tcl8.6.14/0000755000175000017500000000000014566153413011645 5ustar sergeisergeitcl8.6.14/unix/0000755000175000017500000000000014566153412012627 5ustar sergeisergeitcl8.6.14/unix/tclAppInit.c0000644000175000017500000001140714554262142015043 0ustar sergeisergei/* * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit * procedure for tclsh and other Tcl-based applications (without Tk). * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef BUILD_tcl #undef STATIC_BUILD #include "tcl.h" #if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 # define Tcl_LibraryInitProc Tcl_PackageInitProc # define Tcl_StaticLibrary Tcl_StaticPackage #endif #ifdef TCL_TEST extern Tcl_LibraryInitProc Tcltest_Init; extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST extern void XtToolkitInitialize(void); extern Tcl_LibraryInitProc Tclxttest_Init; #endif /* TCL_XT_TEST */ /* * The following #if block allows you to change the AppInit function by using * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The * #if checks for that #define and uses Tcl_AppInit if it does not exist. */ #ifndef TCL_LOCAL_APPINIT #define TCL_LOCAL_APPINIT Tcl_AppInit #endif #ifndef MODULE_SCOPE # define MODULE_SCOPE extern #endif MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); MODULE_SCOPE int main(int, char **); /* * The following #if block allows you to change how Tcl finds the startup * script, prime the library or encoding paths, fiddle with the argv, etc., * without needing to rewrite Tcl_Main() */ #ifdef TCL_LOCAL_MAIN_HOOK MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, char ***argv); #endif /* *---------------------------------------------------------------------- * * main -- * * This is the main program for the application. * * Results: * None: Tcl_Main never returns here, so this procedure never returns * either. * * Side effects: * Just about anything, since from here we call arbitrary Tcl code. * *---------------------------------------------------------------------- */ int main( int argc, /* Number of command-line arguments. */ char *argv[]) /* Values of command-line arguments. */ { #ifdef TCL_XT_TEST XtToolkitInitialize(); #endif #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE)) /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */ TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * * This procedure performs application-specific initialization. Most * applications, especially those that incorporate additional packages, * will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error message in * the interp's result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } #ifdef TCL_XT_TEST if (Tclxttest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #endif #ifdef TCL_TEST if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ /* * Call the init procedures for included packages. Each call should look * like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * * where "Mod" is the name of the module. (Dynamically-loadable packages * should have the same entry-point name.) */ /* * Call Tcl_CreateCommand for application-specific commands, if they * weren't already created by the init procedures called above. */ /* * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. */ #ifdef DJGPP (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY); #else (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY); #endif return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclLoadAix.c0000644000175000017500000003127414554262142015024 0ustar sergeisergei/* * tclLoadAix.c -- * * This file implements the dlopen and dlsym APIs under the AIX operating * system, to enable the Tcl "load" command to work. This code was * provided by Jens-Uwe Mager. * * This file is subject to the following copyright notice, which is * different from the notice used elsewhere in Tcl. The file has been * modified to incorporate the file dlfcn.h in-line. * * Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH * Not derived from licensed software. * * Permission is granted to freely use, copy, modify, and redistribute * this software, provided that the author is not construed to be liable * for any results of using the software, alterations are clearly marked * as such, and this notice is not modified. * * Note: this file has been altered from the original in a few ways in order * to work properly with Tcl. */ /* * @(#)dlfcn.c 1.7 revision of 95/08/14 19:08:38 * This is an unpublished work copyright (c) 1992 HELIOS Software GmbH * 30159 Hannover, Germany */ #include #include #include #include #include #include #include #include #include "../compat/dlfcn.h" /* * We simulate dlopen() et al. through a call to load. Because AIX has no call * to find an exported symbol we read the loader section of the loaded module * and build a list of exported symbols and their virtual address. */ typedef struct { char *name; /* The symbols's name. */ void *addr; /* Its relocated virtual address. */ } Export, *ExportPtr; /* * xlC uses the following structure to list its constructors and destructors. * This is gleaned from the output of munch. */ typedef struct { void (*init)(void); /* call static constructors */ void (*term)(void); /* call static destructors */ } Cdtor, *CdtorPtr; /* * The void * handle returned from dlopen is actually a ModulePtr. */ typedef struct Module { struct Module *next; char *name; /* module name for refcounting */ int refCnt; /* the number of references */ void *entry; /* entry point from load */ struct dl_info *info; /* optional init/terminate functions */ CdtorPtr cdtors; /* optional C++ constructors */ int nExports; /* the number of exports found */ ExportPtr exports; /* the array of exports */ } Module, *ModulePtr; /* * We keep a list of all loaded modules to be able to call the fini handlers * and destructors at atexit() time. */ static ModulePtr modList; /* * The last error from one of the dl* routines is kept in static variables * here. Each error is returned only once to the caller. */ static char errbuf[BUFSIZ]; static int errvalid; static void caterr(char *); static int readExports(ModulePtr); static void terminate(void); static void *findMain(void); void * dlopen( const char *path, int mode) { ModulePtr mp; static void *mainModule; /* * Upon the first call register a terminate handler that will close all * libraries. Also get a reference to the main module for use with * loadbind. */ if (!mainModule) { mainModule = findMain(); if (mainModule == NULL) { return NULL; } atexit(terminate); } /* * Scan the list of modules if we have the module already loaded. */ for (mp = modList; mp; mp = mp->next) { if (strcmp(mp->name, path) == 0) { mp->refCnt++; return (void *) mp; } } mp = (ModulePtr) calloc(1, sizeof(*mp)); if (mp == NULL) { errvalid++; strcpy(errbuf, "calloc: "); strcat(errbuf, strerror(errno)); return NULL; } mp->name = malloc(strlen(path) + 1); strcpy(mp->name, path); /* * load should be declared load(const char *...). Thus we cast the path to * a normal char *. Ugly. */ mp->entry = (void *) load((char *)path, L_NOAUTODEFER, NULL); if (mp->entry == NULL) { free(mp->name); free(mp); errvalid++; strcpy(errbuf, "dlopen: "); strcat(errbuf, path); strcat(errbuf, ": "); /* * If AIX says the file is not executable, the error can be further * described by querying the loader about the last error. */ if (errno == ENOEXEC) { char *tmp[BUFSIZ/sizeof(char *)], **p; if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1) { strcpy(errbuf, strerror(errno)); } else { for (p=tmp ; *p ; p++) { caterr(*p); } } } else { strcat(errbuf, strerror(errno)); } return NULL; } mp->refCnt = 1; mp->next = modList; modList = mp; if (loadbind(0, mainModule, mp->entry) == -1) { loadbindFailure: dlclose(mp); errvalid++; strcpy(errbuf, "loadbind: "); strcat(errbuf, strerror(errno)); return NULL; } /* * If the user wants global binding, loadbind against all other loaded * modules. */ if (mode & RTLD_GLOBAL) { ModulePtr mp1; for (mp1 = mp->next; mp1; mp1 = mp1->next) { if (loadbind(0, mp1->entry, mp->entry) == -1) { goto loadbindFailure; } } } if (readExports(mp) == -1) { dlclose(mp); return NULL; } /* * If there is a dl_info structure, call the init function. */ if (mp->info = (struct dl_info *)dlsym(mp, "dl_info")) { if (mp->info->init) { mp->info->init(); } } else { errvalid = 0; } /* * If the shared object was compiled using xlC we will need to call static * constructors (and later on dlclose destructors). */ if (mp->cdtors = (CdtorPtr) dlsym(mp, "__cdtors")) { while (mp->cdtors->init) { mp->cdtors->init(); mp->cdtors++; } } else { errvalid = 0; } return (void *) mp; } /* * Attempt to decipher an AIX loader error message and append it to our static * error message buffer. */ static void caterr( char *s) { char *p = s; while (*p >= '0' && *p <= '9') { p++; } switch (atoi(s)) { /* INTL: "C", UTF safe. */ case L_ERROR_TOOMANY: strcat(errbuf, "to many errors"); break; case L_ERROR_NOLIB: strcat(errbuf, "can't load library"); strcat(errbuf, p); break; case L_ERROR_UNDEF: strcat(errbuf, "can't find symbol"); strcat(errbuf, p); break; case L_ERROR_RLDBAD: strcat(errbuf, "bad RLD"); strcat(errbuf, p); break; case L_ERROR_FORMAT: strcat(errbuf, "bad exec format in"); strcat(errbuf, p); break; case L_ERROR_ERRNO: strcat(errbuf, strerror(atoi(++p))); /* INTL: "C", UTF safe. */ break; default: strcat(errbuf, s); break; } } void * dlsym( void *handle, const char *symbol) { ModulePtr mp = (ModulePtr)handle; ExportPtr ep; int i; /* * Could speed up the search, but I assume that one assigns the result to * function pointers anyways. */ for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { if (strcmp(ep->name, symbol) == 0) { return ep->addr; } } errvalid++; strcpy(errbuf, "dlsym: undefined symbol "); strcat(errbuf, symbol); return NULL; } char * dlerror(void) { if (errvalid) { errvalid = 0; return errbuf; } return NULL; } int dlclose( void *handle) { ModulePtr mp = (ModulePtr)handle; int result; ModulePtr mp1; if (--mp->refCnt > 0) { return 0; } if (mp->info && mp->info->fini) { mp->info->fini(); } if (mp->cdtors) { while (mp->cdtors->term) { mp->cdtors->term(); mp->cdtors++; } } result = unload(mp->entry); if (result == -1) { errvalid++; strcpy(errbuf, strerror(errno)); } if (mp->exports) { ExportPtr ep; int i; for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { if (ep->name) { free(ep->name); } } free(mp->exports); } if (mp == modList) { modList = mp->next; } else { for (mp1 = modList; mp1; mp1 = mp1->next) { if (mp1->next == mp) { mp1->next = mp->next; break; } } } free(mp->name); free(mp); return result; } static void terminate(void) { while (modList) { dlclose(modList); } } /* * Build the export table from the XCOFF .loader section. */ static int readExports( ModulePtr mp) { LDFILE *ldp = NULL; SCNHDR sh, shdata; LDHDR *lhp; char *ldbuf; LDSYM *ls; int i; ExportPtr ep; const char *errMsg; #define Error(msg) do{errMsg=(msg);goto error;}while(0) #define SysErr() Error(strerror(errno)) ldp = ldopen(mp->name, ldp); if (ldp == NULL) { struct ld_info *lp; char *buf; int size = 0; if (errno != ENOENT) { SysErr(); } /* * The module might be loaded due to the LIBPATH environment variable. * Search for the loaded module using L_GETINFO. */ while (1) { size += 4 * 1024; buf = malloc(size); if (buf == NULL) { SysErr(); } i = loadquery(L_GETINFO, buf, size); if (i != -1) { break; } free(buf); if (errno != ENOMEM) { SysErr(); } } /* * Traverse the list of loaded modules. The entry point returned by * load() does actually point to the data segment origin. */ lp = (struct ld_info *) buf; while (lp) { if (lp->ldinfo_dataorg == mp->entry) { ldp = ldopen(lp->ldinfo_filename, ldp); break; } if (lp->ldinfo_next == 0) { lp = NULL; } else { lp = (struct ld_info *)((char *)lp + lp->ldinfo_next); } } free(buf); if (!ldp) { SysErr(); } } if (TYPE(ldp) != U802TOCMAGIC) { Error("bad magic"); } /* * Get the padding for the data section. This is needed for AIX 4.1 * compilers. This is used when building the final function pointer to the * exported symbol. */ if (ldnshread(ldp, _DATA, &shdata) != SUCCESS) { Error("cannot read data section header"); } if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) { Error("cannot read loader section header"); } /* * We read the complete loader section in one chunk, this makes finding * long symbol names residing in the string table easier. */ ldbuf = (char *) malloc(sh.s_size); if (ldbuf == NULL) { SysErr(); } if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) { free(ldbuf); Error("cannot seek to loader section"); } if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { free(ldbuf); Error("cannot read loader section"); } lhp = (LDHDR *) ldbuf; ls = (LDSYM *)(ldbuf + LDHDRSZ); /* * Count the number of exports to include in our export table. */ for (i = lhp->l_nsyms; i; i--, ls++) { if (!LDR_EXPORT(*ls)) { continue; } mp->nExports++; } mp->exports = (ExportPtr) calloc(mp->nExports, sizeof(*mp->exports)); if (mp->exports == NULL) { free(ldbuf); SysErr(); } /* * Fill in the export table. All entries are relative to the entry point * we got from load. */ ep = mp->exports; ls = (LDSYM *)(ldbuf + LDHDRSZ); for (i=lhp->l_nsyms ; i!=0 ; i--,ls++) { char *symname; char tmpsym[SYMNMLEN+1]; if (!LDR_EXPORT(*ls)) { continue; } if (ls->l_zeroes == 0) { symname = ls->l_offset + lhp->l_stoff + ldbuf; } else { /* * The l_name member is not zero terminated, we must copy the * first SYMNMLEN chars and make sure we have a zero byte at the * end. */ strncpy(tmpsym, ls->l_name, SYMNMLEN); tmpsym[SYMNMLEN] = '\0'; symname = tmpsym; } ep->name = malloc(strlen(symname) + 1); strcpy(ep->name, symname); ep->addr = (void *)((unsigned long) mp->entry + ls->l_value - shdata.s_vaddr); ep++; } free(ldbuf); while (ldclose(ldp) == FAILURE) { /* Empty body */ } return 0; /* * This is a factoring out of the error-handling code to make the rest of * the function much simpler to read. */ error: errvalid++; strcpy(errbuf, "readExports: "); strcat(errbuf, errMsg); if (ldp != NULL) { while (ldclose(ldp) == FAILURE) { /* Empty body */ } } return -1; } /* * Find the main modules entry point. This is used as export pointer for * loadbind() to be able to resolve references to the main part. */ static void * findMain(void) { struct ld_info *lp; char *buf; int size = 4*1024; int i; void *ret; buf = malloc(size); if (buf == NULL) { goto error; } while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { free(buf); size += 4*1024; buf = malloc(size); if (buf == NULL) { goto error; } } if (i == -1) { free(buf); goto error; } /* * The first entry is the main module. The entry point returned by load() * does actually point to the data segment origin. */ lp = (struct ld_info *) buf; ret = lp->ldinfo_dataorg; free(buf); return ret; error: errvalid++; strcpy(errbuf, "findMain: "); strcat(errbuf, strerror(errno)); return NULL; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclLoadDl.c0000644000175000017500000001633114554262142014637 0ustar sergeisergei/* * tclLoadDl.c -- * * This procedure provides a version of the TclLoadFile that works with * the "dlopen" and "dlsym" library procedures for dynamic loading. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef NO_DLFCN_H # include "../compat/dlfcn.h" #else # include #endif /* * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined and this * argument to dlopen must always be 1. The RTLD_LOCAL flag doesn't exist on * some platforms; if it doesn't exist, set it to 0 so it has no effect. * See [Bug #3216070] */ #ifndef RTLD_NOW # define RTLD_NOW 1 #endif #ifndef RTLD_LOCAL # define RTLD_LOCAL 0 #endif /* * Static procedures defined within this file. */ static void * FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); static void UnloadFile(Tcl_LoadHandle loadHandle); /* *--------------------------------------------------------------------------- * * TclpDlopen -- * * Dynamically loads a binary code file into memory and returns a handle * to the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. * *--------------------------------------------------------------------------- */ int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { void *handle; Tcl_LoadHandle newHandle; const char *native; int dlopenflags = 0; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ native = Tcl_FSGetNativePath(pathPtr); /* * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ if (flags & TCL_LOAD_GLOBAL) { dlopenflags |= RTLD_GLOBAL; } else { dlopenflags |= RTLD_LOCAL; } if (flags & TCL_LOAD_LAZY) { dlopenflags |= RTLD_LAZY; } else { dlopenflags |= RTLD_NOW; } handle = dlopen(native, dlopenflags); if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the * binary path. */ Tcl_DString ds; const char *fileName = Tcl_GetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); /* * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ handle = dlopen(native, dlopenflags); Tcl_DStringFree(&ds); } if (handle == NULL) { /* * Write the string to a variable first to work around a compiler bug * in the Sun Forte 6 compiler. [Bug 1503729] */ const char *errorStr = dlerror(); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", Tcl_GetString(pathPtr), errorStr)); } return TCL_ERROR; } newHandle = ckalloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *unloadProcPtr = &UnloadFile; *loadHandle = newHandle; return TCL_OK; } /* *---------------------------------------------------------------------- * * FindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). * * Results: * Returns a pointer to the function associated with 'symbol' if it is * found. Otherwise returns NULL and may leave an error message in the * interp's result. * *---------------------------------------------------------------------- */ static void * FindSymbol( Tcl_Interp *interp, /* Place to put error messages. */ Tcl_LoadHandle loadHandle, /* Value from TcpDlopen(). */ const char *symbol) /* Symbol to look up. */ { const char *native; /* Name of the library to be loaded, in * system encoding */ Tcl_DString newName, ds; /* Buffers for converting the name to * system encoding and prepending an * underscore*/ void *handle = (void *) loadHandle->clientData; /* Native handle to the loaded library */ void *proc; /* Address corresponding to the resolved * symbol */ /* * Some platforms still add an underscore to the beginning of symbol * names. If we can't find a name without an underscore, try again with * the underscore. */ native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); proc = dlsym(handle, native); /* INTL: Native. */ if (proc == NULL) { Tcl_DStringInit(&newName); TclDStringAppendLiteral(&newName, "_"); native = Tcl_DStringAppend(&newName, native, -1); proc = dlsym(handle, native); /* INTL: Native. */ Tcl_DStringFree(&newName); } Tcl_DStringFree(&ds); if (proc == NULL) { const char *errorStr = dlerror(); if (interp) { if (!errorStr) { errorStr = "unknown"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\": %s", symbol, errorStr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); } } return proc; } /* *---------------------------------------------------------------------- * * UnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling * this function. * * Results: * None. * * Side effects: * Code removed from memory. * *---------------------------------------------------------------------- */ static void UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { void *handle = loadHandle->clientData; dlclose(handle); ckfree(loadHandle); } /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package name, * this procedure is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a package * name; generic code will then try to guess the package from the file * name. A return value of 1 would have meant that we figured out the * package name and put it in bufPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName( const char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ { return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclLoadDyld.c0000644000175000017500000004753414554262142015205 0ustar sergeisergei/* * tclLoadDyld.c -- * * This procedure provides a version of the TclLoadFile that works with * Apple's dyld dynamic loading. * Original version of his file (superseded long ago) provided by * Wilfredo Sanchez (wsanchez@apple.com). * * Copyright (c) 1995 Apple Computer, Inc. * Copyright (c) 2001-2007 Daniel A. Steffen * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifndef MODULE_SCOPE # define MODULE_SCOPE extern #endif /* * Use preferred dlfcn API on 10.4 and later */ #ifndef TCL_DYLD_USE_DLFCN # ifdef NO_DLFCN_H # define TCL_DYLD_USE_DLFCN 0 # else # define TCL_DYLD_USE_DLFCN 1 # endif #endif /* * Use deprecated NSModule API only to support 10.3 and earlier: */ #ifndef TCL_DYLD_USE_NSMODULE # define TCL_DYLD_USE_NSMODULE 0 #endif /* * Use includes for the API we're using. */ #if TCL_DYLD_USE_DLFCN # include #endif /* TCL_DYLD_USE_DLFCN */ #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) #if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) #pragma GCC diagnostic ignored "-Wdeprecated-declarations" #endif #include #include #include #include #include #include typedef struct Tcl_DyldModuleHandle { struct Tcl_DyldModuleHandle *nextPtr; NSModule module; } Tcl_DyldModuleHandle; #endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */ typedef struct { void *dlHandle; #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) const struct mach_header *dyldLibHeader; Tcl_DyldModuleHandle *modulePtr; #endif } Tcl_DyldLoadHandle; #if TCL_DYLD_USE_DLFCN || defined(TCL_LOAD_FROM_MEMORY) MODULE_SCOPE long tclMacOSXDarwinRelease; #endif /* * Static functions defined in this file. */ static void * FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); static void UnloadFile(Tcl_LoadHandle handle); /* *---------------------------------------------------------------------- * * DyldOFIErrorMsg -- * * Converts a numerical NSObjectFileImage error into an error message * string. * * Results: * Error message string. * * Side effects: * None. * *---------------------------------------------------------------------- */ #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) static const char * DyldOFIErrorMsg( int err) { switch(err) { case NSObjectFileImageSuccess: return NULL; case NSObjectFileImageFailure: return "object file setup failure"; case NSObjectFileImageInappropriateFile: return "not a Mach-O MH_BUNDLE file"; case NSObjectFileImageArch: return "no object for this architecture"; case NSObjectFileImageFormat: return "bad object file format"; case NSObjectFileImageAccess: return "can't read object file"; default: return "unknown error"; } } #endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */ /* *---------------------------------------------------------------------- * * TclpDlopen -- * * Dynamically loads a binary code file into memory and returns a handle * to the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interpreter's result. * * Side effects: * New code suddenly appears in memory. * *---------------------------------------------------------------------- */ MODULE_SCOPE int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { Tcl_DyldLoadHandle *dyldLoadHandle; Tcl_LoadHandle newHandle; void *dlHandle = NULL; #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) const struct mach_header *dyldLibHeader = NULL; Tcl_DyldModuleHandle *modulePtr = NULL; #endif #if TCL_DYLD_USE_NSMODULE NSLinkEditErrors editError; int errorNumber; const char *errorName, *objFileImageErrMsg = NULL; #endif /* TCL_DYLD_USE_NSMODULE */ const char *errMsg = NULL; int result; Tcl_DString ds; const char *nativePath, *nativeFileName = NULL; #if TCL_DYLD_USE_DLFCN int dlopenflags = 0; #endif /* TCL_DYLD_USE_DLFCN */ /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ nativePath = Tcl_FSGetNativePath(pathPtr); nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1, &ds); #if TCL_DYLD_USE_DLFCN /* * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ if (flags & TCL_LOAD_GLOBAL) { dlopenflags |= RTLD_GLOBAL; } else { dlopenflags |= RTLD_LOCAL; } if (flags & TCL_LOAD_LAZY) { dlopenflags |= RTLD_LAZY; } else { dlopenflags |= RTLD_NOW; } dlHandle = dlopen(nativePath, dlopenflags); if (!dlHandle) { /* * Let the OS loader examine the binary search path for whatever string * the user gave us which hopefully refers to a file on the binary * path. */ dlHandle = dlopen(nativeFileName, dlopenflags); if (!dlHandle) { errMsg = dlerror(); } } #endif /* TCL_DYLD_USE_DLFCN */ if (!dlHandle) { #if TCL_DYLD_USE_NSMODULE dyldLibHeader = NSAddImage(nativePath, NSADDIMAGE_OPTION_RETURN_ON_ERROR); if (!dyldLibHeader) { NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); if (editError == NSLinkEditFileAccessError) { /* * The requested file was not found. Let the OS loader examine * the binary search path for whatever string the user gave us * which hopefully refers to a file on the binary path. */ dyldLibHeader = NSAddImage(nativeFileName, NSADDIMAGE_OPTION_WITH_SEARCHING | NSADDIMAGE_OPTION_RETURN_ON_ERROR); if (!dyldLibHeader) { NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); } } else if ((editError == NSLinkEditFileFormatError && errorNumber == EBADMACHO) || editError == NSLinkEditOtherError){ NSObjectFileImageReturnCode err; NSObjectFileImage dyldObjFileImage; NSModule module; /* * The requested file was found but was not of type MH_DYLIB, * attempt to load it as a MH_BUNDLE. */ err = NSCreateObjectFileImageFromFile(nativePath, &dyldObjFileImage); if (err == NSObjectFileImageSuccess && dyldObjFileImage) { int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR; if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; module = NSLinkModule(dyldObjFileImage, nativePath, nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (module) { modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; } else { NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); } } else { objFileImageErrMsg = DyldOFIErrorMsg(err); } } } #endif /* TCL_DYLD_USE_NSMODULE */ } if (dlHandle #if TCL_DYLD_USE_NSMODULE || dyldLibHeader || modulePtr #endif /* TCL_DYLD_USE_NSMODULE */ ) { dyldLoadHandle = ckalloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dlHandle = dlHandle; #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) dyldLoadHandle->dyldLibHeader = dyldLibHeader; dyldLoadHandle->modulePtr = modulePtr; #endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */ newHandle = ckalloc(sizeof(*newHandle)); newHandle->clientData = dyldLoadHandle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *unloadProcPtr = &UnloadFile; *loadHandle = newHandle; result = TCL_OK; } else { Tcl_Obj *errObj; TclNewObj(errObj); if (errMsg != NULL) { Tcl_AppendToObj(errObj, errMsg, -1); } #if TCL_DYLD_USE_NSMODULE if (objFileImageErrMsg) { Tcl_AppendPrintfToObj(errObj, "\nNSCreateObjectFileImageFromFile() error: %s", objFileImageErrMsg); } #endif /* TCL_DYLD_USE_NSMODULE */ Tcl_SetObjResult(interp, errObj); result = TCL_ERROR; } Tcl_DStringFree(&ds); return result; } /* *---------------------------------------------------------------------- * * FindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). * * Results: * Returns a pointer to the function associated with 'symbol' if it is * found. Otherwise returns NULL and may leave an error message in the * interp's result. * *---------------------------------------------------------------------- */ static void * FindSymbol( Tcl_Interp *interp, /* For error reporting. */ Tcl_LoadHandle loadHandle, /* Handle from TclpDlopen. */ const char *symbol) /* Symbol name to look up. */ { Tcl_DyldLoadHandle *dyldLoadHandle = loadHandle->clientData; Tcl_PackageInitProc *proc = NULL; const char *errMsg = NULL; Tcl_DString ds; const char *native; native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); if (dyldLoadHandle->dlHandle) { #if TCL_DYLD_USE_DLFCN proc = dlsym(dyldLoadHandle->dlHandle, native); if (!proc) { errMsg = dlerror(); } #endif /* TCL_DYLD_USE_DLFCN */ } else { #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) NSSymbol nsSymbol = NULL; Tcl_DString newName; /* * dyld adds an underscore to the beginning of symbol names. */ Tcl_DStringInit(&newName); TclDStringAppendLiteral(&newName, "_"); native = Tcl_DStringAppend(&newName, native, -1); if (dyldLoadHandle->dyldLibHeader) { nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader, native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW | NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); if (nsSymbol) { /* * Until dyld supports unloading of MY_DYLIB binaries, the * following is not needed. */ #ifdef DYLD_SUPPORTS_DYLIB_UNLOADING NSModule module = NSModuleForSymbol(nsSymbol); Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr; while (modulePtr != NULL) { if (module == modulePtr->module) { break; } modulePtr = modulePtr->nextPtr; } if (modulePtr == NULL) { modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = dyldLoadHandle->modulePtr; dyldLoadHandle->modulePtr = modulePtr; } #endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */ } else { NSLinkEditErrors editError; int errorNumber; const char *errorName; NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); } } else if (dyldLoadHandle->modulePtr) { nsSymbol = NSLookupSymbolInModule( dyldLoadHandle->modulePtr->module, native); } if (nsSymbol) { proc = NSAddressOfSymbol(nsSymbol); } Tcl_DStringFree(&newName); #endif /* TCL_DYLD_USE_NSMODULE */ } Tcl_DStringFree(&ds); if (errMsg && (interp != NULL)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\": %s", symbol, errMsg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); } return proc; } /* *---------------------------------------------------------------------- * * UnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling * this function. * * Results: * None. * * Side effects: * Code dissapears from memory. Note that dyld currently only supports * unloading of binaries of type MH_BUNDLE loaded with NSLinkModule() in * TclpDlopen() above. * *---------------------------------------------------------------------- */ static void UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { Tcl_DyldLoadHandle *dyldLoadHandle = loadHandle->clientData; if (dyldLoadHandle->dlHandle) { #if TCL_DYLD_USE_DLFCN (void) dlclose(dyldLoadHandle->dlHandle); #endif /* TCL_DYLD_USE_DLFCN */ } else { #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr; while (modulePtr != NULL) { void *ptr = modulePtr; (void) NSUnLinkModule(modulePtr->module, NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES); modulePtr = modulePtr->nextPtr; ckfree(ptr); } #endif /* TCL_DYLD_USE_NSMODULE */ } ckfree(dyldLoadHandle); ckfree(loadHandle); } /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package name, * this procedure is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a package * name; generic code will then try to guess the package from the file * name. A return value of 1 would have meant that we figured out the * package name and put it in bufPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName( const char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ { return 0; } /* *---------------------------------------------------------------------- * * TclpLoadMemoryGetBuffer -- * * Allocate a buffer that can be used with TclpLoadMemory() below. * * Results: * Pointer to allocated buffer or NULL if an error occurs. * * Side effects: * Buffer is allocated. * *---------------------------------------------------------------------- */ #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE void * TclpLoadMemoryGetBuffer( Tcl_Interp *interp, /* Used for error reporting. */ int size) /* Size of desired buffer. */ { void *buffer = NULL; /* * NSCreateObjectFileImageFromMemory is available but always fails * prior to Darwin 7. */ if (tclMacOSXDarwinRelease >= 7) { /* * We must allocate the buffer using vm_allocate, because * NSCreateObjectFileImageFromMemory will dispose of it using * vm_deallocate. */ if (vm_allocate(mach_task_self(), (vm_address_t *) &buffer, size, 1)) { buffer = NULL; } } return buffer; } #endif /* TCL_LOAD_FROM_MEMORY */ /* *---------------------------------------------------------------------- * * TclpLoadMemory -- * * Dynamically loads binary code file from memory and returns a handle to * the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interpreter's result. * * Side effects: * New code is loaded from memory. * *---------------------------------------------------------------------- */ #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE int TclpLoadMemory( Tcl_Interp *interp, /* Used for error reporting. */ void *buffer, /* Buffer containing the desired code * (allocated with TclpLoadMemoryGetBuffer). */ int size, /* Allocation size of buffer. */ int codeSize, /* Size of code data read into buffer or -1 if * an error occurred and the buffer should * just be freed. */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { Tcl_LoadHandle newHandle; Tcl_DyldLoadHandle *dyldLoadHandle; NSObjectFileImage dyldObjFileImage = NULL; Tcl_DyldModuleHandle *modulePtr; NSModule module; const char *objFileImageErrMsg = NULL; int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR; /* * Try to create an object file image that we can load from. */ if (codeSize >= 0) { NSObjectFileImageReturnCode err = NSObjectFileImageSuccess; const struct fat_header *fh = buffer; uint32_t ms = 0; #ifndef __LP64__ const struct mach_header *mh = NULL; # define mh_size sizeof(struct mach_header) # define mh_magic MH_MAGIC # define arch_abi 0 #else const struct mach_header_64 *mh = NULL; # define mh_size sizeof(struct mach_header_64) # define mh_magic MH_MAGIC_64 # define arch_abi CPU_ARCH_ABI64 #endif /* __LP64__ */ if ((size_t) codeSize >= sizeof(struct fat_header) && fh->magic == OSSwapHostToBigInt32(FAT_MAGIC)) { uint32_t fh_nfat_arch = OSSwapBigToHostInt32(fh->nfat_arch); /* * Fat binary, try to find mach_header for our architecture */ if ((size_t) codeSize >= sizeof(struct fat_header) + fh_nfat_arch * sizeof(struct fat_arch)) { void *fatarchs = (char*)buffer + sizeof(struct fat_header); const NXArchInfo *arch = NXGetLocalArchInfo(); struct fat_arch *fa; if (fh->magic != FAT_MAGIC) { swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder); } fa = NXFindBestFatArch(arch->cputype | arch_abi, arch->cpusubtype, fatarchs, fh_nfat_arch); if (fa) { mh = (void *)((char *) buffer + fa->offset); ms = fa->size; } else { err = NSObjectFileImageInappropriateFile; } if (fh->magic != FAT_MAGIC) { swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder); } } else { err = NSObjectFileImageInappropriateFile; } } else { /* * Thin binary */ mh = buffer; ms = codeSize; } if (ms && !(ms >= mh_size && mh->magic == mh_magic && mh->filetype == MH_BUNDLE)) { err = NSObjectFileImageInappropriateFile; } if (err == NSObjectFileImageSuccess) { err = NSCreateObjectFileImageFromMemory(buffer, codeSize, &dyldObjFileImage); if (err != NSObjectFileImageSuccess) { objFileImageErrMsg = DyldOFIErrorMsg(err); } } else { objFileImageErrMsg = DyldOFIErrorMsg(err); } } /* * If it went wrong (or we were asked to just deallocate), get rid of the * memory block and create an error message. */ if (dyldObjFileImage == NULL) { vm_deallocate(mach_task_self(), (vm_address_t) buffer, size); if (objFileImageErrMsg != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "NSCreateObjectFileImageFromMemory() error: %s", objFileImageErrMsg)); } return TCL_ERROR; } /* * Extract the module we want from the image of the object file. */ if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (!module) { NSLinkEditErrors editError; int errorNumber; const char *errorName, *errMsg; NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); return TCL_ERROR; } /* * Stash the module reference within the load handle we create and return. */ modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; dyldLoadHandle = ckalloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dlHandle = NULL; dyldLoadHandle->dyldLibHeader = NULL; dyldLoadHandle->modulePtr = modulePtr; newHandle = ckalloc(sizeof(*newHandle)); newHandle->clientData = dyldLoadHandle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *loadHandle = newHandle; *unloadProcPtr = &UnloadFile; return TCL_OK; } #endif /* TCL_LOAD_FROM_MEMORY */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 79 * End: */ tcl8.6.14/unix/tclLoadNext.c0000644000175000017500000001312714554262142015216 0ustar sergeisergei/* * tclLoadNext.c -- * * This procedure provides a version of the TclLoadFile that works with * NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include #include /* Static procedures defined within this file */ static void * FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char* symbol); static void UnloadFile(Tcl_LoadHandle loadHandle); /* *---------------------------------------------------------------------- * * TclpDlopen -- * * Dynamically loads a binary code file into memory and returns a handle * to the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. * *---------------------------------------------------------------------- */ int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { Tcl_LoadHandle newHandle; struct mach_header *header; char *fileName; char *files[2]; const char *native; int result = 1; NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE); fileName = Tcl_GetString(pathPtr); /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ native = Tcl_FSGetNativePath(pathPtr); files = {native,NULL}; result = rld_load(errorStream, &header, files, NULL); if (!result) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the * binary path */ Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); files = {native,NULL}; result = rld_load(errorStream, &header, files, NULL); Tcl_DStringFree(&ds); } if (!result) { char *data; int len, maxlen; NXGetMemoryBuffer(errorStream, &data, &len, &maxlen); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", fileName, data)); NXCloseMemory(errorStream, NX_FREEBUFFER); return TCL_ERROR; } NXCloseMemory(errorStream, NX_FREEBUFFER); newHandle = ckalloc(sizeof(Tcl_LoadHandle)); newHandle->clientData = INT2PTR(1); newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *loadHandle = newHandle; *unloadProcPtr = &UnloadFile; return TCL_OK; } /* *---------------------------------------------------------------------- * * FindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). * * Results: * Returns a pointer to the function associated with 'symbol' if it is * found. Otherwise returns NULL and may leave an error message in the * interp's result. * *---------------------------------------------------------------------- */ static void * FindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol) { Tcl_PackageInitProc *proc = NULL; if (symbol) { char sym[strlen(symbol) + 2]; sym[0] = '_'; sym[1] = 0; strcat(sym, symbol); rld_lookup(NULL, sym, (unsigned long *) &proc); } if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); } return proc; } /* *---------------------------------------------------------------------- * * UnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling * this function. * * Results: * None. * * Side effects: * Does nothing. Can anything be done? * *---------------------------------------------------------------------- */ void UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { ckfree(loadHandle); } /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package name, * this procedure is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a package * name; generic code will then try to guess the package from the file * name. A return value of 1 would have meant that we figured out the * package name and put it in bufPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName( const char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ { return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclLoadOSF.c0000644000175000017500000001447114554262142014732 0ustar sergeisergei/* * tclLoadOSF.c -- * * This function provides a version of the TclLoadFile that works under * OSF/1 1.0/1.1/1.2 and related systems, utilizing the old OSF/1 * /sbin/loader and /usr/include/loader.h. OSF/1 versions from 1.3 and on * use ELF, rtld, and dlopen()[/usr/include/ldfcn.h]. * * This is useful for: * OSF/1 1.0, 1.1, 1.2 (from OSF) * includes: MK4 and AD1 (from OSF RI) * OSF/1 1.3 (from OSF) using ROSE * HP OSF/1 1.0 ("Acorn") using COFF * * This is likely to be useful for: * Paragon OSF/1 (from Intel) * HI-OSF/1 (from Hitachi) * * This is NOT to be used on: * Digitial Alpha OSF/1 systems * OSF/1 1.3 or later (from OSF) using ELF * includes: MK6, MK7, AD2, AD3 (from OSF RI) * * This approach to things was utter @&^#; thankfully, OSF/1 eventually * supported dlopen(). * * John Robert LoVerso * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include #include /* * Static functions defined within this file. */ static void * FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char* symbol); static void UnloadFile(Tcl_LoadHandle handle); /* *---------------------------------------------------------------------- * * TclpDlopen -- * * Dynamically loads a binary code file into memory and returns a handle * to the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. * *---------------------------------------------------------------------- */ int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { Tcl_LoadHandle newHandle; ldr_module_t lm; char *pkg; char *fileName = Tcl_GetString(pathPtr); const char *native; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ native = Tcl_FSGetNativePath(pathPtr); lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); if (lm == LDR_NULL_MODULE) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the * binary path */ Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); Tcl_DStringFree(&ds); } if (lm == LDR_NULL_MODULE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", fileName, Tcl_PosixError(interp))); return TCL_ERROR; } *clientDataPtr = NULL; /* * My convention is to use a [OSF loader] package name the same as shlib, * since the idiots never implemented ldr_lookup() and it is otherwise * impossible to get a package name given a module. * * I build loadable modules with a makefile rule like * ld ... -export $@: -o $@ $(OBJS) */ if ((pkg = strrchr(fileName, '/')) == NULL) { pkg = fileName; } else { pkg++; } newHandle = ckalloc(sizeof(*newHandle)); newHandle->clientData = pkg; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *loadHandle = newHandle; *unloadProcPtr = &UnloadFile; return TCL_OK; } /* *---------------------------------------------------------------------- * * FindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). * * Results: * Returns a pointer to the function associated with 'symbol' if it is * found. Otherwise returns NULL and may leave an error message in the * interp's result. * *---------------------------------------------------------------------- */ static void * FindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol) { void *retval = ldr_lookup_package((char *) loadHandle, symbol); if (retval == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); } return retval; } /* *---------------------------------------------------------------------- * * UnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling * this function. * * Results: * None. * * Side effects: * Does nothing. Can anything be done? * *---------------------------------------------------------------------- */ static void UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { ckfree(loadHandle); } /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package name, * this function is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a package * name; generic code will then try to guess the package from the file * name. A return value of 1 would have meant that we figured out the * package name and put it in bufPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName( const char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ { return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclLoadShl.c0000644000175000017500000001426714554262142015034 0ustar sergeisergei/* * tclLoadShl.c -- * * This procedure provides a version of the TclLoadFile that works with * the "shl_load" and "shl_findsym" library procedures for dynamic * loading (e.g. for HP machines). * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include #include "tclInt.h" /* * Static functions defined within this file. */ static void * FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); static void UnloadFile(Tcl_LoadHandle handle); /* *---------------------------------------------------------------------- * * TclpDlopen -- * * Dynamically loads a binary code file into memory and returns a handle * to the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. * *---------------------------------------------------------------------- */ int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { shl_t handle; Tcl_LoadHandle newHandle; const char *native; char *fileName = Tcl_GetString(pathPtr); /* * The flags below used to be BIND_IMMEDIATE; they were changed at the * suggestion of Wolfgang Kechel (wolfgang@prs.de): "This enables * verbosity for missing symbols when loading a shared lib and allows to * load libtk8.0.sl into tclsh8.0 without problems. In general, this * delays resolving symbols until they are actually needed. Shared libs * do no longer need all libraries linked in when they are build." */ /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ native = Tcl_FSGetNativePath(pathPtr); handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE, 0L); if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the * binary path. */ Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); Tcl_DStringFree(&ds); } if (handle == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", fileName, Tcl_PosixError(interp))); return TCL_ERROR; } newHandle = ckalloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile; *loadHandle = newHandle; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_FindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). * * Results: * Returns a pointer to the function associated with 'symbol' if it is * found. Otherwise returns NULL and may leave an error message in the * interp's result. * *---------------------------------------------------------------------- */ static void* FindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol) { Tcl_DString newName; Tcl_PackageInitProc *proc = NULL; shl_t handle = (shl_t) loadHandle->clientData; /* * Some versions of the HP system software still use "_" at the beginning * of exported symbols while others don't; try both forms of each name. */ if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, (void *) &proc) != 0) { Tcl_DStringInit(&newName); TclDStringAppendLiteral(&newName, "_"); Tcl_DStringAppend(&newName, symbol, -1); if (shl_findsym(&handle, Tcl_DStringValue(&newName), (short) TYPE_PROCEDURE, (void *) &proc) != 0) { proc = NULL; } Tcl_DStringFree(&newName); } if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\": %s", symbol, Tcl_PosixError(interp))); } return proc; } /* *---------------------------------------------------------------------- * * UnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling * this function. * * Results: * None. * * Side effects: * Code removed from memory. * *---------------------------------------------------------------------- */ static void UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { shl_t handle = (shl_t) loadHandle->clientData; shl_unload(handle); ckfree(loadHandle); } /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package name, * this procedure is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a package * name; generic code will then try to guess the package from the file * name. A return value of 1 would have meant that we figured out the * package name and put it in bufPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName( const char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ { return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixChan.c0000644000175000017500000014434014554262142015217 0ustar sergeisergei/* * tclUnixChan.c * * Common channel driver for Unix channels based on files, command pipes * and TCP sockets. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* Internal definitions for Tcl. */ #include "tclIO.h" /* To get Channel type declaration. */ #undef SUPPORTS_TTY #if defined(HAVE_TERMIOS_H) # define SUPPORTS_TTY 1 # include # ifdef HAVE_SYS_IOCTL_H # include # endif /* HAVE_SYS_IOCTL_H */ # ifdef HAVE_SYS_MODEM_H # include # endif /* HAVE_SYS_MODEM_H */ # ifdef FIONREAD # define GETREADQUEUE(fd, int) ioctl((fd), FIONREAD, &(int)) # elif defined(FIORDCHK) # define GETREADQUEUE(fd, int) int = ioctl((fd), FIORDCHK, NULL) # else # define GETREADQUEUE(fd, int) int = 0 # endif # ifdef TIOCOUTQ # define GETWRITEQUEUE(fd, int) ioctl((fd), TIOCOUTQ, &(int)) # else # define GETWRITEQUEUE(fd, int) int = 0 # endif # if !defined(CRTSCTS) && defined(CNEW_RTSCTS) # define CRTSCTS CNEW_RTSCTS # endif /* !CRTSCTS&CNEW_RTSCTS */ # if !defined(PAREXT) && defined(CMSPAR) # define PAREXT CMSPAR # endif /* !PAREXT&&CMSPAR */ #endif /* HAVE_TERMIOS_H */ /* * Helper macros to make parts of this file clearer. The macros do exactly * what they say on the tin. :-) They also only ever refer to their arguments * once, and so can be used without regard to side effects. */ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) /* * This structure describes per-instance state of a file based channel. */ typedef struct FileState { Tcl_Channel channel; /* Channel associated with this file. */ int fd; /* File handle. */ int validMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ } FileState; #ifdef SUPPORTS_TTY /* * The following structure is used to set or get the serial port attributes in * a platform-independent manner. */ typedef struct TtyAttrs { int baud; int parity; int data; int stop; } TtyAttrs; #endif /* !SUPPORTS_TTY */ #define UNSUPPORTED_OPTION(detail) \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \ "%s not supported for this platform", (detail))); \ Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); \ } /* * Static routines for this file: */ static int FileBlockModeProc(ClientData instanceData, int mode); static int FileCloseProc(ClientData instanceData, Tcl_Interp *interp); static int FileClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags); static int FileGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static int FileInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static int FileSeekProc(ClientData instanceData, long offset, int mode, int *errorCode); static int FileTruncateProc(ClientData instanceData, Tcl_WideInt length); static Tcl_WideInt FileWideSeekProc(ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode); static void FileWatchProc(ClientData instanceData, int mask); #ifdef SUPPORTS_TTY static void TtyGetAttributes(int fd, TtyAttrs *ttyPtr); static int TtyGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int TtyGetBaud(speed_t speed); static speed_t TtyGetSpeed(int baud); static void TtyInit(int fd); static void TtyModemStatusStr(int status, Tcl_DString *dsPtr); static int TtyParseMode(Tcl_Interp *interp, const char *mode, TtyAttrs *ttyPtr); static void TtySetAttributes(int fd, TtyAttrs *ttyPtr); static int TtySetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); #endif /* SUPPORTS_TTY */ /* * This structure describes the channel type structure for file based IO: */ static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ FileCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ FileSeekProc, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ FileClose2Proc, /* close2proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ FileWideSeekProc, /* wide seek proc. */ NULL, FileTruncateProc /* truncate proc. */ }; #ifdef SUPPORTS_TTY /* * This structure describes the channel type structure for serial IO. * Note that this type is a subclass of the "file" type. */ static const Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ FileCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TtySetOptionProc, /* Set option proc. */ TtyGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ FileClose2Proc, /* close2proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ NULL, /* thread action proc. */ NULL /* truncate proc. */ }; #endif /* SUPPORTS_TTY */ /* *---------------------------------------------------------------------- * * FileBlockModeProc -- * * Helper function to set blocking and nonblocking modes on a file based * channel. Invoked by generic IO level code. * * Results: * 0 if successful, errno when failed. * * Side effects: * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ static int FileBlockModeProc( ClientData instanceData, /* File state. */ int mode) /* The mode to set. Can be TCL_MODE_BLOCKING * or TCL_MODE_NONBLOCKING. */ { FileState *fsPtr = (FileState *)instanceData; if (TclUnixSetBlockingMode(fsPtr->fd, mode) < 0) { return errno; } return 0; } /* *---------------------------------------------------------------------- * * FileInputProc -- * * This function is invoked from the generic IO level to read input from * a file based channel. * * Results: * The number of bytes read is returned or -1 on error. An output * argument contains a POSIX error code if an error occurs, or zero. * * Side effects: * Reads input from the input device of the channel. * *---------------------------------------------------------------------- */ static int FileInputProc( ClientData instanceData, /* File state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { FileState *fsPtr = (FileState *)instanceData; int bytesRead; /* How many bytes were actually read from the * input device? */ *errorCodePtr = 0; /* * Assume there is always enough input available. This will block * appropriately, and read will unblock as soon as a short read is * possible, if the channel is in blocking mode. If the channel is * nonblocking, the read will never block. */ do { bytesRead = read(fsPtr->fd, buf, toRead); } while ((bytesRead < 0) && (errno == EINTR)); if (bytesRead < 0) { *errorCodePtr = errno; return -1; } return bytesRead; } /* *---------------------------------------------------------------------- * * FileOutputProc-- * * This function is invoked from the generic IO level to write output to * a file channel. * * Results: * The number of bytes written is returned or -1 on error. An output * argument contains a POSIX error code if an error occurred, or zero. * * Side effects: * Writes output on the output device of the channel. * *---------------------------------------------------------------------- */ static int FileOutputProc( ClientData instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { FileState *fsPtr = (FileState *)instanceData; int written; *errorCodePtr = 0; if (toWrite == 0) { /* * SF Tcl Bug 465765. Do not try to write nothing into a file. STREAM * based implementations will considers this as EOF (if there is a * pipe behind the file). */ return 0; } written = write(fsPtr->fd, buf, toWrite); if (written >= 0) { return written; } *errorCodePtr = errno; return -1; } /* *---------------------------------------------------------------------- * * FileCloseProc -- * * This function is called from the generic IO level to perform * channel-type-specific cleanup when a file based channel is closed. * * Results: * 0 if successful, errno if failed. * * Side effects: * Closes the device of the channel. * *---------------------------------------------------------------------- */ static int FileCloseProc( ClientData instanceData, /* File state. */ Tcl_Interp *interp) /* For error reporting - unused. */ { FileState *fsPtr = (FileState *)instanceData; int errorCode = 0; Tcl_DeleteFileHandler(fsPtr->fd); /* * Do not close standard channels while in thread-exit. */ if (!TclInThreadExit() || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) { if (close(fsPtr->fd) < 0) { errorCode = errno; } } ckfree(fsPtr); return errorCode; } static int FileClose2Proc( ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - unused. */ int flags) { if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return FileCloseProc(instanceData, interp); } return EINVAL; } /* *---------------------------------------------------------------------- * * FileSeekProc -- * * This function is called by the generic IO level to move the access * point in a file based channel. * * Results: * -1 if failed, the new position if successful. An output argument * contains the POSIX error code if an error occurred, or zero. * * Side effects: * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ static int FileSeekProc( ClientData instanceData, /* File state. */ long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_SET or SEEK_END. */ int *errorCodePtr) /* To store error code. */ { FileState *fsPtr = instanceData; Tcl_WideInt oldLoc, newLoc; /* * Save our current place in case we need to roll-back the seek. */ oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR); if (oldLoc == Tcl_LongAsWide(-1)) { /* * Bad things are happening. Error out... */ *errorCodePtr = errno; return -1; } newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode); /* * Check for expressability in our return type, and roll-back otherwise. */ if (newLoc > Tcl_LongAsWide(INT_MAX)) { *errorCodePtr = EOVERFLOW; TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET); return -1; } else { *errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0; } return (int) Tcl_WideAsLong(newLoc); } /* *---------------------------------------------------------------------- * * FileWideSeekProc -- * * This function is called by the generic IO level to move the access * point in a file based channel, with offsets expressed as wide * integers. * * Results: * -1 if failed, the new position if successful. An output argument * contains the POSIX error code if an error occurred, or zero. * * Side effects: * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ static Tcl_WideInt FileWideSeekProc( ClientData instanceData, /* File state. */ Tcl_WideInt offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_CUR or SEEK_END. */ int *errorCodePtr) /* To store error code. */ { FileState *fsPtr = (FileState *)instanceData; Tcl_WideInt newLoc; newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode); *errorCodePtr = (newLoc == -1) ? errno : 0; return newLoc; } /* *---------------------------------------------------------------------- * * FileWatchProc -- * * Initialize the notifier to watch the fd from this channel. * * Results: * None. * * Side effects: * Sets up the notifier so that a future event on the channel will * be seen by Tcl. * *---------------------------------------------------------------------- */ /* * Bug ad5a57f2f271: Tcl_NotifyChannel is not a Tcl_FileProc, * so do not pass it to directly to Tcl_CreateFileHandler. * Instead, pass a wrapper which is a Tcl_FileProc. */ static void FileWatchNotifyChannelWrapper( ClientData clientData, int mask) { Tcl_Channel channel = (Tcl_Channel)clientData; Tcl_NotifyChannel(channel, mask); } static void FileWatchProc( ClientData instanceData, /* The file state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { FileState *fsPtr = (FileState *)instanceData; /* * Make sure we only register for events that are valid on this file. */ mask &= fsPtr->validMask; if (mask) { Tcl_CreateFileHandler(fsPtr->fd, mask, FileWatchNotifyChannelWrapper, fsPtr->channel); } else { Tcl_DeleteFileHandler(fsPtr->fd); } } /* *---------------------------------------------------------------------- * * FileGetHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS handles from a file * based channel. * * Results: * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no * handle for the specified direction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileGetHandleProc( ClientData instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { FileState *fsPtr = (FileState *)instanceData; if (direction & fsPtr->validMask) { *handlePtr = INT2PTR(fsPtr->fd); return TCL_OK; } return TCL_ERROR; } #ifdef SUPPORTS_TTY /* *---------------------------------------------------------------------- * * TtyModemStatusStr -- * * Converts a RS232 modem status list of readable flags * *---------------------------------------------------------------------- */ static void TtyModemStatusStr( int status, /* RS232 modem status */ Tcl_DString *dsPtr) /* Where to store string */ { #ifdef TIOCM_CTS Tcl_DStringAppendElement(dsPtr, "CTS"); Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CTS) ? "1" : "0"); #endif /* TIOCM_CTS */ #ifdef TIOCM_DSR Tcl_DStringAppendElement(dsPtr, "DSR"); Tcl_DStringAppendElement(dsPtr, (status & TIOCM_DSR) ? "1" : "0"); #endif /* TIOCM_DSR */ #ifdef TIOCM_RNG Tcl_DStringAppendElement(dsPtr, "RING"); Tcl_DStringAppendElement(dsPtr, (status & TIOCM_RNG) ? "1" : "0"); #endif /* TIOCM_RNG */ #ifdef TIOCM_CD Tcl_DStringAppendElement(dsPtr, "DCD"); Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CD) ? "1" : "0"); #endif /* TIOCM_CD */ } /* *---------------------------------------------------------------------- * * TtySetOptionProc -- * * Sets an option on a channel. * * Results: * A standard Tcl result. Also sets the interp's result on error if * interp is not NULL. * * Side effects: * May modify an option on a device. Sets Error message if needed (by * calling Tcl_BadChannelOption). * *---------------------------------------------------------------------- */ static int TtySetOptionProc( ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { FileState *fsPtr = (FileState *)instanceData; size_t len, vlen; TtyAttrs tty; int argc; const char **argv; struct termios iostate; len = strlen(optionName); vlen = strlen(value); /* * Option -mode baud,parity,databits,stopbits */ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (TtyParseMode(interp, value, &tty) != TCL_OK) { return TCL_ERROR; } /* * system calls results should be checked there. - dl */ TtySetAttributes(fsPtr->fd, &tty); return TCL_OK; } /* * Option -handshake none|xonxoff|rtscts|dtrdsr */ if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { /* * Reset all handshake options. DTR and RTS are ON by default. */ tcgetattr(fsPtr->fd, &iostate); CLEAR_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); #ifdef CRTSCTS CLEAR_BITS(iostate.c_cflag, CRTSCTS); #endif /* CRTSCTS */ if (strncasecmp(value, "NONE", vlen) == 0) { /* * Leave all handshake options disabled. */ } else if (strncasecmp(value, "XONXOFF", vlen) == 0) { SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); } else if (strncasecmp(value, "RTSCTS", vlen) == 0) { #ifdef CRTSCTS SET_BITS(iostate.c_cflag, CRTSCTS); #else /* !CRTSTS */ UNSUPPORTED_OPTION("-handshake RTSCTS"); return TCL_ERROR; #endif /* CRTSCTS */ } else if (strncasecmp(value, "DTRDSR", vlen) == 0) { UNSUPPORTED_OPTION("-handshake DTRDSR"); return TCL_ERROR; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -handshake: must be one of" " xonxoff, rtscts, dtrdsr or none", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } return TCL_ERROR; } tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); return TCL_OK; } /* * Option -xchar {\x11 \x13} */ if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { Tcl_DString ds; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } else if (argc != 2) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -xchar: should be a list of" " two elements", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", NULL); } ckfree(argv); return TCL_ERROR; } tcgetattr(fsPtr->fd, &iostate); Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds); iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds); TclDStringClear(&ds); Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds); iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds); Tcl_DStringFree(&ds); ckfree(argv); tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); return TCL_OK; } /* * Option -timeout msec */ if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) { int msec; tcgetattr(fsPtr->fd, &iostate); if (Tcl_GetInt(interp, value, &msec) != TCL_OK) { return TCL_ERROR; } iostate.c_cc[VMIN] = 0; iostate.c_cc[VTIME] = (msec==0) ? 0 : (msec<100) ? 1 : (msec+50)/100; tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); return TCL_OK; } /* * Option -ttycontrol {DTR 1 RTS 0 BREAK 0} */ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { #if defined(TIOCMGET) && defined(TIOCMSET) int control, flag; int i; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if ((argc % 2) == 1) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -ttycontrol: should be a list of" " signal,value pairs", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } ckfree(argv); return TCL_ERROR; } ioctl(fsPtr->fd, TIOCMGET, &control); for (i = 0; i < argc-1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { ckfree(argv); return TCL_ERROR; } if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_DTR); } else { CLEAR_BITS(control, TIOCM_DTR); } } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_RTS); } else { CLEAR_BITS(control, TIOCM_RTS); } } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { #if defined(TIOCSBRK) && defined(TIOCCBRK) if (flag) { ioctl(fsPtr->fd, TIOCSBRK, NULL); } else { ioctl(fsPtr->fd, TIOCCBRK, NULL); } #else /* TIOCSBRK & TIOCCBRK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); ckfree(argv); return TCL_ERROR; #endif /* TIOCSBRK & TIOCCBRK */ } else { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad signal \"%s\" for -ttycontrol: must be" " DTR, RTS or BREAK", argv[i])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } ckfree(argv); return TCL_ERROR; } } /* -ttycontrol options loop */ ioctl(fsPtr->fd, TIOCMSET, &control); ckfree(argv); return TCL_OK; #else /* TIOCMGET&TIOCMSET */ UNSUPPORTED_OPTION("-ttycontrol"); #endif /* TIOCMGET&TIOCMSET */ } return Tcl_BadChannelOption(interp, optionName, "mode handshake timeout ttycontrol xchar"); } /* *---------------------------------------------------------------------- * * TtyGetOptionProc -- * * Gets a mode associated with an IO channel. If the optionName arg is * non-NULL, retrieves the value of that option. If the optionName arg is * NULL, retrieves a list of alternating option names and values for the * given channel. * * Results: * A standard Tcl result. Also sets the supplied DString to the string * value of the option(s) returned. Sets error message if needed * (by calling Tcl_BadChannelOption). * *---------------------------------------------------------------------- */ static int TtyGetOptionProc( ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { FileState *fsPtr = (FileState *)instanceData; size_t len; char buf[3*TCL_INTEGER_SPACE + 16]; int valid = 0; /* Flag if valid option parsed. */ if (optionName == NULL) { len = 0; } else { len = strlen(optionName); } if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-mode"); } if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) { TtyAttrs tty; valid = 1; TtyGetAttributes(fsPtr->fd, &tty); snprintf(buf, sizeof(buf), "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop); Tcl_DStringAppendElement(dsPtr, buf); } /* * Get option -xchar */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-xchar"); Tcl_DStringStartSublist(dsPtr); } if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) { struct termios iostate; Tcl_DString ds; valid = 1; tcgetattr(fsPtr->fd, &iostate); Tcl_DStringInit(&ds); Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); TclDStringClear(&ds); Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } if (len == 0) { Tcl_DStringEndSublist(dsPtr); } /* * Get option -queue * Option is readonly and returned by [fconfigure chan -queue] but not * returned by unnamed [fconfigure chan]. */ if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) { int inQueue=0, outQueue=0, inBuffered, outBuffered; valid = 1; GETREADQUEUE(fsPtr->fd, inQueue); GETWRITEQUEUE(fsPtr->fd, outQueue); inBuffered = Tcl_InputBuffered(fsPtr->channel); outBuffered = Tcl_OutputBuffered(fsPtr->channel); snprintf(buf, sizeof(buf), "%d", inBuffered+inQueue); Tcl_DStringAppendElement(dsPtr, buf); snprintf(buf, sizeof(buf), "%d", outBuffered+outQueue); Tcl_DStringAppendElement(dsPtr, buf); } #if defined(TIOCMGET) /* * Get option -ttystatus * Option is readonly and returned by [fconfigure chan -ttystatus] but not * returned by unnamed [fconfigure chan]. */ if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) { int status; valid = 1; ioctl(fsPtr->fd, TIOCMGET, &status); TtyModemStatusStr(status, dsPtr); } #endif /* TIOCMGET */ if (valid) { return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, "mode queue ttystatus xchar"); } static const struct {int baud; speed_t speed;} speeds[] = { #ifdef B0 {0, B0}, #endif #ifdef B50 {50, B50}, #endif #ifdef B75 {75, B75}, #endif #ifdef B110 {110, B110}, #endif #ifdef B134 {134, B134}, #endif #ifdef B150 {150, B150}, #endif #ifdef B200 {200, B200}, #endif #ifdef B300 {300, B300}, #endif #ifdef B600 {600, B600}, #endif #ifdef B1200 {1200, B1200}, #endif #ifdef B1800 {1800, B1800}, #endif #ifdef B2400 {2400, B2400}, #endif #ifdef B4800 {4800, B4800}, #endif #ifdef B9600 {9600, B9600}, #endif #ifdef B14400 {14400, B14400}, #endif #ifdef B19200 {19200, B19200}, #endif #ifdef EXTA {19200, EXTA}, #endif #ifdef B28800 {28800, B28800}, #endif #ifdef B38400 {38400, B38400}, #endif #ifdef EXTB {38400, EXTB}, #endif #ifdef B57600 {57600, B57600}, #endif #ifdef _B57600 {57600, _B57600}, #endif #ifdef B76800 {76800, B76800}, #endif #ifdef B115200 {115200, B115200}, #endif #ifdef _B115200 {115200, _B115200}, #endif #ifdef B153600 {153600, B153600}, #endif #ifdef B230400 {230400, B230400}, #endif #ifdef B307200 {307200, B307200}, #endif #ifdef B460800 {460800, B460800}, #endif #ifdef B500000 {500000, B500000}, #endif #ifdef B576000 {576000, B576000}, #endif #ifdef B921600 {921600, B921600}, #endif #ifdef B1000000 {1000000, B1000000}, #endif #ifdef B1152000 {1152000, B1152000}, #endif #ifdef B1500000 {1500000,B1500000}, #endif #ifdef B2000000 {2000000, B2000000}, #endif #ifdef B2500000 {2500000,B2500000}, #endif #ifdef B3000000 {3000000,B3000000}, #endif #ifdef B3500000 {3500000,B3500000}, #endif #ifdef B4000000 {4000000,B4000000}, #endif {-1, 0} }; /* *--------------------------------------------------------------------------- * * TtyGetSpeed -- * * Given an integer baud rate, get the speed_t value that should be * used to select that baud rate. * * Results: * As above. * *--------------------------------------------------------------------------- */ static speed_t TtyGetSpeed( int baud) /* The baud rate to look up. */ { int bestIdx, bestDiff, i, diff; bestIdx = 0; bestDiff = 1000000; /* * If the baud rate does not correspond to one of the known mask values, * choose the mask value whose baud rate is closest to the specified baud * rate. */ for (i = 0; speeds[i].baud >= 0; i++) { diff = speeds[i].baud - baud; if (diff < 0) { diff = -diff; } if (diff < bestDiff) { bestIdx = i; bestDiff = diff; } } return speeds[bestIdx].speed; } /* *--------------------------------------------------------------------------- * * TtyGetBaud -- * * Return the integer baud rate corresponding to a given speed_t value. * * Results: * As above. If the mask value was not recognized, 0 is returned. * *--------------------------------------------------------------------------- */ static int TtyGetBaud( speed_t speed) /* Speed mask value to look up. */ { int i; for (i = 0; speeds[i].baud >= 0; i++) { if (speeds[i].speed == speed) { return speeds[i].baud; } } return 0; } /* *--------------------------------------------------------------------------- * * TtyGetAttributes -- * * Get the current attributes of the specified serial device. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static void TtyGetAttributes( int fd, /* Open file descriptor for serial port to be * queried. */ TtyAttrs *ttyPtr) /* Buffer filled with serial port * attributes. */ { struct termios iostate; int baud, parity, data, stop; tcgetattr(fd, &iostate); baud = TtyGetBaud(cfgetospeed(&iostate)); parity = 'n'; #ifdef PAREXT switch ((int) (iostate.c_cflag & (PARENB | PARODD | PAREXT))) { case PARENB : parity = 'e'; break; case PARENB | PARODD : parity = 'o'; break; case PARENB | PAREXT : parity = 's'; break; case PARENB | PARODD | PAREXT : parity = 'm'; break; } #else /* !PAREXT */ switch ((int) (iostate.c_cflag & (PARENB | PARODD))) { case PARENB : parity = 'e'; break; case PARENB | PARODD : parity = 'o'; break; } #endif /* PAREXT */ data = iostate.c_cflag & CSIZE; data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8; stop = (iostate.c_cflag & CSTOPB) ? 2 : 1; ttyPtr->baud = baud; ttyPtr->parity = parity; ttyPtr->data = data; ttyPtr->stop = stop; } /* *--------------------------------------------------------------------------- * * TtySetAttributes -- * * Set the current attributes of the specified serial device. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static void TtySetAttributes( int fd, /* Open file descriptor for serial port to be * modified. */ TtyAttrs *ttyPtr) /* Buffer containing new attributes for serial * port. */ { struct termios iostate; int parity, data, flag; tcgetattr(fd, &iostate); cfsetospeed(&iostate, TtyGetSpeed(ttyPtr->baud)); cfsetispeed(&iostate, TtyGetSpeed(ttyPtr->baud)); flag = 0; parity = ttyPtr->parity; if (parity != 'n') { SET_BITS(flag, PARENB); #ifdef PAREXT CLEAR_BITS(iostate.c_cflag, PAREXT); if ((parity == 'm') || (parity == 's')) { SET_BITS(flag, PAREXT); } #endif /* PAREXT */ if ((parity == 'm') || (parity == 'o')) { SET_BITS(flag, PARODD); } } data = ttyPtr->data; SET_BITS(flag, (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8); if (ttyPtr->stop == 2) { SET_BITS(flag, CSTOPB); } CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | CSIZE | CSTOPB); SET_BITS(iostate.c_cflag, flag); tcsetattr(fd, TCSADRAIN, &iostate); } /* *--------------------------------------------------------------------------- * * TtyParseMode -- * * Parse the "-mode" argument to the fconfigure command. The argument is * of the form baud,parity,data,stop. * * Results: * The return value is TCL_OK if the argument was successfully parsed, * TCL_ERROR otherwise. If TCL_ERROR is returned, an error message is * left in the interp's result (if interp is non-NULL). * *--------------------------------------------------------------------------- */ static int TtyParseMode( Tcl_Interp *interp, /* If non-NULL, interp for error return. */ const char *mode, /* Mode string to be parsed. */ TtyAttrs *ttyPtr) /* Filled with data from mode string */ { int i, end; char parity; const char *bad = "bad value for -mode"; i = sscanf(mode, "%d,%c,%d,%d%n", &ttyPtr->baud, &parity, &ttyPtr->data, &ttyPtr->stop, &end); if ((i != 4) || (mode[end] != '\0')) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s: should be baud,parity,data,stop", bad)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } /* * Only allow setting mark/space parity on platforms that support it Make * sure to allow for the case where strchr is a macro. [Bug: 5089] * * We cannot if/else/endif the strchr arguments, it has to be the whole * function. On AIX this function is apparently a macro, and macros do * not allow preprocessor directives in their arguments. */ if ( #if defined(PAREXT) strchr("noems", parity) #else strchr("noe", parity) #endif /* PAREXT */ == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s parity: should be %s", bad, #if defined(PAREXT) "n, o, e, m, or s" #else "n, o, or e" #endif /* PAREXT */ )); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } ttyPtr->parity = parity; if ((ttyPtr->data < 5) || (ttyPtr->data > 8)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s data: should be 5, 6, 7, or 8", bad)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } if ((ttyPtr->stop < 0) || (ttyPtr->stop > 2)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s stop: should be 1 or 2", bad)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * TtyInit -- * * Given file descriptor that refers to a serial port, initialize the * serial port to a set of sane values so that Tcl can talk to a device * located on the serial port. * * Side effects: * Serial device initialized to non-blocking raw mode, similar to sockets * All other modes can be simulated on top of this in Tcl. * *--------------------------------------------------------------------------- */ static void TtyInit( int fd) /* Open file descriptor for serial port to be * initialized. */ { struct termios iostate; tcgetattr(fd, &iostate); if (iostate.c_iflag != IGNBRK || iostate.c_oflag != 0 || iostate.c_lflag != 0 || iostate.c_cflag & CREAD || iostate.c_cc[VMIN] != 1 || iostate.c_cc[VTIME] != 0) { iostate.c_iflag = IGNBRK; iostate.c_oflag = 0; iostate.c_lflag = 0; iostate.c_cflag |= CREAD; iostate.c_cc[VMIN] = 1; iostate.c_cc[VTIME] = 0; tcsetattr(fd, TCSADRAIN, &iostate); } } #endif /* SUPPORTS_TTY */ /* *---------------------------------------------------------------------- * * TclpOpenFileChannel -- * * Open an file based channel on Unix systems. * * Results: * The new channel or NULL. If NULL, the output argument errorCodePtr is * set to a POSIX error and an error message is left in the interp's * result if interp is not NULL. * * Side effects: * May open the channel and may cause creation of a file on the file * system. * *---------------------------------------------------------------------- */ Tcl_Channel TclpOpenFileChannel( Tcl_Interp *interp, /* Interpreter for error reporting; can be * NULL. */ Tcl_Obj *pathPtr, /* Name of file to open. */ int mode, /* POSIX open mode. */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { int fd, channelPermissions; FileState *fsPtr; const char *native, *translation; char channelName[16 + TCL_INTEGER_SPACE]; const Tcl_ChannelType *channelTypePtr; switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { case O_RDONLY: channelPermissions = TCL_READABLE; break; case O_WRONLY: channelPermissions = TCL_WRITABLE; break; case O_RDWR: channelPermissions = (TCL_READABLE | TCL_WRITABLE); break; default: /* * This may occurr if modeString was "", for example. */ Tcl_Panic("TclpOpenFileChannel: invalid mode value"); return NULL; } native = (const char *)Tcl_FSGetNativePath(pathPtr); if (native == NULL) { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), "\": filename is invalid on this platform", (char *)NULL); } return NULL; } #ifdef DJGPP SET_BITS(mode, O_BINARY); #endif fd = TclOSopen(native, mode, permissions); if (fd < 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": %s", TclGetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } /* * Set close-on-exec flag on the fd so that child processes will not * inherit this fd. */ fcntl(fd, F_SETFD, FD_CLOEXEC); snprintf(channelName, sizeof(channelName), "file%d", fd); #ifdef SUPPORTS_TTY if (strcmp(native, "/dev/tty") != 0 && isatty(fd)) { /* * Initialize the serial port to a set of sane parameters. Especially * important if the remote device is set to echo and the serial port * driver was also set to echo -- as soon as a char were sent to the * serial port, the remote device would echo it, then the serial * driver would echo it back to the device, etc. * * Note that we do not do this if we're dealing with /dev/tty itself, * as that tends to cause Bad Things To Happen when you're working * interactively. Strictly a better check would be to see if the FD * being set up is a device and has the same major/minor as the * initial std FDs (beware reopening!) but that's nearly as messy. */ translation = "auto crlf"; channelTypePtr = &ttyChannelType; TtyInit(fd); } else #endif /* SUPPORTS_TTY */ { translation = NULL; channelTypePtr = &fileChannelType; } fsPtr = (FileState *)ckalloc(sizeof(FileState)); fsPtr->validMask = channelPermissions | TCL_EXCEPTION; fsPtr->fd = fd; fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName, fsPtr, channelPermissions); if (translation != NULL) { /* * Gotcha. Most modems need a "\r" at the end of the command sequence. * If you just send "at\n", the modem will not respond with "OK" * because it never got a "\r" to actually invoke the command. So, by * default, newlines are translated to "\r\n" on output to avoid "bug" * reports that the serial port isn't working. */ if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation", translation) != TCL_OK) { Tcl_Close(NULL, fsPtr->channel); return NULL; } } return fsPtr->channel; } /* *---------------------------------------------------------------------- * * Tcl_MakeFileChannel -- * * Makes a Tcl_Channel from an existing OS level file handle. * * Results: * The Tcl_Channel created around the preexisting OS level file handle. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeFileChannel( ClientData handle, /* OS level handle. */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { FileState *fsPtr; char channelName[16 + TCL_INTEGER_SPACE]; int fd = PTR2INT(handle); const Tcl_ChannelType *channelTypePtr; struct stat buf; if (mode == 0) { return NULL; } #ifdef SUPPORTS_TTY if (isatty(fd)) { channelTypePtr = &ttyChannelType; snprintf(channelName, sizeof(channelName), "serial%d", fd); goto final; } else #endif /* SUPPORTS_TTY */ if (fstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) { struct sockaddr sockaddr; socklen_t sockaddrLen = sizeof(sockaddr); sockaddr.sa_family = AF_UNSPEC; if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) && (sockaddrLen > 0) && (sockaddr.sa_family == AF_INET || sockaddr.sa_family == AF_INET6)) { return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); } } channelTypePtr = &fileChannelType; snprintf(channelName, sizeof(channelName), "file%d", fd); final: fsPtr = (FileState *)ckalloc(sizeof(FileState)); fsPtr->fd = fd; fsPtr->validMask = mode | TCL_EXCEPTION; fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName, fsPtr, mode); return fsPtr->channel; } /* *---------------------------------------------------------------------- * * TclpGetDefaultStdChannel -- * * Creates channels for standard input, standard output or standard error * output if they do not already exist. * * Results: * Returns the specified default standard channel, or NULL. * * Side effects: * May cause the creation of a standard channel and the underlying file. * *---------------------------------------------------------------------- */ Tcl_Channel TclpGetDefaultStdChannel( int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */ { Tcl_Channel channel = NULL; int fd = 0; /* Initializations needed to prevent */ int mode = 0; /* compiler warning (used before set). */ const char *bufMode = NULL; /* * Some #def's to make the code a little clearer! */ #define ZERO_OFFSET ((Tcl_SeekOffset) 0) #define ERROR_OFFSET ((Tcl_SeekOffset) -1) switch (type) { case TCL_STDIN: if ((TclOSseek(0, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET) && (errno == EBADF)) { return NULL; } fd = 0; mode = TCL_READABLE; bufMode = "line"; break; case TCL_STDOUT: if ((TclOSseek(1, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET) && (errno == EBADF)) { return NULL; } fd = 1; mode = TCL_WRITABLE; bufMode = "line"; break; case TCL_STDERR: if ((TclOSseek(2, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET) && (errno == EBADF)) { return NULL; } fd = 2; mode = TCL_WRITABLE; bufMode = "none"; break; default: Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type"); break; } #undef ZERO_OFFSET #undef ERROR_OFFSET channel = Tcl_MakeFileChannel(INT2PTR(fd), mode); if (channel == NULL) { return NULL; } /* * Set up the normal channel options for stdio handles. */ if (Tcl_GetChannelType(channel) == &fileChannelType) { Tcl_SetChannelOption(NULL, channel, "-translation", "auto"); } else { Tcl_SetChannelOption(NULL, channel, "-translation", "auto crlf"); } Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode); return channel; } /* *---------------------------------------------------------------------- * * Tcl_GetOpenFile -- * * Given a name of a channel registered in the given interpreter, returns * a FILE * for it. * * Results: * A standard Tcl result. If the channel is registered in the given * interpreter and it is managed by the "file" channel driver, and it is * open for the requested mode, then the output parameter filePtr is set * to a FILE * for the underlying file. On error, the filePtr is not set, * TCL_ERROR is returned and an error message is left in the interp's * result. * * Side effects: * May invoke fdopen to create the FILE * for the requested file. * *---------------------------------------------------------------------- */ int Tcl_GetOpenFile( Tcl_Interp *interp, /* Interpreter in which to find file. */ const char *chanID, /* String that identifies file. */ int forWriting, /* 1 means the file is going to be used for * writing, 0 means for reading. */ int checkUsage, /* 1 means verify that the file was opened in * a mode that allows the access specified by * "forWriting". Ignored, we always check that * the channel is open for the requested * mode. */ ClientData *filePtr) /* Store pointer to FILE structure here. */ { Tcl_Channel chan; int chanMode, fd; const Tcl_ChannelType *chanTypePtr; ClientData data; FILE *f; chan = Tcl_GetChannel(interp, chanID, &chanMode); if (chan == NULL) { return TCL_ERROR; } if (forWriting && !(chanMode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" wasn't opened for writing", chanID)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_WRITABLE", (char *)NULL); return TCL_ERROR; } else if (!forWriting && !(chanMode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" wasn't opened for reading", chanID)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_READABLE", (char *)NULL); return TCL_ERROR; } /* * We allow creating a FILE * out of file based, pipe based and socket * based channels. We currently do not allow any other channel types, * because it is likely that stdio will not know what to do with them. */ chanTypePtr = Tcl_GetChannelType(chan); if ((chanTypePtr == &fileChannelType) #ifdef SUPPORTS_TTY || (chanTypePtr == &ttyChannelType) #endif /* SUPPORTS_TTY */ || (strcmp(chanTypePtr->typeName, "tcp") == 0) || (strcmp(chanTypePtr->typeName, "pipe") == 0)) { if (Tcl_GetChannelHandle(chan, (forWriting ? TCL_WRITABLE : TCL_READABLE), &data) == TCL_OK) { fd = PTR2INT(data); /* * The call to fdopen below is probably dangerous, since it will * truncate an existing file if the file is being opened for * writing.... */ f = fdopen(fd, (forWriting ? "w" : "r")); if (f == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot get a FILE * for \"%s\"", chanID)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "FILE_FAILURE", (char *)NULL); return TCL_ERROR; } *filePtr = f; return TCL_OK; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" cannot be used to get a FILE *", chanID)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NO_DESCRIPTOR", (char *)NULL); return TCL_ERROR; } #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is * in tclMacOSXNotify.c */ /* *---------------------------------------------------------------------- * * TclUnixWaitForFile -- * * This function waits synchronously for a file to become readable or * writable, with an optional timeout. * * Results: * The return value is an OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are * present on file at the time of the return. This function will not * return until either "timeout" milliseconds have elapsed or at least * one of the conditions given by mask has occurred for file (a return * value of 0 means that a timeout occurred). No normal events will be * serviced during the execution of this function. * * Side effects: * Time passes. * *---------------------------------------------------------------------- */ int TclUnixWaitForFile( int fd, /* Handle for file on which to wait. */ int mask, /* What to wait for: OR'ed combination of * TCL_READABLE, TCL_WRITABLE, and * TCL_EXCEPTION. */ int timeout) /* Maximum amount of time to wait for one of * the conditions in mask to occur, in * milliseconds. A value of 0 means don't wait * at all, and a value of -1 means wait * forever. */ { Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */ struct timeval blockTime, *timeoutPtr; int numFound, result = 0; fd_set readableMask; fd_set writableMask; fd_set exceptionMask; #ifndef _DARWIN_C_SOURCE /* * Sanity check fd. */ if (fd >= FD_SETSIZE) { Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd); /* must never get here, or select masks overrun will occur below */ } #endif /* * If there is a non-zero finite timeout, compute the time when we give * up. */ if (timeout > 0) { Tcl_GetTime(&now); abortTime.sec = now.sec + timeout/1000; abortTime.usec = now.usec + (timeout%1000)*1000; if (abortTime.usec >= 1000000) { abortTime.usec -= 1000000; abortTime.sec += 1; } timeoutPtr = &blockTime; } else if (timeout == 0) { timeoutPtr = &blockTime; blockTime.tv_sec = 0; blockTime.tv_usec = 0; } else { timeoutPtr = NULL; } /* * Initialize the select masks. */ FD_ZERO(&readableMask); FD_ZERO(&writableMask); FD_ZERO(&exceptionMask); /* * Loop in a mini-event loop of our own, waiting for either the file to * become ready or a timeout to occur. */ while (1) { if (timeout > 0) { blockTime.tv_sec = abortTime.sec - now.sec; blockTime.tv_usec = abortTime.usec - now.usec; if (blockTime.tv_usec < 0) { blockTime.tv_sec -= 1; blockTime.tv_usec += 1000000; } if (blockTime.tv_sec < 0) { blockTime.tv_sec = 0; blockTime.tv_usec = 0; } } /* * Setup the select masks for the fd. */ if (mask & TCL_READABLE) { FD_SET(fd, &readableMask); } if (mask & TCL_WRITABLE) { FD_SET(fd, &writableMask); } if (mask & TCL_EXCEPTION) { FD_SET(fd, &exceptionMask); } /* * Wait for the event or a timeout. */ numFound = select(fd + 1, &readableMask, &writableMask, &exceptionMask, timeoutPtr); if (numFound == 1) { if (FD_ISSET(fd, &readableMask)) { SET_BITS(result, TCL_READABLE); } if (FD_ISSET(fd, &writableMask)) { SET_BITS(result, TCL_WRITABLE); } if (FD_ISSET(fd, &exceptionMask)) { SET_BITS(result, TCL_EXCEPTION); } result &= mask; if (result) { break; } } if (timeout == 0) { break; } if (timeout < 0) { continue; } /* * The select returned early, so we need to recompute the timeout. */ Tcl_GetTime(&now); if ((abortTime.sec < now.sec) || (abortTime.sec==now.sec && abortTime.usec<=now.usec)) { break; } } return result; } #endif /* HAVE_COREFOUNDATION */ /* *---------------------------------------------------------------------- * * FileTruncateProc -- * * Truncates a file to a given length. * * Results: * 0 if the operation succeeded, and -1 if it failed (in which case * *errorCodePtr will be set to errno). * * Side effects: * The underlying file is potentially truncated. This can have a wide * variety of side effects, including moving file pointers that point at * places later in the file than the truncate point. * *---------------------------------------------------------------------- */ static int FileTruncateProc( ClientData instanceData, Tcl_WideInt length) { FileState *fsPtr = (FileState *)instanceData; int result; #ifdef HAVE_TYPE_OFF64_T /* * We assume this goes with the type for now... */ result = ftruncate64(fsPtr->fd, (off64_t) length); #else result = ftruncate(fsPtr->fd, (off_t) length); #endif if (result) { return errno; } return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixCompat.c0000644000175000017500000005667414554262142015605 0ustar sergeisergei/* * tclUnixCompat.c * * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net). * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include #include #include #include /* * See also: SC_BLOCKING_STYLE in unix/tcl.m4 */ #ifdef USE_FIONBIO # ifdef HAVE_SYS_FILIO_H # include /* For FIONBIO. */ # endif # ifdef HAVE_SYS_IOCTL_H # include # endif #endif /* USE_FIONBIO */ /* * Used to pad structures at size'd boundaries * * This macro assumes that the pointer 'buffer' was created from an aligned * pointer by adding the 'length'. If this 'length' was not a multiple of the * 'size' the result is unaligned and PadBuffer corrects both the pointer, * _and_ the 'length'. The latter means that future increments of 'buffer' by * 'length' stay aligned. */ #define PadBuffer(buffer, length, size) \ if (((length) % (size))) { \ (buffer) += ((size) - ((length) % (size))); \ (length) += ((size) - ((length) % (size))); \ } /* * Per-thread private storage used to store values returned from MT-unsafe * library calls. */ #ifdef TCL_THREADS typedef struct { struct passwd pwd; #if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5) #define NEED_PW_CLEANER 1 char *pbuf; int pbuflen; #else char pbuf[2048]; #endif struct group grp; #if defined(HAVE_GETGRNAM_R_5) || defined(HAVE_GETGRGID_R_5) #define NEED_GR_CLEANER 1 char *gbuf; int gbuflen; #else char gbuf[2048]; #endif #if !defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR) struct hostent hent; char hbuf[2048]; #endif } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #if ((!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || \ !defined(HAVE_MTSAFE_GETHOSTBYADDR))) || \ !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || \ !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) /* * Mutex to lock access to MT-unsafe calls. This is just to protect our own * usage. It does not protect us from others calling the same functions * without (or using some different) lock. */ static Tcl_Mutex compatLock; /* * Helper function declarations. Note that these are only used if needed and * only defined if used (via the NEED_* macros). */ #undef NEED_COPYARRAY #undef NEED_COPYGRP #undef NEED_COPYHOSTENT #undef NEED_COPYPWD #undef NEED_COPYSTRING #if !defined(HAVE_GETGRNAM_R_5) && !defined(HAVE_GETGRNAM_R_4) #define NEED_COPYGRP 1 static int CopyGrp(struct group *tgtPtr, char *buf, int buflen); #endif #if !defined(HAVE_GETPWNAM_R_5) && !defined(HAVE_GETPWNAM_R_4) #define NEED_COPYPWD 1 static int CopyPwd(struct passwd *tgtPtr, char *buf, int buflen); #endif static int CopyArray(char **src, int elsize, char *buf, int buflen); static int CopyHostent(struct hostent *tgtPtr, char *buf, int buflen); static int CopyString(const char *src, char *buf, int buflen); #endif #ifdef NEED_PW_CLEANER static void FreePwBuf(ClientData dummy); #endif #ifdef NEED_GR_CLEANER static void FreeGrBuf(ClientData dummy); #endif #endif /* TCL_THREADS */ /* *--------------------------------------------------------------------------- * * TclUnixSetBlockingMode -- * * Set the blocking mode of a file descriptor. * * Results: * * 0 on success, -1 (with errno set) on error. * *--------------------------------------------------------------------------- */ int TclUnixSetBlockingMode( int fd, /* File descriptor */ int mode) /* Either TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { #ifndef USE_FIONBIO int flags = fcntl(fd, F_GETFL); if (mode == TCL_MODE_BLOCKING) { flags &= ~O_NONBLOCK; } else { flags |= O_NONBLOCK; } return fcntl(fd, F_SETFL, flags); #else /* USE_FIONBIO */ int state = (mode == TCL_MODE_NONBLOCKING); return ioctl(fd, FIONBIO, &state); #endif /* !USE_FIONBIO */ } /* *--------------------------------------------------------------------------- * * TclpGetPwNam -- * * Thread-safe wrappers for getpwnam(). See "man getpwnam" for more * details. * * Results: * Pointer to struct passwd on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct passwd * TclpGetPwNam( const char *name) { #if !defined(TCL_THREADS) return getpwnam(name); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETPWNAM_R_5) struct passwd *pwPtr = NULL; /* * How to allocate a buffer of the right initial size. If you want the * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt * and weep. */ if (tsdPtr->pbuf == NULL) { tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX); if (tsdPtr->pbuflen < 1) { tsdPtr->pbuflen = 1024; } tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen); Tcl_CreateThreadExitHandler(FreePwBuf, NULL); } while (1) { int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen, &pwPtr); if (e == 0) { break; } else if (e != ERANGE) { return NULL; } tsdPtr->pbuflen *= 2; tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); } return (pwPtr != NULL ? &tsdPtr->pwd : NULL); #elif defined(HAVE_GETPWNAM_R_4) return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); #else struct passwd *pwPtr; Tcl_MutexLock(&compatLock); pwPtr = getpwnam(name); if (pwPtr != NULL) { tsdPtr->pwd = *pwPtr; pwPtr = &tsdPtr->pwd; if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) { pwPtr = NULL; } } Tcl_MutexUnlock(&compatLock); return pwPtr; #endif return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } /* *--------------------------------------------------------------------------- * * TclpGetPwUid -- * * Thread-safe wrappers for getpwuid(). See "man getpwuid" for more * details. * * Results: * Pointer to struct passwd on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct passwd * TclpGetPwUid( uid_t uid) { #if !defined(TCL_THREADS) return getpwuid(uid); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETPWUID_R_5) struct passwd *pwPtr = NULL; /* * How to allocate a buffer of the right initial size. If you want the * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt * and weep. */ if (tsdPtr->pbuf == NULL) { tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX); if (tsdPtr->pbuflen < 1) { tsdPtr->pbuflen = 1024; } tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen); Tcl_CreateThreadExitHandler(FreePwBuf, NULL); } while (1) { int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen, &pwPtr); if (e == 0) { break; } else if (e != ERANGE) { return NULL; } tsdPtr->pbuflen *= 2; tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); } return (pwPtr != NULL ? &tsdPtr->pwd : NULL); #elif defined(HAVE_GETPWUID_R_4) return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); #else struct passwd *pwPtr; Tcl_MutexLock(&compatLock); pwPtr = getpwuid(uid); if (pwPtr != NULL) { tsdPtr->pwd = *pwPtr; pwPtr = &tsdPtr->pwd; if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) { pwPtr = NULL; } } Tcl_MutexUnlock(&compatLock); return pwPtr; #endif return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } /* *--------------------------------------------------------------------------- * * FreePwBuf -- * * Helper that is used to dispose of space allocated and referenced from * the ThreadSpecificData for user entries. (Darn that baroque POSIX * reentrant interface.) * *--------------------------------------------------------------------------- */ #ifdef NEED_PW_CLEANER static void FreePwBuf( ClientData dummy) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)dummy; ckfree(tsdPtr->pbuf); } #endif /* NEED_PW_CLEANER */ /* *--------------------------------------------------------------------------- * * TclpGetGrNam -- * * Thread-safe wrappers for getgrnam(). See "man getgrnam" for more * details. * * Results: * Pointer to struct group on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct group * TclpGetGrNam( const char *name) { #if !defined(TCL_THREADS) return getgrnam(name); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETGRNAM_R_5) struct group *grPtr = NULL; /* * How to allocate a buffer of the right initial size. If you want the * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt * and weep. */ if (tsdPtr->gbuf == NULL) { tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX); if (tsdPtr->gbuflen < 1) { tsdPtr->gbuflen = 1024; } tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen); Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); } while (1) { int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen, &grPtr); if (e == 0) { break; } else if (e != ERANGE) { return NULL; } tsdPtr->gbuflen *= 2; tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); } return (grPtr != NULL ? &tsdPtr->grp : NULL); #elif defined(HAVE_GETGRNAM_R_4) return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); #else struct group *grPtr; Tcl_MutexLock(&compatLock); grPtr = getgrnam(name); if (grPtr != NULL) { tsdPtr->grp = *grPtr; grPtr = &tsdPtr->grp; if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) { grPtr = NULL; } } Tcl_MutexUnlock(&compatLock); return grPtr; #endif return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } /* *--------------------------------------------------------------------------- * * TclpGetGrGid -- * * Thread-safe wrappers for getgrgid(). See "man getgrgid" for more * details. * * Results: * Pointer to struct group on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct group * TclpGetGrGid( gid_t gid) { #if !defined(TCL_THREADS) return getgrgid(gid); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETGRGID_R_5) struct group *grPtr = NULL; /* * How to allocate a buffer of the right initial size. If you want the * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt * and weep. */ if (tsdPtr->gbuf == NULL) { tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX); if (tsdPtr->gbuflen < 1) { tsdPtr->gbuflen = 1024; } tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen); Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); } while (1) { int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen, &grPtr); if (e == 0) { break; } else if (e != ERANGE) { return NULL; } tsdPtr->gbuflen *= 2; tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); } return (grPtr != NULL ? &tsdPtr->grp : NULL); #elif defined(HAVE_GETGRGID_R_4) return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); #else struct group *grPtr; Tcl_MutexLock(&compatLock); grPtr = getgrgid(gid); if (grPtr != NULL) { tsdPtr->grp = *grPtr; grPtr = &tsdPtr->grp; if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) { grPtr = NULL; } } Tcl_MutexUnlock(&compatLock); return grPtr; #endif return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } /* *--------------------------------------------------------------------------- * * FreeGrBuf -- * * Helper that is used to dispose of space allocated and referenced from * the ThreadSpecificData for group entries. (Darn that baroque POSIX * reentrant interface.) * *--------------------------------------------------------------------------- */ #ifdef NEED_GR_CLEANER static void FreeGrBuf( ClientData dummy) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)dummy; ckfree(tsdPtr->gbuf); } #endif /* NEED_GR_CLEANER */ /* *--------------------------------------------------------------------------- * * TclpGetHostByName -- * * Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for * more details. * * Results: * Pointer to struct hostent on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct hostent * TclpGetHostByName( const char *name) { #if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME) return gethostbyname(name); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETHOSTBYNAME_R_5) int local_errno; return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &local_errno); #elif defined(HAVE_GETHOSTBYNAME_R_6) struct hostent *hePtr = NULL; int local_errno, result; result = gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &hePtr, &local_errno); return (result == 0) ? hePtr : NULL; #elif defined(HAVE_GETHOSTBYNAME_R_3) struct hostent_data data; return (gethostbyname_r(name, &tsdPtr->hent, &data) == 0) ? &tsdPtr->hent : NULL; #else #define NEED_COPYHOSTENT 1 struct hostent *hePtr; Tcl_MutexLock(&compatLock); hePtr = gethostbyname(name); if (hePtr != NULL) { tsdPtr->hent = *hePtr; hePtr = &tsdPtr->hent; if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf)) == -1) { hePtr = NULL; } } Tcl_MutexUnlock(&compatLock); return hePtr; #endif return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } /* *--------------------------------------------------------------------------- * * TclpGetHostByAddr -- * * Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for * more details. * * Results: * Pointer to struct hostent on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct hostent * TclpGetHostByAddr( const char *addr, int length, int type) { #if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR) return gethostbyaddr(addr, length, type); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETHOSTBYADDR_R_7) int local_errno; return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &local_errno); #elif defined(HAVE_GETHOSTBYADDR_R_8) struct hostent *hePtr; int local_errno; return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &hePtr, &local_errno) == 0) ? &tsdPtr->hent : NULL; #else #define NEED_COPYHOSTENT 1 struct hostent *hePtr; Tcl_MutexLock(&compatLock); hePtr = gethostbyaddr(addr, length, type); if (hePtr != NULL) { tsdPtr->hent = *hePtr; hePtr = &tsdPtr->hent; if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf)) == -1) { hePtr = NULL; } } Tcl_MutexUnlock(&compatLock); return hePtr; #endif return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } /* *--------------------------------------------------------------------------- * * CopyGrp -- * * Copies string fields of the group structure to the private buffer, * honouring the size of the buffer. * * Results: * 0 on success or -1 on error (errno = ERANGE). * * Side effects: * None. * *--------------------------------------------------------------------------- */ #ifdef NEED_COPYGRP #define NEED_COPYARRAY 1 #define NEED_COPYSTRING 1 static int CopyGrp( struct group *tgtPtr, char *buf, int buflen) { char *p = buf; int copied, len = 0; /* * Copy username. */ copied = CopyString(tgtPtr->gr_name, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->gr_name = (copied > 0) ? p : NULL; len += copied; p = buf + len; /* * Copy password. */ copied = CopyString(tgtPtr->gr_passwd, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->gr_passwd = (copied > 0) ? p : NULL; len += copied; p = buf + len; /* * Copy group members. */ PadBuffer(p, len, sizeof(char *)); copied = CopyArray((char **)tgtPtr->gr_mem, -1, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->gr_mem = (copied > 0) ? (char **)p : NULL; return 0; range: errno = ERANGE; return -1; } #endif /* NEED_COPYGRP */ /* *--------------------------------------------------------------------------- * * CopyHostent -- * * Copies string fields of the hostent structure to the private buffer, * honouring the size of the buffer. * * Results: * Number of bytes copied on success or -1 on error (errno = ERANGE) * * Side effects: * None * *--------------------------------------------------------------------------- */ #ifdef NEED_COPYHOSTENT #define NEED_COPYSTRING 1 #define NEED_COPYARRAY 1 static int CopyHostent( struct hostent *tgtPtr, char *buf, int buflen) { char *p = buf; int copied, len = 0; copied = CopyString(tgtPtr->h_name, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->h_name = (copied > 0) ? p : NULL; len += copied; p = buf + len; PadBuffer(p, len, sizeof(char *)); copied = CopyArray(tgtPtr->h_aliases, -1, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->h_aliases = (copied > 0) ? (char **)p : NULL; len += copied; p += len; PadBuffer(p, len, sizeof(char *)); copied = CopyArray(tgtPtr->h_addr_list, tgtPtr->h_length, p, buflen-len); if (copied == -1) { goto range; } tgtPtr->h_addr_list = (copied > 0) ? (char **)p : NULL; return 0; range: errno = ERANGE; return -1; } #endif /* NEED_COPYHOSTENT */ /* *--------------------------------------------------------------------------- * * CopyPwd -- * * Copies string fields of the passwd structure to the private buffer, * honouring the size of the buffer. * * Results: * 0 on success or -1 on error (errno = ERANGE). * * Side effects: * We are not copying the gecos field as it may not be supported on all * platforms. * *--------------------------------------------------------------------------- */ #ifdef NEED_COPYPWD #define NEED_COPYSTRING 1 static int CopyPwd( struct passwd *tgtPtr, char *buf, int buflen) { char *p = buf; int copied, len = 0; copied = CopyString(tgtPtr->pw_name, p, buflen - len); if (copied == -1) { range: errno = ERANGE; return -1; } tgtPtr->pw_name = (copied > 0) ? p : NULL; len += copied; p = buf + len; copied = CopyString(tgtPtr->pw_passwd, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->pw_passwd = (copied > 0) ? p : NULL; len += copied; p = buf + len; copied = CopyString(tgtPtr->pw_dir, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->pw_dir = (copied > 0) ? p : NULL; len += copied; p = buf + len; copied = CopyString(tgtPtr->pw_shell, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->pw_shell = (copied > 0) ? p : NULL; return 0; } #endif /* NEED_COPYPWD */ /* *--------------------------------------------------------------------------- * * CopyArray -- * * Copies array of NULL-terminated or fixed-length strings to the private * buffer, honouring the size of the buffer. * * Results: * Number of bytes copied on success or -1 on error (errno = ERANGE) * * Side effects: * None. * *--------------------------------------------------------------------------- */ #ifdef NEED_COPYARRAY static int CopyArray( char **src, /* Array of elements to copy. */ int elsize, /* Size of each element, or -1 to indicate * that they are C strings of dynamic * length. */ char *buf, /* Buffer to copy into. */ int buflen) /* Size of buffer. */ { int i, j, len = 0; char *p, **newBuffer; if (src == NULL) { return 0; } for (i = 0; src[i] != NULL; i++) { /* * Empty loop to count how many. */ } len = sizeof(char *) * (i + 1); /* Leave place for the array. */ if (len > buflen) { return -1; } newBuffer = (char **)buf; p = buf + len; for (j = 0; j < i; j++) { int sz = (elsize<0 ? (int) strlen(src[j]) + 1 : elsize); len += sz; if (len > buflen) { return -1; } memcpy(p, src[j], sz); newBuffer[j] = p; p = buf + len; } newBuffer[j] = NULL; return len; } #endif /* NEED_COPYARRAY */ /* *--------------------------------------------------------------------------- * * CopyString -- * * Copies a NULL-terminated string to the private buffer, honouring the * size of the buffer * * Results: * 0 success or -1 on error (errno = ERANGE) * * Side effects: * None * *--------------------------------------------------------------------------- */ #ifdef NEED_COPYSTRING static int CopyString( const char *src, /* String to copy. */ char *buf, /* Buffer to copy into. */ int buflen) /* Size of buffer. */ { int len = 0; if (src != NULL) { len = strlen(src) + 1; if (len > buflen) { return -1; } memcpy(buf, src, len); } return len; } #endif /* NEED_COPYSTRING */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ /* *------------------------------------------------------------------------ * * TclWinCPUID -- * * Get CPU ID information on an Intel box under UNIX (either Linux or Cygwin) * * Results: * Returns TCL_OK if successful, TCL_ERROR if CPUID is not supported. * * Side effects: * If successful, stores EAX, EBX, ECX and EDX registers after the CPUID * instruction in the four integers designated by 'regsPtr' * *---------------------------------------------------------------------- */ int TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve. */ unsigned int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; /* See: */ #if defined(HAVE_CPUID) #if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64) __asm__ __volatile__("movq %%rbx, %%rsi \n\t" /* save %rbx */ "cpuid \n\t" "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index)); status = TCL_OK; #elif defined(__i386__) || defined(_M_IX86) __asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */ "cpuid \n\t" "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index)); status = TCL_OK; #endif #endif return status; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixEvent.c0000644000175000017500000000424614554262142015427 0ustar sergeisergei/* * tclUnixEvent.c -- * * This file implements Unix specific event related routines. * * Copyright (c) 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is * in tclMacOSXNotify.c */ /* *---------------------------------------------------------------------- * * Tcl_Sleep -- * * Delay execution for the specified number of milliseconds. * * Results: * None. * * Side effects: * Time passes. * *---------------------------------------------------------------------- */ void Tcl_Sleep( int ms) /* Number of milliseconds to sleep. */ { struct timeval delay; Tcl_Time before, after, vdelay; /* * The only trick here is that select appears to return early under some * conditions, so we have to check to make sure that the right amount of * time really has elapsed. If it's too early, go back to sleep again. */ Tcl_GetTime(&before); after = before; after.sec += ms/1000; after.usec += (ms%1000)*1000; if (after.usec > 1000000) { after.usec -= 1000000; after.sec += 1; } while (1) { /* * TIP #233: Scale from virtual time to real-time for select. */ vdelay.sec = after.sec - before.sec; vdelay.usec = after.usec - before.usec; if (vdelay.usec < 0) { vdelay.usec += 1000000; vdelay.sec -= 1; } if ((vdelay.sec != 0) || (vdelay.usec != 0)) { tclScaleTimeProcPtr(&vdelay, tclTimeClientData); } delay.tv_sec = vdelay.sec; delay.tv_usec = vdelay.usec; /* * Special note: must convert delay.tv_sec to int before comparing to * zero, since delay.tv_usec is unsigned on some platforms. */ if ((((int) delay.tv_sec) < 0) || ((delay.tv_usec == 0) && (delay.tv_sec == 0))) { break; } (void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0, (SELECT_MASK *) 0, &delay); Tcl_GetTime(&before); } } #else TCL_MAC_EMPTY_FILE(unix_tclUnixEvent_c) #endif /* HAVE_COREFOUNDATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixFCmd.c0000644000175000017500000020236714554262142015163 0ustar sergeisergei/* * tclUnixFCmd.c * * This file implements the Unix specific portion of file manipulation * subcommands of the "file" command. All filename arguments should * already be translated to native format. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * Portions of this code were derived from NetBSD source code which has the * following copyright notice: * * Copyright (c) 1988, 1993, 1994 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * 1. Redistributions of source code must retain the above copyright notice, * this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the University nor the names of its contributors may * be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. */ #include "tclInt.h" #include #include #ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include #endif #endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */ #ifdef HAVE_FTS #include #endif /* * The following constants specify the type of callback when * TraverseUnixTree() calls the traverseProc() */ #define DOTREE_PRED 1 /* pre-order directory */ #define DOTREE_POSTD 2 /* post-order directory */ #define DOTREE_F 3 /* regular file */ /* * Fallback temporary file location the temporary file generation code. Can be * overridden at compile time for when it is known that temp files can't be * written to /tmp (hello, iOS!). */ #ifndef TCL_TEMPORARY_FILE_DIRECTORY #define TCL_TEMPORARY_FILE_DIRECTORY "/tmp" #endif /* * Callbacks for file attributes code. */ static int GetGroupAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); static int GetOwnerAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); static int GetPermissionsAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); static int SetGroupAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); static int SetOwnerAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); static int SetPermissionsAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); static int GetModeFromPermString(Tcl_Interp *interp, const char *modeStringPtr, mode_t *modePtr); #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) static int GetUnixFileAttributes(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); static int SetUnixFileAttributes(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); #endif /* * Prototype for the TraverseUnixTree callback function. */ typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, const Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr); /* * Constants and variables necessary for file attributes subcommand. * * IMPORTANT: The permissions attribute is assumed to be the third item (i.e. * to be indexed with '2' in arrays) in code in tclIOUtil.c and possibly * elsewhere in Tcl's core. */ #ifdef DJGPP /* * See contrib/djgpp/tclDjgppFCmd.c for definition. */ extern TclFileAttrProcs tclpFileAttrProcs[]; extern const char *const tclpFileAttrStrings[]; #else /* !DJGPP */ enum { #if defined(__CYGWIN__) UNIX_ARCHIVE_ATTRIBUTE, #endif UNIX_GROUP_ATTRIBUTE, #if defined(__CYGWIN__) UNIX_HIDDEN_ATTRIBUTE, #endif UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE, #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) UNIX_READONLY_ATTRIBUTE, #endif #if defined(__CYGWIN__) UNIX_SYSTEM_ATTRIBUTE, #endif #ifdef MAC_OSX_TCL MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE, MACOSX_RSRCLENGTH_ATTRIBUTE, #endif UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */ }; MODULE_SCOPE const char *const tclpFileAttrStrings[]; const char *const tclpFileAttrStrings[] = { #if defined(__CYGWIN__) "-archive", #endif "-group", #if defined(__CYGWIN__) "-hidden", #endif "-owner", "-permissions", #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) "-readonly", #endif #if defined(__CYGWIN__) "-system", #endif #ifdef MAC_OSX_TCL "-creator", "-type", "-hidden", "-rsrclength", #endif NULL }; MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; const TclFileAttrProcs tclpFileAttrProcs[] = { #if defined(__CYGWIN__) {GetUnixFileAttributes, SetUnixFileAttributes}, #endif {GetGroupAttribute, SetGroupAttribute}, #if defined(__CYGWIN__) {GetUnixFileAttributes, SetUnixFileAttributes}, #endif {GetOwnerAttribute, SetOwnerAttribute}, {GetPermissionsAttribute, SetPermissionsAttribute}, #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) {GetUnixFileAttributes, SetUnixFileAttributes}, #endif #if defined(__CYGWIN__) {GetUnixFileAttributes, SetUnixFileAttributes}, #endif #ifdef MAC_OSX_TCL {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, #endif }; #endif /* DJGPP */ /* * This is the maximum number of consecutive readdir/unlink calls that can be * made (with no intervening rewinddir or closedir/opendir) before triggering * a bug that makes readdir return NULL even though some directory entries * have not been processed. The bug afflicts SunOS's readdir when applied to * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We * can't do a general rewind on failure as NFS can create special files that * recreate themselves when you try and delete them. 8.4.8 added a solution * that was affected by a single such NFS file, this solution should not be * affected by less than THRESHOLD such files. [Bug 1034337] */ #define MAX_READDIR_UNLINK_THRESHOLD 130 /* * Declarations for local procedures defined in this file: */ static int CopyFileAtts(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); static const char * DefaultTempDir(void); static int DoCopyFile(const char *srcPtr, const char *dstPtr, const Tcl_StatBuf *statBufPtr); static int DoCreateDirectory(const char *pathPtr); static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); static int DoRenameFile(const char *src, const char *dst); static int TraversalCopy(Tcl_DString *srcPtr, Tcl_DString *dstPtr, const Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr); static int TraversalDelete(Tcl_DString *srcPtr, Tcl_DString *dstPtr, const Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr); static int TraverseUnixTree(TraversalProc *traversalProc, Tcl_DString *sourcePtr, Tcl_DString *destPtr, Tcl_DString *errorPtr, int doRewind); #ifdef PURIFY /* * realpath and purify don't mix happily. It has been noted that realpath * should not be used with purify because of bogus warnings, but just * memset'ing the resolved path will squelch those. This assumes we are * passing the standard MAXPATHLEN size resolved arg. */ static char * Realpath(const char *path, char *resolved); char * Realpath( const char *path, char *resolved) { memset(resolved, 0, MAXPATHLEN); return realpath(path, resolved); } #else # define Realpath realpath #endif /* PURIFY */ #ifndef NO_REALPATH #if defined(__APPLE__) && defined(TCL_THREADS) && \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* * Prior to Darwin 7, realpath is not thread-safe, c.f. Bug 711232; if we * might potentially be running on pre-10.3 OSX, check Darwin release at * runtime before using realpath. */ MODULE_SCOPE long tclMacOSXDarwinRelease; # define haveRealpath (tclMacOSXDarwinRelease >= 7) #else # define haveRealpath 1 #endif #endif /* NO_REALPATH */ #ifdef HAVE_FTS #if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) /* fts doesn't do stat64 */ # define noFtsStat 1 #elif defined(__APPLE__) && defined(__LP64__) && \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050 /* * Prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a * 64bit-unsafe ALIGN macro); if we could be running on pre-10.5 OSX, check * Darwin release at runtime and do a separate stat() if necessary. */ MODULE_SCOPE long tclMacOSXDarwinRelease; # define noFtsStat (tclMacOSXDarwinRelease < 9) #else # define noFtsStat 0 #endif #endif /* HAVE_FTS */ /* *--------------------------------------------------------------------------- * * TclpObjRenameFile, DoRenameFile -- * * Changes the name of an existing file or directory, from src to dst. If * src and dst refer to the same file or directory, does nothing and * returns success. Otherwise if dst already exists, it will be deleted * and replaced by src subject to the following conditions: * If src is a directory, dst may be an empty directory. * If src is a file, dst may be a file. * In any other situation where dst already exists, the rename will fail. * * Results: * If the directory was successfully created, returns TCL_OK. Otherwise * the return value is TCL_ERROR and errno is set to indicate the error. * Some possible values for errno are: * * EACCES: src or dst parent directory can't be read and/or written. * EEXIST: dst is a non-empty directory. * EINVAL: src is a root directory or dst is a subdirectory of src. * EISDIR: dst is a directory, but src is not. * ENOENT: src doesn't exist, or src or dst is "". * ENOTDIR: src is a directory, but dst is not. * EXDEV: src and dst are on different filesystems. * * Side effects: * The implementation of rename may allow cross-filesystem renames, but * the caller should be prepared to emulate it with copy and delete if * errno is EXDEV. * *--------------------------------------------------------------------------- */ int TclpObjRenameFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), Tcl_FSGetNativePath(destPathPtr)); } static int DoRenameFile( const char *src, /* Pathname of file or dir to be renamed * (native). */ const char *dst) /* New pathname of file or directory * (native). */ { if (rename(src, dst) == 0) { /* INTL: Native. */ return TCL_OK; } if (errno == ENOTEMPTY) { errno = EEXIST; } /* * IRIX returns EIO when you attempt to move a directory into itself. We * just map EIO to EINVAL get the right message on SGI. Most platforms * don't return EIO except in really strange cases. */ if (errno == EIO) { errno = EINVAL; } #ifndef NO_REALPATH /* * SunOS 4.1.4 reports overwriting a non-empty directory with a directory * as EINVAL instead of EEXIST (first rule out the correct EINVAL result * code for moving a directory into itself). Must be conditionally * compiled because realpath() not defined on all systems. */ if (errno == EINVAL && haveRealpath) { char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN]; TclDIR *dirPtr; Tcl_DirEntry *dirEntPtr; if ((Realpath((char *) src, srcPath) != NULL) /* INTL: Native. */ && (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native */ && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) { dirPtr = TclOSopendir(dst); /* INTL: Native. */ if (dirPtr != NULL) { while (1) { dirEntPtr = TclOSreaddir(dirPtr); /* INTL: Native. */ if (dirEntPtr == NULL) { break; } if ((strcmp(dirEntPtr->d_name, ".") != 0) && (strcmp(dirEntPtr->d_name, "..") != 0)) { errno = EEXIST; TclOSclosedir(dirPtr); return TCL_ERROR; } } TclOSclosedir(dirPtr); } } errno = EINVAL; } #endif /* !NO_REALPATH */ if (strcmp(src, "/") == 0) { /* * Alpha reports renaming / as EBUSY and Linux reports it as EACCES, * instead of EINVAL. */ errno = EINVAL; } /* * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a file * across filesystems and the parent directory of that file is not * writable. Most other systems return EXDEV. Does nothing to correct this * behavior. */ return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * TclpObjCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and is not * a directory, it is removed. * * Results: * If the file was successfully copied, returns TCL_OK. Otherwise the * return value is TCL_ERROR and errno is set to indicate the error. Some * possible values for errno are: * * EACCES: src or dst parent directory can't be read and/or written. * EISDIR: src or dst is a directory. * ENOENT: src doesn't exist. src or dst is "". * * Side effects: * This procedure will also copy symbolic links, block, and character * devices, and fifos. For symbolic links, the links themselves will be * copied and not what they point to. For the other special file types, * the directory entry will be copied and not the contents of the device * that it refers to. * *--------------------------------------------------------------------------- */ int TclpObjCopyFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { const char *src = Tcl_FSGetNativePath(srcPathPtr); Tcl_StatBuf srcStatBuf; if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ return TCL_ERROR; } return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf); } static int DoCopyFile( const char *src, /* Pathname of file to be copied (native). */ const char *dst, /* Pathname of file to copy to (native). */ const Tcl_StatBuf *statBufPtr) /* Used to determine filetype. */ { Tcl_StatBuf dstStatBuf; if (S_ISDIR(statBufPtr->st_mode)) { errno = EISDIR; return TCL_ERROR; } /* * Symlink, and some of the other calls will fail if the target exists, so * we remove it first. */ if (TclOSlstat(dst, &dstStatBuf) == 0) { /* INTL: Native. */ if (S_ISDIR(dstStatBuf.st_mode)) { errno = EISDIR; return TCL_ERROR; } } if (unlink(dst) != 0) { /* INTL: Native. */ if (errno != ENOENT) { return TCL_ERROR; } } switch ((int) (statBufPtr->st_mode & S_IFMT)) { #ifndef DJGPP case S_IFLNK: { char linkBuf[MAXPATHLEN+1]; int length; length = readlink(src, linkBuf, MAXPATHLEN); /* INTL: Native. */ if (length == -1) { return TCL_ERROR; } linkBuf[length] = '\0'; if (symlink(linkBuf, dst) < 0) { /* INTL: Native. */ return TCL_ERROR; } #ifdef MAC_OSX_TCL TclMacOSXCopyFileAttributes(src, dst, statBufPtr); #endif break; } #endif /* !DJGPP */ case S_IFBLK: case S_IFCHR: if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */ statBufPtr->st_rdev) < 0) { return TCL_ERROR; } return CopyFileAtts(src, dst, statBufPtr); case S_IFIFO: if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */ return TCL_ERROR; } return CopyFileAtts(src, dst, statBufPtr); default: return TclUnixCopyFile(src, dst, statBufPtr, 0); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclUnixCopyFile - * * Helper function for TclpCopyFile. Copies one regular file, using * read() and write(). * * Results: * A standard Tcl result. * * Side effects: * A file is copied. Dst will be overwritten if it exists. * *---------------------------------------------------------------------- */ int TclUnixCopyFile( const char *src, /* Pathname of file to copy (native). */ const char *dst, /* Pathname of file to create/overwrite * (native). */ const Tcl_StatBuf *statBufPtr, /* Used to determine mode and blocksize. */ int dontCopyAtts) /* If flag set, don't copy attributes. */ { int srcFd, dstFd; unsigned blockSize; /* Optimal I/O blocksize for filesystem */ char *buffer; /* Data buffer for copy */ size_t nread; #ifdef DJGPP #define BINMODE |O_BINARY #else #define BINMODE #endif /* DJGPP */ #define DEFAULT_COPY_BLOCK_SIZE 4096 if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native */ return TCL_ERROR; } dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY BINMODE, /* INTL: Native */ statBufPtr->st_mode); if (dstFd < 0) { close(srcFd); return TCL_ERROR; } /* * Try to work out the best size of buffer to use for copying. If we * can't, it's no big deal as we can just use a (32-bit) page, since * that's likely to be fairly efficient anyway. */ #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE blockSize = statBufPtr->st_blksize; #elif !defined(NO_FSTATFS) { struct statfs fs; if (fstatfs(srcFd, &fs) == 0) { blockSize = fs.f_bsize; } else { blockSize = DEFAULT_COPY_BLOCK_SIZE; } } #else blockSize = DEFAULT_COPY_BLOCK_SIZE; #endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */ /* * [SF Tcl Bug 1586470] Even if we HAVE_STRUCT_STAT_ST_BLKSIZE, there are * filesystems which report a bogus value for the blocksize. An example * is the Andrew Filesystem (afs), reporting a blocksize of 0. When * detecting such a situation we now simply fall back to a hardwired * default size. */ if (blockSize <= 0) { blockSize = DEFAULT_COPY_BLOCK_SIZE; } buffer = ckalloc(blockSize); while (1) { nread = (size_t) read(srcFd, buffer, blockSize); if ((nread == (size_t) -1) || (nread == 0)) { break; } if ((size_t) write(dstFd, buffer, nread) != nread) { nread = (size_t) -1; break; } } ckfree(buffer); close(srcFd); if ((close(dstFd) != 0) || (nread == (size_t) -1)) { unlink(dst); /* INTL: Native. */ return TCL_ERROR; } if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) { /* * The copy succeeded, but setting the permissions failed, so be in a * consistent state, we remove the file that was created by the copy. */ unlink(dst); /* INTL: Native. */ return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclpObjDeleteFile, TclpDeleteFile -- * * Removes a single file (not a directory). * * Results: * If the file was successfully deleted, returns TCL_OK. Otherwise the * return value is TCL_ERROR and errno is set to indicate the error. Some * possible values for errno are: * * EACCES: a parent directory can't be read and/or written. * EISDIR: path is a directory. * ENOENT: path doesn't exist or is "". * * Side effects: * The file is deleted, even if it is read-only. * *--------------------------------------------------------------------------- */ int TclpObjDeleteFile( Tcl_Obj *pathPtr) { return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr)); } int TclpDeleteFile( const void *path) /* Pathname of file to be removed (native). */ { if (unlink((const char *)path) != 0) { return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclpCreateDirectory, DoCreateDirectory -- * * Creates the specified directory. All parent directories of the * specified directory must already exist. The directory is automatically * created with permissions so that user can access the new directory and * create new files or subdirectories in it. * * Results: * If the directory was successfully created, returns TCL_OK. Otherwise * the return value is TCL_ERROR and errno is set to indicate the error. * Some possible values for errno are: * * EACCES: a parent directory can't be read and/or written. * EEXIST: path already exists. * ENOENT: a parent directory doesn't exist. * * Side effects: * A directory is created with the current umask, except that permission * for u+rwx will always be added. * *--------------------------------------------------------------------------- */ int TclpObjCreateDirectory( Tcl_Obj *pathPtr) { return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int DoCreateDirectory( const char *path) /* Pathname of directory to create (native). */ { mode_t mode; mode = umask(0); umask(mode); /* * umask return value is actually the inverse of the permissions. */ mode = (0777 & ~mode) | S_IRUSR | S_IWUSR | S_IXUSR; if (mkdir(path, mode) != 0) { /* INTL: Native. */ return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclpObjCopyDirectory -- * * Recursively copies a directory. The target directory dst must not * already exist. Note that this function does not merge two directory * hierarchies, even if the target directory is an empty directory. * * Results: * If the directory was successfully copied, returns TCL_OK. Otherwise * the return value is TCL_ERROR, errno is set to indicate the error, and * the pathname of the file that caused the error is stored in errorPtr. * See TclpObjCreateDirectory and TclpObjCopyFile for a description of * possible values for errno. * * Side effects: * An exact copy of the directory hierarchy src will be created with the * name dst. If an error occurs, the error will be returned immediately, * and remaining files will not be processed. * *--------------------------------------------------------------------------- */ int TclpObjCopyDirectory( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_DString srcString, dstString; int ret; Tcl_Obj *transPtr; transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); Tcl_UtfToExternalDString(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, &srcString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); Tcl_UtfToExternalDString(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, &dstString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); if (ret != TCL_OK) { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } return ret; } /* *--------------------------------------------------------------------------- * * TclpRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * * Results: * If the directory was successfully removed, returns TCL_OK. Otherwise * the return value is TCL_ERROR, errno is set to indicate the error, and * the pathname of the file that caused the error is stored in errorPtr. * Some possible values for errno are: * * EACCES: path directory can't be read and/or written. * EEXIST: path is a non-empty directory. * EINVAL: path is a root directory. * ENOENT: path doesn't exist or is "". * ENOTDIR: path is not a directory. * * Side effects: * Directory removed. If an error occurs, the error will be returned * immediately, and remaining files will not be deleted. * *--------------------------------------------------------------------------- */ int TclpObjRemoveDirectory( Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_DString pathString; int ret; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); Tcl_UtfToExternalDString(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, &pathString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } ret = DoRemoveDirectory(&pathString, recursive, &ds); Tcl_DStringFree(&pathString); if (ret != TCL_OK) { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } return ret; } static int DoRemoveDirectory( Tcl_DString *pathPtr, /* Pathname of directory to be removed * (native). */ int recursive, /* If non-zero, removes directories that are * nonempty. Otherwise, will only remove empty * directories. */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { const char *path; mode_t oldPerm = 0; int result; path = Tcl_DStringValue(pathPtr); if (recursive != 0) { /* * We should try to change permissions so this can be deleted. */ Tcl_StatBuf statBuf; int newPerm; if (TclOSstat(path, &statBuf) == 0) { oldPerm = (mode_t) (statBuf.st_mode & 0x00007FFF); } newPerm = oldPerm | (64+128+256); chmod(path, (mode_t) newPerm); } if (rmdir(path) == 0) { /* INTL: Native. */ return TCL_OK; } if (errno == ENOTEMPTY) { errno = EEXIST; } result = TCL_OK; if ((errno != EEXIST) || (recursive == 0)) { if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, path, -1, errorPtr); } result = TCL_ERROR; } /* * The directory is nonempty, but the recursive flag has been specified, * so we recursively remove all the files in the directory. */ if (result == TCL_OK) { result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr, 1); } if ((result != TCL_OK) && (recursive != 0)) { /* * Try to restore permissions. */ chmod(path, oldPerm); } return result; } /* *--------------------------------------------------------------------------- * * TraverseUnixTree -- * * Traverse directory tree specified by sourcePtr, calling the function * traverseProc for each file and directory encountered. If destPtr is * non-null, each of name in the sourcePtr directory is appended to the * directory specified by destPtr and passed as the second argument to * traverseProc(). * * Results: * Standard Tcl result. * * Side effects: * None caused by TraverseUnixTree, however the user specified * traverseProc() may change state. If an error occurs, the error will be * returned immediately, and remaining files will not be processed. * *--------------------------------------------------------------------------- */ static int TraverseUnixTree( TraversalProc *traverseProc,/* Function to call for every file and * directory in source hierarchy. */ Tcl_DString *sourcePtr, /* Pathname of source directory to be * traversed (native). */ Tcl_DString *targetPtr, /* Pathname of directory to traverse in * parallel with source directory (native). */ Tcl_DString *errorPtr, /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ int doRewind) /* Flag indicating that to ensure complete * traversal of source hierarchy, the readdir * loop should be rewound whenever * traverseProc has returned TCL_OK; this is * required when traverseProc modifies the * source hierarchy, e.g. by deleting * files. */ { Tcl_StatBuf statBuf; const char *source, *errfile; int result, sourceLen; int targetLen; #ifndef HAVE_FTS int numProcessed = 0; Tcl_DirEntry *dirEntPtr; TclDIR *dirPtr; #else const char *paths[2] = {NULL, NULL}; FTS *fts = NULL; FTSENT *ent; #endif errfile = NULL; result = TCL_OK; targetLen = 0; /* lint. */ source = Tcl_DStringValue(sourcePtr); if (TclOSlstat(source, &statBuf) != 0) { /* INTL: Native. */ errfile = source; goto end; } if (!S_ISDIR(statBuf.st_mode)) { /* * Process the regular file */ return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F, errorPtr); } #ifndef HAVE_FTS dirPtr = TclOSopendir(source); /* INTL: Native. */ if (dirPtr == NULL) { /* * Can't read directory */ errfile = source; goto end; } result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, errorPtr); if (result != TCL_OK) { TclOSclosedir(dirPtr); return result; } TclDStringAppendLiteral(sourcePtr, "/"); sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { TclDStringAppendLiteral(targetPtr, "/"); targetLen = Tcl_DStringLength(targetPtr); } while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */ if ((dirEntPtr->d_name[0] == '.') && ((dirEntPtr->d_name[1] == '\0') || (strcmp(dirEntPtr->d_name, "..") == 0))) { continue; } /* * Append name after slash, and recurse on the file. */ Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1); if (targetPtr != NULL) { Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1); } result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind); if (result != TCL_OK) { break; } else { numProcessed++; } /* * Remove name after slash. */ Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, targetLen); } if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) { /* * Call rewinddir if we've called unlink or rmdir so many times * (since the opendir or the previous rewinddir), to avoid a * NULL-return that may a symptom of a buggy readdir. */ TclOSrewinddir(dirPtr); numProcessed = 0; } } TclOSclosedir(dirPtr); /* * Strip off the trailing slash we added */ Tcl_DStringSetLength(sourcePtr, sourceLen - 1); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, targetLen - 1); } if (result == TCL_OK) { /* * Call traverseProc() on a directory after visiting all the files in * that directory. */ result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD, errorPtr); } #else /* HAVE_FTS */ paths[0] = source; fts = fts_open((char **) paths, FTS_PHYSICAL | FTS_NOCHDIR | (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); if (fts == NULL) { errfile = source; goto end; } sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { targetLen = Tcl_DStringLength(targetPtr); } while ((ent = fts_read(fts)) != NULL) { unsigned short info = ent->fts_info; char *path = ent->fts_path + sourceLen; unsigned short pathlen = ent->fts_pathlen - sourceLen; int type; Tcl_StatBuf *statBufPtr = NULL; if (info == FTS_DNR || info == FTS_ERR || info == FTS_NS) { errfile = ent->fts_path; break; } Tcl_DStringAppend(sourcePtr, path, pathlen); if (targetPtr != NULL) { Tcl_DStringAppend(targetPtr, path, pathlen); } switch (info) { case FTS_D: type = DOTREE_PRED; break; case FTS_DP: type = DOTREE_POSTD; break; default: type = DOTREE_F; break; } if (!doRewind) { /* no need to stat for delete */ if (noFtsStat) { statBufPtr = &statBuf; if (TclOSlstat(ent->fts_path, statBufPtr) != 0) { errfile = ent->fts_path; break; } } else { statBufPtr = (Tcl_StatBuf *) ent->fts_statp; } } result = traverseProc(sourcePtr, targetPtr, statBufPtr, type, errorPtr); if (result != TCL_OK) { break; } Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, targetLen); } } #endif /* !HAVE_FTS */ end: if (errfile != NULL) { if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr); } result = TCL_ERROR; } #ifdef HAVE_FTS if (fts != NULL) { fts_close(fts); } #endif return result; } /* *---------------------------------------------------------------------- * * TraversalCopy * * Called from TraverseUnixTree in order to execute a recursive copy of a * directory. * * Results: * Standard Tcl result. * * Side effects: * The file or directory src may be copied to dst, depending on the value * of type. * *---------------------------------------------------------------------- */ static int TraversalCopy( Tcl_DString *srcPtr, /* Source pathname to copy (native). */ Tcl_DString *dstPtr, /* Destination pathname of copy (native). */ const Tcl_StatBuf *statBufPtr, /* Stat info for file specified by srcPtr. */ int type, /* Reason for call - see TraverseUnixTree(). */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { switch (type) { case DOTREE_F: if (DoCopyFile(Tcl_DStringValue(srcPtr), Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) { return TCL_OK; } break; case DOTREE_PRED: if (DoCreateDirectory(Tcl_DStringValue(dstPtr)) == TCL_OK) { return TCL_OK; } break; case DOTREE_POSTD: if (CopyFileAtts(Tcl_DStringValue(srcPtr), Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) { return TCL_OK; } break; } /* * There shouldn't be a problem with src, because we already checked it to * get here. */ if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(dstPtr), Tcl_DStringLength(dstPtr), errorPtr); } return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * TraversalDelete -- * * Called by procedure TraverseUnixTree for every file and directory that * it encounters in a directory hierarchy. This procedure unlinks files, * and removes directories after all the containing files have been * processed. * * Results: * Standard Tcl result. * * Side effects: * Files or directory specified by src will be deleted. * *---------------------------------------------------------------------- */ static int TraversalDelete( Tcl_DString *srcPtr, /* Source pathname (native). */ Tcl_DString *ignore, /* Destination pathname (not used). */ const Tcl_StatBuf *statBufPtr, /* Stat info for file specified by srcPtr. */ int type, /* Reason for call - see TraverseUnixTree(). */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { switch (type) { case DOTREE_F: if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { return TCL_OK; } break; case DOTREE_PRED: return TCL_OK; case DOTREE_POSTD: if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) { return TCL_OK; } break; } if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr), Tcl_DStringLength(srcPtr), errorPtr); } return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * CopyFileAtts -- * * Copy the file attributes such as owner, group, permissions, and * modification date from one file to another. * * Results: * Standard Tcl result. * * Side effects: * User id, group id, permission bits, last modification time, and last * access time are updated in the new file to reflect the old file. * *--------------------------------------------------------------------------- */ static int CopyFileAtts( const char *src, /* Path name of source file (native). */ const char *dst, /* Path name of target file (native). */ const Tcl_StatBuf *statBufPtr) /* Stat info for source file */ { struct utimbuf tval; mode_t newMode; newMode = statBufPtr->st_mode & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO); /* * Note that if you copy a setuid file that is owned by someone else, and * you are not root, then the copy will be setuid to you. The most correct * implementation would probably be to have the copy not setuid to anyone * if the original file was owned by someone else, but this corner case * isn't currently handled. It would require another lstat(), or getuid(). */ if (chmod(dst, newMode)) { /* INTL: Native. */ newMode &= ~(S_ISUID | S_ISGID); if (chmod(dst, newMode)) { /* INTL: Native. */ return TCL_ERROR; } } tval.actime = statBufPtr->st_atime; tval.modtime = statBufPtr->st_mtime; if (utime(dst, &tval)) { /* INTL: Native. */ return TCL_ERROR; } #ifdef MAC_OSX_TCL TclMacOSXCopyFileAttributes(src, dst, statBufPtr); #endif return TCL_OK; } /* *---------------------------------------------------------------------- * * GetGroupAttribute * * Gets the group attribute of a file. * * Results: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there * is no error. * * Side effects: * A new object is allocated. * *---------------------------------------------------------------------- */ static int GetGroupAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; struct group *groupPtr; int result; result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } groupPtr = TclpGetGrGid(statBuf.st_gid); if (groupPtr == NULL) { TclNewIntObj(*attributePtrPtr, (int) statBuf.st_gid); } else { Tcl_DString ds; const char *utf; utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds); *attributePtrPtr = Tcl_NewStringObj(utf, -1); Tcl_DStringFree(&ds); } return TCL_OK; } /* *---------------------------------------------------------------------- * * GetOwnerAttribute * * Gets the owner attribute of a file. * * Results: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there * is no error. * * Side effects: * A new object is allocated. * *---------------------------------------------------------------------- */ static int GetOwnerAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; struct passwd *pwPtr; int result; result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } pwPtr = TclpGetPwUid(statBuf.st_uid); if (pwPtr == NULL) { TclNewIntObj(*attributePtrPtr, (int) statBuf.st_uid); } else { Tcl_DString ds; (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); *attributePtrPtr = TclDStringToObj(&ds); } return TCL_OK; } /* *---------------------------------------------------------------------- * * GetPermissionsAttribute * * Gets the group attribute of a file. * * Results: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there * is no error. The object will have ref count 0. * * Side effects: * A new object is allocated. * *---------------------------------------------------------------------- */ static int GetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; int result; result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } *attributePtrPtr = Tcl_ObjPrintf( "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF)); return TCL_OK; } /* *--------------------------------------------------------------------------- * * SetGroupAttribute -- * * Sets the group of the file to the specified group. * * Results: * Standard TCL result. * * Side effects: * As above. * *--------------------------------------------------------------------------- */ static int SetGroupAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New group for file. */ { long gid; int result; const char *native; if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr = NULL; const char *string; int length; string = Tcl_GetStringFromObj(attributePtr, &length); native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (groupPtr == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set group for file \"%s\":" " group \"%s\" does not exist", TclGetString(fileName), string)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP", "NO_GROUP", NULL); } return TCL_ERROR; } gid = groupPtr->gr_gid; } native = Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set group for file \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * SetOwnerAttribute -- * * Sets the owner of the file to the specified owner. * * Results: * Standard TCL result. * * Side effects: * As above. * *--------------------------------------------------------------------------- */ static int SetOwnerAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New owner for file. */ { long uid; int result; const char *native; if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; int length; string = Tcl_GetStringFromObj(attributePtr, &length); native = Tcl_UtfToExternalDString(NULL, string, length, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set owner for file \"%s\":" " user \"%s\" does not exist", TclGetString(fileName), string)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN", "NO_USER", NULL); } return TCL_ERROR; } uid = pwPtr->pw_uid; } native = Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set owner for file \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * SetPermissionsAttribute * * Sets the file to the given permission. * * Results: * Standard TCL result. * * Side effects: * The permission of the file is changed. * *--------------------------------------------------------------------------- */ static int SetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* The attribute to set. */ { long mode; mode_t newMode; int result = TCL_ERROR; const char *native; const char *modeStringPtr = TclGetString(attributePtr); int scanned = TclParseAllWhiteSpace(modeStringPtr, -1); /* * First supply support for octal number format */ if ((modeStringPtr[scanned] == '0') && (modeStringPtr[scanned+1] >= '0') && (modeStringPtr[scanned+1] <= '7')) { /* Leading zero - attempt octal interpretation */ Tcl_Obj *modeObj; TclNewLiteralStringObj(modeObj, "0o"); Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1); result = Tcl_GetLongFromObj(NULL, modeObj, &mode); Tcl_DecrRefCount(modeObj); } if (result == TCL_OK || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { newMode = (mode_t) (mode & 0x00007FFF); } else { Tcl_StatBuf buf; /* * Try the forms "rwxrwxrwx" and "ugo=rwx" * * We get the current mode of the file, in order to allow for ug+-=rwx * style chmod strings. */ result = TclpObjStat(fileName, &buf); if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } newMode = (mode_t) (buf.st_mode & 0x00007FFF); if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown permission string format \"%s\"", modeStringPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL); } return TCL_ERROR; } } native = Tcl_FSGetNativePath(fileName); result = chmod(native, newMode); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set permissions for file \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } #ifndef DJGPP /* *--------------------------------------------------------------------------- * * TclpObjListVolumes -- * * Lists the currently mounted volumes, which on UNIX is just /. * * Results: * The list of volumes. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclpObjListVolumes(void) { Tcl_Obj *resultPtr; TclNewLiteralStringObj(resultPtr, "/"); Tcl_IncrRefCount(resultPtr); return resultPtr; } #endif /* *---------------------------------------------------------------------- * * GetModeFromPermString -- * * This procedure is invoked to process the "file permissions" Tcl * command, to check for a "rwxrwxrwx" or "ugoa+-=rwxst" string. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int GetModeFromPermString( Tcl_Interp *interp, /* The interp we are using for errors. */ const char *modeStringPtr, /* Permissions string */ mode_t *modePtr) /* pointer to the mode value */ { mode_t newMode; mode_t oldMode; /* Storage for the value of the old mode (that * is passed in), to allow for the chmod style * manipulation. */ int i,n, who, op, what, op_found, who_found; /* * We start off checking for an "rwxrwxrwx" style permissions string */ if (strlen(modeStringPtr) != 9) { goto chmodStyleCheck; } newMode = 0; for (i = 0; i < 9; i++) { switch (*(modeStringPtr+i)) { case 'r': if ((i%3) != 0) { goto chmodStyleCheck; } newMode |= (1<<(8-i)); break; case 'w': if ((i%3) != 1) { goto chmodStyleCheck; } newMode |= (1<<(8-i)); break; case 'x': if ((i%3) != 2) { goto chmodStyleCheck; } newMode |= (1<<(8-i)); break; case 's': if (((i%3) != 2) || (i > 5)) { goto chmodStyleCheck; } newMode |= (1<<(8-i)); newMode |= (1<<(11-(i/3))); break; case 'S': if (((i%3) != 2) || (i > 5)) { goto chmodStyleCheck; } newMode |= (1<<(11-(i/3))); break; case 't': if (i != 8) { goto chmodStyleCheck; } newMode |= (1<<(8-i)); newMode |= (1<<9); break; case 'T': if (i != 8) { goto chmodStyleCheck; } newMode |= (1<<9); break; case '-': break; default: /* * Oops, not what we thought it was, so go on */ goto chmodStyleCheck; } } *modePtr = newMode; return TCL_OK; chmodStyleCheck: /* * We now check for an "ugoa+-=rwxst" style permissions string */ for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) { oldMode = *modePtr; who = op = what = op_found = who_found = 0; for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) { if (!who_found) { /* who */ switch (*(modeStringPtr+n+i)) { case 'u': who |= 0x9C0; continue; case 'g': who |= 0x438; continue; case 'o': who |= 0x207; continue; case 'a': who |= 0xFFF; continue; } } who_found = 1; if (who == 0) { who = 0xFFF; } if (!op_found) { /* op */ switch (*(modeStringPtr+n+i)) { case '+': op = 1; op_found = 1; continue; case '-': op = 2; op_found = 1; continue; case '=': op = 3; op_found = 1; continue; default: return TCL_ERROR; } } /* what */ switch (*(modeStringPtr+n+i)) { case 'r': what |= 0x124; continue; case 'w': what |= 0x92; continue; case 'x': what |= 0x49; continue; case 's': what |= 0xC00; continue; case 't': what |= 0x200; continue; case ',': break; default: return TCL_ERROR; } if (*(modeStringPtr+n+i) == ',') { i++; break; } } switch (op) { case 1: *modePtr = oldMode | (who & what); continue; case 2: *modePtr = oldMode & ~(who & what); continue; case 3: *modePtr = (oldMode & ~who) | (who & what); continue; } } return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclpObjNormalizePath -- * * This function scans through a path specification and replaces it, in * place, with a normalized version. A normalized version is one in which * all symlinks in the path are replaced with their expanded form (except * a symlink at the very end of the path). * * Results: * The new 'nextCheckpoint' value, giving as far as we could understand * in the path. * * Side effects: * The pathPtr string, is modified. * *--------------------------------------------------------------------------- */ int TclpObjNormalizePath( Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint) { const char *currentPathEndPosition; int pathLen; char cur; const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_DString ds; const char *nativePath; #ifndef NO_REALPATH char normPath[MAXPATHLEN]; #endif /* * We add '1' here because if nextCheckpoint is zero we know that '/' * exists, and if it isn't zero, it must point at a directory separator * which we also know exists. */ currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; } #ifndef NO_REALPATH /* * For speed, try to get the entire path in one go. */ if (nextCheckpoint == 0 && haveRealpath) { char *lastDir = strrchr(currentPathEndPosition, '/'); if (lastDir != NULL) { nativePath = Tcl_UtfToExternalDString(NULL, path, lastDir-path, &ds); if (Realpath(nativePath, normPath) != NULL) { if (*nativePath != '/' && *normPath == '/') { /* * realpath has transformed a relative path into an * absolute path, we do not know how to handle this. */ } else { nextCheckpoint = lastDir - path; goto wholeStringOk; } } Tcl_DStringFree(&ds); } } /* * Else do it the slow way. */ #endif while (1) { cur = *currentPathEndPosition; if ((cur == '/') && (path != currentPathEndPosition)) { /* * Reached directory separator. */ int accessOk; nativePath = Tcl_UtfToExternalDString(NULL, path, currentPathEndPosition - path, &ds); accessOk = access(nativePath, F_OK); Tcl_DStringFree(&ds); if (accessOk != 0) { /* * File doesn't exist. */ break; } /* * Update the acceptable point. */ nextCheckpoint = currentPathEndPosition - path; } else if (cur == 0) { /* * Reached end of string. */ break; } currentPathEndPosition++; } /* * We should really now convert this to a canonical path. We do that with * 'realpath' if we have it available. Otherwise we could step through * every single path component, checking whether it is a symlink, but that * would be a lot of work, and most modern OSes have 'realpath'. */ #ifndef NO_REALPATH if (haveRealpath) { /* * If we only had '/foo' or '/' then we never increment nextCheckpoint * and we don't need or want to go through 'Realpath'. Also, on some * platforms, passing an empty string to 'Realpath' will give us the * normalized pwd, which is not what we want at all! */ if (nextCheckpoint == 0) { return 0; } nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { int newNormLen; wholeStringOk: newNormLen = strlen(normPath); if ((newNormLen == Tcl_DStringLength(&ds)) && (strcmp(normPath, nativePath) == 0)) { /* * String is unchanged. */ Tcl_DStringFree(&ds); /* * Enable this to have the native FS claim normalization of * the whole path for existing files. That would permit the * caller to declare normalization complete without calls to * additional filesystems. Saving lots of calls is probably * worth the extra access() time here. When no other FS's are * registered though, things are less clear. * if (0 == access(normPath, F_OK)) { return pathLen; } */ return nextCheckpoint; } /* * Free up the native path and put in its place the converted, * normalized path. */ Tcl_DStringFree(&ds); Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); if (path[nextCheckpoint] != '\0') { /* * Not at end, append remaining path. */ int normLen = Tcl_DStringLength(&ds); Tcl_DStringAppend(&ds, path + nextCheckpoint, pathLen - nextCheckpoint); /* * We recognise up to and including the directory separator. */ nextCheckpoint = normLen + 1; } else { /* * We recognise the whole string. */ nextCheckpoint = Tcl_DStringLength(&ds); } /* * Overwrite with the normalized path. */ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); } Tcl_DStringFree(&ds); } #endif /* !NO_REALPATH */ return nextCheckpoint; } /* *---------------------------------------------------------------------- * * TclpOpenTemporaryFile, TclUnixOpenTemporaryFile -- * * Creates a temporary file, possibly based on the supplied bits and * pieces of template supplied in the first three arguments. If the * fourth argument is non-NULL, it contains a Tcl_Obj to store the name * of the temporary file in (and it is caller's responsibility to clean * up). If the fourth argument is NULL, try to arrange for the temporary * file to go away once it is no longer needed. * * Results: * A read-write Tcl Channel open on the file for TclpOpenTemporaryFile, * or a file descriptor (or -1 on failure) for TclUnixOpenTemporaryFile. * * Side effects: * Accesses the filesystem. Will set the contents of the Tcl_Obj fourth * argument (if that is non-NULL). * *---------------------------------------------------------------------- */ Tcl_Channel TclpOpenTemporaryFile( Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) { int fd = TclUnixOpenTemporaryFile(dirObj, basenameObj, extensionObj, resultingNameObj); if (fd == -1) { return NULL; } return Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE); } int TclUnixOpenTemporaryFile( Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) { Tcl_DString template, tmp; const char *string; int len, fd; /* * We should also check against making more then TMP_MAX of these. */ if (dirObj) { string = Tcl_GetStringFromObj(dirObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &template); } else { Tcl_DStringInit(&template); Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ } TclDStringAppendLiteral(&template, "/"); if (basenameObj) { string = Tcl_GetStringFromObj(basenameObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &tmp); TclDStringAppendDString(&template, &tmp); Tcl_DStringFree(&tmp); } else { TclDStringAppendLiteral(&template, "tcl"); } TclDStringAppendLiteral(&template, "_XXXXXX"); #ifdef HAVE_MKSTEMPS if (extensionObj) { string = Tcl_GetStringFromObj(extensionObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &tmp); TclDStringAppendDString(&template, &tmp); fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); } else #endif { fd = mkstemp(Tcl_DStringValue(&template)); } if (fd == -1) { Tcl_DStringFree(&template); return -1; } if (resultingNameObj) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template), Tcl_DStringLength(&template), &tmp); Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); } else { /* * Try to delete the file immediately since we're not reporting the * name to anyone. Note that we're *not* handling any errors from * this! */ unlink(Tcl_DStringValue(&template)); errno = 0; } Tcl_DStringFree(&template); return fd; } /* * Helper that does *part* of what tempnam() does. */ static const char * DefaultTempDir(void) { const char *dir; struct stat buf; dir = getenv("TMPDIR"); if (dir && dir[0] && stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) && access(dir, W_OK) == 0) { return dir; } #ifdef P_tmpdir dir = P_tmpdir; if (stat(dir, &buf)==0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)==0) { return dir; } #endif /* * Assume that the default location ("/tmp" if not overridden) is always * an existing writable directory; we've no recovery mechanism if it * isn't. */ return TCL_TEMPORARY_FILE_DIRECTORY; } #if defined(__CYGWIN__) static void StatError( Tcl_Interp *interp, /* The interp that has the error */ Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } static WCHAR * winPathFromObj( Tcl_Obj *fileName) { int size; const char *native = Tcl_FSGetNativePath(fileName); WCHAR *winPath; size = cygwin_conv_path(1, native, NULL, 0); winPath = ckalloc(size); cygwin_conv_path(1, native, winPath, size); return winPath; } static const int attributeArray[] = { 0x20, 0, 2, 0, 0, 1, 4}; /* *---------------------------------------------------------------------- * * GetUnixFileAttributes * * Gets the readonly attribute of a file. * * Results: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there * is no error. The object will have ref count 0. * * Side effects: * A new object is allocated. * *---------------------------------------------------------------------- */ static int GetUnixFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { int fileAttributes; WCHAR *winPath = winPathFromObj(fileName); fileAttributes = GetFileAttributesW(winPath); ckfree(winPath); if (fileAttributes == -1) { StatError(interp, fileName); return TCL_ERROR; } TclNewIntObj(*attributePtrPtr, (fileAttributes&attributeArray[objIndex])!=0); return TCL_OK; } /* *--------------------------------------------------------------------------- * * SetUnixFileAttributes * * Sets the readonly attribute of a file. * * Results: * Standard TCL result. * * Side effects: * The readonly attribute of the file is changed. * *--------------------------------------------------------------------------- */ static int SetUnixFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* The attribute to set. */ { int yesNo, fileAttributes, old; WCHAR *winPath; if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) { return TCL_ERROR; } winPath = winPathFromObj(fileName); fileAttributes = old = GetFileAttributesW(winPath); if (fileAttributes == -1) { ckfree(winPath); StatError(interp, fileName); return TCL_ERROR; } if (yesNo) { fileAttributes |= attributeArray[objIndex]; } else { fileAttributes &= ~attributeArray[objIndex]; } if ((fileAttributes != old) && !SetFileAttributesW(winPath, fileAttributes)) { ckfree(winPath); StatError(interp, fileName); return TCL_ERROR; } ckfree(winPath); return TCL_OK; } #elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) /* *---------------------------------------------------------------------- * * GetUnixFileAttributes * * Gets the readonly attribute (user immutable flag) of a file. * * Results: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there * is no error. The object will have ref count 0. * * Side effects: * A new object is allocated. * *---------------------------------------------------------------------- */ static int GetUnixFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; int result; result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE); return TCL_OK; } /* *--------------------------------------------------------------------------- * * SetUnixFileAttributes * * Sets the readonly attribute (user immutable flag) of a file. * * Results: * Standard TCL result. * * Side effects: * The readonly attribute of the file is changed. * *--------------------------------------------------------------------------- */ static int SetUnixFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* The attribute to set. */ { Tcl_StatBuf statBuf; int result, readonly; const char *native; if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) { return TCL_ERROR; } result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } if (readonly) { statBuf.st_flags |= UF_IMMUTABLE; } else { statBuf.st_flags &= ~UF_IMMUTABLE; } native = Tcl_FSGetNativePath(fileName); result = chflags(native, statBuf.st_flags); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set flags for file \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } #endif /* defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixFile.c0000644000175000017500000007340314554262142015226 0ustar sergeisergei/* * tclUnixFile.c -- * * This file contains wrappers around UNIX file handling functions. * These wrappers mask differences between Windows and UNIX. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclFileSystem.h" static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry, const char* nativeName, Tcl_GlobTypeData *types); /* *--------------------------------------------------------------------------- * * TclpFindExecutable -- * * This function computes the absolute path name of the current * application, given its argv[0] value. For Cygwin, argv[0] is * ignored and the path is determined the same as under win32. * * Results: * None. * * Side effects: * The computed path name is stored as a ProcessGlobalValue. * *--------------------------------------------------------------------------- */ void TclpFindExecutable( const char *argv0) /* The value of the application's argv[0] * (native). */ { #ifdef __CYGWIN__ int length; wchar_t buf[PATH_MAX] = L""; char name[PATH_MAX * 3 + 1]; GetModuleFileNameW(NULL, buf, PATH_MAX); cygwin_conv_path(3, buf, name, sizeof(name)); length = strlen(name); if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) { /* Strip '.exe' part. */ length -= 4; } TclSetObjNameOfExecutable( Tcl_NewStringObj(name, length), NULL); #else Tcl_Encoding encoding; const char *name, *p; Tcl_StatBuf statBuf; Tcl_DString buffer, nameString, cwd, utfName; if (argv0 == NULL) { return; } Tcl_DStringInit(&buffer); name = argv0; for (p = name; *p != '\0'; p++) { if (*p == '/') { /* * The name contains a slash, so use the name directly without * doing a path search. */ goto gotName; } } p = getenv("PATH"); /* INTL: Native. */ if (p == NULL) { /* * There's no PATH environment variable; use the default that is used * by sh. */ p = ":/bin:/usr/bin"; } else if (*p == '\0') { /* * An empty path is equivalent to ".". */ p = "./"; } /* * Search through all the directories named in the PATH variable to see if * argv[0] is in one of them. If so, use that file name. */ while (1) { while (TclIsSpaceProcM(*p)) { p++; } name = p; while ((*p != ':') && (*p != 0)) { p++; } TclDStringClear(&buffer); if (p != name) { Tcl_DStringAppend(&buffer, name, p - name); if (p[-1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } } name = Tcl_DStringAppend(&buffer, argv0, -1); /* * INTL: The following calls to access() and stat() should not be * converted to Tclp routines because they need to operate on native * strings directly. */ if ((access(name, X_OK) == 0) /* INTL: Native. */ && (TclOSstat(name, &statBuf) == 0) /* INTL: Native. */ && S_ISREG(statBuf.st_mode)) { goto gotName; } if (*p == '\0') { break; } else if (*(p+1) == 0) { p = "./"; } else { p++; } } TclSetObjNameOfExecutable(Tcl_NewObj(), NULL); goto done; /* * If the name starts with "/" then just store it */ gotName: #ifdef DJGPP if (name[1] == ':') #else if (name[0] == '/') #endif { encoding = Tcl_GetEncoding(NULL, NULL); Tcl_ExternalToUtfDString(encoding, name, -1, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); Tcl_DStringFree(&utfName); goto done; } if (TclpGetCwd(NULL, &cwd) == NULL) { TclSetObjNameOfExecutable(Tcl_NewObj(), NULL); goto done; } /* * The name is relative to the current working directory. First strip off * a leading "./", if any, then add the full path name of the current * working directory. */ if ((name[0] == '.') && (name[1] == '/')) { name += 2; } Tcl_DStringInit(&nameString); Tcl_DStringAppend(&nameString, name, -1); Tcl_DStringFree(&buffer); Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), Tcl_DStringLength(&cwd), &buffer); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } Tcl_DStringFree(&cwd); TclDStringAppendDString(&buffer, &nameString); Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); Tcl_DStringFree(&utfName); done: Tcl_DStringFree(&buffer); #endif } /* *---------------------------------------------------------------------- * * TclpMatchInDirectory -- * * This routine is used by the globbing code to search a directory for * all files which match a given pattern. * * Results: * The return value is a standard Tcl result indicating whether an error * occurred in globbing. Errors are left in interp, good results are * [lappend]ed to resultPtr (which must be a valid object). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpMatchInDirectory( Tcl_Interp *interp, /* Interpreter to receive errors. */ Tcl_Obj *resultPtr, /* List object to lappend results. */ Tcl_Obj *pathPtr, /* Contains path to directory to search. */ const char *pattern, /* Pattern to match against. */ Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. In particular the directory * flag is very important. */ { const char *native; Tcl_Obj *fileNamePtr; int matchResult = 0; if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) { /* * The native filesystem never adds mounts. */ return TCL_OK; } fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (fileNamePtr == NULL) { return TCL_ERROR; } if (pattern == NULL || (*pattern == '\0')) { /* * Match a file directly. */ Tcl_Obj *tailPtr; const char *nativeTail; native = (const char *)Tcl_FSGetNativePath(pathPtr); tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL); nativeTail = (const char *)Tcl_FSGetNativePath(tailPtr); matchResult = NativeMatchType(interp, native, nativeTail, types); if (matchResult == 1) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } Tcl_DecrRefCount(tailPtr); Tcl_DecrRefCount(fileNamePtr); } else { TclDIR *d; Tcl_DirEntry *entryPtr; const char *dirName; int dirLength, nativeDirLen; int matchHidden, matchHiddenPat; Tcl_StatBuf statBuf; Tcl_DString ds; /* native encoding of dir */ Tcl_DString dsOrig; /* utf-8 encoding of dir */ Tcl_DStringInit(&dsOrig); dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); /* * Make sure that the directory part of the name really is a * directory. If the directory name is "", use the name "." instead, * because some UNIX systems don't treat "" like "." automatically. * Keep the "" for use in generating file names, otherwise "glob * foo.c" would return "./foo.c". */ if (dirLength == 0) { dirName = "."; } else { dirName = Tcl_DStringValue(&dsOrig); /* * Make sure we have a trailing directory delimiter. */ if (dirName[dirLength-1] != '/') { dirName = TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } } /* * Now open the directory for reading and iterate over the contents. */ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds); if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */ || !S_ISDIR(statBuf.st_mode)) { Tcl_DStringFree(&dsOrig); Tcl_DStringFree(&ds); Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } d = TclOSopendir(native); /* INTL: Native. */ if (d == NULL) { Tcl_DStringFree(&ds); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read directory \"%s\": %s", Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); } Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); return TCL_ERROR; } nativeDirLen = Tcl_DStringLength(&ds); /* * Check to see if -type or the pattern requests hidden files. */ matchHiddenPat = (pattern[0] == '.') || ((pattern[0] == '\\') && (pattern[1] == '.')); matchHidden = matchHiddenPat || (types && (types->perm & TCL_GLOB_PERM_HIDDEN)); while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */ Tcl_DString utfDs; const char *utfname; /* * Skip this file if it doesn't agree with the hidden parameters * requested by the user (via -type or pattern). */ if (*entryPtr->d_name == '.') { if (!matchHidden) { continue; } } else { #ifdef MAC_OSX_TCL if (matchHiddenPat) { continue; } /* Also need to check HFS hidden flag in TclMacOSXMatchType. */ #else if (matchHidden) { continue; } #endif } /* * Now check to see if the file matches, according to both type * and pattern. If so, add the file to the result. */ utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs); if (Tcl_StringCaseMatch(utfname, pattern, 0)) { int typeOk = 1; if (types != NULL) { Tcl_DStringSetLength(&ds, nativeDirLen); native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1); matchResult = NativeMatchType(interp, native, entryPtr->d_name, types); typeOk = (matchResult == 1); } if (typeOk) { Tcl_ListObjAppendElement(interp, resultPtr, TclNewFSPathObj(pathPtr, utfname, Tcl_DStringLength(&utfDs))); } } Tcl_DStringFree(&utfDs); if (matchResult < 0) { break; } } TclOSclosedir(d); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); } if (matchResult < 0) { return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * NativeMatchType -- * * This routine is used by the globbing code to check if a file matches a * given type description. * * Results: * The return value is 1, 0 or -1 indicating whether the file matches the * given criteria, does not match them, or an error occurred (in which * case an error is left in interp). * * Side effects: * None. * *---------------------------------------------------------------------- */ static int NativeMatchType( Tcl_Interp *interp, /* Interpreter to receive errors. */ const char *nativeEntry, /* Native path to check. */ const char *nativeName, /* Native filename to check. */ Tcl_GlobTypeData *types) /* Type description to match against. */ { Tcl_StatBuf buf; if (types == NULL) { /* * Simply check for the file's existence, but do it with lstat, in * case it is a link to a file which doesn't exist (since that case * would not show up if we used 'access' or 'stat') */ if (TclOSlstat(nativeEntry, &buf) != 0) { return 0; } return 1; } if (types->perm != 0) { if (TclOSstat(nativeEntry, &buf) != 0) { /* * Either the file has disappeared between the 'readdir' call and * the 'stat' call, or the file is a link to a file which doesn't * exist (which we could ascertain with lstat), or there is some * other strange problem. In all these cases, we define this to * mean the file does not match any defined permission, and * therefore it is not added to the list of files to return. */ return 0; } /* * readonly means that there are NO write permissions (even for user), * but execute is OK for anybody OR that the user immutable flag is * set (where supported). */ if (((types->perm & TCL_GLOB_PERM_RONLY) && #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) !(buf.st_flags & UF_IMMUTABLE) && #endif (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) || ((types->perm & TCL_GLOB_PERM_R) && (access(nativeEntry, R_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_W) && (access(nativeEntry, W_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_X) && (access(nativeEntry, X_OK) != 0)) #ifndef MAC_OSX_TCL || ((types->perm & TCL_GLOB_PERM_HIDDEN) && (*nativeName != '.')) #endif /* MAC_OSX_TCL */ ) { return 0; } } if (types->type != 0) { if (types->perm == 0) { /* * We haven't yet done a stat on the file. */ if (TclOSstat(nativeEntry, &buf) != 0) { /* * Posix error occurred. The only ok case is if this is a link * to a nonexistent file, and the user did 'glob -l'. So we * check that here: */ if ((types->type & TCL_GLOB_TYPE_LINK) && (TclOSlstat(nativeEntry, &buf) == 0) && S_ISLNK(buf.st_mode)) { return 1; } return 0; } } /* * In order bcdpsfl as in 'find -t' */ if ( ((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(buf.st_mode)) || ((types->type & TCL_GLOB_TYPE_CHAR) && S_ISCHR(buf.st_mode)) || ((types->type & TCL_GLOB_TYPE_DIR) && S_ISDIR(buf.st_mode)) || ((types->type & TCL_GLOB_TYPE_PIPE) && S_ISFIFO(buf.st_mode))|| #ifdef S_ISSOCK ((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode))|| #endif /* S_ISSOCK */ ((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))) { /* * Do nothing - this file is ok. */ } else { #ifdef S_ISLNK if ((types->type & TCL_GLOB_TYPE_LINK) && (TclOSlstat(nativeEntry, &buf) == 0) && S_ISLNK(buf.st_mode)) { goto filetypeOK; } #endif /* S_ISLNK */ return 0; } } filetypeOK: /* * If we're on OSX, we also have to worry about matching the file creator * code (if specified). Do that now. */ #ifdef MAC_OSX_TCL if (types->macType != NULL || types->macCreator != NULL || (types->perm & TCL_GLOB_PERM_HIDDEN)) { int matchResult; if (types->perm == 0 && types->type == 0) { /* * We haven't yet done a stat on the file. */ if (TclOSstat(nativeEntry, &buf) != 0) { return 0; } } matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName, &buf, types); if (matchResult != 1) { return matchResult; } } #endif /* MAC_OSX_TCL */ return 1; } /* *--------------------------------------------------------------------------- * * TclpGetUserHome -- * * This function takes the specified user name and finds their home * directory. * * Results: * The result is a pointer to a string specifying the user's home * directory, or NULL if the user's home directory could not be * determined. Storage for the result string is allocated in bufferPtr; * the caller must call Tcl_DStringFree() when the result is no longer * needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * TclpGetUserHome( const char *name, /* User name for desired home directory. */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of user's home directory. */ { struct passwd *pwPtr; Tcl_DString ds; const char *native = Tcl_UtfToExternalDString(NULL, name, -1, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { return NULL; } Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr); return Tcl_DStringValue(bufferPtr); } /* *--------------------------------------------------------------------------- * * TclpObjAccess -- * * This function replaces the library version of access(). * * Results: * See access() documentation. * * Side effects: * See access() documentation. * *--------------------------------------------------------------------------- */ int TclpObjAccess( Tcl_Obj *pathPtr, /* Path of file to access */ int mode) /* Permission setting. */ { const char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return access(path, mode); } /* *--------------------------------------------------------------------------- * * TclpObjChdir -- * * This function replaces the library version of chdir(). * * Results: * See chdir() documentation. * * Side effects: * See chdir() documentation. * *--------------------------------------------------------------------------- */ int TclpObjChdir( Tcl_Obj *pathPtr) /* Path to new working directory */ { const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return chdir(path); } /* *---------------------------------------------------------------------- * * TclpObjLstat -- * * This function replaces the library version of lstat(). * * Results: * See lstat() documentation. * * Side effects: * See lstat() documentation. * *---------------------------------------------------------------------- */ int TclpObjLstat( Tcl_Obj *pathPtr, /* Path of file to stat */ Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ { return TclOSlstat((const char *)Tcl_FSGetNativePath(pathPtr), bufPtr); } /* *--------------------------------------------------------------------------- * * TclpGetNativeCwd -- * * This function replaces the library version of getcwd(). * * Results: * The input and output are filesystem paths in native form. The result * is either the given clientData, if the working directory hasn't * changed, or a new clientData (owned by our caller), giving the new * native path, or NULL if the current directory could not be determined. * If NULL is returned, the caller can examine the standard Posix error * codes to determine the cause of the problem. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData TclpGetNativeCwd( ClientData clientData) { char buffer[MAXPATHLEN+1]; #ifdef USEGETWD if (getwd(buffer) == NULL) { /* INTL: Native. */ return NULL; } #else if (getcwd(buffer, MAXPATHLEN+1) == NULL) { /* INTL: Native. */ return NULL; } #endif /* USEGETWD */ if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) { char *newCd = (char*)ckalloc(strlen(buffer) + 1); strcpy(newCd, buffer); return newCd; } /* * No change to pwd. */ return clientData; } /* *--------------------------------------------------------------------------- * * TclpGetCwd -- * * This function replaces the library version of getcwd(). (Obsolete * function, only retained for old extensions which may call it * directly). * * Results: * The result is a pointer to a string specifying the current directory, * or NULL if the current directory could not be determined. If NULL is * returned, an error message is left in the interp's result. Storage for * the result string is allocated in bufferPtr; the caller must call * Tcl_DStringFree() when the result is no longer needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * TclpGetCwd( Tcl_Interp *interp, /* If non-NULL, used for error reporting. */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of current directory. */ { char buffer[MAXPATHLEN+1]; #ifdef USEGETWD if (getwd(buffer) == NULL) /* INTL: Native. */ #else if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */ #endif /* USEGETWD */ { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error getting working directory name: %s", Tcl_PosixError(interp))); } return NULL; } return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr); } /* *--------------------------------------------------------------------------- * * TclpReadlink -- * * This function replaces the library version of readlink(). * * Results: * The result is a pointer to a string specifying the contents of the * symbolic link given by 'path', or NULL if the symbolic link could not * be read. Storage for the result string is allocated in bufferPtr; the * caller must call Tcl_DStringFree() when the result is no longer * needed. * * Side effects: * See readlink() documentation. * *--------------------------------------------------------------------------- */ char * TclpReadlink( const char *path, /* Path of file to readlink (UTF-8). */ Tcl_DString *linkPtr) /* Uninitialized or free DString filled with * contents of link (UTF-8). */ { #ifndef DJGPP char link[MAXPATHLEN]; int length; const char *native; Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); length = readlink(native, link, sizeof(link)); /* INTL: Native. */ Tcl_DStringFree(&ds); if (length < 0) { return NULL; } Tcl_ExternalToUtfDString(NULL, link, length, linkPtr); return Tcl_DStringValue(linkPtr); #else return NULL; #endif /* !DJGPP */ } /* *---------------------------------------------------------------------- * * TclpObjStat -- * * This function replaces the library version of stat(). * * Results: * See stat() documentation. * * Side effects: * See stat() documentation. * *---------------------------------------------------------------------- */ int TclpObjStat( Tcl_Obj *pathPtr, /* Path of file to stat */ Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ { const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return TclOSstat(path, bufPtr); } #ifdef S_IFLNK Tcl_Obj * TclpObjLink( Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction) { if (toPtr != NULL) { const char *src = (const char *)Tcl_FSGetNativePath(pathPtr); const char *target = NULL; if (src == NULL) { return NULL; } /* * If we're making a symbolic link and the path is relative, then we * must check whether it exists _relative_ to the directory in which * the src is found (not relative to the current cwd which is just not * relevant in this case). * * If we're making a hard link, then a relative path is just converted * to absolute relative to the cwd. */ if ((linkAction & TCL_CREATE_SYMBOLIC_LINK) && (Tcl_FSGetPathType(toPtr) == TCL_PATH_RELATIVE)) { Tcl_Obj *dirPtr, *absPtr; dirPtr = TclPathPart(NULL, pathPtr, TCL_PATH_DIRNAME); if (dirPtr == NULL) { return NULL; } absPtr = Tcl_FSJoinToPath(dirPtr, 1, &toPtr); Tcl_IncrRefCount(absPtr); if (Tcl_FSAccess(absPtr, F_OK) == -1) { Tcl_DecrRefCount(absPtr); Tcl_DecrRefCount(dirPtr); /* * Target doesn't exist. */ errno = ENOENT; return NULL; } /* * Target exists; we'll construct the relative path we want below. */ Tcl_DecrRefCount(absPtr); Tcl_DecrRefCount(dirPtr); } else { target = (const char*)Tcl_FSGetNativePath(toPtr); if (target == NULL) { return NULL; } if (access(target, F_OK) == -1) { /* * Target doesn't exist. */ errno = ENOENT; return NULL; } } if (access(src, F_OK) != -1) { /* * Src exists. */ errno = EEXIST; return NULL; } /* * Check symbolic link flag first, since we prefer to create these. */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { int targetLen; Tcl_DString ds; Tcl_Obj *transPtr; /* * Now we don't want to link to the absolute, normalized path. * Relative links are quite acceptable (but links to ~user are not * -- these must be expanded first). */ transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr); if (transPtr == NULL) { return NULL; } target = Tcl_GetStringFromObj(transPtr, &targetLen); target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { toPtr = NULL; } Tcl_DStringFree(&ds); } else if (linkAction & TCL_CREATE_HARD_LINK) { if (link(target, src) != 0) { return NULL; } } else { errno = ENODEV; return NULL; } return toPtr; } else { Tcl_Obj *linkPtr = NULL; char link[MAXPATHLEN]; int length; Tcl_DString ds; Tcl_Obj *transPtr; transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (transPtr == NULL) { return NULL; } Tcl_DecrRefCount(transPtr); length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); if (length < 0) { return NULL; } Tcl_ExternalToUtfDString(NULL, link, length, &ds); linkPtr = TclDStringToObj(&ds); Tcl_IncrRefCount(linkPtr); return linkPtr; } } #endif /* S_IFLNK */ /* *--------------------------------------------------------------------------- * * TclpFilesystemPathType -- * * This function is part of the native filesystem support, and returns * the path type of the given path. Right now it simply returns NULL. In * the future it could return specific path types, like 'nfs', 'samba', * 'FAT32', etc. * * Results: * NULL at present. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclpFilesystemPathType( Tcl_Obj *pathPtr) { /* * All native paths are of the same type. */ return NULL; } /* *--------------------------------------------------------------------------- * * TclpNativeToNormalized -- * * Convert native format to a normalized path object, with refCount of * zero. * * Currently assumes all native paths are actually normalized already, so * if the path given is not normalized this will actually just convert to * a valid string path, but not necessarily a normalized one. * * Results: * A valid normalized path. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclpNativeToNormalized( ClientData clientData) { Tcl_DString ds; Tcl_ExternalToUtfDString(NULL, (const char *) clientData, -1, &ds); return TclDStringToObj(&ds); } /* *--------------------------------------------------------------------------- * * TclNativeCreateNativeRep -- * * Create a native representation for the given path. * * Results: * The nativePath representation. * * Side effects: * Memory will be allocated. The path may need to be normalized. * *--------------------------------------------------------------------------- */ ClientData TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { char *nativePathPtr; const char *str; Tcl_DString ds; Tcl_Obj *validPathPtr; int len; if (TclFSCwdIsNative()) { /* * The cwd is native, which means we can use the translated path * without worrying about normalization (this will also usually be * shorter so the utf-to-external conversion will be somewhat faster). */ validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } } else { /* * Make sure the normalized path is set. */ validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } Tcl_IncrRefCount(validPathPtr); } str = Tcl_GetStringFromObj(validPathPtr, &len); Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { /* See bug [3118489]: NUL in filenames */ Tcl_DecrRefCount(validPathPtr); Tcl_DStringFree(&ds); return NULL; } Tcl_DecrRefCount(validPathPtr); nativePathPtr = (char *)ckalloc(len); memcpy(nativePathPtr, Tcl_DStringValue(&ds), len); Tcl_DStringFree(&ds); return nativePathPtr; } /* *--------------------------------------------------------------------------- * * TclNativeDupInternalRep -- * * Duplicate the native representation. * * Results: * The copied native representation, or NULL if it is not possible to * copy the representation. * * Side effects: * Memory will be allocated for the copy. * *--------------------------------------------------------------------------- */ ClientData TclNativeDupInternalRep( ClientData clientData) { char *copy; size_t len; if (clientData == NULL) { return NULL; } /* * ASCII representation when running on Unix. */ len = (strlen((const char*) clientData) + 1) * sizeof(char); copy = (char *)ckalloc(len); memcpy(copy, clientData, len); return copy; } /* *--------------------------------------------------------------------------- * * TclpUtime -- * * Set the modification date for a file. * * Results: * 0 on success, -1 on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TclpUtime( Tcl_Obj *pathPtr, /* File to modify */ struct utimbuf *tval) /* New modification date structure */ { return utime((const char *)Tcl_FSGetNativePath(pathPtr), tval); } #ifdef __CYGWIN__ int TclOSstat( const char *name, void *cygstat) { struct stat buf; Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat; int result = stat(name, &buf); statBuf->st_mode = buf.st_mode; statBuf->st_ino = buf.st_ino; statBuf->st_dev = buf.st_dev; statBuf->st_rdev = buf.st_rdev; statBuf->st_nlink = buf.st_nlink; statBuf->st_uid = buf.st_uid; statBuf->st_gid = buf.st_gid; statBuf->st_size = buf.st_size; statBuf->st_atime = buf.st_atime; statBuf->st_mtime = buf.st_mtime; statBuf->st_ctime = buf.st_ctime; return result; } int TclOSlstat( const char *name, void *cygstat) { struct stat buf; Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat; int result = lstat(name, &buf); statBuf->st_mode = buf.st_mode; statBuf->st_ino = buf.st_ino; statBuf->st_dev = buf.st_dev; statBuf->st_rdev = buf.st_rdev; statBuf->st_nlink = buf.st_nlink; statBuf->st_uid = buf.st_uid; statBuf->st_gid = buf.st_gid; statBuf->st_size = buf.st_size; statBuf->st_atime = buf.st_atime; statBuf->st_mtime = buf.st_mtime; statBuf->st_ctime = buf.st_ctime; return result; } #endif /* CYGWIN */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixInit.c0000644000175000017500000007336614554262142015262 0ustar sergeisergei/* * tclUnixInit.c -- * * Contains the Unix-specific interpreter initialization functions. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. */ #include "tclInt.h" #include #include #ifdef HAVE_LANGINFO # include # ifdef __APPLE__ # if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* Support for weakly importing nl_langinfo on Darwin. */ # define WEAK_IMPORT_NL_LANGINFO extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE; # endif # endif #endif #include #if defined(__FreeBSD__) && defined(__GNUC__) # include #endif #if defined(__bsdi__) # include # if _BSDI_VERSION > 199501 # include # endif #endif #ifdef __CYGWIN__ #ifdef __cplusplus extern "C" { #endif #ifdef __clang__ #pragma clang diagnostic ignored "-Wignored-attributes" #endif DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *); DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *); DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); #ifdef __cplusplus } #endif #define NUMPROCESSORS 15 static const char *const processors[NUMPROCESSORS] = { "i686", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "x86_64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64" }; typedef struct { union { unsigned int dwOemId; struct { int wProcessorArchitecture; int wReserved; }; }; unsigned int dwPageSize; void *lpMinimumApplicationAddress; void *lpMaximumApplicationAddress; void *dwActiveProcessorMask; unsigned int dwNumberOfProcessors; unsigned int dwProcessorType; unsigned int dwAllocationGranularity; int wProcessorLevel; int wProcessorRevision; } SYSTEM_INFO; typedef struct { unsigned int dwOSVersionInfoSize; unsigned int dwMajorVersion; unsigned int dwMinorVersion; unsigned int dwBuildNumber; unsigned int dwPlatformId; wchar_t szCSDVersion[128]; } OSVERSIONINFOW; #endif #ifdef HAVE_COREFOUNDATION #include #endif /* * Tcl tries to use standard and homebrew methods to guess the right encoding * on the platform. However, there is always a final fallback, and this value * is it. Make sure it is a real Tcl encoding. */ #ifndef TCL_DEFAULT_ENCODING #define TCL_DEFAULT_ENCODING "iso8859-1" #endif /* * Default directory in which to look for Tcl library scripts. The symbol is * defined by Makefile. */ static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY; /* * Directory in which to look for packages (each package is typically * installed as a subdirectory of this directory). The symbol is defined by * Makefile. */ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; /* * The following table is used to map from Unix locale strings to encoding * files. If HAVE_LANGINFO is defined, then this is a fallback table when the * result from nl_langinfo isn't a recognized encoding. Otherwise this is the * first list checked for a mapping from env encoding to Tcl encoding name. */ typedef struct { const char *lang; const char *encoding; } LocaleTable; /* * The table below is sorted for the sake of doing binary searches on it. The * indenting reflects different categories of data. The leftmost data * represent the encoding names directly implemented by data files in Tcl's * default encoding directory. Indented by one TAB are the encoding names that * are common alternative spellings. Indented by two TABs are the accumulated * "bug fixes" that have been added to deal with the wide variability seen * among existing platforms. */ static const LocaleTable localeTable[] = { {"", "iso8859-1"}, {"ansi-1251", "cp1251"}, {"ansi_x3.4-1968", "iso8859-1"}, {"ascii", "ascii"}, {"big5", "big5"}, {"cp1250", "cp1250"}, {"cp1251", "cp1251"}, {"cp1252", "cp1252"}, {"cp1253", "cp1253"}, {"cp1254", "cp1254"}, {"cp1255", "cp1255"}, {"cp1256", "cp1256"}, {"cp1257", "cp1257"}, {"cp1258", "cp1258"}, {"cp437", "cp437"}, {"cp737", "cp737"}, {"cp775", "cp775"}, {"cp850", "cp850"}, {"cp852", "cp852"}, {"cp855", "cp855"}, {"cp857", "cp857"}, {"cp860", "cp860"}, {"cp861", "cp861"}, {"cp862", "cp862"}, {"cp863", "cp863"}, {"cp864", "cp864"}, {"cp865", "cp865"}, {"cp866", "cp866"}, {"cp869", "cp869"}, {"cp874", "cp874"}, {"cp932", "cp932"}, {"cp936", "cp936"}, {"cp949", "cp949"}, {"cp950", "cp950"}, {"dingbats", "dingbats"}, {"ebcdic", "ebcdic"}, {"euc-cn", "euc-cn"}, {"euc-jp", "euc-jp"}, {"euc-kr", "euc-kr"}, {"eucjp", "euc-jp"}, {"euckr", "euc-kr"}, {"euctw", "euc-cn"}, {"gb12345", "gb12345"}, {"gb1988", "gb1988"}, {"gb2312", "gb2312"}, {"gb2312-1980", "gb2312"}, {"gb2312-raw", "gb2312-raw"}, {"greek8", "cp869"}, {"ibm1250", "cp1250"}, {"ibm1251", "cp1251"}, {"ibm1252", "cp1252"}, {"ibm1253", "cp1253"}, {"ibm1254", "cp1254"}, {"ibm1255", "cp1255"}, {"ibm1256", "cp1256"}, {"ibm1257", "cp1257"}, {"ibm1258", "cp1258"}, {"ibm437", "cp437"}, {"ibm737", "cp737"}, {"ibm775", "cp775"}, {"ibm850", "cp850"}, {"ibm852", "cp852"}, {"ibm855", "cp855"}, {"ibm857", "cp857"}, {"ibm860", "cp860"}, {"ibm861", "cp861"}, {"ibm862", "cp862"}, {"ibm863", "cp863"}, {"ibm864", "cp864"}, {"ibm865", "cp865"}, {"ibm866", "cp866"}, {"ibm869", "cp869"}, {"ibm874", "cp874"}, {"ibm932", "cp932"}, {"ibm936", "cp936"}, {"ibm949", "cp949"}, {"ibm950", "cp950"}, {"iso-2022", "iso2022"}, {"iso-2022-jp", "iso2022-jp"}, {"iso-2022-kr", "iso2022-kr"}, {"iso-8859-1", "iso8859-1"}, {"iso-8859-10", "iso8859-10"}, {"iso-8859-13", "iso8859-13"}, {"iso-8859-14", "iso8859-14"}, {"iso-8859-15", "iso8859-15"}, {"iso-8859-16", "iso8859-16"}, {"iso-8859-2", "iso8859-2"}, {"iso-8859-3", "iso8859-3"}, {"iso-8859-4", "iso8859-4"}, {"iso-8859-5", "iso8859-5"}, {"iso-8859-6", "iso8859-6"}, {"iso-8859-7", "iso8859-7"}, {"iso-8859-8", "iso8859-8"}, {"iso-8859-9", "iso8859-9"}, {"iso2022", "iso2022"}, {"iso2022-jp", "iso2022-jp"}, {"iso2022-kr", "iso2022-kr"}, {"iso8859-1", "iso8859-1"}, {"iso8859-10", "iso8859-10"}, {"iso8859-13", "iso8859-13"}, {"iso8859-14", "iso8859-14"}, {"iso8859-15", "iso8859-15"}, {"iso8859-16", "iso8859-16"}, {"iso8859-2", "iso8859-2"}, {"iso8859-3", "iso8859-3"}, {"iso8859-4", "iso8859-4"}, {"iso8859-5", "iso8859-5"}, {"iso8859-6", "iso8859-6"}, {"iso8859-7", "iso8859-7"}, {"iso8859-8", "iso8859-8"}, {"iso8859-9", "iso8859-9"}, {"iso88591", "iso8859-1"}, {"iso885915", "iso8859-15"}, {"iso88592", "iso8859-2"}, {"iso88595", "iso8859-5"}, {"iso88596", "iso8859-6"}, {"iso88597", "iso8859-7"}, {"iso88598", "iso8859-8"}, {"iso88599", "iso8859-9"}, #ifdef hpux {"ja", "shiftjis"}, #else {"ja", "euc-jp"}, #endif {"ja_jp", "euc-jp"}, {"ja_jp.euc", "euc-jp"}, {"ja_jp.eucjp", "euc-jp"}, {"ja_jp.jis", "iso2022-jp"}, {"ja_jp.mscode", "shiftjis"}, {"ja_jp.sjis", "shiftjis"}, {"ja_jp.ujis", "euc-jp"}, {"japan", "euc-jp"}, #ifdef hpux {"japanese", "shiftjis"}, #else {"japanese", "euc-jp"}, #endif {"japanese-sjis", "shiftjis"}, {"japanese-ujis", "euc-jp"}, {"japanese.euc", "euc-jp"}, {"japanese.sjis", "shiftjis"}, {"jis0201", "jis0201"}, {"jis0208", "jis0208"}, {"jis0212", "jis0212"}, {"jp_jp", "shiftjis"}, {"ko", "euc-kr"}, {"ko_kr", "euc-kr"}, {"ko_kr.euc", "euc-kr"}, {"ko_kw.euckw", "euc-kr"}, {"koi8-r", "koi8-r"}, {"koi8-u", "koi8-u"}, {"korean", "euc-kr"}, {"ksc5601", "ksc5601"}, {"maccenteuro", "macCentEuro"}, {"maccroatian", "macCroatian"}, {"maccyrillic", "macCyrillic"}, {"macdingbats", "macDingbats"}, {"macgreek", "macGreek"}, {"maciceland", "macIceland"}, {"macjapan", "macJapan"}, {"macroman", "macRoman"}, {"macromania", "macRomania"}, {"macthai", "macThai"}, {"macturkish", "macTurkish"}, {"macukraine", "macUkraine"}, {"roman8", "iso8859-1"}, {"ru", "iso8859-5"}, {"ru_ru", "iso8859-5"}, {"ru_su", "iso8859-5"}, {"shiftjis", "shiftjis"}, {"sjis", "shiftjis"}, {"symbol", "symbol"}, {"tis-620", "tis-620"}, {"tis620", "tis-620"}, {"turkish8", "cp857"}, {"utf8", "utf-8"}, {"zh", "cp936"}, {"zh_cn.gb2312", "euc-cn"}, {"zh_cn.gbk", "euc-cn"}, {"zh_cz.gb2312", "euc-cn"}, {"zh_tw", "euc-tw"}, {"zh_tw.big5", "big5"}, }; #ifdef HAVE_COREFOUNDATION static int MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath); #endif /* HAVE_COREFOUNDATION */ #if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \ (defined(TCL_THREADS) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \ (defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \ (defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\ ))) /* * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c: * initialize release global at startup from uname(). */ #define GET_DARWIN_RELEASE 1 MODULE_SCOPE long tclMacOSXDarwinRelease; long tclMacOSXDarwinRelease = 0; #endif /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * * Initialize all the platform-dependent things like signals and * floating-point error handling. * * Called at process initialization time. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclpInitPlatform(void) { #ifdef DJGPP tclPlatform = TCL_PLATFORM_WINDOWS; #else tclPlatform = TCL_PLATFORM_UNIX; #endif /* * Make sure, that the standard FDs exist. [Bug 772288] */ if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_RDONLY); } if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_WRONLY); } if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_WRONLY); } /* * The code below causes SIGPIPE (broken pipe) errors to be ignored. This * is needed so that Tcl processes don't die if they create child * processes (e.g. using "exec" or "open") that terminate prematurely. * The signal handler is only set up when the first interpreter is * created; after this the application can override the handler with a * different one of its own, if it wants. */ #ifdef SIGPIPE (void) signal(SIGPIPE, SIG_IGN); #endif /* SIGPIPE */ #if defined(__FreeBSD__) && defined(__GNUC__) /* * Adjust the rounding mode to be more conventional. Note that FreeBSD * only provides the __fpsetreg() used by the following two for the GNU * Compiler. When using, say, Intel's icc they break. (Partially based on * patch in BSD ports system from root@celsius.bychok.com) */ fpsetround(FP_RN); (void) fpsetmask(0L); #endif #if defined(__bsdi__) && (_BSDI_VERSION > 199501) /* * Find local symbols. Don't report an error if we fail. */ (void) dlopen(NULL, RTLD_NOW); /* INTL: Native. */ #endif /* * Initialize the C library's locale subsystem. This is required for input * methods to work properly on X11. We only do this for LC_CTYPE because * that's the necessary one, and we don't want to affect LC_TIME here. * The side effect of setting the default locale should be to load any * locale specific modules that are needed by X. [BUG: 5422 3345 4236 2522 * 2521]. */ setlocale(LC_CTYPE, ""); /* * In case the initial locale is not "C", ensure that the numeric * processing is done in "C" locale regardless. This is needed because Tcl * relies on routines like strtod, but should not have locale dependent * behavior. */ setlocale(LC_NUMERIC, "C"); #ifdef GET_DARWIN_RELEASE { struct utsname name; if (!uname(&name)) { tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); } } #endif } /* *--------------------------------------------------------------------------- * * TclpInitLibraryPath -- * * This is the fallback routine that sets the library path if the * application has not set one by the first time it is needed. * * Results: * None. * * Side effects: * Sets the library path to an initial value. * *------------------------------------------------------------------------- */ void TclpInitLibraryPath( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 Tcl_Obj *pathPtr, *objPtr; const char *str; Tcl_DString buffer; TclNewObj(pathPtr); /* * Look for the library relative to the TCL_LIBRARY env variable. If the * last dirname in the TCL_LIBRARY path does not match the last dirname in * the installLib variable, use the last dir name of installLib in * addition to the original TCL_LIBRARY path. */ str = getenv("TCL_LIBRARY"); /* INTL: Native. */ Tcl_ExternalToUtfDString(NULL, str, -1, &buffer); str = Tcl_DStringValue(&buffer); if ((str != NULL) && (str[0] != '\0')) { Tcl_DString ds; int pathc; const char **pathv; char installLib[LIBRARY_SIZE]; Tcl_DStringInit(&ds); /* * Initialize the substrings used when locating an executable. The * installLib variable computes the path as though the executable is * installed. */ snprintf(installLib, sizeof(installLib), "lib/tcl%s", TCL_VERSION); /* * If TCL_LIBRARY is set, search there. */ Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, -1)); Tcl_SplitPath(str, &pathc, &pathv); if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) { /* * If TCL_LIBRARY is set but refers to a different tcl * installation than the current version, try fiddling with the * specified directory to make it refer to this installation by * removing the old "tclX.Y" and substituting the current version * string. */ pathv[pathc - 1] = installLib + 4; str = Tcl_JoinPath(pathc, pathv, &ds); Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds)); } ckfree(pathv); } /* * Finally, look for the library relative to the compiled-in path. This is * needed when users install Tcl with an exec-prefix that is different * from the prefix. */ { #ifdef HAVE_COREFOUNDATION char tclLibPath[MAXPATHLEN + 1]; if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { str = tclLibPath; } else #endif /* HAVE_COREFOUNDATION */ { /* * TODO: Pull this value from the TIP 59 table. */ str = defaultLibraryDir; } if (str[0] != '\0') { objPtr = Tcl_NewStringObj(str, -1); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); } } Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); str = Tcl_GetStringFromObj(pathPtr, lengthPtr); *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, str, *lengthPtr + 1); Tcl_DecrRefCount(pathPtr); } /* *--------------------------------------------------------------------------- * * TclpSetInitialEncodings -- * * Based on the locale, determine the encoding of the operating system * and the default encoding for newly opened files. * * Called at process initialization time, and part way through startup, * we verify that the initial encodings were correctly setup. Depending * on Tcl's environment, there may not have been enough information first * time through (above). * * Results: * None. * * Side effects: * The Tcl library path is converted from native encoding to UTF-8, on * the first call, and the encodings may be changed on first or second * call. * *--------------------------------------------------------------------------- */ void TclpSetInitialEncodings(void) { Tcl_DString encodingName; Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); } static const char * SearchKnownEncodings( const char *encoding) { int left = 0; int right = sizeof(localeTable)/sizeof(LocaleTable); while (left < right) { int test = (left + right)/2; int code = strcmp(localeTable[test].lang, encoding); if (code == 0) { return localeTable[test].encoding; } if (code < 0) { left = test+1; } else { right = test-1; } } return NULL; } const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { const char *encoding; const char *knownEncoding; Tcl_DStringInit(bufPtr); /* * Determine the current encoding from the LC_* or LANG environment * variables. We previously used setlocale() to determine the locale, but * this does not work on some systems (e.g. Linux/i386 RH 5.0). */ #ifdef HAVE_LANGINFO if ( #ifdef WEAK_IMPORT_NL_LANGINFO nl_langinfo != NULL && #endif setlocale(LC_CTYPE, "") != NULL) { Tcl_DString ds; /* * Use a DString so we can modify case. */ Tcl_DStringInit(&ds); encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1); Tcl_UtfToLower(Tcl_DStringValue(&ds)); knownEncoding = SearchKnownEncodings(encoding); if (knownEncoding != NULL) { Tcl_DStringAppend(bufPtr, knownEncoding, -1); } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { Tcl_DStringAppend(bufPtr, encoding, -1); } Tcl_DStringFree(&ds); if (Tcl_DStringLength(bufPtr)) { return Tcl_DStringValue(bufPtr); } } #endif /* HAVE_LANGINFO */ /* * Classic fallback check. This tries a homebrew algorithm to determine * what encoding should be used based on env vars. */ encoding = getenv("LC_ALL"); if (encoding == NULL || encoding[0] == '\0') { encoding = getenv("LC_CTYPE"); } if (encoding == NULL || encoding[0] == '\0') { encoding = getenv("LANG"); } if (encoding == NULL || encoding[0] == '\0') { encoding = NULL; } if (encoding != NULL) { const char *p; Tcl_DString ds; Tcl_DStringInit(&ds); p = encoding; encoding = Tcl_DStringAppend(&ds, p, -1); Tcl_UtfToLower(Tcl_DStringValue(&ds)); knownEncoding = SearchKnownEncodings(encoding); if (knownEncoding != NULL) { Tcl_DStringAppend(bufPtr, knownEncoding, -1); } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { Tcl_DStringAppend(bufPtr, encoding, -1); } if (Tcl_DStringLength(bufPtr)) { Tcl_DStringFree(&ds); return Tcl_DStringValue(bufPtr); } /* * We didn't recognize the full value as an encoding name. If there is * an encoding subfield, we can try to guess from that. */ for (p = encoding; *p != '\0'; p++) { if (*p == '.') { p++; break; } } if (*p != '\0') { knownEncoding = SearchKnownEncodings(p); if (knownEncoding != NULL) { Tcl_DStringAppend(bufPtr, knownEncoding, -1); } else if (NULL != Tcl_GetEncoding(NULL, p)) { Tcl_DStringAppend(bufPtr, p, -1); } } Tcl_DStringFree(&ds); if (Tcl_DStringLength(bufPtr)) { return Tcl_DStringValue(bufPtr); } } return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, -1); } /* *--------------------------------------------------------------------------- * * TclpSetVariables -- * * Performs platform-specific interpreter initialization related to the * tcl_library and tcl_platform variables, and other platform-specific * things. * * Results: * None. * * Side effects: * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl * variables. * *---------------------------------------------------------------------- */ #if defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MAX_ALLOWED > 1020 /* * Helper because whether CFLocaleCopyCurrent and CFLocaleGetIdentifier are * strongly or weakly bound varies by version of OSX, triggering warnings. */ static inline void InitMacLocaleInfoVar( CFLocaleRef (*localeCopyCurrent)(void), CFStringRef (*localeGetIdentifier)(CFLocaleRef), Tcl_Interp *interp) { CFLocaleRef localeRef; CFStringRef locale; char loc[256]; if (localeCopyCurrent == NULL || localeGetIdentifier == NULL) { return; } localeRef = localeCopyCurrent(); if (!localeRef) { return; } locale = localeGetIdentifier(localeRef); if (locale && CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) { if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) { Tcl_ResetResult(interp); } Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY); } CFRelease(localeRef); } #endif /*defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MAX_ALLOWED > 1020*/ void TclpSetVariables( Tcl_Interp *interp) { #ifdef __CYGWIN__ SYSTEM_INFO sysInfo; static OSVERSIONINFOW osInfo; static int osInfoInitialized = 0; char buffer[TCL_INTEGER_SPACE * 2]; #elif !defined(NO_UNAME) struct utsname name; #endif int unameOK; Tcl_DString ds; #ifdef HAVE_COREFOUNDATION char tclLibPath[MAXPATHLEN + 1]; /* * Set msgcat fallback locale to current CFLocale identifier. */ #if MAC_OS_X_VERSION_MAX_ALLOWED > 1020 InitMacLocaleInfoVar(CFLocaleCopyCurrent, CFLocaleGetIdentifier, interp); #endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */ if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) { const char *str; CFBundleRef bundleRef; Tcl_SetVar2(interp, "tclDefaultLibrary", NULL, tclLibPath, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); if ((str != NULL) && (str[0] != '\0')) { char *p = Tcl_DStringValue(&ds); /* * Convert DYLD_FRAMEWORK_PATH from colon to space separated. */ do { if (*p == ':') { *p = ' '; } } while (*p++); Tcl_SetVar2(interp, "tcl_pkgPath", NULL, Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); Tcl_DStringFree(&ds); } bundleRef = CFBundleGetMainBundle(); if (bundleRef) { CFURLRef frameworksURL; Tcl_StatBuf statBuf; frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef); if (frameworksURL) { if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE, (unsigned char*) tclLibPath, MAXPATHLEN) && ! TclOSstat(tclLibPath, &statBuf) && S_ISDIR(statBuf.st_mode)) { Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } CFRelease(frameworksURL); } frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef); if (frameworksURL) { if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE, (unsigned char*) tclLibPath, MAXPATHLEN) && ! TclOSstat(tclLibPath, &statBuf) && S_ISDIR(statBuf.st_mode)) { Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } CFRelease(frameworksURL); } } Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } else #endif /* HAVE_COREFOUNDATION */ { Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY); } #ifdef DJGPP Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY); #endif unameOK = 0; #ifdef __CYGWIN__ unameOK = 1; if (!osInfoInitialized) { void *handle = GetModuleHandleW(L"NTDLL"); int(__stdcall *getversion)(void *) = (int(__stdcall *)(void *))GetProcAddress(handle, "RtlGetVersion"); osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); if (!getversion || getversion(&osInfo)) { GetVersionExW(&osInfo); } osInfoInitialized = 1; } GetSystemInfo(&sysInfo); if (osInfo.dwMajorVersion == 10 && osInfo.dwBuildNumber >= 22000) { osInfo.dwMajorVersion = 11; } Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); snprintf(buffer, sizeof(buffer), "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", processors[sysInfo.wProcessorArchitecture], TCL_GLOBAL_ONLY); } #elif !defined NO_UNAME if (uname(&name) >= 0) { const char *native; unameOK = 1; native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds); Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds); /* * The following code is a special hack to handle differences in the * way version information is returned by uname. On most systems the * full version number is available in name.release. However, under * AIX the major version number is in name.version and the minor * version number is in name.release. */ if ((strchr(name.release, '.') != NULL) || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */ Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, TCL_GLOBAL_ONLY); } else { #ifdef DJGPP /* * For some obscure reason DJGPP puts major version into * name.release and minor into name.version. As of DJGPP 2.04 this * is documented in djgpp libc.info file. */ Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); #else Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); #endif /* DJGPP */ } Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine, TCL_GLOBAL_ONLY); } #endif /* !NO_UNAME */ if (!unameOK) { Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY); } /* * Copy the username of the real user (according to getuid()) into * tcl_platform(user). */ { struct passwd *pwEnt = TclpGetPwUid(getuid()); const char *user; if (pwEnt == NULL) { user = ""; Tcl_DStringInit(&ds); /* ensure cleanliness */ } else { user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds); } Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds); } /* * Define what the platform PATH separator is. [TIP #315] */ Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ":", TCL_GLOBAL_ONLY); } /* *---------------------------------------------------------------------- * * TclpFindVariable -- * * Locate the entry in environ for a given name. On Unix this routine is * case sensitive, on Windows this matches mixed case. * * Results: * The return value is the index in environ of an entry with the name * "name", or -1 if there is no such entry. The integer at *lengthPtr is * filled in with the length of name (if a matching entry is found) or * the length of the environ array (if no matching entry is found). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpFindVariable( const char *name, /* Name of desired environment variable * (native). */ int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { int i, result = -1; const char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); p2 = name; for (; *p2 == *p1; p1++, p2++) { /* NULL loop body. */ } if ((*p1 == '=') && (*p2 == '\0')) { *lengthPtr = p2 - name; result = i; goto done; } Tcl_DStringFree(&envString); } *lengthPtr = i; done: Tcl_DStringFree(&envString); return result; } /* *---------------------------------------------------------------------- * * MacOSXGetLibraryPath -- * * If we have a bundle structure for the Tcl installation, then check * there first to see if we can find the libraries there. * * Results: * TCL_OK if we have found the tcl library; TCL_ERROR otherwise. * * Side effects: * Same as for Tcl_MacOSXOpenVersionedBundleResources. * *---------------------------------------------------------------------- */ #ifdef HAVE_COREFOUNDATION static int MacOSXGetLibraryPath( Tcl_Interp *interp, int maxPathLen, char *tclLibPath) { int foundInFramework = TCL_ERROR; #ifdef TCL_FRAMEWORK foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, tclLibPath); #endif return foundInFramework; } #endif /* HAVE_COREFOUNDATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixNotfy.c0000644000175000017500000011647514554262142015455 0ustar sergeisergei#define AT_FORK_INIT_VALUE 0 #define RESET_ATFORK_MUTEX 1 /* * tclUnixNotify.c -- * * This file contains the implementation of the select()-based * Unix-specific notifier, which is the lowest-level part of the Tcl * event loop. This file works together with generic/tclNotify.c. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is * in tclMacOSXNotify.c */ #include /* * This structure is used to keep track of the notifier info for a registered * file. */ typedef struct FileHandler { int fd; int mask; /* Mask of desired events: TCL_READABLE, * etc. */ int readyMask; /* Mask of events that have been seen since * the last time file handlers were invoked * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; /* * The following structure is what is added to the Tcl event queue when file * handlers are ready to fire. */ typedef struct FileHandlerEvent { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find * the FileHandler structure for the file * (can't point directly to the FileHandler * structure because it could go away while * the event is queued). */ } FileHandlerEvent; /* * The following structure contains a set of select() masks to track readable, * writable, and exception conditions. */ typedef struct SelectMasks { fd_set readable; fd_set writable; fd_set exception; } SelectMasks; /* * The following static structure contains the state information for the * select based implementation of the Tcl notifier. One of these structures is * created for each thread that is using the notifier. */ typedef struct ThreadSpecificData { FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler list. */ SelectMasks checkMasks; /* This structure is used to build up the * masks to be used in the next call to * select. Bits are set in response to calls * to Tcl_CreateFileHandler. */ SelectMasks readyMasks; /* This array reflects the readable/writable * conditions that were found to exist by the * last call to select. */ int numFdBits; /* Number of valid bits in checkMasks (one * more than highest fd for which * Tcl_WatchFile has been called). */ #ifdef TCL_THREADS int onList; /* True if it is in this list */ unsigned int pollState; /* pollState is used to implement a polling * handshake between each thread and the * notifier thread. Bits defined below. */ struct ThreadSpecificData *nextPtr, *prevPtr; /* All threads that are currently waiting on * an event have their ThreadSpecificData * structure on a doubly-linked listed formed * from these pointers. You must hold the * notifierMutex lock before accessing these * fields. */ #ifdef __CYGWIN__ void *event; /* Any other thread alerts a notifier that an * event is ready to be processed by sending * this event. */ void *hwnd; /* Messaging window. */ #else /* !__CYGWIN__ */ pthread_cond_t waitCV; /* Any other thread alerts a notifier that an * event is ready to be processed by signaling * this condition variable. */ #endif /* __CYGWIN__ */ int waitCVinitialized; /* Variable to flag initialization of the * structure. */ int eventReady; /* True if an event is ready to be processed. * Used as condition flag together with waitCV * above. */ #endif /* TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #ifdef TCL_THREADS /* * The following static indicates the number of threads that have initialized * notifiers. * * You must hold the notifierMutex lock before accessing this variable. */ static int notifierCount = 0; /* * The following variable points to the head of a doubly-linked list of * ThreadSpecificData structures for all threads that are currently waiting on * an event. * * You must hold the notifierMutex lock before accessing this list. */ static ThreadSpecificData *waitingListPtr = NULL; /* * The notifier thread spends all its time in select() waiting for a file * descriptor associated with one of the threads on the waitingListPtr list to * do something interesting. But if the contents of the waitingListPtr list * ever changes, we need to wake up and restart the select() system call. You * can wake up the notifier thread by writing a single byte to the file * descriptor defined below. This file descriptor is the input-end of a pipe * and the notifier thread is listening for data on the output-end of the same * pipe. Hence writing to this file descriptor will cause the select() system * call to return and wake up the notifier thread. * * You must hold the notifierMutex lock before writing to the pipe. */ static int triggerPipe = -1; /* * The notifierMutex locks access to all of the global notifier state. */ static pthread_mutex_t notifierInitMutex = PTHREAD_MUTEX_INITIALIZER; static pthread_mutex_t notifierMutex = PTHREAD_MUTEX_INITIALIZER; /* * The following static indicates if the notifier thread is running. * * You must hold the notifierInitMutex before accessing this variable. */ static int notifierThreadRunning = 0; /* * The notifier thread signals the notifierCV when it has finished * initializing the triggerPipe and right before the notifier thread * terminates. */ static pthread_cond_t notifierCV = PTHREAD_COND_INITIALIZER; /* * The pollState bits: * * POLL_WANT is set by each thread before it waits on its condition variable. * It is checked by the notifier before it does select. * * POLL_DONE is set by the notifier if it goes into select after seeing * POLL_WANT. The idea is to ensure it tries a select with the same bits * the initial thread had set. */ #define POLL_WANT 0x1 #define POLL_DONE 0x2 /* * This is the thread ID of the notifier thread that does select. */ static Tcl_ThreadId notifierThread; #endif /* TCL_THREADS */ /* * Static routines defined in this file. */ #ifdef TCL_THREADS static void NotifierThreadProc(void *clientData); #if defined(HAVE_PTHREAD_ATFORK) static int atForkInit = AT_FORK_INIT_VALUE; static void AtForkPrepare(void); static void AtForkParent(void); static void AtForkChild(void); #endif /* HAVE_PTHREAD_ATFORK */ #endif /* TCL_THREADS */ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); /* * Import of Windows API when building threaded with Cygwin. */ #if defined(TCL_THREADS) && defined(__CYGWIN__) typedef struct { void *hwnd; /* Messaging window. */ unsigned int *message; /* Message payload. */ size_t wParam; /* Event-specific "word" parameter. */ size_t lParam; /* Event-specific "long" parameter. */ int time; /* Event timestamp. */ int x; /* Event location (where meaningful). */ int y; int lPrivate; } MSG; typedef struct { unsigned int style; void *lpfnWndProc; int cbClsExtra; int cbWndExtra; void *hInstance; void *hIcon; void *hCursor; void *hbrBackground; const void *lpszMenuName; const void *lpszClassName; } WNDCLASSW; extern void __stdcall CloseHandle(void *); extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char, void *); extern void * __stdcall CreateWindowExW(void *, const void *, const void *, unsigned int, int, int, int, int, void *, void *, void *, void *); extern unsigned int __stdcall DefWindowProcW(void *, int, void *, void *); extern unsigned char __stdcall DestroyWindow(void *); extern int __stdcall DispatchMessageW(const MSG *); extern unsigned char __stdcall GetMessageW(MSG *, void *, int, int); extern void __stdcall MsgWaitForMultipleObjects(unsigned int, void *, unsigned char, unsigned int, unsigned int); extern unsigned char __stdcall PeekMessageW(MSG *, void *, int, int, int); extern unsigned char __stdcall PostMessageW(void *, unsigned int, void *, void *); extern void __stdcall PostQuitMessage(int); extern void *__stdcall RegisterClassW(const WNDCLASSW *); extern unsigned char __stdcall ResetEvent(void *); extern unsigned char __stdcall TranslateMessage(const MSG *); /* * Threaded-cygwin specific constants and functions in this file: */ static const wchar_t *NotfyClassName = L"TclNotifier"; static unsigned int __stdcall NotifierProc(void *hwnd, unsigned int message, void *wParam, void *lParam); #endif /* TCL_THREADS && __CYGWIN__ */ #if TCL_THREADS /* *---------------------------------------------------------------------- * * StartNotifierThread -- * * Start a notfier thread and wait for the notifier pipe to be created. * * Results: * None. * * Side effects: * Running Thread. * *---------------------------------------------------------------------- */ static void StartNotifierThread(const char *proc) { if (!notifierThreadRunning) { pthread_mutex_lock(¬ifierInitMutex); if (!notifierThreadRunning) { if (TclpThreadCreate(¬ifierThread, NotifierThreadProc, NULL, TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) { Tcl_Panic("%s: unable to start notifier thread", proc); } pthread_mutex_lock(¬ifierMutex); /* * Wait for the notifier pipe to be created. */ while (triggerPipe < 0) { pthread_cond_wait(¬ifierCV, ¬ifierMutex); } pthread_mutex_unlock(¬ifierMutex); notifierThreadRunning = 1; } pthread_mutex_unlock(¬ifierInitMutex); } } #endif /* TCL_THREADS */ /* *---------------------------------------------------------------------- * * Tcl_InitNotifier -- * * Initializes the platform specific notifier state. * * Results: * Returns a handle to the notifier state for this thread. * * Side effects: * None. * *---------------------------------------------------------------------- */ void * Tcl_InitNotifier(void) { if (tclNotifierHooks.initNotifierProc) { return tclNotifierHooks.initNotifierProc(); } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #ifdef TCL_THREADS tsdPtr->eventReady = 0; /* * Initialize thread specific condition variable for this thread. */ if (tsdPtr->waitCVinitialized == 0) { #ifdef __CYGWIN__ WNDCLASSW clazz; clazz.style = 0; clazz.cbClsExtra = 0; clazz.cbWndExtra = 0; clazz.hInstance = TclWinGetTclInstance(); clazz.hbrBackground = NULL; clazz.lpszMenuName = NULL; clazz.lpszClassName = NotfyClassName; clazz.lpfnWndProc = (void *)NotifierProc; clazz.hIcon = NULL; clazz.hCursor = NULL; RegisterClassW(&clazz); tsdPtr->hwnd = CreateWindowExW(NULL, clazz.lpszClassName, clazz.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL, clazz.hInstance, NULL); tsdPtr->event = CreateEventW(NULL, 1 /* manual */, 0 /* !signaled */, NULL); #else pthread_cond_init(&tsdPtr->waitCV, NULL); #endif /* __CYGWIN__ */ tsdPtr->waitCVinitialized = 1; } pthread_mutex_lock(¬ifierInitMutex); #if defined(HAVE_PTHREAD_ATFORK) /* * Install pthread_atfork handlers to clean up the notifier in the * child of a fork. */ if (!atForkInit) { int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild); if (result) { Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed"); } atForkInit = 1; } #endif /* HAVE_PTHREAD_ATFORK */ notifierCount++; pthread_mutex_unlock(¬ifierInitMutex); #endif /* TCL_THREADS */ return tsdPtr; } } /* *---------------------------------------------------------------------- * * Tcl_FinalizeNotifier -- * * This function is called to cleanup the notifier state before a thread * is terminated. * * Results: * None. * * Side effects: * May terminate the background notifier thread if this is the last * notifier instance. * *---------------------------------------------------------------------- */ void Tcl_FinalizeNotifier( void *clientData) { if (tclNotifierHooks.finalizeNotifierProc) { tclNotifierHooks.finalizeNotifierProc(clientData); return; } else { #ifdef TCL_THREADS ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); pthread_mutex_lock(¬ifierInitMutex); notifierCount--; /* * If this is the last thread to use the notifier, close the notifier * pipe and wait for the background thread to terminate. */ if (notifierCount == 0 && triggerPipe != -1) { if (write(triggerPipe, "q", 1) != 1) { Tcl_Panic("Tcl_FinalizeNotifier: %s", "unable to write 'q' to triggerPipe"); } close(triggerPipe); pthread_mutex_lock(¬ifierMutex); while(triggerPipe != -1) { pthread_cond_wait(¬ifierCV, ¬ifierMutex); } pthread_mutex_unlock(¬ifierMutex); if (notifierThreadRunning) { int result = pthread_join((pthread_t) notifierThread, NULL); if (result) { Tcl_Panic("Tcl_FinalizeNotifier: %s", "unable to join notifier thread"); } notifierThreadRunning = 0; } } /* * Clean up any synchronization objects in the thread local storage. */ #ifdef __CYGWIN__ DestroyWindow(tsdPtr->hwnd); CloseHandle(tsdPtr->event); #else /* __CYGWIN__ */ pthread_cond_destroy(&tsdPtr->waitCV); #endif /* __CYGWIN__ */ tsdPtr->waitCVinitialized = 0; pthread_mutex_unlock(¬ifierInitMutex); #endif /* TCL_THREADS */ } } /* *---------------------------------------------------------------------- * * Tcl_AlertNotifier -- * * Wake up the specified notifier from any thread. This routine is called * by the platform independent notifier code whenever the Tcl_ThreadAlert * routine is called. This routine is guaranteed not to be called on a * given notifier after Tcl_FinalizeNotifier is called for that notifier. * * Results: * None. * * Side effects: * Signals the notifier condition variable for the specified notifier. * *---------------------------------------------------------------------- */ void Tcl_AlertNotifier( void *clientData) { if (tclNotifierHooks.alertNotifierProc) { tclNotifierHooks.alertNotifierProc(clientData); return; } else { #ifdef TCL_THREADS ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; pthread_mutex_lock(¬ifierMutex); tsdPtr->eventReady = 1; # ifdef __CYGWIN__ PostMessageW(tsdPtr->hwnd, 1024, 0, 0); # else pthread_cond_broadcast(&tsdPtr->waitCV); # endif /* __CYGWIN__ */ pthread_mutex_unlock(¬ifierMutex); #endif /* TCL_THREADS */ } } /* *---------------------------------------------------------------------- * * Tcl_SetTimer -- * * This function sets the current notifier timer value. This interface is * not implemented in this notifier because we are always running inside * of Tcl_DoOneEvent. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_SetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { if (tclNotifierHooks.setTimerProc) { tclNotifierHooks.setTimerProc(timePtr); return; } else { /* * The interval timer doesn't do anything in this implementation, * because the only event loop is via Tcl_DoOneEvent, which passes * timeout values to Tcl_WaitForEvent. */ } } /* *---------------------------------------------------------------------- * * Tcl_ServiceModeHook -- * * This function is invoked whenever the service mode changes. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_ServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { if (tclNotifierHooks.serviceModeHookProc) { tclNotifierHooks.serviceModeHookProc(mode); return; } else if (mode == TCL_SERVICE_ALL) { #if TCL_THREADS StartNotifierThread("Tcl_ServiceModeHook"); #endif } } /* *---------------------------------------------------------------------- * * Tcl_CreateFileHandler -- * * This function registers a file handler with the select notifier. * * Results: * None. * * Side effects: * Creates a new file handler structure. * *---------------------------------------------------------------------- */ void Tcl_CreateFileHandler( int fd, /* Handle of stream to watch. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ void *clientData) /* Arbitrary data to pass to proc. */ { if (tclNotifierHooks.createFileHandlerProc) { tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); return; } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr; for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; tsdPtr->firstFileHandlerPtr = filePtr; } filePtr->proc = proc; filePtr->clientData = clientData; filePtr->mask = mask; /* * Update the check masks for this file. */ if (mask & TCL_READABLE) { FD_SET(fd, &tsdPtr->checkMasks.readable); } else { FD_CLR(fd, &tsdPtr->checkMasks.readable); } if (mask & TCL_WRITABLE) { FD_SET(fd, &tsdPtr->checkMasks.writable); } else { FD_CLR(fd, &tsdPtr->checkMasks.writable); } if (mask & TCL_EXCEPTION) { FD_SET(fd, &tsdPtr->checkMasks.exception); } else { FD_CLR(fd, &tsdPtr->checkMasks.exception); } if (tsdPtr->numFdBits <= fd) { tsdPtr->numFdBits = fd+1; } } } /* *---------------------------------------------------------------------- * * Tcl_DeleteFileHandler -- * * Cancel a previously-arranged callback arrangement for a file. * * Results: * None. * * Side effects: * If a callback was previously registered on file, remove it. * *---------------------------------------------------------------------- */ void Tcl_DeleteFileHandler( int fd) /* Stream id for which to remove callback * function. */ { if (tclNotifierHooks.deleteFileHandlerProc) { tclNotifierHooks.deleteFileHandlerProc(fd); return; } else { FileHandler *filePtr, *prevPtr; int i; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Find the entry for the given file (and return if there isn't one). */ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; prevPtr = filePtr, filePtr = filePtr->nextPtr) { if (filePtr == NULL) { return; } if (filePtr->fd == fd) { break; } } /* * Update the check masks for this file. */ if (filePtr->mask & TCL_READABLE) { FD_CLR(fd, &tsdPtr->checkMasks.readable); } if (filePtr->mask & TCL_WRITABLE) { FD_CLR(fd, &tsdPtr->checkMasks.writable); } if (filePtr->mask & TCL_EXCEPTION) { FD_CLR(fd, &tsdPtr->checkMasks.exception); } /* * Find current max fd. */ if (fd+1 == tsdPtr->numFdBits) { int numFdBits = 0; for (i = fd-1; i >= 0; i--) { if (FD_ISSET(i, &tsdPtr->checkMasks.readable) || FD_ISSET(i, &tsdPtr->checkMasks.writable) || FD_ISSET(i, &tsdPtr->checkMasks.exception)) { numFdBits = i+1; break; } } tsdPtr->numFdBits = numFdBits; } /* * Clean up information in the callback record. */ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } ckfree(filePtr); } } /* *---------------------------------------------------------------------- * * FileHandlerEventProc -- * * This function is called by Tcl_ServiceEvent when a file event reaches * the front of the event queue. This function is responsible for * actually handling the event by invoking the callback for the file * handler. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the file handler's callback function does. * *---------------------------------------------------------------------- */ static int FileHandlerEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { int mask; FileHandler *filePtr; FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr; ThreadSpecificData *tsdPtr; if (!(flags & TCL_FILE_EVENTS)) { return 0; } /* * Search through the file handlers to find the one whose handle matches * the event. We do this rather than keeping a pointer to the file handler * directly in the event, so that the handler can be deleted while the * event is queued without leaving a dangling pointer. */ tsdPtr = TCL_TSD_INIT(&dataKey); for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd != fileEvPtr->fd) { continue; } /* * The code is tricky for two reasons: * 1. The file handler's desired events could have changed since the * time when the event was queued, so AND the ready mask with the * desired mask. * 2. The file could have been closed and re-opened since the time * when the event was queued. This is why the ready mask is stored * in the file handler rather than the queued event: it will be * zeroed when a new file handler is created for the newly opened * file. */ mask = filePtr->readyMask & filePtr->mask; filePtr->readyMask = 0; if (mask != 0) { filePtr->proc(filePtr->clientData, mask); } break; } return 1; } #if defined(TCL_THREADS) && defined(__CYGWIN__) static unsigned int __stdcall NotifierProc( void *hwnd, unsigned int message, void *wParam, void *lParam) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (message != 1024) { return DefWindowProcW(hwnd, message, wParam, lParam); } /* * Process all of the runnable events. */ tsdPtr->eventReady = 1; Tcl_ServiceAll(); return 0; } #endif /* TCL_THREADS && __CYGWIN__ */ /* *---------------------------------------------------------------------- * * Tcl_WaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on * the message queue. If the block time is 0, then Tcl_WaitForEvent just * polls without blocking. * * Results: * Returns -1 if the select would block forever, otherwise returns 0. * * Side effects: * Queues file events that are detected by the select. * *---------------------------------------------------------------------- */ int Tcl_WaitForEvent( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { if (tclNotifierHooks.waitForEventProc) { return tclNotifierHooks.waitForEventProc(timePtr); } else { FileHandler *filePtr; int mask; Tcl_Time vTime; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #ifdef TCL_THREADS int waitForFiles; # ifdef __CYGWIN__ MSG msg; # endif /* __CYGWIN__ */ #else /* !TCL_THREADS */ /* * Impl. notes: timeout & timeoutPtr are used if, and only if threads * are not enabled. They are the arguments for the regular select() * used when the core is not thread-enabled. */ struct timeval timeout, *timeoutPtr; int numFound; #endif /* TCL_THREADS */ /* * Set up the timeout structure. Note that if there are no events to * check for, we return with a negative result rather than blocking * forever. */ if (timePtr != NULL) { /* * TIP #233 (Virtualized Time). Is virtual time in effect? And do * we actually have something to scale? If yes to both then we * call the handler to do this scaling. */ if (timePtr->sec != 0 || timePtr->usec != 0) { vTime = *timePtr; tclScaleTimeProcPtr(&vTime, tclTimeClientData); timePtr = &vTime; } #ifndef TCL_THREADS timeout.tv_sec = timePtr->sec; timeout.tv_usec = timePtr->usec; timeoutPtr = &timeout; } else if (tsdPtr->numFdBits == 0) { /* * If there are no threads, no timeout, and no fds registered, * then there are no events possible and we must avoid deadlock. * Note that this is not entirely correct because there might be a * signal that could interrupt the select call, but we don't * handle that case if we aren't using threads. */ return -1; } else { timeoutPtr = NULL; #endif /* !TCL_THREADS */ } #ifdef TCL_THREADS /* * Start notifier thread and place this thread on the list of * interested threads, signal the notifier thread, and wait for a * response or a timeout. */ StartNotifierThread("Tcl_WaitForEvent"); pthread_mutex_lock(¬ifierMutex); if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0 #if defined(__APPLE__) && defined(__LP64__) /* * On 64-bit Darwin, pthread_cond_timedwait() appears to have * a bug that causes it to wait forever when passed an * absolute time which has already been exceeded by the system * time; as a workaround, when given a very brief timeout, * just do a poll. [Bug 1457797] */ || timePtr->usec < 10 #endif /* __APPLE__ && __LP64__ */ )) { /* * Cannot emulate a polling select with a polling condition * variable. Instead, pretend to wait for files and tell the * notifier thread what we are doing. The notifier thread makes * sure it goes through select with its select mask in the same * state as ours currently is. We block until that happens. */ waitForFiles = 1; tsdPtr->pollState = POLL_WANT; timePtr = NULL; } else { waitForFiles = (tsdPtr->numFdBits > 0); tsdPtr->pollState = 0; } if (waitForFiles) { /* * Add the ThreadSpecificData structure of this thread to the list * of ThreadSpecificData structures of all threads that are * waiting on file events. */ tsdPtr->nextPtr = waitingListPtr; if (waitingListPtr) { waitingListPtr->prevPtr = tsdPtr; } tsdPtr->prevPtr = 0; waitingListPtr = tsdPtr; tsdPtr->onList = 1; if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { Tcl_Panic("Tcl_WaitForEvent: %s", "unable to write to triggerPipe"); } } FD_ZERO(&tsdPtr->readyMasks.readable); FD_ZERO(&tsdPtr->readyMasks.writable); FD_ZERO(&tsdPtr->readyMasks.exception); if (!tsdPtr->eventReady) { #ifdef __CYGWIN__ if (!PeekMessageW(&msg, NULL, 0, 0, 0)) { unsigned int timeout; if (timePtr) { timeout = timePtr->sec * 1000 + timePtr->usec / 1000; } else { timeout = 0xFFFFFFFF; } pthread_mutex_unlock(¬ifierMutex); MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279); pthread_mutex_lock(¬ifierMutex); } #else /* !__CYGWIN__ */ if (timePtr != NULL) { Tcl_Time now; struct timespec ptime; Tcl_GetTime(&now); ptime.tv_sec = timePtr->sec + now.sec + (timePtr->usec + now.usec) / 1000000; ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000); pthread_cond_timedwait(&tsdPtr->waitCV, ¬ifierMutex, &ptime); } else { pthread_cond_wait(&tsdPtr->waitCV, ¬ifierMutex); } #endif /* __CYGWIN__ */ } tsdPtr->eventReady = 0; #ifdef __CYGWIN__ while (PeekMessageW(&msg, NULL, 0, 0, 0)) { /* * Retrieve and dispatch the message. */ unsigned int result = GetMessageW(&msg, NULL, 0, 0); if (result == 0) { PostQuitMessage(msg.wParam); /* What to do here? */ } else if (result != (unsigned int) -1) { TranslateMessage(&msg); DispatchMessageW(&msg); } } ResetEvent(tsdPtr->event); #endif /* __CYGWIN__ */ if (waitForFiles && tsdPtr->onList) { /* * Remove the ThreadSpecificData structure of this thread from the * waiting list. Alert the notifier thread to recompute its select * masks - skipping this caused a hang when trying to close a pipe * which the notifier thread was still doing a select on. */ if (tsdPtr->prevPtr) { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } else { waitingListPtr = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { Tcl_Panic("Tcl_WaitForEvent: %s", "unable to write to triggerPipe"); } } #else /* !TCL_THREADS */ tsdPtr->readyMasks = tsdPtr->checkMasks; numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable, &tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception, timeoutPtr); /* * Some systems don't clear the masks after an error, so we have to do * it here. */ if (numFound == -1) { FD_ZERO(&tsdPtr->readyMasks.readable); FD_ZERO(&tsdPtr->readyMasks.writable); FD_ZERO(&tsdPtr->readyMasks.exception); } #endif /* TCL_THREADS */ /* * Queue all detected file events before returning. */ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL); filePtr = filePtr->nextPtr) { mask = 0; if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) { mask |= TCL_READABLE; } if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) { mask |= TCL_WRITABLE; } if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) { mask |= TCL_EXCEPTION; } if (!mask) { continue; } /* * Don't bother to queue an event if the mask was previously * non-zero since an event must still be on the queue. */ if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } filePtr->readyMask = mask; } #ifdef TCL_THREADS pthread_mutex_unlock(¬ifierMutex); #endif /* TCL_THREADS */ return 0; } } #ifdef TCL_THREADS /* *---------------------------------------------------------------------- * * NotifierThreadProc -- * * This routine is the initial (and only) function executed by the * special notifier thread. Its job is to wait for file descriptors to * become readable or writable or to have an exception condition and then * to notify other threads who are interested in this information by * signalling a condition variable. Other threads can signal this * notifier thread of a change in their interests by writing a single * byte to a special pipe that the notifier thread is monitoring. * * Result: * None. Once started, this routine never exits. It dies with the overall * process. * * Side effects: * The trigger pipe used to signal the notifier thread is created when * the notifier thread first starts. * *---------------------------------------------------------------------- */ static void NotifierThreadProc( void *dummy) /* Not used. */ { ThreadSpecificData *tsdPtr; fd_set readableMask; fd_set writableMask; fd_set exceptionMask; int i; int fds[2], receivePipe; long found; struct timeval poll = {0, 0}, *timePtr; char buf[2]; int numFdBits = 0; (void)dummy; if (pipe(fds) != 0) { Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe"); } receivePipe = fds[0]; if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) { Tcl_Panic("NotifierThreadProc: %s", "could not make receive pipe non blocking"); } if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) { Tcl_Panic("NotifierThreadProc: %s", "could not make trigger pipe non blocking"); } if (fcntl(receivePipe, F_SETFD, FD_CLOEXEC) < 0) { Tcl_Panic("NotifierThreadProc: %s", "could not make receive pipe close-on-exec"); } if (fcntl(fds[1], F_SETFD, FD_CLOEXEC) < 0) { Tcl_Panic("NotifierThreadProc: %s", "could not make trigger pipe close-on-exec"); } /* * Install the write end of the pipe into the global variable. */ pthread_mutex_lock(¬ifierMutex); triggerPipe = fds[1]; /* * Signal any threads that are waiting. */ pthread_cond_broadcast(¬ifierCV); pthread_mutex_unlock(¬ifierMutex); /* * Look for file events and report them to interested threads. */ while (1) { FD_ZERO(&readableMask); FD_ZERO(&writableMask); FD_ZERO(&exceptionMask); /* * Compute the logical OR of the masks from all the waiting * notifiers. */ pthread_mutex_lock(¬ifierMutex); timePtr = NULL; for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { for (i = tsdPtr->numFdBits-1; i >= 0; --i) { if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) { FD_SET(i, &readableMask); } if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) { FD_SET(i, &writableMask); } if (FD_ISSET(i, &tsdPtr->checkMasks.exception)) { FD_SET(i, &exceptionMask); } } if (tsdPtr->numFdBits > numFdBits) { numFdBits = tsdPtr->numFdBits; } if (tsdPtr->pollState & POLL_WANT) { /* * Here we make sure we go through select() with the same mask * bits that were present when the thread tried to poll. */ tsdPtr->pollState |= POLL_DONE; timePtr = &poll; } } pthread_mutex_unlock(¬ifierMutex); /* * Set up the select mask to include the receive pipe. */ if (receivePipe >= numFdBits) { numFdBits = receivePipe + 1; } FD_SET(receivePipe, &readableMask); if (select(numFdBits, &readableMask, &writableMask, &exceptionMask, timePtr) == -1) { /* * Try again immediately on an error. */ continue; } /* * Alert any threads that are waiting on a ready file descriptor. */ pthread_mutex_lock(¬ifierMutex); for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { found = 0; for (i = tsdPtr->numFdBits-1; i >= 0; --i) { if (FD_ISSET(i, &tsdPtr->checkMasks.readable) && FD_ISSET(i, &readableMask)) { FD_SET(i, &tsdPtr->readyMasks.readable); found = 1; } if (FD_ISSET(i, &tsdPtr->checkMasks.writable) && FD_ISSET(i, &writableMask)) { FD_SET(i, &tsdPtr->readyMasks.writable); found = 1; } if (FD_ISSET(i, &tsdPtr->checkMasks.exception) && FD_ISSET(i, &exceptionMask)) { FD_SET(i, &tsdPtr->readyMasks.exception); found = 1; } } if (found || (tsdPtr->pollState & POLL_DONE)) { tsdPtr->eventReady = 1; if (tsdPtr->onList) { /* * Remove the ThreadSpecificData structure of this thread * from the waiting list. This prevents us from * continuously spining on select until the other threads * runs and services the file event. */ if (tsdPtr->prevPtr) { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } else { waitingListPtr = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; tsdPtr->pollState = 0; } #ifdef __CYGWIN__ PostMessageW(tsdPtr->hwnd, 1024, 0, 0); #else /* __CYGWIN__ */ pthread_cond_broadcast(&tsdPtr->waitCV); #endif /* __CYGWIN__ */ } } pthread_mutex_unlock(¬ifierMutex); /* * Consume the next byte from the notifier pipe if the pipe was * readable. Note that there may be multiple bytes pending, but to * avoid a race condition we only read one at a time. */ if (FD_ISSET(receivePipe, &readableMask)) { i = read(receivePipe, buf, 1); if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) { /* * Someone closed the write end of the pipe or sent us a Quit * message [Bug: 4139] and then closed the write end of the * pipe so we need to shut down the notifier thread. */ break; } } } /* * Clean up the read end of the pipe and signal any threads waiting on * termination of the notifier thread. */ close(receivePipe); pthread_mutex_lock(¬ifierMutex); triggerPipe = -1; pthread_cond_broadcast(¬ifierCV); pthread_mutex_unlock(¬ifierMutex); TclpThreadExit(0); } #if defined(HAVE_PTHREAD_ATFORK) /* *---------------------------------------------------------------------- * * AtForkPrepare -- * * Lock the notifier in preparation for a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkPrepare(void) { #if RESET_ATFORK_MUTEX == 0 pthread_mutex_lock(¬ifierInitMutex); #endif } /* *---------------------------------------------------------------------- * * AtForkParent -- * * Unlock the notifier in the parent after a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkParent(void) { #if RESET_ATFORK_MUTEX == 0 pthread_mutex_unlock(¬ifierInitMutex); #endif } /* *---------------------------------------------------------------------- * * AtForkChild -- * * Unlock and reinstall the notifier in the child after a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkChild(void) { if (notifierThreadRunning == 1) { pthread_cond_destroy(¬ifierCV); } #if RESET_ATFORK_MUTEX == 0 pthread_mutex_unlock(¬ifierInitMutex); #else pthread_mutex_init(¬ifierInitMutex, NULL); pthread_mutex_init(¬ifierMutex, NULL); #endif pthread_cond_init(¬ifierCV, NULL); /* * notifierThreadRunning == 1: thread is running, (there might be data in notifier lists) * atForkInit == 0: InitNotifier was never called * notifierCount != 0: unbalanced InitNotifier() / FinalizeNotifier calls * waitingListPtr != 0: there are threads currently waiting for events. */ if (atForkInit == 1) { notifierCount = 0; if (notifierThreadRunning == 1) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); notifierThreadRunning = 0; close(triggerPipe); triggerPipe = -1; /* * The waitingListPtr might contain event info from multiple * threads, which are invalid here, so setting it to NULL is not * unreasonable. */ waitingListPtr = NULL; /* * The tsdPtr from before the fork is copied as well. But since * we are paranoiac, we don't trust its condvar and reset it. */ #ifdef __CYGWIN__ DestroyWindow(tsdPtr->hwnd); tsdPtr->hwnd = CreateWindowExW(NULL, NotfyClassName, NotfyClassName, 0, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); ResetEvent(tsdPtr->event); #else pthread_cond_destroy(&tsdPtr->waitCV); pthread_cond_init(&tsdPtr->waitCV, NULL); #endif /* * In case, we had multiple threads running before the fork, * make sure, we don't try to reach out to their thread local data. */ tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; /* * The list of registered event handlers at fork time is in * tsdPtr->firstFileHandlerPtr; */ } } Tcl_InitNotifier(); } #endif /* HAVE_PTHREAD_ATFORK */ #endif /* TCL_THREADS */ #else TCL_MAC_EMPTY_FILE(unix_tclUnixNotfy_c) #endif /* !HAVE_COREFOUNDATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixPipe.c0000644000175000017500000010540014554262142015235 0ustar sergeisergei/* * tclUnixPipe.c -- * * This file implements the UNIX-specific exec pipeline functions, the * "pipe" channel driver, and the "pid" Tcl command. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef HAVE_POSIX_SPAWNP # if defined(HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDDUP2) \ && defined(HAVE_POSIX_SPAWNATTR_SETFLAGS) \ && !defined(HAVE_VFORK) # include # include # else # undef HAVE_POSIX_SPAWNP # endif #endif #ifdef HAVE_VFORK #define fork vfork #endif /* * The following macros convert between TclFile's and fd's. The conversion * simple involves shifting fd's up by one to ensure that no valid fd is ever * the same as NULL. */ #define MakeFile(fd) ((TclFile) INT2PTR(((int) (fd)) + 1)) #define GetFd(file) (PTR2INT(file) - 1) /* * This structure describes per-instance state of a pipe based channel. */ typedef struct PipeState { Tcl_Channel channel; /* Channel associated with this file. */ TclFile inFile; /* Output from pipe. */ TclFile outFile; /* Input to pipe. */ TclFile errorFile; /* Error output from pipe. */ int numPids; /* How many processes are attached to this * pipe? */ Tcl_Pid *pidPtr; /* The process IDs themselves. Allocated by * the creator of the pipe. */ int isNonBlocking; /* Nonzero when the pipe is in nonblocking * mode. Used to decide whether to wait for * the children at close time. */ } PipeState; /* * Declarations for local functions defined in this file: */ static int PipeBlockModeProc(ClientData instanceData, int mode); static int PipeClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags); static int PipeGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static int PipeInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int PipeOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static void PipeWatchProc(ClientData instanceData, int mask); static void RestoreSignals(void); static int SetupStdFile(TclFile file, int type); /* * This structure describes the channel type structure for command pipe based * I/O: */ static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TCL_CLOSE2PROC, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ PipeWatchProc, /* Initialize notifier. */ PipeGetHandleProc, /* Get OS handles out of channel. */ PipeClose2Proc, /* close2proc. */ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ NULL, /* thread action proc */ NULL /* truncation */ }; /* *---------------------------------------------------------------------- * * TclpMakeFile -- * * Make a TclFile from a channel. * * Results: * Returns a new TclFile or NULL on failure. * * Side effects: * None. * *---------------------------------------------------------------------- */ TclFile TclpMakeFile( Tcl_Channel channel, /* Channel to get file from. */ int direction) /* Either TCL_READABLE or TCL_WRITABLE. */ { ClientData data; if (Tcl_GetChannelHandle(channel, direction, &data) != TCL_OK) { return NULL; } return MakeFile(PTR2INT(data)); } /* *---------------------------------------------------------------------- * * TclpOpenFile -- * * Open a file for use in a pipeline. * * Results: * Returns a new TclFile handle or NULL on failure. * * Side effects: * May cause a file to be created on the file system. * *---------------------------------------------------------------------- */ TclFile TclpOpenFile( const char *fname, /* The name of the file to open. */ int mode) /* In what mode to open the file? */ { int fd; const char *native; Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fname, -1, &ds); fd = TclOSopen(native, mode, 0666); /* INTL: Native. */ Tcl_DStringFree(&ds); if (fd != -1) { fcntl(fd, F_SETFD, FD_CLOEXEC); /* * If the file is being opened for writing, seek to the end so we can * append to any data already in the file. */ if ((mode & O_WRONLY) && !(mode & O_APPEND)) { TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_END); } /* * Increment the fd so it can't be 0, which would conflict with the * NULL return for errors. */ return MakeFile(fd); } return NULL; } /* *---------------------------------------------------------------------- * * TclpCreateTempFile -- * * This function creates a temporary file initialized with an optional * string, and returns a file handle with the file pointer at the * beginning of the file. * * Results: * A handle to a file. * * Side effects: * None. * *---------------------------------------------------------------------- */ TclFile TclpCreateTempFile( const char *contents) /* String to write into temp file, or NULL. */ { int fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, NULL); if (fd == -1) { return NULL; } fcntl(fd, F_SETFD, FD_CLOEXEC); if (contents != NULL) { Tcl_DString dstring; char *native; native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) { close(fd); Tcl_DStringFree(&dstring); return NULL; } Tcl_DStringFree(&dstring); TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_SET); } return MakeFile(fd); } /* *---------------------------------------------------------------------- * * TclpTempFileName -- * * This function returns unique filename. * * Results: * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * TclpTempFileName(void) { Tcl_Obj *retVal, *nameObj; int fd; TclNewObj(nameObj); Tcl_IncrRefCount(nameObj); fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, nameObj); if (fd == -1) { Tcl_DecrRefCount(nameObj); return NULL; } fcntl(fd, F_SETFD, FD_CLOEXEC); TclpObjDeleteFile(nameObj); close(fd); retVal = Tcl_DuplicateObj(nameObj); Tcl_DecrRefCount(nameObj); return retVal; } /* *---------------------------------------------------------------------------- * * TclpTempFileNameForLibrary -- * * Constructs a file name in the native file system where a dynamically * loaded library may be placed. * * Results: * Returns the constructed file name. If an error occurs, returns NULL * and leaves an error message in the interpreter result. * * On Unix, it works to load a shared object from a file of any name, so this * function is merely a thin wrapper around TclpTempFileName(). * *---------------------------------------------------------------------------- */ Tcl_Obj * TclpTempFileNameForLibrary( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *path) /* Path name of the library in the VFS. */ { Tcl_Obj *retval = TclpTempFileName(); if (retval == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create temporary file: %s", Tcl_PosixError(interp))); } return retval; } /* *---------------------------------------------------------------------- * * TclpCreatePipe -- * * Creates a pipe - simply calls the pipe() function. * * Results: * Returns 1 on success, 0 on failure. * * Side effects: * Creates a pipe. * *---------------------------------------------------------------------- */ int TclpCreatePipe( TclFile *readPipe, /* Location to store file handle for read side * of pipe. */ TclFile *writePipe) /* Location to store file handle for write * side of pipe. */ { int pipeIds[2]; if (pipe(pipeIds) != 0) { return 0; } fcntl(pipeIds[0], F_SETFD, FD_CLOEXEC); fcntl(pipeIds[1], F_SETFD, FD_CLOEXEC); *readPipe = MakeFile(pipeIds[0]); *writePipe = MakeFile(pipeIds[1]); return 1; } /* *---------------------------------------------------------------------- * * TclpCloseFile -- * * Implements a mechanism to close a UNIX file. * * Results: * Returns 0 on success, or -1 on error, setting errno. * * Side effects: * The file is closed. * *---------------------------------------------------------------------- */ int TclpCloseFile( TclFile file) /* The file to close. */ { int fd = GetFd(file); /* * Refuse to close the fds for stdin, stdout and stderr. */ if ((fd == 0) || (fd == 1) || (fd == 2)) { return 0; } Tcl_DeleteFileHandler(fd); return close(fd); } /* *--------------------------------------------------------------------------- * * TclpCreateProcess -- * * Create a child process that has the specified files as its standard * input, output, and error. The child process runs asynchronously and * runs with the same environment variables as the creating process. * * The path is searched to find the specified executable. * * Results: * The return value is TCL_ERROR and an error message is left in the * interp's result if there was a problem creating the child process. * Otherwise, the return value is TCL_OK and *pidPtr is filled with the * process id of the child process. * * Side effects: * A process is created. * *--------------------------------------------------------------------------- */ int TclpCreateProcess( Tcl_Interp *interp, /* Interpreter in which to leave errors that * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ int argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings in UTF-8. * argv[0] contains the name of the executable * translated using Tcl_TranslateFileName * call). Additional arguments have not been * converted. */ TclFile inputFile, /* If non-NULL, gives the file to use as input * for the child process. If inputFile file is * not readable or is NULL, the child will * receive no standard input. */ TclFile outputFile, /* If non-NULL, gives the file that receives * output from the child process. If * outputFile file is not writable or is * NULL, output from the child will be * discarded. */ TclFile errorFile, /* If non-NULL, gives the file that receives * errors from the child process. If errorFile * file is not writable or is NULL, errors * from the child will be discarded. errorFile * may be the same as outputFile. */ Tcl_Pid *pidPtr) /* If this function is successful, pidPtr is * filled with the process id of the child * process. */ { TclFile errPipeIn, errPipeOut; int count, status, fd; char errSpace[200 + TCL_INTEGER_SPACE]; Tcl_DString *dsArray; char **newArgv; int pid; int i; #if defined(HAVE_POSIX_SPAWNP) int childErrno; static int use_spawn = -1; #endif errPipeIn = NULL; errPipeOut = NULL; pid = -1; /* * Create a pipe that the child can use to return error information if * anything goes wrong. */ if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create pipe: %s", Tcl_PosixError(interp))); goto error; } /* * We need to allocate and convert this before the fork so it is properly * deallocated later */ dsArray = (Tcl_DString *)TclStackAlloc(interp, argc * sizeof(Tcl_DString)); newArgv = (char **)TclStackAlloc(interp, (argc+1) * sizeof(char *)); newArgv[argc] = NULL; for (i = 0; i < argc; i++) { newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]); } #if defined(HAVE_VFORK) || defined(HAVE_POSIX_SPAWNP) /* * After vfork(), do not call code in the child that changes global state, * because it is using the parent's memory space at that point and writes * might corrupt the parent: so ensure standard channels are initialized * in the parent, otherwise SetupStdFile() might initialize them in the * child. */ if (!inputFile) { Tcl_GetStdChannel(TCL_STDIN); } if (!outputFile) { Tcl_GetStdChannel(TCL_STDOUT); } if (!errorFile) { Tcl_GetStdChannel(TCL_STDERR); } #endif #ifdef HAVE_POSIX_SPAWNP #ifdef _CS_GNU_LIBC_VERSION if (use_spawn < 0) { char conf[32], *p; int major = 0, minor = 0; use_spawn = 0; memset(conf, 0, sizeof(conf)); confstr(_CS_GNU_LIBC_VERSION, conf, sizeof(conf)); p = strchr(conf, ' '); /* skip "glibc" */ if (p != NULL) { ++p; if (sscanf(p, "%d.%d", &major, &minor) > 1) { if ((major > 2) || ((major == 2) && (minor >= 24))) { use_spawn = 1; } } } } #endif status = -1; if (use_spawn) { posix_spawn_file_actions_t actions; posix_spawnattr_t attr; sigset_t sigs; posix_spawn_file_actions_init(&actions); posix_spawnattr_init(&attr); sigfillset(&sigs); sigdelset(&sigs, SIGKILL); sigdelset(&sigs, SIGSTOP); posix_spawnattr_setflags(&attr, POSIX_SPAWN_SETSIGDEF #ifdef POSIX_SPAWN_USEVFORK | POSIX_SPAWN_USEVFORK #endif ); posix_spawnattr_setsigdefault(&attr, &sigs); posix_spawn_file_actions_adddup2(&actions, GetFd(inputFile), 0); posix_spawn_file_actions_adddup2(&actions, GetFd(outputFile), 1); posix_spawn_file_actions_adddup2(&actions, GetFd(errorFile), 2); status = posix_spawnp(&pid, newArgv[0], &actions, &attr, newArgv, environ); childErrno = errno; posix_spawn_file_actions_destroy(&actions); posix_spawnattr_destroy(&attr); /* * Fork semantics: * - pid == 0: child process * - pid == -1: error * - pid > 0: parent process * * Mimic fork semantics to minimize changes below, * but retry with fork() as last ressort. */ } if (status != 0) { pid = fork(); childErrno = errno; } #else pid = fork(); #endif if (pid == 0) { size_t len; int joinThisError = errorFile && (errorFile == outputFile); fd = GetFd(errPipeOut); /* * Set up stdio file handles for the child process. */ if (!SetupStdFile(inputFile, TCL_STDIN) || !SetupStdFile(outputFile, TCL_STDOUT) || (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR)) || (joinThisError && ((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) { snprintf(errSpace, sizeof(errSpace), "%dforked process couldn't set up input/output", errno); len = strlen(errSpace); if (len != (size_t) write(fd, errSpace, len)) { Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut"); } _exit(1); } /* * Close the input side of the error pipe. */ RestoreSignals(); execvp(newArgv[0], newArgv); /* INTL: Native. */ snprintf(errSpace, sizeof(errSpace), "%dcouldn't execute \"%.150s\"", errno, argv[0]); len = strlen(errSpace); if (len != (size_t) write(fd, errSpace, len)) { Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut"); } _exit(1); } /* * Free the mem we used for the fork */ for (i = 0; i < argc; i++) { Tcl_DStringFree(&dsArray[i]); } TclStackFree(interp, newArgv); TclStackFree(interp, dsArray); if (pid == -1) { #ifdef HAVE_POSIX_SPAWNP errno = childErrno; #endif Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't fork child process: %s", Tcl_PosixError(interp))); goto error; } /* * Read back from the error pipe to see if the child started up OK. The * info in the pipe (if any) consists of a decimal errno value followed by * an error message. */ TclpCloseFile(errPipeOut); errPipeOut = NULL; fd = GetFd(errPipeIn); count = read(fd, errSpace, sizeof(errSpace) - 1); if (count > 0) { char *end; errSpace[count] = 0; errno = strtol(errSpace, &end, 10); Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s: %s", end, Tcl_PosixError(interp))); goto error; } TclpCloseFile(errPipeIn); *pidPtr = (Tcl_Pid) INT2PTR(pid); return TCL_OK; error: if (pid != -1) { /* * Reap the child process now if an error occurred during its startup. * We don't call this with WNOHANG because that can lead to defunct * processes on an MP system. We shouldn't have to worry about hanging * here, since this is the error case. [Bug: 6148] */ Tcl_WaitPid((Tcl_Pid)INT2PTR(pid), &status, 0); } if (errPipeIn) { TclpCloseFile(errPipeIn); } if (errPipeOut) { TclpCloseFile(errPipeOut); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * RestoreSignals -- * * This function is invoked in a forked child process just before * exec-ing a new program to restore all signals to their default * settings. * * Results: * None. * * Side effects: * Signal settings get changed. * *---------------------------------------------------------------------- */ static void RestoreSignals(void) { #ifdef SIGABRT signal(SIGABRT, SIG_DFL); #endif #ifdef SIGALRM signal(SIGALRM, SIG_DFL); #endif #ifdef SIGFPE signal(SIGFPE, SIG_DFL); #endif #ifdef SIGHUP signal(SIGHUP, SIG_DFL); #endif #ifdef SIGILL signal(SIGILL, SIG_DFL); #endif #ifdef SIGINT signal(SIGINT, SIG_DFL); #endif #ifdef SIGPIPE signal(SIGPIPE, SIG_DFL); #endif #ifdef SIGQUIT signal(SIGQUIT, SIG_DFL); #endif #ifdef SIGSEGV signal(SIGSEGV, SIG_DFL); #endif #ifdef SIGTERM signal(SIGTERM, SIG_DFL); #endif #ifdef SIGUSR1 signal(SIGUSR1, SIG_DFL); #endif #ifdef SIGUSR2 signal(SIGUSR2, SIG_DFL); #endif #ifdef SIGCHLD signal(SIGCHLD, SIG_DFL); #endif #ifdef SIGCONT signal(SIGCONT, SIG_DFL); #endif #ifdef SIGTSTP signal(SIGTSTP, SIG_DFL); #endif #ifdef SIGTTIN signal(SIGTTIN, SIG_DFL); #endif #ifdef SIGTTOU signal(SIGTTOU, SIG_DFL); #endif } /* *---------------------------------------------------------------------- * * SetupStdFile -- * * Set up stdio file handles for the child process, using the current * standard channels if no other files are specified. If no standard * channel is defined, or if no file is associated with the channel, then * the corresponding standard fd is closed. * * Results: * Returns 1 on success, or 0 on failure. * * Side effects: * Replaces stdio fds. * *---------------------------------------------------------------------- */ static int SetupStdFile( TclFile file, /* File to dup, or NULL. */ int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR */ { Tcl_Channel channel; int fd; int targetFd = 0; /* Initializations here needed only to */ int direction = 0; /* prevent warnings about using uninitialized * variables. */ switch (type) { case TCL_STDIN: targetFd = 0; direction = TCL_READABLE; break; case TCL_STDOUT: targetFd = 1; direction = TCL_WRITABLE; break; case TCL_STDERR: targetFd = 2; direction = TCL_WRITABLE; break; } if (!file) { channel = Tcl_GetStdChannel(type); if (channel) { file = TclpMakeFile(channel, direction); } } if (file) { fd = GetFd(file); if (fd != targetFd) { if (dup2(fd, targetFd) == -1) { return 0; } /* * Must clear the close-on-exec flag for the target FD, since some * systems (e.g. Ultrix) do not clear the CLOEXEC flag on the * target FD. */ fcntl(targetFd, F_SETFD, 0); } else { /* * Since we aren't dup'ing the file, we need to explicitly clear * the close-on-exec flag. */ fcntl(fd, F_SETFD, 0); } } else { close(targetFd); } return 1; } /* *---------------------------------------------------------------------- * * TclpCreateCommandChannel -- * * This function is called by the generic IO level to perform the * platform specific channel initialization for a command channel. * * Results: * Returns a new channel or NULL on failure. * * Side effects: * Allocates a new channel. * *---------------------------------------------------------------------- */ Tcl_Channel TclpCreateCommandChannel( TclFile readFile, /* If non-null, gives the file for reading. */ TclFile writeFile, /* If non-null, gives the file for writing. */ TclFile errorFile, /* If non-null, gives the file where errors * can be read. */ int numPids, /* The number of pids in the pid array. */ Tcl_Pid *pidPtr) /* An array of process identifiers. Allocated * by the caller, freed when the channel is * closed or the processes are detached (in a * background exec). */ { char channelName[16 + TCL_INTEGER_SPACE]; int channelId; PipeState *statePtr = (PipeState *)ckalloc(sizeof(PipeState)); int mode; statePtr->inFile = readFile; statePtr->outFile = writeFile; statePtr->errorFile = errorFile; statePtr->numPids = numPids; statePtr->pidPtr = pidPtr; statePtr->isNonBlocking = 0; mode = 0; if (readFile) { mode |= TCL_READABLE; } if (writeFile) { mode |= TCL_WRITABLE; } /* * Use one of the fds associated with the channel as the channel id. */ if (readFile) { channelId = GetFd(readFile); } else if (writeFile) { channelId = GetFd(writeFile); } else if (errorFile) { channelId = GetFd(errorFile); } else { channelId = 0; } /* * For backward compatibility with previous versions of Tcl, we use * "file%d" as the base name for pipes even though it would be more * natural to use "pipe%d". */ snprintf(channelName, sizeof(channelName), "file%d", channelId); statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, statePtr, mode); return statePtr->channel; } /* *---------------------------------------------------------------------- * * Tcl_CreatePipe -- * * System dependent interface to create a pipe for the [chan pipe] * command. Stolen from TclX. * * Results: * TCL_OK or TCL_ERROR. * * Side effects: * Registers two channels. * *---------------------------------------------------------------------- */ int Tcl_CreatePipe( Tcl_Interp *interp, /* Errors returned in result. */ Tcl_Channel *rchan, /* Returned read side. */ Tcl_Channel *wchan, /* Returned write side. */ int flags) /* Reserved for future use. */ { int fileNums[2]; if (pipe(fileNums) < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } fcntl(fileNums[0], F_SETFD, FD_CLOEXEC); fcntl(fileNums[1], F_SETFD, FD_CLOEXEC); *rchan = Tcl_MakeFileChannel(INT2PTR(fileNums[0]), TCL_READABLE); Tcl_RegisterChannel(interp, *rchan); *wchan = Tcl_MakeFileChannel(INT2PTR(fileNums[1]), TCL_WRITABLE); Tcl_RegisterChannel(interp, *wchan); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclGetAndDetachPids -- * * This function is invoked in the generic implementation of a * background "exec" (an exec when invoked with a terminating "&") to * store a list of the PIDs for processes in a command pipeline in the * interp's result and to detach the processes. * * Results: * None. * * Side effects: * Modifies the interp's result. Detaches processes. * *---------------------------------------------------------------------- */ void TclGetAndDetachPids( Tcl_Interp *interp, /* Interpreter to append the PIDs to. */ Tcl_Channel chan) /* Handle for the pipeline. */ { PipeState *pipePtr; const Tcl_ChannelType *chanTypePtr; Tcl_Obj *pidsObj; int i; /* * Punt if the channel is not a command channel. */ chanTypePtr = Tcl_GetChannelType(chan); if (chanTypePtr != &pipeChannelType) { return; } pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan); TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj( PTR2INT(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; } } /* *---------------------------------------------------------------------- * * PipeBlockModeProc -- * * Helper function to set blocking and nonblocking modes on a pipe based * channel. Invoked by generic IO level code. * * Results: * 0 if successful, errno when failed. * * Side effects: * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ static int PipeBlockModeProc( ClientData instanceData, /* Pipe state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { PipeState *psPtr = (PipeState *)instanceData; if (psPtr->inFile && TclUnixSetBlockingMode(GetFd(psPtr->inFile), mode) < 0) { return errno; } if (psPtr->outFile && TclUnixSetBlockingMode(GetFd(psPtr->outFile), mode) < 0) { return errno; } psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING); return 0; } /* *---------------------------------------------------------------------- * * PipeClose2Proc * * This function is invoked by the generic IO level to perform * pipeline-type-specific half or full-close. * * Results: * 0 on success, errno otherwise. * * Side effects: * Closes the command pipeline channel. * *---------------------------------------------------------------------- */ static int PipeClose2Proc( ClientData instanceData, /* The pipe to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { PipeState *pipePtr = (PipeState *)instanceData; Tcl_Channel errChan; int errorCode, result; errorCode = 0; result = 0; if (((!flags) || (flags & TCL_CLOSE_READ)) && (pipePtr->inFile != NULL)) { if (TclpCloseFile(pipePtr->inFile) < 0) { errorCode = errno; } else { pipePtr->inFile = NULL; } } if (((!flags) || (flags & TCL_CLOSE_WRITE)) && (pipePtr->outFile != NULL) && (errorCode == 0)) { if (TclpCloseFile(pipePtr->outFile) < 0) { errorCode = errno; } else { pipePtr->outFile = NULL; } } /* * If half-closing, stop here. */ if (flags) { return errorCode; } if (pipePtr->isNonBlocking || TclInExit()) { /* * If the channel is non-blocking or Tcl is being cleaned up, just * detach the children PIDs, reap them (important if we are in a * dynamic load module), and discard the errorFile. */ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr); Tcl_ReapDetachedProcs(); if (pipePtr->errorFile) { TclpCloseFile(pipePtr->errorFile); } } else { /* * Wrap the error file into a channel and give it to the cleanup * routine. */ if (pipePtr->errorFile) { errChan = Tcl_MakeFileChannel( INT2PTR(GetFd(pipePtr->errorFile)), TCL_READABLE); } else { errChan = NULL; } result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr, errChan); } if (pipePtr->numPids != 0) { ckfree(pipePtr->pidPtr); } ckfree(pipePtr); if (errorCode == 0) { return result; } return errorCode; } /* *---------------------------------------------------------------------- * * PipeInputProc -- * * This function is invoked from the generic IO level to read input from * a command pipeline based channel. * * Results: * The number of bytes read is returned or -1 on error. An output * argument contains a POSIX error code if an error occurs, or zero. * * Side effects: * Reads input from the input device of the channel. * *---------------------------------------------------------------------- */ static int PipeInputProc( ClientData instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { PipeState *psPtr = (PipeState *)instanceData; int bytesRead; /* How many bytes were actually read from the * input device? */ *errorCodePtr = 0; /* * Assume there is always enough input available. This will block * appropriately, and read will unblock as soon as a short read is * possible, if the channel is in blocking mode. If the channel is * nonblocking, the read will never block. Some OSes can throw an * interrupt error, for which we should immediately retry. [Bug #415131] */ do { bytesRead = read(GetFd(psPtr->inFile), buf, toRead); } while ((bytesRead < 0) && (errno == EINTR)); if (bytesRead < 0) { *errorCodePtr = errno; return -1; } return bytesRead; } /* *---------------------------------------------------------------------- * * PipeOutputProc-- * * This function is invoked from the generic IO level to write output to * a command pipeline based channel. * * Results: * The number of bytes written is returned or -1 on error. An output * argument contains a POSIX error code if an error occurred, or zero. * * Side effects: * Writes output on the output device of the channel. * *---------------------------------------------------------------------- */ static int PipeOutputProc( ClientData instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { PipeState *psPtr = (PipeState *)instanceData; int written; *errorCodePtr = 0; /* * Some OSes can throw an interrupt error, for which we should immediately * retry. [Bug #415131] */ do { written = write(GetFd(psPtr->outFile), buf, toWrite); } while ((written < 0) && (errno == EINTR)); if (written < 0) { *errorCodePtr = errno; return -1; } return written; } /* *---------------------------------------------------------------------- * * PipeWatchProc -- * * Initialize the notifier to watch the fds from this channel. * * Results: * None. * * Side effects: * Sets up the notifier so that a future event on the channel will be * seen by Tcl. * *---------------------------------------------------------------------- */ /* * Bug ad5a57f2f271: Tcl_NotifyChannel is not a Tcl_FileProc, * so do not pass it to directly to Tcl_CreateFileHandler. * Instead, pass a wrapper which is a Tcl_FileProc. */ static void PipeWatchNotifyChannelWrapper( ClientData clientData, int mask) { Tcl_Channel channel = clientData; Tcl_NotifyChannel(channel, mask); } static void PipeWatchProc( ClientData instanceData, /* The pipe state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { PipeState *psPtr = (PipeState *)instanceData; int newmask; if (psPtr->inFile) { newmask = mask & (TCL_READABLE | TCL_EXCEPTION); if (newmask) { Tcl_CreateFileHandler(GetFd(psPtr->inFile), newmask, PipeWatchNotifyChannelWrapper, psPtr->channel); } else { Tcl_DeleteFileHandler(GetFd(psPtr->inFile)); } } if (psPtr->outFile) { newmask = mask & (TCL_WRITABLE | TCL_EXCEPTION); if (newmask) { Tcl_CreateFileHandler(GetFd(psPtr->outFile), newmask, PipeWatchNotifyChannelWrapper, psPtr->channel); } else { Tcl_DeleteFileHandler(GetFd(psPtr->outFile)); } } } /* *---------------------------------------------------------------------- * * PipeGetHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a * command pipeline based channel. * * Results: * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no * handle for the specified direction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PipeGetHandleProc( ClientData instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { PipeState *psPtr = (PipeState *)instanceData; if (direction == TCL_READABLE && psPtr->inFile) { *handlePtr = INT2PTR(GetFd(psPtr->inFile)); return TCL_OK; } if (direction == TCL_WRITABLE && psPtr->outFile) { *handlePtr = INT2PTR(GetFd(psPtr->outFile)); return TCL_OK; } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_WaitPid -- * * Implements the waitpid system call on Unix systems. * * Results: * Result of calling waitpid. * * Side effects: * Waits for a process to terminate. * *---------------------------------------------------------------------- */ Tcl_Pid Tcl_WaitPid( Tcl_Pid pid, int *statPtr, int options) { int result; pid_t real_pid = (pid_t) PTR2INT(pid); while (1) { result = (int) waitpid(real_pid, statPtr, options); if ((result != -1) || (errno != EINTR)) { return (Tcl_Pid) INT2PTR(result); } } } /* *---------------------------------------------------------------------- * * Tcl_PidObjCmd -- * * This function is invoked to process the "pid" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_PidObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Channel chan; PipeState *pipePtr; int i; Tcl_Obj *resultPtr; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); return TCL_ERROR; } if (objc == 1) { Tcl_SetObjResult(interp, Tcl_NewLongObj((long) getpid())); } else { /* * Get the channel and make sure that it refers to a pipe. */ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == NULL) { return TCL_ERROR; } if (Tcl_GetChannelType(chan) != &pipeChannelType) { return TCL_OK; } /* * Extract the process IDs from the pipe structure. */ pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan); TclNewObj(resultPtr); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); } Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclpFinalizePipes -- * * Cleans up the pipe subsystem from Tcl_FinalizeThread * * Results: * None. * * Notes: * This function carries out no operation on Unix. * *---------------------------------------------------------------------- */ void TclpFinalizePipes(void) { } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixPort.h0000644000175000017500000005033614554262142015300 0ustar sergeisergei/* * tclUnixPort.h -- * * This header file handles porting issues that occur because of * differences between systems. It reads in UNIX-related header files and * sets up UNIX-related macros for Tcl's UNIX core. It should be the only * file that contains #ifdefs to handle different flavors of UNIX. This * file sets up the union of all UNIX-related things needed by any of the * Tcl core files. This file depends on configuration #defines such as * NO_DIRENT_H that are set up by the "configure" script. * * Much of the material in this file was originally contributed by Karl * Lehenbauer, Mark Diekhans and Peter da Silva. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLUNIXPORT #define _TCLUNIXPORT /* *--------------------------------------------------------------------------- * The following sets of #includes and #ifdefs are required to get Tcl to * compile under the various flavors of unix. *--------------------------------------------------------------------------- */ #include #include #ifdef HAVE_NET_ERRNO_H # include #endif #include #include #ifdef HAVE_SYS_PARAM_H # include #endif #include #ifdef USE_DIRENT2_H # include "../compat/dirent2.h" #else #ifdef NO_DIRENT_H # include "../compat/dirent.h" #else # include #endif #endif /* *--------------------------------------------------------------------------- * Parameterize for 64-bit filesystem support. *--------------------------------------------------------------------------- */ #ifdef HAVE_STRUCT_DIRENT64 typedef struct dirent64 Tcl_DirEntry; # define TclOSreaddir readdir64 #else typedef struct dirent Tcl_DirEntry; # define TclOSreaddir readdir #endif #ifdef HAVE_DIR64 typedef DIR64 TclDIR; # define TclOSopendir opendir64 # define TclOSrewinddir rewinddir64 # define TclOSclosedir closedir64 #else typedef DIR TclDIR; # define TclOSopendir opendir # define TclOSrewinddir rewinddir # define TclOSclosedir closedir #endif #ifdef HAVE_TYPE_OFF64_T typedef off64_t Tcl_SeekOffset; # define TclOSseek lseek64 # define TclOSopen open64 #else typedef off_t Tcl_SeekOffset; # define TclOSseek lseek # define TclOSopen open #endif #ifdef __CYGWIN__ #ifdef __cplusplus extern "C" { #endif /* Make some symbols available without including */ # define DWORD unsigned int # define CP_UTF8 65001 # define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 # define HANDLE void * # define HINSTANCE void * # define SOCKET unsigned int # define WSAEWOULDBLOCK 10035 typedef unsigned short WCHAR; #ifdef __clang__ #pragma clang diagnostic push #pragma clang diagnostic ignored "-Wignored-attributes" #endif __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const void *, void *); __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const void *, int); __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const void *, int, char *, int, const char *, void *); __declspec(dllimport) extern __stdcall int MultiByteToWideChar(int, int, const char *, int, WCHAR *, int); __declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *); __declspec(dllimport) extern __stdcall int IsDebuggerPresent(void); __declspec(dllimport) extern __stdcall int GetLastError(void); __declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *); __declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int); __declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int); #ifdef __clang__ #pragma clang diagnostic pop #endif # define timezone _timezone extern int TclOSstat(const char *name, void *statBuf); extern int TclOSlstat(const char *name, void *statBuf); #ifdef __cplusplus } #endif #elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) # define TclOSstat(name, buf) stat64(name, (struct stat64 *)buf) # define TclOSlstat(name,buf) lstat64(name, (struct stat64 *)buf) #else # define TclOSstat(name, buf) stat(name, (struct stat *)buf) # define TclOSlstat(name, buf) lstat(name, (struct stat *)buf) #endif /* *--------------------------------------------------------------------------- * Miscellaneous includes that might be missing. *--------------------------------------------------------------------------- */ #include #ifdef HAVE_SYS_SELECT_H # include #endif #include #ifdef TIME_WITH_SYS_TIME # include # include #else #ifdef HAVE_SYS_TIME_H # include #else # include #endif #endif #ifndef NO_SYS_WAIT_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #include #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_UNISTD_H # include #else # include "../compat/unistd.h" #endif extern int TclUnixSetBlockingMode(int fd, int mode); #include /* *--------------------------------------------------------------------------- * Socket support stuff: This likely needs more work to parameterize for each * system. *--------------------------------------------------------------------------- */ #include /* struct sockaddr, SOCK_STREAM, ... */ #ifndef NO_UNAME # include /* uname system call. */ #endif #include /* struct in_addr, struct sockaddr_in */ #include /* inet_ntoa() */ #include /* getaddrinfo() */ #ifdef NEED_FAKE_RFC2553 # include "../compat/fake-rfc2553.h" #endif /* *--------------------------------------------------------------------------- * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we look * for an alternative definition. If no other alternative is available we use * a reasonable guess. *--------------------------------------------------------------------------- */ #ifndef NO_FLOAT_H # include #else #ifndef NO_VALUES_H # include #endif #endif #ifndef FLT_MAX # ifdef MAXFLOAT # define FLT_MAX MAXFLOAT # else # define FLT_MAX 3.402823466E+38F # endif #endif #ifndef FLT_MIN # ifdef MINFLOAT # define FLT_MIN MINFLOAT # else # define FLT_MIN 1.175494351E-38F # endif #endif /* *--------------------------------------------------------------------------- * NeXT doesn't define O_NONBLOCK, so #define it here if necessary. *--------------------------------------------------------------------------- */ #ifndef O_NONBLOCK # define O_NONBLOCK 0x80 #endif /* *--------------------------------------------------------------------------- * The type of the status returned by wait varies from UNIX system to UNIX * system. The macro below defines it: *--------------------------------------------------------------------------- */ #ifdef _AIX # define WAIT_STATUS_TYPE pid_t #else #ifndef NO_UNION_WAIT # define WAIT_STATUS_TYPE union wait #else # define WAIT_STATUS_TYPE int #endif #endif /* *--------------------------------------------------------------------------- * Supply definitions for macros to query wait status, if not already defined * in header files above. *--------------------------------------------------------------------------- */ #ifndef WIFEXITED # define WIFEXITED(stat) (((*((int *) &(stat))) & 0xFF) == 0) #endif #ifndef WEXITSTATUS # define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xFF) #endif #ifndef WIFSIGNALED # define WIFSIGNALED(stat) \ (((*((int *) &(stat)))) && ((*((int *) &(stat))) \ == ((*((int *) &(stat))) & 0x00FF))) #endif #ifndef WTERMSIG # define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7F) #endif #ifndef WIFSTOPPED # define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xFF) == 0177) #endif #ifndef WSTOPSIG # define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xFF) #endif /* *--------------------------------------------------------------------------- * Define constants for waitpid() system call if they aren't defined by a * system header file. *--------------------------------------------------------------------------- */ #ifndef WNOHANG # define WNOHANG 1 #endif #ifndef WUNTRACED # define WUNTRACED 2 #endif /* *--------------------------------------------------------------------------- * Supply macros for seek offsets, if they're not already provided by an * include file. *--------------------------------------------------------------------------- */ #ifndef SEEK_SET # define SEEK_SET 0 #endif #ifndef SEEK_CUR # define SEEK_CUR 1 #endif #ifndef SEEK_END # define SEEK_END 2 #endif /* *--------------------------------------------------------------------------- * The stuff below is needed by the "time" command. If this system has no * gettimeofday call, then must use times() instead. *--------------------------------------------------------------------------- */ #ifdef NO_GETTOD # include #else # ifdef HAVE_BSDGETTIMEOFDAY # define gettimeofday BSDgettimeofday # endif #endif #ifdef GETTOD_NOT_DECLARED extern int gettimeofday(struct timeval *tp, struct timezone *tzp); #endif /* *--------------------------------------------------------------------------- * Define access mode constants if they aren't already defined. *--------------------------------------------------------------------------- */ #ifndef F_OK # define F_OK 00 #endif #ifndef X_OK # define X_OK 01 #endif #ifndef W_OK # define W_OK 02 #endif #ifndef R_OK # define R_OK 04 #endif /* *--------------------------------------------------------------------------- * Define FD_CLOEEXEC (the close-on-exec flag bit) if it isn't already * defined. *--------------------------------------------------------------------------- */ #ifndef FD_CLOEXEC # define FD_CLOEXEC 1 #endif /* *--------------------------------------------------------------------------- * On systems without symbolic links (i.e. S_IFLNK isn't defined) define * "lstat" to use "stat" instead. *--------------------------------------------------------------------------- */ #ifndef S_IFLNK # undef TclOSlstat # define lstat stat # define lstat64 stat64 # define TclOSlstat TclOSstat #endif /* *--------------------------------------------------------------------------- * Define macros to query file type bits, if they're not already defined. *--------------------------------------------------------------------------- */ #ifndef S_ISREG # ifdef S_IFREG # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) # else # define S_ISREG(m) 0 # endif #endif /* !S_ISREG */ #ifndef S_ISDIR # ifdef S_IFDIR # define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) # else # define S_ISDIR(m) 0 # endif #endif /* !S_ISDIR */ #ifndef S_ISCHR # ifdef S_IFCHR # define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR) # else # define S_ISCHR(m) 0 # endif #endif /* !S_ISCHR */ #ifndef S_ISBLK # ifdef S_IFBLK # define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK) # else # define S_ISBLK(m) 0 # endif #endif /* !S_ISBLK */ #ifndef S_ISFIFO # ifdef S_IFIFO # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) # else # define S_ISFIFO(m) 0 # endif #endif /* !S_ISFIFO */ #ifndef S_ISLNK # ifdef S_IFLNK # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) # else # define S_ISLNK(m) 0 # endif #endif /* !S_ISLNK */ #ifndef S_ISSOCK # ifdef S_IFSOCK # define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK) # else # define S_ISSOCK(m) 0 # endif #endif /* !S_ISSOCK */ /* *--------------------------------------------------------------------------- * Make sure that MAXPATHLEN and MAXNAMLEN are defined. *--------------------------------------------------------------------------- */ #ifndef MAXPATHLEN # ifdef PATH_MAX # define MAXPATHLEN PATH_MAX # else # define MAXPATHLEN 2048 # endif #endif #ifndef MAXNAMLEN # ifdef NAME_MAX # define MAXNAMLEN NAME_MAX # else # define MAXNAMLEN 255 # endif #endif /* *--------------------------------------------------------------------------- * The following macro defines the type of the mask arguments to select: *--------------------------------------------------------------------------- */ #ifndef NO_FD_SET # define SELECT_MASK fd_set #else /* NO_FD_SET */ # ifndef _AIX typedef long fd_mask; # endif /* !AIX */ # if defined(_IBMR2) # define SELECT_MASK void # else /* !defined(_IBMR2) */ # define SELECT_MASK int # endif /* defined(_IBMR2) */ #endif /* !NO_FD_SET */ /* *--------------------------------------------------------------------------- * Define "NBBY" (number of bits per byte) if it's not already defined. *--------------------------------------------------------------------------- */ #ifndef NBBY # define NBBY 8 #endif /* *--------------------------------------------------------------------------- * The following macro defines the number of fd_masks in an fd_set: *--------------------------------------------------------------------------- */ #ifndef FD_SETSIZE # ifdef OPEN_MAX # define FD_SETSIZE OPEN_MAX # else # define FD_SETSIZE 256 # endif #endif /* FD_SETSIZE */ #ifndef howmany # define howmany(x, y) (((x)+((y)-1))/(y)) #endif /* !defined(howmany) */ #ifndef NFDBITS # define NFDBITS NBBY*sizeof(fd_mask) #endif /* NFDBITS */ #define MASK_SIZE howmany(FD_SETSIZE, NFDBITS) /* *--------------------------------------------------------------------------- * Not all systems declare the errno variable in errno.h, so this file does it * explicitly. The list of system error messages also isn't generally declared * in a header file anywhere. *--------------------------------------------------------------------------- */ #ifdef NO_ERRNO extern int errno; #endif /* NO_ERRNO */ /* *--------------------------------------------------------------------------- * Not all systems declare all the errors that Tcl uses! Provide some * work-arounds... *--------------------------------------------------------------------------- */ #ifndef EOVERFLOW # ifdef EFBIG # define EOVERFLOW EFBIG # else /* !EFBIG */ # define EOVERFLOW EINVAL # endif /* EFBIG */ #endif /* EOVERFLOW */ /* *--------------------------------------------------------------------------- * Variables provided by the C library: *--------------------------------------------------------------------------- */ #if defined(__APPLE__) && defined(__DYNAMIC__) # include # define environ (*_NSGetEnviron()) # define USE_PUTENV 1 #else # if defined(_sgi) || defined(__sgi) # define environ _environ # endif extern char ** environ; #endif /* *--------------------------------------------------------------------------- * Darwin specifc configure overrides. *--------------------------------------------------------------------------- */ #ifdef __APPLE__ /* *--------------------------------------------------------------------------- * Support for fat compiles: configure runs only once for multiple architectures *--------------------------------------------------------------------------- */ # if defined(__LP64__) && defined (NO_COREFOUNDATION_64) # undef HAVE_COREFOUNDATION # endif /* __LP64__ && NO_COREFOUNDATION_64 */ # include # ifdef __DARWIN_UNIX03 # if __DARWIN_UNIX03 # undef HAVE_PUTENV_THAT_COPIES # else # define HAVE_PUTENV_THAT_COPIES 1 # endif # endif /* __DARWIN_UNIX03 */ /* *--------------------------------------------------------------------------- * Include AvailabilityMacros.h here (when available) to ensure any symbolic * MAC_OS_X_VERSION_* constants passed on the command line are translated. *--------------------------------------------------------------------------- */ # ifdef HAVE_AVAILABILITYMACROS_H # include # endif /* *--------------------------------------------------------------------------- * Support for weak import. *--------------------------------------------------------------------------- */ # ifdef HAVE_WEAK_IMPORT # if !defined(HAVE_AVAILABILITYMACROS_H) || !defined(MAC_OS_X_VERSION_MIN_REQUIRED) # undef HAVE_WEAK_IMPORT # else # ifndef WEAK_IMPORT_ATTRIBUTE # define WEAK_IMPORT_ATTRIBUTE __attribute__((weak_import)) # endif # endif # endif /* HAVE_WEAK_IMPORT */ /* *--------------------------------------------------------------------------- * Support for MAC_OS_X_VERSION_MAX_ALLOWED define from AvailabilityMacros.h: * only use API available in the indicated OS version or earlier. *--------------------------------------------------------------------------- */ # ifdef MAC_OS_X_VERSION_MAX_ALLOWED # if MAC_OS_X_VERSION_MAX_ALLOWED < 1050 && defined(__LP64__) # undef HAVE_COREFOUNDATION # endif # if MAC_OS_X_VERSION_MAX_ALLOWED < 1040 # undef HAVE_OSSPINLOCKLOCK # undef HAVE_PTHREAD_ATFORK # undef HAVE_COPYFILE # endif # if MAC_OS_X_VERSION_MAX_ALLOWED < 1030 # ifdef TCL_THREADS /* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */ # define NO_REALPATH 1 # endif # undef HAVE_LANGINFO # endif # endif /* MAC_OS_X_VERSION_MAX_ALLOWED */ # if defined(HAVE_COREFOUNDATION) && defined(__LP64__) && \ defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050 # warning "Weak import of 64-bit CoreFoundation is not supported, will not run on Mac OS X < 10.5." # endif /* * For now, test exec-17.1 fails (I/O setup after closing stdout) with * posix_spawnp(), but the classic implementation (based on fork()+execvp()) * works well under macOS. */ # undef HAVE_POSIX_SPAWNP # undef HAVE_VFORK #endif /* __APPLE__ */ /* *--------------------------------------------------------------------------- * The following macros and declarations represent the interface between * generic and unix-specific parts of Tcl. Some of the macros may override * functions declared in tclInt.h. *--------------------------------------------------------------------------- */ /* * The default platform eol translation on Unix is TCL_TRANSLATE_LF. */ #ifdef DJGPP #define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CRLF typedef int socklen_t; #else #define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_LF #endif /* *--------------------------------------------------------------------------- * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. *--------------------------------------------------------------------------- */ #define TclpReleaseFile(file) /* Nothing. */ /* *--------------------------------------------------------------------------- * The following defines wrap the system memory allocation routines. *--------------------------------------------------------------------------- */ #define TclpSysAlloc(size, isBin) malloc((size_t)(size)) #define TclpSysFree(ptr) free((char *)(ptr)) #define TclpSysRealloc(ptr, size) realloc((char *)(ptr), (size_t)(size)) /* *--------------------------------------------------------------------------- * The following macros and declaration wrap the C runtime library functions. *--------------------------------------------------------------------------- */ #define TclpExit exit #ifdef TCL_THREADS # include #endif /* TCL_THREADS */ /* FIXME - Hyper-enormous platform assumption! */ #ifndef AF_INET6 # define AF_INET6 10 #endif /* *--------------------------------------------------------------------------- * Set of MT-safe implementations of some known-to-be-MT-unsafe library calls. * Instead of returning pointers to the static storage, those return pointers * to the TSD data. *--------------------------------------------------------------------------- */ #include #include extern struct passwd * TclpGetPwNam(const char *name); extern struct group * TclpGetGrNam(const char *name); extern struct passwd * TclpGetPwUid(uid_t uid); extern struct group * TclpGetGrGid(gid_t gid); extern struct hostent * TclpGetHostByName(const char *name); extern struct hostent * TclpGetHostByAddr(const char *addr, int length, int type); extern void *TclpMakeTcpClientChannelMode( void *tcpSocket, int mode); #endif /* _TCLUNIXPORT */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixSock.c0000644000175000017500000014216614554262142015251 0ustar sergeisergei/* * tclUnixSock.c -- * * This file contains Unix-specific socket related code. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Helper macros to make parts of this file clearer. The macros do exactly * what they say on the tin. :-) They also only ever refer to their arguments * once, and so can be used without regard to side effects. */ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) #define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ #define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) #define SOCK_TEMPLATE "sock%lx" #undef SOCKET /* Possible conflict with win32 SOCKET */ /* * This is needed to comply with the strict aliasing rules of GCC, but it also * simplifies casting between the different sockaddr types. */ typedef union { struct sockaddr sa; struct sockaddr_in sa4; struct sockaddr_in6 sa6; struct sockaddr_storage sas; } address; /* * This structure describes per-instance state of a tcp-based channel. */ typedef struct TcpState TcpState; typedef struct TcpFdList { TcpState *statePtr; int fd; struct TcpFdList *next; } TcpFdList; struct TcpState { Tcl_Channel channel; /* Channel associated with this file. */ TcpFdList fds; /* The file descriptors of the sockets. */ int flags; /* OR'ed combination of the bitfields defined * below. */ int interest; /* Event types of interest */ /* * Only needed for server sockets */ Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */ void *acceptProcData; /* The data for the accept proc. */ /* * Only needed for client sockets */ struct addrinfo *addrlist; /* Addresses to connect to. */ struct addrinfo *addr; /* Iterator over addrlist. */ struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ int filehandlers; /* Caches FileHandlers that get set up while * an async socket is not yet connected. */ int connectError; /* Cache SO_ERROR of async socket. */ int cachedBlocking; /* Cache blocking mode of async socket. */ }; /* * These bits may be OR'ed together into the "flags" field of a TcpState * structure. */ #define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */ #define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ #define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to * process an async connect. This * flag indicates that reentry is * still pending */ #define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ /* * The following defines the maximum length of the listen queue. This is the * number of outstanding yet-to-be-serviced requests for a connection on a * server socket, more than this number of outstanding requests and the * connection request will fail. */ #ifndef SOMAXCONN # define SOMAXCONN 100 #elif (SOMAXCONN < 100) # undef SOMAXCONN # define SOMAXCONN 100 #endif /* SOMAXCONN < 100 */ /* * The following defines how much buffer space the kernel should maintain for * a socket. */ #define SOCKET_BUFSIZE 4096 /* * Static routines for this file: */ static void TcpAsyncCallback(void *clientData, int mask); static int TcpConnect(Tcl_Interp *interp, TcpState *state); static void TcpAccept(void *data, int mask); static int TcpBlockModeProc(void *data, int mode); static int TcpCloseProc(void *instanceData, Tcl_Interp *interp); static int TcpClose2Proc(void *instanceData, Tcl_Interp *interp, int flags); static int TcpGetHandleProc(void *instanceData, int direction, void **handlePtr); static int TcpGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int TcpInputProc(void *instanceData, char *buf, int toRead, int *errorCode); static int TcpOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); static void TcpThreadActionProc(void *instanceData, int action); static void TcpWatchProc(void *instanceData, int mask); static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); static Tcl_FileProc WrapNotify; /* * This structure describes the channel type structure for TCP socket * based IO: */ static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TcpCloseProc, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Initialize notifier. */ TcpGetHandleProc, /* Get OS handles out of channel. */ TcpClose2Proc, /* Close2 proc. */ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ TcpThreadActionProc, /* thread action proc. */ NULL /* truncate proc. */ }; /* * The following variable holds the network name of this host. */ static TclInitProcessGlobalValueProc InitializeHostName; static ProcessGlobalValue hostName = {0, 0, NULL, NULL, InitializeHostName, NULL, NULL}; #if 0 /* printf debugging */ void printaddrinfo( struct addrinfo *addrlist, char *prefix) { char host[NI_MAXHOST], port[NI_MAXSERV]; struct addrinfo *ai; for (ai = addrlist; ai != NULL; ai = ai->ai_next) { getnameinfo(ai->ai_addr, ai->ai_addrlen, host, sizeof(host), port, sizeof(port), NI_NUMERICHOST|NI_NUMERICSERV); fprintf(stderr,"%s: %s:%s\n", prefix, host, port); } } #endif /* * ---------------------------------------------------------------------- * * InitializeHostName -- * * This routine sets the process global value of the name of the local * host on which the process is running. * * Results: * None. * * ---------------------------------------------------------------------- */ static void InitializeHostName( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; #ifndef NO_UNAME struct utsname u; struct hostent *hp; memset(&u, (int) 0, sizeof(struct utsname)); if (uname(&u) >= 0) { /* INTL: Native. */ hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ if (hp == NULL) { /* * Sometimes the nodename is fully qualified, but gets truncated * as it exceeds SYS_NMLN. See if we can just get the immediate * nodename and get a proper answer that way. */ char *dot = strchr(u.nodename, '.'); if (dot != NULL) { char *node = (char *)ckalloc(dot - u.nodename + 1); memcpy(node, u.nodename, dot - u.nodename); node[dot - u.nodename] = '\0'; hp = TclpGetHostByName(node); ckfree(node); } } if (hp != NULL) { native = hp->h_name; } else { native = u.nodename; } } if (native == NULL) { native = tclEmptyStringRep; } #else /* !NO_UNAME */ /* * Uname doesn't exist; try gethostname instead. * * There is no portable macro for the maximum length of host names * returned by gethostbyname(). We should only trust SYS_NMLN if it is at * least 255 + 1 bytes to comply with DNS host name limits. * * Note: SYS_NMLN is a restriction on "uname" not on gethostbyname! * * For example HP-UX 10.20 has SYS_NMLN == 9, while gethostbyname() can * return a fully qualified name from DNS of up to 255 bytes. * * Fix suggested by Viktor Dukhovni (viktor@esm.com) */ # if defined(SYS_NMLN) && (SYS_NMLEN >= 256) char buffer[SYS_NMLEN]; # else char buffer[256]; # endif if (gethostname(buffer, sizeof(buffer)) >= 0) { /* INTL: Native. */ native = buffer; } #endif /* NO_UNAME */ *encodingPtr = Tcl_GetEncoding(NULL, NULL); *lengthPtr = strlen(native); *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, native, *lengthPtr + 1); } /* * ---------------------------------------------------------------------- * * Tcl_GetHostName -- * * Returns the name of the local host. * * Results: * A string containing the network name for this machine, or an empty * string if we can't figure out the name. The caller must not modify or * free this string. * * Side effects: * Caches the name to return for future calls. * * ---------------------------------------------------------------------- */ const char * Tcl_GetHostName(void) { return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); } /* * ---------------------------------------------------------------------- * * TclpHasSockets -- * * Detect if sockets are available on this platform. * * Results: * Returns TCL_OK. * * Side effects: * None. * * ---------------------------------------------------------------------- */ int TclpHasSockets( Tcl_Interp *dummy) /* Not used. */ { (void)dummy; return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclpFinalizeSockets -- * * Performs per-thread socket subsystem finalization. * * Results: * None. * * Side effects: * None. * * ---------------------------------------------------------------------- */ void TclpFinalizeSockets(void) { return; } /* * ---------------------------------------------------------------------- * * TcpBlockModeProc -- * * This function is invoked by the generic IO level to set blocking and * nonblocking mode on a TCP socket based channel. * * Results: * 0 if successful, errno when failed. * * Side effects: * Sets the device into blocking or nonblocking mode. * * ---------------------------------------------------------------------- */ static int TcpBlockModeProc( void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { TcpState *statePtr = (TcpState *)instanceData; if (mode == TCL_MODE_BLOCKING) { CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); } else { SET_BITS(statePtr->flags, TCP_NONBLOCKING); } if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { statePtr->cachedBlocking = mode; return 0; } if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) { return errno; } return 0; } /* * ---------------------------------------------------------------------- * * WaitForConnect -- * * Check the state of an async connect process. If a connection attempt * terminated, process it, which may finalize it or may start the next * attempt. If a connect error occurs, it is saved in * statePtr->connectError to be reported by 'fconfigure -error'. * * There are two modes of operation, defined by errorCodePtr: * * non-NULL: Called by explicit read/write command. Blocks if the * socket is blocking. * May return two error codes: * * EWOULDBLOCK: if connect is still in progress * * ENOTCONN: if connect failed. This would be the error message * of a recv or sendto syscall so this is emulated here. * * NULL: Called by a background operation. Do not block and do not * return any error code. * * Results: * 0 if the connection has completed, -1 if still in progress or there is * an error. * * Side effects: * Processes socket events off the system queue. May process * asynchronous connects. * *---------------------------------------------------------------------- */ static int WaitForConnect( TcpState *statePtr, /* State of the socket. */ int *errorCodePtr) { int timeout; /* * Check if an async connect failed already and error reporting is * demanded, return the error ENOTCONN */ if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { *errorCodePtr = ENOTCONN; return -1; } /* * Check if an async connect is running. If not return ok. */ if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { return 0; } if (errorCodePtr == NULL || GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { timeout = 0; } else { timeout = -1; } do { if (TclUnixWaitForFile(statePtr->fds.fd, TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) { TcpConnect(NULL, statePtr); } /* * Do this only once in the nonblocking case and repeat it until the * socket is final when blocking. */ } while (timeout == -1 && GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)); if (errorCodePtr != NULL) { if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { *errorCodePtr = EAGAIN; return -1; } else if (statePtr->connectError != 0) { *errorCodePtr = ENOTCONN; return -1; } } return 0; } /* *---------------------------------------------------------------------- * * TcpInputProc -- * * This function is invoked by the generic IO level to read input from a * TCP socket based channel. * * NOTE: We cannot share code with FilePipeInputProc because here we must * use recv to obtain the input from the channel, not read. * * Results: * The number of bytes read is returned or -1 on error. An output * argument contains the POSIX error code on error, or zero if no error * occurred. * * Side effects: * Reads input from the input device of the channel. * *---------------------------------------------------------------------- */ static int TcpInputProc( void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { TcpState *statePtr = (TcpState *)instanceData; int bytesRead; *errorCodePtr = 0; if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } bytesRead = recv(statePtr->fds.fd, buf, bufSize, 0); if (bytesRead >= 0) { return bytesRead; } if (errno == ECONNRESET) { /* * Turn ECONNRESET into a soft EOF condition. */ return 0; } *errorCodePtr = errno; return -1; } /* *---------------------------------------------------------------------- * * TcpOutputProc -- * * This function is invoked by the generic IO level to write output to a * TCP socket based channel. * * NOTE: We cannot share code with FilePipeOutputProc because here we * must use send, not write, to get reliable error reporting. * * Results: * The number of bytes written is returned. An output argument is set to * a POSIX error code if an error occurred, or zero. * * Side effects: * Writes output on the output device of the channel. * *---------------------------------------------------------------------- */ static int TcpOutputProc( void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { TcpState *statePtr = (TcpState *)instanceData; int written; *errorCodePtr = 0; if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } written = send(statePtr->fds.fd, buf, toWrite, 0); if (written >= 0) { return written; } *errorCodePtr = errno; return -1; } /* *---------------------------------------------------------------------- * * TcpCloseProc -- * * This function is invoked by the generic IO level to perform * channel-type-specific cleanup when a TCP socket based channel is * closed. * * Results: * 0 if successful, the value of errno if failed. * * Side effects: * Closes the socket of the channel. * *---------------------------------------------------------------------- */ static int TcpCloseProc( void *instanceData, /* The socket to close. */ Tcl_Interp *dummy) /* For error reporting - unused. */ { TcpState *statePtr = (TcpState *)instanceData; int errorCode = 0; TcpFdList *fds; (void)dummy; /* * Delete a file handler that may be active for this socket if this is a * server socket - the file handler was created automatically by Tcl as * part of the mechanism to accept new client connections. Channel * handlers are already deleted in the generic IO channel closing code * that called this function, so we do not have to delete them here. */ for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { if (fds->fd < 0) { continue; } Tcl_DeleteFileHandler(fds->fd); if (close(fds->fd) < 0) { errorCode = errno; } } fds = statePtr->fds.next; while (fds != NULL) { TcpFdList *next = fds->next; ckfree(fds); fds = next; } if (statePtr->addrlist != NULL) { freeaddrinfo(statePtr->addrlist); } if (statePtr->myaddrlist != NULL) { freeaddrinfo(statePtr->myaddrlist); } ckfree(statePtr); return errorCode; } /* *---------------------------------------------------------------------- * * TcpClose2Proc -- * * This function is called by the generic IO level to perform the channel * type specific part of a half-close: namely, a shutdown() on a socket. * * Results: * 0 if successful, the value of errno if failed. * * Side effects: * Shuts down one side of the socket. * *---------------------------------------------------------------------- */ static int TcpClose2Proc( void *instanceData, /* The socket to close. */ Tcl_Interp *dummy, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = (TcpState *)instanceData; int readError = 0; int writeError = 0; (void)dummy; /* * Shutdown the OS socket handle. */ if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { return TcpCloseProc(instanceData, NULL); } if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->fds.fd, SHUT_RD) < 0)) { readError = errno; } if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->fds.fd, SHUT_WR) < 0)) { writeError = errno; } return (readError != 0) ? readError : writeError; } /* *---------------------------------------------------------------------- * * TcpHostPortList -- * * This function is called by the -gethostname and -getpeername switches * of TcpGetOptionProc() to add three list elements with the textual * representation of the given address to the given DString. * * Results: * None. * * Side effects: * Adds three elements do dsPtr * *---------------------------------------------------------------------- */ #ifndef NEED_FAKE_RFC2553 #if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wstrict-aliasing" #endif static inline int IPv6AddressNeedsNumericRendering( struct in6_addr addr) { if (IN6_ARE_ADDR_EQUAL(&addr, &in6addr_any)) { return 1; } /* * The IN6_IS_ADDR_V4MAPPED macro has a problem with aliasing warnings on * at least some versions of OSX. */ if (!IN6_IS_ADDR_V4MAPPED(&addr)) { return 0; } return (addr.s6_addr[12] == 0 && addr.s6_addr[13] == 0 && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0); } #if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) #pragma GCC diagnostic pop #endif #endif /* NEED_FAKE_RFC2553 */ static void TcpHostPortList( Tcl_Interp *interp, Tcl_DString *dsPtr, address addr, socklen_t salen) { #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV]; int flags = 0; getnameinfo(&addr.sa, salen, nhost, sizeof(nhost), nport, sizeof(nport), NI_NUMERICHOST | NI_NUMERICSERV); Tcl_DStringAppendElement(dsPtr, nhost); /* * We don't want to resolve INADDR_ANY and sin6addr_any; they can * sometimes cause problems (and never have a name). */ if (addr.sa.sa_family == AF_INET) { if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { flags |= NI_NUMERICHOST; } #ifndef NEED_FAKE_RFC2553 } else if (addr.sa.sa_family == AF_INET6) { if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) { flags |= NI_NUMERICHOST; } #endif /* NEED_FAKE_RFC2553 */ } /* * Check if reverse DNS has been switched off globally. */ if (interp != NULL && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { flags |= NI_NUMERICHOST; } if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, flags) == 0) { /* * Reverse mapping worked. */ Tcl_DStringAppendElement(dsPtr, host); } else { /* * Reverse mapping failed - use the numeric rep once more. */ Tcl_DStringAppendElement(dsPtr, nhost); } Tcl_DStringAppendElement(dsPtr, nport); } /* *---------------------------------------------------------------------- * * TcpGetOptionProc -- * * Computes an option value for a TCP socket based channel, or a list of * all options and their values. * * Note: This code is based on code contributed by John Haxby. * * Results: * A standard Tcl result. The value of the specified option or a list of * all options and their values is returned in the supplied DString. Sets * Error message if needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TcpGetOptionProc( void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to retrieve the value * for, or NULL to get all options and their * values. */ Tcl_DString *dsPtr) /* Where to store the computed value; * initialized by caller. */ { TcpState *statePtr = (TcpState *)instanceData; size_t len = 0; WaitForConnect(statePtr, NULL); if (optionName != NULL) { len = strlen(optionName); } if ((len > 1) && (optionName[1] == 'e') && (strncmp(optionName, "-error", len) == 0)) { socklen_t optlen = sizeof(int); if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { /* * Suppress errors as long as we are not done. */ errno = 0; } else if (statePtr->connectError != 0) { errno = statePtr->connectError; statePtr->connectError = 0; } else { int err; getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err, &optlen); errno = err; } if (errno != 0) { Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), -1); } return TCL_OK; } if ((len > 1) && (optionName[1] == 'c') && (strncmp(optionName, "-connecting", len) == 0)) { Tcl_DStringAppend(dsPtr, GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", -1); return TCL_OK; } if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && (strncmp(optionName, "-peername", len) == 0))) { address peername; socklen_t size = sizeof(peername); if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { /* * In async connect output an empty string */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringAppendElement(dsPtr, ""); } else { return TCL_OK; } } else if (getpeername(statePtr->fds.fd, &peername.sa, &size) >= 0) { /* * Peername fetch succeeded - output list */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } TcpHostPortList(interp, dsPtr, peername, size); if (len) { return TCL_OK; } Tcl_DStringEndSublist(dsPtr); } else { /* * getpeername failed - but if we were asked for all the options * (len==0), don't flag an error at that point because it could be * an fconfigure request on a server socket (which have no peer). * Same must be done on win&mac. */ if (len) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get peername: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } } } if ((len == 0) || ((len > 1) && (optionName[1] == 's') && (strncmp(optionName, "-sockname", len) == 0))) { TcpFdList *fds; address sockname; socklen_t size; int found = 0; if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-sockname"); Tcl_DStringStartSublist(dsPtr); } if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { /* * In async connect output an empty string */ found = 1; } else { for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { size = sizeof(sockname); if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) { found = 1; TcpHostPortList(interp, dsPtr, sockname, size); } } } if (found) { if (len) { return TCL_OK; } Tcl_DStringEndSublist(dsPtr); } else { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get sockname: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } } if (len > 0) { return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname"); } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TcpThreadActionProc -- * * Handles detach/attach for asynchronously connecting socket. * * Reassigning the file handler associated with thread-related channel * notification, responsible for callbacks (signaling that asynchronous * connection attempt has succeeded or failed). * * Results: * None. * * ---------------------------------------------------------------------- */ static void TcpThreadActionProc( void *instanceData, int action) { TcpState *statePtr = (TcpState *)instanceData; if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { /* * Async-connecting socket must get reassigned handler if it have been * transferred to another thread. Remove the handler if the socket is * not managed by this thread anymore and create new handler (TSD related) * so the callback will run in the correct thread, bug [f583715154]. */ switch (action) { case TCL_CHANNEL_THREAD_REMOVE: CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); Tcl_DeleteFileHandler(statePtr->fds.fd); break; case TCL_CHANNEL_THREAD_INSERT: Tcl_CreateFileHandler(statePtr->fds.fd, TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, statePtr); SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); break; } } } /* * ---------------------------------------------------------------------- * * TcpWatchProc -- * * Initialize the notifier to watch the fd from this channel. * * Results: * None. * * Side effects: * Sets up the notifier so that a future event on the channel will be * seen by Tcl. * * ---------------------------------------------------------------------- */ static void WrapNotify( void *clientData, int mask) { TcpState *statePtr = (TcpState *) clientData; int newmask = mask & statePtr->interest; if (newmask == 0) { /* * There was no overlap between the states the channel is interested * in notifications for, and the states that are reported present on * the file descriptor by select(). The only way that can happen is * when the channel is interested in a writable condition, and only a * readable state is reported present (see TcpWatchProc() below). In * that case, signal back to the caller the writable state, which is * really an error condition. As an extra check on that assumption, * check for a non-zero value of errno before reporting an artificial * writable state. */ if (errno == 0) { return; } newmask = TCL_WRITABLE; } Tcl_NotifyChannel(statePtr->channel, newmask); } static void TcpWatchProc( void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { TcpState *statePtr = (TcpState *)instanceData; if (statePtr->acceptProc != NULL) { /* * Make sure we don't mess with server sockets since they will never * be readable or writable at the Tcl level. This keeps Tcl scripts * from interfering with the -accept behavior (bug #3394732). */ return; } if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* * Async sockets use a FileHandler internally while connecting, so we * need to cache this request until the connection has succeeded. */ statePtr->filehandlers = mask; } else if (mask) { /* * Whether it is a bug or feature or otherwise, it is a fact of life * that on at least some Linux kernels select() fails to report that a * socket file descriptor is writable when the other end of the socket * is closed. This is in contrast to the guarantees Tcl makes that * its channels become writable and fire writable events on an error * condition. This has caused a leak of file descriptors in a state of * background flushing. See Tcl ticket 1758a0b603. * * As a workaround, when our caller indicates an interest in writable * notifications, we must tell the notifier built around select() that * we are interested in the readable state of the file descriptor as * well, as that is the only reliable means to get notified of error * conditions. Then it is the task of WrapNotify() above to untangle * the meaning of these channel states and report the chan events as * best it can. We save a copy of the mask passed in to assist with * that. */ statePtr->interest = mask; Tcl_CreateFileHandler(statePtr->fds.fd, mask|TCL_READABLE, WrapNotify, statePtr); } else { Tcl_DeleteFileHandler(statePtr->fds.fd); } } /* * ---------------------------------------------------------------------- * * TcpGetHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a * TCP socket based channel. * * Results: * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no * handle for the specified direction. * * Side effects: * None. * * ---------------------------------------------------------------------- */ static int TcpGetHandleProc( void *instanceData, /* The socket state. */ int direction, /* Not used. */ void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; (void)direction; *handlePtr = INT2PTR(statePtr->fds.fd); return TCL_OK; } /* * ---------------------------------------------------------------------- * * TcpAsyncCallback -- * * Called by the event handler that TcpConnect sets up internally for * [socket -async] to get notified when the asynchronous connection * attempt has succeeded or failed. * * ---------------------------------------------------------------------- */ static void TcpAsyncCallback( void *clientData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { (void)mask; TcpConnect(NULL, (TcpState *)clientData); } /* * ---------------------------------------------------------------------- * * TcpConnect -- * * This function opens a new socket in client mode. * * Results: * TCL_OK, if the socket was successfully connected or an asynchronous * connection is in progress. If an error occurs, TCL_ERROR is returned * and an error message is left in interp. * * Side effects: * Opens a socket. * * Remarks: * A single host name may resolve to more than one IP address, e.g. for * an IPv4/IPv6 dual stack host. For handling asynchronously connecting * sockets in the background for such hosts, this function can act as a * coroutine. On the first call, it sets up the control variables for the * two nested loops over the local and remote addresses. Once the first * connection attempt is in progress, it sets up itself as a writable * event handler for that socket, and returns. When the callback occurs, * control is transferred to the "reenter" label, right after the initial * return and the loops resume as if they had never been interrupted. * For synchronously connecting sockets, the loops work the usual way. * * ---------------------------------------------------------------------- */ static int TcpConnect( Tcl_Interp *interp, /* For error reporting; can be NULL. */ TcpState *statePtr) { socklen_t optlen; int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); int ret = -1, error = EHOSTUNREACH; int async = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); if (async_callback) { goto reenter; } for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; statePtr->addr = statePtr->addr->ai_next) { for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL; statePtr->myaddr = statePtr->myaddr->ai_next) { int reuseaddr = 1; /* * No need to try combinations of local and remote addresses of * different families. */ if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) { continue; } /* * Close the socket if it is still open from the last unsuccessful * iteration. */ if (statePtr->fds.fd >= 0) { close(statePtr->fds.fd); statePtr->fds.fd = -1; errno = 0; } statePtr->fds.fd = socket(statePtr->addr->ai_family, SOCK_STREAM, 0); if (statePtr->fds.fd < 0) { continue; } /* * Set the close-on-exec flag so that the socket will not get * inherited by child processes. */ fcntl(statePtr->fds.fd, F_SETFD, FD_CLOEXEC); /* * Set kernel space buffering */ TclSockMinimumBuffers(INT2PTR(statePtr->fds.fd), SOCKET_BUFSIZE); if (async) { ret = TclUnixSetBlockingMode(statePtr->fds.fd, TCL_MODE_NONBLOCKING); if (ret < 0) { continue; } } /* * Must reset the error variable here, before we use it for the * first time in this iteration. */ error = 0; (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR, (char *) &reuseaddr, sizeof(reuseaddr)); ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr, statePtr->myaddr->ai_addrlen); if (ret < 0) { error = errno; continue; } /* * Attempt to connect. The connect may fail at present with an * EINPROGRESS but at a later time it will complete. The caller * will set up a file handler on the socket if she is interested * in being informed when the connect completes. */ ret = connect(statePtr->fds.fd, statePtr->addr->ai_addr, statePtr->addr->ai_addrlen); if (ret < 0) { error = errno; } if (ret < 0 && errno == EINPROGRESS) { Tcl_CreateFileHandler(statePtr->fds.fd, TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, statePtr); errno = EWOULDBLOCK; SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); return TCL_OK; reenter: CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); Tcl_DeleteFileHandler(statePtr->fds.fd); /* * Read the error state from the socket to see if the async * connection has succeeded or failed. As this clears the * error condition, we cache the status in the socket state * struct for later retrieval by [fconfigure -error]. */ optlen = sizeof(int); getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &error, &optlen); errno = error; } if (error == 0) { goto out; } } } out: statePtr->connectError = error; CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); if (async_callback) { /* * An asynchonous connection has finally succeeded or failed. */ TcpWatchProc(statePtr, statePtr->filehandlers); TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking); if (error != 0) { SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); } /* * We need to forward the writable event that brought us here, because * upon reading of getsockopt(SO_ERROR), at least some OSes clear the * writable state from the socket, and so a subsequent select() on * behalf of a script level [fileevent] would not fire. It doesn't * hurt that this is also called in the successful case and will save * the event mechanism one roundtrip through select(). */ if (statePtr->cachedBlocking == TCL_MODE_NONBLOCKING) { Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE); } } if (error != 0) { /* * Failure for either a synchronous connection, or an async one that * failed before it could enter background mode, e.g. because an * invalid -myaddr was given. */ if (interp != NULL) { errno = error; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open socket: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_OpenTcpClient -- * * Opens a TCP client socket and creates a channel around it. * * Results: * The channel or NULL if failed. An error message is returned in the * interpreter on failure. * * Side effects: * Opens a client socket and creates a new channel. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_OpenTcpClient( Tcl_Interp *interp, /* For error reporting; can be NULL. */ int port, /* Port number to open. */ const char *host, /* Host on which to open port. */ const char *myaddr, /* Client-side address */ int myport, /* Client-side port */ int async) /* If nonzero, attempt to do an asynchronous * connect. Otherwise we do a blocking * connect. */ { TcpState *statePtr; const char *errorMsg = NULL; struct addrinfo *addrlist = NULL, *myaddrlist = NULL; char channelName[SOCK_CHAN_LENGTH]; /* * Do the name lookups for the local and remote addresses. */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, &errorMsg)) { if (addrlist != NULL) { freeaddrinfo(addrlist); } if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open socket: %s", errorMsg)); } return NULL; } /* * Allocate a new TcpState for this socket. */ statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->flags = async ? TCP_ASYNC_CONNECT : 0; statePtr->cachedBlocking = TCL_MODE_BLOCKING; statePtr->addrlist = addrlist; statePtr->myaddrlist = myaddrlist; statePtr->fds.fd = -1; /* * Create a new client socket and wrap it in a channel. */ if (TcpConnect(interp, statePtr) != TCL_OK) { TcpCloseProc(statePtr, NULL); return NULL; } snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, (long)statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, TCL_READABLE | TCL_WRITABLE); if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { Tcl_Close(NULL, statePtr->channel); return NULL; } return statePtr->channel; } /* *---------------------------------------------------------------------- * * Tcl_MakeTcpClientChannel -- * * Creates a Tcl_Channel from an existing client TCP socket. * * Results: * The Tcl_Channel wrapped around the preexisting TCP socket. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeTcpClientChannel( void *sock) /* The socket to wrap up into a channel. */ { return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock, TCL_READABLE | TCL_WRITABLE); } /* *---------------------------------------------------------------------- * * TclpMakeTcpClientChannelMode -- * * Creates a Tcl_Channel from an existing client TCP socket * with given mode. * * Results: * The Tcl_Channel wrapped around the preexisting TCP socket. * * Side effects: * None. * *---------------------------------------------------------------------- */ void * TclpMakeTcpClientChannelMode( void *sock, /* The socket to wrap up into a channel. */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->fds.fd = PTR2INT(sock); statePtr->flags = 0; snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, (long)statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, mode); if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { Tcl_Close(NULL, statePtr->channel); return NULL; } return statePtr->channel; } /* *---------------------------------------------------------------------- * * Tcl_OpenTcpServer -- * * Opens a TCP server socket and creates a channel around it. * * Results: * The channel or NULL if failed. If an error occurred, an error message * is left in the interp's result if interp is not NULL. * * Side effects: * Opens a server socket and creates a new channel. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_OpenTcpServer( Tcl_Interp *interp, /* For error reporting - may be NULL. */ int port, /* Port number to open. */ const char *myHost, /* Name of local host. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ void *acceptProcData) /* Data for the callback. */ { int status = 0, sock = -1, reuseaddr = 1, chosenport = 0; struct addrinfo *addrlist = NULL, *addrPtr; /* socket address */ TcpState *statePtr = NULL; char channelName[SOCK_CHAN_LENGTH]; const char *errorMsg = NULL; TcpFdList *fds = NULL, *newfds; /* * Try to record and return the most meaningful error message, i.e. the * one from the first socket that went the farthest before it failed. */ enum { LOOKUP, SOCKET, BIND, LISTEN } howfar = LOOKUP; int my_errno = 0; if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) { my_errno = errno; goto error; } for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { sock = socket(addrPtr->ai_family, addrPtr->ai_socktype, addrPtr->ai_protocol); if (sock == -1) { if (howfar < SOCKET) { howfar = SOCKET; my_errno = errno; } continue; } /* * Set the close-on-exec flag so that the socket will not get * inherited by child processes. */ fcntl(sock, F_SETFD, FD_CLOEXEC); /* * Set kernel space buffering */ TclSockMinimumBuffers(INT2PTR(sock), SOCKET_BUFSIZE); /* * Set up to reuse server addresses automatically and bind to the * specified port. */ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &reuseaddr, sizeof(reuseaddr)); /* * Make sure we use the same port number when opening two server * sockets for IPv4 and IPv6 on a random port. * * As sockaddr_in6 uses the same offset and size for the port member * as sockaddr_in, we can handle both through the IPv4 API. */ if (port == 0 && chosenport != 0) { ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port = htons(chosenport); } #ifdef IPV6_V6ONLY /* * Missing on: Solaris 2.8 */ if (addrPtr->ai_family == AF_INET6) { int v6only = 1; (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY, &v6only, sizeof(v6only)); } #endif /* IPV6_V6ONLY */ status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen); if (status == -1) { if (howfar < BIND) { howfar = BIND; my_errno = errno; } close(sock); sock = -1; continue; } if (port == 0 && chosenport == 0) { address sockname; socklen_t namelen = sizeof(sockname); /* * Synchronize port numbers when binding to port 0 of multiple * addresses. */ if (getsockname(sock, &sockname.sa, &namelen) >= 0) { chosenport = ntohs(sockname.sa4.sin_port); } } status = listen(sock, SOMAXCONN); if (status < 0) { if (howfar < LISTEN) { howfar = LISTEN; my_errno = errno; } close(sock); sock = -1; continue; } if (statePtr == NULL) { /* * Allocate a new TcpState for this socket. */ statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, (long) statePtr); newfds = &statePtr->fds; } else { newfds = (TcpFdList *)ckalloc(sizeof(TcpFdList)); memset(newfds, (int) 0, sizeof(TcpFdList)); fds->next = newfds; } newfds->fd = sock; newfds->statePtr = statePtr; fds = newfds; /* * Set up the callback mechanism for accepting connections from new * clients. */ Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds); } error: if (addrlist != NULL) { freeaddrinfo(addrlist); } if (statePtr != NULL) { statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, 0); return statePtr->channel; } if (interp != NULL) { Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", -1); if (errorMsg == NULL) { errno = my_errno; Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), -1); } else { Tcl_AppendToObj(errorObj, errorMsg, -1); } Tcl_SetObjResult(interp, errorObj); } if (sock != -1) { close(sock); } return NULL; } /* *---------------------------------------------------------------------- * * TcpAccept -- * Accept a TCP socket connection. This is called by the event loop. * * Results: * None. * * Side effects: * Creates a new connection socket. Calls the registered callback for the * connection acceptance mechanism. * *---------------------------------------------------------------------- */ static void TcpAccept( void *data, /* Callback token. */ int mask) /* Not used. */ { TcpFdList *fds = (TcpFdList *)data; /* Client data of server socket. */ int newsock; /* The new client socket */ TcpState *newSockState; /* State for new socket. */ address addr; /* The remote address */ socklen_t len; /* For accept interface */ char channelName[SOCK_CHAN_LENGTH]; char host[NI_MAXHOST], port[NI_MAXSERV]; (void)mask; len = sizeof(addr); newsock = accept(fds->fd, &addr.sa, &len); if (newsock < 0) { return; } /* * Set close-on-exec flag to prevent the newly accepted socket from being * inherited by child processes. */ (void) fcntl(newsock, F_SETFD, FD_CLOEXEC); newSockState = (TcpState *)ckalloc(sizeof(TcpState)); memset(newSockState, 0, sizeof(TcpState)); newSockState->flags = 0; newSockState->fds.fd = newsock; snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, (long)newSockState); newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newSockState, TCL_READABLE | TCL_WRITABLE); Tcl_SetChannelOption(NULL, newSockState->channel, "-translation", "auto crlf"); if (fds->statePtr->acceptProc != NULL) { getnameinfo(&addr.sa, len, host, sizeof(host), port, sizeof(port), NI_NUMERICHOST|NI_NUMERICSERV); fds->statePtr->acceptProc(fds->statePtr->acceptProcData, newSockState->channel, host, atoi(port)); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/unix/tclUnixTest.c0000644000175000017500000005014314554262142015262 0ustar sergeisergei/* * tclUnixTest.c -- * * Contains platform specific test commands for the Unix platform. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" /* * The headers are needed for the testalarm command that verifies the use of * SA_RESTART in signal handlers. */ #include #include /* * The following macros convert between TclFile's and fd's. The conversion * simple involves shifting fd's up by one to ensure that no valid fd is ever * the same as NULL. Note that this code is duplicated from tclUnixPipe.c */ #define MakeFile(fd) ((TclFile)INT2PTR(((int)(fd))+1)) #define GetFd(file) (PTR2INT(file)-1) /* * The stuff below is used to keep track of file handlers created and * exercised by the "testfilehandler" command. */ typedef struct Pipe { TclFile readFile; /* File handle for reading from the pipe. NULL * means pipe doesn't exist yet. */ TclFile writeFile; /* File handle for writing from the pipe. */ int readCount; /* Number of times the file handler for this * file has triggered and the file was * readable. */ int writeCount; /* Number of times the file handler for this * file has triggered and the file was * writable. */ } Pipe; #define MAX_PIPES 10 static Pipe testPipes[MAX_PIPES]; /* * The stuff below is used by the testalarm and testgotsig ommands. */ static const char *gotsig = "0"; /* * Forward declarations of functions defined later in this file: */ static Tcl_CmdProc TestalarmCmd; static Tcl_ObjCmdProc TestchmodCmd; static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; static Tcl_ObjCmdProc TestforkObjCmd; static Tcl_CmdProc TestgetdefencdirCmd; static Tcl_CmdProc TestgetopenfileCmd; static Tcl_CmdProc TestgotsigCmd; static Tcl_CmdProc TestsetdefencdirCmd; static Tcl_FileProc TestFileHandlerProc; static void AlarmHandler(int signum); /* *---------------------------------------------------------------------- * * TclplatformtestInit -- * * Defines commands that test platform specific functionality for Unix * platforms. * * Results: * A standard Tcl result. * * Side effects: * Defines new commands. * *---------------------------------------------------------------------- */ int TclplatformtestInit( Tcl_Interp *interp) /* Interpreter to add commands to. */ { Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, NULL, NULL); Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, NULL, NULL); Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd, NULL, NULL); Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestfilehandlerCmd -- * * This function implements the "testfilehandler" command. It is used to * test Tcl_CreateFileHandler, Tcl_DeleteFileHandler, and TclWaitForFile. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestfilehandlerCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Pipe *pipePtr; int i, mask, timeout; static int initialized = 0; char buffer[4000]; TclFile file; /* * NOTE: When we make this code work on Windows also, the following * variable needs to be made Unix-only. */ if (!initialized) { for (i = 0; i < MAX_PIPES; i++) { testPipes[i].readFile = NULL; } initialized = 1; } if (argc < 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " option ... \"", NULL); return TCL_ERROR; } pipePtr = NULL; if (argc >= 3) { if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) { return TCL_ERROR; } if (i >= MAX_PIPES) { Tcl_AppendResult(interp, "bad index ", argv[2], NULL); return TCL_ERROR; } pipePtr = &testPipes[i]; } if (strcmp(argv[1], "close") == 0) { for (i = 0; i < MAX_PIPES; i++) { if (testPipes[i].readFile != NULL) { TclpCloseFile(testPipes[i].readFile); testPipes[i].readFile = NULL; TclpCloseFile(testPipes[i].writeFile); testPipes[i].writeFile = NULL; } } } else if (strcmp(argv[1], "clear") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " clear index\"", NULL); return TCL_ERROR; } pipePtr->readCount = pipePtr->writeCount = 0; } else if (strcmp(argv[1], "counts") == 0) { char buf[TCL_INTEGER_SPACE * 2]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " counts index\"", NULL); return TCL_ERROR; } snprintf(buf, sizeof(buf), "%d %d", pipePtr->readCount, pipePtr->writeCount); Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "create") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " create index readMode writeMode\"", NULL); return TCL_ERROR; } if (pipePtr->readFile == NULL) { if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) { Tcl_AppendResult(interp, "couldn't open pipe: ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } #ifdef O_NONBLOCK fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK); fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK); #else Tcl_AppendResult(interp, "can't make pipes non-blocking", NULL); return TCL_ERROR; #endif } pipePtr->readCount = 0; pipePtr->writeCount = 0; if (strcmp(argv[3], "readable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE, TestFileHandlerProc, pipePtr); } else if (strcmp(argv[3], "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->readFile)); } else if (strcmp(argv[3], "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0, TestFileHandlerProc, pipePtr); } else { Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL); return TCL_ERROR; } if (strcmp(argv[4], "writable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE, TestFileHandlerProc, pipePtr); } else if (strcmp(argv[4], "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile)); } else if (strcmp(argv[4], "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0, TestFileHandlerProc, pipePtr); } else { Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL); return TCL_ERROR; } } else if (strcmp(argv[1], "empty") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " empty index\"", NULL); return TCL_ERROR; } while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { /* Empty loop body. */ } } else if (strcmp(argv[1], "fill") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " fill index\"", NULL); return TCL_ERROR; } memset(buffer, 'a', 4000); while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) { /* Empty loop body. */ } } else if (strcmp(argv[1], "fillpartial") == 0) { char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " fillpartial index\"", NULL); return TCL_ERROR; } memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); } else if (strcmp(argv[1], "wait") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " wait index readable|writable timeout\"", NULL); return TCL_ERROR; } if (pipePtr->readFile == NULL) { Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist", NULL); return TCL_ERROR; } if (strcmp(argv[3], "readable") == 0) { mask = TCL_READABLE; file = pipePtr->readFile; } else { mask = TCL_WRITABLE; file = pipePtr->writeFile; } if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) { return TCL_ERROR; } i = TclUnixWaitForFile(GetFd(file), mask, timeout); if (i & TCL_READABLE) { Tcl_AppendElement(interp, "readable"); } if (i & TCL_WRITABLE) { Tcl_AppendElement(interp, "writable"); } } else if (strcmp(argv[1], "windowevent") == 0) { Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be close, clear, counts, create, empty, fill, " "fillpartial, oneevent, wait, or windowevent", NULL); return TCL_ERROR; } return TCL_OK; } static void TestFileHandlerProc( ClientData clientData, /* Points to a Pipe structure. */ int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { Pipe *pipePtr = clientData; if (mask & TCL_READABLE) { pipePtr->readCount++; } if (mask & TCL_WRITABLE) { pipePtr->writeCount++; } } /* *---------------------------------------------------------------------- * * TestfilewaitCmd -- * * This function implements the "testfilewait" command. It is used to * test TclUnixWaitForFile. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestfilewaitCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int mask, result, timeout; Tcl_Channel channel; int fd; ClientData data; if (argc != 4) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " file readable|writable|both timeout\"", NULL); return TCL_ERROR; } channel = Tcl_GetChannel(interp, argv[1], NULL); if (channel == NULL) { return TCL_ERROR; } if (strcmp(argv[2], "readable") == 0) { mask = TCL_READABLE; } else if (strcmp(argv[2], "writable") == 0){ mask = TCL_WRITABLE; } else if (strcmp(argv[2], "both") == 0){ mask = TCL_WRITABLE|TCL_READABLE; } else { Tcl_AppendResult(interp, "bad argument \"", argv[2], "\": must be readable, writable, or both", NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, (ClientData*) &data) != TCL_OK) { Tcl_AppendResult(interp, "couldn't get channel file", NULL); return TCL_ERROR; } fd = PTR2INT(data); if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) { return TCL_ERROR; } result = TclUnixWaitForFile(fd, mask, timeout); if (result & TCL_READABLE) { Tcl_AppendElement(interp, "readable"); } if (result & TCL_WRITABLE) { Tcl_AppendElement(interp, "writable"); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestfindexecutableCmd -- * * This function implements the "testfindexecutable" command. It is used * to test TclpFindExecutable. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestfindexecutableCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Obj *saveName; if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " argv0\"", NULL); return TCL_ERROR; } saveName = TclGetObjNameOfExecutable(); Tcl_IncrRefCount(saveName); TclpFindExecutable(argv[1]); Tcl_SetObjResult(interp, TclGetObjNameOfExecutable()); TclSetObjNameOfExecutable(saveName, NULL); Tcl_DecrRefCount(saveName); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestgetopenfileCmd -- * * This function implements the "testgetopenfile" command. It is used to * get a FILE * value from a registered channel. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestgetopenfileCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { ClientData filePtr; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " channelName forWriting\"", NULL); return TCL_ERROR; } if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr) == TCL_ERROR) { return TCL_ERROR; } if (filePtr == NULL) { Tcl_AppendResult(interp, "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestsetdefencdirCmd -- * * This function implements the "testsetdefenc" command. It is used to * test Tcl_SetDefaultEncodingDir(). * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestsetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " defaultDir\"", NULL); return TCL_ERROR; } Tcl_SetDefaultEncodingDir(argv[1]); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestforkObjCmd -- * * This function implements the "testfork" command. It is used to * fork the Tcl process for specific test cases. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestforkObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { pid_t pid; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } pid = fork(); if (pid == -1) { Tcl_AppendResult(interp, "Cannot fork", NULL); return TCL_ERROR; } /* Only needed when pthread_atfork is not present, * should not hurt otherwise. */ if (pid==0) { Tcl_InitNotifier(); } Tcl_SetObjResult(interp, Tcl_NewIntObj(pid)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestgetdefencdirCmd -- * * This function implements the "testgetdefenc" command. It is used to * test Tcl_GetDefaultEncodingDir(). * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestgetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 1) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL); return TCL_ERROR; } Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestalarmCmd -- * * Test that EINTR is handled correctly by generating and handling a * signal. This requires using the SA_RESTART flag when registering the * signal handler. * * Results: * None. * * Side Effects: * Sets up an signal and async handlers. * *---------------------------------------------------------------------- */ static int TestalarmCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { #ifdef SA_RESTART unsigned int sec; struct sigaction action; if (argc > 1) { Tcl_GetInt(interp, argv[1], (int *)&sec); } else { sec = 1; } /* * Setup the signal handling that automatically retries any interrupted * I/O system calls. */ action.sa_handler = AlarmHandler; memset((void *) &action.sa_mask, 0, sizeof(sigset_t)); action.sa_flags = SA_RESTART; if (sigaction(SIGALRM, &action, NULL) < 0) { Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } (void) alarm(sec); return TCL_OK; #else Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", NULL); return TCL_ERROR; #endif } /* *---------------------------------------------------------------------- * * AlarmHandler -- * * Signal handler for the alarm command. * * Results: * None. * * Side effects: * Calls the Tcl Async handler. * *---------------------------------------------------------------------- */ static void AlarmHandler( int signum) { gotsig = "1"; } /* *---------------------------------------------------------------------- * * TestgotsigCmd -- * * Verify the signal was handled after the testalarm command. * * Results: * None. * * Side Effects: * Resets the value of gotsig back to '0'. * *---------------------------------------------------------------------- */ static int TestgotsigCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, gotsig, NULL); gotsig = "0"; return TCL_OK; } /* *--------------------------------------------------------------------------- * * TestchmodCmd -- * * Implements the "testchmod" cmd. Used when testing "file" command. * The only attribute used by the Windows platform is the user write * flag; if this is not set, the file is made read-only. Otherwise, the * file is made read-write. * * Results: * A standard Tcl result. * * Side effects: * Changes permissions of specified files. * *--------------------------------------------------------------------------- */ static int TestchmodCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { int i, mode; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) { return TCL_ERROR; } for (i = 2; i < objc; i++) { Tcl_DString buffer; const char *translated; translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer); if (translated == NULL) { return TCL_ERROR; } if (chmod(translated, (unsigned) mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); } return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ tcl8.6.14/unix/tclUnixThrd.c0000644000175000017500000004451114554262142015246 0ustar sergeisergei/* * tclUnixThrd.c -- * * This file implements the UNIX-specific thread support. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 2008 by George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef TCL_THREADS typedef struct ThreadSpecificData { char nabuf[16]; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * globalLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the * ability to statically initialize the mutex. */ static pthread_mutex_t globalLock = PTHREAD_MUTEX_INITIALIZER; /* * initLock is used to serialize initialization and finalization of Tcl. It * cannot use any dynamically allocated storage. */ static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER; /* * allocLock is used by Tcl's version of malloc for synchronization. For * obvious reasons, cannot use any dynamically allocated storage. */ static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER; static pthread_mutex_t *allocLockPtr = &allocLock; /* * These are for the critical sections inside this file. */ #define GLOBAL_LOCK pthread_mutex_lock(&globalLock) #define GLOBAL_UNLOCK pthread_mutex_unlock(&globalLock) #endif /* TCL_THREADS */ /* *---------------------------------------------------------------------- * * TclpThreadCreate -- * * This procedure creates a new thread. * * Results: * TCL_OK if the thread could be created. The thread ID is returned in a * parameter. * * Side effects: * A new thread is created. * *---------------------------------------------------------------------- */ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ ClientData clientData, /* The one argument to Main() */ int stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { #ifdef TCL_THREADS pthread_attr_t attr; pthread_t theThread; int result; pthread_attr_init(&attr); pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM); #ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE if (stackSize != TCL_THREAD_STACK_DEFAULT) { pthread_attr_setstacksize(&attr, stackSize); #ifdef TCL_THREAD_STACK_MIN } else { /* * Certain systems define a thread stack size that by default is too * small for many operations. The user has the option of defining * TCL_THREAD_STACK_MIN to a value large enough to work for their * needs. This would look like (for 128K min stack): * make MEM_DEBUG_FLAGS=-DTCL_THREAD_STACK_MIN=131072L * * This solution is not optimal, as we should allow the user to * specify a size at runtime, but we don't want to slow this function * down, and that would still leave the main thread at the default. */ size_t size; result = pthread_attr_getstacksize(&attr, &size); if (!result && (size < TCL_THREAD_STACK_MIN)) { pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN); } #endif /* TCL_THREAD_STACK_MIN */ } #endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */ if (!(flags & TCL_THREAD_JOINABLE)) { pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); } if (pthread_create(&theThread, &attr, (void * (*)(void *))(void *)proc, (void *)clientData) && pthread_create(&theThread, NULL, (void * (*)(void *))(void *)proc, (void *)clientData)) { result = TCL_ERROR; } else { *idPtr = (Tcl_ThreadId)theThread; result = TCL_OK; } pthread_attr_destroy(&attr); return result; #else return TCL_ERROR; #endif /* TCL_THREADS */ } /* *---------------------------------------------------------------------- * * Tcl_JoinThread -- * * This procedure waits upon the exit of the specified thread. * * Results: * TCL_OK if the wait was successful, TCL_ERROR else. * * Side effects: * The result area is set to the exit code of the thread we waited upon. * *---------------------------------------------------------------------- */ int Tcl_JoinThread( Tcl_ThreadId threadId, /* Id of the thread to wait upon. */ int *state) /* Reference to the storage the result of the * thread we wait upon will be written into. * May be NULL. */ { #ifdef TCL_THREADS int result; unsigned long retcode, *retcodePtr = &retcode; result = pthread_join((pthread_t) threadId, (void**) retcodePtr); if (state) { *state = (int) retcode; } return (result == 0) ? TCL_OK : TCL_ERROR; #else return TCL_ERROR; #endif } #ifdef TCL_THREADS /* *---------------------------------------------------------------------- * * TclpThreadExit -- * * This procedure terminates the current thread. * * Results: * None. * * Side effects: * This procedure terminates the current thread. * *---------------------------------------------------------------------- */ void TclpThreadExit( int status) { pthread_exit(INT2PTR(status)); } #endif /* TCL_THREADS */ /* *---------------------------------------------------------------------- * * Tcl_GetCurrentThread -- * * This procedure returns the ID of the currently running thread. * * Results: * A thread ID. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_ThreadId Tcl_GetCurrentThread(void) { #ifdef TCL_THREADS return (Tcl_ThreadId) pthread_self(); #else return (Tcl_ThreadId) 0; #endif } /* *---------------------------------------------------------------------- * * TclpInitLock * * This procedure is used to grab a lock that serializes initialization * and finalization of Tcl. On some platforms this may also initialize * the mutex used to serialize creation of more mutexes and thread local * storage keys. * * Results: * None. * * Side effects: * Acquire the initialization mutex. * *---------------------------------------------------------------------- */ void TclpInitLock(void) { #ifdef TCL_THREADS pthread_mutex_lock(&initLock); #endif } /* *---------------------------------------------------------------------- * * TclFinalizeLock * * This procedure is used to destroy all private resources used in this * file. * * Results: * None. * * Side effects: * Destroys everything private. TclpInitLock must be held entering this * function. * *---------------------------------------------------------------------- */ void TclFinalizeLock(void) { #ifdef TCL_THREADS /* * You do not need to destroy mutexes that were created with the * PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any * destruction: globalLock, allocLock, and initLock. */ pthread_mutex_unlock(&initLock); #endif } /* *---------------------------------------------------------------------- * * TclpInitUnlock * * This procedure is used to release a lock that serializes * initialization and finalization of Tcl. * * Results: * None. * * Side effects: * Release the initialization mutex. * *---------------------------------------------------------------------- */ void TclpInitUnlock(void) { #ifdef TCL_THREADS pthread_mutex_unlock(&initLock); #endif } /* *---------------------------------------------------------------------- * * TclpGlobalLock * * This procedure is used to grab a lock that serializes creation and * finalization of serialization objects. This interface is only needed * in finalization; it is hidden during creation of the objects. * * This lock must be different than the initLock because the initLock is * held during creation of synchronization objects. * * Results: * None. * * Side effects: * Acquire the global mutex. * *---------------------------------------------------------------------- */ void TclpGlobalLock(void) { #ifdef TCL_THREADS pthread_mutex_lock(&globalLock); #endif } /* *---------------------------------------------------------------------- * * TclpGlobalUnlock * * This procedure is used to release a lock that serializes creation and * finalization of synchronization objects. * * Results: * None. * * Side effects: * Release the global mutex. * *---------------------------------------------------------------------- */ void TclpGlobalUnlock(void) { #ifdef TCL_THREADS pthread_mutex_unlock(&globalLock); #endif } /* *---------------------------------------------------------------------- * * Tcl_GetAllocMutex * * This procedure returns a pointer to a statically initialized mutex for * use by the memory allocator. The allocator must use this lock, because * all other locks are allocated... * * Results: * A pointer to a mutex that is suitable for passing to Tcl_MutexLock and * Tcl_MutexUnlock. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Mutex * Tcl_GetAllocMutex(void) { #ifdef TCL_THREADS pthread_mutex_t **allocLockPtrPtr = &allocLockPtr; return (Tcl_Mutex *) allocLockPtrPtr; #else return NULL; #endif } #ifdef TCL_THREADS /* *---------------------------------------------------------------------- * * Tcl_MutexLock -- * * This procedure is invoked to lock a mutex. This procedure handles * initializing the mutex, if necessary. The caller can rely on the fact * that Tcl_Mutex is an opaque pointer. This routine will change that * pointer from NULL after first use. * * Results: * None. * * Side effects: * May block the current thread. The mutex is acquired when this returns. * Will allocate memory for a pthread_mutex_t and initialize this the * first time this Tcl_Mutex is used. * *---------------------------------------------------------------------- */ void Tcl_MutexLock( Tcl_Mutex *mutexPtr) /* Really (pthread_mutex_t **) */ { pthread_mutex_t *pmutexPtr; if (*mutexPtr == NULL) { GLOBAL_LOCK; if (*mutexPtr == NULL) { /* * Double inside global lock check to avoid a race condition. */ pmutexPtr = (pthread_mutex_t *)ckalloc(sizeof(pthread_mutex_t)); pthread_mutex_init(pmutexPtr, NULL); *mutexPtr = (Tcl_Mutex)pmutexPtr; TclRememberMutex(mutexPtr); } GLOBAL_UNLOCK; } pmutexPtr = *((pthread_mutex_t **)mutexPtr); pthread_mutex_lock(pmutexPtr); } /* *---------------------------------------------------------------------- * * Tcl_MutexUnlock -- * * This procedure is invoked to unlock a mutex. The mutex must have been * locked by Tcl_MutexLock. * * Results: * None. * * Side effects: * The mutex is released when this returns. * *---------------------------------------------------------------------- */ void Tcl_MutexUnlock( Tcl_Mutex *mutexPtr) /* Really (pthread_mutex_t **) */ { pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **) mutexPtr; pthread_mutex_unlock(pmutexPtr); } /* *---------------------------------------------------------------------- * * TclpFinalizeMutex -- * * This procedure is invoked to clean up one mutex. This is only safe to * call at the end of time. * * This assumes the Global Lock is held. * * Results: * None. * * Side effects: * The mutex list is deallocated. * *---------------------------------------------------------------------- */ void TclpFinalizeMutex( Tcl_Mutex *mutexPtr) { pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **) mutexPtr; if (pmutexPtr != NULL) { pthread_mutex_destroy(pmutexPtr); ckfree(pmutexPtr); *mutexPtr = NULL; } } /* *---------------------------------------------------------------------- * * Tcl_ConditionWait -- * * This procedure is invoked to wait on a condition variable. The mutex * is automically released as part of the wait, and automatically grabbed * when the condition is signaled. * * The mutex must be held when this procedure is called. * * Results: * None. * * Side effects: * May block the current thread. The mutex is acquired when this returns. * Will allocate memory for a pthread_mutex_t and initialize this the * first time this Tcl_Mutex is used. * *---------------------------------------------------------------------- */ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (pthread_cond_t **) */ Tcl_Mutex *mutexPtr, /* Really (pthread_mutex_t **) */ const Tcl_Time *timePtr) /* Timeout on waiting period */ { pthread_cond_t *pcondPtr; pthread_mutex_t *pmutexPtr; struct timespec ptime; if (*condPtr == NULL) { GLOBAL_LOCK; /* * Double check inside mutex to avoid race, then initialize condition * variable if necessary. */ if (*condPtr == NULL) { pcondPtr = (pthread_cond_t *)ckalloc(sizeof(pthread_cond_t)); pthread_cond_init(pcondPtr, NULL); *condPtr = (Tcl_Condition) pcondPtr; TclRememberCondition(condPtr); } GLOBAL_UNLOCK; } pmutexPtr = *((pthread_mutex_t **)mutexPtr); pcondPtr = *((pthread_cond_t **)condPtr); if (timePtr == NULL) { pthread_cond_wait(pcondPtr, pmutexPtr); } else { Tcl_Time now; /* * Make sure to take into account the microsecond component of the * current time, including possible overflow situations. [Bug #411603] */ Tcl_GetTime(&now); ptime.tv_sec = timePtr->sec + now.sec + (timePtr->usec + now.usec) / 1000000; ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000); pthread_cond_timedwait(pcondPtr, pmutexPtr, &ptime); } } /* *---------------------------------------------------------------------- * * Tcl_ConditionNotify -- * * This procedure is invoked to signal a condition variable. * * The mutex must be held during this call to avoid races, but this * interface does not enforce that. * * Results: * None. * * Side effects: * May unblock another thread. * *---------------------------------------------------------------------- */ void Tcl_ConditionNotify( Tcl_Condition *condPtr) { pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr); if (pcondPtr != NULL) { pthread_cond_broadcast(pcondPtr); } else { /* * No-one has used the condition variable, so there are no waiters. */ } } /* *---------------------------------------------------------------------- * * TclpFinalizeCondition -- * * This procedure is invoked to clean up a condition variable. This is * only safe to call at the end of time. * * This assumes the Global Lock is held. * * Results: * None. * * Side effects: * The condition variable is deallocated. * *---------------------------------------------------------------------- */ void TclpFinalizeCondition( Tcl_Condition *condPtr) { pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr; if (pcondPtr != NULL) { pthread_cond_destroy(pcondPtr); ckfree(pcondPtr); *condPtr = NULL; } } #endif /* TCL_THREADS */ /* *---------------------------------------------------------------------- * * TclpReaddir, TclpInetNtoa -- * * These procedures replace core C versions to be used in a threaded * environment. * * Results: * See documentation of C functions. * * Side effects: * See documentation of C functions. * * Notes: * TclpReaddir is no longer used by the core (see 1095909), but it * appears in the internal stubs table (see #589526). * *---------------------------------------------------------------------- */ Tcl_DirEntry * TclpReaddir( TclDIR * dir) { return TclOSreaddir(dir); } #undef TclpInetNtoa char * TclpInetNtoa( struct in_addr addr) { #ifdef TCL_THREADS ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); unsigned char *b = (unsigned char*) &addr.s_addr; snprintf(tsdPtr->nabuf, sizeof(tsdPtr->nabuf), "%u.%u.%u.%u", b[0], b[1], b[2], b[3]); return tsdPtr->nabuf; #else return inet_ntoa(addr); #endif } #ifdef TCL_THREADS /* * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC static volatile int initialized = 0; static pthread_key_t key; typedef struct { Tcl_Mutex tlock; pthread_mutex_t plock; } AllocMutex; Tcl_Mutex * TclpNewAllocMutex(void) { AllocMutex *lockPtr; pthread_mutex_t *plockPtr; lockPtr = (AllocMutex *)malloc(sizeof(AllocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } plockPtr = &lockPtr->plock; lockPtr->tlock = (Tcl_Mutex) plockPtr; pthread_mutex_init(&lockPtr->plock, NULL); return &lockPtr->tlock; } void TclpFreeAllocMutex( Tcl_Mutex *mutex) /* The alloc mutex to free. */ { AllocMutex *lockPtr = (AllocMutex *)mutex; if (!lockPtr) { return; } pthread_mutex_destroy(&lockPtr->plock); free(lockPtr); } void TclpFreeAllocCache( void *ptr) { if (ptr != NULL) { /* * Called by TclFinalizeThreadAllocThread() during the thread * finalization initiated from Tcl_FinalizeThread() */ TclFreeAllocCache(ptr); pthread_setspecific(key, NULL); } else if (initialized) { /* * Called by TclFinalizeThreadAlloc() during the process * finalization initiated from Tcl_Finalize() */ pthread_key_delete(key); initialized = 0; } } void * TclpGetAllocCache(void) { if (!initialized) { pthread_mutex_lock(allocLockPtr); if (!initialized) { pthread_key_create(&key, NULL); initialized = 1; } pthread_mutex_unlock(allocLockPtr); } return pthread_getspecific(key); } void TclpSetAllocCache( void *arg) { pthread_setspecific(key, arg); } #endif /* USE_THREAD_ALLOC */ void * TclpThreadCreateKey(void) { pthread_key_t *ptkeyPtr; ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t), 0); if (NULL == ptkeyPtr) { Tcl_Panic("unable to allocate thread key!"); } if (pthread_key_create(ptkeyPtr, NULL)) { Tcl_Panic("unable to create pthread key!"); } return ptkeyPtr; } void TclpThreadDeleteKey( void *keyPtr) { pthread_key_t *ptkeyPtr = (pthread_key_t *)keyPtr; if (pthread_key_delete(*ptkeyPtr)) { Tcl_Panic("unable to delete key!"); } TclpSysFree(keyPtr); } void TclpThreadSetGlobalTSD( void *tsdKeyPtr, void *ptr) { pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr; if (pthread_setspecific(*ptkeyPtr, ptr)) { Tcl_Panic("unable to set global TSD value"); } } void * TclpThreadGetGlobalTSD( void *tsdKeyPtr) { pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr; return pthread_getspecific(*ptkeyPtr); } #endif /* TCL_THREADS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclUnixThrd.h0000644000175000017500000000060614554262142015250 0ustar sergeisergei/* * tclUnixThrd.h -- * * This header file defines things for thread support. * * Copyright (c) 1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLUNIXTHRD #define _TCLUNIXTHRD #ifdef TCL_THREADS #endif /* TCL_THREADS */ #endif /* _TCLUNIXTHRD */ tcl8.6.14/unix/tclUnixTime.c0000644000175000017500000003262014554262142015241 0ustar sergeisergei/* * tclUnixTime.c -- * * Contains Unix specific versions of Tcl functions that obtain time * values from the operating system. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include #if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL) #include #endif /* * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread * safety, this structure must be in thread-specific data. The 'tmKey' * variable is the key to this buffer. */ static Tcl_ThreadDataKey tmKey; typedef struct ThreadSpecificData { struct tm gmtime_buf; struct tm localtime_buf; } ThreadSpecificData; /* * If we fall back on the thread-unsafe versions of gmtime and localtime, use * this mutex to try to protect them. */ TCL_DECLARE_MUTEX(tmMutex) static char *lastTZ = NULL; /* Holds the last setting of the TZ * environment variable, or an empty string if * the variable was not set. */ /* * Static functions declared in this file. */ static void SetTZIfNecessary(void); static void CleanupMemory(ClientData clientData); static void NativeScaleTime(Tcl_Time *timebuf, ClientData clientData); static void NativeGetTime(Tcl_Time *timebuf, ClientData clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. */ Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; ClientData tclTimeClientData = NULL; /* *---------------------------------------------------------------------- * * TclpGetSeconds -- * * This procedure returns the number of seconds from the epoch. On most * Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of seconds from the epoch. * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned long TclpGetSeconds(void) { return time(NULL); } /* *---------------------------------------------------------------------- * * TclpGetMicroseconds -- * * This procedure returns the number of microseconds from the epoch. * On most Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of microseconds from the epoch. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_WideInt TclpGetMicroseconds(void) { Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); return ((Tcl_WideInt)time.sec)*1000000 + time.usec; } /* *---------------------------------------------------------------------- * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no guarantees on what the * resolution will be. In Tcl we will call this value a "click". The * start time is also system dependent. * * Results: * Number of clicks from some start time. * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned long TclpGetClicks(void) { unsigned long now; #ifdef NO_GETTOD if (tclGetTimeProcPtr != NativeGetTime) { Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); now = ((unsigned long)(time.sec)*1000000UL) + (unsigned long)(time.usec); } else { /* * A semi-NativeGetTime, specialized to clicks. */ struct tms dummy; now = (unsigned long) times(&dummy); } #else Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); now = ((unsigned long)(time.sec)*1000000UL) + (unsigned long)(time.usec); #endif return now; } #ifdef TCL_WIDE_CLICKS /* *---------------------------------------------------------------------- * * TclpGetWideClicks -- * * This procedure returns a WideInt value that represents the highest * resolution clock available on the system. There are no guarantees on * what the resolution will be. In Tcl we will call this value a "click". * The start time is also system dependent. * * Results: * Number of WideInt clicks from some start time. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_WideInt TclpGetWideClicks(void) { Tcl_WideInt now; if (tclGetTimeProcPtr != NativeGetTime) { Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); now = ((Tcl_WideInt)time.sec)*1000000 + time.usec; } else { #ifdef MAC_OSX_TCL now = (Tcl_WideInt) (mach_absolute_time() & INT64_MAX); #else #error Wide high-resolution clicks not implemented on this platform #endif } return now; } /* *---------------------------------------------------------------------- * * TclpWideClicksToNanoseconds -- * * This procedure converts click values from the TclpGetWideClicks native * resolution to nanosecond resolution. * * Results: * Number of nanoseconds from some start time. * * Side effects: * None. * *---------------------------------------------------------------------- */ double TclpWideClicksToNanoseconds( Tcl_WideInt clicks) { double nsec; if (tclGetTimeProcPtr != NativeGetTime) { nsec = clicks * 1000; } else { #ifdef MAC_OSX_TCL static mach_timebase_info_data_t tb; static uint64_t maxClicksForUInt64; if (!tb.denom) { mach_timebase_info(&tb); maxClicksForUInt64 = UINT64_MAX / tb.numer; } if ((uint64_t) clicks < maxClicksForUInt64) { nsec = ((uint64_t) clicks) * tb.numer / tb.denom; } else { nsec = ((long double) (uint64_t) clicks) * tb.numer / tb.denom; } #else #error Wide high-resolution clicks not implemented on this platform #endif } return nsec; } /* *---------------------------------------------------------------------- * * TclpWideClickInMicrosec -- * * This procedure return scale to convert click values from the * TclpGetWideClicks native resolution to microsecond resolution * and back. * * Results: * 1 click in microseconds as double. * * Side effects: * None. * *---------------------------------------------------------------------- */ double TclpWideClickInMicrosec(void) { if (tclGetTimeProcPtr != NativeGetTime) { return 1.0; } else { #ifdef MAC_OSX_TCL static int initialized = 0; static double scale = 0.0; if (initialized) { return scale; } else { mach_timebase_info_data_t tb; mach_timebase_info(&tb); /* value of tb.numer / tb.denom = 1 click in nanoseconds */ scale = ((double)tb.numer) / tb.denom / 1000; initialized = 1; return scale; } #else #error Wide high-resolution clicks not implemented on this platform #endif } } #endif /* TCL_WIDE_CLICKS */ /* *---------------------------------------------------------------------- * * Tcl_GetTime -- * * Gets the current system time in seconds and microseconds since the * beginning of the epoch: 00:00 UCT, January 1, 1970. * * This function is hooked, allowing users to specify their own virtual * system time. * * Results: * Returns the current time in timePtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { tclGetTimeProcPtr(timePtr, tclTimeClientData); } /* *---------------------------------------------------------------------- * * TclpGetDate -- * * This function converts between seconds and struct tm. If useGMT is * true, then the returned date will be in Greenwich Mean Time (GMT). * Otherwise, it will be in the local time zone. * * Results: * Returns a static tm structure. * * Side effects: * None. * *---------------------------------------------------------------------- */ struct tm * TclpGetDate( const time_t *time, int useGMT) { if (useGMT) { return TclpGmtime(time); } else { return TclpLocaltime(time); } } /* *---------------------------------------------------------------------- * * TclpGmtime -- * * Wrapper around the 'gmtime' library function to make it thread safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes gmtime or gmtime_r as appropriate. * *---------------------------------------------------------------------- */ struct tm * TclpGmtime( const time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ { /* * Get a thread-local buffer to hold the returned time. */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); #ifdef HAVE_GMTIME_R gmtime_r(timePtr, &tsdPtr->gmtime_buf); #else Tcl_MutexLock(&tmMutex); memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm)); Tcl_MutexUnlock(&tmMutex); #endif return &tsdPtr->gmtime_buf; } /* *---------------------------------------------------------------------- * * TclpLocaltime -- * * Wrapper around the 'localtime' library function to make it thread * safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes localtime or localtime_r as appropriate. * *---------------------------------------------------------------------- */ struct tm * TclpLocaltime( const time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ { /* * Get a thread-local buffer to hold the returned time. */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); SetTZIfNecessary(); #ifdef HAVE_LOCALTIME_R localtime_r(timePtr, &tsdPtr->localtime_buf); #else Tcl_MutexLock(&tmMutex); memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm)); Tcl_MutexUnlock(&tmMutex); #endif return &tsdPtr->localtime_buf; } /* *---------------------------------------------------------------------- * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the * virtualization of Tcl's access to time information. * * Results: * None. * * Side effects: * Remembers the handlers, alters core behaviour. * *---------------------------------------------------------------------- */ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; tclTimeClientData = clientData; } /* *---------------------------------------------------------------------- * * Tcl_QueryTimeProc -- * * TIP #233 (Virtualized Time): Query which time handlers are registered. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; } if (scaleProc) { *scaleProc = tclScaleTimeProcPtr; } if (clientData) { *clientData = tclTimeClientData; } } /* *---------------------------------------------------------------------- * * NativeScaleTime -- * * TIP #233: Scale from virtual time to the real-time. For native scaling * the relationship is 1:1 and nothing has to be done. * * Results: * Scales the time in timePtr. * * Side effects: * See above. * *---------------------------------------------------------------------- */ static void NativeScaleTime( Tcl_Time *timePtr, ClientData clientData) { /* Native scale is 1:1. Nothing is done */ } /* *---------------------------------------------------------------------- * * NativeGetTime -- * * TIP #233: Gets the current system time in seconds and microseconds * since the beginning of the epoch: 00:00 UCT, January 1, 1970. * * Results: * Returns the current time in timePtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void NativeGetTime( Tcl_Time *timePtr, ClientData clientData) { struct timeval tv; (void) gettimeofday(&tv, NULL); timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } /* *---------------------------------------------------------------------- * * SetTZIfNecessary -- * * Determines whether a call to 'tzset' is needed prior to the next call * to 'localtime' or examination of the 'timezone' variable. * * Results: * None. * * Side effects: * If 'tzset' has never been called in the current process, or if the * value of the environment variable TZ has changed since the last call * to 'tzset', then 'tzset' is called again. * *---------------------------------------------------------------------- */ static void SetTZIfNecessary(void) { const char *newTZ = getenv("TZ"); Tcl_MutexLock(&tmMutex); if (newTZ == NULL) { newTZ = ""; } if (lastTZ == NULL || strcmp(lastTZ, newTZ)) { tzset(); if (lastTZ == NULL) { Tcl_CreateExitHandler(CleanupMemory, NULL); } else { ckfree(lastTZ); } lastTZ = ckalloc(strlen(newTZ) + 1); strcpy(lastTZ, newTZ); } Tcl_MutexUnlock(&tmMutex); } /* *---------------------------------------------------------------------- * * CleanupMemory -- * * Releases the private copy of the TZ environment variable upon exit * from Tcl. * * Results: * None. * * Side effects: * Frees allocated memory. * *---------------------------------------------------------------------- */ static void CleanupMemory( ClientData ignored) { ckfree(lastTZ); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclXtNotify.c0000644000175000017500000003774214554262142015275 0ustar sergeisergei/* * tclXtNotify.c -- * * This file contains the notifier driver implementation for the Xt * intrinsics. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include #include "tclInt.h" /* * This structure is used to keep track of the notifier info for a * registered file. */ typedef struct FileHandler { int fd; int mask; /* Mask of desired events: TCL_READABLE, * etc. */ int readyMask; /* Events that have been seen since the last * time FileHandlerEventProc was called for * this file. */ XtInputId read; /* Xt read callback handle. */ XtInputId write; /* Xt write callback handle. */ XtInputId except; /* Xt exception callback handle. */ Tcl_FileProc *proc; /* Procedure to call, in the style of * Tcl_CreateFileHandler. */ ClientData clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; /* * The following structure is what is added to the Tcl event queue when file * handlers are ready to fire. */ typedef struct FileHandlerEvent { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find * the FileHandler structure for the file * (can't point directly to the FileHandler * structure because it could go away while * the event is queued). */ } FileHandlerEvent; /* * The following static structure contains the state information for the Xt * based implementation of the Tcl notifier. */ static struct NotifierState { XtAppContext appContext; /* The context used by the Xt notifier. Can be * set with TclSetAppContext. */ int appContextCreated; /* Was it created by us? */ XtIntervalId currentTimeout;/* Handle of current timer. */ FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler list. */ } notifier; /* * The following static indicates whether this module has been initialized. */ static int initialized = 0; /* * Static routines defined in this file. */ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void FileProc(XtPointer clientData, int *source, XtInputId *id); static void NotifierExitHandler(ClientData clientData); static void TimerProc(XtPointer clientData, XtIntervalId *id); static void CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); static void DeleteFileHandler(int fd); static void SetTimer(const Tcl_Time * timePtr); static int WaitForEvent(const Tcl_Time * timePtr); /* * Functions defined in this file for use by users of the Xt Notifier: */ MODULE_SCOPE void InitNotifier(void); MODULE_SCOPE XtAppContext TclSetAppContext(XtAppContext ctx); /* *---------------------------------------------------------------------- * * TclSetAppContext -- * * Set the notifier application context. * * Results: * None. * * Side effects: * Sets the application context used by the notifier. Panics if the * context is already set when called. * *---------------------------------------------------------------------- */ XtAppContext TclSetAppContext( XtAppContext appContext) { if (!initialized) { InitNotifier(); } /* * If we already have a context we check whether we were asked to set a * new context. If so, we panic because we try to prevent switching * contexts by mistake. Otherwise, we return the one we have. */ if (notifier.appContext != NULL) { if (appContext != NULL) { /* * We already have a context. We do not allow switching contexts * after initialization, so we panic. */ Tcl_Panic("TclSetAppContext: multiple application contexts"); } } else { /* * If we get here we have not yet gotten a context, so either create * one or use the one supplied by our caller. */ if (appContext == NULL) { /* * We must create a new context and tell our caller what it is, so * she can use it too. */ notifier.appContext = XtCreateApplicationContext(); notifier.appContextCreated = 1; } else { /* * Otherwise we remember the context that our caller gave us and * use it. */ notifier.appContextCreated = 0; notifier.appContext = appContext; } } return notifier.appContext; } /* *---------------------------------------------------------------------- * * InitNotifier -- * * Initializes the notifier state. * * Results: * None. * * Side effects: * Creates a new exit handler. * *---------------------------------------------------------------------- */ void InitNotifier(void) { Tcl_NotifierProcs np; /* * Only reinitialize if we are not in exit handling. The notifier can get * reinitialized after its own exit handler has run, because of exit * handlers for the I/O and timer sub-systems (order dependency). */ if (TclInExit()) { return; } memset(&np, 0, sizeof(np)); np.createFileHandlerProc = CreateFileHandler; np.deleteFileHandlerProc = DeleteFileHandler; np.setTimerProc = SetTimer; np.waitForEventProc = WaitForEvent; Tcl_SetNotifier(&np); /* * DO NOT create the application context yet; doing so would prevent * external applications from setting it for us to their own ones. */ initialized = 1; Tcl_CreateExitHandler(NotifierExitHandler, NULL); } /* *---------------------------------------------------------------------- * * NotifierExitHandler -- * * This function is called to cleanup the notifier state before Tcl is * unloaded. * * Results: * None. * * Side effects: * Destroys the notifier window. * *---------------------------------------------------------------------- */ static void NotifierExitHandler( ClientData clientData) /* Not used. */ { if (notifier.currentTimeout != 0) { XtRemoveTimeOut(notifier.currentTimeout); } for (; notifier.firstFileHandlerPtr != NULL; ) { Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd); } if (notifier.appContextCreated) { XtDestroyApplicationContext(notifier.appContext); notifier.appContextCreated = 0; notifier.appContext = NULL; } initialized = 0; } /* *---------------------------------------------------------------------- * * SetTimer -- * * This procedure sets the current notifier timeout value. * * Results: * None. * * Side effects: * Replaces any previous timer. * *---------------------------------------------------------------------- */ static void SetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { long timeout; if (!initialized) { InitNotifier(); } TclSetAppContext(NULL); if (notifier.currentTimeout != 0) { XtRemoveTimeOut(notifier.currentTimeout); } if (timePtr) { timeout = timePtr->sec * 1000 + timePtr->usec / 1000; notifier.currentTimeout = XtAppAddTimeOut(notifier.appContext, (unsigned long) timeout, TimerProc, NULL); } else { notifier.currentTimeout = 0; } } /* *---------------------------------------------------------------------- * * TimerProc -- * * This procedure is the XtTimerCallbackProc used to handle timeouts. * * Results: * None. * * Side effects: * Processes all queued events. * *---------------------------------------------------------------------- */ static void TimerProc( XtPointer clientData, /* Not used. */ XtIntervalId *id) { if (*id != notifier.currentTimeout) { return; } notifier.currentTimeout = 0; Tcl_ServiceAll(); } /* *---------------------------------------------------------------------- * * CreateFileHandler -- * * This procedure registers a file handler with the Xt notifier. * * Results: * None. * * Side effects: * Creates a new file handler structure and registers one or more input * procedures with Xt. * *---------------------------------------------------------------------- */ static void CreateFileHandler( int fd, /* Handle of stream to watch. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Procedure to call for each selected * event. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { FileHandler *filePtr; if (!initialized) { InitNotifier(); } TclSetAppContext(NULL); for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { filePtr = ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->read = 0; filePtr->write = 0; filePtr->except = 0; filePtr->readyMask = 0; filePtr->mask = 0; filePtr->nextPtr = notifier.firstFileHandlerPtr; notifier.firstFileHandlerPtr = filePtr; } filePtr->proc = proc; filePtr->clientData = clientData; /* * Register the file with the Xt notifier, if it hasn't been done yet. */ if (mask & TCL_READABLE) { if (!(filePtr->mask & TCL_READABLE)) { filePtr->read = XtAppAddInput(notifier.appContext, fd, INT2PTR(XtInputReadMask), FileProc, filePtr); } } else { if (filePtr->mask & TCL_READABLE) { XtRemoveInput(filePtr->read); } } if (mask & TCL_WRITABLE) { if (!(filePtr->mask & TCL_WRITABLE)) { filePtr->write = XtAppAddInput(notifier.appContext, fd, INT2PTR(XtInputWriteMask), FileProc, filePtr); } } else { if (filePtr->mask & TCL_WRITABLE) { XtRemoveInput(filePtr->write); } } if (mask & TCL_EXCEPTION) { if (!(filePtr->mask & TCL_EXCEPTION)) { filePtr->except = XtAppAddInput(notifier.appContext, fd, INT2PTR(XtInputExceptMask), FileProc, filePtr); } } else { if (filePtr->mask & TCL_EXCEPTION) { XtRemoveInput(filePtr->except); } } filePtr->mask = mask; } /* *---------------------------------------------------------------------- * * DeleteFileHandler -- * * Cancel a previously-arranged callback arrangement for a file. * * Results: * None. * * Side effects: * If a callback was previously registered on file, remove it. * *---------------------------------------------------------------------- */ static void DeleteFileHandler( int fd) /* Stream id for which to remove callback * procedure. */ { FileHandler *filePtr, *prevPtr; if (!initialized) { InitNotifier(); } TclSetAppContext(NULL); /* * Find the entry for the given file (and return if there isn't one). */ for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ; prevPtr = filePtr, filePtr = filePtr->nextPtr) { if (filePtr == NULL) { return; } if (filePtr->fd == fd) { break; } } /* * Clean up information in the callback record. */ if (prevPtr == NULL) { notifier.firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } if (filePtr->mask & TCL_READABLE) { XtRemoveInput(filePtr->read); } if (filePtr->mask & TCL_WRITABLE) { XtRemoveInput(filePtr->write); } if (filePtr->mask & TCL_EXCEPTION) { XtRemoveInput(filePtr->except); } ckfree(filePtr); } /* *---------------------------------------------------------------------- * * FileProc -- * * These procedures are called by Xt when a file becomes readable, * writable, or has an exception. * * Results: * None. * * Side effects: * Makes an entry on the Tcl event queue if the event is interesting. * *---------------------------------------------------------------------- */ static void FileProc( XtPointer clientData, int *fd, XtInputId *id) { FileHandler *filePtr = (FileHandler *)clientData; FileHandlerEvent *fileEvPtr; int mask = 0; /* * Determine which event happened. */ if (*id == filePtr->read) { mask = TCL_READABLE; } else if (*id == filePtr->write) { mask = TCL_WRITABLE; } else if (*id == filePtr->except) { mask = TCL_EXCEPTION; } /* * Ignore unwanted or duplicate events. */ if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) { return; } /* * This is an interesting event, so put it onto the event queue. */ filePtr->readyMask |= mask; fileEvPtr = ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); /* * Process events on the Tcl event queue before returning to Xt. */ Tcl_ServiceAll(); } /* *---------------------------------------------------------------------- * * FileHandlerEventProc -- * * This procedure is called by Tcl_ServiceEvent when a file event reaches * the front of the event queue. This procedure is responsible for * actually handling the event by invoking the callback for the file * handler. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the file handler's callback procedure does. * *---------------------------------------------------------------------- */ static int FileHandlerEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { FileHandler *filePtr; FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr; int mask; if (!(flags & TCL_FILE_EVENTS)) { return 0; } /* * Search through the file handlers to find the one whose handle matches * the event. We do this rather than keeping a pointer to the file handler * directly in the event, so that the handler can be deleted while the * event is queued without leaving a dangling pointer. */ for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd != fileEvPtr->fd) { continue; } /* * The code is tricky for two reasons: * 1. The file handler's desired events could have changed since the * time when the event was queued, so AND the ready mask with the * desired mask. * 2. The file could have been closed and re-opened since the time * when the event was queued. This is why the ready mask is stored * in the file handler rather than the queued event: it will be * zeroed when a new file handler is created for the newly opened * file. */ mask = filePtr->readyMask & filePtr->mask; filePtr->readyMask = 0; if (mask != 0) { filePtr->proc(filePtr->clientData, mask); } break; } return 1; } /* *---------------------------------------------------------------------- * * WaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on * the message queue. If the block time is 0, then Tcl_WaitForEvent just * polls without blocking. * * Results: * Returns 1 if an event was found, else 0. This ensures that * Tcl_DoOneEvent will return 1, even if the event is handled by non-Tcl * code. * * Side effects: * Queues file events that are detected by the select. * *---------------------------------------------------------------------- */ static int WaitForEvent( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { int timeout; if (!initialized) { InitNotifier(); } TclSetAppContext(NULL); if (timePtr) { timeout = timePtr->sec * 1000 + timePtr->usec / 1000; if (timeout == 0) { if (XtAppPending(notifier.appContext)) { goto process; } else { return 0; } } else { Tcl_SetTimer(timePtr); } } process: XtAppProcessEvent(notifier.appContext, XtIMAll); return 1; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/unix/tclXtTest.c0000644000175000017500000000622314554262142014732 0ustar sergeisergei/* * tclXtTest.c -- * * Contains commands for Xt notifier specific tests on Unix. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include #include "tcl.h" static Tcl_ObjCmdProc TesteventloopCmd; /* * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: */ extern void InitNotifier(void); extern XtAppContext TclSetAppContext(XtAppContext ctx); /* *---------------------------------------------------------------------- * * Tclxttest_Init -- * * This procedure performs application-specific initialization. Most * applications, especially those that incorporate additional packages, * will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error message in * the interp's result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ DLLEXPORT int Tclxttest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } XtToolkitInitialize(); InitNotifier(); Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TesteventloopCmd -- * * This procedure implements the "testeventloop" command. It is used to * test the Tcl notifier from an "external" event loop (i.e. not * Tcl_DoOneEvent()). * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TesteventloopCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static int *framePtr = NULL;/* Pointer to integer on stack frame of * innermost invocation of the "wait" * subcommand. */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ..."); return TCL_ERROR; } if (strcmp(Tcl_GetString(objv[1]), "done") == 0) { *framePtr = 1; } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { int *oldFramePtr; int done; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); /* * Save the old stack frame pointer and set up the current frame. */ oldFramePtr = framePtr; framePtr = &done; /* * Enter an Xt event loop until the flag changes. Note that we do not * explicitly call Tcl_ServiceEvent(). */ done = 0; while (!done) { XtAppProcessEvent(TclSetAppContext(NULL), XtIMAll); } (void) Tcl_SetServiceMode(oldMode); framePtr = oldFramePtr; } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be done or wait", NULL); return TCL_ERROR; } return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ tcl8.6.14/unix/Makefile.in0000644000175000017500000023762714563210117014706 0ustar sergeisergei# # This file is a Makefile for Tcl. If it has the name "Makefile.in" then it is # a template for a Makefile; to generate the actual Makefile, run # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ MINOR_VERSION = @TCL_MINOR_VERSION@ PATCH_LEVEL = @TCL_PATCH_LEVEL@ #-------------------------------------------------------------------------- # Things you can change to personalize the Makefile for your own site (you can # make these changes in either Makefile.in or Makefile, but changes to # Makefile will get lost if you re-run the configuration script). #-------------------------------------------------------------------------- # Default top-level directories in which to install architecture-specific # files (exec_prefix) and machine-independent files such as scripts (prefix). # The values specified here may be overridden at configure-time with the # --exec-prefix and --prefix options to the "configure" script. The *dir vars # are standard configure substitutions that are based off prefix and # exec_prefix. prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS # with replication. It allows the pathnames used for installation to be # different than those used for actually reference files at run-time. # INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. INSTALL_ROOT = $(DESTDIR) # Path for the platform independent Tcl scripting libraries: TCL_LIBRARY = @TCL_LIBRARY@ # Path to use at runtime to refer to LIB_INSTALL_DIR: LIB_RUNTIME_DIR = $(libdir) # Directory in which to install the program tclsh: BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir) # Directory in which to install libtcl.so or libtcl.a: LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) DLL_INSTALL_DIR = @DLL_INSTALL_DIR@ # Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) # Path name to use when installing Tcl modules. MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Path to the private tcl header dir: PRIVATE_INCLUDE_DIR = @PRIVATE_INCLUDE_DIR@ # Directory in which to (optionally) install the private tcl headers: PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(PRIVATE_INCLUDE_DIR) # Top-level directory in which to install manual entries: MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir) # Directory in which to install manual entry for tclsh: MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 # Directory in which to install manual entries for Tcl's C library procedures: MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 # Directory in which to install manual entries for the built-in Tcl commands: MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann # Path to the html documentation dir: HTML_DIR = @HTML_DIR@ # Directory in which to install html documentation: HTML_INSTALL_DIR = $(INSTALL_ROOT)$(HTML_DIR) # Directory in which to install the configuration file tclConfig.sh CONFIG_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) # Directory in which to install bundled packages: PACKAGE_DIR = @PACKAGE_DIR@ # Package search path. TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@ # Tcl Module default path roots (TIP189). TCL_MODULE_PATH = @TCL_MODULE_PATH@ # warning flags CFLAGS_WARNING = @CFLAGS_WARNING@ # The default switches for optimization or debugging CFLAGS_DEBUG = @CFLAGS_DEBUG@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ # Flags to pass to the linker LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ # If you use the setenv, putenv, or unsetenv procedures to modify environment # variables in your application and you'd like those modifications to appear # in the "env" Tcl variable, switch the comments on the two lines below so # that Tcl provides these procedures instead of your standard C library. ENV_FLAGS = #ENV_FLAGS = -DTclSetEnv=setenv -DTcl_PutEnv=putenv -DTclUnsetEnv=unsetenv # To enable memory debugging, call configure with --enable-symbols=mem # Warning: if you enable memory debugging, you must do it *everywhere*, # including all the code that calls Tcl, and you must use ckalloc and ckfree # everywhere instead of malloc and free. TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ #TCL_STUB_LIB_FILE = libtclstub.a # Generic stub lib name used in rules that apply to tcl and tk STUB_LIB_FILE = ${TCL_STUB_LIB_FILE} TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@ #TCL_STUB_LIB_FLAG = -ltclstub # To compile without backward compatibility and deprecated code uncomment the # following NO_DEPRECATED_FLAGS = #NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED # Some versions of make, like SGI's, use the following variable to determine # which shell to use for executing commands: SHELL = @MAKEFILE_SHELL@ # Tcl used to let the configure script choose which program to use for # installing, but there are just too many different versions of "install" # around; better to use the install-sh script that comes with the # distribution, which is slower but guaranteed to work. INSTALL_STRIP_PROGRAM = strip INSTALL_STRIP_LIBRARY = strip -x INSTALL = $(SHELL) $(UNIX_DIR)/install-sh -c INSTALL_PROGRAM = ${INSTALL} INSTALL_LIBRARY = ${INSTALL} INSTALL_DATA = ${INSTALL} -m 644 INSTALL_DATA_DIR = ${INSTALL} -d -m 755 # NATIVE_TCLSH is the name of a tclsh executable that is available *BEFORE* # running make for the first time. Certain build targets (make genstubs) need # it to be available on the PATH. This executable should *NOT* be required # just to do a normal build although it can be required to run make dist. # Do not use SHELL_ENV for NATIVE_TCLSH unless it is the tclsh being built. EXE_SUFFIX = @EXEEXT@ TCL_EXE = tclsh${EXE_SUFFIX} TCLTEST_EXE = tcltest${EXE_SUFFIX} NATIVE_TCLSH = @TCLSH_PROG@ # The symbols below provide support for dynamic loading and shared libraries. # See configure.in for a description of what the symbols mean. The values of # the symbols are normally set by the configure script. You shouldn't normally # need to modify any of these definitions by hand. STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ -DBUILD_tcl SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ SHLIB_LD_FLAGS = @SHLIB_LD_FLAGS@ TCL_SHLIB_LD_EXTRAS = @TCL_SHLIB_LD_EXTRAS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ DLTEST_TARGETS = dltest.marker # Additional search flags needed to find the various shared libraries at # run-time. The first symbol is for use when creating a binary with cc, and # the second is for use when running ld directly. CC_SEARCH_FLAGS = @CC_SEARCH_FLAGS@ LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@ # The following symbol is defined to "$(DLTEST_TARGETS)" if dynamic loading is # available; this causes everything in the "dltest" subdirectory to be built # when making "tcltest. If dynamic loading isn't available, configure defines # this symbol to an empty string, in which case the shared libraries aren't # built. BUILD_DLTEST = @BUILD_DLTEST@ #BUILD_DLTEST = TCL_LIB_FILE = @TCL_LIB_FILE@ #TCL_LIB_FILE = libtcl.a # Generic lib name used in rules that apply to tcl and tk LIB_FILE = ${TCL_LIB_FILE} TCL_LIB_FLAG = @TCL_LIB_FLAG@ #TCL_LIB_FLAG = -ltcl # support for embedded libraries on Darwin / Mac OS X DYLIB_INSTALL_DIR = $(libdir) #-------------------------------------------------------------------------- # The information below is modified by the configure script when Makefile is # generated from Makefile.in. You shouldn't normally modify any of this stuff # by hand. #-------------------------------------------------------------------------- COMPAT_OBJS = @LIBOBJS@ AC_FLAGS = @DEFS@ AR = @AR@ RANLIB = @RANLIB@ DTRACE = @DTRACE@ SRC_DIR = @srcdir@ TOP_DIR = @TCL_SRC_DIR@ BUILD_DIR = @builddir@ GENERIC_DIR = $(TOP_DIR)/generic COMPAT_DIR = $(TOP_DIR)/compat TOOL_DIR = $(TOP_DIR)/tools UNIX_DIR = $(TOP_DIR)/unix MAC_OSX_DIR = $(TOP_DIR)/macosx PKGS_DIR = $(TOP_DIR)/pkgs # Must be absolute because of the cd dltest $(DLTEST_DIR)/configure below. DLTEST_DIR = @TCL_SRC_DIR@/unix/dltest # Must be absolute to so the corresponding tcltest's tcl_library is absolute. TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library ZLIB_DIR = ${COMPAT_DIR}/zlib ZLIB_INCLUDE = @ZLIB_INCLUDE@ TOMMATH_DIR = $(TOP_DIR)/libtommath CC = @CC@ OBJEXT = @OBJEXT@ #CC = purify -best-effort @CC@ -DPURIFY # Flags to be passed to installManPage to control how the manpages should be # installed (symlinks, compression, package name suffix). MAN_FLAGS = @MAN_FLAGS@ # If non-empty, install the timezone files that are included with Tcl, # otherwise use the ones that ship with the OS. INSTALL_TZDATA = @INSTALL_TZDATA@ #-------------------------------------------------------------------------- # The information below is usually usable as is. The configure script won't # modify it and it only exists to make working around selected rare system # configurations easier. #-------------------------------------------------------------------------- GDB = gdb LLDB = lldb TRACE = strace TRACE_OPTS = VALGRIND = valgrind VALGRINDARGS = --tool=memcheck --num-callers=24 \ --leak-resolution=high --leak-check=yes --show-reachable=yes -v \ --keep-debuginfo=yes \ --suppressions=$(TOOL_DIR)/valgrind_suppress shquotequote = $(subst ",\",$(subst ',\',$(1))) shquotesingle = $(subst ','\'',$(1)) #-------------------------------------------------------------------------- # The information below should be usable as is. The configure script won't # modify it and you shouldn't need to modify it either. #-------------------------------------------------------------------------- STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \ ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ ${AC_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \ @EXTRA_CC_SWITCHES@ CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@ LIBS = @TCL_LIBS@ DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ ${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ TCLSH_OBJS = tclAppInit.o TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \ tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \ tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \ tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \ tclEncoding.o tclEnsemble.o \ tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \ tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \ tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \ tclLink.o tclListObj.o \ tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \ tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \ tclPkg.o tclPkgConfig.o tclPosixStr.o \ tclPreserve.o tclProc.o tclRegexp.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ tclTomMathInterface.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ tclOOMethod.o tclOOStubInit.o TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.o \ bn_s_mp_sqr_fast.o bn_mp_add.o bn_mp_and.o \ bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \ bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ bn_mp_cnt_lsb.o bn_mp_copy.o \ bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \ bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o bn_mp_expt_u32.o \ bn_mp_grow.o bn_mp_init.o \ bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \ bn_mp_init_size.o bn_s_mp_karatsuba_mul.o \ bn_s_mp_karatsuba_sqr.o bn_s_mp_balance_mul.o \ bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \ bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o \ bn_mp_pack_count.o bn_mp_radix_size.o bn_mp_radix_smap.o \ bn_mp_read_radix.o bn_mp_rshd.o bn_mp_shrink.o \ bn_mp_set.o \ bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \ bn_mp_signed_rsh.o bn_mp_to_ubin.o bn_mp_unpack.o \ bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o bn_mp_to_radix.o \ bn_mp_ubin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ tclTomMathStubLib.o \ tclOOStubLib.o \ ${COMPAT_OBJS} UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \ tclUnixTime.o tclUnixInit.o tclUnixThrd.o \ tclUnixCompat.o NOTIFY_OBJS = tclUnixNotfy.o MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o CYGWIN_OBJS = tclWinError.o DTRACE_OBJ = tclDTrace.o ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \ Zinffast.o Zinflate.o Zinftrees.o Ztrees.o Zuncompr.o Zzutil.o TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ ${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@ OBJS = ${TCL_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ ${TOMMATH_OBJS} TCL_DECLS = \ $(GENERIC_DIR)/tcl.decls \ $(GENERIC_DIR)/tclInt.decls \ $(GENERIC_DIR)/tclOO.decls \ $(GENERIC_DIR)/tclTomMath.decls GENERIC_HDRS = \ $(GENERIC_DIR)/tcl.h \ $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclInt.h \ $(GENERIC_DIR)/tclIntDecls.h \ $(GENERIC_DIR)/tclIntPlatDecls.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h \ $(GENERIC_DIR)/tclOO.h \ $(GENERIC_DIR)/tclOODecls.h \ $(GENERIC_DIR)/tclOOInt.h \ $(GENERIC_DIR)/tclOOIntDecls.h \ $(GENERIC_DIR)/tclPatch.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclPort.h \ $(GENERIC_DIR)/tclRegexp.h GENERIC_SRCS = \ $(GENERIC_DIR)/regcomp.c \ $(GENERIC_DIR)/regexec.c \ $(GENERIC_DIR)/regfree.c \ $(GENERIC_DIR)/regerror.c \ $(GENERIC_DIR)/tclAlloc.c \ $(GENERIC_DIR)/tclAssembly.c \ $(GENERIC_DIR)/tclAsync.c \ $(GENERIC_DIR)/tclBasic.c \ $(GENERIC_DIR)/tclBinary.c \ $(GENERIC_DIR)/tclCkalloc.c \ $(GENERIC_DIR)/tclClock.c \ $(GENERIC_DIR)/tclCmdAH.c \ $(GENERIC_DIR)/tclCmdIL.c \ $(GENERIC_DIR)/tclCmdMZ.c \ $(GENERIC_DIR)/tclCompCmds.c \ $(GENERIC_DIR)/tclCompCmdsGR.c \ $(GENERIC_DIR)/tclCompCmdsSZ.c \ $(GENERIC_DIR)/tclCompExpr.c \ $(GENERIC_DIR)/tclCompile.c \ $(GENERIC_DIR)/tclConfig.c \ $(GENERIC_DIR)/tclDate.c \ $(GENERIC_DIR)/tclDictObj.c \ $(GENERIC_DIR)/tclDisassemble.c \ $(GENERIC_DIR)/tclEncoding.c \ $(GENERIC_DIR)/tclEnsemble.c \ $(GENERIC_DIR)/tclEnv.c \ $(GENERIC_DIR)/tclEvent.c \ $(GENERIC_DIR)/tclExecute.c \ $(GENERIC_DIR)/tclFCmd.c \ $(GENERIC_DIR)/tclFileName.c \ $(GENERIC_DIR)/tclGet.c \ $(GENERIC_DIR)/tclHash.c \ $(GENERIC_DIR)/tclHistory.c \ $(GENERIC_DIR)/tclIndexObj.c \ $(GENERIC_DIR)/tclInterp.c \ $(GENERIC_DIR)/tclIO.c \ $(GENERIC_DIR)/tclIOCmd.c \ $(GENERIC_DIR)/tclIOGT.c \ $(GENERIC_DIR)/tclIOSock.c \ $(GENERIC_DIR)/tclIOUtil.c \ $(GENERIC_DIR)/tclIORChan.c \ $(GENERIC_DIR)/tclIORTrans.c \ $(GENERIC_DIR)/tclLink.c \ $(GENERIC_DIR)/tclListObj.c \ $(GENERIC_DIR)/tclLiteral.c \ $(GENERIC_DIR)/tclLoad.c \ $(GENERIC_DIR)/tclMain.c \ $(GENERIC_DIR)/tclNamesp.c \ $(GENERIC_DIR)/tclNotify.c \ $(GENERIC_DIR)/tclObj.c \ $(GENERIC_DIR)/tclOptimize.c \ $(GENERIC_DIR)/tclParse.c \ $(GENERIC_DIR)/tclPathObj.c \ $(GENERIC_DIR)/tclPipe.c \ $(GENERIC_DIR)/tclPkg.c \ $(GENERIC_DIR)/tclPkgConfig.c \ $(GENERIC_DIR)/tclPosixStr.c \ $(GENERIC_DIR)/tclPreserve.c \ $(GENERIC_DIR)/tclProc.c \ $(GENERIC_DIR)/tclRegexp.c \ $(GENERIC_DIR)/tclResolve.c \ $(GENERIC_DIR)/tclResult.c \ $(GENERIC_DIR)/tclScan.c \ $(GENERIC_DIR)/tclStubInit.c \ $(GENERIC_DIR)/tclStringObj.c \ $(GENERIC_DIR)/tclStrToD.c \ $(GENERIC_DIR)/tclTest.c \ $(GENERIC_DIR)/tclTestObj.c \ $(GENERIC_DIR)/tclTestProcBodyObj.c \ $(GENERIC_DIR)/tclThread.c \ $(GENERIC_DIR)/tclThreadAlloc.c \ $(GENERIC_DIR)/tclThreadJoin.c \ $(GENERIC_DIR)/tclThreadStorage.c \ $(GENERIC_DIR)/tclTimer.c \ $(GENERIC_DIR)/tclTrace.c \ $(GENERIC_DIR)/tclUtil.c \ $(GENERIC_DIR)/tclVar.c \ $(GENERIC_DIR)/tclAssembly.c \ $(GENERIC_DIR)/tclZlib.c OO_SRCS = \ $(GENERIC_DIR)/tclOO.c \ $(GENERIC_DIR)/tclOOBasic.c \ $(GENERIC_DIR)/tclOOCall.c \ $(GENERIC_DIR)/tclOODefineCmds.c \ $(GENERIC_DIR)/tclOOInfo.c \ $(GENERIC_DIR)/tclOOMethod.c \ $(GENERIC_DIR)/tclOOStubInit.c STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c TOMMATH_SRCS = \ $(TOMMATH_DIR)/bn_cutoffs.c \ $(TOMMATH_DIR)/bn_deprecated.c \ $(TOMMATH_DIR)/bn_mp_2expt.c \ $(TOMMATH_DIR)/bn_mp_abs.c \ $(TOMMATH_DIR)/bn_mp_add.c \ $(TOMMATH_DIR)/bn_mp_add_d.c \ $(TOMMATH_DIR)/bn_mp_addmod.c \ $(TOMMATH_DIR)/bn_mp_and.c \ $(TOMMATH_DIR)/bn_mp_clamp.c \ $(TOMMATH_DIR)/bn_mp_clear.c \ $(TOMMATH_DIR)/bn_mp_clear_multi.c \ $(TOMMATH_DIR)/bn_mp_cmp.c \ $(TOMMATH_DIR)/bn_mp_cmp_d.c \ $(TOMMATH_DIR)/bn_mp_cmp_mag.c \ $(TOMMATH_DIR)/bn_mp_cnt_lsb.c \ $(TOMMATH_DIR)/bn_mp_complement.c \ $(TOMMATH_DIR)/bn_mp_copy.c \ $(TOMMATH_DIR)/bn_mp_count_bits.c \ $(TOMMATH_DIR)/bn_mp_decr.c \ $(TOMMATH_DIR)/bn_mp_div.c \ $(TOMMATH_DIR)/bn_mp_div_2.c \ $(TOMMATH_DIR)/bn_mp_div_2d.c \ $(TOMMATH_DIR)/bn_mp_div_3.c \ $(TOMMATH_DIR)/bn_mp_div_d.c \ $(TOMMATH_DIR)/bn_mp_dr_is_modulus.c \ $(TOMMATH_DIR)/bn_mp_dr_reduce.c \ $(TOMMATH_DIR)/bn_mp_dr_setup.c \ $(TOMMATH_DIR)/bn_mp_error_to_string.c \ $(TOMMATH_DIR)/bn_mp_exch.c \ $(TOMMATH_DIR)/bn_mp_expt_u32.c \ $(TOMMATH_DIR)/bn_mp_exptmod.c \ $(TOMMATH_DIR)/bn_mp_exteuclid.c \ $(TOMMATH_DIR)/bn_mp_fread.c \ $(TOMMATH_DIR)/bn_mp_from_sbin.c \ $(TOMMATH_DIR)/bn_mp_from_ubin.c \ $(TOMMATH_DIR)/bn_mp_fwrite.c \ $(TOMMATH_DIR)/bn_mp_gcd.c \ $(TOMMATH_DIR)/bn_mp_get_double.c \ $(TOMMATH_DIR)/bn_mp_get_i32.c \ $(TOMMATH_DIR)/bn_mp_get_i64.c \ $(TOMMATH_DIR)/bn_mp_get_l.c \ $(TOMMATH_DIR)/bn_mp_get_ll.c \ $(TOMMATH_DIR)/bn_mp_get_mag_u32.c \ $(TOMMATH_DIR)/bn_mp_get_mag_u64.c \ $(TOMMATH_DIR)/bn_mp_get_mag_ul.c \ $(TOMMATH_DIR)/bn_mp_get_mag_ull.c \ $(TOMMATH_DIR)/bn_mp_grow.c \ $(TOMMATH_DIR)/bn_mp_incr.c \ $(TOMMATH_DIR)/bn_mp_init.c \ $(TOMMATH_DIR)/bn_mp_init_copy.c \ $(TOMMATH_DIR)/bn_mp_init_i32.c \ $(TOMMATH_DIR)/bn_mp_init_i64.c \ $(TOMMATH_DIR)/bn_mp_init_l.c \ $(TOMMATH_DIR)/bn_mp_init_ll.c \ $(TOMMATH_DIR)/bn_mp_init_multi.c \ $(TOMMATH_DIR)/bn_mp_init_set.c \ $(TOMMATH_DIR)/bn_mp_init_size.c \ $(TOMMATH_DIR)/bn_mp_init_u32.c \ $(TOMMATH_DIR)/bn_mp_init_u64.c \ $(TOMMATH_DIR)/bn_mp_init_ul.c \ $(TOMMATH_DIR)/bn_mp_init_ull.c \ $(TOMMATH_DIR)/bn_mp_invmod.c \ $(TOMMATH_DIR)/bn_mp_is_square.c \ $(TOMMATH_DIR)/bn_mp_iseven.c \ $(TOMMATH_DIR)/bn_mp_isodd.c \ $(TOMMATH_DIR)/bn_mp_kronecker.c \ $(TOMMATH_DIR)/bn_mp_lcm.c \ $(TOMMATH_DIR)/bn_mp_log_u32.c \ $(TOMMATH_DIR)/bn_mp_lshd.c \ $(TOMMATH_DIR)/bn_mp_mod.c \ $(TOMMATH_DIR)/bn_mp_mod_2d.c \ $(TOMMATH_DIR)/bn_mp_mod_d.c \ $(TOMMATH_DIR)/bn_mp_montgomery_calc_normalization.c \ $(TOMMATH_DIR)/bn_mp_montgomery_reduce.c \ $(TOMMATH_DIR)/bn_mp_montgomery_setup.c \ $(TOMMATH_DIR)/bn_mp_mul.c \ $(TOMMATH_DIR)/bn_mp_mul_2.c \ $(TOMMATH_DIR)/bn_mp_mul_2d.c \ $(TOMMATH_DIR)/bn_mp_mul_d.c \ $(TOMMATH_DIR)/bn_mp_mulmod.c \ $(TOMMATH_DIR)/bn_mp_neg.c \ $(TOMMATH_DIR)/bn_mp_or.c \ $(TOMMATH_DIR)/bn_mp_pack.c \ $(TOMMATH_DIR)/bn_mp_pack_count.c \ $(TOMMATH_DIR)/bn_mp_prime_fermat.c \ $(TOMMATH_DIR)/bn_mp_prime_frobenius_underwood.c \ $(TOMMATH_DIR)/bn_mp_prime_is_prime.c \ $(TOMMATH_DIR)/bn_mp_prime_miller_rabin.c \ $(TOMMATH_DIR)/bn_mp_prime_next_prime.c \ $(TOMMATH_DIR)/bn_mp_prime_rabin_miller_trials.c \ $(TOMMATH_DIR)/bn_mp_prime_rand.c \ $(TOMMATH_DIR)/bn_mp_prime_strong_lucas_selfridge.c \ $(TOMMATH_DIR)/bn_mp_radix_size.c \ $(TOMMATH_DIR)/bn_mp_radix_smap.c \ $(TOMMATH_DIR)/bn_mp_rand.c \ $(TOMMATH_DIR)/bn_mp_read_radix.c \ $(TOMMATH_DIR)/bn_mp_reduce.c \ $(TOMMATH_DIR)/bn_mp_reduce_2k.c \ $(TOMMATH_DIR)/bn_mp_reduce_2k_l.c \ $(TOMMATH_DIR)/bn_mp_reduce_2k_setup.c \ $(TOMMATH_DIR)/bn_mp_reduce_2k_setup_l.c \ $(TOMMATH_DIR)/bn_mp_reduce_is_2k.c \ $(TOMMATH_DIR)/bn_mp_reduce_is_2k_l.c \ $(TOMMATH_DIR)/bn_mp_reduce_setup.c \ $(TOMMATH_DIR)/bn_mp_root_u32.c \ $(TOMMATH_DIR)/bn_mp_rshd.c \ $(TOMMATH_DIR)/bn_mp_sbin_size.c \ $(TOMMATH_DIR)/bn_mp_set.c \ $(TOMMATH_DIR)/bn_mp_set_double.c \ $(TOMMATH_DIR)/bn_mp_set_i32.c \ $(TOMMATH_DIR)/bn_mp_set_i64.c \ $(TOMMATH_DIR)/bn_mp_set_l.c \ $(TOMMATH_DIR)/bn_mp_set_ll.c \ $(TOMMATH_DIR)/bn_mp_set_u32.c \ $(TOMMATH_DIR)/bn_mp_set_u64.c \ $(TOMMATH_DIR)/bn_mp_set_ul.c \ $(TOMMATH_DIR)/bn_mp_set_ull.c \ $(TOMMATH_DIR)/bn_mp_shrink.c \ $(TOMMATH_DIR)/bn_mp_signed_rsh.c \ $(TOMMATH_DIR)/bn_mp_sqr.c \ $(TOMMATH_DIR)/bn_mp_sqrmod.c \ $(TOMMATH_DIR)/bn_mp_sqrt.c \ $(TOMMATH_DIR)/bn_mp_sqrtmod_prime.c \ $(TOMMATH_DIR)/bn_mp_sub.c \ $(TOMMATH_DIR)/bn_mp_sub_d.c \ $(TOMMATH_DIR)/bn_mp_submod.c \ $(TOMMATH_DIR)/bn_mp_to_radix.c \ $(TOMMATH_DIR)/bn_mp_to_sbin.c \ $(TOMMATH_DIR)/bn_mp_to_ubin.c \ $(TOMMATH_DIR)/bn_mp_ubin_size.c \ $(TOMMATH_DIR)/bn_mp_unpack.c \ $(TOMMATH_DIR)/bn_mp_xor.c \ $(TOMMATH_DIR)/bn_mp_zero.c \ $(TOMMATH_DIR)/bn_prime_tab.c \ $(TOMMATH_DIR)/bn_s_mp_add.c \ $(TOMMATH_DIR)/bn_s_mp_balance_mul.c \ $(TOMMATH_DIR)/bn_s_mp_exptmod.c \ $(TOMMATH_DIR)/bn_s_mp_exptmod_fast.c \ $(TOMMATH_DIR)/bn_s_mp_get_bit.c \ $(TOMMATH_DIR)/bn_s_mp_invmod_fast.c \ $(TOMMATH_DIR)/bn_s_mp_invmod_slow.c \ $(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c \ $(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c \ $(TOMMATH_DIR)/bn_s_mp_montgomery_reduce_fast.c \ $(TOMMATH_DIR)/bn_s_mp_mul_digs.c \ $(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c \ $(TOMMATH_DIR)/bn_s_mp_mul_high_digs.c \ $(TOMMATH_DIR)/bn_s_mp_mul_high_digs_fast.c \ $(TOMMATH_DIR)/bn_s_mp_prime_is_divisible.c \ $(TOMMATH_DIR)/bn_s_mp_rand_jenkins.c \ $(TOMMATH_DIR)/bn_s_mp_rand_platform.c \ $(TOMMATH_DIR)/bn_s_mp_reverse.c \ $(TOMMATH_DIR)/bn_s_mp_sqr.c \ $(TOMMATH_DIR)/bn_s_mp_sqr_fast.c \ $(TOMMATH_DIR)/bn_s_mp_sub.c \ $(TOMMATH_DIR)/bn_s_mp_toom_mul.c \ $(TOMMATH_DIR)/bn_s_mp_toom_sqr.c UNIX_HDRS = \ $(UNIX_DIR)/tclUnixPort.h # $(UNIX_DIR)/tclConfig.h UNIX_SRCS = \ $(UNIX_DIR)/tclAppInit.c \ $(UNIX_DIR)/tclUnixChan.c \ $(UNIX_DIR)/tclUnixEvent.c \ $(UNIX_DIR)/tclUnixFCmd.c \ $(UNIX_DIR)/tclUnixFile.c \ $(UNIX_DIR)/tclUnixPipe.c \ $(UNIX_DIR)/tclUnixSock.c \ $(UNIX_DIR)/tclUnixTest.c \ $(UNIX_DIR)/tclUnixThrd.c \ $(UNIX_DIR)/tclUnixTime.c \ $(UNIX_DIR)/tclUnixInit.c \ $(UNIX_DIR)/tclUnixCompat.c NOTIFY_SRCS = \ $(UNIX_DIR)/tclUnixNotfy.c DL_SRCS = \ $(UNIX_DIR)/tclLoadAix.c \ $(UNIX_DIR)/tclLoadDl.c \ $(UNIX_DIR)/tclLoadDl2.c \ $(UNIX_DIR)/tclLoadDld.c \ $(UNIX_DIR)/tclLoadDyld.c \ $(GENERIC_DIR)/tclLoadNone.c \ $(UNIX_DIR)/tclLoadOSF.c \ $(UNIX_DIR)/tclLoadShl.c MAC_OSX_SRCS = \ $(MAC_OSX_DIR)/tclMacOSXBundle.c \ $(MAC_OSX_DIR)/tclMacOSXFCmd.c \ $(MAC_OSX_DIR)/tclMacOSXNotify.c CYGWIN_SRCS = \ $(TOP_DIR)/win/tclWinError.c DTRACE_HDR = tclDTrace.h DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d ZLIB_SRCS = \ $(ZLIB_DIR)/adler32.c \ $(ZLIB_DIR)/compress.c \ $(ZLIB_DIR)/crc32.c \ $(ZLIB_DIR)/deflate.c \ $(ZLIB_DIR)/infback.c \ $(ZLIB_DIR)/inffast.c \ $(ZLIB_DIR)/inflate.c \ $(ZLIB_DIR)/inftrees.c \ $(ZLIB_DIR)/trees.c \ $(ZLIB_DIR)/uncompr.c \ $(ZLIB_DIR)/zutil.c # Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those files # won't compile on the current machine, and they will cause problems for # things like "make depend". SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ $(TOMMATH_SRCS) #-------------------------------------------------------------------------- # Start of rules #-------------------------------------------------------------------------- all: binaries libraries doc packages binaries: ${LIB_FILE} ${TCL_EXE} libraries: doc: # The following target is configured by autoconf to generate either a shared # library or non-shared library for Tcl. ${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} rm -f $@ @MAKE_LIB@ ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} @if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \ (cd ${TOP_DIR}/win; ${MAKE} winextensions); \ fi rm -f $@ @MAKE_STUB_LIB@ # Make target which outputs the list of the .o contained in the Tcl lib useful # to build a single big shared library containing Tcl and other extensions. # Used for the Tcl Plugin. -- dl # The dependency on OBJS is not there because we just want the list of objects # here, not actually building them tclLibObjs: @echo ${OBJS} # This targets actually build the objects needed for the lib in the above case objs: ${OBJS} ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \ @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCL_EXE} # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above ${NATIVE_TCLSH}: Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status #tclConfig.h: $(UNIX_DIR)/tclConfig.h.in # $(SHELL) config.status clean: clean-packages rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ minizip${HOST_EXEEXT} *.${HOST_OBJEXT} *.zip *.vfs (cd dltest ; $(MAKE) clean) distclean: distclean-packages clean rm -rf Makefile config.status config.cache config.log tclConfig.sh \ tclConfig.h *.plist Tcl.framework tcl.pc tclUuid.h (cd dltest ; $(MAKE) distclean) depend: makedepend -- $(DEPEND_SWITCHES) -- $(SRCS) #-------------------------------------------------------------------------- # The following target outputs the name of the top-level source directory for # Tcl (it is used by Tk's configure script, for example). The .NO_PARALLEL # line is needed to avoid problems under Sun's "pmake". Note: this target is # now obsolete (use the autoconf variable TCL_SRC_DIR from tclConfig.sh # instead). #-------------------------------------------------------------------------- .NO_PARALLEL: topDirName topDirName: @cd $(TOP_DIR); pwd #-------------------------------------------------------------------------- # Rules for testing #-------------------------------------------------------------------------- # Resetting the LIB_RUNTIME_DIR below is required so that the generated # tcltest executable gets the build directory burned into its ld search path. # This keeps tcltest from picking up an already installed version of the Tcl # library. SHELL_ENV = @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@} \ TCLLIBPATH="@abs_builddir@/pkgs" \ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}" ${TCLTEST_EXE}: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST} $(MAKE) tcltest-real LIB_RUNTIME_DIR="`pwd`" tcltest-real: ${CC} ${CFLAGS} ${LDFLAGS} ${TCLTEST_OBJS} \ @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLTEST_EXE} # Note, in the targets below TCL_LIBRARY needs to be set or else "make test" # won't work in the case where the compilation directory isn't the same as the # source directory. # # Specifying TESTFLAGS on the command line is the standard way to pass args to # tcltest, ie: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: test-tcl test-packages test-tcl: ${TCLTEST_EXE} $(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) gdb-test: ${TCLTEST_EXE} @printf '%s ' set env @LD_LIBRARY_PATH_VAR@=\"`pwd`$${@LD_LIBRARY_PATH_VAR@:+:$${@LD_LIBRARY_PATH_VAR}}\" > gdb.run @printf '\n' >>gdb.run @printf '%s ' set env TCL_LIBRARY=\'$(call shquotesingle,${TCL_BUILDTIME_LIBRARY})\' >> gdb.run @printf '\n' >>gdb.run @printf '%s ' set args $(call shquotequote,$(TOP_DIR))/tests/all.tcl\ $(call shquotequote,$(TESTFLAGS)) -singleproc 1 >> gdb.run $(GDB) ./${TCLTEST_EXE} --command=gdb.run rm gdb.run # Useful target to launch a built tcltest with the proper path,... runtest: ${TCLTEST_EXE} $(SHELL_ENV) ./${TCLTEST_EXE} # Useful target for running the test suite with an unwritable current # directory... ro-test: ${TCLTEST_EXE} echo 'exec chmod -w .;package require tcltest;tcltest::temporaryDirectory /tmp;source ../tests/all.tcl;exec chmod +w .' | $(SHELL_ENV) ./${TCLTEST_EXE} # The following target generates the shared libraries in dltest/ that are used # for testing; they are included as part of the "tcltest" target (via the # BUILD_DLTEST variable) if dynamic loading is supported on this platform. The # Makefile in the dltest subdirectory creates the dltest.marker file in this # directory after a successful build. dltest.marker: ${STUB_LIB_FILE} cd dltest ; $(MAKE) #-------------------------------------------------------------------------- # Rules for running a shell before installation #-------------------------------------------------------------------------- # This target can be used to run tclsh from the build directory # via `make shell SCRIPT=/tmp/foo.tcl` shell: ${TCL_EXE} $(SHELL_ENV) ./${TCL_EXE} $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: ${TCL_EXE} $(SHELL_ENV) $(GDB) ./${TCL_EXE} lldb: ${TCL_EXE} $(SHELL_ENV) $(LLDB) ./${TCL_EXE} valgrind: ${TCL_EXE} ${TCLTEST_EXE} $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \ $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \ $(TESTFLAGS) valgrindshell: ${TCL_EXE} $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT) trace-shell: ${TCL_EXE} $(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCL_EXE} $(SCRIPT) trace-test: ${TCLTEST_EXE} $(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS) #-------------------------------------------------------------------------- # Installation rules #-------------------------------------------------------------------------- INSTALL_BASE_TARGETS = install-binaries install-libraries install-msgs $(INSTALL_TZDATA) INSTALL_DOC_TARGETS = install-doc INSTALL_PACKAGE_TARGETS = install-packages INSTALL_DEV_TARGETS = install-headers INSTALL_EXTRA_TARGETS = @EXTRA_INSTALL@ INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \ $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS) install: $(INSTALL_TARGETS) install-strip: $(MAKE) $(INSTALL_TARGETS) \ INSTALL_PROGRAM="STRIPPROG='${INSTALL_STRIP_PROGRAM}' $(INSTALL_PROGRAM) -s" \ INSTALL_LIBRARY="STRIPPROG='${INSTALL_STRIP_LIBRARY}' $(INSTALL_LIBRARY) -s" install-binaries: binaries @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \ "$(CONFIG_INSTALL_DIR)" ; do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done @echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/" @@INSTALL_LIB@ @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" @echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh" @echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) $(UNIX_DIR)/tclooConfig.sh \ "$(CONFIG_INSTALL_DIR)/tclooConfig.sh" @if test "$(STUB_LIB_FILE)" != "" ; then \ echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ @INSTALL_STUB_LIB@ ; \ fi @EXTRA_INSTALL_BINARIES@ @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/" @$(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/pkgconfig" @$(INSTALL_DATA) tcl.pc "$(LIB_INSTALL_DIR)/pkgconfig/tcl.pc" install-libraries: libraries @for i in "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done; @for i in opt0.4 http1.0 encoding; \ do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; @for i in 8.4 8.4/platform 8.5 8.6; \ do \ if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ $(INSTALL_DATA_DIR) "$(MODULE_INSTALL_DIR)/$$i"; \ fi; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/" @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \ $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ done; @echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/" @for i in $(TOP_DIR)/library/http1.0/*.tcl ; \ do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done @echo "Installing package http 2.9.8 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ "$(MODULE_INSTALL_DIR)/8.6/http-2.9.8.tm" @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done @echo "Installing package msgcat 1.6.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)/8.5/msgcat-1.6.1.tm" @echo "Installing package tcltest 2.5.7 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.7.tm" @echo "Installing package platform 1.0.19 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm" @echo "Installing package platform::shell 1.1.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \ "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm" @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/" @for i in $(TOP_DIR)/library/encoding/*.enc; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/encoding"; \ done @if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ] ; then \ echo "Customizing tcl module path"; \ echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \ "$(SCRIPT_INSTALL_DIR)/tm.tcl"; \ fi install-tzdata: @for i in tzdata; do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ fi; \ done @echo "Installing time zone files to $(SCRIPT_INSTALL_DIR)/tzdata/" @for i in $(TOP_DIR)/library/tzdata/*; do \ if [ -d $$i ] ; then \ ii=`basename $$i`; \ if [ ! -d "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii" ] ; then \ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii"; \ fi; \ for j in $$i/*; do \ if [ -d $$j ] ; then \ jj=`basename $$j`; \ if [ ! -d "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii/$$jj" ] ; then \ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii/$$jj"; \ fi; \ for k in $$j/*; do \ $(INSTALL_DATA) $$k "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii/$$jj"; \ done; \ else \ $(INSTALL_DATA) $$j "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii"; \ fi; \ done; \ else \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/tzdata"; \ fi; \ done install-msgs: @for i in msgs; do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ fi; \ done @echo "Installing message catalog files to $(SCRIPT_INSTALL_DIR)/msgs/" @for i in $(TOP_DIR)/library/msgs/*.msg; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/msgs"; \ done install-doc: doc @for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)"; do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done @echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/" @for i in $(TOP_DIR)/doc/*.1; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \ done @echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/" @for i in $(TOP_DIR)/doc/*.3; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \ done @echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/"; @for i in $(TOP_DIR)/doc/*.n; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \ done install-headers: @for i in "$(INCLUDE_INSTALL_DIR)"; do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h ; \ do \ $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \ done # Optional target to install private headers install-private-headers: @for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done @echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/"; @for i in $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \ $(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \ $(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \ $(UNIX_DIR)/tclUnixPort.h; \ do \ $(INSTALL_DATA) $$i "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ done @if test -f tclConfig.h; then\ $(INSTALL_DATA) tclConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ fi #-------------------------------------------------------------------------- # Rules for how to compile C files #-------------------------------------------------------------------------- # Test binaries. The rules for tclTestInit.o and xtTestInit.o are complicated # because they are compiled from tclAppInit.c. Can't use the "-o" option # because this doesn't work on some strange compilers (e.g. UnixWare). # # To enable concurrent parallel make of tclsh and tcltest resp xttest, these # targets have to depend on tclsh, this ensures that linking of tclsh with # tclAppInit.o does not execute concurrently with the renaming and recompiling # of that same object file in the targets below. tclTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE} @if test -f tclAppInit.o ; then \ rm -f tclAppInit.sav; \ mv tclAppInit.o tclAppInit.sav; \ fi $(CC) -c $(APP_CC_SWITCHES) \ -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \ -DTCL_TEST $(UNIX_DIR)/tclAppInit.c @rm -f tclTestInit.o mv tclAppInit.o tclTestInit.o @if test -f tclAppInit.sav ; then \ mv tclAppInit.sav tclAppInit.o; \ fi xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE} @if test -f tclAppInit.o ; then \ rm -f tclAppInit.sav; \ mv tclAppInit.o tclAppInit.sav; \ fi $(CC) -c $(APP_CC_SWITCHES) \ -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \ -DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c @rm -f xtTestInit.o mv tclAppInit.o xtTestInit.o @if test -f tclAppInit.sav ; then \ mv tclAppInit.sav tclAppInit.o; \ fi # Object files used on all Unix systems: REGHDRS = $(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \ $(GENERIC_DIR)/regcustom.h TCLREHDRS = $(GENERIC_DIR)/tclRegexp.h COMPILEHDR = $(GENERIC_DIR)/tclCompile.h FSHDR = $(GENERIC_DIR)/tclFileSystem.h IOHDR = $(GENERIC_DIR)/tclIO.h MATHHDRS = $(GENERIC_DIR)/tclTomMath.h $(GENERIC_DIR)/tommath.h PARSEHDR = $(GENERIC_DIR)/tclParse.h NREHDR = $(GENERIC_DIR)/tclInt.h TRIMHDR = $(GENERIC_DIR)/tclStringTrim.h TCL_LOCATIONS = -DTCL_LIBRARY="\"${TCL_LIBRARY}\"" \ -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \ $(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \ $(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c regexec.o: $(REGHDRS) $(GENERIC_DIR)/regexec.c $(GENERIC_DIR)/rege_dfa.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regexec.c regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regfree.c regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c tclAppInit.o: $(UNIX_DIR)/tclAppInit.c $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c tclAsync.o: $(GENERIC_DIR)/tclAsync.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c tclBasic.o: $(GENERIC_DIR)/tclBasic.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBasic.c tclBinary.o: $(GENERIC_DIR)/tclBinary.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBinary.c tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c tclClock.o: $(GENERIC_DIR)/tclClock.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c $(TCLREHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS) $(TRIMHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdMZ.c tclDate.o: $(GENERIC_DIR)/tclDate.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDate.c tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmds.c tclCompCmdsGR.o: $(GENERIC_DIR)/tclCompCmdsGR.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsGR.c tclCompCmdsSZ.o: $(GENERIC_DIR)/tclCompCmdsSZ.c $(COMPILEHDR) $(TRIMHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsSZ.c tclCompExpr.o: $(GENERIC_DIR)/tclCompExpr.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompExpr.c tclCompile.o: $(GENERIC_DIR)/tclCompile.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompile.c tclConfig.o: $(GENERIC_DIR)/tclConfig.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclConfig.c tclDictObj.o: $(GENERIC_DIR)/tclDictObj.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDictObj.c tclDisassemble.o: $(GENERIC_DIR)/tclDisassemble.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDisassemble.c tclEncoding.o: $(GENERIC_DIR)/tclEncoding.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEncoding.c tclEnsemble.o: $(GENERIC_DIR)/tclEnsemble.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnsemble.c tclEnv.o: $(GENERIC_DIR)/tclEnv.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c tclEvent.o: $(GENERIC_DIR)/tclEvent.c tclUuid.h $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.c tclFCmd.o: $(GENERIC_DIR)/tclFCmd.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFCmd.c tclFileName.o: $(GENERIC_DIR)/tclFileName.c $(FSHDR) $(TCLREHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFileName.c tclGet.o: $(GENERIC_DIR)/tclGet.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclGet.c tclHash.o: $(GENERIC_DIR)/tclHash.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHash.c tclHistory.o: $(GENERIC_DIR)/tclHistory.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHistory.c tclIndexObj.o: $(GENERIC_DIR)/tclIndexObj.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIndexObj.c tclInterp.o: $(GENERIC_DIR)/tclInterp.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclInterp.c tclIO.o: $(GENERIC_DIR)/tclIO.c $(IOHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIO.c tclIOCmd.o: $(GENERIC_DIR)/tclIOCmd.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOCmd.c tclIOGT.o: $(GENERIC_DIR)/tclIOGT.c $(IOHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOGT.c tclIOSock.o: $(GENERIC_DIR)/tclIOSock.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOSock.c tclIOUtil.o: $(GENERIC_DIR)/tclIOUtil.c $(FSHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOUtil.c tclIORChan.o: $(GENERIC_DIR)/tclIORChan.c $(IOHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIORChan.c tclIORTrans.o: $(GENERIC_DIR)/tclIORTrans.c $(IOHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIORTrans.c tclLink.o: $(GENERIC_DIR)/tclLink.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLink.c tclListObj.o: $(GENERIC_DIR)/tclListObj.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclListObj.c tclLiteral.o: $(GENERIC_DIR)/tclLiteral.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLiteral.c tclObj.o: $(GENERIC_DIR)/tclObj.c $(COMPILEHDR) $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c tclOptimize.o: $(GENERIC_DIR)/tclOptimize.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOptimize.c tclLoad.o: $(GENERIC_DIR)/tclLoad.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoad.c tclLoadAix.o: $(UNIX_DIR)/tclLoadAix.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadAix.c tclLoadDl.o: $(UNIX_DIR)/tclLoadDl.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl.c tclLoadDl2.o: $(UNIX_DIR)/tclLoadDl2.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl2.c tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c tclLoadDyld.o: $(UNIX_DIR)/tclLoadDyld.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDyld.c tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoadNone.c tclLoadOSF.o: $(UNIX_DIR)/tclLoadOSF.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadOSF.c tclLoadShl.o: $(UNIX_DIR)/tclLoadShl.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadShl.c tclMain.o: $(GENERIC_DIR)/tclMain.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclMain.c tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c tclNotify.o: $(GENERIC_DIR)/tclNotify.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c tclOO.o: $(GENERIC_DIR)/tclOO.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOO.c tclOOBasic.o: $(GENERIC_DIR)/tclOOBasic.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOBasic.c tclOOCall.o: $(GENERIC_DIR)/tclOOCall.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOCall.c tclOODefineCmds.o: $(GENERIC_DIR)/tclOODefineCmds.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOODefineCmds.c tclOOInfo.o: $(GENERIC_DIR)/tclOOInfo.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOInfo.c tclOOMethod.o: $(GENERIC_DIR)/tclOOMethod.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOMethod.c tclOOStubInit.o: $(GENERIC_DIR)/tclOOStubInit.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOStubInit.c tclParse.o: $(GENERIC_DIR)/tclParse.c $(PARSEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c tclPanic.o: $(GENERIC_DIR)/tclPanic.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPanic.c tclPathObj.o: $(GENERIC_DIR)/tclPathObj.c $(FSHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPathObj.c tclPipe.o: $(GENERIC_DIR)/tclPipe.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPipe.c tclPkg.o: $(GENERIC_DIR)/tclPkg.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPkg.c # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed # and where it will look for its libraries (which can be different). We derive # this information from the variables which can be overridden by the user. As # every path can be configured separately we do not remember one general # prefix/exec_prefix but all the different paths individually. tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \ -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \ -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \ -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR)\"" \ -DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \ -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ -DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \ -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \ -DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ $(GENERIC_DIR)/tclPkgConfig.c tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR) $(NREHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c $(TCLREHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclRegexp.c tclResolve.o: $(GENERIC_DIR)/tclResolve.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResolve.c tclResult.o: $(GENERIC_DIR)/tclResult.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResult.c tclScan.o: $(GENERIC_DIR)/tclScan.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclScan.c tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c tclStrToD.o: $(GENERIC_DIR)/tclStrToD.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrToD.c tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStubInit.c tclTrace.o: $(GENERIC_DIR)/tclTrace.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTrace.c tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR) $(TRIMHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtf.c tclVar.o: $(GENERIC_DIR)/tclVar.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c tclTimer.o: $(GENERIC_DIR)/tclTimer.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTimer.c tclThread.o: $(GENERIC_DIR)/tclThread.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThread.c tclThreadAlloc.o: $(GENERIC_DIR)/tclThreadAlloc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadAlloc.c tclThreadJoin.o: $(GENERIC_DIR)/tclThreadJoin.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadJoin.c tclThreadStorage.o: $(GENERIC_DIR)/tclThreadStorage.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadStorage.c tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c tclTomMathInterface.o: $(GENERIC_DIR)/tclTomMathInterface.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTomMathInterface.c bn_s_mp_reverse.o: $(TOMMATH_DIR)/bn_s_mp_reverse.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_reverse.c bn_s_mp_mul_digs_fast.o: $(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c bn_s_mp_sqr_fast.o: $(TOMMATH_DIR)/bn_s_mp_sqr_fast.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_sqr_fast.c bn_mp_add.o: $(TOMMATH_DIR)/bn_mp_add.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_add.c bn_mp_add_d.o: $(TOMMATH_DIR)/bn_mp_add_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_add_d.c bn_mp_and.o: $(TOMMATH_DIR)/bn_mp_and.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_and.c bn_mp_clamp.o: $(TOMMATH_DIR)/bn_mp_clamp.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_clamp.c bn_mp_clear.o: $(TOMMATH_DIR)/bn_mp_clear.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_clear.c bn_mp_clear_multi.o: $(TOMMATH_DIR)/bn_mp_clear_multi.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_clear_multi.c bn_mp_cmp.o: $(TOMMATH_DIR)/bn_mp_cmp.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cmp.c bn_mp_cmp_d.o: $(TOMMATH_DIR)/bn_mp_cmp_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cmp_d.c bn_mp_cmp_mag.o: $(TOMMATH_DIR)/bn_mp_cmp_mag.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cmp_mag.c bn_mp_cnt_lsb.o: $(TOMMATH_DIR)/bn_mp_cnt_lsb.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cnt_lsb.c bn_mp_copy.o: $(TOMMATH_DIR)/bn_mp_copy.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_copy.c bn_mp_count_bits.o: $(TOMMATH_DIR)/bn_mp_count_bits.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_count_bits.c bn_mp_div.o: $(TOMMATH_DIR)/bn_mp_div.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div.c bn_mp_div_d.o: $(TOMMATH_DIR)/bn_mp_div_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_d.c bn_mp_div_2.o: $(TOMMATH_DIR)/bn_mp_div_2.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_2.c bn_mp_div_2d.o: $(TOMMATH_DIR)/bn_mp_div_2d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_2d.c bn_mp_div_3.o: $(TOMMATH_DIR)/bn_mp_div_3.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_3.c bn_mp_exch.o: $(TOMMATH_DIR)/bn_mp_exch.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_exch.c bn_mp_expt_u32.o: $(TOMMATH_DIR)/bn_mp_expt_u32.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_u32.c bn_mp_grow.o: $(TOMMATH_DIR)/bn_mp_grow.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_grow.c bn_mp_init.o: $(TOMMATH_DIR)/bn_mp_init.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init.c bn_mp_init_copy.o: $(TOMMATH_DIR)/bn_mp_init_copy.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_copy.c bn_mp_init_multi.o: $(TOMMATH_DIR)/bn_mp_init_multi.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_multi.c bn_mp_init_set.o: $(TOMMATH_DIR)/bn_mp_init_set.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set.c bn_mp_init_size.o:$(TOMMATH_DIR)/bn_mp_init_size.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_size.c bn_s_mp_karatsuba_mul.o: $(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c bn_s_mp_karatsuba_sqr.o: $(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c bn_s_mp_balance_mul.o: $(TOMMATH_DIR)/bn_s_mp_balance_mul.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_balance_mul.c bn_mp_lshd.o: $(TOMMATH_DIR)/bn_mp_lshd.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_lshd.c bn_mp_mod.o: $(TOMMATH_DIR)/bn_mp_mod.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mod.c bn_mp_mod_2d.o: $(TOMMATH_DIR)/bn_mp_mod_2d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mod_2d.c bn_mp_mul.o: $(TOMMATH_DIR)/bn_mp_mul.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mul.c bn_mp_mul_2.o: $(TOMMATH_DIR)/bn_mp_mul_2.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mul_2.c bn_mp_mul_2d.o: $(TOMMATH_DIR)/bn_mp_mul_2d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mul_2d.c bn_mp_mul_d.o: $(TOMMATH_DIR)/bn_mp_mul_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mul_d.c bn_mp_neg.o: $(TOMMATH_DIR)/bn_mp_neg.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_neg.c bn_mp_or.o: $(TOMMATH_DIR)/bn_mp_or.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_or.c bn_mp_pack.o: $(TOMMATH_DIR)/bn_mp_pack.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_pack.c bn_mp_pack_count.o: $(TOMMATH_DIR)/bn_mp_pack_count.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_pack_count.c bn_mp_radix_size.o: $(TOMMATH_DIR)/bn_mp_radix_size.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_radix_size.c bn_mp_radix_smap.o: $(TOMMATH_DIR)/bn_mp_radix_smap.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_radix_smap.c bn_mp_read_radix.o: $(TOMMATH_DIR)/bn_mp_read_radix.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_read_radix.c bn_mp_rshd.o: $(TOMMATH_DIR)/bn_mp_rshd.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_rshd.c bn_mp_set.o: $(TOMMATH_DIR)/bn_mp_set.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set.c bn_mp_shrink.o: $(TOMMATH_DIR)/bn_mp_shrink.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_shrink.c bn_mp_sqr.o: $(TOMMATH_DIR)/bn_mp_sqr.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sqr.c bn_mp_sqrt.o: $(TOMMATH_DIR)/bn_mp_sqrt.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sqrt.c bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub.c bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c bn_mp_signed_rsh.o: $(TOMMATH_DIR)/bn_mp_signed_rsh.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_signed_rsh.c bn_mp_to_ubin.o: $(TOMMATH_DIR)/bn_mp_to_ubin.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_ubin.c bn_s_mp_toom_mul.o: $(TOMMATH_DIR)/bn_s_mp_toom_mul.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_toom_mul.c bn_s_mp_toom_sqr.o: $(TOMMATH_DIR)/bn_s_mp_toom_sqr.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_toom_sqr.c bn_mp_to_radix.o: $(TOMMATH_DIR)/bn_mp_to_radix.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_radix.c bn_mp_ubin_size.o: $(TOMMATH_DIR)/bn_mp_ubin_size.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_ubin_size.c bn_mp_unpack.o: $(TOMMATH_DIR)/bn_mp_unpack.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_unpack.c bn_mp_xor.o: $(TOMMATH_DIR)/bn_mp_xor.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_xor.c bn_mp_zero.o: $(TOMMATH_DIR)/bn_mp_zero.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_zero.c bn_s_mp_add.o: $(TOMMATH_DIR)/bn_s_mp_add.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_add.c bn_s_mp_mul_digs.o: $(TOMMATH_DIR)/bn_s_mp_mul_digs.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_mul_digs.c bn_s_mp_sqr.o: $(TOMMATH_DIR)/bn_s_mp_sqr.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_sqr.c bn_s_mp_sub.o: $(TOMMATH_DIR)/bn_s_mp_sub.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_sub.c tclUnixChan.o: $(UNIX_DIR)/tclUnixChan.c $(IOHDR) $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixChan.c tclUnixEvent.o: $(UNIX_DIR)/tclUnixEvent.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixEvent.c tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFCmd.c tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c $(FSHDR) $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c tclUnixNotfy.o: $(UNIX_DIR)/tclUnixNotfy.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixNotfy.c tclUnixPipe.o: $(UNIX_DIR)/tclUnixPipe.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixPipe.c tclUnixSock.o: $(UNIX_DIR)/tclUnixSock.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixSock.c tclUnixTest.o: $(UNIX_DIR)/tclUnixTest.c $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclUnixTest.c tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh $(CC) -c $(CC_SWITCHES) $(TCL_LOCATIONS) $(UNIX_DIR)/tclUnixInit.c tclUnixCompat.o: $(UNIX_DIR)/tclUnixCompat.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixCompat.c # The following are Mac OS X only sources: tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMacOSXBundle.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXBundle.c tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXFCmd.c tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c # The following is a CYGWIN only source: tclWinError.o: $(TOP_DIR)/win/tclWinError.c $(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinError.c # DTrace support $(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS) $(TOMMATH_OBJS): @DTRACE_HDR@ $(DTRACE_HDR): $(DTRACE_SRC) $(DTRACE) -h $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC) $(DTRACE_OBJ): $(DTRACE_SRC) $(TCL_OBJS) $(DTRACE) -G $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC) $(TCL_OBJS) #-------------------------------------------------------------------------- # The following targets are not completely general. They are provide purely # for documentation purposes so people who are interested in the Xt based # notifier can modify them to suit their own installation. #-------------------------------------------------------------------------- xttest: ${XTTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST} ${CC} ${CFLAGS} ${LDFLAGS} ${XTTEST_OBJS} \ @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -L/usr/openwin/lib -lXt -o xttest tclXtNotify.o: $(UNIX_DIR)/tclXtNotify.c $(CC) -c $(APP_CC_SWITCHES) -I/usr/openwin/include \ $(UNIX_DIR)/tclXtNotify.c tclXtTest.o: $(UNIX_DIR)/tclXtTest.c $(CC) -c $(APP_CC_SWITCHES) -I/usr/openwin/include \ $(UNIX_DIR)/tclXtTest.c #-------------------------------------------------------------------------- # Compat binaries, these must be compiled for use in a shared library even # though they may be placed in a static executable or library. Since they are # included in both the tcl library and the stub library, they need to be # relocatable. #-------------------------------------------------------------------------- opendir.o: $(COMPAT_DIR)/opendir.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c mkstemp.o: $(COMPAT_DIR)/mkstemp.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/mkstemp.c memcmp.o: $(COMPAT_DIR)/memcmp.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/memcmp.c strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c strstr.o: $(COMPAT_DIR)/strstr.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c strtol.o: $(COMPAT_DIR)/strtol.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c strtoul.o: $(COMPAT_DIR)/strtoul.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c waitpid.o: $(COMPAT_DIR)/waitpid.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c fake-rfc2553.o: $(COMPAT_DIR)/fake-rfc2553.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fake-rfc2553.c # For building zlib, only used in some build configurations Zadler32.o: $(ZLIB_DIR)/adler32.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/adler32.c Zcompress.o: $(ZLIB_DIR)/compress.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/compress.c Zcrc32.o: $(ZLIB_DIR)/crc32.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/crc32.c Zdeflate.o: $(ZLIB_DIR)/deflate.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/deflate.c Zinfback.o: $(ZLIB_DIR)/infback.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/infback.c Zinffast.o: $(ZLIB_DIR)/inffast.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/inffast.c Zinflate.o: $(ZLIB_DIR)/inflate.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/inflate.c Zinftrees.o: $(ZLIB_DIR)/inftrees.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/inftrees.c Ztrees.o: $(ZLIB_DIR)/trees.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/trees.c Zuncompr.o: $(ZLIB_DIR)/uncompr.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/uncompr.c Zzutil.o: $(ZLIB_DIR)/zutil.c $(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/zutil.c #-------------------------------------------------------------------------- # Stub library binaries, these must be compiled for use in a shared library # even though they will be placed in a static archive #-------------------------------------------------------------------------- tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclStubLib.c tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclTomMathStubLib.c tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c $(CC) -c $(STUB_CC_SWITCHES) @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclOOStubLib.c .c.o: $(CC) -c $(CC_SWITCHES) $< #-------------------------------------------------------------------------- # Bundled Package targets #-------------------------------------------------------------------------- # Propagate configure args like --enable-64bit to package configure PKG_CFG_ARGS = @PKG_CFG_ARGS@ # If PKG_DIR is changed to a different relative depth to the build dir, need # to adapt the ../.. relative paths below and at the top of configure.in (we # cannot use absolute paths due to issues in nested configure when path to # build dir contains spaces). PKG_DIR = ./pkgs configure-packages: @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ if [ -x $$i/configure ] ; then \ pkg=`basename $$i`; \ echo "Configuring package '$$pkg'"; \ mkdir -p $(PKG_DIR)/$$pkg; \ if [ ! -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; \ $$i/configure --with-tcl=../.. \ --with-tclinclude=$(GENERIC_DIR) \ $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \ --enable-shared --enable-threads; ) || exit $$?; \ fi; \ fi; \ fi; \ done packages: configure-packages ${STUB_LIB_FILE} @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ echo "Building package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \ fi; \ fi; \ done install-packages: packages @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ echo "Installing package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \ "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \ fi; \ fi; \ done test-packages: ${TCLTEST_EXE} packages @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ echo "Testing package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) \ "@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \ "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \ "TCLLIBPATH=../../pkgs" test \ "TCLSH_PROG=../../${TCLTEST_EXE}"; ) \ fi; \ fi; \ done clean-packages: @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \ fi; \ fi; \ done distclean-packages: @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \ fi; \ rm -rf $(PKG_DIR)/$$pkg; \ fi; \ done; \ rm -rf $(PKG_DIR) dist-packages: configure-packages @rm -rf $(DISTROOT)/pkgs; \ mkdir -p $(DISTROOT)/pkgs; \ for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \ "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \ fi; \ fi; \ done #-------------------------------------------------------------------------- # Maintainer-only targets #-------------------------------------------------------------------------- # The following target generates the file generic/tclDate.c from the yacc # grammar found in generic/tclGetDate.y. This is only run by hand as yacc is # not available in all environments. The name of the .c file is different than # the name of the .y file so that make doesn't try to automatically regenerate # the .c file. # # Remark: see [54a305cb88]. tclDate.c is manually edited, removing the unused "yynerrs" variable gendate: bison --output-file=$(GENERIC_DIR)/tclDate.c \ --no-lines \ --name-prefix=TclDate \ $(GENERIC_DIR)/tclGetDate.y # yacc -l $(GENERIC_DIR)/tclGetDate.y # sed -e 's/yy/TclDate/g' -e '/^#include /d' \ # -e 's?SCCSID?RCS: @(#) ?' \ # -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \ # -e '/TclDatenewstate:/d' -e '/#pragma/d' \ # -e '/#include /d' \ # -e '/#define YYNEW/s/malloc/TclDateAlloc/g' \ # -e '/#define YYENLARGE/,/realloc/s/realloc/TclDateRealloc/g' \ # $(GENERIC_DIR)/tclDate.c # rm y.tab.c # The following target generates the file generic/tclTomMath.h. It needs to be # run (and the results checked) after updating to a new release of libtommath. gentommath_h: $(NATIVE_TCLSH) "$(TOOL_DIR)/fix_tommath_h.tcl" \ "$(TOMMATH_DIR)/tommath.h" \ > "$(GENERIC_DIR)/tclTomMath.h" # # Target to regenerate header files and stub files from the *.decls tables. # $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \ $(GENERIC_DIR)/tclInt.decls $(GENERIC_DIR)/tclTomMath.decls @echo "Warning: tclStubInit.c may be out of date." @echo "Developers may want to run \"make genstubs\" to regenerate." @echo "This warning can be safely ignored, do not report as a bug!" $(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls @echo "Warning: tclOOStubInit.c may be out of date." @echo "Developers may want to run \"make genstubs\" to regenerate." @echo "This warning can be safely ignored, do not report as a bug!" genstubs: $(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \ $(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls \ $(GENERIC_DIR)/tclTomMath.decls $(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \ $(GENERIC_DIR)/tclOO.decls # # Target to check that all exported functions have an entry in the stubs # tables. # checkstubs: $(TCL_LIB_FILE) -@for i in `nm -p $(TCL_LIB_FILE) \ | awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \ | sort -n` ; do \ match=0; \ for j in $(TCL_DECLS); do \ if [ `grep -c "$$i *(" $$j` -gt 0 ] ; then \ match=1; \ fi; \ done; \ if [ $$match -eq 0 ] ; then \ echo $$i; \ fi; \ done # # Target to check that all public APIs which are not command implementations # have an entry in section three of the distributed manpages. # checkdoc: $(TCL_LIB_FILE) -@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \ | grep -Fv . | grep -v 'Cmd$$' | sort -n`; do \ match=0; \ i=`echo $$i | sed 's/^_//'`; \ for j in $(TOP_DIR)/doc/*.3; do \ if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \ match=1; \ fi; \ done; \ if [ $$match -eq 0 ]; then \ echo $$i; \ fi; \ done # # Target to check for proper usage of UCHAR macro. # checkuchar: -@egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR # # Target to make sure that only symbols with "Tcl" prefixes are exported. # checkexports: $(TCL_LIB_FILE) -@nm -p $(TCL_LIB_FILE) \ | awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \ | sort -n | grep -E -v '^[Tt]cl' || true #-------------------------------------------------------------------------- # Distribution building rules #-------------------------------------------------------------------------- # # Target to create a Tcl RPM for Linux. Requires that you be on a Linux # system. # RPM_PLATFORMS = i386 rpm: all -@rm -f THIS.TCL.SPEC echo "%define _builddir `pwd`" > THIS.TCL.SPEC echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC cat tcl.spec >> THIS.TCL.SPEC for platform in $(RPM_PLATFORMS); do \ mkdir -p RPMS/$$platform && \ rpmbuild -bb THIS.TCL.SPEC && \ mv RPMS/$$platform/*.rpm .; \ done -rm -rf RPMS THIS.TCL.SPEC # # Target to create a proper Tcl distribution from information in the # source directory. DISTDIR must be defined to indicate where to put # the distribution. DISTDIR must be an absolute path name. # DISTROOT = /tmp/dist DISTNAME = tcl${VERSION}${PATCH_LEVEL} ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) BUILTIN_PACKAGE_LIST = http1.0 http opt msgcat reg dde tcltest platform $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in $(UNIX_DIR)/tcl.m4 \ $(UNIX_DIR)/aclocal.m4 cd $(UNIX_DIR); autoconf $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure cd $(MAC_OSX_DIR); autoconf $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure cd $(MAC_OSX_DIR); autoheader; touch $@ tclUuid.h: $(TOP_DIR)/manifest.uuid echo "#define TCL_VERSION_UUID \\" >$@ cat $(TOP_DIR)/manifest.uuid >>$@ echo "" >>$@ $(TOP_DIR)/manifest.uuid: printf "git-" >$(TOP_DIR)/manifest.uuid (cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \ (printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \ svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \ printf "unknown" >$(TOP_DIR)/manifest.uuid) dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in genstubs \ $(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid dist-packages ${NATIVE_TCLSH} rm -rf $(DISTDIR) mkdir -p $(DISTDIR)/unix cp -p $(TOP_DIR)/manifest.uuid $(DISTDIR) cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix cp -p $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix chmod 664 $(DISTDIR)/unix/Makefile.in cp -p $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \ $(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \ $(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/tclooConfig.sh \ $(UNIX_DIR)/install-sh \ $(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \ $(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \ $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix chmod 775 $(DISTDIR)/unix/configure chmod 775 $(DISTDIR)/unix/ldAix @mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) @mkdir $(DISTDIR)/library cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library @for i in $(BUILTIN_PACKAGE_LIST); do \ mkdir $(DISTDIR)/library/$$i;\ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done @mkdir $(DISTDIR)/library/encoding cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding @mkdir $(DISTDIR)/library/msgs cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs @echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata @( cd $(TOP_DIR); find library/tzdata -type f -print ) \ | ( cd $(TOP_DIR) ; xargs tar cf - ) \ | ( cd $(DISTDIR) ; tar xfp - ) @mkdir $(DISTDIR)/doc cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc @mkdir $(DISTDIR)/compat cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ $(COMPAT_DIR)/README $(DISTDIR)/compat @mkdir $(DISTDIR)/compat/zlib @echo cp -r $(COMPAT_DIR)/zlib $(DISTDIR)/compat/zlib @( cd $(COMPAT_DIR)/zlib; find . -type f -print ) \ | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) @mkdir $(DISTDIR)/libtommath cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath @mkdir $(DISTDIR)/tests cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(DISTDIR)/tests @mkdir $(DISTDIR)/tests/auto0 for i in auto1 auto2 ; \ do \ mkdir $(DISTDIR)/tests/auto0/$$i ;\ cp -p $(TOP_DIR)/tests/auto0/$$i/tclIndex $(TOP_DIR)/tests/auto0/$$i/*.tcl \ $(DISTDIR)/tests/auto0/$$i; \ done; for i in modules modules/mod1 modules/mod2 ; \ do \ mkdir $(DISTDIR)/tests/auto0/$$i ;\ cp -p $(TOP_DIR)/tests/auto0/$$i/*.tm \ $(DISTDIR)/tests/auto0/$$i; \ done; @mkdir $(DISTDIR)/win cp -p $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win cp -p $(TOP_DIR)/win/configure.in $(TOP_DIR)/win/configure \ $(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \ $(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \ $(TOP_DIR)/win/tclsh.exe.manifest.in $(TOP_DIR)/win/tclUuid.h.in \ $(TOP_DIR)/win/gitmanifest.in $(TOP_DIR)/win/svnmanifest.in \ $(TOP_DIR)/win/x86_64-w64-mingw32-nmakehlp.exe $(DISTDIR)/win chmod 775 $(DISTDIR)/win/x86_64-w64-mingw32-nmakehlp.exe cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.vc $(DISTDIR)/win cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win cp -p $(TOP_DIR)/win/README $(DISTDIR)/win cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win @mkdir $(DISTDIR)/macosx cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \ $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx @mkdir $(DISTDIR)/macosx/Tcl.xcode cp -p $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcode @mkdir $(DISTDIR)/macosx/Tcl.xcodeproj cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcodeproj @mkdir $(DISTDIR)/unix/dltest cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest @mkdir $(DISTDIR)/tools cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \ $(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \ $(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \ $(DISTDIR)/tools @mkdir $(DISTDIR)/pkgs cp -p $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs cp -p $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done cp -p $(TOP_DIR)/.travis.yml $(DISTDIR) mkdir -p $(DISTDIR)/.github/workflows cp -p $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows alldist: dist rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) ( cd $(DISTROOT); \ tar cf $(DISTNAME)-src.tar $(DISTNAME); \ gzip -9 $(DISTNAME)-src.tar; \ zip -qr8 $(ZIPNAME) $(DISTNAME) ) #-------------------------------------------------------------------------- # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool # workspace. It depends on the Tcl & Tk being in directories called tcl8.* & # tk8.* up two directories from the TOOL_DIR. # # Note that for platforms where this is important, it is more common to use a # build of this HTML documentation that has already been placed online. As # such, this rule is not guaranteed to work well on all systems; it only needs # to function on those of the Tcl/Tk maintainers. # # Also note that the 8.6 tool build requires an installed 8.6 native Tcl # interpreter in order to be able to run. #-------------------------------------------------------------------------- html: ${NATIVE_TCLSH} $(BUILD_HTML) @EXTRA_BUILD_HTML@ html-tcl: ${NATIVE_TCLSH} $(BUILD_HTML) --tcl @EXTRA_BUILD_HTML@ html-tk: ${NATIVE_TCLSH} $(BUILD_HTML) --tk @EXTRA_BUILD_HTML@ # You'd better have these programs or you will have problems creating Makefile # from Makefile.in in the first place... HTML_VERSION = `basename $(TOP_DIR) | sed s/tcl//` BUILD_HTML = \ @${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \ --useversion=$(HTML_VERSION) --htmldir="$(HTML_INSTALL_DIR)" \ --srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS) #-------------------------------------------------------------------------- # The list of all the targets that do not correspond to real files. This stops # 'make' from getting confused when someone makes an error in a rule. #-------------------------------------------------------------------------- .PHONY: all binaries libraries objs doc html html-tcl html-tk test runtest .PHONY: install install-strip install-binaries install-libraries .PHONY: install-headers install-private-headers install-doc .PHONY: clean distclean depend genstubs checkstubs checkexports checkuchar .PHONY: shell gdb valgrind valgrindshell dist alldist rpm .PHONY: tclLibObjs tcltest-real test-tcl gdb-test ro-test trace-test xttest .PHONY: topDirName gendate gentommath_h trace-shell checkdoc .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. tcl8.6.14/unix/configure0000755000175000017500000215614714560750333014555 0ustar sergeisergei#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.59 for tcl 8.6. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' PACKAGE_VERSION='8.6' PACKAGE_STRING='tcl 8.6' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. ac_includes_default="\ #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if STDC_HEADERS # include # include #else # if HAVE_STDLIB_H # include # endif #endif #if HAVE_STRING_H # if !STDC_HEADERS && HAVE_MEMORY_H # include # endif # include #endif #if HAVE_STRINGS_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS SHARED_BUILD TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_NOLTO LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias ac_env_CC_set=${CC+set} ac_env_CC_value=$CC ac_cv_env_CC_set=${CC+set} ac_cv_env_CC_value=$CC ac_env_CFLAGS_set=${CFLAGS+set} ac_env_CFLAGS_value=$CFLAGS ac_cv_env_CFLAGS_set=${CFLAGS+set} ac_cv_env_CFLAGS_value=$CFLAGS ac_env_LDFLAGS_set=${LDFLAGS+set} ac_env_LDFLAGS_value=$LDFLAGS ac_cv_env_LDFLAGS_set=${LDFLAGS+set} ac_cv_env_LDFLAGS_value=$LDFLAGS ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS ac_env_CPP_set=${CPP+set} ac_env_CPP_value=$CPP ac_cv_env_CPP_set=${CPP+set} ac_cv_env_CPP_value=$CPP # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures tcl 8.6 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of tcl 8.6:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-man-symlinks use symlinks for the manpages (default: off) --enable-man-compression=PROG compress the manpages with PROG (default: off) --enable-man-suffix=STRING use STRING as a suffix to manpage file names (default: no, tcl if enabled without specifying STRING) --enable-threads build with threads (default: on) --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (default: off) --enable-64bit-vis enable 64bit Sparc VIS support (default: off) --disable-rpath disable rpath support (default: on) --enable-corefoundation use CoreFoundation API on MacOSX (default: on) --enable-load allow dynamic loading and "load" command (default: on) --enable-symbols build with debugging symbols (default: off) --enable-langinfo use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on) --enable-dll-unloading enable the 'unload' command (default: on) --enable-dtrace build with DTrace support (default: off) --enable-framework package shared libraries in MacOSX frameworks (default: off) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values (default: iso8859-1) --with-tzdata install timezone data (default: autodetect) Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF tcl configure 8.6 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit 0 fi exec 5>config.log cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 8.6, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL=".14" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} #------------------------------------------------------------------------ # Setup configure arguments for bundled packages #------------------------------------------------------------------------ PKG_CFG_ARGS="$ac_configure_args ${PKG_CFG_ARGS}" if test -r "$cache_file" -a -f "$cache_file"; then case $cache_file in [\\/]* | ?:[\\/]* ) pkg_cache_file=$cache_file ;; *) pkg_cache_file=../../$cache_file ;; esac PKG_CFG_ARGS="${PKG_CFG_ARGS} --cache-file=$pkg_cache_file" fi #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ #rm -Rf pkgs if test -f Makefile; then make distclean-packages fi #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then prefix=/usr/local fi if test "${exec_prefix}" = "NONE"; then exec_prefix=$prefix fi # Make sure srcdir is fully qualified! srcdir="`cd "$srcdir" ; pwd`" TCL_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ # Compress and/or soft link the manpages? #------------------------------------------------------------------------ echo "$as_me:$LINENO: checking whether to use symlinks for manpages" >&5 echo $ECHO_N "checking whether to use symlinks for manpages... $ECHO_C" >&6 # Check whether --enable-man-symlinks or --disable-man-symlinks was given. if test "${enable_man_symlinks+set}" = set; then enableval="$enable_man_symlinks" test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 echo "$as_me:$LINENO: checking whether to compress the manpages" >&5 echo $ECHO_N "checking whether to compress the manpages... $ECHO_C" >&6 # Check whether --enable-man-compression or --disable-man-compression was given. if test "${enable_man_compression+set}" = set; then enableval="$enable_man_compression" case $enableval in yes) { { echo "$as_me:$LINENO: error: missing argument to --enable-man-compression" >&5 echo "$as_me: error: missing argument to --enable-man-compression" >&2;} { (exit 1); exit 1; }; };; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 if test "$enableval" != "no"; then echo "$as_me:$LINENO: checking for compressed file suffix" >&5 echo $ECHO_N "checking for compressed file suffix... $ECHO_C" >&6 touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" echo "$as_me:$LINENO: result: $Z" >&5 echo "${ECHO_T}$Z" >&6 fi echo "$as_me:$LINENO: checking whether to add a package name suffix for the manpages" >&5 echo $ECHO_N "checking whether to add a package name suffix for the manpages... $ECHO_C" >&6 # Check whether --enable-man-suffix or --disable-man-suffix was given. if test "${enable_man_suffix+set}" = set; then enableval="$enable_man_suffix" case $enableval in yes) enableval="tcl" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 #------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CC" && break done CC=$ac_ct_CC fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 (eval $ac_link_default) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Find the output, starting from the most likely. This scheme is # not robust to junk in `.', hence go to wildcards (a.*) only as a last # resort. # Be careful to initialize this variable, since it used to be cached. # Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. ac_cv_exeext= # b.out is created by i960 compilers. for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; conftest.$ac_ext ) # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` # FIXME: I believe we export ac_cv_exeext for Libtool, # but it would be cool to find out if it's true. Does anybody # maintain Libtool? --akim. export ac_cv_exeext break;; * ) break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6 # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6 echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` export ac_cv_exeext break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS CFLAGS="-g" echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cc_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 if test "${ac_cv_prog_cc_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_stdc=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std1 is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std1. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF # Don't try gcc -ansi; that turns off useful extensions and # breaks some systems' header files. # AIX -qlanglvl=ansi # Ultrix and OSF/1 -std1 # HP-UX 10.20 and later -Ae # HP-UX older versions -Aa -D_HPUX_SOURCE # SVR4 -Xc -D__EXTENSIONS__ for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_stdc=$ac_arg break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext done rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi case "x$ac_cv_prog_cc_stdc" in x|xno) echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6 ;; *) echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 CC="$CC $ac_cv_prog_cc_stdc" ;; esac # Some people use a C++ compiler to compile C. Since we use `exit', # in C++ we need to declare it. In case someone uses the same compiler # for both compiling C and C++ we need to have the C++ compiler decide # the declaration of exit, since it's the most demanding environment. cat >conftest.$ac_ext <<_ACEOF #ifndef __cplusplus choke me #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then for ac_declaration in \ '' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration #include int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking for inline" >&5 echo $ECHO_N "checking for inline... $ECHO_C" >&6 if test "${ac_cv_c_inline+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifndef __cplusplus typedef int foo_t; static $ac_kw foo_t static_foo () {return 0; } $ac_kw foo_t foo () {return 0; } #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_inline=$ac_kw; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done fi echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 echo "${ECHO_T}$ac_cv_c_inline" >&6 case $ac_cv_c_inline in inline | yes) ;; *) case $ac_cv_c_inline in no) ac_val=;; *) ac_val=$ac_cv_c_inline;; esac cat >>confdefs.h <<_ACEOF #ifndef __cplusplus #define inline $ac_val #endif _ACEOF ;; esac #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or # strtod in some versions of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6 ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6 if test "${ac_cv_prog_egrep+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | (grep -E '(a|b)') >/dev/null 2>&1 then ac_cv_prog_egrep='grep -E' else ac_cv_prog_egrep='egrep' fi fi echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 echo "${ECHO_T}$ac_cv_prog_egrep" >&6 EGREP=$ac_cv_prog_egrep echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6 if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking dirent.h" >&5 echo $ECHO_N "checking dirent.h... $ECHO_C" >&6 if test "${tcl_cv_dirent_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #ifndef _POSIX_SOURCE # ifdef __Lynx__ /* * Generate compilation error to make the test fail: Lynx headers * are only valid if really in the POSIX environment. */ missing_procedure(); # endif #endif DIR *d; struct dirent *entryPtr; char *p; d = opendir("foobar"); entryPtr = readdir(d); p = entryPtr->d_name; closedir(d); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_dirent_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_dirent_h=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_dirent_h" >&5 echo "${ECHO_T}$tcl_cv_dirent_h" >&6 if test $tcl_cv_dirent_h = no; then cat >>confdefs.h <<\_ACEOF #define NO_DIRENT_H 1 _ACEOF fi if test "${ac_cv_header_float_h+set}" = set; then echo "$as_me:$LINENO: checking for float.h" >&5 echo $ECHO_N "checking for float.h... $ECHO_C" >&6 if test "${ac_cv_header_float_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5 echo "${ECHO_T}$ac_cv_header_float_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking float.h usability" >&5 echo $ECHO_N "checking float.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking float.h presence" >&5 echo $ECHO_N "checking float.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: float.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: float.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: float.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: float.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: float.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: float.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: float.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for float.h" >&5 echo $ECHO_N "checking for float.h... $ECHO_C" >&6 if test "${ac_cv_header_float_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_float_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5 echo "${ECHO_T}$ac_cv_header_float_h" >&6 fi if test $ac_cv_header_float_h = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_FLOAT_H 1 _ACEOF fi if test "${ac_cv_header_values_h+set}" = set; then echo "$as_me:$LINENO: checking for values.h" >&5 echo $ECHO_N "checking for values.h... $ECHO_C" >&6 if test "${ac_cv_header_values_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5 echo "${ECHO_T}$ac_cv_header_values_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking values.h usability" >&5 echo $ECHO_N "checking values.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking values.h presence" >&5 echo $ECHO_N "checking values.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: values.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: values.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: values.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: values.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: values.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: values.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: values.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for values.h" >&5 echo $ECHO_N "checking for values.h... $ECHO_C" >&6 if test "${ac_cv_header_values_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_values_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5 echo "${ECHO_T}$ac_cv_header_values_h" >&6 fi if test $ac_cv_header_values_h = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_VALUES_H 1 _ACEOF fi if test "${ac_cv_header_stdlib_h+set}" = set; then echo "$as_me:$LINENO: checking for stdlib.h" >&5 echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 if test "${ac_cv_header_stdlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking stdlib.h usability" >&5 echo $ECHO_N "checking stdlib.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking stdlib.h presence" >&5 echo $ECHO_N "checking stdlib.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: stdlib.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: stdlib.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: stdlib.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: stdlib.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: stdlib.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: stdlib.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: stdlib.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for stdlib.h" >&5 echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 if test "${ac_cv_header_stdlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_stdlib_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 fi if test $ac_cv_header_stdlib_h = yes; then tcl_ok=1 else tcl_ok=0 fi cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtol" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtoul" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtod" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* if test $tcl_ok = 0; then cat >>confdefs.h <<\_ACEOF #define NO_STDLIB_H 1 _ACEOF fi if test "${ac_cv_header_string_h+set}" = set; then echo "$as_me:$LINENO: checking for string.h" >&5 echo $ECHO_N "checking for string.h... $ECHO_C" >&6 if test "${ac_cv_header_string_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5 echo "${ECHO_T}$ac_cv_header_string_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking string.h usability" >&5 echo $ECHO_N "checking string.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking string.h presence" >&5 echo $ECHO_N "checking string.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: string.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: string.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: string.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: string.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: string.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: string.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: string.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for string.h" >&5 echo $ECHO_N "checking for string.h... $ECHO_C" >&6 if test "${ac_cv_header_string_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_string_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5 echo "${ECHO_T}$ac_cv_header_string_h" >&6 fi if test $ac_cv_header_string_h = yes; then tcl_ok=1 else tcl_ok=0 fi cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strstr" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strerror" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* # See also memmove check below for a place where NO_STRING_H can be # set and why. if test $tcl_ok = 0; then cat >>confdefs.h <<\_ACEOF #define NO_STRING_H 1 _ACEOF fi if test "${ac_cv_header_sys_wait_h+set}" = set; then echo "$as_me:$LINENO: checking for sys/wait.h" >&5 echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6 if test "${ac_cv_header_sys_wait_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sys/wait.h usability" >&5 echo $ECHO_N "checking sys/wait.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sys/wait.h presence" >&5 echo $ECHO_N "checking sys/wait.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: sys/wait.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: sys/wait.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sys/wait.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sys/wait.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: sys/wait.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sys/wait.h" >&5 echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6 if test "${ac_cv_header_sys_wait_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sys_wait_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6 fi if test $ac_cv_header_sys_wait_h = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_SYS_WAIT_H 1 _ACEOF fi if test "${ac_cv_header_dlfcn_h+set}" = set; then echo "$as_me:$LINENO: checking for dlfcn.h" >&5 echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6 if test "${ac_cv_header_dlfcn_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking dlfcn.h usability" >&5 echo $ECHO_N "checking dlfcn.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking dlfcn.h presence" >&5 echo $ECHO_N "checking dlfcn.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: dlfcn.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: dlfcn.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: dlfcn.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: dlfcn.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: dlfcn.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for dlfcn.h" >&5 echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6 if test "${ac_cv_header_dlfcn_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_dlfcn_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6 fi if test $ac_cv_header_dlfcn_h = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_DLFCN_H 1 _ACEOF fi # OS/390 lacks sys/param.h (and doesn't need it, by chance). for ac_header in sys/param.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done #-------------------------------------------------------------------- # Determines the correct executable file extension (.exe) #-------------------------------------------------------------------- #------------------------------------------------------------------------ # If we're using GCC, see if the compiler understands -pipe. If so, use it. # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then echo "$as_me:$LINENO: checking if the compiler understands -pipe" >&5 echo $ECHO_N "checking if the compiler understands -pipe... $ECHO_C" >&6 if test "${tcl_cv_cc_pipe+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_pipe=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_pipe=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_pipe" >&5 echo "${ECHO_T}$tcl_cv_cc_pipe" >&6 if test $tcl_cv_cc_pipe = yes; then CFLAGS="$CFLAGS -pipe" fi fi #------------------------------------------------------------------------ # Threads support #------------------------------------------------------------------------ # Check whether --enable-threads or --disable-threads was given. if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else tcl_ok=yes fi; if test "${TCL_THREADS}" = 1; then tcl_threaded_core=1; fi if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then TCL_THREADS=1 # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention cat >>confdefs.h <<\_ACEOF #define USE_THREAD_ALLOC 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF if test "`uname -s`" = "SunOS" ; then cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF fi cat >>confdefs.h <<\_ACEOF #define _THREAD_SAFE 1 _ACEOF echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthread" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lpthread... $ECHO_C" >&6 if test "${ac_cv_lib_pthread_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthread_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthread_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthread_pthread_mutex_init" >&6 if test $ac_cv_lib_pthread_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "no"; then # Check a little harder for __pthread_mutex_init in the same # library, as some systems hide it there until pthread.h is # defined. We could alternatively do an AC_TRY_COMPILE with # pthread.h, but that will work with libpthread really doesn't # exist, like AIX 4.2. [Bug: 4359] echo "$as_me:$LINENO: checking for __pthread_mutex_init in -lpthread" >&5 echo $ECHO_N "checking for __pthread_mutex_init in -lpthread... $ECHO_C" >&6 if test "${ac_cv_lib_pthread___pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char __pthread_mutex_init (); int main () { __pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthread___pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthread___pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthread___pthread_mutex_init" >&6 if test $ac_cv_lib_pthread___pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthread" else echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthreads" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lpthreads... $ECHO_C" >&6 if test "${ac_cv_lib_pthreads_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthreads $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthreads_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthreads_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthreads_pthread_mutex_init" >&6 if test $ac_cv_lib_pthreads_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthreads" else echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lc... $ECHO_C" >&6 if test "${ac_cv_lib_c_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lc $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_c_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_c_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_c_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_c_pthread_mutex_init" >&6 if test $ac_cv_lib_c_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "no"; then echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc_r" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lc_r... $ECHO_C" >&6 if test "${ac_cv_lib_c_r_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lc_r $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_c_r_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_c_r_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_c_r_pthread_mutex_init" >&6 if test $ac_cv_lib_c_r_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -pthread" else TCL_THREADS=0 { echo "$as_me:$LINENO: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5 echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;} fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" for ac_func in pthread_attr_setstacksize pthread_atfork do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done LIBS=$ac_saved_libs else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output echo "$as_me:$LINENO: checking for building with threads" >&5 echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 if test "${TCL_THREADS}" = 1; then cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 _ACEOF if test "${tcl_threaded_core}" = 1; then echo "$as_me:$LINENO: result: yes (threaded core)" >&5 echo "${ECHO_T}yes (threaded core)" >&6 else echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 fi else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ # Check whether --with-encoding or --without-encoding was given. if test "${with_encoding+set}" = set; then withval="$with_encoding" with_tcencoding=${withval} fi; if test x"${with_tcencoding}" != x ; then cat >>confdefs.h <<_ACEOF #define TCL_CFGVAL_ENCODING "${with_tcencoding}" _ACEOF else cat >>confdefs.h <<\_ACEOF #define TCL_CFGVAL_ENCODING "iso8859-1" _ACEOF fi #-------------------------------------------------------------------- # Look for libraries that we will need when compiling the Tcl shell #-------------------------------------------------------------------- #-------------------------------------------------------------------- # On a few very rare systems, all of the libm.a stuff is # already in libc.a. Set compiler flags accordingly. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for sin" >&5 echo $ECHO_N "checking for sin... $ECHO_C" >&6 if test "${ac_cv_func_sin+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define sin to an innocuous variant, in case declares sin. For example, HP-UX 11i declares gettimeofday. */ #define sin innocuous_sin /* System header to define __stub macros and hopefully few prototypes, which can conflict with char sin (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef sin /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char sin (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_sin) || defined (__stub___sin) choke me #else char (*f) () = sin; #endif #ifdef __cplusplus } #endif int main () { return f != sin; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_sin=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_sin=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_sin" >&5 echo "${ECHO_T}$ac_cv_func_sin" >&6 if test $ac_cv_func_sin = yes; then MATH_LIBS="" else MATH_LIBS="-lm" fi #-------------------------------------------------------------------- # Interactive UNIX requires -linet instead of -lsocket, plus it # needs net/errno.h to define the socket-related error codes. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for main in -linet" >&5 echo $ECHO_N "checking for main in -linet... $ECHO_C" >&6 if test "${ac_cv_lib_inet_main+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { main (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_inet_main=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_inet_main=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_inet_main" >&5 echo "${ECHO_T}$ac_cv_lib_inet_main" >&6 if test $ac_cv_lib_inet_main = yes; then LIBS="$LIBS -linet" fi if test "${ac_cv_header_net_errno_h+set}" = set; then echo "$as_me:$LINENO: checking for net/errno.h" >&5 echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6 if test "${ac_cv_header_net_errno_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5 echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking net/errno.h usability" >&5 echo $ECHO_N "checking net/errno.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking net/errno.h presence" >&5 echo $ECHO_N "checking net/errno.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: net/errno.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: net/errno.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: net/errno.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: net/errno.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: net/errno.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: net/errno.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: net/errno.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for net/errno.h" >&5 echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6 if test "${ac_cv_header_net_errno_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_net_errno_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5 echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6 fi if test $ac_cv_header_net_errno_h = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_NET_ERRNO_H 1 _ACEOF fi #-------------------------------------------------------------------- # Check for the existence of the -lsocket and -lnsl libraries. # The order here is important, so that they end up in the right # order in the command line generated by make. Here are some # special considerations: # 1. Use "connect" and "accept" to check for -lsocket, and # "gethostbyname" to check for -lnsl. # 2. Use each function name only once: can't redo a check because # autoconf caches the results of the last check and won't redo it. # 3. Use -lnsl and -lsocket only if they supply procedures that # aren't already present in the normal libraries. This is because # IRIX 5.2 has libraries, but they aren't needed and they're # bogus: they goof up name resolution if used. # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. # To get around this problem, check for both libraries together # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- tcl_checkBoth=0 echo "$as_me:$LINENO: checking for connect" >&5 echo $ECHO_N "checking for connect... $ECHO_C" >&6 if test "${ac_cv_func_connect+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define connect to an innocuous variant, in case declares connect. For example, HP-UX 11i declares gettimeofday. */ #define connect innocuous_connect /* System header to define __stub macros and hopefully few prototypes, which can conflict with char connect (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef connect /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char connect (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_connect) || defined (__stub___connect) choke me #else char (*f) () = connect; #endif #ifdef __cplusplus } #endif int main () { return f != connect; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_connect=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_connect=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_connect" >&5 echo "${ECHO_T}$ac_cv_func_connect" >&6 if test $ac_cv_func_connect = yes; then tcl_checkSocket=0 else tcl_checkSocket=1 fi if test "$tcl_checkSocket" = 1; then echo "$as_me:$LINENO: checking for setsockopt" >&5 echo $ECHO_N "checking for setsockopt... $ECHO_C" >&6 if test "${ac_cv_func_setsockopt+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define setsockopt to an innocuous variant, in case declares setsockopt. For example, HP-UX 11i declares gettimeofday. */ #define setsockopt innocuous_setsockopt /* System header to define __stub macros and hopefully few prototypes, which can conflict with char setsockopt (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef setsockopt /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char setsockopt (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_setsockopt) || defined (__stub___setsockopt) choke me #else char (*f) () = setsockopt; #endif #ifdef __cplusplus } #endif int main () { return f != setsockopt; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_setsockopt=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_setsockopt=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_setsockopt" >&5 echo "${ECHO_T}$ac_cv_func_setsockopt" >&6 if test $ac_cv_func_setsockopt = yes; then : else echo "$as_me:$LINENO: checking for setsockopt in -lsocket" >&5 echo $ECHO_N "checking for setsockopt in -lsocket... $ECHO_C" >&6 if test "${ac_cv_lib_socket_setsockopt+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char setsockopt (); int main () { setsockopt (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_socket_setsockopt=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_socket_setsockopt=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_socket_setsockopt" >&5 echo "${ECHO_T}$ac_cv_lib_socket_setsockopt" >&6 if test $ac_cv_lib_socket_setsockopt = yes; then LIBS="$LIBS -lsocket" else tcl_checkBoth=1 fi fi fi if test "$tcl_checkBoth" = 1; then tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" echo "$as_me:$LINENO: checking for accept" >&5 echo $ECHO_N "checking for accept... $ECHO_C" >&6 if test "${ac_cv_func_accept+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define accept to an innocuous variant, in case declares accept. For example, HP-UX 11i declares gettimeofday. */ #define accept innocuous_accept /* System header to define __stub macros and hopefully few prototypes, which can conflict with char accept (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef accept /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char accept (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_accept) || defined (__stub___accept) choke me #else char (*f) () = accept; #endif #ifdef __cplusplus } #endif int main () { return f != accept; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_accept=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_accept=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_accept" >&5 echo "${ECHO_T}$ac_cv_func_accept" >&6 if test $ac_cv_func_accept = yes; then tcl_checkNsl=0 else LIBS=$tk_oldLibs fi fi echo "$as_me:$LINENO: checking for gethostbyname" >&5 echo $ECHO_N "checking for gethostbyname... $ECHO_C" >&6 if test "${ac_cv_func_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gethostbyname to an innocuous variant, in case declares gethostbyname. For example, HP-UX 11i declares gettimeofday. */ #define gethostbyname innocuous_gethostbyname /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gethostbyname /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyname (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) choke me #else char (*f) () = gethostbyname; #endif #ifdef __cplusplus } #endif int main () { return f != gethostbyname; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gethostbyname=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_func_gethostbyname" >&6 if test $ac_cv_func_gethostbyname = yes; then : else echo "$as_me:$LINENO: checking for gethostbyname in -lnsl" >&5 echo $ECHO_N "checking for gethostbyname in -lnsl... $ECHO_C" >&6 if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnsl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyname (); int main () { gethostbyname (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_nsl_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_nsl_gethostbyname=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_nsl_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_lib_nsl_gethostbyname" >&6 if test $ac_cv_lib_nsl_gethostbyname = yes; then LIBS="$LIBS -lnsl" fi fi # Add the threads support libraries LIBS="$LIBS$THREADS_LIBS" echo "$as_me:$LINENO: checking how to build libraries" >&5 echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes fi; if test "$tcl_ok" = "yes" ; then echo "$as_me:$LINENO: result: shared" >&5 echo "${ECHO_T}shared" >&6 SHARED_BUILD=1 else echo "$as_me:$LINENO: result: static" >&5 echo "${ECHO_T}static" >&6 SHARED_BUILD=0 cat >>confdefs.h <<\_ACEOF #define STATIC_BUILD 1 _ACEOF fi #-------------------------------------------------------------------- # Look for a native installed tclsh binary (if available) # If one cannot be found then use the binary we build (fails for # cross compiling). This is used for NATIVE_TCLSH in Makefile. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for tclsh" >&5 echo $ECHO_N "checking for tclsh... $ECHO_C" >&6 if test "${ac_cv_path_tclsh+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[8-9]* 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done fi if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" echo "$as_me:$LINENO: result: $TCLSH_PROG" >&5 echo "${ECHO_T}$TCLSH_PROG" >&6 else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" echo "$as_me:$LINENO: result: No tclsh found on PATH" >&5 echo "${ECHO_T}No tclsh found on PATH" >&6 fi if test "$TCLSH_PROG" = ""; then TCLSH_PROG='./${TCL_EXE}' fi #------------------------------------------------------------------------ # Add stuff for zlib #------------------------------------------------------------------------ zlib_ok=yes if test "${ac_cv_header_zlib_h+set}" = set; then echo "$as_me:$LINENO: checking for zlib.h" >&5 echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6 if test "${ac_cv_header_zlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 echo "${ECHO_T}$ac_cv_header_zlib_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking zlib.h usability" >&5 echo $ECHO_N "checking zlib.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking zlib.h presence" >&5 echo $ECHO_N "checking zlib.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: zlib.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: zlib.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: zlib.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: zlib.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: zlib.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: zlib.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: zlib.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for zlib.h" >&5 echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6 if test "${ac_cv_header_zlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_zlib_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 echo "${ECHO_T}$ac_cv_header_zlib_h" >&6 fi if test $ac_cv_header_zlib_h = yes; then echo "$as_me:$LINENO: checking for gz_header" >&5 echo $ECHO_N "checking for gz_header... $ECHO_C" >&6 if test "${ac_cv_type_gz_header+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { if ((gz_header *) 0) return 0; if (sizeof (gz_header)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_gz_header=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_gz_header=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_gz_header" >&5 echo "${ECHO_T}$ac_cv_type_gz_header" >&6 if test $ac_cv_type_gz_header = yes; then : else zlib_ok=no fi else zlib_ok=no fi if test $zlib_ok = yes; then echo "$as_me:$LINENO: checking for library containing deflateSetHeader" >&5 echo $ECHO_N "checking for library containing deflateSetHeader... $ECHO_C" >&6 if test "${ac_cv_search_deflateSetHeader+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_func_search_save_LIBS=$LIBS ac_cv_search_deflateSetHeader=no cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char deflateSetHeader (); int main () { deflateSetHeader (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_search_deflateSetHeader="none required" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test "$ac_cv_search_deflateSetHeader" = no; then for ac_lib in z; do LIBS="-l$ac_lib $ac_func_search_save_LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char deflateSetHeader (); int main () { deflateSetHeader (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_search_deflateSetHeader="-l$ac_lib" break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext done fi LIBS=$ac_func_search_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_search_deflateSetHeader" >&5 echo "${ECHO_T}$ac_cv_search_deflateSetHeader" >&6 if test "$ac_cv_search_deflateSetHeader" != no; then test "$ac_cv_search_deflateSetHeader" = "none required" || LIBS="$ac_cv_search_deflateSetHeader $LIBS" else zlib_ok=no fi fi if test $zlib_ok = no; then ZLIB_OBJS=\${ZLIB_OBJS} ZLIB_SRCS=\${ZLIB_SRCS} ZLIB_INCLUDE=-I\${ZLIB_DIR} fi cat >>confdefs.h <<\_ACEOF #define HAVE_ZLIB 1 _ACEOF #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then echo "$as_me:$LINENO: result: $RANLIB" >&5 echo "${ECHO_T}$RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":" fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 echo "${ECHO_T}$ac_ct_RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi # Step 0.a: Enable 64 bit support? echo "$as_me:$LINENO: checking if 64bit support is requested" >&5 echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" do64bit=$enableval else do64bit=no fi; echo "$as_me:$LINENO: result: $do64bit" >&5 echo "${ECHO_T}$do64bit" >&6 # Step 0.b: Enable Solaris 64 bit VIS support? echo "$as_me:$LINENO: checking if 64bit Sparc VIS support is requested" >&5 echo $ECHO_N "checking if 64bit Sparc VIS support is requested... $ECHO_C" >&6 # Check whether --enable-64bit-vis or --disable-64bit-vis was given. if test "${enable_64bit_vis+set}" = set; then enableval="$enable_64bit_vis" do64bitVIS=$enableval else do64bitVIS=no fi; echo "$as_me:$LINENO: result: $do64bitVIS" >&5 echo "${ECHO_T}$do64bitVIS" >&6 # Force 64bit on with VIS if test "$do64bitVIS" = "yes"; then do64bit=yes fi # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. echo "$as_me:$LINENO: checking if compiler supports visibility \"hidden\"" >&5 echo $ECHO_N "checking if compiler supports visibility \"hidden\"... $ECHO_C" >&6 if test "${tcl_cv_cc_visibility_hidden+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {} int main () { f(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_visibility_hidden=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_visibility_hidden=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 if test $tcl_cv_cc_visibility_hidden = yes; then cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE extern __attribute__((__visibility__("hidden"))) _ACEOF cat >>confdefs.h <<\_ACEOF #define HAVE_HIDDEN 1 _ACEOF fi # Step 0.d: Disable -rpath support? echo "$as_me:$LINENO: checking if rpath support is requested" >&5 echo $ECHO_N "checking if rpath support is requested... $ECHO_C" >&6 # Check whether --enable-rpath or --disable-rpath was given. if test "${enable_rpath+set}" = set; then enableval="$enable_rpath" doRpath=$enableval else doRpath=yes fi; echo "$as_me:$LINENO: result: $doRpath" >&5 echo "${ECHO_T}$doRpath" >&6 # Step 1: set the variable "system" to hold the name and version number # for the system. echo "$as_me:$LINENO: checking system version" >&5 echo $ECHO_N "checking system version... $ECHO_C" >&6 if test "${tcl_cv_sys_version+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -f /usr/lib/NextStep/software_version; then tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then tcl_cv_sys_version=MP-RAS-`awk '{print $3}' /etc/.relid` fi if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then tcl_cv_sys_version=NetBSD-Debian fi fi fi fi echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 echo "${ECHO_T}$tcl_cv_sys_version" >&6 system=$tcl_cv_sys_version # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6 if test "${ac_cv_lib_dl_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char dlopen (); int main () { dlopen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dl_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dl_dlopen=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6 if test $ac_cv_lib_dl_dlopen = yes; then have_dl=yes else have_dl=no fi # Require ranlib early so we can override it in special cases below. # Step 3: set configuration options based on system name and version. do64bit_ok=no # default to '{$LIBS}' and set to "" on per-platform necessary basis SHLIB_LD_LIBS='${LIBS}' LDFLAGS_ORIG="$LDFLAGS" # When ld needs options to work in 64-bit mode, put them in # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] # is disabled by the user. [Bug 1016796] LDFLAGS_ARCH="" UNSHARED_LIB_SUFFIX="" TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`' ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g if test "$GCC" = yes; then CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall -Wpointer-arith" else CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 echo "${ECHO_T}$ac_ct_AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi AR=$ac_ct_AR else AR="$ac_cv_prog_AR" fi STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" if test "x${SHLIB_VERSION}" = x; then SHLIB_VERSION=".1.0" else SHLIB_VERSION=".${SHLIB_VERSION}" fi case $system in AIX-*) if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then # AIX requires the _r compiler when gcc isn't being used case "${CC}" in *_r|*_r\ *) # ok ... ;; *) # Make sure only first arg gets _r CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'` ;; esac echo "$as_me:$LINENO: result: Using $CC for compiling with threads" >&5 echo "${ECHO_T}Using $CC for compiling with threads" >&6 fi LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" LD_LIBRARY_PATH_VAR="LIBPATH" # ldAix No longer needed with use of -bexpall/-brtl # but some extensions may still reference it LDAIX_SRC='$(UNIX_DIR)/ldAix' # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then if test "$GCC" = yes; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} else do64bit_ok=yes CFLAGS="$CFLAGS -q64" LDFLAGS_ARCH="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" fi fi if test "`uname -m`" = ia64; then # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" if test "$GCC" = yes; then CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' else CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' else if test "$GCC" = yes; then SHLIB_LD='${CC} -shared -Wl,-bexpall' else SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" LDFLAGS="$LDFLAGS -brtl" fi SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi ;; BeOS*) SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -nostart' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" #----------------------------------------------------------- # Check for inet_ntoa in -lbind, for BeOS (which also needs # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- echo "$as_me:$LINENO: checking for inet_ntoa in -lbind" >&5 echo $ECHO_N "checking for inet_ntoa in -lbind... $ECHO_C" >&6 if test "${ac_cv_lib_bind_inet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lbind $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { inet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_bind_inet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_bind_inet_ntoa=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_bind_inet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_bind_inet_ntoa" >&6 if test $ac_cv_lib_bind_inet_ntoa = yes; then LIBS="$LIBS -lbind -lsocket" fi ;; BSD/OS-2.1*|BSD/OS-3*) SHLIB_CFLAGS="" SHLIB_LD="shlicc -r" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; BSD/OS-4.*) SHLIB_CFLAGS="-export-dynamic -fPIC" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32_*|MSYS_*) SHLIB_CFLAGS="-fno-common" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5 echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6 if test "${ac_cv_cygwin+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __CYGWIN__ #error cygwin #endif int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_cygwin=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_cygwin=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5 echo "${ECHO_T}$ac_cv_cygwin" >&6 if test "$ac_cv_cygwin" = "no"; then { { echo "$as_me:$LINENO: error: ${CC} is not a cygwin compiler." >&5 echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;} { (exit 1); exit 1; }; } fi if test "x${TCL_THREADS}" = "x0"; then { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5 echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;} { (exit 1); exit 1; }; } fi do64bit_ok=yes if test "x${SHARED_BUILD}" = "x1"; then echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32" # The eval makes quoting arguments work. if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32; cd ../unix then : else { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } fi fi ;; dgux*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" echo "$as_me:$LINENO: checking for inet_ntoa in -lnetwork" >&5 echo $ECHO_N "checking for inet_ntoa in -lnetwork... $ECHO_C" >&6 if test "${ac_cv_lib_network_inet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnetwork $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { inet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_network_inet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_network_inet_ntoa=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_network_inet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_network_inet_ntoa" >&6 if test $ac_cv_lib_network_inet_ntoa = yes; then LIBS="$LIBS -lnetwork" fi ;; HP-UX-*.11.*) # Use updated header definitions where possible cat >>confdefs.h <<\_ACEOF #define _XOPEN_SOURCE_EXTENDED 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _XOPEN_SOURCE 1 _ACEOF LIBS="$LIBS -lxnet" # Use the XOPEN network library if test "`uname -m`" = ia64; then SHLIB_SUFFIX=".so" else SHLIB_SUFFIX=".sl" fi echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 if test "${ac_cv_lib_dld_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char shl_load (); int main () { shl_load (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_shl_load=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else CFLAGS="$CFLAGS -z" fi # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes"; then if test "$GCC" = yes; then case `${CC} -dumpmachine` in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} ;; esac else do64bit_ok=yes CFLAGS="$CFLAGS +DD64" LDFLAGS_ARCH="+DD64" fi fi ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 if test "${ac_cv_lib_dld_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char shl_load (); int main () { shl_load (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_shl_load=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" SHLIB_LD_LIBS="" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi ;; IRIX-5.*) SHLIB_CFLAGS="" SHLIB_LD="ld -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" case $LIBOBJS in "mkstemp.$ac_objext" | \ *" mkstemp.$ac_objext" | \ "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi ;; IRIX-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" case $LIBOBJS in "mkstemp.$ac_objext" | \ *" mkstemp.$ac_objext" | \ "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes; then CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" else case $system in IRIX-6.3) # Use to build 6.2 compatible binaries on 6.3. CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" ;; *) CFLAGS="$CFLAGS -n32" ;; esac LDFLAGS="$LDFLAGS -n32" fi ;; IRIX64-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" case $LIBOBJS in "mkstemp.$ac_objext" | \ *" mkstemp.$ac_objext" | \ "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then if test "$GCC" = yes; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported by gcc" >&5 echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} else do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" fi fi ;; Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*) SHLIB_CFLAGS="-fPIC -fno-common" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" case $system in DragonFly-*|FreeBSD-*) if test "${TCL_THREADS}" = "1"; then # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS" fi ;; esac if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "`uname -m`" = "alpha"; then CFLAGS="$CFLAGS -mieee" fi if test $do64bit = yes; then echo "$as_me:$LINENO: checking if compiler accepts -m64 flag" >&5 echo $ECHO_N "checking if compiler accepts -m64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_m64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_m64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_m64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_m64" >&5 echo "${ECHO_T}$tcl_cv_cc_m64" >&6 if test $tcl_cv_cc_m64 = yes; then CFLAGS="$CFLAGS -m64" do64bit_ok=yes fi fi # The combo of gcc + glibc has a bug related to inlining of # functions like strtod(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. if test x"${USE_COMPAT}" != x; then CFLAGS="$CFLAGS -fno-inline" fi ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE=-02 SHLIB_LD='${CC} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi ;; MP-RAS-02*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; MP-RAS-*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,-Bexport" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OpenBSD-*) arch=`arch -s` case "$arch" in alpha|sparc64) SHLIB_CFLAGS="-fPIC" ;; *) SHLIB_CFLAGS="-fpic" ;; esac SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" CFLAGS_OPTIMIZE="-O2" if test "${TCL_THREADS}" = "1"; then # On OpenBSD: Compile with -pthread # Don't link with -lpthread LIBS=`echo $LIBS | sed s/-lpthread//` CFLAGS="$CFLAGS -pthread" fi # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "${TCL_THREADS}" = "1"; then # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi ;; Darwin-*) CFLAGS_OPTIMIZE="-O2" SHLIB_CFLAGS="-fno-common" # To avoid discrepancies between what headers configure sees during # preprocessing tests and compiling tests, move any -isysroot and # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if ($i~/^(isysroot|mmacosx-version-min)/) print "-"$i}'`" CFLAGS="`echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if (!($i~/^(isysroot|mmacosx-version-min)/)) print "-"$i}'`" if test $do64bit = yes; then case `arch` in ppc) echo "$as_me:$LINENO: checking if compiler accepts -arch ppc64 flag" >&5 echo $ECHO_N "checking if compiler accepts -arch ppc64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_arch_ppc64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_arch_ppc64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_arch_ppc64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_ppc64" >&5 echo "${ECHO_T}$tcl_cv_cc_arch_ppc64" >&6 if test $tcl_cv_cc_arch_ppc64 = yes; then CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes fi ;; i386|x86_64) echo "$as_me:$LINENO: checking if compiler accepts -arch x86_64 flag" >&5 echo $ECHO_N "checking if compiler accepts -arch x86_64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_arch_x86_64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_arch_x86_64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_arch_x86_64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_x86_64" >&5 echo "${ECHO_T}$tcl_cv_cc_arch_x86_64" >&6 if test $tcl_cv_cc_arch_x86_64 = yes; then CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes fi ;; arm64) echo "$as_me:$LINENO: checking if compiler accepts -arch arm64 flag" >&5 echo $ECHO_N "checking if compiler accepts -arch arm64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_arch_arm64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch arm64" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_arch_arm64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_arch_arm64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_arm64" >&5 echo "${ECHO_T}$tcl_cv_cc_arch_arm64" >&6 if test $tcl_cv_cc_arch_arm64 = yes; then CFLAGS="$CFLAGS -arch arm64" do64bit_ok=yes fi ;; *) { echo "$as_me:$LINENO: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; esac else # Check for combined 32-bit and 64-bit fat build if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64|arm64) ' \ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then fat_32_64=yes fi fi SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' echo "$as_me:$LINENO: checking if ld accepts -single_module flag" >&5 echo $ECHO_N "checking if ld accepts -single_module flag... $ECHO_C" >&6 if test "${tcl_cv_ld_single_module+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_single_module=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_single_module=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_single_module" >&5 echo "${ECHO_T}$tcl_cv_ld_single_module" >&6 if test $tcl_cv_ld_single_module = yes; then SHLIB_LD="${SHLIB_LD} -Wl,-single_module" fi SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" LDFLAGS="$LDFLAGS -headerpad_max_install_names" echo "$as_me:$LINENO: checking if ld accepts -search_paths_first flag" >&5 echo $ECHO_N "checking if ld accepts -search_paths_first flag... $ECHO_C" >&6 if test "${tcl_cv_ld_search_paths_first+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_search_paths_first=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_search_paths_first=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_search_paths_first" >&5 echo "${ECHO_T}$tcl_cv_ld_search_paths_first" >&6 if test $tcl_cv_ld_search_paths_first = yes; then LDFLAGS="$LDFLAGS -Wl,-search_paths_first" fi if test "$tcl_cv_cc_visibility_hidden" != yes; then cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE __private_extern__ _ACEOF tcl_cv_cc_visibility_hidden=yes fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_FALLBACK_LIBRARY_PATH" cat >>confdefs.h <<\_ACEOF #define MAC_OSX_TCL 1 _ACEOF PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' echo "$as_me:$LINENO: checking whether to use CoreFoundation" >&5 echo $ECHO_N "checking whether to use CoreFoundation... $ECHO_C" >&6 # Check whether --enable-corefoundation or --disable-corefoundation was given. if test "${enable_corefoundation+set}" = set; then enableval="$enable_corefoundation" tcl_corefoundation=$enableval else tcl_corefoundation=yes fi; echo "$as_me:$LINENO: result: $tcl_corefoundation" >&5 echo "${ECHO_T}$tcl_corefoundation" >&6 if test $tcl_corefoundation = yes; then echo "$as_me:$LINENO: checking for CoreFoundation.framework" >&5 echo $ECHO_N "checking for CoreFoundation.framework... $ECHO_C" >&6 if test "${tcl_cv_lib_corefoundation+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_libs=$LIBS if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit # archs from CFLAGS et al. while testing for # presence of CF. 64-bit CF is disabled in # tclUnixPort.h if necessary. eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done fi LIBS="$LIBS -framework CoreFoundation" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { CFBundleRef b = CFBundleGetMainBundle(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_lib_corefoundation=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_lib_corefoundation=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi LIBS=$hold_libs fi echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation" >&5 echo "${ECHO_T}$tcl_cv_lib_corefoundation" >&6 if test $tcl_cv_lib_corefoundation = yes; then LIBS="$LIBS -framework CoreFoundation" cat >>confdefs.h <<\_ACEOF #define HAVE_COREFOUNDATION 1 _ACEOF else tcl_corefoundation=no fi if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then echo "$as_me:$LINENO: checking for 64-bit CoreFoundation" >&5 echo $ECHO_N "checking for 64-bit CoreFoundation... $ECHO_C" >&6 if test "${tcl_cv_lib_corefoundation_64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { CFBundleRef b = CFBundleGetMainBundle(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_lib_corefoundation_64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_lib_corefoundation_64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation_64" >&5 echo "${ECHO_T}$tcl_cv_lib_corefoundation_64" >&6 if test $tcl_cv_lib_corefoundation_64 = no; then cat >>confdefs.h <<\_ACEOF #define NO_COREFOUNDATION_64 1 _ACEOF LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" fi fi fi ;; NEXTSTEP-*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -nostdlib -r' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadNext.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OS/390-*) SHLIB_LD_LIBS="" CFLAGS_OPTIMIZE="" # Optimizer is buggy cat >>confdefs.h <<\_ACEOF #define _OE_SOCKETS 1 _ACEOF ;; OSF1-1.0|OSF1-1.1|OSF1-1.2) # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1 SHLIB_CFLAGS="" # Hack: make package name same as library name SHLIB_LD='ld -R -export :' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadOSF.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-1.*) # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2 SHLIB_CFLAGS="-fPIC" if test "$SHARED_BUILD" = 1; then SHLIB_LD="ld -shared" else SHLIB_LD="ld -non_shared" fi SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" if test "$SHARED_BUILD" = 1; then SHLIB_LD='${CC} -shared' else SHLIB_LD='${CC} -non_shared' fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes; then CFLAGS="$CFLAGS -mieee" else CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" fi # see pthread_intro(3) for pthread support on osf1, k.furukawa if test "${TCL_THREADS}" = 1; then CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` if test "$GCC" = yes; then LIBS="$LIBS -lpthread -lmach -lexc" else CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi fi ;; QNX-6*) # QNX RTP # This may work for all QNX, but it was only reported for v6. SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" # dlopen is in -lc on QNX DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. if test "$GCC" = yes; then SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" else SHLIB_CFLAGS="-Kpic -belf" LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" fi SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SINIX*5.4*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SunOS-4*) SHLIB_CFLAGS="-PIC" SHLIB_LD="ld" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} # SunOS can't handle version numbers with dots in them in library # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it # requires an extra version number at the end of .so file names. # So, the library has to have a name like libtcl75.so.1.0 SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; SunOS-5.[0-6]) # Careful to not let 5.10+ fall into this case # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF SHLIB_CFLAGS="-KPIC" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF SHLIB_CFLAGS="-KPIC" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then arch=`isainfo` if test "$arch" = "sparcv9 sparc"; then if test "$GCC" = yes; then if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} else do64bit_ok=yes CFLAGS="$CFLAGS -m64 -mcpu=v9" LDFLAGS="$LDFLAGS -m64 -mcpu=v9" SHLIB_CFLAGS="-fPIC" fi else do64bit_ok=yes if test "$do64bitVIS" = yes; then CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" else CFLAGS="$CFLAGS -xarch=v9" LDFLAGS_ARCH="-xarch=v9" fi # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" fi else if test "$arch" = "amd64 i386"; then if test "$GCC" = yes; then case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) do64bit_ok=yes CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; esac else do64bit_ok=yes case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) CFLAGS="$CFLAGS -xarch=amd64" LDFLAGS="$LDFLAGS -xarch=amd64";; esac fi else { echo "$as_me:$LINENO: WARNING: 64bit mode not supported for $arch" >&5 echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} fi fi fi #-------------------------------------------------------------------- # On Solaris 5.x i386 with the sunpro compiler we need to link # with sunmath to get floating point rounding control #-------------------------------------------------------------------- if test "$GCC" = yes; then use_sunmath=no else arch=`isainfo` echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5 echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6 if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MATH_LIBS="-lsunmath $MATH_LIBS" if test "${ac_cv_header_sunmath_h+set}" = set; then echo "$as_me:$LINENO: checking for sunmath.h" >&5 echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 if test "${ac_cv_header_sunmath_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sunmath.h usability" >&5 echo $ECHO_N "checking sunmath.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sunmath.h presence" >&5 echo $ECHO_N "checking sunmath.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: sunmath.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: sunmath.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sunmath.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sunmath.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: sunmath.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sunmath.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: sunmath.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sunmath.h" >&5 echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 if test "${ac_cv_header_sunmath_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sunmath_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 fi use_sunmath=yes else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 use_sunmath=no fi fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "$do64bit_ok" = yes; then if test "$arch" = "sparcv9 sparc"; then # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" # for finding sparcv9 libgcc, get the regular libgcc # path, remove so name and append 'sparcv9' #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" else if test "$arch" = "amd64 i386"; then SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" fi fi fi else if test "$use_sunmath" = yes; then textmode=textoff else textmode=text fi case $system in SunOS-5.[1-9][0-9]*|SunOS-5.[7-9]) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; esac CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' fi ;; UNIX_SV* | UnixWare-5*) SHLIB_CFLAGS="-KPIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. echo "$as_me:$LINENO: checking for ld accepts -Bexport flag" >&5 echo $ECHO_N "checking for ld accepts -Bexport flag... $ECHO_C" >&6 if test "${tcl_cv_ld_Bexport+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_Bexport=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_Bexport=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_Bexport" >&5 echo "${ECHO_T}$tcl_cv_ld_Bexport" >&6 if test $tcl_cv_ld_Bexport = yes; then LDFLAGS="$LDFLAGS -Wl,-Bexport" fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac if test "$do64bit" = yes -a "$do64bit_ok" = no; then { echo "$as_me:$LINENO: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} fi if test "$do64bit" = yes -a "$do64bit_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define TCL_CFG_DO64BIT 1 _ACEOF fi # Step 4: disable dynamic loading if requested via a command-line switch. # Check whether --enable-load or --disable-load was given. if test "${enable_load+set}" = set; then enableval="$enable_load" tcl_ok=$enableval else tcl_ok=yes fi; if test "$tcl_ok" = no; then DL_OBJS="" fi if test "x$DL_OBJS" != x; then BUILD_DLTEST="\$(DLTEST_TARGETS)" else { echo "$as_me:$LINENO: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" DL_OBJS="tclLoadNone.o" DL_LIBS="" LDFLAGS="$LDFLAGS_ORIG" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" BUILD_DLTEST="" fi LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then case $system in AIX-*) ;; BSD/OS*) ;; CYGWIN_*|MINGW32_*|MSYS_*) ;; HP-UX*) ;; Darwin-*) ;; IRIX*) ;; NetBSD-*|OpenBSD-*) ;; OSF1-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac fi if test "$tcl_cv_cc_visibility_hidden" != yes; then cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE extern _ACEOF fi if test "$SHARED_LIB_SUFFIX" = ""; then SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}' fi if test "$UNSHARED_LIB_SUFFIX" = ""; then UNSHARED_LIB_SUFFIX='${VERSION}.a' fi DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' if test "${SHLIB_SUFFIX}" = ".dll"; then INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" else INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi else LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} if test "$RANLIB" = ""; then MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' else MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@' fi INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi # Stub lib does not depend on shared/static configuration if test "$RANLIB" = ""; then MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' else MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@' fi INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. if test "x${TCL_LIBS}" = x; then TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}" fi # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. echo "$as_me:$LINENO: checking for cast to union support" >&5 echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 if test "${tcl_cv_cast_to_union+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { union foo { int i; double d; }; union foo f = (union foo) (int) 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cast_to_union=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cast_to_union=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 if test "$tcl_cv_cast_to_union" = "yes"; then cat >>confdefs.h <<\_ACEOF #define HAVE_CAST_TO_UNION 1 _ACEOF fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" echo "$as_me:$LINENO: checking for working -fno-lto" >&5 echo $ECHO_N "checking for working -fno-lto... $ECHO_C" >&6 if test "${ac_cv_nolto+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_nolto=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_nolto=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_nolto" >&5 echo "${ECHO_T}$ac_cv_nolto" >&6 CFLAGS=$hold_cflags if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi # Check for vfork, posix_spawnp() and friends unconditionally for ac_func in vfork posix_spawnp posix_spawn_file_actions_adddup2 posix_spawnattr_setflags do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. cat >>confdefs.h <<_ACEOF #define TCL_SHLIB_EXT "${SHLIB_SUFFIX}" _ACEOF echo "$as_me:$LINENO: checking for build with symbols" >&5 echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" tcl_ok=$enableval else tcl_ok=no fi; # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' cat >>confdefs.h <<\_ACEOF #define NDEBUG 1 _ACEOF echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 cat >>confdefs.h <<\_ACEOF #define TCL_CFG_OPTIMIZED 1 _ACEOF else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 echo "${ECHO_T}yes (standard debugging)" >&6 fi fi if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then cat >>confdefs.h <<\_ACEOF #define TCL_MEM_DEBUG 1 _ACEOF fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_DEBUG 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_STATS 1 _ACEOF fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5 echo "${ECHO_T}enabled symbols mem compile debugging" >&6 else echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5 echo "${ECHO_T}enabled $tcl_ok debugging" >&6 fi fi cat >>confdefs.h <<\_ACEOF #define TCL_TOMMATH 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define MP_PREC 4 _ACEOF #-------------------------------------------------------------------- # Detect what compiler flags to set for 64-bit support. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for required early compiler flags" >&5 echo $ECHO_N "checking for required early compiler flags... $ECHO_C" >&6 tcl_flags="" if test "${tcl_cv_flag__isoc99_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *p = (char *)strtoll; char *q = (char *)strtoull; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__isoc99_source=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _ISOC99_SOURCE 1 #include int main () { char *p = (char *)strtoll; char *q = (char *)strtoull; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__isoc99_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_flag__isoc99_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define _ISOC99_SOURCE 1 _ACEOF tcl_flags="$tcl_flags _ISOC99_SOURCE" fi if test "${tcl_cv_flag__largefile64_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__largefile64_source=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _LARGEFILE64_SOURCE 1 #include int main () { struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__largefile64_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_flag__largefile64_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define _LARGEFILE64_SOURCE 1 _ACEOF tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" fi if test "x${tcl_flags}" = "x" ; then echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 else echo "$as_me:$LINENO: result: ${tcl_flags}" >&5 echo "${ECHO_T}${tcl_flags}" >&6 fi echo "$as_me:$LINENO: checking for 64-bit integer type" >&5 echo $ECHO_N "checking for 64-bit integer type... $ECHO_C" >&6 if test "${tcl_cv_type_64bit+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { __int64 value = (__int64) 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_type_64bit=__int64 else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_type_64bit="long long" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # See if we should use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { switch (0) { case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; } ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_64bit=${tcl_type_64bit} else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "${tcl_cv_type_64bit}" = none ; then cat >>confdefs.h <<\_ACEOF #define TCL_WIDE_INT_IS_LONG 1 _ACEOF echo "$as_me:$LINENO: result: using long" >&5 echo "${ECHO_T}using long" >&6 else cat >>confdefs.h <<_ACEOF #define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit} _ACEOF echo "$as_me:$LINENO: result: ${tcl_cv_type_64bit}" >&5 echo "${ECHO_T}${tcl_cv_type_64bit}" >&6 # Now check for auxiliary declarations echo "$as_me:$LINENO: checking for struct dirent64" >&5 echo $ECHO_N "checking for struct dirent64... $ECHO_C" >&6 if test "${tcl_cv_struct_dirent64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct dirent64 p; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_struct_dirent64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_struct_dirent64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_struct_dirent64" >&5 echo "${ECHO_T}$tcl_cv_struct_dirent64" >&6 if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_STRUCT_DIRENT64 1 _ACEOF fi echo "$as_me:$LINENO: checking for DIR64" >&5 echo $ECHO_N "checking for DIR64... $ECHO_C" >&6 if test "${tcl_cv_DIR64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct dirent64 *p; DIR64 d = opendir64("."); p = readdir64(d); rewinddir64(d); closedir64(d); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_DIR64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_DIR64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_DIR64" >&5 echo "${ECHO_T}$tcl_cv_DIR64" >&6 if test "x${tcl_cv_DIR64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_DIR64 1 _ACEOF fi echo "$as_me:$LINENO: checking for struct stat64" >&5 echo $ECHO_N "checking for struct stat64... $ECHO_C" >&6 if test "${tcl_cv_struct_stat64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct stat64 p; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_struct_stat64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_struct_stat64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_struct_stat64" >&5 echo "${ECHO_T}$tcl_cv_struct_stat64" >&6 if test "x${tcl_cv_struct_stat64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_STRUCT_STAT64 1 _ACEOF fi for ac_func in open64 lseek64 do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking for off64_t" >&5 echo $ECHO_N "checking for off64_t... $ECHO_C" >&6 if test "${tcl_cv_type_off64_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { off64_t offset; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_off64_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_type_off64_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TYPE_OFF64_T 1 _ACEOF echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi #-------------------------------------------------------------------- # Check endianness because we can optimize comparisons of # Tcl_UniChar strings to memcmp on big-endian systems. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6 if test "${ac_cv_c_bigendian+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # See if sys/param.h defines the BYTE_ORDER macro. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN bogus endian macros #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then # It does; now see whether it defined to BIG_ENDIAN or not. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if BYTE_ORDER != BIG_ENDIAN not big endian #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_bigendian=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # It does not; compile a test program. if test "$cross_compiling" = yes; then # try to guess the endianness by grepping values into an object file ac_cv_c_bigendian=unknown cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } int main () { _ascii (); _ebcdic (); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then ac_cv_c_bigendian=yes fi if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then if test "$ac_cv_c_bigendian" = unknown; then ac_cv_c_bigendian=no else # finding both strings is unlikely to happen, but who knows? ac_cv_c_bigendian=unknown fi fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* Are we little or big endian? From Harbison&Steele. */ union { long l; char c[sizeof (long)]; } u; u.l = 1; exit (u.c[sizeof (long) - 1] == 1); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_c_bigendian=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 echo "${ECHO_T}$ac_cv_c_bigendian" >&6 case $ac_cv_c_bigendian in yes) cat >>confdefs.h <<\_ACEOF #define WORDS_BIGENDIAN 1 _ACEOF ;; no) ;; *) { { echo "$as_me:$LINENO: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&5 echo "$as_me: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&2;} { (exit 1); exit 1; }; } ;; esac #-------------------------------------------------------------------- # Supply substitutes for missing POSIX library procedures, or # set flags so Tcl uses alternate procedures. #-------------------------------------------------------------------- # Check if Posix compliant getcwd exists, if not we'll use getwd. for ac_func in getcwd do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF else cat >>confdefs.h <<\_ACEOF #define USEGETWD 1 _ACEOF fi done # Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really # define USEGETWD even if the Posix getcwd exists. Add a test ? for ac_func in mkstemp opendir strtol waitpid do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF else case $LIBOBJS in "$ac_func.$ac_objext" | \ *" $ac_func.$ac_objext" | \ "$ac_func.$ac_objext "* | \ *" $ac_func.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS $ac_func.$ac_objext" ;; esac fi done echo "$as_me:$LINENO: checking for strerror" >&5 echo $ECHO_N "checking for strerror... $ECHO_C" >&6 if test "${ac_cv_func_strerror+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strerror to an innocuous variant, in case declares strerror. For example, HP-UX 11i declares gettimeofday. */ #define strerror innocuous_strerror /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strerror (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strerror /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strerror (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strerror) || defined (__stub___strerror) choke me #else char (*f) () = strerror; #endif #ifdef __cplusplus } #endif int main () { return f != strerror; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strerror=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strerror=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strerror" >&5 echo "${ECHO_T}$ac_cv_func_strerror" >&6 if test $ac_cv_func_strerror = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_STRERROR 1 _ACEOF fi echo "$as_me:$LINENO: checking for getwd" >&5 echo $ECHO_N "checking for getwd... $ECHO_C" >&6 if test "${ac_cv_func_getwd+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getwd to an innocuous variant, in case declares getwd. For example, HP-UX 11i declares gettimeofday. */ #define getwd innocuous_getwd /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getwd (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getwd /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getwd (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getwd) || defined (__stub___getwd) choke me #else char (*f) () = getwd; #endif #ifdef __cplusplus } #endif int main () { return f != getwd; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getwd=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getwd=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getwd" >&5 echo "${ECHO_T}$ac_cv_func_getwd" >&6 if test $ac_cv_func_getwd = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_GETWD 1 _ACEOF fi echo "$as_me:$LINENO: checking for wait3" >&5 echo $ECHO_N "checking for wait3... $ECHO_C" >&6 if test "${ac_cv_func_wait3+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define wait3 to an innocuous variant, in case declares wait3. For example, HP-UX 11i declares gettimeofday. */ #define wait3 innocuous_wait3 /* System header to define __stub macros and hopefully few prototypes, which can conflict with char wait3 (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef wait3 /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char wait3 (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_wait3) || defined (__stub___wait3) choke me #else char (*f) () = wait3; #endif #ifdef __cplusplus } #endif int main () { return f != wait3; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_wait3=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_wait3=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_wait3" >&5 echo "${ECHO_T}$ac_cv_func_wait3" >&6 if test $ac_cv_func_wait3 = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_WAIT3 1 _ACEOF fi echo "$as_me:$LINENO: checking for fork" >&5 echo $ECHO_N "checking for fork... $ECHO_C" >&6 if test "${ac_cv_func_fork+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define fork to an innocuous variant, in case declares fork. For example, HP-UX 11i declares gettimeofday. */ #define fork innocuous_fork /* System header to define __stub macros and hopefully few prototypes, which can conflict with char fork (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef fork /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char fork (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_fork) || defined (__stub___fork) choke me #else char (*f) () = fork; #endif #ifdef __cplusplus } #endif int main () { return f != fork; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_fork=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_fork=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_fork" >&5 echo "${ECHO_T}$ac_cv_func_fork" >&6 if test $ac_cv_func_fork = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_FORK 1 _ACEOF fi echo "$as_me:$LINENO: checking for mknod" >&5 echo $ECHO_N "checking for mknod... $ECHO_C" >&6 if test "${ac_cv_func_mknod+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define mknod to an innocuous variant, in case declares mknod. For example, HP-UX 11i declares gettimeofday. */ #define mknod innocuous_mknod /* System header to define __stub macros and hopefully few prototypes, which can conflict with char mknod (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef mknod /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char mknod (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_mknod) || defined (__stub___mknod) choke me #else char (*f) () = mknod; #endif #ifdef __cplusplus } #endif int main () { return f != mknod; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_mknod=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_mknod=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_mknod" >&5 echo "${ECHO_T}$ac_cv_func_mknod" >&6 if test $ac_cv_func_mknod = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_MKNOD 1 _ACEOF fi echo "$as_me:$LINENO: checking for tcdrain" >&5 echo $ECHO_N "checking for tcdrain... $ECHO_C" >&6 if test "${ac_cv_func_tcdrain+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define tcdrain to an innocuous variant, in case declares tcdrain. For example, HP-UX 11i declares gettimeofday. */ #define tcdrain innocuous_tcdrain /* System header to define __stub macros and hopefully few prototypes, which can conflict with char tcdrain (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef tcdrain /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char tcdrain (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_tcdrain) || defined (__stub___tcdrain) choke me #else char (*f) () = tcdrain; #endif #ifdef __cplusplus } #endif int main () { return f != tcdrain; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_tcdrain=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_tcdrain=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_tcdrain" >&5 echo "${ECHO_T}$ac_cv_func_tcdrain" >&6 if test $ac_cv_func_tcdrain = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_TCDRAIN 1 _ACEOF fi echo "$as_me:$LINENO: checking for uname" >&5 echo $ECHO_N "checking for uname... $ECHO_C" >&6 if test "${ac_cv_func_uname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define uname to an innocuous variant, in case declares uname. For example, HP-UX 11i declares gettimeofday. */ #define uname innocuous_uname /* System header to define __stub macros and hopefully few prototypes, which can conflict with char uname (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef uname /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char uname (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_uname) || defined (__stub___uname) choke me #else char (*f) () = uname; #endif #ifdef __cplusplus } #endif int main () { return f != uname; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_uname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_uname=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_uname" >&5 echo "${ECHO_T}$ac_cv_func_uname" >&6 if test $ac_cv_func_uname = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_UNAME 1 _ACEOF fi if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \ test "`uname -r | awk -F. '{print $1}'`" -lt 7; then # prior to Darwin 7, realpath is not threadsafe, so don't # use it when threads are enabled, c.f. bug # 711232 ac_cv_func_realpath=no fi echo "$as_me:$LINENO: checking for realpath" >&5 echo $ECHO_N "checking for realpath... $ECHO_C" >&6 if test "${ac_cv_func_realpath+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define realpath to an innocuous variant, in case declares realpath. For example, HP-UX 11i declares gettimeofday. */ #define realpath innocuous_realpath /* System header to define __stub macros and hopefully few prototypes, which can conflict with char realpath (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef realpath /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char realpath (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_realpath) || defined (__stub___realpath) choke me #else char (*f) () = realpath; #endif #ifdef __cplusplus } #endif int main () { return f != realpath; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_realpath=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_realpath=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_realpath" >&5 echo "${ECHO_T}$ac_cv_func_realpath" >&6 if test $ac_cv_func_realpath = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_REALPATH 1 _ACEOF fi NEED_FAKE_RFC2553=0 for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF else NEED_FAKE_RFC2553=1 fi done echo "$as_me:$LINENO: checking for struct addrinfo" >&5 echo $ECHO_N "checking for struct addrinfo... $ECHO_C" >&6 if test "${ac_cv_type_struct_addrinfo+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { if ((struct addrinfo *) 0) return 0; if (sizeof (struct addrinfo)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_struct_addrinfo=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_struct_addrinfo=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_struct_addrinfo" >&5 echo "${ECHO_T}$ac_cv_type_struct_addrinfo" >&6 if test $ac_cv_type_struct_addrinfo = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_ADDRINFO 1 _ACEOF else NEED_FAKE_RFC2553=1 fi echo "$as_me:$LINENO: checking for struct in6_addr" >&5 echo $ECHO_N "checking for struct in6_addr... $ECHO_C" >&6 if test "${ac_cv_type_struct_in6_addr+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { if ((struct in6_addr *) 0) return 0; if (sizeof (struct in6_addr)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_struct_in6_addr=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_struct_in6_addr=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_struct_in6_addr" >&5 echo "${ECHO_T}$ac_cv_type_struct_in6_addr" >&6 if test $ac_cv_type_struct_in6_addr = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IN6_ADDR 1 _ACEOF else NEED_FAKE_RFC2553=1 fi echo "$as_me:$LINENO: checking for struct sockaddr_in6" >&5 echo $ECHO_N "checking for struct sockaddr_in6... $ECHO_C" >&6 if test "${ac_cv_type_struct_sockaddr_in6+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { if ((struct sockaddr_in6 *) 0) return 0; if (sizeof (struct sockaddr_in6)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_struct_sockaddr_in6=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_struct_sockaddr_in6=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_in6" >&5 echo "${ECHO_T}$ac_cv_type_struct_sockaddr_in6" >&6 if test $ac_cv_type_struct_sockaddr_in6 = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_SOCKADDR_IN6 1 _ACEOF else NEED_FAKE_RFC2553=1 fi echo "$as_me:$LINENO: checking for struct sockaddr_storage" >&5 echo $ECHO_N "checking for struct sockaddr_storage... $ECHO_C" >&6 if test "${ac_cv_type_struct_sockaddr_storage+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { if ((struct sockaddr_storage *) 0) return 0; if (sizeof (struct sockaddr_storage)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_struct_sockaddr_storage=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_struct_sockaddr_storage=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_storage" >&5 echo "${ECHO_T}$ac_cv_type_struct_sockaddr_storage" >&6 if test $ac_cv_type_struct_sockaddr_storage = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_SOCKADDR_STORAGE 1 _ACEOF else NEED_FAKE_RFC2553=1 fi if test "x$NEED_FAKE_RFC2553" = "x1"; then cat >>confdefs.h <<\_ACEOF #define NEED_FAKE_RFC2553 1 _ACEOF case $LIBOBJS in "fake-rfc2553.$ac_objext" | \ *" fake-rfc2553.$ac_objext" | \ "fake-rfc2553.$ac_objext "* | \ *" fake-rfc2553.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" ;; esac echo "$as_me:$LINENO: checking for strlcpy" >&5 echo $ECHO_N "checking for strlcpy... $ECHO_C" >&6 if test "${ac_cv_func_strlcpy+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strlcpy to an innocuous variant, in case declares strlcpy. For example, HP-UX 11i declares gettimeofday. */ #define strlcpy innocuous_strlcpy /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strlcpy (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strlcpy /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strlcpy (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strlcpy) || defined (__stub___strlcpy) choke me #else char (*f) () = strlcpy; #endif #ifdef __cplusplus } #endif int main () { return f != strlcpy; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strlcpy=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strlcpy=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strlcpy" >&5 echo "${ECHO_T}$ac_cv_func_strlcpy" >&6 fi #-------------------------------------------------------------------- # Look for thread-safe variants of some library functions. #-------------------------------------------------------------------- if test "${TCL_THREADS}" = 1; then echo "$as_me:$LINENO: checking for getpwuid_r" >&5 echo $ECHO_N "checking for getpwuid_r... $ECHO_C" >&6 if test "${ac_cv_func_getpwuid_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getpwuid_r to an innocuous variant, in case declares getpwuid_r. For example, HP-UX 11i declares gettimeofday. */ #define getpwuid_r innocuous_getpwuid_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getpwuid_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getpwuid_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getpwuid_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getpwuid_r) || defined (__stub___getpwuid_r) choke me #else char (*f) () = getpwuid_r; #endif #ifdef __cplusplus } #endif int main () { return f != getpwuid_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getpwuid_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getpwuid_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getpwuid_r" >&5 echo "${ECHO_T}$ac_cv_func_getpwuid_r" >&6 if test $ac_cv_func_getpwuid_r = yes; then echo "$as_me:$LINENO: checking for getpwuid_r with 5 args" >&5 echo $ECHO_N "checking for getpwuid_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_getpwuid_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { uid_t uid; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getpwuid_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getpwuid_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_getpwuid_r_5" >&6 tcl_ok=$tcl_cv_api_getpwuid_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWUID_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for getpwuid_r with 4 args" >&5 echo $ECHO_N "checking for getpwuid_r with 4 args... $ECHO_C" >&6 if test "${tcl_cv_api_getpwuid_r_4+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { uid_t uid; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(uid, &pw, buf, buflen); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getpwuid_r_4=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getpwuid_r_4=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_4" >&5 echo "${ECHO_T}$tcl_cv_api_getpwuid_r_4" >&6 tcl_ok=$tcl_cv_api_getpwuid_r_4 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWUID_R_4 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWUID_R 1 _ACEOF fi fi echo "$as_me:$LINENO: checking for getpwnam_r" >&5 echo $ECHO_N "checking for getpwnam_r... $ECHO_C" >&6 if test "${ac_cv_func_getpwnam_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getpwnam_r to an innocuous variant, in case declares getpwnam_r. For example, HP-UX 11i declares gettimeofday. */ #define getpwnam_r innocuous_getpwnam_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getpwnam_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getpwnam_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getpwnam_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getpwnam_r) || defined (__stub___getpwnam_r) choke me #else char (*f) () = getpwnam_r; #endif #ifdef __cplusplus } #endif int main () { return f != getpwnam_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getpwnam_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getpwnam_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getpwnam_r" >&5 echo "${ECHO_T}$ac_cv_func_getpwnam_r" >&6 if test $ac_cv_func_getpwnam_r = yes; then echo "$as_me:$LINENO: checking for getpwnam_r with 5 args" >&5 echo $ECHO_N "checking for getpwnam_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_getpwnam_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { char *name; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwnam_r(name, &pw, buf, buflen, &pwp); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getpwnam_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getpwnam_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_getpwnam_r_5" >&6 tcl_ok=$tcl_cv_api_getpwnam_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWNAM_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for getpwnam_r with 4 args" >&5 echo $ECHO_N "checking for getpwnam_r with 4 args... $ECHO_C" >&6 if test "${tcl_cv_api_getpwnam_r_4+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { char *name; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(name, &pw, buf, buflen); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getpwnam_r_4=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getpwnam_r_4=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_4" >&5 echo "${ECHO_T}$tcl_cv_api_getpwnam_r_4" >&6 tcl_ok=$tcl_cv_api_getpwnam_r_4 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWNAM_R_4 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWNAM_R 1 _ACEOF fi fi echo "$as_me:$LINENO: checking for getgrgid_r" >&5 echo $ECHO_N "checking for getgrgid_r... $ECHO_C" >&6 if test "${ac_cv_func_getgrgid_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getgrgid_r to an innocuous variant, in case declares getgrgid_r. For example, HP-UX 11i declares gettimeofday. */ #define getgrgid_r innocuous_getgrgid_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getgrgid_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getgrgid_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getgrgid_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getgrgid_r) || defined (__stub___getgrgid_r) choke me #else char (*f) () = getgrgid_r; #endif #ifdef __cplusplus } #endif int main () { return f != getgrgid_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getgrgid_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getgrgid_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getgrgid_r" >&5 echo "${ECHO_T}$ac_cv_func_getgrgid_r" >&6 if test $ac_cv_func_getgrgid_r = yes; then echo "$as_me:$LINENO: checking for getgrgid_r with 5 args" >&5 echo $ECHO_N "checking for getgrgid_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_getgrgid_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { gid_t gid; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrgid_r(gid, &gr, buf, buflen, &grp); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getgrgid_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getgrgid_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_getgrgid_r_5" >&6 tcl_ok=$tcl_cv_api_getgrgid_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRGID_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for getgrgid_r with 4 args" >&5 echo $ECHO_N "checking for getgrgid_r with 4 args... $ECHO_C" >&6 if test "${tcl_cv_api_getgrgid_r_4+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { gid_t gid; struct group gr; char buf[512]; int buflen = 512; (void)getgrgid_r(gid, &gr, buf, buflen); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getgrgid_r_4=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getgrgid_r_4=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_4" >&5 echo "${ECHO_T}$tcl_cv_api_getgrgid_r_4" >&6 tcl_ok=$tcl_cv_api_getgrgid_r_4 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRGID_R_4 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRGID_R 1 _ACEOF fi fi echo "$as_me:$LINENO: checking for getgrnam_r" >&5 echo $ECHO_N "checking for getgrnam_r... $ECHO_C" >&6 if test "${ac_cv_func_getgrnam_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getgrnam_r to an innocuous variant, in case declares getgrnam_r. For example, HP-UX 11i declares gettimeofday. */ #define getgrnam_r innocuous_getgrnam_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getgrnam_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getgrnam_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getgrnam_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getgrnam_r) || defined (__stub___getgrnam_r) choke me #else char (*f) () = getgrnam_r; #endif #ifdef __cplusplus } #endif int main () { return f != getgrnam_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getgrnam_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getgrnam_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getgrnam_r" >&5 echo "${ECHO_T}$ac_cv_func_getgrnam_r" >&6 if test $ac_cv_func_getgrnam_r = yes; then echo "$as_me:$LINENO: checking for getgrnam_r with 5 args" >&5 echo $ECHO_N "checking for getgrnam_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_getgrnam_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { char *name; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrnam_r(name, &gr, buf, buflen, &grp); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getgrnam_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getgrnam_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_getgrnam_r_5" >&6 tcl_ok=$tcl_cv_api_getgrnam_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRNAM_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for getgrnam_r with 4 args" >&5 echo $ECHO_N "checking for getgrnam_r with 4 args... $ECHO_C" >&6 if test "${tcl_cv_api_getgrnam_r_4+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { char *name; struct group gr; char buf[512]; int buflen = 512; (void)getgrnam_r(name, &gr, buf, buflen); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getgrnam_r_4=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getgrnam_r_4=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_4" >&5 echo "${ECHO_T}$tcl_cv_api_getgrnam_r_4" >&6 tcl_ok=$tcl_cv_api_getgrnam_r_4 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRNAM_R_4 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRNAM_R 1 _ACEOF fi fi if test "`uname -s`" = "Darwin" && \ test "`uname -r | awk -F. '{print $1}'`" -gt 5; then # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. cat >>confdefs.h <<\_ACEOF #define HAVE_MTSAFE_GETHOSTBYNAME 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define HAVE_MTSAFE_GETHOSTBYADDR 1 _ACEOF elif test "`uname -s`" = "HP-UX" && \ test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then # Starting with HPUX 11.00 (we believe), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. cat >>confdefs.h <<\_ACEOF #define HAVE_MTSAFE_GETHOSTBYNAME 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define HAVE_MTSAFE_GETHOSTBYADDR 1 _ACEOF else # Avoids picking hidden internal symbol from libc echo "$as_me:$LINENO: checking whether gethostbyname_r is declared" >&5 echo $ECHO_N "checking whether gethostbyname_r is declared... $ECHO_C" >&6 if test "${ac_cv_have_decl_gethostbyname_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { #ifndef gethostbyname_r char *p = (char *) gethostbyname_r; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_gethostbyname_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_gethostbyname_r=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_have_decl_gethostbyname_r" >&5 echo "${ECHO_T}$ac_cv_have_decl_gethostbyname_r" >&6 if test $ac_cv_have_decl_gethostbyname_r = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_GETHOSTBYNAME_R 1 _ACEOF tcl_cv_api_gethostbyname_r=yes else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_GETHOSTBYNAME_R 0 _ACEOF tcl_cv_api_gethostbyname_r=no fi if test "$tcl_cv_api_gethostbyname_r" = yes; then echo "$as_me:$LINENO: checking for gethostbyname_r" >&5 echo $ECHO_N "checking for gethostbyname_r... $ECHO_C" >&6 if test "${ac_cv_func_gethostbyname_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gethostbyname_r to an innocuous variant, in case declares gethostbyname_r. For example, HP-UX 11i declares gettimeofday. */ #define gethostbyname_r innocuous_gethostbyname_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gethostbyname_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyname_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gethostbyname_r) || defined (__stub___gethostbyname_r) choke me #else char (*f) () = gethostbyname_r; #endif #ifdef __cplusplus } #endif int main () { return f != gethostbyname_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gethostbyname_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gethostbyname_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname_r" >&5 echo "${ECHO_T}$ac_cv_func_gethostbyname_r" >&6 if test $ac_cv_func_gethostbyname_r = yes; then echo "$as_me:$LINENO: checking for gethostbyname_r with 6 args" >&5 echo $ECHO_N "checking for gethostbyname_r with 6 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyname_r_6+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *name; struct hostent *he, *res; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyname_r_6=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyname_r_6=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_6" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_6" >&6 tcl_ok=$tcl_cv_api_gethostbyname_r_6 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYNAME_R_6 1 _ACEOF else echo "$as_me:$LINENO: checking for gethostbyname_r with 5 args" >&5 echo $ECHO_N "checking for gethostbyname_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyname_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *name; struct hostent *he; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyname_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyname_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_5" >&6 tcl_ok=$tcl_cv_api_gethostbyname_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYNAME_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for gethostbyname_r with 3 args" >&5 echo $ECHO_N "checking for gethostbyname_r with 3 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyname_r_3+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *name; struct hostent *he; struct hostent_data data; (void) gethostbyname_r(name, he, &data); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyname_r_3=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyname_r_3=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_3" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_3" >&6 tcl_ok=$tcl_cv_api_gethostbyname_r_3 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYNAME_R_3 1 _ACEOF fi fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYNAME_R 1 _ACEOF fi fi fi # Avoids picking hidden internal symbol from libc echo "$as_me:$LINENO: checking whether gethostbyaddr_r is declared" >&5 echo $ECHO_N "checking whether gethostbyaddr_r is declared... $ECHO_C" >&6 if test "${ac_cv_have_decl_gethostbyaddr_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { #ifndef gethostbyaddr_r char *p = (char *) gethostbyaddr_r; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_gethostbyaddr_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_gethostbyaddr_r=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_have_decl_gethostbyaddr_r" >&5 echo "${ECHO_T}$ac_cv_have_decl_gethostbyaddr_r" >&6 if test $ac_cv_have_decl_gethostbyaddr_r = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_GETHOSTBYADDR_R 1 _ACEOF tcl_cv_api_gethostbyaddr_r=yes else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_GETHOSTBYADDR_R 0 _ACEOF tcl_cv_api_gethostbyaddr_r=no fi if test "$tcl_cv_api_gethostbyaddr_r" = yes; then echo "$as_me:$LINENO: checking for gethostbyaddr_r" >&5 echo $ECHO_N "checking for gethostbyaddr_r... $ECHO_C" >&6 if test "${ac_cv_func_gethostbyaddr_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gethostbyaddr_r to an innocuous variant, in case declares gethostbyaddr_r. For example, HP-UX 11i declares gettimeofday. */ #define gethostbyaddr_r innocuous_gethostbyaddr_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyaddr_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gethostbyaddr_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyaddr_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gethostbyaddr_r) || defined (__stub___gethostbyaddr_r) choke me #else char (*f) () = gethostbyaddr_r; #endif #ifdef __cplusplus } #endif int main () { return f != gethostbyaddr_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gethostbyaddr_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gethostbyaddr_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyaddr_r" >&5 echo "${ECHO_T}$ac_cv_func_gethostbyaddr_r" >&6 if test $ac_cv_func_gethostbyaddr_r = yes; then echo "$as_me:$LINENO: checking for gethostbyaddr_r with 7 args" >&5 echo $ECHO_N "checking for gethostbyaddr_r with 7 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyaddr_r_7+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *addr; int length; int type; struct hostent *result; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &h_errnop); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyaddr_r_7=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyaddr_r_7=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_7" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_7" >&6 tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYADDR_R_7 1 _ACEOF else echo "$as_me:$LINENO: checking for gethostbyaddr_r with 8 args" >&5 echo $ECHO_N "checking for gethostbyaddr_r with 8 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyaddr_r_8+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *addr; int length; int type; struct hostent *result, *resultp; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &resultp, &h_errnop); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyaddr_r_8=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyaddr_r_8=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_8" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_8" >&6 tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYADDR_R_8 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYADDR_R 1 _ACEOF fi fi fi fi fi #--------------------------------------------------------------------------- # Check for serial port interface. # # termios.h is present on all POSIX systems. # sys/ioctl.h is almost always present, though what it contains # is system-specific. # sys/modem.h is needed on HP-UX. #--------------------------------------------------------------------------- for ac_header in termios.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/ioctl.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/modem.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done #-------------------------------------------------------------------- # Include sys/select.h if it exists and if it supplies things # that appear to be useful and aren't already in sys/types.h. # This appears to be true only on the RS/6000 under AIX. Some # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for fd_set in sys/types" >&5 echo $ECHO_N "checking for fd_set in sys/types... $ECHO_C" >&6 if test "${tcl_cv_type_fd_set+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { fd_set readMask, writeMask; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_fd_set=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_type_fd_set=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_type_fd_set" >&5 echo "${ECHO_T}$tcl_cv_type_fd_set" >&6 tcl_ok=$tcl_cv_type_fd_set if test $tcl_ok = no; then echo "$as_me:$LINENO: checking for fd_mask in sys/select" >&5 echo $ECHO_N "checking for fd_mask in sys/select... $ECHO_C" >&6 if test "${tcl_cv_grep_fd_mask+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "fd_mask" >/dev/null 2>&1; then tcl_cv_grep_fd_mask=present else tcl_cv_grep_fd_mask=missing fi rm -f conftest* fi echo "$as_me:$LINENO: result: $tcl_cv_grep_fd_mask" >&5 echo "${ECHO_T}$tcl_cv_grep_fd_mask" >&6 if test $tcl_cv_grep_fd_mask = present; then cat >>confdefs.h <<\_ACEOF #define HAVE_SYS_SELECT_H 1 _ACEOF tcl_ok=yes fi fi if test $tcl_ok = no; then cat >>confdefs.h <<\_ACEOF #define NO_FD_SET 1 _ACEOF fi #------------------------------------------------------------------------------ # Find out all about time handling differences. #------------------------------------------------------------------------------ for ac_header in sys/time.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6 if test "${ac_cv_header_time+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main () { if ((struct tm *) 0) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_time=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_time=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 echo "${ECHO_T}$ac_cv_header_time" >&6 if test $ac_cv_header_time = yes; then cat >>confdefs.h <<\_ACEOF #define TIME_WITH_SYS_TIME 1 _ACEOF fi for ac_func in gmtime_r localtime_r mktime do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking tm_tzadj in struct tm" >&5 echo $ECHO_N "checking tm_tzadj in struct tm... $ECHO_C" >&6 if test "${tcl_cv_member_tm_tzadj+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct tm tm; (void)tm.tm_tzadj; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_member_tm_tzadj=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_member_tm_tzadj=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_member_tm_tzadj" >&5 echo "${ECHO_T}$tcl_cv_member_tm_tzadj" >&6 if test $tcl_cv_member_tm_tzadj = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TM_TZADJ 1 _ACEOF fi echo "$as_me:$LINENO: checking tm_gmtoff in struct tm" >&5 echo $ECHO_N "checking tm_gmtoff in struct tm... $ECHO_C" >&6 if test "${tcl_cv_member_tm_gmtoff+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct tm tm; (void)tm.tm_gmtoff; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_member_tm_gmtoff=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_member_tm_gmtoff=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_member_tm_gmtoff" >&5 echo "${ECHO_T}$tcl_cv_member_tm_gmtoff" >&6 if test $tcl_cv_member_tm_gmtoff = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TM_GMTOFF 1 _ACEOF fi # # Its important to include time.h in this check, as some systems # (like convex) have timezone functions, etc. # echo "$as_me:$LINENO: checking long timezone variable" >&5 echo $ECHO_N "checking long timezone variable... $ECHO_C" >&6 if test "${tcl_cv_timezone_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { extern long timezone; timezone += 1; exit (0); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_timezone_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_timezone_long=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_timezone_long" >&5 echo "${ECHO_T}$tcl_cv_timezone_long" >&6 if test $tcl_cv_timezone_long = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TIMEZONE_VAR 1 _ACEOF else # # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. # echo "$as_me:$LINENO: checking time_t timezone variable" >&5 echo $ECHO_N "checking time_t timezone variable... $ECHO_C" >&6 if test "${tcl_cv_timezone_time+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { extern time_t timezone; timezone += 1; exit (0); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_timezone_time=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_timezone_time=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_timezone_time" >&5 echo "${ECHO_T}$tcl_cv_timezone_time" >&6 if test $tcl_cv_timezone_time = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TIMEZONE_VAR 1 _ACEOF fi fi #-------------------------------------------------------------------- # Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But # we might be able to use fstatfs instead. Some systems (OpenBSD?) also # lack blkcnt_t. #-------------------------------------------------------------------- if test "$ac_cv_cygwin" != "yes"; then echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5 echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6 if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static struct stat ac_aggr; if (ac_aggr.st_blocks) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_stat_st_blocks=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static struct stat ac_aggr; if (sizeof ac_aggr.st_blocks) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_stat_st_blocks=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_stat_st_blocks=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blocks" >&5 echo "${ECHO_T}$ac_cv_member_struct_stat_st_blocks" >&6 if test $ac_cv_member_struct_stat_st_blocks = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_STAT_ST_BLOCKS 1 _ACEOF fi echo "$as_me:$LINENO: checking for struct stat.st_blksize" >&5 echo $ECHO_N "checking for struct stat.st_blksize... $ECHO_C" >&6 if test "${ac_cv_member_struct_stat_st_blksize+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static struct stat ac_aggr; if (ac_aggr.st_blksize) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_stat_st_blksize=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static struct stat ac_aggr; if (sizeof ac_aggr.st_blksize) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_stat_st_blksize=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_stat_st_blksize=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blksize" >&5 echo "${ECHO_T}$ac_cv_member_struct_stat_st_blksize" >&6 if test $ac_cv_member_struct_stat_st_blksize = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_STAT_ST_BLKSIZE 1 _ACEOF fi fi echo "$as_me:$LINENO: checking for blkcnt_t" >&5 echo $ECHO_N "checking for blkcnt_t... $ECHO_C" >&6 if test "${ac_cv_type_blkcnt_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((blkcnt_t *) 0) return 0; if (sizeof (blkcnt_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_blkcnt_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_blkcnt_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_blkcnt_t" >&5 echo "${ECHO_T}$ac_cv_type_blkcnt_t" >&6 if test $ac_cv_type_blkcnt_t = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_BLKCNT_T 1 _ACEOF fi echo "$as_me:$LINENO: checking for fstatfs" >&5 echo $ECHO_N "checking for fstatfs... $ECHO_C" >&6 if test "${ac_cv_func_fstatfs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define fstatfs to an innocuous variant, in case declares fstatfs. For example, HP-UX 11i declares gettimeofday. */ #define fstatfs innocuous_fstatfs /* System header to define __stub macros and hopefully few prototypes, which can conflict with char fstatfs (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef fstatfs /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char fstatfs (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_fstatfs) || defined (__stub___fstatfs) choke me #else char (*f) () = fstatfs; #endif #ifdef __cplusplus } #endif int main () { return f != fstatfs; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_fstatfs=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_fstatfs=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_fstatfs" >&5 echo "${ECHO_T}$ac_cv_func_fstatfs" >&6 if test $ac_cv_func_fstatfs = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_FSTATFS 1 _ACEOF fi #-------------------------------------------------------------------- # Some system have no memcmp or it does not work with 8 bit data, this # checks it and add memcmp.o to LIBOBJS if needed #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for working memcmp" >&5 echo $ECHO_N "checking for working memcmp... $ECHO_C" >&6 if test "${ac_cv_func_memcmp_working+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then ac_cv_func_memcmp_working=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { /* Some versions of memcmp are not 8-bit clean. */ char c0 = 0x40, c1 = 0x80, c2 = 0x81; if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0) exit (1); /* The Next x86 OpenStep bug shows up only when comparing 16 bytes or more and with at least one buffer not starting on a 4-byte boundary. William Lewis provided this test program. */ { char foo[21]; char bar[21]; int i; for (i = 0; i < 4; i++) { char *a = foo + i; char *b = bar + i; strcpy (a, "--------01111111"); strcpy (b, "--------10000000"); if (memcmp (a, b, 16) >= 0) exit (1); } exit (0); } ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_memcmp_working=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_memcmp_working=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5 echo "${ECHO_T}$ac_cv_func_memcmp_working" >&6 test $ac_cv_func_memcmp_working = no && case $LIBOBJS in "memcmp.$ac_objext" | \ *" memcmp.$ac_objext" | \ "memcmp.$ac_objext "* | \ *" memcmp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" ;; esac #-------------------------------------------------------------------- # Some system like SunOS 4 and other BSD like systems have no memmove # (we assume they have bcopy instead). {The replacement define is in # compat/string.h} #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for memmove" >&5 echo $ECHO_N "checking for memmove... $ECHO_C" >&6 if test "${ac_cv_func_memmove+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define memmove to an innocuous variant, in case declares memmove. For example, HP-UX 11i declares gettimeofday. */ #define memmove innocuous_memmove /* System header to define __stub macros and hopefully few prototypes, which can conflict with char memmove (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef memmove /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char memmove (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_memmove) || defined (__stub___memmove) choke me #else char (*f) () = memmove; #endif #ifdef __cplusplus } #endif int main () { return f != memmove; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_memmove=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_memmove=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_memmove" >&5 echo "${ECHO_T}$ac_cv_func_memmove" >&6 if test $ac_cv_func_memmove = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_MEMMOVE 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define NO_STRING_H 1 _ACEOF fi #-------------------------------------------------------------------- # On some systems strstr is broken: it returns a pointer even if # the original string is empty. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for strstr" >&5 echo $ECHO_N "checking for strstr... $ECHO_C" >&6 if test "${ac_cv_func_strstr+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strstr to an innocuous variant, in case declares strstr. For example, HP-UX 11i declares gettimeofday. */ #define strstr innocuous_strstr /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strstr (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strstr /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strstr (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strstr) || defined (__stub___strstr) choke me #else char (*f) () = strstr; #endif #ifdef __cplusplus } #endif int main () { return f != strstr; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strstr=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strstr=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strstr" >&5 echo "${ECHO_T}$ac_cv_func_strstr" >&6 if test $ac_cv_func_strstr = yes; then tcl_ok=1 else tcl_ok=0 fi if test "$tcl_ok" = 1; then echo "$as_me:$LINENO: checking proper strstr implementation" >&5 echo $ECHO_N "checking proper strstr implementation... $ECHO_C" >&6 if test "${tcl_cv_strstr_unbroken+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_strstr_unbroken=unknown else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main() { exit(strstr("\0test", "test") ? 1 : 0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_strstr_unbroken=ok else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) tcl_cv_strstr_unbroken=broken fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $tcl_cv_strstr_unbroken" >&5 echo "${ECHO_T}$tcl_cv_strstr_unbroken" >&6 if test "$tcl_cv_strstr_unbroken" = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then case $LIBOBJS in "strstr.$ac_objext" | \ *" strstr.$ac_objext" | \ "strstr.$ac_objext "* | \ *" strstr.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS strstr.$ac_objext" ;; esac USE_COMPAT=1 fi #-------------------------------------------------------------------- # Check for strtoul function. This is tricky because under some # versions of AIX strtoul returns an incorrect terminator # pointer for the string "0". #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for strtoul" >&5 echo $ECHO_N "checking for strtoul... $ECHO_C" >&6 if test "${ac_cv_func_strtoul+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strtoul to an innocuous variant, in case declares strtoul. For example, HP-UX 11i declares gettimeofday. */ #define strtoul innocuous_strtoul /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strtoul (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strtoul /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strtoul (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strtoul) || defined (__stub___strtoul) choke me #else char (*f) () = strtoul; #endif #ifdef __cplusplus } #endif int main () { return f != strtoul; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strtoul=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strtoul=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strtoul" >&5 echo "${ECHO_T}$ac_cv_func_strtoul" >&6 if test $ac_cv_func_strtoul = yes; then tcl_ok=1 else tcl_ok=0 fi if test "$tcl_ok" = 1; then echo "$as_me:$LINENO: checking proper strtoul implementation" >&5 echo $ECHO_N "checking proper strtoul implementation... $ECHO_C" >&6 if test "${tcl_cv_strtoul_unbroken+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_strtoul_unbroken=unknown else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main() { char *term, *string = "0"; exit(strtoul(string,&term,0) != 0 || term != string+1); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_strtoul_unbroken=ok else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) tcl_cv_strtoul_unbroken=broken fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $tcl_cv_strtoul_unbroken" >&5 echo "${ECHO_T}$tcl_cv_strtoul_unbroken" >&6 if test "$tcl_cv_strtoul_unbroken" = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then case $LIBOBJS in "strtoul.$ac_objext" | \ *" strtoul.$ac_objext" | \ "strtoul.$ac_objext "* | \ *" strtoul.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS strtoul.$ac_objext" ;; esac USE_COMPAT=1 fi #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for mode_t" >&5 echo $ECHO_N "checking for mode_t... $ECHO_C" >&6 if test "${ac_cv_type_mode_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((mode_t *) 0) return 0; if (sizeof (mode_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_mode_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_mode_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_mode_t" >&5 echo "${ECHO_T}$ac_cv_type_mode_t" >&6 if test $ac_cv_type_mode_t = yes; then : else cat >>confdefs.h <<_ACEOF #define mode_t int _ACEOF fi echo "$as_me:$LINENO: checking for pid_t" >&5 echo $ECHO_N "checking for pid_t... $ECHO_C" >&6 if test "${ac_cv_type_pid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((pid_t *) 0) return 0; if (sizeof (pid_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_pid_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_pid_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5 echo "${ECHO_T}$ac_cv_type_pid_t" >&6 if test $ac_cv_type_pid_t = yes; then : else cat >>confdefs.h <<_ACEOF #define pid_t int _ACEOF fi echo "$as_me:$LINENO: checking for size_t" >&5 echo $ECHO_N "checking for size_t... $ECHO_C" >&6 if test "${ac_cv_type_size_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((size_t *) 0) return 0; if (sizeof (size_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_size_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_size_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_size_t" >&5 echo "${ECHO_T}$ac_cv_type_size_t" >&6 if test $ac_cv_type_size_t = yes; then : else cat >>confdefs.h <<_ACEOF #define size_t unsigned _ACEOF fi echo "$as_me:$LINENO: checking for uid_t in sys/types.h" >&5 echo $ECHO_N "checking for uid_t in sys/types.h... $ECHO_C" >&6 if test "${ac_cv_type_uid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "uid_t" >/dev/null 2>&1; then ac_cv_type_uid_t=yes else ac_cv_type_uid_t=no fi rm -f conftest* fi echo "$as_me:$LINENO: result: $ac_cv_type_uid_t" >&5 echo "${ECHO_T}$ac_cv_type_uid_t" >&6 if test $ac_cv_type_uid_t = no; then cat >>confdefs.h <<\_ACEOF #define uid_t int _ACEOF cat >>confdefs.h <<\_ACEOF #define gid_t int _ACEOF fi echo "$as_me:$LINENO: checking for socklen_t" >&5 echo $ECHO_N "checking for socklen_t... $ECHO_C" >&6 if test "${tcl_cv_type_socklen_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { socklen_t foo; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_socklen_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_type_socklen_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_type_socklen_t" >&5 echo "${ECHO_T}$tcl_cv_type_socklen_t" >&6 if test $tcl_cv_type_socklen_t = no; then cat >>confdefs.h <<\_ACEOF #define socklen_t int _ACEOF fi echo "$as_me:$LINENO: checking for intptr_t" >&5 echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 if test "${ac_cv_type_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((intptr_t *) 0) return 0; if (sizeof (intptr_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_intptr_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_intptr_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 if test $ac_cv_type_intptr_t = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_INTPTR_T 1 _ACEOF else echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 if test "${tcl_cv_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for tcl_cv_intptr_t in "int" "long" "long long" none; do if test "$tcl_cv_intptr_t" != none; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_ok=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 echo "${ECHO_T}$tcl_cv_intptr_t" >&6 if test "$tcl_cv_intptr_t" != none; then cat >>confdefs.h <<_ACEOF #define intptr_t $tcl_cv_intptr_t _ACEOF fi fi echo "$as_me:$LINENO: checking for uintptr_t" >&5 echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 if test "${ac_cv_type_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((uintptr_t *) 0) return 0; if (sizeof (uintptr_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_uintptr_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_uintptr_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 if test $ac_cv_type_uintptr_t = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_UINTPTR_T 1 _ACEOF else echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 if test "${tcl_cv_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ none; do if test "$tcl_cv_uintptr_t" != none; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_ok=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 if test "$tcl_cv_uintptr_t" != none; then cat >>confdefs.h <<_ACEOF #define uintptr_t $tcl_cv_uintptr_t _ACEOF fi fi #-------------------------------------------------------------------- # If a system doesn't have an opendir function (man, that's old!) # then we have to supply a different version of dirent.h which # is compatible with the substitute version of opendir that's # provided. This version only works with V7-style directories. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for opendir" >&5 echo $ECHO_N "checking for opendir... $ECHO_C" >&6 if test "${ac_cv_func_opendir+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define opendir to an innocuous variant, in case declares opendir. For example, HP-UX 11i declares gettimeofday. */ #define opendir innocuous_opendir /* System header to define __stub macros and hopefully few prototypes, which can conflict with char opendir (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef opendir /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char opendir (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_opendir) || defined (__stub___opendir) choke me #else char (*f) () = opendir; #endif #ifdef __cplusplus } #endif int main () { return f != opendir; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_opendir=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_opendir=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_opendir" >&5 echo "${ECHO_T}$ac_cv_func_opendir" >&6 if test $ac_cv_func_opendir = yes; then : else cat >>confdefs.h <<\_ACEOF #define USE_DIRENT2_H 1 _ACEOF fi #-------------------------------------------------------------------- # The check below checks whether defines the type # "union wait" correctly. It's needed because of weirdness in # HP-UX where "union wait" is defined in both the BSD and SYS-V # environments. Checking the usability of WIFEXITED seems to do # the trick. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking union wait" >&5 echo $ECHO_N "checking union wait... $ECHO_C" >&6 if test "${tcl_cv_union_wait+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { union wait x; WIFEXITED(x); /* Generates compiler error if WIFEXITED * uses an int. */ ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_union_wait=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_union_wait=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_union_wait" >&5 echo "${ECHO_T}$tcl_cv_union_wait" >&6 if test $tcl_cv_union_wait = no; then cat >>confdefs.h <<\_ACEOF #define NO_UNION_WAIT 1 _ACEOF fi #-------------------------------------------------------------------- # Check whether there is an strncasecmp function on this system. # This is a bit tricky because under SCO it's in -lsocket and # under Sequent Dynix it's in -linet. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for strncasecmp" >&5 echo $ECHO_N "checking for strncasecmp... $ECHO_C" >&6 if test "${ac_cv_func_strncasecmp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strncasecmp to an innocuous variant, in case declares strncasecmp. For example, HP-UX 11i declares gettimeofday. */ #define strncasecmp innocuous_strncasecmp /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strncasecmp (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strncasecmp /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strncasecmp (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strncasecmp) || defined (__stub___strncasecmp) choke me #else char (*f) () = strncasecmp; #endif #ifdef __cplusplus } #endif int main () { return f != strncasecmp; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strncasecmp=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strncasecmp=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strncasecmp" >&5 echo "${ECHO_T}$ac_cv_func_strncasecmp" >&6 if test $ac_cv_func_strncasecmp = yes; then tcl_ok=1 else tcl_ok=0 fi if test "$tcl_ok" = 0; then echo "$as_me:$LINENO: checking for strncasecmp in -lsocket" >&5 echo $ECHO_N "checking for strncasecmp in -lsocket... $ECHO_C" >&6 if test "${ac_cv_lib_socket_strncasecmp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strncasecmp (); int main () { strncasecmp (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_socket_strncasecmp=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_socket_strncasecmp=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_socket_strncasecmp" >&5 echo "${ECHO_T}$ac_cv_lib_socket_strncasecmp" >&6 if test $ac_cv_lib_socket_strncasecmp = yes; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then echo "$as_me:$LINENO: checking for strncasecmp in -linet" >&5 echo $ECHO_N "checking for strncasecmp in -linet... $ECHO_C" >&6 if test "${ac_cv_lib_inet_strncasecmp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strncasecmp (); int main () { strncasecmp (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_inet_strncasecmp=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_inet_strncasecmp=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_inet_strncasecmp" >&5 echo "${ECHO_T}$ac_cv_lib_inet_strncasecmp" >&6 if test $ac_cv_lib_inet_strncasecmp = yes; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then case $LIBOBJS in "strncasecmp.$ac_objext" | \ *" strncasecmp.$ac_objext" | \ "strncasecmp.$ac_objext "* | \ *" strncasecmp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext" ;; esac USE_COMPAT=1 fi #-------------------------------------------------------------------- # The code below deals with several issues related to gettimeofday: # 1. Some systems don't provide a gettimeofday function at all # (set NO_GETTOD if this is the case). # 2. See if gettimeofday is declared in the header file. # if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can # declare it. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for gettimeofday" >&5 echo $ECHO_N "checking for gettimeofday... $ECHO_C" >&6 if test "${ac_cv_func_gettimeofday+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gettimeofday to an innocuous variant, in case declares gettimeofday. For example, HP-UX 11i declares gettimeofday. */ #define gettimeofday innocuous_gettimeofday /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gettimeofday (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gettimeofday /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gettimeofday (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gettimeofday) || defined (__stub___gettimeofday) choke me #else char (*f) () = gettimeofday; #endif #ifdef __cplusplus } #endif int main () { return f != gettimeofday; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gettimeofday=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gettimeofday=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_gettimeofday" >&5 echo "${ECHO_T}$ac_cv_func_gettimeofday" >&6 if test $ac_cv_func_gettimeofday = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_GETTOD 1 _ACEOF fi echo "$as_me:$LINENO: checking for gettimeofday declaration" >&5 echo $ECHO_N "checking for gettimeofday declaration... $ECHO_C" >&6 if test "${tcl_cv_grep_gettimeofday+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "gettimeofday" >/dev/null 2>&1; then tcl_cv_grep_gettimeofday=present else tcl_cv_grep_gettimeofday=missing fi rm -f conftest* fi echo "$as_me:$LINENO: result: $tcl_cv_grep_gettimeofday" >&5 echo "${ECHO_T}$tcl_cv_grep_gettimeofday" >&6 if test $tcl_cv_grep_gettimeofday = missing ; then cat >>confdefs.h <<\_ACEOF #define GETTOD_NOT_DECLARED 1 _ACEOF fi #-------------------------------------------------------------------- # The following code checks to see whether it is possible to get # signed chars on this platform. This is needed in order to # properly generate sign-extended ints from character values. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether char is unsigned" >&5 echo $ECHO_N "checking whether char is unsigned... $ECHO_C" >&6 if test "${ac_cv_c_char_unsigned+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((char) -1) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_char_unsigned=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_char_unsigned=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_c_char_unsigned" >&5 echo "${ECHO_T}$ac_cv_c_char_unsigned" >&6 if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then cat >>confdefs.h <<\_ACEOF #define __CHAR_UNSIGNED__ 1 _ACEOF fi echo "$as_me:$LINENO: checking signed char declarations" >&5 echo $ECHO_N "checking signed char declarations... $ECHO_C" >&6 if test "${tcl_cv_char_signed+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { signed char *p; p = 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_char_signed=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_char_signed=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_char_signed" >&5 echo "${ECHO_T}$tcl_cv_char_signed" >&6 if test $tcl_cv_char_signed = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_SIGNED_CHAR 1 _ACEOF fi #-------------------------------------------------------------------- # Does putenv() copy or not? We need to know to avoid memory leaks. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for a putenv() that copies the buffer" >&5 echo $ECHO_N "checking for a putenv() that copies the buffer... $ECHO_C" >&6 if test "${tcl_cv_putenv_copy+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_putenv_copy=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #define OURVAR "havecopy=yes" int main (int argc, char *argv[]) { char *foo, *bar; foo = (char *)strdup(OURVAR); putenv(foo); strcpy((char *)(strchr(foo, '=') + 1), "no"); bar = getenv("havecopy"); if (!strcmp(bar, "no")) { /* doesnt copy */ return 0; } else { /* does copy */ return 1; } } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_putenv_copy=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) tcl_cv_putenv_copy=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $tcl_cv_putenv_copy" >&5 echo "${ECHO_T}$tcl_cv_putenv_copy" >&6 if test $tcl_cv_putenv_copy = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_PUTENV_THAT_COPIES 1 _ACEOF fi #-------------------------------------------------------------------- # Check for support of nl_langinfo function #-------------------------------------------------------------------- # Check whether --enable-langinfo or --disable-langinfo was given. if test "${enable_langinfo+set}" = set; then enableval="$enable_langinfo" langinfo_ok=$enableval else langinfo_ok=yes fi; HAVE_LANGINFO=0 if test "$langinfo_ok" = "yes"; then if test "${ac_cv_header_langinfo_h+set}" = set; then echo "$as_me:$LINENO: checking for langinfo.h" >&5 echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6 if test "${ac_cv_header_langinfo_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5 echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking langinfo.h usability" >&5 echo $ECHO_N "checking langinfo.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking langinfo.h presence" >&5 echo $ECHO_N "checking langinfo.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: langinfo.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: langinfo.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: langinfo.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: langinfo.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: langinfo.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: langinfo.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: langinfo.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for langinfo.h" >&5 echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6 if test "${ac_cv_header_langinfo_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_langinfo_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5 echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6 fi if test $ac_cv_header_langinfo_h = yes; then langinfo_ok=yes else langinfo_ok=no fi fi echo "$as_me:$LINENO: checking whether to use nl_langinfo" >&5 echo $ECHO_N "checking whether to use nl_langinfo... $ECHO_C" >&6 if test "$langinfo_ok" = "yes"; then if test "${tcl_cv_langinfo_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { nl_langinfo(CODESET); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_langinfo_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_langinfo_h=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_langinfo_h" >&5 echo "${ECHO_T}$tcl_cv_langinfo_h" >&6 if test $tcl_cv_langinfo_h = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_LANGINFO 1 _ACEOF fi else echo "$as_me:$LINENO: result: $langinfo_ok" >&5 echo "${ECHO_T}$langinfo_ok" >&6 fi #-------------------------------------------------------------------- # Check for support of chflags and mkstemps functions #-------------------------------------------------------------------- for ac_func in chflags mkstemps do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done #-------------------------------------------------------------------- # Check for support of isnan() function or macro #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking isnan" >&5 echo $ECHO_N "checking isnan... $ECHO_C" >&6 if test "${tcl_cv_isnan+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { isnan(0.0); /* Generates an error if isnan is missing */ ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_isnan=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_isnan=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_isnan" >&5 echo "${ECHO_T}$tcl_cv_isnan" >&6 if test $tcl_cv_isnan = no; then cat >>confdefs.h <<\_ACEOF #define NO_ISNAN 1 _ACEOF fi #-------------------------------------------------------------------- # Darwin specific API checks and defines #-------------------------------------------------------------------- if test "`uname -s`" = "Darwin" ; then for ac_func in getattrlist do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in copyfile.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in copyfile do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done if test $tcl_corefoundation = yes; then for ac_header in libkern/OSAtomic.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in OSSpinLockLock do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done fi cat >>confdefs.h <<\_ACEOF #define TCL_DEFAULT_ENCODING "utf-8" _ACEOF cat >>confdefs.h <<\_ACEOF #define TCL_LOAD_FROM_MEMORY 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define TCL_WIDE_CLICKS 1 _ACEOF for ac_header in AvailabilityMacros.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "$ac_cv_header_AvailabilityMacros_h" = yes; then echo "$as_me:$LINENO: checking if weak import is available" >&5 echo $ECHO_N "checking if weak import is available... $ECHO_C" >&6 if test "${tcl_cv_cc_weak_import+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #endif int rand(void) __attribute__((weak_import)); int main () { rand(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_weak_import=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_weak_import=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_weak_import" >&5 echo "${ECHO_T}$tcl_cv_cc_weak_import" >&6 if test $tcl_cv_cc_weak_import = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_WEAK_IMPORT 1 _ACEOF fi echo "$as_me:$LINENO: checking if Darwin SUSv3 extensions are available" >&5 echo $ECHO_N "checking if Darwin SUSv3 extensions are available... $ECHO_C" >&6 if test "${tcl_cv_cc_darwin_c_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #endif #define _DARWIN_C_SOURCE 1 #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_darwin_c_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_darwin_c_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_darwin_c_source" >&5 echo "${ECHO_T}$tcl_cv_cc_darwin_c_source" >&6 if test $tcl_cv_cc_darwin_c_source = yes; then cat >>confdefs.h <<\_ACEOF #define _DARWIN_C_SOURCE 1 _ACEOF fi fi # Build .bundle dltest binaries in addition to .dylib DLTEST_LD='${CC} -bundle -Wl,-w ${CFLAGS} ${LDFLAGS}' DLTEST_SUFFIX=".bundle" else DLTEST_LD='${SHLIB_LD}' DLTEST_SUFFIX="" fi #-------------------------------------------------------------------- # Check for support of fts functions (readdir replacement) #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for fts" >&5 echo $ECHO_N "checking for fts... $ECHO_C" >&6 if test "${tcl_cv_api_fts+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main () { char*const p[2] = {"/", NULL}; FTS *f = fts_open(p, FTS_PHYSICAL|FTS_NOCHDIR|FTS_NOSTAT, NULL); FTSENT *e = fts_read(f); fts_close(f); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_fts=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_fts=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_fts" >&5 echo "${ECHO_T}$tcl_cv_api_fts" >&6 if test $tcl_cv_api_fts = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_FTS 1 _ACEOF fi #-------------------------------------------------------------------- # The statements below check for systems where POSIX-style non-blocking # I/O (O_NONBLOCK) doesn't work or is unimplemented. On these systems # (mostly older ones), use the old BSD-style FIONBIO approach instead. #-------------------------------------------------------------------- for ac_header in sys/ioctl.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/filio.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking system version" >&5 echo $ECHO_N "checking system version... $ECHO_C" >&6 if test "${tcl_cv_sys_version+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -f /usr/lib/NextStep/software_version; then tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then tcl_cv_sys_version=MP-RAS-`awk '{print $3}' /etc/.relid` fi if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then tcl_cv_sys_version=NetBSD-Debian fi fi fi fi echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 echo "${ECHO_T}$tcl_cv_sys_version" >&6 system=$tcl_cv_sys_version echo "$as_me:$LINENO: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 echo $ECHO_N "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... $ECHO_C" >&6 case $system in OSF*) cat >>confdefs.h <<\_ACEOF #define USE_FIONBIO 1 _ACEOF echo "$as_me:$LINENO: result: FIONBIO" >&5 echo "${ECHO_T}FIONBIO" >&6 ;; SunOS-4*) cat >>confdefs.h <<\_ACEOF #define USE_FIONBIO 1 _ACEOF echo "$as_me:$LINENO: result: FIONBIO" >&5 echo "${ECHO_T}FIONBIO" >&6 ;; *) echo "$as_me:$LINENO: result: O_NONBLOCK" >&5 echo "${ECHO_T}O_NONBLOCK" >&6 ;; esac #------------------------------------------------------------------------ echo "$as_me:$LINENO: checking whether to use dll unloading" >&5 echo $ECHO_N "checking whether to use dll unloading... $ECHO_C" >&6 # Check whether --enable-dll-unloading or --disable-dll-unloading was given. if test "${enable_dll_unloading+set}" = set; then enableval="$enable_dll_unloading" tcl_ok=$enableval else tcl_ok=yes fi; if test $tcl_ok = yes; then cat >>confdefs.h <<\_ACEOF #define TCL_UNLOAD_DLLS 1 _ACEOF fi echo "$as_me:$LINENO: result: $tcl_ok" >&5 echo "${ECHO_T}$tcl_ok" >&6 #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can # be overridden on the configure command line either way. #------------------------------------------------------------------------ echo "$as_me:$LINENO: checking for timezone data" >&5 echo $ECHO_N "checking for timezone data... $ECHO_C" >&6 # Check whether --with-tzdata or --without-tzdata was given. if test "${with_tzdata+set}" = set; then withval="$with_tzdata" tcl_ok=$withval else tcl_ok=auto fi; # # Any directories that get added here must also be added to the # search path in ::tcl::clock::Initialize (library/clock.tcl). # case $tcl_ok in no) echo "$as_me:$LINENO: result: supplied by OS vendor" >&5 echo "${ECHO_T}supplied by OS vendor" >&6 ;; yes) # nothing to do here ;; auto*) if test "${tcl_cv_dir_zoneinfo+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for dir in /usr/share/zoneinfo \ /usr/share/lib/zoneinfo \ /usr/lib/zoneinfo do if test -f $dir/UTC -o -f $dir/GMT then tcl_cv_dir_zoneinfo="$dir" break fi done fi if test -n "$tcl_cv_dir_zoneinfo"; then tcl_ok=no echo "$as_me:$LINENO: result: $dir" >&5 echo "${ECHO_T}$dir" >&6 else tcl_ok=yes fi ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $tcl_ok" >&5 echo "$as_me: error: invalid argument: $tcl_ok" >&2;} { (exit 1); exit 1; }; } ;; esac if test $tcl_ok = yes then echo "$as_me:$LINENO: result: supplied by Tcl" >&5 echo "${ECHO_T}supplied by Tcl" >&6 INSTALL_TZDATA=install-tzdata fi #-------------------------------------------------------------------- # DTrace support #-------------------------------------------------------------------- # Check whether --enable-dtrace or --disable-dtrace was given. if test "${enable_dtrace+set}" = set; then enableval="$enable_dtrace" tcl_ok=$enableval else tcl_ok=no fi; if test $tcl_ok = yes; then if test "${ac_cv_header_sys_sdt_h+set}" = set; then echo "$as_me:$LINENO: checking for sys/sdt.h" >&5 echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6 if test "${ac_cv_header_sys_sdt_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sys/sdt.h usability" >&5 echo $ECHO_N "checking sys/sdt.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sys/sdt.h presence" >&5 echo $ECHO_N "checking sys/sdt.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: sys/sdt.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: sys/sdt.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sys/sdt.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: sys/sdt.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sys/sdt.h" >&5 echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6 if test "${ac_cv_header_sys_sdt_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sys_sdt_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6 fi if test $ac_cv_header_sys_sdt_h = yes; then tcl_ok=yes else tcl_ok=no fi fi if test $tcl_ok = yes; then # Extract the first word of "dtrace", so it can be a program name with args. set dummy dtrace; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_DTRACE+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $DTRACE in [\\/]* | ?:[\\/]*) ac_cv_path_DTRACE="$DTRACE" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_dummy="$PATH:/usr/sbin" for as_dir in $as_dummy do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_DTRACE="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi DTRACE=$ac_cv_path_DTRACE if test -n "$DTRACE"; then echo "$as_me:$LINENO: result: $DTRACE" >&5 echo "${ECHO_T}$DTRACE" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -z "$ac_cv_path_DTRACE" && tcl_ok=no fi echo "$as_me:$LINENO: checking whether to enable DTrace support" >&5 echo $ECHO_N "checking whether to enable DTrace support... $ECHO_C" >&6 MAKEFILE_SHELL='/bin/sh' if test $tcl_ok = yes; then cat >>confdefs.h <<\_ACEOF #define USE_DTRACE 1 _ACEOF DTRACE_SRC="\${DTRACE_SRC}" DTRACE_HDR="\${DTRACE_HDR}" if test "`uname -s`" != "Darwin" ; then DTRACE_OBJ="\${DTRACE_OBJ}" if test "`uname -s`" = "SunOS" -a "$SHARED_BUILD" = "0" ; then # Need to create an intermediate object file to ensure tclDTrace.o # gets included when linking against the static tcl library. STLIB_LD='stlib_ld () { /usr/ccs/bin/ld -r -o $${1%.a}.o "$${@:2}" && '"${STLIB_LD}"' $${1} $${1%.a}.o ; } && stlib_ld' MAKEFILE_SHELL='/bin/bash' # Force use of Sun ar and ranlib, the GNU versions choke on # tclDTrace.o and the combined object file above. AR='/usr/ccs/bin/ar' RANLIB='/usr/ccs/bin/ranlib' fi fi fi echo "$as_me:$LINENO: result: $tcl_ok" >&5 echo "${ECHO_T}$tcl_ok" >&6 #-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether the cpuid instruction is usable" >&5 echo $ECHO_N "checking whether the cpuid instruction is usable... $ECHO_C" >&6 if test "${tcl_cv_cpuid+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int index,regsPtr[4]; __asm__ __volatile__("mov %%ebx, %%edi \n\t" "cpuid \n\t" "mov %%ebx, %%esi \n\t" "mov %%edi, %%ebx \n\t" : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index) : "edi"); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cpuid=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cpuid=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_cpuid" >&5 echo "${ECHO_T}$tcl_cv_cpuid" >&6 if test $tcl_cv_cpuid = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_CPUID 1 _ACEOF fi #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX} eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" # tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed # since on some platforms TCL_LIB_FILE contains shell escapes. # (See also: TCL_TRIM_DOTS). eval "TCL_LIB_FILE=${TCL_LIB_FILE}" test -z "$TCL_LIBRARY" && TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' # Note: in the following variable, it's important to use the absolute # path name of the Tcl directory rather than "..": this is because # AIX remembers this path and will attempt to use it at run-time to look # up the Tcl library. if test "`uname -s`" = "Darwin" ; then if test "`uname -s`" = "Darwin" ; then echo "$as_me:$LINENO: checking how to package libraries" >&5 echo $ECHO_N "checking how to package libraries... $ECHO_C" >&6 # Check whether --enable-framework or --disable-framework was given. if test "${enable_framework+set}" = set; then enableval="$enable_framework" enable_framework=$enableval else enable_framework=no fi; if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then { echo "$as_me:$LINENO: WARNING: Frameworks can only be built if --enable-shared is yes" >&5 echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;} enable_framework=no fi if test $tcl_corefoundation = no; then { echo "$as_me:$LINENO: WARNING: Frameworks can only be used when CoreFoundation is available" >&5 echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;} enable_framework=no fi fi if test $enable_framework = yes; then echo "$as_me:$LINENO: result: framework" >&5 echo "${ECHO_T}framework" >&6 FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then echo "$as_me:$LINENO: result: shared library" >&5 echo "${ECHO_T}shared library" >&6 else echo "$as_me:$LINENO: result: static library" >&5 echo "${ECHO_T}static library" >&6 fi FRAMEWORK_BUILD=0 fi fi TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk '{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}'`" TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}' echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000' TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" TCL_YEAR="`date +%Y`" fi if test "$FRAMEWORK_BUILD" = "1" ; then cat >>confdefs.h <<\_ACEOF #define TCL_FRAMEWORK 1 _ACEOF # Construct a fake local framework structure to make linking with # '-framework Tcl' and running of tcltest work ac_config_commands="$ac_config_commands Tcl.framework" LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" # default install directory for bundled packages if test "${libdir}" = '${exec_prefix}/lib' -o "`basename ${libdir}`" = 'Frameworks'; then PACKAGE_DIR="/Library/Tcl" else PACKAGE_DIR="$libdir" fi if test "${libdir}" = '${exec_prefix}/lib'; then # override libdir default libdir="/Library/Frameworks" fi TCL_LIB_FILE="Tcl" TCL_LIB_FLAG="-framework Tcl" TCL_BUILD_LIB_SPEC="-F`pwd | sed -e 's/ /\\\\ /g'` -framework Tcl" TCL_LIB_SPEC="-F${libdir} -framework Tcl" libdir="${libdir}/Tcl.framework/Versions/\${VERSION}" TCL_LIBRARY="${libdir}/Resources/Scripts" includedir="${libdir}/Headers" PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders" HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl" EXTRA_INSTALL="install-private-headers html-tcl" EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)/TclTOC.html"' EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."' # Don't use AC_DEFINE for the following as the framework version define # needs to go into the Makefile even when using autoheader, so that we # can pick up a potential make override of VERSION. Also, don't put this # into CFLAGS as it should not go into tclConfig.sh EXTRA_CC_SWITCHES='-DTCL_FRAMEWORK_VERSION=\"$(VERSION)\"' else # libdir must be a fully qualified path and not ${exec_prefix}/lib eval libdir="$libdir" # default install directory for bundled packages PACKAGE_DIR="$libdir" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_LIB_FLAG="-ltcl${TCL_VERSION}" else TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`" fi TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" fi VERSION='${VERSION}' eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" VERSION=${TCL_VERSION} #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$FRAMEWORK_BUILD" = "1" ; then test -z "$TCL_PACKAGE_PATH" && \ TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" test -z "$TCL_MODULE_PATH" && \ TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl" elif test "$prefix/lib" != "$libdir"; then test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib} ${TCL_PACKAGE_PATH}" else test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${prefix}/lib} ${TCL_PACKAGE_PATH}" fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl # stub support. #-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_DIR=\"${libdir}\"" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" else TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" fi TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}" TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}" TCL_STUB_LIB_PATH="${TCL_STUB_LIB_DIR}/${TCL_STUB_LIB_FILE}" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ TCL_SHARED_BUILD=${SHARED_BUILD} ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. cat >confdef2opt.sed <<\_ACEOF t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g p _ACEOF # We use echo to avoid assuming a particular line-breaking character. # The extra dot is to prevent the shell from consuming trailing # line-breaks from the sub-command output. A line-break within # single-quotes doesn't work because, if this script is created in a # platform that uses two characters for line-breaks (e.g., DOS), tr # would break. ac_LF_and_DOT=`echo; echo .` DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` rm -f confdef2opt.sed CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by tcl $as_me 8.6, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Configuration commands: $config_commands Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ tcl config.status 8.6 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # INIT-COMMANDS section. # VERSION=${TCL_VERSION} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "Tcl-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;; "Tclsh-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;; "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;; "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@MAN_FLAGS@,$MAN_FLAGS,;t t s,@CC@,$CC,;t t s,@CFLAGS@,$CFLAGS,;t t s,@LDFLAGS@,$LDFLAGS,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t s,@CPP@,$CPP,;t t s,@EGREP@,$EGREP,;t t s,@TCL_THREADS@,$TCL_THREADS,;t t s,@SHARED_BUILD@,$SHARED_BUILD,;t t s,@TCLSH_PROG@,$TCLSH_PROG,;t t s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t s,@ZLIB_SRCS@,$ZLIB_SRCS,;t t s,@ZLIB_INCLUDE@,$ZLIB_INCLUDE,;t t s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@AR@,$AR,;t t s,@ac_ct_AR@,$ac_ct_AR,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@TCL_LIBS@,$TCL_LIBS,;t t s,@DL_LIBS@,$DL_LIBS,;t t s,@DL_OBJS@,$DL_OBJS,;t t s,@PLAT_OBJS@,$PLAT_OBJS,;t t s,@PLAT_SRCS@,$PLAT_SRCS,;t t s,@LDAIX_SRC@,$LDAIX_SRC,;t t s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t s,@CFLAGS_NOLTO@,$CFLAGS_NOLTO,;t t s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t s,@CC_SEARCH_FLAGS@,$CC_SEARCH_FLAGS,;t t s,@LD_SEARCH_FLAGS@,$LD_SEARCH_FLAGS,;t t s,@STLIB_LD@,$STLIB_LD,;t t s,@SHLIB_LD@,$SHLIB_LD,;t t s,@TCL_SHLIB_LD_EXTRAS@,$TCL_SHLIB_LD_EXTRAS,;t t s,@TK_SHLIB_LD_EXTRAS@,$TK_SHLIB_LD_EXTRAS,;t t s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t s,@MAKE_LIB@,$MAKE_LIB,;t t s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t s,@INSTALL_LIB@,$INSTALL_LIB,;t t s,@DLL_INSTALL_DIR@,$DLL_INSTALL_DIR,;t t s,@INSTALL_STUB_LIB@,$INSTALL_STUB_LIB,;t t s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t s,@DTRACE@,$DTRACE,;t t s,@TCL_VERSION@,$TCL_VERSION,;t t s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t s,@TCL_YEAR@,$TCL_YEAR,;t t s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t s,@LD_LIBRARY_PATH_VAR@,$LD_LIBRARY_PATH_VAR,;t t s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t s,@TCL_SHARED_LIB_SUFFIX@,$TCL_SHARED_LIB_SUFFIX,;t t s,@TCL_UNSHARED_LIB_SUFFIX@,$TCL_UNSHARED_LIB_SUFFIX,;t t s,@TCL_HAS_LONGLONG@,$TCL_HAS_LONGLONG,;t t s,@INSTALL_TZDATA@,$INSTALL_TZDATA,;t t s,@DTRACE_SRC@,$DTRACE_SRC,;t t s,@DTRACE_HDR@,$DTRACE_HDR,;t t s,@DTRACE_OBJ@,$DTRACE_OBJ,;t t s,@MAKEFILE_SHELL@,$MAKEFILE_SHELL,;t t s,@BUILD_DLTEST@,$BUILD_DLTEST,;t t s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t s,@TCL_MODULE_PATH@,$TCL_MODULE_PATH,;t t s,@TCL_LIBRARY@,$TCL_LIBRARY,;t t s,@PRIVATE_INCLUDE_DIR@,$PRIVATE_INCLUDE_DIR,;t t s,@HTML_DIR@,$HTML_DIR,;t t s,@PACKAGE_DIR@,$PACKAGE_DIR,;t t s,@EXTRA_CC_SWITCHES@,$EXTRA_CC_SWITCHES,;t t s,@EXTRA_APP_CC_SWITCHES@,$EXTRA_APP_CC_SWITCHES,;t t s,@EXTRA_INSTALL@,$EXTRA_INSTALL,;t t s,@EXTRA_INSTALL_BINARIES@,$EXTRA_INSTALL_BINARIES,;t t s,@EXTRA_BUILD_HTML@,$EXTRA_BUILD_HTML,;t t s,@EXTRA_TCLSH_LIBS@,$EXTRA_TCLSH_LIBS,;t t s,@DLTEST_LD@,$DLTEST_LD,;t t s,@DLTEST_SUFFIX@,$DLTEST_SUFFIX,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # # CONFIG_COMMANDS section. # for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue ac_dest=`echo "$ac_file" | sed 's,:.*,,'` ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_dir=`(dirname "$ac_dest") 2>/dev/null || $as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_dest" : 'X\(//\)[^/]' \| \ X"$ac_dest" : 'X\(//\)$' \| \ X"$ac_dest" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_dest" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac { echo "$as_me:$LINENO: executing $ac_dest commands" >&5 echo "$as_me: executing $ac_dest commands" >&6;} case $ac_dest in Tcl.framework ) n=Tcl && f=$n.framework && v=Versions/$VERSION && rm -rf $f && mkdir -p $f/$v/Resources && ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && unset n f v ;; esac done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi tcl8.6.14/unix/configure.in0000644000175000017500000011074214554262142015143 0ustar sergeisergei#! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. AC_INIT([tcl],[8.6]) AC_PREREQ([2.59]) dnl This is only used when included from macosx/configure.ac m4_ifdef([SC_USE_CONFIG_HEADERS], [ AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in]) AC_CONFIG_COMMANDS_PRE([DEFS="-DHAVE_TCL_CONFIG_H -imacros tclConfig.h"]) AH_TOP([ #ifndef _TCLCONFIG #define _TCLCONFIG]) AH_BOTTOM([ /* Undef unused package specific autoheader defines so that we can * include both tclConfig.h and tkConfig.h at the same time: */ /* override */ #undef PACKAGE_NAME /* override */ #undef PACKAGE_TARNAME /* override */ #undef PACKAGE_VERSION /* override */ #undef PACKAGE_STRING #endif /* _TCLCONFIG */]) ]) TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL=".14" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} #------------------------------------------------------------------------ # Setup configure arguments for bundled packages #------------------------------------------------------------------------ PKG_CFG_ARGS="$ac_configure_args ${PKG_CFG_ARGS}" if test -r "$cache_file" -a -f "$cache_file"; then case $cache_file in [[\\/]]* | ?:[[\\/]]* ) pkg_cache_file=$cache_file ;; *) pkg_cache_file=../../$cache_file ;; esac PKG_CFG_ARGS="${PKG_CFG_ARGS} --cache-file=$pkg_cache_file" fi #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ #rm -Rf pkgs if test -f Makefile; then make distclean-packages fi #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then prefix=/usr/local fi if test "${exec_prefix}" = "NONE"; then exec_prefix=$prefix fi # Make sure srcdir is fully qualified! srcdir="`cd "$srcdir" ; pwd`" TCL_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ # Compress and/or soft link the manpages? #------------------------------------------------------------------------ SC_CONFIG_MANPAGES #------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi AC_PROG_CC AC_C_INLINE #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or # strtod in some versions of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- SC_MISSING_POSIX_HEADERS #-------------------------------------------------------------------- # Determines the correct executable file extension (.exe) #-------------------------------------------------------------------- AC_EXEEXT #------------------------------------------------------------------------ # If we're using GCC, see if the compiler understands -pipe. If so, use it. # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then AC_CACHE_CHECK([if the compiler understands -pipe], tcl_cv_cc_pipe, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_pipe=yes],[tcl_cv_cc_pipe=no]) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_pipe = yes; then CFLAGS="$CFLAGS -pipe" fi fi #------------------------------------------------------------------------ # Threads support #------------------------------------------------------------------------ SC_ENABLE_THREADS #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ SC_TCL_CFG_ENCODING #-------------------------------------------------------------------- # Look for libraries that we will need when compiling the Tcl shell #-------------------------------------------------------------------- SC_TCL_LINK_LIBS # Add the threads support libraries LIBS="$LIBS$THREADS_LIBS" SC_ENABLE_SHARED #-------------------------------------------------------------------- # Look for a native installed tclsh binary (if available) # If one cannot be found then use the binary we build (fails for # cross compiling). This is used for NATIVE_TCLSH in Makefile. #-------------------------------------------------------------------- SC_PROG_TCLSH if test "$TCLSH_PROG" = ""; then TCLSH_PROG='./${TCL_EXE}' fi #------------------------------------------------------------------------ # Add stuff for zlib #------------------------------------------------------------------------ zlib_ok=yes AC_CHECK_HEADER([zlib.h],[ AC_CHECK_TYPE([gz_header],[],[zlib_ok=no],[#include ])],[ zlib_ok=no]) AS_IF([test $zlib_ok = yes], [ AC_SEARCH_LIBS([deflateSetHeader],[z],[],[ zlib_ok=no ])]) AS_IF([test $zlib_ok = no], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) AC_SUBST(ZLIB_SRCS,[\${ZLIB_SRCS}]) AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- SC_CONFIG_CFLAGS SC_ENABLE_SYMBOLS(bccdebug) AC_DEFINE(TCL_TOMMATH, 1, [Build libtommath?]) AC_DEFINE(MP_PREC, 4, [Default libtommath precision.]) #-------------------------------------------------------------------- # Detect what compiler flags to set for 64-bit support. #-------------------------------------------------------------------- SC_TCL_EARLY_FLAGS SC_TCL_64BIT_FLAGS #-------------------------------------------------------------------- # Check endianness because we can optimize comparisons of # Tcl_UniChar strings to memcmp on big-endian systems. #-------------------------------------------------------------------- AC_C_BIGENDIAN(,,,[#]) #-------------------------------------------------------------------- # Supply substitutes for missing POSIX library procedures, or # set flags so Tcl uses alternate procedures. #-------------------------------------------------------------------- # Check if Posix compliant getcwd exists, if not we'll use getwd. AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD, 1, [Is getcwd Posix-compliant?])]) # Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really # define USEGETWD even if the Posix getcwd exists. Add a test ? AC_REPLACE_FUNCS(mkstemp opendir strtol waitpid) AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])]) AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])]) AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])]) AC_CHECK_FUNC(fork, , [AC_DEFINE(NO_FORK, 1, [Do we have fork()])]) AC_CHECK_FUNC(mknod, , [AC_DEFINE(NO_MKNOD, 1, [Do we have mknod()])]) AC_CHECK_FUNC(tcdrain, , [AC_DEFINE(NO_TCDRAIN, 1, [Do we have tcdrain()])]) AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])]) if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \ test "`uname -r | awk -F. '{print [$]1}'`" -lt 7; then # prior to Darwin 7, realpath is not threadsafe, so don't # use it when threads are enabled, c.f. bug # 711232 ac_cv_func_realpath=no fi AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH, 1, [Do we have realpath()])]) SC_TCL_IPV6 #-------------------------------------------------------------------- # Look for thread-safe variants of some library functions. #-------------------------------------------------------------------- if test "${TCL_THREADS}" = 1; then SC_TCL_GETPWUID_R SC_TCL_GETPWNAM_R SC_TCL_GETGRGID_R SC_TCL_GETGRNAM_R if test "`uname -s`" = "Darwin" && \ test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1, [Do we have MT-safe gethostbyname() ?]) AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1, [Do we have MT-safe gethostbyaddr() ?]) elif test "`uname -s`" = "HP-UX" && \ test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then # Starting with HPUX 11.00 (we believe), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1, [Do we have MT-safe gethostbyname() ?]) AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1, [Do we have MT-safe gethostbyaddr() ?]) else SC_TCL_GETHOSTBYNAME_R SC_TCL_GETHOSTBYADDR_R fi fi #--------------------------------------------------------------------------- # Check for serial port interface. # # termios.h is present on all POSIX systems. # sys/ioctl.h is almost always present, though what it contains # is system-specific. # sys/modem.h is needed on HP-UX. #--------------------------------------------------------------------------- AC_CHECK_HEADERS(termios.h) AC_CHECK_HEADERS(sys/ioctl.h) AC_CHECK_HEADERS(sys/modem.h) #-------------------------------------------------------------------- # Include sys/select.h if it exists and if it supplies things # that appear to be useful and aren't already in sys/types.h. # This appears to be true only on the RS/6000 under AIX. Some # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- AC_CACHE_CHECK([for fd_set in sys/types], tcl_cv_type_fd_set, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[fd_set readMask, writeMask;]])], [tcl_cv_type_fd_set=yes],[tcl_cv_type_fd_set=no])]) tcl_ok=$tcl_cv_type_fd_set if test $tcl_ok = no; then AC_CACHE_CHECK([for fd_mask in sys/select], tcl_cv_grep_fd_mask, [ AC_EGREP_HEADER(fd_mask, sys/select.h, tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing)]) if test $tcl_cv_grep_fd_mask = present; then AC_DEFINE(HAVE_SYS_SELECT_H, 1, [Should we include ?]) tcl_ok=yes fi fi if test $tcl_ok = no; then AC_DEFINE(NO_FD_SET, 1, [Do we have fd_set?]) fi #------------------------------------------------------------------------------ # Find out all about time handling differences. #------------------------------------------------------------------------------ SC_TIME_HANDLER #-------------------------------------------------------------------- # Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But # we might be able to use fstatfs instead. Some systems (OpenBSD?) also # lack blkcnt_t. #-------------------------------------------------------------------- if test "$ac_cv_cygwin" != "yes"; then AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize]) fi AC_CHECK_TYPES([blkcnt_t]) AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])]) #-------------------------------------------------------------------- # Some system have no memcmp or it does not work with 8 bit data, this # checks it and add memcmp.o to LIBOBJS if needed #-------------------------------------------------------------------- AC_FUNC_MEMCMP #-------------------------------------------------------------------- # Some system like SunOS 4 and other BSD like systems have no memmove # (we assume they have bcopy instead). {The replacement define is in # compat/string.h} #-------------------------------------------------------------------- AC_CHECK_FUNC(memmove, , [ AC_DEFINE(NO_MEMMOVE, 1, [Do we have memmove()?]) AC_DEFINE(NO_STRING_H, 1, [Do we have ?]) ]) #-------------------------------------------------------------------- # On some systems strstr is broken: it returns a pointer even if # the original string is empty. #-------------------------------------------------------------------- SC_TCL_CHECK_BROKEN_FUNC(strstr, [ exit(strstr("\0test", "test") ? 1 : 0); ]) #-------------------------------------------------------------------- # Check for strtoul function. This is tricky because under some # versions of AIX strtoul returns an incorrect terminator # pointer for the string "0". #-------------------------------------------------------------------- SC_TCL_CHECK_BROKEN_FUNC(strtoul, [ char *term, *string = "0"; exit(strtoul(string,&term,0) != 0 || term != string+1); ]) #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- AC_TYPE_MODE_T AC_TYPE_PID_T AC_TYPE_SIZE_T AC_TYPE_UID_T AC_CACHE_CHECK([for socklen_t], tcl_cv_type_socklen_t, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ socklen_t foo; ]])],[tcl_cv_type_socklen_t=yes],[tcl_cv_type_socklen_t=no])]) if test $tcl_cv_type_socklen_t = no; then AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available]) fi AC_CHECK_TYPE([intptr_t], [ AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [ AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [ for tcl_cv_intptr_t in "int" "long" "long long" none; do if test "$tcl_cv_intptr_t" != none; then AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], [tcl_ok=yes], [tcl_ok=no]) test "$tcl_ok" = yes && break; fi done]) if test "$tcl_cv_intptr_t" != none; then AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer type wide enough to hold a pointer.]) fi ]) AC_CHECK_TYPE([uintptr_t], [ AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [ AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [ for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ none; do if test "$tcl_cv_uintptr_t" != none; then AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])], [tcl_ok=yes], [tcl_ok=no]) test "$tcl_ok" = yes && break; fi done]) if test "$tcl_cv_uintptr_t" != none; then AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer type wide enough to hold a pointer.]) fi ]) #-------------------------------------------------------------------- # If a system doesn't have an opendir function (man, that's old!) # then we have to supply a different version of dirent.h which # is compatible with the substitute version of opendir that's # provided. This version only works with V7-style directories. #-------------------------------------------------------------------- AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H, 1, [May we include ?])]) #-------------------------------------------------------------------- # The check below checks whether defines the type # "union wait" correctly. It's needed because of weirdness in # HP-UX where "union wait" is defined in both the BSD and SYS-V # environments. Checking the usability of WIFEXITED seems to do # the trick. #-------------------------------------------------------------------- AC_CACHE_CHECK([union wait], tcl_cv_union_wait, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[ union wait x; WIFEXITED(x); /* Generates compiler error if WIFEXITED * uses an int. */ ]])],[tcl_cv_union_wait=yes],[tcl_cv_union_wait=no])]) if test $tcl_cv_union_wait = no; then AC_DEFINE(NO_UNION_WAIT, 1, [Do we have a usable 'union wait'?]) fi #-------------------------------------------------------------------- # Check whether there is an strncasecmp function on this system. # This is a bit tricky because under SCO it's in -lsocket and # under Sequent Dynix it's in -linet. #-------------------------------------------------------------------- AC_CHECK_FUNC(strncasecmp, tcl_ok=1, tcl_ok=0) if test "$tcl_ok" = 0; then AC_CHECK_LIB(socket, strncasecmp, tcl_ok=1, tcl_ok=0) fi if test "$tcl_ok" = 0; then AC_CHECK_LIB(inet, strncasecmp, tcl_ok=1, tcl_ok=0) fi if test "$tcl_ok" = 0; then AC_LIBOBJ([strncasecmp]) USE_COMPAT=1 fi #-------------------------------------------------------------------- # The code below deals with several issues related to gettimeofday: # 1. Some systems don't provide a gettimeofday function at all # (set NO_GETTOD if this is the case). # 2. See if gettimeofday is declared in the header file. # if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can # declare it. #-------------------------------------------------------------------- AC_CHECK_FUNC(gettimeofday,[],[ AC_DEFINE(NO_GETTOD, 1, [Do we have gettimeofday()?]) ]) AC_CACHE_CHECK([for gettimeofday declaration], tcl_cv_grep_gettimeofday, [ AC_EGREP_HEADER(gettimeofday, sys/time.h, tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing)]) if test $tcl_cv_grep_gettimeofday = missing ; then AC_DEFINE(GETTOD_NOT_DECLARED, 1, [Is gettimeofday() actually declared in ?]) fi #-------------------------------------------------------------------- # The following code checks to see whether it is possible to get # signed chars on this platform. This is needed in order to # properly generate sign-extended ints from character values. #-------------------------------------------------------------------- AC_C_CHAR_UNSIGNED AC_CACHE_CHECK([signed char declarations], tcl_cv_char_signed, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[ signed char *p; p = 0; ]])],[tcl_cv_char_signed=yes],[tcl_cv_char_signed=no])]) if test $tcl_cv_char_signed = yes; then AC_DEFINE(HAVE_SIGNED_CHAR, 1, [Are characters signed?]) fi #-------------------------------------------------------------------- # Does putenv() copy or not? We need to know to avoid memory leaks. #-------------------------------------------------------------------- AC_CACHE_CHECK([for a putenv() that copies the buffer], tcl_cv_putenv_copy, [ AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include #include #define OURVAR "havecopy=yes" int main (int argc, char *argv[]) { char *foo, *bar; foo = (char *)strdup(OURVAR); putenv(foo); strcpy((char *)(strchr(foo, '=') + 1), "no"); bar = getenv("havecopy"); if (!strcmp(bar, "no")) { /* doesnt copy */ return 0; } else { /* does copy */ return 1; } } ]])], [tcl_cv_putenv_copy=no], [tcl_cv_putenv_copy=yes], [tcl_cv_putenv_copy=no])]) if test $tcl_cv_putenv_copy = yes; then AC_DEFINE(HAVE_PUTENV_THAT_COPIES, 1, [Does putenv() copy strings or incorporate them by reference?]) fi #-------------------------------------------------------------------- # Check for support of nl_langinfo function #-------------------------------------------------------------------- SC_ENABLE_LANGINFO #-------------------------------------------------------------------- # Check for support of chflags and mkstemps functions #-------------------------------------------------------------------- AC_CHECK_FUNCS(chflags mkstemps) #-------------------------------------------------------------------- # Check for support of isnan() function or macro #-------------------------------------------------------------------- AC_CACHE_CHECK([isnan], tcl_cv_isnan, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[ isnan(0.0); /* Generates an error if isnan is missing */ ]])],[tcl_cv_isnan=yes],[tcl_cv_isnan=no])]) if test $tcl_cv_isnan = no; then AC_DEFINE(NO_ISNAN, 1, [Do we have a usable 'isnan'?]) fi #-------------------------------------------------------------------- # Darwin specific API checks and defines #-------------------------------------------------------------------- if test "`uname -s`" = "Darwin" ; then AC_CHECK_FUNCS(getattrlist) AC_CHECK_HEADERS(copyfile.h) AC_CHECK_FUNCS(copyfile) if test $tcl_corefoundation = yes; then AC_CHECK_HEADERS(libkern/OSAtomic.h) AC_CHECK_FUNCS(OSSpinLockLock) fi AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8", [Are we to override what our default encoding is?]) AC_DEFINE(TCL_LOAD_FROM_MEMORY, 1, [Can this platform load code from memory?]) AC_DEFINE(TCL_WIDE_CLICKS, 1, [Does this platform have wide high-resolution clicks?]) AC_CHECK_HEADERS(AvailabilityMacros.h) if test "$ac_cv_header_AvailabilityMacros_h" = yes; then AC_CACHE_CHECK([if weak import is available], tcl_cv_cc_weak_import, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_LINK_IFELSE([AC_LANG_PROGRAM([[ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #endif int rand(void) __attribute__((weak_import)); ]], [[rand();]])], [tcl_cv_cc_weak_import=yes],[tcl_cv_cc_weak_import=no]) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_weak_import = yes; then AC_DEFINE(HAVE_WEAK_IMPORT, 1, [Is weak import available?]) fi AC_CACHE_CHECK([if Darwin SUSv3 extensions are available], tcl_cv_cc_darwin_c_source, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #endif #define _DARWIN_C_SOURCE 1 #include ]], [[]])],[tcl_cv_cc_darwin_c_source=yes],[tcl_cv_cc_darwin_c_source=no]) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_darwin_c_source = yes; then AC_DEFINE(_DARWIN_C_SOURCE, 1, [Are Darwin SUSv3 extensions available?]) fi fi # Build .bundle dltest binaries in addition to .dylib DLTEST_LD='${CC} -bundle -Wl,-w ${CFLAGS} ${LDFLAGS}' DLTEST_SUFFIX=".bundle" else DLTEST_LD='${SHLIB_LD}' DLTEST_SUFFIX="" fi #-------------------------------------------------------------------- # Check for support of fts functions (readdir replacement) #-------------------------------------------------------------------- AC_CACHE_CHECK([for fts], tcl_cv_api_fts, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[ #include #include #include ]], [[ char*const p[2] = {"/", NULL}; FTS *f = fts_open(p, FTS_PHYSICAL|FTS_NOCHDIR|FTS_NOSTAT, NULL); FTSENT *e = fts_read(f); fts_close(f); ]])],[tcl_cv_api_fts=yes],[tcl_cv_api_fts=no])]) if test $tcl_cv_api_fts = yes; then AC_DEFINE(HAVE_FTS, 1, [Do we have fts functions?]) fi #-------------------------------------------------------------------- # The statements below check for systems where POSIX-style non-blocking # I/O (O_NONBLOCK) doesn't work or is unimplemented. On these systems # (mostly older ones), use the old BSD-style FIONBIO approach instead. #-------------------------------------------------------------------- SC_BLOCKING_STYLE #------------------------------------------------------------------------ AC_MSG_CHECKING([whether to use dll unloading]) AC_ARG_ENABLE(dll-unloading, AS_HELP_STRING([--enable-dll-unloading], [enable the 'unload' command (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) if test $tcl_ok = yes; then AC_DEFINE(TCL_UNLOAD_DLLS, 1, [Do we allow unloading of shared libraries?]) fi AC_MSG_RESULT([$tcl_ok]) #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can # be overridden on the configure command line either way. #------------------------------------------------------------------------ AC_MSG_CHECKING([for timezone data]) AC_ARG_WITH(tzdata, AS_HELP_STRING([--with-tzdata], [install timezone data (default: autodetect)]), [tcl_ok=$withval], [tcl_ok=auto]) # # Any directories that get added here must also be added to the # search path in ::tcl::clock::Initialize (library/clock.tcl). # case $tcl_ok in no) AC_MSG_RESULT([supplied by OS vendor]) ;; yes) # nothing to do here ;; auto*) AC_CACHE_VAL([tcl_cv_dir_zoneinfo], [ for dir in /usr/share/zoneinfo \ /usr/share/lib/zoneinfo \ /usr/lib/zoneinfo do if test -f $dir/UTC -o -f $dir/GMT then tcl_cv_dir_zoneinfo="$dir" break fi done]) if test -n "$tcl_cv_dir_zoneinfo"; then tcl_ok=no AC_MSG_RESULT([$dir]) else tcl_ok=yes fi ;; *) AC_MSG_ERROR([invalid argument: $tcl_ok]) ;; esac if test $tcl_ok = yes then AC_MSG_RESULT([supplied by Tcl]) INSTALL_TZDATA=install-tzdata fi #-------------------------------------------------------------------- # DTrace support #-------------------------------------------------------------------- AC_ARG_ENABLE(dtrace, AS_HELP_STRING([--enable-dtrace], [build with DTrace support (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) if test $tcl_ok = yes; then AC_CHECK_HEADER(sys/sdt.h, [tcl_ok=yes], [tcl_ok=no]) fi if test $tcl_ok = yes; then AC_PATH_PROG(DTRACE, dtrace,, [$PATH:/usr/sbin]) test -z "$ac_cv_path_DTRACE" && tcl_ok=no fi AC_MSG_CHECKING([whether to enable DTrace support]) MAKEFILE_SHELL='/bin/sh' if test $tcl_ok = yes; then AC_DEFINE(USE_DTRACE, 1, [Are we building with DTrace support?]) DTRACE_SRC="\${DTRACE_SRC}" DTRACE_HDR="\${DTRACE_HDR}" if test "`uname -s`" != "Darwin" ; then DTRACE_OBJ="\${DTRACE_OBJ}" if test "`uname -s`" = "SunOS" -a "$SHARED_BUILD" = "0" ; then # Need to create an intermediate object file to ensure tclDTrace.o # gets included when linking against the static tcl library. STLIB_LD='stlib_ld () { /usr/ccs/bin/ld -r -o $${1%.a}.o "$${@:2}" && '"${STLIB_LD}"' $${1} $${1%.a}.o ; } && stlib_ld' MAKEFILE_SHELL='/bin/bash' # Force use of Sun ar and ranlib, the GNU versions choke on # tclDTrace.o and the combined object file above. AR='/usr/ccs/bin/ar' RANLIB='/usr/ccs/bin/ranlib' fi fi fi AC_MSG_RESULT([$tcl_ok]) #-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[ int index,regsPtr[4]; __asm__ __volatile__("mov %%ebx, %%edi \n\t" "cpuid \n\t" "mov %%ebx, %%esi \n\t" "mov %%edi, %%ebx \n\t" : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index) : "edi"); ]])],[tcl_cv_cpuid=yes],[tcl_cv_cpuid=no])]) if test $tcl_cv_cpuid = yes; then AC_DEFINE(HAVE_CPUID, 1, [Is the cpuid instruction usable?]) fi #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX} eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" # tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed # since on some platforms TCL_LIB_FILE contains shell escapes. # (See also: TCL_TRIM_DOTS). eval "TCL_LIB_FILE=${TCL_LIB_FILE}" test -z "$TCL_LIBRARY" && TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' # Note: in the following variable, it's important to use the absolute # path name of the Tcl directory rather than "..": this is because # AIX remembers this path and will attempt to use it at run-time to look # up the Tcl library. if test "`uname -s`" = "Darwin" ; then SC_ENABLE_FRAMEWORK TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`" TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}' echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000' TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' AC_CONFIG_FILES([Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in]) TCL_YEAR="`date +%Y`" fi if test "$FRAMEWORK_BUILD" = "1" ; then AC_DEFINE(TCL_FRAMEWORK, 1, [Is Tcl built as a framework?]) # Construct a fake local framework structure to make linking with # '-framework Tcl' and running of tcltest work AC_CONFIG_COMMANDS([Tcl.framework], [n=Tcl && f=$n.framework && v=Versions/$VERSION && rm -rf $f && mkdir -p $f/$v/Resources && ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && unset n f v ], VERSION=${TCL_VERSION}) LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" # default install directory for bundled packages if test "${libdir}" = '${exec_prefix}/lib' -o "`basename ${libdir}`" = 'Frameworks'; then PACKAGE_DIR="/Library/Tcl" else PACKAGE_DIR="$libdir" fi if test "${libdir}" = '${exec_prefix}/lib'; then # override libdir default libdir="/Library/Frameworks" fi TCL_LIB_FILE="Tcl" TCL_LIB_FLAG="-framework Tcl" TCL_BUILD_LIB_SPEC="-F`pwd | sed -e 's/ /\\\\ /g'` -framework Tcl" TCL_LIB_SPEC="-F${libdir} -framework Tcl" libdir="${libdir}/Tcl.framework/Versions/\${VERSION}" TCL_LIBRARY="${libdir}/Resources/Scripts" includedir="${libdir}/Headers" PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders" HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl" EXTRA_INSTALL="install-private-headers html-tcl" EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)/TclTOC.html"' EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."' # Don't use AC_DEFINE for the following as the framework version define # needs to go into the Makefile even when using autoheader, so that we # can pick up a potential make override of VERSION. Also, don't put this # into CFLAGS as it should not go into tclConfig.sh EXTRA_CC_SWITCHES='-DTCL_FRAMEWORK_VERSION=\"$(VERSION)\"' else # libdir must be a fully qualified path and not ${exec_prefix}/lib eval libdir="$libdir" # default install directory for bundled packages PACKAGE_DIR="$libdir" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_LIB_FLAG="-ltcl${TCL_VERSION}" else TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`" fi TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" fi VERSION='${VERSION}' eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" VERSION=${TCL_VERSION} #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$FRAMEWORK_BUILD" = "1" ; then test -z "$TCL_PACKAGE_PATH" && \ TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" test -z "$TCL_MODULE_PATH" && \ TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl" elif test "$prefix/lib" != "$libdir"; then test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib} ${TCL_PACKAGE_PATH}" else test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${prefix}/lib} ${TCL_PACKAGE_PATH}" fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl # stub support. #-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_DIR=\"${libdir}\"" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" else TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" fi TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}" TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}" TCL_STUB_LIB_PATH="${TCL_STUB_LIB_DIR}/${TCL_STUB_LIB_FILE}" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ TCL_SHARED_BUILD=${SHARED_BUILD} AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_YEAR) AC_SUBST(PKG_CFG_ARGS) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_PATH) AC_SUBST(TCL_INCLUDE_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_PATH) AC_SUBST(TCL_SRC_DIR) AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX) AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX) AC_SUBST(TCL_SHARED_BUILD) AC_SUBST(LD_LIBRARY_PATH_VAR) AC_SUBST(TCL_BUILD_LIB_SPEC) AC_SUBST(TCL_LIB_VERSIONS_OK) AC_SUBST(TCL_SHARED_LIB_SUFFIX) AC_SUBST(TCL_UNSHARED_LIB_SUFFIX) AC_SUBST(TCL_HAS_LONGLONG) AC_SUBST(INSTALL_TZDATA) AC_SUBST(DTRACE_SRC) AC_SUBST(DTRACE_HDR) AC_SUBST(DTRACE_OBJ) AC_SUBST(MAKEFILE_SHELL) AC_SUBST(BUILD_DLTEST) AC_SUBST(TCL_PACKAGE_PATH) AC_SUBST(TCL_MODULE_PATH) AC_SUBST(TCL_LIBRARY) AC_SUBST(PRIVATE_INCLUDE_DIR) AC_SUBST(HTML_DIR) AC_SUBST(PACKAGE_DIR) AC_SUBST(EXTRA_CC_SWITCHES) AC_SUBST(EXTRA_APP_CC_SWITCHES) AC_SUBST(EXTRA_INSTALL) AC_SUBST(EXTRA_INSTALL_BINARIES) AC_SUBST(EXTRA_BUILD_HTML) AC_SUBST(EXTRA_TCLSH_LIBS) AC_SUBST(DLTEST_LD) AC_SUBST(DLTEST_SUFFIX) dnl Disable the automake-friendly normalization of LIBOBJS dnl performed by autoconf 2.53 and later. It's not correct for us. define([_AC_LIBOBJS_NORMALIZE],[]) AC_CONFIG_FILES([ Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in ]) AC_OUTPUT dnl Local Variables: dnl mode: autoconf dnl End: tcl8.6.14/unix/tcl.m40000644000175000017500000030114114554262142013651 0ustar sergeisergei#------------------------------------------------------------------------ # SC_PATH_TCLCONFIG -- # # Locate the tclConfig.sh file and perform a sanity check on # the Tcl compile flags # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --with-tcl=... # # Defines the following vars: # TCL_BIN_DIR Full path to the directory containing # the tclConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TCLCONFIG], [ # # Ok, lets find the tcl configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true AC_ARG_WITH(tcl, AS_HELP_STRING([--with-tcl], [directory containing tcl configuration (tclConfig.sh)]), [with_tclconfig="${withval}"]) AC_MSG_CHECKING([for Tcl configuration]) AC_CACHE_VAL(ac_cv_c_tclconfig,[ # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then case "${with_tclconfig}" in */tclConfig.sh ) if test -f "${with_tclconfig}"; then AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself]) with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" fi ;; esac if test -f "${with_tclconfig}/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" else AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) fi fi # then check for a private Tcl installation if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ../tcl \ `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ ../../tcl \ `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ ../../../tcl \ `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" break fi done fi # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tcl.framework/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`" break fi done fi # check in a few common install locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ `ls -d /usr/lib/tcl8.6 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ `ls -d /usr/local/lib/tcl8.6 2>/dev/null` \ `ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" break fi done fi # check in a few other private locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ${srcdir}/../tcl \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" break fi done fi ]) if test x"${ac_cv_c_tclconfig}" = x ; then TCL_BIN_DIR="# no Tcl configs found" AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) else no_tcl= TCL_BIN_DIR="${ac_cv_c_tclconfig}" AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) fi fi ]) #------------------------------------------------------------------------ # SC_PATH_TKCONFIG -- # # Locate the tkConfig.sh file # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --with-tk=... # # Defines the following vars: # TK_BIN_DIR Full path to the directory containing # the tkConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Ok, lets find the tk configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then # we reset no_tk in case something fails here no_tk=true AC_ARG_WITH(tk, AS_HELP_STRING([--with-tk], [directory containing tk configuration (tkConfig.sh)]), [with_tkconfig="${withval}"]) AC_MSG_CHECKING([for Tk configuration]) AC_CACHE_VAL(ac_cv_c_tkconfig,[ # First check to see if --with-tkconfig was specified. if test x"${with_tkconfig}" != x ; then case "${with_tkconfig}" in */tkConfig.sh ) if test -f "${with_tkconfig}"; then AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself]) with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`" fi ;; esac if test -f "${with_tkconfig}/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`" else AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) fi fi # then check for a private Tk library if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ../tk \ `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ ../../tk \ `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ ../../../tk \ `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/unix; pwd)`" break fi done fi # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tk.framework/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/Tk.framework; pwd)`" break fi done fi # check in a few common install locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ `ls -d /usr/lib/tk8.6 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ `ls -d /usr/local/lib/tk8.6 2>/dev/null` \ `ls -d /usr/local/lib/tcl/tk8.6 2>/dev/null` \ ; do if test -f "$i/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i; pwd)`" break fi done fi # check in a few other private locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ${srcdir}/../tk \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/unix; pwd)`" break fi done fi ]) if test x"${ac_cv_c_tkconfig}" = x ; then TK_BIN_DIR="# no Tk configs found" AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) else no_tk= TK_BIN_DIR="${ac_cv_c_tkconfig}" AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) fi fi ]) #------------------------------------------------------------------------ # SC_LOAD_TCLCONFIG -- # # Load the tclConfig.sh file # # Arguments: # # Requires the following vars to be set: # TCL_BIN_DIR # # Results: # # Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # If the TCL_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TCL_LIB_SPEC will be set to the value # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TCL_BIN_DIR}/Makefile" ; then TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tcl.framework installed in an arbitrary location. case ${TCL_DEFS} in *TCL_FRAMEWORK*) if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then for i in "`cd "${TCL_BIN_DIR}"; pwd`" \ "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}" break fi done fi if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi ;; esac fi AC_SUBST(TCL_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) ]) #------------------------------------------------------------------------ # SC_LOAD_TKCONFIG -- # # Load the tkConfig.sh file # # Arguments: # # Requires the following vars to be set: # TK_BIN_DIR # # Results: # # Sets the following vars that should be in tkConfig.sh: # TK_BIN_DIR #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TKCONFIG], [ AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TK_BIN_DIR}/tkConfig.sh" else AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi # If the TK_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TK_LIB_SPEC will be set to the value # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC # instead of TK_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TK_BIN_DIR}/Makefile" ; then TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tk was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tk.framework installed in an arbitrary location. case ${TK_DEFS} in *TK_FRAMEWORK*) if test -f "${TK_BIN_DIR}/${TK_LIB_FILE}"; then for i in "`cd "${TK_BIN_DIR}"; pwd`" \ "`cd "${TK_BIN_DIR}"/../..; pwd`"; do if test "`basename "$i"`" = "${TK_LIB_FILE}.framework"; then TK_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TK_LIB_FILE}" break fi done fi if test -f "${TK_BIN_DIR}/${TK_STUB_LIB_FILE}"; then TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" fi ;; esac fi AC_SUBST(TK_VERSION) AC_SUBST(TK_BIN_DIR) AC_SUBST(TK_SRC_DIR) AC_SUBST(TK_LIB_FILE) AC_SUBST(TK_LIB_FLAG) AC_SUBST(TK_LIB_SPEC) AC_SUBST(TK_STUB_LIB_FILE) AC_SUBST(TK_STUB_LIB_FLAG) AC_SUBST(TK_STUB_LIB_SPEC) ]) #------------------------------------------------------------------------ # SC_PROG_TCLSH # Locate a tclsh shell installed on the system path. This macro # will only find a Tcl shell that already exists on the system. # It will not find a Tcl shell in the Tcl build directory or # a Tcl shell that has been installed from the Tcl build directory. # If a Tcl shell can't be located on the PATH, then TCLSH_PROG will # be set to "". Extensions should take care not to create Makefile # rules that are run by default and depend on TCLSH_PROG. An # extension can't assume that an executable Tcl shell exists at # build time. # # Arguments: # none # # Results: # Substitutes the following vars: # TCLSH_PROG #------------------------------------------------------------------------ AC_DEFUN([SC_PROG_TCLSH], [ AC_MSG_CHECKING([for tclsh]) AC_CACHE_VAL(ac_cv_path_tclsh, [ search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[[8-9]]* 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done ]) if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" AC_MSG_RESULT([$TCLSH_PROG]) else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" AC_MSG_RESULT([No tclsh found on PATH]) fi AC_SUBST(TCLSH_PROG) ]) #------------------------------------------------------------------------ # SC_BUILD_TCLSH # Determine the fully qualified path name of the tclsh executable # in the Tcl build directory. This macro will correctly determine # the name of the tclsh executable even if tclsh has not yet # been built in the build directory. The build tclsh must be used # when running tests from an extension build directory. It is not # correct to use the TCLSH_PROG in cases like this. # # Arguments: # none # # Results: # Substitutes the following values: # BUILD_TCLSH #------------------------------------------------------------------------ AC_DEFUN([SC_BUILD_TCLSH], [ AC_MSG_CHECKING([for tclsh in Tcl build directory]) BUILD_TCLSH="${TCL_BIN_DIR}"/tclsh AC_MSG_RESULT([$BUILD_TCLSH]) AC_SUBST(BUILD_TCLSH) ]) #------------------------------------------------------------------------ # SC_ENABLE_SHARED -- # # Allows the building of shared libraries # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-shared=yes|no # # Defines the following vars: # STATIC_BUILD Used for building import/export libraries # on Windows. # # Sets the following vars: # SHARED_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, AS_HELP_STRING([--enable-shared], [build and link with shared libraries (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes" ; then AC_MSG_RESULT([shared]) SHARED_BUILD=1 else AC_MSG_RESULT([static]) SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi AC_SUBST(SHARED_BUILD) ]) #------------------------------------------------------------------------ # SC_ENABLE_FRAMEWORK -- # # Allows the building of shared libraries into frameworks # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-framework=yes|no # # Sets the following vars: # FRAMEWORK_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_FRAMEWORK], [ if test "`uname -s`" = "Darwin" ; then AC_MSG_CHECKING([how to package libraries]) AC_ARG_ENABLE(framework, AS_HELP_STRING([--enable-framework], [package shared libraries in MacOSX frameworks (default: off)]), [enable_framework=$enableval], [enable_framework=no]) if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then AC_MSG_WARN([Frameworks can only be built if --enable-shared is yes]) enable_framework=no fi if test $tcl_corefoundation = no; then AC_MSG_WARN([Frameworks can only be used when CoreFoundation is available]) enable_framework=no fi fi if test $enable_framework = yes; then AC_MSG_RESULT([framework]) FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then AC_MSG_RESULT([shared library]) else AC_MSG_RESULT([static library]) fi FRAMEWORK_BUILD=0 fi fi ]) #------------------------------------------------------------------------ # SC_ENABLE_THREADS -- # # Specify if thread support should be enabled # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-threads # # Sets the following vars: # THREADS_LIBS Thread library(s) # # Defines the following vars: # TCL_THREADS # _REENTRANT # _THREAD_SAFE #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_THREADS], [ AC_ARG_ENABLE(threads, AS_HELP_STRING([--enable-threads], [build with threads (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) if test "${TCL_THREADS}" = 1; then tcl_threaded_core=1; fi if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then TCL_THREADS=1 # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention AC_DEFINE(USE_THREAD_ALLOC, 1, [Do we want to use the threaded memory allocator?]) AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) if test "`uname -s`" = "SunOS" ; then AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, [Do we really want to follow the standard? Yes we do!]) fi AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?]) AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) if test "$tcl_ok" = "no"; then # Check a little harder for __pthread_mutex_init in the same # library, as some systems hide it there until pthread.h is # defined. We could alternatively do an AC_TRY_COMPILE with # pthread.h, but that will work with libpthread really doesn't # exist, like AIX 4.2. [Bug: 4359] AC_CHECK_LIB(pthread, __pthread_mutex_init, tcl_ok=yes, tcl_ok=no) fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthread" else AC_CHECK_LIB(pthreads, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthreads" else AC_CHECK_LIB(c, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "no"; then AC_CHECK_LIB(c_r, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -pthread" else TCL_THREADS=0 AC_MSG_WARN([Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...]) fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork) LIBS=$ac_saved_libs else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output AC_MSG_CHECKING([for building with threads]) if test "${TCL_THREADS}" = 1; then AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?]) if test "${tcl_threaded_core}" = 1; then AC_MSG_RESULT([yes (threaded core)]) else AC_MSG_RESULT([yes]) fi else AC_MSG_RESULT([no]) fi AC_SUBST(TCL_THREADS) ]) #------------------------------------------------------------------------ # SC_ENABLE_SYMBOLS -- # # Specify if debugging symbols should be used. # Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging # can also be enabled. # # Arguments: # none # # Requires the following vars to be set in the Makefile: # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # LDFLAGS_DEBUG # LDFLAGS_OPTIMIZE # # Results: # # Adds the following arguments to configure: # --enable-symbols # # Defines the following vars: # CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true # Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, AS_HELP_STRING([--enable-symbols], [build with debugging symbols (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?]) AC_MSG_RESULT([no]) AC_DEFINE(TCL_CFG_OPTIMIZED, 1, [Is this an optimized build?]) else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then AC_MSG_RESULT([yes (standard debugging)]) fi fi AC_SUBST(CFLAGS_DEFAULT) AC_SUBST(LDFLAGS_DEFAULT) if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?]) fi ifelse($1,bccdebug,dnl Only enable 'compile' for the Tcl core itself if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then AC_DEFINE(TCL_COMPILE_DEBUG, 1, [Is bytecode debugging enabled?]) AC_DEFINE(TCL_COMPILE_STATS, 1, [Are bytecode statistics enabled?]) fi) if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then AC_MSG_RESULT([enabled symbols mem ]ifelse($1,bccdebug,[compile ])[debugging]) else AC_MSG_RESULT([enabled $tcl_ok debugging]) fi fi ]) #------------------------------------------------------------------------ # SC_ENABLE_LANGINFO -- # # Allows use of modern nl_langinfo check for better l10n. # This is only relevant for Unix. # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-langinfo=yes|no (default is yes) # # Defines the following vars: # HAVE_LANGINFO Triggers use of nl_langinfo if defined. #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_LANGINFO], [ AC_ARG_ENABLE(langinfo, AS_HELP_STRING([--enable-langinfo], [use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on)]), [langinfo_ok=$enableval], [langinfo_ok=yes]) HAVE_LANGINFO=0 if test "$langinfo_ok" = "yes"; then AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no]) fi AC_MSG_CHECKING([whether to use nl_langinfo]) if test "$langinfo_ok" = "yes"; then AC_CACHE_VAL(tcl_cv_langinfo_h, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[nl_langinfo(CODESET);]])], [tcl_cv_langinfo_h=yes], [tcl_cv_langinfo_h=no])]) AC_MSG_RESULT([$tcl_cv_langinfo_h]) if test $tcl_cv_langinfo_h = yes; then AC_DEFINE(HAVE_LANGINFO, 1, [Do we have nl_langinfo()?]) fi else AC_MSG_RESULT([$langinfo_ok]) fi ]) #-------------------------------------------------------------------- # SC_CONFIG_MANPAGES # # Decide whether to use symlinks for linking the manpages, # whether to compress the manpages after installation, and # whether to add a package name suffix to the installed # manpages to avoidfile name clashes. # If compression is enabled also find out what file name suffix # the given compression program is using. # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-man-symlinks # --enable-man-compression=PROG # --enable-man-suffix[=STRING] # # Defines the following variable: # # MAN_FLAGS - The apropriate flags for installManPage # according to the user's selection. # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_MANPAGES], [ AC_MSG_CHECKING([whether to use symlinks for manpages]) AC_ARG_ENABLE(man-symlinks, AS_HELP_STRING([--enable-man-symlinks], [use symlinks for the manpages (default: off)]), [test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks"], [enableval="no"]) AC_MSG_RESULT([$enableval]) AC_MSG_CHECKING([whether to compress the manpages]) AC_ARG_ENABLE(man-compression, AS_HELP_STRING([--enable-man-compression=PROG], [compress the manpages with PROG (default: off)]), [case $enableval in yes) AC_MSG_ERROR([missing argument to --enable-man-compression]);; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac], [enableval="no"]) AC_MSG_RESULT([$enableval]) if test "$enableval" != "no"; then AC_MSG_CHECKING([for compressed file suffix]) touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" AC_MSG_RESULT([$Z]) fi AC_MSG_CHECKING([whether to add a package name suffix for the manpages]) AC_ARG_ENABLE(man-suffix, AS_HELP_STRING([--enable-man-suffix=STRING], [use STRING as a suffix to manpage file names (default: no, AC_PACKAGE_NAME if enabled without specifying STRING)]), [case $enableval in yes) enableval="AC_PACKAGE_NAME" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac], [enableval="no"]) AC_MSG_RESULT([$enableval]) AC_SUBST(MAN_FLAGS) ]) #-------------------------------------------------------------------- # SC_CONFIG_SYSTEM # # Determine what the system is (some things cannot be easily checked # on a feature-driven basis, alas). This can usually be done via the # "uname" command, but there are a few systems, like Next, where # this doesn't work. # # Arguments: # none # # Results: # Defines the following var: # # system - System/platform/version identification code. # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_SYSTEM], [ AC_CACHE_CHECK([system version], tcl_cv_sys_version, [ if test -f /usr/lib/NextStep/software_version; then tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then AC_MSG_WARN([can't find uname command]) tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then tcl_cv_sys_version=MP-RAS-`awk '{print $[3]}' /etc/.relid` fi if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then tcl_cv_sys_version=NetBSD-Debian fi fi fi ]) system=$tcl_cv_sys_version ]) #-------------------------------------------------------------------- # SC_CONFIG_CFLAGS # # Try to determine the proper flags to pass to the compiler # for building shared libraries and other such nonsense. # # Arguments: # none # # Results: # # Defines and substitutes the following vars: # # DL_OBJS - Name of the object file that implements dynamic # loading for Tcl on this system. # DL_LIBS - Library file(s) to include in tclsh and other base # applications in order for the "load" command to work. # LDFLAGS - Flags to pass to the compiler when linking object # files into an executable application binary such # as tclsh. # LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib", # that tell the run-time dynamic linker where to look # for shared libraries such as libtcl.so. Depends on # the variable LIB_RUNTIME_DIR in the Makefile. Could # be the same as CC_SEARCH_FLAGS if ${CC} is used to link. # CC_SEARCH_FLAGS-Flags to pass to ${CC}, such as "-Wl,-rpath,/usr/local/tcl/lib", # that tell the run-time dynamic linker where to look # for shared libraries such as libtcl.so. Depends on # the variable LIB_RUNTIME_DIR in the Makefile. # MAKE_LIB - Command to execute to build the a library; # differs when building shared or static. # MAKE_STUB_LIB - # Command to execute to build a stub library. # INSTALL_LIB - Command to execute to install a library; # differs when building shared or static. # INSTALL_STUB_LIB - # Command to execute to install a stub library. # STLIB_LD - Base command to use for combining object files # into a static library. # SHLIB_CFLAGS - Flags to pass to cc when compiling the components # of a shared library (may request position-independent # code, among other things). # SHLIB_LD - Base command to use for combining object files # into a shared library. # SHLIB_LD_LIBS - Dependent libraries for the linker to scan when # creating shared libraries. This symbol typically # goes at the end of the "ld" commands that build # shared libraries. The value of the symbol defaults to # "${LIBS}" if all of the dependent libraries should # be specified when creating a shared library. If # dependent libraries should not be specified (as on # SunOS 4.x, where they cause the link to fail, or in # general if Tcl and Tk aren't themselves shared # libraries), then this symbol has an empty string # as its value. # SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable # extensions. An empty string means we don't know how # to use shared libraries on this platform. # TCL_SHLIB_LD_EXTRAS - Additional element which are added to SHLIB_LD_LIBS # TK_SHLIB_LD_EXTRAS for the build of Tcl and Tk, but not recorded in the # tclConfig.sh, since they are only used for the build # of Tcl and Tk. # Examples: MacOS X records the library version and # compatibility version in the shared library. But # of course the Tcl version of this is only used for Tcl. # LIB_SUFFIX - Specifies everything that comes after the "libfoo" # in a static or shared library name, using the $VERSION variable # to put the version in the right place. This is used # by platforms that need non-standard library names. # Examples: ${VERSION}.so.1.1 on NetBSD, since it needs # to have a version after the .so, and ${VERSION}.a # on AIX, since a shared library needs to have # a .a extension whereas shared objects for loadable # extensions have a .so extension. Defaults to # ${VERSION}${SHLIB_SUFFIX}. # TCL_LIBS - # Libs to use when linking Tcl shell or some other # shell that includes Tcl libs. # CFLAGS_DEBUG - # Flags used when running the compiler in debug mode # CFLAGS_OPTIMIZE - # Flags used when running the compiler in optimize mode # CFLAGS - Additional CFLAGS added as necessary (usually 64-bit) # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_CFLAGS], [ # Step 0.a: Enable 64 bit support? AC_MSG_CHECKING([if 64bit support is requested]) AC_ARG_ENABLE(64bit, AS_HELP_STRING([--enable-64bit], [enable 64bit support (default: off)]), [do64bit=$enableval], [do64bit=no]) AC_MSG_RESULT([$do64bit]) # Step 0.b: Enable Solaris 64 bit VIS support? AC_MSG_CHECKING([if 64bit Sparc VIS support is requested]) AC_ARG_ENABLE(64bit-vis, AS_HELP_STRING([--enable-64bit-vis], [enable 64bit Sparc VIS support (default: off)]), [do64bitVIS=$enableval], [do64bitVIS=no]) AC_MSG_RESULT([$do64bitVIS]) # Force 64bit on with VIS AS_IF([test "$do64bitVIS" = "yes"], [do64bit=yes]) # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. AC_CACHE_CHECK([if compiler supports visibility "hidden"], tcl_cv_cc_visibility_hidden, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_LINK_IFELSE([AC_LANG_PROGRAM([[ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {}]], [[f();]])], [tcl_cv_cc_visibility_hidden=yes], [tcl_cv_cc_visibility_hidden=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ AC_DEFINE(MODULE_SCOPE, [extern __attribute__((__visibility__("hidden")))], [Compiler support for module scope symbols]) AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols]) ]) # Step 0.d: Disable -rpath support? AC_MSG_CHECKING([if rpath support is requested]) AC_ARG_ENABLE(rpath, AS_HELP_STRING([--disable-rpath], [disable rpath support (default: on)]), [doRpath=$enableval], [doRpath=yes]) AC_MSG_RESULT([$doRpath]) # Step 1: set the variable "system" to hold the name and version number # for the system. SC_CONFIG_SYSTEM # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no) # Require ranlib early so we can override it in special cases below. AC_REQUIRE([AC_PROG_RANLIB]) # Step 3: set configuration options based on system name and version. do64bit_ok=no # default to '{$LIBS}' and set to "" on per-platform necessary basis SHLIB_LD_LIBS='${LIBS}' LDFLAGS_ORIG="$LDFLAGS" # When ld needs options to work in 64-bit mode, put them in # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] # is disabled by the user. [Bug 1016796] LDFLAGS_ARCH="" UNSHARED_LIB_SUFFIX="" TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`' ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g AS_IF([test "$GCC" = yes], [ CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall -Wpointer-arith" ], [ CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" ]) AC_CHECK_TOOL(AR, ar) STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" AS_IF([test "x${SHLIB_VERSION}" = x],[SHLIB_VERSION=".1.0"],[SHLIB_VERSION=".${SHLIB_VERSION}"]) case $system in AIX-*) AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [ # AIX requires the _r compiler when gcc isn't being used case "${CC}" in *_r|*_r\ *) # ok ... ;; *) # Make sure only first arg gets _r CC=`echo "$CC" | sed -e 's/^\([[^ ]]*\)/\1_r/'` ;; esac AC_MSG_RESULT([Using $CC for compiling with threads]) ]) LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" LD_LIBRARY_PATH_VAR="LIBPATH" # ldAix No longer needed with use of -bexpall/-brtl # but some extensions may still reference it LDAIX_SRC='$(UNIX_DIR)/ldAix' # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = yes], [ AS_IF([test "$GCC" = yes], [ AC_MSG_WARN([64bit mode not supported with GCC on $system]) ], [ do64bit_ok=yes CFLAGS="$CFLAGS -q64" LDFLAGS_ARCH="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" ]) ]) AS_IF([test "`uname -m`" = ia64], [ # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" AS_IF([test "$GCC" = yes], [ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' ], [ CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' ]) LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' ], [ AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared -Wl,-bexpall' ], [ SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" LDFLAGS="$LDFLAGS -brtl" ]) SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ]) ;; BeOS*) SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -nostart' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" #----------------------------------------------------------- # Check for inet_ntoa in -lbind, for BeOS (which also needs # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- AC_CHECK_LIB(bind, inet_ntoa, [LIBS="$LIBS -lbind -lsocket"]) ;; BSD/OS-2.1*|BSD/OS-3*) SHLIB_CFLAGS="" SHLIB_LD="shlicc -r" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; BSD/OS-4.*) SHLIB_CFLAGS="-export-dynamic -fPIC" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32_*|MSYS_*) SHLIB_CFLAGS="-fno-common" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" AC_CACHE_CHECK(for Cygwin version of gcc, ac_cv_cygwin, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef __CYGWIN__ #error cygwin #endif ]], [[]])], [ac_cv_cygwin=no], [ac_cv_cygwin=yes]) ) if test "$ac_cv_cygwin" = "no"; then AC_MSG_ERROR([${CC} is not a cygwin compiler.]) fi if test "x${TCL_THREADS}" = "x0"; then AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads]) fi do64bit_ok=yes if test "x${SHARED_BUILD}" = "x1"; then echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32" # The eval makes quoting arguments work. if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32; cd ../unix then : else { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } fi fi ;; dgux*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" AC_CHECK_LIB(network, inet_ntoa, [LIBS="$LIBS -lnetwork"]) ;; HP-UX-*.11.*) # Use updated header definitions where possible AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Do we want to use the XOPEN network library?]) AC_DEFINE(_XOPEN_SOURCE, 1, [Do we want to use the XOPEN network library?]) LIBS="$LIBS -lxnet" # Use the XOPEN network library AS_IF([test "`uname -m`" = ia64], [ SHLIB_SUFFIX=".so" ], [ SHLIB_SUFFIX=".sl" ]) AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no) AS_IF([test "$tcl_ok" = yes], [ SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" ]) AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ], [ CFLAGS="$CFLAGS -z" ]) # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = "yes"], [ AS_IF([test "$GCC" = yes], [ case `${CC} -dumpmachine` in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) AC_MSG_WARN([64bit mode not supported with GCC on $system]) ;; esac ], [ do64bit_ok=yes CFLAGS="$CFLAGS +DD64" LDFLAGS_ARCH="+DD64" ]) ]) ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no) AS_IF([test "$tcl_ok" = yes], [ SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" SHLIB_LD_LIBS="" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" ]) ;; IRIX-5.*) SHLIB_CFLAGS="" SHLIB_LD="ld -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) ;; IRIX-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) AS_IF([test "$GCC" = yes], [ CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" ], [ case $system in IRIX-6.3) # Use to build 6.2 compatible binaries on 6.3. CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" ;; *) CFLAGS="$CFLAGS -n32" ;; esac LDFLAGS="$LDFLAGS -n32" ]) ;; IRIX64-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = yes], [ AS_IF([test "$GCC" = yes], [ AC_MSG_WARN([64bit mode not supported by gcc]) ], [ do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" ]) ]) ;; Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*) SHLIB_CFLAGS="-fPIC -fno-common" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" case $system in DragonFly-*|FreeBSD-*) AS_IF([test "${TCL_THREADS}" = "1"], [ # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) ;; esac AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"]) AS_IF([test $do64bit = yes], [ AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])], [tcl_cv_cc_m64=yes],[tcl_cv_cc_m64=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_m64 = yes], [ CFLAGS="$CFLAGS -m64" do64bit_ok=yes ]) ]) # The combo of gcc + glibc has a bug related to inlining of # functions like strtod(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE=-02 SHLIB_LD='${CC} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) ;; MP-RAS-02*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; MP-RAS-*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,-Bexport" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OpenBSD-*) arch=`arch -s` case "$arch" in alpha|sparc64) SHLIB_CFLAGS="-fPIC" ;; *) SHLIB_CFLAGS="-fpic" ;; esac SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" CFLAGS_OPTIMIZE="-O2" AS_IF([test "${TCL_THREADS}" = "1"], [ # On OpenBSD: Compile with -pthread # Don't link with -lpthread LIBS=`echo $LIBS | sed s/-lpthread//` CFLAGS="$CFLAGS -pthread" ]) # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} AS_IF([test "${TCL_THREADS}" = "1"], [ # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" ]) ;; Darwin-*) CFLAGS_OPTIMIZE="-O2" SHLIB_CFLAGS="-fno-common" # To avoid discrepancies between what headers configure sees during # preprocessing tests and compiling tests, move any -isysroot and # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if ([$]i~/^(isysroot|mmacosx-version-min)/) print "-"[$]i}'`" CFLAGS="`echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if (!([$]i~/^(isysroot|mmacosx-version-min)/)) print "-"[$]i}'`" AS_IF([test $do64bit = yes], [ case `arch` in ppc) AC_CACHE_CHECK([if compiler accepts -arch ppc64 flag], tcl_cv_cc_arch_ppc64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])], [tcl_cv_cc_arch_ppc64=yes],[tcl_cv_cc_arch_ppc64=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_arch_ppc64 = yes], [ CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes ]);; i386|x86_64) AC_CACHE_CHECK([if compiler accepts -arch x86_64 flag], tcl_cv_cc_arch_x86_64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])], [tcl_cv_cc_arch_x86_64=yes],[tcl_cv_cc_arch_x86_64=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [ CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes ]);; arm64) AC_CACHE_CHECK([if compiler accepts -arch arm64 flag], tcl_cv_cc_arch_arm64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch arm64" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])], [tcl_cv_cc_arch_arm64=yes],[tcl_cv_cc_arch_arm64=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_arch_arm64 = yes], [ CFLAGS="$CFLAGS -arch arm64" do64bit_ok=yes ]);; *) AC_MSG_WARN([Don't know how enable 64-bit on architecture `arch`]);; esac ], [ # Check for combined 32-bit and 64-bit fat build AS_IF([echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64|arm64) ' \ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '], [ fat_32_64=yes]) ]) SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])],[tcl_cv_ld_single_module=yes], [tcl_cv_ld_single_module=no]) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_single_module = yes], [ SHLIB_LD="${SHLIB_LD} -Wl,-single_module" ]) SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" LDFLAGS="$LDFLAGS -headerpad_max_install_names" AC_CACHE_CHECK([if ld accepts -search_paths_first flag], tcl_cv_ld_search_paths_first, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])], [tcl_cv_ld_search_paths_first=yes], [tcl_cv_ld_search_paths_first=no]) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_search_paths_first = yes], [ LDFLAGS="$LDFLAGS -Wl,-search_paths_first" ]) AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [__private_extern__], [Compiler support for module scope symbols]) tcl_cv_cc_visibility_hidden=yes ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_FALLBACK_LIBRARY_PATH" AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?]) PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' AC_MSG_CHECKING([whether to use CoreFoundation]) AC_ARG_ENABLE(corefoundation, AS_HELP_STRING([--enable-corefoundation], [use CoreFoundation API on MacOSX (default: on)]), [tcl_corefoundation=$enableval], [tcl_corefoundation=yes]) AC_MSG_RESULT([$tcl_corefoundation]) AS_IF([test $tcl_corefoundation = yes], [ AC_CACHE_CHECK([for CoreFoundation.framework], tcl_cv_lib_corefoundation, [ hold_libs=$LIBS AS_IF([test "$fat_32_64" = yes], [ for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit # archs from CFLAGS et al. while testing for # presence of CF. 64-bit CF is disabled in # tclUnixPort.h if necessary. eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done]) LIBS="$LIBS -framework CoreFoundation" AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[CFBundleRef b = CFBundleGetMainBundle();]])], [tcl_cv_lib_corefoundation=yes], [tcl_cv_lib_corefoundation=no]) AS_IF([test "$fat_32_64" = yes], [ for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done]) LIBS=$hold_libs]) AS_IF([test $tcl_cv_lib_corefoundation = yes], [ LIBS="$LIBS -framework CoreFoundation" AC_DEFINE(HAVE_COREFOUNDATION, 1, [Do we have access to Darwin CoreFoundation.framework?]) ], [tcl_corefoundation=no]) AS_IF([test "$fat_32_64" = yes -a $tcl_corefoundation = yes],[ AC_CACHE_CHECK([for 64-bit CoreFoundation], tcl_cv_lib_corefoundation_64, [ for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[CFBundleRef b = CFBundleGetMainBundle();]])], [tcl_cv_lib_corefoundation_64=yes], [tcl_cv_lib_corefoundation_64=no]) for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done]) AS_IF([test $tcl_cv_lib_corefoundation_64 = no], [ AC_DEFINE(NO_COREFOUNDATION_64, 1, [Is Darwin CoreFoundation unavailable for 64-bit?]) LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" ]) ]) ]) ;; NEXTSTEP-*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -nostdlib -r' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadNext.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OS/390-*) SHLIB_LD_LIBS="" CFLAGS_OPTIMIZE="" # Optimizer is buggy AC_DEFINE(_OE_SOCKETS, 1, # needed in sys/socket.h [Should OS/390 do the right thing with sockets?]) ;; OSF1-1.0|OSF1-1.1|OSF1-1.2) # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1 SHLIB_CFLAGS="" # Hack: make package name same as library name SHLIB_LD='ld -R -export $@:' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadOSF.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-1.*) # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2 SHLIB_CFLAGS="-fPIC" AS_IF([test "$SHARED_BUILD" = 1], [SHLIB_LD="ld -shared"], [ SHLIB_LD="ld -non_shared" ]) SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" AS_IF([test "$SHARED_BUILD" = 1], [ SHLIB_LD='${CC} -shared' ], [ SHLIB_LD='${CC} -non_shared' ]) SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [ CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"]) # see pthread_intro(3) for pthread support on osf1, k.furukawa AS_IF([test "${TCL_THREADS}" = 1], [ CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` AS_IF([test "$GCC" = yes], [ LIBS="$LIBS -lpthread -lmach -lexc" ], [ CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" ]) ]) ;; QNX-6*) # QNX RTP # This may work for all QNX, but it was only reported for v6. SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" # dlopen is in -lc on QNX DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. AS_IF([test "$GCC" = yes], [ SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" ], [ SHLIB_CFLAGS="-Kpic -belf" LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" ]) SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SINIX*5.4*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SunOS-4*) SHLIB_CFLAGS="-PIC" SHLIB_LD="ld" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} # SunOS can't handle version numbers with dots in them in library # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it # requires an extra version number at the end of .so file names. # So, the library has to have a name like libtcl75.so.1.0 SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; SunOS-5.[[0-6]]) # Careful to not let 5.10+ fall into this case # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, [Do we really want to follow the standard? Yes we do!]) SHLIB_CFLAGS="-KPIC" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ], [ SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ]) ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, [Do we really want to follow the standard? Yes we do!]) SHLIB_CFLAGS="-KPIC" # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = yes], [ arch=`isainfo` AS_IF([test "$arch" = "sparcv9 sparc"], [ AS_IF([test "$GCC" = yes], [ AS_IF([test "`${CC} -dumpversion | awk -F. '{print [$]1}'`" -lt 3], [ AC_MSG_WARN([64bit mode not supported with GCC < 3.2 on $system]) ], [ do64bit_ok=yes CFLAGS="$CFLAGS -m64 -mcpu=v9" LDFLAGS="$LDFLAGS -m64 -mcpu=v9" SHLIB_CFLAGS="-fPIC" ]) ], [ do64bit_ok=yes AS_IF([test "$do64bitVIS" = yes], [ CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" ], [ CFLAGS="$CFLAGS -xarch=v9" LDFLAGS_ARCH="-xarch=v9" ]) # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" ]) ], [AS_IF([test "$arch" = "amd64 i386"], [ AS_IF([test "$GCC" = yes], [ case $system in SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) do64bit_ok=yes CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) AC_MSG_WARN([64bit mode not supported with GCC on $system]);; esac ], [ do64bit_ok=yes case $system in SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) CFLAGS="$CFLAGS -xarch=amd64" LDFLAGS="$LDFLAGS -xarch=amd64";; esac ]) ], [AC_MSG_WARN([64bit mode not supported for $arch])])]) ]) #-------------------------------------------------------------------- # On Solaris 5.x i386 with the sunpro compiler we need to link # with sunmath to get floating point rounding control #-------------------------------------------------------------------- AS_IF([test "$GCC" = yes],[use_sunmath=no],[ arch=`isainfo` AC_MSG_CHECKING([whether to use -lsunmath for fp rounding control]) AS_IF([test "$arch" = "amd64 i386" -o "$arch" = "i386"], [ AC_MSG_RESULT([yes]) MATH_LIBS="-lsunmath $MATH_LIBS" AC_CHECK_HEADER(sunmath.h) use_sunmath=yes ], [ AC_MSG_RESULT([no]) use_sunmath=no ]) ]) SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} AS_IF([test "$do64bit_ok" = yes], [ AS_IF([test "$arch" = "sparcv9 sparc"], [ # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" # for finding sparcv9 libgcc, get the regular libgcc # path, remove so name and append 'sparcv9' #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" ], [AS_IF([test "$arch" = "amd64 i386"], [ SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" ])]) ]) ], [ AS_IF([test "$use_sunmath" = yes], [textmode=textoff],[textmode=text]) case $system in SunOS-5.[[1-9]][[0-9]]*|SunOS-5.[[7-9]]) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; esac CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' ]) ;; UNIX_SV* | UnixWare-5*) SHLIB_CFLAGS="-KPIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. AC_CACHE_CHECK([for ld accepts -Bexport flag], tcl_cv_ld_Bexport, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])],[tcl_cv_ld_Bexport=yes],[tcl_cv_ld_Bexport=no]) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_Bexport = yes], [ LDFLAGS="$LDFLAGS -Wl,-Bexport" ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac AS_IF([test "$do64bit" = yes -a "$do64bit_ok" = no], [ AC_MSG_WARN([64bit support being disabled -- don't know magic for this platform]) ]) AS_IF([test "$do64bit" = yes -a "$do64bit_ok" = yes], [ AC_DEFINE(TCL_CFG_DO64BIT, 1, [Is this a 64-bit build?]) ]) dnl # Add any CPPFLAGS set in the environment to our CFLAGS, but delay doing so dnl # until the end of configure, as configure's compile and link tests use dnl # both CPPFLAGS and CFLAGS (unlike our compile and link) but configure's dnl # preprocessing tests use only CPPFLAGS. AC_CONFIG_COMMANDS_PRE([CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""]) # Step 4: disable dynamic loading if requested via a command-line switch. AC_ARG_ENABLE(load, AS_HELP_STRING([--enable-load], [allow dynamic loading and "load" command (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) AS_IF([test "$tcl_ok" = no], [DL_OBJS=""]) AS_IF([test "x$DL_OBJS" != x], [BUILD_DLTEST="\$(DLTEST_TARGETS)"], [ AC_MSG_WARN([Can't figure out how to do dynamic loading or shared libraries on this system.]) SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" DL_OBJS="tclLoadNone.o" DL_LIBS="" LDFLAGS="$LDFLAGS_ORIG" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" BUILD_DLTEST="" ]) LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [ case $system in AIX-*) ;; BSD/OS*) ;; CYGWIN_*|MINGW32_*|MSYS_*) ;; HP-UX*) ;; Darwin-*) ;; IRIX*) ;; NetBSD-*|OpenBSD-*) ;; OSF1-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac]) AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [extern], [No Compiler support for module scope symbols]) ]) AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [ SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}']) AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [ UNSHARED_LIB_SUFFIX='${VERSION}.a']) DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [ LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" ], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ]) ], [ LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} AS_IF([test "$RANLIB" = ""], [ MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}' ], [ MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@' ]) INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ]) # Stub lib does not depend on shared/static configuration AS_IF([test "$RANLIB" = ""], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS}' ], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@' ]) INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. AS_IF([test "x${TCL_LIBS}" = x], [ TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"]) AC_SUBST(TCL_LIBS) # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. AC_CACHE_CHECK(for cast to union support, tcl_cv_cast_to_union, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[ union foo { int i; double d; }; union foo f = (union foo) (int) 0; ]])], [tcl_cv_cast_to_union=yes], [tcl_cv_cast_to_union=no]) ) if test "$tcl_cv_cast_to_union" = "yes"; then AC_DEFINE(HAVE_CAST_TO_UNION, 1, [Defined when compiler supports casting to union type.]) fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" AC_CACHE_CHECK(for working -fno-lto, ac_cv_nolto, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])], [ac_cv_nolto=yes], [ac_cv_nolto=no]) ) CFLAGS=$hold_cflags if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi # Check for vfork, posix_spawnp() and friends unconditionally AC_CHECK_FUNCS(vfork posix_spawnp posix_spawn_file_actions_adddup2 posix_spawnattr_setflags) # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. AC_SUBST(DL_LIBS) AC_SUBST(DL_OBJS) AC_SUBST(PLAT_OBJS) AC_SUBST(PLAT_SRCS) AC_SUBST(LDAIX_SRC) AC_SUBST(CFLAGS) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) AC_SUBST(CFLAGS_NOLTO) AC_SUBST(LDFLAGS) AC_SUBST(LDFLAGS_DEBUG) AC_SUBST(LDFLAGS_OPTIMIZE) AC_SUBST(CC_SEARCH_FLAGS) AC_SUBST(LD_SEARCH_FLAGS) AC_SUBST(STLIB_LD) AC_SUBST(SHLIB_LD) AC_SUBST(TCL_SHLIB_LD_EXTRAS) AC_SUBST(TK_SHLIB_LD_EXTRAS) AC_SUBST(SHLIB_LD_LIBS) AC_SUBST(SHLIB_CFLAGS) AC_SUBST(SHLIB_SUFFIX) AC_DEFINE_UNQUOTED(TCL_SHLIB_EXT,"${SHLIB_SUFFIX}", [What is the default extension for shared libraries?]) AC_SUBST(MAKE_LIB) AC_SUBST(MAKE_STUB_LIB) AC_SUBST(INSTALL_LIB) AC_SUBST(DLL_INSTALL_DIR) AC_SUBST(INSTALL_STUB_LIB) AC_SUBST(RANLIB) ]) #-------------------------------------------------------------------- # SC_MISSING_POSIX_HEADERS # # Supply substitutes for missing POSIX header files. Special # notes: # - stdlib.h doesn't define strtol, strtoul, or # strtod insome versions of SunOS # - some versions of string.h don't declare procedures such # as strstr # # Arguments: # none # # Results: # # Defines some of the following vars: # NO_DIRENT_H # NO_FLOAT_H # NO_VALUES_H # NO_STDLIB_H # NO_STRING_H # NO_SYS_WAIT_H # NO_DLFCN_H # HAVE_SYS_PARAM_H # HAVE_STRING_H ? # #-------------------------------------------------------------------- AC_DEFUN([SC_MISSING_POSIX_HEADERS], [ AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[ #ifndef _POSIX_SOURCE # ifdef __Lynx__ /* * Generate compilation error to make the test fail: Lynx headers * are only valid if really in the POSIX environment. */ missing_procedure(); # endif #endif DIR *d; struct dirent *entryPtr; char *p; d = opendir("foobar"); entryPtr = readdir(d); p = entryPtr->d_name; closedir(d); ]])],[tcl_cv_dirent_h=yes],[tcl_cv_dirent_h=no])]) if test $tcl_cv_dirent_h = no; then AC_DEFINE(NO_DIRENT_H, 1, [Do we have ?]) fi AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H, 1, [Do we have ?])]) AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have ?])]) AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0) if test $tcl_ok = 0; then AC_DEFINE(NO_STDLIB_H, 1, [Do we have ?]) fi AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0) AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0) # See also memmove check below for a place where NO_STRING_H can be # set and why. if test $tcl_ok = 0; then AC_DEFINE(NO_STRING_H, 1, [Do we have ?]) fi AC_CHECK_HEADER(sys/wait.h, , [AC_DEFINE(NO_SYS_WAIT_H, 1, [Do we have ?])]) AC_CHECK_HEADER(dlfcn.h, , [AC_DEFINE(NO_DLFCN_H, 1, [Do we have ?])]) # OS/390 lacks sys/param.h (and doesn't need it, by chance). AC_CHECK_HEADERS([sys/param.h]) ]) #-------------------------------------------------------------------- # SC_PATH_X # # Locate the X11 header files and the X11 library archive. Try # the ac_path_x macro first, but if it doesn't find the X stuff # (e.g. because there's no xmkmf program) then check through # a list of possible directories. Under some conditions the # autoconf macro will return an include directory that contains # no include files, so double-check its result just to be safe. # # Arguments: # none # # Results: # # Sets the following vars: # XINCLUDES # XLIBSW # #-------------------------------------------------------------------- AC_DEFUN([SC_PATH_X], [ AC_PATH_X not_really_there="" if test "$no_x" = ""; then if test "$x_includes" = ""; then AC_PREPROC_IFELSE([AC_LANG_SOURCE([[#include ]])],[],[not_really_there="yes"]) else if test ! -r $x_includes/X11/Xlib.h; then not_really_there="yes" fi fi fi if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then AC_MSG_CHECKING([for X11 header files]) found_xincludes="no" AC_PREPROC_IFELSE([AC_LANG_SOURCE([[#include ]])],[found_xincludes="yes"],[found_xincludes="no"]) if test "$found_xincludes" = "no"; then dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include" for i in $dirs ; do if test -r $i/X11/Xlib.h; then AC_MSG_RESULT([$i]) XINCLUDES=" -I$i" found_xincludes="yes" break fi done fi else if test "$x_includes" != ""; then XINCLUDES="-I$x_includes" found_xincludes="yes" fi fi if test "$found_xincludes" = "no"; then AC_MSG_RESULT([couldn't find any!]) fi if test "$no_x" = yes; then AC_MSG_CHECKING([for X11 libraries]) XLIBSW=nope dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib" for i in $dirs ; do if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl -o -r $i/libX11.dylib; then AC_MSG_RESULT([$i]) XLIBSW="-L$i -lX11" x_libraries="$i" break fi done else if test "$x_libraries" = ""; then XLIBSW=-lX11 else XLIBSW="-L$x_libraries -lX11" fi fi if test "$XLIBSW" = nope ; then AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow) fi if test "$XLIBSW" = nope ; then AC_MSG_RESULT([could not find any! Using -lX11.]) XLIBSW=-lX11 fi ]) #-------------------------------------------------------------------- # SC_BLOCKING_STYLE # # The statements below check for systems where POSIX-style # non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. # On these systems (mostly older ones), use the old BSD-style # FIONBIO approach instead. # # Arguments: # none # # Results: # # Defines some of the following vars: # HAVE_SYS_IOCTL_H # HAVE_SYS_FILIO_H # USE_FIONBIO # O_NONBLOCK # #-------------------------------------------------------------------- AC_DEFUN([SC_BLOCKING_STYLE], [ AC_CHECK_HEADERS(sys/ioctl.h) AC_CHECK_HEADERS(sys/filio.h) SC_CONFIG_SYSTEM AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) case $system in OSF*) AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?]) AC_MSG_RESULT([FIONBIO]) ;; SunOS-4*) AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?]) AC_MSG_RESULT([FIONBIO]) ;; *) AC_MSG_RESULT([O_NONBLOCK]) ;; esac ]) #-------------------------------------------------------------------- # SC_TIME_HANLDER # # Checks how the system deals with time.h, what time structures # are used on the system, and what fields the structures have. # # Arguments: # none # # Results: # # Defines some of the following vars: # USE_DELTA_FOR_TZ # HAVE_TM_GMTOFF # HAVE_TM_TZADJ # HAVE_TIMEZONE_VAR # #-------------------------------------------------------------------- AC_DEFUN([SC_TIME_HANDLER], [ AC_CHECK_HEADERS(sys/time.h) AC_HEADER_TIME AC_CHECK_FUNCS(gmtime_r localtime_r mktime) AC_CACHE_CHECK([tm_tzadj in struct tm], tcl_cv_member_tm_tzadj, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[struct tm tm; (void)tm.tm_tzadj;]])], [tcl_cv_member_tm_tzadj=yes], [tcl_cv_member_tm_tzadj=no])]) if test $tcl_cv_member_tm_tzadj = yes ; then AC_DEFINE(HAVE_TM_TZADJ, 1, [Should we use the tm_tzadj field of struct tm?]) fi AC_CACHE_CHECK([tm_gmtoff in struct tm], tcl_cv_member_tm_gmtoff, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[struct tm tm; (void)tm.tm_gmtoff;]])], [tcl_cv_member_tm_gmtoff=yes], [tcl_cv_member_tm_gmtoff=no])]) if test $tcl_cv_member_tm_gmtoff = yes ; then AC_DEFINE(HAVE_TM_GMTOFF, 1, [Should we use the tm_gmtoff field of struct tm?]) fi # # Its important to include time.h in this check, as some systems # (like convex) have timezone functions, etc. # AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[extern long timezone; timezone += 1; exit (0);]])], [tcl_cv_timezone_long=yes], [tcl_cv_timezone_long=no])]) if test $tcl_cv_timezone_long = yes ; then AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?]) else # # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. # AC_CACHE_CHECK([time_t timezone variable], tcl_cv_timezone_time, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[extern time_t timezone; timezone += 1; exit (0);]])], [tcl_cv_timezone_time=yes], [tcl_cv_timezone_time=no])]) if test $tcl_cv_timezone_time = yes ; then AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?]) fi fi ]) #-------------------------------------------------------------------- # SC_TCL_LINK_LIBS # # Search for the libraries needed to link the Tcl shell. # Things like the math library (-lm), socket stuff (-lsocket vs. # -lnsl), zlib (-lz) and libtommath (-ltommath) are dealt with here. # # Arguments: # None. # # Results: # # Might append to the following vars: # LIBS # MATH_LIBS # # Might define the following vars: # HAVE_NET_ERRNO_H # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_LINK_LIBS], [ #-------------------------------------------------------------------- # On a few very rare systems, all of the libm.a stuff is # already in libc.a. Set compiler flags accordingly. #-------------------------------------------------------------------- AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm") #-------------------------------------------------------------------- # Interactive UNIX requires -linet instead of -lsocket, plus it # needs net/errno.h to define the socket-related error codes. #-------------------------------------------------------------------- AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"]) AC_CHECK_HEADER(net/errno.h, [ AC_DEFINE(HAVE_NET_ERRNO_H, 1, [Do we have ?])]) #-------------------------------------------------------------------- # Check for the existence of the -lsocket and -lnsl libraries. # The order here is important, so that they end up in the right # order in the command line generated by make. Here are some # special considerations: # 1. Use "connect" and "accept" to check for -lsocket, and # "gethostbyname" to check for -lnsl. # 2. Use each function name only once: can't redo a check because # autoconf caches the results of the last check and won't redo it. # 3. Use -lnsl and -lsocket only if they supply procedures that # aren't already present in the normal libraries. This is because # IRIX 5.2 has libraries, but they aren't needed and they're # bogus: they goof up name resolution if used. # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. # To get around this problem, check for both libraries together # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- tcl_checkBoth=0 AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1) if test "$tcl_checkSocket" = 1; then AC_CHECK_FUNC(setsockopt, , [AC_CHECK_LIB(socket, setsockopt, LIBS="$LIBS -lsocket", tcl_checkBoth=1)]) fi if test "$tcl_checkBoth" = 1; then tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs]) fi AC_CHECK_FUNC(gethostbyname, , [AC_CHECK_LIB(nsl, gethostbyname, [LIBS="$LIBS -lnsl"])]) ]) #-------------------------------------------------------------------- # SC_TCL_EARLY_FLAGS # # Check for what flags are needed to be passed so the correct OS # features are available. # # Arguments: # None # # Results: # # Might define the following vars: # _ISOC99_SOURCE # _LARGEFILE64_SOURCE # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_EARLY_FLAG],[ AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[$2]], [[$3]])], [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[[#define ]$1[ ]m4_default([$4],[1])[ ]$2]], [[$3]])], [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no)])) if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then AC_DEFINE($1, m4_default([$4],[1]), [Add the ]$1[ flag when building]) tcl_flags="$tcl_flags $1" fi ]) AC_DEFUN([SC_TCL_EARLY_FLAGS],[ AC_MSG_CHECKING([for required early compiler flags]) tcl_flags="" SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include ], [char *p = (char *)strtoll; char *q = (char *)strtoull;]) SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include ], [struct stat64 buf; int i = stat64("/", &buf);]) if test "x${tcl_flags}" = "x" ; then AC_MSG_RESULT([none]) else AC_MSG_RESULT([${tcl_flags}]) fi ]) #-------------------------------------------------------------------- # SC_TCL_64BIT_FLAGS # # Check for what is defined in the way of 64-bit features. # # Arguments: # None # # Results: # # Might define the following vars: # TCL_WIDE_INT_IS_LONG # TCL_WIDE_INT_TYPE # HAVE_STRUCT_DIRENT64, HAVE_DIR64 # HAVE_STRUCT_STAT64 # HAVE_TYPE_OFF64_T # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_64BIT_FLAGS], [ AC_MSG_CHECKING([for 64-bit integer type]) AC_CACHE_VAL(tcl_cv_type_64bit,[ tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[__int64 value = (__int64) 0;]])], [tcl_type_64bit=__int64], [tcl_type_64bit="long long"]) # See if we should use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[switch (0) { case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; }]])],[tcl_cv_type_64bit=${tcl_type_64bit}],[])]) if test "${tcl_cv_type_64bit}" = none ; then AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?]) AC_MSG_RESULT([using long]) else AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit}, [What type should be used to define wide integers?]) AC_MSG_RESULT([${tcl_cv_type_64bit}]) # Now check for auxiliary declarations AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[struct dirent64 p;]])], [tcl_cv_struct_dirent64=yes],[tcl_cv_struct_dirent64=no])]) if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in ?]) fi AC_CACHE_CHECK([for DIR64], tcl_cv_DIR64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[struct dirent64 *p; DIR64 d = opendir64("."); p = readdir64(d); rewinddir64(d); closedir64(d);]])], [tcl_cv_DIR64=yes], [tcl_cv_DIR64=no])]) if test "x${tcl_cv_DIR64}" = "xyes" ; then AC_DEFINE(HAVE_DIR64, 1, [Is 'DIR64' in ?]) fi AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[struct stat64 p; ]])], [tcl_cv_struct_stat64=yes], [tcl_cv_struct_stat64=no])]) if test "x${tcl_cv_struct_stat64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_STAT64, 1, [Is 'struct stat64' in ?]) fi AC_CHECK_FUNCS(open64 lseek64) AC_MSG_CHECKING([for off64_t]) AC_CACHE_VAL(tcl_cv_type_off64_t,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[off64_t offset; ]])], [tcl_cv_type_off64_t=yes], [tcl_cv_type_off64_t=no])]) dnl Define HAVE_TYPE_OFF64_T only when the off64_t type and the dnl functions lseek64 and open64 are defined. if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then AC_DEFINE(HAVE_TYPE_OFF64_T, 1, [Is off64_t in ?]) AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) fi fi ]) #-------------------------------------------------------------------- # SC_TCL_CFG_ENCODING TIP #59 # # Declare the encoding to use for embedded configuration information. # # Arguments: # None. # # Results: # Might append to the following vars: # DEFS (implicit) # # Will define the following vars: # TCL_CFGVAL_ENCODING # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CFG_ENCODING], [ AC_ARG_WITH(encoding, AS_HELP_STRING([--with-encoding], [encoding for configuration values (default: iso8859-1)]), [with_tcencoding=${withval}]) if test x"${with_tcencoding}" != x ; then AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}", [What encoding should be used for embedded configuration info?]) else AC_DEFINE(TCL_CFGVAL_ENCODING,"iso8859-1", [What encoding should be used for embedded configuration info?]) fi ]) #-------------------------------------------------------------------- # SC_TCL_CHECK_BROKEN_FUNC # # Check for broken function. # # Arguments: # funcName - function to test for # advancedTest - the advanced test to run if the function is present # # Results: # Might cause compatibility versions of the function to be used. # Might affect the following vars: # USE_COMPAT (implicit) # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[ AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0) if test ["$tcl_ok"] = 1; then AC_CACHE_CHECK([proper ]$1[ implementation], [tcl_cv_]$1[_unbroken], AC_RUN_IFELSE([AC_LANG_SOURCE([[[ #include #include int main() {]$2[}]]])],[tcl_cv_$1_unbroken=ok], [tcl_cv_$1_unbroken=broken],[tcl_cv_$1_unbroken=unknown])) if test ["$tcl_cv_]$1[_unbroken"] = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test ["$tcl_ok"] = 0; then AC_LIBOBJ($1) USE_COMPAT=1 fi ]) #-------------------------------------------------------------------- # SC_TCL_GETHOSTBYADDR_R # # Check if we have MT-safe variant of gethostbyaddr(). # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETHOSTBYADDR_R # HAVE_GETHOSTBYADDR_R_7 # HAVE_GETHOSTBYADDR_R_8 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETHOSTBYADDR_R], [ # Avoids picking hidden internal symbol from libc SC_TCL_GETHOSTBYADDR_R_DECL if test "$tcl_cv_api_gethostbyaddr_r" = yes; then SC_TCL_GETHOSTBYADDR_R_TYPE fi ]) AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_DECL], [AC_CHECK_DECLS(gethostbyaddr_r, [ tcl_cv_api_gethostbyaddr_r=yes],[tcl_cv_api_gethostbyaddr_r=no],[#include ]) ]) AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_TYPE], [AC_CHECK_FUNC(gethostbyaddr_r, [ AC_CACHE_CHECK([for gethostbyaddr_r with 7 args], tcl_cv_api_gethostbyaddr_r_7, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include ]], [[ char *addr; int length; int type; struct hostent *result; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &h_errnop); ]])],[tcl_cv_api_gethostbyaddr_r_7=yes],[tcl_cv_api_gethostbyaddr_r_7=no])]) tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R_7, 1, [Define to 1 if gethostbyaddr_r takes 7 args.]) else AC_CACHE_CHECK([for gethostbyaddr_r with 8 args], tcl_cv_api_gethostbyaddr_r_8, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include ]], [[ char *addr; int length; int type; struct hostent *result, *resultp; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &resultp, &h_errnop); ]])],[tcl_cv_api_gethostbyaddr_r_8=yes],[tcl_cv_api_gethostbyaddr_r_8=no])]) tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R_8, 1, [Define to 1 if gethostbyaddr_r takes 8 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R, 1, [Define to 1 if gethostbyaddr_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETHOSTBYNAME_R # # Check to see what variant of gethostbyname_r() we have. # Based on David Arnold's example from the comp.programming.threads # FAQ Q213 # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETHOSTBYNAME_R # HAVE_GETHOSTBYNAME_R_3 # HAVE_GETHOSTBYNAME_R_5 # HAVE_GETHOSTBYNAME_R_6 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETHOSTBYNAME_R], [ # Avoids picking hidden internal symbol from libc SC_TCL_GETHOSTBYNAME_R_DECL if test "$tcl_cv_api_gethostbyname_r" = yes; then SC_TCL_GETHOSTBYNAME_R_TYPE fi ]) AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_DECL], [AC_CHECK_DECLS(gethostbyname_r, [ tcl_cv_api_gethostbyname_r=yes],[tcl_cv_api_gethostbyname_r=no],[#include ]) ]) AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_TYPE], [AC_CHECK_FUNC(gethostbyname_r, [ AC_CACHE_CHECK([for gethostbyname_r with 6 args], tcl_cv_api_gethostbyname_r_6, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include ]], [[ char *name; struct hostent *he, *res; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); ]])],[tcl_cv_api_gethostbyname_r_6=yes],[tcl_cv_api_gethostbyname_r_6=no])]) tcl_ok=$tcl_cv_api_gethostbyname_r_6 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_6, 1, [Define to 1 if gethostbyname_r takes 6 args.]) else AC_CACHE_CHECK([for gethostbyname_r with 5 args], tcl_cv_api_gethostbyname_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include ]], [[ char *name; struct hostent *he; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); ]])],[tcl_cv_api_gethostbyname_r_5=yes],[tcl_cv_api_gethostbyname_r_5=no])]) tcl_ok=$tcl_cv_api_gethostbyname_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_5, 1, [Define to 1 if gethostbyname_r takes 5 args.]) else AC_CACHE_CHECK([for gethostbyname_r with 3 args], tcl_cv_api_gethostbyname_r_3, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include ]], [[ char *name; struct hostent *he; struct hostent_data data; (void) gethostbyname_r(name, he, &data); ]])],[tcl_cv_api_gethostbyname_r_3=yes],[tcl_cv_api_gethostbyname_r_3=no])]) tcl_ok=$tcl_cv_api_gethostbyname_r_3 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_3, 1, [Define to 1 if gethostbyname_r takes 3 args.]) fi fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R, 1, [Define to 1 if gethostbyname_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETPWUID_R # # Check if we have MT-safe variant of getpwuid() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETPWUID_R # HAVE_GETPWUID_R_4 # HAVE_GETPWUID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWUID_R], [AC_CHECK_FUNC(getpwuid_r, [ AC_CACHE_CHECK([for getpwuid_r with 5 args], tcl_cv_api_getpwuid_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ uid_t uid; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); ]])],[tcl_cv_api_getpwuid_r_5=yes],[tcl_cv_api_getpwuid_r_5=no])]) tcl_ok=$tcl_cv_api_getpwuid_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R_5, 1, [Define to 1 if getpwuid_r takes 5 args.]) else AC_CACHE_CHECK([for getpwuid_r with 4 args], tcl_cv_api_getpwuid_r_4, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ uid_t uid; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(uid, &pw, buf, buflen); ]])],[tcl_cv_api_getpwuid_r_4=yes],[tcl_cv_api_getpwuid_r_4=no])]) tcl_ok=$tcl_cv_api_getpwuid_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R_4, 1, [Define to 1 if getpwuid_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R, 1, [Define to 1 if getpwuid_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETPWNAM_R # # Check if we have MT-safe variant of getpwnam() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETPWNAM_R # HAVE_GETPWNAM_R_4 # HAVE_GETPWNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWNAM_R], [AC_CHECK_FUNC(getpwnam_r, [ AC_CACHE_CHECK([for getpwnam_r with 5 args], tcl_cv_api_getpwnam_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ char *name; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwnam_r(name, &pw, buf, buflen, &pwp); ]])],[tcl_cv_api_getpwnam_r_5=yes],[tcl_cv_api_getpwnam_r_5=no])]) tcl_ok=$tcl_cv_api_getpwnam_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R_5, 1, [Define to 1 if getpwnam_r takes 5 args.]) else AC_CACHE_CHECK([for getpwnam_r with 4 args], tcl_cv_api_getpwnam_r_4, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ char *name; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(name, &pw, buf, buflen); ]])],[tcl_cv_api_getpwnam_r_4=yes],[tcl_cv_api_getpwnam_r_4=no])]) tcl_ok=$tcl_cv_api_getpwnam_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R_4, 1, [Define to 1 if getpwnam_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R, 1, [Define to 1 if getpwnam_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETGRGID_R # # Check if we have MT-safe variant of getgrgid() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETGRGID_R # HAVE_GETGRGID_R_4 # HAVE_GETGRGID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRGID_R], [AC_CHECK_FUNC(getgrgid_r, [ AC_CACHE_CHECK([for getgrgid_r with 5 args], tcl_cv_api_getgrgid_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ gid_t gid; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrgid_r(gid, &gr, buf, buflen, &grp); ]])],[tcl_cv_api_getgrgid_r_5=yes],[tcl_cv_api_getgrgid_r_5=no])]) tcl_ok=$tcl_cv_api_getgrgid_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R_5, 1, [Define to 1 if getgrgid_r takes 5 args.]) else AC_CACHE_CHECK([for getgrgid_r with 4 args], tcl_cv_api_getgrgid_r_4, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ gid_t gid; struct group gr; char buf[512]; int buflen = 512; (void)getgrgid_r(gid, &gr, buf, buflen); ]])],[tcl_cv_api_getgrgid_r_4=yes],[tcl_cv_api_getgrgid_r_4=no])]) tcl_ok=$tcl_cv_api_getgrgid_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R_4, 1, [Define to 1 if getgrgid_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R, 1, [Define to 1 if getgrgid_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETGRNAM_R # # Check if we have MT-safe variant of getgrnam() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETGRNAM_R # HAVE_GETGRNAM_R_4 # HAVE_GETGRNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRNAM_R], [AC_CHECK_FUNC(getgrnam_r, [ AC_CACHE_CHECK([for getgrnam_r with 5 args], tcl_cv_api_getgrnam_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ char *name; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrnam_r(name, &gr, buf, buflen, &grp); ]])],[tcl_cv_api_getgrnam_r_5=yes],[tcl_cv_api_getgrnam_r_5=no])]) tcl_ok=$tcl_cv_api_getgrnam_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R_5, 1, [Define to 1 if getgrnam_r takes 5 args.]) else AC_CACHE_CHECK([for getgrnam_r with 4 args], tcl_cv_api_getgrnam_r_4, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[ char *name; struct group gr; char buf[512]; int buflen = 512; (void)getgrnam_r(name, &gr, buf, buflen); ]])],[tcl_cv_api_getgrnam_r_4=yes],[tcl_cv_api_getgrnam_r_4=no])]) tcl_ok=$tcl_cv_api_getgrnam_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R_4, 1, [Define to 1 if getgrnam_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R, 1, [Define to 1 if getgrnam_r is available.]) fi ])]) AC_DEFUN([SC_TCL_IPV6],[ NEED_FAKE_RFC2553=0 AC_CHECK_FUNCS(getnameinfo getaddrinfo freeaddrinfo gai_strerror,,[NEED_FAKE_RFC2553=1]) AC_CHECK_TYPES([ struct addrinfo, struct in6_addr, struct sockaddr_in6, struct sockaddr_storage],,[NEED_FAKE_RFC2553=1],[[ #include #include #include #include ]]) if test "x$NEED_FAKE_RFC2553" = "x1"; then AC_DEFINE([NEED_FAKE_RFC2553], 1, [Use compat implementation of getaddrinfo() and friends]) AC_LIBOBJ([fake-rfc2553]) AC_CHECK_FUNC(strlcpy) fi ]) # Local Variables: # mode: autoconf # End: tcl8.6.14/unix/aclocal.m40000644000175000017500000000004014554262142014457 0ustar sergeisergeibuiltin(include,../unix/tcl.m4) tcl8.6.14/unix/tclConfig.sh.in0000644000175000017500000001363114554262142015502 0ustar sergeisergei# tclConfig.sh -- # # This shell script (for sh) is generated automatically by Tcl's # configure script. It will create shell variables for most of # the configuration options discovered by the configure script. # This script is intended to be included by the configure scripts # for Tcl extensions so that they don't have to figure this all # out for themselves. # # The information in this file is specific to a single platform. # Tcl's version number. TCL_VERSION='@TCL_VERSION@' TCL_MAJOR_VERSION='@TCL_MAJOR_VERSION@' TCL_MINOR_VERSION='@TCL_MINOR_VERSION@' TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@' # C compiler to use for compilation. TCL_CC='@CC@' # -D flags for use with the C compiler. TCL_DEFS='@DEFS@' # TCL_DBGX used to be used to distinguish debug vs. non-debug builds. # This was a righteous pain so the core doesn't do that any more. TCL_DBGX= # Default flags used in an optimized and debuggable build, respectively. TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@' TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@' # Default linker flags used in an optimized and debuggable build, respectively. TCL_LDFLAGS_DEBUG='@LDFLAGS_DEBUG@' TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@' # Flag, 1: we built a shared lib, 0 we didn't TCL_SHARED_BUILD=@TCL_SHARED_BUILD@ # The name of the Tcl library (may be either a .a file or a shared library): TCL_LIB_FILE='@TCL_LIB_FILE@' # Additional libraries to use when linking Tcl. TCL_LIBS='@TCL_LIBS@' # Top-level directory in which Tcl's platform-independent files are # installed. TCL_PREFIX='@prefix@' # Top-level directory in which Tcl's platform-specific files (e.g. # executables) are installed. TCL_EXEC_PREFIX='@exec_prefix@' # Flags to pass to cc when compiling the components of a shared library: TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@' # Flags to pass to cc to get warning messages TCL_CFLAGS_WARNING='@CFLAGS_WARNING@' # Extra flags to pass to cc: TCL_EXTRA_CFLAGS='@CFLAGS@' # Base command to use for combining object files into a shared library: TCL_SHLIB_LD='@SHLIB_LD@' # Base command to use for combining object files into a static library: TCL_STLIB_LD='@STLIB_LD@' # Either '$LIBS' (if dependent libraries should be included when linking # shared libraries) or an empty string. See Tcl's configure.in for more # explanation. TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@' # Suffix to use for the name of a shared library. TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@' # Library file(s) to include in tclsh and other base applications # in order to provide facilities needed by DLOBJ above. TCL_DL_LIBS='@DL_LIBS@' # Flags to pass to the compiler when linking object files into # an executable tclsh or tcltest binary. TCL_LD_FLAGS='@LDFLAGS@' # Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the # run-time dynamic linker where to look for shared libraries such as # libtcl.so. Used when linking applications. Only works if there # is a variable "LIB_RUNTIME_DIR" defined in the Makefile. TCL_CC_SEARCH_FLAGS='@CC_SEARCH_FLAGS@' TCL_LD_SEARCH_FLAGS='@LD_SEARCH_FLAGS@' # Additional object files linked with Tcl to provide compatibility # with standard facilities from ANSI C or POSIX. TCL_COMPAT_OBJS='@LIBOBJS@' # Name of the ranlib program to use. TCL_RANLIB='@RANLIB@' # -l flag to pass to the linker to pick up the Tcl library TCL_LIB_FLAG='@TCL_LIB_FLAG@' # String to pass to linker to pick up the Tcl library from its # build directory. TCL_BUILD_LIB_SPEC='@TCL_BUILD_LIB_SPEC@' # String to pass to linker to pick up the Tcl library from its # installed directory. TCL_LIB_SPEC='@TCL_LIB_SPEC@' # String to pass to the compiler so that an extension can # find installed Tcl headers. TCL_INCLUDE_SPEC='@TCL_INCLUDE_SPEC@' # Indicates whether a version numbers should be used in -l switches # ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means # use switches like -ltcl75). SunOS and FreeBSD require "nodots", for # example. TCL_LIB_VERSIONS_OK='@TCL_LIB_VERSIONS_OK@' # String that can be evaluated to generate the part of a shared library # name that comes after the "libxxx" (includes version number, if any, # extension, and anything else needed). May depend on the variables # VERSION and SHLIB_SUFFIX. On most UNIX systems this is # ${VERSION}${SHLIB_SUFFIX}. TCL_SHARED_LIB_SUFFIX='@CFG_TCL_SHARED_LIB_SUFFIX@' # String that can be evaluated to generate the part of an unshared library # name that comes after the "libxxx" (includes version number, if any, # extension, and anything else needed). May depend on the variable # VERSION. On most UNIX systems this is ${VERSION}.a. TCL_UNSHARED_LIB_SUFFIX='@CFG_TCL_UNSHARED_LIB_SUFFIX@' # Location of the top-level source directory from which Tcl was built. # This is the directory that contains a README file as well as # subdirectories such as generic, unix, etc. If Tcl was compiled in a # different place than the directory containing the source files, this # points to the location of the sources, not the location where Tcl was # compiled. TCL_SRC_DIR='@TCL_SRC_DIR@' # List of standard directories in which to look for packages during # "package require" commands. Contains the "prefix" directory plus also # the "exec_prefix" directory, if it is different. TCL_PACKAGE_PATH='@TCL_PACKAGE_PATH@' # Tcl supports stub. TCL_SUPPORTS_STUBS=1 # The name of the Tcl stub library (.a): TCL_STUB_LIB_FILE='@TCL_STUB_LIB_FILE@' # -l flag to pass to the linker to pick up the Tcl stub library TCL_STUB_LIB_FLAG='@TCL_STUB_LIB_FLAG@' # String to pass to linker to pick up the Tcl stub library from its # build directory. TCL_BUILD_STUB_LIB_SPEC='@TCL_BUILD_STUB_LIB_SPEC@' # String to pass to linker to pick up the Tcl stub library from its # installed directory. TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@' # Path to the Tcl stub library in the build directory. TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@' # Path to the Tcl stub library in the install directory. TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@' # Flag, 1: we built Tcl with threads enabled, 0 we didn't TCL_THREADS=@TCL_THREADS@ tcl8.6.14/unix/tclooConfig.sh0000644000175000017500000000140514554262142015427 0ustar sergeisergei# tclooConfig.sh -- # # This shell script (for sh) is generated automatically by TclOO's configure # script, or would be except it has no values that we substitute. It will # create shell variables for most of the configuration options discovered by # the configure script. This script is intended to be included by TEA-based # configure scripts for TclOO extensions so that they don't have to figure # this all out for themselves. # # The information in this file is specific to a single platform. # These are mostly empty because no special steps are ever needed from Tcl 8.6 # onwards; all libraries and include files are just part of Tcl. TCLOO_LIB_SPEC="" TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" TCLOO_VERSION=1.1.0 tcl8.6.14/unix/install-sh0000755000175000017500000003577614554262142014653 0ustar sergeisergei#!/bin/sh # install - install a program, script, or datafile scriptversion=2020-11-14.01; # UTC # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the # following copyright and license. # # Copyright (C) 1994 X Consortium # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to # deal in the Software without restriction, including without limitation the # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or # sell copies of the Software, and to permit persons to whom the Software is # furnished to do so, subject to the following conditions: # # The above copyright notice and this permission notice shall be included in # all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE # X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- # TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # Except as contained in this notice, the name of the X Consortium shall not # be used in advertising or otherwise to promote the sale, use or other deal- # ings in this Software without prior written authorization from the X Consor- # tium. # # # FSF changes to this file are in the public domain. # # Calling this script install-sh is preferred over install.sh, to prevent # 'make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. tab=' ' nl=' ' IFS=" $tab$nl" # Set DOITPROG to "echo" to test this script. doit=${DOITPROG-} doit_exec=${doit:-exec} # Put in absolute file names if you don't have them in your path; # or use environment vars. chgrpprog=${CHGRPPROG-chgrp} chmodprog=${CHMODPROG-chmod} chownprog=${CHOWNPROG-chown} cmpprog=${CMPPROG-cmp} cpprog=${CPPROG-cp} mkdirprog=${MKDIRPROG-mkdir} mvprog=${MVPROG-mv} rmprog=${RMPROG-rm} stripprog=${STRIPPROG-strip} posix_mkdir= # Desired mode of installed file. mode=0755 # Create dirs (including intermediate dirs) using mode 755. # This is like GNU 'install' as of coreutils 8.32 (2020). mkdir_umask=22 backupsuffix= chgrpcmd= chmodcmd=$chmodprog chowncmd= mvcmd=$mvprog rmcmd="$rmprog -f" stripcmd= src= dst= dir_arg= dst_arg= copy_on_change=false is_target_a_directory=possibly usage="\ Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE or: $0 [OPTION]... SRCFILES... DIRECTORY or: $0 [OPTION]... -t DIRECTORY SRCFILES... or: $0 [OPTION]... -d DIRECTORIES... In the 1st form, copy SRCFILE to DSTFILE. In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. In the 4th, create DIRECTORIES. Options: --help display this help and exit. --version display version info and exit. -c (ignored) -C install only if different (preserve data modification time) -d create directories instead of installing files. -g GROUP $chgrpprog installed files to GROUP. -m MODE $chmodprog installed files to MODE. -o USER $chownprog installed files to USER. -p pass -p to $cpprog. -s $stripprog installed files. -S SUFFIX attempt to back up existing files, with suffix SUFFIX. -t DIRECTORY install into DIRECTORY. -T report an error if DSTFILE is a directory. Environment variables override the default commands: CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG By default, rm is invoked with -f; when overridden with RMPROG, it's up to you to specify -f if you want it. If -S is not specified, no backups are attempted. Email bug reports to bug-automake@gnu.org. Automake home page: https://www.gnu.org/software/automake/ " while test $# -ne 0; do case $1 in -c) ;; -C) copy_on_change=true;; -d) dir_arg=true;; -g) chgrpcmd="$chgrpprog $2" shift;; --help) echo "$usage"; exit $?;; -m) mode=$2 case $mode in *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*) echo "$0: invalid mode: $mode" >&2 exit 1;; esac shift;; -o) chowncmd="$chownprog $2" shift;; -p) cpprog="$cpprog -p";; -s) stripcmd=$stripprog;; -S) backupsuffix="$2" shift;; -t) is_target_a_directory=always dst_arg=$2 # Protect names problematic for 'test' and other utilities. case $dst_arg in -* | [=\(\)!]) dst_arg=./$dst_arg;; esac shift;; -T) is_target_a_directory=never;; --version) echo "$0 $scriptversion"; exit $?;; --) shift break;; -*) echo "$0: invalid option: $1" >&2 exit 1;; *) break;; esac shift done # We allow the use of options -d and -T together, by making -d # take the precedence; this is for compatibility with GNU install. if test -n "$dir_arg"; then if test -n "$dst_arg"; then echo "$0: target directory not allowed when installing a directory." >&2 exit 1 fi fi if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then # When -d is used, all remaining arguments are directories to create. # When -t is used, the destination is already specified. # Otherwise, the last argument is the destination. Remove it from $@. for arg do if test -n "$dst_arg"; then # $@ is not empty: it contains at least $arg. set fnord "$@" "$dst_arg" shift # fnord fi shift # arg dst_arg=$arg # Protect names problematic for 'test' and other utilities. case $dst_arg in -* | [=\(\)!]) dst_arg=./$dst_arg;; esac done fi if test $# -eq 0; then if test -z "$dir_arg"; then echo "$0: no input file specified." >&2 exit 1 fi # It's OK to call 'install-sh -d' without argument. # This can happen when creating conditional directories. exit 0 fi if test -z "$dir_arg"; then if test $# -gt 1 || test "$is_target_a_directory" = always; then if test ! -d "$dst_arg"; then echo "$0: $dst_arg: Is not a directory." >&2 exit 1 fi fi fi if test -z "$dir_arg"; then do_exit='(exit $ret); exit $ret' trap "ret=129; $do_exit" 1 trap "ret=130; $do_exit" 2 trap "ret=141; $do_exit" 13 trap "ret=143; $do_exit" 15 # Set umask so as not to create temps with too-generous modes. # However, 'strip' requires both read and write access to temps. case $mode in # Optimize common cases. *644) cp_umask=133;; *755) cp_umask=22;; *[0-7]) if test -z "$stripcmd"; then u_plus_rw= else u_plus_rw='% 200' fi cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; *) if test -z "$stripcmd"; then u_plus_rw= else u_plus_rw=,u+rw fi cp_umask=$mode$u_plus_rw;; esac fi for src do # Protect names problematic for 'test' and other utilities. case $src in -* | [=\(\)!]) src=./$src;; esac if test -n "$dir_arg"; then dst=$src dstdir=$dst test -d "$dstdir" dstdir_status=$? # Don't chown directories that already exist. if test $dstdir_status = 0; then chowncmd="" fi else # Waiting for this to be detected by the "$cpprog $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if test ! -f "$src" && test ! -d "$src"; then echo "$0: $src does not exist." >&2 exit 1 fi if test -z "$dst_arg"; then echo "$0: no destination specified." >&2 exit 1 fi dst=$dst_arg # If destination is a directory, append the input filename. if test -d "$dst"; then if test "$is_target_a_directory" = never; then echo "$0: $dst_arg: Is a directory" >&2 exit 1 fi dstdir=$dst dstbase=`basename "$src"` case $dst in */) dst=$dst$dstbase;; *) dst=$dst/$dstbase;; esac dstdir_status=0 else dstdir=`dirname "$dst"` test -d "$dstdir" dstdir_status=$? fi fi case $dstdir in */) dstdirslash=$dstdir;; *) dstdirslash=$dstdir/;; esac obsolete_mkdir_used=false if test $dstdir_status != 0; then case $posix_mkdir in '') # With -d, create the new directory with the user-specified mode. # Otherwise, rely on $mkdir_umask. if test -n "$dir_arg"; then mkdir_mode=-m$mode else mkdir_mode= fi posix_mkdir=false # The $RANDOM variable is not portable (e.g., dash). Use it # here however when possible just to lower collision chance. tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ trap ' ret=$? rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null exit $ret ' 0 # Because "mkdir -p" follows existing symlinks and we likely work # directly in world-writeable /tmp, make sure that the '$tmpdir' # directory is successfully created first before we actually test # 'mkdir -p'. if (umask $mkdir_umask && $mkdirprog $mkdir_mode "$tmpdir" && exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1 then if test -z "$dir_arg" || { # Check for POSIX incompatibilities with -m. # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or # other-writable bit of parent directory when it shouldn't. # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. test_tmpdir="$tmpdir/a" ls_ld_tmpdir=`ls -ld "$test_tmpdir"` case $ls_ld_tmpdir in d????-?r-*) different_mode=700;; d????-?--*) different_mode=755;; *) false;; esac && $mkdirprog -m$different_mode -p -- "$test_tmpdir" && { ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"` test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" } } then posix_mkdir=: fi rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" else # Remove any dirs left behind by ancient mkdir implementations. rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null fi trap '' 0;; esac if $posix_mkdir && ( umask $mkdir_umask && $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" ) then : else # mkdir does not conform to POSIX, # or it failed possibly due to a race condition. Create the # directory the slow way, step by step, checking for races as we go. case $dstdir in /*) prefix='/';; [-=\(\)!]*) prefix='./';; *) prefix='';; esac oIFS=$IFS IFS=/ set -f set fnord $dstdir shift set +f IFS=$oIFS prefixes= for d do test X"$d" = X && continue prefix=$prefix$d if test -d "$prefix"; then prefixes= else if $posix_mkdir; then (umask $mkdir_umask && $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break # Don't fail if two instances are running concurrently. test -d "$prefix" || exit 1 else case $prefix in *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; *) qprefix=$prefix;; esac prefixes="$prefixes '$qprefix'" fi fi prefix=$prefix/ done if test -n "$prefixes"; then # Don't fail if two instances are running concurrently. (umask $mkdir_umask && eval "\$doit_exec \$mkdirprog $prefixes") || test -d "$dstdir" || exit 1 obsolete_mkdir_used=true fi fi fi if test -n "$dir_arg"; then { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 else # Make a couple of temp file names in the proper directory. dsttmp=${dstdirslash}_inst.$$_ rmtmp=${dstdirslash}_rm.$$_ # Trap to clean up those temp files at exit. trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 # Copy the file name to the temp name. (umask $cp_umask && { test -z "$stripcmd" || { # Create $dsttmp read-write so that cp doesn't create it read-only, # which would cause strip to fail. if test -z "$doit"; then : >"$dsttmp" # No need to fork-exec 'touch'. else $doit touch "$dsttmp" fi } } && $doit_exec $cpprog "$src" "$dsttmp") && # and set any options; do chmod last to preserve setuid bits. # # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $cpprog $src $dsttmp" command. # { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && # If -C, don't bother to copy if it wouldn't change the file. if $copy_on_change && old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && set -f && set X $old && old=:$2:$4:$5:$6 && set X $new && new=:$2:$4:$5:$6 && set +f && test "$old" = "$new" && $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 then rm -f "$dsttmp" else # If $backupsuffix is set, and the file being installed # already exists, attempt a backup. Don't worry if it fails, # e.g., if mv doesn't support -f. if test -n "$backupsuffix" && test -f "$dst"; then $doit $mvcmd -f "$dst" "$dst$backupsuffix" 2>/dev/null fi # Rename the file to the real destination. $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || # The rename failed, perhaps because mv can't rename something else # to itself, or perhaps because mv is so ancient that it does not # support -f. { # Now remove or move aside any old file at destination location. # We try this two ways since rm can't unlink itself on some # systems and the destination file might be busy for other # reasons. In this case, the final cleanup might fail but the new # file should still install successfully. { test ! -f "$dst" || $doit $rmcmd "$dst" 2>/dev/null || { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && { $doit $rmcmd "$rmtmp" 2>/dev/null; :; } } || { echo "$0: cannot unlink or rename $dst" >&2 (exit 1); exit 1 } } && # Now rename the file to the real destination. $doit $mvcmd "$dsttmp" "$dst" } fi || exit 1 trap '' 0 fi done # Local variables: # eval: (add-hook 'before-save-hook 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-time-zone: "UTC0" # time-stamp-end: "; # UTC" # End: tcl8.6.14/unix/README0000644000175000017500000002033614554262142013511 0ustar sergeisergeiTcl UNIX README --------------- This is the directory where you configure, compile, test, and install UNIX versions of Tcl. This directory also contains source files for Tcl that are specific to UNIX. Some of the files in this directory are used on the PC or MacOSX platform too, but they all depend on UNIX (POSIX/ANSI C) interfaces and some of them only make sense under UNIX. Updated forms of the information found in this file is available at: https://www.tcl-lang.org/doc/howto/compile.html#unix For information on platforms where Tcl is known to compile, along with any porting notes for getting it to work on those platforms, see: https://www.tcl-lang.org/software/tcltk/platforms.html The rest of this file contains instructions on how to do this. The release should compile and run either "out of the box" or with trivial changes on any UNIX-like system that approximates POSIX, BSD, or System V. We know that it runs on workstations from Sun, H-P, DEC, IBM, and SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for a PC running Windows, see the README file in the directory ../win. To compile for MacOSX, see the README file in the directory ../macosx. How To Compile And Install Tcl: ------------------------------- (a) If you have already compiled Tcl once in this directory and are now preparing to compile again in the same directory but for a different platform, or if you have applied patches, type "make distclean" to discard all the configuration information computed previously. (b) If you need to reconfigure because you changed any of the .in or .m4 files, you will need to run autoconf to create a new ./configure script. Most users will NOT need to do this since a configure script is already provided. (in the tcl/unix directory) autoconf (c) Type "./configure". This runs a configuration script created by GNU autoconf, which configures Tcl for your system and creates a Makefile. The configure script allows you to customize the Tcl configuration for your site; for details on how you can do this, type "./configure --help" or refer to the autoconf documentation (not included here). Tcl's "configure" supports the following special switches in addition to the standard ones: --enable-threads If this switch is set, Tcl will compile itself with multithreading support. --disable-load If this switch is specified then Tcl will configure itself not to allow dynamic loading, even if your system appears to support it. Normally you can leave this switch out and Tcl will build itself for dynamic loading if your system supports it. --disable-dll-unloading Disables support for the [unload] command even on platforms that can support it. Meaningless when Tcl is compiled with --disable-load. --enable-shared If this switch is specified, Tcl will compile itself as a shared library if it can figure out how to do that on this platform. This is the default on platforms where we know how to build shared libraries. --disable-shared If this switch is specified, Tcl will compile itself as a static library. --enable-symbols Build with debugging symbols. By default standard debugging symbols are used. You can specify the value "mem" to include TCL_MEM_DEBUG memory debugging, "compile" to include TCL_COMPILE_DEBUG debugging, or "all" to enable all internal debugging. --disable-symbols Build without debugging symbols --enable-64bit Enable 64bit support (where applicable) --disable-64bit Disable 64bit support (where applicable) --enable-64bit-vis Enable 64bit Sparc VIS support --disable-64bit-vis Disable 64bit Sparc VIS support --enable-langinfo Allows use of modern nl_langinfo check for better localization support. This is on by default on platforms where nl_langinfo is found. --disable-langinfo Specifically disables use of nl_langinfo. --enable-man-symlinks Use symlinks for linking the manpages that should be reachable under several names. --enable-man-suffix[=STRING] Append STRING to the names of installed manual pages (prior to applying compression, if that is also enabled). If STRING is omitted, defaults to 'tcl'. --enable-man-compression=PROG Compress the manpages using PROG. --enable-dtrace Enable tcl DTrace provider (if DTrace is available on the platform), c.f. tclDTrace.d for descriptions of the probes made available, see https://wiki.tcl-lang.org/page/DTrace for more details --with-encoding=ENCODING Specifies the encoding for compile-time configuration values. Defaults to iso8859-1, which is also sufficient for ASCII. --with-tzdata=FLAG Specifies whether to install timezone data. By default, the configure script tries to detect whether a usable timezone database is present on the system already. Mac OS X only (i.e. completely unsupported on other platforms): --enable-framework Package Tcl as a framework. --disable-corefoundation Disable use of CoreFoundation API and revert to standard select based notifier, required when using naked fork (i.e. not followed by execve). Note: by default gcc will be used if it can be located on the PATH. If you want to use cc instead of gcc, set the CC environment variable to "cc" before running configure. It is not safe to edit the Makefile to use gcc after configure is run. Also note that you should use the same compiler when building extensions. Note: be sure to use only absolute path names (those starting with "/") in the --prefix and --exec-prefix options. (d) Type "make". This will create a library archive called "libtcl.a" or "libtcl.so" and an interpreter application called "tclsh" that allows you to type Tcl commands interactively or execute script files. It will also create a stub library archive "libtclstub.a" that developers may link against other C code to produce loadable extensions for Tcl. (e) If the make fails then you'll have to personalize the Makefile for your site or possibly modify the distribution in other ways. First check the porting Web page above to see if there are hints for compiling on your system. If you need to modify Makefile, there are comments at the beginning of it that describe the things you might want to change and how to change them. (f) Type "make install" to install Tcl binaries and script files in standard places. You'll need write permission on the installation directories to do this. The installation directories are determined by the "configure" script and may be specified with the standard --prefix and --exec-prefix options to "configure". See the Makefile for information on what directories were chosen; you can override these choices by modifying the "prefix" and "exec_prefix" variables in the Makefile. The installed binaries have embedded within them path values relative to the install directory. If you change your mind about where Tcl should be installed, start this procedure over again from step (a) so that the path embedded in the binaries agrees with the install location. (g) At this point you can play with Tcl by running the installed "tclsh" executable, or via the "make shell" target, and typing Tcl commands at the interactive prompt. If you have trouble compiling Tcl, see the URL noted above about working platforms. It contains information that people have provided about changes they had to make to compile Tcl in various environments. We're also interested in hearing how to change the configuration setup so that Tcl compiles on additional platforms "out of the box". Test suite ---------- There is a relatively complete test suite for all of the Tcl core in the subdirectory "tests". To use it just type "make test" in this directory. You should then see a printout of the test files processed. If any errors occur, you'll see a much more substantial printout for each error. See the README file in the "tests" directory for more information on the test suite. Note: don't run the tests as superuser: this will cause several of them to fail. If a test is failing consistently, please send us a bug report with as much detail as you can manage to our tracker: https://core.tcl-lang.org/tcl/reportlist tcl8.6.14/unix/ldAix0000755000175000017500000000373514554262142013624 0ustar sergeisergei#!/bin/sh # # ldAix ldCmd ldArg ldArg ... # # This shell script provides a wrapper for ld under AIX in order to # create the .exp file required for linking. Its arguments consist # of the name and arguments that would normally be provided to the # ld command. This script extracts the names of the object files # from the argument list, creates a .exp file describing all of the # symbols exported by those files, and then invokes "ldCmd" to # perform the real link. # Extract from the arguments the names of all of the object files. args=$* ofiles="" for i do x=`echo $i | grep '[^.].o$'` if test "$x" != ""; then ofiles="$ofiles $i" fi done # Extract the name of the object file that we're linking. outputFile=`echo $args | sed -e 's/.*-o \([^ ]*\).*/\1/'` # Create the export file from all of the object files, using nm followed # by sed editing. Here are some tricky aspects of this: # # - Use the -X32_64 switch to nm to handle 32 or 64bit compiles. # - Eliminate lines that end in ":": these are the names of object files # - Eliminate entries with the "U" key letter; these are undefined symbols # - If a line starts with ".", delete the leading ".", since this will just # cause confusion later # - Eliminate everything after the first field in a line, so that we're # left with just the symbol name nmopts="-g -C -h -X32_64" rm -f lib.exp echo "#! $outputFile" >lib.exp /usr/ccs/bin/nm $nmopts $ofiles | sed -e '/:$/d' -e '/ U /d' -e 's/^\.//' -e 's/[ |].*//' | sort | uniq >>lib.exp # If we're linking a .a file, then link all the objects together into a # single file "shr.o" and then put that into the archive. Otherwise link # the object files directly into the .a file. noDotA=`echo $outputFile | sed -e '/\.a$/d'` echo "noDotA=\"$noDotA\"" if test "$noDotA" = "" ; then linkArgs=`echo $args | sed -e 's/-o .*\.a /-o shr.o /'` echo $linkArgs eval $linkArgs echo ar cr $outputFile shr.o ar cr $outputFile shr.o rm -f shr.o else eval $args fi tcl8.6.14/unix/tcl.spec0000644000175000017500000000251114554262142014262 0ustar sergeisergei# This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} Name: tcl Summary: Tcl scripting language development environment Version: 8.6.14 Release: 2 License: BSD Group: Development/Languages Source: http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz URL: https://www.tcl-lang.org/ Buildroot: /var/tmp/%{name}%{version} %description The Tcl (Tool Command Language) provides a powerful platform for creating integration applications that tie together diverse applications, protocols, devices, and frameworks. When paired with the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that run on PCs, Unix, and Mac OS X. Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. %prep %setup -q -n %{name}%{version} %build cd unix CFLAGS="%optflags" ./configure \ --prefix=%{directory} \ --exec-prefix=%{directory} \ --libdir=%{directory}/%{_lib} make %install cd unix make INSTALL_ROOT=%{buildroot} install %clean rm -rf %buildroot %files %defattr(-,root,root) %if %{_lib} != lib %{directory}/%{_lib} %endif %{directory}/lib %{directory}/bin %{directory}/include %{directory}/man/man1 %{directory}/man/man3 %{directory}/man/mann tcl8.6.14/unix/installManPage0000755000175000017500000000631314554262142015455 0ustar sergeisergei#!/bin/sh ######################################################################## ### Parse Options ### Gzip=: Sym="" Loc="" Gz="" Suffix="" while true; do case $1 in -s | --symlinks ) Sym="-s " ;; -z | --compress ) Gzip=$2; shift ;; -e | --extension ) Gz=$2; shift ;; -x | --suffix ) Suffix=$2; shift ;; -*) cat < file dir" exit 1 fi ######################################################################## ### Parse Required Arguments ### ManPage=$1 Dir=$2 if test -f $ManPage ; then : ; else echo "source manual page file must exist" exit 1 fi if test -d "$Dir" ; then : ; else echo "target directory must exist" exit 1 fi test -z "$Sym" && Loc="$Dir/" ######################################################################## ### Extract Target Names from Manual Page ### # A sed script to parse the alternative names out of a man page. # # Backslashes are trippled in the sed script, because it is in # backticks which doesn't pass backslashes literally. # Names=`sed -n ' # Look for a line that starts with .SH NAME /^\.SH NAME/{ # Read next line n # Remove all commas ... s/,//g # ... and backslash-escaped spaces. s/\\\ //g # Delete from \- to the end of line s/ \\\-.*// # Convert all non-space non-alphanum sequences # to single underscores. s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g # print the result and exit p;q }' $ManPage` if test -z "$Names" ; then echo "warning: no target names found in $ManPage" fi ######################################################################## ### Remaining Set Up ### case $ManPage in *.1) Section=1 ;; *.3) Section=3 ;; *.n) Section=n ;; *) echo "unknown section for $ManPage" exit 2 ;; esac Name=`basename $ManPage .$Section` SrcDir=`dirname $ManPage` ######################################################################## ### Process Page to Create Target Pages ### Specials="DString Thread Notifier RegExp library packagens pkgMkIndex safesock FindPhoto FontId MeasureChar" for n in $Specials; do if [ "$Name" = "$n" ] ; then Names="$n $Names" fi done First="" for Target in $Names; do Target=$Target.$Section$Suffix rm -f "$Dir/$Target" "$Dir/$Target.*" if test -z "$First" ; then First=$Target sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \ $ManPage > "$Dir/$First" chmod 644 "$Dir/$First" $Gzip "$Dir/$First" else ln $Sym"$Loc$First$Gz" "$Dir/$Target$Gz" fi done ######################################################################## exit 0 tcl8.6.14/unix/tclConfig.h.in0000644000175000017500000003170214560750374015324 0ustar sergeisergei/* ../unix/tclConfig.h.in. Generated from configure.ac by autoheader. */ #ifndef _TCLCONFIG #define _TCLCONFIG /* Is gettimeofday() actually declared in ? */ #undef GETTOD_NOT_DECLARED /* Define to 1 if you have the header file. */ #undef HAVE_AVAILABILITYMACROS_H /* Define to 1 if the system has the type `blkcnt_t'. */ #undef HAVE_BLKCNT_T /* Defined when compiler supports casting to union type. */ #undef HAVE_CAST_TO_UNION /* Define to 1 if you have the `chflags' function. */ #undef HAVE_CHFLAGS /* Define to 1 if you have the `copyfile' function. */ #undef HAVE_COPYFILE /* Define to 1 if you have the header file. */ #undef HAVE_COPYFILE_H /* Do we have access to Darwin CoreFoundation.framework? */ #undef HAVE_COREFOUNDATION /* Is the cpuid instruction usable? */ #undef HAVE_CPUID /* Define to 1 if you have the declaration of `gethostbyaddr_r', and to 0 if you don't. */ #undef HAVE_DECL_GETHOSTBYADDR_R /* Define to 1 if you have the declaration of `gethostbyname_r', and to 0 if you don't. */ #undef HAVE_DECL_GETHOSTBYNAME_R /* Is 'DIR64' in ? */ #undef HAVE_DIR64 /* Define to 1 if you have the `freeaddrinfo' function. */ #undef HAVE_FREEADDRINFO /* Do we have fts functions? */ #undef HAVE_FTS /* Define to 1 if you have the `gai_strerror' function. */ #undef HAVE_GAI_STRERROR /* Define to 1 if you have the `getaddrinfo' function. */ #undef HAVE_GETADDRINFO /* Define to 1 if you have the `getattrlist' function. */ #undef HAVE_GETATTRLIST /* Define to 1 if you have the `getcwd' function. */ #undef HAVE_GETCWD /* Define to 1 if getgrgid_r is available. */ #undef HAVE_GETGRGID_R /* Define to 1 if getgrgid_r takes 4 args. */ #undef HAVE_GETGRGID_R_4 /* Define to 1 if getgrgid_r takes 5 args. */ #undef HAVE_GETGRGID_R_5 /* Define to 1 if getgrnam_r is available. */ #undef HAVE_GETGRNAM_R /* Define to 1 if getgrnam_r takes 4 args. */ #undef HAVE_GETGRNAM_R_4 /* Define to 1 if getgrnam_r takes 5 args. */ #undef HAVE_GETGRNAM_R_5 /* Define to 1 if gethostbyaddr_r is available. */ #undef HAVE_GETHOSTBYADDR_R /* Define to 1 if gethostbyaddr_r takes 7 args. */ #undef HAVE_GETHOSTBYADDR_R_7 /* Define to 1 if gethostbyaddr_r takes 8 args. */ #undef HAVE_GETHOSTBYADDR_R_8 /* Define to 1 if gethostbyname_r is available. */ #undef HAVE_GETHOSTBYNAME_R /* Define to 1 if gethostbyname_r takes 3 args. */ #undef HAVE_GETHOSTBYNAME_R_3 /* Define to 1 if gethostbyname_r takes 5 args. */ #undef HAVE_GETHOSTBYNAME_R_5 /* Define to 1 if gethostbyname_r takes 6 args. */ #undef HAVE_GETHOSTBYNAME_R_6 /* Define to 1 if you have the `getnameinfo' function. */ #undef HAVE_GETNAMEINFO /* Define to 1 if getpwnam_r is available. */ #undef HAVE_GETPWNAM_R /* Define to 1 if getpwnam_r takes 4 args. */ #undef HAVE_GETPWNAM_R_4 /* Define to 1 if getpwnam_r takes 5 args. */ #undef HAVE_GETPWNAM_R_5 /* Define to 1 if getpwuid_r is available. */ #undef HAVE_GETPWUID_R /* Define to 1 if getpwuid_r takes 4 args. */ #undef HAVE_GETPWUID_R_4 /* Define to 1 if getpwuid_r takes 5 args. */ #undef HAVE_GETPWUID_R_5 /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R /* Compiler support for module scope symbols */ #undef HAVE_HIDDEN /* Do we have the intptr_t type? */ #undef HAVE_INTPTR_T /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Do we have nl_langinfo()? */ #undef HAVE_LANGINFO /* Define to 1 if you have the header file. */ #undef HAVE_LIBKERN_OSATOMIC_H /* Define to 1 if you have the `localtime_r' function. */ #undef HAVE_LOCALTIME_R /* Define to 1 if you have the `lseek64' function. */ #undef HAVE_LSEEK64 /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the `mkstemp' function. */ #undef HAVE_MKSTEMP /* Define to 1 if you have the `mkstemps' function. */ #undef HAVE_MKSTEMPS /* Define to 1 if you have the `mktime' function. */ #undef HAVE_MKTIME /* Do we have MT-safe gethostbyaddr() ? */ #undef HAVE_MTSAFE_GETHOSTBYADDR /* Do we have MT-safe gethostbyname() ? */ #undef HAVE_MTSAFE_GETHOSTBYNAME /* Do we have ? */ #undef HAVE_NET_ERRNO_H /* Define to 1 if you have the `open64' function. */ #undef HAVE_OPEN64 /* Define to 1 if you have the `opendir' function. */ #undef HAVE_OPENDIR /* Define to 1 if you have the `OSSpinLockLock' function. */ #undef HAVE_OSSPINLOCKLOCK /* Define to 1 if you have the `posix_spawnattr_setflags' function. */ #undef HAVE_POSIX_SPAWNATTR_SETFLAGS /* Define to 1 if you have the `posix_spawnp' function. */ #undef HAVE_POSIX_SPAWNP /* Define to 1 if you have the `posix_spawn_file_actions_adddup2' function. */ #undef HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDDUP2 /* Define to 1 if you have the `pthread_atfork' function. */ #undef HAVE_PTHREAD_ATFORK /* Define to 1 if you have the `pthread_attr_setstacksize' function. */ #undef HAVE_PTHREAD_ATTR_SETSTACKSIZE /* Does putenv() copy strings or incorporate them by reference? */ #undef HAVE_PUTENV_THAT_COPIES /* Are characters signed? */ #undef HAVE_SIGNED_CHAR /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the `strtol' function. */ #undef HAVE_STRTOL /* Define to 1 if the system has the type `struct addrinfo'. */ #undef HAVE_STRUCT_ADDRINFO /* Is 'struct dirent64' in ? */ #undef HAVE_STRUCT_DIRENT64 /* Define to 1 if the system has the type `struct in6_addr'. */ #undef HAVE_STRUCT_IN6_ADDR /* Define to 1 if the system has the type `struct sockaddr_in6'. */ #undef HAVE_STRUCT_SOCKADDR_IN6 /* Define to 1 if the system has the type `struct sockaddr_storage'. */ #undef HAVE_STRUCT_SOCKADDR_STORAGE /* Is 'struct stat64' in ? */ #undef HAVE_STRUCT_STAT64 /* Define to 1 if `st_blksize' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE /* Define to 1 if `st_blocks' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLOCKS /* Define to 1 if you have the header file. */ #undef HAVE_SYS_FILIO_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_IOCTL_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_MODEM_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_PARAM_H /* Should we include ? */ #undef HAVE_SYS_SELECT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_TERMIOS_H /* Should we use the global timezone variable? */ #undef HAVE_TIMEZONE_VAR /* Should we use the tm_gmtoff field of struct tm? */ #undef HAVE_TM_GMTOFF /* Should we use the tm_tzadj field of struct tm? */ #undef HAVE_TM_TZADJ /* Is off64_t in ? */ #undef HAVE_TYPE_OFF64_T /* Do we have the uintptr_t type? */ #undef HAVE_UINTPTR_T /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to 1 if you have the `vfork' function. */ #undef HAVE_VFORK /* Define to 1 if you have the `waitpid' function. */ #undef HAVE_WAITPID /* Is weak import available? */ #undef HAVE_WEAK_IMPORT /* Is there an installed zlib? */ #undef HAVE_ZLIB /* Is this a Mac I see before me? */ #undef MAC_OSX_TCL /* No Compiler support for module scope symbols */ #undef MODULE_SCOPE /* Default libtommath precision. */ #undef MP_PREC /* Is no debugging enabled? */ #undef NDEBUG /* Use compat implementation of getaddrinfo() and friends */ #undef NEED_FAKE_RFC2553 /* Is Darwin CoreFoundation unavailable for 64-bit? */ #undef NO_COREFOUNDATION_64 /* Do we have ? */ #undef NO_DIRENT_H /* Do we have ? */ #undef NO_DLFCN_H /* Do we have fd_set? */ #undef NO_FD_SET /* Do we have ? */ #undef NO_FLOAT_H /* Do we have fork() */ #undef NO_FORK /* Do we have fstatfs()? */ #undef NO_FSTATFS /* Do we have gettimeofday()? */ #undef NO_GETTOD /* Do we have getwd() */ #undef NO_GETWD /* Do we have a usable 'isnan'? */ #undef NO_ISNAN /* Do we have memmove()? */ #undef NO_MEMMOVE /* Do we have mknod() */ #undef NO_MKNOD /* Do we have realpath() */ #undef NO_REALPATH /* Do we have ? */ #undef NO_STDLIB_H /* Do we have strerror() */ #undef NO_STRERROR /* Do we have ? */ #undef NO_STRING_H /* Do we have ? */ #undef NO_SYS_WAIT_H /* Do we have tcdrain() */ #undef NO_TCDRAIN /* Do we have uname() */ #undef NO_UNAME /* Do we have a usable 'union wait'? */ #undef NO_UNION_WAIT /* Do we have ? */ #undef NO_VALUES_H /* Do we have wait3() */ #undef NO_WAIT3 /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Is this a static build? */ #undef STATIC_BUILD /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* What encoding should be used for embedded configuration info? */ #undef TCL_CFGVAL_ENCODING /* Is this a 64-bit build? */ #undef TCL_CFG_DO64BIT /* Is this an optimized build? */ #undef TCL_CFG_OPTIMIZED /* Is bytecode debugging enabled? */ #undef TCL_COMPILE_DEBUG /* Are bytecode statistics enabled? */ #undef TCL_COMPILE_STATS /* Are we to override what our default encoding is? */ #undef TCL_DEFAULT_ENCODING /* Is Tcl built as a framework? */ #undef TCL_FRAMEWORK /* Can this platform load code from memory? */ #undef TCL_LOAD_FROM_MEMORY /* Is memory debugging enabled? */ #undef TCL_MEM_DEBUG /* What is the default extension for shared libraries? */ #undef TCL_SHLIB_EXT /* Are we building with threads enabled? */ #undef TCL_THREADS /* Build libtommath? */ #undef TCL_TOMMATH /* Do we allow unloading of shared libraries? */ #undef TCL_UNLOAD_DLLS /* Does this platform have wide high-resolution clicks? */ #undef TCL_WIDE_CLICKS /* Are wide integers to be implemented with C 'long's? */ #undef TCL_WIDE_INT_IS_LONG /* What type should be used to define wide integers? */ #undef TCL_WIDE_INT_TYPE /* Define to 1 if you can safely include both and . */ #undef TIME_WITH_SYS_TIME /* Is getcwd Posix-compliant? */ #undef USEGETWD /* May we include ? */ #undef USE_DIRENT2_H /* Are we building with DTrace support? */ #undef USE_DTRACE /* Should we use FIONBIO? */ #undef USE_FIONBIO /* Do we want to use the threaded memory allocator? */ #undef USE_THREAD_ALLOC /* Define to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel and VAX). */ #undef WORDS_BIGENDIAN /* Are Darwin SUSv3 extensions available? */ #undef _DARWIN_C_SOURCE /* Add the _ISOC99_SOURCE flag when building */ #undef _ISOC99_SOURCE /* Add the _LARGEFILE64_SOURCE flag when building */ #undef _LARGEFILE64_SOURCE /* # needed in sys/socket.h Should OS/390 do the right thing with sockets? */ #undef _OE_SOCKETS /* Do we really want to follow the standard? Yes we do! */ #undef _POSIX_PTHREAD_SEMANTICS /* Do we want the reentrant OS API? */ #undef _REENTRANT /* Do we want the thread-safe OS API? */ #undef _THREAD_SAFE /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE_EXTENDED /* Define to 1 if type `char' is unsigned and you are not using gcc. */ #ifndef __CHAR_UNSIGNED__ # undef __CHAR_UNSIGNED__ #endif /* Define to `int' if doesn't define. */ #undef gid_t /* Define to `__inline__' or `__inline' if that's what the C compiler calls it, or to nothing if 'inline' is not supported under any name. */ #ifndef __cplusplus #undef inline #endif /* Signed integer type wide enough to hold a pointer. */ #undef intptr_t /* Define to `int' if does not define. */ #undef mode_t /* Define to `int' if does not define. */ #undef pid_t /* Define to `unsigned' if does not define. */ #undef size_t /* Define as int if socklen_t is not available */ #undef socklen_t /* Define to `int' if doesn't define. */ #undef uid_t /* Unsigned integer type wide enough to hold a pointer. */ #undef uintptr_t /* Undef unused package specific autoheader defines so that we can * include both tclConfig.h and tkConfig.h at the same time: */ /* override */ #undef PACKAGE_NAME /* override */ #undef PACKAGE_TARNAME /* override */ #undef PACKAGE_VERSION /* override */ #undef PACKAGE_STRING #endif /* _TCLCONFIG */ tcl8.6.14/unix/tcl.pc.in0000644000175000017500000000074014554262142014341 0ustar sergeisergei# tcl pkg-config source file prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ libfile=@TCL_LIB_FILE@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. URL: https://www.tcl-lang.org/ Version: @TCL_VERSION@@TCL_PATCH_LEVEL@ Requires.private: zlib >= 1.2.3 Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@ Libs.private: @TCL_LIBS@ Cflags: -I${includedir} tcl8.6.14/unix/dltest/0000755000175000017500000000000014566153412014126 5ustar sergeisergeitcl8.6.14/unix/dltest/pkga.c0000644000175000017500000000617614554262142015224 0ustar sergeisergei/* * pkga.c -- * * This file contains a simple Tcl package "pkga" that is intended for * testing the Tcl dynamic loading facilities. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" /* *---------------------------------------------------------------------- * * Pkga_EqObjCmd -- * * This procedure is invoked to process the "pkga_eq" Tcl command. It * expects two arguments and returns 1 if they are the same, 0 if they * are different. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkga_EqObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; const char *str1, *str2; int len1, len2; (void)dummy; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); return TCL_ERROR; } str1 = Tcl_GetStringFromObj(objv[1], &len1); str2 = Tcl_GetStringFromObj(objv[2], &len2); len1 = Tcl_NumUtfChars(str1, len1); len2 = Tcl_NumUtfChars(str2, len2); if (len1 == len2) { result = (Tcl_UtfNcmp(str1, str2, (size_t)len1) == 0); } else { result = 0; } Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkga_QuoteObjCmd -- * * This procedure is invoked to process the "pkga_quote" Tcl command. It * expects one argument, which it returns as result. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkga_QuoteObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { (void)dummy; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkga_Init -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to an interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkga_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkga", "1.0"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd, NULL, NULL); return TCL_OK; } tcl8.6.14/unix/dltest/pkgb.c0000644000175000017500000001122014554262142015207 0ustar sergeisergei/* * pkgb.c -- * * This file contains a simple Tcl package "pkgb" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" #if defined(_WIN32) && defined(_MSC_VER) # define snprintf _snprintf #endif /* *---------------------------------------------------------------------- * * Pkgb_SubObjCmd -- * * This procedure is invoked to process the "pkgb_sub" Tcl command. It * expects two arguments and returns their difference. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ #ifndef Tcl_GetErrorLine # define Tcl_GetErrorLine(interp) ((interp)->errorLine) #endif static int Pkgb_SubObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int first, second; (void)dummy; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "num num"); return TCL_ERROR; } if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { char buf[TCL_INTEGER_SPACE]; snprintf(buf, sizeof(buf), "%d", Tcl_GetErrorLine(interp)); Tcl_AppendResult(interp, " in line: ", buf, (void *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgb_UnsafeObjCmd -- * * This procedure is invoked to process the "pkgb_unsafe" Tcl command. It * just returns a constant string. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkgb_UnsafeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { (void)dummy; (void)objc; (void)objv; return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL); } static int Pkgb_DemoObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { (void)dummy; (void)objc; (void)objv; #if (TCL_MAJOR_VERSION > 8) || (TCL_MINOR_VERSION > 4) Tcl_Obj *first; if (Tcl_ListObjIndex(NULL, Tcl_GetEncodingSearchPath(), 0, &first) == TCL_OK) { Tcl_SetObjResult(interp, first); } #else Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1)); #endif return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgb_Init -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to an interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgb_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgb", "2.3"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgb_SafeInit -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to a safe interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgb_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgb", "2.3"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL); return TCL_OK; } tcl8.6.14/unix/dltest/pkgc.c0000644000175000017500000000731714554262142015224 0ustar sergeisergei/* * pkgc.c -- * * This file contains a simple Tcl package "pkgc" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" /* *---------------------------------------------------------------------- * * Pkgc_SubObjCmd -- * * This procedure is invoked to process the "pkgc_sub" Tcl command. It * expects two arguments and returns their difference. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkgc_SubObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int first, second; (void)dummy; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "num num"); return TCL_ERROR; } if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgc_UnsafeCmd -- * * This procedure is invoked to process the "pkgc_unsafe" Tcl command. It * just returns a constant string. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkgc_UnsafeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { (void)dummy; (void)objc; (void)objv; Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgc_Init -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to an interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgc_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgc", "1.7.2"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgc_SafeInit -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to a safe interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgc_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgc", "1.7.2"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL); return TCL_OK; } tcl8.6.14/unix/dltest/pkgd.c0000644000175000017500000000731314554262142015221 0ustar sergeisergei/* * pkgd.c -- * * This file contains a simple Tcl package "pkgd" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" /* *---------------------------------------------------------------------- * * Pkgd_SubObjCmd -- * * This procedure is invoked to process the "pkgd_sub" Tcl command. It * expects two arguments and returns their difference. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkgd_SubObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int first, second; (void)dummy; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "num num"); return TCL_ERROR; } if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgd_UnsafeCmd -- * * This procedure is invoked to process the "pkgd_unsafe" Tcl command. It * just returns a constant string. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkgd_UnsafeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { (void)dummy; (void)objc; (void)objv; Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgd_Init -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to an interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgd_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgd", "7.3"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgd_SafeInit -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to a safe interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgd_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgd", "7.3"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL); return TCL_OK; } tcl8.6.14/unix/dltest/pkge.c0000644000175000017500000000222114554262142015213 0ustar sergeisergei/* * pkge.c -- * * This file contains a simple Tcl package "pkge" that is intended for * testing the Tcl dynamic loading facilities. Its Init procedure returns * an error in order to test how this is handled. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" /* *---------------------------------------------------------------------- * * Pkge_Init -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to an interpreter. * * Results: * Returns TCL_ERROR and leaves an error message in interp->result. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkge_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { static const char script[] = "if 44 {open non_existent}"; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } return Tcl_EvalEx(interp, script, -1, 0); } tcl8.6.14/unix/dltest/pkgooa.c0000644000175000017500000001044214554262142015551 0ustar sergeisergei/* * pkgooa.c -- * * This file contains a simple Tcl package "pkgooa" that is intended for * testing the Tcl dynamic loading facilities. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tclOO.h" #include /* *---------------------------------------------------------------------- * * Pkgooa_StubsOKObjCmd -- * * This procedure is invoked to process the "pkgooa_stubsok" Tcl command. * It gives 1 if stubs are used correctly, 0 if stubs are not OK. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkgooa_StubsOKObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { (void)dummy; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj( Tcl_CopyObjectInstance == tclOOStubsPtr->tcl_CopyObjectInstance)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgooa_Init -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to an interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ extern void *tclOOIntStubsPtr; static TclOOStubs stubsCopy = { TCL_STUB_MAGIC, NULL, /* It doesn't really matter what implementation of * Tcl_CopyObjectInstance is put in the "pseudo" * stub table, since the test-case never actually * calls this function. All that matters is that it's * a function with a different memory address than * the real Tcl_CopyObjectInstance function in Tcl. */ (Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *, const char *t))(void *)Pkgooa_StubsOKObjCmd, /* More entries could be here, but those are not used * for this test-case. So, being NULL is OK. */ NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL }; DLLEXPORT int Pkgooa_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; /* Any TclOO extension which uses stubs, calls * both Tcl_InitStubs and Tcl_OOInitStubs() and * does not use any Tcl 8.6 features should be * loadable in Tcl 8.5 as well, provided the * TclOO extension (for Tcl 8.5) is installed. * This worked in Tcl 8.6.0, and is expected * to keep working in all future Tcl 8.x releases. */ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } if (tclStubsPtr == NULL) { Tcl_AppendResult(interp, "Tcl stubs are not initialized, " "did you compile using -DUSE_TCL_STUBS? ", (void *)NULL); return TCL_ERROR; } if (Tcl_OOInitStubs(interp) == NULL) { return TCL_ERROR; } if (tclOOStubsPtr == NULL) { Tcl_AppendResult(interp, "TclOO stubs are not initialized", (void *)NULL); return TCL_ERROR; } if (tclOOIntStubsPtr == NULL) { Tcl_AppendResult(interp, "TclOO internal stubs are not initialized", (void *)NULL); return TCL_ERROR; } /* Test case for Bug [f51efe99a7]. * * Let tclOOStubsPtr point to an alternate stub table * (with only a single function, that's enough for * this test). This way, the function "pkgooa_stubsok" * can check whether the TclOO function calls really * use the stub table, or only pretend to. * * On platforms without backlinking (Windows, Cygwin, * AIX), this code doesn't even compile without using * stubs, but on UNIX ELF systems, the problem is * less visible. */ tclOOStubsPtr = &stubsCopy; code = Tcl_PkgProvide(interp, "pkgooa", "1.0"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL); return TCL_OK; } tcl8.6.14/unix/dltest/pkgua.c0000644000175000017500000002111514554262142015377 0ustar sergeisergei/* * pkgua.c -- * * This file contains a simple Tcl package "pkgua" that is intended for * testing the Tcl dynamic unloading facilities. * * Copyright (c) 1995 Sun Microsystems, Inc. * Copyright (c) 2004 Georgios Petasis * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" /* * In the following hash table we are going to store a struct that holds all * the command tokens created by Tcl_CreateObjCommand in an interpreter, * indexed by the interpreter. In this way, we can find which command tokens * we have registered in a specific interpreter, in order to unload them. We * need to keep the various command tokens we have registered, as they are the * only safe way to unregister our registered commands, even if they have been * renamed. */ typedef struct ThreadSpecificData { int interpTokenMapInitialised; Tcl_HashTable interpTokenMap; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #define MAX_REGISTERED_COMMANDS 2 static void CommandDeleted(ClientData clientData) { Tcl_Command *cmdToken = (Tcl_Command *)clientData; *cmdToken = NULL; } static void PkguaInitTokensHashTable(void) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData)); if (tsdPtr->interpTokenMapInitialised) { return; } Tcl_InitHashTable(&tsdPtr->interpTokenMap, TCL_ONE_WORD_KEYS); tsdPtr->interpTokenMapInitialised = 1; } static void PkguaFreeTokensHashTable(void) { Tcl_HashSearch search; Tcl_HashEntry *entryPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData)); for (entryPtr = Tcl_FirstHashEntry(&tsdPtr->interpTokenMap, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { Tcl_Free((char *) Tcl_GetHashValue(entryPtr)); } tsdPtr->interpTokenMapInitialised = 0; } static Tcl_Command * PkguaInterpToTokens( Tcl_Interp *interp) { int newEntry; Tcl_Command *cmdTokens; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData)); Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(&tsdPtr->interpTokenMap, (char *) interp, &newEntry); if (newEntry) { cmdTokens = (Tcl_Command *) Tcl_Alloc(sizeof(Tcl_Command) * (MAX_REGISTERED_COMMANDS)); for (newEntry=0 ; newEntryinterpTokenMap, (char *) interp); if (entryPtr) { Tcl_Free((char *) Tcl_GetHashValue(entryPtr)); Tcl_DeleteHashEntry(entryPtr); } } /* *---------------------------------------------------------------------- * * PkguaEqObjCmd -- * * This procedure is invoked to process the "pkgua_eq" Tcl command. It * expects two arguments and returns 1 if they are the same, 0 if they * are different. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int PkguaEqObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; const char *str1, *str2; int len1, len2; (void)dummy; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); return TCL_ERROR; } str1 = Tcl_GetStringFromObj(objv[1], &len1); str2 = Tcl_GetStringFromObj(objv[2], &len2); len1 = Tcl_NumUtfChars(str1, len1); len2 = Tcl_NumUtfChars(str2, len2); if (len1 == len2) { result = (Tcl_UtfNcmp(str1, str2, (size_t)len1) == 0); } else { result = 0; } Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); return TCL_OK; } /* *---------------------------------------------------------------------- * * PkguaQuoteObjCmd -- * * This procedure is invoked to process the "pkgua_quote" Tcl command. It * expects one argument, which it returns as result. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int PkguaQuoteObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { (void)dummy; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgua_Init -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to an interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgua_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; Tcl_Command *cmdTokens; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } /* * Initialize our Hash table, where we store the registered command tokens * for each interpreter. */ PkguaInitTokensHashTable(); code = Tcl_PkgProvide(interp, "pkgua", "1.0"); if (code != TCL_OK) { return code; } Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE); cmdTokens = PkguaInterpToTokens(interp); cmdTokens[0] = Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, &cmdTokens[0], CommandDeleted); cmdTokens[1] = Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd, &cmdTokens[1], CommandDeleted); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgua_SafeInit -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to a safe interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgua_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { return Pkgua_Init(interp); } /* *---------------------------------------------------------------------- * * Pkgua_Unload -- * * This is a package unloading initialization procedure, which is called * by Tcl when this package is to be unloaded from an interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkgua_Unload( Tcl_Interp *interp, /* Interpreter from which the package is to be * unloaded. */ int flags) /* Flags passed by the unloading mechanism */ { int code, cmdIndex; Tcl_Command *cmdTokens = PkguaInterpToTokens(interp); for (cmdIndex=0 ; cmdIndexv) #define CERR(e) VERR(cm->v, (e)) /* - initcm - set up new colormap ^ static void initcm(struct vars *, struct colormap *); */ static void initcm( struct vars *v, struct colormap *cm) { int i; int j; union tree *t; union tree *nextt; struct colordesc *cd; cm->magic = CMMAGIC; cm->v = v; cm->ncds = NINLINECDS; cm->cd = cm->cdspace; cm->max = 0; cm->free = 0; cd = cm->cd; /* cm->cd[WHITE] */ cd->sub = NOSUB; cd->arcs = NULL; cd->flags = 0; cd->nchrs = CHR_MAX - CHR_MIN + 1; /* * Upper levels of tree. */ for (t=&cm->tree[0], j=NBYTS-1 ; j>0 ; t=nextt, j--) { nextt = t + 1; for (i=BYTTAB-1 ; i>=0 ; i--) { t->tptr[i] = nextt; } } /* * Bottom level is solid white. */ t = &cm->tree[NBYTS-1]; for (i=BYTTAB-1 ; i>=0 ; i--) { t->tcolor[i] = WHITE; } cd->block = t; } /* - freecm - free dynamically-allocated things in a colormap ^ static void freecm(struct colormap *); */ static void freecm( struct colormap *cm) { size_t i; union tree *cb; cm->magic = 0; if (NBYTS > 1) { cmtreefree(cm, cm->tree, 0); } for (i=1 ; i<=cm->max ; i++) { /* skip WHITE */ if (!UNUSEDCOLOR(&cm->cd[i])) { cb = cm->cd[i].block; if (cb != NULL) { FREE(cb); } } } if (cm->cd != cm->cdspace) { FREE(cm->cd); } } /* - cmtreefree - free a non-terminal part of a colormap tree ^ static void cmtreefree(struct colormap *, union tree *, int); */ static void cmtreefree( struct colormap *cm, union tree *tree, int level) /* level number (top == 0) of this block */ { int i; union tree *t; union tree *fillt = &cm->tree[level+1]; union tree *cb; assert(level < NBYTS-1); /* this level has pointers */ for (i=BYTTAB-1 ; i>=0 ; i--) { t = tree->tptr[i]; assert(t != NULL); if (t != fillt) { if (level < NBYTS-2) { /* more pointer blocks below */ cmtreefree(cm, t, level+1); FREE(t); } else { /* color block below */ cb = cm->cd[t->tcolor[0]].block; if (t != cb) { /* not a solid block */ FREE(t); } } } } } /* - setcolor - set the color of a character in a colormap ^ static color setcolor(struct colormap *, pchr, pcolor); */ static color /* previous color */ setcolor( struct colormap *cm, pchr c, pcolor co) { uchr uc = c; int shift; int level; int b; int bottom; union tree *t; union tree *newt; union tree *fillt; union tree *lastt; union tree *cb; color prev; assert(cm->magic == CMMAGIC); if (CISERR() || co == COLORLESS) { return COLORLESS; } t = cm->tree; for (level=0, shift=BYTBITS*(NBYTS-1) ; shift>0; level++, shift-=BYTBITS){ b = (uc >> shift) & BYTMASK; lastt = t; t = lastt->tptr[b]; assert(t != NULL); fillt = &cm->tree[level+1]; bottom = (shift <= BYTBITS) ? 1 : 0; cb = (bottom) ? cm->cd[t->tcolor[0]].block : fillt; if (t == fillt || t == cb) { /* must allocate a new block */ newt = (union tree *) MALLOC((bottom) ? sizeof(struct colors) : sizeof(struct ptrs)); if (newt == NULL) { CERR(REG_ESPACE); return COLORLESS; } if (bottom) { memcpy(newt->tcolor, t->tcolor, BYTTAB*sizeof(color)); } else { memcpy(newt->tptr, t->tptr, BYTTAB*sizeof(union tree *)); } t = newt; lastt->tptr[b] = t; } } b = uc & BYTMASK; prev = t->tcolor[b]; t->tcolor[b] = (color) co; return prev; } /* - maxcolor - report largest color number in use ^ static color maxcolor(struct colormap *); */ static color maxcolor( struct colormap *cm) { if (CISERR()) { return COLORLESS; } return (color) cm->max; } /* - newcolor - find a new color (must be subject of setcolor at once) * Beware: may relocate the colordescs. ^ static color newcolor(struct colormap *); */ static color /* COLORLESS for error */ newcolor( struct colormap *cm) { struct colordesc *cd; size_t n; if (CISERR()) { return COLORLESS; } if (cm->free != 0) { assert(cm->free > 0); assert((size_t) cm->free < cm->ncds); cd = &cm->cd[cm->free]; assert(UNUSEDCOLOR(cd)); assert(cd->arcs == NULL); cm->free = cd->sub; } else if (cm->max < cm->ncds - 1) { cm->max++; cd = &cm->cd[cm->max]; } else { struct colordesc *newCd; /* * Oops, must allocate more. */ if (cm->max == MAX_COLOR) { CERR(REG_ECOLORS); return COLORLESS; /* too many colors */ } n = cm->ncds * 2; if (n > MAX_COLOR + 1) { n = MAX_COLOR + 1; } if (cm->cd == cm->cdspace) { newCd = (struct colordesc *) MALLOC(n * sizeof(struct colordesc)); if (newCd != NULL) { memcpy(newCd, cm->cdspace, cm->ncds * sizeof(struct colordesc)); } } else { newCd = (struct colordesc *) REALLOC(cm->cd, n * sizeof(struct colordesc)); } if (newCd == NULL) { CERR(REG_ESPACE); return COLORLESS; } cm->cd = newCd; cm->ncds = n; assert(cm->max < cm->ncds - 1); cm->max++; cd = &cm->cd[cm->max]; } cd->nchrs = 0; cd->sub = NOSUB; cd->arcs = NULL; cd->flags = 0; cd->block = NULL; return (color) (cd - cm->cd); } /* - freecolor - free a color (must have no arcs or subcolor) ^ static void freecolor(struct colormap *, pcolor); */ static void freecolor( struct colormap *cm, pcolor co) { struct colordesc *cd = &cm->cd[co]; color pco, nco; /* for freelist scan */ assert(co >= 0); if (co == WHITE) { return; } assert(cd->arcs == NULL); assert(cd->sub == NOSUB); assert(cd->nchrs == 0); cd->flags = FREECOL; if (cd->block != NULL) { FREE(cd->block); cd->block = NULL; /* just paranoia */ } if ((size_t) co == cm->max) { while (cm->max > WHITE && UNUSEDCOLOR(&cm->cd[cm->max])) { cm->max--; } assert(cm->free >= 0); while ((size_t) cm->free > cm->max) { cm->free = cm->cd[cm->free].sub; } if (cm->free > 0) { assert((size_t)cm->free < cm->max); pco = cm->free; nco = cm->cd[pco].sub; while (nco > 0) { if ((size_t) nco > cm->max) { /* * Take this one out of freelist. */ nco = cm->cd[nco].sub; cm->cd[pco].sub = nco; } else { assert((size_t)nco < cm->max); pco = nco; nco = cm->cd[pco].sub; } } } } else { cd->sub = cm->free; cm->free = (color) (cd - cm->cd); } } /* - pseudocolor - allocate a false color, to be managed by other means ^ static color pseudocolor(struct colormap *); */ static color pseudocolor( struct colormap *cm) { color co; co = newcolor(cm); if (CISERR()) { return COLORLESS; } cm->cd[co].nchrs = 1; cm->cd[co].flags = PSEUDO; return co; } /* - subcolor - allocate a new subcolor (if necessary) to this chr ^ static color subcolor(struct colormap *, pchr c); */ static color subcolor( struct colormap *cm, pchr c) { color co; /* current color of c */ color sco; /* new subcolor */ co = GETCOLOR(cm, c); sco = newsub(cm, co); if (CISERR()) { return COLORLESS; } assert(sco != COLORLESS); if (co == sco) { /* already in an open subcolor */ return co; /* rest is redundant */ } cm->cd[co].nchrs--; cm->cd[sco].nchrs++; setcolor(cm, c, sco); return sco; } /* - newsub - allocate a new subcolor (if necessary) for a color ^ static color newsub(struct colormap *, pcolor); */ static color newsub( struct colormap *cm, pcolor co) { color sco; /* new subcolor */ sco = cm->cd[co].sub; if (sco == NOSUB) { /* color has no open subcolor */ if (cm->cd[co].nchrs == 1) { /* optimization */ return co; } sco = newcolor(cm); /* must create subcolor */ if (sco == COLORLESS) { assert(CISERR()); return COLORLESS; } cm->cd[co].sub = sco; cm->cd[sco].sub = sco; /* open subcolor points to self */ } assert(sco != NOSUB); return sco; } /* - subrange - allocate new subcolors to this range of chrs, fill in arcs ^ static void subrange(struct vars *, pchr, pchr, struct state *, ^ struct state *); */ static void subrange( struct vars *v, pchr from, pchr to, struct state *lp, struct state *rp) { uchr uf; int i; assert(from <= to); /* * First, align "from" on a tree-block boundary */ uf = (uchr) from; i = (int) (((uf + BYTTAB - 1) & (uchr) ~BYTMASK) - uf); for (; from<=to && i>0; i--, from++) { newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp); } if (from > to) { /* didn't reach a boundary */ return; } /* * Deal with whole blocks. */ for (; to-from>=BYTTAB ; from+=BYTTAB) { subblock(v, from, lp, rp); } /* * Clean up any remaining partial table. */ for (; from<=to ; from++) { newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp); } } /* - subblock - allocate new subcolors for one tree block of chrs, fill in arcs ^ static void subblock(struct vars *, pchr, struct state *, struct state *); */ static void subblock( struct vars *v, pchr start, /* first of BYTTAB chrs */ struct state *lp, struct state *rp) { uchr uc = start; struct colormap *cm = v->cm; int shift; int level; int i; int b; union tree *t; union tree *cb; union tree *fillt; union tree *lastt; int previ; int ndone; color co; color sco; assert((uc % BYTTAB) == 0); /* * Find its color block, making new pointer blocks as needed. */ t = cm->tree; fillt = NULL; for (level=0, shift=BYTBITS*(NBYTS-1); shift>0; level++, shift-=BYTBITS) { b = (uc >> shift) & BYTMASK; lastt = t; t = lastt->tptr[b]; assert(t != NULL); fillt = &cm->tree[level+1]; if (t == fillt && shift > BYTBITS) { /* need new ptr block */ t = (union tree *) MALLOC(sizeof(struct ptrs)); if (t == NULL) { CERR(REG_ESPACE); return; } memcpy(t->tptr, fillt->tptr, BYTTAB*sizeof(union tree *)); lastt->tptr[b] = t; } } /* * Special cases: fill block or solid block. */ co = t->tcolor[0]; cb = cm->cd[co].block; if (t == fillt || t == cb) { /* * Either way, we want a subcolor solid block. */ sco = newsub(cm, co); t = cm->cd[sco].block; if (t == NULL) { /* must set it up */ t = (union tree *) MALLOC(sizeof(struct colors)); if (t == NULL) { CERR(REG_ESPACE); return; } for (i=0 ; itcolor[i] = sco; } cm->cd[sco].block = t; } /* * Find loop must have run at least once. */ lastt->tptr[b] = t; newarc(v->nfa, PLAIN, sco, lp, rp); cm->cd[co].nchrs -= BYTTAB; cm->cd[sco].nchrs += BYTTAB; return; } /* * General case, a mixed block to be altered. */ i = 0; while (i < BYTTAB) { co = t->tcolor[i]; sco = newsub(cm, co); newarc(v->nfa, PLAIN, sco, lp, rp); previ = i; do { t->tcolor[i++] = sco; } while (i < BYTTAB && t->tcolor[i] == co); ndone = i - previ; cm->cd[co].nchrs -= ndone; cm->cd[sco].nchrs += ndone; } } /* - okcolors - promote subcolors to full colors ^ static void okcolors(struct nfa *, struct colormap *); */ static void okcolors( struct nfa *nfa, struct colormap *cm) { struct colordesc *cd; struct colordesc *end = CDEND(cm); struct colordesc *scd; struct arc *a; color co; color sco; for (cd=cm->cd, co=0 ; cdsub; if (UNUSEDCOLOR(cd) || sco == NOSUB) { /* * Has no subcolor, no further action. */ } else if (sco == co) { /* * Is subcolor, let parent deal with it. */ } else if (cd->nchrs == 0) { /* * Parent empty, its arcs change color to subcolor. */ cd->sub = NOSUB; scd = &cm->cd[sco]; assert(scd->nchrs > 0); assert(scd->sub == sco); scd->sub = NOSUB; while ((a = cd->arcs) != NULL) { assert(a->co == co); uncolorchain(cm, a); a->co = sco; colorchain(cm, a); } freecolor(cm, co); } else { /* * Parent's arcs must gain parallel subcolor arcs. */ cd->sub = NOSUB; scd = &cm->cd[sco]; assert(scd->nchrs > 0); assert(scd->sub == sco); scd->sub = NOSUB; for (a=cd->arcs ; a!=NULL ; a=a->colorchain) { assert(a->co == co); newarc(nfa, a->type, sco, a->from, a->to); } } } } /* - colorchain - add this arc to the color chain of its color ^ static void colorchain(struct colormap *, struct arc *); */ static void colorchain( struct colormap *cm, struct arc *a) { struct colordesc *cd = &cm->cd[a->co]; if (cd->arcs != NULL) { cd->arcs->colorchainRev = a; } a->colorchain = cd->arcs; a->colorchainRev = NULL; cd->arcs = a; } /* - uncolorchain - delete this arc from the color chain of its color ^ static void uncolorchain(struct colormap *, struct arc *); */ static void uncolorchain( struct colormap *cm, struct arc *a) { struct colordesc *cd = &cm->cd[a->co]; struct arc *aa = a->colorchainRev; if (aa == NULL) { assert(cd->arcs == a); cd->arcs = a->colorchain; } else { assert(aa->colorchain == a); aa->colorchain = a->colorchain; } if (a->colorchain != NULL) { a->colorchain->colorchainRev = aa; } a->colorchain = NULL; /* paranoia */ a->colorchainRev = NULL; } /* - rainbow - add arcs of all full colors (but one) between specified states ^ static void rainbow(struct nfa *, struct colormap *, int, pcolor, ^ struct state *, struct state *); */ static void rainbow( struct nfa *nfa, struct colormap *cm, int type, pcolor but, /* COLORLESS if no exceptions */ struct state *from, struct state *to) { struct colordesc *cd; struct colordesc *end = CDEND(cm); color co; for (cd=cm->cd, co=0 ; cdsub != co) && (co != but) && !(cd->flags&PSEUDO)) { newarc(nfa, type, co, from, to); } } } /* - colorcomplement - add arcs of complementary colors * The calling sequence ought to be reconciled with cloneouts(). ^ static void colorcomplement(struct nfa *, struct colormap *, int, ^ struct state *, struct state *, struct state *); */ static void colorcomplement( struct nfa *nfa, struct colormap *cm, int type, struct state *of, /* complements of this guy's PLAIN outarcs */ struct state *from, struct state *to) { struct colordesc *cd; struct colordesc *end = CDEND(cm); color co; assert(of != from); for (cd=cm->cd, co=0 ; cdflags&PSEUDO)) { if (findarc(of, PLAIN, co) == NULL) { newarc(nfa, type, co, from, to); } } } } #ifdef REG_DEBUG /* ^ #ifdef REG_DEBUG */ /* - dumpcolors - debugging output ^ static void dumpcolors(struct colormap *, FILE *); */ static void dumpcolors( struct colormap *cm, FILE *f) { struct colordesc *cd; struct colordesc *end; color co; chr c; const char *has; fprintf(f, "max %ld\n", (long) cm->max); if (NBYTS > 1) { fillcheck(cm, cm->tree, 0, f); } end = CDEND(cm); for (cd=cm->cd+1, co=1 ; cdnchrs > 0); has = (cd->block != NULL) ? "#" : ""; if (cd->flags&PSEUDO) { fprintf(f, "#%2ld%s(ps): ", (long) co, has); } else { fprintf(f, "#%2ld%s(%2d): ", (long) co, has, cd->nchrs); } /* * Unfortunately, it's hard to do this next bit more efficiently. * * Spencer's original coding has the loop iterating from CHR_MIN * to CHR_MAX, but that's utterly unusable for 32-bit chr, or * even 16-bit. For debugging purposes it seems fine to print * only chr codes up to 1000 or so. */ for (c=CHR_MIN ; c<1000 ; c++) { if (GETCOLOR(cm, c) == co) { dumpchr(c, f); } } fprintf(f, "\n"); } } } /* - fillcheck - check proper filling of a tree ^ static void fillcheck(struct colormap *, union tree *, int, FILE *); */ static void fillcheck( struct colormap *cm, union tree *tree, int level, /* level number (top == 0) of this block */ FILE *f) { int i; union tree *t; union tree *fillt = &cm->tree[level+1]; assert(level < NBYTS-1); /* this level has pointers */ for (i=BYTTAB-1 ; i>=0 ; i--) { t = tree->tptr[i]; if (t == NULL) { fprintf(f, "NULL found in filled tree!\n"); } else if (t == fillt) { /* empty body */ } else if (level < NBYTS-2) { /* more pointer blocks below */ fillcheck(cm, t, level+1, f); } } } /* - dumpchr - print a chr * Kind of char-centric but works well enough for debug use. ^ static void dumpchr(pchr, FILE *); */ static void dumpchr( pchr c, FILE *f) { if (c == '\\') { fprintf(f, "\\\\"); } else if (c > ' ' && c <= '~') { putc((char) c, f); } else { fprintf(f, "\\u%04lx", (long) c); } } /* ^ #endif */ #endif /* ifdef REG_DEBUG */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regc_cvec.c0000644000175000017500000000765514554262142015357 0ustar sergeisergei/* * Utility functions for handling cvecs * This file is #included by regcomp.c. * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Notes: * Only (selected) functions in _this_ file should treat chr* as non-constant. */ /* - newcvec - allocate a new cvec ^ static struct cvec *newcvec(int, int); */ static struct cvec * newcvec( int nchrs, /* to hold this many chrs... */ int nranges) /* ... and this many ranges... */ { size_t nc = (size_t)nchrs + (size_t)nranges*2; size_t n = sizeof(struct cvec) + nc*sizeof(chr); struct cvec *cv = (struct cvec *) MALLOC(n); if (cv == NULL) { return NULL; } cv->chrspace = nchrs; cv->chrs = (chr *)(((char *)cv)+sizeof(struct cvec)); cv->ranges = cv->chrs + nchrs; cv->rangespace = nranges; return clearcvec(cv); } /* - clearcvec - clear a possibly-new cvec * Returns pointer as convenience. ^ static struct cvec *clearcvec(struct cvec *); */ static struct cvec * clearcvec( struct cvec *cv) /* character vector */ { assert(cv != NULL); cv->nchrs = 0; cv->nranges = 0; return cv; } /* - addchr - add a chr to a cvec ^ static void addchr(struct cvec *, pchr); */ static void addchr( struct cvec *cv, /* character vector */ pchr c) /* character to add */ { assert(cv->nchrs < cv->chrspace); cv->chrs[cv->nchrs++] = (chr)c; } /* - addrange - add a range to a cvec ^ static void addrange(struct cvec *, pchr, pchr); */ static void addrange( struct cvec *cv, /* character vector */ pchr from, /* first character of range */ pchr to) /* last character of range */ { assert(cv->nranges < cv->rangespace); cv->ranges[cv->nranges*2] = (chr)from; cv->ranges[cv->nranges*2 + 1] = (chr)to; cv->nranges++; } /* - getcvec - get a cvec, remembering it as v->cv ^ static struct cvec *getcvec(struct vars *, int, int); */ static struct cvec * getcvec( struct vars *v, /* context */ int nchrs, /* to hold this many chrs... */ int nranges) /* ... and this many ranges... */ { if ((v->cv != NULL) && (nchrs <= v->cv->chrspace) && (nranges <= v->cv->rangespace)) { return clearcvec(v->cv); } if (v->cv != NULL) { freecvec(v->cv); } v->cv = newcvec(nchrs, nranges); if (v->cv == NULL) { ERR(REG_ESPACE); } return v->cv; } /* - freecvec - free a cvec ^ static void freecvec(struct cvec *); */ static void freecvec( struct cvec *cv) /* character vector */ { FREE(cv); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regc_lex.c0000644000175000017500000006253714554262142015227 0ustar sergeisergei/* * lexical analyzer * This file is #included by regcomp.c. * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* scanning macros (know about v) */ #define ATEOS() (v->now >= v->stop) #define HAVE(n) (v->stop - v->now >= (n)) #define NEXT1(c) (!ATEOS() && *v->now == CHR(c)) #define NEXT2(a,b) (HAVE(2) && *v->now == CHR(a) && *(v->now+1) == CHR(b)) #define NEXT3(a,b,c) \ (HAVE(3) && *v->now == CHR(a) && \ *(v->now+1) == CHR(b) && \ *(v->now+2) == CHR(c)) #define SET(c) (v->nexttype = (c)) #define SETV(c, n) (v->nexttype = (c), v->nextvalue = (n)) #define RET(c) return (SET(c), 1) #define RETV(c, n) return (SETV(c, n), 1) #define FAILW(e) return (ERR(e), 0) /* ERR does SET(EOS) */ #define LASTTYPE(t) (v->lasttype == (t)) /* lexical contexts */ #define L_ERE 1 /* mainline ERE/ARE */ #define L_BRE 2 /* mainline BRE */ #define L_Q 3 /* REG_QUOTE */ #define L_EBND 4 /* ERE/ARE bound */ #define L_BBND 5 /* BRE bound */ #define L_BRACK 6 /* brackets */ #define L_CEL 7 /* collating element */ #define L_ECL 8 /* equivalence class */ #define L_CCL 9 /* character class */ #define INTOCON(c) (v->lexcon = (c)) #define INCON(con) (v->lexcon == (con)) /* construct pointer past end of chr array */ #define ENDOF(array) ((array) + sizeof(array)/sizeof(chr)) /* - lexstart - set up lexical stuff, scan leading options ^ static void lexstart(struct vars *); */ static void lexstart( struct vars *v) { prefixes(v); /* may turn on new type bits etc. */ NOERR(); if (v->cflags®_QUOTE) { assert(!(v->cflags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE))); INTOCON(L_Q); } else if (v->cflags®_EXTENDED) { assert(!(v->cflags®_QUOTE)); INTOCON(L_ERE); } else { assert(!(v->cflags&(REG_QUOTE|REG_ADVF))); INTOCON(L_BRE); } v->nexttype = EMPTY; /* remember we were at the start */ next(v); /* set up the first token */ } /* - prefixes - implement various special prefixes ^ static void prefixes(struct vars *); */ static void prefixes( struct vars *v) { /* * Literal string doesn't get any of this stuff. */ if (v->cflags®_QUOTE) { return; } /* * Initial "***" gets special things. */ if (HAVE(4) && NEXT3('*', '*', '*')) { switch (*(v->now + 3)) { case CHR('?'): /* "***?" error, msg shows version */ ERR(REG_BADPAT); return; /* proceed no further */ break; case CHR('='): /* "***=" shifts to literal string */ NOTE(REG_UNONPOSIX); v->cflags |= REG_QUOTE; v->cflags &= ~(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE); v->now += 4; return; /* and there can be no more prefixes */ break; case CHR(':'): /* "***:" shifts to AREs */ NOTE(REG_UNONPOSIX); v->cflags |= REG_ADVANCED; v->now += 4; break; default: /* otherwise *** is just an error */ ERR(REG_BADRPT); return; break; } } /* * BREs and EREs don't get embedded options. */ if ((v->cflags®_ADVANCED) != REG_ADVANCED) { return; } /* * Embedded options (AREs only). */ if (HAVE(3) && NEXT2('(', '?') && iscalpha(*(v->now + 2))) { NOTE(REG_UNONPOSIX); v->now += 2; for (; !ATEOS() && iscalpha(*v->now); v->now++) { switch (*v->now) { case CHR('b'): /* BREs (but why???) */ v->cflags &= ~(REG_ADVANCED|REG_QUOTE); break; case CHR('c'): /* case sensitive */ v->cflags &= ~REG_ICASE; break; case CHR('e'): /* plain EREs */ v->cflags |= REG_EXTENDED; v->cflags &= ~(REG_ADVF|REG_QUOTE); break; case CHR('i'): /* case insensitive */ v->cflags |= REG_ICASE; break; case CHR('m'): /* Perloid synonym for n */ case CHR('n'): /* \n affects ^ $ . [^ */ v->cflags |= REG_NEWLINE; break; case CHR('p'): /* ~Perl, \n affects . [^ */ v->cflags |= REG_NLSTOP; v->cflags &= ~REG_NLANCH; break; case CHR('q'): /* literal string */ v->cflags |= REG_QUOTE; v->cflags &= ~REG_ADVANCED; break; case CHR('s'): /* single line, \n ordinary */ v->cflags &= ~REG_NEWLINE; break; case CHR('t'): /* tight syntax */ v->cflags &= ~REG_EXPANDED; break; case CHR('w'): /* weird, \n affects ^ $ only */ v->cflags &= ~REG_NLSTOP; v->cflags |= REG_NLANCH; break; case CHR('x'): /* expanded syntax */ v->cflags |= REG_EXPANDED; break; default: ERR(REG_BADOPT); return; } } if (!NEXT1(')')) { ERR(REG_BADOPT); return; } v->now++; if (v->cflags®_QUOTE) { v->cflags &= ~(REG_EXPANDED|REG_NEWLINE); } } } /* - lexnest - "call a subroutine", interpolating string at the lexical level * Note, this is not a very general facility. There are a number of * implicit assumptions about what sorts of strings can be subroutines. ^ static void lexnest(struct vars *, const chr *, const chr *); */ static void lexnest( struct vars *v, const chr *beginp, /* start of interpolation */ const chr *endp) /* one past end of interpolation */ { assert(v->savenow == NULL); /* only one level of nesting */ v->savenow = v->now; v->savestop = v->stop; v->now = beginp; v->stop = endp; } /* * string constants to interpolate as expansions of things like \d */ static const chr backd[] = { /* \d */ CHR('['), CHR('['), CHR(':'), CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'), CHR(':'), CHR(']'), CHR(']') }; static const chr backD[] = { /* \D */ CHR('['), CHR('^'), CHR('['), CHR(':'), CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'), CHR(':'), CHR(']'), CHR(']') }; static const chr brbackd[] = { /* \d within brackets */ CHR('['), CHR(':'), CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'), CHR(':'), CHR(']') }; static const chr backs[] = { /* \s */ CHR('['), CHR('['), CHR(':'), CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'), CHR(':'), CHR(']'), CHR(']') }; static const chr backS[] = { /* \S */ CHR('['), CHR('^'), CHR('['), CHR(':'), CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'), CHR(':'), CHR(']'), CHR(']') }; static const chr brbacks[] = { /* \s within brackets */ CHR('['), CHR(':'), CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'), CHR(':'), CHR(']') }; #define PUNCT_CONN \ CHR('_'), \ 0x203F /* UNDERTIE */, \ 0x2040 /* CHARACTER TIE */,\ 0x2054 /* INVERTED UNDERTIE */,\ 0xFE33 /* PRESENTATION FORM FOR VERTICAL LOW LINE */, \ 0xFE34 /* PRESENTATION FORM FOR VERTICAL WAVY LOW LINE */, \ 0xFE4D /* DASHED LOW LINE */, \ 0xFE4E /* CENTRELINE LOW LINE */, \ 0xFE4F /* WAVY LOW LINE */, \ 0xFF3F /* FULLWIDTH LOW LINE */ static const chr backw[] = { /* \w */ CHR('['), CHR('['), CHR(':'), CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'), CHR(':'), CHR(']'), PUNCT_CONN, CHR(']') }; static const chr backW[] = { /* \W */ CHR('['), CHR('^'), CHR('['), CHR(':'), CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'), CHR(':'), CHR(']'), PUNCT_CONN, CHR(']') }; static const chr brbackw[] = { /* \w within brackets */ CHR('['), CHR(':'), CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'), CHR(':'), CHR(']'), PUNCT_CONN }; /* - lexword - interpolate a bracket expression for word characters * Possibly ought to inquire whether there is a "word" character class. ^ static void lexword(struct vars *); */ static void lexword( struct vars *v) { lexnest(v, backw, ENDOF(backw)); } /* - next - get next token ^ static int next(struct vars *); */ static int /* 1 normal, 0 failure */ next( struct vars *v) { chr c; /* * Errors yield an infinite sequence of failures. */ if (ISERR()) { return 0; /* the error has set nexttype to EOS */ } /* * Remember flavor of last token. */ v->lasttype = v->nexttype; /* * REG_BOSONLY */ if (v->nexttype == EMPTY && (v->cflags®_BOSONLY)) { /* at start of a REG_BOSONLY RE */ RETV(SBEGIN, 0); /* same as \A */ } /* * If we're nested and we've hit end, return to outer level. */ if (v->savenow != NULL && ATEOS()) { v->now = v->savenow; v->stop = v->savestop; v->savenow = v->savestop = NULL; } /* * Skip white space etc. if appropriate (not in literal or []) */ if (v->cflags®_EXPANDED) { switch (v->lexcon) { case L_ERE: case L_BRE: case L_EBND: case L_BBND: skip(v); break; } } /* * Handle EOS, depending on context. */ if (ATEOS()) { switch (v->lexcon) { case L_ERE: case L_BRE: case L_Q: RET(EOS); break; case L_EBND: case L_BBND: FAILW(REG_EBRACE); break; case L_BRACK: case L_CEL: case L_ECL: case L_CCL: FAILW(REG_EBRACK); break; } assert(NOTREACHED); } /* * Okay, time to actually get a character. */ c = *v->now++; /* * Deal with the easy contexts, punt EREs to code below. */ switch (v->lexcon) { case L_BRE: /* punt BREs to separate function */ return brenext(v, c); break; case L_ERE: /* see below */ break; case L_Q: /* literal strings are easy */ RETV(PLAIN, c); break; case L_BBND: /* bounds are fairly simple */ case L_EBND: switch (c) { case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'): case CHR('9'): RETV(DIGIT, (chr)DIGITVAL(c)); break; case CHR(','): RET(','); break; case CHR('}'): /* ERE bound ends with } */ if (INCON(L_EBND)) { INTOCON(L_ERE); if ((v->cflags®_ADVF) && NEXT1('?')) { v->now++; NOTE(REG_UNONPOSIX); RETV('}', 0); } RETV('}', 1); } else { FAILW(REG_BADBR); } break; case CHR('\\'): /* BRE bound ends with \} */ if (INCON(L_BBND) && NEXT1('}')) { v->now++; INTOCON(L_BRE); RETV('}', 1); } else { FAILW(REG_BADBR); } break; default: FAILW(REG_BADBR); break; } assert(NOTREACHED); break; case L_BRACK: /* brackets are not too hard */ switch (c) { case CHR(']'): if (LASTTYPE('[')) { RETV(PLAIN, c); } else { INTOCON((v->cflags®_EXTENDED) ? L_ERE : L_BRE); RET(']'); } break; case CHR('\\'): NOTE(REG_UBBS); if (!(v->cflags®_ADVF)) { RETV(PLAIN, c); } NOTE(REG_UNONPOSIX); if (ATEOS()) { FAILW(REG_EESCAPE); } (DISCARD)lexescape(v); switch (v->nexttype) { /* not all escapes okay here */ case PLAIN: return 1; break; case CCLASS: switch (v->nextvalue) { case 'd': lexnest(v, brbackd, ENDOF(brbackd)); break; case 's': lexnest(v, brbacks, ENDOF(brbacks)); break; case 'w': lexnest(v, brbackw, ENDOF(brbackw)); break; default: FAILW(REG_EESCAPE); break; } /* * lexnest() done, back up and try again. */ v->nexttype = v->lasttype; return next(v); break; } /* * Not one of the acceptable escapes. */ FAILW(REG_EESCAPE); break; case CHR('-'): if (LASTTYPE('[') || NEXT1(']')) { RETV(PLAIN, c); } else { RETV(RANGE, c); } break; case CHR('['): if (ATEOS()) { FAILW(REG_EBRACK); } switch (*v->now++) { case CHR('.'): INTOCON(L_CEL); /* * Might or might not be locale-specific. */ RET(COLLEL); break; case CHR('='): INTOCON(L_ECL); NOTE(REG_ULOCALE); RET(ECLASS); break; case CHR(':'): INTOCON(L_CCL); NOTE(REG_ULOCALE); RET(CCLASS); break; default: /* oops */ v->now--; RETV(PLAIN, c); break; } assert(NOTREACHED); break; default: RETV(PLAIN, c); break; } assert(NOTREACHED); break; case L_CEL: /* collating elements are easy */ if (c == CHR('.') && NEXT1(']')) { v->now++; INTOCON(L_BRACK); RETV(END, '.'); } else { RETV(PLAIN, c); } break; case L_ECL: /* ditto equivalence classes */ if (c == CHR('=') && NEXT1(']')) { v->now++; INTOCON(L_BRACK); RETV(END, '='); } else { RETV(PLAIN, c); } break; case L_CCL: /* ditto character classes */ if (c == CHR(':') && NEXT1(']')) { v->now++; INTOCON(L_BRACK); RETV(END, ':'); } else { RETV(PLAIN, c); } break; default: assert(NOTREACHED); break; } /* * That got rid of everything except EREs and AREs. */ assert(INCON(L_ERE)); /* * Deal with EREs and AREs, except for backslashes. */ switch (c) { case CHR('|'): RET('|'); break; case CHR('*'): if ((v->cflags®_ADVF) && NEXT1('?')) { v->now++; NOTE(REG_UNONPOSIX); RETV('*', 0); } RETV('*', 1); break; case CHR('+'): if ((v->cflags®_ADVF) && NEXT1('?')) { v->now++; NOTE(REG_UNONPOSIX); RETV('+', 0); } RETV('+', 1); break; case CHR('?'): if ((v->cflags®_ADVF) && NEXT1('?')) { v->now++; NOTE(REG_UNONPOSIX); RETV('?', 0); } RETV('?', 1); break; case CHR('{'): /* bounds start or plain character */ if (v->cflags®_EXPANDED) { skip(v); } if (ATEOS() || !iscdigit(*v->now)) { NOTE(REG_UBRACES); NOTE(REG_UUNSPEC); RETV(PLAIN, c); } else { NOTE(REG_UBOUNDS); INTOCON(L_EBND); RET('{'); } assert(NOTREACHED); break; case CHR('('): /* parenthesis, or advanced extension */ if ((v->cflags®_ADVF) && NEXT1('?')) { NOTE(REG_UNONPOSIX); v->now++; switch (*v->now++) { case CHR(':'): /* non-capturing paren */ RETV('(', 0); break; case CHR('#'): /* comment */ while (!ATEOS() && *v->now != CHR(')')) { v->now++; } if (!ATEOS()) { v->now++; } assert(v->nexttype == v->lasttype); return next(v); break; case CHR('='): /* positive lookahead */ NOTE(REG_ULOOKAHEAD); RETV(LACON, 1); break; case CHR('!'): /* negative lookahead */ NOTE(REG_ULOOKAHEAD); RETV(LACON, 0); break; default: FAILW(REG_BADRPT); break; } assert(NOTREACHED); } if (v->cflags®_NOSUB) { RETV('(', 0); /* all parens non-capturing */ } else { RETV('(', 1); } break; case CHR(')'): if (LASTTYPE('(')) { NOTE(REG_UUNSPEC); } RETV(')', c); break; case CHR('['): /* easy except for [[:<:]] and [[:>:]] */ if (HAVE(6) && *(v->now+0) == CHR('[') && *(v->now+1) == CHR(':') && (*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) && *(v->now+3) == CHR(':') && *(v->now+4) == CHR(']') && *(v->now+5) == CHR(']')) { c = *(v->now+2); v->now += 6; NOTE(REG_UNONPOSIX); RET((c == CHR('<')) ? '<' : '>'); } INTOCON(L_BRACK); if (NEXT1('^')) { v->now++; RETV('[', 0); } RETV('[', 1); break; case CHR('.'): RET('.'); break; case CHR('^'): RET('^'); break; case CHR('$'): RET('$'); break; case CHR('\\'): /* mostly punt backslashes to code below */ if (ATEOS()) { FAILW(REG_EESCAPE); } break; default: /* ordinary character */ RETV(PLAIN, c); break; } /* * ERE/ARE backslash handling; backslash already eaten. */ assert(!ATEOS()); if (!(v->cflags®_ADVF)) {/* only AREs have non-trivial escapes */ if (iscalnum(*v->now)) { NOTE(REG_UBSALNUM); NOTE(REG_UUNSPEC); } RETV(PLAIN, *v->now++); } (DISCARD)lexescape(v); if (ISERR()) { FAILW(REG_EESCAPE); } if (v->nexttype == CCLASS) {/* fudge at lexical level */ switch (v->nextvalue) { case 'd': lexnest(v, backd, ENDOF(backd)); break; case 'D': lexnest(v, backD, ENDOF(backD)); break; case 's': lexnest(v, backs, ENDOF(backs)); break; case 'S': lexnest(v, backS, ENDOF(backS)); break; case 'w': lexnest(v, backw, ENDOF(backw)); break; case 'W': lexnest(v, backW, ENDOF(backW)); break; default: assert(NOTREACHED); FAILW(REG_ASSERT); break; } /* lexnest done, back up and try again */ v->nexttype = v->lasttype; return next(v); } /* * Otherwise, lexescape has already done the work. */ return !ISERR(); } /* - lexescape - parse an ARE backslash escape (backslash already eaten) * Note slightly nonstandard use of the CCLASS type code. ^ static int lexescape(struct vars *); */ static int /* not actually used, but convenient for RETV */ lexescape( struct vars *v) { chr c; int i; static const chr alert[] = { CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t') }; static const chr esc[] = { CHR('E'), CHR('S'), CHR('C') }; const chr *save; assert(v->cflags®_ADVF); assert(!ATEOS()); c = *v->now++; if (!iscalnum(c)) { RETV(PLAIN, c); } NOTE(REG_UNONPOSIX); switch (c) { case CHR('a'): RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\007'))); break; case CHR('A'): RETV(SBEGIN, 0); break; case CHR('b'): RETV(PLAIN, CHR('\b')); break; case CHR('B'): RETV(PLAIN, CHR('\\')); break; case CHR('c'): NOTE(REG_UUNPORT); if (ATEOS()) { FAILW(REG_EESCAPE); } RETV(PLAIN, (chr)(*v->now++ & 037)); break; case CHR('d'): NOTE(REG_ULOCALE); RETV(CCLASS, 'd'); break; case CHR('D'): NOTE(REG_ULOCALE); RETV(CCLASS, 'D'); break; case CHR('e'): NOTE(REG_UUNPORT); RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\033'))); break; case CHR('f'): RETV(PLAIN, CHR('\f')); break; case CHR('m'): RET('<'); break; case CHR('M'): RET('>'); break; case CHR('n'): RETV(PLAIN, CHR('\n')); break; case CHR('r'): RETV(PLAIN, CHR('\r')); break; case CHR('s'): NOTE(REG_ULOCALE); RETV(CCLASS, 's'); break; case CHR('S'): NOTE(REG_ULOCALE); RETV(CCLASS, 'S'); break; case CHR('t'): RETV(PLAIN, CHR('\t')); break; case CHR('u'): c = (uchr) lexdigits(v, 16, 1, 4); if (ISERR()) { FAILW(REG_EESCAPE); } RETV(PLAIN, c); break; case CHR('U'): i = lexdigits(v, 16, 1, 8); if (ISERR()) { FAILW(REG_EESCAPE); } if (i > 0xFFFF) { /* TODO: output a Surrogate pair */ i = 0xFFFD; } RETV(PLAIN, (uchr) i); break; case CHR('v'): RETV(PLAIN, CHR('\v')); break; case CHR('w'): NOTE(REG_ULOCALE); RETV(CCLASS, 'w'); break; case CHR('W'): NOTE(REG_ULOCALE); RETV(CCLASS, 'W'); break; case CHR('x'): NOTE(REG_UUNPORT); c = (uchr) lexdigits(v, 16, 1, 2); if (ISERR()) { FAILW(REG_EESCAPE); } RETV(PLAIN, c); break; case CHR('y'): NOTE(REG_ULOCALE); RETV(WBDRY, 0); break; case CHR('Y'): NOTE(REG_ULOCALE); RETV(NWBDRY, 0); break; case CHR('Z'): RETV(SEND, 0); break; case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'): case CHR('9'): save = v->now; v->now--; /* put first digit back */ c = (uchr) lexdigits(v, 10, 1, 255); /* REs >255 long outside spec */ if (ISERR()) { FAILW(REG_EESCAPE); } /* * Ugly heuristic (first test is "exactly 1 digit?") */ if (v->now - save == 0 || ((int) c > 0 && (int)c <= v->nsubexp)) { NOTE(REG_UBACKREF); RETV(BACKREF, (chr)c); } /* * Oops, doesn't look like it's a backref after all... */ v->now = save; /* FALLTHRU */ case CHR('0'): NOTE(REG_UUNPORT); v->now--; /* put first digit back */ c = (uchr) lexdigits(v, 8, 1, 3); if (ISERR()) { FAILW(REG_EESCAPE); } if (c > 0xFF) { /* out of range, so we handled one digit too much */ v->now--; c >>= 3; } RETV(PLAIN, c); break; default: assert(iscalpha(c)); FAILW(REG_EESCAPE); /* unknown alphabetic escape */ break; } assert(NOTREACHED); } /* - lexdigits - slurp up digits and return chr value ^ static int lexdigits(struct vars *, int, int, int); */ static int /* chr value; errors signalled via ERR */ lexdigits( struct vars *v, int base, int minlen, int maxlen) { int n; int len; chr c; int d; const uchr ub = (uchr) base; n = 0; for (len = 0; len < maxlen && !ATEOS(); len++) { if (n > 0x10FFF) { /* Stop when continuing would otherwise overflow */ break; } c = *v->now++; switch (c) { case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'): case CHR('9'): d = DIGITVAL(c); break; case CHR('a'): case CHR('A'): d = 10; break; case CHR('b'): case CHR('B'): d = 11; break; case CHR('c'): case CHR('C'): d = 12; break; case CHR('d'): case CHR('D'): d = 13; break; case CHR('e'): case CHR('E'): d = 14; break; case CHR('f'): case CHR('F'): d = 15; break; default: v->now--; /* oops, not a digit at all */ d = -1; break; } if (d >= base) { /* not a plausible digit */ v->now--; d = -1; } if (d < 0) { break; /* NOTE BREAK OUT */ } n = n*ub + (uchr)d; } if (len < minlen) { ERR(REG_EESCAPE); } return n; } /* - brenext - get next BRE token * This is much like EREs except for all the stupid backslashes and the * context-dependency of some things. ^ static int brenext(struct vars *, pchr); */ static int /* 1 normal, 0 failure */ brenext( struct vars *v, pchr pc) { chr c = (chr)pc; switch (c) { case CHR('*'): if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) { RETV(PLAIN, c); } RETV('*', 1); break; case CHR('['): if (HAVE(6) && *(v->now+0) == CHR('[') && *(v->now+1) == CHR(':') && (*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) && *(v->now+3) == CHR(':') && *(v->now+4) == CHR(']') && *(v->now+5) == CHR(']')) { c = *(v->now+2); v->now += 6; NOTE(REG_UNONPOSIX); RET((c == CHR('<')) ? '<' : '>'); } INTOCON(L_BRACK); if (NEXT1('^')) { v->now++; RETV('[', 0); } RETV('[', 1); break; case CHR('.'): RET('.'); break; case CHR('^'): if (LASTTYPE(EMPTY)) { RET('^'); } if (LASTTYPE('(')) { NOTE(REG_UUNSPEC); RET('^'); } RETV(PLAIN, c); break; case CHR('$'): if (v->cflags®_EXPANDED) { skip(v); } if (ATEOS()) { RET('$'); } if (NEXT2('\\', ')')) { NOTE(REG_UUNSPEC); RET('$'); } RETV(PLAIN, c); break; case CHR('\\'): break; /* see below */ default: RETV(PLAIN, c); break; } assert(c == CHR('\\')); if (ATEOS()) { FAILW(REG_EESCAPE); } c = *v->now++; switch (c) { case CHR('{'): INTOCON(L_BBND); NOTE(REG_UBOUNDS); RET('{'); break; case CHR('('): RETV('(', 1); break; case CHR(')'): RETV(')', c); break; case CHR('<'): NOTE(REG_UNONPOSIX); RET('<'); break; case CHR('>'): NOTE(REG_UNONPOSIX); RET('>'); break; case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'): case CHR('9'): NOTE(REG_UBACKREF); RETV(BACKREF, (chr)DIGITVAL(c)); break; default: if (iscalnum(c)) { NOTE(REG_UBSALNUM); NOTE(REG_UUNSPEC); } RETV(PLAIN, c); break; } assert(NOTREACHED); } /* - skip - skip white space and comments in expanded form ^ static void skip(struct vars *); */ static void skip( struct vars *v) { const chr *start = v->now; assert(v->cflags®_EXPANDED); for (;;) { while (!ATEOS() && iscspace(*v->now)) { v->now++; } if (ATEOS() || *v->now != CHR('#')) { break; /* NOTE BREAK OUT */ } assert(NEXT1('#')); while (!ATEOS() && *v->now != CHR('\n')) { v->now++; } /* * Leave the newline to be picked up by the iscspace loop. */ } if (v->now != start) { NOTE(REG_UNONPOSIX); } } /* - newline - return the chr for a newline * This helps confine use of CHR to this source file. ^ static chr newline(NOPARMS); */ static chr newline(void) { return CHR('\n'); } /* - chrnamed - return the chr known by a given (chr string) name * The code is a bit clumsy, but this routine gets only such specialized * use that it hardly matters. ^ static chr chrnamed(struct vars *, const chr *, const chr *, pchr); */ static chr chrnamed( struct vars *v, const chr *startp, /* start of name */ const chr *endp, /* just past end of name */ pchr lastresort) /* what to return if name lookup fails */ { celt c; int errsave; int e; struct cvec *cv; errsave = v->err; v->err = 0; c = element(v, startp, endp); e = v->err; v->err = errsave; if (e != 0) { return (chr)lastresort; } cv = range(v, c, c, 0); if (cv->nchrs == 0) { return (chr)lastresort; } return cv->chrs[0]; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regc_locale.c0000644000175000017500000016165214554263074015701 0ustar sergeisergei/* * regc_locale.c -- * * This file contains the Unicode locale specific regexp routines. * This file is #included by regcomp.c. * * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* ASCII character-name table */ static const struct cname { const char *name; const char code; } cnames[] = { {"NUL", '\0'}, {"SOH", '\001'}, {"STX", '\002'}, {"ETX", '\003'}, {"EOT", '\004'}, {"ENQ", '\005'}, {"ACK", '\006'}, {"BEL", '\007'}, {"alert", '\007'}, {"BS", '\010'}, {"backspace", '\b'}, {"HT", '\011'}, {"tab", '\t'}, {"LF", '\012'}, {"newline", '\n'}, {"VT", '\013'}, {"vertical-tab", '\v'}, {"FF", '\014'}, {"form-feed", '\f'}, {"CR", '\015'}, {"carriage-return", '\r'}, {"SO", '\016'}, {"SI", '\017'}, {"DLE", '\020'}, {"DC1", '\021'}, {"DC2", '\022'}, {"DC3", '\023'}, {"DC4", '\024'}, {"NAK", '\025'}, {"SYN", '\026'}, {"ETB", '\027'}, {"CAN", '\030'}, {"EM", '\031'}, {"SUB", '\032'}, {"ESC", '\033'}, {"IS4", '\034'}, {"FS", '\034'}, {"IS3", '\035'}, {"GS", '\035'}, {"IS2", '\036'}, {"RS", '\036'}, {"IS1", '\037'}, {"US", '\037'}, {"space", ' '}, {"exclamation-mark",'!'}, {"quotation-mark", '"'}, {"number-sign", '#'}, {"dollar-sign", '$'}, {"percent-sign", '%'}, {"ampersand", '&'}, {"apostrophe", '\''}, {"left-parenthesis",'('}, {"right-parenthesis", ')'}, {"asterisk", '*'}, {"plus-sign", '+'}, {"comma", ','}, {"hyphen", '-'}, {"hyphen-minus", '-'}, {"period", '.'}, {"full-stop", '.'}, {"slash", '/'}, {"solidus", '/'}, {"zero", '0'}, {"one", '1'}, {"two", '2'}, {"three", '3'}, {"four", '4'}, {"five", '5'}, {"six", '6'}, {"seven", '7'}, {"eight", '8'}, {"nine", '9'}, {"colon", ':'}, {"semicolon", ';'}, {"less-than-sign", '<'}, {"equals-sign", '='}, {"greater-than-sign", '>'}, {"question-mark", '?'}, {"commercial-at", '@'}, {"left-square-bracket", '['}, {"backslash", '\\'}, {"reverse-solidus", '\\'}, {"right-square-bracket", ']'}, {"circumflex", '^'}, {"circumflex-accent", '^'}, {"underscore", '_'}, {"low-line", '_'}, {"grave-accent", '`'}, {"left-brace", '{'}, {"left-curly-bracket", '{'}, {"vertical-line", '|'}, {"right-brace", '}'}, {"right-curly-bracket", '}'}, {"tilde", '~'}, {"DEL", '\177'}, {NULL, 0} }; /* * Unicode character-class tables. */ typedef struct { chr start; chr end; } crange; /* * Declarations of Unicode character ranges. This code * is automatically generated by the tools/uniClass.tcl script * and used in generic/regc_locale.c. Do not modify by hand. */ /* * Unicode: alphabetic characters. */ static const crange alphaRangeTable[] = { {0x41, 0x5A}, {0x61, 0x7A}, {0xC0, 0xD6}, {0xD8, 0xF6}, {0xF8, 0x2C1}, {0x2C6, 0x2D1}, {0x2E0, 0x2E4}, {0x370, 0x374}, {0x37A, 0x37D}, {0x388, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x3F5}, {0x3F7, 0x481}, {0x48A, 0x52F}, {0x531, 0x556}, {0x560, 0x588}, {0x5D0, 0x5EA}, {0x5EF, 0x5F2}, {0x620, 0x64A}, {0x671, 0x6D3}, {0x6FA, 0x6FC}, {0x712, 0x72F}, {0x74D, 0x7A5}, {0x7CA, 0x7EA}, {0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86A}, {0x870, 0x887}, {0x889, 0x88E}, {0x8A0, 0x8C9}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98C}, {0x993, 0x9A8}, {0x9AA, 0x9B0}, {0x9B6, 0x9B9}, {0x9DF, 0x9E1}, {0xA05, 0xA0A}, {0xA13, 0xA28}, {0xA2A, 0xA30}, {0xA59, 0xA5C}, {0xA72, 0xA74}, {0xA85, 0xA8D}, {0xA8F, 0xA91}, {0xA93, 0xAA8}, {0xAAA, 0xAB0}, {0xAB5, 0xAB9}, {0xB05, 0xB0C}, {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39}, {0xB5F, 0xB61}, {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95}, {0xBA8, 0xBAA}, {0xBAE, 0xBB9}, {0xC05, 0xC0C}, {0xC0E, 0xC10}, {0xC12, 0xC28}, {0xC2A, 0xC39}, {0xC58, 0xC5A}, {0xC85, 0xC8C}, {0xC8E, 0xC90}, {0xC92, 0xCA8}, {0xCAA, 0xCB3}, {0xCB5, 0xCB9}, {0xD04, 0xD0C}, {0xD0E, 0xD10}, {0xD12, 0xD3A}, {0xD54, 0xD56}, {0xD5F, 0xD61}, {0xD7A, 0xD7F}, {0xD85, 0xD96}, {0xD9A, 0xDB1}, {0xDB3, 0xDBB}, {0xDC0, 0xDC6}, {0xE01, 0xE30}, {0xE40, 0xE46}, {0xE86, 0xE8A}, {0xE8C, 0xEA3}, {0xEA7, 0xEB0}, {0xEC0, 0xEC4}, {0xEDC, 0xEDF}, {0xF40, 0xF47}, {0xF49, 0xF6C}, {0xF88, 0xF8C}, {0x1000, 0x102A}, {0x1050, 0x1055}, {0x105A, 0x105D}, {0x106E, 0x1070}, {0x1075, 0x1081}, {0x10A0, 0x10C5}, {0x10D0, 0x10FA}, {0x10FC, 0x1248}, {0x124A, 0x124D}, {0x1250, 0x1256}, {0x125A, 0x125D}, {0x1260, 0x1288}, {0x128A, 0x128D}, {0x1290, 0x12B0}, {0x12B2, 0x12B5}, {0x12B8, 0x12BE}, {0x12C2, 0x12C5}, {0x12C8, 0x12D6}, {0x12D8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135A}, {0x1380, 0x138F}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD}, {0x1401, 0x166C}, {0x166F, 0x167F}, {0x1681, 0x169A}, {0x16A0, 0x16EA}, {0x16F1, 0x16F8}, {0x1700, 0x1711}, {0x171F, 0x1731}, {0x1740, 0x1751}, {0x1760, 0x176C}, {0x176E, 0x1770}, {0x1780, 0x17B3}, {0x1820, 0x1878}, {0x1880, 0x1884}, {0x1887, 0x18A8}, {0x18B0, 0x18F5}, {0x1900, 0x191E}, {0x1950, 0x196D}, {0x1970, 0x1974}, {0x1980, 0x19AB}, {0x19B0, 0x19C9}, {0x1A00, 0x1A16}, {0x1A20, 0x1A54}, {0x1B05, 0x1B33}, {0x1B45, 0x1B4C}, {0x1B83, 0x1BA0}, {0x1BBA, 0x1BE5}, {0x1C00, 0x1C23}, {0x1C4D, 0x1C4F}, {0x1C5A, 0x1C7D}, {0x1C80, 0x1C88}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CBF}, {0x1CE9, 0x1CEC}, {0x1CEE, 0x1CF3}, {0x1D00, 0x1DBF}, {0x1E00, 0x1F15}, {0x1F18, 0x1F1D}, {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57}, {0x1F5F, 0x1F7D}, {0x1F80, 0x1FB4}, {0x1FB6, 0x1FBC}, {0x1FC2, 0x1FC4}, {0x1FC6, 0x1FCC}, {0x1FD0, 0x1FD3}, {0x1FD6, 0x1FDB}, {0x1FE0, 0x1FEC}, {0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFC}, {0x2090, 0x209C}, {0x210A, 0x2113}, {0x2119, 0x211D}, {0x212A, 0x212D}, {0x212F, 0x2139}, {0x213C, 0x213F}, {0x2145, 0x2149}, {0x2C00, 0x2CE4}, {0x2CEB, 0x2CEE}, {0x2D00, 0x2D25}, {0x2D30, 0x2D67}, {0x2D80, 0x2D96}, {0x2DA0, 0x2DA6}, {0x2DA8, 0x2DAE}, {0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE}, {0x2DC0, 0x2DC6}, {0x2DC8, 0x2DCE}, {0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE}, {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309D, 0x309F}, {0x30A1, 0x30FA}, {0x30FC, 0x30FF}, {0x3105, 0x312F}, {0x3131, 0x318E}, {0x31A0, 0x31BF}, {0x31F0, 0x31FF}, {0x3400, 0x4DBF}, {0x4E00, 0xA48C}, {0xA4D0, 0xA4FD}, {0xA500, 0xA60C}, {0xA610, 0xA61F}, {0xA640, 0xA66E}, {0xA67F, 0xA69D}, {0xA6A0, 0xA6E5}, {0xA717, 0xA71F}, {0xA722, 0xA788}, {0xA78B, 0xA7CA}, {0xA7D5, 0xA7D9}, {0xA7F2, 0xA801}, {0xA803, 0xA805}, {0xA807, 0xA80A}, {0xA80C, 0xA822}, {0xA840, 0xA873}, {0xA882, 0xA8B3}, {0xA8F2, 0xA8F7}, {0xA90A, 0xA925}, {0xA930, 0xA946}, {0xA960, 0xA97C}, {0xA984, 0xA9B2}, {0xA9E0, 0xA9E4}, {0xA9E6, 0xA9EF}, {0xA9FA, 0xA9FE}, {0xAA00, 0xAA28}, {0xAA40, 0xAA42}, {0xAA44, 0xAA4B}, {0xAA60, 0xAA76}, {0xAA7E, 0xAAAF}, {0xAAB9, 0xAABD}, {0xAADB, 0xAADD}, {0xAAE0, 0xAAEA}, {0xAAF2, 0xAAF4}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E}, {0xAB11, 0xAB16}, {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB5A}, {0xAB5C, 0xAB69}, {0xAB70, 0xABE2}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6}, {0xD7CB, 0xD7FB}, {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17}, {0xFB1F, 0xFB28}, {0xFB2A, 0xFB36}, {0xFB38, 0xFB3C}, {0xFB46, 0xFBB1}, {0xFBD3, 0xFD3D}, {0xFD50, 0xFD8F}, {0xFD92, 0xFDC7}, {0xFDF0, 0xFDFB}, {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF21, 0xFF3A}, {0xFF41, 0xFF5A}, {0xFF66, 0xFFBE}, {0xFFC2, 0xFFC7}, {0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7}, {0xFFDA, 0xFFDC} #if CHRBITS > 16 ,{0x10000, 0x1000B}, {0x1000D, 0x10026}, {0x10028, 0x1003A}, {0x1003F, 0x1004D}, {0x10050, 0x1005D}, {0x10080, 0x100FA}, {0x10280, 0x1029C}, {0x102A0, 0x102D0}, {0x10300, 0x1031F}, {0x1032D, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375}, {0x10380, 0x1039D}, {0x103A0, 0x103C3}, {0x103C8, 0x103CF}, {0x10400, 0x1049D}, {0x104B0, 0x104D3}, {0x104D8, 0x104FB}, {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10570, 0x1057A}, {0x1057C, 0x1058A}, {0x1058C, 0x10592}, {0x10597, 0x105A1}, {0x105A3, 0x105B1}, {0x105B3, 0x105B9}, {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10780, 0x10785}, {0x10787, 0x107B0}, {0x107B2, 0x107BA}, {0x10800, 0x10805}, {0x1080A, 0x10835}, {0x1083F, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089E}, {0x108E0, 0x108F2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109B7}, {0x10A10, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35}, {0x10A60, 0x10A7C}, {0x10A80, 0x10A9C}, {0x10AC0, 0x10AC7}, {0x10AC9, 0x10AE4}, {0x10B00, 0x10B35}, {0x10B40, 0x10B55}, {0x10B60, 0x10B72}, {0x10B80, 0x10B91}, {0x10C00, 0x10C48}, {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10D00, 0x10D23}, {0x10E80, 0x10EA9}, {0x10F00, 0x10F1C}, {0x10F30, 0x10F45}, {0x10F70, 0x10F81}, {0x10FB0, 0x10FC4}, {0x10FE0, 0x10FF6}, {0x11003, 0x11037}, {0x11083, 0x110AF}, {0x110D0, 0x110E8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111B2}, {0x111C1, 0x111C4}, {0x11200, 0x11211}, {0x11213, 0x1122B}, {0x11280, 0x11286}, {0x1128A, 0x1128D}, {0x1128F, 0x1129D}, {0x1129F, 0x112A8}, {0x112B0, 0x112DE}, {0x11305, 0x1130C}, {0x11313, 0x11328}, {0x1132A, 0x11330}, {0x11335, 0x11339}, {0x1135D, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144A}, {0x1145F, 0x11461}, {0x11480, 0x114AF}, {0x11580, 0x115AE}, {0x115D8, 0x115DB}, {0x11600, 0x1162F}, {0x11680, 0x116AA}, {0x11700, 0x1171A}, {0x11740, 0x11746}, {0x11800, 0x1182B}, {0x118A0, 0x118DF}, {0x118FF, 0x11906}, {0x1190C, 0x11913}, {0x11918, 0x1192F}, {0x119A0, 0x119A7}, {0x119AA, 0x119D0}, {0x11A0B, 0x11A32}, {0x11A5C, 0x11A89}, {0x11AB0, 0x11AF8}, {0x11C00, 0x11C08}, {0x11C0A, 0x11C2E}, {0x11C72, 0x11C8F}, {0x11D00, 0x11D06}, {0x11D0B, 0x11D30}, {0x11D60, 0x11D65}, {0x11D6A, 0x11D89}, {0x11EE0, 0x11EF2}, {0x11F04, 0x11F10}, {0x11F12, 0x11F33}, {0x12000, 0x12399}, {0x12480, 0x12543}, {0x12F90, 0x12FF0}, {0x13000, 0x1342F}, {0x13441, 0x13446}, {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E}, {0x16A70, 0x16ABE}, {0x16AD0, 0x16AED}, {0x16B00, 0x16B2F}, {0x16B40, 0x16B43}, {0x16B63, 0x16B77}, {0x16B7D, 0x16B8F}, {0x16E40, 0x16E7F}, {0x16F00, 0x16F4A}, {0x16F93, 0x16F9F}, {0x17000, 0x187F7}, {0x18800, 0x18CD5}, {0x18D00, 0x18D08}, {0x1AFF0, 0x1AFF3}, {0x1AFF5, 0x1AFFB}, {0x1B000, 0x1B122}, {0x1B150, 0x1B152}, {0x1B164, 0x1B167}, {0x1B170, 0x1B2FB}, {0x1BC00, 0x1BC6A}, {0x1BC70, 0x1BC7C}, {0x1BC80, 0x1BC88}, {0x1BC90, 0x1BC99}, {0x1D400, 0x1D454}, {0x1D456, 0x1D49C}, {0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D505}, {0x1D507, 0x1D50A}, {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D51E, 0x1D539}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550}, {0x1D552, 0x1D6A5}, {0x1D6A8, 0x1D6C0}, {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6FA}, {0x1D6FC, 0x1D714}, {0x1D716, 0x1D734}, {0x1D736, 0x1D74E}, {0x1D750, 0x1D76E}, {0x1D770, 0x1D788}, {0x1D78A, 0x1D7A8}, {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7CB}, {0x1DF00, 0x1DF1E}, {0x1DF25, 0x1DF2A}, {0x1E030, 0x1E06D}, {0x1E100, 0x1E12C}, {0x1E137, 0x1E13D}, {0x1E290, 0x1E2AD}, {0x1E2C0, 0x1E2EB}, {0x1E4D0, 0x1E4EB}, {0x1E7E0, 0x1E7E6}, {0x1E7E8, 0x1E7EB}, {0x1E7F0, 0x1E7FE}, {0x1E800, 0x1E8C4}, {0x1E900, 0x1E943}, {0x1EE00, 0x1EE03}, {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32}, {0x1EE34, 0x1EE37}, {0x1EE4D, 0x1EE4F}, {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72}, {0x1EE74, 0x1EE77}, {0x1EE79, 0x1EE7C}, {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B}, {0x1EEA1, 0x1EEA3}, {0x1EEA5, 0x1EEA9}, {0x1EEAB, 0x1EEBB}, {0x20000, 0x2A6DF}, {0x2A700, 0x2B739}, {0x2B740, 0x2B81D}, {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0}, {0x2EBF0, 0x2EE5D}, {0x2F800, 0x2FA1D}, {0x30000, 0x3134A}, {0x31350, 0x323AF} #endif }; #define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange)) static const chr alphaCharTable[] = { 0xAA, 0xB5, 0xBA, 0x2EC, 0x2EE, 0x376, 0x377, 0x37F, 0x386, 0x38C, 0x559, 0x66E, 0x66F, 0x6D5, 0x6E5, 0x6E6, 0x6EE, 0x6EF, 0x6FF, 0x710, 0x7B1, 0x7F4, 0x7F5, 0x7FA, 0x81A, 0x824, 0x828, 0x93D, 0x950, 0x98F, 0x990, 0x9B2, 0x9BD, 0x9CE, 0x9DC, 0x9DD, 0x9F0, 0x9F1, 0x9FC, 0xA0F, 0xA10, 0xA32, 0xA33, 0xA35, 0xA36, 0xA38, 0xA39, 0xA5E, 0xAB2, 0xAB3, 0xABD, 0xAD0, 0xAE0, 0xAE1, 0xAF9, 0xB0F, 0xB10, 0xB32, 0xB33, 0xB3D, 0xB5C, 0xB5D, 0xB71, 0xB83, 0xB99, 0xB9A, 0xB9C, 0xB9E, 0xB9F, 0xBA3, 0xBA4, 0xBD0, 0xC3D, 0xC5D, 0xC60, 0xC61, 0xC80, 0xCBD, 0xCDD, 0xCDE, 0xCE0, 0xCE1, 0xCF1, 0xCF2, 0xD3D, 0xD4E, 0xDBD, 0xE32, 0xE33, 0xE81, 0xE82, 0xE84, 0xEA5, 0xEB2, 0xEB3, 0xEBD, 0xEC6, 0xF00, 0x103F, 0x1061, 0x1065, 0x1066, 0x108E, 0x10C7, 0x10CD, 0x1258, 0x12C0, 0x17D7, 0x17DC, 0x18AA, 0x1AA7, 0x1BAE, 0x1BAF, 0x1CF5, 0x1CF6, 0x1CFA, 0x1F59, 0x1F5B, 0x1F5D, 0x1FBE, 0x2071, 0x207F, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214E, 0x2183, 0x2184, 0x2CF2, 0x2CF3, 0x2D27, 0x2D2D, 0x2D6F, 0x2E2F, 0x3005, 0x3006, 0x303B, 0x303C, 0xA62A, 0xA62B, 0xA7D0, 0xA7D1, 0xA7D3, 0xA8FB, 0xA8FD, 0xA8FE, 0xA9CF, 0xAA7A, 0xAAB1, 0xAAB5, 0xAAB6, 0xAAC0, 0xAAC2, 0xFB1D, 0xFB3E, 0xFB40, 0xFB41, 0xFB43, 0xFB44 #if CHRBITS > 16 ,0x1003C, 0x1003D, 0x10594, 0x10595, 0x105BB, 0x105BC, 0x10808, 0x10837, 0x10838, 0x1083C, 0x108F4, 0x108F5, 0x109BE, 0x109BF, 0x10A00, 0x10EB0, 0x10EB1, 0x10F27, 0x11071, 0x11072, 0x11075, 0x11144, 0x11147, 0x11176, 0x111DA, 0x111DC, 0x1123F, 0x11240, 0x11288, 0x1130F, 0x11310, 0x11332, 0x11333, 0x1133D, 0x11350, 0x114C4, 0x114C5, 0x114C7, 0x11644, 0x116B8, 0x11909, 0x11915, 0x11916, 0x1193F, 0x11941, 0x119E1, 0x119E3, 0x11A00, 0x11A3A, 0x11A50, 0x11A9D, 0x11C40, 0x11D08, 0x11D09, 0x11D46, 0x11D67, 0x11D68, 0x11D98, 0x11F02, 0x11FB0, 0x16F50, 0x16FE0, 0x16FE1, 0x16FE3, 0x1AFFD, 0x1AFFE, 0x1B132, 0x1B155, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB, 0x1D546, 0x1E14E, 0x1E7ED, 0x1E7EE, 0x1E94B, 0x1EE21, 0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, 0x1EE42, 0x1EE47, 0x1EE49, 0x1EE4B, 0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, 0x1EE5B, 0x1EE5D, 0x1EE5F, 0x1EE61, 0x1EE62, 0x1EE64, 0x1EE7E #endif }; #define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr)) /* * Unicode: control characters. */ static const crange controlRangeTable[] = { {0x0, 0x1F}, {0x7F, 0x9F}, {0x600, 0x605}, {0x200B, 0x200F}, {0x202A, 0x202E}, {0x2060, 0x2064}, {0x2066, 0x206F}, {0xE000, 0xF8FF}, {0xFFF9, 0xFFFB} #if CHRBITS > 16 ,{0x13430, 0x1343F}, {0x1BCA0, 0x1BCA3}, {0x1D173, 0x1D17A}, {0xE0020, 0xE007F} #endif }; #define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange)) static const chr controlCharTable[] = { 0xAD, 0x61C, 0x6DD, 0x70F, 0x890, 0x891, 0x8E2, 0x180E, 0xFEFF #if CHRBITS > 16 ,0x110BD, 0x110CD, 0xE0001 #endif }; #define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr)) /* * Unicode: decimal digit characters. */ static const crange digitRangeTable[] = { {0x30, 0x39}, {0x660, 0x669}, {0x6F0, 0x6F9}, {0x7C0, 0x7C9}, {0x966, 0x96F}, {0x9E6, 0x9EF}, {0xA66, 0xA6F}, {0xAE6, 0xAEF}, {0xB66, 0xB6F}, {0xBE6, 0xBEF}, {0xC66, 0xC6F}, {0xCE6, 0xCEF}, {0xD66, 0xD6F}, {0xDE6, 0xDEF}, {0xE50, 0xE59}, {0xED0, 0xED9}, {0xF20, 0xF29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17E0, 0x17E9}, {0x1810, 0x1819}, {0x1946, 0x194F}, {0x19D0, 0x19D9}, {0x1A80, 0x1A89}, {0x1A90, 0x1A99}, {0x1B50, 0x1B59}, {0x1BB0, 0x1BB9}, {0x1C40, 0x1C49}, {0x1C50, 0x1C59}, {0xA620, 0xA629}, {0xA8D0, 0xA8D9}, {0xA900, 0xA909}, {0xA9D0, 0xA9D9}, {0xA9F0, 0xA9F9}, {0xAA50, 0xAA59}, {0xABF0, 0xABF9}, {0xFF10, 0xFF19} #if CHRBITS > 16 ,{0x104A0, 0x104A9}, {0x10D30, 0x10D39}, {0x11066, 0x1106F}, {0x110F0, 0x110F9}, {0x11136, 0x1113F}, {0x111D0, 0x111D9}, {0x112F0, 0x112F9}, {0x11450, 0x11459}, {0x114D0, 0x114D9}, {0x11650, 0x11659}, {0x116C0, 0x116C9}, {0x11730, 0x11739}, {0x118E0, 0x118E9}, {0x11950, 0x11959}, {0x11C50, 0x11C59}, {0x11D50, 0x11D59}, {0x11DA0, 0x11DA9}, {0x11F50, 0x11F59}, {0x16A60, 0x16A69}, {0x16AC0, 0x16AC9}, {0x16B50, 0x16B59}, {0x1D7CE, 0x1D7FF}, {0x1E140, 0x1E149}, {0x1E2F0, 0x1E2F9}, {0x1E4F0, 0x1E4F9}, {0x1E950, 0x1E959}, {0x1FBF0, 0x1FBF9} #endif }; #define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange)) /* * no singletons of digit characters. */ /* * Unicode: punctuation characters. */ static const crange punctRangeTable[] = { {0x21, 0x23}, {0x25, 0x2A}, {0x2C, 0x2F}, {0x5B, 0x5D}, {0x55A, 0x55F}, {0x61D, 0x61F}, {0x66A, 0x66D}, {0x700, 0x70D}, {0x7F7, 0x7F9}, {0x830, 0x83E}, {0xF04, 0xF12}, {0xF3A, 0xF3D}, {0xFD0, 0xFD4}, {0x104A, 0x104F}, {0x1360, 0x1368}, {0x16EB, 0x16ED}, {0x17D4, 0x17D6}, {0x17D8, 0x17DA}, {0x1800, 0x180A}, {0x1AA0, 0x1AA6}, {0x1AA8, 0x1AAD}, {0x1B5A, 0x1B60}, {0x1BFC, 0x1BFF}, {0x1C3B, 0x1C3F}, {0x1CC0, 0x1CC7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205E}, {0x2308, 0x230B}, {0x2768, 0x2775}, {0x27E6, 0x27EF}, {0x2983, 0x2998}, {0x29D8, 0x29DB}, {0x2CF9, 0x2CFC}, {0x2E00, 0x2E2E}, {0x2E30, 0x2E4F}, {0x2E52, 0x2E5D}, {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301F}, {0xA60D, 0xA60F}, {0xA6F2, 0xA6F7}, {0xA874, 0xA877}, {0xA8F8, 0xA8FA}, {0xA9C1, 0xA9CD}, {0xAA5C, 0xAA5F}, {0xFE10, 0xFE19}, {0xFE30, 0xFE52}, {0xFE54, 0xFE61}, {0xFF01, 0xFF03}, {0xFF05, 0xFF0A}, {0xFF0C, 0xFF0F}, {0xFF3B, 0xFF3D}, {0xFF5F, 0xFF65} #if CHRBITS > 16 ,{0x10100, 0x10102}, {0x10A50, 0x10A58}, {0x10AF0, 0x10AF6}, {0x10B39, 0x10B3F}, {0x10B99, 0x10B9C}, {0x10F55, 0x10F59}, {0x10F86, 0x10F89}, {0x11047, 0x1104D}, {0x110BE, 0x110C1}, {0x11140, 0x11143}, {0x111C5, 0x111C8}, {0x111DD, 0x111DF}, {0x11238, 0x1123D}, {0x1144B, 0x1144F}, {0x115C1, 0x115D7}, {0x11641, 0x11643}, {0x11660, 0x1166C}, {0x1173C, 0x1173E}, {0x11944, 0x11946}, {0x11A3F, 0x11A46}, {0x11A9A, 0x11A9C}, {0x11A9E, 0x11AA2}, {0x11B00, 0x11B09}, {0x11C41, 0x11C45}, {0x11F43, 0x11F4F}, {0x12470, 0x12474}, {0x16B37, 0x16B3B}, {0x16E97, 0x16E9A}, {0x1DA87, 0x1DA8B} #endif }; #define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange)) static const chr punctCharTable[] = { 0x3A, 0x3B, 0x3F, 0x40, 0x5F, 0x7B, 0x7D, 0xA1, 0xA7, 0xAB, 0xB6, 0xB7, 0xBB, 0xBF, 0x37E, 0x387, 0x589, 0x58A, 0x5BE, 0x5C0, 0x5C3, 0x5C6, 0x5F3, 0x5F4, 0x609, 0x60A, 0x60C, 0x60D, 0x61B, 0x6D4, 0x85E, 0x964, 0x965, 0x970, 0x9FD, 0xA76, 0xAF0, 0xC77, 0xC84, 0xDF4, 0xE4F, 0xE5A, 0xE5B, 0xF14, 0xF85, 0xFD9, 0xFDA, 0x10FB, 0x1400, 0x166E, 0x169B, 0x169C, 0x1735, 0x1736, 0x1944, 0x1945, 0x1A1E, 0x1A1F, 0x1B7D, 0x1B7E, 0x1C7E, 0x1C7F, 0x1CD3, 0x207D, 0x207E, 0x208D, 0x208E, 0x2329, 0x232A, 0x27C5, 0x27C6, 0x29FC, 0x29FD, 0x2CFE, 0x2CFF, 0x2D70, 0x3030, 0x303D, 0x30A0, 0x30FB, 0xA4FE, 0xA4FF, 0xA673, 0xA67E, 0xA8CE, 0xA8CF, 0xA8FC, 0xA92E, 0xA92F, 0xA95F, 0xA9DE, 0xA9DF, 0xAADE, 0xAADF, 0xAAF0, 0xAAF1, 0xABEB, 0xFD3E, 0xFD3F, 0xFE63, 0xFE68, 0xFE6A, 0xFE6B, 0xFF1A, 0xFF1B, 0xFF1F, 0xFF20, 0xFF3F, 0xFF5B, 0xFF5D #if CHRBITS > 16 ,0x1039F, 0x103D0, 0x1056F, 0x10857, 0x1091F, 0x1093F, 0x10A7F, 0x10EAD, 0x110BB, 0x110BC, 0x11174, 0x11175, 0x111CD, 0x111DB, 0x112A9, 0x1145A, 0x1145B, 0x1145D, 0x114C6, 0x116B9, 0x1183B, 0x119E2, 0x11C70, 0x11C71, 0x11EF7, 0x11EF8, 0x11FFF, 0x12FF1, 0x12FF2, 0x16A6E, 0x16A6F, 0x16AF5, 0x16B44, 0x16FE2, 0x1BC9F, 0x1E95E, 0x1E95F #endif }; #define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr)) /* * Unicode: white space characters. */ static const crange spaceRangeTable[] = { {0x9, 0xD}, {0x2000, 0x200B} }; #define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange)) static const chr spaceCharTable[] = { 0x20, 0x85, 0xA0, 0x1680, 0x180E, 0x2028, 0x2029, 0x202F, 0x205F, 0x2060, 0x3000, 0xFEFF }; #define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr)) /* * Unicode: lowercase characters. */ static const crange lowerRangeTable[] = { {0x61, 0x7A}, {0xDF, 0xF6}, {0xF8, 0xFF}, {0x17E, 0x180}, {0x199, 0x19B}, {0x1BD, 0x1BF}, {0x233, 0x239}, {0x24F, 0x293}, {0x295, 0x2AF}, {0x37B, 0x37D}, {0x3AC, 0x3CE}, {0x3D5, 0x3D7}, {0x3EF, 0x3F3}, {0x430, 0x45F}, {0x560, 0x588}, {0x10D0, 0x10FA}, {0x10FD, 0x10FF}, {0x13F8, 0x13FD}, {0x1C80, 0x1C88}, {0x1D00, 0x1D2B}, {0x1D6B, 0x1D77}, {0x1D79, 0x1D9A}, {0x1E95, 0x1E9D}, {0x1EFF, 0x1F07}, {0x1F10, 0x1F15}, {0x1F20, 0x1F27}, {0x1F30, 0x1F37}, {0x1F40, 0x1F45}, {0x1F50, 0x1F57}, {0x1F60, 0x1F67}, {0x1F70, 0x1F7D}, {0x1F80, 0x1F87}, {0x1F90, 0x1F97}, {0x1FA0, 0x1FA7}, {0x1FB0, 0x1FB4}, {0x1FC2, 0x1FC4}, {0x1FD0, 0x1FD3}, {0x1FE0, 0x1FE7}, {0x1FF2, 0x1FF4}, {0x2146, 0x2149}, {0x2C30, 0x2C5F}, {0x2C76, 0x2C7B}, {0x2D00, 0x2D25}, {0xA72F, 0xA731}, {0xA771, 0xA778}, {0xA793, 0xA795}, {0xAB30, 0xAB5A}, {0xAB60, 0xAB68}, {0xAB70, 0xABBF}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17}, {0xFF41, 0xFF5A} #if CHRBITS > 16 ,{0x10428, 0x1044F}, {0x104D8, 0x104FB}, {0x10597, 0x105A1}, {0x105A3, 0x105B1}, {0x105B3, 0x105B9}, {0x10CC0, 0x10CF2}, {0x118C0, 0x118DF}, {0x16E60, 0x16E7F}, {0x1D41A, 0x1D433}, {0x1D44E, 0x1D454}, {0x1D456, 0x1D467}, {0x1D482, 0x1D49B}, {0x1D4B6, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D4CF}, {0x1D4EA, 0x1D503}, {0x1D51E, 0x1D537}, {0x1D552, 0x1D56B}, {0x1D586, 0x1D59F}, {0x1D5BA, 0x1D5D3}, {0x1D5EE, 0x1D607}, {0x1D622, 0x1D63B}, {0x1D656, 0x1D66F}, {0x1D68A, 0x1D6A5}, {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6E1}, {0x1D6FC, 0x1D714}, {0x1D716, 0x1D71B}, {0x1D736, 0x1D74E}, {0x1D750, 0x1D755}, {0x1D770, 0x1D788}, {0x1D78A, 0x1D78F}, {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7C9}, {0x1DF00, 0x1DF09}, {0x1DF0B, 0x1DF1E}, {0x1DF25, 0x1DF2A}, {0x1E922, 0x1E943} #endif }; #define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange)) static const chr lowerCharTable[] = { 0xB5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10B, 0x10D, 0x10F, 0x111, 0x113, 0x115, 0x117, 0x119, 0x11B, 0x11D, 0x11F, 0x121, 0x123, 0x125, 0x127, 0x129, 0x12B, 0x12D, 0x12F, 0x131, 0x133, 0x135, 0x137, 0x138, 0x13A, 0x13C, 0x13E, 0x140, 0x142, 0x144, 0x146, 0x148, 0x149, 0x14B, 0x14D, 0x14F, 0x151, 0x153, 0x155, 0x157, 0x159, 0x15B, 0x15D, 0x15F, 0x161, 0x163, 0x165, 0x167, 0x169, 0x16B, 0x16D, 0x16F, 0x171, 0x173, 0x175, 0x177, 0x17A, 0x17C, 0x183, 0x185, 0x188, 0x18C, 0x18D, 0x192, 0x195, 0x19E, 0x1A1, 0x1A3, 0x1A5, 0x1A8, 0x1AA, 0x1AB, 0x1AD, 0x1B0, 0x1B4, 0x1B6, 0x1B9, 0x1BA, 0x1C6, 0x1C9, 0x1CC, 0x1CE, 0x1D0, 0x1D2, 0x1D4, 0x1D6, 0x1D8, 0x1DA, 0x1DC, 0x1DD, 0x1DF, 0x1E1, 0x1E3, 0x1E5, 0x1E7, 0x1E9, 0x1EB, 0x1ED, 0x1EF, 0x1F0, 0x1F3, 0x1F5, 0x1F9, 0x1FB, 0x1FD, 0x1FF, 0x201, 0x203, 0x205, 0x207, 0x209, 0x20B, 0x20D, 0x20F, 0x211, 0x213, 0x215, 0x217, 0x219, 0x21B, 0x21D, 0x21F, 0x221, 0x223, 0x225, 0x227, 0x229, 0x22B, 0x22D, 0x22F, 0x231, 0x23C, 0x23F, 0x240, 0x242, 0x247, 0x249, 0x24B, 0x24D, 0x371, 0x373, 0x377, 0x390, 0x3D0, 0x3D1, 0x3D9, 0x3DB, 0x3DD, 0x3DF, 0x3E1, 0x3E3, 0x3E5, 0x3E7, 0x3E9, 0x3EB, 0x3ED, 0x3F5, 0x3F8, 0x3FB, 0x3FC, 0x461, 0x463, 0x465, 0x467, 0x469, 0x46B, 0x46D, 0x46F, 0x471, 0x473, 0x475, 0x477, 0x479, 0x47B, 0x47D, 0x47F, 0x481, 0x48B, 0x48D, 0x48F, 0x491, 0x493, 0x495, 0x497, 0x499, 0x49B, 0x49D, 0x49F, 0x4A1, 0x4A3, 0x4A5, 0x4A7, 0x4A9, 0x4AB, 0x4AD, 0x4AF, 0x4B1, 0x4B3, 0x4B5, 0x4B7, 0x4B9, 0x4BB, 0x4BD, 0x4BF, 0x4C2, 0x4C4, 0x4C6, 0x4C8, 0x4CA, 0x4CC, 0x4CE, 0x4CF, 0x4D1, 0x4D3, 0x4D5, 0x4D7, 0x4D9, 0x4DB, 0x4DD, 0x4DF, 0x4E1, 0x4E3, 0x4E5, 0x4E7, 0x4E9, 0x4EB, 0x4ED, 0x4EF, 0x4F1, 0x4F3, 0x4F5, 0x4F7, 0x4F9, 0x4FB, 0x4FD, 0x4FF, 0x501, 0x503, 0x505, 0x507, 0x509, 0x50B, 0x50D, 0x50F, 0x511, 0x513, 0x515, 0x517, 0x519, 0x51B, 0x51D, 0x51F, 0x521, 0x523, 0x525, 0x527, 0x529, 0x52B, 0x52D, 0x52F, 0x1E01, 0x1E03, 0x1E05, 0x1E07, 0x1E09, 0x1E0B, 0x1E0D, 0x1E0F, 0x1E11, 0x1E13, 0x1E15, 0x1E17, 0x1E19, 0x1E1B, 0x1E1D, 0x1E1F, 0x1E21, 0x1E23, 0x1E25, 0x1E27, 0x1E29, 0x1E2B, 0x1E2D, 0x1E2F, 0x1E31, 0x1E33, 0x1E35, 0x1E37, 0x1E39, 0x1E3B, 0x1E3D, 0x1E3F, 0x1E41, 0x1E43, 0x1E45, 0x1E47, 0x1E49, 0x1E4B, 0x1E4D, 0x1E4F, 0x1E51, 0x1E53, 0x1E55, 0x1E57, 0x1E59, 0x1E5B, 0x1E5D, 0x1E5F, 0x1E61, 0x1E63, 0x1E65, 0x1E67, 0x1E69, 0x1E6B, 0x1E6D, 0x1E6F, 0x1E71, 0x1E73, 0x1E75, 0x1E77, 0x1E79, 0x1E7B, 0x1E7D, 0x1E7F, 0x1E81, 0x1E83, 0x1E85, 0x1E87, 0x1E89, 0x1E8B, 0x1E8D, 0x1E8F, 0x1E91, 0x1E93, 0x1E9F, 0x1EA1, 0x1EA3, 0x1EA5, 0x1EA7, 0x1EA9, 0x1EAB, 0x1EAD, 0x1EAF, 0x1EB1, 0x1EB3, 0x1EB5, 0x1EB7, 0x1EB9, 0x1EBB, 0x1EBD, 0x1EBF, 0x1EC1, 0x1EC3, 0x1EC5, 0x1EC7, 0x1EC9, 0x1ECB, 0x1ECD, 0x1ECF, 0x1ED1, 0x1ED3, 0x1ED5, 0x1ED7, 0x1ED9, 0x1EDB, 0x1EDD, 0x1EDF, 0x1EE1, 0x1EE3, 0x1EE5, 0x1EE7, 0x1EE9, 0x1EEB, 0x1EED, 0x1EEF, 0x1EF1, 0x1EF3, 0x1EF5, 0x1EF7, 0x1EF9, 0x1EFB, 0x1EFD, 0x1FB6, 0x1FB7, 0x1FBE, 0x1FC6, 0x1FC7, 0x1FD6, 0x1FD7, 0x1FF6, 0x1FF7, 0x210A, 0x210E, 0x210F, 0x2113, 0x212F, 0x2134, 0x2139, 0x213C, 0x213D, 0x214E, 0x2184, 0x2C61, 0x2C65, 0x2C66, 0x2C68, 0x2C6A, 0x2C6C, 0x2C71, 0x2C73, 0x2C74, 0x2C81, 0x2C83, 0x2C85, 0x2C87, 0x2C89, 0x2C8B, 0x2C8D, 0x2C8F, 0x2C91, 0x2C93, 0x2C95, 0x2C97, 0x2C99, 0x2C9B, 0x2C9D, 0x2C9F, 0x2CA1, 0x2CA3, 0x2CA5, 0x2CA7, 0x2CA9, 0x2CAB, 0x2CAD, 0x2CAF, 0x2CB1, 0x2CB3, 0x2CB5, 0x2CB7, 0x2CB9, 0x2CBB, 0x2CBD, 0x2CBF, 0x2CC1, 0x2CC3, 0x2CC5, 0x2CC7, 0x2CC9, 0x2CCB, 0x2CCD, 0x2CCF, 0x2CD1, 0x2CD3, 0x2CD5, 0x2CD7, 0x2CD9, 0x2CDB, 0x2CDD, 0x2CDF, 0x2CE1, 0x2CE3, 0x2CE4, 0x2CEC, 0x2CEE, 0x2CF3, 0x2D27, 0x2D2D, 0xA641, 0xA643, 0xA645, 0xA647, 0xA649, 0xA64B, 0xA64D, 0xA64F, 0xA651, 0xA653, 0xA655, 0xA657, 0xA659, 0xA65B, 0xA65D, 0xA65F, 0xA661, 0xA663, 0xA665, 0xA667, 0xA669, 0xA66B, 0xA66D, 0xA681, 0xA683, 0xA685, 0xA687, 0xA689, 0xA68B, 0xA68D, 0xA68F, 0xA691, 0xA693, 0xA695, 0xA697, 0xA699, 0xA69B, 0xA723, 0xA725, 0xA727, 0xA729, 0xA72B, 0xA72D, 0xA733, 0xA735, 0xA737, 0xA739, 0xA73B, 0xA73D, 0xA73F, 0xA741, 0xA743, 0xA745, 0xA747, 0xA749, 0xA74B, 0xA74D, 0xA74F, 0xA751, 0xA753, 0xA755, 0xA757, 0xA759, 0xA75B, 0xA75D, 0xA75F, 0xA761, 0xA763, 0xA765, 0xA767, 0xA769, 0xA76B, 0xA76D, 0xA76F, 0xA77A, 0xA77C, 0xA77F, 0xA781, 0xA783, 0xA785, 0xA787, 0xA78C, 0xA78E, 0xA791, 0xA797, 0xA799, 0xA79B, 0xA79D, 0xA79F, 0xA7A1, 0xA7A3, 0xA7A5, 0xA7A7, 0xA7A9, 0xA7AF, 0xA7B5, 0xA7B7, 0xA7B9, 0xA7BB, 0xA7BD, 0xA7BF, 0xA7C1, 0xA7C3, 0xA7C8, 0xA7CA, 0xA7D1, 0xA7D3, 0xA7D5, 0xA7D7, 0xA7D9, 0xA7F6, 0xA7FA #if CHRBITS > 16 ,0x105BB, 0x105BC, 0x1D4BB, 0x1D7CB #endif }; #define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr)) /* * Unicode: uppercase characters. */ static const crange upperRangeTable[] = { {0x41, 0x5A}, {0xC0, 0xD6}, {0xD8, 0xDE}, {0x189, 0x18B}, {0x18E, 0x191}, {0x196, 0x198}, {0x1B1, 0x1B3}, {0x1F6, 0x1F8}, {0x243, 0x246}, {0x388, 0x38A}, {0x391, 0x3A1}, {0x3A3, 0x3AB}, {0x3D2, 0x3D4}, {0x3FD, 0x42F}, {0x531, 0x556}, {0x10A0, 0x10C5}, {0x13A0, 0x13F5}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CBF}, {0x1F08, 0x1F0F}, {0x1F18, 0x1F1D}, {0x1F28, 0x1F2F}, {0x1F38, 0x1F3F}, {0x1F48, 0x1F4D}, {0x1F68, 0x1F6F}, {0x1FB8, 0x1FBB}, {0x1FC8, 0x1FCB}, {0x1FD8, 0x1FDB}, {0x1FE8, 0x1FEC}, {0x1FF8, 0x1FFB}, {0x210B, 0x210D}, {0x2110, 0x2112}, {0x2119, 0x211D}, {0x212A, 0x212D}, {0x2130, 0x2133}, {0x2C00, 0x2C2F}, {0x2C62, 0x2C64}, {0x2C6D, 0x2C70}, {0x2C7E, 0x2C80}, {0xA7AA, 0xA7AE}, {0xA7B0, 0xA7B4}, {0xA7C4, 0xA7C7}, {0xFF21, 0xFF3A} #if CHRBITS > 16 ,{0x10400, 0x10427}, {0x104B0, 0x104D3}, {0x10570, 0x1057A}, {0x1057C, 0x1058A}, {0x1058C, 0x10592}, {0x10C80, 0x10CB2}, {0x118A0, 0x118BF}, {0x16E40, 0x16E5F}, {0x1D400, 0x1D419}, {0x1D434, 0x1D44D}, {0x1D468, 0x1D481}, {0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B5}, {0x1D4D0, 0x1D4E9}, {0x1D507, 0x1D50A}, {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550}, {0x1D56C, 0x1D585}, {0x1D5A0, 0x1D5B9}, {0x1D5D4, 0x1D5ED}, {0x1D608, 0x1D621}, {0x1D63C, 0x1D655}, {0x1D670, 0x1D689}, {0x1D6A8, 0x1D6C0}, {0x1D6E2, 0x1D6FA}, {0x1D71C, 0x1D734}, {0x1D756, 0x1D76E}, {0x1D790, 0x1D7A8}, {0x1E900, 0x1E921} #endif }; #define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange)) static const chr upperCharTable[] = { 0x100, 0x102, 0x104, 0x106, 0x108, 0x10A, 0x10C, 0x10E, 0x110, 0x112, 0x114, 0x116, 0x118, 0x11A, 0x11C, 0x11E, 0x120, 0x122, 0x124, 0x126, 0x128, 0x12A, 0x12C, 0x12E, 0x130, 0x132, 0x134, 0x136, 0x139, 0x13B, 0x13D, 0x13F, 0x141, 0x143, 0x145, 0x147, 0x14A, 0x14C, 0x14E, 0x150, 0x152, 0x154, 0x156, 0x158, 0x15A, 0x15C, 0x15E, 0x160, 0x162, 0x164, 0x166, 0x168, 0x16A, 0x16C, 0x16E, 0x170, 0x172, 0x174, 0x176, 0x178, 0x179, 0x17B, 0x17D, 0x181, 0x182, 0x184, 0x186, 0x187, 0x193, 0x194, 0x19C, 0x19D, 0x19F, 0x1A0, 0x1A2, 0x1A4, 0x1A6, 0x1A7, 0x1A9, 0x1AC, 0x1AE, 0x1AF, 0x1B5, 0x1B7, 0x1B8, 0x1BC, 0x1C4, 0x1C7, 0x1CA, 0x1CD, 0x1CF, 0x1D1, 0x1D3, 0x1D5, 0x1D7, 0x1D9, 0x1DB, 0x1DE, 0x1E0, 0x1E2, 0x1E4, 0x1E6, 0x1E8, 0x1EA, 0x1EC, 0x1EE, 0x1F1, 0x1F4, 0x1FA, 0x1FC, 0x1FE, 0x200, 0x202, 0x204, 0x206, 0x208, 0x20A, 0x20C, 0x20E, 0x210, 0x212, 0x214, 0x216, 0x218, 0x21A, 0x21C, 0x21E, 0x220, 0x222, 0x224, 0x226, 0x228, 0x22A, 0x22C, 0x22E, 0x230, 0x232, 0x23A, 0x23B, 0x23D, 0x23E, 0x241, 0x248, 0x24A, 0x24C, 0x24E, 0x370, 0x372, 0x376, 0x37F, 0x386, 0x38C, 0x38E, 0x38F, 0x3CF, 0x3D8, 0x3DA, 0x3DC, 0x3DE, 0x3E0, 0x3E2, 0x3E4, 0x3E6, 0x3E8, 0x3EA, 0x3EC, 0x3EE, 0x3F4, 0x3F7, 0x3F9, 0x3FA, 0x460, 0x462, 0x464, 0x466, 0x468, 0x46A, 0x46C, 0x46E, 0x470, 0x472, 0x474, 0x476, 0x478, 0x47A, 0x47C, 0x47E, 0x480, 0x48A, 0x48C, 0x48E, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49A, 0x49C, 0x49E, 0x4A0, 0x4A2, 0x4A4, 0x4A6, 0x4A8, 0x4AA, 0x4AC, 0x4AE, 0x4B0, 0x4B2, 0x4B4, 0x4B6, 0x4B8, 0x4BA, 0x4BC, 0x4BE, 0x4C0, 0x4C1, 0x4C3, 0x4C5, 0x4C7, 0x4C9, 0x4CB, 0x4CD, 0x4D0, 0x4D2, 0x4D4, 0x4D6, 0x4D8, 0x4DA, 0x4DC, 0x4DE, 0x4E0, 0x4E2, 0x4E4, 0x4E6, 0x4E8, 0x4EA, 0x4EC, 0x4EE, 0x4F0, 0x4F2, 0x4F4, 0x4F6, 0x4F8, 0x4FA, 0x4FC, 0x4FE, 0x500, 0x502, 0x504, 0x506, 0x508, 0x50A, 0x50C, 0x50E, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51A, 0x51C, 0x51E, 0x520, 0x522, 0x524, 0x526, 0x528, 0x52A, 0x52C, 0x52E, 0x10C7, 0x10CD, 0x1E00, 0x1E02, 0x1E04, 0x1E06, 0x1E08, 0x1E0A, 0x1E0C, 0x1E0E, 0x1E10, 0x1E12, 0x1E14, 0x1E16, 0x1E18, 0x1E1A, 0x1E1C, 0x1E1E, 0x1E20, 0x1E22, 0x1E24, 0x1E26, 0x1E28, 0x1E2A, 0x1E2C, 0x1E2E, 0x1E30, 0x1E32, 0x1E34, 0x1E36, 0x1E38, 0x1E3A, 0x1E3C, 0x1E3E, 0x1E40, 0x1E42, 0x1E44, 0x1E46, 0x1E48, 0x1E4A, 0x1E4C, 0x1E4E, 0x1E50, 0x1E52, 0x1E54, 0x1E56, 0x1E58, 0x1E5A, 0x1E5C, 0x1E5E, 0x1E60, 0x1E62, 0x1E64, 0x1E66, 0x1E68, 0x1E6A, 0x1E6C, 0x1E6E, 0x1E70, 0x1E72, 0x1E74, 0x1E76, 0x1E78, 0x1E7A, 0x1E7C, 0x1E7E, 0x1E80, 0x1E82, 0x1E84, 0x1E86, 0x1E88, 0x1E8A, 0x1E8C, 0x1E8E, 0x1E90, 0x1E92, 0x1E94, 0x1E9E, 0x1EA0, 0x1EA2, 0x1EA4, 0x1EA6, 0x1EA8, 0x1EAA, 0x1EAC, 0x1EAE, 0x1EB0, 0x1EB2, 0x1EB4, 0x1EB6, 0x1EB8, 0x1EBA, 0x1EBC, 0x1EBE, 0x1EC0, 0x1EC2, 0x1EC4, 0x1EC6, 0x1EC8, 0x1ECA, 0x1ECC, 0x1ECE, 0x1ED0, 0x1ED2, 0x1ED4, 0x1ED6, 0x1ED8, 0x1EDA, 0x1EDC, 0x1EDE, 0x1EE0, 0x1EE2, 0x1EE4, 0x1EE6, 0x1EE8, 0x1EEA, 0x1EEC, 0x1EEE, 0x1EF0, 0x1EF2, 0x1EF4, 0x1EF6, 0x1EF8, 0x1EFA, 0x1EFC, 0x1EFE, 0x1F59, 0x1F5B, 0x1F5D, 0x1F5F, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x213E, 0x213F, 0x2145, 0x2183, 0x2C60, 0x2C67, 0x2C69, 0x2C6B, 0x2C72, 0x2C75, 0x2C82, 0x2C84, 0x2C86, 0x2C88, 0x2C8A, 0x2C8C, 0x2C8E, 0x2C90, 0x2C92, 0x2C94, 0x2C96, 0x2C98, 0x2C9A, 0x2C9C, 0x2C9E, 0x2CA0, 0x2CA2, 0x2CA4, 0x2CA6, 0x2CA8, 0x2CAA, 0x2CAC, 0x2CAE, 0x2CB0, 0x2CB2, 0x2CB4, 0x2CB6, 0x2CB8, 0x2CBA, 0x2CBC, 0x2CBE, 0x2CC0, 0x2CC2, 0x2CC4, 0x2CC6, 0x2CC8, 0x2CCA, 0x2CCC, 0x2CCE, 0x2CD0, 0x2CD2, 0x2CD4, 0x2CD6, 0x2CD8, 0x2CDA, 0x2CDC, 0x2CDE, 0x2CE0, 0x2CE2, 0x2CEB, 0x2CED, 0x2CF2, 0xA640, 0xA642, 0xA644, 0xA646, 0xA648, 0xA64A, 0xA64C, 0xA64E, 0xA650, 0xA652, 0xA654, 0xA656, 0xA658, 0xA65A, 0xA65C, 0xA65E, 0xA660, 0xA662, 0xA664, 0xA666, 0xA668, 0xA66A, 0xA66C, 0xA680, 0xA682, 0xA684, 0xA686, 0xA688, 0xA68A, 0xA68C, 0xA68E, 0xA690, 0xA692, 0xA694, 0xA696, 0xA698, 0xA69A, 0xA722, 0xA724, 0xA726, 0xA728, 0xA72A, 0xA72C, 0xA72E, 0xA732, 0xA734, 0xA736, 0xA738, 0xA73A, 0xA73C, 0xA73E, 0xA740, 0xA742, 0xA744, 0xA746, 0xA748, 0xA74A, 0xA74C, 0xA74E, 0xA750, 0xA752, 0xA754, 0xA756, 0xA758, 0xA75A, 0xA75C, 0xA75E, 0xA760, 0xA762, 0xA764, 0xA766, 0xA768, 0xA76A, 0xA76C, 0xA76E, 0xA779, 0xA77B, 0xA77D, 0xA77E, 0xA780, 0xA782, 0xA784, 0xA786, 0xA78B, 0xA78D, 0xA790, 0xA792, 0xA796, 0xA798, 0xA79A, 0xA79C, 0xA79E, 0xA7A0, 0xA7A2, 0xA7A4, 0xA7A6, 0xA7A8, 0xA7B6, 0xA7B8, 0xA7BA, 0xA7BC, 0xA7BE, 0xA7C0, 0xA7C2, 0xA7C9, 0xA7D0, 0xA7D6, 0xA7D8, 0xA7F5 #if CHRBITS > 16 ,0x10594, 0x10595, 0x1D49C, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D504, 0x1D505, 0x1D538, 0x1D539, 0x1D546, 0x1D7CA #endif }; #define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr)) /* * Unicode: unicode print characters excluding space. */ static const crange graphRangeTable[] = { {0x21, 0x7E}, {0xA1, 0xAC}, {0xAE, 0x377}, {0x37A, 0x37F}, {0x384, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x52F}, {0x531, 0x556}, {0x559, 0x58A}, {0x58D, 0x58F}, {0x591, 0x5C7}, {0x5D0, 0x5EA}, {0x5EF, 0x5F4}, {0x606, 0x61B}, {0x61D, 0x6DC}, {0x6DE, 0x70D}, {0x710, 0x74A}, {0x74D, 0x7B1}, {0x7C0, 0x7FA}, {0x7FD, 0x82D}, {0x830, 0x83E}, {0x840, 0x85B}, {0x860, 0x86A}, {0x870, 0x88E}, {0x898, 0x8E1}, {0x8E3, 0x983}, {0x985, 0x98C}, {0x993, 0x9A8}, {0x9AA, 0x9B0}, {0x9B6, 0x9B9}, {0x9BC, 0x9C4}, {0x9CB, 0x9CE}, {0x9DF, 0x9E3}, {0x9E6, 0x9FE}, {0xA01, 0xA03}, {0xA05, 0xA0A}, {0xA13, 0xA28}, {0xA2A, 0xA30}, {0xA3E, 0xA42}, {0xA4B, 0xA4D}, {0xA59, 0xA5C}, {0xA66, 0xA76}, {0xA81, 0xA83}, {0xA85, 0xA8D}, {0xA8F, 0xA91}, {0xA93, 0xAA8}, {0xAAA, 0xAB0}, {0xAB5, 0xAB9}, {0xABC, 0xAC5}, {0xAC7, 0xAC9}, {0xACB, 0xACD}, {0xAE0, 0xAE3}, {0xAE6, 0xAF1}, {0xAF9, 0xAFF}, {0xB01, 0xB03}, {0xB05, 0xB0C}, {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39}, {0xB3C, 0xB44}, {0xB4B, 0xB4D}, {0xB55, 0xB57}, {0xB5F, 0xB63}, {0xB66, 0xB77}, {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95}, {0xBA8, 0xBAA}, {0xBAE, 0xBB9}, {0xBBE, 0xBC2}, {0xBC6, 0xBC8}, {0xBCA, 0xBCD}, {0xBE6, 0xBFA}, {0xC00, 0xC0C}, {0xC0E, 0xC10}, {0xC12, 0xC28}, {0xC2A, 0xC39}, {0xC3C, 0xC44}, {0xC46, 0xC48}, {0xC4A, 0xC4D}, {0xC58, 0xC5A}, {0xC60, 0xC63}, {0xC66, 0xC6F}, {0xC77, 0xC8C}, {0xC8E, 0xC90}, {0xC92, 0xCA8}, {0xCAA, 0xCB3}, {0xCB5, 0xCB9}, {0xCBC, 0xCC4}, {0xCC6, 0xCC8}, {0xCCA, 0xCCD}, {0xCE0, 0xCE3}, {0xCE6, 0xCEF}, {0xCF1, 0xCF3}, {0xD00, 0xD0C}, {0xD0E, 0xD10}, {0xD12, 0xD44}, {0xD46, 0xD48}, {0xD4A, 0xD4F}, {0xD54, 0xD63}, {0xD66, 0xD7F}, {0xD81, 0xD83}, {0xD85, 0xD96}, {0xD9A, 0xDB1}, {0xDB3, 0xDBB}, {0xDC0, 0xDC6}, {0xDCF, 0xDD4}, {0xDD8, 0xDDF}, {0xDE6, 0xDEF}, {0xDF2, 0xDF4}, {0xE01, 0xE3A}, {0xE3F, 0xE5B}, {0xE86, 0xE8A}, {0xE8C, 0xEA3}, {0xEA7, 0xEBD}, {0xEC0, 0xEC4}, {0xEC8, 0xECE}, {0xED0, 0xED9}, {0xEDC, 0xEDF}, {0xF00, 0xF47}, {0xF49, 0xF6C}, {0xF71, 0xF97}, {0xF99, 0xFBC}, {0xFBE, 0xFCC}, {0xFCE, 0xFDA}, {0x1000, 0x10C5}, {0x10D0, 0x1248}, {0x124A, 0x124D}, {0x1250, 0x1256}, {0x125A, 0x125D}, {0x1260, 0x1288}, {0x128A, 0x128D}, {0x1290, 0x12B0}, {0x12B2, 0x12B5}, {0x12B8, 0x12BE}, {0x12C2, 0x12C5}, {0x12C8, 0x12D6}, {0x12D8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135A}, {0x135D, 0x137C}, {0x1380, 0x1399}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD}, {0x1400, 0x167F}, {0x1681, 0x169C}, {0x16A0, 0x16F8}, {0x1700, 0x1715}, {0x171F, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176C}, {0x176E, 0x1770}, {0x1780, 0x17DD}, {0x17E0, 0x17E9}, {0x17F0, 0x17F9}, {0x1800, 0x180D}, {0x180F, 0x1819}, {0x1820, 0x1878}, {0x1880, 0x18AA}, {0x18B0, 0x18F5}, {0x1900, 0x191E}, {0x1920, 0x192B}, {0x1930, 0x193B}, {0x1944, 0x196D}, {0x1970, 0x1974}, {0x1980, 0x19AB}, {0x19B0, 0x19C9}, {0x19D0, 0x19DA}, {0x19DE, 0x1A1B}, {0x1A1E, 0x1A5E}, {0x1A60, 0x1A7C}, {0x1A7F, 0x1A89}, {0x1A90, 0x1A99}, {0x1AA0, 0x1AAD}, {0x1AB0, 0x1ACE}, {0x1B00, 0x1B4C}, {0x1B50, 0x1B7E}, {0x1B80, 0x1BF3}, {0x1BFC, 0x1C37}, {0x1C3B, 0x1C49}, {0x1C4D, 0x1C88}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CC7}, {0x1CD0, 0x1CFA}, {0x1D00, 0x1F15}, {0x1F18, 0x1F1D}, {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57}, {0x1F5F, 0x1F7D}, {0x1F80, 0x1FB4}, {0x1FB6, 0x1FC4}, {0x1FC6, 0x1FD3}, {0x1FD6, 0x1FDB}, {0x1FDD, 0x1FEF}, {0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFE}, {0x2010, 0x2027}, {0x2030, 0x205E}, {0x2074, 0x208E}, {0x2090, 0x209C}, {0x20A0, 0x20C0}, {0x20D0, 0x20F0}, {0x2100, 0x218B}, {0x2190, 0x2426}, {0x2440, 0x244A}, {0x2460, 0x2B73}, {0x2B76, 0x2B95}, {0x2B97, 0x2CF3}, {0x2CF9, 0x2D25}, {0x2D30, 0x2D67}, {0x2D7F, 0x2D96}, {0x2DA0, 0x2DA6}, {0x2DA8, 0x2DAE}, {0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE}, {0x2DC0, 0x2DC6}, {0x2DC8, 0x2DCE}, {0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE}, {0x2DE0, 0x2E5D}, {0x2E80, 0x2E99}, {0x2E9B, 0x2EF3}, {0x2F00, 0x2FD5}, {0x2FF0, 0x2FFF}, {0x3001, 0x303F}, {0x3041, 0x3096}, {0x3099, 0x30FF}, {0x3105, 0x312F}, {0x3131, 0x318E}, {0x3190, 0x31E3}, {0x31EF, 0x321E}, {0x3220, 0xA48C}, {0xA490, 0xA4C6}, {0xA4D0, 0xA62B}, {0xA640, 0xA6F7}, {0xA700, 0xA7CA}, {0xA7D5, 0xA7D9}, {0xA7F2, 0xA82C}, {0xA830, 0xA839}, {0xA840, 0xA877}, {0xA880, 0xA8C5}, {0xA8CE, 0xA8D9}, {0xA8E0, 0xA953}, {0xA95F, 0xA97C}, {0xA980, 0xA9CD}, {0xA9CF, 0xA9D9}, {0xA9DE, 0xA9FE}, {0xAA00, 0xAA36}, {0xAA40, 0xAA4D}, {0xAA50, 0xAA59}, {0xAA5C, 0xAAC2}, {0xAADB, 0xAAF6}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E}, {0xAB11, 0xAB16}, {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB6B}, {0xAB70, 0xABED}, {0xABF0, 0xABF9}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6}, {0xD7CB, 0xD7FB}, {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17}, {0xFB1D, 0xFB36}, {0xFB38, 0xFB3C}, {0xFB46, 0xFBC2}, {0xFBD3, 0xFD8F}, {0xFD92, 0xFDC7}, {0xFDF0, 0xFE19}, {0xFE20, 0xFE52}, {0xFE54, 0xFE66}, {0xFE68, 0xFE6B}, {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF01, 0xFFBE}, {0xFFC2, 0xFFC7}, {0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7}, {0xFFDA, 0xFFDC}, {0xFFE0, 0xFFE6}, {0xFFE8, 0xFFEE} #if CHRBITS > 16 ,{0x10000, 0x1000B}, {0x1000D, 0x10026}, {0x10028, 0x1003A}, {0x1003F, 0x1004D}, {0x10050, 0x1005D}, {0x10080, 0x100FA}, {0x10100, 0x10102}, {0x10107, 0x10133}, {0x10137, 0x1018E}, {0x10190, 0x1019C}, {0x101D0, 0x101FD}, {0x10280, 0x1029C}, {0x102A0, 0x102D0}, {0x102E0, 0x102FB}, {0x10300, 0x10323}, {0x1032D, 0x1034A}, {0x10350, 0x1037A}, {0x10380, 0x1039D}, {0x1039F, 0x103C3}, {0x103C8, 0x103D5}, {0x10400, 0x1049D}, {0x104A0, 0x104A9}, {0x104B0, 0x104D3}, {0x104D8, 0x104FB}, {0x10500, 0x10527}, {0x10530, 0x10563}, {0x1056F, 0x1057A}, {0x1057C, 0x1058A}, {0x1058C, 0x10592}, {0x10597, 0x105A1}, {0x105A3, 0x105B1}, {0x105B3, 0x105B9}, {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10780, 0x10785}, {0x10787, 0x107B0}, {0x107B2, 0x107BA}, {0x10800, 0x10805}, {0x1080A, 0x10835}, {0x1083F, 0x10855}, {0x10857, 0x1089E}, {0x108A7, 0x108AF}, {0x108E0, 0x108F2}, {0x108FB, 0x1091B}, {0x1091F, 0x10939}, {0x10980, 0x109B7}, {0x109BC, 0x109CF}, {0x109D2, 0x10A03}, {0x10A0C, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35}, {0x10A38, 0x10A3A}, {0x10A3F, 0x10A48}, {0x10A50, 0x10A58}, {0x10A60, 0x10A9F}, {0x10AC0, 0x10AE6}, {0x10AEB, 0x10AF6}, {0x10B00, 0x10B35}, {0x10B39, 0x10B55}, {0x10B58, 0x10B72}, {0x10B78, 0x10B91}, {0x10B99, 0x10B9C}, {0x10BA9, 0x10BAF}, {0x10C00, 0x10C48}, {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10CFA, 0x10D27}, {0x10D30, 0x10D39}, {0x10E60, 0x10E7E}, {0x10E80, 0x10EA9}, {0x10EAB, 0x10EAD}, {0x10EFD, 0x10F27}, {0x10F30, 0x10F59}, {0x10F70, 0x10F89}, {0x10FB0, 0x10FCB}, {0x10FE0, 0x10FF6}, {0x11000, 0x1104D}, {0x11052, 0x11075}, {0x1107F, 0x110BC}, {0x110BE, 0x110C2}, {0x110D0, 0x110E8}, {0x110F0, 0x110F9}, {0x11100, 0x11134}, {0x11136, 0x11147}, {0x11150, 0x11176}, {0x11180, 0x111DF}, {0x111E1, 0x111F4}, {0x11200, 0x11211}, {0x11213, 0x11241}, {0x11280, 0x11286}, {0x1128A, 0x1128D}, {0x1128F, 0x1129D}, {0x1129F, 0x112A9}, {0x112B0, 0x112EA}, {0x112F0, 0x112F9}, {0x11300, 0x11303}, {0x11305, 0x1130C}, {0x11313, 0x11328}, {0x1132A, 0x11330}, {0x11335, 0x11339}, {0x1133B, 0x11344}, {0x1134B, 0x1134D}, {0x1135D, 0x11363}, {0x11366, 0x1136C}, {0x11370, 0x11374}, {0x11400, 0x1145B}, {0x1145D, 0x11461}, {0x11480, 0x114C7}, {0x114D0, 0x114D9}, {0x11580, 0x115B5}, {0x115B8, 0x115DD}, {0x11600, 0x11644}, {0x11650, 0x11659}, {0x11660, 0x1166C}, {0x11680, 0x116B9}, {0x116C0, 0x116C9}, {0x11700, 0x1171A}, {0x1171D, 0x1172B}, {0x11730, 0x11746}, {0x11800, 0x1183B}, {0x118A0, 0x118F2}, {0x118FF, 0x11906}, {0x1190C, 0x11913}, {0x11918, 0x11935}, {0x1193B, 0x11946}, {0x11950, 0x11959}, {0x119A0, 0x119A7}, {0x119AA, 0x119D7}, {0x119DA, 0x119E4}, {0x11A00, 0x11A47}, {0x11A50, 0x11AA2}, {0x11AB0, 0x11AF8}, {0x11B00, 0x11B09}, {0x11C00, 0x11C08}, {0x11C0A, 0x11C36}, {0x11C38, 0x11C45}, {0x11C50, 0x11C6C}, {0x11C70, 0x11C8F}, {0x11C92, 0x11CA7}, {0x11CA9, 0x11CB6}, {0x11D00, 0x11D06}, {0x11D0B, 0x11D36}, {0x11D3F, 0x11D47}, {0x11D50, 0x11D59}, {0x11D60, 0x11D65}, {0x11D6A, 0x11D8E}, {0x11D93, 0x11D98}, {0x11DA0, 0x11DA9}, {0x11EE0, 0x11EF8}, {0x11F00, 0x11F10}, {0x11F12, 0x11F3A}, {0x11F3E, 0x11F59}, {0x11FC0, 0x11FF1}, {0x11FFF, 0x12399}, {0x12400, 0x1246E}, {0x12470, 0x12474}, {0x12480, 0x12543}, {0x12F90, 0x12FF2}, {0x13000, 0x1342F}, {0x13440, 0x13455}, {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E}, {0x16A60, 0x16A69}, {0x16A6E, 0x16ABE}, {0x16AC0, 0x16AC9}, {0x16AD0, 0x16AED}, {0x16AF0, 0x16AF5}, {0x16B00, 0x16B45}, {0x16B50, 0x16B59}, {0x16B5B, 0x16B61}, {0x16B63, 0x16B77}, {0x16B7D, 0x16B8F}, {0x16E40, 0x16E9A}, {0x16F00, 0x16F4A}, {0x16F4F, 0x16F87}, {0x16F8F, 0x16F9F}, {0x16FE0, 0x16FE4}, {0x17000, 0x187F7}, {0x18800, 0x18CD5}, {0x18D00, 0x18D08}, {0x1AFF0, 0x1AFF3}, {0x1AFF5, 0x1AFFB}, {0x1B000, 0x1B122}, {0x1B150, 0x1B152}, {0x1B164, 0x1B167}, {0x1B170, 0x1B2FB}, {0x1BC00, 0x1BC6A}, {0x1BC70, 0x1BC7C}, {0x1BC80, 0x1BC88}, {0x1BC90, 0x1BC99}, {0x1BC9C, 0x1BC9F}, {0x1CF00, 0x1CF2D}, {0x1CF30, 0x1CF46}, {0x1CF50, 0x1CFC3}, {0x1D000, 0x1D0F5}, {0x1D100, 0x1D126}, {0x1D129, 0x1D172}, {0x1D17B, 0x1D1EA}, {0x1D200, 0x1D245}, {0x1D2C0, 0x1D2D3}, {0x1D2E0, 0x1D2F3}, {0x1D300, 0x1D356}, {0x1D360, 0x1D378}, {0x1D400, 0x1D454}, {0x1D456, 0x1D49C}, {0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D505}, {0x1D507, 0x1D50A}, {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D51E, 0x1D539}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550}, {0x1D552, 0x1D6A5}, {0x1D6A8, 0x1D7CB}, {0x1D7CE, 0x1DA8B}, {0x1DA9B, 0x1DA9F}, {0x1DAA1, 0x1DAAF}, {0x1DF00, 0x1DF1E}, {0x1DF25, 0x1DF2A}, {0x1E000, 0x1E006}, {0x1E008, 0x1E018}, {0x1E01B, 0x1E021}, {0x1E026, 0x1E02A}, {0x1E030, 0x1E06D}, {0x1E100, 0x1E12C}, {0x1E130, 0x1E13D}, {0x1E140, 0x1E149}, {0x1E290, 0x1E2AE}, {0x1E2C0, 0x1E2F9}, {0x1E4D0, 0x1E4F9}, {0x1E7E0, 0x1E7E6}, {0x1E7E8, 0x1E7EB}, {0x1E7F0, 0x1E7FE}, {0x1E800, 0x1E8C4}, {0x1E8C7, 0x1E8D6}, {0x1E900, 0x1E94B}, {0x1E950, 0x1E959}, {0x1EC71, 0x1ECB4}, {0x1ED01, 0x1ED3D}, {0x1EE00, 0x1EE03}, {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32}, {0x1EE34, 0x1EE37}, {0x1EE4D, 0x1EE4F}, {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72}, {0x1EE74, 0x1EE77}, {0x1EE79, 0x1EE7C}, {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B}, {0x1EEA1, 0x1EEA3}, {0x1EEA5, 0x1EEA9}, {0x1EEAB, 0x1EEBB}, {0x1F000, 0x1F02B}, {0x1F030, 0x1F093}, {0x1F0A0, 0x1F0AE}, {0x1F0B1, 0x1F0BF}, {0x1F0C1, 0x1F0CF}, {0x1F0D1, 0x1F0F5}, {0x1F100, 0x1F1AD}, {0x1F1E6, 0x1F202}, {0x1F210, 0x1F23B}, {0x1F240, 0x1F248}, {0x1F260, 0x1F265}, {0x1F300, 0x1F6D7}, {0x1F6DC, 0x1F6EC}, {0x1F6F0, 0x1F6FC}, {0x1F700, 0x1F776}, {0x1F77B, 0x1F7D9}, {0x1F7E0, 0x1F7EB}, {0x1F800, 0x1F80B}, {0x1F810, 0x1F847}, {0x1F850, 0x1F859}, {0x1F860, 0x1F887}, {0x1F890, 0x1F8AD}, {0x1F900, 0x1FA53}, {0x1FA60, 0x1FA6D}, {0x1FA70, 0x1FA7C}, {0x1FA80, 0x1FA88}, {0x1FA90, 0x1FABD}, {0x1FABF, 0x1FAC5}, {0x1FACE, 0x1FADB}, {0x1FAE0, 0x1FAE8}, {0x1FAF0, 0x1FAF8}, {0x1FB00, 0x1FB92}, {0x1FB94, 0x1FBCA}, {0x1FBF0, 0x1FBF9}, {0x20000, 0x2A6DF}, {0x2A700, 0x2B739}, {0x2B740, 0x2B81D}, {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0}, {0x2EBF0, 0x2EE5D}, {0x2F800, 0x2FA1D}, {0x30000, 0x3134A}, {0x31350, 0x323AF}, {0xE0100, 0xE01EF} #endif }; #define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange)) static const chr graphCharTable[] = { 0x38C, 0x85E, 0x98F, 0x990, 0x9B2, 0x9C7, 0x9C8, 0x9D7, 0x9DC, 0x9DD, 0xA0F, 0xA10, 0xA32, 0xA33, 0xA35, 0xA36, 0xA38, 0xA39, 0xA3C, 0xA47, 0xA48, 0xA51, 0xA5E, 0xAB2, 0xAB3, 0xAD0, 0xB0F, 0xB10, 0xB32, 0xB33, 0xB47, 0xB48, 0xB5C, 0xB5D, 0xB82, 0xB83, 0xB99, 0xB9A, 0xB9C, 0xB9E, 0xB9F, 0xBA3, 0xBA4, 0xBD0, 0xBD7, 0xC55, 0xC56, 0xC5D, 0xCD5, 0xCD6, 0xCDD, 0xCDE, 0xDBD, 0xDCA, 0xDD6, 0xE81, 0xE82, 0xE84, 0xEA5, 0xEC6, 0x10C7, 0x10CD, 0x1258, 0x12C0, 0x1772, 0x1773, 0x1940, 0x1F59, 0x1F5B, 0x1F5D, 0x2070, 0x2071, 0x2D27, 0x2D2D, 0x2D6F, 0x2D70, 0xA7D0, 0xA7D1, 0xA7D3, 0xFB3E, 0xFB40, 0xFB41, 0xFB43, 0xFB44, 0xFDCF, 0xFFFC, 0xFFFD #if CHRBITS > 16 ,0x1003C, 0x1003D, 0x101A0, 0x10594, 0x10595, 0x105BB, 0x105BC, 0x10808, 0x10837, 0x10838, 0x1083C, 0x108F4, 0x108F5, 0x1093F, 0x10A05, 0x10A06, 0x10EB0, 0x10EB1, 0x11288, 0x1130F, 0x11310, 0x11332, 0x11333, 0x11347, 0x11348, 0x11350, 0x11357, 0x11909, 0x11915, 0x11916, 0x11937, 0x11938, 0x11D08, 0x11D09, 0x11D3A, 0x11D3C, 0x11D3D, 0x11D67, 0x11D68, 0x11D90, 0x11D91, 0x11FB0, 0x16FF0, 0x16FF1, 0x1AFFD, 0x1AFFE, 0x1B132, 0x1B155, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB, 0x1D546, 0x1E023, 0x1E024, 0x1E08F, 0x1E14E, 0x1E14F, 0x1E2FF, 0x1E7ED, 0x1E7EE, 0x1E95E, 0x1E95F, 0x1EE21, 0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, 0x1EE42, 0x1EE47, 0x1EE49, 0x1EE4B, 0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, 0x1EE5B, 0x1EE5D, 0x1EE5F, 0x1EE61, 0x1EE62, 0x1EE64, 0x1EE7E, 0x1EEF0, 0x1EEF1, 0x1F250, 0x1F251, 0x1F7F0, 0x1F8B0, 0x1F8B1 #endif }; #define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr)) /* * End of auto-generated Unicode character ranges declarations. */ #define CH NOCELT /* - element - map collating-element name to celt ^ static celt element(struct vars *, const chr *, const chr *); */ static celt element( struct vars *v, /* context */ const chr *startp, /* points to start of name */ const chr *endp) /* points just past end of name */ { const struct cname *cn; size_t len; Tcl_DString ds; const char *np; /* * Generic: one-chr names stand for themselves. */ assert(startp < endp); len = endp - startp; if (len == 1) { return *startp; } NOTE(REG_ULOCALE); /* * Search table. */ Tcl_DStringInit(&ds); np = Tcl_UniCharToUtfDString(startp, (int)len, &ds); for (cn=cnames; cn->name!=NULL; cn++) { if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) { break; /* NOTE BREAK OUT */ } } Tcl_DStringFree(&ds); if (cn->name != NULL) { return CHR(cn->code); } /* * Couldn't find it. */ ERR(REG_ECOLLATE); return 0; } /* - range - supply cvec for a range, including legality check ^ static struct cvec *range(struct vars *, celt, celt, int); */ static struct cvec * range( struct vars *v, /* context */ celt a, /* range start */ celt b, /* range end, might equal a */ int cases) /* case-independent? */ { int nchrs; struct cvec *cv; celt c, lc, uc, tc; if (a != b && !before(a, b)) { ERR(REG_ERANGE); return NULL; } if (!cases) { /* easy version */ cv = getcvec(v, 0, 1); NOERRN(); addrange(cv, a, b); return cv; } /* * When case-independent, it's hard to decide when cvec ranges are usable, * so for now at least, we won't try. We allocate enough space for two * case variants plus a little extra for the two title case variants. */ nchrs = (b - a + 1)*2 + 4; cv = getcvec(v, nchrs, 0); NOERRN(); for (c=a; c<=b; c++) { addchr(cv, c); lc = Tcl_UniCharToLower((chr)c); uc = Tcl_UniCharToUpper((chr)c); tc = Tcl_UniCharToTitle((chr)c); if (c != lc) { addchr(cv, lc); } if (c != uc) { addchr(cv, uc); } if (c != tc && tc != uc) { addchr(cv, tc); } } return cv; } /* - before - is celt x before celt y, for purposes of range legality? ^ static int before(celt, celt); */ static int /* predicate */ before( celt x, celt y) /* collating elements */ { if (x < y) { return 1; } return 0; } /* - eclass - supply cvec for an equivalence class * Must include case counterparts on request. ^ static struct cvec *eclass(struct vars *, celt, int); */ static struct cvec * eclass( struct vars *v, /* context */ celt c, /* Collating element representing the * equivalence class. */ int cases) /* all cases? */ { struct cvec *cv; /* * Crude fake equivalence class for testing. */ if ((v->cflags®_FAKE) && c == 'x') { cv = getcvec(v, 4, 0); addchr(cv, (chr)'x'); addchr(cv, (chr)'y'); if (cases) { addchr(cv, (chr)'X'); addchr(cv, (chr)'Y'); } return cv; } /* * Otherwise, none. */ if (cases) { return allcases(v, c); } cv = getcvec(v, 1, 0); assert(cv != NULL); addchr(cv, (chr)c); return cv; } /* - cclass - supply cvec for a character class * Must include case counterparts on request. ^ static struct cvec *cclass(struct vars *, const chr *, const chr *, int); */ static struct cvec * cclass( struct vars *v, /* context */ const chr *startp, /* where the name starts */ const chr *endp, /* just past the end of the name */ int cases) /* case-independent? */ { size_t len; struct cvec *cv = NULL; Tcl_DString ds; const char *np; const char *const *namePtr; int i, index; /* * The following arrays define the valid character class names. */ static const char *const classNames[] = { "alnum", "alpha", "ascii", "blank", "cntrl", "digit", "graph", "lower", "print", "punct", "space", "upper", "xdigit", NULL }; enum classes { CC_ALNUM, CC_ALPHA, CC_ASCII, CC_BLANK, CC_CNTRL, CC_DIGIT, CC_GRAPH, CC_LOWER, CC_PRINT, CC_PUNCT, CC_SPACE, CC_UPPER, CC_XDIGIT }; /* * Extract the class name */ len = endp - startp; Tcl_DStringInit(&ds); np = Tcl_UniCharToUtfDString(startp, (int)len, &ds); /* * Map the name to the corresponding enumerated value. */ index = -1; for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) { if ((strlen(*namePtr) == len) && (strncmp(*namePtr, np, len) == 0)) { index = i; break; } } Tcl_DStringFree(&ds); if (index == -1) { ERR(REG_ECTYPE); return NULL; } /* * Remap lower and upper to alpha if the match is case insensitive. */ if (cases && ((index == CC_LOWER) || (index == CC_UPPER))) { index = CC_ALNUM; } /* * Now compute the character class contents. */ switch((enum classes) index) { case CC_ALNUM: cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE); if (cv) { for (i=0 ; (size_t)i 0; len--, x++, y++) { if ((*x!=*y) && (Tcl_UniCharToLower(*x) != Tcl_UniCharToLower(*y))) { return 1; } } return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regc_nfa.c0000644000175000017500000024456114554262142015202 0ustar sergeisergei/* * NFA utilities. * This file is #included by regcomp.c. * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * One or two things that technically ought to be in here are actually in * color.c, thanks to some incestuous relationships in the color chains. */ #define NISERR() VISERR(nfa->v) #define NERR(e) VERR(nfa->v, (e)) #define STACK_TOO_DEEP(x) (0) #define CANCEL_REQUESTED(x) (0) #define REG_CANCEL 777 /* - newnfa - set up an NFA ^ static struct nfa *newnfa(struct vars *, struct colormap *, struct nfa *); */ static struct nfa * /* the NFA, or NULL */ newnfa( struct vars *v, struct colormap *cm, struct nfa *parent) /* NULL if primary NFA */ { struct nfa *nfa; nfa = (struct nfa *) MALLOC(sizeof(struct nfa)); if (nfa == NULL) { ERR(REG_ESPACE); return NULL; } nfa->states = NULL; nfa->slast = NULL; nfa->free = NULL; nfa->nstates = 0; nfa->cm = cm; nfa->v = v; nfa->bos[0] = nfa->bos[1] = COLORLESS; nfa->eos[0] = nfa->eos[1] = COLORLESS; nfa->parent = parent; /* Precedes newfstate so parent is valid. */ nfa->post = newfstate(nfa, '@'); /* number 0 */ nfa->pre = newfstate(nfa, '>'); /* number 1 */ nfa->init = newstate(nfa); /* May become invalid later. */ nfa->final = newstate(nfa); if (ISERR()) { freenfa(nfa); return NULL; } rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->pre, nfa->init); newarc(nfa, '^', 1, nfa->pre, nfa->init); newarc(nfa, '^', 0, nfa->pre, nfa->init); rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->final, nfa->post); newarc(nfa, '$', 1, nfa->final, nfa->post); newarc(nfa, '$', 0, nfa->final, nfa->post); if (ISERR()) { freenfa(nfa); return NULL; } return nfa; } /* - freenfa - free an entire NFA ^ static void freenfa(struct nfa *); */ static void freenfa( struct nfa *nfa) { struct state *s; while ((s = nfa->states) != NULL) { s->nins = s->nouts = 0; /* don't worry about arcs */ freestate(nfa, s); } while ((s = nfa->free) != NULL) { nfa->free = s->next; destroystate(nfa, s); } nfa->slast = NULL; nfa->nstates = -1; nfa->pre = NULL; nfa->post = NULL; FREE(nfa); } /* - newstate - allocate an NFA state, with zero flag value ^ static struct state *newstate(struct nfa *); */ static struct state * /* NULL on error */ newstate( struct nfa *nfa) { struct state *s; if (nfa->free != NULL) { s = nfa->free; nfa->free = s->next; } else { if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) { NERR(REG_ETOOBIG); return NULL; } s = (struct state *) MALLOC(sizeof(struct state)); if (s == NULL) { NERR(REG_ESPACE); return NULL; } nfa->v->spaceused += sizeof(struct state); s->oas.next = NULL; s->free = NULL; s->noas = 0; } assert(nfa->nstates >= 0); s->no = nfa->nstates++; s->flag = 0; if (nfa->states == NULL) { nfa->states = s; } s->nins = 0; s->ins = NULL; s->nouts = 0; s->outs = NULL; s->tmp = NULL; s->next = NULL; if (nfa->slast != NULL) { assert(nfa->slast->next == NULL); nfa->slast->next = s; } s->prev = nfa->slast; nfa->slast = s; return s; } /* - newfstate - allocate an NFA state with a specified flag value ^ static struct state *newfstate(struct nfa *, int flag); */ static struct state * /* NULL on error */ newfstate( struct nfa *nfa, int flag) { struct state *s; s = newstate(nfa); if (s != NULL) { s->flag = (char) flag; } return s; } /* - dropstate - delete a state's inarcs and outarcs and free it ^ static void dropstate(struct nfa *, struct state *); */ static void dropstate( struct nfa *nfa, struct state *s) { struct arc *a; while ((a = s->ins) != NULL) { freearc(nfa, a); } while ((a = s->outs) != NULL) { freearc(nfa, a); } freestate(nfa, s); } /* - freestate - free a state, which has no in-arcs or out-arcs ^ static void freestate(struct nfa *, struct state *); */ static void freestate( struct nfa *nfa, struct state *s) { assert(s != NULL); assert(s->nins == 0 && s->nouts == 0); s->no = FREESTATE; s->flag = 0; if (s->next != NULL) { s->next->prev = s->prev; } else { assert(s == nfa->slast); nfa->slast = s->prev; } if (s->prev != NULL) { s->prev->next = s->next; } else { assert(s == nfa->states); nfa->states = s->next; } s->prev = NULL; s->next = nfa->free; /* don't delete it, put it on the free list */ nfa->free = s; } /* - destroystate - really get rid of an already-freed state ^ static void destroystate(struct nfa *, struct state *); */ static void destroystate( struct nfa *nfa, struct state *s) { struct arcbatch *ab; struct arcbatch *abnext; assert(s->no == FREESTATE); for (ab=s->oas.next ; ab!=NULL ; ab=abnext) { abnext = ab->next; FREE(ab); nfa->v->spaceused -= sizeof(struct arcbatch); } s->ins = NULL; s->outs = NULL; s->next = NULL; FREE(s); nfa->v->spaceused -= sizeof(struct state); } /* - newarc - set up a new arc within an NFA ^ static void newarc(struct nfa *, int, pcolor, struct state *, ^ struct state *); */ /* * This function checks to make sure that no duplicate arcs are created. * In general we never want duplicates. */ static void newarc( struct nfa *nfa, int t, pcolor co, struct state *from, struct state *to) { struct arc *a; assert(from != NULL && to != NULL); /* check for duplicate arc, using whichever chain is shorter */ if (from->nouts <= to->nins) { for (a = from->outs; a != NULL; a = a->outchain) { if (a->to == to && a->co == co && a->type == t) { return; } } } else { for (a = to->ins; a != NULL; a = a->inchain) { if (a->from == from && a->co == co && a->type == t) { return; } } } /* no dup, so create the arc */ createarc(nfa, t, co, from, to); } /* * createarc - create a new arc within an NFA * * This function must *only* be used after verifying that there is no existing * identical arc (same type/color/from/to). */ static void createarc( struct nfa * nfa, int t, pcolor co, struct state * from, struct state * to) { struct arc *a; /* the arc is physically allocated within its from-state */ a = allocarc(nfa, from); if (NISERR()) { return; } assert(a != NULL); a->type = t; a->co = (color) co; a->to = to; a->from = from; /* * Put the new arc on the beginning, not the end, of the chains; it's * simpler here, and freearc() is the same cost either way. See also the * logic in moveins() and its cohorts, as well as fixempties(). */ a->inchain = to->ins; a->inchainRev = NULL; if (to->ins) { to->ins->inchainRev = a; } to->ins = a; a->outchain = from->outs; a->outchainRev = NULL; if (from->outs) { from->outs->outchainRev = a; } from->outs = a; from->nouts++; to->nins++; if (COLORED(a) && nfa->parent == NULL) { colorchain(nfa->cm, a); } } /* - allocarc - allocate a new out-arc within a state ^ static struct arc *allocarc(struct nfa *, struct state *); */ static struct arc * /* NULL for failure */ allocarc( struct nfa *nfa, struct state *s) { struct arc *a; /* * Shortcut */ if (s->free == NULL && s->noas < ABSIZE) { a = &s->oas.a[s->noas]; s->noas++; return a; } /* * if none at hand, get more */ if (s->free == NULL) { struct arcbatch *newAb; int i; if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) { NERR(REG_ETOOBIG); return NULL; } newAb = (struct arcbatch *) MALLOC(sizeof(struct arcbatch)); if (newAb == NULL) { NERR(REG_ESPACE); return NULL; } nfa->v->spaceused += sizeof(struct arcbatch); newAb->next = s->oas.next; s->oas.next = newAb; for (i=0 ; ia[i].type = 0; newAb->a[i].freechain = &newAb->a[i+1]; } newAb->a[ABSIZE-1].freechain = NULL; s->free = &newAb->a[0]; } assert(s->free != NULL); a = s->free; s->free = a->freechain; return a; } /* - freearc - free an arc ^ static void freearc(struct nfa *, struct arc *); */ static void freearc( struct nfa *nfa, struct arc *victim) { struct state *from = victim->from; struct state *to = victim->to; struct arc *predecessor; assert(victim->type != 0); /* * Take it off color chain if necessary. */ if (COLORED(victim) && nfa->parent == NULL) { uncolorchain(nfa->cm, victim); } /* * Take it off source's out-chain. */ assert(from != NULL); predecessor = victim->outchainRev; if (predecessor == NULL) { assert(from->outs == victim); from->outs = victim->outchain; } else { assert(predecessor->outchain == victim); predecessor->outchain = victim->outchain; } if (victim->outchain != NULL) { assert(victim->outchain->outchainRev == victim); victim->outchain->outchainRev = predecessor; } from->nouts--; /* * Take it off target's in-chain. */ assert(to != NULL); predecessor = victim->inchainRev; if (predecessor == NULL) { assert(to->ins == victim); to->ins = victim->inchain; } else { assert(predecessor->inchain == victim); predecessor->inchain = victim->inchain; } if (victim->inchain != NULL) { assert(victim->inchain->inchainRev == victim); victim->inchain->inchainRev = predecessor; } to->nins--; /* * Clean up and place on from-state's free list. */ victim->type = 0; victim->from = NULL; /* precautions... */ victim->to = NULL; victim->inchain = NULL; victim->inchainRev = NULL; victim->outchain = NULL; victim->outchainRev = NULL; victim->freechain = from->free; from->free = victim; } /* * changearctarget - flip an arc to have a different to state * * Caller must have verified that there is no preexisting duplicate arc. * * Note that because we store arcs in their from state, we can't easily have * a similar changearcsource function. */ static void changearctarget(struct arc * a, struct state * newto) { struct state *oldto = a->to; struct arc *predecessor; assert(oldto != newto); /* take it off old target's in-chain */ assert(oldto != NULL); predecessor = a->inchainRev; if (predecessor == NULL) { assert(oldto->ins == a); oldto->ins = a->inchain; } else { assert(predecessor->inchain == a); predecessor->inchain = a->inchain; } if (a->inchain != NULL) { assert(a->inchain->inchainRev == a); a->inchain->inchainRev = predecessor; } oldto->nins--; a->to = newto; /* prepend it to new target's in-chain */ a->inchain = newto->ins; a->inchainRev = NULL; if (newto->ins) { newto->ins->inchainRev = a; } newto->ins = a; newto->nins++; } /* - hasnonemptyout - Does state have a non-EMPTY out arc? ^ static int hasnonemptyout(struct state *); */ static int hasnonemptyout( struct state *s) { struct arc *a; for (a = s->outs; a != NULL; a = a->outchain) { if (a->type != EMPTY) { return 1; } } return 0; } /* - findarc - find arc, if any, from given source with given type and color * If there is more than one such arc, the result is random. ^ static struct arc *findarc(struct state *, int, pcolor); */ static struct arc * findarc( struct state *s, int type, pcolor co) { struct arc *a; for (a=s->outs ; a!=NULL ; a=a->outchain) { if (a->type == type && a->co == co) { return a; } } return NULL; } /* - cparc - allocate a new arc within an NFA, copying details from old one ^ static void cparc(struct nfa *, struct arc *, struct state *, ^ struct state *); */ static void cparc( struct nfa *nfa, struct arc *oa, struct state *from, struct state *to) { newarc(nfa, oa->type, oa->co, from, to); } /* * sortins - sort the in arcs of a state by from/color/type */ static void sortins( struct nfa * nfa, struct state * s) { struct arc **sortarray; struct arc *a; int n = s->nins; int i; if (n <= 1) { return; /* nothing to do */ } /* make an array of arc pointers ... */ sortarray = (struct arc **) MALLOC(n * sizeof(struct arc *)); if (sortarray == NULL) { NERR(REG_ESPACE); return; } i = 0; for (a = s->ins; a != NULL; a = a->inchain) { sortarray[i++] = a; } assert(i == n); /* ... sort the array */ qsort(sortarray, n, sizeof(struct arc *), sortins_cmp); /* ... and rebuild arc list in order */ /* it seems worth special-casing first and last items to simplify loop */ a = sortarray[0]; s->ins = a; a->inchain = sortarray[1]; a->inchainRev = NULL; for (i = 1; i < n - 1; i++) { a = sortarray[i]; a->inchain = sortarray[i + 1]; a->inchainRev = sortarray[i - 1]; } a = sortarray[i]; a->inchain = NULL; a->inchainRev = sortarray[i - 1]; FREE(sortarray); } static int sortins_cmp( const void *a, const void *b) { const struct arc *aa = *((const struct arc * const *) a); const struct arc *bb = *((const struct arc * const *) b); /* we check the fields in the order they are most likely to be different */ if (aa->from->no < bb->from->no) { return -1; } if (aa->from->no > bb->from->no) { return 1; } if (aa->co < bb->co) { return -1; } if (aa->co > bb->co) { return 1; } if (aa->type < bb->type) { return -1; } if (aa->type > bb->type) { return 1; } return 0; } /* * sortouts - sort the out arcs of a state by to/color/type */ static void sortouts( struct nfa * nfa, struct state * s) { struct arc **sortarray; struct arc *a; int n = s->nouts; int i; if (n <= 1) { return; /* nothing to do */ } /* make an array of arc pointers ... */ sortarray = (struct arc **) MALLOC(n * sizeof(struct arc *)); if (sortarray == NULL) { NERR(REG_ESPACE); return; } i = 0; for (a = s->outs; a != NULL; a = a->outchain) { sortarray[i++] = a; } assert(i == n); /* ... sort the array */ qsort(sortarray, n, sizeof(struct arc *), sortouts_cmp); /* ... and rebuild arc list in order */ /* it seems worth special-casing first and last items to simplify loop */ a = sortarray[0]; s->outs = a; a->outchain = sortarray[1]; a->outchainRev = NULL; for (i = 1; i < n - 1; i++) { a = sortarray[i]; a->outchain = sortarray[i + 1]; a->outchainRev = sortarray[i - 1]; } a = sortarray[i]; a->outchain = NULL; a->outchainRev = sortarray[i - 1]; FREE(sortarray); } static int sortouts_cmp( const void *a, const void *b) { const struct arc *aa = *((const struct arc * const *) a); const struct arc *bb = *((const struct arc * const *) b); /* we check the fields in the order they are most likely to be different */ if (aa->to->no < bb->to->no) { return -1; } if (aa->to->no > bb->to->no) { return 1; } if (aa->co < bb->co) { return -1; } if (aa->co > bb->co) { return 1; } if (aa->type < bb->type) { return -1; } if (aa->type > bb->type) { return 1; } return 0; } /* * Common decision logic about whether to use arc-by-arc operations or * sort/merge. If there's just a few source arcs we cannot recoup the * cost of sorting the destination arc list, no matter how large it is. * Otherwise, limit the number of arc-by-arc comparisons to about 1000 * (a somewhat arbitrary choice, but the breakeven point would probably * be machine dependent anyway). */ #define BULK_ARC_OP_USE_SORT(nsrcarcs, ndestarcs) \ ((nsrcarcs) < 4 ? 0 : ((nsrcarcs) > 32 || (ndestarcs) > 32)) /* - moveins - move all in arcs of a state to another state * You might think this could be done better by just updating the * existing arcs, and you would be right if it weren't for the need * for duplicate suppression, which makes it easier to just make new * ones to exploit the suppression built into newarc. * * However, if we have a whole lot of arcs to deal with, retail duplicate * checks become too slow. In that case we proceed by sorting and merging * the arc lists, and then we can indeed just update the arcs in-place. * ^ static void moveins(struct nfa *, struct state *, struct state *); */ static void moveins( struct nfa *nfa, struct state *oldState, struct state *newState) { assert(oldState != newState); if (!BULK_ARC_OP_USE_SORT(oldState->nins, newState->nins)) { /* With not too many arcs, just do them one at a time */ struct arc *a; while ((a = oldState->ins) != NULL) { cparc(nfa, a, a->from, newState); freearc(nfa, a); } } else { /* * With many arcs, use a sort-merge approach. Note changearctarget() * will put the arc onto the front of newState's chain, so it does not * break our walk through the sorted part of the chain. */ struct arc *oa; struct arc *na; /* * Because we bypass newarc() in this code path, we'd better include a * cancel check. */ if (CANCEL_REQUESTED(nfa->v->re)) { NERR(REG_CANCEL); return; } sortins(nfa, oldState); sortins(nfa, newState); if (NISERR()) { return; /* might have failed to sort */ } oa = oldState->ins; na = newState->ins; while (oa != NULL && na != NULL) { struct arc *a = oa; switch (sortins_cmp(&oa, &na)) { case -1: /* newState does not have anything matching oa */ oa = oa->inchain; /* * Rather than doing createarc+freearc, we can just unlink * and relink the existing arc struct. */ changearctarget(a, newState); break; case 0: /* match, advance in both lists */ oa = oa->inchain; na = na->inchain; /* ... and drop duplicate arc from oldState */ freearc(nfa, a); break; case +1: /* advance only na; oa might have a match later */ na = na->inchain; break; default: assert(NOTREACHED); } } while (oa != NULL) { /* newState does not have anything matching oa */ struct arc *a = oa; oa = oa->inchain; changearctarget(a, newState); } } assert(oldState->nins == 0); assert(oldState->ins == NULL); } /* - copyins - copy in arcs of a state to another state ^ static VOID copyins(struct nfa *, struct state *, struct state *, int); */ static void copyins( struct nfa *nfa, struct state *oldState, struct state *newState) { assert(oldState != newState); if (!BULK_ARC_OP_USE_SORT(oldState->nins, newState->nins)) { /* With not too many arcs, just do them one at a time */ struct arc *a; for (a = oldState->ins; a != NULL; a = a->inchain) { cparc(nfa, a, a->from, newState); } } else { /* * With many arcs, use a sort-merge approach. Note that createarc() * will put new arcs onto the front of newState's chain, so it does * not break our walk through the sorted part of the chain. */ struct arc *oa; struct arc *na; /* * Because we bypass newarc() in this code path, we'd better include a * cancel check. */ if (CANCEL_REQUESTED(nfa->v->re)) { NERR(REG_CANCEL); return; } sortins(nfa, oldState); sortins(nfa, newState); if (NISERR()) { return; /* might have failed to sort */ } oa = oldState->ins; na = newState->ins; while (oa != NULL && na != NULL) { struct arc *a = oa; switch (sortins_cmp(&oa, &na)) { case -1: /* newState does not have anything matching oa */ oa = oa->inchain; createarc(nfa, a->type, a->co, a->from, newState); break; case 0: /* match, advance in both lists */ oa = oa->inchain; na = na->inchain; break; case +1: /* advance only na; oa might have a match later */ na = na->inchain; break; default: assert(NOTREACHED); } } while (oa != NULL) { /* newState does not have anything matching oa */ struct arc *a = oa; oa = oa->inchain; createarc(nfa, a->type, a->co, a->from, newState); } } } /* * mergeins - merge a list of inarcs into a state * * This is much like copyins, but the source arcs are listed in an array, * and are not guaranteed unique. It's okay to clobber the array contents. */ static void mergeins( struct nfa * nfa, struct state * s, struct arc ** arcarray, int arccount) { struct arc *na; int i; int j; if (arccount <= 0) { return; } /* * Because we bypass newarc() in this code path, we'd better include a * cancel check. */ if (CANCEL_REQUESTED(nfa->v->re)) { NERR(REG_CANCEL); return; } /* Sort existing inarcs as well as proposed new ones */ sortins(nfa, s); if (NISERR()) { return; /* might have failed to sort */ } qsort(arcarray, arccount, sizeof(struct arc *), sortins_cmp); /* * arcarray very likely includes dups, so we must eliminate them. (This * could be folded into the next loop, but it's not worth the trouble.) */ j = 0; for (i = 1; i < arccount; i++) { switch (sortins_cmp(&arcarray[j], &arcarray[i])) { case -1: /* non-dup */ arcarray[++j] = arcarray[i]; break; case 0: /* dup */ break; default: /* trouble */ assert(NOTREACHED); } } arccount = j + 1; /* * Now merge into s' inchain. Note that createarc() will put new arcs * onto the front of s's chain, so it does not break our walk through the * sorted part of the chain. */ i = 0; na = s->ins; while (i < arccount && na != NULL) { struct arc *a = arcarray[i]; switch (sortins_cmp(&a, &na)) { case -1: /* s does not have anything matching a */ createarc(nfa, a->type, a->co, a->from, s); i++; break; case 0: /* match, advance in both lists */ i++; na = na->inchain; break; case +1: /* advance only na; array might have a match later */ na = na->inchain; break; default: assert(NOTREACHED); } } while (i < arccount) { /* s does not have anything matching a */ struct arc *a = arcarray[i]; createarc(nfa, a->type, a->co, a->from, s); i++; } } /* - moveouts - move all out arcs of a state to another state ^ static void moveouts(struct nfa *, struct state *, struct state *); */ static void moveouts( struct nfa *nfa, struct state *oldState, struct state *newState) { assert(oldState != newState); if (!BULK_ARC_OP_USE_SORT(oldState->nouts, newState->nouts)) { /* With not too many arcs, just do them one at a time */ struct arc *a; while ((a = oldState->outs) != NULL) { cparc(nfa, a, newState, a->to); freearc(nfa, a); } } else { /* * With many arcs, use a sort-merge approach. Note that createarc() * will put new arcs onto the front of newState's chain, so it does * not break our walk through the sorted part of the chain. */ struct arc *oa; struct arc *na; /* * Because we bypass newarc() in this code path, we'd better include a * cancel check. */ if (CANCEL_REQUESTED(nfa->v->re)) { NERR(REG_CANCEL); return; } sortouts(nfa, oldState); sortouts(nfa, newState); if (NISERR()) { return; /* might have failed to sort */ } oa = oldState->outs; na = newState->outs; while (oa != NULL && na != NULL) { struct arc *a = oa; switch (sortouts_cmp(&oa, &na)) { case -1: /* newState does not have anything matching oa */ oa = oa->outchain; createarc(nfa, a->type, a->co, newState, a->to); freearc(nfa, a); break; case 0: /* match, advance in both lists */ oa = oa->outchain; na = na->outchain; /* ... and drop duplicate arc from oldState */ freearc(nfa, a); break; case +1: /* advance only na; oa might have a match later */ na = na->outchain; break; default: assert(NOTREACHED); } } while (oa != NULL) { /* newState does not have anything matching oa */ struct arc *a = oa; oa = oa->outchain; createarc(nfa, a->type, a->co, newState, a->to); freearc(nfa, a); } } assert(oldState->nouts == 0); assert(oldState->outs == NULL); } /* - copyouts - copy out arcs of a state to another state ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int); */ static void copyouts( struct nfa *nfa, struct state *oldState, struct state *newState) { assert(oldState != newState); if (!BULK_ARC_OP_USE_SORT(oldState->nouts, newState->nouts)) { /* With not too many arcs, just do them one at a time */ struct arc *a; for (a = oldState->outs; a != NULL; a = a->outchain) { cparc(nfa, a, newState, a->to); } } else { /* * With many arcs, use a sort-merge approach. Note that createarc() * will put new arcs onto the front of newState's chain, so it does * not break our walk through the sorted part of the chain. */ struct arc *oa; struct arc *na; /* * Because we bypass newarc() in this code path, we'd better include a * cancel check. */ if (CANCEL_REQUESTED(nfa->v->re)) { NERR(REG_CANCEL); return; } sortouts(nfa, oldState); sortouts(nfa, newState); if (NISERR()) { return; /* might have failed to sort */ } oa = oldState->outs; na = newState->outs; while (oa != NULL && na != NULL) { struct arc *a = oa; switch (sortouts_cmp(&oa, &na)) { case -1: /* newState does not have anything matching oa */ oa = oa->outchain; createarc(nfa, a->type, a->co, newState, a->to); break; case 0: /* match, advance in both lists */ oa = oa->outchain; na = na->outchain; break; case +1: /* advance only na; oa might have a match later */ na = na->outchain; break; default: assert(NOTREACHED); } } while (oa != NULL) { /* newState does not have anything matching oa */ struct arc *a = oa; oa = oa->outchain; createarc(nfa, a->type, a->co, newState, a->to); } } } /* - cloneouts - copy out arcs of a state to another state pair, modifying type ^ static void cloneouts(struct nfa *, struct state *, struct state *, ^ struct state *, int); */ static void cloneouts( struct nfa *nfa, struct state *old, struct state *from, struct state *to, int type) { struct arc *a; assert(old != from); for (a=old->outs ; a!=NULL ; a=a->outchain) { newarc(nfa, type, a->co, from, to); } } /* - delsub - delete a sub-NFA, updating subre pointers if necessary * This uses a recursive traversal of the sub-NFA, marking already-seen * states using their tmp pointer. ^ static void delsub(struct nfa *, struct state *, struct state *); */ static void delsub( struct nfa *nfa, struct state *lp, /* the sub-NFA goes from here... */ struct state *rp) /* ...to here, *not* inclusive */ { assert(lp != rp); rp->tmp = rp; /* mark end */ deltraverse(nfa, lp, lp); assert(lp->nouts == 0 && rp->nins == 0); /* did the job */ assert(lp->no != FREESTATE && rp->no != FREESTATE); /* no more */ rp->tmp = NULL; /* unmark end */ lp->tmp = NULL; /* and begin, marked by deltraverse */ } /* - deltraverse - the recursive heart of delsub * This routine's basic job is to destroy all out-arcs of the state. ^ static void deltraverse(struct nfa *, struct state *, struct state *); */ static void deltraverse( struct nfa *nfa, struct state *leftend, struct state *s) { struct arc *a; struct state *to; if (s->nouts == 0) { return; /* nothing to do */ } if (s->tmp != NULL) { return; /* already in progress */ } s->tmp = s; /* mark as in progress */ while ((a = s->outs) != NULL) { to = a->to; deltraverse(nfa, leftend, to); assert(to->nouts == 0 || to->tmp != NULL); freearc(nfa, a); if (to->nins == 0 && to->tmp == NULL) { assert(to->nouts == 0); freestate(nfa, to); } } assert(s->no != FREESTATE); /* we're still here */ assert(s == leftend || s->nins != 0); /* and still reachable */ assert(s->nouts == 0); /* but have no outarcs */ s->tmp = NULL; /* we're done here */ } /* - dupnfa - duplicate sub-NFA * Another recursive traversal, this time using tmp to point to duplicates as * well as mark already-seen states. (You knew there was a reason why it's a * state pointer, didn't you? :-)) ^ static void dupnfa(struct nfa *, struct state *, struct state *, ^ struct state *, struct state *); */ static void dupnfa( struct nfa *nfa, struct state *start, /* duplicate of subNFA starting here */ struct state *stop, /* and stopping here */ struct state *from, /* stringing duplicate from here */ struct state *to) /* to here */ { if (start == stop) { newarc(nfa, EMPTY, 0, from, to); return; } stop->tmp = to; duptraverse(nfa, start, from, 0); /* done, except for clearing out the tmp pointers */ stop->tmp = NULL; cleartraverse(nfa, start); } /* - duptraverse - recursive heart of dupnfa ^ static void duptraverse(struct nfa *, struct state *, struct state *); */ static void duptraverse( struct nfa *nfa, struct state *s, struct state *stmp, /* s's duplicate, or NULL */ int depth) { struct arc *a; if (s->tmp != NULL) { return; /* already done */ } s->tmp = (stmp == NULL) ? newstate(nfa) : stmp; if (s->tmp == NULL) { assert(NISERR()); return; } /* * Arbitrary depth limit. Needs tuning, but this value is sufficient to * make all normal tests (not reg-33.14) pass. */ #ifndef DUPTRAVERSE_MAX_DEPTH #define DUPTRAVERSE_MAX_DEPTH 15000 #endif if (depth++ > DUPTRAVERSE_MAX_DEPTH) { NERR(REG_ESPACE); } for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) { duptraverse(nfa, a->to, NULL, depth); if (NISERR()) { break; } assert(a->to->tmp != NULL); cparc(nfa, a, s->tmp, a->to->tmp); } } /* - cleartraverse - recursive cleanup for algorithms that leave tmp ptrs set ^ static void cleartraverse(struct nfa *, struct state *); */ static void cleartraverse( struct nfa *nfa, struct state *s) { struct arc *a; if (s->tmp == NULL) { return; } s->tmp = NULL; for (a=s->outs ; a!=NULL ; a=a->outchain) { cleartraverse(nfa, a->to); } } /* - specialcolors - fill in special colors for an NFA ^ static void specialcolors(struct nfa *); */ static void specialcolors( struct nfa *nfa) { /* * False colors for BOS, BOL, EOS, EOL */ if (nfa->parent == NULL) { nfa->bos[0] = pseudocolor(nfa->cm); nfa->bos[1] = pseudocolor(nfa->cm); nfa->eos[0] = pseudocolor(nfa->cm); nfa->eos[1] = pseudocolor(nfa->cm); } else { assert(nfa->parent->bos[0] != COLORLESS); nfa->bos[0] = nfa->parent->bos[0]; assert(nfa->parent->bos[1] != COLORLESS); nfa->bos[1] = nfa->parent->bos[1]; assert(nfa->parent->eos[0] != COLORLESS); nfa->eos[0] = nfa->parent->eos[0]; assert(nfa->parent->eos[1] != COLORLESS); nfa->eos[1] = nfa->parent->eos[1]; } } /* - optimize - optimize an NFA ^ static long optimize(struct nfa *, FILE *); */ /* * The main goal of this function is not so much "optimization" (though it * does try to get rid of useless NFA states) as reducing the NFA to a form * the regex executor can handle. The executor, and indeed the cNFA format * that is its input, can only handle PLAIN and LACON arcs. The output of * the regex parser also includes EMPTY (do-nothing) arcs, as well as * ^, $, AHEAD, and BEHIND constraint arcs, which we must get rid of here. * We first get rid of EMPTY arcs and then deal with the constraint arcs. * The hardest part of either job is to get rid of circular loops of the * target arc type. We would have to do that in any case, though, as such a * loop would otherwise allow the executor to cycle through the loop endlessly * without making any progress in the input string. */ static long /* re_info bits */ optimize( struct nfa *nfa, FILE *f) /* for debug output; NULL none */ { int verbose = (f != NULL) ? 1 : 0; if (verbose) { fprintf(f, "\ninitial cleanup:\n"); } cleanup(nfa); /* may simplify situation */ if (verbose) { dumpnfa(nfa, f); } if (verbose) { fprintf(f, "\nempties:\n"); } fixempties(nfa, f); /* get rid of EMPTY arcs */ if (verbose) { fprintf(f, "\nconstraints:\n"); } fixconstraintloops(nfa, f); /* get rid of constraint loops */ pullback(nfa, f); /* pull back constraints backward */ pushfwd(nfa, f); /* push fwd constraints forward */ if (verbose) { fprintf(f, "\nfinal cleanup:\n"); } cleanup(nfa); /* final tidying */ #ifdef REG_DEBUG if (verbose) { dumpnfa(nfa, f); } #endif return analyze(nfa); /* and analysis */ } /* - pullback - pull back constraints backward to eliminate them ^ static void pullback(struct nfa *, FILE *); */ static void pullback( struct nfa *nfa, FILE *f) /* for debug output; NULL none */ { struct state *s; struct state *nexts; struct arc *a; struct arc *nexta; struct state *intermediates; int progress; /* * Find and pull until there are no more. */ do { progress = 0; for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) { nexts = s->next; intermediates = NULL; for (a=s->outs ; a!=NULL && !NISERR() ; a=nexta) { nexta = a->outchain; if (a->type == '^' || a->type == BEHIND) { if (pull(nfa, a, &intermediates)) { progress = 1; } } assert(nexta == NULL || s->no != FREESTATE); } /* clear tmp fields of intermediate states created here */ while (intermediates != NULL) { struct state *ns = intermediates->tmp; intermediates->tmp = NULL; intermediates = ns; } /* if s is now useless, get rid of it */ if ((s->nins == 0 || s->nouts == 0) && !s->flag) { dropstate(nfa, s); } } if (progress && f != NULL) { dumpnfa(nfa, f); } } while (progress && !NISERR()); if (NISERR()) { return; } /* * Any ^ constraints we were able to pull to the start state can now be * replaced by PLAIN arcs referencing the BOS or BOL colors. There should * be no other ^ or BEHIND arcs left in the NFA, though we do not check * that here (compact() will fail if so). */ for (a=nfa->pre->outs ; a!=NULL ; a=nexta) { nexta = a->outchain; if (a->type == '^') { assert(a->co == 0 || a->co == 1); newarc(nfa, PLAIN, nfa->bos[a->co], a->from, a->to); freearc(nfa, a); } } } /* - pull - pull a back constraint backward past its source state * * Returns 1 if successful (which it always is unless the source is the * start state or we have an internal error), 0 if nothing happened. * * A significant property of this function is that it deletes no preexisting * states, and no outarcs of the constraint's from state other than the given * constraint arc. This makes the loops in pullback() safe, at the cost that * we may leave useless states behind. Therefore, we leave it to pullback() * to delete such states. * * If the from state has multiple back-constraint outarcs, and/or multiple * compatible constraint inarcs, we only need to create one new intermediate * state per combination of predecessor and successor states. *intermediates * points to a list of such intermediate states for this from state (chained * through their tmp fields). ^ static int pull(struct nfa *, struct arc *); */ static int pull( struct nfa *nfa, struct arc *con, struct state **intermediates) { struct state *from = con->from; struct state *to = con->to; struct arc *a; struct arc *nexta; struct state *s; assert(from != to); /* should have gotten rid of this earlier */ if (from->flag) { /* can't pull back beyond start */ return 0; } if (from->nins == 0) { /* unreachable */ freearc(nfa, con); return 1; } /* * First, clone from state if necessary to avoid other outarcs. This may * seem wasteful, but it simplifies the logic, and we'll get rid of the * clone state again at the bottom. */ if (from->nouts > 1) { s = newstate(nfa); if (NISERR()) { return 0; } copyins(nfa, from, s); /* duplicate inarcs */ cparc(nfa, con, s, to); /* move constraint arc */ freearc(nfa, con); if (NISERR()) { return 0; } from = s; con = from->outs; } assert(from->nouts == 1); /* * Propagate the constraint into the from state's inarcs. */ for (a=from->ins ; a!=NULL && !NISERR(); a=nexta) { nexta = a->inchain; switch (combine(con, a)) { case INCOMPATIBLE: /* destroy the arc */ freearc(nfa, a); break; case SATISFIED: /* no action needed */ break; case COMPATIBLE: /* swap the two arcs, more or less */ /* need an intermediate state, but might have one already */ for (s = *intermediates; s != NULL; s = s->tmp) { assert(s->nins > 0 && s->nouts > 0); if (s->ins->from == a->from && s->outs->to == to) { break; } } if (s == NULL) { s = newstate(nfa); if (NISERR()) { return 0; } s->tmp = *intermediates; *intermediates = s; } cparc(nfa, con, a->from, s); cparc(nfa, a, s, to); freearc(nfa, a); break; default: assert(NOTREACHED); break; } } /* * Remaining inarcs, if any, incorporate the constraint. */ moveins(nfa, from, to); freearc(nfa, con); /* from state is now useless, but we leave it to pullback() to clean up */ return 1; } /* - pushfwd - push forward constraints forward to eliminate them ^ static void pushfwd(struct nfa *, FILE *); */ static void pushfwd( struct nfa *nfa, FILE *f) /* for debug output; NULL none */ { struct state *s; struct state *nexts; struct arc *a; struct arc *nexta; struct state *intermediates; int progress; /* * Find and push until there are no more. */ do { progress = 0; for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) { nexts = s->next; intermediates = NULL; for (a = s->ins; a != NULL && !NISERR(); a = nexta) { nexta = a->inchain; if (a->type == '$' || a->type == AHEAD) { if (push(nfa, a, &intermediates)) { progress = 1; } } } /* clear tmp fields of intermediate states created here */ while (intermediates != NULL) { struct state *ns = intermediates->tmp; intermediates->tmp = NULL; intermediates = ns; } /* if s is now useless, get rid of it */ if ((s->nins == 0 || s->nouts == 0) && !s->flag) { dropstate(nfa, s); } } if (progress && f != NULL) { dumpnfa(nfa, f); } } while (progress && !NISERR()); if (NISERR()) { return; } /* * Any $ constraints we were able to push to the post state can now be * replaced by PLAIN arcs referencing the EOS or EOL colors. There should * be no other $ or AHEAD arcs left in the NFA, though we do not check * that here (compact() will fail if so). */ for (a = nfa->post->ins; a != NULL; a = nexta) { nexta = a->inchain; if (a->type == '$') { assert(a->co == 0 || a->co == 1); newarc(nfa, PLAIN, nfa->eos[a->co], a->from, a->to); freearc(nfa, a); } } } /* - push - push a forward constraint forward past its destination state * * Returns 1 if successful (which it always is unless the destination is the * post state or we have an internal error), 0 if nothing happened. * * A significant property of this function is that it deletes no preexisting * states, and no inarcs of the constraint's to state other than the given * constraint arc. This makes the loops in pushfwd() safe, at the cost that * we may leave useless states behind. Therefore, we leave it to pushfwd() * to delete such states. * * If the to state has multiple forward-constraint inarcs, and/or multiple * compatible constraint outarcs, we only need to create one new intermediate * state per combination of predecessor and successor states. *intermediates * points to a list of such intermediate states for this to state (chained * through their tmp fields). ^ static int push(struct nfa *, struct arc *); */ static int push( struct nfa *nfa, struct arc *con, struct state **intermediates) { struct state *from = con->from; struct state *to = con->to; struct arc *a; struct arc *nexta; struct state *s; assert(to != from); /* should have gotten rid of this earlier */ if (to->flag) { /* can't push forward beyond end */ return 0; } if (to->nouts == 0) { /* dead end */ freearc(nfa, con); return 1; } /* * First, clone to state if necessary to avoid other inarcs. This may * seem wasteful, but it simplifies the logic, and we'll get rid of the * clone state again at the bottom. */ if (to->nins > 1) { s = newstate(nfa); if (NISERR()) { return 0; } copyouts(nfa, to, s); /* duplicate outarcs */ cparc(nfa, con, from, s); /* move constraint arc */ freearc(nfa, con); if (NISERR()) { return 0; } to = s; con = to->ins; } assert(to->nins == 1); /* * Propagate the constraint into the to state's outarcs. */ for (a = to->outs; a != NULL && !NISERR(); a = nexta) { nexta = a->outchain; switch (combine(con, a)) { case INCOMPATIBLE: /* destroy the arc */ freearc(nfa, a); break; case SATISFIED: /* no action needed */ break; case COMPATIBLE: /* swap the two arcs, more or less */ /* need an intermediate state, but might have one already */ for (s = *intermediates; s != NULL; s = s->tmp) { assert(s->nins > 0 && s->nouts > 0); if (s->ins->from == from && s->outs->to == a->to) { break; } } if (s == NULL) { s = newstate(nfa); if (NISERR()) { return 0; } s->tmp = *intermediates; *intermediates = s; } cparc(nfa, con, s, a->to); cparc(nfa, a, from, s); freearc(nfa, a); break; default: assert(NOTREACHED); break; } } /* * Remaining outarcs, if any, incorporate the constraint. */ moveouts(nfa, to, from); freearc(nfa, con); /* to state is now useless, but we leave it to pushfwd() to clean up */ return 1; } /* - combine - constraint lands on an arc, what happens? ^ #def INCOMPATIBLE 1 // destroys arc ^ #def SATISFIED 2 // constraint satisfied ^ #def COMPATIBLE 3 // compatible but not satisfied yet ^ static int combine(struct arc *, struct arc *); */ static int combine( struct arc *con, struct arc *a) { #define CA(ct,at) (((ct)<type, a->type)) { case CA('^', PLAIN): /* newlines are handled separately */ case CA('$', PLAIN): return INCOMPATIBLE; break; case CA(AHEAD, PLAIN): /* color constraints meet colors */ case CA(BEHIND, PLAIN): if (con->co == a->co) { return SATISFIED; } return INCOMPATIBLE; break; case CA('^', '^'): /* collision, similar constraints */ case CA('$', '$'): case CA(AHEAD, AHEAD): case CA(BEHIND, BEHIND): if (con->co == a->co) { /* true duplication */ return SATISFIED; } return INCOMPATIBLE; break; case CA('^', BEHIND): /* collision, dissimilar constraints */ case CA(BEHIND, '^'): case CA('$', AHEAD): case CA(AHEAD, '$'): return INCOMPATIBLE; break; case CA('^', '$'): /* constraints passing each other */ case CA('^', AHEAD): case CA(BEHIND, '$'): case CA(BEHIND, AHEAD): case CA('$', '^'): case CA('$', BEHIND): case CA(AHEAD, '^'): case CA(AHEAD, BEHIND): case CA('^', LACON): case CA(BEHIND, LACON): case CA('$', LACON): case CA(AHEAD, LACON): return COMPATIBLE; break; } assert(NOTREACHED); return INCOMPATIBLE; /* for benefit of blind compilers */ } /* - fixempties - get rid of EMPTY arcs ^ static void fixempties(struct nfa *, FILE *); */ static void fixempties( struct nfa *nfa, FILE *f) /* for debug output; NULL none */ { struct state *s; struct state *s2; struct state *nexts; struct arc *a; struct arc *nexta; int totalinarcs; struct arc **inarcsorig; struct arc **arcarray; int arccount; int prevnins; int nskip; /* * First, get rid of any states whose sole out-arc is an EMPTY, * since they're basically just aliases for their successor. The * parsing algorithm creates enough of these that it's worth * special-casing this. */ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) { nexts = s->next; if (s->flag || s->nouts != 1) { continue; } a = s->outs; assert(a != NULL && a->outchain == NULL); if (a->type != EMPTY) { continue; } if (s != a->to) { moveins(nfa, s, a->to); } dropstate(nfa, s); } /* * Similarly, get rid of any state with a single EMPTY in-arc, by * folding it into its predecessor. */ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) { nexts = s->next; /* Ensure tmp fields are clear for next step */ assert(s->tmp == NULL); if (s->flag || s->nins != 1) { continue; } a = s->ins; assert(a != NULL && a->inchain == NULL); if (a->type != EMPTY) { continue; } if (s != a->from) { moveouts(nfa, s, a->from); } dropstate(nfa, s); } if (NISERR()) { return; } /* * For each remaining NFA state, find all other states from which it is * reachable by a chain of one or more EMPTY arcs. Then generate new arcs * that eliminate the need for each such chain. * * We could replace a chain of EMPTY arcs that leads from a "from" state * to a "to" state either by pushing non-EMPTY arcs forward (linking * directly from "from"'s predecessors to "to") or by pulling them back * (linking directly from "from" to "to"'s successors). We choose to * always do the former; this choice is somewhat arbitrary, but the * approach below requires that we uniformly do one or the other. * * Suppose we have a chain of N successive EMPTY arcs (where N can easily * approach the size of the NFA). All of the intermediate states must * have additional inarcs and outarcs, else they'd have been removed by * the steps above. Assuming their inarcs are mostly not empties, we will * add O(N^2) arcs to the NFA, since a non-EMPTY inarc leading to any one * state in the chain must be duplicated to lead to all its successor * states as well. So there is no hope of doing less than O(N^2) work; * however, we should endeavor to keep the big-O cost from being even * worse than that, which it can easily become without care. In * particular, suppose we were to copy all S1's inarcs forward to S2, and * then also to S3, and then later we consider pushing S2's inarcs forward * to S3. If we include the arcs already copied from S1 in that, we'd be * doing O(N^3) work. (The duplicate-arc elimination built into newarc() * and its cohorts would get rid of the extra arcs, but not without cost.) * * We can avoid this cost by treating only arcs that existed at the start * of this phase as candidates to be pushed forward. To identify those, * we remember the first inarc each state had to start with. We rely on * the fact that newarc() and friends put new arcs on the front of their * to-states' inchains, and that this phase never deletes arcs, so that * the original arcs must be the last arcs in their to-states' inchains. * * So the process here is that, for each state in the NFA, we gather up * all non-EMPTY inarcs of states that can reach the target state via * EMPTY arcs. We then sort, de-duplicate, and merge these arcs into the * target state's inchain. (We can safely use sort-merge for this as long * as we update each state's original-arcs pointer after we add arcs to * it; the sort step of mergeins probably changed the order of the old * arcs.) * * Another refinement worth making is that, because we only add non-EMPTY * arcs during this phase, and all added arcs have the same from-state as * the non-EMPTY arc they were cloned from, we know ahead of time that any * states having only EMPTY outarcs will be useless for lack of outarcs * after we drop the EMPTY arcs. (They cannot gain non-EMPTY outarcs if * they had none to start with.) So we need not bother to update the * inchains of such states at all. */ /* Remember the states' first original inarcs */ /* ... and while at it, count how many old inarcs there are altogether */ inarcsorig = (struct arc **) MALLOC(nfa->nstates * sizeof(struct arc *)); if (inarcsorig == NULL) { NERR(REG_ESPACE); return; } totalinarcs = 0; for (s = nfa->states; s != NULL; s = s->next) { inarcsorig[s->no] = s->ins; totalinarcs += s->nins; } /* * Create a workspace for accumulating the inarcs to be added to the * current target state. totalinarcs is probably a considerable * overestimate of the space needed, but the NFA is unlikely to be large * enough at this point to make it worth being smarter. */ arcarray = (struct arc **) MALLOC(totalinarcs * sizeof(struct arc *)); if (arcarray == NULL) { NERR(REG_ESPACE); FREE(inarcsorig); return; } /* And iterate over the target states */ for (s = nfa->states; s != NULL && !NISERR(); s = s->next) { /* Ignore target states without non-EMPTY outarcs, per note above */ if (!s->flag && !hasnonemptyout(s)) { continue; } /* Find predecessor states and accumulate their original inarcs */ arccount = 0; for (s2 = emptyreachable(nfa, s, s, inarcsorig); s2 != s; s2 = nexts) { /* Add s2's original inarcs to arcarray[], but ignore empties */ for (a = inarcsorig[s2->no]; a != NULL; a = a->inchain) { if (a->type != EMPTY) { arcarray[arccount++] = a; } } /* Reset the tmp fields as we walk back */ nexts = s2->tmp; s2->tmp = NULL; } s->tmp = NULL; assert(arccount <= totalinarcs); /* Remember how many original inarcs this state has */ prevnins = s->nins; /* Add non-duplicate inarcs to target state */ mergeins(nfa, s, arcarray, arccount); /* Now we must update the state's inarcsorig pointer */ nskip = s->nins - prevnins; a = s->ins; while (nskip-- > 0) { a = a->inchain; } inarcsorig[s->no] = a; } FREE(arcarray); FREE(inarcsorig); if (NISERR()) { return; } /* * Remove all the EMPTY arcs, since we don't need them anymore. */ for (s = nfa->states; s != NULL; s = s->next) { for (a = s->outs; a != NULL; a = nexta) { nexta = a->outchain; if (a->type == EMPTY) { freearc(nfa, a); } } } /* * And remove any states that have become useless. (This cleanup is * not very thorough, and would be even less so if we tried to * combine it with the previous step; but cleanup() will take care * of anything we miss.) */ for (s = nfa->states; s != NULL; s = nexts) { nexts = s->next; if ((s->nins == 0 || s->nouts == 0) && !s->flag) { dropstate(nfa, s); } } if (f != NULL) { dumpnfa(nfa, f); } } /* - emptyreachable - recursively find all states that can reach s by EMPTY arcs * The return value is the last such state found. Its tmp field links back * to the next-to-last such state, and so on back to s, so that all these * states can be located without searching the whole NFA. * * Since this is only used in fixempties(), we pass in the inarcsorig[] array * maintained by that function. This lets us skip over all new inarcs, which * are certainly not EMPTY arcs. * * The maximum recursion depth here is equal to the length of the longest * loop-free chain of EMPTY arcs, which is surely no more than the size of * the NFA, and in practice will be less than that. ^ static struct state *emptyreachable(struct state *, struct state *); */ static struct state * emptyreachable( struct nfa *nfa, struct state *s, struct state *lastfound, struct arc **inarcsorig) { struct arc *a; s->tmp = lastfound; lastfound = s; for (a = inarcsorig[s->no]; a != NULL; a = a->inchain) { if (a->type == EMPTY && a->from->tmp == NULL) { lastfound = emptyreachable(nfa, a->from, lastfound, inarcsorig); } } return lastfound; } /* * isconstraintarc - detect whether an arc is of a constraint type */ static inline int isconstraintarc(struct arc * a) { switch (a->type) { case '^': case '$': case BEHIND: case AHEAD: case LACON: return 1; } return 0; } /* * hasconstraintout - does state have a constraint out arc? */ static int hasconstraintout(struct state * s) { struct arc *a; for (a = s->outs; a != NULL; a = a->outchain) { if (isconstraintarc(a)) { return 1; } } return 0; } /* * fixconstraintloops - get rid of loops containing only constraint arcs * * A loop of states that contains only constraint arcs is useless, since * passing around the loop represents no forward progress. Moreover, it * would cause infinite looping in pullback/pushfwd, so we need to get rid * of such loops before doing that. */ static void fixconstraintloops( struct nfa * nfa, FILE *f) /* for debug output; NULL none */ { struct state *s; struct state *nexts; struct arc *a; struct arc *nexta; int hasconstraints; /* * In the trivial case of a state that loops to itself, we can just drop * the constraint arc altogether. This is worth special-casing because * such loops are far more common than loops containing multiple states. * While we're at it, note whether any constraint arcs survive. */ hasconstraints = 0; for (s = nfa->states; s != NULL && !NISERR(); s = nexts) { nexts = s->next; /* while we're at it, ensure tmp fields are clear for next step */ assert(s->tmp == NULL); for (a = s->outs; a != NULL && !NISERR(); a = nexta) { nexta = a->outchain; if (isconstraintarc(a)) { if (a->to == s) { freearc(nfa, a); } else { hasconstraints = 1; } } } /* If we removed all the outarcs, the state is useless. */ if (s->nouts == 0 && !s->flag) { dropstate(nfa, s); } } /* Nothing to do if no remaining constraint arcs */ if (NISERR() || !hasconstraints) { return; } /* * Starting from each remaining NFA state, search outwards for a * constraint loop. If we find a loop, break the loop, then start the * search over. (We could possibly retain some state from the first scan, * but it would complicate things greatly, and multi-state constraint * loops are rare enough that it's not worth optimizing the case.) */ restart: for (s = nfa->states; s != NULL && !NISERR(); s = s->next) { if (findconstraintloop(nfa, s)) { goto restart; } } if (NISERR()) { return; } /* * Now remove any states that have become useless. (This cleanup is not * very thorough, and would be even less so if we tried to combine it with * the previous step; but cleanup() will take care of anything we miss.) * * Because findconstraintloop intentionally doesn't reset all tmp fields, * we have to clear them after it's done. This is a convenient place to * do that, too. */ for (s = nfa->states; s != NULL; s = nexts) { nexts = s->next; s->tmp = NULL; if ((s->nins == 0 || s->nouts == 0) && !s->flag) { dropstate(nfa, s); } } if (f != NULL) { dumpnfa(nfa, f); } } /* * findconstraintloop - recursively find a loop of constraint arcs * * If we find a loop, break it by calling breakconstraintloop(), then * return 1; otherwise return 0. * * State tmp fields are guaranteed all NULL on a success return, because * breakconstraintloop does that. After a failure return, any state that * is known not to be part of a loop is marked with s->tmp == s; this allows * us not to have to re-prove that fact on later calls. (This convention is * workable because we already eliminated single-state loops.) * * Note that the found loop doesn't necessarily include the first state we * are called on. Any loop reachable from that state will do. * * The maximum recursion depth here is one more than the length of the longest * loop-free chain of constraint arcs, which is surely no more than the size * of the NFA, and in practice will be a lot less than that. */ static int findconstraintloop(struct nfa * nfa, struct state * s) { struct arc *a; /* Since this is recursive, it could be driven to stack overflow */ if (STACK_TOO_DEEP(nfa->v->re)) { NERR(REG_ETOOBIG); return 1; /* to exit as quickly as possible */ } if (s->tmp != NULL) { /* Already proven uninteresting? */ if (s->tmp == s) { return 0; } /* Found a loop involving s */ breakconstraintloop(nfa, s); /* The tmp fields have been cleaned up by breakconstraintloop */ return 1; } for (a = s->outs; a != NULL; a = a->outchain) { if (isconstraintarc(a)) { struct state *sto = a->to; assert(sto != s); s->tmp = sto; if (findconstraintloop(nfa, sto)) { return 1; } } } /* * If we get here, no constraint loop exists leading out from s. Mark it * with s->tmp == s so we need not rediscover that fact again later. */ s->tmp = s; return 0; } /* * breakconstraintloop - break a loop of constraint arcs * * sinitial is any one member state of the loop. Each loop member's tmp * field links to its successor within the loop. (Note that this function * will reset all the tmp fields to NULL.) * * We can break the loop by, for any one state S1 in the loop, cloning its * loop successor state S2 (and possibly following states), and then moving * all S1->S2 constraint arcs to point to the cloned S2. The cloned S2 should * copy any non-constraint outarcs of S2. Constraint outarcs should be * dropped if they point back to S1, else they need to be copied as arcs to * similarly cloned states S3, S4, etc. In general, each cloned state copies * non-constraint outarcs, drops constraint outarcs that would lead to itself * or any earlier cloned state, and sends other constraint outarcs to newly * cloned states. No cloned state will have any inarcs that aren't constraint * arcs or do not lead from S1 or earlier-cloned states. It's okay to drop * constraint back-arcs since they would not take us to any state we've not * already been in; therefore, no new constraint loop is created. In this way * we generate a modified NFA that can still represent every useful state * sequence, but not sequences that represent state loops with no consumption * of input data. Note that the set of cloned states will certainly include * all of the loop member states other than S1, and it may also include * non-loop states that are reachable from S2 via constraint arcs. This is * important because there is no guarantee that findconstraintloop found a * maximal loop (and searching for one would be NP-hard, so don't try). * Frequently the "non-loop states" are actually part of a larger loop that * we didn't notice, and indeed there may be several overlapping loops. * This technique ensures convergence in such cases, while considering only * the originally-found loop does not. * * If there is only one S1->S2 constraint arc, then that constraint is * certainly satisfied when we enter any of the clone states. This means that * in the common case where many of the constraint arcs are identically * labeled, we can merge together clone states linked by a similarly-labeled * constraint: if we can get to the first one we can certainly get to the * second, so there's no need to distinguish. This greatly reduces the number * of new states needed, so we preferentially break the given loop at a state * pair where this is true. * * Furthermore, it's fairly common to find that a cloned successor state has * no outarcs, especially if we're a bit aggressive about removing unnecessary * outarcs. If that happens, then there is simply not any interesting state * that can be reached through the predecessor's loop arcs, which means we can * break the loop just by removing those loop arcs, with no new states added. */ static void breakconstraintloop(struct nfa * nfa, struct state * sinitial) { struct state *s; struct state *shead; struct state *stail; struct state *sclone; struct state *nexts; struct arc *refarc; struct arc *a; struct arc *nexta; /* * Start by identifying which loop step we want to break at. * Preferentially this is one with only one constraint arc. (XXX are * there any other secondary heuristics we want to use here?) Set refarc * to point to the selected lone constraint arc, if there is one. */ refarc = NULL; s = sinitial; do { nexts = s->tmp; assert(nexts != s); /* should not see any one-element loops */ if (refarc == NULL) { int narcs = 0; for (a = s->outs; a != NULL; a = a->outchain) { if (a->to == nexts && isconstraintarc(a)) { refarc = a; narcs++; } } assert(narcs > 0); if (narcs > 1) { refarc = NULL; /* multiple constraint arcs here, no good */ } } s = nexts; } while (s != sinitial); if (refarc) { /* break at the refarc */ shead = refarc->from; stail = refarc->to; assert(stail == shead->tmp); } else { /* for lack of a better idea, break after sinitial */ shead = sinitial; stail = sinitial->tmp; } /* * Reset the tmp fields so that we can use them for local storage in * clonesuccessorstates. (findconstraintloop won't mind, since it's just * going to abandon its search anyway.) */ for (s = nfa->states; s != NULL; s = s->next) { s->tmp = NULL; } /* * Recursively build clone state(s) as needed. */ sclone = newstate(nfa); if (sclone == NULL) { assert(NISERR()); return; } clonesuccessorstates(nfa, stail, sclone, shead, refarc, NULL, NULL, nfa->nstates); if (NISERR()) { return; } /* * It's possible that sclone has no outarcs at all, in which case it's * useless. (We don't try extremely hard to get rid of useless states * here, but this is an easy and fairly common case.) */ if (sclone->nouts == 0) { freestate(nfa, sclone); sclone = NULL; } /* * Move shead's constraint-loop arcs to point to sclone, or just drop them * if we discovered we don't need sclone. */ for (a = shead->outs; a != NULL; a = nexta) { nexta = a->outchain; if (a->to == stail && isconstraintarc(a)) { if (sclone) { cparc(nfa, a, shead, sclone); } freearc(nfa, a); if (NISERR()) { break; } } } } /* * clonesuccessorstates - create a tree of constraint-arc successor states * * ssource is the state to be cloned, and sclone is the state to copy its * outarcs into. sclone's inarcs, if any, should already be set up. * * spredecessor is the original predecessor state that we are trying to build * successors for (it may not be the immediate predecessor of ssource). * refarc, if not NULL, is the original constraint arc that is known to have * been traversed out of spredecessor to reach the successor(s). * * For each cloned successor state, we transiently create a "donemap" that is * a boolean array showing which source states we've already visited for this * clone state. This prevents infinite recursion as well as useless repeat * visits to the same state subtree (which can add up fast, since typical NFAs * have multiple redundant arc pathways). Each donemap is a char array * indexed by state number. The donemaps are all of the same size "nstates", * which is nfa->nstates as of the start of the recursion. This is enough to * have entries for all preexisting states, but *not* entries for clone * states created during the recursion. That's okay since we have no need to * mark those. * * curdonemap is NULL when recursing to a new sclone state, or sclone's * donemap when we are recursing without having created a new state (which we * do when we decide we can merge a successor state into the current clone * state). outerdonemap is NULL at the top level and otherwise the parent * clone state's donemap. * * The successor states we create and fill here form a strict tree structure, * with each state having exactly one predecessor, except that the toplevel * state has no inarcs as yet (breakconstraintloop will add its inarcs from * spredecessor after we're done). Thus, we can examine sclone's inarcs back * to the root, plus refarc if any, to identify the set of constraints already * known valid at the current point. This allows us to avoid generating extra * successor states. */ static void clonesuccessorstates( struct nfa * nfa, struct state * ssource, struct state * sclone, struct state * spredecessor, struct arc * refarc, char *curdonemap, char *outerdonemap, int nstates) { char *donemap; struct arc *a; /* Since this is recursive, it could be driven to stack overflow */ if (STACK_TOO_DEEP(nfa->v->re)) { NERR(REG_ETOOBIG); return; } /* If this state hasn't already got a donemap, create one */ donemap = curdonemap; if (donemap == NULL) { donemap = (char *) MALLOC(nstates * sizeof(char)); if (donemap == NULL) { NERR(REG_ESPACE); return; } if (outerdonemap != NULL) { /* * Not at outermost recursion level, so copy the outer level's * donemap; this ensures that we see states in process of being * visited at outer levels, or already merged into predecessor * states, as ones we shouldn't traverse back to. */ memcpy(donemap, outerdonemap, nstates * sizeof(char)); } else { /* At outermost level, only spredecessor is off-limits */ memset(donemap, 0, nstates * sizeof(char)); assert(spredecessor->no < nstates); donemap[spredecessor->no] = 1; } } /* Mark ssource as visited in the donemap */ assert(ssource->no < nstates); assert(donemap[ssource->no] == 0); donemap[ssource->no] = 1; /* * We proceed by first cloning all of ssource's outarcs, creating new * clone states as needed but not doing more with them than that. Then in * a second pass, recurse to process the child clone states. This allows * us to have only one child clone state per reachable source state, even * when there are multiple outarcs leading to the same state. Also, when * we do visit a child state, its set of inarcs is known exactly, which * makes it safe to apply the constraint-is-already-checked optimization. * Also, this ensures that we've merged all the states we can into the * current clone before we recurse to any children, thus possibly saving * them from making extra images of those states. * * While this function runs, child clone states of the current state are * marked by setting their tmp fields to point to the original state they * were cloned from. This makes it possible to detect multiple outarcs * leading to the same state, and also makes it easy to distinguish clone * states from original states (which will have tmp == NULL). */ for (a = ssource->outs; a != NULL && !NISERR(); a = a->outchain) { struct state *sto = a->to; /* * We do not consider cloning successor states that have no constraint * outarcs; just link to them as-is. They cannot be part of a * constraint loop so there is no need to make copies. In particular, * this rule keeps us from trying to clone the post state, which would * be a bad idea. */ if (isconstraintarc(a) && hasconstraintout(sto)) { struct state *prevclone; int canmerge; struct arc *a2; /* * Back-link constraint arcs must not be followed. Nor is there a * need to revisit states previously merged into this clone. */ assert(sto->no < nstates); if (donemap[sto->no] != 0) { continue; } /* * Check whether we already have a child clone state for this * source state. */ prevclone = NULL; for (a2 = sclone->outs; a2 != NULL; a2 = a2->outchain) { if (a2->to->tmp == sto) { prevclone = a2->to; break; } } /* * If this arc is labeled the same as refarc, or the same as any * arc we must have traversed to get to sclone, then no additional * constraints need to be met to get to sto, so we should just * merge its outarcs into sclone. */ if (refarc && a->type == refarc->type && a->co == refarc->co) { canmerge = 1; } else { struct state *s; canmerge = 0; for (s = sclone; s->ins; s = s->ins->from) { if (s->nins == 1 && a->type == s->ins->type && a->co == s->ins->co) { canmerge = 1; break; } } } if (canmerge) { /* * We can merge into sclone. If we previously made a child * clone state, drop it; there's no need to visit it. (This * can happen if ssource has multiple pathways to sto, and we * only just now found one that is provably a no-op.) */ if (prevclone) { dropstate(nfa, prevclone); /* kills our outarc, too */ } /* Recurse to merge sto's outarcs into sclone */ clonesuccessorstates(nfa, sto, sclone, spredecessor, refarc, donemap, outerdonemap, nstates); /* sto should now be marked as previously visited */ assert(NISERR() || donemap[sto->no] == 1); } else if (prevclone) { /* * We already have a clone state for this successor, so just * make another arc to it. */ cparc(nfa, a, sclone, prevclone); } else { /* * We need to create a new successor clone state. */ struct state *stoclone; stoclone = newstate(nfa); if (stoclone == NULL) { assert(NISERR()); break; } /* Mark it as to what it's a clone of */ stoclone->tmp = sto; /* ... and add the outarc leading to it */ cparc(nfa, a, sclone, stoclone); } } else { /* * Non-constraint outarcs just get copied to sclone, as do outarcs * leading to states with no constraint outarc. */ cparc(nfa, a, sclone, sto); } } /* * If we are at outer level for this clone state, recurse to all its child * clone states, clearing their tmp fields as we go. (If we're not * outermost for sclone, leave this to be done by the outer call level.) * Note that if we have multiple outarcs leading to the same clone state, * it will only be recursed-to once. */ if (curdonemap == NULL) { for (a = sclone->outs; a != NULL && !NISERR(); a = a->outchain) { struct state *stoclone = a->to; struct state *sto = stoclone->tmp; if (sto != NULL) { stoclone->tmp = NULL; clonesuccessorstates(nfa, sto, stoclone, spredecessor, refarc, NULL, donemap, nstates); } } /* Don't forget to free sclone's donemap when done with it */ FREE(donemap); } } /* - cleanup - clean up NFA after optimizations ^ static void cleanup(struct nfa *); */ static void cleanup( struct nfa *nfa) { struct state *s; struct state *nexts; int n; /* * Clear out unreachable or dead-end states. Use pre to mark reachable, * then post to mark can-reach-post. */ markreachable(nfa, nfa->pre, NULL, nfa->pre); markcanreach(nfa, nfa->post, nfa->pre, nfa->post); for (s = nfa->states; s != NULL; s = nexts) { nexts = s->next; if (s->tmp != nfa->post && !s->flag) { dropstate(nfa, s); } } assert(nfa->post->nins == 0 || nfa->post->tmp == nfa->post); cleartraverse(nfa, nfa->pre); assert(nfa->post->nins == 0 || nfa->post->tmp == NULL); /* the nins==0 (final unreachable) case will be caught later */ /* * Renumber surviving states. */ n = 0; for (s = nfa->states; s != NULL; s = s->next) { s->no = n++; } nfa->nstates = n; } /* - markreachable - recursive marking of reachable states ^ static void markreachable(struct nfa *, struct state *, struct state *, ^ struct state *); */ static void markreachable( struct nfa *nfa, struct state *s, struct state *okay, /* consider only states with this mark */ struct state *mark) /* the value to mark with */ { struct arc *a; if (s->tmp != okay) { return; } s->tmp = mark; for (a = s->outs; a != NULL; a = a->outchain) { markreachable(nfa, a->to, okay, mark); } } /* - markcanreach - recursive marking of states which can reach here ^ static void markcanreach(struct nfa *, struct state *, struct state *, ^ struct state *); */ static void markcanreach( struct nfa *nfa, struct state *s, struct state *okay, /* consider only states with this mark */ struct state *mark) /* the value to mark with */ { struct arc *a; if (s->tmp != okay) { return; } s->tmp = mark; for (a = s->ins; a != NULL; a = a->inchain) { markcanreach(nfa, a->from, okay, mark); } } /* - analyze - ascertain potentially-useful facts about an optimized NFA ^ static long analyze(struct nfa *); */ static long /* re_info bits to be OR'ed in */ analyze( struct nfa *nfa) { struct arc *a; struct arc *aa; if (nfa->pre->outs == NULL) { return REG_UIMPOSSIBLE; } for (a = nfa->pre->outs; a != NULL; a = a->outchain) { for (aa = a->to->outs; aa != NULL; aa = aa->outchain) { if (aa->to == nfa->post) { return REG_UEMPTYMATCH; } } } return 0; } /* - compact - construct the compact representation of an NFA ^ static void compact(struct nfa *, struct cnfa *); */ static void compact( struct nfa *nfa, struct cnfa *cnfa) { struct state *s; struct arc *a; size_t nstates; size_t narcs; struct carc *ca; struct carc *first; assert(!NISERR()); nstates = 0; narcs = 0; for (s = nfa->states; s != NULL; s = s->next) { nstates++; narcs += s->nouts + 1; /* need one extra for endmarker */ } cnfa->stflags = (char *) MALLOC(nstates * sizeof(char)); cnfa->states = (struct carc **) MALLOC(nstates * sizeof(struct carc *)); cnfa->arcs = (struct carc *) MALLOC(narcs * sizeof(struct carc)); if (cnfa->stflags == NULL || cnfa->states == NULL || cnfa->arcs == NULL) { if (cnfa->stflags != NULL) { FREE(cnfa->stflags); } if (cnfa->states != NULL) { FREE(cnfa->states); } if (cnfa->arcs != NULL) { FREE(cnfa->arcs); } NERR(REG_ESPACE); return; } cnfa->nstates = nstates; cnfa->pre = nfa->pre->no; cnfa->post = nfa->post->no; cnfa->bos[0] = nfa->bos[0]; cnfa->bos[1] = nfa->bos[1]; cnfa->eos[0] = nfa->eos[0]; cnfa->eos[1] = nfa->eos[1]; cnfa->ncolors = maxcolor(nfa->cm) + 1; cnfa->flags = 0; ca = cnfa->arcs; for (s = nfa->states; s != NULL; s = s->next) { assert((size_t) s->no < nstates); cnfa->stflags[s->no] = 0; cnfa->states[s->no] = ca; first = ca; for (a = s->outs; a != NULL; a = a->outchain) { switch (a->type) { case PLAIN: ca->co = a->co; ca->to = a->to->no; ca++; break; case LACON: assert(s->no != cnfa->pre); ca->co = (color) (cnfa->ncolors + a->co); ca->to = a->to->no; ca++; cnfa->flags |= HASLACONS; break; default: NERR(REG_ASSERT); break; } } carcsort(first, ca - first); ca->co = COLORLESS; ca->to = 0; ca++; } assert(ca == &cnfa->arcs[narcs]); assert(cnfa->nstates != 0); /* * Mark no-progress states. */ for (a = nfa->pre->outs; a != NULL; a = a->outchain) { cnfa->stflags[a->to->no] = CNFA_NOPROGRESS; } cnfa->stflags[nfa->pre->no] = CNFA_NOPROGRESS; } /* - carcsort - sort compacted-NFA arcs by color ^ static void carcsort(struct carc *, struct carc *); */ static void carcsort( struct carc *first, size_t n) { if (n > 1) { qsort(first, n, sizeof(struct carc), carc_cmp); } } static int carc_cmp( const void *a, const void *b) { const struct carc *aa = (const struct carc *) a; const struct carc *bb = (const struct carc *) b; if (aa->co < bb->co) { return -1; } if (aa->co > bb->co) { return +1; } if (aa->to < bb->to) { return -1; } if (aa->to > bb->to) { return +1; } return 0; } /* - freecnfa - free a compacted NFA ^ static void freecnfa(struct cnfa *); */ static void freecnfa( struct cnfa *cnfa) { assert(cnfa->nstates != 0); /* not empty already */ cnfa->nstates = 0; FREE(cnfa->stflags); FREE(cnfa->states); FREE(cnfa->arcs); } /* - dumpnfa - dump an NFA in human-readable form ^ static void dumpnfa(struct nfa *, FILE *); */ static void dumpnfa( struct nfa *nfa, FILE *f) { #ifdef REG_DEBUG struct state *s; int nstates = 0; int narcs = 0; fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no); if (nfa->bos[0] != COLORLESS) { fprintf(f, ", bos [%ld]", (long) nfa->bos[0]); } if (nfa->bos[1] != COLORLESS) { fprintf(f, ", bol [%ld]", (long) nfa->bos[1]); } if (nfa->eos[0] != COLORLESS) { fprintf(f, ", eos [%ld]", (long) nfa->eos[0]); } if (nfa->eos[1] != COLORLESS) { fprintf(f, ", eol [%ld]", (long) nfa->eos[1]); } fprintf(f, "\n"); for (s = nfa->states; s != NULL; s = s->next) { dumpstate(s, f); nstates++; narcs += s->nouts; } fprintf(f, "total of %d states, %d arcs\n", nstates, narcs); if (nfa->parent == NULL) { dumpcolors(nfa->cm, f); } fflush(f); #else (void)nfa; (void)f; #endif } #ifdef REG_DEBUG /* subordinates of dumpnfa */ /* ^ #ifdef REG_DEBUG */ /* - dumpstate - dump an NFA state in human-readable form ^ static void dumpstate(struct state *, FILE *); */ static void dumpstate( struct state *s, FILE *f) { struct arc *a; fprintf(f, "%d%s%c", s->no, (s->tmp != NULL) ? "T" : "", (s->flag) ? s->flag : '.'); if (s->prev != NULL && s->prev->next != s) { fprintf(f, "\tstate chain bad\n"); } if (s->nouts == 0) { fprintf(f, "\tno out arcs\n"); } else { dumparcs(s, f); } fflush(f); for (a = s->ins; a != NULL; a = a->inchain) { if (a->to != s) { fprintf(f, "\tlink from %d to %d on %d's in-chain\n", a->from->no, a->to->no, s->no); } } } /* - dumparcs - dump out-arcs in human-readable form ^ static void dumparcs(struct state *, FILE *); */ static void dumparcs( struct state *s, FILE *f) { int pos; struct arc *a; /* printing oldest arcs first is usually clearer */ a = s->outs; assert(a != NULL); while (a->outchain != NULL) { a = a->outchain; } pos = 1; do { dumparc(a, s, f); if (pos == 5) { fprintf(f, "\n"); pos = 1; } else { pos++; } a = a->outchainRev; } while (a != NULL); if (pos != 1) { fprintf(f, "\n"); } } /* - dumparc - dump one outarc in readable form, including prefixing tab ^ static void dumparc(struct arc *, struct state *, FILE *); */ static void dumparc( struct arc *a, struct state *s, FILE *f) { struct arc *aa; struct arcbatch *ab; fprintf(f, "\t"); switch (a->type) { case PLAIN: fprintf(f, "[%ld]", (long) a->co); break; case AHEAD: fprintf(f, ">%ld>", (long) a->co); break; case BEHIND: fprintf(f, "<%ld<", (long) a->co); break; case LACON: fprintf(f, ":%ld:", (long) a->co); break; case '^': case '$': fprintf(f, "%c%d", a->type, (int) a->co); break; case EMPTY: break; default: fprintf(f, "0x%x/0%lo", a->type, (long) a->co); break; } if (a->from != s) { fprintf(f, "?%d?", a->from->no); } for (ab = &a->from->oas; ab != NULL; ab = ab->next) { for (aa = &ab->a[0]; aa < &ab->a[ABSIZE]; aa++) { if (aa == a) { break; /* NOTE BREAK OUT */ } } if (aa < &ab->a[ABSIZE]) { /* propagate break */ break; /* NOTE BREAK OUT */ } } if (ab == NULL) { fprintf(f, "?!?"); /* not in allocated space */ } fprintf(f, "->"); if (a->to == NULL) { fprintf(f, "NULL"); return; } fprintf(f, "%d", a->to->no); for (aa = a->to->ins; aa != NULL; aa = aa->inchain) { if (aa == a) { break; /* NOTE BREAK OUT */ } } if (aa == NULL) { fprintf(f, "?!?"); /* missing from in-chain */ } } /* ^ #endif */ #endif /* ifdef REG_DEBUG */ /* - dumpcnfa - dump a compacted NFA in human-readable form ^ static void dumpcnfa(struct cnfa *, FILE *); */ static void dumpcnfa( struct cnfa *cnfa, FILE *f) { #ifdef REG_DEBUG int st; fprintf(f, "pre %d, post %d", cnfa->pre, cnfa->post); if (cnfa->bos[0] != COLORLESS) { fprintf(f, ", bos [%ld]", (long) cnfa->bos[0]); } if (cnfa->bos[1] != COLORLESS) { fprintf(f, ", bol [%ld]", (long) cnfa->bos[1]); } if (cnfa->eos[0] != COLORLESS) { fprintf(f, ", eos [%ld]", (long) cnfa->eos[0]); } if (cnfa->eos[1] != COLORLESS) { fprintf(f, ", eol [%ld]", (long) cnfa->eos[1]); } if (cnfa->flags&HASLACONS) { fprintf(f, ", haslacons"); } fprintf(f, "\n"); for (st = 0; st < cnfa->nstates; st++) { dumpcstate(st, cnfa, f); } fflush(f); #else (void)cnfa; (void)f; #endif } #ifdef REG_DEBUG /* subordinates of dumpcnfa */ /* ^ #ifdef REG_DEBUG */ /* - dumpcstate - dump a compacted-NFA state in human-readable form ^ static void dumpcstate(int, struct cnfa *, FILE *); */ static void dumpcstate( int st, struct cnfa *cnfa, FILE *f) { struct carc *ca; int pos; fprintf(f, "%d%s", st, (cnfa->stflags[st] & CNFA_NOPROGRESS) ? ":" : "."); pos = 1; for (ca = cnfa->states[st]; ca->co != COLORLESS; ca++) { if (ca->co < cnfa->ncolors) { fprintf(f, "\t[%ld]->%d", (long) ca->co, ca->to); } else { fprintf(f, "\t:%ld:->%d", (long) (ca->co - cnfa->ncolors), ca->to); } if (pos == 5) { fprintf(f, "\n"); pos = 1; } else { pos++; } } if (ca == cnfa->states[st] || pos != 1) { fprintf(f, "\n"); } fflush(f); } /* ^ #endif */ #endif /* ifdef REG_DEBUG */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regcomp.c0000644000175000017500000015723314554262142015071 0ustar sergeisergei/* * re_*comp and friends - compile REs * This file #includes several others (see the bottom). * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * */ #include "regguts.h" /* * forward declarations, up here so forward datatypes etc. are defined early */ /* =====^!^===== begin forwards =====^!^===== */ /* automatically gathered by fwd; do not hand-edit */ /* === regcomp.c === */ int compile(regex_t *, const chr *, size_t, int); static void moresubs(struct vars *, int); static int freev(struct vars *, int); static void makesearch(struct vars *, struct nfa *); static struct subre *parse(struct vars *, int, int, struct state *, struct state *); static struct subre *parsebranch(struct vars *, int, int, struct state *, struct state *, int); static void parseqatom(struct vars *, int, int, struct state *, struct state *, struct subre *); static void nonword(struct vars *, int, struct state *, struct state *); static void word(struct vars *, int, struct state *, struct state *); static int scannum(struct vars *); static void repeat(struct vars *, struct state *, struct state *, int, int); static void bracket(struct vars *, struct state *, struct state *); static void cbracket(struct vars *, struct state *, struct state *); static void brackpart(struct vars *, struct state *, struct state *); static const chr *scanplain(struct vars *); static void onechr(struct vars *, pchr, struct state *, struct state *); static void dovec(struct vars *, struct cvec *, struct state *, struct state *); static void wordchrs(struct vars *); static struct subre *subre(struct vars *, int, int, struct state *, struct state *); static void freesubre(struct vars *, struct subre *); static void freesrnode(struct vars *, struct subre *); static int numst(struct subre *, int); static void markst(struct subre *); static void cleanst(struct vars *); static long nfatree(struct vars *, struct subre *, FILE *); static long nfanode(struct vars *, struct subre *, FILE *); static int newlacon(struct vars *, struct state *, struct state *, int); static void freelacons(struct subre *, int); static void rfree(regex_t *); static void dump(regex_t *, FILE *); static void dumpst(struct subre *, FILE *, int); static void stdump(struct subre *, FILE *, int); static const char *stid(struct subre *, char *, size_t); /* === regc_lex.c === */ static void lexstart(struct vars *); static void prefixes(struct vars *); static void lexnest(struct vars *, const chr *, const chr *); static void lexword(struct vars *); static int next(struct vars *); static int lexescape(struct vars *); static int lexdigits(struct vars *, int, int, int); static int brenext(struct vars *, pchr); static void skip(struct vars *); static chr newline(NOPARMS); static chr chrnamed(struct vars *, const chr *, const chr *, pchr); /* === regc_color.c === */ static void initcm(struct vars *, struct colormap *); static void freecm(struct colormap *); static void cmtreefree(struct colormap *, union tree *, int); static color setcolor(struct colormap *, pchr, pcolor); static color maxcolor(struct colormap *); static color newcolor(struct colormap *); static void freecolor(struct colormap *, pcolor); static color pseudocolor(struct colormap *); static color subcolor(struct colormap *, pchr c); static color newsub(struct colormap *, pcolor); static void subrange(struct vars *, pchr, pchr, struct state *, struct state *); static void subblock(struct vars *, pchr, struct state *, struct state *); static void okcolors(struct nfa *, struct colormap *); static void colorchain(struct colormap *, struct arc *); static void uncolorchain(struct colormap *, struct arc *); static void rainbow(struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *); static void colorcomplement(struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *); #ifdef REG_DEBUG static void dumpcolors(struct colormap *, FILE *); static void fillcheck(struct colormap *, union tree *, int, FILE *); static void dumpchr(pchr, FILE *); #endif /* === regc_nfa.c === */ static struct nfa *newnfa(struct vars *, struct colormap *, struct nfa *); static void freenfa(struct nfa *); static struct state *newstate(struct nfa *); static struct state *newfstate(struct nfa *, int flag); static void dropstate(struct nfa *, struct state *); static void freestate(struct nfa *, struct state *); static void destroystate(struct nfa *, struct state *); static void newarc(struct nfa *, int, pcolor, struct state *, struct state *); static void createarc(struct nfa *, int, pcolor, struct state *, struct state *); static struct arc *allocarc(struct nfa *, struct state *); static void freearc(struct nfa *, struct arc *); static void changearctarget(struct arc *, struct state *); static int hasnonemptyout(struct state *); static struct arc *findarc(struct state *, int, pcolor); static void cparc(struct nfa *, struct arc *, struct state *, struct state *); static void sortins(struct nfa *, struct state *); static int sortins_cmp(const void *, const void *); static void sortouts(struct nfa *, struct state *); static int sortouts_cmp(const void *, const void *); static void moveins(struct nfa *, struct state *, struct state *); static void copyins(struct nfa *, struct state *, struct state *); static void mergeins(struct nfa *, struct state *, struct arc **, int); static void moveouts(struct nfa *, struct state *, struct state *); static void copyouts(struct nfa *, struct state *, struct state *); static void cloneouts(struct nfa *, struct state *, struct state *, struct state *, int); static void delsub(struct nfa *, struct state *, struct state *); static void deltraverse(struct nfa *, struct state *, struct state *); static void dupnfa(struct nfa *, struct state *, struct state *, struct state *, struct state *); static void duptraverse(struct nfa *, struct state *, struct state *, int); static void cleartraverse(struct nfa *, struct state *); static void specialcolors(struct nfa *); static long optimize(struct nfa *, FILE *); static void pullback(struct nfa *, FILE *); static int pull(struct nfa *, struct arc *, struct state **); static void pushfwd(struct nfa *, FILE *); static int push(struct nfa *, struct arc *, struct state **); #define INCOMPATIBLE 1 /* destroys arc */ #define SATISFIED 2 /* constraint satisfied */ #define COMPATIBLE 3 /* compatible but not satisfied yet */ static int combine(struct arc *, struct arc *); static void fixempties(struct nfa *, FILE *); static struct state *emptyreachable(struct nfa *, struct state *, struct state *, struct arc **); static int isconstraintarc(struct arc *); static int hasconstraintout(struct state *); static void fixconstraintloops(struct nfa *, FILE *); static int findconstraintloop(struct nfa *, struct state *); static void breakconstraintloop(struct nfa *, struct state *); static void clonesuccessorstates(struct nfa *, struct state *, struct state *, struct state *, struct arc *, char *, char *, int); static void cleanup(struct nfa *); static void markreachable(struct nfa *, struct state *, struct state *, struct state *); static void markcanreach(struct nfa *, struct state *, struct state *, struct state *); static long analyze(struct nfa *); static void compact(struct nfa *, struct cnfa *); static void carcsort(struct carc *, size_t); static int carc_cmp(const void *, const void *); static void freecnfa(struct cnfa *); static void dumpnfa(struct nfa *, FILE *); #ifdef REG_DEBUG static void dumpstate(struct state *, FILE *); static void dumparcs(struct state *, FILE *); static void dumparc(struct arc *, struct state *, FILE *); #endif static void dumpcnfa(struct cnfa *, FILE *); #ifdef REG_DEBUG static void dumpcstate(int, struct cnfa *, FILE *); #endif /* === regc_cvec.c === */ static struct cvec *clearcvec(struct cvec *); static void addchr(struct cvec *, pchr); static void addrange(struct cvec *, pchr, pchr); static struct cvec *newcvec(int, int); static struct cvec *getcvec(struct vars *, int, int); static void freecvec(struct cvec *); /* === regc_locale.c === */ static celt element(struct vars *, const chr *, const chr *); static struct cvec *range(struct vars *, celt, celt, int); static int before(celt, celt); static struct cvec *eclass(struct vars *, celt, int); static struct cvec *cclass(struct vars *, const chr *, const chr *, int); static struct cvec *allcases(struct vars *, pchr); static int cmp(const chr *, const chr *, size_t); static int casecmp(const chr *, const chr *, size_t); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ /* internal variables, bundled for easy passing around */ struct vars { regex_t *re; const chr *now; /* scan pointer into string */ const chr *stop; /* end of string */ const chr *savenow; /* saved now and stop for "subroutine call" */ const chr *savestop; int err; /* error code (0 if none) */ int cflags; /* copy of compile flags */ int lasttype; /* type of previous token */ int nexttype; /* type of next token */ chr nextvalue; /* value (if any) of next token */ int lexcon; /* lexical context type (see lex.c) */ int nsubexp; /* subexpression count */ struct subre **subs; /* subRE pointer vector */ size_t nsubs; /* length of vector */ struct subre *sub10[10]; /* initial vector, enough for most */ struct nfa *nfa; /* the NFA */ struct colormap *cm; /* character color map */ color nlcolor; /* color of newline */ struct state *wordchrs; /* state in nfa holding word-char outarcs */ struct subre *tree; /* subexpression tree */ struct subre *treechain; /* all tree nodes allocated */ struct subre *treefree; /* any free tree nodes */ int ntree; /* number of tree nodes, plus one */ struct cvec *cv; /* interface cvec */ struct cvec *cv2; /* utility cvec */ struct subre *lacons; /* lookahead-constraint vector */ int nlacons; /* size of lacons */ size_t spaceused; /* approx. space used for compilation */ }; /* parsing macros; most know that `v' is the struct vars pointer */ #define NEXT() (next(v)) /* advance by one token */ #define SEE(t) (v->nexttype == (t)) /* is next token this? */ #define EAT(t) (SEE(t) && next(v)) /* if next is this, swallow it */ #define VISERR(vv) ((vv)->err != 0)/* have we seen an error yet? */ #define ISERR() VISERR(v) #define VERR(vv,e) ((vv)->nexttype = EOS, \ (vv)->err = ((vv)->err ? (vv)->err : (e))) #define ERR(e) VERR(v, e) /* record an error */ #define NOERR() {if (ISERR()) return;} /* if error seen, return */ #define NOERRN() {if (ISERR()) return NULL;} /* NOERR with retval */ #define NOERRZ() {if (ISERR()) return 0;} /* NOERR with retval */ #define INSIST(c, e) do { if (!(c)) ERR(e); } while (0) /* error if c false */ #define NOTE(b) (v->re->re_info |= (b)) /* note visible condition */ #define EMPTYARC(x, y) newarc(v->nfa, EMPTY, 0, x, y) /* token type codes, some also used as NFA arc types */ #undef DIGIT /* prevent conflict with libtommath */ #define EMPTY 'n' /* no token present */ #define EOS 'e' /* end of string */ #define PLAIN 'p' /* ordinary character */ #define DIGIT 'd' /* digit (in bound) */ #define BACKREF 'b' /* back reference */ #define COLLEL 'I' /* start of [. */ #define ECLASS 'E' /* start of [= */ #define CCLASS 'C' /* start of [: */ #define END 'X' /* end of [. [= [: */ #define RANGE 'R' /* - within [] which might be range delim. */ #define LACON 'L' /* lookahead constraint subRE */ #define AHEAD 'a' /* color-lookahead arc */ #define BEHIND 'r' /* color-lookbehind arc */ #define WBDRY 'w' /* word boundary constraint */ #define NWBDRY 'W' /* non-word-boundary constraint */ #define SBEGIN 'A' /* beginning of string (even if not BOL) */ #define SEND 'Z' /* end of string (even if not EOL) */ #define PREFER 'P' /* length preference */ /* is an arc colored, and hence on a color chain? */ #define COLORED(a) \ ((a)->type == PLAIN || (a)->type == AHEAD || (a)->type == BEHIND) /* static function list */ static const struct fns functions = { rfree, /* regfree insides */ }; /* - compile - compile regular expression * Note: on failure, no resources remain allocated, so regfree() * need not be applied to re. ^ int compile(regex_t *, const chr *, size_t, int); */ int compile( regex_t *re, const chr *string, size_t len, int flags) { AllocVars(v); struct guts *g; int i; size_t j; FILE *debug = (flags®_PROGRESS) ? stdout : NULL; #define CNOERR() { if (ISERR()) return freev(v, v->err); } /* * Sanity checks. */ if (re == NULL || string == NULL) { FreeVars(v); return REG_INVARG; } if ((flags®_QUOTE) && (flags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE))) { FreeVars(v); return REG_INVARG; } if (!(flags®_EXTENDED) && (flags®_ADVF)) { FreeVars(v); return REG_INVARG; } /* * Initial setup (after which freev() is callable). */ v->re = re; v->now = string; v->stop = v->now + len; v->savenow = v->savestop = NULL; v->err = 0; v->cflags = flags; v->nsubexp = 0; v->subs = v->sub10; v->nsubs = 10; for (j = 0; j < v->nsubs; j++) { v->subs[j] = NULL; } v->nfa = NULL; v->cm = NULL; v->nlcolor = COLORLESS; v->wordchrs = NULL; v->tree = NULL; v->treechain = NULL; v->treefree = NULL; v->cv = NULL; v->cv2 = NULL; v->lacons = NULL; v->nlacons = 0; v->spaceused = 0; re->re_magic = REMAGIC; re->re_info = 0; /* bits get set during parse */ re->re_csize = sizeof(chr); re->re_guts = NULL; re->re_fns = (char *)&functions; /* * More complex setup, malloced things. */ re->re_guts = (char *)(MALLOC(sizeof(struct guts))); if (re->re_guts == NULL) { return freev(v, REG_ESPACE); } g = (struct guts *) re->re_guts; g->tree = NULL; initcm(v, &g->cmap); v->cm = &g->cmap; g->lacons = NULL; g->nlacons = 0; ZAPCNFA(g->search); v->nfa = newnfa(v, v->cm, NULL); CNOERR(); v->cv = newcvec(100, 20); if (v->cv == NULL) { return freev(v, REG_ESPACE); } /* * Parsing. */ lexstart(v); /* also handles prefixes */ if ((v->cflags®_NLSTOP) || (v->cflags®_NLANCH)) { /* * Assign newline a unique color. */ v->nlcolor = subcolor(v->cm, newline()); okcolors(v->nfa, v->cm); } CNOERR(); v->tree = parse(v, EOS, PLAIN, v->nfa->init, v->nfa->final); assert(SEE(EOS)); /* even if error; ISERR() => SEE(EOS) */ CNOERR(); assert(v->tree != NULL); /* * Finish setup of nfa and its subre tree. */ specialcolors(v->nfa); CNOERR(); if (debug != NULL) { fprintf(debug, "\n\n\n========= RAW ==========\n"); dumpnfa(v->nfa, debug); dumpst(v->tree, debug, 1); } v->ntree = numst(v->tree, 1); markst(v->tree); cleanst(v); if (debug != NULL) { fprintf(debug, "\n\n\n========= TREE FIXED ==========\n"); dumpst(v->tree, debug, 1); } /* * Build compacted NFAs for tree and lacons. */ re->re_info |= nfatree(v, v->tree, debug); CNOERR(); assert(v->nlacons == 0 || v->lacons != NULL); for (i = 1; i < v->nlacons; i++) { if (debug != NULL) { fprintf(debug, "\n\n\n========= LA%d ==========\n", i); } nfanode(v, &v->lacons[i], debug); } CNOERR(); if (v->tree->flags&SHORTER) { NOTE(REG_USHORTEST); } /* * Build compacted NFAs for tree, lacons, fast search. */ if (debug != NULL) { fprintf(debug, "\n\n\n========= SEARCH ==========\n"); } /* * Can sacrifice main NFA now, so use it as work area. */ (DISCARD) optimize(v->nfa, debug); CNOERR(); makesearch(v, v->nfa); CNOERR(); compact(v->nfa, &g->search); CNOERR(); /* * Looks okay, package it up. */ re->re_nsub = v->nsubexp; v->re = NULL; /* freev no longer frees re */ g->magic = GUTSMAGIC; g->cflags = v->cflags; g->info = re->re_info; g->nsub = re->re_nsub; g->tree = v->tree; v->tree = NULL; g->ntree = v->ntree; g->compare = (v->cflags®_ICASE) ? casecmp : cmp; g->lacons = v->lacons; v->lacons = NULL; g->nlacons = v->nlacons; if (flags®_DUMP) { dump(re, stdout); } assert(v->err == 0); return freev(v, 0); } /* - moresubs - enlarge subRE vector ^ static void moresubs(struct vars *, int); */ static void moresubs( struct vars *v, int wanted) /* want enough room for this one */ { struct subre **p; size_t n; assert(wanted > 0 && (size_t)wanted >= v->nsubs); n = (size_t)wanted * 3 / 2 + 1; if (v->subs == v->sub10) { p = (struct subre **) MALLOC(n * sizeof(struct subre *)); if (p != NULL) { memcpy(p, v->subs, v->nsubs * sizeof(struct subre *)); } } else { p = (struct subre **) REALLOC(v->subs, n*sizeof(struct subre *)); } if (p == NULL) { ERR(REG_ESPACE); return; } v->subs = p; for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++) { *p = NULL; } assert(v->nsubs == n); assert((size_t)wanted < v->nsubs); } /* - freev - free vars struct's substructures where necessary * Optionally does error-number setting, and always returns error code (if * any), to make error-handling code terser. ^ static int freev(struct vars *, int); */ static int freev( struct vars *v, int err) { int ret; if (v->re != NULL) { rfree(v->re); } if (v->subs != v->sub10) { FREE(v->subs); } if (v->nfa != NULL) { freenfa(v->nfa); } if (v->tree != NULL) { freesubre(v, v->tree); } if (v->treechain != NULL) { cleanst(v); } if (v->cv != NULL) { freecvec(v->cv); } if (v->cv2 != NULL) { freecvec(v->cv2); } if (v->lacons != NULL) { freelacons(v->lacons, v->nlacons); } ERR(err); /* nop if err==0 */ ret = v->err; FreeVars(v); return ret; } /* - makesearch - turn an NFA into a search NFA (implicit prepend of .*?) * NFA must have been optimize()d already. ^ static void makesearch(struct vars *, struct nfa *); */ static void makesearch( struct vars *v, struct nfa *nfa) { struct arc *a, *b; struct state *pre = nfa->pre; struct state *s, *s2, *slist; /* * No loops are needed if it's anchored. */ for (a = pre->outs; a != NULL; a = a->outchain) { assert(a->type == PLAIN); if (a->co != nfa->bos[0] && a->co != nfa->bos[1]) { break; } } if (a != NULL) { /* * Add implicit .* in front. */ rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre); /* * And ^* and \A* too -- not always necessary, but harmless. */ newarc(nfa, PLAIN, nfa->bos[0], pre, pre); newarc(nfa, PLAIN, nfa->bos[1], pre, pre); } /* * Now here's the subtle part. Because many REs have no lookback * constraints, often knowing when you were in the pre state tells you * little; it's the next state(s) that are informative. But some of them * may have other inarcs, i.e. it may be possible to make actual progress * and then return to one of them. We must de-optimize such cases, * splitting each such state into progress and no-progress states. */ /* * First, make a list of the states. */ slist = NULL; for (a=pre->outs ; a!=NULL ; a=a->outchain) { s = a->to; for (b=s->ins ; b!=NULL ; b=b->inchain) { if (b->from != pre) { break; } } /* * We want to mark states as being in the list already by having non * NULL tmp fields, but we can't just store the old slist value in tmp * because that doesn't work for the first such state. Instead, the * first list entry gets its own address in tmp. */ if (b != NULL && s->tmp == NULL) { s->tmp = (slist != NULL) ? slist : s; slist = s; } } /* * Do the splits. */ for (s=slist ; s!=NULL ; s=s2) { s2 = newstate(nfa); NOERR(); copyouts(nfa, s, s2); NOERR(); for (a=s->ins ; a!=NULL ; a=b) { b = a->inchain; if (a->from != pre) { cparc(nfa, a, a->from, s2); freearc(nfa, a); } } s2 = (s->tmp != s) ? s->tmp : NULL; s->tmp = NULL; /* clean up while we're at it */ } } /* - parse - parse an RE * This is actually just the top level, which parses a bunch of branches tied * together with '|'. They appear in the tree as the left children of a chain * of '|' subres. ^ static struct subre *parse(struct vars *, int, int, struct state *, ^ struct state *); */ static struct subre * parse( struct vars *v, int stopper, /* EOS or ')' */ int type, /* LACON (lookahead subRE) or PLAIN */ struct state *init, /* initial state */ struct state *final) /* final state */ { struct state *left, *right; /* scaffolding for branch */ struct subre *branches; /* top level */ struct subre *branch; /* current branch */ struct subre *t; /* temporary */ int firstbranch; /* is this the first branch? */ assert(stopper == ')' || stopper == EOS); branches = subre(v, '|', LONGER, init, final); NOERRN(); branch = branches; firstbranch = 1; do { /* a branch */ if (!firstbranch) { /* * Need a place to hang the branch. */ branch->right = subre(v, '|', LONGER, init, final); NOERRN(); branch = branch->right; } firstbranch = 0; left = newstate(v->nfa); right = newstate(v->nfa); NOERRN(); EMPTYARC(init, left); EMPTYARC(right, final); NOERRN(); branch->left = parsebranch(v, stopper, type, left, right, 0); NOERRN(); branch->flags |= UP(branch->flags | branch->left->flags); if ((branch->flags &~ branches->flags) != 0) { /* new flags */ for (t = branches; t != branch; t = t->right) { t->flags |= branch->flags; } } } while (EAT('|')); assert(SEE(stopper) || SEE(EOS)); if (!SEE(stopper)) { assert(stopper == ')' && SEE(EOS)); ERR(REG_EPAREN); } /* * Optimize out simple cases. */ if (branch == branches) { /* only one branch */ assert(branch->right == NULL); t = branch->left; branch->left = NULL; freesubre(v, branches); branches = t; } else if (!MESSY(branches->flags)) { /* no interesting innards */ freesubre(v, branches->left); branches->left = NULL; freesubre(v, branches->right); branches->right = NULL; branches->op = '='; } return branches; } /* - parsebranch - parse one branch of an RE * This mostly manages concatenation, working closely with parseqatom(). * Concatenated things are bundled up as much as possible, with separate * ',' nodes introduced only when necessary due to substructure. ^ static struct subre *parsebranch(struct vars *, int, int, struct state *, ^ struct state *, int); */ static struct subre * parsebranch( struct vars *v, int stopper, /* EOS or ')' */ int type, /* LACON (lookahead subRE) or PLAIN */ struct state *left, /* leftmost state */ struct state *right, /* rightmost state */ int partial) /* is this only part of a branch? */ { struct state *lp; /* left end of current construct */ int seencontent; /* is there anything in this branch yet? */ struct subre *t; lp = left; seencontent = 0; t = subre(v, '=', 0, left, right); /* op '=' is tentative */ NOERRN(); while (!SEE('|') && !SEE(stopper) && !SEE(EOS)) { if (seencontent) { /* implicit concat operator */ lp = newstate(v->nfa); NOERRN(); moveins(v->nfa, right, lp); } seencontent = 1; /* NB, recursion in parseqatom() may swallow rest of branch */ parseqatom(v, stopper, type, lp, right, t); NOERRN(); } if (!seencontent) { /* empty branch */ if (!partial) { NOTE(REG_UUNSPEC); } assert(lp == left); EMPTYARC(left, right); } return t; } /* - parseqatom - parse one quantified atom or constraint of an RE * The bookkeeping near the end cooperates very closely with parsebranch(); in * particular, it contains a recursion that can involve parsing the rest of * the branch, making this function's name somewhat inaccurate. ^ static void parseqatom(struct vars *, int, int, struct state *, ^ struct state *, struct subre *); */ static void parseqatom( struct vars *v, int stopper, /* EOS or ')' */ int type, /* LACON (lookahead subRE) or PLAIN */ struct state *lp, /* left state to hang it on */ struct state *rp, /* right state to hang it on */ struct subre *top) /* subtree top */ { struct state *s; /* temporaries for new states */ struct state *s2; #define ARCV(t, val) newarc(v->nfa, t, val, lp, rp) int m, n; struct subre *atom; /* atom's subtree */ struct subre *t; int cap; /* capturing parens? */ int pos; /* positive lookahead? */ int subno; /* capturing-parens or backref number */ int atomtype; int qprefer; /* quantifier short/long preference */ int f; struct subre **atomp; /* where the pointer to atom is */ /* * Initial bookkeeping. */ atom = NULL; assert(lp->nouts == 0); /* must string new code */ assert(rp->nins == 0); /* between lp and rp */ subno = 0; /* just to shut lint up */ /* * An atom or constraint... */ atomtype = v->nexttype; switch (atomtype) { /* first, constraints, which end by returning */ case '^': ARCV('^', 1); if (v->cflags®_NLANCH) { ARCV(BEHIND, v->nlcolor); } NEXT(); return; case '$': ARCV('$', 1); if (v->cflags®_NLANCH) { ARCV(AHEAD, v->nlcolor); } NEXT(); return; case SBEGIN: ARCV('^', 1); /* BOL */ ARCV('^', 0); /* or BOS */ NEXT(); return; case SEND: ARCV('$', 1); /* EOL */ ARCV('$', 0); /* or EOS */ NEXT(); return; case '<': wordchrs(v); /* does NEXT() */ s = newstate(v->nfa); NOERR(); nonword(v, BEHIND, lp, s); word(v, AHEAD, s, rp); return; case '>': wordchrs(v); /* does NEXT() */ s = newstate(v->nfa); NOERR(); word(v, BEHIND, lp, s); nonword(v, AHEAD, s, rp); return; case WBDRY: wordchrs(v); /* does NEXT() */ s = newstate(v->nfa); NOERR(); nonword(v, BEHIND, lp, s); word(v, AHEAD, s, rp); s = newstate(v->nfa); NOERR(); word(v, BEHIND, lp, s); nonword(v, AHEAD, s, rp); return; case NWBDRY: wordchrs(v); /* does NEXT() */ s = newstate(v->nfa); NOERR(); word(v, BEHIND, lp, s); word(v, AHEAD, s, rp); s = newstate(v->nfa); NOERR(); nonword(v, BEHIND, lp, s); nonword(v, AHEAD, s, rp); return; case LACON: /* lookahead constraint */ pos = v->nextvalue; NEXT(); s = newstate(v->nfa); s2 = newstate(v->nfa); NOERR(); t = parse(v, ')', LACON, s, s2); freesubre(v, t); /* internal structure irrelevant */ assert(SEE(')') || ISERR()); NEXT(); n = newlacon(v, s, s2, pos); NOERR(); ARCV(LACON, n); return; /* * Then errors, to get them out of the way. */ case '*': case '+': case '?': case '{': ERR(REG_BADRPT); return; default: ERR(REG_ASSERT); return; /* * Then plain characters, and minor variants on that theme. */ case ')': /* unbalanced paren */ if ((v->cflags®_ADVANCED) != REG_EXTENDED) { ERR(REG_EPAREN); return; } /* * Legal in EREs due to specification botch. */ NOTE(REG_UPBOTCH); /* FALLTHRU */ case PLAIN: onechr(v, v->nextvalue, lp, rp); okcolors(v->nfa, v->cm); NOERR(); NEXT(); break; case '[': if (v->nextvalue == 1) { bracket(v, lp, rp); } else { cbracket(v, lp, rp); } assert(SEE(']') || ISERR()); NEXT(); break; case '.': rainbow(v->nfa, v->cm, PLAIN, (v->cflags®_NLSTOP) ? v->nlcolor : COLORLESS, lp, rp); NEXT(); break; /* * And finally the ugly stuff. */ case '(': /* value flags as capturing or non */ cap = (type == LACON) ? 0 : v->nextvalue; if (cap) { v->nsubexp++; subno = v->nsubexp; if ((size_t)subno >= v->nsubs) { moresubs(v, subno); } assert((size_t)subno < v->nsubs); } else { atomtype = PLAIN; /* something that's not '(' */ } NEXT(); /* * Need new endpoints because tree will contain pointers. */ s = newstate(v->nfa); s2 = newstate(v->nfa); NOERR(); EMPTYARC(lp, s); EMPTYARC(s2, rp); NOERR(); atom = parse(v, ')', PLAIN, s, s2); assert(SEE(')') || ISERR()); NEXT(); NOERR(); if (cap) { v->subs[subno] = atom; t = subre(v, '(', atom->flags|CAP, lp, rp); NOERR(); t->subno = subno; t->left = atom; atom = t; } /* * Postpone everything else pending possible {0}. */ break; case BACKREF: /* the Feature From The Black Lagoon */ INSIST(type != LACON, REG_ESUBREG); INSIST(v->nextvalue < v->nsubs, REG_ESUBREG); INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG); NOERR(); assert(v->nextvalue > 0); atom = subre(v, 'b', BACKR, lp, rp); NOERR(); subno = v->nextvalue; atom->subno = subno; EMPTYARC(lp, rp); /* temporarily, so there's something */ NEXT(); break; } /* * ...and an atom may be followed by a quantifier. */ switch (v->nexttype) { case '*': m = 0; n = DUPINF; qprefer = (v->nextvalue) ? LONGER : SHORTER; NEXT(); break; case '+': m = 1; n = DUPINF; qprefer = (v->nextvalue) ? LONGER : SHORTER; NEXT(); break; case '?': m = 0; n = 1; qprefer = (v->nextvalue) ? LONGER : SHORTER; NEXT(); break; case '{': NEXT(); m = scannum(v); if (EAT(',')) { if (SEE(DIGIT)) { n = scannum(v); } else { n = DUPINF; } if (m > n) { ERR(REG_BADBR); return; } /* * {m,n} exercises preference, even if it's {m,m} */ qprefer = (v->nextvalue) ? LONGER : SHORTER; } else { n = m; /* * {m} passes operand's preference through. */ qprefer = 0; } if (!SEE('}')) { /* catches errors too */ ERR(REG_BADBR); return; } NEXT(); break; default: /* no quantifier */ m = n = 1; qprefer = 0; break; } /* * Annoying special case: {0} or {0,0} cancels everything. */ if (m == 0 && n == 0) { if (atom != NULL) { freesubre(v, atom); } if (atomtype == '(') { v->subs[subno] = NULL; } delsub(v->nfa, lp, rp); EMPTYARC(lp, rp); return; } /* * If not a messy case, avoid hard part. */ assert(!MESSY(top->flags)); f = top->flags | qprefer | ((atom != NULL) ? atom->flags : 0); if (atomtype != '(' && atomtype != BACKREF && !MESSY(UP(f))) { if (!(m == 1 && n == 1)) { repeat(v, lp, rp, m, n); } if (atom != NULL) { freesubre(v, atom); } top->flags = f; return; } /* * hard part: something messy * That is, capturing parens, back reference, short/long clash, or an atom * with substructure containing one of those. */ /* * Now we'll need a subre for the contents even if they're boring. */ if (atom == NULL) { atom = subre(v, '=', 0, lp, rp); NOERR(); } /* * Prepare a general-purpose state skeleton. * * In the no-backrefs case, we want this: * * [lp] ---> [s] ---prefix---> [begin] ---atom---> [end] ---rest---> [rp] * * where prefix is some repetitions of atom. In the general case we need * * [lp] ---> [s] ---iterator---> [s2] ---rest---> [rp] * * where the iterator wraps around [begin] ---atom---> [end] * * We make the s state here for both cases; s2 is made below if needed */ s = newstate(v->nfa); /* first, new endpoints for the atom */ s2 = newstate(v->nfa); NOERR(); moveouts(v->nfa, lp, s); moveins(v->nfa, rp, s2); NOERR(); atom->begin = s; atom->end = s2; s = newstate(v->nfa); /* set up starting state */ NOERR(); EMPTYARC(lp, s); NOERR(); /* * Break remaining subRE into x{...} and what follows. */ t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp); NOERR(); t->left = atom; atomp = &t->left; /* * Here we should recurse... but we must postpone that to the end. */ /* * Split top into prefix and remaining. */ assert(top->op == '=' && top->left == NULL && top->right == NULL); top->left = subre(v, '=', top->flags, top->begin, lp); NOERR(); top->op = '.'; top->right = t; /* * If it's a backref, now is the time to replicate the subNFA. */ if (atomtype == BACKREF) { assert(atom->begin->nouts == 1); /* just the EMPTY */ delsub(v->nfa, atom->begin, atom->end); assert(v->subs[subno] != NULL); /* * And here's why the recursion got postponed: it must wait until the * skeleton is filled in, because it may hit a backref that wants to * copy the filled-in skeleton. */ dupnfa(v->nfa, v->subs[subno]->begin, v->subs[subno]->end, atom->begin, atom->end); NOERR(); } /* * It's quantifier time. If the atom is just a backref, we'll let it deal * with quantifiers internally. */ if (atomtype == BACKREF) { /* * Special case: backrefs have internal quantifiers. */ EMPTYARC(s, atom->begin); /* empty prefix */ /* * Just stuff everything into atom. */ repeat(v, atom->begin, atom->end, m, n); atom->min = (short) m; atom->max = (short) n; atom->flags |= COMBINE(qprefer, atom->flags); /* rest of branch can be strung starting from atom->end */ s2 = atom->end; } else if (m == 1 && n == 1) { /* * No/vacuous quantifier: done. */ EMPTYARC(s, atom->begin); /* empty prefix */ /* rest of branch can be strung starting from atom->end */ s2 = atom->end; } else if (m > 0 && !(atom->flags & BACKR)) { /* * If there's no backrefs involved, we can turn x{m,n} into * x{m-1,n-1}x, with capturing parens in only the second x. This * is valid because we only care about capturing matches from the * final iteration of the quantifier. It's a win because we can * implement the backref-free left side as a plain DFA node, since * we don't really care where its submatches are. */ dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin); assert(m >= 1 && m != DUPINF && n >= 1); repeat(v, s, atom->begin, m-1, (n == DUPINF) ? n : n-1); f = COMBINE(qprefer, atom->flags); t = subre(v, '.', f, s, atom->end); /* prefix and atom */ NOERR(); t->left = subre(v, '=', PREF(f), s, atom->begin); NOERR(); t->right = atom; *atomp = t; /* rest of branch can be strung starting from atom->end */ s2 = atom->end; } else { /* general case: need an iteration node */ s2 = newstate(v->nfa); NOERR(); moveouts(v->nfa, atom->end, s2); NOERR(); dupnfa(v->nfa, atom->begin, atom->end, s, s2); repeat(v, s, s2, m, n); f = COMBINE(qprefer, atom->flags); t = subre(v, '*', f, s, s2); NOERR(); t->min = (short) m; t->max = (short) n; t->left = atom; *atomp = t; /* rest of branch is to be strung from iteration's end state */ } /* * And finally, look after that postponed recursion. */ t = top->right; if (!(SEE('|') || SEE(stopper) || SEE(EOS))) { t->right = parsebranch(v, stopper, type, s2, rp, 1); } else { EMPTYARC(s2, rp); t->right = subre(v, '=', 0, s2, rp); } NOERR(); assert(SEE('|') || SEE(stopper) || SEE(EOS)); t->flags |= COMBINE(t->flags, t->right->flags); top->flags |= COMBINE(top->flags, t->flags); } /* - nonword - generate arcs for non-word-character ahead or behind ^ static void nonword(struct vars *, int, struct state *, struct state *); */ static void nonword( struct vars *v, int dir, /* AHEAD or BEHIND */ struct state *lp, struct state *rp) { int anchor = (dir == AHEAD) ? '$' : '^'; assert(dir == AHEAD || dir == BEHIND); newarc(v->nfa, anchor, 1, lp, rp); newarc(v->nfa, anchor, 0, lp, rp); colorcomplement(v->nfa, v->cm, dir, v->wordchrs, lp, rp); /* (no need for special attention to \n) */ } /* - word - generate arcs for word character ahead or behind ^ static void word(struct vars *, int, struct state *, struct state *); */ static void word( struct vars *v, int dir, /* AHEAD or BEHIND */ struct state *lp, struct state *rp) { assert(dir == AHEAD || dir == BEHIND); cloneouts(v->nfa, v->wordchrs, lp, rp, dir); /* (no need for special attention to \n) */ } /* - scannum - scan a number ^ static int scannum(struct vars *); */ static int /* value, <= DUPMAX */ scannum( struct vars *v) { int n = 0; while (SEE(DIGIT) && n < DUPMAX) { n = n*10 + v->nextvalue; NEXT(); } if (SEE(DIGIT) || n > DUPMAX) { ERR(REG_BADBR); return 0; } return n; } /* - repeat - replicate subNFA for quantifiers * The sub-NFA strung from lp to rp is modified to represent m to n * repetitions of its initial contents. * The duplication sequences used here are chosen carefully so that any * pointers starting out pointing into the subexpression end up pointing into * the last occurrence. (Note that it may not be strung between the same left * and right end states, however!) This used to be important for the subRE * tree, although the important bits are now handled by the in-line code in * parse(), and when this is called, it doesn't matter any more. ^ static void repeat(struct vars *, struct state *, struct state *, int, int); */ static void repeat( struct vars *v, struct state *lp, struct state *rp, int m, int n) { #define SOME 2 #define INF 3 #define PAIR(x, y) ((x)*4 + (y)) #define REDUCE(x) ( ((x) == DUPINF) ? INF : (((x) > 1) ? SOME : (x)) ) const int rm = REDUCE(m); const int rn = REDUCE(n); struct state *s, *s2; switch (PAIR(rm, rn)) { case PAIR(0, 0): /* empty string */ delsub(v->nfa, lp, rp); EMPTYARC(lp, rp); break; case PAIR(0, 1): /* do as x| */ EMPTYARC(lp, rp); break; case PAIR(0, SOME): /* do as x{1,n}| */ repeat(v, lp, rp, 1, n); NOERR(); EMPTYARC(lp, rp); break; case PAIR(0, INF): /* loop x around */ s = newstate(v->nfa); NOERR(); moveouts(v->nfa, lp, s); moveins(v->nfa, rp, s); EMPTYARC(lp, s); EMPTYARC(s, rp); break; case PAIR(1, 1): /* no action required */ break; case PAIR(1, SOME): /* do as x{0,n-1}x = (x{1,n-1}|)x */ s = newstate(v->nfa); NOERR(); moveouts(v->nfa, lp, s); dupnfa(v->nfa, s, rp, lp, s); NOERR(); repeat(v, lp, s, 1, n-1); NOERR(); EMPTYARC(lp, s); break; case PAIR(1, INF): /* add loopback arc */ s = newstate(v->nfa); s2 = newstate(v->nfa); NOERR(); moveouts(v->nfa, lp, s); moveins(v->nfa, rp, s2); EMPTYARC(lp, s); EMPTYARC(s2, rp); EMPTYARC(s2, s); break; case PAIR(SOME, SOME): /* do as x{m-1,n-1}x */ s = newstate(v->nfa); NOERR(); moveouts(v->nfa, lp, s); dupnfa(v->nfa, s, rp, lp, s); NOERR(); repeat(v, lp, s, m-1, n-1); break; case PAIR(SOME, INF): /* do as x{m-1,}x */ s = newstate(v->nfa); NOERR(); moveouts(v->nfa, lp, s); dupnfa(v->nfa, s, rp, lp, s); NOERR(); repeat(v, lp, s, m-1, n); break; default: ERR(REG_ASSERT); break; } } /* - bracket - handle non-complemented bracket expression * Also called from cbracket for complemented bracket expressions. ^ static void bracket(struct vars *, struct state *, struct state *); */ static void bracket( struct vars *v, struct state *lp, struct state *rp) { assert(SEE('[')); NEXT(); while (!SEE(']') && !SEE(EOS)) { brackpart(v, lp, rp); } assert(SEE(']') || ISERR()); okcolors(v->nfa, v->cm); } /* - cbracket - handle complemented bracket expression * We do it by calling bracket() with dummy endpoints, and then complementing * the result. The alternative would be to invoke rainbow(), and then delete * arcs as the b.e. is seen... but that gets messy. ^ static void cbracket(struct vars *, struct state *, struct state *); */ static void cbracket( struct vars *v, struct state *lp, struct state *rp) { struct state *left = newstate(v->nfa); struct state *right = newstate(v->nfa); NOERR(); bracket(v, left, right); if (v->cflags®_NLSTOP) { newarc(v->nfa, PLAIN, v->nlcolor, left, right); } NOERR(); assert(lp->nouts == 0); /* all outarcs will be ours */ /* * Easy part of complementing, and all there is to do since the MCCE code * was removed. */ colorcomplement(v->nfa, v->cm, PLAIN, left, lp, rp); NOERR(); dropstate(v->nfa, left); assert(right->nins == 0); freestate(v->nfa, right); return; } /* - brackpart - handle one item (or range) within a bracket expression ^ static void brackpart(struct vars *, struct state *, struct state *); */ static void brackpart( struct vars *v, struct state *lp, struct state *rp) { celt startc, endc; struct cvec *cv; const chr *startp, *endp; chr c; /* * Parse something, get rid of special cases, take shortcuts. */ switch (v->nexttype) { case RANGE: /* a-b-c or other botch */ ERR(REG_ERANGE); return; break; case PLAIN: c = v->nextvalue; NEXT(); /* * Shortcut for ordinary chr (not range). */ if (!SEE(RANGE)) { onechr(v, c, lp, rp); return; } startc = element(v, &c, &c+1); NOERR(); break; case COLLEL: startp = v->now; endp = scanplain(v); INSIST(startp < endp, REG_ECOLLATE); NOERR(); startc = element(v, startp, endp); NOERR(); break; case ECLASS: startp = v->now; endp = scanplain(v); INSIST(startp < endp, REG_ECOLLATE); NOERR(); startc = element(v, startp, endp); NOERR(); cv = eclass(v, startc, (v->cflags®_ICASE)); NOERR(); dovec(v, cv, lp, rp); return; break; case CCLASS: startp = v->now; endp = scanplain(v); INSIST(startp < endp, REG_ECTYPE); NOERR(); cv = cclass(v, startp, endp, (v->cflags®_ICASE)); NOERR(); dovec(v, cv, lp, rp); return; break; default: ERR(REG_ASSERT); return; break; } if (SEE(RANGE)) { NEXT(); switch (v->nexttype) { case PLAIN: case RANGE: c = v->nextvalue; NEXT(); endc = element(v, &c, &c+1); NOERR(); break; case COLLEL: startp = v->now; endp = scanplain(v); INSIST(startp < endp, REG_ECOLLATE); NOERR(); endc = element(v, startp, endp); NOERR(); break; default: ERR(REG_ERANGE); return; break; } } else { endc = startc; } /* * Ranges are unportable. Actually, standard C does guarantee that digits * are contiguous, but making that an exception is just too complicated. */ if (startc != endc) { NOTE(REG_UUNPORT); } cv = range(v, startc, endc, (v->cflags®_ICASE)); NOERR(); dovec(v, cv, lp, rp); } /* - scanplain - scan PLAIN contents of [. etc. * Certain bits of trickery in lex.c know that this code does not try to look * past the final bracket of the [. etc. ^ static const chr *scanplain(struct vars *); */ static const chr * /* just after end of sequence */ scanplain( struct vars *v) { const chr *endp; assert(SEE(COLLEL) || SEE(ECLASS) || SEE(CCLASS)); NEXT(); endp = v->now; while (SEE(PLAIN)) { endp = v->now; NEXT(); } assert(SEE(END) || ISERR()); NEXT(); return endp; } /* - onechr - fill in arcs for a plain character, and possible case complements * This is mostly a shortcut for efficient handling of the common case. ^ static void onechr(struct vars *, pchr, struct state *, struct state *); */ static void onechr( struct vars *v, pchr c, struct state *lp, struct state *rp) { if (!(v->cflags®_ICASE)) { newarc(v->nfa, PLAIN, subcolor(v->cm, c), lp, rp); return; } /* * Rats, need general case anyway... */ dovec(v, allcases(v, c), lp, rp); } /* - dovec - fill in arcs for each element of a cvec ^ static void dovec(struct vars *, struct cvec *, struct state *, ^ struct state *); */ static void dovec( struct vars *v, struct cvec *cv, struct state *lp, struct state *rp) { chr ch, from, to; const chr *p; int i; for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) { ch = *p; newarc(v->nfa, PLAIN, subcolor(v->cm, ch), lp, rp); } for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) { from = *p; to = *(p+1); if (from <= to) { subrange(v, from, to, lp, rp); } } } /* - wordchrs - set up word-chr list for word-boundary stuff, if needed * The list is kept as a bunch of arcs between two dummy states; it's disposed * of by the unreachable-states sweep in NFA optimization. Does NEXT(). Must * not be called from any unusual lexical context. This should be reconciled * with the \w etc. handling in lex.c, and should be cleaned up to reduce * dependencies on input scanning. ^ static void wordchrs(struct vars *); */ static void wordchrs( struct vars *v) { struct state *left, *right; if (v->wordchrs != NULL) { NEXT(); /* for consistency */ return; } left = newstate(v->nfa); right = newstate(v->nfa); NOERR(); /* * Fine point: implemented with [::], and lexer will set REG_ULOCALE. */ lexword(v); NEXT(); assert(v->savenow != NULL && SEE('[')); bracket(v, left, right); assert((v->savenow != NULL && SEE(']')) || ISERR()); NEXT(); NOERR(); v->wordchrs = left; } /* - subre - allocate a subre ^ static struct subre *subre(struct vars *, int, int, struct state *, ^ struct state *); */ static struct subre * subre( struct vars *v, int op, int flags, struct state *begin, struct state *end) { struct subre *ret = v->treefree; if (ret != NULL) { v->treefree = ret->left; } else { ret = (struct subre *) MALLOC(sizeof(struct subre)); if (ret == NULL) { ERR(REG_ESPACE); return NULL; } ret->chain = v->treechain; v->treechain = ret; } assert(strchr("=b|.*(", op) != NULL); ret->op = op; ret->flags = flags; ret->id = 0; /* will be assigned later */ ret->subno = 0; ret->min = ret->max = 1; ret->left = NULL; ret->right = NULL; ret->begin = begin; ret->end = end; ZAPCNFA(ret->cnfa); return ret; } /* - freesubre - free a subRE subtree ^ static void freesubre(struct vars *, struct subre *); */ static void freesubre( struct vars *v, /* might be NULL */ struct subre *sr) { if (sr == NULL) { return; } if (sr->left != NULL) { freesubre(v, sr->left); } if (sr->right != NULL) { freesubre(v, sr->right); } freesrnode(v, sr); } /* - freesrnode - free one node in a subRE subtree ^ static void freesrnode(struct vars *, struct subre *); */ static void freesrnode( struct vars *v, /* might be NULL */ struct subre *sr) { if (sr == NULL) { return; } if (!NULLCNFA(sr->cnfa)) { freecnfa(&sr->cnfa); } sr->flags = 0; if (v != NULL && v->treechain != NULL) { /* we're still parsing, maybe we can reuse the subre */ sr->left = v->treefree; v->treefree = sr; } else { FREE(sr); } } /* - numst - number tree nodes (assigning "id" indexes) ^ static int numst(struct subre *, int); */ static int /* next number */ numst( struct subre *t, int start) /* starting point for subtree numbers */ { int i; assert(t != NULL); i = start; t->id = (short) i++; if (t->left != NULL) { i = numst(t->left, i); } if (t->right != NULL) { i = numst(t->right, i); } return i; } /* - markst - mark tree nodes as INUSE * Note: this is a great deal more subtle than it looks. During initial * parsing of a regex, all subres are linked into the treechain list; * discarded ones are also linked into the treefree list for possible reuse. * After we are done creating all subres required for a regex, we run markst() * then cleanst(), which results in discarding all subres not reachable from * v->tree. We then clear v->treechain, indicating that subres must be found * by descending from v->tree. This changes the behavior of freesubre(): it * will henceforth FREE() unwanted subres rather than sticking them into the * treefree list. (Doing that any earlier would result in dangling links in * the treechain list.) This all means that freev() will clean up correctly * if invoked before or after markst()+cleanst(); but it would not work if * called partway through this state conversion, so we mustn't error out * in or between these two functions. ^ static void markst(struct subre *); */ static void markst( struct subre *t) { assert(t != NULL); t->flags |= INUSE; if (t->left != NULL) { markst(t->left); } if (t->right != NULL) { markst(t->right); } } /* - cleanst - free any tree nodes not marked INUSE ^ static void cleanst(struct vars *); */ static void cleanst( struct vars *v) { struct subre *t; struct subre *next; for (t = v->treechain; t != NULL; t = next) { next = t->chain; if (!(t->flags&INUSE)) { FREE(t); } } v->treechain = NULL; v->treefree = NULL; /* just on general principles */ } /* - nfatree - turn a subRE subtree into a tree of compacted NFAs ^ static long nfatree(struct vars *, struct subre *, FILE *); */ static long /* optimize results from top node */ nfatree( struct vars *v, struct subre *t, FILE *f) /* for debug output */ { assert(t != NULL && t->begin != NULL); if (t->left != NULL) { (DISCARD) nfatree(v, t->left, f); } if (t->right != NULL) { (DISCARD) nfatree(v, t->right, f); } return nfanode(v, t, f); } /* - nfanode - do one NFA for nfatree ^ static long nfanode(struct vars *, struct subre *, FILE *); */ static long /* optimize results */ nfanode( struct vars *v, struct subre *t, FILE *f) /* for debug output */ { struct nfa *nfa; long ret = 0; char idbuf[50]; assert(t->begin != NULL); if (f != NULL) { fprintf(f, "\n\n\n========= TREE NODE %s ==========\n", stid(t, idbuf, sizeof(idbuf))); } nfa = newnfa(v, v->cm, v->nfa); NOERRZ(); dupnfa(nfa, t->begin, t->end, nfa->init, nfa->final); if (!ISERR()) { specialcolors(nfa); ret = optimize(nfa, f); } if (!ISERR()) { compact(nfa, &t->cnfa); } freenfa(nfa); return ret; } /* - newlacon - allocate a lookahead-constraint subRE ^ static int newlacon(struct vars *, struct state *, struct state *, int); */ static int /* lacon number */ newlacon( struct vars *v, struct state *begin, struct state *end, int pos) { int n; struct subre *newlacons; struct subre *sub; if (v->nlacons == 0) { n = 1; /* skip 0th */ newlacons = (struct subre *) MALLOC(2 * sizeof(struct subre)); } else { n = v->nlacons; newlacons = (struct subre *) REALLOC(v->lacons, (n + 1) * sizeof(struct subre)); } if (newlacons == NULL) { ERR(REG_ESPACE); return 0; } v->lacons = newlacons; v->nlacons = n + 1; sub = &v->lacons[n]; sub->begin = begin; sub->end = end; sub->subno = pos; ZAPCNFA(sub->cnfa); return n; } /* - freelacons - free lookahead-constraint subRE vector ^ static void freelacons(struct subre *, int); */ static void freelacons( struct subre *subs, int n) { struct subre *sub; int i; assert(n > 0); for (sub=subs+1, i=n-1; i>0; sub++, i--) { /* no 0th */ if (!NULLCNFA(sub->cnfa)) { freecnfa(&sub->cnfa); } } FREE(subs); } /* - rfree - free a whole RE (insides of regfree) ^ static void rfree(regex_t *); */ static void rfree( regex_t *re) { struct guts *g; if (re == NULL || re->re_magic != REMAGIC) { return; } re->re_magic = 0; /* invalidate RE */ g = (struct guts *) re->re_guts; re->re_guts = NULL; re->re_fns = NULL; if (g != NULL) { g->magic = 0; freecm(&g->cmap); if (g->tree != NULL) { freesubre(NULL, g->tree); } if (g->lacons != NULL) { freelacons(g->lacons, g->nlacons); } if (!NULLCNFA(g->search)) { freecnfa(&g->search); } FREE(g); } } /* - dump - dump an RE in human-readable form ^ static void dump(regex_t *, FILE *); */ static void dump( regex_t *re, FILE *f) { #ifdef REG_DEBUG struct guts *g; int i; if (re->re_magic != REMAGIC) { fprintf(f, "bad magic number (0x%x not 0x%x)\n", re->re_magic, REMAGIC); } if (re->re_guts == NULL) { fprintf(f, "NULL guts!!!\n"); return; } g = (struct guts *) re->re_guts; if (g->magic != GUTSMAGIC) { fprintf(f, "bad guts magic number (0x%x not 0x%x)\n", g->magic, GUTSMAGIC); } fprintf(f, "\n\n\n========= DUMP ==========\n"); fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n", (int) re->re_nsub, re->re_info, re->re_csize, g->ntree); dumpcolors(&g->cmap, f); if (!NULLCNFA(g->search)) { fprintf(f, "\nsearch:\n"); dumpcnfa(&g->search, f); } for (i = 1; i < g->nlacons; i++) { fprintf(f, "\nla%d (%s):\n", i, (g->lacons[i].subno) ? "positive" : "negative"); dumpcnfa(&g->lacons[i].cnfa, f); } fprintf(f, "\n"); dumpst(g->tree, f, 0); #else (void)re; (void)f; #endif } /* - dumpst - dump a subRE tree ^ static void dumpst(struct subre *, FILE *, int); */ static void dumpst( struct subre *t, FILE *f, int nfapresent) /* is the original NFA still around? */ { if (t == NULL) { fprintf(f, "null tree\n"); } else { stdump(t, f, nfapresent); } fflush(f); } /* - stdump - recursive guts of dumpst ^ static void stdump(struct subre *, FILE *, int); */ static void stdump( struct subre *t, FILE *f, int nfapresent) /* is the original NFA still around? */ { char idbuf[50]; fprintf(f, "%s. `%c'", stid(t, idbuf, sizeof(idbuf)), t->op); if (t->flags&LONGER) { fprintf(f, " longest"); } if (t->flags&SHORTER) { fprintf(f, " shortest"); } if (t->flags&MIXED) { fprintf(f, " hasmixed"); } if (t->flags&CAP) { fprintf(f, " hascapture"); } if (t->flags&BACKR) { fprintf(f, " hasbackref"); } if (!(t->flags&INUSE)) { fprintf(f, " UNUSED"); } if (t->subno != 0) { fprintf(f, " (#%d)", t->subno); } if (t->min != 1 || t->max != 1) { fprintf(f, " {%d,", t->min); if (t->max != DUPINF) { fprintf(f, "%d", t->max); } fprintf(f, "}"); } if (nfapresent) { fprintf(f, " %ld-%ld", (long)t->begin->no, (long)t->end->no); } if (t->left != NULL) { fprintf(f, " L:%s", stid(t->left, idbuf, sizeof(idbuf))); } if (t->right != NULL) { fprintf(f, " R:%s", stid(t->right, idbuf, sizeof(idbuf))); } if (!NULLCNFA(t->cnfa)) { fprintf(f, "\n"); dumpcnfa(&t->cnfa, f); } fprintf(f, "\n"); if (t->left != NULL) { stdump(t->left, f, nfapresent); } if (t->right != NULL) { stdump(t->right, f, nfapresent); } } /* - stid - identify a subtree node for dumping ^ static const char *stid(struct subre *, char *, size_t); */ static const char * /* points to buf or constant string */ stid( struct subre *t, char *buf, size_t bufsize) { /* * Big enough for hex int or decimal t->id? */ if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->id)*3 + 1) { return "unable"; } if (t->id != 0) { snprintf(buf, bufsize, "%d", t->id); } else { snprintf(buf, bufsize, "%p", t); } return buf; } #include "regc_lex.c" #include "regc_color.c" #include "regc_nfa.c" #include "regc_cvec.c" #include "regc_locale.c" /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regcustom.h0000644000175000017500000001134214554262142015440 0ustar sergeisergei/* * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms - with or without * modification - are permitted for any purpose, provided that redistributions * in source form retain this entire copyright notice and indicate the origin * and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Headers if any. */ #include "regex.h" /* * Overrides for regguts.h definitions, if any. */ #define FUNCPTR(name, args) (*name)args #define MALLOC(n) VS(attemptckalloc(n)) #define FREE(p) ckfree(VS(p)) #define REALLOC(p,n) VS(attemptckrealloc(VS(p),n)) /* * Do not insert extras between the "begin" and "end" lines - this chunk is * automatically extracted to be fitted into regex.h. */ /* --- begin --- */ /* Ensure certain things don't sneak in from system headers. */ #ifdef __REG_WIDE_T #undef __REG_WIDE_T #endif #ifdef __REG_WIDE_COMPILE #undef __REG_WIDE_COMPILE #endif #ifdef __REG_WIDE_EXEC #undef __REG_WIDE_EXEC #endif #ifdef __REG_REGOFF_T #undef __REG_REGOFF_T #endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif #ifdef __REG_NOCHAR #undef __REG_NOCHAR #endif /* Interface types */ #define __REG_WIDE_T Tcl_UniChar #define __REG_REGOFF_T long /* Not really right, but good enough... */ /* Names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec #define __REG_NOFRONT /* Don't want regcomp() and regexec() */ #define __REG_NOCHAR /* Or the char versions */ #define regfree TclReFree #define regerror TclReError /* --- end --- */ /* * Internal character type and related. */ typedef Tcl_UniChar chr; /* The type itself. */ typedef int pchr; /* What it promotes to. */ typedef unsigned uchr; /* Unsigned type that will hold a chr. */ typedef int celt; /* Type to hold chr, or NOCELT */ #define NOCELT (-1) /* Celt value which is not valid chr */ #define CHR(c) (UCHAR(c)) /* Turn char literal into chr literal */ #define DIGITVAL(c) ((c)-'0') /* Turn chr digit into its value */ #if TCL_UTF_MAX > 4 #define CHRBITS 32 /* Bits in a chr; must not use sizeof */ #define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */ #define CHR_MAX 0xFFFFFFFF /* CHR_MAX-CHR_MIN+1 should fit in uchr */ #else #define CHRBITS 16 /* Bits in a chr; must not use sizeof */ #define CHR_MIN 0x0000 /* Smallest and largest chr; the value */ #define CHR_MAX 0xFFFF /* CHR_MAX-CHR_MIN+1 should fit in uchr */ #endif /* * Functions operating on chr. */ #define iscalnum(x) Tcl_UniCharIsAlnum(x) #define iscalpha(x) Tcl_UniCharIsAlpha(x) #define iscdigit(x) Tcl_UniCharIsDigit(x) #define iscspace(x) Tcl_UniCharIsSpace(x) /* * Name the external functions. */ #define compile TclReComp #define exec TclReExec /* & Enable/disable debugging code (by whether REG_DEBUG is defined or not). */ #if 0 /* No debug unless requested by makefile. */ #define REG_DEBUG /* */ #endif /* * Method of allocating a local workspace. We used a thread-specific data * space to store this because the regular expression engine is never * reentered from the same thread; it doesn't make any callbacks. */ #if 1 #define AllocVars(vPtr) \ static Tcl_ThreadDataKey varsKey; \ struct vars *vPtr = (struct vars *) \ Tcl_GetThreadData(&varsKey, sizeof(struct vars)) #else /* * This strategy for allocating workspace is "more proper" in some sense, but * quite a bit slower. Using TSD (as above) leads to code that is quite a bit * faster in practice (measured!) */ #define AllocVars(vPtr) \ struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) #define FreeVars(vPtr) \ FREE(vPtr) #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/rege_dfa.c0000644000175000017500000004607314554262142015170 0ustar sergeisergei/* * DFA routines * This file is #included by regexec.c. * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation * of software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * */ /* - longest - longest-preferred matching engine ^ static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *); */ static chr * /* endpoint, or NULL */ longest( struct vars *const v, /* used only for debug and exec flags */ struct dfa *const d, chr *const start, /* where the match should start */ chr *const stop, /* match must end at or before here */ int *const hitstopp) /* record whether hit v->stop, if non-NULL */ { chr *cp; chr *realstop = (stop == v->stop) ? stop : stop + 1; color co; struct sset *css, *ss; chr *post; int i; struct colormap *cm = d->cm; /* * Initialize. */ css = initialize(v, d, start); cp = start; if (hitstopp != NULL) { *hitstopp = 0; } /* * Startup. */ FDEBUG(("+++ startup +++\n")); if (cp == v->start) { co = d->cnfa->bos[(v->eflags®_NOTBOL) ? 0 : 1]; FDEBUG(("color %ld\n", (long)co)); } else { co = GETCOLOR(cm, *(cp - 1)); FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co)); } css = miss(v, d, css, co, cp, start); if (css == NULL) { return NULL; } css->lastseen = cp; /* * Main loop. */ if (v->eflags®_FTRACE) { while (cp < realstop) { FDEBUG(("+++ at c%d +++\n", (int) (css - d->ssets))); co = GETCOLOR(cm, *cp); FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co)); ss = css->outs[co]; if (ss == NULL) { ss = miss(v, d, css, co, cp+1, start); if (ss == NULL) { break; /* NOTE BREAK OUT */ } } cp++; ss->lastseen = cp; css = ss; } } else { while (cp < realstop) { co = GETCOLOR(cm, *cp); ss = css->outs[co]; if (ss == NULL) { ss = miss(v, d, css, co, cp+1, start); if (ss == NULL) { break; /* NOTE BREAK OUT */ } } cp++; ss->lastseen = cp; css = ss; } } /* * Shutdown. */ FDEBUG(("+++ shutdown at c%d +++\n", (int) (css - d->ssets))); if (cp == v->stop && stop == v->stop) { if (hitstopp != NULL) { *hitstopp = 1; } co = d->cnfa->eos[(v->eflags®_NOTEOL) ? 0 : 1]; FDEBUG(("color %ld\n", (long)co)); ss = miss(v, d, css, co, cp, start); /* * Special case: match ended at eol? */ if (ss != NULL && (ss->flags&POSTSTATE)) { return cp; } else if (ss != NULL) { ss->lastseen = cp; /* to be tidy */ } } /* * Find last match, if any. */ post = d->lastpost; for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--) { if ((ss->flags&POSTSTATE) && (post != ss->lastseen) && (post == NULL || post < ss->lastseen)) { post = ss->lastseen; } } if (post != NULL) { /* found one */ return post - 1; } return NULL; } /* - shortest - shortest-preferred matching engine ^ static chr *shortest(struct vars *, struct dfa *, chr *, chr *, chr *, ^ chr **, int *); */ static chr * /* endpoint, or NULL */ shortest( struct vars *const v, struct dfa *const d, chr *const start, /* where the match should start */ chr *const min, /* match must end at or after here */ chr *const max, /* match must end at or before here */ chr **const coldp, /* store coldstart pointer here, if nonNULL */ int *const hitstopp) /* record whether hit v->stop, if non-NULL */ { chr *cp; chr *realmin = (min == v->stop) ? min : min + 1; chr *realmax = (max == v->stop) ? max : max + 1; color co; struct sset *css, *ss; struct colormap *cm = d->cm; /* * Initialize. */ css = initialize(v, d, start); cp = start; if (hitstopp != NULL) { *hitstopp = 0; } /* * Startup. */ FDEBUG(("--- startup ---\n")); if (cp == v->start) { co = d->cnfa->bos[(v->eflags®_NOTBOL) ? 0 : 1]; FDEBUG(("color %ld\n", (long)co)); } else { co = GETCOLOR(cm, *(cp - 1)); FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co)); } css = miss(v, d, css, co, cp, start); if (css == NULL) { return NULL; } css->lastseen = cp; ss = css; /* * Main loop. */ if (v->eflags®_FTRACE) { while (cp < realmax) { FDEBUG(("--- at c%d ---\n", (int) (css - d->ssets))); co = GETCOLOR(cm, *cp); FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co)); ss = css->outs[co]; if (ss == NULL) { ss = miss(v, d, css, co, cp+1, start); if (ss == NULL) { break; /* NOTE BREAK OUT */ } } cp++; ss->lastseen = cp; css = ss; if ((ss->flags&POSTSTATE) && cp >= realmin) { break; /* NOTE BREAK OUT */ } } } else { while (cp < realmax) { co = GETCOLOR(cm, *cp); ss = css->outs[co]; if (ss == NULL) { ss = miss(v, d, css, co, cp+1, start); if (ss == NULL) { break; /* NOTE BREAK OUT */ } } cp++; ss->lastseen = cp; css = ss; if ((ss->flags&POSTSTATE) && cp >= realmin) { break; /* NOTE BREAK OUT */ } } } if (ss == NULL) { return NULL; } if (coldp != NULL) { /* report last no-progress state set, if any */ *coldp = lastCold(v, d); } if ((ss->flags&POSTSTATE) && cp > min) { assert(cp >= realmin); cp--; } else if (cp == v->stop && max == v->stop) { co = d->cnfa->eos[(v->eflags®_NOTEOL) ? 0 : 1]; FDEBUG(("color %ld\n", (long)co)); ss = miss(v, d, css, co, cp, start); /* * Match might have ended at eol. */ if ((ss == NULL || !(ss->flags&POSTSTATE)) && hitstopp != NULL) { *hitstopp = 1; } } if (ss == NULL || !(ss->flags&POSTSTATE)) { return NULL; } return cp; } /* - lastCold - determine last point at which no progress had been made ^ static chr *lastCold(struct vars *, struct dfa *); */ static chr * /* endpoint, or NULL */ lastCold( struct vars *const v, struct dfa *const d) { struct sset *ss; chr *nopr = d->lastnopr; int i; if (nopr == NULL) { nopr = v->start; } for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--) { if ((ss->flags&NOPROGRESS) && nopr < ss->lastseen) { nopr = ss->lastseen; } } return nopr; } /* - newDFA - set up a fresh DFA ^ static struct dfa *newDFA(struct vars *, struct cnfa *, ^ struct colormap *, struct smalldfa *); */ static struct dfa * newDFA( struct vars *const v, struct cnfa *const cnfa, struct colormap *const cm, struct smalldfa *sml) /* preallocated space, may be NULL */ { struct dfa *d; size_t nss = cnfa->nstates * 2; int wordsper = (cnfa->nstates + UBITS - 1) / UBITS; struct smalldfa *smallwas = sml; assert(cnfa != NULL && cnfa->nstates != 0); if (nss <= FEWSTATES && cnfa->ncolors <= FEWCOLORS) { assert(wordsper == 1); if (sml == NULL) { sml = (struct smalldfa *) MALLOC(sizeof(struct smalldfa)); if (sml == NULL) { ERR(REG_ESPACE); return NULL; } } d = &sml->dfa; d->ssets = sml->ssets; d->statesarea = sml->statesarea; d->work = &d->statesarea[nss]; d->outsarea = sml->outsarea; d->incarea = sml->incarea; d->cptsmalloced = 0; d->mallocarea = (smallwas == NULL) ? (char *)sml : NULL; } else { d = (struct dfa *) MALLOC(sizeof(struct dfa)); if (d == NULL) { ERR(REG_ESPACE); return NULL; } d->ssets = (struct sset *) MALLOC(nss * sizeof(struct sset)); d->statesarea = (unsigned *) MALLOC((nss+WORK) * wordsper * sizeof(unsigned)); d->work = &d->statesarea[nss * wordsper]; d->outsarea = (struct sset **) MALLOC(nss * cnfa->ncolors * sizeof(struct sset *)); d->incarea = (struct arcp *) MALLOC(nss * cnfa->ncolors * sizeof(struct arcp)); d->cptsmalloced = 1; d->mallocarea = (char *)d; if (d->ssets == NULL || d->statesarea == NULL || d->outsarea == NULL || d->incarea == NULL) { freeDFA(d); ERR(REG_ESPACE); return NULL; } } d->nssets = (v->eflags®_SMALL) ? 7 : nss; d->nssused = 0; d->nstates = cnfa->nstates; d->ncolors = cnfa->ncolors; d->wordsper = wordsper; d->cnfa = cnfa; d->cm = cm; d->lastpost = NULL; d->lastnopr = NULL; d->search = d->ssets; /* * Initialization of sset fields is done as needed. */ return d; } /* - freeDFA - free a DFA ^ static void freeDFA(struct dfa *); */ static void freeDFA( struct dfa *const d) { if (d->cptsmalloced) { if (d->ssets != NULL) { FREE(d->ssets); } if (d->statesarea != NULL) { FREE(d->statesarea); } if (d->outsarea != NULL) { FREE(d->outsarea); } if (d->incarea != NULL) { FREE(d->incarea); } } if (d->mallocarea != NULL) { FREE(d->mallocarea); } } /* - hash - construct a hash code for a bitvector * There are probably better ways, but they're more expensive. ^ static unsigned hash(unsigned *, int); */ static unsigned hash( unsigned *const uv, const int n) { int i; unsigned h; h = 0; for (i = 0; i < n; i++) { h ^= uv[i]; } return h; } /* - initialize - hand-craft a cache entry for startup, otherwise get ready ^ static struct sset *initialize(struct vars *, struct dfa *, chr *); */ static struct sset * initialize( struct vars *const v, /* used only for debug flags */ struct dfa *const d, chr *const start) { struct sset *ss; int i; /* * Is previous one still there? */ if (d->nssused > 0 && (d->ssets[0].flags&STARTER)) { ss = &d->ssets[0]; } else { /* no, must (re)build it */ ss = getVacantSS(v, d, start, start); for (i = 0; i < d->wordsper; i++) { ss->states[i] = 0; } BSET(ss->states, d->cnfa->pre); ss->hash = HASH(ss->states, d->wordsper); assert(d->cnfa->pre != d->cnfa->post); ss->flags = STARTER|LOCKED|NOPROGRESS; /* * lastseen dealt with below */ } for (i = 0; i < d->nssused; i++) { d->ssets[i].lastseen = NULL; } ss->lastseen = start; /* maybe untrue, but harmless */ d->lastpost = NULL; d->lastnopr = NULL; return ss; } /* - miss - handle a cache miss ^ static struct sset *miss(struct vars *, struct dfa *, struct sset *, ^ pcolor, chr *, chr *); */ static struct sset * /* NULL if goes to empty set */ miss( struct vars *const v, /* used only for debug flags */ struct dfa *const d, struct sset *const css, const pcolor co, chr *const cp, /* next chr */ chr *const start) /* where the attempt got started */ { struct cnfa *cnfa = d->cnfa; unsigned h; struct carc *ca; struct sset *p; int i, isPost, noProgress, gotState, doLAConstraints, sawLAConstraints; /* * For convenience, we can be called even if it might not be a miss. */ if (css->outs[co] != NULL) { FDEBUG(("hit\n")); return css->outs[co]; } FDEBUG(("miss\n")); /* * First, what set of states would we end up in? */ for (i = 0; i < d->wordsper; i++) { d->work[i] = 0; } isPost = 0; noProgress = 1; gotState = 0; for (i = 0; i < d->nstates; i++) { if (ISBSET(css->states, i)) { for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) { if (ca->co == co) { BSET(d->work, ca->to); gotState = 1; if (ca->to == cnfa->post) { isPost = 1; } if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) { noProgress = 0; } FDEBUG(("%d -> %d\n", i, ca->to)); } } } } doLAConstraints = (gotState ? (cnfa->flags&HASLACONS) : 0); sawLAConstraints = 0; while (doLAConstraints) { /* transitive closure */ doLAConstraints = 0; for (i = 0; i < d->nstates; i++) { if (ISBSET(d->work, i)) { for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) { if (ca->co < cnfa->ncolors) { continue; /* NOTE CONTINUE */ } sawLAConstraints = 1; if (ISBSET(d->work, ca->to)) { continue; /* NOTE CONTINUE */ } if (!checkLAConstraint(v, cnfa, cp, ca->co)) { continue; /* NOTE CONTINUE */ } BSET(d->work, ca->to); doLAConstraints = 1; if (ca->to == cnfa->post) { isPost = 1; } if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) { noProgress = 0; } FDEBUG(("%d :> %d\n", i, ca->to)); } } } } if (!gotState) { return NULL; } h = HASH(d->work, d->wordsper); /* * Next, is that in the cache? */ for (p = d->ssets, i = d->nssused; i > 0; p++, i--) { if (HIT(h, d->work, p, d->wordsper)) { FDEBUG(("cached c%d\n", (int) (p - d->ssets))); break; /* NOTE BREAK OUT */ } } if (i == 0) { /* nope, need a new cache entry */ p = getVacantSS(v, d, cp, start); assert(p != css); for (i = 0; i < d->wordsper; i++) { p->states[i] = d->work[i]; } p->hash = h; p->flags = (isPost ? POSTSTATE : 0); if (noProgress) { p->flags |= NOPROGRESS; } /* * lastseen to be dealt with by caller */ } if (!sawLAConstraints) { /* lookahead conds. always cache miss */ FDEBUG(("c%d[%d]->c%d\n", (int) (css - d->ssets), co, (int) (p - d->ssets))); css->outs[co] = p; css->inchain[co] = p->ins; p->ins.ss = css; p->ins.co = (color) co; } return p; } /* - checkLAConstraint - lookahead-constraint checker for miss() ^ static int checkLAConstraint(struct vars *, struct cnfa *, chr *, pcolor); */ static int /* predicate: constraint satisfied? */ checkLAConstraint( struct vars *const v, struct cnfa *const pcnfa, /* parent cnfa */ chr *const cp, const pcolor co) /* "color" of the lookahead constraint */ { int n; struct subre *sub; struct dfa *d; struct smalldfa sd; chr *end; n = co - pcnfa->ncolors; assert(n < v->g->nlacons && v->g->lacons != NULL); FDEBUG(("=== testing lacon %d\n", n)); sub = &v->g->lacons[n]; d = newDFA(v, &sub->cnfa, &v->g->cmap, &sd); if (d == NULL) { ERR(REG_ESPACE); return 0; } end = longest(v, d, cp, v->stop, NULL); freeDFA(d); FDEBUG(("=== lacon %d match %d\n", n, (end != NULL))); return (sub->subno) ? (end != NULL) : (end == NULL); } /* - getVacantSS - get a vacant state set * This routine clears out the inarcs and outarcs, but does not otherwise * clear the innards of the state set -- that's up to the caller. ^ static struct sset *getVacantSS(struct vars *, struct dfa *, chr *, chr *); */ static struct sset * getVacantSS( struct vars *const v, /* used only for debug flags */ struct dfa *const d, chr *const cp, chr *const start) { int i; struct sset *ss, *p; struct arcp ap, lastap = {NULL, 0}; /* silence gcc 4 warning */ color co; ss = pickNextSS(v, d, cp, start); assert(!(ss->flags&LOCKED)); /* * Clear out its inarcs, including self-referential ones. */ ap = ss->ins; while ((p = ap.ss) != NULL) { co = ap.co; FDEBUG(("zapping c%d's %ld outarc\n", (int) (p - d->ssets), (long)co)); p->outs[co] = NULL; ap = p->inchain[co]; p->inchain[co].ss = NULL; /* paranoia */ } ss->ins.ss = NULL; /* * Take it off the inarc chains of the ssets reached by its outarcs. */ for (i = 0; i < d->ncolors; i++) { p = ss->outs[i]; assert(p != ss); /* not self-referential */ if (p == NULL) { continue; /* NOTE CONTINUE */ } FDEBUG(("del outarc %d from c%d's in chn\n", i, (int) (p - d->ssets))); if (p->ins.ss == ss && p->ins.co == i) { p->ins = ss->inchain[i]; } else { assert(p->ins.ss != NULL); for (ap = p->ins; ap.ss != NULL && !(ap.ss == ss && ap.co == i); ap = ap.ss->inchain[ap.co]) { lastap = ap; } assert(ap.ss != NULL); lastap.ss->inchain[lastap.co] = ss->inchain[i]; } ss->outs[i] = NULL; ss->inchain[i].ss = NULL; } /* * If ss was a success state, may need to remember location. */ if ((ss->flags&POSTSTATE) && ss->lastseen != d->lastpost && (d->lastpost == NULL || d->lastpost < ss->lastseen)) { d->lastpost = ss->lastseen; } /* * Likewise for a no-progress state. */ if ((ss->flags&NOPROGRESS) && ss->lastseen != d->lastnopr && (d->lastnopr == NULL || d->lastnopr < ss->lastseen)) { d->lastnopr = ss->lastseen; } return ss; } /* - pickNextSS - pick the next stateset to be used ^ static struct sset *pickNextSS(struct vars *, struct dfa *, chr *, chr *); */ static struct sset * pickNextSS( struct vars *const v, /* used only for debug flags */ struct dfa *const d, chr *const cp, chr *const start) { int i; struct sset *ss, *end; chr *ancient; /* * Shortcut for cases where cache isn't full. */ if (d->nssused < d->nssets) { i = d->nssused; d->nssused++; ss = &d->ssets[i]; FDEBUG(("new c%d\n", i)); /* * Set up innards. */ ss->states = &d->statesarea[i * d->wordsper]; ss->flags = 0; ss->ins.ss = NULL; ss->ins.co = WHITE; /* give it some value */ ss->outs = &d->outsarea[i * d->ncolors]; ss->inchain = &d->incarea[i * d->ncolors]; for (i = 0; i < d->ncolors; i++) { ss->outs[i] = NULL; ss->inchain[i].ss = NULL; } return ss; } /* * Look for oldest, or old enough anyway. */ if (cp - start > d->nssets*2/3) { /* oldest 33% are expendable */ ancient = cp - d->nssets*2/3; } else { ancient = start; } for (ss = d->search, end = &d->ssets[d->nssets]; ss < end; ss++) { if ((ss->lastseen == NULL || ss->lastseen < ancient) && !(ss->flags&LOCKED)) { d->search = ss + 1; FDEBUG(("replacing c%d\n", (int) (ss - d->ssets))); return ss; } } for (ss = d->ssets, end = d->search; ss < end; ss++) { if ((ss->lastseen == NULL || ss->lastseen < ancient) && !(ss->flags&LOCKED)) { d->search = ss + 1; FDEBUG(("replacing c%d\n", (int) (ss - d->ssets))); return ss; } } /* * Nobody's old enough?!? -- something's really wrong. */ FDEBUG(("can't find victim to replace!\n")); assert(NOTREACHED); ERR(REG_ASSERT); return d->ssets; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regerror.c0000644000175000017500000000715314554262142015257 0ustar sergeisergei/* * regerror - error-code expansion * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * */ #include "regguts.h" /* * Unknown-error explanation. */ static const char unk[] = "*** unknown regex error code 0x%x ***"; /* * Struct to map among codes, code names, and explanations. */ static const struct rerr { int code; const char *name; const char *explain; } rerrs[] = { /* The actual table is built from regex.h */ #include "regerrs.h" { -1, "", "oops" }, /* explanation special-cased in code */ }; /* - regerror - the interface to error numbers */ size_t /* Actual space needed (including NUL) */ regerror( int code, /* Error code, or REG_ATOI or REG_ITOA */ char *errbuf, /* Result buffer (unless errbuf_size==0) */ size_t errbuf_size) /* Available space in errbuf, can be 0 */ { const struct rerr *r; const char *msg; char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */ size_t len; int icode; switch (code) { case REG_ATOI: /* Convert name to number */ for (r = rerrs; r->code >= 0; r++) { if (strcmp(r->name, errbuf) == 0) { break; } } snprintf(convbuf, sizeof(convbuf), "%d", r->code); /* -1 for unknown */ msg = convbuf; break; case REG_ITOA: /* Convert number to name */ icode = atoi(errbuf); /* Not our problem if this fails */ for (r = rerrs; r->code >= 0; r++) { if (r->code == icode) { break; } } if (r->code >= 0) { msg = r->name; } else { /* Unknown; tell him the number */ snprintf(convbuf, sizeof(convbuf), "REG_%u", (unsigned)icode); msg = convbuf; } break; default: /* A real, normal error code */ for (r = rerrs; r->code >= 0; r++) { if (r->code == code) { break; } } if (r->code >= 0) { msg = r->explain; } else { /* Unknown; say so */ snprintf(convbuf, sizeof(convbuf), unk, code); msg = convbuf; } break; } len = strlen(msg) + 1; /* Space needed, including NUL */ if (errbuf_size > 0) { if (errbuf_size > len) { strcpy(errbuf, msg); } else { /* Truncate to fit */ strncpy(errbuf, msg, errbuf_size-1); errbuf[errbuf_size-1] = '\0'; } } return len; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regerrs.h0000644000175000017500000000225614554262142015105 0ustar sergeisergei{ REG_OKAY, "REG_OKAY", "no errors detected" }, { REG_NOMATCH, "REG_NOMATCH", "failed to match" }, { REG_BADPAT, "REG_BADPAT", "invalid regexp (reg version 0.8)" }, { REG_ECOLLATE, "REG_ECOLLATE", "invalid collating element" }, { REG_ECTYPE, "REG_ECTYPE", "invalid character class" }, { REG_EESCAPE, "REG_EESCAPE", "invalid escape \\ sequence" }, { REG_ESUBREG, "REG_ESUBREG", "invalid backreference number" }, { REG_EBRACK, "REG_EBRACK", "brackets [] not balanced" }, { REG_EPAREN, "REG_EPAREN", "parentheses () not balanced" }, { REG_EBRACE, "REG_EBRACE", "braces {} not balanced" }, { REG_BADBR, "REG_BADBR", "invalid repetition count(s)" }, { REG_ERANGE, "REG_ERANGE", "invalid character range" }, { REG_ESPACE, "REG_ESPACE", "out of memory" }, { REG_BADRPT, "REG_BADRPT", "quantifier operand invalid" }, { REG_ASSERT, "REG_ASSERT", "\"can't happen\" -- you found a bug" }, { REG_INVARG, "REG_INVARG", "invalid argument to regex function" }, { REG_MIXED, "REG_MIXED", "character widths of regex and string differ" }, { REG_BADOPT, "REG_BADOPT", "invalid embedded option" }, { REG_ETOOBIG, "REG_ETOOBIG", "regular expression is too complex" }, { REG_ECOLORS, "REG_ECOLORS", "too many colors" }, tcl8.6.14/generic/regexec.c0000644000175000017500000010602314554262142015046 0ustar sergeisergei/* * re_*exec and friends - match REs * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "regguts.h" /* * Lazy-DFA representation. */ struct arcp { /* "pointer" to an outarc */ struct sset *ss; color co; }; struct sset { /* state set */ unsigned *states; /* pointer to bitvector */ unsigned hash; /* hash of bitvector */ #define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw)) #define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \ memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0)) int flags; #define STARTER 01 /* the initial state set */ #define POSTSTATE 02 /* includes the goal state */ #define LOCKED 04 /* locked in cache */ #define NOPROGRESS 010 /* zero-progress state set */ struct arcp ins; /* chain of inarcs pointing here */ chr *lastseen; /* last entered on arrival here */ struct sset **outs; /* outarc vector indexed by color */ struct arcp *inchain; /* chain-pointer vector for outarcs */ }; struct dfa { int nssets; /* size of cache */ int nssused; /* how many entries occupied yet */ int nstates; /* number of states */ int ncolors; /* length of outarc and inchain vectors */ int wordsper; /* length of state-set bitvectors */ struct sset *ssets; /* state-set cache */ unsigned *statesarea; /* bitvector storage */ unsigned *work; /* pointer to work area within statesarea */ struct sset **outsarea; /* outarc-vector storage */ struct arcp *incarea; /* inchain storage */ struct cnfa *cnfa; struct colormap *cm; chr *lastpost; /* location of last cache-flushed success */ chr *lastnopr; /* location of last cache-flushed NOPROGRESS */ struct sset *search; /* replacement-search-pointer memory */ int cptsmalloced; /* were the areas individually malloced? */ char *mallocarea; /* self, or malloced area, or NULL */ }; #define WORK 1 /* number of work bitvectors needed */ /* * Setup for non-malloc allocation for small cases. */ #define FEWSTATES 20 /* must be less than UBITS */ #define FEWCOLORS 15 struct smalldfa { struct dfa dfa; struct sset ssets[FEWSTATES*2]; unsigned statesarea[FEWSTATES*2 + WORK]; struct sset *outsarea[FEWSTATES*2 * FEWCOLORS]; struct arcp incarea[FEWSTATES*2 * FEWCOLORS]; }; #define DOMALLOC ((struct smalldfa *)NULL) /* force malloc */ /* * Internal variables, bundled for easy passing around. */ struct vars { regex_t *re; struct guts *g; int eflags; /* copies of arguments */ size_t nmatch; regmatch_t *pmatch; rm_detail_t *details; chr *start; /* start of string */ chr *stop; /* just past end of string */ int err; /* error code if any (0 none) */ struct dfa **subdfas; /* per-subre DFAs */ struct smalldfa dfa1; struct smalldfa dfa2; }; #define VISERR(vv) ((vv)->err != 0) /* have we seen an error yet? */ #define ISERR() VISERR(v) #define VERR(vv,e) ((vv)->err = ((vv)->err ? (vv)->err : (e))) #define ERR(e) VERR(v, e) /* record an error */ #define NOERR() {if (ISERR()) return v->err;} /* if error seen, return it */ #define OFF(p) ((p) - v->start) #define LOFF(p) ((long)OFF(p)) /* * forward declarations */ /* =====^!^===== begin forwards =====^!^===== */ /* automatically gathered by fwd; do not hand-edit */ /* === regexec.c === */ int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int); static struct dfa *getsubdfa(struct vars *, struct subre *); static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const); static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const); static int complicatedFindLoop(struct vars *const, struct dfa *const, struct dfa *const, chr **const); static void zapallsubs(regmatch_t *const, const size_t); static void zaptreesubs(struct vars *const, struct subre *const); static void subset(struct vars *const, struct subre *const, chr *const, chr *const); static int cdissect(struct vars *, struct subre *, chr *, chr *); static int ccondissect(struct vars *, struct subre *, chr *, chr *); static int crevcondissect(struct vars *, struct subre *, chr *, chr *); static int cbrdissect(struct vars *, struct subre *, chr *, chr *); static int caltdissect(struct vars *, struct subre *, chr *, chr *); static int citerdissect(struct vars *, struct subre *, chr *, chr *); static int creviterdissect(struct vars *, struct subre *, chr *, chr *); /* === rege_dfa.c === */ static chr *longest(struct vars *const, struct dfa *const, chr *const, chr *const, int *const); static chr *shortest(struct vars *const, struct dfa *const, chr *const, chr *const, chr *const, chr **const, int *const); static chr *lastCold(struct vars *const, struct dfa *const); static struct dfa *newDFA(struct vars *const, struct cnfa *const, struct colormap *const, struct smalldfa *); static void freeDFA(struct dfa *const); static unsigned hash(unsigned *const, const int); static struct sset *initialize(struct vars *const, struct dfa *const, chr *const); static struct sset *miss(struct vars *const, struct dfa *const, struct sset *const, const pcolor, chr *const, chr *const); static int checkLAConstraint(struct vars *const, struct cnfa *const, chr *const, const pcolor); static struct sset *getVacantSS(struct vars *const, struct dfa *const, chr *const, chr *const); static struct sset *pickNextSS(struct vars *const, struct dfa *const, chr *const, chr *const); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ /* - exec - match regular expression ^ int exec(regex_t *, const chr *, size_t, rm_detail_t *, ^ size_t, regmatch_t [], int); */ int exec( regex_t *re, const chr *string, size_t len, rm_detail_t *details, size_t nmatch, regmatch_t pmatch[], int flags) { AllocVars(v); int st, backref; size_t n; size_t i; #define LOCALMAT 20 regmatch_t mat[LOCALMAT]; #define LOCALDFAS 40 struct dfa *subdfas[LOCALDFAS]; /* * Sanity checks. */ if (re == NULL || string == NULL || re->re_magic != REMAGIC) { FreeVars(v); return REG_INVARG; } if (re->re_csize != sizeof(chr)) { FreeVars(v); return REG_MIXED; } /* * Setup. */ v->re = re; v->g = (struct guts *)re->re_guts; if ((v->g->cflags®_EXPECT) && details == NULL) { FreeVars(v); return REG_INVARG; } if (v->g->info®_UIMPOSSIBLE) { FreeVars(v); return REG_NOMATCH; } backref = (v->g->info®_UBACKREF) ? 1 : 0; v->eflags = flags; if (v->g->cflags®_NOSUB) { nmatch = 0; /* override client */ } v->nmatch = nmatch; if (backref) { /* * Need work area. */ if (v->g->nsub + 1 <= LOCALMAT) { v->pmatch = mat; } else { v->pmatch = (regmatch_t *) MALLOC((v->g->nsub + 1) * sizeof(regmatch_t)); } if (v->pmatch == NULL) { FreeVars(v); return REG_ESPACE; } v->nmatch = v->g->nsub + 1; } else { v->pmatch = pmatch; } v->details = details; v->start = (chr *)string; v->stop = (chr *)string + len; v->err = 0; assert(v->g->ntree >= 0); n = (size_t) v->g->ntree; if (n <= LOCALDFAS) { v->subdfas = subdfas; } else { v->subdfas = (struct dfa **) MALLOC(n * sizeof(struct dfa *)); } if (v->subdfas == NULL) { if (v->pmatch != pmatch && v->pmatch != mat) FREE(v->pmatch); FreeVars(v); return REG_ESPACE; } for (i = 0; i < n; i++) v->subdfas[i] = NULL; /* * Do it. */ assert(v->g->tree != NULL); if (backref) { st = complicatedFind(v, &v->g->tree->cnfa, &v->g->cmap); } else { st = simpleFind(v, &v->g->tree->cnfa, &v->g->cmap); } /* * Copy (portion of) match vector over if necessary. */ if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) { zapallsubs(pmatch, nmatch); n = (nmatch < v->nmatch) ? nmatch : v->nmatch; memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t)); } /* * Clean up. */ if (v->pmatch != pmatch && v->pmatch != mat) { FREE(v->pmatch); } n = (size_t) v->g->ntree; for (i = 0; i < n; i++) { if (v->subdfas[i] != NULL) freeDFA(v->subdfas[i]); } if (v->subdfas != subdfas) FREE(v->subdfas); FreeVars(v); return st; } /* - getsubdfa - create or re-fetch the DFA for a subre node * We only need to create the DFA once per overall regex execution. * The DFA will be freed by the cleanup step in exec(). */ static struct dfa * getsubdfa(struct vars * v, struct subre * t) { if (v->subdfas[t->id] == NULL) { v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, DOMALLOC); if (ISERR()) return NULL; } return v->subdfas[t->id]; } /* - simpleFind - find a match for the main NFA (no-complications case) ^ static int simpleFind(struct vars *, struct cnfa *, struct colormap *); */ static int simpleFind( struct vars *const v, struct cnfa *const cnfa, struct colormap *const cm) { struct dfa *s, *d; chr *begin, *end = NULL; chr *cold; chr *open, *close; /* Open and close of range of possible * starts */ int hitend; int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0; /* * First, a shot with the search RE. */ s = newDFA(v, &v->g->search, cm, &v->dfa1); assert(!(ISERR() && s != NULL)); NOERR(); MDEBUG(("\nsearch at %ld\n", LOFF(v->start))); cold = NULL; close = shortest(v, s, v->start, v->start, v->stop, &cold, NULL); freeDFA(s); NOERR(); if (v->g->cflags®_EXPECT) { assert(v->details != NULL); if (cold != NULL) { v->details->rm_extend.rm_so = OFF(cold); } else { v->details->rm_extend.rm_so = OFF(v->stop); } v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */ } if (close == NULL) { /* not found */ return REG_NOMATCH; } if (v->nmatch == 0) { /* found, don't need exact location */ return REG_OKAY; } /* * Find starting point and match. */ assert(cold != NULL); open = cold; cold = NULL; MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close))); d = newDFA(v, cnfa, cm, &v->dfa1); assert(!(ISERR() && d != NULL)); NOERR(); for (begin = open; begin <= close; begin++) { MDEBUG(("\nfind trying at %ld\n", LOFF(begin))); if (shorter) { end = shortest(v, d, begin, begin, v->stop, NULL, &hitend); } else { end = longest(v, d, begin, v->stop, &hitend); } if (ISERR()) { freeDFA(d); return v->err; } if (hitend && cold == NULL) { cold = begin; } if (end != NULL) { break; /* NOTE BREAK OUT */ } } assert(end != NULL); /* search RE succeeded so loop should */ freeDFA(d); /* * And pin down details. */ assert(v->nmatch > 0); v->pmatch[0].rm_so = OFF(begin); v->pmatch[0].rm_eo = OFF(end); if (v->g->cflags®_EXPECT) { if (cold != NULL) { v->details->rm_extend.rm_so = OFF(cold); } else { v->details->rm_extend.rm_so = OFF(v->stop); } v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */ } if (v->nmatch == 1) { /* no need for submatches */ return REG_OKAY; } /* * Find submatches. */ zapallsubs(v->pmatch, v->nmatch); return cdissect(v, v->g->tree, begin, end); } /* - complicatedFind - find a match for the main NFA (with complications) ^ static int complicatedFind(struct vars *, struct cnfa *, struct colormap *); */ static int complicatedFind( struct vars *const v, struct cnfa *const cnfa, struct colormap *const cm) { struct dfa *s, *d; chr *cold = NULL; /* silence gcc 4 warning */ int ret; s = newDFA(v, &v->g->search, cm, &v->dfa1); NOERR(); d = newDFA(v, cnfa, cm, &v->dfa2); if (ISERR()) { assert(d == NULL); freeDFA(s); return v->err; } ret = complicatedFindLoop(v, d, s, &cold); freeDFA(d); freeDFA(s); NOERR(); if (v->g->cflags®_EXPECT) { assert(v->details != NULL); if (cold != NULL) { v->details->rm_extend.rm_so = OFF(cold); } else { v->details->rm_extend.rm_so = OFF(v->stop); } v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */ } return ret; } /* - complicatedFindLoop - the heart of complicatedFind ^ static int complicatedFindLoop(struct vars *, ^ struct dfa *, struct dfa *, chr **); */ static int complicatedFindLoop( struct vars *const v, struct dfa *const d, struct dfa *const s, chr **const coldp) /* where to put coldstart pointer */ { chr *begin, *end; chr *cold; chr *open, *close; /* Open and close of range of possible * starts */ chr *estart, *estop; int er, hitend; int shorter = v->g->tree->flags&SHORTER; assert(d != NULL && s != NULL); cold = NULL; close = v->start; do { MDEBUG(("\ncsearch at %ld\n", LOFF(close))); close = shortest(v, s, close, close, v->stop, &cold, NULL); if (close == NULL) { break; /* NOTE BREAK */ } assert(cold != NULL); open = cold; cold = NULL; MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close))); for (begin = open; begin <= close; begin++) { MDEBUG(("\ncomplicatedFind trying at %ld\n", LOFF(begin))); estart = begin; estop = v->stop; for (;;) { if (shorter) { end = shortest(v, d, begin, estart, estop, NULL, &hitend); } else { end = longest(v, d, begin, estop, &hitend); } if (hitend && cold == NULL) { cold = begin; } if (end == NULL) { break; /* NOTE BREAK OUT */ } MDEBUG(("tentative end %ld\n", LOFF(end))); zapallsubs(v->pmatch, v->nmatch); er = cdissect(v, v->g->tree, begin, end); if (er == REG_OKAY) { if (v->nmatch > 0) { v->pmatch[0].rm_so = OFF(begin); v->pmatch[0].rm_eo = OFF(end); } *coldp = cold; return REG_OKAY; } if (er != REG_NOMATCH) { ERR(er); *coldp = cold; return er; } if ((shorter) ? end == estop : end == begin) { break; } /* * Go around and try again */ if (shorter) { estart = end + 1; } else { estop = end - 1; } } } } while (close < v->stop); *coldp = cold; return REG_NOMATCH; } /* - zapallsubs - initialize all subexpression matches to "no match" ^ static void zapallsubs(regmatch_t *, size_t); */ static void zapallsubs( regmatch_t *const p, const size_t n) { size_t i; for (i = n-1; i > 0; i--) { p[i].rm_so = -1; p[i].rm_eo = -1; } } /* - zaptreesubs - initialize subexpressions within subtree to "no match" ^ static void zaptreesubs(struct vars *, struct subre *); */ static void zaptreesubs( struct vars *const v, struct subre *const t) { if (t->op == '(') { int n = t->subno; assert(n > 0); if ((size_t) n < v->nmatch) { v->pmatch[n].rm_so = -1; v->pmatch[n].rm_eo = -1; } } if (t->left != NULL) { zaptreesubs(v, t->left); } if (t->right != NULL) { zaptreesubs(v, t->right); } } /* - subset - set subexpression match data for a successful subre ^ static void subset(struct vars *, struct subre *, chr *, chr *); */ static void subset( struct vars *const v, struct subre *const sub, chr *const begin, chr *const end) { int n = sub->subno; assert(n > 0); if ((size_t)n >= v->nmatch) { return; } MDEBUG(("setting %d\n", n)); v->pmatch[n].rm_so = OFF(begin); v->pmatch[n].rm_eo = OFF(end); } /* - cdissect - check backrefs and determine subexpression matches * cdissect recursively processes a subre tree to check matching of backrefs * and/or identify submatch boundaries for capture nodes. The proposed match * runs from "begin" to "end" (not including "end"), and we are basically * "dissecting" it to see where the submatches are. * Before calling any level of cdissect, the caller must have run the node's * DFA and found that the proposed substring satisfies the DFA. (We make * the caller do that because in concatenation and iteration nodes, it's * much faster to check all the substrings against the child DFAs before we * recurse.) Also, caller must have cleared subexpression match data via * zaptreesubs (or zapallsubs at the top level). ^ static int cdissect(struct vars *, struct subre *, chr *, chr *); */ static int /* regexec return code */ cdissect( struct vars *v, struct subre *t, chr *begin, /* beginning of relevant substring */ chr *end) /* end of same */ { int er; assert(t != NULL); MDEBUG(("cdissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op)); switch (t->op) { case '=': /* terminal node */ assert(t->left == NULL && t->right == NULL); er = REG_OKAY; /* no action, parent did the work */ break; case 'b': /* back reference */ assert(t->left == NULL && t->right == NULL); er = cbrdissect(v, t, begin, end); break; case '.': /* concatenation */ assert(t->left != NULL && t->right != NULL); if (t->left->flags & SHORTER) {/* reverse scan */ er = crevcondissect(v, t, begin, end); } else { er = ccondissect(v, t, begin, end); } break; case '|': /* alternation */ assert(t->left != NULL); er = caltdissect(v, t, begin, end); break; case '*': /* iteration */ assert(t->left != NULL); if (t->left->flags & SHORTER) {/* reverse scan */ er = creviterdissect(v, t, begin, end); } else { er = citerdissect(v, t, begin, end); } break; case '(': /* capturing */ assert(t->left != NULL && t->right == NULL); assert(t->subno > 0); er = cdissect(v, t->left, begin, end); if (er == REG_OKAY) { subset(v, t, begin, end); } break; default: er = REG_ASSERT; break; } /* * We should never have a match failure unless backrefs lurk below; * otherwise, either caller failed to check the DFA, or there's some * inconsistency between the DFA and the node's innards. */ assert(er != REG_NOMATCH || (t->flags & BACKR)); return er; } /* - ccondissect - dissect match for concatenation node ^ static int ccondissect(struct vars *, struct subre *, chr *, chr *); */ static int /* regexec return code */ ccondissect( struct vars *v, struct subre *t, chr *begin, /* beginning of relevant substring */ chr *end) /* end of same */ { struct dfa *d, *d2; chr *mid; assert(t->op == '.'); assert(t->left != NULL && t->left->cnfa.nstates > 0); assert(t->right != NULL && t->right->cnfa.nstates > 0); assert(!(t->left->flags & SHORTER)); d = getsubdfa(v, t->left); NOERR(); d2 = getsubdfa(v, t->right); NOERR(); MDEBUG(("cConcat %d\n", t->id)); /* * Pick a tentative midpoint. */ mid = longest(v, d, begin, end, (int *) NULL); if (mid == NULL) { return REG_NOMATCH; } MDEBUG(("tentative midpoint %ld\n", LOFF(mid))); /* * Iterate until satisfaction or failure. */ for (;;) { /* * Try this midpoint on for size. */ if (longest(v, d2, mid, end, NULL) == end) { int er = cdissect(v, t->left, begin, mid); if (er == REG_OKAY) { er = cdissect(v, t->right, mid, end); if (er == REG_OKAY) { /* * Satisfaction. */ MDEBUG(("successful\n")); return REG_OKAY; } } if (er != REG_NOMATCH) { return er; } } /* * That midpoint didn't work, find a new one. */ if (mid == begin) { /* * All possibilities exhausted. */ MDEBUG(("%d no midpoint\n", t->id)); return REG_NOMATCH; } mid = longest(v, d, begin, mid-1, NULL); if (mid == NULL) { /* * Failed to find a new one. */ MDEBUG(("%d failed midpoint\n", t->id)); return REG_NOMATCH; } MDEBUG(("%d: new midpoint %ld\n", t->id, LOFF(mid))); zaptreesubs(v, t->left); zaptreesubs(v, t->right); } } /* - crevcondissect - dissect match for concatenation node, shortest-first ^ static int crevcondissect(struct vars *, struct subre *, chr *, chr *); */ static int /* regexec return code */ crevcondissect( struct vars *v, struct subre *t, chr *begin, /* beginning of relevant substring */ chr *end) /* end of same */ { struct dfa *d, *d2; chr *mid; assert(t->op == '.'); assert(t->left != NULL && t->left->cnfa.nstates > 0); assert(t->right != NULL && t->right->cnfa.nstates > 0); assert(t->left->flags&SHORTER); d = getsubdfa(v, t->left); NOERR(); d2 = getsubdfa(v, t->right); NOERR(); MDEBUG(("crevcon %d\n", t->id)); /* * Pick a tentative midpoint. */ mid = shortest(v, d, begin, begin, end, (chr **) NULL, (int *) NULL); if (mid == NULL) { return REG_NOMATCH; } MDEBUG(("tentative midpoint %ld\n", LOFF(mid))); /* * Iterate until satisfaction or failure. */ for (;;) { /* * Try this midpoint on for size. */ if (longest(v, d2, mid, end, NULL) == end) { int er = cdissect(v, t->left, begin, mid); if (er == REG_OKAY) { er = cdissect(v, t->right, mid, end); if (er == REG_OKAY) { /* * Satisfaction. */ MDEBUG(("successful\n")); return REG_OKAY; } } if (er != REG_NOMATCH) { return er; } } /* * That midpoint didn't work, find a new one. */ if (mid == end) { /* * All possibilities exhausted. */ MDEBUG(("%d no midpoint\n", t->id)); return REG_NOMATCH; } mid = shortest(v, d, begin, mid+1, end, NULL, NULL); if (mid == NULL) { /* * Failed to find a new one. */ MDEBUG(("%d failed midpoint\n", t->id)); return REG_NOMATCH; } MDEBUG(("%d: new midpoint %ld\n", t->id, LOFF(mid))); zaptreesubs(v, t->left); zaptreesubs(v, t->right); } } /* - cbrdissect - dissect match for backref node ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *); */ static int /* regexec return code */ cbrdissect( struct vars *v, struct subre *t, chr *begin, /* beginning of relevant substring */ chr *end) /* end of same */ { int n = t->subno, min = t->min, max = t->max; size_t numreps; size_t tlen; size_t brlen; chr *brstring; chr *p; assert(t != NULL); assert(t->op == 'b'); assert(n >= 0); assert((size_t)n < v->nmatch); MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max)); /* get the backreferenced string */ if (v->pmatch[n].rm_so == -1) { return REG_NOMATCH; } brstring = v->start + v->pmatch[n].rm_so; brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so; /* special cases for zero-length strings */ if (brlen == 0) { /* * matches only if target is zero length, but any number of * repetitions can be considered to be present */ if (begin == end && min <= max) { MDEBUG(("cbackref matched trivially\n")); return REG_OKAY; } return REG_NOMATCH; } if (begin == end) { /* matches only if zero repetitions are okay */ if (min == 0) { MDEBUG(("cbackref matched trivially\n")); return REG_OKAY; } return REG_NOMATCH; } /* * check target length to see if it could possibly be an allowed number of * repetitions of brstring */ assert(end > begin); tlen = end - begin; if (tlen % brlen != 0) return REG_NOMATCH; numreps = tlen / brlen; if (numreps < (size_t)min || (numreps > (size_t)max && max != DUPINF)) return REG_NOMATCH; /* okay, compare the actual string contents */ p = begin; while (numreps-- > 0) { if ((*v->g->compare) (brstring, p, brlen) != 0) return REG_NOMATCH; p += brlen; } MDEBUG(("cbackref matched\n")); return REG_OKAY; } /* - caltdissect - dissect match for alternation node ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *); */ static int /* regexec return code */ caltdissect( struct vars *v, struct subre *t, chr *begin, /* beginning of relevant substring */ chr *end) /* end of same */ { struct dfa *d; int er; /* We loop, rather than tail-recurse, to handle a chain of alternatives */ while (t != NULL) { assert(t->op == '|'); assert(t->left != NULL && t->left->cnfa.nstates > 0); MDEBUG(("calt n%d\n", t->id)); d = getsubdfa(v, t->left); NOERR(); if (longest(v, d, begin, end, (int *) NULL) == end) { MDEBUG(("calt matched\n")); er = cdissect(v, t->left, begin, end); if (er != REG_NOMATCH) { return er; } } t = t->right; } return REG_NOMATCH; } /* - citerdissect - dissect match for iteration node ^ static int citerdissect(struct vars *, struct subre *, chr *, chr *); */ static int /* regexec return code */ citerdissect(struct vars * v, struct subre * t, chr *begin, /* beginning of relevant substring */ chr *end) /* end of same */ { struct dfa *d; chr **endpts; chr *limit; int min_matches; size_t max_matches; int nverified; int k; int i; int er; assert(t->op == '*'); assert(t->left != NULL && t->left->cnfa.nstates > 0); assert(!(t->left->flags & SHORTER)); assert(begin <= end); /* * If zero matches are allowed, and target string is empty, just declare * victory. OTOH, if target string isn't empty, zero matches can't work * so we pretend the min is 1. */ min_matches = t->min; if (min_matches <= 0) { if (begin == end) return REG_OKAY; min_matches = 1; } /* * We need workspace to track the endpoints of each sub-match. Normally * we consider only nonzero-length sub-matches, so there can be at most * end-begin of them. However, if min is larger than that, we will also * consider zero-length sub-matches in order to find enough matches. * * For convenience, endpts[0] contains the "begin" pointer and we store * sub-match endpoints in endpts[1..max_matches]. */ max_matches = end - begin; if (max_matches > (size_t)t->max && t->max != DUPINF) max_matches = t->max; if (max_matches < (size_t)min_matches) max_matches = min_matches; endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *)); if (endpts == NULL) return REG_ESPACE; endpts[0] = begin; d = getsubdfa(v, t->left); if (ISERR()) { FREE(endpts); return v->err; } MDEBUG(("citer %d\n", t->id)); /* * Our strategy is to first find a set of sub-match endpoints that are * valid according to the child node's DFA, and then recursively dissect * each sub-match to confirm validity. If any validity check fails, * backtrack the last sub-match and try again. And, when we next try for * a validity check, we need not recheck any successfully verified * sub-matches that we didn't move the endpoints of. nverified remembers * how many sub-matches are currently known okay. */ /* initialize to consider first sub-match */ nverified = 0; k = 1; limit = end; /* iterate until satisfaction or failure */ while (k > 0) { /* try to find an endpoint for the k'th sub-match */ endpts[k] = longest(v, d, endpts[k - 1], limit, (int *) NULL); if (endpts[k] == NULL) { /* no match possible, so see if we can shorten previous one */ k--; goto backtrack; } MDEBUG(("%d: working endpoint %d: %ld\n", t->id, k, LOFF(endpts[k]))); /* k'th sub-match can no longer be considered verified */ if (nverified >= k) nverified = k - 1; if (endpts[k] != end) { /* haven't reached end yet, try another iteration if allowed */ if ((size_t)k >= max_matches) { /* must try to shorten some previous match */ k--; goto backtrack; } /* reject zero-length match unless necessary to achieve min */ if (endpts[k] == endpts[k - 1] && (k >= min_matches || min_matches - k < end - endpts[k])) goto backtrack; k++; limit = end; continue; } /* * We've identified a way to divide the string into k sub-matches * that works so far as the child DFA can tell. If k is an allowed * number of matches, start the slow part: recurse to verify each * sub-match. We always have k <= max_matches, needn't check that. */ if (k < min_matches) goto backtrack; MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k)); for (i = nverified + 1; i <= k; i++) { zaptreesubs(v, t->left); er = cdissect(v, t->left, endpts[i - 1], endpts[i]); if (er == REG_OKAY) { nverified = i; continue; } if (er == REG_NOMATCH) break; /* oops, something failed */ FREE(endpts); return er; } if (i > k) { /* satisfaction */ MDEBUG(("%d successful\n", t->id)); FREE(endpts); return REG_OKAY; } /* match failed to verify, so backtrack */ backtrack: /* * Must consider shorter versions of the current sub-match. However, * we'll only ask for a zero-length match if necessary. */ while (k > 0) { chr *prev_end = endpts[k - 1]; if (endpts[k] > prev_end) { limit = endpts[k] - 1; if (limit > prev_end || (k < min_matches && min_matches - k >= end - prev_end)) { /* break out of backtrack loop, continue the outer one */ break; } } /* can't shorten k'th sub-match any more, consider previous one */ k--; } } /* all possibilities exhausted */ MDEBUG(("%d failed\n", t->id)); FREE(endpts); return REG_NOMATCH; } /* - creviterdissect - dissect match for iteration node, shortest-first ^ static int creviterdissect(struct vars *, struct subre *, chr *, chr *); */ static int /* regexec return code */ creviterdissect(struct vars * v, struct subre * t, chr *begin, /* beginning of relevant substring */ chr *end) /* end of same */ { struct dfa *d; chr **endpts; chr *limit; int min_matches; size_t max_matches; int nverified; int k; int i; int er; assert(t->op == '*'); assert(t->left != NULL && t->left->cnfa.nstates > 0); assert(t->left->flags & SHORTER); assert(begin <= end); /* * If zero matches are allowed, and target string is empty, just declare * victory. OTOH, if target string isn't empty, zero matches can't work * so we pretend the min is 1. */ min_matches = t->min; if (min_matches <= 0) { if (begin == end) return REG_OKAY; min_matches = 1; } /* * We need workspace to track the endpoints of each sub-match. Normally * we consider only nonzero-length sub-matches, so there can be at most * end-begin of them. However, if min is larger than that, we will also * consider zero-length sub-matches in order to find enough matches. * * For convenience, endpts[0] contains the "begin" pointer and we store * sub-match endpoints in endpts[1..max_matches]. */ max_matches = end - begin; if (max_matches > (size_t)t->max && t->max != DUPINF) max_matches = t->max; if (max_matches < (size_t)min_matches) max_matches = min_matches; endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *)); if (endpts == NULL) return REG_ESPACE; endpts[0] = begin; d = getsubdfa(v, t->left); if (ISERR()) { FREE(endpts); return v->err; } MDEBUG(("creviter %d\n", t->id)); /* * Our strategy is to first find a set of sub-match endpoints that are * valid according to the child node's DFA, and then recursively dissect * each sub-match to confirm validity. If any validity check fails, * backtrack the last sub-match and try again. And, when we next try for * a validity check, we need not recheck any successfully verified * sub-matches that we didn't move the endpoints of. nverified remembers * how many sub-matches are currently known okay. */ /* initialize to consider first sub-match */ nverified = 0; k = 1; limit = begin; /* iterate until satisfaction or failure */ while (k > 0) { /* disallow zero-length match unless necessary to achieve min */ if (limit == endpts[k - 1] && limit != end && (k >= min_matches || min_matches - k < end - limit)) limit++; /* if this is the last allowed sub-match, it must reach to the end */ if ((size_t)k >= max_matches) limit = end; /* try to find an endpoint for the k'th sub-match */ endpts[k] = shortest(v, d, endpts[k - 1], limit, end, (chr **) NULL, (int *) NULL); if (endpts[k] == NULL) { /* no match possible, so see if we can lengthen previous one */ k--; goto backtrack; } MDEBUG(("%d: working endpoint %d: %ld\n", t->id, k, LOFF(endpts[k]))); /* k'th sub-match can no longer be considered verified */ if (nverified >= k) nverified = k - 1; if (endpts[k] != end) { /* haven't reached end yet, try another iteration if allowed */ if ((size_t)k >= max_matches) { /* must try to lengthen some previous match */ k--; goto backtrack; } k++; limit = endpts[k - 1]; continue; } /* * We've identified a way to divide the string into k sub-matches * that works so far as the child DFA can tell. If k is an allowed * number of matches, start the slow part: recurse to verify each * sub-match. We always have k <= max_matches, needn't check that. */ if (k < min_matches) goto backtrack; MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k)); for (i = nverified + 1; i <= k; i++) { zaptreesubs(v, t->left); er = cdissect(v, t->left, endpts[i - 1], endpts[i]); if (er == REG_OKAY) { nverified = i; continue; } if (er == REG_NOMATCH) break; /* oops, something failed */ FREE(endpts); return er; } if (i > k) { /* satisfaction */ MDEBUG(("%d successful\n", t->id)); FREE(endpts); return REG_OKAY; } /* match failed to verify, so backtrack */ backtrack: /* * Must consider longer versions of the current sub-match. */ while (k > 0) { if (endpts[k] < end) { limit = endpts[k] + 1; /* break out of backtrack loop, continue the outer one */ break; } /* can't lengthen k'th sub-match any more, consider previous one */ k--; } } /* all possibilities exhausted */ MDEBUG(("%d failed\n", t->id)); FREE(endpts); return REG_NOMATCH; } #include "rege_dfa.c" /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regex.h0000644000175000017500000002461314554262142014547 0ustar sergeisergei#ifndef _REGEX_H_ #define _REGEX_H_ /* never again */ #include "tclInt.h" /* * regular expressions * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * * Prototypes etc. marked with "^" within comments get gathered up (and * possibly edited) by the regfwd program and inserted near the bottom of this * file. * * We offer the option of declaring one wide-character version of the RE * functions as well as the char versions. To do that, define __REG_WIDE_T to * the type of wide characters (unfortunately, there is no consensus that * wchar_t is suitable) and __REG_WIDE_COMPILE and __REG_WIDE_EXEC to the * names to be used for the compile and execute functions (suggestion: * re_Xcomp and re_Xexec, where X is a letter suggestive of the wide type, * e.g. re_ucomp and re_uexec for Unicode). For cranky old compilers, it may * be necessary to do something like: * #define __REG_WIDE_COMPILE(a,b,c,d) re_Xcomp(a,b,c,d) * #define __REG_WIDE_EXEC(a,b,c,d,e,f,g) re_Xexec(a,b,c,d,e,f,g) * rather than just #defining the names as parameterless macros. * * For some specialized purposes, it may be desirable to suppress the * declarations of the "front end" functions, regcomp() and regexec(), or of * the char versions of the compile and execute functions. To suppress the * front-end functions, define __REG_NOFRONT. To suppress the char versions, * define __REG_NOCHAR. * * The right place to do those defines (and some others you may want, see * below) would be . If you don't have control of that file, the * right place to add your own defines to this file is marked below. This is * normally done automatically, by the makefile and regmkhdr, based on the * contents of regcustom.h. */ /* * voodoo for C++ */ #ifdef __cplusplus extern "C" { #endif /* * Add your own defines, if needed, here. */ /* * Location where a chunk of regcustom.h is automatically spliced into this * file (working from its prototype, regproto.h). */ /* --- begin --- */ /* ensure certain things don't sneak in from system headers */ #ifdef __REG_WIDE_T #undef __REG_WIDE_T #endif #ifdef __REG_WIDE_COMPILE #undef __REG_WIDE_COMPILE #endif #ifdef __REG_WIDE_EXEC #undef __REG_WIDE_EXEC #endif #ifdef __REG_REGOFF_T #undef __REG_REGOFF_T #endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif #ifdef __REG_NOCHAR #undef __REG_NOCHAR #endif /* interface types */ #define __REG_WIDE_T Tcl_UniChar #define __REG_REGOFF_T long /* not really right, but good enough... */ /* names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec #define __REG_NOFRONT /* don't want regcomp() and regexec() */ #define __REG_NOCHAR /* or the char versions */ #define regfree TclReFree #define regerror TclReError /* --- end --- */ /* * interface types etc. */ /* * regoff_t has to be large enough to hold either off_t or ssize_t, and must * be signed; it's only a guess that long is suitable, so we offer * an override. */ #ifdef __REG_REGOFF_T typedef __REG_REGOFF_T regoff_t; #else typedef long regoff_t; #endif /* * other interface types */ /* the biggie, a compiled RE (or rather, a front end to same) */ typedef struct { int re_magic; /* magic number */ size_t re_nsub; /* number of subexpressions */ long re_info; /* information about RE */ #define REG_UBACKREF 000001 #define REG_ULOOKAHEAD 000002 #define REG_UBOUNDS 000004 #define REG_UBRACES 000010 #define REG_UBSALNUM 000020 #define REG_UPBOTCH 000040 #define REG_UBBS 000100 #define REG_UNONPOSIX 000200 #define REG_UUNSPEC 000400 #define REG_UUNPORT 001000 #define REG_ULOCALE 002000 #define REG_UEMPTYMATCH 004000 #define REG_UIMPOSSIBLE 010000 #define REG_USHORTEST 020000 int re_csize; /* sizeof(character) */ char *re_endp; /* backward compatibility kludge */ /* the rest is opaque pointers to hidden innards */ char *re_guts; /* `char *' is more portable than `void *' */ char *re_fns; } regex_t; /* result reporting (may acquire more fields later) */ typedef struct { regoff_t rm_so; /* start of substring */ regoff_t rm_eo; /* end of substring */ } regmatch_t; /* supplementary control and reporting */ typedef struct { regmatch_t rm_extend; /* see REG_EXPECT */ } rm_detail_t; /* * compilation ^ #ifndef __REG_NOCHAR ^ int re_comp(regex_t *, const char *, size_t, int); ^ #endif ^ #ifndef __REG_NOFRONT ^ int regcomp(regex_t *, const char *, int); ^ #endif ^ #ifdef __REG_WIDE_T ^ int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int); ^ #endif */ #define REG_BASIC 000000 /* BREs (convenience) */ #define REG_EXTENDED 000001 /* EREs */ #define REG_ADVF 000002 /* advanced features in EREs */ #define REG_ADVANCED 000003 /* AREs (which are also EREs) */ #define REG_QUOTE 000004 /* no special characters, none */ #define REG_NOSPEC REG_QUOTE /* historical synonym */ #define REG_ICASE 000010 /* ignore case */ #define REG_NOSUB 000020 /* don't care about subexpressions */ #define REG_EXPANDED 000040 /* expanded format, white space & comments */ #define REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */ #define REG_NLANCH 000200 /* ^ matches after \n, $ before */ #define REG_NEWLINE 000300 /* newlines are line terminators */ #define REG_PEND 000400 /* ugh -- backward-compatibility hack */ #define REG_EXPECT 001000 /* report details on partial/limited matches */ #define REG_BOSONLY 002000 /* temporary kludge for BOS-only matches */ #define REG_DUMP 004000 /* none of your business :-) */ #define REG_FAKE 010000 /* none of your business :-) */ #define REG_PROGRESS 020000 /* none of your business :-) */ /* * execution ^ #ifndef __REG_NOCHAR ^ int re_exec(regex_t *, const char *, size_t, ^ rm_detail_t *, size_t, regmatch_t [], int); ^ #endif ^ #ifndef __REG_NOFRONT ^ int regexec(regex_t *, const char *, size_t, regmatch_t [], int); ^ #endif ^ #ifdef __REG_WIDE_T ^ int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, ^ rm_detail_t *, size_t, regmatch_t [], int); ^ #endif */ #define REG_NOTBOL 0001 /* BOS is not BOL */ #define REG_NOTEOL 0002 /* EOS is not EOL */ #define REG_STARTEND 0004 /* backward compatibility kludge */ #define REG_FTRACE 0010 /* none of your business */ #define REG_MTRACE 0020 /* none of your business */ #define REG_SMALL 0040 /* none of your business */ /* * misc generics (may be more functions here eventually) ^ void regfree(regex_t *); */ /* * error reporting * Be careful if modifying the list of error codes -- the table used by * regerror() is generated automatically from this file! * * Note that there is no wide-char variant of regerror at this time; what kind * of character is used for error reports is independent of what kind is used * in matching. * ^ extern size_t regerror(int, char *, size_t); */ #define REG_OKAY 0 /* no errors detected */ #define REG_NOMATCH 1 /* failed to match */ #define REG_BADPAT 2 /* invalid regexp */ #define REG_ECOLLATE 3 /* invalid collating element */ #define REG_ECTYPE 4 /* invalid character class */ #define REG_EESCAPE 5 /* invalid escape \ sequence */ #define REG_ESUBREG 6 /* invalid backreference number */ #define REG_EBRACK 7 /* brackets [] not balanced */ #define REG_EPAREN 8 /* parentheses () not balanced */ #define REG_EBRACE 9 /* braces {} not balanced */ #define REG_BADBR 10 /* invalid repetition count(s) */ #define REG_ERANGE 11 /* invalid character range */ #define REG_ESPACE 12 /* out of memory */ #define REG_BADRPT 13 /* quantifier operand invalid */ #define REG_ASSERT 15 /* "can't happen" -- you found a bug */ #define REG_INVARG 16 /* invalid argument to regex function */ #define REG_MIXED 17 /* character widths of regex and string differ */ #define REG_BADOPT 18 /* invalid embedded option */ #define REG_ETOOBIG 19 /* regular expression is too complex */ #define REG_ECOLORS 20 /* too many colors */ /* two specials for debugging and testing */ #define REG_ATOI 101 /* convert error-code name to number */ #define REG_ITOA 102 /* convert error-code number to name */ /* * the prototypes, as possibly munched by regfwd */ /* =====^!^===== begin forwards =====^!^===== */ /* automatically gathered by fwd; do not hand-edit */ /* === regproto.h === */ #ifndef __REG_NOCHAR int re_comp(regex_t *, const char *, size_t, int); #endif #ifndef __REG_NOFRONT int regcomp(regex_t *, const char *, int); #endif #ifdef __REG_WIDE_T MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int); #endif #ifndef __REG_NOCHAR int re_exec(regex_t *, const char *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif #ifndef __REG_NOFRONT int regexec(regex_t *, const char *, size_t, regmatch_t [], int); #endif #ifdef __REG_WIDE_T MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif MODULE_SCOPE void regfree(regex_t *); MODULE_SCOPE size_t regerror(int, char *, size_t); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ /* * more C++ voodoo */ #ifdef __cplusplus } #endif #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regfree.c0000644000175000017500000000420114554262142015036 0ustar sergeisergei/* * regfree - free an RE * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * You might think that this could be incorporated into regcomp.c, and that * would be a reasonable idea... except that this is a generic function (with * a generic name), applicable to all compiled REs regardless of the size of * their characters, whereas the stuff in regcomp.c gets compiled once per * character size. */ #include "regguts.h" /* - regfree - free an RE (generic function, punts to RE-specific function) * * Ignoring invocation with NULL is a convenience. */ void regfree( regex_t *re) { if (re == NULL) { return; } (*((struct fns *)re->re_fns)->free)(re); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regfronts.c0000644000175000017500000000470314554262142015437 0ustar sergeisergei/* * regcomp and regexec - front ends to re_ routines * * Mostly for implementation of backward-compatibility kludges. Note that * these routines exist ONLY in char versions. * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "regguts.h" /* - regcomp - compile regular expression */ int regcomp( regex_t *re, const char *str, int flags) { size_t len; int f = flags; if (f®_PEND) { len = re->re_endp - str; f &= ~REG_PEND; } else { len = strlen(str); } return re_comp(re, str, len, f); } /* - regexec - execute regular expression */ int regexec( regex_t *re, const char *str, size_t nmatch, regmatch_t pmatch[], int flags) { const char *start; size_t len; int f = flags; if (f & REG_STARTEND) { start = str + pmatch[0].rm_so; len = pmatch[0].rm_eo - pmatch[0].rm_so; f &= ~REG_STARTEND; } else { start = str; len = strlen(str); } return re_exec(re, start, len, nmatch, pmatch, f); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/regguts.h0000644000175000017500000003575414554262142015125 0ustar sergeisergei/* * Internal interface definitions, etc., for the reg package * * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Environmental customization. It should not (I hope) be necessary to alter * the file you are now reading -- regcustom.h should handle it all, given * care here and elsewhere. */ #include "regcustom.h" /* * Things that regcustom.h might override. */ /* assertions */ #ifndef assert #ifndef REG_DEBUG #ifndef NDEBUG #define NDEBUG /* no assertions */ #endif #endif /* !REG_DEBUG */ #include #endif /* voids */ #ifndef VOID #define VOID void /* for function return values */ #endif #ifndef DISCARD #define DISCARD void /* for throwing values away */ #endif #ifndef PVOID #define PVOID void * /* generic pointer */ #endif #ifndef VS #define VS(x) ((void*)(x)) /* cast something to generic ptr */ #endif #ifndef NOPARMS #define NOPARMS void /* for empty parm lists */ #endif /* function-pointer declarator */ #ifndef FUNCPTR #if __STDC__ >= 1 #define FUNCPTR(name, args) (*name)args #else #define FUNCPTR(name, args) (*name)() #endif #endif /* memory allocation */ #ifndef MALLOC #define MALLOC(n) malloc(n) #endif #ifndef REALLOC #define REALLOC(p, n) realloc(VS(p), n) #endif #ifndef FREE #define FREE(p) free(VS(p)) #endif /* want size of a char in bits, and max value in bounded quantifiers */ #ifndef _POSIX2_RE_DUP_MAX #define _POSIX2_RE_DUP_MAX 255 /* normally from */ #endif /* * misc */ #define NOTREACHED 0 #define xxx 1 #define DUPMAX _POSIX2_RE_DUP_MAX #define DUPINF (DUPMAX+1) #define REMAGIC 0xFED7 /* magic number for main struct */ /* * debugging facilities */ #ifdef REG_DEBUG /* FDEBUG does finite-state tracing */ #define FDEBUG(arglist) { if (v->eflags®_FTRACE) printf arglist; } /* MDEBUG does higher-level tracing */ #define MDEBUG(arglist) { if (v->eflags®_MTRACE) printf arglist; } #else #define FDEBUG(arglist) {} #define MDEBUG(arglist) {} #endif /* * bitmap manipulation */ #define UBITS (CHAR_BIT * sizeof(unsigned)) #define BSET(uv, sn) ((uv)[(sn)/UBITS] |= (unsigned)1 << ((sn)%UBITS)) #define ISBSET(uv, sn) ((uv)[(sn)/UBITS] & ((unsigned)1 << ((sn)%UBITS))) /* * We dissect a chr into byts for colormap table indexing. Here we define a * byt, which will be the same as a byte on most machines... The exact size of * a byt is not critical, but about 8 bits is good, and extraction of 8-bit * chunks is sometimes especially fast. */ #ifndef BYTBITS #define BYTBITS 8 /* bits in a byt */ #endif #define BYTTAB (1<flags&FREECOL) union tree *block; /* block of solid color, if any */ }; /* * The color map itself * * Much of the data in the colormap struct is only used at compile time. * However, the bulk of the space usage is in the "tree" structure, so it's * not clear that there's much point in converting the rest to a more compact * form when compilation is finished. */ struct colormap { int magic; #define CMMAGIC 0x876 struct vars *v; /* for compile error reporting */ size_t ncds; /* number of colordescs */ size_t max; /* highest in use */ color free; /* beginning of free chain (if non-0) */ struct colordesc *cd; #define CDEND(cm) (&(cm)->cd[(cm)->max + 1]) #define NINLINECDS ((size_t)10) struct colordesc cdspace[NINLINECDS]; union tree tree[NBYTS]; /* tree top, plus fill blocks */ }; /* optimization magic to do fast chr->color mapping */ #define B0(c) ((c) & BYTMASK) #define B1(c) (((c)>>BYTBITS) & BYTMASK) #define B2(c) (((c)>>(2*BYTBITS)) & BYTMASK) #define B3(c) (((c)>>(3*BYTBITS)) & BYTMASK) #if NBYTS == 1 #define GETCOLOR(cm, c) ((cm)->tree->tcolor[B0(c)]) #endif /* beware, for NBYTS>1, GETCOLOR() is unsafe -- 2nd arg used repeatedly */ #if NBYTS == 2 #define GETCOLOR(cm, c) ((cm)->tree->tptr[B1(c)]->tcolor[B0(c)]) #endif #if NBYTS == 4 #define GETCOLOR(cm, c) ((cm)->tree->tptr[B3(c)]->tptr[B2(c)]->tptr[B1(c)]->tcolor[B0(c)]) #endif /* * Interface definitions for locale-interface functions in locale.c. */ /* Representation of a set of characters. */ struct cvec { int nchrs; /* number of chrs */ int chrspace; /* number of chrs possible */ chr *chrs; /* pointer to vector of chrs */ int nranges; /* number of ranges (chr pairs) */ int rangespace; /* number of chrs possible */ chr *ranges; /* pointer to vector of chr pairs */ }; /* * definitions for non-deterministic finite autmaton (NFA) internal * representation * * Having a "from" pointer within each arc may seem redundant, but it saves a * lot of hassle. */ struct state; struct arc { int type; /* 0 if free, else an NFA arc type code */ color co; struct state *from; /* where it's from (and contained within) */ struct state *to; /* where it's to */ struct arc *outchain; /* link in *from's outs chain or free chain */ struct arc *outchainRev; /* back-link in *from's outs chain */ #define freechain outchain /* we do not maintain "freechainRev" */ struct arc *inchain; /* *to's ins chain */ struct arc *inchainRev; /* back-link in *to's ins chain */ struct arc *colorchain; /* color's arc chain */ struct arc *colorchainRev; /* back-link in color's arc chain */ }; struct arcbatch { /* for bulk allocation of arcs */ struct arcbatch *next; #define ABSIZE 10 struct arc a[ABSIZE]; }; struct state { int no; #define FREESTATE (-1) char flag; /* marks special states */ int nins; /* number of inarcs */ struct arc *ins; /* chain of inarcs */ int nouts; /* number of outarcs */ struct arc *outs; /* chain of outarcs */ struct arc *free; /* chain of free arcs */ struct state *tmp; /* temporary for traversal algorithms */ struct state *next; /* chain for traversing all */ struct state *prev; /* back chain */ struct arcbatch oas; /* first arcbatch, avoid malloc in easy case */ int noas; /* number of arcs used in first arcbatch */ }; struct nfa { struct state *pre; /* preinitial state */ struct state *init; /* initial state */ struct state *final; /* final state */ struct state *post; /* postfinal state */ int nstates; /* for numbering states */ struct state *states; /* state-chain header */ struct state *slast; /* tail of the chain */ struct state *free; /* free list */ struct colormap *cm; /* the color map */ color bos[2]; /* colors, if any, assigned to BOS and BOL */ color eos[2]; /* colors, if any, assigned to EOS and EOL */ struct vars *v; /* simplifies compile error reporting */ struct nfa *parent; /* parent NFA, if any */ }; /* * definitions for compacted NFA * * The main space savings in a compacted NFA is from making the arcs as small * as possible. We store only the transition color and next-state number for * each arc. The list of out arcs for each state is an array beginning at * cnfa.states[statenumber], and terminated by a dummy carc struct with * co == COLORLESS. * * The non-dummy carc structs are of two types: plain arcs and LACON arcs. * Plain arcs just store the transition color number as "co". LACON arcs * store the lookahead constraint number plus cnfa.ncolors as "co". LACON * arcs can be distinguished from plain by testing for co >= cnfa.ncolors. */ struct carc { color co; /* COLORLESS is list terminator */ int to; /* next-state number */ }; struct cnfa { int nstates; /* number of states */ int ncolors; /* number of colors */ int flags; #define HASLACONS 01 /* uses lookahead constraints */ int pre; /* setup state number */ int post; /* teardown state number */ color bos[2]; /* colors, if any, assigned to BOS and BOL */ color eos[2]; /* colors, if any, assigned to EOS and EOL */ char *stflags; /* vector of per-state flags bytes */ #define CNFA_NOPROGRESS 01 /* flag bit for a no-progress state */ struct carc **states; /* vector of pointers to outarc lists */ /* states[n] are pointers into a single malloc'd array of arcs */ struct carc *arcs; /* the area for the lists */ }; #define ZAPCNFA(cnfa) ((cnfa).nstates = 0) #define NULLCNFA(cnfa) ((cnfa).nstates == 0) /* * This symbol limits the transient heap space used by the regex compiler, * and thereby also the maximum complexity of NFAs that we'll deal with. * Currently we only count NFA states and arcs against this; the other * transient data is generally not large enough to notice compared to those. * Note that we do not charge anything for the final output data structures * (the compacted NFA and the colormap). */ #ifndef REG_MAX_COMPILE_SPACE #define REG_MAX_COMPILE_SPACE \ (100000 * sizeof(struct state) + 100000 * sizeof(struct arcbatch)) #endif /* * subexpression tree * * "op" is one of: * '=' plain regex without interesting substructure (implemented as DFA) * 'b' back-reference (has no substructure either) * '(' capture node: captures the match of its single child * '.' concatenation: matches a match for left, then a match for right * '|' alternation: matches a match for left or a match for right * '*' iteration: matches some number of matches of its single child * * Note: the right child of an alternation must be another alternation or * NULL; hence, an N-way branch requires N alternation nodes, not N-1 as you * might expect. This could stand to be changed. Actually I'd rather see * a single alternation node with N children, but that will take revising * the representation of struct subre. * * Note: when a backref is directly quantified, we stick the min/max counts * into the backref rather than plastering an iteration node on top. This is * for efficiency: there is no need to search for possible division points. */ struct subre { char op; /* see type codes above */ char flags; #define LONGER 01 /* prefers longer match */ #define SHORTER 02 /* prefers shorter match */ #define MIXED 04 /* mixed preference below */ #define CAP 010 /* capturing parens below */ #define BACKR 020 /* back reference below */ #define INUSE 0100 /* in use in final tree */ #define NOPROP 03 /* bits which may not propagate up */ #define LMIX(f) ((f)<<2) /* LONGER -> MIXED */ #define SMIX(f) ((f)<<1) /* SHORTER -> MIXED */ #define UP(f) (((f)&~NOPROP) | (LMIX(f) & SMIX(f) & MIXED)) #define MESSY(f) ((f)&(MIXED|CAP|BACKR)) #define PREF(f) ((f)&NOPROP) #define PREF2(f1, f2) ((PREF(f1) != 0) ? PREF(f1) : PREF(f2)) #define COMBINE(f1, f2) (UP((f1)|(f2)) | PREF2(f1, f2)) short id; /* ID of subre (1..ntree-1) */ int subno; /* subexpression number (for 'b' and '(') */ short min; /* min repetitions for iteration or backref */ short max; /* max repetitions for iteration or backref */ struct subre *left; /* left child, if any (also freelist chain) */ struct subre *right; /* right child, if any */ struct state *begin; /* outarcs from here... */ struct state *end; /* ...ending in inarcs here */ struct cnfa cnfa; /* compacted NFA, if any */ struct subre *chain; /* for bookkeeping and error cleanup */ }; /* * table of function pointers for generic manipulation functions. A regex_t's * re_fns points to one of these. */ struct fns { void FUNCPTR(free, (regex_t *)); }; /* * the insides of a regex_t, hidden behind a void * */ struct guts { int magic; #define GUTSMAGIC 0xFED9 int cflags; /* copy of compile flags */ long info; /* copy of re_info */ size_t nsub; /* copy of re_nsub */ struct subre *tree; struct cnfa search; /* for fast preliminary search */ int ntree; /* number of subre's, plus one */ struct colormap cmap; int FUNCPTR(compare, (const chr *, const chr *, size_t)); struct subre *lacons; /* lookahead-constraint vector */ int nlacons; /* size of lacons */ }; /* * Magic for allocating a variable workspace. This default version is * stack-hungry. */ #ifndef AllocVars #define AllocVars(vPtr) \ struct vars var; \ struct vars *vPtr = &var #endif #ifndef FreeVars #define FreeVars(vPtr) ((void) 0) #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclAlloc.c0000644000175000017500000004254414554262142015170 0ustar sergeisergei/* * tclAlloc.c -- * * This is a very fast storage allocator. It allocates blocks of a small * number of different sizes, and keeps free lists of each size. Blocks * that don't exactly fit are passed up to the next larger size. Blocks * over a certain size are directly allocated from the system. * * Copyright (c) 1983 Regents of the University of California. * Copyright (c) 1996-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * Windows and Unix use an alternative allocator when building with threads * that has significantly reduced lock contention. */ #include "tclInt.h" #if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC) #if defined(USE_TCLALLOC) && USE_TCLALLOC /* * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait * until Tcl uses config.h properly. */ #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) typedef unsigned long caddr_t; #endif /* * The overhead on a block is at least 8 bytes. When free, this space contains * a pointer to the next free block, and the bottom two bits must be zero. * When in use, the first byte is set to MAGIC, and the second byte is the * size index. The remaining bytes are for alignment. If range checking is * enabled then a second word holds the size of the requested block, less 1, * rounded up to a multiple of sizeof(RMAGIC). The order of elements is * critical: ov.magic must overlay the low order bits of ov.next, and ov.magic * can not be a valid ov.next bit pattern. */ union overhead { union overhead *next; /* when free */ unsigned char padding[TCL_ALLOCALIGN]; /* align struct to TCL_ALLOCALIGN bytes */ struct { unsigned char magic0; /* magic number */ unsigned char index; /* bucket # */ unsigned char unused; /* unused */ unsigned char magic1; /* other magic number */ #ifndef NDEBUG unsigned short rmagic; /* range magic number */ unsigned long size; /* actual block size */ unsigned short unused2; /* padding to 8-byte align */ #endif } ovu; #define overMagic0 ovu.magic0 #define overMagic1 ovu.magic1 #define bucketIndex ovu.index #define rangeCheckMagic ovu.rmagic #define realBlockSize ovu.size }; #define MAGIC 0xEF /* magic # on accounting info */ #define RMAGIC 0x5555 /* magic # on range info */ #ifndef NDEBUG #define RSLOP sizeof(unsigned short) #else #define RSLOP 0 #endif #define OVERHEAD (sizeof(union overhead) + RSLOP) /* * Macro to make it easier to refer to the end-of-block guard magic. */ #define BLOCK_END(overPtr) \ (*(unsigned short *)((caddr_t)((overPtr) + 1) + (overPtr)->realBlockSize)) /* * nextf[i] is the pointer to the next free block of size 2^(i+3). The * smallest allocatable block is MINBLOCK bytes. The overhead information * precedes the data area returned to the user. */ #define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (13 - (MINBLOCK >> 4)) #define MAXMALLOC (1<<(NBUCKETS+2)) static union overhead *nextf[NBUCKETS]; /* * The following structure is used to keep track of all system memory * currently owned by Tcl. When finalizing, all this memory will be returned * to the system. */ struct block { struct block *nextPtr; /* Linked list. */ struct block *prevPtr; /* Linked list for big blocks, ensures 8-byte * alignment for suballocated blocks. */ }; static struct block *blockList; /* Tracks the suballocated blocks. */ static struct block bigBlocks={ /* Big blocks aren't suballocated. */ &bigBlocks, &bigBlocks }; /* * The allocator is protected by a special mutex that must be explicitly * initialized. Furthermore, because Tcl_Alloc may be used before anything else * in Tcl, we make this module self-initializing after all with the allocInit * variable. */ #ifdef TCL_THREADS static Tcl_Mutex *allocMutexPtr; #endif static int allocInit = 0; #ifdef MSTATS /* * numMallocs[i] is the difference between the number of mallocs and frees for * a given block size. */ static unsigned int numMallocs[NBUCKETS+1]; #endif #if !defined(NDEBUG) #define ASSERT(p) if (!(p)) Tcl_Panic(# p) #define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p) #else #define ASSERT(p) #define RANGE_ASSERT(p) #endif /* * Prototypes for functions used only in this file. */ static void MoreCore(int bucket); /* *------------------------------------------------------------------------- * * TclInitAlloc -- * * Initialize the memory system. * * Results: * None. * * Side effects: * Initialize the mutex used to serialize allocations. * *------------------------------------------------------------------------- */ void TclInitAlloc(void) { if (!allocInit) { allocInit = 1; #ifdef TCL_THREADS allocMutexPtr = Tcl_GetAllocMutex(); #endif } } /* *------------------------------------------------------------------------- * * TclFinalizeAllocSubsystem -- * * Release all resources being used by this subsystem, including * aggressively freeing all memory allocated by TclpAlloc() that has not * yet been released with TclpFree(). * * After this function is called, all memory allocated with TclpAlloc() * should be considered unusable. * * Results: * None. * * Side effects: * This subsystem is self-initializing, since memory can be allocated * before Tcl is formally initialized. After this call, this subsystem * has been reset to its initial state and is usable again. * *------------------------------------------------------------------------- */ void TclFinalizeAllocSubsystem(void) { unsigned int i; struct block *blockPtr, *nextPtr; Tcl_MutexLock(allocMutexPtr); for (blockPtr = blockList; blockPtr != NULL; blockPtr = nextPtr) { nextPtr = blockPtr->nextPtr; TclpSysFree(blockPtr); } blockList = NULL; for (blockPtr = bigBlocks.nextPtr; blockPtr != &bigBlocks; ) { nextPtr = blockPtr->nextPtr; TclpSysFree(blockPtr); blockPtr = nextPtr; } bigBlocks.nextPtr = &bigBlocks; bigBlocks.prevPtr = &bigBlocks; for (i=0 ; i= MAXMALLOC - OVERHEAD) { if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) { bigBlockPtr = (struct block *) TclpSysAlloc( sizeof(struct block) + OVERHEAD + numBytes, 0); } if (bigBlockPtr == NULL) { Tcl_MutexUnlock(allocMutexPtr); return NULL; } bigBlockPtr->nextPtr = bigBlocks.nextPtr; bigBlocks.nextPtr = bigBlockPtr; bigBlockPtr->prevPtr = &bigBlocks; bigBlockPtr->nextPtr->prevPtr = bigBlockPtr; overPtr = (union overhead *) (bigBlockPtr + 1); overPtr->overMagic0 = overPtr->overMagic1 = MAGIC; overPtr->bucketIndex = 0xFF; #ifdef MSTATS numMallocs[NBUCKETS]++; #endif #ifndef NDEBUG /* * Record allocated size of block and bound space with magic numbers. */ overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); overPtr->rangeCheckMagic = RMAGIC; BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); return (void *)(overPtr+1); } /* * Convert amount of memory requested into closest block size stored in * hash buckets which satisfies request. Account for space used per block * for accounting. */ amount = MINBLOCK; /* size of first bucket */ bucket = MINBLOCK >> 4; while (numBytes + OVERHEAD > amount) { amount <<= 1; if (amount == 0) { Tcl_MutexUnlock(allocMutexPtr); return NULL; } bucket++; } ASSERT(bucket < NBUCKETS); /* * If nothing in hash bucket right now, request more memory from the * system. */ if ((overPtr = nextf[bucket]) == NULL) { MoreCore(bucket); if ((overPtr = nextf[bucket]) == NULL) { Tcl_MutexUnlock(allocMutexPtr); return NULL; } } /* * Remove from linked list */ nextf[bucket] = overPtr->next; overPtr->overMagic0 = overPtr->overMagic1 = MAGIC; overPtr->bucketIndex = UCHAR(bucket); #ifdef MSTATS numMallocs[bucket]++; #endif #ifndef NDEBUG /* * Record allocated size of block and bound space with magic numbers. */ overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); overPtr->rangeCheckMagic = RMAGIC; BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); return ((char *)(overPtr + 1)); } /* *---------------------------------------------------------------------- * * MoreCore -- * * Allocate more memory to the indicated bucket. * * Assumes Mutex is already held. * * Results: * None. * * Side effects: * Attempts to get more memory from the system. * *---------------------------------------------------------------------- */ static void MoreCore( int bucket) /* Bucket to allocate to. */ { union overhead *overPtr; long size; /* size of desired block */ long amount; /* amount to allocate */ int numBlocks; /* how many blocks we get */ struct block *blockPtr; /* * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a * VAX, I think) or for a negative arg. */ size = 1 << (bucket + 3); ASSERT(size > 0); amount = MAXMALLOC; numBlocks = amount / size; ASSERT(numBlocks*size == amount); blockPtr = (struct block *) TclpSysAlloc( (sizeof(struct block) + amount), 1); /* no more room! */ if (blockPtr == NULL) { return; } blockPtr->nextPtr = blockList; blockList = blockPtr; overPtr = (union overhead *) (blockPtr + 1); /* * Add new memory allocated to that on free list for this hash bucket. */ nextf[bucket] = overPtr; while (--numBlocks > 0) { overPtr->next = (union overhead *)((caddr_t)overPtr + size); overPtr = (union overhead *)((caddr_t)overPtr + size); } overPtr->next = NULL; } /* *---------------------------------------------------------------------- * * TclpFree -- * * Free memory. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclpFree( char *oldPtr) /* Pointer to memory to free. */ { long size; union overhead *overPtr; struct block *bigBlockPtr; if (oldPtr == NULL) { return; } Tcl_MutexLock(allocMutexPtr); overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead)); ASSERT(overPtr->overMagic0 == MAGIC); /* make sure it was in use */ ASSERT(overPtr->overMagic1 == MAGIC); if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) { Tcl_MutexUnlock(allocMutexPtr); return; } RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC); RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC); size = overPtr->bucketIndex; if (size == 0xFF) { #ifdef MSTATS numMallocs[NBUCKETS]--; #endif bigBlockPtr = (struct block *) overPtr - 1; bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr; bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr; TclpSysFree(bigBlockPtr); Tcl_MutexUnlock(allocMutexPtr); return; } ASSERT(size < NBUCKETS); overPtr->next = nextf[size]; /* also clobbers overMagic */ nextf[size] = overPtr; #ifdef MSTATS numMallocs[size]--; #endif Tcl_MutexUnlock(allocMutexPtr); } /* *---------------------------------------------------------------------- * * TclpRealloc -- * * Reallocate memory. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * TclpRealloc( char *oldPtr, /* Pointer to alloc'ed block. */ unsigned int numBytes) /* New size of memory. */ { int i; union overhead *overPtr; struct block *bigBlockPtr; int expensive; unsigned long maxSize; if (oldPtr == NULL) { return TclpAlloc(numBytes); } Tcl_MutexLock(allocMutexPtr); overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead)); ASSERT(overPtr->overMagic0 == MAGIC); /* make sure it was in use */ ASSERT(overPtr->overMagic1 == MAGIC); if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) { Tcl_MutexUnlock(allocMutexPtr); return NULL; } RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC); RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC); i = overPtr->bucketIndex; /* * If the block isn't in a bin, just realloc it. */ if (i == 0xFF) { struct block *prevPtr, *nextPtr; bigBlockPtr = (struct block *) overPtr - 1; prevPtr = bigBlockPtr->prevPtr; nextPtr = bigBlockPtr->nextPtr; bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr, sizeof(struct block) + OVERHEAD + numBytes); if (bigBlockPtr == NULL) { Tcl_MutexUnlock(allocMutexPtr); return NULL; } if (prevPtr->nextPtr != bigBlockPtr) { /* * If the block has moved, splice the new block into the list * where the old block used to be. */ prevPtr->nextPtr = bigBlockPtr; nextPtr->prevPtr = bigBlockPtr; } overPtr = (union overhead *) (bigBlockPtr + 1); #ifdef MSTATS numMallocs[NBUCKETS]++; #endif #ifndef NDEBUG /* * Record allocated size of block and update magic number bounds. */ overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); return (char *)(overPtr+1); } maxSize = 1 << (i+3); expensive = 0; if (numBytes+OVERHEAD > maxSize) { expensive = 1; } else if (i>0 && numBytes+OVERHEAD < maxSize/2) { expensive = 1; } if (expensive) { void *newPtr; Tcl_MutexUnlock(allocMutexPtr); newPtr = TclpAlloc(numBytes); if (newPtr == NULL) { return NULL; } maxSize -= OVERHEAD; if (maxSize < numBytes) { numBytes = maxSize; } memcpy(newPtr, oldPtr, numBytes); TclpFree(oldPtr); return newPtr; } /* * No need to copy. It fits as-is. */ #ifndef NDEBUG overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); return(oldPtr); } /* *---------------------------------------------------------------------- * * mstats -- * * Prints two lines of numbers, one showing the length of the free list * for each size category, the second showing the number of mallocs - * frees for each size category. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ #ifdef MSTATS void mstats( char *s) /* Where to write info. */ { int i, j; union overhead *overPtr; int totalFree = 0, totalUsed = 0; Tcl_MutexLock(allocMutexPtr); fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s); for (i = 0; i < NBUCKETS; i++) { for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) { fprintf(stderr, " %d", j); } totalFree += j * (1 << (i + 3)); } fprintf(stderr, "\nused:\t"); for (i = 0; i < NBUCKETS; i++) { fprintf(stderr, " %d", numMallocs[i]); totalUsed += numMallocs[i] * (1 << (i + 3)); } fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n", totalUsed, totalFree); fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n", MAXMALLOC, numMallocs[NBUCKETS]); Tcl_MutexUnlock(allocMutexPtr); } #endif #else /* !USE_TCLALLOC */ /* *---------------------------------------------------------------------- * * TclpAlloc -- * * Allocate more memory. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * TclpAlloc( unsigned int numBytes) /* Number of bytes to allocate. */ { return (char *) malloc(numBytes); } /* *---------------------------------------------------------------------- * * TclpFree -- * * Free memory. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclpFree( char *oldPtr) /* Pointer to memory to free. */ { free(oldPtr); return; } /* *---------------------------------------------------------------------- * * TclpRealloc -- * * Reallocate memory. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * TclpRealloc( char *oldPtr, /* Pointer to alloced block. */ unsigned int numBytes) /* New size of memory. */ { return (char *) realloc(oldPtr, numBytes); } #endif /* !USE_TCLALLOC */ #else TCL_MAC_EMPTY_FILE(generic_tclAlloc_c) #endif /* !TCL_THREADS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclAssembly.c0000644000175000017500000040720014554262142015707 0ustar sergeisergei/* * tclAssembly.c -- * * Assembler for Tcl bytecodes. * * This file contains the procedures that convert Tcl Assembly Language (TAL) * to a sequence of bytecode instructions for the Tcl execution engine. * * Copyright (c) 2010 by Ozgur Dogan Ugurlu. * Copyright (c) 2010 by Kevin B. Kenny. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /*- *- THINGS TO DO: *- More instructions: *- done - alternate exit point (affects stack and exception range checking) *- break and continue - if exception ranges can be sorted out. *- foreach_start4, foreach_step4 *- returnImm, returnStk *- expandStart, expandStkTop, invokeExpanded, expandDrop *- dictFirst, dictNext, dictDone *- dictUpdateStart, dictUpdateEnd *- jumpTable testing *- syntax (?) *- returnCodeBranch *- tclooNext, tclooNextClass */ #include "tclInt.h" #include "tclCompile.h" #include "tclOOInt.h" /* * Structure that represents a range of instructions in the bytecode. */ typedef struct CodeRange { int startOffset; /* Start offset in the bytecode array */ int endOffset; /* End offset in the bytecode array */ } CodeRange; /* * State identified for a basic block's catch context. */ typedef enum BasicBlockCatchState { BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */ BBCS_NONE, /* Block is outside of any catch */ BBCS_INCATCH, /* Block is within a catch context */ BBCS_CAUGHT /* Block is within a catch context and * may be executed after an exception fires */ } BasicBlockCatchState; /* * Structure that defines a basic block - a linear sequence of bytecode * instructions with no jumps in or out (including not changing the * state of any exception range). */ typedef struct BasicBlock { int originalStartOffset; /* Instruction offset before JUMP1s were * substituted with JUMP4's */ int startOffset; /* Instruction offset of the start of the * block */ int startLine; /* Line number in the input script of the * instruction at the start of the block */ int jumpOffset; /* Bytecode offset of the 'jump' instruction * that ends the block, or -1 if there is no * jump. */ int jumpLine; /* Line number in the input script of the * 'jump' instruction that ends the block, or * -1 if there is no jump */ struct BasicBlock* prevPtr; /* Immediate predecessor of this block */ struct BasicBlock* predecessor; /* Predecessor of this block in the spanning * tree */ struct BasicBlock* successor1; /* BasicBlock structure of the following * block: NULL at the end of the bytecode * sequence. */ Tcl_Obj* jumpTarget; /* Jump target label if the jump target is * unresolved */ int initialStackDepth; /* Absolute stack depth on entry */ int minStackDepth; /* Low-water relative stack depth */ int maxStackDepth; /* High-water relative stack depth */ int finalStackDepth; /* Relative stack depth on exit */ enum BasicBlockCatchState catchState; /* State of the block for 'catch' analysis */ int catchDepth; /* Number of nested catches in which the basic * block appears */ struct BasicBlock* enclosingCatch; /* BasicBlock structure of the last startCatch * executed on a path to this block, or NULL * if there is no enclosing catch */ int foreignExceptionBase; /* Base index of foreign exceptions */ int foreignExceptionCount; /* Count of foreign exceptions */ ExceptionRange* foreignExceptions; /* ExceptionRange structures for exception * ranges belonging to embedded scripts and * expressions in this block */ JumptableInfo* jtPtr; /* Jump table at the end of this basic block */ int flags; /* Boolean flags */ } BasicBlock; /* * Flags that pertain to a basic block. */ enum BasicBlockFlags { BB_VISITED = (1 << 0), /* Block has been visited in the current * traversal */ BB_FALLTHRU = (1 << 1), /* Control may pass from this block to a * successor */ BB_JUMP1 = (1 << 2), /* Basic block ends with a 1-byte-offset jump * and may need expansion */ BB_JUMPTABLE = (1 << 3), /* Basic block ends with a jump table */ BB_BEGINCATCH = (1 << 4), /* Block ends with a 'beginCatch' instruction, * marking it as the start of a 'catch' * sequence. The 'jumpTarget' is the exception * exit from the catch block. */ BB_ENDCATCH = (1 << 5) /* Block ends with an 'endCatch' instruction, * unwinding the catch from the exception * stack. */ }; /* * Source instruction type recognized by the assembler. */ typedef enum TalInstType { ASSEM_1BYTE, /* Fixed arity, 1-byte instruction */ ASSEM_BEGIN_CATCH, /* Begin catch: one 4-byte jump offset to be * converted to appropriate exception * ranges */ ASSEM_BOOL, /* One Boolean operand */ ASSEM_BOOL_LVT4, /* One Boolean, one 4-byte LVT ref. */ ASSEM_CLOCK_READ, /* 1-byte unsigned-integer case number, in the * range 0-3 */ ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must * be strictly positive, consumes N, produces * 1 */ ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1 * operands, produces 1, N > 0 */ ASSEM_DICT_SET, /* specifies key count and LVT index, consumes * N+1 operands, produces 1, N > 0 */ ASSEM_DICT_UNSET, /* specifies key count and LVT index, consumes * N operands, produces 1, N > 0 */ ASSEM_END_CATCH, /* End catch. No args. Exception range popped * from stack and stack pointer restored. */ ASSEM_EVAL, /* 'eval' - evaluate a constant script (by * compiling it in line with the assembly * code! I love Tcl!) */ ASSEM_INDEX, /* 4 byte operand, integer or end-integer */ ASSEM_INVOKE, /* 1- or 4-byte operand count, must be * strictly positive, consumes N, produces * 1. */ ASSEM_JUMP, /* Jump instructions */ ASSEM_JUMP4, /* Jump instructions forcing a 4-byte offset */ ASSEM_JUMPTABLE, /* Jumptable (switch -exact) */ ASSEM_LABEL, /* The assembly directive that defines a * label */ ASSEM_LINDEX_MULTI, /* 4-byte operand count, must be strictly * positive, consumes N, produces 1 */ ASSEM_LIST, /* 4-byte operand count, must be nonnegative, * consumses N, produces 1 */ ASSEM_LSET_FLAT, /* 4-byte operand count, must be >= 3, * consumes N, produces 1 */ ASSEM_LVT, /* One operand that references a local * variable */ ASSEM_LVT1, /* One 1-byte operand that references a local * variable */ ASSEM_LVT1_SINT1, /* One 1-byte operand that references a local * variable, one signed-integer 1-byte * operand */ ASSEM_LVT4, /* One 4-byte operand that references a local * variable */ ASSEM_OVER, /* OVER: 4-byte operand count, consumes N+1, * produces N+2 */ ASSEM_PUSH, /* one literal operand */ ASSEM_REGEXP, /* One Boolean operand, but weird mapping to * call flags */ ASSEM_REVERSE, /* REVERSE: 4-byte operand count, consumes N, * produces N */ ASSEM_SINT1, /* One 1-byte signed-integer operand * (INCR_STK_IMM) */ ASSEM_SINT4_LVT4 /* Signed 4-byte integer operand followed by * LVT entry. Fixed arity */ } TalInstType; /* * Description of an instruction recognized by the assembler. */ typedef struct TalInstDesc { const char *name; /* Name of instruction. */ TalInstType instType; /* The type of instruction */ int tclInstCode; /* Instruction code. For instructions having * 1- and 4-byte variables, tclInstCode is * ((1byte)<<8) || (4byte) */ int operandsConsumed; /* Number of operands consumed by the * operation, or INT_MIN if the operation is * variadic */ int operandsProduced; /* Number of operands produced by the * operation. If negative, the operation has a * net stack effect of -1-operandsProduced */ } TalInstDesc; /* * Structure that holds the state of the assembler while generating code. */ typedef struct AssemblyEnv { CompileEnv* envPtr; /* Compilation environment being used for code * generation */ Tcl_Parse* parsePtr; /* Parse of the current line of source */ Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose * values are 'label' objects storing the code * offsets of the labels. */ int cmdLine; /* Current line number within the assembly * code */ int* clNext; /* Invisible continuation line for * [info frame] */ BasicBlock* head_bb; /* First basic block in the code */ BasicBlock* curr_bb; /* Current basic block */ int maxDepth; /* Maximum stack depth encountered */ int curCatchDepth; /* Current depth of catches */ int maxCatchDepth; /* Maximum depth of catches encountered */ int flags; /* Compilation flags (TCL_EVAL_DIRECT) */ } AssemblyEnv; /* * Static functions defined in this file. */ static void AddBasicBlockRangeToErrorInfo(AssemblyEnv*, BasicBlock*); static BasicBlock * AllocBB(AssemblyEnv*); static int AssembleOneLine(AssemblyEnv* envPtr); static void BBAdjustStackDepth(BasicBlock* bbPtr, int consumed, int produced); static void BBUpdateStackReqs(BasicBlock* bbPtr, int tblIdx, int count); static void BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx, int opnd, int count); static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx, int opnd, int count); static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx, int param, int count); static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx, int count); static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr); static int CalculateJumpRelocations(AssemblyEnv*, int*); static int CheckForUnclosedCatches(AssemblyEnv*); static int CheckForThrowInWrongContext(AssemblyEnv*); static int CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*); static int BytecodeMightThrow(unsigned char); static int CheckJumpTableLabels(AssemblyEnv*, BasicBlock*); static int CheckNamespaceQualifiers(Tcl_Interp*, const char*, int); static int CheckNonNegative(Tcl_Interp*, int); static int CheckOneByte(Tcl_Interp*, int); static int CheckSignedOneByte(Tcl_Interp*, int); static int CheckStack(AssemblyEnv*); static int CheckStrictlyPositive(Tcl_Interp*, int); static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*, const TalInstDesc*); static int DefineLabel(AssemblyEnv* envPtr, const char* label); static void DeleteMirrorJumpTable(JumptableInfo* jtPtr); static void DupAssembleCodeInternalRep(Tcl_Obj* src, Tcl_Obj* dest); static void FillInJumpOffsets(AssemblyEnv*); static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, Tcl_Obj* jumpTable); static int FindLocalVar(AssemblyEnv* envPtr, Tcl_Token** tokenPtrPtr); static int FinishAssembly(AssemblyEnv*); static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr); static void FreeAssemblyEnv(AssemblyEnv*); static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**); static void LookForFreshCatches(BasicBlock*, BasicBlock**); static void MoveCodeForJumps(AssemblyEnv*, int); static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int); static AssemblyEnv* NewAssemblyEnv(CompileEnv*, int); static int ProcessCatches(AssemblyEnv*); static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*, BasicBlock*, enum BasicBlockCatchState, int); static void ResetVisitedBasicBlocks(AssemblyEnv*); static void ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*); static void ReportUndefinedLabel(AssemblyEnv*, BasicBlock*, Tcl_Obj*); static void RestoreEmbeddedExceptionRanges(AssemblyEnv*); static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *, BasicBlock *, int); static BasicBlock* StartBasicBlock(AssemblyEnv*, int fallthrough, Tcl_Obj* jumpLabel); /* static int AdvanceIp(const unsigned char *pc); */ static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *, BasicBlock *, int); static int StackCheckExit(AssemblyEnv*); static void StackFreshCatches(AssemblyEnv*, BasicBlock*, int, BasicBlock**, int*); static void SyncStackDepth(AssemblyEnv*); static int TclAssembleCode(CompileEnv* envPtr, const char* code, int codeLen, int flags); static void UnstackExpiredCatches(CompileEnv*, BasicBlock*, int, BasicBlock**, int*); /* * Tcl_ObjType that describes bytecode emitted by the assembler. */ static const Tcl_ObjType assembleCodeType = { "assemblecode", FreeAssembleCodeInternalRep, /* freeIntRepProc */ DupAssembleCodeInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL /* setFromAnyProc */ }; /* * Source instructions recognized in the Tcl Assembly Language (TAL) */ static const TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ {"push", ASSEM_PUSH, (INST_PUSH1<<8 | INST_PUSH4), 0, 1}, {"add", ASSEM_1BYTE, INST_ADD, 2, 1}, {"append", ASSEM_LVT, (INST_APPEND_SCALAR1<<8 | INST_APPEND_SCALAR4),1, 1}, {"appendArray", ASSEM_LVT, (INST_APPEND_ARRAY1<<8 | INST_APPEND_ARRAY4), 2, 1}, {"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1}, {"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1}, {"arrayExistsImm", ASSEM_LVT4, INST_ARRAY_EXISTS_IMM, 0, 1}, {"arrayExistsStk", ASSEM_1BYTE, INST_ARRAY_EXISTS_STK, 1, 1}, {"arrayMakeImm", ASSEM_LVT4, INST_ARRAY_MAKE_IMM, 0, 0}, {"arrayMakeStk", ASSEM_1BYTE, INST_ARRAY_MAKE_STK, 1, 0}, {"beginCatch", ASSEM_BEGIN_CATCH, INST_BEGIN_CATCH4, 0, 0}, {"bitand", ASSEM_1BYTE, INST_BITAND, 2, 1}, {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1}, {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1}, {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1}, {"clockRead", ASSEM_CLOCK_READ, INST_CLOCK_READ, 0, 1}, {"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1}, {"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1}, {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1}, {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1}, {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1}, {"dictExists", ASSEM_DICT_GET, INST_DICT_EXISTS, INT_MIN,1}, {"dictExpand", ASSEM_1BYTE, INST_DICT_EXPAND, 3, 1}, {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1}, {"dictIncrImm", ASSEM_SINT4_LVT4, INST_DICT_INCR_IMM, 1, 1}, {"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1}, {"dictRecombineStk",ASSEM_1BYTE, INST_DICT_RECOMBINE_STK,3, 0}, {"dictRecombineImm",ASSEM_LVT4, INST_DICT_RECOMBINE_IMM,2, 0}, {"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1}, {"dictUnset", ASSEM_DICT_UNSET, INST_DICT_UNSET, INT_MIN,1}, {"div", ASSEM_1BYTE, INST_DIV, 2, 1}, {"dup", ASSEM_1BYTE, INST_DUP, 1, 2}, {"endCatch", ASSEM_END_CATCH,INST_END_CATCH, 0, 0}, {"eq", ASSEM_1BYTE, INST_EQ, 2, 1}, {"eval", ASSEM_EVAL, INST_EVAL_STK, 1, 1}, {"evalStk", ASSEM_1BYTE, INST_EVAL_STK, 1, 1}, {"exist", ASSEM_LVT4, INST_EXIST_SCALAR, 0, 1}, {"existArray", ASSEM_LVT4, INST_EXIST_ARRAY, 1, 1}, {"existArrayStk", ASSEM_1BYTE, INST_EXIST_ARRAY_STK, 2, 1}, {"existStk", ASSEM_1BYTE, INST_EXIST_STK, 1, 1}, {"expon", ASSEM_1BYTE, INST_EXPON, 2, 1}, {"expr", ASSEM_EVAL, INST_EXPR_STK, 1, 1}, {"exprStk", ASSEM_1BYTE, INST_EXPR_STK, 1, 1}, {"ge", ASSEM_1BYTE, INST_GE, 2, 1}, {"gt", ASSEM_1BYTE, INST_GT, 2, 1}, {"incr", ASSEM_LVT1, INST_INCR_SCALAR1, 1, 1}, {"incrArray", ASSEM_LVT1, INST_INCR_ARRAY1, 2, 1}, {"incrArrayImm", ASSEM_LVT1_SINT1, INST_INCR_ARRAY1_IMM, 1, 1}, {"incrArrayStk", ASSEM_1BYTE, INST_INCR_ARRAY_STK, 3, 1}, {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1}, {"incrImm", ASSEM_LVT1_SINT1, INST_INCR_SCALAR1_IMM, 0, 1}, {"incrStk", ASSEM_1BYTE, INST_INCR_STK, 2, 1}, {"incrStkImm", ASSEM_SINT1, INST_INCR_STK_IMM, 1, 1}, {"infoLevelArgs", ASSEM_1BYTE, INST_INFO_LEVEL_ARGS, 1, 1}, {"infoLevelNumber", ASSEM_1BYTE, INST_INFO_LEVEL_NUM, 0, 1}, {"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8 | INST_INVOKE_STK4), INT_MIN,1}, {"jump", ASSEM_JUMP, INST_JUMP1, 0, 0}, {"jump4", ASSEM_JUMP4, INST_JUMP4, 0, 0}, {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE1, 1, 0}, {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0}, {"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0}, {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0}, {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0}, {"label", ASSEM_LABEL, 0, 0, 0}, {"land", ASSEM_1BYTE, INST_LAND, 2, 1}, {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8 | INST_LAPPEND_SCALAR4), 1, 1}, {"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8 | INST_LAPPEND_ARRAY4),2, 1}, {"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1}, {"lappendList", ASSEM_LVT4, INST_LAPPEND_LIST, 1, 1}, {"lappendListArray",ASSEM_LVT4, INST_LAPPEND_LIST_ARRAY,2, 1}, {"lappendListArrayStk", ASSEM_1BYTE,INST_LAPPEND_LIST_ARRAY_STK, 3, 1}, {"lappendListStk", ASSEM_1BYTE, INST_LAPPEND_LIST_STK, 2, 1}, {"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1}, {"le", ASSEM_1BYTE, INST_LE, 2, 1}, {"lindexMulti", ASSEM_LINDEX_MULTI, INST_LIST_INDEX_MULTI, INT_MIN,1}, {"list", ASSEM_LIST, INST_LIST, INT_MIN,1}, {"listConcat", ASSEM_1BYTE, INST_LIST_CONCAT, 2, 1}, {"listIn", ASSEM_1BYTE, INST_LIST_IN, 2, 1}, {"listIndex", ASSEM_1BYTE, INST_LIST_INDEX, 2, 1}, {"listIndexImm", ASSEM_INDEX, INST_LIST_INDEX_IMM, 1, 1}, {"listLength", ASSEM_1BYTE, INST_LIST_LENGTH, 1, 1}, {"listNotIn", ASSEM_1BYTE, INST_LIST_NOT_IN, 2, 1}, {"load", ASSEM_LVT, (INST_LOAD_SCALAR1 << 8 | INST_LOAD_SCALAR4), 0, 1}, {"loadArray", ASSEM_LVT, (INST_LOAD_ARRAY1<<8 | INST_LOAD_ARRAY4), 1, 1}, {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1}, {"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1}, {"lor", ASSEM_1BYTE, INST_LOR, 2, 1}, {"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1}, {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1}, {"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1}, {"lt", ASSEM_1BYTE, INST_LT, 2, 1}, {"mod", ASSEM_1BYTE, INST_MOD, 2, 1}, {"mult", ASSEM_1BYTE, INST_MULT, 2, 1}, {"neq", ASSEM_1BYTE, INST_NEQ, 2, 1}, {"nop", ASSEM_1BYTE, INST_NOP, 0, 0}, {"not", ASSEM_1BYTE, INST_LNOT, 1, 1}, {"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1}, {"numericType", ASSEM_1BYTE, INST_NUM_TYPE, 1, 1}, {"originCmd", ASSEM_1BYTE, INST_ORIGIN_COMMAND, 1, 1}, {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1}, {"pop", ASSEM_1BYTE, INST_POP, 1, 0}, {"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1}, {"pushReturnOpts", ASSEM_1BYTE, INST_PUSH_RETURN_OPTIONS, 0, 1}, {"pushResult", ASSEM_1BYTE, INST_PUSH_RESULT, 0, 1}, {"regexp", ASSEM_REGEXP, INST_REGEXP, 2, 1}, {"resolveCmd", ASSEM_1BYTE, INST_RESOLVE_COMMAND, 1, 1}, {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0}, {"rshift", ASSEM_1BYTE, INST_RSHIFT, 2, 1}, {"store", ASSEM_LVT, (INST_STORE_SCALAR1<<8 | INST_STORE_SCALAR4), 1, 1}, {"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8 | INST_STORE_ARRAY4), 2, 1}, {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1}, {"storeStk", ASSEM_1BYTE, INST_STORE_STK, 2, 1}, {"strcaseLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1}, {"strcaseTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1}, {"strcaseUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1}, {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1}, {"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1}, {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1}, {"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1}, {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1}, {"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1}, {"strmap", ASSEM_1BYTE, INST_STR_MAP, 3, 1}, {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1}, {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1}, {"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1}, {"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1}, {"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1}, {"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1}, {"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1}, {"strtrimRight", ASSEM_1BYTE, INST_STR_TRIM_RIGHT, 2, 1}, {"sub", ASSEM_1BYTE, INST_SUB, 2, 1}, {"tclooClass", ASSEM_1BYTE, INST_TCLOO_CLASS, 1, 1}, {"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1}, {"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1}, {"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1}, {"tryCvtToBoolean", ASSEM_1BYTE, INST_TRY_CVT_TO_BOOLEAN,1, 2}, {"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1}, {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1}, {"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0}, {"unsetArray", ASSEM_BOOL_LVT4,INST_UNSET_ARRAY, 1, 0}, {"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0}, {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0}, {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0}, {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1}, {NULL, ASSEM_1BYTE, 0, 0, 0} }; /* * List of instructions that cannot throw an exception under any * circumstances. These instructions are the ones that are permissible after * an exception is caught but before the corresponding exception range is * popped from the stack. * The instructions must be in ascending order by numeric operation code. */ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN, /* 73-76 */ INST_LIST, /* 79 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ INST_REVERSE, /* 126 */ INST_NOP, /* 132 */ INST_STR_MAP, /* 143 */ INST_STR_FIND, /* 144 */ INST_COROUTINE_NAME, /* 149 */ INST_NS_CURRENT, /* 151 */ INST_INFO_LEVEL_NUM, /* 152 */ INST_RESOLVE_COMMAND, /* 154 */ INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */ INST_CONCAT_STK, /* 169 */ INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 170-172 */ INST_NUM_TYPE /* 180 */ }; /* * Helper macros. */ #if defined(TCL_DEBUG_ASSEMBLY) && defined(__GNUC__) && __GNUC__ > 2 #define DEBUG_PRINT(...) fprintf(stderr, ##__VA_ARGS__);fflush(stderr) #elif defined(__GNUC__) && __GNUC__ > 2 #define DEBUG_PRINT(...) /* nothing */ #else #define DEBUG_PRINT /* nothing */ #endif /* *----------------------------------------------------------------------------- * * BBAdjustStackDepth -- * * When an opcode is emitted, adjusts the stack information in the basic * block to reflect the number of operands produced and consumed. * * Results: * None. * * Side effects: * Updates minimum, maximum and final stack requirements in the basic * block. * *----------------------------------------------------------------------------- */ static void BBAdjustStackDepth( BasicBlock *bbPtr, /* Structure describing the basic block */ int consumed, /* Count of operands consumed by the * operation */ int produced) /* Count of operands produced by the * operation */ { int depth = bbPtr->finalStackDepth; depth -= consumed; if (depth < bbPtr->minStackDepth) { bbPtr->minStackDepth = depth; } depth += produced; if (depth > bbPtr->maxStackDepth) { bbPtr->maxStackDepth = depth; } bbPtr->finalStackDepth = depth; } /* *----------------------------------------------------------------------------- * * BBUpdateStackReqs -- * * Updates the stack requirements of a basic block, given the opcode * being emitted and an operand count. * * Results: * None. * * Side effects: * Updates min, max and final stack requirements in the basic block. * * Notes: * This function must not be called for instructions such as REVERSE and * OVER that are variadic but do not consume all their operands. Instead, * BBAdjustStackDepth should be called directly. * * count should be provided only for variadic operations. For operations * with known arity, count should be 0. * *----------------------------------------------------------------------------- */ static void BBUpdateStackReqs( BasicBlock* bbPtr, /* Structure describing the basic block */ int tblIdx, /* Index in TalInstructionTable of the * operation being assembled */ int count) /* Count of operands for variadic insts */ { int consumed = TalInstructionTable[tblIdx].operandsConsumed; int produced = TalInstructionTable[tblIdx].operandsProduced; if (consumed == INT_MIN) { /* * The instruction is variadic; it consumes 'count' operands. */ consumed = count; } if (produced < 0) { /* * The instruction leaves some of its variadic operands on the stack, * with net stack effect of '-1-produced' */ produced = consumed - produced - 1; } BBAdjustStackDepth(bbPtr, consumed, produced); } /* *----------------------------------------------------------------------------- * * BBEmitOpcode, BBEmitInstInt1, BBEmitInstInt4 -- * * Emit the opcode part of an instruction, or the entirety of an * instruction with a 1- or 4-byte operand, and adjust stack * requirements. * * Results: * None. * * Side effects: * Stores instruction and operand in the operand stream, and adjusts the * stack. * *----------------------------------------------------------------------------- */ static void BBEmitOpcode( AssemblyEnv* assemEnvPtr, /* Assembly environment */ int tblIdx, /* Table index in TalInstructionTable of op */ int count) /* Operand count for variadic ops */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ int op = TalInstructionTable[tblIdx].tclInstCode & 0xFF; /* * If this is the first instruction in a basic block, record its line * number. */ if (bbPtr->startOffset == envPtr->codeNext - envPtr->codeStart) { bbPtr->startLine = assemEnvPtr->cmdLine; } TclEmitInt1(op, envPtr); TclUpdateAtCmdStart(op, envPtr); BBUpdateStackReqs(bbPtr, tblIdx, count); } static void BBEmitInstInt1( AssemblyEnv* assemEnvPtr, /* Assembly environment */ int tblIdx, /* Index in TalInstructionTable of op */ int opnd, /* 1-byte operand */ int count) /* Operand count for variadic ops */ { BBEmitOpcode(assemEnvPtr, tblIdx, count); TclEmitInt1(opnd, assemEnvPtr->envPtr); } static void BBEmitInstInt4( AssemblyEnv* assemEnvPtr, /* Assembly environment */ int tblIdx, /* Index in TalInstructionTable of op */ int opnd, /* 4-byte operand */ int count) /* Operand count for variadic ops */ { BBEmitOpcode(assemEnvPtr, tblIdx, count); TclEmitInt4(opnd, assemEnvPtr->envPtr); } /* *----------------------------------------------------------------------------- * * BBEmitInst1or4 -- * * Emits a 1- or 4-byte operation according to the magnitude of the * operand. * *----------------------------------------------------------------------------- */ static void BBEmitInst1or4( AssemblyEnv* assemEnvPtr, /* Assembly environment */ int tblIdx, /* Index in TalInstructionTable of op */ int param, /* Variable-length parameter */ int count) /* Arity if variadic */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ int op = TalInstructionTable[tblIdx].tclInstCode; if (param <= 0xFF) { op >>= 8; } else { op &= 0xFF; } TclEmitInt1(op, envPtr); if (param <= 0xFF) { TclEmitInt1(param, envPtr); } else { TclEmitInt4(param, envPtr); } TclUpdateAtCmdStart(op, envPtr); BBUpdateStackReqs(bbPtr, tblIdx, count); } /* *----------------------------------------------------------------------------- * * Tcl_AssembleObjCmd, TclNRAssembleObjCmd -- * * Direct evaluation path for tcl::unsupported::assemble * * Results: * Returns a standard Tcl result. * * Side effects: * Assembles the code in objv[1], and executes it, so side effects * include whatever the code does. * *----------------------------------------------------------------------------- */ int Tcl_AssembleObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { /* * Boilerplate - make sure that there is an NRE trampoline on the C stack * because there needs to be one in place to execute bytecode. */ return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv); } int TclNRAssembleObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ByteCode *codePtr; /* Pointer to the bytecode to execute */ Tcl_Obj* backtrace; /* Object where extra error information is * constructed. */ (void)dummy; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList"); return TCL_ERROR; } /* * Assemble the source to bytecode. */ codePtr = CompileAssembleObj(interp, objv[1]); /* * On failure, report error line. */ if (codePtr == NULL) { Tcl_AddErrorInfo(interp, "\n (\""); Tcl_AppendObjToErrorInfo(interp, objv[0]); Tcl_AddErrorInfo(interp, "\" body, line "); TclNewIntObj(backtrace, Tcl_GetErrorLine(interp)); Tcl_AppendObjToErrorInfo(interp, backtrace); Tcl_AddErrorInfo(interp, ")"); return TCL_ERROR; } /* * Use NRE to evaluate the bytecode from the trampoline. */ return TclNRExecuteByteCode(interp, codePtr); } /* *----------------------------------------------------------------------------- * * CompileAssembleObj -- * * Sets up and assembles Tcl bytecode for the direct-execution path in * the Tcl bytecode assembler. * * Results: * Returns a pointer to the assembled code. Returns NULL if the assembly * fails for any reason, with an appropriate error message in the * interpreter. * *----------------------------------------------------------------------------- */ static ByteCode * CompileAssembleObj( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Source code to assemble */ { Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ Namespace* namespacePtr; /* Namespace in which variable and command * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ int sourceLen; /* Length of the source code in bytes */ /* * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ if (objPtr->typePtr == &assembleCodeType) { namespacePtr = iPtr->varFramePtr->nsPtr; codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle == iPtr) && (codePtr->compileEpoch == iPtr->compileEpoch) && (codePtr->nsPtr == namespacePtr) && (codePtr->nsEpoch == namespacePtr->resolverEpoch) && (codePtr->localCachePtr == iPtr->varFramePtr->localCachePtr)) { return codePtr; } /* * Not valid, so free it and regenerate. */ FreeAssembleCodeInternalRep(objPtr); } /* * Set up the compilation environment, and assemble the code. */ source = TclGetStringFromObj(objPtr, &sourceLen); TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0); status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT); if (status != TCL_OK) { /* * Assembly failed. Clean up and report the error. */ TclFreeCompileEnv(&compEnv); return NULL; } /* * Add a "done" instruction as the last instruction and change the object * into a ByteCode object. Ownership of the literal objects and aux data * items is given to the ByteCode object. */ TclEmitOpcode(INST_DONE, &compEnv); TclInitByteCodeObj(objPtr, &compEnv); objPtr->typePtr = &assembleCodeType; TclFreeCompileEnv(&compEnv); /* * Record the local variable context to which the bytecode pertains */ codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; } /* * Report on what the assembler did. */ #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 2) { TclPrintByteCodeObj(interp, objPtr); fflush(stdout); } #endif /* TCL_COMPILE_DEBUG */ return codePtr; } /* *----------------------------------------------------------------------------- * * TclCompileAssembleCmd -- * * Compilation procedure for the '::tcl::unsupported::assemble' command. * * Results: * Returns a standard Tcl result. * * Side effects: * Puts the result of assembling the code into the bytecode stream in * 'compileEnv'. * * This procedure makes sure that the command has a single arg, which is * constant. If that condition is met, the procedure calls TclAssembleCode to * produce bytecode for the given assembly code, and returns any error * resulting from the assembly. * *----------------------------------------------------------------------------- */ int TclCompileAssembleCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; /* Token in the input script */ int numCommands = envPtr->numCommands; int offset = envPtr->codeNext - envPtr->codeStart; int depth = envPtr->currStackDepth; (void)cmdPtr; /* * Make sure that the command has a single arg that is a simple word. */ if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } /* * Compile the code and convert any error from the compilation into * bytecode reporting the error; */ if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, TCL_EVAL_DIRECT)) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s\" body, line %d)", parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, Tcl_GetErrorLine(interp))); envPtr->numCommands = numCommands; envPtr->codeNext = envPtr->codeStart + offset; envPtr->currStackDepth = depth; TclCompileSyntaxError(interp, envPtr); } return TCL_OK; } /* *----------------------------------------------------------------------------- * * TclAssembleCode -- * * Take a list of instructions in a Tcl_Obj, and assemble them to Tcl * bytecodes * * Results: * Returns TCL_OK on success, TCL_ERROR on failure. If 'flags' includes * TCL_EVAL_DIRECT, places an error message in the interpreter result. * * Side effects: * Adds byte codes to the compile environment, and updates the * environment's stack depth. * *----------------------------------------------------------------------------- */ static int TclAssembleCode( CompileEnv *envPtr, /* Compilation environment that is to receive * the generated bytecode */ const char* codePtr, /* Assembly-language code to be processed */ int codeLen, /* Length of the code */ int flags) /* OR'ed combination of flags */ { Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ /* * Walk through the assembly script using the Tcl parser. Each 'command' * will be an instruction or assembly directive. */ const char* instPtr = codePtr; /* Where to start looking for a line of code */ const char* nextPtr; /* Pointer to the end of the line of code */ int bytesLeft = codeLen; /* Number of bytes of source code remaining to * be parsed */ int status; /* Tcl status return */ AssemblyEnv* assemEnvPtr = NewAssemblyEnv(envPtr, flags); Tcl_Parse* parsePtr = assemEnvPtr->parsePtr; do { /* * Parse out one command line from the assembly script. */ status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr); /* * Report errors in the parse. */ if (status != TCL_OK) { if (flags & TCL_EVAL_DIRECT) { Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, parsePtr->term + 1 - parsePtr->commandStart); } FreeAssemblyEnv(assemEnvPtr); return TCL_ERROR; } /* * Advance the pointers around any leading commentary. */ TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr, parsePtr->commandStart); TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, parsePtr->commandStart - envPtr->source); /* * Process the line of code. */ if (parsePtr->numWords > 0) { int instLen = parsePtr->commandSize; /* Length in bytes of the current command */ if (parsePtr->term == parsePtr->commandStart + instLen - 1) { --instLen; } /* * If tracing, show each line assembled as it happens. */ #ifdef TCL_COMPILE_DEBUG if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) { printf(" %4ld Assembling: ", (long)(envPtr->codeNext - envPtr->codeStart)); TclPrintSource(stdout, parsePtr->commandStart, TclMin(instLen, 55)); printf("\n"); } #endif if (AssembleOneLine(assemEnvPtr) != TCL_OK) { if (flags & TCL_EVAL_DIRECT) { Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, instLen); } Tcl_FreeParse(parsePtr); FreeAssemblyEnv(assemEnvPtr); return TCL_ERROR; } } /* * Advance to the next line of code. */ nextPtr = parsePtr->commandStart + parsePtr->commandSize; bytesLeft -= (nextPtr - instPtr); instPtr = nextPtr; TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart, instPtr); TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, instPtr - envPtr->source); Tcl_FreeParse(parsePtr); } while (bytesLeft > 0); /* * Done with parsing the code. */ status = FinishAssembly(assemEnvPtr); FreeAssemblyEnv(assemEnvPtr); return status; } /* *----------------------------------------------------------------------------- * * NewAssemblyEnv -- * * Creates an environment for the assembler to run in. * * Results: * Allocates, initialises and returns an assembler environment * *----------------------------------------------------------------------------- */ static AssemblyEnv* NewAssemblyEnv( CompileEnv* envPtr, /* Compilation environment being used for code * generation*/ int flags) /* Compilation flags (TCL_EVAL_DIRECT) */ { Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ AssemblyEnv* assemEnvPtr = (AssemblyEnv*)TclStackAlloc(interp, sizeof(AssemblyEnv)); /* Assembler environment under construction */ Tcl_Parse* parsePtr = (Tcl_Parse*)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Parse of one line of assembly code */ assemEnvPtr->envPtr = envPtr; assemEnvPtr->parsePtr = parsePtr; assemEnvPtr->cmdLine = 1; assemEnvPtr->clNext = envPtr->clNext; /* * Make the hashtables that store symbol resolution. */ Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS); /* * Start the first basic block. */ assemEnvPtr->curr_bb = NULL; assemEnvPtr->head_bb = AllocBB(assemEnvPtr); assemEnvPtr->curr_bb = assemEnvPtr->head_bb; assemEnvPtr->head_bb->startLine = 1; /* * Stash compilation flags. */ assemEnvPtr->flags = flags; return assemEnvPtr; } /* *----------------------------------------------------------------------------- * * FreeAssemblyEnv -- * * Cleans up the assembler environment when assembly is complete. * *----------------------------------------------------------------------------- */ static void FreeAssemblyEnv( AssemblyEnv* assemEnvPtr) /* Environment to free */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment being used for code * generation */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ BasicBlock* thisBB; /* Pointer to a basic block being deleted */ BasicBlock* nextBB; /* Pointer to a deleted basic block's * successor */ /* * Free all the basic block structures. */ for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) { if (thisBB->jumpTarget != NULL) { Tcl_DecrRefCount(thisBB->jumpTarget); } if (thisBB->foreignExceptions != NULL) { ckfree(thisBB->foreignExceptions); } nextBB = thisBB->successor1; if (thisBB->jtPtr != NULL) { DeleteMirrorJumpTable(thisBB->jtPtr); thisBB->jtPtr = NULL; } ckfree(thisBB); } /* * Dispose what's left. */ Tcl_DeleteHashTable(&assemEnvPtr->labelHash); TclStackFree(interp, assemEnvPtr->parsePtr); TclStackFree(interp, assemEnvPtr); } /* *----------------------------------------------------------------------------- * * AssembleOneLine -- * * Assembles a single command from an assembly language source. * * Results: * Returns TCL_ERROR with an appropriate error message if the assembly * fails. Returns TCL_OK if the assembly succeeds. Updates the assembly * environment with the state of the assembly. * *----------------------------------------------------------------------------- */ static int AssembleOneLine( AssemblyEnv* assemEnvPtr) /* State of the assembly */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment being used for code * gen */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Parse* parsePtr = assemEnvPtr->parsePtr; /* Parse of the line of code */ Tcl_Token* tokenPtr; /* Current token within the line of code */ Tcl_Obj* instNameObj; /* Name of the instruction */ int tblIdx; /* Index in TalInstructionTable of the * instruction */ enum TalInstType instType; /* Type of the instruction */ Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ int operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ int localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ JumptableInfo* jtPtr; /* Pointer to a jumptable */ int infoIndex; /* Index of the jumptable in auxdata */ int status = TCL_ERROR; /* Return value from this function */ /* * Make sure that the instruction name is known at compile time. */ tokenPtr = parsePtr->tokenPtr; if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) { return TCL_ERROR; } /* * Look up the instruction name. */ if (Tcl_GetIndexFromObjStruct(interp, instNameObj, &TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction", TCL_EXACT, &tblIdx) != TCL_OK) { goto cleanup; } /* * Vector on the type of instruction being processed. */ instType = TalInstructionTable[tblIdx].instType; switch (instType) { case ASSEM_PUSH: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "value"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len); BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0); break; case ASSEM_1BYTE: if (parsePtr->numWords != 1) { Tcl_WrongNumArgs(interp, 1, &instNameObj, ""); goto cleanup; } BBEmitOpcode(assemEnvPtr, tblIdx, 0); break; case ASSEM_BEGIN_CATCH: /* * Emit the BEGIN_CATCH instruction with the code offset of the * exception branch target instead of the exception range index. The * correct index will be generated and inserted later, when catches * are being resolved. */ if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "label"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart; BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0); assemEnvPtr->curr_bb->flags |= BB_BEGINCATCH; StartBasicBlock(assemEnvPtr, BB_FALLTHRU, operand1Obj); break; case ASSEM_BOOL: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean"); goto cleanup; } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); break; case ASSEM_BOOL_LVT4: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName"); goto cleanup; } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); TclEmitInt4(localVar, envPtr); break; case ASSEM_CLOCK_READ: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } if (opnd < 0 || opnd > 3) { Tcl_SetObjResult(interp, Tcl_NewStringObj("operand must be [0..3]", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL); goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_CONCAT1: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckOneByte(interp, opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_DICT_GET: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); break; case ASSEM_DICT_SET: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); TclEmitInt4(localVar, envPtr); break; case ASSEM_DICT_UNSET: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); TclEmitInt4(localVar, envPtr); break; case ASSEM_END_CATCH: if (parsePtr->numWords != 1) { Tcl_WrongNumArgs(interp, 1, &instNameObj, ""); goto cleanup; } assemEnvPtr->curr_bb->flags |= BB_ENDCATCH; BBEmitOpcode(assemEnvPtr, tblIdx, 0); StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); break; case ASSEM_EVAL: /* TODO - Refactor this stuff into a subroutine that takes the inst * code, the message ("script" or "expression") and an evaluator * callback that calls TclCompileScript or TclCompileExpr. */ if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, ((TalInstructionTable[tblIdx].tclInstCode == INST_EVAL_STK) ? "script" : "expression")); goto cleanup; } if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { CompileEmbeddedScript(assemEnvPtr, tokenPtr+1, TalInstructionTable+tblIdx); } else if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } else { operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len); /* * Assumes that PUSH is the first slot! */ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); BBEmitOpcode(assemEnvPtr, tblIdx, 0); } break; case ASSEM_INVOKE: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_JUMP: case ASSEM_JUMP4: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "label"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart; if (instType == ASSEM_JUMP) { flags = BB_JUMP1; BBEmitInstInt1(assemEnvPtr, tblIdx, 0, 0); } else { flags = 0; BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0); } /* * Start a new basic block at the instruction following the jump. */ assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; if (TalInstructionTable[tblIdx].operandsConsumed != 0) { flags |= BB_FALLTHRU; } StartBasicBlock(assemEnvPtr, flags, operand1Obj); break; case ASSEM_JUMPTABLE: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "table"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart; DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n", assemEnvPtr->curr_bb, assemEnvPtr->cmdLine, envPtr->codeNext - envPtr->codeStart); infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); DEBUG_PRINT("auxdata index=%d\n", infoIndex); BBEmitInstInt4(assemEnvPtr, tblIdx, infoIndex, 0); if (CreateMirrorJumpTable(assemEnvPtr, operand1Obj) != TCL_OK) { goto cleanup; } StartBasicBlock(assemEnvPtr, BB_JUMPTABLE|BB_FALLTHRU, NULL); break; case ASSEM_LABEL: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "name"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } /* * Add the (label_name, address) pair to the hash table. */ if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) { goto cleanup; } break; case ASSEM_LINDEX_MULTI: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_LIST: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckNonNegative(interp, opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_INDEX: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); goto cleanup; } if (GetListIndexOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_LSET_FLAT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } if (opnd < 2) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj("operand must be >=2", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL); } goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_LVT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_LVT1: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0 || CheckOneByte(interp, localVar)) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_LVT1_SINT1: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0 || CheckOneByte(interp, localVar) || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckSignedOneByte(interp, opnd)) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); TclEmitInt1(opnd, envPtr); break; case ASSEM_LVT4: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_OVER: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckNonNegative(interp, opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); break; case ASSEM_REGEXP: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean"); goto cleanup; } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } { BBEmitInstInt1(assemEnvPtr, tblIdx, TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0), 0); } break; case ASSEM_REVERSE: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckNonNegative(interp, opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_SINT1: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckSignedOneByte(interp, opnd) != TCL_OK) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); break; case ASSEM_SINT4_LVT4: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0); TclEmitInt4(localVar, envPtr); break; default: Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n", Tcl_GetString(instNameObj)); } status = TCL_OK; cleanup: Tcl_DecrRefCount(instNameObj); if (operand1Obj) { Tcl_DecrRefCount(operand1Obj); } return status; } /* *----------------------------------------------------------------------------- * * CompileEmbeddedScript -- * * Compile an embedded 'eval' or 'expr' that appears in assembly code. * * This procedure is called when the 'eval' or 'expr' assembly directive is * encountered, and the argument to the directive is a simple word that * requires no substitution. The appropriate compiler (TclCompileScript or * TclCompileExpr) is invoked recursively, and emits bytecode. * * Before the compiler is invoked, the compilation environment's stack * consumption is reset to zero. Upon return from the compilation, the net * stack effect of the compilation is in the compiler env, and this stack * effect is posted to the assembler environment. The compile environment's * stack consumption is then restored to what it was before (which is actually * the state of the stack on entry to the block of assembly code). * * Any exception ranges pushed by the compilation are copied to the basic * block and removed from the compiler environment. They will be rebuilt at * the end of assembly, when the exception stack depth is actually known. * *----------------------------------------------------------------------------- */ static void CompileEmbeddedScript( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token* tokenPtr, /* Tcl_Token containing the script */ const TalInstDesc* instPtr) /* Instruction that determines whether * the script is 'expr' or 'eval' */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ /* * The expression or script is not only known at compile time, but * actually a "simple word". It can be compiled inline by invoking the * compiler recursively. * * Save away the stack depth and reset it before compiling the script. * We'll record the stack usage of the script in the BasicBlock, and * accumulate it together with the stack usage of the enclosing assembly * code. */ int savedStackDepth = envPtr->currStackDepth; int savedMaxStackDepth = envPtr->maxStackDepth; int savedExceptArrayNext = envPtr->exceptArrayNext; envPtr->currStackDepth = 0; envPtr->maxStackDepth = 0; StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); switch(instPtr->tclInstCode) { case INST_EVAL_STK: TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr); break; case INST_EXPR_STK: TclCompileExpr(interp, tokenPtr->start, tokenPtr->size, envPtr, 1); break; default: Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen", instPtr->name, instPtr->tclInstCode); } /* * Roll up the stack usage of the embedded block into the assembler * environment. */ SyncStackDepth(assemEnvPtr); envPtr->currStackDepth = savedStackDepth; envPtr->maxStackDepth = savedMaxStackDepth; /* * Save any exception ranges that were pushed by the compiler; they will * need to be fixed up once the stack depth is known. */ MoveExceptionRangesToBasicBlock(assemEnvPtr, savedExceptArrayNext); /* * Flush the current basic block. */ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); } /* *----------------------------------------------------------------------------- * * SyncStackDepth -- * * Copies the stack depth from the compile environment to a basic block. * * Side effects: * Current and max stack depth in the current basic block are adjusted. * * This procedure is called on return from invoking the compiler for the * 'eval' and 'expr' operations. It adjusts the stack depth of the current * basic block to reflect the stack required by the just-compiled code. * *----------------------------------------------------------------------------- */ static void SyncStackDepth( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* curr_bb = assemEnvPtr->curr_bb; /* Current basic block */ int maxStackDepth = curr_bb->finalStackDepth + envPtr->maxStackDepth; /* Max stack depth in the basic block */ if (maxStackDepth > curr_bb->maxStackDepth) { curr_bb->maxStackDepth = maxStackDepth; } curr_bb->finalStackDepth += envPtr->currStackDepth; } /* *----------------------------------------------------------------------------- * * MoveExceptionRangesToBasicBlock -- * * Removes exception ranges that were created by compiling an embedded * script from the CompileEnv, and stores them in the BasicBlock. They * will be reinstalled, at the correct stack depth, after control flow * analysis is complete on the assembly code. * *----------------------------------------------------------------------------- */ static void MoveExceptionRangesToBasicBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ int savedExceptArrayNext) /* Saved index of the end of the exception * range array */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* curr_bb = assemEnvPtr->curr_bb; /* Current basic block */ int exceptionCount = envPtr->exceptArrayNext - savedExceptArrayNext; /* Number of ranges that must be moved */ int i; if (exceptionCount == 0) { /* Nothing to do */ return; } /* * Save the exception ranges in the basic block. They will be re-added at * the conclusion of assembly; at this time, the INST_BEGIN_CATCH * instructions in the block will be adjusted from whatever range indices * they have [savedExceptArrayNext .. envPtr->exceptArrayNext) to the * indices that the exceptions acquire. The saved exception ranges are * converted to a relative nesting depth. The depth will be recomputed * once flow analysis has determined the actual stack depth of the block. */ DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n", curr_bb, exceptionCount, savedExceptArrayNext); curr_bb->foreignExceptionBase = savedExceptArrayNext; curr_bb->foreignExceptionCount = exceptionCount; curr_bb->foreignExceptions = (ExceptionRange*)ckalloc(exceptionCount * sizeof(ExceptionRange)); memcpy(curr_bb->foreignExceptions, envPtr->exceptArrayPtr + savedExceptArrayNext, exceptionCount * sizeof(ExceptionRange)); for (i = 0; i < exceptionCount; ++i) { curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth; } envPtr->exceptArrayNext = savedExceptArrayNext; } /* *----------------------------------------------------------------------------- * * CreateMirrorJumpTable -- * * Makes a jump table with comparison values and assembly code labels. * * Results: * Returns a standard Tcl status, with an error message in the * interpreter on error. * * Side effects: * Initializes the jump table pointer in the current basic block to a * JumptableInfo. The keys in the JumptableInfo are the comparison * strings. The values, instead of being jump displacements, are * Tcl_Obj's with the code labels. */ static int CreateMirrorJumpTable( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Obj* jumps) /* List of alternating keywords and labels */ { int objc; /* Number of elements in the 'jumps' list */ Tcl_Obj** objv; /* Pointers to the elements in the list */ CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ JumptableInfo* jtPtr; Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */ Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */ int isNew; /* Flag==1 if the key is not yet in the * table. */ int i; if (TclListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) { return TCL_ERROR; } if (objc % 2 != 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "jump table must have an even number of list elements", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL); } return TCL_ERROR; } /* * Allocate the jumptable. */ jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo)); jtHashPtr = &jtPtr->hashTable; Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS); /* * Fill the keys and labels into the table. */ DEBUG_PRINT("jump table {\n"); for (i = 0; i < objc; i+=2) { DEBUG_PRINT(" %s -> %s\n", Tcl_GetString(objv[i]), Tcl_GetString(objv[i+1])); hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]), &isNew); if (!isNew) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "duplicate entry in jump table for \"%s\"", Tcl_GetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", NULL); DeleteMirrorJumpTable(jtPtr); return TCL_ERROR; } } Tcl_SetHashValue(hashEntry, objv[i+1]); Tcl_IncrRefCount(objv[i+1]); } DEBUG_PRINT("}\n"); /* * Put the mirror jumptable in the basic block struct. */ bbPtr->jtPtr = jtPtr; return TCL_OK; } /* *----------------------------------------------------------------------------- * * DeleteMirrorJumpTable -- * * Cleans up a jump table when the basic block is deleted. * *----------------------------------------------------------------------------- */ static void DeleteMirrorJumpTable( JumptableInfo* jtPtr) { Tcl_HashTable* jtHashPtr = &jtPtr->hashTable; /* Hash table pointer */ Tcl_HashSearch search; /* Hash search control */ Tcl_HashEntry* entry; /* Hash table entry containing a jump label */ Tcl_Obj* label; /* Jump label from the hash table */ for (entry = Tcl_FirstHashEntry(jtHashPtr, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { label = (Tcl_Obj*)Tcl_GetHashValue(entry); Tcl_DecrRefCount(label); Tcl_SetHashValue(entry, NULL); } Tcl_DeleteHashTable(jtHashPtr); ckfree(jtPtr); } /* *----------------------------------------------------------------------------- * * GetNextOperand -- * * Retrieves the next operand in sequence from an assembly instruction, * and makes sure that its value is known at compile time. * * Results: * If successful, returns TCL_OK and leaves a Tcl_Obj with the operand * text in *operandObjPtr. In case of failure, returns TCL_ERROR and * leaves *operandObjPtr untouched. * * Side effects: * Advances *tokenPtrPtr around the token just processed. * *----------------------------------------------------------------------------- */ static int GetNextOperand( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token** tokenPtrPtr, /* INPUT/OUTPUT: Pointer to the token holding * the operand */ Tcl_Obj** operandObjPtr) /* OUTPUT: Tcl object holding the operand text * with \-substitutions done. */ { Tcl_Interp* interp = (Tcl_Interp*) assemEnvPtr->envPtr->iPtr; Tcl_Obj* operandObj; TclNewObj(operandObj); if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) { Tcl_DecrRefCount(operandObj); if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "assembly code may not contain substitutions", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL); } return TCL_ERROR; } *tokenPtrPtr = TokenAfter(*tokenPtrPtr); Tcl_IncrRefCount(operandObj); *operandObjPtr = operandObj; return TCL_OK; } /* *----------------------------------------------------------------------------- * * GetBooleanOperand -- * * Retrieves a Boolean operand from the input stream and advances * the token pointer. * * Results: * Returns a standard Tcl result (with an error message in the * interpreter on failure). * * Side effects: * Stores the Boolean value in (*result) and advances (*tokenPtrPtr) * to the next token. * *----------------------------------------------------------------------------- */ static int GetBooleanOperand( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token** tokenPtrPtr, /* Current token from the parser */ int* result) /* OUTPUT: Integer extracted from the token */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ Tcl_Obj* intObj; /* Integer from the source code */ int status; /* Tcl status return */ /* * Extract the next token as a string. */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) { return TCL_ERROR; } /* * Convert to an integer, advance to the next token and return. */ status = Tcl_GetBooleanFromObj(interp, intObj, result); Tcl_DecrRefCount(intObj); *tokenPtrPtr = TokenAfter(tokenPtr); return status; } /* *----------------------------------------------------------------------------- * * GetIntegerOperand -- * * Retrieves an integer operand from the input stream and advances the * token pointer. * * Results: * Returns a standard Tcl result (with an error message in the * interpreter on failure). * * Side effects: * Stores the integer value in (*result) and advances (*tokenPtrPtr) to * the next token. * *----------------------------------------------------------------------------- */ static int GetIntegerOperand( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token** tokenPtrPtr, /* Current token from the parser */ int* result) /* OUTPUT: Integer extracted from the token */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ Tcl_Obj* intObj; /* Integer from the source code */ int status; /* Tcl status return */ /* * Extract the next token as a string. */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) { return TCL_ERROR; } /* * Convert to an integer, advance to the next token and return. */ status = Tcl_GetIntFromObj(interp, intObj, result); Tcl_DecrRefCount(intObj); *tokenPtrPtr = TokenAfter(tokenPtr); return status; } /* *----------------------------------------------------------------------------- * * GetListIndexOperand -- * * Gets the value of an operand intended to serve as a list index. * * Results: * Returns a standard Tcl result: TCL_OK if the parse is successful and * TCL_ERROR (with an appropriate error message) if the parse fails. * * Side effects: * Stores the list index at '*index'. Values between -1 and 0x7FFFFFFF * have their natural meaning; values between -2 and -0x80000000 * represent 'end-2-N'. * *----------------------------------------------------------------------------- */ static int GetListIndexOperand( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token** tokenPtrPtr, /* Current token from the parser */ int* result) /* OUTPUT: Integer extracted from the token */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ Tcl_Obj *value; int status; /* General operand validity check */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) { return TCL_ERROR; } /* Convert to an integer, advance to the next token and return. */ /* * NOTE: Indexing a list with an index before it yields the * same result as indexing after it, and might be more easily portable * when list size limits grow. */ status = TclIndexEncode(interp, value, TCL_INDEX_BEFORE,TCL_INDEX_BEFORE, result); Tcl_DecrRefCount(value); *tokenPtrPtr = TokenAfter(tokenPtr); return status; } /* *----------------------------------------------------------------------------- * * FindLocalVar -- * * Gets the name of a local variable from the input stream and advances * the token pointer. * * Results: * Returns the LVT index of the local variable. Returns -1 if the * variable is non-local, not known at compile time, or cannot be * installed in the LVT (leaving an error message in the interpreter * result if necessary). * * Side effects: * Advances the token pointer. May define a new LVT slot if the variable * has not yet been seen and the execution context allows for it. * *----------------------------------------------------------------------------- */ static int FindLocalVar( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token** tokenPtrPtr) { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; int varNameLen; int localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { return -1; } varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen); if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) { Tcl_DecrRefCount(varNameObj); return -1; } localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr); Tcl_DecrRefCount(varNameObj); if (localVar == -1) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use this instruction to create a variable" " in a non-proc context", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL); } return -1; } *tokenPtrPtr = TokenAfter(tokenPtr); return localVar; } /* *----------------------------------------------------------------------------- * * CheckNamespaceQualifiers -- * * Verify that a variable name has no namespace qualifiers before * attempting to install it in the LVT. * * Results: * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores * an error message in the interpreter result. * *----------------------------------------------------------------------------- */ static int CheckNamespaceQualifiers( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ const char* name, /* Variable name to check */ int nameLen) /* Length of the variable */ { const char* p; for (p = name; p+2 < name+nameLen; p++) { if ((*p == ':') && (p[1] == ':')) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "variable \"%s\" is not local", name)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL); return TCL_ERROR; } } return TCL_OK; } /* *----------------------------------------------------------------------------- * * CheckOneByte -- * * Verify that a constant fits in a single byte in the instruction * stream. * * Results: * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores * an error message in the interpreter result. * * This code is here primarily to verify that instructions like INCR_SCALAR1 * are possible on a given local variable. The fact that there is no * INCR_SCALAR4 is puzzling. * *----------------------------------------------------------------------------- */ static int CheckOneByte( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value < 0 || value > 0xFF) { result = Tcl_NewStringObj("operand does not fit in one byte", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL); return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * CheckSignedOneByte -- * * Verify that a constant fits in a single signed byte in the instruction * stream. * * Results: * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores * an error message in the interpreter result. * * This code is here primarily to verify that instructions like INCR_SCALAR1 * are possible on a given local variable. The fact that there is no * INCR_SCALAR4 is puzzling. * *----------------------------------------------------------------------------- */ static int CheckSignedOneByte( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value > 0x7F || value < -0x80) { result = Tcl_NewStringObj("operand does not fit in one byte", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL); return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * CheckNonNegative -- * * Verify that a constant is nonnegative * * Results: * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores * an error message in the interpreter result. * * This code is here primarily to verify that instructions like INCR_INVOKE * are consuming a positive number of operands * *----------------------------------------------------------------------------- */ static int CheckNonNegative( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value < 0) { result = Tcl_NewStringObj("operand must be nonnegative", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL); return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * CheckStrictlyPositive -- * * Verify that a constant is positive * * Results: * On success, returns TCL_OK. On failure, returns TCL_ERROR and * stores an error message in the interpreter result. * * This code is here primarily to verify that instructions like INCR_INVOKE * are consuming a positive number of operands * *----------------------------------------------------------------------------- */ static int CheckStrictlyPositive( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value <= 0) { result = Tcl_NewStringObj("operand must be positive", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL); return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * DefineLabel -- * * Defines a label appearing in the assembly sequence. * * Results: * Returns a standard Tcl result. Returns TCL_OK and an empty result if * the definition succeeds; returns TCL_ERROR and an appropriate message * if a duplicate definition is found. * *----------------------------------------------------------------------------- */ static int DefineLabel( AssemblyEnv* assemEnvPtr, /* Assembly environment */ const char* labelName) /* Label being defined */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_HashEntry* entry; /* Label's entry in the symbol table */ int isNew; /* Flag == 1 iff the label was previously * undefined */ /* TODO - This can now be simplified! */ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); /* * Look up the newly-defined label in the symbol table. */ entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew); if (!isNew) { /* * This is a duplicate label. */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "duplicate definition of label \"%s\"", labelName)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName, NULL); } return TCL_ERROR; } /* * This is the first appearance of the label in the code. */ Tcl_SetHashValue(entry, assemEnvPtr->curr_bb); return TCL_OK; } /* *----------------------------------------------------------------------------- * * StartBasicBlock -- * * Starts a new basic block when a label or jump is encountered. * * Results: * Returns a pointer to the BasicBlock structure of the new * basic block. * *----------------------------------------------------------------------------- */ static BasicBlock* StartBasicBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ int flags, /* Flags to apply to the basic block being * closed, if there is one. */ Tcl_Obj* jumpLabel) /* Label of the location that the block jumps * to, or NULL if the block does not jump */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* newBB; /* BasicBlock structure for the new block */ BasicBlock* currBB = assemEnvPtr->curr_bb; /* * Coalesce zero-length blocks. */ if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) { currBB->startLine = assemEnvPtr->cmdLine; return currBB; } /* * Make the new basic block. */ newBB = AllocBB(assemEnvPtr); /* * Record the jump target if there is one. */ currBB->jumpTarget = jumpLabel; if (jumpLabel != NULL) { Tcl_IncrRefCount(currBB->jumpTarget); } /* * Record the fallthrough if there is one. */ currBB->flags |= flags; /* * Record the successor block. */ currBB->successor1 = newBB; assemEnvPtr->curr_bb = newBB; return newBB; } /* *----------------------------------------------------------------------------- * * AllocBB -- * * Allocates a new basic block * * Results: * Returns a pointer to the newly allocated block, which is initialized * to contain no code and begin at the current instruction pointer. * *----------------------------------------------------------------------------- */ static BasicBlock * AllocBB( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; BasicBlock *bb = (BasicBlock*)ckalloc(sizeof(BasicBlock)); bb->originalStartOffset = bb->startOffset = envPtr->codeNext - envPtr->codeStart; bb->startLine = assemEnvPtr->cmdLine + 1; bb->jumpOffset = -1; bb->jumpLine = -1; bb->prevPtr = assemEnvPtr->curr_bb; bb->predecessor = NULL; bb->successor1 = NULL; bb->jumpTarget = NULL; bb->initialStackDepth = 0; bb->minStackDepth = 0; bb->maxStackDepth = 0; bb->finalStackDepth = 0; bb->catchDepth = 0; bb->enclosingCatch = NULL; bb->foreignExceptionBase = -1; bb->foreignExceptionCount = 0; bb->foreignExceptions = NULL; bb->jtPtr = NULL; bb->flags = 0; return bb; } /* *----------------------------------------------------------------------------- * * FinishAssembly -- * * Postprocessing after all bytecode has been generated for a block of * assembly code. * * Results: * Returns a standard Tcl result, with an error message left in the * interpreter if appropriate. * * Side effects: * The program is checked to see if any undefined labels remain. The * initial stack depth of all the basic blocks in the flow graph is * calculated and saved. The stack balance on exit is computed, checked * and saved. * *----------------------------------------------------------------------------- */ static int FinishAssembly( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { int mustMove; /* Amount by which the code needs to be grown * because of expanding jumps */ /* * Resolve the targets of all jumps and determine whether code needs to be * moved around. */ if (CalculateJumpRelocations(assemEnvPtr, &mustMove)) { return TCL_ERROR; } /* * Move the code if necessary. */ if (mustMove) { MoveCodeForJumps(assemEnvPtr, mustMove); } /* * Resolve jump target labels to bytecode offsets. */ FillInJumpOffsets(assemEnvPtr); /* * Label each basic block with its catch context. Quit on inconsistency. */ if (ProcessCatches(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } /* * Make sure that no block accessible from a catch's error exit that hasn't * popped the exception stack can throw an exception. */ if (CheckForThrowInWrongContext(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } /* * Compute stack balance throughout the program. */ if (CheckStack(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } /* * TODO - Check for unreachable code. Or maybe not; unreachable code is * Mostly Harmless. */ return TCL_OK; } /* *----------------------------------------------------------------------------- * * CalculateJumpRelocations -- * * Calculate any movement that has to be done in the assembly code to * expand JUMP1 instructions to JUMP4 (because they jump more than a * 1-byte range). * * Results: * Returns a standard Tcl result, with an appropriate error message if * anything fails. * * Side effects: * Sets the 'startOffset' pointer in every basic block to the new origin * of the block, and turns off JUMP1 flags on instructions that must be * expanded (and adjusts them to the corresponding JUMP4's). Does *not* * store the jump offsets at this point. * * Sets *mustMove to 1 if and only if at least one instruction changed * size so the code must be moved. * * As a side effect, also checks for undefined labels and reports them. * *----------------------------------------------------------------------------- */ static int CalculateJumpRelocations( AssemblyEnv* assemEnvPtr, /* Assembly environment */ int* mustMove) /* OUTPUT: Number of bytes that have been * added to the code */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr; /* Pointer to a basic block being checked */ Tcl_HashEntry* entry; /* Exit label's entry in the symbol table */ BasicBlock* jumpTarget; /* Basic block where the jump goes */ int motion; /* Amount by which the code has expanded */ int offset; /* Offset in the bytecode from a jump * instruction to its target */ unsigned opcode; /* Opcode in the bytecode being adjusted */ /* * Iterate through basic blocks as long as a change results in code * expansion. */ *mustMove = 0; do { motion = 0; for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr = bbPtr->successor1) { /* * Advance the basic block start offset by however many bytes we * have inserted in the code up to this point */ bbPtr->startOffset += motion; /* * If the basic block references a label (and hence performs a * jump), find the location of the label. Report an error if the * label is missing. */ if (bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(bbPtr->jumpTarget)); if (entry == NULL) { ReportUndefinedLabel(assemEnvPtr, bbPtr, bbPtr->jumpTarget); return TCL_ERROR; } /* * If the instruction is a JUMP1, turn it into a JUMP4 if its * target is out of range. */ jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); if (bbPtr->flags & BB_JUMP1) { offset = jumpTarget->startOffset - (bbPtr->jumpOffset + motion); if (offset < -0x80 || offset > 0x7F) { opcode = TclGetUInt1AtPtr(envPtr->codeStart + bbPtr->jumpOffset); ++opcode; TclStoreInt1AtPtr(opcode, envPtr->codeStart + bbPtr->jumpOffset); motion += 3; bbPtr->flags &= ~BB_JUMP1; } } } /* * If the basic block references a jump table, that doesn't affect * the code locations, but resolve the labels now, and store basic * block pointers in the jumptable hash. */ if (bbPtr->flags & BB_JUMPTABLE) { if (CheckJumpTableLabels(assemEnvPtr, bbPtr) != TCL_OK) { return TCL_ERROR; } } } *mustMove += motion; } while (motion != 0); return TCL_OK; } /* *----------------------------------------------------------------------------- * * CheckJumpTableLabels -- * * Make sure that all the labels in a jump table are defined. * * Results: * Returns TCL_OK if they are, TCL_ERROR if they aren't. * *----------------------------------------------------------------------------- */ static int CheckJumpTableLabels( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* bbPtr) /* Basic block that ends in a jump table */ { Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable; /* Hash table with the symbols */ Tcl_HashSearch search; /* Hash table iterator */ Tcl_HashEntry* symEntryPtr; /* Hash entry for the symbols */ Tcl_Obj* symbolObj; /* Jump target */ Tcl_HashEntry* valEntryPtr; /* Hash entry for the resolutions */ /* * Look up every jump target in the jump hash. */ DEBUG_PRINT("check jump table labels %p {\n", bbPtr); for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr); valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(symbolObj)); DEBUG_PRINT(" %s -> %s (%d)\n", (char*) Tcl_GetHashKey(symHash, symEntryPtr), Tcl_GetString(symbolObj), (valEntryPtr != NULL)); if (valEntryPtr == NULL) { ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj); return TCL_ERROR; } } DEBUG_PRINT("}\n"); return TCL_OK; } /* *----------------------------------------------------------------------------- * * ReportUndefinedLabel -- * * Report that a basic block refers to an undefined jump label * * Side effects: * Stores an error message, error code, and line number information in * the assembler's Tcl interpreter. * *----------------------------------------------------------------------------- */ static void ReportUndefinedLabel( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* bbPtr, /* Basic block that contains the undefined * label */ Tcl_Obj* jumpTarget) /* Label of a jump target */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "undefined label \"%s\"", Tcl_GetString(jumpTarget))); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL", Tcl_GetString(jumpTarget), NULL); Tcl_SetErrorLine(interp, bbPtr->jumpLine); } } /* *----------------------------------------------------------------------------- * * MoveCodeForJumps -- * * Move bytecodes in memory to accommodate JUMP1 instructions that have * expanded to become JUMP4's. * *----------------------------------------------------------------------------- */ static void MoveCodeForJumps( AssemblyEnv* assemEnvPtr, /* Assembler environment */ int mustMove) /* Number of bytes of added code */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr; /* Pointer to a basic block being checked */ int topOffset; /* Bytecode offset of the following basic * block before code motion */ /* * Make sure that there is enough space in the bytecode array to * accommodate the expanded code. */ while (envPtr->codeEnd < envPtr->codeNext + mustMove) { TclExpandCodeArray(envPtr); } /* * Iterate through the bytecodes in reverse order, and move them upward to * their new homes. */ topOffset = envPtr->codeNext - envPtr->codeStart; for (bbPtr = assemEnvPtr->curr_bb; bbPtr != NULL; bbPtr = bbPtr->prevPtr) { DEBUG_PRINT("move code from %d to %d\n", bbPtr->originalStartOffset, bbPtr->startOffset); memmove(envPtr->codeStart + bbPtr->startOffset, envPtr->codeStart + bbPtr->originalStartOffset, topOffset - bbPtr->originalStartOffset); topOffset = bbPtr->originalStartOffset; bbPtr->jumpOffset += (bbPtr->startOffset - bbPtr->originalStartOffset); } envPtr->codeNext += mustMove; } /* *----------------------------------------------------------------------------- * * FillInJumpOffsets -- * * Fill in the final offsets of all jump instructions once bytecode * locations have been completely determined. * *----------------------------------------------------------------------------- */ static void FillInJumpOffsets( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr; /* Pointer to a basic block being checked */ Tcl_HashEntry* entry; /* Hashtable entry for a jump target label */ BasicBlock* jumpTarget; /* Basic block where a jump goes */ int fromOffset; /* Bytecode location of a jump instruction */ int targetOffset; /* Bytecode location of a jump instruction's * target */ for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr = bbPtr->successor1) { if (bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(bbPtr->jumpTarget)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); fromOffset = bbPtr->jumpOffset; targetOffset = jumpTarget->startOffset; if (bbPtr->flags & BB_JUMP1) { TclStoreInt1AtPtr(targetOffset - fromOffset, envPtr->codeStart + fromOffset + 1); } else { TclStoreInt4AtPtr(targetOffset - fromOffset, envPtr->codeStart + fromOffset + 1); } } if (bbPtr->flags & BB_JUMPTABLE) { ResolveJumpTableTargets(assemEnvPtr, bbPtr); } } } /* *----------------------------------------------------------------------------- * * ResolveJumpTableTargets -- * * Puts bytecode addresses for the targets of a jumptable into the * table * * Results: * Returns TCL_OK if they are, TCL_ERROR if they aren't. * *----------------------------------------------------------------------------- */ static void ResolveJumpTableTargets( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* bbPtr) /* Basic block that ends in a jump table */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable; /* Hash table with the symbols */ Tcl_HashSearch search; /* Hash table iterator */ Tcl_HashEntry* symEntryPtr; /* Hash entry for the symbols */ Tcl_Obj* symbolObj; /* Jump target */ Tcl_HashEntry* valEntryPtr; /* Hash entry for the resolutions */ int auxDataIndex; /* Index of the auxdata */ JumptableInfo* realJumpTablePtr; /* Jump table in the actual code */ Tcl_HashTable* realJumpHashPtr; /* Jump table hash in the actual code */ Tcl_HashEntry* realJumpEntryPtr; /* Entry in the jump table hash in * the actual code */ BasicBlock* jumpTargetBBPtr; /* Basic block that the jump proceeds to */ int junk; auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); realJumpTablePtr = (JumptableInfo*)TclFetchAuxData(envPtr, auxDataIndex); realJumpHashPtr = &realJumpTablePtr->hashTable; /* * Look up every jump target in the jump hash. */ DEBUG_PRINT("resolve jump table {\n"); for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr); DEBUG_PRINT(" symbol %s\n", Tcl_GetString(symbolObj)); valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(symbolObj)); jumpTargetBBPtr = (BasicBlock*)Tcl_GetHashValue(valEntryPtr); realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr, Tcl_GetHashKey(symHash, symEntryPtr), &junk); DEBUG_PRINT(" %s -> %s -> bb %p (pc %d) hash entry %p\n", (char*) Tcl_GetHashKey(symHash, symEntryPtr), Tcl_GetString(symbolObj), jumpTargetBBPtr, jumpTargetBBPtr->startOffset, realJumpEntryPtr); Tcl_SetHashValue(realJumpEntryPtr, INT2PTR(jumpTargetBBPtr->startOffset - bbPtr->jumpOffset)); } DEBUG_PRINT("}\n"); } /* *----------------------------------------------------------------------------- * * CheckForThrowInWrongContext -- * * Verify that no beginCatch/endCatch sequence can throw an exception * after an original exception is caught and before its exception context * is removed from the stack. * * Results: * Returns a standard Tcl result. * * Side effects: * Stores an appropriate error message in the interpreter as needed. * *----------------------------------------------------------------------------- */ static int CheckForThrowInWrongContext( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { BasicBlock* blockPtr; /* Current basic block */ /* * Walk through the basic blocks in turn, checking all the ones that have * caught an exception and not disposed of it properly. */ for (blockPtr = assemEnvPtr->head_bb; blockPtr != NULL; blockPtr = blockPtr->successor1) { if (blockPtr->catchState == BBCS_CAUGHT) { /* * Walk through the instructions in the basic block. */ if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) { return TCL_ERROR; } } } return TCL_OK; } /* *----------------------------------------------------------------------------- * * CheckNonThrowingBlock -- * * Check that a basic block cannot throw an exception. * * Results: * Returns TCL_ERROR if the block cannot be proven to be nonthrowing. * * Side effects: * Stashes an error message in the interpreter result. * *----------------------------------------------------------------------------- */ static int CheckNonThrowingBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* blockPtr) /* Basic block where exceptions are not * allowed */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ BasicBlock* nextPtr; /* Pointer to the succeeding basic block */ int offset; /* Bytecode offset of the current * instruction */ int bound; /* Bytecode offset following the last * instruction of the block. */ unsigned char opcode; /* Current bytecode instruction */ /* * Determine where in the code array the basic block ends. */ nextPtr = blockPtr->successor1; if (nextPtr == NULL) { bound = envPtr->codeNext - envPtr->codeStart; } else { bound = nextPtr->startOffset; } /* * Walk through the instructions of the block. */ offset = blockPtr->startOffset; while (offset < bound) { /* * Determine whether an instruction is nonthrowing. */ opcode = (envPtr->codeStart)[offset]; if (BytecodeMightThrow(opcode)) { /* * Report an error for a throw in the wrong context. */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" instruction may not appear in " "a context where an exception has been " "caught and not disposed of.", tclInstructionTable[opcode].name)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); } return TCL_ERROR; } offset += tclInstructionTable[opcode].numBytes; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * BytecodeMightThrow -- * * Tests if a given bytecode instruction might throw an exception. * * Results: * Returns 1 if the bytecode might throw an exception, 0 if the * instruction is known never to throw. * *----------------------------------------------------------------------------- */ static int BytecodeMightThrow( unsigned char opcode) { /* * Binary search on the non-throwing bytecode list. */ int min = 0; int max = sizeof(NonThrowingByteCodes) - 1; int mid; unsigned char c; while (max >= min) { mid = (min + max) / 2; c = NonThrowingByteCodes[mid]; if (opcode < c) { max = mid-1; } else if (opcode > c) { min = mid+1; } else { /* * Opcode is nonthrowing. */ return 0; } } return 1; } /* *----------------------------------------------------------------------------- * * CheckStack -- * * Audit stack usage in a block of assembly code. * * Results: * Returns a standard Tcl result. * * Side effects: * Updates stack depth on entry for all basic blocks in the flowgraph. * Calculates the max stack depth used in the program, and updates the * compilation environment to reflect it. * *----------------------------------------------------------------------------- */ static int CheckStack( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ int maxDepth; /* Maximum stack depth overall */ /* * Checking the head block will check all the other blocks recursively. */ assemEnvPtr->maxDepth = 0; if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL, 0) == TCL_ERROR) { return TCL_ERROR; } /* * Post the max stack depth back to the compilation environment. */ maxDepth = assemEnvPtr->maxDepth + envPtr->currStackDepth; if (maxDepth > envPtr->maxStackDepth) { envPtr->maxStackDepth = maxDepth; } /* * If the exit is reachable, make sure that the program exits with 1 * operand on the stack. */ if (StackCheckExit(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } /* * Reset the visited state on all basic blocks. */ ResetVisitedBasicBlocks(assemEnvPtr); return TCL_OK; } /* *----------------------------------------------------------------------------- * * StackCheckBasicBlock -- * * Checks stack consumption for a basic block (and recursively for its * successors). * * Results: * Returns a standard Tcl result. * * Side effects: * Updates initial stack depth for the basic block and its successors. * (Final and maximum stack depth are relative to initial, and are not * touched). * * This procedure eventually checks, for the entire flow graph, whether stack * balance is consistent. It is an error for a given basic block to be * reachable along multiple flow paths with different stack depths. * *----------------------------------------------------------------------------- */ static int StackCheckBasicBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* blockPtr, /* Pointer to the basic block being checked */ BasicBlock* predecessor, /* Pointer to the block that passed control to * this one. */ int initialStackDepth) /* Stack depth on entry to the block */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ BasicBlock* jumpTarget; /* Basic block where a jump goes */ int stackDepth; /* Current stack depth */ int maxDepth; /* Maximum stack depth so far */ int result; /* Tcl status return */ Tcl_HashSearch jtSearch; /* Search structure for the jump table */ Tcl_HashEntry* jtEntry; /* Hash entry in the jump table */ Tcl_Obj* targetLabel; /* Target label from the jump table */ Tcl_HashEntry* entry; /* Hash entry in the label table */ if (blockPtr->flags & BB_VISITED) { /* * If the block is already visited, check stack depth for consistency * among the paths that reach it. */ if (blockPtr->initialStackDepth == initialStackDepth) { return TCL_OK; } if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "inconsistent stack depths on two execution paths", -1)); /* * TODO - add execution trace of both paths */ Tcl_SetErrorLine(interp, blockPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); } return TCL_ERROR; } /* * If the block is not already visited, set the 'predecessor' link to * indicate how control got to it. Set the initial stack depth to the * current stack depth in the flow of control. */ blockPtr->flags |= BB_VISITED; blockPtr->predecessor = predecessor; blockPtr->initialStackDepth = initialStackDepth; /* * Calculate minimum stack depth, and flag an error if the block * underflows the stack. */ if (initialStackDepth + blockPtr->minStackDepth < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); } return TCL_ERROR; } /* * Make sure that the block doesn't try to pop below the stack level of an * enclosing catch. */ if (blockPtr->enclosingCatch != 0 && initialStackDepth + blockPtr->minStackDepth < (blockPtr->enclosingCatch->initialStackDepth + blockPtr->enclosingCatch->finalStackDepth)) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "code pops stack below level of enclosing catch", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); } return TCL_ERROR; } /* * Update maximum stgack depth. */ maxDepth = initialStackDepth + blockPtr->maxStackDepth; if (maxDepth > assemEnvPtr->maxDepth) { assemEnvPtr->maxDepth = maxDepth; } /* * Calculate stack depth on exit from the block, and invoke this procedure * recursively to check successor blocks. */ stackDepth = initialStackDepth + blockPtr->finalStackDepth; result = TCL_OK; if (blockPtr->flags & BB_FALLTHRU) { result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1, blockPtr, stackDepth); } if (result == TCL_OK && blockPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(blockPtr->jumpTarget)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr, stackDepth); } /* * All blocks referenced in a jump table are successors. */ if (blockPtr->flags & BB_JUMPTABLE) { for (jtEntry = Tcl_FirstHashEntry(&blockPtr->jtPtr->hashTable, &jtSearch); result == TCL_OK && jtEntry != NULL; jtEntry = Tcl_NextHashEntry(&jtSearch)) { targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry); entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(targetLabel)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr, stackDepth); } } return result; } /* *----------------------------------------------------------------------------- * * StackCheckExit -- * * Makes sure that the net stack effect of an entire assembly language * script is to push 1 result. * * Results: * Returns a standard Tcl result, with an error message in the * interpreter result if the stack is wrong. * * Side effects: * If the assembly code had a net stack effect of zero, emits code to the * concluding block to push a null result. In any case, updates the stack * depth in the compile environment to reflect the net effect of the * assembly code. * *----------------------------------------------------------------------------- */ static int StackCheckExit( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ int depth; /* Net stack effect */ int litIndex; /* Index in the literal pool of the empty * string */ BasicBlock* curr_bb = assemEnvPtr->curr_bb; /* Final basic block in the assembly */ /* * Don't perform these checks if execution doesn't reach the exit (either * because of an infinite loop or because the only return is from the * middle. */ if (curr_bb->flags & BB_VISITED) { /* * Exit with no operands; push an empty one. */ depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth; if (depth == 0) { /* * Emit a 'push' of the empty literal. */ litIndex = TclRegisterNewLiteral(envPtr, "", 0); /* * Assumes that 'push' is at slot 0 in TalInstructionTable. */ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); ++depth; } /* * Exit with unbalanced stack. */ if (depth != 1) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "stack is unbalanced on exit from the code (depth=%d)", depth)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); } return TCL_ERROR; } /* * Record stack usage. */ envPtr->currStackDepth += depth; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * ProcessCatches -- * * First pass of 'catch' processing. * * Results: * Returns a standard Tcl result, with an appropriate error message if * the result is TCL_ERROR. * * Side effects: * Labels all basic blocks with their enclosing catches. * *----------------------------------------------------------------------------- */ static int ProcessCatches( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { BasicBlock* blockPtr; /* Pointer to a basic block */ /* * Clear the catch state of all basic blocks. */ for (blockPtr = assemEnvPtr->head_bb; blockPtr != NULL; blockPtr = blockPtr->successor1) { blockPtr->catchState = BBCS_UNKNOWN; blockPtr->enclosingCatch = NULL; } /* * Start the check recursively from the first basic block, which is * outside any exception context */ if (ProcessCatchesInBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL, BBCS_NONE, 0) != TCL_OK) { return TCL_ERROR; } /* * Check for unclosed catch on exit. */ if (CheckForUnclosedCatches(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } /* * Now there's enough information to build the exception ranges. */ if (BuildExceptionRanges(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } /* * Finally, restore any exception ranges from embedded scripts. */ RestoreEmbeddedExceptionRanges(assemEnvPtr); return TCL_OK; } /* *----------------------------------------------------------------------------- * * ProcessCatchesInBasicBlock -- * * First-pass catch processing for one basic block. * * Results: * Returns a standard Tcl result, with error message in the interpreter * result if an error occurs. * * This procedure checks consistency of the exception context through the * assembler program, and records the enclosing 'catch' for every basic block. * *----------------------------------------------------------------------------- */ static int ProcessCatchesInBasicBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* bbPtr, /* Basic block being processed */ BasicBlock* enclosing, /* Start basic block of the enclosing catch */ enum BasicBlockCatchState state, /* BBCS_NONE, BBCS_INCATCH, or BBCS_CAUGHT */ int catchDepth) /* Depth of nesting of catches */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ int result; /* Return value from this procedure */ BasicBlock* fallThruEnclosing; /* Enclosing catch if execution falls thru */ enum BasicBlockCatchState fallThruState; /* Catch state of the successor block */ BasicBlock* jumpEnclosing; /* Enclosing catch if execution goes to jump * target */ enum BasicBlockCatchState jumpState; /* Catch state of the jump target */ int changed = 0; /* Flag == 1 iff successor blocks need to be * checked because the state of this block has * changed. */ BasicBlock* jumpTarget; /* Basic block where a jump goes */ Tcl_HashSearch jtSearch; /* Hash search control for a jumptable */ Tcl_HashEntry* jtEntry; /* Entry in a jumptable */ Tcl_Obj* targetLabel; /* Target label from a jumptable */ Tcl_HashEntry* entry; /* Entry from the label table */ /* * Update the state of the current block, checking for consistency. Set * 'changed' to 1 if the state changes and successor blocks need to be * rechecked. */ if (bbPtr->catchState == BBCS_UNKNOWN) { bbPtr->enclosingCatch = enclosing; } else if (bbPtr->enclosingCatch != enclosing) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "execution reaches an instruction in inconsistent " "exception contexts", -1)); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL); } return TCL_ERROR; } if (state > bbPtr->catchState) { bbPtr->catchState = state; changed = 1; } /* * If this block has been visited before, and its state hasn't changed, * we're done with it for now. */ if (!changed) { return TCL_OK; } bbPtr->catchDepth = catchDepth; /* * Determine enclosing catch and 'caught' state for the fallthrough and * the jump target. Default for both is the state of the current block. */ fallThruEnclosing = enclosing; fallThruState = state; jumpEnclosing = enclosing; jumpState = state; /* * TODO: Make sure that the test cases include validating that a natural * loop can't include 'beginCatch' or 'endCatch' */ if (bbPtr->flags & BB_BEGINCATCH) { /* * If the block begins a catch, the state for the successor is 'in * catch'. The jump target is the exception exit, and the state of the * jump target is 'caught.' */ fallThruEnclosing = bbPtr; fallThruState = BBCS_INCATCH; jumpEnclosing = bbPtr; jumpState = BBCS_CAUGHT; ++catchDepth; } if (bbPtr->flags & BB_ENDCATCH) { /* * If the block ends a catch, the state for the successor is whatever * the state was on entry to the catch. */ if (enclosing == NULL) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "endCatch without a corresponding beginCatch", -1)); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL); } return TCL_ERROR; } fallThruEnclosing = enclosing->enclosingCatch; fallThruState = enclosing->catchState; --catchDepth; } /* * Visit any successor blocks with the appropriate exception context */ result = TCL_OK; if (bbPtr->flags & BB_FALLTHRU) { result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1, fallThruEnclosing, fallThruState, catchDepth); } if (result == TCL_OK && bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(bbPtr->jumpTarget)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, jumpEnclosing, jumpState, catchDepth); } /* * All blocks referenced in a jump table are successors. */ if (bbPtr->flags & BB_JUMPTABLE) { for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch); result == TCL_OK && jtEntry != NULL; jtEntry = Tcl_NextHashEntry(&jtSearch)) { targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry); entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(targetLabel)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, jumpEnclosing, jumpState, catchDepth); } } return result; } /* *----------------------------------------------------------------------------- * * CheckForUnclosedCatches -- * * Checks that a sequence of assembly code has no unclosed catches on * exit. * * Results: * Returns a standard Tcl result, with an error message for unclosed * catches. * *----------------------------------------------------------------------------- */ static int CheckForUnclosedCatches( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "catch still active on exit from assembly code", -1)); Tcl_SetErrorLine(interp, assemEnvPtr->curr_bb->enclosingCatch->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL); } return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * BuildExceptionRanges -- * * Walks through the assembly code and builds exception ranges for the * catches embedded therein. * * Results: * Returns a standard Tcl result with an error message in the interpreter * if anything is unsuccessful. * * Side effects: * Each contiguous block of code with a given catch exit is assigned an * exception range at the appropriate level. * Exception ranges in embedded blocks have their levels corrected and * collated into the table. * Blocks that end with 'beginCatch' are associated with the innermost * exception range of the following block. * *----------------------------------------------------------------------------- */ static int BuildExceptionRanges( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr; /* Current basic block */ BasicBlock* prevPtr = NULL; /* Previous basic block */ int catchDepth = 0; /* Current catch depth */ int maxCatchDepth = 0; /* Maximum catch depth in the program */ BasicBlock** catches; /* Stack of catches in progress */ int* catchIndices; /* Indices of the exception ranges of catches * in progress */ int i; /* * Determine the max catch depth for the entire assembly script * (excluding embedded eval's and expr's, which will be handled later). */ for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) { if (bbPtr->catchDepth > maxCatchDepth) { maxCatchDepth = bbPtr->catchDepth; } } /* * Allocate memory for a stack of active catches. */ catches = (BasicBlock**)ckalloc(maxCatchDepth * sizeof(BasicBlock*)); catchIndices = (int *)ckalloc(maxCatchDepth * sizeof(int)); for (i = 0; i < maxCatchDepth; ++i) { catches[i] = NULL; catchIndices[i] = -1; } /* * Walk through the basic blocks and manage exception ranges. */ for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) { UnstackExpiredCatches(envPtr, bbPtr, catchDepth, catches, catchIndices); LookForFreshCatches(bbPtr, catches); StackFreshCatches(assemEnvPtr, bbPtr, catchDepth, catches, catchIndices); /* * If the last block was a 'begin catch', fill in the exception range. */ catchDepth = bbPtr->catchDepth; if (prevPtr != NULL && (prevPtr->flags & BB_BEGINCATCH)) { TclStoreInt4AtPtr(catchIndices[catchDepth-1], envPtr->codeStart + bbPtr->startOffset - 4); } prevPtr = bbPtr; } /* Make sure that all catches are closed */ if (catchDepth != 0) { Tcl_Panic("unclosed catch at end of code in " "tclAssembly.c:BuildExceptionRanges, can't happen"); } /* Free temp storage */ ckfree(catchIndices); ckfree(catches); return TCL_OK; } /* *----------------------------------------------------------------------------- * * UnstackExpiredCatches -- * * Unstacks and closes the exception ranges for any catch contexts that * were active in the previous basic block but are inactive in the * current one. * *----------------------------------------------------------------------------- */ static void UnstackExpiredCatches( CompileEnv* envPtr, /* Compilation environment */ BasicBlock* bbPtr, /* Basic block being processed */ int catchDepth, /* Depth of nesting of catches prior to entry * to this block */ BasicBlock** catches, /* Array of catch contexts */ int* catchIndices) /* Indices of the exception ranges * corresponding to the catch contexts */ { ExceptionRange* range; /* Exception range for a specific catch */ BasicBlock* block; /* Catch block being examined */ BasicBlockCatchState catchState; /* State of the code relative to the catch * block being examined ("in catch" or * "caught"). */ /* * Unstack any catches that are deeper than the nesting level of the basic * block being entered. */ while (catchDepth > bbPtr->catchDepth) { --catchDepth; if (catches[catchDepth] != NULL) { range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->numCodeBytes = bbPtr->startOffset - range->codeOffset; catches[catchDepth] = NULL; catchIndices[catchDepth] = -1; } } /* * Unstack any catches that don't match the basic block being entered, * either because they are no longer part of the context, or because the * context has changed from INCATCH to CAUGHT. */ catchState = bbPtr->catchState; block = bbPtr->enclosingCatch; while (catchDepth > 0) { --catchDepth; if (catches[catchDepth] != NULL) { if (catches[catchDepth] != block || catchState >= BBCS_CAUGHT) { range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->numCodeBytes = bbPtr->startOffset - range->codeOffset; catches[catchDepth] = NULL; catchIndices[catchDepth] = -1; } catchState = block->catchState; block = block->enclosingCatch; } } } /* *----------------------------------------------------------------------------- * * LookForFreshCatches -- * * Determines whether a basic block being entered needs any exception * ranges that are not already stacked. * * Does not create the ranges: this procedure iterates from the innermost * catch outward, but exception ranges must be created from the outermost * catch inward. * *----------------------------------------------------------------------------- */ static void LookForFreshCatches( BasicBlock* bbPtr, /* Basic block being entered */ BasicBlock** catches) /* Array of catch contexts that are already * entered */ { BasicBlockCatchState catchState; /* State ("in catch" or "caught") of the * current catch. */ BasicBlock* block; /* Current enclosing catch */ int catchDepth; /* Nesting depth of the current catch */ catchState = bbPtr->catchState; block = bbPtr->enclosingCatch; catchDepth = bbPtr->catchDepth; while (catchDepth > 0) { --catchDepth; if (catches[catchDepth] != block && catchState < BBCS_CAUGHT) { catches[catchDepth] = block; } catchState = block->catchState; block = block->enclosingCatch; } } /* *----------------------------------------------------------------------------- * * StackFreshCatches -- * * Make ExceptionRange records for any catches that are in the basic * block being entered and were not in the previous basic block. * *----------------------------------------------------------------------------- */ static void StackFreshCatches( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* bbPtr, /* Basic block being processed */ int catchDepth, /* Depth of nesting of catches prior to entry * to this block */ BasicBlock** catches, /* Array of catch contexts */ int* catchIndices) /* Indices of the exception ranges * corresponding to the catch contexts */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ ExceptionRange* range; /* Exception range for a specific catch */ BasicBlock* block; /* Catch block being examined */ BasicBlock* errorExit; /* Error exit from the catch block */ Tcl_HashEntry* entryPtr; catchDepth = 0; /* * Iterate through the enclosing catch blocks from the outside in, * looking for ones that don't have exception ranges (and are uncaught) */ for (catchDepth = 0; catchDepth < bbPtr->catchDepth; ++catchDepth) { if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) { /* * Create an exception range for a block that needs one. */ block = catches[catchDepth]; catchIndices[catchDepth] = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->nestingLevel = envPtr->exceptDepth + catchDepth; envPtr->maxExceptDepth = TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth); range->codeOffset = bbPtr->startOffset; entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(block->jumpTarget)); if (entryPtr == NULL) { Tcl_Panic("undefined label in tclAssembly.c:" "BuildExceptionRanges, can't happen"); } errorExit = (BasicBlock*)Tcl_GetHashValue(entryPtr); range->catchOffset = errorExit->startOffset; } } } /* *----------------------------------------------------------------------------- * * RestoreEmbeddedExceptionRanges -- * * Processes an assembly script, replacing any exception ranges that * were present in embedded code. * *----------------------------------------------------------------------------- */ static void RestoreEmbeddedExceptionRanges( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr; /* Current basic block */ int rangeBase; /* Base of the foreign exception ranges when * they are reinstalled */ int rangeIndex; /* Index of the current foreign exception * range as reinstalled */ ExceptionRange* range; /* Current foreign exception range */ unsigned char opcode; /* Current instruction's opcode */ int catchIndex; /* Index of the exception range to which the * current instruction refers */ int i; /* * Walk the basic blocks looking for exceptions in embedded scripts. */ for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr = bbPtr->successor1) { if (bbPtr->foreignExceptionCount != 0) { /* * Reinstall the embedded exceptions and track their nesting level */ rangeBase = envPtr->exceptArrayNext; for (i = 0; i < bbPtr->foreignExceptionCount; ++i) { range = bbPtr->foreignExceptions + i; rangeIndex = TclCreateExceptRange(range->type, envPtr); range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth; memcpy(envPtr->exceptArrayPtr + rangeIndex, range, sizeof(ExceptionRange)); if (range->nestingLevel >= envPtr->maxExceptDepth) { envPtr->maxExceptDepth = range->nestingLevel + 1; } } /* * Walk through the bytecode of the basic block, and relocate * INST_BEGIN_CATCH4 instructions to the new locations */ i = bbPtr->startOffset; while (i < bbPtr->successor1->startOffset) { opcode = envPtr->codeStart[i]; if (opcode == INST_BEGIN_CATCH4) { catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1); if (catchIndex >= bbPtr->foreignExceptionBase && catchIndex < (bbPtr->foreignExceptionBase + bbPtr->foreignExceptionCount)) { catchIndex -= bbPtr->foreignExceptionBase; catchIndex += rangeBase; TclStoreInt4AtPtr(catchIndex, envPtr->codeStart+i+1); } } i += tclInstructionTable[opcode].numBytes; } } } } /* *----------------------------------------------------------------------------- * * ResetVisitedBasicBlocks -- * * Turns off the 'visited' flag in all basic blocks at the conclusion * of a pass. * *----------------------------------------------------------------------------- */ static void ResetVisitedBasicBlocks( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { BasicBlock* block; for (block = assemEnvPtr->head_bb; block != NULL; block = block->successor1) { block->flags &= ~BB_VISITED; } } /* *----------------------------------------------------------------------------- * * AddBasicBlockRangeToErrorInfo -- * * Updates the error info of the Tcl interpreter to show a given basic * block in the code. * * This procedure is used to label the callstack with source location * information when reporting an error in stack checking. * *----------------------------------------------------------------------------- */ static void AddBasicBlockRangeToErrorInfo( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* bbPtr) /* Basic block in which the error is found */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Obj* lineNo; /* Line number in the source */ Tcl_AddErrorInfo(interp, "\n in assembly code between lines "); TclNewIntObj(lineNo, bbPtr->startLine); Tcl_IncrRefCount(lineNo); Tcl_AppendObjToErrorInfo(interp, lineNo); Tcl_AddErrorInfo(interp, " and "); if (bbPtr->successor1 != NULL) { Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine); Tcl_AppendObjToErrorInfo(interp, lineNo); } else { Tcl_AddErrorInfo(interp, "end of assembly code"); } Tcl_DecrRefCount(lineNo); } /* *----------------------------------------------------------------------------- * * DupAssembleCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl assembly language * bytecode. We do not copy the bytecode internalrep. Instead, we return * without setting copyPtr->typePtr, so the copy is a plain string copy * of the assembly source, and if it is to be used as a compiled * expression, it will need to be reprocessed. * * This makes sense, because with Tcl's copy-on-write practices, the * usual (only?) time Tcl_DuplicateObj() will be called is when the copy * is about to be modified, which would invalidate any copied bytecode * anyway. The only reason it might make sense to copy the bytecode is if * we had some modifying routines that operated directly on the internalrep, * as we do for lists and dicts. * * Results: * None. * * Side effects: * None. * *----------------------------------------------------------------------------- */ static void DupAssembleCodeInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { (void)srcPtr; (void)copyPtr; return; } /* *----------------------------------------------------------------------------- * * FreeAssembleCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl expression * bytecode. Frees the storage allocated to hold the internal rep, unless * ref counts indicate bytecode execution is still in progress. * * Results: * None. * * Side effects: * May free allocated memory. Leaves objPtr untyped. * *----------------------------------------------------------------------------- */ static void FreeAssembleCodeInternalRep( Tcl_Obj *objPtr) { ByteCode *codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; if (codePtr->refCount-- <= 1) { TclCleanupByteCode(codePtr); } objPtr->typePtr = NULL; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclAsync.c0000644000175000017500000002346114554262142015210 0ustar sergeisergei/* * tclAsync.c -- * * This file provides low-level support needed to invoke signal handlers * in a safe way. The code here doesn't actually handle signals, though. * This code is based on proposals made by Mark Diekhans and Don Libes. * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* Forward declaration */ struct ThreadSpecificData; /* * One of the following structures exists for each asynchronous handler: */ typedef struct AsyncHandler { int ready; /* Non-zero means this handler should be * invoked in the next call to * Tcl_AsyncInvoke. */ struct AsyncHandler *nextPtr; /* Next in list of all handlers for the * process. */ Tcl_AsyncProc *proc; /* Procedure to call when handler is * invoked. */ ClientData clientData; /* Value to pass to handler when it is * invoked. */ struct ThreadSpecificData *originTsd; /* Used in Tcl_AsyncMark to modify thread- * specific data from outside the thread it is * associated to. */ Tcl_ThreadId originThrdId; /* Origin thread where this token was created * and where it will be yielded. */ } AsyncHandler; typedef struct ThreadSpecificData { /* * The variables below maintain a list of all existing handlers specific * to the calling thread. */ AsyncHandler *firstHandler; /* First handler defined for process, or NULL * if none. */ AsyncHandler *lastHandler; /* Last handler or NULL. */ int asyncReady; /* This is set to 1 whenever a handler becomes * ready and it is cleared to zero whenever * Tcl_AsyncInvoke is called. It can be * checked elsewhere in the application by * calling Tcl_AsyncReady to see if * Tcl_AsyncInvoke should be invoked. */ int asyncActive; /* Indicates whether Tcl_AsyncInvoke is * currently working. If so then we won't set * asyncReady again until Tcl_AsyncInvoke * returns. */ Tcl_Mutex asyncMutex; /* Thread-specific AsyncHandler linked-list * lock */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* *---------------------------------------------------------------------- * * TclFinalizeAsync -- * * Finalizes the mutex in the thread local data structure for the async * subsystem. * * Results: * None. * * Side effects: * Forgets knowledge of the mutex should it have been created. * *---------------------------------------------------------------------- */ void TclFinalizeAsync(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->asyncMutex != NULL) { Tcl_MutexFinalize(&tsdPtr->asyncMutex); } } /* *---------------------------------------------------------------------- * * Tcl_AsyncCreate -- * * This procedure creates the data structures for an asynchronous * handler, so that no memory has to be allocated when the handler is * activated. * * Results: * The return value is a token for the handler, which can be used to * activate it later on. * * Side effects: * Information about the handler is recorded. * *---------------------------------------------------------------------- */ Tcl_AsyncHandler Tcl_AsyncCreate( Tcl_AsyncProc *proc, /* Procedure to call when handler is * invoked. */ ClientData clientData) /* Argument to pass to handler. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); asyncPtr = (AsyncHandler *)ckalloc(sizeof(AsyncHandler)); asyncPtr->ready = 0; asyncPtr->nextPtr = NULL; asyncPtr->proc = proc; asyncPtr->clientData = clientData; asyncPtr->originTsd = tsdPtr; asyncPtr->originThrdId = Tcl_GetCurrentThread(); Tcl_MutexLock(&tsdPtr->asyncMutex); if (tsdPtr->firstHandler == NULL) { tsdPtr->firstHandler = asyncPtr; } else { tsdPtr->lastHandler->nextPtr = asyncPtr; } tsdPtr->lastHandler = asyncPtr; Tcl_MutexUnlock(&tsdPtr->asyncMutex); return (Tcl_AsyncHandler) asyncPtr; } /* *---------------------------------------------------------------------- * * Tcl_AsyncMark -- * * This procedure is called to request that an asynchronous handler be * invoked as soon as possible. It's typically called from an interrupt * handler, where it isn't safe to do anything that depends on or * modifies application state. * * Results: * None. * * Side effects: * The handler gets marked for invocation later. * *---------------------------------------------------------------------- */ void Tcl_AsyncMark( Tcl_AsyncHandler async) /* Token for handler. */ { AsyncHandler *token = (AsyncHandler *) async; Tcl_MutexLock(&token->originTsd->asyncMutex); token->ready = 1; if (!token->originTsd->asyncActive) { token->originTsd->asyncReady = 1; Tcl_ThreadAlert(token->originThrdId); } Tcl_MutexUnlock(&token->originTsd->asyncMutex); } /* *---------------------------------------------------------------------- * * Tcl_AsyncInvoke -- * * This procedure is called at a "safe" time at background level to * invoke any active asynchronous handlers. * * Results: * The return value is a normal Tcl result, which is intended to replace * the code argument as the current completion code for interp. * * Side effects: * Depends on the handlers that are active. * *---------------------------------------------------------------------- */ int Tcl_AsyncInvoke( Tcl_Interp *interp, /* If invoked from Tcl_Eval just after * completing a command, points to * interpreter. Otherwise it is NULL. */ int code) /* If interp is non-NULL, this gives * completion code from command that just * completed. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_MutexLock(&tsdPtr->asyncMutex); if (tsdPtr->asyncReady == 0) { Tcl_MutexUnlock(&tsdPtr->asyncMutex); return code; } tsdPtr->asyncReady = 0; tsdPtr->asyncActive = 1; if (interp == NULL) { code = 0; } /* * Make one or more passes over the list of handlers, invoking at most one * handler in each pass. After invoking a handler, go back to the start of * the list again so that (a) if a new higher-priority handler gets marked * while executing a lower priority handler, we execute the higher- * priority handler next, and (b) if a handler gets deleted during the * execution of a handler, then the list structure may change so it isn't * safe to continue down the list anyway. */ while (1) { for (asyncPtr = tsdPtr->firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->ready) { break; } } if (asyncPtr == NULL) { break; } asyncPtr->ready = 0; Tcl_MutexUnlock(&tsdPtr->asyncMutex); code = asyncPtr->proc(asyncPtr->clientData, interp, code); Tcl_MutexLock(&tsdPtr->asyncMutex); } tsdPtr->asyncActive = 0; Tcl_MutexUnlock(&tsdPtr->asyncMutex); return code; } /* *---------------------------------------------------------------------- * * Tcl_AsyncDelete -- * * Frees up all the state for an asynchronous handler. The handler should * never be used again. * * Results: * None. * * Side effects: * The state associated with the handler is deleted. * * Failure to locate the handler in current thread private list * of async handlers will result in panic; exception: the list * is already empty (potential trouble?). * Consequently, threads should create and delete handlers * themselves. I.e. a handler created by one should not be * deleted by some other thread. * *---------------------------------------------------------------------- */ void Tcl_AsyncDelete( Tcl_AsyncHandler async) /* Token for handler to delete. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); AsyncHandler *asyncPtr = (AsyncHandler *) async; AsyncHandler *prevPtr, *thisPtr; /* * Assure early handling of the constraint */ if (asyncPtr->originThrdId != Tcl_GetCurrentThread()) { Tcl_Panic("Tcl_AsyncDelete: async handler deleted by the wrong thread"); } /* * If we come to this point when TSD's for the current * thread have already been garbage-collected, we are * in the _serious_ trouble. OTOH, we tolerate calling * with already cleaned-up handler list (should we?). */ Tcl_MutexLock(&tsdPtr->asyncMutex); if (tsdPtr->firstHandler != NULL) { prevPtr = thisPtr = tsdPtr->firstHandler; while (thisPtr != NULL && thisPtr != asyncPtr) { prevPtr = thisPtr; thisPtr = thisPtr->nextPtr; } if (thisPtr == NULL) { Tcl_Panic("Tcl_AsyncDelete: cannot find async handler"); } if (asyncPtr == tsdPtr->firstHandler) { tsdPtr->firstHandler = asyncPtr->nextPtr; } else { prevPtr->nextPtr = asyncPtr->nextPtr; } if (asyncPtr == tsdPtr->lastHandler) { tsdPtr->lastHandler = prevPtr; } } Tcl_MutexUnlock(&tsdPtr->asyncMutex); ckfree(asyncPtr); } /* *---------------------------------------------------------------------- * * Tcl_AsyncReady -- * * This procedure can be used to tell whether Tcl_AsyncInvoke needs to be * called. This procedure is the external interface for checking the * thread-specific asyncReady variable. * * Results: * The return value is 1 whenever a handler is ready and is 0 when no * handlers are ready. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_AsyncReady(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); return tsdPtr->asyncReady; } int * TclGetAsyncReadyPtr(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); return &(tsdPtr->asyncReady); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclBasic.c0000644000175000017500000101023214554262142015145 0ustar sergeisergei/* * tclBasic.c -- * * Contains the basic facilities for TCL command interpretation, * including interpreter creation and deletion, command creation and * deletion, and command/script execution. * * Copyright (c) 1987-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * Copyright (c) 2001, 2002 Kevin B. Kenny. All rights reserved. * Copyright (c) 2007 Daniel A. Steffen * Copyright (c) 2006-2008 Joe Mistachkin. All rights reserved. * Copyright (c) 2008 Miguel Sofer * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclOOInt.h" #include "tclCompile.h" #include "tommath.h" #include #include /* * Bug 7371b6270b: to check C call stack depth, prefer an approach which is * compatible with AddressSanitizer (ASan) use-after-return detection. */ #if defined(_MSC_VER) && defined(HAVE_INTRIN_H) #include /* for _AddressOfReturnAddress() */ #endif /* * As suggested by * https://clang.llvm.org/docs/LanguageExtensions.html#has-builtin */ #ifndef __has_builtin #define __has_builtin(x) 0 /* for non-clang compilers */ #endif void * TclGetCStackPtr(void) { #if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address) return __builtin_frame_address(0); #elif defined(_MSC_VER) && defined(HAVE_INTRIN_H) return _AddressOfReturnAddress(); #else size_t unused = 0; /* * LLVM recommends using volatile: * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 */ size_t *volatile stackLevel = &unused; return (void *)stackLevel; #endif } #define INTERP_STACK_INITIAL_SIZE 2000 #define CORO_STACK_INITIAL_SIZE 200 /* * Determine whether we're using IEEE floating point */ #if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024) # define IEEE_FLOATING_POINT /* Largest odd integer that can be represented exactly in a double */ # define MAX_EXACT 9007199254740991.0 #endif /* * The following structure defines the client data for a math function * registered with Tcl_CreateMathFunc */ typedef struct OldMathFuncData { Tcl_MathProc *proc; /* Handler function */ int numArgs; /* Number of args expected */ Tcl_ValueType *argTypes; /* Types of the args */ ClientData clientData; /* Client data for the handler function */ } OldMathFuncData; /* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler * tokens (created by Tcl_AsyncCreate), and the clientData and flags arguments * passed to Tcl_CancelEval on a per-interp basis. The cancelLock mutex is * used for protecting calls to Tcl_CancelEval as well as protecting access to * the hash table below. */ typedef struct { Tcl_Interp *interp; /* Interp this struct belongs to. */ Tcl_AsyncHandler async; /* Async handler token for script * cancellation. */ char *result; /* The script cancellation result or NULL for * a default result. */ int length; /* Length of the above error message. */ ClientData clientData; /* Ignored */ int flags; /* Additional flags */ } CancelInfo; static Tcl_HashTable cancelTable; static int cancelTableInitialized = 0; /* 0 means not yet initialized. */ TCL_DECLARE_MUTEX(cancelLock); /* * Declarations for managing contexts for non-recursive coroutines. Contexts * are used to save the evaluation state between NR calls to each coro. */ #define SAVE_CONTEXT(context) \ (context).framePtr = iPtr->framePtr; \ (context).varFramePtr = iPtr->varFramePtr; \ (context).cmdFramePtr = iPtr->cmdFramePtr; \ (context).lineLABCPtr = iPtr->lineLABCPtr #define RESTORE_CONTEXT(context) \ iPtr->framePtr = (context).framePtr; \ iPtr->varFramePtr = (context).varFramePtr; \ iPtr->cmdFramePtr = (context).cmdFramePtr; \ iPtr->lineLABCPtr = (context).lineLABCPtr /* * Static functions in this file: */ static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, const char *oldName, const char *newName, int flags); static int CancelEvalProc(ClientData clientData, Tcl_Interp *interp, int code); static int CheckDoubleResult(Tcl_Interp *interp, double dResult); static void DeleteCoroutine(ClientData clientData); static Tcl_FreeProc DeleteInterpProc; static void DeleteOpCmdClientData(ClientData clientData); #ifdef USE_DTRACE static Tcl_ObjCmdProc DTraceObjCmd; static Tcl_NRPostProc DTraceCmdReturn; #else # define DTraceCmdReturn NULL #endif /* USE_DTRACE */ static Tcl_ObjCmdProc ExprAbsFunc; static Tcl_ObjCmdProc ExprBinaryFunc; static Tcl_ObjCmdProc ExprBoolFunc; static Tcl_ObjCmdProc ExprCeilFunc; static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprEntierFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; static Tcl_ObjCmdProc ExprRandFunc; static Tcl_ObjCmdProc ExprRoundFunc; static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static Tcl_NRPostProc NRCommand; static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); static inline Command * TEOV_LookupCmdFromObj(Tcl_Interp *interp, Tcl_Obj *namePtr, Namespace *lookupNsPtr); static int TEOV_NotFound(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr); static int TEOV_RunEnterTraces(Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, Tcl_Obj *const objv[]); static Tcl_NRPostProc RewindCoroutineCallback; static Tcl_NRPostProc TEOEx_ByteCodeCallback; static Tcl_NRPostProc TEOEx_ListCallback; static Tcl_NRPostProc TEOV_Error; static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; static Tcl_ObjCmdProc NRCoroInjectObjCmd; static Tcl_NRPostProc NRPostInvoke; static Tcl_ObjCmdProc CoroTypeObjCmd; MODULE_SCOPE const TclStubs tclStubs; /* * Magical counts for the number of arguments accepted by a coroutine command * after particular kinds of [yield]. */ #define CORO_ACTIVATE_YIELD PTR2INT(NULL) #define CORO_ACTIVATE_YIELDM PTR2INT(NULL)+1 #define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) #define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. */ typedef struct { const char *name; /* Name of object-based command. */ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */ CompileProc *compileProc; /* Function called to compile command. */ Tcl_ObjCmdProc *nreProc; /* NR-based function for command */ int flags; /* Various flag bits, as defined below. */ } CmdInfo; #define CMD_IS_SAFE 1 /* Whether this command is part of the set of * commands present by default in a safe * interpreter. */ /* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle * expansion for itself rather than needing the generic layer to take care of * it for it. Defined in tclInt.h. */ /* * The built-in commands, and the functions that implement them: */ static const CmdInfo builtInCmds[] = { /* * Commands in the generic core. */ {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, #ifndef EXCLUDE_OBSOLETE_COMMANDS {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, {"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE}, {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE}, {"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE}, {"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, CMD_IS_SAFE}, {"scan", Tcl_ScanObjCmd, NULL, NULL, CMD_IS_SAFE}, {"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, CMD_IS_SAFE}, {"split", Tcl_SplitObjCmd, NULL, NULL, CMD_IS_SAFE}, {"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, CMD_IS_SAFE}, {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, CMD_IS_SAFE}, {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, CMD_IS_SAFE}, {"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, CMD_IS_SAFE}, {"trace", Tcl_TraceObjCmd, NULL, NULL, CMD_IS_SAFE}, {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, CMD_IS_SAFE}, {"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, CMD_IS_SAFE}, {"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, CMD_IS_SAFE}, {"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, CMD_IS_SAFE}, {"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE}, {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE}, {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE}, {"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE}, /* * Commands in the OS-interface. Note that many of these are unsafe. */ {"after", Tcl_AfterObjCmd, NULL, NULL, CMD_IS_SAFE}, {"cd", Tcl_CdObjCmd, NULL, NULL, 0}, {"close", Tcl_CloseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"eof", Tcl_EofObjCmd, NULL, NULL, CMD_IS_SAFE}, {"exec", Tcl_ExecObjCmd, NULL, NULL, 0}, {"exit", Tcl_ExitObjCmd, NULL, NULL, 0}, {"fblocked", Tcl_FblockedObjCmd, NULL, NULL, CMD_IS_SAFE}, {"fconfigure", Tcl_FconfigureObjCmd, NULL, NULL, 0}, {"fcopy", Tcl_FcopyObjCmd, NULL, NULL, CMD_IS_SAFE}, {"fileevent", Tcl_FileEventObjCmd, NULL, NULL, CMD_IS_SAFE}, {"flush", Tcl_FlushObjCmd, NULL, NULL, CMD_IS_SAFE}, {"gets", Tcl_GetsObjCmd, NULL, NULL, CMD_IS_SAFE}, {"glob", Tcl_GlobObjCmd, NULL, NULL, 0}, {"load", Tcl_LoadObjCmd, NULL, NULL, 0}, {"open", Tcl_OpenObjCmd, NULL, NULL, 0}, {"pid", Tcl_PidObjCmd, NULL, NULL, CMD_IS_SAFE}, {"puts", Tcl_PutsObjCmd, NULL, NULL, CMD_IS_SAFE}, {"pwd", Tcl_PwdObjCmd, NULL, NULL, 0}, {"read", Tcl_ReadObjCmd, NULL, NULL, CMD_IS_SAFE}, {"seek", Tcl_SeekObjCmd, NULL, NULL, CMD_IS_SAFE}, {"socket", Tcl_SocketObjCmd, NULL, NULL, 0}, {"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0}, {"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE}, {"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE}, #ifdef TCL_TIMERATE {"timerate", Tcl_TimeRateObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"unload", Tcl_UnloadObjCmd, NULL, NULL, 0}, {"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE}, {NULL, NULL, NULL, NULL, 0} }; /* * Math functions. All are safe. */ typedef struct { const char *name; /* Name of the function. The full name is * "::tcl::mathfunc::". */ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */ ClientData clientData; /* Client data for the function */ } BuiltinFuncDef; static const BuiltinFuncDef BuiltinFuncTable[] = { { "abs", ExprAbsFunc, NULL }, { "acos", ExprUnaryFunc, (ClientData) acos }, { "asin", ExprUnaryFunc, (ClientData) asin }, { "atan", ExprUnaryFunc, (ClientData) atan }, { "atan2", ExprBinaryFunc, (ClientData) atan2 }, { "bool", ExprBoolFunc, NULL }, { "ceil", ExprCeilFunc, NULL }, { "cos", ExprUnaryFunc, (ClientData) cos }, { "cosh", ExprUnaryFunc, (ClientData) cosh }, { "double", ExprDoubleFunc, NULL }, { "entier", ExprEntierFunc, NULL }, { "exp", ExprUnaryFunc, (ClientData) exp }, { "floor", ExprFloorFunc, NULL }, { "fmod", ExprBinaryFunc, (ClientData) fmod }, { "hypot", ExprBinaryFunc, (ClientData) hypot }, { "int", ExprIntFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, { "log", ExprUnaryFunc, (ClientData) log }, { "log10", ExprUnaryFunc, (ClientData) log10 }, { "pow", ExprBinaryFunc, (ClientData) pow }, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, { "sin", ExprUnaryFunc, (ClientData) sin }, { "sinh", ExprUnaryFunc, (ClientData) sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, { "tan", ExprUnaryFunc, (ClientData) tan }, { "tanh", ExprUnaryFunc, (ClientData) tanh }, { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } }; /* * TIP#174's math operators. All are safe. */ typedef struct { const char *name; /* Name of object-based command. */ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */ CompileProc *compileProc; /* Function called to compile command. */ union { int numArgs; int identity; } i; const char *expected; /* For error message, what argument(s) * were expected. */ } OpCmdInfo; static const OpCmdInfo mathOpCmds[] = { { "~", TclSingleOpCmd, TclCompileInvertOpCmd, /* numArgs */ {1}, "integer"}, { "!", TclSingleOpCmd, TclCompileNotOpCmd, /* numArgs */ {1}, "boolean"}, { "+", TclVariadicOpCmd, TclCompileAddOpCmd, /* identity */ {0}, NULL}, { "*", TclVariadicOpCmd, TclCompileMulOpCmd, /* identity */ {1}, NULL}, { "&", TclVariadicOpCmd, TclCompileAndOpCmd, /* identity */ {-1}, NULL}, { "|", TclVariadicOpCmd, TclCompileOrOpCmd, /* identity */ {0}, NULL}, { "^", TclVariadicOpCmd, TclCompileXorOpCmd, /* identity */ {0}, NULL}, { "**", TclVariadicOpCmd, TclCompilePowOpCmd, /* identity */ {1}, NULL}, { "<<", TclSingleOpCmd, TclCompileLshiftOpCmd, /* numArgs */ {2}, "integer shift"}, { ">>", TclSingleOpCmd, TclCompileRshiftOpCmd, /* numArgs */ {2}, "integer shift"}, { "%", TclSingleOpCmd, TclCompileModOpCmd, /* numArgs */ {2}, "integer integer"}, { "!=", TclSingleOpCmd, TclCompileNeqOpCmd, /* numArgs */ {2}, "value value"}, { "ne", TclSingleOpCmd, TclCompileStrneqOpCmd, /* numArgs */ {2}, "value value"}, { "in", TclSingleOpCmd, TclCompileInOpCmd, /* numArgs */ {2}, "value list"}, { "ni", TclSingleOpCmd, TclCompileNiOpCmd, /* numArgs */ {2}, "value list"}, { "-", TclNoIdentOpCmd, TclCompileMinusOpCmd, /* unused */ {0}, "value ?value ...?"}, { "/", TclNoIdentOpCmd, TclCompileDivOpCmd, /* unused */ {0}, "value ?value ...?"}, { "<", TclSortingOpCmd, TclCompileLessOpCmd, /* unused */ {0}, NULL}, { "<=", TclSortingOpCmd, TclCompileLeqOpCmd, /* unused */ {0}, NULL}, { ">", TclSortingOpCmd, TclCompileGreaterOpCmd, /* unused */ {0}, NULL}, { ">=", TclSortingOpCmd, TclCompileGeqOpCmd, /* unused */ {0}, NULL}, { "==", TclSortingOpCmd, TclCompileEqOpCmd, /* unused */ {0}, NULL}, { "eq", TclSortingOpCmd, TclCompileStreqOpCmd, /* unused */ {0}, NULL}, { NULL, NULL, NULL, {0}, NULL} }; /* *---------------------------------------------------------------------- * * TclFinalizeEvaluation -- * * Finalizes the script cancellation hash table. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFinalizeEvaluation(void) { Tcl_MutexLock(&cancelLock); if (cancelTableInitialized == 1) { Tcl_DeleteHashTable(&cancelTable); cancelTableInitialized = 0; } Tcl_MutexUnlock(&cancelLock); } /* *---------------------------------------------------------------------- * * Tcl_CreateInterp -- * * Create a new TCL command interpreter. * * Results: * The return value is a token for the interpreter, which may be used in * calls to functions like Tcl_CreateCmd, Tcl_Eval, or Tcl_DeleteInterp. * * Side effects: * The command interpreter is initialized with the built-in commands and * with the variables documented in tclvars(n). * *---------------------------------------------------------------------- */ Tcl_Interp * Tcl_CreateInterp(void) { Interp *iPtr; Tcl_Interp *interp; Command *cmdPtr; const BuiltinFuncDef *builtinFuncPtr; const OpCmdInfo *opcmdInfoPtr; const CmdInfo *cmdInfoPtr; Tcl_Namespace *nsPtr; Tcl_HashEntry *hPtr; int isNew; CancelInfo *cancelInfo; union { char c[sizeof(short)]; short s; } order; #ifdef TCL_COMPILE_STATS ByteCodeStats *statsPtr; #endif /* TCL_COMPILE_STATS */ char mathFuncName[32]; CallFrame *framePtr; const char *version = TclInitSubsystems(); /* * Panic if someone updated the CallFrame structure without also updating * the Tcl_CallFrame structure (or vice versa). */ if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) { Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } #if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T * the result is a binary incompatible with the 'standard' build of * Tcl: All extensions using Tcl_StatBuf need to be recompiled in * the same way. Therefore, this is not officially supported. * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet) */ if ((TclOffset(Tcl_StatBuf,st_atime) != 32) || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) { Tcl_Panic(" is not compatible with MSVC"); } #endif if (cancelTableInitialized == 0) { Tcl_MutexLock(&cancelLock); if (cancelTableInitialized == 0) { Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS); cancelTableInitialized = 1; } Tcl_MutexUnlock(&cancelLock); } /* * Initialize support for namespaces and create the global namespace * (whose name is ""; an alias is "::"). This also initializes the Tcl * object type table and other object management code. */ iPtr = (Interp *)ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; iPtr->result = iPtr->resultSpace; iPtr->freeProc = NULL; iPtr->errorLine = 0; TclNewObj(iPtr->objResultPtr); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); iPtr->globalNsPtr = NULL; iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable)); iPtr->extra.optimizer = TclOptimizeBytecode; iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; iPtr->framePtr = NULL; /* Initialise as soon as :: is available */ iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */ /* * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc * structures. */ iPtr->cmdFramePtr = NULL; iPtr->linePBodyPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); iPtr->lineBCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); iPtr->lineLAPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); iPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); iPtr->scriptCLLocPtr = NULL; iPtr->activeVarTracePtr = NULL; iPtr->returnOpts = NULL; iPtr->errorInfo = NULL; TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo"); Tcl_IncrRefCount(iPtr->eiVar); iPtr->errorStack = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(iPtr->errorStack); iPtr->resetErrorStack = 1; TclNewLiteralStringObj(iPtr->upLiteral,"UP"); Tcl_IncrRefCount(iPtr->upLiteral); TclNewLiteralStringObj(iPtr->callLiteral,"CALL"); Tcl_IncrRefCount(iPtr->callLiteral); TclNewLiteralStringObj(iPtr->innerLiteral,"INNER"); Tcl_IncrRefCount(iPtr->innerLiteral); iPtr->innerContext = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(iPtr->innerContext); iPtr->errorCode = NULL; TclNewLiteralStringObj(iPtr->ecVar, "::errorCode"); Tcl_IncrRefCount(iPtr->ecVar); iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; iPtr->appendResult = NULL; iPtr->appendAvl = 0; iPtr->appendUsed = 0; Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; #ifdef _WIN32 # define getenv(x) _wgetenv(L##x) /* On Windows, use _wgetenv below */ #endif /* TIP #268 */ if (getenv("TCL_PKG_PREFER_LATEST") == NULL) { iPtr->packagePrefer = PKG_PREFER_STABLE; } else { iPtr->packagePrefer = PKG_PREFER_LATEST; } iPtr->cmdCount = 0; TclInitLiteralTable(&iPtr->literalTable); iPtr->compileEpoch = 0; iPtr->compiledProcPtr = NULL; iPtr->resolverPtr = NULL; iPtr->evalFlags = 0; iPtr->scriptFile = NULL; iPtr->flags = 0; iPtr->tracePtr = NULL; iPtr->tracesForbiddingInline = 0; iPtr->activeCmdTracePtr = NULL; iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ TclNewObj(iPtr->emptyObjPtr); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ #ifdef TCL_INTERP_DEBUG_FRAME iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { iPtr->flags |= INTERP_DEBUG_FRAME; } #endif /* * Initialise the tables for variable traces and searches *before* * creating the global ns - so that the trace on errorInfo can be * recorded. */ Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS); iPtr->globalNsPtr = NULL; /* Force creation of global ns below. */ iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "", NULL, NULL); if (iPtr->globalNsPtr == NULL) { Tcl_Panic("Tcl_CreateInterp: can't create global namespace"); } /* * Initialise the rootCallframe. It cannot be allocated on the stack, as * it has to be in place before TclCreateExecEnv tries to use a variable. */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ framePtr = (CallFrame *)ckalloc(sizeof(CallFrame)); (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); framePtr->objc = 0; iPtr->framePtr = framePtr; iPtr->varFramePtr = framePtr; iPtr->rootFramePtr = framePtr; /* * Initialize support for code compilation and execution. We call * TclCreateExecEnv after initializing namespaces since it tries to * reference a Tcl variable (it links to the Tcl "tcl_traceExec" * variable). */ iPtr->execEnvPtr = TclCreateExecEnv(interp, INTERP_STACK_INITIAL_SIZE); /* * TIP #219, Tcl Channel Reflection API support. */ iPtr->chanMsg = NULL; /* * TIP #285, Script cancellation support. */ TclNewObj(iPtr->asyncCancelMsg); cancelInfo = (CancelInfo *)ckalloc(sizeof(CancelInfo)); cancelInfo->interp = interp; iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo); cancelInfo->async = iPtr->asyncCancel; cancelInfo->result = NULL; cancelInfo->length = 0; Tcl_MutexLock(&cancelLock); hPtr = Tcl_CreateHashEntry(&cancelTable, iPtr, &isNew); Tcl_SetHashValue(hPtr, cancelInfo); Tcl_MutexUnlock(&cancelLock); /* * Initialize the compilation and execution statistics kept for this * interpreter. */ #ifdef TCL_COMPILE_STATS statsPtr = &iPtr->stats; statsPtr->numExecutions = 0; statsPtr->numCompilations = 0; statsPtr->numByteCodesFreed = 0; memset(statsPtr->instructionCount, 0, sizeof(statsPtr->instructionCount)); statsPtr->totalSrcBytes = 0.0; statsPtr->totalByteCodeBytes = 0.0; statsPtr->currentSrcBytes = 0.0; statsPtr->currentByteCodeBytes = 0.0; memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount)); memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount)); memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount)); statsPtr->currentInstBytes = 0.0; statsPtr->currentLitBytes = 0.0; statsPtr->currentExceptBytes = 0.0; statsPtr->currentAuxBytes = 0.0; statsPtr->currentCmdMapBytes = 0.0; statsPtr->numLiteralsCreated = 0; statsPtr->totalLitStringBytes = 0.0; statsPtr->currentLitStringBytes = 0.0; memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount)); #endif /* TCL_COMPILE_STATS */ /* * Initialise the stub table pointer. */ iPtr->stubTable = &tclStubs; /* * Initialize the ensemble error message rewriting support. */ TclResetRewriteEnsemble(interp, 1); /* * TIP#143: Initialise the resource limit support. */ TclInitLimitSupport(interp); /* * Initialise the thread-specific data ekeko. Note that the thread's alloc * cache was already initialised by the call to alloc the interp struct. */ #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) iPtr->allocCache = (AllocCache *)TclpGetAllocCache(); #else iPtr->allocCache = NULL; #endif iPtr->pendingObjDataPtr = NULL; iPtr->asyncReadyPtr = TclGetAsyncReadyPtr(); iPtr->deferredCallbacks = NULL; /* * Create the core commands. Do it here, rather than calling * Tcl_CreateCommand, because it's faster (there's no need to check for a * preexisting command by the same name). If a command has a Tcl_CmdProc * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to * TclInvokeStringCommand. This is an object-based wrapper function that * extracts strings, calls the string function, and creates an object for * the result. Similarly, if a command has a Tcl_ObjCmdProc but no * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand. */ for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { if ((cmdInfoPtr->objProc == NULL) && (cmdInfoPtr->compileProc == NULL) && (cmdInfoPtr->nreProc == NULL)) { Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc"); } hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { cmdPtr = (Command *)ckalloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = cmdInfoPtr->compileProc; cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; cmdPtr->objProc = cmdInfoPtr->objProc; cmdPtr->objClientData = NULL; cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { cmdPtr->flags |= CMD_COMPILES_EXPANDED; } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; Tcl_SetHashValue(hPtr, cmdPtr); } } /* * Create the "array", "binary", "chan", "clock", "dict", "encoding", * "file", "info", "namespace" and "string" ensembles. Note that all these * commands (and their subcommands that are not present in the global * namespace) are wholly safe *except* for "clock", "encoding" and "file". */ TclInitArrayCmd(interp); TclInitBinaryCmd(interp); TclInitChanCmd(interp); TclInitDictCmd(interp); TclInitEncodingCmd(interp); TclInitFileCmd(interp); TclInitInfoCmd(interp); TclInitNamespaceCmd(interp); TclInitStringCmd(interp); TclInitPrefixCmd(interp); /* * Register "clock" subcommands. These *do* go through * Tcl_CreateObjCommand, since they aren't in the global namespace and * involve ensembles. */ TclClockInit(interp); /* * Register the built-in functions. This is empty now that they are * implemented as commands in the ::tcl::mathfunc namespace. */ /* * Register the default [interp bgerror] handler. */ Tcl_CreateObjCommand(interp, "::tcl::Bgerror", TclDefaultBgErrorHandlerObjCmd, NULL, NULL); /* * Create unsupported commands for debugging bytecode and objects. */ Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble", Tcl_DisassembleObjCmd, INT2PTR(0), NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::getbytecode", Tcl_DisassembleObjCmd, INT2PTR(1), NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation", Tcl_RepresentationCmd, NULL, NULL); /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRCoroInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", CoroTypeObjCmd, NULL, NULL); /* Create an unsupported command for timerate */ Tcl_CreateObjCommand(interp, "::tcl::unsupported::timerate", Tcl_TimeRateObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); if (nsPtr) { Tcl_Export(interp, nsPtr, "*", 1); } #ifdef USE_DTRACE /* * Register the tcl::dtrace command. */ Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL); #endif /* USE_DTRACE */ /* * Register the builtin math functions. */ nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL); if (nsPtr == NULL) { Tcl_Panic("Can't create math function namespace"); } #define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */ memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN); for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); } /* * Register the mathematical "operator" commands. [TIP #174] */ nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL); if (nsPtr == NULL) { Tcl_Panic("can't create math operator namespace"); } Tcl_Export(interp, nsPtr, "*", 1); #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)ckalloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; occdPtr->expected = opcmdInfoPtr->expected; strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name); cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName, opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData); if (cmdPtr == NULL) { Tcl_Panic("failed to create math operator %s", opcmdInfoPtr->name); } else if (opcmdInfoPtr->compileProc != NULL) { cmdPtr->compileProc = opcmdInfoPtr->compileProc; } } /* * Do Multiple/Safe Interps Tcl init stuff */ TclInterpInit(interp); TclSetupEnv(interp); /* * TIP #59: Make embedded configuration information available. */ TclInitEmbeddedConfigurationInformation(interp); /* * TIP #440: Declare the name of the script engine to be "Tcl". */ Tcl_SetVar2(interp, "tcl_platform", "engine", "Tcl", TCL_GLOBAL_ONLY); /* * Compute the byte order of this machine. */ order.s = 1; Tcl_SetVar2(interp, "tcl_platform", "byteOrder", ((order.c[0] == 1) ? "littleEndian" : "bigEndian"), TCL_GLOBAL_ONLY); Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize", Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY); /* TIP #291 */ Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize", Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY); /* * Set up other variables such as tcl_version and tcl_library */ Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); TclpSetVariables(interp); #ifdef TCL_THREADS /* * The existence of the "threaded" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with threads * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can * introspect on the interpreter level of thread safety. */ Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY); #endif /* * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor */ Tcl_PkgProvideEx(interp, "Tcl", version, &tclStubs); if (TclTommath_Init(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } if (TclOOInit(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } /* * Only build in zlib support if we've successfully detected a library to * compile and link against. */ #ifdef HAVE_ZLIB if (TclZlibInit(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } #endif TOP_CB(iPtr) = NULL; return interp; } static void DeleteOpCmdClientData( ClientData clientData) { TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; ckfree(occdPtr); } /* *---------------------------------------------------------------------- * * TclHideUnsafeCommands -- * * Hides base commands that are not marked as safe from this interpreter. * * Results: * TCL_OK if it succeeds, TCL_ERROR else. * * Side effects: * Hides functionality in an interpreter. * *---------------------------------------------------------------------- */ int TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { const CmdInfo *cmdInfoPtr; if (interp == NULL) { return TCL_ERROR; } for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) { Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); } } TclMakeEncodingCommandSafe(interp); /* Ugh! */ TclMakeFileCommandSafe(interp); /* Ugh! */ return TCL_OK; } /* *-------------------------------------------------------------- * * Tcl_CallWhenDeleted -- * * Arrange for a function to be called before a given interpreter is * deleted. The function is called as soon as Tcl_DeleteInterp is called; * if Tcl_CallWhenDeleted is called on an interpreter that has already * been deleted, the function will be called when the last Tcl_Release is * done on the interpreter. * * Results: * None. * * Side effects: * When Tcl_DeleteInterp is invoked to delete interp, proc will be * invoked. See the manual entry for details. * *-------------------------------------------------------------- */ void Tcl_CallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ ClientData clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; int *assocDataCounterPtr = (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; AssocData *dPtr = (AssocData *)ckalloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; snprintf(buffer, sizeof(buffer), "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew); dPtr->proc = proc; dPtr->clientData = clientData; Tcl_SetHashValue(hPtr, dPtr); } /* *-------------------------------------------------------------- * * Tcl_DontCallWhenDeleted -- * * Cancel the arrangement for a function to be called when a given * interpreter is deleted. * * Results: * None. * * Side effects: * If proc and clientData were previously registered as a callback via * Tcl_CallWhenDeleted, they are unregistered. If they weren't previously * registered then nothing happens. * *-------------------------------------------------------------- */ void Tcl_DontCallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ ClientData clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTablePtr; Tcl_HashSearch hSearch; Tcl_HashEntry *hPtr; AssocData *dPtr; hTablePtr = iPtr->assocData; if (hTablePtr == NULL) { return; } for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { ckfree(dPtr); Tcl_DeleteHashEntry(hPtr); return; } } } /* *---------------------------------------------------------------------- * * Tcl_SetAssocData -- * * Creates a named association between user-specified data, a delete * function and this interpreter. If the association already exists the * data is overwritten with the new data. The delete function will be * invoked when the interpreter is deleted. * * Results: * None. * * Side effects: * Sets the associated data, creates the association if needed. * *---------------------------------------------------------------------- */ void Tcl_SetAssocData( Tcl_Interp *interp, /* Interpreter to associate with. */ const char *name, /* Name for association. */ Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to * be deleted. */ ClientData clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; Tcl_HashEntry *hPtr; int isNew; if (iPtr->assocData == NULL) { iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew); if (isNew == 0) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); } else { dPtr = (AssocData *)ckalloc(sizeof(AssocData)); } dPtr->proc = proc; dPtr->clientData = clientData; Tcl_SetHashValue(hPtr, dPtr); } /* *---------------------------------------------------------------------- * * Tcl_DeleteAssocData -- * * Deletes a named association of user-specified data with the specified * interpreter. * * Results: * None. * * Side effects: * Deletes the association. * *---------------------------------------------------------------------- */ void Tcl_DeleteAssocData( Tcl_Interp *interp, /* Interpreter to associate with. */ const char *name) /* Name of association. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; Tcl_HashEntry *hPtr; if (iPtr->assocData == NULL) { return; } hPtr = Tcl_FindHashEntry(iPtr->assocData, name); if (hPtr == NULL) { return; } dPtr = (AssocData *)Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } ckfree(dPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetAssocData -- * * Returns the client data associated with this name in the specified * interpreter. * * Results: * The client data in the AssocData record denoted by the named * association, or NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_GetAssocData( Tcl_Interp *interp, /* Interpreter associated with. */ const char *name, /* Name of association. */ Tcl_InterpDeleteProc **procPtr) /* Pointer to place to store address of * current deletion callback. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; Tcl_HashEntry *hPtr; if (iPtr->assocData == NULL) { return NULL; } hPtr = Tcl_FindHashEntry(iPtr->assocData, name); if (hPtr == NULL) { return NULL; } dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if (procPtr != NULL) { *procPtr = dPtr->proc; } return dPtr->clientData; } /* *---------------------------------------------------------------------- * * Tcl_InterpDeleted -- * * Returns nonzero if the interpreter has been deleted with a call to * Tcl_DeleteInterp. * * Results: * Nonzero if the interpreter is deleted, zero otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_InterpDeleted( Tcl_Interp *interp) { return (((Interp *) interp)->flags & DELETED) ? 1 : 0; } /* *---------------------------------------------------------------------- * * Tcl_DeleteInterp -- * * Ensures that the interpreter will be deleted eventually. If there are * no Tcl_Preserve calls in effect for this interpreter, it is deleted * immediately, otherwise the interpreter is deleted when the last * Tcl_Preserve is matched by a call to Tcl_Release. In either case, the * function runs the currently registered deletion callbacks. * * Results: * None. * * Side effects: * The interpreter is marked as deleted. The caller may still use it * safely if there are calls to Tcl_Preserve in effect for the * interpreter, but further calls to Tcl_Eval etc in this interpreter * will fail. * *---------------------------------------------------------------------- */ void Tcl_DeleteInterp( Tcl_Interp *interp) /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ { Interp *iPtr = (Interp *) interp; /* * If the interpreter has already been marked deleted, just punt. */ if (iPtr->flags & DELETED) { return; } /* * Mark the interpreter as deleted. No further evals will be allowed. * Increase the compileEpoch as a signal to compiled bytecodes. */ iPtr->flags |= DELETED; iPtr->compileEpoch++; /* * Ensure that the interpreter is eventually deleted. */ Tcl_EventuallyFree(interp, DeleteInterpProc); } /* *---------------------------------------------------------------------- * * DeleteInterpProc -- * * Helper function to delete an interpreter. This function is called when * the last call to Tcl_Preserve on this interpreter is matched by a call * to Tcl_Release. The function cleans up all resources used in the * interpreter and calls all currently registered interpreter deletion * callbacks. * * Results: * None. * * Side effects: * Whatever the interpreter deletion callbacks do. Frees resources used * by the interpreter. * *---------------------------------------------------------------------- */ static void DeleteInterpProc( char *blockPtr) /* Interpreter to delete. */ { Tcl_Interp *interp = (Tcl_Interp *) blockPtr; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable *hTablePtr; ResolverScheme *resPtr, *nextResPtr; int i; /* * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup, * unless we are exiting. */ if ((iPtr->numLevels > 0) && !TclInExit()) { Tcl_Panic("DeleteInterpProc called with active evals"); } /* * The interpreter should already be marked deleted; otherwise how did we * get here? */ if (!(iPtr->flags & DELETED)) { Tcl_Panic("DeleteInterpProc called on interpreter not marked deleted"); } /* * TIP #219, Tcl Channel Reflection API. Discard a leftover state. */ if (iPtr->chanMsg != NULL) { Tcl_DecrRefCount(iPtr->chanMsg); iPtr->chanMsg = NULL; } /* * TIP #285, Script cancellation support. Delete this interp from the * global hash table of CancelInfo structs. */ Tcl_MutexLock(&cancelLock); hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr); if (hPtr != NULL) { CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { ckfree(cancelInfo->result); } ckfree(cancelInfo); } Tcl_DeleteHashEntry(hPtr); } if (iPtr->asyncCancel != NULL) { Tcl_AsyncDelete(iPtr->asyncCancel); iPtr->asyncCancel = NULL; } if (iPtr->asyncCancelMsg != NULL) { Tcl_DecrRefCount(iPtr->asyncCancelMsg); iPtr->asyncCancelMsg = NULL; } Tcl_MutexUnlock(&cancelLock); /* * Shut down all limit handler callback scripts that call back into this * interpreter. Then eliminate all limit handlers for this interpreter. */ TclRemoveScriptLimitCallbacks(interp); TclLimitRemoveAllHandlers(interp); /* * Dismantle the namespace here, before we clear the assocData. If any * background errors occur here, they will be deleted below. * * Dismantle the namespace after freeing the iPtr->handle so that each * bytecode releases its literals without caring to update the literal * table, as it will be freed later in this function without further use. */ TclHandleFree(iPtr->handle); TclTeardownNamespace(iPtr->globalNsPtr); /* * Delete all the hidden commands. */ hTablePtr = iPtr->hiddenCmdTablePtr; if (hTablePtr != NULL) { /* * Non-pernicious deletion. The deletion callbacks will not be allowed * to create any new hidden or non-hidden commands. * Tcl_DeleteCommandFromToken will remove the entry from the * hiddenCmdTablePtr. */ hPtr = Tcl_FirstHashEntry(hTablePtr, &search); for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); ckfree(hTablePtr); } /* * Invoke deletion callbacks; note that a callback can create new * callbacks, so we iterate. */ while (iPtr->assocData != NULL) { AssocData *dPtr; hTablePtr = iPtr->assocData; iPtr->assocData = NULL; for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } ckfree(dPtr); } Tcl_DeleteHashTable(hTablePtr); ckfree(hTablePtr); } /* * Pop the root frame pointer and finish deleting the global * namespace. The order is important [Bug 1658572]. */ if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) { Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top"); } Tcl_PopCallFrame(interp); ckfree(iPtr->rootFramePtr); iPtr->rootFramePtr = NULL; Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr); /* * Free up the result *after* deleting variables, since variable deletion * could have transferred ownership of the result string to Tcl. */ Tcl_FreeResult(interp); iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); if (iPtr->errorCode) { Tcl_DecrRefCount(iPtr->errorCode); iPtr->errorCode = NULL; } Tcl_DecrRefCount(iPtr->eiVar); if (iPtr->errorInfo) { Tcl_DecrRefCount(iPtr->errorInfo); iPtr->errorInfo = NULL; } Tcl_DecrRefCount(iPtr->errorStack); iPtr->errorStack = NULL; Tcl_DecrRefCount(iPtr->upLiteral); Tcl_DecrRefCount(iPtr->callLiteral); Tcl_DecrRefCount(iPtr->innerLiteral); Tcl_DecrRefCount(iPtr->innerContext); if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); iPtr->appendResult = NULL; } TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); } if (iPtr->execEnvPtr != NULL) { TclDeleteExecEnv(iPtr->execEnvPtr); } if (iPtr->scriptFile) { Tcl_DecrRefCount(iPtr->scriptFile); iPtr->scriptFile = NULL; } Tcl_DecrRefCount(iPtr->emptyObjPtr); iPtr->emptyObjPtr = NULL; resPtr = iPtr->resolverPtr; while (resPtr) { nextResPtr = resPtr->nextPtr; ckfree(resPtr->name); ckfree(resPtr); resPtr = nextResPtr; } /* * Free up literal objects created for scripts compiled by the * interpreter. */ TclDeleteLiteralTable(interp, &iPtr->literalTable); /* * TIP #280 - Release the arrays for ByteCode/Proc extension, and * contents. */ for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr); Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); procPtr->iPtr = NULL; if (cfPtr) { if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); } ckfree(cfPtr->line); ckfree(cfPtr); } Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->linePBodyPtr); ckfree(iPtr->linePBodyPtr); iPtr->linePBodyPtr = NULL; /* * See also tclCompile.c, TclCleanupByteCode */ for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr); if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); } for (i=0; i< eclPtr->nuloc; i++) { ckfree(eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { ckfree(eclPtr->loc); } ckfree(eclPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->lineBCPtr); ckfree(iPtr->lineBCPtr); iPtr->lineBCPtr = NULL; /* * Location stack for uplevel/eval/... scripts which were passed through * proc arguments. Actually we track all arguments as we do not and cannot * know which arguments will be used as scripts and which will not. */ if (iPtr->lineLAPtr->numEntries && !TclInExit()) { /* * When the interp goes away we have nothing on the stack, so there * are no arguments, so this table has to be empty. */ Tcl_Panic("Argument location tracking table not empty"); } Tcl_DeleteHashTable(iPtr->lineLAPtr); ckfree((char *) iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { /* * When the interp goes away we have nothing on the stack, so there * are no arguments, so this table has to be empty. */ Tcl_Panic("Argument location tracking table not empty"); } Tcl_DeleteHashTable(iPtr->lineLABCPtr); ckfree(iPtr->lineLABCPtr); iPtr->lineLABCPtr = NULL; /* * Squelch the tables of traces on variables and searches over arrays in * the in the interpreter. */ Tcl_DeleteHashTable(&iPtr->varTraces); Tcl_DeleteHashTable(&iPtr->varSearches); ckfree(iPtr); } /* *--------------------------------------------------------------------------- * * Tcl_HideCommand -- * * Makes a command hidden so that it cannot be invoked from within an * interpreter, only from within an ancestor. * * Results: * A standard Tcl result; also leaves a message in the interp's result if * an error occurs. * * Side effects: * Removes a command from the command table and create an entry into the * hidden command table under the specified token name. * *--------------------------------------------------------------------------- */ int Tcl_HideCommand( Tcl_Interp *interp, /* Interpreter in which to hide command. */ const char *cmdName, /* Name of command to hide. */ const char *hiddenCmdToken) /* Token name of the to-be-hidden command. */ { Interp *iPtr = (Interp *) interp; Tcl_Command cmd; Command *cmdPtr; Tcl_HashTable *hiddenCmdTablePtr; Tcl_HashEntry *hPtr; int isNew; if (iPtr->flags & DELETED) { /* * The interpreter is being deleted. Do not create any new structures, * because it is not safe to modify the interpreter. */ return TCL_ERROR; } /* * Disallow hiding of commands that are currently in a namespace or * renaming (as part of hiding) into a namespace (because the current * implementation with a single global table and the needed uniqueness of * names cause problems with namespaces). * * We don't need to check for "::" in cmdName because the real check is on * the nsPtr below. * * hiddenCmdToken is just a string which is not interpreted in any way. It * may contain :: but the string is not interpreted as a namespace * qualifier command name. Thus, hiding foo::bar to foo::bar and then * trying to expose or invoke ::foo::bar will NOT work; but if the * application always uses the same strings it will get consistent * behaviour. * * But as we currently limit ourselves to the global namespace only for * the source, in order to avoid potential confusion, lets prevent "::" in * the token too. - dl */ if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" " token (rename)", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL); return TCL_ERROR; } /* * Find the command to hide. An error is returned if cmdName can't be * found. Look up the command only from the global namespace. Full path of * the command must be given if using namespaces. */ cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY); if (cmd == (Tcl_Command) NULL) { return TCL_ERROR; } cmdPtr = (Command *) cmd; /* * Check that the command is really in global namespace */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only hide global namespace commands (use rename then hide)", -1)); Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL); return TCL_ERROR; } /* * Initialize the hidden command table if necessary. */ hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr == NULL) { hiddenCmdTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; } /* * It is an error to move an exposed command to a hidden command with * hiddenCmdToken if a hidden command with the name hiddenCmdToken already * exists. */ hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "hidden command named \"%s\" already exists", hiddenCmdToken)); Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL); return TCL_ERROR; } /* * NB: This code is currently 'like' a rename to a special separate name * table. Changes here and in TclRenameCommand must be kept in synch until * the common parts are actually factorized out. */ /* * Remove the hash entry for the command from the interpreter command * table. This is like deleting the command, so bump its command epoch * to invalidate any cached references that point to the command. */ if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; cmdPtr->cmdEpoch++; } /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we need * the info will be soon enough. */ TclInvalidateNsCmdLookup(cmdPtr->nsPtr); /* * Now link the hash table entry with the command structure. We ensured * above that the nsPtr was right. */ cmdPtr->hPtr = hPtr; Tcl_SetHashValue(hPtr, cmdPtr); /* * If the command being hidden has a compile function, increment the * interpreter's compileEpoch to invalidate its compiled code. This makes * sure that we don't later try to execute old code compiled with * command-specific (i.e., inline) bytecodes for the now-hidden command. * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose * compilation epoch doesn't match is recompiled. */ if (cmdPtr->compileProc != NULL) { iPtr->compileEpoch++; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ExposeCommand -- * * Makes a previously hidden command callable from inside the interpreter * instead of only by its ancestors. * * Results: * A standard Tcl result. If an error occurs, a message is left in the * interp's result. * * Side effects: * Moves commands from one hash table to another. * *---------------------------------------------------------------------- */ int Tcl_ExposeCommand( Tcl_Interp *interp, /* Interpreter in which to make command * callable. */ const char *hiddenCmdToken, /* Name of hidden command. */ const char *cmdName) /* Name of to-be-exposed command. */ { Interp *iPtr = (Interp *) interp; Command *cmdPtr; Namespace *nsPtr; Tcl_HashEntry *hPtr; Tcl_HashTable *hiddenCmdTablePtr; int isNew; if (iPtr->flags & DELETED) { /* * The interpreter is being deleted. Do not create any new structures, * because it is not safe to modify the interpreter. */ return TCL_ERROR; } /* * Check that we have a regular name for the command (that the user is not * trying to do an expose and a rename (to another namespace) at the same * time). */ if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot expose to a namespace (use expose to toplevel, then rename)", -1)); Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL); return TCL_ERROR; } /* * Get the command from the hidden command table: */ hPtr = NULL; hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr != NULL) { hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken); } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown hidden command \"%s\"", hiddenCmdToken)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", hiddenCmdToken, NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Check that we have a true global namespace command (enforced by * Tcl_HideCommand but let's double check. (If it was not, we would not * really know how to handle it). */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { /* * This case is theoretically impossible, we might rather Tcl_Panic * than 'nicely' erroring out ? */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "trying to expose a non-global command namespace command", -1)); return TCL_ERROR; } /* * This is the global table. */ nsPtr = cmdPtr->nsPtr; /* * It is an error to overwrite an existing exposed command as a result of * exposing a previously hidden command. */ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "exposed command \"%s\" already exists", cmdName)); Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", NULL); return TCL_ERROR; } /* * Command resolvers (per-interp, per-namespace) might have resolved to a * command for the given namespace scope with this command not being * registered with the namespace's command table. During BC compilation, * the so-resolved command turns into a CmdName literal. Without * invalidating a possible CmdName literal here explicitly, such literals * keep being reused while pointing to overhauled commands. */ TclInvalidateCmdLiteral(interp, cmdName, nsPtr); /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we need * the info will be soon enough. */ TclInvalidateNsCmdLookup(nsPtr); /* * Remove the hash entry for the command from the interpreter hidden * command table. */ if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; } /* * Now link the hash table entry with the command structure. This is like * creating a new command, so deal with any shadowing of commands in the * global namespace. */ cmdPtr->hPtr = hPtr; Tcl_SetHashValue(hPtr, cmdPtr); /* * Not needed as we are only in the global namespace (but would be needed * again if we supported namespace command hiding) * * TclResetShadowedCmdRefs(interp, cmdPtr); */ /* * If the command being exposed has a compile function, increment * interpreter's compileEpoch to invalidate its compiled code. This makes * sure that we don't later try to execute old code compiled assuming the * command is hidden. This field is checked in Tcl_EvalObj and * ObjInterpProc, and code whose compilation epoch doesn't match is * recompiled. */ if (cmdPtr->compileProc != NULL) { iPtr->compileEpoch++; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_CreateCommand -- * * Define a new command in a command table. * * Results: * The return value is a token for the command, which can be used in * future calls to Tcl_GetCommandName. * * Side effects: * If a command named cmdName already exists for interp, it is deleted. * In the future, when cmdName is seen as the name of a command by * Tcl_Eval, proc will be called. To support the bytecode interpreter, * the command is created with a wrapper Tcl_ObjCmdProc * (TclInvokeStringCommand) that eventually calls proc. When the command * is deleted from the table, deleteProc will be called. See the manual * entry for details on the calling sequence. * *---------------------------------------------------------------------- */ Tcl_Command Tcl_CreateCommand( Tcl_Interp *interp, /* Token for command interpreter returned by a * previous call to Tcl_CreateInterp. */ const char *cmdName, /* Name of command. If it contains namespace * qualifiers, the new command is put in the * specified namespace; otherwise it is put in * the global namespace. */ Tcl_CmdProc *proc, /* Function to associate with cmdName. */ ClientData clientData, /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { Interp *iPtr = (Interp *) interp; ImportRef *oldRefPtr = NULL; Namespace *nsPtr; Command *cmdPtr; Tcl_HashEntry *hPtr; const char *tail; int isNew = 0, deleted = 0; ImportedCmdData *dataPtr; if (iPtr->flags & DELETED) { /* * The interpreter is being deleted. Don't create any new commands; * it's not safe to muck with the interpreter anymore. */ return (Tcl_Command) NULL; } /* * If the command name we seek to create already exists, we need to * delete that first. That can be tricky in the presence of traces. * Loop until we no longer find an existing command in the way, or * until we've deleted one command and that didn't finish the job. */ while (1) { /* * Determine where the command should reside. If its name contains * namespace qualifiers, we put it in the specified namespace; * otherwise, we always put it in the global namespace. */ if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { return (Tcl_Command) NULL; } } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; } hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); if (isNew || deleted) { /* * isNew - No conflict with existing command. * deleted - We've already deleted a conflicting command */ break; } /* * An existing command conflicts. Try to delete it... */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Be careful to preserve any existing import links so we can restore * them down below. That way, you can redefine a command and its * import status will remain intact. */ cmdPtr->refCount++; if (cmdPtr->importRefPtr) { cmdPtr->flags |= CMD_REDEF_IN_PROGRESS; } Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { oldRefPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = NULL; } TclCleanupCommandMacro(cmdPtr); deleted = 1; } if (!isNew) { /* * If the deletion callback recreated the command, just throw away the * new command (if we try to delete it again, we could get stuck in an * infinite loop). */ ckfree(Tcl_GetHashValue(hPtr)); } if (!deleted) { /* * Command resolvers (per-interp, per-namespace) might have resolved * to a command for the given namespace scope with this command not * being registered with the namespace's command table. During BC * compilation, the so-resolved command turns into a CmdName literal. * Without invalidating a possible CmdName literal here explicitly, * such literals keep being reused while pointing to overhauled * commands. */ TclInvalidateCmdLiteral(interp, tail, nsPtr); /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we * need the info will be soon enough. */ TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } cmdPtr = (Command *)ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = NULL; cmdPtr->objProc = TclInvokeStringCommand; cmdPtr->objClientData = cmdPtr; cmdPtr->proc = proc; cmdPtr->clientData = clientData; cmdPtr->deleteProc = deleteProc; cmdPtr->deleteData = clientData; cmdPtr->flags = 0; cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = NULL; /* * Plug in any existing import references found above. Be sure to update * all of these references to point to the new command. */ if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; dataPtr = (ImportedCmdData *)refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } } /* * We just created a command, so in its namespace and all of its parent * namespaces, it may shadow global commands with the same name. If any * shadowed commands are found, invalidate all cached command references * in the affected namespaces. */ TclResetShadowedCmdRefs(interp, cmdPtr); return (Tcl_Command) cmdPtr; } /* *---------------------------------------------------------------------- * * Tcl_CreateObjCommand -- * * Define a new object-based command in a command table. * * Results: * The return value is a token for the command, which can be used in * future calls to Tcl_GetCommandName. * * Side effects: * If a command named "cmdName" already exists for interp, it is * first deleted. Then the new command is created from the arguments. * [***] (See below for exception). * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based * Tcl_ObjCmdProc proc will be called. When the command is deleted from * the table, deleteProc will be called. See the manual entry for details * on the calling sequence. * *---------------------------------------------------------------------- */ Tcl_Command Tcl_CreateObjCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ const char *cmdName, /* Name of command. If it contains namespace * qualifiers, the new command is put in the * specified namespace; otherwise it is put in * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ ClientData clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc /* If not NULL, gives a function to call when * this command is deleted. */ ) { Interp *iPtr = (Interp *) interp; Namespace *nsPtr; const char *tail; if (iPtr->flags & DELETED) { /* * The interpreter is being deleted. Don't create any new commands; * it's not safe to muck with the interpreter anymore. */ return (Tcl_Command) NULL; } /* * Determine where the command should reside. If its name contains * namespace qualifiers, we put it in the specified namespace; * otherwise, we always put it in the global namespace. */ if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { return (Tcl_Command) NULL; } } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; } return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr, proc, clientData, deleteProc); } Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace * components. */ Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ ClientData clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { int deleted = 0, isNew = 0; Command *cmdPtr; ImportRef *oldRefPtr = NULL; ImportedCmdData *dataPtr; Tcl_HashEntry *hPtr; Namespace *nsPtr = (Namespace *) namesp; /* * If the command name we seek to create already exists, we need to delete * that first. That can be tricky in the presence of traces. Loop until we * no longer find an existing command in the way, or until we've deleted * one command and that didn't finish the job. */ while (1) { hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (isNew || deleted) { /* * isNew - No conflict with existing command. * deleted - We've already deleted a conflicting command */ break; } /* * An existing command conflicts. Try to delete it... */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * [***] This is wrong. See Tcl Bug a16752c252. * However, this buggy behavior is kept under particular circumstances * to accommodate deployed binaries of the "tclcompiler" program * that crash if the bug is * fixed. */ if (cmdPtr->objProc == TclInvokeStringCommand && cmdPtr->clientData == clientData && cmdPtr->deleteData == clientData && cmdPtr->deleteProc == deleteProc) { cmdPtr->objProc = proc; cmdPtr->objClientData = clientData; return (Tcl_Command) cmdPtr; } /* * Otherwise, we delete the old command. Be careful to preserve any * existing import links so we can restore them down below. That way, * you can redefine a command and its import status will remain * intact. */ cmdPtr->refCount++; if (cmdPtr->importRefPtr) { cmdPtr->flags |= CMD_REDEF_IN_PROGRESS; } /* * Make sure namespace doesn't get deallocated. */ cmdPtr->nsPtr->refCount++; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); nsPtr = (Namespace *) TclEnsureNamespace(interp, (Tcl_Namespace *) cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { oldRefPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = NULL; } TclCleanupCommandMacro(cmdPtr); deleted = 1; } if (!isNew) { /* * If the deletion callback recreated the command, just throw away the * new command (if we try to delete it again, we could get stuck in an * infinite loop). */ ckfree(Tcl_GetHashValue(hPtr)); } if (!deleted) { /* * Command resolvers (per-interp, per-namespace) might have resolved * to a command for the given namespace scope with this command not * being registered with the namespace's command table. During BC * compilation, the so-resolved command turns into a CmdName literal. * Without invalidating a possible CmdName literal here explicitly, * such literals keep being reused while pointing to overhauled * commands. */ TclInvalidateCmdLiteral(interp, cmdName, nsPtr); /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we * need the info will be soon enough. */ TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } cmdPtr = (Command *)ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = NULL; cmdPtr->objProc = proc; cmdPtr->objClientData = clientData; cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; cmdPtr->deleteProc = deleteProc; cmdPtr->deleteData = clientData; cmdPtr->flags = 0; cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = NULL; /* * Plug in any existing import references found above. Be sure to update * all of these references to point to the new command. */ if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } } /* * We just created a command, so in its namespace and all of its parent * namespaces, it may shadow global commands with the same name. If any * shadowed commands are found, invalidate all cached command references * in the affected namespaces. */ TclResetShadowedCmdRefs(interp, cmdPtr); return (Tcl_Command) cmdPtr; } /* *---------------------------------------------------------------------- * * TclInvokeStringCommand -- * * "Wrapper" Tcl_ObjCmdProc used to call an existing string-based * Tcl_CmdProc if no object-based function exists for a command. A * pointer to this function is stored as the Tcl_ObjCmdProc in a Command * structure. It simply turns around and calls the string Tcl_CmdProc in * the Command structure. * * Results: * A standard Tcl object result value. * * Side effects: * Besides those side effects of the called Tcl_CmdProc, * TclInvokeStringCommand allocates and frees storage. * *---------------------------------------------------------------------- */ int TclInvokeStringCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr = (Command *)clientData; int i, result; const char **argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(char *)); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); } argv[objc] = 0; /* * Invoke the command's string-based Tcl_CmdProc. */ result = cmdPtr->proc(cmdPtr->clientData, interp, objc, argv); TclStackFree(interp, (void *) argv); return result; } /* *---------------------------------------------------------------------- * * TclInvokeObjectCommand -- * * "Wrapper" Tcl_CmdProc used to call an existing object-based * Tcl_ObjCmdProc if no string-based function exists for a command. A * pointer to this function is stored as the Tcl_CmdProc in a Command * structure. It simply turns around and calls the object Tcl_ObjCmdProc * in the Command structure. * * Results: * A standard Tcl result value. * * Side effects: * Besides those side effects of the called Tcl_ObjCmdProc, * TclInvokeObjectCommand allocates and frees storage. * *---------------------------------------------------------------------- */ int TclInvokeObjectCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Command *cmdPtr = ( Command *) clientData; Tcl_Obj *objPtr; int i, length, result; Tcl_Obj **objv = (Tcl_Obj **) TclStackAlloc(interp, (argc * sizeof(Tcl_Obj *))); for (i = 0; i < argc; i++) { length = strlen(argv[i]); TclNewStringObj(objPtr, argv[i], length); Tcl_IncrRefCount(objPtr); objv[i] = objPtr; } /* * Invoke the command's object-based Tcl_ObjCmdProc. */ if (cmdPtr->objProc != NULL) { result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv); } else { result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, cmdPtr->objClientData, argc, objv); } /* * Move the interpreter's object result to the string result, then reset * the object result. */ (void) Tcl_GetStringResult(interp); /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. */ for (i = 0; i < argc; i++) { objPtr = objv[i]; Tcl_DecrRefCount(objPtr); } TclStackFree(interp, objv); return result; } /* *---------------------------------------------------------------------- * * TclRenameCommand -- * * Called to give an existing Tcl command a different name. Both the old * command name and the new command name can have "::" namespace * qualifiers. If the new command has a different namespace context, the * command will be moved to that namespace and will execute in the * context of that new namespace. * * If the new command name is NULL or the null string, the command is * deleted. * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * If anything goes wrong, an error message is returned in the * interpreter's result object. * *---------------------------------------------------------------------- */ int TclRenameCommand( Tcl_Interp *interp, /* Current interpreter. */ const char *oldName, /* Existing command name. */ const char *newName) /* New command name. */ { Interp *iPtr = (Interp *) interp; const char *newTail; Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2; Tcl_Command cmd; Command *cmdPtr; Tcl_HashEntry *hPtr, *oldHPtr; int isNew, result; Tcl_Obj *oldFullName; Tcl_DString newFullName; /* * Find the existing command. An error is returned if cmdName can't be * found. */ cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0); cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't %s \"%s\": command doesn't exist", ((newName == NULL)||(*newName == '\0'))? "delete":"rename", oldName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL); return TCL_ERROR; } /* * If the new command name is NULL or empty, delete the command. Do this * with Tcl_DeleteCommandFromToken, since we already have the command. */ if ((newName == NULL) || (*newName == '\0')) { Tcl_DeleteCommandFromToken(interp, cmd); return TCL_OK; } cmdNsPtr = cmdPtr->nsPtr; TclNewObj(oldFullName); Tcl_IncrRefCount(oldFullName); Tcl_GetCommandFullName(interp, cmd, oldFullName); /* * Make sure that the destination command does not already exist. The * rename operation is like creating a command, so we should automatically * create the containing namespaces just like Tcl_CreateCommand would. */ TclGetNamespaceForQualName(interp, newName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail); if ((newNsPtr == NULL) || (newTail == NULL)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't rename to \"%s\": bad command name", newName)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't rename to \"%s\": command already exists", newName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", "TARGET_EXISTS", NULL); result = TCL_ERROR; goto done; } /* * Warning: any changes done in the code here are likely to be needed in * Tcl_HideCommand code too (until the common parts are extracted out). * - dl */ /* * Put the command in the new namespace so we can check for an alias loop. * Since we are adding a new command to a namespace, we must handle any * shadowing of the global commands that this might create. */ oldHPtr = cmdPtr->hPtr; hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &isNew); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = newNsPtr; TclResetShadowedCmdRefs(interp, cmdPtr); /* * Now check for an alias loop. If we detect one, put everything back the * way it was and report the error. */ result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr); if (result != TCL_OK) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = oldHPtr; cmdPtr->nsPtr = cmdNsPtr; goto done; } /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we need * the info will be soon enough. These might refer to the same variable, * but that's no big deal. */ TclInvalidateNsCmdLookup(cmdNsPtr); TclInvalidateNsCmdLookup(cmdPtr->nsPtr); /* * Command resolvers (per-interp, per-namespace) might have resolved to a * command for the given namespace scope with this command not being * registered with the namespace's command table. During BC compilation, * the so-resolved command turns into a CmdName literal. Without * invalidating a possible CmdName literal here explicitly, such literals * keep being reused while pointing to overhauled commands. */ TclInvalidateCmdLiteral(interp, newTail, cmdPtr->nsPtr); /* * Script for rename traces can delete the command "oldName". Therefore * increment the reference count for cmdPtr so that it's Command structure * is freed only towards the end of this function by calling * TclCleanupCommand. * * The trace function needs to get a fully qualified name for old and new * commands [Tcl bug #651271], or else there's no way for the trace * function to get the namespace from which the old command is being * renamed! */ Tcl_DStringInit(&newFullName); Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1); if (newNsPtr != iPtr->globalNsPtr) { TclDStringAppendLiteral(&newFullName, "::"); } Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName), Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME); Tcl_DStringFree(&newFullName); /* * The new command name is okay, so remove the command from its current * namespace. This is like deleting the command, so bump the cmdEpoch to * invalidate any cached references to the command. */ Tcl_DeleteHashEntry(oldHPtr); cmdPtr->cmdEpoch++; /* * If the command being renamed has a compile function, increment the * interpreter's compileEpoch to invalidate its compiled code. This makes * sure that we don't later try to execute old code compiled for the * now-renamed command. */ if (cmdPtr->compileProc != NULL) { iPtr->compileEpoch++; } /* * Now free the Command structure, if the "oldName" command has been * deleted by invocation of rename traces. */ TclCleanupCommandMacro(cmdPtr); result = TCL_OK; done: TclDecrRefCount(oldFullName); return result; } /* *---------------------------------------------------------------------- * * Tcl_SetCommandInfo -- * * Modifies various information about a Tcl command. Note that this * function will not change a command's namespace; use TclRenameCommand * to do that. Also, the isNativeObjectProc member of *infoPtr is * ignored. * * Results: * If cmdName exists in interp, then the information at *infoPtr is * stored with the command in place of the current information and 1 is * returned. If the command doesn't exist then 0 is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_SetCommandInfo( Tcl_Interp *interp, /* Interpreter in which to look for * command. */ const char *cmdName, /* Name of desired command. */ const Tcl_CmdInfo *infoPtr) /* Where to find information to store in the * command. */ { Tcl_Command cmd; cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0); return Tcl_SetCommandInfoFromToken(cmd, infoPtr); } /* *---------------------------------------------------------------------- * * Tcl_SetCommandInfoFromToken -- * * Modifies various information about a Tcl command. Note that this * function will not change a command's namespace; use TclRenameCommand * to do that. Also, the isNativeObjectProc member of *infoPtr is * ignored. * * Results: * If cmdName exists in interp, then the information at *infoPtr is * stored with the command in place of the current information and 1 is * returned. If the command doesn't exist then 0 is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_SetCommandInfoFromToken( Tcl_Command cmd, const Tcl_CmdInfo *infoPtr) { Command *cmdPtr; /* Internal representation of the command */ if (cmd == NULL) { return 0; } /* * The isNativeObjectProc and nsPtr members of *infoPtr are ignored. */ cmdPtr = (Command *) cmd; cmdPtr->proc = infoPtr->proc; cmdPtr->clientData = infoPtr->clientData; if (infoPtr->objProc == NULL) { cmdPtr->objProc = TclInvokeStringCommand; cmdPtr->objClientData = cmdPtr; cmdPtr->nreProc = NULL; } else { if (infoPtr->objProc != cmdPtr->objProc) { cmdPtr->nreProc = NULL; cmdPtr->objProc = infoPtr->objProc; } cmdPtr->objClientData = infoPtr->objClientData; } cmdPtr->deleteProc = infoPtr->deleteProc; cmdPtr->deleteData = infoPtr->deleteData; return 1; } /* *---------------------------------------------------------------------- * * Tcl_GetCommandInfo -- * * Returns various information about a Tcl command. * * Results: * If cmdName exists in interp, then *infoPtr is modified to hold * information about cmdName and 1 is returned. If the command doesn't * exist then 0 is returned and *infoPtr isn't modified. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetCommandInfo( Tcl_Interp *interp, /* Interpreter in which to look for * command. */ const char *cmdName, /* Name of desired command. */ Tcl_CmdInfo *infoPtr) /* Where to store information about * command. */ { Tcl_Command cmd; cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0); return Tcl_GetCommandInfoFromToken(cmd, infoPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetCommandInfoFromToken -- * * Returns various information about a Tcl command. * * Results: * Copies information from the command identified by 'cmd' into a * caller-supplied structure and returns 1. If the 'cmd' is NULL, leaves * the structure untouched and returns 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetCommandInfoFromToken( Tcl_Command cmd, Tcl_CmdInfo *infoPtr) { Command *cmdPtr; /* Internal representation of the command */ if (cmd == NULL) { return 0; } /* * Set isNativeObjectProc 1 if objProc was registered by a call to * Tcl_CreateObjCommand. Otherwise set it to 0. */ cmdPtr = (Command *) cmd; infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand); infoPtr->objProc = cmdPtr->objProc; infoPtr->objClientData = cmdPtr->objClientData; infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; infoPtr->deleteProc = cmdPtr->deleteProc; infoPtr->deleteData = cmdPtr->deleteData; infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr; return 1; } /* *---------------------------------------------------------------------- * * Tcl_GetCommandName -- * * Given a token returned by Tcl_CreateCommand, this function returns the * current name of the command (which may have changed due to renaming). * * Results: * The return value is the name of the given command. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_GetCommandName( Tcl_Interp *interp, /* Interpreter containing the command. */ Tcl_Command command) /* Token for command returned by a previous * call to Tcl_CreateCommand. The command must * not have been deleted. */ { Command *cmdPtr = (Command *) command; if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) { /* * This should only happen if command was "created" after the * interpreter began to be deleted, so there isn't really any command. * Just return an empty string. */ return ""; } return (const char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetCommandFullName -- * * Given a token returned by, e.g., Tcl_CreateCommand or Tcl_FindCommand, * this function appends to an object the command's full name, qualified * by a sequence of parent namespace names. The command's fully-qualified * name may have changed due to renaming. * * Results: * None. * * Side effects: * The command's fully-qualified name is appended to the string * representation of objPtr. * *---------------------------------------------------------------------- */ void Tcl_GetCommandFullName( Tcl_Interp *interp, /* Interpreter containing the command. */ Tcl_Command command, /* Token for command returned by a previous * call to Tcl_CreateCommand. The command must * not have been deleted. */ Tcl_Obj *objPtr) /* Points to the object onto which the * command's full name is appended. */ { Interp *iPtr = (Interp *) interp; Command *cmdPtr = (Command *) command; char *name; /* * Add the full name of the containing namespace, followed by the "::" * separator, and the command name. */ if (cmdPtr != NULL) { if (cmdPtr->nsPtr != NULL) { Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1); if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } if (cmdPtr->hPtr != NULL) { name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); Tcl_AppendToObj(objPtr, name, -1); } } } /* *---------------------------------------------------------------------- * * Tcl_DeleteCommand -- * * Remove the given command from the given interpreter. * * Results: * 0 is returned if the command was deleted successfully. -1 is returned * if there didn't exist a command by that name. * * Side effects: * cmdName will no longer be recognized as a valid command for interp. * *---------------------------------------------------------------------- */ int Tcl_DeleteCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous Tcl_CreateInterp call). */ const char *cmdName) /* Name of command to remove. */ { Tcl_Command cmd; /* * Find the desired command and delete it. */ cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0); if (cmd == NULL) { return -1; } return Tcl_DeleteCommandFromToken(interp, cmd); } /* *---------------------------------------------------------------------- * * Tcl_DeleteCommandFromToken -- * * Removes the given command from the given interpreter. This function * resembles Tcl_DeleteCommand, but takes a Tcl_Command token instead of * a command name for efficiency. * * Results: * 0 is returned if the command was deleted successfully. -1 is returned * if there didn't exist a command by that name. * * Side effects: * The command specified by "cmd" will no longer be recognized as a valid * command for "interp". * *---------------------------------------------------------------------- */ int Tcl_DeleteCommandFromToken( Tcl_Interp *interp, /* Token for command interpreter returned by a * previous call to Tcl_CreateInterp. */ Tcl_Command cmd) /* Token for command to delete. */ { Interp *iPtr = (Interp *) interp; Command *cmdPtr = (Command *) cmd; ImportRef *refPtr, *nextRefPtr; Tcl_Command importCmd; /* * Bump the command epoch counter. This will invalidate all cached * references that point to this command. */ cmdPtr->cmdEpoch++; /* * The code here is tricky. We can't delete the hash table entry before * invoking the deletion callback because there are cases where the * deletion callback needs to invoke the command (e.g. object systems such * as OTcl). However, this means that the callback could try to delete or * rename the command. The deleted flag allows us to detect these cases * and skip nested deletes. */ if (cmdPtr->flags & CMD_IS_DELETED) { /* * Another deletion is already in progress. Remove the hash table * entry now, but don't invoke a callback or free the command * structure. Take care to only remove the hash entry if it has not * already been removed; otherwise if we manage to hit this function * three times, everything goes up in smoke. [Bug 1220058] */ if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; } return 0; } /* * We must delete this command, even though both traces and delete procs * may try to avoid this (renaming the command etc). Also traces and * delete procs may try to delete the command themselves. This flag * declares that a delete is in progress and that recursive deletes should * be ignored. */ cmdPtr->flags |= CMD_IS_DELETED; /* * Call trace functions for the command being deleted. Then delete its * traces. */ cmdPtr->nsPtr->refCount++; if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* * Now delete these traces. */ tracePtr = cmdPtr->tracePtr; while (tracePtr != NULL) { CommandTrace *nextPtr = tracePtr->nextPtr; if (tracePtr->refCount-- <= 1) { ckfree(tracePtr); } tracePtr = nextPtr; } cmdPtr->tracePtr = NULL; } /* * The list of commands exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we need * the info will be soon enough. */ TclInvalidateNsCmdLookup(cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); /* * If the command being deleted has a compile function, increment the * interpreter's compileEpoch to invalidate its compiled code. This makes * sure that we don't later try to execute old code compiled with * command-specific (i.e., inline) bytecodes for the now-deleted command. * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose * compilation epoch doesn't match is recompiled. */ if (cmdPtr->compileProc != NULL) { iPtr->compileEpoch++; } if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) { /* * Delete any imports of this routine before deleting this routine itself. * See issue 688fcc7082fa. */ for (refPtr = cmdPtr->importRefPtr; refPtr != NULL; refPtr = nextRefPtr) { nextRefPtr = refPtr->nextPtr; importCmd = (Tcl_Command) refPtr->importedCmdPtr; Tcl_DeleteCommandFromToken(interp, importCmd); } } if (cmdPtr->deleteProc != NULL) { /* * Delete the command's client data. If this was an imported command * created when a command was imported into a namespace, this client * data will be a pointer to a ImportedCmdData structure describing * the "real" command that this imported command refers to. * * If you are getting a crash during the call to deleteProc and * cmdPtr->deleteProc is a pointer to the function free(), the most * likely cause is that your extension allocated memory for the * clientData argument to Tcl_CreateObjCommand with the ckalloc() * macro and you are now trying to deallocate this memory with free() * instead of ckfree(). You should pass a pointer to your own method * that calls ckfree(). */ cmdPtr->deleteProc(cmdPtr->deleteData); } /* * Don't use hPtr to delete the hash entry here, because it's possible * that the deletion callback renamed the command. Instead, use * cmdPtr->hptr, and make sure that no-one else has already deleted the * hash entry. */ if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; /* * Bump the command epoch counter. This will invalidate all cached * references that point to this command. */ cmdPtr->cmdEpoch++; } /* * A number of tests for particular kinds of commands are done by checking * whether the objProc field holds a known value. Set the field to NULL so * that such tests won't have false positives when applied to deleted * commands. */ cmdPtr->objProc = NULL; /* * Now free the Command structure, unless there is another reference to it * from a CmdName Tcl object in some ByteCode code sequence. In that case, * delay the cleanup until all references are either discarded (when a * ByteCode is freed) or replaced by a new reference (when a cached * CmdName Command reference is found to be invalid and * TclNRExecuteByteCode looks up the command in the command hashtable). */ cmdPtr->flags |= CMD_DEAD; TclCleanupCommandMacro(cmdPtr); return 0; } /* *---------------------------------------------------------------------- * * CallCommandTraces -- * * Abstraction of the code to call traces on a command. * * Results: * Currently always NULL. * * Side effects: * Anything; this may recursively evaluate scripts and code exists to do * just that. * *---------------------------------------------------------------------- */ static char * CallCommandTraces( Interp *iPtr, /* Interpreter containing command. */ Command *cmdPtr, /* Command whose traces are to be invoked. */ const char *oldName, /* Command's old name, or NULL if we must get * the name from cmdPtr */ const char *newName, /* Command's new name, or NULL if the command * is not being renamed */ int flags) /* Flags indicating the type of traces to * trigger, either TCL_TRACE_DELETE or * TCL_TRACE_RENAME. */ { CommandTrace *tracePtr; ActiveCommandTrace active; char *result; Tcl_Obj *oldNamePtr = NULL; Tcl_InterpState state = NULL; if (cmdPtr->flags & CMD_TRACE_ACTIVE) { /* * While a rename trace is active, we will not process any more rename * traces; while a delete trace is active we will never reach here - * because Tcl_DeleteCommandFromToken checks for the condition * (cmdPtr->flags & CMD_IS_DELETED) and returns immediately when a * command deletion is in progress. For all other traces, delete * traces will not be invoked but a call to TraceCommandProc will * ensure that tracePtr->clientData is freed whenever the command * "oldName" is deleted. */ if (cmdPtr->flags & TCL_TRACE_RENAME) { flags &= ~TCL_TRACE_RENAME; } if (flags == 0) { return NULL; } } cmdPtr->flags |= CMD_TRACE_ACTIVE; result = NULL; active.nextPtr = iPtr->activeCmdTracePtr; active.reverseScan = 0; iPtr->activeCmdTracePtr = &active; if (flags & TCL_TRACE_DELETE) { flags |= TCL_TRACE_DESTROYED; } active.cmdPtr = cmdPtr; Tcl_Preserve(iPtr); for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } cmdPtr->flags |= tracePtr->flags; if (oldName == NULL) { TclNewObj(oldNamePtr); Tcl_IncrRefCount(oldNamePtr); Tcl_GetCommandFullName((Tcl_Interp *) iPtr, (Tcl_Command) cmdPtr, oldNamePtr); oldName = TclGetString(oldNamePtr); } tracePtr->refCount++; if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK); } tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, oldName, newName, flags); cmdPtr->flags &= ~tracePtr->flags; if (tracePtr->refCount-- <= 1) { ckfree(tracePtr); } } if (state) { Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); } /* * If a new object was created to hold the full oldName, free it now. */ if (oldNamePtr != NULL) { TclDecrRefCount(oldNamePtr); } /* * Restore the variable's flags, remove the record of our active traces, * and then return. */ cmdPtr->flags &= ~CMD_TRACE_ACTIVE; iPtr->activeCmdTracePtr = active.nextPtr; Tcl_Release(iPtr); return result; } /* *---------------------------------------------------------------------- * * CancelEvalProc -- * * Marks this interpreter as being canceled. This causes current * executions to be unwound as the interpreter enters a state where it * refuses to execute more commands or handle [catch] or [try], yet the * interpreter is still able to execute further commands after the * cancelation is cleared (unlike if it is deleted). * * Results: * The value given for the code argument. * * Side effects: * Transfers a message from the cancellation message to the interpreter. * *---------------------------------------------------------------------- */ static int CancelEvalProc( ClientData clientData, /* Interp to cancel the script in progress. */ Tcl_Interp *interp, /* Ignored */ int code) /* Current return code from command. */ { CancelInfo *cancelInfo = (CancelInfo *)clientData; Interp *iPtr; if (cancelInfo != NULL) { Tcl_MutexLock(&cancelLock); iPtr = (Interp *) cancelInfo->interp; if (iPtr != NULL) { /* * Setting the CANCELED flag will cause the script in progress to * be canceled as soon as possible. The core honors this flag at * all the necessary places to ensure script cancellation is * responsive. Extensions can check for this flag by calling * Tcl_Canceled and checking if TCL_ERROR is returned or they can * choose to ignore the script cancellation flag and the * associated functionality altogether. Currently, the only other * flag we care about here is the TCL_CANCEL_UNWIND flag (from * Tcl_CancelEval). We do not want to simply combine all the flags * from original Tcl_CancelEval call with the interp flags here * just in case the caller passed flags that might cause behaviour * unrelated to script cancellation. */ TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED); /* * Now, we must set the script cancellation flags on all the child * interpreters belonging to this one. */ TclSetChildCancelFlags((Tcl_Interp *) iPtr, cancelInfo->flags | CANCELED, 0); /* * Create the result object now so that Tcl_Canceled can avoid * locking the cancelLock mutex. */ if (cancelInfo->result != NULL) { Tcl_SetStringObj(iPtr->asyncCancelMsg, cancelInfo->result, cancelInfo->length); } else { Tcl_SetObjLength(iPtr->asyncCancelMsg, 0); } } Tcl_MutexUnlock(&cancelLock); } return code; } /* *---------------------------------------------------------------------- * * TclCleanupCommand -- * * This function frees up a Command structure unless it is still * referenced from an interpreter's command hashtable or from a CmdName * Tcl object representing the name of a command in a ByteCode * instruction sequence. * * Results: * None. * * Side effects: * Memory gets freed unless a reference to the Command structure still * exists. In that case the cleanup is delayed until the command is * deleted or when the last ByteCode referring to it is freed. * *---------------------------------------------------------------------- */ void TclCleanupCommand( Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { ckfree(cmdPtr); } } /* *---------------------------------------------------------------------- * * Tcl_CreateMathFunc -- * * Creates a new math function for expressions in a given interpreter. * * Results: * None. * * Side effects: * The Tcl function defined by "name" is created or redefined. If the * function already exists then its definition is replaced; this includes * the builtin functions. Redefining a builtin function forces all * existing code to be invalidated since that code may be compiled using * an instruction specific to the replaced function. In addition, * redefining a non-builtin function will force existing code to be * invalidated if the number of arguments has changed. * *---------------------------------------------------------------------- */ void Tcl_CreateMathFunc( Tcl_Interp *interp, /* Interpreter in which function is to be * available. */ const char *name, /* Name of function (e.g. "sin"). */ int numArgs, /* Number of arguments required by * function. */ Tcl_ValueType *argTypes, /* Array of types acceptable for each * argument. */ Tcl_MathProc *proc, /* C function that implements the math * function. */ ClientData clientData) /* Additional value to pass to the * function. */ { Tcl_DString bigName; OldMathFuncData *data = (OldMathFuncData *)ckalloc(sizeof(OldMathFuncData)); data->proc = proc; data->numArgs = numArgs; data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType)); if ((numArgs > 0) && (argTypes != NULL)) { memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); } data->clientData = clientData; Tcl_DStringInit(&bigName); TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); Tcl_DStringAppend(&bigName, name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), OldMathFuncProc, data, OldMathFuncDeleteProc); Tcl_DStringFree(&bigName); } /* *---------------------------------------------------------------------- * * OldMathFuncProc -- * * Dispatch to a math function created with Tcl_CreateMathFunc * * Results: * Returns a standard Tcl result. * * Side effects: * Whatever the math function does. * *---------------------------------------------------------------------- */ static int OldMathFuncProc( ClientData clientData, /* Pointer to OldMathFuncData describing the * function being called */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { Tcl_Obj *valuePtr; OldMathFuncData *dataPtr = (OldMathFuncData *)clientData; Tcl_Value funcResult, *args; int result; int j, k; double d; /* * Check argument count. */ if (objc != dataPtr->numArgs + 1) { MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv); return TCL_ERROR; } /* * Convert arguments from Tcl_Obj's to Tcl_Value's. */ args = (Tcl_Value *)ckalloc(dataPtr->numArgs * sizeof(Tcl_Value)); for (j = 1, k = 0; j < objc; ++j, ++k) { /* TODO: Convert to TclGetNumberFromObj? */ valuePtr = objv[j]; result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); #ifdef ACCEPT_NAN if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) { d = valuePtr->internalRep.doubleValue; result = TCL_OK; } #endif if (result != TCL_OK) { /* * We have a non-numeric argument. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument to math function didn't have numeric value", -1)); TclCheckBadOctal(interp, Tcl_GetString(valuePtr)); ckfree(args); return TCL_ERROR; } /* * Copy the object's numeric value to the argument record, converting * it if necessary. * * NOTE: no bignum support; use the new mathfunc interface for that. */ args[k].type = dataPtr->argTypes[k]; switch (args[k].type) { case TCL_EITHER: if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue) == TCL_OK) { args[k].type = TCL_INT; break; } if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue) == TCL_OK) { args[k].type = TCL_WIDE_INT; break; } args[k].type = TCL_DOUBLE; /* FALLTHROUGH */ case TCL_DOUBLE: args[k].doubleValue = d; break; case TCL_INT: if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { ckfree(args); return TCL_ERROR; } valuePtr = Tcl_GetObjResult(interp); Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue); Tcl_ResetResult(interp); break; case TCL_WIDE_INT: if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { ckfree(args); return TCL_ERROR; } valuePtr = Tcl_GetObjResult(interp); TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); Tcl_ResetResult(interp); break; } } /* * Call the function. */ errno = 0; result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult); ckfree(args); if (result != TCL_OK) { return result; } /* * Return the result of the call. */ if (funcResult.type == TCL_INT) { TclNewLongObj(valuePtr, funcResult.intValue); } else if (funcResult.type == TCL_WIDE_INT) { valuePtr = Tcl_NewWideIntObj(funcResult.wideValue); } else { return CheckDoubleResult(interp, funcResult.doubleValue); } Tcl_SetObjResult(interp, valuePtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * OldMathFuncDeleteProc -- * * Cleans up after deleting a math function registered with * Tcl_CreateMathFunc * * Results: * None. * * Side effects: * Frees allocated memory. * *---------------------------------------------------------------------- */ static void OldMathFuncDeleteProc( ClientData clientData) { OldMathFuncData *dataPtr = (OldMathFuncData *)clientData; ckfree(dataPtr->argTypes); ckfree(dataPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetMathFuncInfo -- * * Discovers how a particular math function was created in a given * interpreter. * * Results: * TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the * interpreter result if that happens.) * * Side effects: * If this function succeeds, the variables pointed to by the numArgsPtr * and argTypePtr arguments will be updated to detail the arguments * allowed by the function. The variable pointed to by the procPtr * argument will be set to NULL if the function is a builtin function, * and will be set to the address of the C function used to implement the * math function otherwise (in which case the variable pointed to by the * clientDataPtr argument will also be updated.) * *---------------------------------------------------------------------- */ int Tcl_GetMathFuncInfo( Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr) { Tcl_Obj *cmdNameObj; Command *cmdPtr; /* * Get the command that implements the math function. */ TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::"); Tcl_AppendToObj(cmdNameObj, name, -1); Tcl_IncrRefCount(cmdNameObj); cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj); Tcl_DecrRefCount(cmdNameObj); /* * Report unknown functions. */ if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown math function \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL); *numArgsPtr = -1; *argTypesPtr = NULL; *procPtr = NULL; *clientDataPtr = NULL; return TCL_ERROR; } /* * Retrieve function info for user defined functions; return dummy * information for builtins. */ if (cmdPtr->objProc == &OldMathFuncProc) { OldMathFuncData *dataPtr = (OldMathFuncData *)cmdPtr->clientData; *procPtr = dataPtr->proc; *numArgsPtr = dataPtr->numArgs; *argTypesPtr = dataPtr->argTypes; *clientDataPtr = dataPtr->clientData; } else { *procPtr = NULL; *numArgsPtr = -1; *argTypesPtr = NULL; *procPtr = NULL; *clientDataPtr = NULL; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ListMathFuncs -- * * Produces a list of all the math functions defined in a given * interpreter. * * Results: * A pointer to a Tcl_Obj structure with a reference count of zero, or * NULL in the case of an error (in which case a suitable error message * will be left in the interpreter result.) * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ListMathFuncs( Tcl_Interp *interp, const char *pattern) { Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1); Tcl_Obj *result; Tcl_InterpState state; if (pattern) { Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1); Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj); Tcl_AppendObjToObj(script, arg); Tcl_DecrRefCount(arg); /* Should tear down patternObj too */ } state = Tcl_SaveInterpState(interp, TCL_OK); Tcl_IncrRefCount(script); if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) { result = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } else { TclNewObj(result); } Tcl_DecrRefCount(script); Tcl_RestoreInterpState(interp, state); return result; } /* *---------------------------------------------------------------------- * * TclInterpReady -- * * Check if an interpreter is ready to eval commands or scripts, i.e., if * it was not deleted and if the nesting level is not too high. * * Results: * The return value is TCL_OK if it the interpreter is ready, TCL_ERROR * otherwise. * * Side effects: * The interpreters object and string results are cleared. * *---------------------------------------------------------------------- */ int TclInterpReady( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; /* * Reset both the interpreter's string and object results and clear out * any previous error information. */ Tcl_ResetResult(interp); /* * If the interpreter has been deleted, return an error. */ if (iPtr->flags & DELETED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to call eval in deleted interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "IDELETE", "attempt to call eval in deleted interpreter", NULL); return TCL_ERROR; } if (iPtr->execEnvPtr->rewind) { return TCL_ERROR; } /* * Make sure the script being evaluated (if any) has not been canceled. */ if (TclCanceled(iPtr) && (TCL_OK != Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG))) { return TCL_ERROR; } /* * Check depth of nested calls to Tcl_Eval: if this gets too large, it's * probably because of an infinite loop somewhere. */ if (((iPtr->numLevels) <= iPtr->maxNestingDepth)) { return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( "too many nested evaluations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclResetCancellation -- * * Reset the script cancellation flags if the nesting level * (iPtr->numLevels) for the interp is zero or argument force is * non-zero. * * Results: * A standard Tcl result. * * Side effects: * The script cancellation flags for the interp may be reset. * *---------------------------------------------------------------------- */ int TclResetCancellation( Tcl_Interp *interp, int force) { Interp *iPtr = (Interp *) interp; if (iPtr == NULL) { return TCL_ERROR; } if (force || (iPtr->numLevels == 0)) { TclUnsetCancelFlags(iPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_Canceled -- * * Check if the script in progress has been canceled, i.e., * Tcl_CancelEval was called for this interpreter or any of its parent * interpreters. * * Results: * The return value is TCL_OK if the script evaluation has not been * canceled, TCL_ERROR otherwise. * * If "flags" contains TCL_LEAVE_ERR_MSG, an error message is returned in * the interpreter's result object. Otherwise, the interpreter's result * object is left unchanged. If "flags" contains TCL_CANCEL_UNWIND, * TCL_ERROR will only be returned if the script evaluation is being * completely unwound. * * Side effects: * The CANCELED flag for the interp will be reset if it is set. * *---------------------------------------------------------------------- */ int Tcl_Canceled( Tcl_Interp *interp, int flags) { Interp *iPtr = (Interp *) interp; /* * Has the current script in progress for this interpreter been canceled * or is the stack being unwound due to the previous script cancellation? */ if (!TclCanceled(iPtr)) { return TCL_OK; } /* * The CANCELED flag is a one-shot flag that is reset immediately upon * being detected; however, if the TCL_CANCEL_UNWIND flag is set we will * continue to report that the script in progress has been canceled * thereby allowing the evaluation stack for the interp to be fully * unwound. */ iPtr->flags &= ~CANCELED; /* * The CANCELED flag was detected and reset; however, if the caller * specified the TCL_CANCEL_UNWIND flag, we only return TCL_ERROR * (indicating that the script in progress has been canceled) if the * evaluation stack for the interp is being fully unwound. */ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) { return TCL_OK; } /* * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the * interp's result; otherwise, we leave it alone. */ if (flags & TCL_LEAVE_ERR_MSG) { const char *id, *message = NULL; int length; /* * Setup errorCode variables so that we can differentiate between * being canceled and unwound. */ if (iPtr->asyncCancelMsg != NULL) { message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length); } else { length = 0; } if (iPtr->flags & TCL_CANCEL_UNWIND) { id = "IUNWIND"; if (length == 0) { message = "eval unwound"; } } else { id = "ICANCEL"; if (length == 0) { message = "eval canceled"; } } Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL); } /* * Return TCL_ERROR to the caller (not necessarily just the Tcl core * itself) that indicates further processing of the script or command in * progress should halt gracefully and as soon as possible. */ return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_CancelEval -- * * This function schedules the cancellation of the current script in the * given interpreter. * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR. Since the interp may belong to a different thread, no error * message can be left in the interp's result. * * Side effects: * The script in progress in the specified interpreter will be canceled * with TCL_ERROR after asynchronous handlers are invoked at the next * Tcl_Canceled check. * *---------------------------------------------------------------------- */ int Tcl_CancelEval( Tcl_Interp *interp, /* Interpreter in which to cancel the * script. */ Tcl_Obj *resultObjPtr, /* The script cancellation error message or * NULL for a default error message. */ ClientData clientData, /* Passed to CancelEvalProc. */ int flags) /* Collection of OR-ed bits that control * the cancellation of the script. Only * TCL_CANCEL_UNWIND is currently * supported. */ { Tcl_HashEntry *hPtr; CancelInfo *cancelInfo; int code = TCL_ERROR; const char *result; if (interp == NULL) { return TCL_ERROR; } Tcl_MutexLock(&cancelLock); if (cancelTableInitialized != 1) { /* * No CancelInfo hash table (Tcl_CreateInterp has never been called?) */ goto done; } hPtr = Tcl_FindHashEntry(&cancelTable, (char *) interp); if (hPtr == NULL) { /* * No CancelInfo record for this interpreter. */ goto done; } cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); /* * Populate information needed by the interpreter thread to fulfill the * cancellation request. Currently, clientData is ignored. If the * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not * allowed to catch the script cancellation because the evaluation stack * for the interp is completely unwound. */ if (resultObjPtr != NULL) { result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length); cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { cancelInfo->result = NULL; cancelInfo->length = 0; } cancelInfo->clientData = clientData; cancelInfo->flags = flags; Tcl_AsyncMark(cancelInfo->async); code = TCL_OK; done: Tcl_MutexUnlock(&cancelLock); return code; } /* *---------------------------------------------------------------------- * * Tcl_InterpActive -- * * Returns non-zero if the specified interpreter is in use, i.e. if there * is an evaluation currently active in the interpreter. * * Results: * See above. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_InterpActive( Tcl_Interp *interp) { return ((Interp *) interp)->numLevels > 0; } /* *---------------------------------------------------------------------- * * Tcl_EvalObjv -- * * This function evaluates a Tcl command that has already been parsed * into words, with one Tcl_Obj holding each word. * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR. A result or error message is left in interp's result. * * Side effects: * Always pushes a callback. Other side effects depend on the command. * *---------------------------------------------------------------------- */ int Tcl_EvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ int objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and * TCL_EVAL_NOERR are currently supported. */ { int result; NRE_callback *rootPtr = TOP_CB(interp); result = TclNREvalObjv(interp, objc, objv, flags, NULL); return TclNRRunCallbacks(interp, result, rootPtr); } int TclNREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ int objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and * TCL_EVAL_NOERR are currently supported. */ Command *cmdPtr) /* NULL if the Command is to be looked up * here, otherwise the pointer to the * requested Command struct to be invoked. */ { Interp *iPtr = (Interp *) interp; /* * data[1] stores a marker for use by tailcalls; it will be set to 1 by * command redirectors (imports, alias, ensembles) so that tailcall skips * this callback (that marks the end of the target command) and goes back * to the end of the source command. */ if (iPtr->deferredCallbacks) { iPtr->deferredCallbacks = NULL; } else { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); } iPtr->numLevels++; TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags), INT2PTR(objc), objv); return TCL_OK; } static int EvalObjvCore( ClientData data[], Tcl_Interp *interp, int result) { Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0]; int flags = PTR2INT(data[1]); int objc = PTR2INT(data[2]); Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = NULL; int enterTracesDone = 0; /* * Push records for task to be done on return, in INVERSE order. First, if * needed, the exception handlers (as they should happen last). */ if (!(flags & TCL_EVAL_NOERR)) { TEOV_PushExceptionHandlers(interp, objc, objv, flags); } if (TCL_OK != TclInterpReady(interp)) { return TCL_ERROR; } if (objc == 0) { return TCL_OK; } if (TclLimitExceeded(iPtr->limit)) { return TCL_ERROR; } /* * Configure evaluation context to match the requested flags. */ if (iPtr->lookupNsPtr) { /* * Capture the namespace we should do command name resolution in, as * instructed by our caller sneaking it in to us in a private interp * field. Clear that field right away so we cannot possibly have its * use leak where it should not. The sneaky message pass is done. * * Use of this mechanism overrides the TCL_EVAL_GLOBAL flag. * TODO: Is that a bug? */ lookupNsPtr = iPtr->lookupNsPtr; iPtr->lookupNsPtr = NULL; } else if (flags & TCL_EVAL_INVOKE) { lookupNsPtr = iPtr->globalNsPtr; } else { /* * TCL_EVAL_INVOKE was not set: clear rewrite rules */ TclResetRewriteEnsemble(interp, 1); if (flags & TCL_EVAL_GLOBAL) { TEOV_SwitchVarFrame(interp); lookupNsPtr = iPtr->globalNsPtr; } } /* * Lookup the Command to dispatch. */ reresolve: assert(cmdPtr == NULL); if (preCmdPtr) { /* * Caller gave it to us. */ if (!(preCmdPtr->flags & CMD_DEAD)) { /* * So long as it exists, use it. */ cmdPtr = preCmdPtr; } else if (flags & TCL_EVAL_NORESOLVE) { /* * When it's been deleted, and we're told not to attempt resolving * it ourselves, all we can do is raise an error. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to invoke a deleted command")); Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL); return TCL_ERROR; } } if (cmdPtr == NULL) { cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); if (!cmdPtr) { return TEOV_NotFound(interp, objc, objv, lookupNsPtr); } } if (enterTracesDone || iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { Tcl_Obj *commandPtr = TclGetSourceFromFrame( flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, objc, objv); Tcl_IncrRefCount(commandPtr); if (!enterTracesDone) { int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr, objc, objv); /* * Send any exception from enter traces back as an exception * raised by the traced command. * TODO: Is this a bug? Letting an execution trace BREAK or * CONTINUE or RETURN in the place of the traced command? Would * either converting all exceptions to TCL_ERROR, or just * swallowing them be better? (Swallowing them has the problem of * permanently hiding program errors.) */ if (code != TCL_OK) { Tcl_DecrRefCount(commandPtr); return code; } /* * If the enter traces made the resolved cmdPtr unusable, go back * and resolve again, but next time don't run enter traces again. */ if (cmdPtr == NULL) { enterTracesDone = 1; Tcl_DecrRefCount(commandPtr); goto reresolve; } } /* * Schedule leave traces. Raise the refCount on the resolved cmdPtr, * so that when it passes to the leave traces we know it's still * valid. */ cmdPtr->refCount++; TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), commandPtr, cmdPtr, objv); } TclNRAddCallback(interp, Dispatch, cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc, cmdPtr->objClientData, INT2PTR(objc), objv); return TCL_OK; } static int Dispatch( ClientData data[], Tcl_Interp *interp, int result) { Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; ClientData clientData = data[1]; int objc = PTR2INT(data[2]); Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { const char *a[10]; int i = 0; while (i < 10) { a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; } TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]); } if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) { Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); const char *a[6]; int i[2]; TclDTraceInfo(info, a, i); TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); TclDecrRefCount(info); } if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) && objc) { TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); } if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) { TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1, (Tcl_Obj **)(objv + 1)); } #endif /* USE_DTRACE */ iPtr->cmdCount++; return objProc(clientData, interp, objc, objv); } int TclNRRunCallbacks( Tcl_Interp *interp, int result, struct NRE_callback *rootPtr) /* All callbacks down to rootPtr not inclusive * are to be run. */ { Interp *iPtr = (Interp *) interp; /* * If the interpreter has a non-empty string result, the result object is * either empty or stale because some function set interp->result * directly. If so, move the string result to the result object, then * reset the string result. * * This only needs to be done for the first item in the list: all other * are for NR function calls, and those are Tcl_Obj based. */ if (*(iPtr->result) != 0) { (void) Tcl_GetObjResult(interp); } /* * This is the trampoline. */ while (TOP_CB(interp) != rootPtr) { NRE_callback *callbackPtr = TOP_CB(interp); Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); TCLNR_FREE(interp, callbackPtr); } return result; } static int NRCommand( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; iPtr->numLevels--; /* * If there is a tailcall, schedule it next */ if (data[1] && (data[1] != INT2PTR(1))) { TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL); } /* OPT ?? * Do not interrupt a series of cleanups with async or limit checks: * just check at the end? */ if (TclAsyncReady(iPtr)) { result = Tcl_AsyncInvoke(interp, result); } if ((result == TCL_OK) && TclCanceled(iPtr)) { result = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG); } if (result == TCL_OK && TclLimitReady(iPtr->limit)) { result = Tcl_LimitCheck(interp); } return result; } /* *---------------------------------------------------------------------- * * TEOV_Exception - * TEOV_LookupCmdFromObj - * TEOV_RunEnterTraces - * TEOV_RunLeaveTraces - * TEOV_NotFound - * * These are helper functions for Tcl_EvalObjv. * *---------------------------------------------------------------------- */ static void TEOV_PushExceptionHandlers( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) { Interp *iPtr = (Interp *) interp; /* * If any error processing is necessary, push the appropriate records. * Note that we have to push them in the inverse order: first the one that * has to run last. */ if (!(flags & TCL_EVAL_INVOKE)) { /* * Error messages */ TclNRAddCallback(interp, TEOV_Error, INT2PTR(objc), objv, NULL, NULL); } if (iPtr->numLevels == 1) { /* * No CONTINUE or BREAK at level 0, manage RETURN */ TclNRAddCallback(interp, TEOV_Exception, INT2PTR(iPtr->evalFlags), NULL, NULL, NULL); } } static void TEOV_SwitchVarFrame( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; /* * Change the varFrame to be the rootVarFrame, and push a record to * restore things at the end. */ TclNRAddCallback(interp, TEOV_RestoreVarFrame, iPtr->varFramePtr, NULL, NULL, NULL); iPtr->varFramePtr = iPtr->rootFramePtr; } static int TEOV_RestoreVarFrame( ClientData data[], Tcl_Interp *interp, int result) { ((Interp *) interp)->varFramePtr = (CallFrame *)data[0]; return result; } static int TEOV_Exception( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int allowExceptions = (PTR2INT(data[0]) & TCL_ALLOW_EXCEPTIONS); if (result != TCL_OK) { if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { ProcessUnexpectedResult(interp, result); result = TCL_ERROR; } } /* * We are returning to level 0, so should process TclResetCancellation. As * numLevels has not *yet* been decreased, do not call it: do the thing * here directly. */ TclUnsetCancelFlags(iPtr); return result; } static int TEOV_Error( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; int cmdLen; int objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { /* * If there was an error, a command string will be needed for the * error log: get it out of the itemPtr. The details depend on the * type. */ listPtr = Tcl_NewListObj(objc, objv); cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen); Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(listPtr); } iPtr->flags &= ~ERR_ALREADY_LOGGED; return result; } static int TEOV_NotFound( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr) { Command * cmdPtr; Interp *iPtr = (Interp *) interp; int i, newObjc, handlerObjc; Tcl_Obj **newObjv, **handlerObjv; CallFrame *varFramePtr = iPtr->varFramePtr; Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered * unknown command handler for the current * namespace (TIP 181). */ Namespace *savedNsPtr = NULL; currNsPtr = varFramePtr->nsPtr; if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) { currNsPtr = iPtr->globalNsPtr; if (currNsPtr == NULL) { Tcl_Panic("Tcl_EvalObjv: NULL global namespace pointer"); } } /* * Check to see if the resolution namespace has lost its unknown handler. * If so, reset it to "::unknown". */ if (currNsPtr->unknownHandlerPtr == NULL) { TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown"); Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr); } /* * Get the list of words for the unknown handler and allocate enough space * to hold both the handler prefix and all words of the command invocation * itself. */ TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); /* * Copy command prefix from unknown handler and add on the real command's * full argument list. Note that we only use memcpy() once because we have * to increment the reference count of all the handler arguments anyway. */ for (i = 0; i < handlerObjc; ++i) { newObjv[i] = handlerObjv[i]; Tcl_IncrRefCount(newObjv[i]); } memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc); /* * Look up and invoke the handler (by recursive call to this function). If * there is no handler at all, instead of doing the recursive call we just * generate a generic error message; it would be an infinite-recursion * nightmare otherwise. * * In this case we worry a bit less about recursion for now, and call the * "blocking" interface. */ cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid command name \"%s\"", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", TclGetString(objv[0]), NULL); /* * Release any resources we locked and allocated during the handler * call. */ for (i = 0; i < handlerObjc; ++i) { Tcl_DecrRefCount(newObjv[i]); } TclStackFree(interp, newObjv); return TCL_ERROR; } if (lookupNsPtr) { savedNsPtr = varFramePtr->nsPtr; varFramePtr->nsPtr = lookupNsPtr; } TclSkipTailcall(interp); TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), newObjv, savedNsPtr, NULL); return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL); } static int TEOV_NotFoundCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; Namespace *savedNsPtr = (Namespace *)data[2]; int i; if (savedNsPtr) { iPtr->varFramePtr->nsPtr = savedNsPtr; } /* * Release any resources we locked and allocated during the handler call. */ for (i = 0; i < objc; ++i) { Tcl_DecrRefCount(objv[i]); } TclStackFree(interp, objv); return result; } static int TEOV_RunEnterTraces( Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int length, traceCode = TCL_OK; const char *command = Tcl_GetStringFromObj(commandPtr, &length); /* * Call trace functions. * Execute any command or execution traces. Note that we bump up the * command's reference count for the duration of the calling of the * traces so that the structure doesn't go away underneath our feet. */ cmdPtr->refCount++; if (iPtr->tracePtr) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv); } if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) { traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv); } newEpoch = cmdPtr->cmdEpoch; TclCleanupCommandMacro(cmdPtr); if (traceCode != TCL_OK) { if (traceCode == TCL_ERROR) { Tcl_Obj *info; TclNewLiteralStringObj(info, "\n (enter trace on \""); Tcl_AppendLimitedToObj(info, command, length, 55, "..."); Tcl_AppendToObj(info, "\")", 2); Tcl_AppendObjToErrorInfo(interp, info); iPtr->flags |= ERR_ALREADY_LOGGED; } return traceCode; } if (cmdEpoch != newEpoch) { *cmdPtrPtr = NULL; } return TCL_OK; } static int TEOV_RunLeaveTraces( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; int length; const char *command = Tcl_GetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_IS_DELETED)) { if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) { traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } } /* * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels. * Prevent that by resetting the cmdPtr field and dealing right here with * cmdPtr->refCount. */ TclCleanupCommandMacro(cmdPtr); if (traceCode != TCL_OK) { if (traceCode == TCL_ERROR) { Tcl_Obj *info; TclNewLiteralStringObj(info, "\n (leave trace on \""); Tcl_AppendLimitedToObj(info, command, length, 55, "..."); Tcl_AppendToObj(info, "\")", 2); Tcl_AppendObjToErrorInfo(interp, info); iPtr->flags |= ERR_ALREADY_LOGGED; } result = traceCode; } Tcl_DecrRefCount(commandPtr); return result; } static inline Command * TEOV_LookupCmdFromObj( Tcl_Interp *interp, Tcl_Obj *namePtr, Namespace *lookupNsPtr) { Interp *iPtr = (Interp *) interp; Command *cmdPtr; Namespace *savedNsPtr = iPtr->varFramePtr->nsPtr; if (lookupNsPtr) { iPtr->varFramePtr->nsPtr = lookupNsPtr; } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr); iPtr->varFramePtr->nsPtr = savedNsPtr; return cmdPtr; } /* *---------------------------------------------------------------------- * * Tcl_EvalTokensStandard -- * * Given an array of tokens parsed from a Tcl command (e.g., the tokens * that make up a word or the index for an array variable) this function * evaluates the tokens and concatenates their values to form a single * result value. * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR. A result or error message is left in interp's result. * * Side effects: * Depends on the array of tokens being evaled. * *---------------------------------------------------------------------- */ int Tcl_EvalTokensStandard( Tcl_Interp *interp, /* Interpreter in which to lookup variables, * execute nested commands, and report * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ int count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, NULL, NULL); } /* *---------------------------------------------------------------------- * * Tcl_EvalTokens -- * * Given an array of tokens parsed from a Tcl command (e.g., the tokens * that make up a word or the index for an array variable) this function * evaluates the tokens and concatenates their values to form a single * result value. * * Results: * The return value is a pointer to a newly allocated Tcl_Obj containing * the value of the array of tokens. The reference count of the returned * object has been incremented. If an error occurs in evaluating the * tokens then a NULL value is returned and an error message is left in * interp's result. * * Side effects: * A new object is allocated to hold the result. * *---------------------------------------------------------------------- * * This uses a non-standard return convention; its use is now deprecated. It * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used * in the core any longer. It is only kept for backward compatibility. */ Tcl_Obj * Tcl_EvalTokens( Tcl_Interp *interp, /* Interpreter in which to lookup variables, * execute nested commands, and report * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ int count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { Tcl_Obj *resPtr; if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) { return NULL; } resPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resPtr); Tcl_ResetResult(interp); return resPtr; } /* *---------------------------------------------------------------------- * * Tcl_EvalEx, TclEvalEx -- * * This function evaluates a Tcl script without using the compiler or * byte-code interpreter. It just parses the script, creates values for * each word of each command, then calls EvalObjv to execute each * command. * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR. A result or error message is left in interp's result. * * Side effects: * Depends on the script. * * TIP #280 : Keep public API, internally extended API. *---------------------------------------------------------------------- */ int Tcl_EvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ int numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ { return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script); } int TclEvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ int numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first NUL character. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ int line, /* The line the script starts on. */ int *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' * refers to the most-outer script containing * the embedded command, which is referred to * by 'script'. The 'clNextOuter' refers to * the current entry in the table of * continuation lines in this "main script", * and the character offsets are relative to * the 'outerScript' as well. * * If outerScript == script, then this call is * for the outer-most script/command. See * Tcl_EvalEx() and TclEvalObjEx() for places * generating arguments for which this is * true. */ { Interp *iPtr = (Interp *) interp; const char *p, *next; const unsigned int minObjs = 20; Tcl_Obj **objv, **objvSpace; int *expand, *lines, *lineSpace; Tcl_Token *tokenPtr; int commandLength, bytesLeft, expandRequested, code = TCL_OK; CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); int gotParse = 0; unsigned int i, objectsUsed = 0; /* These variables keep track of how much * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); Tcl_Obj **stackObjArray = (Tcl_Obj **) TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); /* TIP #280 Structures for tracking of command * locations. */ int *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to * track, via scriptCLLocPtr. It always refers * to the table entry holding the location of * the next invisible continuation line to * look for, while parsing the script. */ if (iPtr->scriptCLLocPtr) { if (clNextOuter) { clNext = clNextOuter; } else { clNext = &iPtr->scriptCLLocPtr->loc[0]; } } if (numBytes < 0) { numBytes = strlen(script); } Tcl_ResetResult(interp); savedVarFramePtr = iPtr->varFramePtr; if (flags & TCL_EVAL_GLOBAL) { iPtr->varFramePtr = iPtr->rootFramePtr; } /* * Each iteration through the following loop parses the next command from * the script and then executes it. */ objv = objvSpace = stackObjArray; lines = lineSpace = linesStack; expand = expandStack; p = script; bytesLeft = numBytes; /* * TIP #280 Initialize tracking. Do not push on the frame stack yet. * * We open a new context, either for a sourced script, or 'eval'. * For sourced files we always have a path object, even if nothing was * specified in the interp itself. That makes code using it simpler as * NULL checks can be left out. Sourced file without path in the * 'scriptFile' is possible during Tcl initialization. */ eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1; eeFramePtr->framePtr = iPtr->framePtr; eeFramePtr->nextPtr = iPtr->cmdFramePtr; eeFramePtr->nline = 0; eeFramePtr->line = NULL; eeFramePtr->cmdObj = NULL; iPtr->cmdFramePtr = eeFramePtr; if (iPtr->evalFlags & TCL_EVAL_FILE) { /* * Set up for a sourced file. */ eeFramePtr->type = TCL_LOCATION_SOURCE; if (iPtr->scriptFile) { /* * Normalization here, to have the correct pwd. Should have * negligible impact on performance, as the norm should have been * done already by the 'source' invoking us, and it caches the * result. */ Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile); if (norm == NULL) { /* * Error message in the interp result. */ code = TCL_ERROR; goto error; } eeFramePtr->data.eval.path = norm; } else { TclNewLiteralStringObj(eeFramePtr->data.eval.path, ""); } Tcl_IncrRefCount(eeFramePtr->data.eval.path); } else { /* * Set up for plain eval. */ eeFramePtr->type = TCL_LOCATION_EVAL; eeFramePtr->data.eval.path = NULL; } iPtr->evalFlags = 0; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { code = TCL_ERROR; Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, parsePtr->term + 1 - parsePtr->commandStart); goto posterror; } /* * TIP #280 Track lines. The parser may have skipped text till it * found the command we are now at. We have to count the lines in this * block, and do not forget invisible continuation lines. */ TclAdvanceLines(&line, p, parsePtr->commandStart); TclAdvanceContinuations(&line, &clNext, parsePtr->commandStart - outerScript); gotParse = 1; if (parsePtr->numWords > 0) { /* * TIP #280. Track lines within the words of the current * command. We use a separate pointer into the table of * continuation line locations to not lose our position for the * per-command parsing. */ int wordLine = line; const char *wordStart = parsePtr->commandStart; int *wordCLNext = clNext; unsigned int objectsNeeded = 0; unsigned int numWords = parsePtr->numWords; /* * Generate an array of objects for the words of the command. */ if (numWords > minObjs) { expand = (int *)ckalloc(numWords * sizeof(int)); objvSpace = (Tcl_Obj **)ckalloc(numWords * sizeof(Tcl_Obj *)); lineSpace = (int *)ckalloc(numWords * sizeof(int)); } expandRequested = 0; objv = objvSpace; lines = lineSpace; iPtr->cmdFramePtr = eeFramePtr->nextPtr; for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { /* * TIP #280. Track lines to current word. Save the information * on a per-word basis, signaling dynamic words as needed. * Make the information available to the recursively called * evaluator as well, including the type of context (source * vs. eval). */ TclAdvanceLines(&wordLine, wordStart, tokenPtr->start); TclAdvanceContinuations(&wordLine, &wordCLNext, tokenPtr->start - outerScript); wordStart = tokenPtr->start; lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1; if (eeFramePtr->type == TCL_LOCATION_SOURCE) { iPtr->evalFlags |= TCL_EVAL_FILE; } code = TclSubstTokens(interp, tokenPtr+1, tokenPtr->numComponents, NULL, wordLine, wordCLNext, outerScript); iPtr->evalFlags = 0; if (code != TCL_OK) { break; } objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { int numElements; code = TclListObjLength(interp, objv[objectsUsed], &numElements); if (code == TCL_ERROR) { /* * Attempt to expand a non-list. */ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (expanding word %d)", objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); break; } expandRequested = 1; expand[objectsUsed] = 1; objectsNeeded += (numElements ? numElements : 1); } else { expand[objectsUsed] = 0; objectsNeeded++; } if (wordCLNext) { TclContinuationsEnterDerived(objv[objectsUsed], wordStart - outerScript, wordCLNext); } } /* for loop */ iPtr->cmdFramePtr = eeFramePtr; if (code != TCL_OK) { goto error; } if (expandRequested) { /* * Some word expansion was requested. Check for objv resize. */ Tcl_Obj **copy = objvSpace; int *lcopy = lineSpace; int wordIdx = numWords; int objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { objv = objvSpace = (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *)); lines = lineSpace = (int *)ckalloc(objectsNeeded * sizeof(int)); } objectsUsed = 0; while (wordIdx--) { if (expand[wordIdx]) { int numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; TclListObjGetElements(NULL, temp, &numElements, &elements); objectsUsed += numElements; while (numElements--) { lines[objIdx] = -1; objv[objIdx--] = elements[numElements]; Tcl_IncrRefCount(elements[numElements]); } Tcl_DecrRefCount(temp); } else { lines[objIdx] = lcopy[wordIdx]; objv[objIdx--] = copy[wordIdx]; objectsUsed++; } } objv += objIdx+1; if (copy != stackObjArray) { ckfree(copy); } if (lcopy != linesStack) { ckfree(lcopy); } } /* * Execute the command and free the objects for its words. * * TIP #280: Remember the command itself for 'info frame'. We * shorten the visible command by one char to exclude the * termination character, if necessary. Here is where we put our * frame on the stack of frames too. _After_ the nested commands * have been executed. */ eeFramePtr->cmd = parsePtr->commandStart; eeFramePtr->len = parsePtr->commandSize; if (parsePtr->term == parsePtr->commandStart + parsePtr->commandSize - 1) { eeFramePtr->len--; } eeFramePtr->nline = objectsUsed; eeFramePtr->line = lines; TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr); code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME); TclArgumentRelease(interp, objv, objectsUsed); eeFramePtr->line = NULL; eeFramePtr->nline = 0; if (eeFramePtr->cmdObj) { Tcl_DecrRefCount(eeFramePtr->cmdObj); eeFramePtr->cmdObj = NULL; } if (code != TCL_OK) { goto error; } for (i = 0; i < objectsUsed; i++) { Tcl_DecrRefCount(objv[i]); } objectsUsed = 0; if (objvSpace != stackObjArray) { ckfree(objvSpace); objvSpace = stackObjArray; ckfree(lineSpace); lineSpace = linesStack; } /* * Free expand separately since objvSpace could have been * reallocated above. */ if (expand != expandStack) { ckfree(expand); expand = expandStack; } } /* * Advance to the next command in the script. * * TIP #280 Track Lines. Now we track how many lines were in the * executed command. */ next = parsePtr->commandStart + parsePtr->commandSize; bytesLeft -= next - p; p = next; TclAdvanceLines(&line, parsePtr->commandStart, p); Tcl_FreeParse(parsePtr); gotParse = 0; } while (bytesLeft > 0); iPtr->varFramePtr = savedVarFramePtr; code = TCL_OK; goto cleanup_return; error: /* * Generate and log various pieces of error information. */ if (iPtr->numLevels == 0) { if (code == TCL_RETURN) { code = TclUpdateReturnInfo(iPtr); } if ((code != TCL_OK) && (code != TCL_ERROR) && !allowExceptions) { ProcessUnexpectedResult(interp, code); code = TCL_ERROR; } } if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { commandLength = parsePtr->commandSize; if (parsePtr->term == parsePtr->commandStart + commandLength - 1) { /* * The terminator character (such as ; or ]) of the command where * the error occurred is the last character in the parsed command. * Reduce the length by one so that the error message doesn't * include the terminator character. */ commandLength -= 1; } Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, commandLength); } posterror: iPtr->flags &= ~ERR_ALREADY_LOGGED; /* * Then free resources that had been allocated to the command. */ for (i = 0; i < objectsUsed; i++) { Tcl_DecrRefCount(objv[i]); } if (gotParse) { Tcl_FreeParse(parsePtr); } if (objvSpace != stackObjArray) { ckfree(objvSpace); ckfree(lineSpace); } if (expand != expandStack) { ckfree(expand); } iPtr->varFramePtr = savedVarFramePtr; cleanup_return: /* * TIP #280. Release the local CmdFrame, and its contents. */ iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; if (eeFramePtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eeFramePtr->data.eval.path); } TclStackFree(interp, linesStack); TclStackFree(interp, expandStack); TclStackFree(interp, stackObjArray); TclStackFree(interp, eeFramePtr); TclStackFree(interp, parsePtr); return code; } /* *---------------------------------------------------------------------- * * TclAdvanceLines -- * * This function is a helper which counts the number of lines in a block * of text and advances an external counter. * * Results: * None. * * Side effects: * The specified counter is advanced per the number of lines found. * * TIP #280 *---------------------------------------------------------------------- */ void TclAdvanceLines( int *line, const char *start, const char *end) { const char *p; for (p = start; p < end; p++) { if (*p == '\n') { (*line)++; } } } /* *---------------------------------------------------------------------- * * TclAdvanceContinuations -- * * This procedure is a helper which counts the number of continuation * lines (CL) in a block of text using a table of CL locations and * advances an external counter, and the pointer into the table. * * Results: * None. * * Side effects: * The specified counter is advanced per the number of continuation lines * found. * * TIP #280 *---------------------------------------------------------------------- */ void TclAdvanceContinuations( int *line, int **clNextPtrPtr, int loc) { /* * Track the invisible continuation lines embedded in a script, if any. * Here they are just spaces (already). They were removed by * TclSubstTokens via TclParseBackslash. * * *clNextPtrPtr <=> We have continuation lines to track. * **clNextPtrPtr >= 0 <=> We are not beyond the last possible location. * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line. */ while (*clNextPtrPtr && (**clNextPtrPtr >= 0) && (loc >= **clNextPtrPtr)) { /* * We just stepped over an invisible continuation line. Adjust the * line counter and step to the table entry holding the location of * the next continuation line to track. */ (*line)++; (*clNextPtrPtr)++; } } /* *---------------------------------------------------------------------- * Note: The whole data structure access for argument location tracking is * hidden behind these three functions. The only parts open are the lineLAPtr * field in the Interp structure. The CFWord definition is internal to here. * Should make it easier to redo the data structures if we find something more * space/time efficient. */ /* *---------------------------------------------------------------------- * * TclArgumentEnter -- * * This procedure is a helper for the TIP #280 uplevel extension. It * enters location references for the arguments of a command to be * invoked. Only the first entry has the actual data, further entries * simply count the usage up. * * Results: * None. * * Side effects: * May allocate memory. * * TIP #280 *---------------------------------------------------------------------- */ void TclArgumentEnter( Tcl_Interp *interp, Tcl_Obj **objv, int objc, CmdFrame *cfPtr) { Interp *iPtr = (Interp *) interp; int isNew, i; Tcl_HashEntry *hPtr; CFWord *cfwPtr; for (i = 1; i < objc; i++) { /* * Ignore argument words without line information (= dynamic). If they * are variables they may have location information associated with * that, either through globally recorded 'set' invocations, or * literals in bytecode. Either way there is no need to record * something here. */ if (cfPtr->line[i] < 0) { continue; } hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew); if (isNew) { /* * The word is not on the stack yet, remember the current location * and initialize references. */ cfwPtr = (CFWord *)ckalloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; cfwPtr->word = i; cfwPtr->refCount = 1; Tcl_SetHashValue(hPtr, cfwPtr); } else { /* * The word is already on the stack, its current location is not * relevant. Just remember the reference to prevent early removal. */ cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); cfwPtr->refCount++; } } } /* *---------------------------------------------------------------------- * * TclArgumentRelease -- * * This procedure is a helper for the TIP #280 uplevel extension. It * removes the location references for the arguments of a command just * done. Usage is counted down, the data is removed only when no user is * left over. * * Results: * None. * * Side effects: * May release memory. * * TIP #280 *---------------------------------------------------------------------- */ void TclArgumentRelease( Tcl_Interp *interp, Tcl_Obj **objv, int objc) { Interp *iPtr = (Interp *) interp; int i; for (i = 1; i < objc; i++) { CFWord *cfwPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]); if (!hPtr) { continue; } cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); if (cfwPtr->refCount-- > 1) { continue; } ckfree(cfwPtr); Tcl_DeleteHashEntry(hPtr); } } /* *---------------------------------------------------------------------- * * TclArgumentBCEnter -- * * This procedure is a helper for the TIP #280 uplevel extension. It * enters location references for the literal arguments of commands in * bytecode about to be invoked. Only the first entry has the actual * data, further entries simply count the usage up. * * Results: * None. * * Side effects: * May allocate memory. * * TIP #280 *---------------------------------------------------------------------- */ void TclArgumentBCEnter( Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, int pc) { ExtCmdLoc *eclPtr; int word; ECL *ePtr; CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr); if (!hePtr) { return; } eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); ePtr = &eclPtr->loc[cmd]; /* * ePtr->nline is the number of words originally parsed. * * objc is the number of elements getting invoked. * * If they are not the same, we arrived here by compiling an * ensemble dispatch. Ensemble subcommands that lead to script * evaluation are not supposed to get compiled, because a command * such as [info level] in the script can expose some of the dispatch * shenanigans. This means that we don't have to tend to the * housekeeping, and can escape now. */ if (ePtr->nline != objc) { return; } /* * Having disposed of the ensemble cases, we can state... * A few truths ... * (1) ePtr->nline == objc * (2) (ePtr->line[word] < 0) => !literal, for all words * (3) (word == 0) => !literal * * Item (2) is why we can use objv to get the literals, and do not * have to save them at compile time. */ for (word = 1; word < objc; word++) { if (ePtr->line[word] >= 0) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, objv[word], &isNew); CFWordBC *cfwPtr = (CFWordBC *)ckalloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; cfwPtr->obj = objv[word]; cfwPtr->pc = pc; cfwPtr->word = word; cfwPtr->nextPtr = lastPtr; lastPtr = cfwPtr; if (isNew) { /* * The word is not on the stack yet, remember the current * location and initialize references. */ cfwPtr->prevPtr = NULL; } else { /* * The object is already on the stack, however it may have * a different location now (literal sharing may map * multiple location to a single Tcl_Obj*. Save the old * information in the new structure. */ cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, cfwPtr); } } /* for */ cfPtr->litarg = lastPtr; } /* *---------------------------------------------------------------------- * * TclArgumentBCRelease -- * * This procedure is a helper for the TIP #280 uplevel extension. It * removes the location references for the literal arguments of commands * in bytecode just done. Usage is counted down, the data is removed only * when no user is left over. * * Results: * None. * * Side effects: * May release memory. * * TIP #280 *---------------------------------------------------------------------- */ void TclArgumentBCRelease( Tcl_Interp *interp, CmdFrame *cfPtr) { Interp *iPtr = (Interp *) interp; CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg; while (cfwPtr) { CFWordBC *nextPtr = cfwPtr->nextPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj); CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); if (xPtr != cfwPtr) { Tcl_Panic("TclArgumentBC Enter/Release Mismatch"); } if (cfwPtr->prevPtr) { Tcl_SetHashValue(hPtr, cfwPtr->prevPtr); } else { Tcl_DeleteHashEntry(hPtr); } ckfree(cfwPtr); cfwPtr = nextPtr; } cfPtr->litarg = NULL; } /* *---------------------------------------------------------------------- * * TclArgumentGet -- * * This procedure is a helper for the TIP #280 uplevel extension. It * finds the location references for a Tcl_Obj, if any. * * Results: * None. * * Side effects: * Writes found location information into the result arguments. * * TIP #280 *---------------------------------------------------------------------- */ void TclArgumentGet( Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr) { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; CmdFrame *framePtr; /* * An object which either has no string rep or else is a canonical list is * guaranteed to have been generated dynamically: bail out, this cannot * have a usable absolute location. _Do not touch_ the information the set * up by the caller. It knows better than us. */ if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) { return; } /* * First look for location information recorded in the argument * stack. That is nearest. */ hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj); if (hPtr) { CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); *wordPtr = cfwPtr->word; *cfPtrPtr = cfwPtr->framePtr; return; } /* * Check if the Tcl_Obj has location information as a bytecode literal, in * that stack. */ hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj); if (hPtr) { CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); framePtr = cfwPtr->framePtr; framePtr->data.tebc.pc = (char *) (((ByteCode *) framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc); *cfPtrPtr = cfwPtr->framePtr; *wordPtr = cfwPtr->word; return; } } /* *---------------------------------------------------------------------- * * Tcl_Eval -- * * Execute a Tcl command in a string. This function executes the script * directly, rather than compiling it to bytecodes. Before the arrival of * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used * for executing Tcl commands, but nowadays it isn't used much. * * Results: * The return value is one of the return codes defined in tcl.h (such as * TCL_OK), and interp's result contains a value to supplement the return * code. The value of the result will persist only until the next call to * Tcl_Eval or Tcl_EvalObj: you must copy it or lose it! * * Side effects: * Can be almost arbitrary, depending on the commands in the script. * *---------------------------------------------------------------------- */ #undef Tcl_Eval int Tcl_Eval( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ const char *script) /* Pointer to TCL command to execute. */ { int code = Tcl_EvalEx(interp, script, -1, 0); /* * For backwards compatibility with old C code that predates the object * system in Tcl 8.0, we have to mirror the object result back into the * string result (some callers may expect it there). */ (void) Tcl_GetStringResult(interp); return code; } /* *---------------------------------------------------------------------- * * Tcl_EvalObj, Tcl_GlobalEvalObj -- * * These functions are deprecated but we keep them around for backwards * compatibility reasons. * * Results: * See the functions they call. * * Side effects: * See the functions they call. * *---------------------------------------------------------------------- */ #undef Tcl_EvalObj int Tcl_EvalObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { return Tcl_EvalObjEx(interp, objPtr, 0); } #undef Tcl_GlobalEvalObj int Tcl_GlobalEvalObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); } /* *---------------------------------------------------------------------- * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is * specified. * * If the flag TCL_EVAL_DIRECT is passed in, the value of invoker * must be NULL. Support for non-NULL invokers in that mode has * been removed since it was unused and untested. Failure to * follow this limitation will lead to an assertion panic. * * Results: * The return value is one of the return codes defined in tcl.h (such as * TCL_OK), and the interpreter's result contains a value to supplement * the return code. * * Side effects: * The object is converted, if necessary, to a ByteCode object that holds * the bytecode instructions for the commands. Executing the commands * will almost certainly have side effects that depend on those commands. * * TIP #280 : Keep public API, internally extended API. *---------------------------------------------------------------------- */ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { return TclEvalObjEx(interp, objPtr, flags, NULL, 0); } int TclEvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ int word) /* Index of the word which is in objPtr. */ { int result = TCL_OK; NRE_callback *rootPtr = TOP_CB(interp); result = TclNREvalObjEx(interp, objPtr, flags, invoker, word); return TclNRRunCallbacks(interp, result, rootPtr); } int TclNREvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ int word) /* Index of the word which is in objPtr. */ { Interp *iPtr = (Interp *) interp; int result; /* * This function consists of three independent blocks for: direct * evaluation of canonical lists, compilation and bytecode execution and * finally direct evaluation. Precisely one of these blocks will be run. */ if (TclListObjIsCanonical(objPtr)) { CmdFrame *eoFramePtr = NULL; int objc; Tcl_Obj *listPtr, **objv; /* * Canonical List Optimization: In this case, we * can safely use Tcl_EvalObjv instead and get an appreciable * improvement in execution speed. This is because it allows us to * avoid a setFromAny step that would just pack everything into a * string and back out again. * * This also preserves any associations between list elements and * location information for such elements. */ /* * Shimmer protection! Always pass an unshared obj. The caller could * incr the refCount of objPtr AFTER calling us! To be completely safe * we always make a copy. The callback takes care of the refCounts for * both listPtr and objPtr. * * TODO: Create a test to demo this need, or eliminate it. * FIXME OPT: preserve just the internal rep? */ Tcl_IncrRefCount(objPtr); listPtr = TclListObjCopy(interp, objPtr); Tcl_IncrRefCount(listPtr); if (word != INT_MIN) { /* * TIP #280 Structures for tracking lines. As we know that this is * dynamic execution we ignore the invoker, even if known. * * TIP #280. We do _not_ compute all the line numbers for the * words in the command. For the eval of a pure list the most * sensible choice is to put all words on line 1. Given that we * neither need memory for them nor compute anything. 'line' is * left NULL. The two places using this information (TclInfoFrame, * and TclInitCompileEnv), are special-cased to use the proper * line number directly instead of accessing the 'line' array. * * Note that we use (word==INTMIN) to signal that no command frame * should be pushed, as needed by alias and ensemble redirections. */ eoFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; eoFramePtr->type = TCL_LOCATION_EVAL; eoFramePtr->level = (iPtr->cmdFramePtr == NULL? 1 : iPtr->cmdFramePtr->level + 1); eoFramePtr->framePtr = iPtr->framePtr; eoFramePtr->nextPtr = iPtr->cmdFramePtr; eoFramePtr->cmdObj = objPtr; eoFramePtr->cmd = NULL; eoFramePtr->len = 0; eoFramePtr->data.eval.path = NULL; iPtr->cmdFramePtr = eoFramePtr; flags |= TCL_EVAL_SOURCE_IN_FRAME; } TclMarkTailcall(interp); TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); ListObjGetElements(listPtr, objc, objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } if (!(flags & TCL_EVAL_DIRECT)) { /* * Let the compiler/engine subsystem do the evaluation. * * TIP #280 The invoker provides us with the context for the script. * We transfer this to the byte code compiler. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); ByteCode *codePtr; CallFrame *savedVarFramePtr = NULL; /* Saves old copy of * iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } if (flags & TCL_EVAL_GLOBAL) { savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; } Tcl_IncrRefCount(objPtr); codePtr = TclCompileObj(interp, objPtr, invoker, word); TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); return TclNRExecuteByteCode(interp, codePtr); } { /* * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). */ const char *script; int numSrcBytes; /* * Now we check if we have data about invisible continuation lines for * the script, and make it available to the direct script parser and * evaluator we are about to call, if so. * * It may be possible that the script Tcl_Obj* can be free'd while the * evaluator is using it, leading to the release of the associated * ContLineLoc structure as well. To ensure that the latter doesn't * happen we set a lock on it. We release this lock later in this * function, after the evaluator is done. The relevant "lineCLPtr" * hashtable is managed in the file "tclObj.c". * * Another important action is to save (and later restore) the * continuation line information of the caller, in case we are * executing nested commands in the eval/direct path. */ ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr; assert(invoker == NULL); iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr); Tcl_IncrRefCount(objPtr); script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); TclDecrRefCount(objPtr); iPtr->scriptCLLocPtr = saveCLLocPtr; return result; } } static int TEOEx_ByteCodeCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; CallFrame *savedVarFramePtr = (CallFrame *)data[0]; Tcl_Obj *objPtr = (Tcl_Obj *)data[1]; int allowExceptions = PTR2INT(data[2]); if (iPtr->numLevels == 0) { if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; int numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); Tcl_LogCommandInfo(interp, script, script, numSrcBytes); } /* * We are returning to level 0, so should call TclResetCancellation. * Let us just unset the flags inline. */ TclUnsetCancelFlags(iPtr); } iPtr->evalFlags = 0; /* * Restore the callFrame if this was a TCL_EVAL_GLOBAL. */ if (savedVarFramePtr) { iPtr->varFramePtr = savedVarFramePtr; } TclDecrRefCount(objPtr); return result; } static int TEOEx_ListCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; CmdFrame *eoFramePtr = (CmdFrame *)data[1]; Tcl_Obj *objPtr = (Tcl_Obj *)data[2]; /* * Remove the cmdFrame */ if (eoFramePtr) { iPtr->cmdFramePtr = eoFramePtr->nextPtr; TclStackFree(interp, eoFramePtr); } TclDecrRefCount(objPtr); TclDecrRefCount(listPtr); return result; } /* *---------------------------------------------------------------------- * * ProcessUnexpectedResult -- * * Function called by Tcl_EvalObj to set the interpreter's result value * to an appropriate error message when the code it evaluates returns an * unexpected result code (not TCL_OK and not TCL_ERROR) to the topmost * evaluation level. * * Results: * None. * * Side effects: * The interpreter result is set to an error message appropriate to the * result code. * *---------------------------------------------------------------------- */ static void ProcessUnexpectedResult( Tcl_Interp *interp, /* The interpreter in which the unexpected * result code was returned. */ int returnCode) /* The unexpected result code. */ { char buf[TCL_INTEGER_SPACE]; Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "invoked \"break\" outside of a loop", -1)); } else if (returnCode == TCL_CONTINUE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "invoked \"continue\" outside of a loop", -1)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "command returned bad code: %d", returnCode)); } snprintf(buf, sizeof(buf), "%d", returnCode); Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL); } /* *--------------------------------------------------------------------------- * * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean -- * * Functions to evaluate an expression and return its value in a * particular form. * * Results: * Each of the functions below returns a standard Tcl result. If an error * occurs then an error message is left in the interp's result. Otherwise * the value of the expression, in the appropriate form, is stored at * *ptr. If the expression had a result that was incompatible with the * desired form then an error is returned. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tcl_ExprLong( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ long *ptr) /* Where to store result. */ { Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0; } else { exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); if (result != TCL_OK) { (void) Tcl_GetStringResult(interp); } } return result; } int Tcl_ExprDouble( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ double *ptr) /* Where to store result. */ { Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0.0; } else { exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ if (result != TCL_OK) { (void) Tcl_GetStringResult(interp); } } return result; } int Tcl_ExprBoolean( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ int *ptr) /* Where to store 0/1 result. */ { if (*exprstring == '\0') { /* * An empty string. Just set the result boolean to 0 (false). */ *ptr = 0; return TCL_OK; } else { int result; Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); if (result != TCL_OK) { /* * Move the interpreter's object result to the string result, then * reset the object result. */ (void) Tcl_GetStringResult(interp); } return result; } } /* *-------------------------------------------------------------- * * Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj -- * * Functions to evaluate an expression in an object and return its value * in a particular form. * * Results: * Each of the functions below returns a standard Tcl result object. If * an error occurs then an error message is left in the interpreter's * result. Otherwise the value of the expression, in the appropriate * form, is stored at *ptr. If the expression had a result that was * incompatible with the desired form then an error is returned. * * Side effects: * None. * *-------------------------------------------------------------- */ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; int result, type; double d; ClientData internalPtr; result = Tcl_ExprObj(interp, objPtr, &resultPtr); if (result != TCL_OK) { return TCL_ERROR; } if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) { return TCL_ERROR; } switch (type) { case TCL_NUMBER_DOUBLE: { mp_int big; d = *((const double *) internalPtr); Tcl_DecrRefCount(resultPtr); if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewBignumObj(&big); } /* FALLTHRU */ case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: case TCL_NUMBER_BIG: result = TclGetLongFromObj(interp, resultPtr, ptr); break; case TCL_NUMBER_NAN: Tcl_GetDoubleFromObj(interp, resultPtr, &d); result = TCL_ERROR; } Tcl_DecrRefCount(resultPtr);/* Discard the result object. */ return result; } int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; int result, type; ClientData internalPtr; result = Tcl_ExprObj(interp, objPtr, &resultPtr); if (result != TCL_OK) { return TCL_ERROR; } result = TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type); if (result == TCL_OK) { switch (type) { case TCL_NUMBER_NAN: #ifndef ACCEPT_NAN result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr); break; #endif case TCL_NUMBER_DOUBLE: *ptr = *((const double *) internalPtr); result = TCL_OK; break; default: result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr); } } Tcl_DecrRefCount(resultPtr);/* Discard the result object. */ return result; } int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ int *ptr) /* Where to store 0/1 result. */ { Tcl_Obj *resultPtr; int result; result = Tcl_ExprObj(interp, objPtr, &resultPtr); if (result == TCL_OK) { result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); Tcl_DecrRefCount(resultPtr); /* Discard the result object. */ } return result; } /* *---------------------------------------------------------------------- * * TclObjInvokeNamespace -- * * Object version: Invokes a Tcl command, given an objv/objc, from either * the exposed or hidden set of commands in the given interpreter. * * NOTE: The command is invoked in the global stack frame of the * interpreter or namespace, thus it cannot see any current state on the * stack of that interpreter. * * Results: * A standard Tcl result. * * Side effects: * Whatever the command does. * *---------------------------------------------------------------------- */ int TclObjInvokeNamespace( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ int objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ Tcl_Namespace *nsPtr, /* The namespace to use. */ int flags) /* Combination of flags controlling the call: * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN, * or TCL_INVOKE_NO_TRACEBACK. */ { int result; Tcl_CallFrame *framePtr; /* * Make the specified namespace the current namespace and invoke the * command. */ (void) TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0); result = TclObjInvoke(interp, objc, objv, flags); TclPopStackFrame(interp); return result; } /* *---------------------------------------------------------------------- * * TclObjInvoke -- * * Invokes a Tcl command, given an objv/objc, from either the exposed or * the hidden sets of commands in the given interpreter. * * Results: * A standard Tcl object result. * * Side effects: * Whatever the command does. * *---------------------------------------------------------------------- */ int TclObjInvoke( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ int objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ int flags) /* Combination of flags controlling the call: * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN, * or TCL_INVOKE_NO_TRACEBACK. */ { if (interp == NULL) { return TCL_ERROR; } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal argument vector", -1)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN"); } return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv); } int TclNRInvoke( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ const char *cmdName; /* Name of the command from objv[0]. */ Tcl_HashEntry *hPtr = NULL; Command *cmdPtr; cmdName = TclGetString(objv[0]); hTblPtr = iPtr->hiddenCmdTablePtr; if (hTblPtr != NULL) { hPtr = Tcl_FindHashEntry(hTblPtr, cmdName); } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid hidden command name \"%s\"", cmdName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Avoid the exception-handling brain damage when numLevels == 0 */ iPtr->numLevels++; Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL); /* * Normal command resolution of objv[0] isn't going to find cmdPtr. * That's the whole point of **hidden** commands. So tell the Eval core * machinery not to even try (and risk finding something wrong). */ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr); } static int NRPostInvoke( ClientData clientData[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *)interp; iPtr->numLevels--; return result; } /* *--------------------------------------------------------------------------- * * Tcl_ExprString -- * * Evaluate an expression in a string and return its value in string * form. * * Results: * A standard Tcl result. If the result is TCL_OK, then the interp's * result is set to the string value of the expression. If the result is * TCL_ERROR, then the interp's result contains an error message. * * Side effects: * A Tcl object is allocated to hold a copy of the expression string. * This expression object is passed to Tcl_ExprObj and then deallocated. * *--------------------------------------------------------------------------- */ int Tcl_ExprString( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *expr) /* Expression to evaluate. */ { int code = TCL_OK; if (expr[0] == '\0') { /* * An empty string. Just set the interpreter's result to 0. */ Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } else { Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1); Tcl_IncrRefCount(exprObj); code = Tcl_ExprObj(interp, exprObj, &resultPtr); Tcl_DecrRefCount(exprObj); if (code == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); Tcl_DecrRefCount(resultPtr); } } /* * Force the string rep of the interp result. */ (void) Tcl_GetStringResult(interp); return code; } /* *---------------------------------------------------------------------- * * Tcl_AppendObjToErrorInfo -- * * Add a Tcl_Obj value to the errorInfo field that describes the current * error. * * Results: * None. * * Side effects: * The value of the Tcl_obj is appended to the errorInfo field. If we are * just starting to log an error, errorInfo is initialized from the error * message in the interpreter's result. * *---------------------------------------------------------------------- */ #undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { int length; const char *message = TclGetStringFromObj(objPtr, &length); Tcl_IncrRefCount(objPtr); Tcl_AddObjErrorInfo(interp, message, length); Tcl_DecrRefCount(objPtr); } /* *---------------------------------------------------------------------- * * Tcl_AddErrorInfo -- * * Add information to the errorInfo field that describes the current * error. * * Results: * None. * * Side effects: * The contents of message are appended to the errorInfo field. If we are * just starting to log an error, errorInfo is initialized from the error * message in the interpreter's result. * *---------------------------------------------------------------------- */ #undef Tcl_AddErrorInfo void Tcl_AddErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ const char *message) /* Message to record. */ { Tcl_AddObjErrorInfo(interp, message, -1); } /* *---------------------------------------------------------------------- * * Tcl_AddObjErrorInfo -- * * Add information to the errorInfo field that describes the current * error. This routine differs from Tcl_AddErrorInfo by taking a byte * pointer and length. * * Results: * None. * * Side effects: * "length" bytes from "message" are appended to the errorInfo field. If * "length" is negative, use bytes up to the first NULL byte. If we are * just starting to log an error, errorInfo is initialized from the error * message in the interpreter's result. * *---------------------------------------------------------------------- */ void Tcl_AddObjErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ const char *message, /* Points to the first byte of an array of * bytes of the message. */ int length) /* The number of bytes in the message. If < 0, * then append all bytes up to a NULL byte. */ { Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from * the error message in the interpreter's result. */ iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { if (iPtr->result[0] != 0) { /* * The interp's string result is set, apparently by some extension * making a deprecated direct write to it. That extension may * expect interp->result to continue to be set, so we'll take * special pains to avoid clearing it, until we drop support for * interp->result completely. */ iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); } else { iPtr->errorInfo = iPtr->objResultPtr; } Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); } } /* * Now append "message" to the end of errorInfo. */ if (length != 0) { if (Tcl_IsShared(iPtr->errorInfo)) { Tcl_DecrRefCount(iPtr->errorInfo); iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo); Tcl_IncrRefCount(iPtr->errorInfo); } Tcl_AppendToObj(iPtr->errorInfo, message, length); } } /* *--------------------------------------------------------------------------- * * Tcl_VarEvalVA -- * * Given a variable number of string arguments, concatenate them all * together and execute the result as a Tcl command. * * Results: * A standard Tcl return result. An error message or other result may be * left in the interp's result. * * Side effects: * Depends on what was done by the command. * *--------------------------------------------------------------------------- */ int Tcl_VarEvalVA( Tcl_Interp *interp, /* Interpreter in which to evaluate command */ va_list argList) /* Variable argument list. */ { Tcl_DString buf; char *string; int result; /* * Copy the strings one after the other into a single larger string. Use * stack-allocated space for small commands, but if the command gets too * large than call ckalloc to create the space. */ Tcl_DStringInit(&buf); while (1) { string = va_arg(argList, char *); if (string == NULL) { break; } Tcl_DStringAppend(&buf, string, -1); } result = Tcl_Eval(interp, Tcl_DStringValue(&buf)); Tcl_DStringFree(&buf); return result; } /* *---------------------------------------------------------------------- * * Tcl_VarEval -- * * Given a variable number of string arguments, concatenate them all * together and execute the result as a Tcl command. * * Results: * A standard Tcl return result. An error message or other result may be * left in interp->result. * * Side effects: * Depends on what was done by the command. * *---------------------------------------------------------------------- */ int Tcl_VarEval( Tcl_Interp *interp, ...) { va_list argList; int result; va_start(argList, interp); result = Tcl_VarEvalVA(interp, argList); va_end(argList); return result; } /* *---------------------------------------------------------------------- * * Tcl_GlobalEval -- * * Evaluate a command at global level in an interpreter. * * Results: * A standard Tcl result is returned, and the interp's result is modified * accordingly. * * Side effects: * The command string is executed in interp, and the execution is carried * out in the variable context of global level (no functions active), * just as if an "uplevel #0" command were being executed. * *---------------------------------------------------------------------- */ #undef Tcl_GlobalEval int Tcl_GlobalEval( Tcl_Interp *interp, /* Interpreter in which to evaluate * command. */ const char *command) /* Command to evaluate. */ { Interp *iPtr = (Interp *) interp; int result; CallFrame *savedVarFramePtr; savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; result = Tcl_Eval(interp, command); iPtr->varFramePtr = savedVarFramePtr; return result; } /* *---------------------------------------------------------------------- * * Tcl_SetRecursionLimit -- * * Set the maximum number of recursive calls that may be active for an * interpreter at once. * * Results: * The return value is the old limit on nesting for interp. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_SetRecursionLimit( Tcl_Interp *interp, /* Interpreter whose nesting limit is to be * set. */ int depth) /* New value for maximum depth. */ { Interp *iPtr = (Interp *) interp; int old; old = iPtr->maxNestingDepth; if (depth > 0) { iPtr->maxNestingDepth = depth; } return old; } /* *---------------------------------------------------------------------- * * Tcl_AllowExceptions -- * * Sets a flag in an interpreter so that exceptions can occur in the next * call to Tcl_Eval without them being turned into errors. * * Results: * None. * * Side effects: * The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's evalFlags * structure. See the reference documentation for more details. * *---------------------------------------------------------------------- */ void Tcl_AllowExceptions( Tcl_Interp *interp) /* Interpreter in which to set flag. */ { Interp *iPtr = (Interp *) interp; iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS; } /* *---------------------------------------------------------------------- * * Tcl_GetVersion -- * * Get the Tcl major, minor, and patchlevel version numbers and the * release type. A patch is a release type TCL_FINAL_RELEASE with a * patchLevel > 0. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_GetVersion( int *majorV, int *minorV, int *patchLevelV, int *type) { if (majorV != NULL) { *majorV = TCL_MAJOR_VERSION; } if (minorV != NULL) { *minorV = TCL_MINOR_VERSION; } if (patchLevelV != NULL) { *patchLevelV = TCL_RELEASE_SERIAL; } if (type != NULL) { *type = TCL_RELEASE_LEVEL; } } /* *---------------------------------------------------------------------- * * Math Functions -- * * This page contains the functions that implement all of the built-in * math functions for expressions. * * Results: * Each function returns TCL_OK if it succeeds and pushes an Tcl object * holding the result. If it fails it returns TCL_ERROR and leaves an * error message in the interpreter's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ExprCeilFunc( ClientData clientData, /* Ignored */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter list. */ { int code; double d; mp_int big; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } #endif if (code != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclCeil(&big))); mp_clear(&big); } else { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ceil(d))); } return TCL_OK; } static int ExprFloorFunc( ClientData clientData, /* Ignored */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter list. */ { int code; double d; mp_int big; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } #endif if (code != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclFloor(&big))); mp_clear(&big); } else { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(floor(d))); } return TCL_OK; } static int ExprIsqrtFunc( ClientData clientData, /* Ignored */ Tcl_Interp *interp, /* The interpreter in which to execute. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter list. */ { ClientData ptr; int type; double d; Tcl_WideInt w; mp_int big; int exact = 0; /* Flag ==1 if the argument can be represented * in a double as an exact integer. */ /* * Check syntax. */ if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } /* * Make sure that the arg is a number. */ if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } switch (type) { case TCL_NUMBER_NAN: Tcl_GetDoubleFromObj(interp, objv[1], &d); return TCL_ERROR; case TCL_NUMBER_DOUBLE: d = *((const double *) ptr); if (d < 0) { goto negarg; } #ifdef IEEE_FLOATING_POINT if (d <= MAX_EXACT) { exact = 1; } #endif if (!exact) { if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { return TCL_ERROR; } } break; case TCL_NUMBER_BIG: if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) { return TCL_ERROR; } if (big.sign) { mp_clear(&big); goto negarg; } break; default: if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) { return TCL_ERROR; } if (w < 0) { goto negarg; } d = (double) w; #ifdef IEEE_FLOATING_POINT if (d < MAX_EXACT) { exact = 1; } #endif if (!exact) { Tcl_GetBignumFromObj(interp, objv[1], &big); } break; } if (exact) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d))); } else { mp_int root; mp_init(&root); mp_sqrt(&big, &root); mp_clear(&big); Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root)); } return TCL_OK; negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( "square root of negative argument", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); return TCL_ERROR; } static int ExprSqrtFunc( ClientData clientData, /* Ignored */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter list. */ { int code; double d; mp_int big; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } #endif if (code != TCL_OK) { return TCL_ERROR; } if ((d >= 0.0) && TclIsInfinite(d) && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) { mp_int root; mp_init(&root); mp_sqrt(&big, &root); mp_clear(&big); Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclBignumToDouble(&root))); mp_clear(&root); } else { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d))); } return TCL_OK; } static int ExprUnaryFunc( ClientData clientData, /* Contains the address of a function that * takes one double argument and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Actual parameter list */ { int code; double d; double (*func)(double) = (double (*)(double)) clientData; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { d = objv[1]->internalRep.doubleValue; Tcl_ResetResult(interp); code = TCL_OK; } #endif if (code != TCL_OK) { return TCL_ERROR; } errno = 0; return CheckDoubleResult(interp, func(d)); } static int CheckDoubleResult( Tcl_Interp *interp, double dResult) { #ifndef ACCEPT_NAN if (TclIsNaN(dResult)) { TclExprFloatError(interp, dResult); return TCL_ERROR; } #endif if ((errno == ERANGE) && ((dResult == 0.0) || TclIsInfinite(dResult))) { /* * When ERANGE signals under/overflow, just accept 0.0 or +/-Inf */ } else if (errno != 0) { /* * Report other errno values as errors. */ TclExprFloatError(interp, dResult); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult)); return TCL_OK; } static int ExprBinaryFunc( ClientData clientData, /* Contains the address of a function that * takes two double arguments and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { int code; double d1, d2; double (*func)(double, double) = (double (*)(double, double)) clientData; if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d1); #ifdef ACCEPT_NAN if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { d1 = objv[1]->internalRep.doubleValue; Tcl_ResetResult(interp); code = TCL_OK; } #endif if (code != TCL_OK) { return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[2], &d2); #ifdef ACCEPT_NAN if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) { d2 = objv[2]->internalRep.doubleValue; Tcl_ResetResult(interp); code = TCL_OK; } #endif if (code != TCL_OK) { return TCL_ERROR; } errno = 0; return CheckDoubleResult(interp, func(d1, d2)); } static int ExprAbsFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { ClientData ptr; int type; mp_int big; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_LONG) { long l = *((const long *) ptr); if (l > (long)0) { goto unChanged; } else if (l == (long)0) { const char *string = objv[1]->bytes; if (string) { while (*string != '0') { if (*string == '-') { Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); return TCL_OK; } string++; } } goto unChanged; } else if (l == LONG_MIN) { TclBNInitBignumFromLong(&big, l); goto tooLarge; } Tcl_SetObjResult(interp, Tcl_NewLongObj(-l)); return TCL_OK; } if (type == TCL_NUMBER_DOUBLE) { double d = *((const double *) ptr); static const double poszero = 0.0; /* * We need to distinguish here between positive 0.0 and negative -0.0. * [Bug 2954959] */ if (d == -0.0) { if (!memcmp(&d, &poszero, sizeof(double))) { goto unChanged; } } else if (d > -0.0) { goto unChanged; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d)); return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { Tcl_WideInt w = *((const Tcl_WideInt *) ptr); if (w >= (Tcl_WideInt)0) { goto unChanged; } if (w == LLONG_MIN) { TclBNInitBignumFromWideInt(&big, w); goto tooLarge; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w)); return TCL_OK; } #endif if (type == TCL_NUMBER_BIG) { if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) { Tcl_GetBignumFromObj(NULL, objv[1], &big); tooLarge: (void)mp_neg(&big, &big); Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); } else { unChanged: Tcl_SetObjResult(interp, objv[1]); } return TCL_OK; } if (type == TCL_NUMBER_NAN) { #ifdef ACCEPT_NAN Tcl_SetObjResult(interp, objv[1]); return TCL_OK; #else double d; Tcl_GetDoubleFromObj(interp, objv[1], &d); return TCL_ERROR; #endif } return TCL_OK; } static int ExprBoolFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { int value; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[1], &value) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); return TCL_OK; } static int ExprDoubleFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { double dResult; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) { #ifdef ACCEPT_NAN if (objv[1]->typePtr == &tclDoubleType) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } #endif return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult)); return TCL_OK; } static int ExprEntierFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { double d; int type; ClientData ptr; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); if ((d < (double)LONG_MAX) && (d > (double)LONG_MIN)) { long result = (long) d; Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); return TCL_OK; #ifndef TCL_WIDE_INT_IS_LONG } else if ((d < (double)LLONG_MAX) && (d > (double)LLONG_MIN)) { Tcl_WideInt result = (Tcl_WideInt) d; Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); return TCL_OK; #endif } else { mp_int big; if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } } if (type != TCL_NUMBER_NAN) { /* * All integers are already of integer type. */ Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* * Get the error message for NaN. */ Tcl_GetDoubleFromObj(interp, objv[1], &d); return TCL_ERROR; } static int ExprIntFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { long iResult; Tcl_Obj *objPtr; if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) { return TCL_ERROR; } objPtr = Tcl_GetObjResult(interp); if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) { /* * Truncate the bignum; keep only bits in long range. */ mp_int big; Tcl_GetBignumFromObj(NULL, objPtr, &big); mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); objPtr = Tcl_NewBignumObj(&big); Tcl_IncrRefCount(objPtr); TclGetLongFromObj(NULL, objPtr, &iResult); Tcl_DecrRefCount(objPtr); } Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult)); return TCL_OK; } static int ExprWideFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { Tcl_WideInt wResult; Tcl_Obj *objPtr; if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) { return TCL_ERROR; } objPtr = Tcl_GetObjResult(interp); if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) { /* * Truncate the bignum; keep only bits in wide int range. */ mp_int big; Tcl_GetBignumFromObj(NULL, objPtr, &big); mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big); objPtr = Tcl_NewBignumObj(&big); Tcl_IncrRefCount(objPtr); TclGetWideIntFromObj(NULL, objPtr, &wResult); Tcl_DecrRefCount(objPtr); } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult)); return TCL_OK; } static int ExprRandFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { Interp *iPtr = (Interp *) interp; double dResult; long tmp; /* Algorithm assumes at least 32 bits. Only * long guarantees that. See below. */ Tcl_Obj *oResult; if (objc != 1) { MathFuncWrongNumArgs(interp, 1, objc, objv); return TCL_ERROR; } if (!(iPtr->flags & RAND_SEED_INITIALIZED)) { iPtr->flags |= RAND_SEED_INITIALIZED; /* * To ensure different seeds in different threads (bug #416643), * take into consideration the thread this interp is running in. */ iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U; /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. */ iPtr->randSeed &= 0x7FFFFFFFL; if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFFL)) { iPtr->randSeed ^= 123459876L; } } /* * Generate the random number using the linear congruential generator * defined by the following recurrence: * seed = ( IA * seed ) mod IM * where IA is 16807 and IM is (2^31) - 1. The recurrence maps a seed in * the range [1, IM - 1] to a new seed in that same range. The recurrence * maps IM to 0, and maps 0 back to 0, so those two values must not be * allowed as initial values of seed. * * In order to avoid potential problems with integer overflow, the * recurrence is implemented in terms of additional constants IQ and IR * such that * IM = IA*IQ + IR * None of the operations in the implementation overflows a 32-bit signed * integer, and the C type long is guaranteed to be at least 32 bits wide. * * For more details on how this algorithm works, refer to the following * papers: * * S.K. Park & K.W. Miller, "Random number generators: good ones are hard * to find," Comm ACM 31(10):1192-1201, Oct 1988 * * W.H. Press & S.A. Teukolsky, "Portable random number generators," * Computers in Physics 6(5):522-524, Sep/Oct 1992. */ #define RAND_IA 16807 #define RAND_IM 2147483647 #define RAND_IQ 127773 #define RAND_IR 2836 #define RAND_MASK 123459876 tmp = iPtr->randSeed/RAND_IQ; iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp; if (iPtr->randSeed < 0) { iPtr->randSeed += RAND_IM; } /* * Since the recurrence keeps seed values in the range [1, RAND_IM - 1], * dividing by RAND_IM yields a double in the range (0, 1). */ dResult = iPtr->randSeed * (1.0/RAND_IM); /* * Push a Tcl object with the result. */ TclNewDoubleObj(oResult, dResult); Tcl_SetObjResult(interp, oResult); return TCL_OK; } static int ExprRoundFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { double d; ClientData ptr; int type; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_DOUBLE) { double fractPart, intPart; long max = LONG_MAX, min = LONG_MIN; fractPart = modf(*((const double *) ptr), &intPart); if (fractPart <= -0.5) { min++; } else if (fractPart >= 0.5) { max--; } if ((intPart >= (double)max) || (intPart <= (double)min)) { mp_int big; if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } if (fractPart <= -0.5) { mp_sub_d(&big, 1, &big); } else if (fractPart >= 0.5) { mp_add_d(&big, 1, &big); } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } else { long result = (long)intPart; if (fractPart <= -0.5) { result--; } else if (fractPart >= 0.5) { result++; } Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); return TCL_OK; } } if (type != TCL_NUMBER_NAN) { /* * All integers are already rounded */ Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* * Get the error message for NaN. */ Tcl_GetDoubleFromObj(interp, objv[1], &d); return TCL_ERROR; } static int ExprSrandFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { Interp *iPtr = (Interp *) interp; long i = 0; /* Initialized to avoid compiler warning. */ /* * Convert argument and use it to reset the seed. */ if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) { Tcl_Obj *objPtr; mp_int big; if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) { /* TODO: more ::errorInfo here? or in caller? */ return TCL_ERROR; } mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); objPtr = Tcl_NewBignumObj(&big); Tcl_IncrRefCount(objPtr); TclGetLongFromObj(NULL, objPtr, &i); Tcl_DecrRefCount(objPtr); } /* * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in * ExprRandFunc for more details. */ iPtr->flags |= RAND_SEED_INITIALIZED; iPtr->randSeed = i; iPtr->randSeed &= (unsigned long) 0x7FFFFFFF; if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFF)) { iPtr->randSeed ^= 123459876; } /* * To avoid duplicating the random number generation code we simply clean * up our state and call the real random number function. That function * will always succeed. */ return ExprRandFunc(clientData, interp, 1, objv); } /* *---------------------------------------------------------------------- * * MathFuncWrongNumArgs -- * * Generate an error message when a math function presents the wrong * number of arguments. * * Results: * None. * * Side effects: * An error message is stored in the interpreter result. * *---------------------------------------------------------------------- */ static void MathFuncWrongNumArgs( Tcl_Interp *interp, /* Tcl interpreter */ int expected, /* Formal parameter count. */ int found, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { const char *name = Tcl_GetString(objv[0]); const char *tail = name + strlen(name); while (tail > name+1) { tail--; if (*tail == ':' && tail[-1] == ':') { name = tail+1; break; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s arguments for math function \"%s\"", (found < expected ? "not enough" : "too many"), name)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); } #ifdef USE_DTRACE /* *---------------------------------------------------------------------- * * DTraceObjCmd -- * * This function is invoked to process the "::tcl::dtrace" Tcl command. * * Results: * A standard Tcl object result. * * Side effects: * The 'tcl-probe' DTrace probe is triggered (if it is enabled). * *---------------------------------------------------------------------- */ static int DTraceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (TCL_DTRACE_TCL_PROBE_ENABLED()) { char *a[10]; int i = 0; while (i++ < 10) { a[i-1] = i < objc ? TclGetString(objv[i]) : NULL; } TCL_DTRACE_TCL_PROBE(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclDTraceInfo -- * * Extract information from a TIP280 dict for use by DTrace probes. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclDTraceInfo( Tcl_Obj *info, const char **args, int *argsi) { static Tcl_Obj *keys[10] = { NULL }; Tcl_Obj **k = keys, *val; int i = 0; if (!*k) { #define kini(s) TclNewLiteralStringObj(keys[i], s); i++ kini("cmd"); kini("type"); kini("proc"); kini("file"); kini("method"); kini("class"); kini("lambda"); kini("object"); kini("line"); kini("level"); #undef kini } for (i = 0; i < 6; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); args[i] = val ? TclGetString(val) : NULL; } /* * no "proc" -> use "lambda" */ if (!args[2]) { Tcl_DictObjGet(NULL, info, *k, &val); args[2] = val ? TclGetString(val) : NULL; } k++; /* * no "class" -> use "object" */ if (!args[5]) { Tcl_DictObjGet(NULL, info, *k, &val); args[5] = val ? TclGetString(val) : NULL; } k++; for (i = 0; i < 2; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); if (val) { TclGetIntFromObj(NULL, val, &argsi[i]); } else { argsi[i] = 0; } } } /* *---------------------------------------------------------------------- * * DTraceCmdReturn -- * * NR callback for DTrace command return probes. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int DTraceCmdReturn( ClientData data[], Tcl_Interp *interp, int result) { char *cmdName = TclGetString((Tcl_Obj *) data[0]); if (TCL_DTRACE_CMD_RETURN_ENABLED()) { TCL_DTRACE_CMD_RETURN(cmdName, result); } if (TCL_DTRACE_CMD_RESULT_ENABLED()) { Tcl_Obj *r = Tcl_GetObjResult(interp); TCL_DTRACE_CMD_RESULT(cmdName, result, TclGetString(r), r); } return result; } TCL_DTRACE_DEBUG_LOG() #endif /* USE_DTRACE */ /* *---------------------------------------------------------------------- * * Tcl_NRCallObjProc -- * * This function calls an objProc directly while managing things properly * if it happens to be an NR objProc. It is meant to be used by extenders * that provide an NR implementation of a command, as this function * permits a trivial coding of the non-NR objProc. * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR. A result or error message is left in interp's result. * * Side effects: * Depends on the objProc. * *---------------------------------------------------------------------- */ int Tcl_NRCallObjProc( Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]) { NRE_callback *rootPtr = TOP_CB(interp); TclNRAddCallback(interp, Dispatch, objProc, clientData, INT2PTR(objc), objv); return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } /* *---------------------------------------------------------------------- * * Tcl_NRCreateCommand -- * * Define a new NRE-enabled object-based command in a command table. * * Results: * The return value is a token for the command, which can be used in * future calls to Tcl_GetCommandName. * * Side effects: * If no command named "cmdName" already exists for interp, one is * created. Otherwise, if a command does exist, then if the object-based * Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand * was called previously for the same command and just set its * Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old * command. * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based * Tcl_ObjCmdProc proc will be called. When the command is deleted from * the table, deleteProc will be called. See the manual entry for details * on the calling sequence. * *---------------------------------------------------------------------- */ Tcl_Command Tcl_NRCreateCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ const char *cmdName, /* Name of command. If it contains namespace * qualifiers, the new command is put in the * specified namespace; otherwise it is put in * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name, provides direct access for direct * calls. */ Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with * name, provides NR implementation */ ClientData clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { Command *cmdPtr = (Command *) Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; } Tcl_Command TclNRCreateCommandInNs( Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; } /**************************************************************************** * Stuff for the public api ****************************************************************************/ int Tcl_NREvalObj( Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) { return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN); } int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ int objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and * TCL_EVAL_NOERR are currently supported. */ { return TclNREvalObjv(interp, objc, objv, flags, NULL); } int Tcl_NRCmdSwap( Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags) { return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR, (Command *) cmd); } /***************************************************************************** * Tailcall related code ***************************************************************************** * * The steps of the tailcall dance are as follows: * * 1. when [tailcall] is invoked, it stores the corresponding callback in * the current CallFrame and returns TCL_RETURN * 2. when the CallFrame is popped, it calls TclSetTailcall to store the * callback in the proper NRCommand callback - the spot where the command * that pushed the CallFrame is completely cleaned up * 3. when the NRCommand callback runs, it schedules the tailcall callback * to run immediately after it returns * * One delicate point is to properly define the NRCommand where the tailcall * will execute. There are functions whose purpose is to help define the * precise spot: * TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution * should continue right here * TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution * should continue after the CURRENT command is fully returned ("skip * the next command: we are redirecting to it, tailcalls should run * after WE return") * TclPushTailcallPoint: the search for a tailcalling spot cannot traverse * this point. This is special for OO, as some of the oo constructs * that behave like commands may not push an NRCommand callback. */ void TclMarkTailcall( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; if (iPtr->deferredCallbacks == NULL) { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); iPtr->deferredCallbacks = TOP_CB(interp); } } void TclSkipTailcall( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; TclMarkTailcall(interp); iPtr->deferredCallbacks->data[1] = INT2PTR(1); } void TclPushTailcallPoint( Tcl_Interp *interp) { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); ((Interp *) interp)->numLevels++; } /* *---------------------------------------------------------------------- * * TclSetTailcall -- * * Splice a tailcall command in the proper spot of the NRE callback * stack, so that it runs at the right time. * *---------------------------------------------------------------------- */ void TclSetTailcall( Tcl_Interp *interp, Tcl_Obj *listPtr) { /* * Find the splicing spot: right before the NRCommand of the thing * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1] * (used by command redirectors). */ NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { break; } } if (!runPtr) { Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } runPtr->data[1] = listPtr; } /* *---------------------------------------------------------------------- * * TclNRTailcallObjCmd -- * * Prepare the tailcall as a list and store it in the current * varFrame. When the frame is later popped the tailcall will be spliced * at the proper place. * * Results: * The first NRCommand callback that is not marked to be skipped is * updated so that its data[1] field contains the tailcall list. * *---------------------------------------------------------------------- */ int TclNRTailcallObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "tailcall can only be called from a proc, lambda or method", -1)); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); return TCL_ERROR; } /* * Invocation without args just clears a scheduled tailcall; invocation * with an argument replaces any previously scheduled tailcall. */ if (iPtr->varFramePtr->tailcallPtr) { Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); iPtr->varFramePtr->tailcallPtr = NULL; } /* * Create the callback to actually evaluate the tailcalled * command, then set it in the varFrame so that PopCallFrame can use it * at the proper time. */ if (objc > 1) { Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; /* * The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } /* *---------------------------------------------------------------------- * * TclNRTailcallEval -- * * This NREcallback actually causes the tailcall to be evaluated. * *---------------------------------------------------------------------- */ int TclNRTailcallEval( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; Tcl_Namespace *nsPtr; int objc; Tcl_Obj **objv; TclListObjGetElements(interp, listPtr, &objc, &objv); nsObjPtr = objv[0]; if (result == TCL_OK) { result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); } if (result != TCL_OK) { /* * Tailcall execution was preempted, eg by an intervening catch or by * a now-gone namespace: cleanup and return. */ Tcl_DecrRefCount(listPtr); return result; } /* * Perform the tailcall */ TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); } int TclNRReleaseValues( ClientData data[], Tcl_Interp *interp, int result) { int i = 0; while (i < 4) { if (data[i]) { Tcl_DecrRefCount((Tcl_Obj *) data[i]); } else { break; } i++; } return result; } void Tcl_NRAddCallback( Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3) { if (!(postProcPtr)) { Tcl_Panic("Adding a callback without an objProc?!"); } TclNRAddCallback(interp, postProcPtr, data0, data1, data2, data3); } /* *---------------------------------------------------------------------- * * TclNRCoroutineObjCmd -- (and friends) * * This object-based function is invoked to process the "coroutine" Tcl * command. It is heavily based on "apply". * * Results: * A standard Tcl object result value. * * Side effects: * A new procedure gets created. * * ** FIRST EXPERIMENTAL IMPLEMENTATION ** * * It is fairly amateurish and not up to our standards - mainly in terms of * error messages and [info] interaction. Just to test the infrastructure in * teov and tebc. *---------------------------------------------------------------------- */ #define iPtr ((Interp *) interp) int TclNRYieldObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } if (objc == 2) { Tcl_SetObjResult(interp, objv[1]); } NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, clientData, NULL, NULL); return TCL_OK; } int TclNRYieldToObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", NULL); return TCL_ERROR; } /* * Add the tailcall in the caller env, then just yield. * * This is essentially code from TclNRTailcallObjCmd */ listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); /* * Add the callback in the caller's env, then instruct TEBC to yield. */ iPtr->execEnvPtr = corPtr->callerEEPtr; TclSetTailcall(interp, listPtr); iPtr->execEnvPtr = corPtr->eePtr; return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv); } static int RewindCoroutineCallback( ClientData data[], Tcl_Interp *interp, int result) { return Tcl_RestoreInterpState(interp, data[0]); } static int RewindCoroutine( CoroutineData *corPtr, int result) { Tcl_Interp *interp = corPtr->eePtr->interp; Tcl_InterpState state = Tcl_SaveInterpState(interp, result); NRE_ASSERT(COR_IS_SUSPENDED(corPtr)); NRE_ASSERT(corPtr->eePtr != NULL); NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr); corPtr->eePtr->rewind = 1; TclNRAddCallback(interp, RewindCoroutineCallback, state, NULL, NULL, NULL); return TclNRInterpCoroutine(corPtr, interp, 0, NULL); } static void DeleteCoroutine( ClientData clientData) { CoroutineData *corPtr = (CoroutineData *)clientData; Tcl_Interp *interp = corPtr->eePtr->interp; NRE_callback *rootPtr = TOP_CB(interp); if (COR_IS_SUSPENDED(corPtr)) { TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr); } } static int NRCoroutineCallerCallback( ClientData data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = (CoroutineData *)data[0]; Command *cmdPtr = corPtr->cmdPtr; /* * This is the last callback in the caller execEnv, right before switching * to the coroutine's */ NRE_ASSERT(iPtr->execEnvPtr == corPtr->callerEEPtr); if (!corPtr->eePtr) { /* * The execEnv was wound down but not deleted for our sake. We finish * the job here. The caller context has already been restored. */ NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr); NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr); NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr); ckfree(corPtr); return result; } NRE_ASSERT(COR_IS_SUSPENDED(corPtr)); SAVE_CONTEXT(corPtr->running); RESTORE_CONTEXT(corPtr->caller); if (cmdPtr->flags & CMD_IS_DELETED) { /* * The command was deleted while it was running: wind down the * execEnv, this will do the complete cleanup. RewindCoroutine will * restore both the caller's context and interp state. */ return RewindCoroutine(corPtr, result); } return result; } static int NRCoroutineExitCallback( ClientData data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = (CoroutineData *)data[0]; Command *cmdPtr = corPtr->cmdPtr; /* * This runs at the bottom of the Coroutine's execEnv: it will be executed * when the coroutine returns or is wound down, but not when it yields. It * deletes the coroutine and restores the caller's environment. */ NRE_ASSERT(interp == corPtr->eePtr->interp); NRE_ASSERT(TOP_CB(interp) == NULL); NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr); NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); NRE_ASSERT((corPtr->callerEEPtr->callbackPtr->procPtr == NRCoroutineCallerCallback)); cmdPtr->deleteProc = NULL; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); TclCleanupCommandMacro(cmdPtr); corPtr->eePtr->corPtr = NULL; TclDeleteExecEnv(corPtr->eePtr); corPtr->eePtr = NULL; corPtr->stackLevel = NULL; /* * #280. * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal * command arguments in bytecode. */ Tcl_DeleteHashTable(corPtr->lineLABCPtr); ckfree(corPtr->lineLABCPtr); corPtr->lineLABCPtr = NULL; RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; iPtr->numLevels++; return result; } /* *---------------------------------------------------------------------- * * TclNRCoroutineActivateCallback -- * * This is the workhorse for coroutines: it implements both yield and * resume. * * It is important that both be implemented in the same callback: the * detection of the impossibility to suspend due to a busy C-stack relies * on the precise position of a local variable in the stack. We do not * want the compiler to play tricks on us, either by moving things around * or inlining. * *---------------------------------------------------------------------- */ int TclNRCoroutineActivateCallback( ClientData data[], Tcl_Interp *interp, int result /*result*/) { CoroutineData *corPtr = (CoroutineData *)data[0]; int type = PTR2INT(data[1]); int numLevels; void *stackLevel = TclGetCStackPtr(); if (!corPtr->stackLevel) { /* * -- Coroutine is suspended -- * Push the callback to restore the caller's context on yield or * return. */ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL, NULL); /* * Record the stackLevel at which the resume is happening, then swap * the interp's environment to make it suitable to run this coroutine. */ corPtr->stackLevel = stackLevel; numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; SAVE_CONTEXT(corPtr->caller); corPtr->callerEEPtr = iPtr->execEnvPtr; RESTORE_CONTEXT(corPtr->running); iPtr->execEnvPtr = corPtr->eePtr; iPtr->numLevels += numLevels; } else { /* * Coroutine is active: yield */ if (corPtr->stackLevel != stackLevel) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot yield: C stack busy", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", NULL); return TCL_ERROR; } if (type == CORO_ACTIVATE_YIELD) { corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; } else if (type == CORO_ACTIVATE_YIELDM) { corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; } else { Tcl_Panic("Yield received an option which is not implemented"); } corPtr->stackLevel = NULL; numLevels = iPtr->numLevels; iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; iPtr->execEnvPtr = corPtr->callerEEPtr; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclNREvalList -- * * Callback to invoke command as list, used in order to delayed * processing of canonical list command in sane environment. * *---------------------------------------------------------------------- */ static int TclNREvalList( ClientData data[], Tcl_Interp *interp, int result /*result*/) { int objc; Tcl_Obj **objv; Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } /* *---------------------------------------------------------------------- * * CoroTypeObjCmd -- * * Implementation of [::tcl::unsupported::corotype] command. * *---------------------------------------------------------------------- */ static int CoroTypeObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Command *cmdPtr; CoroutineData *corPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "coroName"); return TCL_ERROR; } /* * Look up the coroutine. */ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only get coroutine type of a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), NULL); return TCL_ERROR; } /* * An active coroutine is "active". Can't tell what it might do in the * future. */ corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); return TCL_OK; } /* * Inactive coroutines are classified by the (effective) command used to * suspend them, which matters when you're injecting a probe. */ switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); return TCL_OK; default: Tcl_SetObjResult(interp, Tcl_NewStringObj( "unknown coroutine type", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", NULL); return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * NRCoroInjectObjCmd -- * * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ static int NRCoroInjectObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Command *cmdPtr; CoroutineData *corPtr; ExecEnv *savedEEPtr = iPtr->execEnvPtr; /* * Usage more or less like tailcall: * inject coroName cmd ?arg1 arg2 ...? */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a command into a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), NULL); return TCL_ERROR; } corPtr = cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. */ iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2), NULL, NULL, NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; } int TclNRInterpCoroutine( ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { CoroutineData *corPtr = (CoroutineData *)clientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "coroutine \"%s\" is already running", Tcl_GetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL); return TCL_ERROR; } /* * Parse all the arguments to work out what to feed as the result of the * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine * is deleted! */ switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: if (objc == 2) { Tcl_SetObjResult(interp, objv[1]); } else if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); return TCL_ERROR; } break; default: if (corPtr->nargs != objc-1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong coro nargs; how did we get here? " "not implemented!", -1)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: if (objc > 1) { Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); } break; } TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, NULL, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclNRCoroutineObjCmd -- * * Implementation of [coroutine] command; see documentation for * description of what this does. * *---------------------------------------------------------------------- */ int TclNRCoroutineObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr; CoroutineData *corPtr; const char *procName, *simpleName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr, *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?"); return TCL_ERROR; } procName = TclGetString(objv[1]); TclGetNamespaceForQualName(interp, procName, inNsPtr, 0, &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName); if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create procedure \"%s\": unknown namespace", procName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL); return TCL_ERROR; } if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create procedure \"%s\": bad procedure name", procName)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL); return TCL_ERROR; } /* * We ARE creating the coroutine command: allocate the corresponding * struct and create the corresponding command. */ corPtr = (CoroutineData *)ckalloc(sizeof(CoroutineData)); cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); corPtr->cmdPtr = cmdPtr; cmdPtr->refCount++; /* * #280. * Provide the new coroutine with its own copy of the lineLABCPtr * hashtable for literal command arguments in bytecode. Note that that * CFWordBC chains are not duplicated, only the entrypoints to them. This * means that in the presence of coroutines each chain is potentially a * tree. Like the chain -> tree conversion of the CmdFrame stack. */ { Tcl_HashSearch hSearch; Tcl_HashEntry *hePtr; corPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) { int isNew; Tcl_HashEntry *newPtr = Tcl_CreateHashEntry(corPtr->lineLABCPtr, Tcl_GetHashKey(iPtr->lineLABCPtr, hePtr), &isNew); Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr)); } } /* * Create the base context. */ corPtr->running.framePtr = iPtr->rootFramePtr; corPtr->running.varFramePtr = iPtr->rootFramePtr; corPtr->running.cmdFramePtr = NULL; corPtr->running.lineLABCPtr = corPtr->lineLABCPtr; corPtr->stackLevel = NULL; corPtr->auxNumLevels = 0; /* * Create the coro's execEnv, switch to it to push the exit and coro * command callbacks, then switch back. */ corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE); corPtr->callerEEPtr = iPtr->execEnvPtr; corPtr->eePtr->corPtr = corPtr; SAVE_CONTEXT(corPtr->caller); corPtr->callerEEPtr = iPtr->execEnvPtr; RESTORE_CONTEXT(corPtr->running); iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL, NULL, NULL); /* * Ensure that the command is looked up in the correct namespace. */ iPtr->lookupNsPtr = lookupNsPtr; Tcl_NREvalObj(interp, Tcl_NewListObj(objc - 2, objv + 2), 0); iPtr->numLevels--; SAVE_CONTEXT(corPtr->running); RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; /* * Now just resume the coroutine. */ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, NULL, NULL, NULL); return TCL_OK; } /* * This is used in the [info] ensemble */ int TclInfoCoroutineCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) { Tcl_Obj *namePtr; TclNewObj(namePtr); Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr, namePtr); Tcl_SetObjResult(interp, namePtr); } return TCL_OK; } #undef iPtr /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/generic/tclBinary.c0000644000175000017500000023005514554262142015356 0ustar sergeisergei/* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in * command and the Tcl binary data object. * * Copyright (c) 1997 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #include /* * The following constants are used by GetFormatSpec to indicate various * special conditions in the parsing of a format specifier. */ #define BINARY_ALL -1 /* Use all elements in the argument. */ #define BINARY_NOCOUNT -2 /* No count was specified in format. */ /* * The following flags may be OR'ed together and returned by GetFormatSpec */ #define BINARY_SIGNED 0 /* Field to be read as signed data */ #define BINARY_UNSIGNED 1 /* Field to be read as unsigned data */ /* * The following defines the maximum number of different (integer) numbers * placed in the object cache by 'binary scan' before it bails out and * switches back to Plan A (creating a new object for each value.) * Theoretically, it would be possible to keep the cache about for the values * that are already in it, but that makes the code slower in practice when * overflow happens, and makes little odds the rest of the time (as measured * on my machine.) It is also slower (on the sample I tried at least) to grow * the cache to hold all items we might want to put in it; presumably the * extra cost of managing the memory for the enlarged table outweighs the * benefit from allocating fewer objects. This is probably because as the * number of objects increases, the likelihood of reuse of any particular one * drops, and there is very little gain from larger maximum cache sizes (the * value below is chosen to allow caching to work in full with conversion of * bytes.) - DKF */ #define BINARY_SCAN_MAX_CACHE 260 /* * Prototypes for local procedures defined in this file: */ static void DupByteArrayInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static int FormatNumber(Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr); static void FreeByteArrayInternalRep(Tcl_Obj *objPtr); static int GetFormatSpec(const char **formatPtr, char *cmdPtr, int *countPtr, int *flagsPtr); static Tcl_Obj * ScanNumber(unsigned char *buffer, int type, int flags, Tcl_HashTable **numberCachePtr); static int SetByteArrayFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); static int NeedReversing(int format); static void CopyNumber(const void *from, void *to, unsigned int length, int type); /* Binary ensemble commands */ static Tcl_ObjCmdProc BinaryFormatCmd; static Tcl_ObjCmdProc BinaryScanCmd; /* Binary encoding sub-ensemble commands */ static Tcl_ObjCmdProc BinaryEncodeHex; static Tcl_ObjCmdProc BinaryDecodeHex; static Tcl_ObjCmdProc BinaryEncode64; static Tcl_ObjCmdProc BinaryDecode64; static Tcl_ObjCmdProc BinaryEncodeUu; static Tcl_ObjCmdProc BinaryDecodeUu; /* * The following tables are used by the binary encoders */ static const char HexDigits[16] = { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' }; static const char UueDigits[65] = { '`', '!', '"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', ',', '-', '.', '/', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ':', ';', '<', '=', '>', '?', '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '[', '\\',']', '^', '_', '`' }; static const char B64Digits[65] = { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/', '=' }; /* * How to construct the ensembles. */ static const EnsembleImplMap binaryMap[] = { { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 }, { "scan", BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 }, { "encode", NULL, NULL, NULL, NULL, 0 }, { "decode", NULL, NULL, NULL, NULL, 0 }, { NULL, NULL, NULL, NULL, NULL, 0 } }; static const EnsembleImplMap encodeMap[] = { { "hex", BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, { "uuencode", BinaryEncodeUu, NULL, NULL, NULL, 0 }, { "base64", BinaryEncode64, NULL, NULL, NULL, 0 }, { NULL, NULL, NULL, NULL, NULL, 0 } }; static const EnsembleImplMap decodeMap[] = { { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { NULL, NULL, NULL, NULL, NULL, 0 } }; /* * The following object type represents an array of bytes. An array of bytes * is not equivalent to an internationalized string. Conceptually, a string is * an array of 16-bit quantities organized as a sequence of properly formed * UTF-8 characters, while a ByteArray is an array of 8-bit quantities. * Accessor functions are provided to convert a ByteArray to a String or a * String to a ByteArray. Two or more consecutive bytes in an array of bytes * may look like a single UTF-8 character if the array is casually treated as * a string. But obtaining the String from a ByteArray is guaranteed to * produced properly formed UTF-8 sequences so that there is a one-to-one map * between bytes and characters. * * Converting a ByteArray to a String proceeds by casting each byte in the * array to a 16-bit quantity, treating that number as a Unicode character, * and storing the UTF-8 version of that Unicode character in the String. For * ByteArrays consisting entirely of values 1..127, the corresponding String * representation is the same as the ByteArray representation. * * Converting a String to a ByteArray proceeds by getting the Unicode * representation of each character in the String, casting it to a byte by * truncating the upper 8 bits, and then storing the byte in the ByteArray. * Converting from ByteArray to String and back to ByteArray is not lossy, but * converting an arbitrary String to a ByteArray may be. */ const Tcl_ObjType tclByteArrayType = { "bytearray", FreeByteArrayInternalRep, DupByteArrayInternalRep, UpdateStringOfByteArray, SetByteArrayFromAny }; /* * The following structure is the internal rep for a ByteArray object. Keeps * track of how much memory has been used and how much has been allocated for * the byte array to enable growing and shrinking of the ByteArray object with * fewer mallocs. */ typedef struct ByteArray { unsigned int used; /* The number of bytes used in the byte * array. */ unsigned int allocated; /* The number of bytes allocated for storage * of the following "bytes" field. */ unsigned char bytes[TCLFLEXARRAY]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field * above. */ } ByteArray; #define BYTEARRAY_SIZE(len) \ (((unsigned)TclOffset(ByteArray, bytes) + (len))) #define GET_BYTEARRAY(objPtr) \ ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_BYTEARRAY(objPtr, baPtr) \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr) /* *---------------------------------------------------------------------- * * Tcl_NewByteArrayObj -- * * This procedure is creates a new ByteArray object and initializes it * from the given array of bytes. * * Results: * The newly create object is returned. This object will have no initial * string representation. The returned object has a ref count of 0. * * Side effects: * Memory allocated for new object and copy of byte array argument. * *---------------------------------------------------------------------- */ #undef Tcl_NewByteArrayObj Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ int length) /* Length of the array of bytes, which must be * >= 0. */ { #ifdef TCL_MEM_DEBUG return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0); #else /* if not TCL_MEM_DEBUG */ Tcl_Obj *objPtr; TclNewObj(objPtr); Tcl_SetByteArrayObj(objPtr, bytes, length); return objPtr; #endif /* TCL_MEM_DEBUG */ } /* *---------------------------------------------------------------------- * * Tcl_DbNewByteArrayObj -- * * This procedure is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It is the same as the Tcl_NewByteArrayObj * above except that it calls Tcl_DbCkalloc directly with the file name * and line number from its caller. This simplifies debugging since then * the [memory active] command will report the correct file name and line * number when reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the * result of calling Tcl_NewByteArrayObj. * * Results: * The newly create object is returned. This object will have no initial * string representation. The returned object has a ref count of 0. * * Side effects: * Memory allocated for new object and copy of byte array argument. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ int length, /* Length of the array of bytes, which must be * >= 0. */ const char *file, /* The name of the source file calling this * procedure; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); Tcl_SetByteArrayObj(objPtr, bytes, length); return objPtr; #else /* if not TCL_MEM_DEBUG */ return Tcl_NewByteArrayObj(bytes, length); #endif /* TCL_MEM_DEBUG */ } /* *--------------------------------------------------------------------------- * * Tcl_SetByteArrayObj -- * * Modify an object to be a ByteArray object and to have the specified * array of bytes as its value. * * Results: * None. * * Side effects: * The object's old string rep and internal rep is freed. Memory * allocated for copy of byte array argument. * *---------------------------------------------------------------------- */ void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new value. * May be NULL even if length > 0. */ int length) /* Length of the array of bytes, which must * be >= 0. */ { ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); } TclFreeIntRep(objPtr); TclInvalidateStringRep(objPtr); if (length < 0) { length = 0; } byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); byteArrayPtr->used = length; byteArrayPtr->allocated = length; if ((bytes != NULL) && (length > 0)) { memcpy(byteArrayPtr->bytes, bytes, length); } objPtr->typePtr = &tclByteArrayType; SET_BYTEARRAY(objPtr, byteArrayPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetByteArrayFromObj -- * * Attempt to get the array of bytes from the Tcl object. If the object * is not already a ByteArray object, an attempt will be made to convert * it to one. * * Results: * Pointer to array of bytes representing the ByteArray object. * * Side effects: * Frees old internal rep. Allocates memory for new internal rep. * *---------------------------------------------------------------------- */ unsigned char * Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; if (objPtr->typePtr != &tclByteArrayType) { SetByteArrayFromAny(NULL, objPtr); } baPtr = GET_BYTEARRAY(objPtr); if (lengthPtr != NULL) { *lengthPtr = baPtr->used; } return (unsigned char *) baPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_SetByteArrayLength -- * * This procedure changes the length of the byte array for this object. * Once the caller has set the length of the array, it is acceptable to * directly modify the bytes in the array up until Tcl_GetStringFromObj() * has been called on this object. * * Results: * The new byte array of the specified length. * * Side effects: * Allocates enough memory for an array of bytes of the requested size. * When growing the array, the old array is copied to the new array; new * bytes are undefined. When shrinking, the old array is truncated to the * specified length. * *---------------------------------------------------------------------- */ unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ int length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } if (objPtr->typePtr != &tclByteArrayType) { SetByteArrayFromAny(NULL, objPtr); } if (length < 0) { length = 0; } byteArrayPtr = GET_BYTEARRAY(objPtr); if ((unsigned int)length > byteArrayPtr->allocated) { byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length)); byteArrayPtr->allocated = length; SET_BYTEARRAY(objPtr, byteArrayPtr); } TclInvalidateStringRep(objPtr); byteArrayPtr->used = length; return byteArrayPtr->bytes; } /* *---------------------------------------------------------------------- * * SetByteArrayFromAny -- * * Generate the ByteArray internal rep from the string rep. * * Results: * The return value is always TCL_OK. * * Side effects: * A ByteArray object is stored as the internal rep of objPtr. * *---------------------------------------------------------------------- */ static int SetByteArrayFromAny( Tcl_Interp *interp, /* Not used. */ Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ { int length; const char *src, *srcEnd; unsigned char *dst; ByteArray *byteArrayPtr; Tcl_UniChar ch = 0; if (objPtr->typePtr != &tclByteArrayType) { src = TclGetStringFromObj(objPtr, &length); srcEnd = src + length; byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { src += TclUtfToUniChar(src, &ch); *dst++ = UCHAR(ch); } byteArrayPtr->used = dst - byteArrayPtr->bytes; byteArrayPtr->allocated = length; TclFreeIntRep(objPtr); objPtr->typePtr = &tclByteArrayType; SET_BYTEARRAY(objPtr, byteArrayPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * FreeByteArrayInternalRep -- * * Deallocate the storage associated with a ByteArray data object's * internal representation. * * Results: * None. * * Side effects: * Frees memory. * *---------------------------------------------------------------------- */ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { ckfree(GET_BYTEARRAY(objPtr)); objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DupByteArrayInternalRep -- * * Initialize the internal representation of a ByteArray Tcl_Obj to a * copy of the internal representation of an existing ByteArray object. * * Results: * None. * * Side effects: * Allocates memory. * *---------------------------------------------------------------------- */ static void DupByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { unsigned int length; ByteArray *srcArrayPtr, *copyArrayPtr; srcArrayPtr = GET_BYTEARRAY(srcPtr); length = srcArrayPtr->used; copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); SET_BYTEARRAY(copyPtr, copyArrayPtr); copyPtr->typePtr = &tclByteArrayType; } /* *---------------------------------------------------------------------- * * UpdateStringOfByteArray -- * * Update the string representation for a ByteArray data object. Note: * This procedure does not invalidate an existing old string rep so * storage will be lost if this has not already been done. * * Results: * None. * * Side effects: * The object's string is set to a valid string that results from the * ByteArray-to-string conversion. * * The object becomes a string object -- the internal rep is discarded * and the typePtr becomes NULL. * *---------------------------------------------------------------------- */ static void UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { unsigned int i, length, size; unsigned char *src; char *dst; ByteArray *byteArrayPtr; byteArrayPtr = GET_BYTEARRAY(objPtr); src = byteArrayPtr->bytes; length = byteArrayPtr->used; /* * How much space will string rep need? */ size = length; for (i = 0; i < length && size <= INT_MAX; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } if (size > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } dst = (char *)ckalloc(size + 1U); objPtr->bytes = dst; objPtr->length = size; if (size == length) { memcpy(dst, src, size); dst[size] = '\0'; } else { for (i = 0; i < length; i++) { dst += Tcl_UniCharToUtf(src[i], dst); } *dst = '\0'; } } /* *---------------------------------------------------------------------- * * TclAppendBytesToByteArray -- * * This function appends an array of bytes to a byte array object. Note * that the object *must* be unshared, and the array of bytes *must not* * refer to the object being appended to. * * Results: * None. * * Side effects: * Allocates enough memory for an array of bytes of the requested total * size, or possibly larger. [Bug 2992970] * *---------------------------------------------------------------------- */ void TclAppendBytesToByteArray( Tcl_Obj *objPtr, const unsigned char *bytes, int len) { ByteArray *byteArrayPtr; unsigned int needed; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } if (len < 0) { Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { /* * Append zero bytes is a no-op. */ return; } if (objPtr->typePtr != &tclByteArrayType) { SetByteArrayFromAny(NULL, objPtr); } byteArrayPtr = GET_BYTEARRAY(objPtr); if ((unsigned int)len > INT_MAX - byteArrayPtr->used) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } needed = byteArrayPtr->used + len; /* * If we need to, resize the allocated space in the byte array. */ if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; unsigned int attempt; if (needed <= INT_MAX/2) { /* * Try to allocate double the total space that is needed. */ attempt = 2 * needed; ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* * Try to allocate double the increment that is needed (plus). */ unsigned int limit = INT_MAX - needed; unsigned int extra = len + TCL_MIN_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); attempt = needed + growth; ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* * Last chance: Try to allocate exactly what is needed. */ attempt = needed; ptr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } byteArrayPtr = ptr; byteArrayPtr->allocated = attempt; SET_BYTEARRAY(objPtr, byteArrayPtr); } if (bytes) { memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len); } byteArrayPtr->used += len; TclInvalidateStringRep(objPtr); } /* *---------------------------------------------------------------------- * * TclInitBinaryCmd -- * * This function is called to create the "binary" Tcl command. See the * user documentation for details on what it does. * * Results: * A command token for the new command. * * Side effects: * Creates a new binary command as a mapped ensemble. * *---------------------------------------------------------------------- */ Tcl_Command TclInitBinaryCmd( Tcl_Interp *interp) { Tcl_Command binaryEnsemble; binaryEnsemble = TclMakeEnsemble(interp, "binary", binaryMap); TclMakeEnsemble(interp, "binary encode", encodeMap); TclMakeEnsemble(interp, "binary decode", decodeMap); return binaryEnsemble; } /* *---------------------------------------------------------------------- * * BinaryFormatCmd -- * * This procedure implements the "binary format" Tcl command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int BinaryFormatCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ unsigned char *cursor; /* Current position within result buffer. */ unsigned char *maxPos; /* Greatest position within result buffer that * cursor has visited.*/ const char *errorString; const char *errorValue, *str; int offset, size, length; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?"); return TCL_ERROR; } /* * To avoid copying the data, we format the string in two passes. The * first pass computes the size of the output buffer. The second pass * places the formatted data into the buffer. */ format = TclGetString(objv[1]); arg = 2; offset = 0; length = 0; while (*format != '\0') { str = format; flags = 0; if (!GetFormatSpec(&format, &cmd, &count, &flags)) { break; } switch (cmd) { case 'a': case 'A': case 'b': case 'B': case 'h': case 'H': /* * For string-type specifiers, the count corresponds to the number * of bytes in a single argument. */ if (arg >= objc) { goto badIndex; } if (count == BINARY_ALL) { Tcl_GetByteArrayFromObj(objv[arg], &count); } else if (count == BINARY_NOCOUNT) { count = 1; } arg++; if (cmd == 'a' || cmd == 'A') { offset += count; } else if (cmd == 'b' || cmd == 'B') { offset += (count + 7) / 8; } else { offset += (count + 1) / 2; } break; case 'c': size = 1; goto doNumbers; case 't': case 's': case 'S': size = 2; goto doNumbers; case 'n': case 'i': case 'I': size = 4; goto doNumbers; case 'm': case 'w': case 'W': size = 8; goto doNumbers; case 'r': case 'R': case 'f': size = sizeof(float); goto doNumbers; case 'q': case 'Q': case 'd': size = sizeof(double); doNumbers: if (arg >= objc) { goto badIndex; } /* * For number-type specifiers, the count corresponds to the number * of elements in the list stored in a single argument. If no * count is specified, then the argument is taken as a single * non-list value. */ if (count == BINARY_NOCOUNT) { arg++; count = 1; } else { int listc; Tcl_Obj **listv; /* * The macro evals its args more than once: avoid arg++ */ if (TclListObjGetElements(interp, objv[arg], &listc, &listv) != TCL_OK) { return TCL_ERROR; } arg++; if (count == BINARY_ALL) { count = listc; } else if (count > listc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "number of elements in list does not match count", -1)); return TCL_ERROR; } } offset += count*size; break; case 'x': if (count == BINARY_ALL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use \"*\" in format string with \"x\"", -1)); return TCL_ERROR; } else if (count == BINARY_NOCOUNT) { count = 1; } offset += count; break; case 'X': if (count == BINARY_NOCOUNT) { count = 1; } if ((count > offset) || (count == BINARY_ALL)) { count = offset; } if (offset > length) { length = offset; } offset -= count; break; case '@': if (offset > length) { length = offset; } if (count == BINARY_ALL) { offset = length; } else if (count == BINARY_NOCOUNT) { goto badCount; } else { offset = count; } break; default: errorString = str; goto badField; } } if (offset > length) { length = offset; } if (length == 0) { return TCL_OK; } /* * Prepare the result object by preallocating the calculated number of * bytes and filling with nulls. */ TclNewObj(resultPtr); buffer = Tcl_SetByteArrayLength(resultPtr, length); memset(buffer, 0, length); /* * Pack the data into the result object. Note that we can skip the error * checking during this pass, since we have already parsed the string * once. */ arg = 2; format = TclGetString(objv[1]); cursor = buffer; maxPos = cursor; while (*format != 0) { flags = 0; if (!GetFormatSpec(&format, &cmd, &count, &flags)) { break; } if ((count == 0) && (cmd != '@')) { if (cmd != 'x') { arg++; } continue; } switch (cmd) { case 'a': case 'A': { char pad = (char) (cmd == 'a' ? '\0' : ' '); unsigned char *bytes; bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length); if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } if (length >= count) { memcpy(cursor, bytes, count); } else { memcpy(cursor, bytes, length); memset(cursor + length, pad, count - length); } cursor += count; break; } case 'b': case 'B': { unsigned char *last; str = TclGetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } last = cursor + ((count + 7) / 8); if (count > length) { count = length; } value = 0; errorString = "binary"; if (cmd == 'B') { for (offset = 0; offset < count; offset++) { value <<= 1; if (str[offset] == '1') { value |= 1; } else if (str[offset] != '0') { errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; } if (((offset + 1) % 8) == 0) { *cursor++ = UCHAR(value); value = 0; } } } else { for (offset = 0; offset < count; offset++) { value >>= 1; if (str[offset] == '1') { value |= 128; } else if (str[offset] != '0') { errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; } if (!((offset + 1) % 8)) { *cursor++ = UCHAR(value); value = 0; } } } if ((offset % 8) != 0) { if (cmd == 'B') { value <<= 8 - (offset % 8); } else { value >>= 8 - (offset % 8); } *cursor++ = UCHAR(value); } while (cursor < last) { *cursor++ = '\0'; } break; } case 'h': case 'H': { unsigned char *last; int c; str = TclGetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } last = cursor + ((count + 1) / 2); if (count > length) { count = length; } value = 0; errorString = "hexadecimal"; if (cmd == 'H') { for (offset = 0; offset < count; offset++) { value <<= 4; if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; } c = str[offset] - '0'; if (c > 9) { c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } value |= (c & 0xF); if (offset % 2) { *cursor++ = (char) value; value = 0; } } } else { for (offset = 0; offset < count; offset++) { value >>= 4; if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; } c = str[offset] - '0'; if (c > 9) { c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } value |= ((c << 4) & 0xF0); if (offset % 2) { *cursor++ = UCHAR(value & 0xFF); value = 0; } } } if (offset % 2) { if (cmd == 'H') { value <<= 4; } else { value >>= 4; } *cursor++ = UCHAR(value); } while (cursor < last) { *cursor++ = '\0'; } break; } case 'c': case 't': case 's': case 'S': case 'n': case 'i': case 'I': case 'm': case 'w': case 'W': case 'r': case 'R': case 'd': case 'q': case 'Q': case 'f': { int listc, i; Tcl_Obj **listv; if (count == BINARY_NOCOUNT) { /* * Note that we are casting away the const-ness of objv, but * this is safe since we aren't going to modify the array. */ listv = (Tcl_Obj **) (objv + arg); listc = 1; count = 1; } else { TclListObjGetElements(interp, objv[arg], &listc, &listv); if (count == BINARY_ALL) { count = listc; } } arg++; for (i = 0; i < count; i++) { if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) { Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } } break; } case 'x': if (count == BINARY_NOCOUNT) { count = 1; } memset(cursor, 0, count); cursor += count; break; case 'X': if (cursor > maxPos) { maxPos = cursor; } if (count == BINARY_NOCOUNT) { count = 1; } if ((count == BINARY_ALL) || (count > (cursor - buffer))) { cursor = buffer; } else { cursor -= count; } break; case '@': if (cursor > maxPos) { maxPos = cursor; } if (count == BINARY_ALL) { cursor = maxPos; } else { cursor = buffer + count; } break; } } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; badValue: Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected %s string but got \"%s\" instead", errorString, errorValue)); return TCL_ERROR; badCount: errorString = "missing count for \"@\" field specifier"; goto error; badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { int ch; char buf[8] = ""; TclUtfToUCS4(errorString, &ch); buf[TclUCS4ToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } error: Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * BinaryScanCmd -- * * This procedure implements the "binary scan" Tcl command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int BinaryScanCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ const char *errorString; const char *str; int offset, size, length; int i; Tcl_Obj *valuePtr, *elementPtr; Tcl_HashTable numberCacheHash; Tcl_HashTable *numberCachePtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "value formatString ?varName ...?"); return TCL_ERROR; } numberCachePtr = &numberCacheHash; Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); buffer = Tcl_GetByteArrayFromObj(objv[1], &length); format = TclGetString(objv[2]); arg = 3; offset = 0; while (*format != '\0') { str = format; flags = 0; if (!GetFormatSpec(&format, &cmd, &count, &flags)) { goto done; } switch (cmd) { case 'a': case 'A': { unsigned char *src; if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_ALL) { count = length - offset; } else { if (count == BINARY_NOCOUNT) { count = 1; } if (count > (length - offset)) { goto done; } } src = buffer + offset; size = count; /* * Trim trailing nulls and spaces, if necessary. */ if (cmd == 'A') { while (size > 0) { if (src[size - 1] != '\0' && src[size - 1] != ' ') { break; } size--; } } /* * Have to do this #ifdef-fery because (as part of defining * Tcl_NewByteArrayObj) we removed the #def that hides this stuff * normally. If this code ever gets copied to another file, it * should be changed back to the simpler version. */ #ifdef TCL_MEM_DEBUG valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__, __LINE__); #else valuePtr = Tcl_NewByteArrayObj(src, size); #endif /* TCL_MEM_DEBUG */ resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += count; break; } case 'b': case 'B': { unsigned char *src; char *dest; if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_ALL) { count = (length - offset) * 8; } else { if (count == BINARY_NOCOUNT) { count = 1; } if (count > (length - offset) * 8) { goto done; } } src = buffer + offset; TclNewObj(valuePtr); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); if (cmd == 'b') { for (i = 0; i < count; i++) { if (i % 8) { value >>= 1; } else { value = *src++; } *dest++ = (char) ((value & 1) ? '1' : '0'); } } else { for (i = 0; i < count; i++) { if (i % 8) { value <<= 1; } else { value = *src++; } *dest++ = (char) ((value & 0x80) ? '1' : '0'); } } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += (count + 7) / 8; break; } case 'h': case 'H': { char *dest; unsigned char *src; static const char hexdigit[] = "0123456789abcdef"; if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_ALL) { count = (length - offset)*2; } else { if (count == BINARY_NOCOUNT) { count = 1; } if (count > (length - offset)*2) { goto done; } } src = buffer + offset; TclNewObj(valuePtr); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); if (cmd == 'h') { for (i = 0; i < count; i++) { if (i % 2) { value >>= 4; } else { value = *src++; } *dest++ = hexdigit[value & 0xF]; } } else { for (i = 0; i < count; i++) { if (i % 2) { value <<= 4; } else { value = *src++; } *dest++ = hexdigit[(value >> 4) & 0xF]; } } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += (count + 1) / 2; break; } case 'c': size = 1; goto scanNumber; case 't': case 's': case 'S': size = 2; goto scanNumber; case 'n': case 'i': case 'I': size = 4; goto scanNumber; case 'm': case 'w': case 'W': size = 8; goto scanNumber; case 'r': case 'R': case 'f': size = sizeof(float); goto scanNumber; case 'q': case 'Q': case 'd': { unsigned char *src; size = sizeof(double); /* fall through */ scanNumber: if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_NOCOUNT) { if ((length - offset) < size) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd, flags, &numberCachePtr); offset += size; } else { if (count == BINARY_ALL) { count = (length - offset) / size; } if ((length - offset) < (count * size)) { goto done; } TclNewObj(valuePtr); src = buffer + offset; for (i = 0; i < count; i++) { elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr); src += size; Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr); } offset += count * size; } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } break; } case 'x': if (count == BINARY_NOCOUNT) { count = 1; } if ((count == BINARY_ALL) || (count > (length - offset))) { offset = length; } else { offset += count; } break; case 'X': if (count == BINARY_NOCOUNT) { count = 1; } if ((count == BINARY_ALL) || (count > offset)) { offset = 0; } else { offset -= count; } break; case '@': if (count == BINARY_NOCOUNT) { DeleteScanNumberCache(numberCachePtr); goto badCount; } if ((count == BINARY_ALL) || (count > length)) { offset = length; } else { offset = count; } break; default: DeleteScanNumberCache(numberCachePtr); errorString = str; goto badField; } } /* * Set the result to the last position of the cursor. */ done: Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 3)); DeleteScanNumberCache(numberCachePtr); return TCL_OK; badCount: errorString = "missing count for \"@\" field specifier"; goto error; badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { int ch; char buf[8] = ""; TclUtfToUCS4(errorString, &ch); buf[TclUCS4ToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } error: Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * GetFormatSpec -- * * This function parses the format strings used in the binary format and * scan commands. * * Results: * Moves the formatPtr to the start of the next command. Returns the * current command character and count in cmdPtr and countPtr. The count * is set to BINARY_ALL if the count character was '*' or BINARY_NOCOUNT * if no count was specified. Returns 1 on success, or 0 if the string * did not have a format specifier. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetFormatSpec( const char **formatPtr, /* Pointer to format string. */ char *cmdPtr, /* Pointer to location of command char. */ int *countPtr, /* Pointer to repeat count value. */ int *flagsPtr) /* Pointer to field flags */ { /* * Skip any leading blanks. */ while (**formatPtr == ' ') { (*formatPtr)++; } /* * The string was empty, except for whitespace, so fail. */ if (!(**formatPtr)) { return 0; } /* * Extract the command character and any trailing digits or '*'. */ *cmdPtr = **formatPtr; (*formatPtr)++; if (**formatPtr == 'u') { (*formatPtr)++; *flagsPtr |= BINARY_UNSIGNED; } if (**formatPtr == '*') { (*formatPtr)++; *countPtr = BINARY_ALL; } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */ unsigned long count; errno = 0; count = strtoul(*formatPtr, (char **) formatPtr, 10); if (errno || (count > (unsigned long) INT_MAX)) { *countPtr = INT_MAX; } else { *countPtr = (int) count; } } else { *countPtr = BINARY_NOCOUNT; } return 1; } /* *---------------------------------------------------------------------- * * NeedReversing -- * * This routine determines, if bytes of a number need to be re-ordered, * and returns a numeric code indicating the re-ordering to be done. * This depends on the endianness of the machine and the desired format. * It is in effect a table (whose contents depend on the endianness of * the system) describing whether a value needs reversing or not. Anyone * porting the code to a big-endian platform should take care to make * sure that they define WORDS_BIGENDIAN though this is already done by * configure for the Unix build; little-endian platforms (including * Windows) don't need to do anything. * * Results: * 0 No re-ordering needed. * 1 Reverse the bytes: 01234567 <-> 76543210 (little to big) * 2 Apply this re-ordering: 01234567 <-> 45670123 (Nokia to little) * 3 Apply this re-ordering: 01234567 <-> 32107654 (Nokia to big) * * Side effects: * None * *---------------------------------------------------------------------- */ static int NeedReversing( int format) { switch (format) { /* native floats and doubles: never reverse */ case 'd': case 'f': /* big endian ints: never reverse */ case 'I': case 'S': case 'W': #ifdef WORDS_BIGENDIAN /* native ints: reverse if we're little-endian */ case 'n': case 't': case 'm': /* f: reverse if we're little-endian */ case 'Q': case 'R': #else /* !WORDS_BIGENDIAN */ /* small endian floats: reverse if we're big-endian */ case 'r': #endif /* WORDS_BIGENDIAN */ return 0; #ifdef WORDS_BIGENDIAN /* small endian floats: reverse if we're big-endian */ case 'q': case 'r': #else /* !WORDS_BIGENDIAN */ /* native ints: reverse if we're little-endian */ case 'n': case 't': case 'm': /* f: reverse if we're little-endian */ case 'R': #endif /* WORDS_BIGENDIAN */ /* small endian ints: always reverse */ case 'i': case 's': case 'w': return 1; #ifndef WORDS_BIGENDIAN /* * The Q and q formats need special handling to account for the unusual * byte ordering of 8-byte floats on Nokia 770 systems, which claim to be * little-endian, but also reverse word order. */ case 'Q': if (TclNokia770Doubles()) { return 3; } return 1; case 'q': if (TclNokia770Doubles()) { return 2; } return 0; #endif } Tcl_Panic("unexpected fallthrough"); return 0; } /* *---------------------------------------------------------------------- * * CopyNumber -- * * This routine is called by FormatNumber and ScanNumber to copy a * floating-point number. If required, bytes are reversed while copying. * The behaviour is only fully defined when used with IEEE float and * double values (guaranteed to be 4 and 8 bytes long, respectively.) * * Results: * None * * Side effects: * Copies length bytes * *---------------------------------------------------------------------- */ static void CopyNumber( const void *from, /* source */ void *to, /* destination */ unsigned length, /* Number of bytes to copy */ int type) /* What type of thing are we copying? */ { switch (NeedReversing(type)) { case 0: memcpy(to, from, length); break; case 1: { const unsigned char *fromPtr = (const unsigned char *)from; unsigned char *toPtr = (unsigned char *)to; switch (length) { case 4: toPtr[0] = fromPtr[3]; toPtr[1] = fromPtr[2]; toPtr[2] = fromPtr[1]; toPtr[3] = fromPtr[0]; break; case 8: toPtr[0] = fromPtr[7]; toPtr[1] = fromPtr[6]; toPtr[2] = fromPtr[5]; toPtr[3] = fromPtr[4]; toPtr[4] = fromPtr[3]; toPtr[5] = fromPtr[2]; toPtr[6] = fromPtr[1]; toPtr[7] = fromPtr[0]; break; } break; } case 2: { const unsigned char *fromPtr = (const unsigned char *)from; unsigned char *toPtr = (unsigned char *)to; toPtr[0] = fromPtr[4]; toPtr[1] = fromPtr[5]; toPtr[2] = fromPtr[6]; toPtr[3] = fromPtr[7]; toPtr[4] = fromPtr[0]; toPtr[5] = fromPtr[1]; toPtr[6] = fromPtr[2]; toPtr[7] = fromPtr[3]; break; } case 3: { const unsigned char *fromPtr = (const unsigned char *)from; unsigned char *toPtr = (unsigned char *)to; toPtr[0] = fromPtr[3]; toPtr[1] = fromPtr[2]; toPtr[2] = fromPtr[1]; toPtr[3] = fromPtr[0]; toPtr[4] = fromPtr[7]; toPtr[5] = fromPtr[6]; toPtr[6] = fromPtr[5]; toPtr[7] = fromPtr[4]; break; } } } /* *---------------------------------------------------------------------- * * FormatNumber -- * * This routine is called by Tcl_BinaryObjCmd to format a number into a * location pointed at by cursor. * * Results: * A standard Tcl result. * * Side effects: * Moves the cursor to the next location to be written into. * *---------------------------------------------------------------------- */ static int FormatNumber( Tcl_Interp *interp, /* Current interpreter, used to report * errors. */ int type, /* Type of number to format. */ Tcl_Obj *src, /* Number to format. */ unsigned char **cursorPtr) /* Pointer to index into destination buffer. */ { long value; double dvalue; Tcl_WideInt wvalue; float fvalue; switch (type) { case 'd': case 'q': case 'Q': /* * Double-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { if (src->typePtr != &tclDoubleType) { return TCL_ERROR; } dvalue = src->internalRep.doubleValue; } CopyNumber(&dvalue, *cursorPtr, sizeof(double), type); *cursorPtr += sizeof(double); return TCL_OK; case 'f': case 'r': case 'R': /* * Single-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { if (src->typePtr != &tclDoubleType) { return TCL_ERROR; } dvalue = src->internalRep.doubleValue; } /* * Because some compilers will generate floating point exceptions on * an overflow cast (e.g. Borland), we restrict the values to the * valid range for float. */ if (fabs(dvalue) > (double) FLT_MAX) { fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; } else { fvalue = (float) dvalue; } CopyNumber(&fvalue, *cursorPtr, sizeof(float), type); *cursorPtr += sizeof(float); return TCL_OK; /* * 64-bit integer values. */ case 'w': case 'W': case 'm': if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { *(*cursorPtr)++ = UCHAR(wvalue); *(*cursorPtr)++ = UCHAR(wvalue >> 8); *(*cursorPtr)++ = UCHAR(wvalue >> 16); *(*cursorPtr)++ = UCHAR(wvalue >> 24); *(*cursorPtr)++ = UCHAR(wvalue >> 32); *(*cursorPtr)++ = UCHAR(wvalue >> 40); *(*cursorPtr)++ = UCHAR(wvalue >> 48); *(*cursorPtr)++ = UCHAR(wvalue >> 56); } else { *(*cursorPtr)++ = UCHAR(wvalue >> 56); *(*cursorPtr)++ = UCHAR(wvalue >> 48); *(*cursorPtr)++ = UCHAR(wvalue >> 40); *(*cursorPtr)++ = UCHAR(wvalue >> 32); *(*cursorPtr)++ = UCHAR(wvalue >> 24); *(*cursorPtr)++ = UCHAR(wvalue >> 16); *(*cursorPtr)++ = UCHAR(wvalue >> 8); *(*cursorPtr)++ = UCHAR(wvalue); } return TCL_OK; /* * 32-bit integer values. */ case 'i': case 'I': case 'n': if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { *(*cursorPtr)++ = UCHAR(value); *(*cursorPtr)++ = UCHAR(value >> 8); *(*cursorPtr)++ = UCHAR(value >> 16); *(*cursorPtr)++ = UCHAR(value >> 24); } else { *(*cursorPtr)++ = UCHAR(value >> 24); *(*cursorPtr)++ = UCHAR(value >> 16); *(*cursorPtr)++ = UCHAR(value >> 8); *(*cursorPtr)++ = UCHAR(value); } return TCL_OK; /* * 16-bit integer values. */ case 's': case 'S': case 't': if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { *(*cursorPtr)++ = UCHAR(value); *(*cursorPtr)++ = UCHAR(value >> 8); } else { *(*cursorPtr)++ = UCHAR(value >> 8); *(*cursorPtr)++ = UCHAR(value); } return TCL_OK; /* * 8-bit integer values. */ case 'c': if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { return TCL_ERROR; } *(*cursorPtr)++ = UCHAR(value); return TCL_OK; default: Tcl_Panic("unexpected fallthrough"); return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * ScanNumber -- * * This routine is called by Tcl_BinaryObjCmd to scan a number out of a * buffer. * * Results: * Returns a newly created object containing the scanned number. This * object has a ref count of zero. * * Side effects: * Might reuse an object in the number cache, place a new object in the * cache, or delete the cache and set the reference to it (itself passed * in by reference) to NULL. * *---------------------------------------------------------------------- */ static Tcl_Obj * ScanNumber( unsigned char *buffer, /* Buffer to scan number from. */ int type, /* Format character from "binary scan" */ int flags, /* Format field flags */ Tcl_HashTable **numberCachePtrPtr) /* Place to look for cache of scanned value * objects, or NULL if too many different * numbers have been scanned. */ { long value; float fvalue; double dvalue; Tcl_WideUInt uwvalue; /* * We cannot rely on the compiler to properly sign extend integer values * when we cast from smaller values to larger values because we don't know * the exact size of the integer types. So, we have to handle sign * extension explicitly by checking the high bit and padding with 1's as * needed. This practice is disabled if the BINARY_UNSIGNED flag is set. */ switch (type) { case 'c': /* * Characters need special handling. We want to produce a signed * result, but on some platforms (such as AIX) chars are unsigned. To * deal with this, check for a value that should be negative but * isn't. */ value = buffer[0]; if (!(flags & BINARY_UNSIGNED)) { if (value & 0x80) { value |= -0x100; } } goto returnNumericObject; /* * 16-bit numeric values. We need the sign extension trick (see above) * here as well. */ case 's': case 'S': case 't': if (NeedReversing(type)) { value = (long) (buffer[0] + (buffer[1] << 8)); } else { value = (long) (buffer[1] + (buffer[0] << 8)); } if (!(flags & BINARY_UNSIGNED)) { if (value & 0x8000) { value |= -0x10000; } } goto returnNumericObject; /* * 32-bit numeric values. */ case 'i': case 'I': case 'n': if (NeedReversing(type)) { value = (long) (buffer[0] + (buffer[1] << 8) + (buffer[2] << 16) + (((unsigned long)buffer[3]) << 24)); } else { value = (long) (buffer[3] + (buffer[2] << 8) + (buffer[1] << 16) + (((unsigned long) buffer[0]) << 24)); } /* * Check to see if the value was sign extended properly on systems * where an int is more than 32-bits. * * We avoid caching unsigned integers as we cannot distinguish between * 32bit signed and unsigned in the hash (short and char are ok). */ if (flags & BINARY_UNSIGNED) { return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); } if ((value & (((unsigned) 1) << 31)) && (value > 0)) { value -= (((unsigned) 1) << 31); value -= (((unsigned) 1) << 31); } returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewLongObj(value); } else { Tcl_HashTable *tablePtr = *numberCachePtrPtr; Tcl_HashEntry *hPtr; int isNew; hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew); if (!isNew) { return (Tcl_Obj *)Tcl_GetHashValue(hPtr); } if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) { Tcl_Obj *objPtr = Tcl_NewLongObj(value); Tcl_IncrRefCount(objPtr); Tcl_SetHashValue(hPtr, objPtr); return objPtr; } /* * We've overflowed the cache! Someone's parsing a LOT of varied * binary data in a single call! Bail out by switching back to the * old behaviour for the rest of the scan. * * Note that anyone just using the 'c' conversion (for bytes) * cannot trigger this. */ DeleteScanNumberCache(tablePtr); *numberCachePtrPtr = NULL; return Tcl_NewLongObj(value); } /* * Do not cache wide (64-bit) values; they are already too large to * use as keys. */ case 'w': case 'W': case 'm': if (NeedReversing(type)) { uwvalue = ((Tcl_WideUInt) buffer[0]) | (((Tcl_WideUInt) buffer[1]) << 8) | (((Tcl_WideUInt) buffer[2]) << 16) | (((Tcl_WideUInt) buffer[3]) << 24) | (((Tcl_WideUInt) buffer[4]) << 32) | (((Tcl_WideUInt) buffer[5]) << 40) | (((Tcl_WideUInt) buffer[6]) << 48) | (((Tcl_WideUInt) buffer[7]) << 56); } else { uwvalue = ((Tcl_WideUInt) buffer[7]) | (((Tcl_WideUInt) buffer[6]) << 8) | (((Tcl_WideUInt) buffer[5]) << 16) | (((Tcl_WideUInt) buffer[4]) << 24) | (((Tcl_WideUInt) buffer[3]) << 32) | (((Tcl_WideUInt) buffer[2]) << 40) | (((Tcl_WideUInt) buffer[1]) << 48) | (((Tcl_WideUInt) buffer[0]) << 56); } if (flags & BINARY_UNSIGNED) { Tcl_Obj *bigObj = NULL; mp_int big; TclBNInitBignumFromWideUInt(&big, uwvalue); bigObj = Tcl_NewBignumObj(&big); return bigObj; } return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); /* * Do not cache double values; they are already too large to use as * keys and the values stored are utterly incompatible with the * integer part of the cache. */ /* * 32-bit IEEE single-precision floating point. */ case 'f': case 'R': case 'r': CopyNumber(buffer, &fvalue, sizeof(float), type); return Tcl_NewDoubleObj(fvalue); /* * 64-bit IEEE double-precision floating point. */ case 'd': case 'Q': case 'q': CopyNumber(buffer, &dvalue, sizeof(double), type); return Tcl_NewDoubleObj(dvalue); } return NULL; } /* *---------------------------------------------------------------------- * * DeleteScanNumberCache -- * * Deletes the hash table acting as a scan number cache. * * Results: * None * * Side effects: * Decrements the reference counts of the objects in the cache. * *---------------------------------------------------------------------- */ static void DeleteScanNumberCache( Tcl_HashTable *numberCachePtr) /* Pointer to the hash table, or NULL (when * the cache has already been deleted due to * overflow.) */ { Tcl_HashEntry *hEntry; Tcl_HashSearch search; if (numberCachePtr == NULL) { return; } hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { Tcl_Obj *value = (Tcl_Obj *)Tcl_GetHashValue(hEntry); if (value != NULL) { Tcl_DecrRefCount(value); } hEntry = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(numberCachePtr); } /* * ---------------------------------------------------------------------- * * NOTES -- * * Some measurements show that it is faster to use a table to to perform * uuencode and base64 value encoding than to calculate the output (at * least on intel P4 arch). * * Conversely using a lookup table for the decoding is slower than just * calculating the values. We therefore use the fastest of each method. * * Presumably this has to do with the size of the tables. The base64 * decode table is 255 bytes while the encode table is only 65 bytes. The * choice likely depends on CPU memory cache sizes. */ /* *---------------------------------------------------------------------- * * BinaryEncodeHex -- * * Implement the [binary encode hex] binary encoding. clientData must be * a table to convert values to hexadecimal digits. * * Results: * Interp result set to an encoded byte array object * * Side effects: * None * *---------------------------------------------------------------------- */ static int BinaryEncodeHex( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data = NULL; unsigned char *cursor = NULL; int offset = 0, count = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "data"); return TCL_ERROR; } TclNewObj(resultObj); data = Tcl_GetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { *cursor++ = HexDigits[(data[offset] >> 4) & 0x0F]; *cursor++ = HexDigits[data[offset] & 0x0F]; } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *---------------------------------------------------------------------- * * BinaryDecodeHex -- * * Implement the [binary decode hex] binary encoding. * * Results: * Interp result set to an decoded byte array object * * Side effects: * None * *---------------------------------------------------------------------- */ static int BinaryDecodeHex( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor, c; int i, index, value, size, pure, count = 0, cut = 0, strict = 0; Tcl_UniChar ch = 0; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); pure = TclIsPureByteArray(objv[objc - 1]); datastart = data = pure ? Tcl_GetByteArrayFromObj(objv[objc - 1], &count) : (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = (count + 1) / 2; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { value = 0; for (i = 0 ; i < 2 ; i++) { if (data >= dataend) { value <<= 4; break; } c = *data++; if (!isxdigit((int) c)) { if (strict || !TclIsSpaceProc(c)) { goto badChar; } i--; continue; } value <<= 4; c -= '0'; if (c > 9) { c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } value |= c & 0xF; } if (i < 2) { cut++; } *cursor++ = UCHAR(value); value = 0; } if (cut > size) { cut = size; } Tcl_SetByteArrayLength(resultObj, cursor - begin - cut); Tcl_SetObjResult(interp, resultObj); return TCL_OK; badChar: if (pure) { ch = c; } else { TclUtfToUniChar((const char *)(data - 1), &ch); } TclDecrRefCount(resultObj); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid hexadecimal digit \"%c\" at position %d", ch, (int) (data - datastart - 1))); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * BinaryEncode64 -- * * This procedure implements the "binary encode base64" Tcl command. * * Results: * The base64 encoded value prescribed by the input arguments. * *---------------------------------------------------------------------- */ #define OUTPUT(c) \ do { \ *cursor++ = (c); \ outindex++; \ if (maxlen > 0 && cursor != limit) { \ if (outindex == maxlen) { \ memcpy(cursor, wrapchar, wrapcharlen); \ cursor += wrapcharlen; \ outindex = 0; \ } \ } \ if (cursor > limit) { \ Tcl_Panic("limit hit"); \ } \ } while (0) static int BinaryEncode64( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj; unsigned char *data, *limit; int maxlen = 0; const char *wrapchar = "\n"; int wrapcharlen = 1; int offset, i, index, size, outindex = 0, count = 0, purewrap = 1; enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } break; case OPT_WRAPCHAR: purewrap = TclIsPureByteArray(objv[i + 1]); if (purewrap) { wrapchar = (const char *) Tcl_GetByteArrayFromObj( objv[i + 1], &wrapcharlen); } else { wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen); } break; } } if (wrapcharlen == 0) { maxlen = 0; } TclNewObj(resultObj); data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { unsigned char *cursor = NULL; size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ if (maxlen > 0 && size > maxlen) { int adjusted = size + (wrapcharlen * (size / maxlen)); if (size % maxlen == 0) { adjusted -= wrapcharlen; } size = adjusted; if (purewrap == 0) { /* Wrapchar is (possibly) non-byte, so build result as * general string, not bytearray */ Tcl_SetObjLength(resultObj, size); cursor = (unsigned char *) TclGetString(resultObj); } } if (cursor == NULL) { cursor = Tcl_SetByteArrayLength(resultObj, size); } limit = cursor + size; for (offset = 0; offset < count; offset += 3) { unsigned char d[3] = {0, 0, 0}; for (i = 0; i < 3 && offset + i < count; ++i) { d[i] = data[offset + i]; } OUTPUT(B64Digits[d[0] >> 2]); OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); if (offset + 1 < count) { OUTPUT(B64Digits[((d[1] & 0x0F) << 2) | (d[2] >> 6)]); } else { OUTPUT(B64Digits[64]); } if (offset+2 < count) { OUTPUT(B64Digits[d[2] & 0x3F]); } else { OUTPUT(B64Digits[64]); } } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } #undef OUTPUT /* *---------------------------------------------------------------------- * * BinaryEncodeUu -- * * This implements the uuencode binary encoding. Input is broken into 6 * bit chunks and a lookup table is used to turn these values into output * characters. This differs from the generic code above in that line * lengths are also encoded. * * Results: * Interp result set to an encoded byte array object * * Side effects: * None * *---------------------------------------------------------------------- */ static int BinaryEncodeUu( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; int offset, count, rawLength, i, j, bits, index; unsigned int n; int lineLength = 61; const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; int wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: if (Tcl_GetIntFromObj(interp, objv[i + 1], &lineLength) != TCL_OK) { return TCL_ERROR; } if (lineLength < 5 || lineLength > 85) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */ break; case OPT_WRAPCHAR: wrapchar = (const unsigned char *) TclGetStringFromObj( objv[i + 1], &wrapcharlen); { const unsigned char *p = wrapchar; int numBytes = wrapcharlen; while (numBytes) { switch (*p) { case '\t': case '\v': case '\f': case '\r': p++; numBytes--; continue; case '\n': numBytes--; break; default: badwrap: Tcl_SetObjResult(interp, Tcl_NewStringObj( "invalid wrapchar; will defeat decoding", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "WRAPCHAR", NULL); return TCL_ERROR; } } if (numBytes) { goto badwrap; } } break; } } /* * Allocate the buffer. This is a little bit too long, but is "good * enough". */ TclNewObj(resultObj); offset = 0; data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * ((count + (rawLength - 1)) / rawLength)); n = bits = 0; /* * Encode the data. Each output line first has the length of raw data * encoded by the output line described in it by one encoded byte, then * the encoded data follows (encoding each 6 bits as one character). * Encoded lines are always terminated by a newline. */ while (offset < count) { int lineLen = count - offset; if (lineLen > rawLength) { lineLen = rawLength; } *cursor++ = UueDigits[lineLen]; for (i = 0 ; i < lineLen ; i++) { n <<= 8; n |= data[offset++]; for (bits += 8; bits > 6 ; bits -= 6) { *cursor++ = UueDigits[(n >> (bits - 6)) & 0x3F]; } } if (bits > 0) { n <<= 8; *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3F]; bits = 0; } for (j = 0 ; j < wrapcharlen ; ++j) { *cursor++ = wrapchar[j]; } } /* * Fix the length of the output bytearray. */ Tcl_SetByteArrayLength(resultObj, cursor - start); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *---------------------------------------------------------------------- * * BinaryDecodeUu -- * * Decode a uuencoded string. * * Results: * Interp result set to an byte array object * * Side effects: * None * *---------------------------------------------------------------------- */ static int BinaryDecodeUu( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; int i, index, size, pure, count = 0, strict = 0, lineLen; unsigned char c; Tcl_UniChar ch = 0; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); pure = TclIsPureByteArray(objv[objc - 1]); datastart = data = pure ? Tcl_GetByteArrayFromObj(objv[objc - 1], &count) : (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); lineLen = -1; /* * The decoding loop. First, we get the length of line (strictly, the * number of data bytes we expect to generate from the line) we're * processing this time round if it is not already known (i.e., when the * lineLen variable is set to the magic value, -1). */ while (data < dataend) { char d[4] = {0, 0, 0, 0}; if (lineLen < 0) { c = *data++; if (c < 32 || c > 96) { if (strict || !TclIsSpaceProc(c)) { goto badUu; } i--; continue; } lineLen = (c - 32) & 0x3F; } /* * Now we read a four-character grouping. */ for (i = 0 ; i < 4 ; i++) { if (data < dataend) { d[i] = c = *data++; if (c < 32 || c > 96) { if (strict) { if (!TclIsSpaceProc(c)) { goto badUu; } else if (c == '\n') { goto shortUu; } } i--; continue; } } } /* * Translate that grouping into (up to) three binary bytes output. */ if (lineLen > 0) { *cursor++ = (((d[0] - 0x20) & 0x3F) << 2) | (((d[1] - 0x20) & 0x3F) >> 4); if (--lineLen > 0) { *cursor++ = (((d[1] - 0x20) & 0x3F) << 4) | (((d[2] - 0x20) & 0x3F) >> 2); if (--lineLen > 0) { *cursor++ = (((d[2] - 0x20) & 0x3F) << 6) | (((d[3] - 0x20) & 0x3F)); lineLen--; } } } /* * If we've reached the end of the line, skip until we process a * newline. */ if (lineLen == 0 && data < dataend) { lineLen = -1; do { c = *data++; if (c == '\n') { break; } else if (c >= 32 && c <= 96) { data--; break; } else if (strict || !TclIsSpaceProc(c)) { goto badUu; } } while (data < dataend); } } /* * Sanity check, clean up and finish. */ if (lineLen > 0 && strict) { goto shortUu; } Tcl_SetByteArrayLength(resultObj, cursor - begin); Tcl_SetObjResult(interp, resultObj); return TCL_OK; shortUu: Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data")); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; badUu: if (pure) { ch = c; } else { TclUtfToUniChar((const char *)(data - 1), &ch); } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid uuencode character \"%c\" at position %d", ch, (int) (data - datastart - 1))); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * BinaryDecode64 -- * * Decode a base64 encoded string. * * Results: * Interp result set to an byte array object * * Side effects: * None * *---------------------------------------------------------------------- */ static int BinaryDecode64( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend, c = '\0'; unsigned char *begin = NULL; unsigned char *cursor = NULL; int pure, strict = 0; int i, index, size, cut = 0, count = 0; Tcl_UniChar ch = 0; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); pure = TclIsPureByteArray(objv[objc - 1]); datastart = data = pure ? Tcl_GetByteArrayFromObj(objv[objc - 1], &count) : (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { unsigned long value = 0; /* * Decode the current block. Each base64 block consists of four input * characters A-Z, a-z, 0-9, +, or /. Each character supplies six bits * of output data, so each block's output is 24 bits (three bytes) in * length. The final block can be shorter by one or two bytes, denoted * by the input ending with one or two ='s, respectively. */ for (i = 0; i < 4; i++) { /* * Get the next input character. At end of input, pad with at most * two ='s. If more than two ='s would be needed, instead discard * the block read thus far. */ if (data < dataend) { c = *data++; } else if (i > 1) { c = '='; } else { if (strict && i <= 1) { /* * Single resp. unfulfilled char (each 4th next single * char) is rather bad64 error case in strict mode. */ goto bad64; } cut += 3; break; } /* * Load the character into the block value. Handle ='s specially * because they're only valid as the last character or two of the * final block of input. Unless strict mode is enabled, skip any * input whitespace characters. */ if (cut) { if (c == '=' && i > 1) { value <<= 6; cut++; } else if (!strict) { i--; } else { goto bad64; } } else if (c >= 'A' && c <= 'Z') { value = (value << 6) | ((c - 'A') & 0x3F); } else if (c >= 'a' && c <= 'z') { value = (value << 6) | ((c - 'a' + 26) & 0x3F); } else if (c >= '0' && c <= '9') { value = (value << 6) | ((c - '0' + 52) & 0x3F); } else if (c == '+') { value = (value << 6) | 0x3E; } else if (c == '/') { value = (value << 6) | 0x3F; } else if (c == '=' && (!strict || i > 1)) { /* * "=" and "a=" is rather bad64 error case in strict mode. */ value <<= 6; if (i) { cut++; } } else if (strict) { goto bad64; } else { i--; } } *cursor++ = UCHAR((value >> 16) & 0xFF); *cursor++ = UCHAR((value >> 8) & 0xFF); *cursor++ = UCHAR(value & 0xFF); /* * Since = is only valid within the final block, if it was encountered * but there are still more input characters, confirm that strict mode * is off and all subsequent characters are whitespace. */ if (cut && data < dataend) { if (strict) { goto bad64; } } } Tcl_SetByteArrayLength(resultObj, cursor - begin - cut); Tcl_SetObjResult(interp, resultObj); return TCL_OK; bad64: if (pure) { ch = c; } else { /* The decoder is byte-oriented. If we saw a byte that's not a * valid member of the base64 alphabet, it could be the lead byte * of a multi-byte character. */ /* Safe because we know data is NUL-terminated */ TclUtfToUniChar((const char *)(data - 1), &ch); } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid base64 character \"%c\" at position %d", ch, (int) (data - datastart - 1))); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclCkalloc.c0000644000175000017500000010053414554262142015500 0ustar sergeisergei/* * tclCkalloc.c -- * * Interface to malloc and free that provides support for debugging * problems involving overwritten, double freeing memory and loss of * memory. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * This code contributed by Karl Lehenbauer and Mark Diekhans */ #include "tclInt.h" #define FALSE 0 #define TRUE 1 #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc #undef Tcl_AttemptAlloc #undef Tcl_AttemptRealloc #ifdef TCL_MEM_DEBUG /* * One of the following structures is allocated each time the * "memory tag" command is invoked, to hold the current tag. */ typedef struct MemTag { int refCount; /* Number of mem_headers referencing this * tag. */ char string[1]; /* Actual size of string will be as large as * needed for actual tag. This must be the * last field in the structure. */ } MemTag; #define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1U) + (bytesInString))) static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set * by "memory tag" command). */ /* * One of the following structures is allocated just before each dynamically * allocated chunk of memory, both to record information about the chunk and * to help detect chunk under-runs. */ #define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8) struct mem_header { struct mem_header *flink; struct mem_header *blink; MemTag *tagPtr; /* Tag from "memory tag" command; may be * NULL. */ const char *file; long length; int line; unsigned char low_guard[LOW_GUARD_SIZE]; /* Aligns body on 8-byte boundary, plus * provides at least 8 additional guard bytes * to detect underruns. */ char body[1]; /* First byte of client's space. Actual size * of this field will be larger than one. */ }; static struct mem_header *allocHead = NULL; /* List of allocated structures */ #define GUARD_VALUE 0141 /* * The following macro determines the amount of guard space *above* each chunk * of memory. */ #define HIGH_GUARD_SIZE 8 /* * The following macro computes the offset of the "body" field within * mem_header. It is used to get back to the header pointer from the body * pointer that's used by clients. */ #define BODY_OFFSET \ ((size_t) (&((struct mem_header *) 0)->body)) static int total_mallocs = 0; static int total_frees = 0; static size_t current_bytes_malloced = 0; static size_t maximum_bytes_malloced = 0; static int current_malloc_packets = 0; static int maximum_malloc_packets = 0; static int break_on_malloc = 0; static int trace_on_at_malloc = 0; static int alloc_tracing = FALSE; static int init_malloced_bodies = TRUE; #ifdef MEM_VALIDATE static int validate_memory = TRUE; #else static int validate_memory = FALSE; #endif /* * The following variable indicates to TclFinalizeMemorySubsystem() that it * should dump out the state of memory before exiting. If the value is * non-NULL, it gives the name of the file in which to dump memory usage * information. */ char *tclMemDumpFileName = NULL; static char *onExitMemDumpFileName = NULL; static char dumpFile[100]; /* Records where to dump memory allocation * information. */ /* * Mutex to serialize allocations. This is a low-level mutex that must be * explicitly initialized. This is necessary because the self initializing * mutexes use ckalloc... */ static Tcl_Mutex *ckallocMutexPtr; static int ckallocInit = 0; /* * Prototypes for procedures defined in this file: */ static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[]); static int MemoryCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[]); static void ValidateMemory(struct mem_header *memHeaderP, const char *file, int line, int nukeGuards); /* *---------------------------------------------------------------------- * * TclInitDbCkalloc -- * * Initialize the locks used by the allocator. This is only appropriate * to call in a single threaded environment, such as during * TclInitSubsystems. * *---------------------------------------------------------------------- */ void TclInitDbCkalloc(void) { if (!ckallocInit) { ckallocInit = 1; ckallocMutexPtr = Tcl_GetAllocMutex(); #ifndef TCL_THREADS /* Silence compiler warning */ (void)ckallocMutexPtr; #endif } } /* *---------------------------------------------------------------------- * * TclDumpMemoryInfo -- * * Display the global memory management statistics. * *---------------------------------------------------------------------- */ int TclDumpMemoryInfo( ClientData clientData, int flags) { char buf[1024]; if (clientData == NULL) { return 0; } snprintf(buf, sizeof(buf), "total mallocs %10d\n" "total frees %10d\n" "current packets allocated %10d\n" "current bytes allocated %10lu\n" "maximum packets allocated %10d\n" "maximum bytes allocated %10lu\n", total_mallocs, total_frees, current_malloc_packets, (unsigned long)current_bytes_malloced, maximum_malloc_packets, (unsigned long)maximum_bytes_malloced); if (flags == 0) { fprintf((FILE *)clientData, "%s", buf); } else { /* Assume objPtr to append to */ Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1); } return 1; } /* *---------------------------------------------------------------------- * * ValidateMemory -- * * Validate memory guard zones for a particular chunk of allocated * memory. * * Results: * None. * * Side effects: * Prints validation information about the allocated memory to stderr. * *---------------------------------------------------------------------- */ static void ValidateMemory( struct mem_header *memHeaderP, /* Memory chunk to validate */ const char *file, /* File containing the call to * Tcl_ValidateAllMemory */ int line, /* Line number of call to * Tcl_ValidateAllMemory */ int nukeGuards) /* If non-zero, indicates that the memory * guards are to be reset to 0 after they have * been printed */ { unsigned char *hiPtr; size_t idx; int guard_failed = FALSE; int byte; for (idx = 0; idx < LOW_GUARD_SIZE; idx++) { byte = *(memHeaderP->low_guard + idx); if (byte != GUARD_VALUE) { guard_failed = TRUE; fflush(stdout); byte &= 0xFF; fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } if (guard_failed) { TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "low guard failed at %lx, %s %d\n", (unsigned long)(size_t)memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, memHeaderP->line); Tcl_Panic("Memory validation failure"); } hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length; for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) { byte = *(hiPtr + idx); if (byte != GUARD_VALUE) { guard_failed = TRUE; fflush(stdout); byte &= 0xFF; fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } if (guard_failed) { TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "high guard failed at %lx, %s %d\n", (unsigned long)(size_t)memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, memHeaderP->line); Tcl_Panic("Memory validation failure"); } if (nukeGuards) { memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE); memset(hiPtr, 0, HIGH_GUARD_SIZE); } } /* *---------------------------------------------------------------------- * * Tcl_ValidateAllMemory -- * * Validate memory guard regions for all allocated memory. * * Results: * None. * * Side effects: * Displays memory validation information to stderr. * *---------------------------------------------------------------------- */ void Tcl_ValidateAllMemory( const char *file, /* File from which Tcl_ValidateAllMemory was * called. */ int line) /* Line number of call to * Tcl_ValidateAllMemory */ { struct mem_header *memScanP; if (!ckallocInit) { TclInitDbCkalloc(); } Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { ValidateMemory(memScanP, file, line, FALSE); } Tcl_MutexUnlock(ckallocMutexPtr); } /* *---------------------------------------------------------------------- * * Tcl_DumpActiveMemory -- * * Displays all allocated memory to a file; if no filename is given, * information will be written to stderr. * * Results: * Return TCL_ERROR if an error accessing the file occurs, `errno' will * have the file error number left in it. * *---------------------------------------------------------------------- */ int Tcl_DumpActiveMemory( const char *fileName) /* Name of the file to write info to */ { FILE *fileP; struct mem_header *memScanP; char *address; if (fileName == NULL) { fileP = stderr; } else { fileP = fopen(fileName, "w"); if (fileP == NULL) { return TCL_ERROR; } } Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { address = &memScanP->body[0]; fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s", (unsigned long)(size_t)address, (unsigned long)(size_t)address + memScanP->length - 1, memScanP->length, memScanP->file, memScanP->line, (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string); (void) fputc('\n', fileP); } Tcl_MutexUnlock(ckallocMutexPtr); if (fileP != stderr) { fclose(fileP); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_DbCkalloc - debugging ckalloc * * Allocate the requested amount of space plus some extra for guard bands * at both ends of the request, plus a size, panicking if there isn't * enough space, then write in the guard bands and return the address of * the space in the middle that the user asked for. * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent * by the ckalloc macro; it uses the preprocessor autodefines __FILE__ * and __LINE__. * *---------------------------------------------------------------------- */ char * Tcl_DbCkalloc( unsigned int size, const char *file, int line) { struct mem_header *result = NULL; if (validate_memory) { Tcl_ValidateAllMemory(file, line); } /* Don't let size argument to TclpAlloc overflow */ if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) { result = (struct mem_header *) TclpAlloc(size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } if (result == NULL) { fflush(stdout); TclDumpMemoryInfo((ClientData) stderr, 0); Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); } /* * Fill in guard zones and size. Also initialize the contents of the block * with bogus bytes to detect uses of initialized data. Link into * allocated list. */ if (init_malloced_bodies) { memset(result, GUARD_VALUE, size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } else { memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); } if (!ckallocInit) { TclInitDbCkalloc(); } Tcl_MutexLock(ckallocMutexPtr); result->length = size; result->tagPtr = curTagPtr; if (curTagPtr != NULL) { curTagPtr->refCount++; } result->file = file; result->line = line; result->flink = allocHead; result->blink = NULL; if (allocHead != NULL) { allocHead->blink = result; } allocHead = result; total_mallocs++; if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { (void) fflush(stdout); fprintf(stderr, "reached malloc trace enable point (%d)\n", total_mallocs); fflush(stderr); alloc_tracing = TRUE; trace_on_at_malloc = 0; } if (alloc_tracing) { fprintf(stderr,"ckalloc %lx %u %s %d\n", (unsigned long)(size_t)result->body, size, file, line); } if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; (void) fflush(stdout); Tcl_Panic("reached malloc break limit (%d)", total_mallocs); } current_malloc_packets++; if (current_malloc_packets > maximum_malloc_packets) { maximum_malloc_packets = current_malloc_packets; } current_bytes_malloced += size; if (current_bytes_malloced > maximum_bytes_malloced) { maximum_bytes_malloced = current_bytes_malloced; } Tcl_MutexUnlock(ckallocMutexPtr); return result->body; } char * Tcl_AttemptDbCkalloc( unsigned int size, const char *file, int line) { struct mem_header *result = NULL; if (validate_memory) { Tcl_ValidateAllMemory(file, line); } /* Don't let size argument to TclpAlloc overflow */ if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) { result = (struct mem_header *) TclpAlloc(size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } if (result == NULL) { fflush(stdout); TclDumpMemoryInfo((ClientData) stderr, 0); return NULL; } /* * Fill in guard zones and size. Also initialize the contents of the block * with bogus bytes to detect uses of initialized data. Link into * allocated list. */ if (init_malloced_bodies) { memset(result, GUARD_VALUE, size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } else { memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); } if (!ckallocInit) { TclInitDbCkalloc(); } Tcl_MutexLock(ckallocMutexPtr); result->length = size; result->tagPtr = curTagPtr; if (curTagPtr != NULL) { curTagPtr->refCount++; } result->file = file; result->line = line; result->flink = allocHead; result->blink = NULL; if (allocHead != NULL) { allocHead->blink = result; } allocHead = result; total_mallocs++; if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { (void) fflush(stdout); fprintf(stderr, "reached malloc trace enable point (%d)\n", total_mallocs); fflush(stderr); alloc_tracing = TRUE; trace_on_at_malloc = 0; } if (alloc_tracing) { fprintf(stderr,"ckalloc %lx %u %s %d\n", (unsigned long)(size_t)result->body, size, file, line); } if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; (void) fflush(stdout); Tcl_Panic("reached malloc break limit (%d)", total_mallocs); } current_malloc_packets++; if (current_malloc_packets > maximum_malloc_packets) { maximum_malloc_packets = current_malloc_packets; } current_bytes_malloced += size; if (current_bytes_malloced > maximum_bytes_malloced) { maximum_bytes_malloced = current_bytes_malloced; } Tcl_MutexUnlock(ckallocMutexPtr); return result->body; } /* *---------------------------------------------------------------------- * * Tcl_DbCkfree - debugging ckfree * * Verify that the low and high guards are intact, and if so then free * the buffer else Tcl_Panic. * * The guards are erased after being checked to catch duplicate frees. * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent * by the ckfree macro; it uses the preprocessor autodefines __FILE__ and * __LINE__. * *---------------------------------------------------------------------- */ void Tcl_DbCkfree( char *ptr, const char *file, int line) { struct mem_header *memp; if (ptr == NULL) { return; } /* * The following cast is *very* tricky. Must convert the pointer to an * integer before doing arithmetic on it, because otherwise the arithmetic * will be done differently (and incorrectly) on word-addressed machines * such as Crays (will subtract only bytes, even though BODY_OFFSET is in * words on these machines). */ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); if (alloc_tracing) { fprintf(stderr, "ckfree %lx %ld %s %d\n", (unsigned long)(size_t)memp->body, memp->length, file, line); } if (validate_memory) { Tcl_ValidateAllMemory(file, line); } Tcl_MutexLock(ckallocMutexPtr); ValidateMemory(memp, file, line, TRUE); if (init_malloced_bodies) { memset(ptr, GUARD_VALUE, memp->length); } total_frees++; current_malloc_packets--; current_bytes_malloced -= memp->length; if (memp->tagPtr != NULL) { memp->tagPtr->refCount--; if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) { TclpFree((char *) memp->tagPtr); } } /* * Delink from allocated list */ if (memp->flink != NULL) { memp->flink->blink = memp->blink; } if (memp->blink != NULL) { memp->blink->flink = memp->flink; } if (allocHead == memp) { allocHead = memp->flink; } TclpFree((char *) memp); Tcl_MutexUnlock(ckallocMutexPtr); } /* *-------------------------------------------------------------------- * * Tcl_DbCkrealloc - debugging ckrealloc * * Reallocate a chunk of memory by allocating a new one of the right * size, copying the old data to the new location, and then freeing the * old memory space, using all the memory checking features of this * package. * *-------------------------------------------------------------------- */ char * Tcl_DbCkrealloc( char *ptr, unsigned int size, const char *file, int line) { char *newPtr; unsigned int copySize; struct mem_header *memp; if (ptr == NULL) { return Tcl_DbCkalloc(size, file, line); } /* * See comment from Tcl_DbCkfree before you change the following line. */ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); copySize = size; if (copySize > (unsigned int) memp->length) { copySize = memp->length; } newPtr = Tcl_DbCkalloc(size, file, line); memcpy(newPtr, ptr, copySize); Tcl_DbCkfree(ptr, file, line); return newPtr; } char * Tcl_AttemptDbCkrealloc( char *ptr, unsigned int size, const char *file, int line) { char *newPtr; unsigned int copySize; struct mem_header *memp; if (ptr == NULL) { return Tcl_AttemptDbCkalloc(size, file, line); } /* * See comment from Tcl_DbCkfree before you change the following line. */ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); copySize = size; if (copySize > (unsigned int) memp->length) { copySize = memp->length; } newPtr = Tcl_AttemptDbCkalloc(size, file, line); if (newPtr == NULL) { return NULL; } memcpy(newPtr, ptr, copySize); Tcl_DbCkfree(ptr, file, line); return newPtr; } /* *---------------------------------------------------------------------- * * Tcl_Alloc, et al. -- * * These functions are defined in terms of the debugging versions when * TCL_MEM_DEBUG is set. * * Results: * Same as the debug versions. * * Side effects: * Same as the debug versions. * *---------------------------------------------------------------------- */ char * Tcl_Alloc( unsigned int size) { return Tcl_DbCkalloc(size, "unknown", 0); } char * Tcl_AttemptAlloc( unsigned int size) { return Tcl_AttemptDbCkalloc(size, "unknown", 0); } void Tcl_Free( char *ptr) { Tcl_DbCkfree(ptr, "unknown", 0); } char * Tcl_Realloc( char *ptr, unsigned int size) { return Tcl_DbCkrealloc(ptr, size, "unknown", 0); } char * Tcl_AttemptRealloc( char *ptr, unsigned int size) { return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0); } /* *---------------------------------------------------------------------- * * MemoryCmd -- * * Implements the Tcl "memory" command, which provides Tcl-level control * of Tcl memory debugging information. * memory active $file * memory break_on_malloc $count * memory info * memory init on|off * memory onexit $file * memory tag $string * memory trace on|off * memory trace_on_at_malloc $count * memory validate on|off * * Results: * Standard TCL results. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static int MemoryCmd( ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[]) { const char *fileName; FILE *fileP; Tcl_DString buffer; int result; size_t len; if (argc < 2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s option [args..]\"", argv[0])); return TCL_ERROR; } if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) { if (argc != 3) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s %s file\"", argv[0], argv[1])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } result = Tcl_DumpActiveMemory(fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", argv[2], Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"break_on_malloc") == 0) { if (argc != 3) { goto argError; } if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, "current bytes allocated", (unsigned long)current_bytes_malloced, "maximum packets allocated", maximum_malloc_packets, "maximum bytes allocated", (unsigned long)maximum_bytes_malloced)); return TCL_OK; } if (strcmp(argv[1], "init") == 0) { if (argc != 3) { goto bad_suboption; } init_malloced_bodies = (strcmp(argv[2],"on") == 0); return TCL_OK; } if (strcmp(argv[1], "objs") == 0) { if (argc != 3) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s objs file\"", argv[0])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } fileP = fopen(fileName, "w"); if (fileP == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot open output file: %s", Tcl_PosixError(interp))); return TCL_ERROR; } TclDbDumpActiveObjects(fileP); fclose(fileP); Tcl_DStringFree(&buffer); return TCL_OK; } if (strcmp(argv[1],"onexit") == 0) { if (argc != 3) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s onexit file\"", argv[0])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } onExitMemDumpFileName = dumpFile; strcpy(onExitMemDumpFileName,fileName); Tcl_DStringFree(&buffer); return TCL_OK; } if (strcmp(argv[1],"tag") == 0) { if (argc != 3) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s tag string\"", argv[0])); return TCL_ERROR; } if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { TclpFree((char *) curTagPtr); } len = strlen(argv[2]); curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len)); curTagPtr->refCount = 0; memcpy(curTagPtr->string, argv[2], len + 1); return TCL_OK; } if (strcmp(argv[1],"trace") == 0) { if (argc != 3) { goto bad_suboption; } alloc_tracing = (strcmp(argv[2],"on") == 0); return TCL_OK; } if (strcmp(argv[1],"trace_on_at_malloc") == 0) { if (argc != 3) { goto argError; } if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"validate") == 0) { if (argc != 3) { goto bad_suboption; } validate_memory = (strcmp(argv[2],"on") == 0); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": should be active, break_on_malloc, info, " "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", argv[1])); return TCL_ERROR; argError: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s %s count\"", argv[0], argv[1])); return TCL_ERROR; bad_suboption: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1])); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * CheckmemCmd -- * * This is the command procedure for the "checkmem" command, which causes * the application to exit after printing information about memory usage * to the file passed to this command as its first argument. * * Results: * Returns a standard Tcl completion code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CheckmemCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter for evaluation. */ int argc, /* Number of arguments. */ const char *argv[]) /* String values of arguments. */ { if (argc != 2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s fileName\"", argv[0])); return TCL_ERROR; } tclMemDumpFileName = dumpFile; strcpy(tclMemDumpFileName, argv[1]); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_InitMemory -- * * Create the "memory" and "checkmem" commands in the given interpreter. * * Results: * None. * * Side effects: * New commands are added to the interpreter. * *---------------------------------------------------------------------- */ void Tcl_InitMemory( Tcl_Interp *interp) /* Interpreter in which commands should be * added */ { TclInitDbCkalloc(); Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL); Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } #else /* TCL_MEM_DEBUG */ /* This is the !TCL_MEM_DEBUG case */ #undef Tcl_InitMemory #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory /* *---------------------------------------------------------------------- * * Tcl_Alloc -- * * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check * that memory was actually allocated. * *---------------------------------------------------------------------- */ char * Tcl_Alloc( unsigned int size) { char *result; result = TclpAlloc(size); /* * Most systems will not alloc(0), instead bumping it to one so that NULL * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning * NULL, so we have to check that the NULL we get is not in response to * alloc(0). * * The ANSI spec actually says that systems either return NULL *or* a * special pointer on failure, but we only check for NULL */ if ((result == NULL) && size) { Tcl_Panic("unable to alloc %u bytes", size); } return result; } char * Tcl_DbCkalloc( unsigned int size, const char *file, int line) { char *result; result = (char *) TclpAlloc(size); if ((result == NULL) && size) { fflush(stdout); Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); } return result; } /* *---------------------------------------------------------------------- * * Tcl_AttemptAlloc -- * * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not * check that memory was actually allocated. * *---------------------------------------------------------------------- */ char * Tcl_AttemptAlloc( unsigned int size) { char *result; result = TclpAlloc(size); return result; } char * Tcl_AttemptDbCkalloc( unsigned int size, const char *file, int line) { char *result; (void)file; (void)line; result = (char *) TclpAlloc(size); return result; } /* *---------------------------------------------------------------------- * * Tcl_Realloc -- * * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check * that memory was actually allocated. * *---------------------------------------------------------------------- */ char * Tcl_Realloc( char *ptr, unsigned int size) { char *result; result = TclpRealloc(ptr, size); if ((result == NULL) && size) { Tcl_Panic("unable to realloc %u bytes", size); } return result; } char * Tcl_DbCkrealloc( char *ptr, unsigned int size, const char *file, int line) { char *result; result = (char *) TclpRealloc(ptr, size); if ((result == NULL) && size) { fflush(stdout); Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line); } return result; } /* *---------------------------------------------------------------------- * * Tcl_AttemptRealloc -- * * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not * check that memory was actually allocated. * *---------------------------------------------------------------------- */ char * Tcl_AttemptRealloc( char *ptr, unsigned int size) { char *result; result = TclpRealloc(ptr, size); return result; } char * Tcl_AttemptDbCkrealloc( char *ptr, unsigned int size, const char *file, int line) { char *result; (void)file; (void)line; result = (char *) TclpRealloc(ptr, size); return result; } /* *---------------------------------------------------------------------- * * Tcl_Free -- * * Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here rather * in the macro to keep some modules from being compiled with * TCL_MEM_DEBUG enabled and some with it disabled. * *---------------------------------------------------------------------- */ void Tcl_Free( char *ptr) { TclpFree(ptr); } void Tcl_DbCkfree( char *ptr, const char *file, int line) { (void)file; (void)line; TclpFree(ptr); } /* *---------------------------------------------------------------------- * * Tcl_InitMemory -- * * Dummy initialization for memory command, which is only available if * TCL_MEM_DEBUG is on. * *---------------------------------------------------------------------- */ /* ARGSUSED */ void Tcl_InitMemory( Tcl_Interp *interp) { (void)interp; } int Tcl_DumpActiveMemory( const char *fileName) { (void)fileName; return TCL_OK; } void Tcl_ValidateAllMemory( const char *file, int line) { (void)file; (void)line; } int TclDumpMemoryInfo( ClientData clientData, int flags) { (void)clientData; (void)flags; return 1; } #endif /* TCL_MEM_DEBUG */ /* *--------------------------------------------------------------------------- * * TclFinalizeMemorySubsystem -- * * This procedure is called to finalize all the structures that are used * by the memory allocator on a per-process basis. * * Results: * None. * * Side effects: * This subsystem is self-initializing, since memory can be allocated * before Tcl is formally initialized. After this call, this subsystem * has been reset to its initial state and is usable again. * *--------------------------------------------------------------------------- */ void TclFinalizeMemorySubsystem(void) { #ifdef TCL_MEM_DEBUG if (tclMemDumpFileName != NULL) { Tcl_DumpActiveMemory(tclMemDumpFileName); } else if (onExitMemDumpFileName != NULL) { Tcl_DumpActiveMemory(onExitMemDumpFileName); } Tcl_MutexLock(ckallocMutexPtr); if (curTagPtr != NULL) { TclpFree((char *) curTagPtr); curTagPtr = NULL; } allocHead = NULL; Tcl_MutexUnlock(ckallocMutexPtr); #endif #if defined(USE_TCLALLOC) && USE_TCLALLOC TclFinalizeAllocSubsystem(); #endif } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/generic/tclClock.c0000644000175000017500000015667414554262142015203 0ustar sergeisergei/* * tclClock.c -- * * Contains the time and date related commands. This code is derived from * the time and date facilities of TclX, by Mark Diekhans and Karl * Lehenbauer. * * Copyright (c) 1991-1995 Karl Lehenbauer & Mark Diekhans. * Copyright (c) 1995 Sun Microsystems, Inc. * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Windows has mktime. The configurators do not check. */ #ifdef _WIN32 #define HAVE_MKTIME 1 #endif /* * Constants */ #define JULIAN_DAY_POSIX_EPOCH 2440588 #define SECONDS_PER_DAY 86400 #define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \ * SECONDS_PER_DAY) #define FOUR_CENTURIES 146097 /* days */ #define JDAY_1_JAN_1_CE_JULIAN 1721424 #define JDAY_1_JAN_1_CE_GREGORIAN 1721426 #define ONE_CENTURY_GREGORIAN 36524 /* days */ #define FOUR_YEARS 1461 /* days */ #define ONE_YEAR 365 /* days */ /* * Table of the days in each month, leap and common years */ static const int hath[2][12] = { {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}, {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} }; static const int daysInPriorMonths[2][13] = { {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365}, {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366} }; /* * Enumeration of the string literals used in [clock] */ typedef enum ClockLiteral { LIT__NIL, LIT__DEFAULT_FORMAT, LIT_BCE, LIT_C, LIT_CANNOT_USE_GMT_AND_TIMEZONE, LIT_CE, LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, LIT_ERA, LIT_GMT, LIT_GREGORIAN, LIT_INTEGER_VALUE_TOO_LARGE, LIT_ISO8601WEEK, LIT_ISO8601YEAR, LIT_JULIANDAY, LIT_LOCALSECONDS, LIT_MONTH, LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, LIT_YEAR, LIT__END } ClockLiteral; static const char *const literals[] = { "", "%a %b %d %H:%M:%S %Z %Y", "BCE", "C", "cannot use -gmt and -timezone in same call", "CE", "dayOfMonth", "dayOfWeek", "dayOfYear", "era", ":GMT", "gregorian", "integer value too large to represent", "iso8601Week", "iso8601Year", "julianDay", "localSeconds", "month", "seconds", "tzName", "tzOffset", "year" }; /* * Structure containing the client data for [clock] */ typedef struct { size_t refCount; /* Number of live references. */ Tcl_Obj **literals; /* Pool of object literals. */ } ClockClientData; /* * Structure containing the fields used in [clock format] and [clock scan] */ typedef struct TclDateFields { Tcl_WideInt seconds; /* Time expressed in seconds from the Posix * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds * from the Posix epoch */ int tzOffset; /* Time zone offset in seconds east of * Greenwich */ Tcl_Obj *tzName; /* Time zone name */ int julianDay; /* Julian Day Number in local time zone */ enum {BCE=1, CE=0} era; /* Era */ int gregorian; /* Flag == 1 if the date is Gregorian */ int year; /* Year of the era */ int dayOfYear; /* Day of the year (1 January == 1) */ int month; /* Month number */ int dayOfMonth; /* Day of the month */ int iso8601Year; /* ISO8601 week-based year */ int iso8601Week; /* ISO8601 week number */ int dayOfWeek; /* Day of the week */ } TclDateFields; static const char *const eras[] = { "CE", "BCE", NULL }; /* * Thread specific data block holding a 'struct tm' for the 'gmtime' and * 'localtime' library calls. */ static Tcl_ThreadDataKey tmKey; /* * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls and the statics * in the date parsing code. */ TCL_DECLARE_MUTEX(clockMutex) /* * Function prototypes for local procedures in this file: */ static int ConvertUTCToLocal(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, TclDateFields *, int, Tcl_Obj *const[]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); static int ConvertLocalToUTC(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, TclDateFields *, int, Tcl_Obj *const[]); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, int, Tcl_Obj *const *); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int); static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int); static int IsGregorianLeapYear(TclDateFields *); static int WeekdayOnOrBefore(int, int); static int ClockClicksObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockConvertlocaltoutcObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockGetdatefieldsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockGetjuliandayfromerayearmonthdayObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockGetjuliandayfromerayearweekdayObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockGetenvObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockMicrosecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockMillisecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockParseformatargsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockSecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static struct tm * ThreadSafeLocalTime(const time_t *); static void TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); /* * Structure containing description of "native" clock commands to create. */ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::". When NULL marks * the end of the table. */ Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This * will always have the ClockClientData sent * to it, but may well ignore this data. */ }; static const struct ClockCommand clockCommands[] = { { "getenv", ClockGetenvObjCmd }, { "Oldscan", TclClockOldscanObjCmd }, { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, { "GetDateFields", ClockGetdatefieldsObjCmd }, { "GetJulianDayFromEraYearMonthDay", ClockGetjuliandayfromerayearmonthdayObjCmd }, { "GetJulianDayFromEraYearWeekDay", ClockGetjuliandayfromerayearweekdayObjCmd }, { "ParseFormatArgs", ClockParseformatargsObjCmd }, { NULL, NULL } }; /* *---------------------------------------------------------------------- * * TclClockInit -- * * Registers the 'clock' subcommands with the Tcl interpreter and * initializes its client data (which consists mostly of constant * Tcl_Obj's that it is too much trouble to keep recreating). * * Results: * None. * * Side effects: * Installs the commands and creates the client data * *---------------------------------------------------------------------- */ void TclClockInit( Tcl_Interp *interp) /* Tcl interpreter */ { const struct ClockCommand *clockCmdPtr; char cmdName[50]; /* Buffer large enough to hold the string *::tcl::clock::GetJulianDayFromEraYearMonthDay * plus a terminating NUL. */ ClockClientData *data; int i; /* Structure of the 'clock' ensemble */ static const EnsembleImplMap clockImplMap[] = { {"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, NULL, 0}, {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0}, {"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0}, {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0}, {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* * Safe interps get [::clock] as alias to a parent, so do not need their * own copies of the support routines. */ if (Tcl_IsSafe(interp)) { return; } /* * Create the client data, which is a refcounted literal pool. */ data = (ClockClientData *)ckalloc(sizeof(ClockClientData)); data->refCount = 0; data->literals = (Tcl_Obj **)ckalloc(LIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < LIT__END; ++i) { data->literals[i] = Tcl_NewStringObj(literals[i], -1); Tcl_IncrRefCount(data->literals[i]); } /* * Install the commands. * TODO - Let Tcl_MakeEnsemble do this? */ #define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */ memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN); for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) { strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name); data->refCount++; Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data, ClockDeleteCmdProc); } /* Make the clock ensemble */ TclMakeEnsemble(interp, "clock", clockImplMap); } /* *---------------------------------------------------------------------- * * ClockConvertlocaltoutcObjCmd -- * * Tcl command that converts a UTC time to a local time by whatever means * is available. * * Usage: * ::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover * * Parameters: * dict - Dictionary containing a 'localSeconds' entry. * tzdata - Time zone data * changeover - Julian Day of the adoption of the Gregorian calendar. * * Results: * Returns a standard Tcl result. * * Side effects: * On success, sets the interpreter result to the given dictionary * augmented with a 'seconds' field giving the UTC time. On failure, * leaves an error message in the interpreter result. * *---------------------------------------------------------------------- */ static int ClockConvertlocaltoutcObjCmd( ClientData clientData, /* Client data */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { ClockClientData *data = (ClockClientData *)clientData; Tcl_Obj *const *lit = data->literals; Tcl_Obj *secondsObj; Tcl_Obj *dict; int changeover; TclDateFields fields; int created = 0; int status; /* * Check params and convert time. */ if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover"); return TCL_ERROR; } dict = objv[1]; if (Tcl_DictObjGet(interp, dict, lit[LIT_LOCALSECONDS], &secondsObj)!= TCL_OK) { return TCL_ERROR; } if (secondsObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not " "found in dictionary", -1)); return TCL_ERROR; } if ((TclGetWideIntFromObj(interp, secondsObj, &fields.localSeconds) != TCL_OK) || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) { return TCL_ERROR; } /* * Copy-on-write; set the 'seconds' field in the dictionary and place the * modified dictionary in the interpreter result. */ if (Tcl_IsShared(dict)) { dict = Tcl_DuplicateObj(dict); created = 1; Tcl_IncrRefCount(dict); } status = Tcl_DictObjPut(interp, dict, lit[LIT_SECONDS], Tcl_NewWideIntObj(fields.seconds)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); } if (created) { Tcl_DecrRefCount(dict); } return status; } /* *---------------------------------------------------------------------- * * ClockGetdatefieldsObjCmd -- * * Tcl command that determines the values that [clock format] will use in * formatting a date, and populates a dictionary with them. * * Usage: * ::tcl::clock::GetDateFields seconds tzdata changeover * * Parameters: * seconds - Time expressed in seconds from the Posix epoch. * tzdata - Time zone data of the time zone in which time is to be * expressed. * changeover - Julian Day Number at which the current locale adopted * the Gregorian calendar * * Results: * Returns a dictonary populated with the fields: * seconds - Seconds from the Posix epoch * localSeconds - Nominal seconds from the Posix epoch in the * local time zone. * tzOffset - Time zone offset in seconds east of Greenwich * tzName - Time zone name * julianDay - Julian Day Number in the local time zone * *---------------------------------------------------------------------- */ int ClockGetdatefieldsObjCmd( ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; ClockClientData *data = (ClockClientData *)clientData; Tcl_Obj *const *lit = data->literals; int changeover; /* * Check params. */ if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover"); return TCL_ERROR; } if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) { return TCL_ERROR; } /* * fields.seconds could be an unsigned number that overflowed. Make sure * that it isn't. */ if (objv[1]->typePtr == &tclBignumType) { Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]); return TCL_ERROR; } /* * Convert UTC time to local. */ if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) { return TCL_ERROR; } /* * Extract Julian day. Always round the quotient down by subtracting 1 * when the remainder is negative (i.e. if the quotient was rounded up). */ fields.julianDay = (int) ((fields.localSeconds / SECONDS_PER_DAY) - ((fields.localSeconds % SECONDS_PER_DAY) < 0) + JULIAN_DAY_POSIX_EPOCH); /* * Convert to Julian or Gregorian calendar. */ GetGregorianEraYearDay(&fields, changeover); GetMonthDay(&fields); GetYearWeekDay(&fields, changeover); dict = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, dict, lit[LIT_LOCALSECONDS], Tcl_NewWideIntObj(fields.localSeconds)); Tcl_DictObjPut(NULL, dict, lit[LIT_SECONDS], Tcl_NewWideIntObj(fields.seconds)); Tcl_DictObjPut(NULL, dict, lit[LIT_TZNAME], fields.tzName); Tcl_DecrRefCount(fields.tzName); Tcl_DictObjPut(NULL, dict, lit[LIT_TZOFFSET], Tcl_NewIntObj(fields.tzOffset)); Tcl_DictObjPut(NULL, dict, lit[LIT_JULIANDAY], Tcl_NewIntObj(fields.julianDay)); Tcl_DictObjPut(NULL, dict, lit[LIT_GREGORIAN], Tcl_NewIntObj(fields.gregorian)); Tcl_DictObjPut(NULL, dict, lit[LIT_ERA], lit[fields.era ? LIT_BCE : LIT_CE]); Tcl_DictObjPut(NULL, dict, lit[LIT_YEAR], Tcl_NewIntObj(fields.year)); Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFYEAR], Tcl_NewIntObj(fields.dayOfYear)); Tcl_DictObjPut(NULL, dict, lit[LIT_MONTH], Tcl_NewIntObj(fields.month)); Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFMONTH], Tcl_NewIntObj(fields.dayOfMonth)); Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601YEAR], Tcl_NewIntObj(fields.iso8601Year)); Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601WEEK], Tcl_NewIntObj(fields.iso8601Week)); Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFWEEK], Tcl_NewIntObj(fields.dayOfWeek)); Tcl_SetObjResult(interp, dict); return TCL_OK; } /* *---------------------------------------------------------------------- * * ClockGetjuliandayfromerayearmonthdayObjCmd -- * * Tcl command that converts a time from era-year-month-day to a Julian * Day Number. * * Parameters: * dict - Dictionary that contains 'era', 'year', 'month' and * 'dayOfMonth' keys. * changeover - Julian Day of changeover to the Gregorian calendar * * Results: * Result is either TCL_OK, with the interpreter result being the * dictionary augmented with a 'julianDay' key, or TCL_ERROR, * with the result being an error message. * *---------------------------------------------------------------------- */ static int FetchEraField( Tcl_Interp *interp, Tcl_Obj *dict, Tcl_Obj *key, int *storePtr) { Tcl_Obj *value = NULL; if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) { return TCL_ERROR; } if (value == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "expected key(s) not found in dictionary", -1)); return TCL_ERROR; } return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr); } static int FetchIntField( Tcl_Interp *interp, Tcl_Obj *dict, Tcl_Obj *key, int *storePtr) { Tcl_Obj *value = NULL; if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) { return TCL_ERROR; } if (value == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "expected key(s) not found in dictionary", -1)); return TCL_ERROR; } return TclGetIntFromObj(interp, value, storePtr); } static int ClockGetjuliandayfromerayearmonthdayObjCmd( ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; ClockClientData *data = (ClockClientData *)clientData; Tcl_Obj *const *lit = data->literals; int changeover; int copied = 0; int status; int era = 0; /* * Check params. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); return TCL_ERROR; } dict = objv[1]; if (FetchEraField(interp, dict, lit[LIT_ERA], &era) != TCL_OK || FetchIntField(interp, dict, lit[LIT_YEAR], &fields.year) != TCL_OK || FetchIntField(interp, dict, lit[LIT_MONTH], &fields.month) != TCL_OK || FetchIntField(interp, dict, lit[LIT_DAYOFMONTH], &fields.dayOfMonth) != TCL_OK || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { return TCL_ERROR; } fields.era = era; /* * Get Julian day. */ GetJulianDayFromEraYearMonthDay(&fields, changeover); /* * Store Julian day in the dictionary - copy on write. */ if (Tcl_IsShared(dict)) { dict = Tcl_DuplicateObj(dict); Tcl_IncrRefCount(dict); copied = 1; } status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY], Tcl_NewIntObj(fields.julianDay)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); } if (copied) { Tcl_DecrRefCount(dict); } return status; } /* *---------------------------------------------------------------------- * * ClockGetjuliandayfromerayearweekdayObjCmd -- * * Tcl command that converts a time from the ISO calendar to a Julian Day * Number. * * Parameters: * dict - Dictionary that contains 'era', 'iso8601Year', 'iso8601Week' * and 'dayOfWeek' keys. * changeover - Julian Day of changeover to the Gregorian calendar * * Results: * Result is either TCL_OK, with the interpreter result being the * dictionary augmented with a 'julianDay' key, or TCL_ERROR, with the * result being an error message. * *---------------------------------------------------------------------- */ static int ClockGetjuliandayfromerayearweekdayObjCmd( ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; ClockClientData *data = (ClockClientData *)clientData; Tcl_Obj *const *lit = data->literals; int changeover; int copied = 0; int status; int era = 0; /* * Check params. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); return TCL_ERROR; } dict = objv[1]; if (FetchEraField(interp, dict, lit[LIT_ERA], &era) != TCL_OK || FetchIntField(interp, dict, lit[LIT_ISO8601YEAR], &fields.iso8601Year) != TCL_OK || FetchIntField(interp, dict, lit[LIT_ISO8601WEEK], &fields.iso8601Week) != TCL_OK || FetchIntField(interp, dict, lit[LIT_DAYOFWEEK], &fields.dayOfWeek) != TCL_OK || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { return TCL_ERROR; } fields.era = era; /* * Get Julian day. */ GetJulianDayFromEraYearWeekDay(&fields, changeover); /* * Store Julian day in the dictionary - copy on write. */ if (Tcl_IsShared(dict)) { dict = Tcl_DuplicateObj(dict); Tcl_IncrRefCount(dict); copied = 1; } status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY], Tcl_NewIntObj(fields.julianDay)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); } if (copied) { Tcl_DecrRefCount(dict); } return status; } /* *---------------------------------------------------------------------- * * ConvertLocalToUTC -- * * Converts a time (in a TclDateFields structure) from the local wall * clock to UTC. * * Results: * Returns a standard Tcl result. * * Side effects: * Populates the 'seconds' field if successful; stores an error message * in the interpreter result on failure. * *---------------------------------------------------------------------- */ static int ConvertLocalToUTC( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* * Unpack the tz data. */ if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } /* * Special case: If the time zone is :localtime, the tzdata will be empty. * Use 'mktime' to convert the time to local */ if (rowc == 0) { return ConvertLocalToUTCUsingC(interp, fields, changeover); } else { return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv); } } /* *---------------------------------------------------------------------- * * ConvertLocalToUTCUsingTable -- * * Converts a time (in a TclDateFields structure) from local time in a * given time zone to UTC. * * Results: * Returns a standard Tcl result. * * Side effects: * Stores an error message in the interpreter if an error occurs; if * successful, stores the 'seconds' field in 'fields. * *---------------------------------------------------------------------- */ static int ConvertLocalToUTCUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ int rowc, /* Number of points at which time changes */ Tcl_Obj *const rowv[]) /* Points at which time changes */ { Tcl_Obj *row; int cellc; Tcl_Obj **cellv; int have[8]; int nHave = 0; int i; int found; /* * Perform an initial lookup assuming that local == UTC, and locate the * last time conversion prior to that time. Get the offset from that row, * and look up again. Continue until we find an offset that we found * before. This definition, rather than "the same offset" ensures that we * don't enter an endless loop, as would otherwise happen when trying to * convert a non-existent time such as 02:30 during the US Spring Daylight * Saving Time transition. */ found = 0; fields->tzOffset = 0; fields->seconds = fields->localSeconds; while (!found) { row = LookupLastTransition(interp, fields->seconds, rowc, rowv); if ((row == NULL) || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { return TCL_ERROR; } found = 0; for (i = 0; !found && i < nHave; ++i) { if (have[i] == fields->tzOffset) { found = 1; break; } } if (!found) { if (nHave == 8) { Tcl_Panic("loop in ConvertLocalToUTCUsingTable"); } have[nHave++] = fields->tzOffset; } fields->seconds = fields->localSeconds - fields->tzOffset; } fields->tzOffset = have[i]; fields->seconds = fields->localSeconds - fields->tzOffset; return TCL_OK; } /* *---------------------------------------------------------------------- * * ConvertLocalToUTCUsingC -- * * Converts a time from local wall clock to UTC when the local time zone * cannot be determined. Uses 'mktime' to do the job. * * Results: * Returns a standard Tcl result. * * Side effects: * Stores an error message in the interpreter if an error occurs; if * successful, stores the 'seconds' field in 'fields. * *---------------------------------------------------------------------- */ static int ConvertLocalToUTCUsingC( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ int changeover) /* Julian Day of the Gregorian transition */ { struct tm timeVal; int localErrno; int secondOfDay; Tcl_WideInt jsec; /* * Convert the given time to a date. */ jsec = fields->localSeconds + JULIAN_SEC_POSIX_EPOCH; fields->julianDay = (int) (jsec / SECONDS_PER_DAY); secondOfDay = (int)(jsec % SECONDS_PER_DAY); if (secondOfDay < 0) { secondOfDay += SECONDS_PER_DAY; fields->julianDay--; } GetGregorianEraYearDay(fields, changeover); GetMonthDay(fields); /* * Convert the date/time to a 'struct tm'. */ timeVal.tm_year = fields->year - 1900; timeVal.tm_mon = fields->month - 1; timeVal.tm_mday = fields->dayOfMonth; timeVal.tm_hour = (secondOfDay / 3600) % 24; timeVal.tm_min = (secondOfDay / 60) % 60; timeVal.tm_sec = secondOfDay % 60; timeVal.tm_isdst = -1; timeVal.tm_wday = -1; timeVal.tm_yday = -1; /* * Get local time. It is rumored that mktime is not thread safe on some * platforms, so seize a mutex before attempting this. */ TzsetIfNecessary(); Tcl_MutexLock(&clockMutex); errno = 0; fields->seconds = (Tcl_WideInt) mktime(&timeVal); localErrno = (fields->seconds == -1) ? errno : 0; Tcl_MutexUnlock(&clockMutex); /* * If conversion fails, report an error. */ if (localErrno != 0 || (fields->seconds == -1 && timeVal.tm_yday == -1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "time value too large/small to represent", -1)); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * ConvertUTCToLocal -- * * Converts a time (in a TclDateFields structure) from UTC to local time. * * Results: * Returns a standard Tcl result. * * Side effects: * Populates the 'tzName' and 'tzOffset' fields. * *---------------------------------------------------------------------- */ static int ConvertUTCToLocal( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* * Unpack the tz data. */ if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } /* * Special case: If the time zone is :localtime, the tzdata will be empty. * Use 'localtime' to convert the time to local */ if (rowc == 0) { return ConvertUTCToLocalUsingC(interp, fields, changeover); } else { return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv); } } /* *---------------------------------------------------------------------- * * ConvertUTCToLocalUsingTable -- * * Converts UTC to local time, given a table of transition points * * Results: * Returns a standard Tcl result * * Side effects: * On success, fills fields->tzName, fields->tzOffset and * fields->localSeconds. On failure, places an error message in the * interpreter result. * *---------------------------------------------------------------------- */ static int ConvertUTCToLocalUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the date */ int rowc, /* Number of rows in the conversion table * (>= 1) */ Tcl_Obj *const rowv[]) /* Rows of the conversion table */ { Tcl_Obj *row; /* Row containing the current information */ int cellc; /* Count of cells in the row (must be 4) */ Tcl_Obj **cellv; /* Pointers to the cells */ /* * Look up the nearest transition time. */ row = LookupLastTransition(interp, fields->seconds, rowc, rowv); if (row == NULL || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { return TCL_ERROR; } /* * Convert the time. */ fields->tzName = cellv[3]; Tcl_IncrRefCount(fields->tzName); fields->localSeconds = fields->seconds + fields->tzOffset; return TCL_OK; } /* *---------------------------------------------------------------------- * * ConvertUTCToLocalUsingC -- * * Converts UTC to localtime in cases where the local time zone is not * determinable, using the C 'localtime' function to do it. * * Results: * Returns a standard Tcl result. * * Side effects: * On success, fills fields->tzName, fields->tzOffset and * fields->localSeconds. On failure, places an error message in the * interpreter result. * *---------------------------------------------------------------------- */ static int ConvertUTCToLocalUsingC( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ int changeover) /* Julian Day of the Gregorian transition */ { time_t tock; struct tm *timeVal; /* Time after conversion */ int diff; /* Time zone diff local-Greenwich */ char buffer[16]; /* Buffer for time zone name */ /* * Use 'localtime' to determine local year, month, day, time of day. */ tock = (time_t) fields->seconds; if ((Tcl_WideInt) tock != fields->seconds) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "number too large to represent as a Posix time", -1)); Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL); return TCL_ERROR; } TzsetIfNecessary(); timeVal = ThreadSafeLocalTime(&tock); if (timeVal == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "localtime failed (clock value may be too " "large/small to represent)", -1)); Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL); return TCL_ERROR; } /* * Fill in the date in 'fields' and use it to derive Julian Day. */ fields->era = CE; fields->year = timeVal->tm_year + 1900; fields->month = timeVal->tm_mon + 1; fields->dayOfMonth = timeVal->tm_mday; GetJulianDayFromEraYearMonthDay(fields, changeover); /* * Convert that value to seconds. */ fields->localSeconds = (((fields->julianDay * (Tcl_WideInt) 24 + timeVal->tm_hour) * 60 + timeVal->tm_min) * 60 + timeVal->tm_sec) - JULIAN_SEC_POSIX_EPOCH; /* * Determine a time zone offset and name; just use +hhmm for the name. */ diff = (int) (fields->localSeconds - fields->seconds); fields->tzOffset = diff; if (diff < 0) { *buffer = '-'; diff = -diff; } else { *buffer = '+'; } snprintf(buffer+1, sizeof(buffer) - 1, "%02d", diff / 3600); diff %= 3600; snprintf(buffer+3, sizeof(buffer) - 3, "%02d", diff / 60); diff %= 60; if (diff > 0) { snprintf(buffer+5, sizeof(buffer) - 5, "%02d", diff); } fields->tzName = Tcl_NewStringObj(buffer, -1); Tcl_IncrRefCount(fields->tzName); return TCL_OK; } /* *---------------------------------------------------------------------- * * LookupLastTransition -- * * Given a UTC time and a tzdata array, looks up the last transition on * or before the given time. * * Results: * Returns a pointer to the row, or NULL if an error occurs. * *---------------------------------------------------------------------- */ static Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ int rowc, /* Number of rows of tzdata */ Tcl_Obj *const *rowv) /* Rows in tzdata */ { int l; int u; Tcl_Obj *compObj; Tcl_WideInt compVal; /* * Examine the first row to make sure we're in bounds. */ if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { return NULL; } /* * Bizarre case - first row doesn't begin at MIN_WIDE_INT. Return it * anyway. */ if (tick < compVal) { return rowv[0]; } /* * Binary-search to find the transition. */ l = 0; u = rowc-1; while (l < u) { int m = (l + u + 1) / 2; if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { return NULL; } if (tick >= compVal) { l = m; } else { u = m-1; } } return rowv[l]; } /* *---------------------------------------------------------------------- * * GetYearWeekDay -- * * Given a date with Julian Calendar Day, compute the year, week, and day * in the ISO8601 calendar. * * Results: * None. * * Side effects: * Stores 'iso8601Year', 'iso8601Week' and 'dayOfWeek' in the date * fields. * *---------------------------------------------------------------------- */ static void GetYearWeekDay( TclDateFields *fields, /* Date to convert, must have 'julianDay' */ int changeover) /* Julian Day Number of the Gregorian * transition */ { TclDateFields temp; int dayOfFiscalYear; /* * Find the given date, minus three days, plus one year. That date's * iso8601 year is an upper bound on the ISO8601 year of the given date. */ temp.julianDay = fields->julianDay - 3; GetGregorianEraYearDay(&temp, changeover); if (temp.era == BCE) { temp.iso8601Year = temp.year - 1; } else { temp.iso8601Year = temp.year + 1; } temp.iso8601Week = 1; temp.dayOfWeek = 1; GetJulianDayFromEraYearWeekDay(&temp, changeover); /* * temp.julianDay is now the start of an ISO8601 year, either the one * corresponding to the given date, or the one after. If we guessed high, * move one year earlier */ if (fields->julianDay < temp.julianDay) { if (temp.era == BCE) { temp.iso8601Year += 1; } else { temp.iso8601Year -= 1; } GetJulianDayFromEraYearWeekDay(&temp, changeover); } fields->iso8601Year = temp.iso8601Year; dayOfFiscalYear = fields->julianDay - temp.julianDay; fields->iso8601Week = (dayOfFiscalYear / 7) + 1; fields->dayOfWeek = (dayOfFiscalYear + 1) % 7; if (fields->dayOfWeek < 1) { fields->dayOfWeek += 7; } } /* *---------------------------------------------------------------------- * * GetGregorianEraYearDay -- * * Given a Julian Day Number, extracts the year and day of the year and * puts them into TclDateFields, along with the era (BCE or CE) and a * flag indicating whether the date is Gregorian or Julian. * * Results: * None. * * Side effects: * Stores 'era', 'gregorian', 'year', and 'dayOfYear'. * *---------------------------------------------------------------------- */ static void GetGregorianEraYearDay( TclDateFields *fields, /* Date fields containing 'julianDay' */ int changeover) /* Gregorian transition date */ { int jday = fields->julianDay; int day; int year; int n; if (jday >= changeover) { /* * Gregorian calendar. */ fields->gregorian = 1; year = 1; /* * n = Number of 400-year cycles since 1 January, 1 CE in the * proleptic Gregorian calendar. day = remaining days. */ day = jday - JDAY_1_JAN_1_CE_GREGORIAN; n = day / FOUR_CENTURIES; day %= FOUR_CENTURIES; if (day < 0) { day += FOUR_CENTURIES; n--; } year += 400 * n; /* * n = number of centuries since the start of (year); * day = remaining days */ n = day / ONE_CENTURY_GREGORIAN; day %= ONE_CENTURY_GREGORIAN; if (n > 3) { /* * 31 December in the last year of a 400-year cycle. */ n = 3; day += ONE_CENTURY_GREGORIAN; } year += 100 * n; } else { /* * Julian calendar. */ fields->gregorian = 0; year = 1; day = jday - JDAY_1_JAN_1_CE_JULIAN; } /* * n = number of 4-year cycles; days = remaining days. */ n = day / FOUR_YEARS; day %= FOUR_YEARS; if (day < 0) { day += FOUR_YEARS; n--; } year += 4 * n; /* * n = number of years; days = remaining days. */ n = day / ONE_YEAR; day %= ONE_YEAR; if (n > 3) { /* * 31 December of a leap year. */ n = 3; day += 365; } year += n; /* * store era/year/day back into fields. */ if (year <= 0) { fields->era = BCE; fields->year = 1 - year; } else { fields->era = CE; fields->year = year; } fields->dayOfYear = day + 1; } /* *---------------------------------------------------------------------- * * GetMonthDay -- * * Given a date as year and day-of-year, find month and day. * * Results: * None. * * Side effects: * Stores 'month' and 'dayOfMonth' in the 'fields' structure. * *---------------------------------------------------------------------- */ static void GetMonthDay( TclDateFields *fields) /* Date to convert */ { int day = fields->dayOfYear; int month; const int *h = hath[IsGregorianLeapYear(fields)]; for (month = 0; month < 12 && day > h[month]; ++month) { day -= h[month]; } fields->month = month+1; fields->dayOfMonth = day; } /* *---------------------------------------------------------------------- * * GetJulianDayFromEraYearWeekDay -- * * Given a TclDateFields structure containing era, ISO8601 year, ISO8601 * week, and day of week, computes the Julian Day Number. * * Results: * None. * * Side effects: * Stores 'julianDay' in the fields. * *---------------------------------------------------------------------- */ static void GetJulianDayFromEraYearWeekDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Julian Day Number of the Gregorian * transition */ { int firstMonday; /* Julian day number of week 1, day 1 in the * given year */ TclDateFields firstWeek; /* * Find January 4 in the ISO8601 year, which will always be in week 1. */ firstWeek.era = fields->era; firstWeek.year = fields->iso8601Year; firstWeek.month = 1; firstWeek.dayOfMonth = 4; GetJulianDayFromEraYearMonthDay(&firstWeek, changeover); /* * Find Monday of week 1. */ firstMonday = WeekdayOnOrBefore(1, firstWeek.julianDay); /* * Advance to the given week and day. */ fields->julianDay = firstMonday + 7 * (fields->iso8601Week - 1) + fields->dayOfWeek - 1; } /* *---------------------------------------------------------------------- * * GetJulianDayFromEraYearMonthDay -- * * Given era, year, month, and dayOfMonth (in TclDateFields), and the * Gregorian transition date, computes the Julian Day Number. * * Results: * None. * * Side effects: * Stores day number in 'julianDay' * *---------------------------------------------------------------------- */ static void GetJulianDayFromEraYearMonthDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ { int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400; if (fields->era == BCE) { year = 1 - fields->year; } else { year = fields->year; } /* * Reduce month modulo 12. */ month = fields->month; mm1 = month - 1; q = mm1 / 12; r = (mm1 % 12); if (r < 0) { r += 12; q -= 1; } year += q; month = r + 1; ym1 = year - 1; /* * Adjust the year after reducing the month. */ fields->gregorian = 1; if (year < 1) { fields->era = BCE; fields->year = 1-year; } else { fields->era = CE; fields->year = year; } /* * Try an initial conversion in the Gregorian calendar. */ #if 0 /* BUG https://core.tcl-lang.org/tcl/tktview?name=da340d4f32 */ ym1o4 = ym1 / 4; #else /* * Have to make sure quotient is truncated towards 0 when negative. * See above bug for details. The casts are necessary. */ if (ym1 >= 0) { ym1o4 = ym1 / 4; } else { ym1o4 = - (int) (((unsigned int) -ym1) / 4); } #endif if (ym1 % 4 < 0) { ym1o4--; } ym1o100 = ym1 / 100; if (ym1 % 100 < 0) { ym1o100--; } ym1o400 = ym1 / 400; if (ym1 % 400 < 0) { ym1o400--; } fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1 + fields->dayOfMonth + daysInPriorMonths[IsGregorianLeapYear(fields)][month - 1] + (ONE_YEAR * ym1) + ym1o4 - ym1o100 + ym1o400; /* * If the resulting date is before the Gregorian changeover, convert in * the Julian calendar instead. */ if (fields->julianDay < changeover) { fields->gregorian = 0; fields->julianDay = JDAY_1_JAN_1_CE_JULIAN - 1 + fields->dayOfMonth + daysInPriorMonths[year%4 == 0][month - 1] + (365 * ym1) + ym1o4; } } /* *---------------------------------------------------------------------- * * IsGregorianLeapYear -- * * Tests whether a given year is a leap year, in either Julian or * Gregorian calendar. * * Results: * Returns 1 for a leap year, 0 otherwise. * *---------------------------------------------------------------------- */ static int IsGregorianLeapYear( TclDateFields *fields) /* Date to test */ { int year = fields->year; if (fields->era == BCE) { year = 1 - year; } if (year%4 != 0) { return 0; } else if (!(fields->gregorian)) { return 1; } else if (year%400 == 0) { return 1; } else if (year%100 == 0) { return 0; } else { return 1; } } /* *---------------------------------------------------------------------- * * WeekdayOnOrBefore -- * * Finds the Julian Day Number of a given day of the week that falls on * or before a given date, expressed as Julian Day Number. * * Results: * Returns the Julian Day Number * *---------------------------------------------------------------------- */ static int WeekdayOnOrBefore( int dayOfWeek, /* Day of week; Sunday == 0 or 7 */ int julianDay) /* Reference date */ { int k = (dayOfWeek + 6) % 7; if (k < 0) { k += 7; } return julianDay - ((julianDay - k) % 7); } /* *---------------------------------------------------------------------- * * ClockGetenvObjCmd -- * * Tcl command that reads an environment variable from the system * * Usage: * ::tcl::clock::getEnv NAME * * Parameters: * NAME - Name of the environment variable desired * * Results: * Returns a standard Tcl result. Returns an error if the variable does * not exist, with a message left in the interpreter. Returns TCL_OK and * the value of the variable if the variable does exist, * *---------------------------------------------------------------------- */ int ClockGetenvObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { #ifdef _WIN32 const WCHAR *varName; const WCHAR *varValue; Tcl_DString ds; #else const char *varName; const char *varValue; #endif (void)clientData; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } #ifdef _WIN32 varName = (const WCHAR *)Tcl_WinUtfToTChar(TclGetString(objv[1]), -1, &ds); varValue = _wgetenv(varName); Tcl_DStringFree(&ds); if (varValue == NULL) { varValue = L""; } Tcl_WinTCharToUtf((TCHAR *)varValue, -1, &ds); Tcl_DStringResult(interp, &ds); #else varName = TclGetString(objv[1]); varValue = getenv(varName); if (varValue == NULL) { varValue = ""; } Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); #endif return TCL_OK; } /* *---------------------------------------------------------------------- * * ThreadSafeLocalTime -- * * Wrapper around the 'localtime' library function to make it thread * safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes localtime or localtime_r as appropriate. * *---------------------------------------------------------------------- */ static struct tm * ThreadSafeLocalTime( const time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ { /* * Get a thread-local buffer to hold the returned time. */ struct tm *tmPtr = (struct tm *)Tcl_GetThreadData(&tmKey, sizeof(struct tm)); #ifdef HAVE_LOCALTIME_R tmPtr = localtime_r(timePtr, tmPtr); #else struct tm *sysTmPtr; Tcl_MutexLock(&clockMutex); sysTmPtr = localtime(timePtr); if (sysTmPtr == NULL) { Tcl_MutexUnlock(&clockMutex); return NULL; } memcpy(tmPtr, sysTmPtr, sizeof(struct tm)); Tcl_MutexUnlock(&clockMutex); #endif return tmPtr; } /*---------------------------------------------------------------------- * * ClockClicksObjCmd -- * * Returns a high-resolution counter. * * Results: * Returns a standard Tcl result. * * Side effects: * None. * * This function implements the 'clock clicks' Tcl command. Refer to the user * documentation for details on what it does. * *---------------------------------------------------------------------- */ int ClockClicksObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { static const char *const clicksSwitches[] = { "-milliseconds", "-microseconds", NULL }; enum ClicksSwitch { CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE }; int index = CLICKS_NATIVE; Tcl_Time now; Tcl_WideInt clicks = 0; (void)clientData; switch (objc) { case 1: break; case 2: if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } break; default: Tcl_WrongNumArgs(interp, 1, objv, "?-switch?"); return TCL_ERROR; } switch (index) { case CLICKS_MILLIS: Tcl_GetTime(&now); clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000; break; case CLICKS_NATIVE: #ifdef TCL_WIDE_CLICKS clicks = TclpGetWideClicks(); #else clicks = (Tcl_WideInt) TclpGetClicks(); #endif break; case CLICKS_MICROS: clicks = TclpGetMicroseconds(); break; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks)); return TCL_OK; } /*---------------------------------------------------------------------- * * ClockMillisecondsObjCmd - * * Returns a count of milliseconds since the epoch. * * Results: * Returns a standard Tcl result. * * Side effects: * None. * * This function implements the 'clock milliseconds' Tcl command. Refer to the * user documentation for details on what it does. * *---------------------------------------------------------------------- */ int ClockMillisecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec * 1000 + now.usec / 1000)); return TCL_OK; } /*---------------------------------------------------------------------- * * ClockMicrosecondsObjCmd - * * Returns a count of microseconds since the epoch. * * Results: * Returns a standard Tcl result. * * Side effects: * None. * * This function implements the 'clock microseconds' Tcl command. Refer to the * user documentation for details on what it does. * *---------------------------------------------------------------------- */ int ClockMicrosecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); return TCL_OK; } /* *----------------------------------------------------------------------------- * * ClockParseformatargsObjCmd -- * * Parses the arguments for [clock format]. * * Results: * Returns a standard Tcl result, whose value is a four-element list * comprising the time format, the locale, and the timezone. * * This function exists because the loop that parses the [clock format] * options is a known performance "hot spot", and is implemented in an effort * to speed that particular code up. * *----------------------------------------------------------------------------- */ static int ClockParseformatargsObjCmd( ClientData clientData, /* Client data containing literal pool */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter vector */ { ClockClientData *dataPtr = (ClockClientData *)clientData; Tcl_Obj **litPtr = dataPtr->literals; Tcl_Obj *results[3]; /* Format, locale and timezone */ #define formatObj results[0] #define localeObj results[1] #define timezoneObj results[2] int gmtFlag = 0; static const char *const options[] = { /* Command line options expected */ "-format", "-gmt", "-locale", "-timezone", NULL }; enum optionInd { CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE, CLOCK_FORMAT_TIMEZONE }; int optionIndex; /* Index of an option. */ int saw = 0; /* Flag == 1 if option was seen already. */ Tcl_WideInt clockVal; /* Clock value - just used to parse. */ int i; /* * Args consist of a time followed by keyword-value pairs. */ if (objc < 2 || (objc % 2) != 0) { Tcl_WrongNumArgs(interp, 0, objv, "clock format clockval ?-format string? " "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); return TCL_ERROR; } /* * Extract values for the keywords. */ formatObj = litPtr[LIT__DEFAULT_FORMAT]; localeObj = litPtr[LIT_C]; timezoneObj = litPtr[LIT__NIL]; for (i = 2; i < objc; i+=2) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", Tcl_GetString(objv[i]), NULL); return TCL_ERROR; } switch (optionIndex) { case CLOCK_FORMAT_FORMAT: formatObj = objv[i+1]; break; case CLOCK_FORMAT_GMT: if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){ return TCL_ERROR; } break; case CLOCK_FORMAT_LOCALE: localeObj = objv[i+1]; break; case CLOCK_FORMAT_TIMEZONE: timezoneObj = objv[i+1]; break; } saw |= 1 << optionIndex; } /* * Check options. */ if (TclGetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { return TCL_ERROR; } if ((saw & (1 << CLOCK_FORMAT_GMT)) && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); return TCL_ERROR; } if (gmtFlag) { timezoneObj = litPtr[LIT_GMT]; } /* * Return options as a list. */ Tcl_SetObjResult(interp, Tcl_NewListObj(3, results)); return TCL_OK; #undef timezoneObj #undef localeObj #undef formatObj } /*---------------------------------------------------------------------- * * ClockSecondsObjCmd - * * Returns a count of microseconds since the epoch. * * Results: * Returns a standard Tcl result. * * Side effects: * None. * * This function implements the 'clock seconds' Tcl command. Refer to the user * documentation for details on what it does. * *---------------------------------------------------------------------- */ int ClockSecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TzsetIfNecessary -- * * Calls the tzset() library function if the contents of the TZ * environment variable has changed. * * Results: * None. * * Side effects: * Calls tzset. * *---------------------------------------------------------------------- */ #ifdef _WIN32 #define getenv(x) _wgetenv(L##x) #else #define WCHAR char #define wcslen strlen #define wcscmp strcmp #define wcscpy strcpy #endif static void TzsetIfNecessary(void) { static WCHAR* tzWas = (WCHAR *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ static long tzLastRefresh = 0; /* Used for latency before next refresh */ static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, that TZ changed via TCL */ const WCHAR *tzIsNow; /* Current value of TZ */ /* * Prevent performance regression on some platforms by resolving of system time zone: * small latency for check whether environment was changed (once per second) * no latency if environment was changed with tcl-env (compare both epoch values) */ Tcl_Time now; Tcl_GetTime(&now); if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) { return; } tzEnvEpoch = TclEnvEpoch; tzLastRefresh = now.sec; Tcl_MutexLock(&clockMutex); tzIsNow = getenv("TZ"); if (tzIsNow != NULL && (tzWas == NULL || tzWas == (WCHAR *)INT2PTR(-1) || wcscmp(tzIsNow, tzWas) != 0)) { tzset(); if (tzWas != NULL && tzWas != (WCHAR *)INT2PTR(-1)) { ckfree(tzWas); } tzWas = (WCHAR *)ckalloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1)); wcscpy(tzWas, tzIsNow); } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); if (tzWas != (WCHAR *)INT2PTR(-1)) ckfree(tzWas); tzWas = NULL; } Tcl_MutexUnlock(&clockMutex); } /* *---------------------------------------------------------------------- * * ClockDeleteCmdProc -- * * Remove a reference to the clock client data, and clean up memory * when it's all gone. * * Results: * None. * *---------------------------------------------------------------------- */ static void ClockDeleteCmdProc( ClientData clientData) /* Opaque pointer to the client data */ { ClockClientData *data = (ClockClientData *)clientData; int i; if (data->refCount-- <= 1) { for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } ckfree(data->literals); ckfree(data); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclCmdAH.c0000644000175000017500000023556614554262142015062 0ustar sergeisergei/* * tclCmdAH.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters A to H. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef _WIN32 # include "tclWinInt.h" #endif #include /* * The state structure used by [foreach]. Note that the actual structure has * all its working arrays appended afterwards so they can be allocated and * freed in a single step. */ struct ForeachState { Tcl_Obj *bodyPtr; /* The script body of the command. */ int bodyIdx; /* The argument index of the body. */ int j, maxj; /* Number of loop iterations. */ int numLists; /* Count of value lists. */ int *index; /* Array of value list indices. */ int *varcList; /* # loop variables per list. */ Tcl_Obj ***varvList; /* Array of var name lists. */ Tcl_Obj **vCopyList; /* Copies of var name list arguments. */ int *argcList; /* Array of value list sizes. */ Tcl_Obj ***argvList; /* Array of value lists. */ Tcl_Obj **aCopyList; /* Copies of value list arguments. */ Tcl_Obj *resultList; /* List of result values from the loop body, * or NULL if we're not collecting them * ([lmap] vs [foreach]). */ }; /* * Prototypes for local procedures defined in this file: */ static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode); static Tcl_ObjCmdProc BadEncodingSubcommand; static Tcl_ObjCmdProc EncodingConvertfromObjCmd; static Tcl_ObjCmdProc EncodingConverttoObjCmd; static Tcl_ObjCmdProc EncodingDirsObjCmd; static Tcl_ObjCmdProc EncodingNamesObjCmd; static Tcl_ObjCmdProc EncodingSystemObjCmd; static inline int ForeachAssignments(Tcl_Interp *interp, struct ForeachState *statePtr); static inline void ForeachCleanup(Tcl_Interp *interp, struct ForeachState *statePtr); static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr); static const char * GetTypeFromMode(int mode); static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName, Tcl_StatBuf *statPtr); static inline int EachloopCmd(Tcl_Interp *interp, int collect, int objc, Tcl_Obj *const objv[]); static Tcl_NRPostProc CatchObjCmdCallback; static Tcl_NRPostProc ExprCallback; static Tcl_NRPostProc ForSetupCallback; static Tcl_NRPostProc ForCondCallback; static Tcl_NRPostProc ForNextCallback; static Tcl_NRPostProc ForPostNextCallback; static Tcl_NRPostProc ForeachLoopStep; static Tcl_NRPostProc EvalCmdErrMsg; static Tcl_ObjCmdProc BadFileSubcommand; static Tcl_ObjCmdProc FileAttrAccessTimeCmd; static Tcl_ObjCmdProc FileAttrIsDirectoryCmd; static Tcl_ObjCmdProc FileAttrIsExecutableCmd; static Tcl_ObjCmdProc FileAttrIsExistingCmd; static Tcl_ObjCmdProc FileAttrIsFileCmd; static Tcl_ObjCmdProc FileAttrIsOwnedCmd; static Tcl_ObjCmdProc FileAttrIsReadableCmd; static Tcl_ObjCmdProc FileAttrIsWritableCmd; static Tcl_ObjCmdProc FileAttrLinkStatCmd; static Tcl_ObjCmdProc FileAttrModifyTimeCmd; static Tcl_ObjCmdProc FileAttrSizeCmd; static Tcl_ObjCmdProc FileAttrStatCmd; static Tcl_ObjCmdProc FileAttrTypeCmd; static Tcl_ObjCmdProc FilesystemSeparatorCmd; static Tcl_ObjCmdProc FilesystemVolumesCmd; static Tcl_ObjCmdProc PathDirNameCmd; static Tcl_ObjCmdProc PathExtensionCmd; static Tcl_ObjCmdProc PathFilesystemCmd; static Tcl_ObjCmdProc PathJoinCmd; static Tcl_ObjCmdProc PathNativeNameCmd; static Tcl_ObjCmdProc PathNormalizeCmd; static Tcl_ObjCmdProc PathRootNameCmd; static Tcl_ObjCmdProc PathSplitCmd; static Tcl_ObjCmdProc PathTailCmd; static Tcl_ObjCmdProc PathTypeCmd; /* *---------------------------------------------------------------------- * * Tcl_BreakObjCmd -- * * This procedure is invoked to process the "break" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a * command name is computed at runtime, and is "break" or the name to * which "break" was renamed: e.g., "set z break; $z" * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_BreakObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } return TCL_BREAK; } /* *---------------------------------------------------------------------- * * Tcl_CaseObjCmd -- * * This procedure is invoked to process the "case" Tcl command. See the * user documentation for details on what it does. THIS COMMAND IS * OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_CaseObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i; int body, result, caseObjc; const char *stringPtr, *arg; Tcl_Obj *const *caseObjv; Tcl_Obj *armPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "string ?in? ?pattern body ...? ?default body?"); return TCL_ERROR; } stringPtr = TclGetString(objv[1]); body = -1; arg = TclGetString(objv[2]); if (strcmp(arg, "in") == 0) { i = 3; } else { i = 2; } caseObjc = objc - i; caseObjv = objv + i; /* * If all of the pattern/command pairs are lumped into a single argument, * split them out again. */ if (caseObjc == 1) { Tcl_Obj **newObjv; TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv); caseObjv = newObjv; } for (i = 0; i < caseObjc; i += 2) { int patObjc, j; const char **patObjv; const char *pat, *p; if (i == caseObjc-1) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( "extra case pattern with no body", -1)); return TCL_ERROR; } /* * Check for special case of single pattern (no list) with no * backslash sequences. */ pat = TclGetString(caseObjv[i]); for (p = pat; *p != '\0'; p++) { if (TclIsSpaceProcM(*p) || (*p == '\\')) { break; } } if (*p == '\0') { if ((*pat == 'd') && (strcmp(pat, "default") == 0)) { body = i + 1; } if (Tcl_StringMatch(stringPtr, pat)) { body = i + 1; goto match; } continue; } /* * Break up pattern lists, then check each of the patterns in the * list. */ result = Tcl_SplitList(interp, pat, &patObjc, &patObjv); if (result != TCL_OK) { return result; } for (j = 0; j < patObjc; j++) { if (Tcl_StringMatch(stringPtr, patObjv[j])) { body = i + 1; break; } } ckfree(patObjv); if (j < patObjc) { break; } } match: if (body != -1) { armPtr = caseObjv[body - 1]; result = Tcl_EvalObjEx(interp, caseObjv[body], 0); if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.50s\" arm line %d)", TclGetString(armPtr), Tcl_GetErrorLine(interp))); } return result; } /* * Nothing matched: return nothing. */ return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_CatchObjCmd -- * * This object-based procedure is invoked to process the "catch" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_CatchObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRCatchObjCmd, dummy, objc, objv); } int TclNRCatchObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varNamePtr = NULL; Tcl_Obj *optionVarNamePtr = NULL; Interp *iPtr = (Interp *) interp; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "script ?resultVarName? ?optionVarName?"); return TCL_ERROR; } if (objc >= 3) { varNamePtr = objv[2]; } if (objc == 4) { optionVarNamePtr = objv[3]; } TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc), varNamePtr, optionVarNamePtr, NULL); /* * TIP #280. Make invoking context available to caught script. */ return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1); } static int CatchObjCmdCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); Tcl_Obj *varNamePtr = (Tcl_Obj *)data[1]; Tcl_Obj *optionVarNamePtr = (Tcl_Obj *)data[2]; int rewind = iPtr->execEnvPtr->rewind; /* * We disable catch in interpreters where the limit has been exceeded. */ if (rewind || Tcl_LimitExceeded(interp)) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"catch\" body line %d)", Tcl_GetErrorLine(interp))); return TCL_ERROR; } if (objc >= 3) { if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL, Tcl_GetObjResult(interp), TCL_LEAVE_ERR_MSG)) { return TCL_ERROR; } } if (objc == 4) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, result); if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL, options, TCL_LEAVE_ERR_MSG)) { /* Do not decrRefCount 'options', it was already done by * Tcl_ObjSetVar2 */ return TCL_ERROR; } } Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_CdObjCmd -- * * This procedure is invoked to process the "cd" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_CdObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *dir; int result; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?dirName?"); return TCL_ERROR; } if (objc == 2) { dir = objv[1]; } else { TclNewLiteralStringObj(dir, "~"); Tcl_IncrRefCount(dir); } if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) { result = TCL_ERROR; } else { result = Tcl_FSChdir(dir); if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't change working directory to \"%s\": %s", TclGetString(dir), Tcl_PosixError(interp))); result = TCL_ERROR; } } if (objc != 2) { Tcl_DecrRefCount(dir); } return result; } /* *---------------------------------------------------------------------- * * Tcl_ConcatObjCmd -- * * This object-based procedure is invoked to process the "concat" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ConcatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc >= 2) { Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ContinueObjCmd -- * * This procedure is invoked to process the "continue" Tcl command. See * the user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a * command name is computed at runtime, and is "continue" or the name to * which "continue" was renamed: e.g., "set z continue; $z" * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ContinueObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } return TCL_CONTINUE; } /* *----------------------------------------------------------------------------- * * TclInitEncodingCmd -- * * This function creates the 'encoding' ensemble. * * Results: * Returns the Tcl_Command so created. * * Side effects: * The ensemble is initialized. * * This command is hidden in a safe interpreter. */ Tcl_Command TclInitEncodingCmd( Tcl_Interp* interp) /* Tcl interpreter */ { static const EnsembleImplMap encodingImplMap[] = { {"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"convertto", EncodingConverttoObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"names", EncodingNamesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "encoding", encodingImplMap); } /* *----------------------------------------------------------------------------- * * TclMakeEncodingCommandSafe -- * * This function hides the unsafe 'dirs' and 'system' subcommands of * the "encoding" Tcl command ensemble. It must be called only from * TclHideUnsafeCommands. * * Results: * A standard Tcl result * * Side effects: * Adds commands to the table of hidden commands. * *----------------------------------------------------------------------------- */ int TclMakeEncodingCommandSafe( Tcl_Interp* interp) /* Tcl interpreter */ { static const struct { const char *cmdName; int unsafe; } unsafeInfo[] = { {"convertfrom", 0}, {"convertto", 0}, {"dirs", 1}, {"names", 0}, {"system", 0}, {NULL, 0} }; int i; Tcl_DString oldBuf, newBuf; Tcl_DStringInit(&oldBuf); TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::"); Tcl_DStringInit(&newBuf); TclDStringAppendLiteral(&newBuf, "tcl:encoding:"); for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) { if (unsafeInfo[i].unsafe) { const char *oldName, *newName; Tcl_DStringSetLength(&oldBuf, 17); oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1); Tcl_DStringSetLength(&newBuf, 13); newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1); if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) { Tcl_Panic("problem making 'encoding %s' safe: %s", unsafeInfo[i].cmdName, Tcl_GetString(Tcl_GetObjResult(interp))); } Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand, (ClientData) unsafeInfo[i].cmdName, NULL); } } Tcl_DStringFree(&oldBuf); Tcl_DStringFree(&newBuf); /* * Ugh. The [encoding] command is now actually safe, but it is assumed by * scripts that it is not, which messes up security policies. */ if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) { Tcl_Panic("problem making 'encoding' safe: %s", Tcl_GetString(Tcl_GetObjResult(interp))); } return TCL_OK; } /* *---------------------------------------------------------------------- * * BadEncodingSubcommand -- * * Command used to act as a backstop implementation when subcommands of * "encoding" are unsafe (the real implementations of the subcommands are * hidden). The clientData is always the full official subcommand name. * * Results: * A standard Tcl result (always a TCL_ERROR). * * Side effects: * None. * *---------------------------------------------------------------------- */ static int BadEncodingSubcommand( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *subcommandName = (const char *) clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "not allowed to invoke subcommand %s of encoding", subcommandName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * EncodingConvertfromObjCmd -- * * This command converts a byte array in an external encoding into a * Tcl string * * Results: * A standard Tcl result. * *---------------------------------------------------------------------- */ int EncodingConvertfromObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ int length; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ if (objc == 2) { encoding = Tcl_GetEncoding(interp, NULL); data = objv[1]; } else if (objc == 3) { if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) { return TCL_ERROR; } data = objv[2]; } else { Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data"); return TCL_ERROR; } /* * Convert the string into a byte array in 'ds' */ bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds); /* * Note that we cannot use Tcl_DStringResult here because it will * truncate the string at the first null byte. */ Tcl_SetObjResult(interp, TclDStringToObj(&ds)); /* * We're done with the encoding */ Tcl_FreeEncoding(encoding); return TCL_OK; } /* *---------------------------------------------------------------------- * * EncodingConverttoObjCmd -- * * This command converts a Tcl string into a byte array that * encodes the string according to some encoding. * * Results: * A standard Tcl result. * *---------------------------------------------------------------------- */ int EncodingConverttoObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ int length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ if (objc == 2) { encoding = Tcl_GetEncoding(interp, NULL); data = objv[1]; } else if (objc == 3) { if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) { return TCL_ERROR; } data = objv[2]; } else { Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data"); return TCL_ERROR; } /* * Convert the string to a byte array in 'ds' */ stringPtr = TclGetStringFromObj(data, &length); Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds); Tcl_SetObjResult(interp, Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); /* * We're done with the encoding */ Tcl_FreeEncoding(encoding); return TCL_OK; } /* *---------------------------------------------------------------------- * * EncodingDirsObjCmd -- * * This command manipulates the encoding search path. * * Results: * A standard Tcl result. * * Side effects: * Can set the encoding search path. * *---------------------------------------------------------------------- */ int EncodingDirsObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *dirListObj; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?dirList?"); return TCL_ERROR; } if (objc == 1) { Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); return TCL_OK; } dirListObj = objv[1]; if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected directory list but got \"%s\"", TclGetString(dirListObj))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, dirListObj); return TCL_OK; } /* *----------------------------------------------------------------------------- * * EncodingNamesObjCmd -- * * This command returns a list of the available encoding names * * Results: * Returns a standard Tcl result * *----------------------------------------------------------------------------- */ int EncodingNamesObjCmd( ClientData dummy, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Number of command line args */ Tcl_Obj* const objv[]) /* Vector of command line args */ { if (objc > 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetEncodingNames(interp); return TCL_OK; } /* *----------------------------------------------------------------------------- * * EncodingSystemObjCmd -- * * This command retrieves or changes the system encoding * * Results: * Returns a standard Tcl result * * Side effects: * May change the system encoding. * *----------------------------------------------------------------------------- */ int EncodingSystemObjCmd( ClientData dummy, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Number of command line args */ Tcl_Obj* const objv[]) /* Vector of command line args */ { if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?encoding?"); return TCL_ERROR; } if (objc == 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1)); } else { return Tcl_SetSystemEncoding(interp, TclGetString(objv[1])); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ErrorObjCmd -- * * This procedure is invoked to process the "error" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ErrorObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *options, *optName; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?"); return TCL_ERROR; } TclNewLiteralStringObj(options, "-code error -level 0"); if (objc >= 3) { /* Process the optional info argument */ TclNewLiteralStringObj(optName, "-errorinfo"); Tcl_ListObjAppendElement(NULL, options, optName); Tcl_ListObjAppendElement(NULL, options, objv[2]); } if (objc >= 4) { /* Process the optional code argument */ TclNewLiteralStringObj(optName, "-errorcode"); Tcl_ListObjAppendElement(NULL, options, optName); Tcl_ListObjAppendElement(NULL, options, objv[3]); } Tcl_SetObjResult(interp, objv[1]); return Tcl_SetReturnOptions(interp, options); } /* *---------------------------------------------------------------------- * * Tcl_EvalObjCmd -- * * This object-based procedure is invoked to process the "eval" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int EvalCmdErrMsg( ClientData data[], Tcl_Interp *interp, int result) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp))); } return result; } int Tcl_EvalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv); } int TclNREvalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *objPtr; Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); return TCL_ERROR; } if (objc == 2) { /* * TIP #280. Make argument location available to eval'd script. */ invoker = iPtr->cmdFramePtr; word = 1; objPtr = objv[1]; TclArgumentGet(interp, objPtr, &invoker, &word); } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. * * TIP #280. Make invoking context available to eval'd script, done * with the default values. */ objPtr = Tcl_ConcatObj(objc-1, objv+1); } TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0, invoker, word); } /* *---------------------------------------------------------------------- * * Tcl_ExitObjCmd -- * * This procedure is invoked to process the "exit" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ExitObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int value; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?"); return TCL_ERROR; } if (objc == 1) { value = 0; } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) { return TCL_ERROR; } Tcl_Exit(value); return TCL_OK; /* Better not ever reach this! */ } /* *---------------------------------------------------------------------- * * Tcl_ExprObjCmd -- * * This object-based procedure is invoked to process the "expr" Tcl * command. See the user documentation for details on what it does. * * With the bytecode compiler, this procedure is called in two * circumstances: 1) to execute expr commands that are too complicated or * too unsafe to try compiling directly into an inline sequence of * instructions, and 2) to execute commands where the command name is * computed at runtime and is "expr" or the name to which "expr" was * renamed (e.g., "set z expr; $z 2+3") * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ExprObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRExprObjCmd, dummy, objc, objv); } int TclNRExprObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *resultPtr, *objPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); return TCL_ERROR; } TclNewObj(resultPtr); Tcl_IncrRefCount(resultPtr); if (objc == 2) { objPtr = objv[1]; TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL); } else { objPtr = Tcl_ConcatObj(objc-1, objv+1); TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL); } return Tcl_NRExprObj(interp, objPtr, resultPtr); } static int ExprCallback( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj *resultPtr = (Tcl_Obj *)data[0]; Tcl_Obj *objPtr = (Tcl_Obj *)data[1]; if (objPtr != NULL) { Tcl_DecrRefCount(objPtr); } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); } Tcl_DecrRefCount(resultPtr); return result; } /* *---------------------------------------------------------------------- * * TclInitFileCmd -- * * This function builds the "file" Tcl command ensemble. See the user * documentation for details on what that ensemble does. * * PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH EMBEDDED * NULLS. With the object-based Tcl_FS APIs, the above NOTE may no longer * be true. In any case this assertion should be tested. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ Tcl_Command TclInitFileCmd( Tcl_Interp *interp) { /* * Note that most subcommands are unsafe because either they manipulate * the native filesystem or because they reveal information about the * native filesystem. */ static const EnsembleImplMap initMap[] = { {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0}, {"channels", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0}, {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"join", PathJoinCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"pathtype", PathTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0}, {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0}, {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "file", initMap); } /* *---------------------------------------------------------------------- * * TclMakeFileCommandSafe -- * * This function hides the unsafe subcommands of the "file" Tcl command * ensemble. It must only be called from TclHideUnsafeCommands. * * Results: * A standard Tcl result. * * Side effects: * Adds commands to the table of hidden commands. * *---------------------------------------------------------------------- */ int TclMakeFileCommandSafe( Tcl_Interp *interp) { static const struct { const char *cmdName; int unsafe; } unsafeInfo[] = { {"atime", 1}, {"attributes", 1}, {"channels", 0}, {"copy", 1}, {"delete", 1}, {"dirname", 1}, {"executable", 1}, {"exists", 1}, {"extension", 1}, {"isdirectory", 1}, {"isfile", 1}, {"join", 0}, {"link", 1}, {"lstat", 1}, {"mtime", 1}, {"mkdir", 1}, {"nativename", 1}, {"normalize", 1}, {"owned", 1}, {"pathtype", 0}, {"readable", 1}, {"readlink", 1}, {"rename", 1}, {"rootname", 1}, {"separator", 0}, {"size", 1}, {"split", 0}, {"stat", 1}, {"system", 0}, {"tail", 1}, {"tempfile", 1}, {"type", 1}, {"volumes", 1}, {"writable", 1}, {NULL, 0} }; int i; Tcl_DString oldBuf, newBuf; Tcl_DStringInit(&oldBuf); TclDStringAppendLiteral(&oldBuf, "::tcl::file::"); Tcl_DStringInit(&newBuf); TclDStringAppendLiteral(&newBuf, "tcl:file:"); for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) { if (unsafeInfo[i].unsafe) { const char *oldName, *newName; Tcl_DStringSetLength(&oldBuf, 13); oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1); Tcl_DStringSetLength(&newBuf, 9); newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1); if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) { Tcl_Panic("problem making 'file %s' safe: %s", unsafeInfo[i].cmdName, Tcl_GetString(Tcl_GetObjResult(interp))); } Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand, (ClientData) unsafeInfo[i].cmdName, NULL); } } Tcl_DStringFree(&oldBuf); Tcl_DStringFree(&newBuf); /* * Ugh. The [file] command is now actually safe, but it is assumed by * scripts that it is not, which messes up security policies. [Bug * 3211758] */ if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) { Tcl_Panic("problem making 'file' safe: %s", Tcl_GetString(Tcl_GetObjResult(interp))); } return TCL_OK; } /* *---------------------------------------------------------------------- * * BadFileSubcommand -- * * Command used to act as a backstop implementation when subcommands of * "file" are unsafe (the real implementations of the subcommands are * hidden). The clientData is always the full official subcommand name. * * Results: * A standard Tcl result (always a TCL_ERROR). * * Side effects: * None. * *---------------------------------------------------------------------- */ static int BadFileSubcommand( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *subcommandName = (const char *) clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "not allowed to invoke subcommand %s of file", subcommandName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * FileAttrAccessTimeCmd -- * * This function is invoked to process the "file atime" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * May update the access time on the file, if requested by the user. * *---------------------------------------------------------------------- */ static int FileAttrAccessTimeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; struct utimbuf tval; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "name ?time?"); return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the access time not available */ if (Tcl_GetAccessTimeFromStat(&buf) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not get access time for file \"%s\"", TclGetString(objv[1]))); return TCL_ERROR; } #endif if (objc == 3) { Tcl_WideInt newTime; if (Tcl_GetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) { return TCL_ERROR; } tval.actime = newTime; tval.modtime = Tcl_GetModificationTimeFromStat(&buf); if (Tcl_FSUtime(objv[1], &tval) != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set access time for file \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } /* * Do another stat to ensure that the we return the new recognized * atime - hopefully the same as the one we sent in. However, fs's * like FAT don't even know what atime is. */ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(&buf))); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrModifyTimeCmd -- * * This function is invoked to process the "file mtime" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * May update the modification time on the file, if requested by the * user. * *---------------------------------------------------------------------- */ static int FileAttrModifyTimeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; struct utimbuf tval; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "name ?time?"); return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the modification time not available */ if (Tcl_GetModificationTimeFromStat(&buf) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not get modification time for file \"%s\"", TclGetString(objv[1]))); return TCL_ERROR; } #endif if (objc == 3) { /* * Need separate variable for reading longs from an object on 64-bit * platforms. [Bug 698146] */ Tcl_WideInt newTime; if (Tcl_GetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) { return TCL_ERROR; } tval.actime = Tcl_GetAccessTimeFromStat(&buf); tval.modtime = newTime; if (Tcl_FSUtime(objv[1], &tval) != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set modification time for file \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } /* * Do another stat to ensure that the we return the new recognized * mtime - hopefully the same as the one we sent in. */ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(&buf))); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrLinkStatCmd -- * * This function is invoked to process the "file lstat" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Writes to an array named by the user. * *---------------------------------------------------------------------- */ static int FileAttrLinkStatCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "name varName"); return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) { return TCL_ERROR; } return StoreStatData(interp, objv[2], &buf); } /* *---------------------------------------------------------------------- * * FileAttrStatCmd -- * * This function is invoked to process the "file stat" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Writes to an array named by the user. * *---------------------------------------------------------------------- */ static int FileAttrStatCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "name varName"); return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } return StoreStatData(interp, objv[2], &buf); } /* *---------------------------------------------------------------------- * * FileAttrTypeCmd -- * * This function is invoked to process the "file type" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrTypeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj( GetTypeFromMode((unsigned short) buf.st_mode), -1)); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrSizeCmd -- * * This function is invoked to process the "file size" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrSizeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size)); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrIsDirectoryCmd -- * * This function is invoked to process the "file isdirectory" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrIsDirectoryCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; int value = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) { value = S_ISDIR(buf.st_mode); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrIsExecutableCmd -- * * This function is invoked to process the "file executable" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrIsExecutableCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } return CheckAccess(interp, objv[1], X_OK); } /* *---------------------------------------------------------------------- * * FileAttrIsExistingCmd -- * * This function is invoked to process the "file exists" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrIsExistingCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } return CheckAccess(interp, objv[1], F_OK); } /* *---------------------------------------------------------------------- * * FileAttrIsFileCmd -- * * This function is invoked to process the "file isfile" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrIsFileCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; int value = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) { value = S_ISREG(buf.st_mode); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrIsOwnedCmd -- * * This function is invoked to process the "file owned" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrIsOwnedCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { #ifdef __CYGWIN__ #define geteuid() (short)(geteuid)() #endif #if !defined(_WIN32) Tcl_StatBuf buf; #endif int value = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } #if defined(_WIN32) value = TclWinFileOwned(objv[1]); #else if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) { value = (geteuid() == buf.st_uid); } #endif Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrIsReadableCmd -- * * This function is invoked to process the "file readable" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrIsReadableCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } return CheckAccess(interp, objv[1], R_OK); } /* *---------------------------------------------------------------------- * * FileAttrIsWritableCmd -- * * This function is invoked to process the "file writable" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileAttrIsWritableCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } return CheckAccess(interp, objv[1], W_OK); } /* *---------------------------------------------------------------------- * * PathDirNameCmd -- * * This function is invoked to process the "file dirname" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathDirNameCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } dirPtr = TclPathPart(interp, objv[1], TCL_PATH_DIRNAME); if (dirPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, dirPtr); Tcl_DecrRefCount(dirPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathExtensionCmd -- * * This function is invoked to process the "file extension" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathExtensionCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } dirPtr = TclPathPart(interp, objv[1], TCL_PATH_EXTENSION); if (dirPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, dirPtr); Tcl_DecrRefCount(dirPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathRootNameCmd -- * * This function is invoked to process the "file root" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathRootNameCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } dirPtr = TclPathPart(interp, objv[1], TCL_PATH_ROOT); if (dirPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, dirPtr); Tcl_DecrRefCount(dirPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathTailCmd -- * * This function is invoked to process the "file tail" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathTailCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } dirPtr = TclPathPart(interp, objv[1], TCL_PATH_TAIL); if (dirPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, dirPtr); Tcl_DecrRefCount(dirPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathFilesystemCmd -- * * This function is invoked to process the "file system" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathFilesystemCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *fsInfo; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } fsInfo = Tcl_FSFileSystemInfo(objv[1]); if (fsInfo == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", Tcl_GetString(objv[1]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, fsInfo); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathJoinCmd -- * * This function is invoked to process the "file join" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathJoinCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?"); return TCL_ERROR; } Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1, 0)); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathNativeNameCmd -- * * This function is invoked to process the "file nativename" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathNativeNameCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_DString ds; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, TclDStringToObj(&ds)); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathNormalizeCmd -- * * This function is invoked to process the "file normalize" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathNormalizeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *fileName; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } fileName = Tcl_FSGetNormalizedPath(interp, objv[1]); if (fileName == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, fileName); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathSplitCmd -- * * This function is invoked to process the "file split" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathSplitCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *res; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } res = Tcl_FSSplitPath(objv[1], NULL); if (res == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, res); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathTypeCmd -- * * This function is invoked to process the "file pathtype" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PathTypeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *typeName; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } switch (Tcl_FSGetPathType(objv[1])) { case TCL_PATH_ABSOLUTE: TclNewLiteralStringObj(typeName, "absolute"); break; case TCL_PATH_RELATIVE: TclNewLiteralStringObj(typeName, "relative"); break; case TCL_PATH_VOLUME_RELATIVE: TclNewLiteralStringObj(typeName, "volumerelative"); break; default: /* Should be unreachable */ return TCL_OK; } Tcl_SetObjResult(interp, typeName); return TCL_OK; } /* *---------------------------------------------------------------------- * * FilesystemSeparatorCmd -- * * This function is invoked to process the "file separator" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FilesystemSeparatorCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc < 1 || objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } if (objc == 1) { const char *separator = NULL; switch (tclPlatform) { case TCL_PLATFORM_UNIX: separator = "/"; break; case TCL_PLATFORM_WINDOWS: separator = "\\"; break; } Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1)); } else { Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]); if (separatorObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unrecognised path", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", Tcl_GetString(objv[1]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, separatorObj); } return TCL_OK; } /* *---------------------------------------------------------------------- * * FilesystemVolumesCmd -- * * This function is invoked to process the "file volumes" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FilesystemVolumesCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_FSListVolumes()); return TCL_OK; } /* *--------------------------------------------------------------------------- * * CheckAccess -- * * Utility procedure used by Tcl_FileObjCmd() to query file attributes * available through the access() system call. * * Results: * Always returns TCL_OK. Sets interp's result to boolean true or false * depending on whether the file has the specified attribute. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int CheckAccess( Tcl_Interp *interp, /* Interp for status return. Must not be * NULL. */ Tcl_Obj *pathPtr, /* Name of file to check. */ int mode) /* Attribute to check; passed as argument to * access(). */ { int value; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { value = 0; } else { value = (Tcl_FSAccess(pathPtr, mode) == 0); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); return TCL_OK; } /* *--------------------------------------------------------------------------- * * GetStatBuf -- * * Utility procedure used by Tcl_FileObjCmd() to query file attributes * available through the stat() or lstat() system call. * * Results: * The return value is TCL_OK if the specified file exists and can be * stat'ed, TCL_ERROR otherwise. If TCL_ERROR is returned, an error * message is left in interp's result. If TCL_OK is returned, *statPtr is * filled with information about the specified file. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int GetStatBuf( Tcl_Interp *interp, /* Interp for error return. May be NULL. */ Tcl_Obj *pathPtr, /* Path name to examine. */ Tcl_FSStatProc *statProc, /* Either stat() or lstat() depending on * desired behavior. */ Tcl_StatBuf *statPtr) /* Filled with info about file obtained by * calling (*statProc)(). */ { int status; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return TCL_ERROR; } status = statProc(pathPtr, statPtr); if (status < 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(pathPtr), Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * StoreStatData -- * * This is a utility procedure that breaks out the fields of a "stat" * structure and stores them in textual form into the elements of an * associative array. * * Results: * Returns a standard Tcl return value. If an error occurs then a message * is left in interp's result. * * Side effects: * Elements of the associative array given by "varName" are modified. * *---------------------------------------------------------------------- */ static int StoreStatData( Tcl_Interp *interp, /* Interpreter for error reports. */ Tcl_Obj *varName, /* Name of associative array variable in which * to store stat results. */ Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to * store in varName. */ { Tcl_Obj *field, *value; unsigned short mode; /* * Assume Tcl_ObjSetVar2() does not keep a copy of the field name! * * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want * to have an object (i.e. possibly cached) array variable name but a * string element name, so no API exists. Messy. */ #define STORE_ARY(fieldName, object) \ TclNewLiteralStringObj(field, fieldName); \ Tcl_IncrRefCount(field); \ value = (object); \ if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \ TclDecrRefCount(field); \ return TCL_ERROR; \ } \ TclDecrRefCount(field); /* * Watch out porters; the inode is meant to be an *unsigned* value, so the * cast might fail when there isn't a real arithmetic 'long long' type... */ STORE_ARY("dev", Tcl_NewLongObj((long)statPtr->st_dev)); STORE_ARY("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino)); STORE_ARY("nlink", Tcl_NewLongObj((long)statPtr->st_nlink)); STORE_ARY("uid", Tcl_NewLongObj((long)statPtr->st_uid)); STORE_ARY("gid", Tcl_NewLongObj((long)statPtr->st_gid)); STORE_ARY("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); #ifdef HAVE_STRUCT_STAT_ST_BLOCKS STORE_ARY("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks)); #endif #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize)); #endif STORE_ARY("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); STORE_ARY("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); STORE_ARY("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); mode = (unsigned short) statPtr->st_mode; STORE_ARY("mode", Tcl_NewIntObj(mode)); STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); #undef STORE_ARY return TCL_OK; } /* *---------------------------------------------------------------------- * * GetTypeFromMode -- * * Given a mode word, returns a string identifying the type of a file. * * Results: * A static text string giving the file type from mode. * * Side effects: * None. * *---------------------------------------------------------------------- */ static const char * GetTypeFromMode( int mode) { if (S_ISREG(mode)) { return "file"; } else if (S_ISDIR(mode)) { return "directory"; } else if (S_ISCHR(mode)) { return "characterSpecial"; } else if (S_ISBLK(mode)) { return "blockSpecial"; } else if (S_ISFIFO(mode)) { return "fifo"; #ifdef S_ISLNK } else if (S_ISLNK(mode)) { return "link"; #endif #ifdef S_ISSOCK } else if (S_ISSOCK(mode)) { return "socket"; #endif } return "unknown"; } /* *---------------------------------------------------------------------- * * Tcl_ForObjCmd -- * * This procedure is invoked to process the "for" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a * command name is computed at runtime, and is "for" or the name to which * "for" was renamed: e.g., * "set z for; $z {set i 0} {$i<100} {incr i} {puts $i}" * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * * Notes: * This command is split into a lot of pieces so that it can avoid doing * reentrant TEBC calls. This makes things rather hard to follow, but * here's the plan: * * NR: ---------------_\ * Direct: Tcl_ForObjCmd -> TclNRForObjCmd * | * ForSetupCallback * | * [while] ------------> TclNRForIterCallback <---------. * | | * ForCondCallback | * | | * ForNextCallback ------------| * | | * ForPostNextCallback | * |____________________| * *---------------------------------------------------------------------- */ int Tcl_ForObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRForObjCmd, dummy, objc, objv); } int TclNRForObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; ForIterData *iterPtr; if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "start test next command"); return TCL_ERROR; } TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr); iterPtr->cond = objv[2]; iterPtr->body = objv[4]; iterPtr->next = objv[3]; iterPtr->msg = "\n (\"for\" body line %d)"; iterPtr->word = 4; TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL); /* * TIP #280. Make invoking context available to initial script. */ return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1); } static int ForSetupCallback( ClientData data[], Tcl_Interp *interp, int result) { ForIterData *iterPtr = (ForIterData *)data[0]; if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)"); } TclSmallFreeEx(interp, iterPtr); return result; } TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return TCL_OK; } int TclNRForIterCallback( ClientData data[], Tcl_Interp *interp, int result) { ForIterData *iterPtr = (ForIterData *)data[0]; Tcl_Obj *boolObj; switch (result) { case TCL_OK: case TCL_CONTINUE: /* * We need to reset the result before evaluating the expression. * Otherwise, any error message will be appended to the result of the * last evaluation. */ Tcl_ResetResult(interp); TclNewObj(boolObj); TclNRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL, NULL); return Tcl_NRExprObj(interp, iterPtr->cond, boolObj); case TCL_BREAK: result = TCL_OK; Tcl_ResetResult(interp); break; case TCL_ERROR: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(iterPtr->msg, Tcl_GetErrorLine(interp))); } TclSmallFreeEx(interp, iterPtr); return result; } static int ForCondCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; ForIterData *iterPtr = (ForIterData *)data[0]; Tcl_Obj *boolObj = (Tcl_Obj *)data[1]; int value; if (result != TCL_OK) { Tcl_DecrRefCount(boolObj); TclSmallFreeEx(interp, iterPtr); return result; } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) { Tcl_DecrRefCount(boolObj); TclSmallFreeEx(interp, iterPtr); return TCL_ERROR; } Tcl_DecrRefCount(boolObj); if (value) { /* TIP #280. */ if (iterPtr->next) { TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL, NULL); } else { TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); } return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr, iterPtr->word); } TclSmallFreeEx(interp, iterPtr); return result; } static int ForNextCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; ForIterData *iterPtr = (ForIterData *)data[0]; Tcl_Obj *next = iterPtr->next; if ((result == TCL_OK) || (result == TCL_CONTINUE)) { TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL, NULL); /* * TIP #280. Make invoking context available to next script. */ return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3); } TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return result; } static int ForPostNextCallback( ClientData data[], Tcl_Interp *interp, int result) { ForIterData *iterPtr = (ForIterData *)data[0]; if ((result != TCL_BREAK) && (result != TCL_OK)) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" loop-end command)"); TclSmallFreeEx(interp, iterPtr); } return result; } TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return result; } /* *---------------------------------------------------------------------- * * Tcl_ForeachObjCmd, TclNRForeachCmd, EachloopCmd -- * * This object-based procedure is invoked to process the "foreach" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ForeachObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRForeachCmd, dummy, objc, objv); } int TclNRForeachCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv); } int Tcl_LmapObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRLmapCmd, dummy, objc, objv); } int TclNRLmapCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv); } static inline int EachloopCmd( Tcl_Interp *interp, /* Our context for variables and script * evaluation. */ int collect, /* Select collecting or accumulating mode * (TCL_EACH_*) */ int objc, /* The arguments being passed in... */ Tcl_Obj *const objv[]) { int numLists = (objc-2) / 2; struct ForeachState *statePtr; int i, j, result; if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, "varList list ?varList list ...? command"); return TCL_ERROR; } /* * Manage numList parallel value lists. * statePtr->argvList[i] is a value list counted by statePtr->argcList[i]; * statePtr->varvList[i] is the list of variables associated with the * value list; * statePtr->varcList[i] is the number of variables associated with the * value list; * statePtr->index[i] is the current pointer into the value list * statePtr->argvList[i]. * * The setting up of all of these pointers is moderately messy, but allows * the rest of this code to be simple and for us to use a single memory * allocation for better performance. */ statePtr = (struct ForeachState *)TclStackAlloc(interp, sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); memset(statePtr, 0, sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); statePtr->varvList = (Tcl_Obj ***) (statePtr + 1); statePtr->argvList = statePtr->varvList + numLists; statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists); statePtr->aCopyList = statePtr->vCopyList + numLists; statePtr->index = (int *) (statePtr->aCopyList + numLists); statePtr->varcList = statePtr->index + numLists; statePtr->argcList = statePtr->varcList + numLists; statePtr->numLists = numLists; statePtr->bodyPtr = objv[objc - 1]; statePtr->bodyIdx = objc - 1; if (collect == TCL_EACH_COLLECT) { statePtr->resultList = Tcl_NewListObj(0, NULL); } else { statePtr->resultList = NULL; } /* * Break up the value lists and variable lists into elements. */ for (i=0 ; ivCopyList[i] = TclListObjCopy(interp, objv[1+i*2]); if (statePtr->vCopyList[i] == NULL) { result = TCL_ERROR; goto done; } TclListObjGetElements(NULL, statePtr->vCopyList[i], &statePtr->varcList[i], &statePtr->varvList[i]); if (statePtr->varcList[i] < 1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s varlist is empty", (statePtr->resultList != NULL ? "lmap" : "foreach"))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", (statePtr->resultList != NULL ? "LMAP" : "FOREACH"), "NEEDVARS", NULL); result = TCL_ERROR; goto done; } statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]); if (statePtr->aCopyList[i] == NULL) { result = TCL_ERROR; goto done; } TclListObjGetElements(NULL, statePtr->aCopyList[i], &statePtr->argcList[i], &statePtr->argvList[i]); j = statePtr->argcList[i] / statePtr->varcList[i]; if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) { j++; } if (j > statePtr->maxj) { statePtr->maxj = j; } } /* * If there is any work to do, assign the variables and set things going * non-recursively. */ if (statePtr->maxj > 0) { result = ForeachAssignments(interp, statePtr); if (result == TCL_ERROR) { goto done; } TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, objv[objc-1], 0, ((Interp *) interp)->cmdFramePtr, objc-1); } /* * This cleanup stage is only used when an error occurs during setup or if * there is no work to do. */ result = TCL_OK; done: ForeachCleanup(interp, statePtr); return result; } /* * Post-body processing handler. */ static int ForeachLoopStep( ClientData data[], Tcl_Interp *interp, int result) { struct ForeachState *statePtr = (struct ForeachState *)data[0]; /* * Process the result code from this run of the [foreach] body. Note that * this switch uses fallthroughs in several places. Maintainer aware! */ switch (result) { case TCL_CONTINUE: result = TCL_OK; break; case TCL_OK: if (statePtr->resultList != NULL) { Tcl_ListObjAppendElement(interp, statePtr->resultList, Tcl_GetObjResult(interp)); } break; case TCL_BREAK: result = TCL_OK; goto finish; case TCL_ERROR: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%s\" body line %d)", (statePtr->resultList != NULL ? "lmap" : "foreach"), Tcl_GetErrorLine(interp))); default: goto done; } /* * Test if there is work still to be done. If so, do the next round of * variable assignments, reschedule ourselves and run the body again. */ if (statePtr->maxj > ++statePtr->j) { result = ForeachAssignments(interp, statePtr); if (result == TCL_ERROR) { goto done; } TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, statePtr->bodyPtr, 0, ((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx); } /* * We're done. Tidy up our work space and finish off. */ finish: if (statePtr->resultList == NULL) { Tcl_ResetResult(interp); } else { Tcl_SetObjResult(interp, statePtr->resultList); statePtr->resultList = NULL; /* Don't clean it up */ } done: ForeachCleanup(interp, statePtr); return result; } /* * Factored out code to do the assignments in [foreach]. */ static inline int ForeachAssignments( Tcl_Interp *interp, struct ForeachState *statePtr) { int i, v, k; Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; inumLists ; i++) { for (v=0 ; vvarcList[i] ; v++) { k = statePtr->index[i]++; if (k < statePtr->argcList[i]) { valuePtr = statePtr->argvList[i][k]; } else { TclNewObj(valuePtr); /* Empty string */ } varValuePtr = Tcl_ObjSetVar2(interp, statePtr->varvList[i][v], NULL, valuePtr, TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (setting %s loop variable \"%s\")", (statePtr->resultList != NULL ? "lmap" : "foreach"), TclGetString(statePtr->varvList[i][v]))); return TCL_ERROR; } } } return TCL_OK; } /* * Factored out code for cleaning up the state of the foreach. */ static inline void ForeachCleanup( Tcl_Interp *interp, struct ForeachState *statePtr) { int i; for (i=0 ; inumLists ; i++) { if (statePtr->vCopyList[i]) { TclDecrRefCount(statePtr->vCopyList[i]); } if (statePtr->aCopyList[i]) { TclDecrRefCount(statePtr->aCopyList[i]); } } if (statePtr->resultList != NULL) { TclDecrRefCount(statePtr->resultList); } TclStackFree(interp, statePtr); } /* *---------------------------------------------------------------------- * * Tcl_FormatObjCmd -- * * This procedure is invoked to process the "format" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_FormatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *resultPtr; /* Where result is stored finally. */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?"); return TCL_ERROR; } resultPtr = Tcl_Format(interp, TclGetString(objv[1]), objc-2, objv+2); if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclCmdIL.c0000644000175000017500000036060614554262142015070 0ustar sergeisergei/* * tclCmdIL.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters I through L. It * contains only commands in the generic core (i.e., those that don't * depend much upon UNIX facilities). * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1993-1997 Lucent Technologies. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2005 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclRegexp.h" /* * During execution of the "lsort" command, structures of the following type * are used to arrange the objects being sorted into a collection of linked * lists. */ typedef struct SortElement { union { /* The value that we sorting by. */ const char *strValuePtr; Tcl_WideInt wideValue; double doubleValue; Tcl_Obj *objValuePtr; } collationKey; union { /* Object being sorted, or its index. */ Tcl_Obj *objPtr; int index; } payload; struct SortElement *nextPtr;/* Next element in the list, or NULL for end * of list. */ } SortElement; /* * These function pointer types are used with the "lsearch" and "lsort" * commands to facilitate the "-nocase" option. */ typedef int (*SortStrCmpFn_t) (const char *, const char *); typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t); /* * The "lsort" command needs to pass certain information down to the function * that compares two list elements, and the comparison function needs to pass * success or failure information back up to the top-level "lsort" command. * The following structure is used to pass this information. */ typedef struct SortInfo { int isIncreasing; /* Nonzero means sort in increasing order. */ int sortMode; /* The sort mode. One of SORTMODE_* values * defined below. */ Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is * SORTMODE_COMMAND. Preinitialized to hold * base of command. */ int *indexv; /* If the -index option was specified, this * holds an encoding of the indexes contained * in the list supplied as an argument to * that option. * NULL if no indexes supplied, and points to * singleIndex field when only one * supplied. */ int indexc; /* Number of indexes in indexv array. */ int singleIndex; /* Static space for common index case. */ int unique; int numElements; Tcl_Interp *interp; /* The interpreter in which the sort is being * done. */ int resultCode; /* Completion code for the lsort command. If * an error occurs during the sort this is * changed from TCL_OK to TCL_ERROR. */ } SortInfo; /* * The "sortMode" field of the SortInfo structure can take on any of the * following values. */ #define SORTMODE_ASCII 0 #define SORTMODE_INTEGER 1 #define SORTMODE_REAL 2 #define SORTMODE_COMMAND 3 #define SORTMODE_DICTIONARY 4 #define SORTMODE_ASCII_NC 8 /* * Forward declarations for procedures defined in this file: */ static int DictionaryCompare(const char *left, const char *right); static Tcl_NRPostProc IfConditionCallback; static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* TIP #348 - New 'info' subcommand 'errorstack' */ static int InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* TIP #280 - New 'info' subcommand 'frame' */ static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoLevelCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoNameOfExecutableCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoProcsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr, SortInfo *infoPtr); static int SortCompare(SortElement *firstPtr, SortElement *second, SortInfo *infoPtr); static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, SortInfo *infoPtr); /* * Array of values describing how to implement each standard subcommand of the * "info" command. */ static const EnsembleImplMap defaultInfoMap[] = { {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, {"default", InfoDefaultCmd, TclCompileBasic3ArgCmd, NULL, NULL, 0}, {"errorstack", InfoErrorStackCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0}, {"frame", InfoFrameCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"functions", InfoFunctionsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"globals", TclInfoGlobalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"hostname", InfoHostnameCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"level", InfoLevelCmd, TclCompileInfoLevelCmd, NULL, NULL, 0}, {"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* *---------------------------------------------------------------------- * * Tcl_IfObjCmd -- * * This procedure is invoked to process the "if" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a * command name is computed at runtime, and is "if" or the name to which * "if" was renamed: e.g., "set z if; $z 1 {puts foo}" * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_IfObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRIfObjCmd, dummy, objc, objv); } int TclNRIfObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *boolObj; if (objc <= 1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: no expression after \"%s\" argument", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } /* * At this point, objv[1] refers to the main expression to test. The * arguments after the expression must be "then" (optional) and a script * to execute if the expression is true. */ TclNewObj(boolObj); Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc), (ClientData) objv, INT2PTR(1), boolObj); return Tcl_NRExprObj(interp, objv[1], boolObj); } static int IfConditionCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); Tcl_Obj *const *objv = (Tcl_Obj *const *)data[1]; int i = PTR2INT(data[2]); Tcl_Obj *boolObj = (Tcl_Obj *)data[3]; int value, thenScriptIndex = 0; const char *clause; if (result != TCL_OK) { TclDecrRefCount(boolObj); return result; } if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) { TclDecrRefCount(boolObj); return TCL_ERROR; } TclDecrRefCount(boolObj); while (1) { i++; if (i >= objc) { goto missingScript; } clause = TclGetString(objv[i]); if ((i < objc) && (strcmp(clause, "then") == 0)) { i++; } if (i >= objc) { goto missingScript; } if (value) { thenScriptIndex = i; value = 0; } /* * The expression evaluated to false. Skip the command, then see if * there is an "else" or "elseif" clause. */ i++; if (i >= objc) { if (thenScriptIndex) { /* * TIP #280. Make invoking context available to branch. */ return TclNREvalObjEx(interp, objv[thenScriptIndex], 0, iPtr->cmdFramePtr, thenScriptIndex); } return TCL_OK; } clause = TclGetString(objv[i]); if ((clause[0] != 'e') || (strcmp(clause, "elseif") != 0)) { break; } i++; /* * At this point in the loop, objv and objc refer to an expression to * test, either for the main expression or an expression following an * "elseif". The arguments after the expression must be "then" * (optional) and a script to execute if the expression is true. */ if (i >= objc) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: no expression after \"%s\" argument", clause)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } if (!thenScriptIndex) { TclNewObj(boolObj); Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1], INT2PTR(i), boolObj); return Tcl_NRExprObj(interp, objv[i], boolObj); } } /* * Couldn't find a "then" or "elseif" clause to execute. Check now for an * "else" clause. We know that there's at least one more argument when we * get here. */ if (strcmp(clause, "else") == 0) { i++; if (i >= objc) { goto missingScript; } } if (i < objc - 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "wrong # args: extra words after \"else\" clause in \"if\" command", -1)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } if (thenScriptIndex) { /* * TIP #280. Make invoking context available to branch/else. */ return TclNREvalObjEx(interp, objv[thenScriptIndex], 0, iPtr->cmdFramePtr, thenScriptIndex); } return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i); missingScript: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: no script following \"%s\" argument", TclGetString(objv[i-1]))); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_IncrObjCmd -- * * This procedure is invoked to process the "incr" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a * command name is computed at runtime, and is "incr" or the name to * which "incr" was renamed: e.g., "set z incr; $z i -1" * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_IncrObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *newValuePtr, *incrPtr; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?"); return TCL_ERROR; } if (objc == 3) { incrPtr = objv[2]; } else { TclNewIntObj(incrPtr, 1); } Tcl_IncrRefCount(incrPtr); newValuePtr = TclIncrObjVar2(interp, objv[1], NULL, incrPtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(incrPtr); if (newValuePtr == NULL) { return TCL_ERROR; } /* * Set the interpreter's object result to refer to the variable's new * value object. */ Tcl_SetObjResult(interp, newValuePtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclInitInfoCmd -- * * This function is called to create the "info" Tcl command. See the user * documentation for details on what it does. * * Results: * Handle for the info command, or NULL on failure. * * Side effects: * none * *---------------------------------------------------------------------- */ Tcl_Command TclInitInfoCmd( Tcl_Interp *interp) /* Current interpreter. */ { return TclMakeEnsemble(interp, "info", defaultInfoMap); } /* *---------------------------------------------------------------------- * * InfoArgsCmd -- * * Called to implement the "info args" command that returns the argument * list for a procedure. Handles the following syntax: * * info args procName * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoArgsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *name; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *listObjPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); return TCL_ERROR; } name = TclGetString(objv[1]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" isn't a procedure", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL); return TCL_ERROR; } /* * Build a return list containing the arguments. */ listObjPtr = Tcl_NewListObj(0, NULL); for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; localPtr = localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj(localPtr->name, -1)); } } Tcl_SetObjResult(interp, listObjPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoBodyCmd -- * * Called to implement the "info body" command that returns the body for * a procedure. Handles the following syntax: * * info body procName * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoBodyCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *name; Proc *procPtr; Tcl_Obj *bodyPtr, *resultPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); return TCL_ERROR; } name = TclGetString(objv[1]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" isn't a procedure", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL); return TCL_ERROR; } /* * Here we used to return procPtr->bodyPtr, except when the body was * bytecompiled - in that case, the return was a copy of the body's string * rep. In order to better isolate the implementation details of the * compiler/engine subsystem, we now always return a copy of the string * rep. It is important to return a copy so that later manipulations of * the object do not invalidate the internal rep. */ bodyPtr = procPtr->bodyPtr; if (bodyPtr->bytes == NULL) { /* * The string rep might not be valid if the procedure has never been * run before. [Bug #545644] */ TclGetString(bodyPtr); } resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length); Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoCmdCountCmd -- * * Called to implement the "info cmdcount" command that returns the * number of commands that have been executed. Handles the following * syntax: * * info cmdcount * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoCmdCountCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->cmdCount)); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoCommandsCmd -- * * Called to implement the "info commands" command that returns the list * of commands in the interpreter that match an optional pattern. The * pattern, if any, consists of an optional sequence of namespace names * separated by "::" qualifiers, which is followed by a glob-style * pattern that restricts which commands are returned. Handles the * following syntax: * * info commands ?pattern? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoCommandsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *cmdName, *pattern; const char *simplePattern; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; int i; /* * Get the pattern and find the "effective namespace" in which to list * commands. */ if (objc == 1) { simplePattern = NULL; nsPtr = currNsPtr; specificNsInPattern = 0; } else if (objc == 2) { /* * From the pattern, get the effective namespace and the simple * pattern (no namespace qualifiers or ::'s) at the end. If an error * was found while parsing the pattern, return it. Otherwise, if the * namespace wasn't found, just leave nsPtr NULL: we will return an * empty list since no commands there can be found. */ Namespace *dummy1NsPtr, *dummy2NsPtr; pattern = TclGetString(objv[1]); TclGetNamespaceForQualName(interp, pattern, NULL, 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern); if (nsPtr != NULL) { /* We successfully found the pattern's ns. */ specificNsInPattern = (strcmp(simplePattern, pattern) != 0); } } else { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } /* * Exit as quickly as possible if we couldn't find the namespace. */ if (nsPtr == NULL) { return TCL_OK; } /* * Scan through the effective namespace's command table and create a list * with all commands that match the pattern. If a specific namespace was * requested in the pattern, qualify the command names with the namespace * name. */ listPtr = Tcl_NewListObj(0, NULL); if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { /* * Special case for when the pattern doesn't include any of glob's * special characters. This lets us avoid scans of any hash tables. */ entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (entryPtr != NULL) { if (specificNsInPattern) { cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); TclNewObj(elemObjPtr); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } if ((nsPtr != globalNsPtr) && !specificNsInPattern) { Tcl_HashTable *tablePtr = NULL; /* Quell warning. */ for (i=0 ; icommandPathLength ; i++) { Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr; if (pathNsPtr == NULL) { continue; } tablePtr = &pathNsPtr->cmdTable; entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern); if (entryPtr != NULL) { break; } } if (entryPtr == NULL) { tablePtr = &globalNsPtr->cmdTable; entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern); } if (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(tablePtr, entryPtr); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } } } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) { /* * The pattern is non-trivial, but either there is no explicit path or * there is an explicit namespace in the pattern. In both cases, the * old matching scheme is perfect. */ entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (specificNsInPattern) { cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); TclNewObj(elemObjPtr); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } entryPtr = Tcl_NextHashEntry(&search); } /* * If the effective namespace isn't the global :: namespace, and a * specific namespace wasn't requested in the pattern, then add in all * global :: commands that match the simple pattern. Of course, we add * in only those commands that aren't hidden by a command in the * effective namespace. */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); } } entryPtr = Tcl_NextHashEntry(&search); } } } else { /* * The pattern is non-trivial (can match more than one command name), * there is an explicit path, and there is no explicit namespace in * the pattern. This means that we have to traverse the path to * discover all the commands defined. */ Tcl_HashTable addedCommandsTable; int isNew; int foundGlobal = (nsPtr == globalNsPtr); /* * We keep a hash of the objects already added to the result list. */ Tcl_InitObjHashTable(&addedCommandsTable); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); (void) Tcl_CreateHashEntry(&addedCommandsTable, elemObjPtr, &isNew); } entryPtr = Tcl_NextHashEntry(&search); } /* * Search the path next. */ for (i=0 ; icommandPathLength ; i++) { Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr; if (pathNsPtr == NULL) { continue; } if (pathNsPtr == globalNsPtr) { foundGlobal = 1; } entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); (void) Tcl_CreateHashEntry(&addedCommandsTable, elemObjPtr, &isNew); if (isNew) { Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } else { TclDecrRefCount(elemObjPtr); } } entryPtr = Tcl_NextHashEntry(&search); } } /* * If the effective namespace isn't the global :: namespace, and a * specific namespace wasn't requested in the pattern, then add in all * global :: commands that match the simple pattern. Of course, we add * in only those commands that aren't hidden by a command in the * effective namespace. */ if (!foundGlobal) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); if (Tcl_FindHashEntry(&addedCommandsTable, (char *) elemObjPtr) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } else { TclDecrRefCount(elemObjPtr); } } entryPtr = Tcl_NextHashEntry(&search); } } Tcl_DeleteHashTable(&addedCommandsTable); } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoCompleteCmd -- * * Called to implement the "info complete" command that determines * whether a string is a complete Tcl command. Handles the following * syntax: * * info complete command * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoCompleteCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "command"); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj( TclObjCommandComplete(objv[1]))); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoDefaultCmd -- * * Called to implement the "info default" command that returns the * default value for a procedure argument. Handles the following syntax: * * info default procName arg varName * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoDefaultCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *procName, *argName; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *valueObjPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "procname arg varname"); return TCL_ERROR; } procName = TclGetString(objv[1]); argName = TclGetString(objv[2]); procPtr = TclFindProc(iPtr, procName); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" isn't a procedure", procName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName, NULL); return TCL_ERROR; } for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; localPtr = localPtr->nextPtr) { if (TclIsVarArgument(localPtr) && (strcmp(argName, localPtr->name) == 0)) { if (localPtr->defValuePtr != NULL) { valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL, localPtr->defValuePtr, TCL_LEAVE_ERR_MSG); if (valueObjPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } else { Tcl_Obj *nullObjPtr; TclNewObj(nullObjPtr); valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL, nullObjPtr, TCL_LEAVE_ERR_MSG); if (valueObjPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } return TCL_OK; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\" doesn't have an argument \"%s\"", procName, argName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * InfoErrorStackCmd -- * * Called to implement the "info errorstack" command that returns information * about the last error's call stack. Handles the following syntax: * * info errorstack ?interp? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoErrorStackCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *target; Interp *iPtr; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?interp?"); return TCL_ERROR; } target = interp; if (objc == 2) { target = Tcl_GetChild(interp, Tcl_GetString(objv[1])); if (target == NULL) { return TCL_ERROR; } } iPtr = (Interp *) target; Tcl_SetObjResult(interp, iPtr->errorStack); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclInfoExistsCmd -- * * Called to implement the "info exists" command that determines whether * a variable exists. Handles the following syntax: * * info exists varName * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ int TclInfoExistsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *varName; Var *varPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName"); return TCL_ERROR; } varName = TclGetString(objv[1]); varPtr = TclVarTraceExists(interp, varName); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(varPtr && varPtr->value.objPtr)); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoFrameCmd -- * TIP #280 * * Called to implement the "info frame" command that returns the location * of either the currently executing command, or its caller. Handles the * following syntax: * * info frame ?number? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoFrameCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; int level, code = TCL_OK; CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr; CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; int topLevel = 0; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?number?"); return TCL_ERROR; } while (corPtr) { while (*cmdFramePtrPtr) { topLevel++; cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr); } if (corPtr->caller.cmdFramePtr) { *cmdFramePtrPtr = corPtr->caller.cmdFramePtr; } corPtr = corPtr->callerEEPtr->corPtr; } topLevel += (*cmdFramePtrPtr)->level; if (topLevel != iPtr->cmdFramePtr->level) { framePtr = iPtr->cmdFramePtr; while (framePtr) { framePtr->level = topLevel--; framePtr = framePtr->nextPtr; } if (topLevel) { Tcl_Panic("Broken frame level calculation"); } topLevel = iPtr->cmdFramePtr->level; } if (objc == 1) { /* * Just "info frame". */ Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel)); goto done; } /* * We've got "info frame level" and must parse the level first. */ if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) { code = TCL_ERROR; goto done; } if ((level > topLevel) || (level <= - topLevel)) { levelError: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad level \"%s\"", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", TclGetString(objv[1]), NULL); code = TCL_ERROR; goto done; } /* * Let us convert to relative so that we know how many levels to go back */ if (level > 0) { level -= topLevel; } framePtr = iPtr->cmdFramePtr; while (++level <= 0) { framePtr = framePtr->nextPtr; if (!framePtr) { goto levelError; } } Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr)); done: cmdFramePtrPtr = &iPtr->cmdFramePtr; corPtr = iPtr->execEnvPtr->corPtr; while (corPtr) { CmdFrame *endPtr = corPtr->caller.cmdFramePtr; if (endPtr) { if (*cmdFramePtrPtr == endPtr) { *cmdFramePtrPtr = NULL; } else { CmdFrame *runPtr = *cmdFramePtrPtr; while (runPtr->nextPtr != endPtr) { runPtr->level -= endPtr->level; runPtr = runPtr->nextPtr; } runPtr->level = 1; runPtr->nextPtr = NULL; } cmdFramePtrPtr = &corPtr->caller.cmdFramePtr; } corPtr = corPtr->callerEEPtr->corPtr; } return code; } /* *---------------------------------------------------------------------- * * TclInfoFrame -- * * Core of InfoFrameCmd, returns TIP280 dict for a given frame. * * Results: * Returns TIP280 dict. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * TclInfoFrame( Tcl_Interp *interp, /* Current interpreter. */ CmdFrame *framePtr) /* Frame to get info for. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *tmpObj; Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to * the dict. */ int lc = 0; /* * This array is indexed by the TCL_LOCATION_... values, except * for _LAST. */ static const char *const typeString[TCL_LOCATION_LAST] = { "eval", "eval", "eval", "precompiled", "source", "proc" }; Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL; int needsFree = -1; /* * Pull the information and construct the dictionary to return, as list. * Regarding use of the CmdFrame fields see tclInt.h, and its definition. */ #define ADD_PAIR(name, value) \ TclNewLiteralStringObj(tmpObj, name); \ lv[lc++] = tmpObj; \ lv[lc++] = (value) switch (framePtr->type) { case TCL_LOCATION_EVAL: /* * Evaluation, dynamic script. Type, line, cmd, the latter through * str. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); if (framePtr->line) { ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); } else { ADD_PAIR("line", Tcl_NewIntObj(1)); } ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PREBC: /* * Precompiled. Result contains the type as signal, nothing else. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); break; case TCL_LOCATION_BC: { /* * Execution of bytecode. Talk to the BC engine to fill out the frame. */ CmdFrame *fPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *fPtr = *framePtr; /* * Note: * Type BC => f.data.eval.path is not used. * f.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc(fPtr); /* * Now filled: cmd.str.(cmd,len), line * Possibly modified: type, path! */ ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1)); if (fPtr->line) { ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0])); } if (fPtr->type == TCL_LOCATION_SOURCE) { ADD_PAIR("file", fPtr->data.eval.path); /* * Death of reference by TclGetSrcInfoForPc. */ Tcl_DecrRefCount(fPtr->data.eval.path); } ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL)); if (fPtr->cmdObj && framePtr->cmdObj == NULL) { needsFree = lc - 1; } TclStackFree(interp, fPtr); break; } case TCL_LOCATION_SOURCE: /* * Evaluation of a script file. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); ADD_PAIR("file", framePtr->data.eval.path); /* * Refcount framePtr->data.eval.path goes up when lv is converted into * the result list object. */ ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PROC: Tcl_Panic("TCL_LOCATION_PROC found in standard frame"); break; } /* * 'proc'. Common to all frame types. Conditional on having an associated * Procedure CallFrame. */ if (procPtr != NULL) { Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; if (namePtr) { Tcl_Obj *procNameObj; /* * This is a regular command. */ TclNewObj(procNameObj); Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, procNameObj); ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData; int i; /* * This is a non-standard command. Luckily, it's told us how to * render extra information about its frame. */ for (i=0 ; ilength ; i++) { lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1); if (efiPtr->fields[i].proc) { lv[lc++] = efiPtr->fields[i].proc(efiPtr->fields[i].clientData); } else { lv[lc++] = (Tcl_Obj *)efiPtr->fields[i].clientData; } } } } /* * 'level'. Common to all frame types. Conditional on having an associated * _visible_ CallFrame. */ if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) { CallFrame *current = framePtr->framePtr; CallFrame *top = iPtr->varFramePtr; CallFrame *idx; for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) { if (idx == current) { int c = framePtr->framePtr->level; int t = iPtr->varFramePtr->level; ADD_PAIR("level", Tcl_NewIntObj(t - c)); break; } } } tmpObj = Tcl_NewListObj(lc, lv); if (needsFree >= 0) { Tcl_DecrRefCount(lv[needsFree]); } return tmpObj; } /* *---------------------------------------------------------------------- * * InfoFunctionsCmd -- * * Called to implement the "info functions" command that returns the list * of math functions matching an optional pattern. Handles the following * syntax: * * info functions ?pattern? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoFunctionsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *script; int code; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } script = Tcl_NewStringObj( " ::apply [::list {{pattern *}} {\n" " ::set cmds {}\n" " ::foreach cmd [::info commands ::tcl::mathfunc::$pattern] {\n" " ::lappend cmds [::namespace tail $cmd]\n" " }\n" " ::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n" " ::set cmd [::namespace tail $cmd]\n" " ::if {$cmd ni $cmds} {\n" " ::lappend cmds $cmd\n" " }\n" " }\n" " ::return $cmds\n" " } [::namespace current]] ", -1); if (objc == 2) { Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1])); Tcl_AppendObjToObj(script, arg); Tcl_DecrRefCount(arg); } Tcl_IncrRefCount(script); code = Tcl_EvalObjEx(interp, script, 0); Tcl_DecrRefCount(script); return code; } /* *---------------------------------------------------------------------- * * InfoHostnameCmd -- * * Called to implement the "info hostname" command that returns the host * name. Handles the following syntax: * * info hostname * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoHostnameCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } name = Tcl_GetHostName(); if (name) { Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( "unable to determine name of host", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * InfoLevelCmd -- * * Called to implement the "info level" command that returns information * about the call stack. Handles the following syntax: * * info level ?number? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoLevelCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; if (objc == 1) { /* Just "info level" */ Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level)); return TCL_OK; } if (objc == 2) { int level; CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr; if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) { return TCL_ERROR; } if (level <= 0) { if (iPtr->varFramePtr == rootFramePtr) { goto levelError; } level += iPtr->varFramePtr->level; } for (framePtr=iPtr->varFramePtr ; framePtr!=rootFramePtr; framePtr=framePtr->callerVarPtr) { if (framePtr->level == level) { break; } } if (framePtr == rootFramePtr) { goto levelError; } Tcl_SetObjResult(interp, Tcl_NewListObj(framePtr->objc, framePtr->objv)); return TCL_OK; } Tcl_WrongNumArgs(interp, 1, objv, "?number?"); return TCL_ERROR; levelError: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad level \"%s\"", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", TclGetString(objv[1]), NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * InfoLibraryCmd -- * * Called to implement the "info library" command that returns the * library directory for the Tcl installation. Handles the following * syntax: * * info library * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoLibraryCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *libDirName; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY); if (libDirName != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1)); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( "no library has been specified for Tcl", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * InfoLoadedCmd -- * * Called to implement the "info loaded" command that returns the * packages that have been loaded into an interpreter. Handles the * following syntax: * * info loaded ?interp? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoLoadedCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *interpName; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?interp?"); return TCL_ERROR; } if (objc == 1) { /* Get loaded pkgs in all interpreters. */ interpName = NULL; } else { /* Get pkgs just in specified interp. */ interpName = TclGetString(objv[1]); } return TclGetLoadedPackages(interp, interpName); } /* *---------------------------------------------------------------------- * * InfoNameOfExecutableCmd -- * * Called to implement the "info nameofexecutable" command that returns * the name of the binary file running this application. Handles the * following syntax: * * info nameofexecutable * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoNameOfExecutableCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclGetObjNameOfExecutable()); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoPatchLevelCmd -- * * Called to implement the "info patchlevel" command that returns the * default value for an argument to a procedure. Handles the following * syntax: * * info patchlevel * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoPatchLevelCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *patchlevel; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } patchlevel = Tcl_GetVar(interp, "tcl_patchLevel", (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (patchlevel != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1)); return TCL_OK; } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * InfoProcsCmd -- * * Called to implement the "info procs" command that returns the list of * procedures in the interpreter that match an optional pattern. The * pattern, if any, consists of an optional sequence of namespace names * separated by "::" qualifiers, which is followed by a glob-style * pattern that restricts which commands are returned. Handles the * following syntax: * * info procs ?pattern? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoProcsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *cmdName, *pattern; const char *simplePattern; Namespace *nsPtr; #ifdef INFO_PROCS_SEARCH_GLOBAL_NS Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); #endif Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr, *realCmdPtr; /* * Get the pattern and find the "effective namespace" in which to list * procs. */ if (objc == 1) { simplePattern = NULL; nsPtr = currNsPtr; specificNsInPattern = 0; } else if (objc == 2) { /* * From the pattern, get the effective namespace and the simple * pattern (no namespace qualifiers or ::'s) at the end. If an error * was found while parsing the pattern, return it. Otherwise, if the * namespace wasn't found, just leave nsPtr NULL: we will return an * empty list since no commands there can be found. */ Namespace *dummy1NsPtr, *dummy2NsPtr; pattern = TclGetString(objv[1]); TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern); if (nsPtr != NULL) { /* We successfully found the pattern's ns. */ specificNsInPattern = (strcmp(simplePattern, pattern) != 0); } } else { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } if (nsPtr == NULL) { return TCL_OK; } /* * Scan through the effective namespace's command table and create a list * with all procs that match the pattern. If a specific namespace was * requested in the pattern, qualify the command names with the namespace * name. */ listPtr = Tcl_NewListObj(0, NULL); #ifndef INFO_PROCS_SEARCH_GLOBAL_NS if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (entryPtr != NULL) { cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { goto simpleProcOK; } } else { simpleProcOK: if (specificNsInPattern) { TclNewObj(elemObjPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(simplePattern, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } } else #endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */ { entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { goto procOK; } } else { procOK: if (specificNsInPattern) { TclNewObj(elemObjPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } entryPtr = Tcl_NextHashEntry(&search); } /* * If the effective namespace isn't the global :: namespace, and a * specific namespace wasn't requested in the pattern, then add in all * global :: procs that match the simple pattern. Of course, we add in * only those procs that aren't hidden by a proc in the effective * namespace. */ #ifdef INFO_PROCS_SEARCH_GLOBAL_NS /* * If "info procs" worked like "info commands", returning the commands * also seen in the global namespace, then you would include this * code. As this could break backwards compatibility with 8.0-8.2, we * decided not to "fix" it in 8.3, leaving the behavior slightly * different. */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { cmdPtr = Tcl_GetHashValue(entryPtr); realCmdPtr = (Command *) TclGetOriginalCommand( (Tcl_Command) cmdPtr); if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); } } } entryPtr = Tcl_NextHashEntry(&search); } } #endif } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoScriptCmd -- * * Called to implement the "info script" command that returns the script * file that is currently being evaluated. Handles the following syntax: * * info script ?newName? * * If newName is specified, it will set that as the internal name. * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. It may change the internal * script filename. * *---------------------------------------------------------------------- */ static int InfoScriptCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?filename?"); return TCL_ERROR; } if (objc == 2) { if (iPtr->scriptFile != NULL) { Tcl_DecrRefCount(iPtr->scriptFile); } iPtr->scriptFile = objv[1]; Tcl_IncrRefCount(iPtr->scriptFile); } if (iPtr->scriptFile != NULL) { Tcl_SetObjResult(interp, iPtr->scriptFile); } return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoSharedlibCmd -- * * Called to implement the "info sharedlibextension" command that returns * the file extension used for shared libraries. Handles the following * syntax: * * info sharedlibextension * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoSharedlibCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } #ifdef TCL_SHLIB_EXT Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1)); #endif return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoTclVersionCmd -- * * Called to implement the "info tclversion" command that returns the * version number for this Tcl library. Handles the following syntax: * * info tclversion * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoTclVersionCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *version; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } version = Tcl_GetVar2Ex(interp, "tcl_version", NULL, (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (version != NULL) { Tcl_SetObjResult(interp, version); return TCL_OK; } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_JoinObjCmd -- * * This procedure is invoked to process the "join" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_JoinObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int listLen, i; Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?"); return TCL_ERROR; } /* * Make sure the list argument is a list object and get its length and a * pointer to its array of element pointers. */ if (TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs) != TCL_OK) { return TCL_ERROR; } joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); TclNewObj(resObjPtr); for (i = 0; i < listLen; i++) { if (i > 0) { /* * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT** * to shimmer joinObjPtr. If it did, then the case where * objv[1] and objv[2] are the same value would not be safe. * Accessing elemPtrs would crash. */ Tcl_AppendObjToObj(resObjPtr, joinObjPtr); } Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]); } Tcl_DecrRefCount(joinObjPtr); Tcl_SetObjResult(interp, resObjPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LassignObjCmd -- * * This object-based procedure is invoked to process the "lassign" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LassignObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listCopyPtr; Tcl_Obj **listObjv; /* The contents of the list. */ int listObjc; /* The length of the list. */ int code = TCL_OK; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?"); return TCL_ERROR; } listCopyPtr = TclListObjCopy(interp, objv[1]); if (listCopyPtr == NULL) { return TCL_ERROR; } TclListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv); objc -= 2; objv += 2; while (code == TCL_OK && objc > 0 && listObjc > 0) { if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++, TCL_LEAVE_ERR_MSG) == NULL) { code = TCL_ERROR; } objc--; listObjc--; } if (code == TCL_OK && objc > 0) { Tcl_Obj *emptyObj; TclNewObj(emptyObj); Tcl_IncrRefCount(emptyObj); while (code == TCL_OK && objc-- > 0) { if (Tcl_ObjSetVar2(interp, *objv++, NULL, emptyObj, TCL_LEAVE_ERR_MSG) == NULL) { code = TCL_ERROR; } } Tcl_DecrRefCount(emptyObj); } if (code == TCL_OK && listObjc > 0) { Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv)); } Tcl_DecrRefCount(listCopyPtr); return code; } /* *---------------------------------------------------------------------- * * Tcl_LindexObjCmd -- * * This object-based procedure is invoked to process the "lindex" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LindexObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *elemPtr; /* Pointer to the element being extracted. */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?"); return TCL_ERROR; } /* * If objc==3, then objv[2] may be either a single index or a list of * indices: go to TclLindexList to determine which. If objc>=4, or * objc==2, then objv[2 .. objc-2] are all single indices and processed as * such in TclLindexFlat. */ if (objc == 3) { elemPtr = TclLindexList(interp, objv[1], objv[2]); } else { elemPtr = TclLindexFlat(interp, objv[1], objc-2, objv+2); } /* * Set the interpreter's object result to the last element extracted. */ if (elemPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, elemPtr); Tcl_DecrRefCount(elemPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LinsertObjCmd -- * * This object-based procedure is invoked to process the "linsert" Tcl * command. See the user documentation for details on what it does. * * Results: * A new Tcl list object formed by inserting zero or more elements into a * list. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LinsertObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; int index, len, result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); return TCL_ERROR; } result = TclListObjLength(interp, objv[1], &len); if (result != TCL_OK) { return result; } /* * Get the index. "end" is interpreted to be the index after the last * element, such that using it will cause any inserted elements to be * appended to the list. */ result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index); if (result != TCL_OK) { return result; } if (index > len) { index = len; } /* * If the list object is unshared we can modify it directly. Otherwise we * create a copy to modify: this is "copy on write". */ listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { listPtr = TclListObjCopy(NULL, listPtr); } if ((objc == 4) && (index == len)) { /* * Special case: insert one element at the end of the list. */ Tcl_ListObjAppendElement(NULL, listPtr, objv[3]); } else { if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0, (objc-3), &(objv[3]))) { return TCL_ERROR; } } /* * Set the interpreter's object result. */ Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ListObjCmd -- * * This procedure is invoked to process the "list" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ListObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { /* * If there are no list elements, the result is an empty object. * Otherwise set the interpreter's result object to be a list object. */ if (objc > 1) { Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1])); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LlengthObjCmd -- * * This object-based procedure is invoked to process the "llength" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LlengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; } result = TclListObjLength(interp, objv[1], &listLen); if (result != TCL_OK) { return result; } /* * Set the interpreter's object result to an integer object holding the * length. */ Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LrangeObjCmd -- * * This procedure is invoked to process the "lrange" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LrangeObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj **elemPtrs; int listLen, first, last, result; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; } result = TclListObjLength(interp, objv[1], &listLen); if (result != TCL_OK) { return result; } result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1, &first); if (result != TCL_OK) { return result; } if (first < 0) { first = 0; } result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1, &last); if (result != TCL_OK) { return result; } if (last >= listLen) { last = listLen - 1; } if (first > last) { /* * Returning an empty list is easy. */ return TCL_OK; } result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (Tcl_IsShared(objv[1]) || ((ListRepPtr(objv[1])->refCount > 1))) { Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1, &elemPtrs[first])); } else { /* * In-place is possible. */ if (last < (listLen - 1)) { Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last, 0, NULL); } /* * This one is not conditioned on (first > 0) in order to preserve the * string-canonizing effect of [lrange 0 end]. */ Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL); Tcl_SetObjResult(interp, objv[1]); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LrepeatObjCmd -- * * This procedure is invoked to process the "lrepeat" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LrepeatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int elementCount, i, totalElems; Tcl_Obj *listPtr, **dataArray = NULL; /* * Check arguments for legality: * lrepeat count ?value ...? */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?"); return TCL_ERROR; } if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) { return TCL_ERROR; } if (elementCount < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad count \"%d\": must be integer >= 0", elementCount)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG", NULL); return TCL_ERROR; } /* * Skip forward to the interesting arguments now we've finished parsing. */ objc -= 2; objv += 2; /* Final sanity check. Do not exceed limits on max list length. */ if (elementCount && objc > LIST_MAX/elementCount) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } totalElems = objc * elementCount; /* * Get an empty list object that is allocated large enough to hold each * init value elementCount times. */ listPtr = Tcl_NewListObj(totalElems, NULL); if (totalElems) { List *listRepPtr = ListRepPtr(listPtr); listRepPtr->elemCount = elementCount*objc; dataArray = &listRepPtr->elements; } /* * Set the elements. Note that we handle the common degenerate case of a * single value being repeated separately to permit the compiler as much * room as possible to optimize a loop that might be run a very large * number of times. */ CLANG_ASSERT(dataArray || totalElems == 0 ); if (objc == 1) { Tcl_Obj *tmpPtr = objv[0]; tmpPtr->refCount += elementCount; for (i=0 ; i listLen) { first = listLen; } if (last >= listLen) { last = listLen - 1; } if (first <= last) { numToDelete = last - first + 1; } else { numToDelete = 0; } /* * If the list object is unshared we can modify it directly, otherwise we * create a copy to modify: this is "copy on write". */ listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { listPtr = TclListObjCopy(NULL, listPtr); } /* * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and * objc == 4. In this case, the list value of listPtr is not changed (no * elements are removed or added), but by making the call we are assured * we end up with a list in canonical form. Resist any temptation to * optimize this case away. */ if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete, objc-4, objv+4)) { return TCL_ERROR; } /* * Set the interpreter's object result. */ Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LreverseObjCmd -- * * This procedure is invoked to process the "lreverse" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LreverseObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj **elemv; int elemc, i, j; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; } if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) { return TCL_ERROR; } /* * If the list is empty, just return it. [Bug 1876793] */ if (!elemc) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } if (Tcl_IsShared(objv[1]) || (ListRepPtr(objv[1])->refCount > 1)) { /* Bug 1675044 */ Tcl_Obj *resultObj, **dataArray; List *listRepPtr; resultObj = Tcl_NewListObj(elemc, NULL); listRepPtr = ListRepPtr(resultObj); listRepPtr->elemCount = elemc; dataArray = &listRepPtr->elements; for (i=0,j=elemc-1 ; i objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing starting index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; } i++; if (objv[i] == objv[objc - 2]) { /* * Take copy to prevent shimmering problems. Note that it does * not matter if the index obj is also a component of the list * being searched. We only need to copy where the list and the * index are one-and-the-same. */ startPtr = Tcl_DuplicateObj(objv[i]); } else { startPtr = objv[i]; Tcl_IncrRefCount(startPtr); } break; case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; int j; if (sortInfo.indexc > 1) { TclStackFree(interp, sortInfo.indexv); } if (i > objc-4) { if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } /* * Store the extracted indices for processing by sublist * extraction. Note that we don't do this using objects because * that has shimmering problems. */ i++; if (TclListObjGetElements(interp, objv[i], &sortInfo.indexc, &indices) != TCL_OK) { if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } return TCL_ERROR; } switch (sortInfo.indexc) { case 0: sortInfo.indexv = NULL; break; case 1: sortInfo.indexv = &sortInfo.singleIndex; break; default: sortInfo.indexv = (int *) TclStackAlloc(interp, sizeof(int) * sortInfo.indexc); } /* * Fill the array by parsing each index. We don't know whether * their scale is sensible yet, but we at least perform the * syntactic check here. */ for (j=0 ; j listc-1) { if (sortInfo.indexc > 1) { TclStackFree(interp, sortInfo.indexv); } if (allMatches || inlineReturn) { Tcl_ResetResult(interp); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); } return TCL_OK; } } patObj = objv[objc - 1]; patternBytes = NULL; if (mode == EXACT || mode == SORTED) { switch ((enum datatypes) dataType) { case ASCII: case DICTIONARY: patternBytes = TclGetStringFromObj(patObj, &length); break; case INTEGER: result = TclGetWideIntFromObj(interp, patObj, &patWide); if (result != TCL_OK) { goto done; } /* * List representation might have been shimmered; restore it. [Bug * 1844789] */ TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv); break; case REAL: result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble); if (result != TCL_OK) { goto done; } /* * List representation might have been shimmered; restore it. [Bug * 1844789] */ TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv); break; } } else { patternBytes = TclGetStringFromObj(patObj, &length); } /* * Set default index value to -1, indicating failure; if we find the item * in the course of our search, index will be set to the correct value. */ index = -1; match = 0; if (mode == SORTED && !allMatches && !negatedMatch) { /* * If the data is sorted, we can do a more intelligent search. Note * that there is no point in being smart when -all was specified; in * that case, we have to look at all items anyway, and there is no * sense in doing this when the match sense is inverted. */ lower = offset - 1; upper = listc; while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) { i = (lower + upper)/2; if (sortInfo.indexc != 0) { itemPtr = SelectObjFromSublist(listv[i], &sortInfo); if (sortInfo.resultCode != TCL_OK) { result = sortInfo.resultCode; goto done; } } else { itemPtr = listv[i]; } switch ((enum datatypes) dataType) { case ASCII: bytes = TclGetString(itemPtr); match = strCmpFn(patternBytes, bytes); break; case DICTIONARY: bytes = TclGetString(itemPtr); match = DictionaryCompare(patternBytes, bytes); break; case INTEGER: result = TclGetWideIntFromObj(interp, itemPtr, &objWide); if (result != TCL_OK) { goto done; } if (patWide == objWide) { match = 0; } else if (patWide < objWide) { match = -1; } else { match = 1; } break; case REAL: result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble); if (result != TCL_OK) { goto done; } if (patDouble == objDouble) { match = 0; } else if (patDouble < objDouble) { match = -1; } else { match = 1; } break; } if (match == 0) { /* * Normally, binary search is written to stop when it finds a * match. If there are duplicates of an element in the list, * our first match might not be the first occurrence. * Consider: 0 0 0 1 1 1 2 2 2 * * To maintain consistency with standard lsearch semantics, we * must find the leftmost occurrence of the pattern in the * list. Thus we don't just stop searching here. This * variation means that a search always makes log n * comparisons (normal binary search might "get lucky" with an * early comparison). * * In bisect mode though, we want the last of equals. */ index = i; if (bisect) { lower = i; } else { upper = i; } } else if (match > 0) { if (isIncreasing) { lower = i; } else { upper = i; } } else { if (isIncreasing) { upper = i; } else { lower = i; } } } if (bisect && index < 0) { index = lower; } } else { /* * We need to do a linear search, because (at least one) of: * - our matcher can only tell equal vs. not equal * - our matching sense is negated * - we're building a list of all matched items */ if (allMatches) { listPtr = Tcl_NewListObj(0, NULL); } for (i = offset; i < listc; i++) { match = 0; if (sortInfo.indexc != 0) { itemPtr = SelectObjFromSublist(listv[i], &sortInfo); if (sortInfo.resultCode != TCL_OK) { if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); } result = sortInfo.resultCode; goto done; } } else { itemPtr = listv[i]; } switch (mode) { case SORTED: case EXACT: switch ((enum datatypes) dataType) { case ASCII: bytes = TclGetStringFromObj(itemPtr, &elemLen); if (length == elemLen) { /* * This split allows for more optimal compilation of * memcmp/strcasecmp. */ if (noCase) { match = (TclUtfCasecmp(bytes, patternBytes) == 0); } else { match = (memcmp(bytes, patternBytes, (size_t) length) == 0); } } break; case DICTIONARY: bytes = TclGetString(itemPtr); match = (DictionaryCompare(bytes, patternBytes) == 0); break; case INTEGER: result = TclGetWideIntFromObj(interp, itemPtr, &objWide); if (result != TCL_OK) { if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); } goto done; } match = (objWide == patWide); break; case REAL: result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble); if (result != TCL_OK) { if (listPtr) { Tcl_DecrRefCount(listPtr); } goto done; } match = (objDouble == patDouble); break; } break; case GLOB: match = Tcl_StringCaseMatch(TclGetString(itemPtr), patternBytes, noCase); break; case REGEXP: match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0); if (match < 0) { Tcl_DecrRefCount(patObj); if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); } result = TCL_ERROR; goto done; } break; } /* * Invert match condition for -not. */ if (negatedMatch) { match = !match; } if (!match) { continue; } if (!allMatches) { index = i; break; } else if (inlineReturn) { /* * Note that these appends are not expected to fail. */ if (returnSubindices && (sortInfo.indexc != 0)) { itemPtr = SelectObjFromSublist(listv[i], &sortInfo); } else { itemPtr = listv[i]; } Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } else if (returnSubindices) { int j; TclNewIntObj(itemPtr, i); for (j=0 ; j 1) { TclStackFree(interp, sortInfo.indexv); } return result; } /* *---------------------------------------------------------------------- * * Tcl_LsetObjCmd -- * * This procedure is invoked to process the "lset" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LsetObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj *listPtr; /* Pointer to the list being altered. */ Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ /* * Check parameter count. */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "listVar ?index? ?index ...? value"); return TCL_ERROR; } /* * Look up the list variable's value. */ listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (listPtr == NULL) { return TCL_ERROR; } /* * Substitute the value in the value. Return either the value or else an * unshared copy of it. */ if (objc == 4) { finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]); } else { finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2, objv[objc-1]); } /* * If substitution has failed, bail out. */ if (finalValuePtr == NULL) { return TCL_ERROR; } /* * Finally, update the variable so that traces fire. */ listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(finalValuePtr); if (listPtr == NULL) { return TCL_ERROR; } /* * Return the new value of the variable as the interpreter result. */ Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LsortObjCmd -- * * This procedure is invoked to process the "lsort" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LsortObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { int i, j, index, indices, length, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; int group, groupSize, groupOffset, idx, allocatedIndexVector = 0; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; size_t elmArrSize; SortElement *elementArray = NULL, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ # define MAXCALLOC 1024000 # define NUM_LISTS 30 SortElement *subList[NUM_LISTS+1]; /* This array holds pointers to temporary * lists built during the merge sort. Element * i of the array holds a list of length * 2**i. */ static const char *const switches[] = { "-ascii", "-command", "-decreasing", "-dictionary", "-increasing", "-index", "-indices", "-integer", "-nocase", "-real", "-stride", "-unique", NULL }; enum Lsort_Switches { LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY, LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER, LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list"); return TCL_ERROR; } /* * Parse arguments to set up the mode for the sort. */ sortInfo.isIncreasing = 1; sortInfo.sortMode = SORTMODE_ASCII; sortInfo.indexv = NULL; sortInfo.indexc = 0; sortInfo.unique = 0; sortInfo.interp = interp; sortInfo.resultCode = TCL_OK; cmdPtr = NULL; indices = 0; group = 0; groupSize = 1; groupOffset = 0; indexPtr = NULL; for (i = 1; i < objc-1; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } switch ((enum Lsort_Switches) index) { case LSORT_ASCII: sortInfo.sortMode = SORTMODE_ASCII; break; case LSORT_COMMAND: if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-command\" option must be followed " "by comparison command", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } sortInfo.sortMode = SORTMODE_COMMAND; cmdPtr = objv[i+1]; i++; break; case LSORT_DECREASING: sortInfo.isIncreasing = 0; break; case LSORT_DICTIONARY: sortInfo.sortMode = SORTMODE_DICTIONARY; break; case LSORT_INCREASING: sortInfo.isIncreasing = 1; break; case LSORT_INDEX: { int sortindex; Tcl_Obj **indexv; if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } if (TclListObjGetElements(interp, objv[i+1], &sortindex, &indexv) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } /* * Check each of the indices for syntactic correctness. Note that * we do not store the converted values here because we do not * know if this is the only -index option yet and so we can't * allocate any space; that happens after the scan through all the * options is done. */ for (j=0 ; j 0) { /* * Use the first value in the list supplied to -index as the * offset of the element within each group by which to sort. */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); if (groupOffset < 0 || groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" " value must be within the group", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADINDEX", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } if (sortInfo.indexc == 1) { sortInfo.indexc = 0; sortInfo.indexv = NULL; } else { sortInfo.indexc--; /* * Do not shrink the actual memory block used; that doesn't * work with TclStackAlloc-allocated memory. [Bug 2918962] * * TODO: Consider a pointer increment to replace this * array shift. */ for (i = 0; i < sortInfo.indexc; i++) { sortInfo.indexv[i] = sortInfo.indexv[i+1]; } } } } sortInfo.numElements = length; indexc = sortInfo.indexc; sortMode = sortInfo.sortMode; if ((sortMode == SORTMODE_ASCII_NC) || (sortMode == SORTMODE_DICTIONARY)) { /* * For this function's purpose all string-based modes are equivalent */ sortMode = SORTMODE_ASCII; } /* * Initialize the sublists. After the following loop, subList[i] will * contain a sorted sublist of length 2**i. Use one extra subList at the * end, always at NULL, to indicate the end of the lists. */ for (j=0 ; j<=NUM_LISTS ; j++) { subList[j] = NULL; } /* * The following loop creates a SortElement for each list element and * begins sorting it into the sublists as it appears. */ elmArrSize = length * sizeof(SortElement); if (elmArrSize <= MAXCALLOC) { elementArray = (SortElement *)ckalloc(elmArrSize); } else { elementArray = (SortElement *)malloc(elmArrSize); } if (!elementArray) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no enough memory to proccess sort of %d items", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } for (i=0; i < length; i++){ idx = groupSize * i + groupOffset; if (indexc) { /* * If this is an indexed sort, retrieve the corresponding element */ indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo); if (sortInfo.resultCode != TCL_OK) { goto done; } } else { indexPtr = listObjPtrs[idx]; } /* * Determine the "value" of this object for sorting purposes */ if (sortMode == SORTMODE_ASCII) { elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr); } else if (sortMode == SORTMODE_INTEGER) { Tcl_WideInt a; if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } elementArray[i].collationKey.wideValue = a; } else if (sortMode == SORTMODE_REAL) { double a; if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } elementArray[i].collationKey.doubleValue = a; } else { elementArray[i].collationKey.objValuePtr = indexPtr; } /* * Determine the representation of this element in the result: either * the objPtr itself, or its index in the original list. */ if (indices || group) { elementArray[i].payload.index = idx; } else { elementArray[i].payload.objPtr = listObjPtrs[idx]; } /* * Merge this element in the preexisting sublists (and merge together * sublists when we have two of the same size). */ elementArray[i].nextPtr = NULL; elementPtr = &elementArray[i]; for (j=0 ; subList[j] ; j++) { elementPtr = MergeLists(subList[j], elementPtr, &sortInfo); subList[j] = NULL; } if (j >= NUM_LISTS) { j = NUM_LISTS-1; } subList[j] = elementPtr; } /* * Merge all sublists */ elementPtr = subList[0]; for (j=1 ; jelements; if (group) { for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) { idx = elementPtr->payload.index; for (j = 0; j < groupSize; j++) { if (indices) { TclNewIntObj(objPtr, idx + j - groupOffset); newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } else { objPtr = listObjPtrs[idx + j - groupOffset]; newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } } } } else if (indices) { for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { TclNewIntObj(objPtr, elementPtr->payload.index); newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } } else { for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { objPtr = elementPtr->payload.objPtr; newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } } listRepPtr->elemCount = i; Tcl_SetObjResult(interp, resultPtr); } done: if (sortMode == SORTMODE_COMMAND) { TclDecrRefCount(sortInfo.compareCmdPtr); TclDecrRefCount(listObj); sortInfo.compareCmdPtr = NULL; } if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); } if (elementArray) { if (elmArrSize <= MAXCALLOC) { ckfree((char *)elementArray); } else { free((char *)elementArray); } } return sortInfo.resultCode; } /* *---------------------------------------------------------------------- * * MergeLists - * * This procedure combines two sorted lists of SortElement structures * into a single sorted list. * * Results: * The unified list of SortElement structures. * * Side effects: * If infoPtr->unique is set then infoPtr->numElements may be updated. * Possibly others, if a user-defined comparison command does something * weird. * * Note: * If infoPtr->unique is set, the merge assumes that there are no * "repeated" elements in each of the left and right lists. In that case, * if any element of the left list is equivalent to one in the right list * it is omitted from the merged list. * * This simplified mechanism works because of the special way our * MergeSort creates the sublists to be merged and will fail to eliminate * all repeats in the general case where they are already present in * either the left or right list. A general code would need to skip * adjacent initial repeats in the left and right lists before comparing * their initial elements, at each step. * *---------------------------------------------------------------------- */ static SortElement * MergeLists( SortElement *leftPtr, /* First list to be merged; may be NULL. */ SortElement *rightPtr, /* Second list to be merged; may be NULL. */ SortInfo *infoPtr) /* Information needed by the comparison * operator. */ { SortElement *headPtr, *tailPtr; int cmp; if (leftPtr == NULL) { return rightPtr; } if (rightPtr == NULL) { return leftPtr; } cmp = SortCompare(leftPtr, rightPtr, infoPtr); if (cmp > 0 || (cmp == 0 && infoPtr->unique)) { if (cmp == 0) { infoPtr->numElements--; leftPtr = leftPtr->nextPtr; } tailPtr = rightPtr; rightPtr = rightPtr->nextPtr; } else { tailPtr = leftPtr; leftPtr = leftPtr->nextPtr; } headPtr = tailPtr; if (!infoPtr->unique) { while ((leftPtr != NULL) && (rightPtr != NULL)) { cmp = SortCompare(leftPtr, rightPtr, infoPtr); if (cmp > 0) { tailPtr->nextPtr = rightPtr; tailPtr = rightPtr; rightPtr = rightPtr->nextPtr; } else { tailPtr->nextPtr = leftPtr; tailPtr = leftPtr; leftPtr = leftPtr->nextPtr; } } } else { while ((leftPtr != NULL) && (rightPtr != NULL)) { cmp = SortCompare(leftPtr, rightPtr, infoPtr); if (cmp >= 0) { if (cmp == 0) { infoPtr->numElements--; leftPtr = leftPtr->nextPtr; } tailPtr->nextPtr = rightPtr; tailPtr = rightPtr; rightPtr = rightPtr->nextPtr; } else { tailPtr->nextPtr = leftPtr; tailPtr = leftPtr; leftPtr = leftPtr->nextPtr; } } } if (leftPtr != NULL) { tailPtr->nextPtr = leftPtr; } else { tailPtr->nextPtr = rightPtr; } return headPtr; } /* *---------------------------------------------------------------------- * * SortCompare -- * * This procedure is invoked by MergeLists to determine the proper * ordering between two elements. * * Results: * A negative results means the first element comes before the * second, and a positive results means that the second element should * come first. A result of zero means the two elements are equal and it * doesn't matter which comes first. * * Side effects: * None, unless a user-defined comparison command does something weird. * *---------------------------------------------------------------------- */ static int SortCompare( SortElement *elemPtr1, SortElement *elemPtr2, /* Values to be compared. */ SortInfo *infoPtr) /* Information passed from the top-level * "lsort" command. */ { int order = 0; if (infoPtr->sortMode == SORTMODE_ASCII) { order = strcmp(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) { order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) { order = DictionaryCompare(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_INTEGER) { Tcl_WideInt a, b; a = elemPtr1->collationKey.wideValue; b = elemPtr2->collationKey.wideValue; order = ((a >= b) - (a <= b)); } else if (infoPtr->sortMode == SORTMODE_REAL) { double a, b; a = elemPtr1->collationKey.doubleValue; b = elemPtr2->collationKey.doubleValue; order = ((a >= b) - (a <= b)); } else { Tcl_Obj **objv, *paramObjv[2]; int objc; Tcl_Obj *objPtr1, *objPtr2; if (infoPtr->resultCode != TCL_OK) { /* * Once an error has occurred, skip any future comparisons so as * to preserve the error message in sortInterp->result. */ return 0; } objPtr1 = elemPtr1->collationKey.objValuePtr; objPtr2 = elemPtr2->collationKey.objValuePtr; paramObjv[0] = objPtr1; paramObjv[1] = objPtr2; /* * We made space in the command list for the two things to compare. * Replace them and evaluate the result. */ TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc); Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2, 2, 2, paramObjv); TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr, &objc, &objv); infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0); if (infoPtr->resultCode != TCL_OK) { Tcl_AddErrorInfo(infoPtr->interp, "\n (-compare command)"); return 0; } /* * Parse the result of the command. */ if (TclGetIntFromObj(infoPtr->interp, Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) { Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj( "-compare command returned non-integer result", -1)); Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", "COMPARISONFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return 0; } } if (!infoPtr->isIncreasing) { order = -order; } return order; } /* *---------------------------------------------------------------------- * * DictionaryCompare * * This function compares two strings as if they were being used in an * index or card catalog. The case of alphabetic characters is ignored, * except to break ties. Thus "B" comes before "b" but after "a". Also, * integers embedded in the strings compare in numerical order. In other * words, "x10y" comes after "x9y", not * before it as it would when * using strcmp(). * * Results: * A negative result means that the first element comes before the * second, and a positive result means that the second element should * come first. A result of zero means the two elements are equal and it * doesn't matter which comes first. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int DictionaryCompare( const char *left, const char *right) /* The strings to compare. */ { int uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower; int diff, zeros; int secondaryDiff = 0; while (1) { if (isdigit(UCHAR(*right)) /* INTL: digit */ && isdigit(UCHAR(*left))) { /* INTL: digit */ /* * There are decimal numbers embedded in the two strings. Compare * them as numbers, rather than strings. If one number has more * leading zeros than the other, the number with more leading * zeros sorts later, but only as a secondary choice. */ zeros = 0; while ((*right == '0') && isdigit(UCHAR(right[1]))) { right++; zeros--; } while ((*left == '0') && isdigit(UCHAR(left[1]))) { left++; zeros++; } if (secondaryDiff == 0) { secondaryDiff = zeros; } /* * The code below compares the numbers in the two strings without * ever converting them to integers. It does this by first * comparing the lengths of the numbers and then comparing the * digit values. */ diff = 0; while (1) { if (diff == 0) { diff = UCHAR(*left) - UCHAR(*right); } right++; left++; if (!isdigit(UCHAR(*right))) { /* INTL: digit */ if (isdigit(UCHAR(*left))) { /* INTL: digit */ return 1; } else { /* * The two numbers have the same length. See if their * values are different. */ if (diff != 0) { return diff; } break; } } else if (!isdigit(UCHAR(*left))) { /* INTL: digit */ return -1; } } continue; } /* * Convert character to Unicode for comparison purposes. If either * string is at the terminating null, do a byte-wise comparison and * bail out immediately. */ if ((*left != '\0') && (*right != '\0')) { left += TclUtfToUCS4(left, &uniLeft); right += TclUtfToUCS4(right, &uniRight); /* * Convert both chars to lower for the comparison, because * dictionary sorts are case-insensitive. Covert to lower, not * upper, so chars between Z and a will sort before A (where most * other interesting punctuations occur). */ uniLeftLower = TclUCS4ToLower(uniLeft); uniRightLower = TclUCS4ToLower(uniRight); } else { diff = UCHAR(*left) - UCHAR(*right); break; } diff = uniLeftLower - uniRightLower; if (diff) { return diff; } if (secondaryDiff == 0) { if (Tcl_UniCharIsUpper(uniLeft) && Tcl_UniCharIsLower(uniRight)) { secondaryDiff = -1; } else if (Tcl_UniCharIsUpper(uniRight) && Tcl_UniCharIsLower(uniLeft)) { secondaryDiff = 1; } } } if (diff == 0) { diff = secondaryDiff; } return diff; } /* *---------------------------------------------------------------------- * * SelectObjFromSublist -- * * This procedure is invoked from lsearch and SortCompare. It is used for * implementing the -index option, for the lsort and lsearch commands. * * Results: * Returns NULL if a failure occurs, and sets the result in the infoPtr. * Otherwise returns the Tcl_Obj* to the item. * * Side effects: * None. * * Note: * No reference counting is done, as the result is only used internally * and never passed directly to user code. * *---------------------------------------------------------------------- */ static Tcl_Obj * SelectObjFromSublist( Tcl_Obj *objPtr, /* Obj to select sublist from. */ SortInfo *infoPtr) /* Information passed from the top-level * "lsearch" or "lsort" command. */ { int i; /* * Quick check for case when no "-index" option is there. */ if (infoPtr->indexc == 0) { return objPtr; } /* * Iterate over the indices, traversing through the nested sublists as we * go. */ for (i=0 ; iindexc ; i++) { int listLen, index; Tcl_Obj *currentObj; if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) { infoPtr->resultCode = TCL_ERROR; return NULL; } index = TclIndexDecode(infoPtr->indexv[i], listLen - 1); if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index, ¤tObj) != TCL_OK) { infoPtr->resultCode = TCL_ERROR; return NULL; } if (currentObj == NULL) { Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( "element %d missing from sublist \"%s\"", index, TclGetString(objPtr))); Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", "INDEXFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return NULL; } objPtr = currentObj; } return objPtr; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ tcl8.6.14/generic/tclCmdMZ.c0000644000175000017500000042353414554262142015112 0ustar sergeisergei/* * tclCmdMZ.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters M to Z. It * contains only commands in the generic core (i.e. those that don't * depend much upon UNIX facilities). * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * Copyright (c) 2002 ActiveState Corporation. * Copyright (c) 2003-2009 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include "tclRegexp.h" #include "tclStringTrim.h" static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode, Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); static Tcl_NRPostProc SwitchPostProc; static Tcl_NRPostProc TryPostBody; static Tcl_NRPostProc TryPostFinal; static Tcl_NRPostProc TryPostHandler; static int UniCharIsAscii(int character); static int UniCharIsHexDigit(int character); /* * Default set of characters to trim in [string trim] and friends. This is a * UTF-8 literal string containing all Unicode space characters [TIP #413] */ const char tclDefaultTrimSet[] = "\x09\x0A\x0B\x0C\x0D " /* ASCII */ "\xC0\x80" /* nul (U+0000) */ "\xC2\x85" /* next line (U+0085) */ "\xC2\xA0" /* non-breaking space (U+00a0) */ "\xE1\x9A\x80" /* ogham space mark (U+1680) */ "\xE1\xA0\x8E" /* mongolian vowel separator (U+180e) */ "\xE2\x80\x80" /* en quad (U+2000) */ "\xE2\x80\x81" /* em quad (U+2001) */ "\xE2\x80\x82" /* en space (U+2002) */ "\xE2\x80\x83" /* em space (U+2003) */ "\xE2\x80\x84" /* three-per-em space (U+2004) */ "\xE2\x80\x85" /* four-per-em space (U+2005) */ "\xE2\x80\x86" /* six-per-em space (U+2006) */ "\xE2\x80\x87" /* figure space (U+2007) */ "\xE2\x80\x88" /* punctuation space (U+2008) */ "\xE2\x80\x89" /* thin space (U+2009) */ "\xE2\x80\x8A" /* hair space (U+200a) */ "\xE2\x80\x8B" /* zero width space (U+200b) */ "\xE2\x80\xA8" /* line separator (U+2028) */ "\xE2\x80\xA9" /* paragraph separator (U+2029) */ "\xE2\x80\xAF" /* narrow no-break space (U+202f) */ "\xE2\x81\x9F" /* medium mathematical space (U+205f) */ "\xE2\x81\xA0" /* word joiner (U+2060) */ "\xE3\x80\x80" /* ideographic space (U+3000) */ "\xEF\xBB\xBF" /* zero width no-break space (U+feff) */ ; /* *---------------------------------------------------------------------- * * Tcl_PwdObjCmd -- * * This procedure is invoked to process the "pwd" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_PwdObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *retVal; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } retVal = Tcl_FSGetCwd(interp); if (retVal == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, retVal); Tcl_DecrRefCount(retVal); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_RegexpObjCmd -- * * This procedure is invoked to process the "regexp" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_RegexpObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, indices, match, about, offset, all, doinline, numMatchesSaved; int cflags, eflags, stringLength, matchLength; Tcl_RegExp regExpr; Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; static const char *const options[] = { "-all", "-about", "-indices", "-inline", "-expanded", "-line", "-linestop", "-lineanchor", "-nocase", "-start", "--", NULL }; enum regexpoptions { REGEXP_ALL, REGEXP_ABOUT, REGEXP_INDICES, REGEXP_INLINE, REGEXP_EXPANDED,REGEXP_LINE, REGEXP_LINESTOP,REGEXP_LINEANCHOR, REGEXP_NOCASE, REGEXP_START, REGEXP_LAST }; indices = 0; about = 0; cflags = TCL_REG_ADVANCED; offset = 0; all = 0; doinline = 0; for (i = 1; i < objc; i++) { const char *name; int index; name = TclGetString(objv[i]); if (name[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { goto optionError; } switch ((enum regexpoptions) index) { case REGEXP_ALL: all = 1; break; case REGEXP_INDICES: indices = 1; break; case REGEXP_INLINE: doinline = 1; break; case REGEXP_NOCASE: cflags |= TCL_REG_NOCASE; break; case REGEXP_ABOUT: about = 1; break; case REGEXP_EXPANDED: cflags |= TCL_REG_EXPANDED; break; case REGEXP_LINE: cflags |= TCL_REG_NEWLINE; break; case REGEXP_LINESTOP: cflags |= TCL_REG_NLSTOP; break; case REGEXP_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGEXP_START: { int temp; if (++i >= objc) { goto endOfForLoop; } if (TclGetIntForIndexM(interp, objv[i], 0, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } startIndex = objv[i]; Tcl_IncrRefCount(startIndex); break; } case REGEXP_LAST: i++; goto endOfForLoop; } } endOfForLoop: if ((objc - i) < (2 - about)) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? exp string ?matchVar? ?subMatchVar ...?"); goto optionError; } objc -= i; objv += i; /* * Check if the user requested -inline, but specified match variables; a * no-no. */ if (doinline && ((objc - 2) != 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "regexp match variables not allowed when using -inline", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP", "MIX_VAR_INLINE", NULL); goto optionError; } /* * Handle the odd about case separately. */ if (about) { regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) { optionError: if (startIndex) { Tcl_DecrRefCount(startIndex); } return TCL_ERROR; } return TCL_OK; } /* * Get the length of the string that we are matching against so we can do * the termination test for -all matches. Do this before getting the * regexp to avoid shimmering problems. */ objPtr = objv[1]; stringLength = Tcl_GetCharLength(objPtr); if (startIndex) { TclGetIntForIndexM(NULL, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); if (offset < 0) { offset = 0; } } regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; } objc -= 2; objv += 2; if (doinline) { /* * Save all the subexpressions, as we will return them as a list */ numMatchesSaved = -1; } else { /* * Save only enough subexpressions for matches we want to keep, expect * in the case of -all, where we need to keep at least one to know * where to move the offset. */ numMatchesSaved = (objc == 0) ? all : objc; } /* * The following loop is to handle multiple matches within the same source * string; each iteration handles one match. If "-all" hasn't been * specified then the loop body only gets executed once. We terminate the * loop when the starting offset is past the end of the string. */ while (1) { /* * Pass either 0 or TCL_REG_NOTBOL in the eflags. Passing * TCL_REG_NOTBOL indicates that the character at offset should not be * considered the start of the line. If for example the pattern {^} is * passed and -start is positive, then the pattern will not match the * start of the string unless the previous character is a newline. */ if (offset == 0) { eflags = 0; } else if (offset > stringLength) { eflags = TCL_REG_NOTBOL; } else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') { eflags = 0; } else { eflags = TCL_REG_NOTBOL; } match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset, numMatchesSaved, eflags); if (match < 0) { return TCL_ERROR; } if (match == 0) { /* * We want to set the value of the interpreter result only when * this is the first time through the loop. */ if (all <= 1) { /* * If inlining, the interpreter's object result remains an * empty list, otherwise set it to an integer object w/ value * 0. */ if (!doinline) { Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } return TCL_OK; } break; } /* * If additional variable names have been specified, return index * information in those variables. */ Tcl_RegExpGetInfo(regExpr, &info); if (doinline) { /* * It's the number of substitutions, plus one for the matchVar at * index 0 */ objc = info.nsubs + 1; if (all <= 1) { TclNewObj(resultPtr); } } for (i = 0; i < objc; i++) { Tcl_Obj *newPtr; if (indices) { int start, end; Tcl_Obj *objs[2]; /* * Only adjust the match area if there was a match for that * area. (Scriptics Bug 4391/SF Bug #219232) */ if (i <= info.nsubs && info.matches[i].start >= 0) { start = offset + info.matches[i].start; end = offset + info.matches[i].end; /* * Adjust index so it refers to the last character in the * match instead of the first character after the match. */ if (end >= offset) { end--; } } else { start = -1; end = -1; } objs[0] = Tcl_NewLongObj(start); objs[1] = Tcl_NewLongObj(end); newPtr = Tcl_NewListObj(2, objs); } else { if ((i <= info.nsubs) && (info.matches[i].end > 0)) { newPtr = Tcl_GetRange(objPtr, offset + info.matches[i].start, offset + info.matches[i].end - 1); } else { TclNewObj(newPtr); } } if (doinline) { if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr) != TCL_OK) { Tcl_DecrRefCount(newPtr); Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } } else { if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } } } if (all == 0) { break; } /* * Adjust the offset to the character just after the last one in the * matchVar and increment all to count how many times we are making a * match. We always increment the offset by at least one to prevent * endless looping (as in the case: regexp -all {a*} a). Otherwise, * when we match the NULL string at the end of the input string, we * will loop indefinitely (because the length of the match is 0, so * offset never changes). */ matchLength = (info.matches[0].end - info.matches[0].start); offset += info.matches[0].end; /* * A match of length zero could happen for {^} {$} or {.*} and in * these cases we always want to bump the index up one. */ if (matchLength == 0) { offset++; } all++; if (offset >= stringLength) { break; } } /* * Set the interpreter's object result to an integer object with value 1 * if -all wasn't specified, otherwise it's all-1 (the number of times * through the while - 1). */ if (doinline) { Tcl_SetObjResult(interp, resultPtr); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_RegsubObjCmd -- * * This procedure is invoked to process the "regsub" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_RegsubObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int idx, result, cflags, all, wlen, wsublen, numMatches, offset; int start, end, subStart, subEnd, match; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend; static const char *const options[] = { "-all", "-nocase", "-expanded", "-line", "-linestop", "-lineanchor", "-start", "--", NULL }; enum options { REGSUB_ALL, REGSUB_NOCASE, REGSUB_EXPANDED, REGSUB_LINE, REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_START, REGSUB_LAST }; cflags = TCL_REG_ADVANCED; all = 0; offset = 0; resultPtr = NULL; for (idx = 1; idx < objc; idx++) { const char *name; int index; name = TclGetString(objv[idx]); if (name[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option", TCL_EXACT, &index) != TCL_OK) { goto optionError; } switch ((enum options) index) { case REGSUB_ALL: all = 1; break; case REGSUB_NOCASE: cflags |= TCL_REG_NOCASE; break; case REGSUB_EXPANDED: cflags |= TCL_REG_EXPANDED; break; case REGSUB_LINE: cflags |= TCL_REG_NEWLINE; break; case REGSUB_LINESTOP: cflags |= TCL_REG_NLSTOP; break; case REGSUB_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGSUB_START: { int temp; if (++idx >= objc) { goto endOfForLoop; } if (TclGetIntForIndexM(interp, objv[idx], 0, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } startIndex = objv[idx]; Tcl_IncrRefCount(startIndex); break; } case REGSUB_LAST: idx++; goto endOfForLoop; } } endOfForLoop: if (objc-idx < 3 || objc-idx > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? exp string subSpec ?varName?"); optionError: if (startIndex) { Tcl_DecrRefCount(startIndex); } return TCL_ERROR; } objc -= idx; objv += idx; if (startIndex) { int stringLength = Tcl_GetCharLength(objv[1]); TclGetIntForIndexM(NULL, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); if (offset < 0) { offset = 0; } } if (all && (offset == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { /* * This is a simple one pair string map situation. We make use of a * slightly modified version of the one pair STR_MAP code. */ int slen, nocase; int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); Tcl_UniChar *p, wsrclc; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); wend = wstring + wlen - (slen ? slen - 1 : 0); result = TCL_OK; if (slen == 0) { /* * regsub behavior for "" matches between each character. 'string * map' skips the "" case. */ if (wstring < wend) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); for (; wstring < wend; wstring++) { Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); Tcl_AppendUnicodeToObj(resultPtr, wstring, 1); numMatches++; } wlen = 0; } } else { wsrclc = Tcl_UniCharToLower(*wsrc); for (p = wfirstChar = wstring; wstring < wend; wstring++) { if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && (slen==1 || (strCmpFn(wstring, wsrc, (unsigned long) slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); } if (p != wstring) { Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p); p = wstring + slen; } else { p += slen; } wstring = p - 1; Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); numMatches++; } } if (numMatches) { wlen = wfirstChar + wlen - p; wstring = p; } } objPtr = NULL; subPtr = NULL; goto regsubDone; } regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; } /* * Make sure to avoid problems where the objects are shared. This can * cause RegExpObj <> UnicodeObj shimmering that causes data corruption. * [Bug #461322] */ if (objv[1] == objv[0]) { objPtr = Tcl_DuplicateObj(objv[1]); } else { objPtr = objv[1]; } wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); if (objv[2] == objv[0]) { subPtr = Tcl_DuplicateObj(objv[2]); } else { subPtr = objv[2]; } wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); result = TCL_OK; /* * The following loop is to handle multiple matches within the same source * string; each iteration handles one match and its corresponding * substitution. If "-all" hasn't been specified then the loop body only * gets executed once. We must use 'offset <= wlen' in particular for the * case where the regexp pattern can match the empty string - this is * useful when doing, say, 'regsub -- ^ $str ...' when $str might be * empty. */ numMatches = 0; for ( ; offset <= wlen; ) { /* * The flags argument is set if string is part of a larger string, so * that "^" won't match. */ match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset, 10 /* matches */, ((offset > 0 && (wstring[offset-1] != (Tcl_UniChar)'\n')) ? TCL_REG_NOTBOL : 0)); if (match < 0) { result = TCL_ERROR; goto done; } if (match == 0) { break; } if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); if (offset > 0) { /* * Copy the initial portion of the string in if an offset was * specified. */ Tcl_AppendUnicodeToObj(resultPtr, wstring, offset); } } numMatches++; /* * Copy the portion of the source string before the match to the * result variable. */ Tcl_RegExpGetInfo(regExpr, &info); start = info.matches[0].start; end = info.matches[0].end; Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start); /* * Append the subSpec argument to the variable, making appropriate * substitutions. This code is a bit hairy because of the backslash * conventions and because the code saves up ranges of characters in * subSpec to reduce the number of calls to Tcl_SetVar. */ wsrc = wfirstChar = wsubspec; wend = wsubspec + wsublen; for (ch = *wsrc; wsrc != wend; wsrc++, ch = *wsrc) { if (ch == '&') { idx = 0; } else if (ch == '\\') { ch = wsrc[1]; if ((ch >= '0') && (ch <= '9')) { idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar + 1); *wsrc = '\\'; wfirstChar = wsrc + 2; wsrc++; continue; } else { continue; } } else { continue; } if (wfirstChar != wsrc) { Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; if ((subStart >= 0) && (subEnd >= 0)) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } if (*wsrc == '\\') { wsrc++; } wfirstChar = wsrc + 1; } if (wfirstChar != wsrc) { Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (end == 0) { /* * Always consume at least one character of the input string in * order to prevent infinite loops. */ if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } else { offset += end; if (start == end) { /* * We matched an empty string, which means we must go forward * one more step so we don't match again at the same spot. */ if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } } if (!all) { break; } } /* * Copy the portion of the source string after the last match to the * result variable. */ regsubDone: if (numMatches == 0) { /* * On zero matches, just ignore the offset, since it shouldn't matter * to us in this case, and the user may have skewed it. */ resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (objc == 4) { if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } else { /* * Set the interpreter's object result to an integer object * holding the number of matches. */ Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches)); } } else { /* * No varname supplied, so just return the modified string. */ Tcl_SetObjResult(interp, resultPtr); } done: if (objPtr && (objv[1] == objv[0])) { Tcl_DecrRefCount(objPtr); } if (subPtr && (objv[2] == objv[0])) { Tcl_DecrRefCount(subPtr); } if (resultPtr) { Tcl_DecrRefCount(resultPtr); } return result; } /* *---------------------------------------------------------------------- * * Tcl_RenameObjCmd -- * * This procedure is invoked to process the "rename" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_RenameObjCmd( ClientData dummy, /* Arbitrary value passed to the command. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *oldName, *newName; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "oldName newName"); return TCL_ERROR; } oldName = TclGetString(objv[1]); newName = TclGetString(objv[2]); return TclRenameCommand(interp, oldName, newName); } /* *---------------------------------------------------------------------- * * Tcl_ReturnObjCmd -- * * This object-based procedure is invoked to process the "return" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ReturnObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int code, level; Tcl_Obj *returnOpts; /* * General syntax: [return ?-option value ...? ?result?] * An even number of words means an explicit result argument is present. */ int explicitResult = (0 == (objc % 2)); int numOptionWords = objc - 1 - explicitResult; if (TCL_ERROR == TclMergeReturnOptions(interp, numOptionWords, objv+1, &returnOpts, &code, &level)) { return TCL_ERROR; } code = TclProcessReturn(interp, code, level, returnOpts); if (explicitResult) { Tcl_SetObjResult(interp, objv[objc-1]); } return code; } /* *---------------------------------------------------------------------- * * Tcl_SourceObjCmd -- * * This procedure is invoked to process the "source" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_SourceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRSourceObjCmd, dummy, objc, objv); } int TclNRSourceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *encodingName = NULL; Tcl_Obj *fileName; if (objc != 2 && objc !=4) { Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName"); return TCL_ERROR; } fileName = objv[objc-1]; if (objc == 4) { static const char *const options[] = { "-encoding", NULL }; int index; if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options, "option", TCL_EXACT, &index)) { return TCL_ERROR; } encodingName = TclGetString(objv[2]); } return TclNREvalFile(interp, fileName, encodingName); } /* *---------------------------------------------------------------------- * * Tcl_SplitObjCmd -- * * This procedure is invoked to process the "split" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_SplitObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar ch = 0; int len; const char *splitChars; const char *stringPtr; const char *end; int splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; if (objc == 2) { splitChars = " \n\t\r"; splitCharLen = 4; } else if (objc == 3) { splitChars = TclGetStringFromObj(objv[2], &splitCharLen); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?"); return TCL_ERROR; } stringPtr = TclGetStringFromObj(objv[1], &stringLen); end = stringPtr + stringLen; TclNewObj(listPtr); if (stringLen == 0) { /* * Do nothing. */ } else if (splitCharLen == 0) { Tcl_HashTable charReuseTable; Tcl_HashEntry *hPtr; int isNew; /* * Handle the special case of splitting on every character. * * Uses a hash table to ensure that each kind of character has only * one Tcl_Obj instance (multiply-referenced) in the final list. This * is a *major* win when splitting on a long string (especially in the * megabyte range!) - DKF */ Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { int ucs4; len = TclUtfToUCS4(stringPtr, &ucs4); hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ucs4), &isNew); if (isNew) { TclNewStringObj(objPtr, stringPtr, len); /* * Don't need to fiddle with refcount... */ Tcl_SetHashValue(hPtr, objPtr); } else { objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); } Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } Tcl_DeleteHashTable(&charReuseTable); } else if (splitCharLen == 1) { const char *p; /* * Handle the special case of splitting on a single character. This is * only true for the one-char ASCII case, as one Unicode char is > 1 * byte in length. */ while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) { objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; } TclNewStringObj(objPtr, stringPtr, end - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; int splitLen; Tcl_UniChar splitChar = 0; /* * Normal case: split on any of a given set of characters. Discard * instances of the split characters. */ splitEnd = splitChars + splitCharLen; for (element = stringPtr; stringPtr < end; stringPtr += len) { len = TclUtfToUniChar(stringPtr, &ch); for (p = splitChars; p < splitEnd; p += splitLen) { splitLen = TclUtfToUniChar(p, &splitChar); if (ch == splitChar) { TclNewStringObj(objPtr, element, stringPtr - element); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); element = stringPtr + len; break; } } } TclNewStringObj(objPtr, element, stringPtr - element); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringFirstCmd -- * * This procedure is invoked to process the "string first" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringFirstCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *needleStr, *haystackStr; int match, start, needleLen, haystackLen; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "needleString haystackString ?startIndex?"); return TCL_ERROR; } /* * We are searching haystackStr for the sequence needleStr. */ match = -1; start = 0; haystackLen = -1; needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen); haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen); if (objc == 4) { /* * If a startIndex is specified, we will need to fast forward to that * point in the string before we think about a match. */ if (TclGetIntForIndexM(interp, objv[3], haystackLen-1, &start) != TCL_OK){ return TCL_ERROR; } /* * Reread to prevent shimmering problems. */ needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen); haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen); if (start >= haystackLen) { goto str_first_done; } else if (start > 0) { haystackStr += start; haystackLen -= start; } else if (start < 0) { /* * Invalid start index mapped to string start; Bug #423581 */ start = 0; } } /* * If the length of the needle is more than the length of the haystack, it * cannot be contained in there so we can avoid searching. [Bug 2960021] */ if (needleLen > 0 && needleLen <= haystackLen) { Tcl_UniChar *p, *end; end = haystackStr + haystackLen - needleLen + 1; for (p = haystackStr; p < end; p++) { /* * Scan forward to find the first character. */ if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p, needleLen) == 0)) { match = p - haystackStr; break; } } } /* * Compute the character index of the matching string by counting the * number of characters before the match. */ if ((match != -1) && (objc == 4)) { match += start; } str_first_done: Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringLastCmd -- * * This procedure is invoked to process the "string last" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringLastCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *needleStr, *haystackStr, *p; int match, start, needleLen, haystackLen; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "needleString haystackString ?startIndex?"); return TCL_ERROR; } /* * We are searching haystackString for the sequence needleString. */ match = -1; start = 0; haystackLen = -1; needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen); haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen); if (objc == 4) { /* * If a startIndex is specified, we will need to restrict the string * range to that char index in the string */ if (TclGetIntForIndexM(interp, objv[3], haystackLen-1, &start) != TCL_OK){ return TCL_ERROR; } /* * Reread to prevent shimmering problems. */ needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen); haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen); if (start < 0) { goto str_last_done; } else if (start < haystackLen) { p = haystackStr + start + 1 - needleLen; } else { p = haystackStr + haystackLen - needleLen; } } else { p = haystackStr + haystackLen - needleLen; } /* * If the length of the needle is more than the length of the haystack, it * cannot be contained in there so we can avoid searching. [Bug 2960021] */ if (needleLen > 0 && needleLen <= haystackLen) { for (; p >= haystackStr; p--) { /* * Scan backwards to find the first character. */ if ((*p == *needleStr) && !memcmp(needleStr, p, sizeof(Tcl_UniChar) * (size_t)needleLen)) { match = p - haystackStr; break; } } } str_last_done: Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringIndexCmd -- * * This procedure is invoked to process the "string index" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringIndexCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length, index; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string charIndex"); return TCL_ERROR; } /* * Get the char length to calculate what 'end' means. */ length = Tcl_GetCharLength(objv[1]); if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } if ((index >= 0) && (index < length)) { int ch = TclGetUCS4(objv[1], index); /* * If we have a ByteArray object, we're careful to generate a new * bytearray for a result. */ if (TclIsPureByteArray(objv[1])) { unsigned char uch = UCHAR(ch); Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1)); } else { char buf[8] = ""; length = TclUCS4ToUtf(ch, buf); Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length)); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * StringIsCmd -- * * This procedure is invoked to process the "string is" Tcl command. See * the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringIsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *end, *stop; int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ int i, failat = 0, result = 1, strict = 0, index, length1, length2; Tcl_Obj *objPtr, *failVarObj = NULL; Tcl_WideInt w; static const char *const isClasses[] = { "alnum", "alpha", "ascii", "control", "boolean", "digit", "double", "entier", "false", "graph", "integer", "list", "lower", "print", "punct", "space", "true", "upper", "wideinteger", "wordchar", "xdigit", NULL }; enum isClasses { STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL, STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT }; static const char *const isOptions[] = { "-strict", "-failindex", NULL }; enum isOptions { OPT_STRICT, OPT_FAILIDX }; if (objc < 3 || objc > 6) { Tcl_WrongNumArgs(interp, 1, objv, "class ?-strict? ?-failindex var? str"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0, &index) != TCL_OK) { return TCL_ERROR; } if (objc != 3) { for (i = 2; i < objc-1; i++) { int idx2; if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0, &idx2) != TCL_OK) { return TCL_ERROR; } switch ((enum isOptions) idx2) { case OPT_STRICT: strict = 1; break; case OPT_FAILIDX: if (i+1 >= objc-1) { Tcl_WrongNumArgs(interp, 2, objv, "?-strict? ?-failindex var? str"); return TCL_ERROR; } failVarObj = objv[++i]; break; } } } /* * We get the objPtr so that we can short-cut for some classes by checking * the object type (int and double), but we need the string otherwise, * because we don't want any conversion of type occurring (as, for example, * Tcl_Get*FromObj would do). */ objPtr = objv[objc-1]; /* * When entering here, result == 1 and failat == 0. */ switch ((enum isClasses) index) { case STR_IS_ALNUM: chcomp = Tcl_UniCharIsAlnum; break; case STR_IS_ALPHA: chcomp = Tcl_UniCharIsAlpha; break; case STR_IS_ASCII: chcomp = UniCharIsAscii; break; case STR_IS_BOOL: case STR_IS_TRUE: case STR_IS_FALSE: if ((objPtr->typePtr != &tclBooleanType) && (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) { if (strict) { result = 0; } else { string1 = TclGetStringFromObj(objPtr, &length1); result = length1 == 0; } } else if (((index == STR_IS_TRUE) && objPtr->internalRep.longValue == 0) || ((index == STR_IS_FALSE) && objPtr->internalRep.longValue != 0)) { result = 0; } break; case STR_IS_CONTROL: chcomp = Tcl_UniCharIsControl; break; case STR_IS_DIGIT: chcomp = Tcl_UniCharIsDigit; break; case STR_IS_DOUBLE: { if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || #ifndef TCL_WIDE_INT_IS_LONG (objPtr->typePtr == &tclWideIntType) || #endif (objPtr->typePtr == &tclBignumType)) { break; } string1 = TclGetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } goto str_is_done; } end = string1 + length1; if (TclParseNumber(NULL, objPtr, NULL, NULL, -1, (const char **) &stop, 0) != TCL_OK) { result = 0; failat = 0; } else { failat = stop - string1; if (stop < end) { result = 0; TclFreeIntRep(objPtr); } } break; } case STR_IS_GRAPH: chcomp = Tcl_UniCharIsGraph; break; case STR_IS_INT: if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) { break; } goto failedIntParse; case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || #ifndef TCL_WIDE_INT_IS_LONG (objPtr->typePtr == &tclWideIntType) || #endif (objPtr->typePtr == &tclBignumType)) { break; } string1 = TclGetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } goto str_is_done; } end = string1 + length1; if (TclParseNumber(NULL, objPtr, NULL, NULL, -1, (const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) { if (stop == end) { /* * Entire string parses as an integer. */ break; } else { /* * Some prefix parsed as an integer, but not the whole string, * so return failure index as the point where parsing stopped. * Clear out the internal rep, since keeping it would leave * *objPtr in an inconsistent state. */ result = 0; failat = stop - string1; TclFreeIntRep(objPtr); } } else { /* * No prefix is a valid integer. Fail at beginning. */ result = 0; failat = 0; } break; case STR_IS_WIDE: if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) { break; } failedIntParse: string1 = TclGetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } goto str_is_done; } result = 0; if (failVarObj == NULL) { /* * Don't bother computing the failure point if we're not going to * return it. */ break; } end = string1 + length1; if (TclParseNumber(NULL, objPtr, NULL, NULL, -1, (const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) { if (stop == end) { /* * Entire string parses as an integer, but rejected by * Tcl_Get(Wide)IntFromObj() so we must have overflowed the * target type, and our convention is to return failure at * index -1 in that situation. */ failat = -1; } else { /* * Some prefix parsed as an integer, but not the whole string, * so return failure index as the point where parsing stopped. * Clear out the internal rep, since keeping it would leave * *objPtr in an inconsistent state. */ failat = stop - string1; TclFreeIntRep(objPtr); } } else { /* * No prefix is a valid integer. Fail at beginning. */ failat = 0; } break; case STR_IS_LIST: /* * We ignore the strictness here, since empty strings are always * well-formed lists. */ if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) { break; } if (failVarObj != NULL) { /* * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; int lenRemain, elemSize; const char *p; string1 = TclGetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { if (TCL_ERROR == TclFindElement(NULL, p, lenRemain, &elemStart, &nextElem, &elemSize, NULL)) { Tcl_Obj *tmpStr; /* * This is the simplest way of getting the number of * characters parsed. Note that this is not the same as * the number of bytes when parsing strings with non-ASCII * characters in them. * * Skip leading spaces first. This is only really an issue * if it is the first "element" that has the failure. */ while (TclIsSpaceProcM(*p)) { p++; } TclNewStringObj(tmpStr, string1, p-string1); failat = Tcl_GetCharLength(tmpStr); TclDecrRefCount(tmpStr); break; } } } result = 0; break; case STR_IS_LOWER: chcomp = Tcl_UniCharIsLower; break; case STR_IS_PRINT: chcomp = Tcl_UniCharIsPrint; break; case STR_IS_PUNCT: chcomp = Tcl_UniCharIsPunct; break; case STR_IS_SPACE: chcomp = Tcl_UniCharIsSpace; break; case STR_IS_UPPER: chcomp = Tcl_UniCharIsUpper; break; case STR_IS_WORD: chcomp = Tcl_UniCharIsWordChar; break; case STR_IS_XDIGIT: chcomp = UniCharIsHexDigit; break; } if (chcomp != NULL) { string1 = TclGetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } goto str_is_done; } end = string1 + length1; for (; string1 < end; string1 += length2, failat++) { int ucs4; length2 = TclUtfToUCS4(string1, &ucs4); if (!chcomp(ucs4)) { result = 0; break; } } } /* * Only set the failVarObj when we will return 0 and we have indicated a * valid fail index (>= 0). */ str_is_done: if ((result == 0) && (failVarObj != NULL) && Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat), TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } static int UniCharIsAscii( int character) { return (character >= 0) && (character < 0x80); } static int UniCharIsHexDigit( int character) { return (character >= 0) && (character < 0x80) && isxdigit(character); } /* *---------------------------------------------------------------------- * * StringMapCmd -- * * This procedure is invoked to process the "string map" Tcl command. See * the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringMapCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length1, length2, mapElemc, index; int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); return TCL_ERROR; } if (objc == 4) { const char *string = TclGetStringFromObj(objv[1], &length2); if ((length2 > 1) && strncmp(string, "-nocase", length2) == 0) { nocase = 1; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": must be -nocase", string)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string, NULL); return TCL_ERROR; } } /* * This test is tricky, but has to be that way or you get other strange * inconsistencies (see test string-10.20 for illustration why!) */ if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){ int i, done; Tcl_DictSearch search; /* * We know the type exactly, so all dict operations will succeed for * sure. This shortens this code quite a bit. */ Tcl_DictObjSize(interp, objv[objc-2], &mapElemc); if (mapElemc == 0) { /* * Empty charMap, just return whatever string was given. */ Tcl_SetObjResult(interp, objv[objc-1]); return TCL_OK; } mapElemc *= 2; mapWithDict = 1; /* * Copy the dictionary out into an array; that's the easiest way to * adapt this code... */ mapElemv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc); Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0, mapElemv+1, &done); for (i=2 ; i30% faster on * larger strings. */ int mapLen; Tcl_UniChar *mapString, u2lc; ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if ((length2 > length1) || (length2 == 0)) { /* * Match string is either longer than input or empty. */ ustring1 = end; } else { mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, (unsigned long) length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen); } } } } else { Tcl_UniChar **mapStrings, *u2lc = NULL; int *mapLens; /* * Precompute pointers to the Unicode string and length. This saves us * repeated function calls later, significantly speeding up the * algorithm. We only need the lowercase first char in the nocase * case. */ mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *)); mapLens = (int *)TclStackAlloc(interp, mapElemc * 2 * sizeof(int)); if (nocase) { u2lc = (Tcl_UniChar *)TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar)); } for (index = 0; index < mapElemc; index++) { mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], mapLens+index); if (nocase && ((index % 2) == 0)) { u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]); } } for (p = ustring1; ustring1 < end; ustring1++) { for (index = 0; index < mapElemc; index += 2) { /* * Get the key string to match on. */ ustring2 = mapStrings[index]; length2 = mapLens[index]; if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ (end-ustring1 >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. */ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } /* * Adjust len to be full length of matched string. */ ustring1 = p - 1; /* * Append the map value to the Unicode string. */ Tcl_AppendUnicodeToObj(resultPtr, mapStrings[index+1], mapLens[index+1]); break; } } } if (nocase) { TclStackFree(interp, u2lc); } TclStackFree(interp, mapLens); TclStackFree(interp, mapStrings); } if (p != ustring1) { /* * Put the rest of the unmapped chars onto result. */ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); } Tcl_SetObjResult(interp, resultPtr); done: if (mapWithDict) { TclStackFree(interp, mapElemv); } if (copySource) { Tcl_DecrRefCount(sourceObj); } return TCL_OK; } /* *---------------------------------------------------------------------- * * StringMatchCmd -- * * This procedure is invoked to process the "string match" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringMatchCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int nocase = 0; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string"); return TCL_ERROR; } if (objc == 4) { int length; const char *string = TclGetStringFromObj(objv[1], &length); if ((length > 1) && strncmp(string, "-nocase", length) == 0) { nocase = TCL_MATCH_NOCASE; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": must be -nocase", string)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string, NULL); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewBooleanObj( TclStringMatchObj(objv[objc-1], objv[objc-2], nocase))); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringRangeCmd -- * * This procedure is invoked to process the "string range" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringRangeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length, first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string first last"); return TCL_ERROR; } /* * Get the length in actual characters; Then reduce it by one because * 'end' refers to the last character, not one past it. */ length = Tcl_GetCharLength(objv[1]) - 1; if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK || TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) { return TCL_ERROR; } if (first < 0) { first = 0; } if (last >= length) { last = length; } if (last >= first) { Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * StringReptCmd -- * * This procedure is invoked to process the "string repeat" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringReptCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1; char *string2; int count, index, length1, length2; Tcl_Obj *resultPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string count"); return TCL_ERROR; } if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) { return TCL_ERROR; } /* * Check for cases that allow us to skip copying stuff. */ if (count == 1) { Tcl_SetObjResult(interp, objv[1]); goto done; } else if (count < 1) { goto done; } string1 = TclGetStringFromObj(objv[1], &length1); if (length1 <= 0) { goto done; } /* * Only build up a string that has data. Instead of building it up with * repeated appends, we just allocate the necessary space once and copy * the string value in. * * We have to worry about overflow [Bugs 714106, 2561746]. * At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX. * We need to keep 2 <= length2 <= INT_MAX. */ if (count > INT_MAX/length1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "result exceeds max size for a Tcl value (%d bytes)", INT_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } length2 = length1 * count; /* * Include space for the NUL. */ string2 = (char *)attemptckalloc(length2 + 1); if (string2 == NULL) { /* * Alloc failed. Note that in this case we try to do an error message * since this is a case that's most likely when the alloc is large and * that's easy to do with this API. Note that if we fail allocating a * short string, this will likely keel over too (and fatally). */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "string size overflow, out of memory allocating %u bytes", length2 + 1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } for (index = 0; index < count; index++) { memcpy(string2 + (length1 * index), string1, length1); } string2[length2] = '\0'; /* * We have to directly assign this instead of using Tcl_SetStringObj (and * indirectly TclInitStringRep) because that makes another copy of the * data. */ TclNewObj(resultPtr); resultPtr->bytes = string2; resultPtr->length = length2; Tcl_SetObjResult(interp, resultPtr); done: return TCL_OK; } /* *---------------------------------------------------------------------- * * StringRplcCmd -- * * This procedure is invoked to process the "string replace" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringRplcCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *ustring; int first, last, length, end; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?"); return TCL_ERROR; } ustring = Tcl_GetUnicodeFromObj(objv[1], &length); end = length - 1; if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){ return TCL_ERROR; } /* * The following test screens out most empty substrings as * candidates for replacement. When they are detected, no * replacement is done, and the result is the original string, */ if ((last < 0) || /* Range ends before start of string */ (first > end) || /* Range begins after end of string */ (last < first)) { /* Range begins after it starts */ /* * BUT!!! when (end < 0) -- an empty original string -- we can * have (first <= end < 0 <= last) and an empty string is permitted * to be replaced. */ Tcl_SetObjResult(interp, objv[1]); } else { Tcl_Obj *resultPtr; /* * We are re-fetching in case the string argument is same value as * an index argument, and shimmering cost us our ustring. */ ustring = Tcl_GetUnicodeFromObj(objv[1], &length); end = length-1; if (first < 0) { first = 0; } resultPtr = Tcl_NewUnicodeObj(ustring, first); if (objc == 5) { Tcl_AppendObjToObj(resultPtr, objv[4]); } if (last < end) { Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1, end - last); } Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * StringRevCmd -- * * This procedure is invoked to process the "string reverse" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringRevCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } Tcl_SetObjResult(interp, TclStringReverse(objv[1])); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringStartCmd -- * * This procedure is invoked to process the "string wordstart" Tcl * command. See the user documentation for details on what it does. Note * that this command only functions correctly on properly formed Tcl UTF * strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringStartCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar ch = 0; const char *p, *string; int cur, index, length, numChars; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); numChars = Tcl_NumUtfChars(string, length); if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) { return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); if (index >= numChars) { index = numChars - 1; } cur = 0; if (index > 0) { p = Tcl_UtfAtIndex(string, index); TclUtfToUniChar(p, &ch); for (cur = index; cur >= 0; cur--) { int delta = 0; const char *next; if (!Tcl_UniCharIsWordChar(ch)) { break; } next = TclUtfPrev(p, string); do { next += delta; delta = TclUtfToUniChar(next, &ch); } while (next + delta < p); p = next; } if (cur != index) { cur += 1; } } Tcl_SetObjResult(interp, Tcl_NewIntObj(cur)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringEndCmd -- * * This procedure is invoked to process the "string wordend" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringEndCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar ch = 0; const char *p, *end, *string; int cur, index, length, numChars; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); numChars = Tcl_NumUtfChars(string, length); if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) { return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); if (index < 0) { index = 0; } if (index < numChars) { p = Tcl_UtfAtIndex(string, index); end = string+length; for (cur = index; p < end; cur++) { p += TclUtfToUniChar(p, &ch); if (!Tcl_UniCharIsWordChar(ch)) { break; } } if (cur == index) { cur++; } } else { cur = numChars; } Tcl_SetObjResult(interp, Tcl_NewIntObj(cur)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringEqualCmd -- * * This procedure is invoked to process the "string equal" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringEqualCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { /* * Remember to keep code here in some sync with the byte-compiled versions * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ const char *string2; int length2, i, match, nocase = 0, reqlength = -1; if (objc < 3 || objc > 6) { str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? ?-length int? string1 string2"); return TCL_ERROR; } for (i = 1; i < objc-2; i++) { string2 = TclGetStringFromObj(objv[i], &length2); if ((length2 > 1) && !strncmp(string2, "-nocase", length2)) { nocase = 1; } else if ((length2 > 1) && !strncmp(string2, "-length", length2)) { if (i+1 >= objc-2) { goto str_cmp_args; } i++; if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { return TCL_ERROR; } } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": must be -nocase or -length", string2)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string2, NULL); return TCL_ERROR; } } /* * From now on, we only access the two objects at the end of the argument * array. */ objv += objc-2; match = TclStringCmp(objv[0], objv[1], 1, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringCmpCmd -- * * This procedure is invoked to process the "string compare" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringCmpCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { /* * Remember to keep code here in some sync with the byte-compiled versions * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ int match, nocase, reqlength, status; status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength); if (status != TCL_OK) { return status; } objv += objc-2; match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclStringCmp -- * * This is the core of Tcl's string comparison. It only handles byte * arrays, UNICODE strings and UTF-8 strings correctly. * * Results: * -1 if value1Ptr is less than value2Ptr, 0 if they are equal, or 1 if * value1Ptr is greater. * * Side effects: * May cause string representations of objects to be allocated. * *---------------------------------------------------------------------- */ int TclStringCmp( Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ int reqlength) /* requested length in characters; -1 to * compare whole strings */ { const char *s1, *s2; int empty, length, match, s1len, s2len; memCmpFn_t memCmpFn; if ((reqlength == 0) || (value1Ptr == value2Ptr)) { /* * Always match at 0 chars or if it is the same obj. */ return 0; } if (!nocase && TclIsPureByteArray(value1Ptr) && TclIsPureByteArray(value2Ptr)) { /* * Use binary versions of comparisons since that won't cause undue * type conversions and it is much faster. Only do this if we're * case-sensitive (which is all that really makes sense with byte * arrays anyway, and we have no memcasecmp() for some reason... :^) */ s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; } else if ((value1Ptr->typePtr == &tclStringType) && (value2Ptr->typePtr == &tclStringType)) { /* * Do a Unicode-specific comparison if both of the args are of String * type. If the char length == byte length, we can do a memcmp. In * benchmark testing this proved the most efficient check between the * Unicode and string comparison operations. */ if (nocase) { s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); memCmpFn = TclUniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); if ((s1len == value1Ptr->length) && (value1Ptr->bytes != NULL) && (s2len == value2Ptr->length) && (value2Ptr->bytes != NULL)) { /* each byte represents one character so s1l3n, s2l3n, and * reqlength are in both bytes and characters */ s1 = value1Ptr->bytes; s2 = value2Ptr->bytes; memCmpFn = memcmp; } else { s1 = (char *) Tcl_GetUnicode(value1Ptr); s2 = (char *) Tcl_GetUnicode(value2Ptr); if ( #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX != 4) 1 #else checkEq #endif /* WORDS_BIGENDIAN */ ) { memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); if (reqlength > 0) { reqlength *= sizeof(Tcl_UniChar); } } else { memCmpFn = TclUniCharNcmp; } } } } else { /* * Get the string representations, being careful in case we have * special empty string objects about. */ empty = TclCheckEmptyString(value1Ptr); if (empty > 0) { switch (TclCheckEmptyString(value2Ptr)) { case -1: s1 = ""; s1len = 0; s2 = TclGetStringFromObj(value2Ptr, &s2len); break; case 0: return -1; default: /* avoid warn: `s2` may be used uninitialized */ return 0; } } else if (TclCheckEmptyString(value2Ptr) > 0) { switch (empty) { case -1: s2 = ""; s2len = 0; s1 = TclGetStringFromObj(value1Ptr, &s1len); break; case 0: return 1; default: /* avoid warn: `s1` may be used uninitialized */ return 0; } } else { s1 = TclGetStringFromObj(value1Ptr, &s1len); s2 = TclGetStringFromObj(value2Ptr, &s2len); } if (!nocase && checkEq && reqlength < 0) { /* * When we have equal-length we can check only for (in)equality. * We can use memcmp() in all (n)eq cases because we don't need to * worry about lexical LE/BE variance. */ memCmpFn = memcmp; } else { /* * As a catch-all we will work with UTF-8. We cannot use memcmp() * as that is unsafe with any string containing NUL (\xC0\x80 in * Tcl's utf rep). We can use the more efficient TclUtfNcmp if * we are case-sensitive and no specific length was requested. */ if ((reqlength < 0) && !nocase) { memCmpFn = TclUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); s2len = Tcl_NumUtfChars(s2, s2len); memCmpFn = nocase ? TclUtfNcasecmp : TclUtfNcmp; } } } /* At this point s1len, s2len, and reqlength should by now have been * adjusted so that they are all in the units expected by the selected * comparison function. */ length = (s1len < s2len) ? s1len : s2len; if (reqlength > 0 && reqlength < length) { length = reqlength; } else if (reqlength < 0) { /* * The requested length is negative, so ignore it by setting it to * length + 1 to correct the match var. */ reqlength = length + 1; } if (checkEq && reqlength < 0 && (s1len != s2len)) { match = 1; /* This will be reversed below. */ } else { /* * The comparison function should compare up to the minimum byte * length only. */ match = memCmpFn(s1, s2, length); } if ((match == 0) && (reqlength > length)) { match = s1len - s2len; } return (match > 0) ? 1 : (match < 0) ? -1 : 0; } int TclStringCmpOpts( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, int *reqlength) { int i, length; const char *string; *reqlength = -1; *nocase = 0; if (objc < 3 || objc > 6) { str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? ?-length int? string1 string2"); return TCL_ERROR; } for (i = 1; i < objc-2; i++) { string = TclGetStringFromObj(objv[i], &length); if ((length > 1) && !strncmp(string, "-nocase", length)) { *nocase = 1; } else if ((length > 1) && !strncmp(string, "-length", length)) { if (i+1 >= objc-2) { goto str_cmp_args; } i++; if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) { return TCL_ERROR; } } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": must be -nocase or -length", string)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string, NULL); return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * StringCatCmd -- * * This procedure is invoked to process the "string cat" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringCatCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i; Tcl_Obj *objResultPtr; if (objc < 2) { /* * If there are no args, the result is an empty object. * Just leave the preset empty interp result. */ return TCL_OK; } if (objc == 2) { /* * Other trivial case, single arg, just return it. */ Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } objResultPtr = objv[1]; if (Tcl_IsShared(objResultPtr)) { objResultPtr = Tcl_DuplicateObj(objResultPtr); } for(i = 2;i < objc;i++) { Tcl_AppendObjToObj(objResultPtr, objv[i]); } Tcl_SetObjResult(interp, objResultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringBytesCmd -- * * This procedure is invoked to process the "string bytelength" Tcl * command. See the user documentation for details on what it does. Note * that this command only functions correctly on properly formed Tcl UTF * strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringBytesCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } (void) TclGetStringFromObj(objv[1], &length); Tcl_SetObjResult(interp, Tcl_NewIntObj(length)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringLenCmd -- * * This procedure is invoked to process the "string length" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringLenCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1]))); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringLowerCmd -- * * This procedure is invoked to process the "string tolower" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringLowerCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToLower(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { int first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } if (last >= length1) { last = length1; } if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = TclGetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToLower(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * StringUpperCmd -- * * This procedure is invoked to process the "string toupper" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringUpperCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToUpper(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { int first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } if (last >= length1) { last = length1; } if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = TclGetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToUpper(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * StringTitleCmd -- * * This procedure is invoked to process the "string totitle" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringTitleCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToTitle(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { int first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } if (last >= length1) { last = length1; } if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = TclGetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToTitle(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * StringTrimCmd -- * * This procedure is invoked to process the "string trim" Tcl command. * See the user documentation for details on what it does. Note that this * command only functions correctly on properly formed Tcl UTF strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringTrimCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int triml, trimr, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); triml = TclTrim(string1, length1, string2, length2, &trimr); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1 + triml, length1 - triml - trimr)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringTrimLCmd -- * * This procedure is invoked to process the "string trimleft" Tcl * command. See the user documentation for details on what it does. Note * that this command only functions correctly on properly formed Tcl UTF * strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringTrimLCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); trim = TclTrimLeft(string1, length1, string2, length2); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringTrimRCmd -- * * This procedure is invoked to process the "string trimright" Tcl * command. See the user documentation for details on what it does. Note * that this command only functions correctly on properly formed Tcl UTF * strings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int StringTrimRCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); trim = TclTrimRight(string1, length1, string2, length2); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclInitStringCmd -- * * This procedure creates the "string" Tcl command. See the user * documentation for details on what it does. Note that this command only * functions correctly on properly formed Tcl UTF strings. * * Also note that the primary methods here (equal, compare, match, ...) * have bytecode equivalents. You will find the code for those in * tclExecute.c. The code here will only be used in the non-bc case (like * in an 'eval'). * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ Tcl_Command TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0}, {"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0}, {"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0}, {"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0}, {"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0}, {"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0}, {"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0}, {"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0}, {"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0}, {"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"tolower", StringLowerCmd, TclCompileStringToLowerCmd, NULL, NULL, 0}, {"toupper", StringUpperCmd, TclCompileStringToUpperCmd, NULL, NULL, 0}, {"totitle", StringTitleCmd, TclCompileStringToTitleCmd, NULL, NULL, 0}, {"trim", StringTrimCmd, TclCompileStringTrimCmd, NULL, NULL, 0}, {"trimleft", StringTrimLCmd, TclCompileStringTrimLCmd, NULL, NULL, 0}, {"trimright", StringTrimRCmd, TclCompileStringTrimRCmd, NULL, NULL, 0}, {"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "string", stringImplMap); } /* *---------------------------------------------------------------------- * * Tcl_SubstObjCmd -- * * This procedure is invoked to process the "subst" Tcl command. See the * user documentation for details on what it does. This command relies on * Tcl_SubstObj() for its implementation. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int TclSubstOptions( Tcl_Interp *interp, int numOpts, Tcl_Obj *const opts[], int *flagPtr) { static const char *const substOptions[] = { "-nobackslashes", "-nocommands", "-novariables", NULL }; enum { SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS }; int i, flags = TCL_SUBST_ALL; for (i = 0; i < numOpts; i++) { int optionIndex; if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch (optionIndex) { case SUBST_NOBACKSLASHES: flags &= ~TCL_SUBST_BACKSLASHES; break; case SUBST_NOCOMMANDS: flags &= ~TCL_SUBST_COMMANDS; break; case SUBST_NOVARS: flags &= ~TCL_SUBST_VARIABLES; break; default: Tcl_Panic("Tcl_SubstObjCmd: bad option index to SubstOptions"); } } *flagPtr = flags; return TCL_OK; } int Tcl_SubstObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRSubstObjCmd, dummy, objc, objv); } int TclNRSubstObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int flags; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?-nobackslashes? ?-nocommands? ?-novariables? string"); return TCL_ERROR; } if (TclSubstOptions(interp, objc-2, objv+1, &flags) != TCL_OK) { return TCL_ERROR; } return Tcl_NRSubstObj(interp, objv[objc-1], flags); } /* *---------------------------------------------------------------------- * * Tcl_SwitchObjCmd -- * * This object-based procedure is invoked to process the "switch" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_SwitchObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRSwitchObjCmd, dummy, objc, objv); } int TclNRSwitchObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i,j, index, mode, foundmode, splitObjs, numMatchesSaved; int noCase, patternLength; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; Tcl_RegExp regExpr = NULL; Interp *iPtr = (Interp *) interp; int pc = 0; int bidx = 0; /* Index of body argument. */ Tcl_Obj *blist = NULL; /* List obj which is the body */ CmdFrame *ctxPtr; /* Copy of the topmost cmdframe, to allow us * to mess with the line information */ /* * If you add options that make -e and -g not unique prefixes of -exact or * -glob, you *must* fix TclCompileSwitchCmd's option parser as well. */ static const char *const options[] = { "-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp", "--", NULL }; enum options { OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP, OPT_LAST }; typedef int (*strCmpFn_t)(const char *, const char *); strCmpFn_t strCmpFn = strcmp; mode = OPT_EXACT; foundmode = 0; indexVarObj = NULL; matchVarObj = NULL; numMatchesSaved = 0; noCase = 0; for (i = 1; i < objc-2; i++) { if (TclGetString(objv[i])[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { /* * General options. */ case OPT_LAST: i++; goto finishedOptions; case OPT_NOCASE: strCmpFn = TclUtfCasecmp; noCase = 1; break; /* * Handle the different switch mode options. */ default: if (foundmode) { /* * Mode already set via -exact, -glob, or -regexp. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": %s option already found", TclGetString(objv[i]), options[mode])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "DOUBLEOPT", NULL); return TCL_ERROR; } foundmode = 1; mode = index; break; /* * Check for TIP#75 options specifying the variables to write * regexp information into. */ case OPT_INDEXV: i++; if (i >= objc-2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "missing variable name argument to %s option", "-indexvar")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "NOVAR", NULL); return TCL_ERROR; } indexVarObj = objv[i]; numMatchesSaved = -1; break; case OPT_MATCHV: i++; if (i >= objc-2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "missing variable name argument to %s option", "-matchvar")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "NOVAR", NULL); return TCL_ERROR; } matchVarObj = objv[i]; numMatchesSaved = -1; break; } } finishedOptions: if (objc - i < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? string ?pattern body ...? ?default body?"); return TCL_ERROR; } if (indexVarObj != NULL && mode != OPT_REGEXP) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s option requires -regexp option", "-indexvar")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "MODERESTRICTION", NULL); return TCL_ERROR; } if (matchVarObj != NULL && mode != OPT_REGEXP) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s option requires -regexp option", "-matchvar")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "MODERESTRICTION", NULL); return TCL_ERROR; } stringObj = objv[i]; objc -= i + 1; objv += i + 1; bidx = i + 1; /* First after the match string. */ /* * If all of the pattern/command pairs are lumped into a single argument, * split them out again. * * TIP #280: Determine the lines the words in the list start at, based on * the same data for the list word itself. The cmdFramePtr line * information is manipulated directly. */ splitObjs = 0; if (objc == 1) { Tcl_Obj **listv; blist = objv[0]; if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){ return TCL_ERROR; } /* * Ensure that the list is non-empty. */ if (objc < 1) { Tcl_WrongNumArgs(interp, 1, savedObjv, "?-option ...? string {?pattern body ...? ?default body?}"); return TCL_ERROR; } objv = listv; splitObjs = 1; } /* * Complain if there is an odd number of words in the list of patterns and * bodies. */ if (objc % 2) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( "extra switch pattern with no body", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", NULL); /* * Check if this can be due to a badly placed comment in the switch * block. * * The following is an heuristic to detect the infamous "comment in * switch" error: just check if a pattern begins with '#'. */ if (splitObjs) { for (i=0 ; i 0) { rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1); } else { TclNewIntObj(rangeObjAry[1], -1); rangeObjAry[0] = rangeObjAry[1]; } /* * Never fails; the object is always clean at this point. */ Tcl_ListObjAppendElement(NULL, indicesObj, Tcl_NewListObj(2, rangeObjAry)); } if (matchVarObj != NULL) { Tcl_Obj *substringObj; if (info.matches[j].end > 0) { substringObj = Tcl_GetRange(stringObj, info.matches[j].start, info.matches[j].end-1); } else { TclNewObj(substringObj); } /* * Never fails; the object is always clean at this point. */ Tcl_ListObjAppendElement(NULL, matchesObj, substringObj); } } if (indexVarObj != NULL) { if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj, TCL_LEAVE_ERR_MSG) == NULL) { /* * Careful! Check to see if we have allocated the list of * matched strings; if so (but there was an error assigning * the indices list) we have a potential memory leak because * the match list has not been written to a variable. Except * that we'll clean that up right now. */ if (matchesObj != NULL) { Tcl_DecrRefCount(matchesObj); } return TCL_ERROR; } } if (matchVarObj != NULL) { if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj, TCL_LEAVE_ERR_MSG) == NULL) { /* * Unlike above, if indicesObj is non-NULL at this point, it * will have been written to a variable already and will hence * not be leaked. */ return TCL_ERROR; } } } /* * We've got a match. Find a body to execute, skipping bodies that are * "-". */ matchFound: ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *ctxPtr = *iPtr->cmdFramePtr; if (splitObjs) { /* * We have to perform the GetSrc and other type dependent handling of * the frame here because we are munging with the line numbers, * something the other commands like if, etc. are not doing. Them are * fine with simply passing the CmdFrame through and having the * special handling done in 'info frame', or the bc compiler */ if (ctxPtr->type == TCL_LOCATION_BC) { /* * Type BC => ctxPtr->data.eval.path is not used. * ctxPtr->data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc(ctxPtr); pc = 1; /* * The line information in the cmdFrame is now a copy we do not * own. */ } if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) { int bline = ctxPtr->line[bidx]; ctxPtr->line = (int *)ckalloc(objc * sizeof(int)); ctxPtr->nline = objc; TclListLines(blist, bline, objc, ctxPtr->line, objv); } else { /* * This is either a dynamic code word, when all elements are * relative to themselves, or something else less expected and * where we have no information. The result is the same in both * cases; tell the code to come that it doesn't know where it is, * which triggers reversion to the old behavior. */ int k; ctxPtr->line = (int *)ckalloc(objc * sizeof(int)); ctxPtr->nline = objc; for (k=0; k < objc; k++) { ctxPtr->line[k] = -1; } } } for (j = i + 1; ; j += 2) { if (j >= objc) { /* * This shouldn't happen since we've checked that the last body is * not a continuation... */ Tcl_Panic("fall-out when searching for body to match pattern"); } if (strcmp(TclGetString(objv[j]), "-") != 0) { break; } } /* * TIP #280: Make invoking context available to switch branch. */ Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr, INT2PTR(pc), (ClientData) pattern); return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j); } static int SwitchPostProc( ClientData data[], /* Data passed from Tcl_NRAddCallback above */ Tcl_Interp *interp, /* Tcl interpreter */ int result) /* Result to return*/ { /* Unpack the preserved data */ int splitObjs = PTR2INT(data[0]); CmdFrame *ctxPtr = (CmdFrame *)data[1]; int pc = PTR2INT(data[2]); const char *pattern = (const char *)data[3]; int patternLength = strlen(pattern); /* * Clean up TIP 280 context information */ if (splitObjs) { ckfree(ctxPtr->line); if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { /* * Death of SrcInfo reference. */ Tcl_DecrRefCount(ctxPtr->data.eval.path); } } /* * Generate an error message if necessary. */ if (result == TCL_ERROR) { int limit = 50; int overflow = (patternLength > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", (overflow ? limit : patternLength), pattern, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } TclStackFree(interp, ctxPtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_ThrowObjCmd -- * * This procedure is invoked to process the "throw" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_ThrowObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *options; int len; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "type message"); return TCL_ERROR; } /* * The type must be a list of at least length 1. */ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { return TCL_ERROR; } else if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "type must be non-empty list", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION", NULL); return TCL_ERROR; } /* * Now prepare the result options dictionary. We use the list API as it is * slightly more convenient. */ TclNewLiteralStringObj(options, "-code error -level 0 -errorcode"); Tcl_ListObjAppendElement(NULL, options, objv[1]); /* * We're ready to go. Fire things into the low-level result machinery. */ Tcl_SetObjResult(interp, objv[2]); return Tcl_SetReturnOptions(interp, options); } /* *---------------------------------------------------------------------- * * Tcl_TimeObjCmd -- * * This object-based procedure is invoked to process the "time" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_TimeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *objPtr; Tcl_Obj *objs[4]; int i, result; int count; double totalMicroSec; #ifndef TCL_WIDE_CLICKS Tcl_Time start, stop; #else Tcl_WideInt start, stop; #endif if (objc == 2) { count = 1; } else if (objc == 3) { result = TclGetIntFromObj(interp, objv[2], &count); if (result != TCL_OK) { return result; } } else { Tcl_WrongNumArgs(interp, 1, objv, "command ?count?"); return TCL_ERROR; } objPtr = objv[1]; i = count; #ifndef TCL_WIDE_CLICKS Tcl_GetTime(&start); #else start = TclpGetWideClicks(); #endif while (i-- > 0) { result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); if (result != TCL_OK) { return result; } } #ifndef TCL_WIDE_CLICKS Tcl_GetTime(&stop); totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6 + (stop.usec - start.usec); #else stop = TclpGetWideClicks(); totalMicroSec = ((double) TclpWideClicksToNanoseconds(stop - start))/1.0e3; #endif if (count <= 1) { /* * Use int obj since we know time is not fractional. [Bug 1202178] */ objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec); } else { objs[0] = Tcl_NewDoubleObj(totalMicroSec/count); } /* * Construct the result as a list because many programs have always parsed * as such (extracting the first element, typically). */ TclNewLiteralStringObj(objs[1], "microseconds"); TclNewLiteralStringObj(objs[2], "per"); TclNewLiteralStringObj(objs[3], "iteration"); Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_TimeRateObjCmd -- * * This object-based procedure is invoked to process the "timerate" Tcl * command. * * This is similar to command "time", except the execution limited by * given time (in milliseconds) instead of repetition count. * * Example: * timerate {after 5} 1000; # equivalent to: time {after 5} [expr 1000/5] * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_TimeRateObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static double measureOverhead = 0; /* global measure-overhead */ double overhead = -1; /* given measure-overhead */ Tcl_Obj *objPtr; int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; TclWideMUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ TclWideMUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ TclWideMUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max * threshold, additionally avoiding divide to * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid * growth of execution time. */ Tcl_WideInt start, middle, stop; #ifndef TCL_WIDE_CLICKS Tcl_Time now; #endif /* !TCL_WIDE_CLICKS */ static const char *const options[] = { "-direct", "-overhead", "-calibrate", "--", NULL }; enum options { TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST }; NRE_callback *rootPtr; ByteCode *codePtr = NULL; for (i = 1; i < objc - 1; i++) { int index; if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { break; } if (index == TMRT_LAST) { i++; break; } switch (index) { case TMRT_EV_DIRECT: direct = objv[i]; break; case TMRT_OVERHEAD: if (++i >= objc - 1) { goto usage; } if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) { return TCL_ERROR; } break; case TMRT_CALIBRATE: calibrate = objv[i]; break; } } if (i >= objc || i < objc - 3) { usage: Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? " "command ?time ?max-count??"); return TCL_ERROR; } objPtr = objv[i++]; if (i < objc) { /* max-time */ result = Tcl_GetWideIntFromObj(interp, objv[i++], &maxms); if (result != TCL_OK) { return result; } if (i < objc) { /* max-count*/ Tcl_WideInt v; result = Tcl_GetWideIntFromObj(interp, objv[i], &v); if (result != TCL_OK) { return result; } maxcnt = (v > 0) ? v : 0; } } /* * If we are doing calibration. */ if (calibrate) { /* * If no time specified for the calibration. */ if (maxms == WIDE_MIN) { Tcl_Obj *clobjv[6]; Tcl_WideInt maxCalTime = 5000; double lastMeasureOverhead = measureOverhead; clobjv[0] = objv[0]; i = 1; if (direct) { clobjv[i++] = direct; } clobjv[i++] = objPtr; /* * Reset last measurement overhead. */ measureOverhead = (double) 0; /* * Self-call with 100 milliseconds to warm-up, before entering the * calibration cycle. */ TclNewLongObj(clobjv[i], 100); Tcl_IncrRefCount(clobjv[i]); result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv); Tcl_DecrRefCount(clobjv[i]); if (result != TCL_OK) { return result; } i--; clobjv[i++] = calibrate; clobjv[i++] = objPtr; /* * Set last measurement overhead to max. */ measureOverhead = (double) UWIDE_MAX; /* * Run the calibration cycle until it is more precise. */ maxms = -1000; do { lastMeasureOverhead = measureOverhead; TclNewLongObj(clobjv[i], (int) maxms); Tcl_IncrRefCount(clobjv[i]); result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv); Tcl_DecrRefCount(clobjv[i]); if (result != TCL_OK) { return result; } maxCalTime += maxms; /* * Increase maxms for more precise calibration. */ maxms -= -maxms / 4; /* * As long as new value more as 0.05% better */ } while ((measureOverhead >= lastMeasureOverhead || measureOverhead / lastMeasureOverhead <= 0.9995) && maxCalTime > 0); return result; } if (maxms == 0) { /* * Reset last measurement overhead */ measureOverhead = 0; Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); return TCL_OK; } /* * If time is negative, make current overhead more precise. */ if (maxms > 0) { /* * Set last measurement overhead to max. */ measureOverhead = (double) UWIDE_MAX; } else { maxms = -maxms; } } if (maxms == WIDE_MIN) { maxms = 1000; } if (overhead == -1) { overhead = measureOverhead; } /* * Ensure that resetting of result will not smudge the further * measurement. */ Tcl_ResetResult(interp); /* * Compile object if needed. */ if (!direct) { if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); } /* * Get start and stop time. */ #ifdef TCL_WIDE_CLICKS start = middle = TclpGetWideClicks(); /* * Time to stop execution (in wide clicks). */ stop = start + (maxms * 1000 / TclpWideClickInMicrosec()); #else Tcl_GetTime(&now); start = now.sec; start *= 1000000; start += now.usec; middle = start; /* * Time to stop execution (in microsecs). */ stop = start + maxms * 1000; #endif /* TCL_WIDE_CLICKS */ /* * Start measurement. */ if (maxcnt > 0) { while (1) { /* * Evaluate a single iteration. */ count++; if (!direct) { /* precompiled */ rootPtr = TOP_CB(interp); /* * Use loop optimized TEBC call (TCL_EVAL_DISCARD_RESULT): it's a part of * iteration, this way evaluation will be more similar to a cycle (also * avoids extra overhead to set result to interp, etc.) */ ((Interp *)interp)->evalFlags |= TCL_EVAL_DISCARD_RESULT; result = TclNRExecuteByteCode(interp, codePtr); result = TclNRRunCallbacks(interp, result, rootPtr); } else { /* eval */ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); } /* * Allow break and continue from measurement cycle (used for * conditional stop and flow control of iterations). */ switch (result) { case TCL_OK: break; case TCL_BREAK: /* * Force stop immediately. */ threshold = 1; maxcnt = 0; /* FALLTHRU */ case TCL_CONTINUE: result = TCL_OK; break; default: goto done; } /* * Don't check time up to threshold. */ if (--threshold > 0) { continue; } /* * Check stop time reached, estimate new threshold. */ #ifdef TCL_WIDE_CLICKS middle = TclpGetWideClicks(); #else Tcl_GetTime(&now); middle = now.sec; middle *= 1000000; middle += now.usec; #endif /* TCL_WIDE_CLICKS */ if (middle >= stop || count >= maxcnt) { break; } /* * Don't calculate threshold by few iterations, because sometimes * first iteration(s) can be too fast or slow (cached, delayed * clean up, etc). */ if (count < 10) { threshold = 1; continue; } /* * Average iteration time in microsecs. */ threshold = (middle - start) / count; if (threshold > maxIterTm) { maxIterTm = threshold; /* * Iterations seem to be longer. */ if (threshold > maxIterTm * 2) { factor *= 2; if (factor > 50) { factor = 50; } } else { if (factor < 50) { factor++; } } } else if (factor > 4) { /* * Iterations seem to be shorter. */ if (threshold < (maxIterTm / 2)) { factor /= 2; if (factor < 4) { factor = 4; } } else { factor--; } } /* * As relation between remaining time and time since last check, * maximal some % of time (by factor), so avoid growing of the * execution time if iterations are not consistent, e.g. was * continuously on time). */ threshold = ((stop - middle) / maxIterTm) / factor + 1; if (threshold > 100000) { /* fix for too large threshold */ threshold = 100000; } /* * Consider max-count */ if (threshold > maxcnt - count) { threshold = maxcnt - count; } } } { Tcl_Obj *objarr[8], **objs = objarr; TclWideMUInt usec, val; int digits; /* * Absolute execution time in microseconds or in wide clicks. */ usec = (TclWideMUInt)(middle - start); #ifdef TCL_WIDE_CLICKS /* * convert execution time (in wide clicks) to microsecs. */ usec *= TclpWideClickInMicrosec(); #endif /* TCL_WIDE_CLICKS */ if (!count) { /* no iterations - avoid divide by zero */ objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0); goto retRes; } /* * If not calibrating... */ if (!calibrate) { /* * Minimize influence of measurement overhead. */ if (overhead > 0) { /* * Estimate the time of overhead (microsecs). */ TclWideMUInt curOverhead = overhead * count; if (usec > curOverhead) { usec -= curOverhead; } else { usec = 0; } } } else { /* * Calibration: obtaining new measurement overhead. */ if (measureOverhead > ((double) usec) / count) { measureOverhead = ((double) usec) / count; } objs[0] = Tcl_NewDoubleObj(measureOverhead); TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */ objs += 2; } val = usec / count; /* microsecs per iteration */ if (val >= 1000000) { objs[0] = Tcl_NewWideIntObj(val); } else { if (val < 10) { digits = 6; } else if (val < 100) { digits = 4; } else if (val < 1000) { digits = 3; } else if (val < 10000) { digits = 2; } else { digits = 1; } objs[0] = Tcl_ObjPrintf("%.*f", digits, ((double) usec)/count); } objs[2] = Tcl_NewWideIntObj(count); /* iterations */ /* * Calculate speed as rate (count) per sec */ if (!usec) { usec++; /* Avoid divide by zero. */ } if (count < (WIDE_MAX / 1000000)) { val = (count * 1000000) / usec; if (val < 100000) { if (val < 100) { digits = 3; } else if (val < 1000) { digits = 2; } else { digits = 1; } objs[4] = Tcl_ObjPrintf("%.*f", digits, ((double) (count * 1000000)) / usec); } else { objs[4] = Tcl_NewWideIntObj(val); } } else { objs[4] = Tcl_NewWideIntObj((count / usec) * 1000000); } retRes: /* * Estimated net execution time (in millisecs). */ if (!calibrate) { if (usec >= 1) { objs[6] = Tcl_ObjPrintf("%.3f", (double)usec / 1000); } else { objs[6] = Tcl_NewWideIntObj(0); } TclNewLiteralStringObj(objs[7], "net-ms"); } /* * Construct the result as a list because many programs have always * parsed as such (extracting the first element, typically). */ TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */ TclNewLiteralStringObj(objs[3], "#"); TclNewLiteralStringObj(objs[5], "#/sec"); Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr)); } done: if (codePtr != NULL) { TclReleaseByteCode(codePtr); } return result; } /* *---------------------------------------------------------------------- * * Tcl_TryObjCmd, TclNRTryObjCmd -- * * This procedure is invoked to process the "try" Tcl command. See the * user documentation (or TIP #329) for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_TryObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRTryObjCmd, dummy, objc, objv); } int TclNRTryObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL; int i, bodyShared, haveHandlers, dummy, code; static const char *const handlerNames[] = { "finally", "on", "trap", NULL }; enum Handlers { TryFinally, TryOn, TryTrap }; /* * Parse the arguments. The handlers are passed to subsequent callbacks as * a Tcl_Obj list of the 5-tuples like (type, returnCode, errorCodePrefix, * bindVariables, script), and the finally script is just passed as it is. */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "body ?handler ...? ?finally script?"); return TCL_ERROR; } bodyObj = objv[1]; TclNewObj(handlersObj); bodyShared = 0; haveHandlers = 0; for (i=2 ; i objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "wrong # args to on clause: must be \"... on code" " variableList script\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON", "ARGUMENT", NULL); return TCL_ERROR; } if (TclGetCompletionCodeFromObj(interp, objv[i+1], &code) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } info[2] = NULL; goto commonHandler; case TryTrap: /* trap pattern variableList script */ if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "wrong # args to trap clause: " "must be \"... trap pattern variableList script\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", "ARGUMENT", NULL); return TCL_ERROR; } code = 1; if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad prefix '%s': must be a list", Tcl_GetString(objv[i+1]))); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", "EXNFORMAT", NULL); return TCL_ERROR; } info[2] = objv[i+1]; commonHandler: if (TclListObjLength(interp, objv[i+2], &dummy) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } info[0] = objv[i]; /* type */ TclNewIntObj(info[1], code); /* returnCode */ if (info[2] == NULL) { /* errorCodePrefix */ TclNewObj(info[2]); } info[3] = objv[i+2]; /* bindVariables */ info[4] = objv[i+3]; /* script */ bodyShared = !strcmp(TclGetString(objv[i+3]), "-"); Tcl_ListObjAppendElement(NULL, handlersObj, Tcl_NewListObj(5, info)); haveHandlers = 1; i += 3; break; } } if (bodyShared) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "last non-finally clause must not have a body of \"-\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH", NULL); return TCL_ERROR; } if (!haveHandlers) { Tcl_DecrRefCount(handlersObj); handlersObj = NULL; } /* * Execute the body. */ Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj, (ClientData)objv, INT2PTR(objc)); return TclNREvalObjEx(interp, bodyObj, 0, ((Interp *) interp)->cmdFramePtr, 1); } /* *---------------------------------------------------------------------- * * During -- * * This helper function patches together the updates to the interpreter's * return options that are needed when things fail during the processing * of a handler or finally script for the [try] command. * * Returns: * The new option dictionary. * *---------------------------------------------------------------------- */ static inline Tcl_Obj * During( Tcl_Interp *interp, int resultCode, /* The result code from the just-evaluated * script. */ Tcl_Obj *oldOptions, /* The old option dictionary. */ Tcl_Obj *errorInfo) /* An object to append to the errorinfo and * release, or NULL if nothing is to be added. * Designed to be used with Tcl_ObjPrintf. */ { Tcl_Obj *during, *options; if (errorInfo != NULL) { Tcl_AppendObjToErrorInfo(interp, errorInfo); } options = Tcl_GetReturnOptions(interp, resultCode); TclNewLiteralStringObj(during, "-during"); Tcl_IncrRefCount(during); Tcl_DictObjPut(interp, options, during, oldOptions); Tcl_DecrRefCount(during); Tcl_IncrRefCount(options); Tcl_DecrRefCount(oldOptions); return options; } /* *---------------------------------------------------------------------- * * TryPostBody -- * * Callback to handle the outcome of the execution of the body of a 'try' * command. * *---------------------------------------------------------------------- */ static int TryPostBody( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv; int i, dummy, code, objc; int numHandlers = 0; handlersObj = (Tcl_Obj *)data[0]; finallyObj = (Tcl_Obj *)data[1]; objv = (Tcl_Obj **)data[2]; objc = PTR2INT(data[3]); cmdObj = objv[0]; /* * Check for limits/rewinding, which override normal trapping behaviour. */ if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%s\" body line %d)", TclGetString(cmdObj), Tcl_GetErrorLine(interp))); if (handlersObj != NULL) { Tcl_DecrRefCount(handlersObj); } return TCL_ERROR; } /* * Basic processing of the outcome of the script, including adding of * errorinfo trace. */ if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%s\" body line %d)", TclGetString(cmdObj), Tcl_GetErrorLine(interp))); } resultObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultObj); options = Tcl_GetReturnOptions(interp, result); Tcl_IncrRefCount(options); Tcl_ResetResult(interp); /* * Handle the results. */ if (handlersObj != NULL) { int found = 0; Tcl_Obj **handlers, **info; TclListObjGetElements(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; i 0) { Tcl_Obj *varName; Tcl_ListObjIndex(NULL, info[3], 0, &varName); if (Tcl_ObjSetVar2(interp, varName, NULL, resultObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(resultObj); goto handlerFailed; } Tcl_DecrRefCount(resultObj); if (dummy > 1) { Tcl_ListObjIndex(NULL, info[3], 1, &varName); if (Tcl_ObjSetVar2(interp, varName, NULL, options, TCL_LEAVE_ERR_MSG) == NULL) { goto handlerFailed; } } } else { /* * Dispose of the result to prevent a memleak. [Bug 2910044] */ Tcl_DecrRefCount(resultObj); } /* * Evaluate the handler body and process the outcome. Note that we * need to keep the kind of handler for debugging purposes, and in * any case anything we want from info[] must be extracted right * now because the info[] array is about to become invalid. There * is very little refcount handling here however, since we know * that the objects that we still want to refer to now were input * arguments to [try] and so are still on the Tcl value stack. */ handlerBodyObj = info[4]; Tcl_NRAddCallback(interp, TryPostHandler, objv, options, info[0], INT2PTR((finallyObj == NULL) ? 0 : objc - 1)); Tcl_DecrRefCount(handlersObj); return TclNREvalObjEx(interp, handlerBodyObj, 0, ((Interp *) interp)->cmdFramePtr, 4*i + 5); handlerFailed: resultObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultObj); options = During(interp, result, options, NULL); break; didNotMatch: continue; } /* * No handler matched; get rid of the list of handlers. */ Tcl_DecrRefCount(handlersObj); } /* * Process the finally clause. */ if (finallyObj != NULL) { Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj, NULL); return TclNREvalObjEx(interp, finallyObj, 0, ((Interp *) interp)->cmdFramePtr, objc - 1); } /* * Install the correct result/options into the interpreter and clean up * any temporary storage. */ result = Tcl_SetReturnOptions(interp, options); Tcl_DecrRefCount(options); Tcl_SetObjResult(interp, resultObj); Tcl_DecrRefCount(resultObj); return result; } /* *---------------------------------------------------------------------- * * TryPostHandler -- * * Callback to handle the outcome of the execution of a handler of a * 'try' command. * *---------------------------------------------------------------------- */ static int TryPostHandler( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv; Tcl_Obj *finallyObj; int finallyIndex; objv = (Tcl_Obj **)data[0]; options = (Tcl_Obj *)data[1]; handlerKindObj = (Tcl_Obj *)data[2]; finallyIndex = PTR2INT(data[3]); cmdObj = objv[0]; finallyObj = finallyIndex ? objv[finallyIndex] : 0; /* * Check for limits/rewinding, which override normal trapping behaviour. */ if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) { options = During(interp, result, options, Tcl_ObjPrintf( "\n (\"%s ... %s\" handler line %d)", TclGetString(cmdObj), TclGetString(handlerKindObj), Tcl_GetErrorLine(interp))); Tcl_DecrRefCount(options); return TCL_ERROR; } /* * The handler result completely substitutes for the result of the body. */ resultObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultObj); if (result == TCL_ERROR) { options = During(interp, result, options, Tcl_ObjPrintf( "\n (\"%s ... %s\" handler line %d)", TclGetString(cmdObj), TclGetString(handlerKindObj), Tcl_GetErrorLine(interp))); } else { Tcl_DecrRefCount(options); options = Tcl_GetReturnOptions(interp, result); Tcl_IncrRefCount(options); } /* * Process the finally clause if it is present. */ if (finallyObj != NULL) { Interp *iPtr = (Interp *) interp; Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj, NULL); /* The 'finally' script is always the last argument word. */ return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr, finallyIndex); } /* * Install the correct result/options into the interpreter and clean up * any temporary storage. */ result = Tcl_SetReturnOptions(interp, options); Tcl_DecrRefCount(options); Tcl_SetObjResult(interp, resultObj); Tcl_DecrRefCount(resultObj); return result; } /* *---------------------------------------------------------------------- * * TryPostFinal -- * * Callback to handle the outcome of the execution of the finally script * of a 'try' command. * *---------------------------------------------------------------------- */ static int TryPostFinal( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj *resultObj, *options, *cmdObj; resultObj = (Tcl_Obj *)data[0]; options = (Tcl_Obj *)data[1]; cmdObj = (Tcl_Obj *)data[2]; /* * If the result wasn't OK, we need to adjust the result options. */ if (result != TCL_OK) { Tcl_DecrRefCount(resultObj); resultObj = NULL; if (result == TCL_ERROR) { options = During(interp, result, options, Tcl_ObjPrintf( "\n (\"%s ... finally\" body line %d)", TclGetString(cmdObj), Tcl_GetErrorLine(interp))); } else { Tcl_Obj *origOptions = options; options = Tcl_GetReturnOptions(interp, result); Tcl_IncrRefCount(options); Tcl_DecrRefCount(origOptions); } } /* * Install the correct result/options into the interpreter and clean up * any temporary storage. */ result = Tcl_SetReturnOptions(interp, options); Tcl_DecrRefCount(options); if (resultObj != NULL) { Tcl_SetObjResult(interp, resultObj); Tcl_DecrRefCount(resultObj); } return result; } /* *---------------------------------------------------------------------- * * Tcl_WhileObjCmd -- * * This procedure is invoked to process the "while" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a * command name is computed at runtime, and is "while" or the name to * which "while" was renamed: e.g., "set z while; $z {$i<100} {}" * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_WhileObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRWhileObjCmd, dummy, objc, objv); } int TclNRWhileObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ForIterData *iterPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "test command"); return TCL_ERROR; } /* * We reuse [for]'s callback, passing a NULL for the 'next' script. */ TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr); iterPtr->cond = objv[1]; iterPtr->body = objv[2]; iterPtr->next = NULL; iterPtr->msg = "\n (\"while\" body line %d)"; iterPtr->word = 2; TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclListLines -- * * ??? * * Results: * Filled in array of line numbers? * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclListLines( Tcl_Obj *listObj, /* Pointer to obj holding a string with list * structure. Assumed to be valid. Assumed to * contain n elements. */ int line, /* Line the list as a whole starts on. */ int n, /* #elements in lines */ int *lines, /* Array of line numbers, to fill. */ Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of * derived continuation data */ { const char *listStr = Tcl_GetString(listObj); const char *listHead = listStr; int i, length = strlen(listStr); const char *element = NULL, *next = NULL; ContLineLoc *clLocPtr = TclContinuationsGet(listObj); int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL); for (i = 0; i < n; i++) { TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL); TclAdvanceLines(&line, listStr, element); /* Leading whitespace */ TclAdvanceContinuations(&line, &clNext, element - listHead); if (elems && clNext) { TclContinuationsEnterDerived(elems[i], element-listHead, clNext); } lines[i] = line; length -= (next - listStr); TclAdvanceLines(&line, element, next); /* Element */ listStr = next; if (*element == 0) { /* ASSERT i == n */ break; } } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclCompCmds.c0000644000175000017500000031167114554262142015643 0ustar sergeisergei/* * tclCompCmds.c -- * * This file contains compilation procedures that compile various Tcl * commands into a sequence of instructions ("bytecodes"). * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2001 Kevin B. Kenny. All rights reserved. * Copyright (c) 2002 ActiveState Corporation. * Copyright (c) 2004-2013 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include /* * Prototypes for procedures defined later in this file: */ static AuxDataDupProc DupDictUpdateInfo; static AuxDataFreeProc FreeDictUpdateInfo; static AuxDataPrintProc PrintDictUpdateInfo; static AuxDataPrintProc DisassembleDictUpdateInfo; static AuxDataDupProc DupForeachInfo; static AuxDataFreeProc FreeForeachInfo; static AuxDataPrintProc PrintForeachInfo; static AuxDataPrintProc DisassembleForeachInfo; static AuxDataPrintProc PrintNewForeachInfo; static AuxDataPrintProc DisassembleNewForeachInfo; static int CompileEachloopCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr, int collect); static int CompileDictEachCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr, int collect); /* * The structures below define the AuxData types defined in this file. */ static const AuxDataType foreachInfoType = { "ForeachInfo", /* name */ DupForeachInfo, /* dupProc */ FreeForeachInfo, /* freeProc */ PrintForeachInfo, /* printProc */ DisassembleForeachInfo /* disassembleProc */ }; static const AuxDataType newForeachInfoType = { "NewForeachInfo", /* name */ DupForeachInfo, /* dupProc */ FreeForeachInfo, /* freeProc */ PrintNewForeachInfo, /* printProc */ DisassembleNewForeachInfo /* disassembleProc */ }; static const AuxDataType dictUpdateInfoType = { "DictUpdateInfo", /* name */ DupDictUpdateInfo, /* dupProc */ FreeDictUpdateInfo, /* freeProc */ PrintDictUpdateInfo, /* printProc */ DisassembleDictUpdateInfo /* disassembleProc */ }; /* *---------------------------------------------------------------------- * * TclGetAuxDataType -- * * This procedure looks up an Auxdata type by name. * * Results: * If an AuxData type with name matching "typeName" is found, a pointer * to its AuxDataType structure is returned; otherwise, NULL is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ const AuxDataType * TclGetAuxDataType( const char *typeName) /* Name of AuxData type to look up. */ { if (!strcmp(typeName, foreachInfoType.name)) { return &foreachInfoType; } else if (!strcmp(typeName, newForeachInfoType.name)) { return &newForeachInfoType; } else if (!strcmp(typeName, dictUpdateInfoType.name)) { return &dictUpdateInfoType; } else if (!strcmp(typeName, tclJumptableInfoType.name)) { return &tclJumptableInfoType; } return NULL; } /* *---------------------------------------------------------------------- * * TclCompileAppendCmd -- * * Procedure called to compile the "append" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "append" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileAppendCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *valueTokenPtr; int isScalar, localIndex, numWords, i; /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords == 1) { return TCL_ERROR; } else if (numWords == 2) { /* * append varName == set varName */ return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr); } else if (numWords > 3) { /* * APPEND instructions currently only handle one value, but we can * handle some multi-value cases by stringing them together. */ goto appendMultiple; } /* * Decide if we can use a frame slot for the var/array name or if we need * to emit code to compute and push the name at runtime. We use a frame * slot (entry in the array of local vars) if we are compiling a procedure * body and if the name is simple text that does not include namespace * qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, 0, &localIndex, &isScalar, 1); /* * We are doing an assignment, otherwise TclCompileSetCmd was called, so * push the new value. This will need to be extended to push a value for * each argument. */ valueTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, valueTokenPtr, interp, 2); /* * Emit instructions to set/get the variable. */ if (isScalar) { if (localIndex < 0) { TclEmitOpcode(INST_APPEND_STK, envPtr); } else { Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr); } else { Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr); } } return TCL_OK; appendMultiple: /* * Can only handle the case where we are appending to a local scalar when * there are multiple values to append. Fortunately, this is common. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); localIndex = LocalScalarFromToken(varTokenPtr, envPtr); if (localIndex < 0) { return TCL_ERROR; } /* * Definitely appending to a local scalar; generate the words and append * them. */ valueTokenPtr = TokenAfter(varTokenPtr); for (i = 2 ; i < numWords ; i++) { CompileWord(envPtr, valueTokenPtr, interp, i); valueTokenPtr = TokenAfter(valueTokenPtr); } TclEmitInstInt4( INST_REVERSE, numWords-2, envPtr); for (i = 2 ; i < numWords ;) { Emit14Inst( INST_APPEND_SCALAR, localIndex, envPtr); if (++i < numWords) { TclEmitOpcode(INST_POP, envPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileArray*Cmd -- * * Functions called to compile "array" subcommands. * * Results: * All return TCL_OK for a successful compile, and TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "array" subcommand at * runtime. * *---------------------------------------------------------------------- */ int TclCompileArrayExistsCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int isScalar, localIndex; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT, &localIndex, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } if (localIndex >= 0) { TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); } else { TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); } return TCL_OK; } int TclCompileArraySetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *dataTokenPtr; int isScalar, localIndex, code = TCL_OK; int isDataLiteral, isDataValid, isDataEven, len; int keyVar, valVar, infoIndex; int fwd, offsetBack, offsetFwd; Tcl_Obj *literalObj; ForeachInfo *infoPtr; if (parsePtr->numWords != 3) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); dataTokenPtr = TokenAfter(varTokenPtr); TclNewObj(literalObj); isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj); isDataValid = (isDataLiteral && TclListObjLength(NULL, literalObj, &len) == TCL_OK); isDataEven = (isDataValid && (len & 1) == 0); /* * Special case: literal odd-length argument is always an error. */ if (isDataValid && !isDataEven) { /* Abandon custom compile and let invocation raise the error */ code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); goto done; /* * We used to compile to the bytecode that would throw the error, * but that was wrong because it would not invoke the array trace * on the variable. * PushStringLiteral(envPtr, "list must have an even number of elements"); PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}"); TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr); TclEmitInt4( 0, envPtr); goto done; * */ } /* * Except for the special "ensure array" case below, when we're not in * a proc, we cannot do a better compile than generic. */ if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (envPtr->procPtr == NULL && !(isDataEven && len == 0))) { code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); goto done; } PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT, &localIndex, &isScalar, 1); if (!isScalar) { code = TCL_ERROR; goto done; } /* * Special case: literal empty value argument is just an "ensure array" * operation. */ if (isDataEven && len == 0) { if (localIndex >= 0) { TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); } else { TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 5, envPtr); TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); TclEmitInstInt1(INST_JUMP1, 3, envPtr); /* Each branch decrements stack depth, but we only take one. */ TclAdjustStackDepth(1, envPtr); TclEmitOpcode( INST_POP, envPtr); } PushStringLiteral(envPtr, ""); goto done; } if (localIndex < 0) { /* * a non-local variable: upvar from a local one! This consumes the * variable name that was left at stacktop. */ localIndex = TclFindCompiledLocal(varTokenPtr->start, varTokenPtr->size, 1, envPtr); PushStringLiteral(envPtr, "0"); TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); TclEmitOpcode(INST_POP, envPtr); } /* * Prepare for the internal foreach. */ keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); infoPtr = (ForeachInfo *)ckalloc(TclOffset(ForeachInfo, varLists) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; infoPtr->varLists[0] = (ForeachVarList *)ckalloc(TclOffset(ForeachVarList, varIndexes) + 2 * sizeof(int)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr); /* * Start issuing instructions to write to the array. */ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); CompileWord(envPtr, dataTokenPtr, interp, 2); if (!isDataLiteral || !isDataValid) { /* * Only need this safety check if we're handling a non-literal or list * containing an invalid literal; with valid list literals, we've * already checked (worth it because literals are a very common * use-case with [array set]). */ TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LIST_LENGTH, envPtr); PushStringLiteral(envPtr, "1"); TclEmitOpcode( INST_BITAND, envPtr); offsetFwd = CurrentOffset(envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); PushStringLiteral(envPtr, "list must have an even number of elements"); PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}"); TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr); TclEmitInt4( 0, envPtr); TclAdjustStackDepth(-1, envPtr); fwd = CurrentOffset(envPtr) - offsetFwd; TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); } TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr); offsetBack = CurrentOffset(envPtr); Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */ TclEmitOpcode( INST_FOREACH_STEP, envPtr); TclEmitOpcode( INST_FOREACH_END, envPtr); TclAdjustStackDepth(-3, envPtr); PushStringLiteral(envPtr, ""); done: Tcl_DecrRefCount(literalObj); return code; } int TclCompileArrayUnsetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); int isScalar, localIndex; if (parsePtr->numWords != 2) { return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT, &localIndex, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } if (localIndex >= 0) { TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 8, envPtr); TclEmitInstInt1(INST_UNSET_SCALAR, 1, envPtr); TclEmitInt4( localIndex, envPtr); } else { TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 6, envPtr); TclEmitInstInt1(INST_UNSET_STK, 1, envPtr); TclEmitInstInt1(INST_JUMP1, 3, envPtr); /* Each branch decrements stack depth, but we only take one. */ TclAdjustStackDepth(1, envPtr); TclEmitOpcode( INST_POP, envPtr); } PushStringLiteral(envPtr, ""); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileBreakCmd -- * * Procedure called to compile the "break" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "break" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileBreakCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; if (parsePtr->numWords != 1) { return TCL_ERROR; } /* * Find the innermost exception range that contains this command. */ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { /* * Found the target! No need for a nasty INST_BREAK here. */ TclCleanupStackForBreakContinue(envPtr, auxPtr); TclAddLoopBreakFixup(envPtr, auxPtr); } else { /* * Emit a real break. */ TclEmitOpcode(INST_BREAK, envPtr); } TclAdjustStackDepth(1, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileCatchCmd -- * * Procedure called to compile the "catch" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "catch" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileCatchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; int resultIndex, optsIndex, range, dropScript = 0; int depth = TclGetStackDepth(envPtr); /* * If syntax does not match what we expect for [catch], do not compile. * Let runtime checks determine if syntax has changed. */ if ((parsePtr->numWords < 2) || (parsePtr->numWords > 4)) { return TCL_ERROR; } /* * If variables were specified and the catch command is at global level * (not in a procedure), don't compile it inline: the payoff is too small. */ if ((parsePtr->numWords >= 3) && !EnvHasLVT(envPtr)) { return TCL_ERROR; } /* * Make sure the variable names, if any, have no substitutions and just * refer to local scalars. */ resultIndex = optsIndex = -1; cmdTokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords >= 3) { resultNameTokenPtr = TokenAfter(cmdTokenPtr); resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr); if (resultIndex < 0) { return TCL_ERROR; } if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr); if (optsIndex < 0) { return TCL_ERROR; } } } /* * We will compile the catch command. Declare the exception range that it * uses. * * If the body is a simple word, compile a BEGIN_CATCH instruction, * followed by the instructions to eval the body. * Otherwise, compile instructions to substitute the body text before * starting the catch, then BEGIN_CATCH, and then EVAL_STK to evaluate the * substituted body. * Care has to be taken to make sure that substitution happens outside the * catch range so that errors in the substitution are not caught. * [Bug 219184] * The reason for duplicating the script is that EVAL_STK would otherwise * begin by underflowing the stack below the mark set by BEGIN_CATCH4. */ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); BODY(cmdTokenPtr, 1); } else { SetLineInformation(1); CompileTokens(envPtr, cmdTokenPtr, interp); TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); TclEmitOpcode( INST_DUP, envPtr); TclEmitInvoke(envPtr, INST_EVAL_STK); /* drop the script */ dropScript = 1; TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_POP, envPtr); } ExceptionRangeEnds(envPtr, range); /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. */ TclCheckStackDepth(depth+1, envPtr); PushStringLiteral(envPtr, "0"); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); /* * Emit the "error case" epilogue. Push the interpreter result and the * return code. */ ExceptionRangeTarget(envPtr, range, catchOffset); TclSetStackDepth(depth + dropScript, envPtr); if (dropScript) { TclEmitOpcode( INST_POP, envPtr); } /* Stack at this point is empty */ TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); /* Stack at this point on both branches: result returnCode */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileCatchCmd: bad jump distance %d", (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset)); } /* * Push the return options if the caller wants them. This needs to happen * before INST_END_CATCH */ if (optsIndex != -1) { TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); } /* * End the catch */ TclEmitOpcode( INST_END_CATCH, envPtr); /* * Save the result and return options if the caller wants them. This needs * to happen after INST_END_CATCH (compile-3.6/7). */ if (optsIndex != -1) { Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); } /* * At this point, the top of the stack is inconveniently ordered: * result returnCode * Reverse the stack to store the result. */ TclEmitInstInt4( INST_REVERSE, 2, envPtr); if (resultIndex != -1) { Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr); } TclEmitOpcode( INST_POP, envPtr); TclCheckStackDepth(depth+1, envPtr); return TCL_OK; } /*---------------------------------------------------------------------- * * TclCompileClockClicksCmd -- * * Procedure called to compile the "tcl::clock::clicks" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to run time. * * Side effects: * Instructions are added to envPtr to execute the "clock clicks" * command at runtime. * *---------------------------------------------------------------------- */ int TclCompileClockClicksCmd( Tcl_Interp* interp, /* Tcl interpreter */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token* tokenPtr; switch (parsePtr->numWords) { case 1: /* * No args */ TclEmitInstInt1(INST_CLOCK_READ, 0, envPtr); break; case 2: /* * -milliseconds or -microseconds */ tokenPtr = TokenAfter(parsePtr->tokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size < 4 || tokenPtr[1].size > 13) { return TCL_ERROR; } else if (!strncmp(tokenPtr[1].start, "-microseconds", tokenPtr[1].size)) { TclEmitInstInt1(INST_CLOCK_READ, 1, envPtr); break; } else if (!strncmp(tokenPtr[1].start, "-milliseconds", tokenPtr[1].size)) { TclEmitInstInt1(INST_CLOCK_READ, 2, envPtr); break; } else { return TCL_ERROR; } default: return TCL_ERROR; } return TCL_OK; } /*---------------------------------------------------------------------- * * TclCompileClockReadingCmd -- * * Procedure called to compile the "tcl::clock::microseconds", * "tcl::clock::milliseconds" and "tcl::clock::seconds" commands. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to run time. * * Side effects: * Instructions are added to envPtr to execute the "clock clicks" * command at runtime. * * Client data is 1 for microseconds, 2 for milliseconds, 3 for seconds. *---------------------------------------------------------------------- */ int TclCompileClockReadingCmd( Tcl_Interp* interp, /* Tcl interpreter */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { if (parsePtr->numWords != 1) { return TCL_ERROR; } TclEmitInstInt1(INST_CLOCK_READ, PTR2INT(cmdPtr->objClientData), envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileConcatCmd -- * * Procedure called to compile the "concat" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "concat" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileConcatCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Obj *objPtr, *listObj; Tcl_Token *tokenPtr; int i; /* TODO: Consider compiling expansion case. */ if (parsePtr->numWords == 1) { /* * [concat] without arguments just pushes an empty object. */ PushStringLiteral(envPtr, ""); return TCL_OK; } /* * Test if all arguments are compile-time known. If they are, we can * implement with a simple push. */ TclNewObj(listObj); for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { tokenPtr = TokenAfter(tokenPtr); TclNewObj(objPtr); if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { Tcl_DecrRefCount(objPtr); Tcl_DecrRefCount(listObj); listObj = NULL; break; } (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); } if (listObj != NULL) { Tcl_Obj **objs; const char *bytes; int len; TclListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); bytes = Tcl_GetStringFromObj(objPtr, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(objPtr); return TCL_OK; } /* * General case: runtime concat. */ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileContinueCmd -- * * Procedure called to compile the "continue" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "continue" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileContinueCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; /* * There should be no argument after the "continue". */ if (parsePtr->numWords != 1) { return TCL_ERROR; } /* * See if we can find a valid continueOffset (i.e., not -1) in the * innermost containing exception range. */ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { /* * Found the target! No need for a nasty INST_CONTINUE here. */ TclCleanupStackForBreakContinue(envPtr, auxPtr); TclAddLoopContinueFixup(envPtr, auxPtr); } else { /* * Emit a real continue. */ TclEmitOpcode(INST_CONTINUE, envPtr); } TclAdjustStackDepth(1, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileDict*Cmd -- * * Functions called to compile "dict" subcommands. * * Results: * All return TCL_OK for a successful compile, and TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "dict" subcommand at * runtime. * *---------------------------------------------------------------------- */ int TclCompileDictSetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *varTokenPtr; int i, dictVarIndex; /* * There must be at least one argument after the command. */ if (parsePtr->numWords < 4) { return TCL_ERROR; } /* * The dictionary variable must be a local scalar that is knowable at * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { return TCL_ERROR; } /* * Remaining words (key path and value to set) can be handled normally. */ tokenPtr = TokenAfter(varTokenPtr); for (i=2 ; i< parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } /* * Now emit the instruction to do the dict manipulation. */ TclEmitInstInt4( INST_DICT_SET, parsePtr->numWords-3, envPtr); TclEmitInt4( dictVarIndex, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } int TclCompileDictIncrCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *keyTokenPtr; int dictVarIndex, incrAmount; /* * There must be at least two arguments after the command. */ if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); /* * Parse the increment amount, if present. */ if (parsePtr->numWords == 4) { const char *word; int numBytes, code; Tcl_Token *incrTokenPtr; Tcl_Obj *intObj; incrTokenPtr = TokenAfter(keyTokenPtr); if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); } word = incrTokenPtr[1].start; numBytes = incrTokenPtr[1].size; intObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(intObj); code = TclGetIntFromObj(NULL, intObj, &incrAmount); TclDecrRefCount(intObj); if (code != TCL_OK) { return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); } } else { incrAmount = 1; } /* * The dictionary variable must be a local scalar that is knowable at * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Emit the key and the code to actually do the increment. */ CompileWord(envPtr, keyTokenPtr, interp, 2); TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr); TclEmitInt4( dictVarIndex, envPtr); return TCL_OK; } int TclCompileDictGetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i; /* * There must be at least two arguments after the command (the single-arg * case is legal, but too special and magic for us to deal with here). */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); /* * Only compile this because we need INST_DICT_GET anyway. */ for (i=1 ; inumWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } int TclCompileDictExistsCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i; /* * There must be at least two arguments after the command (the single-arg * case is legal, but too special and magic for us to deal with here). */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); /* * Now we do the code generation. */ for (i=1 ; inumWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } int TclCompileDictUnsetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i, dictVarIndex; /* * There must be at least one argument after the variable name for us to * compile to bytecode. */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } /* * The dictionary variable must be a local scalar that is knowable at * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); if (dictVarIndex < 0) { return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Remaining words (the key path) can be handled normally. */ for (i=2 ; inumWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } /* * Now emit the instruction to do the dict manipulation. */ TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2, envPtr); TclEmitInt4( dictVarIndex, envPtr); return TCL_OK; } int TclCompileDictCreateCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int worker; /* Temp var for building the value in. */ Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; const char *bytes; int i, len; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; } /* * See if we can build the value at compile time... */ tokenPtr = TokenAfter(parsePtr->tokenPtr); TclNewObj(dictObj); Tcl_IncrRefCount(dictObj); for (i=1 ; inumWords ; i+=2) { TclNewObj(keyObj); Tcl_IncrRefCount(keyObj); if (!TclWordKnownAtCompileTime(tokenPtr, keyObj)) { Tcl_DecrRefCount(keyObj); Tcl_DecrRefCount(dictObj); goto nonConstant; } tokenPtr = TokenAfter(tokenPtr); TclNewObj(valueObj); Tcl_IncrRefCount(valueObj); if (!TclWordKnownAtCompileTime(tokenPtr, valueObj)) { Tcl_DecrRefCount(keyObj); Tcl_DecrRefCount(valueObj); Tcl_DecrRefCount(dictObj); goto nonConstant; } tokenPtr = TokenAfter(tokenPtr); Tcl_DictObjPut(NULL, dictObj, keyObj, valueObj); Tcl_DecrRefCount(keyObj); Tcl_DecrRefCount(valueObj); } /* * We did! Excellent. The "verifyDict" is to do type forcing. */ bytes = Tcl_GetStringFromObj(dictObj, &len); PushLiteral(envPtr, bytes, len); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_DICT_VERIFY, envPtr); Tcl_DecrRefCount(dictObj); return TCL_OK; /* * Otherwise, we've got to issue runtime code to do the building, which we * do by [dict set]ting into an unnamed local variable. This requires that * we are in a context with an LVT. */ nonConstant: worker = AnonymousLocal(envPtr); if (worker < 0) { return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr); } PushStringLiteral(envPtr, ""); Emit14Inst( INST_STORE_SCALAR, worker, envPtr); TclEmitOpcode( INST_POP, envPtr); tokenPtr = TokenAfter(parsePtr->tokenPtr); for (i=1 ; inumWords ; i+=2) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i+1); tokenPtr = TokenAfter(tokenPtr); TclEmitInstInt4( INST_DICT_SET, 1, envPtr); TclEmitInt4( worker, envPtr); TclAdjustStackDepth(-1, envPtr); TclEmitOpcode( INST_POP, envPtr); } Emit14Inst( INST_LOAD_SCALAR, worker, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( worker, envPtr); return TCL_OK; } int TclCompileDictMergeCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i, workerIndex, infoIndex, outLoop; /* * Deal with some special edge cases. Note that in the case with one * argument, the only thing to do is to verify the dict-ness. */ /* TODO: Consider support for compiling expanded args. (less likely) */ if (parsePtr->numWords < 2) { PushStringLiteral(envPtr, ""); return TCL_OK; } else if (parsePtr->numWords == 2) { tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_DICT_VERIFY, envPtr); return TCL_OK; } /* * There's real merging work to do. * * Allocate some working space. This means we'll only ever compile this * command when there's an LVT present. */ workerIndex = AnonymousLocal(envPtr); if (workerIndex < 0) { return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } infoIndex = AnonymousLocal(envPtr); /* * Get the first dictionary and verify that it is so. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_DICT_VERIFY, envPtr); Emit14Inst( INST_STORE_SCALAR, workerIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); /* * For each of the remaining dictionaries... */ outLoop = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4( INST_BEGIN_CATCH4, outLoop, envPtr); ExceptionRangeStarts(envPtr, outLoop); for (i=2 ; inumWords ; i++) { /* * Get the dictionary, and merge its pairs into the first dict (using * a small loop). */ tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); TclEmitInstInt1( INST_JUMP_TRUE1, 24, envPtr); TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitInstInt4( INST_DICT_SET, 1, envPtr); TclEmitInt4( workerIndex, envPtr); TclAdjustStackDepth(-1, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); TclEmitInstInt1( INST_JUMP_FALSE1, -20, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); } ExceptionRangeEnds(envPtr, outLoop); TclEmitOpcode( INST_END_CATCH, envPtr); /* * Clean up any state left over. */ Emit14Inst( INST_LOAD_SCALAR, workerIndex, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( workerIndex, envPtr); TclEmitInstInt1( INST_JUMP1, 18, envPtr); /* * If an exception happens when starting to iterate over the second (and * subsequent) dicts. This is strictly not necessary, but it is nice. */ TclAdjustStackDepth(-1, envPtr); ExceptionRangeTarget(envPtr, outLoop, catchOffset); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( workerIndex, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); TclEmitOpcode( INST_RETURN_STK, envPtr); return TCL_OK; } int TclCompileDictForCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr, TCL_EACH_KEEP_NONE); } int TclCompileDictMapCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr, TCL_EACH_COLLECT); } int CompileDictEachCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int collect) /* Flag == TCL_EACH_COLLECT to collect and * construct a new dictionary with the loop * body result. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; int numVars, endTargetOffset; int collectVar = -1; /* Index of temp var holding the result * dict. */ const char **argv; Tcl_DString buffer; /* * There must be three arguments after the command. */ if (parsePtr->numWords != 4) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } varsTokenPtr = TokenAfter(parsePtr->tokenPtr); dictTokenPtr = TokenAfter(varsTokenPtr); bodyTokenPtr = TokenAfter(dictTokenPtr); if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD || bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Create temporary variable to capture return values from loop body when * we're collecting results. */ if (collect == TCL_EACH_COLLECT) { collectVar = AnonymousLocal(envPtr); if (collectVar < 0) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } } /* * Check we've got a pair of variables and that they are local variables. * Then extract their indices in the LVT. */ Tcl_DStringInit(&buffer); TclDStringAppendToken(&buffer, &varsTokenPtr[1]); if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, &argv) != TCL_OK) { Tcl_DStringFree(&buffer); return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } Tcl_DStringFree(&buffer); if (numVars != 2) { ckfree(argv); return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } nameChars = strlen(argv[0]); keyVarIndex = LocalScalar(argv[0], nameChars, envPtr); nameChars = strlen(argv[1]); valueVarIndex = LocalScalar(argv[1], nameChars, envPtr); ckfree(argv); if ((keyVarIndex < 0) || (valueVarIndex < 0)) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Allocate a temporary variable to store the iterator reference. The * variable will contain a Tcl_DictSearch reference which will be * allocated by INST_DICT_FIRST and disposed when the variable is unset * (at which point it should also have been finished with). */ infoIndex = AnonymousLocal(envPtr); if (infoIndex < 0) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Preparation complete; issue instructions. Note that this code issues * fixed-sized jumps. That simplifies things a lot! * * First up, initialize the accumulator dictionary if needed. */ if (collect == TCL_EACH_COLLECT) { PushStringLiteral(envPtr, ""); Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); TclEmitOpcode( INST_POP, envPtr); } /* * Get the dictionary and start the iteration. No catching of errors at * this point. */ CompileWord(envPtr, dictTokenPtr, interp, 2); /* * Now we catch errors from here on so that we can finalize the search * started by Tcl_DictObjFirst above. */ catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr); ExceptionRangeStarts(envPtr, catchRange); TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); emptyTargetOffset = CurrentOffset(envPtr); TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); /* * Inside the iteration, write the loop variables. */ bodyTargetOffset = CurrentOffset(envPtr); Emit14Inst( INST_STORE_SCALAR, keyVarIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); Emit14Inst( INST_STORE_SCALAR, valueVarIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); /* * Set up the loop exception targets. */ loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); ExceptionRangeStarts(envPtr, loopRange); /* * Compile the loop body itself. It should be stack-neutral. */ BODY(bodyTokenPtr, 3); if (collect == TCL_EACH_COLLECT) { Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitInstInt4(INST_DICT_SET, 1, envPtr); TclEmitInt4( collectVar, envPtr); TclAdjustStackDepth(-1, envPtr); TclEmitOpcode( INST_POP, envPtr); } TclEmitOpcode( INST_POP, envPtr); /* * Both exception target ranges (error and loop) end here. */ ExceptionRangeEnds(envPtr, loopRange); ExceptionRangeEnds(envPtr, catchRange); /* * Continue (or just normally process) by getting the next pair of items * from the dictionary and jumping back to the code to write them into * variables if there is another pair. */ ExceptionRangeTarget(envPtr, loopRange, continueOffset); TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr); TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr); endTargetOffset = CurrentOffset(envPtr); TclEmitInstInt1( INST_JUMP1, 0, envPtr); /* * Error handler "finally" clause, which force-terminates the iteration * and re-throws the error. */ TclAdjustStackDepth(-1, envPtr); ExceptionRangeTarget(envPtr, catchRange, catchOffset); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); if (collect == TCL_EACH_COLLECT) { TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( collectVar, envPtr); } TclEmitOpcode( INST_RETURN_STK, envPtr); /* * Otherwise we're done (the jump after the DICT_FIRST points here) and we * need to pop the bogus key/value pair (pushed to keep stack calculations * easy!) Note that we skip the END_CATCH. [Bug 1382528] */ jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset; TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement, envPtr->codeStart + emptyTargetOffset); jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset; TclUpdateInstInt1AtPc(INST_JUMP1, jumpDisplacement, envPtr->codeStart + endTargetOffset); TclEmitOpcode( INST_POP, envPtr); TclEmitOpcode( INST_POP, envPtr); ExceptionRangeTarget(envPtr, loopRange, breakOffset); TclFinalizeLoopExceptionRange(envPtr, loopRange); TclEmitOpcode( INST_END_CATCH, envPtr); /* * Final stage of the command (normal case) is that we push an empty * object (or push the accumulator as the result object). This is done * last to promote peephole optimization when it's dropped immediately. */ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); if (collect == TCL_EACH_COLLECT) { Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( collectVar, envPtr); } else { PushStringLiteral(envPtr, ""); } return TCL_OK; } int TclCompileDictUpdateCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int i, dictIndex, numVars, range, infoIndex; Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr; DictUpdateInfo *duiPtr; JumpFixup jumpFixup; /* * There must be at least one argument after the command. */ if (parsePtr->numWords < 5) { return TCL_ERROR; } /* * Parse the command. Expect the following: * dict update ? ...? */ if ((parsePtr->numWords - 1) & 1) { return TCL_ERROR; } numVars = (parsePtr->numWords - 3) / 2; /* * The dictionary variable must be a local scalar that is knowable at * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr); if (dictIndex < 0) { goto issueFallback; } /* * Assemble the instruction metadata. This is complex enough that it is * represented as auxData; it holds an ordered list of variable indices * that are to be used. */ duiPtr = (DictUpdateInfo *)ckalloc(TclOffset(DictUpdateInfo, varIndices) + sizeof(int) * numVars); duiPtr->length = numVars; keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars); tokenPtr = TokenAfter(dictVarTokenPtr); for (i=0 ; ivarIndices[i] = LocalScalarFromToken(tokenPtr, envPtr); if (duiPtr->varIndices[i] < 0) { goto failedUpdateInfoAssembly; } tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { goto failedUpdateInfoAssembly; } bodyTokenPtr = tokenPtr; /* * The list of variables to bind is stored in auxiliary data so that it * can't be snagged by literal sharing and forced to shimmer dangerously. */ infoIndex = TclCreateAuxData(duiPtr, &dictUpdateInfoType, envPtr); for (i=0 ; inumWords - 1); ExceptionRangeEnds(envPtr, range); /* * Normal termination code: the stack has the key list below the result of * the body evaluation: swap them and finish the update code. */ TclEmitOpcode( INST_END_CATCH, envPtr); TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); TclEmitInt4( infoIndex, envPtr); /* * Jump around the exceptional termination code. */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); /* * Termination code for non-ok returns: stash the result and return * options in the stack, bring up the key list, finish the update code, * and finally return with the caught return data */ ExceptionRangeTarget(envPtr, range, catchOffset); TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); TclEmitInstInt4( INST_REVERSE, 3, envPtr); TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); TclEmitInt4( infoIndex, envPtr); TclEmitInvoke(envPtr,INST_RETURN_STK); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } TclStackFree(interp, keyTokenPtrs); return TCL_OK; /* * Clean up after a failure to create the DictUpdateInfo structure. */ failedUpdateInfoAssembly: ckfree(duiPtr); TclStackFree(interp, keyTokenPtrs); issueFallback: return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } int TclCompileDictAppendCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i, dictVarIndex; /* * There must be at least two argument after the command. And we impose an * (arbitrary) safe limit; anyone exceeding it should stop worrying about * speed quite so much. ;-) */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords<4 || parsePtr->numWords>100) { return TCL_ERROR; } /* * Get the index of the local variable that we will be working with. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); if (dictVarIndex < 0) { return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr); } /* * Produce the string to concatenate onto the dictionary entry. */ tokenPtr = TokenAfter(tokenPtr); for (i=2 ; inumWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } if (parsePtr->numWords > 4) { TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr); } /* * Do the concatenation. */ TclEmitInstInt4(INST_DICT_APPEND, dictVarIndex, envPtr); return TCL_OK; } int TclCompileDictLappendCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; int dictVarIndex; /* * There must be three arguments after the command. */ /* TODO: Consider support for compiling expanded args. */ /* Probably not. Why is INST_DICT_LAPPEND limited to one value? */ if (parsePtr->numWords != 4) { return TCL_ERROR; } /* * Parse the arguments. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); valueTokenPtr = TokenAfter(keyTokenPtr); dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Issue the implementation. */ CompileWord(envPtr, keyTokenPtr, interp, 2); CompileWord(envPtr, valueTokenPtr, interp, 3); TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); return TCL_OK; } int TclCompileDictWithCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int i, range, varNameTmp = -1, pathTmp = -1, keysTmp, gotPath; int dictVar, bodyIsEmpty = 1; Tcl_Token *varTokenPtr, *tokenPtr; JumpFixup jumpFixup; const char *ptr, *end; /* * There must be at least one argument after the command. */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } /* * Parse the command (trivially). Expect the following: * dict with ? ...? */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(varTokenPtr); for (i=3 ; inumWords ; i++) { tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Test if the last word is an empty script; if so, we can compile it in * all cases, but if it is non-empty we need local variable table entries * to hold the temporary variables (used to keep stack usage simple). */ for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) { if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') { if (envPtr->procPtr == NULL) { return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } bodyIsEmpty = 0; break; } } /* * Determine if we're manipulating a dict in a simple local variable. */ gotPath = (parsePtr->numWords > 3); dictVar = LocalScalarFromToken(varTokenPtr, envPtr); /* * Special case: an empty body means we definitely have no need to issue * try-finally style code or to allocate local variable table entries for * storing temporaries. Still need to do both INST_DICT_EXPAND and * INST_DICT_RECOMBINE_* though, because we can't determine if we're free * of traces. */ if (bodyIsEmpty) { if (dictVar >= 0) { if (gotPath) { /* * Case: Path into dict in LVT with empty body. */ tokenPtr = TokenAfter(varTokenPtr); for (i=2 ; inumWords-1 ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitOpcode( INST_DICT_EXPAND, envPtr); TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr); } else { /* * Case: Direct dict in LVT with empty body. */ PushStringLiteral(envPtr, ""); Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); PushStringLiteral(envPtr, ""); TclEmitOpcode( INST_DICT_EXPAND, envPtr); TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr); } } else { if (gotPath) { /* * Case: Path into dict in non-simple var with empty body. */ tokenPtr = varTokenPtr; for (i=1 ; inumWords-1 ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitOpcode( INST_LOAD_STK, envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitOpcode( INST_DICT_EXPAND, envPtr); TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); } else { /* * Case: Direct dict in non-simple var with empty body. */ CompileWord(envPtr, varTokenPtr, interp, 1); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LOAD_STK, envPtr); PushStringLiteral(envPtr, ""); TclEmitOpcode( INST_DICT_EXPAND, envPtr); PushStringLiteral(envPtr, ""); TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); } } PushStringLiteral(envPtr, ""); return TCL_OK; } /* * OK, we have a non-trivial body. This means that the focus is on * generating a try-finally structure where the INST_DICT_RECOMBINE_* goes * in the 'finally' clause. * * Start by allocating local (unnamed, untraced) working variables. */ if (dictVar == -1) { varNameTmp = AnonymousLocal(envPtr); } if (gotPath) { pathTmp = AnonymousLocal(envPtr); } keysTmp = AnonymousLocal(envPtr); /* * Issue instructions. First, the part to expand the dictionary. */ if (dictVar == -1) { CompileWord(envPtr, varTokenPtr, interp, 1); Emit14Inst( INST_STORE_SCALAR, varNameTmp, envPtr); } tokenPtr = TokenAfter(varTokenPtr); if (gotPath) { for (i=2 ; inumWords-1 ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4( INST_LIST, parsePtr->numWords-3,envPtr); Emit14Inst( INST_STORE_SCALAR, pathTmp, envPtr); TclEmitOpcode( INST_POP, envPtr); } if (dictVar == -1) { TclEmitOpcode( INST_LOAD_STK, envPtr); } else { Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); } if (gotPath) { Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); } else { PushStringLiteral(envPtr, ""); } TclEmitOpcode( INST_DICT_EXPAND, envPtr); Emit14Inst( INST_STORE_SCALAR, keysTmp, envPtr); TclEmitOpcode( INST_POP, envPtr); /* * Now the body of the [dict with]. */ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); BODY(tokenPtr, parsePtr->numWords - 1); ExceptionRangeEnds(envPtr, range); /* * Now fold the results back into the dictionary in the OK case. */ TclEmitOpcode( INST_END_CATCH, envPtr); if (dictVar == -1) { Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); } if (gotPath) { Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); } else { PushStringLiteral(envPtr, ""); } Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr); if (dictVar == -1) { TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); } else { TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); } TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); /* * Now fold the results back into the dictionary in the exception case. */ TclAdjustStackDepth(-1, envPtr); ExceptionRangeTarget(envPtr, range, catchOffset); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); if (dictVar == -1) { Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); } if (parsePtr->numWords > 3) { Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); } else { PushStringLiteral(envPtr, ""); } Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr); if (dictVar == -1) { TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); } else { TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); } TclEmitInvoke(envPtr, INST_RETURN_STK); /* * Prepare for the start of the next command. */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * DupDictUpdateInfo, FreeDictUpdateInfo -- * * Functions to duplicate, release and print the aux data created for use * with the INST_DICT_UPDATE_START and INST_DICT_UPDATE_END instructions. * * Results: * DupDictUpdateInfo: a copy of the auxiliary data * FreeDictUpdateInfo: none * PrintDictUpdateInfo: none * DisassembleDictUpdateInfo: none * * Side effects: * DupDictUpdateInfo: allocates memory * FreeDictUpdateInfo: releases memory * PrintDictUpdateInfo: none * DisassembleDictUpdateInfo: none * *---------------------------------------------------------------------- */ static ClientData DupDictUpdateInfo( ClientData clientData) { DictUpdateInfo *dui1Ptr, *dui2Ptr; size_t len; dui1Ptr = (DictUpdateInfo *)clientData; len = TclOffset(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length; dui2Ptr = (DictUpdateInfo *)ckalloc(len); memcpy(dui2Ptr, dui1Ptr, len); return dui2Ptr; } static void FreeDictUpdateInfo( ClientData clientData) { ckfree(clientData); } static void PrintDictUpdateInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; int i; for (i=0 ; ilength ; i++) { if (i) { Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]); } } static void DisassembleDictUpdateInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; int i; Tcl_Obj *variables; TclNewObj(variables); for (i=0 ; ilength ; i++) { Tcl_ListObjAppendElement(NULL, variables, Tcl_NewIntObj(duiPtr->varIndices[i])); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1), variables); } /* *---------------------------------------------------------------------- * * TclCompileErrorCmd -- * * Procedure called to compile the "error" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "error" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileErrorCmd( Tcl_Interp *interp, /* Used for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * General syntax: [error message ?errorInfo? ?errorCode?] */ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) { return TCL_ERROR; } /* * Handle the message. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); /* * Construct the options. Note that -code and -level are not here. */ if (parsePtr->numWords == 2) { PushStringLiteral(envPtr, ""); } else { PushStringLiteral(envPtr, "-errorinfo"); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); if (parsePtr->numWords == 3) { TclEmitInstInt4( INST_LIST, 2, envPtr); } else { PushStringLiteral(envPtr, "-errorcode"); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 3); TclEmitInstInt4( INST_LIST, 4, envPtr); } } /* * Issue the error via 'returnImm error 0'. */ TclEmitInstInt4( INST_RETURN_IMM, TCL_ERROR, envPtr); TclEmitInt4( 0, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileExprCmd -- * * Procedure called to compile the "expr" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "expr" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileExprCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *firstWordPtr; if (parsePtr->numWords == 1) { return TCL_ERROR; } /* * TIP #280: Use the per-word line information of the current command. */ envPtr->line = envPtr->extCmdMapPtr->loc[ envPtr->extCmdMapPtr->nuloc-1].line[1]; firstWordPtr = TokenAfter(parsePtr->tokenPtr); TclCompileExprWords(interp, firstWordPtr, parsePtr->numWords-1, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileForCmd -- * * Procedure called to compile the "for" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "for" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileForCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr; JumpFixup jumpEvalCondFixup; int bodyCodeOffset, nextCodeOffset, jumpDist; int bodyRange, nextRange; if (parsePtr->numWords != 5) { return TCL_ERROR; } /* * If the test expression requires substitutions, don't compile the for * command inline. E.g., the expression might cause the loop to never * execute or execute forever, as in "for {} "$x > 5" {incr x} {}". */ startTokenPtr = TokenAfter(parsePtr->tokenPtr); testTokenPtr = TokenAfter(startTokenPtr); if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } /* * Bail out also if the body or the next expression require substitutions * in order to insure correct behaviour [Bug 219166] */ nextTokenPtr = TokenAfter(testTokenPtr); bodyTokenPtr = TokenAfter(nextTokenPtr); if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) { return TCL_ERROR; } /* * Inline compile the initial command. */ BODY(startTokenPtr, 1); TclEmitOpcode(INST_POP, envPtr); /* * Jump to the evaluation of the condition. This code uses the "loop * rotation" optimisation (which eliminates one branch from the loop). * "for start cond next body" produces then: * start * goto A * B: body : bodyCodeOffset * next : nextCodeOffset, continueOffset * A: cond -> result : testCodeOffset * if (result) goto B */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup); /* * Compile the loop body. */ bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange); BODY(bodyTokenPtr, 4); ExceptionRangeEnds(envPtr, bodyRange); TclEmitOpcode(INST_POP, envPtr); /* * Compile the "next" subcommand. Note that this exception range will not * have a continueOffset (other than -1) connected to it; it won't trap * TCL_CONTINUE but rather just TCL_BREAK. */ nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0; nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); BODY(nextTokenPtr, 3); ExceptionRangeEnds(envPtr, nextRange); TclEmitOpcode(INST_POP, envPtr); /* * Compile the test expression then emit the conditional jump that * terminates the for. */ if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) { bodyCodeOffset += 3; nextCodeOffset += 3; } SetLineInformation(2); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr); } else { TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr); } /* * Fix the starting points of the exception ranges (may have moved due to * jump type modification) and set where the exceptions target. */ envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset; envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset; envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset; ExceptionRangeTarget(envPtr, bodyRange, breakOffset); ExceptionRangeTarget(envPtr, nextRange, breakOffset); TclFinalizeLoopExceptionRange(envPtr, bodyRange); TclFinalizeLoopExceptionRange(envPtr, nextRange); /* * The for command's result is an empty string. */ PushStringLiteral(envPtr, ""); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileForeachCmd -- * * Procedure called to compile the "foreach" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "foreach" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileForeachCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, TCL_EACH_KEEP_NONE); } /* *---------------------------------------------------------------------- * * TclCompileLmapCmd -- * * Procedure called to compile the "lmap" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lmap" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileLmapCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to the definition of the command * being compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, TCL_EACH_COLLECT); } /* *---------------------------------------------------------------------- * * CompileEachloopCmd -- * * Procedure called to compile the "foreach" and "lmap" commands. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "foreach" command at * runtime. * *---------------------------------------------------------------------- */ static int CompileEachloopCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int collect) /* Select collecting or accumulating mode * (TCL_EACH_*) */ { DefineLineInformation; /* TIP #280 */ Proc *procPtr = envPtr->procPtr; ForeachInfo *infoPtr=NULL; /* Points to the structure describing this * foreach command. Stored in a AuxData * record in the ByteCode. */ Tcl_Token *tokenPtr, *bodyTokenPtr; int jumpBackOffset, infoIndex, range; int numWords, numLists, i, j, code = TCL_OK; Tcl_Obj *varListObj = NULL; /* * If the foreach command isn't in a procedure, don't compile it inline: * the payoff is too small. */ if (procPtr == NULL) { return TCL_ERROR; } numWords = parsePtr->numWords; if ((numWords < 4) || (numWords%2 != 0)) { return TCL_ERROR; } /* * Bail out if the body requires substitutions in order to ensure correct * behaviour. [Bug 219166] */ for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++) { tokenPtr = TokenAfter(tokenPtr); } bodyTokenPtr = tokenPtr; if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } /* * Create and initialize the ForeachInfo and ForeachVarList data * structures describing this command. Then create a AuxData record * pointing to the ForeachInfo structure. */ numLists = (numWords - 2)/2; infoPtr = (ForeachInfo *)ckalloc(TclOffset(ForeachInfo, varLists) + numLists * sizeof(ForeachVarList *)); infoPtr->numLists = 0; /* Count this up as we go */ /* * Parse each var list into sequence of var names. Don't * compile the foreach inline if any var name needs substitutions or isn't * a scalar, or if any var list needs substitutions. */ TclNewObj(varListObj); for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { ForeachVarList *varListPtr; int numVars; if (i%2 != 1) { continue; } /* * If the variable list is empty, we can enter an infinite loop when * the interpreted version would not. Take care to ensure this does * not happen. [Bug 1671138] */ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) || TCL_OK != TclListObjLength(NULL, varListObj, &numVars) || numVars == 0) { code = TCL_ERROR; goto done; } varListPtr = (ForeachVarList *)ckalloc(TclOffset(ForeachVarList, varIndexes) + numVars * sizeof(int)); varListPtr->numVars = numVars; infoPtr->varLists[i/2] = varListPtr; infoPtr->numLists++; for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; const char *bytes; int numBytes, varIndex; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); bytes = Tcl_GetStringFromObj(varNameObj, &numBytes); varIndex = LocalScalar(bytes, numBytes, envPtr); if (varIndex < 0) { code = TCL_ERROR; goto done; } varListPtr->varIndexes[j] = varIndex; } Tcl_SetObjLength(varListObj, 0); } /* * We will compile the foreach command. */ infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr); /* * Create the collecting object, unshared. */ if (collect == TCL_EACH_COLLECT) { TclEmitInstInt4(INST_LIST, 0, envPtr); } /* * Evaluate each value list and leave it on stack. */ for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { if ((i%2 == 0) && (i > 0)) { CompileWord(envPtr, tokenPtr, interp, i); } } TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr); /* * Inline compile the loop body. */ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); ExceptionRangeStarts(envPtr, range); BODY(bodyTokenPtr, numWords - 1); ExceptionRangeEnds(envPtr, range); if (collect == TCL_EACH_COLLECT) { TclEmitOpcode(INST_LMAP_COLLECT, envPtr); } else { TclEmitOpcode( INST_POP, envPtr); } /* * Bottom of loop code: assign each loop variable and check whether * to terminate the loop. Set the loop's break target. */ ExceptionRangeTarget(envPtr, range, continueOffset); TclEmitOpcode(INST_FOREACH_STEP, envPtr); ExceptionRangeTarget(envPtr, range, breakOffset); TclFinalizeLoopExceptionRange(envPtr, range); TclEmitOpcode(INST_FOREACH_END, envPtr); TclAdjustStackDepth(-(numLists+2), envPtr); /* * Set the jumpback distance from INST_FOREACH_STEP to the start of the * body's code. Misuse loopCtTemp for storing the jump size. */ jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset - envPtr->exceptArrayPtr[range].codeOffset; infoPtr->loopCtTemp = -jumpBackOffset; /* * The command's result is an empty string if not collecting. If * collecting, it is automatically left on stack after FOREACH_END. */ if (collect != TCL_EACH_COLLECT) { PushStringLiteral(envPtr, ""); } done: if (code == TCL_ERROR) { FreeForeachInfo(infoPtr); } Tcl_DecrRefCount(varListObj); return code; } /* *---------------------------------------------------------------------- * * DupForeachInfo -- * * This procedure duplicates a ForeachInfo structure created as auxiliary * data during the compilation of a foreach command. * * Results: * A pointer to a newly allocated copy of the existing ForeachInfo * structure is returned. * * Side effects: * Storage for the copied ForeachInfo record is allocated. If the * original ForeachInfo structure pointed to any ForeachVarList records, * these structures are also copied and pointers to them are stored in * the new ForeachInfo record. * *---------------------------------------------------------------------- */ static ClientData DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { ForeachInfo *srcPtr = (ForeachInfo *)clientData; ForeachInfo *dupPtr; ForeachVarList *srcListPtr, *dupListPtr; int numVars, i, j, numLists = srcPtr->numLists; dupPtr = (ForeachInfo *)ckalloc(TclOffset(ForeachInfo, varLists) + numLists * sizeof(ForeachVarList *)); dupPtr->numLists = numLists; dupPtr->firstValueTemp = srcPtr->firstValueTemp; dupPtr->loopCtTemp = srcPtr->loopCtTemp; for (i = 0; i < numLists; i++) { srcListPtr = srcPtr->varLists[i]; numVars = srcListPtr->numVars; dupListPtr = (ForeachVarList *)ckalloc(TclOffset(ForeachVarList, varIndexes) + numVars * sizeof(int)); dupListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j]; } dupPtr->varLists[i] = dupListPtr; } return dupPtr; } /* *---------------------------------------------------------------------- * * FreeForeachInfo -- * * Procedure to free a ForeachInfo structure created as auxiliary data * during the compilation of a foreach command. * * Results: * None. * * Side effects: * Storage for the ForeachInfo structure pointed to by the ClientData * argument is freed as is any ForeachVarList record pointed to by the * ForeachInfo structure. * *---------------------------------------------------------------------- */ static void FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *listPtr; int numLists = infoPtr->numLists; int i; for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; ckfree(listPtr); } ckfree(infoPtr); } /* *---------------------------------------------------------------------- * * PrintForeachInfo, DisassembleForeachInfo -- * * Functions to write a human-readable or script-readablerepresentation * of a ForeachInfo structure to a Tcl_Obj for debugging. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PrintForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; int i, j; Tcl_AppendToObj(appendObj, "data=[", -1); for (i=0 ; inumLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%u", (unsigned) (infoPtr->firstValueTemp + i)); } Tcl_AppendPrintfToObj(appendObj, "], loop=%%v%u", (unsigned) infoPtr->loopCtTemp); for (i=0 ; inumLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ",", -1); } Tcl_AppendPrintfToObj(appendObj, "\n\t\t it%%v%u\t[", (unsigned) (infoPtr->firstValueTemp + i)); varsPtr = infoPtr->varLists[i]; for (j=0 ; jnumVars ; j++) { if (j) { Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%u", (unsigned) varsPtr->varIndexes[j]); } Tcl_AppendToObj(appendObj, "]", -1); } } static void PrintNewForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; int i, j; Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=", infoPtr->loopCtTemp); for (i=0 ; inumLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ",", -1); } Tcl_AppendToObj(appendObj, "[", -1); varsPtr = infoPtr->varLists[i]; for (j=0 ; jnumVars ; j++) { if (j) { Tcl_AppendToObj(appendObj, ",", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%u", (unsigned) varsPtr->varIndexes[j]); } Tcl_AppendToObj(appendObj, "]", -1); } } static void DisassembleForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; /* * Data stores. */ TclNewObj(objPtr); for (i=0 ; inumLists ; i++) { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(infoPtr->firstValueTemp + i)); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr); /* * Loop counter. */ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1), Tcl_NewIntObj(infoPtr->loopCtTemp)); /* * Assignment targets. */ TclNewObj(objPtr); for (i=0 ; inumLists ; i++) { TclNewObj(innerPtr); varsPtr = infoPtr->varLists[i]; for (j=0 ; jnumVars ; j++) { Tcl_ListObjAppendElement(NULL, innerPtr, Tcl_NewIntObj(varsPtr->varIndexes[j])); } Tcl_ListObjAppendElement(NULL, objPtr, innerPtr); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr); } static void DisassembleNewForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; /* * Jump offset. */ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1), Tcl_NewIntObj(infoPtr->loopCtTemp)); /* * Assignment targets. */ TclNewObj(objPtr); for (i=0 ; inumLists ; i++) { TclNewObj(innerPtr); varsPtr = infoPtr->varLists[i]; for (j=0 ; jnumVars ; j++) { Tcl_ListObjAppendElement(NULL, innerPtr, Tcl_NewIntObj(varsPtr->varIndexes[j])); } Tcl_ListObjAppendElement(NULL, objPtr, innerPtr); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr); } /* *---------------------------------------------------------------------- * * TclCompileFormatCmd -- * * Procedure called to compile the "format" command. Handles cases that * can be done as constants or simple string concatenation only. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "format" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileFormatCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Obj **objv, *formatObj, *tmpObj; const char *bytes, *start; int i, j, len; /* * Don't handle any guaranteed-error cases. */ if (parsePtr->numWords < 2) { return TCL_ERROR; } /* * Check if the argument words are all compile-time-known literals; that's * a case we can handle by compiling to a constant. */ TclNewObj(formatObj); Tcl_IncrRefCount(formatObj); tokenPtr = TokenAfter(tokenPtr); if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) { Tcl_DecrRefCount(formatObj); return TCL_ERROR; } objv = (Tcl_Obj **)ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); for (i=0 ; i+2 < parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); TclNewObj(objv[i]); Tcl_IncrRefCount(objv[i]); if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) { goto checkForStringConcatCase; } } /* * Everything is a literal, so the result is constant too (or an error if * the format is broken). Do the format now. */ tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj), parsePtr->numWords-2, objv); for (; --i>=0 ;) { Tcl_DecrRefCount(objv[i]); } ckfree(objv); Tcl_DecrRefCount(formatObj); if (tmpObj == NULL) { TclCompileSyntaxError(interp, envPtr); return TCL_OK; } /* * Not an error, always a constant result, so just push the result as a * literal. Job done. */ bytes = Tcl_GetStringFromObj(tmpObj, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(tmpObj); return TCL_OK; checkForStringConcatCase: /* * See if we can generate a sequence of things to concatenate. This * requires that all the % sequences be %s or %%, as everything else is * sufficiently complex that we don't bother. * * First, get the state of the system relatively sensible (cleaning up * after our attempt to spot a literal). */ for (; i>=0 ; i--) { Tcl_DecrRefCount(objv[i]); } ckfree(objv); tokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(tokenPtr); i = 0; /* * Now scan through and check for non-%s and non-%% substitutions. */ for (bytes = Tcl_GetString(formatObj) ; *bytes ; bytes++) { if (*bytes == '%') { bytes++; if (*bytes == 's') { i++; continue; } else if (*bytes == '%') { continue; } Tcl_DecrRefCount(formatObj); return TCL_ERROR; } } /* * Check if the number of things to concatenate will fit in a byte. */ if (i+2 != parsePtr->numWords || i > 125) { Tcl_DecrRefCount(formatObj); return TCL_ERROR; } /* * Generate the pushes of the things to concatenate, a sequence of * literals and compiled tokens (of which at least one is non-literal or * we'd have the case in the first half of this function) which we will * concatenate. */ i = 0; /* The count of things to concat. */ j = 2; /* The index into the argument tokens, for * TIP#280 handling. */ start = Tcl_GetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ TclNewObj(tmpObj); /* The buffer used to accumulate the literal * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { const char *b = Tcl_GetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, * push it and reset. */ if (len > 0) { PushLiteral(envPtr, b, len); Tcl_DecrRefCount(tmpObj); TclNewObj(tmpObj); i++; } /* * Push the code to produce the string that would be * substituted with %s, except we'll be concatenating * directly. */ CompileWord(envPtr, tokenPtr, interp, j); tokenPtr = TokenAfter(tokenPtr); j++; i++; } start = bytes + 1; } } /* * Handle the case of a trailing literal. */ Tcl_AppendToObj(tmpObj, start, bytes - start); bytes = Tcl_GetStringFromObj(tmpObj, &len); if (len > 0) { PushLiteral(envPtr, bytes, len); i++; } Tcl_DecrRefCount(tmpObj); Tcl_DecrRefCount(formatObj); if (i > 1) { /* * Do the concatenation, which produces the result. */ TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclLocalScalarFromToken -- * * Get the index into the table of compiled locals that corresponds * to a local scalar variable name. * * Results: * Returns the non-negative integer index value into the table of * compiled locals corresponding to a local scalar variable name. * If the arguments passed in do not identify a local scalar variable * then return -1. * * Side effects: * May add an entry into the table of compiled locals. * *---------------------------------------------------------------------- */ int TclLocalScalarFromToken( Tcl_Token *tokenPtr, CompileEnv *envPtr) { int isScalar, index; TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar); if (!isScalar) { index = -1; } return index; } int TclLocalScalar( const char *bytes, int numBytes, CompileEnv *envPtr) { Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, {TCL_TOKEN_TEXT, NULL, 0, 0}}; token[1].start = bytes; token[1].size = numBytes; return TclLocalScalarFromToken(token, envPtr); } /* *---------------------------------------------------------------------- * * TclPushVarName -- * * Procedure used in the compiling where pushing a variable name is * necessary (append, lappend, set). * * Results: * The values written to *localIndexPtr and *isScalarPtr signal to * the caller what the instructions emitted by this routine will do: * * *isScalarPtr (*localIndexPtr < 0) * 1 1 Push the varname on the stack. (Stack +1) * 1 0 *localIndexPtr is the index of the compiled * local for this varname. No instructions * emitted. (Stack +0) * 0 1 Push part1 and part2 names of array element * on the stack. (Stack +2) * 0 0 *localIndexPtr is the index of the compiled * local for this array. Element name is pushed * on the stack. (Stack +1) * * Side effects: * Instructions are added to envPtr. * *---------------------------------------------------------------------- */ void TclPushVarName( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ int *localIndexPtr, /* Must not be NULL. */ int *isScalarPtr) /* Must not be NULL. */ { const char *p; const char *last, *name, *elName; int n; Tcl_Token *elemTokenPtr = NULL; int nameLen, elNameLen, simpleVarName, localIndex; int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; /* * Decide if we can use a frame slot for the var/array name or if we need * to emit code to compute and push the name at runtime. We use a frame * slot (entry in the array of local vars) if we are compiling a procedure * body and if the name is simple text that does not include namespace * qualifiers. */ simpleVarName = 0; name = elName = NULL; nameLen = elNameLen = 0; localIndex = -1; if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { /* * A simple variable name. Divide it up into "name" and "elName" * strings. If it is not a local variable, look it up at runtime. */ simpleVarName = 1; name = varTokenPtr[1].start; nameLen = varTokenPtr[1].size; if (name[nameLen-1] == ')') { /* * last char is ')' => potential array reference. */ last = &name[nameLen-1]; if (*last == ')') { for (p = name; p < last; p++) { if (*p == '(') { elName = p + 1; elNameLen = last - elName; nameLen = p - name; break; } } } if (!(flags & TCL_NO_ELEMENT) && elNameLen) { /* * An array element, the element name is a simple string: * assemble the corresponding token. */ elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, sizeof(Tcl_Token)); allocedTokens = 1; elemTokenPtr->type = TCL_TOKEN_TEXT; elemTokenPtr->start = elName; elemTokenPtr->size = elNameLen; elemTokenPtr->numComponents = 0; elemTokenCount = 1; } } } else if (interp && ((n = varTokenPtr->numComponents) > 1) && (varTokenPtr[1].type == TCL_TOKEN_TEXT) && (varTokenPtr[n].type == TCL_TOKEN_TEXT) && (*(varTokenPtr[n].start + varTokenPtr[n].size - 1) == ')')) { /* * Check for parentheses inside first token. */ simpleVarName = 0; for (p = varTokenPtr[1].start, last = p + varTokenPtr[1].size; p < last; p++) { if (*p == '(') { simpleVarName = 1; break; } } if (simpleVarName) { int remainingLen; /* * Check the last token: if it is just ')', do not count it. * Otherwise, remove the ')' and flag so that it is restored at * the end. */ if (varTokenPtr[n].size == 1) { n--; } else { varTokenPtr[n].size--; removedParen = n; } name = varTokenPtr[1].start; nameLen = p - varTokenPtr[1].start; elName = p + 1; remainingLen = (varTokenPtr[2].start - p) - 1; elNameLen = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1; if (!(flags & TCL_NO_ELEMENT)) { if (remainingLen) { /* * Make a first token with the extra characters in the first * token. */ elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token)); allocedTokens = 1; elemTokenPtr->type = TCL_TOKEN_TEXT; elemTokenPtr->start = elName; elemTokenPtr->size = remainingLen; elemTokenPtr->numComponents = 0; elemTokenCount = n; /* * Copy the remaining tokens. */ memcpy(elemTokenPtr+1, varTokenPtr+2, (n-1) * sizeof(Tcl_Token)); } else { /* * Use the already available tokens. */ elemTokenPtr = &varTokenPtr[2]; elemTokenCount = n - 1; } } } } if (simpleVarName) { /* * See whether name has any namespace separators (::'s). */ int hasNsQualifiers = 0; for (p = name, last = p + nameLen-1; p < last; p++) { if ((*p == ':') && (*(p+1) == ':')) { hasNsQualifiers = 1; break; } } /* * Look up the var name's index in the array of local vars in the proc * frame. If retrieving the var's value and it doesn't already exist, * push its name and look it up at runtime. */ if (!hasNsQualifiers) { localIndex = TclFindCompiledLocal(name, nameLen, 1, envPtr); if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { /* * We'll push the name. */ localIndex = -1; } } if (interp && localIndex < 0) { PushLiteral(envPtr, name, nameLen); } /* * Compile the element script, if any, and only if not inhibited. [Bug * 3600328] */ if (elName != NULL && !(flags & TCL_NO_ELEMENT)) { if (elNameLen) { TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr); } else { PushStringLiteral(envPtr, ""); } } } else if (interp) { /* * The var name isn't simple: compile and push it. */ CompileTokens(envPtr, varTokenPtr, interp); } if (removedParen) { varTokenPtr[removedParen].size++; } if (allocedTokens) { TclStackFree(interp, elemTokenPtr); } *localIndexPtr = localIndex; *isScalarPtr = (elName == NULL); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclCompCmdsGR.c0000644000175000017500000024535414554262142016100 0ustar sergeisergei/* * tclCompCmdsGR.c -- * * This file contains compilation procedures that compile various Tcl * commands (beginning with the letters 'g' through 'r') into a sequence * of instructions ("bytecodes"). * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2001 Kevin B. Kenny. All rights reserved. * Copyright (c) 2002 ActiveState Corporation. * Copyright (c) 2004-2013 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include /* * Prototypes for procedures defined later in this file: */ static void CompileReturnInternal(CompileEnv *envPtr, unsigned char op, int code, int level, Tcl_Obj *returnOpts); static int IndexTailVarIfKnown(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr); /* *---------------------------------------------------------------------- * * TclGetIndexFromToken -- * * Parse a token to determine if an index value is known at * compile time. * * Returns: * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. * * Side effects: * When TCL_OK is returned, the encoded index value is written * to *index. * *---------------------------------------------------------------------- */ int TclGetIndexFromToken( Tcl_Token *tokenPtr, int before, int after, int *indexPtr) { Tcl_Obj *tmpObj; int result = TCL_ERROR; TclNewObj(tmpObj); if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { result = TclIndexEncode(NULL, tmpObj, before, after, indexPtr); } Tcl_DecrRefCount(tmpObj); return result; } /* *---------------------------------------------------------------------- * * TclCompileGlobalCmd -- * * Procedure called to compile the "global" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "global" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileGlobalCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; int localIndex, numWords, i; /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords < 2) { return TCL_ERROR; } /* * 'global' has no effect outside of proc bodies; handle that at runtime */ if (envPtr->procPtr == NULL) { return TCL_ERROR; } /* * Push the namespace */ PushStringLiteral(envPtr, "::"); /* * Loop over the variables. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i=1; itokenPtr; wordIdx = 0; numWords = parsePtr->numWords; for (wordIdx = 0; wordIdx < numWords; wordIdx++) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); } TclInitJumpFixupArray(&jumpFalseFixupArray); TclInitJumpFixupArray(&jumpEndFixupArray); code = TCL_OK; /* * Each iteration of this loop compiles one "if expr ?then? body" or * "elseif expr ?then? body" clause. */ tokenPtr = parsePtr->tokenPtr; wordIdx = 0; while (wordIdx < numWords) { /* * Stop looping if the token isn't "if" or "elseif". */ word = tokenPtr[1].start; numBytes = tokenPtr[1].size; if ((tokenPtr == parsePtr->tokenPtr) || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) { tokenPtr = TokenAfter(tokenPtr); wordIdx++; } else { break; } if (wordIdx >= numWords) { code = TCL_ERROR; goto done; } /* * Compile the test expression then emit the conditional jump around * the "then" part. */ testTokenPtr = tokenPtr; if (realCond) { /* * Find out if the condition is a constant. */ Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size); Tcl_IncrRefCount(boolObj); code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); TclDecrRefCount(boolObj); if (code == TCL_OK) { /* * A static condition. */ realCond = 0; if (!boolVal) { compileScripts = 0; } } else { SetLineInformation(wordIdx); Tcl_ResetResult(interp); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) { TclExpandJumpFixupArray(&jumpFalseFixupArray); } jumpIndex = jumpFalseFixupArray.next; jumpFalseFixupArray.next++; TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, jumpFalseFixupArray.fixup + jumpIndex); } code = TCL_OK; } /* * Skip over the optional "then" before the then clause. */ tokenPtr = TokenAfter(testTokenPtr); wordIdx++; if (wordIdx >= numWords) { code = TCL_ERROR; goto done; } if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { word = tokenPtr[1].start; numBytes = tokenPtr[1].size; if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) { tokenPtr = TokenAfter(tokenPtr); wordIdx++; if (wordIdx >= numWords) { code = TCL_ERROR; goto done; } } } /* * Compile the "then" command body. */ if (compileScripts) { BODY(tokenPtr, wordIdx); } if (realCond) { /* * Jump to the end of the "if" command. Both jumpFalseFixupArray * and jumpEndFixupArray are indexed by "jumpIndex". */ if (jumpEndFixupArray.next >= jumpEndFixupArray.end) { TclExpandJumpFixupArray(&jumpEndFixupArray); } jumpEndFixupArray.next++; TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, jumpEndFixupArray.fixup + jumpIndex); /* * Fix the target of the jumpFalse after the test. Generate a 4 * byte jump if the distance is > 120 bytes. This is conservative, * and ensures that we won't have to replace this jump if we later * also need to replace the proceeding jump to the end of the "if" * with a 4 byte jump. */ TclAdjustStackDepth(-1, envPtr); if (TclFixupForwardJumpToHere(envPtr, jumpFalseFixupArray.fixup + jumpIndex, 120)) { /* * Adjust the code offset for the proceeding jump to the end * of the "if" command. */ jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3; } } else if (boolVal) { /* * We were processing an "if 1 {...}"; stop compiling scripts. */ compileScripts = 0; } else { /* * We were processing an "if 0 {...}"; reset so that the rest * (elseif, else) is compiled correctly. */ realCond = 1; compileScripts = 1; } tokenPtr = TokenAfter(tokenPtr); wordIdx++; } /* * Check for the optional else clause. Do not compile anything if this was * an "if 1 {...}" case. */ if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { /* * There is an else clause. Skip over the optional "else" word. */ word = tokenPtr[1].start; numBytes = tokenPtr[1].size; if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) { tokenPtr = TokenAfter(tokenPtr); wordIdx++; if (wordIdx >= numWords) { code = TCL_ERROR; goto done; } } if (compileScripts) { /* * Compile the else command body. */ BODY(tokenPtr, wordIdx); } /* * Make sure there are no words after the else clause. */ wordIdx++; if (wordIdx < numWords) { code = TCL_ERROR; goto done; } } else { /* * No else clause: the "if" command's result is an empty string. */ if (compileScripts) { PushStringLiteral(envPtr, ""); } } /* * Fix the unconditional jumps to the end of the "if" command. */ for (j = jumpEndFixupArray.next; j > 0; j--) { jumpIndex = (j - 1); /* i.e. process the closest jump first. */ if (TclFixupForwardJumpToHere(envPtr, jumpEndFixupArray.fixup+jumpIndex, 127)) { /* * Adjust the immediately preceding "ifFalse" jump. We moved it's * target (just after this jump) down three bytes. */ unsigned char *ifFalsePc = envPtr->codeStart + jumpFalseFixupArray.fixup[jumpIndex].codeOffset; unsigned char opCode = *ifFalsePc; if (opCode == INST_JUMP_FALSE1) { jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1); jumpFalseDist += 3; TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1)); } else if (opCode == INST_JUMP_FALSE4) { jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1); jumpFalseDist += 3; TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1)); } else { Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode); } } } /* * Free the jumpFixupArray array if malloc'ed storage was used. */ done: TclFreeJumpFixupArray(&jumpFalseFixupArray); TclFreeJumpFixupArray(&jumpEndFixupArray); return code; } /* *---------------------------------------------------------------------- * * TclCompileIncrCmd -- * * Procedure called to compile the "incr" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "incr" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileIncrCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *incrTokenPtr; int isScalar, localIndex, haveImmValue, immValue; if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX, &localIndex, &isScalar, 1); /* * If an increment is given, push it, but see first if it's a small * integer. */ haveImmValue = 0; immValue = 1; if (parsePtr->numWords == 3) { incrTokenPtr = TokenAfter(varTokenPtr); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { const char *word = incrTokenPtr[1].start; int numBytes = incrTokenPtr[1].size; int code; Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(intObj); code = TclGetIntFromObj(NULL, intObj, &immValue); TclDecrRefCount(intObj); if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) { haveImmValue = 1; } if (!haveImmValue) { PushLiteral(envPtr, word, numBytes); } } else { SetLineInformation(2); CompileTokens(envPtr, incrTokenPtr, interp); } } else { /* No incr amount given so use 1. */ haveImmValue = 1; } /* * Emit the instruction to increment the variable. */ if (isScalar) { /* Simple scalar variable. */ if (localIndex >= 0) { if (haveImmValue) { TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr); TclEmitInt1(immValue, envPtr); } else { TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr); } } else { if (haveImmValue) { TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr); } else { TclEmitOpcode( INST_INCR_STK, envPtr); } } } else { /* Simple array variable. */ if (localIndex >= 0) { if (haveImmValue) { TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr); TclEmitInt1(immValue, envPtr); } else { TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr); } } else { if (haveImmValue) { TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr); } else { TclEmitOpcode( INST_INCR_ARRAY_STK, envPtr); } } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileInfo*Cmd -- * * Procedures called to compile "info" subcommands. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "info" subcommand at * runtime. * *---------------------------------------------------------------------- */ int TclCompileInfoCommandsCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; const char *bytes; /* * We require one compile-time known argument for the case we can compile. */ if (parsePtr->numWords == 1) { return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { goto notCompilable; } bytes = Tcl_GetString(objPtr); /* * We require that the argument start with "::" and not have any of "*\[?" * in it. (Theoretically, we should look in only the final component, but * the difference is so slight given current naming practices.) */ if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) { goto notCompilable; } Tcl_DecrRefCount(objPtr); /* * Confirmed as a literal that will not frighten the horses. Compile. * The result must be made into a list. */ /* TODO: Just push the known value */ CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_STR_LEN, envPtr); TclEmitInstInt1( INST_JUMP_FALSE1, 7, envPtr); TclEmitInstInt4( INST_LIST, 1, envPtr); return TCL_OK; notCompilable: Tcl_DecrRefCount(objPtr); return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr); } int TclCompileInfoCoroutineCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Only compile [info coroutine] without arguments. */ if (parsePtr->numWords != 1) { return TCL_ERROR; } /* * Not much to do; we compile to a single instruction... */ TclEmitOpcode( INST_COROUTINE_NAME, envPtr); return TCL_OK; } int TclCompileInfoExistsCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int isScalar, localIndex; if (parsePtr->numWords != 2) { return TCL_ERROR; } /* * Decide if we can use a frame slot for the var/array name or if we need * to emit code to compute and push the name at runtime. We use a frame * slot (entry in the array of local vars) if we are compiling a procedure * body and if the name is simple text that does not include namespace * qualifiers. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, &isScalar, 1); /* * Emit instruction to check the variable for existence. */ if (isScalar) { if (localIndex < 0) { TclEmitOpcode( INST_EXIST_STK, envPtr); } else { TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode( INST_EXIST_ARRAY_STK, envPtr); } else { TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr); } } return TCL_OK; } int TclCompileInfoLevelCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Only compile [info level] without arguments or with a single argument. */ if (parsePtr->numWords == 1) { /* * Not much to do; we compile to a single instruction... */ TclEmitOpcode( INST_INFO_LEVEL_NUM, envPtr); } else if (parsePtr->numWords != 2) { return TCL_ERROR; } else { DefineLineInformation; /* TIP #280 */ /* * Compile the argument, then add the instruction to convert it into a * list of arguments. */ CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1); TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr); } return TCL_OK; } int TclCompileInfoObjectClassCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords != 2) { return TCL_ERROR; } CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_TCLOO_CLASS, envPtr); return TCL_OK; } int TclCompileInfoObjectIsACmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); /* * We only handle [info object isa object ]. The first three * words are compressed to a single token by the ensemble compilation * engine. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size < 1 || strncmp(tokenPtr[1].start, "object", tokenPtr[1].size)) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); /* * Issue the code. */ CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode( INST_TCLOO_IS_OBJECT, envPtr); return TCL_OK; } int TclCompileInfoObjectNamespaceCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords != 2) { return TCL_ERROR; } CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_TCLOO_NS, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLappendCmd -- * * Procedure called to compile the "lappend" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lappend" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileLappendCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *valueTokenPtr; int isScalar, localIndex, numWords, i; /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords < 3) { return TCL_ERROR; } if (numWords != 3 || envPtr->procPtr == NULL) { goto lappendMultiple; } /* * Decide if we can use a frame slot for the var/array name or if we * need to emit code to compute and push the name at runtime. We use a * frame slot (entry in the array of local vars) if we are compiling a * procedure body and if the name is simple text that does not include * namespace qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, 0, &localIndex, &isScalar, 1); /* * If we are doing an assignment, push the new value. In the no values * case, create an empty object. */ if (numWords > 2) { valueTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, valueTokenPtr, interp, 2); } /* * Emit instructions to set/get the variable. */ /* * The *_STK opcodes should be refactored to make better use of existing * LOAD/STORE instructions. */ if (isScalar) { if (localIndex < 0) { TclEmitOpcode( INST_LAPPEND_STK, envPtr); } else { Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode( INST_LAPPEND_ARRAY_STK, envPtr); } else { Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr); } } return TCL_OK; lappendMultiple: varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, 0, &localIndex, &isScalar, 1); valueTokenPtr = TokenAfter(varTokenPtr); for (i = 2 ; i < numWords ; i++) { CompileWord(envPtr, valueTokenPtr, interp, i); valueTokenPtr = TokenAfter(valueTokenPtr); } TclEmitInstInt4( INST_LIST, numWords - 2, envPtr); if (isScalar) { if (localIndex < 0) { TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr); } else { TclEmitInstInt4(INST_LAPPEND_LIST, localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode( INST_LAPPEND_LIST_ARRAY_STK, envPtr); } else { TclEmitInstInt4(INST_LAPPEND_LIST_ARRAY, localIndex,envPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLassignCmd -- * * Procedure called to compile the "lassign" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lassign" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileLassignCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int isScalar, localIndex, numWords, idx; numWords = parsePtr->numWords; /* * Check for command syntax error, but we'll punt that to runtime. */ if (numWords < 3) { return TCL_ERROR; } /* * Generate code to push list being taken apart by [lassign]. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); /* * Generate code to assign values from the list to variables. */ for (idx=0 ; idx= 0) { TclEmitOpcode( INST_DUP, envPtr); TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); } else { TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); TclEmitOpcode( INST_STORE_STK, envPtr); TclEmitOpcode( INST_POP, envPtr); } } else { if (localIndex >= 0) { TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); } else { TclEmitInstInt4(INST_OVER, 2, envPtr); TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); TclEmitOpcode( INST_POP, envPtr); } } } /* * Generate code to leave the rest of the list on the stack. */ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); TclEmitInt4( TCL_INDEX_END, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLindexCmd -- * * Procedure called to compile the "lindex" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lindex" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileLindexCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *idxTokenPtr, *valTokenPtr; int i, idx, numWords = parsePtr->numWords; /* * Quit if not enough args. */ /* TODO: Consider support for compiling expanded args. */ if (numWords <= 1) { return TCL_ERROR; } valTokenPtr = TokenAfter(parsePtr->tokenPtr); if (numWords != 3) { goto emitComplexLindex; } idxTokenPtr = TokenAfter(valTokenPtr); if (TclGetIndexFromToken(idxTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_BEFORE, &idx) == TCL_OK) { /* * The idxTokenPtr parsed as a valid index value and was * encoded as expected by INST_LIST_INDEX_IMM. * * NOTE: that we rely on indexing before a list producing the * same result as indexing after a list. */ CompileWord(envPtr, valTokenPtr, interp, 1); TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); return TCL_OK; } /* * If the value was not known at compile time, the conversion failed or * the value was negative, we just keep on going with the more complex * compilation. */ /* * Push the operands onto the stack. */ emitComplexLindex: for (i=1 ; inumWords == 1) { /* * [list] without arguments just pushes an empty object. */ PushStringLiteral(envPtr, ""); return TCL_OK; } /* * Test if all arguments are compile-time known. If they are, we can * implement with a simple push. */ numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); TclNewObj(listObj); for (i = 1; i < numWords && listObj != NULL; i++) { TclNewObj(objPtr); if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) { (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); } else { Tcl_DecrRefCount(objPtr); Tcl_DecrRefCount(listObj); listObj = NULL; } valueTokenPtr = TokenAfter(valueTokenPtr); } if (listObj != NULL) { TclEmitPush(TclAddLiteralObj(envPtr, listObj, NULL), envPtr); return TCL_OK; } /* * Push the all values onto the stack. */ numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); concat = build = 0; for (i = 1; i < numWords; i++) { if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) { TclEmitInstInt4( INST_LIST, build, envPtr); if (concat) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } build = 0; concat = 1; } CompileWord(envPtr, valueTokenPtr, interp, i); if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) { if (concat) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } else { concat = 1; } } else { build++; } valueTokenPtr = TokenAfter(valueTokenPtr); } if (build > 0) { TclEmitInstInt4( INST_LIST, build, envPtr); if (concat) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } } /* * If there was just one expanded word, we must ensure that it is a list * at this point. We use an [lrange ... 0 end] for this (instead of * [llength], as with literals) as we must drop any string representation * that might be hanging around. */ if (concat && numWords == 2) { TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); TclEmitInt4( TCL_INDEX_END, envPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLlengthCmd -- * * Procedure called to compile the "llength" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "llength" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileLlengthCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, varTokenPtr, interp, 1); TclEmitOpcode( INST_LIST_LENGTH, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLrangeCmd -- * * How to compile the "lrange" command. We only bother because we needed * the opcode anyway for "lassign". * *---------------------------------------------------------------------- */ int TclCompileLrangeCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *listTokenPtr; int idx1, idx2; if (parsePtr->numWords != 4) { return TCL_ERROR; } listTokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(listTokenPtr); if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER, &idx1) != TCL_OK) { return TCL_ERROR; } /* * Token was an index value, and we treat all "first" indices * before the list same as the start of the list. */ tokenPtr = TokenAfter(tokenPtr); if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, &idx2) != TCL_OK) { return TCL_ERROR; } /* * Token was an index value, and we treat all "last" indices * after the list same as the end of the list. */ /* * Issue instructions. It's not safe to skip doing the LIST_RANGE, as * we've not proved that the 'list' argument is really a list. Not that it * is worth trying to do that given current knowledge. */ CompileWord(envPtr, listTokenPtr, interp, 1); TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); TclEmitInt4( idx2, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLinsertCmd -- * * How to compile the "linsert" command. We only bother with the case * where the index is constant. * *---------------------------------------------------------------------- */ int TclCompileLinsertCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *listTokenPtr; int idx, i; if (parsePtr->numWords < 3) { return TCL_ERROR; } listTokenPtr = TokenAfter(parsePtr->tokenPtr); /* * Parse the index. Will only compile if it is constant and not an * _integer_ less than zero (since we reserve negative indices here for * end-relative indexing) or an end-based index greater than 'end' itself. */ tokenPtr = TokenAfter(listTokenPtr); /* * NOTE: This command treats all inserts at indices before the list * the same as inserts at the start of the list, and all inserts * after the list the same as inserts at the end of the list. We * make that transformation here so we can use the optimized bytecode * as much as possible. */ if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END, &idx) != TCL_OK) { return TCL_ERROR; } /* * There are four main cases. If there are no values to insert, this is * just a confirm-listiness check. If the index is '0', this is a prepend. * If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise, * this is a splice (== split, insert values as list, concat-3). */ CompileWord(envPtr, listTokenPtr, interp, 1); if (parsePtr->numWords == 3) { TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); TclEmitInt4( TCL_INDEX_END, envPtr); return TCL_OK; } for (i=3 ; inumWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } TclEmitInstInt4( INST_LIST, i-3, envPtr); if (idx == TCL_INDEX_START) { TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); } else if (idx == TCL_INDEX_END) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } else { /* * Here we handle two ranges for idx. First when idx > 0, we * want the first half of the split to end at index idx-1 and * the second half to start at index idx. * Second when idx < TCL_INDEX_END, indicating "end-N" indexing, * we want the first half of the split to end at index end-N and * the second half to start at index end-N+1. We accomplish this * with a preadjustment of the end-N value. * The root of this is that the commands [lrange] and [linsert] * differ in their interpretation of the "end" index. */ if (idx < TCL_INDEX_END) { idx++; } TclEmitInstInt4( INST_OVER, 1, envPtr); TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); TclEmitInt4( idx-1, envPtr); TclEmitInstInt4( INST_REVERSE, 3, envPtr); TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); TclEmitInt4( TCL_INDEX_END, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLreplaceCmd -- * * How to compile the "lreplace" command. We only bother with the case * where the indices are constant. * *---------------------------------------------------------------------- */ int TclCompileLreplaceCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *listTokenPtr; int idx1, idx2, i; int emptyPrefix=1, suffixStart = 0; if (parsePtr->numWords < 4) { return TCL_ERROR; } listTokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(listTokenPtr); if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER, &idx1) != TCL_OK) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, &idx2) != TCL_OK) { return TCL_ERROR; } /* * General structure of the [lreplace] result is * prefix replacement suffix * In a few cases we can predict various parts will be empty and * take advantage. * * The proper suffix begins with the greater of indices idx1 or * idx2 + 1. If we cannot tell at compile time which is greater, * we must defer to direct evaluation. */ if (idx1 == TCL_INDEX_AFTER) { suffixStart = idx1; } else if (idx2 == TCL_INDEX_BEFORE) { suffixStart = idx1; } else if (idx2 == TCL_INDEX_END) { suffixStart = TCL_INDEX_AFTER; } else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END)) || ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) { suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1; } else { return TCL_ERROR; } /* All paths start with computing/pushing the original value. */ CompileWord(envPtr, listTokenPtr, interp, 1); /* * Push all the replacement values next so any errors raised in * creating them get raised first. */ if (parsePtr->numWords > 4) { /* Push the replacement arguments */ tokenPtr = TokenAfter(tokenPtr); for (i=4 ; inumWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } /* Make a list of them... */ TclEmitInstInt4( INST_LIST, i - 4, envPtr); emptyPrefix = 0; } if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) { /* * This is a "no-op". Example: [lreplace {a b c} 2 0] * We still do a list operation to get list-verification * and canonicalization side effects. */ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); TclEmitInt4( TCL_INDEX_END, envPtr); return TCL_OK; } if (idx1 != TCL_INDEX_START) { /* Prefix may not be empty; generate bytecode to push it */ if (emptyPrefix) { TclEmitOpcode( INST_DUP, envPtr); } else { TclEmitInstInt4( INST_OVER, 1, envPtr); } TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); TclEmitInt4( idx1 - 1, envPtr); if (!emptyPrefix) { TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); } emptyPrefix = 0; } if (!emptyPrefix) { TclEmitInstInt4( INST_REVERSE, 2, envPtr); } if (suffixStart == TCL_INDEX_AFTER) { TclEmitOpcode( INST_POP, envPtr); if (emptyPrefix) { PushStringLiteral(envPtr, ""); } } else { /* Suffix may not be empty; generate bytecode to push it */ TclEmitInstInt4( INST_LIST_RANGE_IMM, suffixStart, envPtr); TclEmitInt4( TCL_INDEX_END, envPtr); if (!emptyPrefix) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLsetCmd -- * * Procedure called to compile the "lset" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lset" command at * runtime. * * The general template for execution of the "lset" command is: * (1) Instructions to push the variable name, unless the variable is * local to the stack frame. * (2) If the variable is an array element, instructions to push the * array element name. * (3) Instructions to push each of zero or more "index" arguments to the * stack, followed with the "newValue" element. * (4) Instructions to duplicate the variable name and/or array element * name onto the top of the stack, if either was pushed at steps (1) * and (2). * (5) The appropriate INST_LOAD_* instruction to place the original * value of the list variable at top of stack. * (6) At this point, the stack contains: * varName? arrayElementName? index1 index2 ... newValue oldList * The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST * according as whether there is exactly one index element (LIST) or * either zero or else two or more (FLAT). This instruction removes * everything from the stack except for the two names and pushes the * new value of the variable. * (7) Finally, INST_STORE_* stores the new value in the variable and * cleans up the stack. * *---------------------------------------------------------------------- */ int TclCompileLsetCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int tempDepth; /* Depth used for emitting one part of the * code burst. */ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the variable name. */ int localIndex; /* Index of var in local var table. */ int isScalar; /* Flag == 1 if scalar, 0 if array. */ int i; /* * Check argument count. */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { /* * Fail at run time, not in compilation. */ return TCL_ERROR; } /* * Decide if we can use a frame slot for the var/array name or if we need * to emit code to compute and push the name at runtime. We use a frame * slot (entry in the array of local vars) if we are compiling a procedure * body and if the name is simple text that does not include namespace * qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, 0, &localIndex, &isScalar, 1); /* * Push the "index" args and the new element value. */ for (i=2 ; inumWords ; ++i) { varTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, varTokenPtr, interp, i); } /* * Duplicate the variable name if it's been pushed. */ if (localIndex < 0) { if (isScalar) { tempDepth = parsePtr->numWords - 2; } else { tempDepth = parsePtr->numWords - 1; } TclEmitInstInt4( INST_OVER, tempDepth, envPtr); } /* * Duplicate an array index if one's been pushed. */ if (!isScalar) { if (localIndex < 0) { tempDepth = parsePtr->numWords - 1; } else { tempDepth = parsePtr->numWords - 2; } TclEmitInstInt4( INST_OVER, tempDepth, envPtr); } /* * Emit code to load the variable's value. */ if (isScalar) { if (localIndex < 0) { TclEmitOpcode( INST_LOAD_STK, envPtr); } else { Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr); } else { Emit14Inst( INST_LOAD_ARRAY, localIndex, envPtr); } } /* * Emit the correct variety of 'lset' instruction. */ if (parsePtr->numWords == 4) { TclEmitOpcode( INST_LSET_LIST, envPtr); } else { TclEmitInstInt4( INST_LSET_FLAT, parsePtr->numWords-1, envPtr); } /* * Emit code to put the value back in the variable. */ if (isScalar) { if (localIndex < 0) { TclEmitOpcode( INST_STORE_STK, envPtr); } else { Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); } else { Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileNamespace*Cmd -- * * Procedures called to compile the "namespace" command; currently, only * the subcommands "namespace current" and "namespace upvar" are compiled * to bytecodes, and the latter only inside a procedure(-like) context. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "namespace upvar" * command at runtime. * *---------------------------------------------------------------------- */ int TclCompileNamespaceCurrentCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Only compile [namespace current] without arguments. */ if (parsePtr->numWords != 1) { return TCL_ERROR; } /* * Not much to do; we compile to a single instruction... */ TclEmitOpcode( INST_NS_CURRENT, envPtr); return TCL_OK; } int TclCompileNamespaceCodeCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); /* * The specification of [namespace code] is rather shocking, in that it is * supposed to check if the argument is itself the result of [namespace * code] and not apply itself in that case. Which is excessively cautious, * but what the test suite checks for. */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || (tokenPtr[1].size > 20 && strncmp(tokenPtr[1].start, "::namespace inscope ", 20) == 0)) { /* * Technically, we could just pass a literal '::namespace inscope ' * term through, but that's something which really shouldn't be * occurring as something that the user writes so we'll just punt it. */ return TCL_ERROR; } /* * Now we can compile using the same strategy as [namespace code]'s normal * implementation does internally. Note that we can't bind the namespace * name directly here, because TclOO plays complex games with namespaces; * the value needs to be determined at runtime for safety. */ PushStringLiteral(envPtr, "::namespace"); PushStringLiteral(envPtr, "inscope"); TclEmitOpcode( INST_NS_CURRENT, envPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitInstInt4( INST_LIST, 4, envPtr); return TCL_OK; } int TclCompileNamespaceOriginCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_ORIGIN_COMMAND, envPtr); return TCL_OK; } int TclCompileNamespaceQualifiersCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); int off; if (parsePtr->numWords != 2) { return TCL_ERROR; } CompileWord(envPtr, tokenPtr, interp, 1); PushStringLiteral(envPtr, "0"); PushStringLiteral(envPtr, "::"); TclEmitInstInt4( INST_OVER, 2, envPtr); TclEmitOpcode( INST_STR_FIND_LAST, envPtr); off = CurrentOffset(envPtr); PushStringLiteral(envPtr, "1"); TclEmitOpcode( INST_SUB, envPtr); TclEmitInstInt4( INST_OVER, 2, envPtr); TclEmitInstInt4( INST_OVER, 1, envPtr); TclEmitOpcode( INST_STR_INDEX, envPtr); PushStringLiteral(envPtr, ":"); TclEmitOpcode( INST_STR_EQ, envPtr); off = off - CurrentOffset(envPtr); TclEmitInstInt1( INST_JUMP_TRUE1, off, envPtr); TclEmitOpcode( INST_STR_RANGE, envPtr); return TCL_OK; } int TclCompileNamespaceTailCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); JumpFixup jumpFixup; if (parsePtr->numWords != 2) { return TCL_ERROR; } /* * Take care; only add 2 to found index if the string was actually found. */ CompileWord(envPtr, tokenPtr, interp, 1); PushStringLiteral(envPtr, "::"); TclEmitInstInt4( INST_OVER, 1, envPtr); TclEmitOpcode( INST_STR_FIND_LAST, envPtr); TclEmitOpcode( INST_DUP, envPtr); PushStringLiteral(envPtr, "0"); TclEmitOpcode( INST_GE, envPtr); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup); PushStringLiteral(envPtr, "2"); TclEmitOpcode( INST_ADD, envPtr); TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127); PushStringLiteral(envPtr, "end"); TclEmitOpcode( INST_STR_RANGE, envPtr); return TCL_OK; } int TclCompileNamespaceUpvarCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; int localIndex, numWords, i; if (envPtr->procPtr == NULL) { return TCL_ERROR; } /* * Only compile [namespace upvar ...]: needs an even number of args, >=4 */ numWords = parsePtr->numWords; if ((numWords % 2) || (numWords < 4)) { return TCL_ERROR; } /* * Push the namespace */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); /* * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a * local variable, return an error so that the non-compiled command will * be called at runtime. */ localTokenPtr = tokenPtr; for (i=2; inumWords < 2 || parsePtr->numWords > 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); idx = 1; /* * If there's an option, check that it's "-command". We don't handle * "-variable" (currently) and anything else is an error. */ if (parsePtr->numWords == 3) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } opt = tokenPtr + 1; if (opt->size < 2 || opt->size > 8 || strncmp(opt->start, "-command", opt->size) != 0) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); idx++; } /* * Issue the bytecode. */ CompileWord(envPtr, tokenPtr, interp, idx); TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileRegexpCmd -- * * Procedure called to compile the "regexp" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "regexp" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileRegexpCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the RE or string. */ int len; int i, nocase, exact, sawLast, simple; const char *str; /* * We are only interested in compiling simple regexp cases. Currently * supported compile cases are: * regexp ?-nocase? ?--? staticString $var * regexp ?-nocase? ?--? {^staticString$} $var */ if (parsePtr->numWords < 3) { return TCL_ERROR; } simple = 0; nocase = 0; sawLast = 0; varTokenPtr = parsePtr->tokenPtr; /* * We only look for -nocase and -- as options. Everything else gets pushed * to runtime execution. This is different than regexp's runtime option * handling, but satisfies our stricter needs. */ for (i = 1; i < parsePtr->numWords - 2; i++) { varTokenPtr = TokenAfter(varTokenPtr); if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * Not a simple string, so punt to runtime. */ return TCL_ERROR; } str = varTokenPtr[1].start; len = varTokenPtr[1].size; if ((len == 2) && (str[0] == '-') && (str[1] == '-')) { sawLast++; i++; break; } else if ((len > 1) && (strncmp(str, "-nocase", len) == 0)) { nocase = 1; } else { /* * Not an option we recognize. */ return TCL_ERROR; } } if ((parsePtr->numWords - i) != 2) { /* * We don't support capturing to variables. */ return TCL_ERROR; } /* * Get the regexp string. If it is not a simple string or can't be * converted to a glob pattern, push the word for the INST_REGEXP. * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp. */ varTokenPtr = TokenAfter(varTokenPtr); if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { Tcl_DString ds; str = varTokenPtr[1].start; len = varTokenPtr[1].size; /* * If it has a '-', it could be an incorrectly formed regexp command. */ if ((*str == '-') && !sawLast) { return TCL_ERROR; } if (len == 0) { /* * The semantics of regexp are always match on re == "". */ PushStringLiteral(envPtr, "1"); return TCL_OK; } /* * Attempt to convert pattern to glob. If successful, push the * converted pattern as a literal. */ if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL) == TCL_OK) { simple = 1; PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); } } if (!simple) { CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2); } /* * Push the string arg. */ varTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1); if (simple) { if (exact && !nocase) { TclEmitOpcode( INST_STR_EQ, envPtr); } else { TclEmitInstInt1( INST_STR_MATCH, nocase, envPtr); } } else { /* * Pass correct RE compile flags. We use only Int1 (8-bit), but * that handles all the flags we want to pass. * Don't use TCL_REG_NOSUB as we may have backrefs. */ int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0); TclEmitInstInt1( INST_REGEXP, cflags, envPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileRegsubCmd -- * * Procedure called to compile the "regsub" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "regsub" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileRegsubCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { /* * We only compile the case with [regsub -all] where the pattern is both * known at compile time and simple (i.e., no RE metacharacters). That is, * the pattern must be translatable into a glob like "*foo*" with no other * glob metacharacters inside it; there must be some "foo" in there too. * The substitution string must also be known at compile time and free of * metacharacters ("\digit" and "&"). Finally, there must not be a * variable mentioned in the [regsub] to write the result back to (because * we can't get the count of substitutions that would be the result in * that case). The key is that these are the conditions under which a * [string map] could be used instead, in particular a [string map] of the * form we can compile to bytecode. * * In short, we look for: * * regsub -all [--] simpleRE string simpleReplacement * * The only optional part is the "--", and no other options are handled. */ DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *stringTokenPtr; Tcl_Obj *patternObj = NULL, *replacementObj = NULL; Tcl_DString pattern; const char *bytes; int exact, quantified, result = TCL_ERROR; int len; if (parsePtr->numWords < 5 || parsePtr->numWords > 6) { return TCL_ERROR; } /* * Parse the "-all", which must be the first argument (other options not * supported, non-"-all" substitution we can't compile). */ tokenPtr = TokenAfter(parsePtr->tokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 4 || strncmp(tokenPtr[1].start, "-all", 4)) { return TCL_ERROR; } /* * Get the pattern into patternObj, checking for "--" in the process. */ Tcl_DStringInit(&pattern); tokenPtr = TokenAfter(tokenPtr); TclNewObj(patternObj); if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } if (Tcl_GetString(patternObj)[0] == '-') { if (strcmp(Tcl_GetString(patternObj), "--") != 0 || parsePtr->numWords == 5) { goto done; } tokenPtr = TokenAfter(tokenPtr); Tcl_DecrRefCount(patternObj); TclNewObj(patternObj); if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } } else if (parsePtr->numWords == 6) { goto done; } /* * Identify the code which produces the string to apply the substitution * to (stringTokenPtr), and the replacement string (into replacementObj). */ stringTokenPtr = TokenAfter(tokenPtr); tokenPtr = TokenAfter(stringTokenPtr); TclNewObj(replacementObj); if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) { goto done; } /* * Next, higher-level checks. Is the RE a very simple glob? Is the * replacement "simple"? */ bytes = Tcl_GetStringFromObj(patternObj, &len); if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified) != TCL_OK || exact || quantified) { goto done; } bytes = Tcl_DStringValue(&pattern); if (*bytes++ != '*') { goto done; } while (1) { switch (*bytes) { case '*': if (bytes[1] == '\0') { /* * OK, we've proved there are no metacharacters except for the * '*' at each end. */ len = Tcl_DStringLength(&pattern) - 2; if (len > 0) { goto isSimpleGlob; } /* * The pattern is "**"! I believe that should be impossible, * but we definitely can't handle that at all. */ } case '\0': case '?': case '[': case '\\': goto done; } bytes++; } isSimpleGlob: for (bytes = Tcl_GetString(replacementObj); *bytes; bytes++) { switch (*bytes) { case '\\': case '&': goto done; } } /* * Proved the simplicity constraints! Time to issue the code. */ result = TCL_OK; bytes = Tcl_DStringValue(&pattern) + 1; PushLiteral(envPtr, bytes, len); bytes = Tcl_GetStringFromObj(replacementObj, &len); PushLiteral(envPtr, bytes, len); CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2); TclEmitOpcode( INST_STR_MAP, envPtr); done: Tcl_DStringFree(&pattern); if (patternObj) { Tcl_DecrRefCount(patternObj); } if (replacementObj) { Tcl_DecrRefCount(replacementObj); } return result; } /* *---------------------------------------------------------------------- * * TclCompileReturnCmd -- * * Procedure called to compile the "return" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "return" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileReturnCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ /* * General syntax: [return ?-option value ...? ?result?] * An even number of words means an explicit result argument is present. */ int level, code, objc, status = TCL_OK; int size; int numWords = parsePtr->numWords; int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; Tcl_Obj *returnOpts, **objv; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); /* * Check for special case which can always be compiled: * return -options * Unlike the normal [return] compilation, this version does everything at * runtime so it can handle arbitrary words and not just literals. Note * that if INST_RETURN_STK wasn't already needed for something else * ('finally' clause processing) this piece of code would not be present. */ if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) && (wordTokenPtr[1].size == 8) && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) { Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); CompileWord(envPtr, optsTokenPtr, interp, 2); CompileWord(envPtr, msgTokenPtr, interp, 3); TclEmitInvoke(envPtr, INST_RETURN_STK); return TCL_OK; } /* * Allocate some working space. */ objv = (Tcl_Obj **)TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *)); /* * Scan through the return options. If any are unknown at compile time, * there is no value in bytecompiling. Save the option values known in an * objv array for merging into a return options dictionary. * * TODO: There is potential for improvement if all option keys are known * at compile time and all option values relating to '-code' and '-level' * are known at compile time. */ for (objc = 0; objc < numOptionWords; objc++) { TclNewObj(objv[objc]); Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { /* * Non-literal, so punt to run-time assembly of the dictionary. */ for (; objc>=0 ; objc--) { TclDecrRefCount(objv[objc]); } TclStackFree(interp, objv); goto issueRuntimeReturn; } wordTokenPtr = TokenAfter(wordTokenPtr); } status = TclMergeReturnOptions(interp, objc, objv, &returnOpts, &code, &level); while (--objc >= 0) { TclDecrRefCount(objv[objc]); } TclStackFree(interp, objv); if (TCL_ERROR == status) { /* * Something was bogus in the return options. Clear the error message, * and report back to the compiler that this must be interpreted at * runtime. */ Tcl_ResetResult(interp); return TCL_ERROR; } /* * All options are known at compile time, so we're going to bytecompile. * Emit instructions to push the result on the stack. */ if (explicitResult) { CompileWord(envPtr, wordTokenPtr, interp, numWords - 1); } else { /* * No explict result argument, so default result is empty string. */ PushStringLiteral(envPtr, ""); } /* * Check for optimization: When [return] is in a proc, and there's no * enclosing [catch], and there are no return options, then the INST_DONE * instruction is equivalent, and may be more efficient. */ if (numOptionWords == 0 && envPtr->procPtr != NULL) { /* * We have default return options and we're in a proc ... */ int index = envPtr->exceptArrayNext - 1; int enclosingCatch = 0; while (index >= 0) { ExceptionRange range = envPtr->exceptArrayPtr[index]; if ((range.type == CATCH_EXCEPTION_RANGE) && (range.catchOffset == -1)) { enclosingCatch = 1; break; } index--; } if (!enclosingCatch) { /* * ... and there is no enclosing catch. Issue the maximally * efficient exit instruction. */ Tcl_DecrRefCount(returnOpts); TclEmitOpcode(INST_DONE, envPtr); TclAdjustStackDepth(1, envPtr); return TCL_OK; } } /* Optimize [return -level 0 $x]. */ Tcl_DictObjSize(NULL, returnOpts, &size); if (size == 0 && level == 0 && code == TCL_OK) { Tcl_DecrRefCount(returnOpts); return TCL_OK; } /* * Could not use the optimization, so we push the return options dict, and * emit the INST_RETURN_IMM instruction with code and level as operands. */ CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts); return TCL_OK; issueRuntimeReturn: /* * Assemble the option dictionary (as a list as that's good enough). */ wordTokenPtr = TokenAfter(parsePtr->tokenPtr); for (objc=1 ; objc<=numOptionWords ; objc++) { CompileWord(envPtr, wordTokenPtr, interp, objc); wordTokenPtr = TokenAfter(wordTokenPtr); } TclEmitInstInt4(INST_LIST, numOptionWords, envPtr); /* * Push the result. */ if (explicitResult) { CompileWord(envPtr, wordTokenPtr, interp, numWords - 1); } else { PushStringLiteral(envPtr, ""); } /* * Issue the RETURN itself. */ TclEmitInvoke(envPtr, INST_RETURN_STK); return TCL_OK; } static void CompileReturnInternal( CompileEnv *envPtr, unsigned char op, int code, int level, Tcl_Obj *returnOpts) { if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) { ExceptionRange *rangePtr; ExceptionAux *exceptAux; rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { TclCleanupStackForBreakContinue(envPtr, exceptAux); if (code == TCL_BREAK) { TclAddLoopBreakFixup(envPtr, exceptAux); } else { TclAddLoopContinueFixup(envPtr, exceptAux); } Tcl_DecrRefCount(returnOpts); return; } } TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr); TclEmitInstInt4(op, code, envPtr); TclEmitInt4(level, envPtr); } void TclCompileSyntaxError( Tcl_Interp *interp, CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); int numBytes; const char *bytes = TclGetStringFromObj(msg, &numBytes); TclErrorStackResetIf(interp, bytes, numBytes); TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr); CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR))); Tcl_ResetResult(interp); } /* *---------------------------------------------------------------------- * * TclCompileUpvarCmd -- * * Procedure called to compile the "upvar" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "upvar" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileUpvarCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; int localIndex, numWords, i; Tcl_Obj *objPtr; if (envPtr->procPtr == NULL) { return TCL_ERROR; } numWords = parsePtr->numWords; if (numWords < 3) { return TCL_ERROR; } /* * Push the frame index if it is known at compile time */ TclNewObj(objPtr); tokenPtr = TokenAfter(parsePtr->tokenPtr); if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) { CallFrame *framePtr; const Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr; /* * Attempt to convert to a level reference. Note that TclObjGetFrame * only changes the obj type when a conversion was successful. */ TclObjGetFrame(interp, objPtr, &framePtr); newTypePtr = objPtr->typePtr; Tcl_DecrRefCount(objPtr); if (newTypePtr != typePtr) { if (numWords%2) { return TCL_ERROR; } /* TODO: Push the known value instead? */ CompileWord(envPtr, tokenPtr, interp, 1); otherTokenPtr = TokenAfter(tokenPtr); i = 2; } else { if (!(numWords%2)) { return TCL_ERROR; } PushStringLiteral(envPtr, "1"); otherTokenPtr = tokenPtr; i = 1; } } else { Tcl_DecrRefCount(objPtr); return TCL_ERROR; } /* * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a * local variable, return an error so that the non-compiled command will * be called at runtime. */ for (; inumWords; if (numWords < 2) { return TCL_ERROR; } /* * Bail out if not compiling a proc body */ if (envPtr->procPtr == NULL) { return TCL_ERROR; } /* * Loop over the (var, value) pairs. */ valueTokenPtr = parsePtr->tokenPtr; for (i=1; inumComponents; int len; Tcl_Token *lastTokenPtr; int full, localIndex; /* * Determine if the tail is (a) known at compile time, and (b) not an * array element. Should any of these fail, return an error so that the * non-compiled command will be called at runtime. * * In order for the tail to be known at compile time, the last token in * the word has to be constant and contain "::" if it is not the only one. */ if (!EnvHasLVT(envPtr)) { return -1; } TclNewObj(tailPtr); if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) { full = 1; lastTokenPtr = varTokenPtr; } else { full = 0; lastTokenPtr = varTokenPtr + n; if (lastTokenPtr->type != TCL_TOKEN_TEXT) { Tcl_DecrRefCount(tailPtr); return -1; } Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size); } tailName = TclGetStringFromObj(tailPtr, &len); if (len) { if (*(tailName + len - 1) == ')') { /* * Possible array: bail out */ Tcl_DecrRefCount(tailPtr); return -1; } /* * Get the tail: immediately after the last '::' */ for (p = tailName + len -1; p > tailName; p--) { if ((*p == ':') && (*(p - 1) == ':')) { p++; break; } } if (!full && (p == tailName)) { /* * No :: in the last component. */ Tcl_DecrRefCount(tailPtr); return -1; } len -= p - tailName; tailName = p; } localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr); Tcl_DecrRefCount(tailPtr); return localIndex; } /* * ---------------------------------------------------------------------- * * TclCompileObjectNextCmd, TclCompileObjectSelfCmd -- * * Compilations of the TclOO utility commands [next] and [self]. * * ---------------------------------------------------------------------- */ int TclCompileObjectNextCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; if (parsePtr->numWords > 255) { return TCL_ERROR; } for (i=0 ; inumWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr); return TCL_OK; } int TclCompileObjectNextToCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; if (parsePtr->numWords < 2 || parsePtr->numWords > 255) { return TCL_ERROR; } for (i=0 ; inumWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt1( INST_TCLOO_NEXT_CLASS, i, envPtr); return TCL_OK; } int TclCompileObjectSelfCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * We only handle [self] and [self object] (which is the same operation). * These are the only very common operations on [self] for which * bytecoding is at all reasonable. */ if (parsePtr->numWords == 1) { goto compileSelfObject; } else if (parsePtr->numWords == 2) { Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr), *subcmd; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size==0) { return TCL_ERROR; } subcmd = tokenPtr + 1; if (strncmp(subcmd->start, "object", subcmd->size) == 0) { goto compileSelfObject; } else if (strncmp(subcmd->start, "namespace", subcmd->size) == 0) { goto compileSelfNamespace; } } /* * Can't compile; handle with runtime call. */ return TCL_ERROR; compileSelfObject: /* * This delegates the entire problem to a single opcode. */ TclEmitOpcode( INST_TCLOO_SELF, envPtr); return TCL_OK; compileSelfNamespace: /* * This is formally only correct with TclOO methods as they are currently * implemented; it assumes that the current namespace is invariably when a * TclOO context is present is the object's namespace, and that's * technically only something that's a matter of current policy. But it * avoids creating another opcode, so that's all good! */ TclEmitOpcode( INST_TCLOO_SELF, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitOpcode( INST_NS_CURRENT, envPtr); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclCompCmdsSZ.c0000644000175000017500000036733514554262142016130 0ustar sergeisergei/* * tclCompCmdsSZ.c -- * * This file contains compilation procedures that compile various Tcl * commands (beginning with the letters 's' through 'z', except for * [upvar] and [variable]) into a sequence of instructions ("bytecodes"). * Also includes the operator command compilers. * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2001 Kevin B. Kenny. All rights reserved. * Copyright (c) 2002 ActiveState Corporation. * Copyright (c) 2004-2010 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include "tclStringTrim.h" /* * Prototypes for procedures defined later in this file: */ static AuxDataDupProc DupJumptableInfo; static AuxDataFreeProc FreeJumptableInfo; static AuxDataPrintProc PrintJumptableInfo; static AuxDataPrintProc DisassembleJumptableInfo; static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr); static int CompileComparisonOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr); static int CompileStrictlyBinaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr); static int CompileUnaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr); static void IssueSwitchChainedTests(Tcl_Interp *interp, CompileEnv *envPtr, int mode, int noCase, int numWords, Tcl_Token **bodyToken, int *bodyLines, int **bodyNext); static void IssueSwitchJumpTable(Tcl_Interp *interp, CompileEnv *envPtr, int numWords, Tcl_Token **bodyToken, int *bodyLines, int **bodyContLines); static int IssueTryClausesInstructions(Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, int numHandlers, int *matchCodes, Tcl_Obj **matchClauses, int *resultVarIndices, int *optionVarIndices, Tcl_Token **handlerTokens); static int IssueTryClausesFinallyInstructions(Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, int numHandlers, int *matchCodes, Tcl_Obj **matchClauses, int *resultVarIndices, int *optionVarIndices, Tcl_Token **handlerTokens, Tcl_Token *finallyToken); static int IssueTryFinallyInstructions(Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, Tcl_Token *finallyToken); /* * The structures below define the AuxData types defined in this file. */ const AuxDataType tclJumptableInfoType = { "JumptableInfo", /* name */ DupJumptableInfo, /* dupProc */ FreeJumptableInfo, /* freeProc */ PrintJumptableInfo, /* printProc */ DisassembleJumptableInfo /* disassembleProc */ }; /* * Shorthand macros for instruction issuing. */ #define OP(name) TclEmitOpcode(INST_##name, envPtr) #define OP1(name,val) TclEmitInstInt1(INST_##name,(val),envPtr) #define OP4(name,val) TclEmitInstInt4(INST_##name,(val),envPtr) #define OP14(name,val1,val2) \ TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) #define OP44(name,val1,val2) \ TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) #define PUSH(str) \ PushStringLiteral(envPtr, str) #define JUMP4(name,var) \ (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr) #define FIXJUMP4(var) \ TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1) #define JUMP1(name,var) \ (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr) #define FIXJUMP1(var) \ TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1) #define LOAD(idx) \ if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));} #define STORE(idx) \ if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} #define INVOKE(name) \ TclEmitInvoke(envPtr,INST_##name) /* *---------------------------------------------------------------------- * * TclCompileSetCmd -- * * Procedure called to compile the "set" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "set" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileSetCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *valueTokenPtr; int isAssignment, isScalar, localIndex, numWords; numWords = parsePtr->numWords; if ((numWords != 2) && (numWords != 3)) { return TCL_ERROR; } isAssignment = (numWords == 3); /* * Decide if we can use a frame slot for the var/array name or if we need * to emit code to compute and push the name at runtime. We use a frame * slot (entry in the array of local vars) if we are compiling a procedure * body and if the name is simple text that does not include namespace * qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, 0, &localIndex, &isScalar, 1); /* * If we are doing an assignment, push the new value. */ if (isAssignment) { valueTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, valueTokenPtr, interp, 2); } /* * Emit instructions to set/get the variable. */ if (isScalar) { if (localIndex < 0) { TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr); } else if (localIndex <= 255) { TclEmitInstInt1((isAssignment? INST_STORE_SCALAR1 : INST_LOAD_SCALAR1), localIndex, envPtr); } else { TclEmitInstInt4((isAssignment? INST_STORE_SCALAR4 : INST_LOAD_SCALAR4), localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode((isAssignment? INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr); } else if (localIndex <= 255) { TclEmitInstInt1((isAssignment? INST_STORE_ARRAY1 : INST_LOAD_ARRAY1), localIndex, envPtr); } else { TclEmitInstInt4((isAssignment? INST_STORE_ARRAY4 : INST_LOAD_ARRAY4), localIndex, envPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileString*Cmd -- * * Procedures called to compile various subcommands of the "string" * command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "string" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileStringCatCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int i, numWords = parsePtr->numWords, numArgs; Tcl_Token *wordTokenPtr; Tcl_Obj *obj, *folded; /* Trivial case, no arg */ if (numWords<2) { PushStringLiteral(envPtr, ""); return TCL_OK; } /* General case: issue CONCAT1's (by chunks of 254 if needed), folding contiguous constants along the way */ numArgs = 0; folded = NULL; wordTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { TclNewObj(obj); if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) { if (folded) { Tcl_AppendObjToObj(folded, obj); Tcl_DecrRefCount(obj); } else { folded = obj; } } else { Tcl_DecrRefCount(obj); if (folded) { int len; const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(folded); folded = NULL; numArgs ++; } CompileWord(envPtr, wordTokenPtr, interp, i); numArgs ++; if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */ TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr); numArgs = 1; /* concat pushes 1 obj, the result */ } } wordTokenPtr = TokenAfter(wordTokenPtr); } if (folded) { int len; const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(folded); folded = NULL; numArgs ++; } if (numArgs > 1) { TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr); } return TCL_OK; } int TclCompileStringCmpCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * We don't support any flags; the bytecode isn't that sophisticated. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } /* * Push the two operands onto the stack and then the test. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_CMP, envPtr); return TCL_OK; } int TclCompileStringEqualCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * We don't support any flags; the bytecode isn't that sophisticated. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } /* * Push the two operands onto the stack and then the test. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_EQ, envPtr); return TCL_OK; } int TclCompileStringFirstCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * We don't support any flags; the bytecode isn't that sophisticated. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } /* * Push the two operands onto the stack and then the test. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); OP(STR_FIND); return TCL_OK; } int TclCompileStringLastCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * We don't support any flags; the bytecode isn't that sophisticated. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } /* * Push the two operands onto the stack and then the test. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); OP(STR_FIND_LAST); return TCL_OK; } int TclCompileStringIndexCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 3) { return TCL_ERROR; } /* * Push the two operands onto the stack and then the index operation. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_INDEX, envPtr); return TCL_OK; } int TclCompileStringIsCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); static const char *const isClasses[] = { "alnum", "alpha", "ascii", "control", "boolean", "digit", "double", "entier", "false", "graph", "integer", "list", "lower", "print", "punct", "space", "true", "upper", "wideinteger", "wordchar", "xdigit", NULL }; enum isClassesEnum { STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL, STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT }; int t, range, allowEmpty = 0, end; InstStringClassType strClassType; Tcl_Obj *isClass; if (parsePtr->numWords < 3 || parsePtr->numWords > 6) { return TCL_ERROR; } TclNewObj(isClass); if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) { Tcl_DecrRefCount(isClass); return TCL_ERROR; } else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0, &t) != TCL_OK) { Tcl_DecrRefCount(isClass); TclCompileSyntaxError(interp, envPtr); return TCL_OK; } Tcl_DecrRefCount(isClass); #define GotLiteral(tokenPtr, word) \ ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD && \ (tokenPtr)[1].size > 1 && \ (tokenPtr)[1].start[0] == word[0] && \ strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0) /* * Cannot handle the -failindex option at all, and that's the only legal * way to have more than 4 arguments. */ if (parsePtr->numWords != 3 && parsePtr->numWords != 4) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); if (parsePtr->numWords == 3) { allowEmpty = 1; } else { if (!GotLiteral(tokenPtr, "-strict")) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); } #undef GotLiteral /* * Compile the code. There are several main classes of check here. * 1. Character classes * 2. Booleans * 3. Integers * 4. Floats * 5. Lists */ CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1); switch ((enum isClassesEnum) t) { case STR_IS_ALNUM: strClassType = STR_CLASS_ALNUM; goto compileStrClass; case STR_IS_ALPHA: strClassType = STR_CLASS_ALPHA; goto compileStrClass; case STR_IS_ASCII: strClassType = STR_CLASS_ASCII; goto compileStrClass; case STR_IS_CONTROL: strClassType = STR_CLASS_CONTROL; goto compileStrClass; case STR_IS_DIGIT: strClassType = STR_CLASS_DIGIT; goto compileStrClass; case STR_IS_GRAPH: strClassType = STR_CLASS_GRAPH; goto compileStrClass; case STR_IS_LOWER: strClassType = STR_CLASS_LOWER; goto compileStrClass; case STR_IS_PRINT: strClassType = STR_CLASS_PRINT; goto compileStrClass; case STR_IS_PUNCT: strClassType = STR_CLASS_PUNCT; goto compileStrClass; case STR_IS_SPACE: strClassType = STR_CLASS_SPACE; goto compileStrClass; case STR_IS_UPPER: strClassType = STR_CLASS_UPPER; goto compileStrClass; case STR_IS_WORD: strClassType = STR_CLASS_WORD; goto compileStrClass; case STR_IS_XDIGIT: strClassType = STR_CLASS_XDIGIT; compileStrClass: if (allowEmpty) { OP1( STR_CLASS, strClassType); } else { int over, over2; OP( DUP); OP1( STR_CLASS, strClassType); JUMP1( JUMP_TRUE, over); OP( POP); PUSH( "0"); JUMP1( JUMP, over2); FIXJUMP1(over); PUSH( ""); OP( STR_NEQ); FIXJUMP1(over2); } return TCL_OK; case STR_IS_BOOL: case STR_IS_FALSE: case STR_IS_TRUE: OP( TRY_CVT_TO_BOOLEAN); switch (t) { int over, over2; case STR_IS_BOOL: if (allowEmpty) { JUMP1( JUMP_TRUE, over); PUSH( ""); OP( STR_EQ); JUMP1( JUMP, over2); FIXJUMP1(over); OP( POP); PUSH( "1"); FIXJUMP1(over2); } else { OP4( REVERSE, 2); OP( POP); } return TCL_OK; case STR_IS_TRUE: JUMP1( JUMP_TRUE, over); if (allowEmpty) { PUSH( ""); OP( STR_EQ); } else { OP( POP); PUSH( "0"); } FIXJUMP1( over); OP( LNOT); OP( LNOT); return TCL_OK; case STR_IS_FALSE: JUMP1( JUMP_TRUE, over); if (allowEmpty) { PUSH( ""); OP( STR_NEQ); } else { OP( POP); PUSH( "1"); } FIXJUMP1( over); OP( LNOT); return TCL_OK; } break; case STR_IS_DOUBLE: { int satisfied, isEmpty; if (allowEmpty) { OP( DUP); PUSH( ""); OP( STR_EQ); JUMP1( JUMP_TRUE, isEmpty); OP( NUM_TYPE); JUMP1( JUMP_TRUE, satisfied); PUSH( "0"); JUMP1( JUMP, end); FIXJUMP1( isEmpty); OP( POP); FIXJUMP1( satisfied); } else { OP( NUM_TYPE); JUMP1( JUMP_TRUE, satisfied); PUSH( "0"); JUMP1( JUMP, end); TclAdjustStackDepth(-1, envPtr); FIXJUMP1( satisfied); } PUSH( "1"); FIXJUMP1( end); return TCL_OK; } case STR_IS_INT: case STR_IS_WIDE: case STR_IS_ENTIER: if (allowEmpty) { int testNumType; OP( DUP); OP( NUM_TYPE); OP( DUP); JUMP1( JUMP_TRUE, testNumType); OP( POP); PUSH( ""); OP( STR_EQ); JUMP1( JUMP, end); TclAdjustStackDepth(1, envPtr); FIXJUMP1( testNumType); OP4( REVERSE, 2); OP( POP); } else { OP( NUM_TYPE); OP( DUP); JUMP1( JUMP_FALSE, end); } switch (t) { case STR_IS_WIDE: PUSH( "2"); OP( LE); break; case STR_IS_INT: PUSH( "1"); OP( EQ); break; case STR_IS_ENTIER: PUSH( "3"); OP( LE); break; } FIXJUMP1( end); return TCL_OK; case STR_IS_LIST: range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); OP4( BEGIN_CATCH4, range); ExceptionRangeStarts(envPtr, range); OP( DUP); OP( LIST_LENGTH); OP( POP); ExceptionRangeEnds(envPtr, range); ExceptionRangeTarget(envPtr, range, catchOffset); OP( POP); OP( PUSH_RETURN_CODE); OP( END_CATCH); OP( LNOT); return TCL_OK; } return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr); } int TclCompileStringMatchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i, length, exactMatch = 0, nocase = 0; const char *str; if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); /* * Check if we have a -nocase flag. */ if (parsePtr->numWords == 4) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } str = tokenPtr[1].start; length = tokenPtr[1].size; if ((length <= 1) || strncmp(str, "-nocase", length)) { /* * Fail at run time, not in compilation. */ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } nocase = 1; tokenPtr = TokenAfter(tokenPtr); } /* * Push the strings to match against each other. */ for (i = 0; i < 2; i++) { if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { str = tokenPtr[1].start; length = tokenPtr[1].size; if (!nocase && (i == 0)) { /* * Trivial matches can be done by 'string equal'. If -nocase * was specified, we can't do this because INST_STR_EQ has no * support for nocase. */ Tcl_Obj *copy = Tcl_NewStringObj(str, length); Tcl_IncrRefCount(copy); exactMatch = TclMatchIsTrivial(TclGetString(copy)); TclDecrRefCount(copy); } PushLiteral(envPtr, str, length); } else { SetLineInformation(i+1+nocase); CompileTokens(envPtr, tokenPtr, interp); } tokenPtr = TokenAfter(tokenPtr); } /* * Push the matcher. */ if (exactMatch) { TclEmitOpcode(INST_STR_EQ, envPtr); } else { TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr); } return TCL_OK; } int TclCompileStringLenCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); TclNewObj(objPtr); if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) { /* * Here someone is asking for the length of a static string (or * something with backslashes). Just push the actual character (not * byte) length. */ char buf[TCL_INTEGER_SPACE]; int len = Tcl_GetCharLength(objPtr); len = snprintf(buf, sizeof(buf), "%d", len); PushLiteral(envPtr, buf, len); } else { SetLineInformation(1); CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_STR_LEN, envPtr); } TclDecrRefCount(objPtr); return TCL_OK; } int TclCompileStringMapCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; const char *bytes; int len; /* * We only handle the case: * * string map {foo bar} $thing * * That is, a literal two-element list (doesn't need to be brace-quoted, * but does need to be compile-time knowable) and any old argument (the * thing to map). */ if (parsePtr->numWords != 3) { return TCL_ERROR; } mapTokenPtr = TokenAfter(parsePtr->tokenPtr); stringTokenPtr = TokenAfter(mapTokenPtr); TclNewObj(mapObj); Tcl_IncrRefCount(mapObj); if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else if (TclListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else if (len != 2) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Now issue the opcodes. Note that in the case that we know that the * first word is an empty word, we don't issue the map at all. That is the * correct semantics for mapping. */ bytes = Tcl_GetStringFromObj(objv[0], &len); if (len == 0) { CompileWord(envPtr, stringTokenPtr, interp, 2); } else { PushLiteral(envPtr, bytes, len); bytes = Tcl_GetStringFromObj(objv[1], &len); PushLiteral(envPtr, bytes, len); CompileWord(envPtr, stringTokenPtr, interp, 2); OP(STR_MAP); } Tcl_DecrRefCount(mapObj); return TCL_OK; } int TclCompileStringRangeCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr; int idx1, idx2; if (parsePtr->numWords != 4) { return TCL_ERROR; } stringTokenPtr = TokenAfter(parsePtr->tokenPtr); fromTokenPtr = TokenAfter(stringTokenPtr); toTokenPtr = TokenAfter(fromTokenPtr); /* Every path must push the string argument */ CompileWord(envPtr, stringTokenPtr, interp, 1); /* * Parse the two indices. */ if (TclGetIndexFromToken(fromTokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER, &idx1) != TCL_OK) { goto nonConstantIndices; } /* * Token parsed as an index expression. We treat all indices before * the string the same as the start of the string. */ if (idx1 == TCL_INDEX_AFTER) { /* [string range $s end+1 $last] must be empty string */ OP( POP); PUSH( ""); return TCL_OK; } if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, &idx2) != TCL_OK) { goto nonConstantIndices; } /* * Token parsed as an index expression. We treat all indices after * the string the same as the end of the string. */ if (idx2 == TCL_INDEX_BEFORE) { /* [string range $s $first -1] must be empty string */ OP( POP); PUSH( ""); return TCL_OK; } /* * Push the operand onto the stack and then the substring operation. */ OP44( STR_RANGE_IMM, idx1, idx2); return TCL_OK; /* * Push the operands onto the stack and then the substring operation. */ nonConstantIndices: CompileWord(envPtr, fromTokenPtr, interp, 2); CompileWord(envPtr, toTokenPtr, interp, 3); OP( STR_RANGE); return TCL_OK; } int TclCompileStringReplaceCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *valueTokenPtr; int first, last; if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { return TCL_ERROR; } /* Bytecode to compute/push string argument being replaced */ valueTokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, valueTokenPtr, interp, 1); /* * Check for first index known and useful at compile time. */ tokenPtr = TokenAfter(valueTokenPtr); if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER, &first) != TCL_OK) { goto genericReplace; } /* * Check for last index known and useful at compile time. */ tokenPtr = TokenAfter(tokenPtr); if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER, &last) != TCL_OK) { goto genericReplace; } /* * [string replace] is an odd bird. For many arguments it is * a conventional substring replacer. However it also goes out * of its way to become a no-op for many cases where it would be * replacing an empty substring. Precisely, it is a no-op when * * (last < first) OR * (last < 0) OR * (end < first) * * For some compile-time values we can detect these cases, and * compile direct to bytecode implementing the no-op. */ if ((last == TCL_INDEX_BEFORE) /* Know (last < 0) */ || (first == TCL_INDEX_AFTER) /* Know (first > end) */ /* * Tricky to determine when runtime (last < first) can be * certainly known based on the encoded values. Consider the * cases... * * (first <= TCL_INDEX_END) && * (last == TCL_INDEX_AFTER) => cannot tell REJECT * (last <= TCL_INDEX END) && (last < first) => ACCEPT * else => cannot tell REJECT */ || ((first <= TCL_INDEX_END) && (last <= TCL_INDEX_END) && (last < first)) /* Know (last < first) */ /* * (first == TCL_INDEX_BEFORE) && * (last == TCL_INDEX_AFTER) => (first < last) REJECT * (last <= TCL_INDEX_END) => cannot tell REJECT * else => (first < last) REJECT * * else [[first >= TCL_INDEX_START]] && * (last == TCL_INDEX_AFTER) => cannot tell REJECT * (last <= TCL_INDEX_END) => cannot tell REJECT * else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT */ || ((first >= TCL_INDEX_START) && (last >= TCL_INDEX_START) && (last < first))) { /* Know (last < first) */ if (parsePtr->numWords == 5) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 4); OP( POP); /* Pop newString */ } /* Original string argument now on TOS as result */ return TCL_OK; } if (parsePtr->numWords == 5) { /* * When we have a string replacement, we have to take care about * not replacing empty substrings that [string replace] promises * not to replace * * The remaining index values might be suitable for conventional * string replacement, but only if they cannot possibly meet the * conditions described above at runtime. If there's a chance they * might, we would have to emit bytecode to check and at that point * we're paying more in bytecode execution time than would make * things worthwhile. Trouble is we are very limited in * how much we can detect that at compile time. After decoding, * we need, first: * * (first <= end) * * The encoded indices (first <= TCL_INDEX END) and * (first == TCL_INDEX_BEFORE) always meets this condition, but * any other encoded first index has some list for which it fails. * * We also need, second: * * (last >= 0) * * The encoded indices (last >= TCL_INDEX_START) and * (last == TCL_INDEX_AFTER) always meet this condition but any * other encoded last index has some list for which it fails. * * Finally we need, third: * * (first <= last) * * Considered in combination with the constraints we already have, * we see that we can proceed when (first == TCL_INDEX_BEFORE) * or (last == TCL_INDEX_AFTER). These also permit simplification * of the prefix|replace|suffix construction. The other constraints, * though, interfere with getting a guarantee that first <= last. */ if ((first == TCL_INDEX_BEFORE) && (last >= TCL_INDEX_START)) { /* empty prefix */ tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 4); OP4( REVERSE, 2); if (last == TCL_INDEX_AFTER) { OP( POP); /* Pop original */ } else { OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END); OP1( STR_CONCAT1, 2); } return TCL_OK; } if ((last == TCL_INDEX_AFTER) && (first <= TCL_INDEX_END)) { OP44( STR_RANGE_IMM, 0, first-1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 4); OP1( STR_CONCAT1, 2); return TCL_OK; } /* FLOW THROUGH TO genericReplace */ } else { /* * When we have no replacement string to worry about, we may * have more luck, because the forbidden empty string replacements * are harmless when they are replaced by another empty string. */ if ((first == TCL_INDEX_BEFORE) || (first == TCL_INDEX_START)) { /* empty prefix - build suffix only */ if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) { /* empty suffix too => empty result */ OP( POP); /* Pop original */ PUSH ( ""); return TCL_OK; } OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END); return TCL_OK; } else { if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) { /* empty suffix - build prefix only */ OP44( STR_RANGE_IMM, 0, first-1); return TCL_OK; } OP( DUP); OP44( STR_RANGE_IMM, 0, first-1); OP4( REVERSE, 2); OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END); OP1( STR_CONCAT1, 2); return TCL_OK; } } genericReplace: tokenPtr = TokenAfter(valueTokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 3); if (parsePtr->numWords == 5) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 4); } else { PUSH( ""); } OP( STR_REPLACE); return TCL_OK; } int TclCompileStringTrimLCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); } else { PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet)); } OP( STR_TRIM_LEFT); return TCL_OK; } int TclCompileStringTrimRCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); } else { PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet)); } OP( STR_TRIM_RIGHT); return TCL_OK; } int TclCompileStringTrimCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); } else { PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet)); } OP( STR_TRIM); return TCL_OK; } int TclCompileStringToUpperCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); OP( STR_UPPER); return TCL_OK; } int TclCompileStringToLowerCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); OP( STR_LOWER); return TCL_OK; } int TclCompileStringToTitleCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); OP( STR_TITLE); return TCL_OK; } /* * Support definitions for the [string is] compilation. */ static int UniCharIsAscii( int character) { return (character >= 0) && (character < 0x80); } static int UniCharIsHexDigit( int character) { return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character)); } StringClassDesc const tclStringClassTable[] = { {"alnum", Tcl_UniCharIsAlnum}, {"alpha", Tcl_UniCharIsAlpha}, {"ascii", UniCharIsAscii}, {"control", Tcl_UniCharIsControl}, {"digit", Tcl_UniCharIsDigit}, {"graph", Tcl_UniCharIsGraph}, {"lower", Tcl_UniCharIsLower}, {"print", Tcl_UniCharIsPrint}, {"punct", Tcl_UniCharIsPunct}, {"space", Tcl_UniCharIsSpace}, {"upper", Tcl_UniCharIsUpper}, {"word", Tcl_UniCharIsWordChar}, {"xdigit", UniCharIsHexDigit}, {NULL, NULL} }; /* *---------------------------------------------------------------------- * * TclCompileSubstCmd -- * * Procedure called to compile the "subst" command. * * Results: * Returns TCL_OK for successful compile, or TCL_ERROR to defer * evaluation to runtime (either when it is too complex to get the * semantics right, or when we know for sure that it is an error but need * the error to happen at the right time). * * Side effects: * Instructions are added to envPtr to execute the "subst" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileSubstCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int numArgs = parsePtr->numWords - 1; int numOpts = numArgs - 1; int objc, flags = TCL_SUBST_ALL; Tcl_Obj **objv/*, *toSubst = NULL*/; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); int code = TCL_ERROR; if (numArgs == 0) { return TCL_ERROR; } objv = (Tcl_Obj **)TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *)); for (objc = 0; objc < /*numArgs*/ numOpts; objc++) { TclNewObj(objv[objc]); Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { objc++; goto cleanup; } wordTokenPtr = TokenAfter(wordTokenPtr); } /* if (TclSubstOptions(NULL, numOpts, objv, &flags) == TCL_OK) { toSubst = objv[numOpts]; Tcl_IncrRefCount(toSubst); } */ /* TODO: Figure out expansion to cover WordKnownAtCompileTime * The difficulty is that WKACT makes a copy, and if TclSubstParse * below parses the copy of the original source string, some deep * parts of the compile machinery get upset. They want all pointers * stored in Tcl_Tokens to point back to the same original string. */ if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { code = TclSubstOptions(NULL, numOpts, objv, &flags); } cleanup: while (--objc >= 0) { TclDecrRefCount(objv[objc]); } TclStackFree(interp, objv); if (/*toSubst == NULL*/ code != TCL_OK) { return TCL_ERROR; } SetLineInformation(numArgs); TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size, flags, mapPtr->loc[eclIndex].line[numArgs], envPtr); /* TclDecrRefCount(toSubst);*/ return TCL_OK; } void TclSubstCompile( Tcl_Interp *interp, const char *bytes, int numBytes, int flags, int line, CompileEnv *envPtr) { Tcl_Token *endTokenPtr, *tokenPtr; int breakOffset = 0, count = 0, bline = line; Tcl_Parse parse; Tcl_InterpState state = NULL; TclSubstParse(interp, bytes, numBytes, flags, &parse, &state); if (state != NULL) { Tcl_ResetResult(interp); } /* * Tricky point! If the first token does not result in a *guaranteed* push * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for * identifying a script that could trigger this case. */ tokenPtr = parse.tokenPtr; if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) { PUSH(""); count++; } for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { int length, literal, catchRange, breakJump; char buf[TCL_UTF_MAX] = ""; JumpFixup startFixup, okFixup, returnFixup, breakFixup; JumpFixup continueFixup, otherFixup, endFixup; switch (tokenPtr->type) { case TCL_TOKEN_TEXT: literal = TclRegisterNewLiteral(envPtr, tokenPtr->start, tokenPtr->size); TclEmitPush(literal, envPtr); TclAdvanceLines(&bline, tokenPtr->start, tokenPtr->start + tokenPtr->size); count++; continue; case TCL_TOKEN_BS: length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, buf); literal = TclRegisterNewLiteral(envPtr, buf, length); TclEmitPush(literal, envPtr); count++; continue; case TCL_TOKEN_VARIABLE: /* * Check for simple variable access; see if we can only generate * TCL_OK or TCL_ERROR from the substituted variable read; if so, * there is no need to generate elaborate exception-management * code. Note that the first component of TCL_TOKEN_VARIABLE is * always TCL_TOKEN_TEXT... */ if (tokenPtr->numComponents > 1) { int i, foundCommand = 0; for (i=2 ; i<=tokenPtr->numComponents ; i++) { if (tokenPtr[i].type == TCL_TOKEN_COMMAND) { foundCommand = 1; break; } } if (foundCommand) { break; } } envPtr->line = bline; TclCompileVarSubst(interp, tokenPtr, envPtr); bline = envPtr->line; count++; continue; } while (count > 255) { OP1( STR_CONCAT1, 255); count -= 254; } if (count > 1) { OP1( STR_CONCAT1, count); count = 1; } if (breakOffset == 0) { /* Jump to the start (jump over the jump to end) */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &startFixup); /* Jump to the end (all BREAKs land here) */ breakOffset = CurrentOffset(envPtr); TclEmitInstInt4(INST_JUMP4, 0, envPtr); /* Start */ if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d", (int) (CurrentOffset(envPtr) - startFixup.codeOffset)); } } envPtr->line = bline; catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); OP4( BEGIN_CATCH4, catchRange); ExceptionRangeStarts(envPtr, catchRange); switch (tokenPtr->type) { case TCL_TOKEN_COMMAND: TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr); count++; break; case TCL_TOKEN_VARIABLE: TclCompileVarSubst(interp, tokenPtr, envPtr); count++; break; default: Tcl_Panic("unexpected token type in TclCompileSubstCmd: %d", tokenPtr->type); } ExceptionRangeEnds(envPtr, catchRange); /* Substitution produced TCL_OK */ OP( END_CATCH); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup); TclAdjustStackDepth(-1, envPtr); /* Exceptional return codes processed here */ ExceptionRangeTarget(envPtr, catchRange, catchOffset); OP( PUSH_RETURN_OPTIONS); OP( PUSH_RESULT); OP( PUSH_RETURN_CODE); OP( END_CATCH); OP( RETURN_CODE_BRANCH); /* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */ OP( RETURN_STK); OP( NOP); /* RETURN */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup); /* BREAK */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &breakFixup); /* CONTINUE */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &continueFixup); /* OTHER */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup); TclAdjustStackDepth(1, envPtr); /* BREAK destination */ if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d", (int) (CurrentOffset(envPtr) - breakFixup.codeOffset)); } OP( POP); OP( POP); breakJump = CurrentOffset(envPtr) - breakOffset; if (breakJump > 127) { OP4(JUMP4, -breakJump); } else { OP1(JUMP1, -breakJump); } TclAdjustStackDepth(2, envPtr); /* CONTINUE destination */ if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d", (int) (CurrentOffset(envPtr) - continueFixup.codeOffset)); } OP( POP); OP( POP); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); TclAdjustStackDepth(2, envPtr); /* RETURN + other destination */ if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d", (int) (CurrentOffset(envPtr) - returnFixup.codeOffset)); } if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d", (int) (CurrentOffset(envPtr) - otherFixup.codeOffset)); } /* * Pull the result to top of stack, discard options dict. */ OP4( REVERSE, 2); OP( POP); /* OK destination */ if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d", (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); } if (count > 1) { OP1(STR_CONCAT1, count); count = 1; } /* CONTINUE jump to here */ if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d", (int) (CurrentOffset(envPtr) - endFixup.codeOffset)); } bline = envPtr->line; } while (count > 255) { OP1( STR_CONCAT1, 255); count -= 254; } if (count > 1) { OP1( STR_CONCAT1, count); } Tcl_FreeParse(&parse); if (state != NULL) { Tcl_RestoreInterpState(interp, state); TclCompileSyntaxError(interp, envPtr); TclAdjustStackDepth(-1, envPtr); } /* Final target of the multi-jump from all BREAKs */ if (breakOffset > 0) { TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset, envPtr->codeStart + breakOffset); } } /* *---------------------------------------------------------------------- * * TclCompileSwitchCmd -- * * Procedure called to compile the "switch" command. * * Results: * Returns TCL_OK for successful compile, or TCL_ERROR to defer * evaluation to runtime (either when it is too complex to get the * semantics right, or when we know for sure that it is an error but need * the error to happen at the right time). * * Side effects: * Instructions are added to envPtr to execute the "switch" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileSwitchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* Pointer to tokens in command. */ int numWords; /* Number of words in command. */ Tcl_Token *valueTokenPtr; /* Token for the value to switch on. */ enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode; /* What kind of switch are we doing? */ Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */ Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */ int *bodyLines; /* Array of line numbers for body list * items. */ int **bodyContLines; /* Array of continuation line info. */ int noCase; /* Has the -nocase flag been given? */ int foundMode = 0; /* Have we seen a mode flag yet? */ int i, valueIndex; int result = TCL_ERROR; int *clNext = envPtr->clNext; /* * Only handle the following versions: * switch ?--? word {pattern body ...} * switch -exact ?--? word {pattern body ...} * switch -glob ?--? word {pattern body ...} * switch -regexp ?--? word {pattern body ...} * switch -- word simpleWordPattern simpleWordBody ... * switch -exact -- word simpleWordPattern simpleWordBody ... * switch -glob -- word simpleWordPattern simpleWordBody ... * switch -regexp -- word simpleWordPattern simpleWordBody ... * When the mode is -glob, can also handle a -nocase flag. * * First off, we don't care how the command's word was generated; we're * compiling it anyway! So skip it... */ tokenPtr = TokenAfter(parsePtr->tokenPtr); valueIndex = 1; numWords = parsePtr->numWords-1; /* * Check for options. */ noCase = 0; mode = Switch_Exact; if (numWords == 2) { /* * There's just the switch value and the bodies list. In that case, we * can skip all option parsing and move on to consider switch values * and the body list. */ goto finishedOptionParse; } /* * There must be at least one option, --, because without that there is no * way to statically avoid the problems you get from strings-to-be-matched * that start with a - (the interpreted code falls apart if it encounters * them, so we punt if we *might* encounter them as that is the easiest * way of emulating the behaviour). */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { unsigned size = tokenPtr[1].size; const char *chrs = tokenPtr[1].start; /* * We only process literal options, and we assume that -e, -g and -n * are unique prefixes of -exact, -glob and -nocase respectively (true * at time of writing). Note that -exact and -glob may only be given * at most once or we bail out (error case). */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) { return TCL_ERROR; } if ((size <= 6) && !memcmp(chrs, "-exact", size)) { if (foundMode) { return TCL_ERROR; } mode = Switch_Exact; foundMode = 1; valueIndex++; continue; } else if ((size <= 5) && !memcmp(chrs, "-glob", size)) { if (foundMode) { return TCL_ERROR; } mode = Switch_Glob; foundMode = 1; valueIndex++; continue; } else if ((size <= 7) && !memcmp(chrs, "-regexp", size)) { if (foundMode) { return TCL_ERROR; } mode = Switch_Regexp; foundMode = 1; valueIndex++; continue; } else if ((size <= 7) && !memcmp(chrs, "-nocase", size)) { noCase = 1; valueIndex++; continue; } else if ((size == 2) && !memcmp(chrs, "--", 2)) { valueIndex++; break; } /* * The switch command has many flags we cannot compile at all (e.g. * all the RE-related ones) which we must have encountered. Either * that or we have run off the end. The action here is the same: punt * to interpreted version. */ return TCL_ERROR; } if (numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); numWords--; if (noCase && (mode == Switch_Exact)) { /* * Can't compile this case; no opcode for case-insensitive equality! */ return TCL_ERROR; } /* * The value to test against is going to always get pushed on the stack. * But not yet; we need to verify that the rest of the command is * compilable too. */ finishedOptionParse: valueTokenPtr = tokenPtr; /* For valueIndex, see previous loop. */ tokenPtr = TokenAfter(tokenPtr); numWords--; /* * Build an array of tokens for the matcher terms and script bodies. Note * that in the case of the quoted bodies, this is tricky as we cannot use * copies of the string from the input token for the generated tokens (it * causes a crash during exception handling). When multiple tokens are * available at this point, this is pretty easy. */ if (numWords == 1) { const char *bytes; int maxLen, numBytes; int bline; /* TIP #280: line of the pattern/action list, * and start of list for when tracking the * location. This list comes immediately after * the value we switch on. */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } bytes = tokenPtr[1].start; numBytes = tokenPtr[1].size; /* Allocate enough space to work in. */ maxLen = TclMaxListLength(bytes, numBytes, NULL); if (maxLen < 2) { return TCL_ERROR; } bodyTokenArray = (Tcl_Token *)ckalloc(sizeof(Tcl_Token) * maxLen); bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * maxLen); bodyLines = (int *)ckalloc(sizeof(int) * maxLen); bodyContLines = (int **)ckalloc(sizeof(int*) * maxLen); bline = mapPtr->loc[eclIndex].line[valueIndex+1]; numWords = 0; while (numBytes > 0) { const char *prevBytes = bytes; int literal; if (TCL_OK != TclFindElement(NULL, bytes, numBytes, &(bodyTokenArray[numWords].start), &bytes, &(bodyTokenArray[numWords].size), &literal) || !literal) { goto abort; } bodyTokenArray[numWords].type = TCL_TOKEN_TEXT; bodyTokenArray[numWords].numComponents = 0; bodyToken[numWords] = bodyTokenArray + numWords; /* * TIP #280: Now determine the line the list element starts on * (there is no need to do it earlier, due to the possibility of * aborting, see above). */ TclAdvanceLines(&bline, prevBytes, bodyTokenArray[numWords].start); TclAdvanceContinuations(&bline, &clNext, bodyTokenArray[numWords].start - envPtr->source); bodyLines[numWords] = bline; bodyContLines[numWords] = clNext; TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes); TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source); numBytes -= (bytes - prevBytes); numWords++; } if (numWords % 2) { abort: ckfree((char *) bodyToken); ckfree((char *) bodyTokenArray); ckfree((char *) bodyLines); ckfree((char *) bodyContLines); return TCL_ERROR; } } else if (numWords % 2 || numWords == 0) { /* * Odd number of words (>1) available, or no words at all available. * Both are error cases, so punt and let the interpreted-version * generate the error message. Note that the second case probably * should get caught earlier, but it's easy to check here again anyway * because it'd cause a nasty crash otherwise. */ return TCL_ERROR; } else { /* * Multi-word definition of patterns & actions. */ bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * numWords); bodyLines = (int *)ckalloc(sizeof(int) * numWords); bodyContLines = (int **)ckalloc(sizeof(int*) * numWords); bodyTokenArray = NULL; for (i=0 ; itype != TCL_TOKEN_SIMPLE_WORD) { goto freeTemporaries; } bodyToken[i] = tokenPtr+1; /* * TIP #280: Copy line information from regular cmd info. */ bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i]; bodyContLines[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i]; tokenPtr = TokenAfter(tokenPtr); } } /* * Fall back to interpreted if the last body is a continuation (it's * illegal, but this makes the error happen at the right time). */ if (bodyToken[numWords-1]->size == 1 && bodyToken[numWords-1]->start[0] == '-') { goto freeTemporaries; } /* * Now we commit to generating code; the parsing stage per se is done. * Check if we can generate a jump table, since if so that's faster than * doing an explicit compare with each body. Note that we're definitely * over-conservative with determining whether we can do the jump table, * but it handles the most common case well enough. */ /* Both methods push the value to match against onto the stack. */ CompileWord(envPtr, valueTokenPtr, interp, valueIndex); if (mode == Switch_Exact) { IssueSwitchJumpTable(interp, envPtr, numWords, bodyToken, bodyLines, bodyContLines); } else { IssueSwitchChainedTests(interp, envPtr, mode, noCase, numWords, bodyToken, bodyLines, bodyContLines); } result = TCL_OK; /* * Clean up all our temporary space and return. */ freeTemporaries: ckfree(bodyToken); ckfree(bodyLines); ckfree(bodyContLines); if (bodyTokenArray != NULL) { ckfree(bodyTokenArray); } return result; } /* *---------------------------------------------------------------------- * * IssueSwitchChainedTests -- * * Generate instructions for a [switch] command that is to be compiled * into a sequence of tests. This is the generic handle-everything mode * that inherently has performance that is (on average) linear in the * number of tests. It is the only mode that can handle -glob and -regexp * matches, or anything that is case-insensitive. It does not handle the * wild-and-wooly end of regexp matching (i.e., capture of match results) * so that's when we spill to the interpreted version. * *---------------------------------------------------------------------- */ static void IssueSwitchChainedTests( Tcl_Interp *interp, /* Context for compiling script bodies. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int mode, /* Exact, Glob or Regexp */ int noCase, /* Case-insensitivity flag. */ int numBodyTokens, /* Number of tokens describing things the * switch can match against and bodies to * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ int *bodyLines, /* Array of line numbers for body list * items. */ int **bodyContLines) /* Array of continuation line info. */ { enum {Switch_Exact, Switch_Glob, Switch_Regexp}; int foundDefault; /* Flag to indicate whether a "default" clause * is present. */ JumpFixup *fixupArray; /* Array of forward-jump fixup records. */ unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */ int fixupCount; /* Number of places to fix up. */ int contFixIndex; /* Where the first of the jumps due to a group * of continuation bodies starts, or -1 if * there aren't any. */ int contFixCount; /* Number of continuation bodies pointing to * the current (or next) real body. */ int nextArmFixupIndex; int simple, exact; /* For extracting the type of regexp. */ int i; /* * Generate a test for each arm. */ contFixIndex = -1; contFixCount = 0; fixupArray = (JumpFixup *)TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens); fixupTargetArray = (unsigned int *)TclStackAlloc(interp, sizeof(int) * numBodyTokens); memset(fixupTargetArray, 0, numBodyTokens * sizeof(int)); fixupCount = 0; foundDefault = 0; for (i=0 ; isize != 7 || memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) { /* * Generate the test for the arm. */ switch (mode) { case Switch_Exact: OP( DUP); TclCompileTokens(interp, bodyToken[i], 1, envPtr); OP( STR_EQ); break; case Switch_Glob: TclCompileTokens(interp, bodyToken[i], 1, envPtr); OP4( OVER, 1); OP1( STR_MATCH, noCase); break; case Switch_Regexp: simple = exact = 0; /* * Keep in sync with TclCompileRegexpCmd. */ if (bodyToken[i]->type == TCL_TOKEN_TEXT) { Tcl_DString ds; if (bodyToken[i]->size == 0) { /* * The semantics of regexps are that they always match * when the RE == "". */ PUSH("1"); break; } /* * Attempt to convert pattern to glob. If successful, push * the converted pattern. */ if (TclReToGlob(NULL, bodyToken[i]->start, bodyToken[i]->size, &ds, &exact, NULL) == TCL_OK){ simple = 1; PushLiteral(envPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); } } if (!simple) { TclCompileTokens(interp, bodyToken[i], 1, envPtr); } OP4( OVER, 1); if (!simple) { /* * Pass correct RE compile flags. We use only Int1 * (8-bit), but that handles all the flags we want to * pass. Don't use TCL_REG_NOSUB as we may have backrefs * or capture vars. */ int cflags = TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0); OP1(REGEXP, cflags); } else if (exact && !noCase) { OP( STR_EQ); } else { OP1(STR_MATCH, noCase); } break; default: Tcl_Panic("unknown switch mode: %d", mode); } /* * In a fall-through case, we will jump on _true_ to the place * where the body starts (generated later, with guarantee of this * ensured earlier; the final body is never a fall-through). */ if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') { if (contFixIndex == -1) { contFixIndex = fixupCount; contFixCount = 0; } TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &fixupArray[contFixIndex+contFixCount]); fixupCount++; contFixCount++; continue; } TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &fixupArray[fixupCount]); nextArmFixupIndex = fixupCount; fixupCount++; } else { /* * Got a default clause; set a flag to inhibit the generation of * the jump after the body and the cleanup of the intermediate * value that we are switching against. * * Note that default clauses (which are always terminal clauses) * cannot be fall-through clauses as well, since the last clause * is never a fall-through clause (which we have already * verified). */ foundDefault = 1; } /* * Generate the body for the arm. This is guaranteed not to be a * fall-through case, but it might have preceding fall-through cases, * so we must process those first. */ if (contFixIndex != -1) { int j; for (j=0 ; jline = bodyLines[i+1]; /* TIP #280 */ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); if (!foundDefault) { TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &fixupArray[fixupCount]); fixupCount++; fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr); } } /* * Discard the value we are matching against unless we've had a default * clause (in which case it will already be gone due to the code at the * start of processing an arm, guaranteed) and make the result of the * command an empty string. */ if (!foundDefault) { OP( POP); PUSH(""); } /* * Do jump fixups for arms that were executed. First, fill in the jumps of * all jumps that don't point elsewhere to point to here. */ for (i=0 ; icodeNext-envPtr->codeStart; } } /* * Now scan backwards over all the jumps (all of which are forward jumps) * doing each one. When we do one and there is a size changes, we must * scan back over all the previous ones and see if they need adjusting * before proceeding with further jump fixups (the interleaved nature of * all the jumps makes this impossible to do without nested loops). */ for (i=fixupCount-1 ; i>=0 ; i--) { if (TclFixupForwardJump(envPtr, &fixupArray[i], fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) { int j; for (j=i-1 ; j>=0 ; j--) { if (fixupTargetArray[j] > fixupArray[i].codeOffset) { fixupTargetArray[j] += 3; } } } } TclStackFree(interp, fixupTargetArray); TclStackFree(interp, fixupArray); } /* *---------------------------------------------------------------------- * * IssueSwitchJumpTable -- * * Generate instructions for a [switch] command that is to be compiled * into a jump table. This only handles the case where case-sensitive, * exact matching is used, but this is actually the most common case in * real code. * *---------------------------------------------------------------------- */ static void IssueSwitchJumpTable( Tcl_Interp *interp, /* Context for compiling script bodies. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int numBodyTokens, /* Number of tokens describing things the * switch can match against and bodies to * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ int *bodyLines, /* Array of line numbers for body list * items. */ int **bodyContLines) /* Array of continuation line info. */ { JumptableInfo *jtPtr; int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation; int mustGenerate, foundDefault, jumpToDefault, i; Tcl_DString buffer; Tcl_HashEntry *hPtr; /* * Compile the switch by using a jump table, which is basically a * hashtable that maps from literal values to match against to the offset * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump * table itself is independent of any invocation of the bytecode, and as * such is stored in an auxData block. * * Start by allocating the jump table itself, plus some workspace. */ jtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); finalFixups = (int *)TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2)); foundDefault = 0; mustGenerate = 1; /* * Next, issue the instruction to do the jump, together with what we want * to do if things do not work out (jump to either the default clause or * the "default" default, which just sets the result to empty). Note that * we will come back and rewrite the jump's offset parameter when we know * what it should be, and that all jumps we issue are of the wide kind * because that makes the code much easier to debug! */ jumpLocation = CurrentOffset(envPtr); OP4( JUMP_TABLE, infoIndex); jumpToDefault = CurrentOffset(envPtr); OP4( JUMP4, 0); for (i=0 ; isize != 7 || memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) { /* * This is not a default clause, so insert the current location as * a target in the jump table (assuming it isn't already there, * which would indicate that this clause is probably masked by an * earlier one). Note that we use a Tcl_DString here simply * because the hash API does not let us specify the string length. */ Tcl_DStringInit(&buffer); TclDStringAppendToken(&buffer, bodyToken[i]); hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable, Tcl_DStringValue(&buffer), &isNew); if (isNew) { /* * First time we've encountered this match clause, so it must * point to here. */ Tcl_SetHashValue(hPtr, INT2PTR(CurrentOffset(envPtr) - jumpLocation)); } Tcl_DStringFree(&buffer); } else { /* * This is a default clause, so patch up the fallthrough from the * INST_JUMP_TABLE instruction to here. */ foundDefault = 1; isNew = 1; TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault, envPtr->codeStart+jumpToDefault+1); } /* * Now, for each arm we must deal with the body of the clause. * * If this is a continuation body (never true of a final clause, * whether default or not) we're done because the next jump target * will also point here, so we advance to the next clause. */ if (bodyToken[i+1]->size == 1 && bodyToken[i+1]->start[0] == '-') { mustGenerate = 1; continue; } /* * Also skip this arm if its only match clause is masked. (We could * probably be more aggressive about this, but that would be much more * difficult to get right.) */ if (!isNew && !mustGenerate) { continue; } mustGenerate = 0; /* * Compile the body of the arm. */ envPtr->line = bodyLines[i+1]; /* TIP #280 */ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); /* * Compile a jump in to the end of the command if this body is * anything other than a user-supplied default arm (to either skip * over the remaining bodies or the code that generates an empty * result). */ if (i+2 < numBodyTokens || !foundDefault) { finalFixups[numRealBodies++] = CurrentOffset(envPtr); /* * Easier by far to issue this jump as a fixed-width jump, since * otherwise we'd need to do a lot more (and more awkward) * rewriting when we fixed this all up. */ OP4( JUMP4, 0); TclAdjustStackDepth(-1, envPtr); } } /* * We're at the end. If we've not already done so through the processing * of a user-supplied default clause, add in a "default" default clause * now. */ if (!foundDefault) { TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault, envPtr->codeStart+jumpToDefault+1); PUSH(""); } /* * No more instructions to be issued; everything that needs to jump to the * end of the command is fixed up at this point. */ for (i=0 ; icodeStart+finalFixups[i]+1); } /* * Clean up all our temporary space and return. */ TclStackFree(interp, finalFixups); } /* *---------------------------------------------------------------------- * * DupJumptableInfo, FreeJumptableInfo -- * * Functions to duplicate, release and print a jump-table created for use * with the INST_JUMP_TABLE instruction. * * Results: * DupJumptableInfo: a copy of the jump-table * FreeJumptableInfo: none * PrintJumptableInfo: none * DisassembleJumptableInfo: none * * Side effects: * DupJumptableInfo: allocates memory * FreeJumptableInfo: releases memory * PrintJumptableInfo: none * DisassembleJumptableInfo: none * *---------------------------------------------------------------------- */ static ClientData DupJumptableInfo( ClientData clientData) { JumptableInfo *jtPtr = (JumptableInfo *)clientData; JumptableInfo *newJtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo)); Tcl_HashEntry *hPtr, *newHPtr; Tcl_HashSearch search; int isNew; Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS); hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); while (hPtr != NULL) { newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable, Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew); Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr)); } return newJtPtr; } static void FreeJumptableInfo( ClientData clientData) { JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_DeleteHashTable(&jtPtr->hashTable); ckfree(jtPtr); } static void PrintJumptableInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset, i = 0; hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); if (i++) { Tcl_AppendToObj(appendObj, ", ", -1); if (i%4==0) { Tcl_AppendToObj(appendObj, "\n\t\t", -1); } } Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d", keyPtr, pcOffset + offset); } } static void DisassembleJumptableInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_Obj *mapping; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset; TclNewObj(mapping); hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1), Tcl_NewIntObj(offset)); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping); } /* *---------------------------------------------------------------------- * * TclCompileTailcallCmd -- * * Procedure called to compile the "tailcall" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "tailcall" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileTailcallCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; if (parsePtr->numWords < 2 || parsePtr->numWords >= 256 || envPtr->procPtr == NULL) { return TCL_ERROR; } /* make room for the nsObjPtr */ /* TODO: Doesn't this have to be a known value? */ CompileWord(envPtr, tokenPtr, interp, 0); for (i=1 ; inumWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileThrowCmd -- * * Procedure called to compile the "throw" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "throw" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileThrowCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int numWords = parsePtr->numWords; Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; int codeKnown, codeIsList, codeIsValid, len; if (numWords != 3) { return TCL_ERROR; } codeToken = TokenAfter(parsePtr->tokenPtr); msgToken = TokenAfter(codeToken); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); codeKnown = TclWordKnownAtCompileTime(codeToken, objPtr); /* * First we must emit the code to substitute the arguments. This * must come first in case substitution raises errors. */ if (!codeKnown) { CompileWord(envPtr, codeToken, interp, 1); PUSH( "-errorcode"); } CompileWord(envPtr, msgToken, interp, 2); codeIsList = codeKnown && (TCL_OK == TclListObjLength(interp, objPtr, &len)); codeIsValid = codeIsList && (len != 0); if (codeIsValid) { Tcl_Obj *errPtr, *dictPtr; TclNewLiteralStringObj(errPtr, "-errorcode"); TclNewObj(dictPtr); Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr); TclEmitPush(TclAddLiteralObj(envPtr, dictPtr, NULL), envPtr); } TclDecrRefCount(objPtr); /* * Simpler bytecodes when we detect invalid arguments at compile time. */ if (codeKnown && !codeIsValid) { OP( POP); if (codeIsList) { /* Must be an empty list */ goto issueErrorForEmptyCode; } TclCompileSyntaxError(interp, envPtr); return TCL_OK; } if (!codeKnown) { /* * Argument validity checking has to be done by bytecode at * run time. */ OP4( REVERSE, 3); OP( DUP); OP( LIST_LENGTH); OP1( JUMP_FALSE1, 16); OP4( LIST, 2); OP44( RETURN_IMM, TCL_ERROR, 0); TclAdjustStackDepth(2, envPtr); OP( POP); OP( POP); OP( POP); issueErrorForEmptyCode: PUSH( "type must be non-empty list"); PUSH( "-errorcode {TCL OPERATION THROW BADEXCEPTION}"); } OP44( RETURN_IMM, TCL_ERROR, 0); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileTryCmd -- * * Procedure called to compile the "try" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "try" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileTryCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { int numWords = parsePtr->numWords, numHandlers, result = TCL_ERROR; Tcl_Token *bodyToken, *finallyToken, *tokenPtr; Tcl_Token **handlerTokens = NULL; Tcl_Obj **matchClauses = NULL; int *matchCodes=NULL, *resultVarIndices=NULL, *optionVarIndices=NULL; int i; if (numWords < 2) { return TCL_ERROR; } bodyToken = TokenAfter(parsePtr->tokenPtr); if (numWords == 2) { /* * No handlers or finally; do nothing beyond evaluating the body. */ DefineLineInformation; /* TIP #280 */ BODY(bodyToken, 1); return TCL_OK; } numWords -= 2; tokenPtr = TokenAfter(bodyToken); /* * Extract information about what handlers there are. */ numHandlers = numWords >> 2; numWords -= numHandlers * 4; if (numHandlers > 0) { handlerTokens = (Tcl_Token**)TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers); matchClauses = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers); memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers); matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); for (i=0 ; itype != TCL_TOKEN_SIMPLE_WORD) { goto failedToCompile; } if (tokenPtr[1].size == 4 && !strncmp(tokenPtr[1].start, "trap", 4)) { /* * Parse the list of errorCode words to match against. */ matchCodes[i] = TCL_ERROR; tokenPtr = TokenAfter(tokenPtr); TclNewObj(tmpObj); Tcl_IncrRefCount(tmpObj); if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj) || TclListObjLength(NULL, tmpObj, &objc) != TCL_OK || (objc == 0)) { TclDecrRefCount(tmpObj); goto failedToCompile; } Tcl_ListObjReplace(NULL, tmpObj, 0, 0, 0, NULL); matchClauses[i] = tmpObj; } else if (tokenPtr[1].size == 2 && !strncmp(tokenPtr[1].start, "on", 2)) { int code; /* * Parse the result code to look for. */ tokenPtr = TokenAfter(tokenPtr); TclNewObj(tmpObj); Tcl_IncrRefCount(tmpObj); if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { TclDecrRefCount(tmpObj); goto failedToCompile; } if (TCL_ERROR == TclGetCompletionCodeFromObj(NULL, tmpObj, &code)) { TclDecrRefCount(tmpObj); goto failedToCompile; } matchCodes[i] = code; TclDecrRefCount(tmpObj); } else { goto failedToCompile; } /* * Parse the variable binding. */ tokenPtr = TokenAfter(tokenPtr); TclNewObj(tmpObj); Tcl_IncrRefCount(tmpObj); if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { TclDecrRefCount(tmpObj); goto failedToCompile; } if (TclListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK || (objc > 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; } if (objc > 0) { int len; const char *varname = Tcl_GetStringFromObj(objv[0], &len); resultVarIndices[i] = LocalScalar(varname, len, envPtr); if (resultVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } } else { resultVarIndices[i] = -1; } if (objc == 2) { int len; const char *varname = Tcl_GetStringFromObj(objv[1], &len); optionVarIndices[i] = LocalScalar(varname, len, envPtr); if (optionVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } } else { optionVarIndices[i] = -1; } TclDecrRefCount(tmpObj); /* * Extract the body for this handler. */ tokenPtr = TokenAfter(tokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { goto failedToCompile; } if (tokenPtr[1].size == 1 && tokenPtr[1].start[0] == '-') { handlerTokens[i] = NULL; } else { handlerTokens[i] = tokenPtr; } tokenPtr = TokenAfter(tokenPtr); } if (handlerTokens[numHandlers-1] == NULL) { goto failedToCompile; } } /* * Parse the finally clause */ if (numWords == 0) { finallyToken = NULL; } else if (numWords == 2) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 7 || strncmp(tokenPtr[1].start, "finally", 7)) { goto failedToCompile; } finallyToken = TokenAfter(tokenPtr); if (finallyToken->type != TCL_TOKEN_SIMPLE_WORD) { goto failedToCompile; } } else { goto failedToCompile; } /* * Issue the bytecode. */ if (!finallyToken) { result = IssueTryClausesInstructions(interp, envPtr, bodyToken, numHandlers, matchCodes, matchClauses, resultVarIndices, optionVarIndices, handlerTokens); } else if (numHandlers == 0) { result = IssueTryFinallyInstructions(interp, envPtr, bodyToken, finallyToken); } else { result = IssueTryClausesFinallyInstructions(interp, envPtr, bodyToken, numHandlers, matchCodes, matchClauses, resultVarIndices, optionVarIndices, handlerTokens, finallyToken); } /* * Delete any temporary state and finish off. */ failedToCompile: if (numHandlers > 0) { for (i=0 ; i= 0) { LOAD( resultVar); STORE( resultVars[i]); OP( POP); if (optionVars[i] >= 0) { LOAD( optionsVar); STORE( optionVars[i]); OP( POP); } } if (!handlerTokens[i]) { forwardsNeedFixing = 1; JUMP4( JUMP, forwardsToFix[i]); TclAdjustStackDepth(1, envPtr); } else { int dontChangeOptions; forwardsToFix[i] = -1; if (forwardsNeedFixing) { forwardsNeedFixing = 0; for (j=0 ; j= 0 || handlerTokens[i]) { range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); OP4( BEGIN_CATCH4, range); ExceptionRangeStarts(envPtr, range); } if (resultVars[i] >= 0) { LOAD( resultVar); STORE( resultVars[i]); OP( POP); if (optionVars[i] >= 0) { LOAD( optionsVar); STORE( optionVars[i]); OP( POP); } if (!handlerTokens[i]) { /* * No handler. Will not be the last handler (that is a * condition that is checked by the caller). Chain to the next * one. */ ExceptionRangeEnds(envPtr, range); OP( END_CATCH); forwardsNeedFixing = 1; JUMP4( JUMP, forwardsToFix[i]); goto finishTrapCatchHandling; } } else if (!handlerTokens[i]) { /* * No handler. Will not be the last handler (that condition is * checked by the caller). Chain to the next one. */ forwardsNeedFixing = 1; JUMP4( JUMP, forwardsToFix[i]); goto endOfThisArm; } /* * Got a handler. Make sure that any pending patch-up actions from * previous unprocessed handlers are dealt with now that we know where * they are to jump to. */ if (forwardsNeedFixing) { forwardsNeedFixing = 0; OP1( JUMP1, 7); for (j=0 ; jtokenPtr ; inumWords ; i++) { Tcl_Obj *leadingWord; TclNewObj(leadingWord); varTokenPtr = TokenAfter(varTokenPtr); if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) { TclDecrRefCount(leadingWord); /* * We can tolerate non-trivial substitutions in the first variable * to be unset. If a '--' or '-nocomplain' was present, anything * goes in that one place! (All subsequent variable names must be * constants since we don't want to have to push them all first.) */ if (varCount == 0) { if (haveFlags) { continue; } /* * In fact, we're OK as long as we're the first argument *and* * we provably don't start with a '-'. If that is true, then * even if everything else is varying, we still can't be a * flag. Otherwise we'll spill to runtime to place a limit on * the trickiness. */ if (varTokenPtr->type == TCL_TOKEN_WORD && varTokenPtr[1].type == TCL_TOKEN_TEXT && varTokenPtr[1].size > 0 && varTokenPtr[1].start[0] != '-') { continue; } } return TCL_ERROR; } if (varCount == 0) { const char *bytes; int len; bytes = Tcl_GetStringFromObj(leadingWord, &len); if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) { flags = 0; haveFlags++; } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) { haveFlags++; } else { varCount++; } } else { varCount++; } TclDecrRefCount(leadingWord); } /* * Issue instructions to unset each of the named variables. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i=0; inumWords ; i++) { /* * Decide if we can use a frame slot for the var/array name or if we * need to emit code to compute and push the name at runtime. We use a * frame slot (entry in the array of local vars) if we are compiling a * procedure body and if the name is simple text that does not include * namespace qualifiers. */ PushVarNameWord(interp, varTokenPtr, envPtr, 0, &localIndex, &isScalar, i); /* * Emit instructions to unset the variable. */ if (isScalar) { if (localIndex < 0) { OP1( UNSET_STK, flags); } else { OP14( UNSET_SCALAR, flags, localIndex); } } else { if (localIndex < 0) { OP1( UNSET_ARRAY_STK, flags); } else { OP14( UNSET_ARRAY, flags, localIndex); } } varTokenPtr = TokenAfter(varTokenPtr); } PUSH(""); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileWhileCmd -- * * Procedure called to compile the "while" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "while" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileWhileCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *testTokenPtr, *bodyTokenPtr; JumpFixup jumpEvalCondFixup; int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal; int loopMayEnd = 1; /* This is set to 0 if it is recognized as an * infinite loop. */ Tcl_Obj *boolObj; if (parsePtr->numWords != 3) { return TCL_ERROR; } /* * If the test expression requires substitutions, don't compile the while * command inline. E.g., the expression might cause the loop to never * execute or execute forever, as in "while "$x < 5" {}". * * Bail out also if the body expression requires substitutions in order to * insure correct behaviour [Bug 219166] */ testTokenPtr = TokenAfter(parsePtr->tokenPtr); bodyTokenPtr = TokenAfter(testTokenPtr); if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) { return TCL_ERROR; } /* * Find out if the condition is a constant. */ boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size); Tcl_IncrRefCount(boolObj); code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); TclDecrRefCount(boolObj); if (code == TCL_OK) { if (boolVal) { /* * It is an infinite loop; flag it so that we generate a more * efficient body. */ loopMayEnd = 0; } else { /* * This is an empty loop: "while 0 {...}" or such. Compile no * bytecodes. */ goto pushResult; } } /* * Create a ExceptionRange record for the loop body. This is used to * implement break and continue. */ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); /* * Jump to the evaluation of the condition. This code uses the "loop * rotation" optimisation (which eliminates one branch from the loop). * "while cond body" produces then: * goto A * B: body : bodyCodeOffset * A: cond -> result : testCodeOffset, continueOffset * if (result) goto B * * The infinite loop "while 1 body" produces: * B: body : all three offsets here * goto B */ if (loopMayEnd) { TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup); testCodeOffset = 0; /* Avoid compiler warning. */ } else { /* * Make sure that the first command in the body is preceded by an * INST_START_CMD, and hence counted properly. [Bug 1752146] */ envPtr->atCmdStart &= ~1; testCodeOffset = CurrentOffset(envPtr); } /* * Compile the loop body. */ bodyCodeOffset = ExceptionRangeStarts(envPtr, range); if (!loopMayEnd) { envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset; envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset; } BODY(bodyTokenPtr, 2); ExceptionRangeEnds(envPtr, range); OP( POP); /* * Compile the test expression then emit the conditional jump that * terminates the while. We already know it's a simple word. */ if (loopMayEnd) { testCodeOffset = CurrentOffset(envPtr); jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { bodyCodeOffset += 3; testCodeOffset += 3; } SetLineInformation(1); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr); } else { TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr); } } else { jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr); } else { TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr); } } /* * Set the loop's body, continue and break offsets. */ envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset; envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset; ExceptionRangeTarget(envPtr, range, breakOffset); TclFinalizeLoopExceptionRange(envPtr, range); /* * The while command's result is an empty string. */ pushResult: PUSH(""); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileYieldCmd -- * * Procedure called to compile the "yield" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "yield" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileYieldCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { if (parsePtr->numWords < 1 || parsePtr->numWords > 2) { return TCL_ERROR; } if (parsePtr->numWords == 1) { PUSH(""); } else { DefineLineInformation; /* TIP #280 */ Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, valueTokenPtr, interp, 1); } OP( YIELD); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileYieldToCmd -- * * Procedure called to compile the "yieldto" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "yieldto" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileYieldToCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); int i; if (parsePtr->numWords < 2) { return TCL_ERROR; } OP( NS_CURRENT); for (i = 1 ; i < parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } OP4( LIST, i); OP( YIELD_TO_INVOKE); return TCL_OK; } /* *---------------------------------------------------------------------- * * CompileUnaryOpCmd -- * * Utility routine to compile the unary operator commands. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the compiled command at * runtime. * *---------------------------------------------------------------------- */ static int CompileUnaryOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode(instruction, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * CompileAssociativeBinaryOpCmd -- * * Utility routine to compile the binary operator commands that accept an * arbitrary number of arguments, and that are associative operations. * Because of the associativity, we may combine operations from right to * left, saving us any effort of re-ordering the arguments on the stack * after substitutions are completed. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the compiled command at * runtime. * *---------------------------------------------------------------------- */ static int CompileAssociativeBinaryOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int words; /* TODO: Consider support for compiling expanded args. */ for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); } if (parsePtr->numWords <= 2) { PushLiteral(envPtr, identity, -1); words++; } if (words > 3) { /* * Reverse order of arguments to get precise agreement with [expr] in * calculations, including roundoff errors. */ OP4( REVERSE, words-1); } while (--words > 1) { TclEmitOpcode(instruction, envPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * CompileStrictlyBinaryOpCmd -- * * Utility routine to compile the binary operator commands, that strictly * accept exactly two arguments. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the compiled command at * runtime. * *---------------------------------------------------------------------- */ static int CompileStrictlyBinaryOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { if (parsePtr->numWords != 3) { return TCL_ERROR; } return CompileAssociativeBinaryOpCmd(interp, parsePtr, NULL, instruction, envPtr); } /* *---------------------------------------------------------------------- * * CompileComparisonOpCmd -- * * Utility routine to compile the n-ary comparison operator commands. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the compiled command at * runtime. * *---------------------------------------------------------------------- */ static int CompileComparisonOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { PUSH("1"); } else if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(instruction, envPtr); } else if (envPtr->procPtr == NULL) { /* * No local variable space! */ return TCL_ERROR; } else { int tmpIndex = AnonymousLocal(envPtr); int words; tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); STORE(tmpIndex); TclEmitOpcode(instruction, envPtr); for (words=3 ; wordsnumWords ;) { LOAD(tmpIndex); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); if (++words < parsePtr->numWords) { STORE(tmpIndex); } TclEmitOpcode(instruction, envPtr); } for (; words>3 ; words--) { OP( BITAND); } /* * Drop the value from the temp variable; retaining that reference * might be expensive elsewhere. */ OP14( UNSET_SCALAR, 0, tmpIndex); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompile*OpCmd -- * * Procedures called to compile the corresponding "::tcl::mathop::*" * commands. These are all wrappers around the utility operator command * compiler functions, except for the compilers for subtraction and * division, which are special. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the compiled command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileInvertOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr); } int TclCompileNotOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr); } int TclCompileAddOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD, envPtr); } int TclCompileMulOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT, envPtr); } int TclCompileAndOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND, envPtr); } int TclCompileOrOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR, envPtr); } int TclCompileXorOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR, envPtr); } int TclCompilePowOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int words; /* * This one has its own implementation because the ** operator is the only * one with right associativity. */ for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); } if (parsePtr->numWords <= 2) { PUSH("1"); words++; } while (--words > 1) { TclEmitOpcode(INST_EXPON, envPtr); } return TCL_OK; } int TclCompileLshiftOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr); } int TclCompileRshiftOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr); } int TclCompileModOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr); } int TclCompileNeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr); } int TclCompileStrneqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr); } int TclCompileInOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr); } int TclCompileNiOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN, envPtr); } int TclCompileLessOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr); } int TclCompileLeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr); } int TclCompileGreaterOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr); } int TclCompileGeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr); } int TclCompileEqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr); } int TclCompileStreqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr); } int TclCompileMinusOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. */ return TCL_ERROR; } for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); } if (words == 2) { TclEmitOpcode(INST_UMINUS, envPtr); return TCL_OK; } if (words == 3) { TclEmitOpcode(INST_SUB, envPtr); return TCL_OK; } /* * Reverse order of arguments to get precise agreement with [expr] in * calculations, including roundoff errors. */ TclEmitInstInt4(INST_REVERSE, words-1, envPtr); while (--words > 1) { TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitOpcode(INST_SUB, envPtr); } return TCL_OK; } int TclCompileDivOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. */ return TCL_ERROR; } if (parsePtr->numWords == 2) { PUSH("1.0"); } for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); } if (words <= 3) { TclEmitOpcode(INST_DIV, envPtr); return TCL_OK; } /* * Reverse order of arguments to get precise agreement with [expr] in * calculations, including roundoff errors. */ TclEmitInstInt4(INST_REVERSE, words-1, envPtr); while (--words > 1) { TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitOpcode(INST_DIV, envPtr); } return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclCompExpr.c0000644000175000017500000024336414554262142015676 0ustar sergeisergei/* * tclCompExpr.c -- * * This file contains the code to parse and compile Tcl expressions and * implementations of the Tcl commands corresponding to expression * operators, such as the command ::tcl::mathop::+ . * * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" /* CompileEnv */ /* * Expression parsing takes place in the routine ParseExpr(). It takes a * string as input, parses that string, and generates a representation of the * expression in the form of a tree of operators, a list of literals, a list * of function names, and an array of Tcl_Token's within a Tcl_Parse struct. * The tree is composed of OpNodes. */ typedef struct OpNode { int left; /* "Pointer" to the left operand. */ int right; /* "Pointer" to the right operand. */ union { int parent; /* "Pointer" to the parent operand. */ int prev; /* "Pointer" joining incomplete tree stack */ } p; unsigned char lexeme; /* Code that identifies the operator. */ unsigned char precedence; /* Precedence of the operator */ unsigned char mark; /* Mark used to control traversal. */ unsigned char constant; /* Flag marking constant subexpressions. */ } OpNode; /* * The storage for the tree is dynamically allocated array of OpNodes. The * array is grown as parsing needs dictate according to a scheme similar to * Tcl's string growth algorithm, so that the resizing costs are O(N) and so * that we use at least half the memory allocated as expressions get large. * * Each OpNode in the tree represents an operator in the expression, either * unary or binary. When parsing is completed successfully, a binary operator * OpNode will have its left and right fields filled with "pointers" to its * left and right operands. A unary operator OpNode will have its right field * filled with a pointer to its single operand. When an operand is a * subexpression the "pointer" takes the form of the index -- a non-negative * integer -- into the OpNode storage array where the root of that * subexpression parse tree is found. * * Non-operator elements of the expression do not get stored in the OpNode * tree. They are stored in the other structures according to their type. * Literal values get appended to the literal list. Elements that denote forms * of quoting or substitution known to the Tcl parser get stored as * Tcl_Tokens. These non-operator elements of the expression are the leaves of * the completed parse tree. When an operand of an OpNode is one of these leaf * elements, the following negative integer codes are used to indicate which * kind of elements it is. */ enum OperandTypes { OT_LITERAL = -3, /* Operand is a literal in the literal list */ OT_TOKENS = -2, /* Operand is sequence of Tcl_Tokens */ OT_EMPTY = -1 /* "Operand" is an empty string. This is a special * case used only to represent the EMPTY lexeme. See * below. */ }; /* * Readable macros to test whether a "pointer" value points to an operator. * They operate on the "non-negative integer -> operator; negative integer -> * a non-operator OperandType" distinction. */ #define IsOperator(l) ((l) >= 0) #define NotOperator(l) ((l) < 0) /* * Note that it is sufficient to store in the tree just the type of leaf * operand, without any explicit pointer to which leaf. This is true because * the traversals of the completed tree we perform are known to visit the * leaves in the same order as the original parse. * * In a completed parse tree, those OpNodes that are themselves (roots of * subexpression trees that are) operands of some operator store in their * p.parent field a "pointer" to the OpNode of that operator. The p.parent * field permits a traversal of the tree within a non-recursive routine * (ConvertTreeToTokens() and CompileExprTree()). This means that even * expression trees of great depth pose no risk of blowing the C stack. * * While the parse tree is being constructed, the same memory space is used to * hold the p.prev field which chains together a stack of incomplete trees * awaiting their right operands. * * The lexeme field is filled in with the lexeme of the operator that is * returned by the ParseLexeme() routine. Only lexemes for unary and binary * operators get stored in an OpNode. Other lexmes get different treatment. * * The precedence field provides a place to store the precedence of the * operator, so it need not be looked up again and again. * * The mark field is use to control the traversal of the tree, so that it can * be done non-recursively. The mark values are: */ enum Marks { MARK_LEFT, /* Next step of traversal is to visit left subtree */ MARK_RIGHT, /* Next step of traversal is to visit right subtree */ MARK_PARENT /* Next step of traversal is to return to parent */ }; /* * The constant field is a boolean flag marking which subexpressions are * completely known at compile time, and are eligible for computing then * rather than waiting until run time. */ /* * Each lexeme belongs to one of four categories, which determine its place in * the parse tree. We use the two high bits of the (unsigned char) value to * store a NODE_TYPE code. */ #define NODE_TYPE 0xC0 /* * The four category values are LEAF, UNARY, and BINARY, explained below, and * "uncategorized", which is used either temporarily, until context determines * which of the other three categories is correct, or for lexemes like * INVALID, which aren't really lexemes at all, but indicators of a parsing * error. Note that the codes must be distinct to distinguish categories, but * need not take the form of a bit array. */ #define BINARY 0x40 /* This lexeme is a binary operator. An OpNode * representing it should go into the parse * tree, and two operands should be parsed for * it in the expression. */ #define UNARY 0x80 /* This lexeme is a unary operator. An OpNode * representing it should go into the parse * tree, and one operand should be parsed for * it in the expression. */ #define LEAF 0xC0 /* This lexeme is a leaf operand in the parse * tree. No OpNode will be placed in the tree * for it. Either a literal value will be * appended to the list of literals in this * expression, or appropriate Tcl_Tokens will * be appended in a Tcl_Parse struct to * represent those leaves that require some * form of substitution. */ /* Uncategorized lexemes */ #define PLUS 1 /* Ambiguous. Resolves to UNARY_PLUS or * BINARY_PLUS according to context. */ #define MINUS 2 /* Ambiguous. Resolves to UNARY_MINUS or * BINARY_MINUS according to context. */ #define BAREWORD 3 /* Ambiguous. Resolves to BOOLEAN or to * FUNCTION or a parse error according to * context and value. */ #define INCOMPLETE 4 /* A parse error. Used only when the single * "=" is encountered. */ #define INVALID 5 /* A parse error. Used when any punctuation * appears that's not a supported operator. */ /* Leaf lexemes */ #define NUMBER (LEAF | 1) /* For literal numbers */ #define SCRIPT (LEAF | 2) /* Script substitution; [foo] */ #define BOOLEAN (LEAF | BAREWORD) /* For literal booleans */ #define BRACED (LEAF | 4) /* Braced string; {foo bar} */ #define VARIABLE (LEAF | 5) /* Variable substitution; $x */ #define QUOTED (LEAF | 6) /* Quoted string; "foo $bar [soom]" */ #define EMPTY (LEAF | 7) /* Used only for an empty argument list to a * function. Represents the empty string * within parens in the expression: rand() */ /* Unary operator lexemes */ #define UNARY_PLUS (UNARY | PLUS) #define UNARY_MINUS (UNARY | MINUS) #define FUNCTION (UNARY | BAREWORD) /* This is a bit of "creative interpretation" * on the part of the parser. A function call * is parsed into the parse tree according to * the perspective that the function name is a * unary operator and its argument list, * enclosed in parens, is its operand. The * additional requirements not implied * generally by treatment as a unary operator * -- for example, the requirement that the * operand be enclosed in parens -- are hard * coded in the relevant portions of * ParseExpr(). We trade off the need to * include such exceptional handling in the * code against the need we would otherwise * have for more lexeme categories. */ #define START (UNARY | 4) /* This lexeme isn't parsed from the * expression text at all. It represents the * start of the expression and sits at the * root of the parse tree where it serves as * the start/end point of traversals. */ #define OPEN_PAREN (UNARY | 5) /* Another bit of creative interpretation, * where we treat "(" as a unary operator with * the sub-expression between it and its * matching ")" as its operand. See * CLOSE_PAREN below. */ #define NOT (UNARY | 6) #define BIT_NOT (UNARY | 7) /* Binary operator lexemes */ #define BINARY_PLUS (BINARY | PLUS) #define BINARY_MINUS (BINARY | MINUS) #define COMMA (BINARY | 3) /* The "," operator is a low precedence binary * operator that separates the arguments in a * function call. The additional constraint * that this operator can only legally appear * at the right places within a function call * argument list are hard coded within * ParseExpr(). */ #define MULT (BINARY | 4) #define DIVIDE (BINARY | 5) #define MOD (BINARY | 6) #define LESS (BINARY | 7) #define GREATER (BINARY | 8) #define BIT_AND (BINARY | 9) #define BIT_XOR (BINARY | 10) #define BIT_OR (BINARY | 11) #define QUESTION (BINARY | 12) /* These two lexemes make up the */ #define COLON (BINARY | 13) /* ternary conditional operator, $x ? $y : $z. * We treat them as two binary operators to * avoid another lexeme category, and code the * additional constraints directly in * ParseExpr(). For instance, the right * operand of a "?" operator must be a ":" * operator. */ #define LEFT_SHIFT (BINARY | 14) #define RIGHT_SHIFT (BINARY | 15) #define LEQ (BINARY | 16) #define GEQ (BINARY | 17) #define EQUAL (BINARY | 18) #define NEQ (BINARY | 19) #define AND (BINARY | 20) #define OR (BINARY | 21) #define STREQ (BINARY | 22) #define STRNEQ (BINARY | 23) #define EXPON (BINARY | 24) /* Unlike the other binary operators, EXPON is * right associative and this distinction is * coded directly in ParseExpr(). */ #define IN_LIST (BINARY | 25) #define NOT_IN_LIST (BINARY | 26) #define CLOSE_PAREN (BINARY | 27) /* By categorizing the CLOSE_PAREN lexeme as a * BINARY operator, the normal parsing rules * for binary operators assure that a close * paren will not directly follow another * operator, and the machinery already in * place to connect operands to operators * according to precedence performs most of * the work of matching open and close parens * for us. In the end though, a close paren is * not really a binary operator, and some * special coding in ParseExpr() make sure we * never put an actual CLOSE_PAREN node in the * parse tree. The sub-expression between * parens becomes the single argument of the * matching OPEN_PAREN unary operator. */ #define END (BINARY | 28) /* This lexeme represents the end of the * string being parsed. Treating it as a * binary operator follows the same logic as * the CLOSE_PAREN lexeme and END pairs with * START, in the same way that CLOSE_PAREN * pairs with OPEN_PAREN. */ /* * When ParseExpr() builds the parse tree it must choose which operands to * connect to which operators. This is done according to operator precedence. * The greater an operator's precedence the greater claim it has to link to an * available operand. The Precedence enumeration lists the precedence values * used by Tcl expression operators, from lowest to highest claim. Each * precedence level is commented with the operators that hold that precedence. */ enum Precedence { PREC_END = 1, /* END */ PREC_START, /* START */ PREC_CLOSE_PAREN, /* ")" */ PREC_OPEN_PAREN, /* "(" */ PREC_COMMA, /* "," */ PREC_CONDITIONAL, /* "?", ":" */ PREC_OR, /* "||" */ PREC_AND, /* "&&" */ PREC_BIT_OR, /* "|" */ PREC_BIT_XOR, /* "^" */ PREC_BIT_AND, /* "&" */ PREC_EQUAL, /* "==", "!=", "eq", "ne", "in", "ni" */ PREC_COMPARE, /* "<", ">", "<=", ">=" */ PREC_SHIFT, /* "<<", ">>" */ PREC_ADD, /* "+", "-" */ PREC_MULT, /* "*", "/", "%" */ PREC_EXPON, /* "**" */ PREC_UNARY /* "+", "-", FUNCTION, "!", "~" */ }; /* * Here the same information contained in the comments above is stored in * inverted form, so that given a lexeme, one can quickly look up its * precedence value. */ static const unsigned char prec[] = { /* Non-operator lexemes */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* Binary operator lexemes */ PREC_ADD, /* BINARY_PLUS */ PREC_ADD, /* BINARY_MINUS */ PREC_COMMA, /* COMMA */ PREC_MULT, /* MULT */ PREC_MULT, /* DIVIDE */ PREC_MULT, /* MOD */ PREC_COMPARE, /* LESS */ PREC_COMPARE, /* GREATER */ PREC_BIT_AND, /* BIT_AND */ PREC_BIT_XOR, /* BIT_XOR */ PREC_BIT_OR, /* BIT_OR */ PREC_CONDITIONAL, /* QUESTION */ PREC_CONDITIONAL, /* COLON */ PREC_SHIFT, /* LEFT_SHIFT */ PREC_SHIFT, /* RIGHT_SHIFT */ PREC_COMPARE, /* LEQ */ PREC_COMPARE, /* GEQ */ PREC_EQUAL, /* EQUAL */ PREC_EQUAL, /* NEQ */ PREC_AND, /* AND */ PREC_OR, /* OR */ PREC_EQUAL, /* STREQ */ PREC_EQUAL, /* STRNEQ */ PREC_EXPON, /* EXPON */ PREC_EQUAL, /* IN_LIST */ PREC_EQUAL, /* NOT_IN_LIST */ PREC_CLOSE_PAREN, /* CLOSE_PAREN */ PREC_END, /* END */ /* Expansion room for more binary operators */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* Unary operator lexemes */ PREC_UNARY, /* UNARY_PLUS */ PREC_UNARY, /* UNARY_MINUS */ PREC_UNARY, /* FUNCTION */ PREC_START, /* START */ PREC_OPEN_PAREN, /* OPEN_PAREN */ PREC_UNARY, /* NOT*/ PREC_UNARY, /* BIT_NOT*/ }; /* * A table mapping lexemes to bytecode instructions, used by CompileExprTree(). */ static const unsigned char instruction[] = { /* Non-operator lexemes */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* Binary operator lexemes */ INST_ADD, /* BINARY_PLUS */ INST_SUB, /* BINARY_MINUS */ 0, /* COMMA */ INST_MULT, /* MULT */ INST_DIV, /* DIVIDE */ INST_MOD, /* MOD */ INST_LT, /* LESS */ INST_GT, /* GREATER */ INST_BITAND, /* BIT_AND */ INST_BITXOR, /* BIT_XOR */ INST_BITOR, /* BIT_OR */ 0, /* QUESTION */ 0, /* COLON */ INST_LSHIFT, /* LEFT_SHIFT */ INST_RSHIFT, /* RIGHT_SHIFT */ INST_LE, /* LEQ */ INST_GE, /* GEQ */ INST_EQ, /* EQUAL */ INST_NEQ, /* NEQ */ 0, /* AND */ 0, /* OR */ INST_STR_EQ, /* STREQ */ INST_STR_NEQ, /* STRNEQ */ INST_EXPON, /* EXPON */ INST_LIST_IN, /* IN_LIST */ INST_LIST_NOT_IN, /* NOT_IN_LIST */ 0, /* CLOSE_PAREN */ 0, /* END */ /* Expansion room for more binary operators */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* Unary operator lexemes */ INST_UPLUS, /* UNARY_PLUS */ INST_UMINUS, /* UNARY_MINUS */ 0, /* FUNCTION */ 0, /* START */ 0, /* OPEN_PAREN */ INST_LNOT, /* NOT*/ INST_BITNOT, /* BIT_NOT*/ }; /* * A table mapping a byte value to the corresponding lexeme for use by * ParseLexeme(). */ static const unsigned char Lexeme[] = { INVALID /* NUL */, INVALID /* SOH */, INVALID /* STX */, INVALID /* ETX */, INVALID /* EOT */, INVALID /* ENQ */, INVALID /* ACK */, INVALID /* BEL */, INVALID /* BS */, INVALID /* HT */, INVALID /* LF */, INVALID /* VT */, INVALID /* FF */, INVALID /* CR */, INVALID /* SO */, INVALID /* SI */, INVALID /* DLE */, INVALID /* DC1 */, INVALID /* DC2 */, INVALID /* DC3 */, INVALID /* DC4 */, INVALID /* NAK */, INVALID /* SYN */, INVALID /* ETB */, INVALID /* CAN */, INVALID /* EM */, INVALID /* SUB */, INVALID /* ESC */, INVALID /* FS */, INVALID /* GS */, INVALID /* RS */, INVALID /* US */, INVALID /* SPACE */, 0 /* ! or != */, QUOTED /* " */, INVALID /* # */, VARIABLE /* $ */, MOD /* % */, 0 /* & or && */, INVALID /* ' */, OPEN_PAREN /* ( */, CLOSE_PAREN /* ) */, 0 /* * or ** */, PLUS /* + */, COMMA /* , */, MINUS /* - */, 0 /* . */, DIVIDE /* / */, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0-9 */ COLON /* : */, INVALID /* ; */, 0 /* < or << or <= */, 0 /* == or INVALID */, 0 /* > or >> or >= */, QUESTION /* ? */, INVALID /* @ */, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A-M */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* N-Z */ SCRIPT /* [ */, INVALID /* \ */, INVALID /* ] */, BIT_XOR /* ^ */, INVALID /* _ */, INVALID /* ` */, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* a-m */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* n-z */ BRACED /* { */, 0 /* | or || */, INVALID /* } */, BIT_NOT /* ~ */, INVALID /* DEL */ }; /* * The JumpList struct is used to create a stack of data needed for the * TclEmitForwardJump() and TclFixupForwardJump() calls that are performed * when compiling the short-circuiting operators QUESTION/COLON, AND, and OR. * Keeping a stack permits the CompileExprTree() routine to be non-recursive. */ typedef struct JumpList { JumpFixup jump; /* Pass this argument to matching calls of * TclEmitForwardJump() and * TclFixupForwardJump(). */ struct JumpList *next; /* Point to next item on the stack */ } JumpList; /* * Declarations for local functions to this file: */ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj *const **litObjvPtr, Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, CompileEnv *envPtr, int optimize); static void ConvertTreeToTokens(const char *start, int numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr); static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj * const **litObjvPtr); static int ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, OpNode **opTreePtr, Tcl_Obj *litList, Tcl_Obj *funcList, Tcl_Parse *parsePtr, int parseOnly); static int ParseLexeme(const char *start, int numBytes, unsigned char *lexemePtr, Tcl_Obj **literalPtr); /* *---------------------------------------------------------------------- * * ParseExpr -- * * Given a string, the numBytes bytes starting at start, this function * parses it as a Tcl expression and constructs a tree representing the * structure of the expression. The caller must pass in empty lists as * the funcList and litList arguments. The elements of the parsed * expression are returned to the caller as that tree, a list of literal * values, a list of function names, and in Tcl_Tokens added to a * Tcl_Parse struct passed in by the caller. * * Results: * If the string is successfully parsed as a valid Tcl expression, TCL_OK * is returned, and data about the expression structure is written to the * last four arguments. If the string cannot be parsed as a valid Tcl * expression, TCL_ERROR is returned, and if interp is non-NULL, an error * message is written to interp. * * Side effects: * Memory will be allocated. If TCL_OK is returned, the caller must clean * up the returned data structures. The (OpNode *) value written to * opTreePtr should be passed to ckfree() and the parsePtr argument * should be passed to Tcl_FreeParse(). The elements appended to the * litList and funcList will automatically be freed whenever the refcount * on those lists indicates they can be freed. * *---------------------------------------------------------------------- */ static int ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ int numBytes, /* Number of bytes in string. */ OpNode **opTreePtr, /* Points to space where a pointer to the * allocated OpNode tree should go. */ Tcl_Obj *litList, /* List to append literals to. */ Tcl_Obj *funcList, /* List to append function names to. */ Tcl_Parse *parsePtr, /* Structure to fill with tokens representing * those operands that require run time * substitutions. */ int parseOnly) /* A boolean indicating whether the caller's * aim is just a parse, or whether it will go * on to compile the expression. Different * optimizations are appropriate for the two * scenarios. */ { OpNode *nodes = NULL; /* Pointer to the OpNode storage array where * we build the parse tree. */ unsigned int nodesAvailable = 64; /* Initial size of the storage array. This * value establishes a minimum tree memory * cost of only about 1 kilobyte, and is large * enough for most expressions to parse with * no need for array growth and * reallocation. */ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */ int scanned = 0; /* Capture number of byte scanned by parsing * routines. */ int lastParsed; /* Stores info about what the lexeme parsed * the previous pass through the parsing loop * was. If it was an operator, lastParsed is * the index of the OpNode for that operator. * If it was not an operator, lastParsed holds * an OperandTypes value encoding what we need * to know about it. */ int incomplete; /* Index of the most recent incomplete tree in * the OpNode array. Heads a stack of * incomplete trees linked by p.prev. */ int complete = OT_EMPTY; /* "Index" of the complete tree (that is, a * complete subexpression) determined at the * moment. OT_EMPTY is a nonsense value used * only to silence compiler warnings. During a * parse, complete will always hold an index * or an OperandTypes value pointing to an * actual leaf at the time the complete tree * is needed. */ /* * These variables control generation of the error message. */ Tcl_Obj *msg = NULL; /* The error message. */ Tcl_Obj *post = NULL; /* In a few cases, an additional postscript * for the error message, supplying more * information after the error msg and * location have been reported. */ const char *errCode = NULL; /* The detail word of the errorCode list, or * NULL to indicate that no changes to the * errorCode are to be done. */ const char *subErrCode = NULL; /* Extra information for use in generating the * errorCode. */ const char *mark = "_@_"; /* In the portion of the complete error * message where the error location is * reported, this "mark" substring is inserted * into the string being parsed to aid in * pinpointing the location of the syntax * error in the expression. */ int insertMark = 0; /* A boolean controlling whether the "mark" * should be inserted. */ const int limit = 25; /* Portions of the error message are * constructed out of substrings of the * original expression. In order to keep the * error message readable, we impose this * limit on the substring size we extract. */ TclParseInit(interp, start, numBytes, parsePtr); nodes = (OpNode *)attemptckalloc(nodesAvailable * sizeof(OpNode)); if (nodes == NULL) { TclNewLiteralStringObj(msg, "not enough memory to parse expression"); errCode = "NOMEM"; goto error; } /* * Initialize the parse tree with the special "START" node. */ nodes->lexeme = START; nodes->precedence = prec[START]; nodes->mark = MARK_RIGHT; nodes->constant = 1; incomplete = lastParsed = nodesUsed; nodesUsed++; /* * Main parsing loop parses one lexeme per iteration. We exit the loop * only when there's a syntax error with a "goto error" which takes us to * the error handling code following the loop, or when we've successfully * completed the parse and we return to the caller. */ while (1) { OpNode *nodePtr; /* Points to the OpNode we may fill this pass * through the loop. */ unsigned char lexeme; /* The lexeme we parse this iteration. */ Tcl_Obj *literal; /* Filled by the ParseLexeme() call when a * literal is parsed that has a Tcl_Obj rep * worth preserving. */ /* * Each pass through this loop adds up to one more OpNode. Allocate * space for one if required. */ if (nodesUsed >= nodesAvailable) { unsigned int size = nodesUsed * 2; OpNode *newPtr = NULL; do { if (size <= UINT_MAX/sizeof(OpNode)) { newPtr = (OpNode *) attemptckrealloc(nodes, size * sizeof(OpNode)); } } while ((newPtr == NULL) && ((size -= (size - nodesUsed) / 2) > nodesUsed)); if (newPtr == NULL) { TclNewLiteralStringObj(msg, "not enough memory to parse expression"); errCode = "NOMEM"; goto error; } nodesAvailable = size; nodes = newPtr; } nodePtr = nodes + nodesUsed; /* * Skip white space between lexemes. */ scanned = TclParseAllWhiteSpace(start, numBytes); start += scanned; numBytes -= scanned; scanned = ParseLexeme(start, numBytes, &lexeme, &literal); /* * Use context to categorize the lexemes that are ambiguous. */ if ((NODE_TYPE & lexeme) == 0) { int b; switch (lexeme) { case INVALID: msg = Tcl_ObjPrintf("invalid character \"%.*s\"", scanned, start); errCode = "BADCHAR"; goto error; case INCOMPLETE: msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"", scanned, start); errCode = "PARTOP"; goto error; case BAREWORD: /* * Most barewords in an expression are a syntax error. The * exceptions are that when a bareword is followed by an open * paren, it might be a function call, and when the bareword * is a legal literal boolean value, we accept that as well. */ if (start[scanned+TclParseAllWhiteSpace( start+scanned, numBytes-scanned)] == '(') { lexeme = FUNCTION; /* * When we compile the expression we'll need the function * name, and there's no place in the parse tree to store * it, so we keep a separate list of all the function * names we've parsed in the order we found them. */ Tcl_ListObjAppendElement(NULL, funcList, literal); } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) { lexeme = BOOLEAN; } else { Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "...", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); errCode = "BAREWORD"; if (start[0] == '0') { const char *stop; TclParseNumber(NULL, NULL, NULL, start, scanned, &stop, TCL_PARSE_NO_WHITESPACE); if (isdigit(UCHAR(*stop)) || (stop == start + 1)) { switch (start[1]) { case 'b': Tcl_AppendToObj(post, " (invalid binary number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "BINARY"; break; case 'o': Tcl_AppendToObj(post, " (invalid octal number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "OCTAL"; break; default: if (isdigit(UCHAR(start[1]))) { Tcl_AppendToObj(post, " (invalid octal number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "OCTAL"; } break; } } } goto error; } break; case PLUS: case MINUS: if (IsOperator(lastParsed)) { /* * A "+" or "-" coming just after another operator must be * interpreted as a unary operator. */ lexeme |= UNARY; } else { lexeme |= BINARY; } } } /* Uncategorized lexemes */ /* * Handle lexeme based on its category. */ switch (NODE_TYPE & lexeme) { case LEAF: { /* * Each LEAF results in either a literal getting appended to the * litList, or a sequence of Tcl_Tokens representing a Tcl word * getting appended to the parsePtr->tokens. No OpNode is filled * for this lexeme. */ Tcl_Token *tokenPtr; const char *end = start; int wordIndex; int code = TCL_OK; /* * A leaf operand appearing just after something that's not an * operator is a syntax error. */ if (NotOperator(lastParsed)) { msg = Tcl_ObjPrintf("missing operator at %s", mark); errCode = "MISSING"; scanned = 0; insertMark = 1; /* * Free any literal to avoid a memleak. */ if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) { Tcl_DecrRefCount(literal); } goto error; } switch (lexeme) { case NUMBER: case BOOLEAN: /* * TODO: Consider using a dict or hash to collapse all * duplicate literals into a single representative value. * (Like what is done with [split $s {}]). * Pro: ~75% memory saving on expressions like * {1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost * to "pointer" cost only) * Con: Cost of the dict store/retrieve on every literal in * every expression when expressions like the above tend * to be uncommon. * The memory savings is temporary; Compiling to bytecode * will collapse things as literals are registered * anyway, so the savings applies only to the time * between parsing and compiling. Possibly important due * to high-water mark nature of memory allocation. */ Tcl_ListObjAppendElement(NULL, litList, literal); complete = lastParsed = OT_LITERAL; start += scanned; numBytes -= scanned; continue; default: break; } /* * Remaining LEAF cases may involve filling Tcl_Tokens, so make * room for at least 2 more tokens. */ TclGrowParseTokenArray(parsePtr, 2); wordIndex = parsePtr->numTokens; tokenPtr = parsePtr->tokenPtr + wordIndex; tokenPtr->type = TCL_TOKEN_WORD; tokenPtr->start = start; parsePtr->numTokens++; switch (lexeme) { case QUOTED: code = Tcl_ParseQuotedString(NULL, start, numBytes, parsePtr, 1, &end); scanned = end - start; break; case BRACED: code = Tcl_ParseBraces(NULL, start, numBytes, parsePtr, 1, &end); scanned = end - start; break; case VARIABLE: code = Tcl_ParseVarName(NULL, start, numBytes, parsePtr, 1); /* * Handle the quirk that Tcl_ParseVarName reports a successful * parse even when it gets only a "$" with no variable name. */ tokenPtr = parsePtr->tokenPtr + wordIndex + 1; if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) { TclNewLiteralStringObj(msg, "invalid character \"$\""); errCode = "BADCHAR"; goto error; } scanned = tokenPtr->size; break; case SCRIPT: { Tcl_Parse *nestedPtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; tokenPtr->type = TCL_TOKEN_COMMAND; tokenPtr->start = start; tokenPtr->numComponents = 0; end = start + numBytes; start++; while (1) { code = Tcl_ParseCommand(interp, start, end - start, 1, nestedPtr); if (code != TCL_OK) { parsePtr->term = nestedPtr->term; parsePtr->errorType = nestedPtr->errorType; parsePtr->incomplete = nestedPtr->incomplete; break; } start = nestedPtr->commandStart + nestedPtr->commandSize; Tcl_FreeParse(nestedPtr); if ((nestedPtr->term < end) && (nestedPtr->term[0] == ']') && !nestedPtr->incomplete) { break; } if (start == end) { TclNewLiteralStringObj(msg, "missing close-bracket"); parsePtr->term = tokenPtr->start; parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; parsePtr->incomplete = 1; code = TCL_ERROR; errCode = "UNBALANCED"; break; } } TclStackFree(interp, nestedPtr); end = start; start = tokenPtr->start; scanned = end - start; tokenPtr->size = scanned; parsePtr->numTokens++; break; } /* SCRIPT case */ } if (code != TCL_OK) { /* * Here we handle all the syntax errors generated by the * Tcl_Token generating parsing routines called in the switch * just above. If the value of parsePtr->incomplete is 1, then * the error was an unbalanced '[', '(', '{', or '"' and * parsePtr->term is pointing to that unbalanced character. If * the value of parsePtr->incomplete is 0, then the error is * one of lacking whitespace following a quoted word, for * example: expr {[an error {foo}bar]}, and parsePtr->term * points to where the whitespace is missing. We reset our * values of start and scanned so that when our error message * is constructed, the location of the syntax error is sure to * appear in it, even if the quoted expression is truncated. */ start = parsePtr->term; scanned = parsePtr->incomplete; if (parsePtr->incomplete) { errCode = "UNBALANCED"; } goto error; } tokenPtr = parsePtr->tokenPtr + wordIndex; tokenPtr->size = scanned; tokenPtr->numComponents = parsePtr->numTokens - wordIndex - 1; if (!parseOnly && ((lexeme == QUOTED) || (lexeme == BRACED))) { /* * When this expression is destined to be compiled, and a * braced or quoted word within an expression is known at * compile time (no runtime substitutions in it), we can store * it as a literal rather than in its tokenized form. This is * an advantage since the compiled bytecode is going to need * the argument in Tcl_Obj form eventually, so it's just as * well to get there now. Another advantage is that with this * conversion, larger constant expressions might be grown and * optimized. * * On the contrary, if the end goal of this parse is to fill a * Tcl_Parse for a caller of Tcl_ParseExpr(), then it's * wasteful to convert to a literal only to convert back again * later. */ TclNewObj(literal); if (TclWordKnownAtCompileTime(tokenPtr, literal)) { Tcl_ListObjAppendElement(NULL, litList, literal); complete = lastParsed = OT_LITERAL; parsePtr->numTokens = wordIndex; break; } Tcl_DecrRefCount(literal); } complete = lastParsed = OT_TOKENS; break; } /* case LEAF */ case UNARY: /* * A unary operator appearing just after something that's not an * operator is a syntax error -- something trying to be the left * operand of an operator that doesn't take one. */ if (NotOperator(lastParsed)) { msg = Tcl_ObjPrintf("missing operator at %s", mark); scanned = 0; insertMark = 1; errCode = "MISSING"; goto error; } /* * Create an OpNode for the unary operator. */ nodePtr->lexeme = lexeme; nodePtr->precedence = prec[lexeme]; nodePtr->mark = MARK_RIGHT; /* * A FUNCTION cannot be a constant expression, because Tcl allows * functions to return variable results with the same arguments; * for example, rand(). Other unary operators can root a constant * expression, so long as the argument is a constant expression. */ nodePtr->constant = (lexeme != FUNCTION); /* * This unary operator is a new incomplete tree, so push it onto * our stack of incomplete trees. Also remember it as the last * lexeme we parsed. */ nodePtr->p.prev = incomplete; incomplete = lastParsed = nodesUsed; nodesUsed++; break; case BINARY: { OpNode *incompletePtr; unsigned char precedence = prec[lexeme]; /* * A binary operator appearing just after another operator is a * syntax error -- one of the two operators is missing an operand. */ if (IsOperator(lastParsed)) { if ((lexeme == CLOSE_PAREN) && (nodePtr[-1].lexeme == OPEN_PAREN)) { if (nodePtr[-2].lexeme == FUNCTION) { /* * Normally, "()" is a syntax error, but as a special * case accept it as an argument list for a function. * Treat this as a special LEAF lexeme, and restart * the parsing loop with zero characters scanned. We * will parse the ")" again the next time through, but * with the OT_EMPTY leaf as the subexpression between * the parens. */ scanned = 0; complete = lastParsed = OT_EMPTY; break; } msg = Tcl_ObjPrintf("empty subexpression at %s", mark); scanned = 0; insertMark = 1; errCode = "EMPTY"; goto error; } if (nodePtr[-1].precedence > precedence) { if (nodePtr[-1].lexeme == OPEN_PAREN) { TclNewLiteralStringObj(msg, "unbalanced open paren"); parsePtr->errorType = TCL_PARSE_MISSING_PAREN; errCode = "UNBALANCED"; } else if (nodePtr[-1].lexeme == COMMA) { msg = Tcl_ObjPrintf( "missing function argument at %s", mark); scanned = 0; insertMark = 1; errCode = "MISSING"; } else if (nodePtr[-1].lexeme == START) { TclNewLiteralStringObj(msg, "empty expression"); errCode = "EMPTY"; } } else if (lexeme == CLOSE_PAREN) { TclNewLiteralStringObj(msg, "unbalanced close paren"); errCode = "UNBALANCED"; } else if ((lexeme == COMMA) && (nodePtr[-1].lexeme == OPEN_PAREN) && (nodePtr[-2].lexeme == FUNCTION)) { msg = Tcl_ObjPrintf("missing function argument at %s", mark); scanned = 0; insertMark = 1; errCode = "UNBALANCED"; } if (msg == NULL) { msg = Tcl_ObjPrintf("missing operand at %s", mark); scanned = 0; insertMark = 1; errCode = "MISSING"; } goto error; } /* * Here is where the tree comes together. At this point, we have a * stack of incomplete trees corresponding to substrings that are * incomplete expressions, followed by a complete tree * corresponding to a substring that is itself a complete * expression, followed by the binary operator we have just * parsed. The incomplete trees can each be completed by adding a * right operand. * * To illustrate with an example, when we parse the expression * "1+2*3-4" and we reach this point having just parsed the "-" * operator, we have these incomplete trees: START, "1+", and * "2*". Next we have the complete subexpression "3". Last is the * "-" we've just parsed. * * The next step is to join our complete tree to an operator. The * choice is governed by the precedence and associativity of the * competing operators. If we connect it as the right operand of * our most recent incomplete tree, we get a new complete tree, * and we can repeat the process. The while loop following repeats * this until precedence indicates it is time to join the complete * tree as the left operand of the just parsed binary operator. * * Continuing the example, the first pass through the loop will * join "3" to "2*"; the next pass will join "2*3" to "1+". Then * we'll exit the loop and join "1+2*3" to "-". When we return to * parse another lexeme, our stack of incomplete trees is START * and "1+2*3-". */ while (1) { incompletePtr = nodes + incomplete; if (incompletePtr->precedence < precedence) { break; } if (incompletePtr->precedence == precedence) { /* * Right association rules for exponentiation. */ if (lexeme == EXPON) { break; } /* * Special association rules for the conditional * operators. The "?" and ":" operators have equal * precedence, but must be linked up in sensible pairs. */ if ((incompletePtr->lexeme == QUESTION) && (NotOperator(complete) || (nodes[complete].lexeme != COLON))) { break; } if ((incompletePtr->lexeme == COLON) && (lexeme == QUESTION)) { break; } } /* * Some special syntax checks... */ /* Parens must balance */ if ((incompletePtr->lexeme == OPEN_PAREN) && (lexeme != CLOSE_PAREN)) { TclNewLiteralStringObj(msg, "unbalanced open paren"); parsePtr->errorType = TCL_PARSE_MISSING_PAREN; errCode = "UNBALANCED"; goto error; } /* Right operand of "?" must be ":" */ if ((incompletePtr->lexeme == QUESTION) && (NotOperator(complete) || (nodes[complete].lexeme != COLON))) { msg = Tcl_ObjPrintf("missing operator \":\" at %s", mark); scanned = 0; insertMark = 1; errCode = "MISSING"; goto error; } /* Operator ":" may only be right operand of "?" */ if (IsOperator(complete) && (nodes[complete].lexeme == COLON) && (incompletePtr->lexeme != QUESTION)) { TclNewLiteralStringObj(msg, "unexpected operator \":\" " "without preceding \"?\""); errCode = "SURPRISE"; goto error; } /* * Attach complete tree as right operand of most recent * incomplete tree. */ incompletePtr->right = complete; if (IsOperator(complete)) { nodes[complete].p.parent = incomplete; incompletePtr->constant = incompletePtr->constant && nodes[complete].constant; } else { incompletePtr->constant = incompletePtr->constant && (complete == OT_LITERAL); } /* * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations * each make up a single operator. Force them to agree whether * they have a constant expression. */ if ((incompletePtr->lexeme == QUESTION) || (incompletePtr->lexeme == FUNCTION)) { nodes[complete].constant = incompletePtr->constant; } if (incompletePtr->lexeme == START) { /* * Completing the START tree indicates we're done. * Transfer the parse tree to the caller and return. */ *opTreePtr = nodes; return TCL_OK; } /* * With a right operand attached, last incomplete tree has * become the complete tree. Pop it from the incomplete tree * stack. */ complete = incomplete; incomplete = incompletePtr->p.prev; /* CLOSE_PAREN can only close one OPEN_PAREN. */ if (incompletePtr->lexeme == OPEN_PAREN) { break; } } /* * More syntax checks... */ /* Parens must balance. */ if (lexeme == CLOSE_PAREN) { if (incompletePtr->lexeme != OPEN_PAREN) { TclNewLiteralStringObj(msg, "unbalanced close paren"); errCode = "UNBALANCED"; goto error; } } /* Commas must appear only in function argument lists. */ if (lexeme == COMMA) { if ((incompletePtr->lexeme != OPEN_PAREN) || (incompletePtr[-1].lexeme != FUNCTION)) { TclNewLiteralStringObj(msg, "unexpected \",\" outside function argument list"); errCode = "SURPRISE"; goto error; } } /* Operator ":" may only be right operand of "?" */ if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) { TclNewLiteralStringObj(msg, "unexpected operator \":\" without preceding \"?\""); errCode = "SURPRISE"; goto error; } /* * Create no node for a CLOSE_PAREN lexeme. */ if (lexeme == CLOSE_PAREN) { break; } /* * Link complete tree as left operand of new node. */ nodePtr->lexeme = lexeme; nodePtr->precedence = precedence; nodePtr->mark = MARK_LEFT; nodePtr->left = complete; /* * The COMMA operator cannot be optimized, since the function * needs all of its arguments, and optimization would reduce the * number. Other binary operators root constant expressions when * both arguments are constant expressions. */ nodePtr->constant = (lexeme != COMMA); if (IsOperator(complete)) { nodes[complete].p.parent = nodesUsed; nodePtr->constant = nodePtr->constant && nodes[complete].constant; } else { nodePtr->constant = nodePtr->constant && (complete == OT_LITERAL); } /* * With a left operand attached and a right operand missing, the * just-parsed binary operator is root of a new incomplete tree. * Push it onto the stack of incomplete trees. */ nodePtr->p.prev = incomplete; incomplete = lastParsed = nodesUsed; nodesUsed++; break; } /* case BINARY */ } /* lexeme handler */ /* Advance past the just-parsed lexeme */ start += scanned; numBytes -= scanned; } /* main parsing loop */ /* * We only get here if there's been an error. Any errors that didn't get a * suitable parsePtr->errorType, get recorded as syntax errors. */ error: if (parsePtr->errorType == TCL_PARSE_SUCCESS) { parsePtr->errorType = TCL_PARSE_SYNTAX; } /* * Free any partial parse tree we've built. */ if (nodes != NULL) { ckfree(nodes); } if (interp == NULL) { /* * Nowhere to report an error message, so just free it. */ if (msg) { Tcl_DecrRefCount(msg); } } else { /* * Construct the complete error message. Start with the simple error * message, pulled from the interp result if necessary... */ if (msg == NULL) { msg = Tcl_GetObjResult(interp); } /* * Add a detailed quote from the bad expression, displaying and * sometimes marking the precise location of the syntax error. */ Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", ((start - limit) < parsePtr->string) ? "" : "...", ((start - limit) < parsePtr->string) ? (int) (start - parsePtr->string) : limit - 3, ((start - limit) < parsePtr->string) ? parsePtr->string : start - limit + 3, (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "...", insertMark ? mark : "", (start + scanned + limit > parsePtr->end) ? (int) (parsePtr->end - start) - scanned : limit-3, start + scanned, (start + scanned + limit > parsePtr->end) ? "" : "..."); /* * Next, append any postscript message. */ if (post != NULL) { Tcl_AppendToObj(msg, ";\n", -1); Tcl_AppendObjToObj(msg, post); Tcl_DecrRefCount(post); } Tcl_SetObjResult(interp, msg); /* * Finally, place context information in the errorInfo. */ numBytes = parsePtr->end - parsePtr->string; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing expression \"%.*s%s\")", (numBytes < limit) ? numBytes : limit - 3, parsePtr->string, (numBytes < limit) ? "" : "...")); if (errCode) { Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode, subErrCode, NULL); } } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * ConvertTreeToTokens -- * * Given a string, the numBytes bytes starting at start, and an OpNode * tree and Tcl_Token array created by passing that same string to * ParseExpr(), this function writes into *parsePtr the sequence of * Tcl_Tokens needed so to satisfy the historical interface provided by * Tcl_ParseExpr(). Note that this routine exists only for the sake of * the public Tcl_ParseExpr() routine. It is not used by Tcl itself at * all. * * Results: * None. * * Side effects: * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the * parsed expression. * *---------------------------------------------------------------------- */ static void ConvertTreeToTokens( const char *start, int numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr) { int subExprTokenIdx = 0; OpNode *nodePtr = nodes; int next = nodePtr->right; while (1) { Tcl_Token *subExprTokenPtr; int scanned, parentIdx; unsigned char lexeme; /* * Advance the mark so the next exit from this node won't retrace * steps over ground already covered. */ nodePtr->mark++; /* * Handle next child node or leaf. */ switch (next) { case OT_EMPTY: /* No tokens and no characters for the OT_EMPTY leaf. */ break; case OT_LITERAL: /* * Skip any white space that comes before the literal. */ scanned = TclParseAllWhiteSpace(start, numBytes); start += scanned; numBytes -= scanned; /* * Reparse the literal to get pointers into source string. */ scanned = ParseLexeme(start, numBytes, &lexeme, NULL); TclGrowParseTokenArray(parsePtr, 2); subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; subExprTokenPtr->start = start; subExprTokenPtr->size = scanned; subExprTokenPtr->numComponents = 1; subExprTokenPtr[1].type = TCL_TOKEN_TEXT; subExprTokenPtr[1].start = start; subExprTokenPtr[1].size = scanned; subExprTokenPtr[1].numComponents = 0; parsePtr->numTokens += 2; start += scanned; numBytes -= scanned; break; case OT_TOKENS: { /* * tokenPtr points to a token sequence that came from parsing a * Tcl word. A Tcl word is made up of a sequence of one or more * elements. When the word is only a single element, it's been the * historical practice to replace the TCL_TOKEN_WORD token * directly with a TCL_TOKEN_SUB_EXPR token. However, when the * word has multiple elements, a TCL_TOKEN_WORD token is kept as a * grouping device so that TCL_TOKEN_SUB_EXPR always has only one * element. Wise or not, these are the rules the Tcl expr parser * has followed, and for the sake of those few callers of * Tcl_ParseExpr() we do not change them now. Internally, we can * do better. */ int toCopy = tokenPtr->numComponents + 1; if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) { /* * Single element word. Copy tokens and convert the leading * token to TCL_TOKEN_SUB_EXPR. */ TclGrowParseTokenArray(parsePtr, toCopy); subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; memcpy(subExprTokenPtr, tokenPtr, (size_t) toCopy * sizeof(Tcl_Token)); subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; parsePtr->numTokens += toCopy; } else { /* * Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to * lead, with fields initialized from the leading token, then * copy entire set of word tokens. */ TclGrowParseTokenArray(parsePtr, toCopy+1); subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; *subExprTokenPtr = *tokenPtr; subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; subExprTokenPtr->numComponents++; subExprTokenPtr++; memcpy(subExprTokenPtr, tokenPtr, (size_t) toCopy * sizeof(Tcl_Token)); parsePtr->numTokens += toCopy + 1; } scanned = tokenPtr->start + tokenPtr->size - start; start += scanned; numBytes -= scanned; tokenPtr += toCopy; break; } default: /* * Advance to the child node, which is an operator. */ nodePtr = nodes + next; /* * Skip any white space that comes before the subexpression. */ scanned = TclParseAllWhiteSpace(start, numBytes); start += scanned; numBytes -= scanned; /* * Generate tokens for the operator / subexpression... */ switch (nodePtr->lexeme) { case OPEN_PAREN: case COMMA: case COLON: /* * Historical practice has been to have no Tcl_Tokens for * these operators. */ break; default: { /* * Remember the index of the last subexpression we were * working on -- that of our parent. We'll stack it later. */ parentIdx = subExprTokenIdx; /* * Verify space for the two leading Tcl_Tokens representing * the subexpression rooted by this operator. The first * Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second of * type TCL_TOKEN_OPERATOR. */ TclGrowParseTokenArray(parsePtr, 2); subExprTokenIdx = parsePtr->numTokens; subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; parsePtr->numTokens += 2; subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; subExprTokenPtr[1].type = TCL_TOKEN_OPERATOR; /* * Our current position scanning the string is the starting * point for this subexpression. */ subExprTokenPtr->start = start; /* * Eventually, we know that the numComponents field of the * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0. This means * we can make other use of this field for now to track the * stack of subexpressions we have pending. */ subExprTokenPtr[1].numComponents = parentIdx; break; } } break; } /* Determine which way to exit the node on this pass. */ router: switch (nodePtr->mark) { case MARK_LEFT: next = nodePtr->left; break; case MARK_RIGHT: next = nodePtr->right; /* * Skip any white space that comes before the operator. */ scanned = TclParseAllWhiteSpace(start, numBytes); start += scanned; numBytes -= scanned; /* * Here we scan from the string the operator corresponding to * nodePtr->lexeme. */ scanned = ParseLexeme(start, numBytes, &lexeme, NULL); switch(nodePtr->lexeme) { case OPEN_PAREN: case COMMA: case COLON: /* * No tokens for these lexemes -> nothing to do. */ break; default: /* * Record in the TCL_TOKEN_OPERATOR token the pointers into * the string marking where the operator is. */ subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; subExprTokenPtr[1].start = start; subExprTokenPtr[1].size = scanned; break; } start += scanned; numBytes -= scanned; break; case MARK_PARENT: switch (nodePtr->lexeme) { case START: /* When we get back to the START node, we're done. */ return; case COMMA: case COLON: /* No tokens for these lexemes -> nothing to do. */ break; case OPEN_PAREN: /* * Skip past matching close paren. */ scanned = TclParseAllWhiteSpace(start, numBytes); start += scanned; numBytes -= scanned; scanned = ParseLexeme(start, numBytes, &lexeme, NULL); start += scanned; numBytes -= scanned; break; default: /* * Before we leave this node/operator/subexpression for the * last time, finish up its tokens.... * * Our current position scanning the string is where the * substring for the subexpression ends. */ subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; subExprTokenPtr->size = start - subExprTokenPtr->start; /* * All the Tcl_Tokens allocated and filled belong to * this subexpression. The first token is the leading * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer) * are its components. */ subExprTokenPtr->numComponents = (parsePtr->numTokens - subExprTokenIdx) - 1; /* * Finally, as we return up the tree to our parent, pop the * parent subexpression off our subexpression stack, and * fill in the zero numComponents for the operator Tcl_Token. */ parentIdx = subExprTokenPtr[1].numComponents; subExprTokenPtr[1].numComponents = 0; subExprTokenIdx = parentIdx; break; } /* * Since we're returning to parent, skip child handling code. */ nodePtr = nodes + nodePtr->p.parent; goto router; } } } /* *---------------------------------------------------------------------- * * Tcl_ParseExpr -- * * Given a string, the numBytes bytes starting at start, this function * parses it as a Tcl expression and stores information about the * structure of the expression in the Tcl_Parse struct indicated by the * caller. * * Results: * If the string is successfully parsed as a valid Tcl expression, TCL_OK * is returned, and data about the expression structure is written to * *parsePtr. If the string cannot be parsed as a valid Tcl expression, * TCL_ERROR is returned, and if interp is non-NULL, an error message is * written to interp. * * Side effects: * If there is insufficient space in parsePtr to hold all the information * about the expression, then additional space is malloc-ed. If the * function returns TCL_OK then the caller must eventually invoke * Tcl_FreeParse to release any additional space that was allocated. * *---------------------------------------------------------------------- */ int Tcl_ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ int numBytes, /* Number of bytes in string. If < 0, the * string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Structure to fill with information about * the parsed expression; any previous * information in the structure is ignored. */ { int code; OpNode *opTree = NULL; /* Will point to the tree of operators. */ Tcl_Obj *litList; /* List to hold the literals. */ Tcl_Obj *funcList; /* List to hold the functon names. */ Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ TclNewObj(litList); TclNewObj(funcList); if (numBytes < 0) { numBytes = (start ? strlen(start) : 0); } code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList, exprParsePtr, 1 /* parseOnly */); Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); TclParseInit(interp, start, numBytes, parsePtr); if (code == TCL_OK) { ConvertTreeToTokens(start, numBytes, opTree, exprParsePtr->tokenPtr, parsePtr); } else { parsePtr->term = exprParsePtr->term; parsePtr->errorType = exprParsePtr->errorType; } Tcl_FreeParse(exprParsePtr); TclStackFree(interp, exprParsePtr); ckfree(opTree); return code; } /* *---------------------------------------------------------------------- * * ParseLexeme -- * * Parse a single lexeme from the start of a string, scanning no more * than numBytes bytes. * * Results: * Returns the number of bytes scanned to produce the lexeme. * * Side effects: * Code identifying lexeme parsed is written to *lexemePtr. * *---------------------------------------------------------------------- */ static int ParseLexeme( const char *start, /* Start of lexeme to parse. */ int numBytes, /* Number of bytes in string. */ unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this storage, if non-NULL. */ { const char *end; int scanned; Tcl_UniChar ch = 0; Tcl_Obj *literal = NULL; unsigned char byte; if (numBytes == 0) { *lexemePtr = END; return 0; } byte = UCHAR(*start); if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) { *lexemePtr = Lexeme[byte]; return 1; } switch (byte) { case '*': if ((numBytes > 1) && (start[1] == '*')) { *lexemePtr = EXPON; return 2; } *lexemePtr = MULT; return 1; case '=': if ((numBytes > 1) && (start[1] == '=')) { *lexemePtr = EQUAL; return 2; } *lexemePtr = INCOMPLETE; return 1; case '!': if ((numBytes > 1) && (start[1] == '=')) { *lexemePtr = NEQ; return 2; } *lexemePtr = NOT; return 1; case '&': if ((numBytes > 1) && (start[1] == '&')) { *lexemePtr = AND; return 2; } *lexemePtr = BIT_AND; return 1; case '|': if ((numBytes > 1) && (start[1] == '|')) { *lexemePtr = OR; return 2; } *lexemePtr = BIT_OR; return 1; case '<': if (numBytes > 1) { switch (start[1]) { case '<': *lexemePtr = LEFT_SHIFT; return 2; case '=': *lexemePtr = LEQ; return 2; } } *lexemePtr = LESS; return 1; case '>': if (numBytes > 1) { switch (start[1]) { case '>': *lexemePtr = RIGHT_SHIFT; return 2; case '=': *lexemePtr = GEQ; return 2; } } *lexemePtr = GREATER; return 1; case 'i': if ((numBytes > 1) && (start[1] == 'n') && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) { /* * Must make this check so we can tell the difference between the * "in" operator and the "int" function name and the "infinity" * numeric value. */ *lexemePtr = IN_LIST; return 2; } break; case 'e': if ((numBytes > 1) && (start[1] == 'q') && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) { *lexemePtr = STREQ; return 2; } break; case 'n': if ((numBytes > 1) && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) { switch (start[1]) { case 'e': *lexemePtr = STRNEQ; return 2; case 'i': *lexemePtr = NOT_IN_LIST; return 2; } } } TclNewObj(literal); if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end, TCL_PARSE_NO_WHITESPACE) == TCL_OK) { if (end < start + numBytes && !TclIsBareword(*end)) { number: TclInitStringRep(literal, start, end-start); *lexemePtr = NUMBER; if (literalPtr) { *literalPtr = literal; } else { Tcl_DecrRefCount(literal); } return (end-start); } else { unsigned char lexeme; /* * We have a number followed directly by bareword characters * (alpha, digit, underscore). Is this a number followed by * bareword syntax error? Or should we join into one bareword? * Example: Inf + luence + () becomes a valid function call. * [Bug 3401704] */ if (literal->typePtr == &tclDoubleType) { const char *p = start; while (p < end) { if (!TclIsBareword(*p++)) { /* * The number has non-bareword characters, so we * must treat it as a number. */ goto number; } } } ParseLexeme(end, numBytes-(end-start), &lexeme, NULL); if ((NODE_TYPE & lexeme) == BINARY) { /* * The bareword characters following the number take the * form of an operator (eq, ne, in, ni, ...) so we treat * as number + operator. */ goto number; } /* * Otherwise, fall through and parse the whole as a bareword. */ } } /* * We reject leading underscores in bareword. No sensible reason why. * Might be inspired by reserved identifier rules in C, which of course * have no direct relevance here. */ if (!TclIsBareword(*start) || *start == '_') { if (Tcl_UtfCharComplete(start, numBytes)) { scanned = TclUtfToUniChar(start, &ch); } else { char utfBytes[TCL_UTF_MAX]; memcpy(utfBytes, start, numBytes); utfBytes[numBytes] = '\0'; scanned = TclUtfToUniChar(utfBytes, &ch); } *lexemePtr = INVALID; Tcl_DecrRefCount(literal); return scanned; } end = start; while (numBytes && TclIsBareword(*end)) { end += 1; numBytes -= 1; } *lexemePtr = BAREWORD; if (literalPtr) { Tcl_SetStringObj(literal, start, (int) (end-start)); *literalPtr = literal; } else { Tcl_DecrRefCount(literal); } return (end-start); } /* *---------------------------------------------------------------------- * * TclCompileExpr -- * * This procedure compiles a string containing a Tcl expression into Tcl * bytecodes. * * Results: * None. * * Side effects: * Adds instructions to envPtr to evaluate the expression at runtime. * *---------------------------------------------------------------------- */ void TclCompileExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *script, /* The source script to compile. */ int numBytes, /* Number of bytes in script. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int optimize) /* 0 for one-off expressions. */ { OpNode *opTree = NULL; /* Will point to the tree of operators */ Tcl_Obj *litList; /* List to hold the literals */ Tcl_Obj *funcList; /* List to hold the functon names*/ Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions */ int code; TclNewObj(litList); TclNewObj(funcList); code = ParseExpr(interp, script, numBytes, &opTree, litList, funcList, parsePtr, 0 /* parseOnly */); if (code == TCL_OK) { /* * Valid parse; compile the tree. */ int objc; Tcl_Obj *const *litObjv; Tcl_Obj **funcObjv; /* TIP #280 : Track Lines within the expression */ TclAdvanceLines(&envPtr->line, script, script + TclParseAllWhiteSpace(script, numBytes)); TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv); TclListObjGetElements(NULL, funcList, &objc, &funcObjv); CompileExprTree(interp, opTree, 0, &litObjv, funcObjv, parsePtr->tokenPtr, envPtr, optimize); } else { TclCompileSyntaxError(interp, envPtr); } Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); ckfree(opTree); } /* *---------------------------------------------------------------------- * * ExecConstantExprTree -- * Compiles and executes bytecode for the subexpression tree at index * in the nodes array. This subexpression must be constant, made up * of only constant operators (not functions) and literals. * * Results: * A standard Tcl return code and result left in interp. * * Side effects: * Consumes subtree of nodes rooted at index. Advances the pointer * *litObjvPtr. * *---------------------------------------------------------------------- */ static int ExecConstantExprTree( Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj *const **litObjvPtr) { CompileEnv *envPtr; ByteCode *byteCodePtr; int code; Tcl_Obj *byteCodeObj; NRE_callback *rootPtr = TOP_CB(interp); TclNewObj(byteCodeObj); /* * Note we are compiling an expression with literal arguments. This means * there can be no [info frame] calls when we execute the resulting * bytecode, so there's no need to tend to TIP 280 issues. */ envPtr = (CompileEnv *)TclStackAlloc(interp, sizeof(CompileEnv)); TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0); CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr, 0 /* optimize */); TclEmitOpcode(INST_DONE, envPtr); Tcl_IncrRefCount(byteCodeObj); TclInitByteCodeObj(byteCodeObj, envPtr); TclFreeCompileEnv(envPtr); TclStackFree(interp, envPtr); byteCodePtr = (ByteCode *)byteCodeObj->internalRep.twoPtrValue.ptr1; TclNRExecuteByteCode(interp, byteCodePtr); code = TclNRRunCallbacks(interp, TCL_OK, rootPtr); Tcl_DecrRefCount(byteCodeObj); return code; } /* *---------------------------------------------------------------------- * * CompileExprTree -- * * Compiles and writes to envPtr instructions for the subexpression tree * at index in the nodes array. (*litObjvPtr) must point to the proper * location in a corresponding literals list. Likewise, when non-NULL, * funcObjv and tokenPtr must point into matching arrays of function * names and Tcl_Token's derived from earlier call to ParseExpr(). When * optimize is true, any constant subexpressions will be precomputed. * * Results: * None. * * Side effects: * Adds instructions to envPtr to evaluate the expression at runtime. * Consumes subtree of nodes rooted at index. Advances the pointer * *litObjvPtr. * *---------------------------------------------------------------------- */ static void CompileExprTree( Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj *const **litObjvPtr, Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, CompileEnv *envPtr, int optimize) { OpNode *nodePtr = nodes + index; OpNode *rootPtr = nodePtr; int numWords = 0; JumpList *jumpPtr = NULL; int convert = 1; while (1) { int next; JumpList *freePtr, *newJump; if (nodePtr->mark == MARK_LEFT) { next = nodePtr->left; if (nodePtr->lexeme == QUESTION) { convert = 1; } } else if (nodePtr->mark == MARK_RIGHT) { next = nodePtr->right; switch (nodePtr->lexeme) { case FUNCTION: { Tcl_DString cmdName; const char *p; int length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); p = TclGetStringFromObj(*funcObjv, &length); funcObjv++; Tcl_DStringAppend(&cmdName, p, length); TclEmitPush(TclRegisterNewCmdLiteral(envPtr, Tcl_DStringValue(&cmdName), Tcl_DStringLength(&cmdName)), envPtr); Tcl_DStringFree(&cmdName); /* * Start a count of the number of words in this function * command invocation. In case there's already a count in * progress (nested functions), save it in our unused "left" * field for restoring later. */ nodePtr->left = numWords; numWords = 2; /* Command plus one argument */ break; } case QUESTION: newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump); break; case COLON: newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpPtr->jump); TclAdjustStackDepth(-1, envPtr); if (convert) { jumpPtr->jump.jumpType = TCL_TRUE_JUMP; } convert = 1; break; case AND: case OR: newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump); break; } } else { int pc1, pc2, target; switch (nodePtr->lexeme) { case START: case QUESTION: if (convert && (nodePtr == rootPtr)) { TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); } break; case OPEN_PAREN: /* do nothing */ break; case FUNCTION: /* * Use the numWords count we've kept to invoke the function * command with the correct number of arguments. */ if (numWords < 255) { TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords); } else { TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords); } /* * Restore any saved numWords value. */ numWords = nodePtr->left; convert = 1; break; case COMMA: /* * Each comma implies another function argument. */ numWords++; break; case COLON: CLANG_ASSERT(jumpPtr); if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) { jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP; convert = 1; } target = jumpPtr->jump.codeOffset + 2; if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) { target += 3; } freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); TclFixupForwardJump(envPtr, &jumpPtr->jump, target - jumpPtr->jump.codeOffset, 127); freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); break; case AND: case OR: CLANG_ASSERT(jumpPtr); pc1 = CurrentOffset(envPtr); TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1 : INST_JUMP_TRUE1, 0, envPtr); TclEmitPush(TclRegisterNewLiteral(envPtr, (nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr); pc2 = CurrentOffset(envPtr); TclEmitInstInt1(INST_JUMP1, 0, envPtr); TclAdjustStackDepth(-1, envPtr); TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1, envPtr->codeStart + pc1 + 1); if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) { pc2 += 3; } TclEmitPush(TclRegisterNewLiteral(envPtr, (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr); TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2, envPtr->codeStart + pc2 + 1); convert = 0; freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); break; default: TclEmitOpcode(instruction[nodePtr->lexeme], envPtr); convert = 0; break; } if (nodePtr == rootPtr) { /* We're done */ return; } nodePtr = nodes + nodePtr->p.parent; continue; } nodePtr->mark++; switch (next) { case OT_EMPTY: numWords = 1; /* No arguments, so just the command */ break; case OT_LITERAL: { Tcl_Obj *const *litObjv = *litObjvPtr; Tcl_Obj *literal = *litObjv; if (optimize) { int length; const char *bytes = TclGetStringFromObj(literal, &length); int idx = TclRegisterNewLiteral(envPtr, bytes, length); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx); if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) { /* * Would like to do this: * * lePtr->objPtr = literal; * Tcl_IncrRefCount(literal); * Tcl_DecrRefCount(objPtr); * * However, the design of the "global" and "local" * LiteralTable does not permit the value of lePtr->objPtr * to change. So rather than replace lePtr->objPtr, we do * surgery to transfer our desired internalrep into it. */ objPtr->typePtr = literal->typePtr; objPtr->internalRep = literal->internalRep; literal->typePtr = NULL; } TclEmitPush(idx, envPtr); } else { /* * When optimize==0, we know the expression is a one-off and * there's nothing to be gained from sharing literals when * they won't live long, and the copies we have already have * an appropriate internalrep. In this case, skip literal * registration that would enable sharing, and use the routine * that preserves internalreps. */ TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr); } (*litObjvPtr)++; break; } case OT_TOKENS: CompileTokens(envPtr, tokenPtr, interp); tokenPtr += tokenPtr->numComponents + 1; break; default: if (optimize && nodes[next].constant) { Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK); if (ExecConstantExprTree(interp, nodes, next, litObjvPtr) == TCL_OK) { int idx; Tcl_Obj *objPtr = Tcl_GetObjResult(interp); /* * Don't generate a string rep, but if we have one * already, then use it to share via the literal table. */ if (objPtr->bytes) { Tcl_Obj *tableValue; idx = TclRegisterNewLiteral(envPtr, objPtr->bytes, objPtr->length); tableValue = TclFetchLiteral(envPtr, idx); if ((tableValue->typePtr == NULL) && (objPtr->typePtr != NULL)) { /* * Same internalrep surgery as for OT_LITERAL. */ tableValue->typePtr = objPtr->typePtr; tableValue->internalRep = objPtr->internalRep; objPtr->typePtr = NULL; } } else { idx = TclAddLiteralObj(envPtr, objPtr, NULL); } TclEmitPush(idx, envPtr); } else { TclCompileSyntaxError(interp, envPtr); } Tcl_RestoreInterpState(interp, save); convert = 0; } else { nodePtr = nodes + next; } } } } /* *---------------------------------------------------------------------- * * TclSingleOpCmd -- * * Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni * in the ::tcl::mathop namespace. These commands have no * extension to arbitrary arguments; they accept only exactly one * or exactly two arguments as suitable for the operator. * * Results: * A standard Tcl return code and result left in interp. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclSingleOpCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; unsigned char lexeme; OpNode nodes[2]; Tcl_Obj *const *litObjv = objv + 1; if (objc != 1 + occdPtr->i.numArgs) { Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected); return TCL_ERROR; } ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL); nodes[0].lexeme = START; nodes[0].mark = MARK_RIGHT; nodes[0].right = 1; nodes[1].lexeme = lexeme; if (objc == 2) { nodes[1].mark = MARK_RIGHT; } else { nodes[1].mark = MARK_LEFT; nodes[1].left = OT_LITERAL; } nodes[1].right = OT_LITERAL; nodes[1].p.parent = 0; return ExecConstantExprTree(interp, nodes, 0, &litObjv); } /* *---------------------------------------------------------------------- * * TclSortingOpCmd -- * Implements the commands: * <, <=, >, >=, ==, eq * in the ::tcl::mathop namespace. These commands are defined for * arbitrary number of arguments by computing the AND of the base * operator applied to all neighbor argument pairs. * * Results: * A standard Tcl return code and result left in interp. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclSortingOpCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int code = TCL_OK; if (objc < 3) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); } else { TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp, 2 * (objc-2) * sizeof(Tcl_Obj *)); OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode)); unsigned char lexeme; int i, lastAnd = 1; Tcl_Obj *const *litObjPtrPtr = litObjv; ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL); litObjv[0] = objv[1]; nodes[0].lexeme = START; nodes[0].mark = MARK_RIGHT; for (i=2; ii.identity)); return TCL_OK; } ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL); lexeme |= BINARY; if (objc == 2) { Tcl_Obj *litObjv[2]; OpNode nodes[2]; int decrMe = 0; Tcl_Obj *const *litObjPtrPtr = litObjv; if (lexeme == EXPON) { TclNewIntObj(litObjv[1], occdPtr->i.identity); Tcl_IncrRefCount(litObjv[1]); decrMe = 1; litObjv[0] = objv[1]; nodes[0].lexeme = START; nodes[0].mark = MARK_RIGHT; nodes[0].right = 1; nodes[1].lexeme = lexeme; nodes[1].mark = MARK_LEFT; nodes[1].left = OT_LITERAL; nodes[1].right = OT_LITERAL; nodes[1].p.parent = 0; } else { if (lexeme == DIVIDE) { litObjv[0] = Tcl_NewDoubleObj(1.0); } else { TclNewIntObj(litObjv[0], occdPtr->i.identity); } Tcl_IncrRefCount(litObjv[0]); litObjv[1] = objv[1]; nodes[0].lexeme = START; nodes[0].mark = MARK_RIGHT; nodes[0].right = 1; nodes[1].lexeme = lexeme; nodes[1].mark = MARK_LEFT; nodes[1].left = OT_LITERAL; nodes[1].right = OT_LITERAL; nodes[1].p.parent = 0; } code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr); Tcl_DecrRefCount(litObjv[decrMe]); return code; } else { Tcl_Obj *const *litObjv = objv + 1; OpNode *nodes = (OpNode *)TclStackAlloc(interp, (objc-1) * sizeof(OpNode)); int i, lastOp = OT_LITERAL; nodes[0].lexeme = START; nodes[0].mark = MARK_RIGHT; if (lexeme == EXPON) { for (i=objc-2; i>0; i--) { nodes[i].lexeme = lexeme; nodes[i].mark = MARK_LEFT; nodes[i].left = OT_LITERAL; nodes[i].right = lastOp; if (lastOp >= 0) { nodes[lastOp].p.parent = i; } lastOp = i; } } else { for (i=1; i= 0) { nodes[lastOp].p.parent = i; } nodes[i].right = OT_LITERAL; lastOp = i; } } nodes[0].right = lastOp; nodes[lastOp].p.parent = 0; code = ExecConstantExprTree(interp, nodes, 0, &litObjv); TclStackFree(interp, nodes); return code; } } /* *---------------------------------------------------------------------- * * TclNoIdentOpCmd -- * Implements the commands: -, / * in the ::tcl::mathop namespace. These commands are defined for * arbitrary non-zero number of arguments by repeatedly applying the base * operator with suitable associative rules. When no arguments are * provided, an error is raised. * * Results: * A standard Tcl return code and result left in interp. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclNoIdentOpCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected); return TCL_ERROR; } return TclVariadicOpCmd(clientData, interp, objc, objv); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclCompile.c0000644000175000017500000044221414554262142015524 0ustar sergeisergei/* * tclCompile.c -- * * This file contains procedures that compile Tcl commands or parts of * commands (like quoted strings or nested sub-commands) into a sequence * of instructions ("bytecodes"). * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * Copyright (c) 2001 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include /* * Variable that controls whether compilation tracing is enabled and, if so, * what level of tracing is desired: * 0: no compilation tracing * 1: summarize compilation of top level cmds and proc bodies * 2: display all instructions of each ByteCode compiled * This variable is linked to the Tcl variable "tcl_traceCompile". */ #ifdef TCL_COMPILE_DEBUG int tclTraceCompile = 0; static int traceInitialized = 0; #endif /* * A table describing the Tcl bytecode instructions. Entries in this table * must correspond to the instruction opcode definitions in tclCompile.h. The * names "op1" and "op4" refer to an instruction's one or four byte first * operand. Similarly, "stktop" and "stknext" refer to the topmost and next to * topmost stack elements. * * Note that the load, store, and incr instructions do not distinguish local * from global variables; the bytecode interpreter at runtime uses the * existence of a procedure call frame to distinguish these. */ InstructionDesc const tclInstructionTable[] = { /* Name Bytes stackEffect #Opnds Operand types */ {"done", 1, -1, 0, {OPERAND_NONE}}, /* Finish ByteCode execution and return stktop (top stack item) */ {"push1", 2, +1, 1, {OPERAND_LIT1}}, /* Push object at ByteCode objArray[op1] */ {"push4", 5, +1, 1, {OPERAND_LIT4}}, /* Push object at ByteCode objArray[op4] */ {"pop", 1, -1, 0, {OPERAND_NONE}}, /* Pop the topmost stack object */ {"dup", 1, +1, 0, {OPERAND_NONE}}, /* Duplicate the topmost stack object and push the result */ {"strcat", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Concatenate the top op1 items and push result */ {"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Invoke command named objv[0]; = */ {"invokeStk4", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* Invoke command named objv[0]; = */ {"evalStk", 1, 0, 0, {OPERAND_NONE}}, /* Evaluate command in stktop using Tcl_EvalObj. */ {"exprStk", 1, 0, 0, {OPERAND_NONE}}, /* Execute expression in stktop using Tcl_ExprStringObj. */ {"loadScalar1", 2, 1, 1, {OPERAND_LVT1}}, /* Load scalar variable at index op1 <= 255 in call frame */ {"loadScalar4", 5, 1, 1, {OPERAND_LVT4}}, /* Load scalar variable at index op1 >= 256 in call frame */ {"loadScalarStk", 1, 0, 0, {OPERAND_NONE}}, /* Load scalar variable; scalar's name is stktop */ {"loadArray1", 2, 0, 1, {OPERAND_LVT1}}, /* Load array element; array at slot op1<=255, element is stktop */ {"loadArray4", 5, 0, 1, {OPERAND_LVT4}}, /* Load array element; array at slot op1 > 255, element is stktop */ {"loadArrayStk", 1, -1, 0, {OPERAND_NONE}}, /* Load array element; element is stktop, array name is stknext */ {"loadStk", 1, 0, 0, {OPERAND_NONE}}, /* Load general variable; unparsed variable name is stktop */ {"storeScalar1", 2, 0, 1, {OPERAND_LVT1}}, /* Store scalar variable at op1<=255 in frame; value is stktop */ {"storeScalar4", 5, 0, 1, {OPERAND_LVT4}}, /* Store scalar variable at op1 > 255 in frame; value is stktop */ {"storeScalarStk", 1, -1, 0, {OPERAND_NONE}}, /* Store scalar; value is stktop, scalar name is stknext */ {"storeArray1", 2, -1, 1, {OPERAND_LVT1}}, /* Store array element; array at op1<=255, value is top then elem */ {"storeArray4", 5, -1, 1, {OPERAND_LVT4}}, /* Store array element; array at op1>=256, value is top then elem */ {"storeArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Store array element; value is stktop, then elem, array names */ {"storeStk", 1, -1, 0, {OPERAND_NONE}}, /* Store general variable; value is stktop, then unparsed name */ {"incrScalar1", 2, 0, 1, {OPERAND_LVT1}}, /* Incr scalar at index op1<=255 in frame; incr amount is stktop */ {"incrScalarStk", 1, -1, 0, {OPERAND_NONE}}, /* Incr scalar; incr amount is stktop, scalar's name is stknext */ {"incrArray1", 2, -1, 1, {OPERAND_LVT1}}, /* Incr array elem; arr at slot op1<=255, amount is top then elem */ {"incrArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Incr array element; amount is top then elem then array names */ {"incrStk", 1, -1, 0, {OPERAND_NONE}}, /* Incr general variable; amount is stktop then unparsed var name */ {"incrScalar1Imm", 3, +1, 2, {OPERAND_LVT1, OPERAND_INT1}}, /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */ {"incrScalarStkImm", 2, 0, 1, {OPERAND_INT1}}, /* Incr scalar; scalar name is stktop; incr amount is op1 */ {"incrArray1Imm", 3, 0, 2, {OPERAND_LVT1, OPERAND_INT1}}, /* Incr array elem; array at slot op1 <= 255, elem is stktop, * amount is 2nd operand byte */ {"incrArrayStkImm", 2, -1, 1, {OPERAND_INT1}}, /* Incr array element; elem is top then array name, amount is op1 */ {"incrStkImm", 2, 0, 1, {OPERAND_INT1}}, /* Incr general variable; unparsed name is top, amount is op1 */ {"jump1", 2, 0, 1, {OPERAND_OFFSET1}}, /* Jump relative to (pc + op1) */ {"jump4", 5, 0, 1, {OPERAND_OFFSET4}}, /* Jump relative to (pc + op4) */ {"jumpTrue1", 2, -1, 1, {OPERAND_OFFSET1}}, /* Jump relative to (pc + op1) if stktop expr object is true */ {"jumpTrue4", 5, -1, 1, {OPERAND_OFFSET4}}, /* Jump relative to (pc + op4) if stktop expr object is true */ {"jumpFalse1", 2, -1, 1, {OPERAND_OFFSET1}}, /* Jump relative to (pc + op1) if stktop expr object is false */ {"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}}, /* Jump relative to (pc + op4) if stktop expr object is false */ {"lor", 1, -1, 0, {OPERAND_NONE}}, /* Logical or: push (stknext || stktop) */ {"land", 1, -1, 0, {OPERAND_NONE}}, /* Logical and: push (stknext && stktop) */ {"bitor", 1, -1, 0, {OPERAND_NONE}}, /* Bitwise or: push (stknext | stktop) */ {"bitxor", 1, -1, 0, {OPERAND_NONE}}, /* Bitwise xor push (stknext ^ stktop) */ {"bitand", 1, -1, 0, {OPERAND_NONE}}, /* Bitwise and: push (stknext & stktop) */ {"eq", 1, -1, 0, {OPERAND_NONE}}, /* Equal: push (stknext == stktop) */ {"neq", 1, -1, 0, {OPERAND_NONE}}, /* Not equal: push (stknext != stktop) */ {"lt", 1, -1, 0, {OPERAND_NONE}}, /* Less: push (stknext < stktop) */ {"gt", 1, -1, 0, {OPERAND_NONE}}, /* Greater: push (stknext > stktop) */ {"le", 1, -1, 0, {OPERAND_NONE}}, /* Less or equal: push (stknext <= stktop) */ {"ge", 1, -1, 0, {OPERAND_NONE}}, /* Greater or equal: push (stknext >= stktop) */ {"lshift", 1, -1, 0, {OPERAND_NONE}}, /* Left shift: push (stknext << stktop) */ {"rshift", 1, -1, 0, {OPERAND_NONE}}, /* Right shift: push (stknext >> stktop) */ {"add", 1, -1, 0, {OPERAND_NONE}}, /* Add: push (stknext + stktop) */ {"sub", 1, -1, 0, {OPERAND_NONE}}, /* Sub: push (stkext - stktop) */ {"mult", 1, -1, 0, {OPERAND_NONE}}, /* Multiply: push (stknext * stktop) */ {"div", 1, -1, 0, {OPERAND_NONE}}, /* Divide: push (stknext / stktop) */ {"mod", 1, -1, 0, {OPERAND_NONE}}, /* Mod: push (stknext % stktop) */ {"uplus", 1, 0, 0, {OPERAND_NONE}}, /* Unary plus: push +stktop */ {"uminus", 1, 0, 0, {OPERAND_NONE}}, /* Unary minus: push -stktop */ {"bitnot", 1, 0, 0, {OPERAND_NONE}}, /* Bitwise not: push ~stktop */ {"not", 1, 0, 0, {OPERAND_NONE}}, /* Logical not: push !stktop */ {"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}}, /* Call builtin math function with index op1; any args are on stk */ {"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Call non-builtin func objv[0]; = */ {"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}}, /* Try converting stktop to first int then double if possible. */ {"break", 1, 0, 0, {OPERAND_NONE}}, /* Abort closest enclosing loop; if none, return TCL_BREAK code. */ {"continue", 1, 0, 0, {OPERAND_NONE}}, /* Skip to next iteration of closest enclosing loop; if none, return * TCL_CONTINUE code. */ {"foreach_start4", 5, 0, 1, {OPERAND_AUX4}}, /* Initialize execution of a foreach loop. Operand is aux data index * of the ForeachInfo structure for the foreach command. */ {"foreach_step4", 5, +1, 1, {OPERAND_AUX4}}, /* "Step" or begin next iteration of foreach loop. Push 0 if to * terminate loop, else push 1. */ {"beginCatch4", 5, 0, 1, {OPERAND_UINT4}}, /* Record start of catch with the operand's exception index. Push the * current stack depth onto a special catch stack. */ {"endCatch", 1, 0, 0, {OPERAND_NONE}}, /* End of last catch. Pop the bytecode interpreter's catch stack. */ {"pushResult", 1, +1, 0, {OPERAND_NONE}}, /* Push the interpreter's object result onto the stack. */ {"pushReturnCode", 1, +1, 0, {OPERAND_NONE}}, /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as a new * object onto the stack. */ {"streq", 1, -1, 0, {OPERAND_NONE}}, /* Str Equal: push (stknext eq stktop) */ {"strneq", 1, -1, 0, {OPERAND_NONE}}, /* Str !Equal: push (stknext neq stktop) */ {"strcmp", 1, -1, 0, {OPERAND_NONE}}, /* Str Compare: push (stknext cmp stktop) */ {"strlen", 1, 0, 0, {OPERAND_NONE}}, /* Str Length: push (strlen stktop) */ {"strindex", 1, -1, 0, {OPERAND_NONE}}, /* Str Index: push (strindex stknext stktop) */ {"strmatch", 2, -1, 1, {OPERAND_INT1}}, /* Str Match: push (strmatch stknext stktop) opnd == nocase */ {"list", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* List: push (stk1 stk2 ... stktop) */ {"listIndex", 1, -1, 0, {OPERAND_NONE}}, /* List Index: push (listindex stknext stktop) */ {"listLength", 1, 0, 0, {OPERAND_NONE}}, /* List Len: push (listlength stktop) */ {"appendScalar1", 2, 0, 1, {OPERAND_LVT1}}, /* Append scalar variable at op1<=255 in frame; value is stktop */ {"appendScalar4", 5, 0, 1, {OPERAND_LVT4}}, /* Append scalar variable at op1 > 255 in frame; value is stktop */ {"appendArray1", 2, -1, 1, {OPERAND_LVT1}}, /* Append array element; array at op1<=255, value is top then elem */ {"appendArray4", 5, -1, 1, {OPERAND_LVT4}}, /* Append array element; array at op1>=256, value is top then elem */ {"appendArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Append array element; value is stktop, then elem, array names */ {"appendStk", 1, -1, 0, {OPERAND_NONE}}, /* Append general variable; value is stktop, then unparsed name */ {"lappendScalar1", 2, 0, 1, {OPERAND_LVT1}}, /* Lappend scalar variable at op1<=255 in frame; value is stktop */ {"lappendScalar4", 5, 0, 1, {OPERAND_LVT4}}, /* Lappend scalar variable at op1 > 255 in frame; value is stktop */ {"lappendArray1", 2, -1, 1, {OPERAND_LVT1}}, /* Lappend array element; array at op1<=255, value is top then elem */ {"lappendArray4", 5, -1, 1, {OPERAND_LVT4}}, /* Lappend array element; array at op1>=256, value is top then elem */ {"lappendArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Lappend array element; value is stktop, then elem, array names */ {"lappendStk", 1, -1, 0, {OPERAND_NONE}}, /* Lappend general variable; value is stktop, then unparsed name */ {"lindexMulti", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* Lindex with generalized args, operand is number of stacked objs * used: (operand-1) entries from stktop are the indices; then list to * process. */ {"over", 5, +1, 1, {OPERAND_UINT4}}, /* Duplicate the arg-th element from top of stack (TOS=0) */ {"lsetList", 1, -2, 0, {OPERAND_NONE}}, /* Four-arg version of 'lset'. stktop is old value; next is new * element value, next is the index list; pushes new value */ {"lsetFlat", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* Three- or >=5-arg version of 'lset', operand is number of stacked * objs: stktop is old value, next is new element value, next come * (operand-2) indices; pushes the new value. */ {"returnImm", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, /* Compiled [return], code, level are operands; options and result * are on the stack. */ {"expon", 1, -1, 0, {OPERAND_NONE}}, /* Binary exponentiation operator: push (stknext ** stktop) */ /* * NOTE: the stack effects of expandStkTop and invokeExpanded are wrong - * but it cannot be done right at compile time, the stack effect is only * known at run time. The value for invokeExpanded is estimated better at * compile time. * See the comments further down in this file, where INST_INVOKE_EXPANDED * is emitted. */ {"expandStart", 1, 0, 0, {OPERAND_NONE}}, /* Start of command with {*} (expanded) arguments */ {"expandStkTop", 5, 0, 1, {OPERAND_UINT4}}, /* Expand the list at stacktop: push its elements on the stack */ {"invokeExpanded", 1, 0, 0, {OPERAND_NONE}}, /* Invoke the command marked by the last 'expandStart' */ {"listIndexImm", 5, 0, 1, {OPERAND_IDX4}}, /* List Index: push (lindex stktop op4) */ {"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}}, /* List Range: push (lrange stktop op4 op4) */ {"startCommand", 9, 0, 2, {OPERAND_OFFSET4, OPERAND_UINT4}}, /* Start of bytecoded command: op is the length of the cmd's code, op2 * is number of commands here */ {"listIn", 1, -1, 0, {OPERAND_NONE}}, /* List containment: push [lsearch stktop stknext]>=0) */ {"listNotIn", 1, -1, 0, {OPERAND_NONE}}, /* List negated containment: push [lsearch stktop stknext]<0) */ {"pushReturnOpts", 1, +1, 0, {OPERAND_NONE}}, /* Push the interpreter's return option dictionary as an object on the * stack. */ {"returnStk", 1, -1, 0, {OPERAND_NONE}}, /* Compiled [return]; options and result are on the stack, code and * level are in the options. */ {"dictGet", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* The top op4 words (min 1) are a key path into the dictionary just * below the keys on the stack, and all those values are replaced by * the value read out of that key-path (like [dict get]). * Stack: ... dict key1 ... keyN => ... value */ {"dictSet", 9, INT_MIN, 2, {OPERAND_UINT4, OPERAND_LVT4}}, /* Update a dictionary value such that the keys are a path pointing to * the value. op4#1 = numKeys, op4#2 = LVTindex * Stack: ... key1 ... keyN value => ... newDict */ {"dictUnset", 9, INT_MIN, 2, {OPERAND_UINT4, OPERAND_LVT4}}, /* Update a dictionary value such that the keys are not a path pointing * to any value. op4#1 = numKeys, op4#2 = LVTindex * Stack: ... key1 ... keyN => ... newDict */ {"dictIncrImm", 9, 0, 2, {OPERAND_INT4, OPERAND_LVT4}}, /* Update a dictionary value such that the value pointed to by key is * incremented by some value (or set to it if the key isn't in the * dictionary at all). op4#1 = incrAmount, op4#2 = LVTindex * Stack: ... key => ... newDict */ {"dictAppend", 5, -1, 1, {OPERAND_LVT4}}, /* Update a dictionary value such that the value pointed to by key has * some value string-concatenated onto it. op4 = LVTindex * Stack: ... key valueToAppend => ... newDict */ {"dictLappend", 5, -1, 1, {OPERAND_LVT4}}, /* Update a dictionary value such that the value pointed to by key has * some value list-appended onto it. op4 = LVTindex * Stack: ... key valueToAppend => ... newDict */ {"dictFirst", 5, +2, 1, {OPERAND_LVT4}}, /* Begin iterating over the dictionary, using the local scalar * indicated by op4 to hold the iterator state. The local scalar * should not refer to a named variable as the value is not wholly * managed correctly. * Stack: ... dict => ... value key doneBool */ {"dictNext", 5, +3, 1, {OPERAND_LVT4}}, /* Get the next iteration from the iterator in op4's local scalar. * Stack: ... => ... value key doneBool */ {"dictDone", 5, 0, 1, {OPERAND_LVT4}}, /* Terminate the iterator in op4's local scalar. Use unsetScalar * instead (with 0 for flags). */ {"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}}, /* Create the variables (described in the aux data referred to by the * second immediate argument) to mirror the state of the dictionary in * the variable referred to by the first immediate argument. The list * of keys (top of the stack, not popped) must be the same length as * the list of variables. * Stack: ... keyList => ... keyList */ {"dictUpdateEnd", 9, -1, 2, {OPERAND_LVT4, OPERAND_AUX4}}, /* Reflect the state of local variables (described in the aux data * referred to by the second immediate argument) back to the state of * the dictionary in the variable referred to by the first immediate * argument. The list of keys (popped from the stack) must be the same * length as the list of variables. * Stack: ... keyList => ... */ {"jumpTable", 5, -1, 1, {OPERAND_AUX4}}, /* Jump according to the jump-table (in AuxData as indicated by the * operand) and the argument popped from the list. Always executes the * next instruction if no match against the table's entries was found. * Stack: ... value => ... * Note that the jump table contains offsets relative to the PC when * it points to this instruction; the code is relocatable. */ {"upvar", 5, -1, 1, {OPERAND_LVT4}}, /* finds level and otherName in stack, links to local variable at * index op1. Leaves the level on stack. */ {"nsupvar", 5, -1, 1, {OPERAND_LVT4}}, /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ {"variable", 5, -1, 1, {OPERAND_LVT4}}, /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ {"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, /* Compiled bytecodes to signal syntax error. Equivalent to returnImm * except for the ERR_ALREADY_LOGGED flag in the interpreter. */ {"reverse", 5, 0, 1, {OPERAND_UINT4}}, /* Reverse the order of the arg elements at the top of stack */ {"regexp", 2, -1, 1, {OPERAND_INT1}}, /* Regexp: push (regexp stknext stktop) opnd == nocase */ {"existScalar", 5, 1, 1, {OPERAND_LVT4}}, /* Test if scalar variable at index op1 in call frame exists */ {"existArray", 5, 0, 1, {OPERAND_LVT4}}, /* Test if array element exists; array at slot op1, element is * stktop */ {"existArrayStk", 1, -1, 0, {OPERAND_NONE}}, /* Test if array element exists; element is stktop, array name is * stknext */ {"existStk", 1, 0, 0, {OPERAND_NONE}}, /* Test if general variable exists; unparsed variable name is stktop*/ {"nop", 1, 0, 0, {OPERAND_NONE}}, /* Do nothing */ {"returnCodeBranch", 1, -1, 0, {OPERAND_NONE}}, /* Jump to next instruction based on the return code on top of stack * ERROR: +1; RETURN: +3; BREAK: +5; CONTINUE: +7; * Other non-OK: +9 */ {"unsetScalar", 6, 0, 2, {OPERAND_UINT1, OPERAND_LVT4}}, /* Make scalar variable at index op2 in call frame cease to exist; * op1 is 1 for errors on problems, 0 otherwise */ {"unsetArray", 6, -1, 2, {OPERAND_UINT1, OPERAND_LVT4}}, /* Make array element cease to exist; array at slot op2, element is * stktop; op1 is 1 for errors on problems, 0 otherwise */ {"unsetArrayStk", 2, -2, 1, {OPERAND_UINT1}}, /* Make array element cease to exist; element is stktop, array name is * stknext; op1 is 1 for errors on problems, 0 otherwise */ {"unsetStk", 2, -1, 1, {OPERAND_UINT1}}, /* Make general variable cease to exist; unparsed variable name is * stktop; op1 is 1 for errors on problems, 0 otherwise */ {"dictExpand", 1, -1, 0, {OPERAND_NONE}}, /* Probe into a dict and extract it (or a subdict of it) into * variables with matched names. Produces list of keys bound as * result. Part of [dict with]. * Stack: ... dict path => ... keyList */ {"dictRecombineStk", 1, -3, 0, {OPERAND_NONE}}, /* Map variable contents back into a dictionary in a variable. Part of * [dict with]. * Stack: ... dictVarName path keyList => ... */ {"dictRecombineImm", 5, -2, 1, {OPERAND_LVT4}}, /* Map variable contents back into a dictionary in the local variable * indicated by the LVT index. Part of [dict with]. * Stack: ... path keyList => ... */ {"dictExists", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* The top op4 words (min 1) are a key path into the dictionary just * below the keys on the stack, and all those values are replaced by a * boolean indicating whether it is possible to read out a value from * that key-path (like [dict exists]). * Stack: ... dict key1 ... keyN => ... boolean */ {"verifyDict", 1, -1, 0, {OPERAND_NONE}}, /* Verifies that the word on the top of the stack is a dictionary, * popping it if it is and throwing an error if it is not. * Stack: ... value => ... */ {"strmap", 1, -2, 0, {OPERAND_NONE}}, /* Simplified version of [string map] that only applies one change * string, and only case-sensitively. * Stack: ... from to string => ... changedString */ {"strfind", 1, -1, 0, {OPERAND_NONE}}, /* Find the first index of a needle string in a haystack string, * producing the index (integer) or -1 if nothing found. * Stack: ... needle haystack => ... index */ {"strrfind", 1, -1, 0, {OPERAND_NONE}}, /* Find the last index of a needle string in a haystack string, * producing the index (integer) or -1 if nothing found. * Stack: ... needle haystack => ... index */ {"strrangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}}, /* String Range: push (string range stktop op4 op4) */ {"strrange", 1, -2, 0, {OPERAND_NONE}}, /* String Range with non-constant arguments. * Stack: ... string idxA idxB => ... substring */ {"yield", 1, 0, 0, {OPERAND_NONE}}, /* Makes the current coroutine yield the value at the top of the * stack, and places the response back on top of the stack when it * resumes. * Stack: ... valueToYield => ... resumeValue */ {"coroName", 1, +1, 0, {OPERAND_NONE}}, /* Push the name of the interpreter's current coroutine as an object * on the stack. */ {"tailcall", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Do a tailcall with the opnd items on the stack as the thing to * tailcall to; opnd must be greater than 0 for the semantics to work * right. */ {"currentNamespace", 1, +1, 0, {OPERAND_NONE}}, /* Push the name of the interpreter's current namespace as an object * on the stack. */ {"infoLevelNumber", 1, +1, 0, {OPERAND_NONE}}, /* Push the stack depth (i.e., [info level]) of the interpreter as an * object on the stack. */ {"infoLevelArgs", 1, 0, 0, {OPERAND_NONE}}, /* Push the argument words to a stack depth (i.e., [info level ]) * of the interpreter as an object on the stack. * Stack: ... depth => ... argList */ {"resolveCmd", 1, 0, 0, {OPERAND_NONE}}, /* Resolves the command named on the top of the stack to its fully * qualified version, or produces the empty string if no such command * exists. Never generates errors. * Stack: ... cmdName => ... fullCmdName */ {"tclooSelf", 1, +1, 0, {OPERAND_NONE}}, /* Push the identity of the current TclOO object (i.e., the name of * its current public access command) on the stack. */ {"tclooClass", 1, 0, 0, {OPERAND_NONE}}, /* Push the class of the TclOO object named at the top of the stack * onto the stack. * Stack: ... object => ... class */ {"tclooNamespace", 1, 0, 0, {OPERAND_NONE}}, /* Push the namespace of the TclOO object named at the top of the * stack onto the stack. * Stack: ... object => ... namespace */ {"tclooIsObject", 1, 0, 0, {OPERAND_NONE}}, /* Push whether the value named at the top of the stack is a TclOO * object (i.e., a boolean). Can corrupt the interpreter result * despite not throwing, so not safe for use in a post-exception * context. * Stack: ... value => ... boolean */ {"arrayExistsStk", 1, 0, 0, {OPERAND_NONE}}, /* Looks up the element on the top of the stack and tests whether it * is an array. Pushes a boolean describing whether this is the * case. Also runs the whole-array trace on the named variable, so can * throw anything. * Stack: ... varName => ... boolean */ {"arrayExistsImm", 5, +1, 1, {OPERAND_LVT4}}, /* Looks up the variable indexed by opnd and tests whether it is an * array. Pushes a boolean describing whether this is the case. Also * runs the whole-array trace on the named variable, so can throw * anything. * Stack: ... => ... boolean */ {"arrayMakeStk", 1, -1, 0, {OPERAND_NONE}}, /* Forces the element on the top of the stack to be the name of an * array. * Stack: ... varName => ... */ {"arrayMakeImm", 5, 0, 1, {OPERAND_LVT4}}, /* Forces the variable indexed by opnd to be an array. Does not touch * the stack. */ {"invokeReplace", 6, INT_MIN, 2, {OPERAND_UINT4,OPERAND_UINT1}}, /* Invoke command named objv[0], replacing the first two words with * the word at the top of the stack; * = */ {"listConcat", 1, -1, 0, {OPERAND_NONE}}, /* Concatenates the two lists at the top of the stack into a single * list and pushes that resulting list onto the stack. * Stack: ... list1 list2 => ... [lconcat list1 list2] */ {"expandDrop", 1, 0, 0, {OPERAND_NONE}}, /* Drops an element from the auxiliary stack, popping stack elements * until the matching stack depth is reached. */ /* New foreach implementation */ {"foreach_start", 5, +2, 1, {OPERAND_AUX4}}, /* Initialize execution of a foreach loop. Operand is aux data index * of the ForeachInfo structure for the foreach command. It pushes 2 * elements which hold runtime params for foreach_step, they are later * dropped by foreach_end together with the value lists. NOTE that the * iterator-tracker and info reference must not be passed to bytecodes * that handle normal Tcl values. NOTE that this instruction jumps to * the foreach_step instruction paired with it; the stack info below * is only nominal. * Stack: ... listObjs... => ... listObjs... iterTracker info */ {"foreach_step", 1, 0, 0, {OPERAND_NONE}}, /* "Step" or begin next iteration of foreach loop. Assigns to foreach * iteration variables. May jump to straight after the foreach_start * that pushed the iterTracker and info values. MUST be followed * immediately by a foreach_end. * Stack: ... listObjs... iterTracker info => * ... listObjs... iterTracker info */ {"foreach_end", 1, 0, 0, {OPERAND_NONE}}, /* Clean up a foreach loop by dropping the info value, the tracker * value and the lists that were being iterated over. * Stack: ... listObjs... iterTracker info => ... */ {"lmap_collect", 1, -1, 0, {OPERAND_NONE}}, /* Appends the value at the top of the stack to the list located on * the stack the "other side" of the foreach-related values. * Stack: ... collector listObjs... iterTracker info value => * ... collector listObjs... iterTracker info */ {"strtrim", 1, -1, 0, {OPERAND_NONE}}, /* [string trim] core: removes the characters (designated by the value * at the top of the stack) from both ends of the string and pushes * the resulting string. * Stack: ... string charset => ... trimmedString */ {"strtrimLeft", 1, -1, 0, {OPERAND_NONE}}, /* [string trimleft] core: removes the characters (designated by the * value at the top of the stack) from the left of the string and * pushes the resulting string. * Stack: ... string charset => ... trimmedString */ {"strtrimRight", 1, -1, 0, {OPERAND_NONE}}, /* [string trimright] core: removes the characters (designated by the * value at the top of the stack) from the right of the string and * pushes the resulting string. * Stack: ... string charset => ... trimmedString */ {"concatStk", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd * is number of values to concatenate. * Operation: push concat(stk1 stk2 ... stktop) */ {"strcaseUpper", 1, 0, 0, {OPERAND_NONE}}, /* [string toupper] core: converts whole string to upper case using * the default (extended "C" locale) rules. * Stack: ... string => ... newString */ {"strcaseLower", 1, 0, 0, {OPERAND_NONE}}, /* [string tolower] core: converts whole string to upper case using * the default (extended "C" locale) rules. * Stack: ... string => ... newString */ {"strcaseTitle", 1, 0, 0, {OPERAND_NONE}}, /* [string totitle] core: converts whole string to upper case using * the default (extended "C" locale) rules. * Stack: ... string => ... newString */ {"strreplace", 1, -3, 0, {OPERAND_NONE}}, /* [string replace] core: replaces a non-empty range of one string * with the contents of another. * Stack: ... string fromIdx toIdx replacement => ... newString */ {"originCmd", 1, 0, 0, {OPERAND_NONE}}, /* Reports which command was the origin (via namespace import chain) * of the command named on the top of the stack. * Stack: ... cmdName => ... fullOriginalCmdName */ {"tclooNext", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Call the next item on the TclOO call chain, passing opnd arguments * (min 1, max 255, *includes* "next"). The result of the invoked * method implementation will be pushed on the stack in place of the * arguments (similar to invokeStk). * Stack: ... "next" arg2 arg3 -- argN => ... result */ {"tclooNextClass", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Call the following item on the TclOO call chain defined by class * className, passing opnd arguments (min 2, max 255, *includes* * "nextto" and the class name). The result of the invoked method * implementation will be pushed on the stack in place of the * arguments (similar to invokeStk). * Stack: ... "nextto" className arg3 arg4 -- argN => ... result */ {"yieldToInvoke", 1, 0, 0, {OPERAND_NONE}}, /* Makes the current coroutine yield the value at the top of the * stack, invoking the given command/args with resolution in the given * namespace (all packed into a list), and places the list of values * that are the response back on top of the stack when it resumes. * Stack: ... [list ns cmd arg1 ... argN] => ... resumeList */ {"numericType", 1, 0, 0, {OPERAND_NONE}}, /* Pushes the numeric type code of the word at the top of the stack. * Stack: ... value => ... typeCode */ {"tryCvtToBoolean", 1, +1, 0, {OPERAND_NONE}}, /* Try converting stktop to boolean if possible. No errors. * Stack: ... value => ... value isStrictBool */ {"strclass", 2, 0, 1, {OPERAND_SCLS1}}, /* See if all the characters of the given string are a member of the * specified (by opnd) character class. Note that an empty string will * satisfy the class check (standard definition of "all"). * Stack: ... stringValue => ... boolean */ {"lappendList", 5, 0, 1, {OPERAND_LVT4}}, /* Lappend list to scalar variable at op4 in frame. * Stack: ... list => ... listVarContents */ {"lappendListArray", 5, -1, 1, {OPERAND_LVT4}}, /* Lappend list to array element; array at op4. * Stack: ... elem list => ... listVarContents */ {"lappendListArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Lappend list to array element. * Stack: ... arrayName elem list => ... listVarContents */ {"lappendListStk", 1, -1, 0, {OPERAND_NONE}}, /* Lappend list to general variable. * Stack: ... varName list => ... listVarContents */ {"clockRead", 2, +1, 1, {OPERAND_UINT1}}, /* Read clock out to the stack. Operand is which clock to read * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds. * Stack: ... => ... time */ {NULL, 0, 0, 0, {OPERAND_NONE}} }; /* * Prototypes for procedures defined later in this file: */ static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, int cmdNumber, int numSrcBytes, int numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, int cmdNumber, int srcOffset, int codeOffset); static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); static int IsCompactibleCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ static int SetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void StartExpanding(CompileEnv *envPtr); /* * TIP #280: Helper for building the per-word line information of all compiled * commands. */ static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token *tokenPtr, const char *cmd, int len, int numWords, int line, int *clNext, int **lines, CompileEnv *envPtr); static void ReleaseCmdWordData(ExtCmdLoc *eclPtr); /* * The structure below defines the bytecode Tcl object type by means of * procedures that can be invoked by generic object code. */ const Tcl_ObjType tclByteCodeType = { "bytecode", /* name */ FreeByteCodeInternalRep, /* freeIntRepProc */ DupByteCodeInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetByteCodeFromAny /* setFromAnyProc */ }; /* * The structure below defines a bytecode Tcl object type to hold the * compiled bytecode for the [subst]itution of Tcl values. */ static const Tcl_ObjType substCodeType = { "substcode", /* name */ FreeSubstCodeInternalRep, /* freeIntRepProc */ DupByteCodeInternalRep, /* dupIntRepProc - shared with bytecode */ NULL, /* updateStringProc */ NULL, /* setFromAnyProc */ }; /* * Helper macros. */ #define TclIncrUInt4AtPtr(ptr, delta) \ TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr)); /* *---------------------------------------------------------------------- * * TclSetByteCodeFromAny -- * * Part of the bytecode Tcl object type implementation. Attempts to * generate an byte code internal form for the Tcl object "objPtr" by * compiling its string representation. This function also takes a hook * procedure that will be invoked to perform any needed post processing * on the compilation results before generating byte codes. interp is * compilation context and may not be NULL. * * Results: * The return value is a standard Tcl object result. If an error occurs * during compilation, an error message is left in the interpreter's * result. * * Side effects: * Frees the old internal representation. If no error occurs, then the * compiled code is stored as "objPtr"s bytecode representation. Also, if * debugging, initializes the "tcl_traceCompile" Tcl variable used to * trace compilations. * *---------------------------------------------------------------------- */ int TclSetByteCodeFromAny( Tcl_Interp *interp, /* The interpreter for which the code is being * compiled. Must not be NULL. */ Tcl_Obj *objPtr, /* The object to make a ByteCode object. */ CompileHookProc *hookProc, /* Procedure to invoke after compilation. */ ClientData clientData) /* Hook procedure private data. */ { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ int length, result = TCL_OK; const char *stringPtr; Proc *procPtr = iPtr->compiledProcPtr; ContLineLoc *clLocPtr; #ifdef TCL_COMPILE_DEBUG if (!traceInitialized) { if (Tcl_LinkVar(interp, "tcl_traceCompile", (char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable"); } traceInitialized = 1; } #endif stringPtr = TclGetStringFromObj(objPtr, &length); /* * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and * use to initialize the tracking in the compiler. This information was * stored by TclCompEvalObj and ProcCompileProc. */ TclInitCompileEnv(interp, &compEnv, stringPtr, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); /* * Now we check if we have data about invisible continuation lines for the * script, and make it available to the compile environment, if so. * * It is not clear if the script Tcl_Obj* can be free'd while the compiler * is using it, leading to the release of the associated ContLineLoc * structure as well. To ensure that the latter doesn't happen we set a * lock on it. We release this lock in the function TclFreeCompileEnv(), * found in this file. The "lineCLPtr" hashtable is managed in the file * "tclObj.c". */ clLocPtr = TclContinuationsGet(objPtr); if (clLocPtr) { compEnv.clNext = &clLocPtr->loc[0]; } TclCompileScript(interp, stringPtr, length, &compEnv); /* * Successful compilation. Add a "done" instruction at the end. */ TclEmitOpcode(INST_DONE, &compEnv); /* * Check for optimizations! * * Test if the generated code is free of most hazards; if so, recompile * but with generation of INST_START_CMD disabled. This produces somewhat * faster code in some cases, and more compact code in more. */ if (Tcl_GetParent(interp) == NULL && !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME) && IsCompactibleCompileEnv(interp, &compEnv)) { TclFreeCompileEnv(&compEnv); iPtr->compiledProcPtr = procPtr; TclInitCompileEnv(interp, &compEnv, stringPtr, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); if (clLocPtr) { compEnv.clNext = &clLocPtr->loc[0]; } compEnv.atCmdStart = 2; /* The disabling magic. */ TclCompileScript(interp, stringPtr, length, &compEnv); assert (compEnv.atCmdStart > 1); TclEmitOpcode(INST_DONE, &compEnv); assert (compEnv.atCmdStart > 1); } /* * Apply some peephole optimizations that can cross specific/generic * instruction generator boundaries. */ if (iPtr->extra.optimizer) { (iPtr->extra.optimizer)(&compEnv); } /* * Invoke the compilation hook procedure if one exists. */ if (hookProc) { result = hookProc(interp, &compEnv, clientData); } /* * Change the object into a ByteCode object. Ownership of the literal * objects and aux data items is given to the ByteCode object. */ #ifdef TCL_COMPILE_DEBUG TclVerifyLocalLiteralTable(&compEnv); #endif /*TCL_COMPILE_DEBUG*/ if (result == TCL_OK) { TclInitByteCodeObj(objPtr, &compEnv); #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 2) { TclPrintByteCodeObj(interp, objPtr); fflush(stdout); } #endif /* TCL_COMPILE_DEBUG */ } TclFreeCompileEnv(&compEnv); return result; } /* *----------------------------------------------------------------------- * * SetByteCodeFromAny -- * * Part of the bytecode Tcl object type implementation. Attempts to * generate an byte code internal form for the Tcl object "objPtr" by * compiling its string representation. * * Results: * The return value is a standard Tcl object result. If an error occurs * during compilation, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * Frees the old internal representation. If no error occurs, then the * compiled code is stored as "objPtr"s bytecode representation. Also, if * debugging, initializes the "tcl_traceCompile" Tcl variable used to * trace compilations. * *---------------------------------------------------------------------- */ static int SetByteCodeFromAny( Tcl_Interp *interp, /* The interpreter for which the code is being * compiled. Must not be NULL. */ Tcl_Obj *objPtr) /* The object to make a ByteCode object. */ { if (interp == NULL) { return TCL_ERROR; } return TclSetByteCodeFromAny(interp, objPtr, NULL, NULL); } /* *---------------------------------------------------------------------- * * DupByteCodeInternalRep -- * * Part of the bytecode Tcl object type implementation. However, it does * not copy the internal representation of a bytecode Tcl_Obj, but * instead leaves the new object untyped (with a NULL type pointer). * Code will be compiled for the new object only if necessary. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void DupByteCodeInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { return; } /* *---------------------------------------------------------------------- * * FreeByteCodeInternalRep -- * * Part of the bytecode Tcl object type implementation. Frees the storage * associated with a bytecode object's internal representation unless its * code is actively being executed. * * Results: * None. * * Side effects: * The bytecode object's internal rep is marked invalid and its code gets * freed unless the code is actively being executed. In that case the * cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeByteCodeInternalRep( Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; objPtr->typePtr = NULL; if (codePtr->refCount-- <= 1) { TclCleanupByteCode(codePtr); } } /* *---------------------------------------------------------------------- * * TclCleanupByteCode -- * * This procedure does all the real work of freeing up a bytecode * object's ByteCode structure. It's called only when the structure's * reference count becomes zero. * * Results: * None. * * Side effects: * Frees objPtr's bytecode internal representation and sets its type NULL * Also releases its literals and frees its auxiliary data items. * *---------------------------------------------------------------------- */ void TclCleanupByteCode( ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; Interp *iPtr = (Interp *) interp; int numLitObjects = codePtr->numLitObjects; int numAuxDataItems = codePtr->numAuxDataItems; Tcl_Obj **objArrayPtr, *objPtr; const AuxData *auxDataPtr; int i; #ifdef TCL_COMPILE_STATS if (interp != NULL) { ByteCodeStats *statsPtr; Tcl_Time destroyTime; int lifetimeSec, lifetimeMicroSec, log2; statsPtr = &iPtr->stats; statsPtr->numByteCodesFreed++; statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes; statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize; statsPtr->currentInstBytes -= (double) codePtr->numCodeBytes; statsPtr->currentLitBytes -= (double) codePtr->numLitObjects * sizeof(Tcl_Obj *); statsPtr->currentExceptBytes -= (double) codePtr->numExceptRanges * sizeof(ExceptionRange); statsPtr->currentAuxBytes -= (double) codePtr->numAuxDataItems * sizeof(AuxData); statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes; Tcl_GetTime(&destroyTime); lifetimeSec = destroyTime.sec - codePtr->createTime.sec; if (lifetimeSec > 2000) { /* avoid overflow */ lifetimeSec = 2000; } lifetimeMicroSec = 1000000 * lifetimeSec + (destroyTime.usec - codePtr->createTime.usec); log2 = TclLog2(lifetimeMicroSec); if (log2 > 31) { log2 = 31; } statsPtr->lifetimeCount[log2]++; } #endif /* TCL_COMPILE_STATS */ /* * A single heap object holds the ByteCode structure and its code, object, * command location, and auxiliary data arrays. This means we only need to * 1) decrement the ref counts of the LiteralEntry's in its literal array, * 2) call the free procs for the auxiliary data items, 3) free the * localCache if it is unused, and finally 4) free the ByteCode * structure's heap object. * * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes, like * those generated from tbcload) is special, as they doesn't make use of * the global literal table. They instead maintain private references to * their literals which must be decremented. * * In order to insure a proper and efficient cleanup of the literal array * when it contains non-shared literals [Bug 983660], we also distinguish * the case of an interpreter being deleted (signaled by interp == NULL). * Also, as the interp deletion will remove the global literal table * anyway, we avoid the extra cost of updating it for each literal being * released. */ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { objArrayPtr = codePtr->objArrayPtr; for (i = 0; i < numLitObjects; i++) { objPtr = *objArrayPtr; if (objPtr) { Tcl_DecrRefCount(objPtr); } objArrayPtr++; } codePtr->numLitObjects = 0; } else { objArrayPtr = codePtr->objArrayPtr; while (numLitObjects--) { /* TclReleaseLiteral calls Tcl_DecrRefCount() for us */ TclReleaseLiteral(interp, *objArrayPtr++); } } auxDataPtr = codePtr->auxDataArrayPtr; for (i = 0; i < numAuxDataItems; i++) { if (auxDataPtr->type->freeProc != NULL) { auxDataPtr->type->freeProc(auxDataPtr->clientData); } auxDataPtr++; } /* * TIP #280. Release the location data associated with this byte code * structure, if any. NOTE: The interp we belong to may be gone already, * and the data with it. * * See also tclBasic.c, DeleteInterpProc */ if (iPtr) { Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr); if (hePtr) { ReleaseCmdWordData((ExtCmdLoc *)Tcl_GetHashValue(hePtr)); Tcl_DeleteHashEntry(hePtr); } } if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) { TclFreeLocalCache(interp, codePtr->localCachePtr); } TclHandleRelease(codePtr->interpHandle); ckfree(codePtr); } /* * --------------------------------------------------------------------- * * IsCompactibleCompileEnv -- * * Checks to see if we may apply some basic compaction optimizations to a * piece of bytecode. Idempotent. * * --------------------------------------------------------------------- */ static int IsCompactibleCompileEnv( Tcl_Interp *interp, CompileEnv *envPtr) { unsigned char *pc; int size; /* * Special: procedures in the '::tcl' namespace (or its children) are * considered to be well-behaved and so can have compaction applied even * if it would otherwise be invalid. */ if (envPtr->procPtr != NULL && envPtr->procPtr->cmdPtr != NULL && envPtr->procPtr->cmdPtr->nsPtr != NULL) { Namespace *nsPtr = envPtr->procPtr->cmdPtr->nsPtr; if (strcmp(nsPtr->fullName, "::tcl") == 0 || strncmp(nsPtr->fullName, "::tcl::", 7) == 0) { return 1; } } /* * Go through and ensure that no operation involved can cause a desired * change of bytecode sequence during running. This comes down to ensuring * that there are no mapped variables (due to traces) or calls to external * commands (traces, [uplevel] trickery). This is actually a very * conservative check; it turns down a lot of code that is OK in practice. */ for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) { switch (*pc) { /* Invokes */ case INST_INVOKE_STK1: case INST_INVOKE_STK4: case INST_INVOKE_EXPANDED: case INST_INVOKE_REPLACE: return 0; /* Runtime evals */ case INST_EVAL_STK: case INST_EXPR_STK: case INST_YIELD: return 0; /* Upvars */ case INST_UPVAR: case INST_NSUPVAR: case INST_VARIABLE: return 0; default: size = tclInstructionTable[*pc].numBytes; assert (size > 0); break; } } return 1; } /* *---------------------------------------------------------------------- * * Tcl_SubstObj -- * * This function performs the substitutions specified on the given string * as described in the user documentation for the "subst" Tcl command. * * Results: * A Tcl_Obj* containing the substituted string, or NULL to indicate that * an error occurred. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_SubstObj( Tcl_Interp *interp, /* Interpreter in which substitution occurs */ Tcl_Obj *objPtr, /* The value to be substituted. */ int flags) /* What substitutions to do. */ { NRE_callback *rootPtr = TOP_CB(interp); if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags), rootPtr) != TCL_OK) { return NULL; } return Tcl_GetObjResult(interp); } /* *---------------------------------------------------------------------- * * Tcl_NRSubstObj -- * * Request substitution of a Tcl value by the NR stack. * * Results: * Returns TCL_OK. * * Side effects: * Compiles objPtr into bytecode that performs the substitutions as * governed by flags and places callbacks on the NR stack to execute * the bytecode and store the result in the interp. * *---------------------------------------------------------------------- */ int Tcl_NRSubstObj( Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) { ByteCode *codePtr = CompileSubstObj(interp, objPtr, flags); /* TODO: Confirm we do not need this. */ /* Tcl_ResetResult(interp); */ return TclNRExecuteByteCode(interp, codePtr); } /* *---------------------------------------------------------------------- * * CompileSubstObj -- * * Compile a Tcl value into ByteCode implementing its substitution, as * governed by flags. * * Results: * A (ByteCode *) is returned pointing to the resulting ByteCode. * The caller must manage its refCount and arrange for a call to * TclCleanupByteCode() when the last reference disappears. * * Side effects: * The Tcl_ObjType of objPtr is changed to the "substcode" type, and the * ByteCode and governing flags value are kept in the internal rep for * faster operations the next time CompileSubstObj is called on the same * value. * *---------------------------------------------------------------------- */ static ByteCode * CompileSubstObj( Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) { Interp *iPtr = (Interp *) interp; ByteCode *codePtr = NULL; if (objPtr->typePtr == &substCodeType) { Namespace *nsPtr = iPtr->varFramePtr->nsPtr; codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) || ((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) || (codePtr->nsEpoch != nsPtr->resolverEpoch) || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { FreeSubstCodeInternalRep(objPtr); } } if (objPtr->typePtr != &substCodeType) { CompileEnv compEnv; int numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0); TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv); TclEmitOpcode(INST_DONE, &compEnv); TclInitByteCodeObj(objPtr, &compEnv); objPtr->typePtr = &substCodeType; TclFreeCompileEnv(&compEnv); codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; objPtr->internalRep.twoPtrValue.ptr1 = codePtr; objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags); if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; } #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 2) { TclPrintByteCodeObj(interp, objPtr); fflush(stdout); } #endif /* TCL_COMPILE_DEBUG */ } return codePtr; } /* *---------------------------------------------------------------------- * * FreeSubstCodeInternalRep -- * * Part of the substcode Tcl object type implementation. Frees the * storage associated with a substcode object's internal representation * unless its code is actively being executed. * * Results: * None. * * Side effects: * The substcode object's internal rep is marked invalid and its code * gets freed unless the code is actively being executed. In that case * the cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; objPtr->typePtr = NULL; if (codePtr->refCount-- <= 1) { TclCleanupByteCode(codePtr); } } static void ReleaseCmdWordData( ExtCmdLoc *eclPtr) { int i; if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); } for (i=0 ; inuloc ; i++) { ckfree((char *) eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { ckfree((char *) eclPtr->loc); } ckfree((char *) eclPtr); } /* *---------------------------------------------------------------------- * * TclInitCompileEnv -- * * Initializes a CompileEnv compilation environment structure for the * compilation of a string in an interpreter. * * Results: * None. * * Side effects: * The CompileEnv structure is initialized. * *---------------------------------------------------------------------- */ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ int numBytes, /* Number of bytes in source string. */ const CmdFrame *invoker, /* Location context invoking the bcc */ int word) /* Index of the word in that context getting * compiled */ { Interp *iPtr = (Interp *) interp; assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL); envPtr->iPtr = iPtr; envPtr->source = stringPtr; envPtr->numSrcBytes = numBytes; envPtr->procPtr = iPtr->compiledProcPtr; iPtr->compiledProcPtr = NULL; envPtr->numCommands = 0; envPtr->exceptDepth = 0; envPtr->maxExceptDepth = 0; envPtr->maxStackDepth = 0; envPtr->currStackDepth = 0; TclInitLiteralTable(&envPtr->localLitTable); envPtr->codeStart = envPtr->staticCodeSpace; envPtr->codeNext = envPtr->codeStart; envPtr->codeEnd = envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES; envPtr->mallocedCodeArray = 0; envPtr->literalArrayPtr = envPtr->staticLiteralSpace; envPtr->literalArrayNext = 0; envPtr->literalArrayEnd = COMPILEENV_INIT_NUM_OBJECTS; envPtr->mallocedLiteralArray = 0; envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace; envPtr->exceptAuxArrayPtr = envPtr->staticExAuxArraySpace; envPtr->exceptArrayNext = 0; envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES; envPtr->mallocedExceptArray = 0; envPtr->cmdMapPtr = envPtr->staticCmdMapSpace; envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE; envPtr->mallocedCmdMap = 0; envPtr->atCmdStart = 1; envPtr->expandCount = 0; /* * TIP #280: Set up the extended command location information, based on * the context invoking the byte code compiler. This structure is used to * keep the per-word line information for all compiled commands. * * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the * non-compiling evaluator */ envPtr->extCmdMapPtr = (ExtCmdLoc *)ckalloc(sizeof(ExtCmdLoc)); envPtr->extCmdMapPtr->loc = NULL; envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; envPtr->extCmdMapPtr->path = NULL; if (invoker == NULL) { /* * Initialize the compiler for relative counting in case of a * dynamic context. */ envPtr->line = 1; if (iPtr->evalFlags & TCL_EVAL_FILE) { iPtr->evalFlags &= ~TCL_EVAL_FILE; envPtr->extCmdMapPtr->type = TCL_LOCATION_SOURCE; if (iPtr->scriptFile) { /* * Normalization here, to have the correct pwd. Should have * negligible impact on performance, as the norm should have * been done already by the 'source' invoking us, and it * caches the result. */ Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile); if (norm == NULL) { /* * Error message in the interp result. No place to put it. * And no place to serve the error itself to either. Fake * a path, empty string. */ TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, ""); } else { envPtr->extCmdMapPtr->path = norm; } } else { TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, ""); } Tcl_IncrRefCount(envPtr->extCmdMapPtr->path); } else { envPtr->extCmdMapPtr->type = (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC); } } else { /* * Initialize the compiler using the context, making counting absolute * to that context. Note that the context can be byte code execution. * In that case we have to fill out the missing pieces (line, path, * ...) which may make change the type as well. */ CmdFrame *ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); int pc = 0; *ctxPtr = *invoker; if (invoker->type == TCL_LOCATION_BC) { /* * Note: Type BC => ctx.data.eval.path is not used. * ctx.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc(ctxPtr); pc = 1; } if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) { /* * Word is not a literal, relative counting. */ envPtr->line = 1; envPtr->extCmdMapPtr->type = (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC); if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { /* * The reference made by 'TclGetSrcInfoForPc' is dead. */ Tcl_DecrRefCount(ctxPtr->data.eval.path); } } else { envPtr->line = ctxPtr->line[word]; envPtr->extCmdMapPtr->type = ctxPtr->type; if (ctxPtr->type == TCL_LOCATION_SOURCE) { envPtr->extCmdMapPtr->path = ctxPtr->data.eval.path; if (pc) { /* * The reference 'TclGetSrcInfoForPc' made is transfered. */ ctxPtr->data.eval.path = NULL; } else { /* * We have a new reference here. */ Tcl_IncrRefCount(envPtr->extCmdMapPtr->path); } } } TclStackFree(interp, ctxPtr); } envPtr->extCmdMapPtr->start = envPtr->line; /* * Initialize the data about invisible continuation lines as empty, i.e. * not used. The caller (TclSetByteCodeFromAny) will set this up, if such * data is available. */ envPtr->clNext = NULL; envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace; envPtr->auxDataArrayNext = 0; envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE; envPtr->mallocedAuxDataArray = 0; } /* *---------------------------------------------------------------------- * * TclFreeCompileEnv -- * * Free the storage allocated in a CompileEnv compilation environment * structure. * * Results: * None. * * Side effects: * Allocated storage in the CompileEnv structure is freed. Note that its * local literal table is not deleted and its literal objects are not * released. In addition, storage referenced by its auxiliary data items * is not freed. This is done so that, when compilation is successful, * "ownership" of these objects and aux data items is handed over to the * corresponding ByteCode structure. * *---------------------------------------------------------------------- */ void TclFreeCompileEnv( CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){ ckfree(envPtr->localLitTable.buckets); envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } if (envPtr->iPtr) { /* * We never converted to Bytecode, so free the things we would * have transferred to it. */ int i; LiteralEntry *entryPtr = envPtr->literalArrayPtr; AuxData *auxDataPtr = envPtr->auxDataArrayPtr; for (i = 0; i < envPtr->literalArrayNext; i++) { TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr); entryPtr++; } #ifdef TCL_COMPILE_DEBUG TclVerifyGlobalLiteralTable(envPtr->iPtr); #endif /*TCL_COMPILE_DEBUG*/ for (i = 0; i < envPtr->auxDataArrayNext; i++) { if (auxDataPtr->type->freeProc != NULL) { auxDataPtr->type->freeProc(auxDataPtr->clientData); } auxDataPtr++; } } if (envPtr->mallocedCodeArray) { ckfree(envPtr->codeStart); } if (envPtr->mallocedLiteralArray) { ckfree(envPtr->literalArrayPtr); } if (envPtr->mallocedExceptArray) { ckfree(envPtr->exceptArrayPtr); ckfree(envPtr->exceptAuxArrayPtr); } if (envPtr->mallocedCmdMap) { ckfree(envPtr->cmdMapPtr); } if (envPtr->mallocedAuxDataArray) { ckfree(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { ReleaseCmdWordData(envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; } } /* *---------------------------------------------------------------------- * * TclWordKnownAtCompileTime -- * * Test whether the value of a token is completely known at compile time. * * Results: * Returns true if the tokenPtr argument points to a word value that is * completely known at compile time. Generally, values that are known at * compile time can be compiled to their values, while values that cannot * be known until substitution at runtime must be compiled to bytecode * instructions that perform that substitution. For several commands, * whether or not arguments are known at compile time determine whether * it is worthwhile to compile at all. * * Side effects: * When returning true, appends the known value of the word to the * unshared Tcl_Obj (*valuePtr), unless valuePtr is NULL. * *---------------------------------------------------------------------- */ int TclWordKnownAtCompileTime( Tcl_Token *tokenPtr, /* Points to Tcl_Token we should check */ Tcl_Obj *valuePtr) /* If not NULL, points to an unshared Tcl_Obj * to which we should append the known value * of the word. */ { int numComponents = tokenPtr->numComponents; Tcl_Obj *tempPtr = NULL; if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { if (valuePtr != NULL) { Tcl_AppendToObj(valuePtr, tokenPtr[1].start, tokenPtr[1].size); } return 1; } if (tokenPtr->type != TCL_TOKEN_WORD) { return 0; } tokenPtr++; if (valuePtr != NULL) { TclNewObj(tempPtr); Tcl_IncrRefCount(tempPtr); } while (numComponents--) { switch (tokenPtr->type) { case TCL_TOKEN_TEXT: if (tempPtr != NULL) { Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size); } break; case TCL_TOKEN_BS: if (tempPtr != NULL) { char utfBuf[TCL_UTF_MAX] = ""; int length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, utfBuf); Tcl_AppendToObj(tempPtr, utfBuf, length); } break; default: if (tempPtr != NULL) { Tcl_DecrRefCount(tempPtr); } return 0; } tokenPtr++; } if (valuePtr != NULL) { Tcl_AppendObjToObj(valuePtr, tempPtr); Tcl_DecrRefCount(tempPtr); } return 1; } /* *---------------------------------------------------------------------- * * TclCompileScript -- * * Compile a Tcl script in a string. * * Results: * The return value is TCL_OK on a successful compilation and TCL_ERROR * on failure. If TCL_ERROR is returned, then the interpreter's result * contains an error message. * * Side effects: * Adds instructions to envPtr to evaluate the script at runtime. * *---------------------------------------------------------------------- */ static int ExpandRequested( Tcl_Token *tokenPtr, int numWords) { /* Determine whether any words of the command require expansion */ while (numWords--) { if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { return 1; } tokenPtr = TokenAfter(tokenPtr); } return 0; } static void CompileCmdLiteral( Tcl_Interp *interp, Tcl_Obj *cmdObj, CompileEnv *envPtr) { int numBytes; const char *bytes; Command *cmdPtr; int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags); if (cmdPtr) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); } TclEmitPush(cmdLitIdx, envPtr); } void TclCompileInvocation( Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, CompileEnv *envPtr) { DefineLineInformation; int wordIdx = 0, depth = TclGetStackDepth(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; tokenPtr = TokenAfter(tokenPtr); } for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { int objIdx; SetLineInformation(wordIdx); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { CompileTokens(envPtr, tokenPtr, interp); continue; } objIdx = TclRegisterNewLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size); if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, envPtr->clNext); } TclEmitPush(objIdx, envPtr); } if (wordIdx <= 255) { TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx); } else { TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx); } TclCheckStackDepth(depth+1, envPtr); } static void CompileExpanded( Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, CompileEnv *envPtr) { DefineLineInformation; int wordIdx = 0; int depth = TclGetStackDepth(envPtr); StartExpanding(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; tokenPtr = TokenAfter(tokenPtr); } for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { int objIdx; SetLineInformation(wordIdx); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { CompileTokens(envPtr, tokenPtr, interp); if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { TclEmitInstInt4(INST_EXPAND_STKTOP, envPtr->currStackDepth, envPtr); } continue; } objIdx = TclRegisterNewLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size); if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, envPtr->clNext); } TclEmitPush(objIdx, envPtr); } /* * The stack depth during argument expansion can only be managed at * runtime, as the number of elements in the expanded lists is not known * at compile time. We adjust here the stack depth estimate so that it is * correct after the command with expanded arguments returns. * * The end effect of this command's invocation is that all the words of * the command are popped from the stack, and the result is pushed: the * stack top changes by (1-wordIdx). * * Note that the estimates are not correct while the command is being * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general. */ TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx); TclCheckStackDepth(depth+1, envPtr); } static int CompileCmdCompileProc( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr) { DefineLineInformation; int unwind = 0, incrOffset = -1; int depth = TclGetStackDepth(envPtr); /* * Emit of the INST_START_CMD instruction is controlled by the value of * envPtr->atCmdStart: * * atCmdStart == 2 : We are not using the INST_START_CMD instruction. * atCmdStart == 1 : INST_START_CMD was the last instruction emitted. * : We do not need to emit another. Instead we * : increment the number of cmds started at it (except * : for the special case at the start of a script.) * atCmdStart == 0 : The last instruction was something else. We need * : to emit INST_START_CMD here. */ switch (envPtr->atCmdStart) { case 0: unwind = tclInstructionTable[INST_START_CMD].numBytes; TclEmitInstInt4(INST_START_CMD, 0, envPtr); incrOffset = envPtr->codeNext - envPtr->codeStart; TclEmitInt4(0, envPtr); break; case 1: if (envPtr->codeNext > envPtr->codeStart) { incrOffset = envPtr->codeNext - 4 - envPtr->codeStart; } break; case 2: /* Nothing to do */ ; } if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) { if (incrOffset >= 0) { /* * We successfully compiled a command. Increment the number of * commands that start at the currently active INST_START_CMD. */ unsigned char *incrPtr = envPtr->codeStart + incrOffset; unsigned char *startPtr = incrPtr - 5; TclIncrUInt4AtPtr(incrPtr, 1); if (unwind) { /* We started the INST_START_CMD. Record the code length. */ TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1); } } TclCheckStackDepth(depth+1, envPtr); return TCL_OK; } envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */ /* * Throw out any line information generated by the failed compile attempt. */ while (mapPtr->nuloc - 1 > eclIndex) { mapPtr->nuloc--; ckfree(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; } /* * Reset the index of next command. Toss out any from failed nested * partial compiles. */ envPtr->numCommands = mapPtr->nuloc; return TCL_ERROR; } static int CompileCommandTokens( Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr) { Interp *iPtr = (Interp *) interp; Tcl_Token *tokenPtr = parsePtr->tokenPtr; ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; Tcl_Obj *cmdObj; Command *cmdPtr = NULL; int code = TCL_ERROR; int cmdKnown, expand = -1; int *wlines, wlineat; int cmdLine = envPtr->line; int *clNext = envPtr->clNext; int cmdIdx = envPtr->numCommands; int startCodeOffset = envPtr->codeNext - envPtr->codeStart; int depth = TclGetStackDepth(envPtr); TclNewObj(cmdObj); assert (parsePtr->numWords > 0); /* Precompile */ envPtr->numCommands++; EnterCmdStartData(envPtr, cmdIdx, parsePtr->commandStart - envPtr->source, startCodeOffset); /* * TIP #280. Scan the words and compute the extended location information. * At first the map first contains full per-word line information for use by the * compiler. This is later replaced by a reduced form which signals * non-literal words, stored in 'wlines'. */ EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source, parsePtr->tokenPtr, parsePtr->commandStart, parsePtr->commandSize, parsePtr->numWords, cmdLine, clNext, &wlines, envPtr); wlineat = eclPtr->nuloc - 1; envPtr->line = eclPtr->loc[wlineat].line[0]; envPtr->clNext = eclPtr->loc[wlineat].next[0]; /* Do we know the command word? */ Tcl_IncrRefCount(cmdObj); tokenPtr = parsePtr->tokenPtr; cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj); /* Is this a command we should (try to) compile with a compileProc ? */ if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if (cmdPtr) { /* * Found a command. Test the ways we can be told not to attempt * to compile it. */ if ((cmdPtr->compileProc == NULL) || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION) || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { cmdPtr = NULL; } } if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) { expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); if (expand) { /* We need to expand, but compileProc cannot. */ cmdPtr = NULL; } } } /* If cmdPtr != NULL, try to call cmdPtr->compileProc */ if (cmdPtr) { code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr); } if (code == TCL_ERROR) { if (expand < 0) { expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); } if (expand) { CompileExpanded(interp, parsePtr->tokenPtr, cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); } else { TclCompileInvocation(interp, parsePtr->tokenPtr, cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); } } Tcl_DecrRefCount(cmdObj); TclEmitOpcode(INST_POP, envPtr); EnterCmdExtentData(envPtr, cmdIdx, parsePtr->term - parsePtr->commandStart, (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); /* * TIP #280: Free full form of per-word line data and insert the reduced * form now */ envPtr->line = cmdLine; envPtr->clNext = clNext; ckfree(eclPtr->loc[wlineat].line); ckfree(eclPtr->loc[wlineat].next); eclPtr->loc[wlineat].line = wlines; eclPtr->loc[wlineat].next = NULL; TclCheckStackDepth(depth, envPtr); return cmdIdx; } void TclCompileScript( Tcl_Interp *interp, /* Used for error and status reporting. Also * serves as context for finding and compiling * commands. May not be NULL. */ const char *script, /* The source script to compile. */ int numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last * command this routine compiles into bytecode. * Initial value of -1 indicates this routine * has not yet generated any bytecode. */ const char *p = script; /* Where we are in our compile. */ int depth = TclGetStackDepth(envPtr); Interp *iPtr = (Interp *) interp; if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } /* * Check depth to avoid overflow of the C execution stack by too many * nested calls of TclCompileScript, considering interp recursionlimit. * Use factor 5/4 (1.25) to avoid being too mistaken when recognizing the * limit during "mixed" evaluation and compilation process (nested * eval+compile) and is good enough for default recursionlimit (1000). */ if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "too many nested compilations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); TclCompileSyntaxError(interp, envPtr); return; } /* Each iteration compiles one command from the script. */ if (numBytes > 0) { /* * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so * many nested compilations (body enclosed in body) can cause abnormal * program termination with a stack overflow exception, bug [fec0c17d39]. */ Tcl_Parse *parsePtr = (Tcl_Parse *)ckalloc(sizeof(Tcl_Parse)); do { const char *next; if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) { /* * Compile bytecodes to report the parsePtr error at runtime. */ Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, parsePtr->term + 1 - parsePtr->commandStart); TclCompileSyntaxError(interp, envPtr); ckfree(parsePtr); return; } #ifdef TCL_COMPILE_DEBUG /* * If tracing, print a line for each top level command compiled. * TODO: Suppress when numWords == 0 ? */ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { int commandLength = parsePtr->term - parsePtr->commandStart; fprintf(stdout, " Compiling: "); TclPrintSource(stdout, parsePtr->commandStart, TclMin(commandLength, 55)); fprintf(stdout, "\n"); } #endif /* * TIP #280: Count newlines before the command start. * (See test info-30.33). */ TclAdvanceLines(&envPtr->line, p, parsePtr->commandStart); TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, parsePtr->commandStart - envPtr->source); /* * Advance parser to the next command in the script. */ next = parsePtr->commandStart + parsePtr->commandSize; numBytes -= next - p; p = next; if (parsePtr->numWords == 0) { /* * The "command" parsed has no words. In this case we can skip * the rest of the loop body. With no words, clearly * CompileCommandTokens() has nothing to do. Since the parser * aggressively sucks up leading comment and white space, * including newlines, parsePtr->commandStart must be pointing at * either the end of script, or a command-terminating semi-colon. * In either case, the TclAdvance*() calls have nothing to do. * Finally, when no words are parsed, no tokens have been * allocated at parsePtr->tokenPtr so there's also nothing for * Tcl_FreeParse() to do. * * The advantage of this shortcut is that CompileCommandTokens() * can be written with an assumption that parsePtr->numWords > 0, with * the implication the CCT() always generates bytecode. */ continue; } /* * Avoid stack exhaustion by too many nested calls of TclCompileScript * (considering interp recursionlimit). */ iPtr->numLevels++; lastCmdIdx = CompileCommandTokens(interp, parsePtr, envPtr); iPtr->numLevels--; /* * TIP #280: Track lines in the just compiled command. */ TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p); TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, p - envPtr->source); Tcl_FreeParse(parsePtr); } while (numBytes > 0); ckfree(parsePtr); } if (lastCmdIdx == -1) { /* * Compiling the script yielded no bytecode. The script must be all * whitespace, comments, and empty commands. Such scripts are defined * to successfully produce the empty string result, so we emit the * simple bytecode that makes that happen. */ PushStringLiteral(envPtr, ""); } else { /* * We compiled at least one command to bytecode. The routine * CompileCommandTokens() follows the bytecode of each compiled * command with an INST_POP, so that stack balance is maintained when * several commands are in sequence. (The result of each command is * thrown away before moving on to the next command). For the last * command compiled, we need to undo that INST_POP so that the result * of the last command becomes the result of the script. The code * here removes that trailing INST_POP. */ envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; envPtr->codeNext--; envPtr->currStackDepth++; } TclCheckStackDepth(depth+1, envPtr); } /* *---------------------------------------------------------------------- * * TclCompileTokens -- * * Given an array of tokens parsed from a Tcl command, e.g. the tokens * that make up a word, emits instructions to evaluate the * tokens and concatenate their values to form a single result value on * the interpreter's runtime evaluation stack. * * Results: * The return value is a standard Tcl result. If an error occurs, an * error message is left in the interpreter's result. * * Side effects: * Instructions are added to envPtr to push and evaluate the tokens at * runtime. * *---------------------------------------------------------------------- */ void TclCompileVarSubst( Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; int i, localVar, nameBytes = tokenPtr[1].size; int localVarName = 1; /* * Determine how the variable name should be handled: if it contains any * namespace qualifiers it is not a local variable (localVarName=-1); if * it looks like an array element and the token has a single component, it * should not be created here [Bug 569438] (localVarName=0); otherwise, * the local variable can safely be created (localVarName=1). */ for (i = 0, p = name; i < nameBytes; i++, p++) { if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) { localVarName = -1; break; } else if ((*p == '(') && (tokenPtr->numComponents == 1) && (*(name + nameBytes - 1) == ')')) { localVarName = 0; break; } } /* * Either push the variable's name, or find its index in the array * of local variables in a procedure frame. */ localVar = -1; if (localVarName != -1) { localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr); } if (localVar < 0) { PushLiteral(envPtr, name, nameBytes); } /* * Emit instructions to load the variable. */ TclAdvanceLines(&envPtr->line, tokenPtr[1].start, tokenPtr[1].start + tokenPtr[1].size); if (tokenPtr->numComponents == 1) { if (localVar < 0) { TclEmitOpcode(INST_LOAD_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr); } else { TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr); } } else { TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr); if (localVar < 0) { TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr); } else { TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr); } } } void TclCompileTokens( Tcl_Interp *interp, /* Used for error and status reporting. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * compile. */ int count, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[TCL_UTF_MAX] = ""; int i, numObjsToConcat, length, adjust; unsigned char *entryCodeNext = envPtr->codeNext; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL; int *clPosition = NULL; int depth = TclGetStackDepth(envPtr); /* * For the handling of continuation lines in literals, first check if * this is actually a literal. For if not we can forego the additional * processing. Otherwise preallocate a small table to store the * locations of all continuation lines found in this literal, if any. * The table is extended if needed. * * Note: Different to the equivalent code in function 'TclSubstTokens()' * (see file "tclParse.c") there seem to be no need the 'adjust' variable. * There also seems to be no need for code which merges continuation line * information of multiple words which concat'd at runtime. Either that or * I have not managed to find a test case for these two possibilities yet. * It might be a difference between compile- versus run-time processing. */ numCL = 0; maxNumCL = 0; isLiteral = 1; for (i=0 ; i < count; i++) { if ((tokenPtr[i].type != TCL_TOKEN_TEXT) && (tokenPtr[i].type != TCL_TOKEN_BS)) { isLiteral = 0; break; } } if (isLiteral) { maxNumCL = NUM_STATIC_POS; clPosition = (int *)ckalloc(maxNumCL * sizeof(int)); } adjust = 0; Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; for ( ; count > 0; count--, tokenPtr++) { switch (tokenPtr->type) { case TCL_TOKEN_TEXT: TclDStringAppendToken(&textBuffer, tokenPtr); TclAdvanceLines(&envPtr->line, tokenPtr->start, tokenPtr->start + tokenPtr->size); break; case TCL_TOKEN_BS: length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, buffer); Tcl_DStringAppend(&textBuffer, buffer, length); /* * If the backslash sequence we found is in a literal, and * represented a continuation line, we compute and store its * location (as char offset to the beginning of the _result_ * script). We may have to extend the table of locations. * * Note that the continuation line information is relevant even if * the word we are processing is not a literal, as it can affect * nested commands. See the branch for TCL_TOKEN_COMMAND below, * where the adjustment we are tracking here is taken into * account. The good thing is that we do not need a table of * everything, just the number of lines we have to add as * correction. */ if ((length == 1) && (buffer[0] == ' ') && (tokenPtr->start[1] == '\n')) { if (isLiteral) { int clPos = Tcl_DStringLength(&textBuffer); if (numCL >= maxNumCL) { maxNumCL *= 2; clPosition = (int *)ckrealloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; numCL ++; } adjust++; } break; case TCL_TOKEN_COMMAND: /* * Push any accumulated chars appearing before the command. */ if (Tcl_DStringLength(&textBuffer) > 0) { int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); if (numCL) { TclContinuationsEnter(TclFetchLiteral(envPtr, literal), numCL, clPosition); } numCL = 0; } envPtr->line += adjust; TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr); envPtr->line -= adjust; numObjsToConcat++; break; case TCL_TOKEN_VARIABLE: /* * Push any accumulated chars appearing before the $. */ if (Tcl_DStringLength(&textBuffer) > 0) { int literal; literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); } TclCompileVarSubst(interp, tokenPtr, envPtr); numObjsToConcat++; count -= tokenPtr->numComponents; tokenPtr += tokenPtr->numComponents; break; default: Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s", tokenPtr->type, tokenPtr->size, tokenPtr->start); } } /* * Push any accumulated characters appearing at the end. */ if (Tcl_DStringLength(&textBuffer) > 0) { int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; if (numCL) { TclContinuationsEnter(TclFetchLiteral(envPtr, literal), numCL, clPosition); } numCL = 0; } /* * If necessary, concatenate the parts of the word. */ while (numObjsToConcat > 255) { TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); numObjsToConcat -= 254; /* concat pushes 1 obj, the result */ } if (numObjsToConcat > 1) { TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr); } /* * If the tokens yielded no instructions, push an empty string. */ if (envPtr->codeNext == entryCodeNext) { PushStringLiteral(envPtr, ""); } Tcl_DStringFree(&textBuffer); /* * Release the temp table we used to collect the locations of continuation * lines, if any. */ if (maxNumCL) { ckfree(clPosition); } TclCheckStackDepth(depth+1, envPtr); } /* *---------------------------------------------------------------------- * * TclCompileCmdWord -- * * Given an array of parse tokens for a word containing one or more Tcl * commands, emit inline instructions to execute them. This procedure * differs from TclCompileTokens in that a simple word such as a loop * body enclosed in braces is not just pushed as a string, but is itself * parsed into tokens and compiled. * * Results: * The return value is a standard Tcl result. If an error occurs, an * error message is left in the interpreter's result. * * Side effects: * Instructions are added to envPtr to execute the tokens at runtime. * *---------------------------------------------------------------------- */ void TclCompileCmdWord( Tcl_Interp *interp, /* Used for error and status reporting. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens for * a command word to compile inline. */ int count, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) { /* * Handle the common case: if there is a single text token, compile it * into an inline sequence of instructions. */ TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr); } else { /* * Multiple tokens or the single token involves substitutions. Emit * instructions to invoke the eval command procedure at runtime on the * result of evaluating the tokens. */ TclCompileTokens(interp, tokenPtr, count, envPtr); TclEmitInvoke(envPtr, INST_EVAL_STK); } } /* *---------------------------------------------------------------------- * * TclCompileExprWords -- * * Given an array of parse tokens representing one or more words that * contain a Tcl expression, emit inline instructions to execute the * expression. This procedure differs from TclCompileExpr in that it * supports Tcl's two-level substitution semantics for expressions that * appear as command words. * * Results: * The return value is a standard Tcl result. If an error occurs, an * error message is left in the interpreter's result. * * Side effects: * Instructions are added to envPtr to execute the expression. * *---------------------------------------------------------------------- */ void TclCompileExprWords( Tcl_Interp *interp, /* Used for error and status reporting. */ Tcl_Token *tokenPtr, /* Points to first in an array of word tokens * tokens for the expression to compile * inline. */ int numWords, /* Number of word tokens starting at tokenPtr. * Must be at least 1. Each word token * contains one or more subtokens. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { Tcl_Token *wordPtr; int i, concatItems; /* * If the expression is a single word that doesn't require substitutions, * just compile its string into inline instructions. */ if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { TclCompileExpr(interp, tokenPtr[1].start,tokenPtr[1].size, envPtr, 1); return; } /* * Emit code to call the expr command proc at runtime. Concatenate the * (already substituted once) expr tokens with a space between each. */ wordPtr = tokenPtr; for (i = 0; i < numWords; i++) { CompileTokens(envPtr, wordPtr, interp); if (i < (numWords - 1)) { PushStringLiteral(envPtr, " "); } wordPtr += wordPtr->numComponents + 1; } concatItems = 2*numWords - 1; while (concatItems > 255) { TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); concatItems -= 254; } if (concatItems > 1) { TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr); } TclEmitOpcode(INST_EXPR_STK, envPtr); } /* *---------------------------------------------------------------------- * * TclCompileNoOp -- * * Function called to compile no-op's * * Results: * The return value is TCL_OK, indicating successful compilation. * * Side effects: * Instructions are added to envPtr to execute a no-op at runtime. No * result is pushed onto the stack: the compiler has to take care of this * itself if the last compiled command is a NoOp. * *---------------------------------------------------------------------- */ int TclCompileNoOp( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; int i; tokenPtr = parsePtr->tokenPtr; for (i = 1; i < parsePtr->numWords; i++) { tokenPtr = tokenPtr + tokenPtr->numComponents + 1; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_POP, envPtr); } } PushStringLiteral(envPtr, ""); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclInitByteCodeObj -- * * Creates a ByteCode structure and initializes it from a CompileEnv * compilation environment structure. The ByteCode structure is smaller * and contains just that information needed to execute the bytecode * instructions resulting from compiling a Tcl script. The resulting * structure is placed in the specified object. * * Results: * A newly-constructed ByteCode object is stored in the internal * representation of the objPtr. * * Side effects: * A single heap object is allocated to hold the new ByteCode structure * and its code, object, command location, and aux data arrays. Note that * "ownership" (i.e., the pointers to) the Tcl objects and aux data items * will be handed over to the new ByteCode structure from the CompileEnv * structure. * *---------------------------------------------------------------------- */ void TclInitByteCodeObj( Tcl_Obj *objPtr, /* Points object that should be initialized, * and whose string rep contains the source * code. */ CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { ByteCode *codePtr; size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes; size_t auxDataArrayBytes, structureSize; unsigned char *p; #ifdef TCL_COMPILE_DEBUG unsigned char *nextPtr; #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; int i, isNew; Interp *iPtr; if (envPtr->iPtr == NULL) { Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv"); } iPtr = envPtr->iPtr; codeBytes = envPtr->codeNext - envPtr->codeStart; objArrayBytes = envPtr->literalArrayNext * sizeof(Tcl_Obj *); exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange); auxDataArrayBytes = envPtr->auxDataArrayNext * sizeof(AuxData); cmdLocBytes = GetCmdLocEncodingSize(envPtr); /* * Compute the total number of bytes needed for this bytecode. */ structureSize = sizeof(ByteCode); structureSize += TCL_ALIGN(codeBytes); /* align object array */ structureSize += TCL_ALIGN(objArrayBytes); /* align exc range arr */ structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */ structureSize += auxDataArrayBytes; structureSize += cmdLocBytes; if (envPtr->iPtr->varFramePtr != NULL) { namespacePtr = envPtr->iPtr->varFramePtr->nsPtr; } else { namespacePtr = envPtr->iPtr->globalNsPtr; } p = (unsigned char *)ckalloc(structureSize); codePtr = (ByteCode *) p; codePtr->interpHandle = TclHandlePreserve(iPtr->handle); codePtr->compileEpoch = iPtr->compileEpoch; codePtr->nsPtr = namespacePtr; codePtr->nsEpoch = namespacePtr->resolverEpoch; codePtr->refCount = 1; if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) { codePtr->flags = TCL_BYTECODE_RESOLVE_VARS; } else { codePtr->flags = 0; } codePtr->source = envPtr->source; codePtr->procPtr = envPtr->procPtr; codePtr->numCommands = envPtr->numCommands; codePtr->numSrcBytes = envPtr->numSrcBytes; codePtr->numCodeBytes = codeBytes; codePtr->numLitObjects = numLitObjects; codePtr->numExceptRanges = envPtr->exceptArrayNext; codePtr->numAuxDataItems = envPtr->auxDataArrayNext; codePtr->numCmdLocBytes = cmdLocBytes; codePtr->maxExceptDepth = envPtr->maxExceptDepth; codePtr->maxStackDepth = envPtr->maxStackDepth; p += sizeof(ByteCode); codePtr->codeStart = p; memcpy(p, envPtr->codeStart, codeBytes); p += TCL_ALIGN(codeBytes); /* align object array */ codePtr->objArrayPtr = (Tcl_Obj **) p; for (i = 0; i < numLitObjects; i++) { Tcl_Obj *fetched = TclFetchLiteral(envPtr, i); if (objPtr == fetched) { /* * Prevent circular reference where the bytecode internalrep of * a value contains a literal which is that same value. * If this is allowed to happen, refcount decrements may not * reach zero, and memory may leak. Bugs 467523, 3357771 * * NOTE: [Bugs 3392070, 3389764] We make a copy based completely * on the string value, and do not call Tcl_DuplicateObj() so we * can be sure we do not have any lingering cycles hiding in * the internalrep. */ int numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes); Tcl_IncrRefCount(codePtr->objArrayPtr[i]); TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr); } else { codePtr->objArrayPtr[i] = fetched; } } p += TCL_ALIGN(objArrayBytes); /* align exception range array */ if (exceptArrayBytes > 0) { codePtr->exceptArrayPtr = (ExceptionRange *) p; memcpy(p, envPtr->exceptArrayPtr, exceptArrayBytes); } else { codePtr->exceptArrayPtr = NULL; } p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */ if (auxDataArrayBytes > 0) { codePtr->auxDataArrayPtr = (AuxData *) p; memcpy(p, envPtr->auxDataArrayPtr, auxDataArrayBytes); } else { codePtr->auxDataArrayPtr = NULL; } p += auxDataArrayBytes; #ifndef TCL_COMPILE_DEBUG EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p); #else nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p); if (((size_t)(nextPtr - p)) != cmdLocBytes) { Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %lu != expected size %lu", (unsigned long)(nextPtr - p), (unsigned long)cmdLocBytes); } #endif /* * Record various compilation-related statistics about the new ByteCode * structure. Don't include overhead for statistics-related fields. */ #ifdef TCL_COMPILE_STATS codePtr->structureSize = structureSize - (sizeof(size_t) + sizeof(Tcl_Time)); Tcl_GetTime(&codePtr->createTime); RecordByteCodeStats(codePtr); #endif /* TCL_COMPILE_STATS */ /* * Free the old internal rep then convert the object to a bytecode object * by making its internal rep point to the just compiled ByteCode. */ TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = codePtr; objPtr->typePtr = &tclByteCodeType; /* * TIP #280. Associate the extended per-word line information with the * byte code object (internal rep), for use with the bc compiler. */ Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr, &isNew), envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; /* We've used up the CompileEnv. Mark as uninitialized. */ envPtr->iPtr = NULL; codePtr->localCachePtr = NULL; } /* *---------------------------------------------------------------------- * * TclFindCompiledLocal -- * * This procedure is called at compile time to look up and optionally * allocate an entry ("slot") for a variable in a procedure's array of * local variables. If the variable's name is NULL, a new temporary * variable is always created. (Such temporary variables can only be * referenced using their slot index.) * * Results: * If create is 0 and the name is non-NULL, then if the variable is * found, the index of its entry in the procedure's array of local * variables is returned; otherwise -1 is returned. If name is NULL, the * index of a new temporary variable is returned. Finally, if create is 1 * and name is non-NULL, the index of a new entry is returned. * * Side effects: * Creates and registers a new local variable if create is 1 and the * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ int TclFindCompiledLocal( const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ int nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ CompileEnv *envPtr) /* Points to the current compile environment*/ { CompiledLocal *localPtr; int localVar = -1; int i; Proc *procPtr; /* * If not creating a temporary, does a local variable of the specified * name already exist? */ procPtr = envPtr->procPtr; if (procPtr == NULL) { /* * Compiling a non-body script: give it read access to the LVT in the * current localCache */ LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr; const char *localName; Tcl_Obj **varNamePtr; int len; if (!cachePtr || !name) { return -1; } varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { localName = Tcl_GetStringFromObj(*varNamePtr, &len); if ((len == nameBytes) && !strncmp(name, localName, len)) { return i; } } } return -1; } if (name != NULL) { int localCt = procPtr->numCompiledLocals; localPtr = procPtr->firstLocalPtr; for (i = 0; i < localCt; i++) { if (!TclIsVarTemporary(localPtr)) { char *localName = localPtr->name; if ((nameBytes == localPtr->nameLength) && (strncmp(name, localName, nameBytes) == 0)) { return i; } } localPtr = localPtr->nextPtr; } } /* * Create a new variable if appropriate. */ if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; localPtr = (CompiledLocal *)ckalloc(TclOffset(CompiledLocal, name) + 1U + nameBytes); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; } localPtr->nextPtr = NULL; localPtr->nameLength = nameBytes; localPtr->frameIndex = localVar; localPtr->flags = 0; if (name == NULL) { localPtr->flags |= VAR_TEMPORARY; } localPtr->defValuePtr = NULL; localPtr->resolveInfo = NULL; if (name != NULL) { memcpy(localPtr->name, name, nameBytes); } localPtr->name[nameBytes] = '\0'; procPtr->numCompiledLocals++; } return localVar; } /* *---------------------------------------------------------------------- * * TclExpandCodeArray -- * * Procedure that uses malloc to allocate more storage for a CompileEnv's * code array. * * Results: * None. * * Side effects: * The byte code array in *envPtr is reallocated to a new array of double * the size, and if envPtr->mallocedCodeArray is non-zero the old array * is freed. Byte codes are copied from the old array to the new one. * *---------------------------------------------------------------------- */ void TclExpandCodeArray( void *envArgPtr) /* Points to the CompileEnv whose code array * must be enlarged. */ { CompileEnv *envPtr = (CompileEnv *)envArgPtr; /* The CompileEnv containing the code array to * be doubled in size. */ /* * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined * code bytes are stored between envPtr->codeStart and envPtr->codeNext-1 * [inclusive]. */ size_t currBytes = envPtr->codeNext - envPtr->codeStart; size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart); if (envPtr->mallocedCodeArray) { envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes); } else { /* * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a * ckrealloc equivalent for ourselves. */ unsigned char *newPtr = (unsigned char *)ckalloc(newBytes); memcpy(newPtr, envPtr->codeStart, currBytes); envPtr->codeStart = newPtr; envPtr->mallocedCodeArray = 1; } envPtr->codeNext = envPtr->codeStart + currBytes; envPtr->codeEnd = envPtr->codeStart + newBytes; } /* *---------------------------------------------------------------------- * * EnterCmdStartData -- * * Registers the starting source and bytecode location of a command. This * information is used at runtime to map between instruction pc and * source locations. * * Results: * None. * * Side effects: * Inserts source and code location information into the compilation * environment envPtr for the command at index cmdIndex. The compilation * environment's CmdLocation array is grown if necessary. * *---------------------------------------------------------------------- */ static void EnterCmdStartData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ int cmdIndex, /* Index of the command whose start data is * being set. */ int srcOffset, /* Offset of first char of the command. */ int codeOffset) /* Offset of first byte of command code. */ { CmdLocation *cmdLocPtr; if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) { Tcl_Panic("EnterCmdStartData: bad command index %d", cmdIndex); } if (cmdIndex >= envPtr->cmdMapEnd) { /* * Expand the command location array by allocating more storage from * the heap. The currently allocated CmdLocation entries are stored * from cmdMapPtr[0] up to cmdMapPtr[envPtr->cmdMapEnd] (inclusive). */ size_t currElems = envPtr->cmdMapEnd; size_t newElems = 2 * currElems; size_t currBytes = currElems * sizeof(CmdLocation); size_t newBytes = newElems * sizeof(CmdLocation); if (envPtr->mallocedCmdMap) { envPtr->cmdMapPtr = (CmdLocation *)ckrealloc(envPtr->cmdMapPtr, newBytes); } else { /* * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a * ckrealloc equivalent for ourselves. */ CmdLocation *newPtr = (CmdLocation *)ckalloc(newBytes); memcpy(newPtr, envPtr->cmdMapPtr, currBytes); envPtr->cmdMapPtr = newPtr; envPtr->mallocedCmdMap = 1; } envPtr->cmdMapEnd = newElems; } if (cmdIndex > 0) { if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) { Tcl_Panic("EnterCmdStartData: cmd map not sorted by code offset"); } } cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex]; cmdLocPtr->codeOffset = codeOffset; cmdLocPtr->srcOffset = srcOffset; cmdLocPtr->numSrcBytes = -1; cmdLocPtr->numCodeBytes = -1; } /* *---------------------------------------------------------------------- * * EnterCmdExtentData -- * * Registers the source and bytecode length for a command. This * information is used at runtime to map between instruction pc and * source locations. * * Results: * None. * * Side effects: * Inserts source and code length information into the compilation * environment envPtr for the command at index cmdIndex. Starting source * and bytecode information for the command must already have been * registered. * *---------------------------------------------------------------------- */ static void EnterCmdExtentData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ int cmdIndex, /* Index of the command whose source and code * length data is being set. */ int numSrcBytes, /* Number of command source chars. */ int numCodeBytes) /* Offset of last byte of command code. */ { CmdLocation *cmdLocPtr; if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) { Tcl_Panic("EnterCmdExtentData: bad command index %d", cmdIndex); } if (cmdIndex > envPtr->cmdMapEnd) { Tcl_Panic("EnterCmdExtentData: missing start data for command %d", cmdIndex); } cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex]; cmdLocPtr->numSrcBytes = numSrcBytes; cmdLocPtr->numCodeBytes = numCodeBytes; } /* *---------------------------------------------------------------------- * TIP #280 * * EnterCmdWordData -- * * Registers the lines for the words of a command. This information is * used at runtime by 'info frame'. * * Results: * None. * * Side effects: * Inserts word location information into the compilation environment * envPtr for the command at index cmdIndex. The compilation * environment's ExtCmdLoc.ECL array is grown if necessary. * *---------------------------------------------------------------------- */ static void EnterCmdWordData( ExtCmdLoc *eclPtr, /* Points to the map environment structure in * which to enter command location * information. */ int srcOffset, /* Offset of first char of the command. */ Tcl_Token *tokenPtr, const char *cmd, int len, int numWords, int line, int *clNext, int **wlines, CompileEnv *envPtr) { ECL *ePtr; const char *last; int wordIdx, wordLine, *wwlines, *wordNext; if (eclPtr->nuloc >= eclPtr->nloc) { /* * Expand the ECL array by allocating more storage from the heap. The * currently allocated ECL entries are stored from eclPtr->loc[0] up * to eclPtr->loc[eclPtr->nuloc-1] (inclusive). */ size_t currElems = eclPtr->nloc; size_t newElems = (currElems ? 2*currElems : 1); size_t newBytes = newElems * sizeof(ECL); eclPtr->loc = (ECL *)ckrealloc(eclPtr->loc, newBytes); eclPtr->nloc = newElems; } ePtr = &eclPtr->loc[eclPtr->nuloc]; ePtr->srcOffset = srcOffset; ePtr->line = (int *)ckalloc(numWords * sizeof(int)); ePtr->next = (int **)ckalloc(numWords * sizeof(int *)); ePtr->nline = numWords; wwlines = (int *)ckalloc(numWords * sizeof(int)); last = cmd; wordLine = line; wordNext = clNext; for (wordIdx=0 ; wordIdxnumComponents + 1) { TclAdvanceLines(&wordLine, last, tokenPtr->start); TclAdvanceContinuations(&wordLine, &wordNext, tokenPtr->start - envPtr->source); /* See Ticket 4b61afd660 */ wwlines[wordIdx] = ((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL)) ? wordLine : -1; ePtr->line[wordIdx] = wordLine; ePtr->next[wordIdx] = wordNext; last = tokenPtr->start; } *wlines = wwlines; eclPtr->nuloc ++; } /* *---------------------------------------------------------------------- * * TclCreateExceptRange -- * * Procedure that allocates and initializes a new ExceptionRange * structure of the specified kind in a CompileEnv. * * Results: * Returns the index for the newly created ExceptionRange. * * Side effects: * If there is not enough room in the CompileEnv's ExceptionRange array, * the array in expanded: a new array of double the size is allocated, if * envPtr->mallocedExceptArray is non-zero the old array is freed, and * ExceptionRange entries are copied from the old array to the new one. * *---------------------------------------------------------------------- */ int TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ CompileEnv *envPtr)/* Points to CompileEnv for which to create a * new ExceptionRange structure. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; int index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { /* * Expand the ExceptionRange array. The currently allocated entries * are stored between elements 0 and (envPtr->exceptArrayNext - 1) * [inclusive]. */ size_t currBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange); size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux); int newElems = 2*envPtr->exceptArrayEnd; size_t newBytes = newElems * sizeof(ExceptionRange); size_t newBytes2 = newElems * sizeof(ExceptionAux); if (envPtr->mallocedExceptArray) { envPtr->exceptArrayPtr = (ExceptionRange *)ckrealloc(envPtr->exceptArrayPtr, newBytes); envPtr->exceptAuxArrayPtr = (ExceptionAux *)ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2); } else { /* * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must * code a ckrealloc equivalent for ourselves. */ ExceptionRange *newPtr = (ExceptionRange *)ckalloc(newBytes); ExceptionAux *newPtr2 = (ExceptionAux *)ckalloc(newBytes2); memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2); envPtr->exceptArrayPtr = newPtr; envPtr->exceptAuxArrayPtr = newPtr2; envPtr->mallocedExceptArray = 1; } envPtr->exceptArrayEnd = newElems; } envPtr->exceptArrayNext++; rangePtr = &envPtr->exceptArrayPtr[index]; rangePtr->type = type; rangePtr->nestingLevel = envPtr->exceptDepth; rangePtr->codeOffset = -1; rangePtr->numCodeBytes = -1; rangePtr->breakOffset = -1; rangePtr->continueOffset = -1; rangePtr->catchOffset = -1; auxPtr = &envPtr->exceptAuxArrayPtr[index]; auxPtr->supportsContinue = 1; auxPtr->stackDepth = envPtr->currStackDepth; auxPtr->expandTarget = envPtr->expandCount; auxPtr->expandTargetDepth = -1; auxPtr->numBreakTargets = 0; auxPtr->breakTargets = NULL; auxPtr->allocBreakTargets = 0; auxPtr->numContinueTargets = 0; auxPtr->continueTargets = NULL; auxPtr->allocContinueTargets = 0; return index; } /* * --------------------------------------------------------------------- * * TclGetInnermostExceptionRange -- * * Returns the innermost exception range that covers the current code * creation point, and (optionally) the stack depth that is expected at * that point. Relies on the fact that the range has a numCodeBytes = -1 * when it is being populated and that inner ranges come after outer * ranges. * * --------------------------------------------------------------------- */ ExceptionRange * TclGetInnermostExceptionRange( CompileEnv *envPtr, int returnCode, ExceptionAux **auxPtrPtr) { int i = envPtr->exceptArrayNext; ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i; while (i > 0) { rangePtr--; i--; if (CurrentOffset(envPtr) >= rangePtr->codeOffset && (rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) < rangePtr->codeOffset+rangePtr->numCodeBytes) && (returnCode != TCL_CONTINUE || envPtr->exceptAuxArrayPtr[i].supportsContinue)) { if (auxPtrPtr) { *auxPtrPtr = envPtr->exceptAuxArrayPtr + i; } return rangePtr; } } return NULL; } /* * --------------------------------------------------------------------- * * TclAddLoopBreakFixup, TclAddLoopContinueFixup -- * * Adds a place that wants to break/continue to the loop exception range * tracking that will be fixed up once the loop can be finalized. These * functions generate an INST_JUMP4 that is fixed up during the * loop finalization. * * --------------------------------------------------------------------- */ void TclAddLoopBreakFixup( CompileEnv *envPtr, ExceptionAux *auxPtr) { int range = auxPtr - envPtr->exceptAuxArrayPtr; if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) { Tcl_Panic("trying to add 'break' fixup to full exception range"); } if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) { auxPtr->allocBreakTargets *= 2; auxPtr->allocBreakTargets += 2; if (auxPtr->breakTargets) { auxPtr->breakTargets = (unsigned int *)ckrealloc(auxPtr->breakTargets, sizeof(int) * auxPtr->allocBreakTargets); } else { auxPtr->breakTargets = (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocBreakTargets); } } auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr); TclEmitInstInt4(INST_JUMP4, 0, envPtr); } void TclAddLoopContinueFixup( CompileEnv *envPtr, ExceptionAux *auxPtr) { int range = auxPtr - envPtr->exceptAuxArrayPtr; if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) { Tcl_Panic("trying to add 'continue' fixup to full exception range"); } if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) { auxPtr->allocContinueTargets *= 2; auxPtr->allocContinueTargets += 2; if (auxPtr->continueTargets) { auxPtr->continueTargets = (unsigned int *)ckrealloc(auxPtr->continueTargets, sizeof(int) * auxPtr->allocContinueTargets); } else { auxPtr->continueTargets = (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocContinueTargets); } } auxPtr->continueTargets[auxPtr->numContinueTargets - 1] = CurrentOffset(envPtr); TclEmitInstInt4(INST_JUMP4, 0, envPtr); } /* * --------------------------------------------------------------------- * * TclCleanupStackForBreakContinue -- * * Ditch the extra elements from the auxiliary stack and the main stack. * How to do this exactly depends on whether there are any elements on * the auxiliary stack to pop. * * --------------------------------------------------------------------- */ void TclCleanupStackForBreakContinue( CompileEnv *envPtr, ExceptionAux *auxPtr) { int savedStackDepth = envPtr->currStackDepth; int toPop = envPtr->expandCount - auxPtr->expandTarget; if (toPop > 0) { while (toPop --> 0) { TclEmitOpcode(INST_EXPAND_DROP, envPtr); } TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth, envPtr); envPtr->currStackDepth = auxPtr->expandTargetDepth; } toPop = envPtr->currStackDepth - auxPtr->stackDepth; while (toPop --> 0) { TclEmitOpcode(INST_POP, envPtr); } envPtr->currStackDepth = savedStackDepth; } /* * --------------------------------------------------------------------- * * StartExpanding -- * * Pushes an INST_EXPAND_START and does some additional housekeeping so * that the [break] and [continue] compilers can use an exception-free * issue to discard it. * * --------------------------------------------------------------------- */ static void StartExpanding( CompileEnv *envPtr) { int i; TclEmitOpcode(INST_EXPAND_START, envPtr); /* * Update inner exception ranges with information about the environment * where this expansion started. */ for (i=0 ; iexceptArrayNext ; i++) { ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[i]; /* * Ignore loops unless they're still being built. */ if (rangePtr->codeOffset > CurrentOffset(envPtr)) { continue; } if (rangePtr->numCodeBytes != -1) { continue; } /* * Adequate condition: further out loops and further in exceptions * don't actually need this information. */ if (auxPtr->expandTarget == envPtr->expandCount) { auxPtr->expandTargetDepth = envPtr->currStackDepth; } } /* * There's now one more expansion being processed on the auxiliary stack. */ envPtr->expandCount++; } /* * --------------------------------------------------------------------- * * TclFinalizeLoopExceptionRange -- * * Finalizes a loop exception range, binding the registered [break] and * [continue] implementations so that they jump to the correct place. * Note that this must only be called after *all* the exception range * target offsets have been set. * * --------------------------------------------------------------------- */ void TclFinalizeLoopExceptionRange( CompileEnv *envPtr, int range) { ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[range]; ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[range]; int i, offset; unsigned char *site; if (rangePtr->type != LOOP_EXCEPTION_RANGE) { Tcl_Panic("trying to finalize a loop exception range"); } /* * Do the jump fixups. Note that these are always issued as INST_JUMP4 so * there is no need to fuss around with updating code offsets. */ for (i=0 ; inumBreakTargets ; i++) { site = envPtr->codeStart + auxPtr->breakTargets[i]; offset = rangePtr->breakOffset - auxPtr->breakTargets[i]; TclUpdateInstInt4AtPc(INST_JUMP4, offset, site); } for (i=0 ; inumContinueTargets ; i++) { site = envPtr->codeStart + auxPtr->continueTargets[i]; if (rangePtr->continueOffset == -1) { int j; /* * WTF? Can't bind, so revert to an INST_CONTINUE. Not enough * space to do anything else. */ *site = INST_CONTINUE; for (j=0 ; j<4 ; j++) { *++site = INST_NOP; } } else { offset = rangePtr->continueOffset - auxPtr->continueTargets[i]; TclUpdateInstInt4AtPc(INST_JUMP4, offset, site); } } /* * Drop the arrays we were holding the only reference to. */ if (auxPtr->breakTargets) { ckfree(auxPtr->breakTargets); auxPtr->breakTargets = NULL; auxPtr->numBreakTargets = 0; } if (auxPtr->continueTargets) { ckfree(auxPtr->continueTargets); auxPtr->continueTargets = NULL; auxPtr->numContinueTargets = 0; } } /* *---------------------------------------------------------------------- * * TclCreateAuxData -- * * Procedure that allocates and initializes a new AuxData structure in a * CompileEnv's array of compilation auxiliary data records. These * AuxData records hold information created during compilation by * CompileProcs and used by instructions during execution. * * Results: * Returns the index for the newly created AuxData structure. * * Side effects: * If there is not enough room in the CompileEnv's AuxData array, the * AuxData array in expanded: a new array of double the size is * allocated, if envPtr->mallocedAuxDataArray is non-zero the old array * is freed, and AuxData entries are copied from the old array to the new * one. * *---------------------------------------------------------------------- */ int TclCreateAuxData( ClientData clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { int index; /* Index for the new AuxData structure. */ AuxData *auxDataPtr; /* Points to the new AuxData structure */ index = envPtr->auxDataArrayNext; if (index >= envPtr->auxDataArrayEnd) { /* * Expand the AuxData array. The currently allocated entries are * stored between elements 0 and (envPtr->auxDataArrayNext - 1) * [inclusive]. */ size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData); int newElems = 2*envPtr->auxDataArrayEnd; size_t newBytes = newElems * sizeof(AuxData); if (envPtr->mallocedAuxDataArray) { envPtr->auxDataArrayPtr = (AuxData *)ckrealloc(envPtr->auxDataArrayPtr, newBytes); } else { /* * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must * code a ckrealloc equivalent for ourselves. */ AuxData *newPtr = (AuxData *)ckalloc(newBytes); memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes); envPtr->auxDataArrayPtr = newPtr; envPtr->mallocedAuxDataArray = 1; } envPtr->auxDataArrayEnd = newElems; } envPtr->auxDataArrayNext++; auxDataPtr = &envPtr->auxDataArrayPtr[index]; auxDataPtr->clientData = clientData; auxDataPtr->type = typePtr; return index; } /* *---------------------------------------------------------------------- * * TclInitJumpFixupArray -- * * Initializes a JumpFixupArray structure to hold some number of jump * fixup entries. * * Results: * None. * * Side effects: * The JumpFixupArray structure is initialized. * *---------------------------------------------------------------------- */ void TclInitJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * initialize. */ { fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace; fixupArrayPtr->next = 0; fixupArrayPtr->end = JUMPFIXUP_INIT_ENTRIES - 1; fixupArrayPtr->mallocedArray = 0; } /* *---------------------------------------------------------------------- * * TclExpandJumpFixupArray -- * * Procedure that uses malloc to allocate more storage for a jump fixup * array. * * Results: * None. * * Side effects: * The jump fixup array in *fixupArrayPtr is reallocated to a new array * of double the size, and if fixupArrayPtr->mallocedArray is non-zero * the old array is freed. Jump fixup structures are copied from the old * array to the new one. * *---------------------------------------------------------------------- */ void TclExpandJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * enlarge. */ { /* * The currently allocated jump fixup entries are stored from fixup[0] up * to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd. */ size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup); int newElems = 2*(fixupArrayPtr->end + 1); size_t newBytes = newElems * sizeof(JumpFixup); if (fixupArrayPtr->mallocedArray) { fixupArrayPtr->fixup = (JumpFixup *)ckrealloc(fixupArrayPtr->fixup, newBytes); } else { /* * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a * ckrealloc equivalent for ourselves. */ JumpFixup *newPtr = (JumpFixup *)ckalloc(newBytes); memcpy(newPtr, fixupArrayPtr->fixup, currBytes); fixupArrayPtr->fixup = newPtr; fixupArrayPtr->mallocedArray = 1; } fixupArrayPtr->end = newElems; } /* *---------------------------------------------------------------------- * * TclFreeJumpFixupArray -- * * Free any storage allocated in a jump fixup array structure. * * Results: * None. * * Side effects: * Allocated storage in the JumpFixupArray structure is freed. * *---------------------------------------------------------------------- */ void TclFreeJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * free. */ { if (fixupArrayPtr->mallocedArray) { ckfree(fixupArrayPtr->fixup); } } /* *---------------------------------------------------------------------- * * TclEmitForwardJump -- * * Procedure to emit a two-byte forward jump of kind "jumpType". Since * the jump may later have to be grown to five bytes if the jump target * is more than, say, 127 bytes away, this procedure also initializes a * JumpFixup record with information about the jump. * * Results: * None. * * Side effects: * The JumpFixup record pointed to by "jumpFixupPtr" is initialized with * information needed later if the jump is to be grown. Also, a two byte * jump of the designated type is emitted at the current point in the * bytecode stream. * *---------------------------------------------------------------------- */ void TclEmitForwardJump( CompileEnv *envPtr, /* Points to the CompileEnv structure that * holds the resulting instruction. */ TclJumpType jumpType, /* Indicates the kind of jump: if true or * false or unconditional. */ JumpFixup *jumpFixupPtr) /* Points to the JumpFixup structure to * initialize with information about this * forward jump. */ { /* * Initialize the JumpFixup structure: * - codeOffset is offset of first byte of jump below * - cmdIndex is index of the command after the current one * - exceptIndex is the index of the first ExceptionRange after the * current one. */ jumpFixupPtr->jumpType = jumpType; jumpFixupPtr->codeOffset = envPtr->codeNext - envPtr->codeStart; jumpFixupPtr->cmdIndex = envPtr->numCommands; jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext; switch (jumpType) { case TCL_UNCONDITIONAL_JUMP: TclEmitInstInt1(INST_JUMP1, 0, envPtr); break; case TCL_TRUE_JUMP: TclEmitInstInt1(INST_JUMP_TRUE1, 0, envPtr); break; default: TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); break; } } /* *---------------------------------------------------------------------- * * TclFixupForwardJump -- * * Procedure that updates a previously-emitted forward jump to jump a * specified number of bytes, "jumpDist". If necessary, the jump is grown * from two to five bytes; this is done if the jump distance is greater * than "distThreshold" (normally 127 bytes). The jump is described by a * JumpFixup record previously initialized by TclEmitForwardJump. * * Results: * 1 if the jump was grown and subsequent instructions had to be moved; * otherwise 0. This result is returned to allow callers to update any * additional code offsets they may hold. * * Side effects: * The jump may be grown and subsequent instructions moved. If this * happens, the code offsets for any commands and any ExceptionRange * records between the jump and the current code address will be updated * to reflect the moved code. Also, the bytecode instruction array in the * CompileEnv structure may be grown and reallocated. * *---------------------------------------------------------------------- */ int TclFixupForwardJump( CompileEnv *envPtr, /* Points to the CompileEnv structure that * holds the resulting instruction. */ JumpFixup *jumpFixupPtr, /* Points to the JumpFixup structure that * describes the forward jump. */ int jumpDist, /* Jump distance to set in jump instr. */ int distThreshold) /* Maximum distance before the two byte jump * is grown to five bytes. */ { unsigned char *jumpPc, *p; int firstCmd, lastCmd, firstRange, lastRange, k; unsigned numBytes; if (jumpDist <= distThreshold) { jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; switch (jumpFixupPtr->jumpType) { case TCL_UNCONDITIONAL_JUMP: TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc); break; case TCL_TRUE_JUMP: TclUpdateInstInt1AtPc(INST_JUMP_TRUE1, jumpDist, jumpPc); break; default: TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc); break; } return 0; } /* * We must grow the jump then move subsequent instructions down. Note that * if we expand the space for generated instructions, code addresses might * change; be careful about updating any of these addresses held in * variables. */ if ((envPtr->codeNext + 3) > envPtr->codeEnd) { TclExpandCodeArray(envPtr); } jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; numBytes = envPtr->codeNext-jumpPc-2; p = jumpPc+2; memmove(p+3, p, numBytes); envPtr->codeNext += 3; jumpDist += 3; switch (jumpFixupPtr->jumpType) { case TCL_UNCONDITIONAL_JUMP: TclUpdateInstInt4AtPc(INST_JUMP4, jumpDist, jumpPc); break; case TCL_TRUE_JUMP: TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDist, jumpPc); break; default: TclUpdateInstInt4AtPc(INST_JUMP_FALSE4, jumpDist, jumpPc); break; } /* * Adjust the code offsets for any commands and any ExceptionRange records * between the jump and the current code address. */ firstCmd = jumpFixupPtr->cmdIndex; lastCmd = envPtr->numCommands - 1; if (firstCmd < lastCmd) { for (k = firstCmd; k <= lastCmd; k++) { envPtr->cmdMapPtr[k].codeOffset += 3; } } firstRange = jumpFixupPtr->exceptIndex; lastRange = envPtr->exceptArrayNext - 1; for (k = firstRange; k <= lastRange; k++) { ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[k]; rangePtr->codeOffset += 3; switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: rangePtr->breakOffset += 3; if (rangePtr->continueOffset != -1) { rangePtr->continueOffset += 3; } break; case CATCH_EXCEPTION_RANGE: rangePtr->catchOffset += 3; break; default: Tcl_Panic("TclFixupForwardJump: bad ExceptionRange type %d", rangePtr->type); } } for (k = 0 ; k < envPtr->exceptArrayNext ; k++) { ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[k]; int i; for (i=0 ; inumBreakTargets ; i++) { if (jumpFixupPtr->codeOffset < auxPtr->breakTargets[i]) { auxPtr->breakTargets[i] += 3; } } for (i=0 ; inumContinueTargets ; i++) { if (jumpFixupPtr->codeOffset < auxPtr->continueTargets[i]) { auxPtr->continueTargets[i] += 3; } } } return 1; /* the jump was grown */ } /* *---------------------------------------------------------------------- * * TclEmitInvoke -- * * Emit one of the invoke-related instructions, wrapping it if necessary * in code that ensures that any break or continue operation passing * through it gets the stack unwinding correct, converting it into an * internal jump if in an appropriate context. * * Results: * None * * Side effects: * Issues the jump with all correct stack management. May create another * loop exception range; pointers to ExceptionRange and ExceptionAux * structures should not be held across this call. * *---------------------------------------------------------------------- */ void TclEmitInvoke( CompileEnv *envPtr, int opcode, ...) { va_list argList; ExceptionRange *rangePtr; ExceptionAux *auxBreakPtr, *auxContinuePtr; int arg1, arg2, wordCount = 0, expandCount = 0; int loopRange = 0, breakRange = 0, continueRange = 0; int cleanup, depth = TclGetStackDepth(envPtr); /* * Parse the arguments. */ va_start(argList, opcode); switch (opcode) { case INST_INVOKE_STK1: wordCount = arg1 = cleanup = va_arg(argList, int); arg2 = 0; break; case INST_INVOKE_STK4: wordCount = arg1 = cleanup = va_arg(argList, int); arg2 = 0; break; case INST_INVOKE_REPLACE: arg1 = va_arg(argList, int); arg2 = va_arg(argList, int); wordCount = arg1 + arg2 - 1; cleanup = arg1 + 1; break; default: Tcl_Panic("unexpected opcode"); case INST_EVAL_STK: wordCount = cleanup = 1; arg1 = arg2 = 0; break; case INST_RETURN_STK: wordCount = cleanup = 2; arg1 = arg2 = 0; break; case INST_INVOKE_EXPANDED: wordCount = arg1 = cleanup = va_arg(argList, int); arg2 = 0; expandCount = 1; break; } va_end(argList); /* * Determine if we need to handle break and continue exceptions with a * special handling exception range (so that we can correctly unwind the * stack). * * These must be done separately; they can be different (especially for * calls from inside a [for] increment clause). */ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxContinuePtr); if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { auxContinuePtr = NULL; } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) { auxContinuePtr = NULL; } else { continueRange = auxContinuePtr - envPtr->exceptAuxArrayPtr; } rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr); if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { auxBreakPtr = NULL; } else if (auxContinuePtr == NULL && auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) { auxBreakPtr = NULL; } else { breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; } if (auxBreakPtr != NULL || auxContinuePtr != NULL) { loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); ExceptionRangeStarts(envPtr, loopRange); } /* * Issue the invoke itself. */ switch (opcode) { case INST_INVOKE_STK1: TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr); break; case INST_INVOKE_STK4: TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr); break; case INST_INVOKE_EXPANDED: TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); envPtr->expandCount--; TclAdjustStackDepth(1 - arg1, envPtr); break; case INST_EVAL_STK: TclEmitOpcode(INST_EVAL_STK, envPtr); break; case INST_RETURN_STK: TclEmitOpcode(INST_RETURN_STK, envPtr); break; case INST_INVOKE_REPLACE: TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr); TclEmitInt1(arg2, envPtr); TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */ break; } /* * If we're generating a special wrapper exception range, we need to * finish that up now. */ if (auxBreakPtr != NULL || auxContinuePtr != NULL) { int savedStackDepth = envPtr->currStackDepth; int savedExpandCount = envPtr->expandCount; JumpFixup nonTrapFixup; if (auxBreakPtr != NULL) { auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange; } if (auxContinuePtr != NULL) { auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange; } ExceptionRangeEnds(envPtr, loopRange); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup); /* * Careful! When generating these stack unwinding sequences, the depth * of stack in the cases where they are taken is not the same as if * the exception is not taken. */ if (auxBreakPtr != NULL) { TclAdjustStackDepth(-1, envPtr); ExceptionRangeTarget(envPtr, loopRange, breakOffset); TclCleanupStackForBreakContinue(envPtr, auxBreakPtr); TclAddLoopBreakFixup(envPtr, auxBreakPtr); TclAdjustStackDepth(1, envPtr); envPtr->currStackDepth = savedStackDepth; envPtr->expandCount = savedExpandCount; } if (auxContinuePtr != NULL) { TclAdjustStackDepth(-1, envPtr); ExceptionRangeTarget(envPtr, loopRange, continueOffset); TclCleanupStackForBreakContinue(envPtr, auxContinuePtr); TclAddLoopContinueFixup(envPtr, auxContinuePtr); TclAdjustStackDepth(1, envPtr); envPtr->currStackDepth = savedStackDepth; envPtr->expandCount = savedExpandCount; } TclFinalizeLoopExceptionRange(envPtr, loopRange); TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127); } TclCheckStackDepth(depth+1-cleanup, envPtr); } /* *---------------------------------------------------------------------- * * TclGetInstructionTable -- * * Returns a pointer to the table describing Tcl bytecode instructions. * This procedure is defined so that clients can access the pointer from * outside the TCL DLLs. * * Results: * Returns a pointer to the global instruction table, same as the * expression (&tclInstructionTable[0]). * * Side effects: * None. * *---------------------------------------------------------------------- */ const void * /* == InstructionDesc* == */ TclGetInstructionTable(void) { return &tclInstructionTable[0]; } /* *---------------------------------------------------------------------- * * GetCmdLocEncodingSize -- * * Computes the total number of bytes needed to encode the command * location information for some compiled code. * * Results: * The byte count needed to encode the compiled location information. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetCmdLocEncodingSize( CompileEnv *envPtr) /* Points to compilation environment structure * containing the CmdLocation structure to * encode. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; int codeDelta, codeLen, srcDelta, srcLen; int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext; /* The offsets in their respective byte * sequences where the next encoded offset or * length should go. */ int prevCodeOffset, prevSrcOffset, i; codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0; prevCodeOffset = prevSrcOffset = 0; for (i = 0; i < numCmds; i++) { codeDelta = mapPtr[i].codeOffset - prevCodeOffset; if (codeDelta < 0) { Tcl_Panic("GetCmdLocEncodingSize: bad code offset"); } else if (codeDelta <= 127) { codeDeltaNext++; } else { codeDeltaNext += 5; /* 1 byte for 0xFF, 4 for positive delta */ } prevCodeOffset = mapPtr[i].codeOffset; codeLen = mapPtr[i].numCodeBytes; if (codeLen < 0) { Tcl_Panic("GetCmdLocEncodingSize: bad code length"); } else if (codeLen <= 127) { codeLengthNext++; } else { codeLengthNext += 5;/* 1 byte for 0xFF, 4 for length */ } srcDelta = mapPtr[i].srcOffset - prevSrcOffset; if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) { srcDeltaNext++; } else { srcDeltaNext += 5; /* 1 byte for 0xFF, 4 for delta */ } prevSrcOffset = mapPtr[i].srcOffset; srcLen = mapPtr[i].numSrcBytes; if (srcLen < 0) { Tcl_Panic("GetCmdLocEncodingSize: bad source length"); } else if (srcLen <= 127) { srcLengthNext++; } else { srcLengthNext += 5; /* 1 byte for 0xFF, 4 for length */ } } return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext); } /* *---------------------------------------------------------------------- * * EncodeCmdLocMap -- * * Encode the command location information for some compiled code into a * ByteCode structure. The encoded command location map is stored as * three adjacent byte sequences. * * Results: * Pointer to the first byte after the encoded command location * information. * * Side effects: * The encoded information is stored into the block of memory headed by * codePtr. Also records pointers to the start of the four byte sequences * in fields in codePtr's ByteCode header structure. * *---------------------------------------------------------------------- */ static unsigned char * EncodeCmdLocMap( CompileEnv *envPtr, /* Points to compilation environment structure * containing the CmdLocation structure to * encode. */ ByteCode *codePtr, /* ByteCode in which to encode envPtr's * command location information. */ unsigned char *startPtr) /* Points to the first byte in codePtr's * memory block where the location information * is to be stored. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; unsigned char *p = startPtr; int codeDelta, codeLen, srcDelta, srcLen, prevOffset; int i; /* * Encode the code offset for each command as a sequence of deltas. */ codePtr->codeDeltaStart = p; prevOffset = 0; for (i = 0; i < numCmds; i++) { codeDelta = mapPtr[i].codeOffset - prevOffset; if (codeDelta < 0) { Tcl_Panic("EncodeCmdLocMap: bad code offset"); } else if (codeDelta <= 127) { TclStoreInt1AtPtr(codeDelta, p); p++; } else { TclStoreInt1AtPtr(0xFF, p); p++; TclStoreInt4AtPtr(codeDelta, p); p += 4; } prevOffset = mapPtr[i].codeOffset; } /* * Encode the code length for each command. */ codePtr->codeLengthStart = p; for (i = 0; i < numCmds; i++) { codeLen = mapPtr[i].numCodeBytes; if (codeLen < 0) { Tcl_Panic("EncodeCmdLocMap: bad code length"); } else if (codeLen <= 127) { TclStoreInt1AtPtr(codeLen, p); p++; } else { TclStoreInt1AtPtr(0xFF, p); p++; TclStoreInt4AtPtr(codeLen, p); p += 4; } } /* * Encode the source offset for each command as a sequence of deltas. */ codePtr->srcDeltaStart = p; prevOffset = 0; for (i = 0; i < numCmds; i++) { srcDelta = mapPtr[i].srcOffset - prevOffset; if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) { TclStoreInt1AtPtr(srcDelta, p); p++; } else { TclStoreInt1AtPtr(0xFF, p); p++; TclStoreInt4AtPtr(srcDelta, p); p += 4; } prevOffset = mapPtr[i].srcOffset; } /* * Encode the source length for each command. */ codePtr->srcLengthStart = p; for (i = 0; i < numCmds; i++) { srcLen = mapPtr[i].numSrcBytes; if (srcLen < 0) { Tcl_Panic("EncodeCmdLocMap: bad source length"); } else if (srcLen <= 127) { TclStoreInt1AtPtr(srcLen, p); p++; } else { TclStoreInt1AtPtr(0xFF, p); p++; TclStoreInt4AtPtr(srcLen, p); p += 4; } } return p; } #ifdef TCL_COMPILE_STATS /* *---------------------------------------------------------------------- * * RecordByteCodeStats -- * * Accumulates various compilation-related statistics for each newly * compiled ByteCode. Called by the TclInitByteCodeObj when Tcl is * compiled with the -DTCL_COMPILE_STATS flag * * Results: * None. * * Side effects: * Accumulates aggregate code-related statistics in the interpreter's * ByteCodeStats structure. Records statistics specific to a ByteCode in * its ByteCode structure. * *---------------------------------------------------------------------- */ void RecordByteCodeStats( ByteCode *codePtr) /* Points to ByteCode structure with info * to add to accumulated statistics. */ { Interp *iPtr = (Interp *) *codePtr->interpHandle; ByteCodeStats *statsPtr; if (iPtr == NULL) { /* Avoid segfaulting in case we're called in a deleted interp */ return; } statsPtr = &(iPtr->stats); statsPtr->numCompilations++; statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes; statsPtr->totalByteCodeBytes += (double) codePtr->structureSize; statsPtr->currentSrcBytes += (double) codePtr->numSrcBytes; statsPtr->currentByteCodeBytes += (double) codePtr->structureSize; statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++; statsPtr->byteCodeCount[TclLog2((int) codePtr->structureSize)]++; statsPtr->currentInstBytes += (double) codePtr->numCodeBytes; statsPtr->currentLitBytes += (double) codePtr->numLitObjects * sizeof(Tcl_Obj *); statsPtr->currentExceptBytes += (double) codePtr->numExceptRanges * sizeof(ExceptionRange); statsPtr->currentAuxBytes += (double) codePtr->numAuxDataItems * sizeof(AuxData); statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes; } #endif /* TCL_COMPILE_STATS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ tcl8.6.14/generic/tclCompile.h0000644000175000017500000021222514554262142015526 0ustar sergeisergei/* * tclCompile.h -- * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2007 Daniel A. Steffen * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLCOMPILATION #define _TCLCOMPILATION 1 #include "tclInt.h" struct ByteCode; /* Forward declaration. */ /* *------------------------------------------------------------------------ * Variables related to compilation. These are used in tclCompile.c, * tclExecute.c, tclBasic.c, and their clients. *------------------------------------------------------------------------ */ #ifdef TCL_COMPILE_DEBUG /* * Variable that controls whether compilation tracing is enabled and, if so, * what level of tracing is desired: * 0: no compilation tracing * 1: summarize compilation of top level cmds and proc bodies * 2: display all instructions of each ByteCode compiled * This variable is linked to the Tcl variable "tcl_traceCompile". */ MODULE_SCOPE int tclTraceCompile; /* * Variable that controls whether execution tracing is enabled and, if so, * what level of tracing is desired: * 0: no execution tracing * 1: trace invocations of Tcl procs only * 2: trace invocations of all (not compiled away) commands * 3: display each instruction executed * This variable is linked to the Tcl variable "tcl_traceExec". */ MODULE_SCOPE int tclTraceExec; #endif /* * The type of lambda expressions. Note that every lambda will *always* have a * string representation. */ MODULE_SCOPE const Tcl_ObjType tclLambdaType; /* *------------------------------------------------------------------------ * Data structures related to compilation. *------------------------------------------------------------------------ */ /* * The structure used to implement Tcl "exceptions" (exceptional returns): for * example, those generated in loops by the break and continue commands, and * those generated by scripts and caught by the catch command. This * ExceptionRange structure describes a range of code (e.g., a loop body), the * kind of exceptions (e.g., a break or continue) that might occur, and the PC * offsets to jump to if a matching exception does occur. Exception ranges can * nest so this structure includes a nesting level that is used at runtime to * find the closest exception range surrounding a PC. For example, when a * break command is executed, the ExceptionRange structure for the most deeply * nested loop, if any, is found and used. These structures are also generated * for the "next" subcommands of for loops since a break there terminates the * for command. This means a for command actually generates two LoopInfo * structures. */ typedef enum { LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. Break * and continue "exceptions" cause jumps to * appropriate PC offsets. */ CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch * command. Errors in the range cause a jump * to a catch PC offset. */ } ExceptionRangeType; typedef struct ExceptionRange { ExceptionRangeType type; /* The kind of ExceptionRange. */ int nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range * surrounding a PC at runtime. */ int codeOffset; /* Offset of the first instruction byte of the * code range. */ int numCodeBytes; /* Number of bytes in the code range. */ int breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC * offset for a break command in the range. */ int continueOffset; /* If LOOP_EXCEPTION_RANGE and not -1, the * target PC offset for a continue command in * the code range. Otherwise, ignore this * range when processing a continue * command. */ int catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC * offset for any "exception" in range. */ } ExceptionRange; /* * Auxiliary data used when issuing (currently just loop) exception ranges, * but which is not required during execution. */ typedef struct ExceptionAux { int supportsContinue; /* Whether this exception range will have a * continueOffset created for it; if it is a * loop exception range that *doesn't* have * one (see [for] next-clause) then we must * not pick up the range when scanning for a * target to continue to. */ int stackDepth; /* The stack depth at the point where the * exception range was created. This is used * to calculate the number of POPs required to * restore the stack to its prior state. */ int expandTarget; /* The number of expansions expected on the * auxData stack at the time the loop starts; * we can't currently discard them except by * doing INST_INVOKE_EXPANDED; this is a known * problem. */ int expandTargetDepth; /* The stack depth expected at the outermost * expansion within the loop. Not meaningful * if there are no open expansions between the * looping level and the point of jump * issue. */ int numBreakTargets; /* The number of [break]s that want to be * targeted to the place where this loop * exception will be bound to. */ unsigned int *breakTargets; /* The offsets of the INST_JUMP4 instructions * issued by the [break]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numBreakTargets==0, this is NULL. */ int allocBreakTargets; /* The size of the breakTargets array. */ int numContinueTargets; /* The number of [continue]s that want to be * targeted to the place where this loop * exception will be bound to. */ unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions * issued by the [continue]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numContinueTargets==0, this is NULL. */ int allocContinueTargets; /* The size of the continueTargets array. */ } ExceptionAux; /* * Structure used to map between instruction pc and source locations. It * defines for each compiled Tcl command its code's starting offset and its * source's starting offset and length. Note that the code offset increases * monotonically: that is, the table is sorted in code offset order. The * source offset is not monotonic. */ typedef struct CmdLocation { int codeOffset; /* Offset of first byte of command code. */ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ int numSrcBytes; /* Number of command source chars. */ } CmdLocation; /* * TIP #280 * Structure to record additional location information for byte code. This * information is internal and not saved. i.e. tbcload'ed code will not have * this information. It records the lines for all words of all commands found * in the byte code. The association with a ByteCode structure BC is done * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC. * Also recorded is information coming from the context, i.e. type of the * frame and associated information, like the path of a sourced file. */ typedef struct ECL { int srcOffset; /* Command location to find the entry. */ int nline; /* Number of words in the command */ int *line; /* Line information for all words in the * command. */ int **next; /* Transient information used by the compiler * for tracking of hidden continuation * lines. */ } ECL; typedef struct ExtCmdLoc { int type; /* Context type. */ int start; /* Starting line for compiled script. Needed * for the extended recompile check in * tclCompileObj. */ Tcl_Obj *path; /* Path of the sourced file the command is * in. */ ECL *loc; /* Command word locations (lines). */ int nloc; /* Number of allocated entries in 'loc'. */ int nuloc; /* Number of used entries in 'loc'. */ } ExtCmdLoc; /* * CompileProcs need the ability to record information during compilation that * can be used by bytecode instructions during execution. The AuxData * structure provides this "auxiliary data" mechanism. An arbitrary number of * these structures can be stored in the ByteCode record (during compilation * they are stored in a CompileEnv structure). Each AuxData record holds one * word of client-specified data (often a pointer) and is given an index that * instructions can later use to look up the structure and its data. * * The following definitions declare the types of procedures that are called * to duplicate or free this auxiliary data when the containing ByteCode * objects are duplicated and freed. Pointers to these procedures are kept in * the AuxData structure. */ typedef ClientData (AuxDataDupProc) (ClientData clientData); typedef void (AuxDataFreeProc) (ClientData clientData); typedef void (AuxDataPrintProc)(ClientData clientData, Tcl_Obj *appendObj, struct ByteCode *codePtr, unsigned int pcOffset); /* * We define a separate AuxDataType struct to hold type-related information * for the AuxData structure. This separation makes it possible for clients * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for * example, it makes it possible to pickle and unpickle AuxData structs. */ typedef struct AuxDataType { const char *name; /* The name of the type. Types can be * registered and found by name */ AuxDataDupProc *dupProc; /* Callback procedure to invoke when the aux * data is duplicated (e.g., when the ByteCode * structure containing the aux data is * duplicated). NULL means just copy the * source clientData bits; no proc need be * called. */ AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the aux * data is freed. NULL means no proc need be * called. */ AuxDataPrintProc *printProc;/* Callback function to invoke when printing * the aux data as part of debugging. NULL * means that the data can't be printed. */ AuxDataPrintProc *disassembleProc; /* Callback function to invoke when doing a * disassembly of the aux data (like the * printProc, except that the output is * intended to be script-readable). The * appendObj argument should be filled in with * a descriptive dictionary; it will start out * with "name" mapped to the content of the * name field. NULL means that the printProc * should be used instead. */ } AuxDataType; /* * The definition of the AuxData structure that holds information created * during compilation by CompileProcs and used by instructions during * execution. */ typedef struct AuxData { const AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ ClientData clientData; /* The compilation data itself. */ } AuxData; /* * Structure defining the compilation environment. After compilation, fields * describing bytecode instructions are copied out into the more compact * ByteCode structure defined below. */ #define COMPILEENV_INIT_CODE_BYTES 250 #define COMPILEENV_INIT_NUM_OBJECTS 60 #define COMPILEENV_INIT_EXCEPT_RANGES 5 #define COMPILEENV_INIT_CMD_MAP_SIZE 40 #define COMPILEENV_INIT_AUX_DATA_SIZE 5 typedef struct CompileEnv { Interp *iPtr; /* Interpreter containing the code being * compiled. Commands and their compile procs * are specific to an interpreter so the code * emitted will depend on the interpreter. */ const char *source; /* The source string being compiled by * SetByteCodeFromAny. This pointer is not * owned by the CompileEnv and must not be * freed or changed by it. */ int numSrcBytes; /* Number of bytes in source. */ Proc *procPtr; /* If a procedure is being compiled, a pointer * to its Proc structure; otherwise NULL. Used * to compile local variables. Set from * information provided by ObjInterpProc in * tclProc.c. */ int numCommands; /* Number of commands compiled. */ int exceptDepth; /* Current exception range nesting level; -1 * if not in any range currently. */ int maxExceptDepth; /* Max nesting level of exception ranges; -1 * if no ranges have been compiled. */ int maxStackDepth; /* Maximum number of stack elements needed to * execute the code. Set by compilation * procedures before returning. */ int currStackDepth; /* Current stack depth. */ LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl * objects referenced by this compiled code. * Indexed by the string representations of * the literals. Used to avoid creating * duplicate objects. */ unsigned char *codeStart; /* Points to the first byte of the code. */ unsigned char *codeNext; /* Points to next code array byte to use. */ unsigned char *codeEnd; /* Points just after the last allocated code * array byte. */ int mallocedCodeArray; /* Set 1 if code array was expanded and * codeStart points into the heap.*/ LiteralEntry *literalArrayPtr; /* Points to start of LiteralEntry array. */ int literalArrayNext; /* Index of next free object array entry. */ int literalArrayEnd; /* Index just after last obj array entry. */ int mallocedLiteralArray; /* 1 if object array was expanded and objArray * points into the heap, else 0. */ ExceptionRange *exceptArrayPtr; /* Points to start of the ExceptionRange * array. */ int exceptArrayNext; /* Next free ExceptionRange array index. * exceptArrayNext is the number of ranges and * (exceptArrayNext-1) is the index of the * current range's array entry. */ int exceptArrayEnd; /* Index after the last ExceptionRange array * entry. */ int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and * exceptArrayPtr points in heap, else 0. */ ExceptionAux *exceptAuxArrayPtr; /* Array of information used to restore the * state when processing BREAK/CONTINUE * exceptions. Must be the same size as the * exceptArrayPtr. */ CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array. * numCommands is the index of the next entry * to use; (numCommands-1) is the entry index * for the last command. */ int cmdMapEnd; /* Index after last CmdLocation entry. */ int mallocedCmdMap; /* 1 if command map array was expanded and * cmdMapPtr points in the heap, else 0. */ AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */ int auxDataArrayNext; /* Next free compile aux data array index. * auxDataArrayNext is the number of aux data * items and (auxDataArrayNext-1) is index of * current aux data array entry. */ int auxDataArrayEnd; /* Index after last aux data array entry. */ int mallocedAuxDataArray; /* 1 if aux data array was expanded and * auxDataArrayPtr points in heap else 0. */ unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES]; /* Initial storage for code. */ LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS]; /* Initial storage of LiteralEntry array. */ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; /* Initial ExceptionRange array storage. */ ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; /* Initial static except auxiliary info array * storage. */ CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE]; /* Initial storage for cmd location map. */ AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; /* Initial storage for aux data array. */ /* TIP #280 */ ExtCmdLoc *extCmdMapPtr; /* Extended command location information for * 'info frame'. */ int line; /* First line of the script, based on the * invoking context, then the line of the * command currently compiled. */ int atCmdStart; /* Flag to say whether an INST_START_CMD * should be issued; they should never be * issued repeatedly, as that is significantly * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ int expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ int *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ } CompileEnv; /* * The structure defining the bytecode instructions resulting from compiling a * Tcl script. Note that this structure is variable length: a single heap * object is allocated to hold the ByteCode structure immediately followed by * the code bytes, the literal object array, the ExceptionRange array, the * CmdLocation map, and the compilation AuxData array. */ /* * A PRECOMPILED bytecode struct is one that was generated from a compiled * image rather than implicitly compiled from source */ #define TCL_BYTECODE_PRECOMPILED 0x0001 /* * When a bytecode is compiled, interp or namespace resolvers have not been * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag. */ #define TCL_BYTECODE_RESOLVE_VARS 0x0002 #define TCL_BYTECODE_RECOMPILE 0x0004 typedef struct ByteCode { TclHandle interpHandle; /* Handle for interpreter containing the * compiled code. Commands and their compile * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ int compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ Namespace *nsPtr; /* Namespace context in which this code was * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ int nsEpoch; /* Value of nsPtr->resolverEpoch when this * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ int refCount; /* Reference count: set 1 when created plus 1 * for each execution of the code currently * active. This structure can be freed when * refCount becomes zero. */ unsigned int flags; /* flags describing state for the codebyte. * this variable holds OR'ed values from the * TCL_BYTECODE_ masks defined above */ const char *source; /* The source string from which this ByteCode * was compiled. Note that this pointer is not * owned by the ByteCode and must not be freed * or modified by it. */ Proc *procPtr; /* If the ByteCode was compiled from a * procedure body, this is a pointer to its * Proc structure; otherwise NULL. This * pointer is also not owned by the ByteCode * and must not be freed by it. */ size_t structureSize; /* Number of bytes in the ByteCode structure * itself. Does not include heap space for * literal Tcl objects or storage referenced * by AuxData entries. */ int numCommands; /* Number of commands compiled. */ int numSrcBytes; /* Number of source bytes compiled. */ int numCodeBytes; /* Number of code bytes. */ int numLitObjects; /* Number of objects in literal array. */ int numExceptRanges; /* Number of ExceptionRange array elems. */ int numAuxDataItems; /* Number of AuxData items. */ int numCmdLocBytes; /* Number of bytes needed for encoded command * location information. */ int maxExceptDepth; /* Maximum nesting level of ExceptionRanges; * -1 if no ranges were compiled. */ int maxStackDepth; /* Maximum number of stack elements needed to * execute the code. */ unsigned char *codeStart; /* Points to the first byte of the code. This * is just after the final ByteCode member * cmdMapPtr. */ Tcl_Obj **objArrayPtr; /* Points to the start of the literal object * array. This is just after the last code * byte. */ ExceptionRange *exceptArrayPtr; /* Points to the start of the ExceptionRange * array. This is just after the last object * in the object array. */ AuxData *auxDataArrayPtr; /* Points to the start of the auxiliary data * array. This is just after the last entry in * the ExceptionRange array. */ unsigned char *codeDeltaStart; /* Points to the first of a sequence of bytes * that encode the change in the starting * offset of each command's code. If -127 <= * delta <= 127, it is encoded as 1 byte, * otherwise 0xFF (128) appears and the delta * is encoded by the next 4 bytes. Code deltas * are always positive. This sequence is just * after the last entry in the AuxData * array. */ unsigned char *codeLengthStart; /* Points to the first of a sequence of bytes * that encode the length of each command's * code. The encoding is the same as for code * deltas. Code lengths are always positive. * This sequence is just after the last entry * in the code delta sequence. */ unsigned char *srcDeltaStart; /* Points to the first of a sequence of bytes * that encode the change in the starting * offset of each command's source. The * encoding is the same as for code deltas. * Source deltas can be negative. This * sequence is just after the last byte in the * code length sequence. */ unsigned char *srcLengthStart; /* Points to the first of a sequence of bytes * that encode the length of each command's * source. The encoding is the same as for * code deltas. Source lengths are always * positive. This sequence is just after the * last byte in the source delta sequence. */ LocalCache *localCachePtr; /* Pointer to the start of the cached variable * names and initialisation data for local * variables. */ #ifdef TCL_COMPILE_STATS Tcl_Time createTime; /* Absolute time when the ByteCode was * created. */ #endif /* TCL_COMPILE_STATS */ } ByteCode; /* * Opcodes for the Tcl bytecode instructions. These must correspond to the * entries in the table of instruction descriptions, tclInstructionTable, in * tclCompile.c. Also, the order and number of the expression opcodes (e.g., * INST_LOR) must match the entries in the array operatorStrings in * tclExecute.c. */ /* Opcodes 0 to 9 */ #define INST_DONE 0 #define INST_PUSH1 1 #define INST_PUSH4 2 #define INST_POP 3 #define INST_DUP 4 #define INST_STR_CONCAT1 5 #define INST_INVOKE_STK1 6 #define INST_INVOKE_STK4 7 #define INST_EVAL_STK 8 #define INST_EXPR_STK 9 /* Opcodes 10 to 23 */ #define INST_LOAD_SCALAR1 10 #define INST_LOAD_SCALAR4 11 #define INST_LOAD_SCALAR_STK 12 #define INST_LOAD_ARRAY1 13 #define INST_LOAD_ARRAY4 14 #define INST_LOAD_ARRAY_STK 15 #define INST_LOAD_STK 16 #define INST_STORE_SCALAR1 17 #define INST_STORE_SCALAR4 18 #define INST_STORE_SCALAR_STK 19 #define INST_STORE_ARRAY1 20 #define INST_STORE_ARRAY4 21 #define INST_STORE_ARRAY_STK 22 #define INST_STORE_STK 23 /* Opcodes 24 to 33 */ #define INST_INCR_SCALAR1 24 #define INST_INCR_SCALAR_STK 25 #define INST_INCR_ARRAY1 26 #define INST_INCR_ARRAY_STK 27 #define INST_INCR_STK 28 #define INST_INCR_SCALAR1_IMM 29 #define INST_INCR_SCALAR_STK_IMM 30 #define INST_INCR_ARRAY1_IMM 31 #define INST_INCR_ARRAY_STK_IMM 32 #define INST_INCR_STK_IMM 33 /* Opcodes 34 to 39 */ #define INST_JUMP1 34 #define INST_JUMP4 35 #define INST_JUMP_TRUE1 36 #define INST_JUMP_TRUE4 37 #define INST_JUMP_FALSE1 38 #define INST_JUMP_FALSE4 39 /* Opcodes 40 to 64 */ #define INST_LOR 40 #define INST_LAND 41 #define INST_BITOR 42 #define INST_BITXOR 43 #define INST_BITAND 44 #define INST_EQ 45 #define INST_NEQ 46 #define INST_LT 47 #define INST_GT 48 #define INST_LE 49 #define INST_GE 50 #define INST_LSHIFT 51 #define INST_RSHIFT 52 #define INST_ADD 53 #define INST_SUB 54 #define INST_MULT 55 #define INST_DIV 56 #define INST_MOD 57 #define INST_UPLUS 58 #define INST_UMINUS 59 #define INST_BITNOT 60 #define INST_LNOT 61 #define INST_CALL_BUILTIN_FUNC1 62 #define INST_CALL_FUNC1 63 #define INST_TRY_CVT_TO_NUMERIC 64 /* Opcodes 65 to 66 */ #define INST_BREAK 65 #define INST_CONTINUE 66 /* Opcodes 67 to 68 */ #define INST_FOREACH_START4 67 /* DEPRECATED */ #define INST_FOREACH_STEP4 68 /* DEPRECATED */ /* Opcodes 69 to 72 */ #define INST_BEGIN_CATCH4 69 #define INST_END_CATCH 70 #define INST_PUSH_RESULT 71 #define INST_PUSH_RETURN_CODE 72 /* Opcodes 73 to 78 */ #define INST_STR_EQ 73 #define INST_STR_NEQ 74 #define INST_STR_CMP 75 #define INST_STR_LEN 76 #define INST_STR_INDEX 77 #define INST_STR_MATCH 78 /* Opcodes 78 to 81 */ #define INST_LIST 79 #define INST_LIST_INDEX 80 #define INST_LIST_LENGTH 81 /* Opcodes 82 to 87 */ #define INST_APPEND_SCALAR1 82 #define INST_APPEND_SCALAR4 83 #define INST_APPEND_ARRAY1 84 #define INST_APPEND_ARRAY4 85 #define INST_APPEND_ARRAY_STK 86 #define INST_APPEND_STK 87 /* Opcodes 88 to 93 */ #define INST_LAPPEND_SCALAR1 88 #define INST_LAPPEND_SCALAR4 89 #define INST_LAPPEND_ARRAY1 90 #define INST_LAPPEND_ARRAY4 91 #define INST_LAPPEND_ARRAY_STK 92 #define INST_LAPPEND_STK 93 /* TIP #22 - LINDEX operator with flat arg list */ #define INST_LIST_INDEX_MULTI 94 /* * TIP #33 - 'lset' command. Code gen also required a Forth-like * OVER operation. */ #define INST_OVER 95 #define INST_LSET_LIST 96 #define INST_LSET_FLAT 97 /* TIP#90 - 'return' command. */ #define INST_RETURN_IMM 98 /* TIP#123 - exponentiation operator. */ #define INST_EXPON 99 /* TIP #157 - {*}... (word expansion) language syntax support. */ #define INST_EXPAND_START 100 #define INST_EXPAND_STKTOP 101 #define INST_INVOKE_EXPANDED 102 /* * TIP #57 - 'lassign' command. Code generation requires immediate * LINDEX and LRANGE operators. */ #define INST_LIST_INDEX_IMM 103 #define INST_LIST_RANGE_IMM 104 #define INST_START_CMD 105 #define INST_LIST_IN 106 #define INST_LIST_NOT_IN 107 #define INST_PUSH_RETURN_OPTIONS 108 #define INST_RETURN_STK 109 /* * Dictionary (TIP#111) related commands. */ #define INST_DICT_GET 110 #define INST_DICT_SET 111 #define INST_DICT_UNSET 112 #define INST_DICT_INCR_IMM 113 #define INST_DICT_APPEND 114 #define INST_DICT_LAPPEND 115 #define INST_DICT_FIRST 116 #define INST_DICT_NEXT 117 #define INST_DICT_DONE 118 #define INST_DICT_UPDATE_START 119 #define INST_DICT_UPDATE_END 120 /* * Instruction to support jumps defined by tables (instead of the classic * [switch] technique of chained comparisons). */ #define INST_JUMP_TABLE 121 /* * Instructions to support compilation of global, variable, upvar and * [namespace upvar]. */ #define INST_UPVAR 122 #define INST_NSUPVAR 123 #define INST_VARIABLE 124 /* Instruction to support compiling syntax error to bytecode */ #define INST_SYNTAX 125 /* Instruction to reverse N items on top of stack */ #define INST_REVERSE 126 /* regexp instruction */ #define INST_REGEXP 127 /* For [info exists] compilation */ #define INST_EXIST_SCALAR 128 #define INST_EXIST_ARRAY 129 #define INST_EXIST_ARRAY_STK 130 #define INST_EXIST_STK 131 /* For [subst] compilation */ #define INST_NOP 132 #define INST_RETURN_CODE_BRANCH 133 /* For [unset] compilation */ #define INST_UNSET_SCALAR 134 #define INST_UNSET_ARRAY 135 #define INST_UNSET_ARRAY_STK 136 #define INST_UNSET_STK 137 /* For [dict with], [dict exists], [dict create] and [dict merge] */ #define INST_DICT_EXPAND 138 #define INST_DICT_RECOMBINE_STK 139 #define INST_DICT_RECOMBINE_IMM 140 #define INST_DICT_EXISTS 141 #define INST_DICT_VERIFY 142 /* For [string map] and [regsub] compilation */ #define INST_STR_MAP 143 #define INST_STR_FIND 144 #define INST_STR_FIND_LAST 145 #define INST_STR_RANGE_IMM 146 #define INST_STR_RANGE 147 /* For operations to do with coroutines and other NRE-manipulators */ #define INST_YIELD 148 #define INST_COROUTINE_NAME 149 #define INST_TAILCALL 150 /* For compilation of basic information operations */ #define INST_NS_CURRENT 151 #define INST_INFO_LEVEL_NUM 152 #define INST_INFO_LEVEL_ARGS 153 #define INST_RESOLVE_COMMAND 154 /* For compilation relating to TclOO */ #define INST_TCLOO_SELF 155 #define INST_TCLOO_CLASS 156 #define INST_TCLOO_NS 157 #define INST_TCLOO_IS_OBJECT 158 /* For compilation of [array] subcommands */ #define INST_ARRAY_EXISTS_STK 159 #define INST_ARRAY_EXISTS_IMM 160 #define INST_ARRAY_MAKE_STK 161 #define INST_ARRAY_MAKE_IMM 162 #define INST_INVOKE_REPLACE 163 #define INST_LIST_CONCAT 164 #define INST_EXPAND_DROP 165 /* New foreach implementation */ #define INST_FOREACH_START 166 #define INST_FOREACH_STEP 167 #define INST_FOREACH_END 168 #define INST_LMAP_COLLECT 169 /* For compilation of [string trim] and related */ #define INST_STR_TRIM 170 #define INST_STR_TRIM_LEFT 171 #define INST_STR_TRIM_RIGHT 172 #define INST_CONCAT_STK 173 #define INST_STR_UPPER 174 #define INST_STR_LOWER 175 #define INST_STR_TITLE 176 #define INST_STR_REPLACE 177 #define INST_ORIGIN_COMMAND 178 #define INST_TCLOO_NEXT 179 #define INST_TCLOO_NEXT_CLASS 180 #define INST_YIELD_TO_INVOKE 181 #define INST_NUM_TYPE 182 #define INST_TRY_CVT_TO_BOOLEAN 183 #define INST_STR_CLASS 184 #define INST_LAPPEND_LIST 185 #define INST_LAPPEND_LIST_ARRAY 186 #define INST_LAPPEND_LIST_ARRAY_STK 187 #define INST_LAPPEND_LIST_STK 188 #define INST_CLOCK_READ 189 /* The last opcode */ #define LAST_INST_OPCODE 189 /* * Table describing the Tcl bytecode instructions: their name (for displaying * code), total number of code bytes required (including operand bytes), and a * description of the type of each operand. These operand types include signed * and unsigned integers of length one and four bytes. The unsigned integers * are used for indexes or for, e.g., the count of objects to push in a "push" * instruction. */ #define MAX_INSTRUCTION_OPERANDS 2 typedef enum InstOperandType { OPERAND_NONE, OPERAND_INT1, /* One byte signed integer. */ OPERAND_INT4, /* Four byte signed integer. */ OPERAND_UINT1, /* One byte unsigned integer. */ OPERAND_UINT4, /* Four byte unsigned integer. */ OPERAND_IDX4, /* Four byte signed index (actually an * integer, but displayed differently.) */ OPERAND_LVT1, /* One byte unsigned index into the local * variable table. */ OPERAND_LVT4, /* Four byte unsigned index into the local * variable table. */ OPERAND_AUX4, /* Four byte unsigned index into the aux data * table. */ OPERAND_OFFSET1, /* One byte signed jump offset. */ OPERAND_OFFSET4, /* Four byte signed jump offset. */ OPERAND_LIT1, /* One byte unsigned index into table of * literals. */ OPERAND_LIT4, /* Four byte unsigned index into table of * literals. */ OPERAND_SCLS1 /* Index into tclStringClassTable. */ } InstOperandType; typedef struct InstructionDesc { const char *name; /* Name of instruction. */ int numBytes; /* Total number of bytes for instruction. */ int stackEffect; /* The worst-case balance stack effect of the * instruction, used for stack requirements * computations. The value INT_MIN signals * that the instruction's worst case effect is * (1-opnd1). */ int numOperands; /* Number of operands. */ InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS]; /* The type of each operand. */ } InstructionDesc; MODULE_SCOPE InstructionDesc const tclInstructionTable[]; /* * Constants used by INST_STRING_CLASS to indicate character classes. These * correspond closely by name with what [string is] can support, but there is * no requirement to keep the values the same. */ typedef enum InstStringClassType { STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */ STR_CLASS_ALPHA, /* Unicode alphabet characters. */ STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */ STR_CLASS_CONTROL, /* Unicode control characters. */ STR_CLASS_DIGIT, /* Unicode digit characters. */ STR_CLASS_GRAPH, /* Unicode printing characters, excluding * space. */ STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */ STR_CLASS_PRINT, /* Unicode printing characters, including * spaces. */ STR_CLASS_PUNCT, /* Unicode punctuation characters. */ STR_CLASS_SPACE, /* Unicode space characters. */ STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */ STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector * punctuation) characters. */ STR_CLASS_XDIGIT /* Characters that can be used as digits in * hexadecimal numbers ([0-9A-Fa-f]). */ } InstStringClassType; typedef struct StringClassDesc { const char *name; /* Name of the class. */ int (*comparator)(int); /* Function to test if a single unicode * character is a member of the class. */ } StringClassDesc; MODULE_SCOPE StringClassDesc const tclStringClassTable[]; /* * Compilation of some Tcl constructs such as if commands and the logical or * (||) and logical and (&&) operators in expressions requires the generation * of forward jumps. Since the PC target of these jumps isn't known when the * jumps are emitted, we record the offset of each jump in an array of * JumpFixup structures. There is one array for each sequence of jumps to one * target PC. When we learn the target PC, we update the jumps with the * correct distance. Also, if the distance is too great (> 127 bytes), we * replace the single-byte jump with a four byte jump instruction, move the * instructions after the jump down, and update the code offsets for any * commands between the jump and the target. */ typedef enum { TCL_UNCONDITIONAL_JUMP, TCL_TRUE_JUMP, TCL_FALSE_JUMP } TclJumpType; typedef struct JumpFixup { TclJumpType jumpType; /* Indicates the kind of jump. */ unsigned int codeOffset; /* Offset of the first byte of the one-byte * forward jump's code. */ int cmdIndex; /* Index of the first command after the one * for which the jump was emitted. Used to * update the code offsets for subsequent * commands if the two-byte jump at jumpPc * must be replaced with a five-byte one. */ int exceptIndex; /* Index of the first range entry in the * ExceptionRange array after the current one. * This field is used to adjust the code * offsets in subsequent ExceptionRange * records when a jump is grown from 2 bytes * to 5 bytes. */ } JumpFixup; #define JUMPFIXUP_INIT_ENTRIES 10 typedef struct JumpFixupArray { JumpFixup *fixup; /* Points to start of jump fixup array. */ int next; /* Index of next free array entry. */ int end; /* Index of last usable entry in array. */ int mallocedArray; /* 1 if array was expanded and fixups points * into the heap, else 0. */ JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES]; /* Initial storage for jump fixup array. */ } JumpFixupArray; /* * The structure describing one variable list of a foreach command. Note that * only foreach commands inside procedure bodies are compiled inline so a * ForeachVarList structure always describes local variables. Furthermore, * only scalar variables are supported for inline-compiled foreach loops. */ typedef struct ForeachVarList { int numVars; /* The number of variables in the list. */ int varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers") * for each variable in the procedure's array * of local variables. Only scalar variables * are supported. The actual size of this * field will be large enough to numVars * indexes. THIS MUST BE THE LAST FIELD IN THE * STRUCTURE! */ } ForeachVarList; /* * Structure used to hold information about a foreach command that is needed * during program execution. These structures are stored in CompileEnv and * ByteCode structures as auxiliary data. */ typedef struct ForeachInfo { int numLists; /* The number of both the variable and value * lists of the foreach command. */ int firstValueTemp; /* Index of the first temp var in a proc frame * used to point to a value list. */ int loopCtTemp; /* Index of temp var in a proc frame holding * the loop's iteration count. Used to * determine next value list element to assign * each loop var. */ ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList * structures describing each var list. The * actual size of this field will be large * enough to numVars indexes. THIS MUST BE THE * LAST FIELD IN THE STRUCTURE! */ } ForeachInfo; /* * Structure used to hold information about a switch command that is needed * during program execution. These structures are stored in CompileEnv and * ByteCode structures as auxiliary data. */ typedef struct JumptableInfo { Tcl_HashTable hashTable; /* Hash that maps strings to signed ints (PC * offsets). */ } JumptableInfo; MODULE_SCOPE const AuxDataType tclJumptableInfoType; #define JUMPTABLEINFO(envPtr, index) \ ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData)) /* * Structure used to hold information about a [dict update] command that is * needed during program execution. These structures are stored in CompileEnv * and ByteCode structures as auxiliary data. */ typedef struct { int length; /* Size of array */ int varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when * processing the start and end of a [dict * update]. There is really more than one * entry, and the structure is allocated to * take account of this. MUST BE LAST FIELD IN * STRUCTURE. */ } DictUpdateInfo; /* * ClientData type used by the math operator commands. */ typedef struct { const char *op; /* Do not call it 'operator': C++ reserved */ const char *expected; union { int numArgs; int identity; } i; } TclOpCmdClientData; /* *---------------------------------------------------------------- * Procedures exported by tclBasic.c to be used within the engine. *---------------------------------------------------------------- */ MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine; /* *---------------------------------------------------------------- * Procedures exported by the engine to be used by tclBasic.c *---------------------------------------------------------------- */ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr, const CmdFrame *invoker, int word); /* *---------------------------------------------------------------- * Procedures shared among Tcl bytecode compilation and execution modules but * not used outside: *---------------------------------------------------------------- */ MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp, Tcl_Parse *parsePtr, int depth, Command *cmdPtr, CompileEnv *envPtr); MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr); MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr, ExceptionAux *auxPtr); MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, int numBytes, CompileEnv *envPtr, int optimize); MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, const char *script, int numBytes, CompileEnv *envPtr); MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateAuxData(ClientData clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes, int length, unsigned int hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr); MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...); MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, int catchOnly, ByteCode *codePtr); MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index); MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars, int create, CompileEnv *envPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, int distThreshold); MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr); MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr, int before, int after, int *indexPtr); MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr, const char *string, int numBytes, const CmdFrame *invoker, int word); MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr, int returnCode, ExceptionAux **auxPtrPtr); MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr, ExceptionAux *auxPtr); MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr, ExceptionAux *auxPtr); MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, int range); #ifdef TCL_COMPILE_STATS MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes, CompileEnv *envPtr); MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE void TclOptimizeBytecode(void *envPtr); #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr, const unsigned char *pc); MODULE_SCOPE void TclPrintObject(FILE *outFile, Tcl_Obj *objPtr, int maxChars); MODULE_SCOPE void TclPrintSource(FILE *outFile, const char *string, int maxChars); MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *isScalarPtr); static inline void TclPreserveByteCode( ByteCode *codePtr) { codePtr->refCount++; } static inline void TclReleaseByteCode( ByteCode *codePtr) { if (codePtr->refCount-- > 1) { return; } /* Just dropped to refcount==0. Clean up. */ TclCleanupByteCode(codePtr); } MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); MODULE_SCOPE Tcl_ObjCmdProc TclSingleOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclSortingOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclVariadicOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNoIdentOpCmd; #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr); MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr); #endif MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, Tcl_Obj *valuePtr); MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, int length, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); /* *---------------------------------------------------------------- * Macros and flag values used by Tcl bytecode compilation and execution * modules inside the Tcl core but not used outside. *---------------------------------------------------------------- */ /* * Simplified form to access AuxData. * * ClientData TclFetchAuxData(CompileEng *envPtr, int index); */ #define TclFetchAuxData(envPtr, index) \ (envPtr)->auxDataArrayPtr[(index)].clientData #define LITERAL_ON_HEAP 0x01 #define LITERAL_CMD_NAME 0x02 #define LITERAL_UNSHARED 0x04 /* * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to * cast away constness, and it is cleanest to do that here, all in one place. * * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes, * int length); */ #define TclRegisterNewLiteral(envPtr, bytes, length) \ TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0) /* * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it * is safe to cast away constness, and it is cleanest to do that here, all in * one place. * * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes, * int length); */ #define TclRegisterNewCmdLiteral(envPtr, bytes, length) \ TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME) /* * Macro used to manually adjust the stack requirements; used in cases where * the stack effect cannot be computed from the opcode and its operands, but * is still known at compile time. * * void TclAdjustStackDepth(int delta, CompileEnv *envPtr); */ #define TclAdjustStackDepth(delta, envPtr) \ do { \ if ((delta) < 0) { \ if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) { \ (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ } \ } \ (envPtr)->currStackDepth += (delta); \ } while (0) #define TclGetStackDepth(envPtr) \ ((envPtr)->currStackDepth) #define TclSetStackDepth(depth, envPtr) \ (envPtr)->currStackDepth = (depth) #define TclCheckStackDepth(depth, envPtr) \ do { \ int _dd = (depth); \ if (_dd != (envPtr)->currStackDepth) { \ Tcl_Panic("bad stack depth computations: is %i, should be %i", \ (envPtr)->currStackDepth, _dd); \ } \ } while (0) /* * Macro used to update the stack requirements. It is called by the macros * TclEmitOpCode, TclEmitInst1 and TclEmitInst4. * Remark that the very last instruction of a bytecode always reduces the * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always * updated. * * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr); */ #define TclUpdateStackReqs(op, i, envPtr) \ do { \ int _delta = tclInstructionTable[(op)].stackEffect; \ if (_delta) { \ if (_delta == INT_MIN) { \ _delta = 1 - (i); \ } \ TclAdjustStackDepth(_delta, envPtr); \ } \ } while (0) /* * Macros used to update the flag that indicates if we are at the start of a * command, based on whether the opcode is INST_START_COMMAND. * * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr); */ #define TclUpdateAtCmdStart(op, envPtr) \ if ((envPtr)->atCmdStart < 2) { \ (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ } /* * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C * "prototype" for this macro is: * * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr); */ #define TclEmitOpcode(op, envPtr) \ do { \ if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ TclExpandCodeArray(envPtr); \ } \ *(envPtr)->codeNext++ = (unsigned char) (op); \ TclUpdateAtCmdStart(op, envPtr); \ TclUpdateStackReqs(op, 0, envPtr); \ } while (0) /* * Macros to emit an integer operand. The ANSI C "prototype" for these macros * are: * * void TclEmitInt1(int i, CompileEnv *envPtr); * void TclEmitInt4(int i, CompileEnv *envPtr); */ #define TclEmitInt1(i, envPtr) \ do { \ if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ TclExpandCodeArray(envPtr); \ } \ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ } while (0) #define TclEmitInt4(i, envPtr) \ do { \ if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \ TclExpandCodeArray(envPtr); \ } \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) >> 24); \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) >> 16); \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) >> 8); \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) ); \ } while (0) /* * Macros to emit an instruction with signed or unsigned integer operands. * Four byte integers are stored in "big-endian" order with the high order * byte stored at the lowest address. The ANSI C "prototypes" for these macros * are: * * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr); * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr); */ #define TclEmitInstInt1(op, i, envPtr) \ do { \ if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \ TclExpandCodeArray(envPtr); \ } \ *(envPtr)->codeNext++ = (unsigned char) (op); \ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ TclUpdateAtCmdStart(op, envPtr); \ TclUpdateStackReqs(op, i, envPtr); \ } while (0) #define TclEmitInstInt4(op, i, envPtr) \ do { \ if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ TclExpandCodeArray(envPtr); \ } \ *(envPtr)->codeNext++ = (unsigned char) (op); \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) >> 24); \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) >> 16); \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) >> 8); \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) ); \ TclUpdateAtCmdStart(op, envPtr); \ TclUpdateStackReqs(op, i, envPtr); \ } while (0) /* * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the * object's one or four byte array index into the CompileEnv's code array. * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a * CompileEnv. The ANSI C "prototype" for this macro is: * * void TclEmitPush(int objIndex, CompileEnv *envPtr); */ #define TclEmitPush(objIndex, envPtr) \ do { \ int _objIndexCopy = (objIndex); \ if (_objIndexCopy <= 255) { \ TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ } else { \ TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ } \ } while (0) /* * Macros to update a (signed or unsigned) integer starting at a pointer. The * two variants depend on the number of bytes. The ANSI C "prototypes" for * these macros are: * * void TclStoreInt1AtPtr(int i, unsigned char *p); * void TclStoreInt4AtPtr(int i, unsigned char *p); */ #define TclStoreInt1AtPtr(i, p) \ *(p) = (unsigned char) ((unsigned int) (i)) #define TclStoreInt4AtPtr(i, p) \ do { \ *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ *(p+3) = (unsigned char) ((unsigned int) (i) ); \ } while (0) /* * Macros to update instructions at a particular pc with a new op code and a * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros * are: * * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc); * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc); */ #define TclUpdateInstInt1AtPc(op, i, pc) \ do { \ *(pc) = (unsigned char) (op); \ TclStoreInt1AtPtr((i), ((pc)+1)); \ } while (0) #define TclUpdateInstInt4AtPc(op, i, pc) \ do { \ *(pc) = (unsigned char) (op); \ TclStoreInt4AtPtr((i), ((pc)+1)); \ } while (0) /* * Macro to fix up a forward jump to point to the current code-generation * position in the bytecode being created (the most common case). The ANSI C * "prototypes" for this macro is: * * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr, * int threshold); */ #define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \ TclFixupForwardJump((envPtr), (fixupPtr), \ (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \ (threshold)) /* * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int * (GET_UINT{1,2}) from a pointer. There are two variants for each return type * that depend on the number of bytes fetched. The ANSI C "prototypes" for * these macros are: * * int TclGetInt1AtPtr(unsigned char *p); * int TclGetInt4AtPtr(unsigned char *p); * unsigned int TclGetUInt1AtPtr(unsigned char *p); * unsigned int TclGetUInt4AtPtr(unsigned char *p); */ /* * The TclGetInt1AtPtr macro is tricky because we want to do sign extension on * the 1-byte value. Unfortunately the "char" type isn't signed on all * platforms so sign-extension doesn't always happen automatically. Sometimes * we can explicitly declare the pointer to be signed, but other times we have * to explicitly sign-extend the value in software. */ #ifndef __CHAR_UNSIGNED__ # define TclGetInt1AtPtr(p) ((int) *((char *) p)) #elif defined(HAVE_SIGNED_CHAR) # define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) #else # define TclGetInt1AtPtr(p) \ ((int) ((*((char *) p)) | ((*(p) & 0200) ? (-256) : 0))) #endif #define TclGetInt4AtPtr(p) \ ((int) ((TclGetUInt1AtPtr(p) << 24) | \ (*((p)+1) << 16) | \ (*((p)+2) << 8) | \ (*((p)+3)))) #define TclGetUInt1AtPtr(p) \ ((unsigned int) *(p)) #define TclGetUInt4AtPtr(p) \ ((unsigned int) ((*(p) << 24) | \ (*((p)+1) << 16) | \ (*((p)+2) << 8) | \ (*((p)+3)))) /* * Macros used to compute the minimum and maximum of two integers. The ANSI C * "prototypes" for these macros are: * * int TclMin(int i, int j); * int TclMax(int i, int j); */ #define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j)) #define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j)) /* * Convenience macros for use when compiling bodies of commands. The ANSI C * "prototype" for these macros are: * * static void BODY(Tcl_Token *tokenPtr, int word); */ #define BODY(tokenPtr, word) \ SetLineInformation((word)); \ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \ envPtr) /* * Convenience macro for use when compiling tokens to be pushed. The ANSI C * "prototype" for this macro is: * * static void CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr, * Tcl_Interp *interp); */ #define CompileTokens(envPtr, tokenPtr, interp) \ TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ (envPtr)); /* * Convenience macros for use when pushing literals. The ANSI C "prototype" for * these macros are: * * static void PushLiteral(CompileEnv *envPtr, * const char *string, int length); * static void PushStringLiteral(CompileEnv *envPtr, * const char *string); */ #define PushLiteral(envPtr, string, length) \ TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr)) #define PushStringLiteral(envPtr, string) \ PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1)) /* * Macro to advance to the next token; it is more mnemonic than the address * arithmetic that it replaces. The ANSI C "prototype" for this macro is: * * static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr); */ #define TokenAfter(tokenPtr) \ ((tokenPtr) + ((tokenPtr)->numComponents + 1)) /* * Macro to get the offset to the next instruction to be issued. The ANSI C * "prototype" for this macro is: * * static int CurrentOffset(CompileEnv *envPtr); */ #define CurrentOffset(envPtr) \ ((envPtr)->codeNext - (envPtr)->codeStart) /* * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the * maximal depth of nested CATCH ranges in order to alloc runtime * memory. These macros should compute precisely that? OTOH, the nesting depth * of LOOP ranges is an interesting datum for debugging purposes, and that is * what we compute now. * * static int ExceptionRangeStarts(CompileEnv *envPtr, int index); * static void ExceptionRangeEnds(CompileEnv *envPtr, int index); * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL); */ #define ExceptionRangeStarts(envPtr, index) \ (((envPtr)->exceptDepth++), \ ((envPtr)->maxExceptDepth = \ TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \ ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr))) #define ExceptionRangeEnds(envPtr, index) \ (((envPtr)->exceptDepth--), \ ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \ CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset)) #define ExceptionRangeTarget(envPtr, index, targetType) \ ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr)) /* * Check if there is an LVT for compiled locals */ #define EnvHasLVT(envPtr) \ (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr) /* * Macros for making it easier to deal with tokens and DStrings. */ #define TclDStringAppendToken(dsPtr, tokenPtr) \ Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size) #define TclRegisterDStringLiteral(envPtr, dsPtr) \ TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \ Tcl_DStringLength(dsPtr), /*flags*/ 0) /* * Macro that encapsulates an efficiency trick that avoids a function call for * the simplest of compiles. The ANSI C "prototype" for this macro is: * * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, * Tcl_Interp *interp, int word); */ #define CompileWord(envPtr, tokenPtr, interp, word) \ if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size); \ } else { \ SetLineInformation((word)); \ CompileTokens((envPtr), (tokenPtr), (interp)); \ } /* * TIP #280: Remember the per-word line information of the current command. An * index is used instead of a pointer as recursive compilation may reallocate, * i.e. move, the array. This is also the reason to save the nuloc now, it may * change during the course of the function. * * Macro to encapsulate the variable definition and setup. */ #define DefineLineInformation \ ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ int eclIndex = mapPtr->nuloc - 1 #define SetLineInformation(word) \ envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] #define PushVarNameWord(i,v,e,f,l,sc,word) \ SetLineInformation(word); \ TclPushVarName(i,v,e,f,l,sc) /* * Often want to issue one of two versions of an instruction based on whether * the argument will fit in a single byte or not. This makes it much clearer. */ #define Emit14Inst(nm,idx,envPtr) \ if (idx <= 255) { \ TclEmitInstInt1(nm##1,idx,envPtr); \ } else { \ TclEmitInstInt4(nm##4,idx,envPtr); \ } /* * How to get an anonymous local variable (used for holding temporary values * off the stack) or a local simple scalar. */ #define AnonymousLocal(envPtr) \ (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr))) #define LocalScalar(chars,len,envPtr) \ TclLocalScalar(chars, len, envPtr) #define LocalScalarFromToken(tokenPtr,envPtr) \ TclLocalScalarFromToken(tokenPtr, envPtr) /* * Flags bits used by TclPushVarName. */ #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ #define TCL_NO_ELEMENT 2 /* Do not push the array element. */ /* * DTrace probe macros (NOPs if DTrace support is not enabled). */ /* * Define the following macros to enable debug logging of the DTrace proc, * cmd, and inst probes. Note that this does _not_ require a platform with * DTrace, it simply logs all probe output to /tmp/tclDTraceDebug-[pid].log. * * If the second macro is defined, logging to file starts immediately, * otherwise only after the first call to [tcl::dtrace]. Note that the debug * probe data is always computed, even when it is not logged to file. * * Defining the third macro enables debug logging of inst probes (disabled * by default due to the significant performance impact). */ /* #define TCL_DTRACE_DEBUG 1 #define TCL_DTRACE_DEBUG_LOG_ENABLED 1 #define TCL_DTRACE_DEBUG_INST_PROBES 1 */ #if !(defined(TCL_DTRACE_DEBUG) && defined(__GNUC__)) #ifdef USE_DTRACE #if defined(__GNUC__) && __GNUC__ > 2 /* * Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks. */ #define unlikely(x) (__builtin_expect((x), 0)) #else #define unlikely(x) (x) #endif #define TCL_DTRACE_PROC_ENTRY_ENABLED() unlikely(TCL_PROC_ENTRY_ENABLED()) #define TCL_DTRACE_PROC_RETURN_ENABLED() unlikely(TCL_PROC_RETURN_ENABLED()) #define TCL_DTRACE_PROC_RESULT_ENABLED() unlikely(TCL_PROC_RESULT_ENABLED()) #define TCL_DTRACE_PROC_ARGS_ENABLED() unlikely(TCL_PROC_ARGS_ENABLED()) #define TCL_DTRACE_PROC_INFO_ENABLED() unlikely(TCL_PROC_INFO_ENABLED()) #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) TCL_PROC_ENTRY(a0, a1, a2) #define TCL_DTRACE_PROC_RETURN(a0, a1) TCL_PROC_RETURN(a0, a1) #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3) #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) #define TCL_DTRACE_CMD_ENTRY_ENABLED() unlikely(TCL_CMD_ENTRY_ENABLED()) #define TCL_DTRACE_CMD_RETURN_ENABLED() unlikely(TCL_CMD_RETURN_ENABLED()) #define TCL_DTRACE_CMD_RESULT_ENABLED() unlikely(TCL_CMD_RESULT_ENABLED()) #define TCL_DTRACE_CMD_ARGS_ENABLED() unlikely(TCL_CMD_ARGS_ENABLED()) #define TCL_DTRACE_CMD_INFO_ENABLED() unlikely(TCL_CMD_INFO_ENABLED()) #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) TCL_CMD_ENTRY(a0, a1, a2) #define TCL_DTRACE_CMD_RETURN(a0, a1) TCL_CMD_RETURN(a0, a1) #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3) #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) #define TCL_DTRACE_INST_START_ENABLED() unlikely(TCL_INST_START_ENABLED()) #define TCL_DTRACE_INST_DONE_ENABLED() unlikely(TCL_INST_DONE_ENABLED()) #define TCL_DTRACE_INST_START(a0, a1, a2) TCL_INST_START(a0, a1, a2) #define TCL_DTRACE_INST_DONE(a0, a1, a2) TCL_INST_DONE(a0, a1, a2) #define TCL_DTRACE_TCL_PROBE_ENABLED() unlikely(TCL_TCL_PROBE_ENABLED()) #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) #define TCL_DTRACE_DEBUG_LOG() MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); #else /* USE_DTRACE */ #define TCL_DTRACE_PROC_ENTRY_ENABLED() 0 #define TCL_DTRACE_PROC_RETURN_ENABLED() 0 #define TCL_DTRACE_PROC_RESULT_ENABLED() 0 #define TCL_DTRACE_PROC_ARGS_ENABLED() 0 #define TCL_DTRACE_PROC_INFO_ENABLED() 0 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) {if (a0) {}} #define TCL_DTRACE_PROC_RETURN(a0, a1) {if (a0) {}} #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {if (a0) {}; if (a3) {}} #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {} #define TCL_DTRACE_CMD_ENTRY_ENABLED() 0 #define TCL_DTRACE_CMD_RETURN_ENABLED() 0 #define TCL_DTRACE_CMD_RESULT_ENABLED() 0 #define TCL_DTRACE_CMD_ARGS_ENABLED() 0 #define TCL_DTRACE_CMD_INFO_ENABLED() 0 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) {} #define TCL_DTRACE_CMD_RETURN(a0, a1) {} #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {} #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {} #define TCL_DTRACE_INST_START_ENABLED() 0 #define TCL_DTRACE_INST_DONE_ENABLED() 0 #define TCL_DTRACE_INST_START(a0, a1, a2) {} #define TCL_DTRACE_INST_DONE(a0, a1, a2) {} #define TCL_DTRACE_TCL_PROBE_ENABLED() 0 #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} #define TclDTraceInfo(info, args, argsi) {*args = ""; *argsi = 0;} #endif /* USE_DTRACE */ #else /* TCL_DTRACE_DEBUG */ #define USE_DTRACE 1 #if !defined(TCL_DTRACE_DEBUG_LOG_ENABLED) || !(TCL_DTRACE_DEBUG_LOG_ENABLED) #undef TCL_DTRACE_DEBUG_LOG_ENABLED #define TCL_DTRACE_DEBUG_LOG_ENABLED 0 #endif #if !defined(TCL_DTRACE_DEBUG_INST_PROBES) || !(TCL_DTRACE_DEBUG_INST_PROBES) #undef TCL_DTRACE_DEBUG_INST_PROBES #define TCL_DTRACE_DEBUG_INST_PROBES 0 #endif MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent; MODULE_SCOPE FILE *tclDTraceDebugLog; MODULE_SCOPE void TclDTraceOpenDebugLog(void); MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); #define TCL_DTRACE_DEBUG_LOG() \ int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ int tclDTraceDebugIndent = 0; \ FILE *tclDTraceDebugLog = NULL; \ void TclDTraceOpenDebugLog(void) { \ char n[35]; \ snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%lu.log", \ (unsigned long) getpid()); \ tclDTraceDebugLog = fopen(n, "a"); \ } #define TclDTraceDbgMsg(p, m, ...) \ do { \ if (tclDTraceDebugEnabled) { \ int _l, _t = 0; \ if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \ fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", \ strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \ fprintf(tclDTraceDebugLog, " %.*s():%n", \ (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \ fprintf(tclDTraceDebugLog, "%*s" p "%n", \ (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \ "", &_l); _t += _l; \ fprintf(tclDTraceDebugLog, "%*s" m "\n", \ (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__); \ fflush(tclDTraceDebugLog); \ } \ } while (0) #define TCL_DTRACE_PROC_ENTRY_ENABLED() 1 #define TCL_DTRACE_PROC_RETURN_ENABLED() 1 #define TCL_DTRACE_PROC_RESULT_ENABLED() 1 #define TCL_DTRACE_PROC_ARGS_ENABLED() 1 #define TCL_DTRACE_PROC_INFO_ENABLED() 1 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \ tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2) #define TCL_DTRACE_PROC_RETURN(a0, a1) \ TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3) #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \ a1, a2, a3, a4, a5, a6, a7, a8, a9) #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \ a2, a3, a4, a5, a6, a7) #define TCL_DTRACE_CMD_ENTRY_ENABLED() 1 #define TCL_DTRACE_CMD_RETURN_ENABLED() 1 #define TCL_DTRACE_CMD_RESULT_ENABLED() 1 #define TCL_DTRACE_CMD_ARGS_ENABLED() 1 #define TCL_DTRACE_CMD_INFO_ENABLED() 1 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \ tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2) #define TCL_DTRACE_CMD_RETURN(a0, a1) \ TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3) #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \ a1, a2, a3, a4, a5, a6, a7, a8, a9) #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \ a2, a3, a4, a5, a6, a7) #define TCL_DTRACE_INST_START_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES #define TCL_DTRACE_INST_DONE_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES #define TCL_DTRACE_INST_START(a0, a1, a2) \ TclDTraceDbgMsg(" | inst-start", "%s %d %p", a0, a1, a2) #define TCL_DTRACE_INST_DONE(a0, a1, a2) \ TclDTraceDbgMsg(" | inst-end", "%s %d %p", a0, a1, a2) #define TCL_DTRACE_TCL_PROBE_ENABLED() 1 #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ do { \ tclDTraceDebugEnabled = 1; \ TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \ a1, a2, a3, a4, a5, a6, a7, a8, a9); \ } while (0) #endif /* TCL_DTRACE_DEBUG */ #endif /* _TCLCOMPILATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclConfig.c0000644000175000017500000002513014554262142015333 0ustar sergeisergei/* * tclConfig.c -- * * This file provides the facilities which allow Tcl and other packages * to embed configuration information into their binary libraries. * * Copyright (c) 2002 Andreas Kupries * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Internal structure to hold embedded configuration information. * * Our structure is a two-level dictionary associated with the 'interp'. The * first level is keyed with the package name and maps to the dictionary for * that package. The package dictionary is keyed with metadata keys and maps * to the metadata value for that key. This is package specific. The metadata * values are in UTF-8, converted from the external representation given to us * by the caller. */ #define ASSOC_KEY "tclPackageAboutDict" /* * A ClientData struct for the QueryConfig command. Store the three bits * of data we need; the package name for which we store a config dict, * the (Tcl_Interp *) in which it is stored, and the encoding. */ typedef struct QCCD { Tcl_Obj *pkg; Tcl_Interp *interp; char *encoding; } QCCD; /* * Static functions in this file: */ static Tcl_ObjCmdProc QueryConfigObjCmd; static void QueryConfigDelete(ClientData clientData); static Tcl_Obj * GetConfigDict(Tcl_Interp *interp); static void ConfigDictDeleteProc(ClientData clientData, Tcl_Interp *interp); /* *---------------------------------------------------------------------- * * Tcl_RegisterConfig -- * * See TIP#59 for details on what this function does. * * Results: * None. * * Side effects: * Creates namespace and cfg query command in it as per TIP #59. * *---------------------------------------------------------------------- */ void Tcl_RegisterConfig( Tcl_Interp *interp, /* Interpreter the configuration command is * registered in. */ const char *pkgName, /* Name of the package registering the * embedded configuration. ASCII, thus in * UTF-8 too. */ const Tcl_Config *configuration, /* Embedded configuration. */ const char *valEncoding) /* Name of the encoding used to store the * configuration values, ASCII, thus UTF-8. */ { Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; const Tcl_Config *cfg; QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); cdPtr->interp = interp; if (valEncoding) { cdPtr->encoding = (char *)ckalloc(strlen(valEncoding)+1); strcpy(cdPtr->encoding, valEncoding); } else { cdPtr->encoding = NULL; } cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* * Phase I: Adding the provided information to the internal database of * package meta data. * * Phase II: Create a command for querying this database, specific to the * package registering its configuration. This is the approved interface * in TIP 59. In the future a more general interface should be done, as * follow-up to TIP 59. Simply because our database is now general across * packages, and not a structure tied to one package. * * Note, the created command will have a reference through its clientdata. */ Tcl_IncrRefCount(cdPtr->pkg); /* * For venc == NULL aka bogus encoding we skip the step setting up the * dictionaries visible at Tcl level. I.e. they are not filled */ pDB = GetConfigDict(interp); /* * Retrieve package specific configuration... */ if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK || (pkgDict == NULL)) { pkgDict = Tcl_NewDictObj(); } else if (Tcl_IsShared(pkgDict)) { pkgDict = Tcl_DuplicateObj(pkgDict); } /* * Extend the package configuration... * We cannot assume that the encodings are initialized, therefore * store the value as-is in a byte array. See Bug [9b2e636361]. */ for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value))); } /* * Write the changes back into the overall database. */ Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); /* * Now create the interface command for retrieval of the package * information. */ Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "::"); Tcl_DStringAppend(&cmdName, pkgName, -1); /* * The incomplete command name is the name of the namespace to place it * in. */ if (Tcl_FindNamespace(interp, Tcl_DStringValue(&cmdName), NULL, TCL_GLOBAL_ONLY) == NULL) { if (Tcl_CreateNamespace(interp, Tcl_DStringValue(&cmdName), NULL, NULL) == NULL) { Tcl_Panic("%s.\n%s: %s", Tcl_GetStringResult(interp), "Tcl_RegisterConfig", "Unable to create namespace for package configuration."); } } TclDStringAppendLiteral(&cmdName, "::pkgconfig"); if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) { Tcl_Panic("%s: %s", "Tcl_RegisterConfig", "Unable to create query command for package configuration"); } Tcl_DStringFree(&cmdName); } /* *---------------------------------------------------------------------- * * QueryConfigObjCmd -- * * Implementation of "::::pkgconfig", the command to query * configuration information embedded into a binary library. * * Results: * A standard Tcl result. * * Side effects: * See the manual for what this command does. * *---------------------------------------------------------------------- */ static int QueryConfigObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; int n, index; static const char *const subcmdStrings[] = { "get", "list", NULL }; enum subcmds { CFG_GET, CFG_LIST }; Tcl_DString conv; Tcl_Encoding venc = NULL; const char *value; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } pDB = GetConfigDict(interp); if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK || pkgDict == NULL) { /* * Maybe a Tcl_Panic is better, because the package data has to be * present. */ Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1)); Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE", Tcl_GetString(pkgName), NULL); return TCL_ERROR; } switch ((enum subcmds) index) { case CFG_GET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "key"); return TCL_ERROR; } if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK || val == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG", Tcl_GetString(objv[2]), NULL); return TCL_ERROR; } if (cdPtr->encoding) { venc = Tcl_GetEncoding(interp, cdPtr->encoding); if (!venc) { return TCL_ERROR; } } /* * Value is stored as-is in a byte array, see Bug [9b2e636361], * so we have to decode it first. */ value = (const char *) Tcl_GetByteArrayFromObj(val, &n); value = Tcl_ExternalToUtfDString(venc, value, n, &conv); Tcl_SetObjResult(interp, Tcl_NewStringObj(value, Tcl_DStringLength(&conv))); Tcl_DStringFree(&conv); return TCL_OK; case CFG_LIST: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_DictObjSize(interp, pkgDict, &n); listPtr = Tcl_NewListObj(n, NULL); if (!listPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "insufficient memory to create list", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } if (n) { Tcl_DictSearch s; Tcl_Obj *key; int done; for (Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done); !done; Tcl_DictObjNext(&s, &key, NULL, &done)) { Tcl_ListObjAppendElement(NULL, listPtr, key); } } Tcl_SetObjResult(interp, listPtr); return TCL_OK; default: Tcl_Panic("QueryConfigObjCmd: Unknown subcommand to 'pkgconfig'. This can't happen"); break; } return TCL_ERROR; } /* *------------------------------------------------------------------------- * * QueryConfigDelete -- * * Command delete function. Cleans up after the configuration query * command when it is deleted by the user or during finalization. * * Results: * None. * * Side effects: * Deallocates all non-transient memory allocated by Tcl_RegisterConfig. * *------------------------------------------------------------------------- */ static void QueryConfigDelete( ClientData clientData) { QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB = GetConfigDict(cdPtr->interp); Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); if (cdPtr->encoding) { ckfree((char *)cdPtr->encoding); } ckfree((char *)cdPtr); } /* *------------------------------------------------------------------------- * * GetConfigDict -- * * Retrieve the package metadata database from the interpreter. * Initializes it, if not present yet. * * Results: * A Tcl_Obj reference * * Side effects: * May allocate a Tcl_Obj. * *------------------------------------------------------------------------- */ static Tcl_Obj * GetConfigDict( Tcl_Interp *interp) { Tcl_Obj *pDB = (Tcl_Obj *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL); if (pDB == NULL) { pDB = Tcl_NewDictObj(); Tcl_IncrRefCount(pDB); Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB); } return pDB; } /* *---------------------------------------------------------------------- * * ConfigDictDeleteProc -- * * This function is associated with the "Package About dict" assoc data * for an interpreter; it is invoked when the interpreter is deleted in * order to free the information associated with any pending error * reports. * * Results: * None. * * Side effects: * The package metadata database is freed. * *---------------------------------------------------------------------- */ static void ConfigDictDeleteProc( ClientData clientData, /* Pointer to Tcl_Obj. */ Tcl_Interp *interp) /* Interpreter being deleted. */ { Tcl_Obj *pDB = (Tcl_Obj *)clientData; Tcl_DecrRefCount(pDB); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclDate.c0000644000175000017500000023633714554262142015020 0ustar sergeisergei/* A Bison parser, made by GNU Bison 3.1. */ /* Bison implementation for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* C LALR(1) parser skeleton written by Richard Stallman, by simplifying the original so-called "semantic" parser. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output. */ #define YYBISON 1 /* Bison version. */ #define YYBISON_VERSION "3.1" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 1 /* Push parsers. */ #define YYPUSH 0 /* Pull parsers. */ #define YYPULL 1 /* Substitute the variable and function names. */ #define yyparse TclDateparse #define yylex TclDatelex #define yyerror TclDateerror #define yydebug TclDatedebug /* Copy the first part of user declarations. */ /* * tclDate.c -- * * This file is generated from a yacc grammar defined in the file * tclGetDate.y. It should not be edited directly. * * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tclInt.h" /* * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; time_t dateRelMonth; time_t dateRelDay; time_t dateRelSeconds; int dateHaveRel; time_t dateMonthOrdinal; int dateHaveOrdinalMonth; time_t dateDayOrdinal; time_t dateDayNumber; int dateHaveDay; const char *dateStart; const char *dateInput; time_t *dateRelPointer; int dateDigitCount; } DateInfo; #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) #define yyDSTmode (info->dateDSTmode) #define yyDayOrdinal (info->dateDayOrdinal) #define yyDayNumber (info->dateDayNumber) #define yyMonthOrdinal (info->dateMonthOrdinal) #define yyHaveDate (info->dateHaveDate) #define yyHaveDay (info->dateHaveDay) #define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) #define yyHaveRel (info->dateHaveRel) #define yyHaveTime (info->dateHaveTime) #define yyHaveZone (info->dateHaveZone) #define yyTimezone (info->dateTimezone) #define yyDay (info->dateDay) #define yyMonth (info->dateMonth) #define yyYear (info->dateYear) #define yyHour (info->dateHour) #define yyMinutes (info->dateMinutes) #define yySeconds (info->dateSeconds) #define yyMeridian (info->dateMeridian) #define yyRelMonth (info->dateRelMonth) #define yyRelDay (info->dateRelDay) #define yyRelSeconds (info->dateRelSeconds) #define yyRelPointer (info->dateRelPointer) #define yyInput (info->dateInput) #define yyDigitCount (info->dateDigitCount) #define EPOCH 1970 #define START_OF_TIME 1902 #define END_OF_TIME 2037 /* * The offset of tm_year of struct tm returned by localtime, gmtime, etc. * Posix requires 1900. */ #define TM_YEAR_BASE 1900 #define HOUR(x) ((int) (60 * (x))) #define SECSPERDAY (24L * 60L * 60L) #define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0)) /* * An entry in the lexical lookup table. */ typedef struct _TABLE { const char *name; int type; time_t value; } TABLE; /* * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; # ifndef YY_NULLPTR # if defined __cplusplus && 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif # endif /* Enabling verbose error messages. */ #ifdef YYERROR_VERBOSE # undef YYERROR_VERBOSE # define YYERROR_VERBOSE 1 #else # define YYERROR_VERBOSE 0 #endif /* Debug traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif #if YYDEBUG extern int TclDatedebug; #endif /* Token type. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE enum yytokentype { tAGO = 258, tDAY = 259, tDAYZONE = 260, tID = 261, tMERIDIAN = 262, tMONTH = 263, tMONTH_UNIT = 264, tSTARDATE = 265, tSEC_UNIT = 266, tSNUMBER = 267, tUNUMBER = 268, tZONE = 269, tEPOCH = 270, tDST = 271, tISOBASE = 272, tDAY_UNIT = 273, tNEXT = 274 }; #endif /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED union YYSTYPE { time_t Number; enum _MERIDIAN Meridian; }; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif /* Location type. */ #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED typedef struct YYLTYPE YYLTYPE; struct YYLTYPE { int first_line; int first_column; int last_line; int last_column; }; # define YYLTYPE_IS_DECLARED 1 # define YYLTYPE_IS_TRIVIAL 1 #endif int TclDateparse (DateInfo* info); /* Copy the second part of user declarations. */ /* * Prototypes of internal functions. */ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); static void TclDateerror(YYLTYPE* location, DateInfo* info, const char *s); static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); static time_t ToSeconds(time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian); MODULE_SCOPE int yyparse(DateInfo*); #ifdef short # undef short #endif #ifdef YYTYPE_UINT8 typedef YYTYPE_UINT8 yytype_uint8; #else typedef unsigned char yytype_uint8; #endif #ifdef YYTYPE_INT8 typedef YYTYPE_INT8 yytype_int8; #else typedef signed char yytype_int8; #endif #ifdef YYTYPE_UINT16 typedef YYTYPE_UINT16 yytype_uint16; #else typedef unsigned short yytype_uint16; #endif #ifdef YYTYPE_INT16 typedef YYTYPE_INT16 yytype_int16; #else typedef short yytype_int16; #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t # elif ! defined YYSIZE_T # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else # define YYSIZE_T unsigned # endif #endif #define YYSIZE_MAXIMUM ((YYSIZE_T) -1) #ifndef YY_ # if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(Msgid) dgettext ("bison-runtime", Msgid) # endif # endif # ifndef YY_ # define YY_(Msgid) Msgid # endif #endif #ifndef YY_ATTRIBUTE # if (defined __GNUC__ \ && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__))) \ || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C # define YY_ATTRIBUTE(Spec) __attribute__(Spec) # else # define YY_ATTRIBUTE(Spec) /* empty */ # endif #endif #ifndef YY_ATTRIBUTE_PURE # define YY_ATTRIBUTE_PURE YY_ATTRIBUTE ((__pure__)) #endif #ifndef YY_ATTRIBUTE_UNUSED # define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__)) #endif #if !defined _Noreturn \ && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112) # if defined _MSC_VER && 1200 <= _MSC_VER # define _Noreturn __declspec (noreturn) # else # define _Noreturn YY_ATTRIBUTE ((__noreturn__)) # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ # define YYUSE(E) ((void) (E)) #else # define YYUSE(E) /* empty */ #endif #if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__ /* Suppress an incorrect diagnostic about yylval being uninitialized. */ # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") # define YY_IGNORE_MAYBE_UNINITIALIZED_END \ _Pragma ("GCC diagnostic pop") #else # define YY_INITIAL_VALUE(Value) Value #endif #ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_END #endif #ifndef YY_INITIAL_VALUE # define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif #if ! defined yyoverflow || YYERROR_VERBOSE /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # elif defined __BUILTIN_VA_ARG_INCR # include /* INFRINGES ON USER NAME SPACE */ # elif defined _AIX # define YYSTACK_ALLOC __alloca # elif defined _MSC_VER # include /* INFRINGES ON USER NAME SPACE */ # define alloca _alloca # else # define YYSTACK_ALLOC alloca # if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS # include /* INFRINGES ON USER NAME SPACE */ /* Use EXIT_SUCCESS as a witness for stdlib.h. */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's 'empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely invoke alloca (N) if N exceeds 4096. Use a slightly smaller number to allow for a few compiler-allocated temporary stack slots. */ # define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif # else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif # if (defined __cplusplus && ! defined EXIT_SUCCESS \ && ! ((defined YYMALLOC || defined malloc) \ && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc # if ! defined malloc && ! defined EXIT_SUCCESS void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free # if ! defined free && ! defined EXIT_SUCCESS void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif # endif #endif /* ! defined yyoverflow || YYERROR_VERBOSE */ #if (! defined yyoverflow \ && (! defined __cplusplus \ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { yytype_int16 yyss_alloc; YYSTYPE yyvs_alloc; YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \ + 2 * YYSTACK_GAP_MAXIMUM) # define YYCOPY_NEEDED 1 /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYSIZE_T yynewbytes; \ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / sizeof (*yyptr); \ } \ while (0) #endif #if defined YYCOPY_NEEDED && YYCOPY_NEEDED /* Copy COUNT objects from SRC to DST. The source and destination do not overlap. */ # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(Dst, Src, Count) \ __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) # else # define YYCOPY(Dst, Src, Count) \ do \ { \ YYSIZE_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (Dst)[yyi] = (Src)[yyi]; \ } \ while (0) # endif # endif #endif /* !YYCOPY_NEEDED */ /* YYFINAL -- State number of the termination state. */ #define YYFINAL 2 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 81 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 26 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 16 /* YYNRULES -- Number of rules. */ #define YYNRULES 56 /* YYNSTATES -- Number of states. */ #define YYNSTATES 85 /* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned by yylex, with out-of-bounds checking. */ #define YYUNDEFTOK 2 #define YYMAXUTOK 274 #define YYTRANSLATE(YYX) \ ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM as returned by yylex, without out-of-bounds checking. */ static const yytype_uint8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 25, 21, 23, 24, 22, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 20, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { 0, 223, 223, 224, 227, 230, 233, 236, 239, 242, 245, 249, 254, 257, 263, 269, 277, 282, 287, 291, 297, 301, 305, 309, 313, 319, 323, 328, 333, 338, 343, 347, 352, 356, 361, 368, 372, 378, 388, 397, 406, 416, 430, 435, 438, 441, 444, 447, 450, 455, 458, 463, 467, 471, 477, 495, 498 }; #endif #if YYDEBUG || YYERROR_VERBOSE || 0 /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID", "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT", "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE", "tDAY_UNIT", "tNEXT", "':'", "','", "'/'", "'-'", "'.'", "'+'", "$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth", "iso", "trek", "relspec", "relunits", "sign", "unit", "number", "o_merid", YY_NULLPTR }; #endif # ifdef YYPRINT /* YYTOKNUM[NUM] -- (External) token number corresponding to the (internal) symbol number NUM (which must be that of a token). */ static const yytype_uint16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 58, 44, 47, 45, 46, 43 }; # endif #define YYPACT_NINF -18 #define yypact_value_is_default(Yystate) \ (!!((Yystate) == (-18))) #define YYTABLE_NINF -1 #define yytable_value_is_error(Yytable_value) \ 0 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ static const yytype_int8 yypact[] = { -18, 2, -18, -17, -18, -4, -18, 10, -18, 22, 8, -18, 18, -18, 39, -18, -18, -18, -18, -18, -18, -18, -18, -18, -18, -18, 25, 21, -18, -18, -18, 16, 14, -18, -18, 28, 36, 41, -5, -18, -18, 5, -18, -18, -18, 47, -18, -18, 42, 46, 48, -18, -6, 40, 43, 44, 49, -18, -18, -18, -18, -18, -18, -18, -18, 50, -18, 51, 55, 57, 58, 65, -18, -18, 59, 54, -18, 62, 63, 60, -18, 64, 61, 66, -18 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ static const yytype_uint8 yydefact[] = { 2, 0, 1, 20, 18, 0, 53, 0, 51, 54, 17, 33, 27, 52, 0, 49, 50, 3, 4, 5, 8, 6, 7, 10, 11, 9, 43, 0, 48, 12, 21, 30, 0, 22, 13, 32, 0, 0, 0, 45, 16, 0, 40, 24, 35, 0, 46, 42, 19, 0, 0, 34, 55, 25, 0, 0, 0, 38, 36, 47, 23, 44, 31, 41, 56, 0, 14, 0, 0, 0, 0, 55, 26, 28, 29, 0, 15, 0, 0, 0, 39, 0, 0, 0, 37 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { -18, -18, -18, -18, -18, -18, -18, -18, -18, -18, -18, -18, -18, -9, -18, 7 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int8 yydefgoto[] = { -1, 1, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 66 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule whose number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_uint8 yytable[] = { 39, 64, 2, 54, 30, 46, 3, 4, 55, 31, 5, 6, 7, 8, 65, 9, 10, 11, 56, 12, 13, 14, 57, 32, 40, 15, 33, 16, 47, 34, 35, 6, 41, 8, 48, 42, 59, 49, 50, 61, 13, 51, 36, 43, 37, 38, 60, 44, 6, 52, 8, 6, 45, 8, 53, 58, 6, 13, 8, 62, 13, 63, 67, 71, 72, 13, 68, 69, 73, 70, 74, 75, 64, 77, 78, 79, 80, 82, 76, 84, 81, 83 }; static const yytype_uint8 yycheck[] = { 9, 7, 0, 8, 21, 14, 4, 5, 13, 13, 8, 9, 10, 11, 20, 13, 14, 15, 13, 17, 18, 19, 17, 13, 16, 23, 4, 25, 3, 7, 8, 9, 14, 11, 13, 17, 45, 21, 24, 48, 18, 13, 20, 4, 22, 23, 4, 8, 9, 13, 11, 9, 13, 11, 13, 8, 9, 18, 11, 13, 18, 13, 22, 13, 13, 18, 23, 23, 13, 20, 13, 13, 7, 14, 20, 13, 13, 13, 71, 13, 20, 20 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ static const yytype_uint8 yystos[] = { 0, 27, 0, 4, 5, 8, 9, 10, 11, 13, 14, 15, 17, 18, 19, 23, 25, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 21, 13, 13, 4, 7, 8, 20, 22, 23, 39, 16, 14, 17, 4, 8, 13, 39, 3, 13, 21, 24, 13, 13, 13, 8, 13, 13, 17, 8, 39, 4, 39, 13, 13, 7, 20, 41, 22, 23, 23, 20, 13, 13, 13, 13, 13, 41, 14, 20, 13, 13, 20, 13, 20, 13 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const yytype_uint8 yyr1[] = { 0, 26, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 30, 30, 30, 30, 31, 31, 31, 31, 31, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 33, 33, 34, 34, 34, 34, 35, 36, 36, 37, 37, 37, 37, 37, 38, 38, 39, 39, 39, 40, 41, 41 }; /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ static const yytype_uint8 yyr2[] = { 0, 2, 0, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 4, 6, 2, 1, 1, 2, 1, 2, 2, 3, 2, 3, 5, 1, 5, 5, 2, 4, 2, 1, 3, 2, 3, 11, 3, 7, 2, 4, 2, 1, 3, 2, 2, 3, 1, 1, 1, 1, 1, 1, 1, 0, 1 }; #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYEMPTY (-2) #define YYEOF 0 #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY) \ { \ yychar = (Token); \ yylval = (Value); \ YYPOPSTACK (yylen); \ yystate = *yyssp; \ goto yybackup; \ } \ else \ { \ yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \ YYERROR; \ } \ while (0) /* Error token number */ #define YYTERROR 1 #define YYERRCODE 256 /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ #ifndef YYLLOC_DEFAULT # define YYLLOC_DEFAULT(Current, Rhs, N) \ do \ if (N) \ { \ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ } \ else \ { \ (Current).first_line = (Current).last_line = \ YYRHSLOC (Rhs, 0).last_line; \ (Current).first_column = (Current).last_column = \ YYRHSLOC (Rhs, 0).last_column; \ } \ while (0) #endif #define YYRHSLOC(Rhs, K) ((Rhs)[K]) /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (0) /* YY_LOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ #ifndef YY_LOCATION_PRINT # if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL /* Print *YYLOCP on YYO. Private, do not rely on its existence. */ YY_ATTRIBUTE_UNUSED static unsigned yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) { unsigned res = 0; int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; if (0 <= yylocp->first_line) { res += YYFPRINTF (yyo, "%d", yylocp->first_line); if (0 <= yylocp->first_column) res += YYFPRINTF (yyo, ".%d", yylocp->first_column); } if (0 <= yylocp->last_line) { if (yylocp->first_line < yylocp->last_line) { res += YYFPRINTF (yyo, "-%d", yylocp->last_line); if (0 <= end_col) res += YYFPRINTF (yyo, ".%d", end_col); } else if (0 <= end_col && yylocp->first_column < end_col) res += YYFPRINTF (yyo, "-%d", end_col); } return res; } # define YY_LOCATION_PRINT(File, Loc) \ yy_location_print_ (File, &(Loc)) # else # define YY_LOCATION_PRINT(File, Loc) ((void) 0) # endif #endif # define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yy_symbol_print (stderr, \ Type, Value, Location, info); \ YYFPRINTF (stderr, "\n"); \ } \ } while (0) /*----------------------------------------. | Print this symbol's value on YYOUTPUT. | `----------------------------------------*/ static void yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info) { FILE *yyo = yyoutput; YYUSE (yyo); YYUSE (yylocationp); YYUSE (info); if (!yyvaluep) return; # ifdef YYPRINT if (yytype < YYNTOKENS) YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); # endif YYUSE (yytype); } /*--------------------------------. | Print this symbol on YYOUTPUT. | `--------------------------------*/ static void yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info) { YYFPRINTF (yyoutput, "%s %s (", yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]); YY_LOCATION_PRINT (yyoutput, *yylocationp); YYFPRINTF (yyoutput, ": "); yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info); YYFPRINTF (yyoutput, ")"); } /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ static void yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) { int yybot = *yybottom; YYFPRINTF (stderr, " %d", yybot); } YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ static void yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info) { unsigned long yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, yystos[yyssp[yyi + 1 - yynrhs]], &(yyvsp[(yyi + 1) - (yynrhs)]) , &(yylsp[(yyi + 1) - (yynrhs)]) , info); YYFPRINTF (stderr, "\n"); } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (yyssp, yyvsp, yylsp, Rule, info); \ } while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) # define YY_SYMBOL_PRINT(Title, Type, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif #if YYERROR_VERBOSE # ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H # define yystrlen strlen # else /* Return the length of YYSTR. */ static YYSIZE_T yystrlen (const char *yystr) { YYSIZE_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; } # endif # endif # ifndef yystpcpy # if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ static char * yystpcpy (char *yydest, const char *yysrc) { char *yyd = yydest; const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif # endif # ifndef yytnamerr /* Copy to YYRES the contents of YYSTR after stripping away unnecessary quotes and backslashes, so that it's suitable for yyerror. The heuristic is that double-quoting is unnecessary unless the string contains an apostrophe, a comma, or backslash (other than backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ static YYSIZE_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { YYSIZE_T yyn = 0; char const *yyp = yystr; for (;;) switch (*++yyp) { case '\'': case ',': goto do_not_strip_quotes; case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; /* Fall through. */ default: if (yyres) yyres[yyn] = *yyp; yyn++; break; case '"': if (yyres) yyres[yyn] = '\0'; return yyn; } do_not_strip_quotes: ; } if (! yyres) return yystrlen (yystr); return yystpcpy (yyres, yystr) - yyres; } # endif /* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message about the unexpected token YYTOKEN for the state stack whose top is YYSSP. Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is not large enough to hold the message. In that case, also set *YYMSG_ALLOC to the required number of bytes. Return 2 if the required number of bytes is too large to store. */ static int yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, yytype_int16 *yyssp, int yytoken) { YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]); YYSIZE_T yysize = yysize0; enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; /* Internationalized format string. */ const char *yyformat = YY_NULLPTR; /* Arguments of yyformat. */ char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; /* Number of reported tokens (one for the "unexpected", one per "expected"). */ int yycount = 0; /* There are many possibilities here to consider: - If this state is a consistent state with a default action, then the only way this function was invoked is if the default action is an error action. In that case, don't check for expected tokens because there are none. - The only way there can be no lookahead present (in yychar) is if this state is a consistent state with a default action. Thus, detecting the absence of a lookahead is sufficient to determine that there is no unexpected or expected token to report. In that case, just report a simple "syntax error". - Don't assume there isn't a lookahead just because this state is a consistent state with a default action. There might have been a previous inconsistent state, consistent state with a non-default action, or user semantic action that manipulated yychar. - Of course, the expected token list depends on states to have correct lookahead information, and it depends on the parser not to perform extra reductions after fetching a lookahead from the scanner and before detecting a syntax error. Thus, state merging (from LALR or IELR) and default reductions corrupt the expected token list. However, the list is correct for canonical LR with one exception: it will still contain any token that will not be accepted due to an error action in a later state. */ if (yytoken != YYEMPTY) { int yyn = yypact[*yyssp]; yyarg[yycount++] = yytname[yytoken]; if (!yypact_value_is_default (yyn)) { /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. In other words, skip the first -YYN actions for this state because they are default actions. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn + 1; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yyx; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR && !yytable_value_is_error (yytable[yyx + yyn])) { if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) { yycount = 1; yysize = yysize0; break; } yyarg[yycount++] = yytname[yyx]; { YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]); if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) return 2; yysize = yysize1; } } } } switch (yycount) { # define YYCASE_(N, S) \ case N: \ yyformat = S; \ break default: /* Avoid compiler warnings. */ YYCASE_(0, YY_("syntax error")); YYCASE_(1, YY_("syntax error, unexpected %s")); YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); # undef YYCASE_ } { YYSIZE_T yysize1 = yysize + yystrlen (yyformat); if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) return 2; yysize = yysize1; } if (*yymsg_alloc < yysize) { *yymsg_alloc = 2 * yysize; if (! (yysize <= *yymsg_alloc && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; return 1; } /* Avoid sprintf, as that infringes on the user's name space. Don't have undefined behavior even if the translation produced a string with the wrong number of "%s"s. */ { char *yyp = *yymsg; int yyi = 0; while ((*yyp = *yyformat) != '\0') if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) { yyp += yytnamerr (yyp, yyarg[yyi++]); yyformat += 2; } else { yyp++; yyformat++; } } return 0; } #endif /* YYERROR_VERBOSE */ /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ static void yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info) { YYUSE (yyvaluep); YYUSE (yylocationp); YYUSE (info); if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YYUSE (yytype); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*----------. | yyparse. | `----------*/ int yyparse (DateInfo* info) { /* The lookahead symbol. */ int yychar; /* The semantic value of the lookahead symbol. */ /* Default value used for initialization, for pacifying older GCCs or non-GCC compilers. */ YY_INITIAL_VALUE (static YYSTYPE yyval_default;) YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default); /* Location data for the lookahead symbol. */ static YYLTYPE yyloc_default # if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL = { 1, 1, 1, 1 } # endif ; YYLTYPE yylloc = yyloc_default; int yystate; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus; /* The stacks and their tools: 'yyss': related to states. 'yyvs': related to semantic values. 'yyls': related to locations. Refer to the stacks through separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* The state stack. */ yytype_int16 yyssa[YYINITDEPTH]; yytype_int16 *yyss; yytype_int16 *yyssp; /* The semantic value stack. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs; YYSTYPE *yyvsp; /* The location stack. */ YYLTYPE yylsa[YYINITDEPTH]; YYLTYPE *yyls; YYLTYPE *yylsp; /* The locations where the error started and ended. */ YYLTYPE yyerror_range[3]; YYSIZE_T yystacksize; int yyn; int yyresult; /* Lookahead token as an internal (translated) token number. */ int yytoken = 0; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; YYLTYPE yyloc; #if YYERROR_VERBOSE /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; YYSIZE_T yymsg_alloc = sizeof yymsgbuf; #endif #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; yyssp = yyss = yyssa; yyvsp = yyvs = yyvsa; yylsp = yyls = yylsa; yystacksize = YYINITDEPTH; YYDPRINTF ((stderr, "Starting parse\n")); yystate = 0; yyerrstatus = 0; yychar = YYEMPTY; /* Cause a token to be read. */ yylsp[0] = yylloc; goto yysetstate; /*------------------------------------------------------------. | yynewstate -- Push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; yysetstate: *yyssp = yystate; if (yyss + yystacksize - 1 <= yyssp) { /* Get the current used size of the three stacks, in elements. */ YYSIZE_T yysize = yyssp - yyss + 1; #ifdef yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ YYSTYPE *yyvs1 = yyvs; yytype_int16 *yyss1 = yyss; YYLTYPE *yyls1 = yyls; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), &yyss1, yysize * sizeof (*yyssp), &yyvs1, yysize * sizeof (*yyvsp), &yyls1, yysize * sizeof (*yylsp), &yystacksize); yyls = yyls1; yyss = yyss1; yyvs = yyvs1; } #else /* no yyoverflow */ # ifndef YYSTACK_RELOCATE goto yyexhaustedlab; # else /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) goto yyexhaustedlab; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { yytype_int16 *yyss1 = yyss; union yyalloc *yyptr = (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); if (! yyptr) goto yyexhaustedlab; YYSTACK_RELOCATE (yyss_alloc, yyss); YYSTACK_RELOCATE (yyvs_alloc, yyvs); YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif #endif /* no yyoverflow */ yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; yylsp = yyls + yysize - 1; YYDPRINTF ((stderr, "Stack size increased to %lu\n", (unsigned long) yystacksize)); if (yyss + yystacksize - 1 <= yyssp) YYABORT; } YYDPRINTF ((stderr, "Entering state %d\n", yystate)); if (yystate == YYFINAL) YYACCEPT; goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. Read a lookahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yypact_value_is_default (yyn)) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token: ")); yychar = yylex (&yylval, &yylloc, info); } if (yychar <= YYEOF) { yychar = yytoken = YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yytable_value_is_error (yyn)) goto yyerrlab; yyn = -yyn; goto yyreduce; } /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); /* Discard the shifted token. */ yychar = YYEMPTY; yystate = yyn; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END *++yylsp = yylloc; goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- Do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: '$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; /* Default location. */ YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen); yyerror_range[1] = yyloc; YY_REDUCE_PRINT (yyn); switch (yyn) { case 4: { yyHaveTime++; } break; case 5: { yyHaveZone++; } break; case 6: { yyHaveDate++; } break; case 7: { yyHaveOrdinalMonth++; } break; case 8: { yyHaveDay++; } break; case 9: { yyHaveRel++; } break; case 10: { yyHaveTime++; yyHaveDate++; } break; case 11: { yyHaveTime++; yyHaveDate++; yyHaveRel++; } break; case 13: { yyHour = (yyvsp[-1].Number); yyMinutes = 0; yySeconds = 0; yyMeridian = (yyvsp[0].Meridian); } break; case 14: { yyHour = (yyvsp[-3].Number); yyMinutes = (yyvsp[-1].Number); yySeconds = 0; yyMeridian = (yyvsp[0].Meridian); } break; case 15: { yyHour = (yyvsp[-5].Number); yyMinutes = (yyvsp[-3].Number); yySeconds = (yyvsp[-1].Number); yyMeridian = (yyvsp[0].Meridian); } break; case 16: { yyTimezone = (yyvsp[-1].Number); if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100); yyDSTmode = DSTon; } break; case 17: { yyTimezone = (yyvsp[0].Number); if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100); yyDSTmode = DSToff; } break; case 18: { yyTimezone = (yyvsp[0].Number); yyDSTmode = DSTon; } break; case 19: { yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); yyDSTmode = DSToff; } break; case 20: { yyDayOrdinal = 1; yyDayNumber = (yyvsp[0].Number); } break; case 21: { yyDayOrdinal = 1; yyDayNumber = (yyvsp[-1].Number); } break; case 22: { yyDayOrdinal = (yyvsp[-1].Number); yyDayNumber = (yyvsp[0].Number); } break; case 23: { yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number); yyDayNumber = (yyvsp[0].Number); } break; case 24: { yyDayOrdinal = 2; yyDayNumber = (yyvsp[0].Number); } break; case 25: { yyMonth = (yyvsp[-2].Number); yyDay = (yyvsp[0].Number); } break; case 26: { yyMonth = (yyvsp[-4].Number); yyDay = (yyvsp[-2].Number); yyYear = (yyvsp[0].Number); } break; case 27: { yyYear = (yyvsp[0].Number) / 10000; yyMonth = ((yyvsp[0].Number) % 10000)/100; yyDay = (yyvsp[0].Number) % 100; } break; case 28: { yyDay = (yyvsp[-4].Number); yyMonth = (yyvsp[-2].Number); yyYear = (yyvsp[0].Number); } break; case 29: { yyMonth = (yyvsp[-2].Number); yyDay = (yyvsp[0].Number); yyYear = (yyvsp[-4].Number); } break; case 30: { yyMonth = (yyvsp[-1].Number); yyDay = (yyvsp[0].Number); } break; case 31: { yyMonth = (yyvsp[-3].Number); yyDay = (yyvsp[-2].Number); yyYear = (yyvsp[0].Number); } break; case 32: { yyMonth = (yyvsp[0].Number); yyDay = (yyvsp[-1].Number); } break; case 33: { yyMonth = 1; yyDay = 1; yyYear = EPOCH; } break; case 34: { yyMonth = (yyvsp[-1].Number); yyDay = (yyvsp[-2].Number); yyYear = (yyvsp[0].Number); } break; case 35: { yyMonthOrdinal = 1; yyMonth = (yyvsp[0].Number); } break; case 36: { yyMonthOrdinal = (yyvsp[-1].Number); yyMonth = (yyvsp[0].Number); } break; case 37: { if ((yyvsp[-5].Number) != HOUR( 7) + HOUR(100)) YYABORT; yyYear = (yyvsp[-10].Number); yyMonth = (yyvsp[-8].Number); yyDay = (yyvsp[-6].Number); yyHour = (yyvsp[-4].Number); yyMinutes = (yyvsp[-2].Number); yySeconds = (yyvsp[0].Number); } break; case 38: { if ((yyvsp[-1].Number) != HOUR( 7) + HOUR(100)) YYABORT; yyYear = (yyvsp[-2].Number) / 10000; yyMonth = ((yyvsp[-2].Number) % 10000)/100; yyDay = (yyvsp[-2].Number) % 100; yyHour = (yyvsp[0].Number) / 10000; yyMinutes = ((yyvsp[0].Number) % 10000)/100; yySeconds = (yyvsp[0].Number) % 100; } break; case 39: { if ((yyvsp[-5].Number) != HOUR( 7) + HOUR(100)) YYABORT; yyYear = (yyvsp[-6].Number) / 10000; yyMonth = ((yyvsp[-6].Number) % 10000)/100; yyDay = (yyvsp[-6].Number) % 100; yyHour = (yyvsp[-4].Number); yyMinutes = (yyvsp[-2].Number); yySeconds = (yyvsp[0].Number); } break; case 40: { yyYear = (yyvsp[-1].Number) / 10000; yyMonth = ((yyvsp[-1].Number) % 10000)/100; yyDay = (yyvsp[-1].Number) % 100; yyHour = (yyvsp[0].Number) / 10000; yyMinutes = ((yyvsp[0].Number) % 10000)/100; yySeconds = (yyvsp[0].Number) % 100; } break; case 41: { /* * Offset computed year by -377 so that the returned years will be * in a range accessible with a 32 bit clock seconds value. */ yyYear = (yyvsp[-2].Number)/1000 + 2323 - 377; yyDay = 1; yyMonth = 1; yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000; yyRelSeconds += (yyvsp[0].Number) * 144 * 60; } break; case 42: { yyRelSeconds *= -1; yyRelMonth *= -1; yyRelDay *= -1; } break; case 44: { *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); } break; case 45: { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); } break; case 46: { *yyRelPointer += (yyvsp[0].Number); } break; case 47: { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); } break; case 48: { *yyRelPointer += (yyvsp[0].Number); } break; case 49: { (yyval.Number) = -1; } break; case 50: { (yyval.Number) = 1; } break; case 51: { (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelSeconds; } break; case 52: { (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelDay; } break; case 53: { (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelMonth; } break; case 54: { if (yyHaveTime && yyHaveDate && !yyHaveRel) { yyYear = (yyvsp[0].Number); } else { yyHaveTime++; if (yyDigitCount <= 2) { yyHour = (yyvsp[0].Number); yyMinutes = 0; } else { yyHour = (yyvsp[0].Number) / 100; yyMinutes = (yyvsp[0].Number) % 100; } yySeconds = 0; yyMeridian = MER24; } } break; case 55: { (yyval.Meridian) = MER24; } break; case 56: { (yyval.Meridian) = (yyvsp[0].Meridian); } break; default: break; } /* User semantic actions sometimes alter yychar, and that requires that yytoken be updated with the new translation. We take the approach of translating immediately before every use of yytoken. One alternative is translating here after every semantic action, but that translation would be missed if the semantic action invokes YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an incorrect destructor might then be invoked immediately. In the case of YYERROR or YYBACKUP, subsequent parser actions might lead to an incorrect destructor call or verbose syntax error message before the lookahead is translated. */ YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); *++yyvsp = yyval; *++yylsp = yyloc; /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ yyn = yyr1[yyn]; yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) yystate = yytable[yystate]; else yystate = yydefgoto[yyn - YYNTOKENS]; goto yynewstate; /*--------------------------------------. | yyerrlab -- here on detecting error. | `--------------------------------------*/ yyerrlab: /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { #if ! YYERROR_VERBOSE yyerror (&yylloc, info, YY_("syntax error")); #else # define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ yyssp, yytoken) { char const *yymsgp = YY_("syntax error"); int yysyntax_error_status; yysyntax_error_status = YYSYNTAX_ERROR; if (yysyntax_error_status == 0) yymsgp = yymsg; else if (yysyntax_error_status == 1) { if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); if (!yymsg) { yymsg = yymsgbuf; yymsg_alloc = sizeof yymsgbuf; yysyntax_error_status = 2; } else { yysyntax_error_status = YYSYNTAX_ERROR; yymsgp = yymsg; } } yyerror (&yylloc, info, yymsgp); if (yysyntax_error_status == 2) goto yyexhaustedlab; } # undef YYSYNTAX_ERROR #endif } yyerror_range[1] = yylloc; if (yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= YYEOF) { /* Return failure if at end of input. */ if (yychar == YYEOF) YYABORT; } else { yydestruct ("Error: discarding", yytoken, &yylval, &yylloc, info); yychar = YYEMPTY; } } /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: /* Pacify compilers like GCC when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (/*CONSTCOND*/ 0) goto yyerrorlab; /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ for (;;) { yyn = yypact[yystate]; if (!yypact_value_is_default (yyn)) { yyn += YYTERROR; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yyerror_range[1] = *yylsp; yydestruct ("Error: popping", yystos[yystate], yyvsp, yylsp, info); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END yyerror_range[2] = yylloc; /* Using YYLLOC is tempting, but would change the location of the lookahead. YYLOC is available though. */ YYLLOC_DEFAULT (yyloc, yyerror_range, 2); *++yylsp = yyloc; /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturn; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturn; #if !defined yyoverflow || YYERROR_VERBOSE /*-------------------------------------------------. | yyexhaustedlab -- memory exhaustion comes here. | `-------------------------------------------------*/ yyexhaustedlab: yyerror (&yylloc, info, YY_("memory exhausted")); yyresult = 2; /* Fall through. */ #endif yyreturn: if (yychar != YYEMPTY) { /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = YYTRANSLATE (yychar); yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval, &yylloc, info); } /* Do not reclaim the symbols of the rule whose action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", yystos[*yyssp], yyvsp, yylsp, info); YYPOPSTACK (1); } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif #if YYERROR_VERBOSE if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); #endif return yyresult; } /* * Month and day table. */ static const TABLE MonthDayTable[] = { { "january", tMONTH, 1 }, { "february", tMONTH, 2 }, { "march", tMONTH, 3 }, { "april", tMONTH, 4 }, { "may", tMONTH, 5 }, { "june", tMONTH, 6 }, { "july", tMONTH, 7 }, { "august", tMONTH, 8 }, { "september", tMONTH, 9 }, { "sept", tMONTH, 9 }, { "october", tMONTH, 10 }, { "november", tMONTH, 11 }, { "december", tMONTH, 12 }, { "sunday", tDAY, 0 }, { "monday", tDAY, 1 }, { "tuesday", tDAY, 2 }, { "tues", tDAY, 2 }, { "wednesday", tDAY, 3 }, { "wednes", tDAY, 3 }, { "thursday", tDAY, 4 }, { "thur", tDAY, 4 }, { "thurs", tDAY, 4 }, { "friday", tDAY, 5 }, { "saturday", tDAY, 6 }, { NULL, 0, 0 } }; /* * Time units table. */ static const TABLE UnitsTable[] = { { "year", tMONTH_UNIT, 12 }, { "month", tMONTH_UNIT, 1 }, { "fortnight", tDAY_UNIT, 14 }, { "week", tDAY_UNIT, 7 }, { "day", tDAY_UNIT, 1 }, { "hour", tSEC_UNIT, 60 * 60 }, { "minute", tSEC_UNIT, 60 }, { "min", tSEC_UNIT, 60 }, { "second", tSEC_UNIT, 1 }, { "sec", tSEC_UNIT, 1 }, { NULL, 0, 0 } }; /* * Assorted relative-time words. */ static const TABLE OtherTable[] = { { "tomorrow", tDAY_UNIT, 1 }, { "yesterday", tDAY_UNIT, -1 }, { "today", tDAY_UNIT, 0 }, { "now", tSEC_UNIT, 0 }, { "last", tUNUMBER, -1 }, { "this", tSEC_UNIT, 0 }, { "next", tNEXT, 1 }, #if 0 { "first", tUNUMBER, 1 }, { "second", tUNUMBER, 2 }, { "third", tUNUMBER, 3 }, { "fourth", tUNUMBER, 4 }, { "fifth", tUNUMBER, 5 }, { "sixth", tUNUMBER, 6 }, { "seventh", tUNUMBER, 7 }, { "eighth", tUNUMBER, 8 }, { "ninth", tUNUMBER, 9 }, { "tenth", tUNUMBER, 10 }, { "eleventh", tUNUMBER, 11 }, { "twelfth", tUNUMBER, 12 }, #endif { "ago", tAGO, 1 }, { "epoch", tEPOCH, 0 }, { "stardate", tSTARDATE, 0 }, { NULL, 0, 0 } }; /* * The timezone table. (Note: This table was modified to not use any floating * point constants to work around an SGI compiler bug). */ static const TABLE TimezoneTable[] = { { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */ { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */ { "utc", tZONE, HOUR( 0) }, { "uct", tZONE, HOUR( 0) }, /* Universal Coordinated Time */ { "wet", tZONE, HOUR( 0) }, /* Western European */ { "bst", tDAYZONE, HOUR( 0) }, /* British Summer */ { "wat", tZONE, HOUR( 1) }, /* West Africa */ { "at", tZONE, HOUR( 2) }, /* Azores */ #if 0 /* For completeness. BST is also British Summer, and GST is * also Guam Standard. */ { "bst", tZONE, HOUR( 3) }, /* Brazil Standard */ { "gst", tZONE, HOUR( 3) }, /* Greenland Standard */ #endif { "nft", tZONE, HOUR( 7/2) }, /* Newfoundland */ { "nst", tZONE, HOUR( 7/2) }, /* Newfoundland Standard */ { "ndt", tDAYZONE, HOUR( 7/2) }, /* Newfoundland Daylight */ { "ast", tZONE, HOUR( 4) }, /* Atlantic Standard */ { "adt", tDAYZONE, HOUR( 4) }, /* Atlantic Daylight */ { "est", tZONE, HOUR( 5) }, /* Eastern Standard */ { "edt", tDAYZONE, HOUR( 5) }, /* Eastern Daylight */ { "cst", tZONE, HOUR( 6) }, /* Central Standard */ { "cdt", tDAYZONE, HOUR( 6) }, /* Central Daylight */ { "mst", tZONE, HOUR( 7) }, /* Mountain Standard */ { "mdt", tDAYZONE, HOUR( 7) }, /* Mountain Daylight */ { "pst", tZONE, HOUR( 8) }, /* Pacific Standard */ { "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */ { "yst", tZONE, HOUR( 9) }, /* Yukon Standard */ { "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */ { "hst", tZONE, HOUR(10) }, /* Hawaii Standard */ { "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */ { "cat", tZONE, HOUR(10) }, /* Central Alaska */ { "ahst", tZONE, HOUR(10) }, /* Alaska-Hawaii Standard */ { "nt", tZONE, HOUR(11) }, /* Nome */ { "idlw", tZONE, HOUR(12) }, /* International Date Line West */ { "cet", tZONE, -HOUR( 1) }, /* Central European */ { "cest", tDAYZONE, -HOUR( 1) }, /* Central European Summer */ { "met", tZONE, -HOUR( 1) }, /* Middle European */ { "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */ { "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */ { "swt", tZONE, -HOUR( 1) }, /* Swedish Winter */ { "sst", tDAYZONE, -HOUR( 1) }, /* Swedish Summer */ { "fwt", tZONE, -HOUR( 1) }, /* French Winter */ { "fst", tDAYZONE, -HOUR( 1) }, /* French Summer */ { "eet", tZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 */ { "bt", tZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 */ { "it", tZONE, -HOUR( 7/2) }, /* Iran */ { "zp4", tZONE, -HOUR( 4) }, /* USSR Zone 3 */ { "zp5", tZONE, -HOUR( 5) }, /* USSR Zone 4 */ { "ist", tZONE, -HOUR(11/2) }, /* Indian Standard */ { "zp6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */ #if 0 /* For completeness. NST is also Newfoundland Standard, and SST is * also Swedish Summer. */ { "nst", tZONE, -HOUR(13/2) }, /* North Sumatra */ { "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */ #endif /* 0 */ { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */ { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */ { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */ { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */ { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */ { "jdt", tDAYZONE, -HOUR( 9) }, /* Japan Daylight */ { "kst", tZONE, -HOUR( 9) }, /* Korea Standard */ { "kdt", tDAYZONE, -HOUR( 9) }, /* Korea Daylight */ { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */ { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */ { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */ { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */ { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */ { "nzt", tZONE, -HOUR(12) }, /* New Zealand */ { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */ { "nzdt", tDAYZONE, -HOUR(12) }, /* New Zealand Daylight */ { "idle", tZONE, -HOUR(12) }, /* International Date Line East */ /* ADDED BY Marco Nijdam */ { "dst", tDST, HOUR( 0) }, /* DST on (hour is ignored) */ /* End ADDED */ { NULL, 0, 0 } }; /* * Military timezone table. */ static const TABLE MilitaryTable[] = { { "a", tZONE, -HOUR( 1) + HOUR(100) }, { "b", tZONE, -HOUR( 2) + HOUR(100) }, { "c", tZONE, -HOUR( 3) + HOUR(100) }, { "d", tZONE, -HOUR( 4) + HOUR(100) }, { "e", tZONE, -HOUR( 5) + HOUR(100) }, { "f", tZONE, -HOUR( 6) + HOUR(100) }, { "g", tZONE, -HOUR( 7) + HOUR(100) }, { "h", tZONE, -HOUR( 8) + HOUR(100) }, { "i", tZONE, -HOUR( 9) + HOUR(100) }, { "k", tZONE, -HOUR(10) + HOUR(100) }, { "l", tZONE, -HOUR(11) + HOUR(100) }, { "m", tZONE, -HOUR(12) + HOUR(100) }, { "n", tZONE, HOUR( 1) + HOUR(100) }, { "o", tZONE, HOUR( 2) + HOUR(100) }, { "p", tZONE, HOUR( 3) + HOUR(100) }, { "q", tZONE, HOUR( 4) + HOUR(100) }, { "r", tZONE, HOUR( 5) + HOUR(100) }, { "s", tZONE, HOUR( 6) + HOUR(100) }, { "t", tZONE, HOUR( 7) + HOUR(100) }, { "u", tZONE, HOUR( 8) + HOUR(100) }, { "v", tZONE, HOUR( 9) + HOUR(100) }, { "w", tZONE, HOUR( 10) + HOUR(100) }, { "x", tZONE, HOUR( 11) + HOUR(100) }, { "y", tZONE, HOUR( 12) + HOUR(100) }, { "z", tZONE, HOUR( 0) + HOUR(100) }, { NULL, 0, 0 } }; /* * Dump error messages in the bit bucket. */ static void TclDateerror( YYLTYPE* location, DateInfo* infoPtr, const char *s) { Tcl_Obj* t; Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1); Tcl_AppendToObj(infoPtr->messages, s, -1); Tcl_AppendToObj(infoPtr->messages, " (characters ", -1); TclNewIntObj(t, location->first_column); Tcl_IncrRefCount(t); Tcl_AppendObjToObj(infoPtr->messages, t); Tcl_DecrRefCount(t); Tcl_AppendToObj(infoPtr->messages, "-", -1); TclNewIntObj(t, location->last_column); Tcl_IncrRefCount(t); Tcl_AppendObjToObj(infoPtr->messages, t); Tcl_DecrRefCount(t); Tcl_AppendToObj(infoPtr->messages, ")", -1); infoPtr->separatrix = "\n"; } static time_t ToSeconds( time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian) { if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) { return -1; } switch (Meridian) { case MER24: if (Hours < 0 || Hours > 23) { return -1; } return (Hours * 60L + Minutes) * 60L + Seconds; case MERam: if (Hours < 1 || Hours > 12) { return -1; } return ((Hours % 12) * 60L + Minutes) * 60L + Seconds; case MERpm: if (Hours < 1 || Hours > 12) { return -1; } return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds; } return -1; /* Should never be reached */ } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { char *p; char *q; const TABLE *tp; int i, abbrev; /* * Make it lowercase. */ Tcl_UtfToLower(buff); if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) { yylvalPtr->Meridian = MERam; return tMERIDIAN; } if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) { yylvalPtr->Meridian = MERpm; return tMERIDIAN; } /* * See if we have an abbreviation for a month. */ if (strlen(buff) == 3) { abbrev = 1; } else if (strlen(buff) == 4 && buff[3] == '.') { abbrev = 1; buff[3] = '\0'; } else { abbrev = 0; } for (tp = MonthDayTable; tp->name; tp++) { if (abbrev) { if (strncmp(buff, tp->name, 3) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } else if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } for (tp = TimezoneTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } for (tp = UnitsTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } /* * Strip off any plural and try the units table again. */ i = strlen(buff) - 1; if (i > 0 && buff[i] == 's') { buff[i] = '\0'; for (tp = UnitsTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } } for (tp = OtherTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } /* * Military timezones. */ if (buff[1] == '\0' && !(*buff & 0x80) && isalpha(UCHAR(*buff))) { /* INTL: ISO only */ for (tp = MilitaryTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } } /* * Drop out any periods and try the timezone table again. */ for (i = 0, p = q = buff; *q; q++) { if (*q != '.') { *p++ = *q; } else { i++; } } *p = '\0'; if (i) { for (tp = TimezoneTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } } return tID; } static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { char c; char *p; char buff[20]; int Count; location->first_column = yyInput - info->dateStart; for ( ; ; ) { while (TclIsSpaceProcM(*yyInput)) { yyInput++; } if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ /* * Convert the string into a number; count the number of digits. */ Count = 0; for (yylvalPtr->Number = 0; isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */ yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0'; Count++; } yyInput--; yyDigitCount = Count; /* * A number with 6 or more digits is considered an ISO 8601 base. */ if (Count >= 6) { location->last_column = yyInput - info->dateStart - 1; return tISOBASE; } else { location->last_column = yyInput - info->dateStart - 1; return tUNUMBER; } } if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */ for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */ || c == '.'; ) { if (p < &buff[sizeof buff - 1]) { *p++ = c; } } *p = '\0'; yyInput--; location->last_column = yyInput - info->dateStart - 1; return LookupWord(yylvalPtr, buff); } if (c != '(') { location->last_column = yyInput - info->dateStart; return *yyInput++; } Count = 0; do { c = *yyInput++; if (c == '\0') { location->last_column = yyInput - info->dateStart - 1; return c; } else if (c == '(') { Count++; } else if (c == ')') { Count--; } } while (Count > 0); } } int TclClockOldscanObjCmd( void *dummy, /* Unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Count of parameters */ Tcl_Obj *const *objv) /* Parameters */ { Tcl_Obj *result, *resultElement; int yr, mo, da; DateInfo dateInfo; DateInfo* info = &dateInfo; int status; (void)dummy; if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "stringToParse baseYear baseMonth baseDay" ); return TCL_ERROR; } yyInput = Tcl_GetString( objv[1] ); dateInfo.dateStart = yyInput; yyHaveDate = 0; if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { return TCL_ERROR; } yyYear = yr; yyMonth = mo; yyDay = da; yyHaveTime = 0; yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; yyHaveZone = 0; yyTimezone = 0; yyDSTmode = DSTmaybe; yyHaveOrdinalMonth = 0; yyMonthOrdinal = 0; yyHaveDay = 0; yyDayOrdinal = 0; yyDayNumber = 0; yyHaveRel = 0; yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL; TclNewObj(dateInfo.messages); dateInfo.separatrix = ""; Tcl_IncrRefCount(dateInfo.messages); status = yyparse(&dateInfo); if (status == 1) { Tcl_SetObjResult(interp, dateInfo.messages); Tcl_DecrRefCount(dateInfo.messages); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); return TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); Tcl_DecrRefCount(dateInfo.messages); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else if (status != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned " "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); Tcl_DecrRefCount(dateInfo.messages); Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); return TCL_ERROR; } Tcl_DecrRefCount(dateInfo.messages); if (yyHaveDate > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one date in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } if (yyHaveTime > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one time of day in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } if (yyHaveZone > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one time zone in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } if (yyHaveDay > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one weekday in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } if (yyHaveOrdinalMonth > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one ordinal month in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } TclNewObj(result); TclNewObj(resultElement); if (yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyYear)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyMonth)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyDay)); } Tcl_ListObjAppendElement(interp, result, resultElement); if (yyHaveTime) { Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian))); } else { Tcl_ListObjAppendElement(interp, result, Tcl_NewObj()); } TclNewObj(resultElement); if (yyHaveZone) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) -yyTimezone)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj(1 - yyDSTmode)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveRel) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyRelMonth)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyRelDay)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyRelSeconds)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveDay && !yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyDayOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyDayNumber)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyMonthOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyMonth)); } Tcl_ListObjAppendElement(interp, result, resultElement); Tcl_SetObjResult(interp, result); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclDecls.h0000644000175000017500000052671314566153372015211 0ustar sergeisergei/* * tclDecls.h -- * * Declarations of functions in the platform independent public Tcl API. * * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLDECLS #define _TCLDECLS #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tcl.decls script. */ /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ /* 0 */ EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 1 */ EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 2 */ EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ EXTERN char * Tcl_Alloc(unsigned int size); /* 4 */ EXTERN void Tcl_Free(char *ptr); /* 5 */ EXTERN char * Tcl_Realloc(char *ptr, unsigned int size); /* 6 */ EXTERN char * Tcl_DbCkalloc(unsigned int size, const char *file, int line); /* 7 */ EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line); /* 8 */ EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size, const char *file, int line); #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 10 */ EXTERN void Tcl_DeleteFileHandler(int fd); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 10 */ EXTERN void Tcl_DeleteFileHandler(int fd); #endif /* MACOSX */ /* 11 */ EXTERN void Tcl_SetTimer(const Tcl_Time *timePtr); /* 12 */ EXTERN void Tcl_Sleep(int ms); /* 13 */ EXTERN int Tcl_WaitForEvent(const Tcl_Time *timePtr); /* 14 */ EXTERN int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 15 */ EXTERN void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...); /* 16 */ EXTERN void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length); /* 17 */ EXTERN Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]); /* 18 */ EXTERN int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 19 */ EXTERN void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, int line); /* 20 */ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line); /* 21 */ EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); /* 22 */ EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int intValue, const char *file, int line); /* 23 */ EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line); /* 24 */ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, const char *file, int line); /* 25 */ EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, const char *file, int line); /* 26 */ EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file, int line); /* 27 */ EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line); /* 28 */ EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, const char *file, int line); /* 29 */ EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); /* 30 */ EXTERN void TclFreeObj(Tcl_Obj *objPtr); /* 31 */ EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *intPtr); /* 32 */ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 33 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr); /* 34 */ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr); /* 35 */ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 36 */ EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 37 */ EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr); /* 38 */ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 39 */ EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 40 */ EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 42 */ EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ EXTERN int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 44 */ EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 45 */ EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 46 */ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 47 */ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 48 */ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 49 */ EXTERN Tcl_Obj * Tcl_NewBooleanObj(int intValue); /* 50 */ EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, int numBytes); /* 51 */ EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); /* 52 */ EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue); /* 53 */ EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); /* 54 */ EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue); /* 55 */ EXTERN Tcl_Obj * Tcl_NewObj(void); /* 56 */ EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); /* 57 */ EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue); /* 58 */ EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int numBytes); /* 59 */ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, int numBytes); /* 60 */ EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); /* 61 */ EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); /* 62 */ EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 63 */ EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue); /* 64 */ EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length); /* 65 */ EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length); /* 66 */ EXTERN void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message); /* 67 */ EXTERN void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, int length); /* 68 */ EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp); /* 69 */ EXTERN void Tcl_AppendElement(Tcl_Interp *interp, const char *element); /* 70 */ EXTERN void Tcl_AppendResult(Tcl_Interp *interp, ...); /* 71 */ EXTERN Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, ClientData clientData); /* 72 */ EXTERN void Tcl_AsyncDelete(Tcl_AsyncHandler async); /* 73 */ EXTERN int Tcl_AsyncInvoke(Tcl_Interp *interp, int code); /* 74 */ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async); /* 75 */ EXTERN int Tcl_AsyncReady(void); /* 76 */ EXTERN void Tcl_BackgroundError(Tcl_Interp *interp); /* 77 */ EXTERN char Tcl_Backslash(const char *src, int *readPtr); /* 78 */ EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList); /* 79 */ EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 80 */ EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData); /* 81 */ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); /* 82 */ EXTERN int Tcl_CommandComplete(const char *cmd); /* 83 */ EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv); /* 84 */ EXTERN int Tcl_ConvertElement(const char *src, char *dst, int flags); /* 85 */ EXTERN int Tcl_ConvertCountedElement(const char *src, int length, char *dst, int flags); /* 86 */ EXTERN int Tcl_CreateAlias(Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 87 */ EXTERN int Tcl_CreateAliasObj(Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 88 */ EXTERN Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 89 */ EXTERN void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 90 */ EXTERN void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 91 */ EXTERN Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 92 */ EXTERN void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 93 */ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); /* 95 */ EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 96 */ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 97 */ EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *name, int isSafe); /* 98 */ EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 99 */ EXTERN Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 100 */ EXTERN void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name); /* 101 */ EXTERN void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 102 */ EXTERN void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 103 */ EXTERN int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName); /* 104 */ EXTERN int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command); /* 105 */ EXTERN void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData); /* 106 */ EXTERN void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 107 */ EXTERN void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 108 */ EXTERN void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); /* 109 */ EXTERN void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr); /* 110 */ EXTERN void Tcl_DeleteInterp(Tcl_Interp *interp); /* 111 */ EXTERN void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr); /* 112 */ EXTERN void Tcl_DeleteTimerHandler(Tcl_TimerToken token); /* 113 */ EXTERN void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); /* 114 */ EXTERN void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 115 */ EXTERN int Tcl_DoOneEvent(int flags); /* 116 */ EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData); /* 117 */ EXTERN char * Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length); /* 118 */ EXTERN char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element); /* 119 */ EXTERN void Tcl_DStringEndSublist(Tcl_DString *dsPtr); /* 120 */ EXTERN void Tcl_DStringFree(Tcl_DString *dsPtr); /* 121 */ EXTERN void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 122 */ EXTERN void Tcl_DStringInit(Tcl_DString *dsPtr); /* 123 */ EXTERN void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 124 */ EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); /* 125 */ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ EXTERN int Tcl_Eof(Tcl_Channel chan); /* 127 */ EXTERN CONST84_RETURN char * Tcl_ErrnoId(void); /* 128 */ EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err); /* 129 */ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); /* 130 */ EXTERN int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName); /* 131 */ EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 132 */ EXTERN void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc); /* 133 */ EXTERN TCL_NORETURN void Tcl_Exit(int status); /* 134 */ EXTERN int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 135 */ EXTERN int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr, int *ptr); /* 136 */ EXTERN int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 137 */ EXTERN int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr, double *ptr); /* 138 */ EXTERN int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 139 */ EXTERN int Tcl_ExprLong(Tcl_Interp *interp, const char *expr, long *ptr); /* 140 */ EXTERN int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 141 */ EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 142 */ EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr); /* 143 */ EXTERN void Tcl_Finalize(void); /* 144 */ EXTERN void Tcl_FindExecutable(const char *argv0); /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); /* 147 */ EXTERN void Tcl_FreeResult(Tcl_Interp *interp); /* 148 */ EXTERN int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 149 */ EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 151 */ EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName, int *modePtr); /* 152 */ EXTERN int Tcl_GetChannelBufferSize(Tcl_Channel chan); /* 153 */ EXTERN int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, ClientData *handlePtr); /* 154 */ EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan); /* 157 */ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 158 */ EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); /* 159 */ EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 160 */ EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command); /* 161 */ EXTERN int Tcl_GetErrno(void); /* 162 */ EXTERN CONST84_RETURN char * Tcl_GetHostName(void); /* 163 */ EXTERN int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *childInterp); /* 164 */ EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp); /* 165 */ EXTERN const char * Tcl_GetNameOfExecutable(void); /* 166 */ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); #endif /* MACOSX */ /* 168 */ EXTERN Tcl_PathType Tcl_GetPathType(const char *path); /* 169 */ EXTERN int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); /* 170 */ EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 171 */ EXTERN int Tcl_GetServiceMode(void); /* 172 */ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, const char *name); /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel(int type); /* 174 */ EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp); /* 175 */ EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags); /* 176 */ EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 177 */ EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, const char *command); /* 178 */ EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 179 */ EXTERN int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 180 */ EXTERN int Tcl_Init(Tcl_Interp *interp); /* 181 */ EXTERN void Tcl_InitHashTable(Tcl_HashTable *tablePtr, int keyType); /* 182 */ EXTERN int Tcl_InputBlocked(Tcl_Channel chan); /* 183 */ EXTERN int Tcl_InputBuffered(Tcl_Channel chan); /* 184 */ EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp); /* 185 */ EXTERN int Tcl_IsSafe(Tcl_Interp *interp); /* 186 */ EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 187 */ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr, int type); /* Slot 188 is reserved */ /* 189 */ EXTERN Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); /* 190 */ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); /* 192 */ EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv); /* 193 */ EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr); /* 194 */ EXTERN void Tcl_NotifyChannel(Tcl_Channel channel, int mask); /* 195 */ EXTERN Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 196 */ EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 197 */ EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 198 */ EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 199 */ EXTERN Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int flags); /* 200 */ EXTERN Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 201 */ EXTERN void Tcl_Preserve(ClientData data); /* 202 */ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst); /* 203 */ EXTERN int Tcl_PutEnv(const char *assignment); /* 204 */ EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp); /* 205 */ EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position); /* 206 */ EXTERN int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead); /* 207 */ EXTERN void Tcl_ReapDetachedProcs(void); /* 208 */ EXTERN int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags); /* 209 */ EXTERN int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 210 */ EXTERN void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 211 */ EXTERN void Tcl_RegisterObjType(const Tcl_ObjType *typePtr); /* 212 */ EXTERN Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, const char *pattern); /* 213 */ EXTERN int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 214 */ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 216 */ EXTERN void Tcl_Release(ClientData clientData); /* 217 */ EXTERN void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ EXTERN int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr); /* 220 */ EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode); /* 221 */ EXTERN int Tcl_ServiceAll(void); /* 222 */ EXTERN int Tcl_ServiceEvent(int flags); /* 223 */ EXTERN void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 224 */ EXTERN void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); /* 225 */ EXTERN int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 226 */ EXTERN int Tcl_SetCommandInfo(Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 227 */ EXTERN void Tcl_SetErrno(int err); /* 228 */ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); /* 230 */ EXTERN void Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 231 */ EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); /* 232 */ EXTERN void Tcl_SetResult(Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 233 */ EXTERN int Tcl_SetServiceMode(int mode); /* 234 */ EXTERN void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 235 */ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 236 */ EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); /* 237 */ EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 238 */ EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 239 */ EXTERN CONST84_RETURN char * Tcl_SignalId(int sig); /* 240 */ EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig); /* 241 */ EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ EXTERN int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 243 */ EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 244 */ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 245 */ EXTERN int Tcl_StringMatch(const char *str, const char *pattern); /* 246 */ EXTERN int Tcl_TellOld(Tcl_Channel chan); /* 247 */ EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ EXTERN int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 249 */ EXTERN char * Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 250 */ EXTERN int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead); /* 251 */ EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName); /* 252 */ EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 253 */ EXTERN int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags); /* 254 */ EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 255 */ EXTERN void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 257 */ EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName); /* 258 */ EXTERN int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 259 */ EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 260 */ EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...); /* 261 */ EXTERN ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ EXTERN ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 263 */ EXTERN int Tcl_Write(Tcl_Channel chan, const char *s, int slen); /* 264 */ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 265 */ EXTERN int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ EXTERN void Tcl_ValidateAllMemory(const char *file, int line); /* 267 */ EXTERN void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList); /* 268 */ EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList); /* 269 */ EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 271 */ EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, const char *version, int exact); /* 272 */ EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 273 */ EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, const char *version); /* 274 */ EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact); /* 275 */ EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList); /* 276 */ EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); /* 277 */ EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); /* 278 */ EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList); /* 279 */ EXTERN void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type); /* 280 */ EXTERN void Tcl_InitMemory(Tcl_Interp *interp); /* 281 */ EXTERN Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 282 */ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 283 */ EXTERN Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan); /* 284 */ EXTERN void Tcl_SetMainLoop(Tcl_MainLoopProc *proc); /* Slot 285 is reserved */ /* 286 */ EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 287 */ EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); /* 288 */ EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 289 */ EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 290 */ EXTERN void Tcl_DiscardResult(Tcl_SavedResult *statePtr); /* 291 */ EXTERN int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 292 */ EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 293 */ EXTERN int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 294 */ EXTERN void Tcl_ExitThread(int status); /* 295 */ EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 296 */ EXTERN char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 297 */ EXTERN void Tcl_FinalizeThread(void); /* 298 */ EXTERN void Tcl_FinalizeNotifier(ClientData clientData); /* 299 */ EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding); /* 300 */ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void); /* 301 */ EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name); /* 302 */ EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding); /* 303 */ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 305 */ EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size); /* 306 */ EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 307 */ EXTERN ClientData Tcl_InitNotifier(void); /* 308 */ EXTERN void Tcl_MutexLock(Tcl_Mutex *mutexPtr); /* 309 */ EXTERN void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr); /* 310 */ EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr); /* 311 */ EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 312 */ EXTERN int Tcl_NumUtfChars(const char *src, int length); /* 313 */ EXTERN int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 314 */ EXTERN void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ EXTERN void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 316 */ EXTERN int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name); /* 317 */ EXTERN Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 318 */ EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId); /* 319 */ EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 320 */ EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index); /* 321 */ EXTERN Tcl_UniChar Tcl_UniCharToLower(int ch); /* 322 */ EXTERN Tcl_UniChar Tcl_UniCharToTitle(int ch); /* 323 */ EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index); /* 326 */ EXTERN int Tcl_UtfCharComplete(const char *src, int length); /* 327 */ EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch); /* 329 */ EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch); /* 330 */ EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src); /* 331 */ EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start); /* 332 */ EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 333 */ EXTERN char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 334 */ EXTERN int Tcl_UtfToLower(char *src); /* 335 */ EXTERN int Tcl_UtfToTitle(char *src); /* 336 */ EXTERN int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr); /* 337 */ EXTERN int Tcl_UtfToUpper(char *src); /* 338 */ EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen); /* 339 */ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); /* 341 */ EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void); /* 342 */ EXTERN void Tcl_SetDefaultEncodingDir(const char *path); /* 343 */ EXTERN void Tcl_AlertNotifier(ClientData clientData); /* 344 */ EXTERN void Tcl_ServiceModeHook(int mode); /* 345 */ EXTERN int Tcl_UniCharIsAlnum(int ch); /* 346 */ EXTERN int Tcl_UniCharIsAlpha(int ch); /* 347 */ EXTERN int Tcl_UniCharIsDigit(int ch); /* 348 */ EXTERN int Tcl_UniCharIsLower(int ch); /* 349 */ EXTERN int Tcl_UniCharIsSpace(int ch); /* 350 */ EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); /* 352 */ EXTERN int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 354 */ EXTERN char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 355 */ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr); /* 356 */ EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 357 */ EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 358 */ EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr); /* 359 */ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, int length); /* 360 */ EXTERN int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 361 */ EXTERN int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 362 */ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 363 */ EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 364 */ EXTERN int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 365 */ EXTERN char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 366 */ EXTERN int Tcl_Chdir(const char *dirName); /* 367 */ EXTERN int Tcl_Access(const char *path, int mode); /* 368 */ EXTERN int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n); /* 370 */ EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n); /* 371 */ EXTERN int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); /* 372 */ EXTERN int Tcl_UniCharIsControl(int ch); /* 373 */ EXTERN int Tcl_UniCharIsGraph(int ch); /* 374 */ EXTERN int Tcl_UniCharIsPrint(int ch); /* 375 */ EXTERN int Tcl_UniCharIsPunct(int ch); /* 376 */ EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 377 */ EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 378 */ EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars); /* 379 */ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 380 */ EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ EXTERN Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index); /* 382 */ EXTERN Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); /* 383 */ EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); /* 384 */ EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 386 */ EXTERN void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr); /* 387 */ EXTERN Tcl_Mutex * Tcl_GetAllocMutex(void); /* 388 */ EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp); /* 389 */ EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern); /* 390 */ EXTERN int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 391 */ EXTERN void Tcl_ConditionFinalize(Tcl_Condition *condPtr); /* 392 */ EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex); /* 393 */ EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 394 */ EXTERN int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead); /* 395 */ EXTERN int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen); /* 396 */ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan); /* 398 */ EXTERN CONST84_RETURN char * Tcl_ChannelName( const Tcl_ChannelType *chanTypePtr); /* 399 */ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr); /* 400 */ EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr); /* 401 */ EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr); /* 402 */ EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc( const Tcl_ChannelType *chanTypePtr); /* 403 */ EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc( const Tcl_ChannelType *chanTypePtr); /* 404 */ EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr); /* 405 */ EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr); /* 406 */ EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc( const Tcl_ChannelType *chanTypePtr); /* 407 */ EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc( const Tcl_ChannelType *chanTypePtr); /* 408 */ EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc( const Tcl_ChannelType *chanTypePtr); /* 409 */ EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc( const Tcl_ChannelType *chanTypePtr); /* 410 */ EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr); /* 411 */ EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr); /* 412 */ EXTERN int Tcl_JoinThread(Tcl_ThreadId threadId, int *result); /* 413 */ EXTERN int Tcl_IsChannelShared(Tcl_Channel channel); /* 414 */ EXTERN int Tcl_IsChannelRegistered(Tcl_Interp *interp, Tcl_Channel channel); /* 415 */ EXTERN void Tcl_CutChannel(Tcl_Channel channel); /* 416 */ EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); /* 417 */ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ EXTERN int Tcl_IsChannelExisting(const char *channelName); /* 419 */ EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 420 */ EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 421 */ EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key); /* 422 */ EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 423 */ EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 424 */ EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); /* 425 */ EXTERN ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 426 */ EXTERN int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 428 */ EXTERN char * Tcl_AttemptAlloc(unsigned int size); /* 429 */ EXTERN char * Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line); /* 430 */ EXTERN char * Tcl_AttemptRealloc(char *ptr, unsigned int size); /* 431 */ EXTERN char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, const char *file, int line); /* 432 */ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 435 */ EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 436 */ EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern); /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 438 */ EXTERN int Tcl_DetachChannel(Tcl_Interp *interp, Tcl_Channel channel); /* 439 */ EXTERN int Tcl_IsStandardChannel(Tcl_Channel channel); /* 440 */ EXTERN int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 441 */ EXTERN int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 442 */ EXTERN int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr); /* 443 */ EXTERN int Tcl_FSDeleteFile(Tcl_Obj *pathPtr); /* 444 */ EXTERN int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 445 */ EXTERN int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 446 */ EXTERN Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 447 */ EXTERN int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 448 */ EXTERN int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 449 */ EXTERN int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 450 */ EXTERN int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); /* 451 */ EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 452 */ EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 453 */ EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 454 */ EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 455 */ EXTERN int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode); /* 456 */ EXTERN Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 457 */ EXTERN Tcl_Obj * Tcl_FSGetCwd(Tcl_Interp *interp); /* 458 */ EXTERN int Tcl_FSChdir(Tcl_Obj *pathPtr); /* 459 */ EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 460 */ EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, int elements); /* 461 */ EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); /* 462 */ EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 463 */ EXTERN Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 464 */ EXTERN Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 465 */ EXTERN ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 466 */ EXTERN Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 467 */ EXTERN int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); /* 468 */ EXTERN Tcl_Obj * Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 469 */ EXTERN const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); /* 470 */ EXTERN Tcl_Obj * Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr); /* 471 */ EXTERN Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); /* 472 */ EXTERN Tcl_Obj * Tcl_FSListVolumes(void); /* 473 */ EXTERN int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr); /* 474 */ EXTERN int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); /* 475 */ EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); /* 476 */ EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 477 */ EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); /* 478 */ EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); /* 479 */ EXTERN int Tcl_OutputBuffered(Tcl_Channel chan); /* 480 */ EXTERN void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr); /* 481 */ EXTERN int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 482 */ EXTERN void Tcl_GetTime(Tcl_Time *timeBuf); /* 483 */ EXTERN Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 484 */ EXTERN int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 485 */ EXTERN int Tcl_SetCommandInfoFromToken(Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 486 */ EXTERN Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue, const char *file, int line); /* 487 */ EXTERN int Tcl_GetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 488 */ EXTERN Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue); /* 489 */ EXTERN void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 490 */ EXTERN Tcl_StatBuf * Tcl_AllocStatBuf(void); /* 491 */ EXTERN Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 492 */ EXTERN Tcl_WideInt Tcl_Tell(Tcl_Channel chan); /* 493 */ EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr); /* 494 */ EXTERN int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 495 */ EXTERN int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 496 */ EXTERN int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 497 */ EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 498 */ EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */ EXTERN void Tcl_DictObjNext(Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 500 */ EXTERN void Tcl_DictObjDone(Tcl_DictSearch *searchPtr); /* 501 */ EXTERN int Tcl_DictObjPutKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 502 */ EXTERN int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 503 */ EXTERN Tcl_Obj * Tcl_NewDictObj(void); /* 504 */ EXTERN Tcl_Obj * Tcl_DbNewDictObj(const char *file, int line); /* 505 */ EXTERN void Tcl_RegisterConfig(Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 506 */ EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 507 */ EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); /* 508 */ EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 509 */ EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 510 */ EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 511 */ EXTERN int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 512 */ EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); /* 513 */ EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); /* 514 */ EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */ EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 516 */ EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 517 */ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 518 */ EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 519 */ EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); /* 520 */ EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 521 */ EXTERN void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 522 */ EXTERN int Tcl_LimitReady(Tcl_Interp *interp); /* 523 */ EXTERN int Tcl_LimitCheck(Tcl_Interp *interp); /* 524 */ EXTERN int Tcl_LimitExceeded(Tcl_Interp *interp); /* 525 */ EXTERN void Tcl_LimitSetCommands(Tcl_Interp *interp, int commandLimit); /* 526 */ EXTERN void Tcl_LimitSetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 527 */ EXTERN void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type, int granularity); /* 528 */ EXTERN int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type); /* 529 */ EXTERN int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type); /* 530 */ EXTERN void Tcl_LimitTypeSet(Tcl_Interp *interp, int type); /* 531 */ EXTERN void Tcl_LimitTypeReset(Tcl_Interp *interp, int type); /* 532 */ EXTERN int Tcl_LimitGetCommands(Tcl_Interp *interp); /* 533 */ EXTERN void Tcl_LimitGetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 534 */ EXTERN int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type); /* 535 */ EXTERN Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status); /* 536 */ EXTERN int Tcl_RestoreInterpState(Tcl_Interp *interp, Tcl_InterpState state); /* 537 */ EXTERN void Tcl_DiscardInterpState(Tcl_InterpState state); /* 538 */ EXTERN int Tcl_SetReturnOptions(Tcl_Interp *interp, Tcl_Obj *options); /* 539 */ EXTERN Tcl_Obj * Tcl_GetReturnOptions(Tcl_Interp *interp, int result); /* 540 */ EXTERN int Tcl_IsEnsemble(Tcl_Command token); /* 541 */ EXTERN Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags); /* 542 */ EXTERN Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags); /* 543 */ EXTERN int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList); /* 544 */ EXTERN int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict); /* 545 */ EXTERN int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 546 */ EXTERN int Tcl_SetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int flags); /* 547 */ EXTERN int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 548 */ EXTERN int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 549 */ EXTERN int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 550 */ EXTERN int Tcl_GetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 551 */ EXTERN int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 552 */ EXTERN void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 553 */ EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); /* 555 */ EXTERN Tcl_Obj * Tcl_NewBignumObj(mp_int *value); /* 556 */ EXTERN Tcl_Obj * Tcl_DbNewBignumObj(mp_int *value, const char *file, int line); /* 557 */ EXTERN void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value); /* 558 */ EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */ EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 560 */ EXTERN int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length); /* 561 */ EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr); /* 562 */ EXTERN void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg); /* 563 */ EXTERN void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj **msg); /* 564 */ EXTERN void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg); /* 565 */ EXTERN void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg); /* 566 */ EXTERN int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, mp_int *toInit); /* 567 */ EXTERN Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 568 */ EXTERN int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 569 */ EXTERN int Tcl_GetEncodingFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 570 */ EXTERN Tcl_Obj * Tcl_GetEncodingSearchPath(void); /* 571 */ EXTERN int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath); /* 572 */ EXTERN const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr); /* 573 */ EXTERN int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 574 */ EXTERN void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 575 */ EXTERN void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 576 */ EXTERN Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ EXTERN int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 578 */ EXTERN Tcl_Obj * Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 579 */ EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 580 */ EXTERN int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 581 */ EXTERN int Tcl_Canceled(Tcl_Interp *interp, int flags); /* 582 */ EXTERN int Tcl_CreatePipe(Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 583 */ EXTERN Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 584 */ EXTERN int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 585 */ EXTERN int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 586 */ EXTERN int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 587 */ EXTERN void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 588 */ EXTERN int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 589 */ EXTERN unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); /* 590 */ EXTERN unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr); /* 591 */ EXTERN unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr); /* 592 */ EXTERN int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr); /* 593 */ EXTERN int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr); /* 594 */ EXTERN int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr); /* 595 */ EXTERN int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr); /* 596 */ EXTERN Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr); /* 597 */ EXTERN Tcl_WideInt Tcl_GetModificationTimeFromStat( const Tcl_StatBuf *statPtr); /* 598 */ EXTERN Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr); /* 599 */ EXTERN Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr); /* 600 */ EXTERN Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr); /* 601 */ EXTERN unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr); /* 602 */ EXTERN int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 603 */ EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 604 */ EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 605 */ EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp); /* 606 */ EXTERN void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum); /* 607 */ EXTERN void Tcl_TransferResult(Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 608 */ EXTERN int Tcl_InterpActive(Tcl_Interp *interp); /* 609 */ EXTERN void Tcl_BackgroundException(Tcl_Interp *interp, int code); /* 610 */ EXTERN int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 611 */ EXTERN int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 612 */ EXTERN unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf, int len); /* 613 */ EXTERN unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf, int len); /* 614 */ EXTERN int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 615 */ EXTERN Tcl_Obj * Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle); /* 616 */ EXTERN int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle); /* 617 */ EXTERN int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle); /* 618 */ EXTERN int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 619 */ EXTERN int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 620 */ EXTERN int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle); /* 621 */ EXTERN int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle); /* 622 */ EXTERN void Tcl_SetStartupScript(Tcl_Obj *path, const char *encoding); /* 623 */ EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingPtr); /* 624 */ EXTERN int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 625 */ EXTERN int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 626 */ EXTERN int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 627 */ EXTERN int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 628 */ EXTERN void * Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 629 */ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 630 */ EXTERN void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* Slot 631 is reserved */ /* Slot 632 is reserved */ /* Slot 633 is reserved */ /* Slot 634 is reserved */ /* Slot 635 is reserved */ /* Slot 636 is reserved */ /* Slot 637 is reserved */ /* Slot 638 is reserved */ /* Slot 639 is reserved */ /* Slot 640 is reserved */ /* Slot 641 is reserved */ /* Slot 642 is reserved */ /* Slot 643 is reserved */ /* Slot 644 is reserved */ /* Slot 645 is reserved */ /* Slot 646 is reserved */ /* Slot 647 is reserved */ /* Slot 648 is reserved */ /* Slot 649 is reserved */ /* Slot 650 is reserved */ /* Slot 651 is reserved */ /* Slot 652 is reserved */ /* Slot 653 is reserved */ /* Slot 654 is reserved */ /* Slot 655 is reserved */ /* Slot 656 is reserved */ /* Slot 657 is reserved */ /* Slot 658 is reserved */ /* Slot 659 is reserved */ /* Slot 660 is reserved */ /* Slot 661 is reserved */ /* Slot 662 is reserved */ /* Slot 663 is reserved */ /* Slot 664 is reserved */ /* Slot 665 is reserved */ /* Slot 666 is reserved */ /* Slot 667 is reserved */ /* Slot 668 is reserved */ /* Slot 669 is reserved */ /* Slot 670 is reserved */ /* Slot 671 is reserved */ /* Slot 672 is reserved */ /* Slot 673 is reserved */ /* Slot 674 is reserved */ /* Slot 675 is reserved */ /* Slot 676 is reserved */ /* Slot 677 is reserved */ /* Slot 678 is reserved */ /* Slot 679 is reserved */ /* Slot 680 is reserved */ /* Slot 681 is reserved */ /* Slot 682 is reserved */ /* Slot 683 is reserved */ /* Slot 684 is reserved */ /* Slot 685 is reserved */ /* Slot 686 is reserved */ /* Slot 687 is reserved */ /* 688 */ EXTERN void TclUnusedStubEntry(void); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; typedef struct TclStubs { int magic; const TclStubHooks *hooks; int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ char * (*tcl_Alloc) (unsigned int size); /* 3 */ void (*tcl_Free) (char *ptr); /* 4 */ char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */ char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */ void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */ char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved9)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved10)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ #endif /* MACOSX */ void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */ void (*tcl_Sleep) (int ms); /* 12 */ int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */ int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */ void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */ void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */ Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */ int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */ void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */ void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */ int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */ Tcl_Obj * (*tcl_DbNewBooleanObj) (int intValue, const char *file, int line); /* 22 */ Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */ Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */ Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */ Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *intPtr); /* 31 */ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */ int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */ Tcl_Obj * (*tcl_NewBooleanObj) (int intValue); /* 49 */ Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int numBytes); /* 50 */ Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */ Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */ Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */ Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */ Tcl_Obj * (*tcl_NewObj) (void); /* 55 */ Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */ void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int intValue); /* 57 */ unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int numBytes); /* 58 */ void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int numBytes); /* 59 */ void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */ void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */ void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */ void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */ void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */ void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */ void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */ void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */ void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */ void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */ void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */ Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */ void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */ int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */ void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ int (*tcl_CommandComplete) (const char *cmd); /* 82 */ char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */ int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ int (*tcl_CreateAlias) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */ void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */ Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */ void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */ Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */ void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */ Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */ Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */ Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */ void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */ void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */ void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */ int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */ int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */ void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */ void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */ void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */ void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */ void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */ void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */ void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */ void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */ void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */ void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */ int (*tcl_DoOneEvent) (int flags); /* 115 */ void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */ char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, int length); /* 117 */ char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */ void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */ void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */ void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */ void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */ void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */ void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */ void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */ int (*tcl_Eof) (Tcl_Channel chan); /* 126 */ CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */ CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */ int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */ int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */ int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */ int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */ int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */ int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */ int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */ int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ void (*tcl_FindExecutable) (const char *argv0); /* 144 */ Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */ ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */ CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */ int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *childInterp); /* 163 */ Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved167)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ #endif /* MACOSX */ Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */ int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */ int (*tcl_GetServiceMode) (void); /* 171 */ Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *name); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */ int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */ int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */ int (*tcl_Init) (Tcl_Interp *interp); /* 180 */ void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */ int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */ int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */ int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */ int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */ char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */ void (*reserved188)(void); Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */ char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */ Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */ Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */ Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int flags); /* 199 */ Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */ void (*tcl_Preserve) (ClientData data); /* 201 */ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */ int (*tcl_PutEnv) (const char *assignment); /* 203 */ CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */ int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */ void (*tcl_ReapDetachedProcs) (void); /* 207 */ int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */ int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */ void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */ void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */ Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */ int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */ void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */ void (*tcl_Release) (ClientData clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */ int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */ void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */ int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */ int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */ void (*tcl_SetErrno) (int err); /* 227 */ void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */ void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */ void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */ int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */ void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */ int (*tcl_SetServiceMode) (int mode); /* 233 */ void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */ CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */ CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */ void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */ void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */ int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */ int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */ void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */ int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */ int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */ int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */ void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */ void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */ int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */ int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */ int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */ ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */ ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */ void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */ int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */ void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */ void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */ void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */ CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */ void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */ Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */ int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */ void (*reserved285)(void); void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */ void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */ void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */ int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ void (*tcl_ExitThread) (int status); /* 294 */ int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */ void (*tcl_FinalizeThread) (void); /* 297 */ void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */ void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */ int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */ Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */ ClientData (*tcl_InitNotifier) (void); /* 307 */ void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */ void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */ void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */ void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */ int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */ int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */ void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */ void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */ Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */ Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */ CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ int (*tcl_UtfToTitle) (char *src); /* 335 */ int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */ int (*tcl_UtfToUpper) (char *src); /* 337 */ int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */ int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ int (*tcl_UniCharIsAlpha) (int ch); /* 346 */ int (*tcl_UniCharIsDigit) (int ch); /* 347 */ int (*tcl_UniCharIsLower) (int ch); /* 348 */ int (*tcl_UniCharIsSpace) (int ch); /* 349 */ int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */ int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */ int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */ int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */ int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */ int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ int (*tcl_UniCharIsPrint) (int ch); /* 374 */ int (*tcl_UniCharIsPunct) (int ch); /* 375 */ int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */ void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */ int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */ void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */ int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */ void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */ int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */ int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */ void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */ int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */ int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */ int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */ CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */ Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */ Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */ Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */ Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */ Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 406 */ Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 407 */ Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr); /* 408 */ Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (const Tcl_ChannelType *chanTypePtr); /* 409 */ Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (const Tcl_ChannelType *chanTypePtr); /* 410 */ Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) (const Tcl_ChannelType *chanTypePtr); /* 411 */ int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */ int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */ int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */ void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */ void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */ void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */ char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */ char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */ char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */ Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */ int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */ int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */ int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */ int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */ int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */ int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */ int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 445 */ Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 446 */ int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 447 */ int (*tcl_FSRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 448 */ int (*tcl_FSLstat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 449 */ int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */ int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */ int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */ const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */ int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */ Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */ Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp); /* 457 */ int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */ int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */ Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements); /* 460 */ Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */ int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */ Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */ Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 464 */ ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */ int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */ Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */ const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */ Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */ Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */ Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */ int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */ int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */ ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */ CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */ int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */ void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */ int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */ void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */ Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */ int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */ Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */ int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */ Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */ void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */ Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */ Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 491 */ Tcl_WideInt (*tcl_Tell) (Tcl_Channel chan); /* 492 */ Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */ int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */ int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */ int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */ int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */ int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */ void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */ void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */ int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */ int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 502 */ Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */ Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */ void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */ Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */ int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */ int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */ int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 510 */ int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 511 */ Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 512 */ Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 513 */ Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 514 */ Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */ Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */ int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */ Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */ void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */ int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */ int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */ int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */ void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit); /* 525 */ void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 526 */ void (*tcl_LimitSetGranularity) (Tcl_Interp *interp, int type, int granularity); /* 527 */ int (*tcl_LimitTypeEnabled) (Tcl_Interp *interp, int type); /* 528 */ int (*tcl_LimitTypeExceeded) (Tcl_Interp *interp, int type); /* 529 */ void (*tcl_LimitTypeSet) (Tcl_Interp *interp, int type); /* 530 */ void (*tcl_LimitTypeReset) (Tcl_Interp *interp, int type); /* 531 */ int (*tcl_LimitGetCommands) (Tcl_Interp *interp); /* 532 */ void (*tcl_LimitGetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 533 */ int (*tcl_LimitGetGranularity) (Tcl_Interp *interp, int type); /* 534 */ Tcl_InterpState (*tcl_SaveInterpState) (Tcl_Interp *interp, int status); /* 535 */ int (*tcl_RestoreInterpState) (Tcl_Interp *interp, Tcl_InterpState state); /* 536 */ void (*tcl_DiscardInterpState) (Tcl_InterpState state); /* 537 */ int (*tcl_SetReturnOptions) (Tcl_Interp *interp, Tcl_Obj *options); /* 538 */ Tcl_Obj * (*tcl_GetReturnOptions) (Tcl_Interp *interp, int result); /* 539 */ int (*tcl_IsEnsemble) (Tcl_Command token); /* 540 */ Tcl_Command (*tcl_CreateEnsemble) (Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags); /* 541 */ Tcl_Command (*tcl_FindEnsemble) (Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags); /* 542 */ int (*tcl_SetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList); /* 543 */ int (*tcl_SetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict); /* 544 */ int (*tcl_SetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 545 */ int (*tcl_SetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int flags); /* 546 */ int (*tcl_GetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 547 */ int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */ int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */ void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */ Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, const char *file, int line); /* 556 */ void (*tcl_SetBignumObj) (Tcl_Obj *obj, mp_int *value); /* 557 */ int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 558 */ int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */ int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */ Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */ void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */ void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */ void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */ void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */ int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, mp_int *toInit); /* 566 */ Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */ int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */ int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */ Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */ int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */ const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */ int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */ void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */ void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 575 */ Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */ int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */ void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */ int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 580 */ int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */ int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */ Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */ int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */ int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */ void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */ int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */ unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */ unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */ int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */ int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */ int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */ int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */ Tcl_WideInt (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */ Tcl_WideInt (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */ Tcl_WideInt (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */ Tcl_WideUInt (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */ Tcl_WideUInt (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */ unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */ int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */ int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */ int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */ void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */ void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */ int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */ void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */ int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */ int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */ unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, int len); /* 612 */ unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, int len); /* 613 */ int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */ Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */ int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */ int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */ int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */ int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 619 */ int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */ int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */ void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */ Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */ int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */ int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */ int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */ int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */ void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ void (*reserved631)(void); void (*reserved632)(void); void (*reserved633)(void); void (*reserved634)(void); void (*reserved635)(void); void (*reserved636)(void); void (*reserved637)(void); void (*reserved638)(void); void (*reserved639)(void); void (*reserved640)(void); void (*reserved641)(void); void (*reserved642)(void); void (*reserved643)(void); void (*reserved644)(void); void (*reserved645)(void); void (*reserved646)(void); void (*reserved647)(void); void (*reserved648)(void); void (*reserved649)(void); void (*reserved650)(void); void (*reserved651)(void); void (*reserved652)(void); void (*reserved653)(void); void (*reserved654)(void); void (*reserved655)(void); void (*reserved656)(void); void (*reserved657)(void); void (*reserved658)(void); void (*reserved659)(void); void (*reserved660)(void); void (*reserved661)(void); void (*reserved662)(void); void (*reserved663)(void); void (*reserved664)(void); void (*reserved665)(void); void (*reserved666)(void); void (*reserved667)(void); void (*reserved668)(void); void (*reserved669)(void); void (*reserved670)(void); void (*reserved671)(void); void (*reserved672)(void); void (*reserved673)(void); void (*reserved674)(void); void (*reserved675)(void); void (*reserved676)(void); void (*reserved677)(void); void (*reserved678)(void); void (*reserved679)(void); void (*reserved680)(void); void (*reserved681)(void); void (*reserved682)(void); void (*reserved683)(void); void (*reserved684)(void); void (*reserved685)(void); void (*reserved686)(void); void (*reserved687)(void); void (*tclUnusedStubEntry) (void); /* 688 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) /* * Inline function declarations: */ #define Tcl_PkgProvideEx \ (tclStubsPtr->tcl_PkgProvideEx) /* 0 */ #define Tcl_PkgRequireEx \ (tclStubsPtr->tcl_PkgRequireEx) /* 1 */ #define Tcl_Panic \ (tclStubsPtr->tcl_Panic) /* 2 */ #define Tcl_Alloc \ (tclStubsPtr->tcl_Alloc) /* 3 */ #define Tcl_Free \ (tclStubsPtr->tcl_Free) /* 4 */ #define Tcl_Realloc \ (tclStubsPtr->tcl_Realloc) /* 5 */ #define Tcl_DbCkalloc \ (tclStubsPtr->tcl_DbCkalloc) /* 6 */ #define Tcl_DbCkfree \ (tclStubsPtr->tcl_DbCkfree) /* 7 */ #define Tcl_DbCkrealloc \ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ #define Tcl_DeleteFileHandler \ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ #define Tcl_DeleteFileHandler \ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ #endif /* MACOSX */ #define Tcl_SetTimer \ (tclStubsPtr->tcl_SetTimer) /* 11 */ #define Tcl_Sleep \ (tclStubsPtr->tcl_Sleep) /* 12 */ #define Tcl_WaitForEvent \ (tclStubsPtr->tcl_WaitForEvent) /* 13 */ #define Tcl_AppendAllObjTypes \ (tclStubsPtr->tcl_AppendAllObjTypes) /* 14 */ #define Tcl_AppendStringsToObj \ (tclStubsPtr->tcl_AppendStringsToObj) /* 15 */ #define Tcl_AppendToObj \ (tclStubsPtr->tcl_AppendToObj) /* 16 */ #define Tcl_ConcatObj \ (tclStubsPtr->tcl_ConcatObj) /* 17 */ #define Tcl_ConvertToType \ (tclStubsPtr->tcl_ConvertToType) /* 18 */ #define Tcl_DbDecrRefCount \ (tclStubsPtr->tcl_DbDecrRefCount) /* 19 */ #define Tcl_DbIncrRefCount \ (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */ #define Tcl_DbIsShared \ (tclStubsPtr->tcl_DbIsShared) /* 21 */ #define Tcl_DbNewBooleanObj \ (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */ #define Tcl_DbNewByteArrayObj \ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */ #define Tcl_DbNewDoubleObj \ (tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */ #define Tcl_DbNewListObj \ (tclStubsPtr->tcl_DbNewListObj) /* 25 */ #define Tcl_DbNewLongObj \ (tclStubsPtr->tcl_DbNewLongObj) /* 26 */ #define Tcl_DbNewObj \ (tclStubsPtr->tcl_DbNewObj) /* 27 */ #define Tcl_DbNewStringObj \ (tclStubsPtr->tcl_DbNewStringObj) /* 28 */ #define Tcl_DuplicateObj \ (tclStubsPtr->tcl_DuplicateObj) /* 29 */ #define TclFreeObj \ (tclStubsPtr->tclFreeObj) /* 30 */ #define Tcl_GetBoolean \ (tclStubsPtr->tcl_GetBoolean) /* 31 */ #define Tcl_GetBooleanFromObj \ (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */ #define Tcl_GetByteArrayFromObj \ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */ #define Tcl_GetDouble \ (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ #define Tcl_GetIndexFromObj \ (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */ #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #define Tcl_GetIntFromObj \ (tclStubsPtr->tcl_GetIntFromObj) /* 38 */ #define Tcl_GetLongFromObj \ (tclStubsPtr->tcl_GetLongFromObj) /* 39 */ #define Tcl_GetObjType \ (tclStubsPtr->tcl_GetObjType) /* 40 */ #define Tcl_GetStringFromObj \ (tclStubsPtr->tcl_GetStringFromObj) /* 41 */ #define Tcl_InvalidateStringRep \ (tclStubsPtr->tcl_InvalidateStringRep) /* 42 */ #define Tcl_ListObjAppendList \ (tclStubsPtr->tcl_ListObjAppendList) /* 43 */ #define Tcl_ListObjAppendElement \ (tclStubsPtr->tcl_ListObjAppendElement) /* 44 */ #define Tcl_ListObjGetElements \ (tclStubsPtr->tcl_ListObjGetElements) /* 45 */ #define Tcl_ListObjIndex \ (tclStubsPtr->tcl_ListObjIndex) /* 46 */ #define Tcl_ListObjLength \ (tclStubsPtr->tcl_ListObjLength) /* 47 */ #define Tcl_ListObjReplace \ (tclStubsPtr->tcl_ListObjReplace) /* 48 */ #define Tcl_NewBooleanObj \ (tclStubsPtr->tcl_NewBooleanObj) /* 49 */ #define Tcl_NewByteArrayObj \ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */ #define Tcl_NewDoubleObj \ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */ #define Tcl_NewIntObj \ (tclStubsPtr->tcl_NewIntObj) /* 52 */ #define Tcl_NewListObj \ (tclStubsPtr->tcl_NewListObj) /* 53 */ #define Tcl_NewLongObj \ (tclStubsPtr->tcl_NewLongObj) /* 54 */ #define Tcl_NewObj \ (tclStubsPtr->tcl_NewObj) /* 55 */ #define Tcl_NewStringObj \ (tclStubsPtr->tcl_NewStringObj) /* 56 */ #define Tcl_SetBooleanObj \ (tclStubsPtr->tcl_SetBooleanObj) /* 57 */ #define Tcl_SetByteArrayLength \ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */ #define Tcl_SetByteArrayObj \ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */ #define Tcl_SetDoubleObj \ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */ #define Tcl_SetIntObj \ (tclStubsPtr->tcl_SetIntObj) /* 61 */ #define Tcl_SetListObj \ (tclStubsPtr->tcl_SetListObj) /* 62 */ #define Tcl_SetLongObj \ (tclStubsPtr->tcl_SetLongObj) /* 63 */ #define Tcl_SetObjLength \ (tclStubsPtr->tcl_SetObjLength) /* 64 */ #define Tcl_SetStringObj \ (tclStubsPtr->tcl_SetStringObj) /* 65 */ #define Tcl_AddErrorInfo \ (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ #define Tcl_AddObjErrorInfo \ (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */ #define Tcl_AllowExceptions \ (tclStubsPtr->tcl_AllowExceptions) /* 68 */ #define Tcl_AppendElement \ (tclStubsPtr->tcl_AppendElement) /* 69 */ #define Tcl_AppendResult \ (tclStubsPtr->tcl_AppendResult) /* 70 */ #define Tcl_AsyncCreate \ (tclStubsPtr->tcl_AsyncCreate) /* 71 */ #define Tcl_AsyncDelete \ (tclStubsPtr->tcl_AsyncDelete) /* 72 */ #define Tcl_AsyncInvoke \ (tclStubsPtr->tcl_AsyncInvoke) /* 73 */ #define Tcl_AsyncMark \ (tclStubsPtr->tcl_AsyncMark) /* 74 */ #define Tcl_AsyncReady \ (tclStubsPtr->tcl_AsyncReady) /* 75 */ #define Tcl_BackgroundError \ (tclStubsPtr->tcl_BackgroundError) /* 76 */ #define Tcl_Backslash \ (tclStubsPtr->tcl_Backslash) /* 77 */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ (tclStubsPtr->tcl_CallWhenDeleted) /* 79 */ #define Tcl_CancelIdleCall \ (tclStubsPtr->tcl_CancelIdleCall) /* 80 */ #define Tcl_Close \ (tclStubsPtr->tcl_Close) /* 81 */ #define Tcl_CommandComplete \ (tclStubsPtr->tcl_CommandComplete) /* 82 */ #define Tcl_Concat \ (tclStubsPtr->tcl_Concat) /* 83 */ #define Tcl_ConvertElement \ (tclStubsPtr->tcl_ConvertElement) /* 84 */ #define Tcl_ConvertCountedElement \ (tclStubsPtr->tcl_ConvertCountedElement) /* 85 */ #define Tcl_CreateAlias \ (tclStubsPtr->tcl_CreateAlias) /* 86 */ #define Tcl_CreateAliasObj \ (tclStubsPtr->tcl_CreateAliasObj) /* 87 */ #define Tcl_CreateChannel \ (tclStubsPtr->tcl_CreateChannel) /* 88 */ #define Tcl_CreateChannelHandler \ (tclStubsPtr->tcl_CreateChannelHandler) /* 89 */ #define Tcl_CreateCloseHandler \ (tclStubsPtr->tcl_CreateCloseHandler) /* 90 */ #define Tcl_CreateCommand \ (tclStubsPtr->tcl_CreateCommand) /* 91 */ #define Tcl_CreateEventSource \ (tclStubsPtr->tcl_CreateEventSource) /* 92 */ #define Tcl_CreateExitHandler \ (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ #define Tcl_CreateMathFunc \ (tclStubsPtr->tcl_CreateMathFunc) /* 95 */ #define Tcl_CreateObjCommand \ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */ #define Tcl_CreateSlave \ (tclStubsPtr->tcl_CreateSlave) /* 97 */ #define Tcl_CreateTimerHandler \ (tclStubsPtr->tcl_CreateTimerHandler) /* 98 */ #define Tcl_CreateTrace \ (tclStubsPtr->tcl_CreateTrace) /* 99 */ #define Tcl_DeleteAssocData \ (tclStubsPtr->tcl_DeleteAssocData) /* 100 */ #define Tcl_DeleteChannelHandler \ (tclStubsPtr->tcl_DeleteChannelHandler) /* 101 */ #define Tcl_DeleteCloseHandler \ (tclStubsPtr->tcl_DeleteCloseHandler) /* 102 */ #define Tcl_DeleteCommand \ (tclStubsPtr->tcl_DeleteCommand) /* 103 */ #define Tcl_DeleteCommandFromToken \ (tclStubsPtr->tcl_DeleteCommandFromToken) /* 104 */ #define Tcl_DeleteEvents \ (tclStubsPtr->tcl_DeleteEvents) /* 105 */ #define Tcl_DeleteEventSource \ (tclStubsPtr->tcl_DeleteEventSource) /* 106 */ #define Tcl_DeleteExitHandler \ (tclStubsPtr->tcl_DeleteExitHandler) /* 107 */ #define Tcl_DeleteHashEntry \ (tclStubsPtr->tcl_DeleteHashEntry) /* 108 */ #define Tcl_DeleteHashTable \ (tclStubsPtr->tcl_DeleteHashTable) /* 109 */ #define Tcl_DeleteInterp \ (tclStubsPtr->tcl_DeleteInterp) /* 110 */ #define Tcl_DetachPids \ (tclStubsPtr->tcl_DetachPids) /* 111 */ #define Tcl_DeleteTimerHandler \ (tclStubsPtr->tcl_DeleteTimerHandler) /* 112 */ #define Tcl_DeleteTrace \ (tclStubsPtr->tcl_DeleteTrace) /* 113 */ #define Tcl_DontCallWhenDeleted \ (tclStubsPtr->tcl_DontCallWhenDeleted) /* 114 */ #define Tcl_DoOneEvent \ (tclStubsPtr->tcl_DoOneEvent) /* 115 */ #define Tcl_DoWhenIdle \ (tclStubsPtr->tcl_DoWhenIdle) /* 116 */ #define Tcl_DStringAppend \ (tclStubsPtr->tcl_DStringAppend) /* 117 */ #define Tcl_DStringAppendElement \ (tclStubsPtr->tcl_DStringAppendElement) /* 118 */ #define Tcl_DStringEndSublist \ (tclStubsPtr->tcl_DStringEndSublist) /* 119 */ #define Tcl_DStringFree \ (tclStubsPtr->tcl_DStringFree) /* 120 */ #define Tcl_DStringGetResult \ (tclStubsPtr->tcl_DStringGetResult) /* 121 */ #define Tcl_DStringInit \ (tclStubsPtr->tcl_DStringInit) /* 122 */ #define Tcl_DStringResult \ (tclStubsPtr->tcl_DStringResult) /* 123 */ #define Tcl_DStringSetLength \ (tclStubsPtr->tcl_DStringSetLength) /* 124 */ #define Tcl_DStringStartSublist \ (tclStubsPtr->tcl_DStringStartSublist) /* 125 */ #define Tcl_Eof \ (tclStubsPtr->tcl_Eof) /* 126 */ #define Tcl_ErrnoId \ (tclStubsPtr->tcl_ErrnoId) /* 127 */ #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ #define Tcl_Eval \ (tclStubsPtr->tcl_Eval) /* 129 */ #define Tcl_EvalFile \ (tclStubsPtr->tcl_EvalFile) /* 130 */ #define Tcl_EvalObj \ (tclStubsPtr->tcl_EvalObj) /* 131 */ #define Tcl_EventuallyFree \ (tclStubsPtr->tcl_EventuallyFree) /* 132 */ #define Tcl_Exit \ (tclStubsPtr->tcl_Exit) /* 133 */ #define Tcl_ExposeCommand \ (tclStubsPtr->tcl_ExposeCommand) /* 134 */ #define Tcl_ExprBoolean \ (tclStubsPtr->tcl_ExprBoolean) /* 135 */ #define Tcl_ExprBooleanObj \ (tclStubsPtr->tcl_ExprBooleanObj) /* 136 */ #define Tcl_ExprDouble \ (tclStubsPtr->tcl_ExprDouble) /* 137 */ #define Tcl_ExprDoubleObj \ (tclStubsPtr->tcl_ExprDoubleObj) /* 138 */ #define Tcl_ExprLong \ (tclStubsPtr->tcl_ExprLong) /* 139 */ #define Tcl_ExprLongObj \ (tclStubsPtr->tcl_ExprLongObj) /* 140 */ #define Tcl_ExprObj \ (tclStubsPtr->tcl_ExprObj) /* 141 */ #define Tcl_ExprString \ (tclStubsPtr->tcl_ExprString) /* 142 */ #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ #define Tcl_FindExecutable \ (tclStubsPtr->tcl_FindExecutable) /* 144 */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ #define Tcl_FreeResult \ (tclStubsPtr->tcl_FreeResult) /* 147 */ #define Tcl_GetAlias \ (tclStubsPtr->tcl_GetAlias) /* 148 */ #define Tcl_GetAliasObj \ (tclStubsPtr->tcl_GetAliasObj) /* 149 */ #define Tcl_GetAssocData \ (tclStubsPtr->tcl_GetAssocData) /* 150 */ #define Tcl_GetChannel \ (tclStubsPtr->tcl_GetChannel) /* 151 */ #define Tcl_GetChannelBufferSize \ (tclStubsPtr->tcl_GetChannelBufferSize) /* 152 */ #define Tcl_GetChannelHandle \ (tclStubsPtr->tcl_GetChannelHandle) /* 153 */ #define Tcl_GetChannelInstanceData \ (tclStubsPtr->tcl_GetChannelInstanceData) /* 154 */ #define Tcl_GetChannelMode \ (tclStubsPtr->tcl_GetChannelMode) /* 155 */ #define Tcl_GetChannelName \ (tclStubsPtr->tcl_GetChannelName) /* 156 */ #define Tcl_GetChannelOption \ (tclStubsPtr->tcl_GetChannelOption) /* 157 */ #define Tcl_GetChannelType \ (tclStubsPtr->tcl_GetChannelType) /* 158 */ #define Tcl_GetCommandInfo \ (tclStubsPtr->tcl_GetCommandInfo) /* 159 */ #define Tcl_GetCommandName \ (tclStubsPtr->tcl_GetCommandName) /* 160 */ #define Tcl_GetErrno \ (tclStubsPtr->tcl_GetErrno) /* 161 */ #define Tcl_GetHostName \ (tclStubsPtr->tcl_GetHostName) /* 162 */ #define Tcl_GetInterpPath \ (tclStubsPtr->tcl_GetInterpPath) /* 163 */ #define Tcl_GetMaster \ (tclStubsPtr->tcl_GetMaster) /* 164 */ #define Tcl_GetNameOfExecutable \ (tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */ #define Tcl_GetObjResult \ (tclStubsPtr->tcl_GetObjResult) /* 166 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ #define Tcl_GetOpenFile \ (tclStubsPtr->tcl_GetOpenFile) /* 167 */ #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ #define Tcl_GetOpenFile \ (tclStubsPtr->tcl_GetOpenFile) /* 167 */ #endif /* MACOSX */ #define Tcl_GetPathType \ (tclStubsPtr->tcl_GetPathType) /* 168 */ #define Tcl_Gets \ (tclStubsPtr->tcl_Gets) /* 169 */ #define Tcl_GetsObj \ (tclStubsPtr->tcl_GetsObj) /* 170 */ #define Tcl_GetServiceMode \ (tclStubsPtr->tcl_GetServiceMode) /* 171 */ #define Tcl_GetSlave \ (tclStubsPtr->tcl_GetSlave) /* 172 */ #define Tcl_GetStdChannel \ (tclStubsPtr->tcl_GetStdChannel) /* 173 */ #define Tcl_GetStringResult \ (tclStubsPtr->tcl_GetStringResult) /* 174 */ #define Tcl_GetVar \ (tclStubsPtr->tcl_GetVar) /* 175 */ #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ #define Tcl_GlobalEval \ (tclStubsPtr->tcl_GlobalEval) /* 177 */ #define Tcl_GlobalEvalObj \ (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */ #define Tcl_HideCommand \ (tclStubsPtr->tcl_HideCommand) /* 179 */ #define Tcl_Init \ (tclStubsPtr->tcl_Init) /* 180 */ #define Tcl_InitHashTable \ (tclStubsPtr->tcl_InitHashTable) /* 181 */ #define Tcl_InputBlocked \ (tclStubsPtr->tcl_InputBlocked) /* 182 */ #define Tcl_InputBuffered \ (tclStubsPtr->tcl_InputBuffered) /* 183 */ #define Tcl_InterpDeleted \ (tclStubsPtr->tcl_InterpDeleted) /* 184 */ #define Tcl_IsSafe \ (tclStubsPtr->tcl_IsSafe) /* 185 */ #define Tcl_JoinPath \ (tclStubsPtr->tcl_JoinPath) /* 186 */ #define Tcl_LinkVar \ (tclStubsPtr->tcl_LinkVar) /* 187 */ /* Slot 188 is reserved */ #define Tcl_MakeFileChannel \ (tclStubsPtr->tcl_MakeFileChannel) /* 189 */ #define Tcl_MakeSafe \ (tclStubsPtr->tcl_MakeSafe) /* 190 */ #define Tcl_MakeTcpClientChannel \ (tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */ #define Tcl_Merge \ (tclStubsPtr->tcl_Merge) /* 192 */ #define Tcl_NextHashEntry \ (tclStubsPtr->tcl_NextHashEntry) /* 193 */ #define Tcl_NotifyChannel \ (tclStubsPtr->tcl_NotifyChannel) /* 194 */ #define Tcl_ObjGetVar2 \ (tclStubsPtr->tcl_ObjGetVar2) /* 195 */ #define Tcl_ObjSetVar2 \ (tclStubsPtr->tcl_ObjSetVar2) /* 196 */ #define Tcl_OpenCommandChannel \ (tclStubsPtr->tcl_OpenCommandChannel) /* 197 */ #define Tcl_OpenFileChannel \ (tclStubsPtr->tcl_OpenFileChannel) /* 198 */ #define Tcl_OpenTcpClient \ (tclStubsPtr->tcl_OpenTcpClient) /* 199 */ #define Tcl_OpenTcpServer \ (tclStubsPtr->tcl_OpenTcpServer) /* 200 */ #define Tcl_Preserve \ (tclStubsPtr->tcl_Preserve) /* 201 */ #define Tcl_PrintDouble \ (tclStubsPtr->tcl_PrintDouble) /* 202 */ #define Tcl_PutEnv \ (tclStubsPtr->tcl_PutEnv) /* 203 */ #define Tcl_PosixError \ (tclStubsPtr->tcl_PosixError) /* 204 */ #define Tcl_QueueEvent \ (tclStubsPtr->tcl_QueueEvent) /* 205 */ #define Tcl_Read \ (tclStubsPtr->tcl_Read) /* 206 */ #define Tcl_ReapDetachedProcs \ (tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */ #define Tcl_RecordAndEval \ (tclStubsPtr->tcl_RecordAndEval) /* 208 */ #define Tcl_RecordAndEvalObj \ (tclStubsPtr->tcl_RecordAndEvalObj) /* 209 */ #define Tcl_RegisterChannel \ (tclStubsPtr->tcl_RegisterChannel) /* 210 */ #define Tcl_RegisterObjType \ (tclStubsPtr->tcl_RegisterObjType) /* 211 */ #define Tcl_RegExpCompile \ (tclStubsPtr->tcl_RegExpCompile) /* 212 */ #define Tcl_RegExpExec \ (tclStubsPtr->tcl_RegExpExec) /* 213 */ #define Tcl_RegExpMatch \ (tclStubsPtr->tcl_RegExpMatch) /* 214 */ #define Tcl_RegExpRange \ (tclStubsPtr->tcl_RegExpRange) /* 215 */ #define Tcl_Release \ (tclStubsPtr->tcl_Release) /* 216 */ #define Tcl_ResetResult \ (tclStubsPtr->tcl_ResetResult) /* 217 */ #define Tcl_ScanElement \ (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ #define Tcl_SeekOld \ (tclStubsPtr->tcl_SeekOld) /* 220 */ #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #define Tcl_ServiceEvent \ (tclStubsPtr->tcl_ServiceEvent) /* 222 */ #define Tcl_SetAssocData \ (tclStubsPtr->tcl_SetAssocData) /* 223 */ #define Tcl_SetChannelBufferSize \ (tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */ #define Tcl_SetChannelOption \ (tclStubsPtr->tcl_SetChannelOption) /* 225 */ #define Tcl_SetCommandInfo \ (tclStubsPtr->tcl_SetCommandInfo) /* 226 */ #define Tcl_SetErrno \ (tclStubsPtr->tcl_SetErrno) /* 227 */ #define Tcl_SetErrorCode \ (tclStubsPtr->tcl_SetErrorCode) /* 228 */ #define Tcl_SetMaxBlockTime \ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */ #define Tcl_SetPanicProc \ (tclStubsPtr->tcl_SetPanicProc) /* 230 */ #define Tcl_SetRecursionLimit \ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */ #define Tcl_SetResult \ (tclStubsPtr->tcl_SetResult) /* 232 */ #define Tcl_SetServiceMode \ (tclStubsPtr->tcl_SetServiceMode) /* 233 */ #define Tcl_SetObjErrorCode \ (tclStubsPtr->tcl_SetObjErrorCode) /* 234 */ #define Tcl_SetObjResult \ (tclStubsPtr->tcl_SetObjResult) /* 235 */ #define Tcl_SetStdChannel \ (tclStubsPtr->tcl_SetStdChannel) /* 236 */ #define Tcl_SetVar \ (tclStubsPtr->tcl_SetVar) /* 237 */ #define Tcl_SetVar2 \ (tclStubsPtr->tcl_SetVar2) /* 238 */ #define Tcl_SignalId \ (tclStubsPtr->tcl_SignalId) /* 239 */ #define Tcl_SignalMsg \ (tclStubsPtr->tcl_SignalMsg) /* 240 */ #define Tcl_SourceRCFile \ (tclStubsPtr->tcl_SourceRCFile) /* 241 */ #define Tcl_SplitList \ (tclStubsPtr->tcl_SplitList) /* 242 */ #define Tcl_SplitPath \ (tclStubsPtr->tcl_SplitPath) /* 243 */ #define Tcl_StaticPackage \ (tclStubsPtr->tcl_StaticPackage) /* 244 */ #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ #define Tcl_TellOld \ (tclStubsPtr->tcl_TellOld) /* 246 */ #define Tcl_TraceVar \ (tclStubsPtr->tcl_TraceVar) /* 247 */ #define Tcl_TraceVar2 \ (tclStubsPtr->tcl_TraceVar2) /* 248 */ #define Tcl_TranslateFileName \ (tclStubsPtr->tcl_TranslateFileName) /* 249 */ #define Tcl_Ungets \ (tclStubsPtr->tcl_Ungets) /* 250 */ #define Tcl_UnlinkVar \ (tclStubsPtr->tcl_UnlinkVar) /* 251 */ #define Tcl_UnregisterChannel \ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */ #define Tcl_UnsetVar \ (tclStubsPtr->tcl_UnsetVar) /* 253 */ #define Tcl_UnsetVar2 \ (tclStubsPtr->tcl_UnsetVar2) /* 254 */ #define Tcl_UntraceVar \ (tclStubsPtr->tcl_UntraceVar) /* 255 */ #define Tcl_UntraceVar2 \ (tclStubsPtr->tcl_UntraceVar2) /* 256 */ #define Tcl_UpdateLinkedVar \ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */ #define Tcl_UpVar \ (tclStubsPtr->tcl_UpVar) /* 258 */ #define Tcl_UpVar2 \ (tclStubsPtr->tcl_UpVar2) /* 259 */ #define Tcl_VarEval \ (tclStubsPtr->tcl_VarEval) /* 260 */ #define Tcl_VarTraceInfo \ (tclStubsPtr->tcl_VarTraceInfo) /* 261 */ #define Tcl_VarTraceInfo2 \ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */ #define Tcl_Write \ (tclStubsPtr->tcl_Write) /* 263 */ #define Tcl_WrongNumArgs \ (tclStubsPtr->tcl_WrongNumArgs) /* 264 */ #define Tcl_DumpActiveMemory \ (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */ #define Tcl_ValidateAllMemory \ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */ #define Tcl_AppendResultVA \ (tclStubsPtr->tcl_AppendResultVA) /* 267 */ #define Tcl_AppendStringsToObjVA \ (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */ #define Tcl_HashStats \ (tclStubsPtr->tcl_HashStats) /* 269 */ #define Tcl_ParseVar \ (tclStubsPtr->tcl_ParseVar) /* 270 */ #define Tcl_PkgPresent \ (tclStubsPtr->tcl_PkgPresent) /* 271 */ #define Tcl_PkgPresentEx \ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */ #define Tcl_PkgProvide \ (tclStubsPtr->tcl_PkgProvide) /* 273 */ #define Tcl_PkgRequire \ (tclStubsPtr->tcl_PkgRequire) /* 274 */ #define Tcl_SetErrorCodeVA \ (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ #define Tcl_VarEvalVA \ (tclStubsPtr->tcl_VarEvalVA) /* 276 */ #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ #define Tcl_PanicVA \ (tclStubsPtr->tcl_PanicVA) /* 278 */ #define Tcl_GetVersion \ (tclStubsPtr->tcl_GetVersion) /* 279 */ #define Tcl_InitMemory \ (tclStubsPtr->tcl_InitMemory) /* 280 */ #define Tcl_StackChannel \ (tclStubsPtr->tcl_StackChannel) /* 281 */ #define Tcl_UnstackChannel \ (tclStubsPtr->tcl_UnstackChannel) /* 282 */ #define Tcl_GetStackedChannel \ (tclStubsPtr->tcl_GetStackedChannel) /* 283 */ #define Tcl_SetMainLoop \ (tclStubsPtr->tcl_SetMainLoop) /* 284 */ /* Slot 285 is reserved */ #define Tcl_AppendObjToObj \ (tclStubsPtr->tcl_AppendObjToObj) /* 286 */ #define Tcl_CreateEncoding \ (tclStubsPtr->tcl_CreateEncoding) /* 287 */ #define Tcl_CreateThreadExitHandler \ (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ #define Tcl_DiscardResult \ (tclStubsPtr->tcl_DiscardResult) /* 290 */ #define Tcl_EvalEx \ (tclStubsPtr->tcl_EvalEx) /* 291 */ #define Tcl_EvalObjv \ (tclStubsPtr->tcl_EvalObjv) /* 292 */ #define Tcl_EvalObjEx \ (tclStubsPtr->tcl_EvalObjEx) /* 293 */ #define Tcl_ExitThread \ (tclStubsPtr->tcl_ExitThread) /* 294 */ #define Tcl_ExternalToUtf \ (tclStubsPtr->tcl_ExternalToUtf) /* 295 */ #define Tcl_ExternalToUtfDString \ (tclStubsPtr->tcl_ExternalToUtfDString) /* 296 */ #define Tcl_FinalizeThread \ (tclStubsPtr->tcl_FinalizeThread) /* 297 */ #define Tcl_FinalizeNotifier \ (tclStubsPtr->tcl_FinalizeNotifier) /* 298 */ #define Tcl_FreeEncoding \ (tclStubsPtr->tcl_FreeEncoding) /* 299 */ #define Tcl_GetCurrentThread \ (tclStubsPtr->tcl_GetCurrentThread) /* 300 */ #define Tcl_GetEncoding \ (tclStubsPtr->tcl_GetEncoding) /* 301 */ #define Tcl_GetEncodingName \ (tclStubsPtr->tcl_GetEncodingName) /* 302 */ #define Tcl_GetEncodingNames \ (tclStubsPtr->tcl_GetEncodingNames) /* 303 */ #define Tcl_GetIndexFromObjStruct \ (tclStubsPtr->tcl_GetIndexFromObjStruct) /* 304 */ #define Tcl_GetThreadData \ (tclStubsPtr->tcl_GetThreadData) /* 305 */ #define Tcl_GetVar2Ex \ (tclStubsPtr->tcl_GetVar2Ex) /* 306 */ #define Tcl_InitNotifier \ (tclStubsPtr->tcl_InitNotifier) /* 307 */ #define Tcl_MutexLock \ (tclStubsPtr->tcl_MutexLock) /* 308 */ #define Tcl_MutexUnlock \ (tclStubsPtr->tcl_MutexUnlock) /* 309 */ #define Tcl_ConditionNotify \ (tclStubsPtr->tcl_ConditionNotify) /* 310 */ #define Tcl_ConditionWait \ (tclStubsPtr->tcl_ConditionWait) /* 311 */ #define Tcl_NumUtfChars \ (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ #define Tcl_RestoreResult \ (tclStubsPtr->tcl_RestoreResult) /* 314 */ #define Tcl_SaveResult \ (tclStubsPtr->tcl_SaveResult) /* 315 */ #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #define Tcl_SetVar2Ex \ (tclStubsPtr->tcl_SetVar2Ex) /* 317 */ #define Tcl_ThreadAlert \ (tclStubsPtr->tcl_ThreadAlert) /* 318 */ #define Tcl_ThreadQueueEvent \ (tclStubsPtr->tcl_ThreadQueueEvent) /* 319 */ #define Tcl_UniCharAtIndex \ (tclStubsPtr->tcl_UniCharAtIndex) /* 320 */ #define Tcl_UniCharToLower \ (tclStubsPtr->tcl_UniCharToLower) /* 321 */ #define Tcl_UniCharToTitle \ (tclStubsPtr->tcl_UniCharToTitle) /* 322 */ #define Tcl_UniCharToUpper \ (tclStubsPtr->tcl_UniCharToUpper) /* 323 */ #define Tcl_UniCharToUtf \ (tclStubsPtr->tcl_UniCharToUtf) /* 324 */ #define Tcl_UtfAtIndex \ (tclStubsPtr->tcl_UtfAtIndex) /* 325 */ #define Tcl_UtfCharComplete \ (tclStubsPtr->tcl_UtfCharComplete) /* 326 */ #define Tcl_UtfBackslash \ (tclStubsPtr->tcl_UtfBackslash) /* 327 */ #define Tcl_UtfFindFirst \ (tclStubsPtr->tcl_UtfFindFirst) /* 328 */ #define Tcl_UtfFindLast \ (tclStubsPtr->tcl_UtfFindLast) /* 329 */ #define Tcl_UtfNext \ (tclStubsPtr->tcl_UtfNext) /* 330 */ #define Tcl_UtfPrev \ (tclStubsPtr->tcl_UtfPrev) /* 331 */ #define Tcl_UtfToExternal \ (tclStubsPtr->tcl_UtfToExternal) /* 332 */ #define Tcl_UtfToExternalDString \ (tclStubsPtr->tcl_UtfToExternalDString) /* 333 */ #define Tcl_UtfToLower \ (tclStubsPtr->tcl_UtfToLower) /* 334 */ #define Tcl_UtfToTitle \ (tclStubsPtr->tcl_UtfToTitle) /* 335 */ #define Tcl_UtfToUniChar \ (tclStubsPtr->tcl_UtfToUniChar) /* 336 */ #define Tcl_UtfToUpper \ (tclStubsPtr->tcl_UtfToUpper) /* 337 */ #define Tcl_WriteChars \ (tclStubsPtr->tcl_WriteChars) /* 338 */ #define Tcl_WriteObj \ (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ #define Tcl_GetDefaultEncodingDir \ (tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */ #define Tcl_SetDefaultEncodingDir \ (tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */ #define Tcl_AlertNotifier \ (tclStubsPtr->tcl_AlertNotifier) /* 343 */ #define Tcl_ServiceModeHook \ (tclStubsPtr->tcl_ServiceModeHook) /* 344 */ #define Tcl_UniCharIsAlnum \ (tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */ #define Tcl_UniCharIsAlpha \ (tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */ #define Tcl_UniCharIsDigit \ (tclStubsPtr->tcl_UniCharIsDigit) /* 347 */ #define Tcl_UniCharIsLower \ (tclStubsPtr->tcl_UniCharIsLower) /* 348 */ #define Tcl_UniCharIsSpace \ (tclStubsPtr->tcl_UniCharIsSpace) /* 349 */ #define Tcl_UniCharIsUpper \ (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ #define Tcl_UniCharLen \ (tclStubsPtr->tcl_UniCharLen) /* 352 */ #define Tcl_UniCharNcmp \ (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ #define Tcl_UniCharToUtfDString \ (tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */ #define Tcl_UtfToUniCharDString \ (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ #define Tcl_EvalTokens \ (tclStubsPtr->tcl_EvalTokens) /* 357 */ #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #define Tcl_LogCommandInfo \ (tclStubsPtr->tcl_LogCommandInfo) /* 359 */ #define Tcl_ParseBraces \ (tclStubsPtr->tcl_ParseBraces) /* 360 */ #define Tcl_ParseCommand \ (tclStubsPtr->tcl_ParseCommand) /* 361 */ #define Tcl_ParseExpr \ (tclStubsPtr->tcl_ParseExpr) /* 362 */ #define Tcl_ParseQuotedString \ (tclStubsPtr->tcl_ParseQuotedString) /* 363 */ #define Tcl_ParseVarName \ (tclStubsPtr->tcl_ParseVarName) /* 364 */ #define Tcl_GetCwd \ (tclStubsPtr->tcl_GetCwd) /* 365 */ #define Tcl_Chdir \ (tclStubsPtr->tcl_Chdir) /* 366 */ #define Tcl_Access \ (tclStubsPtr->tcl_Access) /* 367 */ #define Tcl_Stat \ (tclStubsPtr->tcl_Stat) /* 368 */ #define Tcl_UtfNcmp \ (tclStubsPtr->tcl_UtfNcmp) /* 369 */ #define Tcl_UtfNcasecmp \ (tclStubsPtr->tcl_UtfNcasecmp) /* 370 */ #define Tcl_StringCaseMatch \ (tclStubsPtr->tcl_StringCaseMatch) /* 371 */ #define Tcl_UniCharIsControl \ (tclStubsPtr->tcl_UniCharIsControl) /* 372 */ #define Tcl_UniCharIsGraph \ (tclStubsPtr->tcl_UniCharIsGraph) /* 373 */ #define Tcl_UniCharIsPrint \ (tclStubsPtr->tcl_UniCharIsPrint) /* 374 */ #define Tcl_UniCharIsPunct \ (tclStubsPtr->tcl_UniCharIsPunct) /* 375 */ #define Tcl_RegExpExecObj \ (tclStubsPtr->tcl_RegExpExecObj) /* 376 */ #define Tcl_RegExpGetInfo \ (tclStubsPtr->tcl_RegExpGetInfo) /* 377 */ #define Tcl_NewUnicodeObj \ (tclStubsPtr->tcl_NewUnicodeObj) /* 378 */ #define Tcl_SetUnicodeObj \ (tclStubsPtr->tcl_SetUnicodeObj) /* 379 */ #define Tcl_GetCharLength \ (tclStubsPtr->tcl_GetCharLength) /* 380 */ #define Tcl_GetUniChar \ (tclStubsPtr->tcl_GetUniChar) /* 381 */ #define Tcl_GetUnicode \ (tclStubsPtr->tcl_GetUnicode) /* 382 */ #define Tcl_GetRange \ (tclStubsPtr->tcl_GetRange) /* 383 */ #define Tcl_AppendUnicodeToObj \ (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */ #define Tcl_RegExpMatchObj \ (tclStubsPtr->tcl_RegExpMatchObj) /* 385 */ #define Tcl_SetNotifier \ (tclStubsPtr->tcl_SetNotifier) /* 386 */ #define Tcl_GetAllocMutex \ (tclStubsPtr->tcl_GetAllocMutex) /* 387 */ #define Tcl_GetChannelNames \ (tclStubsPtr->tcl_GetChannelNames) /* 388 */ #define Tcl_GetChannelNamesEx \ (tclStubsPtr->tcl_GetChannelNamesEx) /* 389 */ #define Tcl_ProcObjCmd \ (tclStubsPtr->tcl_ProcObjCmd) /* 390 */ #define Tcl_ConditionFinalize \ (tclStubsPtr->tcl_ConditionFinalize) /* 391 */ #define Tcl_MutexFinalize \ (tclStubsPtr->tcl_MutexFinalize) /* 392 */ #define Tcl_CreateThread \ (tclStubsPtr->tcl_CreateThread) /* 393 */ #define Tcl_ReadRaw \ (tclStubsPtr->tcl_ReadRaw) /* 394 */ #define Tcl_WriteRaw \ (tclStubsPtr->tcl_WriteRaw) /* 395 */ #define Tcl_GetTopChannel \ (tclStubsPtr->tcl_GetTopChannel) /* 396 */ #define Tcl_ChannelBuffered \ (tclStubsPtr->tcl_ChannelBuffered) /* 397 */ #define Tcl_ChannelName \ (tclStubsPtr->tcl_ChannelName) /* 398 */ #define Tcl_ChannelVersion \ (tclStubsPtr->tcl_ChannelVersion) /* 399 */ #define Tcl_ChannelBlockModeProc \ (tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */ #define Tcl_ChannelCloseProc \ (tclStubsPtr->tcl_ChannelCloseProc) /* 401 */ #define Tcl_ChannelClose2Proc \ (tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */ #define Tcl_ChannelInputProc \ (tclStubsPtr->tcl_ChannelInputProc) /* 403 */ #define Tcl_ChannelOutputProc \ (tclStubsPtr->tcl_ChannelOutputProc) /* 404 */ #define Tcl_ChannelSeekProc \ (tclStubsPtr->tcl_ChannelSeekProc) /* 405 */ #define Tcl_ChannelSetOptionProc \ (tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */ #define Tcl_ChannelGetOptionProc \ (tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */ #define Tcl_ChannelWatchProc \ (tclStubsPtr->tcl_ChannelWatchProc) /* 408 */ #define Tcl_ChannelGetHandleProc \ (tclStubsPtr->tcl_ChannelGetHandleProc) /* 409 */ #define Tcl_ChannelFlushProc \ (tclStubsPtr->tcl_ChannelFlushProc) /* 410 */ #define Tcl_ChannelHandlerProc \ (tclStubsPtr->tcl_ChannelHandlerProc) /* 411 */ #define Tcl_JoinThread \ (tclStubsPtr->tcl_JoinThread) /* 412 */ #define Tcl_IsChannelShared \ (tclStubsPtr->tcl_IsChannelShared) /* 413 */ #define Tcl_IsChannelRegistered \ (tclStubsPtr->tcl_IsChannelRegistered) /* 414 */ #define Tcl_CutChannel \ (tclStubsPtr->tcl_CutChannel) /* 415 */ #define Tcl_SpliceChannel \ (tclStubsPtr->tcl_SpliceChannel) /* 416 */ #define Tcl_ClearChannelHandlers \ (tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */ #define Tcl_IsChannelExisting \ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ #define Tcl_UniCharNcasecmp \ (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ #define Tcl_FindHashEntry \ (tclStubsPtr->tcl_FindHashEntry) /* 421 */ #define Tcl_CreateHashEntry \ (tclStubsPtr->tcl_CreateHashEntry) /* 422 */ #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #define Tcl_InitObjHashTable \ (tclStubsPtr->tcl_InitObjHashTable) /* 424 */ #define Tcl_CommandTraceInfo \ (tclStubsPtr->tcl_CommandTraceInfo) /* 425 */ #define Tcl_TraceCommand \ (tclStubsPtr->tcl_TraceCommand) /* 426 */ #define Tcl_UntraceCommand \ (tclStubsPtr->tcl_UntraceCommand) /* 427 */ #define Tcl_AttemptAlloc \ (tclStubsPtr->tcl_AttemptAlloc) /* 428 */ #define Tcl_AttemptDbCkalloc \ (tclStubsPtr->tcl_AttemptDbCkalloc) /* 429 */ #define Tcl_AttemptRealloc \ (tclStubsPtr->tcl_AttemptRealloc) /* 430 */ #define Tcl_AttemptDbCkrealloc \ (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */ #define Tcl_AttemptSetObjLength \ (tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */ #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ #define Tcl_GetMathFuncInfo \ (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */ #define Tcl_ListMathFuncs \ (tclStubsPtr->tcl_ListMathFuncs) /* 436 */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ (tclStubsPtr->tcl_DetachChannel) /* 438 */ #define Tcl_IsStandardChannel \ (tclStubsPtr->tcl_IsStandardChannel) /* 439 */ #define Tcl_FSCopyFile \ (tclStubsPtr->tcl_FSCopyFile) /* 440 */ #define Tcl_FSCopyDirectory \ (tclStubsPtr->tcl_FSCopyDirectory) /* 441 */ #define Tcl_FSCreateDirectory \ (tclStubsPtr->tcl_FSCreateDirectory) /* 442 */ #define Tcl_FSDeleteFile \ (tclStubsPtr->tcl_FSDeleteFile) /* 443 */ #define Tcl_FSLoadFile \ (tclStubsPtr->tcl_FSLoadFile) /* 444 */ #define Tcl_FSMatchInDirectory \ (tclStubsPtr->tcl_FSMatchInDirectory) /* 445 */ #define Tcl_FSLink \ (tclStubsPtr->tcl_FSLink) /* 446 */ #define Tcl_FSRemoveDirectory \ (tclStubsPtr->tcl_FSRemoveDirectory) /* 447 */ #define Tcl_FSRenameFile \ (tclStubsPtr->tcl_FSRenameFile) /* 448 */ #define Tcl_FSLstat \ (tclStubsPtr->tcl_FSLstat) /* 449 */ #define Tcl_FSUtime \ (tclStubsPtr->tcl_FSUtime) /* 450 */ #define Tcl_FSFileAttrsGet \ (tclStubsPtr->tcl_FSFileAttrsGet) /* 451 */ #define Tcl_FSFileAttrsSet \ (tclStubsPtr->tcl_FSFileAttrsSet) /* 452 */ #define Tcl_FSFileAttrStrings \ (tclStubsPtr->tcl_FSFileAttrStrings) /* 453 */ #define Tcl_FSStat \ (tclStubsPtr->tcl_FSStat) /* 454 */ #define Tcl_FSAccess \ (tclStubsPtr->tcl_FSAccess) /* 455 */ #define Tcl_FSOpenFileChannel \ (tclStubsPtr->tcl_FSOpenFileChannel) /* 456 */ #define Tcl_FSGetCwd \ (tclStubsPtr->tcl_FSGetCwd) /* 457 */ #define Tcl_FSChdir \ (tclStubsPtr->tcl_FSChdir) /* 458 */ #define Tcl_FSConvertToPathType \ (tclStubsPtr->tcl_FSConvertToPathType) /* 459 */ #define Tcl_FSJoinPath \ (tclStubsPtr->tcl_FSJoinPath) /* 460 */ #define Tcl_FSSplitPath \ (tclStubsPtr->tcl_FSSplitPath) /* 461 */ #define Tcl_FSEqualPaths \ (tclStubsPtr->tcl_FSEqualPaths) /* 462 */ #define Tcl_FSGetNormalizedPath \ (tclStubsPtr->tcl_FSGetNormalizedPath) /* 463 */ #define Tcl_FSJoinToPath \ (tclStubsPtr->tcl_FSJoinToPath) /* 464 */ #define Tcl_FSGetInternalRep \ (tclStubsPtr->tcl_FSGetInternalRep) /* 465 */ #define Tcl_FSGetTranslatedPath \ (tclStubsPtr->tcl_FSGetTranslatedPath) /* 466 */ #define Tcl_FSEvalFile \ (tclStubsPtr->tcl_FSEvalFile) /* 467 */ #define Tcl_FSNewNativePath \ (tclStubsPtr->tcl_FSNewNativePath) /* 468 */ #define Tcl_FSGetNativePath \ (tclStubsPtr->tcl_FSGetNativePath) /* 469 */ #define Tcl_FSFileSystemInfo \ (tclStubsPtr->tcl_FSFileSystemInfo) /* 470 */ #define Tcl_FSPathSeparator \ (tclStubsPtr->tcl_FSPathSeparator) /* 471 */ #define Tcl_FSListVolumes \ (tclStubsPtr->tcl_FSListVolumes) /* 472 */ #define Tcl_FSRegister \ (tclStubsPtr->tcl_FSRegister) /* 473 */ #define Tcl_FSUnregister \ (tclStubsPtr->tcl_FSUnregister) /* 474 */ #define Tcl_FSData \ (tclStubsPtr->tcl_FSData) /* 475 */ #define Tcl_FSGetTranslatedStringPath \ (tclStubsPtr->tcl_FSGetTranslatedStringPath) /* 476 */ #define Tcl_FSGetFileSystemForPath \ (tclStubsPtr->tcl_FSGetFileSystemForPath) /* 477 */ #define Tcl_FSGetPathType \ (tclStubsPtr->tcl_FSGetPathType) /* 478 */ #define Tcl_OutputBuffered \ (tclStubsPtr->tcl_OutputBuffered) /* 479 */ #define Tcl_FSMountsChanged \ (tclStubsPtr->tcl_FSMountsChanged) /* 480 */ #define Tcl_EvalTokensStandard \ (tclStubsPtr->tcl_EvalTokensStandard) /* 481 */ #define Tcl_GetTime \ (tclStubsPtr->tcl_GetTime) /* 482 */ #define Tcl_CreateObjTrace \ (tclStubsPtr->tcl_CreateObjTrace) /* 483 */ #define Tcl_GetCommandInfoFromToken \ (tclStubsPtr->tcl_GetCommandInfoFromToken) /* 484 */ #define Tcl_SetCommandInfoFromToken \ (tclStubsPtr->tcl_SetCommandInfoFromToken) /* 485 */ #define Tcl_DbNewWideIntObj \ (tclStubsPtr->tcl_DbNewWideIntObj) /* 486 */ #define Tcl_GetWideIntFromObj \ (tclStubsPtr->tcl_GetWideIntFromObj) /* 487 */ #define Tcl_NewWideIntObj \ (tclStubsPtr->tcl_NewWideIntObj) /* 488 */ #define Tcl_SetWideIntObj \ (tclStubsPtr->tcl_SetWideIntObj) /* 489 */ #define Tcl_AllocStatBuf \ (tclStubsPtr->tcl_AllocStatBuf) /* 490 */ #define Tcl_Seek \ (tclStubsPtr->tcl_Seek) /* 491 */ #define Tcl_Tell \ (tclStubsPtr->tcl_Tell) /* 492 */ #define Tcl_ChannelWideSeekProc \ (tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */ #define Tcl_DictObjPut \ (tclStubsPtr->tcl_DictObjPut) /* 494 */ #define Tcl_DictObjGet \ (tclStubsPtr->tcl_DictObjGet) /* 495 */ #define Tcl_DictObjRemove \ (tclStubsPtr->tcl_DictObjRemove) /* 496 */ #define Tcl_DictObjSize \ (tclStubsPtr->tcl_DictObjSize) /* 497 */ #define Tcl_DictObjFirst \ (tclStubsPtr->tcl_DictObjFirst) /* 498 */ #define Tcl_DictObjNext \ (tclStubsPtr->tcl_DictObjNext) /* 499 */ #define Tcl_DictObjDone \ (tclStubsPtr->tcl_DictObjDone) /* 500 */ #define Tcl_DictObjPutKeyList \ (tclStubsPtr->tcl_DictObjPutKeyList) /* 501 */ #define Tcl_DictObjRemoveKeyList \ (tclStubsPtr->tcl_DictObjRemoveKeyList) /* 502 */ #define Tcl_NewDictObj \ (tclStubsPtr->tcl_NewDictObj) /* 503 */ #define Tcl_DbNewDictObj \ (tclStubsPtr->tcl_DbNewDictObj) /* 504 */ #define Tcl_RegisterConfig \ (tclStubsPtr->tcl_RegisterConfig) /* 505 */ #define Tcl_CreateNamespace \ (tclStubsPtr->tcl_CreateNamespace) /* 506 */ #define Tcl_DeleteNamespace \ (tclStubsPtr->tcl_DeleteNamespace) /* 507 */ #define Tcl_AppendExportList \ (tclStubsPtr->tcl_AppendExportList) /* 508 */ #define Tcl_Export \ (tclStubsPtr->tcl_Export) /* 509 */ #define Tcl_Import \ (tclStubsPtr->tcl_Import) /* 510 */ #define Tcl_ForgetImport \ (tclStubsPtr->tcl_ForgetImport) /* 511 */ #define Tcl_GetCurrentNamespace \ (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */ #define Tcl_GetGlobalNamespace \ (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */ #define Tcl_FindNamespace \ (tclStubsPtr->tcl_FindNamespace) /* 514 */ #define Tcl_FindCommand \ (tclStubsPtr->tcl_FindCommand) /* 515 */ #define Tcl_GetCommandFromObj \ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ #define Tcl_GetCommandFullName \ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ #define Tcl_FSEvalFileEx \ (tclStubsPtr->tcl_FSEvalFileEx) /* 518 */ #define Tcl_SetExitProc \ (tclStubsPtr->tcl_SetExitProc) /* 519 */ #define Tcl_LimitAddHandler \ (tclStubsPtr->tcl_LimitAddHandler) /* 520 */ #define Tcl_LimitRemoveHandler \ (tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */ #define Tcl_LimitReady \ (tclStubsPtr->tcl_LimitReady) /* 522 */ #define Tcl_LimitCheck \ (tclStubsPtr->tcl_LimitCheck) /* 523 */ #define Tcl_LimitExceeded \ (tclStubsPtr->tcl_LimitExceeded) /* 524 */ #define Tcl_LimitSetCommands \ (tclStubsPtr->tcl_LimitSetCommands) /* 525 */ #define Tcl_LimitSetTime \ (tclStubsPtr->tcl_LimitSetTime) /* 526 */ #define Tcl_LimitSetGranularity \ (tclStubsPtr->tcl_LimitSetGranularity) /* 527 */ #define Tcl_LimitTypeEnabled \ (tclStubsPtr->tcl_LimitTypeEnabled) /* 528 */ #define Tcl_LimitTypeExceeded \ (tclStubsPtr->tcl_LimitTypeExceeded) /* 529 */ #define Tcl_LimitTypeSet \ (tclStubsPtr->tcl_LimitTypeSet) /* 530 */ #define Tcl_LimitTypeReset \ (tclStubsPtr->tcl_LimitTypeReset) /* 531 */ #define Tcl_LimitGetCommands \ (tclStubsPtr->tcl_LimitGetCommands) /* 532 */ #define Tcl_LimitGetTime \ (tclStubsPtr->tcl_LimitGetTime) /* 533 */ #define Tcl_LimitGetGranularity \ (tclStubsPtr->tcl_LimitGetGranularity) /* 534 */ #define Tcl_SaveInterpState \ (tclStubsPtr->tcl_SaveInterpState) /* 535 */ #define Tcl_RestoreInterpState \ (tclStubsPtr->tcl_RestoreInterpState) /* 536 */ #define Tcl_DiscardInterpState \ (tclStubsPtr->tcl_DiscardInterpState) /* 537 */ #define Tcl_SetReturnOptions \ (tclStubsPtr->tcl_SetReturnOptions) /* 538 */ #define Tcl_GetReturnOptions \ (tclStubsPtr->tcl_GetReturnOptions) /* 539 */ #define Tcl_IsEnsemble \ (tclStubsPtr->tcl_IsEnsemble) /* 540 */ #define Tcl_CreateEnsemble \ (tclStubsPtr->tcl_CreateEnsemble) /* 541 */ #define Tcl_FindEnsemble \ (tclStubsPtr->tcl_FindEnsemble) /* 542 */ #define Tcl_SetEnsembleSubcommandList \ (tclStubsPtr->tcl_SetEnsembleSubcommandList) /* 543 */ #define Tcl_SetEnsembleMappingDict \ (tclStubsPtr->tcl_SetEnsembleMappingDict) /* 544 */ #define Tcl_SetEnsembleUnknownHandler \ (tclStubsPtr->tcl_SetEnsembleUnknownHandler) /* 545 */ #define Tcl_SetEnsembleFlags \ (tclStubsPtr->tcl_SetEnsembleFlags) /* 546 */ #define Tcl_GetEnsembleSubcommandList \ (tclStubsPtr->tcl_GetEnsembleSubcommandList) /* 547 */ #define Tcl_GetEnsembleMappingDict \ (tclStubsPtr->tcl_GetEnsembleMappingDict) /* 548 */ #define Tcl_GetEnsembleUnknownHandler \ (tclStubsPtr->tcl_GetEnsembleUnknownHandler) /* 549 */ #define Tcl_GetEnsembleFlags \ (tclStubsPtr->tcl_GetEnsembleFlags) /* 550 */ #define Tcl_GetEnsembleNamespace \ (tclStubsPtr->tcl_GetEnsembleNamespace) /* 551 */ #define Tcl_SetTimeProc \ (tclStubsPtr->tcl_SetTimeProc) /* 552 */ #define Tcl_QueryTimeProc \ (tclStubsPtr->tcl_QueryTimeProc) /* 553 */ #define Tcl_ChannelThreadActionProc \ (tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */ #define Tcl_NewBignumObj \ (tclStubsPtr->tcl_NewBignumObj) /* 555 */ #define Tcl_DbNewBignumObj \ (tclStubsPtr->tcl_DbNewBignumObj) /* 556 */ #define Tcl_SetBignumObj \ (tclStubsPtr->tcl_SetBignumObj) /* 557 */ #define Tcl_GetBignumFromObj \ (tclStubsPtr->tcl_GetBignumFromObj) /* 558 */ #define Tcl_TakeBignumFromObj \ (tclStubsPtr->tcl_TakeBignumFromObj) /* 559 */ #define Tcl_TruncateChannel \ (tclStubsPtr->tcl_TruncateChannel) /* 560 */ #define Tcl_ChannelTruncateProc \ (tclStubsPtr->tcl_ChannelTruncateProc) /* 561 */ #define Tcl_SetChannelErrorInterp \ (tclStubsPtr->tcl_SetChannelErrorInterp) /* 562 */ #define Tcl_GetChannelErrorInterp \ (tclStubsPtr->tcl_GetChannelErrorInterp) /* 563 */ #define Tcl_SetChannelError \ (tclStubsPtr->tcl_SetChannelError) /* 564 */ #define Tcl_GetChannelError \ (tclStubsPtr->tcl_GetChannelError) /* 565 */ #define Tcl_InitBignumFromDouble \ (tclStubsPtr->tcl_InitBignumFromDouble) /* 566 */ #define Tcl_GetNamespaceUnknownHandler \ (tclStubsPtr->tcl_GetNamespaceUnknownHandler) /* 567 */ #define Tcl_SetNamespaceUnknownHandler \ (tclStubsPtr->tcl_SetNamespaceUnknownHandler) /* 568 */ #define Tcl_GetEncodingFromObj \ (tclStubsPtr->tcl_GetEncodingFromObj) /* 569 */ #define Tcl_GetEncodingSearchPath \ (tclStubsPtr->tcl_GetEncodingSearchPath) /* 570 */ #define Tcl_SetEncodingSearchPath \ (tclStubsPtr->tcl_SetEncodingSearchPath) /* 571 */ #define Tcl_GetEncodingNameFromEnvironment \ (tclStubsPtr->tcl_GetEncodingNameFromEnvironment) /* 572 */ #define Tcl_PkgRequireProc \ (tclStubsPtr->tcl_PkgRequireProc) /* 573 */ #define Tcl_AppendObjToErrorInfo \ (tclStubsPtr->tcl_AppendObjToErrorInfo) /* 574 */ #define Tcl_AppendLimitedToObj \ (tclStubsPtr->tcl_AppendLimitedToObj) /* 575 */ #define Tcl_Format \ (tclStubsPtr->tcl_Format) /* 576 */ #define Tcl_AppendFormatToObj \ (tclStubsPtr->tcl_AppendFormatToObj) /* 577 */ #define Tcl_ObjPrintf \ (tclStubsPtr->tcl_ObjPrintf) /* 578 */ #define Tcl_AppendPrintfToObj \ (tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */ #define Tcl_CancelEval \ (tclStubsPtr->tcl_CancelEval) /* 580 */ #define Tcl_Canceled \ (tclStubsPtr->tcl_Canceled) /* 581 */ #define Tcl_CreatePipe \ (tclStubsPtr->tcl_CreatePipe) /* 582 */ #define Tcl_NRCreateCommand \ (tclStubsPtr->tcl_NRCreateCommand) /* 583 */ #define Tcl_NREvalObj \ (tclStubsPtr->tcl_NREvalObj) /* 584 */ #define Tcl_NREvalObjv \ (tclStubsPtr->tcl_NREvalObjv) /* 585 */ #define Tcl_NRCmdSwap \ (tclStubsPtr->tcl_NRCmdSwap) /* 586 */ #define Tcl_NRAddCallback \ (tclStubsPtr->tcl_NRAddCallback) /* 587 */ #define Tcl_NRCallObjProc \ (tclStubsPtr->tcl_NRCallObjProc) /* 588 */ #define Tcl_GetFSDeviceFromStat \ (tclStubsPtr->tcl_GetFSDeviceFromStat) /* 589 */ #define Tcl_GetFSInodeFromStat \ (tclStubsPtr->tcl_GetFSInodeFromStat) /* 590 */ #define Tcl_GetModeFromStat \ (tclStubsPtr->tcl_GetModeFromStat) /* 591 */ #define Tcl_GetLinkCountFromStat \ (tclStubsPtr->tcl_GetLinkCountFromStat) /* 592 */ #define Tcl_GetUserIdFromStat \ (tclStubsPtr->tcl_GetUserIdFromStat) /* 593 */ #define Tcl_GetGroupIdFromStat \ (tclStubsPtr->tcl_GetGroupIdFromStat) /* 594 */ #define Tcl_GetDeviceTypeFromStat \ (tclStubsPtr->tcl_GetDeviceTypeFromStat) /* 595 */ #define Tcl_GetAccessTimeFromStat \ (tclStubsPtr->tcl_GetAccessTimeFromStat) /* 596 */ #define Tcl_GetModificationTimeFromStat \ (tclStubsPtr->tcl_GetModificationTimeFromStat) /* 597 */ #define Tcl_GetChangeTimeFromStat \ (tclStubsPtr->tcl_GetChangeTimeFromStat) /* 598 */ #define Tcl_GetSizeFromStat \ (tclStubsPtr->tcl_GetSizeFromStat) /* 599 */ #define Tcl_GetBlocksFromStat \ (tclStubsPtr->tcl_GetBlocksFromStat) /* 600 */ #define Tcl_GetBlockSizeFromStat \ (tclStubsPtr->tcl_GetBlockSizeFromStat) /* 601 */ #define Tcl_SetEnsembleParameterList \ (tclStubsPtr->tcl_SetEnsembleParameterList) /* 602 */ #define Tcl_GetEnsembleParameterList \ (tclStubsPtr->tcl_GetEnsembleParameterList) /* 603 */ #define Tcl_ParseArgsObjv \ (tclStubsPtr->tcl_ParseArgsObjv) /* 604 */ #define Tcl_GetErrorLine \ (tclStubsPtr->tcl_GetErrorLine) /* 605 */ #define Tcl_SetErrorLine \ (tclStubsPtr->tcl_SetErrorLine) /* 606 */ #define Tcl_TransferResult \ (tclStubsPtr->tcl_TransferResult) /* 607 */ #define Tcl_InterpActive \ (tclStubsPtr->tcl_InterpActive) /* 608 */ #define Tcl_BackgroundException \ (tclStubsPtr->tcl_BackgroundException) /* 609 */ #define Tcl_ZlibDeflate \ (tclStubsPtr->tcl_ZlibDeflate) /* 610 */ #define Tcl_ZlibInflate \ (tclStubsPtr->tcl_ZlibInflate) /* 611 */ #define Tcl_ZlibCRC32 \ (tclStubsPtr->tcl_ZlibCRC32) /* 612 */ #define Tcl_ZlibAdler32 \ (tclStubsPtr->tcl_ZlibAdler32) /* 613 */ #define Tcl_ZlibStreamInit \ (tclStubsPtr->tcl_ZlibStreamInit) /* 614 */ #define Tcl_ZlibStreamGetCommandName \ (tclStubsPtr->tcl_ZlibStreamGetCommandName) /* 615 */ #define Tcl_ZlibStreamEof \ (tclStubsPtr->tcl_ZlibStreamEof) /* 616 */ #define Tcl_ZlibStreamChecksum \ (tclStubsPtr->tcl_ZlibStreamChecksum) /* 617 */ #define Tcl_ZlibStreamPut \ (tclStubsPtr->tcl_ZlibStreamPut) /* 618 */ #define Tcl_ZlibStreamGet \ (tclStubsPtr->tcl_ZlibStreamGet) /* 619 */ #define Tcl_ZlibStreamClose \ (tclStubsPtr->tcl_ZlibStreamClose) /* 620 */ #define Tcl_ZlibStreamReset \ (tclStubsPtr->tcl_ZlibStreamReset) /* 621 */ #define Tcl_SetStartupScript \ (tclStubsPtr->tcl_SetStartupScript) /* 622 */ #define Tcl_GetStartupScript \ (tclStubsPtr->tcl_GetStartupScript) /* 623 */ #define Tcl_CloseEx \ (tclStubsPtr->tcl_CloseEx) /* 624 */ #define Tcl_NRExprObj \ (tclStubsPtr->tcl_NRExprObj) /* 625 */ #define Tcl_NRSubstObj \ (tclStubsPtr->tcl_NRSubstObj) /* 626 */ #define Tcl_LoadFile \ (tclStubsPtr->tcl_LoadFile) /* 627 */ #define Tcl_FindSymbol \ (tclStubsPtr->tcl_FindSymbol) /* 628 */ #define Tcl_FSUnloadFile \ (tclStubsPtr->tcl_FSUnloadFile) /* 629 */ #define Tcl_ZlibStreamSetCompressionDictionary \ (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ /* Slot 631 is reserved */ /* Slot 632 is reserved */ /* Slot 633 is reserved */ /* Slot 634 is reserved */ /* Slot 635 is reserved */ /* Slot 636 is reserved */ /* Slot 637 is reserved */ /* Slot 638 is reserved */ /* Slot 639 is reserved */ /* Slot 640 is reserved */ /* Slot 641 is reserved */ /* Slot 642 is reserved */ /* Slot 643 is reserved */ /* Slot 644 is reserved */ /* Slot 645 is reserved */ /* Slot 646 is reserved */ /* Slot 647 is reserved */ /* Slot 648 is reserved */ /* Slot 649 is reserved */ /* Slot 650 is reserved */ /* Slot 651 is reserved */ /* Slot 652 is reserved */ /* Slot 653 is reserved */ /* Slot 654 is reserved */ /* Slot 655 is reserved */ /* Slot 656 is reserved */ /* Slot 657 is reserved */ /* Slot 658 is reserved */ /* Slot 659 is reserved */ /* Slot 660 is reserved */ /* Slot 661 is reserved */ /* Slot 662 is reserved */ /* Slot 663 is reserved */ /* Slot 664 is reserved */ /* Slot 665 is reserved */ /* Slot 666 is reserved */ /* Slot 667 is reserved */ /* Slot 668 is reserved */ /* Slot 669 is reserved */ /* Slot 670 is reserved */ /* Slot 671 is reserved */ /* Slot 672 is reserved */ /* Slot 673 is reserved */ /* Slot 674 is reserved */ /* Slot 675 is reserved */ /* Slot 676 is reserved */ /* Slot 677 is reserved */ /* Slot 678 is reserved */ /* Slot 679 is reserved */ /* Slot 680 is reserved */ /* Slot 681 is reserved */ /* Slot 682 is reserved */ /* Slot 683 is reserved */ /* Slot 684 is reserved */ /* Slot 685 is reserved */ /* Slot 686 is reserved */ /* Slot 687 is reserved */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 688 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp # undef Tcl_FindExecutable # undef Tcl_GetStringResult # undef Tcl_Init # undef Tcl_SetPanicProc # undef Tcl_SetVar # undef Tcl_ObjSetVar2 # undef Tcl_StaticPackage # define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp()) # define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp)) # define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp)) # define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc)) # define Tcl_SetVar(interp, varName, newValue, flags) \ (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags)) # define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \ (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags)) #ifndef __cplusplus # undef Tcl_EventuallyFree # define Tcl_EventuallyFree \ ((void (*)(void *,void *))(void *)(tclStubsPtr->tcl_EventuallyFree)) /* 132 */ # undef Tcl_SetResult # define Tcl_SetResult \ ((void (*)(Tcl_Interp *, char *, void *))(void *)(tclStubsPtr->tcl_SetResult)) /* 232 */ #endif #endif #if defined(_WIN32) && defined(UNICODE) # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) # define Tcl_MainEx Tcl_MainExW EXTERN void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #undef Tcl_SeekOld #undef Tcl_TellOld #undef Tcl_PkgPresent #define Tcl_PkgPresent(interp, name, version, exact) \ Tcl_PkgPresentEx(interp, name, version, exact, NULL) #undef Tcl_PkgProvide #define Tcl_PkgProvide(interp, name, version) \ Tcl_PkgProvideEx(interp, name, version, NULL) #undef Tcl_PkgRequire #define Tcl_PkgRequire(interp, name, version, exact) \ Tcl_PkgRequireEx(interp, name, version, exact, NULL) #undef Tcl_GetIndexFromObj #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ sizeof(char *), msg, flags, indexPtr) #undef Tcl_NewBooleanObj #define Tcl_NewBooleanObj(intValue) \ Tcl_NewIntObj((intValue)!=0) #undef Tcl_DbNewBooleanObj #define Tcl_DbNewBooleanObj(intValue, file, line) \ Tcl_DbNewLongObj((intValue)!=0, file, line) #undef Tcl_SetBooleanObj #define Tcl_SetBooleanObj(objPtr, intValue) \ Tcl_SetIntObj((objPtr), (intValue)!=0) #undef Tcl_SetVar #define Tcl_SetVar(interp, varName, newValue, flags) \ Tcl_SetVar2(interp, varName, NULL, newValue, flags) #undef Tcl_UnsetVar #define Tcl_UnsetVar(interp, varName, flags) \ Tcl_UnsetVar2(interp, varName, NULL, flags) #undef Tcl_GetVar #define Tcl_GetVar(interp, varName, flags) \ Tcl_GetVar2(interp, varName, NULL, flags) #undef Tcl_TraceVar #define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData) #undef Tcl_UntraceVar #define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) #undef Tcl_VarTraceInfo #define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) #undef Tcl_UpVar #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) #if defined(USE_TCL_STUBS) # if defined(_WIN32) && defined(_WIN64) # undef Tcl_GetTime /* Handle Win64 tk.dll being loaded in Cygwin64. */ # define Tcl_GetTime(t) \ do { \ struct { \ Tcl_Time now; \ __int64 reserved; \ } _t; \ _t.reserved = -1; \ tclStubsPtr->tcl_GetTime((&_t.now)); \ if (_t.reserved != -1) { \ _t.now.usec = (long) _t.reserved; \ } \ *(t) = _t.now; \ } while (0) # endif # if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG) /* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore * we have to make sure that all stub entries on Cygwin64 follow the * Win64 signature. Cygwin64 stubbed extensions cannot use those stub * entries any more, they should use the 64-bit alternatives where * possible. Tcl 9 must find a better solution, but that cannot be done * without introducing a binary incompatibility. */ # undef Tcl_DbNewLongObj # undef Tcl_GetLongFromObj # undef Tcl_NewLongObj # undef Tcl_SetLongObj # undef Tcl_ExprLong # undef Tcl_ExprLongObj # undef Tcl_UniCharNcmp # undef Tcl_UtfNcmp # undef Tcl_UtfNcasecmp # undef Tcl_UniCharNcasecmp # define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))(void *)Tcl_DbNewWideIntObj) # define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)Tcl_GetWideIntFromObj) # define Tcl_NewLongObj ((Tcl_Obj*(*)(long))(void *)Tcl_NewWideIntObj) # define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))(void *)Tcl_SetWideIntObj) # define Tcl_ExprLong TclExprLong static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){ int intValue; int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue); if (result == TCL_OK) *ptr = (long)intValue; return result; } # define Tcl_ExprLongObj TclExprLongObj static inline int TclExprLongObj(Tcl_Interp *interp, Tcl_Obj *obj, long *ptr){ int intValue; int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue); if (result == TCL_OK) *ptr = (long)intValue; return result; } # define Tcl_UniCharNcmp(ucs,uct,n) \ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))(void *)tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n)) # define Tcl_UtfNcmp(s1,s2,n) \ ((int(*)(const char*,const char*,unsigned int))(void *)tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) # define Tcl_UtfNcasecmp(s1,s2,n) \ ((int(*)(const char*,const char*,unsigned int))(void *)tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) # define Tcl_UniCharNcasecmp(ucs,uct,n) \ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))(void *)tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif /* * Deprecated Tcl procedures: */ #undef Tcl_EvalObj #define Tcl_EvalObj(interp,objPtr) \ Tcl_EvalObjEx((interp),(objPtr),0) #undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp,objPtr) \ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) #define Tcl_CreateChild Tcl_CreateSlave #define Tcl_GetChild Tcl_GetSlave #define Tcl_GetParent Tcl_GetMaster #endif /* _TCLDECLS */ tcl8.6.14/generic/tclDictObj.c0000644000175000017500000027277214554262142015464 0ustar sergeisergei/* * tclDictObj.c -- * * This file contains functions that implement the Tcl dict object type * and its accessor command. * * Copyright (c) 2002-2010 by Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" /* * Forward declaration. */ struct Dict; /* * Prototypes for functions defined later in this file: */ static void DeleteDict(struct Dict *dict); static int DictAppendCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictCreateCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictExistsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictFilterCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictGetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictIncrCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictInfoCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictKeysCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictLappendCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictMergeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictRemoveCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictReplaceCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictValuesCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictWithCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static void DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeDictInternalRep(Tcl_Obj *dictPtr); static void InvalidateDictChain(Tcl_Obj *dictObj); static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDict(Tcl_Obj *dictPtr); static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr); static inline void InitChainTable(struct Dict *dict); static inline void DeleteChainTable(struct Dict *dict); static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict, Tcl_Obj *keyPtr, int *newPtr); static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr); static Tcl_NRPostProc FinalizeDictUpdate; static Tcl_NRPostProc FinalizeDictWith; static Tcl_ObjCmdProc DictForNRCmd; static Tcl_ObjCmdProc DictMapNRCmd; static Tcl_NRPostProc DictForLoopCallback; static Tcl_NRPostProc DictMapLoopCallback; /* * Table of dict subcommand names and implementations. */ static const EnsembleImplMap implementationMap[] = { {"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL, 0 }, {"create", DictCreateCmd, TclCompileDictCreateCmd, NULL, NULL, 0 }, {"exists", DictExistsCmd, TclCompileDictExistsCmd, NULL, NULL, 0 }, {"filter", DictFilterCmd, NULL, NULL, NULL, 0 }, {"for", NULL, TclCompileDictForCmd, DictForNRCmd, NULL, 0 }, {"get", DictGetCmd, TclCompileDictGetCmd, NULL, NULL, 0 }, {"incr", DictIncrCmd, TclCompileDictIncrCmd, NULL, NULL, 0 }, {"info", DictInfoCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, {"keys", DictKeysCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 }, {"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 }, {"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 }, {"remove", DictRemoveCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 }, {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 }, {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 }, {"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 }, {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 }, {"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, {"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 }, {NULL, NULL, NULL, NULL, NULL, 0} }; /* * Internal representation of the entries in the hash table that backs a * dictionary. */ typedef struct ChainEntry { Tcl_HashEntry entry; struct ChainEntry *prevPtr; struct ChainEntry *nextPtr; } ChainEntry; /* * Internal representation of a dictionary. * * The internal representation of a dictionary object is a hash table (with * Tcl_Objs for both keys and values), a reference count and epoch number for * detecting concurrent modifications of the dictionary, and a pointer to the * parent object (used when invalidating string reps of pathed dictionary * trees) which is NULL in normal use. The fact that hash tables know (with * appropriate initialisation) already about objects makes key management /so/ * much easier! * * Reference counts are used to enable safe iteration across hashes while * allowing the type of the containing object to be modified. */ typedef struct Dict { Tcl_HashTable table; /* Object hash table to store mapping in. */ ChainEntry *entryChainHead; /* Linked list of all entries in the * dictionary. Used for doing traversal of the * entries in the order that they are * created. */ ChainEntry *entryChainTail; /* Other end of linked list of all entries in * the dictionary. Used for doing traversal of * the entries in the order that they are * created. */ int epoch; /* Epoch counter */ size_t refCount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested * dictionaries. */ } Dict; /* * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this * must be assignable as well as readable. */ #define DICT(dictObj) ((dictObj)->internalRep.twoPtrValue.ptr1) /* * The structure below defines the dictionary object type by means of * functions that can be invoked by generic object code. */ const Tcl_ObjType tclDictType = { "dict", FreeDictInternalRep, /* freeIntRepProc */ DupDictInternalRep, /* dupIntRepProc */ UpdateStringOfDict, /* updateStringProc */ SetDictFromAny /* setFromAnyProc */ }; /* * The type of the specially adapted version of the Tcl_Obj*-containing hash * table defined in the tclObj.c code. This version differs in that it * allocates a bit more space in each hash entry in order to hold the pointers * used to keep the hash entries in a linked list. * * Note that this type of hash table is *only* suitable for direct use in * *this* file. Everything else should use the dict iterator API. */ static const Tcl_HashKeyType chainHashType = { TCL_HASH_KEY_TYPE_VERSION, 0, TclHashObjKey, TclCompareObjKeys, AllocChainEntry, TclFreeObjEntry }; /* * Structure used in implementation of 'dict map' to hold the state that gets * passed between parts of the implementation. */ typedef struct { Tcl_Obj *keyVarObj; /* The name of the variable that will have * keys assigned to it. */ Tcl_Obj *valueVarObj; /* The name of the variable that will have * values assigned to it. */ Tcl_DictSearch search; /* The dictionary search structure. */ Tcl_Obj *scriptObj; /* The script to evaluate each time through * the loop. */ Tcl_Obj *accumulatorObj; /* The dictionary used to accumulate the * results. */ } DictMapStorage; /***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/ /* *---------------------------------------------------------------------- * * AllocChainEntry -- * * Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key, and * which has a bit of extra space afterwards for storing pointers to the * rest of the chain of entries (the extra pointers are left NULL). * * Results: * The return value is a pointer to the created entry. * * Side effects: * Increments the reference count on the object. * *---------------------------------------------------------------------- */ static Tcl_HashEntry * AllocChainEntry( Tcl_HashTable *tablePtr, void *keyPtr) { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; ChainEntry *cPtr; cPtr = (ChainEntry *)ckalloc(sizeof(ChainEntry)); cPtr->entry.key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); cPtr->entry.clientData = NULL; cPtr->prevPtr = cPtr->nextPtr = NULL; return &cPtr->entry; } /* * Helper functions that disguise most of the details relating to how the * linked list of hash entries is managed. In particular, these manage the * creation of the table and initializing of the chain, the deletion of the * table and chain, the adding of an entry to the chain, and the removal of an * entry from the chain. */ static inline void InitChainTable( Dict *dict) { Tcl_InitCustomHashTable(&dict->table, TCL_CUSTOM_PTR_KEYS, &chainHashType); dict->entryChainHead = dict->entryChainTail = NULL; } static inline void DeleteChainTable( Dict *dict) { ChainEntry *cPtr; for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) { Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); TclDecrRefCount(valuePtr); } Tcl_DeleteHashTable(&dict->table); } static inline Tcl_HashEntry * CreateChainEntry( Dict *dict, Tcl_Obj *keyPtr, int *newPtr) { ChainEntry *cPtr = (ChainEntry *) Tcl_CreateHashEntry(&dict->table, keyPtr, newPtr); /* * If this is a new entry in the hash table, stitch it into the chain. */ if (*newPtr) { cPtr->nextPtr = NULL; if (dict->entryChainHead == NULL) { cPtr->prevPtr = NULL; dict->entryChainHead = cPtr; dict->entryChainTail = cPtr; } else { cPtr->prevPtr = dict->entryChainTail; dict->entryChainTail->nextPtr = cPtr; dict->entryChainTail = cPtr; } } return &cPtr->entry; } static inline int DeleteChainEntry( Dict *dict, Tcl_Obj *keyPtr) { ChainEntry *cPtr = (ChainEntry *) Tcl_FindHashEntry(&dict->table, keyPtr); if (cPtr == NULL) { return 0; } else { Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); TclDecrRefCount(valuePtr); } /* * Unstitch from the chain. */ if (cPtr->nextPtr) { cPtr->nextPtr->prevPtr = cPtr->prevPtr; } else { dict->entryChainTail = cPtr->prevPtr; } if (cPtr->prevPtr) { cPtr->prevPtr->nextPtr = cPtr->nextPtr; } else { dict->entryChainHead = cPtr->nextPtr; } Tcl_DeleteHashEntry(&cPtr->entry); return 1; } /* *---------------------------------------------------------------------- * * DupDictInternalRep -- * * Initialize the internal representation of a dictionary Tcl_Obj to a * copy of the internal representation of an existing dictionary object. * * Results: * None. * * Side effects: * "srcPtr"s dictionary internal rep pointer should not be NULL and we * assume it is not NULL. We set "copyPtr"s internal rep to a pointer to * a newly allocated dictionary rep that, in turn, points to "srcPtr"s * key and value objects. Those objects are not actually copied but are * shared between "srcPtr" and "copyPtr". The ref count of each key and * value object is incremented. * *---------------------------------------------------------------------- */ static void DupDictInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { Dict *oldDict = (Dict *)DICT(srcPtr); Dict *newDict = (Dict *)ckalloc(sizeof(Dict)); ChainEntry *cPtr; /* * Copy values across from the old hash table. */ InitChainTable(newDict); for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) { Tcl_Obj *key = (Tcl_Obj *)Tcl_GetHashKey(&oldDict->table, &cPtr->entry); Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); int n; Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n); /* * Fill in the contents. */ Tcl_SetHashValue(hPtr, valuePtr); Tcl_IncrRefCount(valuePtr); } /* * Initialise other fields. */ newDict->epoch = 0; newDict->chain = NULL; newDict->refCount = 1; /* * Store in the object. */ DICT(copyPtr) = newDict; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; copyPtr->typePtr = &tclDictType; } /* *---------------------------------------------------------------------- * * FreeDictInternalRep -- * * Deallocate the storage associated with a dictionary object's internal * representation. * * Results: * None * * Side effects: * Frees the memory holding the dictionary's internal hash table unless * it is locked by an iteration going over it. * *---------------------------------------------------------------------- */ static void FreeDictInternalRep( Tcl_Obj *dictPtr) { Dict *dict = (Dict *)DICT(dictPtr); if (dict->refCount-- <= 1) { DeleteDict(dict); } dictPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DeleteDict -- * * Delete the structure that is used to implement a dictionary's internal * representation. Called when either the dictionary object loses its * internal representation or when the last iteration over the dictionary * completes. * * Results: * None * * Side effects: * Decrements the reference count of all key and value objects in the * dictionary, which may free them. * *---------------------------------------------------------------------- */ static void DeleteDict( Dict *dict) { DeleteChainTable(dict); ckfree(dict); } /* *---------------------------------------------------------------------- * * UpdateStringOfDict -- * * Update the string representation for a dictionary object. Note: This * function does not invalidate an existing old string rep so storage * will be lost if this has not already been done. This code is based on * UpdateStringOfList in tclListObj.c * * Results: * None. * * Side effects: * The object's string is set to a valid string that results from the * dict-to-string conversion. This string will be empty if the dictionary * has no key/value pairs. The dictionary internal representation should * not be NULL and we assume it is not NULL. * *---------------------------------------------------------------------- */ static void UpdateStringOfDict( Tcl_Obj *dictPtr) { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; Dict *dict = (Dict *)DICT(dictPtr); ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; int i, length; unsigned int bytesNeeded = 0; const char *elem; char *dst; /* * This field is the most useful one in the whole hash structure, and it * is not exposed by any API function... */ int numElems = dict->table.numEntries * 2; /* Handle empty list case first, simplifies what follows */ if (numElems == 0) { dictPtr->bytes = tclEmptyStringRep; dictPtr->length = 0; return; } /* * Pass 1: estimate space, gather flags. */ if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { flagPtr = (char *)ckalloc(numElems); } for (i=0,cPtr=dict->entryChainHead; inextPtr) { /* * Assume that cPtr is never NULL since we know the number of array * elements already. */ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = TclGetStringFromObj(keyPtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } flagPtr[i+1] = TCL_DONT_QUOTE_HASH; valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); elem = TclGetStringFromObj(valuePtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i+1); if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } } if (bytesNeeded + numElems > INT_MAX + 1U) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; /* * Pass 2: copy into string rep buffer. */ dictPtr->length = bytesNeeded - 1; dictPtr->bytes = (char *)ckalloc(bytesNeeded); dst = dictPtr->bytes; for (i=0,cPtr=dict->entryChainHead; inextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = TclGetStringFromObj(keyPtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; flagPtr[i+1] |= TCL_DONT_QUOTE_HASH; valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); elem = TclGetStringFromObj(valuePtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i+1]); *dst++ = ' '; } dictPtr->bytes[dictPtr->length] = '\0'; if (flagPtr != localFlags) { ckfree(flagPtr); } } /* *---------------------------------------------------------------------- * * SetDictFromAny -- * * Convert a non-dictionary object into a dictionary object. This code is * very closely related to SetListFromAny in tclListObj.c but does not * actually guarantee that a dictionary object will have a string rep (as * conversions from lists are handled with a special case.) * * Results: * A standard Tcl result. * * Side effects: * If the string can be converted, it loses any old internal * representation that it had and gains a dictionary's internalRep. * *---------------------------------------------------------------------- */ static int SetDictFromAny( Tcl_Interp *interp, Tcl_Obj *objPtr) { Tcl_HashEntry *hPtr; int isNew; Dict *dict = (Dict *)ckalloc(sizeof(Dict)); InitChainTable(dict); /* * Since lists and dictionaries have very closely-related string * representations (i.e. the same parsing code) we can safely special-case * the conversion from lists to dictionaries. */ if (objPtr->typePtr == &tclListType) { int objc, i; Tcl_Obj **objv; /* Cannot fail, we already know the Tcl_ObjType is "list". */ TclListObjGetElements(NULL, objPtr, &objc, &objv); if (objc & 1) { goto missingValue; } for (i=0 ; ibytes = (char *)ckalloc(elemSize + 1); keyPtr->length = TclCopyAndCollapse(elemSize, elemStart, keyPtr->bytes); } if (TclFindDictElement(interp, nextElem, (limit - nextElem), &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { TclDecrRefCount(keyPtr); goto errorInFindDictElement; } if (literal) { TclNewStringObj(valuePtr, elemStart, elemSize); } else { /* Avoid double copy */ TclNewObj(valuePtr); valuePtr->bytes = (char *)ckalloc(elemSize + 1); valuePtr->length = TclCopyAndCollapse(elemSize, elemStart, valuePtr->bytes); } /* Store key and value in the hash table we're building. */ hPtr = CreateChainEntry(dict, keyPtr, &isNew); if (!isNew) { Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr); TclDecrRefCount(keyPtr); TclDecrRefCount(discardedValue); } Tcl_SetHashValue(hPtr, valuePtr); Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */ } } /* * Free the old internalRep before setting the new one. We do this as late * as possible to allow the conversion code, in particular * Tcl_GetStringFromObj, to use that old internalRep. */ TclFreeIntRep(objPtr); dict->epoch = 0; dict->chain = NULL; dict->refCount = 1; DICT(objPtr) = dict; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclDictType; return TCL_OK; missingValue: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value to go with key", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); } errorInFindDictElement: DeleteChainTable(dict); ckfree(dict); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclTraceDictPath -- * * Trace through a tree of dictionaries using the array of keys given. If * the flags argument has the DICT_PATH_UPDATE flag is set, a * backward-pointing chain of dictionaries is also built (in the Dict's * chain field) and the chained dictionaries are made into unshared * dictionaries (if they aren't already.) * * Results: * The object at the end of the path, or NULL if there was an error. Note * that this it is an error for an intermediate dictionary on the path to * not exist. If the flags argument has the DICT_PATH_EXISTS set, a * non-existent path gives a DICT_PATH_NON_EXISTENT result. * * Side effects: * If the flags argument is zero or DICT_PATH_EXISTS, there are no side * effects (other than potential conversion of objects to dictionaries.) * If the flags argument is DICT_PATH_UPDATE, the following additional * side effects occur. Shared dictionaries along the path are converted * into unshared objects, and a backward-pointing chain is built using * the chain fields of the dictionaries (for easy invalidation of string * representations using InvalidateDictChain). If the flags argument has * the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit), * non-extant keys will be inserted with a value of an empty * dictionary, resulting in the path being built. * *---------------------------------------------------------------------- */ Tcl_Obj * TclTraceDictPath( Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const keyv[], int flags) { Dict *dict, *newDict; int i; if (dictPtr->typePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { return NULL; } dict = (Dict *)DICT(dictPtr); if (flags & DICT_PATH_UPDATE) { dict->chain = NULL; } for (i=0 ; itable, keyv[i]); Tcl_Obj *tmpObj; if (hPtr == NULL) { int isNew; /* Dummy */ if (flags & DICT_PATH_EXISTS) { return DICT_PATH_NON_EXISTENT; } if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "key \"%s\" not known in dictionary", TclGetString(keyv[i]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(keyv[i]), NULL); } return NULL; } /* * The next line should always set isNew to 1. */ hPtr = CreateChainEntry(dict, keyv[i], &isNew); tmpObj = Tcl_NewDictObj(); Tcl_IncrRefCount(tmpObj); Tcl_SetHashValue(hPtr, tmpObj); } else { tmpObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); if (tmpObj->typePtr != &tclDictType && SetDictFromAny(interp, tmpObj) != TCL_OK) { return NULL; } } newDict = (Dict *)DICT(tmpObj); if (flags & DICT_PATH_UPDATE) { if (Tcl_IsShared(tmpObj)) { TclDecrRefCount(tmpObj); tmpObj = Tcl_DuplicateObj(tmpObj); Tcl_IncrRefCount(tmpObj); Tcl_SetHashValue(hPtr, tmpObj); dict->epoch++; newDict = (Dict *)DICT(tmpObj); } newDict->chain = dictPtr; } dict = newDict; dictPtr = tmpObj; } return dictPtr; } /* *---------------------------------------------------------------------- * * InvalidateDictChain -- * * Go through a dictionary chain (built by an updating invocation of * TclTraceDictPath) and invalidate the string representations of all the * dictionaries on the chain. * * Results: * None * * Side effects: * String reps are invalidated and epoch counters (for detecting illegal * concurrent modifications) are updated through the chain of updated * dictionaries. * *---------------------------------------------------------------------- */ static void InvalidateDictChain( Tcl_Obj *dictObj) { Dict *dict = (Dict *)DICT(dictObj); do { TclInvalidateStringRep(dictObj); dict->epoch++; dictObj = dict->chain; if (dictObj == NULL) { break; } dict->chain = NULL; dict = (Dict *)DICT(dictObj); } while (dict != NULL); } /* *---------------------------------------------------------------------- * * Tcl_DictObjPut -- * * Add a key,value pair to a dictionary, or update the value for a key if * that key already has a mapping in the dictionary. * * Results: * A standard Tcl result. * * Side effects: * The object pointed to by dictPtr is converted to a dictionary if it is * not already one, and any string representation that it has is * invalidated. * *---------------------------------------------------------------------- */ int Tcl_DictObjPut( Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr) { Dict *dict; Tcl_HashEntry *hPtr; int isNew; if (Tcl_IsShared(dictPtr)) { Tcl_Panic("%s called with shared object", "Tcl_DictObjPut"); } if (dictPtr->typePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { return TCL_ERROR; } if (dictPtr->bytes != NULL) { TclInvalidateStringRep(dictPtr); } dict = (Dict *)DICT(dictPtr); hPtr = CreateChainEntry(dict, keyPtr, &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); TclDecrRefCount(oldValuePtr); } Tcl_SetHashValue(hPtr, valuePtr); dict->epoch++; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_DictObjGet -- * * Given a key, get its value from the dictionary (or NULL if key is not * found in dictionary.) * * Results: * A standard Tcl result. The variable pointed to by valuePtrPtr is * updated with the value for the key. Note that it is not an error for * the key to have no mapping in the dictionary. * * Side effects: * The object pointed to by dictPtr is converted to a dictionary if it is * not already one. * *---------------------------------------------------------------------- */ int Tcl_DictObjGet( Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr) { Dict *dict; Tcl_HashEntry *hPtr; if (dictPtr->typePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { *valuePtrPtr = NULL; return TCL_ERROR; } dict = (Dict *)DICT(dictPtr); hPtr = Tcl_FindHashEntry(&dict->table, keyPtr); if (hPtr == NULL) { *valuePtrPtr = NULL; } else { *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_DictObjRemove -- * * Remove the key,value pair with the given key from the dictionary; the * key does not need to be present in the dictionary. * * Results: * A standard Tcl result. * * Side effects: * The object pointed to by dictPtr is converted to a dictionary if it is * not already one, and any string representation that it has is * invalidated. * *---------------------------------------------------------------------- */ int Tcl_DictObjRemove( Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr) { Dict *dict; if (Tcl_IsShared(dictPtr)) { Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove"); } if (dictPtr->typePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { return TCL_ERROR; } dict = (Dict *)DICT(dictPtr); if (DeleteChainEntry(dict, keyPtr)) { if (dictPtr->bytes != NULL) { TclInvalidateStringRep(dictPtr); } dict->epoch++; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_DictObjSize -- * * How many key,value pairs are there in the dictionary? * * Results: * A standard Tcl result. Updates the variable pointed to by sizePtr with * the number of key,value pairs in the dictionary. * * Side effects: * The dictPtr object is converted to a dictionary type if it is not a * dictionary already. * *---------------------------------------------------------------------- */ int Tcl_DictObjSize( Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr) { Dict *dict; if (dictPtr->typePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { return TCL_ERROR; } dict = (Dict *)DICT(dictPtr); *sizePtr = dict->table.numEntries; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_DictObjFirst -- * * Start a traversal of the dictionary. Caller must supply the search * context, pointers for returning key and value, and a pointer to allow * indication of whether the dictionary has been traversed (i.e. the * dictionary is empty). The order of traversal is undefined. * * Results: * A standard Tcl result. Updates the variables pointed to by keyPtrPtr, * valuePtrPtr and donePtr. Either of keyPtrPtr and valuePtrPtr may be * NULL, in which case the key/value is not made available to the caller. * * Side effects: * The dictPtr object is converted to a dictionary type if it is not a * dictionary already. The search context is initialised if the search * has not finished. The dictionary's internal rep is Tcl_Preserve()d if * the dictionary has at least one element. * *---------------------------------------------------------------------- */ int Tcl_DictObjFirst( Tcl_Interp *interp, /* For error messages, or NULL if no error * messages desired. */ Tcl_Obj *dictPtr, /* Dictionary to traverse. */ Tcl_DictSearch *searchPtr, /* Pointer to a dict search context. */ Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the first key * written into, or NULL. */ Tcl_Obj **valuePtrPtr, /* Pointer to a variable to have the first * value written into, or NULL.*/ int *donePtr) /* Pointer to a variable which will have a 1 * written into when there are no further * values in the dictionary, or a 0 * otherwise. */ { Dict *dict; ChainEntry *cPtr; if (dictPtr->typePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { return TCL_ERROR; } dict = (Dict *)DICT(dictPtr); cPtr = dict->entryChainHead; if (cPtr == NULL) { searchPtr->epoch = -1; *donePtr = 1; } else { *donePtr = 0; searchPtr->dictionaryPtr = (Tcl_Dict) dict; searchPtr->epoch = dict->epoch; searchPtr->next = cPtr->nextPtr; dict->refCount++; if (keyPtrPtr != NULL) { *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); } if (valuePtrPtr != NULL) { *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_DictObjNext -- * * Continue a traversal of a dictionary previously started with * Tcl_DictObjFirst. This function is safe against concurrent * modification of the underlying object (including type shimmering), * treating such situations as if the search has terminated, though it is * up to the caller to ensure that the object itself is not disposed * until the search has finished. It is _not_ safe against modifications * from other threads. * * Results: * Updates the variables pointed to by keyPtrPtr, valuePtrPtr and * donePtr. Either of keyPtrPtr and valuePtrPtr may be NULL, in which * case the key/value is not made available to the caller. * * Side effects: * Removes a reference to the dictionary's internal rep if the search * terminates. * *---------------------------------------------------------------------- */ void Tcl_DictObjNext( Tcl_DictSearch *searchPtr, /* Pointer to a hash search context. */ Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the first key * written into, or NULL. */ Tcl_Obj **valuePtrPtr, /* Pointer to a variable to have the first * value written into, or NULL.*/ int *donePtr) /* Pointer to a variable which will have a 1 * written into when there are no further * values in the dictionary, or a 0 * otherwise. */ { ChainEntry *cPtr; /* * If the search is done; we do no work. */ if (searchPtr->epoch == -1) { *donePtr = 1; return; } /* * Bail out if the dictionary has had any elements added, modified or * removed. This *shouldn't* happen, but... */ if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) { Tcl_Panic("concurrent dictionary modification and search"); } cPtr = (ChainEntry *)searchPtr->next; if (cPtr == NULL) { Tcl_DictObjDone(searchPtr); *donePtr = 1; return; } searchPtr->next = cPtr->nextPtr; *donePtr = 0; if (keyPtrPtr != NULL) { *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey( &((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry); } if (valuePtrPtr != NULL) { *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); } } /* *---------------------------------------------------------------------- * * Tcl_DictObjDone -- * * Call this if you want to stop a search before you reach the end of the * dictionary (e.g. because of abnormal termination of the search). It * need not be used if the search reaches its natural end (i.e. if either * Tcl_DictObjFirst or Tcl_DictObjNext sets its donePtr variable to 1). * * Results: * None. * * Side effects: * Removes a reference to the dictionary's internal rep. * *---------------------------------------------------------------------- */ void Tcl_DictObjDone( Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */ { Dict *dict; if (searchPtr->epoch != -1) { searchPtr->epoch = -1; dict = (Dict *) searchPtr->dictionaryPtr; if (dict->refCount-- <= 1) { DeleteDict(dict); } } } /* *---------------------------------------------------------------------- * * Tcl_DictObjPutKeyList -- * * Add a key...key,value pair to a dictionary tree. The main dictionary * value must not be shared, though sub-dictionaries may be. All * intermediate dictionaries on the path must exist. * * Results: * A standard Tcl result. Note that in the error case, a message is left * in interp unless that is NULL. * * Side effects: * If the dictionary and any of its sub-dictionaries on the path have * string representations, these are invalidated. * *---------------------------------------------------------------------- */ int Tcl_DictObjPutKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const keyv[], Tcl_Obj *valuePtr) { Dict *dict; Tcl_HashEntry *hPtr; int isNew; if (Tcl_IsShared(dictPtr)) { Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList"); } if (keyc < 1) { Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList"); } dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE); if (dictPtr == NULL) { return TCL_ERROR; } dict = (Dict *)DICT(dictPtr); hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); TclDecrRefCount(oldValuePtr); } Tcl_SetHashValue(hPtr, valuePtr); InvalidateDictChain(dictPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_DictObjRemoveKeyList -- * * Remove a key...key,value pair from a dictionary tree (the value * removed is implicit in the key path). The main dictionary value must * not be shared, though sub-dictionaries may be. It is not an error if * there is no value associated with the given key list, but all * intermediate dictionaries on the key path must exist. * * Results: * A standard Tcl result. Note that in the error case, a message is left * in interp unless that is NULL. * * Side effects: * If the dictionary and any of its sub-dictionaries on the key path have * string representations, these are invalidated. * *---------------------------------------------------------------------- */ int Tcl_DictObjRemoveKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const keyv[]) { Dict *dict; if (Tcl_IsShared(dictPtr)) { Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList"); } if (keyc < 1) { Tcl_Panic("%s called with empty key list", "Tcl_DictObjRemoveKeyList"); } dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE); if (dictPtr == NULL) { return TCL_ERROR; } dict = (Dict *)DICT(dictPtr); DeleteChainEntry(dict, keyv[keyc-1]); InvalidateDictChain(dictPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_NewDictObj -- * * This function is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates a new dict object without any * content. * * When TCL_MEM_DEBUG is defined, this function just returns the result * of calling the debugging version Tcl_DbNewDictObj. * * Results: * A new dict object is returned; it has no keys defined in it. The new * object's string representation is left NULL, and the ref count of the * object is 0. * * Side Effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_NewDictObj(void) { #ifdef TCL_MEM_DEBUG return Tcl_DbNewDictObj("unknown", 0); #else /* !TCL_MEM_DEBUG */ Tcl_Obj *dictPtr; Dict *dict; TclNewObj(dictPtr); TclInvalidateStringRep(dictPtr); dict = (Dict *)ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; return dictPtr; #endif } /* *---------------------------------------------------------------------- * * Tcl_DbNewDictObj -- * * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It creates new dict objects. It is the same * as the Tcl_NewDictObj function above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its * caller. This simplifies debugging since then the [memory active] * command will report the correct file name and line number when * reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this function just returns the * result of calling Tcl_NewDictObj. * * Results: * A new dict object is returned; it has no keys defined in it. The new * object's string representation is left NULL, and the ref count of the * object is 0. * * Side Effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_DbNewDictObj( const char *file, int line) { #ifdef TCL_MEM_DEBUG Tcl_Obj *dictPtr; Dict *dict; TclDbNewObj(dictPtr, file, line); TclInvalidateStringRep(dictPtr); dict = (Dict *)ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; return dictPtr; #else /* !TCL_MEM_DEBUG */ return Tcl_NewDictObj(); #endif } /***** START OF FUNCTIONS IMPLEMENTING TCL COMMANDS *****/ /* *---------------------------------------------------------------------- * * DictCreateCmd -- * * This function implements the "dict create" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictCreateCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictObj; int i; /* * Must have an even number of arguments; note that number of preceding * arguments (i.e. "dict create" is also even, which makes this much * easier.) */ if ((objc & 1) == 0) { Tcl_WrongNumArgs(interp, 1, objv, "?key value ...?"); return TCL_ERROR; } dictObj = Tcl_NewDictObj(); for (i=1 ; itypePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); } if (dictPtr->bytes != NULL) { TclInvalidateStringRep(dictPtr); } for (i=2 ; itypePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); } if (dictPtr->bytes != NULL) { TclInvalidateStringRep(dictPtr); } for (i=2 ; itypePtr != &tclDictType && SetDictFromAny(interp, targetObj) != TCL_OK) { return TCL_ERROR; } if (objc == 2) { /* * Single argument, return it. */ Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* * Normal behaviour: combining two (or more) dictionaries. */ if (Tcl_IsShared(targetObj)) { targetObj = Tcl_DuplicateObj(targetObj); allocatedDict = 1; } for (i=2 ; itypePtr != &tclDictType && SetDictFromAny(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { pattern = TclGetString(objv[2]); } listPtr = Tcl_NewListObj(0, NULL); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { Tcl_Obj *valuePtr = NULL; Tcl_DictObjGet(interp, objv[1], objv[2], &valuePtr); if (valuePtr != NULL) { Tcl_ListObjAppendElement(NULL, listPtr, objv[2]); } } else { Tcl_DictSearch search; Tcl_Obj *keyPtr = NULL; int done = 0; /* * At this point, we know we have a dictionary (or at least something * that can be represented; it could theoretically have shimmered away * when the pattern was fetched, but that shouldn't be damaging) so we * can start the iteration process without checking for failures. */ Tcl_DictObjFirst(NULL, objv[1], &search, &keyPtr, NULL, &done); for (; !done ; Tcl_DictObjNext(&search, &keyPtr, NULL, &done)) { if (!pattern || Tcl_StringMatch(TclGetString(keyPtr), pattern)) { Tcl_ListObjAppendElement(NULL, listPtr, keyPtr); } } Tcl_DictObjDone(&search); } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * DictValuesCmd -- * * This function implements the "dict values" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictValuesCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *valuePtr = NULL, *listPtr; Tcl_DictSearch search; int done; const char *pattern; if (objc!=2 && objc!=3) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?"); return TCL_ERROR; } if (Tcl_DictObjFirst(interp, objv[1], &search, NULL, &valuePtr, &done) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { pattern = TclGetString(objv[2]); } else { pattern = NULL; } listPtr = Tcl_NewListObj(0, NULL); for (; !done ; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) { if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr),pattern)) { /* * Assume this operation always succeeds. */ Tcl_ListObjAppendElement(interp, listPtr, valuePtr); } } Tcl_DictObjDone(&search); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * DictSizeCmd -- * * This function implements the "dict size" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictSizeCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int result, size; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); return TCL_ERROR; } result = Tcl_DictObjSize(interp, objv[1], &size); if (result == TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewIntObj(size)); } return result; } /* *---------------------------------------------------------------------- * * DictExistsCmd -- * * This function implements the "dict exists" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictExistsCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?"); return TCL_ERROR; } dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2, DICT_PATH_EXISTS); if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT || Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); } else { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * DictInfoCmd -- * * This function implements the "dict info" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictInfoCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr; Dict *dict; char *statsStr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); return TCL_ERROR; } dictPtr = objv[1]; if (dictPtr->typePtr != &tclDictType && SetDictFromAny(interp, dictPtr) != TCL_OK) { return TCL_ERROR; } dict = (Dict *)DICT(dictPtr); statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); ckfree(statsStr); return TCL_OK; } /* *---------------------------------------------------------------------- * * DictIncrCmd -- * * This function implements the "dict incr" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictIncrCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int code = TCL_OK; Tcl_Obj *dictPtr, *valuePtr = NULL; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?"); return TCL_ERROR; } dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { /* * Variable didn't yet exist. Create new dictionary value. */ dictPtr = Tcl_NewDictObj(); } else if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) { /* * Variable contents are not a dict, report error. */ return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { /* * A little internals surgery to avoid copying a string rep that will * soon be no good. */ char *saved = dictPtr->bytes; Tcl_Obj *oldPtr = dictPtr; dictPtr->bytes = NULL; dictPtr = Tcl_DuplicateObj(dictPtr); oldPtr->bytes = saved; } if (valuePtr == NULL) { /* * Key not in dictionary. Create new key with increment as value. */ if (objc == 4) { /* * Verify increment is an integer. */ mp_int increment; code = Tcl_GetBignumFromObj(interp, objv[3], &increment); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (reading increment)"); } else { /* * Remember to dispose with the bignum as we're not actually * using it directly. [Bug 2874678] */ mp_clear(&increment); Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]); } } else { Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewIntObj(1)); } } else { /* * Key in dictionary. Increment its value with minimum dup. */ if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr); } if (objc == 4) { code = TclIncrObj(interp, valuePtr, objv[3]); } else { Tcl_Obj *incrPtr; TclNewIntObj(incrPtr, 1); Tcl_IncrRefCount(incrPtr); code = TclIncrObj(interp, valuePtr, incrPtr); TclDecrRefCount(incrPtr); } } if (code == TCL_OK) { TclInvalidateStringRep(dictPtr); valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (valuePtr == NULL) { code = TCL_ERROR; } else { Tcl_SetObjResult(interp, valuePtr); } } else if (dictPtr->refCount == 0) { TclDecrRefCount(dictPtr); } return code; } /* *---------------------------------------------------------------------- * * DictLappendCmd -- * * This function implements the "dict lappend" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictLappendCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; int i, allocatedDict = 0, allocatedValue = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); return TCL_ERROR; } dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { allocatedDict = 1; dictPtr = Tcl_NewDictObj(); } else if (Tcl_IsShared(dictPtr)) { allocatedDict = 1; dictPtr = Tcl_DuplicateObj(dictPtr); } if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } if (valuePtr == NULL) { valuePtr = Tcl_NewListObj(objc-3, objv+3); allocatedValue = 1; } else { if (Tcl_IsShared(valuePtr)) { allocatedValue = 1; valuePtr = Tcl_DuplicateObj(valuePtr); } for (i=3 ; ibytes != NULL) { TclInvalidateStringRep(dictPtr); } resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * DictAppendCmd -- * * This function implements the "dict append" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictAppendCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; int i, allocatedDict = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); return TCL_ERROR; } dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { allocatedDict = 1; dictPtr = Tcl_NewDictObj(); } else if (Tcl_IsShared(dictPtr)) { allocatedDict = 1; dictPtr = Tcl_DuplicateObj(dictPtr); } if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } if (valuePtr == NULL) { TclNewObj(valuePtr); } else if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); } for (i=3 ; icmdFramePtr, 3); /* * For unwinding everything on error. */ error: TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); Tcl_DictObjDone(searchPtr); TclStackFree(interp, searchPtr); return TCL_ERROR; } static int DictForLoopCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_DictSearch *searchPtr = (Tcl_DictSearch *)data[0]; Tcl_Obj *keyVarObj = (Tcl_Obj *)data[1]; Tcl_Obj *valueVarObj = (Tcl_Obj *)data[2]; Tcl_Obj *scriptObj = (Tcl_Obj *)data[3]; Tcl_Obj *keyObj, *valueObj; int done; /* * Process the result from the previous execution of the script body. */ if (result == TCL_CONTINUE) { result = TCL_OK; } else if (result != TCL_OK) { if (result == TCL_BREAK) { Tcl_ResetResult(interp); result = TCL_OK; } else if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"dict for\" body line %d)", Tcl_GetErrorLine(interp))); } goto done; } /* * Get the next mapping from the dictionary. */ Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done); if (done) { Tcl_ResetResult(interp); goto done; } /* * Stop the value from getting hit in any way by any traces on the key * variable. */ Tcl_IncrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(valueObj); result = TCL_ERROR; goto done; } TclDecrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; goto done; } /* * Run the script. */ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, valueVarObj, scriptObj); return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3); /* * For unwinding everything once the iterating is done. */ done: TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); Tcl_DictObjDone(searchPtr); TclStackFree(interp, searchPtr); return result; } /* *---------------------------------------------------------------------- * * DictMapNRCmd -- * * These functions implement the "dict map" Tcl command. See the user * documentation for details on what it does, and TIP#405 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictMapNRCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; Tcl_Obj **varv, *keyObj, *valueObj; DictMapStorage *storagePtr; int varc; int done; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "{keyVarName valueVarName} dictionary script"); return TCL_ERROR; } /* * Parse arguments. */ if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL); return TCL_ERROR; } storagePtr = (DictMapStorage *)TclStackAlloc(interp, sizeof(DictMapStorage)); if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj, &valueObj, &done) != TCL_OK) { TclStackFree(interp, storagePtr); return TCL_ERROR; } if (done) { /* * Note that this exit leaves an empty value in the result (due to * command calling conventions) but that is OK since an empty value is * an empty dictionary. */ TclStackFree(interp, storagePtr); return TCL_OK; } TclNewObj(storagePtr->accumulatorObj); TclListObjGetElements(NULL, objv[1], &varc, &varv); storagePtr->keyVarObj = varv[0]; storagePtr->valueVarObj = varv[1]; storagePtr->scriptObj = objv[3]; /* * Make sure that these objects (which we need throughout the body of the * loop) don't vanish. Note that the dictionary internal rep is locked * internally so that updates, shimmering, etc are not a problem. */ Tcl_IncrRefCount(storagePtr->accumulatorObj); Tcl_IncrRefCount(storagePtr->keyVarObj); Tcl_IncrRefCount(storagePtr->valueVarObj); Tcl_IncrRefCount(storagePtr->scriptObj); /* * Stop the value from getting hit in any way by any traces on the key * variable. */ Tcl_IncrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(valueObj); goto error; } if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(valueObj); goto error; } TclDecrRefCount(valueObj); /* * Run the script. */ TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); return TclNREvalObjEx(interp, storagePtr->scriptObj, 0, iPtr->cmdFramePtr, 3); /* * For unwinding everything on error. */ error: TclDecrRefCount(storagePtr->keyVarObj); TclDecrRefCount(storagePtr->valueVarObj); TclDecrRefCount(storagePtr->scriptObj); TclDecrRefCount(storagePtr->accumulatorObj); Tcl_DictObjDone(&storagePtr->search); TclStackFree(interp, storagePtr); return TCL_ERROR; } static int DictMapLoopCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; DictMapStorage *storagePtr = (DictMapStorage *)data[0]; Tcl_Obj *keyObj, *valueObj; int done; /* * Process the result from the previous execution of the script body. */ if (result == TCL_CONTINUE) { result = TCL_OK; } else if (result != TCL_OK) { if (result == TCL_BREAK) { Tcl_ResetResult(interp); result = TCL_OK; } else if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"dict map\" body line %d)", Tcl_GetErrorLine(interp))); } goto done; } else { keyObj = Tcl_ObjGetVar2(interp, storagePtr->keyVarObj, NULL, TCL_LEAVE_ERR_MSG); if (keyObj == NULL) { result = TCL_ERROR; goto done; } Tcl_DictObjPut(NULL, storagePtr->accumulatorObj, keyObj, Tcl_GetObjResult(interp)); } /* * Get the next mapping from the dictionary. */ Tcl_DictObjNext(&storagePtr->search, &keyObj, &valueObj, &done); if (done) { Tcl_SetObjResult(interp, storagePtr->accumulatorObj); goto done; } /* * Stop the value from getting hit in any way by any traces on the key * variable. */ Tcl_IncrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(valueObj); result = TCL_ERROR; goto done; } if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(valueObj); result = TCL_ERROR; goto done; } TclDecrRefCount(valueObj); /* * Run the script. */ TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); return TclNREvalObjEx(interp, storagePtr->scriptObj, 0, iPtr->cmdFramePtr, 3); /* * For unwinding everything once the iterating is done. */ done: TclDecrRefCount(storagePtr->keyVarObj); TclDecrRefCount(storagePtr->valueVarObj); TclDecrRefCount(storagePtr->scriptObj); TclDecrRefCount(storagePtr->accumulatorObj); Tcl_DictObjDone(&storagePtr->search); TclStackFree(interp, storagePtr); return result; } /* *---------------------------------------------------------------------- * * DictSetCmd -- * * This function implements the "dict set" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictSetCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *resultPtr; int result, allocatedDict = 0; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value"); return TCL_ERROR; } dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { allocatedDict = 1; dictPtr = Tcl_NewDictObj(); } else if (Tcl_IsShared(dictPtr)) { allocatedDict = 1; dictPtr = Tcl_DuplicateObj(dictPtr); } result = Tcl_DictObjPutKeyList(interp, dictPtr, objc-3, objv+2, objv[objc-1]); if (result != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * DictUnsetCmd -- * * This function implements the "dict unset" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictUnsetCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *resultPtr; int result, allocatedDict = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?"); return TCL_ERROR; } dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { allocatedDict = 1; dictPtr = Tcl_NewDictObj(); } else if (Tcl_IsShared(dictPtr)) { allocatedDict = 1; dictPtr = Tcl_DuplicateObj(dictPtr); } result = Tcl_DictObjRemoveKeyList(interp, dictPtr, objc-2, objv+2); if (result != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * DictFilterCmd -- * * This function implements the "dict filter" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictFilterCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; static const char *const filters[] = { "key", "script", "value", NULL }; enum FilterTypes { FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES }; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj; Tcl_DictSearch search; int index, varc, done, result, satisfied; const char *pattern; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum FilterTypes) index) { case FILTER_KEYS: /* * Create a dictionary whose keys all match a certain pattern. */ if (Tcl_DictObjFirst(interp, objv[1], &search, &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { /* * Nothing to match, so return nothing (== empty dictionary). */ Tcl_DictObjDone(&search); return TCL_OK; } else if (objc == 4) { pattern = TclGetString(objv[3]); resultObj = Tcl_NewDictObj(); if (TclMatchIsTrivial(pattern)) { /* * Must release the search lock here to prevent a memory leak * since we are not exhausing the search. [Bug 1705778, leak * K05] */ Tcl_DictObjDone(&search); Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj); if (valueObj != NULL) { Tcl_DictObjPut(NULL, resultObj, objv[3], valueObj); } } else { while (!done) { if (Tcl_StringMatch(TclGetString(keyObj), pattern)) { Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj); } Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } } } else { /* * Can't optimize this match for trivial globbing: would disturb * order. */ resultObj = Tcl_NewDictObj(); while (!done) { int i; for (i=3 ; icmdFramePtr, 4); switch (result) { case TCL_OK: boolObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(boolObj); Tcl_ResetResult(interp); if (Tcl_GetBooleanFromObj(interp, boolObj, &satisfied) != TCL_OK) { TclDecrRefCount(boolObj); result = TCL_ERROR; goto abnormalResult; } TclDecrRefCount(boolObj); if (satisfied) { Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj); } break; case TCL_BREAK: /* * Force loop termination by calling Tcl_DictObjDone; this * makes the next Tcl_DictObjNext say there is nothing more to * do. */ Tcl_ResetResult(interp); Tcl_DictObjDone(&search); /* FALLTHRU */ case TCL_CONTINUE: result = TCL_OK; break; case TCL_ERROR: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"dict filter\" script line %d)", Tcl_GetErrorLine(interp))); default: goto abnormalResult; } TclDecrRefCount(keyObj); TclDecrRefCount(valueObj); Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } /* * Stop holding a reference to these objects. */ TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); Tcl_DictObjDone(&search); if (result == TCL_OK) { Tcl_SetObjResult(interp, resultObj); } else { TclDecrRefCount(resultObj); } return result; abnormalResult: Tcl_DictObjDone(&search); TclDecrRefCount(keyObj); TclDecrRefCount(valueObj); TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); TclDecrRefCount(resultObj); return result; } Tcl_Panic("unexpected fallthrough"); /* Control never reaches this point. */ return TCL_ERROR; } /* *---------------------------------------------------------------------- * * DictUpdateCmd -- * * This function implements the "dict update" Tcl command. See the user * documentation for details on what it does, and TIP#212 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictUpdateCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *objPtr; int i, dummy; if (objc < 5 || !(objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key varName ?key varName ...? script"); return TCL_ERROR; } dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (dictPtr == NULL) { return TCL_ERROR; } if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) { return TCL_ERROR; } Tcl_IncrRefCount(dictPtr); for (i=2 ; i+2cmdFramePtr, objc-1); } static int FinalizeDictUpdate( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj *dictPtr, *objPtr, **objv; Tcl_InterpState state; int i, objc; Tcl_Obj *varName = (Tcl_Obj *)data[0]; Tcl_Obj *argsObj = (Tcl_Obj *)data[1]; /* * ErrorInfo handling. */ if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (body of \"dict update\")"); } /* * If the dictionary variable doesn't exist, drop everything silently. */ dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0); if (dictPtr == NULL) { TclDecrRefCount(varName); TclDecrRefCount(argsObj); return result; } /* * Double-check that it is still a dictionary. */ state = Tcl_SaveInterpState(interp, result); if (Tcl_DictObjSize(interp, dictPtr, &objc) != TCL_OK) { Tcl_DiscardInterpState(state); TclDecrRefCount(varName); TclDecrRefCount(argsObj); return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); } /* * Write back the values from the variables, treating failure to read as * an instruction to remove the key. */ TclListObjGetElements(NULL, argsObj, &objc, &objv); for (i=0 ; i 3) { pathPtr = Tcl_NewListObj(objc-3, objv+2); Tcl_IncrRefCount(pathPtr); } Tcl_IncrRefCount(objv[1]); TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr, NULL); return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); } static int FinalizeDictWith( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj **pathv; int pathc; Tcl_InterpState state; Tcl_Obj *varName = (Tcl_Obj *)data[0]; Tcl_Obj *keysPtr = (Tcl_Obj *)data[1]; Tcl_Obj *pathPtr = (Tcl_Obj *)data[2]; Var *varPtr, *arrayPtr; if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")"); } /* * Save the result state; TDWF doesn't guarantee to not modify that on * TCL_OK result. */ state = Tcl_SaveInterpState(interp, result); if (pathPtr != NULL) { TclListObjGetElements(NULL, pathPtr, &pathc, &pathv); } else { pathc = 0; pathv = NULL; } /* * Pack from local variables back into the dictionary. */ varPtr = TclObjLookupVarEx(interp, varName, NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { result = TCL_ERROR; } else { result = TclDictWithFinish(interp, varPtr, arrayPtr, varName, NULL, -1, pathc, pathv, keysPtr); } /* * Tidy up and return the real result (unless we had an error). */ TclDecrRefCount(varName); TclDecrRefCount(keysPtr); if (pathPtr != NULL) { TclDecrRefCount(pathPtr); } if (result != TCL_OK) { Tcl_DiscardInterpState(state); return TCL_ERROR; } return Tcl_RestoreInterpState(interp, state); } /* *---------------------------------------------------------------------- * * TclDictWithInit -- * * Part of the core of [dict with]. Pokes into a dictionary and converts * the mappings there into assignments to (presumably) local variables. * Returns a list of all the names that were mapped so that removal of * either the variable or the dictionary entry won't surprise us when we * come to stuffing everything back. * * Result: * List of mapped names, or NULL if there was an error. * * Side effects: * Assigns to variables, so potentially legion due to traces. * *---------------------------------------------------------------------- */ Tcl_Obj * TclDictWithInit( Tcl_Interp *interp, Tcl_Obj *dictPtr, int pathc, Tcl_Obj *const pathv[]) { Tcl_DictSearch s; Tcl_Obj *keyPtr, *valPtr, *keysPtr; int done; if (pathc > 0) { dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv, DICT_PATH_READ); if (dictPtr == NULL) { return NULL; } } /* * Go over the list of keys and write each corresponding value to a * variable in the current context with the same name. Also keep a copy of * the keys so we can write back properly later on even if the dictionary * has been structurally modified. */ if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr, &done) != TCL_OK) { return NULL; } TclNewObj(keysPtr); for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) { Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr); if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(keysPtr); Tcl_DictObjDone(&s); return NULL; } } return keysPtr; } /* *---------------------------------------------------------------------- * * TclDictWithFinish -- * * Part of the core of [dict with]. Reassembles the piece of the dict (in * varName, location given by pathc/pathv) from the variables named in * the keysPtr argument. NB, does not try to preserve errors or manage * argument lifetimes. * * Result: * TCL_OK if we succeeded, or TCL_ERROR if we failed. * * Side effects: * Assigns to a variable, so potentially legion due to traces. Updates * the dictionary in the named variable. * *---------------------------------------------------------------------- */ int TclDictWithFinish( Tcl_Interp *interp, /* Command interpreter in which variable * exists. Used for state management, traces * and error reporting. */ Var *varPtr, /* Reference to the variable holding the * dictionary. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. NULL if the 'index' * parameter is >= 0 */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ int index, /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ int pathc, /* The number of elements in the path into the * dictionary. */ Tcl_Obj *const pathv[], /* The elements of the path to the subdict. */ Tcl_Obj *keysPtr) /* List of keys to be synchronized. This is * the result value from TclDictWithInit. */ { Tcl_Obj *dictPtr, *leafPtr, *valPtr; int i, allocdict, keyc; Tcl_Obj **keyv; /* * If the dictionary variable doesn't exist, drop everything silently. */ dictPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, index); if (dictPtr == NULL) { return TCL_OK; } /* * Double-check that it is still a dictionary. */ if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) { return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); allocdict = 1; } else { allocdict = 0; } if (pathc > 0) { /* * Want to get to the dictionary which we will update; need to do * prepare-for-update unsharing along the path *but* avoid generating * an error on a non-extant path (we'll treat that the same as a * non-extant variable. Luckily, the unsharing operation isn't * deeply damaging if we don't go on to update; it's just less than * perfectly efficient (but no memory should be leaked). */ leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv, DICT_PATH_EXISTS | DICT_PATH_UPDATE); if (leafPtr == NULL) { if (allocdict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } if (leafPtr == DICT_PATH_NON_EXISTENT) { if (allocdict) { TclDecrRefCount(dictPtr); } return TCL_OK; } } else { leafPtr = dictPtr; } /* * Now process our updates on the leaf dictionary. */ TclListObjGetElements(NULL, keysPtr, &keyc, &keyv); for (i=0 ; i 0) { InvalidateDictChain(leafPtr); } /* * Write back the outermost dictionary to the variable. */ if (TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr, TCL_LEAVE_ERR_MSG, index) == NULL) { if (allocdict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclInitDictCmd -- * * This function is create the "dict" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A Tcl command handle. * * Side effects: * May advance compilation epoch. * *---------------------------------------------------------------------- */ Tcl_Command TclInitDictCmd( Tcl_Interp *interp) { return TclMakeEnsemble(interp, "dict", implementationMap); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclDisassemble.c0000644000175000017500000013156614554262142016374 0ustar sergeisergei/* * tclDisassemble.c -- * * This file contains procedures that disassemble bytecode into either * human-readable or Tcl-processable forms. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2013-2016 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include "tclOOInt.h" #include /* * Prototypes for procedures defined later in this file: */ static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Interp *interp, Tcl_Obj *objPtr); static Tcl_Obj * DisassembleByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static int FormatInstruction(ByteCode *codePtr, const unsigned char *pc, Tcl_Obj *bufferObj); static void GetLocationInformation(Proc *procPtr, Tcl_Obj **fileObjPtr, int *linePtr); static void PrintSourceToObj(Tcl_Obj *appendObj, const char *stringPtr, int maxChars); static void UpdateStringOfInstName(Tcl_Obj *objPtr); /* * The structure below defines an instruction name Tcl object to allow * reporting of inner contexts in errorstack without string allocation. */ static const Tcl_ObjType tclInstNameType = { "instname", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfInstName, /* updateStringProc */ NULL, /* setFromAnyProc */ }; /* * How to get the bytecode out of a Tcl_Obj. */ #define BYTECODE(objPtr) \ ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1) /* *---------------------------------------------------------------------- * * GetLocationInformation -- * * This procedure looks up the information about where a procedure was * originally declared. * * Results: * Writes to the variables pointed at by fileObjPtr and linePtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void GetLocationInformation( Proc *procPtr, /* What to look up the information for. */ Tcl_Obj **fileObjPtr, /* Where to write the information about what * file the code came from. Will be written * to, either with the object (assume shared!) * that describes what the file was, or with * NULL if the information is not * available. */ int *linePtr) /* Where to write the information about what * line number represented the start of the * code in question. Will be written to, * either with the line number or with -1 if * the information is not available. */ { CmdFrame *cfPtr = TclGetCmdFrameForProcedure(procPtr); *fileObjPtr = NULL; *linePtr = -1; if (cfPtr == NULL) { return; } /* * Get the source location data out of the CmdFrame. */ *linePtr = cfPtr->line[0]; if (cfPtr->type == TCL_LOCATION_SOURCE) { *fileObjPtr = cfPtr->data.eval.path; } } #ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * * TclPrintByteCodeObj -- * * This procedure prints ("disassembles") the instructions of a bytecode * object to stdout. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclPrintByteCodeObj( Tcl_Interp *interp, /* Used only for getting location info. */ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ { Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, objPtr); fprintf(stdout, "\n%s", TclGetString(bufPtr)); Tcl_DecrRefCount(bufPtr); } /* *---------------------------------------------------------------------- * * TclPrintInstruction -- * * This procedure prints ("disassembles") one instruction from a bytecode * object to stdout. * * Results: * Returns the length in bytes of the current instruiction. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclPrintInstruction( ByteCode *codePtr, /* Bytecode containing the instruction. */ const unsigned char *pc) /* Points to first byte of instruction. */ { Tcl_Obj *bufferObj; int numBytes; TclNewObj(bufferObj); numBytes = FormatInstruction(codePtr, pc, bufferObj); fprintf(stdout, "%s", TclGetString(bufferObj)); Tcl_DecrRefCount(bufferObj); return numBytes; } /* *---------------------------------------------------------------------- * * TclPrintObject -- * * This procedure prints up to a specified number of characters from the * argument Tcl object's string representation to a specified file. * * Results: * None. * * Side effects: * Outputs characters to the specified file. * *---------------------------------------------------------------------- */ void TclPrintObject( FILE *outFile, /* The file to print the source to. */ Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ int maxChars) /* Maximum number of chars to print. */ { char *bytes; int length; bytes = Tcl_GetStringFromObj(objPtr, &length); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); } /* *---------------------------------------------------------------------- * * TclPrintSource -- * * This procedure prints up to a specified number of characters from the * argument string to a specified file. It tries to produce legible * output by adding backslashes as necessary. * * Results: * None. * * Side effects: * Outputs characters to the specified file. * *---------------------------------------------------------------------- */ void TclPrintSource( FILE *outFile, /* The file to print the source to. */ const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { Tcl_Obj *bufferObj; TclNewObj(bufferObj); PrintSourceToObj(bufferObj, stringPtr, maxChars); fprintf(outFile, "%s", TclGetString(bufferObj)); Tcl_DecrRefCount(bufferObj); } #endif /* TCL_COMPILE_DEBUG */ /* *---------------------------------------------------------------------- * * DisassembleByteCodeObj -- * * Given an object which is of bytecode type, return a disassembled * version of the bytecode (in a new refcount 0 object). No guarantees * are made about the details of the contents of the result. * *---------------------------------------------------------------------- */ static Tcl_Obj * DisassembleByteCodeObj( Tcl_Interp *interp, Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ { ByteCode *codePtr = BYTECODE(objPtr); unsigned char *codeStart, *codeLimit, *pc; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_Obj *bufferObj, *fileObj; char ptrBuf1[20], ptrBuf2[20]; TclNewObj(bufferObj); if (codePtr->refCount <= 0) { return bufferObj; /* Already freed. */ } codeStart = codePtr->codeStart; codeLimit = codeStart + codePtr->numCodeBytes; numCmds = codePtr->numCommands; /* * Print header lines describing the ByteCode. */ snprintf(ptrBuf1, sizeof(ptrBuf1), "%p", codePtr); snprintf(ptrBuf2, sizeof(ptrBuf1), "%p", iPtr); Tcl_AppendPrintfToObj(bufferObj, "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n", ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2, iPtr->compileEpoch); Tcl_AppendToObj(bufferObj, " Source ", -1); PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); GetLocationInformation(codePtr->procPtr, &fileObj, &line); if (line > -1 && fileObj != NULL) { Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d", Tcl_GetString(fileObj), line); } Tcl_AppendPrintfToObj(bufferObj, "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n", numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, #ifdef TCL_COMPILE_STATS codePtr->numSrcBytes? codePtr->structureSize/(float)codePtr->numSrcBytes : #endif 0.0); #ifdef TCL_COMPILE_STATS Tcl_AppendPrintfToObj(bufferObj, " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n", (unsigned long) codePtr->structureSize, (unsigned long) (TclOffset(ByteCode, localCachePtr)), codePtr->numCodeBytes, (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)), (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)), (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)), codePtr->numCmdLocBytes); #endif /* TCL_COMPILE_STATS */ /* * If the ByteCode is the compiled body of a Tcl procedure, print * information about that procedure. Note that we don't know the * procedure's name since ByteCode's can be shared among procedures. */ if (codePtr->procPtr != NULL) { Proc *procPtr = codePtr->procPtr; int numCompiledLocals = procPtr->numCompiledLocals; snprintf(ptrBuf1, sizeof(ptrBuf1), "%p", procPtr); Tcl_AppendPrintfToObj(bufferObj, " Proc 0x%s, refCt %d, args %d, compiled locals %d\n", ptrBuf1, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { CompiledLocal *localPtr = procPtr->firstLocalPtr; for (i = 0; i < numCompiledLocals; i++) { Tcl_AppendPrintfToObj(bufferObj, " slot %d%s%s%s%s%s%s", i, (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar", (localPtr->flags & VAR_ARRAY) ? ", array" : "", (localPtr->flags & VAR_LINK) ? ", link" : "", (localPtr->flags & VAR_ARGUMENT) ? ", arg" : "", (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "", (localPtr->flags & VAR_RESOLVED) ? ", resolved" : ""); if (TclIsVarTemporary(localPtr)) { Tcl_AppendToObj(bufferObj, "\n", -1); } else { Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n", localPtr->name); } localPtr = localPtr->nextPtr; } } } /* * Print the ExceptionRange array. */ if (codePtr->numExceptRanges > 0) { Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n", codePtr->numExceptRanges, codePtr->maxExceptDepth); for (i = 0; i < codePtr->numExceptRanges; i++) { ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; Tcl_AppendPrintfToObj(bufferObj, " %d: level %d, %s, pc %d-%d, ", i, rangePtr->nestingLevel, (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"), rangePtr->codeOffset, (rangePtr->codeOffset + rangePtr->numCodeBytes - 1)); switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n", rangePtr->continueOffset, rangePtr->breakOffset); break; case CATCH_EXCEPTION_RANGE: Tcl_AppendPrintfToObj(bufferObj, "catch %d\n", rangePtr->catchOffset); break; default: Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d", rangePtr->type); } } } /* * If there were no commands (e.g., an expression or an empty string was * compiled), just print all instructions and return. */ if (numCmds == 0) { pc = codeStart; while (pc < codeLimit) { Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } return bufferObj; } /* * Print table showing the code offset, source offset, and source length * for each command. These are encoded as a sequence of bytes. */ Tcl_AppendPrintfToObj(bufferObj, " Commands %d:", numCmds); codeDeltaNext = codePtr->codeDeltaStart; codeLengthNext = codePtr->codeLengthStart; srcDeltaNext = codePtr->srcDeltaStart; srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; } else { delta = TclGetInt1AtPtr(codeDeltaNext); codeDeltaNext++; } codeOffset += delta; if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; } else { codeLen = TclGetInt1AtPtr(codeLengthNext); codeLengthNext++; } if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; } else { delta = TclGetInt1AtPtr(srcDeltaNext); srcDeltaNext++; } srcOffset += delta; if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; } else { srcLen = TclGetInt1AtPtr(srcLengthNext); srcLengthNext++; } Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d", ((i % 2)? " " : "\n "), (i+1), codeOffset, (codeOffset + codeLen - 1), srcOffset, (srcOffset + srcLen - 1)); } if (numCmds > 0) { Tcl_AppendToObj(bufferObj, "\n", -1); } /* * Print each instruction. If the instruction corresponds to the start of * a command, print the command's source. Note that we don't need the code * length here. */ codeDeltaNext = codePtr->codeDeltaStart; srcDeltaNext = codePtr->srcDeltaStart; srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; pc = codeStart; for (i = 0; i < numCmds; i++) { if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; } else { delta = TclGetInt1AtPtr(codeDeltaNext); codeDeltaNext++; } codeOffset += delta; if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; } else { delta = TclGetInt1AtPtr(srcDeltaNext); srcDeltaNext++; } srcOffset += delta; if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; } else { srcLen = TclGetInt1AtPtr(srcLengthNext); srcLengthNext++; } /* * Print instructions before command i. */ while ((pc-codeStart) < codeOffset) { Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1); PrintSourceToObj(bufferObj, (codePtr->source + srcOffset), TclMin(srcLen, 55)); Tcl_AppendToObj(bufferObj, "\n", -1); } if (pc < codeLimit) { /* * Print instructions after the last command. */ while (pc < codeLimit) { Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } } return bufferObj; } /* *---------------------------------------------------------------------- * * FormatInstruction -- * * Appends a representation of a bytecode instruction to a Tcl_Obj. * *---------------------------------------------------------------------- */ static int FormatInstruction( ByteCode *codePtr, /* Bytecode containing the instruction. */ const unsigned char *pc, /* Points to first byte of instruction. */ Tcl_Obj *bufferObj) /* Object to append instruction info to. */ { Proc *procPtr = codePtr->procPtr; unsigned char opCode = *pc; const InstructionDesc *instDesc = &tclInstructionTable[opCode]; unsigned char *codeStart = codePtr->codeStart; unsigned pcOffset = pc - codeStart; int opnd = 0, i, j, numBytes = 1; int localCt = procPtr ? procPtr->numCompiledLocals : 0; CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL; char suffixBuffer[128]; /* Additional info to print after main opcode * and immediates. */ char *suffixSrc = NULL; Tcl_Obj *suffixObj = NULL; AuxData *auxPtr = NULL; suffixBuffer[0] = '\0'; Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name); for (i = 0; i < instDesc->numOperands; i++) { switch (instDesc->opTypes[i]) { case OPERAND_INT1: opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_INT4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_UINT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_UINT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; if (opCode == INST_START_CMD) { snprintf(suffixBuffer+strlen(suffixBuffer), sizeof(suffixBuffer) - strlen(suffixBuffer), ", %u cmds start here", opnd); } Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_OFFSET1: opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd); Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_OFFSET4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; if (opCode == INST_START_CMD) { snprintf(suffixBuffer, sizeof(suffixBuffer), "next cmd at pc %u", pcOffset+opnd); } else { snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd); } Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_LIT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; suffixObj = codePtr->objArrayPtr[opnd]; Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_LIT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; suffixObj = codePtr->objArrayPtr[opnd]; Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_AUX4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); auxPtr = &codePtr->auxDataArrayPtr[opnd]; break; case OPERAND_IDX4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; if (opnd >= -1) { Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd); } else if (opnd == -2) { Tcl_AppendPrintfToObj(bufferObj, "end "); } else { Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd); } break; case OPERAND_LVT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; goto printLVTindex; case OPERAND_LVT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; printLVTindex: if (localPtr != NULL) { if (opnd >= localCt) { Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)", (unsigned) opnd, localCt); } for (j = 0; j < opnd; j++) { localPtr = localPtr->nextPtr; } if (TclIsVarTemporary(localPtr)) { snprintf(suffixBuffer, sizeof(suffixBuffer), "temp var %u", (unsigned) opnd); } else { snprintf(suffixBuffer, sizeof(suffixBuffer), "var "); suffixSrc = localPtr->name; } } Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd); break; case OPERAND_SCLS1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%s ", tclStringClassTable[opnd].name); break; case OPERAND_NONE: default: break; } } if (suffixObj) { const char *bytes; int length; Tcl_AppendToObj(bufferObj, "\t# ", -1); bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length); PrintSourceToObj(bufferObj, bytes, TclMin(length, 40)); } else if (suffixBuffer[0]) { Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer); if (suffixSrc) { PrintSourceToObj(bufferObj, suffixSrc, 40); } } Tcl_AppendToObj(bufferObj, "\n", -1); if (auxPtr && auxPtr->type->printProc) { Tcl_AppendToObj(bufferObj, "\t\t[", -1); auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr, pcOffset); Tcl_AppendToObj(bufferObj, "]\n", -1); } return numBytes; } /* *---------------------------------------------------------------------- * * TclGetInnerContext -- * * If possible, returns a list capturing the inner context. Otherwise * return NULL. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetInnerContext( Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr) { int objc = 0, off = 0; Tcl_Obj *result; Interp *iPtr = (Interp *) interp; switch (*pc) { case INST_STR_LEN: case INST_LNOT: case INST_BITNOT: case INST_UMINUS: case INST_UPLUS: case INST_TRY_CVT_TO_NUMERIC: case INST_EXPAND_STKTOP: case INST_EXPR_STK: objc = 1; break; case INST_LIST_IN: case INST_LIST_NOT_IN: /* Basic list containment operators. */ case INST_STR_EQ: case INST_STR_NEQ: /* String (in)equality check */ case INST_STR_CMP: /* String compare. */ case INST_STR_INDEX: case INST_STR_MATCH: case INST_REGEXP: case INST_EQ: case INST_NEQ: case INST_LT: case INST_GT: case INST_LE: case INST_GE: case INST_MOD: case INST_LSHIFT: case INST_RSHIFT: case INST_BITOR: case INST_BITXOR: case INST_BITAND: case INST_EXPON: case INST_ADD: case INST_SUB: case INST_DIV: case INST_MULT: objc = 2; break; case INST_RETURN_STK: /* early pop. TODO: dig out opt dict too :/ */ objc = 1; break; case INST_SYNTAX: case INST_RETURN_IMM: objc = 2; break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); break; case INST_INVOKE_STK1: objc = TclGetUInt1AtPtr(pc+1); break; } result = iPtr->innerContext; if (Tcl_IsShared(result)) { Tcl_DecrRefCount(result); iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); Tcl_IncrRefCount(result); } else { int len; /* * Reset while keeping the list internalrep as much as possible. */ TclListObjLength(interp, result, &len); Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); } Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc)); for (; objc>0 ; objc--) { Tcl_Obj *objPtr; objPtr = tosPtr[1 - objc + off]; if (!objPtr) { Tcl_Panic("InnerContext: bad tos -- appending null object"); } if ((objPtr->refCount<=0) #ifdef TCL_MEM_DEBUG || (objPtr->refCount==0x61616161) #endif ) { Tcl_Panic("InnerContext: bad tos -- appending freed object %p", objPtr); } Tcl_ListObjAppendElement(NULL, result, objPtr); } return result; } /* *---------------------------------------------------------------------- * * TclNewInstNameObj -- * * Creates a new InstName Tcl_Obj based on the given instruction * *---------------------------------------------------------------------- */ Tcl_Obj * TclNewInstNameObj( unsigned char inst) { Tcl_Obj *objPtr; TclNewObj(objPtr); objPtr->typePtr = &tclInstNameType; objPtr->internalRep.longValue = (long) inst; objPtr->bytes = NULL; return objPtr; } /* *---------------------------------------------------------------------- * * UpdateStringOfInstName -- * * Update the string representation for an instruction name object. * *---------------------------------------------------------------------- */ static void UpdateStringOfInstName( Tcl_Obj *objPtr) { int inst = objPtr->internalRep.longValue; char *s, buf[20]; int len; if ((inst < 0) || (inst > LAST_INST_OPCODE)) { snprintf(buf, sizeof(buf), "inst_%d", inst); s = buf; } else { s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name; } len = strlen(s); objPtr->bytes = (char *)ckalloc(len + 1); memcpy(objPtr->bytes, s, len + 1); objPtr->length = len; } /* *---------------------------------------------------------------------- * * PrintSourceToObj -- * * Appends a quoted representation of a string to a Tcl_Obj. * *---------------------------------------------------------------------- */ static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { const char *p; int i = 0, len; if (stringPtr == NULL) { Tcl_AppendToObj(appendObj, "\"\"", -1); return; } Tcl_AppendToObj(appendObj, "\"", -1); p = stringPtr; for (; (*p != '\0') && (i < maxChars); p+=len) { int ucs4; len = TclUtfToUCS4(p, &ucs4); switch (ucs4) { case '"': Tcl_AppendToObj(appendObj, "\\\"", -1); i += 2; continue; case '\f': Tcl_AppendToObj(appendObj, "\\f", -1); i += 2; continue; case '\n': Tcl_AppendToObj(appendObj, "\\n", -1); i += 2; continue; case '\r': Tcl_AppendToObj(appendObj, "\\r", -1); i += 2; continue; case '\t': Tcl_AppendToObj(appendObj, "\\t", -1); i += 2; continue; case '\v': Tcl_AppendToObj(appendObj, "\\v", -1); i += 2; continue; default: if (ucs4 > 0xFFFF) { Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ucs4); i += 10; } else if (ucs4 < 0x20 || ucs4 >= 0x7F) { Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ucs4); i += 6; } else { Tcl_AppendPrintfToObj(appendObj, "%c", ucs4); i++; } continue; } } if (*p != '\0') { Tcl_AppendToObj(appendObj, "...", -1); } Tcl_AppendToObj(appendObj, "\"", -1); } /* *---------------------------------------------------------------------- * * DisassembleByteCodeAsDicts -- * * Given an object which is of bytecode type, return a disassembled * version of the bytecode (in a new refcount 0 object) in a dictionary. * No guarantees are made about the details of the contents of the * result, but it is intended to be more readable than the old output * format. * *---------------------------------------------------------------------- */ static Tcl_Obj * DisassembleByteCodeAsDicts( Tcl_Interp *interp, /* Used for looking up the CmdFrame for the * procedure, if one exists. */ Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */ { ByteCode *codePtr = BYTECODE(objPtr); Tcl_Obj *description, *literals, *variables, *instructions, *inst; Tcl_Obj *aux, *exn, *commands, *file; unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr; int codeOffset, codeLength, sourceOffset, sourceLength; int i, val, line; /* * Get the literals from the bytecode. */ TclNewObj(literals); for (i=0 ; inumLitObjects ; i++) { Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]); } /* * Get the variables from the bytecode. */ TclNewObj(variables); if (codePtr->procPtr) { int localCount = codePtr->procPtr->numCompiledLocals; CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr; for (i=0 ; inextPtr) { Tcl_Obj *descriptor[2]; TclNewObj(descriptor[0]); if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("scalar", -1)); } if (localPtr->flags & VAR_ARRAY) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("array", -1)); } if (localPtr->flags & VAR_LINK) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("link", -1)); } if (localPtr->flags & VAR_ARGUMENT) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("arg", -1)); } if (localPtr->flags & VAR_TEMPORARY) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("temp", -1)); } if (localPtr->flags & VAR_RESOLVED) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("resolved", -1)); } if (localPtr->flags & VAR_TEMPORARY) { Tcl_ListObjAppendElement(NULL, variables, Tcl_NewListObj(1, descriptor)); } else { descriptor[1] = Tcl_NewStringObj(localPtr->name, -1); Tcl_ListObjAppendElement(NULL, variables, Tcl_NewListObj(2, descriptor)); } } } /* * Get the instructions from the bytecode. */ TclNewObj(instructions); for (pc=codePtr->codeStart; pccodeStart+codePtr->numCodeBytes;){ const InstructionDesc *instDesc = &tclInstructionTable[*pc]; int address = pc - codePtr->codeStart; TclNewObj(inst); Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( instDesc->name, -1)); opnd = pc + 1; for (i=0 ; inumOperands ; i++) { switch (instDesc->opTypes[i]) { case OPERAND_INT1: val = TclGetInt1AtPtr(opnd); opnd += 1; goto formatNumber; case OPERAND_UINT1: val = TclGetUInt1AtPtr(opnd); opnd += 1; goto formatNumber; case OPERAND_INT4: val = TclGetInt4AtPtr(opnd); opnd += 4; goto formatNumber; case OPERAND_UINT4: val = TclGetUInt4AtPtr(opnd); opnd += 4; formatNumber: Tcl_ListObjAppendElement(NULL, inst, Tcl_NewIntObj(val)); break; case OPERAND_OFFSET1: val = TclGetInt1AtPtr(opnd); opnd += 1; goto formatAddress; case OPERAND_OFFSET4: val = TclGetInt4AtPtr(opnd); opnd += 4; formatAddress: Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( "pc %d", address + val)); break; case OPERAND_LIT1: val = TclGetUInt1AtPtr(opnd); opnd += 1; goto formatLiteral; case OPERAND_LIT4: val = TclGetUInt4AtPtr(opnd); opnd += 4; formatLiteral: Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( "@%d", val)); break; case OPERAND_LVT1: val = TclGetUInt1AtPtr(opnd); opnd += 1; goto formatVariable; case OPERAND_LVT4: val = TclGetUInt4AtPtr(opnd); opnd += 4; formatVariable: Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( "%%%d", val)); break; case OPERAND_IDX4: val = TclGetInt4AtPtr(opnd); opnd += 4; if (val >= -1) { Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( ".%d", val)); } else if (val == -2) { Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( ".end", -1)); } else { Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( ".end-%d", -2-val)); } break; case OPERAND_AUX4: val = TclGetInt4AtPtr(opnd); opnd += 4; Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( "?%d", val)); break; case OPERAND_SCLS1: val = TclGetUInt1AtPtr(opnd); opnd++; Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( "=%s", tclStringClassTable[val].name)); break; case OPERAND_NONE: Tcl_Panic("opcode %d with more than zero 'no' operands", *pc); } } Tcl_DictObjPut(NULL, instructions, Tcl_NewIntObj(address), inst); pc += instDesc->numBytes; } /* * Get the auxiliary data from the bytecode. */ TclNewObj(aux); for (i=0 ; inumAuxDataItems ; i++) { AuxData *auxData = &codePtr->auxDataArrayPtr[i]; Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1); if (auxData->type->disassembleProc) { Tcl_Obj *desc; TclNewObj(desc); Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc); auxDesc = desc; auxData->type->disassembleProc(auxData->clientData, auxDesc, codePtr, 0); } else if (auxData->type->printProc) { Tcl_Obj *desc; TclNewObj(desc); auxData->type->printProc(auxData->clientData, desc, codePtr, 0); Tcl_ListObjAppendElement(NULL, auxDesc, desc); } Tcl_ListObjAppendElement(NULL, aux, auxDesc); } /* * Get the exception ranges from the bytecode. */ TclNewObj(exn); for (i=0 ; inumExceptRanges ; i++) { ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf( "type %s level %d from %d to %d break %d continue %d", "loop", rangePtr->nestingLevel, rangePtr->codeOffset, rangePtr->codeOffset + rangePtr->numCodeBytes - 1, rangePtr->breakOffset, rangePtr->continueOffset)); break; case CATCH_EXCEPTION_RANGE: Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf( "type %s level %d from %d to %d catch %d", "catch", rangePtr->nestingLevel, rangePtr->codeOffset, rangePtr->codeOffset + rangePtr->numCodeBytes - 1, rangePtr->catchOffset)); break; } } /* * Get the command information from the bytecode. * * The way these are encoded in the bytecode is non-trivial; the Decode * macro (which updates its argument and returns the next decoded value) * handles this so that the rest of the code does not. */ #define Decode(ptr) \ ((TclGetUInt1AtPtr(ptr) == 0xFF) \ ? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4)) \ : ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1))) TclNewObj(commands); codeOffPtr = codePtr->codeDeltaStart; codeLenPtr = codePtr->codeLengthStart; srcOffPtr = codePtr->srcDeltaStart; srcLenPtr = codePtr->srcLengthStart; codeOffset = sourceOffset = 0; for (i=0 ; inumCommands ; i++) { Tcl_Obj *cmd; codeOffset += Decode(codeOffPtr); codeLength = Decode(codeLenPtr); sourceOffset += Decode(srcOffPtr); sourceLength = Decode(srcLenPtr); TclNewObj(cmd); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1), Tcl_NewIntObj(codeOffset)); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1), Tcl_NewIntObj(codeOffset + codeLength - 1)); /* * Convert byte offsets to character offsets; important if multibyte * characters are present in the source! */ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1), Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source, sourceOffset))); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1), Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source, sourceOffset + sourceLength - 1))); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1), Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength)); Tcl_ListObjAppendElement(NULL, commands, cmd); } #undef Decode /* * Get the source file and line number information from the CmdFrame * system if it is available. */ GetLocationInformation(codePtr->procPtr, &file, &line); /* * Build the overall result. */ TclNewObj(description); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1), literals); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1), variables); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1), instructions); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1), commands); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1), Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes)); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1), Tcl_NewStringObj(codePtr->nsPtr->fullName, -1)); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1), Tcl_NewIntObj(codePtr->maxStackDepth)); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1), Tcl_NewIntObj(codePtr->maxExceptDepth)); if (line > -1) { Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("initiallinenumber", -1), Tcl_NewIntObj(line)); } if (file) { Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("sourcefile", -1), file); } return description; } /* *---------------------------------------------------------------------- * * Tcl_DisassembleObjCmd -- * * Implementation of the "::tcl::unsupported::disassemble" command. This * command is not documented, but will disassemble procedures, lambda * terms and general scripts. Note that will compile terms if necessary * in order to disassemble them. * *---------------------------------------------------------------------- */ int Tcl_DisassembleObjCmd( ClientData clientData, /* What type of operation. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const types[] = { "constructor", "destructor", "lambda", "method", "objmethod", "proc", "script", NULL }; enum Types { DISAS_CLASS_CONSTRUCTOR, DISAS_CLASS_DESTRUCTOR, DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC, DISAS_SCRIPT }; int idx, result; Tcl_Obj *codeObjPtr = NULL; Proc *procPtr = NULL; Tcl_HashEntry *hPtr; Object *oPtr; Method *methodPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "type ..."); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){ return TCL_ERROR; } switch ((enum Types) idx) { case DISAS_LAMBDA: { Command cmd; Tcl_Obj *nsObjPtr; Tcl_Namespace *nsPtr; /* * Compile (if uncompiled) and disassemble a lambda term. * * WARNING! Pokes inside the lambda objtype. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm"); return TCL_ERROR; } if (objv[2]->typePtr == &tclLambdaType) { procPtr = (Proc *)objv[2]->internalRep.twoPtrValue.ptr1; } if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) { result = tclLambdaType.setFromAnyProc(interp, objv[2]); if (result != TCL_OK) { return result; } procPtr = (Proc *)objv[2]->internalRep.twoPtrValue.ptr1; } memset(&cmd, 0, sizeof(Command)); nsObjPtr = (Tcl_Obj *)objv[2]->internalRep.twoPtrValue.ptr2; result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); if (result != TCL_OK) { return result; } cmd.nsPtr = (Namespace *) nsPtr; procPtr->cmdPtr = &cmd; result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1); if (result != TCL_OK) { return result; } TclPopStackFrame(interp); codeObjPtr = procPtr->bodyPtr; break; } case DISAS_PROC: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "procName"); return TCL_ERROR; } procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2])); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" isn't a procedure", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC", TclGetString(objv[2]), NULL); return TCL_ERROR; } /* * Compile (if uncompiled) and disassemble a procedure. */ result = TclPushProcCallFrame(procPtr, interp, 2, objv+1, 1); if (result != TCL_OK) { return result; } TclPopStackFrame(interp); codeObjPtr = procPtr->bodyPtr; break; case DISAS_SCRIPT: /* * Compile and disassemble a script. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "script"); return TCL_ERROR; } if ((objv[2]->typePtr != &tclByteCodeType) && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) { return TCL_ERROR; } codeObjPtr = objv[2]; break; case DISAS_CLASS_CONSTRUCTOR: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "className"); return TCL_ERROR; } /* * Look up the body of a constructor. */ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->classPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" is not a class", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[2]), NULL); return TCL_ERROR; } methodPtr = oPtr->classPtr->constructorPtr; if (methodPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" has no defined constructor", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "CONSRUCTOR", NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; } /* * Compile if necessary. */ if (procPtr->bodyPtr->typePtr != &tclByteCodeType) { Command cmd; /* * Yes, this is ugly, but we need to pass the namespace in to the * compiler in two places. */ cmd.nsPtr = (Namespace *) oPtr->namespacePtr; procPtr->cmdPtr = &cmd; result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, (Namespace *) oPtr->namespacePtr, "body of constructor", TclGetString(objv[2])); procPtr->cmdPtr = NULL; if (result != TCL_OK) { return result; } } codeObjPtr = procPtr->bodyPtr; break; case DISAS_CLASS_DESTRUCTOR: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "className"); return TCL_ERROR; } /* * Look up the body of a destructor. */ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->classPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" is not a class", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[2]), NULL); return TCL_ERROR; } methodPtr = oPtr->classPtr->destructorPtr; if (methodPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" has no defined destructor", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "DESRUCTOR", NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of destructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; } /* * Compile if necessary. */ if (procPtr->bodyPtr->typePtr != &tclByteCodeType) { Command cmd; /* * Yes, this is ugly, but we need to pass the namespace in to the * compiler in two places. */ cmd.nsPtr = (Namespace *) oPtr->namespacePtr; procPtr->cmdPtr = &cmd; result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, (Namespace *) oPtr->namespacePtr, "body of destructor", TclGetString(objv[2])); procPtr->cmdPtr = NULL; if (result != TCL_OK) { return result; } } codeObjPtr = procPtr->bodyPtr; break; case DISAS_CLASS_METHOD: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "className methodName"); return TCL_ERROR; } /* * Look up the body of a class method. */ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->classPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" is not a class", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[2]), NULL); return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods, (char *) objv[3]); goto methodBody; case DISAS_OBJECT_METHOD: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName"); return TCL_ERROR; } /* * Look up the body of an instance method. */ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->methodsPtr == NULL) { goto unknownMethod; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]); /* * Compile (if necessary) and disassemble a method body. */ methodBody: if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[3]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[3]), NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; } if (procPtr->bodyPtr->typePtr != &tclByteCodeType) { Command cmd; /* * Yes, this is ugly, but we need to pass the namespace in to the * compiler in two places. */ cmd.nsPtr = (Namespace *) oPtr->namespacePtr; procPtr->cmdPtr = &cmd; result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, (Namespace *) oPtr->namespacePtr, "body of method", TclGetString(objv[3])); procPtr->cmdPtr = NULL; if (result != TCL_OK) { return result; } } codeObjPtr = procPtr->bodyPtr; break; default: CLANG_ASSERT(0); } /* * Do the actual disassembly. */ if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not disassemble prebuilt bytecode", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "BYTECODE", NULL); return TCL_ERROR; } if (PTR2INT(clientData)) { Tcl_SetObjResult(interp, DisassembleByteCodeAsDicts(interp, codeObjPtr)); } else { Tcl_SetObjResult(interp, DisassembleByteCodeObj(interp, codeObjPtr)); } return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ tcl8.6.14/generic/tclDTrace.d0000644000175000017500000001615114554262142015274 0ustar sergeisergei/* * tclDTrace.d -- * * Tcl DTrace provider. * * Copyright (c) 2007-2008 Daniel A. Steffen * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ typedef struct Tcl_Obj Tcl_Obj; /* * Tcl DTrace probes */ provider tcl { /***************************** proc probes *****************************/ /* * tcl*:::proc-entry probe * triggered immediately before proc bytecode execution * arg0: proc name (string) * arg1: number of arguments (int) * arg2: array of proc argument objects (Tcl_Obj**) */ probe proc__entry(const char *name, int objc, struct Tcl_Obj **objv); /* * tcl*:::proc-return probe * triggered immediately after proc bytecode execution * arg0: proc name (string) * arg1: return code (int) */ probe proc__return(const char *name, int code); /* * tcl*:::proc-result probe * triggered after proc-return probe and result processing * arg0: proc name (string) * arg1: return code (int) * arg2: proc result (string) * arg3: proc result object (Tcl_Obj*) */ probe proc__result(const char *name, int code, const char *result, struct Tcl_Obj *resultobj); /* * tcl*:::proc-args probe * triggered before proc-entry probe, gives access to string * representation of proc arguments * arg0: proc name (string) * arg1-arg9: proc arguments or NULL (strings) */ probe proc__args(const char *name, const char *arg1, const char *arg2, const char *arg3, const char *arg4, const char *arg5, const char *arg6, const char *arg7, const char *arg8, const char *arg9); /* * tcl*:::proc-info probe * triggered before proc-entry probe, gives access to TIP 280 * information for the proc invocation (i.e. [info frame 0]) * arg0: TIP 280 cmd (string) * arg1: TIP 280 type (string) * arg2: TIP 280 proc (string) * arg3: TIP 280 file (string) * arg4: TIP 280 line (int) * arg5: TIP 280 level (int) * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ probe proc__info(const char *cmd, const char *type, const char *proc, const char *file, int line, int level, const char *method, const char *class); /***************************** cmd probes ******************************/ /* * tcl*:::cmd-entry probe * triggered immediately before commmand execution * arg0: command name (string) * arg1: number of arguments (int) * arg2: array of command argument objects (Tcl_Obj**) */ probe cmd__entry(const char *name, int objc, struct Tcl_Obj **objv); /* * tcl*:::cmd-return probe * triggered immediately after commmand execution * arg0: command name (string) * arg1: return code (int) */ probe cmd__return(const char *name, int code); /* * tcl*:::cmd-result probe * triggered after cmd-return probe and result processing * arg0: command name (string) * arg1: return code (int) * arg2: command result (string) * arg3: command result object (Tcl_Obj*) */ probe cmd__result(const char *name, int code, const char *result, struct Tcl_Obj *resultobj); /* * tcl*:::cmd-args probe * triggered before cmd-entry probe, gives access to string * representation of command arguments * arg0: command name (string) * arg1-arg9: command arguments or NULL (strings) */ probe cmd__args(const char *name, const char *arg1, const char *arg2, const char *arg3, const char *arg4, const char *arg5, const char *arg6, const char *arg7, const char *arg8, const char *arg9); /* * tcl*:::cmd-info probe * triggered before cmd-entry probe, gives access to TIP 280 * information for the command invocation (i.e. [info frame 0]) * arg0: TIP 280 cmd (string) * arg1: TIP 280 type (string) * arg2: TIP 280 proc (string) * arg3: TIP 280 file (string) * arg4: TIP 280 line (int) * arg5: TIP 280 level (int) * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ probe cmd__info(const char *cmd, const char *type, const char *proc, const char *file, int line, int level, const char *method, const char *class); /***************************** inst probes *****************************/ /* * tcl*:::inst-start probe * triggered immediately before execution of a bytecode * arg0: bytecode name (string) * arg1: depth of stack (int) * arg2: top of stack (Tcl_Obj**) */ probe inst__start(const char *name, int depth, struct Tcl_Obj **stack); /* * tcl*:::inst-done probe * triggered immediately after execution of a bytecode * arg0: bytecode name (string) * arg1: depth of stack (int) * arg2: top of stack (Tcl_Obj**) */ probe inst__done(const char *name, int depth, struct Tcl_Obj **stack); /***************************** obj probes ******************************/ /* * tcl*:::obj-create probe * triggered immediately after a new Tcl_Obj has been created * arg0: object created (Tcl_Obj*) */ probe obj__create(struct Tcl_Obj* obj); /* * tcl*:::obj-free probe * triggered immediately before a Tcl_Obj is freed * arg0: object to be freed (Tcl_Obj*) */ probe obj__free(struct Tcl_Obj* obj); /***************************** tcl probes ******************************/ /* * tcl*:::tcl-probe probe * triggered when the ::tcl::dtrace command is called * arg0-arg9: command arguments (strings) */ probe tcl__probe(const char *arg0, const char *arg1, const char *arg2, const char *arg3, const char *arg4, const char *arg5, const char *arg6, const char *arg7, const char *arg8, const char *arg9); }; /* * Tcl types and constants for use in DTrace scripts */ typedef struct Tcl_ObjType { const char *name; void *freeIntRepProc; void *dupIntRepProc; void *updateStringProc; void *setFromAnyProc; } Tcl_ObjType; struct Tcl_Obj { int refCount; char *bytes; int length; const Tcl_ObjType *typePtr; union { long longValue; double doubleValue; void *otherValuePtr; int64_t wideValue; struct { void *ptr1; void *ptr2; } twoPtrValue; struct { void *ptr; unsigned long value; } ptrAndLongRep; } internalRep; }; enum return_codes { TCL_OK = 0, TCL_ERROR, TCL_RETURN, TCL_BREAK, TCL_CONTINUE }; #pragma D attributes Evolving/Evolving/Common provider tcl provider #pragma D attributes Private/Private/Common provider tcl module #pragma D attributes Private/Private/Common provider tcl function #pragma D attributes Evolving/Evolving/Common provider tcl name #pragma D attributes Evolving/Evolving/Common provider tcl args /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclEncoding.c0000644000175000017500000032367214554262142015670 0ustar sergeisergei/* * tclEncoding.c -- * * Contains the implementation of the encoding conversion package. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" typedef size_t (LengthProc)(const char *src); /* * The following data structure represents an encoding, which describes how to * convert between various character sets and UTF-8. */ typedef struct { char *name; /* Name of encoding. Malloced because (1) hash * table entry that owns this encoding may be * freed prior to this encoding being freed, * (2) string passed in the Tcl_EncodingType * structure may not be persistent. */ Tcl_EncodingConvertProc *toUtfProc; /* Function to convert from external encoding * into UTF-8. */ Tcl_EncodingConvertProc *fromUtfProc; /* Function to convert from UTF-8 into * external encoding. */ Tcl_EncodingFreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ int nullSize; /* Number of 0x00 bytes that signify * end-of-string in this encoding. This number * is used to determine the source string * length when the srcLen argument is * negative. This number can be 1 or 2. */ ClientData clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ LengthProc *lengthProc; /* Function to compute length of * null-terminated strings in this encoding. * If nullSize is 1, this is strlen; if * nullSize is 2, this is a function that * returns the number of bytes in a 0x0000 * terminated string. */ int refCount; /* Number of uses of this structure. */ Tcl_HashEntry *hPtr; /* Hash table entry that owns this encoding. */ } Encoding; /* * The following structure is the clientData for a dynamically-loaded, * table-driven encoding created by LoadTableEncoding(). It maps between * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only) * encoding. */ typedef struct { int fallback; /* Character (in this encoding) to substitute * when this encoding cannot represent a UTF-8 * character. */ char prefixBytes[256]; /* If a byte in the input stream is a lead * byte for a 2-byte sequence, the * corresponding entry in this array is 1, * otherwise it is 0. */ unsigned short **toUnicode; /* Two dimensional sparse matrix to map * characters from the encoding to Unicode. * Each element of the toUnicode array points * to an array of 256 shorts. If there is no * corresponding character in Unicode, the * value in the matrix is 0x0000. * malloc'd. */ unsigned short **fromUnicode; /* Two dimensional sparse matrix to map * characters from Unicode to the encoding. * Each element of the fromUnicode array * points to an array of 256 shorts. If there * is no corresponding character the encoding, * the value in the matrix is 0x0000. * malloc'd. */ } TableEncodingData; /* * Each of the following structures is the clientData for a dynamically-loaded * escape-driven encoding that is itself comprised of other simpler encodings. * An example is "iso-2022-jp", which uses escape sequences to switch between * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven" * does not necessarily mean that the ESCAPE character is the character used * for switching character sets. */ typedef struct { unsigned sequenceLen; /* Length of following string. */ char sequence[16]; /* Escape code that marks this encoding. */ char name[32]; /* Name for encoding. */ Encoding *encodingPtr; /* Encoding loaded using above name, or NULL * if this sub-encoding has not been needed * yet. */ } EscapeSubTable; typedef struct { int fallback; /* Character (in this encoding) to substitute * when this encoding cannot represent a UTF-8 * character. */ unsigned initLen; /* Length of following string. */ char init[16]; /* String to emit or expect before first char * in conversion. */ unsigned finalLen; /* Length of following string. */ char final[16]; /* String to emit or expect after last char in * conversion. */ char prefixBytes[256]; /* If a byte in the input stream is the first * character of one of the escape sequences in * the following array, the corresponding * entry in this array is 1, otherwise it is * 0. */ int numSubTables; /* Length of following array. */ EscapeSubTable subTables[TCLFLEXARRAY];/* Information about each EscapeSubTable used * by this encoding type. The actual size is * as large as necessary to hold all * EscapeSubTables. */ } EscapeEncodingData; /* * Constants used when loading an encoding file to identify the type of the * file. */ #define ENCODING_SINGLEBYTE 0 #define ENCODING_DOUBLEBYTE 1 #define ENCODING_MULTIBYTE 2 #define ENCODING_ESCAPE 3 /* * A list of directories in which Tcl should look for *.enc files. This list * is shared by all threads. Access is governed by a mutex lock. */ static TclInitProcessGlobalValueProc InitializeEncodingSearchPath; static ProcessGlobalValue encodingSearchPath = { 0, 0, NULL, NULL, InitializeEncodingSearchPath, NULL, NULL }; /* * A map from encoding names to the directories in which their data files have * been seen. The string value of the map is shared by all threads. Access to * the shared string is governed by a mutex lock. */ static ProcessGlobalValue encodingFileMap = { 0, 0, NULL, NULL, NULL, NULL, NULL }; /* * A list of directories making up the "library path". Historically this * search path has served many uses, but the only one remaining is a base for * the encodingSearchPath above. If the application does not explicitly set * the encodingSearchPath, then it is initialized by appending /encoding * to each directory in this "libraryPath". */ static ProcessGlobalValue libraryPath = { 0, 0, NULL, NULL, TclpInitLibraryPath, NULL, NULL }; static int encodingsInitialized = 0; /* * Hash table that keeps track of all loaded Encodings. Keys are the string * names that represent the encoding, values are (Encoding *). */ static Tcl_HashTable encodingTable; TCL_DECLARE_MUTEX(encodingMutex) /* * The following are used to hold the default and current system encodings. * If NULL is passed to one of the conversion routines, the current setting of * the system encoding is used to perform the conversion. */ static Tcl_Encoding defaultEncoding = NULL; static Tcl_Encoding systemEncoding = NULL; Tcl_Encoding tclIdentityEncoding = NULL; /* * The following variable is used in the sparse matrix code for a * TableEncoding to represent a page in the table that has no entries. */ static unsigned short emptyPage[256]; /* * Functions used only in this module. */ static Tcl_EncodingConvertProc BinaryProc; static Tcl_DupInternalRepProc DupEncodingInternalRep; static Tcl_EncodingFreeProc EscapeFreeProc; static Tcl_EncodingConvertProc EscapeFromUtfProc; static Tcl_EncodingConvertProc EscapeToUtfProc; static void FillEncodingFileMap(void); static void FreeEncoding(Tcl_Encoding encoding); static Tcl_FreeInternalRepProc FreeEncodingInternalRep; static Encoding * GetTableEncoding(EscapeEncodingData *dataPtr, int state); static Tcl_Encoding LoadEncodingFile(Tcl_Interp *interp, const char *name); static Tcl_Encoding LoadTableEncoding(const char *name, int type, Tcl_Channel chan); static Tcl_Encoding LoadEscapeEncoding(const char *name, Tcl_Channel chan); static Tcl_Channel OpenEncodingFileChannel(Tcl_Interp *interp, const char *name); static Tcl_EncodingFreeProc TableFreeProc; static int TableFromUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int TableToUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static size_t unilen(const char *src); static int UnicodeToUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int UtfToUnicodeProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int UtfToUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr, int pureNullMode); static int UtfIntToUtfExtProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int UtfExtToUtfIntProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int Iso88591FromUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int Iso88591ToUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field * of the internalrep. This should help the lifetime of encodings be more useful. * See concerns raised in [Bug 1077262]. */ static const Tcl_ObjType encodingType = { "encoding", FreeEncodingInternalRep, DupEncodingInternalRep, NULL, NULL }; /* *---------------------------------------------------------------------- * * Tcl_GetEncodingFromObj -- * * Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr), if * possible, and returns TCL_OK. If no such encoding exists, TCL_ERROR is * returned, and if interp is non-NULL, an error message is written * there. * * Results: * Standard Tcl return code. * * Side effects: * Caches the Tcl_Encoding value as the internal rep of (*objPtr). * *---------------------------------------------------------------------- */ int Tcl_GetEncodingFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr) { const char *name = TclGetString(objPtr); if (objPtr->typePtr != &encodingType) { Tcl_Encoding encoding = Tcl_GetEncoding(interp, name); if (encoding == NULL) { return TCL_ERROR; } TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = encoding; objPtr->typePtr = &encodingType; } *encodingPtr = Tcl_GetEncoding(NULL, name); return TCL_OK; } /* *---------------------------------------------------------------------- * * FreeEncodingInternalRep -- * * The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType. * *---------------------------------------------------------------------- */ static void FreeEncodingInternalRep( Tcl_Obj *objPtr) { Tcl_FreeEncoding((Tcl_Encoding)objPtr->internalRep.twoPtrValue.ptr1); objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DupEncodingInternalRep -- * * The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType. * *---------------------------------------------------------------------- */ static void DupEncodingInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes); } /* *---------------------------------------------------------------------- * * Tcl_GetEncodingSearchPath -- * * Keeps the per-thread copy of the encoding search path current with * changes to the global copy. * * Results: * Returns a "list" (Tcl_Obj *) that contains the encoding search path. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetEncodingSearchPath(void) { return TclGetProcessGlobalValue(&encodingSearchPath); } /* *---------------------------------------------------------------------- * * Tcl_SetEncodingSearchPath -- * * Keeps the per-thread copy of the encoding search path current with * changes to the global copy. * *---------------------------------------------------------------------- */ int Tcl_SetEncodingSearchPath( Tcl_Obj *searchPath) { int dummy; if (TCL_ERROR == TclListObjLength(NULL, searchPath, &dummy)) { return TCL_ERROR; } TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclGetLibraryPath -- * * Keeps the per-thread copy of the library path current with changes to * the global copy. * * Results: * Returns a "list" (Tcl_Obj *) that contains the library path. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetLibraryPath(void) { return TclGetProcessGlobalValue(&libraryPath); } /* *---------------------------------------------------------------------- * * TclSetLibraryPath -- * * Keeps the per-thread copy of the library path current with changes to * the global copy. * * Since the result of this routine is void, if searchPath is not a valid * list this routine silently does nothing. * *---------------------------------------------------------------------- */ void TclSetLibraryPath( Tcl_Obj *path) { int dummy; if (TCL_ERROR == TclListObjLength(NULL, path, &dummy)) { return; } TclSetProcessGlobalValue(&libraryPath, path, NULL); } /* *--------------------------------------------------------------------------- * * FillEncodingFileMap -- * * Called to update the encoding file map with the current value * of the encoding search path. * * Finds *.end files in the directories on the encoding search path and * stores the found pathnames in a map associated with the encoding name. * * If $dir is on the encoding search path and the file $dir/foo.enc is * found, stores a "foo" -> $dir entry in the map. if the "foo" encoding * is needed later, the $dir/foo.enc name can be quickly constructed in * order to read the encoding data. * * Results: * None. * * Side effects: * Entries are added to the encoding file map. * *--------------------------------------------------------------------------- */ static void FillEncodingFileMap(void) { int i, numDirs = 0; Tcl_Obj *map, *searchPath; searchPath = Tcl_GetEncodingSearchPath(); Tcl_IncrRefCount(searchPath); TclListObjLength(NULL, searchPath, &numDirs); map = Tcl_NewDictObj(); Tcl_IncrRefCount(map); for (i = numDirs-1; i >= 0; i--) { /* * Iterate backwards through the search path so as we overwrite * entries found, we favor files earlier on the search path. */ int j, numFiles; Tcl_Obj *directory, *matchFileList; Tcl_Obj **filev; Tcl_GlobTypeData readableFiles = { TCL_GLOB_TYPE_FILE, TCL_GLOB_PERM_R, NULL, NULL }; TclNewObj(matchFileList); Tcl_ListObjIndex(NULL, searchPath, i, &directory); Tcl_IncrRefCount(directory); Tcl_IncrRefCount(matchFileList); Tcl_FSMatchInDirectory(NULL, matchFileList, directory, "*.enc", &readableFiles); TclListObjGetElements(NULL, matchFileList, &numFiles, &filev); for (j=0; jfallback = '?'; size = 256*(sizeof(unsigned short *) + sizeof(unsigned short)); dataPtr->toUnicode = (unsigned short **)ckalloc(size); memset(dataPtr->toUnicode, 0, size); dataPtr->fromUnicode = (unsigned short **)ckalloc(size); memset(dataPtr->fromUnicode, 0, size); dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256); dataPtr->fromUnicode[0] = (unsigned short *) (dataPtr->fromUnicode + 256); for (i=1 ; i<256 ; i++) { dataPtr->toUnicode[i] = emptyPage; dataPtr->fromUnicode[i] = emptyPage; } for (i=0 ; i<256 ; i++) { dataPtr->toUnicode[0][i] = i; dataPtr->fromUnicode[0][i] = i; } type.encodingName = "iso8859-1"; type.toUtfProc = Iso88591ToUtfProc; type.fromUtfProc = Iso88591FromUtfProc; type.freeProc = TableFreeProc; type.nullSize = 1; type.clientData = dataPtr; defaultEncoding = Tcl_CreateEncoding(&type); systemEncoding = Tcl_GetEncoding(NULL, type.encodingName); encodingsInitialized = 1; } /* *---------------------------------------------------------------------- * * TclFinalizeEncodingSubsystem -- * * Release the state associated with the encoding subsystem. * * Results: * None. * * Side effects: * Frees all of the encodings. * *---------------------------------------------------------------------- */ void TclFinalizeEncodingSubsystem(void) { Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_MutexLock(&encodingMutex); encodingsInitialized = 0; FreeEncoding(systemEncoding); systemEncoding = NULL; defaultEncoding = NULL; FreeEncoding(tclIdentityEncoding); tclIdentityEncoding = NULL; hPtr = Tcl_FirstHashEntry(&encodingTable, &search); while (hPtr != NULL) { /* * Call FreeEncoding instead of doing it directly to handle refcounts * like escape encodings use. [Bug 524674] Make sure to call * Tcl_FirstHashEntry repeatedly so that all encodings are eventually * cleaned up. */ FreeEncoding((Tcl_Encoding)Tcl_GetHashValue(hPtr)); hPtr = Tcl_FirstHashEntry(&encodingTable, &search); } Tcl_DeleteHashTable(&encodingTable); Tcl_MutexUnlock(&encodingMutex); } /* *------------------------------------------------------------------------- * * Tcl_GetDefaultEncodingDir -- * * Legacy public interface to retrieve first directory in the encoding * searchPath. * * Results: * The directory pathname, as a string, or NULL for an empty encoding * search path. * * Side effects: * None. * *------------------------------------------------------------------------- */ const char * Tcl_GetDefaultEncodingDir(void) { int numDirs; Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); TclListObjLength(NULL, searchPath, &numDirs); if (numDirs == 0) { return NULL; } Tcl_ListObjIndex(NULL, searchPath, 0, &first); return TclGetString(first); } /* *------------------------------------------------------------------------- * * Tcl_SetDefaultEncodingDir -- * * Legacy public interface to set the first directory in the encoding * search path. * * Results: * None. * * Side effects: * Modifies the encoding search path. * *------------------------------------------------------------------------- */ void Tcl_SetDefaultEncodingDir( const char *path) { Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath(); Tcl_Obj *directory = Tcl_NewStringObj(path, -1); searchPath = Tcl_DuplicateObj(searchPath); Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); Tcl_SetEncodingSearchPath(searchPath); } /* *------------------------------------------------------------------------- * * Tcl_GetEncoding -- * * Given the name of a encoding, find the corresponding Tcl_Encoding * token. If the encoding did not already exist, Tcl attempts to * dynamically load an encoding by that name. * * Results: * Returns a token that represents the encoding. If the name didn't refer * to any known or loadable encoding, NULL is returned. If NULL was * returned, an error message is left in interp's result object, unless * interp was NULL. * * Side effects: * LoadEncodingFile is called if necessary. * *------------------------------------------------------------------------- */ Tcl_Encoding Tcl_GetEncoding( Tcl_Interp *interp, /* Interp for error reporting, if not NULL. */ const char *name) /* The name of the desired encoding. */ { Tcl_HashEntry *hPtr; Encoding *encodingPtr; Tcl_MutexLock(&encodingMutex); if (name == NULL) { encodingPtr = (Encoding *) systemEncoding; encodingPtr->refCount++; Tcl_MutexUnlock(&encodingMutex); return systemEncoding; } hPtr = Tcl_FindHashEntry(&encodingTable, name); if (hPtr != NULL) { encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr); encodingPtr->refCount++; Tcl_MutexUnlock(&encodingMutex); return (Tcl_Encoding) encodingPtr; } Tcl_MutexUnlock(&encodingMutex); return LoadEncodingFile(interp, name); } /* *--------------------------------------------------------------------------- * * Tcl_FreeEncoding -- * * Releases an encoding allocated by Tcl_CreateEncoding() or * Tcl_GetEncoding(). * * Results: * None. * * Side effects: * The reference count associated with the encoding is decremented and * the encoding is deleted if nothing is using it anymore. * *--------------------------------------------------------------------------- */ void Tcl_FreeEncoding( Tcl_Encoding encoding) { Tcl_MutexLock(&encodingMutex); FreeEncoding(encoding); Tcl_MutexUnlock(&encodingMutex); } /* *---------------------------------------------------------------------- * * FreeEncoding -- * * Decrements the reference count of an encoding. The caller must hold * encodingMutes. * * Results: * None. * * Side effects: * Releases the resource for an encoding if it is now unused. * The reference count associated with the encoding is decremented and * the encoding may be deleted if nothing is using it anymore. * *---------------------------------------------------------------------- */ static void FreeEncoding( Tcl_Encoding encoding) { Encoding *encodingPtr = (Encoding *) encoding; if (encodingPtr == NULL) { return; } if (encodingPtr->refCount<=0) { Tcl_Panic("FreeEncoding: refcount problem !!!"); } if (encodingPtr->refCount-- <= 1) { if (encodingPtr->freeProc != NULL) { encodingPtr->freeProc(encodingPtr->clientData); } if (encodingPtr->hPtr != NULL) { Tcl_DeleteHashEntry(encodingPtr->hPtr); } if (encodingPtr->name) { ckfree(encodingPtr->name); } ckfree(encodingPtr); } } /* *------------------------------------------------------------------------- * * Tcl_GetEncodingName -- * * Given an encoding, return the name that was used to construct the * encoding. * * Results: * The name of the encoding. * * Side effects: * None. * *--------------------------------------------------------------------------- */ const char * Tcl_GetEncodingName( Tcl_Encoding encoding) /* The encoding whose name to fetch. */ { if (encoding == NULL) { encoding = systemEncoding; } return ((Encoding *) encoding)->name; } /* *------------------------------------------------------------------------- * * Tcl_GetEncodingNames -- * * Get the list of all known encodings, including the ones stored as * files on disk in the encoding path. * * Results: * Modifies interp's result object to hold a list of all the available * encodings. * * Side effects: * None. * *------------------------------------------------------------------------- */ void Tcl_GetEncodingNames( Tcl_Interp *interp) /* Interp to hold result. */ { Tcl_HashTable table; Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_Obj *map, *name, *result; Tcl_DictSearch mapSearch; int dummy, done = 0; TclNewObj(result); Tcl_InitObjHashTable(&table); /* * Copy encoding names from loaded encoding table to table. */ Tcl_MutexLock(&encodingMutex); for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Encoding *encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr); Tcl_CreateHashEntry(&table, Tcl_NewStringObj(encodingPtr->name, -1), &dummy); } Tcl_MutexUnlock(&encodingMutex); FillEncodingFileMap(); map = TclGetProcessGlobalValue(&encodingFileMap); /* * Copy encoding names from encoding file map to table. */ Tcl_DictObjFirst(NULL, map, &mapSearch, &name, NULL, &done); for (; !done; Tcl_DictObjNext(&mapSearch, &name, NULL, &done)) { Tcl_CreateHashEntry(&table, name, &dummy); } /* * Pull all encoding names from table into the result list. */ for (hPtr = Tcl_FirstHashEntry(&table, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_ListObjAppendElement(NULL, result, (Tcl_Obj *) Tcl_GetHashKey(&table, hPtr)); } Tcl_SetObjResult(interp, result); Tcl_DeleteHashTable(&table); } /* *------------------------------------------------------------------------ * * Tcl_SetSystemEncoding -- * * Sets the default encoding that should be used whenever the user passes * a NULL value in to one of the conversion routines. If the supplied * name is NULL, the system encoding is reset to the default system * encoding. * * Results: * The return value is TCL_OK if the system encoding was successfully set * to the encoding specified by name, TCL_ERROR otherwise. If TCL_ERROR * is returned, an error message is left in interp's result object, * unless interp was NULL. * * Side effects: * The reference count of the new system encoding is incremented. The * reference count of the old system encoding is decremented and it may * be freed. All VFS cached information is invalidated. * *------------------------------------------------------------------------ */ int Tcl_SetSystemEncoding( Tcl_Interp *interp, /* Interp for error reporting, if not NULL. */ const char *name) /* The name of the desired encoding, or NULL/"" * to reset to default encoding. */ { Tcl_Encoding encoding; Encoding *encodingPtr; if (!name || !*name) { Tcl_MutexLock(&encodingMutex); encoding = defaultEncoding; encodingPtr = (Encoding *) encoding; encodingPtr->refCount++; Tcl_MutexUnlock(&encodingMutex); } else { encoding = Tcl_GetEncoding(interp, name); if (encoding == NULL) { return TCL_ERROR; } } Tcl_MutexLock(&encodingMutex); FreeEncoding(systemEncoding); systemEncoding = encoding; Tcl_MutexUnlock(&encodingMutex); Tcl_FSMountsChanged(NULL); return TCL_OK; } /* *--------------------------------------------------------------------------- * * Tcl_CreateEncoding -- * * Defines a new encoding, along with the functions that are used to * convert to and from Unicode. * * Results: * Returns a token that represents the encoding. If an encoding with the * same name already existed, the old encoding token remains valid and * continues to behave as it used to, and is eventually garbage collected * when the last reference to it goes away. Any subsequent calls to * Tcl_GetEncoding with the specified name retrieve the most recent * encoding token. * * Side effects: * A new record having the name of the encoding is entered into a table of * encodings visible to all interpreters. For each call to this function, * there should eventually be a call to Tcl_FreeEncoding, which cleans * deletes the record in the table when an encoding is no longer needed. * *--------------------------------------------------------------------------- */ Tcl_Encoding Tcl_CreateEncoding( const Tcl_EncodingType *typePtr) /* The encoding type. */ { Tcl_HashEntry *hPtr; int isNew; Encoding *encodingPtr; char *name; Tcl_MutexLock(&encodingMutex); hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew); if (isNew == 0) { /* * Remove old encoding from hash table, but don't delete it until last * reference goes away. */ encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr); encodingPtr->hPtr = NULL; } name = (char *)ckalloc(strlen(typePtr->encodingName) + 1); encodingPtr = (Encoding *)ckalloc(sizeof(Encoding)); encodingPtr->name = strcpy(name, typePtr->encodingName); encodingPtr->toUtfProc = typePtr->toUtfProc; encodingPtr->fromUtfProc = typePtr->fromUtfProc; encodingPtr->freeProc = typePtr->freeProc; encodingPtr->nullSize = typePtr->nullSize; encodingPtr->clientData = typePtr->clientData; if (typePtr->nullSize == 1) { encodingPtr->lengthProc = (LengthProc *) strlen; } else { encodingPtr->lengthProc = (LengthProc *) unilen; } encodingPtr->refCount = 1; encodingPtr->hPtr = hPtr; Tcl_SetHashValue(hPtr, encodingPtr); Tcl_MutexUnlock(&encodingMutex); return (Tcl_Encoding) encodingPtr; } /* *------------------------------------------------------------------------- * * Tcl_ExternalToUtfDString -- * * Convert a source buffer from the specified encoding into UTF-8. If any * of the bytes in the source buffer are invalid or cannot be represented * in the target encoding, a default fallback character will be * substituted. * * Results: * The converted bytes are stored in the DString, which is then NULL * terminated. The return value is a pointer to the value stored in the * DString. * * Side effects: * None. * *------------------------------------------------------------------------- */ char * Tcl_ExternalToUtfDString( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes, or < 0 for * encoding-specific string length. */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; if (encoding == NULL) { encoding = systemEncoding; } encodingPtr = (Encoding *) encoding; if (src == NULL) { srcLen = 0; } else if (srcLen < 0) { srcLen = encodingPtr->lengthProc(src); } flags = TCL_ENCODING_START | TCL_ENCODING_END; while (1) { result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars); soFar = dst + dstWrote - Tcl_DStringValue(dstPtr); if (result != TCL_CONVERT_NOSPACE) { Tcl_DStringSetLength(dstPtr, soFar); return Tcl_DStringValue(dstPtr); } flags &= ~TCL_ENCODING_START; src += srcRead; srcLen -= srcRead; if (Tcl_DStringLength(dstPtr) == 0) { Tcl_DStringSetLength(dstPtr, dstLen); } Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1); dst = Tcl_DStringValue(dstPtr) + soFar; dstLen = Tcl_DStringLength(dstPtr) - soFar - 1; } } /* *------------------------------------------------------------------------- * * Tcl_ExternalToUtf -- * * Convert a source buffer from the specified encoding into UTF-8. * * Results: * The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE, * TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE, as * documented in tcl.h. * * Side effects: * The converted bytes are stored in the output buffer. * *------------------------------------------------------------------------- */ int Tcl_ExternalToUtf( Tcl_Interp *interp, /* Interp for error return, if not NULL. */ Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes, or < 0 for * encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const Encoding *encodingPtr; int result, srcRead, dstWrote, dstChars = 0; int noTerminate = flags & TCL_ENCODING_NO_TERMINATE; int charLimited = (flags & TCL_ENCODING_CHAR_LIMIT) && dstCharsPtr; int maxChars = INT_MAX; Tcl_EncodingState state; if (encoding == NULL) { encoding = systemEncoding; } encodingPtr = (Encoding *) encoding; if (src == NULL) { srcLen = 0; } else if (srcLen < 0) { srcLen = encodingPtr->lengthProc(src); } if (statePtr == NULL) { flags |= TCL_ENCODING_START | TCL_ENCODING_END; statePtr = &state; } if (srcReadPtr == NULL) { srcReadPtr = &srcRead; } if (dstWrotePtr == NULL) { dstWrotePtr = &dstWrote; } if (dstCharsPtr == NULL) { dstCharsPtr = &dstChars; flags &= ~TCL_ENCODING_CHAR_LIMIT; } else if (charLimited) { maxChars = *dstCharsPtr; } if (!noTerminate) { if (dstLen < 1) { return TCL_CONVERT_NOSPACE; } /* * If there are any null characters in the middle of the buffer, * they will converted to the UTF-8 null character (\xC080). To get * the actual \0 at the end of the destination buffer, we need to * append it manually. First make room for it... */ dstLen--; } else { if (dstLen < 0) { return TCL_CONVERT_NOSPACE; } } do { Tcl_EncodingState savedState = *statePtr; result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr); if (*dstCharsPtr <= maxChars) { break; } dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1); *statePtr = savedState; } while (1); if (!noTerminate) { /* ...and then append it */ dst[*dstWrotePtr] = '\0'; } return result; } /* *------------------------------------------------------------------------- * * Tcl_UtfToExternalDString -- * * Convert a source buffer from UTF-8 to the specified encoding. If any * of the bytes in the source buffer are invalid or cannot be represented * in the target encoding, a default fallback character is substituted. * * Results: * The converted bytes are stored in the DString, which is then NULL * terminated in an encoding-specific manner. The return value is a * pointer to the value stored in the DString. * * Side effects: * None. * *------------------------------------------------------------------------- */ char * Tcl_UtfToExternalDString( Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes, or < 0 for * strlen(). */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; if (encoding == NULL) { encoding = systemEncoding; } encodingPtr = (Encoding *) encoding; if (src == NULL) { srcLen = 0; } else if (srcLen < 0) { srcLen = strlen(src); } flags = TCL_ENCODING_START | TCL_ENCODING_END; while (1) { result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars); soFar = dst + dstWrote - Tcl_DStringValue(dstPtr); if (result != TCL_CONVERT_NOSPACE) { if (encodingPtr->nullSize == 2) { Tcl_DStringSetLength(dstPtr, soFar + 1); } Tcl_DStringSetLength(dstPtr, soFar); return Tcl_DStringValue(dstPtr); } flags &= ~TCL_ENCODING_START; src += srcRead; srcLen -= srcRead; if (Tcl_DStringLength(dstPtr) == 0) { Tcl_DStringSetLength(dstPtr, dstLen); } Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1); dst = Tcl_DStringValue(dstPtr) + soFar; dstLen = Tcl_DStringLength(dstPtr) - soFar - 1; } } /* *------------------------------------------------------------------------- * * Tcl_UtfToExternal -- * * Convert a buffer from UTF-8 into the specified encoding. * * Results: * The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE, * TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE, as * documented in tcl.h. * * Side effects: * The converted bytes are stored in the output buffer. * *------------------------------------------------------------------------- */ int Tcl_UtfToExternal( Tcl_Interp *interp, /* Interp for error return, if not NULL. */ Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes, or < 0 for * strlen(). */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string * is stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const Encoding *encodingPtr; int result, srcRead, dstWrote, dstChars; Tcl_EncodingState state; if (encoding == NULL) { encoding = systemEncoding; } encodingPtr = (Encoding *) encoding; if (src == NULL) { srcLen = 0; } else if (srcLen < 0) { srcLen = strlen(src); } if (statePtr == NULL) { flags |= TCL_ENCODING_START | TCL_ENCODING_END; statePtr = &state; } if (srcReadPtr == NULL) { srcReadPtr = &srcRead; } if (dstWrotePtr == NULL) { dstWrotePtr = &dstWrote; } if (dstCharsPtr == NULL) { dstCharsPtr = &dstChars; } if (dstLen < encodingPtr->nullSize) { return TCL_CONVERT_NOSPACE; } dstLen -= encodingPtr->nullSize; result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr); /* * Buffer is terminated irrespective of result. Not sure this is * reasonable but keep for historical/compatibility reasons. */ if (encodingPtr->nullSize == 2) { dst[*dstWrotePtr + 1] = '\0'; } dst[*dstWrotePtr] = '\0'; return result; } /* *--------------------------------------------------------------------------- * * Tcl_FindExecutable -- * * This function computes the absolute path name of the current * application, given its argv[0] value. * * Results: * None. * * Side effects: * The absolute pathname for the application is computed and stored to be * returned later by [info nameofexecutable]. * *--------------------------------------------------------------------------- */ #undef Tcl_FindExecutable void Tcl_FindExecutable( const char *argv0) /* The value of the application's argv[0] * (native). */ { TclInitSubsystems(); TclpSetInitialEncodings(); TclpFindExecutable(argv0); } /* *--------------------------------------------------------------------------- * * OpenEncodingFileChannel -- * * Open the file believed to hold data for the encoding, "name". * * Results: * Returns the readable Tcl_Channel from opening the file, or NULL if the * file could not be successfully opened. If NULL was returned, an error * message is left in interp's result object, unless interp was NULL. * * Side effects: * Channel may be opened. Information about the filesystem may be cached * to speed later calls. * *--------------------------------------------------------------------------- */ static Tcl_Channel OpenEncodingFileChannel( Tcl_Interp *interp, /* Interp for error reporting, if not NULL. */ const char *name) /* The name of the encoding file on disk and * also the name for new encoding. */ { Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1); Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj); Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath()); Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap); Tcl_Obj **dir, *path, *directory = NULL; Tcl_Channel chan = NULL; int i, numDirs; TclListObjGetElements(NULL, searchPath, &numDirs, &dir); Tcl_IncrRefCount(nameObj); Tcl_AppendToObj(fileNameObj, ".enc", -1); Tcl_IncrRefCount(fileNameObj); Tcl_DictObjGet(NULL, map, nameObj, &directory); /* * Check that any cached directory is still on the encoding search path. */ if (NULL != directory) { int verified = 0; for (i=0; i 256) { numPages = 256; } memset(used, 0, sizeof(used)); #undef PAGESIZE #define PAGESIZE (256 * sizeof(unsigned short)) dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData)); memset(dataPtr, 0, sizeof(TableEncodingData)); dataPtr->fallback = fallback; /* * Read the table that maps characters to Unicode. Performs a single * malloc to get the memory for the array and all the pages needed by the * array. */ size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE; dataPtr->toUnicode = (unsigned short **)ckalloc(size); memset(dataPtr->toUnicode, 0, size); pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); for (i = 0; i < numPages; i++) { int ch; const char *p; int expected = 3 + 16 * (16 * 4 + 1); if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) { return NULL; } p = TclGetString(objPtr); hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])]; dataPtr->toUnicode[hi] = pageMemPtr; p += 2; for (lo = 0; lo < 256; lo++) { if ((lo & 0x0F) == 0) { p++; } ch = (staticHex[UCHAR(p[0])] << 12) + (staticHex[UCHAR(p[1])] << 8) + (staticHex[UCHAR(p[2])] << 4) + staticHex[UCHAR(p[3])]; if (ch != 0) { used[ch >> 8] = 1; } *pageMemPtr = (unsigned short) ch; pageMemPtr++; p += 4; } } TclDecrRefCount(objPtr); if (type == ENCODING_DOUBLEBYTE) { memset(dataPtr->prefixBytes, 1, sizeof(dataPtr->prefixBytes)); } else { for (hi = 1; hi < 256; hi++) { if (dataPtr->toUnicode[hi] != NULL) { dataPtr->prefixBytes[hi] = 1; } } } /* * Invert the toUnicode array to produce the fromUnicode array. Performs a * single malloc to get the memory for the array and all the pages needed * by the array. While reading in the toUnicode array remember what * pages are needed for the fromUnicode array. */ if (symbol) { used[0] = 1; } numPages = 0; for (hi = 0; hi < 256; hi++) { if (used[hi]) { numPages++; } } size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE; dataPtr->fromUnicode = (unsigned short **)ckalloc(size); memset(dataPtr->fromUnicode, 0, size); pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256); for (hi = 0; hi < 256; hi++) { if (dataPtr->toUnicode[hi] == NULL) { dataPtr->toUnicode[hi] = emptyPage; continue; } for (lo = 0; lo < 256; lo++) { int ch = dataPtr->toUnicode[hi][lo]; if (ch != 0) { page = dataPtr->fromUnicode[ch >> 8]; if (page == NULL) { page = pageMemPtr; pageMemPtr += 256; dataPtr->fromUnicode[ch >> 8] = page; } page[ch & 0xFF] = (unsigned short) ((hi << 8) + lo); } } } if (type == ENCODING_MULTIBYTE) { /* * If multibyte encodings don't have a backslash character, define * one. Otherwise, on Windows, native file names don't work because * the backslash in the file name maps to the unknown character * (question mark) when converting from UTF-8 to external encoding. */ if (dataPtr->fromUnicode[0] != NULL) { if (dataPtr->fromUnicode[0]['\\'] == '\0') { dataPtr->fromUnicode[0]['\\'] = '\\'; } } } if (symbol) { /* * Make a special symbol encoding that maps each symbol character from * its Unicode code point down into page 0, and also ensure that each * characters on page 0 maps to itself so that a symbol font can be * used to display a simple string like "abcd" and have alpha, beta, * chi, delta show up, rather than have "unknown" chars show up because * strictly speaking the symbol font doesn't have glyphs for those low * ASCII chars. */ page = dataPtr->fromUnicode[0]; if (page == NULL) { page = pageMemPtr; dataPtr->fromUnicode[0] = page; } for (lo = 0; lo < 256; lo++) { if (dataPtr->toUnicode[0][lo] != 0) { page[lo] = (unsigned short) lo; } } } for (hi = 0; hi < 256; hi++) { if (dataPtr->fromUnicode[hi] == NULL) { dataPtr->fromUnicode[hi] = emptyPage; } } /* * For trailing 'R'everse encoding, see [Patch 689341] */ Tcl_DStringInit(&lineString); /* * Skip leading empty lines. */ while ((len = Tcl_Gets(chan, &lineString)) == 0) { /* empty body */ } if (len < 0) { goto doneParse; } /* * Require that it starts with an 'R'. */ line = Tcl_DStringValue(&lineString); if (line[0] != 'R') { goto doneParse; } /* * Read lines until EOF. */ for (TclDStringClear(&lineString); (len = Tcl_Gets(chan, &lineString)) >= 0; TclDStringClear(&lineString)) { const unsigned char *p; int to, from; /* * Skip short lines. */ if (len < 5) { continue; } /* * Parse the line as a sequence of hex digits. */ p = (const unsigned char *) Tcl_DStringValue(&lineString); to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8) + (staticHex[p[2]] << 4) + staticHex[p[3]]; if (to == 0) { continue; } for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) { from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8) + (staticHex[p[2]] << 4) + staticHex[p[3]]; if (from == 0) { continue; } dataPtr->fromUnicode[from >> 8][from & 0xFF] = to; } } doneParse: Tcl_DStringFree(&lineString); /* * Package everything into an encoding structure. */ encType.encodingName = name; encType.toUtfProc = TableToUtfProc; encType.fromUtfProc = TableFromUtfProc; encType.freeProc = TableFreeProc; encType.nullSize = (type == ENCODING_DOUBLEBYTE) ? 2 : 1; encType.clientData = dataPtr; return Tcl_CreateEncoding(&encType); } /* *------------------------------------------------------------------------- * * LoadEscapeEncoding -- * * Helper function for LoadEncodingTable(). Loads a state machine that * converts between Unicode and some other encoding. * * File contains text data that describes the escape sequences that are * used to choose an encoding and the associated names for the * sub-encodings. * * Results: * The return value is the new encoding, or NULL if the encoding could * not be created (because the file contained invalid data). * * Side effects: * None. * *------------------------------------------------------------------------- */ static Tcl_Encoding LoadEscapeEncoding( const char *name, /* Name of the new encoding. */ Tcl_Channel chan) /* File containing new encoding. */ { int i; unsigned size; Tcl_DString escapeData; char init[16], final[16]; EscapeEncodingData *dataPtr; Tcl_EncodingType type; init[0] = '\0'; final[0] = '\0'; Tcl_DStringInit(&escapeData); while (1) { int argc; const char **argv; char *line; Tcl_DString lineString; Tcl_DStringInit(&lineString); if (Tcl_Gets(chan, &lineString) < 0) { break; } line = Tcl_DStringValue(&lineString); if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) { Tcl_DStringFree(&lineString); continue; } if (argc >= 2) { if (strcmp(argv[0], "name") == 0) { /* do nothing */ } else if (strcmp(argv[0], "init") == 0) { strncpy(init, argv[1], sizeof(init)); init[sizeof(init) - 1] = '\0'; } else if (strcmp(argv[0], "final") == 0) { strncpy(final, argv[1], sizeof(final)); final[sizeof(final) - 1] = '\0'; } else { EscapeSubTable est; Encoding *e; strncpy(est.sequence, argv[1], sizeof(est.sequence)); est.sequence[sizeof(est.sequence) - 1] = '\0'; est.sequenceLen = strlen(est.sequence); strncpy(est.name, argv[0], sizeof(est.name)); est.name[sizeof(est.name) - 1] = '\0'; /* * To avoid infinite recursion in [encoding system iso2022-*] */ e = (Encoding *) Tcl_GetEncoding(NULL, est.name); if ((e != NULL) && (e->toUtfProc != TableToUtfProc) && (e->toUtfProc != Iso88591ToUtfProc)) { Tcl_FreeEncoding((Tcl_Encoding) e); e = NULL; } est.encodingPtr = e; Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est)); } } ckfree(argv); Tcl_DStringFree(&lineString); } size = TclOffset(EscapeEncodingData, subTables) + Tcl_DStringLength(&escapeData); dataPtr = (EscapeEncodingData *)ckalloc(size); dataPtr->initLen = strlen(init); memcpy(dataPtr->init, init, dataPtr->initLen + 1); dataPtr->finalLen = strlen(final); memcpy(dataPtr->final, final, dataPtr->finalLen + 1); dataPtr->numSubTables = Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable); memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData), Tcl_DStringLength(&escapeData)); Tcl_DStringFree(&escapeData); memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes)); for (i = 0; i < dataPtr->numSubTables; i++) { dataPtr->prefixBytes[UCHAR(dataPtr->subTables[i].sequence[0])] = 1; } if (dataPtr->init[0] != '\0') { dataPtr->prefixBytes[UCHAR(dataPtr->init[0])] = 1; } if (dataPtr->final[0] != '\0') { dataPtr->prefixBytes[UCHAR(dataPtr->final[0])] = 1; } /* * Package everything into an encoding structure. */ type.encodingName = name; type.toUtfProc = EscapeToUtfProc; type.fromUtfProc = EscapeFromUtfProc; type.freeProc = EscapeFreeProc; type.nullSize = 1; type.clientData = dataPtr; return Tcl_CreateEncoding(&type); } /* *------------------------------------------------------------------------- * * BinaryProc -- * * The default conversion when no other conversion is specified. No * translation is done; source bytes are copied directly to destination * bytes. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int BinaryProc( ClientData clientData, /* Not used. */ const char *src, /* Source string (unknown encoding). */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { int result; result = TCL_OK; dstLen -= TCL_UTF_MAX - 1; if (dstLen < 0) { dstLen = 0; } if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) { srcLen = *dstCharsPtr; } if (srcLen > dstLen) { srcLen = dstLen; result = TCL_CONVERT_NOSPACE; } *srcReadPtr = srcLen; *dstWrotePtr = srcLen; *dstCharsPtr = srcLen; memcpy(dst, src, srcLen); return result; } /* *------------------------------------------------------------------------- * * UtfIntToUtfExtProc -- * * Convert from UTF-8 to UTF-8. While converting null-bytes from the * Tcl's internal representation (0xC0, 0x80) to the official * representation (0x00). See UtfToUtfProc for details. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UtfIntToUtfExtProc( ClientData clientData, /* Not used. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string * is stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr, 1); } /* *------------------------------------------------------------------------- * * UtfExtToUtfIntProc -- * * Convert from UTF-8 to UTF-8 while converting null-bytes from the * official representation (0x00) to Tcl's internal representation (0xC0, * 0x80). See UtfToUtfProc for details. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UtfExtToUtfIntProc( ClientData clientData, /* Not used. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr, 0); } /* *------------------------------------------------------------------------- * * UtfToUtfProc -- * * Converts from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 translation * is not a no-op, because it turns a stream of improperly formed * UTF-8 into a properly-formed stream. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UtfToUtfProc( ClientData clientData, /* Not used. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr, /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ int pureNullMode) /* Convert embedded nulls from internal * representation to real null-bytes or vice * versa. Also combine or separate surrogate pairs */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int result, numChars, charLimit = INT_MAX; Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr; if (flags & TCL_ENCODING_START) { *statePtr = 0; } result = TCL_OK; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= 6; } if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } dstStart = dst; dstEnd = dst + dstLen - ((pureNullMode == 1) ? 4 : TCL_UTF_MAX); for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ result = TCL_CONVERT_MULTIBYTE; break; } if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } if (UCHAR(*src) < 0x80 && !((UCHAR(*src) == 0) && (pureNullMode == 0))) { /* * Copy 7bit characters, but skip null-bytes when we are in input * mode, so that they get converted to 0xC080. */ *dst++ = *src++; *chPtr = 0; /* reset surrogate handling */ } else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd) && (UCHAR(src[1]) == 0x80) && (pureNullMode == 1)) { /* * Convert 0xC080 to real nulls when we are in output mode. */ *dst++ = 0; *chPtr = 0; /* reset surrogate handling */ src += 2; } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) { /* * Always check before using TclUtfToUniChar. Not doing can so * cause it run beyond the end of the buffer! If we happen such an * incomplete char its bytes are made to represent themselves * unless the user has explicitly asked to be told. */ if ((flags & TCL_ENCODING_STOPONERROR) && (pureNullMode == 0)) { result = TCL_CONVERT_MULTIBYTE; break; } *chPtr = UCHAR(*src); src += 1; dst += Tcl_UniCharToUtf(*chPtr, dst); } else { size_t len = TclUtfToUniChar(src, chPtr); if ((len < 2) && (*chPtr != 0) && (flags & TCL_ENCODING_STOPONERROR) && ((*chPtr & ~0x7FF) != 0xD800) && (pureNullMode == 0)) { result = TCL_CONVERT_SYNTAX; break; } src += len; if ((*chPtr & ~0x7FF) == 0xD800) { Tcl_UniChar low; /* A surrogate character is detected, handle especially */ #if TCL_UTF_MAX <= 4 if ((len < 3) && ((src[3 - len] & 0xC0) != 0x80)) { /* It's invalid. See [ed29806ba] */ *chPtr = UCHAR(src[-1]); dst += Tcl_UniCharToUtf(*chPtr, dst); continue; } #endif low = *chPtr; len = (src <= srcEnd-3) ? Tcl_UtfToUniChar(src, &low) : 0; if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) { *dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF); *dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF); *dst++ = (char) ((*chPtr | 0x80) & 0xBF); *chPtr = 0; /* reset surrogate handling */ continue; } else if ((TCL_UTF_MAX > 3) || (pureNullMode == 1)) { int full = (((*chPtr & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000; *dst++ = (char) (((full >> 18) | 0xF0) & 0xF7); *dst++ = (char) (((full >> 12) | 0x80) & 0xBF); *dst++ = (char) (((full >> 6) | 0x80) & 0xBF); *dst++ = (char) ((full | 0x80) & 0xBF); *chPtr = 0; /* reset surrogate handling */ src += len; continue; } } dst += Tcl_UniCharToUtf(*chPtr, dst); } } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *------------------------------------------------------------------------- * * UnicodeToUtfProc -- * * Convert from UTF-16 to UTF-8. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UnicodeToUtfProc( ClientData clientData, /* != NULL means LE, == NUL means BE */ const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; int result, numChars, charLimit = INT_MAX; unsigned short ch; if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } result = TCL_OK; /* * Check alignment with utf-16 (2 == sizeof(UTF-16)) */ if ((srcLen % 2) != 0) { result = TCL_CONVERT_MULTIBYTE; srcLen--; } #if TCL_UTF_MAX > 3 /* * If last code point is a high surrogate, we cannot handle that yet, * unless we are at the end. */ if (!(flags & TCL_ENCODING_END) && (srcLen >= 2) && ((src[srcLen - (clientData?1:2)] & 0xFC) == 0xD8)) { result = TCL_CONVERT_MULTIBYTE; srcLen-= 2; } #endif srcStart = src; srcEnd = src + srcLen; dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } if (clientData) { ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF); } else { ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF); } /* * Special case for 1-byte utf chars for speed. Make sure we work with * unsigned short-size data. */ if (ch && ch < 0x80) { *dst++ = (ch & 0xFF); } else { dst += Tcl_UniCharToUtf(ch, dst); } src += sizeof(unsigned short); } if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) { /* We have a single byte left-over at the end */ if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; } else { /* destination is not full, so we really are at the end now */ result = TCL_OK; dst += Tcl_UniCharToUtf(0xFFFD, dst); numChars++; src++; } } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *------------------------------------------------------------------------- * * UtfToUnicodeProc -- * * Convert from UTF-8 to UTF-16. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UtfToUnicodeProc( ClientData clientData, /* != NULL means LE, == NUL means BE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr; if (flags & TCL_ENCODING_START) { *statePtr = 0; } srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } dstStart = dst; dstEnd = dst + dstLen - sizeof(Tcl_UniChar); result = TCL_OK; for (numChars = 0; src < srcEnd; numChars++) { if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ result = TCL_CONVERT_MULTIBYTE; break; } if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } src += TclUtfToUniChar(src, chPtr); if (clientData) { #if TCL_UTF_MAX > 4 if (*chPtr <= 0xFFFF) { *dst++ = (*chPtr & 0xFF); *dst++ = (*chPtr >> 8); } else { *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF); *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; *dst++ = (*chPtr & 0xFF); *dst++ = ((*chPtr >> 8) & 0x3) | 0xDC; } #else *dst++ = (*chPtr & 0xFF); *dst++ = (*chPtr >> 8); #endif } else { #if TCL_UTF_MAX > 4 if (*chPtr <= 0xFFFF) { *dst++ = (*chPtr >> 8); *dst++ = (*chPtr & 0xFF); } else { *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF); *dst++ = ((*chPtr >> 8) & 0x3) | 0xDC; *dst++ = (*chPtr & 0xFF); } #else *dst++ = (*chPtr >> 8); *dst++ = (*chPtr & 0xFF); #endif } } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *------------------------------------------------------------------------- * * TableToUtfProc -- * * Convert from the encoding specified by the TableEncodingData into * UTF-8. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int TableToUtfProc( ClientData clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd; const char *dstEnd, *dstStart, *prefixBytes; int result, byte, numChars, charLimit = INT_MAX; Tcl_UniChar ch = 0; const unsigned short *const *toUnicode; const unsigned short *pageZero; TableEncodingData *dataPtr = (TableEncodingData *)clientData; if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } srcStart = src; srcEnd = src + srcLen; dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; toUnicode = (const unsigned short *const *) dataPtr->toUnicode; prefixBytes = dataPtr->prefixBytes; pageZero = toUnicode[0]; result = TCL_OK; for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } byte = *((unsigned char *) src); if (prefixBytes[byte]) { if (src >= srcEnd-1) { /* Prefix byte but nothing after it */ if (!(flags & TCL_ENCODING_END)) { /* More data to come */ result = TCL_CONVERT_MULTIBYTE; break; } else if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_SYNTAX; break; } else { ch = (Tcl_UniChar)byte; } } else { ch = toUnicode[byte][*((unsigned char *)++src)]; } } else { ch = pageZero[byte]; } if ((ch == 0) && (byte != 0)) { /* Prefix+suffix pair is invalid */ if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_SYNTAX; break; } if (prefixBytes[byte]) { src--; } ch = (Tcl_UniChar)byte; } /* * Special case for 1-byte Utf chars for speed. */ if ((unsigned)ch - 1 < 0x7F) { *dst++ = (char) ch; } else { dst += Tcl_UniCharToUtf(ch, dst); } src++; } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *------------------------------------------------------------------------- * * TableFromUtfProc -- * * Convert from UTF-8 into the encoding specified by the * TableEncodingData. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int TableFromUtfProc( ClientData clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd, *prefixBytes; Tcl_UniChar ch = 0; int result, len, word, numChars; TableEncodingData *dataPtr = (TableEncodingData *)clientData; const unsigned short *const *fromUnicode; result = TCL_OK; prefixBytes = dataPtr->prefixBytes; fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } dstStart = dst; dstEnd = dst + dstLen - 1; for (numChars = 0; src < srcEnd; numChars++) { if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); #if TCL_UTF_MAX > 4 /* Unicode chars > +U0FFFF cannot be represented in any table encoding */ if (ch & 0xFFFF0000) { word = 0; } else #elif TCL_UTF_MAX == 4 if (!len) { word = 0; } else #endif word = fromUnicode[(ch >> 8)][ch & 0xFF]; if ((word == 0) && (ch != 0)) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } word = dataPtr->fallback; } if (prefixBytes[(word >> 8)] != 0) { if (dst + 1 > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } dst[0] = (char) (word >> 8); dst[1] = (char) word; dst += 2; } else { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } dst[0] = (char) word; dst++; } src += len; } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *------------------------------------------------------------------------- * * Iso88591ToUtfProc -- * * Convert from the "iso8859-1" encoding into UTF-8. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int Iso88591ToUtfProc( ClientData clientData, /* Ignored. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; int result, numChars, charLimit = INT_MAX; if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } srcStart = src; srcEnd = src + srcLen; dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; result = TCL_OK; for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { Tcl_UniChar ch = 0; if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } ch = (Tcl_UniChar) *((unsigned char *) src); /* * Special case for 1-byte utf chars for speed. */ if ((unsigned)ch - 1 < 0x7F) { *dst++ = (char) ch; } else { dst += Tcl_UniCharToUtf(ch, dst); } src++; } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *------------------------------------------------------------------------- * * Iso88591FromUtfProc -- * * Convert from UTF-8 into the encoding "iso8859-1". * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int Iso88591FromUtfProc( ClientData clientData, /* Ignored. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int result = TCL_OK, numChars; Tcl_UniChar ch = 0; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } dstStart = dst; dstEnd = dst + dstLen - 1; for (numChars = 0; src < srcEnd; numChars++) { int len; if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); /* * Check for illegal characters. */ if (ch > 0xFF #if TCL_UTF_MAX == 4 || ((ch >= 0xD800) && (len < 3)) #endif ) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } #if TCL_UTF_MAX == 4 if ((ch >= 0xD800) && (len < 3)) { len = 4; } #endif /* * Plunge on, using '?' as a fallback character. */ ch = (Tcl_UniChar) '?'; } if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } *(dst++) = (char) ch; src += len; } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *--------------------------------------------------------------------------- * * TableFreeProc -- * * This function is invoked when an encoding is deleted. It deletes the * memory used by the TableEncodingData. * * Results: * None. * * Side effects: * Memory freed. * *--------------------------------------------------------------------------- */ static void TableFreeProc( ClientData clientData) /* TableEncodingData that specifies * encoding. */ { TableEncodingData *dataPtr = (TableEncodingData *) clientData; /* * Make sure we aren't freeing twice on shutdown. [Bug 219314] */ ckfree(dataPtr->toUnicode); dataPtr->toUnicode = NULL; ckfree(dataPtr->fromUnicode); dataPtr->fromUnicode = NULL; ckfree(dataPtr); } /* *------------------------------------------------------------------------- * * EscapeToUtfProc -- * * Convert from the encoding specified by the EscapeEncodingData into * UTF-8. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int EscapeToUtfProc( ClientData clientData, /* EscapeEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { EscapeEncodingData *dataPtr = (EscapeEncodingData *) clientData; const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd; const unsigned short *const *tableToUnicode; const Encoding *encodingPtr; int state, result, numChars, charLimit = INT_MAX; const char *dstStart, *dstEnd; if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } result = TCL_OK; tablePrefixBytes = NULL; tableToUnicode = NULL; prefixBytes = dataPtr->prefixBytes; encodingPtr = NULL; srcStart = src; srcEnd = src + srcLen; dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; state = PTR2INT(*statePtr); if (flags & TCL_ENCODING_START) { state = 0; } for (numChars = 0; src < srcEnd && numChars <= charLimit; ) { int byte, hi, lo, ch; if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } byte = *((unsigned char *) src); if (prefixBytes[byte]) { unsigned left, len, longest; int checked, i; const EscapeSubTable *subTablePtr; /* * Saw the beginning of an escape sequence. */ left = srcEnd - src; len = dataPtr->initLen; longest = len; checked = 0; if (len <= left) { checked++; if ((len > 0) && (memcmp(src, dataPtr->init, len) == 0)) { /* * If we see initialization string, skip it, even if we're * not at the beginning of the buffer. */ src += len; continue; } } len = dataPtr->finalLen; if (len > longest) { longest = len; } if (len <= left) { checked++; if ((len > 0) && (memcmp(src, dataPtr->final, len) == 0)) { /* * If we see finalization string, skip it, even if we're * not at the end of the buffer. */ src += len; continue; } } subTablePtr = dataPtr->subTables; for (i = 0; i < dataPtr->numSubTables; i++) { len = subTablePtr->sequenceLen; if (len > longest) { longest = len; } if (len <= left) { checked++; if ((len > 0) && (memcmp(src, subTablePtr->sequence, len) == 0)) { state = i; encodingPtr = NULL; subTablePtr = NULL; src += len; break; } } subTablePtr++; } if (subTablePtr == NULL) { /* * A match was found, the escape sequence was consumed, and * the state was updated. */ continue; } /* * We have a split-up or unrecognized escape sequence. If we * checked all the sequences, then it's a syntax error, otherwise * we need more bytes to determine a match. */ if ((checked == dataPtr->numSubTables + 2) || (flags & TCL_ENCODING_END)) { if ((flags & TCL_ENCODING_STOPONERROR) == 0) { /* * Skip the unknown escape sequence. */ src += longest; continue; } result = TCL_CONVERT_SYNTAX; } else { result = TCL_CONVERT_MULTIBYTE; } break; } if (encodingPtr == NULL) { TableEncodingData *tableDataPtr; encodingPtr = GetTableEncoding(dataPtr, state); tableDataPtr = (TableEncodingData *)encodingPtr->clientData; tablePrefixBytes = tableDataPtr->prefixBytes; tableToUnicode = (const unsigned short *const*) tableDataPtr->toUnicode; } if (tablePrefixBytes[byte]) { src++; if (src >= srcEnd) { src--; result = TCL_CONVERT_MULTIBYTE; break; } hi = byte; lo = *((unsigned char *) src); } else { hi = 0; lo = byte; } ch = tableToUnicode[hi][lo]; dst += Tcl_UniCharToUtf(ch, dst); src++; numChars++; } *statePtr = (Tcl_EncodingState) INT2PTR(state); *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *------------------------------------------------------------------------- * * EscapeFromUtfProc -- * * Convert from UTF-8 into the encoding specified by the * EscapeEncodingData. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int EscapeFromUtfProc( ClientData clientData, /* EscapeEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData; const Encoding *encodingPtr; const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int state, result, numChars; const TableEncodingData *tableDataPtr; const char *tablePrefixBytes; const unsigned short *const *tableFromUnicode; Tcl_UniChar ch = 0; result = TCL_OK; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } dstStart = dst; dstEnd = dst + dstLen - 1; /* * RFC 1468 states that the text starts in ASCII, and switches to Japanese * characters, and that the text must end in ASCII. [Patch 474358] */ if (flags & TCL_ENCODING_START) { state = 0; if ((dst + dataPtr->initLen) > dstEnd) { *srcReadPtr = 0; *dstWrotePtr = 0; return TCL_CONVERT_NOSPACE; } memcpy(dst, dataPtr->init, dataPtr->initLen); dst += dataPtr->initLen; } else { state = PTR2INT(*statePtr); } encodingPtr = GetTableEncoding(dataPtr, state); tableDataPtr = (const TableEncodingData *)encodingPtr->clientData; tablePrefixBytes = tableDataPtr->prefixBytes; tableFromUnicode = (const unsigned short *const *) tableDataPtr->fromUnicode; for (numChars = 0; src < srcEnd; numChars++) { unsigned len; int word; if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); word = tableFromUnicode[(ch >> 8)][ch & 0xFF]; if ((word == 0) && (ch != 0)) { int oldState; const EscapeSubTable *subTablePtr; oldState = state; for (state = 0; state < dataPtr->numSubTables; state++) { encodingPtr = GetTableEncoding(dataPtr, state); tableDataPtr = (const TableEncodingData *)encodingPtr->clientData; word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xFF]; if (word != 0) { break; } } if (word == 0) { state = oldState; if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } encodingPtr = GetTableEncoding(dataPtr, state); tableDataPtr = (const TableEncodingData *)encodingPtr->clientData; word = tableDataPtr->fallback; } tablePrefixBytes = (const char *) tableDataPtr->prefixBytes; tableFromUnicode = (const unsigned short *const *) tableDataPtr->fromUnicode; /* * The state variable has the value of oldState when word is 0. * In this case, the escape sequence should not be copied to dst * because the current character set is not changed. */ if (state != oldState) { subTablePtr = &dataPtr->subTables[state]; if ((dst + subTablePtr->sequenceLen) > dstEnd) { /* * If there is no space to write the escape sequence, the * state variable must be changed to the value of oldState * variable because this escape sequence must be written * in the next conversion. */ state = oldState; result = TCL_CONVERT_NOSPACE; break; } memcpy(dst, subTablePtr->sequence, subTablePtr->sequenceLen); dst += subTablePtr->sequenceLen; } } if (tablePrefixBytes[(word >> 8)] != 0) { if (dst + 1 > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } dst[0] = (char) (word >> 8); dst[1] = (char) word; dst += 2; } else { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } dst[0] = (char) word; dst++; } src += len; } if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) { unsigned len = dataPtr->subTables[0].sequenceLen; /* * Certain encodings like iso2022-jp need to write an escape sequence * after all characters have been converted. This logic checks that * enough room is available in the buffer for the escape bytes. The * TCL_ENCODING_END flag is cleared after a final escape sequence has * been added to the buffer so that another call to this method does * not attempt to append escape bytes a second time. */ if ((dst + dataPtr->finalLen + (state?len:0)) > dstEnd) { result = TCL_CONVERT_NOSPACE; } else { if (state) { memcpy(dst, dataPtr->subTables[0].sequence, len); dst += len; } memcpy(dst, dataPtr->final, dataPtr->finalLen); dst += dataPtr->finalLen; state &= ~TCL_ENCODING_END; } } *statePtr = (Tcl_EncodingState) INT2PTR(state); *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *--------------------------------------------------------------------------- * * EscapeFreeProc -- * * Frees resources used by the encoding. * * Results: * None. * * Side effects: * Memory is freed. * *--------------------------------------------------------------------------- */ static void EscapeFreeProc( ClientData clientData) /* EscapeEncodingData that specifies * encoding. */ { EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData; EscapeSubTable *subTablePtr; int i; if (dataPtr == NULL) { return; } /* * The subTables should be freed recursively in normal operation but not * during TclFinalizeEncodingSubsystem because they are also present as a * weak reference in the toplevel encodingTable (i.e., they don't have a * +1 refcount for this), and unpredictable nuking order could remove them * from under the following loop's feet. [Bug 2891556] * * The encodingsInitialized flag, being reset on entry to TFES, can serve * as a "not in finalization" test. */ if (encodingsInitialized) { subTablePtr = dataPtr->subTables; for (i = 0; i < dataPtr->numSubTables; i++) { FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr); subTablePtr->encodingPtr = NULL; subTablePtr++; } } ckfree(dataPtr); } /* *--------------------------------------------------------------------------- * * GetTableEncoding -- * * Helper function for the EscapeEncodingData conversions. Gets the * encoding (of type TextEncodingData) that represents the specified * state. * * Results: * The return value is the encoding. * * Side effects: * If the encoding that represents the specified state has not already * been used by this EscapeEncoding, it will be loaded and cached in the * dataPtr. * *--------------------------------------------------------------------------- */ static Encoding * GetTableEncoding( EscapeEncodingData *dataPtr,/* Contains names of encodings. */ int state) /* Index in dataPtr of desired Encoding. */ { EscapeSubTable *subTablePtr = &dataPtr->subTables[state]; Encoding *encodingPtr = subTablePtr->encodingPtr; if (encodingPtr == NULL) { encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name); if ((encodingPtr == NULL) || (encodingPtr->toUtfProc != TableToUtfProc && encodingPtr->toUtfProc != Iso88591ToUtfProc)) { Tcl_Panic("EscapeToUtfProc: invalid sub table"); } subTablePtr->encodingPtr = encodingPtr; } return encodingPtr; } /* *--------------------------------------------------------------------------- * * unilen -- * * A helper function for the Tcl_ExternalToUtf functions. This function * is similar to strlen for double-byte characters: it returns the number * of bytes in a 0x0000 terminated string. * * Results: * As above. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static size_t unilen( const char *src) { unsigned short *p; p = (unsigned short *) src; while (*p != 0x0000) { p++; } return (char *) p - src; } /* *------------------------------------------------------------------------- * * InitializeEncodingSearchPath -- * * This is the fallback routine that sets the default value of the * encoding search path if the application has not set one via a call to * Tcl_SetEncodingSearchPath() by the first time the search path is needed * to load encoding data. * * The default encoding search path is produced by taking each directory * in the library path, appending a subdirectory named "encoding", and if * the resulting directory exists, adding it to the encoding search path. * * Results: * None. * * Side effects: * Sets the encoding search path to an initial value. * *------------------------------------------------------------------------- */ static void InitializeEncodingSearchPath( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; int i, numDirs, numBytes; Tcl_Obj *libPathObj, *encodingObj, *searchPathObj; TclNewLiteralStringObj(encodingObj, "encoding"); TclNewObj(searchPathObj); Tcl_IncrRefCount(encodingObj); Tcl_IncrRefCount(searchPathObj); libPathObj = TclGetLibraryPath(); Tcl_IncrRefCount(libPathObj); TclListObjLength(NULL, libPathObj, &numDirs); for (i = 0; i < numDirs; i++) { Tcl_Obj *directoryObj, *pathObj; Tcl_StatBuf stat; Tcl_ListObjIndex(NULL, libPathObj, i, &directoryObj); pathObj = Tcl_FSJoinToPath(directoryObj, 1, &encodingObj); Tcl_IncrRefCount(pathObj); if ((0 == Tcl_FSStat(pathObj, &stat)) && S_ISDIR(stat.st_mode)) { Tcl_ListObjAppendElement(NULL, searchPathObj, pathObj); } Tcl_DecrRefCount(pathObj); } Tcl_DecrRefCount(libPathObj); Tcl_DecrRefCount(encodingObj); *encodingPtr = libraryPath.encoding; if (*encodingPtr) { ((Encoding *)(*encodingPtr))->refCount++; } bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes); *lengthPtr = numBytes; *valuePtr = (char *)ckalloc(numBytes + 1); memcpy(*valuePtr, bytes, numBytes + 1); Tcl_DecrRefCount(searchPathObj); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclEnsemble.c0000644000175000017500000032237414554262142015672 0ustar sergeisergei/* * tclEnsemble.c -- * * Contains support for ensembles (see TIP#112), which provide simple * mechanism for creating composite commands on top of namespaces. * * Copyright (c) 2005-2013 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" /* * Declarations for functions local to this file: */ static inline Tcl_Obj * NewNsObj(Tcl_Namespace *namespacePtr); static inline int EnsembleUnknownCallback(Tcl_Interp *interp, EnsembleConfig *ensemblePtr, int objc, Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr); static int NsEnsembleImplementationCmd(ClientData clientData, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NsEnsembleImplementationCmdNR(ClientData clientData, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr); static int NsEnsembleStringOrder(const void *strPtr1, const void *strPtr2); static void DeleteEnsembleConfig(ClientData clientData); static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, Tcl_Obj *fix); static void FreeEnsembleCmdRep(Tcl_Obj *objPtr); static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void CompileToInvokedCommand(Tcl_Interp *interp, Tcl_Parse *parsePtr, Tcl_Obj *replacements, Command *cmdPtr, CompileEnv *envPtr); static int CompileBasicNArgCommand(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr); static Tcl_NRPostProc FreeER; /* * The lists of subcommands and options for the [namespace ensemble] command. */ static const char *const ensembleSubcommands[] = { "configure", "create", "exists", NULL }; enum EnsSubcmds { ENS_CONFIG, ENS_CREATE, ENS_EXISTS }; static const char *const ensembleCreateOptions[] = { "-command", "-map", "-parameters", "-prefixes", "-subcommands", "-unknown", NULL }; enum EnsCreateOpts { CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN }; static const char *const ensembleConfigOptions[] = { "-map", "-namespace", "-parameters", "-prefixes", "-subcommands", "-unknown", NULL }; enum EnsConfigOpts { CONF_MAP, CONF_NAMESPACE, CONF_PARAM, CONF_PREFIX, CONF_SUBCMDS, CONF_UNKNOWN }; /* * This structure defines a Tcl object type that contains a reference to an * ensemble subcommand (e.g. the "length" in [string length ab]). It is used * to cache the mapping between the subcommand itself and the real command * that implements it. */ static const Tcl_ObjType ensembleCmdType = { "ensembleCommand", /* the type's name */ FreeEnsembleCmdRep, /* freeIntRepProc */ DupEnsembleCmdRep, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL /* setFromAnyProc */ }; /* * The internal rep for caching ensemble subcommand lookups and * spell corrections. */ typedef struct { int epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ Command *token; /* Reference to the command for which this * structure is a cache of the resolution. */ Tcl_Obj *fix; /* Corrected spelling, if needed. */ Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand * hash table. */ } EnsembleCmdRep; static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) { Namespace *nsPtr = (Namespace *) namespacePtr; if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { return Tcl_NewStringObj("::", 2); } else { return Tcl_NewStringObj(nsPtr->fullName, -1); } } /* *---------------------------------------------------------------------- * * TclNamespaceEnsembleCmd -- * * Invoked to implement the "namespace ensemble" command that creates and * manipulates ensembles built on top of namespaces. Handles the * following syntax: * * namespace ensemble name ?dictionary? * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Creates the ensemble for the namespace if one did not previously * exist. Alternatively, alters the way that the ensemble's subcommand => * implementation prefix is configured. * *---------------------------------------------------------------------- */ int TclNamespaceEnsembleCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Namespace *namespacePtr; Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr, *foundNsPtr, *altFoundNsPtr, *actualCxtPtr; Tcl_Command token; Tcl_DictSearch search; Tcl_Obj *listObj; const char *simpleName; int index, done; if (nsPtr == NULL || nsPtr->flags & NS_DYING) { if (!Tcl_InterpDeleted(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "tried to manipulate ensemble of deleted namespace", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL); } return TCL_ERROR; } if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands, "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum EnsSubcmds) index) { case ENS_CREATE: { const char *name; int len, allocatedMapFlag = 0; /* * Defaults */ Tcl_Obj *subcmdObj = NULL; Tcl_Obj *mapObj = NULL; int permitPrefix = 1; Tcl_Obj *unknownObj = NULL; Tcl_Obj *paramObj = NULL; /* * Check that we've got option-value pairs... [Bug 1558654] */ if (objc & 1) { Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?"); return TCL_ERROR; } objv += 2; objc -= 2; name = nsPtr->name; cxtPtr = (Namespace *) nsPtr->parentPtr; /* * Parse the option list, applying type checks as we go. Note that we * are not incrementing any reference counts in the objects at this * stage, so the presence of an option multiple times won't cause any * memory leaks. */ for (; objc>1 ; objc-=2,objv+=2) { if (Tcl_GetIndexFromObj(interp, objv[0], ensembleCreateOptions, "option", 0, &index) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } switch ((enum EnsCreateOpts) index) { case CRT_CMD: name = TclGetString(objv[1]); cxtPtr = nsPtr; continue; case CRT_SUBCMDS: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } subcmdObj = (len > 0 ? objv[1] : NULL); continue; case CRT_PARAM: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } paramObj = (len > 0 ? objv[1] : NULL); continue; case CRT_MAP: { Tcl_Obj *patchedDict = NULL, *subcmdWordsObj; /* * Verify that the map is sensible. */ if (Tcl_DictObjFirst(interp, objv[1], &search, &subcmdWordsObj, &listObj, &done) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } if (done) { mapObj = NULL; continue; } do { Tcl_Obj **listv; const char *cmd; if (TclListObjGetElements(interp, listObj, &len, &listv) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); } if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " "must be non-empty lists", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "EMPTY_TARGET", NULL); Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); } if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } cmd = TclGetString(listv[0]); if (!(cmd[0] == ':' && cmd[1] == ':')) { Tcl_Obj *newList = Tcl_NewListObj(len, listv); Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace *) nsPtr); if (nsPtr->parentPtr) { Tcl_AppendStringsToObj(newCmd, "::", NULL); } Tcl_AppendObjToObj(newCmd, listv[0]); Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd); if (patchedDict == NULL) { patchedDict = Tcl_DuplicateObj(objv[1]); } Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj, newList); } Tcl_DictObjNext(&search, &subcmdWordsObj,&listObj, &done); } while (!done); if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } mapObj = (patchedDict ? patchedDict : objv[1]); if (patchedDict) { allocatedMapFlag = 1; } continue; } case CRT_PREFIX: if (Tcl_GetBooleanFromObj(interp, objv[1], &permitPrefix) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } continue; case CRT_UNKNOWN: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } unknownObj = (len > 0 ? objv[1] : NULL); continue; } } TclGetNamespaceForQualName(interp, name, cxtPtr, TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr, &simpleName); /* * Create the ensemble. Note that this might delete another ensemble * linked to the same namespace, so we must be careful. However, we * should be OK because we only link the namespace into the list once * we've created it (and after any deletions have occurred.) */ token = TclCreateEnsembleInNs(interp, simpleName, (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0)); Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj); Tcl_SetEnsembleMappingDict(interp, token, mapObj); Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj); Tcl_SetEnsembleParameterList(interp, token, paramObj); /* * Tricky! Must ensure that the result is not shared (command delete * traces could have corrupted the pristine object that we started * with). [Snit test rename-1.5] */ Tcl_ResetResult(interp); Tcl_GetCommandFullName(interp, token, Tcl_GetObjResult(interp)); return TCL_OK; } case ENS_EXISTS: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "cmdname"); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj( Tcl_FindEnsemble(interp, objv[2], 0) != NULL)); return TCL_OK; case ENS_CONFIG: if (objc < 3 || (objc != 4 && !(objc & 1))) { Tcl_WrongNumArgs(interp, 2, objv, "cmdname ?-option value ...? ?arg ...?"); return TCL_ERROR; } token = Tcl_FindEnsemble(interp, objv[2], TCL_LEAVE_ERR_MSG); if (token == NULL) { return TCL_ERROR; } if (objc == 4) { Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */ if (Tcl_GetIndexFromObj(interp, objv[3], ensembleConfigOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum EnsConfigOpts) index) { case CONF_SUBCMDS: Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj); if (resultObj != NULL) { Tcl_SetObjResult(interp, resultObj); } break; case CONF_PARAM: Tcl_GetEnsembleParameterList(NULL, token, &resultObj); if (resultObj != NULL) { Tcl_SetObjResult(interp, resultObj); } break; case CONF_MAP: Tcl_GetEnsembleMappingDict(NULL, token, &resultObj); if (resultObj != NULL) { Tcl_SetObjResult(interp, resultObj); } break; case CONF_NAMESPACE: namespacePtr = NULL; /* silence gcc 4 warning */ Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr); Tcl_SetObjResult(interp, NewNsObj(namespacePtr)); break; case CONF_PREFIX: { int flags = 0; /* silence gcc 4 warning */ Tcl_GetEnsembleFlags(NULL, token, &flags); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX)); break; } case CONF_UNKNOWN: Tcl_GetEnsembleUnknownHandler(NULL, token, &resultObj); if (resultObj != NULL) { Tcl_SetObjResult(interp, resultObj); } break; } } else if (objc == 3) { /* * Produce list of all information. */ Tcl_Obj *resultObj, *tmpObj = NULL; /* silence gcc 4 warning */ int flags = 0; /* silence gcc 4 warning */ TclNewObj(resultObj); /* -map option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_MAP], -1)); Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); /* -namespace option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_NAMESPACE], -1)); namespacePtr = NULL; /* silence gcc 4 warning */ Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr); Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr)); /* -parameters option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], -1)); Tcl_GetEnsembleParameterList(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); /* -prefix option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_PREFIX], -1)); Tcl_GetEnsembleFlags(NULL, token, &flags); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX)); /* -subcommands option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_SUBCMDS],-1)); Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); /* -unknown option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1)); Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); Tcl_SetObjResult(interp, resultObj); } else { int len, allocatedMapFlag = 0; Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL, *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */ int permitPrefix, flags = 0; /* silence gcc 4 warning */ Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj); Tcl_GetEnsembleMappingDict(NULL, token, &mapObj); Tcl_GetEnsembleParameterList(NULL, token, ¶mObj); Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj); Tcl_GetEnsembleFlags(NULL, token, &flags); permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0; objv += 3; objc -= 3; /* * Parse the option list, applying type checks as we go. Note that * we are not incrementing any reference counts in the objects at * this stage, so the presence of an option multiple times won't * cause any memory leaks. */ for (; objc>0 ; objc-=2,objv+=2) { if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions, "option", 0, &index) != TCL_OK) { freeMapAndError: if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } switch ((enum EnsConfigOpts) index) { case CONF_SUBCMDS: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } subcmdObj = (len > 0 ? objv[1] : NULL); continue; case CONF_PARAM: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } paramObj = (len > 0 ? objv[1] : NULL); continue; case CONF_MAP: { Tcl_Obj *patchedDict = NULL, *subcmdWordsObj, **listv; const char *cmd; /* * Verify that the map is sensible. */ if (Tcl_DictObjFirst(interp, objv[1], &search, &subcmdWordsObj, &listObj, &done) != TCL_OK) { goto freeMapAndError; } if (done) { mapObj = NULL; continue; } do { if (TclListObjGetElements(interp, listObj, &len, &listv) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); } goto freeMapAndError; } if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " "must be non-empty lists", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "EMPTY_TARGET", NULL); Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); } goto freeMapAndError; } cmd = TclGetString(listv[0]); if (!(cmd[0] == ':' && cmd[1] == ':')) { Tcl_Obj *newList = Tcl_DuplicateObj(listObj); Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr); if (nsPtr->parentPtr) { Tcl_AppendStringsToObj(newCmd, "::", NULL); } Tcl_AppendObjToObj(newCmd, listv[0]); Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd); if (patchedDict == NULL) { patchedDict = Tcl_DuplicateObj(objv[1]); } Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj, newList); } Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj, &done); } while (!done); if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } mapObj = (patchedDict ? patchedDict : objv[1]); if (patchedDict) { allocatedMapFlag = 1; } continue; } case CONF_NAMESPACE: Tcl_SetObjResult(interp, Tcl_NewStringObj( "option -namespace is read-only", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY", NULL); goto freeMapAndError; case CONF_PREFIX: if (Tcl_GetBooleanFromObj(interp, objv[1], &permitPrefix) != TCL_OK) { goto freeMapAndError; } continue; case CONF_UNKNOWN: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } unknownObj = (len > 0 ? objv[1] : NULL); continue; } } /* * Update the namespace now that we've finished the parsing stage. */ flags = (permitPrefix ? flags|TCL_ENSEMBLE_PREFIX : flags&~TCL_ENSEMBLE_PREFIX); Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj); Tcl_SetEnsembleMappingDict(interp, token, mapObj); Tcl_SetEnsembleParameterList(interp, token, paramObj); Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj); Tcl_SetEnsembleFlags(interp, token, flags); } return TCL_OK; default: Tcl_Panic("unexpected ensemble command"); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCreateEnsembleInNs -- * * Like Tcl_CreateEnsemble, but additionally accepts as an argument the * name of the namespace to create the command in. * *---------------------------------------------------------------------- */ Tcl_Command TclCreateEnsembleInNs( Tcl_Interp *interp, const char *name, /* Simple name of command to create (no */ /* namespace components). */ Tcl_Namespace /* Name of namespace to create the command in. */ *nameNsPtr, Tcl_Namespace *ensembleNsPtr, /* Name of the namespace for the ensemble. */ int flags ) { Namespace *nsPtr = (Namespace *) ensembleNsPtr; EnsembleConfig *ensemblePtr; Tcl_Command token; ensemblePtr = (EnsembleConfig *)ckalloc(sizeof(EnsembleConfig)); token = TclNRCreateCommandInNs(interp, name, (Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig); if (token == NULL) { ckfree(ensemblePtr); return NULL; } ensemblePtr->nsPtr = nsPtr; ensemblePtr->epoch = 0; Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS); ensemblePtr->subcommandArrayPtr = NULL; ensemblePtr->subcmdList = NULL; ensemblePtr->subcommandDict = NULL; ensemblePtr->flags = flags; ensemblePtr->numParameters = 0; ensemblePtr->parameterList = NULL; ensemblePtr->unknownHandler = NULL; ensemblePtr->token = token; ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles; nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr; /* * Trigger an eventual recomputation of the ensemble command set. Note * that this is slightly tricky, as it means that we are not actually * counting the number of namespace export actions, but it is the simplest * way to go! */ nsPtr->exportLookupEpoch++; if (flags & ENSEMBLE_COMPILE) { ((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble; } return ensemblePtr->token; } /* *---------------------------------------------------------------------- * * Tcl_CreateEnsemble * * Create a simple ensemble attached to the given namespace. * * Deprecated by TclCreateEnsembleInNs. * * Value * * The token for the command created. * * Effect * The ensemble is created and marked for compilation. * * *---------------------------------------------------------------------- */ Tcl_Command Tcl_CreateEnsemble( Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags) { Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr, *actualNsPtr; const char * simpleName; if (nsPtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName); return TclCreateEnsembleInNs(interp, simpleName, (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags); } /* *---------------------------------------------------------------------- * * Tcl_SetEnsembleSubcommandList -- * * Set the subcommand list for a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an ensemble * or the subcommand list - if non-NULL - is not a list). * * Side effects: * The ensemble is updated and marked for recompilation. * *---------------------------------------------------------------------- */ int Tcl_SetEnsembleSubcommandList( Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (subcmdList != NULL) { int length; if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { subcmdList = NULL; } } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; oldList = ensemblePtr->subcmdList; ensemblePtr->subcmdList = subcmdList; if (subcmdList != NULL) { Tcl_IncrRefCount(subcmdList); } if (oldList != NULL) { TclDecrRefCount(oldList); } /* * Trigger an eventual recomputation of the ensemble command set. Note * that this is slightly tricky, as it means that we are not actually * counting the number of namespace export actions, but it is the simplest * way to go! */ ensemblePtr->nsPtr->exportLookupEpoch++; /* * Special hack to make compiling of [info exists] work when the * dictionary is modified. */ if (cmdPtr->compileProc != NULL) { ((Interp *) interp)->compileEpoch++; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_SetEnsembleParameterList -- * * Set the parameter list for a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an ensemble * or the parameter list - if non-NULL - is not a list). * * Side effects: * The ensemble is updated and marked for recompilation. * *---------------------------------------------------------------------- */ int Tcl_SetEnsembleParameterList( Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; int length; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (paramList == NULL) { length = 0; } else { if (TclListObjLength(interp, paramList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { paramList = NULL; } } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; oldList = ensemblePtr->parameterList; ensemblePtr->parameterList = paramList; if (paramList != NULL) { Tcl_IncrRefCount(paramList); } if (oldList != NULL) { TclDecrRefCount(oldList); } ensemblePtr->numParameters = length; /* * Trigger an eventual recomputation of the ensemble command set. Note * that this is slightly tricky, as it means that we are not actually * counting the number of namespace export actions, but it is the simplest * way to go! */ ensemblePtr->nsPtr->exportLookupEpoch++; /* * Special hack to make compiling of [info exists] work when the * dictionary is modified. */ if (cmdPtr->compileProc != NULL) { ((Interp *) interp)->compileEpoch++; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_SetEnsembleMappingDict -- * * Set the mapping dictionary for a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an ensemble * or the mapping - if non-NULL - is not a dict). * * Side effects: * The ensemble is updated and marked for recompilation. * *---------------------------------------------------------------------- */ int Tcl_SetEnsembleMappingDict( Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldDict; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (mapDict != NULL) { int size, done; Tcl_DictSearch search; Tcl_Obj *valuePtr; if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) { return TCL_ERROR; } for (Tcl_DictObjFirst(NULL, mapDict, &search, NULL, &valuePtr, &done); !done; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) { Tcl_Obj *cmdObjPtr; const char *bytes; if (Tcl_ListObjIndex(interp, valuePtr, 0, &cmdObjPtr) != TCL_OK) { Tcl_DictObjDone(&search); return TCL_ERROR; } bytes = TclGetString(cmdObjPtr); if (bytes[0] != ':' || bytes[1] != ':') { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble target is not a fully-qualified command", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNQUALIFIED_TARGET", NULL); Tcl_DictObjDone(&search); return TCL_ERROR; } } if (size < 1) { mapDict = NULL; } } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; oldDict = ensemblePtr->subcommandDict; ensemblePtr->subcommandDict = mapDict; if (mapDict != NULL) { Tcl_IncrRefCount(mapDict); } if (oldDict != NULL) { TclDecrRefCount(oldDict); } /* * Trigger an eventual recomputation of the ensemble command set. Note * that this is slightly tricky, as it means that we are not actually * counting the number of namespace export actions, but it is the simplest * way to go! */ ensemblePtr->nsPtr->exportLookupEpoch++; /* * Special hack to make compiling of [info exists] work when the * dictionary is modified. */ if (cmdPtr->compileProc != NULL) { ((Interp *) interp)->compileEpoch++; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_SetEnsembleUnknownHandler -- * * Set the unknown handler for a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an ensemble * or the unknown handler - if non-NULL - is not a list). * * Side effects: * The ensemble is updated and marked for recompilation. * *---------------------------------------------------------------------- */ int Tcl_SetEnsembleUnknownHandler( Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (unknownList != NULL) { int length; if (TclListObjLength(interp, unknownList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { unknownList = NULL; } } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; oldList = ensemblePtr->unknownHandler; ensemblePtr->unknownHandler = unknownList; if (unknownList != NULL) { Tcl_IncrRefCount(unknownList); } if (oldList != NULL) { TclDecrRefCount(oldList); } /* * Trigger an eventual recomputation of the ensemble command set. Note * that this is slightly tricky, as it means that we are not actually * counting the number of namespace export actions, but it is the simplest * way to go! */ ensemblePtr->nsPtr->exportLookupEpoch++; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_SetEnsembleFlags -- * * Set the flags for a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an * ensemble). * * Side effects: * The ensemble is updated and marked for recompilation. * *---------------------------------------------------------------------- */ int Tcl_SetEnsembleFlags( Tcl_Interp *interp, Tcl_Command token, int flags) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; int wasCompiled; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE; /* * This API refuses to set the ENSEMBLE_DEAD flag... */ ensemblePtr->flags &= ENSEMBLE_DEAD; ensemblePtr->flags |= flags & ~ENSEMBLE_DEAD; /* * Trigger an eventual recomputation of the ensemble command set. Note * that this is slightly tricky, as it means that we are not actually * counting the number of namespace export actions, but it is the simplest * way to go! */ ensemblePtr->nsPtr->exportLookupEpoch++; /* * If the ENSEMBLE_COMPILE flag status was changed, install or remove the * compiler function and bump the interpreter's compilation epoch so that * bytecode gets regenerated. */ if (flags & ENSEMBLE_COMPILE) { if (!wasCompiled) { ((Command*) ensemblePtr->token)->compileProc = TclCompileEnsemble; ((Interp *) interp)->compileEpoch++; } } else { if (wasCompiled) { ((Command *) ensemblePtr->token)->compileProc = NULL; ((Interp *) interp)->compileEpoch++; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetEnsembleSubcommandList -- * * Get the list of subcommands associated with a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an * ensemble). The list of subcommands is returned by updating the * variable pointed to by the last parameter (NULL if this is to be * derived from the mapping dictionary or the associated namespace's * exported commands). * * Side effects: * None * *---------------------------------------------------------------------- */ int Tcl_GetEnsembleSubcommandList( Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *subcmdListPtr = ensemblePtr->subcmdList; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetEnsembleParameterList -- * * Get the list of parameters associated with a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an * ensemble). The list of parameters is returned by updating the * variable pointed to by the last parameter (NULL if there are * no parameters). * * Side effects: * None * *---------------------------------------------------------------------- */ int Tcl_GetEnsembleParameterList( Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *paramListPtr = ensemblePtr->parameterList; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetEnsembleMappingDict -- * * Get the command mapping dictionary associated with a particular * ensemble. * * Results: * Tcl result code (error if command token does not indicate an * ensemble). The mapping dict is returned by updating the variable * pointed to by the last parameter (NULL if none is installed). * * Side effects: * None * *---------------------------------------------------------------------- */ int Tcl_GetEnsembleMappingDict( Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *mapDictPtr = ensemblePtr->subcommandDict; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetEnsembleUnknownHandler -- * * Get the unknown handler associated with a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an * ensemble). The unknown handler is returned by updating the variable * pointed to by the last parameter (NULL if no handler is installed). * * Side effects: * None * *---------------------------------------------------------------------- */ int Tcl_GetEnsembleUnknownHandler( Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *unknownListPtr = ensemblePtr->unknownHandler; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetEnsembleFlags -- * * Get the flags for a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an * ensemble). The flags are returned by updating the variable pointed to * by the last parameter. * * Side effects: * None * *---------------------------------------------------------------------- */ int Tcl_GetEnsembleFlags( Tcl_Interp *interp, Tcl_Command token, int *flagsPtr) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *flagsPtr = ensemblePtr->flags; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetEnsembleNamespace -- * * Get the namespace associated with a particular ensemble. * * Results: * Tcl result code (error if command token does not indicate an * ensemble). Namespace is returned by updating the variable pointed to * by the last parameter. * * Side effects: * None * *---------------------------------------------------------------------- */ int Tcl_GetEnsembleNamespace( Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr) { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_FindEnsemble -- * * Given a command name, get the ensemble token for it, allowing for * [namespace import]s. [Bug 1017022] * * Results: * The token for the ensemble command with the given name, or NULL if the * command either does not exist or is not an ensemble (when an error * message will be written into the interp if thats non-NULL). * * Side effects: * None * *---------------------------------------------------------------------- */ Tcl_Command Tcl_FindEnsemble( Tcl_Interp *interp, /* Where to do the lookup, and where to write * the errors if TCL_LEAVE_ERR_MSG is set in * the flags. */ Tcl_Obj *cmdNameObj, /* Name of command to look up. */ int flags) /* Either 0 or TCL_LEAVE_ERR_MSG; other flags * are probably not useful. */ { Command *cmdPtr; cmdPtr = (Command *) Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags); if (cmdPtr == NULL) { return NULL; } if (cmdPtr->objProc != NsEnsembleImplementationCmd) { /* * Reuse existing infrastructure for following import link chains * rather than duplicating it. */ cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){ if (flags & TCL_LEAVE_ERR_MSG) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" is not an ensemble command", TclGetString(cmdNameObj))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE", TclGetString(cmdNameObj), NULL); } return NULL; } } return (Tcl_Command) cmdPtr; } /* *---------------------------------------------------------------------- * * Tcl_IsEnsemble -- * * Simple test for ensemble-hood that takes into account imported * ensemble commands as well. * * Results: * Boolean value * * Side effects: * None * *---------------------------------------------------------------------- */ int Tcl_IsEnsemble( Tcl_Command token) { Command *cmdPtr = (Command *) token; if (cmdPtr->objProc == NsEnsembleImplementationCmd) { return 1; } cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) { return 0; } return 1; } /* *---------------------------------------------------------------------- * * TclMakeEnsemble -- * * Create an ensemble from a table of implementation commands. The * ensemble will be subject to (limited) compilation if any of the * implementation commands are compilable. * * The 'name' parameter may be a single command name or a list if * creating an ensemble subcommand (see the binary implementation). * * Currently, the TCL_ENSEMBLE_PREFIX ensemble flag is only used on * top-level ensemble commands. * * Results: * Handle for the new ensemble, or NULL on failure. * * Side effects: * May advance the bytecode compilation epoch. * *---------------------------------------------------------------------- */ Tcl_Command TclMakeEnsemble( Tcl_Interp *interp, const char *name, /* The ensemble name (as explained above) */ const EnsembleImplMap map[]) /* The subcommands to create */ { Tcl_Command ensemble; Tcl_Namespace *ns; Tcl_DString buf, hiddenBuf; const char **nameParts = NULL; const char *cmdName = NULL; int i, nameCount = 0, ensembleFlags = 0, hiddenLen; /* * Construct the path for the ensemble namespace and create it. */ Tcl_DStringInit(&buf); Tcl_DStringInit(&hiddenBuf); TclDStringAppendLiteral(&hiddenBuf, "tcl:"); Tcl_DStringAppend(&hiddenBuf, name, -1); TclDStringAppendLiteral(&hiddenBuf, ":"); hiddenLen = Tcl_DStringLength(&hiddenBuf); if (name[0] == ':' && name[1] == ':') { /* * An absolute name, so use it directly. */ cmdName = name; Tcl_DStringAppend(&buf, name, -1); ensembleFlags = TCL_ENSEMBLE_PREFIX; } else { /* * Not an absolute name, so do munging of it. Note that this treats a * multi-word list differently to a single word. */ TclDStringAppendLiteral(&buf, "::tcl"); if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) { Tcl_Panic("invalid ensemble name '%s'", name); } for (i = 0; i < nameCount; ++i) { TclDStringAppendLiteral(&buf, "::"); Tcl_DStringAppend(&buf, nameParts[i], -1); } } ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL, TCL_CREATE_NS_IF_UNKNOWN); if (!ns) { Tcl_Panic("unable to find or create %s namespace!", Tcl_DStringValue(&buf)); } /* * Create the named ensemble in the correct namespace */ if (cmdName == NULL) { if (nameCount == 1) { ensembleFlags = TCL_ENSEMBLE_PREFIX; cmdName = Tcl_DStringValue(&buf) + 5; } else { ns = ns->parentPtr; cmdName = nameParts[nameCount - 1]; } } /* * Switch on compilation always for core ensembles now that we can do * nice bytecode things with them. Do it now. Waiting until later will * just cause pointless epoch bumps. */ ensembleFlags |= ENSEMBLE_COMPILE; ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags); /* * Create the ensemble mapping dictionary and the ensemble command procs. */ if (ensemble != NULL) { Tcl_Obj *mapDict, *fromObj, *toObj; Command *cmdPtr; TclDStringAppendLiteral(&buf, "::"); TclNewObj(mapDict); for (i=0 ; map[i].name != NULL ; i++) { fromObj = Tcl_NewStringObj(map[i].name, -1); TclNewStringObj(toObj, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); Tcl_AppendToObj(toObj, map[i].name, -1); Tcl_DictObjPut(NULL, mapDict, fromObj, toObj); if (map[i].proc || map[i].nreProc) { /* * If the command is unsafe, hide it when we're in a safe * interpreter. The code to do this is really hokey! It also * doesn't work properly yet; this function is always * currently called before the safe-interp flag is set so the * Tcl_IsSafe check fails. */ if (map[i].unsafe && Tcl_IsSafe(interp)) { cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "___tmp", map[i].proc, map[i].nreProc, map[i].clientData, NULL); Tcl_DStringSetLength(&hiddenBuf, hiddenLen); if (Tcl_HideCommand(interp, "___tmp", Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) { Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } } else { /* * Not hidden, so just create it. Yay! */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, TclGetString(toObj), map[i].proc, map[i].nreProc, map[i].clientData, NULL); } cmdPtr->compileProc = map[i].compileProc; } } Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict); } Tcl_DStringFree(&buf); Tcl_DStringFree(&hiddenBuf); if (nameParts != NULL) { ckfree((char *) nameParts); } return ensemble; } /* *---------------------------------------------------------------------- * * NsEnsembleImplementationCmd -- * * Implements an ensemble of commands (being those exported by a * namespace other than the global namespace) as a command with the same * (short) name as the namespace in the parent namespace. * * Results: * A standard Tcl result code. Will be TCL_ERROR if the command is not an * unambiguous prefix of any command exported by the ensemble's * namespace. * * Side effects: * Depends on the command within the namespace that gets executed. If the * ensemble itself returns TCL_ERROR, a descriptive error message will be * placed in the interpreter's result. * *---------------------------------------------------------------------- */ static int NsEnsembleImplementationCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { return Tcl_NRCallObjProc(interp, NsEnsembleImplementationCmdNR, clientData, objc, objv); } static int NsEnsembleImplementationCmdNR( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData; /* The ensemble itself. */ Tcl_Obj *prefixObj; /* An object containing the prefix words of * the command that implements the * subcommand. */ Tcl_HashEntry *hPtr; /* Used for efficient lookup of fully * specified but not yet cached command * names. */ int reparseCount = 0; /* Number of reparses. */ Tcl_Obj *errorObj; /* Used for building error messages. */ Tcl_Obj *subObj; int subIdx; /* * Must recheck objc, since numParameters might have changed. Cf. test * namespace-53.9. */ restartEnsembleParse: subIdx = 1 + ensemblePtr->numParameters; if (objc < subIdx + 1) { /* * We don't have a subcommand argument. Make error message. */ Tcl_DString buf; /* Message being built */ Tcl_DStringInit(&buf); if (ensemblePtr->parameterList) { Tcl_DStringAppend(&buf, TclGetString(ensemblePtr->parameterList), -1); TclDStringAppendLiteral(&buf, " "); } TclDStringAppendLiteral(&buf, "subcommand ?arg ...?"); Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf)); Tcl_DStringFree(&buf); return TCL_ERROR; } if (ensemblePtr->nsPtr->flags & NS_DYING) { /* * Don't know how we got here, but make things give up quickly. */ if (!Tcl_InterpDeleted(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble activated for deleted namespace", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL); } return TCL_ERROR; } /* * Determine if the table of subcommands is right. If so, we can just look * up in there and go straight to dispatch. */ subObj = objv[subIdx]; if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) { /* * Table of subcommands is still valid; therefore there might be a * valid cache of discovered information which we can reuse. Do the * check here, and if we're still valid, we can jump straight to the * part where we do the invocation of the subcommand. */ if (subObj->typePtr==&ensembleCmdType){ EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *)subObj->internalRep.twoPtrValue.ptr1; if (ensembleCmd->epoch == ensemblePtr->epoch && ensembleCmd->token == (Command *)ensemblePtr->token) { prefixObj = (Tcl_Obj *)Tcl_GetHashValue(ensembleCmd->hPtr); Tcl_IncrRefCount(prefixObj); if (ensembleCmd->fix) { TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix); } goto runResultingSubcommand; } } } else { BuildEnsembleConfig(ensemblePtr); ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch; } /* * Look in the hashtable for the subcommand name; this is the fastest way * of all if there is no cache in operation. */ hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, TclGetString(subObj)); if (hPtr != NULL) { /* * Cache for later in the subcommand object. */ MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, NULL); } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) { /* * Could not map, no prefixing, go to unknown/error handling. */ goto unknownOrAmbiguousSubcommand; } else { /* * If we've not already confirmed the command with the hash as part of * building our export table, we need to scan the sorted array for * matches. */ const char *subcmdName; /* Name of the subcommand, or unique prefix of * it (will be an error for a non-unique * prefix). */ char *fullName = NULL; /* Full name of the subcommand. */ int stringLength, i; int tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; subcmdName = Tcl_GetStringFromObj(subObj, &stringLength); for (i=0 ; isubcommandArrayPtr[i], (unsigned) stringLength); if (cmp == 0) { if (fullName != NULL) { /* * Since there's never the exact-match case to worry about * (hash search filters this), getting here indicates that * our subcommand is an ambiguous prefix of (at least) two * exported subcommands, which is an error case. */ goto unknownOrAmbiguousSubcommand; } fullName = ensemblePtr->subcommandArrayPtr[i]; } else if (cmp < 0) { /* * Because we are searching a sorted table, we can now stop * searching because we have gone past anything that could * possibly match. */ break; } } if (fullName == NULL) { /* * The subcommand is not a prefix of anything, so bail out! */ goto unknownOrAmbiguousSubcommand; } hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, fullName); if (hPtr == NULL) { Tcl_Panic("full name %s not found in supposedly synchronized hash", fullName); } /* * Record the spelling correction for usage message. */ fix = Tcl_NewStringObj(fullName, -1); /* * Cache for later in the subcommand object. */ MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix); TclSpellFix(interp, objv, objc, subIdx, subObj, fix); } prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_IncrRefCount(prefixObj); runResultingSubcommand: /* * Do the real work of execution of the subcommand by building an array of * objects (note that this is potentially not the same length as the * number of arguments to this ensemble command), populating it and then * feeding it back through the main command-lookup engine. In theory, we * could look up the command in the namespace ourselves, as we already * have the namespace in which it is guaranteed to exist, * * ((Q: That's not true if the -map option is used, is it?)) * * but we don't do that (the caching of the command object used should * help with that.) */ { Tcl_Obj *copyPtr; /* The actual list of words to dispatch to. * Will be freed by the dispatch engine. */ Tcl_Obj **copyObjv; int copyObjc, prefixObjc; TclListObjLength(NULL, prefixObj, &prefixObjc); if (objc == 2) { copyPtr = TclListObjCopy(NULL, prefixObj); } else { copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL); Tcl_ListObjAppendList(NULL, copyPtr, prefixObj); Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0, ensemblePtr->numParameters, objv + 1); Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0, objc - 2 - ensemblePtr->numParameters, objv + 2 + ensemblePtr->numParameters); } Tcl_IncrRefCount(copyPtr); TclNRAddCallback(interp, TclNRReleaseValues, copyPtr, NULL, NULL, NULL); TclDecrRefCount(prefixObj); /* * Record what arguments the script sent in so that things like * Tcl_WrongNumArgs can give the correct error message. Parameters * count both as inserted and removed arguments. */ if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters, prefixObjc + ensemblePtr->numParameters, objv)) { TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } /* * Hand off to the target command. */ TclSkipTailcall(interp); TclListObjGetElements(NULL, copyPtr, ©Objc, ©Objv); ((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr; return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL); } unknownOrAmbiguousSubcommand: /* * Have not been able to match the subcommand asked for with a real * subcommand that we export. See whether a handler has been registered * for dealing with this situation. Will only call (at most) once for any * particular ensemble invocation. */ if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) { switch (EnsembleUnknownCallback(interp, ensemblePtr, objc, objv, &prefixObj)) { case TCL_OK: goto runResultingSubcommand; case TCL_ERROR: return TCL_ERROR; case TCL_CONTINUE: goto restartEnsembleParse; } } /* * We cannot determine what subcommand to hand off to, so generate a * (standard) failure message. Note the one odd case compared with * standard ensemble-like command, which is where a namespace has no * exported commands at all... */ Tcl_ResetResult(interp); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", TclGetString(subObj), NULL); if (ensemblePtr->subcommandTable.numEntries == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown subcommand \"%s\": namespace %s does not" " export any commands", TclGetString(subObj), ensemblePtr->nsPtr->fullName)); return TCL_ERROR; } errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ", (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""), TclGetString(subObj)); if (ensemblePtr->subcommandTable.numEntries == 1) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { int i; for (i=0 ; isubcommandTable.numEntries-1 ; i++) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1); Tcl_AppendToObj(errorObj, ", ", 2); } Tcl_AppendPrintfToObj(errorObj, "or %s", ensemblePtr->subcommandArrayPtr[i]); } Tcl_SetObjResult(interp, errorObj); return TCL_ERROR; } int TclClearRootEnsemble( ClientData data[], Tcl_Interp *interp, int result) { TclResetRewriteEnsemble(interp, 1); return result; } /* *---------------------------------------------------------------------- * * TclInitRewriteEnsemble -- * * Applies a rewrite of arguments so that an ensemble subcommand will * report error messages correctly for the overall command. * * Results: * Whether this is the first rewrite applied, a value which must be * passed to TclResetRewriteEnsemble when undoing this command's * behaviour. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclInitRewriteEnsemble( Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); if (isRootEnsemble) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = numRemoved; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { int numIns = iPtr->ensembleRewrite.numInsertedObjs; if (numIns < numRemoved) { iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved; } } return isRootEnsemble; } /* *---------------------------------------------------------------------- * * TclResetRewriteEnsemble -- * * Removes any rewrites applied to support proper reporting of error * messages used in ensembles. Should be paired with * TclInitRewriteEnsemble. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclResetRewriteEnsemble( Tcl_Interp *interp, int isRootEnsemble) { Interp *iPtr = (Interp *) interp; if (isRootEnsemble) { iPtr->ensembleRewrite.sourceObjs = NULL; iPtr->ensembleRewrite.numRemovedObjs = 0; iPtr->ensembleRewrite.numInsertedObjs = 0; } } /* *---------------------------------------------------------------------- * * TclSpellFix -- * * Record a spelling correction that needs making in the generation of * the WrongNumArgs usage message. * * Results: * None. * * Side effects: * Can create an alternative ensemble rewrite structure. * *---------------------------------------------------------------------- */ static int FreeER( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj **tmp = (Tcl_Obj **) data[0]; Tcl_Obj **store = (Tcl_Obj **) data[1]; ckfree(store); ckfree(tmp); return result; } void TclSpellFix( Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int badIdx, Tcl_Obj *bad, Tcl_Obj *fix) { Interp *iPtr = (Interp *) interp; Tcl_Obj *const *search; Tcl_Obj **store; int idx; int size; if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = 0; iPtr->ensembleRewrite.numInsertedObjs = 0; } /* * Compute the valid length of the ensemble root. */ size = iPtr->ensembleRewrite.numRemovedObjs + objc - iPtr->ensembleRewrite.numInsertedObjs; search = iPtr->ensembleRewrite.sourceObjs; if (search[0] == NULL) { /* * Awful casting abuse here! */ search = (Tcl_Obj *const *) search[1]; } if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) { /* * Misspelled value was inserted. We cannot directly jump to the bad * value, but have to search. */ idx = 1; while (idx < size) { if (search[idx] == bad) { break; } idx++; } if (idx == size) { return; } } else { /* * Jump to the misspelled value. */ idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx - iPtr->ensembleRewrite.numInsertedObjs; /* Verify */ if (search[idx] != bad) { Tcl_Panic("SpellFix: programming error"); } } search = iPtr->ensembleRewrite.sourceObjs; if (search[0] == NULL) { store = (Tcl_Obj **) search[2]; } else { Tcl_Obj **tmp = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *)); store = (Tcl_Obj **)ckalloc(size * sizeof(Tcl_Obj *)); memcpy(store, iPtr->ensembleRewrite.sourceObjs, size * sizeof(Tcl_Obj *)); /* * Awful casting abuse here! Note that the NULL in the first element * indicates that the initial objects are a raw array in the second * element and the rewritten ones are a raw array in the third. */ tmp[0] = NULL; tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs; tmp[2] = (Tcl_Obj *) store; iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp; TclNRAddCallback(interp, FreeER, tmp, store, NULL, NULL); } store[idx] = fix; Tcl_IncrRefCount(fix); TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL); } Tcl_Obj *const *TclEnsembleGetRewriteValues( Tcl_Interp *interp /* Current interpreter. */ ) { Interp *iPtr = (Interp *) interp; Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs; if (origObjv[0] == NULL) { origObjv = (Tcl_Obj *const *)origObjv[2]; } return origObjv; } /* *---------------------------------------------------------------------- * * TclFetchEnsembleRoot -- * * Returns the root of ensemble rewriting, if any. * If no root exists, returns objv instead. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj *const * TclFetchEnsembleRoot( Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr) { Tcl_Obj *const *sourceObjs; Interp *iPtr = (Interp *) interp; if (iPtr->ensembleRewrite.sourceObjs) { *objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs - iPtr->ensembleRewrite.numInsertedObjs; if (iPtr->ensembleRewrite.sourceObjs[0] == NULL) { sourceObjs = (Tcl_Obj *const *)iPtr->ensembleRewrite.sourceObjs[1]; } else { sourceObjs = iPtr->ensembleRewrite.sourceObjs; } return sourceObjs; } *objcPtr = objc; return objv; } /* * ---------------------------------------------------------------------- * * EnsmebleUnknownCallback -- * * Helper for the ensemble engine that handles the processing of unknown * callbacks. See the user documentation of the ensemble unknown handler * for details; this function is only ever called when such a function is * defined, and is only ever called once per ensemble dispatch (i.e. if a * reparse still fails, this isn't called again). * * Results: * TCL_OK - *prefixObjPtr contains the command words to dispatch * to. * TCL_CONTINUE - Need to reparse (*prefixObjPtr is invalid). * TCL_ERROR - Something went wrong! Error message in interpreter. * * Side effects: * Calls the Tcl interpreter, so arbitrary. * * ---------------------------------------------------------------------- */ static inline int EnsembleUnknownCallback( Tcl_Interp *interp, EnsembleConfig *ensemblePtr, int objc, Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr) { int paramc, i, result, prefixObjc; Tcl_Obj **paramv, *unknownCmd, *ensObj; /* * Create the unknown command callback to determine what to do. */ unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler); TclNewObj(ensObj); Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj); Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj); for (i=1 ; iflags & ENSEMBLE_DEAD)) { if (!Tcl_InterpDeleted(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unknown subcommand handler deleted its ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED", NULL); } result = TCL_ERROR; } Tcl_Release(ensemblePtr); /* * If we succeeded, we should either have a list of words that form the * command to be executed, or an empty list. In the empty-list case, the * ensemble is believed to be updated so we should ask the ensemble engine * to reparse the original command. */ if (result == TCL_OK) { *prefixObjPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(*prefixObjPtr); TclDecrRefCount(unknownCmd); Tcl_ResetResult(interp); /* * Namespace is still there. Check if the result is a valid list. If * it is, and it is non-empty, that list is what we are using as our * replacement. */ if (TclListObjLength(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) { TclDecrRefCount(*prefixObjPtr); Tcl_AddErrorInfo(interp, "\n while parsing result of " "ensemble unknown subcommand handler"); return TCL_ERROR; } if (prefixObjc > 0) { return TCL_OK; } /* * Namespace alive & empty result => reparse. */ TclDecrRefCount(*prefixObjPtr); return TCL_CONTINUE; } /* * Oh no! An exceptional result. Convert to an error. */ if (!Tcl_InterpDeleted(interp)) { if (result != TCL_ERROR) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( "unknown subcommand handler returned bad code: ", -1)); switch (result) { case TCL_RETURN: Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1); break; case TCL_BREAK: Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1); break; case TCL_CONTINUE: Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1); break; default: Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result); } Tcl_AddErrorInfo(interp, "\n result of " "ensemble unknown subcommand handler: "); Tcl_AppendObjToErrorInfo(interp, unknownCmd); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT", NULL); } else { Tcl_AddErrorInfo(interp, "\n (ensemble unknown subcommand handler)"); } } TclDecrRefCount(unknownCmd); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * MakeCachedEnsembleCommand -- * * Cache what we've computed so far; it's not nice to repeatedly copy * strings about. Note that to do this, we start by deleting any old * representation that there was (though if it was an out of date * ensemble rep, we can skip some of the deallocation process.) * * Results: * None * * Side effects: * Alters the internal representation of the first object parameter. * *---------------------------------------------------------------------- */ static void MakeCachedEnsembleCommand( Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, Tcl_Obj *fix) { EnsembleCmdRep *ensembleCmd; if (objPtr->typePtr == &ensembleCmdType) { ensembleCmd = (EnsembleCmdRep *)objPtr->internalRep.twoPtrValue.ptr1; TclCleanupCommandMacro(ensembleCmd->token); if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } } else { /* * Kill the old internal rep, and replace it with a brand new one of * our own. */ TclFreeIntRep(objPtr); ensembleCmd = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep)); objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd; objPtr->typePtr = &ensembleCmdType; } /* * Populate the internal rep. */ ensembleCmd->epoch = ensemblePtr->epoch; ensembleCmd->token = (Command *) ensemblePtr->token; ensembleCmd->token->refCount++; if (fix) { Tcl_IncrRefCount(fix); } ensembleCmd->fix = fix; ensembleCmd->hPtr = hPtr; } /* *---------------------------------------------------------------------- * * DeleteEnsembleConfig -- * * Destroys the data structure used to represent an ensemble. This is * called when the ensemble's command is deleted (which happens * automatically if the ensemble's namespace is deleted.) Maintainers * should note that ensembles should be deleted by deleting their * commands. * * Results: * None. * * Side effects: * Memory is (eventually) deallocated. * *---------------------------------------------------------------------- */ static void ClearTable( EnsembleConfig *ensemblePtr) { Tcl_HashTable *hash = &ensemblePtr->subcommandTable; if (hash->numEntries != 0) { Tcl_HashSearch search; Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); while (hPtr != NULL) { Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_DecrRefCount(prefixObj); hPtr = Tcl_NextHashEntry(&search); } ckfree((char *) ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } static void DeleteEnsembleConfig( ClientData clientData) { EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData; Namespace *nsPtr = ensemblePtr->nsPtr; /* * Unlink from the ensemble chain if it has not been marked as having been * done already. */ if (ensemblePtr->next != ensemblePtr) { EnsembleConfig *ensPtr = (EnsembleConfig *) nsPtr->ensembles; if (ensPtr == ensemblePtr) { nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next; } else { while (ensPtr != NULL) { if (ensPtr->next == ensemblePtr) { ensPtr->next = ensemblePtr->next; break; } ensPtr = ensPtr->next; } } } /* * Mark the namespace as dead so code that uses Tcl_Preserve() can tell * whether disaster happened anyway. */ ensemblePtr->flags |= ENSEMBLE_DEAD; /* * Kill the pointer-containing fields. */ ClearTable(ensemblePtr); if (ensemblePtr->subcmdList != NULL) { Tcl_DecrRefCount(ensemblePtr->subcmdList); } if (ensemblePtr->parameterList != NULL) { Tcl_DecrRefCount(ensemblePtr->parameterList); } if (ensemblePtr->subcommandDict != NULL) { Tcl_DecrRefCount(ensemblePtr->subcommandDict); } if (ensemblePtr->unknownHandler != NULL) { Tcl_DecrRefCount(ensemblePtr->unknownHandler); } /* * Arrange for the structure to be reclaimed. Note that this is complex * because we have to make sure that we can react sensibly when an * ensemble is deleted during the process of initialising the ensemble * (especially the unknown callback.) */ Tcl_EventuallyFree(ensemblePtr, TCL_DYNAMIC); } /* *---------------------------------------------------------------------- * * BuildEnsembleConfig -- * * Create the internal data structures that describe how an ensemble * looks, being a hash mapping from the simple command name to the Tcl list * that describes the implementation prefix words, and a sorted array of * the names to allow for reasonably efficient unambiguous prefix handling. * * Results: * None. * * Side effects: * Reallocates and rebuilds the hash table and array stored at the * ensemblePtr argument. For large ensembles or large namespaces, this is * a potentially expensive operation. * *---------------------------------------------------------------------- */ static void BuildEnsembleConfig( EnsembleConfig *ensemblePtr) { Tcl_HashSearch search; /* Used for scanning the set of commands in * the namespace that backs up this * ensemble. */ int i, j, isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; Tcl_Obj *mapDict = ensemblePtr->subcommandDict; Tcl_Obj *subList = ensemblePtr->subcmdList; ClearTable(ensemblePtr); Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { int subc; Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; char *name; /* * There is a list of exactly what subcommands go in the table. * Must determine the target for each. */ TclListObjGetElements(NULL, subList, &subc, &subv); if (subList == mapDict) { /* * Strange case where explicit list of subcommands is same value * as the dict mapping to targets. */ for (i = 0; i < subc; i += 2) { name = TclGetString(subv[i]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (!isNew) { cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_DecrRefCount(cmdObj); } Tcl_SetHashValue(hPtr, subv[i+1]); Tcl_IncrRefCount(subv[i+1]); name = TclGetString(subv[i+1]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (isNew) { cmdObj = Tcl_NewStringObj(name, -1); cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); } } } else { /* Usual case where we can freely act on the list and dict. */ for (i = 0; i < subc; i++) { name = TclGetString(subv[i]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (!isNew) { continue; } /* Lookup target in the dictionary */ if (mapDict) { Tcl_DictObjGet(NULL, mapDict, subv[i], &target); if (target) { Tcl_SetHashValue(hPtr, target); Tcl_IncrRefCount(target); continue; } } /* * target was not in the dictionary so map onto the namespace. * Note in this case that we do not guarantee that the * command is actually there; that is the programmer's * responsibility (or [::unknown] of course). */ cmdObj = Tcl_NewStringObj(name, -1); cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); } } } else if (mapDict) { /* * No subcmd list, but we do have a mapping dictionary so we should * use the keys of that. Convert the dictionary's contents into the * form required for the ensemble's internal hashtable. */ Tcl_DictSearch dictSearch; Tcl_Obj *keyObj, *valueObj; int done; Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, &keyObj, &valueObj, &done); while (!done) { char *name = TclGetString(keyObj); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); Tcl_SetHashValue(hPtr, valueObj); Tcl_IncrRefCount(valueObj); Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); } } else { /* * Discover what commands are actually exported by the namespace. * What we have is an array of patterns and a hash table whose keys * are the command names exported by the namespace (the contents do * not matter here.) We must find out what commands are actually * exported by filtering each command in the namespace against each of * the patterns in the export list. Note that we use an intermediate * hash table to make memory management easier, and because that makes * exact matching far easier too. * * Suggestion for future enhancement: compute the unique prefixes and * place them in the hash too, which should make for even faster * matching. */ hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search); for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) { char *nsCmdName = (char *) /* Name of command in namespace. */ Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr); for (i=0 ; insPtr->numExportPatterns ; i++) { if (Tcl_StringMatch(nsCmdName, ensemblePtr->nsPtr->exportArrayPtr[i])) { hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew); /* * Remember, hash entries have a full reference to the * substituted part of the command (as a list) as their * content! */ if (isNew) { Tcl_Obj *cmdObj, *cmdPrefixObj; TclNewObj(cmdObj); Tcl_AppendStringsToObj(cmdObj, ensemblePtr->nsPtr->fullName, (ensemblePtr->nsPtr->parentPtr ? "::" : ""), nsCmdName, NULL); cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); } break; } } } } if (hash->numEntries == 0) { ensemblePtr->subcommandArrayPtr = NULL; return; } /* * Create a sorted array of all subcommands in the ensemble; hash tables * are all very well for a quick look for an exact match, but they can't * determine things like whether a string is a prefix of another (not * without lots of preparation anyway) and they're no good for when we're * generating the error message either. * * We do this by filling an array with the names (we use the hash keys * directly to save a copy, since any time we change the array we change * the hash too, and vice versa) and running quicksort over the array. */ ensemblePtr->subcommandArrayPtr = (char **) ckalloc(sizeof(char *) * hash->numEntries); /* * Fill array from both ends as this makes us less likely to end up with * performance problems in qsort(), which is good. Note that doing this * makes this code much more opaque, but the naive alternatve: * * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ; * hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) { * ensemblePtr->subcommandArrayPtr[i] = Tcl_GetHashKey(hash, &hPtr); * } * * can produce long runs of precisely ordered table entries when the * commands in the namespace are declared in a sorted fashion (an ordering * some people like) and the hashing functions (or the command names * themselves) are fairly unfortunate. By filling from both ends, it * requires active malice (and probably a debugger) to get qsort() to have * awful runtime behaviour. */ i = 0; j = hash->numEntries; hPtr = Tcl_FirstHashEntry(hash, &search); while (hPtr != NULL) { ensemblePtr->subcommandArrayPtr[i++] = (char *)Tcl_GetHashKey(hash, hPtr); hPtr = Tcl_NextHashEntry(&search); if (hPtr == NULL) { break; } ensemblePtr->subcommandArrayPtr[--j] = (char *)Tcl_GetHashKey(hash, hPtr); hPtr = Tcl_NextHashEntry(&search); } if (hash->numEntries > 1) { qsort(ensemblePtr->subcommandArrayPtr, (unsigned) hash->numEntries, sizeof(char *), NsEnsembleStringOrder); } } /* *---------------------------------------------------------------------- * * NsEnsembleStringOrder -- * * Helper function to compare two pointers to two strings for use with * qsort(). * * Results: * -1 if the first string is smaller, 1 if the second string is smaller, * and 0 if they are equal. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int NsEnsembleStringOrder( const void *strPtr1, const void *strPtr2) { return strcmp(*(const char **)strPtr1, *(const char **)strPtr2); } /* *---------------------------------------------------------------------- * * FreeEnsembleCmdRep -- * * Destroys the internal representation of a Tcl_Obj that has been * holding information about a command in an ensemble. * * Results: * None. * * Side effects: * Memory is deallocated. If this held the last reference to a * namespace's main structure, that main structure will also be * destroyed. * *---------------------------------------------------------------------- */ static void FreeEnsembleCmdRep( Tcl_Obj *objPtr) { EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *)objPtr->internalRep.twoPtrValue.ptr1; TclCleanupCommandMacro(ensembleCmd->token); if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } ckfree(ensembleCmd); objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DupEnsembleCmdRep -- * * Makes one Tcl_Obj into a copy of another that is a subcommand of an * ensemble. * * Results: * None. * * Side effects: * Memory is allocated, and the namespace that the ensemble is built on * top of gains another reference. * *---------------------------------------------------------------------- */ static void DupEnsembleCmdRep( Tcl_Obj *objPtr, Tcl_Obj *copyPtr) { EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *)objPtr->internalRep.twoPtrValue.ptr1; EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep)); copyPtr->typePtr = &ensembleCmdType; copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy; ensembleCopy->epoch = ensembleCmd->epoch; ensembleCopy->token = ensembleCmd->token; ensembleCopy->token->refCount++; ensembleCopy->fix = ensembleCmd->fix; if (ensembleCopy->fix) { Tcl_IncrRefCount(ensembleCopy->fix); } ensembleCopy->hPtr = ensembleCmd->hPtr; } /* *---------------------------------------------------------------------- * * TclCompileEnsemble -- * * Procedure called to compile an ensemble command. Note that most * ensembles are not compiled, since modifying a compiled ensemble causes * a invalidation of all existing bytecode (expensive!) which is not * normally warranted. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the subcommands of the * ensemble at runtime if a compile-time mapping is possible. * *---------------------------------------------------------------------- */ int TclCompileEnsemble( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems; Tcl_Obj *replaced, *replacement; Tcl_Command ensemble = (Tcl_Command) cmdPtr; Command *oldCmdPtr = cmdPtr, *newCmdPtr; int len, result, flags = 0, i, depth = 1, invokeAnyway = 0; int ourResult = TCL_ERROR; unsigned numBytes; const char *word; TclNewObj(replaced); Tcl_IncrRefCount(replaced); if (parsePtr->numWords < depth + 1) { goto failed; } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * Too hard. */ goto failed; } /* * This is where we return to if we are parsing multiple nested compiled * ensembles. [info object] is such a beast. */ checkNextWord: word = tokenPtr[1].start; numBytes = tokenPtr[1].size; /* * There's a sporting chance we'll be able to compile this. But now we * must check properly. To do that, check that we're compiling an ensemble * that has a compilable command as its appropriate subcommand. */ if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK || mapObj == NULL) { /* * Either not an ensemble or a mapping isn't installed. Crud. Too hard * to proceed. */ goto failed; } /* * Also refuse to compile anything that uses a formal parameter list for * now, on the grounds that it is too complex. */ if (Tcl_GetEnsembleParameterList(NULL, ensemble, &listObj) != TCL_OK || listObj != NULL) { /* * Figuring out how to compile this has become too much. Bail out. */ goto failed; } /* * Next, get the flags. We need them on several code paths so that we can * know whether we're to do prefix matching. */ (void) Tcl_GetEnsembleFlags(NULL, ensemble, &flags); /* * Check to see if there's also a subcommand list; must check to see if * the subcommand we are calling is in that list if it exists, since that * list filters the entries in the map. */ (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj); if (listObj != NULL) { int sclen; const char *str; Tcl_Obj *matchObj = NULL; if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { goto failed; } for (i=0 ; insPtr->flags & NS_SUPPRESS_COMPILATION || newCmdPtr->flags & CMD_HAS_EXEC_TRACES || ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) { /* * Maps to an undefined command or a command without a compiler. * Cannot compile. */ goto cleanup; } cmdPtr = newCmdPtr; depth++; /* * See whether we have a nested ensemble. If we do, we can go round the * mulberry bush again, consuming the next word. */ if (cmdPtr->compileProc == TclCompileEnsemble) { tokenPtr = TokenAfter(tokenPtr); if (parsePtr->numWords < depth + 1 || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * Too hard because the user has done something unpleasant like * omitting the sub-ensemble's command name or used a non-constant * name for a sub-ensemble's command name; we respond by bailing * out completely (this is a rare case). [Bug 6d2f249a01] */ goto cleanup; } ensemble = (Tcl_Command) cmdPtr; goto checkNextWord; } /* * Now we've done the mapping process, can now actually try to compile. * If there is a subcommand compiler and that successfully produces code, * we'll use that. Otherwise, we fall back to generating opcodes to do the * invoke at runtime. */ invokeAnyway = 1; if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr, envPtr)) { ourResult = TCL_OK; goto cleanup; } /* * Throw out any line information generated by the failed compile attempt. */ while (mapPtr->nuloc - 1 > eclIndex) { mapPtr->nuloc--; ckfree(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; } /* * Reset the index of next command. Toss out any from failed nested * partial compiles. */ envPtr->numCommands = mapPtr->nuloc; /* * Failed to do a full compile for some reason. Try to do a direct invoke * instead of going through the ensemble lookup process again. */ failed: if (depth < 250) { if (depth > 1) { if (!invokeAnyway) { cmdPtr = oldCmdPtr; depth--; } } /* * The length of the "replaced" list must be depth-1. Trim back * any extra elements that might have been appended by failing * pathways above. */ (void) Tcl_ListObjReplace(NULL, replaced, depth-1, LIST_MAX, 0, NULL); /* * TODO: Reconsider whether we ought to call CompileToInvokedCommand() * when depth==1. In that case we are choosing to emit the * INST_INVOKE_REPLACE bytecode when there is in fact no replacing * to be done. It would be equally functional and presumably more * performant to fall through to cleanup below, return TCL_ERROR, * and let the compiler harness emit the INST_INVOKE_STK * implementation for us. */ CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr); ourResult = TCL_OK; } /* * Release the memory we allocated. If we've got here, we've either done * something useful or we're in a case that we can't compile at all and * we're just giving up. */ cleanup: Tcl_DecrRefCount(replaced); return ourResult; } int TclAttemptCompileProc( Tcl_Interp *interp, Tcl_Parse *parsePtr, int depth, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; int result, i; Tcl_Token *saveTokenPtr = parsePtr->tokenPtr; int savedStackDepth = envPtr->currStackDepth; unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; int savedAuxDataArrayNext = envPtr->auxDataArrayNext; int savedExceptArrayNext = envPtr->exceptArrayNext; #ifdef TCL_COMPILE_DEBUG int savedExceptDepth = envPtr->exceptDepth; #endif if (cmdPtr->compileProc == NULL) { return TCL_ERROR; } /* * Advance parsePtr->tokenPtr so that it points at the last subcommand. * This will be wrong, but it will not matter, and it will put the * tokens for the arguments in the right place without the needed to * allocate a synthetic Tcl_Parse struct, or copy tokens around. */ for (i = 0; i < depth - 1; i++) { parsePtr->tokenPtr = TokenAfter(parsePtr->tokenPtr); } parsePtr->numWords -= (depth - 1); /* * Shift the line information arrays to account for different word * index values. */ mapPtr->loc[eclIndex].line += (depth - 1); mapPtr->loc[eclIndex].next += (depth - 1); /* * Hand off compilation to the subcommand compiler. At last! */ result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr); /* * Undo the shift. */ mapPtr->loc[eclIndex].line -= (depth - 1); mapPtr->loc[eclIndex].next -= (depth - 1); parsePtr->numWords += (depth - 1); parsePtr->tokenPtr = saveTokenPtr; /* * If our target failed to compile, revert any data from failed partial * compiles. Note that envPtr->numCommands need not be checked because * we avoid compiling subcommands that recursively call TclCompileScript(). */ #ifdef TCL_COMPILE_DEBUG if (envPtr->exceptDepth != savedExceptDepth) { Tcl_Panic("ExceptionRange Starts and Ends do not balance"); } #endif if (result != TCL_OK) { ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr; for (i = 0; i < savedExceptArrayNext; i++) { while (auxPtr->numBreakTargets > 0 && auxPtr->breakTargets[auxPtr->numBreakTargets - 1] >= savedCodeNext) { auxPtr->numBreakTargets--; } while (auxPtr->numContinueTargets > 0 && auxPtr->continueTargets[auxPtr->numContinueTargets - 1] >= savedCodeNext) { auxPtr->numContinueTargets--; } auxPtr++; } envPtr->exceptArrayNext = savedExceptArrayNext; if (savedAuxDataArrayNext != envPtr->auxDataArrayNext) { AuxData *auxDataPtr = envPtr->auxDataArrayPtr; AuxData *auxDataEnd = auxDataPtr; auxDataPtr += savedAuxDataArrayNext; auxDataEnd += envPtr->auxDataArrayNext; while (auxDataPtr < auxDataEnd) { if (auxDataPtr->type->freeProc != NULL) { auxDataPtr->type->freeProc(auxDataPtr->clientData); } auxDataPtr++; } envPtr->auxDataArrayNext = savedAuxDataArrayNext; } envPtr->currStackDepth = savedStackDepth; envPtr->codeNext = envPtr->codeStart + savedCodeNext; #ifdef TCL_COMPILE_DEBUG } else { /* * Confirm that the command compiler generated a single value on * the stack as its result. This is only done in debugging mode, * as it *should* be correct and normal users have no reasonable * way to fix it anyway. */ int diff = envPtr->currStackDepth - savedStackDepth; if (diff != 1) { Tcl_Panic("bad stack adjustment when compiling" " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, diff); } #endif } return result; } /* * How to compile a subcommand to a _replacing_ invoke of its implementation * command. */ static void CompileToInvokedCommand( Tcl_Interp *interp, Tcl_Parse *parsePtr, Tcl_Obj *replacements, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; Tcl_Token *tokPtr; Tcl_Obj *objPtr, **words; char *bytes; int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME; /* * Push the words of the command. Take care; the command words may be * scripts that have backslashes in them, and [info frame 0] can see the * difference. Hence the call to TclContinuationsEnterDerived... */ TclListObjGetElements(NULL, replacements, &numWords, &words); for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i < numWords+1) { bytes = Tcl_GetStringFromObj(words[i-1], &length); PushLiteral(envPtr, bytes, length); continue; } SetLineInformation(i); if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) { int literal = TclRegisterNewLiteral(envPtr, tokPtr[1].start, tokPtr[1].size); if (envPtr->clNext) { TclContinuationsEnterDerived( TclFetchLiteral(envPtr, literal), tokPtr[1].start - envPtr->source, envPtr->clNext); } TclEmitPush(literal, envPtr); } else { CompileTokens(envPtr, tokPtr, interp); } } /* * Push the name of the command we're actually dispatching to as part of * the implementation. */ TclNewObj(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); bytes = Tcl_GetStringFromObj(objPtr, &length); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } cmdLit = TclRegisterLiteral(envPtr, (char *)bytes, length, extraLiteralFlags); TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); /* * Do the replacing dispatch. */ TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1); } /* * Helpers that do issuing of instructions for commands that "don't have * compilers" (well, they do; these). They all work by just generating base * code to invoke the command; they're intended for ensemble subcommands so * that the costs of INST_INVOKE_REPLACE can be avoided where we can work out * that they're not needed. * * Note that these are NOT suitable for commands where there's an argument * that is a script, as an [info level] or [info frame] in the inner context * can see the difference. */ static int CompileBasicNArgCommand( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr, parsePtr->numWords, envPtr); Tcl_DecrRefCount(objPtr); return TCL_OK; } int TclCompileBasic0ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords != 1) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasic1ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords != 2) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasic2ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasic3ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords != 4) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasic0Or1ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords != 1 && parsePtr->numWords != 2) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasic1Or2ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasic2Or3ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords != 3 && parsePtr->numWords != 4) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasic0To2ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords < 1 || parsePtr->numWords > 3) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasic1To3ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasicMin0ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords < 1) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasicMin1ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords < 2) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } int TclCompileBasicMin2ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to definition of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Verify that the number of arguments is correct; that's the only case * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, * which is the only code that sees the shenanigans of ensemble dispatch. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclEnv.c0000644000175000017500000005304614554262142014665 0ustar sergeisergei/* * tclEnv.c -- * * Tcl support for environment variables, including a setenv function. * This file contains the generic portion of the environment module. It * is primarily responsible for keeping the "env" arrays in sync with the * system environment variables. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) # define tenviron _wenviron # define tenviron2utfdstr(str, dsPtr) \ Tcl_WinTCharToUtf((TCHAR *)str, -1, dsPtr) # define utf2tenvirondstr(str, dsPtr) \ (const WCHAR *)Tcl_WinUtfToTChar(str, -1, dsPtr) # define techar WCHAR # ifdef USE_PUTENV # define putenv(env) _wputenv((const wchar_t *)env) # endif #else # define tenviron environ # define tenviron2utfdstr(str, dsPtr) \ Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) # define utf2tenvirondstr(str, dsPtr) \ Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) # define techar char #endif /* MODULE_SCOPE */ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ 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 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. */ int ourEnvironSize; /* Non-zero means that the environ array was * malloced and has this many total entries * allocated to it (not all may be in use at * once). Zero means that the environment * array is in its original static state. */ #endif } env; #define tNTL sizeof(techar) /* * Declarations for local functions defined in this file: */ static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void ReplaceString(const char *oldStr, char *newStr); MODULE_SCOPE void TclSetEnv(const char *name, const char *value); MODULE_SCOPE void TclUnsetEnv(const char *name); /* *---------------------------------------------------------------------- * * TclSetupEnv -- * * This function is invoked for an interpreter to make environment * variables accessible from that interpreter via the "env" associative * array. * * Results: * None. * * Side effects: * The interpreter is added to a list of interpreters managed by us, so * that its view of envariables can be kept consistent with the view in * other interpreters. If this is the first call to TclSetupEnv, then * additional initialization happens, such as copying the environment to * dynamically-allocated space for ease of management. * *---------------------------------------------------------------------- */ void 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; /* * 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. */ 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); #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 * of existing elements, so that after this part processes, that table * will hold just the parts to remove. */ if (tenviron[0] != NULL) { int i; Tcl_MutexLock(&envMutex); for (i = 0; tenviron[i] != NULL; i++) { Tcl_Obj *obj1, *obj2; const char *p1; char *p2; p1 = tenviron2utfdstr(tenviron[i], &envString); p2 = (char *)strchr(p1, '='); if (p2 == NULL) { /* * This condition seem to happen occasionally under some * versions of Solaris, or when encoding accidents swallow the * '='; ignore the entry. */ Tcl_DStringFree(&envString); continue; } p2++; p2[-1] = '\0'; #if defined(_WIN32) /* * Enforce PATH and COMSPEC to be all uppercase. This eliminates * additional trace logic otherwise required in init.tcl. */ if (strcasecmp(p1, "PATH") == 0) { p1 = "PATH"; } else if (strcasecmp(p1, "COMSPEC") == 0) { p1 = "COMSPEC"; } #endif obj1 = Tcl_NewStringObj(p1, -1); obj2 = Tcl_NewStringObj(p2, -1); 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_Obj *)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); } /* *---------------------------------------------------------------------- * * TclSetEnv -- * * Set an environment variable, replacing an existing value or creating a * new variable if there doesn't exist a variable by the given name. This * function is intended to be a stand-in for the UNIX "setenv" function * so that applications using that function will interface properly to * Tcl. To make it a stand-in, the Makefile must define "TclSetEnv" to * "setenv". * * Results: * None. * * Side effects: * The environ array gets updated. * *---------------------------------------------------------------------- */ void TclSetEnv( const char *name, /* Name of variable whose value is to be set * (UTF-8). */ const char *value) /* New value for variable (UTF-8). */ { Tcl_DString envString; unsigned nameLength, valueLength; int index, length; char *p, *oldValue; const techar *p2; /* * Figure out where the entry is going to go. If the name doesn't already * exist, enlarge the array if necessary to make room. If the name exists, * free its old entry. */ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); if (index == -1) { #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed * outside our control. ourEnvironSize is only valid if the current * environment is the one we allocated. [Bug 979640] */ if ((env.ourEnviron != tenviron) || (length+2 > env.ourEnvironSize)) { techar **newEnviron = (techar **)ckalloc((length + 5) * sizeof(techar *)); memcpy(newEnviron, tenviron, length * sizeof(techar *)); if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) { ckfree(env.ourEnviron); } tenviron = (env.ourEnviron = newEnviron); env.ourEnvironSize = length + 5; } index = length; tenviron[index + 1] = NULL; #endif /* USE_PUTENV */ oldValue = NULL; nameLength = strlen(name); } else { const char *oldEnv; /* * Compare the new value to the existing value. If they're the same * then quit immediately (e.g. don't rewrite the value or propagate it * to other interpreters). Otherwise, when there are N interpreters * there will be N! propagations of the same value among the * interpreters. */ oldEnv = tenviron2utfdstr(tenviron[index], &envString); if (strcmp(value, oldEnv + (length + 1)) == 0) { Tcl_DStringFree(&envString); Tcl_MutexUnlock(&envMutex); return; } Tcl_DStringFree(&envString); oldValue = (char *)tenviron[index]; nameLength = length; } /* * Create a new entry. Build a complete UTF string that contains a * "name=value" pattern. Then convert the string to the native encoding, * and set the environ array value. */ valueLength = strlen(value); p = (char *)ckalloc(nameLength + valueLength + 2); memcpy(p, name, nameLength); p[nameLength] = '='; memcpy(p+nameLength+1, value, valueLength+1); p2 = utf2tenvirondstr(p, &envString); /* * Copy the native string to heap memory. */ p = (char *)ckrealloc(p, Tcl_DStringLength(&envString) + tNTL); memcpy(p, p2, Tcl_DStringLength(&envString) + tNTL); Tcl_DStringFree(&envString); #ifdef USE_PUTENV /* * Update the system environment. */ putenv(p); index = TclpFindVariable(name, &length); #else tenviron[index] = (techar *)p; #endif /* USE_PUTENV */ /* * Watch out for versions of putenv that copy the string (e.g. VC++). In * this case we need to free the string immediately. Otherwise update the * string in the cache. */ if ((index != -1) && (tenviron[index] == (techar *)p)) { ReplaceString(oldValue, p); #ifdef HAVE_PUTENV_THAT_COPIES } else { /* * This putenv() copies instead of taking ownership. */ ckfree(p); #endif /* HAVE_PUTENV_THAT_COPIES */ } Tcl_MutexUnlock(&envMutex); if (!strcmp(name, "HOME")) { /* * If the user's home directory has changed, we must invalidate the * filesystem cache, because '~' expansions will now be incorrect. */ Tcl_FSMountsChanged(NULL); } } /* *---------------------------------------------------------------------- * * Tcl_PutEnv -- * * Set an environment variable. Similar to setenv except that the * information is passed in a single string of the form NAME=value, * rather than as separate name strings. This function is intended to be * a stand-in for the UNIX "putenv" function so that applications using * that function will interface properly to Tcl. To make it a stand-in, * the Makefile will define "Tcl_PutEnv" to "putenv". * * Results: * None. * * Side effects: * The environ array gets updated, as do all of the interpreters that we * manage. * *---------------------------------------------------------------------- */ int Tcl_PutEnv( const char *assignment) /* Info about environment variable in the form * NAME=value. (native) */ { Tcl_DString nameString; const char *name; char *value; if (assignment == NULL) { return 0; } /* * First convert the native string to Utf. Then separate the string into * name and value parts, and call TclSetEnv to do all of the real work. */ name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString); value = (char *)strchr(name, '='); if ((value != NULL) && (value != name)) { value[0] = '\0'; #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 TclSetEnv(name, value+1); } TclEnvEpoch++; Tcl_DStringFree(&nameString); return 0; } /* *---------------------------------------------------------------------- * * TclUnsetEnv -- * * Remove an environment variable, updating the "env" arrays in all * interpreters managed by us. This function is intended to replace the * UNIX "unsetenv" function (but to do this the Makefile must be modified * to redefine "TclUnsetEnv" to "unsetenv". * * Results: * None. * * Side effects: * Interpreters are updated, as is environ. * *---------------------------------------------------------------------- */ void TclUnsetEnv( const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; int length, index; #ifdef USE_PUTENV_FOR_UNSET Tcl_DString envString; char *string; #else char **envPtr; #endif /* USE_PUTENV_FOR_UNSET */ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); /* * First make sure that the environment variable exists to avoid doing * needless work and to avoid recursion on the unset. */ if (index == -1) { Tcl_MutexUnlock(&envMutex); return; } /* * Remember the old value so we can free it if Tcl created the string. */ oldValue = (char *)tenviron[index]; /* * Update the system environment. This must be done before we update the * interpreters or we will recurse. */ #ifdef USE_PUTENV_FOR_UNSET /* * For those platforms that support putenv to unset, Linux indicates * that no = should be included, and Windows requires it. */ #if defined(_WIN32) string = (char *)ckalloc(length + 2); memcpy(string, name, length); string[length] = '='; string[length+1] = '\0'; #else string = (char *)ckalloc(length + 1); memcpy(string, name, length); string[length] = '\0'; #endif /* _WIN32 */ utf2tenvirondstr(string, &envString); string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + tNTL); memcpy(string, Tcl_DStringValue(&envString), Tcl_DStringLength(&envString) + tNTL); Tcl_DStringFree(&envString); putenv(string); /* * Watch out for versions of putenv that copy the string (e.g. VC++). In * this case we need to free the string immediately. Otherwise update the * string in the cache. */ if (tenviron[index] == (techar *)string) { ReplaceString(oldValue, string); #ifdef HAVE_PUTENV_THAT_COPIES } else { /* * This putenv() copies instead of taking ownership. */ ckfree(string); #endif /* HAVE_PUTENV_THAT_COPIES */ } #else /* !USE_PUTENV_FOR_UNSET */ for (envPtr = (char **)(tenviron+index+1); ; envPtr++) { envPtr[-1] = *envPtr; if (*envPtr == NULL) { break; } } ReplaceString(oldValue, NULL); #endif /* USE_PUTENV_FOR_UNSET */ Tcl_MutexUnlock(&envMutex); } /* *--------------------------------------------------------------------------- * * TclGetEnv -- * * Retrieve the value of an environment variable. * * Results: * The result is a pointer to a string specifying the value of the * environment variable, or NULL if that environment variable does not * exist. Storage for the result string is allocated in valuePtr; the * caller must call Tcl_DStringFree() when the result is no longer * needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * TclGetEnv( const char *name, /* Name of environment variable to find * (UTF-8). */ Tcl_DString *valuePtr) /* Uninitialized or free DString in which the * value of the environment variable is * stored. */ { int length, index; const char *result; Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); result = NULL; if (index != -1) { Tcl_DString envStr; result = tenviron2utfdstr(tenviron[index], &envStr); result += length; if (*result == '=') { result++; Tcl_DStringInit(valuePtr); Tcl_DStringAppend(valuePtr, result, -1); result = Tcl_DStringValue(valuePtr); } else { result = NULL; } Tcl_DStringFree(&envStr); } Tcl_MutexUnlock(&envMutex); return result; } /* *---------------------------------------------------------------------- * * EnvTraceProc -- * * This function is invoked whenever an environment variable is read, * modified or deleted. It propagates the change to the global "environ" * array. * * Results: * Returns NULL to indicate success, or an error-message if the array * element being handled doesn't exist. * * Side effects: * Environment variable changes get propagated. If the whole "env" array * is deleted, then we stop managing things for this interpreter (usually * this happens because the whole interpreter is being deleted). * *---------------------------------------------------------------------- */ static char * EnvTraceProc( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter whose "env" variable is being * modified. */ const char *name1, /* Better be "env". */ const char *name2, /* Name of variable being modified, or NULL if * whole array is being deleted (UTF-8). */ int flags) /* Indicates what's happening. */ { /* * For array traces, let TclSetupEnv do all the work. */ if (flags & TCL_TRACE_ARRAY) { TclSetupEnv(interp); TclEnvEpoch++; return NULL; } /* * If name2 is NULL, then return and do nothing. */ if (name2 == NULL) { return NULL; } /* * If a value is being set, call TclSetEnv to do all of the work. */ if (flags & TCL_TRACE_WRITES) { const char *value; value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); TclEnvEpoch++; } /* * If a value is being read, call TclGetEnv to do all of the work. */ if (flags & TCL_TRACE_READS) { Tcl_DString valueString; const char *value = TclGetEnv(name2, &valueString); if (value == NULL) { return (char *) "no such variable"; } Tcl_SetVar2(interp, name1, name2, value, 0); Tcl_DStringFree(&valueString); } /* * For unset traces, let TclUnsetEnv do all the work. */ if (flags & TCL_TRACE_UNSETS) { TclUnsetEnv(name2); TclEnvEpoch++; } return NULL; } /* *---------------------------------------------------------------------- * * ReplaceString -- * * Replace one string with another in the environment variable cache. The * cache keeps track of all of the environment variables that Tcl has * modified so they can be freed later. * * Results: * None. * * Side effects: * May free the old string. * *---------------------------------------------------------------------- */ static void ReplaceString( const char *oldStr, /* Old environment string. */ char *newStr) /* New environment string. */ { int i; /* * Check to see if the old value was allocated by Tcl. If so, it needs to * be deallocated to avoid memory leaks. Note that this algorithm is O(n), * not O(1). This will result in n-squared behavior if lots of environment * changes are being made. */ for (i = 0; i < env.cacheSize; i++) { if (env.cache[i]==oldStr || env.cache[i]==NULL) { break; } } if (i < env.cacheSize) { /* * Replace or delete the old value. */ if (env.cache[i]) { ckfree(env.cache[i]); } if (newStr) { env.cache[i] = newStr; } else { for (; i < env.cacheSize-1; i++) { env.cache[i] = env.cache[i+1]; } env.cache[env.cacheSize-1] = NULL; } } else { /* * We need to grow the cache in order to hold the new string. */ const int growth = 5; env.cache = (char **)ckrealloc(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 *)); env.cacheSize += growth; } } /* *---------------------------------------------------------------------- * * TclFinalizeEnvironment -- * * This function releases any storage allocated by this module that isn't * still in use by the global environment. Any strings that are still in * the environment will be leaked. * * Results: * None. * * Side effects: * May deallocate storage. * *---------------------------------------------------------------------- */ void TclFinalizeEnvironment(void) { /* * For now we just deallocate the cache array and none of the environment * strings. This may leak more memory that strictly necessary, since some * of the strings may no longer be in the environment. However, * determining which ones are ok to delete is n-squared, and is pretty * unlikely, so we don't bother. However, in the case of DPURIFY, just * free all strings in the cache. */ if (env.cache) { #ifdef PURIFY int i; for (i = 0; i < env.cacheSize; i++) { ckfree(env.cache[i]); } #endif ckfree(env.cache); env.cache = NULL; env.cacheSize = 0; #ifndef USE_PUTENV if ((env.ourEnviron != NULL)) { ckfree(env.ourEnviron); env.ourEnviron = NULL; } env.ourEnvironSize = 0; #endif } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclEvent.c0000644000175000017500000012621014554262142015210 0ustar sergeisergei/* * tclEvent.c -- * * This file implements some general event related interfaces including * background errors, exit handlers, and the "vwait" and "update" command * functions. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 2004 by Zoran Vasiljevic. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * The data structure below is used to report background errors. One such * structure is allocated for each error; it holds information about the * interpreter and the error until an idle handler command can be invoked. */ typedef struct BgError { Tcl_Obj *errorMsg; /* Copy of the error message (the interp's * result when the error occurred). */ Tcl_Obj *returnOpts; /* Active return options when the error * occurred */ struct BgError *nextPtr; /* Next in list of all pending error reports * for this interpreter, or NULL for end of * list. */ } BgError; /* * One of the structures below is associated with the "tclBgError" assoc data * for each interpreter. It keeps track of the head and tail of the list of * pending background errors for the interpreter. */ typedef struct { Tcl_Interp *interp; /* Interpreter in which error occurred. */ Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */ BgError *firstBgPtr; /* First in list of all background errors * waiting to be processed for this * interpreter (NULL if none). */ BgError *lastBgPtr; /* Last in list of all background errors * waiting to be processed for this * interpreter (NULL if none). */ } ErrAssocData; /* * For each exit handler created with a call to Tcl_Create(Late)ExitHandler * there is a structure of the following type: */ typedef struct ExitHandler { Tcl_ExitProc *proc; /* Function to call when process exits. */ ClientData clientData; /* One word of information to pass to proc. */ struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this * application, or NULL for end of list. */ } ExitHandler; /* * There is both per-process and per-thread exit handlers. The first list is * controlled by a mutex. The other is in thread local storage. */ static ExitHandler *firstExitPtr = NULL; /* First in list of all exit handlers for * application. */ static ExitHandler *firstLateExitPtr = NULL; /* First in list of all late exit handlers for * application. */ TCL_DECLARE_MUTEX(exitMutex) /* * This variable is set to 1 when Tcl_Exit is called. The variable is checked * by TclInExit() to allow different behavior for exit-time processing, e.g., * in closing of files and pipes. */ static int inExit = 0; static int subsystemsInitialized = 0; /* * This variable contains the application wide exit handler. It will be called * by Tcl_Exit instead of the C-runtime exit if this variable is set to a * non-NULL value. */ static TCL_NORETURN1 Tcl_ExitProc *appExitPtr = NULL; typedef struct ThreadSpecificData { ExitHandler *firstExitPtr; /* First in list of all exit handlers for this * thread. */ int inExit; /* True when this thread is exiting. This is * used as a hack to decide to close the * standard channels. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #ifdef TCL_THREADS typedef struct { Tcl_ThreadCreateProc *proc; /* Main() function of the thread */ ClientData clientData; /* The one argument to Main() */ } ThreadClientData; static Tcl_ThreadCreateType NewThreadProc(ClientData clientData); #endif /* TCL_THREADS */ /* * Prototypes for functions referenced only in this file: */ static void BgErrorDeleteProc(ClientData clientData, Tcl_Interp *interp); static void HandleBgErrors(ClientData clientData); static char * VwaitVarProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void InvokeExitHandlers(void); static void FinalizeThread(int quick); /* *---------------------------------------------------------------------- * * Tcl_BackgroundError -- * * This function is invoked to handle errors that occur in Tcl commands * that are invoked in "background" (e.g. from event or timer bindings). * * Results: * None. * * Side effects: * A handler command is invoked later as an idle handler to process the * error, passing it the interp result and return options. * *---------------------------------------------------------------------- */ void Tcl_BackgroundError( Tcl_Interp *interp) /* Interpreter in which an error has * occurred. */ { Tcl_BackgroundException(interp, TCL_ERROR); } void Tcl_BackgroundException( Tcl_Interp *interp, /* Interpreter in which an exception has * occurred. */ int code) /* The exception code value */ { BgError *errPtr; ErrAssocData *assocPtr; if (code == TCL_OK) { return; } errPtr = (BgError*)ckalloc(sizeof(BgError)); errPtr->errorMsg = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errPtr->errorMsg); errPtr->returnOpts = Tcl_GetReturnOptions(interp, code); Tcl_IncrRefCount(errPtr->returnOpts); errPtr->nextPtr = NULL; (void) TclGetBgErrorHandler(interp); assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL); if (assocPtr->firstBgPtr == NULL) { assocPtr->firstBgPtr = errPtr; Tcl_DoWhenIdle(HandleBgErrors, assocPtr); } else { assocPtr->lastBgPtr->nextPtr = errPtr; } assocPtr->lastBgPtr = errPtr; Tcl_ResetResult(interp); } /* *---------------------------------------------------------------------- * * HandleBgErrors -- * * This function is invoked as an idle handler to process all of the * accumulated background errors. * * Results: * None. * * Side effects: * Depends on what actions the handler command takes for the errors. * *---------------------------------------------------------------------- */ static void HandleBgErrors( ClientData clientData) /* Pointer to ErrAssocData structure. */ { ErrAssocData *assocPtr = (ErrAssocData *)clientData; Tcl_Interp *interp = assocPtr->interp; BgError *errPtr; /* * Not bothering to save/restore the interp state. Assume that any code * that has interp state it needs to keep will make its own * Tcl_SaveInterpState call before calling something like Tcl_DoOneEvent() * that could lead us here. */ Tcl_Preserve(assocPtr); Tcl_Preserve(interp); while (assocPtr->firstBgPtr != NULL) { int code, prefixObjc; Tcl_Obj **prefixObjv, **tempObjv; /* * Note we copy the handler command prefix each pass through, so we do * support one handler setting another handler. */ Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); errPtr = assocPtr->firstBgPtr; TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; tempObjv[prefixObjc+1] = errPtr->returnOpts; Tcl_AllowExceptions(interp); code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL); /* * Discard the command and the information about the error report. */ Tcl_DecrRefCount(copyObj); Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); assocPtr->firstBgPtr = errPtr->nextPtr; ckfree(errPtr); ckfree(tempObjv); if (code == TCL_BREAK) { /* * Break means cancel any remaining error reports for this * interpreter. */ while (assocPtr->firstBgPtr != NULL) { errPtr = assocPtr->firstBgPtr; assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); ckfree(errPtr); } } else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel != NULL) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); Tcl_Obj *keyPtr, *valuePtr = NULL; TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); Tcl_WriteChars(errChannel, "error in background error handler:\n", -1); if (valuePtr) { Tcl_WriteObj(errChannel, valuePtr); } else { Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); } Tcl_WriteChars(errChannel, "\n", 1); Tcl_Flush(errChannel); Tcl_DecrRefCount(options); } } } assocPtr->lastBgPtr = NULL; Tcl_Release(interp); Tcl_Release(assocPtr); } /* *---------------------------------------------------------------------- * * TclDefaultBgErrorHandlerObjCmd -- * * This function is invoked to process the "::tcl::Bgerror" Tcl command. * It is the default handler command registered with [interp bgerror] for * the sake of compatibility with older Tcl releases. * * Results: * A standard Tcl object result. * * Side effects: * Depends on what actions the "bgerror" command takes for the errors. * *---------------------------------------------------------------------- */ int TclDefaultBgErrorHandlerObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *keyPtr, *valuePtr; Tcl_Obj *tempObjv[2]; int result, code, level; Tcl_InterpState saved; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "msg options"); return TCL_ERROR; } /* * Check for a valid return options dictionary. */ TclNewLiteralStringObj(keyPtr, "-level"); Tcl_IncrRefCount(keyPtr); result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (result != TCL_OK || valuePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing return option \"-level\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) { return TCL_ERROR; } TclNewLiteralStringObj(keyPtr, "-code"); Tcl_IncrRefCount(keyPtr); result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (result != TCL_OK || valuePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing return option \"-code\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) { return TCL_ERROR; } if (level != 0) { /* * We're handling a TCL_RETURN exception. */ code = TCL_RETURN; } if (code == TCL_OK) { /* * Somehow we got to exception handling with no exception. (Pass * TCL_OK to Tcl_BackgroundException()?) Just return without doing * anything. */ return TCL_OK; } /* * Construct the bgerror command. */ TclNewLiteralStringObj(tempObjv[0], "bgerror"); Tcl_IncrRefCount(tempObjv[0]); /* * Determine error message argument. Check the return options in case * a non-error exception brought us here. */ switch (code) { case TCL_ERROR: tempObjv[1] = objv[1]; break; case TCL_BREAK: TclNewLiteralStringObj(tempObjv[1], "invoked \"break\" outside of a loop"); break; case TCL_CONTINUE: TclNewLiteralStringObj(tempObjv[1], "invoked \"continue\" outside of a loop"); break; default: tempObjv[1] = Tcl_ObjPrintf("command returned bad code: %d", code); break; } Tcl_IncrRefCount(tempObjv[1]); if (code != TCL_ERROR) { Tcl_SetObjResult(interp, tempObjv[1]); } TclNewLiteralStringObj(keyPtr, "-errorcode"); Tcl_IncrRefCount(keyPtr); result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (result == TCL_OK && valuePtr != NULL) { Tcl_SetObjErrorCode(interp, valuePtr); } TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (result == TCL_OK && valuePtr != NULL) { Tcl_AppendObjToErrorInfo(interp, valuePtr); } if (code == TCL_ERROR) { Tcl_SetObjResult(interp, tempObjv[1]); } /* * Save interpreter state so we can restore it if multiple handler * attempts are needed. */ saved = Tcl_SaveInterpState(interp, code); /* * Invoke the bgerror command. */ Tcl_AllowExceptions(interp); code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL); if (code == TCL_ERROR) { /* * If the interpreter is safe, we look for a hidden command named * "bgerror" and call that with the error information. Otherwise, * simply ignore the error. The rationale is that this could be an * error caused by a malicious applet trying to cause an infinite * barrage of error messages. The hidden "bgerror" command can be used * by a security policy to interpose on such attacks and e.g. kill the * applet after a few attempts. */ if (Tcl_IsSafe(interp)) { Tcl_RestoreInterpState(interp, saved); TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN); } else { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel != NULL) { Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); if (Tcl_FindCommand(interp, "bgerror", NULL, TCL_GLOBAL_ONLY) == NULL) { Tcl_RestoreInterpState(interp, saved); Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY)); Tcl_WriteChars(errChannel, "\n", -1); } else { Tcl_DiscardInterpState(saved); Tcl_WriteChars(errChannel, "bgerror failed to handle background error.\n",-1); Tcl_WriteChars(errChannel, " Original error: ", -1); Tcl_WriteObj(errChannel, tempObjv[1]); Tcl_WriteChars(errChannel, "\n", -1); Tcl_WriteChars(errChannel, " Error in bgerror: ", -1); Tcl_WriteObj(errChannel, resultPtr); Tcl_WriteChars(errChannel, "\n", -1); } Tcl_DecrRefCount(resultPtr); Tcl_Flush(errChannel); } else { Tcl_DiscardInterpState(saved); } } code = TCL_OK; } else { Tcl_DiscardInterpState(saved); } Tcl_DecrRefCount(tempObjv[0]); Tcl_DecrRefCount(tempObjv[1]); Tcl_ResetResult(interp); return code; } /* *---------------------------------------------------------------------- * * TclSetBgErrorHandler -- * * This function sets the command prefix to be used to handle background * errors in interp. * * Results: * None. * * Side effects: * Error handler is registered. * *---------------------------------------------------------------------- */ void TclSetBgErrorHandler( Tcl_Interp *interp, Tcl_Obj *cmdPrefix) { ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL); if (cmdPrefix == NULL) { Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument"); } if (assocPtr == NULL) { /* * First access: initialize. */ assocPtr = (ErrAssocData*)ckalloc(sizeof(ErrAssocData)); assocPtr->interp = interp; assocPtr->cmdPrefix = NULL; assocPtr->firstBgPtr = NULL; assocPtr->lastBgPtr = NULL; Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr); } if (assocPtr->cmdPrefix) { Tcl_DecrRefCount(assocPtr->cmdPrefix); } assocPtr->cmdPrefix = cmdPrefix; Tcl_IncrRefCount(assocPtr->cmdPrefix); } /* *---------------------------------------------------------------------- * * TclGetBgErrorHandler -- * * This function retrieves the command prefix currently used to handle * background errors in interp. * * Results: * A (Tcl_Obj *) to a list of words (command prefix). * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetBgErrorHandler( Tcl_Interp *interp) { ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL); if (assocPtr == NULL) { Tcl_Obj *bgerrorObj; TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror"); TclSetBgErrorHandler(interp, bgerrorObj); assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL); } return assocPtr->cmdPrefix; } /* *---------------------------------------------------------------------- * * BgErrorDeleteProc -- * * This function is associated with the "tclBgError" assoc data for an * interpreter; it is invoked when the interpreter is deleted in order to * free the information associated with any pending error reports. * * Results: * None. * * Side effects: * Background error information is freed: if there were any pending error * reports, they are canceled. * *---------------------------------------------------------------------- */ static void BgErrorDeleteProc( ClientData clientData, /* Pointer to ErrAssocData structure. */ Tcl_Interp *interp) /* Interpreter being deleted. */ { ErrAssocData *assocPtr = (ErrAssocData *)clientData; BgError *errPtr; while (assocPtr->firstBgPtr != NULL) { errPtr = assocPtr->firstBgPtr; assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); ckfree(errPtr); } Tcl_CancelIdleCall(HandleBgErrors, assocPtr); Tcl_DecrRefCount(assocPtr->cmdPrefix); Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC); } /* *---------------------------------------------------------------------- * * Tcl_CreateExitHandler -- * * Arrange for a given function to be invoked just before the application * exits. * * Results: * None. * * Side effects: * Proc will be invoked with clientData as argument when the application * exits. * *---------------------------------------------------------------------- */ void Tcl_CreateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; Tcl_MutexLock(&exitMutex); exitPtr->nextPtr = firstExitPtr; firstExitPtr = exitPtr; Tcl_MutexUnlock(&exitMutex); } /* *---------------------------------------------------------------------- * * TclCreateLateExitHandler -- * * Arrange for a given function to be invoked after all pre-thread * cleanups. * * Results: * None. * * Side effects: * Proc will be invoked with clientData as argument when the application * exits. * *---------------------------------------------------------------------- */ void TclCreateLateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; Tcl_MutexLock(&exitMutex); exitPtr->nextPtr = firstLateExitPtr; firstLateExitPtr = exitPtr; Tcl_MutexUnlock(&exitMutex); } /* *---------------------------------------------------------------------- * * Tcl_DeleteExitHandler -- * * This function cancels an existing exit handler matching proc and * clientData, if such a handler exits. * * Results: * None. * * Side effects: * If there is an exit handler corresponding to proc and clientData then * it is canceled; if no such handler exists then nothing happens. * *---------------------------------------------------------------------- */ void Tcl_DeleteExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; Tcl_MutexLock(&exitMutex); for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL; prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) { if ((exitPtr->proc == proc) && (exitPtr->clientData == clientData)) { if (prevPtr == NULL) { firstExitPtr = exitPtr->nextPtr; } else { prevPtr->nextPtr = exitPtr->nextPtr; } ckfree(exitPtr); break; } } Tcl_MutexUnlock(&exitMutex); return; } /* *---------------------------------------------------------------------- * * TclDeleteLateExitHandler -- * * This function cancels an existing late exit handler matching proc and * clientData, if such a handler exits. * * Results: * None. * * Side effects: * If there is a late exit handler corresponding to proc and clientData * then it is canceled; if no such handler exists then nothing happens. * *---------------------------------------------------------------------- */ void TclDeleteLateExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; Tcl_MutexLock(&exitMutex); for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL; prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) { if ((exitPtr->proc == proc) && (exitPtr->clientData == clientData)) { if (prevPtr == NULL) { firstLateExitPtr = exitPtr->nextPtr; } else { prevPtr->nextPtr = exitPtr->nextPtr; } ckfree(exitPtr); break; } } Tcl_MutexUnlock(&exitMutex); return; } /* *---------------------------------------------------------------------- * * Tcl_CreateThreadExitHandler -- * * Arrange for a given function to be invoked just before the current * thread exits. * * Results: * None. * * Side effects: * Proc will be invoked with clientData as argument when the application * exits. * *---------------------------------------------------------------------- */ void Tcl_CreateThreadExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; exitPtr->nextPtr = tsdPtr->firstExitPtr; tsdPtr->firstExitPtr = exitPtr; } /* *---------------------------------------------------------------------- * * Tcl_DeleteThreadExitHandler -- * * This function cancels an existing exit handler matching proc and * clientData, if such a handler exits. * * Results: * None. * * Side effects: * If there is an exit handler corresponding to proc and clientData then * it is canceled; if no such handler exists then nothing happens. * *---------------------------------------------------------------------- */ void Tcl_DeleteThreadExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL; prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) { if ((exitPtr->proc == proc) && (exitPtr->clientData == clientData)) { if (prevPtr == NULL) { tsdPtr->firstExitPtr = exitPtr->nextPtr; } else { prevPtr->nextPtr = exitPtr->nextPtr; } ckfree(exitPtr); return; } } } /* *---------------------------------------------------------------------- * * Tcl_SetExitProc -- * * This function sets the application wide exit handler that will be * called by Tcl_Exit in place of the C-runtime exit. If the application * wide exit handler is NULL, the C-runtime exit will be used instead. * * Results: * The previously set application wide exit handler. * * Side effects: * Sets the application wide exit handler to the specified value. * *---------------------------------------------------------------------- */ Tcl_ExitProc * Tcl_SetExitProc( TCL_NORETURN1 Tcl_ExitProc *proc) /* New exit handler for app or NULL */ { Tcl_ExitProc *prevExitProc; /* * Swap the old exit proc for the new one, saving the old one for our * return value. */ Tcl_MutexLock(&exitMutex); prevExitProc = appExitPtr; appExitPtr = proc; Tcl_MutexUnlock(&exitMutex); return prevExitProc; } /* *---------------------------------------------------------------------- * * InvokeExitHandlers -- * * Call the registered exit handlers. * * Results: * None. * * Side effects: * The exit handlers are invoked, and the ExitHandler struct is * freed. * *---------------------------------------------------------------------- */ static void InvokeExitHandlers(void) { ExitHandler *exitPtr; Tcl_MutexLock(&exitMutex); inExit = 1; for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { /* * Be careful to remove the handler from the list before invoking its * callback. This protects us against double-freeing if the callback * should call Tcl_DeleteExitHandler on itself. */ firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); ckfree(exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); } /* *---------------------------------------------------------------------- * * Tcl_Exit -- * * This function is called to terminate the application. * * Results: * None. * * Side effects: * All existing exit handlers are invoked, then the application ends. * *---------------------------------------------------------------------- */ TCL_NORETURN void Tcl_Exit( int status) /* Exit status for application; typically 0 * for normal return, 1 for error return. */ { TCL_NORETURN1 Tcl_ExitProc *currentAppExitPtr; Tcl_MutexLock(&exitMutex); currentAppExitPtr = appExitPtr; Tcl_MutexUnlock(&exitMutex); /* * Warning: this function SHOULD NOT return, as there is code that depends * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone * returns, so critical is this dependency. * * If subsystems are not (yet) initialized, proper Tcl-finalization is * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2]. */ if (currentAppExitPtr) { currentAppExitPtr(INT2PTR(status)); } else if (subsystemsInitialized) { if (TclFullFinalizationRequested()) { /* * Thorough finalization for Valgrind et al. */ Tcl_Finalize(); } else { /* * Fast and deterministic exit (default behavior) */ InvokeExitHandlers(); /* * Ensure the thread-specific data is initialised as it is used in * Tcl_FinalizeThread() */ (void) TCL_TSD_INIT(&dataKey); /* * Now finalize the calling thread only (others are not safely * reachable). Among other things, this triggers a flush of the * Tcl_Channels that may have data enqueued. */ FinalizeThread(/* quick */ 1); } } TclpExit(status); Tcl_Panic("OS exit failed!"); } /* *------------------------------------------------------------------------- * * TclInitSubsystems -- * * Initialize various subsytems in Tcl. This should be called the first * time an interp is created, or before any of the subsystems are used. * This function ensures an order for the initialization of subsystems: * * 1. that cannot be initialized in lazy order because they are mutually * dependent. * * 2. so that they can be finalized in a known order w/o causing the * subsequent re-initialization of a subsystem in the act of shutting * down another. * * Results: * The full Tcl version. * * Side effects: * Varied, see the respective initialization routines. * *------------------------------------------------------------------------- */ MODULE_SCOPE const TclStubs tclStubs; static const struct { const TclStubs *stubs; const char version[256]; } stubInfo = { &tclStubs, {TCL_PATCH_LEVEL} }; const char * TclInitSubsystems(void) { if (inExit != 0) { Tcl_Panic("TclInitSubsystems called while exiting"); } if (subsystemsInitialized == 0) { /* * Double check inside the mutex. There are definitely calls back into * this routine from some of the functions below. */ TclpInitLock(); if (subsystemsInitialized == 0) { /* * Initialize locks used by the memory allocators before anything * interesting happens so we can use the allocators in the * implementation of self-initializing locks. */ TclInitThreadStorage(); /* Creates hash table for * thread local storage */ #if defined(USE_TCLALLOC) && USE_TCLALLOC TclInitAlloc(); /* Process wide mutex init */ #endif #ifdef TCL_MEM_DEBUG TclInitDbCkalloc(); /* Process wide mutex init */ #endif TclpInitPlatform(); /* Creates signal handler(s) */ TclInitDoubleConversion(); /* Initializes constants for * converting to/from double. */ TclInitObjSubsystem(); /* Register obj types, create * mutexes. */ TclInitIOSubsystem(); /* Inits a tsd key (noop). */ TclInitEncodingSubsystem(); /* Process wide encoding init. */ TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ subsystemsInitialized = 1; } TclpInitUnlock(); } TclInitNotifier(); return stubInfo.version; } /* *---------------------------------------------------------------------- * * Tcl_Finalize -- * * Shut down Tcl. First calls registered exit handlers, then carefully * shuts down various subsystems. Should be invoked by user before the * Tcl shared library is being unloaded in an embedded context. * * Results: * None. * * Side effects: * Varied, see the respective finalization routines. * *---------------------------------------------------------------------- */ void Tcl_Finalize(void) { ExitHandler *exitPtr; /* * Invoke exit handlers first. */ InvokeExitHandlers(); TclpInitLock(); if (subsystemsInitialized == 0) { goto alreadyFinalized; } subsystemsInitialized = 0; /* * Ensure the thread-specific data is initialised as it is used in * Tcl_FinalizeThread() */ (void) TCL_TSD_INIT(&dataKey); /* * Clean up after the current thread now, after exit handlers. In * particular, the testexithandler command sets up something that writes * to standard output, which gets closed. Note that there is no * thread-local storage or IO subsystem after this call. */ Tcl_FinalizeThread(); /* * Now invoke late (process-wide) exit handlers. */ Tcl_MutexLock(&exitMutex); for (exitPtr = firstLateExitPtr; exitPtr != NULL; exitPtr = firstLateExitPtr) { /* * Be careful to remove the handler from the list before invoking its * callback. This protects us against double-freeing if the callback * should call Tcl_DeleteLateExitHandler on itself. */ firstLateExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); ckfree(exitPtr); Tcl_MutexLock(&exitMutex); } firstLateExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); /* * Now finalize the Tcl execution environment. Note that this must be done * after the exit handlers, because there are order dependencies. */ TclFinalizeEvaluation(); TclFinalizeExecution(); TclFinalizeEnvironment(); /* * Finalizing the filesystem must come after anything which might * conceivably interact with the 'Tcl_FS' API. */ TclFinalizeFilesystem(); /* * Undo all Tcl_ObjType registrations, and reset the global list of free * Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or * freed. * * Note in particular that TclFinalizeObjects() must follow * TclFinalizeFilesystem() because TclFinalizeFilesystem free's the * Tcl_Obj that holds the path of the current working directory. */ TclFinalizeObjects(); /* * We must be sure the encoding finalization doesn't need to examine the * filesystem in any way. Since it only needs to clean up internal data * structures, this is fine. */ TclFinalizeEncodingSubsystem(); /* * Repeat finalization of the thread local storage once more. Although * this step is already done by the Tcl_FinalizeThread call above, series * of events happening afterwards may re-initialize TSD slots. Those need * to be finalized again, otherwise we're leaking memory chunks. Very * important to note is that things happening afterwards should not * reference anything which may re-initialize TSD's. This includes freeing * Tcl_Objs's, among other things. * * This fixes the Tcl Bug #990552. */ TclFinalizeThreadData(/* quick */ 0); /* * Now we can free constants for conversions to/from double. */ TclFinalizeDoubleConversion(); /* * There have been several bugs in the past that cause exit handlers to be * established during Tcl_Finalize processing. Such exit handlers leave * malloc'ed memory, and Tcl_FinalizeMemorySubsystem or * Tcl_FinalizeThreadAlloc will result in a corrupted heap. The result can * be a mysterious crash on process exit. Check here that nobody's done * this. */ if (firstExitPtr != NULL) { Tcl_Panic("exit handlers were created during Tcl_Finalize"); } TclFinalizePreserve(); /* * Free synchronization objects. There really should only be one thread * alive at this moment. */ TclFinalizeSynchronization(); /* * Close down the thread-specific object allocator. */ #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) TclFinalizeThreadAlloc(); #endif /* * We defer unloading of packages until very late to avoid memory access * issues. Both exit callbacks and synchronization variables may be stored * in packages. * * Note that TclFinalizeLoad unloads packages in the reverse of the order * they were loaded in (i.e. last to be loaded is the first to be * unloaded). This can be important for correct unloading when * dependencies exist. * * Once load has been finalized, we will have deleted any temporary copies * of shared libraries and can therefore reset the filesystem to its * original state. */ TclFinalizeLoad(); TclResetFilesystem(); /* * At this point, there should no longer be any ckalloc'ed memory. */ TclFinalizeMemorySubsystem(); alreadyFinalized: TclFinalizeLock(); } /* *---------------------------------------------------------------------- * * Tcl_FinalizeThread -- * * Runs the exit handlers to allow Tcl to clean up its state about a * particular thread. * * Results: * None. * * Side effects: * Varied, see the respective finalization routines. * *---------------------------------------------------------------------- */ void Tcl_FinalizeThread(void) { FinalizeThread(/* quick */ 0); } void FinalizeThread( int quick) { ExitHandler *exitPtr; ThreadSpecificData *tsdPtr; /* * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because * we don't want to initialize the data block if it hasn't been * initialized already. */ tsdPtr = (ThreadSpecificData*)TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { tsdPtr->inExit = 1; for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL; exitPtr = tsdPtr->firstExitPtr) { /* * Be careful to remove the handler from the list before invoking * its callback. This protects us against double-freeing if the * callback should call Tcl_DeleteThreadExitHandler on itself. */ tsdPtr->firstExitPtr = exitPtr->nextPtr; exitPtr->proc(exitPtr->clientData); ckfree(exitPtr); } TclFinalizeIOSubsystem(); TclFinalizeNotifier(); TclFinalizeAsync(); TclFinalizeThreadObjects(); } /* * Blow away all thread local storage blocks. * * Note that Tcl API allows creation of threads which do not use any Tcl * interp or other Tcl subsytems. Those threads might, however, use thread * local storage, so we must unconditionally finalize it. * * Fix [Bug #571002] */ TclFinalizeThreadData(quick); } /* *---------------------------------------------------------------------- * * TclInExit -- * * Determines if we are in the middle of exit-time cleanup. * * Results: * If we are in the middle of exiting, 1, otherwise 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclInExit(void) { return inExit; } /* *---------------------------------------------------------------------- * * TclInThreadExit -- * * Determines if we are in the middle of thread exit-time cleanup. * * Results: * If we are in the middle of exiting this thread, 1, otherwise 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclInThreadExit(void) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { return 0; } return tsdPtr->inExit; } /* *---------------------------------------------------------------------- * * Tcl_VwaitObjCmd -- * * This function is invoked to process the "vwait" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_VwaitObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int done, foundEvent; const char *nameString; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } nameString = Tcl_GetString(objv[1]); if (Tcl_TraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, &done) != TCL_OK) { return TCL_ERROR; }; done = 0; foundEvent = 1; while (!done && foundEvent) { foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS); if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { break; } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); break; } } Tcl_UntraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, &done); if (!foundEvent) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't wait for variable \"%s\": would wait forever", nameString)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); return TCL_ERROR; } if (!done) { /* * The interpreter's result was already set to the right error message * prior to exiting the loop above. */ return TCL_ERROR; } /* * Clear out the interpreter's result, since it may have been set by event * handlers. */ Tcl_ResetResult(interp); return TCL_OK; } static char * VwaitVarProc( ClientData clientData, /* Pointer to integer to set to 1. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable. */ const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { int *donePtr = (int *)clientData; *donePtr = 1; Tcl_UntraceVar2(interp, name1, name2, TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, clientData); return NULL; } /* *---------------------------------------------------------------------- * * Tcl_UpdateObjCmd -- * * This function is invoked to process the "update" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_UpdateObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int optionIndex; int flags = 0; /* Initialized to avoid compiler warning. */ static const char *const updateOptions[] = {"idletasks", NULL}; enum updateOptionsEnum {OPT_IDLETASKS}; if (objc == 1) { flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; } else if (objc == 2) { if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum updateOptionsEnum) optionIndex) { case OPT_IDLETASKS: flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT; break; default: Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions"); } } else { Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); return TCL_ERROR; } while (Tcl_DoOneEvent(flags) != 0) { if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { return TCL_ERROR; } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); return TCL_ERROR; } } /* * Must clear the interpreter's result because event handlers could have * executed commands. */ Tcl_ResetResult(interp); return TCL_OK; } #ifdef TCL_THREADS /* *---------------------------------------------------------------------- * * NewThreadProc -- * * Bootstrap function of a new Tcl thread. * * Results: * None. * * Side Effects: * Initializes Tcl notifier for the current thread. * *---------------------------------------------------------------------- */ static Tcl_ThreadCreateType NewThreadProc( ClientData clientData) { ThreadClientData *cdPtr = (ThreadClientData *)clientData; ClientData threadClientData; Tcl_ThreadCreateProc *threadProc; threadProc = cdPtr->proc; threadClientData = cdPtr->clientData; ckfree(clientData); /* Allocated in Tcl_CreateThread() */ threadProc(threadClientData); TCL_THREAD_CREATE_RETURN; } #endif /* *---------------------------------------------------------------------- * * Tcl_CreateThread -- * * This function creates a new thread. This actually belongs to the * tclThread.c file but since we use some private data structures local * to this file, it is placed here. * * Results: * TCL_OK if the thread could be created. The thread ID is returned in a * parameter. * * Side effects: * A new thread is created. * *---------------------------------------------------------------------- */ int Tcl_CreateThread( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ ClientData clientData, /* The one argument to Main() */ int stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { #ifdef TCL_THREADS ThreadClientData *cdPtr = (ThreadClientData *)ckalloc(sizeof(ThreadClientData)); int result; cdPtr->proc = proc; cdPtr->clientData = clientData; result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags); if (result != TCL_OK) { ckfree(cdPtr); } return result; #else (void)idPtr; (void)proc; (void)clientData; (void)stackSize; (void)flags; return TCL_ERROR; #endif /* TCL_THREADS */ } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclExecute.c0000644000175000017500000110132314565156356015543 0ustar sergeisergei/* * tclExecute.c -- * * This file contains procedures that execute byte-compiled Tcl commands. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * Copyright (c) 2001 Kevin B. Kenny. All rights reserved. * Copyright (c) 2002-2010 Miguel Sofer. * Copyright (c) 2005-2007 Donal K. Fellows. * Copyright (c) 2007 Daniel A. Steffen * Copyright (c) 2006-2008 Joe Mistachkin. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include "tclOOInt.h" #include "tommath.h" #include #include /* * Hack to determine whether we may expect IEEE floating point. The hack is * formally incorrect in that non-IEEE platforms might have the same precision * and range, but VAX, IBM, and Cray do not; are there any other floating * point units that we might care about? */ #if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024) #define IEEE_FLOATING_POINT #endif /* * A mask (should be 2**n-1) that is used to work out when the bytecode engine * should call Tcl_AsyncReady() to see whether there is a signal that needs * handling. */ #ifndef ASYNC_CHECK_COUNT_MASK # define ASYNC_CHECK_COUNT_MASK 63 #endif /* !ASYNC_CHECK_COUNT_MASK */ /* * Boolean flag indicating whether the Tcl bytecode interpreter has been * initialized. */ static int execInitialized = 0; TCL_DECLARE_MUTEX(execMutex) static int cachedInExit = 0; #ifdef TCL_COMPILE_DEBUG /* * Variable that controls whether execution tracing is enabled and, if so, * what level of tracing is desired: * 0: no execution tracing * 1: trace invocations of Tcl procs only * 2: trace invocations of all (not compiled away) commands * 3: display each instruction executed * This variable is linked to the Tcl variable "tcl_traceExec". */ int tclTraceExec = 0; #endif /* * Mapping from expression instruction opcodes to strings; used for error * messages. Note that these entries must match the order and number of the * expression opcodes (e.g., INST_LOR) in tclCompile.h. * * Does not include the string for INST_EXPON (and beyond), as that is * disjoint for backward-compatibility reasons. */ static const char *const operatorStrings[] = { "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", "+", "-", "*", "/", "%", "+", "-", "~", "!" }; /* * Mapping from Tcl result codes to strings; used for error and debugging * messages. */ #ifdef TCL_COMPILE_DEBUG static const char *const resultStrings[] = { "TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE" }; #endif /* * These are used by evalstats to monitor object usage in Tcl. */ #ifdef TCL_COMPILE_STATS long tclObjsAlloced = 0; long tclObjsFreed = 0; long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ /* * Support pre-8.5 bytecodes unless specifically requested otherwise. */ #ifndef TCL_SUPPORT_84_BYTECODE #define TCL_SUPPORT_84_BYTECODE 1 #endif #if TCL_SUPPORT_84_BYTECODE /* * We need to know the tclBuiltinFuncTable to support translation of pre-8.5 * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+. */ typedef struct { const char *name; /* Name of function. */ int numArgs; /* Number of arguments for function. */ } BuiltinFunc; /* * Table describing the built-in math functions. Entries in this table are * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's * operand byte. */ static BuiltinFunc const tclBuiltinFuncTable[] = { {"acos", 1}, {"asin", 1}, {"atan", 1}, {"atan2", 2}, {"ceil", 1}, {"cos", 1}, {"cosh", 1}, {"exp", 1}, {"floor", 1}, {"fmod", 2}, {"hypot", 2}, {"log", 1}, {"log10", 1}, {"pow", 2}, {"sin", 1}, {"sinh", 1}, {"sqrt", 1}, {"tan", 1}, {"tanh", 1}, {"abs", 1}, {"double", 1}, {"int", 1}, {"rand", 0}, {"round", 1}, {"srand", 1}, {"wide", 1}, {NULL, 0}, }; #define LAST_BUILTIN_FUNC 25 #endif /* * NR_TEBC * Helpers for NR - non-recursive calls to TEBC * Minimal data required to fully reconstruct the execution state. */ typedef struct TEBCdata { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ ptrdiff_t *catchTop; /* These fields are used on return TO this */ Tcl_Obj *auxObjList; /* this level: they record the state when a */ CmdFrame cmdFrame; /* new codePtr was received for NR */ /* execution. */ void *stack[1]; /* Start of the actual combined catch and obj * stacks; the struct will be expanded as * necessary */ } TEBCdata; #define TEBC_YIELD() \ do { \ esPtr->tosPtr = tosPtr; \ TclNRAddCallback(interp, TEBCresume, \ TD, pc, INT2PTR(cleanup), NULL); \ } while (0) #define TEBC_DATA_DIG() \ do { \ tosPtr = esPtr->tosPtr; \ } while (0) #define PUSH_TAUX_OBJ(objPtr) \ do { \ if (auxObjList) { \ (objPtr)->length += auxObjList->length; \ } \ (objPtr)->internalRep.twoPtrValue.ptr1 = auxObjList; \ auxObjList = (objPtr); \ } while (0) #define POP_TAUX_OBJ() \ do { \ tmpPtr = auxObjList; \ auxObjList = tmpPtr->internalRep.twoPtrValue.ptr1; \ Tcl_DecrRefCount(tmpPtr); \ } while (0) /* * These variable-access macros have to coincide with those in tclVar.c */ #define VarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) static inline Var * VarHashCreateVar( TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr) { Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table, key, newPtr); if (!hPtr) { return NULL; } return VarHashGetValue(hPtr); } #define VarHashFindVar(tablePtr, key) \ VarHashCreateVar((tablePtr), (key), NULL) /* * The new macro for ending an instruction; note that a reasonable C-optimiser * will resolve all branches at compile time. (result) is always a constant; * the macro NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is resolved * at runtime for variable (nCleanup). * * ARGUMENTS: * pcAdjustment: how much to increment pc * nCleanup: how many objects to remove from the stack * resultHandling: 0 indicates no object should be pushed on the stack; * otherwise, push objResultPtr. If (result < 0), objResultPtr already * has the correct reference count. * * We use the new compile-time assertions to check that nCleanup is constant * and within range. */ /* Verify the stack depth, only when no expansion is in progress */ #ifdef TCL_COMPILE_DEBUG #define CHECK_STACK() \ do { \ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \ /*checkStack*/ !(starting || auxObjList)); \ starting = 0; \ } while (0) #else #define CHECK_STACK() #endif #define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ do { \ TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ CHECK_STACK(); \ if (nCleanup == 0) { \ if (resultHandling != 0) { \ if ((resultHandling) > 0) { \ PUSH_OBJECT(objResultPtr); \ } else { \ *(++tosPtr) = objResultPtr; \ } \ } \ pc += (pcAdjustment); \ goto cleanup0; \ } else if (resultHandling != 0) { \ if ((resultHandling) > 0) { \ Tcl_IncrRefCount(objResultPtr); \ } \ pc += (pcAdjustment); \ switch (nCleanup) { \ case 1: goto cleanup1_pushObjResultPtr; \ case 2: goto cleanup2_pushObjResultPtr; \ case 0: break; \ } \ } else { \ pc += (pcAdjustment); \ switch (nCleanup) { \ case 1: goto cleanup1; \ case 2: goto cleanup2; \ case 0: break; \ } \ } \ } while (0) #define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ CHECK_STACK(); \ do { \ pc += (pcAdjustment); \ cleanup = (nCleanup); \ if (resultHandling) { \ if ((resultHandling) > 0) { \ Tcl_IncrRefCount(objResultPtr); \ } \ goto cleanupV_pushObjResultPtr; \ } else { \ goto cleanupV; \ } \ } while (0) #ifndef TCL_COMPILE_DEBUG #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ break; \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ break; \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ break; \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ break; \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ break; \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ break; \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ break; \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F((pcAdjustment), (cleanup), 1); \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V((pcAdjustment), (cleanup), 1); \ } while (0) #endif /* * Macros used to cache often-referenced Tcl evaluation stack information * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO() * pair must surround any call inside TclNRExecuteByteCode (and a few other * procedures that use this scheme) that could result in a recursive call * to TclNRExecuteByteCode. */ #define CACHE_STACK_INFO() \ checkInterp = 1 #define DECACHE_STACK_INFO() \ esPtr->tosPtr = tosPtr /* * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT * increments the object's ref count since it makes the stack have another * reference pointing to the object. However, POP_OBJECT does not decrement * the ref count. This is because the stack may hold the only reference to the * object, so the object would be destroyed if its ref count were decremented * before the caller had a chance to, e.g., store it in a variable. It is the * caller's responsibility to decrement the ref count when it is finished with * an object. * * WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT * macro. The actual parameter might be an expression with side effects, and * this ensures that it will be executed only once. */ #define PUSH_OBJECT(objPtr) \ Tcl_IncrRefCount(*(++tosPtr) = (objPtr)) #define POP_OBJECT() *(tosPtr--) #define OBJ_AT_TOS *tosPtr #define OBJ_UNDER_TOS *(tosPtr-1) #define OBJ_AT_DEPTH(n) *(tosPtr-(n)) #define CURR_DEPTH ((ptrdiff_t) (tosPtr - initTosPtr)) #define STACK_BASE(esPtr) ((esPtr)->stackWords - 1) /* * Macros used to trace instruction execution. The macros TRACE, * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is * only used in TRACE* calls to get a string from an object. */ #ifdef TCL_COMPILE_DEBUG # define TRACE(a) \ while (traceInstructions) { \ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \ (int) CURR_DEPTH, \ (unsigned) (pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ printf a; \ break; \ } # define TRACE_APPEND(a) \ while (traceInstructions) { \ printf a; \ break; \ } # define TRACE_ERROR(interp) \ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); # define TRACE_WITH_OBJ(a, objPtr) \ while (traceInstructions) { \ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \ (int) CURR_DEPTH, \ (unsigned) (pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ printf a; \ TclPrintObject(stdout, objPtr, 30); \ fprintf(stdout, "\n"); \ break; \ } # define O2S(objPtr) \ (objPtr ? TclGetString(objPtr) : "") #else /* !TCL_COMPILE_DEBUG */ # define TRACE(a) # define TRACE_APPEND(a) # define TRACE_ERROR(interp) # define TRACE_WITH_OBJ(a, objPtr) # define O2S(objPtr) #endif /* TCL_COMPILE_DEBUG */ /* * DTrace instruction probe macros. */ #define TCL_DTRACE_INST_NEXT() \ do { \ if (TCL_DTRACE_INST_DONE_ENABLED()) { \ if (curInstName) { \ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, \ tosPtr); \ } \ curInstName = tclInstructionTable[*pc].name; \ if (TCL_DTRACE_INST_START_ENABLED()) { \ TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, \ tosPtr); \ } \ } else if (TCL_DTRACE_INST_START_ENABLED()) { \ TCL_DTRACE_INST_START(tclInstructionTable[*pc].name, \ (int) CURR_DEPTH, tosPtr); \ } \ } while (0) #define TCL_DTRACE_INST_LAST() \ do { \ if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) { \ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\ } \ } while (0) /* * Macro used in this file to save a function call for common uses of * TclGetNumberFromObj(). The ANSI C "prototype" is: * * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, * ClientData *ptrPtr, int *tPtr); */ #ifdef TCL_WIDE_INT_IS_LONG #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(tPtr) = TCL_NUMBER_LONG, \ *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.longValue)), TCL_OK) : \ ((objPtr)->typePtr == &tclDoubleType) \ ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \ ? (*(tPtr) = TCL_NUMBER_NAN) \ : (*(tPtr) = TCL_NUMBER_DOUBLE)), \ *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \ ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) #else /* !TCL_WIDE_INT_IS_LONG */ #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(tPtr) = TCL_NUMBER_LONG, \ *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.longValue)), TCL_OK) : \ ((objPtr)->typePtr == &tclWideIntType) \ ? (*(tPtr) = TCL_NUMBER_WIDE, \ *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ ((objPtr)->typePtr == &tclDoubleType) \ ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \ ? (*(tPtr) = TCL_NUMBER_NAN) \ : (*(tPtr) = TCL_NUMBER_DOUBLE)), \ *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \ ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) #endif /* TCL_WIDE_INT_IS_LONG */ /* * Macro used in this file to save a function call for common uses of * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is: * * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, * int *intPtr); */ #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ ((((objPtr)->typePtr == &tclIntType) \ || ((objPtr)->typePtr == &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) /* * Macro used to make the check for type overflow more mnemonic. This works by * comparing sign bits; the rest of the word is irrelevant. The ANSI C * "prototype" (where inttype_t is any integer type) is: * * MODULE_SCOPE int Overflowing(inttype_t a, inttype_t b, inttype_t sum); * * Check first the condition most likely to fail in usual code (at least for * usage in [incr]: do the first summand and the sum have != signs? */ #define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) /* * Macro for checking whether the type is NaN, used when we're thinking about * throwing an error for supplying a non-number number. */ #ifndef ACCEPT_NAN #define IsErroringNaNType(type) ((type) == TCL_NUMBER_NAN) #else #define IsErroringNaNType(type) 0 #endif /* * Auxiliary tables used to compute powers of small integers. */ #if (LONG_MAX == 0x7FFFFFFF) /* * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit * signed integer. */ static const long MaxBase32[] = {46340, 1290, 215, 73, 35, 21, 14}; static const size_t MaxBase32Size = sizeof(MaxBase32)/sizeof(long); /* * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of * powers of i+3; Exp32Value[i] gives the corresponding powers. */ static const unsigned short Exp32Index[] = { 0, 11, 18, 23, 26, 29, 31, 32, 33 }; static const size_t Exp32IndexSize = sizeof(Exp32Index) / sizeof(unsigned short); static const long Exp32Value[] = { 19683, 59049, 177147, 531441, 1594323, 4782969, 14348907, 43046721, 129140163, 387420489, 1162261467, 262144, 1048576, 4194304, 16777216, 67108864, 268435456, 1073741824, 1953125, 9765625, 48828125, 244140625, 1220703125, 10077696, 60466176, 362797056, 40353607, 282475249, 1977326743, 134217728, 1073741824, 387420489, 1000000000 }; static const size_t Exp32ValueSize = sizeof(Exp32Value)/sizeof(long); #endif /* LONG_MAX == 0x7FFFFFFF -- 32 bit machine */ #if (LONG_MAX > 0x7FFFFFFF) || !defined(TCL_WIDE_INT_IS_LONG) /* * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a * Tcl_WideInt. */ static const Tcl_WideInt MaxBase64[] = { (Tcl_WideInt)46340*65536+62259, /* 3037000499 == isqrt(2**63-1) */ (Tcl_WideInt)2097151, (Tcl_WideInt)55108, (Tcl_WideInt)6208, (Tcl_WideInt)1448, (Tcl_WideInt)511, (Tcl_WideInt)234, (Tcl_WideInt)127, (Tcl_WideInt)78, (Tcl_WideInt)52, (Tcl_WideInt)38, (Tcl_WideInt)28, (Tcl_WideInt)22, (Tcl_WideInt)18, (Tcl_WideInt)15 }; static const size_t MaxBase64Size = sizeof(MaxBase64)/sizeof(Tcl_WideInt); /* * Table giving 3, 4, ..., 13 raised to powers greater than 16 when the * results fit in a 64-bit signed integer. */ static const unsigned short Exp64Index[] = { 0, 23, 38, 49, 57, 63, 67, 70, 72, 74, 75, 76 }; static const size_t Exp64IndexSize = sizeof(Exp64Index) / sizeof(unsigned short); static const Tcl_WideInt Exp64Value[] = { (Tcl_WideInt)243*243*243*3*3, (Tcl_WideInt)243*243*243*3*3*3, (Tcl_WideInt)243*243*243*3*3*3*3, (Tcl_WideInt)243*243*243*243, (Tcl_WideInt)243*243*243*243*3, (Tcl_WideInt)243*243*243*243*3*3, (Tcl_WideInt)243*243*243*243*3*3*3, (Tcl_WideInt)243*243*243*243*3*3*3*3, (Tcl_WideInt)243*243*243*243*243, (Tcl_WideInt)243*243*243*243*243*3, (Tcl_WideInt)243*243*243*243*243*3*3, (Tcl_WideInt)243*243*243*243*243*3*3*3, (Tcl_WideInt)243*243*243*243*243*3*3*3*3, (Tcl_WideInt)243*243*243*243*243*243, (Tcl_WideInt)243*243*243*243*243*243*3, (Tcl_WideInt)243*243*243*243*243*243*3*3, (Tcl_WideInt)243*243*243*243*243*243*3*3*3, (Tcl_WideInt)243*243*243*243*243*243*3*3*3*3, (Tcl_WideInt)243*243*243*243*243*243*243, (Tcl_WideInt)243*243*243*243*243*243*243*3, (Tcl_WideInt)243*243*243*243*243*243*243*3*3, (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3, (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3*3, (Tcl_WideInt)1024*1024*1024*4*4, (Tcl_WideInt)1024*1024*1024*4*4*4, (Tcl_WideInt)1024*1024*1024*4*4*4*4, (Tcl_WideInt)1024*1024*1024*1024, (Tcl_WideInt)1024*1024*1024*1024*4, (Tcl_WideInt)1024*1024*1024*1024*4*4, (Tcl_WideInt)1024*1024*1024*1024*4*4*4, (Tcl_WideInt)1024*1024*1024*1024*4*4*4*4, (Tcl_WideInt)1024*1024*1024*1024*1024, (Tcl_WideInt)1024*1024*1024*1024*1024*4, (Tcl_WideInt)1024*1024*1024*1024*1024*4*4, (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4, (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4*4, (Tcl_WideInt)1024*1024*1024*1024*1024*1024, (Tcl_WideInt)1024*1024*1024*1024*1024*1024*4, (Tcl_WideInt)3125*3125*3125*5*5, (Tcl_WideInt)3125*3125*3125*5*5*5, (Tcl_WideInt)3125*3125*3125*5*5*5*5, (Tcl_WideInt)3125*3125*3125*3125, (Tcl_WideInt)3125*3125*3125*3125*5, (Tcl_WideInt)3125*3125*3125*3125*5*5, (Tcl_WideInt)3125*3125*3125*3125*5*5*5, (Tcl_WideInt)3125*3125*3125*3125*5*5*5*5, (Tcl_WideInt)3125*3125*3125*3125*3125, (Tcl_WideInt)3125*3125*3125*3125*3125*5, (Tcl_WideInt)3125*3125*3125*3125*3125*5*5, (Tcl_WideInt)7776*7776*7776*6*6, (Tcl_WideInt)7776*7776*7776*6*6*6, (Tcl_WideInt)7776*7776*7776*6*6*6*6, (Tcl_WideInt)7776*7776*7776*7776, (Tcl_WideInt)7776*7776*7776*7776*6, (Tcl_WideInt)7776*7776*7776*7776*6*6, (Tcl_WideInt)7776*7776*7776*7776*6*6*6, (Tcl_WideInt)7776*7776*7776*7776*6*6*6*6, (Tcl_WideInt)16807*16807*16807*7*7, (Tcl_WideInt)16807*16807*16807*7*7*7, (Tcl_WideInt)16807*16807*16807*7*7*7*7, (Tcl_WideInt)16807*16807*16807*16807, (Tcl_WideInt)16807*16807*16807*16807*7, (Tcl_WideInt)16807*16807*16807*16807*7*7, (Tcl_WideInt)32768*32768*32768*8*8, (Tcl_WideInt)32768*32768*32768*8*8*8, (Tcl_WideInt)32768*32768*32768*8*8*8*8, (Tcl_WideInt)32768*32768*32768*32768, (Tcl_WideInt)59049*59049*59049*9*9, (Tcl_WideInt)59049*59049*59049*9*9*9, (Tcl_WideInt)59049*59049*59049*9*9*9*9, (Tcl_WideInt)100000*100000*100000*10*10, (Tcl_WideInt)100000*100000*100000*10*10*10, (Tcl_WideInt)161051*161051*161051*11*11, (Tcl_WideInt)161051*161051*161051*11*11*11, (Tcl_WideInt)248832*248832*248832*12*12, (Tcl_WideInt)371293*371293*371293*13*13 }; static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt); #endif /* (LONG_MAX > 0x7FFFFFFF) || !defined(TCL_WIDE_INT_IS_LONG) */ /* * Markers for ExecuteExtendedBinaryMathOp. */ #define DIVIDED_BY_ZERO ((Tcl_Obj *) -1) #define EXPONENT_OF_ZERO ((Tcl_Obj *) -2) #define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3) /* * Declarations for local procedures to this file: */ #ifdef TCL_COMPILE_STATS static int EvalStatsCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG static const char * GetOpcodeName(const unsigned char *pc); static void PrintByteCodeInfo(ByteCode *codePtr); static const char * StringForResultCode(int result); static void ValidatePcAndStackTop(ByteCode *codePtr, const unsigned char *pc, int stackTop, int checkStack); #endif /* TCL_COMPILE_DEBUG */ static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void DeleteExecStack(ExecStack *esPtr); static void DupExprCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr); static Tcl_Obj * ExecuteExtendedBinaryMathOp(Tcl_Interp *interp, int opcode, Tcl_Obj **constants, Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr); static Tcl_Obj * ExecuteExtendedUnaryMathOp(int opcode, Tcl_Obj *valuePtr); static void FreeExprCodeInternalRep(Tcl_Obj *objPtr); static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc, int searchMode, ByteCode *codePtr); static const char * GetSrcInfoForPc(const unsigned char *pc, ByteCode *codePtr, int *lengthPtr, const unsigned char **pcBeg, int *cmdIdxPtr); static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, int move); static void IllegalExprOperandType(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj *opndPtr); static void InitByteCodeExecution(Tcl_Interp *interp); static inline int wordSkip(void *ptr); static void ReleaseDictIterator(Tcl_Obj *objPtr); /* Useful elsewhere, make available in tclInt.h or stubs? */ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); static Tcl_NRPostProc CopyCallback; static Tcl_NRPostProc ExprObjCallback; static Tcl_NRPostProc FinalizeOONext; static Tcl_NRPostProc FinalizeOONextFilter; static Tcl_NRPostProc TEBCresume; /* * The structure below defines a bytecode Tcl object type to hold the * compiled bytecode for Tcl expressions. */ static const Tcl_ObjType exprCodeType = { "exprcode", FreeExprCodeInternalRep, /* freeIntRepProc */ DupExprCodeInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL /* setFromAnyProc */ }; /* * Custom object type only used in this file; values of its type should never * be seen by user scripts. */ static const Tcl_ObjType dictIteratorType = { "dictIterator", ReleaseDictIterator, NULL, NULL, NULL }; /* *---------------------------------------------------------------------- * * ReleaseDictIterator -- * * This takes apart a dictionary iterator that is stored in the given Tcl * object. * * Results: * None. * * Side effects: * Deallocates memory, marks the object as being untyped. * *---------------------------------------------------------------------- */ static void ReleaseDictIterator( Tcl_Obj *objPtr) { Tcl_DictSearch *searchPtr; Tcl_Obj *dictPtr; /* * First kill the search, and then release the reference to the dictionary * that we were holding. */ searchPtr = (Tcl_DictSearch *)objPtr->internalRep.twoPtrValue.ptr1; Tcl_DictObjDone(searchPtr); ckfree(searchPtr); dictPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr2; TclDecrRefCount(dictPtr); objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * InitByteCodeExecution -- * * This procedure is called once to initialize the Tcl bytecode * interpreter. * * Results: * None. * * Side effects: * This procedure initializes the array of instruction names. If * compiling with the TCL_COMPILE_STATS flag, it initializes the array * that counts the executions of each instruction and it creates the * "evalstats" command. It also establishes the link between the Tcl * "tcl_traceExec" and C "tclTraceExec" variables. * *---------------------------------------------------------------------- */ static void InitByteCodeExecution( Tcl_Interp *interp) /* Interpreter for which the Tcl variable * "tcl_traceExec" is linked to control * instruction tracing. */ { #ifdef TCL_COMPILE_DEBUG if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec, TCL_LINK_INT) != TCL_OK) { Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable"); } #endif #ifdef TCL_COMPILE_STATS Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, NULL, NULL); #endif /* TCL_COMPILE_STATS */ } /* *---------------------------------------------------------------------- * * TclCreateExecEnv -- * * This procedure creates a new execution environment for Tcl bytecode * execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv is * typically created once for each Tcl interpreter (Interp structure) and * recursively passed to TclNRExecuteByteCode to execute ByteCode sequences * for nested commands. * * Results: * A newly allocated ExecEnv is returned. This points to an empty * evaluation stack of the standard initial size. * * Side effects: * The bytecode interpreter is also initialized here, as this procedure * will be called before any call to TclNRExecuteByteCode. * *---------------------------------------------------------------------- */ ExecEnv * TclCreateExecEnv( Tcl_Interp *interp, /* Interpreter for which the execution * environment is being created. */ int size) /* The initial stack size, in number of words * [sizeof(Tcl_Obj*)] */ { ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv)); ExecStack *esPtr = (ExecStack *)ckalloc(TclOffset(ExecStack, stackWords) + size * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; TclNewBooleanObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); TclNewBooleanObj(eePtr->constants[1], 1); Tcl_IncrRefCount(eePtr->constants[1]); eePtr->interp = interp; eePtr->callbackPtr = NULL; eePtr->corPtr = NULL; eePtr->rewind = 0; esPtr->prevPtr = NULL; esPtr->nextPtr = NULL; esPtr->markerPtr = NULL; esPtr->endPtr = &esPtr->stackWords[size-1]; esPtr->tosPtr = STACK_BASE(esPtr); Tcl_MutexLock(&execMutex); if (!execInitialized) { InitByteCodeExecution(interp); execInitialized = 1; } Tcl_MutexUnlock(&execMutex); return eePtr; } /* *---------------------------------------------------------------------- * * TclDeleteExecEnv -- * * Frees the storage for an ExecEnv. * * Results: * None. * * Side effects: * Storage for an ExecEnv and its contained storage (e.g. the evaluation * stack) is freed. * *---------------------------------------------------------------------- */ static void DeleteExecStack( ExecStack *esPtr) { if (esPtr->markerPtr && !cachedInExit) { Tcl_Panic("freeing an execStack which is still in use"); } if (esPtr->prevPtr) { esPtr->prevPtr->nextPtr = esPtr->nextPtr; } if (esPtr->nextPtr) { esPtr->nextPtr->prevPtr = esPtr->prevPtr; } ckfree(esPtr); } void TclDeleteExecEnv( ExecEnv *eePtr) /* Execution environment to free. */ { ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr; cachedInExit = TclInExit(); /* * Delete all stacks in this exec env. */ while (esPtr->nextPtr) { esPtr = esPtr->nextPtr; } while (esPtr) { tmpPtr = esPtr; esPtr = tmpPtr->prevPtr; DeleteExecStack(tmpPtr); } TclDecrRefCount(eePtr->constants[0]); TclDecrRefCount(eePtr->constants[1]); if (eePtr->callbackPtr && !cachedInExit) { Tcl_Panic("Deleting execEnv with pending TEOV callbacks!"); } if (eePtr->corPtr && !cachedInExit) { Tcl_Panic("Deleting execEnv with existing coroutine"); } ckfree(eePtr); } /* *---------------------------------------------------------------------- * * TclFinalizeExecution -- * * Finalizes the execution environment setup so that it can be later * reinitialized. * * Results: * None. * * Side effects: * After this call, the next time TclCreateExecEnv will be called it will * call InitByteCodeExecution. * *---------------------------------------------------------------------- */ void TclFinalizeExecution(void) { Tcl_MutexLock(&execMutex); execInitialized = 0; Tcl_MutexUnlock(&execMutex); } /* * Auxiliary code to insure that GrowEvaluationStack always returns correctly * aligned memory. * * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a * multiple of the wordsize 'sizeof(Tcl_Obj *)'. */ #define WALLOCALIGN \ (TCL_ALLOCALIGN/sizeof(Tcl_Obj *)) /* * wordSkip computes how many words have to be skipped until the next aligned * word. Note that we are only interested in the low order bits of ptr, so * that any possible information loss in PTR2INT is of no consequence. */ static inline int wordSkip( void *ptr) { int mask = TCL_ALLOCALIGN-1; int base = PTR2INT(ptr) & mask; return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *); } /* * Given a marker, compute where the following aligned memory starts. */ #define MEMSTART(markerPtr) \ ((markerPtr) + wordSkip(markerPtr)) /* *---------------------------------------------------------------------- * * GrowEvaluationStack -- * * This procedure grows a Tcl evaluation stack stored in an ExecEnv, * copying over the words since the last mark if so requested. A mark is * set at the beginning of the new area when no copying is requested. * * Results: * Returns a pointer to the first usable word in the (possibly) grown * stack. * * Side effects: * The size of the evaluation stack may be grown, a marker is set * *---------------------------------------------------------------------- */ static Tcl_Obj ** GrowEvaluationStack( ExecEnv *eePtr, /* Points to the ExecEnv with an evaluation * stack to enlarge. */ int growth, /* How much larger than the current used * size. */ int move) /* 1 if move words since last marker. */ { ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL; int newBytes, newElems, currElems; int needed = growth - (esPtr->endPtr - esPtr->tosPtr); Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart; int moveWords = 0; if (move) { if (!markerPtr) { Tcl_Panic("STACK: Reallocating with no previous alloc"); } if (needed <= 0) { return MEMSTART(markerPtr); } } else { #ifndef PURIFY Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1; int offset = wordSkip(tmpMarkerPtr); if (needed + offset < 0) { /* * Put a marker pointing to the previous marker in this stack, and * store it in esPtr as the current marker. Return a pointer to * the start of aligned memory. */ esPtr->markerPtr = tmpMarkerPtr; memStart = tmpMarkerPtr + offset; esPtr->tosPtr = memStart - 1; *esPtr->markerPtr = (Tcl_Obj *) markerPtr; return memStart; } #endif } /* * Reset move to hold the number of words to be moved to new stack (if * any) and growth to hold the complete stack requirements: add one for * the marker, (WALLOCALIGN-1) for the maximal possible offset. */ if (move) { moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1; } needed = growth + moveWords + WALLOCALIGN; /* * Check if there is enough room in the next stack (if there is one, it * should be both empty and the last one!) */ if (esPtr->nextPtr) { oldPtr = esPtr; esPtr = oldPtr->nextPtr; currElems = esPtr->endPtr - STACK_BASE(esPtr); if (esPtr->markerPtr || (esPtr->tosPtr != STACK_BASE(esPtr))) { Tcl_Panic("STACK: Stack after current is in use"); } if (esPtr->nextPtr) { Tcl_Panic("STACK: Stack after current is not last"); } if (needed <= currElems) { goto newStackReady; } DeleteExecStack(esPtr); esPtr = oldPtr; } else { currElems = esPtr->endPtr - STACK_BASE(esPtr); } /* * We need to allocate a new stack! It needs to store 'growth' words, * including the elements to be copied over and the new marker. */ #ifndef PURIFY newElems = 2*currElems; while (needed > newElems) { newElems *= 2; } #else newElems = needed; #endif newBytes = TclOffset(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *); oldPtr = esPtr; esPtr = (ExecStack *)ckalloc(newBytes); oldPtr->nextPtr = esPtr; esPtr->prevPtr = oldPtr; esPtr->nextPtr = NULL; esPtr->endPtr = &esPtr->stackWords[newElems-1]; newStackReady: eePtr->execStackPtr = esPtr; /* * Store a NULL marker at the beginning of the stack, to indicate that * this is the first marker in this stack and that rewinding to here * should actually be a return to the previous stack. */ esPtr->stackWords[0] = NULL; esPtr->markerPtr = &esPtr->stackWords[0]; memStart = MEMSTART(esPtr->markerPtr); esPtr->tosPtr = memStart - 1; if (move) { memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *)); esPtr->tosPtr += moveWords; oldPtr->markerPtr = (Tcl_Obj **) *markerPtr; oldPtr->tosPtr = markerPtr-1; } /* * Free the old stack if it is now unused. */ if (!oldPtr->markerPtr) { DeleteExecStack(oldPtr); } return memStart; } /* *-------------------------------------------------------------- * * TclStackAlloc, TclStackRealloc, TclStackFree -- * * Allocate memory from the execution stack; it has to be returned later * with a call to TclStackFree. * * Results: * A pointer to the first byte allocated, or panics if the allocation did * not succeed. * * Side effects: * The execution stack may be grown. * *-------------------------------------------------------------- */ static Tcl_Obj ** StackAllocWords( Tcl_Interp *interp, int numWords) { /* * Note that GrowEvaluationStack sets a marker in the stack. This marker * is read when rewinding, e.g., by TclStackFree. */ Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0); eePtr->execStackPtr->tosPtr += numWords; return resPtr; } static Tcl_Obj ** StackReallocWords( Tcl_Interp *interp, int numWords) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1); eePtr->execStackPtr->tosPtr += numWords; return resPtr; } void TclStackFree( Tcl_Interp *interp, void *freePtr) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; ExecStack *esPtr; Tcl_Obj **markerPtr, *marker; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { ckfree((char *) freePtr); return; } /* * Rewind the stack to the previous marker position. The current marker, * as set in the last call to GrowEvaluationStack, contains a pointer to * the previous marker. */ eePtr = iPtr->execEnvPtr; esPtr = eePtr->execStackPtr; markerPtr = esPtr->markerPtr; marker = *markerPtr; if ((freePtr != NULL) && (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr)) { Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p). Call out of sequence?", freePtr, MEMSTART(markerPtr)); } esPtr->tosPtr = markerPtr - 1; esPtr->markerPtr = (Tcl_Obj **) marker; if (marker) { return; } /* * Return to previous active stack. Note that repeated expansions or * reallocs could have generated several unused intervening stacks: free * them too. */ while (esPtr->nextPtr) { esPtr = esPtr->nextPtr; } esPtr->tosPtr = STACK_BASE(esPtr); while (esPtr->prevPtr) { ExecStack *tmpPtr = esPtr->prevPtr; if (tmpPtr->tosPtr == STACK_BASE(tmpPtr)) { DeleteExecStack(tmpPtr); } else { break; } } if (esPtr->prevPtr) { eePtr->execStackPtr = esPtr->prevPtr; #ifdef PURIFY eePtr->execStackPtr->nextPtr = NULL; DeleteExecStack(esPtr); #endif } else { eePtr->execStackPtr = esPtr; } } void * TclStackAlloc( Tcl_Interp *interp, int numBytes) { Interp *iPtr = (Interp *) interp; int numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { return (void *) ckalloc(numBytes); } numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); return (void *) StackAllocWords(interp, numWords); } void * TclStackRealloc( Tcl_Interp *interp, void *ptr, int numBytes) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; ExecStack *esPtr; Tcl_Obj **markerPtr; int numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { return (void *) ckrealloc((char *) ptr, numBytes); } eePtr = iPtr->execEnvPtr; esPtr = eePtr->execStackPtr; markerPtr = esPtr->markerPtr; if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) { Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?"); } numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); return (void *) StackReallocWords(interp, numWords); } /* *-------------------------------------------------------------- * * Tcl_ExprObj -- * * Evaluate an expression in a Tcl_Obj. * * Results: * A standard Tcl object result. If the result is other than TCL_OK, then * the interpreter's result contains an error message. If the result is * TCL_OK, then a pointer to the expression's result value object is * stored in resultPtrPtr. In that case, the object's ref count is * incremented to reflect the reference returned to the caller; the * caller is then responsible for the resulting object and must, for * example, decrement the ref count when it is finished with the object. * * Side effects: * Any side effects caused by subcommands in the expression, if any. The * interpreter result is not modified unless there is an error. * *-------------------------------------------------------------- */ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Points to Tcl object containing expression * to evaluate. */ Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ { NRE_callback *rootPtr = TOP_CB(interp); Tcl_Obj *resultPtr; TclNewObj(resultPtr); TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr, NULL, NULL); Tcl_NRExprObj(interp, objPtr, resultPtr); return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } static int CopyCallback( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj **resultPtrPtr = (Tcl_Obj **)data[0]; Tcl_Obj *resultPtr = (Tcl_Obj *)data[1]; if (result == TCL_OK) { *resultPtrPtr = resultPtr; Tcl_IncrRefCount(resultPtr); } else { Tcl_DecrRefCount(resultPtr); } return result; } /* *-------------------------------------------------------------- * * Tcl_NRExprObj -- * * Request evaluation of the expression in a Tcl_Obj by the NR stack. * * Results: * Returns TCL_OK. * * Side effects: * Compiles objPtr as a Tcl expression and places callbacks on the * NR stack to execute the bytecode and store the result in resultPtr. * If bytecode execution raises an exception, nothing is written * to resultPtr, and the exceptional return code flows up the NR * stack. If the exception is TCL_ERROR, an error message is left * in the interp result and the interp's return options dictionary * holds additional error information too. Execution of the bytecode * may have other side effects, depending on the expression. * *-------------------------------------------------------------- */ int Tcl_NRExprObj( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr) { ByteCode *codePtr; Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK); Tcl_ResetResult(interp); codePtr = CompileExprObj(interp, objPtr); Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr, NULL, NULL); return TclNRExecuteByteCode(interp, codePtr); } static int ExprObjCallback( ClientData data[], Tcl_Interp *interp, int result) { Tcl_InterpState state = (Tcl_InterpState)data[0]; Tcl_Obj *resultPtr = (Tcl_Obj *)data[1]; if (result == TCL_OK) { TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp)); (void) Tcl_RestoreInterpState(interp, state); } else { Tcl_DiscardInterpState(state); } return result; } /* *---------------------------------------------------------------------- * * CompileExprObj -- * Compile a Tcl expression value into ByteCode. * * Results: * A (ByteCode *) is returned pointing to the resulting ByteCode. * The caller must manage its refCount and arrange for a call to * TclCleanupByteCode() when the last reference disappears. * * Side effects: * The Tcl_ObjType of objPtr is changed to the "bytecode" type, * and the ByteCode is kept in the internal rep (along with context * data for checking validity) for faster operations the next time * CompileExprObj is called on the same value. * *---------------------------------------------------------------------- */ static ByteCode * CompileExprObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ /* * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ if (objPtr->typePtr == &exprCodeType) { Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != namespacePtr) || (codePtr->nsEpoch != namespacePtr->resolverEpoch) || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { FreeExprCodeInternalRep(objPtr); } } if (objPtr->typePtr != &exprCodeType) { /* * TIP #280: No invoker (yet) - Expression compilation. */ int length; const char *string = TclGetStringFromObj(objPtr, &length); TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); TclCompileExpr(interp, string, length, &compEnv, 0); /* * Successful compilation. If the expression yielded no instructions, * push an zero object as the expression's result. */ if (compEnv.codeNext == compEnv.codeStart) { TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1), &compEnv); } /* * Add a "done" instruction as the last instruction and change the * object into a ByteCode object. Ownership of the literal objects and * aux data items is given to the ByteCode object. */ TclEmitOpcode(INST_DONE, &compEnv); TclInitByteCodeObj(objPtr, &compEnv); objPtr->typePtr = &exprCodeType; TclFreeCompileEnv(&compEnv); codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; } #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile == 2) { TclPrintByteCodeObj(interp, objPtr); fflush(stdout); } #endif /* TCL_COMPILE_DEBUG */ } return codePtr; } /* *---------------------------------------------------------------------- * * DupExprCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl expression * bytecode. We do not copy the bytecode internalrep. Instead, we return * without setting copyPtr->typePtr, so the copy is a plain string copy * of the expression value, and if it is to be used as a compiled * expression, it will just need a recompile. * * This makes sense, because with Tcl's copy-on-write practices, the * usual (only?) time Tcl_DuplicateObj() will be called is when the copy * is about to be modified, which would invalidate any copied bytecode * anyway. The only reason it might make sense to copy the bytecode is if * we had some modifying routines that operated directly on the internalrep, * like we do for lists and dicts. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void DupExprCodeInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { return; } /* *---------------------------------------------------------------------- * * FreeExprCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl expression * bytecode. Frees the storage allocated to hold the internal rep, unless * ref counts indicate bytecode execution is still in progress. * * Results: * None. * * Side effects: * May free allocated memory. Leaves objPtr untyped. * *---------------------------------------------------------------------- */ static void FreeExprCodeInternalRep( Tcl_Obj *objPtr) { ByteCode *codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1; objPtr->typePtr = NULL; if (codePtr->refCount-- <= 1) { TclCleanupByteCode(codePtr); } } /* *---------------------------------------------------------------------- * * TclCompileObj -- * * This procedure compiles the script contained in a Tcl_Obj. * * Results: * A pointer to the corresponding ByteCode, never NULL. * * Side effects: * The object is shimmered to bytecode type. * *---------------------------------------------------------------------- */ ByteCode * TclCompileObj( Tcl_Interp *interp, Tcl_Obj *objPtr, const CmdFrame *invoker, int word) { Interp *iPtr = (Interp *) interp; ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* * If the object is not already of tclByteCodeType, compile it (and reset * the compilation flags in the interpreter; this should be done after any * compilation). Otherwise, check that it is "fresh" enough. */ if (objPtr->typePtr == &tclByteCodeType) { /* * Make sure the Bytecode hasn't been invalidated by, e.g., someone * redefining a command with a compile procedure (this might make the * compiled code wrong). The object needs to be recompiled if it was * compiled in/for a different interpreter, or for a different * namespace, or for the same namespace but with different name * resolution rules. Precompiled objects, however, are immutable and * therefore they are not recompiled, even if the epoch has changed. * * To be pedantically correct, we should also check that the * originating procPtr is the same as the current context procPtr * (assuming one exists at all - none for global level). This code is * #def'ed out because [info body] was changed to never return a * bytecode type object, which should obviate us from the extra checks * here. */ codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != namespacePtr) || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) { if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { goto recompileObj; } if ((Interp *) *codePtr->interpHandle != iPtr) { Tcl_Panic("Tcl_EvalObj: compiled script jumped interps"); } codePtr->compileEpoch = iPtr->compileEpoch; } /* * Check that any compiled locals do refer to the current proc * environment! If not, recompile. */ if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) && (codePtr->procPtr == NULL) && (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){ goto recompileObj; } /* * #280. * Literal sharing fix. This part of the fix is not required by 8.4 * nor 8.5, because they eval-direct any literals, so just saving the * argument locations per command in bytecode is enough, embedded * 'eval' commands, etc. get the correct information. * * But in 8.6 all the embedded script are compiled, and the resulting * bytecode stored in the literal. Now the shared literal has bytecode * with location data for _one_ particular location this literal is * found at. If we get executed from a different location the bytecode * has to be recompiled to get the correct locations. Not doing this * will execute the saved bytecode with data for a different location, * causing 'info frame' to point to the wrong place in the sources. * * Future optimizations ... * (1) Save the location data (ExtCmdLoc) keyed by start line. In that * case we recompile once per location of the literal, but not * continuously, because the moment we have all locations we do not * need to recompile any longer. * * (2) Alternative: Do not recompile, tell the execution engine the * offset between saved starting line and actual one. Then modify * the users to adjust the locations they have by this offset. * * (3) Alternative 2: Do not fully recompile, adjust just the location * information. */ if (invoker == NULL) { return codePtr; } else { Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); ExtCmdLoc *eclPtr; CmdFrame *ctxCopyPtr; int redo; if (!hePtr) { return codePtr; } eclPtr = Tcl_GetHashValue(hePtr); redo = 0; ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame)); *ctxCopyPtr = *invoker; if (invoker->type == TCL_LOCATION_BC) { /* * Note: Type BC => ctx.data.eval.path is not used. * ctx.data.tebc.codePtr used instead */ TclGetSrcInfoForPc(ctxCopyPtr); if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) { /* * The reference made by 'TclGetSrcInfoForPc' is dead. */ Tcl_DecrRefCount(ctxCopyPtr->data.eval.path); ctxCopyPtr->data.eval.path = NULL; } } if (word < ctxCopyPtr->nline) { /* * Note: We do not care if the line[word] is -1. This is a * difference and requires a recompile (location changed from * absolute to relative, literal is used fixed and through * variable) * * Example: * test info-32.0 using literal of info-24.8 * (dict with ... vs set body ...). */ redo = ((eclPtr->type == TCL_LOCATION_SOURCE) && (eclPtr->start != ctxCopyPtr->line[word])) || ((eclPtr->type == TCL_LOCATION_BC) && (ctxCopyPtr->type == TCL_LOCATION_SOURCE)); } TclStackFree(interp, ctxCopyPtr); if (!redo) { return codePtr; } } } recompileObj: iPtr->errorLine = 1; /* * TIP #280. Remember the invoker for a moment in the interpreter * structures so that the byte code compiler can pick it up when * initializing the compilation environment, i.e. the extended location * information. */ iPtr->invokeCmdFramePtr = invoker; iPtr->invokeWord = word; TclSetByteCodeFromAny(interp, objPtr, NULL, NULL); iPtr->invokeCmdFramePtr = NULL; codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; } return codePtr; } /* *---------------------------------------------------------------------- * * TclIncrObj -- * * Increment an integral value in a Tcl_Obj by an integral value held * in another Tcl_Obj. Caller is responsible for making sure we can * update the first object. * * Results: * TCL_ERROR if either object is non-integer, and TCL_OK otherwise. On * error, an error message is left in the interpreter (if it is not NULL, * of course). * * Side effects: * valuePtr gets the new incremented value. * *---------------------------------------------------------------------- */ int TclIncrObj( Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr) { ClientData ptr1, ptr2; int type1, type2; mp_int value, incr; if (Tcl_IsShared(valuePtr)) { Tcl_Panic("%s called with shared object", "TclIncrObj"); } if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { /* * Produce error message (reparse?!) */ return TclGetIntFromObj(interp, valuePtr, &type1); } if (GetNumberFromObj(NULL, incrPtr, &ptr2, &type2) != TCL_OK) { /* * Produce error message (reparse?!) */ TclGetIntFromObj(interp, incrPtr, &type1); Tcl_AddErrorInfo(interp, "\n (reading increment)"); return TCL_ERROR; } if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { long augend = *((const long *) ptr1); long addend = *((const long *) ptr2); long sum = (long)((unsigned long)augend + (unsigned long)addend); /* * Overflow when (augend and sum have different sign) and (augend and * addend have the same sign). This is encapsulated in the Overflowing * macro. */ if (!Overflowing(augend, addend, sum)) { TclSetLongObj(valuePtr, sum); return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG { Tcl_WideInt w1 = (Tcl_WideInt) augend; Tcl_WideInt w2 = (Tcl_WideInt) addend; /* * We know the sum value is outside the long range, so we use the * macro form that doesn't range test again. */ TclSetWideIntObj(valuePtr, w1 + w2); return TCL_OK; } #endif } if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { /* * Produce error message (reparse?!) */ return TclGetIntFromObj(interp, valuePtr, &type1); } if ((type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) { /* * Produce error message (reparse?!) */ TclGetIntFromObj(interp, incrPtr, &type1); Tcl_AddErrorInfo(interp, "\n (reading increment)"); return TCL_ERROR; } #ifndef TCL_WIDE_INT_IS_LONG if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, sum; TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, incrPtr, &w2); sum = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2); /* * Check for overflow. */ if (!Overflowing(w1, w2, sum)) { Tcl_SetWideIntObj(valuePtr, sum); return TCL_OK; } } #endif Tcl_TakeBignumFromObj(interp, valuePtr, &value); Tcl_GetBignumFromObj(interp, incrPtr, &incr); mp_add(&value, &incr, &value); mp_clear(&incr); Tcl_SetBignumObj(valuePtr, &value); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArgumentBCEnter -- * * This is a helper for TclNRExecuteByteCode/TEBCresume that encapsulates * a code sequence that is fairly common in the code but *not* commonly * called. * * Results: * None * * Side effects: * May register information about the bytecode in the command frame. * *---------------------------------------------------------------------- */ static void ArgumentBCEnter( Tcl_Interp *interp, ByteCode *codePtr, TEBCdata *tdPtr, const unsigned char *pc, int objc, Tcl_Obj **objv) { int cmd; if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd, pc - codePtr->codeStart); } } /* *---------------------------------------------------------------------- * * TclNRExecuteByteCode -- * * This procedure executes the instructions of a ByteCode structure. It * returns when a "done" instruction is executed or an error occurs. * * Results: * The return value is one of the return codes defined in tcl.h (such as * TCL_OK), and interp->objResultPtr refers to a Tcl object that either * contains the result of executing the code or an error message. * * Side effects: * Almost certainly, depending on the ByteCode's instructions. * *---------------------------------------------------------------------- */ #define bcFramePtr (&TD->cmdFrame) #define initCatchTop ((ptrdiff_t *) (TD->stack-1)) #define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth)) #define esPtr (iPtr->execEnvPtr->execStackPtr) int TclNRExecuteByteCode( Tcl_Interp *interp, /* Token for command interpreter. */ ByteCode *codePtr) /* The bytecode sequence to interpret. */ { Interp *iPtr = (Interp *) interp; TEBCdata *TD; int size = sizeof(TEBCdata) - 1 + (codePtr->maxStackDepth + codePtr->maxExceptDepth) * sizeof(void *); int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *); codePtr->refCount++; /* * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame * * The execution uses a unified stack: first a TEBCdata, immediately * above it a CmdFrame, then the catch stack, then the execution stack. * * Make sure the catch stack is large enough to hold the maximum number of * catch commands that could ever be executing at the same time (this will * be no more than the exception range array's depth). Make sure the * execution stack is large enough to execute this ByteCode. */ TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0); esPtr->tosPtr = initTosPtr; TD->codePtr = codePtr; TD->catchTop = initCatchTop; TD->auxObjList = NULL; /* * TIP #280: Initialize the frame. Do not push it yet: it will be pushed * every time that we call out from this TD, popped when we return to it. */ bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) ? TCL_LOCATION_PREBC : TCL_LOCATION_BC); bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1); bcFramePtr->framePtr = iPtr->framePtr; bcFramePtr->nextPtr = iPtr->cmdFramePtr; bcFramePtr->nline = 0; bcFramePtr->line = NULL; bcFramePtr->litarg = NULL; bcFramePtr->data.tebc.codePtr = codePtr; bcFramePtr->data.tebc.pc = NULL; bcFramePtr->cmdObj = NULL; bcFramePtr->cmd = NULL; bcFramePtr->len = 0; #ifdef TCL_COMPILE_STATS iPtr->stats.numExecutions++; #endif /* * Test namespace-50.9 demonstrates the need for this call. * Use a --enable-symbols=mem bug to see. */ TclResetRewriteEnsemble(interp, 1); /* * Push the callback for bytecode execution */ TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL, /* cleanup */ INT2PTR(0), INT2PTR(iPtr->evalFlags)); /* * Reset discard result flag - because it is applicable for this call only, * and should not affect all the nested invocations may return result. */ iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT; return TCL_OK; } static int TEBCresume( ClientData data[], Tcl_Interp *interp, int result) { /* * Compiler cast directive - not a real variable. * Interp *iPtr = (Interp *) interp; */ #define iPtr ((Interp *) interp) /* * Check just the read-traced/write-traced bit of a variable. */ #define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ) #define WriteTraced(varPtr) ((varPtr)->flags & VAR_TRACED_WRITE) #define UnsetTraced(varPtr) ((varPtr)->flags & VAR_TRACED_UNSET) /* * Bottom of allocated stack holds the NR data */ /* * Constants: variables that do not change during the execution, used * sporadically: no special need for speed. */ int instructionCount = 0; /* Counter that is used to work out when to * call Tcl_AsyncReady() */ const char *curInstName; #ifdef TCL_COMPILE_DEBUG int traceInstructions; /* Whether we are doing instruction-level * tracing or not. */ #endif Var *compiledLocals = iPtr->varFramePtr->compiledLocals; Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0]; #define LOCAL(i) (&compiledLocals[(i)]) #define TCONST(i) (constants[(i)]) /* * These macros are just meant to save some global variables that are not * used too frequently */ TEBCdata *TD = data[0]; #define auxObjList (TD->auxObjList) #define catchTop (TD->catchTop) #define codePtr (TD->codePtr) #define curEvalFlags PTR2INT(data[3]) /* calling iPtr->evalFlags */ /* * Globals: variables that store state, must remain valid at all times. */ Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc = data[1]; /* The current program counter. */ unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while * executing an instruction. */ int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* * Locals - variables that are used within opcodes or bounded sections of * the file (jumps between opcodes within a family). * NOTE: These are now mostly defined locally where needed. */ Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr; Tcl_Obj **objv = NULL; int objc = 0; int opnd, length, pcAdjustment; Var *varPtr, *arrayPtr; #ifdef TCL_COMPILE_DEBUG char cmdNameBuf[21]; #endif #ifdef TCL_COMPILE_DEBUG int starting = 1; traceInstructions = (tclTraceExec == 3); #endif TEBC_DATA_DIG(); #ifdef TCL_COMPILE_DEBUG if (!pc && (tclTraceExec >= 2)) { PrintByteCodeInfo(codePtr); fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH); fflush(stdout); } #endif if (!pc) { /* bytecode is starting from scratch */ pc = codePtr->codeStart; /* * Reset the interp's result to avoid possible duplications of large * objects [3c6e47363e], [781585], [804681], This can happen by start * also in nested compiled blocks (enclosed in parent cycle). * See else branch below for opposite handling by continuation/resume. */ objPtr = iPtr->objResultPtr; if (objPtr->refCount > 1) { TclDecrRefCount(objPtr); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; } goto cleanup0; } else { /* resume from invocation */ CACHE_STACK_INFO(); NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); if (bcFramePtr->cmdObj) { Tcl_DecrRefCount(bcFramePtr->cmdObj); bcFramePtr->cmdObj = NULL; bcFramePtr->cmd = NULL; } iPtr->cmdFramePtr = bcFramePtr->nextPtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { TclArgumentBCRelease(interp, bcFramePtr); } if (iPtr->execEnvPtr->rewind) { result = TCL_ERROR; goto abnormalReturn; } if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; checkInterp = 1; iPtr->flags |= ERR_ALREADY_LOGGED; } if (result != TCL_OK) { pc--; goto processExceptionReturn; } /* * Push the call's object result and continue execution with the next * instruction. */ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=", objc, cmdNameBuf), Tcl_GetObjResult(interp)); /* * Obtain and reset interp's result to avoid possible duplications of * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any * side effects caused by the resetting of errorInfo and errorCode * [Bug 804681], which are not needed here. We chose instead to * manipulate the interp's object result directly. * * Note that the result object is now in objResultPtr, it keeps the * refCount it had in its role of iPtr->objResultPtr. */ objResultPtr = Tcl_GetObjResult(interp); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; #ifndef TCL_COMPILE_DEBUG if (*pc == INST_POP) { TclDecrRefCount(objResultPtr); NEXT_INST_V(1, cleanup, 0); } #endif NEXT_INST_V(0, cleanup, -1); } /* * Targets for standard instruction endings; unrolled for speed in the * most frequent cases (instructions that consume up to two stack * elements). * * This used to be a "for(;;)" loop, with each instruction doing its own * cleanup. */ cleanupV_pushObjResultPtr: switch (cleanup) { case 0: *(++tosPtr) = (objResultPtr); goto cleanup0; default: cleanup -= 2; while (cleanup--) { objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } /* FALLTHRU */ case 2: cleanup2_pushObjResultPtr: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); /* FALLTHRU */ case 1: cleanup1_pushObjResultPtr: objPtr = OBJ_AT_TOS; TclDecrRefCount(objPtr); } OBJ_AT_TOS = objResultPtr; goto cleanup0; cleanupV: switch (cleanup) { default: cleanup -= 2; while (cleanup--) { objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } /* FALLTHRU */ case 2: cleanup2: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); /* FALLTHRU */ case 1: cleanup1: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); /* FALLTHRU */ case 0: /* * We really want to do nothing now, but this is needed for some * compilers (SunPro CC). */ break; } cleanup0: /* * Check for asynchronous handlers [Bug 746722]; we do the check every * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1). */ if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) { DECACHE_STACK_INFO(); if (TclAsyncReady(iPtr)) { result = Tcl_AsyncInvoke(interp, result); if (result == TCL_ERROR) { CACHE_STACK_INFO(); goto gotError; } } if (TclCanceled(iPtr)) { if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { CACHE_STACK_INFO(); goto gotError; } } if (TclLimitReady(iPtr->limit)) { if (Tcl_LimitCheck(interp) == TCL_ERROR) { CACHE_STACK_INFO(); goto gotError; } } CACHE_STACK_INFO(); } /* * These two instructions account for 26% of all instructions (according * to measurements on tclbench by Ben Vitale * [http://www.cs.toronto.edu/syslab/pubs/tcl2005-vitale-zaleski.pdf] * Resolving them before the switch reduces the cost of branch * mispredictions, seems to improve runtime by 5% to 15%, and (amazingly!) * reduces total obj size. */ inst = *pc; peepholeStart: #ifdef TCL_COMPILE_STATS iPtr->stats.instructionCount[*pc]++; #endif #ifdef TCL_COMPILE_DEBUG /* * Skip the stack depth check if an expansion is in progress. */ CHECK_STACK(); if (traceInstructions) { fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH); TclPrintInstruction(codePtr, pc); fflush(stdout); } #endif /* TCL_COMPILE_DEBUG */ TCL_DTRACE_INST_NEXT(); if (inst == INST_LOAD_SCALAR1) { goto instLoadScalar1; } else if (inst == INST_PUSH1) { PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]); TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc+1)), OBJ_AT_TOS); inst = *(pc += 2); goto peepholeStart; } else if (inst == INST_START_CMD) { /* * Peephole: do not run INST_START_CMD, just skip it */ iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); if (checkInterp) { if (((codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) && !(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { goto instStartCmdFailed; } checkInterp = 0; } inst = *(pc += 9); goto peepholeStart; } else if (inst == INST_NOP) { #ifndef TCL_COMPILE_DEBUG while (inst == INST_NOP) #endif { inst = *++pc; } goto peepholeStart; } switch (inst) { case INST_SYNTAX: case INST_RETURN_IMM: { int code = TclGetInt4AtPtr(pc+1); int level = TclGetUInt4AtPtr(pc+5); /* * OBJ_AT_TOS is returnOpts, OBJ_UNDER_TOS is resultObjPtr. */ TRACE(("%u %u => ", code, level)); result = TclProcessReturn(interp, code, level, OBJ_AT_TOS); if (result == TCL_OK) { TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n", O2S(objResultPtr))); NEXT_INST_F(9, 1, 0); } Tcl_SetObjResult(interp, OBJ_UNDER_TOS); if (*pc == INST_SYNTAX) { iPtr->flags &= ~ERR_ALREADY_LOGGED; } cleanup = 2; TRACE_APPEND(("\n")); goto processExceptionReturn; } case INST_RETURN_STK: TRACE(("=> ")); objResultPtr = POP_OBJECT(); result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS); if (result == TCL_OK) { Tcl_DecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = objResultPtr; TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n", O2S(objResultPtr))); NEXT_INST_F(1, 0, 0); } else if (result == TCL_ERROR) { /* * BEWARE! Must do this in this order, because an error in the * option dictionary overrides the result (and can be verified by * test). */ Tcl_SetObjResult(interp, objResultPtr); Tcl_SetReturnOptions(interp, OBJ_AT_TOS); Tcl_DecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = objResultPtr; } else { Tcl_DecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = objResultPtr; Tcl_SetObjResult(interp, objResultPtr); } cleanup = 1; TRACE_APPEND(("\n")); goto processExceptionReturn; { CoroutineData *corPtr; int yieldParameter; case INST_YIELD: corPtr = iPtr->execEnvPtr->corPtr; TRACE(("%.30s => ", O2S(OBJ_AT_TOS))); if (!corPtr) { TRACE_APPEND(("ERROR: yield outside coroutine\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( "yield can only be called in a coroutine", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); CACHE_STACK_INFO(); goto gotError; } #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { if (traceInstructions) { TRACE_APPEND(("YIELD...\n")); } else { fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n", iPtr->numLevels, (unsigned)(pc - codePtr->codeStart), Tcl_GetString(OBJ_AT_TOS)); } fflush(stdout); } #endif yieldParameter = 0; Tcl_SetObjResult(interp, OBJ_AT_TOS); goto doYield; case INST_YIELD_TO_INVOKE: corPtr = iPtr->execEnvPtr->corPtr; valuePtr = OBJ_AT_TOS; if (!corPtr) { TRACE(("[%.30s] => ERROR: yield outside coroutine\n", O2S(valuePtr))); Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto can only be called in a coroutine", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); CACHE_STACK_INFO(); goto gotError; } if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) { TRACE(("[%.30s] => ERROR: yield in deleted\n", O2S(valuePtr))); Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", NULL); CACHE_STACK_INFO(); goto gotError; } #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { if (traceInstructions) { TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr))); } else { /* FIXME: What is the right thing to trace? */ fprintf(stdout, "%d: (%u) yielding to [%.30s]\n", iPtr->numLevels, (unsigned)(pc - codePtr->codeStart), Tcl_GetString(valuePtr)); } fflush(stdout); } #endif /* * Install a tailcall record in the caller and continue with the * yield. The yield is switched into multi-return mode (via the * 'yieldParameter'). */ Tcl_IncrRefCount(valuePtr); iPtr->execEnvPtr = corPtr->callerEEPtr; TclSetTailcall(interp, valuePtr); iPtr->execEnvPtr = corPtr->eePtr; yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/ doYield: /* TIP #280: Record the last piece of info needed by * 'TclGetSrcInfoForPc', and push the frame. */ bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } pc++; cleanup = 1; TEBC_YIELD(); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, INT2PTR(yieldParameter), NULL, NULL); return TCL_OK; } case INST_TAILCALL: { Tcl_Obj *listPtr, *nsObjPtr; opnd = TclGetUInt1AtPtr(pc+1); if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd)); Tcl_SetObjResult(interp, Tcl_NewStringObj( "tailcall can only be called from a proc or lambda", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); CACHE_STACK_INFO(); goto gotError; } #ifdef TCL_COMPILE_DEBUG /* FIXME: What is the right thing to trace? */ { int i; TRACE(("%d [", opnd)); for (i=opnd-1 ; i>=0 ; i--) { TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i)))); if (i > 0) { TRACE_APPEND((" ")); } } TRACE_APPEND(("] => RETURN...")); } #endif /* * Push the evaluation of the called command into the NR callback * stack. */ listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); if (iPtr->varFramePtr->tailcallPtr) { Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); } iPtr->varFramePtr->tailcallPtr = listPtr; result = TCL_RETURN; cleanup = opnd; goto processExceptionReturn; } case INST_DONE: if (tosPtr > initTosPtr) { if ((curEvalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) { /* simulate pop & fast done (like it does continue in loop) */ TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); goto abnormalReturn; } /* * Set the interpreter's object result to point to the topmost * object from the stack, and check for a possible [catch]. The * stackTop's level and refCount will be handled by "processCatch" * or "abnormalReturn". */ Tcl_SetObjResult(interp, OBJ_AT_TOS); #ifdef TCL_COMPILE_DEBUG TRACE_WITH_OBJ(("=> return code=%d, result=", result), iPtr->objResultPtr); if (traceInstructions) { fprintf(stdout, "\n"); } #endif goto checkForCatch; } (void) POP_OBJECT(); goto abnormalReturn; case INST_PUSH4: objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); NEXT_INST_F(5, 0, 1); break; case INST_POP: TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); NEXT_INST_F(1, 0, 0); break; case INST_DUP: objResultPtr = OBJ_AT_TOS; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_F(5, 0, 1); break; case INST_REVERSE: { Tcl_Obj **a, **b; opnd = TclGetUInt4AtPtr(pc+1); a = tosPtr-(opnd-1); b = tosPtr; while (a OK\n", opnd)); NEXT_INST_F(5, 0, 0); } break; case INST_STR_CONCAT1: { int appendLen = 0; char *bytes, *p; Tcl_Obj **currPtr; int onlyb = 1; opnd = TclGetUInt1AtPtr(pc+1); /* * Detect only-bytearray-or-null case. */ for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) { if (((*currPtr)->typePtr != &tclByteArrayType) && ((*currPtr)->bytes != tclEmptyStringRep)) { onlyb = 0; break; } else if (((*currPtr)->typePtr == &tclByteArrayType) && ((*currPtr)->bytes != NULL)) { onlyb = 0; break; } } /* * Compute the length to be appended. */ if (onlyb) { for (currPtr = &OBJ_AT_DEPTH(opnd-2); appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) { if ((*currPtr)->bytes != tclEmptyStringRep) { Tcl_GetByteArrayFromObj(*currPtr, &length); appendLen += length; } } } else { for (currPtr = &OBJ_AT_DEPTH(opnd-2); appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) { bytes = TclGetStringFromObj(*currPtr, &length); if (bytes != NULL) { appendLen += length; } } } if (appendLen < 0) { /* TODO: convert panic to error ? */ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } /* * If nothing is to be appended, just return the first object by * dropping all the others from the stack; this saves both the * computation and copy of the string rep of the first object, * enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'. */ if (appendLen == 0) { TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, (opnd-1), 0); } /* * If the first object is shared, we need a new obj for the result; * otherwise, we can reuse the first object. In any case, make sure it * has enough room to accommodate all the concatenated bytes. Note that * if it is unshared its bytes are copied by ckrealloc, so that we set * the loop parameters to avoid copying them again: p points to the * end of the already copied bytes, currPtr to the second object. */ objResultPtr = OBJ_AT_DEPTH(opnd-1); if (!onlyb) { bytes = TclGetStringFromObj(objResultPtr, &length); if (length + appendLen < 0) { /* TODO: convert panic to error ? */ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } #ifndef TCL_COMPILE_DEBUG if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) { TclFreeIntRep(objResultPtr); objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1); objResultPtr->length = length + appendLen; p = TclGetString(objResultPtr) + length; currPtr = &OBJ_AT_DEPTH(opnd - 2); } else #endif { p = ckalloc(length + appendLen + 1); TclNewObj(objResultPtr); objResultPtr->bytes = p; objResultPtr->length = length + appendLen; currPtr = &OBJ_AT_DEPTH(opnd - 1); } /* * Append the remaining characters. */ for (; currPtr <= &OBJ_AT_TOS; currPtr++) { bytes = TclGetStringFromObj(*currPtr, &length); if (bytes != NULL) { memcpy(p, bytes, length); p += length; } } *p = '\0'; } else { bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length); if (length + appendLen < 0) { /* TODO: convert panic to error ? */ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } #ifndef TCL_COMPILE_DEBUG if (!Tcl_IsShared(objResultPtr)) { bytes = (char *) Tcl_SetByteArrayLength(objResultPtr, length + appendLen); p = bytes + length; currPtr = &OBJ_AT_DEPTH(opnd - 2); } else #endif { TclNewObj(objResultPtr); bytes = (char *) Tcl_SetByteArrayLength(objResultPtr, length + appendLen); p = bytes; currPtr = &OBJ_AT_DEPTH(opnd - 1); } /* * Append the remaining characters. */ for (; currPtr <= &OBJ_AT_TOS; currPtr++) { if ((*currPtr)->bytes != tclEmptyStringRep) { bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length); memcpy(p, bytes, length); p += length; } } } TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); } case INST_CONCAT_STK: /* * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj, * and then decrement their ref counts. */ opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); case INST_EXPAND_START: /* * Push an element to the auxObjList. This records the current * stack depth - i.e., the point in the stack where the expanded * command starts. * * Use a Tcl_Obj as linked list element; slight mem waste, but faster * allocation than ckalloc. This also abuses the Tcl_Obj structure, as * we do not define a special tclObjType for it. It is not dangerous * as the obj is never passed anywhere, so that all manipulations are * performed here and in INST_INVOKE_EXPANDED (in case of an expansion * error, also in INST_EXPAND_STKTOP). */ TclNewObj(objPtr); objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH); objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH)); NEXT_INST_F(1, 0, 0); break; case INST_EXPAND_DROP: /* * Drops an element of the auxObjList, popping stack elements to * restore the stack to the state before the point where the aux * element was created. */ CLANG_ASSERT(auxObjList); objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2); POP_TAUX_OBJ(); #ifdef TCL_COMPILE_DEBUG /* Ugly abuse! */ starting = 1; #endif TRACE(("=> drop %d items\n", objc)); NEXT_INST_V(1, objc, 0); case INST_EXPAND_STKTOP: { int i; ptrdiff_t moved; /* * Make sure that the element at stackTop is a list; if not, just * leave with an error. Note that the element from the expand list * will be removed at checkForCatch. */ objPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(objPtr))); if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } (void) POP_OBJECT(); /* * Make sure there is enough room in the stack to expand this list * *and* process the rest of the command (at least up to the next * argument expansion or command end). The operand is the current * stack depth, as seen by the compiler. */ auxObjList->length += objc - 1; if ((objc > 1) && (auxObjList->length > 0)) { length = auxObjList->length /* Total expansion room we need */ + codePtr->maxStackDepth /* Beyond the original max */ - CURR_DEPTH; /* Relative to where we are */ DECACHE_STACK_INFO(); moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1) - (Tcl_Obj **) TD; if (moved) { /* * Change the global data to point to the new stack: move the * TEBCdataPtr TD, recompute the position of every other * stack-allocated parameter, update the stack pointers. */ TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved); catchTop += moved; tosPtr += moved; } } /* * Expand the list at stacktop onto the stack; free the list. Knowing * that it has a freeIntRepProc we use Tcl_DecrRefCount(). */ for (i = 0; i < objc; i++) { PUSH_OBJECT(objv[i]); } TRACE_APPEND(("OK\n")); Tcl_DecrRefCount(objPtr); NEXT_INST_F(5, 0, 0); } break; case INST_EXPR_STK: { ByteCode *newCodePtr; bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; DECACHE_STACK_INFO(); newCodePtr = CompileExprObj(interp, OBJ_AT_TOS); CACHE_STACK_INFO(); cleanup = 1; pc++; TEBC_YIELD(); return TclNRExecuteByteCode(interp, newCodePtr); } /* * INVOCATION BLOCK */ case INST_EVAL_STK: instEvalStk: bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; cleanup = 1; pc += 1; /* yield next instruction */ TEBC_YIELD(); /* add TEBCResume for object at top of stack */ return TclNRExecuteByteCode(interp, TclCompileObj(interp, OBJ_AT_TOS, NULL, 0)); case INST_INVOKE_EXPANDED: CLANG_ASSERT(auxObjList); objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2); POP_TAUX_OBJ(); if (objc) { pcAdjustment = 1; goto doInvocation; } /* * Nothing was expanded, return {}. */ TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doInvocation; case INST_INVOKE_STK1: objc = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; doInvocation: objv = &OBJ_AT_DEPTH(objc-1); cleanup = objc; #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { int i; if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); TRACE(("%u => call ", objc)); } else { fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels, (unsigned)(pc - codePtr->codeStart)); } for (i = 0; i < objc; i++) { TclPrintObject(stdout, objv[i], 15); fprintf(stdout, " "); } fprintf(stdout, "\n"); fflush(stdout); } #endif /*TCL_COMPILE_DEBUG*/ /* * Finally, let TclEvalObjv handle the command. * * TIP #280: Record the last piece of info needed by * 'TclGetSrcInfoForPc', and push the frame. */ bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } DECACHE_STACK_INFO(); pc += pcAdjustment; TEBC_YIELD(); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); #if TCL_SUPPORT_84_BYTECODE case INST_CALL_BUILTIN_FUNC1: /* * Call one of the built-in pre-8.5 Tcl math functions. This * translates to INST_INVOKE_STK1 with the first argument of * ::tcl::mathfunc::$objv[0]. We need to insert the named math * function into the stack. */ opnd = TclGetUInt1AtPtr(pc+1); if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); } TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); /* * Only 0, 1 or 2 args. */ { int numArgs = tclBuiltinFuncTable[opnd].numArgs; Tcl_Obj *tmpPtr1, *tmpPtr2; if (numArgs == 0) { PUSH_OBJECT(objPtr); } else if (numArgs == 1) { tmpPtr1 = POP_OBJECT(); PUSH_OBJECT(objPtr); PUSH_OBJECT(tmpPtr1); Tcl_DecrRefCount(tmpPtr1); } else { tmpPtr2 = POP_OBJECT(); tmpPtr1 = POP_OBJECT(); PUSH_OBJECT(objPtr); PUSH_OBJECT(tmpPtr1); PUSH_OBJECT(tmpPtr2); Tcl_DecrRefCount(tmpPtr1); Tcl_DecrRefCount(tmpPtr2); } objc = numArgs + 1; } pcAdjustment = 2; goto doInvocation; case INST_CALL_FUNC1: /* * Call a non-builtin Tcl math function previously registered by a * call to Tcl_CreateMathFunc pre-8.5. This is essentially * INST_INVOKE_STK1 converting the first arg to * ::tcl::mathfunc::$objv[0]. */ objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function * name is the 0-th argument. */ objPtr = OBJ_AT_DEPTH(objc-1); TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); Tcl_AppendObjToObj(tmpPtr, objPtr); Tcl_DecrRefCount(objPtr); /* * Variation of PUSH_OBJECT. */ OBJ_AT_DEPTH(objc-1) = tmpPtr; Tcl_IncrRefCount(tmpPtr); pcAdjustment = 2; goto doInvocation; #else /* * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support * remains for existing bytecode precompiled files. */ case INST_CALL_BUILTIN_FUNC1: Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found"); case INST_CALL_FUNC1: Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); #endif case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); opnd = TclGetUInt1AtPtr(pc+5); objPtr = POP_OBJECT(); objv = &OBJ_AT_DEPTH(objc-1); cleanup = objc; #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { int i; if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr))); } else { fprintf(stdout, "%d: (%u) invoking (using implementation %s) ", iPtr->numLevels, (unsigned)(pc - codePtr->codeStart), O2S(objPtr)); } for (i = 0; i < objc; i++) { if (i < opnd) { fprintf(stdout, "<"); TclPrintObject(stdout, objv[i], 15); fprintf(stdout, ">"); } else { TclPrintObject(stdout, objv[i], 15); } fprintf(stdout, " "); } fprintf(stdout, "\n"); fflush(stdout); } #endif /*TCL_COMPILE_DEBUG*/ bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } TclInitRewriteEnsemble(interp, opnd, 1, objv); { Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL); Tcl_ListObjAppendElement(NULL, copyPtr, objPtr); Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0, objc - opnd, objv + opnd); Tcl_DecrRefCount(objPtr); objPtr = copyPtr; } DECACHE_STACK_INFO(); pc += 6; TEBC_YIELD(); TclMarkTailcall(interp); TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); TclListObjGetElements(NULL, objPtr, &objc, &objv); TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL); /* * ----------------------------------------------------------------- * Start of INST_LOAD instructions. * * WARNING: more 'goto' here than your doctor recommended! The different * instructions set the value of some variables and then jump to some * common execution code. */ case INST_LOAD_SCALAR1: instLoadScalar1: opnd = TclGetUInt1AtPtr(pc+1); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { /* * No errors, no traces: just get the value. */ objResultPtr = varPtr->value.objPtr; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(2, 0, 1); } pcAdjustment = 2; cleanup = 0; arrayPtr = NULL; part1Ptr = part2Ptr = NULL; goto doCallPtrGetVar; case INST_LOAD_SCALAR4: opnd = TclGetUInt4AtPtr(pc+1); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { /* * No errors, no traces: just get the value. */ objResultPtr = varPtr->value.objPtr; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(5, 0, 1); } pcAdjustment = 5; cleanup = 0; arrayPtr = NULL; part1Ptr = part2Ptr = NULL; goto doCallPtrGetVar; case INST_LOAD_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doLoadArray; case INST_LOAD_ARRAY1: opnd = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; doLoadArray: part1Ptr = NULL; part2Ptr = OBJ_AT_TOS; arrayPtr = LOCAL(opnd); while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectReadable(varPtr)) { /* * No errors, no traces: just get the value. */ objResultPtr = varPtr->value.objPtr; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(pcAdjustment, 1, 1); } } varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd); if (varPtr == NULL) { TRACE_ERROR(interp); goto gotError; } cleanup = 1; goto doCallPtrGetVar; case INST_LOAD_ARRAY_STK: cleanup = 2; part2Ptr = OBJ_AT_TOS; /* element name */ objPtr = OBJ_UNDER_TOS; /* array name */ TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), O2S(part2Ptr))); goto doLoadStk; case INST_LOAD_STK: case INST_LOAD_SCALAR_STK: cleanup = 1; part2Ptr = NULL; objPtr = OBJ_AT_TOS; /* variable name */ TRACE(("\"%.30s\" => ", O2S(objPtr))); doLoadStk: part1Ptr = objPtr; varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1, &arrayPtr); if (!varPtr) { TRACE_ERROR(interp); goto gotError; } if (TclIsVarDirectReadable2(varPtr, arrayPtr)) { /* * No errors, no traces: just get the value. */ objResultPtr = varPtr->value.objPtr; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(1, cleanup, 1); } pcAdjustment = 1; opnd = -1; doCallPtrGetVar: /* * There are either errors or the variable is traced: call * TclPtrGetVar to process fully. */ DECACHE_STACK_INFO(); objResultPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (!objResultPtr) { TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); /* * End of INST_LOAD instructions. * ----------------------------------------------------------------- * Start of INST_STORE and related instructions. * * WARNING: more 'goto' here than your doctor recommended! The different * instructions set the value of some variables and then jump to somme * common execution code. */ { int storeFlags, len; case INST_STORE_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doStoreArrayDirect; case INST_STORE_ARRAY1: opnd = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; doStoreArrayDirect: valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; arrayPtr = LOCAL(opnd); TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } if (TclIsVarArray(arrayPtr) && !WriteTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectWritable(varPtr)) { tosPtr--; Tcl_DecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = valuePtr; goto doStoreVarDirect; } } cleanup = 2; storeFlags = TCL_LEAVE_ERR_MSG; part1Ptr = NULL; goto doStoreArrayDirectFailed; case INST_STORE_SCALAR4: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doStoreScalarDirect; case INST_STORE_SCALAR1: opnd = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; doStoreScalarDirect: valuePtr = OBJ_AT_TOS; varPtr = LOCAL(opnd); TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (!TclIsVarDirectWritable(varPtr)) { storeFlags = TCL_LEAVE_ERR_MSG; part1Ptr = NULL; goto doStoreScalar; } /* * No traces, no errors, plain 'set': we can safely inline. The value * *will* be set to what's requested, so that the stack top remains * pointing to the same Tcl_Obj. */ doStoreVarDirect: valuePtr = varPtr->value.objPtr; if (valuePtr != NULL) { TclDecrRefCount(valuePtr); } objResultPtr = OBJ_AT_TOS; varPtr->value.objPtr = objResultPtr; #ifndef TCL_COMPILE_DEBUG if (*(pc+pcAdjustment) == INST_POP) { tosPtr--; NEXT_INST_F((pcAdjustment+1), 0, 0); } #else TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); #endif Tcl_IncrRefCount(objResultPtr); NEXT_INST_F(pcAdjustment, 0, 0); case INST_LAPPEND_STK: valuePtr = OBJ_AT_TOS; /* value to append */ part2Ptr = NULL; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreStk; case INST_LAPPEND_ARRAY_STK: valuePtr = OBJ_AT_TOS; /* value to append */ part2Ptr = OBJ_UNDER_TOS; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreStk; case INST_APPEND_STK: valuePtr = OBJ_AT_TOS; /* value to append */ part2Ptr = NULL; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreStk; case INST_APPEND_ARRAY_STK: valuePtr = OBJ_AT_TOS; /* value to append */ part2Ptr = OBJ_UNDER_TOS; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreStk; case INST_STORE_ARRAY_STK: valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; storeFlags = TCL_LEAVE_ERR_MSG; goto doStoreStk; case INST_STORE_STK: case INST_STORE_SCALAR_STK: valuePtr = OBJ_AT_TOS; part2Ptr = NULL; storeFlags = TCL_LEAVE_ERR_MSG; doStoreStk: objPtr = OBJ_AT_DEPTH(1 + (part2Ptr != NULL)); /* variable name */ part1Ptr = objPtr; #ifdef TCL_COMPILE_DEBUG if (part2Ptr == NULL) { TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr),O2S(valuePtr))); } else { TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ", O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); } #endif varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!varPtr) { TRACE_ERROR(interp); goto gotError; } cleanup = ((part2Ptr == NULL)? 2 : 3); pcAdjustment = 1; opnd = -1; goto doCallPtrSetVar; case INST_LAPPEND_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreArray; case INST_LAPPEND_ARRAY1: opnd = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreArray; case INST_APPEND_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreArray; case INST_APPEND_ARRAY1: opnd = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreArray; doStoreArray: valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; arrayPtr = LOCAL(opnd); TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } cleanup = 2; part1Ptr = NULL; doStoreArrayDirectFailed: varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd); if (!varPtr) { TRACE_ERROR(interp); goto gotError; } goto doCallPtrSetVar; case INST_LAPPEND_SCALAR4: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreScalar; case INST_LAPPEND_SCALAR1: opnd = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreScalar; case INST_APPEND_SCALAR4: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreScalar; case INST_APPEND_SCALAR1: opnd = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreScalar; doStoreScalar: valuePtr = OBJ_AT_TOS; varPtr = LOCAL(opnd); TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } cleanup = 1; arrayPtr = NULL; part1Ptr = part2Ptr = NULL; doCallPtrSetVar: DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, valuePtr, storeFlags, opnd); CACHE_STACK_INFO(); if (!objResultPtr) { TRACE_ERROR(interp); goto gotError; } #ifndef TCL_COMPILE_DEBUG if (*(pc+pcAdjustment) == INST_POP) { NEXT_INST_V((pcAdjustment+1), cleanup, 0); } #endif TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); case INST_LAPPEND_LIST: opnd = TclGetUInt4AtPtr(pc+1); valuePtr = OBJ_AT_TOS; varPtr = LOCAL(opnd); cleanup = 1; pcAdjustment = 5; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (TclIsVarDirectReadable(varPtr) && TclIsVarDirectWritable(varPtr)) { goto lappendListDirect; } arrayPtr = NULL; part1Ptr = part2Ptr = NULL; goto lappendListPtr; case INST_LAPPEND_LIST_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); valuePtr = OBJ_AT_TOS; part1Ptr = NULL; part2Ptr = OBJ_UNDER_TOS; arrayPtr = LOCAL(opnd); cleanup = 2; pcAdjustment = 5; while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } TRACE(("%u \"%.30s\" \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr) && !WriteTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectReadable(varPtr) && TclIsVarDirectWritable(varPtr)) { goto lappendListDirect; } } varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd); if (varPtr == NULL) { TRACE_ERROR(interp); goto gotError; } goto lappendListPtr; case INST_LAPPEND_LIST_ARRAY_STK: pcAdjustment = 1; cleanup = 3; valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; /* element name */ part1Ptr = OBJ_AT_DEPTH(2); /* array name */ TRACE(("\"%.30s(%.30s)\" \"%.30s\" => ", O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); goto lappendList; case INST_LAPPEND_LIST_STK: pcAdjustment = 1; cleanup = 2; valuePtr = OBJ_AT_TOS; part2Ptr = NULL; part1Ptr = OBJ_UNDER_TOS; /* variable name */ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(valuePtr))); goto lappendList; lappendListDirect: objResultPtr = varPtr->value.objPtr; if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (Tcl_IsShared(objResultPtr)) { Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr); TclDecrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr = newValue; Tcl_IncrRefCount(newValue); } if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); lappendList: opnd = -1; if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } DECACHE_STACK_INFO(); varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr); CACHE_STACK_INFO(); if (!varPtr) { TRACE_ERROR(interp); goto gotError; } lappendListPtr: if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } if (arrayPtr && TclIsVarInHash(arrayPtr)) { VarHashRefCount(arrayPtr)++; } DECACHE_STACK_INFO(); objResultPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)--; } if (arrayPtr && TclIsVarInHash(arrayPtr)) { VarHashRefCount(arrayPtr)--; } { int createdNewObj = 0; Tcl_Obj *valueToAssign; if (!objResultPtr) { valueToAssign = valuePtr; } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } else { if (Tcl_IsShared(objResultPtr)) { valueToAssign = Tcl_DuplicateObj(objResultPtr); createdNewObj = 1; } else { valueToAssign = objResultPtr; } if (Tcl_ListObjReplace(interp, valueToAssign, len, 0, objc, objv) != TCL_OK) { if (createdNewObj) { TclDecrRefCount(valueToAssign); } goto errorInLappendListPtr; } } DECACHE_STACK_INFO(); Tcl_IncrRefCount(valueToAssign); objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd); TclDecrRefCount(valueToAssign); CACHE_STACK_INFO(); if (!objResultPtr) { errorInLappendListPtr: TRACE_ERROR(interp); goto gotError; } } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); } /* * End of INST_STORE and related instructions. * ----------------------------------------------------------------- * Start of INST_INCR instructions. * * WARNING: more 'goto' here than your doctor recommended! The different * instructions set the value of some variables and then jump to some * common execution code. */ /*TODO: Consider more untangling here; merge with LOAD and STORE ? */ { Tcl_Obj *incrPtr; #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w; #endif long increment; case INST_INCR_SCALAR1: case INST_INCR_ARRAY1: case INST_INCR_ARRAY_STK: case INST_INCR_SCALAR_STK: case INST_INCR_STK: opnd = TclGetUInt1AtPtr(pc+1); incrPtr = POP_OBJECT(); switch (*pc) { case INST_INCR_SCALAR1: pcAdjustment = 2; goto doIncrScalar; case INST_INCR_ARRAY1: pcAdjustment = 2; goto doIncrArray; default: pcAdjustment = 1; goto doIncrStk; } case INST_INCR_ARRAY_STK_IMM: case INST_INCR_SCALAR_STK_IMM: case INST_INCR_STK_IMM: increment = TclGetInt1AtPtr(pc+1); TclNewIntObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); pcAdjustment = 2; doIncrStk: if ((*pc == INST_INCR_ARRAY_STK_IMM) || (*pc == INST_INCR_ARRAY_STK)) { part2Ptr = OBJ_AT_TOS; objPtr = OBJ_UNDER_TOS; TRACE(("\"%.30s(%.30s)\" (by %ld) => ", O2S(objPtr), O2S(part2Ptr), increment)); } else { part2Ptr = NULL; objPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), increment)); } part1Ptr = objPtr; opnd = -1; varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (!varPtr) { DECACHE_STACK_INFO(); Tcl_AddErrorInfo(interp, "\n (reading value of variable to increment)"); CACHE_STACK_INFO(); TRACE_ERROR(interp); Tcl_DecrRefCount(incrPtr); goto gotError; } cleanup = ((part2Ptr == NULL)? 1 : 2); goto doIncrVar; case INST_INCR_ARRAY1_IMM: opnd = TclGetUInt1AtPtr(pc+1); increment = TclGetInt1AtPtr(pc+2); TclNewIntObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); pcAdjustment = 3; doIncrArray: part1Ptr = NULL; part2Ptr = OBJ_AT_TOS; arrayPtr = LOCAL(opnd); cleanup = 1; while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), increment)); varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd); if (!varPtr) { TRACE_ERROR(interp); Tcl_DecrRefCount(incrPtr); goto gotError; } goto doIncrVar; case INST_INCR_SCALAR1_IMM: opnd = TclGetUInt1AtPtr(pc+1); increment = TclGetInt1AtPtr(pc+2); pcAdjustment = 3; cleanup = 0; varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (TclIsVarDirectModifyable(varPtr)) { ClientData ptr; int type; objPtr = varPtr->value.objPtr; if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { if (type == TCL_NUMBER_LONG) { long augend = *((const long *)ptr); long sum = (long)((unsigned long)augend + (unsigned long)increment); /* * Overflow when (augend and sum have different sign) and * (augend and increment have the same sign). This is * encapsulated in the Overflowing macro. */ if (!Overflowing(augend, increment, sum)) { TRACE(("%u %ld => ", opnd, increment)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ TclNewLongObj(objResultPtr, sum); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; TclSetLongObj(objPtr, sum); } goto doneIncr; } #ifndef TCL_WIDE_INT_IS_LONG w = (Tcl_WideInt)augend; TRACE(("%u %ld => ", opnd, increment)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ objResultPtr = Tcl_NewWideIntObj(w+increment); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; /* * We know the sum value is outside the long range; * use macro form that doesn't range test again. */ TclSetWideIntObj(objPtr, w+increment); } goto doneIncr; #endif } /* end if (type == TCL_NUMBER_LONG) */ #ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { Tcl_WideInt sum; w = *((const Tcl_WideInt *) ptr); sum = (Tcl_WideInt)((Tcl_WideUInt)w + (Tcl_WideUInt)increment); /* * Check for overflow. */ if (!Overflowing(w, increment, sum)) { TRACE(("%u %ld => ", opnd, increment)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ objResultPtr = Tcl_NewWideIntObj(sum); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; /* * We *do not* know the sum value is outside the * long range (wide + long can yield long); use * the function call that checks range. */ Tcl_SetWideIntObj(objPtr, sum); } goto doneIncr; } } #endif } if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared */ objResultPtr = Tcl_DuplicateObj(objPtr); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; } TclNewLongObj(incrPtr, increment); if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) { Tcl_DecrRefCount(incrPtr); TRACE_ERROR(interp); goto gotError; } Tcl_DecrRefCount(incrPtr); goto doneIncr; } /* * All other cases, flow through to generic handling. */ TclNewLongObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); doIncrScalar: varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } arrayPtr = NULL; part1Ptr = part2Ptr = NULL; cleanup = 0; TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr))); doIncrVar: if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) { objPtr = varPtr->value.objPtr; if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared */ objResultPtr = Tcl_DuplicateObj(objPtr); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; } if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) { Tcl_DecrRefCount(incrPtr); TRACE_ERROR(interp); goto gotError; } Tcl_DecrRefCount(incrPtr); } else { DECACHE_STACK_INFO(); objResultPtr = TclPtrIncrObjVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); Tcl_DecrRefCount(incrPtr); if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } } doneIncr: TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); #ifndef TCL_COMPILE_DEBUG if (*(pc+pcAdjustment) == INST_POP) { NEXT_INST_V((pcAdjustment+1), cleanup, 0); } #endif NEXT_INST_V(pcAdjustment, cleanup, 1); } /* * End of INST_INCR instructions. * ----------------------------------------------------------------- * Start of INST_EXIST instructions. */ case INST_EXIST_SCALAR: cleanup = 0; pcAdjustment = 5; opnd = TclGetUInt4AtPtr(pc+1); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } TRACE(("%u => ", opnd)); if (ReadTraced(varPtr)) { DECACHE_STACK_INFO(); TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL, TCL_TRACE_READS, 0, opnd); CACHE_STACK_INFO(); if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, NULL); varPtr = NULL; } } goto afterExistsPeephole; case INST_EXIST_ARRAY: cleanup = 1; pcAdjustment = 5; opnd = TclGetUInt4AtPtr(pc+1); part2Ptr = OBJ_AT_TOS; arrayPtr = LOCAL(opnd); while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (!varPtr || !ReadTraced(varPtr)) { goto afterExistsPeephole; } } varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access", 0, 1, arrayPtr, opnd); if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { DECACHE_STACK_INFO(); TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr, TCL_TRACE_READS, 0, opnd); CACHE_STACK_INFO(); } if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); varPtr = NULL; } } goto afterExistsPeephole; case INST_EXIST_ARRAY_STK: cleanup = 2; pcAdjustment = 1; part2Ptr = OBJ_AT_TOS; /* element name */ part1Ptr = OBJ_UNDER_TOS; /* array name */ TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr))); goto doExistStk; case INST_EXIST_STK: cleanup = 1; pcAdjustment = 1; part2Ptr = NULL; part1Ptr = OBJ_AT_TOS; /* variable name */ TRACE(("\"%.30s\" => ", O2S(part1Ptr))); doExistStk: varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, 0, "access", /*createPart1*/0, /*createPart2*/1, &arrayPtr); if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { DECACHE_STACK_INFO(); TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr, TCL_TRACE_READS, 0, -1); CACHE_STACK_INFO(); } if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); varPtr = NULL; } } /* * Peep-hole optimisation: if you're about to jump, do jump from here. */ afterExistsPeephole: { int found = (varPtr && !TclIsVarUndefined(varPtr)); TRACE_APPEND(("%d\n", found ? 1 : 0)); JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup); } /* * End of INST_EXIST instructions. * ----------------------------------------------------------------- * Start of INST_UNSET instructions. */ { int flags; case INST_UNSET_SCALAR: flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0; opnd = TclGetUInt4AtPtr(pc+2); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd)); if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { /* * No errors, no traces, no searches: just make the variable cease * to exist. */ if (!TclIsVarUndefined(varPtr)) { TclDecrRefCount(varPtr->value.objPtr); } else if (flags & TCL_LEAVE_ERR_MSG) { goto slowUnsetScalar; } varPtr->value.objPtr = NULL; TRACE_APPEND(("OK\n")); NEXT_INST_F(6, 0, 0); } slowUnsetScalar: DECACHE_STACK_INFO(); if (TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, flags, opnd) != TCL_OK && flags) { goto errorInUnset; } CACHE_STACK_INFO(); NEXT_INST_F(6, 0, 0); case INST_UNSET_ARRAY: flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0; opnd = TclGetUInt4AtPtr(pc+2); part2Ptr = OBJ_AT_TOS; arrayPtr = LOCAL(opnd); while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } TRACE(("%s %u \"%.30s\" => ", (flags ? "normal" : "noerr"), opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr) && !(arrayPtr->flags & VAR_SEARCH_ACTIVE)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectUnsettable(varPtr)) { /* * No nasty traces and element exists, so we can proceed to * unset it. Might still not exist though... */ if (!TclIsVarUndefined(varPtr)) { TclDecrRefCount(varPtr->value.objPtr); TclSetVarUndefined(varPtr); TclClearVarNamespaceVar(varPtr); TclCleanupVar(varPtr, arrayPtr); } else if (flags & TCL_LEAVE_ERR_MSG) { goto slowUnsetArray; } TRACE_APPEND(("OK\n")); NEXT_INST_F(6, 1, 0); } else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) { /* * Don't need to do anything here. */ TRACE_APPEND(("OK\n")); NEXT_INST_F(6, 1, 0); } } slowUnsetArray: DECACHE_STACK_INFO(); varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset", 0, 0, arrayPtr, opnd); if (!varPtr) { if (flags & TCL_LEAVE_ERR_MSG) { goto errorInUnset; } } else if (TclPtrUnsetVarIdx(interp, varPtr, arrayPtr, NULL, part2Ptr, flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) { goto errorInUnset; } CACHE_STACK_INFO(); NEXT_INST_F(6, 1, 0); case INST_UNSET_ARRAY_STK: flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0; cleanup = 2; part2Ptr = OBJ_AT_TOS; /* element name */ part1Ptr = OBJ_UNDER_TOS; /* array name */ TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"), O2S(part1Ptr), O2S(part2Ptr))); goto doUnsetStk; case INST_UNSET_STK: flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0; cleanup = 1; part2Ptr = NULL; part1Ptr = OBJ_AT_TOS; /* variable name */ TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"), O2S(part1Ptr))); doUnsetStk: DECACHE_STACK_INFO(); if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) { goto errorInUnset; } CACHE_STACK_INFO(); TRACE_APPEND(("OK\n")); NEXT_INST_V(2, cleanup, 0); errorInUnset: CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; /* * This is really an unset operation these days. Do not issue. */ case INST_DICT_DONE: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => OK\n", opnd)); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { if (!TclIsVarUndefined(varPtr)) { TclDecrRefCount(varPtr->value.objPtr); } varPtr->value.objPtr = NULL; } else { DECACHE_STACK_INFO(); TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd); CACHE_STACK_INFO(); } NEXT_INST_F(5, 0, 0); } break; /* * End of INST_UNSET instructions. * ----------------------------------------------------------------- * Start of INST_ARRAY instructions. */ case INST_ARRAY_EXISTS_IMM: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; cleanup = 0; part1Ptr = NULL; arrayPtr = NULL; TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } goto doArrayExists; case INST_ARRAY_EXISTS_STK: opnd = -1; pcAdjustment = 1; cleanup = 1; part1Ptr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(part1Ptr))); varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL, /*createPart1*/0, /*createPart2*/0, &arrayPtr); doArrayExists: DECACHE_STACK_INFO(); result = TclCheckArrayTraces(interp, varPtr, arrayPtr, part1Ptr, opnd); CACHE_STACK_INFO(); if (result == TCL_ERROR) { TRACE_ERROR(interp); goto gotError; } if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { objResultPtr = TCONST(1); } else { objResultPtr = TCONST(0); } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); case INST_ARRAY_MAKE_IMM: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; cleanup = 0; part1Ptr = NULL; arrayPtr = NULL; TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } goto doArrayMake; case INST_ARRAY_MAKE_STK: opnd = -1; pcAdjustment = 1; cleanup = 1; part1Ptr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(part1Ptr))); varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/1, /*createPart2*/0, &arrayPtr); if (varPtr == NULL) { TRACE_ERROR(interp); goto gotError; } doArrayMake: if (varPtr && !TclIsVarArray(varPtr)) { if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) { /* * Either an array element, or a scalar: lose! */ TclObjVarErrMsg(interp, part1Ptr, NULL, "array set", "variable isn't array", opnd); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL); CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } TclSetVarArray(varPtr); varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable)); TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr)); #ifdef TCL_COMPILE_DEBUG TRACE_APPEND(("done\n")); } else { TRACE_APPEND(("nothing to do\n")); #endif } NEXT_INST_V(pcAdjustment, cleanup, 0); /* * End of INST_ARRAY instructions. * ----------------------------------------------------------------- * Start of variable linking instructions. */ { Var *otherPtr; CallFrame *framePtr, *savedFramePtr; Tcl_Namespace *nsPtr; Namespace *savedNsPtr; case INST_UPVAR: TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) { TRACE_ERROR(interp); goto gotError; } /* * Locate the other variable. */ savedFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = framePtr; otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL, TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); iPtr->varFramePtr = savedFramePtr; if (!otherPtr) { TRACE_ERROR(interp); goto gotError; } goto doLinkVars; case INST_NSUPVAR: TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } /* * Locate the other variable. */ savedNsPtr = iPtr->varFramePtr->nsPtr; iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr; otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL, (TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS), "access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); iPtr->varFramePtr->nsPtr = savedNsPtr; if (!otherPtr) { TRACE_ERROR(interp); goto gotError; } goto doLinkVars; case INST_VARIABLE: TRACE(("%d, %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_AT_TOS))); otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL, (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); if (!otherPtr) { TRACE_ERROR(interp); goto gotError; } /* * Do the [variable] magic. */ TclSetVarNamespaceVar(otherPtr); doLinkVars: /* * If we are here, the local variable has already been created: do the * little work of TclPtrMakeUpvar that remains to be done right here * if there are no errors; otherwise, let it handle the case. */ opnd = TclGetInt4AtPtr(pc+1); varPtr = LOCAL(opnd); if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr) && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) { if (!TclIsVarUndefined(varPtr)) { /* * Then it is a defined link. */ Var *linkPtr = varPtr->value.linkPtr; if (linkPtr == otherPtr) { TRACE_APPEND(("already linked\n")); NEXT_INST_F(5, 1, 0); } if (TclIsVarInHash(linkPtr)) { VarHashRefCount(linkPtr)--; if (TclIsVarUndefined(linkPtr)) { TclCleanupVar(linkPtr, NULL); } } } TclSetVarLink(varPtr); varPtr->value.linkPtr = otherPtr; if (TclIsVarInHash(otherPtr)) { VarHashRefCount(otherPtr)++; } } else if (TclPtrObjMakeUpvarIdx(interp, otherPtr, NULL, 0, opnd) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } /* * Do not pop the namespace or frame index, it may be needed for other * variables - and [variable] did not push it at all. */ TRACE_APPEND(("link made\n")); NEXT_INST_F(5, 1, 0); } break; /* * End of variable linking instructions. * ----------------------------------------------------------------- */ case INST_JUMP1: opnd = TclGetInt1AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); break; case INST_JUMP4: opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); { int jmpOffset[2], b; /* TODO: consider rewrite so we don't compute the offset we're not * going to take. */ case INST_JUMP_FALSE4: jmpOffset[0] = TclGetInt4AtPtr(pc+1); /* FALSE offset */ jmpOffset[1] = 5; /* TRUE offset */ goto doCondJump; case INST_JUMP_TRUE4: jmpOffset[0] = 5; jmpOffset[1] = TclGetInt4AtPtr(pc+1); goto doCondJump; case INST_JUMP_FALSE1: jmpOffset[0] = TclGetInt1AtPtr(pc+1); jmpOffset[1] = 2; goto doCondJump; case INST_JUMP_TRUE1: jmpOffset[0] = 2; jmpOffset[1] = TclGetInt1AtPtr(pc+1); doCondJump: valuePtr = OBJ_AT_TOS; TRACE(("%d => ", jmpOffset[ (*pc==INST_JUMP_FALSE1 || *pc==INST_JUMP_FALSE4) ? 0 : 1])); /* TODO - check claim that taking address of b harms performance */ /* TODO - consider optimization search for constants */ if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } #ifdef TCL_COMPILE_DEBUG if (b) { if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr), (unsigned)(pc + jmpOffset[1] - codePtr->codeStart))); } else { TRACE_APPEND(("%.20s true\n", O2S(valuePtr))); } } else { if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { TRACE_APPEND(("%.20s false\n", O2S(valuePtr))); } else { TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr), (unsigned)(pc + jmpOffset[0] - codePtr->codeStart))); } } #endif NEXT_INST_F(jmpOffset[b], 1, 0); } break; case INST_JUMP_TABLE: { Tcl_HashEntry *hPtr; JumptableInfo *jtPtr; /* * Jump to location looked up in a hashtable; fall through to next * instr if lookup fails. */ opnd = TclGetInt4AtPtr(pc+1); jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData; TRACE(("%d \"%.20s\" => ", opnd, O2S(OBJ_AT_TOS))); hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS)); if (hPtr != NULL) { int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr)); TRACE_APPEND(("found in table, new pc %u\n", (unsigned)(pc - codePtr->codeStart + jumpOffset))); NEXT_INST_F(jumpOffset, 1, 0); } else { TRACE_APPEND(("not found in table\n")); NEXT_INST_F(5, 1, 0); } } break; /* * These two instructions are now redundant: the complete logic of the LOR * and LAND is now handled by the expression compiler. */ case INST_LOR: case INST_LAND: { /* * Operands must be boolean or numeric. No int->double conversions are * performed. */ int i1, i2, iResult; value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto gotError; } if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); CACHE_STACK_INFO(); goto gotError; } if (*pc == INST_LOR) { iResult = (i1 || i2); } else { iResult = (i1 && i2); } objResultPtr = TCONST(iResult); TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult)); NEXT_INST_F(1, 2, 1); } break; /* * ----------------------------------------------------------------- * Start of general introspector instructions. */ case INST_NS_CURRENT: { Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { TclNewLiteralStringObj(objResultPtr, "::"); } else { TclNewStringObj(objResultPtr, currNsPtr->fullName, strlen(currNsPtr->fullName)); } TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); } break; case INST_COROUTINE_NAME: { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; TclNewObj(objResultPtr); if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) { Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr, objResultPtr); } TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); } break; case INST_INFO_LEVEL_NUM: TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_INFO_LEVEL_ARGS: { int level; CallFrame *framePtr = iPtr->varFramePtr; CallFrame *rootFramePtr = iPtr->rootFramePtr; TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (level <= 0) { level += framePtr->level; } for (; (framePtr->level!=level) && (framePtr!=rootFramePtr) ; framePtr = framePtr->callerVarPtr) { /* Empty loop body */ } if (framePtr == rootFramePtr) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad level \"%s\"", TclGetString(OBJ_AT_TOS))); TRACE_ERROR(interp); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL", TclGetString(OBJ_AT_TOS), NULL); CACHE_STACK_INFO(); goto gotError; } objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } { Tcl_Command cmd, origCmd; case INST_RESOLVE_COMMAND: cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); TclNewObj(objResultPtr); if (cmd != NULL) { Tcl_GetCommandFullName(interp, cmd, objResultPtr); } TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); case INST_ORIGIN_COMMAND: TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); if (cmd == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS))); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", TclGetString(OBJ_AT_TOS), NULL); CACHE_STACK_INFO(); TRACE_APPEND(("ERROR: not command\n")); goto gotError; } origCmd = TclGetOriginalCommand(cmd); if (origCmd == NULL) { origCmd = cmd; } TclNewObj(objResultPtr); Tcl_GetCommandFullName(interp, origCmd, objResultPtr); TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS))); NEXT_INST_F(1, 1, 1); } /* * ----------------------------------------------------------------- * Start of TclOO support instructions. */ { Object *oPtr; CallFrame *framePtr; CallContext *contextPtr; int skip, newDepth; case INST_TCLOO_SELF: framePtr = iPtr->varFramePtr; if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { TRACE(("=> ERROR: no TclOO call context\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( "self may only be called from inside a method", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); CACHE_STACK_INFO(); goto gotError; } contextPtr = framePtr->clientData; /* * Call out to get the name; it's expensive to compute but cached. */ objResultPtr = TclOOObjectName(interp, contextPtr->oPtr); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_TCLOO_NEXT_CLASS: opnd = TclGetUInt1AtPtr(pc+1); framePtr = iPtr->varFramePtr; valuePtr = OBJ_AT_DEPTH(opnd - 2); objv = &OBJ_AT_DEPTH(opnd - 1); skip = 2; TRACE(("%d => ", opnd)); if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { TRACE_APPEND(("ERROR: no TclOO call context\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( "nextto may only be called from inside a method", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); CACHE_STACK_INFO(); goto gotError; } contextPtr = framePtr->clientData; oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr); if (oPtr == NULL) { TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr))); goto gotError; } else { Class *classPtr = oPtr->classPtr; struct MInvoke *miPtr; int i; const char *methodType; if (classPtr == NULL) { TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr))); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" is not a class", TclGetString(valuePtr))); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL); CACHE_STACK_INFO(); goto gotError; } for (i=contextPtr->index+1 ; icallPtr->numChain ; i++) { miPtr = contextPtr->callPtr->chain + i; if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) { newDepth = i; #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); } else { fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels, (unsigned)(pc - codePtr->codeStart)); } for (i = 0; i < opnd; i++) { TclPrintObject(stdout, objv[i], 15); fprintf(stdout, " "); } fprintf(stdout, "\n"); fflush(stdout); } #endif /*TCL_COMPILE_DEBUG*/ goto doInvokeNext; } } if (contextPtr->callPtr->flags & CONSTRUCTOR) { methodType = "constructor"; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { methodType = "destructor"; } else { methodType = "method"; } TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n", O2S(valuePtr))); for (i=contextPtr->index ; i>=0 ; i--) { miPtr = contextPtr->callPtr->chain + i; if (miPtr->isFilter || miPtr->mPtr->declaringClassPtr != classPtr) { continue; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s implementation by \"%s\" not reachable from here", methodType, TclGetString(valuePtr))); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE", NULL); CACHE_STACK_INFO(); goto gotError; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s has no non-filter implementation by \"%s\"", methodType, TclGetString(valuePtr))); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL); CACHE_STACK_INFO(); goto gotError; } case INST_TCLOO_NEXT: opnd = TclGetUInt1AtPtr(pc+1); objv = &OBJ_AT_DEPTH(opnd - 1); framePtr = iPtr->varFramePtr; skip = 1; TRACE(("%d => ", opnd)); if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { TRACE_APPEND(("ERROR: no TclOO call context\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( "next may only be called from inside a method", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); CACHE_STACK_INFO(); goto gotError; } contextPtr = framePtr->clientData; newDepth = contextPtr->index + 1; if (newDepth >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless * the interpreter is being torn down, in which case we might be * getting here because of methods/destructors doing a [next] (or * equivalent) unexpectedly. */ const char *methodType; if (contextPtr->callPtr->flags & CONSTRUCTOR) { methodType = "constructor"; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { methodType = "destructor"; } else { methodType = "method"; } TRACE_APPEND(("ERROR: no TclOO next impl\n")); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no next %s implementation", methodType)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); CACHE_STACK_INFO(); goto gotError; #ifdef TCL_COMPILE_DEBUG } else if (tclTraceExec >= 2) { int i; if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); } else { fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels, (unsigned)(pc - codePtr->codeStart)); } for (i = 0; i < opnd; i++) { TclPrintObject(stdout, objv[i], 15); fprintf(stdout, " "); } fprintf(stdout, "\n"); fflush(stdout); #endif /*TCL_COMPILE_DEBUG*/ } doInvokeNext: bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { ArgumentBCEnter(interp, codePtr, TD, pc, opnd, objv); } pcAdjustment = 2; cleanup = opnd; DECACHE_STACK_INFO(); iPtr->varFramePtr = framePtr->callerVarPtr; pc += pcAdjustment; TEBC_YIELD(); TclPushTailcallPoint(interp); oPtr = contextPtr->oPtr; if (oPtr->flags & FILTER_HANDLING) { TclNRAddCallback(interp, FinalizeOONextFilter, framePtr, contextPtr, INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip)); } else { TclNRAddCallback(interp, FinalizeOONext, framePtr, contextPtr, INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip)); } contextPtr->skip = skip; contextPtr->index = newDepth; if (contextPtr->callPtr->chain[newDepth].isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { oPtr->flags |= FILTER_HANDLING; } else { oPtr->flags &= ~FILTER_HANDLING; } { Method *const mPtr = contextPtr->callPtr->chain[newDepth].mPtr; return mPtr->typePtr->callProc(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, opnd, objv); } case INST_TCLOO_IS_OBJECT: oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS); objResultPtr = TCONST(oPtr != NULL ? 1 : 0); TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); case INST_TCLOO_CLASS: oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS); if (oPtr == NULL) { TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS))); goto gotError; } objResultPtr = TclOOObjectName(interp, oPtr->selfCls->thisPtr); TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); case INST_TCLOO_NS: oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS); if (oPtr == NULL) { TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS))); goto gotError; } /* * TclOO objects *never* have the global namespace as their NS. */ TclNewStringObj(objResultPtr, oPtr->namespacePtr->fullName, strlen(oPtr->namespacePtr->fullName)); TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); } /* * End of TclOO support instructions. * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ { int index, numIndices, fromIdx, toIdx; int nocase, match, length2, cflags, s1len, s2len; const char *s1, *s2; case INST_LIST: /* * Pop the opnd (objc) top stack elements into a new list obj and then * decrement their ref counts. */ opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); case INST_LIST_LENGTH: TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } TclNewIntObj(objResultPtr, length); TRACE_APPEND(("%d\n", length)); NEXT_INST_F(1, 1, 1); case INST_LIST_INDEX: /* lindex with objc == 3 */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* * Extract the desired list element. */ if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) && (value2Ptr->typePtr != &tclListType) && (TclGetIntForIndexM(NULL , value2Ptr, objc-1, &index) == TCL_OK)) { TclDecrRefCount(value2Ptr); tosPtr--; pcAdjustment = 1; goto lindexFastPath; } objResultPtr = TclLindexList(interp, valuePtr, value2Ptr); if (!objResultPtr) { TRACE_ERROR(interp); goto gotError; } /* * Stash the list element on the stack. */ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, -1); /* Already has the correct refCount */ case INST_LIST_INDEX_IMM: /* lindex with objc==3 and index in bytecode * stream */ /* * Pop the list and get the index. */ valuePtr = OBJ_AT_TOS; opnd = TclGetInt4AtPtr(pc+1); TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd)); /* * Get the contents of the list, making sure that it really is a list * in the process. */ if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } /* Decode end-offset index values. */ index = TclIndexDecode(opnd, objc - 1); pcAdjustment = 5; lindexFastPath: if (index >= 0 && index < objc) { objResultPtr = objv[index]; } else { TclNewObj(objResultPtr); } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(pcAdjustment, 1, 1); case INST_LIST_INDEX_MULTI: /* 'lindex' with multiple index args */ /* * Determine the count of index args. */ opnd = TclGetUInt4AtPtr(pc+1); numIndices = opnd-1; /* * Do the 'lindex' operation. */ TRACE(("%d => ", opnd)); objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices), numIndices, &OBJ_AT_DEPTH(numIndices - 1)); if (!objResultPtr) { TRACE_ERROR(interp); goto gotError; } /* * Set result. */ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(5, opnd, -1); case INST_LSET_FLAT: /* * Lset with 3, 5, or more args. Get the number of index args. */ opnd = TclGetUInt4AtPtr(pc + 1); numIndices = opnd - 2; TRACE(("%d => ", opnd)); /* * Get the old value of variable, and remove the stack ref. This is * safe because the variable still references the object; the ref * count will never go zero here - we can use the smaller macro * Tcl_DecrRefCount. */ valuePtr = POP_OBJECT(); Tcl_DecrRefCount(valuePtr); /* This one should be done here */ /* * Compute the new variable value. */ objResultPtr = TclLsetFlat(interp, valuePtr, numIndices, &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); if (!objResultPtr) { TRACE_ERROR(interp); goto gotError; } /* * Set result. */ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(5, numIndices+1, -1); case INST_LSET_LIST: /* 'lset' with 4 args */ /* * Get the old value of variable, and remove the stack ref. This is * safe because the variable still references the object; the ref * count will never go zero here - we can use the smaller macro * Tcl_DecrRefCount. */ objPtr = POP_OBJECT(); Tcl_DecrRefCount(objPtr); /* This one should be done here. */ /* * Get the new element value, and the index list. */ valuePtr = OBJ_AT_TOS; value2Ptr = OBJ_UNDER_TOS; TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ", O2S(value2Ptr), O2S(valuePtr), O2S(objPtr))); /* * Compute the new variable value. */ objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr); if (!objResultPtr) { TRACE_ERROR(interp); goto gotError; } /* * Set result. */ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, -1); case INST_LIST_RANGE_IMM: /* lrange with objc==4 and both indices in * bytecode stream */ /* * Pop the list and get the indices. */ valuePtr = OBJ_AT_TOS; fromIdx = TclGetInt4AtPtr(pc+1); toIdx = TclGetInt4AtPtr(pc+5); TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5))); /* * Get the contents of the list, making sure that it really is a list * in the process. */ if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } /* * Skip a lot of work if we're about to throw the result away (common * with uses of [lassign]). */ #ifndef TCL_COMPILE_DEBUG if (*(pc+9) == INST_POP) { NEXT_INST_F(10, 1, 0); } #endif /* Every range of an empty list is an empty list */ if (objc == 0) { /* avoid return of not canonical list (e. g. spaces in string repr.) */ if (!valuePtr->bytes || !valuePtr->length) { TRACE_APPEND(("\n")); NEXT_INST_F(9, 0, 0); } goto emptyList; } /* Decode index value operands. */ /* assert ( toIdx != TCL_INDEX_AFTER); * * Extra safety for legacy bytecodes: */ if (toIdx == TCL_INDEX_AFTER) { toIdx = TCL_INDEX_END; } if ((toIdx == TCL_INDEX_BEFORE) || (fromIdx == TCL_INDEX_AFTER)) { goto emptyList; } toIdx = TclIndexDecode(toIdx, objc - 1); if (toIdx < 0) { goto emptyList; } else if (toIdx >= objc) { toIdx = objc - 1; } assert ( toIdx >= 0 && toIdx < objc); /* assert ( fromIdx != TCL_INDEX_BEFORE ); * * Extra safety for legacy bytecodes: */ if (fromIdx == TCL_INDEX_BEFORE) { fromIdx = TCL_INDEX_START; } fromIdx = TclIndexDecode(fromIdx, objc - 1); if (fromIdx < 0) { fromIdx = 0; } if (fromIdx <= toIdx) { /* Construct the subsequence list */ /* unshared optimization */ if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx); } else { if (toIdx != objc - 1) { Tcl_ListObjReplace(NULL, valuePtr, toIdx + 1, LIST_MAX, 0, NULL); } Tcl_ListObjReplace(NULL, valuePtr, 0, fromIdx, 0, NULL); TRACE_APPEND(("%.30s\n", O2S(valuePtr))); NEXT_INST_F(9, 0, 0); } } else { emptyList: TclNewObj(objResultPtr); } TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); case INST_LIST_IN: case INST_LIST_NOT_IN: /* Basic list containment operators. */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; s1 = TclGetStringFromObj(valuePtr, &s1len); TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } match = 0; if (length > 0) { int i = 0; Tcl_Obj *o; /* * An empty list doesn't match anything. */ do { Tcl_ListObjIndex(NULL, value2Ptr, i, &o); if (o != NULL) { s2 = TclGetStringFromObj(o, &s2len); } else { s2 = ""; s2len = 0; } if (s1len == s2len) { match = (memcmp(s1, s2, s1len) == 0); } i++; } while (i < length && match == 0); } if (*pc == INST_LIST_NOT_IN) { match = !match; } TRACE_APPEND(("%d\n", match)); /* * Peep-hole optimisation: if you're about to jump, do jump from here. * We're saving the effort of pushing a boolean value only to pop it * for branching. */ JUMP_PEEPHOLE_F(match, 1, 2); case INST_LIST_CONCAT: value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_DuplicateObj(valuePtr); if (Tcl_ListObjAppendList(interp, objResultPtr, value2Ptr) != TCL_OK) { TRACE_ERROR(interp); TclDecrRefCount(objResultPtr); goto gotError; } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } else { if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){ TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } /* * End of INST_LIST and related instructions. * ----------------------------------------------------------------- * Start of string-related instructions. */ case INST_STR_EQ: case INST_STR_NEQ: /* String (in)equality check */ case INST_STR_CMP: /* String compare. */ stringCompare: value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; { int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ) || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ)); match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1); } /* * Make sure only -1,0,1 is returned * TODO: consider peephole opt. */ if (*pc != INST_STR_CMP) { /* * Take care of the opcodes that goto'ed into here. */ switch (*pc) { case INST_STR_EQ: case INST_EQ: match = (match == 0); break; case INST_STR_NEQ: case INST_NEQ: match = (match != 0); break; case INST_LT: match = (match < 0); break; case INST_GT: match = (match > 0); break; case INST_LE: match = (match <= 0); break; case INST_GE: match = (match >= 0); break; } } TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr), (match < 0 ? -1 : match > 0 ? 1 : 0))); JUMP_PEEPHOLE_F(match, 1, 2); case INST_STR_LEN: valuePtr = OBJ_AT_TOS; length = Tcl_GetCharLength(valuePtr); TclNewIntObj(objResultPtr, length); TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); case INST_STR_UPPER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { s1 = TclGetStringFromObj(valuePtr, &length); TclNewStringObj(objResultPtr, s1, length); length = Tcl_UtfToUpper(TclGetString(objResultPtr)); Tcl_SetObjLength(objResultPtr, length); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { length = Tcl_UtfToUpper(TclGetString(valuePtr)); Tcl_SetObjLength(valuePtr, length); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } case INST_STR_LOWER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { s1 = TclGetStringFromObj(valuePtr, &length); TclNewStringObj(objResultPtr, s1, length); length = Tcl_UtfToLower(TclGetString(objResultPtr)); Tcl_SetObjLength(objResultPtr, length); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { length = Tcl_UtfToLower(TclGetString(valuePtr)); Tcl_SetObjLength(valuePtr, length); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } case INST_STR_TITLE: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { s1 = TclGetStringFromObj(valuePtr, &length); TclNewStringObj(objResultPtr, s1, length); length = Tcl_UtfToTitle(TclGetString(objResultPtr)); Tcl_SetObjLength(objResultPtr, length); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { length = Tcl_UtfToTitle(TclGetString(valuePtr)); Tcl_SetObjLength(valuePtr, length); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } case INST_STR_INDEX: value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr))); /* * Get char length to calculate what 'end' means. */ length = Tcl_GetCharLength(valuePtr); if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } if ((index < 0) || (index >= length)) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1); } else if (valuePtr->bytes && length == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); } else { char buf[8] = ""; int ch = TclGetUCS4(valuePtr, index); length = TclUCS4ToUtf(ch, buf); objResultPtr = Tcl_NewStringObj(buf, length); } TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_RANGE: TRACE(("\"%.20s\" %.20s %.20s =>", O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length, &fromIdx) != TCL_OK || TclGetIntForIndexM(interp, OBJ_AT_TOS, length, &toIdx) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (fromIdx < 0) { fromIdx = 0; } if (toIdx >= length) { toIdx = length; } if (toIdx >= fromIdx) { objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); } else { TclNewObj(objResultPtr); } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(1, 3, 1); case INST_STR_RANGE_IMM: valuePtr = OBJ_AT_TOS; fromIdx = TclGetInt4AtPtr(pc+1); toIdx = TclGetInt4AtPtr(pc+5); length = Tcl_GetCharLength(valuePtr); TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx)); /* Every range of an empty value is an empty value */ if (length == 0) { TRACE_APPEND(("\n")); NEXT_INST_F(9, 0, 0); } /* Decode index operands. */ /* assert ( toIdx != TCL_INDEX_BEFORE ); assert ( toIdx != TCL_INDEX_AFTER); * * Extra safety for legacy bytecodes: */ if (toIdx == TCL_INDEX_BEFORE) { goto emptyRange; } if (toIdx == TCL_INDEX_AFTER) { toIdx = TCL_INDEX_END; } toIdx = TclIndexDecode(toIdx, length - 1); if (toIdx < 0) { goto emptyRange; } else if (toIdx >= length) { toIdx = length - 1; } assert ( toIdx >= 0 && toIdx < length ); /* assert ( fromIdx != TCL_INDEX_BEFORE ); assert ( fromIdx != TCL_INDEX_AFTER); * * Extra safety for legacy bytecodes: */ if (fromIdx == TCL_INDEX_BEFORE) { fromIdx = TCL_INDEX_START; } if (fromIdx == TCL_INDEX_AFTER) { goto emptyRange; } fromIdx = TclIndexDecode(fromIdx, length - 1); if (fromIdx < 0) { fromIdx = 0; } if (fromIdx <= toIdx) { objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } else { emptyRange: TclNewObj(objResultPtr); } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); { Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p; int length3, endIdx; Tcl_Obj *value3Ptr; case INST_STR_REPLACE: value3Ptr = POP_OBJECT(); valuePtr = OBJ_AT_DEPTH(2); endIdx = Tcl_GetCharLength(valuePtr) - 1; TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr))); if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx, &fromIdx) != TCL_OK || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx, &toIdx) != TCL_OK) { TclDecrRefCount(value3Ptr); TRACE_ERROR(interp); goto gotError; } TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); if ((toIdx < 0) || (fromIdx > endIdx) || (toIdx < fromIdx)) { TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); TclDecrRefCount(value3Ptr); NEXT_INST_F(1, 0, 0); } if (fromIdx < 0) { fromIdx = 0; } if (toIdx > endIdx) { toIdx = endIdx; } if (fromIdx == 0 && toIdx == endIdx) { TclDecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = value3Ptr; TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr))); NEXT_INST_F(1, 0, 0); } length3 = Tcl_GetCharLength(value3Ptr); /* * See if we can splice in place. This happens when the number of * characters being replaced is the same as the number of characters * in the string to be inserted. */ if (length3 - 1 == toIdx - fromIdx) { unsigned char *bytes1, *bytes2; if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_DuplicateObj(valuePtr); } else { objResultPtr = valuePtr; } if (TclIsPureByteArray(objResultPtr) && TclIsPureByteArray(value3Ptr)) { bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL); bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL); memcpy(bytes1 + fromIdx, bytes2, length3); } else { ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL); ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL); memcpy(ustring1 + fromIdx, ustring2, length3 * sizeof(Tcl_UniChar)); } Tcl_InvalidateStringRep(objResultPtr); TclDecrRefCount(value3Ptr); TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); if (objResultPtr == valuePtr) { NEXT_INST_F(1, 0, 0); } else { NEXT_INST_F(1, 1, 1); } } /* * Get the Unicode representation; this is where we guarantee to lose * bytearrays. */ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); length--; /* * Remove substring using copying. */ objResultPtr = NULL; if (fromIdx > 0) { objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx); } if (length3 > 0) { if (objResultPtr) { Tcl_AppendObjToObj(objResultPtr, value3Ptr); } else if (Tcl_IsShared(value3Ptr)) { objResultPtr = Tcl_DuplicateObj(value3Ptr); } else { objResultPtr = value3Ptr; } } if (toIdx < length) { if (objResultPtr) { Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, length - toIdx); } else { objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1, length - toIdx); } } if (objResultPtr == NULL) { /* This has to be the case [string replace $s 0 end {}] */ /* which has result {} which is same as value3Ptr. */ objResultPtr = value3Ptr; } if (objResultPtr == value3Ptr) { /* See [Bug 82e7f67325] */ TclDecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = value3Ptr; TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr))); NEXT_INST_F(1, 0, 0); } TclDecrRefCount(value3Ptr); TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); case INST_STR_MAP: valuePtr = OBJ_AT_TOS; /* "Main" string. */ value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */ value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */ if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; goto doneStringMap; } ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); if (length == 0) { objResultPtr = valuePtr; goto doneStringMap; } ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); if (length2 > length || length2 == 0) { objResultPtr = valuePtr; goto doneStringMap; } else if (length2 == length) { if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } goto doneStringMap; } ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; end = ustring1 + length; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ (end-ustring1 >= length2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3); } } if (p != ustring1) { /* * Put the rest of the unmapped chars onto result. */ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); } doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); case INST_STR_FIND: ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */ match = -1; if (length2 > 0 && length2 <= length) { end = ustring1 + length - length2 + 1; for (p=ustring1 ; p %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */ match = -1; if (length2 > 0 && length2 <= length) { for (p=ustring1+length-length2 ; p>=ustring1 ; p--) { if ((*p == *ustring2) && memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) { match = p - ustring1; break; } } } TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_CLASS: opnd = TclGetInt1AtPtr(pc+1); valuePtr = OBJ_AT_TOS; TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, O2S(valuePtr))); ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); match = 1; if (length > 0) { int ch; end = ustring1 + length; for (p=ustring1 ; ptypePtr == &tclStringType) || (value2Ptr->typePtr == &tclStringType)) { Tcl_UniChar *ustring1, *ustring2; ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); match = TclUniCharMatch(ustring1, length, ustring2, length2, nocase); } else if (TclIsPureByteArray(valuePtr) && !nocase) { unsigned char *bytes1, *bytes2; bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length); bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2); match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0); } else { match = Tcl_StringCaseMatch(TclGetString(valuePtr), TclGetString(value2Ptr), nocase); } /* * Reuse value2Ptr object already on stack if possible. Adjustment is * 2 due to the nocase byte */ TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match)); /* * Peep-hole optimisation: if you're about to jump, do jump from here. */ JUMP_PEEPHOLE_F(match, 2, 2); { const char *string1, *string2; int trim1, trim2; case INST_STR_TRIM_LEFT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = TclGetStringFromObj(value2Ptr, &length2); string1 = TclGetStringFromObj(valuePtr, &length); trim1 = TclTrimLeft(string1, length, string2, length2); trim2 = 0; goto createTrimmedString; case INST_STR_TRIM_RIGHT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = TclGetStringFromObj(value2Ptr, &length2); string1 = TclGetStringFromObj(valuePtr, &length); trim2 = TclTrimRight(string1, length, string2, length2); trim1 = 0; goto createTrimmedString; case INST_STR_TRIM: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = TclGetStringFromObj(value2Ptr, &length2); string1 = TclGetStringFromObj(valuePtr, &length); trim1 = TclTrim(string1, length, string2, length2, &trim2); createTrimmedString: /* * Careful here; trim set often contains non-ASCII characters so we * take care when printing. [Bug 971cb4f1db] */ #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { TRACE(("\"%.30s\" ", O2S(valuePtr))); TclPrintObject(stdout, value2Ptr, 30); printf(" => "); } #endif if (trim1 == 0 && trim2 == 0) { #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { TclPrintObject(stdout, valuePtr, 30); printf("\n"); } #endif NEXT_INST_F(1, 1, 0); } else { objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2); #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { TclPrintObject(stdout, objResultPtr, 30); printf("\n"); } #endif NEXT_INST_F(1, 2, 1); } } case INST_REGEXP: cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */ valuePtr = OBJ_AT_TOS; /* String */ value2Ptr = OBJ_UNDER_TOS; /* Pattern */ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* * Compile and match the regular expression. */ { Tcl_RegExp regExpr = Tcl_GetRegExpFromObj(interp, value2Ptr, cflags); if (regExpr == NULL) { TRACE_ERROR(interp); goto gotError; } match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0); if (match < 0) { TRACE_ERROR(interp); goto gotError; } } TRACE_APPEND(("%d\n", match)); /* * Peep-hole optimisation: if you're about to jump, do jump from here. * Adjustment is 2 due to the nocase byte. */ JUMP_PEEPHOLE_F(match, 2, 2); } /* * End of string-related instructions. * ----------------------------------------------------------------- * Start of numeric operator instructions. */ { ClientData ptr1, ptr2; int type1, type2; long l1 = 0, l2, lResult; case INST_NUM_TYPE: if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; } else if (type1 == TCL_NUMBER_LONG) { /* value is between LONG_MIN and LONG_MAX */ /* [string is integer] is -UINT_MAX to UINT_MAX range */ int i; if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) { type1 = TCL_NUMBER_WIDE; } #ifndef TCL_WIDE_INT_IS_LONG } else if (type1 == TCL_NUMBER_WIDE) { /* value is between WIDE_MIN and WIDE_MAX */ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ int i; if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { type1 = TCL_NUMBER_LONG; } #endif } else if (type1 == TCL_NUMBER_BIG) { /* value is an integer outside the WIDE_MIN to WIDE_MAX range */ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ Tcl_WideInt w; if (TclGetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { type1 = TCL_NUMBER_WIDE; } } TclNewIntObj(objResultPtr, type1); TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1)); NEXT_INST_F(1, 1, 1); case INST_EQ: case INST_NEQ: case INST_LT: case INST_GT: case INST_LE: case INST_GE: { int iResult = 0, compare = 0; value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; /* Try to determine, without triggering generation of a string representation, whether one value is not a number. */ if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) { goto stringCompare; } if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK || GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) { /* * At least one non-numeric argument - compare as strings. */ goto stringCompare; } if (type1 == TCL_NUMBER_NAN || type2 == TCL_NUMBER_NAN) { /* * NaN arg: NaN != to everything, other compares are false. */ iResult = (*pc == INST_NEQ); goto foundResult; } if (valuePtr == value2Ptr) { compare = MP_EQ; goto convertComparison; } if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { l1 = *((const long *)ptr1); l2 = *((const long *)ptr2); compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); } else { compare = TclCompareTwoNumbers(valuePtr, value2Ptr); } /* * Turn comparison outcome into appropriate result for opcode. */ convertComparison: switch (*pc) { case INST_EQ: iResult = (compare == MP_EQ); break; case INST_NEQ: iResult = (compare != MP_EQ); break; case INST_LT: iResult = (compare == MP_LT); break; case INST_GT: iResult = (compare == MP_GT); break; case INST_LE: iResult = (compare != MP_GT); break; case INST_GE: iResult = (compare != MP_LT); break; } /* * Peep-hole optimisation: if you're about to jump, do jump from here. */ foundResult: TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult)); JUMP_PEEPHOLE_F(iResult, 1, 2); } case INST_MOD: case INST_LSHIFT: case INST_RSHIFT: case INST_BITOR: case INST_BITXOR: case INST_BITAND: value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) || (type1==TCL_NUMBER_DOUBLE) || (type1==TCL_NUMBER_NAN)) { TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto gotError; } if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) || (type2==TCL_NUMBER_DOUBLE) || (type2==TCL_NUMBER_NAN)) { TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); CACHE_STACK_INFO(); goto gotError; } /* * Check for common, simple case. */ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { l1 = *((const long *)ptr1); l2 = *((const long *)ptr2); switch (*pc) { case INST_MOD: if (l2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); goto divideByZero; } else if ((l2 == 1) || (l2 == -1)) { /* * Div. by |1| always yields remainder of 0. */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); objResultPtr = TCONST(0); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } else if (l1 == 0) { /* * 0 % (non-zero) always yields remainder of 0. */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); objResultPtr = TCONST(0); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } else { lResult = l1 / l2; /* * Force Tcl's integer division rules. * TODO: examine for logic simplification */ if ((lResult < 0 || (lResult == 0 && ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) && (lResult * l2 != l1)) { lResult -= 1; } lResult = (long)((unsigned long)l1 - (unsigned long)l2*(unsigned long)lResult); goto longResultOfArithmetic; } break; case INST_RSHIFT: if (l2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); CACHE_STACK_INFO(); #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; } else if (l1 == 0) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); objResultPtr = TCONST(0); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } else { /* * Quickly force large right shifts to 0 or -1. */ if (l2 >= (long)(CHAR_BIT*sizeof(l1))) { /* * We assume that INT_MAX is much larger than the * number of bits in a long. This is a pretty safe * assumption, given that the former is usually around * 4e9 and the latter 32 or 64... */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (l1 > 0L) { objResultPtr = TCONST(0); } else { TclNewIntObj(objResultPtr, -1); } TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } /* * Handle shifts within the native long range. */ lResult = l1 >> ((int) l2); goto longResultOfArithmetic; } break; case INST_LSHIFT: if (l2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); CACHE_STACK_INFO(); #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; } else if (l1 == 0) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); objResultPtr = TCONST(0); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } else if (l2 > (long) INT_MAX) { /* * Technically, we could hold the value (1 << (INT_MAX+1)) * in an mp_int, but since we're using mp_mul_2d() to do * the work, and it takes only an int argument, that's a * good place to draw the line. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent", -1)); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", NULL); CACHE_STACK_INFO(); #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; } else { int shift = (int) l2; /* * Handle shifts within the native long range. */ if (((size_t) shift < CHAR_BIT*sizeof(l1)) && !((l1>0 ? l1 : ~l1) & -(1UL<<(CHAR_BIT*sizeof(l1) - 1 - shift)))) { lResult = (unsigned long)l1 << shift; goto longResultOfArithmetic; } } /* * Too large; need to use the broken-out function. */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); break; case INST_BITAND: lResult = l1 & l2; goto longResultOfArithmetic; case INST_BITOR: lResult = l1 | l2; goto longResultOfArithmetic; case INST_BITXOR: lResult = l1 ^ l2; longResultOfArithmetic: TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, lResult); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } TclSetLongObj(valuePtr, lResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } } /* * DO NOT MERGE THIS WITH THE EQUIVALENT SECTION LATER! That would * encourage the compiler to inline ExecuteExtendedBinaryMathOp, which * is highly undesirable due to the overall impact on size. */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0), valuePtr, value2Ptr); if (objResultPtr == DIVIDED_BY_ZERO) { TRACE_APPEND(("DIVIDE BY ZERO\n")); goto divideByZero; } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) { TRACE_ERROR(interp); goto gotError; } else if (objResultPtr == NULL) { TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } else { TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } case INST_EXPON: case INST_ADD: case INST_SUB: case INST_DIV: case INST_MULT: value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) || IsErroringNaNType(type1)) { TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(value2Ptr), O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name: "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto gotError; } #ifdef ACCEPT_NAN if (type1 == TCL_NUMBER_NAN) { /* * NaN first argument -> result is also NaN. */ NEXT_INST_F(1, 1, 0); } #endif if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) || IsErroringNaNType(type2)) { TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(value2Ptr), O2S(valuePtr), (value2Ptr->typePtr? value2Ptr->typePtr->name: "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); CACHE_STACK_INFO(); goto gotError; } #ifdef ACCEPT_NAN if (type2 == TCL_NUMBER_NAN) { /* * NaN second argument -> result is also NaN. */ objResultPtr = value2Ptr; NEXT_INST_F(1, 2, 1); } #endif /* * Handle (long,long) arithmetic as best we can without going out to * an external function. */ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { Tcl_WideInt w1, w2, wResult; l1 = *((const long *)ptr1); l2 = *((const long *)ptr2); switch (*pc) { case INST_ADD: w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2); #ifdef TCL_WIDE_INT_IS_LONG /* * Check for overflow. */ if (Overflowing(w1, w2, wResult)) { goto overflow; } #endif goto wideResultOfArithmetic; case INST_SUB: w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2); #ifdef TCL_WIDE_INT_IS_LONG /* * Must check for overflow. The macro tests for overflows in * sums by looking at the sign bits. As we have a subtraction * here, we are adding -w2. As -w2 could in turn overflow, we * test with ~w2 instead: it has the opposite sign bit to w2 * so it does the job. Note that the only "bad" case (w2==0) * is irrelevant for this macro, as in that case w1 and * wResult have the same sign and there is no overflow anyway. */ if (Overflowing(w1, ~w2, wResult)) { goto overflow; } #endif wideResultOfArithmetic: TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(wResult); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } Tcl_SetWideIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); break; case INST_DIV: if (l2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); goto divideByZero; } else if ((l1 == LONG_MIN) && (l2 == -1)) { /* * Can't represent (-LONG_MIN) as a long. */ goto overflow; } lResult = l1 / l2; /* * Force Tcl's integer division rules. * TODO: examine for logic simplification */ if (((lResult < 0) || ((lResult == 0) && ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) && ((lResult * l2) != l1)) { lResult -= 1; } goto longResultOfArithmetic; case INST_MULT: if (((sizeof(long) >= 2*sizeof(int)) && (l1 <= INT_MAX) && (l1 >= INT_MIN) && (l2 <= INT_MAX) && (l2 >= INT_MIN)) || ((sizeof(long) >= 2*sizeof(short)) && (l1 <= SHRT_MAX) && (l1 >= SHRT_MIN) && (l2 <= SHRT_MAX) && (l2 >= SHRT_MIN))) { lResult = l1 * l2; goto longResultOfArithmetic; } } /* * Fall through with INST_EXPON, INST_DIV and large multiplies. */ } overflow: TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0), valuePtr, value2Ptr); if (objResultPtr == DIVIDED_BY_ZERO) { TRACE_APPEND(("DIVIDE BY ZERO\n")); goto divideByZero; } else if (objResultPtr == EXPONENT_OF_ZERO) { TRACE_APPEND(("EXPONENT OF ZERO\n")); goto exponOfZero; } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) { TRACE_ERROR(interp); goto gotError; } else if (objResultPtr == NULL) { TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } else { TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } case INST_LNOT: { int b; valuePtr = OBJ_AT_TOS; /* TODO - check claim that taking address of b harms performance */ /* TODO - consider optimization search for constants */ if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) { TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto gotError; } /* TODO: Consider peephole opt. */ objResultPtr = TCONST(!b); TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 1, 1); } case INST_BITNOT: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) || (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) { /* * ... ~$NonInteger => raise an error. */ TRACE_APPEND(("ERROR: illegal type %s\n", (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto gotError; } if (type1 == TCL_NUMBER_LONG) { l1 = *((const long *) ptr1); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, ~l1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } TclSetLongObj(valuePtr, ~l1); TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr); if (objResultPtr != NULL) { TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } case INST_UMINUS: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) || IsErroringNaNType(type1)) { TRACE_APPEND(("ERROR: illegal type %s \n", (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto gotError; } switch (type1) { case TCL_NUMBER_NAN: /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); break; case TCL_NUMBER_LONG: l1 = *((const long *) ptr1); if (l1 != LONG_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, -l1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } TclSetLongObj(valuePtr, -l1); TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } /* FALLTHROUGH */ } objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr); if (objResultPtr != NULL) { TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } case INST_UPLUS: case INST_TRY_CVT_TO_NUMERIC: /* * Try to convert the topmost stack object to numeric object. This is * done in order to support [expr]'s policy of interpreting operands * if at all possible as numbers first, then strings. */ valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { if (*pc == INST_UPLUS) { /* * ... +$NonNumeric => raise an error. */ TRACE_APPEND(("ERROR: illegal type %s\n", (valuePtr->typePtr? valuePtr->typePtr->name:"null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto gotError; } /* ... TryConvertToNumeric($NonNumeric) is acceptable */ TRACE_APPEND(("not numeric\n")); NEXT_INST_F(1, 0, 0); } if (IsErroringNaNType(type1)) { if (*pc == INST_UPLUS) { /* * ... +$NonNumeric => raise an error. */ TRACE_APPEND(("ERROR: illegal type %s\n", (valuePtr->typePtr? valuePtr->typePtr->name:"null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); } else { /* * Numeric conversion of NaN -> error. */ TRACE_APPEND(("ERROR: IEEE floating pt error\n")); DECACHE_STACK_INFO(); TclExprFloatError(interp, *((const double *) ptr1)); CACHE_STACK_INFO(); } goto gotError; } /* * Ensure that the numeric value has a string rep the same as the * formatted version of its internal rep. This is used, e.g., to make * sure that "expr {0001}" yields "1", not "0001". We implement this * by _discarding_ the string rep since we know it will be * regenerated, if needed later, by formatting the internal rep's * value. */ if (valuePtr->bytes == NULL) { TRACE_APPEND(("numeric, same Tcl_Obj\n")); NEXT_INST_F(1, 0, 0); } if (Tcl_IsShared(valuePtr)) { /* * Here we do some surgery within the Tcl_Obj internals. We want * to copy the internalrep, but not the string, so we temporarily hide * the string so we do not copy it. */ char *savedString = valuePtr->bytes; valuePtr->bytes = NULL; objResultPtr = Tcl_DuplicateObj(valuePtr); valuePtr->bytes = savedString; TRACE_APPEND(("numeric, new Tcl_Obj\n")); NEXT_INST_F(1, 1, 1); } TclInvalidateStringRep(valuePtr); TRACE_APPEND(("numeric, same Tcl_Obj\n")); NEXT_INST_F(1, 0, 0); } break; /* * End of numeric operator instructions. * ----------------------------------------------------------------- */ case INST_TRY_CVT_TO_BOOLEAN: valuePtr = OBJ_AT_TOS; if (valuePtr->typePtr == &tclBooleanType) { objResultPtr = TCONST(1); } else { int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK); objResultPtr = TCONST(res); } TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_BREAK: /* DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); */ result = TCL_BREAK; cleanup = 0; TRACE(("=> BREAK!\n")); goto processExceptionReturn; case INST_CONTINUE: /* DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); */ result = TCL_CONTINUE; cleanup = 0; TRACE(("=> CONTINUE!\n")); goto processExceptionReturn; { ForeachInfo *infoPtr; Var *iterVarPtr, *listVarPtr; Tcl_Obj *oldValuePtr, *listPtr, **elements; ForeachVarList *varListPtr; int numLists, iterNum, listTmpIndex, listLen, numVars; int varIndex, valIndex, continueLoop, j, iterTmpIndex; long i; case INST_FOREACH_START4: /* DEPRECATED */ /* * Initialize the temporary local var that holds the count of the * number of iterations of the loop body to -1. */ opnd = TclGetUInt4AtPtr(pc+1); infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; iterTmpIndex = infoPtr->loopCtTemp; iterVarPtr = LOCAL(iterTmpIndex); oldValuePtr = iterVarPtr->value.objPtr; if (oldValuePtr == NULL) { TclNewLongObj(iterVarPtr->value.objPtr, -1); Tcl_IncrRefCount(iterVarPtr->value.objPtr); } else { TclSetLongObj(oldValuePtr, -1); } TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex)); #ifndef TCL_COMPILE_DEBUG /* * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately * after INST_FOREACH_START4 - let us just fall through instead of * jumping back to the top. */ pc += 5; TCL_DTRACE_INST_NEXT(); #else NEXT_INST_F(5, 0, 0); #endif case INST_FOREACH_STEP4: /* DEPRECATED */ /* * "Step" a foreach loop (i.e., begin its next iteration) by assigning * the next value list element to each loop var. */ opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; numLists = infoPtr->numLists; /* * Increment the temp holding the loop iteration number. */ iterVarPtr = LOCAL(infoPtr->loopCtTemp); valuePtr = iterVarPtr->value.objPtr; iterNum = valuePtr->internalRep.longValue + 1; TclSetLongObj(valuePtr, iterNum); /* * Check whether all value lists are exhausted and we should stop the * loop. */ continueLoop = 0; listTmpIndex = infoPtr->firstValueTemp; for (i = 0; i < numLists; i++) { varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; listVarPtr = LOCAL(listTmpIndex); listPtr = listVarPtr->value.objPtr; if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n", i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } if (listLen > iterNum * numVars) { continueLoop = 1; } listTmpIndex++; } /* * If some var in some var list still has a remaining list element * iterate one more time. Assign to var the next element from its * value list. We already checked above that each list temp holds a * valid list object (by calling Tcl_ListObjLength), but cannot rely * on that check remaining valid: one list could have been shimmered * as a side effect of setting a traced variable. */ if (continueLoop) { listTmpIndex = infoPtr->firstValueTemp; for (i = 0; i < numLists; i++) { varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; listVarPtr = LOCAL(listTmpIndex); listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); TclListObjGetElements(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { if (valIndex >= listLen) { TclNewObj(valuePtr); } else { valuePtr = elements[valIndex]; } varIndex = varListPtr->varIndexes[j]; varPtr = LOCAL(varIndex); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (TclIsVarDirectWritable(varPtr)) { value2Ptr = varPtr->value.objPtr; if (valuePtr != value2Ptr) { if (value2Ptr != NULL) { TclDecrRefCount(value2Ptr); } varPtr->value.objPtr = valuePtr; Tcl_IncrRefCount(valuePtr); } } else { DECACHE_STACK_INFO(); if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ CACHE_STACK_INFO(); TRACE_APPEND(( "ERROR init. index temp %d: %s\n", varIndex, O2S(Tcl_GetObjResult(interp)))); TclDecrRefCount(listPtr); goto gotError; } CACHE_STACK_INFO(); } valIndex++; } TclDecrRefCount(listPtr); listTmpIndex++; } } TRACE_APPEND(("%d lists, iter %d, %s loop\n", numLists, iterNum, (continueLoop? "continue" : "exit"))); /* * Run-time peep-hole optimisation: the compiler ALWAYS follows * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that * instruction and jump direct from here. */ pc += 5; if (*pc == INST_JUMP_FALSE1) { NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0); } else { NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); } } { ForeachInfo *infoPtr; Tcl_Obj *listPtr, **elements; ForeachVarList *varListPtr; int numLists, iterMax, listLen, numVars; int iterTmp, iterNum, listTmpDepth; int varIndex, valIndex, j; long i; case INST_FOREACH_START: /* * Initialize the data for the looping construct, pushing the * corresponding Tcl_Objs to the stack. */ opnd = TclGetUInt4AtPtr(pc+1); infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; numLists = infoPtr->numLists; TRACE(("%u => ", opnd)); /* * Compute the number of iterations that will be run: iterMax */ iterMax = 0; listTmpDepth = numLists-1; for (i = 0; i < numLists; i++) { varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; listPtr = OBJ_AT_DEPTH(listTmpDepth); if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s", i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } if (Tcl_IsShared(listPtr)) { objPtr = TclListObjCopy(NULL, listPtr); Tcl_IncrRefCount(objPtr); Tcl_DecrRefCount(listPtr); OBJ_AT_DEPTH(listTmpDepth) = objPtr; } iterTmp = (listLen + (numVars - 1))/numVars; if (iterTmp > iterMax) { iterMax = iterTmp; } listTmpDepth--; } /* * Store the iterNum and iterMax in a single Tcl_Obj; we keep a * nul-string obj with the pointer stored in the ptrValue so that the * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but * it will never leave this scope and is read-only. */ TclNewObj(tmpPtr); tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0); tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax); PUSH_OBJECT(tmpPtr); /* iterCounts object */ /* * Store a pointer to the ForeachInfo struct; same dirty trick * as above */ TclNewObj(tmpPtr); tmpPtr->internalRep.twoPtrValue.ptr1 = infoPtr; PUSH_OBJECT(tmpPtr); /* infoPtr object */ TRACE_APPEND(("jump to loop step\n")); /* * Jump directly to the INST_FOREACH_STEP instruction; the C code just * falls through. */ pc += 5 - infoPtr->loopCtTemp; case INST_FOREACH_STEP: /* * "Step" a foreach loop (i.e., begin its next iteration) by assigning * the next value list element to each loop var. */ tmpPtr = OBJ_AT_TOS; infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE(("=> ")); tmpPtr = OBJ_AT_DEPTH(1); iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1); iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2); /* * If some list still has a remaining list element iterate one more * time. Assign to var the next element from its value list. */ if (iterNum < iterMax) { /* * Set the variables and jump back to run the body */ tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1); listTmpDepth = numLists + 1; for (i = 0; i < numLists; i++) { varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; listPtr = OBJ_AT_DEPTH(listTmpDepth); TclListObjGetElements(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { if (valIndex >= listLen) { TclNewObj(valuePtr); } else { valuePtr = elements[valIndex]; } varIndex = varListPtr->varIndexes[j]; varPtr = LOCAL(varIndex); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (TclIsVarDirectWritable(varPtr)) { value2Ptr = varPtr->value.objPtr; if (valuePtr != value2Ptr) { if (value2Ptr != NULL) { TclDecrRefCount(value2Ptr); } varPtr->value.objPtr = valuePtr; Tcl_IncrRefCount(valuePtr); } } else { DECACHE_STACK_INFO(); if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ CACHE_STACK_INFO(); TRACE_APPEND(("ERROR init. index temp %d: %.30s", varIndex, O2S(Tcl_GetObjResult(interp)))); goto gotError; } CACHE_STACK_INFO(); } valIndex++; } listTmpDepth--; } TRACE_APPEND(("jump to loop start\n")); /* loopCtTemp being 'misused' for storing the jump size */ NEXT_INST_F(infoPtr->loopCtTemp, 0, 0); } TRACE_APPEND(("loop has no more iterations\n")); #ifdef TCL_COMPILE_DEBUG NEXT_INST_F(1, 0, 0); #else /* * FALL THROUGH */ pc++; #endif case INST_FOREACH_END: /* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */ tmpPtr = OBJ_AT_TOS; infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE(("=> loop terminated\n")); NEXT_INST_V(1, numLists+2, 0); case INST_LMAP_COLLECT: /* * This instruction is only issued by lmap. The stack is: * - result * - infoPtr * - loop counters * - valLists * - collecting obj (unshared) * The instruction lappends the result to the collecting obj. */ tmpPtr = OBJ_AT_DEPTH(1); infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists)); objPtr = OBJ_AT_DEPTH(3 + numLists); Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS); NEXT_INST_F(1, 1, 0); } break; case INST_BEGIN_CATCH4: /* * Record start of the catch command with exception range index equal * to the operand. Push the current stack depth onto the special catch * stack. */ *(++catchTop) = CURR_DEPTH; TRACE(("%u => catchTop=%d, stackTop=%d\n", TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1), (int) CURR_DEPTH)); NEXT_INST_F(5, 0, 0); break; case INST_END_CATCH: catchTop--; DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); result = TCL_OK; TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1))); NEXT_INST_F(1, 0, 0); break; case INST_PUSH_RESULT: objResultPtr = Tcl_GetObjResult(interp); TRACE_WITH_OBJ(("=> "), objResultPtr); /* * See the comments at INST_INVOKE_STK */ TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; NEXT_INST_F(1, 0, -1); break; case INST_PUSH_RETURN_CODE: TclNewIntObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); break; case INST_PUSH_RETURN_OPTIONS: DECACHE_STACK_INFO(); objResultPtr = Tcl_GetReturnOptions(interp, result); CACHE_STACK_INFO(); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_RETURN_CODE_BRANCH: { int code; if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) { Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS not a return code!"); } if (code == TCL_OK) { Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS is TCL_OK!"); } if (code < TCL_ERROR || code > TCL_CONTINUE) { code = TCL_CONTINUE + 1; } TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1)); NEXT_INST_F(2*code-1, 1, 0); } /* * ----------------------------------------------------------------- * Start of dictionary-related instructions. */ { int opnd2, allocateDict, done, i, allocdict; Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr; Tcl_Obj *emptyPtr, **keyPtrPtr; Tcl_DictSearch *searchPtr; DictUpdateInfo *duiPtr; case INST_DICT_VERIFY: dictPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(dictPtr))); if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) { TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n", O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); case INST_DICT_GET: case INST_DICT_EXISTS: { Tcl_Interp *interp2 = interp; int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = OBJ_AT_DEPTH(opnd); if (*pc == INST_DICT_EXISTS) { interp2 = NULL; } if (opnd > 1) { dictPtr = TclTraceDictPath(interp2, dictPtr, opnd-1, &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ); if (dictPtr == NULL) { if (*pc == INST_DICT_EXISTS) { found = 0; goto afterDictExists; } TRACE_WITH_OBJ(( "ERROR tracing dictionary path into \"%.30s\": ", O2S(OBJ_AT_DEPTH(opnd))), Tcl_GetObjResult(interp)); goto gotError; } } if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS, &objResultPtr) == TCL_OK) { if (*pc == INST_DICT_EXISTS) { found = (objResultPtr ? 1 : 0); goto afterDictExists; } if (!objResultPtr) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "key \"%s\" not known in dictionary", TclGetString(OBJ_AT_TOS))); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(OBJ_AT_TOS), NULL); CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(5, opnd+1, 1); } else if (*pc != INST_DICT_EXISTS) { TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s", O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } else { found = 0; } afterDictExists: TRACE_APPEND(("%d\n", found)); /* * The INST_DICT_EXISTS instruction is usually followed by a * conditional jump, so we can take advantage of this to do some * peephole optimization (note that we're careful to not close out * someone doing something else). */ JUMP_PEEPHOLE_V(found, 5, opnd+1); } case INST_DICT_SET: case INST_DICT_UNSET: case INST_DICT_INCR_IMM: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); varPtr = LOCAL(opnd2); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } TRACE(("%u %u => ", opnd, opnd2)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); dictPtr = TclPtrGetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd2); CACHE_STACK_INFO(); } if (dictPtr == NULL) { TclNewObj(dictPtr); allocateDict = 1; } else { allocateDict = Tcl_IsShared(dictPtr); if (allocateDict) { dictPtr = Tcl_DuplicateObj(dictPtr); } } switch (*pc) { case INST_DICT_SET: cleanup = opnd + 1; result = Tcl_DictObjPutKeyList(interp, dictPtr, opnd, &OBJ_AT_DEPTH(opnd), OBJ_AT_TOS); break; case INST_DICT_INCR_IMM: cleanup = 1; opnd = TclGetInt4AtPtr(pc+1); result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &valuePtr); if (result != TCL_OK) { break; } if (valuePtr == NULL) { Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd)); } else { TclNewIntObj(value2Ptr, opnd); Tcl_IncrRefCount(value2Ptr); if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valuePtr); } result = TclIncrObj(interp, valuePtr, value2Ptr); if (result == TCL_OK) { TclInvalidateStringRep(dictPtr); } TclDecrRefCount(value2Ptr); } break; case INST_DICT_UNSET: cleanup = opnd; result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd, &OBJ_AT_DEPTH(opnd-1)); break; default: cleanup = 0; /* stop compiler warning */ Tcl_Panic("Should not happen!"); } if (result != TCL_OK) { if (allocateDict) { TclDecrRefCount(dictPtr); } TRACE_APPEND(("ERROR updating dictionary: %s\n", O2S(Tcl_GetObjResult(interp)))); goto checkForCatch; } if (TclIsVarDirectWritable(varPtr)) { if (allocateDict) { value2Ptr = varPtr->value.objPtr; Tcl_IncrRefCount(dictPtr); if (value2Ptr != NULL) { TclDecrRefCount(value2Ptr); } varPtr->value.objPtr = dictPtr; } objResultPtr = dictPtr; } else { Tcl_IncrRefCount(dictPtr); DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd2); CACHE_STACK_INFO(); TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } } #ifndef TCL_COMPILE_DEBUG if (*(pc+9) == INST_POP) { NEXT_INST_V(10, cleanup, 0); } #endif TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(9, cleanup, 1); case INST_DICT_APPEND: case INST_DICT_LAPPEND: opnd = TclGetUInt4AtPtr(pc+1); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); dictPtr = TclPtrGetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd); CACHE_STACK_INFO(); } if (dictPtr == NULL) { TclNewObj(dictPtr); allocateDict = 1; } else { allocateDict = Tcl_IsShared(dictPtr); if (allocateDict) { dictPtr = Tcl_DuplicateObj(dictPtr); } } if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS, &valuePtr) != TCL_OK) { if (allocateDict) { TclDecrRefCount(dictPtr); } TRACE_ERROR(interp); goto gotError; } /* * Note that a non-existent key results in a NULL valuePtr, which is a * case handled separately below. What we *can* say at this point is * that the write-back will always succeed. */ switch (*pc) { case INST_DICT_APPEND: if (valuePtr == NULL) { Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, OBJ_AT_TOS); } else if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS); Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr); } else { Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS); /* * Must invalidate the string representation of dictionary * here because we have directly updated the internal * representation; if we don't, callers could see the wrong * string rep despite the internal version of the dictionary * having the correct value. [Bug 3079830] */ TclInvalidateStringRep(dictPtr); } break; case INST_DICT_LAPPEND: /* * More complex because list-append can fail. */ if (valuePtr == NULL) { Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, Tcl_NewListObj(1, &OBJ_AT_TOS)); break; } else if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); if (Tcl_ListObjAppendElement(interp, valuePtr, OBJ_AT_TOS) != TCL_OK) { TclDecrRefCount(valuePtr); if (allocateDict) { TclDecrRefCount(dictPtr); } TRACE_ERROR(interp); goto gotError; } Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr); } else { if (Tcl_ListObjAppendElement(interp, valuePtr, OBJ_AT_TOS) != TCL_OK) { if (allocateDict) { TclDecrRefCount(dictPtr); } TRACE_ERROR(interp); goto gotError; } /* * Must invalidate the string representation of dictionary * here because we have directly updated the internal * representation; if we don't, callers could see the wrong * string rep despite the internal version of the dictionary * having the correct value. [Bug 3079830] */ TclInvalidateStringRep(dictPtr); } break; default: Tcl_Panic("Should not happen!"); } if (TclIsVarDirectWritable(varPtr)) { if (allocateDict) { value2Ptr = varPtr->value.objPtr; Tcl_IncrRefCount(dictPtr); if (value2Ptr != NULL) { TclDecrRefCount(value2Ptr); } varPtr->value.objPtr = dictPtr; } objResultPtr = dictPtr; } else { Tcl_IncrRefCount(dictPtr); DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } } #ifndef TCL_COMPILE_DEBUG if (*(pc+5) == INST_POP) { NEXT_INST_F(6, 2, 0); } #endif TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(5, 2, 1); case INST_DICT_FIRST: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = POP_OBJECT(); searchPtr = ckalloc(sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr, &valuePtr, &done) != TCL_OK) { /* * dictPtr is no longer on the stack, and we're not * moving it into the internalrep of an iterator. We need * to drop the refcount [Tcl Bug 9b352768e6]. */ Tcl_DecrRefCount(dictPtr); ckfree(searchPtr); TRACE_ERROR(interp); goto gotError; } TclNewObj(statePtr); statePtr->typePtr = &dictIteratorType; statePtr->internalRep.twoPtrValue.ptr1 = searchPtr; statePtr->internalRep.twoPtrValue.ptr2 = dictPtr; varPtr = LOCAL(opnd); if (varPtr->value.objPtr) { if (varPtr->value.objPtr->typePtr == &dictIteratorType) { Tcl_Panic("mis-issued dictFirst!"); } TclDecrRefCount(varPtr->value.objPtr); } varPtr->value.objPtr = statePtr; Tcl_IncrRefCount(statePtr); goto pushDictIteratorResult; case INST_DICT_NEXT: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); statePtr = (*LOCAL(opnd)).value.objPtr; if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) { Tcl_Panic("mis-issued dictNext!"); } searchPtr = statePtr->internalRep.twoPtrValue.ptr1; Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done); pushDictIteratorResult: if (done) { TclNewObj(emptyPtr); PUSH_OBJECT(emptyPtr); PUSH_OBJECT(emptyPtr); } else { PUSH_OBJECT(valuePtr); PUSH_OBJECT(keyPtr); } TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done)); /* * The INST_DICT_FIRST and INST_DICT_NEXT instructions are always * followed by a conditional jump, so we can take advantage of this to * do some peephole optimization (note that we're careful to not close * out someone doing something else). */ JUMP_PEEPHOLE_F(done, 5, 0); case INST_DICT_UPDATE_START: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); dictPtr = TclPtrGetVarIdx(interp, varPtr, NULL, NULL, NULL, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (dictPtr == NULL) { TRACE_ERROR(interp); goto gotError; } } Tcl_IncrRefCount(dictPtr); if (TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (length != duiPtr->length) { Tcl_Panic("dictUpdateStart argument length mismatch"); } for (i=0 ; ivarIndices[i]); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } DECACHE_STACK_INFO(); if (valuePtr == NULL) { TclObjUnsetVar2(interp, localName(iPtr->varFramePtr, duiPtr->varIndices[i]), NULL, 0); } else if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, valuePtr, TCL_LEAVE_ERR_MSG, duiPtr->varIndices[i]) == NULL) { CACHE_STACK_INFO(); TRACE_ERROR(interp); Tcl_DecrRefCount(dictPtr); goto gotError; } CACHE_STACK_INFO(); } TclDecrRefCount(dictPtr); TRACE_APPEND(("OK\n")); NEXT_INST_F(9, 0, 0); case INST_DICT_UPDATE_END: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); dictPtr = TclPtrGetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd); CACHE_STACK_INFO(); } if (dictPtr == NULL) { TRACE_APPEND(("storage was unset\n")); NEXT_INST_F(9, 1, 0); } if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK || TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } allocdict = Tcl_IsShared(dictPtr); if (allocdict) { dictPtr = Tcl_DuplicateObj(dictPtr); } if (length > 0) { TclInvalidateStringRep(dictPtr); } for (i=0 ; ivarIndices[i]); while (TclIsVarLink(var2Ptr)) { var2Ptr = var2Ptr->value.linkPtr; } if (TclIsVarDirectReadable(var2Ptr)) { valuePtr = var2Ptr->value.objPtr; } else { DECACHE_STACK_INFO(); valuePtr = TclPtrGetVarIdx(interp, var2Ptr, NULL, NULL, NULL, 0, duiPtr->varIndices[i]); CACHE_STACK_INFO(); } if (valuePtr == NULL) { Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]); } else if (dictPtr == valuePtr) { Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], Tcl_DuplicateObj(valuePtr)); } else { Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valuePtr); } } if (TclIsVarDirectWritable(varPtr)) { Tcl_IncrRefCount(dictPtr); TclDecrRefCount(varPtr->value.objPtr); varPtr->value.objPtr = dictPtr; } else { DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (objResultPtr == NULL) { if (allocdict) { TclDecrRefCount(dictPtr); } TRACE_ERROR(interp); goto gotError; } } TRACE_APPEND(("written back\n")); NEXT_INST_F(9, 1, 0); case INST_DICT_EXPAND: dictPtr = OBJ_UNDER_TOS; listPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr))); if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv); if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_DICT_RECOMBINE_STK: keysPtr = POP_OBJECT(); varNamePtr = OBJ_UNDER_TOS; listPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ", O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr))); if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); TclDecrRefCount(keysPtr); goto gotError; } varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr); if (varPtr == NULL) { TRACE_ERROR(interp); TclDecrRefCount(keysPtr); goto gotError; } DECACHE_STACK_INFO(); result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1, objc, objv, keysPtr); CACHE_STACK_INFO(); TclDecrRefCount(keysPtr); if (result != TCL_OK) { TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 2, 0); case INST_DICT_RECOMBINE_IMM: opnd = TclGetUInt4AtPtr(pc+1); listPtr = OBJ_UNDER_TOS; keysPtr = OBJ_AT_TOS; varPtr = LOCAL(opnd); TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr), O2S(keysPtr))); if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } DECACHE_STACK_INFO(); result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd, objc, objv, keysPtr); CACHE_STACK_INFO(); if (result != TCL_OK) { TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(5, 2, 0); } break; /* * End of dictionary-related instructions. * ----------------------------------------------------------------- */ case INST_CLOCK_READ: { /* Read the wall clock */ Tcl_WideInt wval; Tcl_Time now; switch(TclGetUInt1AtPtr(pc+1)) { case 0: /* clicks */ #ifdef TCL_WIDE_CLICKS wval = TclpGetWideClicks(); #else wval = (Tcl_WideInt) TclpGetClicks(); #endif break; case 1: /* microseconds */ Tcl_GetTime(&now); wval = (Tcl_WideInt) now.sec * 1000000 + now.usec; break; case 2: /* milliseconds */ Tcl_GetTime(&now); wval = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000; break; case 3: /* seconds */ Tcl_GetTime(&now); wval = (Tcl_WideInt) now.sec; break; default: Tcl_Panic("clockRead instruction with unknown clock#"); } objResultPtr = Tcl_NewWideIntObj(wval); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(2, 0, 1); } break; default: Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc); } /* end of switch on opCode */ /* * Block for variables needed to process exception returns. */ { ExceptionRange *rangePtr; /* Points to closest loop or catch exception * range enclosing the pc. Used by various * instructions and processCatch to process * break, continue, and errors. */ const char *bytes; /* * An external evaluation (INST_INVOKE or INST_EVAL) returned * something different from TCL_OK, or else INST_BREAK or * INST_CONTINUE were called. */ processExceptionReturn: #ifdef TCL_COMPILE_DEBUG switch (*pc) { case INST_INVOKE_STK1: opnd = TclGetUInt1AtPtr(pc+1); TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf)); break; case INST_INVOKE_STK4: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf)); break; case INST_EVAL_STK: /* * Note that the object at stacktop has to be used before doing * the cleanup. */ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); break; default: TRACE(("=> ")); } #endif if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) { rangePtr = GetExceptRangeForPc(pc, result, codePtr); if (rangePtr == NULL) { TRACE_APPEND(("no encl. loop or catch, returning %s\n", StringForResultCode(result))); goto abnormalReturn; } if (rangePtr->type == CATCH_EXCEPTION_RANGE) { TRACE_APPEND(("%s ...\n", StringForResultCode(result))); goto processCatch; } while (cleanup--) { valuePtr = POP_OBJECT(); TclDecrRefCount(valuePtr); } if (result == TCL_BREAK) { result = TCL_OK; pc = (codePtr->codeStart + rangePtr->breakOffset); TRACE_APPEND(("%s, range at %d, new pc %d\n", StringForResultCode(result), rangePtr->codeOffset, rangePtr->breakOffset)); NEXT_INST_F(0, 0, 0); } if (rangePtr->continueOffset == -1) { TRACE_APPEND(("%s, loop w/o continue, checking for catch\n", StringForResultCode(result))); goto checkForCatch; } result = TCL_OK; pc = (codePtr->codeStart + rangePtr->continueOffset); TRACE_APPEND(("%s, range at %d, new pc %d\n", StringForResultCode(result), rangePtr->codeOffset, rangePtr->continueOffset)); NEXT_INST_F(0, 0, 0); } #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { objPtr = Tcl_GetObjResult(interp); if ((result != TCL_ERROR) && (result != TCL_RETURN)) { TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ", result, O2S(objPtr))); } else { TRACE_APPEND(("%s, result=\"%.30s\"\n", StringForResultCode(result), O2S(objPtr))); } } #endif goto checkForCatch; /* * Division by zero in an expression. Control only reaches this point * by "goto divideByZero". */ divideByZero: Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); CACHE_STACK_INFO(); goto gotError; /* * Exponentiation of zero by negative number in an expression. Control * only reaches this point by "goto exponOfZero". */ exponOfZero: Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponentiation of zero by negative power", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", NULL); CACHE_STACK_INFO(); /* * Almost all error paths feed through here rather than assigning to * result themselves (for a small but consistent saving). */ gotError: result = TCL_ERROR; /* * Execution has generated an "exception" such as TCL_ERROR. If the * exception is an error, record information about what was being * executed when the error occurred. Find the closest enclosing catch * range, if any. If no enclosing catch range is found, stop execution * and return the "exception" code. */ checkForCatch: if (iPtr->execEnvPtr->rewind) { goto abnormalReturn; } if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { const unsigned char *pcBeg; bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL); DECACHE_STACK_INFO(); TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr); CACHE_STACK_INFO(); } iPtr->flags &= ~ERR_ALREADY_LOGGED; /* * Clear all expansions that may have started after the last * INST_BEGIN_CATCH. */ while (auxObjList) { if ((catchTop != initCatchTop) && (*catchTop > (ptrdiff_t) auxObjList->internalRep.twoPtrValue.ptr2)) { break; } POP_TAUX_OBJ(); } /* * We must not catch if the script in progress has been canceled with * the TCL_CANCEL_UNWIND flag. Instead, it blows outwards until we * either hit another interpreter (presumably where the script in * progress has not been canceled) or we get to the top-level. We do * NOT modify the interpreter result here because we know it will * already be set prior to vectoring down to this point in the code. */ if (TclCanceled(iPtr) && (Tcl_Canceled(interp, 0) == TCL_ERROR)) { #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... cancel with unwind, returning %s\n", StringForResultCode(result)); } #endif goto abnormalReturn; } /* * We must not catch an exceeded limit. Instead, it blows outwards * until we either hit another interpreter (presumably where the limit * is not exceeded) or we get to the top-level. */ if (TclLimitExceeded(iPtr->limit)) { #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... limit exceeded, returning %s\n", StringForResultCode(result)); } #endif goto abnormalReturn; } if (catchTop == initCatchTop) { #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... no enclosing catch, returning %s\n", StringForResultCode(result)); } #endif goto abnormalReturn; } rangePtr = GetExceptRangeForPc(pc, TCL_ERROR, codePtr); if (rangePtr == NULL) { /* * This is only possible when compiling a [catch] that sends its * script to INST_EVAL. Cannot correct the compiler without * breaking compat with previous .tbc compiled scripts. */ #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... no enclosing catch, returning %s\n", StringForResultCode(result)); } #endif goto abnormalReturn; } /* * A catch exception range (rangePtr) was found to handle an * "exception". It was found either by checkForCatch just above or by * an instruction during break, continue, or error processing. Jump to * its catchOffset after unwinding the operand stack to the depth it * had when starting to execute the range's catch command. */ processCatch: while (CURR_DEPTH > *catchTop) { valuePtr = POP_OBJECT(); TclDecrRefCount(valuePtr); } #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... found catch at %d, catchTop=%d, " "unwound to %ld, new pc %u\n", rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1), (long) *catchTop, (unsigned) rangePtr->catchOffset); } #endif pc = (codePtr->codeStart + rangePtr->catchOffset); NEXT_INST_F(0, 0, 0); /* Restart the execution loop at pc. */ /* * end of infinite loop dispatching on instructions. */ /* * Done or abnormal return code. Restore the stack to state it had when * starting to execute the ByteCode. Panic if the stack is below the * initial level. */ abnormalReturn: TCL_DTRACE_INST_LAST(); /* * Clear all expansions and same-level NR calls. * * Note that expansion markers have a NULL type; avoid removing other * markers. */ while (auxObjList) { POP_TAUX_OBJ(); } while (tosPtr > initTosPtr) { objPtr = POP_OBJECT(); Tcl_DecrRefCount(objPtr); } if (tosPtr < initTosPtr) { fprintf(stderr, "\nTclNRExecuteByteCode: abnormal return at pc %u: " "stack top %d < entry stack top %d\n", (unsigned)(pc - codePtr->codeStart), (unsigned) CURR_DEPTH, (unsigned) 0); Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top"); } CLANG_ASSERT(bcFramePtr); } iPtr->cmdFramePtr = bcFramePtr->nextPtr; if (codePtr->refCount-- <= 1) { TclCleanupByteCode(codePtr); } TclStackFree(interp, TD); /* free my stack */ return result; /* * INST_START_CMD failure case removed where it doesn't bother that much * * Remark that if the interpreter is marked for deletion its * compileEpoch is modified, so that the epoch check also verifies * that the interp is not deleted. If no outside call has been made * since the last check, it is safe to omit the check. * case INST_START_CMD: */ instStartCmdFailed: { const char *bytes; length = 0; if (TclInterpReady(interp) == TCL_ERROR) { goto gotError; } /* * We used to switch to direct eval; for NRE-awareness we now * compile and eval the command so that this evaluation does not * add a new TEBC instance. Bug [2910748], bug [fa6bf38d07] * * TODO: recompile, search this command and eval a code starting from, * so that this evaluation does not add a new TEBC instance without * NRE-trampoline. */ codePtr->flags |= TCL_BYTECODE_RECOMPILE; bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL); opnd = TclGetUInt4AtPtr(pc+1); pc += (opnd-1); assert(bytes); PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); goto instEvalStk; } } #undef codePtr #undef iPtr #undef bcFramePtr #undef initCatchTop #undef initTosPtr #undef auxObjList #undef catchTop #undef TCONST #undef esPtr static int FinalizeOONext( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; CallContext *contextPtr = data[1]; /* * Reset the variable lookup frame. */ iPtr->varFramePtr = data[0]; /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ contextPtr->index = PTR2INT(data[2]); contextPtr->skip = PTR2INT(data[3]); contextPtr->oPtr->flags &= ~FILTER_HANDLING; return result; } static int FinalizeOONextFilter( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; CallContext *contextPtr = data[1]; /* * Reset the variable lookup frame. */ iPtr->varFramePtr = data[0]; /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ contextPtr->index = PTR2INT(data[2]); contextPtr->skip = PTR2INT(data[3]); contextPtr->oPtr->flags |= FILTER_HANDLING; return result; } /* * LongPwrSmallExpon -- , WidePwrSmallExpon -- * * Helpers to calculate small powers of integers whose result is long or wide. */ #if (LONG_MAX == 0x7FFFFFFF) static inline long LongPwrSmallExpon(long l1, long exponent) { long lResult; lResult = l1 * l1; /* b**2 */ switch (exponent) { case 2: break; case 3: lResult *= l1; /* b**3 */ break; case 4: lResult *= lResult; /* b**4 */ break; case 5: lResult *= lResult; /* b**4 */ lResult *= l1; /* b**5 */ break; case 6: lResult *= l1; /* b**3 */ lResult *= lResult; /* b**6 */ break; case 7: lResult *= l1; /* b**3 */ lResult *= lResult; /* b**6 */ lResult *= l1; /* b**7 */ break; case 8: lResult *= lResult; /* b**4 */ lResult *= lResult; /* b**8 */ break; } return lResult; } #endif static inline Tcl_WideInt WidePwrSmallExpon(Tcl_WideInt w1, long exponent) { Tcl_WideInt wResult; wResult = w1 * w1; /* b**2 */ switch (exponent) { case 2: break; case 3: wResult *= w1; /* b**3 */ break; case 4: wResult *= wResult; /* b**4 */ break; case 5: wResult *= wResult; /* b**4 */ wResult *= w1; /* b**5 */ break; case 6: wResult *= w1; /* b**3 */ wResult *= wResult; /* b**6 */ break; case 7: wResult *= w1; /* b**3 */ wResult *= wResult; /* b**6 */ wResult *= w1; /* b**7 */ break; case 8: wResult *= wResult; /* b**4 */ wResult *= wResult; /* b**8 */ break; case 9: wResult *= wResult; /* b**4 */ wResult *= wResult; /* b**8 */ wResult *= w1; /* b**9 */ break; case 10: wResult *= wResult; /* b**4 */ wResult *= w1; /* b**5 */ wResult *= wResult; /* b**10 */ break; case 11: wResult *= wResult; /* b**4 */ wResult *= w1; /* b**5 */ wResult *= wResult; /* b**10 */ wResult *= w1; /* b**11 */ break; case 12: wResult *= w1; /* b**3 */ wResult *= wResult; /* b**6 */ wResult *= wResult; /* b**12 */ break; case 13: wResult *= w1; /* b**3 */ wResult *= wResult; /* b**6 */ wResult *= wResult; /* b**12 */ wResult *= w1; /* b**13 */ break; case 14: wResult *= w1; /* b**3 */ wResult *= wResult; /* b**6 */ wResult *= w1; /* b**7 */ wResult *= wResult; /* b**14 */ break; case 15: wResult *= w1; /* b**3 */ wResult *= wResult; /* b**6 */ wResult *= w1; /* b**7 */ wResult *= wResult; /* b**14 */ wResult *= w1; /* b**15 */ break; case 16: wResult *= wResult; /* b**4 */ wResult *= wResult; /* b**8 */ wResult *= wResult; /* b**16 */ break; } return wResult; } /* *---------------------------------------------------------------------- * * ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp -- * * These functions do advanced math for binary and unary operators * respectively, so that the main TEBC code does not bear the cost of * them. * * Results: * A Tcl_Obj* result, or a NULL (in which case valuePtr is updated to * hold the result value), or one of the special flag values * GENERAL_ARITHMETIC_ERROR, EXPONENT_OF_ZERO or DIVIDED_BY_ZERO. The * latter two signify a zero value raised to a negative power or a value * divided by zero, respectively. With GENERAL_ARITHMETIC_ERROR, all * error information will have already been reported in the interpreter * result. * * Side effects: * May update the Tcl_Obj indicated valuePtr if it is unshared. Will * return a NULL when that happens. * *---------------------------------------------------------------------- */ static Tcl_Obj * ExecuteExtendedBinaryMathOp( Tcl_Interp *interp, /* Where to report errors. */ int opcode, /* What operation to perform. */ Tcl_Obj **constants, /* The execution environment's constants. */ Tcl_Obj *valuePtr, /* The first operand on the stack. */ Tcl_Obj *value2Ptr) /* The second operand on the stack. */ { #define LONG_RESULT(l) \ if (Tcl_IsShared(valuePtr)) { \ TclNewLongObj(objResultPtr, (l)); \ return objResultPtr; \ } else { \ Tcl_SetLongObj(valuePtr, (l)); \ return NULL; \ } #define WIDE_RESULT(w) \ if (Tcl_IsShared(valuePtr)) { \ return Tcl_NewWideIntObj(w); \ } else { \ Tcl_SetWideIntObj(valuePtr, (w)); \ return NULL; \ } #define BIG_RESULT(b) \ if (Tcl_IsShared(valuePtr)) { \ return Tcl_NewBignumObj(b); \ } else { \ Tcl_SetBignumObj(valuePtr, (b)); \ return NULL; \ } #define DOUBLE_RESULT(d) \ if (Tcl_IsShared(valuePtr)) { \ TclNewDoubleObj(objResultPtr, (d)); \ return objResultPtr; \ } else { \ Tcl_SetDoubleObj(valuePtr, (d)); \ return NULL; \ } int type1, type2; ClientData ptr1, ptr2; double d1, d2, dResult; long l1, l2, lResult; Tcl_WideInt w1, w2, wResult; mp_int big1, big2, bigResult, bigRemainder; Tcl_Obj *objResultPtr; int invalid, zero; int shift; (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); switch (opcode) { case INST_MOD: /* TODO: Attempts to re-use unshared operands on stack */ l2 = 0; /* silence gcc warning */ if (type2 == TCL_NUMBER_LONG) { l2 = *((const long *)ptr2); if (l2 == 0) { return DIVIDED_BY_ZERO; } if ((l2 == 1) || (l2 == -1)) { /* * Div. by |1| always yields remainder of 0. */ return constants[0]; } } #ifndef TCL_WIDE_INT_IS_LONG if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *)ptr1); if (type2 != TCL_NUMBER_BIG) { Tcl_WideInt wQuotient, wRemainder; TclGetWideIntFromObj(NULL, value2Ptr, &w2); wQuotient = w1 / w2; /* * Force Tcl's integer division rules. * TODO: examine for logic simplification */ if (((wQuotient < (Tcl_WideInt) 0) || ((wQuotient == (Tcl_WideInt) 0) && ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0) || (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0)))) && (wQuotient * w2 != w1)) { wQuotient -= (Tcl_WideInt) 1; } wRemainder = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2*(Tcl_WideUInt)wQuotient); WIDE_RESULT(wRemainder); } Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); /* TODO: internals intrusion */ if ((w1 > ((Tcl_WideInt) 0)) ^ !mp_isneg(&big2)) { /* * Arguments are opposite sign; remainder is sum. */ TclBNInitBignumFromWideInt(&big1, w1); mp_add(&big2, &big1, &big2); mp_clear(&big1); BIG_RESULT(&big2); } /* * Arguments are same sign; remainder is first operand. */ mp_clear(&big2); return NULL; } #endif Tcl_GetBignumFromObj(NULL, valuePtr, &big1); Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); mp_init(&bigResult); mp_init(&bigRemainder); mp_div(&big1, &big2, &bigResult, &bigRemainder); if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* * Convert to Tcl's integer division rules. */ mp_sub_d(&bigResult, 1, &bigResult); mp_add(&bigRemainder, &big2, &bigRemainder); } mp_copy(&bigRemainder, &bigResult); mp_clear(&bigRemainder); mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); case INST_LSHIFT: case INST_RSHIFT: { /* * Reject negative shift argument. */ switch (type2) { case TCL_NUMBER_LONG: invalid = (*((const long *)ptr2) < 0L); break; #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; #endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); invalid = (mp_cmp_d(&big2, 0) == MP_LT); mp_clear(&big2); break; default: /* Unused, here to silence compiler warning */ invalid = 0; } if (invalid) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); return GENERAL_ARITHMETIC_ERROR; } /* * Zero shifted any number of bits is still zero. */ if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) { return constants[0]; } if (opcode == INST_LSHIFT) { /* * Large left shifts create integer overflow. * * BEWARE! Can't use Tcl_GetIntFromObj() here because that * converts values in the (unsigned) range to their signed int * counterparts, leading to incorrect results. */ if ((type2 != TCL_NUMBER_LONG) || (*((const long *)ptr2) > (long) INT_MAX)) { /* * Technically, we could hold the value (1 << (INT_MAX+1)) in * an mp_int, but since we're using mp_mul_2d() to do the * work, and it takes only an int argument, that's a good * place to draw the line. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent", -1)); return GENERAL_ARITHMETIC_ERROR; } shift = (int)(*((const long *)ptr2)); /* * Handle shifts within the native wide range. */ if ((type1 != TCL_NUMBER_BIG) && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) { TclGetWideIntFromObj(NULL, valuePtr, &w1); if (!((w1>0 ? w1 : ~w1) & -(((Tcl_WideUInt)1) << (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) { WIDE_RESULT((Tcl_WideUInt)w1 << shift); } } } else { /* * Quickly force large right shifts to 0 or -1. */ if ((type2 != TCL_NUMBER_LONG) || (*(const long *)ptr2 > INT_MAX)) { /* * Again, technically, the value to be shifted could be an * mp_int so huge that a right shift by (INT_MAX+1) bits could * not take us to the result of 0 or -1, but since we're using * mp_div_2d to do the work, and it takes only an int * argument, we draw the line there. */ switch (type1) { case TCL_NUMBER_LONG: zero = (*(const long *)ptr1 > 0L); break; #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; #endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); zero = (mp_cmp_d(&big1, 0) == MP_GT); mp_clear(&big1); break; default: /* Unused, here to silence compiler warning. */ zero = 0; } if (zero) { return constants[0]; } LONG_RESULT(-1); } shift = (int)(*(const long *)ptr2); #ifndef TCL_WIDE_INT_IS_LONG /* * Handle shifts within the native wide range. */ if (type1 == TCL_NUMBER_WIDE) { w1 = *(const Tcl_WideInt *)ptr1; if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) { if (w1 >= (Tcl_WideInt)0) { return constants[0]; } LONG_RESULT(-1); } WIDE_RESULT(w1 >> shift); } #endif } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); mp_init(&bigResult); if (opcode == INST_LSHIFT) { mp_mul_2d(&big1, shift, &bigResult); } else { mp_signed_rsh(&big1, shift, &bigResult); } mp_clear(&big1); BIG_RESULT(&bigResult); } case INST_BITOR: case INST_BITXOR: case INST_BITAND: if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) { Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); mp_init(&bigResult); switch (opcode) { case INST_BITAND: mp_and(&big1, &big2, &bigResult); break; case INST_BITOR: mp_or(&big1, &big2, &bigResult); break; case INST_BITXOR: mp_xor(&big1, &big2, &bigResult); break; } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); } #ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); switch (opcode) { case INST_BITAND: wResult = w1 & w2; break; case INST_BITOR: wResult = w1 | w2; break; case INST_BITXOR: wResult = w1 ^ w2; break; default: /* Unused, here to silence compiler warning. */ wResult = 0; } WIDE_RESULT(wResult); } #endif l1 = *((const long *)ptr1); l2 = *((const long *)ptr2); switch (opcode) { case INST_BITAND: lResult = l1 & l2; break; case INST_BITOR: lResult = l1 | l2; break; case INST_BITXOR: lResult = l1 ^ l2; break; default: /* Unused, here to silence compiler warning. */ lResult = 0; } LONG_RESULT(lResult); case INST_EXPON: { int oddExponent = 0, negativeExponent = 0; unsigned short base; if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) { Tcl_GetDoubleFromObj(NULL, valuePtr, &d1); Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2); if (d1==0.0 && d2<0.0) { return EXPONENT_OF_ZERO; } dResult = pow(d1, d2); goto doubleResult; } l1 = l2 = 0; w1 = w2 = 0; /* to silence compiler warning (maybe-uninitialized) */ switch (type2) { case TCL_NUMBER_LONG: l2 = *((const long *) ptr2); #ifndef TCL_WIDE_INT_IS_LONG pwrLongExpon: #endif if (l2 == 0) { /* * Anything to the zero power is 1. */ return constants[1]; } else if (l2 == 1) { /* * Anything to the first power is itself */ return NULL; } negativeExponent = (l2 < 0); oddExponent = (int) (l2 & 1); break; #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); /* check it fits in long */ l2 = (long)w2; if (w2 == l2) { type2 = TCL_NUMBER_LONG; goto pwrLongExpon; } negativeExponent = (w2 < 0); oddExponent = (int) (w2 & (Tcl_WideInt)1); break; #endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT); mp_mod_2d(&big2, 1, &big2); oddExponent = !mp_iszero(&big2); mp_clear(&big2); break; } switch (type1) { case TCL_NUMBER_LONG: l1 = *((const long *)ptr1); #ifndef TCL_WIDE_INT_IS_LONG pwrLongBase: #endif switch (l1) { case 0: /* * Zero to a positive power is zero. * Zero to a negative power is div by zero error. */ return (!negativeExponent) ? constants[0] : EXPONENT_OF_ZERO; case 1: /* * 1 to any power is 1. */ return constants[1]; case -1: if (!negativeExponent) { if (!oddExponent) { return constants[1]; } LONG_RESULT(-1); } /* negativeExponent */ if (oddExponent) { LONG_RESULT(-1); } return constants[1]; } break; #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w1 = *((const Tcl_WideInt *) ptr1); /* check it fits in long */ l1 = (long)w1; if (w1 == l1) { type1 = TCL_NUMBER_LONG; goto pwrLongBase; } #endif } if (negativeExponent) { /* * Integers with magnitude greater than 1 raise to a negative * power yield the answer zero (see TIP 123). */ return constants[0]; } if (type1 == TCL_NUMBER_BIG) { goto overflowExpon; } /* * We refuse to accept exponent arguments that exceed one mp_digit * which means the max exponent value is 2**28-1 = 0x0FFFFFFF = * 268435455, which fits into a signed 32 bit int which is within the * range of the long type. This means any numeric Tcl_Obj value * not using TCL_NUMBER_LONG type must hold a value larger than we * accept. */ if (type2 != TCL_NUMBER_LONG) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } /* From here (up to overflowExpon) exponent is long (l2). */ if (type1 == TCL_NUMBER_LONG) { if (l1 == 2) { /* * Reduce small powers of 2 to shifts. */ if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { LONG_RESULT(1L << l2); } #if !defined(TCL_WIDE_INT_IS_LONG) if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) { WIDE_RESULT(((Tcl_WideInt) 1) << l2); } #endif goto overflowExpon; } if (l1 == -2) { int signum = oddExponent ? -1 : 1; /* * Reduce small powers of 2 to shifts. */ if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { LONG_RESULT(signum * (1L << l2)); } #if !defined(TCL_WIDE_INT_IS_LONG) if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2)); } #endif goto overflowExpon; } #if (LONG_MAX == 0x7FFFFFFF) if (l2 - 2 < (long)MaxBase32Size && l1 <= MaxBase32[l2 - 2] && l1 >= -MaxBase32[l2 - 2]) { /* * Small powers of 32-bit integers. */ lResult = LongPwrSmallExpon(l1, l2); LONG_RESULT(lResult); } if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) { base = Exp32Index[l1 - 3] + (unsigned short) (l2 - 2 - MaxBase32Size); if (base < Exp32Index[l1 - 2]) { /* * 32-bit number raised to intermediate power, done by * table lookup. */ LONG_RESULT(Exp32Value[base]); } } if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) { base = Exp32Index[-l1 - 3] + (unsigned short) (l2 - 2 - MaxBase32Size); if (base < Exp32Index[-l1 - 2]) { /* * 32-bit number raised to intermediate power, done by * table lookup. */ lResult = (oddExponent) ? -Exp32Value[base] : Exp32Value[base]; LONG_RESULT(lResult); } } #endif #if (LONG_MAX > 0x7FFFFFFF) || !defined(TCL_WIDE_INT_IS_LONG) /* Code below (up to overflowExpon) works with wide-int base */ w1 = l1; #endif } #if (LONG_MAX > 0x7FFFFFFF) || !defined(TCL_WIDE_INT_IS_LONG) /* From here (up to overflowExpon) base is wide-int (w1). */ if (l2 - 2 < (long)MaxBase64Size && w1 <= MaxBase64[l2 - 2] && w1 >= -MaxBase64[l2 - 2]) { /* * Small powers of integers whose result is wide. */ wResult = WidePwrSmallExpon(w1, l2); WIDE_RESULT(wResult); } /* * Handle cases of powers > 16 that still fit in a 64-bit word by * doing table lookup. */ if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) { base = Exp64Index[w1 - 3] + (unsigned short) (l2 - 2 - MaxBase64Size); if (base < Exp64Index[w1 - 2]) { /* * 64-bit number raised to intermediate power, done by * table lookup. */ WIDE_RESULT(Exp64Value[base]); } } if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) { base = Exp64Index[-w1 - 3] + (unsigned short) (l2 - 2 - MaxBase64Size); if (base < Exp64Index[-w1 - 2]) { /* * 64-bit number raised to intermediate power, done by * table lookup. */ wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base]; WIDE_RESULT(wResult); } } #endif overflowExpon: if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK) || (value2Ptr->typePtr != &tclIntType) || (Tcl_WideUInt)w2 >= (1<<28)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); mp_init(&bigResult); mp_expt_u32(&big1, (unsigned int)w2, &bigResult); mp_clear(&big1); BIG_RESULT(&bigResult); } case INST_ADD: case INST_SUB: case INST_MULT: case INST_DIV: if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) { /* * At least one of the values is floating-point, so perform * floating point calculations. */ Tcl_GetDoubleFromObj(NULL, valuePtr, &d1); Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2); switch (opcode) { case INST_ADD: dResult = d1 + d2; break; case INST_SUB: dResult = d1 - d2; break; case INST_MULT: dResult = d1 * d2; break; case INST_DIV: #ifndef IEEE_FLOATING_POINT if (d2 == 0.0) { return DIVIDED_BY_ZERO; } #endif /* * We presume that we are running with zero-divide unmasked if * we're on an IEEE box. Otherwise, this statement might cause * demons to fly out our noses. */ dResult = d1 / d2; break; default: /* Unused, here to silence compiler warning. */ dResult = 0; } doubleResult: #ifndef ACCEPT_NAN /* * Check now for IEEE floating-point error. */ if (TclIsNaN(dResult)) { TclExprFloatError(interp, dResult); return GENERAL_ARITHMETIC_ERROR; } #endif DOUBLE_RESULT(dResult); } if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); switch (opcode) { case INST_ADD: wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2); #ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) #endif { /* * Check for overflow. */ if (Overflowing(w1, w2, wResult)) { goto overflowBasic; } } break; case INST_SUB: wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2); #ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) #endif { /* * Must check for overflow. The macro tests for overflows * in sums by looking at the sign bits. As we have a * subtraction here, we are adding -w2. As -w2 could in * turn overflow, we test with ~w2 instead: it has the * opposite sign bit to w2 so it does the job. Note that * the only "bad" case (w2==0) is irrelevant for this * macro, as in that case w1 and wResult have the same * sign and there is no overflow anyway. */ if (Overflowing(w1, ~w2, wResult)) { goto overflowBasic; } } break; case INST_MULT: if ((sizeof(Tcl_WideInt) < 2*sizeof(long)) || (type1 != TCL_NUMBER_LONG) || (type2 != TCL_NUMBER_LONG)) { goto overflowBasic; } wResult = w1 * w2; break; case INST_DIV: if (w2 == 0) { return DIVIDED_BY_ZERO; } /* * Need a bignum to represent (LLONG_MIN / -1) */ if ((w1 == LLONG_MIN) && (w2 == -1)) { goto overflowBasic; } wResult = w1 / w2; /* * Force Tcl's integer division rules. * TODO: examine for logic simplification */ if (((wResult < 0) || ((wResult == 0) && ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) && (wResult*w2 != w1)) { wResult -= 1; } break; default: /* * Unused, here to silence compiler warning. */ wResult = 0; } WIDE_RESULT(wResult); } overflowBasic: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); mp_init(&bigResult); switch (opcode) { case INST_ADD: mp_add(&big1, &big2, &bigResult); break; case INST_SUB: mp_sub(&big1, &big2, &bigResult); break; case INST_MULT: mp_mul(&big1, &big2, &bigResult); break; case INST_DIV: if (mp_iszero(&big2)) { mp_clear(&big1); mp_clear(&big2); mp_clear(&bigResult); return DIVIDED_BY_ZERO; } mp_init(&bigRemainder); mp_div(&big1, &big2, &bigResult, &bigRemainder); /* TODO: internals intrusion */ if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* * Convert to Tcl's integer division rules. */ mp_sub_d(&bigResult, 1, &bigResult); mp_add(&bigRemainder, &big2, &bigRemainder); } mp_clear(&bigRemainder); break; } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); } Tcl_Panic("unexpected opcode"); return NULL; } static Tcl_Obj * ExecuteExtendedUnaryMathOp( int opcode, /* What operation to perform. */ Tcl_Obj *valuePtr) /* The operand on the stack. */ { ClientData ptr = NULL; int type; Tcl_WideInt w; mp_int big; Tcl_Obj *objResultPtr; (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type); switch (opcode) { case INST_BITNOT: #ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); } #endif Tcl_TakeBignumFromObj(NULL, valuePtr, &big); /* ~a = - a - 1 */ (void)mp_neg(&big, &big); mp_sub_d(&big, 1, &big); BIG_RESULT(&big); case INST_UMINUS: switch (type) { case TCL_NUMBER_DOUBLE: DOUBLE_RESULT(-(*((const double *) ptr))); case TCL_NUMBER_LONG: w = (Tcl_WideInt) (*((const long *) ptr)); if (w != LLONG_MIN) { WIDE_RESULT(-w); } TclBNInitBignumFromLong(&big, *(const long *) ptr); break; #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w = *((const Tcl_WideInt *) ptr); if (w != LLONG_MIN) { WIDE_RESULT(-w); } TclBNInitBignumFromWideInt(&big, w); break; #endif default: Tcl_TakeBignumFromObj(NULL, valuePtr, &big); } (void)mp_neg(&big, &big); BIG_RESULT(&big); } Tcl_Panic("unexpected opcode"); return NULL; } #undef LONG_RESULT #undef WIDE_RESULT #undef BIG_RESULT #undef DOUBLE_RESULT /* *---------------------------------------------------------------------- * * CompareTwoNumbers -- * * This function compares a pair of numbers in Tcl_Objs. Each argument * must already be known to be numeric and not NaN. * * Results: * One of MP_LT, MP_EQ or MP_GT, depending on whether valuePtr is less * than, equal to, or greater than value2Ptr (respectively). * * Side effects: * None, provided both values are numeric. * *---------------------------------------------------------------------- */ int TclCompareTwoNumbers( Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr) { int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare; ClientData ptr1, ptr2; mp_int big1, big2; double d1, d2, tmp; long l1, l2; #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w1, w2; #endif (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); switch (type1) { case TCL_NUMBER_LONG: l1 = *((const long *)ptr1); switch (type2) { case TCL_NUMBER_LONG: l2 = *((const long *)ptr2); longCompare: return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); w1 = (Tcl_WideInt)l1; goto wideCompare; #endif case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); d1 = (double) l1; /* * If the double has a fractional part, or if the long can be * converted to double without loss of precision, then compare as * doubles. */ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l1 == (long) d1 || modf(d2, &tmp) != 0.0) { goto doubleCompare; } /* * Otherwise, to make comparision based on full precision, need to * convert the double to a suitably sized integer. * * Need this to get comparsions like * expr 20000000000000003 < 20000000000000004.0 * right. Converting the first argument to double will yield two * double values that are equivalent within double precision. * Converting the double to an integer gets done exactly, then * integer comparison can tell the difference. */ if (d2 < (double)LONG_MIN) { return MP_GT; } if (d2 > (double)LONG_MAX) { return MP_LT; } l2 = (long) d2; goto longCompare; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); if (mp_cmp_d(&big2, 0) == MP_LT) { compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); return compare; } break; #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w1 = *((const Tcl_WideInt *)ptr1); switch (type2) { case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); wideCompare: return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); case TCL_NUMBER_LONG: l2 = *((const long *)ptr2); w2 = (Tcl_WideInt)l2; goto wideCompare; case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); d1 = (double) w1; if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) { goto doubleCompare; } if (d2 < (double)LLONG_MIN) { return MP_GT; } if (d2 > (double)LLONG_MAX) { return MP_LT; } w2 = (Tcl_WideInt) d2; goto wideCompare; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); if (mp_isneg(&big2)) { compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); return compare; } break; #endif case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); switch (type2) { case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); doubleCompare: return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ); case TCL_NUMBER_LONG: l2 = *((const long *)ptr2); d2 = (double) l2; if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l2 == (long) d2 || modf(d1, &tmp) != 0.0) { goto doubleCompare; } if (d1 < (double)LONG_MIN) { return MP_LT; } if (d1 > (double)LONG_MAX) { return MP_GT; } l1 = (long) d1; goto longCompare; #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); d2 = (double) w2; if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) { goto doubleCompare; } if (d1 < (double)LLONG_MIN) { return MP_LT; } if (d1 > (double)LLONG_MAX) { return MP_GT; } w1 = (Tcl_WideInt) d1; goto wideCompare; #endif case TCL_NUMBER_BIG: if (TclIsInfinite(d1)) { return (d1 > 0.0) ? MP_GT : MP_LT; } Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) { if (mp_isneg(&big2)) { compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); return compare; } if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) && modf(d1, &tmp) != 0.0) { d2 = TclBignumToDouble(&big2); mp_clear(&big2); goto doubleCompare; } Tcl_InitBignumFromDouble(NULL, d1, &big1); goto bigCompare; } break; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { #ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: #endif case TCL_NUMBER_LONG: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); return compare; case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); if (TclIsInfinite(d2)) { compare = (d2 > 0.0) ? MP_LT : MP_GT; mp_clear(&big1); return compare; } if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) { compare = mp_cmp_d(&big1, 0); mp_clear(&big1); return compare; } if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) && modf(d2, &tmp) != 0.0) { d1 = TclBignumToDouble(&big1); mp_clear(&big1); goto doubleCompare; } Tcl_InitBignumFromDouble(NULL, d2, &big2); goto bigCompare; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); bigCompare: compare = mp_cmp(&big1, &big2); mp_clear(&big1); mp_clear(&big2); return compare; } break; default: Tcl_Panic("unexpected number type"); } return TCL_ERROR; } #ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * * PrintByteCodeInfo -- * * This procedure prints a summary about a bytecode object to stdout. It * is called by TclNRExecuteByteCode when starting to execute the bytecode * object if tclTraceExec has the value 2 or more. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PrintByteCodeInfo( ByteCode *codePtr) /* The bytecode whose summary is printed to * stdout. */ { Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); fprintf(stdout, "\n Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n", codePtr->numCommands, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, #ifdef TCL_COMPILE_STATS codePtr->numSrcBytes? ((float)codePtr->structureSize)/codePtr->numSrcBytes : #endif 0.0); #ifdef TCL_COMPILE_STATS fprintf(stdout, " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n", (unsigned long) codePtr->structureSize, (unsigned long) (TclOffset(ByteCode, localCachePtr)), codePtr->numCodeBytes, (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)), (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)), (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)), codePtr->numCmdLocBytes); #endif /* TCL_COMPILE_STATS */ if (procPtr != NULL) { fprintf(stdout, " Proc 0x%p, refCt %d, args %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } } #endif /* TCL_COMPILE_DEBUG */ /* *---------------------------------------------------------------------- * * ValidatePcAndStackTop -- * * This procedure is called by TclNRExecuteByteCode when debugging to * verify that the program counter and stack top are valid during * execution. * * Results: * None. * * Side effects: * Prints a message to stderr and panics if either the pc or stack top * are invalid. * *---------------------------------------------------------------------- */ #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( ByteCode *codePtr, /* The bytecode whose summary is printed to * stdout. */ const unsigned char *pc, /* Points to first byte of a bytecode * instruction. The program counter. */ int stackTop, /* Current stack top. Must be between * stackLowerBound and stackUpperBound * (inclusive). */ int checkStack) /* 0 if the stack depth check should be * skipped. */ { int stackUpperBound = codePtr->maxStackDepth; /* Greatest legal value for stackTop. */ size_t relativePc = (size_t) (pc - codePtr->codeStart); size_t codeStart = (size_t) codePtr->codeStart; size_t codeEnd = (size_t) (codePtr->codeStart + codePtr->numCodeBytes); unsigned char opCode = *pc; if (((size_t) pc < codeStart) || ((size_t) pc > codeEnd)) { fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n", pc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc"); } if ((unsigned) opCode > LAST_INST_OPCODE) { fprintf(stderr, "\nBad opcode %d at pc %lu in TclNRExecuteByteCode\n", (unsigned) opCode, (unsigned long)relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } if (checkStack && ((stackTop < 0) || (stackTop > stackUpperBound))) { int numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); fprintf(stderr, "\nBad stack top %d at pc %lu in TclNRExecuteByteCode (min 0, max %i)", stackTop, (unsigned long)relativePc, stackUpperBound); if (cmd != NULL) { Tcl_Obj *message; TclNewLiteralStringObj(message, "\n executing "); Tcl_IncrRefCount(message); Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL); fprintf(stderr,"%s\n", Tcl_GetString(message)); Tcl_DecrRefCount(message); } else { fprintf(stderr, "\n"); } Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top"); } } #endif /* TCL_COMPILE_DEBUG */ /* *---------------------------------------------------------------------- * * IllegalExprOperandType -- * * Used by TclNRExecuteByteCode to append an error message to the interp * result when an illegal operand type is detected by an expression * instruction. The argument opndPtr holds the operand object in error. * * Results: * None. * * Side effects: * An error message is appended to the interp result. * *---------------------------------------------------------------------- */ static void IllegalExprOperandType( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ const unsigned char *pc, /* Points to the instruction being executed * when the illegal type was found. */ Tcl_Obj *opndPtr) /* Points to the operand holding the value * with the illegal type. */ { ClientData ptr; int type; const unsigned char opcode = *pc; const char *description, *op = "unknown"; if (opcode == INST_EXPON) { op = "**"; } else if (opcode <= INST_LNOT) { op = operatorStrings[opcode - INST_LOR]; } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { int numBytes; const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes); if (numBytes == 0) { description = "empty string"; } else if (TclCheckBadOctal(NULL, bytes)) { description = "invalid octal number"; } else { description = "non-numeric string"; } } else if (type == TCL_NUMBER_NAN) { description = "non-numeric floating-point value"; } else if (type == TCL_NUMBER_DOUBLE) { description = "floating-point value"; } else { /* TODO: No caller needs this. Eliminate? */ description = "(big) integer"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't use %s as operand of \"%s\"", description, op)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } /* *---------------------------------------------------------------------- * * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame -- * * Given a program counter value, finds the closest command in the * bytecode code unit's CmdLocation array and returns information about * that command's source: a pointer to its first byte and the number of * characters. * * Results: * If a command is found that encloses the program counter value, a * pointer to the command's source is returned and the length of the * source is stored at *lengthPtr. If multiple commands resulted in code * at pc, information about the closest enclosing command is returned. If * no matching command is found, NULL is returned and *lengthPtr is * unchanged. * * Side effects: * The CmdFrame at *cfPtr is updated. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetSourceFromFrame( CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]) { if (cfPtr == NULL) { return Tcl_NewListObj(objc, objv); } if (cfPtr->cmdObj == NULL) { if (cfPtr->cmd == NULL) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; cfPtr->cmd = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); } if (cfPtr->cmd) { cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); } else { cfPtr->cmdObj = Tcl_NewListObj(objc, objv); } Tcl_IncrRefCount(cfPtr->cmdObj); } return cfPtr->cmdObj; } void TclGetSrcInfoForPc( CmdFrame *cfPtr) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; assert(cfPtr->type == TCL_LOCATION_BC); if (cfPtr->cmd == NULL) { cfPtr->cmd = GetSrcInfoForPc( (unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); } if (cfPtr->cmd != NULL) { /* * We now have the command. We can get the srcOffset back and from * there find the list of word locations for this command. */ ExtCmdLoc *eclPtr; ECL *locPtr = NULL; int srcOffset, i; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; } srcOffset = cfPtr->cmd - codePtr->source; eclPtr = Tcl_GetHashValue(hePtr); for (i=0; i < eclPtr->nuloc; i++) { if (eclPtr->loc[i].srcOffset == srcOffset) { locPtr = eclPtr->loc+i; break; } } if (locPtr == NULL) { Tcl_Panic("LocSearch failure"); } cfPtr->line = locPtr->line; cfPtr->nline = locPtr->nline; cfPtr->type = eclPtr->type; if (eclPtr->type == TCL_LOCATION_SOURCE) { cfPtr->data.eval.path = eclPtr->path; Tcl_IncrRefCount(cfPtr->data.eval.path); } /* * Do not set cfPtr->data.eval.path NULL for non-SOURCE. Needed for * cfPtr->data.tebc.codePtr. */ } } static const char * GetSrcInfoForPc( const unsigned char *pc, /* The program counter value for which to * return the closest command's source info. * This points within a bytecode instruction * in codePtr's code. */ ByteCode *codePtr, /* The bytecode sequence in which to look up * the command source for the pc. */ int *lengthPtr, /* If non-NULL, the location where the length * of the command's source should be stored. * If NULL, no length is stored. */ const unsigned char **pcBeg,/* If non-NULL, the bytecode location * where the current instruction starts. * If NULL; no pointer is stored. */ int *cmdIdxPtr) /* If non-NULL, the location where the index * of the command containing the pc should * be stored. */ { int pcOffset = (pc - codePtr->codeStart); int numCmds = codePtr->numCommands; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ int bestCmdIdx = -1; /* The pc must point within the bytecode */ assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes)); /* * Decode the code and source offset and length for each command. The * closest enclosing command is the last one whose code started before * pcOffset. */ codeDeltaNext = codePtr->codeDeltaStart; codeLengthNext = codePtr->codeLengthStart; srcDeltaNext = codePtr->srcDeltaStart; srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; } else { delta = TclGetInt1AtPtr(codeDeltaNext); codeDeltaNext++; } codeOffset += delta; if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; } else { codeLen = TclGetInt1AtPtr(codeLengthNext); codeLengthNext++; } codeEnd = (codeOffset + codeLen - 1); if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; } else { delta = TclGetInt1AtPtr(srcDeltaNext); srcDeltaNext++; } srcOffset += delta; if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; } else { srcLen = TclGetInt1AtPtr(srcLengthNext); srcLengthNext++; } if (codeOffset > pcOffset) { /* Best cmd already found */ break; } if (pcOffset <= codeEnd) { /* This cmd's code encloses pc */ int dist = (pcOffset - codeOffset); if (dist <= bestDist) { bestDist = dist; bestSrcOffset = srcOffset; bestSrcLength = srcLen; bestCmdIdx = i; } } } if (pcBeg != NULL) { const unsigned char *curr, *prev; /* * Walk from beginning of command or BC to pc, by complete * instructions. Stop when crossing pc; keep previous. */ curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist); prev = curr; while (curr <= pc) { prev = curr; curr += tclInstructionTable[*curr].numBytes; } *pcBeg = prev; } if (bestDist == INT_MAX) { return NULL; } if (lengthPtr != NULL) { *lengthPtr = bestSrcLength; } if (cmdIdxPtr != NULL) { *cmdIdxPtr = bestCmdIdx; } return (codePtr->source + bestSrcOffset); } /* *---------------------------------------------------------------------- * * GetExceptRangeForPc -- * * Given a program counter value, return the closest enclosing * ExceptionRange. * * Results: * If the searchMode is TCL_ERROR, this procedure ignores loop exception * ranges and returns a pointer to the closest catch range. If the * searchMode is TCL_BREAK, this procedure returns a pointer to the most * closely enclosing ExceptionRange regardless of whether it is a loop or * catch exception range. If the searchMode is TCL_CONTINUE, this * procedure returns a pointer to the most closely enclosing * ExceptionRange (of any type) skipping only loop exception ranges if * they don't have a sensible continueOffset defined. If no matching * ExceptionRange is found that encloses pc, a NULL is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ static ExceptionRange * GetExceptRangeForPc( const unsigned char *pc, /* The program counter value for which to * search for a closest enclosing exception * range. This points to a bytecode * instruction in codePtr's code. */ int searchMode, /* If TCL_BREAK, consider either loop or catch * ExceptionRanges in search. If TCL_ERROR * consider only catch ranges (and ignore any * closer loop ranges). If TCL_CONTINUE, look * for loop ranges that define a continue * point or a catch range. */ ByteCode *codePtr) /* Points to the ByteCode in which to search * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; ExceptionRange *rangePtr; int pcOffset = pc - codePtr->codeStart; int start; if (numRanges == 0) { return NULL; } /* * This exploits peculiarities of our compiler: nested ranges are always * *after* their containing ranges, so that by scanning backwards we are * sure that the first matching range is indeed the deepest. */ rangeArrayPtr = codePtr->exceptArrayPtr; rangePtr = rangeArrayPtr + numRanges; while (--rangePtr >= rangeArrayPtr) { start = rangePtr->codeOffset; if ((start <= pcOffset) && (pcOffset < (start + rangePtr->numCodeBytes))) { if (rangePtr->type == CATCH_EXCEPTION_RANGE) { return rangePtr; } if (searchMode == TCL_BREAK) { return rangePtr; } if (searchMode == TCL_CONTINUE && rangePtr->continueOffset != -1){ return rangePtr; } } } return NULL; } /* *---------------------------------------------------------------------- * * GetOpcodeName -- * * This procedure is called by the TRACE and TRACE_WITH_OBJ macros used * in TclNRExecuteByteCode when debugging. It returns the name of the * bytecode instruction at a specified instruction pc. * * Results: * A character string for the instruction. * * Side effects: * None. * *---------------------------------------------------------------------- */ #ifdef TCL_COMPILE_DEBUG static const char * GetOpcodeName( const unsigned char *pc) /* Points to the instruction whose name should * be returned. */ { unsigned char opCode = *pc; return tclInstructionTable[opCode].name; } #endif /* TCL_COMPILE_DEBUG */ /* *---------------------------------------------------------------------- * * TclExprFloatError -- * * This procedure is called when an error occurs during a floating-point * operation. It reads errno and sets interp->objResultPtr accordingly. * * Results: * interp->objResultPtr is set to hold an error message. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclExprFloatError( Tcl_Interp *interp, /* Where to store error message. */ double value) /* Value returned after error; used to * distinguish underflows from overflows. */ { const char *s; if ((errno == EDOM) || TclIsNaN(value)) { s = "domain error: argument not in valid range"; Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL); } else if ((errno == ERANGE) || TclIsInfinite(value)) { if (value == 0.0) { s = "floating-point value too small to represent"; Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL); } else { s = "floating-point value too large to represent"; Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL); } } else { Tcl_Obj *objPtr = Tcl_ObjPrintf( "unknown floating-point error, errno = %d", errno); Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", Tcl_GetString(objPtr), NULL); Tcl_SetObjResult(interp, objPtr); } } #ifdef TCL_COMPILE_STATS /* *---------------------------------------------------------------------- * * TclLog2 -- * * Procedure used while collecting compilation statistics to determine * the log base 2 of an integer. * * Results: * Returns the log base 2 of the operand. If the argument is less than or * equal to zero, a zero is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclLog2( int value) /* The integer for which to compute the log * base 2. */ { int n = value; int result = 0; while (n > 1) { n = n >> 1; result++; } return result; } /* *---------------------------------------------------------------------- * * EvalStatsCmd -- * * Implements the "evalstats" command that prints instruction execution * counts to stdout. * * Results: * Standard Tcl results. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int EvalStatsCmd( ClientData unused, /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The argument strings. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; ByteCodeStats *statsPtr = &iPtr->stats; double totalCodeBytes, currentCodeBytes; double totalLiteralBytes, currentLiteralBytes; double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved; double strBytesSharedMultX, strBytesSharedOnce; double numInstructions, currentHeaderBytes; long numCurrentByteCodes, numByteCodeLits; long refCountSum, literalMgmtBytes, sum; int numSharedMultX, numSharedOnce; int decadeHigh, minSizeDecade, maxSizeDecade, length, i; char *litTableStats; LiteralEntry *entryPtr; Tcl_Obj *objPtr; #define Percent(a,b) ((a) * 100.0 / (b)) TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); numInstructions = 0.0; for (i = 0; i < 256; i++) { if (statsPtr->instructionCount[i] != 0) { numInstructions += statsPtr->instructionCount[i]; } } totalLiteralBytes = sizeof(LiteralTable) + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *) + (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)) + (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)) + statsPtr->totalLitStringBytes; totalCodeBytes = statsPtr->totalByteCodeBytes + totalLiteralBytes; numCurrentByteCodes = statsPtr->numCompilations - statsPtr->numByteCodesFreed; currentHeaderBytes = numCurrentByteCodes * (TclOffset(ByteCode, localCachePtr)); literalMgmtBytes = sizeof(LiteralTable) + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)) + (iPtr->literalTable.numEntries * sizeof(LiteralEntry)); currentLiteralBytes = literalMgmtBytes + iPtr->literalTable.numEntries * sizeof(Tcl_Obj) + statsPtr->currentLitStringBytes; currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes; /* * Summary statistics, total and current source and ByteCode sizes. */ Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); Tcl_AppendPrintfToObj(objPtr, "Compilation and execution statistics for interpreter %#lx\n", (unsigned long)(size_t)iPtr); Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n", statsPtr->numExecutions); Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean executions/compile\t%.1f\n", statsPtr->numExecutions / (float)statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n", numInstructions); Tcl_AppendPrintfToObj(objPtr, " Mean inst/compile\t\t%.0f\n", numInstructions / statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean inst/execution\t\t%.0f\n", numInstructions / statsPtr->numExecutions); Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->totalSrcBytes); Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n", totalCodeBytes); Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n", statsPtr->totalByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", totalLiteralBytes); Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", (unsigned long) sizeof(LiteralTable), (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), (unsigned long) (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)), (unsigned long) (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)), statsPtr->totalLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/compile\t\t%.1f\n", totalCodeBytes / statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n", totalCodeBytes / statsPtr->totalSrcBytes); Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n", numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->currentSrcBytes); Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n", currentCodeBytes); Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n", statsPtr->currentByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", currentLiteralBytes); Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", (unsigned long) sizeof(LiteralTable), (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)), (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)), statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n", currentCodeBytes / statsPtr->currentSrcBytes); Tcl_AppendPrintfToObj(objPtr, " Code + source bytes\t\t%.6g (%0.1f mean code/src)\n", (currentCodeBytes + statsPtr->currentSrcBytes), (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0); /* * Tcl_IsShared statistics check * * This gives the refcount of each obj as Tcl_IsShared was called for it. * Shared objects must be duplicated before they can be modified. */ numSharedMultX = 0; Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n"); Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%ld\n", tclObjsShared[1]); for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) { Tcl_AppendPrintfToObj(objPtr, " refcount ==%d\t\t%ld\n", i, tclObjsShared[i]); numSharedMultX += tclObjsShared[i]; } Tcl_AppendPrintfToObj(objPtr, " refcount >=%d\t\t%ld\n", i, tclObjsShared[0]); numSharedMultX += tclObjsShared[0]; Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%d\n", numSharedMultX); /* * Literal table statistics. */ numByteCodeLits = 0; refCountSum = 0; numSharedMultX = 0; numSharedOnce = 0; objBytesIfUnshared = 0.0; strBytesIfUnshared = 0.0; strBytesSharedMultX = 0.0; strBytesSharedOnce = 0.0; for (i = 0; i < globalTablePtr->numBuckets; i++) { for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL; entryPtr = entryPtr->nextPtr) { if (entryPtr->objPtr->typePtr == &tclByteCodeType) { numByteCodeLits++; } (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length); refCountSum += entryPtr->refCount; objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj)); strBytesIfUnshared += (entryPtr->refCount * (length+1)); if (entryPtr->refCount > 1) { numSharedMultX++; strBytesSharedMultX += (length+1); } else { numSharedOnce++; strBytesSharedOnce += (length+1); } } } sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared) - currentLiteralBytes; Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n", tclObjsAlloced); Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n", (tclObjsAlloced - tclObjsFreed)); Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n", statsPtr->numLiteralsCreated); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n", globalTablePtr->numEntries, Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n", numByteCodeLits, Percent(numByteCodeLits, globalTablePtr->numEntries)); Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%d\n", numSharedMultX); Tcl_AppendPrintfToObj(objPtr, " Mean reference count\t\t%.2f\n", ((double) refCountSum) / globalTablePtr->numEntries); Tcl_AppendPrintfToObj(objPtr, " Mean len, str reused >1x \t%.2f\n", (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0)); Tcl_AppendPrintfToObj(objPtr, " Mean len, str used 1x\t\t%.2f\n", (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0)); Tcl_AppendPrintfToObj(objPtr, " Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n", sharingBytesSaved, Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared)); Tcl_AppendPrintfToObj(objPtr, " Bytes with sharing\t\t%.6g\n", currentLiteralBytes); Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", (unsigned long) sizeof(LiteralTable), (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)), (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)), statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n", (objBytesIfUnshared + strBytesIfUnshared), objBytesIfUnshared, strBytesIfUnshared); Tcl_AppendPrintfToObj(objPtr, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n", (strBytesIfUnshared - statsPtr->currentLitStringBytes), strBytesIfUnshared, statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n", literalMgmtBytes, Percent(literalMgmtBytes, currentLiteralBytes)); Tcl_AppendPrintfToObj(objPtr, " table %lu + buckets %lu + entries %lu\n", (unsigned long) sizeof(LiteralTable), (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry))); /* * Breakdown of current ByteCode space requirements. */ Tcl_AppendPrintfToObj(objPtr, "\nBreakdown of current ByteCode requirements:\n"); Tcl_AppendPrintfToObj(objPtr, " Bytes Pct of Avg per\n"); Tcl_AppendPrintfToObj(objPtr, " total ByteCode\n"); Tcl_AppendPrintfToObj(objPtr, "Total %12.6g 100.00%% %8.1f\n", statsPtr->currentByteCodeBytes, statsPtr->currentByteCodeBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Header %12.6g %8.1f%% %8.1f\n", currentHeaderBytes, Percent(currentHeaderBytes, statsPtr->currentByteCodeBytes), currentHeaderBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Instructions %12.6g %8.1f%% %8.1f\n", statsPtr->currentInstBytes, Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes), statsPtr->currentInstBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g %8.1f%% %8.1f\n", statsPtr->currentLitBytes, Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes), statsPtr->currentLitBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Exception table %12.6g %8.1f%% %8.1f\n", statsPtr->currentExceptBytes, Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes), statsPtr->currentExceptBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Auxiliary data %12.6g %8.1f%% %8.1f\n", statsPtr->currentAuxBytes, Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes), statsPtr->currentAuxBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Command map %12.6g %8.1f%% %8.1f\n", statsPtr->currentCmdMapBytes, Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes), statsPtr->currentCmdMapBytes / numCurrentByteCodes); /* * Detailed literal statistics. */ Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n"); maxSizeDecade = 0; for (i = 31; i >= 0; i--) { if (statsPtr->literalCount[i] > 0) { maxSizeDecade = i; break; } } sum = 0; for (i = 0; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->literalCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numLiteralsCreated)); } litTableStats = TclLiteralStats(globalTablePtr); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n", litTableStats); ckfree(litTableStats); /* * Source and ByteCode size distributions. */ Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n"); minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { if (statsPtr->srcCount[i] > 0) { minSizeDecade = i; break; } } for (i = 31; i >= 0; i--) { if (statsPtr->srcCount[i] > 0) { maxSizeDecade = i; break; } } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n"); minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { if (statsPtr->byteCodeCount[i] > 0) { minSizeDecade = i; break; } } for (i = 31; i >= 0; i--) { if (statsPtr->byteCodeCount[i] > 0) { maxSizeDecade = i; break; } } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to ms\t\tPercentage\n"); minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { if (statsPtr->lifetimeCount[i] > 0) { minSizeDecade = i; break; } } for (i = 31; i >= 0; i--) { if (statsPtr->lifetimeCount[i] > 0) { maxSizeDecade = i; break; } } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->lifetimeCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n", decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed)); } /* * Instruction counts. */ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n"); for (i = 0; i <= LAST_INST_OPCODE; i++) { Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ", tclInstructionTable[i].name, statsPtr->instructionCount[i]); if (statsPtr->instructionCount[i]) { Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n", Percent(statsPtr->instructionCount[i], numInstructions)); } else { Tcl_AppendPrintfToObj(objPtr, "0\n"); } } #ifdef TCL_MEM_DEBUG Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n"); TclDumpMemoryInfo((ClientData) objPtr, 1); #endif Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); if (objc == 1) { Tcl_SetObjResult(interp, objPtr); } else { Tcl_Channel outChan; char *str = Tcl_GetStringFromObj(objv[1], &length); if (length) { if (strcmp(str, "stdout") == 0) { outChan = Tcl_GetStdChannel(TCL_STDOUT); } else if (strcmp(str, "stderr") == 0) { outChan = Tcl_GetStdChannel(TCL_STDERR); } else { outChan = Tcl_OpenFileChannel(NULL, str, "w", 0664); } } else { outChan = Tcl_GetStdChannel(TCL_STDOUT); } if (outChan != NULL) { Tcl_WriteObj(outChan, objPtr); } } Tcl_DecrRefCount(objPtr); return TCL_OK; } #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * * StringForResultCode -- * * Procedure that returns a human-readable string representing a Tcl * result code such as TCL_ERROR. * * Results: * If the result code is one of the standard Tcl return codes, the result * is a string representing that code such as "TCL_ERROR". Otherwise, the * result string is that code formatted as a sequence of decimal digit * characters. Note that the resulting string must not be modified by the * caller. * * Side effects: * None. * *---------------------------------------------------------------------- */ static const char * StringForResultCode( int result) /* The Tcl result code for which to generate a * string. */ { static char buf[TCL_INTEGER_SPACE]; if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) { return resultStrings[result]; } TclFormatInt(buf, result); return buf; } #endif /* TCL_COMPILE_DEBUG */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclFCmd.c0000644000175000017500000011473514554262142014751 0ustar sergeisergei/* * tclFCmd.c * * This file implements the generic portion of file manipulation * subcommands of the "file" command. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclFileSystem.h" /* * Declarations for local functions defined in this file: */ static int CopyRenameOneFile(Tcl_Interp *interp, Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, int copyFlag, int force); static Tcl_Obj * FileBasename(Tcl_Interp *interp, Tcl_Obj *pathPtr); static int FileCopyRename(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int copyFlag); static int FileForceOption(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *forcePtr); /* *--------------------------------------------------------------------------- * * TclFileRenameCmd * * This function implements the "rename" subcommand of the "file" * command. Filename arguments need to be translated to native format * before being passed to platform-specific code that implements rename * functionality. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *--------------------------------------------------------------------------- */ int TclFileRenameCmd( ClientData clientData, /* Unused */ Tcl_Interp *interp, /* Interp for error reporting or recursive * calls in the case of a tricky rename. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ { return FileCopyRename(interp, objc, objv, 0); } /* *--------------------------------------------------------------------------- * * TclFileCopyCmd * * This function implements the "copy" subcommand of the "file" command. * Filename arguments need to be translated to native format before being * passed to platform-specific code that implements copy functionality. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *--------------------------------------------------------------------------- */ int TclFileCopyCmd( ClientData clientData, /* Unused */ Tcl_Interp *interp, /* Used for error reporting or recursive calls * in the case of a tricky copy. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ { return FileCopyRename(interp, objc, objv, 1); } /* *--------------------------------------------------------------------------- * * FileCopyRename -- * * Performs the work of TclFileRenameCmd and TclFileCopyCmd. See * comments for those functions. * * Results: * See above. * * Side effects: * See above. * *--------------------------------------------------------------------------- */ static int FileCopyRename( Tcl_Interp *interp, /* Used for error reporting. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument strings passed to Tcl_FileCmd. */ int copyFlag) /* If non-zero, copy source(s). Otherwise, * rename them. */ { int i, result, force; Tcl_StatBuf statBuf; Tcl_Obj *target; i = FileForceOption(interp, objc - 1, objv + 1, &force); if (i < 0) { return TCL_ERROR; } i++; if ((objc - i) < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? source ?source ...? target"); return TCL_ERROR; } /* * If target doesn't exist or isn't a directory, try the copy/rename. More * than 2 arguments is only valid if the target is an existing directory. */ target = objv[objc - 1]; if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) { return TCL_ERROR; } result = TCL_OK; /* * Call Tcl_FSStat() so that if target is a symlink that points to a * directory we will put the sources in that directory instead of * overwriting the symlink. */ if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) { if ((objc - i) > 2) { errno = ENOTDIR; Tcl_PosixError(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error %s: target \"%s\" is not a directory", (copyFlag?"copying":"renaming"), TclGetString(target))); result = TCL_ERROR; } else { /* * Even though already have target == translated(objv[i+1]), pass * the original argument down, so if there's an error, the error * message will reflect the original arguments. */ result = CopyRenameOneFile(interp, objv[i], objv[i + 1], copyFlag, force); } return result; } /* * Move each source file into target directory. Extract the basename from * each source, and append it to the end of the target path. */ for ( ; i 0) { goto createDir; } /* Already tried, with delete in-between directly after * creation, so just continue (assume created successful). */ goto nextPart; } /* return with error */ errfile = target; goto done; } nextPart: /* * Forget about this sub-path. */ Tcl_DecrRefCount(target); target = NULL; } Tcl_DecrRefCount(split); split = NULL; } done: if (errfile != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create directory \"%s\": %s", TclGetString(errfile), Tcl_PosixError(interp))); result = TCL_ERROR; } if (split != NULL) { Tcl_DecrRefCount(split); } if (target != NULL) { Tcl_DecrRefCount(target); } return result; } /* *---------------------------------------------------------------------- * * TclFileDeleteCmd * * This function implements the "delete" subcommand of the "file" * command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int TclFileDeleteCmd( ClientData clientData, /* Unused */ Tcl_Interp *interp, /* Used for error reporting */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ { int i, force, result; Tcl_Obj *errfile; Tcl_Obj *errorBuffer = NULL; i = FileForceOption(interp, objc - 1, objv + 1, &force); if (i < 0) { return TCL_ERROR; } errfile = NULL; result = TCL_OK; for (i++ ; i < objc; i++) { Tcl_StatBuf statBuf; errfile = objv[i]; if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { result = TCL_ERROR; goto done; } /* * Call lstat() to get info so can delete symbolic link itself. */ if (Tcl_FSLstat(objv[i], &statBuf) != 0) { result = TCL_ERROR; } else if (S_ISDIR(statBuf.st_mode)) { /* * We own a reference count on errorBuffer, if it was set as a * result of this call. */ result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer); if (result != TCL_OK) { if ((force == 0) && (errno == EEXIST)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error deleting \"%s\": directory not empty", TclGetString(objv[i]))); Tcl_PosixError(interp); goto done; } /* * If possible, use the untranslated name for the file. */ errfile = errorBuffer; /* * FS supposed to check between translated objv and errfile. */ if (Tcl_FSEqualPaths(objv[i], errfile)) { errfile = objv[i]; } } } else { result = Tcl_FSDeleteFile(objv[i]); } if (result != TCL_OK) { /* * Avoid possible race condition (file/directory deleted after call * of lstat), so bypass ENOENT because not an error, just a no-op */ if (errno == ENOENT) { result = TCL_OK; continue; } /* * It is important that we break on error, otherwise we might end * up owning reference counts on numerous errorBuffers. */ result = TCL_ERROR; break; } } if (result != TCL_OK) { if (errfile == NULL) { /* * We try to accommodate poor error results from our Tcl_FS calls. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error deleting unknown file: %s", Tcl_PosixError(interp))); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error deleting \"%s\": %s", TclGetString(errfile), Tcl_PosixError(interp))); } } done: if (errorBuffer != NULL) { Tcl_DecrRefCount(errorBuffer); } return result; } /* *--------------------------------------------------------------------------- * * CopyRenameOneFile * * Copies or renames specified source file or directory hierarchy to the * specified target. * * Results: * A standard Tcl result. * * Side effects: * Target is overwritten if the force flag is set. Attempting to * copy/rename a file onto a directory or a directory onto a file will * always result in an error. * *---------------------------------------------------------------------- */ static int CopyRenameOneFile( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *source, /* Pathname of file to copy. May need to be * translated. */ Tcl_Obj *target, /* Pathname of file to create/overwrite. May * need to be translated. */ int copyFlag, /* If non-zero, copy files. Otherwise, rename * them. */ int force) /* If non-zero, overwrite target file if it * exists. Otherwise, error if target already * exists. */ { int result; Tcl_Obj *errfile, *errorBuffer; Tcl_Obj *actualSource=NULL; /* If source is a link, then this is the real * file/directory. */ Tcl_StatBuf sourceStatBuf, targetStatBuf; if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) { return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) { return TCL_ERROR; } errfile = NULL; errorBuffer = NULL; result = TCL_ERROR; /* * We want to copy/rename links and not the files they point to, so we use * lstat(). If target is a link, we also want to replace the link and not * the file it points to, so we also use lstat() on the target. */ if (Tcl_FSLstat(source, &sourceStatBuf) != 0) { errfile = source; goto done; } if (Tcl_FSLstat(target, &targetStatBuf) != 0) { if (errno != ENOENT) { errfile = target; goto done; } } else { if (force == 0) { errno = EEXIST; errfile = target; goto done; } /* * Prevent copying or renaming a file onto itself. On Windows since * 8.5 we do get an inode number, however the unsigned short field is * insufficient to accept the Win32 API file id so it is truncated to * 16 bits and we get collisions. See bug #2015723. */ #if !defined(_WIN32) && !defined(__CYGWIN__) if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) { if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) && (sourceStatBuf.st_dev == targetStatBuf.st_dev)) { result = TCL_OK; goto done; } } #endif /* * Prevent copying/renaming a file onto a directory and vice-versa. * This is a policy decision based on the fact that existing * implementations of copy and rename on all platforms also prevent * this. */ if (S_ISDIR(sourceStatBuf.st_mode) && !S_ISDIR(targetStatBuf.st_mode)) { errno = EISDIR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't overwrite file \"%s\" with directory \"%s\"", TclGetString(target), TclGetString(source))); goto done; } if (!S_ISDIR(sourceStatBuf.st_mode) && S_ISDIR(targetStatBuf.st_mode)) { errno = EISDIR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't overwrite directory \"%s\" with file \"%s\"", TclGetString(target), TclGetString(source))); goto done; } /* * The destination exists, but appears to be ok to over-write, and * -force is given. We now try to adjust permissions to ensure the * operation succeeds. If we can't adjust permissions, we'll let the * actual copy/rename return an error later. */ { Tcl_Obj *perm; int index; TclNewLiteralStringObj(perm, "u+w"); Tcl_IncrRefCount(perm); if (TclFSFileAttrIndex(target, "-permissions", &index) == TCL_OK) { Tcl_FSFileAttrsSet(NULL, index, target, perm); } Tcl_DecrRefCount(perm); } } if (copyFlag == 0) { result = Tcl_FSRenameFile(source, target); if (result == TCL_OK) { goto done; } if (errno == EINVAL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error renaming \"%s\" to \"%s\": trying to rename a" " volume or move a directory into itself", TclGetString(source), TclGetString(target))); goto done; } else if (errno != EXDEV) { errfile = target; goto done; } /* * The rename failed because the move was across file systems. Fall * through to copy file and then remove original. Note that the * low-level Tcl_FSRenameFileProc in the filesystem is allowed to * implement cross-filesystem moves itself, if it desires. */ } actualSource = source; Tcl_IncrRefCount(actualSource); /* * Activate the following block to copy files instead of links. However * Tcl's semantics currently say we should copy links, so any such change * should be the subject of careful study on the consequences. * * Perhaps there could be an optional flag to 'file copy' to dictate which * approach to use, with the default being _not_ to have this block * active. */ #if 0 #ifdef S_ISLNK if (copyFlag && S_ISLNK(sourceStatBuf.st_mode)) { /* * We want to copy files not links. Therefore we must follow the link. * There are two purposes to this 'stat' call here. First we want to * know if the linked-file/dir actually exists, and second, in the * block of code which follows, some 20 lines down, we want to check * if the thing is a file or directory. */ if (Tcl_FSStat(source, &sourceStatBuf) != 0) { /* * Actual file doesn't exist. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error copying \"%s\": the target of this link doesn't" " exist", TclGetString(source))); goto done; } else { int counter = 0; while (1) { Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0); if (path == NULL) { break; } /* * Now we want to check if this is a relative path, and if so, * to make it absolute. */ if (Tcl_FSGetPathType(path) == TCL_PATH_RELATIVE) { Tcl_Obj *abs = Tcl_FSJoinToPath(actualSource, 1, &path); if (abs == NULL) { break; } Tcl_IncrRefCount(abs); Tcl_DecrRefCount(path); path = abs; } Tcl_DecrRefCount(actualSource); actualSource = path; counter++; /* * Arbitrary limit of 20 links to follow. */ if (counter > 20) { /* * Too many links. */ Tcl_SetErrno(EMLINK); errfile = source; goto done; } } /* Now 'actualSource' is the correct file */ } } #endif /* S_ISLNK */ #endif if (S_ISDIR(sourceStatBuf.st_mode)) { result = Tcl_FSCopyDirectory(actualSource, target, &errorBuffer); if (result != TCL_OK) { if (errno == EXDEV) { /* * The copy failed because we're trying to do a * cross-filesystem copy. We do this through our Tcl library. */ Tcl_Obj *copyCommand, *cmdObj, *opObj; TclNewObj(copyCommand); TclNewLiteralStringObj(cmdObj, "::tcl::CopyDirectory"); Tcl_ListObjAppendElement(interp, copyCommand, cmdObj); if (copyFlag) { TclNewLiteralStringObj(opObj, "copying"); } else { TclNewLiteralStringObj(opObj, "renaming"); } Tcl_ListObjAppendElement(interp, copyCommand, opObj); Tcl_ListObjAppendElement(interp, copyCommand, source); Tcl_ListObjAppendElement(interp, copyCommand, target); Tcl_IncrRefCount(copyCommand); result = Tcl_EvalObjEx(interp, copyCommand, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_DecrRefCount(copyCommand); if (result != TCL_OK) { /* * There was an error in the Tcl-level copy. We will pass * on the Tcl error message and can ensure this by setting * errfile to NULL */ errfile = NULL; } } else { errfile = errorBuffer; if (Tcl_FSEqualPaths(errfile, source)) { errfile = source; } else if (Tcl_FSEqualPaths(errfile, target)) { errfile = target; } } } } else { result = Tcl_FSCopyFile(actualSource, target); if ((result != TCL_OK) && (errno == EXDEV)) { result = TclCrossFilesystemCopy(interp, source, target); } if (result != TCL_OK) { /* * We could examine 'errno' to double-check if the problem was * with the target, but we checked the source above, so it should * be quite clear */ errfile = target; } /* * We now need to reset the result, because the above call, * may have left set it. (Ideally we would prefer not to pass * an interpreter in above, but the channel IO code used by * TclCrossFilesystemCopy currently requires one) */ Tcl_ResetResult(interp); } if ((copyFlag == 0) && (result == TCL_OK)) { if (S_ISDIR(sourceStatBuf.st_mode)) { result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer); if (result != TCL_OK) { errfile = errorBuffer; if (Tcl_FSEqualPaths(errfile, source) == 0) { errfile = source; } } } else { result = Tcl_FSDeleteFile(source); if (result != TCL_OK) { errfile = source; } } if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s", TclGetString(errfile), Tcl_PosixError(interp))); errfile = NULL; } } done: if (errfile != NULL) { Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"", (copyFlag ? "copying" : "renaming"), TclGetString(source)); if (errfile != source) { Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"", TclGetString(target)); if (errfile != target) { Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"", TclGetString(errfile)); } } Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp)); Tcl_SetObjResult(interp, errorMsg); } if (errorBuffer != NULL) { Tcl_DecrRefCount(errorBuffer); } if (actualSource != NULL) { Tcl_DecrRefCount(actualSource); } return result; } /* *--------------------------------------------------------------------------- * * FileForceOption -- * * Helps parse command line options for file commands that take the * "-force" and "--" options. * * Results: * The return value is how many arguments from argv were consumed by this * function, or -1 if there was an error parsing the options. If an error * occurred, an error message is left in the interp's result. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int FileForceOption( Tcl_Interp *interp, /* Interp, for error return. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument strings. First command line * option, if it exists, begins at 0. */ int *forcePtr) /* If the "-force" was specified, *forcePtr is * filled with 1, otherwise with 0. */ { int force, i, idx; static const char *const options[] = { "-force", "--", NULL }; force = 0; for (i = 0; i < objc; i++) { if (TclGetString(objv[i])[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT, &idx) != TCL_OK) { return -1; } if (idx == 0 /* -force */) { force = 1; } else { /* -- */ i++; break; } } *forcePtr = force; return i; } /* *--------------------------------------------------------------------------- * * FileBasename -- * * Given a path in either tcl format (with / separators), or in the * platform-specific format for the current platform, return all the * characters in the path after the last directory separator. But, if * path is the root directory, returns no characters. * * Results: * Returns the string object that represents the basename. If there is an * error, an error message is left in interp, and NULL is returned. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static Tcl_Obj * FileBasename( Tcl_Interp *interp, /* Interp, for error return. */ Tcl_Obj *pathPtr) /* Path whose basename to extract. */ { int objc; Tcl_Obj *splitPtr; Tcl_Obj *resultPtr = NULL; splitPtr = Tcl_FSSplitPath(pathPtr, &objc); Tcl_IncrRefCount(splitPtr); if (objc != 0) { if ((objc == 1) && (*TclGetString(pathPtr) == '~')) { Tcl_DecrRefCount(splitPtr); if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } splitPtr = Tcl_FSSplitPath(pathPtr, &objc); Tcl_IncrRefCount(splitPtr); } /* * Return the last component, unless it is the only component, and it * is the root of an absolute path. */ if (objc > 0) { Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr); if ((objc == 1) && (Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) { resultPtr = NULL; } } } if (resultPtr == NULL) { TclNewObj(resultPtr); } Tcl_IncrRefCount(resultPtr); Tcl_DecrRefCount(splitPtr); return resultPtr; } /* *---------------------------------------------------------------------- * * TclFileAttrsCmd -- * * Sets or gets the platform-specific attributes of a file. The objc-objv * points to the file name with the rest of the command line following. * This routine uses platform-specific tables of option strings and * callbacks. The callback to get the attributes take three parameters: * Tcl_Interp *interp; The interp to report errors with. Since * this is an object-based API, the object * form of the result should be used. * const char *fileName; This is extracted using * Tcl_TranslateFileName. * TclObj **attrObjPtrPtr; A new object to hold the attribute is * allocated and put here. * The first two parameters of the callback used to write out the * attributes are the same. The third parameter is: * const *attrObjPtr; A pointer to the object that has the new * attribute. * They both return standard TCL errors; if the routine to get an * attribute fails, no object is allocated and *attrObjPtrPtr is * unchanged. * * Results: * Standard TCL error. * * Side effects: * May set file attributes for the file name. * *---------------------------------------------------------------------- */ int TclFileAttrsCmd( ClientData clientData, /* Unused */ Tcl_Interp *interp, /* The interpreter for error reporting. */ int objc, /* Number of command line arguments. */ Tcl_Obj *const objv[]) /* The command line objects. */ { int result; const char *const *attributeStrings; const char **attributeStringsAllocated = NULL; Tcl_Obj *objStrings = NULL; int numObjStrings = -1; Tcl_Obj *filePtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?"); return TCL_ERROR; } filePtr = objv[1]; if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) { return TCL_ERROR; } objc -= 2; objv += 2; result = TCL_ERROR; Tcl_SetErrno(0); /* * Get the set of attribute names from the filesystem. */ attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings); if (attributeStrings == NULL) { int index; Tcl_Obj *objPtr; if (objStrings == NULL) { if (Tcl_GetErrno() != 0) { /* * There was an error, probably that the filePtr is not * accepted by any filesystem */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(filePtr), Tcl_PosixError(interp))); } return TCL_ERROR; } /* * We own the object now. */ Tcl_IncrRefCount(objStrings); /* * Use objStrings as a list object. */ if (TclListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) { goto end; } attributeStringsAllocated = (const char **) TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *)); for (index = 0; index < numObjStrings; index++) { Tcl_ListObjIndex(interp, objStrings, index, &objPtr); attributeStringsAllocated[index] = TclGetString(objPtr); } attributeStringsAllocated[index] = NULL; attributeStrings = attributeStringsAllocated; } else if (objStrings != NULL) { Tcl_Panic("must not update objPtrRef's variable and return non-NULL"); } /* * Process the attributes to produce a list of all of them, the value of a * particular attribute, or to set one or more attributes (depending on * the number of arguments). */ if (objc == 0) { /* * Get all attributes. */ int index, res = TCL_OK, nbAtts = 0; Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); for (index = 0; attributeStrings[index] != NULL; index++) { Tcl_Obj *objPtrAttr; if (res != TCL_OK) { /* * Clear the error from the last iteration. */ Tcl_ResetResult(interp); } res = Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtrAttr); if (res == TCL_OK) { Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1); Tcl_ListObjAppendElement(interp, listPtr, objPtr); Tcl_ListObjAppendElement(interp, listPtr, objPtrAttr); nbAtts++; } } if (index > 0 && nbAtts == 0) { /* * Error: no valid attributes found. */ Tcl_DecrRefCount(listPtr); goto end; } Tcl_SetObjResult(interp, listPtr); } else if (objc == 1) { /* * Get one attribute. */ int index; Tcl_Obj *objPtr = NULL; if (numObjStrings == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL); goto end; } if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings, "option", 0, &index) != TCL_OK) { goto end; } if (attributeStringsAllocated != NULL) { TclFreeIntRep(objv[0]); } if (Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtr) != TCL_OK) { goto end; } Tcl_SetObjResult(interp, objPtr); } else { /* * Set option/value pairs. */ int i, index; if (numObjStrings == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL); goto end; } for (i = 0; i < objc ; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings, "option", 0, &index) != TCL_OK) { goto end; } if (attributeStringsAllocated != NULL) { TclFreeIntRep(objv[i]); } if (i + 1 == objc) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "value for \"%s\" missing", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR", "NOVALUE", NULL); goto end; } if (Tcl_FSFileAttrsSet(interp, index, filePtr, objv[i + 1]) != TCL_OK) { goto end; } } } result = TCL_OK; /* * Free up the array we allocated and drop our reference to any list of * attribute names issued by the filesystem. */ end: if (attributeStringsAllocated != NULL) { TclStackFree(interp, (void *) attributeStringsAllocated); } if (objStrings != NULL) { Tcl_DecrRefCount(objStrings); } return result; } /* *---------------------------------------------------------------------- * * TclFileLinkCmd -- * * This function is invoked to process the "file link" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * May create a new link. * *---------------------------------------------------------------------- */ int TclFileLinkCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *contents; int index; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?"); return TCL_ERROR; } /* * Index of the 'source' argument. */ if (objc == 4) { index = 2; } else { index = 1; } if (objc > 2) { int linkAction; if (objc == 4) { /* * We have a '-linktype' argument. */ static const char *const linkTypes[] = { "-symbolic", "-hard", NULL }; if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "option", 0, &linkAction) != TCL_OK) { return TCL_ERROR; } if (linkAction == 0) { linkAction = TCL_CREATE_SYMBOLIC_LINK; } else { linkAction = TCL_CREATE_HARD_LINK; } } else { linkAction = TCL_CREATE_SYMBOLIC_LINK | TCL_CREATE_HARD_LINK; } if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) { return TCL_ERROR; } /* * Create link from source to target. */ contents = Tcl_FSLink(objv[index], objv[index+1], linkAction); if (contents == NULL) { /* * We handle three common error cases specially, and for all other * errors, we use the standard Posix error message. */ if (errno == EEXIST) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not create new link \"%s\": that path already" " exists", TclGetString(objv[index]))); Tcl_PosixError(interp); } else if (errno == ENOENT) { /* * There are two cases here: either the target doesn't exist, * or the directory of the src doesn't exist. */ int access; Tcl_Obj *dirPtr = TclPathPart(interp, objv[index], TCL_PATH_DIRNAME); if (dirPtr == NULL) { return TCL_ERROR; } access = Tcl_FSAccess(dirPtr, F_OK); Tcl_DecrRefCount(dirPtr); if (access != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not create new link \"%s\": no such file" " or directory", TclGetString(objv[index]))); Tcl_PosixError(interp); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not create new link \"%s\": target \"%s\" " "doesn't exist", TclGetString(objv[index]), TclGetString(objv[index+1]))); errno = ENOENT; Tcl_PosixError(interp); } } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not create new link \"%s\" pointing to \"%s\": %s", TclGetString(objv[index]), TclGetString(objv[index+1]), Tcl_PosixError(interp))); } return TCL_ERROR; } } else { if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) { return TCL_ERROR; } /* * Read link */ contents = Tcl_FSLink(objv[index], NULL, 0); if (contents == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read link \"%s\": %s", TclGetString(objv[index]), Tcl_PosixError(interp))); return TCL_ERROR; } } Tcl_SetObjResult(interp, contents); if (objc == 2) { /* * If we are reading a link, we need to free this result refCount. If * we are creating a link, this will just be objv[index+1], and so we * don't own it. */ Tcl_DecrRefCount(contents); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclFileReadLinkCmd -- * * This function is invoked to process the "file readlink" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclFileReadLinkCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *contents; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } contents = Tcl_FSLink(objv[1], NULL, 0); if (contents == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read link \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } Tcl_SetObjResult(interp, contents); Tcl_DecrRefCount(contents); return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclFileTemporaryCmd * * This function implements the "tempfile" subcommand of the "file" * command. * * Results: * Returns a standard Tcl result. * * Side effects: * Creates a temporary file. Opens a channel to that file and puts the * name of that channel in the result. *Might* register suitable exit * handlers to ensure that the temporary file gets deleted. Might write * to a variable, so reentrancy is a potential issue. * *--------------------------------------------------------------------------- */ int TclFileTemporaryCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary * file in. */ Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */ Tcl_Channel chan; /* The channel opened (RDWR) on the temporary * file, or NULL if there's an error. */ Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL; /* Pieces of template. Each piece is NULL if * it is omitted. The platform temporary file * engine might ignore some pieces. */ if (objc < 1 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?"); return TCL_ERROR; } if (objc > 1) { nameVarObj = objv[1]; TclNewObj(nameObj); } if (objc > 2) { int length; Tcl_Obj *templateObj = objv[2]; const char *string = TclGetStringFromObj(templateObj, &length); /* * Treat an empty string as if it wasn't there. */ if (length == 0) { goto makeTemporary; } /* * The template only gives a directory if there is a directory * separator in it. */ if (strchr(string, '/') != NULL || (tclPlatform == TCL_PLATFORM_WINDOWS && strchr(string, '\\') != NULL)) { tempDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME); /* * Only allow creation of temporary files in the native filesystem * since they are frequently used for integration with external * tools or system libraries. [Bug 2388866] */ if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj) != &tclNativeFilesystem) { TclDecrRefCount(tempDirObj); tempDirObj = NULL; } } /* * The template only gives the filename if the last character isn't a * directory separator. */ if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS || string[length-1] != '\\')) { Tcl_Obj *tailObj = TclPathPart(interp, templateObj, TCL_PATH_TAIL); if (tailObj != NULL) { tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT); tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION); TclDecrRefCount(tailObj); } } } /* * Convert empty parts of the template into unspecified parts. */ if (tempDirObj && !TclGetString(tempDirObj)[0]) { TclDecrRefCount(tempDirObj); tempDirObj = NULL; } if (tempBaseObj && !TclGetString(tempBaseObj)[0]) { TclDecrRefCount(tempBaseObj); tempBaseObj = NULL; } if (tempExtObj && !TclGetString(tempExtObj)[0]) { TclDecrRefCount(tempExtObj); tempExtObj = NULL; } /* * Create and open the temporary file. */ makeTemporary: chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj); /* * If we created pieces of template, get rid of them now. */ if (tempDirObj) { TclDecrRefCount(tempDirObj); } if (tempBaseObj) { TclDecrRefCount(tempBaseObj); } if (tempExtObj) { TclDecrRefCount(tempExtObj); } /* * Deal with results. */ if (chan == NULL) { if (nameVarObj) { TclDecrRefCount(nameObj); } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create temporary file: %s", Tcl_PosixError(interp))); return TCL_ERROR; } Tcl_RegisterChannel(interp, chan); if (nameVarObj != NULL) { if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_UnregisterChannel(interp, chan); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclFileName.c0000644000175000017500000020350214554262142015607 0ustar sergeisergei/* * tclFileName.c -- * * This file contains routines for converting file names betwen native * and network form. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclRegexp.h" #include "tclFileSystem.h" /* For TclGetPathType() */ /* * The following variable is set in the TclPlatformInit call to one of: * TCL_PLATFORM_UNIX or TCL_PLATFORM_WINDOWS. */ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX; /* * Prototypes for local procedures defined in this file: */ static const char * DoTildeSubst(Tcl_Interp *interp, const char *user, Tcl_DString *resultPtr); static const char * ExtractWinRoot(const char *path, Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr); static int SkipToChar(char **stringPtr, int match); static Tcl_Obj * SplitWinPath(const char *path); static Tcl_Obj * SplitUnixPath(const char *path); static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr, const char *separators, Tcl_Obj *pathPtr, int flags, char *pattern, Tcl_GlobTypeData *types); /* * When there is no support for getting the block size of a file in a stat() * call, use this as a guess. Allow it to be overridden in the platform- * specific files. */ #if (!defined(HAVE_STRUCT_STAT_ST_BLKSIZE) && !defined(GUESSED_BLOCK_SIZE)) #define GUESSED_BLOCK_SIZE 1024 #endif /* *---------------------------------------------------------------------- * * SetResultLength -- * * Resets the result DString for ExtractWinRoot to accommodate * any NT extended path prefixes. * * Results: * None. * * Side effects: * May modify the Tcl_DString. *---------------------------------------------------------------------- */ static void SetResultLength( Tcl_DString *resultPtr, int offset, int extended) { Tcl_DStringSetLength(resultPtr, offset); if (extended == 2) { TclDStringAppendLiteral(resultPtr, "//?/UNC/"); } else if (extended == 1) { TclDStringAppendLiteral(resultPtr, "//?/"); } } /* *---------------------------------------------------------------------- * * ExtractWinRoot -- * * Matches the root portion of a Windows path and appends it to the * specified Tcl_DString. * * Results: * Returns the position in the path immediately after the root including * any trailing slashes. Appends a cleaned up version of the root to the * Tcl_DString at the specified offset. * * Side effects: * Modifies the specified Tcl_DString. * *---------------------------------------------------------------------- */ static const char * ExtractWinRoot( const char *path, /* Path to parse. */ Tcl_DString *resultPtr, /* Buffer to hold result. */ int offset, /* Offset in buffer where result should be * stored. */ Tcl_PathType *typePtr) /* Where to store pathType result */ { int extended = 0; if ( (path[0] == '/' || path[0] == '\\') && (path[1] == '/' || path[1] == '\\') && (path[2] == '?') && (path[3] == '/' || path[3] == '\\')) { extended = 1; path = path + 4; if (path[0] == 'U' && path[1] == 'N' && path[2] == 'C' && (path[3] == '/' || path[3] == '\\')) { extended = 2; path = path + 4; } } if (path[0] == '/' || path[0] == '\\') { /* * Might be a UNC or Vol-Relative path. */ const char *host, *share, *tail; int hlen, slen; if (path[1] != '/' && path[1] != '\\') { SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; TclDStringAppendLiteral(resultPtr, "/"); return &path[1]; } host = &path[2]; /* * Skip separators. */ while (host[0] == '/' || host[0] == '\\') { host++; } for (hlen = 0; host[hlen];hlen++) { if (host[hlen] == '/' || host[hlen] == '\\') { break; } } if (host[hlen] == 0 || host[hlen+1] == 0) { /* * The path given is simply of the form '/foo', '//foo', * '/////foo' or the same with backslashes. If there is exactly * one leading '/' the path is volume relative (see filename man * page). If there are more than one, we are simply assuming they * are superfluous and we trim them away. (An alternative * interpretation would be that it is a host name, but we have * been documented that that is not the case). */ *typePtr = TCL_PATH_VOLUME_RELATIVE; TclDStringAppendLiteral(resultPtr, "/"); return &path[2]; } SetResultLength(resultPtr, offset, extended); share = &host[hlen]; /* * Skip separators. */ while (share[0] == '/' || share[0] == '\\') { share++; } for (slen=0; share[slen]; slen++) { if (share[slen] == '/' || share[slen] == '\\') { break; } } TclDStringAppendLiteral(resultPtr, "//"); Tcl_DStringAppend(resultPtr, host, hlen); TclDStringAppendLiteral(resultPtr, "/"); Tcl_DStringAppend(resultPtr, share, slen); tail = &share[slen]; /* * Skip separators. */ while (tail[0] == '/' || tail[0] == '\\') { tail++; } *typePtr = TCL_PATH_ABSOLUTE; return tail; } else if (*path && path[1] == ':') { /* * Might be a drive separator. */ SetResultLength(resultPtr, offset, extended); if (path[2] != '/' && path[2] != '\\') { *typePtr = TCL_PATH_VOLUME_RELATIVE; Tcl_DStringAppend(resultPtr, path, 2); return &path[2]; } else { const char *tail = &path[3]; /* * Skip separators. */ while (*tail && (tail[0] == '/' || tail[0] == '\\')) { tail++; } *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringAppend(resultPtr, path, 2); TclDStringAppendLiteral(resultPtr, "/"); return tail; } } else { int abs = 0; /* * Check for Windows devices. */ if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') && path[3] >= '1' && path[3] <= '9') { /* * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { abs = 4; } else if (path[4] == ':' && path[5] == '\0') { abs = 5; } } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* * Have match for 'con'. */ abs = 3; } } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { if (path[3] >= '1' && path[3] <= '9') { /* * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { abs = 4; } else if (path[4] == ':' && path[5] == '\0') { abs = 5; } } } else if ((path[0] == 'p' || path[0] == 'P') && (path[1] == 'r' || path[1] == 'R') && (path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* * Have match for 'prn'. */ abs = 3; } else if ((path[0] == 'n' || path[0] == 'N') && (path[1] == 'u' || path[1] == 'U') && (path[2] == 'l' || path[2] == 'L') && path[3] == '\0') { /* * Have match for 'nul'. */ abs = 3; } else if ((path[0] == 'a' || path[0] == 'A') && (path[1] == 'u' || path[1] == 'U') && (path[2] == 'x' || path[2] == 'X') && path[3] == '\0') { /* * Have match for 'aux'. */ abs = 3; } if (abs != 0) { *typePtr = TCL_PATH_ABSOLUTE; SetResultLength(resultPtr, offset, extended); Tcl_DStringAppend(resultPtr, path, abs); return path + abs; } } /* * Anything else is treated as relative. */ *typePtr = TCL_PATH_RELATIVE; return path; } /* *---------------------------------------------------------------------- * * Tcl_GetPathType -- * * Determines whether a given path is relative to the current directory, * relative to the current volume, or absolute. * * The objectified Tcl_FSGetPathType should be used in preference to this * function (as you can see below, this is just a wrapper around that * other function). * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_PathType Tcl_GetPathType( const char *path) { Tcl_PathType type; Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(tempObj); type = Tcl_FSGetPathType(tempObj); Tcl_DecrRefCount(tempObj); return type; } /* *---------------------------------------------------------------------- * * TclpGetNativePathType -- * * Determines whether a given path is relative to the current directory, * relative to the current volume, or absolute, but ONLY FOR THE NATIVE * FILESYSTEM. This function is called from tclIOUtil.c (but needs to be * here due to its dependence on static variables/functions in this * file). The exported function Tcl_FSGetPathType should be used by * extensions. * * Note that '~' paths are always considered TCL_PATH_ABSOLUTE, even * though expanding the '~' could lead to any possible path type. This * function should therefore be considered a low-level, string * manipulation function only -- it doesn't actually do any expansion in * making its determination. * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_PathType TclpGetNativePathType( Tcl_Obj *pathPtr, /* Native path of interest */ int *driveNameLengthPtr, /* Returns length of drive, if non-NULL and * path was absolute */ Tcl_Obj **driveNameRef) { Tcl_PathType type = TCL_PATH_ABSOLUTE; int pathLen; const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); if (path[0] == '~') { /* * This case is common to all platforms. Paths that begin with ~ are * absolute. */ if (driveNameLengthPtr != NULL) { const char *end = path + 1; while ((*end != '\0') && (*end != '/')) { end++; } *driveNameLengthPtr = end - path; } } else { switch (tclPlatform) { case TCL_PLATFORM_UNIX: { const char *origPath = path; /* * Paths that begin with / are absolute. */ if (path[0] == '/') { ++path; #if defined(__CYGWIN__) || defined(__QNX__) /* * Check for "//" network path prefix */ if ((*path == '/') && path[1] && (path[1] != '/')) { path += 2; while (*path && *path != '/') { ++path; } } #endif if (driveNameLengthPtr != NULL) { /* * We need this addition in case the "//" code was used. */ *driveNameLengthPtr = (path - origPath); } } else { type = TCL_PATH_RELATIVE; } break; } case TCL_PLATFORM_WINDOWS: { Tcl_DString ds; const char *rootEnd; Tcl_DStringInit(&ds); rootEnd = ExtractWinRoot(path, &ds, 0, &type); if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { *driveNameLengthPtr = rootEnd - path; if (driveNameRef != NULL) { *driveNameRef = TclDStringToObj(&ds); Tcl_IncrRefCount(*driveNameRef); } } Tcl_DStringFree(&ds); break; } } } return type; } /* *--------------------------------------------------------------------------- * * TclpNativeSplitPath -- * * This function takes the given Tcl_Obj, which should be a valid path, * and returns a Tcl List object containing each segment of that path as * an element. * * Note this function currently calls the older Split(Plat)Path * functions, which require more memory allocation than is desirable. * * Results: * Returns list object with refCount of zero. If the passed in lenPtr is * non-NULL, we use it to return the number of elements in the returned * list. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclpNativeSplitPath( Tcl_Obj *pathPtr, /* Path to split. */ int *lenPtr) /* int to store number of path elements. */ { Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ /* * Perform platform specific splitting. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: resultPtr = SplitUnixPath(Tcl_GetString(pathPtr)); break; case TCL_PLATFORM_WINDOWS: resultPtr = SplitWinPath(Tcl_GetString(pathPtr)); break; } /* * Compute the number of elements in the result. */ if (lenPtr != NULL) { TclListObjLength(NULL, resultPtr, lenPtr); } return resultPtr; } /* *---------------------------------------------------------------------- * * Tcl_SplitPath -- * * Split a path into a list of path components. The first element of the * list will have the same path type as the original path. * * Results: * Returns a standard Tcl result. The interpreter result contains a list * of path components. *argvPtr will be filled in with the address of an * array whose elements point to the elements of path, in order. * *argcPtr will get filled in with the number of valid elements in the * array. A single block of memory is dynamically allocated to hold both * the argv array and a copy of the path elements. The caller must * eventually free this memory by calling ckfree() on *argvPtr. Note: * *argvPtr and *argcPtr are only modified if the procedure returns * normally. * * Side effects: * Allocates memory. * *---------------------------------------------------------------------- */ void Tcl_SplitPath( const char *path, /* Pointer to string containing a path. */ int *argcPtr, /* Pointer to location to fill in with the * number of elements in the path. */ const char ***argvPtr) /* Pointer to place to store pointer to array * of pointers to path elements. */ { Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ Tcl_Obj *tmpPtr, *eltPtr; int i, size, len; char *p; const char *str; /* * Perform the splitting, using objectified, vfs-aware code. */ tmpPtr = Tcl_NewStringObj(path, -1); Tcl_IncrRefCount(tmpPtr); resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr); Tcl_IncrRefCount(resultPtr); Tcl_DecrRefCount(tmpPtr); /* * Calculate space required for the result. */ size = 1; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); Tcl_GetStringFromObj(eltPtr, &len); size += len + 1; } /* * Allocate a buffer large enough to hold the contents of all of the list * plus the argv pointers and the terminating NULL pointer. */ *argvPtr = (const char **)ckalloc( ((((*argcPtr) + 1) * sizeof(char *)) + size)); /* * Position p after the last argv pointer and copy the contents of the * list in, piece by piece. */ p = (char *) &(*argvPtr)[(*argcPtr) + 1]; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); str = Tcl_GetStringFromObj(eltPtr, &len); memcpy(p, str, len + 1); p += len+1; } /* * Now set up the argv pointers. */ p = (char *) &(*argvPtr)[(*argcPtr) + 1]; for (i = 0; i < *argcPtr; i++) { (*argvPtr)[i] = p; for (; *(p++)!='\0'; ); } (*argvPtr)[i] = NULL; /* * Free the result ptr given to us by Tcl_FSSplitPath */ Tcl_DecrRefCount(resultPtr); } /* *---------------------------------------------------------------------- * * SplitUnixPath -- * * This routine is used by Tcl_(FS)SplitPath to handle splitting Unix * paths. * * Results: * Returns a newly allocated Tcl list object. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Obj * SplitUnixPath( const char *path) /* Pointer to string containing a path. */ { int length; const char *origPath = path, *elementStart; Tcl_Obj *result; /* * Deal with the root directory as a special case. */ TclNewObj(result); if (*path == '/') { Tcl_Obj *rootElt; ++path; #if defined(__CYGWIN__) || defined(__QNX__) /* * Check for "//" network path prefix */ if ((*path == '/') && path[1] && (path[1] != '/')) { path += 2; while (*path && *path != '/') { ++path; } } #endif rootElt = Tcl_NewStringObj(origPath, path - origPath); Tcl_ListObjAppendElement(NULL, result, rootElt); while (*path == '/') { ++path; } } /* * Split on slashes. Embedded elements that start with tilde will be * prefixed with "./" so they are not affected by tilde substitution. */ for (;;) { elementStart = path; while ((*path != '\0') && (*path != '/')) { path++; } length = path - elementStart; if (length > 0) { Tcl_Obj *nextElt; if ((elementStart[0] == '~') && (elementStart != origPath)) { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { nextElt = Tcl_NewStringObj(elementStart, length); } Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*path++ == '\0') { break; } } return result; } /* *---------------------------------------------------------------------- * * SplitWinPath -- * * This routine is used by Tcl_(FS)SplitPath to handle splitting Windows * paths. * * Results: * Returns a newly allocated Tcl list object. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Obj * SplitWinPath( const char *path) /* Pointer to string containing a path. */ { int length; const char *p, *elementStart; Tcl_PathType type = TCL_PATH_ABSOLUTE; Tcl_DString buf; Tcl_Obj *result; Tcl_DStringInit(&buf); TclNewObj(result); p = ExtractWinRoot(path, &buf, 0, &type); /* * Terminate the root portion, if we matched something. */ if (p != path) { Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf)); } Tcl_DStringFree(&buf); /* * Split on slashes. Embedded elements that start with tilde or a drive * letter will be prefixed with "./" so they are not affected by tilde * substitution. */ do { elementStart = p; while ((*p != '\0') && (*p != '/') && (*p != '\\')) { p++; } length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; if ((elementStart != path) && ((elementStart[0] == '~') || (isalpha(UCHAR(elementStart[0])) && elementStart[1] == ':'))) { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { nextElt = Tcl_NewStringObj(elementStart, length); } Tcl_ListObjAppendElement(NULL, result, nextElt); } } while (*p++ != '\0'); return result; } /* *--------------------------------------------------------------------------- * * Tcl_FSJoinToPath -- * * This function takes the given object, which should usually be a valid * path or NULL, and joins onto it the array of paths segments given. * * The objects in the array given will temporarily have their refCount * increased by one, and then decreased by one when this function exits * (which means if they had zero refCount when we were called, they will * be freed). * * Results: * Returns object owned by the caller (which should increment its * refCount) - typically an object with refCount of zero. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSJoinToPath( Tcl_Obj *pathPtr, /* Valid path or NULL. */ int objc, /* Number of array elements to join */ Tcl_Obj *const objv[]) /* Path elements to join. */ { if (pathPtr == NULL) { return TclJoinPath(objc, objv, 0); } if (objc == 0) { return TclJoinPath(1, &pathPtr, 0); } if (objc == 1) { Tcl_Obj *pair[2]; pair[0] = pathPtr; pair[1] = objv[0]; return TclJoinPath(2, pair, 0); } else { int elemc = objc + 1; Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *)); elemv[0] = pathPtr; memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *)); ret = TclJoinPath(elemc, elemv, 0); ckfree(elemv); return ret; } } /* *--------------------------------------------------------------------------- * * TclpNativeJoinPath -- * * 'prefix' is absolute, 'joining' is relative to prefix. * * Results: * modifies prefix * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclpNativeJoinPath( Tcl_Obj *prefix, const char *joining) { int length, needsSep; char *dest; const char *p; const char *start; start = Tcl_GetStringFromObj(prefix, &length); /* * Remove the ./ from tilde prefixed elements, and drive-letter prefixed * elements on Windows, unless it is the first component. */ p = joining; if (length != 0) { if ((p[0] == '.') && (p[1] == '/') && ((p[2] == '~') || (tclPlatform==TCL_PLATFORM_WINDOWS && isalpha(UCHAR(p[2])) && (p[3] == ':')))) { p += 2; } } if (*p == '\0') { return; } switch (tclPlatform) { case TCL_PLATFORM_UNIX: /* * Append a separator if needed. */ if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; /* * Append the element, eliminating duplicate and trailing slashes. */ Tcl_SetObjLength(prefix, length + (int) strlen(p)); dest = Tcl_GetString(prefix) + length; for (; *p != '\0'; p++) { if (*p == '/') { while (p[1] == '/') { p++; } if (p[1] != '\0' && needsSep) { *dest++ = '/'; } } else { *dest++ = *p; needsSep = 1; } } length = dest - Tcl_GetString(prefix); Tcl_SetObjLength(prefix, length); break; case TCL_PLATFORM_WINDOWS: /* * Check to see if we need to append a separator. */ if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; /* * Append the element, eliminating duplicate and trailing slashes. */ Tcl_SetObjLength(prefix, length + (int) strlen(p)); dest = Tcl_GetString(prefix) + length; for (; *p != '\0'; p++) { if ((*p == '/') || (*p == '\\')) { while ((p[1] == '/') || (p[1] == '\\')) { p++; } if ((p[1] != '\0') && needsSep) { *dest++ = '/'; } } else { *dest++ = *p; needsSep = 1; } } length = dest - Tcl_GetString(prefix); Tcl_SetObjLength(prefix, length); break; } return; } /* *---------------------------------------------------------------------- * * Tcl_JoinPath -- * * Combine a list of paths in a platform specific manner. The function * 'Tcl_FSJoinPath' should be used in preference where possible. * * Results: * Appends the joined path to the end of the specified Tcl_DString * returning a pointer to the resulting string. Note that the * Tcl_DString must already be initialized. * * Side effects: * Modifies the Tcl_DString. * *---------------------------------------------------------------------- */ char * Tcl_JoinPath( int argc, const char *const *argv, Tcl_DString *resultPtr) /* Pointer to previously initialized DString */ { int i, len; Tcl_Obj *listObj; Tcl_Obj *resultObj; const char *resultStr; /* * Build the list of paths. */ TclNewObj(listObj); for (i = 0; i < argc; i++) { Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewStringObj(argv[i], -1)); } /* * Ask the objectified code to join the paths. */ Tcl_IncrRefCount(listObj); resultObj = Tcl_FSJoinPath(listObj, argc); Tcl_IncrRefCount(resultObj); Tcl_DecrRefCount(listObj); /* * Store the result. */ resultStr = Tcl_GetStringFromObj(resultObj, &len); Tcl_DStringAppend(resultPtr, resultStr, len); Tcl_DecrRefCount(resultObj); /* * Return a pointer to the result. */ return Tcl_DStringValue(resultPtr); } /* *--------------------------------------------------------------------------- * * Tcl_TranslateFileName -- * * Converts a file name into a form usable by the native system * interfaces. If the name starts with a tilde, it will produce a name * where the tilde and following characters have been replaced by the * home directory location for the named user. * * Results: * The return value is a pointer to a string containing the name after * tilde substitution. If there was no tilde substitution, the return * value is a pointer to a copy of the original string. If there was an * error in processing the name, then an error message is left in the * interp's result (if interp was not NULL) and the return value is NULL. * Space for the return value is allocated in bufferPtr; the caller must * call Tcl_DStringFree() to free the space if the return value was not * NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * Tcl_TranslateFileName( Tcl_Interp *interp, /* Interpreter in which to store error message * (if necessary). */ const char *name, /* File name, which may begin with "~" (to * indicate current user's home directory) or * "~" (to indicate any user's home * directory). */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name after tilde substitution. */ { Tcl_Obj *path = Tcl_NewStringObj(name, -1); Tcl_Obj *transPtr; Tcl_IncrRefCount(path); transPtr = Tcl_FSGetTranslatedPath(interp, path); if (transPtr == NULL) { Tcl_DecrRefCount(path); return NULL; } Tcl_DStringInit(bufferPtr); TclDStringAppendObj(bufferPtr, transPtr); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); /* * Convert forward slashes to backslashes in Windows paths because some * system interfaces don't accept forward slashes. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { char *p; for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '/') { *p = '\\'; } } } return Tcl_DStringValue(bufferPtr); } /* *---------------------------------------------------------------------- * * TclGetExtension -- * * This function returns a pointer to the beginning of the extension part * of a file name. * * Results: * Returns a pointer into name which indicates where the extension * starts. If there is no extension, returns NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * TclGetExtension( const char *name) /* File name to parse. */ { const char *p, *lastSep; /* * First find the last directory separator. */ lastSep = NULL; /* Needed only to prevent gcc warnings. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: lastSep = strrchr(name, '/'); break; case TCL_PLATFORM_WINDOWS: lastSep = NULL; for (p = name; *p != '\0'; p++) { if (strchr("/\\:", *p) != NULL) { lastSep = p; } } break; } p = strrchr(name, '.'); if ((p != NULL) && (lastSep != NULL) && (lastSep > p)) { p = NULL; } /* * In earlier versions, we used to back up to the first period in a series * so that "foo..o" would be split into "foo" and "..o". This is a * confusing and usually incorrect behavior, so now we split at the last * period in the name. */ return p; } /* *---------------------------------------------------------------------- * * DoTildeSubst -- * * Given a string following a tilde, this routine returns the * corresponding home directory. * * Results: * The result is a pointer to a static string containing the home * directory in native format. If there was an error in processing the * substitution, then an error message is left in the interp's result and * the return value is NULL. On success, the results are appended to * resultPtr, and the contents of resultPtr are returned. * * Side effects: * Information may be left in resultPtr. * *---------------------------------------------------------------------- */ static const char * DoTildeSubst( Tcl_Interp *interp, /* Interpreter in which to store error message * (if necessary). */ const char *user, /* Name of user whose home directory should be * substituted, or "" for current user. */ Tcl_DString *resultPtr) /* Initialized DString filled with name after * tilde substitution. */ { const char *dir; if (*user == '\0') { Tcl_DString dirString; dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't find HOME environment " "variable to expand path", -1)); Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL); } return NULL; } Tcl_JoinPath(1, &dir, resultPtr); Tcl_DStringFree(&dirString); } else if (TclpGetUserHome(user, resultPtr) == NULL) { if (interp) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "user \"%s\" doesn't exist", user)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL); } return NULL; } return Tcl_DStringValue(resultPtr); } /* *---------------------------------------------------------------------- * * Tcl_GlobObjCmd -- * * This procedure is invoked to process the "glob" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_GlobObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int index, i, globFlags, length, join, dir, result; char *string; const char *separators; Tcl_Obj *typePtr, *look; Tcl_Obj *pathOrDir = NULL; Tcl_DString prefix; static const char *const options[] = { "-directory", "-join", "-nocomplain", "-path", "-tails", "-types", "--", NULL }; enum globOptionsEnum { GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS, GLOB_TYPE, GLOB_LAST }; enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1}; Tcl_GlobTypeData *globTypes = NULL; (void)dummy; globFlags = 0; join = 0; dir = PATH_NONE; typePtr = NULL; for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { string = Tcl_GetStringFromObj(objv[i], &length); if (string[0] == '-') { /* * It looks like the command contains an option so signal an * error. */ return TCL_ERROR; } else { /* * This clearly isn't an option; assume it's the first glob * pattern. We must clear the error. */ Tcl_ResetResult(interp); break; } } switch ((enum globOptionsEnum) index) { case GLOB_NOCOMPLAIN: /* -nocomplain */ globFlags |= TCL_GLOBMODE_NO_COMPLAIN; break; case GLOB_DIR: /* -dir */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-directory\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } if (dir != PATH_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( dir == PATH_DIR ? "\"-directory\" may only be used once" : "\"-directory\" cannot be used with \"-path\"", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; } dir = PATH_DIR; globFlags |= TCL_GLOBMODE_DIR; pathOrDir = objv[i+1]; i++; break; case GLOB_JOIN: /* -join */ join = 1; break; case GLOB_TAILS: /* -tails */ globFlags |= TCL_GLOBMODE_TAILS; break; case GLOB_PATH: /* -path */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-path\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } if (dir != PATH_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( dir == PATH_GENERAL ? "\"-path\" may only be used once" : "\"-path\" cannot be used with \"-dictionary\"", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; } dir = PATH_GENERAL; pathOrDir = objv[i+1]; i++; break; case GLOB_TYPE: /* -types */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-types\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } typePtr = objv[i+1]; if (TclListObjLength(interp, typePtr, &length) != TCL_OK) { return TCL_ERROR; } i++; break; case GLOB_LAST: /* -- */ i++; goto endOfForLoop; } } endOfForLoop: if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-tails\" must be used with either " "\"-directory\" or \"-path\"", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; } separators = NULL; switch (tclPlatform) { case TCL_PLATFORM_UNIX: separators = "/"; break; case TCL_PLATFORM_WINDOWS: separators = "/\\:"; break; } if (dir == PATH_GENERAL) { int pathlength; const char *last; const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength); /* * Find the last path separator in the path */ last = first + pathlength; for (; last != first; last--) { if (strchr(separators, *(last-1)) != NULL) { break; } } if (last == first + pathlength) { /* * It's really a directory. */ dir = PATH_DIR; } else { Tcl_DString pref; char *search, *find; Tcl_DStringInit(&pref); if (last == first) { /* * The whole thing is a prefix. This means we must remove any * 'tails' flag too, since it is irrelevant now (the same * effect will happen without it), but in particular its use * in TclGlob requires a non-NULL pathOrDir. */ Tcl_DStringAppend(&pref, first, -1); globFlags &= ~TCL_GLOBMODE_TAILS; pathOrDir = NULL; } else { /* * Have to split off the end. */ Tcl_DStringAppend(&pref, last, first+pathlength-last); pathOrDir = Tcl_NewStringObj(first, last-first-1); /* * We must ensure that we haven't cut off too much, and turned * a valid path like '/' or 'C:/' into an incorrect path like * '' or 'C:'. The way we do this is to add a separator if * there are none presently in the prefix. */ if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) { Tcl_AppendToObj(pathOrDir, last-1, 1); } } /* * Need to quote 'prefix'. */ Tcl_DStringInit(&prefix); search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); TclDStringAppendLiteral(&prefix, "\\"); Tcl_DStringAppend(&prefix, find, 1); search = find+1; if (*search == '\0') { break; } } if (*search != '\0') { Tcl_DStringAppend(&prefix, search, -1); } Tcl_DStringFree(&pref); } } if (pathOrDir != NULL) { Tcl_IncrRefCount(pathOrDir); } if (typePtr != NULL) { /* * The rest of the possible type arguments (except 'd') are platform * specific. We don't complain when they are used on an incompatible * platform. */ TclListObjLength(interp, typePtr, &length); if (length <= 0) { goto skipTypes; } globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData)); globTypes->type = 0; globTypes->perm = 0; globTypes->macType = NULL; globTypes->macCreator = NULL; while (--length >= 0) { int len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); str = Tcl_GetStringFromObj(look, &len); if (strcmp("readonly", str) == 0) { globTypes->perm |= TCL_GLOB_PERM_RONLY; } else if (strcmp("hidden", str) == 0) { globTypes->perm |= TCL_GLOB_PERM_HIDDEN; } else if (len == 1) { switch (str[0]) { case 'r': globTypes->perm |= TCL_GLOB_PERM_R; break; case 'w': globTypes->perm |= TCL_GLOB_PERM_W; break; case 'x': globTypes->perm |= TCL_GLOB_PERM_X; break; case 'b': globTypes->type |= TCL_GLOB_TYPE_BLOCK; break; case 'c': globTypes->type |= TCL_GLOB_TYPE_CHAR; break; case 'd': globTypes->type |= TCL_GLOB_TYPE_DIR; break; case 'p': globTypes->type |= TCL_GLOB_TYPE_PIPE; break; case 'f': globTypes->type |= TCL_GLOB_TYPE_FILE; break; case 'l': globTypes->type |= TCL_GLOB_TYPE_LINK; break; case 's': globTypes->type |= TCL_GLOB_TYPE_SOCK; break; default: goto badTypesArg; } } else if (len == 4) { /* * This is assumed to be a MacOS file type. */ if (globTypes->macType != NULL) { goto badMacTypesArg; } globTypes->macType = look; Tcl_IncrRefCount(look); } else { Tcl_Obj *item; if ((TclListObjLength(NULL, look, &len) == TCL_OK) && (len == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); if (!strcmp("macintosh", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 1, &item); if (!strcmp("type", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 2, &item); if (globTypes->macType != NULL) { goto badMacTypesArg; } globTypes->macType = item; Tcl_IncrRefCount(item); continue; } else if (!strcmp("creator", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 2, &item); if (globTypes->macCreator != NULL) { goto badMacTypesArg; } globTypes->macCreator = item; Tcl_IncrRefCount(item); continue; } } } /* * Error cases. We reset the 'join' flag to zero, since we * haven't yet made use of it. */ badTypesArg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument to \"-types\": %s", Tcl_GetString(look))); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); result = TCL_ERROR; join = 0; goto endOfGlob; badMacTypesArg: Tcl_SetObjResult(interp, Tcl_NewStringObj( "only one MacOS type or creator argument" " to \"-types\" allowed", -1)); result = TCL_ERROR; Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); join = 0; goto endOfGlob; } } } skipTypes: /* * Now we perform the actual glob below. This may involve joining together * the pattern arguments, dealing with particular file types etc. We use a * 'goto' to ensure we free any memory allocated along the way. */ objc -= i; objv += i; result = TCL_OK; if (join) { if (dir != PATH_GENERAL) { Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { TclDStringAppendObj(&prefix, objv[i]); if (i != objc -1) { Tcl_DStringAppend(&prefix, separators, 1); } } if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; goto endOfGlob; } } else if (dir == PATH_GENERAL) { Tcl_DString str; Tcl_DStringInit(&str); for (i = 0; i < objc; i++) { Tcl_DStringSetLength(&str, 0); if (dir == PATH_GENERAL) { TclDStringAppendDString(&str, &prefix); } TclDStringAppendObj(&str, objv[i]); if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; Tcl_DStringFree(&str); goto endOfGlob; } } Tcl_DStringFree(&str); } else { for (i = 0; i < objc; i++) { string = Tcl_GetString(objv[i]); if (TclGlob(interp, string, pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; goto endOfGlob; } } } if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) { if (TclListObjLength(interp, Tcl_GetObjResult(interp), &length) != TCL_OK) { /* * This should never happen. Maybe we should be more dramatic. */ result = TCL_ERROR; goto endOfGlob; } if (length == 0) { Tcl_Obj *errorMsg = Tcl_ObjPrintf("no files matched glob pattern%s \"", (join || (objc == 1)) ? "" : "s"); if (join) { Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1); } else { const char *sep = ""; for (i = 0; i < objc; i++) { Tcl_AppendPrintfToObj(errorMsg, "%s%s", sep, Tcl_GetString(objv[i])); sep = " "; } } Tcl_AppendToObj(errorMsg, "\"", -1); Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH", NULL); result = TCL_ERROR; } } endOfGlob: if (join || (dir == PATH_GENERAL)) { Tcl_DStringFree(&prefix); } if (pathOrDir != NULL) { Tcl_DecrRefCount(pathOrDir); } if (globTypes != NULL) { if (globTypes->macType != NULL) { Tcl_DecrRefCount(globTypes->macType); } if (globTypes->macCreator != NULL) { Tcl_DecrRefCount(globTypes->macCreator); } TclStackFree(interp, globTypes); } return result; } /* *---------------------------------------------------------------------- * * TclGlob -- * * Sets the separator string based on the platform, performs tilde * substitution, and calls DoGlob. * * The interpreter's result, on entry to this function, must be a valid * Tcl list (e.g. it could be empty), since we will lappend any new * results to that list. If it is not a valid list, this function will * fail to do anything very meaningful. * * Note that if globFlags contains 'TCL_GLOBMODE_TAILS' then pathPrefix * cannot be NULL (it is only allowed with -dir or -path). * * Results: * The return value is a standard Tcl result indicating whether an error * occurred in globbing. After a normal return the result in interp (set * by DoGlob) holds all of the file names given by the pattern and * pathPrefix arguments. After an error the result in interp will hold * an error message. * * Side effects: * The 'pattern' is written to. * *---------------------------------------------------------------------- */ int TclGlob( Tcl_Interp *interp, /* Interpreter for returning error message or * appending list of matching file names. */ char *pattern, /* Glob pattern to match. Must not refer to a * static string. */ Tcl_Obj *pathPrefix, /* Path prefix to glob pattern, if non-null, * which is considered literally. */ int globFlags, /* Stores or'ed combination of flags */ Tcl_GlobTypeData *types) /* Struct containing acceptable types. May be * NULL. */ { const char *separators; const char *head; char *tail, *start; int result; Tcl_Obj *filenamesObj, *savedResultObj; separators = NULL; switch (tclPlatform) { case TCL_PLATFORM_UNIX: separators = "/"; break; case TCL_PLATFORM_WINDOWS: separators = "/\\:"; break; } if (pathPrefix == NULL) { char c; Tcl_DString buffer; Tcl_DStringInit(&buffer); start = pattern; /* * Perform tilde substitution, if needed. */ if (start[0] == '~') { /* * Find the first path separator after the tilde. */ for (tail = start; *tail != '\0'; tail++) { if (*tail == '\\') { if (strchr(separators, tail[1]) != NULL) { break; } } else if (strchr(separators, *tail) != NULL) { break; } } /* * Determine the home directory for the specified user. */ c = *tail; *tail = '\0'; head = DoTildeSubst(interp, start+1, &buffer); *tail = c; if (head == NULL) { return TCL_ERROR; } if (head != Tcl_DStringValue(&buffer)) { Tcl_DStringAppend(&buffer, head, -1); } pathPrefix = TclDStringToObj(&buffer); Tcl_IncrRefCount(pathPrefix); globFlags |= TCL_GLOBMODE_DIR; if (c != '\0') { tail++; } Tcl_DStringFree(&buffer); } else { tail = pattern; } } else { Tcl_IncrRefCount(pathPrefix); tail = pattern; } /* * Handling empty path prefixes with glob patterns like 'C:' or * 'c:////////' is a pain on Windows if we leave it too late, since these * aren't really patterns at all! We therefore check the head of the * pattern now for such cases, if we don't have an unquoted prefix yet. * * Similarly on Unix with '/' at the head of the pattern -- it just * indicates the root volume, so we treat it as such. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (pathPrefix == NULL && tail[0] != '\0' && tail[1] == ':') { char *p = tail + 1; pathPrefix = Tcl_NewStringObj(tail, 1); while (*p != '\0') { char c = p[1]; if (*p == '\\') { if (strchr(separators, c) != NULL) { if (c == '\\') { c = '/'; } Tcl_AppendToObj(pathPrefix, &c, 1); p++; } else { break; } } else if (strchr(separators, *p) != NULL) { Tcl_AppendToObj(pathPrefix, p, 1); } else { break; } p++; } tail = p; Tcl_IncrRefCount(pathPrefix); } else if (pathPrefix == NULL && (tail[0] == '/' || (tail[0] == '\\' && tail[1] == '\\'))) { int driveNameLen; Tcl_Obj *driveName; Tcl_Obj *temp = Tcl_NewStringObj(tail, -1); Tcl_IncrRefCount(temp); switch (TclGetPathType(temp, NULL, &driveNameLen, &driveName)) { case TCL_PATH_VOLUME_RELATIVE: { /* * Volume relative path which is equivalent to a path in the * root of the cwd's volume. We will actually return * non-volume-relative paths here. i.e. 'glob /foo*' will * return 'C:/foobar'. This is much the same as globbing for a * path with '\\' will return one with '/' on Windows. */ Tcl_Obj *cwd = Tcl_FSGetCwd(interp); if (cwd == NULL) { Tcl_DecrRefCount(temp); return TCL_ERROR; } pathPrefix = Tcl_NewStringObj(Tcl_GetString(cwd), 3); Tcl_DecrRefCount(cwd); if (tail[0] == '/') { tail++; } else { tail += 2; } Tcl_IncrRefCount(pathPrefix); break; } case TCL_PATH_ABSOLUTE: /* * Absolute, possibly network path //Machine/Share. Use that * as the path prefix (it already has a refCount). */ pathPrefix = driveName; tail += driveNameLen; break; case TCL_PATH_RELATIVE: /* Do nothing */ break; } Tcl_DecrRefCount(temp); } /* * ':' no longer needed as a separator. It is only relevant to the * beginning of the path. */ separators = "/\\"; } else if (tclPlatform == TCL_PLATFORM_UNIX) { if (pathPrefix == NULL && tail[0] == '/' #if defined(__CYGWIN__) || defined(__QNX__) && tail[1] != '/' #endif ) { pathPrefix = Tcl_NewStringObj(tail, 1); tail++; Tcl_IncrRefCount(pathPrefix); } } /* * Finally if we still haven't managed to generate a path prefix, check if * the path starts with a current volume. */ if (pathPrefix == NULL) { int driveNameLen; Tcl_Obj *driveName; if (TclFSNonnativePathType(tail, (int) strlen(tail), NULL, &driveNameLen, &driveName) == TCL_PATH_ABSOLUTE) { pathPrefix = driveName; tail += driveNameLen; } } /* * To process a [glob] invocation, this function may be called multiple * times. Each time, the previously discovered filenames are in the * interpreter result. We stash that away here so the result is free for * error messages. */ savedResultObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(savedResultObj); Tcl_ResetResult(interp); TclNewObj(filenamesObj); Tcl_IncrRefCount(filenamesObj); /* * Now we do the actual globbing, adding filenames as we go to buffer in * filenamesObj */ if (*tail == '\0' && pathPrefix != NULL) { /* * An empty pattern. This means 'pathPrefix' is actually a full path * of a file/directory we want to simply check for existence and type. */ if (types == NULL) { /* * We just want to check for existence. In this case we make it * easy on Tcl_FSMatchInDirectory and its sub-implementations by * not bothering them (even though they should support this * situation) and we just use the simple existence check with * Tcl_FSAccess. */ if (Tcl_FSAccess(pathPrefix, F_OK) == 0) { Tcl_ListObjAppendElement(interp, filenamesObj, pathPrefix); } result = TCL_OK; } else { /* * We want to check for the correct type. Tcl_FSMatchInDirectory * is documented to do this for us, if we give it a NULL pattern. */ result = Tcl_FSMatchInDirectory(interp, filenamesObj, pathPrefix, NULL, types); } } else { result = DoGlob(interp, filenamesObj, separators, pathPrefix, globFlags & TCL_GLOBMODE_DIR, tail, types); } /* * Check for errors... */ if (result != TCL_OK) { TclDecrRefCount(filenamesObj); TclDecrRefCount(savedResultObj); if (pathPrefix != NULL) { Tcl_DecrRefCount(pathPrefix); } return result; } /* * If we only want the tails, we must strip off the prefix now. It may * seem more efficient to pass the tails flag down into DoGlob, * Tcl_FSMatchInDirectory, but those functions are continually adjusting * the prefix as the various pieces of the pattern are assimilated, so * that would add a lot of complexity to the code. This way is a little * slower (when the -tails flag is given), but much simpler to code. * * We do it by rewriting the result list in-place. */ if (globFlags & TCL_GLOBMODE_TAILS) { int objc, i; Tcl_Obj **objv; int prefixLen; const char *pre; /* * If this length has never been set, set it here. */ if (pathPrefix == NULL) { Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL"); } pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen); if (prefixLen > 0 && (strchr(separators, pre[prefixLen-1]) == NULL)) { /* * If we're on Windows and the prefix is a volume relative one * like 'C:', then there won't be a path separator in between, so * no need to skip it here. */ if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2) || (pre[1] != ':')) { prefixLen++; } } TclListObjGetElements(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { int len; const char *oldStr = Tcl_GetStringFromObj(objv[i], &len); Tcl_Obj *elem; if (len == prefixLen) { if ((pattern[0] == '\0') || (strchr(separators, pattern[0]) == NULL)) { TclNewLiteralStringObj(elem, "."); } else { TclNewLiteralStringObj(elem, "/"); } } else { elem = Tcl_NewStringObj(oldStr+prefixLen, len-prefixLen); } Tcl_ListObjReplace(interp, filenamesObj, i, 1, 1, &elem); } } /* * Now we have a list of discovered filenames in filenamesObj and a list * of previously discovered (saved earlier from the interpreter result) in * savedResultObj. Merge them and put them back in the interpreter result. */ if (Tcl_IsShared(savedResultObj)) { TclDecrRefCount(savedResultObj); savedResultObj = Tcl_DuplicateObj(savedResultObj); Tcl_IncrRefCount(savedResultObj); } if (Tcl_ListObjAppendList(interp, savedResultObj, filenamesObj) != TCL_OK){ result = TCL_ERROR; } else { Tcl_SetObjResult(interp, savedResultObj); } TclDecrRefCount(savedResultObj); TclDecrRefCount(filenamesObj); if (pathPrefix != NULL) { Tcl_DecrRefCount(pathPrefix); } return result; } /* *---------------------------------------------------------------------- * * SkipToChar -- * * This function traverses a glob pattern looking for the next unquoted * occurrence of the specified character at the same braces nesting level. * * Results: * Updates stringPtr to point to the matching character, or to the end of * the string if nothing matched. The return value is 1 if a match was * found at the top level, otherwise it is 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int SkipToChar( char **stringPtr, /* Pointer string to check. */ int match) /* Character to find. */ { int quoted, level; char *p; quoted = 0; level = 0; for (p = *stringPtr; *p != '\0'; p++) { if (quoted) { quoted = 0; continue; } if ((level == 0) && (*p == match)) { *stringPtr = p; return 1; } if (*p == '{') { level++; } else if (*p == '}') { level--; } else if (*p == '\\') { quoted = 1; } } *stringPtr = p; return 0; } /* *---------------------------------------------------------------------- * * DoGlob -- * * This recursive procedure forms the heart of the globbing code. It * performs a depth-first traversal of the tree given by the path name to * be globbed and the pattern. The directory and remainder are assumed to * be native format paths. The prefix contained in 'pathPtr' is either a * directory or path from which to start the search (or NULL). If pathPtr * is NULL, then the pattern must not start with an absolute path * specification (that case should be handled by moving the absolute path * prefix into pathPtr before calling DoGlob). * * Results: * The return value is a standard Tcl result indicating whether an error * occurred in globbing. After a normal return the result in interp will * be set to hold all of the file names given by the dir and remaining * arguments. After an error the result in interp will hold an error * message. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int DoGlob( Tcl_Interp *interp, /* Interpreter to use for error reporting * (e.g. unmatched brace). */ Tcl_Obj *matchesObj, /* Unshared list object in which to place all * resulting filenames. Caller allocates and * deallocates; DoGlob must not touch the * refCount of this object. */ const char *separators, /* String containing separator characters that * should be used to identify globbing * boundaries. */ Tcl_Obj *pathPtr, /* Completely expanded prefix. */ int flags, /* If non-zero then pathPtr is a directory */ char *pattern, /* The pattern to match against. Must not be a * pointer to a static string. */ Tcl_GlobTypeData *types) /* List object containing list of acceptable * types. May be NULL. */ { int baseLength, quoted; int result = TCL_OK; char *name, *p, *openBrace, *closeBrace, *firstSpecialChar; Tcl_Obj *joinedPtr; /* * Consume any leading directory separators, leaving pattern pointing just * past the last initial separator. */ name = pattern; for (; *pattern != '\0'; pattern++) { if (*pattern == '\\') { /* * If the first character is escaped, either we have a directory * separator, or we have any other character. In the latter case * the rest is a pattern, and we must break from the loop. This * is particularly important on Windows where '\' is both the * escaping character and a directory separator. */ if (strchr(separators, pattern[1]) != NULL) { pattern++; } else { break; } } else if (strchr(separators, *pattern) == NULL) { break; } } /* * Look for the first matching pair of braces or the first directory * separator that is not inside a pair of braces. */ openBrace = closeBrace = NULL; quoted = 0; for (p = pattern; *p != '\0'; p++) { if (quoted) { quoted = 0; } else if (*p == '\\') { quoted = 1; if (strchr(separators, p[1]) != NULL) { /* * Quoted directory separator. */ break; } } else if (strchr(separators, *p) != NULL) { /* * Unquoted directory separator. */ break; } else if (*p == '{') { openBrace = p; p++; if (SkipToChar(&p, '}')) { /* * Balanced braces. */ closeBrace = p; break; } Tcl_SetObjResult(interp, Tcl_NewStringObj( "unmatched open-brace in file name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", NULL); return TCL_ERROR; } else if (*p == '}') { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unmatched close-brace in file name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", NULL); return TCL_ERROR; } } /* * Substitute the alternate patterns from the braces and recurse. */ if (openBrace != NULL) { char *element; Tcl_DString newName; Tcl_DStringInit(&newName); /* * For each element within in the outermost pair of braces, append the * element and the remainder to the fixed portion before the first * brace and recursively call DoGlob. */ Tcl_DStringAppend(&newName, pattern, openBrace-pattern); baseLength = Tcl_DStringLength(&newName); *closeBrace = '\0'; for (p = openBrace; p != closeBrace; ) { p++; element = p; SkipToChar(&p, ','); Tcl_DStringSetLength(&newName, baseLength); Tcl_DStringAppend(&newName, element, p-element); Tcl_DStringAppend(&newName, closeBrace+1, -1); result = DoGlob(interp, matchesObj, separators, pathPtr, flags, Tcl_DStringValue(&newName), types); if (result != TCL_OK) { break; } } *closeBrace = '}'; Tcl_DStringFree(&newName); return result; } /* * At this point, there are no more brace substitutions to perform on this * path component. The variable p is pointing at a quoted or unquoted * directory separator or the end of the string. So we need to check for * special globbing characters in the current pattern. We avoid modifying * pattern if p is pointing at the end of the string. * * If we find any globbing characters, then we must call * Tcl_FSMatchInDirectory. If we're at the end of the string, then that's * all we need to do. If we're not at the end of the string, then we must * recurse, so we do that below. * * Alternatively, if there are no globbing characters then again there are * two cases. If we're at the end of the string, we just need to check for * the given path's existence and type. If we're not at the end of the * string, we recurse. */ if (*p != '\0') { char savedChar = *p; /* * Note that we are modifying the string in place. This won't work if * the string is a static. */ *p = '\0'; firstSpecialChar = strpbrk(pattern, "*[]?\\"); *p = savedChar; } else { firstSpecialChar = strpbrk(pattern, "*[]?\\"); } if (firstSpecialChar != NULL) { /* * Look for matching files in the given directory. The implementation * of this function is filesystem specific. For each file that * matches, it will add the match onto the resultPtr given. */ static Tcl_GlobTypeData dirOnly = { TCL_GLOB_TYPE_DIR, 0, NULL, NULL }; char save = *p; Tcl_Obj *subdirsPtr; if (*p == '\0') { return Tcl_FSMatchInDirectory(interp, matchesObj, pathPtr, pattern, types); } /* * We do the recursion ourselves. This makes implementing * Tcl_FSMatchInDirectory for each filesystem much easier. */ *p = '\0'; TclNewObj(subdirsPtr); Tcl_IncrRefCount(subdirsPtr); result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr, pattern, &dirOnly); *p = save; if (result == TCL_OK) { int subdirc, i, repair = -1; Tcl_Obj **subdirv; result = TclListObjGetElements(interp, subdirsPtr, &subdirc, &subdirv); for (i=0; result==TCL_OK && i 0) && (strchr(separators, joined[len-1]) == NULL)) { Tcl_AppendToObj(joinedPtr, "/", 1); } } Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append), Tcl_DStringLength(&append)); } Tcl_IncrRefCount(joinedPtr); Tcl_DStringFree(&append); result = Tcl_FSMatchInDirectory(interp, matchesObj, joinedPtr, NULL, types); Tcl_DecrRefCount(joinedPtr); return result; } /* * If it's not the end of the string, we must recurse */ if (pathPtr == NULL) { joinedPtr = Tcl_NewStringObj(pattern, p-pattern); } else if (flags) { joinedPtr = TclNewFSPathObj(pathPtr, pattern, p-pattern); } else { joinedPtr = Tcl_DuplicateObj(pathPtr); if (strchr(separators, pattern[0]) == NULL) { /* * The current prefix must end in a separator, unless this is a * volume-relative path. In particular globbing in Windows shares, * when not using -dir or -path, e.g. 'glob [file join * //machine/share/subdir *]' requires adding a separator here. * This behaviour is not currently tested for in the test suite. */ int len; const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) { Tcl_AppendToObj(joinedPtr, "/", 1); } } } Tcl_AppendToObj(joinedPtr, pattern, p-pattern); } Tcl_IncrRefCount(joinedPtr); result = DoGlob(interp, matchesObj, separators, joinedPtr, 1, p, types); Tcl_DecrRefCount(joinedPtr); return result; } /* *--------------------------------------------------------------------------- * * Tcl_AllocStatBuf -- * * This procedure allocates a Tcl_StatBuf on the heap. It exists so that * extensions may be used unchanged on systems where largefile support is * optional. * * Results: * A pointer to a Tcl_StatBuf which may be deallocated by being passed to * ckfree(). * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_StatBuf * Tcl_AllocStatBuf(void) { return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf)); } /* *--------------------------------------------------------------------------- * * Access functions for Tcl_StatBuf -- * * These functions provide portable read-only access to the portable * fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct * stat64' or something else related). [TIP #316] * * Results: * The value from the field being retrieved. * * Side effects: * None. * *--------------------------------------------------------------------------- */ unsigned Tcl_GetFSDeviceFromStat( const Tcl_StatBuf *statPtr) { return (unsigned) statPtr->st_dev; } unsigned Tcl_GetFSInodeFromStat( const Tcl_StatBuf *statPtr) { return (unsigned) statPtr->st_ino; } unsigned Tcl_GetModeFromStat( const Tcl_StatBuf *statPtr) { return (unsigned) statPtr->st_mode; } int Tcl_GetLinkCountFromStat( const Tcl_StatBuf *statPtr) { return (int)statPtr->st_nlink; } int Tcl_GetUserIdFromStat( const Tcl_StatBuf *statPtr) { return (int) statPtr->st_uid; } int Tcl_GetGroupIdFromStat( const Tcl_StatBuf *statPtr) { return (int) statPtr->st_gid; } int Tcl_GetDeviceTypeFromStat( const Tcl_StatBuf *statPtr) { return (int) statPtr->st_rdev; } Tcl_WideInt Tcl_GetAccessTimeFromStat( const Tcl_StatBuf *statPtr) { return (Tcl_WideInt) statPtr->st_atime; } Tcl_WideInt Tcl_GetModificationTimeFromStat( const Tcl_StatBuf *statPtr) { return (Tcl_WideInt) statPtr->st_mtime; } Tcl_WideInt Tcl_GetChangeTimeFromStat( const Tcl_StatBuf *statPtr) { return (Tcl_WideInt) statPtr->st_ctime; } Tcl_WideUInt Tcl_GetSizeFromStat( const Tcl_StatBuf *statPtr) { return (Tcl_WideUInt) statPtr->st_size; } Tcl_WideUInt Tcl_GetBlocksFromStat( const Tcl_StatBuf *statPtr) { #ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (Tcl_WideUInt) statPtr->st_blocks; #else unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize; #endif } unsigned Tcl_GetBlockSizeFromStat( const Tcl_StatBuf *statPtr) { #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE return (unsigned) statPtr->st_blksize; #else /* * Not a great guess, but will do... */ return GUESSED_BLOCK_SIZE; #endif } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclFileSystem.h0000644000175000017500000000463214554262142016223 0ustar sergeisergei/* * tclFileSystem.h -- * * This file contains the common definitions and prototypes for use by * Tcl's filesystem and path handling layers. * * Copyright (c) 2003 Vince Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLFILESYSTEM #define _TCLFILESYSTEM #include "tcl.h" /* * The internal TclFS API provides routines for handling and manipulating * paths efficiently, taking direct advantage of the "path" Tcl_Obj type. * * These functions are not exported at all at present. */ MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr); MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt); MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr); MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr); MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr, ClientData clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, Tcl_Obj *pathPtr); MODULE_SCOPE size_t TclFSEpoch(void); /* * Private shared variables for use by tclIOUtil.c and tclPathObj.c */ MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem; /* * Private shared functions for use by tclIOUtil.c, tclPathObj.c and * tclFileName.c, and any platform-specific filesystem code. */ MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr, const Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr); MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr, int pathLen, const Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef); MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr, const Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef); MODULE_SCOPE int TclFSEpochOk(size_t filesystemEpoch); MODULE_SCOPE int TclFSCwdIsNative(void); MODULE_SCOPE Tcl_Obj * TclWinVolumeRelativeNormalize(Tcl_Interp *interp, const char *path, Tcl_Obj **useThisCwdPtr); MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem; MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep; #endif /* _TCLFILESYSTEM */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclGet.c0000644000175000017500000000772514554262142014657 0ustar sergeisergei/* * tclGet.c -- * * This file contains functions to convert strings into other forms, like * integers or floating-point numbers or booleans, doing syntax checking * along the way. * * Copyright (c) 1990-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* *---------------------------------------------------------------------- * * Tcl_GetInt -- * * Given a string, produce the corresponding integer value. * * Results: * The return value is normally TCL_OK; in this case *intPtr will be set * to the integer value equivalent to src. If src is improperly formed * then TCL_ERROR is returned and an error message will be left in the * interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetInt( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ const char *src, /* String containing a (possibly signed) * integer in a form acceptable to * Tcl_GetIntFromObj(). */ int *intPtr) /* Place to store converted result. */ { Tcl_Obj obj; int code; obj.refCount = 1; obj.bytes = (char *) src; obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_GetIntFromObj(interp, &obj, intPtr); if (obj.refCount > 1) { Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } TclFreeIntRep(&obj); return code; } /* *---------------------------------------------------------------------- * * Tcl_GetDouble -- * * Given a string, produce the corresponding double-precision * floating-point value. * * Results: * The return value is normally TCL_OK; in this case *doublePtr will be * set to the double-precision value equivalent to src. If src is * improperly formed then TCL_ERROR is returned and an error message will * be left in the interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetDouble( Tcl_Interp *interp, /* Interpreter used for error reporting. */ const char *src, /* String containing a floating-point number * in a form acceptable to * Tcl_GetDoubleFromObj(). */ double *doublePtr) /* Place to store converted result. */ { Tcl_Obj obj; int code; obj.refCount = 1; obj.bytes = (char *) src; obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr); if (obj.refCount > 1) { Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } TclFreeIntRep(&obj); return code; } /* *---------------------------------------------------------------------- * * Tcl_GetBoolean -- * * Given a string, return a 0/1 boolean value corresponding to the * string. * * Results: * The return value is normally TCL_OK; in this case *intPtr will be set * to the 0/1 value equivalent to src. If src is improperly formed then * TCL_ERROR is returned and an error message will be left in the * interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetBoolean( Tcl_Interp *interp, /* Interpreter used for error reporting. */ const char *src, /* String containing one of the boolean values * 1, 0, true, false, yes, no, on, off. */ int *intPtr) /* Place to store converted result, which will * be 0 or 1. */ { Tcl_Obj obj; int code; obj.refCount = 1; obj.bytes = (char *) src; obj.length = strlen(src); obj.typePtr = NULL; code = TclSetBooleanFromAny(interp, &obj); if (obj.refCount > 1) { Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { *intPtr = obj.internalRep.longValue; } return code; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tcl.h0000644000175000017500000026730414554262142014225 0ustar sergeisergei/* * tcl.h -- * * This header file describes the externally-visible facilities of the * Tcl interpreter. * * Copyright (c) 1987-1994 The Regents of the University of California. * Copyright (c) 1993-1996 Lucent Technologies. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * Copyright (c) 2002 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCL #define _TCL /* * For C++ compilers, use extern "C" */ #ifdef __cplusplus extern "C" { #endif /* * The following defines are used to indicate the various release levels. */ #define TCL_ALPHA_RELEASE 0 #define TCL_BETA_RELEASE 1 #define TCL_FINAL_RELEASE 2 /* * When version numbers change here, must also go into the following files and * update the version numbers: * * library/init.tcl (1 LOC patch) * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.in (as above) * win/tcl.m4 (not patchlevel) * README.md (sections 0 and 2, with and without separator) * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) * tools/tcl.hpj.in (not patchlevel, for windows installer) */ #if !defined(TCL_MAJOR_VERSION) # define TCL_MAJOR_VERSION 8 #endif #if TCL_MAJOR_VERSION != 8 # error "This header-file is for Tcl 8 only" #endif #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE #define TCL_RELEASE_SERIAL 14 #define TCL_VERSION "8.6" #define TCL_PATCH_LEVEL "8.6.14" /* *---------------------------------------------------------------------------- * The following definitions set up the proper options for Windows compilers. * We use this method because there is no autoconf equivalent. */ #ifdef _WIN32 # ifndef __WIN32__ # define __WIN32__ # endif # ifndef WIN32 # define WIN32 # endif #endif /* * Utility macros: STRINGIFY takes an argument and wraps it in "" (double * quotation marks), JOIN joins two arguments. */ #ifndef STRINGIFY # define STRINGIFY(x) STRINGIFY1(x) # define STRINGIFY1(x) #x #endif #ifndef JOIN # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #endif /* * A special definition used to allow this header file to be included from * windows resource files so that they can obtain version information. * RC_INVOKED is defined by default by the windows RC tool. * * Resource compilers don't like all the C stuff, like typedefs and function * declarations, that occur below, so block them out. */ #ifndef RC_INVOKED /* * Special macro to define mutexes, that doesn't do anything if we are not * using threads. */ #ifdef TCL_THREADS #define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name; #else #define TCL_DECLARE_MUTEX(name) #endif /* * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and * SEEK_END, all #define'd by stdio.h . * * Also, many extensions need stdio.h, and they've grown accustomed to tcl.h * providing it for them rather than #include-ing it themselves as they * should, so also for their sake, we keep the #include to be consistent with * prior Tcl releases. */ #include /* *---------------------------------------------------------------------------- * Support for functions with a variable number of arguments. * * The following TCL_VARARGS* macros are to support old extensions * written for older versions of Tcl where the macros permitted * support for the varargs.h system as well as stdarg.h . * * New code should just directly be written to use stdarg.h conventions. */ #include #if !defined(TCL_NO_DEPRECATED) # define TCL_VARARGS(type, name) (type name, ...) # define TCL_VARARGS_DEF(type, name) (type name, ...) # define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) #endif /* !TCL_NO_DEPRECATED */ #if defined(__GNUC__) && (__GNUC__ > 2) # if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b))) # else # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # endif # define TCL_NORETURN __attribute__ ((noreturn)) # if defined(BUILD_tcl) || defined(BUILD_tk) # define TCL_NORETURN1 __attribute__ ((noreturn)) # else # define TCL_NORETURN1 /* nothing */ # endif #else # define TCL_FORMAT_PRINTF(a,b) # if defined(_MSC_VER) && (_MSC_VER >= 1310) # define TCL_NORETURN _declspec(noreturn) # else # define TCL_NORETURN /* nothing */ # endif # define TCL_NORETURN1 /* nothing */ #endif /* * Allow a part of Tcl's API to be explicitly marked as deprecated. * * Used to make TIP 330/336 generate moans even if people use the * compatibility macros. Change your code, guys! We won't support you forever. */ #if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1))) # if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ >= 5)) # define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__ (msg))) # else # define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__)) # endif #else # define TCL_DEPRECATED_API(msg) /* nothing portable */ #endif /* *---------------------------------------------------------------------------- * Macros used to declare a function to be exported by a DLL. Used by Windows, * maps to no-op declarations on non-Windows systems. The default build on * windows is for a DLL, which causes the DLLIMPORT and DLLEXPORT macros to be * nonempty. To build a static library, the macro STATIC_BUILD should be * defined. * * Note: when building static but linking dynamically to MSVCRT we must still * correctly decorate the C library imported function. Use CRTIMPORT * for this purpose. _DLL is defined by the compiler when linking to * MSVCRT. */ #if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec)))) # define HAVE_DECLSPEC 1 # ifdef STATIC_BUILD # define DLLIMPORT # define DLLEXPORT # ifdef _DLL # define CRTIMPORT __declspec(dllimport) # else # define CRTIMPORT # endif # else # define DLLIMPORT __declspec(dllimport) # define DLLEXPORT __declspec(dllexport) # define CRTIMPORT __declspec(dllimport) # endif #else # define DLLIMPORT # if defined(__GNUC__) && __GNUC__ > 3 # define DLLEXPORT __attribute__ ((visibility("default"))) # else # define DLLEXPORT # endif # define CRTIMPORT #endif /* * These macros are used to control whether functions are being declared for * import or export. If a function is being declared while it is being built * to be included in a shared library, then it should have the DLLEXPORT * storage class. If is being declared for use by a module that is going to * link against the shared library, then it should have the DLLIMPORT storage * class. If the symbol is being declared for a static build or for use from a * stub library, then the storage class should be empty. * * The convention is that a macro called BUILD_xxxx, where xxxx is the name of * a library we are building, is set on the compile line for sources that are * to be placed in the library. When this macro is set, the storage class will * be set to DLLEXPORT. At the end of the header file, the storage class will * be reset to DLLIMPORT. */ #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* * The following _ANSI_ARGS_ macro is to support old extensions * written for older versions of Tcl where it permitted support * for compilers written in the pre-prototype era of C. * * New code should use prototypes. */ #ifndef TCL_NO_DEPRECATED # undef _ANSI_ARGS_ # define _ANSI_ARGS_(x) x #endif /* * Definitions that allow this header file to be used either with or without * ANSI C features. */ #ifndef INLINE # define INLINE #endif #ifdef NO_CONST # ifndef const # define const # endif #endif #ifndef CONST # define CONST const #endif #ifdef USE_NON_CONST # ifdef USE_COMPAT_CONST # error define at most one of USE_NON_CONST and USE_COMPAT_CONST # endif # define CONST84 # define CONST84_RETURN #else # ifdef USE_COMPAT_CONST # define CONST84 # define CONST84_RETURN const # else # define CONST84 const # define CONST84_RETURN const # endif #endif #ifndef CONST86 # define CONST86 CONST84 #endif /* * Make sure EXTERN isn't defined elsewhere. */ #ifdef EXTERN # undef EXTERN #endif /* EXTERN */ #ifdef __cplusplus # define EXTERN extern "C" TCL_STORAGE_CLASS #else # define EXTERN extern TCL_STORAGE_CLASS #endif /* *---------------------------------------------------------------------------- * The following code is copied from winnt.h. If we don't replicate it here, * then can't be included after tcl.h, since tcl.h also defines * VOID. This block is skipped under Cygwin and Mingw. */ #if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) #ifndef VOID #define VOID void typedef char CHAR; typedef short SHORT; typedef long LONG; #endif #endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */ /* * Macro to use instead of "void" for arguments that must have type "void *" * in ANSI C; maps them to type "char *" in non-ANSI systems. */ #ifndef __VXWORKS__ # ifndef NO_VOID # define VOID void # else # define VOID char # endif #endif /* * Miscellaneous declarations. */ #ifndef _CLIENTDATA # ifndef NO_VOID typedef void *ClientData; # else typedef int *ClientData; # endif # define _CLIENTDATA #endif /* * Darwin specific configure overrides (to support fat compiles, where * configure runs only once for multiple architectures): */ #ifdef __APPLE__ # ifdef __LP64__ # undef TCL_WIDE_INT_TYPE # define TCL_WIDE_INT_IS_LONG 1 # define TCL_CFG_DO64BIT 1 # else /* !__LP64__ */ # define TCL_WIDE_INT_TYPE long long # undef TCL_WIDE_INT_IS_LONG # undef TCL_CFG_DO64BIT # endif /* __LP64__ */ # undef HAVE_STRUCT_STAT64 #endif /* __APPLE__ */ /* Cross-compiling 32-bit on a 64-bit platform? Then our * configure script does the wrong thing. Correct that here. */ #if defined(__GNUC__) && !defined(_WIN32) && !defined(__LP64__) # undef TCL_WIDE_INT_IS_LONG # undef TCL_WIDE_INT_TYPE # define TCL_WIDE_INT_TYPE long long #endif /* * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, and define * Tcl_WideUInt to be the unsigned variant of that type (assuming that where * we have one, we can have the other.) * * Also defines the following macros: * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a * LP64 system such as modern Solaris or Linux ... not including Win64) * Tcl_WideAsLong - forgetful converter from wideInt to long. * Tcl_LongAsWide - sign-extending converter from long to wideInt. * Tcl_WideAsDouble - converter from wideInt to double. * Tcl_DoubleAsWide - converter from double to wideInt. * * The following invariant should hold for any long value 'longVal': * longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal)) * * Note on converting between Tcl_WideInt and strings. This implementation (in * tclObj.c) depends on the function * snprintf(...,"%" TCL_LL_MODIFIER "d",...). */ #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) # ifdef _WIN32 # define TCL_WIDE_INT_TYPE __int64 # ifdef __BORLANDC__ # define TCL_LL_MODIFIER "L" # elif defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO) # define TCL_LL_MODIFIER "I64" # else # define TCL_LL_MODIFIER "ll" # endif # elif defined(__GNUC__) # define TCL_WIDE_INT_TYPE long long # define TCL_LL_MODIFIER "ll" # else /* ! _WIN32 && ! __GNUC__ */ /* * Don't know what platform it is and configure hasn't discovered what is * going on for us. Try to guess... */ # include # if (INT_MAX < LONG_MAX) # define TCL_WIDE_INT_IS_LONG 1 # else # define TCL_WIDE_INT_TYPE long long # endif # endif /* _WIN32 */ #endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */ #ifdef TCL_WIDE_INT_IS_LONG # undef TCL_WIDE_INT_TYPE # define TCL_WIDE_INT_TYPE long #endif /* TCL_WIDE_INT_IS_LONG */ typedef TCL_WIDE_INT_TYPE Tcl_WideInt; typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; #ifdef TCL_WIDE_INT_IS_LONG # define Tcl_WideAsLong(val) ((long)(val)) # define Tcl_LongAsWide(val) ((long)(val)) # define Tcl_WideAsDouble(val) ((double)((long)(val))) # define Tcl_DoubleAsWide(val) ((long)((double)(val))) # ifndef TCL_LL_MODIFIER # define TCL_LL_MODIFIER "l" # endif /* !TCL_LL_MODIFIER */ #else /* TCL_WIDE_INT_IS_LONG */ /* * The next short section of defines are only done when not running on Windows * or some other strange platform. */ # ifndef TCL_LL_MODIFIER # define TCL_LL_MODIFIER "ll" # endif /* !TCL_LL_MODIFIER */ # define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) # define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) # define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) # define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #endif /* TCL_WIDE_INT_IS_LONG */ #ifdef _WIN32 # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; # elif defined(_WIN64) || defined(_USE_64BIT_TIME_T) typedef struct __stat64 Tcl_StatBuf; # elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T) typedef struct _stati64 Tcl_StatBuf; # else typedef struct _stat32i64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ #elif defined(__CYGWIN__) typedef struct { unsigned st_dev; unsigned short st_ino; unsigned short st_mode; short st_nlink; short st_uid; short st_gid; /* Here is a 2-byte gap */ unsigned st_rdev; /* Here is a 4-byte gap */ long long st_size; struct {long tv_sec;} st_atim; struct {long tv_sec;} st_mtim; struct {long tv_sec;} st_ctim; } Tcl_StatBuf; #elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) typedef struct stat64 Tcl_StatBuf; #else typedef struct stat Tcl_StatBuf; #endif /* *---------------------------------------------------------------------------- * Data structures defined opaquely in this module. The definitions below just * provide dummy types. A few fields are made visible in Tcl_Interp * structures, namely those used for returning a string result from commands. * Direct access to the result field is discouraged in Tcl 8.0. The * interpreter result is either an object or a string, and the two values are * kept consistent unless some C code sets interp->result directly. * Programmers should use either the function Tcl_GetObjResult() or * Tcl_GetStringResult() to read the interpreter's result. See the SetResult * man page for details. * * Note: any change to the Tcl_Interp definition below must be mirrored in the * "real" definition in tclInt.h. * * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc. * Instead, they set a Tcl_Obj member in the "real" structure that can be * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ typedef struct Tcl_Interp #if !defined(TCL_NO_DEPRECATED) { /* TIP #330: Strongly discourage extensions from using the string * result. */ #ifdef USE_INTERP_RESULT char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult"); /* If the last command returned a string * result, this points to it. */ void (*freeProc) (char *blockPtr) TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult"); /* Zero means the string result is statically * allocated. TCL_DYNAMIC means it was * allocated with ckalloc and should be freed * with ckfree. Other values give the address * of function to invoke to free the result. * Tcl_Eval must free it before executing next * command. */ #else char *resultDontUse; /* Don't use in extensions! */ void (*freeProcDontUse) (char *); /* Don't use in extensions! */ #endif #ifdef USE_INTERP_ERRORLINE int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine"); /* When TCL_ERROR is returned, this gives the * line number within the command where the * error occurred (1 if first line). */ #else int errorLineDontUse; /* Don't use in extensions! */ #endif } #endif /* !TCL_NO_DEPRECATED */ Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion; typedef struct Tcl_Command_ *Tcl_Command; typedef struct Tcl_Condition_ *Tcl_Condition; typedef struct Tcl_Dict_ *Tcl_Dict; typedef struct Tcl_EncodingState_ *Tcl_EncodingState; typedef struct Tcl_Encoding_ *Tcl_Encoding; typedef struct Tcl_Event Tcl_Event; typedef struct Tcl_InterpState_ *Tcl_InterpState; typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle; typedef struct Tcl_Mutex_ *Tcl_Mutex; typedef struct Tcl_Pid_ *Tcl_Pid; typedef struct Tcl_RegExp_ *Tcl_RegExp; typedef struct Tcl_ThreadDataKey_ *Tcl_ThreadDataKey; typedef struct Tcl_ThreadId_ *Tcl_ThreadId; typedef struct Tcl_TimerToken_ *Tcl_TimerToken; typedef struct Tcl_Trace_ *Tcl_Trace; typedef struct Tcl_Var_ *Tcl_Var; typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream; /* *---------------------------------------------------------------------------- * Definition of the interface to functions implementing threads. A function * following this definition is given to each call of 'Tcl_CreateThread' and * will be called as the main fuction of the new thread created by that call. */ #if defined _WIN32 typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData); #else typedef void (Tcl_ThreadCreateProc) (ClientData clientData); #endif /* * Threading function return types used for abstracting away platform * differences when writing a Tcl_ThreadCreateProc. See the NewThread function * in generic/tclThreadTest.c for it's usage. */ #if defined _WIN32 # define Tcl_ThreadCreateType unsigned __stdcall # define TCL_THREAD_CREATE_RETURN return 0 #else # define Tcl_ThreadCreateType void # define TCL_THREAD_CREATE_RETURN #endif /* * Definition of values for default stacksize and the possible flags to be * given to Tcl_CreateThread. */ #define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack. */ #define TCL_THREAD_NOFLAGS (0000) /* Standard flags, default * behaviour. */ #define TCL_THREAD_JOINABLE (0001) /* Mark the thread as joinable. */ /* * Flag values passed to Tcl_StringCaseMatch. */ #define TCL_MATCH_NOCASE (1<<0) /* * Flag values passed to Tcl_GetRegExpFromObj. */ #define TCL_REG_BASIC 000000 /* BREs (convenience). */ #define TCL_REG_EXTENDED 000001 /* EREs. */ #define TCL_REG_ADVF 000002 /* Advanced features in EREs. */ #define TCL_REG_ADVANCED 000003 /* AREs (which are also EREs). */ #define TCL_REG_QUOTE 000004 /* No special characters, none. */ #define TCL_REG_NOCASE 000010 /* Ignore case. */ #define TCL_REG_NOSUB 000020 /* Don't care about subexpressions. */ #define TCL_REG_EXPANDED 000040 /* Expanded format, white space & * comments. */ #define TCL_REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */ #define TCL_REG_NLANCH 000200 /* ^ matches after \n, $ before. */ #define TCL_REG_NEWLINE 000300 /* Newlines are line terminators. */ #define TCL_REG_CANMATCH 001000 /* Report details on partial/limited * matches. */ /* * Flags values passed to Tcl_RegExpExecObj. */ #define TCL_REG_NOTBOL 0001 /* Beginning of string does not match ^. */ #define TCL_REG_NOTEOL 0002 /* End of string does not match $. */ /* * Structures filled in by Tcl_RegExpInfo. Note that all offset values are * relative to the start of the match string, not the beginning of the entire * string. */ typedef struct Tcl_RegExpIndices { long start; /* Character offset of first character in * match. */ long end; /* Character offset of first character after * the match. */ } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { int nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ long extendStart; /* The offset at which a subsequent match * might begin. */ long reserved; /* Reserved for later use. */ } Tcl_RegExpInfo; /* * Picky compilers complain if this typdef doesn't appear before the struct's * reference in tclDecls.h. */ typedef Tcl_StatBuf *Tcl_Stat_; typedef struct stat *Tcl_OldStat_; /* *---------------------------------------------------------------------------- * When a TCL command returns, the interpreter contains a result from the * command. Programmers are strongly encouraged to use one of the functions * Tcl_GetObjResult() or Tcl_GetStringResult() to read the interpreter's * result. See the SetResult man page for details. Besides this result, the * command function returns an integer code, which is one of the following: * * TCL_OK Command completed normally; the interpreter's result * contains the command's result. * TCL_ERROR The command couldn't be completed successfully; the * interpreter's result describes what went wrong. * TCL_RETURN The command requests that the current function return; * the interpreter's result contains the function's * return value. * TCL_BREAK The command requests that the innermost loop be * exited; the interpreter's result is meaningless. * TCL_CONTINUE Go on to the next iteration of the current loop; the * interpreter's result is meaningless. */ #define TCL_OK 0 #define TCL_ERROR 1 #define TCL_RETURN 2 #define TCL_BREAK 3 #define TCL_CONTINUE 4 #define TCL_RESULT_SIZE 200 /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): */ #define TCL_SUBST_COMMANDS 001 #define TCL_SUBST_VARIABLES 002 #define TCL_SUBST_BACKSLASHES 004 #define TCL_SUBST_ALL 007 /* * Argument descriptors for math function callbacks in expressions: */ typedef enum { TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT } Tcl_ValueType; typedef struct Tcl_Value { Tcl_ValueType type; /* Indicates intValue or doubleValue is valid, * or both. */ long intValue; /* Integer value. */ double doubleValue; /* Double-precision floating value. */ Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ } Tcl_Value; /* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ struct Tcl_Obj; /* *---------------------------------------------------------------------------- * Function types defined by Tcl: */ typedef int (Tcl_AppInitProc) (Tcl_Interp *interp); typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp, int code); typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); typedef void (Tcl_CloseProc) (ClientData data); typedef void (Tcl_CmdDeleteProc) (ClientData clientData); typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[]); typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, ClientData cmdClientData, int argc, CONST84 char *argv[]); typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); typedef void (Tcl_EncodingFreeProc) (ClientData clientData); typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags); typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData); typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags); typedef void (Tcl_ExitProc) (ClientData clientData); typedef void (Tcl_FileProc) (ClientData clientData, int mask); typedef void (Tcl_FileFreeProc) (ClientData clientData); typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); typedef void (Tcl_FreeProc) (char *blockPtr); typedef void (Tcl_IdleProc) (ClientData clientData); typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp); typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (ClientData clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2, int flags); typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); typedef void (Tcl_DeleteFileHandlerProc) (int fd); typedef void (Tcl_AlertNotifierProc) (ClientData clientData); typedef void (Tcl_ServiceModeHookProc) (int mode); typedef ClientData (Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData); typedef void (Tcl_MainLoopProc) (void); /* *---------------------------------------------------------------------------- * The following structure represents a type of object, which is a particular * internal representation for an object plus a set of functions that provide * standard operations on objects of that type. */ typedef struct Tcl_ObjType { const char *name; /* Name of the type, e.g. "int". */ Tcl_FreeInternalRepProc *freeIntRepProc; /* Called to free any storage for the type's * internal rep. NULL if the internal rep does * not need freeing. */ Tcl_DupInternalRepProc *dupIntRepProc; /* Called to create a new object as a copy of * an existing object. */ Tcl_UpdateStringProc *updateStringProc; /* Called to update the string rep from the * type's internal representation. */ Tcl_SetFromAnyProc *setFromAnyProc; /* Called to convert the object's internal rep * to this type. Frees the internal rep of the * old type. Returns TCL_ERROR on failure. */ } Tcl_ObjType; /* * One of the following structures exists for each object in the Tcl system. * An object stores a value as either a string, some internal representation, * or both. */ typedef struct Tcl_Obj { int refCount; /* When 0 the object will be freed. */ char *bytes; /* This points to the first byte of the * object's string representation. The array * must be followed by a null byte (i.e., at * offset length) but may also contain * embedded null characters. The array's * storage is allocated by ckalloc. NULL means * the string rep is invalid and must be * regenerated from the internal rep. Clients * should use Tcl_GetStringFromObj or * Tcl_GetString to get a pointer to the byte * array as a readonly value. */ int length; /* The number of bytes at *bytes, not * including the terminating null. */ const Tcl_ObjType *typePtr; /* Denotes the object's type. Always * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ union { /* The internal representation: */ long longValue; /* - an long integer value. */ double doubleValue; /* - a double-precision floating value. */ void *otherValuePtr; /* - another, type-specific value, not used internally any more. */ Tcl_WideInt wideValue; /* - a long long value. */ struct { /* - internal rep as two pointers. * the main use of which is a bignum's * tightly packed fields, where the alloc, * used and signum flags are packed into * ptr2 with everything else hung off ptr1. */ void *ptr1; void *ptr2; } twoPtrValue; struct { /* - internal rep as a pointer and a long, not used internally any more. */ void *ptr; unsigned long value; } ptrAndLongRep; } internalRep; } Tcl_Obj; /* * Macros to increment and decrement a Tcl_Obj's reference count, and to test * whether an object is shared (i.e. has reference count > 1). Note: clients * should use Tcl_DecrRefCount() when they are finished using an object, and * should never call TclFreeObj() directly. TclFreeObj() is only defined and * made public in tcl.h to support Tcl_DecrRefCount's macro definition. */ void Tcl_IncrRefCount(Tcl_Obj *objPtr); void Tcl_DecrRefCount(Tcl_Obj *objPtr); int Tcl_IsShared(Tcl_Obj *objPtr); /* *---------------------------------------------------------------------------- * The following structure contains the state needed by Tcl_SaveResult. No-one * outside of Tcl should access any of these fields. This structure is * typically allocated on the stack. */ typedef struct Tcl_SavedResult { char *result; Tcl_FreeProc *freeProc; Tcl_Obj *objResultPtr; char *appendResult; int appendAvl; int appendUsed; char resultSpace[TCL_RESULT_SIZE+1]; } Tcl_SavedResult; /* *---------------------------------------------------------------------------- * The following definitions support Tcl's namespace facility. Note: the first * five fields must match exactly the fields in a Namespace structure (see * tclInt.h). */ typedef struct Tcl_Namespace { char *name; /* The namespace's name within its parent * namespace. This contains no ::'s. The name * of the global namespace is "" although "::" * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ ClientData clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the * namespace to, e.g., free clientData. */ struct Tcl_Namespace *parentPtr; /* Points to the namespace that contains this * one. NULL if this is the global * namespace. */ } Tcl_Namespace; /* *---------------------------------------------------------------------------- * The following structure represents a call frame, or activation record. A * call frame defines a naming context for a procedure call: its local scope * (for local variables) and its namespace scope (used for non-local * variables; often the global :: namespace). A call frame can also define the * naming context for a namespace eval or namespace inscope command: the * namespace in which the command's code should execute. The Tcl_CallFrame * structures exist only while procedures or namespace eval/inscope's are * being executed, and provide a Tcl call stack. * * A call frame is initialized and pushed using Tcl_PushCallFrame and popped * using Tcl_PopCallFrame. Storage for a Tcl_CallFrame must be provided by the * Tcl_PushCallFrame caller, and callers typically allocate them on the C call * stack for efficiency. For this reason, Tcl_CallFrame is defined as a * structure and not as an opaque token. However, most Tcl_CallFrame fields * are hidden since applications should not access them directly; others are * declared as "dummyX". * * WARNING!! The structure definition must be kept consistent with the * CallFrame structure in tclInt.h. If you change one, change the other. */ typedef struct Tcl_CallFrame { Tcl_Namespace *nsPtr; int dummy1; int dummy2; void *dummy3; void *dummy4; void *dummy5; int dummy6; void *dummy7; void *dummy8; int dummy9; void *dummy10; void *dummy11; void *dummy12; void *dummy13; } Tcl_CallFrame; /* *---------------------------------------------------------------------------- * Information about commands that is returned by Tcl_GetCommandInfo and * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based command * function while proc is a traditional Tcl argc/argv string-based function. * Tcl_CreateObjCommand and Tcl_CreateCommand ensure that both objProc and * proc are non-NULL and can be called to execute the command. However, it may * be faster to call one instead of the other. The member isNativeObjectProc * is set to 1 if an object-based function was registered by * Tcl_CreateObjCommand, and to 0 if a string-based function was registered by * Tcl_CreateCommand. The other function is typically set to a compatibility * wrapper that does string-to-object or object-to-string argument conversions * then calls the other function. */ typedef struct Tcl_CmdInfo { int isNativeObjectProc; /* 1 if objProc was registered by a call to * Tcl_CreateObjCommand; 0 otherwise. * Tcl_SetCmdInfo does not modify this * field. */ Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ ClientData objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ ClientData clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ ClientData deleteData; /* Value to pass to deleteProc (usually the * same as clientData). */ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not * change a command's namespace; use * TclRenameCommand or Tcl_Eval (of 'rename') * to do that. */ } Tcl_CmdInfo; /* *---------------------------------------------------------------------------- * The structure defined below is used to hold dynamic strings. The only * fields that clients should use are string and length, accessible via the * macros Tcl_DStringValue and Tcl_DStringLength. */ #define TCL_DSTRING_STATIC_SIZE 200 typedef struct Tcl_DString { char *string; /* Points to beginning of string: either * staticSpace below or a malloced array. */ int length; /* Number of non-NULL characters in the * string. */ int spaceAvl; /* Total number of bytes available for the * string and its terminating NULL char. */ char staticSpace[TCL_DSTRING_STATIC_SIZE]; /* Space to use in common case where string is * small. */ } Tcl_DString; #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) #define Tcl_DStringTrunc Tcl_DStringSetLength /* * Definitions for the maximum number of digits of precision that may be * specified in the "tcl_precision" variable, and the number of bytes of * buffer space required by Tcl_PrintDouble. */ #define TCL_MAX_PREC 17 #define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10) /* * Definition for a number of bytes of buffer space sufficient to hold the * string representation of an integer in base 10 (assuming the existence of * 64-bit integers). */ #define TCL_INTEGER_SPACE 24 /* * Flag values passed to Tcl_ConvertElement. * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to * use backslash quoting instead. * TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It * is safe to leave the hash unquoted when the element is not the first * element of a list, and this flag can be used by the caller to indicate * that condition. */ #define TCL_DONT_USE_BRACES 1 #define TCL_DONT_QUOTE_HASH 8 /* * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow * abbreviated strings. */ #define TCL_EXACT 1 /* *---------------------------------------------------------------------------- * Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv. * WARNING: these bit choices must not conflict with the bit choices for * evalFlag bits in tclInt.h! * * Meanings: * TCL_NO_EVAL: Just record this command * TCL_EVAL_GLOBAL: Execute script in global namespace * TCL_EVAL_DIRECT: Do not compile this script * TCL_EVAL_INVOKE: Magical Tcl_EvalObjv mode for aliases/ensembles * o Run in iPtr->lookupNsPtr or global namespace * o Cut out of error traces * o Don't reset the flags controlling ensemble * error message rewriting. * TCL_CANCEL_UNWIND: Magical Tcl_CancelEval mode that causes the * stack for the script in progress to be * completely unwound. * TCL_EVAL_NOERR: Do no exception reporting at all, just return * as the caller will report. */ #define TCL_NO_EVAL 0x010000 #define TCL_EVAL_GLOBAL 0x020000 #define TCL_EVAL_DIRECT 0x040000 #define TCL_EVAL_INVOKE 0x080000 #define TCL_CANCEL_UNWIND 0x100000 #define TCL_EVAL_NOERR 0x200000 /* * Special freeProc values that may be passed to Tcl_SetResult (see the man * page for details): */ #define TCL_VOLATILE ((Tcl_FreeProc *) 1) #define TCL_STATIC ((Tcl_FreeProc *) 0) #define TCL_DYNAMIC ((Tcl_FreeProc *) 3) /* * Flag values passed to variable-related functions. * WARNING: these bit choices must not conflict with the bit choice for * TCL_CANCEL_UNWIND, above. */ #define TCL_GLOBAL_ONLY 1 #define TCL_NAMESPACE_ONLY 2 #define TCL_APPEND_VALUE 4 #define TCL_LIST_ELEMENT 8 #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 #define TCL_INTERP_DESTROYED 0x100 #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 #ifndef TCL_REMOVE_OBSOLETE_TRACES /* Required to support old variable/vdelete/vinfo traces. */ #define TCL_TRACE_OLD_STYLE 0x1000 #endif /* Indicate the semantics of the result of a trace. */ #define TCL_TRACE_RESULT_DYNAMIC 0x8000 #define TCL_TRACE_RESULT_OBJECT 0x10000 /* * Flag values for ensemble commands. */ #define TCL_ENSEMBLE_PREFIX 0x02/* Flag value to say whether to allow * unambiguous prefixes of commands or to * require exact matches for command names. */ /* * Flag values passed to command-related functions. */ #define TCL_TRACE_RENAME 0x2000 #define TCL_TRACE_DELETE 0x4000 #define TCL_ALLOW_INLINE_COMPILATION 0x20000 /* * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now * always parsed whenever the part2 is NULL. (This is to avoid a common error * when converting code to use the new object based APIs and forgetting to * give the flag) */ #if !defined(TCL_NO_DEPRECATED) # define TCL_PARSE_PART1 0x400 #endif /* !TCL_NO_DEPRECATED */ /* * Types for linked variables: */ #define TCL_LINK_INT 1 #define TCL_LINK_DOUBLE 2 #define TCL_LINK_BOOLEAN 3 #define TCL_LINK_STRING 4 #define TCL_LINK_WIDE_INT 5 #define TCL_LINK_CHAR 6 #define TCL_LINK_UCHAR 7 #define TCL_LINK_SHORT 8 #define TCL_LINK_USHORT 9 #define TCL_LINK_UINT 10 #define TCL_LINK_LONG 11 #define TCL_LINK_ULONG 12 #define TCL_LINK_FLOAT 13 #define TCL_LINK_WIDE_UINT 14 #define TCL_LINK_READ_ONLY 0x80 /* *---------------------------------------------------------------------------- * Forward declarations of Tcl_HashTable and related types. */ typedef struct Tcl_HashKeyType Tcl_HashKeyType; typedef struct Tcl_HashTable Tcl_HashTable; typedef struct Tcl_HashEntry Tcl_HashEntry; typedef unsigned (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr); typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr); typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr, void *keyPtr); typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr); /* * This flag controls whether the hash table stores the hash of a key, or * recalculates it. There should be no reason for turning this flag off as it * is completely binary and source compatible unless you directly access the * bucketPtr member of the Tcl_HashTableEntry structure. This member has been * removed and the space used to store the hash value. */ #ifndef TCL_HASH_KEY_STORE_HASH # define TCL_HASH_KEY_STORE_HASH 1 #endif /* * Structure definition for an entry in a hash table. No-one outside Tcl * should access any of these fields directly; use the macros defined below. */ struct Tcl_HashEntry { Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket, * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ #if TCL_HASH_KEY_STORE_HASH void *hash; /* Hash value, stored as pointer to ensure * that the offsets of the fields in this * structure are not changed. */ #else Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to first * entry in this entry's chain: used for * deleting the entry. */ #endif ClientData clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ Tcl_Obj *objPtr; /* Tcl_Obj * key value. */ int words[1]; /* Multiple integer words for key. The actual * size will be as large as necessary for this * table's keys. */ char string[1]; /* String for key. The actual size will be as * large as needed to hold the key. */ } key; /* MUST BE LAST FIELD IN RECORD!! */ }; /* * Flags used in Tcl_HashKeyType. * * TCL_HASH_KEY_RANDOMIZE_HASH - * There are some things, pointers for example * which don't hash well because they do not use * the lower bits. If this flag is set then the * hash table will attempt to rectify this by * randomising the bits and then using the upper * N bits as the index into the table. * TCL_HASH_KEY_SYSTEM_HASH - If this flag is set then all memory internally * allocated for the hash table that is not for an * entry will use the system heap. */ #define TCL_HASH_KEY_RANDOMIZE_HASH 0x1 #define TCL_HASH_KEY_SYSTEM_HASH 0x2 /* * Structure definition for the methods associated with a hash table key type. */ #define TCL_HASH_KEY_TYPE_VERSION 1 struct Tcl_HashKeyType { int version; /* Version of the table. If this structure is * extended in future then the version can be * used to distinguish between different * structures. */ int flags; /* Flags, see above for details. */ Tcl_HashKeyProc *hashKeyProc; /* Calculates a hash value for the key. If * this is NULL then the pointer itself is * used as a hash value. */ Tcl_CompareHashKeysProc *compareKeysProc; /* Compares two keys and returns zero if they * do not match, and non-zero if they do. If * this is NULL then the pointers are * compared. */ Tcl_AllocHashEntryProc *allocEntryProc; /* Called to allocate memory for a new entry, * i.e. if the key is a string then this could * allocate a single block which contains * enough space for both the entry and the * string. Only the key field of the allocated * Tcl_HashEntry structure needs to be filled * in. If something else needs to be done to * the key, i.e. incrementing a reference * count then that should be done by this * function. If this is NULL then Tcl_Alloc is * used to allocate enough space for a * Tcl_HashEntry and the key pointer is * assigned to key.oneWordValue. */ Tcl_FreeHashEntryProc *freeEntryProc; /* Called to free memory associated with an * entry. If something else needs to be done * to the key, i.e. decrementing a reference * count then that should be done by this * function. If this is NULL then Tcl_Free is * used to free the Tcl_HashEntry. */ }; /* * Structure definition for a hash table. Must be in tcl.h so clients can * allocate space for these structures, but clients should never access any * fields in this structure. */ #define TCL_SMALL_HASH_TABLE 4 struct Tcl_HashTable { Tcl_HashEntry **buckets; /* Pointer to bucket array. Each element * points to first entry in bucket's hash * chain, or NULL. */ Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ int numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ int numEntries; /* Total number of entries present in * table. */ int rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ int mask; /* Mask value used in hashing function. */ int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, * TCL_ONE_WORD_KEYS, or an integer giving the * number of ints that is the size of the * key. */ Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key); Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key, int *newPtr); const Tcl_HashKeyType *typePtr; /* Type of the keys used in the * Tcl_HashTable. */ }; /* * Structure definition for information used to keep track of searches through * hash tables: */ typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ int nextIndex; /* Index of next bucket to be enumerated after * present one. */ Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current * bucket. */ } Tcl_HashSearch; /* * Acceptable key types for hash tables: * * TCL_STRING_KEYS: The keys are strings, they are copied into the * entry. * TCL_ONE_WORD_KEYS: The keys are pointers, the pointer is stored * in the entry. * TCL_CUSTOM_TYPE_KEYS: The keys are arbitrary types which are copied * into the entry. * TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the * pointer is stored in the entry. * * While maintaining binary compatibility the above have to be distinct values * as they are used to differentiate between old versions of the hash table * which don't have a typePtr and new ones which do. Once binary compatibility * is discarded in favour of making more wide spread changes TCL_STRING_KEYS * can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the * same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is * accessed from the entry and not the behaviour. */ #define TCL_STRING_KEYS (0) #define TCL_ONE_WORD_KEYS (1) #define TCL_CUSTOM_TYPE_KEYS (-2) #define TCL_CUSTOM_PTR_KEYS (-1) /* * Structure definition for information used to keep track of searches through * dictionaries. These fields should not be accessed by code outside * tclDictObj.c */ typedef struct { void *next; /* Search position for underlying hash * table. */ int epoch; /* Epoch marker for dictionary being searched, * or -1 if search has terminated. */ Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */ } Tcl_DictSearch; /* *---------------------------------------------------------------------------- * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of * events: */ #define TCL_DONT_WAIT (1<<1) #define TCL_WINDOW_EVENTS (1<<2) #define TCL_FILE_EVENTS (1<<3) #define TCL_TIMER_EVENTS (1<<4) #define TCL_IDLE_EVENTS (1<<5) /* WAS 0x10 ???? */ #define TCL_ALL_EVENTS (~TCL_DONT_WAIT) /* * The following structure defines a generic event for the Tcl event system. * These are the things that are queued in calls to Tcl_QueueEvent and * serviced later by Tcl_DoOneEvent. There can be many different kinds of * events with different fields, corresponding to window events, timer events, * etc. The structure for a particular event consists of a Tcl_Event header * followed by additional information specific to that event. */ struct Tcl_Event { Tcl_EventProc *proc; /* Function to call to service this event. */ struct Tcl_Event *nextPtr; /* Next in list of pending events, or NULL. */ }; /* * Positions to pass to Tcl_QueueEvent: */ typedef enum { TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK } Tcl_QueuePosition; /* * Values to pass to Tcl_SetServiceMode to specify the behavior of notifier * event routines. */ #define TCL_SERVICE_NONE 0 #define TCL_SERVICE_ALL 1 /* * The following structure keeps is used to hold a time value, either as an * absolute time (the number of seconds from the epoch) or as an elapsed time. * On Unix systems the epoch is Midnight Jan 1, 1970 GMT. */ typedef struct Tcl_Time { long sec; /* Seconds. */ long usec; /* Microseconds. */ } Tcl_Time; typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr); typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr); /* * TIP #233 (Virtualized Time) */ typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, ClientData clientData); typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); /* *---------------------------------------------------------------------------- * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to * indicate what sorts of events are of interest: */ #define TCL_READABLE (1<<1) #define TCL_WRITABLE (1<<2) #define TCL_EXCEPTION (1<<3) /* * Flag values to pass to Tcl_OpenCommandChannel to indicate the disposition * of the stdio handles. TCL_STDIN, TCL_STDOUT, TCL_STDERR, are also used in * Tcl_GetStdChannel. */ #define TCL_STDIN (1<<1) #define TCL_STDOUT (1<<2) #define TCL_STDERR (1<<3) #define TCL_ENFORCE_MODE (1<<4) /* * Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel * should be closed. */ #define TCL_CLOSE_READ (1<<1) #define TCL_CLOSE_WRITE (1<<2) /* * Value to use as the closeProc for a channel that supports the close2Proc * interface. */ #define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *) 1) /* * Channel version tag. This was introduced in 8.3.2/8.4. */ #define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1) #define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2) #define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3) #define TCL_CHANNEL_VERSION_4 ((Tcl_ChannelTypeVersion) 0x4) #define TCL_CHANNEL_VERSION_5 ((Tcl_ChannelTypeVersion) 0x5) /* * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc. */ #define TCL_CHANNEL_THREAD_INSERT (0) #define TCL_CHANNEL_THREAD_REMOVE (1) /* * Typedefs for the various operations in a channel type: */ typedef int (Tcl_DriverBlockModeProc) (ClientData instanceData, int mode); typedef int (Tcl_DriverCloseProc) (ClientData instanceData, Tcl_Interp *interp); typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, Tcl_Interp *interp, int flags); typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, int toRead, int *errorCodePtr); typedef int (Tcl_DriverOutputProc) (ClientData instanceData, CONST84 char *buf, int toWrite, int *errorCodePtr); typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, int mode, int *errorCodePtr); typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, Tcl_Interp *interp, CONST84 char *optionName, Tcl_DString *dsPtr); typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, int direction, ClientData *handlePtr); typedef int (Tcl_DriverFlushProc) (ClientData instanceData); typedef int (Tcl_DriverHandlerProc) (ClientData instanceData, int interestMask); typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr); /* * TIP #218, Channel Thread Actions */ typedef void (Tcl_DriverThreadActionProc) (ClientData instanceData, int action); /* * TIP #208, File Truncation (etc.) */ typedef int (Tcl_DriverTruncateProc) (ClientData instanceData, Tcl_WideInt length); /* * struct Tcl_ChannelType: * * One such structure exists for each type (kind) of channel. It collects * together in one place all the functions that are part of the specific * channel type. * * It is recommend that the Tcl_Channel* functions are used to access elements * of this structure, instead of direct accessing. */ typedef struct Tcl_ChannelType { const char *typeName; /* The name of the channel type in Tcl * commands. This storage is owned by channel * type. */ Tcl_ChannelTypeVersion version; /* Version of the channel type. */ Tcl_DriverCloseProc *closeProc; /* Function to call to close the channel, or * TCL_CLOSE2PROC if the close2Proc should be * used instead. */ Tcl_DriverInputProc *inputProc; /* Function to call for input on channel. */ Tcl_DriverOutputProc *outputProc; /* Function to call for output on channel. */ Tcl_DriverSeekProc *seekProc; /* Function to call to seek on the channel. * May be NULL. */ Tcl_DriverSetOptionProc *setOptionProc; /* Set an option on a channel. */ Tcl_DriverGetOptionProc *getOptionProc; /* Get an option from a channel. */ Tcl_DriverWatchProc *watchProc; /* Set up the notifier to watch for events on * this channel. */ Tcl_DriverGetHandleProc *getHandleProc; /* Get an OS handle from the channel or NULL * if not supported. */ Tcl_DriverClose2Proc *close2Proc; /* Function to call to close the channel if * the device supports closing the read & * write sides independently. */ Tcl_DriverBlockModeProc *blockModeProc; /* Set blocking mode for the raw channel. May * be NULL. */ /* * Only valid in TCL_CHANNEL_VERSION_2 channels or later. */ Tcl_DriverFlushProc *flushProc; /* Function to call to flush a channel. May be * NULL. */ Tcl_DriverHandlerProc *handlerProc; /* Function to call to handle a channel event. * This will be passed up the stacked channel * chain. */ /* * Only valid in TCL_CHANNEL_VERSION_3 channels or later. */ Tcl_DriverWideSeekProc *wideSeekProc; /* Function to call to seek on the channel * which can handle 64-bit offsets. May be * NULL, and must be NULL if seekProc is * NULL. */ /* * Only valid in TCL_CHANNEL_VERSION_4 channels or later. * TIP #218, Channel Thread Actions. */ Tcl_DriverThreadActionProc *threadActionProc; /* Function to call to notify the driver of * thread specific activity for a channel. May * be NULL. */ /* * Only valid in TCL_CHANNEL_VERSION_5 channels or later. * TIP #208, File Truncation. */ Tcl_DriverTruncateProc *truncateProc; /* Function to call to truncate the underlying * file to a particular length. May be NULL if * the channel does not support truncation. */ } Tcl_ChannelType; /* * The following flags determine whether the blockModeProc above should set * the channel into blocking or nonblocking mode. They are passed as arguments * to the blockModeProc function in the above structure. */ #define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */ #define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking * mode. */ /* *---------------------------------------------------------------------------- * Enum for different types of file paths. */ typedef enum Tcl_PathType { TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, TCL_PATH_VOLUME_RELATIVE } Tcl_PathType; /* * The following structure is used to pass glob type data amongst the various * glob routines and Tcl_FSMatchInDirectory. */ typedef struct Tcl_GlobTypeData { int type; /* Corresponds to bcdpfls as in 'find -t'. */ int perm; /* Corresponds to file permissions. */ Tcl_Obj *macType; /* Acceptable Mac type. */ Tcl_Obj *macCreator; /* Acceptable Mac creator. */ } Tcl_GlobTypeData; /* * Type and permission definitions for glob command. */ #define TCL_GLOB_TYPE_BLOCK (1<<0) #define TCL_GLOB_TYPE_CHAR (1<<1) #define TCL_GLOB_TYPE_DIR (1<<2) #define TCL_GLOB_TYPE_PIPE (1<<3) #define TCL_GLOB_TYPE_FILE (1<<4) #define TCL_GLOB_TYPE_LINK (1<<5) #define TCL_GLOB_TYPE_SOCK (1<<6) #define TCL_GLOB_TYPE_MOUNT (1<<7) #define TCL_GLOB_PERM_RONLY (1<<0) #define TCL_GLOB_PERM_HIDDEN (1<<1) #define TCL_GLOB_PERM_R (1<<2) #define TCL_GLOB_PERM_W (1<<3) #define TCL_GLOB_PERM_X (1<<4) /* * Flags for the unload callback function. */ #define TCL_UNLOAD_DETACH_FROM_INTERPRETER (1<<0) #define TCL_UNLOAD_DETACH_FROM_PROCESS (1<<1) /* * Typedefs for the various filesystem operations: */ typedef int (Tcl_FSStatProc) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); typedef int (Tcl_FSAccessProc) (Tcl_Obj *pathPtr, int mode); typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); typedef int (Tcl_FSMatchInDirectoryProc) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); typedef Tcl_Obj * (Tcl_FSGetCwdProc) (Tcl_Interp *interp); typedef int (Tcl_FSChdirProc) (Tcl_Obj *pathPtr); typedef int (Tcl_FSLstatProc) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); typedef int (Tcl_FSCreateDirectoryProc) (Tcl_Obj *pathPtr); typedef int (Tcl_FSDeleteFileProc) (Tcl_Obj *pathPtr); typedef int (Tcl_FSCopyDirectoryProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); typedef int (Tcl_FSCopyFileProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); typedef int (Tcl_FSRemoveDirectoryProc) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); typedef int (Tcl_FSRenameFileProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); typedef void (Tcl_FSUnloadFileProc) (Tcl_LoadHandle loadHandle); typedef Tcl_Obj * (Tcl_FSListVolumesProc) (void); /* We have to declare the utime structure here. */ struct utimbuf; typedef int (Tcl_FSUtimeProc) (Tcl_Obj *pathPtr, struct utimbuf *tval); typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr, ClientData *clientDataPtr); typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr); typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr); typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData); typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData); typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData); typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); typedef struct Tcl_FSVersion_ *Tcl_FSVersion; /* *---------------------------------------------------------------------------- * Data structures related to hooking into the filesystem */ /* * Filesystem version tag. This was introduced in 8.4. */ #define TCL_FILESYSTEM_VERSION_1 ((Tcl_FSVersion) 0x1) /* * struct Tcl_Filesystem: * * One such structure exists for each type (kind) of filesystem. It collects * together the functions that form the interface for a particulr the * filesystem. Tcl always accesses the filesystem through one of these * structures. * * Not all entries need be non-NULL; any which are NULL are simply ignored. * However, a complete filesystem should provide all of these functions. The * explanations in the structure show the importance of each function. */ typedef struct Tcl_Filesystem { const char *typeName; /* The name of the filesystem. */ int structureLength; /* Length of this structure, so future binary * compatibility can be assured. */ Tcl_FSVersion version; /* Version of the filesystem type. */ Tcl_FSPathInFilesystemProc *pathInFilesystemProc; /* Determines whether the pathname is in this * filesystem. This is the most important * filesystem function. */ Tcl_FSDupInternalRepProc *dupInternalRepProc; /* Duplicates the internal handle of the node. * If it is NULL, the filesystem is less * performant. */ Tcl_FSFreeInternalRepProc *freeInternalRepProc; /* Frees the internal handle of the node. NULL * only if there is no need to free resources * used for the internal handle. */ Tcl_FSInternalToNormalizedProc *internalToNormalizedProc; /* Converts the internal handle to a normalized * path. NULL if the filesystem creates nodes * having no pathname. */ Tcl_FSCreateInternalRepProc *createInternalRepProc; /* Creates an internal handle for a pathname. * May be NULL if pathnames have no internal * handle or if pathInFilesystemProc always * immediately creates an internal * representation for pathnames in the * filesystem. */ Tcl_FSNormalizePathProc *normalizePathProc; /* Normalizes a path. Should be implemented if * the filesystems supports multiple paths to * the same node. */ Tcl_FSFilesystemPathTypeProc *filesystemPathTypeProc; /* Determines the type of a path in this * filesystem. May be NULL. */ Tcl_FSFilesystemSeparatorProc *filesystemSeparatorProc; /* Produces the separator character(s) for this * filesystem. Must not be NULL. */ Tcl_FSStatProc *statProc; /* Called by 'Tcl_FSStat()'. Provided by any * reasonable filesystem. */ Tcl_FSAccessProc *accessProc; /* Called by 'Tcl_FSAccess()'. Implemented by * any reasonable filesystem. */ Tcl_FSOpenFileChannelProc *openFileChannelProc; /* Called by 'Tcl_FSOpenFileChannel()'. * Provided by any reasonable filesystem. */ Tcl_FSMatchInDirectoryProc *matchInDirectoryProc; /* Called by 'Tcl_FSMatchInDirectory()'. NULL * if the filesystem does not support glob or * recursive copy. */ Tcl_FSUtimeProc *utimeProc; /* Called by 'Tcl_FSUtime()', by 'file * mtime' to set (not read) times, 'file * atime', and the open-r/open-w/fcopy variant * of 'file copy'. */ Tcl_FSLinkProc *linkProc; /* Called by 'Tcl_FSLink()'. NULL if reading or * creating links is not supported. */ Tcl_FSListVolumesProc *listVolumesProc; /* Lists filesystem volumes added by this * filesystem. NULL if the filesystem does not * use volumes. */ Tcl_FSFileAttrStringsProc *fileAttrStringsProc; /* List all valid attributes strings. NULL if * the filesystem does not support the 'file * attributes' command. Can be used to attach * arbitrary additional data to files in a * filesystem. */ Tcl_FSFileAttrsGetProc *fileAttrsGetProc; /* Called by 'Tcl_FSFileAttrsGet()' and by * 'file attributes'. */ Tcl_FSFileAttrsSetProc *fileAttrsSetProc; /* Called by 'Tcl_FSFileAttrsSet()' and by * 'file attributes'. */ Tcl_FSCreateDirectoryProc *createDirectoryProc; /* Called by 'Tcl_FSCreateDirectory()'. May be * NULL if the filesystem is read-only. */ Tcl_FSRemoveDirectoryProc *removeDirectoryProc; /* Called by 'Tcl_FSRemoveDirectory()'. May be * NULL if the filesystem is read-only. */ Tcl_FSDeleteFileProc *deleteFileProc; /* Called by 'Tcl_FSDeleteFile()' May be NULL * if the filesystem is is read-only. */ Tcl_FSCopyFileProc *copyFileProc; /* Called by 'Tcl_FSCopyFile()'. If NULL, for * a copy operation at the script level (not * C) Tcl uses open-r, open-w and fcopy. */ Tcl_FSRenameFileProc *renameFileProc; /* Called by 'Tcl_FSRenameFile()'. If NULL, for * a rename operation at the script level (not * C) Tcl performs a copy operation followed * by a delete operation. */ Tcl_FSCopyDirectoryProc *copyDirectoryProc; /* Called by 'Tcl_FSCopyDirectory()'. If NULL, * for a copy operation at the script level * (not C) Tcl recursively creates directories * and copies files. */ Tcl_FSLstatProc *lstatProc; /* Called by 'Tcl_FSLstat()'. If NULL, Tcl * attempts to use 'statProc' instead. */ Tcl_FSLoadFileProc *loadFileProc; /* Called by 'Tcl_FSLoadFile()'. If NULL, Tcl * performs a copy to a temporary file in the * native filesystem and then calls * Tcl_FSLoadFile() on that temporary copy. */ Tcl_FSGetCwdProc *getCwdProc; /* Called by 'Tcl_FSGetCwd()'. Normally NULL. * Usually only called once: If 'getcwd' is * called before 'chdir' is ever called. */ Tcl_FSChdirProc *chdirProc; /* Called by 'Tcl_FSChdir()'. For a virtual * filesystem, chdirProc just returns zero * (success) if the pathname is a valid * directory, and some other value otherwise. * For A real filesystem, chdirProc performs * the correct action, e.g. calls the system * 'chdir' function. If not implemented, then * 'cd' and 'pwd' fail for a pathname in this * filesystem. On success Tcl stores the * pathname for use by GetCwd. If NULL, Tcl * performs records the pathname as the new * current directory if it passes a series of * directory access checks. */ } Tcl_Filesystem; /* * The following definitions are used as values for the 'linkAction' flag to * Tcl_FSLink, or the linkProc of any filesystem. Any combination of flags can * be given. For link creation, the linkProc should create a link which * matches any of the types given. * * TCL_CREATE_SYMBOLIC_LINK - Create a symbolic or soft link. * TCL_CREATE_HARD_LINK - Create a hard link. */ #define TCL_CREATE_SYMBOLIC_LINK 0x01 #define TCL_CREATE_HARD_LINK 0x02 /* *---------------------------------------------------------------------------- * The following structure represents the Notifier functions that you can * override with the Tcl_SetNotifier call. */ typedef struct Tcl_NotifierProcs { Tcl_SetTimerProc *setTimerProc; Tcl_WaitForEventProc *waitForEventProc; Tcl_CreateFileHandlerProc *createFileHandlerProc; Tcl_DeleteFileHandlerProc *deleteFileHandlerProc; Tcl_InitNotifierProc *initNotifierProc; Tcl_FinalizeNotifierProc *finalizeNotifierProc; Tcl_AlertNotifierProc *alertNotifierProc; Tcl_ServiceModeHookProc *serviceModeHookProc; } Tcl_NotifierProcs; /* *---------------------------------------------------------------------------- * The following data structures and declarations are for the new Tcl parser. * * For each word of a command, and for each piece of a word such as a variable * reference, one of the following structures is created to describe the * token. */ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; see * below for valid types. */ const char *start; /* First character in token. */ int size; /* Number of bytes in token. */ int numComponents; /* If this token is composed of other tokens, * this field tells how many of them there are * (including components of components, etc.). * The component tokens immediately follow * this one. */ } Tcl_Token; /* * Type values defined for Tcl_Token structures. These values are defined as * mask bits so that it's easy to check for collections of types. * * TCL_TOKEN_WORD - The token describes one word of a command, * from the first non-blank character of the word * (which may be " or {) up to but not including * the space, semicolon, or bracket that * terminates the word. NumComponents counts the * total number of sub-tokens that make up the * word. This includes, for example, sub-tokens * of TCL_TOKEN_VARIABLE tokens. * TCL_TOKEN_SIMPLE_WORD - This token is just like TCL_TOKEN_WORD except * that the word is guaranteed to consist of a * single TCL_TOKEN_TEXT sub-token. * TCL_TOKEN_TEXT - The token describes a range of literal text * that is part of a word. NumComponents is * always 0. * TCL_TOKEN_BS - The token describes a backslash sequence that * must be collapsed. NumComponents is always 0. * TCL_TOKEN_COMMAND - The token describes a command whose result * must be substituted into the word. The token * includes the enclosing brackets. NumComponents * is always 0. * TCL_TOKEN_VARIABLE - The token describes a variable substitution, * including the dollar sign, variable name, and * array index (if there is one) up through the * right parentheses. NumComponents tells how * many additional tokens follow to represent the * variable name. The first token will be a * TCL_TOKEN_TEXT token that describes the * variable name. If the variable is an array * reference then there will be one or more * additional tokens, of type TCL_TOKEN_TEXT, * TCL_TOKEN_BS, TCL_TOKEN_COMMAND, and * TCL_TOKEN_VARIABLE, that describe the array * index; numComponents counts the total number * of nested tokens that make up the variable * reference, including sub-tokens of * TCL_TOKEN_VARIABLE tokens. * TCL_TOKEN_SUB_EXPR - The token describes one subexpression of an * expression, from the first non-blank character * of the subexpression up to but not including * the space, brace, or bracket that terminates * the subexpression. NumComponents counts the * total number of following subtokens that make * up the subexpression; this includes all * subtokens for any nested TCL_TOKEN_SUB_EXPR * tokens. For example, a numeric value used as a * primitive operand is described by a * TCL_TOKEN_SUB_EXPR token followed by a * TCL_TOKEN_TEXT token. A binary subexpression * is described by a TCL_TOKEN_SUB_EXPR token * followed by the TCL_TOKEN_OPERATOR token for * the operator, then TCL_TOKEN_SUB_EXPR tokens * for the left then the right operands. * TCL_TOKEN_OPERATOR - The token describes one expression operator. * An operator might be the name of a math * function such as "abs". A TCL_TOKEN_OPERATOR * token is always preceded by one * TCL_TOKEN_SUB_EXPR token for the operator's * subexpression, and is followed by zero or more * TCL_TOKEN_SUB_EXPR tokens for the operator's * operands. NumComponents is always 0. * TCL_TOKEN_EXPAND_WORD - This token is just like TCL_TOKEN_WORD except * that it marks a word that began with the * literal character prefix "{*}". This word is * marked to be expanded - that is, broken into * words after substitution is complete. */ #define TCL_TOKEN_WORD 1 #define TCL_TOKEN_SIMPLE_WORD 2 #define TCL_TOKEN_TEXT 4 #define TCL_TOKEN_BS 8 #define TCL_TOKEN_COMMAND 16 #define TCL_TOKEN_VARIABLE 32 #define TCL_TOKEN_SUB_EXPR 64 #define TCL_TOKEN_OPERATOR 128 #define TCL_TOKEN_EXPAND_WORD 256 /* * Parsing error types. On any parsing error, one of these values will be * stored in the error field of the Tcl_Parse structure defined below. */ #define TCL_PARSE_SUCCESS 0 #define TCL_PARSE_QUOTE_EXTRA 1 #define TCL_PARSE_BRACE_EXTRA 2 #define TCL_PARSE_MISSING_BRACE 3 #define TCL_PARSE_MISSING_BRACKET 4 #define TCL_PARSE_MISSING_PAREN 5 #define TCL_PARSE_MISSING_QUOTE 6 #define TCL_PARSE_MISSING_VAR_BRACE 7 #define TCL_PARSE_SYNTAX 8 #define TCL_PARSE_BAD_NUMBER 9 /* * A structure of the following type is filled in by Tcl_ParseCommand. It * describes a single command parsed from an input string. */ #define NUM_STATIC_TOKENS 20 typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ int commentSize; /* Number of bytes in comments (up through * newline character that terminates the last * comment). If there were no comments, this * field is 0. */ const char *commandStart; /* First character in first word of * command. */ int commandSize; /* Number of bytes in command, including first * character of first word, up through the * terminating newline, close bracket, or * semicolon. */ int numWords; /* Total number of words in command. May be * 0. */ Tcl_Token *tokenPtr; /* Pointer to first token representing the * words of the command. Initially points to * staticTokens, but may change to point to * malloc-ed space if command exceeds space in * staticTokens. */ int numTokens; /* Total number of tokens in command. */ int tokensAvailable; /* Total number of tokens available at * *tokenPtr. */ int errorType; /* One of the parsing error types defined * above. */ /* * The fields below are intended only for the private use of the parser. * They should not be used by functions that invoke Tcl_ParseCommand. */ const char *string; /* The original command string passed to * Tcl_ParseCommand. */ const char *end; /* Points to the character just after the last * one in the command string. */ Tcl_Interp *interp; /* Interpreter to use for error reporting, or * NULL. */ const char *term; /* Points to character in string that * terminated most recent token. Filled in by * ParseTokens. If an error occurs, points to * beginning of region where the error * occurred (e.g. the open brace if the close * brace is missing). */ int incomplete; /* This field is set to 1 by Tcl_ParseCommand * if the command appears to be incomplete. * This information is used by * Tcl_CommandComplete. */ Tcl_Token staticTokens[NUM_STATIC_TOKENS]; /* Initial space for tokens for command. This * space should be large enough to accommodate * most commands; dynamic space is allocated * for very large commands that don't fit * here. */ } Tcl_Parse; /* *---------------------------------------------------------------------------- * The following structure represents a user-defined encoding. It collects * together all the functions that are used by the specific encoding. */ typedef struct Tcl_EncodingType { const char *encodingName; /* The name of the encoding, e.g. "euc-jp". * This name is the unique key for this * encoding type. */ Tcl_EncodingConvertProc *toUtfProc; /* Function to convert from external encoding * into UTF-8. */ Tcl_EncodingConvertProc *fromUtfProc; /* Function to convert from UTF-8 into * external encoding. */ Tcl_EncodingFreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ ClientData clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ int nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number * is used to determine the source string * length when the srcLen argument is * negative. Must be 1 or 2. */ } Tcl_EncodingType; /* * The following definitions are used as values for the conversion control * flags argument when converting text from one character set to another: * * TCL_ENCODING_START - Signifies that the source buffer is the first * block in a (potentially multi-block) input * stream. Tells the conversion function to reset * to an initial state and perform any * initialization that needs to occur before the * first byte is converted. If the source buffer * contains the entire input stream to be * converted, this flag should be set. * TCL_ENCODING_END - Signifies that the source buffer is the last * block in a (potentially multi-block) input * stream. Tells the conversion routine to * perform any finalization that needs to occur * after the last byte is converted and then to * reset to an initial state. If the source * buffer contains the entire input stream to be * converted, this flag should be set. * TCL_ENCODING_STOPONERROR - If set, the converter returns immediately upon * encountering an invalid byte sequence or a * source character that has no mapping in the * target encoding. If clear, the converter * substitues the problematic character(s) with * one or more "close" characters in the * destination buffer and then continues to * convert the source. * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf does not append a * terminating NUL byte. Since it does not need * an extra byte for a terminating NUL, it fills * all dstLen bytes with encoded UTF-8 content if * needed. If clear, a byte is reserved in the * dst space for NUL termination, and a * terminating NUL is appended. * TCL_ENCODING_CHAR_LIMIT - If set and dstCharsPtr is not NULL, then * Tcl_ExternalToUtf takes the initial value of * *dstCharsPtr as a limit of the maximum number * of chars to produce in the encoded UTF-8 * content. Otherwise, the number of chars * produced is controlled only by other limiting * factors. */ #define TCL_ENCODING_START 0x01 #define TCL_ENCODING_END 0x02 #define TCL_ENCODING_STOPONERROR 0x04 #define TCL_ENCODING_NO_TERMINATE 0x08 #define TCL_ENCODING_CHAR_LIMIT 0x10 /* * The following definitions are the error codes returned by the conversion * routines: * * TCL_OK - All characters were converted. * TCL_CONVERT_NOSPACE - The output buffer would not have been large * enough for all of the converted data; as many * characters as could fit were converted though. * TCL_CONVERT_MULTIBYTE - The last few bytes in the source string were * the beginning of a multibyte sequence, but * more bytes were needed to complete this * sequence. A subsequent call to the conversion * routine should pass the beginning of this * unconverted sequence plus additional bytes * from the source stream to properly convert the * formerly split-up multibyte sequence. * TCL_CONVERT_SYNTAX - The source stream contained an invalid * character sequence. This may occur if the * input stream has been damaged or if the input * encoding method was misidentified. This error * is reported only if TCL_ENCODING_STOPONERROR * was specified. * TCL_CONVERT_UNKNOWN - The source string contained a character that * could not be represented in the target * encoding. This error is reported only if * TCL_ENCODING_STOPONERROR was specified. */ #define TCL_CONVERT_MULTIBYTE (-1) #define TCL_CONVERT_SYNTAX (-2) #define TCL_CONVERT_UNKNOWN (-3) #define TCL_CONVERT_NOSPACE (-4) /* * The maximum number of bytes that are necessary to represent a single * Unicode character in UTF-8. The valid values should be 3, 4 or 6. If 3 or * 4, then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6, * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode * is the default and recommended mode. UCS-4 is experimental and not * recommended. It works for the core, but most extensions expect UCS-2. */ #ifndef TCL_UTF_MAX #define TCL_UTF_MAX 3 #endif /* * This represents a Unicode character. Any changes to this should also be * reflected in regcustom.h. */ #if TCL_UTF_MAX > 4 /* * unsigned int isn't 100% accurate as it should be a strict 4-byte value. * The size of this value must be reflected correctly in regcustom.h. * XXX: Tcl is currently UCS-2 and planning UTF-16 for the Unicode * XXX: string rep that Tcl_UniChar represents. Changing the size * XXX: of Tcl_UniChar is /not/ supported. */ typedef unsigned int Tcl_UniChar; #else typedef unsigned short Tcl_UniChar; #endif /* *---------------------------------------------------------------------------- * TIP #59: The following structure is used in calls 'Tcl_RegisterConfig' to * provide the system with the embedded configuration data. */ typedef struct Tcl_Config { const char *key; /* Configuration key to register. ASCII * encoded, thus UTF-8. */ const char *value; /* The value associated with the key. System * encoding. */ } Tcl_Config; /* *---------------------------------------------------------------------------- * Flags for TIP#143 limits, detailing which limits are active in an * interpreter. Used for Tcl_{Add,Remove}LimitHandler type argument. */ #define TCL_LIMIT_COMMANDS 0x01 #define TCL_LIMIT_TIME 0x02 /* * Structure containing information about a limit handler to be called when a * command- or time-limit is exceeded by an interpreter. */ typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp); typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData); /* *---------------------------------------------------------------------------- * Override definitions for libtommath. */ typedef struct mp_int mp_int; #define MP_INT_DECLARED typedef unsigned int mp_digit; #define MP_DIGIT_DECLARED /* *---------------------------------------------------------------------------- * Definitions needed for Tcl_ParseArgvObj routines. * Based on tkArgv.c. * Modifications from the original are copyright (c) Sam Bromley 2006 */ typedef struct { int type; /* Indicates the option type; see below. */ const char *keyStr; /* The key string that flags the option in the * argv array. */ void *srcPtr; /* Value to be used in setting dst; usage * depends on type.*/ void *dstPtr; /* Address of value to be modified; usage * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ ClientData clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* * Legal values for the type field of a Tcl_ArgInfo: see the user * documentation for details. */ #define TCL_ARGV_CONSTANT 15 #define TCL_ARGV_INT 16 #define TCL_ARGV_STRING 17 #define TCL_ARGV_REST 18 #define TCL_ARGV_FLOAT 19 #define TCL_ARGV_FUNC 20 #define TCL_ARGV_GENFUNC 21 #define TCL_ARGV_HELP 22 #define TCL_ARGV_END 23 /* * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC * argument types: */ typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr, void *dstPtr); typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, void *dstPtr); /* * Shorthand for commonly used argTable entries. */ #define TCL_ARGV_AUTO_HELP \ {TCL_ARGV_HELP, "-help", NULL, NULL, \ "Print summary of command-line options and abort", NULL} #define TCL_ARGV_AUTO_REST \ {TCL_ARGV_REST, "--", NULL, NULL, \ "Marks the end of the options", NULL} #define TCL_ARGV_TABLE_END \ {TCL_ARGV_END, NULL, NULL, NULL, NULL, NULL} /* *---------------------------------------------------------------------------- * Definitions needed for Tcl_Zlib routines. [TIP #234] * * Constants for the format flags describing what sort of data format is * desired/expected for the Tcl_ZlibDeflate, Tcl_ZlibInflate and * Tcl_ZlibStreamInit functions. */ #define TCL_ZLIB_FORMAT_RAW 1 #define TCL_ZLIB_FORMAT_ZLIB 2 #define TCL_ZLIB_FORMAT_GZIP 4 #define TCL_ZLIB_FORMAT_AUTO 8 /* * Constants that describe whether the stream is to operate in compressing or * decompressing mode. */ #define TCL_ZLIB_STREAM_DEFLATE 16 #define TCL_ZLIB_STREAM_INFLATE 32 /* * Constants giving compression levels. Use of TCL_ZLIB_COMPRESS_DEFAULT is * recommended. */ #define TCL_ZLIB_COMPRESS_NONE 0 #define TCL_ZLIB_COMPRESS_FAST 1 #define TCL_ZLIB_COMPRESS_BEST 9 #define TCL_ZLIB_COMPRESS_DEFAULT (-1) /* * Constants for types of flushing, used with Tcl_ZlibFlush. */ #define TCL_ZLIB_NO_FLUSH 0 #define TCL_ZLIB_FLUSH 2 #define TCL_ZLIB_FULLFLUSH 3 #define TCL_ZLIB_FINALIZE 4 /* *---------------------------------------------------------------------------- * Definitions needed for the Tcl_LoadFile function. [TIP #416] */ #define TCL_LOAD_GLOBAL 1 #define TCL_LOAD_LAZY 2 /* *---------------------------------------------------------------------------- * Single public declaration for NRE. */ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, int result); /* *---------------------------------------------------------------------------- * The following constant is used to test for older versions of Tcl in the * stubs tables. */ #define TCL_STUB_MAGIC ((int) 0xFCA3BACF) /* * The following function is required to be defined in all stubs aware * extensions. The function is actually implemented in the stub library, not * the main Tcl library, although there is a trivial implementation in the * main library in case an extension is statically linked into an application. */ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); /* * When not using stubs, make it a macro. */ #ifndef USE_TCL_STUBS #define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgInitStubsCheck(interp, version, exact) #endif /* * Public functions that are not accessible via the stubs table. * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ ((Tcl_CreateInterp)())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); /* *---------------------------------------------------------------------------- * Include the public function declarations that are accessible via the stubs * table. */ #include "tclDecls.h" /* * Include platform specific public function declarations that are accessible * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only * has effect on building it as a shared library). See ticket [3010352]. */ #if defined(BUILD_tcl) # undef TCLAPI # define TCLAPI MODULE_SCOPE #endif #include "tclPlatDecls.h" /* *---------------------------------------------------------------------------- * The following declarations either map ckalloc and ckfree to malloc and * free, or they map them to functions with all sorts of debugging hooks * defined in tclCkalloc.c. */ #ifdef TCL_MEM_DEBUG # define ckalloc(x) \ ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) # define ckfree(x) \ Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) # define ckrealloc(x,y) \ ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) # define attemptckalloc(x) \ ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) # define attemptckrealloc(x,y) \ ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) #else /* !TCL_MEM_DEBUG */ /* * If we are not using the debugging allocator, we should call the Tcl_Alloc, * et al. routines in order to guarantee that every module is using the same * memory allocator both inside and outside of the Tcl library. */ # define ckalloc(x) \ ((void *) Tcl_Alloc((unsigned)(x))) # define ckfree(x) \ Tcl_Free((char *)(x)) # define ckrealloc(x,y) \ ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) # define attemptckalloc(x) \ ((void *) Tcl_AttemptAlloc((unsigned)(x))) # define attemptckrealloc(x,y) \ ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory # define Tcl_DumpActiveMemory(x) # undef Tcl_ValidateAllMemory # define Tcl_ValidateAllMemory(x,y) #endif /* !TCL_MEM_DEBUG */ #ifdef TCL_MEM_DEBUG # define Tcl_IncrRefCount(objPtr) \ Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__) # define Tcl_DecrRefCount(objPtr) \ Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__) # define Tcl_IsShared(objPtr) \ Tcl_DbIsShared(objPtr, __FILE__, __LINE__) #else # define Tcl_IncrRefCount(objPtr) \ ++(objPtr)->refCount /* * Use do/while0 idiom for optimum correctness without compiler warnings. * https://wiki.c2.com/?TrivialDoWhileLoop */ # define Tcl_DecrRefCount(objPtr) \ do { \ Tcl_Obj *_objPtr = (objPtr); \ if (_objPtr->refCount-- <= 1) { \ TclFreeObj(_objPtr); \ } \ } while(0) # define Tcl_IsShared(objPtr) \ ((objPtr)->refCount > 1) #endif /* * Macros and definitions that help to debug the use of Tcl objects. When * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call * debugging versions of the object creation functions. */ #ifdef TCL_MEM_DEBUG # undef Tcl_NewBignumObj # define Tcl_NewBignumObj(val) \ Tcl_DbNewBignumObj(val, __FILE__, __LINE__) # undef Tcl_NewBooleanObj # define Tcl_NewBooleanObj(val) \ Tcl_DbNewBooleanObj(val, __FILE__, __LINE__) # undef Tcl_NewByteArrayObj # define Tcl_NewByteArrayObj(bytes, len) \ Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__) # undef Tcl_NewDoubleObj # define Tcl_NewDoubleObj(val) \ Tcl_DbNewDoubleObj(val, __FILE__, __LINE__) # undef Tcl_NewIntObj # define Tcl_NewIntObj(val) \ Tcl_DbNewLongObj(val, __FILE__, __LINE__) # undef Tcl_NewListObj # define Tcl_NewListObj(objc, objv) \ Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__) # undef Tcl_NewLongObj # define Tcl_NewLongObj(val) \ Tcl_DbNewLongObj(val, __FILE__, __LINE__) # undef Tcl_NewObj # define Tcl_NewObj() \ Tcl_DbNewObj(__FILE__, __LINE__) # undef Tcl_NewStringObj # define Tcl_NewStringObj(bytes, len) \ Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__) # undef Tcl_NewWideIntObj # define Tcl_NewWideIntObj(val) \ Tcl_DbNewWideIntObj(val, __FILE__, __LINE__) #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------------- * Macros for clients to use to access fields of hash entries: */ #define Tcl_GetHashValue(h) ((h)->clientData) #define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value)) #define Tcl_GetHashKey(tablePtr, h) \ ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ ? (h)->key.oneWordValue \ : (h)->key.string)) /* * Macros to use for clients to use to invoke find and create functions for * hash tables: */ #undef Tcl_FindHashEntry #define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, (const char *)(key)) #undef Tcl_CreateHashEntry #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) /* *---------------------------------------------------------------------------- * Macros that eliminate the overhead of the thread synchronization functions * when compiling without thread support. */ #ifndef TCL_THREADS #undef Tcl_MutexLock #define Tcl_MutexLock(mutexPtr) #undef Tcl_MutexUnlock #define Tcl_MutexUnlock(mutexPtr) #undef Tcl_MutexFinalize #define Tcl_MutexFinalize(mutexPtr) #undef Tcl_ConditionNotify #define Tcl_ConditionNotify(condPtr) #undef Tcl_ConditionWait #define Tcl_ConditionWait(condPtr, mutexPtr, timePtr) #undef Tcl_ConditionFinalize #define Tcl_ConditionFinalize(condPtr) #endif /* TCL_THREADS */ /* *---------------------------------------------------------------------------- * Deprecated Tcl functions: */ #ifndef TCL_NO_DEPRECATED /* * These function have been renamed. The old names are deprecated, but we * define these macros for backwards compatibility. */ # define Tcl_Ckalloc Tcl_Alloc # define Tcl_Ckfree Tcl_Free # define Tcl_Ckrealloc Tcl_Realloc # define Tcl_Return Tcl_SetResult # define Tcl_TildeSubst Tcl_TranslateFileName #if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */ # define panic Tcl_Panic #endif # define panicVA Tcl_PanicVA #endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------------- * Convenience declaration of Tcl_AppInit for backwards compatibility. This * function is not *implemented* by the tcl library, so the storage class is * neither DLLEXPORT nor DLLIMPORT. */ extern Tcl_AppInitProc Tcl_AppInit; #endif /* RC_INVOKED */ /* * end block for C++ */ #ifdef __cplusplus } #endif #endif /* _TCL */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclHash.c0000644000175000017500000007262514554262142015024 0ustar sergeisergei/* * tclHash.c -- * * Implementation of in-memory hash tables for Tcl and Tcl-based * applications. * * Copyright (c) 1991-1993 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Prevent macros from clashing with function definitions. */ #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry /* * When there are this many entries per bucket, on average, rebuild the hash * table to make it larger. */ #define REBUILD_MULTIPLIER 3 /* * The following macro takes a preliminary integer hash value and produces an * index into a hash tables bucket list. The idea is to make it so that * preliminary values that are arbitrarily similar will end up in different * buckets. The hash function was taken from a random-number generator. */ #define RANDOM_INDEX(tablePtr, i) \ ((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask) /* * Prototypes for the array hash key methods. */ static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr); static unsigned int HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); /* * Prototypes for the one word hash key methods. Not actually declared because * this is a critical path that is implemented in the core hash table access * function. */ #if 0 static Tcl_HashEntry * AllocOneWordEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr); static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr); #endif /* * Prototypes for the string hash key methods. */ static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr); static unsigned int HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); /* * Function prototypes for static functions in this file: */ static Tcl_HashEntry * BogusFind(Tcl_HashTable *tablePtr, const char *key); static Tcl_HashEntry * BogusCreate(Tcl_HashTable *tablePtr, const char *key, int *newPtr); static Tcl_HashEntry * CreateHashEntry(Tcl_HashTable *tablePtr, const char *key, int *newPtr); static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const char *key); static void RebuildTable(Tcl_HashTable *tablePtr); const Tcl_HashKeyType tclArrayHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */ HashArrayKey, /* hashKeyProc */ CompareArrayKeys, /* compareKeysProc */ AllocArrayEntry, /* allocEntryProc */ NULL /* freeEntryProc */ }; const Tcl_HashKeyType tclOneWordHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ NULL, /* HashOneWordKey, */ /* hashProc */ NULL, /* CompareOneWordKey, */ /* compareProc */ NULL, /* AllocOneWordKey, */ /* allocEntryProc */ NULL /* FreeOneWordKey, */ /* freeEntryProc */ }; const Tcl_HashKeyType tclStringHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ HashStringKey, /* hashKeyProc */ CompareStringKeys, /* compareKeysProc */ AllocStringEntry, /* allocEntryProc */ NULL /* freeEntryProc */ }; /* *---------------------------------------------------------------------- * * Tcl_InitHashTable -- * * Given storage for a hash table, set up the fields to prepare the hash * table for use. * * Results: * None. * * Side effects: * TablePtr is now ready to be passed to Tcl_FindHashEntry and * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitHashTable( Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType) /* Type of keys to use in table: * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an * integer >= 2. */ { /* * Use a special value to inform the extended version that it must not * access any of the new fields in the Tcl_HashTable. If an extension is * rebuilt then any calls to this function will be redirected to the * extended version by a macro. */ Tcl_InitCustomHashTable(tablePtr, keyType, (const Tcl_HashKeyType *) -1); } /* *---------------------------------------------------------------------- * * Tcl_InitCustomHashTable -- * * Given storage for a hash table, set up the fields to prepare the hash * table for use. This is an extended version of Tcl_InitHashTable which * supports user defined keys. * * Results: * None. * * Side effects: * TablePtr is now ready to be passed to Tcl_FindHashEntry and * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitCustomHashTable( Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType, /* Type of keys to use in table: * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS, * or an integer >= 2. */ const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the * behaviour of this table. */ { #if (TCL_SMALL_HASH_TABLE != 4) Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4", TCL_SMALL_HASH_TABLE); #endif tablePtr->buckets = tablePtr->staticBuckets; tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0; tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0; tablePtr->numBuckets = TCL_SMALL_HASH_TABLE; tablePtr->numEntries = 0; tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER; tablePtr->downShift = 28; tablePtr->mask = 3; tablePtr->keyType = keyType; tablePtr->findProc = FindHashEntry; tablePtr->createProc = CreateHashEntry; if (typePtr == NULL) { /* * The caller has been rebuilt so the hash table is an extended * version. */ } else if (typePtr != (Tcl_HashKeyType *) -1) { /* * The caller is requesting a customized hash table so it must be an * extended version. */ tablePtr->typePtr = typePtr; } else { /* * The caller has not been rebuilt so the hash table is not extended. */ } } /* *---------------------------------------------------------------------- * * Tcl_FindHashEntry -- * * Given a hash table find the entry with a matching key. * * Results: * The return value is a token for the matching entry in the hash table, * or NULL if there was no matching entry. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_FindHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const void *key) /* Key to use to find matching entry. */ { return (*((tablePtr)->findProc))(tablePtr, key); } static Tcl_HashEntry * FindHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key) /* Key to use to find matching entry. */ { return CreateHashEntry(tablePtr, key, NULL); } /* *---------------------------------------------------------------------- * * Tcl_CreateHashEntry -- * * Given a hash table with string keys, and a string key, find the entry * with a matching key. If there is no matching entry, then create a new * entry that does match. * * Results: * The return value is a pointer to the matching entry. If this is a * newly-created entry, then *newPtr will be set to a non-zero value; * otherwise *newPtr will be set to 0. If this is a new entry the value * stored in the entry will initially be 0. * * Side effects: * A new entry may be added to the hash table. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const void *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { return (*((tablePtr)->createProc))(tablePtr, key, newPtr); } static Tcl_HashEntry * CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; unsigned int hash; int index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { typePtr = tablePtr->typePtr; } else { typePtr = &tclArrayHashKeyType; } if (typePtr->hashKeyProc) { hash = typePtr->hashKeyProc(tablePtr, (void *) key); if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, hash); } else { index = hash & tablePtr->mask; } } else { hash = PTR2UINT(key); index = RANDOM_INDEX(tablePtr, hash); } /* * Search all of the entries in the appropriate bucket. */ if (typePtr->compareKeysProc) { Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc; for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { #if TCL_HASH_KEY_STORE_HASH if (hash != PTR2UINT(hPtr->hash)) { continue; } #endif /* if keys pointers or values are equal */ if ((key == hPtr->key.oneWordValue) || compareKeysProc((void *) key, hPtr) ) { if (newPtr) { *newPtr = 0; } return hPtr; } } } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { #if TCL_HASH_KEY_STORE_HASH if (hash != PTR2UINT(hPtr->hash)) { continue; } #endif if (key == hPtr->key.oneWordValue) { if (newPtr) { *newPtr = 0; } return hPtr; } } } if (!newPtr) { return NULL; } /* * Entry not found. Add a new one to the bucket. */ *newPtr = 1; if (typePtr->allocEntryProc) { hPtr = typePtr->allocEntryProc(tablePtr, (void *) key); } else { hPtr = ckalloc(sizeof(Tcl_HashEntry)); hPtr->key.oneWordValue = (char *) key; hPtr->clientData = 0; } hPtr->tablePtr = tablePtr; #if TCL_HASH_KEY_STORE_HASH hPtr->hash = UINT2PTR(hash); hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; #else hPtr->bucketPtr = &tablePtr->buckets[index]; hPtr->nextPtr = *hPtr->bucketPtr; *hPtr->bucketPtr = hPtr; #endif tablePtr->numEntries++; /* * If the table has exceeded a decent size, rebuild it with many more * buckets. */ if (tablePtr->numEntries >= tablePtr->rebuildSize) { RebuildTable(tablePtr); } return hPtr; } /* *---------------------------------------------------------------------- * * Tcl_DeleteHashEntry -- * * Remove a single entry from a hash table. * * Results: * None. * * Side effects: * The entry given by entryPtr is deleted from its table and should never * again be used by the caller. It is up to the caller to free the * clientData field of the entry, if that is relevant. * *---------------------------------------------------------------------- */ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { Tcl_HashEntry *prevPtr; const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; #if TCL_HASH_KEY_STORE_HASH int index; #endif tablePtr = entryPtr->tablePtr; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { typePtr = tablePtr->typePtr; } else { typePtr = &tclArrayHashKeyType; } #if TCL_HASH_KEY_STORE_HASH if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); } else { index = PTR2UINT(entryPtr->hash) & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; #else bucketPtr = entryPtr->bucketPtr; #endif if (*bucketPtr == entryPtr) { *bucketPtr = entryPtr->nextPtr; } else { for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) { if (prevPtr == NULL) { Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry"); } if (prevPtr->nextPtr == entryPtr) { prevPtr->nextPtr = entryPtr->nextPtr; break; } } } tablePtr->numEntries--; if (typePtr->freeEntryProc) { typePtr->freeEntryProc(entryPtr); } else { ckfree(entryPtr); } } /* *---------------------------------------------------------------------- * * Tcl_DeleteHashTable -- * * Free up everything associated with a hash table except for the record * for the table itself. * * Results: * None. * * Side effects: * The hash table is no longer useable. * *---------------------------------------------------------------------- */ void Tcl_DeleteHashTable( Tcl_HashTable *tablePtr) /* Table to delete. */ { Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; int i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { typePtr = tablePtr->typePtr; } else { typePtr = &tclArrayHashKeyType; } /* * Free up all the entries in the table. */ for (i = 0; i < tablePtr->numBuckets; i++) { hPtr = tablePtr->buckets[i]; while (hPtr != NULL) { nextPtr = hPtr->nextPtr; if (typePtr->freeEntryProc) { typePtr->freeEntryProc(hPtr); } else { ckfree(hPtr); } hPtr = nextPtr; } } /* * Free up the bucket array, if it was dynamically allocated. */ if (tablePtr->buckets != tablePtr->staticBuckets) { if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { TclpSysFree((char *) tablePtr->buckets); } else { ckfree(tablePtr->buckets); } } /* * Arrange for panics if the table is used again without * re-initialization. */ tablePtr->findProc = BogusFind; tablePtr->createProc = BogusCreate; } /* *---------------------------------------------------------------------- * * Tcl_FirstHashEntry -- * * Locate the first entry in a hash table and set up a record that can be * used to step through all the remaining entries of the table. * * Results: * The return value is a pointer to the first entry in tablePtr, or NULL * if tablePtr has no entries in it. The memory at *searchPtr is * initialized so that subsequent calls to Tcl_NextHashEntry will return * all of the entries in the table, one at a time. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_FirstHashEntry( Tcl_HashTable *tablePtr, /* Table to search. */ Tcl_HashSearch *searchPtr) /* Place to store information about progress * through the table. */ { searchPtr->tablePtr = tablePtr; searchPtr->nextIndex = 0; searchPtr->nextEntryPtr = NULL; return Tcl_NextHashEntry(searchPtr); } /* *---------------------------------------------------------------------- * * Tcl_NextHashEntry -- * * Once a hash table enumeration has been initiated by calling * Tcl_FirstHashEntry, this function may be called to return successive * elements of the table. * * Results: * The return value is the next entry in the hash table being enumerated, * or NULL if the end of the table is reached. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_NextHashEntry( Tcl_HashSearch *searchPtr) /* Place to store information about progress * through the table. Must have been * initialized by calling * Tcl_FirstHashEntry. */ { Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr = searchPtr->tablePtr; while (searchPtr->nextEntryPtr == NULL) { if (searchPtr->nextIndex >= tablePtr->numBuckets) { return NULL; } searchPtr->nextEntryPtr = tablePtr->buckets[searchPtr->nextIndex]; searchPtr->nextIndex++; } hPtr = searchPtr->nextEntryPtr; searchPtr->nextEntryPtr = hPtr->nextPtr; return hPtr; } /* *---------------------------------------------------------------------- * * Tcl_HashStats -- * * Return statistics describing the layout of the hash table in its hash * buckets. * * Results: * The return value is a malloc-ed string containing information about * tablePtr. It is the caller's responsibility to free this string. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; double average, tmp; Tcl_HashEntry *hPtr; char *result, *p; /* * Compute a histogram of bucket usage. */ for (i = 0; i < NUM_COUNTERS; i++) { count[i] = 0; } overflow = 0; average = 0.0; for (i = 0; i < tablePtr->numBuckets; i++) { j = 0; for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) { j++; } if (j < NUM_COUNTERS) { count[j]++; } else { overflow++; } tmp = j; if (tablePtr->numEntries != 0) { average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0; } } /* * Print out the histogram and a few other pieces of information. */ result = ckalloc((NUM_COUNTERS * 60) + 300); snprintf(result, 60, "%d entries in table, %d buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { snprintf(p, 60, "number of buckets with %d entries: %d\n", i, count[i]); p += strlen(p); } snprintf(p, 60, "number of buckets with %d or more entries: %d\n", NUM_COUNTERS, overflow); p += strlen(p); snprintf(p, 60, "average search distance for entry: %.1f", average); return result; } /* *---------------------------------------------------------------------- * * AllocArrayEntry -- * * Allocate space for a Tcl_HashEntry containing the array key. * * Results: * The return value is a pointer to the created entry. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; int *iPtr1, *iPtr2; Tcl_HashEntry *hPtr; int count; unsigned int size; count = tablePtr->keyType; size = TclOffset(Tcl_HashEntry, key) + count*sizeof(int); if (size < sizeof(Tcl_HashEntry)) { size = sizeof(Tcl_HashEntry); } hPtr = ckalloc(size); for (iPtr1 = array, iPtr2 = hPtr->key.words; count > 0; count--, iPtr1++, iPtr2++) { *iPtr2 = *iPtr1; } hPtr->clientData = 0; return hPtr; } /* *---------------------------------------------------------------------- * * CompareArrayKeys -- * * Compares two array keys. * * Results: * The return value is 0 if they are different and 1 if they are the * same. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CompareArrayKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { const int *iPtr1 = (const int *) keyPtr; const int *iPtr2 = (const int *) hPtr->key.words; Tcl_HashTable *tablePtr = hPtr->tablePtr; int count; for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { if (count == 0) { return 1; } if (*iPtr1 != *iPtr2) { break; } } return 0; } /* *---------------------------------------------------------------------- * * HashArrayKey -- * * Compute a one-word summary of an array, which can be used to generate * a hash index. * * Results: * The return value is a one-word summary of the information in * string. * * Side effects: * None. * *---------------------------------------------------------------------- */ static unsigned int HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { const int *array = (const int *) keyPtr; unsigned int result; int count; for (result = 0, count = tablePtr->keyType; count > 0; count--, array++) { result += *array; } return result; } /* *---------------------------------------------------------------------- * * AllocStringEntry -- * * Allocate space for a Tcl_HashEntry containing the string key. * * Results: * The return value is a pointer to the created entry. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_HashEntry * AllocStringEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { const char *string = (const char *) keyPtr; Tcl_HashEntry *hPtr; unsigned int size, allocsize; allocsize = size = strlen(string) + 1; if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize); memset(hPtr, 0, TclOffset(Tcl_HashEntry, key) + allocsize); memcpy(hPtr->key.string, string, size); hPtr->clientData = 0; return hPtr; } /* *---------------------------------------------------------------------- * * CompareStringKeys -- * * Compares two string keys. * * Results: * The return value is 0 if they are different and 1 if they are the * same. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CompareStringKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { const char *p1 = (const char *) keyPtr; const char *p2 = (const char *) hPtr->key.string; return !strcmp(p1, p2); } /* *---------------------------------------------------------------------- * * HashStringKey -- * * Compute a one-word summary of a text string, which can be used to * generate a hash index. * * Results: * The return value is a one-word summary of the information in string. * * Side effects: * None. * *---------------------------------------------------------------------- */ static unsigned HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { const char *string = keyPtr; unsigned int result; char c; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose * the one below (multiply by 9 and add new character) because of the * following reasons: * * 1. Multiplying by 10 is perfect for keys that are decimal strings, and * multiplying by 9 is just about as good. * 2. Times-9 is (shift-left-3) plus (old). This means that each * character's bits hang around in the low-order bits of the hash value * for ever, plus they spread fairly rapidly up to the high-order bits * to fill out the hash value. This seems works well both for decimal * and non-decimal strings, but isn't strong against maliciously-chosen * keys. * * Note that this function is very weak against malicious strings; it's * very easy to generate multiple keys that have the same hashcode. On the * other hand, that hardly ever actually occurs and this function *is* * very cheap, even by comparison with industry-standard hashes like FNV. * If real strength of hash is required though, use a custom hash based on * Bob Jenkins's lookup3(), but be aware that it's significantly slower. * Since Tcl command and namespace names are usually reasonably-named (the * main use for string hashes in modern Tcl) speed is far more important * than strength. * * See also HashString in tclLiteral.c. * See also TclObjHashKey in tclObj.c. * * See [tcl-Feature Request #2958832] */ if ((result = UCHAR(*string)) != 0) { while ((c = *++string) != 0) { result += (result << 3) + UCHAR(c); } } return result; } /* *---------------------------------------------------------------------- * * BogusFind -- * * This function is invoked when an Tcl_FindHashEntry is called on a * table that has been deleted. * * Results: * If Tcl_Panic returns (which it shouldn't) this function returns NULL. * * Side effects: * Generates a panic. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static Tcl_HashEntry * BogusFind( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key) /* Key to use to find matching entry. */ { Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry"); return NULL; } /* *---------------------------------------------------------------------- * * BogusCreate -- * * This function is invoked when an Tcl_CreateHashEntry is called on a * table that has been deleted. * * Results: * If panic returns (which it shouldn't) this function returns NULL. * * Side effects: * Generates a panic. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static Tcl_HashEntry * BogusCreate( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry"); return NULL; } /* *---------------------------------------------------------------------- * * RebuildTable -- * * This function is invoked when the ratio of entries to hash buckets * becomes too large. It creates a new table with a larger bucket array * and moves all of the entries into the new table. * * Results: * None. * * Side effects: * Memory gets reallocated and entries get re-hashed to new buckets. * *---------------------------------------------------------------------- */ static void RebuildTable( Tcl_HashTable *tablePtr) /* Table to enlarge. */ { int count, index, oldSize = tablePtr->numBuckets; Tcl_HashEntry **oldBuckets = tablePtr->buckets; Tcl_HashEntry **oldChainPtr, **newChainPtr; Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; /* Avoid outgrowing capability of the memory allocators */ if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) { tablePtr->rebuildSize = INT_MAX; return; } if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { typePtr = tablePtr->typePtr; } else { typePtr = &tclArrayHashKeyType; } /* * Allocate and initialize the new bucket array, and set up hashing * constants for new array size. */ tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned) (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0); } else { tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets; count > 0; count--, newChainPtr++) { *newChainPtr = NULL; } tablePtr->rebuildSize *= 4; tablePtr->downShift -= 2; tablePtr->mask = (tablePtr->mask << 2) + 3; /* * Rehash all of the existing entries into the new bucket array. */ for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) { for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) { *oldChainPtr = hPtr->nextPtr; #if TCL_HASH_KEY_STORE_HASH if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash)); } else { index = PTR2UINT(hPtr->hash) & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; #else void *key = Tcl_GetHashKey(tablePtr, hPtr); if (typePtr->hashKeyProc) { unsigned int hash; hash = typePtr->hashKeyProc(tablePtr, key); if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, hash); } else { index = hash & tablePtr->mask; } } else { index = RANDOM_INDEX(tablePtr, key); } hPtr->bucketPtr = &tablePtr->buckets[index]; hPtr->nextPtr = *hPtr->bucketPtr; *hPtr->bucketPtr = hPtr; #endif } } /* * Free up the old bucket array, if it was dynamically allocated. */ if (oldBuckets != tablePtr->staticBuckets) { if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { TclpSysFree((char *) oldBuckets); } else { ckfree(oldBuckets); } } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclHistory.c0000644000175000017500000001315114554262142015567 0ustar sergeisergei/* * tclHistory.c -- * * This module and the Tcl library file history.tcl together implement * Tcl command history. Tcl_RecordAndEval(Obj) can be called to record * commands ("events") before they are executed. Commands defined in * history.tcl may be used to perform history substitutions. * * Copyright (c) 1990-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Type of the assocData structure used to hold the reference to the [history * add] subcommand, used in Tcl_RecordAndEvalObj. */ typedef struct { Tcl_Obj *historyObj; /* == "::history" */ Tcl_Obj *addObj; /* == "add" */ } HistoryObjs; #define HISTORY_OBJS_KEY "::tcl::HistoryObjs" /* * Static functions in this file. */ static Tcl_InterpDeleteProc DeleteHistoryObjs; /* *---------------------------------------------------------------------- * * Tcl_RecordAndEval -- * * This procedure adds its command argument to the current list of * recorded events and then executes the command by calling Tcl_Eval. * * Results: * The return value is a standard Tcl return value, the result of * executing cmd. * * Side effects: * The command is recorded and executed. * *---------------------------------------------------------------------- */ int Tcl_RecordAndEval( Tcl_Interp *interp, /* Token for interpreter in which command will * be executed. */ const char *cmd, /* Command to record. */ int flags) /* Additional flags. TCL_NO_EVAL means only * record: don't execute command. * TCL_EVAL_GLOBAL means evaluate the script * in global variable context instead of the * current procedure. */ { Tcl_Obj *cmdPtr; int length = strlen(cmd); int result; if (length > 0) { /* * Call Tcl_RecordAndEvalObj to do the actual work. */ cmdPtr = Tcl_NewStringObj(cmd, length); Tcl_IncrRefCount(cmdPtr); result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* * Move the interpreter's object result to the string result, then * reset the object result. */ (void) Tcl_GetStringResult(interp); /* * Discard the Tcl object created to hold the command. */ Tcl_DecrRefCount(cmdPtr); } else { /* * An empty string. Just reset the interpreter's result. */ Tcl_ResetResult(interp); result = TCL_OK; } return result; } /* *---------------------------------------------------------------------- * * Tcl_RecordAndEvalObj -- * * This procedure adds the command held in its argument object to the * current list of recorded events and then executes the command by * calling Tcl_EvalObj. * * Results: * The return value is a standard Tcl return value, the result of * executing the command. * * Side effects: * The command is recorded and executed. * *---------------------------------------------------------------------- */ int Tcl_RecordAndEvalObj( Tcl_Interp *interp, /* Token for interpreter in which command will * be executed. */ Tcl_Obj *cmdPtr, /* Points to object holding the command to * record and execute. */ int flags) /* Additional flags. TCL_NO_EVAL means record * only: don't execute the command. * TCL_EVAL_GLOBAL means evaluate the script * in global variable context instead of the * current procedure. */ { int result, call = 1; Tcl_CmdInfo info; HistoryObjs *histObjsPtr = Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL); /* * Create the references to the [::history add] command if necessary. */ if (histObjsPtr == NULL) { histObjsPtr = ckalloc(sizeof(HistoryObjs)); TclNewLiteralStringObj(histObjsPtr->historyObj, "::history"); TclNewLiteralStringObj(histObjsPtr->addObj, "add"); Tcl_IncrRefCount(histObjsPtr->historyObj); Tcl_IncrRefCount(histObjsPtr->addObj); Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs, histObjsPtr); } /* * Do not call [history] if it has been replaced by an empty proc */ result = Tcl_GetCommandInfo(interp, "::history", &info); if (result && (info.deleteProc == TclProcDeleteProc)) { Proc *procPtr = (Proc *) info.objClientData; call = (procPtr->cmdPtr->compileProc != TclCompileNoOp); } if (call) { Tcl_Obj *list[3]; /* * Do recording by eval'ing a tcl history command: history add $cmd. */ list[0] = histObjsPtr->historyObj; list[1] = histObjsPtr->addObj; list[2] = cmdPtr; Tcl_IncrRefCount(cmdPtr); (void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmdPtr); /* * One possible failure mode above: exceeding a resource limit. */ if (Tcl_LimitExceeded(interp)) { return TCL_ERROR; } } /* * Execute the command. */ result = TCL_OK; if (!(flags & TCL_NO_EVAL)) { result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL); } return result; } /* *---------------------------------------------------------------------- * * DeleteHistoryObjs -- * * Called to delete the references to the constant words used when adding * to the history. * * Results: * None. * * Side effects: * The constant words may be deleted. * *---------------------------------------------------------------------- */ static void DeleteHistoryObjs( ClientData clientData, Tcl_Interp *interp) { HistoryObjs *histObjsPtr = clientData; TclDecrRefCount(histObjsPtr->historyObj); TclDecrRefCount(histObjsPtr->addObj); ckfree(histObjsPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclIndexObj.c0000644000175000017500000012002014554262142015622 0ustar sergeisergei/* * tclIndexObj.c -- * * This file implements objects of type "index". This object type is used * to lookup a keyword in a table of valid values and cache the index of * the matching entry. Also provides table-based argv/argc processing. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 2006 Sam Bromley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Prototypes for functions defined later in this file: */ static int GetIndexFromObjList(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr, const char *msg, int flags, int *indexPtr); static void UpdateStringOfIndex(Tcl_Obj *objPtr); static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void FreeIndex(Tcl_Obj *objPtr); static int PrefixAllObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int PrefixLongestObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int PrefixMatchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void PrintUsage(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable); /* * The structure below defines the index Tcl object type by means of functions * that can be invoked by generic object code. */ static const Tcl_ObjType indexType = { "index", /* name */ FreeIndex, /* freeIntRepProc */ DupIndex, /* dupIntRepProc */ UpdateStringOfIndex, /* updateStringProc */ NULL /* setFromAnyProc */ }; /* * The definition of the internal representation of the "index" object; The * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a * pointer to one of these structures. * * Keep this structure declaration in sync with tclTestObj.c */ typedef struct { void *tablePtr; /* Pointer to the table of strings */ int offset; /* Offset between table entries */ int index; /* Selected index into table. */ } IndexRep; /* * The following macros greatly simplify moving through a table... */ #define STRING_AT(table, offset) \ (*((const char *const *)(((char *)(table)) + (offset)))) #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ (((indexRep)->index >= 0) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "") /* *---------------------------------------------------------------------- * * Tcl_GetIndexFromObj -- * * This function looks up an object's value in a table of strings and * returns the index of the matching string, if any. * * Results: * If the value of objPtr is identical to or a unique abbreviation for * one of the entries in tablePtr, then the return value is TCL_OK and the * index of the matching entry is stored at *indexPtr. If there isn't a * proper match, then TCL_ERROR is returned and an error message is left * in interp's result (unless interp is NULL). The msg argument is used * in the error message; for example, if msg has the value "option" then * the error message will say something flag 'bad option "foo": must be * ...' * * Side effects: * The result of the lookup is cached as the internal rep of objPtr, so * that repeated lookups can be done quickly. * *---------------------------------------------------------------------- */ #undef Tcl_GetIndexFromObj int Tcl_GetIndexFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object containing the string to lookup. */ const char *const *tablePtr, /* Array of strings to compare against the * value of objPtr; last entry must be NULL * and there must not be duplicate entries. */ const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ int *indexPtr) /* Place to store resulting integer index. */ { /* * See if there is a valid cached result from a previous lookup (doing the * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in * the common case where the result is cached). */ if (objPtr->typePtr == &indexType) { IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; /* * Here's hoping we don't get hit by unfortunate packing constraints * on odd platforms like a Cray PVP... */ if (indexRep->tablePtr == (void *)tablePtr && indexRep->offset == sizeof(char *)) { *indexPtr = indexRep->index; return TCL_OK; } } return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), msg, flags, indexPtr); } /* *---------------------------------------------------------------------- * * GetIndexFromObjList -- * * This procedure looks up an object's value in a table of strings and * returns the index of the matching string, if any. * * Results: * If the value of objPtr is identical to or a unique abbreviation for * one of the entries in tableObjPtr, then the return value is TCL_OK and * the index of the matching entry is stored at *indexPtr. If there isn't * a proper match, then TCL_ERROR is returned and an error message is * left in interp's result (unless interp is NULL). The msg argument is * used in the error message; for example, if msg has the value "option" * then the error message will say something flag 'bad option "foo": must * be ...' * * Side effects: * Removes any internal representation that the object might have. (TODO: * find a way to cache the lookup.) * *---------------------------------------------------------------------- */ int GetIndexFromObjList( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object containing the string to lookup. */ Tcl_Obj *tableObjPtr, /* List of strings to compare against the * value of objPtr. */ const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ int *indexPtr) /* Place to store resulting integer index. */ { int objc, result, t; Tcl_Obj **objv; const char **tablePtr; /* * Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most * of the code there. This is a bit inefficient but simpler. */ result = TclListObjGetElements(interp, tableObjPtr, &objc, &objv); if (result != TCL_OK) { return result; } /* * Build a string table from the list. */ tablePtr = (const char **)ckalloc((objc + 1) * sizeof(char *)); for (t = 0; t < objc; t++) { if (objv[t] == objPtr) { /* * An exact match is always chosen, so we can stop here. */ ckfree(tablePtr); *indexPtr = t; return TCL_OK; } tablePtr[t] = Tcl_GetString(objv[t]); } tablePtr[objc] = NULL; result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), msg, flags, indexPtr); /* * The internal rep must be cleared since tablePtr will go away. */ TclFreeIntRep(objPtr); ckfree(tablePtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_GetIndexFromObjStruct -- * * This function looks up an object's value given a starting string and * an offset for the amount of space between strings. This is useful when * the strings are embedded in some other kind of array. * * Results: * If the value of objPtr is identical to or a unique abbreviation for * one of the entries in tablePtr, then the return value is TCL_OK and * the index of the matching entry is stored at *indexPtr. If there isn't * a proper match, then TCL_ERROR is returned and an error message is * left in interp's result (unless interp is NULL). The msg argument is * used in the error message; for example, if msg has the value "option" * then the error message will say something like 'bad option "foo": must * be ...' * * Side effects: * The result of the lookup is cached as the internal rep of objPtr, so * that repeated lookups can be done quickly. * *---------------------------------------------------------------------- */ int Tcl_GetIndexFromObjStruct( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object containing the string to lookup. */ const void *tablePtr, /* The first string in the table. The second * string will be at this address plus the * offset, the third plus the offset again, * etc. The last entry must be NULL and there * must not be duplicate entries. */ int offset, /* The number of bytes between entries */ const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ int *indexPtr) /* Place to store resulting integer index. */ { int index, idx, numAbbrev; const char *key, *p1; const char *p2; const char *const *entryPtr; Tcl_Obj *resultPtr; IndexRep *indexRep; /* Protect against invalid values, like -1 or 0. */ if (offset < (int)sizeof(char *)) { offset = (int)sizeof(char *); } /* * See if there is a valid cached result from a previous lookup. */ if (objPtr && (objPtr->typePtr == &indexType)) { indexRep = objPtr->internalRep.twoPtrValue.ptr1; if ((indexRep->tablePtr == tablePtr) && (indexRep->offset == offset) && (indexRep->index >= 0)) { *indexPtr = indexRep->index; return TCL_OK; } } /* * Lookup the value of the object in the table. Accept unique * abbreviations unless TCL_EXACT is set in flags. */ key = objPtr ? TclGetString(objPtr) : ""; index = -1; numAbbrev = 0; /* * Scan the table looking for one of: * - An exact match (always preferred) * - A single abbreviation (allowed depending on flags) * - Several abbreviations (never allowed, but overridden by exact match) */ for (entryPtr = (const char *const *)tablePtr, idx = 0; *entryPtr != NULL; entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { index = idx; goto done; } } if (*p1 == '\0') { /* * The value is an abbreviation for this entry. Continue checking * other entries to make sure it's unique. If we get more than one * unique abbreviation, keep searching to see if there is an exact * match, but remember the number of unique abbreviations and * don't allow either. */ numAbbrev++; index = idx; } } /* * Check if we were instructed to disallow abbreviations. */ if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)) { goto error; } done: /* * Cache the found representation. Note that we want to avoid allocating a * new internal-rep if at all possible since that is potentially a slow * operation. */ if (objPtr && (index >= 0)) { if (objPtr->typePtr == &indexType) { indexRep = objPtr->internalRep.twoPtrValue.ptr1; } else { TclFreeIntRep(objPtr); indexRep = ckalloc(sizeof(IndexRep)); objPtr->internalRep.twoPtrValue.ptr1 = indexRep; objPtr->typePtr = &indexType; } indexRep->tablePtr = (void *) tablePtr; indexRep->offset = offset; indexRep->index = index; } *indexPtr = index; return TCL_OK; error: if (interp != NULL) { /* * Produce a fancy error message. */ int count = 0; TclNewObj(resultPtr); entryPtr = (const char *const *)tablePtr; while ((*entryPtr != NULL) && !**entryPtr) { entryPtr = NEXT_ENTRY(entryPtr, offset); } Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), msg, " \"", key, NULL); if (*entryPtr == NULL) { Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL); } else { Tcl_AppendStringsToObj(resultPtr, "\": must be ", *entryPtr, NULL); entryPtr = NEXT_ENTRY(entryPtr, offset); while (*entryPtr != NULL) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""), " or ", *entryPtr, NULL); } else if (**entryPtr) { Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL); count++; } entryPtr = NEXT_ENTRY(entryPtr, offset); } } Tcl_SetObjResult(interp, resultPtr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * UpdateStringOfIndex -- * * This function is called to convert a Tcl object from index internal * form to its string form. No abbreviation is ever generated. * * Results: * None. * * Side effects: * The string representation of the object is updated. * *---------------------------------------------------------------------- */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = (IndexRep *)objPtr->internalRep.twoPtrValue.ptr1; char *buf; unsigned len; const char *indexStr = EXPAND_OF(indexRep); len = strlen(indexStr); buf = ckalloc(len + 1); memcpy(buf, indexStr, len+1); objPtr->bytes = buf; objPtr->length = len; } /* *---------------------------------------------------------------------- * * DupIndex -- * * This function is called to copy the internal rep of an index Tcl * object from to another object. * * Results: * None. * * Side effects: * The internal representation of the target object is updated and the * type is set. * *---------------------------------------------------------------------- */ static void DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { IndexRep *srcIndexRep = (IndexRep *)srcPtr->internalRep.twoPtrValue.ptr1; IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep)); memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep; dupPtr->typePtr = &indexType; } /* *---------------------------------------------------------------------- * * FreeIndex -- * * This function is called to delete the internal rep of an index Tcl * object. * * Results: * None. * * Side effects: * The internal representation of the target object is deleted. * *---------------------------------------------------------------------- */ static void FreeIndex( Tcl_Obj *objPtr) { ckfree(objPtr->internalRep.twoPtrValue.ptr1); objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * TclInitPrefixCmd -- * * This procedure creates the "prefix" Tcl command. See the user * documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ Tcl_Command TclInitPrefixCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap prefixImplMap[] = { {"all", PrefixAllObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"longest", PrefixLongestObjCmd,TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"match", PrefixMatchObjCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; Tcl_Command prefixCmd; prefixCmd = TclMakeEnsemble(interp, "::tcl::prefix", prefixImplMap); Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0), "prefix", 0); return prefixCmd; } /*---------------------------------------------------------------------- * * PrefixMatchObjCmd -- * * This function implements the 'prefix match' Tcl command. Refer to the * user documentation for details on what it does. * * Results: * Returns a standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PrefixMatchObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int flags = 0, result, index; int dummyLength, i, errorLength; Tcl_Obj *errorPtr = NULL; const char *message = "option"; Tcl_Obj *tablePtr, *objPtr, *resultPtr; static const char *const matchOptions[] = { "-error", "-exact", "-message", NULL }; enum matchOptionsEnum { PRFMATCH_ERROR, PRFMATCH_EXACT, PRFMATCH_MESSAGE }; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? table string"); return TCL_ERROR; } for (i = 1; i < (objc - 2); i++) { if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum matchOptionsEnum) index) { case PRFMATCH_EXACT: flags |= TCL_EXACT; break; case PRFMATCH_MESSAGE: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value for -message", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; message = Tcl_GetString(objv[i]); break; case PRFMATCH_ERROR: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value for -error", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; result = TclListObjLength(interp, objv[i], &errorLength); if (result != TCL_OK) { return TCL_ERROR; } if ((errorLength % 2) != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "error options must have an even number of elements", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); return TCL_ERROR; } errorPtr = objv[i]; break; } } tablePtr = objv[objc - 2]; objPtr = objv[objc - 1]; /* * Check that table is a valid list first, since we want to handle that * error case regardless of level. */ result = TclListObjLength(interp, tablePtr, &dummyLength); if (result != TCL_OK) { return result; } result = GetIndexFromObjList(interp, objPtr, tablePtr, message, flags, &index); if (result != TCL_OK) { if (errorPtr != NULL && errorLength == 0) { Tcl_ResetResult(interp); return TCL_OK; } else if (errorPtr == NULL) { return TCL_ERROR; } if (Tcl_IsShared(errorPtr)) { errorPtr = Tcl_DuplicateObj(errorPtr); } Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewStringObj("-code", 5)); Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewIntObj(result)); return Tcl_SetReturnOptions(interp, errorPtr); } result = Tcl_ListObjIndex(interp, tablePtr, index, &resultPtr); if (result != TCL_OK) { return result; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /*---------------------------------------------------------------------- * * PrefixAllObjCmd -- * * This function implements the 'prefix all' Tcl command. Refer to the * user documentation for details on what it does. * * Results: * Returns a standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PrefixAllObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int tableObjc, result, t, length, elemLength; const char *string, *elemString; Tcl_Obj **tableObjv, *resultPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "table string"); return TCL_ERROR; } result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } resultPtr = Tcl_NewListObj(0, NULL); string = Tcl_GetStringFromObj(objv[2], &length); for (t = 0; t < tableObjc; t++) { elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength); /* * A prefix cannot match if it is longest. */ if (length <= elemLength) { if (TclUtfNcmp2(elemString, string, length) == 0) { Tcl_ListObjAppendElement(interp, resultPtr, tableObjv[t]); } } } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /*---------------------------------------------------------------------- * * PrefixLongestObjCmd -- * * This function implements the 'prefix longest' Tcl command. Refer to * the user documentation for details on what it does. * * Results: * Returns a standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PrefixLongestObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int tableObjc, result, i, t, length, elemLength, resultLength; const char *string, *elemString, *resultString; Tcl_Obj **tableObjv; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "table string"); return TCL_ERROR; } result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } string = Tcl_GetStringFromObj(objv[2], &length); resultString = NULL; resultLength = 0; for (t = 0; t < tableObjc; t++) { elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength); /* * First check if the prefix string matches the element. A prefix * cannot match if it is longest. */ if ((length > elemLength) || TclUtfNcmp2(elemString, string, length) != 0) { continue; } if (resultString == NULL) { /* * If this is the first match, the longest common substring this * far is the complete string. The result is part of this string * so we only need to adjust the length later. */ resultString = elemString; resultLength = elemLength; } else { /* * Longest common substring cannot be longer than shortest string. */ if (elemLength < resultLength) { resultLength = elemLength; } /* * Compare strings. */ for (i = 0; i < resultLength; i++) { if (resultString[i] != elemString[i]) { /* * Adjust in case we stopped in the middle of a UTF char. */ resultLength = TclUtfPrev(&resultString[i+1], resultString) - resultString; break; } } } } if (resultLength > 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj(resultString, resultLength)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_WrongNumArgs -- * * This function generates a "wrong # args" error message in an * interpreter. It is used as a utility function by many command * functions, including the function that implements procedures. * * Results: * None. * * Side effects: * An error message is generated in interp's result object to indicate * that a command was invoked with the wrong number of arguments. The * message has the form * wrong # args: should be "foo bar additional stuff" * where "foo" and "bar" are the initial objects in objv (objc determines * how many of these are printed) and "additional stuff" is the contents * of the message argument. * * The message printed is modified somewhat if the command is wrapped * inside an ensemble. In that case, the error message generated is * rewritten in such a way that it appears to be generated from the * user-visible command and not how that command is actually implemented, * giving a better overall user experience. * * Internally, the Tcl core may set the flag INTERP_ALTERNATE_WRONG_ARGS * in the interpreter to generate complex multi-part messages by calling * this function repeatedly. This allows the code that knows how to * handle ensemble-related error messages to be kept here while still * generating suitable error messages for commands like [read] and * [socket]. Ideally, this would be done through an extra flags argument, * but that wouldn't be source-compatible with the existing API and it's * a fairly rare requirement anyway. * *---------------------------------------------------------------------- */ void Tcl_WrongNumArgs( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments to print from objv. */ Tcl_Obj *const objv[], /* Initial argument objects, which should be * included in the error message. */ const char *message) /* Error message to print after the leading * objects in objv. The message may be * NULL. */ { Tcl_Obj *objPtr; int i, len, elemLen; char flags; Interp *iPtr = (Interp *) interp; const char *elementStr; /* * [incr Tcl] does something fairly horrific when generating error * messages for its ensembles; it passes the whole set of ensemble * arguments as a list in the first argument. This means that this code * causes a problem in iTcl if it attempts to correctly quote all * arguments, which would be the correct thing to do. We work around this * nasty behaviour for now, and hope that we can remove it all in the * future... */ #ifndef AVOID_HACKS_FOR_ITCL int isFirst = 1; /* Special flag used to inhibit the treating * of the first word as a list element so the * hacky way Itcl generates error messages for * its ensembles will still work. [Bug * 1066837] */ # define MAY_QUOTE_WORD (!isFirst) # define AFTER_FIRST_WORD (isFirst = 0) #else /* !AVOID_HACKS_FOR_ITCL */ # define MAY_QUOTE_WORD 1 # define AFTER_FIRST_WORD (void) 0 #endif /* AVOID_HACKS_FOR_ITCL */ TclNewObj(objPtr); if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp)); Tcl_AppendToObj(objPtr, " or \"", -1); } else { Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); } /* * If processing an an ensemble implementation, rewrite the results in * terms of how the ensemble was invoked. */ if (iPtr->ensembleRewrite.sourceObjs != NULL) { int toSkip = iPtr->ensembleRewrite.numInsertedObjs; int toPrint = iPtr->ensembleRewrite.numRemovedObjs; Tcl_Obj *const *origObjv = TclEnsembleGetRewriteValues(interp); /* * Only do rewrite the command if all the replaced objects are * actually arguments (in objv) to this function. Otherwise it just * gets too complicated and it's to just give a slightly * confusing error message... */ if (objc < toSkip) { goto addNormalArgumentsToMessage; } /* * Strip out the actual arguments that the ensemble inserted. */ objv += toSkip; objc -= toSkip; /* * We assume no object is of index type. */ for (i=0 ; itypePtr == &indexType) { IndexRep *indexRep = origObjv[i]->internalRep.twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { elementStr = TclGetStringFromObj(origObjv[i], &elemLen); } flags = 0; len = TclScanElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); Tcl_AppendToObj(objPtr, quotedElementStr, len); TclStackFree(interp, quotedElementStr); } else { Tcl_AppendToObj(objPtr, elementStr, elemLen); } AFTER_FIRST_WORD; /* * Add a space if the word is not the last one (which has a * moderately complex condition here). */ if (itypePtr == &indexType) { IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). */ elementStr = TclGetStringFromObj(objv[i], &elemLen); flags = 0; len = TclScanElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); Tcl_AppendToObj(objPtr, quotedElementStr, len); TclStackFree(interp, quotedElementStr); } else { Tcl_AppendToObj(objPtr, elementStr, elemLen); } } AFTER_FIRST_WORD; /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). */ if (i 0) { curArg = objv[srcIndex]; srcIndex++; objc--; str = Tcl_GetStringFromObj(curArg, &length); if (length > 0) { c = str[1]; } else { c = 0; } /* * Loop throught the argument descriptors searching for one with the * matching key string. If found, leave a pointer to it in matchPtr. */ matchPtr = NULL; infoPtr = argTable; for (; infoPtr != NULL && infoPtr->type != TCL_ARGV_END ; infoPtr++) { if (infoPtr->keyStr == NULL) { continue; } if ((infoPtr->keyStr[1] != c) || (strncmp(infoPtr->keyStr, str, length) != 0)) { continue; } if (infoPtr->keyStr[length] == 0) { matchPtr = infoPtr; goto gotMatch; } if (matchPtr != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "ambiguous option \"%s\"", str)); goto error; } matchPtr = infoPtr; } if (matchPtr == NULL) { /* * Unrecognized argument. Just copy it down, unless the caller * prefers an error to be registered. */ if (remObjv == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unrecognized argument \"%s\"", str)); goto error; } dstIndex++; /* This argument is now handled */ leftovers[nrem++] = curArg; continue; } /* * Take the appropriate action based on the option type */ gotMatch: infoPtr = matchPtr; switch (infoPtr->type) { case TCL_ARGV_CONSTANT: *((int *) infoPtr->dstPtr) = PTR2INT(infoPtr->srcPtr); break; case TCL_ARGV_INT: if (objc == 0) { goto missingArg; } if (Tcl_GetIntFromObj(interp, objv[srcIndex], (int *) infoPtr->dstPtr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer argument for \"%s\" but got \"%s\"", infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); goto error; } srcIndex++; objc--; break; case TCL_ARGV_STRING: if (objc == 0) { goto missingArg; } *((const char **) infoPtr->dstPtr) = Tcl_GetString(objv[srcIndex]); srcIndex++; objc--; break; case TCL_ARGV_REST: /* * Only store the point where we got to if it's not to be written * to NULL, so that TCL_ARGV_AUTO_REST works. */ if (infoPtr->dstPtr != NULL) { *((int *) infoPtr->dstPtr) = dstIndex; } goto argsDone; case TCL_ARGV_FLOAT: if (objc == 0) { goto missingArg; } if (Tcl_GetDoubleFromObj(interp, objv[srcIndex], (double *) infoPtr->dstPtr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected floating-point argument for \"%s\" but got \"%s\"", infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); goto error; } srcIndex++; objc--; break; case TCL_ARGV_FUNC: { Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *) infoPtr->srcPtr; Tcl_Obj *argObj; if (objc == 0) { argObj = NULL; } else { argObj = objv[srcIndex]; } if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) { srcIndex++; objc--; } break; } case TCL_ARGV_GENFUNC: { Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr; objc = handlerProc(infoPtr->clientData, interp, objc, &objv[srcIndex], infoPtr->dstPtr); if (objc < 0) { goto error; } break; } case TCL_ARGV_HELP: PrintUsage(interp, argTable); goto error; default: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument type %d in Tcl_ArgvInfo", infoPtr->type)); goto error; } } /* * If we broke out of the loop because of an OPT_REST argument, copy the * remaining arguments down. Note that there is always at least one * argument left over - the command name - so we always have a result if * our caller is willing to receive it. [Bug 3413857] */ argsDone: if (remObjv == NULL) { /* * Nothing to do. */ return TCL_OK; } if (objc > 0) { memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *)); nrem += objc; } leftovers[nrem] = NULL; *objcPtr = nrem++; *remObjv = (Tcl_Obj **)ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *)); return TCL_OK; /* * Make sure to handle freeing any temporary space we've allocated on the * way to an error. */ missingArg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" option requires an additional argument", str)); error: if (leftovers != NULL) { ckfree(leftovers); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * PrintUsage -- * * Generate a help string describing command-line options. * * Results: * The interp's result will be modified to hold a help string describing * all the options in argTable. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ const Tcl_ArgvInfo *argTable) /* Array of command-specific argument * descriptions. */ { const Tcl_ArgvInfo *infoPtr; int width, numSpaces; #define NUM_SPACES 20 static const char spaces[] = " "; Tcl_Obj *msg; /* * First, compute the width of the widest option key, so that we can make * everything line up. */ width = 4; for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { int length; if (infoPtr->keyStr == NULL) { continue; } length = strlen(infoPtr->keyStr); if (length > width) { width = length; } } /* * Now add the option information, with pretty-printing. */ msg = Tcl_NewStringObj("Command-specific options:", -1); for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) { Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr); continue; } Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr); numSpaces = width + 1 - strlen(infoPtr->keyStr); while (numSpaces > 0) { if (numSpaces >= NUM_SPACES) { Tcl_AppendToObj(msg, spaces, NUM_SPACES); } else { Tcl_AppendToObj(msg, spaces, numSpaces); } numSpaces -= NUM_SPACES; } Tcl_AppendToObj(msg, infoPtr->helpStr, -1); switch (infoPtr->type) { case TCL_ARGV_INT: Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d", *((int *) infoPtr->dstPtr)); break; case TCL_ARGV_FLOAT: Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g", *((double *) infoPtr->dstPtr)); break; case TCL_ARGV_STRING: { char *string = *((char **) infoPtr->dstPtr); if (string != NULL) { Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"", string); } break; } default: break; } } Tcl_SetObjResult(interp, msg); } /* *---------------------------------------------------------------------- * * TclGetCompletionCodeFromObj -- * * Parses Completion code Code * * Results: * Returns TCL_ERROR if the value is an invalid completion code. * Otherwise, returns TCL_OK, and writes the completion code to the * pointer provided. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGetCompletionCodeFromObj( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *value, int *codePtr) /* Argument objects. */ { static const char *const returnCodes[] = { "ok", "error", "return", "break", "continue", NULL }; if ((value->typePtr != &indexType) && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) { return TCL_OK; } if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT, codePtr) == TCL_OK) { return TCL_OK; } /* * Value is not a legal completion code. */ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad completion code \"%s\": must be" " ok, error, return, break, continue, or an integer", TclGetString(value))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL); } return TCL_ERROR; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclIntDecls.h0000644000175000017500000015721114566153373015656 0ustar sergeisergei/* * tclIntDecls.h -- * * This file contains the declarations for all unsupported * functions that are exported by the Tcl library. These * interfaces are not guaranteed to remain the same between * versions. Use at your own risk. * * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLINTDECLS #define _TCLINTDECLS #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */ #undef Tcl_CreateNamespace #undef Tcl_DeleteNamespace #undef Tcl_AppendExportList #undef Tcl_Export #undef Tcl_Import #undef Tcl_ForgetImport #undef Tcl_GetCurrentNamespace #undef Tcl_GetGlobalNamespace #undef Tcl_FindNamespace #undef Tcl_FindCommand #undef Tcl_GetCommandFromObj #undef Tcl_GetCommandFullName #undef Tcl_SetStartupScript #undef Tcl_GetStartupScript /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tclInt.decls script. */ /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ /* Slot 0 is reserved */ /* Slot 1 is reserved */ /* Slot 2 is reserved */ /* 3 */ EXTERN void TclAllocateFreeObjects(void); /* Slot 4 is reserved */ /* 5 */ EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 6 */ EXTERN void TclCleanupCommand(Command *cmdPtr); /* 7 */ EXTERN int TclCopyAndCollapse(int count, const char *src, char *dst); /* 8 */ EXTERN int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 9 */ EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 10 */ EXTERN int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 11 */ EXTERN void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr); /* 12 */ EXTERN void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr); /* Slot 13 is reserved */ /* 14 */ EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags); /* Slot 15 is reserved */ /* 16 */ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ /* 22 */ EXTERN int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ EXTERN int TclFormatInt(char *buffer, long n); /* 25 */ EXTERN void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* 28 */ EXTERN Tcl_Channel TclpGetDefaultStdChannel(int type); /* Slot 29 is reserved */ /* Slot 30 is reserved */ /* 31 */ EXTERN const char * TclGetExtension(const char *name); /* 32 */ EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ /* 34 */ EXTERN int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* 37 */ EXTERN int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName); /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 39 */ EXTERN Tcl_ObjCmdProc * TclGetObjInterpProc(void); /* 40 */ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN CONST86 char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ /* 44 */ EXTERN int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr); /* 45 */ EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); /* 46 */ EXTERN int TclInExit(void); /* Slot 47 is reserved */ /* Slot 48 is reserved */ /* Slot 49 is reserved */ /* 50 */ EXTERN void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 51 */ EXTERN int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ EXTERN int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 54 */ EXTERN int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 55 */ EXTERN Proc * TclIsProc(Command *cmdPtr); /* Slot 56 is reserved */ /* Slot 57 is reserved */ /* 58 */ EXTERN Var * TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* Slot 59 is reserved */ /* 60 */ EXTERN int TclNeedSpace(const char *start, const char *end); /* 61 */ EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); /* 62 */ EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr); /* 63 */ EXTERN int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 64 */ EXTERN int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* Slot 65 is reserved */ /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ /* 69 */ EXTERN char * TclpAlloc(unsigned int size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ EXTERN void TclpFree(char *ptr); /* 75 */ EXTERN unsigned long TclpGetClicks(void); /* 76 */ EXTERN unsigned long TclpGetSeconds(void); /* 77 */ EXTERN void TclpGetTime(Tcl_Time *time); /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ EXTERN char * TclpRealloc(char *ptr, unsigned int size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ /* 88 */ EXTERN char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 89 */ EXTERN int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* Slot 90 is reserved */ /* 91 */ EXTERN void TclProcCleanupProc(Proc *procPtr); /* 92 */ EXTERN int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 93 */ EXTERN void TclProcDeleteProc(ClientData clientData); /* Slot 94 is reserved */ /* Slot 95 is reserved */ /* 96 */ EXTERN int TclRenameCommand(Tcl_Interp *interp, const char *oldName, const char *newName); /* 97 */ EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr); /* 98 */ EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* 101 */ EXTERN CONST86 char * TclSetPreInitScript(const char *string); /* 102 */ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 104 */ EXTERN int TclSockMinimumBuffersOld(int sock, int size); /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ /* 108 */ EXTERN void TclTeardownNamespace(Namespace *nsPtr); /* 109 */ EXTERN int TclUpdateReturnInfo(Interp *iPtr); /* 110 */ EXTERN int TclSockMinimumBuffers(void *sock, int size); /* 111 */ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 112 */ EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 113 */ EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 114 */ EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); /* 115 */ EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 116 */ EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 118 */ EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 119 */ EXTERN int Tcl_GetNamespaceResolvers( Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 120 */ EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 121 */ EXTERN int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 122 */ EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 123 */ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 124 */ EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); /* 125 */ EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); /* 126 */ EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 127 */ EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 128 */ EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp); /* 129 */ EXTERN int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 130 */ EXTERN int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name); /* 131 */ EXTERN void Tcl_SetNamespaceResolvers( Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ EXTERN int TclpHasSockets(Tcl_Interp *interp); /* 133 */ EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT); /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ /* Slot 137 is reserved */ /* 138 */ EXTERN CONST84_RETURN char * TclGetEnv(const char *name, Tcl_DString *valuePtr); /* Slot 139 is reserved */ /* Slot 140 is reserved */ /* 141 */ EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 142 */ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 143 */ EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 144 */ EXTERN void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 145 */ EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName); /* 146 */ EXTERN TclHandle TclHandleCreate(void *ptr); /* 147 */ EXTERN void TclHandleFree(TclHandle handle); /* 148 */ EXTERN TclHandle TclHandlePreserve(TclHandle handle); /* 149 */ EXTERN void TclHandleRelease(TclHandle handle); /* 150 */ EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 152 */ EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); /* 153 */ EXTERN Tcl_Obj * TclGetLibraryPath(void); /* Slot 154 is reserved */ /* Slot 155 is reserved */ /* 156 */ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, int status); /* 157 */ EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); /* 158 */ EXTERN void TclSetStartupScriptFileName(const char *filename); /* 159 */ EXTERN const char * TclGetStartupScriptFileName(void); /* Slot 160 is reserved */ /* 161 */ EXTERN int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 162 */ EXTERN void TclChannelEventScriptInvoker(ClientData clientData, int flags); /* 163 */ EXTERN const void * TclGetInstructionTable(void); /* 164 */ EXTERN void TclExpandCodeArray(void *envPtr); /* 165 */ EXTERN void TclpSetInitialEncodings(void); /* 166 */ EXTERN int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 167 */ EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr); /* 168 */ EXTERN Tcl_Obj * TclGetStartupScriptPath(void); /* 169 */ EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n); /* 170 */ EXTERN int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ EXTERN int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 172 */ EXTERN int TclInThreadExit(void); /* 173 */ EXTERN int TclUniCharMatch(const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* Slot 174 is reserved */ /* 175 */ EXTERN int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 176 */ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); /* 177 */ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 178 */ EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName); /* 179 */ EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr); /* Slot 180 is reserved */ /* Slot 181 is reserved */ /* 182 */ EXTERN struct tm * TclpLocaltime(const time_t *clock); /* 183 */ EXTERN struct tm * TclpGmtime(const time_t *clock); /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ /* Slot 187 is reserved */ /* Slot 188 is reserved */ /* Slot 189 is reserved */ /* Slot 190 is reserved */ /* Slot 191 is reserved */ /* Slot 192 is reserved */ /* Slot 193 is reserved */ /* Slot 194 is reserved */ /* Slot 195 is reserved */ /* Slot 196 is reserved */ /* Slot 197 is reserved */ /* 198 */ EXTERN int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr); /* Slot 199 is reserved */ /* 200 */ EXTERN int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 201 */ EXTERN int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 202 */ EXTERN int TclpObjCreateDirectory(Tcl_Obj *pathPtr); /* 203 */ EXTERN int TclpObjDeleteFile(Tcl_Obj *pathPtr); /* 204 */ EXTERN int TclpObjCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 205 */ EXTERN int TclpObjRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 206 */ EXTERN int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 207 */ EXTERN int TclpObjAccess(Tcl_Obj *pathPtr, int mode); /* 208 */ EXTERN Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* Slot 209 is reserved */ /* Slot 210 is reserved */ /* Slot 211 is reserved */ /* 212 */ EXTERN void TclpFindExecutable(const char *argv0); /* 213 */ EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void); /* 214 */ EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding); /* 215 */ EXTERN void * TclStackAlloc(Tcl_Interp *interp, int numBytes); /* 216 */ EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr); /* 217 */ EXTERN int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 218 */ EXTERN void TclPopStackFrame(Tcl_Interp *interp); /* Slot 219 is reserved */ /* Slot 220 is reserved */ /* Slot 221 is reserved */ /* Slot 222 is reserved */ /* 223 */ EXTERN void * TclGetCStackPtr(void); /* 224 */ EXTERN TclPlatformType * TclGetPlatform(void); /* 225 */ EXTERN Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 226 */ EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ EXTERN int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 230 */ EXTERN Var * TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 231 */ EXTERN int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 232 */ EXTERN int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 233 */ EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr); /* 234 */ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); /* 236 */ EXTERN void TclBackgroundException(Tcl_Interp *interp, int code); /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ EXTERN int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 239 */ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 240 */ EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 241 */ EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 242 */ EXTERN int TclNREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 243 */ EXTERN void TclDbDumpActiveObjects(FILE *outFile); /* 244 */ EXTERN Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr); /* 245 */ EXTERN Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr); /* 246 */ EXTERN int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 247 */ EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble); /* 248 */ EXTERN int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 249 */ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 250 */ EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force); /* 251 */ EXTERN int TclRegisterLiteral(void *envPtr, char *bytes, int length, int flags); /* 252 */ EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 253 */ EXTERN Tcl_Obj * TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 254 */ EXTERN Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); /* 255 */ EXTERN int TclPtrObjMakeUpvar(Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 256 */ EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 257 */ EXTERN void TclStaticPackage(Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* Slot 258 is reserved */ /* Slot 259 is reserved */ /* Slot 260 is reserved */ /* 261 */ EXTERN void TclUnusedStubEntry(void); typedef struct TclIntStubs { int magic; void *hooks; void (*reserved0)(void); void (*reserved1)(void); void (*reserved2)(void); void (*tclAllocateFreeObjects) (void); /* 3 */ void (*reserved4)(void); int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */ int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */ int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */ int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */ void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */ void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */ void (*reserved13)(void); int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */ void (*reserved15)(void); void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */ void (*reserved17)(void); void (*reserved18)(void); void (*reserved19)(void); void (*reserved20)(void); void (*reserved21)(void); int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */ Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */ int (*tclFormatInt) (char *buffer, long n); /* 24 */ void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */ void (*reserved26)(void); void (*reserved27)(void); Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */ void (*reserved29)(void); void (*reserved30)(void); const char * (*tclGetExtension) (const char *name); /* 31 */ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */ void (*reserved33)(void); int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */ void (*reserved35)(void); void (*reserved36)(void); int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */ int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ Tcl_ObjCmdProc * (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ void (*reserved43)(void); int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */ int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ int (*tclInExit) (void); /* 46 */ void (*reserved47)(void); void (*reserved48)(void); void (*reserved49)(void); void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */ int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */ void (*reserved56)(void); void (*reserved57)(void); Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */ void (*reserved59)(void); int (*tclNeedSpace) (const char *start, const char *end); /* 60 */ Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */ int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */ int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */ void (*reserved65)(void); void (*reserved66)(void); void (*reserved67)(void); void (*reserved68)(void); char * (*tclpAlloc) (unsigned int size); /* 69 */ void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); void (*tclpFree) (char *ptr); /* 74 */ unsigned long (*tclpGetClicks) (void); /* 75 */ unsigned long (*tclpGetSeconds) (void); /* 76 */ void (*tclpGetTime) (Tcl_Time *time); /* 77 */ void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */ void (*reserved82)(void); void (*reserved83)(void); void (*reserved84)(void); void (*reserved85)(void); void (*reserved86)(void); void (*reserved87)(void); char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */ void (*reserved90)(void); void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */ int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */ void (*tclProcDeleteProc) (ClientData clientData); /* 93 */ void (*reserved94)(void); void (*reserved95)(void); int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */ void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */ int (*tclServiceIdle) (void); /* 98 */ void (*reserved99)(void); void (*reserved100)(void); CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */ void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */ void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */ int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */ void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */ int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */ Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */ void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */ int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */ Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */ int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */ Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */ Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */ Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */ void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */ int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */ void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */ int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */ int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); void (*reserved137)(void); CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */ void (*reserved139)(void); void (*reserved140)(void); CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */ TclHandle (*tclHandleCreate) (void *ptr); /* 146 */ void (*tclHandleFree) (TclHandle handle); /* 147 */ TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */ void (*tclHandleRelease) (TclHandle handle); /* 149 */ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */ void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */ void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */ Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */ void (*reserved154)(void); void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */ void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */ const char * (*tclGetStartupScriptFileName) (void); /* 159 */ void (*reserved160)(void); int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */ void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */ const void * (*tclGetInstructionTable) (void); /* 163 */ void (*tclExpandCodeArray) (void *envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */ Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */ int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ int (*tclInThreadExit) (void); /* 172 */ int (*tclUniCharMatch) (const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */ void (*reserved174)(void); int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */ void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */ void (*reserved180)(void); void (*reserved181)(void); struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */ void (*reserved184)(void); void (*reserved185)(void); void (*reserved186)(void); void (*reserved187)(void); void (*reserved188)(void); void (*reserved189)(void); void (*reserved190)(void); void (*reserved191)(void); void (*reserved192)(void); void (*reserved193)(void); void (*reserved194)(void); void (*reserved195)(void); void (*reserved196)(void); void (*reserved197)(void); int (*tclObjGetFrame) (Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr); /* 198 */ void (*reserved199)(void); int (*tclpObjRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 200 */ int (*tclpObjCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 201 */ int (*tclpObjCreateDirectory) (Tcl_Obj *pathPtr); /* 202 */ int (*tclpObjDeleteFile) (Tcl_Obj *pathPtr); /* 203 */ int (*tclpObjCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 204 */ int (*tclpObjRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 205 */ int (*tclpObjStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 206 */ int (*tclpObjAccess) (Tcl_Obj *pathPtr, int mode); /* 207 */ Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */ void (*reserved209)(void); void (*reserved210)(void); void (*reserved211)(void); void (*tclpFindExecutable) (const char *argv0); /* 212 */ Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */ void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */ void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */ void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */ int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */ void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */ void (*reserved219)(void); void (*reserved220)(void); void (*reserved221)(void); void (*reserved222)(void); void * (*tclGetCStackPtr) (void); /* 223 */ TclPlatformType * (*tclGetPlatform) (void); /* 224 */ Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */ int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */ void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */ void (*reserved228)(void); int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 230 */ int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */ int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */ void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */ int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */ int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */ int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */ void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */ Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */ Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */ int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */ void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */ int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */ char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */ Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ void (*reserved258)(void); void (*reserved259)(void); void (*reserved260)(void); void (*tclUnusedStubEntry) (void); /* 261 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) /* * Inline function declarations: */ /* Slot 0 is reserved */ /* Slot 1 is reserved */ /* Slot 2 is reserved */ #define TclAllocateFreeObjects \ (tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */ /* Slot 4 is reserved */ #define TclCleanupChildren \ (tclIntStubsPtr->tclCleanupChildren) /* 5 */ #define TclCleanupCommand \ (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ #define TclCopyChannelOld \ (tclIntStubsPtr->tclCopyChannelOld) /* 8 */ #define TclCreatePipeline \ (tclIntStubsPtr->tclCreatePipeline) /* 9 */ #define TclCreateProc \ (tclIntStubsPtr->tclCreateProc) /* 10 */ #define TclDeleteCompiledLocalVars \ (tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */ #define TclDeleteVars \ (tclIntStubsPtr->tclDeleteVars) /* 12 */ /* Slot 13 is reserved */ #define TclDumpMemoryInfo \ (tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */ /* Slot 15 is reserved */ #define TclExprFloatError \ (tclIntStubsPtr->tclExprFloatError) /* 16 */ /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ #define TclFindElement \ (tclIntStubsPtr->tclFindElement) /* 22 */ #define TclFindProc \ (tclIntStubsPtr->tclFindProc) /* 23 */ #define TclFormatInt \ (tclIntStubsPtr->tclFormatInt) /* 24 */ #define TclFreePackageInfo \ (tclIntStubsPtr->tclFreePackageInfo) /* 25 */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ #define TclpGetDefaultStdChannel \ (tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */ /* Slot 29 is reserved */ /* Slot 30 is reserved */ #define TclGetExtension \ (tclIntStubsPtr->tclGetExtension) /* 31 */ #define TclGetFrame \ (tclIntStubsPtr->tclGetFrame) /* 32 */ /* Slot 33 is reserved */ #define TclGetIntForIndex \ (tclIntStubsPtr->tclGetIntForIndex) /* 34 */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ #define TclGetLoadedPackages \ (tclIntStubsPtr->tclGetLoadedPackages) /* 37 */ #define TclGetNamespaceForQualName \ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ #define TclGetObjInterpProc \ (tclIntStubsPtr->tclGetObjInterpProc) /* 39 */ #define TclGetOpenMode \ (tclIntStubsPtr->tclGetOpenMode) /* 40 */ #define TclGetOriginalCommand \ (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ /* Slot 43 is reserved */ #define TclGuessPackageName \ (tclIntStubsPtr->tclGuessPackageName) /* 44 */ #define TclHideUnsafeCommands \ (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */ #define TclInExit \ (tclIntStubsPtr->tclInExit) /* 46 */ /* Slot 47 is reserved */ /* Slot 48 is reserved */ /* Slot 49 is reserved */ #define TclInitCompiledLocals \ (tclIntStubsPtr->tclInitCompiledLocals) /* 50 */ #define TclInterpInit \ (tclIntStubsPtr->tclInterpInit) /* 51 */ /* Slot 52 is reserved */ #define TclInvokeObjectCommand \ (tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */ #define TclInvokeStringCommand \ (tclIntStubsPtr->tclInvokeStringCommand) /* 54 */ #define TclIsProc \ (tclIntStubsPtr->tclIsProc) /* 55 */ /* Slot 56 is reserved */ /* Slot 57 is reserved */ #define TclLookupVar \ (tclIntStubsPtr->tclLookupVar) /* 58 */ /* Slot 59 is reserved */ #define TclNeedSpace \ (tclIntStubsPtr->tclNeedSpace) /* 60 */ #define TclNewProcBodyObj \ (tclIntStubsPtr->tclNewProcBodyObj) /* 61 */ #define TclObjCommandComplete \ (tclIntStubsPtr->tclObjCommandComplete) /* 62 */ #define TclObjInterpProc \ (tclIntStubsPtr->tclObjInterpProc) /* 63 */ #define TclObjInvoke \ (tclIntStubsPtr->tclObjInvoke) /* 64 */ /* Slot 65 is reserved */ /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ #define TclpAlloc \ (tclIntStubsPtr->tclpAlloc) /* 69 */ /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ #define TclpFree \ (tclIntStubsPtr->tclpFree) /* 74 */ #define TclpGetClicks \ (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ (tclIntStubsPtr->tclpGetSeconds) /* 76 */ #define TclpGetTime \ (tclIntStubsPtr->tclpGetTime) /* 77 */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ #define TclpRealloc \ (tclIntStubsPtr->tclpRealloc) /* 81 */ /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ #define TclPrecTraceProc \ (tclIntStubsPtr->tclPrecTraceProc) /* 88 */ #define TclPreventAliasLoop \ (tclIntStubsPtr->tclPreventAliasLoop) /* 89 */ /* Slot 90 is reserved */ #define TclProcCleanupProc \ (tclIntStubsPtr->tclProcCleanupProc) /* 91 */ #define TclProcCompileProc \ (tclIntStubsPtr->tclProcCompileProc) /* 92 */ #define TclProcDeleteProc \ (tclIntStubsPtr->tclProcDeleteProc) /* 93 */ /* Slot 94 is reserved */ /* Slot 95 is reserved */ #define TclRenameCommand \ (tclIntStubsPtr->tclRenameCommand) /* 96 */ #define TclResetShadowedCmdRefs \ (tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */ #define TclServiceIdle \ (tclIntStubsPtr->tclServiceIdle) /* 98 */ /* Slot 99 is reserved */ /* Slot 100 is reserved */ #define TclSetPreInitScript \ (tclIntStubsPtr->tclSetPreInitScript) /* 101 */ #define TclSetupEnv \ (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ #define TclSockMinimumBuffersOld \ (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ #define TclTeardownNamespace \ (tclIntStubsPtr->tclTeardownNamespace) /* 108 */ #define TclUpdateReturnInfo \ (tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */ #define TclSockMinimumBuffers \ (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ #define Tcl_AppendExportList \ (tclIntStubsPtr->tcl_AppendExportList) /* 112 */ #define Tcl_CreateNamespace \ (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */ #define Tcl_DeleteNamespace \ (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */ #define Tcl_Export \ (tclIntStubsPtr->tcl_Export) /* 115 */ #define Tcl_FindCommand \ (tclIntStubsPtr->tcl_FindCommand) /* 116 */ #define Tcl_FindNamespace \ (tclIntStubsPtr->tcl_FindNamespace) /* 117 */ #define Tcl_GetInterpResolvers \ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ #define Tcl_GetNamespaceResolvers \ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ #define Tcl_FindNamespaceVar \ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ #define Tcl_ForgetImport \ (tclIntStubsPtr->tcl_ForgetImport) /* 121 */ #define Tcl_GetCommandFromObj \ (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */ #define Tcl_GetCommandFullName \ (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */ #define Tcl_GetCurrentNamespace \ (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */ #define Tcl_GetGlobalNamespace \ (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */ #define Tcl_GetVariableFullName \ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ #define Tcl_Import \ (tclIntStubsPtr->tcl_Import) /* 127 */ #define Tcl_PopCallFrame \ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ #define Tcl_PushCallFrame \ (tclIntStubsPtr->tcl_PushCallFrame) /* 129 */ #define Tcl_RemoveInterpResolvers \ (tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */ #define Tcl_SetNamespaceResolvers \ (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ #define TclpGetDate \ (tclIntStubsPtr->tclpGetDate) /* 133 */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ /* Slot 137 is reserved */ #define TclGetEnv \ (tclIntStubsPtr->tclGetEnv) /* 138 */ /* Slot 139 is reserved */ /* Slot 140 is reserved */ #define TclpGetCwd \ (tclIntStubsPtr->tclpGetCwd) /* 141 */ #define TclSetByteCodeFromAny \ (tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */ #define TclAddLiteralObj \ (tclIntStubsPtr->tclAddLiteralObj) /* 143 */ #define TclHideLiteral \ (tclIntStubsPtr->tclHideLiteral) /* 144 */ #define TclGetAuxDataType \ (tclIntStubsPtr->tclGetAuxDataType) /* 145 */ #define TclHandleCreate \ (tclIntStubsPtr->tclHandleCreate) /* 146 */ #define TclHandleFree \ (tclIntStubsPtr->tclHandleFree) /* 147 */ #define TclHandlePreserve \ (tclIntStubsPtr->tclHandlePreserve) /* 148 */ #define TclHandleRelease \ (tclIntStubsPtr->tclHandleRelease) /* 149 */ #define TclRegAbout \ (tclIntStubsPtr->tclRegAbout) /* 150 */ #define TclRegExpRangeUniChar \ (tclIntStubsPtr->tclRegExpRangeUniChar) /* 151 */ #define TclSetLibraryPath \ (tclIntStubsPtr->tclSetLibraryPath) /* 152 */ #define TclGetLibraryPath \ (tclIntStubsPtr->tclGetLibraryPath) /* 153 */ /* Slot 154 is reserved */ /* Slot 155 is reserved */ #define TclRegError \ (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ #define TclSetStartupScriptFileName \ (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */ #define TclGetStartupScriptFileName \ (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */ /* Slot 160 is reserved */ #define TclChannelTransform \ (tclIntStubsPtr->tclChannelTransform) /* 161 */ #define TclChannelEventScriptInvoker \ (tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */ #define TclGetInstructionTable \ (tclIntStubsPtr->tclGetInstructionTable) /* 163 */ #define TclExpandCodeArray \ (tclIntStubsPtr->tclExpandCodeArray) /* 164 */ #define TclpSetInitialEncodings \ (tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */ #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ #define TclSetStartupScriptPath \ (tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */ #define TclGetStartupScriptPath \ (tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */ #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #define TclCheckInterpTraces \ (tclIntStubsPtr->tclCheckInterpTraces) /* 170 */ #define TclCheckExecutionTraces \ (tclIntStubsPtr->tclCheckExecutionTraces) /* 171 */ #define TclInThreadExit \ (tclIntStubsPtr->tclInThreadExit) /* 172 */ #define TclUniCharMatch \ (tclIntStubsPtr->tclUniCharMatch) /* 173 */ /* Slot 174 is reserved */ #define TclCallVarTraces \ (tclIntStubsPtr->tclCallVarTraces) /* 175 */ #define TclCleanupVar \ (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ #define Tcl_SetStartupScript \ (tclIntStubsPtr->tcl_SetStartupScript) /* 178 */ #define Tcl_GetStartupScript \ (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ #define TclpLocaltime \ (tclIntStubsPtr->tclpLocaltime) /* 182 */ #define TclpGmtime \ (tclIntStubsPtr->tclpGmtime) /* 183 */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ /* Slot 187 is reserved */ /* Slot 188 is reserved */ /* Slot 189 is reserved */ /* Slot 190 is reserved */ /* Slot 191 is reserved */ /* Slot 192 is reserved */ /* Slot 193 is reserved */ /* Slot 194 is reserved */ /* Slot 195 is reserved */ /* Slot 196 is reserved */ /* Slot 197 is reserved */ #define TclObjGetFrame \ (tclIntStubsPtr->tclObjGetFrame) /* 198 */ /* Slot 199 is reserved */ #define TclpObjRemoveDirectory \ (tclIntStubsPtr->tclpObjRemoveDirectory) /* 200 */ #define TclpObjCopyDirectory \ (tclIntStubsPtr->tclpObjCopyDirectory) /* 201 */ #define TclpObjCreateDirectory \ (tclIntStubsPtr->tclpObjCreateDirectory) /* 202 */ #define TclpObjDeleteFile \ (tclIntStubsPtr->tclpObjDeleteFile) /* 203 */ #define TclpObjCopyFile \ (tclIntStubsPtr->tclpObjCopyFile) /* 204 */ #define TclpObjRenameFile \ (tclIntStubsPtr->tclpObjRenameFile) /* 205 */ #define TclpObjStat \ (tclIntStubsPtr->tclpObjStat) /* 206 */ #define TclpObjAccess \ (tclIntStubsPtr->tclpObjAccess) /* 207 */ #define TclpOpenFileChannel \ (tclIntStubsPtr->tclpOpenFileChannel) /* 208 */ /* Slot 209 is reserved */ /* Slot 210 is reserved */ /* Slot 211 is reserved */ #define TclpFindExecutable \ (tclIntStubsPtr->tclpFindExecutable) /* 212 */ #define TclGetObjNameOfExecutable \ (tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */ #define TclSetObjNameOfExecutable \ (tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */ #define TclStackAlloc \ (tclIntStubsPtr->tclStackAlloc) /* 215 */ #define TclStackFree \ (tclIntStubsPtr->tclStackFree) /* 216 */ #define TclPushStackFrame \ (tclIntStubsPtr->tclPushStackFrame) /* 217 */ #define TclPopStackFrame \ (tclIntStubsPtr->tclPopStackFrame) /* 218 */ /* Slot 219 is reserved */ /* Slot 220 is reserved */ /* Slot 221 is reserved */ /* Slot 222 is reserved */ #define TclGetCStackPtr \ (tclIntStubsPtr->tclGetCStackPtr) /* 223 */ #define TclGetPlatform \ (tclIntStubsPtr->tclGetPlatform) /* 224 */ #define TclTraceDictPath \ (tclIntStubsPtr->tclTraceDictPath) /* 225 */ #define TclObjBeingDeleted \ (tclIntStubsPtr->tclObjBeingDeleted) /* 226 */ #define TclSetNsPath \ (tclIntStubsPtr->tclSetNsPath) /* 227 */ /* Slot 228 is reserved */ #define TclPtrMakeUpvar \ (tclIntStubsPtr->tclPtrMakeUpvar) /* 229 */ #define TclObjLookupVar \ (tclIntStubsPtr->tclObjLookupVar) /* 230 */ #define TclGetNamespaceFromObj \ (tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */ #define TclEvalObjEx \ (tclIntStubsPtr->tclEvalObjEx) /* 232 */ #define TclGetSrcInfoForPc \ (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */ #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ #define TclBackgroundException \ (tclIntStubsPtr->tclBackgroundException) /* 236 */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ (tclIntStubsPtr->tclNRInterpProc) /* 238 */ #define TclNRInterpProcCore \ (tclIntStubsPtr->tclNRInterpProcCore) /* 239 */ #define TclNRRunCallbacks \ (tclIntStubsPtr->tclNRRunCallbacks) /* 240 */ #define TclNREvalObjEx \ (tclIntStubsPtr->tclNREvalObjEx) /* 241 */ #define TclNREvalObjv \ (tclIntStubsPtr->tclNREvalObjv) /* 242 */ #define TclDbDumpActiveObjects \ (tclIntStubsPtr->tclDbDumpActiveObjects) /* 243 */ #define TclGetNamespaceChildTable \ (tclIntStubsPtr->tclGetNamespaceChildTable) /* 244 */ #define TclGetNamespaceCommandTable \ (tclIntStubsPtr->tclGetNamespaceCommandTable) /* 245 */ #define TclInitRewriteEnsemble \ (tclIntStubsPtr->tclInitRewriteEnsemble) /* 246 */ #define TclResetRewriteEnsemble \ (tclIntStubsPtr->tclResetRewriteEnsemble) /* 247 */ #define TclCopyChannel \ (tclIntStubsPtr->tclCopyChannel) /* 248 */ #define TclDoubleDigits \ (tclIntStubsPtr->tclDoubleDigits) /* 249 */ #define TclSetSlaveCancelFlags \ (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */ #define TclRegisterLiteral \ (tclIntStubsPtr->tclRegisterLiteral) /* 251 */ #define TclPtrGetVar \ (tclIntStubsPtr->tclPtrGetVar) /* 252 */ #define TclPtrSetVar \ (tclIntStubsPtr->tclPtrSetVar) /* 253 */ #define TclPtrIncrObjVar \ (tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */ #define TclPtrObjMakeUpvar \ (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ /* Slot 258 is reserved */ /* Slot 259 is reserved */ /* Slot 260 is reserved */ #define TclUnusedStubEntry \ (tclIntStubsPtr->tclUnusedStubEntry) /* 261 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #undef TclGetStartupScriptFileName #undef TclSetStartupScriptFileName #undef TclGetStartupScriptPath #undef TclSetStartupScriptPath #undef TclBackgroundException #undef TclUnusedStubEntry #undef TclObjInterpProc #define TclObjInterpProc TclGetObjInterpProc() #if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED) # undef Tcl_SetStartupScript # define Tcl_SetStartupScript \ (tclStubsPtr->tcl_SetStartupScript) /* 622 */ # undef Tcl_GetStartupScript # define Tcl_GetStartupScript \ (tclStubsPtr->tcl_GetStartupScript) /* 623 */ # undef Tcl_CreateNamespace # define Tcl_CreateNamespace \ (tclStubsPtr->tcl_CreateNamespace) /* 506 */ # undef Tcl_DeleteNamespace # define Tcl_DeleteNamespace \ (tclStubsPtr->tcl_DeleteNamespace) /* 507 */ # undef Tcl_AppendExportList # define Tcl_AppendExportList \ (tclStubsPtr->tcl_AppendExportList) /* 508 */ # undef Tcl_Export # define Tcl_Export \ (tclStubsPtr->tcl_Export) /* 509 */ # undef Tcl_Import # define Tcl_Import \ (tclStubsPtr->tcl_Import) /* 510 */ # undef Tcl_ForgetImport # define Tcl_ForgetImport \ (tclStubsPtr->tcl_ForgetImport) /* 511 */ # undef Tcl_GetCurrentNamespace # define Tcl_GetCurrentNamespace \ (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */ # undef Tcl_GetGlobalNamespace # define Tcl_GetGlobalNamespace \ (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */ # undef Tcl_FindNamespace # define Tcl_FindNamespace \ (tclStubsPtr->tcl_FindNamespace) /* 514 */ # undef Tcl_FindCommand # define Tcl_FindCommand \ (tclStubsPtr->tcl_FindCommand) /* 515 */ # undef Tcl_GetCommandFromObj # define Tcl_GetCommandFromObj \ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ # undef Tcl_GetCommandFullName # define Tcl_GetCommandFullName \ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ #endif #undef TclCopyChannelOld #undef TclSockMinimumBuffersOld #define TclSetChildCancelFlags TclSetSlaveCancelFlags #endif /* _TCLINTDECLS */ tcl8.6.14/generic/tclInterp.c0000644000175000017500000040635314554262142015401 0ustar sergeisergei/* * tclInterp.c -- * * This file implements the "interp" command which allows creation and * manipulation of Tcl interpreters from within Tcl scripts. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 2004 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * A pointer to a string that holds an initialization script that if non-NULL * is evaluated in Tcl_Init() prior to the built-in initialization script * above. This variable can be modified by the function below. */ static const char *tclPreInitScript = NULL; /* Forward declaration */ struct Target; /* * struct Alias: * * Stores information about an alias. Is stored in the child interpreter and * used by the source command to find the target command in the parent when * the source command is invoked. */ typedef struct Alias { Tcl_Obj *token; /* Token for the alias command in the child * interp. This used to be the command name in * the child when the alias was first * created. */ Tcl_Interp *targetInterp; /* Interp in which target command will be * invoked. */ Tcl_Command childCmd; /* Source command in child interpreter, bound * to command that invokes the target command * in the target interpreter. */ Tcl_HashEntry *aliasEntryPtr; /* Entry for the alias hash table in child. * This is used by alias deletion to remove * the alias from the child interpreter alias * table. */ struct Target *targetPtr; /* Entry for target command in parent. This is * used in the parent interpreter to map back * from the target command to aliases * redirecting to it. */ int objc; /* Count of Tcl_Obj in the prefix of the * target command to be invoked in the target * interpreter. Additional arguments specified * when calling the alias in the child interp * will be appended to the prefix before the * command is invoked. */ Tcl_Obj *objPtr; /* The first actual prefix object - the target * command name; this has to be at the end of * the structure, which will be extended to * accommodate the remaining objects in the * prefix. */ } Alias; /* * * struct Child: * * Used by the "interp" command to record and find information about child * interpreters. Maps from a command name in the parent to information about a * child interpreter, e.g. what aliases are defined in it. */ typedef struct Child { Tcl_Interp *parentInterp; /* Parent interpreter for this child. */ Tcl_HashEntry *childEntryPtr; /* Hash entry in parents child table for this * child interpreter. Used to find this * record, and used when deleting the child * interpreter to delete it from the parent's * table. */ Tcl_Interp *childInterp; /* The child interpreter. */ Tcl_Command interpCmd; /* Interpreter object command. */ Tcl_HashTable aliasTable; /* Table which maps from names of commands in * child interpreter to struct Alias defined * below. */ } Child; /* * struct Target: * * Maps from parent interpreter commands back to the source commands in child * interpreters. This is needed because aliases can be created between sibling * interpreters and must be deleted when the target interpreter is deleted. In * case they would not be deleted the source interpreter would be left with a * "dangling pointer". One such record is stored in the Parent record of the * parent interpreter with the parent for each alias which directs to a * command in the parent. These records are used to remove the source command * for an from a child if/when the parent is deleted. They are organized in a * doubly-linked list attached to the parent interpreter. */ typedef struct Target { Tcl_Command childCmd; /* Command for alias in child interp. */ Tcl_Interp *childInterp; /* Child Interpreter. */ struct Target *nextPtr; /* Next in list of target records, or NULL if * at the end of the list of targets. */ struct Target *prevPtr; /* Previous in list of target records, or NULL * if at the start of the list of targets. */ } Target; /* * struct Parent: * * This record is used for two purposes: First, childTable (a hashtable) maps * from names of commands to child interpreters. This hashtable is used to * store information about child interpreters of this interpreter, to map over * all children, etc. The second purpose is to store information about all * aliases in children (or siblings) which direct to target commands in this * interpreter (using the targetsPtr doubly-linked list). * * NB: the flags field in the interp structure, used with SAFE_INTERP mask * denotes whether the interpreter is safe or not. Safe interpreters have * restricted functionality, can only create safe interpreters and can * only load safe extensions. */ typedef struct Parent { Tcl_HashTable childTable; /* Hash table for child interpreters. Maps * from command names to Child records. */ Target *targetsPtr; /* The head of a doubly-linked list of all the * target records which denote aliases from * children or sibling interpreters that direct * to commands in this interpreter. This list * is used to remove dangling pointers from * the child (or sibling) interpreters when * this interpreter is deleted. */ } Parent; /* * The following structure keeps track of all the Parent and Child information * on a per-interp basis. */ typedef struct InterpInfo { Parent parent; /* Keeps track of all interps for which this * interp is the Parent. */ Child child; /* Information necessary for this interp to * function as a child. */ } InterpInfo; /* * Limit callbacks handled by scripts are modelled as structures which are * stored in hashes indexed by a two-word key. Note that the type of the * 'type' field in the key is not int; this is to make sure that things are * likely to work properly on 64-bit architectures. */ typedef struct ScriptLimitCallback { Tcl_Interp *interp; /* The interpreter in which to execute the * callback. */ Tcl_Obj *scriptObj; /* The script to execute to perform the * user-defined part of the callback. */ int type; /* What kind of callback is this. */ Tcl_HashEntry *entryPtr; /* The entry in the hash table maintained by * the target interpreter that refers to this * callback record, or NULL if the entry has * already been deleted from that hash * table. */ } ScriptLimitCallback; typedef struct ScriptLimitCallbackKey { Tcl_Interp *interp; /* The interpreter that the limit callback was * attached to. This is not the interpreter * that the callback runs in! */ long type; /* The type of callback that this is. */ } ScriptLimitCallbackKey; /* * TIP#143 limit handler internal representation. */ struct LimitHandler { int flags; /* The state of this particular handler. */ Tcl_LimitHandlerProc *handlerProc; /* The handler callback. */ ClientData clientData; /* Opaque argument to the handler callback. */ Tcl_LimitHandlerDeleteProc *deleteProc; /* How to delete the clientData. */ LimitHandler *prevPtr; /* Previous item in linked list of * handlers. */ LimitHandler *nextPtr; /* Next item in linked list of handlers. */ }; /* * Values for the LimitHandler flags field. * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being * processed; handlers are never to be reentered. * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This * should not normally be observed because when a handler is * deleted it is also spliced out of the list of handlers, but * even so we will be careful. */ #define LIMIT_HANDLER_ACTIVE 0x01 #define LIMIT_HANDLER_DELETED 0x02 /* * Prototypes for local static functions: */ static int AliasCreate(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Interp *parentInterp, Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc, Tcl_Obj *const objv[]); static int AliasDelete(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *namePtr); static int AliasDescribe(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *objPtr); static int AliasList(Tcl_Interp *interp, Tcl_Interp *childInterp); static int AliasObjCmd(ClientData dummy, Tcl_Interp *currentInterp, int objc, Tcl_Obj *const objv[]); static Tcl_ObjCmdProc AliasNRCmd; static Tcl_CmdDeleteProc AliasObjCmdDeleteProc; static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr); static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static Tcl_InterpDeleteProc InterpInfoDeleteProc; static int ChildBgerror(Tcl_Interp *interp, Tcl_Interp *childInterp, int objc, Tcl_Obj *const objv[]); static Tcl_Interp * ChildCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr, int safe); static int ChildDebugCmd(Tcl_Interp *interp, Tcl_Interp *childInterp, int objc, Tcl_Obj *const objv[]); static int ChildEval(Tcl_Interp *interp, Tcl_Interp *childInterp, int objc, Tcl_Obj *const objv[]); static int ChildExpose(Tcl_Interp *interp, Tcl_Interp *childInterp, int objc, Tcl_Obj *const objv[]); static int ChildHide(Tcl_Interp *interp, Tcl_Interp *childInterp, int objc, Tcl_Obj *const objv[]); static int ChildHidden(Tcl_Interp *interp, Tcl_Interp *childInterp); static int ChildInvokeHidden(Tcl_Interp *interp, Tcl_Interp *childInterp, const char *namespaceName, int objc, Tcl_Obj *const objv[]); static int ChildMarkTrusted(Tcl_Interp *interp, Tcl_Interp *childInterp); static int ChildObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static Tcl_CmdDeleteProc ChildObjCmdDeleteProc; static int ChildRecursionLimit(Tcl_Interp *interp, Tcl_Interp *childInterp, int objc, Tcl_Obj *const objv[]); static int ChildCommandLimitCmd(Tcl_Interp *interp, Tcl_Interp *childInterp, int consumedObjc, int objc, Tcl_Obj *const objv[]); static int ChildTimeLimitCmd(Tcl_Interp *interp, Tcl_Interp *childInterp, int consumedObjc, int objc, Tcl_Obj *const objv[]); static void InheritLimitsFromParent(Tcl_Interp *childInterp, Tcl_Interp *parentInterp); static void SetScriptLimitCallback(Tcl_Interp *interp, int type, Tcl_Interp *targetInterp, Tcl_Obj *scriptObj); static void CallScriptLimitCallback(ClientData clientData, Tcl_Interp *interp); static void DeleteScriptLimitCallback(ClientData clientData); static void RunLimitHandlers(LimitHandler *handlerPtr, Tcl_Interp *interp); static void TimeLimitCallback(ClientData clientData); /* NRE enabling */ static Tcl_NRPostProc NRPostInvokeHidden; static Tcl_ObjCmdProc NRInterpCmd; static Tcl_ObjCmdProc NRChildCmd; /* *---------------------------------------------------------------------- * * TclSetPreInitScript -- * * This routine is used to change the value of the internal variable, * tclPreInitScript. * * Results: * Returns the current value of tclPreInitScript. * * Side effects: * Changes the way Tcl_Init() routine behaves. * *---------------------------------------------------------------------- */ const char * TclSetPreInitScript( const char *string) /* Pointer to a script. */ { const char *prevString = tclPreInitScript; tclPreInitScript = string; return prevString; } /* *---------------------------------------------------------------------- * * Tcl_Init -- * * This function is typically invoked by Tcl_AppInit functions to find * and source the "init.tcl" script, which should exist somewhere on the * Tcl library path. * * Results: * Returns a standard Tcl completion code and sets the interp's result if * there is an error. * * Side effects: * Depends on what's in the init.tcl script. * *---------------------------------------------------------------------- */ int Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { if (tclPreInitScript != NULL) { if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { return TCL_ERROR; } } /* * In order to find init.tcl during initialization, the following script * is invoked by Tcl_Init(). It looks in several different directories: * * $tcl_library - can specify a primary location, if set, no * other locations will be checked. This is the * recommended way for a program that embeds * Tcl to specifically tell Tcl where to find * an init.tcl file. * * $env(TCL_LIBRARY) - highest priority so user can always override * the search path unless the application has * specified an exact directory above * * $tclDefaultLibrary - INTERNAL: This variable is set by Tcl on * those platforms where it can determine at * runtime the directory where it expects the * init.tcl file to be. After [tclInit] reads * and uses this value, it [unset]s it. * External users of Tcl should not make use of * the variable to customize [tclInit]. * * $tcl_libPath - OBSOLETE: This variable is no longer set by * Tcl itself, but [tclInit] examines it in * case some program that embeds Tcl is * customizing [tclInit] by setting this * variable to a list of directories in which * to search. * * [tcl::pkgconfig get scriptdir,runtime] * - the directory determined by configure to be * the place where Tcl's script library is to * be installed. * * The first directory on this path that contains a valid init.tcl script * will be set as the value of tcl_library. * * Note that this entire search mechanism can be bypassed by defining an * alternate tclInit command before calling Tcl_Init(). */ return Tcl_Eval(interp, "if {[namespace which -command tclInit] eq \"\"} {\n" " proc tclInit {} {\n" " global tcl_libPath tcl_library env tclDefaultLibrary\n" " rename tclInit {}\n" " if {[info exists tcl_library]} {\n" " set scripts {{set tcl_library}}\n" " } else {\n" " set scripts {}\n" " if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" " lappend scripts {set env(TCL_LIBRARY)}\n" " lappend scripts {\n" "if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n" "if {$tail eq [info tclversion]} continue\n" "file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n" " }\n" " if {[info exists tclDefaultLibrary]} {\n" " lappend scripts {set tclDefaultLibrary}\n" " } else {\n" " lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n" " }\n" " lappend scripts {\n" "set parentDir [file dirname [file dirname [info nameofexecutable]]]\n" "set grandParentDir [file dirname $parentDir]\n" "file join $parentDir lib tcl[info tclversion]} \\\n" " {file join $grandParentDir lib tcl[info tclversion]} \\\n" " {file join $parentDir library} \\\n" " {file join $grandParentDir library} \\\n" " {file join $grandParentDir tcl[info patchlevel] library} \\\n" " {\n" "file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n" " if {[info exists tcl_libPath]\n" " && [catch {llength $tcl_libPath} len] == 0} {\n" " for {set i 0} {$i < $len} {incr i} {\n" " lappend scripts [list lindex \\$tcl_libPath $i]\n" " }\n" " }\n" " }\n" " set dirs {}\n" " set errors {}\n" " foreach script $scripts {\n" " lappend dirs [eval $script]\n" " set tcl_library [lindex $dirs end]\n" " set tclfile [file join $tcl_library init.tcl]\n" " if {[file exists $tclfile]} {\n" " if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n" " append errors \"$tclfile: $msg\n\"\n" " append errors \"[dict get $opts -errorinfo]\n\"\n" " continue\n" " }\n" " unset -nocomplain tclDefaultLibrary\n" " return\n" " }\n" " }\n" " unset -nocomplain tclDefaultLibrary\n" " set msg \"Can't find a usable init.tcl in the following directories: \n\"\n" " append msg \" $dirs\n\n\"\n" " append msg \"$errors\n\n\"\n" " append msg \"This probably means that Tcl wasn't installed properly.\n\"\n" " error $msg\n" " }\n" "}\n" "tclInit"); } /* *--------------------------------------------------------------------------- * * TclInterpInit -- * * Initializes the invoking interpreter for using the parent, child and * safe interp facilities. This is called from inside Tcl_CreateInterp(). * * Results: * Always returns TCL_OK for backwards compatibility. * * Side effects: * Adds the "interp" command to an interpreter and initializes the * interpInfoPtr field of the invoking interpreter. * *--------------------------------------------------------------------------- */ int TclInterpInit( Tcl_Interp *interp) /* Interpreter to initialize. */ { InterpInfo *interpInfoPtr; Parent *parentPtr; Child *childPtr; interpInfoPtr = (InterpInfo *)ckalloc(sizeof(InterpInfo)); ((Interp *) interp)->interpInfo = interpInfoPtr; parentPtr = &interpInfoPtr->parent; Tcl_InitHashTable(&parentPtr->childTable, TCL_STRING_KEYS); parentPtr->targetsPtr = NULL; childPtr = &interpInfoPtr->child; childPtr->parentInterp = NULL; childPtr->childEntryPtr = NULL; childPtr->childInterp = interp; childPtr->interpCmd = NULL; Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS); Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd, NULL, NULL); Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL); return TCL_OK; } /* *--------------------------------------------------------------------------- * * InterpInfoDeleteProc -- * * Invoked when an interpreter is being deleted. It releases all storage * used by the parent/child/safe interpreter facilities. * * Results: * None. * * Side effects: * Cleans up storage. Sets the interpInfoPtr field of the interp to NULL. * *--------------------------------------------------------------------------- */ static void InterpInfoDeleteProc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp) /* Interp being deleted. All commands for * child interps should already be deleted. */ { InterpInfo *interpInfoPtr; Child *childPtr; Parent *parentPtr; Target *targetPtr; interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; /* * There shouldn't be any commands left. */ parentPtr = &interpInfoPtr->parent; if (parentPtr->childTable.numEntries != 0) { Tcl_Panic("InterpInfoDeleteProc: still exist commands"); } Tcl_DeleteHashTable(&parentPtr->childTable); /* * Tell any interps that have aliases to this interp that they should * delete those aliases. If the other interp was already dead, it would * have removed the target record already. */ for (targetPtr = parentPtr->targetsPtr; targetPtr != NULL; ) { Target *tmpPtr = targetPtr->nextPtr; Tcl_DeleteCommandFromToken(targetPtr->childInterp, targetPtr->childCmd); targetPtr = tmpPtr; } childPtr = &interpInfoPtr->child; if (childPtr->interpCmd != NULL) { /* * Tcl_DeleteInterp() was called on this interpreter, rather "interp * delete" or the equivalent deletion of the command in the parent. * First ensure that the cleanup callback doesn't try to delete the * interp again. */ childPtr->childInterp = NULL; Tcl_DeleteCommandFromToken(childPtr->parentInterp, childPtr->interpCmd); } /* * There shouldn't be any aliases left. */ if (childPtr->aliasTable.numEntries != 0) { Tcl_Panic("InterpInfoDeleteProc: still exist aliases"); } Tcl_DeleteHashTable(&childPtr->aliasTable); ckfree(interpInfoPtr); } /* *---------------------------------------------------------------------- * * Tcl_InterpObjCmd -- * * This function is invoked to process the "interp" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_InterpObjCmd( ClientData clientData, /* Unused. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv); } static int NRInterpCmd( ClientData clientData, /* Unused. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *childInterp; int index; static const char *const options[] = { "alias", "aliases", "bgerror", "cancel", "children", "create", "debug", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", "limit", "marktrusted", "recursionlimit", "slaves", "share", "target", "transfer", NULL }; enum interpOptionEnum { OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL, OPT_CHILDREN, OPT_CREATE, OPT_DEBUG, OPT_DELETE, OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID, OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT, OPT_SLAVES, OPT_SHARE, OPT_TARGET, OPT_TRANSFER }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum interpOptionEnum)index) { case OPT_ALIAS: { Tcl_Interp *parentInterp; if (objc < 4) { aliasArgs: Tcl_WrongNumArgs(interp, 2, objv, "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } if (objc == 4) { return AliasDescribe(interp, childInterp, objv[3]); } if ((objc == 5) && (TclGetString(objv[4])[0] == '\0')) { return AliasDelete(interp, childInterp, objv[3]); } if (objc > 5) { parentInterp = GetInterp(interp, objv[4]); if (parentInterp == NULL) { return TCL_ERROR; } return AliasCreate(interp, childInterp, parentInterp, objv[3], objv[5], objc - 6, objv + 6); } goto aliasArgs; } case OPT_ALIASES: childInterp = GetInterp2(interp, objc, objv); if (childInterp == NULL) { return TCL_ERROR; } return AliasList(interp, childInterp); case OPT_BGERROR: if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildBgerror(interp, childInterp, objc - 3, objv + 3); case OPT_CANCEL: { int i, flags; Tcl_Obj *resultObjPtr; static const char *const cancelOptions[] = { "-unwind", "--", NULL }; enum optionCancelEnum { OPT_UNWIND, OPT_LAST }; flags = 0; for (i = 2; i < objc; i++) { if (TclGetString(objv[i])[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], cancelOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum optionCancelEnum) index) { case OPT_UNWIND: /* * The evaluation stack in the target interp is to be unwound. */ flags |= TCL_CANCEL_UNWIND; break; case OPT_LAST: i++; goto endOfForLoop; } } endOfForLoop: if (i < objc - 2) { Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? ?--? ?path? ?result?"); return TCL_ERROR; } /* * Did they specify a child interp to cancel the script in progress * in? If not, use the current interp. */ if (i < objc) { childInterp = GetInterp(interp, objv[i]); if (childInterp == NULL) { return TCL_ERROR; } i++; } else { childInterp = interp; } if (i < objc) { resultObjPtr = objv[i]; /* * Tcl_CancelEval removes this reference. */ Tcl_IncrRefCount(resultObjPtr); i++; } else { resultObjPtr = NULL; } return Tcl_CancelEval(childInterp, resultObjPtr, 0, flags); } case OPT_CREATE: { int i, last, safe; Tcl_Obj *childPtr; char buf[16 + TCL_INTEGER_SPACE]; static const char *const createOptions[] = { "-safe", "--", NULL }; enum option { OPT_SAFE, OPT_LAST }; safe = Tcl_IsSafe(interp); /* * Weird historical rules: "-safe" is accepted at the end, too. */ childPtr = NULL; last = 0; for (i = 2; i < objc; i++) { if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) { if (Tcl_GetIndexFromObj(interp, objv[i], createOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_SAFE) { safe = 1; continue; } i++; last = 1; } if (childPtr != NULL) { Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?"); return TCL_ERROR; } if (i < objc) { childPtr = objv[i]; } } buf[0] = '\0'; if (childPtr == NULL) { /* * Create an anonymous interpreter -- we choose its name and the * name of the command. We check that the command name that we use * for the interpreter does not collide with an existing command * in the parent interpreter. */ for (i = 0; ; i++) { Tcl_CmdInfo cmdInfo; snprintf(buf, sizeof(buf), "interp%d", i); if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) { break; } } childPtr = Tcl_NewStringObj(buf, -1); } if (ChildCreate(interp, childPtr, safe) == NULL) { if (buf[0] != '\0') { Tcl_DecrRefCount(childPtr); } return TCL_ERROR; } Tcl_SetObjResult(interp, childPtr); return TCL_OK; } case OPT_DEBUG: /* TIP #378 */ /* * Currently only -frame supported, otherwise ?-option ?value?? */ if (objc < 3 || objc > 5) { Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildDebugCmd(interp, childInterp, objc - 3, objv + 3); case OPT_DELETE: { int i; InterpInfo *iiPtr; for (i = 2; i < objc; i++) { childInterp = GetInterp(interp, objv[i]); if (childInterp == NULL) { return TCL_ERROR; } else if (childInterp == interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot delete the current interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "DELETESELF", NULL); return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; Tcl_DeleteCommandFromToken(iiPtr->child.parentInterp, iiPtr->child.interpCmd); } return TCL_OK; } case OPT_EVAL: if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildEval(interp, childInterp, objc - 3, objv + 3); case OPT_EXISTS: { int exists = 1; childInterp = GetInterp2(interp, objc, objv); if (childInterp == NULL) { if (objc > 3) { return TCL_ERROR; } Tcl_ResetResult(interp); exists = 0; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists)); return TCL_OK; } case OPT_EXPOSE: if ((objc < 4) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildExpose(interp, childInterp, objc - 3, objv + 3); case OPT_HIDE: if ((objc < 4) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildHide(interp, childInterp, objc - 3, objv + 3); case OPT_HIDDEN: childInterp = GetInterp2(interp, objc, objv); if (childInterp == NULL) { return TCL_ERROR; } return ChildHidden(interp, childInterp); case OPT_ISSAFE: childInterp = GetInterp2(interp, objc, objv); if (childInterp == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp))); return TCL_OK; case OPT_INVOKEHID: { int i; const char *namespaceName; static const char *const hiddenOptions[] = { "-global", "-namespace", "--", NULL }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST }; namespaceName = NULL; for (i = 3; i < objc; i++) { if (TclGetString(objv[i])[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_GLOBAL) { namespaceName = "::"; } else if (index == OPT_NAMESPACE) { if (++i == objc) { /* There must be more arguments. */ break; } else { namespaceName = TclGetString(objv[i]); } } else { i++; break; } } if (objc - i < 1) { Tcl_WrongNumArgs(interp, 2, objv, "path ?-namespace ns? ?-global? ?--? cmd ?arg ..?"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildInvokeHidden(interp, childInterp, namespaceName, objc - i, objv + i); } case OPT_LIMIT: { static const char *const limitTypes[] = { "commands", "time", NULL }; enum LimitTypes { LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME }; int limitType; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?-option value ...?"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[3], limitTypes, "limit type", 0, &limitType) != TCL_OK) { return TCL_ERROR; } switch ((enum LimitTypes) limitType) { case LIMIT_TYPE_COMMANDS: return ChildCommandLimitCmd(interp, childInterp, 4, objc,objv); case LIMIT_TYPE_TIME: return ChildTimeLimitCmd(interp, childInterp, 4, objc, objv); } } break; case OPT_MARKTRUSTED: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildMarkTrusted(interp, childInterp); case OPT_RECLIMIT: if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3); case OPT_CHILDREN: case OPT_SLAVES: { InterpInfo *iiPtr; Tcl_Obj *resultPtr; Tcl_HashEntry *hPtr; Tcl_HashSearch hashSearch; char *string; childInterp = GetInterp2(interp, objc, objv); if (childInterp == NULL) { return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; TclNewObj(resultPtr); hPtr = Tcl_FirstHashEntry(&iiPtr->parent.childTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { string = (char *)Tcl_GetHashKey(&iiPtr->parent.childTable, hPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(string, -1)); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } case OPT_TRANSFER: case OPT_SHARE: { Tcl_Interp *parentInterp; /* The parent of the child. */ Tcl_Channel chan; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath"); return TCL_ERROR; } parentInterp = GetInterp(interp, objv[2]); if (parentInterp == NULL) { return TCL_ERROR; } chan = Tcl_GetChannel(parentInterp, TclGetString(objv[3]), NULL); if (chan == NULL) { Tcl_TransferResult(parentInterp, TCL_OK, interp); return TCL_ERROR; } childInterp = GetInterp(interp, objv[4]); if (childInterp == NULL) { return TCL_ERROR; } Tcl_RegisterChannel(childInterp, chan); if (index == OPT_TRANSFER) { /* * When transferring, as opposed to sharing, we must unhitch the * channel from the interpreter where it started. */ if (Tcl_UnregisterChannel(parentInterp, chan) != TCL_OK) { Tcl_TransferResult(parentInterp, TCL_OK, interp); return TCL_ERROR; } } return TCL_OK; } case OPT_TARGET: { InterpInfo *iiPtr; Tcl_HashEntry *hPtr; Alias *aliasPtr; const char *aliasName; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path alias"); return TCL_ERROR; } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } aliasName = TclGetString(objv[3]); iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" in path \"%s\" not found", aliasName, Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "target interpreter for alias \"%s\" in path \"%s\" is " "not my descendant", aliasName, Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "TARGETSHROUDED", NULL); return TCL_ERROR; } return TCL_OK; } } return TCL_OK; } /* *--------------------------------------------------------------------------- * * GetInterp2 -- * * Helper function for Tcl_InterpObjCmd() to convert the interp name * potentially specified on the command line to an Tcl_Interp. * * Results: * The return value is the interp specified on the command line, or the * interp argument itself if no interp was specified on the command line. * If the interp could not be found or the wrong number of arguments was * specified on the command line, the return value is NULL and an error * message is left in the interp's result. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static Tcl_Interp * GetInterp2( Tcl_Interp *interp, /* Default interp if no interp was specified * on the command line. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc == 2) { return interp; } else if (objc == 3) { return GetInterp(interp, objv[2]); } else { Tcl_WrongNumArgs(interp, 2, objv, "?path?"); return NULL; } } /* *---------------------------------------------------------------------- * * Tcl_CreateAlias -- * * Creates an alias between two interpreters. * * Results: * A standard Tcl result. * * Side effects: * Creates a new alias, manipulates the result field of childInterp. * *---------------------------------------------------------------------- */ int Tcl_CreateAlias( Tcl_Interp *childInterp, /* Interpreter for source command. */ const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ int argc, /* How many additional arguments? */ const char *const *argv) /* These are the additional args. */ { Tcl_Obj *childObjPtr, *targetObjPtr; Tcl_Obj **objv; int i; int result; objv = (Tcl_Obj **)TclStackAlloc(childInterp, sizeof(Tcl_Obj *) * argc); for (i = 0; i < argc; i++) { objv[i] = Tcl_NewStringObj(argv[i], -1); Tcl_IncrRefCount(objv[i]); } childObjPtr = Tcl_NewStringObj(childCmd, -1); Tcl_IncrRefCount(childObjPtr); targetObjPtr = Tcl_NewStringObj(targetCmd, -1); Tcl_IncrRefCount(targetObjPtr); result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr, targetObjPtr, argc, objv); for (i = 0; i < argc; i++) { Tcl_DecrRefCount(objv[i]); } TclStackFree(childInterp, objv); Tcl_DecrRefCount(targetObjPtr); Tcl_DecrRefCount(childObjPtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_CreateAliasObj -- * * Object version: Creates an alias between two interpreters. * * Results: * A standard Tcl result. * * Side effects: * Creates a new alias. * *---------------------------------------------------------------------- */ int Tcl_CreateAliasObj( Tcl_Interp *childInterp, /* Interpreter for source command. */ const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ int objc, /* How many additional arguments? */ Tcl_Obj *const objv[]) /* Argument vector. */ { Tcl_Obj *childObjPtr, *targetObjPtr; int result; childObjPtr = Tcl_NewStringObj(childCmd, -1); Tcl_IncrRefCount(childObjPtr); targetObjPtr = Tcl_NewStringObj(targetCmd, -1); Tcl_IncrRefCount(targetObjPtr); result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr, targetObjPtr, objc, objv); Tcl_DecrRefCount(childObjPtr); Tcl_DecrRefCount(targetObjPtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_GetAlias -- * * Gets information about an alias. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetAlias( Tcl_Interp *interp, /* Interp to start search from. */ const char *aliasName, /* Name of alias to find. */ Tcl_Interp **targetInterpPtr, /* (Return) target interpreter. */ const char **targetNamePtr, /* (Return) name of target command. */ int *argcPtr, /* (Return) count of addnl args. */ const char ***argvPtr) /* (Return) additional arguments. */ { InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; Tcl_HashEntry *hPtr; Alias *aliasPtr; int i, objc; Tcl_Obj **objv; hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" not found", aliasName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); objc = aliasPtr->objc; objv = &aliasPtr->objPtr; if (targetInterpPtr != NULL) { *targetInterpPtr = aliasPtr->targetInterp; } if (targetNamePtr != NULL) { *targetNamePtr = TclGetString(objv[0]); } if (argcPtr != NULL) { *argcPtr = objc - 1; } if (argvPtr != NULL) { *argvPtr = (const char **) ckalloc(sizeof(const char *) * (objc - 1)); for (i = 1; i < objc; i++) { (*argvPtr)[i - 1] = TclGetString(objv[i]); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetAliasObj -- * * Object version: Gets information about an alias. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetAliasObj( Tcl_Interp *interp, /* Interp to start search from. */ const char *aliasName, /* Name of alias to find. */ Tcl_Interp **targetInterpPtr, /* (Return) target interpreter. */ const char **targetNamePtr, /* (Return) name of target command. */ int *objcPtr, /* (Return) count of addnl args. */ Tcl_Obj ***objvPtr) /* (Return) additional args. */ { InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; Tcl_HashEntry *hPtr; Alias *aliasPtr; int objc; Tcl_Obj **objv; hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" not found", aliasName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); objc = aliasPtr->objc; objv = &aliasPtr->objPtr; if (targetInterpPtr != NULL) { *targetInterpPtr = aliasPtr->targetInterp; } if (targetNamePtr != NULL) { *targetNamePtr = TclGetString(objv[0]); } if (objcPtr != NULL) { *objcPtr = objc - 1; } if (objvPtr != NULL) { *objvPtr = objv + 1; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclPreventAliasLoop -- * * When defining an alias or renaming a command, prevent an alias loop * from being formed. * * Results: * A standard Tcl object result. * * Side effects: * If TCL_ERROR is returned, the function also stores an error message in * the interpreter's result object. * * NOTE: * This function is public internal (instead of being static to this * file) because it is also used from TclRenameCommand. * *---------------------------------------------------------------------- */ int TclPreventAliasLoop( Tcl_Interp *interp, /* Interp in which to report errors. */ Tcl_Interp *cmdInterp, /* Interp in which the command is being * defined. */ Tcl_Command cmd) /* Tcl command we are attempting to define. */ { Command *cmdPtr = (Command *) cmd; Alias *aliasPtr, *nextAliasPtr; Tcl_Command aliasCmd; Command *aliasCmdPtr; /* * If we are not creating or renaming an alias, then it is always OK to * create or rename the command. */ if (cmdPtr->objProc != AliasObjCmd) { return TCL_OK; } /* * OK, we are dealing with an alias, so traverse the chain of aliases. If * we encounter the alias we are defining (or renaming to) any in the * chain then we have a loop. */ aliasPtr = (Alias *)cmdPtr->objClientData; nextAliasPtr = aliasPtr; while (1) { Tcl_Obj *cmdNamePtr; /* * If the target of the next alias in the chain is the same as the * source alias, we have a loop. */ if (Tcl_InterpDeleted(nextAliasPtr->targetInterp)) { /* * The child interpreter can be deleted while creating the alias. * [Bug #641195] */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot define or rename alias \"%s\": interpreter deleted", Tcl_GetCommandName(cmdInterp, cmd))); return TCL_ERROR; } cmdNamePtr = nextAliasPtr->objPtr; aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp, TclGetString(cmdNamePtr), Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp), /*flags*/ 0); if (aliasCmd == NULL) { return TCL_OK; } aliasCmdPtr = (Command *) aliasCmd; if (aliasCmdPtr == cmdPtr) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot define or rename alias \"%s\": would create a loop", Tcl_GetCommandName(cmdInterp, cmd))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "ALIASLOOP", NULL); return TCL_ERROR; } /* * Otherwise, follow the chain one step further. See if the target * command is an alias - if so, follow the loop to its target command. * Otherwise we do not have a loop. */ if (aliasCmdPtr->objProc != AliasObjCmd) { return TCL_OK; } nextAliasPtr = (Alias *)aliasCmdPtr->objClientData; } } /* *---------------------------------------------------------------------- * * AliasCreate -- * * Helper function to do the work to actually create an alias. * * Results: * A standard Tcl result. * * Side effects: * An alias command is created and entered into the alias table for the * child interpreter. * *---------------------------------------------------------------------- */ static int AliasCreate( Tcl_Interp *interp, /* Interp for error reporting. */ Tcl_Interp *childInterp, /* Interp where alias cmd will live or from * which alias will be deleted. */ Tcl_Interp *parentInterp, /* Interp in which target command will be * invoked. */ Tcl_Obj *namePtr, /* Name of alias cmd. */ Tcl_Obj *targetNamePtr, /* Name of target cmd. */ int objc, /* Additional arguments to store */ Tcl_Obj *const objv[]) /* with alias. */ { Alias *aliasPtr; Tcl_HashEntry *hPtr; Target *targetPtr; Child *childPtr; Parent *parentPtr; Tcl_Obj **prefv; int isNew, i; aliasPtr = (Alias *)ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); aliasPtr->token = namePtr; Tcl_IncrRefCount(aliasPtr->token); aliasPtr->targetInterp = parentInterp; aliasPtr->objc = objc + 1; prefv = &aliasPtr->objPtr; *prefv = targetNamePtr; Tcl_IncrRefCount(targetNamePtr); for (i = 0; i < objc; i++) { *(++prefv) = objv[i]; Tcl_IncrRefCount(objv[i]); } Tcl_Preserve(childInterp); Tcl_Preserve(parentInterp); if (childInterp == parentInterp) { aliasPtr->childCmd = Tcl_NRCreateCommand(childInterp, TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr, AliasObjCmdDeleteProc); } else { aliasPtr->childCmd = Tcl_CreateObjCommand(childInterp, TclGetString(namePtr), AliasObjCmd, aliasPtr, AliasObjCmdDeleteProc); } if (TclPreventAliasLoop(interp, childInterp, aliasPtr->childCmd) != TCL_OK) { /* * Found an alias loop! The last call to Tcl_CreateObjCommand made the * alias point to itself. Delete the command and its alias record. Be * careful to wipe out its client data first, so the command doesn't * try to delete itself. */ Command *cmdPtr; Tcl_DecrRefCount(aliasPtr->token); Tcl_DecrRefCount(targetNamePtr); for (i = 0; i < objc; i++) { Tcl_DecrRefCount(objv[i]); } cmdPtr = (Command *) aliasPtr->childCmd; cmdPtr->clientData = NULL; cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd); ckfree(aliasPtr); /* * The result was already set by TclPreventAliasLoop. */ Tcl_Release(childInterp); Tcl_Release(parentInterp); return TCL_ERROR; } /* * Make an entry in the alias table. If it already exists, retry. */ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; while (1) { Tcl_Obj *newToken; const char *string; string = TclGetString(aliasPtr->token); hPtr = Tcl_CreateHashEntry(&childPtr->aliasTable, string, &isNew); if (isNew != 0) { break; } /* * The alias name cannot be used as unique token, it is already taken. * We can produce a unique token by prepending "::" repeatedly. This * algorithm is a stop-gap to try to maintain the command name as * token for most use cases, fearful of possible backwards compat * problems. A better algorithm would produce unique tokens that need * not be related to the command name. * * ATTENTION: the tests in interp.test and possibly safe.test depend * on the precise definition of these tokens. */ TclNewLiteralStringObj(newToken, "::"); Tcl_AppendObjToObj(newToken, aliasPtr->token); Tcl_DecrRefCount(aliasPtr->token); aliasPtr->token = newToken; Tcl_IncrRefCount(aliasPtr->token); } aliasPtr->aliasEntryPtr = hPtr; Tcl_SetHashValue(hPtr, aliasPtr); /* * Create the new command. We must do it after deleting any old command, * because the alias may be pointing at a renamed alias, as in: * * interp alias {} foo {} bar # Create an alias "foo" * rename foo zop # Now rename the alias * interp alias {} foo {} zop # Now recreate "foo"... */ targetPtr = (Target *)ckalloc(sizeof(Target)); targetPtr->childCmd = aliasPtr->childCmd; targetPtr->childInterp = childInterp; parentPtr = &((InterpInfo*) ((Interp*) parentInterp)->interpInfo)->parent; targetPtr->nextPtr = parentPtr->targetsPtr; targetPtr->prevPtr = NULL; if (parentPtr->targetsPtr != NULL) { parentPtr->targetsPtr->prevPtr = targetPtr; } parentPtr->targetsPtr = targetPtr; aliasPtr->targetPtr = targetPtr; Tcl_SetObjResult(interp, aliasPtr->token); Tcl_Release(childInterp); Tcl_Release(parentInterp); return TCL_OK; } /* *---------------------------------------------------------------------- * * AliasDelete -- * * Deletes the given alias from the child interpreter given. * * Results: * A standard Tcl result. * * Side effects: * Deletes the alias from the child interpreter. * *---------------------------------------------------------------------- */ static int AliasDelete( Tcl_Interp *interp, /* Interpreter for result & errors. */ Tcl_Interp *childInterp, /* Interpreter containing alias. */ Tcl_Obj *namePtr) /* Name of alias to delete. */ { Child *childPtr; Alias *aliasPtr; Tcl_HashEntry *hPtr; /* * If the alias has been renamed in the child, the parent can still use * the original name (with which it was created) to find the alias to * delete it. */ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr)); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" not found", TclGetString(namePtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", TclGetString(namePtr), NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd); return TCL_OK; } /* *---------------------------------------------------------------------- * * AliasDescribe -- * * Sets the interpreter's result object to a Tcl list describing the * given alias in the given interpreter: its target command and the * additional arguments to prepend to any invocation of the alias. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int AliasDescribe( Tcl_Interp *interp, /* Interpreter for result & errors. */ Tcl_Interp *childInterp, /* Interpreter containing alias. */ Tcl_Obj *namePtr) /* Name of alias to describe. */ { Child *childPtr; Tcl_HashEntry *hPtr; Alias *aliasPtr; Tcl_Obj *prefixPtr; /* * If the alias has been renamed in the child, the parent can still use * the original name (with which it was created) to find the alias to * describe it. */ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, Tcl_GetString(namePtr)); if (hPtr == NULL) { return TCL_OK; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr); Tcl_SetObjResult(interp, prefixPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * AliasList -- * * Computes a list of aliases defined in a child interpreter. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int AliasList( Tcl_Interp *interp, /* Interp for data return. */ Tcl_Interp *childInterp) /* Interp whose aliases to compute. */ { Tcl_HashEntry *entryPtr; Tcl_HashSearch hashSearch; Tcl_Obj *resultPtr; Alias *aliasPtr; Child *childPtr; TclNewObj(resultPtr); childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; entryPtr = Tcl_FirstHashEntry(&childPtr->aliasTable, &hashSearch); for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) { aliasPtr = (Alias *)Tcl_GetHashValue(entryPtr); Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * AliasObjCmd -- * * This is the function that services invocations of aliases in a child * interpreter. One such command exists for each alias. When invoked, * this function redirects the invocation to the target command in the * parent interpreter as designated by the Alias record associated with * this command. * * Results: * A standard Tcl result. * * Side effects: * Causes forwarding of the invocation; all possible side effects may * occur as a result of invoking the command to which the invocation is * forwarded. * *---------------------------------------------------------------------- */ static int AliasNRCmd( ClientData clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { Alias *aliasPtr = (Alias *)clientData; int prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *listPtr; List *listRep; int flags = TCL_EVAL_INVOKE; /* * Append the arguments to the command prefix and invoke the command in * the target interp's global namespace. */ prefc = aliasPtr->objc; prefv = &aliasPtr->objPtr; cmdc = prefc + objc - 1; listPtr = Tcl_NewListObj(cmdc, NULL); listRep = listPtr->internalRep.twoPtrValue.ptr1; listRep->elemCount = cmdc; cmdv = &listRep->elements; prefv = &aliasPtr->objPtr; memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *)); memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *)); for (i=0; itargetInterp; int result, prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; Interp *tPtr = (Interp *) targetInterp; int isRootEnsemble; /* * Append the arguments to the command prefix and invoke the command in * the target interp's global namespace. */ prefc = aliasPtr->objc; prefv = &aliasPtr->objPtr; cmdc = prefc + objc - 1; if (cmdc <= ALIAS_CMDV_PREALLOC) { cmdv = cmdArr; } else { cmdv = (Tcl_Obj **)TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); } memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *)); memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *)); Tcl_ResetResult(targetInterp); for (i=0; itoken); objv = &aliasPtr->objPtr; for (i = 0; i < aliasPtr->objc; i++) { Tcl_DecrRefCount(objv[i]); } Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr); /* * Splice the target record out of the target interpreter's parent list. */ targetPtr = aliasPtr->targetPtr; if (targetPtr->prevPtr != NULL) { targetPtr->prevPtr->nextPtr = targetPtr->nextPtr; } else { Parent *parentPtr = &((InterpInfo *) ((Interp *) aliasPtr->targetInterp)->interpInfo)->parent; parentPtr->targetsPtr = targetPtr->nextPtr; } if (targetPtr->nextPtr != NULL) { targetPtr->nextPtr->prevPtr = targetPtr->prevPtr; } ckfree(targetPtr); ckfree(aliasPtr); } /* *---------------------------------------------------------------------- * * Tcl_CreateChild -- * * Creates a child interpreter. The childPath argument denotes the name * of the new child relative to the current interpreter; the child is a * direct descendant of the one-before-last component of the path, * e.g. it is a descendant of the current interpreter if the childPath * argument contains only one component. Optionally makes the child * interpreter safe. * * Results: * Returns the interpreter structure created, or NULL if an error * occurred. * * Side effects: * Creates a new interpreter and a new interpreter object command in the * interpreter indicated by the childPath argument. * *---------------------------------------------------------------------- */ Tcl_Interp * Tcl_CreateChild( Tcl_Interp *interp, /* Interpreter to start search at. */ const char *childPath, /* Name of child to create. */ int isSafe) /* Should new child be "safe" ? */ { Tcl_Obj *pathPtr; Tcl_Interp *childInterp; pathPtr = Tcl_NewStringObj(childPath, -1); childInterp = ChildCreate(interp, pathPtr, isSafe); Tcl_DecrRefCount(pathPtr); return childInterp; } /* *---------------------------------------------------------------------- * * Tcl_GetChild -- * * Finds a child interpreter by its path name. * * Results: * Returns a Tcl_Interp * for the named interpreter or NULL if not found. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Interp * Tcl_GetChild( Tcl_Interp *interp, /* Interpreter to start search from. */ const char *childPath) /* Path of child to find. */ { Tcl_Obj *pathPtr; Tcl_Interp *childInterp; pathPtr = Tcl_NewStringObj(childPath, -1); childInterp = GetInterp(interp, pathPtr); Tcl_DecrRefCount(pathPtr); return childInterp; } /* *---------------------------------------------------------------------- * * Tcl_GetParent -- * * Finds the parent interpreter of a child interpreter. * * Results: * Returns a Tcl_Interp * for the parent interpreter or NULL if none. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Interp * Tcl_GetParent( Tcl_Interp *interp) /* Get the parent of this interpreter. */ { Child *childPtr; /* Child record of this interpreter. */ if (interp == NULL) { return NULL; } childPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->child; return childPtr->parentInterp; } /* *---------------------------------------------------------------------- * * TclSetChildCancelFlags -- * * This function marks all child interpreters belonging to a given * interpreter as being canceled or not canceled, depending on the * provided flags. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclSetChildCancelFlags( Tcl_Interp *interp, /* Set cancel flags of this interpreter. */ int flags, /* Collection of OR-ed bits that control * the cancellation of the script. Only * TCL_CANCEL_UNWIND is currently * supported. */ int force) /* Non-zero to ignore numLevels for the purpose * of resetting the cancellation flags. */ { Parent *parentPtr; /* Parent record of given interpreter. */ Tcl_HashEntry *hPtr; /* Search element. */ Tcl_HashSearch hashSearch; /* Search variable. */ Child *childPtr; /* Child record of interpreter. */ Interp *iPtr; if (interp == NULL) { return; } flags &= (CANCELED | TCL_CANCEL_UNWIND); parentPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->parent; hPtr = Tcl_FirstHashEntry(&parentPtr->childTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { childPtr = (Child *)Tcl_GetHashValue(hPtr); iPtr = (Interp *) childPtr->childInterp; if (iPtr == NULL) { continue; } if (flags == 0) { TclResetCancellation((Tcl_Interp *) iPtr, force); } else { TclSetCancelFlags(iPtr, flags); } /* * Now, recursively handle this for the children of this child * interpreter. */ TclSetChildCancelFlags((Tcl_Interp *) iPtr, flags, force); } } /* *---------------------------------------------------------------------- * * Tcl_GetInterpPath -- * * Sets the result of the asking interpreter to a proper Tcl list * containing the names of interpreters between the asking and target * interpreters. The target interpreter must be either the same as the * asking interpreter or one of its children (including recursively). * * Results: * TCL_OK if the target interpreter is the same as, or a descendant of, * the asking interpreter; TCL_ERROR else. This way one can distinguish * between the case where the asking and target interps are the same (an * empty list is the result, and TCL_OK is returned) and when the target * is not a descendant of the asking interpreter (in which case the Tcl * result is an error message and the function returns TCL_ERROR). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetInterpPath( Tcl_Interp *interp, /* Interpreter to start search from. */ Tcl_Interp *targetInterp) /* Interpreter to find. */ { InterpInfo *iiPtr; if (targetInterp == interp) { Tcl_SetObjResult(interp, Tcl_NewObj()); return TCL_OK; } if (targetInterp == NULL) { return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo; if (Tcl_GetInterpPath(interp, iiPtr->child.parentInterp) != TCL_OK){ return TCL_ERROR; } Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->parent.childTable, iiPtr->child.childEntryPtr), -1)); return TCL_OK; } /* *---------------------------------------------------------------------- * * GetInterp -- * * Helper function to find a child interpreter given a pathname. * * Results: * Returns the child interpreter known by that name in the calling * interpreter, or NULL if no interpreter known by that name exists. * * Side effects: * Assigns to the pointer variable passed in, if not NULL. * *---------------------------------------------------------------------- */ static Tcl_Interp * GetInterp( Tcl_Interp *interp, /* Interp. to start search from. */ Tcl_Obj *pathPtr) /* List object containing name of interp. to * be found. */ { Tcl_HashEntry *hPtr; /* Search element. */ Child *childPtr; /* Interim child record. */ Tcl_Obj **objv; int objc, i; Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */ InterpInfo *parentInfoPtr; if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { return NULL; } searchInterp = interp; for (i = 0; i < objc; i++) { parentInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo; hPtr = Tcl_FindHashEntry(&parentInfoPtr->parent.childTable, TclGetString(objv[i])); if (hPtr == NULL) { searchInterp = NULL; break; } childPtr = (Child *)Tcl_GetHashValue(hPtr); searchInterp = childPtr->childInterp; if (searchInterp == NULL) { break; } } if (searchInterp == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not find interpreter \"%s\"", TclGetString(pathPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP", TclGetString(pathPtr), NULL); } return searchInterp; } /* *---------------------------------------------------------------------- * * ChildBgerror -- * * Helper function to set/query the background error handling command * prefix of an interp * * Results: * A standard Tcl result. * * Side effects: * When (objc == 1), childInterp will be set to a new background handler * of objv[0]. * *---------------------------------------------------------------------- */ static int ChildBgerror( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ int objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { int length; if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cmdPrefix must be list of length >= 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BGERRORFORMAT", NULL); return TCL_ERROR; } TclSetBgErrorHandler(childInterp, objv[0]); } Tcl_SetObjResult(interp, TclGetBgErrorHandler(childInterp)); return TCL_OK; } /* *---------------------------------------------------------------------- * * ChildCreate -- * * Helper function to do the actual work of creating a child interp and * new object command. Also optionally makes the new child interpreter * "safe". * * Results: * Returns the new Tcl_Interp * if successful or NULL if not. If failed, * the result of the invoking interpreter contains an error message. * * Side effects: * Creates a new child interpreter and a new object command. * *---------------------------------------------------------------------- */ static Tcl_Interp * ChildCreate( Tcl_Interp *interp, /* Interp. to start search from. */ Tcl_Obj *pathPtr, /* Path (name) of child to create. */ int safe) /* Should we make it "safe"? */ { Tcl_Interp *parentInterp, *childInterp; Child *childPtr; InterpInfo *parentInfoPtr; Tcl_HashEntry *hPtr; const char *path; int isNew, objc; Tcl_Obj **objv; if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { return NULL; } if (objc < 2) { parentInterp = interp; path = TclGetString(pathPtr); } else { Tcl_Obj *objPtr; objPtr = Tcl_NewListObj(objc - 1, objv); parentInterp = GetInterp(interp, objPtr); Tcl_DecrRefCount(objPtr); if (parentInterp == NULL) { return NULL; } path = TclGetString(objv[objc - 1]); } if (safe == 0) { safe = Tcl_IsSafe(parentInterp); } parentInfoPtr = (InterpInfo *) ((Interp *) parentInterp)->interpInfo; hPtr = Tcl_CreateHashEntry(&parentInfoPtr->parent.childTable, path, &isNew); if (isNew == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "interpreter named \"%s\" already exists, cannot create", path)); return NULL; } childInterp = Tcl_CreateInterp(); childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; childPtr->parentInterp = parentInterp; childPtr->childEntryPtr = hPtr; childPtr->childInterp = childInterp; childPtr->interpCmd = Tcl_NRCreateCommand(parentInterp, path, ChildObjCmd, NRChildCmd, childInterp, ChildObjCmdDeleteProc); Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS); Tcl_SetHashValue(hPtr, childPtr); Tcl_SetVar(childInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); /* * Inherit the recursion limit. */ ((Interp *) childInterp)->maxNestingDepth = ((Interp *) parentInterp)->maxNestingDepth; if (safe) { if (Tcl_MakeSafe(childInterp) == TCL_ERROR) { goto error; } } else { if (Tcl_Init(childInterp) == TCL_ERROR) { goto error; } /* * This will create the "memory" command in child interpreters if we * compiled with TCL_MEM_DEBUG, otherwise it does nothing. */ Tcl_InitMemory(childInterp); } /* * Inherit the TIP#143 limits. */ InheritLimitsFromParent(childInterp, parentInterp); /* * The [clock] command presents a safe API, but uses unsafe features in * its implementation. This means it has to be implemented in safe interps * as an alias to a version in the (trusted) parent. */ if (safe) { Tcl_Obj *clockObj; int status; TclNewLiteralStringObj(clockObj, "clock"); Tcl_IncrRefCount(clockObj); status = AliasCreate(interp, childInterp, parentInterp, clockObj, clockObj, 0, NULL); Tcl_DecrRefCount(clockObj); if (status != TCL_OK) { goto error2; } } return childInterp; error: Tcl_TransferResult(childInterp, TCL_ERROR, interp); error2: Tcl_DeleteInterp(childInterp); return NULL; } /* *---------------------------------------------------------------------- * * ChildObjCmd -- * * Command to manipulate an interpreter, e.g. to send commands to it to * be evaluated. One such command exists for each child interpreter. * * Results: * A standard Tcl result. * * Side effects: * See user documentation for details. * *---------------------------------------------------------------------- */ static int ChildObjCmd( ClientData clientData, /* Child interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRChildCmd, clientData, objc, objv); } static int NRChildCmd( ClientData clientData, /* Child interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *childInterp = (Tcl_Interp *)clientData; int index; static const char *const options[] = { "alias", "aliases", "bgerror", "debug", "eval", "expose", "hide", "hidden", "issafe", "invokehidden", "limit", "marktrusted", "recursionlimit", NULL }; enum childCmdOptionsEnum { OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_DEBUG, OPT_EVAL, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT }; if (childInterp == NULL) { Tcl_Panic("ChildObjCmd: interpreter has been deleted"); } if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum childCmdOptionsEnum) index) { case OPT_ALIAS: if (objc > 2) { if (objc == 3) { return AliasDescribe(interp, childInterp, objv[2]); } if (TclGetString(objv[3])[0] == '\0') { if (objc == 4) { return AliasDelete(interp, childInterp, objv[2]); } } else { return AliasCreate(interp, childInterp, interp, objv[2], objv[3], objc - 4, objv + 4); } } Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?arg ...?"); return TCL_ERROR; case OPT_ALIASES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } return AliasList(interp, childInterp); case OPT_BGERROR: if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "?cmdPrefix?"); return TCL_ERROR; } return ChildBgerror(interp, childInterp, objc - 2, objv + 2); case OPT_DEBUG: /* * TIP #378 * Currently only -frame supported, otherwise ?-option ?value? ...? */ if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "?-frame ?bool??"); return TCL_ERROR; } return ChildDebugCmd(interp, childInterp, objc - 2, objv + 2); case OPT_EVAL: if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?"); return TCL_ERROR; } return ChildEval(interp, childInterp, objc - 2, objv + 2); case OPT_EXPOSE: if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?"); return TCL_ERROR; } return ChildExpose(interp, childInterp, objc - 2, objv + 2); case OPT_HIDE: if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?"); return TCL_ERROR; } return ChildHide(interp, childInterp, objc - 2, objv + 2); case OPT_HIDDEN: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } return ChildHidden(interp, childInterp); case OPT_ISSAFE: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp))); return TCL_OK; case OPT_INVOKEHIDDEN: { int i; const char *namespaceName; static const char *const hiddenOptions[] = { "-global", "-namespace", "--", NULL }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST }; namespaceName = NULL; for (i = 2; i < objc; i++) { if (TclGetString(objv[i])[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_GLOBAL) { namespaceName = "::"; } else if (index == OPT_NAMESPACE) { if (++i == objc) { /* There must be more arguments. */ break; } else { namespaceName = TclGetString(objv[i]); } } else { i++; break; } } if (objc - i < 1) { Tcl_WrongNumArgs(interp, 2, objv, "?-namespace ns? ?-global? ?--? cmd ?arg ..?"); return TCL_ERROR; } return ChildInvokeHidden(interp, childInterp, namespaceName, objc - i, objv + i); } case OPT_LIMIT: { static const char *const limitTypes[] = { "commands", "time", NULL }; enum LimitTypes { LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME }; int limitType; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0, &limitType) != TCL_OK) { return TCL_ERROR; } switch ((enum LimitTypes) limitType) { case LIMIT_TYPE_COMMANDS: return ChildCommandLimitCmd(interp, childInterp, 3, objc,objv); case LIMIT_TYPE_TIME: return ChildTimeLimitCmd(interp, childInterp, 3, objc, objv); } } break; case OPT_MARKTRUSTED: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } return ChildMarkTrusted(interp, childInterp); case OPT_RECLIMIT: if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?"); return TCL_ERROR; } return ChildRecursionLimit(interp, childInterp, objc - 2, objv + 2); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * ChildObjCmdDeleteProc -- * * Invoked when an object command for a child interpreter is deleted; * cleans up all state associated with the child interpreter and destroys * the child interpreter. * * Results: * None. * * Side effects: * Cleans up all state associated with the child interpreter and destroys * the child interpreter. * *---------------------------------------------------------------------- */ static void ChildObjCmdDeleteProc( ClientData clientData) /* The ChildRecord for the command. */ { Child *childPtr; /* Interim storage for Child record. */ Tcl_Interp *childInterp = (Tcl_Interp *)clientData; /* And for a child interp. */ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; /* * Unlink the child from its parent interpreter. */ Tcl_DeleteHashEntry(childPtr->childEntryPtr); /* * Set to NULL so that when the InterpInfo is cleaned up in the child it * does not try to delete the command causing all sorts of grief. See * ChildRecordDeleteProc(). */ childPtr->interpCmd = NULL; if (childPtr->childInterp != NULL) { Tcl_DeleteInterp(childPtr->childInterp); } } /* *---------------------------------------------------------------------- * * ChildDebugCmd -- TIP #378 * * Helper function to handle 'debug' command in a child interpreter. * * Results: * A standard Tcl result. * * Side effects: * May modify INTERP_DEBUG_FRAME flag in the child. * *---------------------------------------------------------------------- */ static int ChildDebugCmd( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const debugTypes[] = { "-frame", NULL }; enum DebugTypes { DEBUG_TYPE_FRAME }; int debugType; Interp *iPtr; Tcl_Obj *resultPtr; iPtr = (Interp *) childInterp; if (objc == 0) { TclNewObj(resultPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj("-frame", -1)); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME)); Tcl_SetObjResult(interp, resultPtr); } else { if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, "debug option", 0, &debugType) != TCL_OK) { return TCL_ERROR; } if (debugType == DEBUG_TYPE_FRAME) { if (objc == 2) { /* set */ if (Tcl_GetBooleanFromObj(interp, objv[1], &debugType) != TCL_OK) { return TCL_ERROR; } /* * Quietly ignore attempts to disable interp debugging. This * is a one-way switch as frame debug info is maintained in a * stack that must be consistent once turned on. */ if (debugType) { iPtr->flags |= INTERP_DEBUG_FRAME; } } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME)); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * ChildEval -- * * Helper function to evaluate a command in a child interpreter. * * Results: * A standard Tcl result. * * Side effects: * Whatever the command does. * *---------------------------------------------------------------------- */ static int ChildEval( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; /* * TIP #285: If necessary, reset the cancellation flags for the child * interpreter now; otherwise, canceling a script in a parent interpreter * can result in a situation where a child interpreter can no longer * evaluate any scripts unless somebody calls the TclResetCancellation * function for that particular Tcl_Interp. */ TclSetChildCancelFlags(childInterp, 0, 0); Tcl_Preserve(childInterp); Tcl_AllowExceptions(childInterp); if (objc == 1) { /* * TIP #280: Make actual argument location available to eval'd script. */ Interp *iPtr = (Interp *) interp; CmdFrame *invoker = iPtr->cmdFramePtr; int word = 0; TclArgumentGet(interp, objv[0], &invoker, &word); result = TclEvalObjEx(childInterp, objv[0], 0, invoker, word); } else { Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv); Tcl_IncrRefCount(objPtr); result = Tcl_EvalObjEx(childInterp, objPtr, 0); Tcl_DecrRefCount(objPtr); } Tcl_TransferResult(childInterp, result, interp); Tcl_Release(childInterp); return result; } /* *---------------------------------------------------------------------- * * ChildExpose -- * * Helper function to expose a command in a child interpreter. * * Results: * A standard Tcl result. * * Side effects: * After this call scripts in the child will be able to invoke the newly * exposed command. * *---------------------------------------------------------------------- */ static int ChildExpose( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot expose commands", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } name = TclGetString(objv[(objc == 1) ? 0 : 1]); if (Tcl_ExposeCommand(childInterp, TclGetString(objv[0]), name) != TCL_OK) { Tcl_TransferResult(childInterp, TCL_ERROR, interp); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * ChildRecursionLimit -- * * Helper function to set/query the Recursion limit of an interp * * Results: * A standard Tcl result. * * Side effects: * When (objc == 1), childInterp will be set to a new recursion limit of * objv[0]. * *---------------------------------------------------------------------- */ static int ChildRecursionLimit( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ int objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { Interp *iPtr; int limit; if (objc) { if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: " "safe interpreters cannot change recursion limit", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { return TCL_ERROR; } if (limit <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "recursion limit must be > 0", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT", NULL); return TCL_ERROR; } Tcl_SetRecursionLimit(childInterp, limit); iPtr = (Interp *) childInterp; if (interp == childInterp && iPtr->numLevels > limit) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "falling back due to new recursion limit", -1)); Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[0]); return TCL_OK; } else { limit = Tcl_SetRecursionLimit(childInterp, 0); Tcl_SetObjResult(interp, Tcl_NewIntObj(limit)); return TCL_OK; } } /* *---------------------------------------------------------------------- * * ChildHide -- * * Helper function to hide a command in a child interpreter. * * Results: * A standard Tcl result. * * Side effects: * After this call scripts in the child will no longer be able to invoke * the named command. * *---------------------------------------------------------------------- */ static int ChildHide( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot hide commands", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } name = TclGetString(objv[(objc == 1) ? 0 : 1]); if (Tcl_HideCommand(childInterp, TclGetString(objv[0]), name) != TCL_OK) { Tcl_TransferResult(childInterp, TCL_ERROR, interp); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * ChildHidden -- * * Helper function to compute list of hidden commands in a child * interpreter. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ChildHidden( Tcl_Interp *interp, /* Interp for data return. */ Tcl_Interp *childInterp) /* Interp whose hidden commands to query. */ { Tcl_Obj *listObjPtr; /* Local object pointer. */ Tcl_HashTable *hTblPtr; /* For local searches. */ Tcl_HashEntry *hPtr; /* For local searches. */ Tcl_HashSearch hSearch; /* For local searches. */ TclNewObj(listObjPtr); hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr; if (hTblPtr != NULL) { for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { Tcl_ListObjAppendElement(NULL, listObjPtr, Tcl_NewStringObj((const char *)Tcl_GetHashKey(hTblPtr, hPtr), -1)); } } Tcl_SetObjResult(interp, listObjPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * ChildInvokeHidden -- * * Helper function to invoke a hidden command in a child interpreter. * * Results: * A standard Tcl result. * * Side effects: * Whatever the hidden command does. * *---------------------------------------------------------------------- */ static int ChildInvokeHidden( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command will * be invoked. */ const char *namespaceName, /* The namespace to use, if any. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not allowed to invoke hidden commands from safe interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } Tcl_Preserve(childInterp); Tcl_AllowExceptions(childInterp); if (namespaceName == NULL) { NRE_callback *rootPtr = TOP_CB(childInterp); Tcl_NRAddCallback(interp, NRPostInvokeHidden, childInterp, rootPtr, NULL, NULL); return TclNRInvoke(NULL, childInterp, objc, objv); } else { Namespace *nsPtr, *dummy1, *dummy2; const char *tail; result = TclGetNamespaceForQualName(childInterp, namespaceName, NULL, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG | TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if (result == TCL_OK) { result = TclObjInvokeNamespace(childInterp, objc, objv, (Tcl_Namespace *) nsPtr, TCL_INVOKE_HIDDEN); } } Tcl_TransferResult(childInterp, result, interp); Tcl_Release(childInterp); return result; } static int NRPostInvokeHidden( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Interp *childInterp = (Tcl_Interp *)data[0]; NRE_callback *rootPtr = (NRE_callback *)data[1]; if (interp != childInterp) { result = TclNRRunCallbacks(childInterp, result, rootPtr); Tcl_TransferResult(childInterp, result, interp); } Tcl_Release(childInterp); return result; } /* *---------------------------------------------------------------------- * * ChildMarkTrusted -- * * Helper function to mark a child interpreter as trusted (unsafe). * * Results: * A standard Tcl result. * * Side effects: * After this call the hard-wired security checks in the core no longer * prevent the child from performing certain operations. * *---------------------------------------------------------------------- */ static int ChildMarkTrusted( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp) /* The child interpreter which will be marked * trusted. */ { if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot mark trusted", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } ((Interp *) childInterp)->flags &= ~SAFE_INTERP; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_IsSafe -- * * Determines whether an interpreter is safe * * Results: * 1 if it is safe, 0 if it is not. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_IsSafe( Tcl_Interp *interp) /* Is this interpreter "safe" ? */ { Interp *iPtr = (Interp *) interp; if (iPtr == NULL) { return 0; } return (iPtr->flags & SAFE_INTERP) ? 1 : 0; } /* *---------------------------------------------------------------------- * * Tcl_MakeSafe -- * * Makes its argument interpreter contain only functionality that is * defined to be part of Safe Tcl. Unsafe commands are hidden, the env * array is unset, and the standard channels are removed. * * Results: * None. * * Side effects: * Hides commands in its argument interpreter, and removes settings and * channels. * *---------------------------------------------------------------------- */ int Tcl_MakeSafe( Tcl_Interp *interp) /* Interpreter to be made safe. */ { Tcl_Channel chan; /* Channel to remove from safe interpreter. */ Interp *iPtr = (Interp *) interp; Tcl_Interp *parent = ((InterpInfo*) iPtr->interpInfo)->child.parentInterp; TclHideUnsafeCommands(interp); if (parent != NULL) { /* * Alias these function implementations in the child to those in the * parent; the overall implementations are safe, but they're normally * defined by init.tcl which is not sourced by safe interpreters. * Assume these functions all work. [Bug 2895741] */ (void) Tcl_Eval(interp, "namespace eval ::tcl {namespace eval mathfunc {}}"); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", parent, "::tcl::mathfunc::min", 0, NULL); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", parent, "::tcl::mathfunc::max", 0, NULL); } iPtr->flags |= SAFE_INTERP; /* * Unsetting variables : (which should not have been set in the first * place, but...) */ /* * No env array in a safe interpreter. */ Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY); /* * Remove unsafe parts of tcl_platform */ Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY); Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY); Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY); Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY); /* * Unset path information variables (the only one remaining is [info * nameofexecutable]) */ Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY); Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY); Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY); /* * Remove the standard channels from the interpreter; safe interpreters do * not ordinarily have access to stdin, stdout and stderr. * * NOTE: These channels are not added to the interpreter by the * Tcl_CreateInterp call, but may be added later, by another I/O * operation. We want to ensure that the interpreter does not have these * channels even if it is being made safe after being used for some time.. */ chan = Tcl_GetStdChannel(TCL_STDIN); if (chan != NULL) { Tcl_UnregisterChannel(interp, chan); } chan = Tcl_GetStdChannel(TCL_STDOUT); if (chan != NULL) { Tcl_UnregisterChannel(interp, chan); } chan = Tcl_GetStdChannel(TCL_STDERR); if (chan != NULL) { Tcl_UnregisterChannel(interp, chan); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LimitExceeded -- * * Tests whether any limit has been exceeded in the given interpreter * (i.e. whether the interpreter is currently unable to process further * scripts). * * Results: * A boolean value. * * Side effects: * None. * * Notes: * If you change this function, you MUST also update TclLimitExceeded() in * tclInt.h. *---------------------------------------------------------------------- */ int Tcl_LimitExceeded( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; return iPtr->limit.exceeded != 0; } /* *---------------------------------------------------------------------- * * Tcl_LimitReady -- * * Find out whether any limit has been set on the interpreter, and if so * check whether the granularity of that limit is such that the full * limit check should be carried out. * * Results: * A boolean value that indicates whether to call Tcl_LimitCheck. * * Side effects: * Increments the limit granularity counter. * * Notes: * If you change this function, you MUST also update TclLimitReady() in * tclInt.h. * *---------------------------------------------------------------------- */ int Tcl_LimitReady( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; if (iPtr->limit.active != 0) { int ticker = ++iPtr->limit.granularityTicker; if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) && ((iPtr->limit.cmdGranularity == 1) || (ticker % iPtr->limit.cmdGranularity == 0))) { return 1; } if ((iPtr->limit.active & TCL_LIMIT_TIME) && ((iPtr->limit.timeGranularity == 1) || (ticker % iPtr->limit.timeGranularity == 0))) { return 1; } } return 0; } /* *---------------------------------------------------------------------- * * Tcl_LimitCheck -- * * Check all currently set limits in the interpreter (where permitted by * granularity). If a limit is exceeded, call its callbacks and, if the * limit is still exceeded after the callbacks have run, make the * interpreter generate an error that cannot be caught within the limited * interpreter. * * Results: * A Tcl result value (TCL_OK if no limit is exceeded, and TCL_ERROR if a * limit has been exceeded). * * Side effects: * May invoke system calls. May invoke other interpreters. May be * reentrant. May put the interpreter into a state where it can no longer * execute commands without outside intervention. * *---------------------------------------------------------------------- */ int Tcl_LimitCheck( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; int ticker = iPtr->limit.granularityTicker; if (Tcl_InterpDeleted(interp)) { return TCL_OK; } if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) && ((iPtr->limit.cmdGranularity == 1) || (ticker % iPtr->limit.cmdGranularity == 0)) && (iPtr->limit.cmdCount < iPtr->cmdCount)) { iPtr->limit.exceeded |= TCL_LIMIT_COMMANDS; Tcl_Preserve(interp); RunLimitHandlers(iPtr->limit.cmdHandlers, interp); if (iPtr->limit.cmdCount >= iPtr->cmdCount) { iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS; } else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command count limit exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL); Tcl_Release(interp); return TCL_ERROR; } Tcl_Release(interp); } if ((iPtr->limit.active & TCL_LIMIT_TIME) && ((iPtr->limit.timeGranularity == 1) || (ticker % iPtr->limit.timeGranularity == 0))) { Tcl_Time now; Tcl_GetTime(&now); if (iPtr->limit.time.sec < now.sec || (iPtr->limit.time.sec == now.sec && iPtr->limit.time.usec < now.usec)) { iPtr->limit.exceeded |= TCL_LIMIT_TIME; Tcl_Preserve(interp); RunLimitHandlers(iPtr->limit.timeHandlers, interp); if (iPtr->limit.time.sec > now.sec || (iPtr->limit.time.sec == now.sec && iPtr->limit.time.usec >= now.usec)) { iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "time limit exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL); Tcl_Release(interp); return TCL_ERROR; } Tcl_Release(interp); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * RunLimitHandlers -- * * Invoke all the limit handlers in a list (for a particular limit). * Note that no particular limit handler callback will be invoked * reentrantly. * * Results: * None. * * Side effects: * Depends on the limit handlers. * *---------------------------------------------------------------------- */ static void RunLimitHandlers( LimitHandler *handlerPtr, Tcl_Interp *interp) { LimitHandler *nextPtr; for (; handlerPtr!=NULL ; handlerPtr=nextPtr) { if (handlerPtr->flags & (LIMIT_HANDLER_DELETED|LIMIT_HANDLER_ACTIVE)) { /* * Reentrant call or something seriously strange in the delete * code. */ nextPtr = handlerPtr->nextPtr; continue; } /* * Set the ACTIVE flag while running the limit handler itself so we * cannot reentrantly call this handler and know to use the alternate * method of deletion if necessary. */ handlerPtr->flags |= LIMIT_HANDLER_ACTIVE; handlerPtr->handlerProc(handlerPtr->clientData, interp); handlerPtr->flags &= ~LIMIT_HANDLER_ACTIVE; /* * Rediscover this value; it might have changed during the processing * of a limit handler. We have to record it here because we might * delete the structure below, and reading a value out of a deleted * structure is unsafe (even if actually legal with some * malloc()/free() implementations.) */ nextPtr = handlerPtr->nextPtr; /* * If we deleted the current handler while we were executing it, we * will have spliced it out of the list and set the * LIMIT_HANDLER_DELETED flag. */ if (handlerPtr->flags & LIMIT_HANDLER_DELETED) { if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } ckfree(handlerPtr); } } } /* *---------------------------------------------------------------------- * * Tcl_LimitAddHandler -- * * Add a callback handler for a particular resource limit. * * Results: * None. * * Side effects: * Extends the internal linked list of handlers for a limit. * *---------------------------------------------------------------------- */ /* Bug 52dbc4b3f8: wrap Tcl_Free since it is not a Tcl_LimitHandlerDeleteProc. */ static void WrapFree( void *ptr) { ckfree(ptr); } void Tcl_LimitAddHandler( Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc) { Interp *iPtr = (Interp *) interp; LimitHandler *handlerPtr; /* * Convert everything into a real deletion callback. */ if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) { deleteProc = WrapFree; } /* * Allocate a handler record. */ handlerPtr = (LimitHandler *)ckalloc(sizeof(LimitHandler)); handlerPtr->flags = 0; handlerPtr->handlerProc = handlerProc; handlerPtr->clientData = clientData; handlerPtr->deleteProc = deleteProc; handlerPtr->prevPtr = NULL; /* * Prepend onto the front of the correct linked list. */ switch (type) { case TCL_LIMIT_COMMANDS: handlerPtr->nextPtr = iPtr->limit.cmdHandlers; if (handlerPtr->nextPtr != NULL) { handlerPtr->nextPtr->prevPtr = handlerPtr; } iPtr->limit.cmdHandlers = handlerPtr; return; case TCL_LIMIT_TIME: handlerPtr->nextPtr = iPtr->limit.timeHandlers; if (handlerPtr->nextPtr != NULL) { handlerPtr->nextPtr->prevPtr = handlerPtr; } iPtr->limit.timeHandlers = handlerPtr; return; } Tcl_Panic("unknown type of resource limit"); } /* *---------------------------------------------------------------------- * * Tcl_LimitRemoveHandler -- * * Remove a callback handler for a particular resource limit. * * Results: * None. * * Side effects: * The handler is spliced out of the internal linked list for the limit, * and if not currently being invoked, deleted. Otherwise it is just * marked for deletion and removed when the limit handler has finished * executing. * *---------------------------------------------------------------------- */ void Tcl_LimitRemoveHandler( Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData) { Interp *iPtr = (Interp *) interp; LimitHandler *handlerPtr; switch (type) { case TCL_LIMIT_COMMANDS: handlerPtr = iPtr->limit.cmdHandlers; break; case TCL_LIMIT_TIME: handlerPtr = iPtr->limit.timeHandlers; break; default: Tcl_Panic("unknown type of resource limit"); return; } for (; handlerPtr!=NULL ; handlerPtr=handlerPtr->nextPtr) { if ((handlerPtr->handlerProc != handlerProc) || (handlerPtr->clientData != clientData)) { continue; } /* * We've found the handler to delete; mark it as doomed if not already * so marked (which shouldn't actually happen). */ if (handlerPtr->flags & LIMIT_HANDLER_DELETED) { return; } handlerPtr->flags |= LIMIT_HANDLER_DELETED; /* * Splice the handler out of the doubly-linked list. */ if (handlerPtr->prevPtr == NULL) { switch (type) { case TCL_LIMIT_COMMANDS: iPtr->limit.cmdHandlers = handlerPtr->nextPtr; break; case TCL_LIMIT_TIME: iPtr->limit.timeHandlers = handlerPtr->nextPtr; break; } } else { handlerPtr->prevPtr->nextPtr = handlerPtr->nextPtr; } if (handlerPtr->nextPtr != NULL) { handlerPtr->nextPtr->prevPtr = handlerPtr->prevPtr; } /* * If nothing is currently executing the handler, delete its client * data and the overall handler structure now. Otherwise it will all * go away when the handler returns. */ if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } ckfree(handlerPtr); } return; } } /* *---------------------------------------------------------------------- * * TclLimitRemoveAllHandlers -- * * Remove all limit callback handlers for an interpreter. This is invoked * as part of deleting the interpreter. * * Results: * None. * * Side effects: * Limit handlers are deleted or marked for deletion (as with * Tcl_LimitRemoveHandler). * *---------------------------------------------------------------------- */ void TclLimitRemoveAllHandlers( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; LimitHandler *handlerPtr, *nextHandlerPtr; /* * Delete all command-limit handlers. */ for (handlerPtr=iPtr->limit.cmdHandlers, iPtr->limit.cmdHandlers=NULL; handlerPtr!=NULL; handlerPtr=nextHandlerPtr) { nextHandlerPtr = handlerPtr->nextPtr; /* * Do not delete here if it has already been marked for deletion. */ if (handlerPtr->flags & LIMIT_HANDLER_DELETED) { continue; } handlerPtr->flags |= LIMIT_HANDLER_DELETED; handlerPtr->prevPtr = NULL; handlerPtr->nextPtr = NULL; /* * If nothing is currently executing the handler, delete its client * data and the overall handler structure now. Otherwise it will all * go away when the handler returns. */ if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } ckfree(handlerPtr); } } /* * Delete all time-limit handlers. */ for (handlerPtr=iPtr->limit.timeHandlers, iPtr->limit.timeHandlers=NULL; handlerPtr!=NULL; handlerPtr=nextHandlerPtr) { nextHandlerPtr = handlerPtr->nextPtr; /* * Do not delete here if it has already been marked for deletion. */ if (handlerPtr->flags & LIMIT_HANDLER_DELETED) { continue; } handlerPtr->flags |= LIMIT_HANDLER_DELETED; handlerPtr->prevPtr = NULL; handlerPtr->nextPtr = NULL; /* * If nothing is currently executing the handler, delete its client * data and the overall handler structure now. Otherwise it will all * go away when the handler returns. */ if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } ckfree(handlerPtr); } } /* * Delete the timer callback that is used to trap limits that occur in * [vwait]s... */ if (iPtr->limit.timeEvent != NULL) { Tcl_DeleteTimerHandler(iPtr->limit.timeEvent); iPtr->limit.timeEvent = NULL; } } /* *---------------------------------------------------------------------- * * Tcl_LimitTypeEnabled -- * * Check whether a particular limit has been enabled for an interpreter. * * Results: * A boolean value. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_LimitTypeEnabled( Tcl_Interp *interp, int type) { Interp *iPtr = (Interp *) interp; return (iPtr->limit.active & type) != 0; } /* *---------------------------------------------------------------------- * * Tcl_LimitTypeExceeded -- * * Check whether a particular limit has been exceeded for an interpreter. * * Results: * A boolean value (note that Tcl_LimitExceeded will always return * non-zero when this function returns non-zero). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_LimitTypeExceeded( Tcl_Interp *interp, int type) { Interp *iPtr = (Interp *) interp; return (iPtr->limit.exceeded & type) != 0; } /* *---------------------------------------------------------------------- * * Tcl_LimitTypeSet -- * * Enable a particular limit for an interpreter. * * Results: * None. * * Side effects: * The limit is turned on and will be checked in future at an interval * determined by the frequency of calling of Tcl_LimitReady and the * granularity of the limit in question. * *---------------------------------------------------------------------- */ void Tcl_LimitTypeSet( Tcl_Interp *interp, int type) { Interp *iPtr = (Interp *) interp; iPtr->limit.active |= type; } /* *---------------------------------------------------------------------- * * Tcl_LimitTypeReset -- * * Disable a particular limit for an interpreter. * * Results: * None. * * Side effects: * The limit is disabled. If the limit was exceeded when this function * was called, the limit will no longer be exceeded afterwards and the * interpreter will be free to execute further scripts (assuming it isn't * also deleted, of course). * *---------------------------------------------------------------------- */ void Tcl_LimitTypeReset( Tcl_Interp *interp, int type) { Interp *iPtr = (Interp *) interp; iPtr->limit.active &= ~type; iPtr->limit.exceeded &= ~type; } /* *---------------------------------------------------------------------- * * Tcl_LimitSetCommands -- * * Set the command limit for an interpreter. * * Results: * None. * * Side effects: * Also resets whether the command limit was exceeded. This might permit * a small amount of further execution in the interpreter even if the * limit itself is theoretically exceeded. * *---------------------------------------------------------------------- */ void Tcl_LimitSetCommands( Tcl_Interp *interp, int commandLimit) { Interp *iPtr = (Interp *) interp; iPtr->limit.cmdCount = commandLimit; iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS; } /* *---------------------------------------------------------------------- * * Tcl_LimitGetCommands -- * * Get the number of commands that may be executed in the interpreter * before the command-limit is reached. * * Results: * An upper bound on the number of commands. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_LimitGetCommands( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; return iPtr->limit.cmdCount; } /* *---------------------------------------------------------------------- * * Tcl_LimitSetTime -- * * Set the time limit for an interpreter by copying it from the value * pointed to by the timeLimitPtr argument. * * Results: * None. * * Side effects: * Also resets whether the time limit was exceeded. This might permit a * small amount of further execution in the interpreter even if the limit * itself is theoretically exceeded. * *---------------------------------------------------------------------- */ void Tcl_LimitSetTime( Tcl_Interp *interp, Tcl_Time *timeLimitPtr) { Interp *iPtr = (Interp *) interp; Tcl_Time nextMoment; memcpy(&iPtr->limit.time, timeLimitPtr, sizeof(Tcl_Time)); if (iPtr->limit.timeEvent != NULL) { Tcl_DeleteTimerHandler(iPtr->limit.timeEvent); } nextMoment.sec = timeLimitPtr->sec; nextMoment.usec = timeLimitPtr->usec+10; if (nextMoment.usec >= 1000000) { nextMoment.sec++; nextMoment.usec -= 1000000; } iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment, TimeLimitCallback, interp); iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } /* *---------------------------------------------------------------------- * * TimeLimitCallback -- * * Callback that allows time limits to be enforced even when doing a * blocking wait for events. * * Results: * None. * * Side effects: * May put the interpreter into a state where it can no longer execute * commands. May make callbacks into other interpreters. * *---------------------------------------------------------------------- */ static void TimeLimitCallback( ClientData clientData) { Tcl_Interp *interp = (Tcl_Interp *)clientData; Interp *iPtr = (Interp *)clientData; int code; Tcl_Preserve(interp); iPtr->limit.timeEvent = NULL; /* * Must reset the granularity ticker here to force an immediate full * check. This is OK because we're swallowing the cost in the overall cost * of the event loop. [Bug 2891362] */ iPtr->limit.granularityTicker = 0; code = Tcl_LimitCheck(interp); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (while waiting for event)"); Tcl_BackgroundException(interp, code); } Tcl_Release(interp); } /* *---------------------------------------------------------------------- * * Tcl_LimitGetTime -- * * Get the current time limit. * * Results: * The time limit (by it being copied into the variable pointed to by the * timeLimitPtr). * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_LimitGetTime( Tcl_Interp *interp, Tcl_Time *timeLimitPtr) { Interp *iPtr = (Interp *) interp; memcpy(timeLimitPtr, &iPtr->limit.time, sizeof(Tcl_Time)); } /* *---------------------------------------------------------------------- * * Tcl_LimitSetGranularity -- * * Set the granularity divisor (which must be positive) for a particular * limit. * * Results: * None. * * Side effects: * The granularity is updated. * *---------------------------------------------------------------------- */ void Tcl_LimitSetGranularity( Tcl_Interp *interp, int type, int granularity) { Interp *iPtr = (Interp *) interp; if (granularity < 1) { Tcl_Panic("limit granularity must be positive"); } switch (type) { case TCL_LIMIT_COMMANDS: iPtr->limit.cmdGranularity = granularity; return; case TCL_LIMIT_TIME: iPtr->limit.timeGranularity = granularity; return; } Tcl_Panic("unknown type of resource limit"); } /* *---------------------------------------------------------------------- * * Tcl_LimitGetGranularity -- * * Get the granularity divisor for a particular limit. * * Results: * The granularity divisor for the given limit. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_LimitGetGranularity( Tcl_Interp *interp, int type) { Interp *iPtr = (Interp *) interp; switch (type) { case TCL_LIMIT_COMMANDS: return iPtr->limit.cmdGranularity; case TCL_LIMIT_TIME: return iPtr->limit.timeGranularity; } Tcl_Panic("unknown type of resource limit"); return -1; /* NOT REACHED */ } /* *---------------------------------------------------------------------- * * DeleteScriptLimitCallback -- * * Callback for when a script limit (a limit callback implemented as a * Tcl script in a parent interpreter, as set up from Tcl) is deleted. * * Results: * None. * * Side effects: * The reference to the script callback from the controlling interpreter * is removed. * *---------------------------------------------------------------------- */ static void DeleteScriptLimitCallback( ClientData clientData) { ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData; Tcl_DecrRefCount(limitCBPtr->scriptObj); if (limitCBPtr->entryPtr != NULL) { Tcl_DeleteHashEntry(limitCBPtr->entryPtr); } ckfree(limitCBPtr); } /* *---------------------------------------------------------------------- * * CallScriptLimitCallback -- * * Invoke a script limit callback. Used to implement limit callbacks set * at the Tcl level on child interpreters. * * Results: * None. * * Side effects: * Depends on the callback script. Errors are reported as background * errors. * *---------------------------------------------------------------------- */ static void CallScriptLimitCallback( ClientData clientData, Tcl_Interp *interp) /* Interpreter which failed the limit */ { ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData; int code; if (Tcl_InterpDeleted(limitCBPtr->interp)) { return; } Tcl_Preserve(limitCBPtr->interp); code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj, TCL_EVAL_GLOBAL); if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) { Tcl_BackgroundException(limitCBPtr->interp, code); } Tcl_Release(limitCBPtr->interp); } /* *---------------------------------------------------------------------- * * SetScriptLimitCallback -- * * Install (or remove, if scriptObj is NULL) a limit callback script that * is called when the target interpreter exceeds the type of limit * specified. Each interpreter may only have one callback set on another * interpreter through this mechanism (though as many interpreters may be * limited as the programmer chooses overall). * * Results: * None. * * Side effects: * A limit callback implemented as an invocation of a Tcl script in * another interpreter is either installed or removed. * *---------------------------------------------------------------------- */ static void SetScriptLimitCallback( Tcl_Interp *interp, int type, Tcl_Interp *targetInterp, Tcl_Obj *scriptObj) { ScriptLimitCallback *limitCBPtr; Tcl_HashEntry *hashPtr; int isNew; ScriptLimitCallbackKey key; Interp *iPtr = (Interp *) interp; if (interp == targetInterp) { Tcl_Panic("installing limit callback to the limited interpreter"); } key.interp = targetInterp; key.type = type; if (scriptObj == NULL) { hashPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hashPtr != NULL) { Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback, Tcl_GetHashValue(hashPtr)); } return; } hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, &key, &isNew); if (!isNew) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hashPtr); limitCBPtr->entryPtr = NULL; Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback, limitCBPtr); } limitCBPtr = (ScriptLimitCallback *)ckalloc(sizeof(ScriptLimitCallback)); limitCBPtr->interp = interp; limitCBPtr->scriptObj = scriptObj; limitCBPtr->entryPtr = hashPtr; limitCBPtr->type = type; Tcl_IncrRefCount(scriptObj); Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback, limitCBPtr, DeleteScriptLimitCallback); Tcl_SetHashValue(hashPtr, limitCBPtr); } /* *---------------------------------------------------------------------- * * TclRemoveScriptLimitCallbacks -- * * Remove all script-implemented limit callbacks that make calls back * into the given interpreter. This invoked as part of deleting an * interpreter. * * Results: * None. * * Side effects: * The script limit callbacks are removed or marked for later removal. * *---------------------------------------------------------------------- */ void TclRemoveScriptLimitCallbacks( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hashPtr; Tcl_HashSearch search; ScriptLimitCallbackKey *keyPtr; hashPtr = Tcl_FirstHashEntry(&iPtr->limit.callbacks, &search); while (hashPtr != NULL) { keyPtr = (ScriptLimitCallbackKey *) Tcl_GetHashKey(&iPtr->limit.callbacks, hashPtr); Tcl_LimitRemoveHandler(keyPtr->interp, keyPtr->type, CallScriptLimitCallback, Tcl_GetHashValue(hashPtr)); hashPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&iPtr->limit.callbacks); } /* *---------------------------------------------------------------------- * * TclInitLimitSupport -- * * Initialise all the parts of the interpreter relating to resource limit * management. This allows an interpreter to both have limits set upon * itself and set limits upon other interpreters. * * Results: * None. * * Side effects: * The resource limit subsystem is initialised for the interpreter. * *---------------------------------------------------------------------- */ void TclInitLimitSupport( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; iPtr->limit.active = 0; iPtr->limit.granularityTicker = 0; iPtr->limit.exceeded = 0; iPtr->limit.cmdCount = 0; iPtr->limit.cmdHandlers = NULL; iPtr->limit.cmdGranularity = 1; memset(&iPtr->limit.time, 0, sizeof(Tcl_Time)); iPtr->limit.timeHandlers = NULL; iPtr->limit.timeEvent = NULL; iPtr->limit.timeGranularity = 10; Tcl_InitHashTable(&iPtr->limit.callbacks, sizeof(ScriptLimitCallbackKey)/sizeof(int)); } /* *---------------------------------------------------------------------- * * InheritLimitsFromParent -- * * Derive the interpreter limit configuration for a child interpreter * from the limit config for the parent. * * Results: * None. * * Side effects: * The child interpreter limits are set so that if the parent has a * limit, it may not exceed it by handing off work to child interpreters. * Note that this does not transfer limit callbacks from the parent to * the child. * *---------------------------------------------------------------------- */ static void InheritLimitsFromParent( Tcl_Interp *childInterp, Tcl_Interp *parentInterp) { Interp *childPtr = (Interp *) childInterp; Interp *parentPtr = (Interp *) parentInterp; if (parentPtr->limit.active & TCL_LIMIT_COMMANDS) { childPtr->limit.active |= TCL_LIMIT_COMMANDS; childPtr->limit.cmdCount = 0; childPtr->limit.cmdGranularity = parentPtr->limit.cmdGranularity; } if (parentPtr->limit.active & TCL_LIMIT_TIME) { childPtr->limit.active |= TCL_LIMIT_TIME; memcpy(&childPtr->limit.time, &parentPtr->limit.time, sizeof(Tcl_Time)); childPtr->limit.timeGranularity = parentPtr->limit.timeGranularity; } } /* *---------------------------------------------------------------------- * * ChildCommandLimitCmd -- * * Implementation of the [interp limit $i commands] and [$i limit * commands] subcommands. See the interp manual page for a full * description. * * Results: * A standard Tcl result. * * Side effects: * Depends on the arguments. * *---------------------------------------------------------------------- */ static int ChildCommandLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ int consumedObjc, /* Number of args already parsed. */ int objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { "-command", "-granularity", "-value", NULL }; enum Options { OPT_CMD, OPT_GRAN, OPT_VAL }; Interp *iPtr = (Interp *) interp; int index; ScriptLimitCallbackKey key; ScriptLimitCallback *limitCBPtr; Tcl_HashEntry *hPtr; /* * First, ensure that we are not reading or writing the calling * interpreter's limits; it may only manipulate its children. Note that * the low level API enforces this with Tcl_Panic, which we want to * avoid. [Bug 3398794] */ if (interp == childInterp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "limits on current interpreter inaccessible", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL); return TCL_ERROR; } if (objc == consumedObjc) { Tcl_Obj *dictPtr; TclNewObj(dictPtr); key.interp = childInterp; key.type = TCL_LIMIT_COMMANDS; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); } else { goto putEmptyCommandInDict; } } else { Tcl_Obj *empty; putEmptyCommandInDict: TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), empty); } Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1), Tcl_NewIntObj(Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_COMMANDS))); if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) { Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1), Tcl_NewIntObj(Tcl_LimitGetCommands(childInterp))); } else { Tcl_Obj *empty; TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1), empty); } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; } else if (objc == consumedObjc+1) { if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { case OPT_CMD: key.interp = childInterp; key.type = TCL_LIMIT_COMMANDS; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_SetObjResult(interp, limitCBPtr->scriptObj); } } break; case OPT_GRAN: Tcl_SetObjResult(interp, Tcl_NewIntObj( Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_COMMANDS))); break; case OPT_VAL: if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) { Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_LimitGetCommands(childInterp))); } break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { int i, scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; for (i=consumedObjc ; i 0 ? scriptObj : NULL)); } if (granObj != NULL) { Tcl_LimitSetGranularity(childInterp, TCL_LIMIT_COMMANDS, gran); } if (limitObj != NULL) { if (limitLen > 0) { Tcl_LimitSetCommands(childInterp, limit); Tcl_LimitTypeSet(childInterp, TCL_LIMIT_COMMANDS); } else { Tcl_LimitTypeReset(childInterp, TCL_LIMIT_COMMANDS); } } return TCL_OK; } } /* *---------------------------------------------------------------------- * * ChildTimeLimitCmd -- * * Implementation of the [interp limit $i time] and [$i limit time] * subcommands. See the interp manual page for a full description. * * Results: * A standard Tcl result. * * Side effects: * Depends on the arguments. * *---------------------------------------------------------------------- */ static int ChildTimeLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ int consumedObjc, /* Number of args already parsed. */ int objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { "-command", "-granularity", "-milliseconds", "-seconds", NULL }; enum Options { OPT_CMD, OPT_GRAN, OPT_MILLI, OPT_SEC }; Interp *iPtr = (Interp *) interp; int index; ScriptLimitCallbackKey key; ScriptLimitCallback *limitCBPtr; Tcl_HashEntry *hPtr; /* * First, ensure that we are not reading or writing the calling * interpreter's limits; it may only manipulate its children. Note that * the low level API enforces this with Tcl_Panic, which we want to * avoid. [Bug 3398794] */ if (interp == childInterp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "limits on current interpreter inaccessible", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL); return TCL_ERROR; } if (objc == consumedObjc) { Tcl_Obj *dictPtr; TclNewObj(dictPtr); key.interp = childInterp; key.type = TCL_LIMIT_TIME; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); } else { goto putEmptyCommandInDict; } } else { Tcl_Obj *empty; putEmptyCommandInDict: TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), empty); } Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1), Tcl_NewIntObj(Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_TIME))); if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) { Tcl_Time limitMoment; Tcl_LimitGetTime(childInterp, &limitMoment); Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1), Tcl_NewLongObj(limitMoment.usec/1000)); Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1), Tcl_NewLongObj(limitMoment.sec)); } else { Tcl_Obj *empty; TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1), empty); Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1), empty); } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; } else if (objc == consumedObjc+1) { if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { case OPT_CMD: key.interp = childInterp; key.type = TCL_LIMIT_TIME; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_SetObjResult(interp, limitCBPtr->scriptObj); } } break; case OPT_GRAN: Tcl_SetObjResult(interp, Tcl_NewIntObj( Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_TIME))); break; case OPT_MILLI: if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) { Tcl_Time limitMoment; Tcl_LimitGetTime(childInterp, &limitMoment); Tcl_SetObjResult(interp, Tcl_NewLongObj(limitMoment.usec/1000)); } break; case OPT_SEC: if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) { Tcl_Time limitMoment; Tcl_LimitGetTime(childInterp, &limitMoment); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limitMoment.sec)); } break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { int i, scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; Tcl_Time limitMoment; int tmp; Tcl_LimitGetTime(childInterp, &limitMoment); for (i=consumedObjc ; i LONG_MAX) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seconds must be between 0 and %ld", LONG_MAX)); goto badValue; } if (sec < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "seconds must be at least 0", -1)); badValue: Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } limitMoment.sec = sec; break; } } } if (milliObj != NULL || secObj != NULL) { if (milliObj != NULL) { /* * Setting -milliseconds but clearing -seconds, or resetting * -milliseconds but not resetting -seconds? Bad voodoo! */ if (secObj != NULL && secLen == 0 && milliLen > 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may only set -milliseconds if -seconds is not " "also being reset", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADUSAGE", NULL); return TCL_ERROR; } if (milliLen == 0 && (secObj == NULL || secLen > 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may only reset -milliseconds if -seconds is " "also being reset", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADUSAGE", NULL); return TCL_ERROR; } } if (milliLen > 0 || secLen > 0) { /* * Force usec to be in range [0..1000000), possibly * incrementing sec in the process. This makes it much easier * for people to write scripts that do small time increments. */ limitMoment.sec += limitMoment.usec / 1000000; limitMoment.usec %= 1000000; Tcl_LimitSetTime(childInterp, &limitMoment); Tcl_LimitTypeSet(childInterp, TCL_LIMIT_TIME); } else { Tcl_LimitTypeReset(childInterp, TCL_LIMIT_TIME); } } if (scriptObj != NULL) { SetScriptLimitCallback(interp, TCL_LIMIT_TIME, childInterp, (scriptLen > 0 ? scriptObj : NULL)); } if (granObj != NULL) { Tcl_LimitSetGranularity(childInterp, TCL_LIMIT_TIME, gran); } return TCL_OK; } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclInt.h0000644000175000017500000052330314560736524014701 0ustar sergeisergei/* * tclInt.h -- * * Declarations of things used internally by the Tcl interpreter. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1993-1997 Lucent Technologies. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2007 Daniel A. Steffen * Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved. * Copyright (c) 2008 by Miguel Sofer. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLINT #define _TCLINT /* * Some numerics configuration options. */ #undef ACCEPT_NAN /* * Common include files needed by most of the Tcl source files are included * here, so that system-dependent personalizations for the include files only * have to be made in once place. This results in a few extra includes, but * greater modularity. The order of the three groups of #includes is * important. For example, stdio.h is needed by tcl.h. */ #include "tclPort.h" #include #include #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else # include #endif #ifdef NO_STRING_H #include "../compat/string.h" #else #include #endif #if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \ || defined(__cplusplus) || defined(_MSC_VER) || defined(__ICC) #include #else typedef int ptrdiff_t; #endif /* * Ensure WORDS_BIGENDIAN is defined correctly: * Needs to happen here in addition to configure to work with fat compiles on * Darwin (where configure runs only once for multiple architectures). */ #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_PARAM_H # include #endif #ifdef BYTE_ORDER # ifdef BIG_ENDIAN # if BYTE_ORDER == BIG_ENDIAN # undef WORDS_BIGENDIAN # define WORDS_BIGENDIAN 1 # endif # endif # ifdef LITTLE_ENDIAN # if BYTE_ORDER == LITTLE_ENDIAN # undef WORDS_BIGENDIAN # endif # endif #endif /* * Used to tag functions that are only to be visible within the module being * built and not outside it (where this is supported by the linker). */ #ifndef MODULE_SCOPE # ifdef __cplusplus # define MODULE_SCOPE extern "C" # else # define MODULE_SCOPE extern # endif #endif /* * Macros used to cast between pointers and integers (e.g. when storing an int * in ClientData), on 64-bit architectures they avoid gcc warning about "cast * to/from pointer from/to integer of different size". */ #if !defined(INT2PTR) && !defined(PTR2INT) # if defined(HAVE_INTPTR_T) || defined(intptr_t) # define INT2PTR(p) ((void *)(intptr_t)(p)) # define PTR2INT(p) ((int)(intptr_t)(p)) # else # define INT2PTR(p) ((void *)(p)) # define PTR2INT(p) ((int)(p)) # endif #endif #if !defined(UINT2PTR) && !defined(PTR2UINT) # if defined(HAVE_UINTPTR_T) || defined(uintptr_t) # define UINT2PTR(p) ((void *)(uintptr_t)(p)) # define PTR2UINT(p) ((unsigned int)(uintptr_t)(p)) # else # define UINT2PTR(p) ((void *)(p)) # define PTR2UINT(p) ((unsigned int)(p)) # endif #endif #if defined(_WIN32) && defined(_MSC_VER) # define vsnprintf _vsnprintf # define snprintf _snprintf #endif /* * The following procedures allow namespaces to be customized to support * special name resolution rules for commands/variables. */ struct Tcl_ResolvedVarInfo; typedef Tcl_Var (Tcl_ResolveRuntimeVarProc)(Tcl_Interp *interp, struct Tcl_ResolvedVarInfo *vinfoPtr); typedef void (Tcl_ResolveVarDeleteProc)(struct Tcl_ResolvedVarInfo *vinfoPtr); /* * The following structure encapsulates the routines needed to resolve a * variable reference at runtime. Any variable specific state will typically * be appended to this structure. */ typedef struct Tcl_ResolvedVarInfo { Tcl_ResolveRuntimeVarProc *fetchProc; Tcl_ResolveVarDeleteProc *deleteProc; } Tcl_ResolvedVarInfo; typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp, CONST84 char *name, int length, Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr); typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name, Tcl_Namespace *context, int flags, Tcl_Var *rPtr); typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name, Tcl_Namespace *context, int flags, Tcl_Command *rPtr); typedef struct Tcl_ResolverInfo { Tcl_ResolveCmdProc *cmdResProc; /* Procedure handling command name * resolution. */ Tcl_ResolveVarProc *varResProc; /* Procedure handling variable name resolution * for variables that can only be handled at * runtime. */ Tcl_ResolveCompiledVarProc *compiledVarResProc; /* Procedure handling variable name resolution * at compile time. */ } Tcl_ResolverInfo; /* * This flag bit should not interfere with TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable * lookup is performed for upvar (or similar) purposes, with slightly * different rules: * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers * * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag * (Bug #835020) */ #define TCL_AVOID_RESOLVERS 0x40000 /* *---------------------------------------------------------------- * Data structures related to namespaces. *---------------------------------------------------------------- */ typedef struct Tcl_Ensemble Tcl_Ensemble; typedef struct NamespacePathEntry NamespacePathEntry; /* * Special hashtable for variables: This is just a Tcl_HashTable with a nsPtr * field added at the end, so that variables can find their namespace * without having to copy a pointer in their struct by accessing them via * their hPtr->tablePtr. */ typedef struct TclVarHashTable { Tcl_HashTable table; struct Namespace *nsPtr; } TclVarHashTable; /* * This is for itcl - it likes to search our varTables directly :( */ #define TclVarHashFindVar(tablePtr, key) \ TclVarHashCreateVar((tablePtr), (key), NULL) /* * Define this to reduce the amount of space that the average namespace * consumes by only allocating the table of child namespaces when necessary. * Defining it breaks compatibility for Tcl extensions (e.g., itcl) which * reach directly into the Namespace structure. */ #undef BREAK_NAMESPACE_COMPAT /* * The structure below defines a namespace. * Note: the first five fields must match exactly the fields in a * Tcl_Namespace structure (see tcl.h). If you change one, be sure to change * the other. */ typedef struct Namespace { char *name; /* The namespace's simple (unqualified) name. * This contains no ::'s. The name of the * global namespace is "" although "::" is an * synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ ClientData clientData; /* An arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Procedure invoked when deleting the * namespace to, e.g., free clientData. */ struct Namespace *parentPtr;/* Points to the namespace that contains this * one. NULL if this is the global * namespace. */ #ifndef BREAK_NAMESPACE_COMPAT Tcl_HashTable childTable; /* Contains any child namespaces. Indexed by * strings; values have type (Namespace *). */ #else Tcl_HashTable *childTablePtr; /* Contains any child namespaces. Indexed by * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif long nsId; /* Unique id for the namespace. */ Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status * flags NS_DYING and NS_DEAD listed below. */ int activationCount; /* Number of "activations" or active call * frames for this namespace that are on the * Tcl call stack. The namespace won't be * freed until activationCount becomes zero. */ int refCount; /* Count of references by namespaceName * objects. The namespace can't be freed until * refCount becomes zero. */ Tcl_HashTable cmdTable; /* Contains all the commands currently * registered in the namespace. Indexed by * strings; values have type (Command *). * Commands imported by Tcl_Import have * Command structures that point (via an * ImportedCmdRef structure) to the Command * structure in the source namespace's command * table. */ TclVarHashTable varTable; /* Contains all the (global) variables * currently in this namespace. Indexed by * strings; values have type (Var *). */ char **exportArrayPtr; /* Points to an array of string patterns * specifying which commands are exported. A * pattern may include "string match" style * wildcard characters to specify multiple * commands; however, no namespace qualifiers * are allowed. NULL if no export patterns are * registered. */ int numExportPatterns; /* Number of export patterns currently * registered using "namespace export". */ int maxExportPatterns; /* Number of export patterns for which space * is currently allocated. */ int cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ int resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This * invalidates all byte codes compiled in the * namespace, causing the code to be * recompiled under the new rules.*/ Tcl_ResolveCmdProc *cmdResProc; /* If non-null, this procedure overrides the * usual command resolution mechanism in Tcl. * This procedure is invoked within * Tcl_FindCommand to resolve all command * references within the namespace. */ Tcl_ResolveVarProc *varResProc; /* If non-null, this procedure overrides the * usual variable resolution mechanism in Tcl. * This procedure is invoked within * Tcl_FindNamespaceVar to resolve all * variable references within the namespace at * runtime. */ Tcl_ResolveCompiledVarProc *compiledVarResProc; /* If non-null, this procedure overrides the * usual variable resolution mechanism in Tcl. * This procedure is invoked within * LookupCompiledLocal to resolve variable * references within the namespace at compile * time. */ int exportLookupEpoch; /* Incremented whenever a command is added to * a namespace, removed from a namespace or * the exports of a namespace are changed. * Allows TIP#112-driven command lists to be * validated efficiently. */ Tcl_Ensemble *ensembles; /* List of structures that contain the details * of the ensembles that are implemented on * top of this namespace. */ Tcl_Obj *unknownHandlerPtr; /* A script fragment to be used when command * resolution in this namespace fails. TIP * 181. */ int commandPathLength; /* The length of the explicit path. */ NamespacePathEntry *commandPathArray; /* The explicit path of the namespace as an * array. */ NamespacePathEntry *commandPathSourceList; /* Linked list of path entries that point to * this namespace. */ Tcl_NamespaceDeleteProc *earlyDeleteProc; /* Just like the deleteProc field (and called * with the same clientData) but called at the * start of the deletion process, so there is * a chance for code to do stuff inside the * namespace before deletion completes. */ } Namespace; /* * An entry on a namespace's command resolution path. */ struct NamespacePathEntry { Namespace *nsPtr; /* What does this path entry point to? If it * is NULL, this path entry points is * redundant and should be skipped. */ Namespace *creatorNsPtr; /* Where does this path entry point from? This * allows for efficient invalidation of * references when the path entry's target * updates its current list of defined * commands. */ NamespacePathEntry *prevPtr, *nextPtr; /* Linked list pointers or NULL at either end * of the list that hangs off Namespace's * commandPathSourceList field. */ }; /* * Flags used to represent the status of a namespace: * * NS_DYING - 1 means Tcl_DeleteNamespace has been called to delete the * namespace but there are still active call frames on the Tcl * stack that refer to the namespace. When the last call frame * referring to it has been popped, it's variables and command * will be destroyed and it will be marked "dead" (NS_DEAD). The * namespace can no longer be looked up by name. * NS_DEAD - 1 means Tcl_DeleteNamespace has been called to delete the * namespace and no call frames still refer to it. Its variables * and command have already been destroyed. This bit allows the * namespace resolution code to recognize that the namespace is * "deleted". When the last namespaceName object in any byte code * unit that refers to the namespace has been freed (i.e., when * the namespace's refCount is 0), the namespace's storage will * be freed. * NS_KILLED - 1 means that TclTeardownNamespace has already been called on * this namespace and it should not be called again [Bug 1355942] * NS_SUPPRESS_COMPILATION - * Marks the commands in this namespace for not being compiled, * forcing them to be looked up every time. */ #define NS_DYING 0x01 #define NS_DEAD 0x02 #define NS_KILLED 0x04 #define NS_SUPPRESS_COMPILATION 0x08 /* * Flags passed to TclGetNamespaceForQualName: * * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns. * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. */ #define TCL_CREATE_NS_IF_UNKNOWN 0x800 #define TCL_FIND_ONLY_NS 0x1000 /* * The client data for an ensemble command. This consists of the table of * commands that are actually exported by the namespace, and an epoch counter * that, combined with the exportLookupEpoch field of the namespace structure, * defines whether the table contains valid data or will need to be recomputed * next time the ensemble command is called. */ typedef struct EnsembleConfig { Namespace *nsPtr; /* The namespace backing this ensemble up. */ Tcl_Command token; /* The token for the command that provides * ensemble support for the namespace, or NULL * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ int epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same * number of entries as there are entries in * the subcommandTable hash. */ Tcl_HashTable subcommandTable; /* Hash table of ensemble subcommand names, * which are its keys so this also provides * the storage management for those subcommand * names. The contents of the entry values are * object version the prefix lists to use when * substituting for the command/subcommand to * build the ensemble implementation command. * Has to be stored here as well as in * subcommandDict because that field is NULL * when we are deriving the ensemble from the * namespace exports list. FUTURE WORK: use * object hash table here. */ struct EnsembleConfig *next;/* The next ensemble in the linked list of * ensembles associated with a namespace. If * this field points to this ensemble, the * structure has already been unlinked from * all lists, and cannot be found by scanning * the list from the namespace's ensemble * field. */ int flags; /* OR'ed combo of TCL_ENSEMBLE_PREFIX, * ENSEMBLE_DEAD and ENSEMBLE_COMPILE. */ /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */ Tcl_Obj *subcommandDict; /* Dictionary providing mapping from * subcommands to their implementing command * prefixes, or NULL if we are to build the * map automatically from the namespace * exports. */ Tcl_Obj *subcmdList; /* List of commands that this ensemble * actually provides, and whose implementation * will be built using the subcommandDict (if * present and defined) and by simple mapping * to the namespace otherwise. If NULL, * indicates that we are using the (dynamic) * list of currently exported commands. */ Tcl_Obj *unknownHandler; /* Script prefix used to handle the case when * no match is found (according to the rule * defined by flag bit TCL_ENSEMBLE_PREFIX) or * NULL to use the default error-generating * behaviour. The script execution gets all * the arguments to the ensemble command * (including objv[0]) and will have the * results passed directly back to the caller * (including the error code) unless the code * is TCL_CONTINUE in which case the * subcommand will be re-parsed by the ensemble * core, presumably because the ensemble * itself has been updated. */ Tcl_Obj *parameterList; /* List of ensemble parameter names. */ int numParameters; /* Cached number of parameters. This is either * 0 (if the parameterList field is NULL) or * the length of the list in the parameterList * field. */ } EnsembleConfig; /* * Various bits for the EnsembleConfig.flags field. */ #define ENSEMBLE_DEAD 0x1 /* Flag value to say that the ensemble is dead * and on its way out. */ #define ENSEMBLE_COMPILE 0x4 /* Flag to enable bytecode compilation of an * ensemble. */ /* *---------------------------------------------------------------- * Data structures related to variables. These are used primarily in tclVar.c *---------------------------------------------------------------- */ /* * The following structure defines a variable trace, which is used to invoke a * specific C procedure whenever certain operations are performed on a * variable. */ typedef struct VarTrace { Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by * flags are performed on variable. */ ClientData clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS and TCL_TRACE_ARRAY. */ struct VarTrace *nextPtr; /* Next in list of traces associated with a * particular variable. */ } VarTrace; /* * The following structure defines a command trace, which is used to invoke a * specific C procedure whenever certain operations are performed on a * command. */ typedef struct CommandTrace { Tcl_CommandTraceProc *traceProc; /* Procedure to call when operations given by * flags are performed on command. */ ClientData clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ int refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ } CommandTrace; /* * When a command trace is active (i.e. its associated procedure is executing) * one of the following structures is linked into a list associated with the * command's interpreter. The information in the structure is needed in order * for Tcl to behave reasonably if traces are deleted while traces are active. */ typedef struct ActiveCommandTrace { struct Command *cmdPtr; /* Command that's being traced. */ struct ActiveCommandTrace *nextPtr; /* Next in list of all active command traces * for the interpreter, or NULL if no more. */ CommandTrace *nextTracePtr; /* Next trace to check after current trace * procedure returns; if this trace gets * deleted, must update pointer to avoid using * free'd memory. */ int reverseScan; /* Boolean set true when traces are scanning * in reverse order. */ } ActiveCommandTrace; /* * When a variable trace is active (i.e. its associated procedure is * executing) one of the following structures is linked into a list associated * with the variable's interpreter. The information in the structure is needed * in order for Tcl to behave reasonably if traces are deleted while traces * are active. */ typedef struct ActiveVarTrace { struct Var *varPtr; /* Variable that's being traced. */ struct ActiveVarTrace *nextPtr; /* Next in list of all active variable traces * for the interpreter, or NULL if no more. */ VarTrace *nextTracePtr; /* Next trace to check after current trace * procedure returns; if this trace gets * deleted, must update pointer to avoid using * free'd memory. */ } ActiveVarTrace; /* * The structure below defines a variable, which associates a string name with * a Tcl_Obj value. These structures are kept in procedure call frames (for * local variables recognized by the compiler) or in the heap (for global * variables and any variable not known to the compiler). For each Var * structure in the heap, a hash table entry holds the variable name and a * pointer to the Var structure. */ typedef struct Var { int flags; /* Miscellaneous bits of information about * variable. See below for definitions. */ union { Tcl_Obj *objPtr; /* The variable's object value. Used for * scalar variables and array elements. */ TclVarHashTable *tablePtr;/* For array variables, this points to * information about the hash table used to * implement the associative array. Points to * ckalloc-ed data. */ struct Var *linkPtr; /* If this is a global variable being referred * to in a procedure, or a variable created by * "upvar", this field points to the * referenced variable's Var struct. */ } value; } Var; typedef struct VarInHash { Var var; int refCount; /* Counts number of active uses of this * variable: 1 for the entry in the hash * table, 1 for each additional variable whose * linkPtr points here, 1 for each nested * trace active on variable, and 1 if the * variable is a namespace variable. This * record can't be deleted until refCount * becomes 0. */ Tcl_HashEntry entry; /* The hash table entry that refers to this * variable. This is used to find the name of * the variable and to delete it from its * hash table if it is no longer needed. It * also holds the variable's name. */ } VarInHash; /* * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are * mutually exclusive and give the "type" of the variable. If none is set, * this is a scalar variable. * * VAR_ARRAY - 1 means this is an array variable rather than * a scalar variable or link. The "tablePtr" * field points to the array's hash table for its * elements. * VAR_LINK - 1 means this Var structure contains a pointer * to another Var structure that either has the * real value or is itself another VAR_LINK * pointer. Variables like this come about * through "upvar" and "global" commands, or * through references to variables in enclosing * namespaces. * * Flags that indicate the type and status of storage; none is set for * compiled local variables (Var structs). * * VAR_IN_HASHTABLE - 1 means this variable is in a hash table and * the Var structure is malloc'ed. 0 if it is a * local variable that was assigned a slot in a * procedure frame by the compiler so the Var * storage is part of the call frame. * VAR_DEAD_HASH 1 means that this var's entry in the hash table * has already been deleted. * VAR_ARRAY_ELEMENT - 1 means that this variable is an array * element, so it is not legal for it to be an * array itself (the VAR_ARRAY flag had better * not be set). * VAR_NAMESPACE_VAR - 1 means that this variable was declared as a * namespace variable. This flag ensures it * persists until its namespace is destroyed or * until the variable is unset; it will persist * even if it has not been initialized and is * marked undefined. The variable's refCount is * incremented to reflect the "reference" from * its namespace. * * Flag values relating to the variable's trace and search status. * * VAR_TRACED_READ * VAR_TRACED_WRITE * VAR_TRACED_UNSET * VAR_TRACED_ARRAY * VAR_TRACE_ACTIVE - 1 means that trace processing is currently * underway for a read or write access, so new * read or write accesses should not cause trace * procedures to be called and the variable can't * be deleted. * VAR_SEARCH_ACTIVE * * The following additional flags are used with the CompiledLocal type defined * below: * * VAR_ARGUMENT - 1 means that this variable holds a procedure * argument. * VAR_TEMPORARY - 1 if the local variable is an anonymous * temporary variable. Temporaries have a NULL * name. * VAR_RESOLVED - 1 if name resolution has been done for this * variable. * VAR_IS_ARGS 1 if this variable is the last argument and is * named "args". */ /* * FLAGS RENUMBERED: everything breaks already, make things simpler. * * IMPORTANT: skip the values 0x10, 0x20, 0x40, 0x800 corresponding to * TCL_TRACE_(READS/WRITES/UNSETS/ARRAY): makes code simpler in tclTrace.c * * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values * in precompiled scripts keep working. */ /* Type of value (0 is scalar) */ #define VAR_ARRAY 0x1 #define VAR_LINK 0x2 /* Type of storage (0 is compiled local) */ #define VAR_IN_HASHTABLE 0x4 #define VAR_DEAD_HASH 0x8 #define VAR_ARRAY_ELEMENT 0x1000 #define VAR_NAMESPACE_VAR 0x80 /* KEEP OLD VALUE for Itcl */ #define VAR_ALL_HASH \ (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT) /* Trace and search state. */ #define VAR_TRACED_READ 0x10 /* TCL_TRACE_READS */ #define VAR_TRACED_WRITE 0x20 /* TCL_TRACE_WRITES */ #define VAR_TRACED_UNSET 0x40 /* TCL_TRACE_UNSETS */ #define VAR_TRACED_ARRAY 0x800 /* TCL_TRACE_ARRAY */ #define VAR_TRACE_ACTIVE 0x2000 #define VAR_SEARCH_ACTIVE 0x4000 #define VAR_ALL_TRACES \ (VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET) /* Special handling on initialisation (only CompiledLocal). */ #define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */ #define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */ #define VAR_IS_ARGS 0x400 #define VAR_RESOLVED 0x8000 /* * Macros to ensure that various flag bits are set properly for variables. * The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE void TclSetVarScalar(Var *varPtr); * MODULE_SCOPE void TclSetVarArray(Var *varPtr); * MODULE_SCOPE void TclSetVarLink(Var *varPtr); * MODULE_SCOPE void TclSetVarArrayElement(Var *varPtr); * MODULE_SCOPE void TclSetVarUndefined(Var *varPtr); * MODULE_SCOPE void TclClearVarUndefined(Var *varPtr); */ #define TclSetVarScalar(varPtr) \ (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK) #define TclSetVarArray(varPtr) \ (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY #define TclSetVarLink(varPtr) \ (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK #define TclSetVarArrayElement(varPtr) \ (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT #define TclSetVarUndefined(varPtr) \ (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\ (varPtr)->value.objPtr = NULL #define TclClearVarUndefined(varPtr) #define TclSetVarTraceActive(varPtr) \ (varPtr)->flags |= VAR_TRACE_ACTIVE #define TclClearVarTraceActive(varPtr) \ (varPtr)->flags &= ~VAR_TRACE_ACTIVE #define TclSetVarNamespaceVar(varPtr) \ if (!TclIsVarNamespaceVar(varPtr)) {\ (varPtr)->flags |= VAR_NAMESPACE_VAR;\ if (TclIsVarInHash(varPtr)) {\ ((VarInHash *)(varPtr))->refCount++;\ }\ } #define TclClearVarNamespaceVar(varPtr) \ if (TclIsVarNamespaceVar(varPtr)) {\ (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\ if (TclIsVarInHash(varPtr)) {\ ((VarInHash *)(varPtr))->refCount--;\ }\ } /* * Macros to read various flag bits of variables. * The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE int TclIsVarScalar(Var *varPtr); * MODULE_SCOPE int TclIsVarLink(Var *varPtr); * MODULE_SCOPE int TclIsVarArray(Var *varPtr); * MODULE_SCOPE int TclIsVarUndefined(Var *varPtr); * MODULE_SCOPE int TclIsVarArrayElement(Var *varPtr); * MODULE_SCOPE int TclIsVarTemporary(Var *varPtr); * MODULE_SCOPE int TclIsVarArgument(Var *varPtr); * MODULE_SCOPE int TclIsVarResolved(Var *varPtr); */ #define TclIsVarScalar(varPtr) \ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK)) #define TclIsVarLink(varPtr) \ ((varPtr)->flags & VAR_LINK) #define TclIsVarArray(varPtr) \ ((varPtr)->flags & VAR_ARRAY) #define TclIsVarUndefined(varPtr) \ ((varPtr)->value.objPtr == NULL) #define TclIsVarArrayElement(varPtr) \ ((varPtr)->flags & VAR_ARRAY_ELEMENT) #define TclIsVarNamespaceVar(varPtr) \ ((varPtr)->flags & VAR_NAMESPACE_VAR) #define TclIsVarTemporary(varPtr) \ ((varPtr)->flags & VAR_TEMPORARY) #define TclIsVarArgument(varPtr) \ ((varPtr)->flags & VAR_ARGUMENT) #define TclIsVarResolved(varPtr) \ ((varPtr)->flags & VAR_RESOLVED) #define TclIsVarTraceActive(varPtr) \ ((varPtr)->flags & VAR_TRACE_ACTIVE) #define TclIsVarTraced(varPtr) \ ((varPtr)->flags & VAR_ALL_TRACES) #define TclIsVarInHash(varPtr) \ ((varPtr)->flags & VAR_IN_HASHTABLE) #define TclIsVarDeadHash(varPtr) \ ((varPtr)->flags & VAR_DEAD_HASH) #define TclGetVarNsPtr(varPtr) \ (TclIsVarInHash(varPtr) \ ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \ : NULL) #define VarHashRefCount(varPtr) \ ((VarInHash *) (varPtr))->refCount /* * Macros for direct variable access by TEBC. */ #define TclIsVarDirectReadable(varPtr) \ ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \ && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH)) #define TclIsVarDirectUnsettable(varPtr) \ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH)) #define TclIsVarDirectModifyable(varPtr) \ ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \ && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ (TclIsVarDirectReadable(varPtr) &&\ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ))) #define TclIsVarDirectWritable2(varPtr, arrayPtr) \ (TclIsVarDirectWritable(varPtr) &&\ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE))) #define TclIsVarDirectModifyable2(varPtr, arrayPtr) \ (TclIsVarDirectModifyable(varPtr) &&\ (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE)))) /* *---------------------------------------------------------------- * Data structures related to procedures. These are used primarily in * tclProc.c, tclCompile.c, and tclExecute.c. *---------------------------------------------------------------- */ #if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L) # define TCLFLEXARRAY #elif defined(__GNUC__) && (__GNUC__ > 2) # define TCLFLEXARRAY 0 #else # define TCLFLEXARRAY 1 #endif /* * Forward declaration to prevent an error when the forward reference to * Command is encountered in the Proc and ImportRef types declared below. */ struct Command; /* * The variable-length structure below describes a local variable of a * procedure that was recognized by the compiler. These variables have a name, * an element in the array of compiler-assigned local variables in the * procedure's call frame, and various other items of information. If the * local variable is a formal argument, it may also have a default value. The * compiler can't recognize local variables whose names are expressions (these * names are only known at runtime when the expressions are evaluated) or * local variables that are created as a result of an "upvar" or "uplevel" * command. These other local variables are kept separately in a hash table in * the call frame. */ typedef struct CompiledLocal { struct CompiledLocal *nextPtr; /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ int nameLength; /* The number of bytes in local variable's name. * Among others used to speed up var lookups. */ int frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ int flags; /* Flag bits for the local variable. Same as * the flags for the Var structure above, * although only VAR_ARGUMENT, VAR_TEMPORARY, * and VAR_RESOLVED make sense. */ Tcl_Obj *defValuePtr; /* Pointer to the default value of an * argument, if any. NULL if not an argument * or, if an argument, no default value. */ Tcl_ResolvedVarInfo *resolveInfo; /* Customized variable resolution info * supplied by the Tcl_ResolveCompiledVarProc * associated with a namespace. Each variable * is marked by a unique tag during * compilation, and that same tag is used to * find the variable at runtime. */ char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If * the name is NULL, this will just be '\0'. * The actual size of this field will be large * enough to hold the name. MUST BE THE LAST * FIELD IN THE STRUCTURE! */ } CompiledLocal; /* * The structure below defines a command procedure, which consists of a * collection of Tcl commands plus information about arguments and other local * variables recognized at compile time. */ typedef struct Proc { struct Interp *iPtr; /* Interpreter for which this command is * defined. */ int refCount; /* Reference count: 1 if still present in * command table plus 1 for each call to the * procedure that is currently active. This * structure can be freed when refCount * becomes zero. */ struct Command *cmdPtr; /* Points to the Command structure for this * procedure. This is used to get the * namespace in which to execute the * procedure. */ Tcl_Obj *bodyPtr; /* Points to the ByteCode object for * procedure's body command. */ int numArgs; /* Number of formal parameters. */ int numCompiledLocals; /* Count of local variables recognized by the * compiler including arguments and * temporaries. */ CompiledLocal *firstLocalPtr; /* Pointer to first of the procedure's * compiler-allocated local variables, or NULL * if none. The first numArgs entries in this * list describe the procedure's formal * arguments. */ CompiledLocal *lastLocalPtr;/* Pointer to the last allocated local * variable or NULL if none. This has frame * index (numCompiledLocals-1). */ } Proc; /* * The type of functions called to process errors found during the execution * of a procedure (or lambda term or ...). */ typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj); /* * The structure below defines a command trace. This is used to allow Tcl * clients to find out whenever a command is about to be executed. */ typedef struct Trace { int level; /* Only trace commands at nesting level less * than or equal to this. */ Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */ ClientData clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see * Tcl_CreateObjTrace for details. */ Tcl_CmdObjTraceDeleteProc *delProc; /* Procedure to call when trace is deleted. */ } Trace; /* * When an interpreter trace is active (i.e. its associated procedure is * executing), one of the following structures is linked into a list * associated with the interpreter. The information in the structure is needed * in order for Tcl to behave reasonably if traces are deleted while traces * are active. */ typedef struct ActiveInterpTrace { struct ActiveInterpTrace *nextPtr; /* Next in list of all active command traces * for the interpreter, or NULL if no more. */ Trace *nextTracePtr; /* Next trace to check after current trace * procedure returns; if this trace gets * deleted, must update pointer to avoid using * free'd memory. */ int reverseScan; /* Boolean set true when traces are scanning * in reverse order. */ } ActiveInterpTrace; /* * Flag values designating types of execution traces. See tclTrace.c for * related flag values. * * TCL_TRACE_ENTER_EXEC - triggers enter/enterstep traces. * - passed to Tcl_CreateObjTrace to set up * "enterstep" traces. * TCL_TRACE_LEAVE_EXEC - triggers leave/leavestep traces. * - passed to Tcl_CreateObjTrace to set up * "leavestep" traces. */ #define TCL_TRACE_ENTER_EXEC 1 #define TCL_TRACE_LEAVE_EXEC 2 /* * The structure below defines an entry in the assocData hash table which is * associated with an interpreter. The entry contains a pointer to a function * to call when the interpreter is deleted, and a pointer to a user-defined * piece of data. */ typedef struct AssocData { Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */ ClientData clientData; /* Value to pass to proc. */ } AssocData; /* * The structure below defines a call frame. A call frame defines a naming * context for a procedure call: its local naming scope (for local variables) * and its global naming scope (a namespace, perhaps the global :: namespace). * A call frame can also define the naming context for a namespace eval or * namespace inscope command: the namespace in which the command's code should * execute. The Tcl_CallFrame structures exist only while procedures or * namespace eval/inscope's are being executed, and provide a kind of Tcl call * stack. * * WARNING!! The structure definition must be kept consistent with the * Tcl_CallFrame structure in tcl.h. If you change one, change the other. */ /* * Will be grown to contain: pointers to the varnames (allocated at the end), * plus the init values for each variable (suitable to be memcopied on init) */ typedef struct LocalCache { int refCount; int numVars; Tcl_Obj *varName0; } LocalCache; #define localName(framePtr, i) \ ((&((framePtr)->localCachePtr->varName0))[(i)]) MODULE_SCOPE void TclFreeLocalCache(Tcl_Interp *interp, LocalCache *localCachePtr); typedef struct CallFrame { Namespace *nsPtr; /* Points to the namespace used to resolve * commands and global variables. */ int isProcCallFrame; /* If 0, the frame was pushed to execute a * namespace command and var references are * treated as references to namespace vars; * varTablePtr and compiledLocals are ignored. * If FRAME_IS_PROC is set, the frame was * pushed to execute a Tcl procedure and may * have local vars. */ int objc; /* This and objv below describe the arguments * for this procedure call. */ Tcl_Obj *const *objv; /* Array of argument objects. */ struct CallFrame *callerPtr; /* Value of interp->framePtr when this * procedure was invoked (i.e. next higher in * stack of all active procedures). */ struct CallFrame *callerVarPtr; /* Value of interp->varFramePtr when this * procedure was invoked (i.e. determines * variable scoping within caller). Same as * callerPtr unless an "uplevel" command or * something equivalent was active in the * caller). */ int level; /* Level of this procedure, for "uplevel" * purposes (i.e. corresponds to nesting of * callerVarPtr's, not callerPtr's). 1 for * outermost procedure, 0 for top-level. */ Proc *procPtr; /* Points to the structure defining the called * procedure. Used to get information such as * the number of compiled local variables * (local variables assigned entries ["slots"] * in the compiledLocals array below). */ TclVarHashTable *varTablePtr; /* Hash table containing local variables not * recognized by the compiler, or created at * execution time through, e.g., upvar. * Initially NULL and created if needed. */ int numCompiledLocals; /* Count of local variables recognized * by the compiler including arguments. */ Var *compiledLocals; /* Points to the array of local variables * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ ClientData clientData; /* Pointer to some context that is used by * object systems. The meaning of the contents * of this field is defined by the code that * sets it, and it should only ever be set by * the code that is pushing the frame. In that * case, the code that sets it should also * have some means of discovering what the * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled */ } CallFrame; #define FRAME_IS_PROC 0x1 #define FRAME_IS_LAMBDA 0x2 #define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's * clientData field contains a CallContext * reference. Part of TIP#257. */ #define FRAME_IS_OO_DEFINE 0x8 /* The frame is part of the inside workings of * the [oo::define] command; the clientData * field contains an Object reference that has * been confirmed to refer to a class. Part of * TIP#257. */ /* * TIP #280 * The structure below defines a command frame. A command frame provides * location information for all commands executing a tcl script (source, eval, * uplevel, procedure bodies, ...). The runtime structure essentially contains * the stack trace as it would be if the currently executing command were to * throw an error. * * For commands where it makes sense it refers to the associated CallFrame as * well. * * The structures are chained in a single list, with the top of the stack * anchored in the Interp structure. * * Instances can be allocated on the C stack, or the heap, the former making * cleanup a bit simpler. */ typedef struct CmdFrame { /* * General data. Always available. */ int type; /* Values see below. */ int level; /* Number of frames in stack, prevent O(n) * scan of list. */ int *line; /* Lines the words of the command start on. */ int nline; CallFrame *framePtr; /* Procedure activation record, may be * NULL. */ struct CmdFrame *nextPtr; /* Link to calling frame. */ /* * Data needed for Eval vs TEBC * * EXECUTION CONTEXTS and usage of CmdFrame * * Field TEBC EvalEx * ======= ==== ====== * level yes yes * type BC/PREBC SRC/EVAL * line0 yes yes * framePtr yes yes * ======= ==== ====== * * ======= ==== ========= union data * line1 - yes * line3 - yes * path - yes * ------- ---- ------ * codePtr yes - * pc yes - * ======= ==== ====== * * ======= ==== ========= union cmd * str.cmd yes yes * str.len yes yes * ------- ---- ------ */ union { struct { Tcl_Obj *path; /* Path of the sourced file the command is * in. */ } eval; struct { const void *codePtr;/* Byte code currently executed... */ const char *pc; /* ... and instruction pointer. */ } tebc; } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ int len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by * TclArgumentBCEnter(). These will be removed * by TclArgumentBCRelease. */ } CmdFrame; typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ int word; /* Index of the word in the command. */ int refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ int pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ int word; /* Index of word in * ExtCmdLoc.loc[cmd]->line[.] */ struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ struct CFWordBC *nextPtr; /* Next entry for same command call. See * CmdFrame litarg field for the list start. */ Tcl_Obj *obj; /* Back reference to hash table key */ } CFWordBC; /* * Structure to record the locations of invisible continuation lines in * literal scripts, as character offset from the beginning of the script. Both * compiler and direct evaluator use this information to adjust their line * counters when tracking through the script, because when it is invoked the * continuation line marker as a whole has been removed already, meaning that * the \n which was part of it is gone as well, breaking regular line * tracking. * * These structures are allocated and filled by both the function * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the * file "tclBasic.c", and stored in the thread-global hash table "lineCLPtr" in * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and * TclCompileScript(), both found in the file "tclCompile.c". Their memory is * released by the function TclFreeObj(), in the file "tclObj.c", and also by * the function TclThreadFinalizeObjects(), in the same file. */ #define CLL_END (-1) typedef struct ContLineLoc { int num; /* Number of entries in loc, not counting the * final -1 marker entry. */ int loc[TCLFLEXARRAY];/* Table of locations, as character offsets. * The table is allocated as part of the * structure, extending behind the nominal end * of the structure. An entry containing the * value -1 is put after the last location, as * end-marker/sentinel. */ } ContLineLoc; /* * The following macros define the allowed values for the type field of the * CmdFrame structure above. Some of the values occur only in the extended * location data referenced via the 'baseLocPtr'. * * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. * TCL_LOCATION_BC : Frame is for bytecode. * TCL_LOCATION_PREBC : Frame is for precompiled bytecode. * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a * sourced file. * TCL_LOCATION_PROC : Frame is for bytecode of a procedure. * * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC * types, per the context of the byte code in execution. */ #define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */ #define TCL_LOCATION_BC (2) /* Location in byte code. */ #define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no * location. */ #define TCL_LOCATION_SOURCE (4) /* Location in a file. */ #define TCL_LOCATION_PROC (5) /* Location in a dynamic proc. */ #define TCL_LOCATION_LAST (6) /* Number of values in the enum. */ /* * Structure passed to describe procedure-like "procedures" that are not * procedures (e.g. a lambda) so that their details can be reported correctly * by [info frame]. Contains a sub-structure for each extra field. */ typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData); typedef struct { const char *name; /* Name of this field. */ GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the * clientData, or just use the clientData * directly (after casting) if NULL. */ ClientData clientData; /* Context for above function, or Tcl_Obj* if * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { int length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ } ExtraFrameInfo; /* *---------------------------------------------------------------- * Data structures and procedures related to TclHandles, which are a very * lightweight method of preserving enough information to determine if an * arbitrary malloc'd block has been deleted. *---------------------------------------------------------------- */ typedef void **TclHandle; /* *---------------------------------------------------------------- * Experimental flag value passed to Tcl_GetRegExpFromObj. Intended for use * only by Expect. It will probably go away in a later release. *---------------------------------------------------------------- */ #define TCL_REG_BOSONLY 002000 /* Prepend \A to pattern so it only matches at * the beginning of the string. */ /* * These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet * when threads are used, or an emulation if there are no threads. These are * really internal and Tcl clients should use Tcl_GetThreadData. */ MODULE_SCOPE void * TclThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr); MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr, void *data); /* * This is a convenience macro used to initialize a thread local storage ptr. */ #define TCL_TSD_INIT(keyPtr) \ (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) /* *---------------------------------------------------------------- * Data structures related to bytecode compilation and execution. These are * used primarily in tclCompile.c, tclExecute.c, and tclBasic.c. *---------------------------------------------------------------- */ /* * Forward declaration to prevent errors when the forward references to * Tcl_Parse and CompileEnv are encountered in the procedure type CompileProc * declared below. */ struct CompileEnv; /* * The type of procedures called by the Tcl bytecode compiler to compile * commands. Pointers to these procedures are kept in the Command structure * describing each command. The integer value returned by a CompileProc must * be one of the following: * * TCL_OK Compilation completed normally. * TCL_ERROR Compilation could not be completed. This can be just a * judgment by the CompileProc that the command is too * complex to compile effectively, or it can indicate * that in the current state of the interp, the command * would raise an error. The bytecode compiler will not * do any error reporting at compiler time. Error * reporting is deferred until the actual runtime, * because by then changes in the interp state may allow * the command to be successfully evaluated. * TCL_OUT_LINE_COMPILE A source-compatible alias for TCL_ERROR, kept for the * sake of old code only. */ #define TCL_OUT_LINE_COMPILE TCL_ERROR typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr, struct Command *cmdPtr, struct CompileEnv *compEnvPtr); /* * The type of procedure called from the compilation hook point in * SetByteCodeFromAny. */ typedef int (CompileHookProc)(Tcl_Interp *interp, struct CompileEnv *compEnvPtr, ClientData clientData); /* * The data structure for a (linked list of) execution stacks. */ typedef struct ExecStack { struct ExecStack *prevPtr; struct ExecStack *nextPtr; Tcl_Obj **markerPtr; Tcl_Obj **endPtr; Tcl_Obj **tosPtr; Tcl_Obj *stackWords[TCLFLEXARRAY]; } ExecStack; /* * The data structure defining the execution environment for ByteCode's. * There is one ExecEnv structure per Tcl interpreter. It holds the evaluation * stack that holds command operands and results. The stack grows towards * increasing addresses. The member stackPtr points to the stackItems of the * currently active execution stack. */ typedef struct CorContext { struct CallFrame *framePtr; struct CallFrame *varFramePtr; struct CmdFrame *cmdFramePtr; /* See Interp.cmdFramePtr */ Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ } CorContext; typedef struct CoroutineData { struct Command *cmdPtr; /* The command handle for the coroutine. */ struct ExecEnv *eePtr; /* The special execution environment (stacks, * etc.) for the coroutine. */ struct ExecEnv *callerEEPtr;/* The execution environment for the caller of * the coroutine, which might be the * interpreter global environment or another * coroutine. */ CorContext caller; CorContext running; Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ void *stackLevel; int auxNumLevels; /* While the coroutine is running the * numLevels of the create/resume command is * stored here; for suspended coroutines it * holds the nesting numLevels at yield. */ int nargs; /* Number of args required for resuming this * coroutine; -2 means "0 or 1" (default), -1 * means "any" */ } CoroutineData; typedef struct ExecEnv { ExecStack *execStackPtr; /* Points to the first item in the evaluation * stack on the heap. */ Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */ struct Tcl_Interp *interp; struct NRE_callback *callbackPtr; /* Top callback in NRE's stack. */ struct CoroutineData *corPtr; int rewind; } ExecEnv; #define COR_IS_SUSPENDED(corPtr) \ ((corPtr)->stackLevel == NULL) /* * The definitions for the LiteralTable and LiteralEntry structures. Each * interpreter contains a LiteralTable. It is used to reduce the storage * needed for all the Tcl objects that hold the literals of scripts compiled * by the interpreter. A literal's object is shared by all the ByteCodes that * refer to the literal. Each distinct literal has one LiteralEntry entry in * the LiteralTable. A literal table is a specialized hash table that is * indexed by the literal's string representation, which may contain null * characters. * * Note that we reduce the space needed for literals by sharing literal * objects both within a ByteCode (each ByteCode contains a local * LiteralTable) and across all an interpreter's ByteCodes (with the * interpreter's global LiteralTable). */ typedef struct LiteralEntry { struct LiteralEntry *nextPtr; /* Points to next entry in this hash bucket or * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ int refCount; /* If in an interpreter's global literal * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to * 0. If in a local literal table, -1. */ Namespace *nsPtr; /* Namespace in which this literal is used. We * try to avoid sharing literal non-FQ command * names among different namespaces to reduce * shimmering. */ } LiteralEntry; typedef struct LiteralTable { LiteralEntry **buckets; /* Pointer to bucket array. Each element * points to first entry in bucket's hash * chain, or NULL. */ LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ int numBuckets; /* Total number of buckets allocated at * **buckets. */ int numEntries; /* Total number of entries present in * table. */ int rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ int mask; /* Mask value used in hashing function. */ } LiteralTable; /* * The following structure defines for each Tcl interpreter various * statistics-related information about the bytecode compiler and * interpreter's operation in that interpreter. */ #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { long numExecutions; /* Number of ByteCodes executed. */ long numCompilations; /* Number of ByteCodes created. */ long numByteCodesFreed; /* Number of ByteCodes destroyed. */ long instructionCount[256]; /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ double totalByteCodeBytes; /* Total bytes for all ByteCodes. */ double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ long srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ long byteCodeCount[32]; /* ByteCode size distribution. */ long lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ double currentInstBytes; /* Instruction bytes-current ByteCodes. */ double currentLitBytes; /* Current literal bytes. */ double currentExceptBytes; /* Current exception table bytes. */ double currentAuxBytes; /* Current auxiliary information bytes. */ double currentCmdMapBytes; /* Current src<->code map bytes. */ long numLiteralsCreated; /* Total literal objects ever compiled. */ double totalLitStringBytes; /* Total string bytes in all literals. */ double currentLitStringBytes; /* String bytes in current literals. */ long literalCount[32]; /* Distribution of literal string sizes. */ } ByteCodeStats; #endif /* TCL_COMPILE_STATS */ /* * Structure used in implementation of those core ensembles which are * partially compiled. Used as an array of these, with a terminating field * whose 'name' is NULL. */ typedef struct { const char *name; /* The name of the subcommand. */ Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ CompileProc *compileProc; /* The compiler for the subcommand. */ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ ClientData clientData; /* Any clientData to give the command. */ int unsafe; /* Whether this command is to be hidden by * default in a safe interpreter. */ } EnsembleImplMap; /* *---------------------------------------------------------------- * Data structures related to commands. *---------------------------------------------------------------- */ /* * An imported command is created in an namespace when it imports a "real" * command from another namespace. An imported command has a Command structure * that points (via its ClientData value) to the "real" Command structure in * the source namespace's command table. The real command records all the * imported commands that refer to it in a list of ImportRef structures so * that they can be deleted when the real command is deleted. */ typedef struct ImportRef { struct Command *importedCmdPtr; /* Points to the imported command created in * an importing namespace; this command * redirects its invocations to the "real" * command. */ struct ImportRef *nextPtr; /* Next element on the linked list of imported * commands that refer to the "real" command. * The real command deletes these imported * commands on this list when it is * deleted. */ } ImportRef; /* * Data structure used as the ClientData of imported commands: commands * created in an namespace when it imports a "real" command from another * namespace. */ typedef struct ImportedCmdData { struct Command *realCmdPtr; /* "Real" command that this imported command * refers to. */ struct Command *selfPtr; /* Pointer to this imported command. Needed * only when deleting it in order to remove it * from the real command's linked list of * imported commands that refer to it. */ } ImportedCmdData; /* * A Command structure exists for each command in a namespace. The Tcl_Command * opaque type actually refers to these structures. */ typedef struct Command { Tcl_HashEntry *hPtr; /* Pointer to the hash table entry that refers * to this command. The hash table is either a * namespace's command table or an * interpreter's hidden command table. This * pointer is used to get a command's name * from its Tcl_Command handle. NULL means * that the hash table entry has been removed * already (this can happen if deleteProc * causes the command to be deleted or * recreated). */ Namespace *nsPtr; /* Points to the namespace containing this * command. */ int refCount; /* 1 if in command hashtable plus 1 for each * reference from a CmdName Tcl object * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ int cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL * if no compile proc exists for command. */ Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ ClientData objClientData; /* Arbitrary value passed to object proc. */ Tcl_CmdProc *proc; /* String-based command procedure. */ ClientData clientData; /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Procedure invoked when deleting command to, * e.g., free all client data. */ ClientData deleteData; /* Arbitrary value passed to deleteProc. */ int flags; /* Miscellaneous bits of information about * command. See below for definitions. */ ImportRef *importRefPtr; /* List of each imported Command created in * another namespace when this command is * imported. These imported commands redirect * invocations back to this command. The list * is used to remove all those imported * commands when deleting this "real" * command. */ CommandTrace *tracePtr; /* First in list of all traces set for this * command. */ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ } Command; /* * Flag bits for commands. * * CMD_IS_DELETED - If 1 the command is in the process of * being deleted (its deleteProc is currently * executing). Other attempts to delete the * command should be ignored. * CMD_TRACE_ACTIVE - If 1 the trace processing is currently * underway for a rename/delete change. See the * two flags below for which is currently being * processed. * CMD_HAS_EXEC_TRACES - If 1 means that this command has at least one * execution trace (as opposed to simple * delete/rename traces) in its tracePtr list. * CMD_COMPILES_EXPANDED - If 1 this command has a compiler that * can handle expansion (provided it is not the * first word). * TCL_TRACE_RENAME - A rename trace is in progress. Further * recursive renames will not be traced. * TCL_TRACE_DELETE - A delete trace is in progress. Further * recursive deletes will not be traced. * (these last two flags are defined in tcl.h) */ #define CMD_IS_DELETED 0x01 #define CMD_TRACE_ACTIVE 0x02 #define CMD_HAS_EXEC_TRACES 0x04 #define CMD_COMPILES_EXPANDED 0x08 #define CMD_REDEF_IN_PROGRESS 0x10 #define CMD_VIA_RESOLVER 0x20 #define CMD_DEAD 0x40 /* *---------------------------------------------------------------- * Data structures related to name resolution procedures. *---------------------------------------------------------------- */ /* * The interpreter keeps a linked list of name resolution schemes. The scheme * for a namespace is consulted first, followed by the list of schemes in an * interpreter, followed by the default name resolution in Tcl. Schemes are * added/removed from the interpreter's list by calling Tcl_AddInterpResolver * and Tcl_RemoveInterpResolver. */ typedef struct ResolverScheme { char *name; /* Name identifying this scheme. */ Tcl_ResolveCmdProc *cmdResProc; /* Procedure handling command name * resolution. */ Tcl_ResolveVarProc *varResProc; /* Procedure handling variable name resolution * for variables that can only be handled at * runtime. */ Tcl_ResolveCompiledVarProc *compiledVarResProc; /* Procedure handling variable name resolution * at compile time. */ struct ResolverScheme *nextPtr; /* Pointer to next record in linked list. */ } ResolverScheme; /* * Forward declaration of the TIP#143 limit handler structure. */ typedef struct LimitHandler LimitHandler; /* * TIP #268. * Values for the selection mode, i.e the package require preferences. */ enum PkgPreferOptions { PKG_PREFER_LATEST, PKG_PREFER_STABLE }; /* *---------------------------------------------------------------- * This structure shadows the first few fields of the memory cache for the * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the * definition there. * Some macros require knowledge of some fields in the struct in order to * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer * to the relevant fields is kept in the allocCache field in struct Interp. *---------------------------------------------------------------- */ typedef struct AllocCache { struct Cache *nextPtr; /* Linked list of cache entries. */ Tcl_ThreadId owner; /* Which thread's cache is this? */ Tcl_Obj *firstObjPtr; /* List of free objects for thread. */ int numObjects; /* Number of objects for thread. */ } AllocCache; /* *---------------------------------------------------------------- * This structure defines an interpreter, which is a collection of commands * plus other state information related to interpreting commands, such as * variable storage. Primary responsibility for this data structure is in * tclBasic.c, but almost every Tcl source file uses something in here. *---------------------------------------------------------------- */ typedef struct Interp { /* * Note: the first three fields must match exactly the fields in a * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the * other. * * The interpreter's result is held in both the string and the * objResultPtr fields. These fields hold, respectively, the result's * string or object value. The interpreter's result is always in the * result field if that is non-empty, otherwise it is in objResultPtr. * The two fields are kept consistent unless some C code sets * interp->result directly. Programs should not access result and * objResultPtr directly; instead, they should always get and set the * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and * Tcl_GetStringResult. See the SetResult man page for details. */ char *result; /* If the last command returned a string * result, this points to it. Should not be * accessed directly; see comment above. */ Tcl_FreeProc *freeProc; /* Zero means a string result is statically * allocated. TCL_DYNAMIC means string result * was allocated with ckalloc and should be * freed with ckfree. Other values give * address of procedure to invoke to free the * string result. Tcl_Eval must free it before * executing next command. */ int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; /* Pointer to the exported Tcl stub table. On * previous versions of Tcl this is a pointer * to the objResultPtr or a pointer to a * buckets array in a hash table. We therefore * have to do some careful checking before we * can use this. */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ Namespace *globalNsPtr; /* The interpreter's global namespace. */ Tcl_HashTable *hiddenCmdTablePtr; /* Hash table used by tclBasic.c to keep track * of hidden commands on a per-interp * basis. */ ClientData interpInfo; /* Information used by tclInterp.c to keep * track of parent/child interps on a * per-interp basis. */ union { void (*optimizer)(void *envPtr); Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The * unused space in interp was repurposed for * pluggable bytecode optimizers. The core * contains one optimizer, which can be * selectively overridden by extensions. */ } extra; /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. */ int numLevels; /* Keeps track of how many nested calls to * Tcl_Eval are in progress for this * interpreter. It's used to delay deletion of * the table until all Tcl_Eval invocations * are completed. */ int maxNestingDepth; /* If numLevels exceeds this value then Tcl * assumes that infinite recursion has * occurred and it generates an error. */ CallFrame *framePtr; /* Points to top-most in stack of all nested * procedure invocations. */ CallFrame *varFramePtr; /* Points to the call frame whose variables * are currently in use (same as framePtr * unless an "uplevel" command is * executing). */ ActiveVarTrace *activeVarTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ int returnCode; /* [return -code] parameter. */ CallFrame *rootFramePtr; /* Global frame pointer for this * interpreter. */ Namespace *lookupNsPtr; /* Namespace to use ONLY on the next * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* * Information used by Tcl_AppendResult to keep track of partial results. * See Tcl_AppendResult code for details. */ char *appendResult; /* Storage space for results generated by * Tcl_AppendResult. Ckalloc-ed. NULL means * not yet allocated. */ int appendAvl; /* Total amount of space available at * partialResult. */ int appendUsed; /* Number of non-null bytes currently stored * at partialResult. */ /* * Information about packages. Used only in tclPkg.c. */ Tcl_HashTable packageTable; /* Describes all of the packages loaded in or * available to this interpreter. Keys are * package names, values are (Package *) * pointers. */ char *packageUnknown; /* Command to invoke during "package require" * commands for packages that aren't described * in packageTable. Ckalloc'ed, may be * NULL. */ /* * Miscellaneous information: */ int cmdCount; /* Total number of times a command procedure * has been called for this interpreter. */ int evalFlags; /* Flags to control next call to Tcl_Eval. * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ int unused1; /* No longer used (was termOffset) */ LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ int compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is * redefined. */ Proc *compiledProcPtr; /* If a procedure is being compiled, a pointer * to its Proc structure; otherwise, this is * NULL. Set by ObjInterpProc in tclProc.c and * used by tclCompile.c to process local * variables appropriately. */ ResolverScheme *resolverPtr; /* Linked list of name resolution schemes * added to this interpreter. Schemes are * added and removed by calling * Tcl_AddInterpResolvers and * Tcl_RemoveInterpResolver respectively. */ Tcl_Obj *scriptFile; /* NULL means there is no nested source * command active; otherwise this points to * pathPtr of the file being sourced. */ int flags; /* Various flag bits. See below. */ long randSeed; /* Seed used for rand() function. */ Trace *tracePtr; /* List of traces for this interpreter. */ Tcl_HashTable *assocData; /* Hash table for associating data with this * interpreter. Cleaned up when this * interpreter is deleted. */ struct ExecEnv *execEnvPtr; /* Execution environment for Tcl bytecode * execution. Contains a pointer to the Tcl * evaluation stack. */ Tcl_Obj *emptyObjPtr; /* Points to an object holding an empty * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ char resultSpace[TCL_RESULT_SIZE+1]; /* Static space holding small results. */ Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ Tcl_ThreadId threadId; /* ID of thread that owns the interpreter. */ ActiveCommandTrace *activeCmdTracePtr; /* First in list of active command traces for * interp, or NULL if no active traces. */ ActiveInterpTrace *activeInterpTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ int tracesForbiddingInline; /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation. */ /* * Fields used to manage extensible return options (TIP 90). */ Tcl_Obj *returnOpts; /* A dictionary holding the options to the * last [return] command. */ Tcl_Obj *errorInfo; /* errorInfo value (now as a Tcl_Obj). */ Tcl_Obj *eiVar; /* cached ref to ::errorInfo variable. */ Tcl_Obj *errorCode; /* errorCode value (now as a Tcl_Obj). */ Tcl_Obj *ecVar; /* cached ref to ::errorInfo variable. */ int returnLevel; /* [return -level] parameter. */ /* * Resource limiting framework support (TIP#143). */ struct { int active; /* Flag values defining which limits have been * set. */ int granularityTicker; /* Counter used to determine how often to * check the limits. */ int exceeded; /* Which limits have been exceeded, described * as flag values the same as the 'active' * field. */ int cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is * reached. */ int cmdGranularity; /* Mod factor used to determine how often to * evaluate the limit check. */ Tcl_Time time; /* Time limit for execution within the * interpreter. */ LimitHandler *timeHandlers; /* Handlers to execute when the limit is * reached. */ int timeGranularity; /* Mod factor used to determine how often to * evaluate the limit check. */ Tcl_TimerToken timeEvent; /* Handle for a timer callback that will occur * when the time-limit is exceeded. */ Tcl_HashTable callbacks;/* Mapping from (interp,type) pair to data * used to install a limit handler callback to * run in _this_ interp when the limit is * exceeded. */ } limit; /* * Information for improved default error generation from ensembles * (TIP#112). */ struct { Tcl_Obj *const *sourceObjs; /* What arguments were actually input into the * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ int numRemovedObjs; /* How many arguments have been stripped off * because of ensemble processing. */ int numInsertedObjs; /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; /* * TIP #219: Global info for the I/O system. */ Tcl_Obj *chanMsg; /* Error message set by channel drivers, for * the propagation of arbitrary Tcl errors. * This information, if present (chanMsg not * NULL), takes precedence over a POSIX error * code returned by a channel operation. */ /* * Source code origin information (TIP #280). */ CmdFrame *cmdFramePtr; /* Points to the command frame containing the * location information for the current * command. */ const CmdFrame *invokeCmdFramePtr; /* Points to the command frame which is the * invoking context of the bytecode compiler. * NULL when the byte code compiler is not * active. */ int invokeWord; /* Index of the word in the command which * is getting compiled. */ Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically * defined procedure the location information * for its body. It is keyed by the address of * the Proc structure for a procedure. The * values are "struct CmdFrame*". */ Tcl_HashTable *lineBCPtr; /* This table remembers for each ByteCode * object the location information for its * body. It is keyed by the address of the * Proc structure for a procedure. The values * are "struct ExtCmdLoc*". (See * tclCompile.h) */ Tcl_HashTable *lineLABCPtr; Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a * command on the execution stack the index of * the argument in the command, and the * location data of the command. It is keyed * by the address of the Tcl_Obj containing * the argument. The values are "struct * CFWord*" (See tclBasic.c). This allows * commands like uplevel, eval, etc. to find * location information for their arguments, * if they are a proper literal argument to an * invoking command. Alt view: An index to the * CmdFrame stack keyed by command argument * holders. */ ContLineLoc *scriptCLLocPtr;/* This table points to the location data for * invisible continuation lines in the script, * if any. This pointer is set by the function * TclEvalObjEx() in file "tclBasic.c", and * used by function ...() in the same file. * It does for the eval/direct path of script * execution what CompileEnv.clLoc does for * the bytecode compiler. */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. */ int packagePrefer; /* Current package selection mode. */ /* * Hashtables for variable traces and searches. */ Tcl_HashTable varTraces; /* Hashtable holding the start of a variable's * active trace list; varPtr is the key. */ Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's * active searches list; varPtr is the key. */ /* * The thread-specific data ekeko: cache pointers or values that * (a) do not change during the thread's lifetime * (b) require access to TSD to determine at runtime * (c) are accessed very often (e.g., at each command call) * * Note that these are the same for all interps in the same thread. They * just have to be initialised for the thread's parent interp, children * inherit the value. * * They are used by the macros defined below. */ AllocCache *allocCache; void *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData * structs for this interp's thread; see * tclObj.c and tclThreadAlloc.c */ int *asyncReadyPtr; /* Pointer to the asyncReady indicator for * this interp's thread; see tclAsync.c */ /* * The pointer to the object system root ekeko. c.f. TIP #257. */ void *objectFoundation; /* Pointer to the Foundation structure of the * object system, which contains things like * references to key namespaces. See * tclOOInt.h and tclOO.c for real definition * and setup. */ struct NRE_callback *deferredCallbacks; /* Callbacks that are set previous to a call * to some Eval function but that actually * belong to the command that is about to be * called - i.e., they should be run *before* * any tailcall is invoked. */ /* * TIP #285, Script cancellation support. */ Tcl_AsyncHandler asyncCancel; /* Async handler token for Tcl_CancelEval. */ Tcl_Obj *asyncCancelMsg; /* Error message set by async cancel handler * for the propagation of arbitrary Tcl * errors. This information, if present * (asyncCancelMsg not NULL), takes precedence * over the default error messages returned by * a script cancellation operation. */ /* * TIP #348 IMPLEMENTATION - Substituted error stack */ Tcl_Obj *errorStack; /* [info errorstack] value (as a Tcl_Obj). */ Tcl_Obj *upLiteral; /* "UP" literal for [info errorstack] */ Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */ Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */ Tcl_Obj *innerContext; /* cached list for fast reallocation */ int resetErrorStack; /* controls cleaning up of ::errorStack */ #ifdef TCL_COMPILE_STATS /* * Statistical information about the bytecode compiler and interpreter's * operation. This should be the last field of Interp. */ ByteCodeStats stats; /* Holds compilation and execution statistics * for this interpreter. */ #endif /* TCL_COMPILE_STATS */ } Interp; /* * Macros that use the TSD-ekeko. */ #define TclAsyncReady(iPtr) \ *((iPtr)->asyncReadyPtr) /* * Macros for script cancellation support (TIP #285). */ #define TclCanceled(iPtr) \ (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND)) #define TclSetCancelFlags(iPtr, cancelFlags) \ (iPtr)->flags |= CANCELED; \ if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ (iPtr)->flags |= TCL_CANCEL_UNWIND; \ } #define TclUnsetCancelFlags(iPtr) \ (iPtr)->flags &= (~(CANCELED | TCL_CANCEL_UNWIND)) /* * Macros for splicing into and out of doubly linked lists. They assume * existence of struct items 'prevPtr' and 'nextPtr'. * * a = element to add or remove. * b = list head. * * TclSpliceIn adds to the head of the list. */ #define TclSpliceIn(a,b) \ (a)->nextPtr = (b); \ if ((b) != NULL) { \ (b)->prevPtr = (a); \ } \ (a)->prevPtr = NULL, (b) = (a); #define TclSpliceOut(a,b) \ if ((a)->prevPtr != NULL) { \ (a)->prevPtr->nextPtr = (a)->nextPtr; \ } else { \ (b) = (a)->nextPtr; \ } \ if ((a)->nextPtr != NULL) { \ (a)->nextPtr->prevPtr = (a)->prevPtr; \ } /* * EvalFlag bits for Interp structures: * * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with a * code other than TCL_OK or TCL_ERROR; 0 means codes * other than these should be turned into errors. */ #define TCL_ALLOW_EXCEPTIONS 0x04 #define TCL_EVAL_FILE 0x02 #define TCL_EVAL_SOURCE_IN_FRAME 0x10 #define TCL_EVAL_NORESOLVE 0x20 #define TCL_EVAL_DISCARD_RESULT 0x40 /* * Flag bits for Interp structures: * * DELETED: Non-zero means the interpreter has been deleted: * don't process any more commands for it, and destroy * the structure as soon as all nested invocations of * Tcl_Eval are done. * ERR_ALREADY_LOGGED: Non-zero means information has already been logged in * iPtr->errorInfo for the current Tcl_Eval instance, so * Tcl_Eval needn't log it (used to implement the "error * message log" command). * DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler should * not compile any commands into an inline sequence of * instructions. This is set 1, for example, when command * traces are requested. * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the interp * has not be initialized. This is set 1 when we first * use the rand() or srand() functions. * SAFE_INTERP: Non zero means that the current interp is a safe * interp (i.e. it has only the safe commands installed, * less privilege than a regular interp). * INTERP_DEBUG_FRAME: Used for switching on various extra interpreter * debug/info mechanisms (e.g. info frame eval/uplevel * tracing) which are performance intensive. * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently * active; so no further trace callbacks should be * invoked. * INTERP_ALTERNATE_WRONG_ARGS: Used for listing second and subsequent forms * of the wrong-num-args string in Tcl_WrongNumArgs. * Makes it append instead of replacing and uses * different intermediate text. * CANCELED: Non-zero means that the script in progress should be * canceled as soon as possible. This can be checked by * extensions (and the core itself) by calling * Tcl_Canceled and checking if TCL_ERROR is returned. * This is a one-shot flag that is reset immediately upon * being detected; however, if the TCL_CANCEL_UNWIND flag * is set Tcl_Canceled will continue to report that the * script in progress has been canceled thereby allowing * the evaluation stack for the interp to be fully * unwound. * * WARNING: For the sake of some extensions that have made use of former * internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS) * or 8 (formerly ERROR_CODE_SET). */ #define DELETED 1 #define ERR_ALREADY_LOGGED 4 #define INTERP_DEBUG_FRAME 0x10 #define DONT_COMPILE_CMDS_INLINE 0x20 #define RAND_SEED_INITIALIZED 0x40 #define SAFE_INTERP 0x80 #define INTERP_TRACE_IN_PROGRESS 0x200 #define INTERP_ALTERNATE_WRONG_ARGS 0x400 #define ERR_LEGACY_COPY 0x800 #define CANCELED 0x1000 /* * Maximum number of levels of nesting permitted in Tcl commands (used to * catch infinite recursion). */ #define MAX_NESTING_DEPTH 1000 /* * The macro below is used to modify a "char" value (e.g. by casting it to an * unsigned character) so that it can be used safely with macros such as * isspace. */ #define UCHAR(c) ((unsigned char) (c)) /* * This macro is used to properly align the memory allocated by Tcl, giving * the same alignment as the native malloc. */ #if defined(__APPLE__) #define TCL_ALLOCALIGN 16 #else #define TCL_ALLOCALIGN (2*sizeof(void *)) #endif /* * This macro is used to determine the offset needed to safely allocate any * data structure in memory. Given a starting offset or size, it "rounds up" * or "aligns" the offset to the next 8-byte boundary so that any data * structure can be placed at the resulting offset without fear of an * alignment error. * * WARNING!! DO NOT USE THIS MACRO TO ALIGN POINTERS: it will produce the * wrong result on platforms that allocate addresses that are divisible by 4 * or 2. Only use it for offsets or sizes. * * This macro is only used by tclCompile.c in the core (Bug 926445). It * however not be made file static, as extensions that touch bytecodes * (notably tbcload) require it. */ #define TCL_ALIGN(x) (((int)(x) + 7) & ~7) /* * The following enum values are used to specify the runtime platform setting * of the tclPlatform variable. */ typedef enum { TCL_PLATFORM_UNIX = 0, /* Any Unix-like OS. */ TCL_PLATFORM_WINDOWS = 2 /* Any Microsoft Windows OS. */ } TclPlatformType; /* * The following enum values are used to indicate the translation of a Tcl * channel. Declared here so that each platform can define * TCL_PLATFORM_TRANSLATION to the native translation on that platform. */ typedef enum TclEolTranslation { TCL_TRANSLATE_AUTO, /* Eol == \r, \n and \r\n. */ TCL_TRANSLATE_CR, /* Eol == \r. */ TCL_TRANSLATE_LF, /* Eol == \n. */ TCL_TRANSLATE_CRLF /* Eol == \r\n. */ } TclEolTranslation; /* * Flags for TclInvoke: * * TCL_INVOKE_HIDDEN Invoke a hidden command; if not set, invokes * an exposed command. * TCL_INVOKE_NO_UNKNOWN If set, "unknown" is not invoked if the * command to be invoked is not found. Only has * an effect if invoking an exposed command, * i.e. if TCL_INVOKE_HIDDEN is not also set. * TCL_INVOKE_NO_TRACEBACK Does not record traceback information if the * invoked command returns an error. Used if the * caller plans on recording its own traceback * information. */ #define TCL_INVOKE_HIDDEN (1<<0) #define TCL_INVOKE_NO_UNKNOWN (1<<1) #define TCL_INVOKE_NO_TRACEBACK (1<<2) /* * The structure used as the internal representation of Tcl list objects. This * struct is grown (reallocated and copied) as necessary to hold all the * list's element pointers. The struct might contain more slots than currently * used to hold all element pointers. This is done to make append operations * faster. */ typedef struct List { int refCount; int maxElemCount; /* Total number of element array slots. */ int elemCount; /* Current number of list elements. */ int canonicalFlag; /* Set if the string representation was * derived from the list representation. May * be ignored if there is no string rep at * all.*/ Tcl_Obj *elements; /* First list element; the struct is grown to * accommodate all elements. */ } List; #define LIST_MAX \ (1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *))) #define LIST_SIZE(numElems) \ (unsigned)(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *))) /* * Macro used to get the elements of a list object. */ #define ListRepPtr(listPtr) \ ((List *) (listPtr)->internalRep.twoPtrValue.ptr1) /* Not used any more */ #define ListSetIntRep(objPtr, listRepPtr) \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \ (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \ (listRepPtr)->refCount++, \ (objPtr)->typePtr = &tclListType #define ListObjGetElements(listPtr, objc, objv) \ ((objv) = &(ListRepPtr(listPtr)->elements), \ (objc) = ListRepPtr(listPtr)->elemCount) #define ListObjLength(listPtr, len) \ ((len) = ListRepPtr(listPtr)->elemCount) #define ListObjIsCanonical(listPtr) \ (((listPtr)->bytes == NULL) || ListRepPtr(listPtr)->canonicalFlag) #define TclListObjGetElements(interp, listPtr, objcPtr, objvPtr) \ (((listPtr)->typePtr == &tclListType) \ ? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\ : Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr))) #define TclListObjLength(interp, listPtr, lenPtr) \ (((listPtr)->typePtr == &tclListType) \ ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\ : Tcl_ListObjLength((interp), (listPtr), (lenPtr))) #define TclListObjIsCanonical(listPtr) \ (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0) /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, * TclNRLmapCmd and their compilations. */ #define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ #define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ /* * Macros providing a faster path to integers: Tcl_GetLongFromObj, * Tcl_GetIntFromObj and TclGetIntForIndex. * * WARNING: these macros eval their args more than once. */ #define TclGetLongFromObj(interp, objPtr, longPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #if (LONG_MAX == INT_MAX) #define TclGetIntFromObj(interp, objPtr, intPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) #else #define TclGetIntFromObj(interp, objPtr, intPtr) \ (((objPtr)->typePtr == &tclIntType \ && (objPtr)->internalRep.longValue >= -(Tcl_WideInt)(UINT_MAX) \ && (objPtr)->internalRep.longValue <= (Tcl_WideInt)(UINT_MAX)) \ ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ (((objPtr)->typePtr == &tclIntType \ && (objPtr)->internalRep.longValue >= INT_MIN \ && (objPtr)->internalRep.longValue <= INT_MAX) \ ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) #endif /* * Macro used to save a function call for common uses of * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: * * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, * Tcl_WideInt *wideIntPtr); */ #ifdef TCL_WIDE_INT_IS_LONG #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(wideIntPtr) = (Tcl_WideInt) \ ((objPtr)->internalRep.longValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) #else /* !TCL_WIDE_INT_IS_LONG */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ (((objPtr)->typePtr == &tclWideIntType) \ ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ ((objPtr)->typePtr == &tclIntType) \ ? (*(wideIntPtr) = (Tcl_WideInt) \ ((objPtr)->internalRep.longValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) #endif /* TCL_WIDE_INT_IS_LONG */ /* * Flag values for TclTraceDictPath(). * * DICT_PATH_READ indicates that all entries on the path must exist but no * updates will be needed. * * DICT_PATH_UPDATE indicates that we are going to be doing an update at the * tip of the path, so duplication of shared objects should be done along the * way. * * DICT_PATH_EXISTS indicates that we are performing an existence test and a * lookup failure should therefore not be an error. If (and only if) this flag * is set, TclTraceDictPath() will return the special value * DICT_PATH_NON_EXISTENT if the path is not traceable. * * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to be set) * indicates that we are to create non-existent dictionaries on the path. */ #define DICT_PATH_READ 0 #define DICT_PATH_UPDATE 1 #define DICT_PATH_EXISTS 2 #define DICT_PATH_CREATE 5 #define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1) /* *---------------------------------------------------------------- * Data structures related to the filesystem internals *---------------------------------------------------------------- */ /* * The version_2 filesystem is private to Tcl. As and when these changes have * been thoroughly tested and investigated a new public filesystem interface * will be released. The aim is more versatile virtual filesystem interfaces, * more efficiency in 'path' manipulation and usage, and cleaner filesystem * code internally. */ #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) typedef ClientData (TclFSGetCwdProc2)(ClientData clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); /* * The following types are used for getting and storing platform-specific file * attributes in tclFCmd.c and the various platform-versions of that file. * This is done to have as much common code as possible in the file attributes * code. For more information about the callbacks, see TclFileAttrsCmd in * tclFCmd.c. */ typedef int (TclGetFileAttrProc)(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr); typedef int (TclSetFileAttrProc)(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attrObjPtr); typedef struct TclFileAttrProcs { TclGetFileAttrProc *getProc;/* The procedure for getting attrs. */ TclSetFileAttrProc *setProc;/* The procedure for setting attrs. */ } TclFileAttrProcs; /* * Opaque handle used in pipeline routines to encapsulate platform-dependent * state. */ typedef struct TclFile_ *TclFile; /* * The "globParameters" argument of the function TclGlob is an or'ed * combination of the following values: */ #define TCL_GLOBMODE_NO_COMPLAIN 1 #define TCL_GLOBMODE_JOIN 2 #define TCL_GLOBMODE_DIR 4 #define TCL_GLOBMODE_TAILS 8 typedef enum Tcl_PathPart { TCL_PATH_DIRNAME, TCL_PATH_TAIL, TCL_PATH_EXTENSION, TCL_PATH_ROOT } Tcl_PathPart; /* *---------------------------------------------------------------- * Data structures related to obsolete filesystem hooks *---------------------------------------------------------------- */ typedef int (TclStatProc_)(const char *path, struct stat *buf); typedef int (TclAccessProc_)(const char *path, int mode); typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* *---------------------------------------------------------------- * Data structures related to procedures *---------------------------------------------------------------- */ typedef Tcl_CmdProc *TclCmdProcType; typedef Tcl_ObjCmdProc *TclObjCmdProcType; /* *---------------------------------------------------------------- * Data structures for process-global values. *---------------------------------------------------------------- */ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr); /* * A ProcessGlobalValue struct exists for each internal value in Tcl that is * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of * the value, and the gobal value is kept as a counted string, with epoch and * mutex control. Each ProcessGlobalValue struct should be a static variable in * some file. */ typedef struct ProcessGlobalValue { int epoch; /* Epoch counter to detect changes in the * global value. */ int numBytes; /* Length of the global string. */ char *value; /* The global string value. */ Tcl_Encoding encoding; /* system encoding when global string was * initialized. */ TclInitProcessGlobalValueProc *proc; /* A procedure to initialize the global string * copy when a "get" request comes in before * any "set" request has been received. */ Tcl_Mutex mutex; /* Enforce orderly access from multiple * threads. */ Tcl_ThreadDataKey key; /* Key for per-thread data holding the * (Tcl_Obj) copy for each thread. */ } ProcessGlobalValue; /* *---------------------------------------------------------------------- * Flags for TclParseNumber *---------------------------------------------------------------------- */ #define TCL_PARSE_DECIMAL_ONLY 1 /* Leading zero doesn't denote octal or * hex. */ #define TCL_PARSE_OCTAL_ONLY 2 /* Parse octal even without prefix. */ #define TCL_PARSE_HEXADECIMAL_ONLY 4 /* Parse hexadecimal even without prefix. */ #define TCL_PARSE_INTEGER_ONLY 8 /* Disable floating point parsing. */ #define TCL_PARSE_SCAN_PREFIXES 16 /* Use [scan] rules dealing with 0? * prefixes. */ #define TCL_PARSE_NO_WHITESPACE 32 /* Reject leading/trailing whitespace. */ #define TCL_PARSE_BINARY_ONLY 64 /* Parse binary even without prefix. */ /* *---------------------------------------------------------------------- * Type values TclGetNumberFromObj *---------------------------------------------------------------------- */ #define TCL_NUMBER_LONG 1 #define TCL_NUMBER_WIDE 2 #define TCL_NUMBER_BIG 3 #define TCL_NUMBER_DOUBLE 4 #define TCL_NUMBER_NAN 5 /* *---------------------------------------------------------------- * Variables shared among Tcl modules but not used by the outside world. *---------------------------------------------------------------- */ MODULE_SCOPE char *tclNativeExecutableName; MODULE_SCOPE int tclFindExecutableSearchDone; MODULE_SCOPE char *tclMemDumpFileName; MODULE_SCOPE TclPlatformType tclPlatform; MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks; MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; /* * TIP #233 (Virtualized Time) * Data for the time hooks, if any. */ MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr; MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr; MODULE_SCOPE ClientData tclTimeClientData; /* * Variables denoting the Tcl object types defined in the core. */ MODULE_SCOPE const Tcl_ObjType tclBignumType; MODULE_SCOPE const Tcl_ObjType tclBooleanType; MODULE_SCOPE const Tcl_ObjType tclByteArrayType; MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclArraySearchType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; #ifndef TCL_WIDE_INT_IS_LONG MODULE_SCOPE const Tcl_ObjType tclWideIntType; #endif MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; /* * Variables denoting the hash key types defined in the core. */ MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType; MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType; MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType; MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType; /* * The head of the list of free Tcl objects, and the total number of Tcl * objects ever allocated and freed. */ MODULE_SCOPE Tcl_Obj * tclFreeObjList; #ifdef TCL_COMPILE_STATS MODULE_SCOPE long tclObjsAlloced; MODULE_SCOPE long tclObjsFreed; #define TCL_MAX_SHARED_OBJ_STATS 5 MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; #endif /* TCL_COMPILE_STATS */ /* * Pointer to a heap-allocated string of length zero that the Tcl core uses as * the value of an empty string representation for an object. This value is * shared by all new objects allocated by Tcl_NewObj. */ MODULE_SCOPE char * tclEmptyStringRep; MODULE_SCOPE char tclEmptyString; enum CheckEmptyStringResult { TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES }; /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world, * introduced by/for NRE. *---------------------------------------------------------------- */ MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback; MODULE_SCOPE Tcl_NRPostProc TclNRCoroutineActivateCallback; MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd; MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval; MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke; MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues; MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); /* These two can be considered for the public api */ MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); /* * This structure holds the data for the various iteration callbacks used to * NRE the 'for' and 'while' commands. We need a separate structure because we * have more than the 4 client data entries we can provide directly thorugh * the callback API. It is the 'word' information which puts us over the * limit. It is needed because the loop body is argument 4 of 'for' and * argument 2 of 'while'. Not providing the correct index confuses the #280 * code. We TclSmallAlloc/Free this. */ typedef struct ForIterData { Tcl_Obj *cond; /* Loop condition expression. */ Tcl_Obj *body; /* Loop body. */ Tcl_Obj *next; /* Loop step script, NULL for 'while'. */ const char *msg; /* Error message part. */ int word; /* Index of the body script in the command */ } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile * and Tcl_FindSymbol. This structure corresponds to an opaque * typedef in tcl.h */ typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, const char* symbol); struct Tcl_LoadHandle_ { ClientData clientData; /* Client data is the load handle in the * native filesystem if a module was loaded * there, or an opaque pointer to a structure * for further bookkeeping on load-from-VFS * and load-from-memory */ TclFindSymbolProc* findSymbolProcPtr; /* Procedure that resolves symbols in a * loaded module */ Tcl_FSUnloadFileProc* unloadFileProcPtr; /* Procedure that unloads a loaded module */ }; /* Flags for conversion of doubles to digit strings */ #define TCL_DD_SHORTEST 0x4 /* Use the shortest possible string */ #define TCL_DD_STEELE 0x5 /* Use the original Steele&White algorithm */ #define TCL_DD_E_FORMAT 0x2 /* Use a fixed-length string of digits, * suitable for E format*/ #define TCL_DD_F_FORMAT 0x3 /* Use a fixed number of digits after the * decimal point, suitable for F format */ #define TCL_DD_SHORTEN_FLAG 0x4 /* Allow return of a shorter digit string * if it converts losslessly */ #define TCL_DD_NO_QUICK 0x8 /* Debug flag: forbid quick FP conversion */ #define TCL_DD_CONVERSION_TYPE_MASK 0x3 /* Mask to isolate the conversion type */ #define TCL_DD_STEELE0 0x1 /* 'Steele&White' after masking */ #define TCL_DD_SHORTEST0 0x0 /* 'Shortest possible' after masking */ /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, int len); MODULE_SCOPE void TclAppendUtfToUtf(Tcl_Obj *objPtr, const char *bytes, int numBytes); MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next, int loc); MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, const char *end); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, CmdFrame *cf); MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, int pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr); MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index); MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, const char *value); MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num, int *loc); MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, int start, int *clNext); MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); MODULE_SCOPE int TclConvertElement(const char *src, int length, char *dst, int flags); MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, const char *name, Tcl_Namespace *nameNamespacePtr, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); MODULE_SCOPE void TclFinalizeEnvironment(void); MODULE_SCOPE void TclFinalizeEvaluation(void); MODULE_SCOPE void TclFinalizeExecution(void); MODULE_SCOPE void TclFinalizeIOSubsystem(void); MODULE_SCOPE void TclFinalizeFilesystem(void); MODULE_SCOPE void TclResetFilesystem(void); MODULE_SCOPE void TclFinalizeLoad(void); MODULE_SCOPE void TclFinalizeLock(void); MODULE_SCOPE void TclFinalizeMemorySubsystem(void); MODULE_SCOPE void TclFinalizeNotifier(void); MODULE_SCOPE void TclFinalizeObjects(void); MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const mp_int *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, const char *attributeName, int *indexPtr); MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *encodingName); MODULE_SCOPE int * TclGetAsyncReadyPtr(void); MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp); MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Channel *chanPtr, int *modePtr, int flags); MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr); MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, Tcl_Obj *value, int *code); MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, unsigned int *sizePtr); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); MODULE_SCOPE Tcl_ObjCmdProc TclInfoExistsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclInfoCoroutineCmd; MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); MODULE_SCOPE Tcl_ObjCmdProc TclInfoGlobalsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclInfoLocalsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclInfoVarsCmd; MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); MODULE_SCOPE void TclInitEmbeddedConfigurationInformation( Tcl_Interp *interp); MODULE_SCOPE void TclInitEncodingSubsystem(void); MODULE_SCOPE void TclInitIOSubsystem(void); MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE const char *TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *const indexArray[]); /* TIP #280 */ MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n, int *lines, Tcl_Obj *const *elems); MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name, const EnsembleImplMap map[]); MODULE_SCOPE int TclMaxListLength(const char *bytes, int numBytes, const char **endPtr); MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const char *operation, const char *reason, int index); MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Namespace *nsPtr, int flags); MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); MODULE_SCOPE int TclParseBackslash(const char *src, int numBytes, int *readPtr, char *dst); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *expected, const char *bytes, int numBytes, const char **endPtrPtr, int flags); MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, int numBytes, Tcl_Parse *parsePtr); MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, int len); MODULE_SCOPE int TclpDeleteFile(const void *path); MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); MODULE_SCOPE void TclpFinalizePipes(void); MODULE_SCOPE void TclpFinalizeSockets(void); MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, struct addrinfo **addrlist, const char *host, int port, int willBind, const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); MODULE_SCOPE void TclpGlobalLock(void); MODULE_SCOPE void TclpGlobalUnlock(void); MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); MODULE_SCOPE void TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining); MODULE_SCOPE Tcl_Obj * TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr); MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef); MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target); MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData clientData); MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep; MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr); MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_PathPart portion); MODULE_SCOPE char * TclpReadlink(const char *fileName, Tcl_DString *linkPtr); MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp); MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr); MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr, void *data); MODULE_SCOPE void TclpThreadExit(int status); MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex); MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, int reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); MODULE_SCOPE unsigned int TclScanElement(const char *string, int length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumInternalRep(Tcl_Obj *objPtr, mp_int *bignumValue); MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int subIdx, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); typedef int (*memCmpFn_t)(const void*, const void*, size_t); MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, int nocase, int reqlength); MODULE_SCOPE int TclUniCharNcasecmp(const void*, const void*, size_t); MODULE_SCOPE int TclUtfNcasecmp(const void*, const void*, size_t); MODULE_SCOPE int TclUtfNcmp(const void*, const void*, size_t); MODULE_SCOPE int TclUniCharNcmp(const void*, const void*, size_t); MODULE_SCOPE int TclUtfNcmp2(const void*, const void*, size_t); MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *nocase, int *reqlength); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr); MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes, int numBytes, int flags, int line, struct CompileEnv *envPtr); MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, int numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, int *tokensLeftPtr, int line, int *clNextOuter, const char *outerScript); MODULE_SCOPE int TclTrim(const char *bytes, int numBytes, const char *trim, int numTrim, int *trimRight); MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfToUCS4(const char *, int *); MODULE_SCOPE int TclUCS4ToUtf(int, char *); MODULE_SCOPE int TclUCS4ToLower(int ch); #if TCL_UTF_MAX == 4 MODULE_SCOPE int TclGetUCS4(Tcl_Obj *, int); MODULE_SCOPE int TclUniCharToUCS4(const Tcl_UniChar *, int *); #else # define TclGetUCS4 Tcl_GetUniChar # define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1) #endif /* * Bytes F0-F4 are start-bytes for 4-byte sequences. * Byte 0xED can be the start-byte of an upper surrogate. In that case, * TclUtfToUCS4() might read the lower surrogate following it too. */ # define TclUCS4Complete(src, length) (((unsigned)(UCHAR(*(src)) - 0xF0) < 5) \ ? ((length) >= 4) : (UCHAR(*(src)) == 0xED) ? ((length) >= 6) : Tcl_UtfCharComplete((src), (length))) MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE void * TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size); MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, int size, int codeSize, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); /* TclWideMUInt -- wide integer used for measurement calculations: */ #if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400)) # define TclWideMUInt Tcl_WideUInt #else /* older MSVS may not allow conversions between unsigned __int64 and double) */ # define TclWideMUInt Tcl_WideInt #endif #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); # define TclpWideClicksToNanoseconds(clicks) \ ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void); MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetGlobalTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length); /* * Many parsing tasks need a common definition of whitespace. * Use this routine and macro to achieve that and place * optimization (fragile on changes) in one place. */ MODULE_SCOPE int TclIsSpaceProc(int byte); # define TclIsSpaceProcM(byte) \ (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) /* *---------------------------------------------------------------- * Command procedures in the generic core: *---------------------------------------------------------------- */ MODULE_SCOPE Tcl_ObjCmdProc Tcl_AfterObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_AppendObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ApplyObjCmd; MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc Tcl_BreakObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_CaseObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_CatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_CdObjCmd; MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc TclChanCreateObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclChanPostEventObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclChanPopObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclChanPushObjCmd; MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd; MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData); MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd; MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int index, int pathc, Tcl_Obj *const pathv[], Tcl_Obj *keysPtr); MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, int pathc, Tcl_Obj *const pathv[]); MODULE_SCOPE Tcl_ObjCmdProc Tcl_DisassembleObjCmd; /* Assemble command function */ MODULE_SCOPE Tcl_ObjCmdProc Tcl_AssembleObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRAssembleObjCmd; MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp); MODULE_SCOPE int TclMakeEncodingCommandSafe(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc Tcl_EofObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ErrorObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_EvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExecObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExitObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_FblockedObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_FconfigureObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_FcopyObjCmd; MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp); MODULE_SCOPE int TclMakeFileCommandSafe(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc Tcl_FileEventObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_FlushObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ForeachObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_FormatObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_GetsObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_GlobalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_GlobObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_IfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_IncrObjCmd; MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc Tcl_InterpObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_JoinObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LappendObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LassignObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LindexObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LinsertObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LlengthObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ListObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LmapObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LoadObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LrangeObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LrepeatObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LreplaceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LreverseObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsearchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsetObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsortObjCmd; MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc TclNamespaceEnsembleCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_OpenObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_PackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_PidObjCmd; MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc Tcl_PutsObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_PwdObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ReadObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_RegexpObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_RegsubObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_RenameObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_RepresentationCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ReturnObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ScanObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_SeekObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_SetObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_SplitObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_SocketObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_SourceObjCmd; MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc Tcl_SubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_SwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_TellObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ThrowObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_TimeObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_TimeRateObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_TraceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_TryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_UnloadObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_UnsetObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_UpdateObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_UplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_UpvarObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_VariableObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_VwaitObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_WhileObjCmd; /* *---------------------------------------------------------------- * Compilation procedures for commands in the generic core: *---------------------------------------------------------------- */ MODULE_SCOPE CompileProc TclCompileAppendCmd; MODULE_SCOPE CompileProc TclCompileArrayExistsCmd; MODULE_SCOPE CompileProc TclCompileArraySetCmd; MODULE_SCOPE CompileProc TclCompileArrayUnsetCmd; MODULE_SCOPE CompileProc TclCompileBreakCmd; MODULE_SCOPE CompileProc TclCompileCatchCmd; MODULE_SCOPE CompileProc TclCompileClockClicksCmd; MODULE_SCOPE CompileProc TclCompileClockReadingCmd; MODULE_SCOPE CompileProc TclCompileConcatCmd; MODULE_SCOPE CompileProc TclCompileContinueCmd; MODULE_SCOPE CompileProc TclCompileDictAppendCmd; MODULE_SCOPE CompileProc TclCompileDictCreateCmd; MODULE_SCOPE CompileProc TclCompileDictExistsCmd; MODULE_SCOPE CompileProc TclCompileDictForCmd; MODULE_SCOPE CompileProc TclCompileDictGetCmd; MODULE_SCOPE CompileProc TclCompileDictIncrCmd; MODULE_SCOPE CompileProc TclCompileDictLappendCmd; MODULE_SCOPE CompileProc TclCompileDictMapCmd; MODULE_SCOPE CompileProc TclCompileDictMergeCmd; MODULE_SCOPE CompileProc TclCompileDictSetCmd; MODULE_SCOPE CompileProc TclCompileDictUnsetCmd; MODULE_SCOPE CompileProc TclCompileDictUpdateCmd; MODULE_SCOPE CompileProc TclCompileDictWithCmd; MODULE_SCOPE CompileProc TclCompileEnsemble; MODULE_SCOPE CompileProc TclCompileErrorCmd; MODULE_SCOPE CompileProc TclCompileExprCmd; MODULE_SCOPE CompileProc TclCompileForCmd; MODULE_SCOPE CompileProc TclCompileForeachCmd; MODULE_SCOPE CompileProc TclCompileFormatCmd; MODULE_SCOPE CompileProc TclCompileGlobalCmd; MODULE_SCOPE CompileProc TclCompileIfCmd; MODULE_SCOPE CompileProc TclCompileInfoCommandsCmd; MODULE_SCOPE CompileProc TclCompileInfoCoroutineCmd; MODULE_SCOPE CompileProc TclCompileInfoExistsCmd; MODULE_SCOPE CompileProc TclCompileInfoLevelCmd; MODULE_SCOPE CompileProc TclCompileInfoObjectClassCmd; MODULE_SCOPE CompileProc TclCompileInfoObjectIsACmd; MODULE_SCOPE CompileProc TclCompileInfoObjectNamespaceCmd; MODULE_SCOPE CompileProc TclCompileIncrCmd; MODULE_SCOPE CompileProc TclCompileLappendCmd; MODULE_SCOPE CompileProc TclCompileLassignCmd; MODULE_SCOPE CompileProc TclCompileLindexCmd; MODULE_SCOPE CompileProc TclCompileLinsertCmd; MODULE_SCOPE CompileProc TclCompileListCmd; MODULE_SCOPE CompileProc TclCompileLlengthCmd; MODULE_SCOPE CompileProc TclCompileLmapCmd; MODULE_SCOPE CompileProc TclCompileLrangeCmd; MODULE_SCOPE CompileProc TclCompileLreplaceCmd; MODULE_SCOPE CompileProc TclCompileLsetCmd; MODULE_SCOPE CompileProc TclCompileNamespaceCodeCmd; MODULE_SCOPE CompileProc TclCompileNamespaceCurrentCmd; MODULE_SCOPE CompileProc TclCompileNamespaceOriginCmd; MODULE_SCOPE CompileProc TclCompileNamespaceQualifiersCmd; MODULE_SCOPE CompileProc TclCompileNamespaceTailCmd; MODULE_SCOPE CompileProc TclCompileNamespaceUpvarCmd; MODULE_SCOPE CompileProc TclCompileNamespaceWhichCmd; MODULE_SCOPE CompileProc TclCompileNoOp; MODULE_SCOPE CompileProc TclCompileObjectNextCmd; MODULE_SCOPE CompileProc TclCompileObjectNextToCmd; MODULE_SCOPE CompileProc TclCompileObjectSelfCmd; MODULE_SCOPE CompileProc TclCompileRegexpCmd; MODULE_SCOPE CompileProc TclCompileRegsubCmd; MODULE_SCOPE CompileProc TclCompileReturnCmd; MODULE_SCOPE CompileProc TclCompileSetCmd; MODULE_SCOPE CompileProc TclCompileStringCatCmd; MODULE_SCOPE CompileProc TclCompileStringCmpCmd; MODULE_SCOPE CompileProc TclCompileStringEqualCmd; MODULE_SCOPE CompileProc TclCompileStringFirstCmd; MODULE_SCOPE CompileProc TclCompileStringIndexCmd; MODULE_SCOPE CompileProc TclCompileStringIsCmd; MODULE_SCOPE CompileProc TclCompileStringLastCmd; MODULE_SCOPE CompileProc TclCompileStringLenCmd; MODULE_SCOPE CompileProc TclCompileStringMapCmd; MODULE_SCOPE CompileProc TclCompileStringMatchCmd; MODULE_SCOPE CompileProc TclCompileStringRangeCmd; MODULE_SCOPE CompileProc TclCompileStringReplaceCmd; MODULE_SCOPE CompileProc TclCompileStringToLowerCmd; MODULE_SCOPE CompileProc TclCompileStringToTitleCmd; MODULE_SCOPE CompileProc TclCompileStringToUpperCmd; MODULE_SCOPE CompileProc TclCompileStringTrimCmd; MODULE_SCOPE CompileProc TclCompileStringTrimLCmd; MODULE_SCOPE CompileProc TclCompileStringTrimRCmd; MODULE_SCOPE CompileProc TclCompileSubstCmd; MODULE_SCOPE CompileProc TclCompileSwitchCmd; MODULE_SCOPE CompileProc TclCompileTailcallCmd; MODULE_SCOPE CompileProc TclCompileThrowCmd; MODULE_SCOPE CompileProc TclCompileTryCmd; MODULE_SCOPE CompileProc TclCompileUnsetCmd; MODULE_SCOPE CompileProc TclCompileUpvarCmd; MODULE_SCOPE CompileProc TclCompileVariableCmd; MODULE_SCOPE CompileProc TclCompileWhileCmd; MODULE_SCOPE CompileProc TclCompileYieldCmd; MODULE_SCOPE CompileProc TclCompileYieldToCmd; MODULE_SCOPE CompileProc TclCompileBasic0ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic1ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic2ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic3ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic0Or1ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic1Or2ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic2Or3ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic0To2ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic1To3ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin0ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin1ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin2ArgCmd; MODULE_SCOPE Tcl_ObjCmdProc TclInvertOpCmd; MODULE_SCOPE CompileProc TclCompileInvertOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNotOpCmd; MODULE_SCOPE CompileProc TclCompileNotOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclAddOpCmd; MODULE_SCOPE CompileProc TclCompileAddOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclMulOpCmd; MODULE_SCOPE CompileProc TclCompileMulOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclAndOpCmd; MODULE_SCOPE CompileProc TclCompileAndOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclOrOpCmd; MODULE_SCOPE CompileProc TclCompileOrOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclXorOpCmd; MODULE_SCOPE CompileProc TclCompileXorOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclPowOpCmd; MODULE_SCOPE CompileProc TclCompilePowOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclLshiftOpCmd; MODULE_SCOPE CompileProc TclCompileLshiftOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclRshiftOpCmd; MODULE_SCOPE CompileProc TclCompileRshiftOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclModOpCmd; MODULE_SCOPE CompileProc TclCompileModOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNeqOpCmd; MODULE_SCOPE CompileProc TclCompileNeqOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclStrneqOpCmd; MODULE_SCOPE CompileProc TclCompileStrneqOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclInOpCmd; MODULE_SCOPE CompileProc TclCompileInOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNiOpCmd; MODULE_SCOPE CompileProc TclCompileNiOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclMinusOpCmd; MODULE_SCOPE CompileProc TclCompileMinusOpCmd; MODULE_SCOPE Tcl_ObjCmdProc TclDivOpCmd; MODULE_SCOPE CompileProc TclCompileDivOpCmd; MODULE_SCOPE CompileProc TclCompileLessOpCmd; MODULE_SCOPE CompileProc TclCompileLeqOpCmd; MODULE_SCOPE CompileProc TclCompileGreaterOpCmd; MODULE_SCOPE CompileProc TclCompileGeqOpCmd; MODULE_SCOPE CompileProc TclCompileEqOpCmd; MODULE_SCOPE CompileProc TclCompileStreqOpCmd; MODULE_SCOPE CompileProc TclCompileAssembleCmd; /* * Functions defined in generic/tclVar.c and currently exported only for use * by the bytecode compiler and engine. Some of these could later be placed in * the public interface. */ MODULE_SCOPE Var * TclObjLookupVarEx(Tcl_Interp * interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp, Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr, int flags, const char *msg, int createPart1, int createPart2, Var *arrayPtr, int index); MODULE_SCOPE Tcl_Obj * TclPtrGetVarIdx(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, int index); MODULE_SCOPE Tcl_Obj * TclPtrSetVarIdx(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags, int index); MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVarIdx(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags, int index); MODULE_SCOPE int TclPtrObjMakeUpvarIdx(Tcl_Interp *interp, Var *otherPtr, Tcl_Obj *myNamePtr, int myFlags, int index); MODULE_SCOPE int TclPtrUnsetVarIdx(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, int index); MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr, Tcl_HashTable *tablePtr); /* * The new extended interface to the variable traces. */ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, int leaveErrMsg, int index); /* * So tclObj.c and tclDictObj.c can share these implementations. */ MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); /* * Utility routines for encoding index values as integers. Used by both * some of the command compilers and by [lsort] and [lsearch]. */ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, int before, int after, int *indexPtr); MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); MODULE_SCOPE void TclBN_s_mp_reverse(unsigned char *s, size_t len); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END (-2) #define TCL_INDEX_BEFORE (-1) #define TCL_INDEX_START (0) #define TCL_INDEX_AFTER (INT_MAX) /* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. * TclNewObj(objPtr) creates a new object denoting an empty string. * TclDecrRefCount(objPtr) decrements the object's reference count, and frees * the object if its reference count is zero. These macros are inline versions * of Tcl_NewObj() and Tcl_DecrRefCount(). Notice that the names differ in not * having a "_" after the "Tcl". Notice also that these macros reference their * argument more than once, so you should avoid calling them with an * expression that is expensive to compute or has side effects. The ANSI C * "prototypes" for these macros are: * * MODULE_SCOPE void TclNewObj(Tcl_Obj *objPtr); * MODULE_SCOPE void TclDecrRefCount(Tcl_Obj *objPtr); * * These macros are defined in terms of two macros that depend on memory * allocator in use: TclAllocObjStorage, TclFreeObjStorage. They are defined * below. *---------------------------------------------------------------- */ /* * DTrace object allocation probe macros. */ #ifdef USE_DTRACE #ifndef _TCLDTRACE_H #include "tclDTrace.h" #endif #define TCL_DTRACE_OBJ_CREATE(objPtr) TCL_OBJ_CREATE(objPtr) #define TCL_DTRACE_OBJ_FREE(objPtr) TCL_OBJ_FREE(objPtr) #else /* USE_DTRACE */ #define TCL_DTRACE_OBJ_CREATE(objPtr) {} #define TCL_DTRACE_OBJ_FREE(objPtr) {} #endif /* USE_DTRACE */ #ifdef TCL_COMPILE_STATS # define TclIncrObjsAllocated() \ tclObjsAlloced++ # define TclIncrObjsFreed() \ tclObjsFreed++ #else # define TclIncrObjsAllocated() # define TclIncrObjsFreed() #endif /* TCL_COMPILE_STATS */ # define TclAllocObjStorage(objPtr) \ TclAllocObjStorageEx(NULL, (objPtr)) # define TclFreeObjStorage(objPtr) \ TclFreeObjStorageEx(NULL, (objPtr)) #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr) /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) with * 'length == -1'. * Use empty 'if ; else' to handle use in unbraced outer if/else conditions. */ # define TclDecrRefCount(objPtr) \ if ((objPtr)->refCount-- > 1) ; else { \ if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ TCL_DTRACE_OBJ_FREE(objPtr); \ if ((objPtr)->bytes \ && ((objPtr)->bytes != tclEmptyStringRep)) { \ ckfree((char *)(objPtr)->bytes); \ } \ (objPtr)->length = -1; \ TclFreeObjStorage(objPtr); \ TclIncrObjsFreed(); \ } else { \ TclFreeObj(objPtr); \ } \ } #if defined(PURIFY) /* * The PURIFY mode is like the regular mode, but instead of doing block * Tcl_Obj allocation and keeping a freed list for efficiency, it always * allocates and frees a single Tcl_Obj so that tools like Purify can better * track memory leaks. */ # define TclAllocObjStorageEx(interp, objPtr) \ (objPtr) = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)) # define TclFreeObjStorageEx(interp, objPtr) \ ckfree((char *)(objPtr)) #undef USE_THREAD_ALLOC #undef USE_TCLALLOC #elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) /* * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from * per-thread caches. */ MODULE_SCOPE Tcl_Obj * TclThreadAllocObj(void); MODULE_SCOPE void TclThreadFreeObj(Tcl_Obj *); MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void); MODULE_SCOPE void TclFreeAllocCache(void *); MODULE_SCOPE void * TclpGetAllocCache(void); MODULE_SCOPE void TclpSetAllocCache(void *); MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclpFreeAllocCache(void *); /* * These macros need to be kept in sync with the code of TclThreadAllocObj() * and TclThreadFreeObj(). * * Note that the optimiser should resolve the case (interp==NULL) at compile * time. */ # define ALLOC_NOBJHIGH 1200 # define TclAllocObjStorageEx(interp, objPtr) \ do { \ AllocCache *cachePtr; \ if (((interp) == NULL) || \ ((cachePtr = ((Interp *)(interp))->allocCache), \ (cachePtr->numObjects == 0))) { \ (objPtr) = TclThreadAllocObj(); \ } else { \ (objPtr) = cachePtr->firstObjPtr; \ cachePtr->firstObjPtr = (Tcl_Obj *)(objPtr)->internalRep.twoPtrValue.ptr1; \ --cachePtr->numObjects; \ } \ } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ do { \ AllocCache *cachePtr; \ if (((interp) == NULL) || \ ((cachePtr = ((Interp *)(interp))->allocCache), \ ((cachePtr->numObjects == 0) || \ (cachePtr->numObjects >= ALLOC_NOBJHIGH)))) { \ TclThreadFreeObj(objPtr); \ } else { \ (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \ cachePtr->firstObjPtr = objPtr; \ ++cachePtr->numObjects; \ } \ } while (0) #else /* not PURIFY or USE_THREAD_ALLOC */ #if defined(USE_TCLALLOC) && USE_TCLALLOC MODULE_SCOPE void TclFinalizeAllocSubsystem(); MODULE_SCOPE void TclInitAlloc(); #else # define USE_TCLALLOC 0 #endif #ifdef TCL_THREADS /* declared in tclObj.c */ MODULE_SCOPE Tcl_Mutex tclObjMutex; #endif # define TclAllocObjStorageEx(interp, objPtr) \ do { \ Tcl_MutexLock(&tclObjMutex); \ if (tclFreeObjList == NULL) { \ TclAllocateFreeObjects(); \ } \ (objPtr) = tclFreeObjList; \ tclFreeObjList = (Tcl_Obj *) \ tclFreeObjList->internalRep.twoPtrValue.ptr1; \ Tcl_MutexUnlock(&tclObjMutex); \ } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ do { \ Tcl_MutexLock(&tclObjMutex); \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ tclFreeObjList = (objPtr); \ Tcl_MutexUnlock(&tclObjMutex); \ } while (0) #endif #else /* TCL_MEM_DEBUG */ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, int line); # define TclDbNewObj(objPtr, file, line) \ do { \ TclIncrObjsAllocated(); \ (objPtr) = (Tcl_Obj *) \ Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ TclDbInitNewObj((objPtr), (file), (line)); \ TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) # define TclNewObj(objPtr) \ TclDbNewObj(objPtr, __FILE__, __LINE__); # define TclDecrRefCount(objPtr) \ Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__) # define TclNewListObjDirect(objc, objv) \ TclDbNewListObjDirect(objc, objv, __FILE__, __LINE__) #undef USE_THREAD_ALLOC #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------- * Macro used by the Tcl core to set a Tcl_Obj's string representation to a * copy of the "len" bytes starting at "bytePtr". This code works even if the * byte array contains NULLs as long as the length is correct. Because "len" * is referenced multiple times, it should be as simple an expression as * possible. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len); * * This macro should only be called on an unshared objPtr where * objPtr->typePtr->freeIntRepProc == NULL *---------------------------------------------------------------- */ #define TclInitStringRep(objPtr, bytePtr, len) \ if ((len) == 0) { \ (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ } else { \ (objPtr)->bytes = (char *) ckalloc((unsigned int)(len) + 1U); \ memcpy((objPtr)->bytes, (bytePtr), (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ } /* *---------------------------------------------------------------- * Macro used by the Tcl core to get the string representation's byte array * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The * macro's expression result is the string rep's byte pointer which might be * NULL. The bytes referenced by this pointer must not be modified by the * caller. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE char * TclGetString(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) #define TclGetStringFromObj(objPtr, lenPtr) \ ((objPtr)->bytes \ ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ : Tcl_GetStringFromObj((objPtr), (lenPtr))) /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's internal * representation. Does not actually reset the rep's bytes. The ANSI C * "prototype" for this macro is: * * MODULE_SCOPE void TclFreeIntRep(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclFreeIntRep(objPtr) \ if ((objPtr)->typePtr != NULL) { \ if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ (objPtr)->typePtr->freeIntRepProc(objPtr); \ } \ (objPtr)->typePtr = NULL; \ } /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's string representation. * The ANSI C "prototype" for this macro is: * * MODULE_SCOPE void TclInvalidateStringRep(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclInvalidateStringRep(objPtr) \ do { \ Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ if (_isobjPtr->bytes != NULL) { \ if (_isobjPtr->bytes != tclEmptyStringRep) { \ ckfree((char *)_isobjPtr->bytes); \ } \ _isobjPtr->bytes = NULL; \ } \ } while (0) /* *---------------------------------------------------------------- * Macro used by the Tcl core to test whether an object has a * string representation (or is a 'pure' internal value). * The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclHasStringRep(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclHasStringRep(objPtr) \ ((objPtr)->bytes != NULL) /* *---------------------------------------------------------------- * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C * "prototype" for this macro is: * * MODULE_SCOPE void TclGrowTokenArray(Tcl_Token *tokenPtr, int used, * int available, int append, * Tcl_Token *staticPtr); * MODULE_SCOPE void TclGrowParseTokenArray(Tcl_Parse *parsePtr, * int append); *---------------------------------------------------------------- */ /* General tuning for minimum growth in Tcl growth algorithms */ #ifndef TCL_MIN_GROWTH # ifdef TCL_GROWTH_MIN_ALLOC /* Support for any legacy tuners */ # define TCL_MIN_GROWTH TCL_GROWTH_MIN_ALLOC # else # define TCL_MIN_GROWTH 1024 # endif #endif /* Token growth tuning, default to the general value. */ #ifndef TCL_MIN_TOKEN_GROWTH #define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token) #endif #define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token)) #define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \ do { \ int _needed = (used) + (append); \ if (_needed > TCL_MAX_TOKENS) { \ Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded", \ TCL_MAX_TOKENS); \ } \ if (_needed > (available)) { \ int allocated = 2 * _needed; \ Tcl_Token *oldPtr = (tokenPtr); \ Tcl_Token *newPtr; \ if (oldPtr == (staticPtr)) { \ oldPtr = NULL; \ } \ if (allocated > TCL_MAX_TOKENS) { \ allocated = TCL_MAX_TOKENS; \ } \ newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \ allocated * sizeof(Tcl_Token)); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ if (allocated > TCL_MAX_TOKENS) { \ allocated = TCL_MAX_TOKENS; \ } \ newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr, \ allocated * sizeof(Tcl_Token)); \ } \ (available) = allocated; \ if (oldPtr == NULL) { \ memcpy(newPtr, staticPtr, \ (used) * sizeof(Tcl_Token)); \ } \ (tokenPtr) = newPtr; \ } \ } while (0) #define TclGrowParseTokenArray(parsePtr, append) \ TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens, \ (parsePtr)->tokensAvailable, (append), \ (parsePtr)->staticTokens) /* *---------------------------------------------------------------- * Macro used by the Tcl core get a unicode char from a utf string. It checks * to see if we have a one-byte utf char before calling the real * Tcl_UtfToUniChar, as this will save a lot of time for primarily ASCII * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ #define TclUtfToUniChar(str, chPtr) \ (((UCHAR(*(str))) < 0x80) ? \ ((*(chPtr) = UCHAR(*(str))), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* *---------------------------------------------------------------- * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- * -sensitive points where it pays to avoid a function call in the common case * of counting along a string of all one-byte characters. The ANSI C * "prototype" for this macro is: * * MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes, * int numBytes); *---------------------------------------------------------------- */ #define TclNumUtfChars(numChars, bytes, numBytes) \ do { \ int _count, _i = (numBytes); \ unsigned char *_str = (unsigned char *) (bytes); \ while (_i && (*_str < 0xC0)) { _i--; _str++; } \ _count = (numBytes) - _i; \ if (_i) { \ _count += Tcl_NumUtfChars((bytes) + _count, _i); \ } \ (numChars) = _count; \ } while (0); #define TclUtfPrev(src, start) \ (((src) < (start)+2) ? (start) : \ (UCHAR(*((src) - 1))) < 0x80 ? (src)-1 : \ Tcl_UtfPrev(src, start)) /* *---------------------------------------------------------------- * Macro that encapsulates the logic that determines when it is safe to * interpret a string as a byte array directly. In summary, the object must be * a byte array and must not have a string representation (as the operations * that it is used in are defined on strings, not byte arrays). Theoretically * it is possible to also be efficient in the case where the object's bytes * field is filled by generation from the byte array (c.f. list canonicality) * but we don't do that at the moment since this is purely about efficiency. * The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclIsPureByteArray(objPtr) \ (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL)) #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType)) #define TclIsPureList(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType)) /* *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian * systems we can use the more efficient memcmp, but this would not be * lexically correct on little-endian systems. The ANSI C "prototype" for * this macro is: * * MODULE_SCOPE int TclUniCharNcmp(const void *cs, * const void *ct, size_t n); *---------------------------------------------------------------- */ #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX != 4) # define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) #endif /* WORDS_BIGENDIAN */ /* *---------------------------------------------------------------- * Macro used by the Tcl core to increment a namespace's export epoch * counter. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE void TclInvalidateNsCmdLookup(Namespace *nsPtr); *---------------------------------------------------------------- */ #define TclInvalidateNsCmdLookup(nsPtr) \ if ((nsPtr)->numExportPatterns) { \ (nsPtr)->exportLookupEpoch++; \ } \ if ((nsPtr)->commandPathLength) { \ (nsPtr)->cmdRefEpoch++; \ } /* *---------------------------------------------------------------------- * * Core procedure added to libtommath for bignum manipulation. * *---------------------------------------------------------------------- */ MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init; /* *---------------------------------------------------------------------- * * External (platform specific) initialization routine, these declarations * explicitly don't use EXTERN since this code does not get compiled into the * library: * *---------------------------------------------------------------------- */ MODULE_SCOPE Tcl_PackageInitProc TclplatformtestInit; MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init; MODULE_SCOPE Tcl_PackageInitProc TclThread_Init; MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init; MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; /* *---------------------------------------------------------------- * Macro used by the Tcl core to check whether a pattern has any characters * special to [string match]. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclMatchIsTrivial(const char *pattern); *---------------------------------------------------------------- */ #define TclMatchIsTrivial(pattern) \ (strpbrk((pattern), "*[?\\") == NULL) /* *---------------------------------------------------------------- * Macros used by the Tcl core to set a Tcl_Obj's numeric representation * avoiding the corresponding function calls in time critical parts of the * core. They should only be called on unshared objects. The ANSI C * "prototypes" for these macros are: * * MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, int intValue); * MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue); * MODULE_SCOPE void TclSetBooleanObj(Tcl_Obj *objPtr, int intValue); * MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d); *---------------------------------------------------------------- */ #define TclSetLongObj(objPtr, i) \ do { \ TclInvalidateStringRep(objPtr); \ TclFreeIntRep(objPtr); \ (objPtr)->internalRep.longValue = (long)(i); \ (objPtr)->typePtr = &tclIntType; \ } while (0) #define TclSetIntObj(objPtr, l) \ TclSetLongObj(objPtr, l) /* * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set * programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1. * The only "boolean" Tcl_Obj's shall be those holding the cached boolean * value of strings like: "yes", "no", "true", "false", "on", "off". */ #define TclSetBooleanObj(objPtr, b) \ TclSetLongObj(objPtr, (b)!=0); #ifndef TCL_WIDE_INT_IS_LONG #define TclSetWideIntObj(objPtr, w) \ do { \ TclInvalidateStringRep(objPtr); \ TclFreeIntRep(objPtr); \ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ (objPtr)->typePtr = &tclWideIntType; \ } while (0) #endif #define TclSetDoubleObj(objPtr, d) \ do { \ TclInvalidateStringRep(objPtr); \ TclFreeIntRep(objPtr); \ (objPtr)->internalRep.doubleValue = (double)(d); \ (objPtr)->typePtr = &tclDoubleType; \ } while (0) /* *---------------------------------------------------------------- * Macros used by the Tcl core to create and initialise objects of standard * types, avoiding the corresponding function calls in time critical parts of * the core. The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, int i); * MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l); * MODULE_SCOPE void TclNewBooleanObj(Tcl_Obj *objPtr, int b); * MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len); * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral); * *---------------------------------------------------------------- */ #ifndef TCL_MEM_DEBUG #define TclNewLongObj(objPtr, i) \ do { \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = NULL; \ (objPtr)->internalRep.longValue = (long)(i); \ (objPtr)->typePtr = &tclIntType; \ TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewIntObj(objPtr, l) \ TclNewLongObj(objPtr, l) /* * NOTE: There is to be no such thing as a "pure" boolean. * See comment above TclSetBooleanObj macro above. */ #define TclNewBooleanObj(objPtr, b) \ TclNewLongObj((objPtr), (b)!=0) #define TclNewDoubleObj(objPtr, d) \ do { \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = NULL; \ (objPtr)->internalRep.doubleValue = (double)(d); \ (objPtr)->typePtr = &tclDoubleType; \ TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewStringObj(objPtr, s, len) \ do { \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ (objPtr)->refCount = 0; \ TclInitStringRep((objPtr), (s), (len)); \ (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #else /* TCL_MEM_DEBUG */ #define TclNewIntObj(objPtr, i) \ (objPtr) = Tcl_NewIntObj(i) #define TclNewLongObj(objPtr, l) \ (objPtr) = Tcl_NewLongObj(l) #define TclNewBooleanObj(objPtr, b) \ (objPtr) = Tcl_NewBooleanObj(b) #define TclNewDoubleObj(objPtr, d) \ (objPtr) = Tcl_NewDoubleObj(d) #define TclNewStringObj(objPtr, s, len) \ (objPtr) = Tcl_NewStringObj((s), (len)) #endif /* TCL_MEM_DEBUG */ /* * The sLiteral argument *must* be a string literal; the incantation with * sizeof(sLiteral "") will fail to compile otherwise. */ #define TclNewLiteralStringObj(objPtr, sLiteral) \ TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1) /* *---------------------------------------------------------------- * Convenience macros for DStrings. * The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr, * const char *sLiteral); * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr); */ #define TclDStringAppendLiteral(dsPtr, sLiteral) \ Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1) #define TclDStringClear(dsPtr) \ Tcl_DStringSetLength((dsPtr), 0) /* *---------------------------------------------------------------- * Macros used by the Tcl core to test for some special double values. * The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE int TclIsInfinite(double d); * MODULE_SCOPE int TclIsNaN(double d); */ #ifdef _MSC_VER # define TclIsInfinite(d) (!(_finite((d)))) # define TclIsNaN(d) (_isnan((d))) #else # define TclIsInfinite(d) ((d) > DBL_MAX || (d) < -DBL_MAX) # ifdef NO_ISNAN # define TclIsNaN(d) ((d) != (d)) # else # define TclIsNaN(d) (isnan(d)) # endif #endif /* * ---------------------------------------------------------------------- * Macro to use to find the offset of a field in a structure. Computes number * of bytes from beginning of structure to a given field. */ #ifdef offsetof #define TclOffset(type, field) ((int) offsetof(type, field)) #else #define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field)) #endif /* *---------------------------------------------------------------- * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace. */ #define TclGetCurrentNamespace(interp) \ (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr #define TclGetGlobalNamespace(interp) \ (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr /* *---------------------------------------------------------------- * Inline version of TclCleanupCommand; still need the function as it is in * the internal stubs, but the core can use the macro instead. */ #define TclCleanupCommandMacro(cmdPtr) \ do { \ if ((cmdPtr)->refCount-- <= 1) { \ ckfree(cmdPtr); \ } \ } while (0) /* *---------------------------------------------------------------- * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number * of calls out of the critical path. Note that this code isn't particularly * readable; the non-inline version (in tclInterp.c) is much easier to * understand. Note also that these macros takes different args (iPtr->limit) * to the non-inline version. */ #define TclLimitExceeded(limit) ((limit).exceeded != 0) #define TclLimitReady(limit) \ (((limit).active == 0) ? 0 : \ (++(limit).granularityTicker, \ ((((limit).active & TCL_LIMIT_COMMANDS) && \ (((limit).cmdGranularity == 1) || \ ((limit).granularityTicker % (limit).cmdGranularity == 0))) \ ? 1 : \ (((limit).active & TCL_LIMIT_TIME) && \ (((limit).timeGranularity == 1) || \ ((limit).granularityTicker % (limit).timeGranularity == 0)))\ ? 1 : 0))) /* * Compile-time assertions: these produce a compile time error if the * expression is not known to be true at compile time. If the assertion is * known to be false, the compiler (or optimizer?) will error out with * "division by zero". If the assertion cannot be evaluated at compile time, * the compiler will error out with "non-static initializer". * * Adapted with permission from * http://www.pixelbeat.org/programming/gcc/static_assert.html */ #define TCL_CT_ASSERT(e) \ {enum { ct_assert_value = 1/(!!(e)) };} /* *---------------------------------------------------------------- * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool. * Only checked at compile time. * * ONLY USE FOR CONSTANT nBytes. * * DO NOT LET THEM CROSS THREAD BOUNDARIES *---------------------------------------------------------------- */ #define TclSmallAlloc(nbytes, memPtr) \ TclSmallAllocEx(NULL, (nbytes), (memPtr)) #define TclSmallFree(memPtr) \ TclSmallFreeEx(NULL, (memPtr)) #ifndef TCL_MEM_DEBUG #define TclSmallAllocEx(interp, nbytes, memPtr) \ do { \ Tcl_Obj *_objPtr; \ TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ TclIncrObjsAllocated(); \ TclAllocObjStorageEx((interp), (_objPtr)); \ *(void **)&(memPtr) = (void *) (_objPtr); \ } while (0) #define TclSmallFreeEx(interp, memPtr) \ do { \ TclFreeObjStorageEx((interp), (Tcl_Obj *)(memPtr)); \ TclIncrObjsFreed(); \ } while (0) #else /* TCL_MEM_DEBUG */ #define TclSmallAllocEx(interp, nbytes, memPtr) \ do { \ Tcl_Obj *_objPtr; \ TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ TclNewObj(_objPtr); \ *(void **)&(memPtr) = (void *)_objPtr; \ } while (0) #define TclSmallFreeEx(interp, memPtr) \ do { \ Tcl_Obj *_objPtr = (Tcl_Obj *)(memPtr); \ _objPtr->bytes = NULL; \ _objPtr->typePtr = NULL; \ _objPtr->refCount = 1; \ TclDecrRefCount(_objPtr); \ } while (0) #endif /* TCL_MEM_DEBUG */ /* * Support for Clang Static Analyzer */ #if defined(PURIFY) && defined(__clang__) #if __has_feature(attribute_analyzer_noreturn) && \ !defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED) void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); #endif #if !defined(CLANG_ASSERT) #include #define CLANG_ASSERT(x) assert(x) #endif #elif !defined(CLANG_ASSERT) #define CLANG_ASSERT(x) #endif /* PURIFY && __clang__ */ /* *---------------------------------------------------------------- * Parameters, structs and macros for the non-recursive engine (NRE) *---------------------------------------------------------------- */ #define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */ #ifndef NRE_ENABLE_ASSERTS #define NRE_ENABLE_ASSERTS 0 #endif /* * This is the main data struct for representing NR commands. It is designed * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator * available. */ typedef struct NRE_callback { Tcl_NRPostProc *procPtr; ClientData data[4]; struct NRE_callback *nextPtr; } NRE_callback; #define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) /* * Inline version of Tcl_NRAddCallback. */ #define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \ do { \ NRE_callback *_callbackPtr; \ TCLNR_ALLOC((interp), (_callbackPtr)); \ _callbackPtr->procPtr = (postProcPtr); \ _callbackPtr->data[0] = (ClientData)(data0); \ _callbackPtr->data[1] = (ClientData)(data1); \ _callbackPtr->data[2] = (ClientData)(data2); \ _callbackPtr->data[3] = (ClientData)(data3); \ _callbackPtr->nextPtr = TOP_CB(interp); \ TOP_CB(interp) = _callbackPtr; \ } while (0) #if NRE_USE_SMALL_ALLOC #define TCLNR_ALLOC(interp, ptr) \ TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr)) #define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) #else #define TCLNR_ALLOC(interp, ptr) \ ((ptr) = (void *)ckalloc(sizeof(NRE_callback))) #define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr)) #endif #if NRE_ENABLE_ASSERTS #define NRE_ASSERT(expr) assert((expr)) #else #define NRE_ASSERT(expr) #endif #include "tclIntDecls.h" #include "tclIntPlatDecls.h" #include "tclTomMathDecls.h" #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) #define Tcl_AttemptAlloc TclpAlloc #define Tcl_AttemptRealloc TclpRealloc #define Tcl_Free TclpFree #endif /* * Special hack for macOS, where the static linker (technically the 'ar' * command) hates empty object files, and accepts no flags to make it shut up. * * These symbols are otherwise completely useless. * * They can't be written to or written through. They can't be seen by any * other code. They use a separate attribute (supported by all macOS * compilers, which are derivatives of clang or gcc) to stop the compilation * from moaning. They will be excluded during the final linking stage. * * Other platforms get nothing at all. That's good. */ #ifdef MAC_OSX_TCL #define TCL_MAC_EMPTY_FILE(name) \ static __attribute__((used)) const void *const TclUnusedFile_ ## name = NULL; #else #define TCL_MAC_EMPTY_FILE(name) #endif /* MAC_OSX_TCL */ /* * Other externals. */ MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment * (if changed with tcl-env). */ #endif /* _TCLINT */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclIntPlatDecls.h0000644000175000017500000005533014566153373016476 0ustar sergeisergei/* * tclIntPlatDecls.h -- * * This file contains the declarations for all platform dependent * unsupported functions that are exported by the Tcl library. These * interfaces are not guaranteed to remain the same between * versions. Use at your own risk. * * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. */ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tclInt.decls script. */ /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 0 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 1 */ EXTERN int TclpCloseFile(TclFile file); /* 2 */ EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 5 */ EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout); /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); /* 11 */ EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); /* 12 */ EXTERN struct tm * TclpGmtime_unix(const time_t *clock); /* 13 */ EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 15 */ EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 16 */ EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 17 */ EXTERN int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 18 */ EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 19 */ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* Slot 20 is reserved */ /* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile_(const char *contents); /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); /* 30 */ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN void TclWinConvertError(DWORD errCode); /* 1 */ EXTERN void TclWinConvertWSAError(DWORD errCode); /* 2 */ EXTERN struct servent * TclWinGetServByName(const char *nm, const char *proto); /* 3 */ EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen); /* 4 */ EXTERN HINSTANCE TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 6 */ EXTERN unsigned short TclWinNToHS(unsigned short ns); /* 7 */ EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen); /* 8 */ EXTERN int TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN int TclWinGetPlatformId(void); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 12 */ EXTERN int TclpCloseFile(TclFile file); /* 13 */ EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 14 */ EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 15 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 16 */ EXTERN int TclpIsAtty(int fd); /* 17 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 18 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 19 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); /* 21 */ EXTERN char * TclpInetNtoa(struct in_addr addr); /* 22 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ /* 26 */ EXTERN void TclWinSetInterfaces(int wide); /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); /* 28 */ EXTERN void TclWinResetInterfaces(void); /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); /* 30 */ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 1 */ EXTERN int TclpCloseFile(TclFile file); /* 2 */ EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 5 */ EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout); /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); /* 11 */ EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); /* 12 */ EXTERN struct tm * TclpGmtime_unix(const time_t *clock); /* 13 */ EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 15 */ EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 16 */ EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 17 */ EXTERN int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 18 */ EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 19 */ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* Slot 20 is reserved */ /* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile_(const char *contents); /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); /* 30 */ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* MACOSX */ typedef struct TclIntPlatStubs { int magic; void *hooks; #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */ int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */ int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ void (*reserved20)(void); void (*reserved21)(void); TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */ void (*reserved23)(void); void (*reserved24)(void); void (*reserved25)(void); void (*reserved26)(void); void (*reserved27)(void); void (*reserved28)(void); int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */ int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */ HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ int (*tclWinGetPlatformId) (void); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ int (*tclpIsAtty) (int fd); /* 16 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */ void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); void (*tclWinSetInterfaces) (int wide); /* 26 */ void (*tclWinFlushDirtyChannels) (void); /* 27 */ void (*tclWinResetInterfaces) (void); /* 28 */ int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */ int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */ int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ void (*reserved20)(void); void (*reserved21)(void); TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */ void (*reserved23)(void); void (*reserved24)(void); void (*reserved25)(void); void (*reserved26)(void); void (*reserved27)(void); void (*reserved28)(void); int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* MACOSX */ } TclIntPlatStubs; extern const TclIntPlatStubs *tclIntPlatStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) /* * Inline function declarations: */ #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #define TclpCreateCommandChannel \ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ #define TclUnixWaitForFile_ \ (tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #define TclpLocaltime_unix \ (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ #define TclpGmtime_unix \ (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */ #define TclMacOSXSetFileAttribute \ (tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */ #define TclMacOSXCopyFileAttributes \ (tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */ #define TclMacOSXMatchType \ (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ #define TclpCreateTempFile_ \ (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ #define TclWinConvertWSAError \ (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ #define TclWinGetServByName \ (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ #define TclWinGetSockOpt \ (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ #define TclWinNToHS \ (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ #define TclWinSetSockOpt \ (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 12 */ #define TclpCreateCommandChannel \ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ #define TclWinSetInterfaces \ (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ #define TclWinResetInterfaces \ (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #define TclpCreateCommandChannel \ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ #define TclUnixWaitForFile_ \ (tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #define TclpLocaltime_unix \ (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ #define TclpGmtime_unix \ (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */ #define TclMacOSXSetFileAttribute \ (tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */ #define TclMacOSXCopyFileAttributes \ (tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */ #define TclMacOSXMatchType \ (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ #define TclpCreateTempFile_ \ (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #undef TclpLocaltime_unix #undef TclpGmtime_unix #undef TclWinConvertWSAError #define TclWinConvertWSAError TclWinConvertError #undef TclpInetNtoa #define TclpInetNtoa inet_ntoa #undef TclpCreateTempFile_ #undef TclUnixWaitForFile_ #ifndef MAC_OSX_TCL /* not accessible on Win32/UNIX */ #undef TclMacOSXGetFileAttribute /* 15 */ #undef TclMacOSXSetFileAttribute /* 16 */ #undef TclMacOSXCopyFileAttributes /* 17 */ #undef TclMacOSXMatchType /* 18 */ #undef TclMacOSXNotifierAddRunLoopMode /* 19 */ #endif #if defined(_WIN32) # undef TclWinNToHS # undef TclWinGetServByName # undef TclWinGetSockOpt # undef TclWinSetSockOpt # define TclWinNToHS ntohs # define TclWinGetServByName getservbyname # define TclWinGetSockOpt getsockopt # define TclWinSetSockOpt setsockopt #else # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) #endif #endif /* _TCLINTPLATDECLS */ tcl8.6.14/generic/tclIO.c0000644000175000017500000115123014563206224014436 0ustar sergeisergei/* * tclIO.c -- * * This file provides the generic portions (those that are the same on * all platforms and for all channel types) of Tcl's IO facilities. * * Copyright (c) 1998-2000 Ajuba Solutions * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Contributions from Don Porter, NIST, 2014. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" #include /* * For each channel handler registered in a call to Tcl_CreateChannelHandler, * there is one record of the following type. All of records for a specific * channel are chained together in a singly linked list which is stored in * the channel structure. */ typedef struct ChannelHandler { Channel *chanPtr; /* The channel structure for this channel. */ int mask; /* Mask of desired events. */ Tcl_ChannelProc *proc; /* Procedure to call in the type of * Tcl_CreateChannelHandler. */ ClientData clientData; /* Argument to pass to procedure. */ struct ChannelHandler *nextPtr; /* Next one in list of registered handlers. */ } ChannelHandler; /* * This structure keeps track of the current ChannelHandler being invoked in * the current invocation of Tcl_NotifyChannel. There is a potential * problem if a ChannelHandler is deleted while it is the current one, since * Tcl_NotifyChannel needs to look at the nextPtr field. To handle this * problem, structures of the type below indicate the next handler to be * processed for any (recursively nested) dispatches in progress. The * nextHandlerPtr field is updated if the handler being pointed to is deleted. * The nestedHandlerPtr field is used to chain together all recursive * invocations, so that Tcl_DeleteChannelHandler can find all the recursively * nested invocations of Tcl_NotifyChannel and compare the handler being * deleted against the NEXT handler to be invoked in that invocation; when it * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr * field of the structure to the next handler. */ typedef struct NextChannelHandler { ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in * this invocation. */ struct NextChannelHandler *nestedHandlerPtr; /* Next nested invocation of * Tcl_NotifyChannel. */ } NextChannelHandler; /* * The following structure is used by Tcl_GetsObj() to encapsulates the * state for a "gets" operation. */ typedef struct GetsState { Tcl_Obj *objPtr; /* The object to which UTF-8 characters * will be appended. */ char **dstPtr; /* Pointer into objPtr's string rep where * next character should be stored. */ Tcl_Encoding encoding; /* The encoding to use to convert raw bytes * to UTF-8. */ ChannelBuffer *bufPtr; /* The current buffer of raw bytes being * emptied. */ Tcl_EncodingState state; /* The encoding state just before the last * external to UTF-8 conversion in * FilterInputBytes(). */ int rawRead; /* The number of bytes removed from bufPtr * in the last call to FilterInputBytes(). */ int bytesWrote; /* The number of bytes of UTF-8 data * appended to objPtr during the last call to * FilterInputBytes(). */ int charsWrote; /* The corresponding number of UTF-8 * characters appended to objPtr during the * last call to FilterInputBytes(). */ int totalChars; /* The total number of UTF-8 characters * appended to objPtr so far, just before the * last call to FilterInputBytes(). */ } GetsState; /* * The following structure encapsulates the state for a background channel * copy. Note that the data buffer for the copy will be appended to this * structure. */ typedef struct CopyState { struct Channel *readPtr; /* Pointer to input channel. */ struct Channel *writePtr; /* Pointer to output channel. */ int readFlags; /* Original read channel flags. */ int writeFlags; /* Original write channel flags. */ Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */ Tcl_WideInt total; /* Total bytes transferred (written). */ Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ int bufSize; /* Size of appended buffer. */ char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last * field. */ } CopyState; /* * All static variables used in this file are collected into a single instance * of the following structure. For multi-threaded implementations, there is * one instance of this structure for each thread. * * Notice that different structures with the same name appear in other files. * The structure defined below is used in this file only. */ typedef struct ThreadSpecificData { NextChannelHandler *nestedHandlerPtr; /* This variable holds the list of nested * Tcl_NotifyChannel invocations. */ ChannelState *firstCSPtr; /* List of all channels currently open, * indexed by ChannelState, as only one * ChannelState exists per set of stacked * channels. */ Tcl_Channel stdinChannel; /* Static variable for the stdin channel. */ int stdinInitialized; Tcl_Channel stdoutChannel; /* Static variable for the stdout channel. */ int stdoutInitialized; Tcl_Channel stderrChannel; /* Static variable for the stderr channel. */ int stderrInitialized; Tcl_Encoding binaryEncoding; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Structure to record a close callback. One such record exists for * each close callback registered for a channel. */ typedef struct CloseCallback { Tcl_CloseProc *proc; /* The procedure to call. */ ClientData clientData; /* Arbitrary one-word data to pass * to the callback. */ struct CloseCallback *nextPtr; /* For chaining close callbacks. */ } CloseCallback; /* * Static functions in this file: */ static ChannelBuffer * AllocChannelBuffer(int length); static void PreserveChannelBuffer(ChannelBuffer *bufPtr); static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); static int IsShared(ChannelBuffer *bufPtr); static void ChannelFree(Channel *chanPtr); static void ChannelTimerProc(ClientData clientData); static int ChanRead(Channel *chanPtr, char *dst, int dstSize); static int CheckChannelErrors(ChannelState *statePtr, int direction); static int CheckForDeadChannel(Tcl_Interp *interp, ChannelState *statePtr); static void CheckForStdChannelsBeingClosed(Tcl_Channel chan); static void CleanupChannelHandlers(Tcl_Interp *interp, Channel *chanPtr); static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr, int errorCode); static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr, int errorCode, int flags); static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr); static void CommonGetsCleanup(Channel *chanPtr); static int CopyData(CopyState *csPtr, int mask); static int MoveBytes(CopyState *csPtr); static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj); static void MBError(CopyState *csPtr, int mask, int errorCode); static int MBRead(CopyState *csPtr); static int MBWrite(CopyState *csPtr); static void MBEvent(ClientData clientData, int mask); static void CopyEventProc(ClientData clientData, int mask); static void CreateScriptRecord(Tcl_Interp *interp, Channel *chanPtr, int mask, Tcl_Obj *scriptPtr); static void DeleteChannelTable(ClientData clientData, Tcl_Interp *interp); static void DeleteScriptRecord(Tcl_Interp *interp, Channel *chanPtr, int mask); static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan); static void DiscardInputQueued(ChannelState *statePtr, int discardSavedBuffers); static void DiscardOutputQueued(ChannelState *chanPtr); static int DoRead(Channel *chanPtr, char *dst, int bytesToRead, int allowShortReads); static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead, int appendFlag); static int FilterInputBytes(Channel *chanPtr, GetsState *statePtr); static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush); static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr); static Tcl_Encoding GetBinaryEncoding(void); static void FreeBinaryEncoding(ClientData clientData); static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp); static int GetInput(Channel *chanPtr); static void PeekAhead(Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr); static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft); static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft, int *factorPtr); static void RecycleBuffer(ChannelState *statePtr, ChannelBuffer *bufPtr, int mustDiscard); static int StackSetBlockMode(Channel *chanPtr, int mode); static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr, int mode); static void StopCopy(CopyState *csPtr); static void TranslateInputEOL(ChannelState *statePtr, char *dst, const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); static int Write(Channel *chanPtr, const char *src, int srcLen, Tcl_Encoding encoding); static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); static int WillRead(Channel *chanPtr); #define WriteChars(chanPtr, src, srcLen) \ Write(chanPtr, src, srcLen, chanPtr->state->encoding) #define WriteBytes(chanPtr, src, srcLen) \ Write(chanPtr, src, srcLen, tclIdentityEncoding) /* * Simplifying helper macros. All may use their argument(s) multiple times. * The ANSI C "prototypes" for the macros are listed below, together with a * short description of what the macro does. * * -------------------------------------------------------------------------- * int BytesLeft(ChannelBuffer *bufPtr) * * Returns the number of bytes of data remaining in the buffer. * * int SpaceLeft(ChannelBuffer *bufPtr) * * Returns the number of bytes of space remaining at the end of the * buffer. * * int IsBufferReady(ChannelBuffer *bufPtr) * * Returns whether a buffer has bytes available within it. * * int IsBufferEmpty(ChannelBuffer *bufPtr) * * Returns whether a buffer is entirely empty. Note that this is not the * inverse of the above operation; trying to merge the two seems to lead * to occasional crashes... * * int IsBufferFull(ChannelBuffer *bufPtr) * * Returns whether more data can be added to a buffer. * * int IsBufferOverflowing(ChannelBuffer *bufPtr) * * Returns whether a buffer has more data in it than it should. * * char *InsertPoint(ChannelBuffer *bufPtr) * * Returns a pointer to where characters should be added to the buffer. * * char *RemovePoint(ChannelBuffer *bufPtr) * * Returns a pointer to where characters should be removed from the * buffer. * -------------------------------------------------------------------------- */ #define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved) #define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded) #define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved) #define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved) #define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength) #define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength) #define InsertPoint(bufPtr) (&(bufPtr)->buf[(bufPtr)->nextAdded]) #define RemovePoint(bufPtr) (&(bufPtr)->buf[(bufPtr)->nextRemoved]) /* * For working with channel state flag bits. */ #define SetFlag(statePtr, flag) ((statePtr)->flags |= (flag)) #define ResetFlag(statePtr, flag) ((statePtr)->flags &= ~(flag)) #define GotFlag(statePtr, flag) ((statePtr)->flags & (flag)) /* * Macro for testing whether a string (in optionName, length len) matches a * value (prefix matching rules). Arguments are the minimum length to match * and the value to match against. (Can't use Tcl_GetIndexFromObj as this is * used in a situation where no objects are available.) */ #define HaveOpt(minLength, nameString) \ ((len > (minLength)) && (optionName[1] == (nameString)[1]) \ && (strncmp(optionName, (nameString), len) == 0)) /* * The ChannelObjType type. Used to store the result of looking up * a channel name in the context of an interp. Saves the lookup * result and values needed to check its continued validity. */ typedef struct ResolvedChanName { ChannelState *statePtr; /* The saved lookup result */ Tcl_Interp *interp; /* The interp in which the lookup was done. */ int epoch; /* The epoch of the channel when the lookup * was done. Use to verify validity. */ int refCount; /* Share this struct among many Tcl_Obj. */ } ResolvedChanName; static void DupChannelInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void FreeChannelInternalRep(Tcl_Obj *objPtr); static const Tcl_ObjType chanObjType = { "channel", /* name for this type */ FreeChannelInternalRep, /* freeIntRepProc */ DupChannelInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL /* setFromAnyProc */ }; #define BUSY_STATE(st, fl) \ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) #define MAX_CHANNEL_BUFFER_SIZE (1024*1024) /* *--------------------------------------------------------------------------- * * ChanClose, ChanRead, ChanSeek, ChanThreadAction, ChanWatch, ChanWrite -- * * Simplify the access to selected channel driver "methods" that are used * in multiple places in a stereotypical fashion. These are just thin * wrappers around the driver functions. * *--------------------------------------------------------------------------- */ static inline int ChanClose( Channel *chanPtr, Tcl_Interp *interp) { if ((chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) && (chanPtr->typePtr->closeProc != NULL)) { return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp); } else { return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0); } } /* *--------------------------------------------------------------------------- * * ChanRead -- * * Read up to dstSize bytes using the inputProc of chanPtr, store them at * dst, and return the number of bytes stored. * * Results: * The return value of the driver inputProc, * - number of bytes stored at dst, ot * - -1 on error, with a Posix error code available to the caller by * calling Tcl_GetErrno(). * * Side effects: * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are set * as appropriate. On EOF, the inputEncodingFlags are set to perform * ending operations on decoding. * * TODO - Is this really the right place for that? * *--------------------------------------------------------------------------- */ static int ChanRead( Channel *chanPtr, char *dst, int dstSize) { int bytesRead, result; /* * If the caller asked for zero bytes, we'd force the inputProc to return * zero bytes, and then misinterpret that as EOF. */ assert(dstSize > 0); /* * Each read op must set the blocked and eof states anew, not let * the effect of prior reads leak through. */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (WillRead(chanPtr) < 0) { return -1; } bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize, &result); /* * Stop any flag leakage through stacked channel levels. */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (bytesRead > 0) { /* * If we get a short read, signal up that we may be BLOCKED. We should * avoid calling the driver because on some platforms we will block in * the low level reading code even though the channel is set into * nonblocking mode. */ if (bytesRead < dstSize) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); } } else if (bytesRead == 0) { SetFlag(chanPtr->state, CHANNEL_EOF); chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; } else if (bytesRead < 0) { if ((result == EWOULDBLOCK) || (result == EAGAIN)) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); result = EAGAIN; } Tcl_SetErrno(result); } return bytesRead; } static inline Tcl_WideInt ChanSeek( Channel *chanPtr, Tcl_WideInt offset, int mode, int *errnoPtr) { /* * Note that we prefer the wideSeekProc if that field is available in the * type and non-NULL. */ if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) { return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData, offset, mode, errnoPtr); } if (offsetTcl_LongAsWide(LONG_MAX)) { *errnoPtr = EOVERFLOW; return Tcl_LongAsWide(-1); } return Tcl_LongAsWide(Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, Tcl_WideAsLong(offset), mode, errnoPtr)); } static inline void ChanThreadAction( Channel *chanPtr, int action) { Tcl_DriverThreadActionProc *threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr); if (threadActionProc != NULL) { threadActionProc(chanPtr->instanceData, action); } } static inline void ChanWatch( Channel *chanPtr, int mask) { chanPtr->typePtr->watchProc(chanPtr->instanceData, mask); } static inline int ChanWrite( Channel *chanPtr, const char *src, int srcLen, int *errnoPtr) { return chanPtr->typePtr->outputProc(chanPtr->instanceData, src, srcLen, errnoPtr); } /* *--------------------------------------------------------------------------- * * TclInitIOSubsystem -- * * Initialize all resources used by this subsystem on a per-process * basis. * * Results: * None. * * Side effects: * Depends on the memory subsystems. * *--------------------------------------------------------------------------- */ void TclInitIOSubsystem(void) { /* * By fetching thread local storage we take care of allocating it for each * thread. */ (void) TCL_TSD_INIT(&dataKey); } /* *------------------------------------------------------------------------- * * TclFinalizeIOSubsystem -- * * Releases all resources used by this subsystem on a per-process basis. * Closes all extant channels that have not already been closed because * they were not owned by any interp. * * Results: * None. * * Side effects: * Depends on encoding and memory subsystems. * *------------------------------------------------------------------------- */ void TclFinalizeIOSubsystem(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr = NULL; /* Iterates over open channels. */ ChannelState *statePtr; /* State of channel stack */ int active = 1; /* Flag == 1 while there's still work to do */ int doflushnb; /* * Fetch the pre-TIP#398 compatibility flag. */ { const char *s; Tcl_DString ds; s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); doflushnb = ((s != NULL) && strcmp(s, "0")); if (s != NULL) { Tcl_DStringFree(&ds); } } /* * Walk all channel state structures known to this thread and close * corresponding channels. */ while (active) { /* * Iterate through the open channel list, and find the first channel * that isn't dead. We start from the head of the list each time, * because the close action on one channel can close others. */ active = 0; for (statePtr = tsdPtr->firstCSPtr; statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; if (GotFlag(statePtr, CHANNEL_DEAD)) { continue; } if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; } } /* * We've found a live (or bg-closing) channel. Close it. */ if (active) { TclChannelPreserve((Tcl_Channel)chanPtr); /* * TIP #398: by default, we no longer set the channel back into * blocking mode. To restore the old blocking behavior, the * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set * and not be "0". */ if (doflushnb) { /* * Set the channel back into blocking mode to ensure that we * wait for all data to flush out. */ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, "-blocking", "on"); } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || (chanPtr == (Channel *) tsdPtr->stderrChannel)) { /* * Decrement the refcount which was earlier artificially * bumped up to keep the channel from being closed. */ statePtr->refCount--; } if (statePtr->refCount <= 0) { /* * Close it only if the refcount indicates that the channel is * not referenced from any interpreter. If it is, that * interpreter will close the channel when it gets destroyed. */ (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr); } else { /* * The refcount is greater than zero, so flush the channel. */ Tcl_Flush((Tcl_Channel) chanPtr); /* * Call the device driver to actually close the underlying * device for this channel. */ (void) ChanClose(chanPtr, NULL); /* * Finally, we clean up the fields in the channel data * structure since all of them have been deleted already. We * mark the channel with CHANNEL_DEAD to prevent any further * IO operations on it. */ chanPtr->instanceData = NULL; SetFlag(statePtr, CHANNEL_DEAD); } TclChannelRelease((Tcl_Channel)chanPtr); } } TclpFinalizeSockets(); TclpFinalizePipes(); } /* *---------------------------------------------------------------------- * * Tcl_SetStdChannel -- * * This function is used to change the channels that are used for * stdin/stdout/stderr in new interpreters. * * Results: * None * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_SetStdChannel( Tcl_Channel channel, int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int init = channel ? 1 : -1; switch (type) { case TCL_STDIN: tsdPtr->stdinInitialized = init; tsdPtr->stdinChannel = channel; break; case TCL_STDOUT: tsdPtr->stdoutInitialized = init; tsdPtr->stdoutChannel = channel; break; case TCL_STDERR: tsdPtr->stderrInitialized = init; tsdPtr->stderrChannel = channel; break; } } /* *---------------------------------------------------------------------- * * Tcl_GetStdChannel -- * * Returns the specified standard channel. * * Results: * Returns the specified standard channel, or NULL. * * Side effects: * May cause the creation of a standard channel and the underlying file. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_GetStdChannel( int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */ { Tcl_Channel channel = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * If the channels were not created yet, create them now and store them in * the static variables. */ switch (type) { case TCL_STDIN: if (!tsdPtr->stdinInitialized) { tsdPtr->stdinInitialized = -1; tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN); /* * Artificially bump the refcount to ensure that the channel is * only closed on exit. * * NOTE: Must only do this if stdinChannel is not NULL. It can be * NULL in situations where Tcl is unable to connect to the * standard input. */ if (tsdPtr->stdinChannel != NULL) { tsdPtr->stdinInitialized = 1; Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel); } } channel = tsdPtr->stdinChannel; break; case TCL_STDOUT: if (!tsdPtr->stdoutInitialized) { tsdPtr->stdoutInitialized = -1; tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT); if (tsdPtr->stdoutChannel != NULL) { tsdPtr->stdoutInitialized = 1; Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel); } } channel = tsdPtr->stdoutChannel; break; case TCL_STDERR: if (!tsdPtr->stderrInitialized) { tsdPtr->stderrInitialized = -1; tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR); if (tsdPtr->stderrChannel != NULL) { tsdPtr->stderrInitialized = 1; Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel); } } channel = tsdPtr->stderrChannel; break; } return channel; } /* *---------------------------------------------------------------------- * * Tcl_CreateCloseHandler * * Creates a close callback which will be called when the channel is * closed. * * Results: * None. * * Side effects: * Causes the callback to be called in the future when the channel will * be closed. * *---------------------------------------------------------------------- */ void Tcl_CreateCloseHandler( Tcl_Channel chan, /* The channel for which to create the close * callback. */ Tcl_CloseProc *proc, /* The callback routine to call when the * channel will be closed. */ ClientData clientData) /* Arbitrary data to pass to the close * callback. */ { ChannelState *statePtr = ((Channel *) chan)->state; CloseCallback *cbPtr; cbPtr = (CloseCallback *)ckalloc(sizeof(CloseCallback)); cbPtr->proc = proc; cbPtr->clientData = clientData; cbPtr->nextPtr = statePtr->closeCbPtr; statePtr->closeCbPtr = cbPtr; } /* *---------------------------------------------------------------------- * * Tcl_DeleteCloseHandler -- * * Removes a callback that would have been called on closing the channel. * If there is no matching callback then this function has no effect. * * Results: * None. * * Side effects: * The callback will not be called in the future when the channel is * eventually closed. * *---------------------------------------------------------------------- */ void Tcl_DeleteCloseHandler( Tcl_Channel chan, /* The channel for which to cancel the close * callback. */ Tcl_CloseProc *proc, /* The procedure for the callback to * remove. */ ClientData clientData) /* The callback data for the callback to * remove. */ { ChannelState *statePtr = ((Channel *) chan)->state; CloseCallback *cbPtr, *cbPrevPtr; for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL; cbPtr != NULL; cbPtr = cbPtr->nextPtr) { if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) { if (cbPrevPtr == NULL) { statePtr->closeCbPtr = cbPtr->nextPtr; } else { cbPrevPtr->nextPtr = cbPtr->nextPtr; } ckfree(cbPtr); break; } cbPrevPtr = cbPtr; } } /* *---------------------------------------------------------------------- * * GetChannelTable -- * * Gets and potentially initializes the channel table for an interpreter. * If it is initializing the table it also inserts channels for stdin, * stdout and stderr if the interpreter is trusted. * * Results: * A pointer to the hash table created, for use by the caller. * * Side effects: * Initializes the channel table for an interpreter. May create channels * for stdin, stdout and stderr. * *---------------------------------------------------------------------- */ static Tcl_HashTable * GetChannelTable( Tcl_Interp *interp) { Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_Channel stdinChan, stdoutChan, stderrChan; hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS); Tcl_SetAssocData(interp, "tclIO", (Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr); /* * If the interpreter is trusted (not "safe"), insert channels for * stdin, stdout and stderr (possibly creating them in the process). */ if (Tcl_IsSafe(interp) == 0) { stdinChan = Tcl_GetStdChannel(TCL_STDIN); if (stdinChan != NULL) { Tcl_RegisterChannel(interp, stdinChan); } stdoutChan = Tcl_GetStdChannel(TCL_STDOUT); if (stdoutChan != NULL) { Tcl_RegisterChannel(interp, stdoutChan); } stderrChan = Tcl_GetStdChannel(TCL_STDERR); if (stderrChan != NULL) { Tcl_RegisterChannel(interp, stderrChan); } } } return hTblPtr; } /* *---------------------------------------------------------------------- * * DeleteChannelTable -- * * Deletes the channel table for an interpreter, closing any open * channels whose refcount reaches zero. This procedure is invoked when * an interpreter is deleted, via the AssocData cleanup mechanism. * * Results: * None. * * Side effects: * Deletes the hash table of channels. May close channels. May flush * output on closed channels. Removes any channelEvent handlers that were * registered in this interpreter. * *---------------------------------------------------------------------- */ static void DeleteChannelTable( ClientData clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { Tcl_HashTable *hTblPtr; /* The hash table. */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ Channel *chanPtr; /* Channel being deleted. */ ChannelState *statePtr; /* State of Channel being deleted. */ EventScriptRecord *sPtr, *prevPtr, *nextPtr; /* Variables to loop over all channel events * registered, to delete the ones that refer * to the interpreter being deleted. */ /* * Delete all the registered channels - this will close channels whose * refcount reaches zero. */ hTblPtr = (Tcl_HashTable *)clientData; for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) { chanPtr = (Channel *)Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; /* * Remove any file events registered in this interpreter. */ for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL; sPtr != NULL; sPtr = nextPtr) { nextPtr = sPtr->nextPtr; if (sPtr->interp == interp) { if (prevPtr == NULL) { statePtr->scriptRecordPtr = nextPtr; } else { prevPtr->nextPtr = nextPtr; } Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); ckfree(sPtr); } else { prevPtr = sPtr; } } /* * Cannot call Tcl_UnregisterChannel because that procedure calls * Tcl_GetAssocData to get the channel table, which might already be * inaccessible from the interpreter structure. Instead, we emulate * the behavior of Tcl_UnregisterChannel directly here. */ Tcl_DeleteHashEntry(hPtr); statePtr->epoch++; if (statePtr->refCount-- <= 1) { if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { (void) Tcl_Close(interp, (Tcl_Channel) chanPtr); } } } Tcl_DeleteHashTable(hTblPtr); ckfree(hTblPtr); } /* *---------------------------------------------------------------------- * * CheckForStdChannelsBeingClosed -- * * Perform special handling for standard channels being closed. When * given a standard channel, if the refcount is now 1, it means that the * last reference to the standard channel is being explicitly closed. Now * bump the refcount artificially down to 0, to ensure the normal * handling of channels being closed will occur. Also reset the static * pointer to the channel to NULL, to avoid dangling references. * * Results: * None. * * Side effects: * Manipulates the refcount on standard channels. May smash the global * static pointer to a standard channel. * *---------------------------------------------------------------------- */ static void CheckForStdChannelsBeingClosed( Tcl_Channel chan) { ChannelState *statePtr = ((Channel *) chan)->state; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->stdinInitialized == 1 && tsdPtr->stdinChannel != NULL && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) { if (statePtr->refCount < 2) { statePtr->refCount = 0; tsdPtr->stdinChannel = NULL; return; } } else if (tsdPtr->stdoutInitialized == 1 && tsdPtr->stdoutChannel != NULL && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) { if (statePtr->refCount < 2) { statePtr->refCount = 0; tsdPtr->stdoutChannel = NULL; return; } } else if (tsdPtr->stderrInitialized == 1 && tsdPtr->stderrChannel != NULL && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) { if (statePtr->refCount < 2) { statePtr->refCount = 0; tsdPtr->stderrChannel = NULL; return; } } } /* *---------------------------------------------------------------------- * * Tcl_IsStandardChannel -- * * Test if the given channel is a standard channel. No attempt is made to * check if the channel or the standard channels are initialized or * otherwise valid. * * Results: * Returns 1 if true, 0 if false. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_IsStandardChannel( Tcl_Channel chan) /* Channel to check. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if ((chan == tsdPtr->stdinChannel) || (chan == tsdPtr->stdoutChannel) || (chan == tsdPtr->stderrChannel)) { return 1; } else { return 0; } } /* *---------------------------------------------------------------------- * * Tcl_RegisterChannel -- * * Adds an already-open channel to the channel table of an interpreter. * If the interpreter passed as argument is NULL, it only increments the * channel refCount. * * Results: * None. * * Side effects: * May increment the reference count of a channel. * *---------------------------------------------------------------------- */ void Tcl_RegisterChannel( Tcl_Interp *interp, /* Interpreter in which to add the channel. */ Tcl_Channel chan) /* The channel to add to this interpreter * channel table. */ { Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashEntry *hPtr; /* Search variable. */ int isNew; /* Is the hash entry new or does it exist? */ Channel *chanPtr; /* The actual channel. */ ChannelState *statePtr; /* State of the actual channel. */ /* * Always (un)register bottom-most channel in the stack. This makes * management of the channel list easier because no manipulation is * necessary during (un)stack operation. */ chanPtr = ((Channel *) chan)->state->bottomChanPtr; statePtr = chanPtr->state; if (statePtr->channelName == NULL) { Tcl_Panic("Tcl_RegisterChannel: channel without name"); } if (interp != NULL) { hTblPtr = GetChannelTable(interp); hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &isNew); if (!isNew) { if (chan == Tcl_GetHashValue(hPtr)) { return; } Tcl_Panic("Tcl_RegisterChannel: duplicate channel names"); } Tcl_SetHashValue(hPtr, chanPtr); } statePtr->refCount++; } /* *---------------------------------------------------------------------- * * Tcl_UnregisterChannel -- * * Deletes the hash entry for a channel associated with an interpreter. * If the interpreter given as argument is NULL, it only decrements the * reference count. (This all happens in the Tcl_DetachChannel helper * function). * * Finally, if the reference count of the channel drops to zero, it is * deleted. * * Results: * A standard Tcl result. * * Side effects: * Calls Tcl_DetachChannel which deletes the hash entry for a channel * associated with an interpreter. * * May delete the channel, which can have a variety of consequences, * especially if we are forced to close the channel. * *---------------------------------------------------------------------- */ int Tcl_UnregisterChannel( Tcl_Interp *interp, /* Interpreter in which channel is defined. */ Tcl_Channel chan) /* Channel to delete. */ { ChannelState *statePtr; /* State of the real channel. */ statePtr = ((Channel *) chan)->state->bottomChanPtr->state; if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" " of channel", -1)); } return TCL_ERROR; } if (DetachChannel(interp, chan) != TCL_OK) { return TCL_OK; } statePtr = ((Channel *) chan)->state->bottomChanPtr->state; /* * Perform special handling for standard channels being closed. If the * refCount is now 1 it means that the last reference to the standard * channel is being explicitly closed, so bump the refCount down * artificially to 0. This will ensure that the channel is actually * closed, below. Also set the static pointer to NULL for the channel. */ CheckForStdChannelsBeingClosed(chan); /* * If the refCount reached zero, close the actual channel. */ if (statePtr->refCount <= 0) { Tcl_Preserve(statePtr); if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* * We don't want to re-enter Tcl_Close(). */ if (!GotFlag(statePtr, CHANNEL_CLOSED)) { if (Tcl_Close(interp, chan) != TCL_OK) { SetFlag(statePtr, CHANNEL_CLOSED); Tcl_Release(statePtr); return TCL_ERROR; } } } SetFlag(statePtr, CHANNEL_CLOSED); Tcl_Release(statePtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_DetachChannel -- * * Deletes the hash entry for a channel associated with an interpreter. * If the interpreter given as argument is NULL, it only decrements the * reference count. Even if the ref count drops to zero, the channel is * NOT closed or cleaned up. This allows a channel to be detached from an * interpreter and left in the same state it was in when it was * originally returned by 'Tcl_OpenFileChannel', for example. * * This function cannot be used on the standard channels, and will return * TCL_ERROR if that is attempted. * * This function should only be necessary for special purposes in which * you need to generate a pristine channel from one that has already been * used. All ordinary purposes will almost always want to use * Tcl_UnregisterChannel instead. * * Provided the channel is not attached to any other interpreter, it can * then be closed with Tcl_Close, rather than with Tcl_UnregisterChannel. * * Results: * A standard Tcl result. If the channel is not currently registered with * the given interpreter, TCL_ERROR is returned, otherwise TCL_OK. * However no error messages are left in the interp's result. * * Side effects: * Deletes the hash entry for a channel associated with an interpreter. * *---------------------------------------------------------------------- */ int Tcl_DetachChannel( Tcl_Interp *interp, /* Interpreter in which channel is defined. */ Tcl_Channel chan) /* Channel to delete. */ { if (Tcl_IsStandardChannel(chan)) { return TCL_ERROR; } return DetachChannel(interp, chan); } /* *---------------------------------------------------------------------- * * DetachChannel -- * * Deletes the hash entry for a channel associated with an interpreter. * If the interpreter given as argument is NULL, it only decrements the * reference count. Even if the ref count drops to zero, the channel is * NOT closed or cleaned up. This allows a channel to be detached from an * interpreter and left in the same state it was in when it was * originally returned by 'Tcl_OpenFileChannel', for example. * * Results: * A standard Tcl result. If the channel is not currently registered with * the given interpreter, TCL_ERROR is returned, otherwise TCL_OK. * However no error messages are left in the interp's result. * * Side effects: * Deletes the hash entry for a channel associated with an interpreter. * *---------------------------------------------------------------------- */ static int DetachChannel( Tcl_Interp *interp, /* Interpreter in which channel is defined. */ Tcl_Channel chan) /* Channel to delete. */ { Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashEntry *hPtr; /* Search variable. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of the real channel. */ /* * Always (un)register bottom-most channel in the stack. This makes * management of the channel list easier because no manipulation is * necessary during (un)stack operation. */ chanPtr = ((Channel *) chan)->state->bottomChanPtr; statePtr = chanPtr->state; if (interp != NULL) { hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { return TCL_ERROR; } hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName); if (hPtr == NULL) { return TCL_ERROR; } if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) { return TCL_ERROR; } Tcl_DeleteHashEntry(hPtr); statePtr->epoch++; /* * Remove channel handlers that refer to this interpreter, so that * they will not be present if the actual close is delayed and more * events happen on the channel. This may occur if the channel is * shared between several interpreters, or if the channel has async * flushing active. */ CleanupChannelHandlers(interp, chanPtr); } statePtr->refCount--; return TCL_OK; } /* *--------------------------------------------------------------------------- * * Tcl_GetChannel -- * * Finds an existing Tcl_Channel structure by name in a given * interpreter. This function is public because it is used by * channel-type-specific functions. * * Results: * A Tcl_Channel or NULL on failure. If failed, interp's result object * contains an error message. *modePtr is filled with the modes in which * the channel was opened. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Channel Tcl_GetChannel( Tcl_Interp *interp, /* Interpreter in which to find or create the * channel. */ const char *chanName, /* The name of the channel. */ int *modePtr) /* Where to store the mode in which the * channel was opened? Will contain an OR'ed * combination of TCL_READABLE and * TCL_WRITABLE, if non-NULL. */ { Channel *chanPtr; /* The actual channel. */ Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashEntry *hPtr; /* Search variable. */ const char *name; /* Translated name. */ /* * Substitute "stdin", etc. Note that even though we immediately find the * channel using Tcl_GetStdChannel, we still need to look it up in the * specified interpreter to ensure that it is present in the channel * table. Otherwise, safe interpreters would always have access to the * standard channels. */ name = chanName; if ((chanName[0] == 's') && (chanName[1] == 't')) { chanPtr = NULL; if (strcmp(chanName, "stdin") == 0) { chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN); } else if (strcmp(chanName, "stdout") == 0) { chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT); } else if (strcmp(chanName, "stderr") == 0) { chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR); } if (chanPtr != NULL) { name = chanPtr->state->channelName; } } hTblPtr = GetChannelTable(interp); hPtr = Tcl_FindHashEntry(hTblPtr, name); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can not find channel named \"%s\"", chanName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, (void *)NULL); return NULL; } /* * Always return bottom-most channel in the stack. This one lives the * longest - other channels may go away unnoticed. The other APIs * compensate where necessary to retrieve the topmost channel again. */ chanPtr = (Channel *)Tcl_GetHashValue(hPtr); chanPtr = chanPtr->state->bottomChanPtr; if (modePtr != NULL) { *modePtr = GotFlag(chanPtr->state, TCL_READABLE|TCL_WRITABLE); } return (Tcl_Channel) chanPtr; } /* *--------------------------------------------------------------------------- * * TclGetChannelFromObj -- * * Finds an existing Tcl_Channel structure by name in a given * interpreter. This function is public because it is used by * channel-type-specific functions. * * Results: * A Tcl_Channel or NULL on failure. If failed, interp's result object * contains an error message. *modePtr is filled with the modes in which * the channel was opened. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TclGetChannelFromObj( Tcl_Interp *interp, /* Interpreter in which to find or create the * channel. */ Tcl_Obj *objPtr, Tcl_Channel *channelPtr, int *modePtr, /* Where to store the mode in which the * channel was opened? Will contain an OR'ed * combination of TCL_READABLE and * TCL_WRITABLE, if non-NULL. */ int flags) { ChannelState *statePtr; ResolvedChanName *resPtr = NULL; Tcl_Channel chan; (void)flags; if (interp == NULL) { return TCL_ERROR; } if (objPtr->typePtr == &chanObjType) { /* * Confirm validity of saved lookup results. */ resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1; statePtr = resPtr->statePtr; if ((resPtr->interp == interp) /* Same interp context */ /* No epoch change in channel since lookup */ && (resPtr->epoch == statePtr->epoch)) { /* * Have a valid saved lookup. Jump to end to return it. */ goto valid; } } chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL); if (chan == NULL) { if (resPtr) { FreeChannelInternalRep(objPtr); } return TCL_ERROR; } if (resPtr && resPtr->refCount == 1) { /* Re-use the ResolvedCmdName struct */ Tcl_Release((ClientData) resPtr->statePtr); } else { TclFreeIntRep(objPtr); resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName)); resPtr->refCount = 1; objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr; objPtr->typePtr = &chanObjType; } statePtr = ((Channel *)chan)->state; resPtr->statePtr = statePtr; Tcl_Preserve((ClientData) statePtr); resPtr->interp = interp; resPtr->epoch = statePtr->epoch; valid: *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr; if (modePtr != NULL) { *modePtr = GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_CreateChannel -- * * Creates a new entry in the hash table for a Tcl_Channel record. * * Results: * Returns the new Tcl_Channel. * * Side effects: * Creates a new Tcl_Channel instance and inserts it into the hash table. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_CreateChannel( const Tcl_ChannelType *typePtr, /* The channel type record. */ const char *chanName, /* Name of channel to record. */ ClientData instanceData, /* Instance specific data. */ int mask) /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ { Channel *chanPtr; /* The channel structure newly created. */ ChannelState *statePtr; /* The stack-level independent state info for * the channel. */ const char *name; char *tmp; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * With the change of the Tcl_ChannelType structure to use a version in * 8.3.2+, we have to make sure that our assumption that the structure * remains a binary compatible size is true. * * If this assertion fails on some system, then it can be removed only if * the user recompiles code with older channel drivers in the new system * as well. */ assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *)); assert(typePtr->typeName != NULL); if (((NULL == typePtr->closeProc) || (TCL_CLOSE2PROC == typePtr->closeProc)) && (typePtr->close2Proc == NULL)) { Tcl_Panic("channel type %s must define closeProc or close2Proc", typePtr->typeName); } if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) { Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName); } if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) { Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName); } if (NULL == typePtr->watchProc) { Tcl_Panic("channel type %s must define watchProc", typePtr->typeName); } if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName); } /* * JH: We could subsequently memset these to 0 to avoid the numerous * assignments to 0/NULL below. */ chanPtr = (Channel *)ckalloc(sizeof(Channel)); statePtr = (ChannelState *)ckalloc(sizeof(ChannelState)); chanPtr->state = statePtr; chanPtr->instanceData = instanceData; chanPtr->typePtr = typePtr; /* * Set all the bits that are part of the stack-independent state * information for the channel. */ if (chanName != NULL) { unsigned len = strlen(chanName) + 1; /* * Make sure we allocate at least 7 bytes, so it fits for "stdout" * later. */ tmp = (char *)ckalloc((len < 7) ? 7 : len); strcpy(tmp, chanName); } else { tmp = (char *)ckalloc(7); tmp[0] = '\0'; } statePtr->channelName = tmp; statePtr->flags = mask; /* * Set the channel to system default encoding. * * Note the strange bit of protection taking place here. If the system * encoding name is reported back as "binary", something weird is * happening. Tcl provides no "binary" encoding, so someone else has * provided one. We ignore it so as not to interfere with the "magic" * interpretation that Tcl_Channels give to the "-encoding binary" option. */ statePtr->encoding = NULL; name = Tcl_GetEncodingName(NULL); if (strcmp(name, "binary") != 0) { statePtr->encoding = Tcl_GetEncoding(NULL, name); } statePtr->inputEncodingState = NULL; statePtr->inputEncodingFlags = TCL_ENCODING_START; statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; /* * Set the channel up initially in AUTO input translation mode to accept * "\n", "\r" and "\r\n". Output translation mode is set to a platform * specific default value. The eofChar is set to 0 for both input and * output, so that Tcl does not look for an in-file EOF indicator (e.g., * ^Z) and does not append an EOF indicator to files. */ statePtr->inputTranslation = TCL_TRANSLATE_AUTO; statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; statePtr->inEofChar = 0; statePtr->outEofChar = 0; statePtr->unreportedError = 0; statePtr->refCount = 0; statePtr->closeCbPtr = NULL; statePtr->curOutPtr = NULL; statePtr->outQueueHead = NULL; statePtr->outQueueTail = NULL; statePtr->saveInBufPtr = NULL; statePtr->inQueueHead = NULL; statePtr->inQueueTail = NULL; statePtr->chPtr = NULL; statePtr->interestMask = 0; statePtr->scriptRecordPtr = NULL; statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; statePtr->timer = NULL; statePtr->timerChanPtr = NULL; statePtr->csPtrR = NULL; statePtr->csPtrW = NULL; statePtr->outputStage = NULL; /* * As we are creating the channel, it is obviously the top for now. */ statePtr->topChanPtr = chanPtr; statePtr->bottomChanPtr = chanPtr; chanPtr->downChanPtr = NULL; chanPtr->upChanPtr = NULL; chanPtr->inQueueHead = NULL; chanPtr->inQueueTail = NULL; chanPtr->refCount = 0; /* * TIP #219, Tcl Channel Reflection API */ statePtr->chanMsg = NULL; statePtr->unreportedMsg = NULL; statePtr->epoch = 0; /* * Link the channel into the list of all channels; create an on-exit * handler if there is not one already, to close off all the channels in * the list on exit. * * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check. * * TIP #218. * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel * We need Tcl_SpliceChannel, for the threadAction calls. There is no * real reason to duplicate all of this. * NOTE: All drivers using thread actions now have to perform their TSD * manipulation only in their thread action proc. Doing it when * creating their instance structures will collide with the thread * action activity and lead to damaged lists. */ statePtr->nextCSPtr = NULL; SpliceChannel((Tcl_Channel) chanPtr); /* * Install this channel in the first empty standard channel slot, if the * channel was previously closed explicitly. */ if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) { strcpy(tmp, "stdin"); Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN); Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr); } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) { strcpy(tmp, "stdout"); Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT); Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr); } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) { strcpy(tmp, "stderr"); Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR); Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr); } return (Tcl_Channel) chanPtr; } /* *---------------------------------------------------------------------- * * Tcl_StackChannel -- * * Replaces an entry in the hash table for a Tcl_Channel record. The * replacement is a new channel with same name, it supercedes the * replaced channel. Input and output of the superceded channel is now * going through the newly created channel and allows the arbitrary * filtering/manipulation of the dataflow. * * Andreas Kupries , 12/13/1998 "Trf-Patch for * filtering channels" * * Results: * Returns the new Tcl_Channel, which actually contains the saved * information about prevChan. * * Side effects: * A new channel structure is allocated and linked below the existing * channel. The channel operations and client data of the existing * channel are copied down to the newly created channel, and the current * channel has its operations replaced by the new typePtr. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_StackChannel( Tcl_Interp *interp, /* The interpreter we are working in */ const Tcl_ChannelType *typePtr, /* The channel type record for the new * channel. */ ClientData instanceData, /* Instance specific data for the new * channel. */ int mask, /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ Tcl_Channel prevChan) /* The channel structure to replace */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr, *prevChanPtr; ChannelState *statePtr; /* * Find the given channel (prevChan) in the list of all channels. If we do * not find it, then it was never registered correctly. * * This operation should occur at the top of a channel stack. */ statePtr = (ChannelState *) tsdPtr->firstCSPtr; prevChanPtr = ((Channel *) prevChan)->state->topChanPtr; while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) { statePtr = statePtr->nextCSPtr; } if (statePtr == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't find state for channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; } /* * Here we check if the given "mask" matches the "flags" of the already * existing channel. * * | - | R | W | RW | * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask) * - | | | | | * R | | + | | + | The superceding channel is allowed to restrict * W | | | + | + | the capabilities of the superceded one! * RW| | + | + | + | * --+---+---+---+----+ */ if ((mask & GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE)) == 0) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "reading and writing both disallowed for channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; } /* * Flush the buffers. This ensures that any data still in them at this * time is not handled by the new transformation. Restrict this to * writable channels. Take care to hide a possible bg-copy in progress * from Tcl_Flush and the CheckForChannelErrors inside. */ if ((mask & TCL_WRITABLE) != 0) { CopyState *csPtrR = statePtr->csPtrR; CopyState *csPtrW = statePtr->csPtrW; statePtr->csPtrR = NULL; statePtr->csPtrW = NULL; /* * TODO: Examine what can go wrong if Tcl_Flush() call disturbs * the stacking state of this channel during its operations. */ if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not flush channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; } statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; } /* * Discard any input in the buffers. They are not yet read by the user of * the channel, so they have to go through the new transformation before * reading. As the buffers contain the untransformed form their contents * are not only useless but actually distorts our view of the system. * * To preserve the information without having to read them again and to * avoid problems with the location in the channel (seeking might be * impossible) we move the buffers from the common state structure into * the channel itself. We use the buffers in the channel below the new * transformation to hold the data. In the future this allows us to write * transformations which preread data and push the unused part back when * they are going away. */ if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) { /* * When statePtr->inQueueHead is not NULL, we know * prevChanPtr->inQueueHead must be NULL. */ assert(prevChanPtr->inQueueHead == NULL); assert(prevChanPtr->inQueueTail == NULL); prevChanPtr->inQueueHead = statePtr->inQueueHead; prevChanPtr->inQueueTail = statePtr->inQueueTail; statePtr->inQueueHead = NULL; statePtr->inQueueTail = NULL; } chanPtr = (Channel *)ckalloc(sizeof(Channel)); /* * Save some of the current state into the new structure, reinitialize the * parts which will stay with the transformation. * * Remarks: */ chanPtr->state = statePtr; chanPtr->instanceData = instanceData; chanPtr->typePtr = typePtr; chanPtr->downChanPtr = prevChanPtr; chanPtr->upChanPtr = NULL; chanPtr->inQueueHead = NULL; chanPtr->inQueueTail = NULL; chanPtr->refCount = 0; /* * Place new block at the head of a possibly existing list of previously * stacked channels. */ prevChanPtr->upChanPtr = chanPtr; statePtr->topChanPtr = chanPtr; /* * TIP #218, Channel Thread Actions. * * We call the thread actions for the new channel directly. We _cannot_ * use SpliceChannel, because the (thread-)global list of all channels * always contains the _ChannelState_ for a stack of channels, not the * individual channels. And SpliceChannel would not only call the thread * actions, but also add the shared ChannelState to this list a second * time, mangling it. */ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT); return (Tcl_Channel) chanPtr; } void TclChannelPreserve( Tcl_Channel chan) { ((Channel *)chan)->refCount++; } void TclChannelRelease( Tcl_Channel chan) { Channel *chanPtr = (Channel *) chan; if (chanPtr->refCount == 0) { Tcl_Panic("Channel released more than preserved"); } if (--chanPtr->refCount) { return; } if (chanPtr->typePtr == NULL) { ckfree(chanPtr); } } static void ChannelFree( Channel *chanPtr) { if (chanPtr->refCount == 0) { ckfree(chanPtr); return; } chanPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * Tcl_UnstackChannel -- * * Unstacks an entry in the hash table for a Tcl_Channel record. This is * the reverse to 'Tcl_StackChannel'. * * Results: * A standard Tcl result. * * Side effects: * If TCL_ERROR is returned, the Posix error code will be set with * Tcl_SetErrno. May leave a message in interp result as well. * *---------------------------------------------------------------------- */ int Tcl_UnstackChannel( Tcl_Interp *interp, /* The interpreter we are working in */ Tcl_Channel chan) /* The channel to unstack */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; int result = 0; /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; if (chanPtr->downChanPtr != NULL) { /* * Instead of manipulating the per-thread / per-interp list/hash table * of registered channels we wind down the state of the * transformation, and then restore the state of underlying channel * into the old structure. * * TODO: Figure out how to handle the situation where the chan * operations called below by this unstacking operation cause * another unstacking recursively. In that case the downChanPtr * value we're holding on to will not be the right thing. */ Channel *downChanPtr = chanPtr->downChanPtr; /* * Flush the buffers. This ensures that any data still in them at this * time _is_ handled by the transformation we are unstacking right * now. Restrict this to writable channels. Take care to hide a * possible bg-copy in progress from Tcl_Flush and the * CheckForChannelErrors inside. */ if (GotFlag(statePtr, TCL_WRITABLE)) { CopyState *csPtrR = statePtr->csPtrR; CopyState *csPtrW = statePtr->csPtrW; statePtr->csPtrR = NULL; statePtr->csPtrW = NULL; if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) { statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; /* * TIP #219, Tcl Channel Reflection API. * Move error messages put by the driver into the chan/ip * bypass area into the regular interpreter result. Fall back * to the regular message if nothing was found in the * bypasses. */ if (!TclChanCaughtErrorBypass(interp, chan) && interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not flush channel \"%s\"", Tcl_GetChannelName((Tcl_Channel) chanPtr))); } return TCL_ERROR; } statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; } /* * Anything in the input queue and the push-back buffers of the * transformation going away is transformed data, but not yet read. As * unstacking means that the caller does not want to see transformed * data any more we have to discard these bytes. To avoid writing an * analogue to 'DiscardInputQueued' we move the information in the * push back buffers to the input queue and then call * 'DiscardInputQueued' on that. */ if (GotFlag(statePtr, TCL_READABLE) && ((statePtr->inQueueHead != NULL) || (chanPtr->inQueueHead != NULL))) { if ((statePtr->inQueueHead != NULL) && (chanPtr->inQueueHead != NULL)) { statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead; statePtr->inQueueTail = chanPtr->inQueueTail; statePtr->inQueueHead = statePtr->inQueueTail; } else if (chanPtr->inQueueHead != NULL) { statePtr->inQueueHead = chanPtr->inQueueHead; statePtr->inQueueTail = chanPtr->inQueueTail; } chanPtr->inQueueHead = NULL; chanPtr->inQueueTail = NULL; DiscardInputQueued(statePtr, 0); } /* * TIP #218, Channel Thread Actions. * * We call the thread actions for the new channel directly. We * _cannot_ use CutChannel, because the (thread-)global list of all * channels always contains the _ChannelState_ for a stack of * channels, not the individual channels. And SpliceChannel would not * only call the thread actions, but also remove the shared * ChannelState from this list despite there being more channels for * the state which are still active. */ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE); statePtr->topChanPtr = downChanPtr; downChanPtr->upChanPtr = NULL; /* * Leave this link intact for closeproc * chanPtr->downChanPtr = NULL; */ /* * Close and free the channel driver state. */ result = ChanClose(chanPtr, interp); ChannelFree(chanPtr); UpdateInterest(statePtr->topChanPtr); if (result != 0) { Tcl_SetErrno(result); /* * TIP #219, Tcl Channel Reflection API. * Move error messages put by the driver into the chan/ip bypass * area into the regular interpreter result. */ TclChanCaughtErrorBypass(interp, chan); return TCL_ERROR; } } else { /* * This channel does not cover another one. Simply do a close, if * necessary. */ if (statePtr->refCount <= 0) { if (Tcl_Close(interp, chan) != TCL_OK) { /* * TIP #219, Tcl Channel Reflection API. * "TclChanCaughtErrorBypass" is not required here, it was * done already by "Tcl_Close". */ return TCL_ERROR; } } /* * TIP #218, Channel Thread Actions. * Not required in this branch, this is done by Tcl_Close. If * Tcl_Close is not called then the ChannelState is still active in * the thread and no action has to be taken either. */ } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetStackedChannel -- * * Determines whether the specified channel is stacked upon another. * * Results: * NULL if the channel is not stacked upon another one, or a reference to * the channel it is stacked upon. This reference can be used in queries, * but modification is not allowed. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_GetStackedChannel( Tcl_Channel chan) { Channel *chanPtr = (Channel *) chan; /* The actual channel. */ return (Tcl_Channel) chanPtr->downChanPtr; } /* *---------------------------------------------------------------------- * * Tcl_GetTopChannel -- * * Returns the top channel of a channel stack. * * Results: * NULL if the channel is not stacked upon another one, or a reference to * the channel it is stacked upon. This reference can be used in queries, * but modification is not allowed. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_GetTopChannel( Tcl_Channel chan) { Channel *chanPtr = (Channel *) chan; /* The actual channel. */ return (Tcl_Channel) chanPtr->state->topChanPtr; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelInstanceData -- * * Returns the client data associated with a channel. * * Results: * The client data. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_GetChannelInstanceData( Tcl_Channel chan) /* Channel for which to return client data. */ { Channel *chanPtr = (Channel *) chan; /* The actual channel. */ return chanPtr->instanceData; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelThread -- * * Given a channel structure, returns the thread managing it. TIP #10 * * Results: * Returns the id of the thread managing the channel. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_ThreadId Tcl_GetChannelThread( Tcl_Channel chan) /* The channel to return the managing thread * for. */ { Channel *chanPtr = (Channel *) chan; /* The actual channel. */ return chanPtr->state->managingThread; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelType -- * * Given a channel structure, returns the channel type structure. * * Results: * Returns a pointer to the channel type structure. * * Side effects: * None. * *---------------------------------------------------------------------- */ const Tcl_ChannelType * Tcl_GetChannelType( Tcl_Channel chan) /* The channel to return type for. */ { Channel *chanPtr = (Channel *) chan; /* The actual channel. */ return chanPtr->typePtr; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelMode -- * * Computes a mask indicating whether the channel is open for reading and * writing. * * Results: * An OR-ed combination of TCL_READABLE and TCL_WRITABLE. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetChannelMode( Tcl_Channel chan) /* The channel for which the mode is being * computed. */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of actual channel. */ return GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE); } /* *---------------------------------------------------------------------- * * Tcl_GetChannelName -- * * Returns the string identifying the channel name. * * Results: * The string containing the channel name. This memory is owned by the * generic layer and should not be modified by the caller. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_GetChannelName( Tcl_Channel chan) /* The channel for which to return the name. */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of actual channel. */ return statePtr->channelName; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelHandle -- * * Returns an OS handle associated with a channel. * * Results: * Returns TCL_OK and places the handle in handlePtr, or returns * TCL_ERROR on failure. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetChannelHandle( Tcl_Channel chan, /* The channel to get file from. */ int direction, /* TCL_WRITABLE or TCL_READABLE. */ ClientData *handlePtr) /* Where to store handle */ { Channel *chanPtr; /* The actual channel. */ ClientData handle; int result; chanPtr = ((Channel *) chan)->state->bottomChanPtr; if (!chanPtr->typePtr->getHandleProc) { Tcl_SetChannelError(chan, Tcl_ObjPrintf( "channel \"%s\" does not support OS handles", Tcl_GetChannelName(chan))); return TCL_ERROR; } result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction, &handle); if (handlePtr) { *handlePtr = handle; } return result; } /* *--------------------------------------------------------------------------- * * AllocChannelBuffer -- * * A channel buffer has BUFFER_PADDING bytes extra at beginning to hold * any bytes of a native-encoding character that got split by the end of * the previous buffer and need to be moved to the beginning of the next * buffer to make a contiguous string so it can be converted to UTF-8. * * A channel buffer has BUFFER_PADDING bytes extra at the end to hold any * bytes of a native-encoding character (generated from a UTF-8 * character) that overflow past the end of the buffer and need to be * moved to the next buffer. * * Results: * A newly allocated channel buffer. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static ChannelBuffer * AllocChannelBuffer( int length) /* Desired length of channel buffer. */ { ChannelBuffer *bufPtr; int n; n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING; bufPtr = (ChannelBuffer *)ckalloc(n); bufPtr->nextAdded = BUFFER_PADDING; bufPtr->nextRemoved = BUFFER_PADDING; bufPtr->bufLength = length + BUFFER_PADDING; bufPtr->nextPtr = NULL; bufPtr->refCount = 1; return bufPtr; } static void PreserveChannelBuffer( ChannelBuffer *bufPtr) { if (bufPtr->refCount == 0) { Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr); } bufPtr->refCount++; } static void ReleaseChannelBuffer( ChannelBuffer *bufPtr) { if (--bufPtr->refCount) { return; } ckfree(bufPtr); } static int IsShared( ChannelBuffer *bufPtr) { return bufPtr->refCount > 1; } /* *---------------------------------------------------------------------- * * RecycleBuffer -- * * Helper function to recycle input and output buffers. Ensures that two * input buffers are saved (one in the input queue and another in the * saveInBufPtr field) and that curOutPtr is set to a buffer. Only if * these conditions are met is the buffer freed to the OS. * * Results: * None. * * Side effects: * May free a buffer to the OS. * *---------------------------------------------------------------------- */ static void RecycleBuffer( ChannelState *statePtr, /* ChannelState in which to recycle buffers. */ ChannelBuffer *bufPtr, /* The buffer to recycle. */ int mustDiscard) /* If nonzero, free the buffer to the OS, * always. */ { /* * Do we have to free the buffer to the OS? */ if (IsShared(bufPtr)) { mustDiscard = 1; } if (mustDiscard) { ReleaseChannelBuffer(bufPtr); return; } /* * Only save buffers which have the requested buffer size for the channel. * This is to honor dynamic changes of the buffe rsize made by the user. */ if ((bufPtr->bufLength) != statePtr->bufSize + BUFFER_PADDING) { ReleaseChannelBuffer(bufPtr); return; } /* * Only save buffers for the input queue if the channel is readable. */ if (GotFlag(statePtr, TCL_READABLE)) { if (statePtr->inQueueHead == NULL) { statePtr->inQueueHead = bufPtr; statePtr->inQueueTail = bufPtr; goto keepBuffer; } if (statePtr->saveInBufPtr == NULL) { statePtr->saveInBufPtr = bufPtr; goto keepBuffer; } } /* * Only save buffers for the output queue if the channel is writable. */ if (GotFlag(statePtr, TCL_WRITABLE)) { if (statePtr->curOutPtr == NULL) { statePtr->curOutPtr = bufPtr; goto keepBuffer; } } /* * If we reached this code we return the buffer to the OS. */ ReleaseChannelBuffer(bufPtr); return; keepBuffer: bufPtr->nextRemoved = BUFFER_PADDING; bufPtr->nextAdded = BUFFER_PADDING; bufPtr->nextPtr = NULL; } /* *---------------------------------------------------------------------- * * DiscardOutputQueued -- * * Discards all output queued in the output queue of a channel. * * Results: * None. * * Side effects: * Recycles buffers. * *---------------------------------------------------------------------- */ static void DiscardOutputQueued( ChannelState *statePtr) /* ChannelState for which to discard output. */ { ChannelBuffer *bufPtr; while (statePtr->outQueueHead != NULL) { bufPtr = statePtr->outQueueHead; statePtr->outQueueHead = bufPtr->nextPtr; RecycleBuffer(statePtr, bufPtr, 0); } statePtr->outQueueHead = NULL; statePtr->outQueueTail = NULL; bufPtr = statePtr->curOutPtr; if (bufPtr && BytesLeft(bufPtr)) { statePtr->curOutPtr = NULL; RecycleBuffer(statePtr, bufPtr, 0); } } /* *---------------------------------------------------------------------- * * CheckForDeadChannel -- * * This function checks is a given channel is Dead (a channel that has * been closed but not yet deallocated.) * * Results: * True (1) if channel is Dead, False (0) if channel is Ok * * Side effects: * None * *---------------------------------------------------------------------- */ static int CheckForDeadChannel( Tcl_Interp *interp, /* For error reporting (can be NULL) */ ChannelState *statePtr) /* The channel state to check. */ { if (!GotFlag(statePtr, CHANNEL_DEAD)) { return 0; } Tcl_SetErrno(EINVAL); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unable to access channel: invalid channel", -1)); } return 1; } /* *---------------------------------------------------------------------- * * FlushChannel -- * * This function flushes as much of the queued output as is possible now. * If calledFromAsyncFlush is nonzero, it is being called in an event * handler to flush channel output asynchronously. * * Results: * 0 if successful, else the error code that was returned by the channel * type operation. May leave a message in the interp result. * * Side effects: * May produce output on a channel. May block indefinitely if the channel * is synchronous. May schedule an async flush on the channel. May * recycle memory for buffers in the output queue. * *---------------------------------------------------------------------- */ static int FlushChannel( Tcl_Interp *interp, /* For error reporting during close. */ Channel *chanPtr, /* The channel to flush on. */ int calledFromAsyncFlush) /* If nonzero then we are being called from an * asynchronous flush callback. */ { ChannelState *statePtr = chanPtr->state; /* State of the channel stack. */ ChannelBuffer *bufPtr; /* Iterates over buffered output queue. */ int written; /* Amount of output data actually written in * current round. */ int errorCode = 0; /* Stores POSIX error codes from channel * driver operations. */ int wroteSome = 0; /* Set to one if any data was written to the * driver. */ /* * Prevent writing on a dead channel -- a channel that has been closed but * not yet deallocated. This can occur if the exit handler for the channel * deallocation runs before all channels are unregistered in all * interpreters. */ if (CheckForDeadChannel(interp, statePtr)) { return -1; } /* * Should we shift the current output buffer over to the output queue? * First check that there are bytes in it. If so then... * * If the output queue is empty, then yes, trusting the caller called us * only when written bytes ought to be flushed. * * If the current output buffer is full, then yes, so we can meet the * post-condition that on a successful return to caller we've left space * in the current output buffer for more writing (the flush call was to * make new room). * * If the channel is blocking, then yes, so we guarantee that blocking * flushes actually flush all pending data. * * Otherwise, no. Keep the current output buffer where it is so more * can be written to it, possibly filling it, to promote more efficient * buffer usage. */ bufPtr = statePtr->curOutPtr; if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */ (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr) || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { if (statePtr->outQueueHead == NULL) { statePtr->outQueueHead = bufPtr; } else { statePtr->outQueueTail->nextPtr = bufPtr; } statePtr->outQueueTail = bufPtr; statePtr->curOutPtr = NULL; } assert(!IsBufferFull(statePtr->curOutPtr)); /* * If we are not being called from an async flush and an async flush * is active, we just return without producing any output. */ if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { return 0; } /* * Loop over the queued buffers and attempt to flush as much as possible * of the queued output to the channel. */ TclChannelPreserve((Tcl_Channel)chanPtr); while (statePtr->outQueueHead) { bufPtr = statePtr->outQueueHead; /* * Produce the output on the channel. */ PreserveChannelBuffer(bufPtr); written = ChanWrite(chanPtr, RemovePoint(bufPtr), BytesLeft(bufPtr), &errorCode); /* * If the write failed completely attempt to start the asynchronous * flush mechanism and break out of this loop - do not attempt to * write any more output at this time. */ if (written < 0) { /* * If the last attempt to write was interrupted, simply retry. */ if (errorCode == EINTR) { errorCode = 0; ReleaseChannelBuffer(bufPtr); continue; } /* * If the channel is non-blocking and we would have blocked, start * a background flushing handler and break out of the loop. */ if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) { /* * This used to check for CHANNEL_NONBLOCKING, and panic if * the channel was blocking. However, it appears that setting * stdin to -blocking 0 has some effect on the stdout when * it's a tty channel (dup'ed underneath) */ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) { SetFlag(statePtr, BG_FLUSH_SCHEDULED); UpdateInterest(chanPtr); } errorCode = 0; ReleaseChannelBuffer(bufPtr); break; } /* * Decide whether to report the error upwards or defer it. */ if (calledFromAsyncFlush) { /* * TIP #219, Tcl Channel Reflection API. * When deferring the error copy a message from the bypass into * the unreported area. Or discard it if the new error is to * be ignored in favor of an earlier deferred error. */ Tcl_Obj *msg = statePtr->chanMsg; if (statePtr->unreportedError == 0) { statePtr->unreportedError = errorCode; statePtr->unreportedMsg = msg; if (msg != NULL) { Tcl_IncrRefCount(msg); } } else { /* * An old unreported error is kept, and this error thrown * away. */ statePtr->chanMsg = NULL; if (msg != NULL) { TclDecrRefCount(msg); } } } else { /* * TIP #219, Tcl Channel Reflection API. * Move error messages put by the driver into the chan bypass * area into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypasses. */ Tcl_SetErrno(errorCode); if (interp != NULL && !TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } /* * An unreportable bypassed message is kept, for the caller of * Tcl_Seek, Tcl_Write, etc. */ } /* * When we get an error we throw away all the output currently * queued. */ ReleaseChannelBuffer(bufPtr); DiscardOutputQueued(statePtr); break; } else { /* * TODO: Consider detecting and reacting to short writes on * blocking channels. Ought not happen. See iocmd-24.2. */ wroteSome = 1; } bufPtr->nextRemoved += written; /* * If this buffer is now empty, recycle it. */ if (IsBufferEmpty(bufPtr)) { statePtr->outQueueHead = bufPtr->nextPtr; if (statePtr->outQueueHead == NULL) { statePtr->outQueueTail = NULL; } RecycleBuffer(statePtr, bufPtr, 0); } ReleaseChannelBuffer(bufPtr); } /* Closes "while". */ /* * If we wrote some data while flushing in the background, we are done. * We can't finish the background flush until we run out of data and the * channel becomes writable again. This ensures that all of the pending * data has been flushed at the system level. */ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { if (wroteSome) { goto done; } else if (statePtr->outQueueHead == NULL) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); ChanWatch(chanPtr, statePtr->interestMask); } else { /* * When we are calledFromAsyncFlush, that means a writable * state on the channel triggered the call, so we should be * able to write something. Either we did write something * and wroteSome should be set, or there was nothing left to * write in this call, and we've completed the BG flush. * These are the two cases above. If we get here, that means * there is some kind failure in the writable event machinery. * * The tls extension indeed suffers from flaws in its channel * event mgmt. See https://core.tcl-lang.org/tcl/info/c31ca233ca. * Until that patch is broadly distributed, disable the * assertion checking here, so that programs using Tcl and * tls can be debugged. assert(!calledFromAsyncFlush); */ } } /* * If the channel is flagged as closed, delete it when the refCount drops * to zero, the output queue is empty and there is no output in the * current output buffer. */ if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) && (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannel(interp, chanPtr, errorCode); goto done; } /* * If the write-side of the channel is flagged as closed, delete it when * the output queue is empty and there is no output in the current output * buffer. */ if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) && (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE); goto done; } done: TclChannelRelease((Tcl_Channel)chanPtr); return errorCode; } /* *---------------------------------------------------------------------- * * CloseChannel -- * * Utility procedure to close a channel and free associated resources. * * If the channel was stacked, then the it will copy the necessary * elements of the NEXT channel into the TOP channel, in essence * unstacking the channel. The NEXT channel will then be freed. * * If the channel was not stacked, then we will free all the bits for the * TOP channel, including the data structure itself. * * Results: * Error code from an unreported error or the driver close operation. * * Side effects: * May close the actual channel, may free memory, may change the value of * errno. * *---------------------------------------------------------------------- */ static int CloseChannel( Tcl_Interp *interp, /* For error reporting. */ Channel *chanPtr, /* The channel to close. */ int errorCode) /* Status of operation so far. */ { int result = 0; /* Of calling driver close operation. */ ChannelState *statePtr; /* State of the channel stack. */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (chanPtr == NULL) { return result; } statePtr = chanPtr->state; /* * No more input can be consumed so discard any leftover input. */ DiscardInputQueued(statePtr, 1); /* * Discard a leftover buffer in the current output buffer field. */ if (statePtr->curOutPtr != NULL) { ReleaseChannelBuffer(statePtr->curOutPtr); statePtr->curOutPtr = NULL; } /* * The caller guarantees that there are no more buffers queued for output. */ if (statePtr->outQueueHead != NULL) { Tcl_Panic("TclFlush, closed channel: queued output left"); } /* * If the EOF character is set in the channel, append that to the output * device. */ if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) { int dummy; char c = (char) statePtr->outEofChar; (void) ChanWrite(chanPtr, &c, 1, &dummy); } /* * TIP #219, Tcl Channel Reflection API. * Move a leftover error message in the channel bypass into the * interpreter bypass. Just clear it if there is no interpreter. */ if (statePtr->chanMsg != NULL) { if (interp != NULL) { Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg); } TclDecrRefCount(statePtr->chanMsg); statePtr->chanMsg = NULL; } /* * Remove this channel from of the list of all channels. */ CutChannel((Tcl_Channel) chanPtr); /* * Close and free the channel driver state. * This may leave a TIP #219 error message in the interp. */ result = ChanClose(chanPtr, interp); /* * Some resources can be cleared only if the bottom channel in a stack is * closed. All the other channels in the stack are not allowed to remove. */ if (chanPtr == statePtr->bottomChanPtr) { if (statePtr->channelName != NULL) { ckfree(statePtr->channelName); statePtr->channelName = NULL; } Tcl_FreeEncoding(statePtr->encoding); } /* * If we are being called synchronously, report either any latent error on * the channel or the current error. */ if (statePtr->unreportedError != 0) { errorCode = statePtr->unreportedError; /* * TIP #219, Tcl Channel Reflection API. * Move an error message found in the unreported area into the regular * bypass (interp). This kills any message in the channel bypass area. */ if (statePtr->chanMsg != NULL) { TclDecrRefCount(statePtr->chanMsg); statePtr->chanMsg = NULL; } if (interp) { Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg); } } if (errorCode == 0) { errorCode = result; if (errorCode != 0) { Tcl_SetErrno(errorCode); } } /* * Cancel any outstanding timer. */ if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = NULL; TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); statePtr->timerChanPtr = NULL; } /* * Mark the channel as deleted by clearing the type structure. */ if (chanPtr->downChanPtr != NULL) { Channel *downChanPtr = chanPtr->downChanPtr; statePtr->nextCSPtr = tsdPtr->firstCSPtr; tsdPtr->firstCSPtr = statePtr; statePtr->topChanPtr = downChanPtr; downChanPtr->upChanPtr = NULL; ChannelFree(chanPtr); return Tcl_Close(interp, (Tcl_Channel) downChanPtr); } /* * There is only the TOP Channel, so we free the remaining pointers we * have and then ourselves. Since this is the last of the channels in the * stack, make sure to free the ChannelState structure associated with it. */ ChannelFree(chanPtr); Tcl_EventuallyFree(statePtr, TCL_DYNAMIC); return errorCode; } /* *---------------------------------------------------------------------- * * Tcl_CutChannel -- * CutChannel -- * * Removes a channel from the (thread-)global list of all channels (in * that thread). This is actually the statePtr for the stack of channel. * * Results: * Nothing. * * Side effects: * Resets the field 'nextCSPtr' of the specified channel state to NULL. * * NOTE: * The channel to cut out of the list must not be referenced in any * interpreter. This is something this procedure cannot check (despite * the refcount) because the caller usually wants fiddle with the channel * (like transferring it to a different thread) and thus keeps the * refcount artificially high to prevent its destruction. * *---------------------------------------------------------------------- */ static void CutChannel( Tcl_Channel chan) /* The channel being removed. Must not be * referenced in any interpreter. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ChannelState *prevCSPtr; /* Preceding channel state in list of all * states - used to splice a channel out of * the list on close. */ ChannelState *statePtr = ((Channel *) chan)->state; /* State of the channel stack. */ /* * Remove this channel from of the list of all channels (in the current * thread). */ if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) { tsdPtr->firstCSPtr = statePtr->nextCSPtr; } else { for (prevCSPtr = tsdPtr->firstCSPtr; prevCSPtr && (prevCSPtr->nextCSPtr != statePtr); prevCSPtr = prevCSPtr->nextCSPtr) { /* Empty loop body. */ } if (prevCSPtr == NULL) { Tcl_Panic("FlushChannel: damaged channel list"); } prevCSPtr->nextCSPtr = statePtr->nextCSPtr; } statePtr->nextCSPtr = NULL; /* * TIP #218, Channel Thread Actions */ ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_REMOVE); /* Channel is not managed by any thread */ statePtr->managingThread = NULL; } void Tcl_CutChannel( Tcl_Channel chan) /* The channel being added. Must not be * referenced in any interpreter. */ { Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ChannelState *prevCSPtr; /* Preceding channel state in list of all * states - used to splice a channel out of * the list on close. */ ChannelState *statePtr = chanPtr->state; /* State of the channel stack. */ /* * Remove this channel from of the list of all channels (in the current * thread). */ if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) { tsdPtr->firstCSPtr = statePtr->nextCSPtr; } else { for (prevCSPtr = tsdPtr->firstCSPtr; prevCSPtr && (prevCSPtr->nextCSPtr != statePtr); prevCSPtr = prevCSPtr->nextCSPtr) { /* Empty loop body. */ } if (prevCSPtr == NULL) { Tcl_Panic("FlushChannel: damaged channel list"); } prevCSPtr->nextCSPtr = statePtr->nextCSPtr; } statePtr->nextCSPtr = NULL; /* * TIP #218, Channel Thread Actions * For all transformations and the base channel. */ for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) { ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE); } /* Channel is not managed by any thread */ statePtr->managingThread = NULL; } /* *---------------------------------------------------------------------- * * Tcl_SpliceChannel -- * SpliceChannel -- * * Adds a channel to the (thread-)global list of all channels (in that * thread). Expects that the field 'nextChanPtr' in the channel is set to * NULL. * * Results: * Nothing. * * Side effects: * Nothing. * * NOTE: * The channel to splice into the list must not be referenced in any * interpreter. This is something this procedure cannot check (despite * the refcount) because the caller usually wants fiddle with the channel * (like transferring it to a different thread) and thus keeps the * refcount artificially high to prevent its destruction. * *---------------------------------------------------------------------- */ static void SpliceChannel( Tcl_Channel chan) /* The channel being added. Must not be * referenced in any interpreter. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ChannelState *statePtr = ((Channel *) chan)->state; if (statePtr->nextCSPtr != NULL) { Tcl_Panic("SpliceChannel: trying to add channel used in different list"); } statePtr->nextCSPtr = tsdPtr->firstCSPtr; tsdPtr->firstCSPtr = statePtr; /* * TIP #10. Mark the current thread as the new one managing this channel. * Note: 'Tcl_GetCurrentThread' returns sensible values even for * a non-threaded core. */ statePtr->managingThread = Tcl_GetCurrentThread(); /* * TIP #218, Channel Thread Actions */ ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_INSERT); } void Tcl_SpliceChannel( Tcl_Channel chan) /* The channel being added. Must not be * referenced in any interpreter. */ { Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ChannelState *statePtr = chanPtr->state; if (statePtr->nextCSPtr != NULL) { Tcl_Panic("SpliceChannel: trying to add channel used in different list"); } statePtr->nextCSPtr = tsdPtr->firstCSPtr; tsdPtr->firstCSPtr = statePtr; /* * TIP #10. Mark the current thread as the new one managing this channel. * Note: 'Tcl_GetCurrentThread' returns sensible values even for * a non-threaded core. */ statePtr->managingThread = Tcl_GetCurrentThread(); /* * TIP #218, Channel Thread Actions * For all transformations and the base channel. */ for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) { ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT); } } /* *---------------------------------------------------------------------- * * Tcl_Close -- * * Closes a channel. * * Results: * A standard Tcl result. * * Side effects: * Closes the channel if this is the last reference. * * NOTE: * Tcl_Close removes the channel as far as the user is concerned. * However, it may continue to exist for a while longer if it has a * background flush scheduled. The device itself is eventually closed and * the channel record removed, in CloseChannel, above. * *---------------------------------------------------------------------- */ int Tcl_Close( Tcl_Interp *interp, /* Interpreter for errors. */ Tcl_Channel chan) /* The channel being closed. Must not be * referenced in any interpreter. */ { CloseCallback *cbPtr; /* Iterate over close callbacks for this * channel. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of real IO channel. */ int result = 0; /* Of calling FlushChannel. */ int flushcode; int stickyError; if (chan == NULL) { return TCL_OK; } /* * Perform special handling for standard channels being closed. If the * refCount is now 1 it means that the last reference to the standard * channel is being explicitly closed, so bump the refCount down * artificially to 0. This will ensure that the channel is actually * closed, below. Also set the static pointer to NULL for the channel. */ CheckForStdChannelsBeingClosed(chan); /* * This operation should occur at the top of a channel stack. */ chanPtr = (Channel *) chan; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; if (statePtr->refCount > 0) { Tcl_Panic("called Tcl_Close on channel with refCount > 0"); } if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" " of channel", -1)); } return TCL_ERROR; } SetFlag(statePtr, CHANNEL_INCLOSE); /* * When the channel has an escape sequence driven encoding such as * iso2022, the terminated escape sequence must write to the buffer. */ stickyError = 0; if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) { int code = CheckChannelErrors(statePtr, TCL_WRITABLE); if (code == 0) { statePtr->outputEncodingFlags |= TCL_ENCODING_END; code = WriteChars(chanPtr, "", 0); statePtr->outputEncodingFlags &= ~TCL_ENCODING_END; statePtr->outputEncodingFlags |= TCL_ENCODING_START; } if (code < 0) { stickyError = Tcl_GetErrno(); } /* * TIP #219, Tcl Channel Reflection API. * Move an error message found in the channel bypass into the * interpreter bypass. Just clear it if there is no interpreter. */ if (statePtr->chanMsg != NULL) { if (interp != NULL) { Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg); } TclDecrRefCount(statePtr->chanMsg); statePtr->chanMsg = NULL; } } Tcl_ClearChannelHandlers(chan); /* * Invoke the registered close callbacks and delete their records. */ while (statePtr->closeCbPtr != NULL) { cbPtr = statePtr->closeCbPtr; statePtr->closeCbPtr = cbPtr->nextPtr; cbPtr->proc(cbPtr->clientData); ckfree(cbPtr); } ResetFlag(statePtr, CHANNEL_INCLOSE); /* * If this channel supports it, close the read side, since we don't need * it anymore and this will help avoid deadlocks on some channel types. */ if ((chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) || (chanPtr->typePtr->closeProc == NULL)) { /* If this half-close gives a EINVAL or ENOTCONN, just continue the full close */ result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ); if ((result == EINVAL) || result == ENOTCONN) { result = 0; } } /* * The call to FlushChannel will flush any queued output and invoke the * close function of the channel driver, or it will set up the channel to * be flushed and closed asynchronously. */ SetFlag(statePtr, CHANNEL_CLOSED); flushcode = FlushChannel(interp, chanPtr, 0); /* * TIP #219. * Capture error messages put by the driver into the bypass area and put * them into the regular interpreter result. * * Notes: Due to the assertion of CHANNEL_CLOSED in the flags * FlushChannel() has called CloseChannel() and thus freed all the channel * structures. We must not try to access "chan" anymore, hence the NULL * argument in the call below. The only place which may still contain a * message is the interpreter itself, and "CloseChannel" made sure to lift * any channel message it generated into it. */ if (TclChanCaughtErrorBypass(interp, NULL)) { result = EINVAL; } if (stickyError != 0) { Tcl_SetErrno(stickyError); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } return TCL_ERROR; } /* * Bug 97069ea11a: set error message if a flush code is set and no error * message set up to now. */ if (flushcode != 0) { /* flushcode has precedence, if available */ result = flushcode; } if ((result != 0) && (result != TCL_ERROR) && (interp != NULL) && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) { Tcl_SetErrno(result); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } if (result != 0) { return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_CloseEx -- * * Closes one side of a channel, read or write. * * Results: * A standard Tcl result. * * Side effects: * Closes one direction of the channel. * * NOTE: * Tcl_CloseEx closes the specified direction of the channel as far as * the user is concerned. The channel keeps existing however. You cannot * call this function to close the last possible direction of the * channel. Use Tcl_Close for that. * *---------------------------------------------------------------------- */ int Tcl_CloseEx( Tcl_Interp *interp, /* Interpreter for errors. */ Tcl_Channel chan, /* The channel being closed. May still be used * by some interpreter. */ int flags) /* Flags telling us which side to close. */ { Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of real IO channel. */ if (chan == NULL) { return TCL_OK; } chanPtr = (Channel *) chan; statePtr = chanPtr->state; if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) { return Tcl_Close(interp, chan); } if ((flags & (TCL_READABLE | TCL_WRITABLE)) == (TCL_READABLE | TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "double-close of channels not supported by %ss", chanPtr->typePtr->typeName)); return TCL_ERROR; } /* * Does the channel support half-close anyway? Error if not. */ if (!chanPtr->typePtr->close2Proc) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "half-close of channels not supported by %ss", chanPtr->typePtr->typeName)); return TCL_ERROR; } /* * Is the channel unstacked ? If not we fail. */ if (chanPtr != statePtr->topChanPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "half-close not applicable to stack of transformations", -1)); return TCL_ERROR; } /* * Check direction against channel mode. It is an error if we try to close * a direction not supported by the channel (already closed, or never * opened for that direction). */ if (!(GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE) & flags)) { const char *msg; if (flags & TCL_CLOSE_READ) { msg = "read"; } else { msg = "write"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Half-close of %s-side not possible, side not opened or" " already closed", msg)); return TCL_ERROR; } /* * A user may try to call half-close from within a channel close handler. * That won't do. */ if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" " of channel", -1)); } return TCL_ERROR; } if (flags & TCL_CLOSE_READ) { /* * Call the finalization code directly. There are no events to handle, * there cannot be for the read-side. */ return CloseChannelPart(interp, chanPtr, 0, flags); } else if (flags & TCL_CLOSE_WRITE) { Tcl_Preserve(statePtr); if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* * We don't want to re-enter CloseWrite(). */ if (!GotFlag(statePtr, CHANNEL_CLOSEDWRITE)) { if (CloseWrite(interp, chanPtr) != TCL_OK) { SetFlag(statePtr, CHANNEL_CLOSEDWRITE); Tcl_Release(statePtr); return TCL_ERROR; } } } SetFlag(statePtr, CHANNEL_CLOSEDWRITE); Tcl_Release(statePtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * CloseWrite -- * * Closes the write side a channel. * * Results: * A standard Tcl result. * * Side effects: * Closes the write side of the channel. * * NOTE: * CloseWrite removes the channel as far as the user is concerned. * However, the output data structures may continue to exist for a while * longer if it has a background flush scheduled. The device itself is * eventually closed and the channel structures modified, in * CloseChannelPart, below. * *---------------------------------------------------------------------- */ static int CloseWrite( Tcl_Interp *interp, /* Interpreter for errors. */ Channel *chanPtr) /* The channel whose write side is being * closed. May still be used by some * interpreter */ { /* * Notes: clear-channel-handlers - write side only ? or keep around, just * not called. * * No close callbacks are run - channel is still open (read side) */ ChannelState *statePtr = chanPtr->state; /* State of real IO channel. */ int flushcode; int result = 0; /* * The call to FlushChannel will flush any queued output and invoke the * close function of the channel driver, or it will set up the channel to * be flushed and closed asynchronously. */ SetFlag(statePtr, CHANNEL_CLOSEDWRITE); flushcode = FlushChannel(interp, chanPtr, 0); /* * TIP #219. * Capture error messages put by the driver into the bypass area and put * them into the regular interpreter result. * * Notes: Due to the assertion of CHANNEL_CLOSEDWRITE in the flags * FlushChannel() has called CloseChannelPart(). While we can still access * "chan" (no structures were freed), the only place which may still * contain a message is the interpreter itself, and "CloseChannelPart" * made sure to lift any channel message it generated into it. Hence the * NULL argument in the call below. */ if (TclChanCaughtErrorBypass(interp, NULL)) { result = EINVAL; } if ((flushcode != 0) || (result != 0)) { return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * CloseChannelPart -- * * Utility procedure to close a channel partially and free associated * resources. If the channel was stacked it will never be run (The higher * level forbid this). If the channel was not stacked, then we will free * all the bits of the chosen side (read, or write) for the TOP channel. * * Results: * Error code from an unreported error or the driver close2 operation. * * Side effects: * May free memory, may change the value of errno. * *---------------------------------------------------------------------- */ static int CloseChannelPart( Tcl_Interp *interp, /* Interpreter for errors. */ Channel *chanPtr, /* The channel being closed. May still be used * by some interpreter. */ int errorCode, /* Status of operation so far. */ int flags) /* Flags telling us which side to close. */ { ChannelState *statePtr; /* State of real IO channel. */ int result; /* Of calling the close2proc. */ statePtr = chanPtr->state; if (flags & TCL_CLOSE_READ) { /* * No more input can be consumed so discard any leftover input. */ DiscardInputQueued(statePtr, 1); } else if (flags & TCL_CLOSE_WRITE) { /* * The caller guarantees that there are no more buffers queued for * output. */ if (statePtr->outQueueHead != NULL) { Tcl_Panic("ClosechanHalf, closed write-side of channel: " "queued output left"); } /* * If the EOF character is set in the channel, append that to the * output device. */ if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) { int dummy; char c = (char) statePtr->outEofChar; (void) ChanWrite(chanPtr, &c, 1, &dummy); } /* * TIP #219, Tcl Channel Reflection API. * Move a leftover error message in the channel bypass into the * interpreter bypass. Just clear it if there is no interpreter. */ if (statePtr->chanMsg != NULL) { if (interp != NULL) { Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg); } TclDecrRefCount(statePtr->chanMsg); statePtr->chanMsg = NULL; } } /* * Finally do what is asked of us. Close and free the channel driver state * for the chosen side of the channel. This may leave a TIP #219 error * message in the interp. */ result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, NULL, flags); /* * If we are being called synchronously, report either any latent error on * the channel or the current error. */ if (statePtr->unreportedError != 0) { errorCode = statePtr->unreportedError; /* * TIP #219, Tcl Channel Reflection API. * Move an error message found in the unreported area into the regular * bypass (interp). This kills any message in the channel bypass area. */ if (statePtr->chanMsg != NULL) { TclDecrRefCount(statePtr->chanMsg); statePtr->chanMsg = NULL; } if (interp) { Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg); } } if (errorCode == 0) { errorCode = result; if (errorCode != 0) { Tcl_SetErrno(errorCode); } } /* * TIP #219. * Capture error messages put by the driver into the bypass area and put * them into the regular interpreter result. See also the bottom of * CloseWrite(). */ if (TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { result = EINVAL; } if (result != 0) { return TCL_ERROR; } /* * Remove the closed side from the channel mode/flags. */ ResetFlag(statePtr, flags & (TCL_READABLE | TCL_WRITABLE)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ClearChannelHandlers -- * * Removes all channel handlers and event scripts from the channel, * cancels all background copies involving the channel and any interest * in events. * * Results: * None. * * Side effects: * See above. Deallocates memory. * *---------------------------------------------------------------------- */ void Tcl_ClearChannelHandlers( Tcl_Channel channel) { ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */ EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of real IO channel. */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); NextChannelHandler *nhPtr; /* * This operation should occur at the top of a channel stack. */ chanPtr = (Channel *) channel; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; /* * Cancel any outstanding timer. */ if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = NULL; TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); statePtr->timerChanPtr = NULL; } /* * Remove any references to channel handlers for this channel that may be * about to be invoked. */ for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL; nhPtr = nhPtr->nestedHandlerPtr) { if (nhPtr->nextHandlerPtr && (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) { nhPtr->nextHandlerPtr = NULL; } } /* * Remove all the channel handler records attached to the channel itself. */ for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) { chNext = chPtr->nextPtr; ckfree(chPtr); } statePtr->chPtr = NULL; /* * Cancel any pending copy operation. */ StopCopy(statePtr->csPtrR); StopCopy(statePtr->csPtrW); /* * Must set the interest mask now to 0, otherwise infinite loops will * occur if Tcl_DoOneEvent is called before the channel is finally deleted * in FlushChannel. This can happen if the channel has a background flush * active. */ statePtr->interestMask = 0; /* * Remove any EventScript records for this channel. */ for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) { eNextPtr = ePtr->nextPtr; TclDecrRefCount(ePtr->scriptPtr); ckfree(ePtr); } statePtr->scriptRecordPtr = NULL; } /* *---------------------------------------------------------------------- * * Tcl_Write -- * * Puts a sequence of bytes into an output buffer, may queue the buffer * for output if it gets full, and also remembers whether the current * buffer is ready e.g. if it contains a newline and we are in line * buffering mode. Compensates stacking, i.e. will redirect the data from * the specified channel to the topmost channel in a stack. * * No encoding conversions are applied to the bytes being read. * * Results: * The number of bytes written or -1 in case of error. If -1, * Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the * channel. * *---------------------------------------------------------------------- */ int Tcl_Write( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ int srcLen) /* Length of data in bytes, or < 0 for * strlen(). */ { /* * Always use the topmost channel of the stack */ Channel *chanPtr; ChannelState *statePtr; /* State info for channel */ statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { return -1; } if (srcLen < 0) { srcLen = strlen(src); } if (WriteBytes(chanPtr, src, srcLen) < 0) { return -1; } return srcLen; } /* *---------------------------------------------------------------------- * * Tcl_WriteRaw -- * * Puts a sequence of bytes into an output buffer, may queue the buffer * for output if it gets full, and also remembers whether the current * buffer is ready e.g. if it contains a newline and we are in line * buffering mode. Writes directly to the driver of the channel, does not * compensate for stacking. * * No encoding conversions are applied to the bytes being read. * * Results: * The number of bytes written or -1 in case of error. If -1, * Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the * channel. * *---------------------------------------------------------------------- */ int Tcl_WriteRaw( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ int srcLen) /* Length of data in bytes, or < 0 for * strlen(). */ { Channel *chanPtr = ((Channel *) chan); ChannelState *statePtr = chanPtr->state; /* State info for channel */ int errorCode; int written; if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) { return -1; } if (srcLen < 0) { srcLen = strlen(src); } /* * Go immediately to the driver, do all the error handling by ourselves. * The code was stolen from 'FlushChannel'. */ written = ChanWrite(chanPtr, src, srcLen, &errorCode); if (written < 0) { Tcl_SetErrno(errorCode); } return written; } /* *--------------------------------------------------------------------------- * * Tcl_WriteChars -- * * Takes a sequence of UTF-8 characters and converts them for output * using the channel's current encoding, may queue the buffer for output * if it gets full, and also remembers whether the current buffer is * ready e.g. if it contains a newline and we are in line buffering * mode. Compensates stacking, i.e. will redirect the data from the * specified channel to the topmost channel in a stack. * * Results: * The number of bytes written or -1 in case of error. If -1, * Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the * channel. * *---------------------------------------------------------------------- */ int Tcl_WriteChars( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* UTF-8 characters to queue in output * buffer. */ int len) /* Length of string in bytes, or < 0 for * strlen(). */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ int result; Tcl_Obj *objPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { return -1; } chanPtr = statePtr->topChanPtr; if (len < 0) { len = strlen(src); } if (statePtr->encoding) { return WriteChars(chanPtr, src, len); } /* * Inefficient way to convert UTF-8 to byte-array, but the code * parallels the way it is done for objects. Special case for 1-byte * (used by e.g. [puts] for the \n) could be extended to more efficient * translation of the src string. */ if ((len == 1) && (UCHAR(*src) < 0xC0)) { return WriteBytes(chanPtr, src, len); } objPtr = Tcl_NewStringObj(src, len); src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); result = WriteBytes(chanPtr, src, len); TclDecrRefCount(objPtr); return result; } /* *--------------------------------------------------------------------------- * * Tcl_WriteObj -- * * Takes the Tcl object and queues its contents for output. If the * encoding of the channel is NULL, takes the byte-array representation * of the object and queues those bytes for output. Otherwise, takes the * characters in the UTF-8 (string) representation of the object and * converts them for output using the channel's current encoding. May * flush internal buffers to output if one becomes full or is ready for * some other reason, e.g. if it contains a newline and the channel is in * line buffering mode. * * Results: * The number of bytes written or -1 in case of error. If -1, * Tcl_GetErrno() will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the * channel. * *---------------------------------------------------------------------- */ int Tcl_WriteObj( Tcl_Channel chan, /* The channel to buffer output for. */ Tcl_Obj *objPtr) /* The object to write. */ { /* * Always use the topmost channel of the stack */ Channel *chanPtr; ChannelState *statePtr; /* State info for channel */ const char *src; int srcLen; statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { return -1; } if (statePtr->encoding == NULL) { src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); return WriteBytes(chanPtr, src, srcLen); } else { src = TclGetStringFromObj(objPtr, &srcLen); return WriteChars(chanPtr, src, srcLen); } } static void WillWrite( Channel *chanPtr) { int inputBuffered; if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ int ignore; DiscardInputQueued(chanPtr->state, 0); ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore); } } static int WillRead( Channel *chanPtr) { if (chanPtr->typePtr == NULL) { /* * Prevent read attempts on a closed channel. */ DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); return -1; } if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { /* * CAVEAT - The assumption here is that FlushChannel() will push out * the bytes of any writes that are in progress. Since this is a * seekable channel, we assume it is not one that can block and force * bg flushing. Channels we know that can do that - sockets, pipes - * are not seekable. If the assumption is wrong, more drastic measures * may be required here like temporarily setting the channel into * blocking mode. */ if (FlushChannel(NULL, chanPtr, 0) != 0) { return -1; } } return 0; } /* *---------------------------------------------------------------------- * * Write -- * * Convert srcLen bytes starting at src according to encoding and write * produced bytes into an output buffer, may queue the buffer for output * if it gets full, and also remembers whether the current buffer is * ready e.g. if it contains a newline and we are in line buffering mode. * * Results: * The number of bytes written or -1 in case of error. If -1, * Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the * channel. * *---------------------------------------------------------------------- */ static int Write( Channel *chanPtr, /* The channel to buffer output for. */ const char *src, /* UTF-8 string to write. */ int srcLen, /* Length of UTF-8 string in bytes. */ Tcl_Encoding encoding) { ChannelState *statePtr = chanPtr->state; /* State info for channel */ char *nextNewLine = NULL; int endEncoding, needNlFlush = 0; int saved = 0, total = 0, flushed = 0; char safe[BUFFER_PADDING]; int encodingError = 0; if (srcLen) { WillWrite(chanPtr); } /* * Write the terminated escape sequence even if srcLen is 0. */ endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); if (GotFlag(statePtr, CHANNEL_LINEBUFFERED) || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) { nextNewLine = (char *)memchr(src, '\n', srcLen); } while (srcLen + saved + endEncoding > 0 && !encodingError) { ChannelBuffer *bufPtr; char *dst; int result, srcRead, dstLen, dstWrote; int srcLimit = srcLen; if (nextNewLine) { srcLimit = nextNewLine - src; } /* Get space to write into */ bufPtr = statePtr->curOutPtr; if (bufPtr == NULL) { bufPtr = AllocChannelBuffer(statePtr->bufSize); statePtr->curOutPtr = bufPtr; } if (saved) { /* * Here's some translated bytes left over from the last buffer * that we need to stick at the beginning of this buffer. */ memcpy(InsertPoint(bufPtr), safe, saved); bufPtr->nextAdded += saved; saved = 0; } PreserveChannelBuffer(bufPtr); dst = InsertPoint(bufPtr); dstLen = SpaceLeft(bufPtr); result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit, statePtr->outputEncodingFlags, &statePtr->outputEncodingState, dst, dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); /* * See chan-io-1.[89]. Tcl Bug 506297. */ statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; if ((result != TCL_OK) && (srcRead + dstWrote == 0)) { encodingError = 1; result = TCL_OK; } bufPtr->nextAdded += dstWrote; src += srcRead; srcLen -= srcRead; total += dstWrote; dst += dstWrote; dstLen -= dstWrote; if (src == nextNewLine && dstLen > 0) { static char crln[3] = "\r\n"; char *nl = NULL; int nlLen = 0; switch (statePtr->outputTranslation) { case TCL_TRANSLATE_LF: nl = crln + 1; nlLen = 1; break; case TCL_TRANSLATE_CR: nl = crln; nlLen = 1; break; case TCL_TRANSLATE_CRLF: nl = crln; nlLen = 2; break; default: Tcl_Panic("unknown output translation requested"); break; } result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen, statePtr->outputEncodingFlags, &statePtr->outputEncodingState, dst, dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); assert(srcRead == nlLen); bufPtr->nextAdded += dstWrote; src++; srcLen--; total += dstWrote; dst += dstWrote; dstLen -= dstWrote; nextNewLine = (char *)memchr(src, '\n', srcLen); needNlFlush = 1; } if (IsBufferOverflowing(bufPtr)) { /* * When translating from UTF-8 to external encoding, we allowed * the translation to produce a character that crossed the end of * the output buffer, so that we would get a completely full * buffer before flushing it. The extra bytes will be moved to the * beginning of the next buffer. */ saved = -SpaceLeft(bufPtr); memcpy(safe, dst + dstLen, saved); bufPtr->nextAdded = bufPtr->bufLength; } if ((srcLen + saved == 0) && (result == TCL_OK)) { endEncoding = 0; } if (IsBufferFull(bufPtr)) { if (FlushChannel(NULL, chanPtr, 0) != 0) { ReleaseChannelBuffer(bufPtr); return -1; } flushed += statePtr->bufSize; /* * We just flushed. So if we have needNlFlush set to record that * we need to flush because there is a (translated) newline in the * buffer, that's likely not true any more. But there is a tricky * exception. If we have saved bytes that did not really get * flushed and those bytes came from a translation of a newline as * the last thing taken from the src array, then needNlFlush needs * to remain set to flag that the next buffer still needs a * newline flush. */ if (needNlFlush && (saved == 0 || src[-1] != '\n')) { needNlFlush = 0; } } ReleaseChannelBuffer(bufPtr); } if (((flushed < total) && GotFlag(statePtr, CHANNEL_UNBUFFERED)) || (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED))) { if (FlushChannel(NULL, chanPtr, 0) != 0) { return -1; } } if (encodingError) { Tcl_SetErrno(EINVAL); return -1; } return total; } /* *--------------------------------------------------------------------------- * * Tcl_Gets -- * * Reads a complete line of input from the channel into a Tcl_DString. * * Results: * Length of line read (in characters) or -1 if error, EOF, or blocked. * If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the * error or condition that occurred. * * Side effects: * May flush output on the channel. May cause input to be consumed from * the channel. * *--------------------------------------------------------------------------- */ int Tcl_Gets( Tcl_Channel chan, /* Channel from which to read. */ Tcl_DString *lineRead) /* The line read will be appended to this * DString as UTF-8 characters. The caller * must have initialized it and is responsible * for managing the storage. */ { Tcl_Obj *objPtr; int charsStored; TclNewObj(objPtr); charsStored = Tcl_GetsObj(chan, objPtr); if (charsStored > 0) { TclDStringAppendObj(lineRead, objPtr); } TclDecrRefCount(objPtr); return charsStored; } /* *--------------------------------------------------------------------------- * * Tcl_GetsObj -- * * Accumulate input from the input channel until end-of-line or * end-of-file has been seen. Bytes read from the input channel are * converted to UTF-8 using the encoding specified by the channel. * * Results: * Number of characters accumulated in the object or -1 if error, * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error * code for the error or condition that occurred. * * Side effects: * Consumes input from the channel. * * On reading EOF, leave channel pointing at EOF char. On reading EOL, * leave channel pointing after EOL, but don't return EOL in dst buffer. * *--------------------------------------------------------------------------- */ int Tcl_GetsObj( Tcl_Channel chan, /* Channel from which to read. */ Tcl_Obj *objPtr) /* The line read will be appended to this * object as UTF-8 characters. */ { GetsState gs; Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; int oldLength; Tcl_Encoding encoding; char *dst, *dstEnd, *eol, *eof; Tcl_EncodingState oldState; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { return -1; } /* * If we're sitting ready to read the eofchar, there's no need to * do it. */ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { SetFlag(statePtr, CHANNEL_EOF); assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); /* TODO: Do we need this? */ UpdateInterest(chanPtr); return -1; } /* * A binary version of Tcl_GetsObj. This could also handle encodings that * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion * done on objPtr. */ if ((statePtr->encoding == NULL) && ((statePtr->inputTranslation == TCL_TRANSLATE_LF) || (statePtr->inputTranslation == TCL_TRANSLATE_CR))) { return TclGetsObjBinary(chan, objPtr); } /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); bufPtr = statePtr->inQueueHead; encoding = statePtr->encoding; /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ TclGetStringFromObj(objPtr, &oldLength); oldFlags = statePtr->inputEncodingFlags; oldState = statePtr->inputEncodingState; oldRemoved = BUFFER_PADDING; if (bufPtr != NULL) { oldRemoved = bufPtr->nextRemoved; } /* * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't * produce ByteArray objects. */ if (encoding == NULL) { encoding = GetBinaryEncoding(); } /* * Object used by FilterInputBytes to keep track of how much data has been * consumed from the channel buffers. */ gs.objPtr = objPtr; gs.dstPtr = &dst; gs.encoding = encoding; gs.bufPtr = bufPtr; gs.state = oldState; gs.rawRead = 0; gs.bytesWrote = 0; gs.charsWrote = 0; gs.totalChars = 0; dst = objPtr->bytes + oldLength; dstEnd = dst; skip = 0; eof = NULL; inEofChar = statePtr->inEofChar; ResetFlag(statePtr, CHANNEL_BLOCKED); while (1) { if (dst >= dstEnd) { if (FilterInputBytes(chanPtr, &gs) != 0) { goto restore; } dstEnd = dst + gs.bytesWrote; } /* * Remember if EOF char is seen, then look for EOL anyhow, because the * EOL might be before the EOF char. */ if (inEofChar != '\0') { for (eol = dst; eol < dstEnd; eol++) { if (*eol == inEofChar) { dstEnd = eol; eof = eol; break; } } } /* * On EOL, leave current file position pointing after the EOL, but * don't store the EOL in the output string. */ switch (statePtr->inputTranslation) { case TCL_TRANSLATE_LF: for (eol = dst; eol < dstEnd; eol++) { if (*eol == '\n') { skip = 1; goto gotEOL; } } break; case TCL_TRANSLATE_CR: for (eol = dst; eol < dstEnd; eol++) { if (*eol == '\r') { skip = 1; goto gotEOL; } } break; case TCL_TRANSLATE_CRLF: for (eol = dst; eol < dstEnd; eol++) { if (*eol == '\r') { eol++; /* * If a CR is at the end of the buffer, then check for a * LF at the beginning of the next buffer, unless EOF char * was found already. */ if (eol >= dstEnd) { int offset; if (eol != eof) { offset = eol - objPtr->bytes; dst = dstEnd; if (FilterInputBytes(chanPtr, &gs) != 0) { goto restore; } dstEnd = dst + gs.bytesWrote; eol = objPtr->bytes + offset; } if (eol >= dstEnd) { skip = 0; goto gotEOL; } } if (*eol == '\n') { eol--; skip = 2; goto gotEOL; } } } break; case TCL_TRANSLATE_AUTO: eol = dst; skip = 1; if (GotFlag(statePtr, INPUT_SAW_CR)) { if ((eol < dstEnd) && (*eol == '\n')) { /* * Skip the raw bytes that make up the '\n'. */ int rawRead; char tmp[TCL_UTF_MAX]; bufPtr = gs.bufPtr; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp, sizeof(tmp), &rawRead, NULL, NULL); bufPtr->nextRemoved += rawRead; gs.rawRead -= rawRead; gs.bytesWrote--; gs.charsWrote--; memmove(dst, dst + 1, dstEnd - dst); dstEnd--; } } for (eol = dst; eol < dstEnd; eol++) { if (*eol == '\r') { eol++; if (eol == dstEnd) { /* * If buffer ended on \r, peek ahead to see if a \n is * available, unless EOF char was found already. */ if (eol != eof) { int offset; offset = eol - objPtr->bytes; dst = dstEnd; PeekAhead(chanPtr, &dstEnd, &gs); eol = objPtr->bytes + offset; } if (eol >= dstEnd) { eol--; SetFlag(statePtr, INPUT_SAW_CR); goto gotEOL; } } if (*eol == '\n') { skip++; } eol--; ResetFlag(statePtr, INPUT_SAW_CR); goto gotEOL; } else if (*eol == '\n') { ResetFlag(statePtr, INPUT_SAW_CR); goto gotEOL; } } } if (eof != NULL) { /* * EOF character was seen. On EOF, leave current file position * pointing at the EOF character, but don't store the EOF * character in the output string. */ dstEnd = eof; SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } if (GotFlag(statePtr, CHANNEL_EOF)) { skip = 0; eol = dstEnd; if (eol == objPtr->bytes + oldLength) { /* * If we didn't append any bytes before encountering EOF, * caller needs to see -1. */ Tcl_SetObjLength(objPtr, oldLength); CommonGetsCleanup(chanPtr); copiedTotal = -1; ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); goto done; } goto gotEOL; } dst = dstEnd; } /* * Found EOL or EOF, but the output buffer may now contain too many UTF-8 * characters. We need to know how many raw bytes correspond to the number * of UTF-8 characters we want, plus how many raw bytes correspond to the * character(s) making up EOL (if any), so we can remove the correct * number of bytes from the channel buffer. */ gotEOL: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } bufPtr = gs.bufPtr; if (bufPtr == NULL) { Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL"); } statePtr->inputEncodingState = gs.state; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &statePtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX - 1, &gs.rawRead, NULL, &gs.charsWrote); bufPtr->nextRemoved += gs.rawRead; /* * Recycle all the emptied buffers. */ Tcl_SetObjLength(objPtr, eol - objPtr->bytes); CommonGetsCleanup(chanPtr); ResetFlag(statePtr, CHANNEL_BLOCKED); copiedTotal = gs.totalChars + gs.charsWrote - skip; goto done; /* * Couldn't get a complete line. This only happens if we get a error * reading from the channel or we are non-blocking and there wasn't an EOL * or EOF in the data available. */ restore: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } bufPtr = statePtr->inQueueHead; if (bufPtr != NULL) { bufPtr->nextRemoved = oldRemoved; bufPtr = bufPtr->nextPtr; } for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bufPtr->nextRemoved = BUFFER_PADDING; } CommonGetsCleanup(chanPtr); statePtr->inputEncodingState = oldState; statePtr->inputEncodingFlags = oldFlags; Tcl_SetObjLength(objPtr, oldLength); /* * We didn't get a complete line so we need to indicate to UpdateInterest * that the gets blocked. It will wait for more data instead of firing a * timer, avoiding a busy wait. This is where we are assuming that the * next operation is a gets. No more file events will be delivered on this * channel until new data arrives or some operation is performed on the * channel (e.g. gets, read, fconfigure) that changes the blocking state. * Note that this means a file event will not be delivered even though a * read would be able to consume the buffered data. */ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); copiedTotal = -1; /* * Update the notifier state so we don't block while there is still data * in the buffers. */ done: assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copiedTotal; } /* *--------------------------------------------------------------------------- * * TclGetsObjBinary -- * * A variation of Tcl_GetsObj that works directly on the buffers until * end-of-line or end-of-file has been seen. Bytes read from the input * channel return as a ByteArray obj. * * WARNING! The notion of "binary" used here is different from notions * of "binary" used in other places. In particular, this "binary" routine * may be called when an -eofchar is set on the channel. * * Results: * Number of characters accumulated in the object or -1 if error, * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error * code for the error or condition that occurred. * * Side effects: * Consumes input from the channel. * * On reading EOF, leave channel pointing at EOF char. On reading EOL, * leave channel pointing after EOL, but don't return EOL in dst buffer. * *--------------------------------------------------------------------------- */ static int TclGetsObjBinary( Tcl_Channel chan, /* Channel from which to read. */ Tcl_Obj *objPtr) /* The line read will be appended to this * object as UTF-8 characters. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; int rawLen, byteLen, eolChar; unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); bufPtr = statePtr->inQueueHead; /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen); oldFlags = statePtr->inputEncodingFlags; oldRemoved = BUFFER_PADDING; oldLength = byteLen; if (bufPtr != NULL) { oldRemoved = bufPtr->nextRemoved; } rawLen = 0; skip = 0; eof = NULL; inEofChar = statePtr->inEofChar; /* * Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR. */ eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r'; ResetFlag(statePtr, CHANNEL_BLOCKED); while (1) { /* * Subtract the number of bytes that were removed from channel buffer * during last call. */ if (bufPtr != NULL) { bufPtr->nextRemoved += rawLen; if (!IsBufferReady(bufPtr)) { bufPtr = bufPtr->nextPtr; } } if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) { /* * All channel buffers were exhausted and the caller still hasn't * seen EOL. Need to read more bytes from the channel device. Side * effect is to allocate another channel buffer. */ if (GetInput(chanPtr) != 0) { goto restore; } bufPtr = statePtr->inQueueTail; if (bufPtr == NULL) { goto restore; } } else { /* * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new * CHANNEL_STICKY_EOF set in this routine leads to return before * coming back here. When we are not dealing with * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer. * Here the buffer is non-empty so we know we're a non-EOF. */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); assert(!GotFlag(statePtr, CHANNEL_EOF)); } dst = (unsigned char *) RemovePoint(bufPtr); dstEnd = dst + BytesLeft(bufPtr); /* * Remember if EOF char is seen, then look for EOL anyhow, because the * EOL might be before the EOF char. * XXX - in the binary case, consider coincident search for eol/eof. */ if (inEofChar != '\0') { for (eol = dst; eol < dstEnd; eol++) { if (*eol == inEofChar) { dstEnd = eol; eof = eol; break; } } } /* * On EOL, leave current file position pointing after the EOL, but * don't store the EOL in the output string. */ for (eol = dst; eol < dstEnd; eol++) { if (*eol == eolChar) { skip = 1; goto gotEOL; } } if (eof != NULL) { /* * EOF character was seen. On EOF, leave current file position * pointing at the EOF character, but don't store the EOF * character in the output string. */ SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } if (GotFlag(statePtr, CHANNEL_EOF)) { skip = 0; eol = dstEnd; if ((dst == dstEnd) && (byteLen == oldLength)) { /* * If we didn't append any bytes before encountering EOF, * caller needs to see -1. */ byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); CommonGetsCleanup(chanPtr); copiedTotal = -1; ResetFlag(statePtr, CHANNEL_BLOCKED); goto done; } goto gotEOL; } if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING) == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) { goto restore; } /* * Copy bytes from the channel buffer to the ByteArray. This may * realloc space, so keep track of result. */ rawLen = dstEnd - dst; byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen); memcpy(byteArray + byteLen, dst, rawLen); byteLen += rawLen; } /* * Found EOL or EOF, but the output buffer may now contain too many bytes. * We need to know how many bytes correspond to the number we want, so we * can remove the correct number of bytes from the channel buffer. */ gotEOL: if (bufPtr == NULL) { Tcl_Panic("TclGetsObjBinary: gotEOL reached with bufPtr==NULL"); } rawLen = eol - dst; byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen); memcpy(byteArray + byteLen, dst, rawLen); byteLen += rawLen; bufPtr->nextRemoved += rawLen + skip; /* * Convert the buffer if there was an encoding. * XXX - unimplemented. */ if (statePtr->encoding != NULL) { } /* * Recycle all the emptied buffers. */ CommonGetsCleanup(chanPtr); ResetFlag(statePtr, CHANNEL_BLOCKED); copiedTotal = byteLen; goto done; /* * Couldn't get a complete line. This only happens if we get a error * reading from the channel or we are non-blocking and there wasn't an EOL * or EOF in the data available. */ restore: bufPtr = statePtr->inQueueHead; if (bufPtr) { bufPtr->nextRemoved = oldRemoved; bufPtr = bufPtr->nextPtr; } for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bufPtr->nextRemoved = BUFFER_PADDING; } CommonGetsCleanup(chanPtr); statePtr->inputEncodingFlags = oldFlags; byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); /* * We didn't get a complete line so we need to indicate to UpdateInterest * that the gets blocked. It will wait for more data instead of firing a * timer, avoiding a busy wait. This is where we are assuming that the * next operation is a gets. No more file events will be delivered on this * channel until new data arrives or some operation is performed on the * channel (e.g. gets, read, fconfigure) that changes the blocking state. * Note that this means a file event will not be delivered even though a * read would be able to consume the buffered data. */ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); copiedTotal = -1; /* * Update the notifier state so we don't block while there is still data * in the buffers. */ done: assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copiedTotal; } /* *--------------------------------------------------------------------------- * * FreeBinaryEncoding -- * * Frees any "iso8859-1" Tcl_Encoding created by [gets] on a binary * channel in a thread as part of that thread's finalization. * * Results: * None. * *--------------------------------------------------------------------------- */ static void FreeBinaryEncoding( ClientData dummy) /* Not used */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)dummy; if (tsdPtr->binaryEncoding != NULL) { Tcl_FreeEncoding(tsdPtr->binaryEncoding); tsdPtr->binaryEncoding = NULL; } } static Tcl_Encoding GetBinaryEncoding(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->binaryEncoding == NULL) { tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL); } if (tsdPtr->binaryEncoding == NULL) { Tcl_Panic("binary encoding is not available"); } return tsdPtr->binaryEncoding; } /* *--------------------------------------------------------------------------- * * FilterInputBytes -- * * Helper function for Tcl_GetsObj. Produces UTF-8 characters from raw * bytes read from the channel. * * Consumes available bytes from channel buffers. When channel buffers * are exhausted, reads more bytes from channel device into a new channel * buffer. It is the caller's responsibility to free the channel buffers * that have been exhausted. * * Results: * The return value is -1 if there was an error reading from the channel, * 0 otherwise. * * Side effects: * Status object keeps track of how much data from channel buffers has * been consumed and where UTF-8 bytes should be stored. * *--------------------------------------------------------------------------- */ static int FilterInputBytes( Channel *chanPtr, /* Channel to read. */ GetsState *gsPtr) /* Current state of gets operation. */ { ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; char *raw, *dst; int offset, toRead, dstNeeded, spaceLeft, result, rawLen; Tcl_Obj *objPtr; #define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at * a time. Since we don't know a priori how * many bytes of storage this many source * bytes will use, we actually need at least * ENCODING_LINESIZE * TCL_MAX_UTF bytes of * room. */ objPtr = gsPtr->objPtr; /* * Subtract the number of bytes that were removed from channel buffer * during last call. */ bufPtr = gsPtr->bufPtr; if (bufPtr != NULL) { bufPtr->nextRemoved += gsPtr->rawRead; if (!IsBufferReady(bufPtr)) { bufPtr = bufPtr->nextPtr; } } gsPtr->totalChars += gsPtr->charsWrote; if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) { /* * All channel buffers were exhausted and the caller still hasn't seen * EOL. Need to read more bytes from the channel device. Side effect * is to allocate another channel buffer. */ read: if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { gsPtr->charsWrote = 0; gsPtr->rawRead = 0; return -1; } if (GetInput(chanPtr) != 0) { gsPtr->charsWrote = 0; gsPtr->rawRead = 0; return -1; } bufPtr = statePtr->inQueueTail; gsPtr->bufPtr = bufPtr; if (bufPtr == NULL) { gsPtr->charsWrote = 0; gsPtr->rawRead = 0; return -1; } } else { /* * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new * CHANNEL_STICKY_EOF set in this routine leads to return before * coming back here. When we are not dealing with CHANNEL_STICKY_EOF, * a CHANNEL_EOF implies an empty buffer. Here the buffer is * non-empty so we know we're a non-EOF. */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); assert(!GotFlag(statePtr, CHANNEL_EOF)); } /* * Convert some of the bytes from the channel buffer to UTF-8. Space in * objPtr's string rep is used to hold the UTF-8 characters. Grow the * string rep if we need more space. */ raw = RemovePoint(bufPtr); rawLen = BytesLeft(bufPtr); dst = *gsPtr->dstPtr; offset = dst - objPtr->bytes; toRead = ENCODING_LINESIZE; if (toRead > rawLen) { toRead = rawLen; } dstNeeded = toRead * TCL_UTF_MAX; spaceLeft = objPtr->length - offset; if (dstNeeded > spaceLeft) { int length = offset + ((offset < dstNeeded) ? dstNeeded : offset); if (Tcl_AttemptSetObjLength(objPtr, length) == 0) { length = offset + dstNeeded; if (Tcl_AttemptSetObjLength(objPtr, length) == 0) { dstNeeded = TCL_UTF_MAX - 1 + toRead; length = offset + dstNeeded; Tcl_SetObjLength(objPtr, length); } } spaceLeft = length - offset; dst = objPtr->bytes + offset; *gsPtr->dstPtr = dst; } gsPtr->state = statePtr->inputEncodingState; result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote, &gsPtr->charsWrote); /* * Make sure that if we go through 'gets', that we reset the * TCL_ENCODING_START flag still. [Bug #523988] */ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; if (result == TCL_CONVERT_MULTIBYTE) { /* * The last few bytes in this channel buffer were the start of a * multibyte sequence. If this buffer was full, then move them to the * next buffer so the bytes will be contiguous. */ ChannelBuffer *nextPtr; int extra; nextPtr = bufPtr->nextPtr; if (!IsBufferFull(bufPtr)) { if (gsPtr->rawRead > 0) { /* * Some raw bytes were converted to UTF-8. Fall through, * returning those UTF-8 characters because a EOL might be * present in them. */ } else if (GotFlag(statePtr, CHANNEL_EOF)) { /* * There was a partial character followed by EOF on the * device. Fall through, returning that nothing was found. */ bufPtr->nextRemoved = bufPtr->nextAdded; } else { /* * There are no more cached raw bytes left. See if we can get * some more, but avoid blocking on a non-blocking channel. */ goto read; } } else { if (nextPtr == NULL) { nextPtr = AllocChannelBuffer(statePtr->bufSize); bufPtr->nextPtr = nextPtr; statePtr->inQueueTail = nextPtr; } extra = rawLen - gsPtr->rawRead; memcpy(nextPtr->buf + (BUFFER_PADDING - extra), raw + gsPtr->rawRead, (size_t) extra); nextPtr->nextRemoved -= extra; bufPtr->nextAdded -= extra; } } gsPtr->bufPtr = bufPtr; return 0; } /* *--------------------------------------------------------------------------- * * PeekAhead -- * * Helper function used by Tcl_GetsObj(). Called when we've seen a \r at * the end of the UTF-8 string and want to look ahead one character to * see if it is a \n. * * Results: * *gsPtr->dstPtr is filled with a pointer to the start of the range of * UTF-8 characters that were found by peeking and *dstEndPtr is filled * with a pointer to the bytes just after the end of the range. * * Side effects: * If no more raw bytes were available in one of the channel buffers, * tries to perform a non-blocking read to get more bytes from the * channel device. * *--------------------------------------------------------------------------- */ static void PeekAhead( Channel *chanPtr, /* The channel to read. */ char **dstEndPtr, /* Filled with pointer to end of new range of * UTF-8 characters. */ GetsState *gsPtr) /* Current state of gets operation. */ { ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; Tcl_DriverBlockModeProc *blockModeProc; int bytesLeft; bufPtr = gsPtr->bufPtr; /* * If there's any more raw input that's still buffered, we'll peek into * that. Otherwise, only get more data from the channel driver if it looks * like there might actually be more data. The assumption is that if the * channel buffer is filled right up to the end, then there might be more * data to read. */ blockModeProc = NULL; if (bufPtr->nextPtr == NULL) { bytesLeft = BytesLeft(bufPtr) - gsPtr->rawRead; if (bytesLeft == 0) { if (!IsBufferFull(bufPtr)) { /* * Don't peek ahead if last read was short read. */ goto cleanup; } if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) { blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr); if (blockModeProc == NULL) { /* * Don't peek ahead if cannot set non-blocking mode. */ goto cleanup; } StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING); } } } if (FilterInputBytes(chanPtr, gsPtr) == 0) { *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote; } if (blockModeProc != NULL) { StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING); } return; cleanup: bufPtr->nextRemoved += gsPtr->rawRead; gsPtr->rawRead = 0; gsPtr->totalChars += gsPtr->charsWrote; gsPtr->bytesWrote = 0; gsPtr->charsWrote = 0; } /* *--------------------------------------------------------------------------- * * CommonGetsCleanup -- * * Helper function for Tcl_GetsObj() to restore the channel after a * "gets" operation. * * Results: * None. * * Side effects: * Encoding may be freed. * *--------------------------------------------------------------------------- */ static void CommonGetsCleanup( Channel *chanPtr) { ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr, *nextPtr; bufPtr = statePtr->inQueueHead; for ( ; bufPtr != NULL; bufPtr = nextPtr) { nextPtr = bufPtr->nextPtr; if (IsBufferReady(bufPtr)) { break; } RecycleBuffer(statePtr, bufPtr, 0); } statePtr->inQueueHead = bufPtr; if (bufPtr == NULL) { statePtr->inQueueTail = NULL; } else { /* * If any multi-byte characters were split across channel buffer * boundaries, the split-up bytes were moved to the next channel * buffer by FilterInputBytes(). Move the bytes back to their original * buffer because the caller could change the channel's encoding which * could change the interpretation of whether those bytes really made * up multi-byte characters after all. */ nextPtr = bufPtr->nextPtr; for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) { int extra; extra = SpaceLeft(bufPtr); if (extra > 0) { memcpy(InsertPoint(bufPtr), nextPtr->buf + (BUFFER_PADDING - extra), (size_t) extra); bufPtr->nextAdded += extra; nextPtr->nextRemoved = BUFFER_PADDING; } bufPtr = nextPtr; } } } /* *---------------------------------------------------------------------- * * Tcl_Read -- * * Reads a given number of bytes from a channel. EOL and EOF translation * is done on the bytes being read, so the number of bytes consumed from * the channel may not be equal to the number of bytes stored in the * destination buffer. * * No encoding conversions are applied to the bytes being read. * * Results: * The number of bytes read, or -1 on error. Use Tcl_GetErrno() to * retrieve the error code for the error that occurred. * * Side effects: * May cause input to be buffered. * *---------------------------------------------------------------------- */ int Tcl_Read( Tcl_Channel chan, /* The channel from which to read. */ char *dst, /* Where to store input read. */ int bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { return -1; } return DoRead(chanPtr, dst, bytesToRead, 0); } /* *---------------------------------------------------------------------- * * Tcl_ReadRaw -- * * Reads a given number of bytes from a channel. EOL and EOF translation * is done on the bytes being read, so the number of bytes consumed from * the channel may not be equal to the number of bytes stored in the * destination buffer. * * No encoding conversions are applied to the bytes being read. * * Results: * The number of bytes read, or -1 on error. Use Tcl_GetErrno() to * retrieve the error code for the error that occurred. * * Side effects: * May cause input to be buffered. * *---------------------------------------------------------------------- */ int Tcl_ReadRaw( Tcl_Channel chan, /* The channel from which to read. */ char *readBuf, /* Where to store input read. */ int bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ int copied = 0; assert(bytesToRead > 0); if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { return -1; } /* * First read bytes from the push-back buffers. */ while (chanPtr->inQueueHead && bytesToRead > 0) { ChannelBuffer *bufPtr = chanPtr->inQueueHead; int bytesInBuffer = BytesLeft(bufPtr); int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer : bytesToRead; /* * Copy the current chunk into the read buffer. */ memcpy(readBuf, RemovePoint(bufPtr), toCopy); bufPtr->nextRemoved += toCopy; copied += toCopy; readBuf += toCopy; bytesToRead -= toCopy; /* * If the current buffer is empty recycle it. */ if (IsBufferEmpty(bufPtr)) { chanPtr->inQueueHead = bufPtr->nextPtr; if (chanPtr->inQueueHead == NULL) { chanPtr->inQueueTail = NULL; } RecycleBuffer(chanPtr->state, bufPtr, 0); } } /* * Go to the driver only if we got nothing from pushback. Have to do it * this way to avoid EOF mistimings when we consider the ability that EOF * may not be a permanent condition in the driver, and in that case we * have to synchronize. */ if (copied) { return copied; } /* * This test not needed. */ if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); if (nread > 0) { /* * Successful read (short is OK) - add to bytes copied. */ copied += nread; } else if (nread < 0) { /* * An error signaled. If CHANNEL_BLOCKED, then the error is not * real, but an indication of blocked state. In that case, retain * the flag and let caller receive the short read of copied bytes * from the pushback. HOWEVER, if copied==0 bytes from pushback * then repeat signalling the blocked state as an error to caller * so there is no false report of an EOF. When !CHANNEL_BLOCKED, * the error is real and passes on to caller. */ if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { copied = -1; } } else { /* * nread == 0. Driver is at EOF. Let that state filter up. */ } } return copied; } /* *--------------------------------------------------------------------------- * * Tcl_ReadChars -- * * Reads from the channel until the requested number of characters have * been seen, EOF is seen, or the channel would block. EOL and EOF * translation is done. If reading binary data, the raw bytes are wrapped * in a Tcl byte array object. Otherwise, the raw bytes are converted to * UTF-8 using the channel's current encoding and stored in a Tcl string * object. * * Results: * The number of characters read, or -1 on error. Use Tcl_GetErrno() to * retrieve the error code for the error that occurred. * * Side effects: * May cause input to be buffered. * *--------------------------------------------------------------------------- */ int Tcl_ReadChars( Tcl_Channel chan, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ int toRead, /* Maximum number of characters to store, or * -1 to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel * will be appended to the object. Otherwise, * the data will replace the existing contents * of the object. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { /* * Update the notifier state so we don't block while there is still * data in the buffers. */ UpdateInterest(chanPtr); return -1; } return DoReadChars(chanPtr, objPtr, toRead, appendFlag); } /* *--------------------------------------------------------------------------- * * DoReadChars -- * * Reads from the channel until the requested number of characters have * been seen, EOF is seen, or the channel would block. EOL and EOF * translation is done. If reading binary data, the raw bytes are wrapped * in a Tcl byte array object. Otherwise, the raw bytes are converted to * UTF-8 using the channel's current encoding and stored in a Tcl string * object. * * Results: * The number of characters read, or -1 on error. Use Tcl_GetErrno() to * retrieve the error code for the error that occurred. * * Side effects: * May cause input to be buffered. * *--------------------------------------------------------------------------- */ static int DoReadChars( Channel *chanPtr, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ int toRead, /* Maximum number of characters to store, or * -1 to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel * will be appended to the object. Otherwise, * the data will replace the existing contents * of the object. */ { ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; int copied; int result; Tcl_Encoding encoding = statePtr->encoding; int binaryMode; #define UTF_EXPANSION_FACTOR 1024 int factor = UTF_EXPANSION_FACTOR; binaryMode = (encoding == NULL) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); if (appendFlag == 0) { if (binaryMode) { Tcl_SetByteArrayLength(objPtr, 0); } else { Tcl_SetObjLength(objPtr, 0); /* * We're going to access objPtr->bytes directly, so we must ensure * that this is actually a string object (otherwise it might have * been pure Unicode). * * Probably not needed anymore. */ TclGetString(objPtr); } } /* * Early out when next read will see eofchar. * * NOTE: See DoRead for argument that it's a bug (one we're keeping) to * have this escape before the one for zero-char read request. */ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { SetFlag(statePtr, CHANNEL_EOF); assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); return 0; } /* * Special handling for zero-char read request. */ if (toRead == 0) { if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); return 0; } /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); /* * Must clear the BLOCKED|EOF flags here since we check before reading. */ if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; for (copied = 0; (unsigned) toRead > 0; ) { int copiedNow = -1; if (statePtr->inQueueHead != NULL) { if (binaryMode) { copiedNow = ReadBytes(statePtr, objPtr, toRead); } else { copiedNow = ReadChars(statePtr, objPtr, toRead, &factor); } /* * Recycle current buffer if empty. */ bufPtr = statePtr->inQueueHead; if (IsBufferEmpty(bufPtr)) { ChannelBuffer *nextPtr = bufPtr->nextPtr; RecycleBuffer(statePtr, bufPtr, 0); statePtr->inQueueHead = nextPtr; if (nextPtr == NULL) { statePtr->inQueueTail = NULL; } } } if (copiedNow < 0) { if (GotFlag(statePtr, CHANNEL_EOF)) { break; } if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { break; } result = GetInput(chanPtr); if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } if (result != 0) { if (!GotFlag(statePtr, CHANNEL_BLOCKED)) { copied = -1; } break; } } else { copied += copiedNow; toRead -= copiedNow; } } /* * Failure to fill a channel buffer may have left channel reporting a * "blocked" state, but so long as we fulfilled the request here, the * caller does not consider us blocked. */ if (toRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); } /* * Regenerate chanPtr in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } /* * Update the notifier state so we don't block while there is still data * in the buffers. */ assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copied; } /* *--------------------------------------------------------------------------- * * ReadBytes -- * * Reads from the channel until the requested number of bytes have been * seen, EOF is seen, or the channel would block. Bytes from the channel * are stored in objPtr as a ByteArray object. EOL and EOF translation * are done. * * 'bytesToRead' can safely be a very large number because space is only * allocated to hold data read from the channel as needed. * * Results: * The return value is the number of bytes appended to the object, or * -1 to indicate that zero bytes were read due to an EOF. * * Side effects: * The storage of bytes in objPtr can cause (re-)allocation of memory. * *--------------------------------------------------------------------------- */ static int ReadBytes( ChannelState *statePtr, /* State of the channel to read. */ Tcl_Obj *objPtr, /* Input data is appended to this ByteArray * object. Its length is how much space has * been allocated to hold data, not how many * bytes of data have been stored in the * object. */ int bytesToRead) /* Maximum number of bytes to store, or < 0 to * get all available bytes. Bytes are obtained * from the first buffer in the queue - even * if this number is larger than the number of * bytes available in the first buffer, only * the bytes from the first buffer are * returned. */ { ChannelBuffer *bufPtr = statePtr->inQueueHead; int srcLen = BytesLeft(bufPtr); int toRead = bytesToRead>srcLen || bytesToRead<0 ? srcLen : bytesToRead; TclAppendBytesToByteArray(objPtr, (unsigned char *) RemovePoint(bufPtr), toRead); bufPtr->nextRemoved += toRead; return toRead; } /* *--------------------------------------------------------------------------- * * ReadChars -- * * Reads from the channel until the requested number of UTF-8 characters * have been seen, EOF is seen, or the channel would block. Raw bytes * from the channel are converted to UTF-8 and stored in objPtr. EOL and * EOF translation is done. * * 'charsToRead' can safely be a very large number because space is only * allocated to hold data read from the channel as needed. * * 'charsToRead' may *not* be 0. * * Results: * The return value is the number of characters appended to the object, * *offsetPtr is filled with the number of bytes that were appended, and * *factorPtr is filled with the expansion factor used to guess how many * bytes of UTF-8 to allocate to hold N source bytes. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int ReadChars( ChannelState *statePtr, /* State of channel to read. */ Tcl_Obj *objPtr, /* Input data is appended to this object. * objPtr->length is how much space has been * allocated to hold data, not how many bytes * of data have been stored in the object. */ int charsToRead, /* Maximum number of characters to store, or * -1 to get all available characters. * Characters are obtained from the first * buffer in the queue -- even if this number * is larger than the number of characters * available in the first buffer, only the * characters from the first buffer are * returned. The exception is when there is * not any complete character in the first * buffer. In that case, a recursive call * effectively obtains chars from the * second buffer. */ int *factorPtr) /* On input, contains a guess of how many * bytes need to be allocated to hold the * result of converting N source bytes to * UTF-8. On output, contains another guess * based on the data seen so far. */ { Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding : GetBinaryEncoding(); Tcl_EncodingState savedState = statePtr->inputEncodingState; ChannelBuffer *bufPtr = statePtr->inQueueHead; int savedIEFlags = statePtr->inputEncodingFlags; int savedFlags = statePtr->flags; char *dst, *src = RemovePoint(bufPtr); int numBytes, srcLen = BytesLeft(bufPtr); /* * One src byte can yield at most one character. So when the number of * src bytes we plan to read is less than the limit on character count to * be read, clearly we will remain within that limit, and we can use the * value of "srcLen" as a tighter limit for sizing receiving buffers. */ int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead; /* * 'factor' is how much we guess that the bytes in the source buffer will * expand when converted to UTF-8 chars. This guess comes from analyzing * how many characters were produced by the previous pass. */ int factor = *factorPtr; int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; if (dstLimit <= 0) dstLimit = INT_MAX; /* avoid overflow */ (void) TclGetStringFromObj(objPtr, &numBytes); TclAppendUtfToUtf(objPtr, NULL, dstLimit); if (toRead == srcLen) { unsigned int size; dst = TclGetStringStorage(objPtr, &size) + numBytes; dstLimit = size - numBytes; } else { dst = TclGetString(objPtr) + numBytes; } /* * This routine is burdened with satisfying several constraints. It cannot * append more than 'charsToRead` chars onto objPtr. This is measured * after encoding and translation transformations are completed. There is * no precise number of src bytes that can be associated with the limit. * Yet, when we are done, we must know precisely the number of src bytes * that were consumed to produce the appended chars, so that all * subsequent bytes are left in the buffers for future read operations. * * The consequence is that we have no choice but to implement a "trial and * error" approach, where in general we may need to perform * transformations and copies multiple times to achieve a consistent set * of results. This takes the shape of a loop. */ while (1) { int dstDecoded, dstRead, dstWrote, srcRead, numChars, code; int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE; if (charsToRead > 0) { flags |= TCL_ENCODING_CHAR_LIMIT; numChars = charsToRead; } /* * Perform the encoding transformation. Read no more than srcLen * bytes, write no more than dstLimit bytes. * * Some trickiness with encoding flags here. We do not want the end * of a buffer to be treated as the end of all input when the presence * of bytes in a next buffer are already known to exist. This is * checked with an assert() because so far no test case causing the * assertion to be false has been created. The normal operations of * channel reading appear to cause EOF and TCL_ENCODING_END setting to * appear only in situations where there are no further bytes in any * buffers. */ assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0 || (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0); code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen, flags, &statePtr->inputEncodingState, dst, dstLimit, &srcRead, &dstDecoded, &numChars); /* * Perform the translation transformation in place. Read no more than * the dstDecoded bytes the encoding transformation actually produced. * Capture the number of bytes written in dstWrote. Capture the number * of bytes actually consumed in dstRead. */ dstWrote = dstLimit; dstRead = dstDecoded; TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead); if (dstRead < dstDecoded) { /* * The encoding transformation produced bytes that the translation * transformation did not consume. Why did this happen? */ if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) { /* * 1) There's an eof char set on the channel, and * we saw it and stopped translating at that point. * * NOTE the bizarre spec of TranslateInputEOL in this case. * Clearly the eof char had to be read in order to account for * the stopping, but the value of dstRead does not include it. * * Also rather bizarre, our caller can only notice an EOF * condition if we return the value -1 as the number of chars * read. This forces us to perform a 2-call dance where the * first call can read all the chars up to the eof char, and * the second call is solely for consuming the encoded eof * char then pointed at by src so that we can return that * magic -1 value. This seems really wasteful, especially * since the first decoding pass of each call is likely to * decode many bytes beyond that eof char that's all we care * about. */ if (dstRead == 0) { /* * Curious choice in the eof char handling. We leave the * eof char in the buffer. So, no need to compute a proper * srcRead value. At this point, there are no chars before * the eof char in the buffer. */ Tcl_SetObjLength(objPtr, numBytes); return -1; } { /* * There are chars leading the buffer before the eof char. * Adjust the dstLimit so we go back and read only those * and do not encounter the eof char this time. */ dstLimit = dstRead + (TCL_UTF_MAX - 1); statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; continue; } } /* * 2) The other way to read fewer bytes than are decoded is when * the final byte is \r and we're in a CRLF translation mode so * we cannot decide whether to record \r or \n yet. */ assert(dst[dstRead] == '\r'); assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF); if (dstWrote > 0) { /* * There are chars we can read before we hit the bare CR. Go * back with a smaller dstLimit so we get them in the next * pass, compute a matching srcRead, and don't end up back * here in this call. */ dstLimit = dstRead + (TCL_UTF_MAX - 1); statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; continue; } assert(dstWrote == 0); assert(dstRead == 0); /* * We decoded only the bare CR, and we cannot read a translated * char from that alone. We have to know what's next. So why do * we only have the one decoded char? */ if (code != TCL_OK) { int read, decoded, count; char buffer[TCL_UTF_MAX + 1]; /* * Didn't get everything the buffer could offer */ statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0 || 0 == (statePtr->inputEncodingFlags & TCL_ENCODING_END)); Tcl_ExternalToUtf(NULL, encoding, src, srcLen, (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE), &statePtr->inputEncodingState, buffer, sizeof(buffer), &read, &decoded, &count); if (count == 2) { if (buffer[1] == '\n') { /* \r\n translate to \n */ dst[0] = '\n'; bufPtr->nextRemoved += read; } else { dst[0] = '\r'; bufPtr->nextRemoved += srcRead; } statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; Tcl_SetObjLength(objPtr, numBytes + 1); return 1; } } else if (GotFlag(statePtr, CHANNEL_EOF)) { /* * The bare \r is the only char and we will never read a * subsequent char to make the determination. */ dst[0] = '\r'; bufPtr->nextRemoved = bufPtr->nextAdded; Tcl_SetObjLength(objPtr, numBytes + 1); return 1; } /* * Revise the dstRead value so that the numChars calc below * correctly computes zero characters read. */ dstRead = numChars; /* FALL THROUGH - get more data (dstWrote == 0) */ } /* * The translation transformation can only reduce the number of chars * when it converts \r\n into \n. The reduction in the number of chars * is the difference in bytes read and written. */ numChars -= (dstRead - dstWrote); if (charsToRead > 0 && numChars > charsToRead) { /* * TODO: This cannot happen anymore. * * We read more chars than allowed. Reset limits to prevent that * and try again. Don't forget the extra padding of TCL_UTF_MAX * bytes demanded by the Tcl_ExternalToUtf() call! */ dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1); statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; continue; } if (dstWrote == 0) { ChannelBuffer *nextPtr; /* * We were not able to read any chars. */ assert(numChars == 0); /* * There is one situation where this is the correct final result. * If the src buffer contains only a single \n byte, and we are in * TCL_TRANSLATE_AUTO mode, and when the translation pass was made * the INPUT_SAW_CR flag was set on the channel. In that case, the * correct behavior is to consume that \n and produce the empty * string. */ if (dstRead == 1 && dst[0] == '\n') { assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO); goto consume; } /* * Otherwise, reading zero characters indicates there's something * incomplete at the end of the src buffer. Maybe there were not * enough src bytes to decode into a char. Maybe a lone \r could * not be translated (crlf mode). Need to combine any unused src * bytes we have in the first buffer with subsequent bytes to try * again. */ nextPtr = bufPtr->nextPtr; if (nextPtr == NULL) { if (srcLen > 0) { SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); } Tcl_SetObjLength(objPtr, numBytes); return -1; } /* * Space is made at the beginning of the buffer to copy the * previous unused bytes there. Check first if the buffer we are * using actually has enough space at its beginning for the data * we are copying. Because if not we will write over the buffer * management information, especially the 'nextPtr'. * * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used * to prevent exactly this situation. I.e. it should never happen. * Therefore it is ok to panic should it happen despite the * precautions. */ if (nextPtr->nextRemoved < srcLen) { Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough"); } nextPtr->nextRemoved -= srcLen; memcpy(RemovePoint(nextPtr), src, srcLen); RecycleBuffer(statePtr, bufPtr, 0); statePtr->inQueueHead = nextPtr; Tcl_SetObjLength(objPtr, numBytes); return ReadChars(statePtr, objPtr, charsToRead, factorPtr); } statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; consume: bufPtr->nextRemoved += srcRead; /* * If this read contained multibyte characters, revise factorPtr so * the next read will allocate bigger buffers. */ if (numChars && numChars < srcRead) { *factorPtr = srcRead * UTF_EXPANSION_FACTOR / numChars; } Tcl_SetObjLength(objPtr, numBytes + dstWrote); return numChars; } } /* *--------------------------------------------------------------------------- * * TranslateInputEOL -- * * Perform input EOL and EOF translation on the source buffer, leaving * the translated result in the destination buffer. * * Results: * The return value is 1 if the EOF character was found when copying * bytes to the destination buffer, 0 otherwise. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static void TranslateInputEOL( ChannelState *statePtr, /* Channel being read, for EOL translation and * EOF character. */ char *dstStart, /* Output buffer filled with chars by applying * appropriate EOL translation to source * characters. */ const char *srcStart, /* Source characters. */ int *dstLenPtr, /* On entry, the maximum length of output * buffer in bytes. On exit, the number of * bytes actually used in output buffer. */ int *srcLenPtr) /* On entry, the length of source buffer. On * exit, the number of bytes read from the * source buffer. */ { const char *eof = NULL; int dstLen = *dstLenPtr; int srcLen = *srcLenPtr; int inEofChar = statePtr->inEofChar; /* * Depending on the translation mode in use, there's no need to scan more * srcLen bytes at srcStart than can possibly transform to dstLen bytes. * This keeps the scan for eof char below from being pointlessly long. */ switch (statePtr->inputTranslation) { case TCL_TRANSLATE_LF: case TCL_TRANSLATE_CR: if (srcLen > dstLen) { /* * In these modes, each src byte become a dst byte. */ srcLen = dstLen; } break; default: /* * In other modes, at most 2 src bytes become a dst byte. */ if (srcLen/2 > dstLen) { srcLen = 2 * dstLen; } break; } if (inEofChar != '\0') { /* * Make sure we do not read past any logical end of channel input * created by the presence of the input eof char. */ if ((eof = (const char *)memchr(srcStart, inEofChar, srcLen))) { srcLen = eof - srcStart; } } switch (statePtr->inputTranslation) { case TCL_TRANSLATE_LF: case TCL_TRANSLATE_CR: if (dstStart != srcStart) { memcpy(dstStart, srcStart, srcLen); } if (statePtr->inputTranslation == TCL_TRANSLATE_CR) { char *dst = dstStart; char *dstEnd = dstStart + srcLen; while ((dst = (char *)memchr(dst, '\r', dstEnd - dst))) { *dst++ = '\n'; } } dstLen = srcLen; break; case TCL_TRANSLATE_CRLF: { const char *crFound, *src = srcStart; char *dst = dstStart; int lesser = (dstLen < srcLen) ? dstLen : srcLen; while ((crFound = (const char *)memchr(src, '\r', lesser))) { int numBytes = crFound - src; memmove(dst, src, numBytes); dst += numBytes; dstLen -= numBytes; src += numBytes; srcLen -= numBytes; if (srcLen == 1) { /* valid src bytes end in \r */ if (eof) { *dst++ = '\r'; src++; srcLen--; } else { lesser = 0; break; } } else if (src[1] == '\n') { *dst++ = '\n'; src += 2; srcLen -= 2; } else { *dst++ = '\r'; src++; srcLen--; } dstLen--; lesser = (dstLen < srcLen) ? dstLen : srcLen; } memmove(dst, src, lesser); srcLen = src + lesser - srcStart; dstLen = dst + lesser - dstStart; break; } case TCL_TRANSLATE_AUTO: { const char *crFound, *src = srcStart; char *dst = dstStart; int lesser; if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) { if (*src == '\n') { src++; srcLen--; } ResetFlag(statePtr, INPUT_SAW_CR); } lesser = (dstLen < srcLen) ? dstLen : srcLen; while ((crFound = (const char *)memchr(src, '\r', lesser))) { int numBytes = crFound - src; memmove(dst, src, numBytes); dst[numBytes] = '\n'; dst += numBytes + 1; dstLen -= numBytes + 1; src += numBytes + 1; srcLen -= numBytes + 1; if (srcLen == 0) { SetFlag(statePtr, INPUT_SAW_CR); } else if (*src == '\n') { src++; srcLen--; } lesser = (dstLen < srcLen) ? dstLen : srcLen; } memmove(dst, src, lesser); srcLen = src + lesser - srcStart; dstLen = dst + lesser - dstStart; break; } default: Tcl_Panic("unknown input translation %d", statePtr->inputTranslation); } *dstLenPtr = dstLen; *srcLenPtr = srcLen; if (srcStart + srcLen == eof) { /* * EOF character was seen in EOL translated range. Leave current file * position pointing at the EOF character, but don't store the EOF * character in the output string. */ SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } } /* *---------------------------------------------------------------------- * * Tcl_Ungets -- * * Causes the supplied string to be added to the input queue of the * channel, at either the head or tail of the queue. * * Results: * The number of bytes stored in the channel, or -1 on error. * * Side effects: * Adds input to the input queue of a channel. * *---------------------------------------------------------------------- */ int Tcl_Ungets( Tcl_Channel chan, /* The channel for which to add the input. */ const char *str, /* The input itself. */ int len, /* The length of the input. */ int atEnd) /* If non-zero, add at end of queue; otherwise * add at head of queue. */ { Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of actual channel. */ ChannelBuffer *bufPtr; /* Buffer to contain the data. */ int flags; chanPtr = (Channel *) chan; statePtr = chanPtr->state; /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; /* * CheckChannelErrors clears too many flag bits in this one case. */ flags = statePtr->flags; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { len = -1; goto done; } statePtr->flags = flags; /* * Clear the EOF flags, and clear the BLOCKED bit. */ if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; bufPtr = AllocChannelBuffer(len); memcpy(InsertPoint(bufPtr), str, len); bufPtr->nextAdded += len; if (statePtr->inQueueHead == NULL) { bufPtr->nextPtr = NULL; statePtr->inQueueHead = bufPtr; statePtr->inQueueTail = bufPtr; } else if (atEnd) { bufPtr->nextPtr = NULL; statePtr->inQueueTail->nextPtr = bufPtr; statePtr->inQueueTail = bufPtr; } else { bufPtr->nextPtr = statePtr->inQueueHead; statePtr->inQueueHead = bufPtr; } /* * Update the notifier state so we don't block while there is still data * in the buffers. */ done: UpdateInterest(chanPtr); return len; } /* *---------------------------------------------------------------------- * * Tcl_Flush -- * * Flushes output data on a channel. * * Results: * A standard Tcl result. * * Side effects: * May flush output queued on this channel. * *---------------------------------------------------------------------- */ int Tcl_Flush( Tcl_Channel chan) /* The Channel to flush. */ { int result; /* Of calling FlushChannel. */ Channel *chanPtr = (Channel *) chan; /* The actual channel. */ ChannelState *statePtr = chanPtr->state; /* State of actual channel. */ /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { return TCL_ERROR; } result = FlushChannel(NULL, chanPtr, 0); if (result != 0) { return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * DiscardInputQueued -- * * Discards any input read from the channel but not yet consumed by Tcl * reading commands. * * Results: * None. * * Side effects: * May discard input from the channel. If discardLastBuffer is zero, * leaves one buffer in place for back-filling. * *---------------------------------------------------------------------- */ static void DiscardInputQueued( ChannelState *statePtr, /* Channel on which to discard the queued * input. */ int discardSavedBuffers) /* If non-zero, discard all buffers including * last one. */ { ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */ bufPtr = statePtr->inQueueHead; statePtr->inQueueHead = NULL; statePtr->inQueueTail = NULL; for (; bufPtr != NULL; bufPtr = nxtPtr) { nxtPtr = bufPtr->nextPtr; RecycleBuffer(statePtr, bufPtr, discardSavedBuffers); } /* * If discardSavedBuffers is nonzero, must also discard any previously * saved buffer in the saveInBufPtr field. */ if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) { ReleaseChannelBuffer(statePtr->saveInBufPtr); statePtr->saveInBufPtr = NULL; } } /* *--------------------------------------------------------------------------- * * GetInput -- * * Reads input data from a device into a channel buffer. * * IMPORTANT! This routine is only called on a chanPtr argument * that is the top channel of a stack! * * Results: * The return value is the Posix error code if an error occurred while * reading from the file, or 0 otherwise. * * Side effects: * Reads from the underlying device. * *--------------------------------------------------------------------------- */ static int GetInput( Channel *chanPtr) /* Channel to read input from. */ { int toRead; /* How much to read? */ int result; /* Of calling driver. */ int nread; /* How much was read from channel? */ ChannelBuffer *bufPtr; /* New buffer to add to input queue. */ ChannelState *statePtr = chanPtr->state; /* State info for channel */ /* * Verify that all callers know better than to call us when * it's recorded that the next char waiting to be read is the * eofchar. */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); /* * Prevent reading from a dead channel -- a channel that has been closed * but not yet deallocated, which can happen if the exit handler for * channel cleanup has run but the channel is still registered in some * interpreter. */ if (CheckForDeadChannel(NULL, statePtr)) { return EINVAL; } /* * WARNING: There was once a comment here claiming that it was * a bad idea to make another call to the inputproc of a channel * driver when EOF has already been detected on the channel. Through * much of Tcl's history, this warning was then completely negated * by having all (most?) read paths clear the EOF setting before * reaching here. So we had a guard that was never triggered. * * Don't be tempted to restore the guard. Even if EOF is set on * the channel, continue through and call the inputproc again. This * is the way to enable the ability to [read] again beyond the EOF, * which seems a strange thing to do, but for which use cases exist * [Tcl Bug 5adc350683] and which may even be essential for channels * representing things like ttys or other devices where the stream * might take the logical form of a series of 'files' separated by * an EOF condition. */ /* * First check for more buffers in the pushback area of the topmost * channel in the stack and use them. They can be the result of a * transformation which went away without reading all the information * placed in the area when it was stacked. */ if (chanPtr->inQueueHead != NULL) { /* TODO: Tests to cover this. */ assert(statePtr->inQueueHead == NULL); statePtr->inQueueHead = chanPtr->inQueueHead; statePtr->inQueueTail = chanPtr->inQueueTail; chanPtr->inQueueHead = NULL; chanPtr->inQueueTail = NULL; return 0; } /* * Nothing in the pushback area, fall back to the usual handling (driver, * etc.) */ /* * See if we can fill an existing buffer. If we can, read only as much as * will fit in it. Otherwise allocate a new buffer, add it to the input * queue and attempt to fill it to the max. */ bufPtr = statePtr->inQueueTail; if ((bufPtr == NULL) || IsBufferFull(bufPtr)) { bufPtr = statePtr->saveInBufPtr; statePtr->saveInBufPtr = NULL; /* * Check the actual buffersize against the requested buffersize. * Saved buffers of the wrong size are squashed. This is done to honor * dynamic changes of the buffersize made by the user. * * TODO: Tests to cover this. */ if ((bufPtr != NULL) && (bufPtr->bufLength != statePtr->bufSize + BUFFER_PADDING)) { ReleaseChannelBuffer(bufPtr); bufPtr = NULL; } if (bufPtr == NULL) { bufPtr = AllocChannelBuffer(statePtr->bufSize); } bufPtr->nextPtr = NULL; toRead = SpaceLeft(bufPtr); assert(toRead == statePtr->bufSize); if (statePtr->inQueueTail == NULL) { statePtr->inQueueHead = bufPtr; } else { statePtr->inQueueTail->nextPtr = bufPtr; } statePtr->inQueueTail = bufPtr; } else { toRead = SpaceLeft(bufPtr); } PreserveChannelBuffer(bufPtr); nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead); if (nread < 0) { result = Tcl_GetErrno(); } else { result = 0; bufPtr->nextAdded += nread; } ReleaseChannelBuffer(bufPtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_Seek -- * * Implements seeking on Tcl Channels. This is a public function so that * other C facilities may be implemented on top of it. * * Results: * The new access point or -1 on error. If error, use Tcl_GetErrno() to * retrieve the POSIX error code for the error that occurred. * * Side effects: * May flush output on the channel. May discard queued input. * *---------------------------------------------------------------------- */ Tcl_WideInt Tcl_Seek( Tcl_Channel chan, /* The channel on which to seek. */ Tcl_WideInt offset, /* Offset to seek to. */ int mode) /* Relative to which location to seek? */ { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* State info for channel */ int inputBuffered, outputBuffered; /* # bytes held in buffers. */ int result; /* Of device driver operations. */ Tcl_WideInt curPos; /* Position on the device. */ int wasAsync; /* Was the channel nonblocking before the seek * operation? If so, must restore to * non-blocking mode after the seek. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { return -1; } /* * Disallow seek on dead channels - channels that have been closed but not * yet been deallocated. Such channels can be found if the exit handler * for channel cleanup has run but the channel is still registered in an * interpreter. */ if (CheckForDeadChannel(NULL, statePtr)) { return -1; } /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; /* * Disallow seek on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) { Tcl_SetErrno(EINVAL); return -1; } /* * Compute how much input and output is buffered. If both input and output * is buffered, cannot compute the current position. */ inputBuffered = Tcl_InputBuffered(chan); outputBuffered = Tcl_OutputBuffered(chan); if ((inputBuffered != 0) && (outputBuffered != 0)) { Tcl_SetErrno(EFAULT); return -1; } /* * If we are seeking relative to the current position, compute the * corrected offset taking into account the amount of unread input. */ if (mode == SEEK_CUR) { offset -= inputBuffered; } /* * Discard any queued input - this input should not be read after the * seek. */ DiscardInputQueued(statePtr, 0); /* * Reset EOF and BLOCKED flags. We invalidate them by moving the access * point. Also clear CR related flags. */ if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; /* * If the channel is in asynchronous output mode, switch it back to * synchronous mode and cancel any async flush that may be scheduled. * After the flush, the channel will be put back into asynchronous output * mode. */ wasAsync = 0; if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { wasAsync = 1; result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING); if (result != 0) { return -1; } ResetFlag(statePtr, CHANNEL_NONBLOCKING); if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); } } /* * If the flush fails we cannot recover the original position. In that * case the seek is not attempted because we do not know where the access * position is - instead we return the error. FlushChannel has already * called Tcl_SetErrno() to report the error upwards. If the flush * succeeds we do the seek also. */ if (FlushChannel(NULL, chanPtr, 0) != 0) { curPos = -1; } else { /* * Now seek to the new position in the channel as requested by the * caller. */ curPos = ChanSeek(chanPtr, offset, mode, &result); if (curPos == -1) { Tcl_SetErrno(result); } } /* * Restore to nonblocking mode if that was the previous behavior. * * NOTE: Even if there was an async flush active we do not restore it now * because we already flushed all the queued output, above. */ if (wasAsync) { SetFlag(statePtr, CHANNEL_NONBLOCKING); result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING); if (result != 0) { return -1; } } return curPos; } /* *---------------------------------------------------------------------- * * Tcl_Tell -- * * Returns the position of the next character to be read/written on this * channel. * * Results: * A nonnegative integer on success, -1 on failure. If failed, use * Tcl_GetErrno() to retrieve the POSIX error code for the error that * occurred. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_WideInt Tcl_Tell( Tcl_Channel chan) /* The channel to return pos for. */ { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* State info for channel */ int inputBuffered, outputBuffered; /* # bytes held in buffers. */ int result; /* Of calling device driver. */ Tcl_WideInt curPos; /* Position on device. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { return -1; } /* * Disallow tell on dead channels -- channels that have been closed but * not yet been deallocated. Such channels can be found if the exit * handler for channel cleanup has run but the channel is still registered * in an interpreter. */ if (CheckForDeadChannel(NULL, statePtr)) { return -1; } /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; /* * Disallow tell on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) { Tcl_SetErrno(EINVAL); return -1; } /* * Compute how much input and output is buffered. If both input and output * is buffered, cannot compute the current position. */ inputBuffered = Tcl_InputBuffered(chan); outputBuffered = Tcl_OutputBuffered(chan); /* * Get the current position in the device and compute the position where * the next character will be read or written. Note that we prefer the * wideSeekProc if that is available and non-NULL... */ curPos = ChanSeek(chanPtr, 0, SEEK_CUR, &result); if (curPos == -1) { Tcl_SetErrno(result); return -1; } if (inputBuffered != 0) { return curPos - inputBuffered; } return curPos + outputBuffered; } /* *--------------------------------------------------------------------------- * * Tcl_SeekOld, Tcl_TellOld -- * * Backward-compatibility versions of the seek/tell interface that do not * support 64-bit offsets. This interface is not documented or expected * to be supported indefinitely. * * Results: * As for Tcl_Seek and Tcl_Tell respectively, except truncated to * whatever value will fit in an 'int'. * * Side effects: * As for Tcl_Seek and Tcl_Tell respectively. * *--------------------------------------------------------------------------- */ int Tcl_SeekOld( Tcl_Channel chan, /* The channel on which to seek. */ int offset, /* Offset to seek to. */ int mode) /* Relative to which location to seek? */ { Tcl_WideInt wOffset, wResult; wOffset = Tcl_LongAsWide((long) offset); wResult = Tcl_Seek(chan, wOffset, mode); return (int) Tcl_WideAsLong(wResult); } int Tcl_TellOld( Tcl_Channel chan) /* The channel to return pos for. */ { Tcl_WideInt wResult = Tcl_Tell(chan); return (int) Tcl_WideAsLong(wResult); } /* *--------------------------------------------------------------------------- * * Tcl_TruncateChannel -- * * Truncate a channel to the given length. * * Results: * TCL_OK on success, TCL_ERROR if the operation failed (e.g., is not * supported by the type of channel, or the underlying OS operation * failed in some way). * * Side effects: * Seeks the channel to the current location. Sets errno on OS error. * *--------------------------------------------------------------------------- */ int Tcl_TruncateChannel( Tcl_Channel chan, /* Channel to truncate. */ Tcl_WideInt length) /* Length to truncate it to. */ { Channel *chanPtr = (Channel *) chan; Tcl_DriverTruncateProc *truncateProc = Tcl_ChannelTruncateProc(chanPtr->typePtr); int result; if (truncateProc == NULL) { /* * Feature not supported and it's not emulatable. Pretend it's * returned an EINVAL, a very generic error! */ Tcl_SetErrno(EINVAL); return TCL_ERROR; } if (!GotFlag(chanPtr->state, TCL_WRITABLE)) { /* * We require that the file was opened of writing. Do that check now * so that we only flush if we think we're going to succeed. */ Tcl_SetErrno(EINVAL); return TCL_ERROR; } /* * Seek first to force a total flush of all pending buffers and ditch any * preread input data. */ WillWrite(chanPtr); if (WillRead(chanPtr) < 0) { return TCL_ERROR; } /* * We're all flushed to disk now and we also don't have any unfortunate * input baggage around either; can truncate with impunity. */ result = truncateProc(chanPtr->instanceData, length); if (result != 0) { Tcl_SetErrno(result); return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * CheckChannelErrors -- * * See if the channel is in an ready state and can perform the desired * operation. * * Results: * The return value is 0 if the channel is OK, otherwise the return value * is -1 and errno is set to indicate the error. * * Side effects: * May clear the EOF and/or BLOCKED bits if reading from channel. * *--------------------------------------------------------------------------- */ static int CheckChannelErrors( ChannelState *statePtr, /* Channel to check. */ int flags) /* Test if channel supports desired operation: * TCL_READABLE, TCL_WRITABLE. Also indicates * Raw read or write for special close * processing */ { int direction = flags & (TCL_READABLE|TCL_WRITABLE); /* * Check for unreported error. */ if (statePtr->unreportedError != 0) { Tcl_SetErrno(statePtr->unreportedError); statePtr->unreportedError = 0; /* * TIP #219, Tcl Channel Reflection API. * Move a deferred error message back into the channel bypass. */ if (statePtr->chanMsg != NULL) { TclDecrRefCount(statePtr->chanMsg); } statePtr->chanMsg = statePtr->unreportedMsg; statePtr->unreportedMsg = NULL; return -1; } /* * Only the raw read and write operations are allowed during close in * order to drain data from stacked channels. */ if (GotFlag(statePtr, CHANNEL_CLOSED) && !(flags & CHANNEL_RAW_MODE)) { Tcl_SetErrno(EACCES); return -1; } /* * Fail if the channel is not opened for desired operation. */ if (GotFlag(statePtr, direction) == 0) { Tcl_SetErrno(EACCES); return -1; } /* * Fail if the channel is in the middle of a background copy. * * Don't do this tests for raw channels here or else the chaining in the * transformation drivers will fail with 'file busy' error instead of * retrieving and transforming the data to copy. */ if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) { Tcl_SetErrno(EBUSY); return -1; } if (direction == TCL_READABLE) { ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA); } return 0; } /* *---------------------------------------------------------------------- * * Tcl_Eof -- * * Returns 1 if the channel is at EOF, 0 otherwise. * * Results: * 1 or 0, always. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_Eof( Tcl_Channel chan) /* Does this channel have EOF? */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } /* *---------------------------------------------------------------------- * * Tcl_InputBlocked -- * * Returns 1 if input is blocked on this channel, 0 otherwise. * * Results: * 0 or 1, always. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_InputBlocked( Tcl_Channel chan) /* Is this channel blocked? */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ return GotFlag(statePtr, CHANNEL_BLOCKED) ? 1 : 0; } /* *---------------------------------------------------------------------- * * Tcl_InputBuffered -- * * Returns the number of bytes of input currently buffered in the common * internal buffer of a channel. * * Results: * The number of input bytes buffered, or zero if the channel is not open * for reading. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_InputBuffered( Tcl_Channel chan) /* The channel to query. */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ ChannelBuffer *bufPtr; int bytesBuffered; for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } /* * Remember the bytes in the topmost pushback area. */ for (bufPtr = statePtr->topChanPtr->inQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } return bytesBuffered; } /* *---------------------------------------------------------------------- * * Tcl_OutputBuffered -- * * Returns the number of bytes of output currently buffered in the common * internal buffer of a channel. * * Results: * The number of output bytes buffered, or zero if the channel is not open * for writing. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_OutputBuffered( Tcl_Channel chan) /* The channel to query. */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ ChannelBuffer *bufPtr; int bytesBuffered; for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } if (statePtr->curOutPtr != NULL) { ChannelBuffer *curOutPtr = statePtr->curOutPtr; if (IsBufferReady(curOutPtr)) { bytesBuffered += BytesLeft(curOutPtr); } } return bytesBuffered; } /* *---------------------------------------------------------------------- * * Tcl_ChannelBuffered -- * * Returns the number of bytes of input currently buffered in the * internal buffer (push back area) of a channel. * * Results: * The number of input bytes buffered, or zero if the channel is not open * for reading. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_ChannelBuffered( Tcl_Channel chan) /* The channel to query. */ { Channel *chanPtr = (Channel *) chan; /* Real channel structure. */ ChannelBuffer *bufPtr; int bytesBuffered = 0; for (bufPtr = chanPtr->inQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } return bytesBuffered; } /* *---------------------------------------------------------------------- * * Tcl_SetChannelBufferSize -- * * Sets the size of buffers to allocate to store input or output in the * channel. The size must be between 1 byte and 1 MByte. * * Results: * None. * * Side effects: * Sets the size of buffers subsequently allocated for this channel. * *---------------------------------------------------------------------- */ void Tcl_SetChannelBufferSize( Tcl_Channel chan, /* The channel whose buffer size to set. */ int sz) /* The size to set. */ { ChannelState *statePtr; /* State of real channel structure. */ /* * Clip the buffer size to force it into the [1,1M] range */ if (sz < 1) { sz = 1; } else if (sz > MAX_CHANNEL_BUFFER_SIZE) { sz = MAX_CHANNEL_BUFFER_SIZE; } statePtr = ((Channel *) chan)->state; if (statePtr->bufSize == sz) { return; } statePtr->bufSize = sz; /* * If bufsize changes, need to get rid of old utility buffer. */ if (statePtr->saveInBufPtr != NULL) { RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1); statePtr->saveInBufPtr = NULL; } if ((statePtr->inQueueHead != NULL) && (statePtr->inQueueHead->nextPtr == NULL) && IsBufferEmpty(statePtr->inQueueHead)) { RecycleBuffer(statePtr, statePtr->inQueueHead, 1); statePtr->inQueueHead = NULL; statePtr->inQueueTail = NULL; } } /* *---------------------------------------------------------------------- * * Tcl_GetChannelBufferSize -- * * Retrieves the size of buffers to allocate for this channel. * * Results: * The size. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetChannelBufferSize( Tcl_Channel chan) /* The channel for which to find the buffer * size. */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ return statePtr->bufSize; } /* *---------------------------------------------------------------------- * * Tcl_BadChannelOption -- * * This procedure generates a "bad option" error message in an (optional) * interpreter. It is used by channel drivers when a invalid Set/Get * option is requested. Its purpose is to concatenate the generic options * list to the specific ones and factorize the generic options error * message string. * * Results: * TCL_ERROR. * * Side effects: * An error message is generated in interp's result object to indicate * that a command was invoked with a bad option. The message has the * form: * bad option "blah": should be one of * <...generic options...>+<...specific options...> * "blah" is the optionName argument and "" is a space * separated list of specific option words. The function takes good care * of inserting minus signs before each option, commas after, and an "or" * before the last option. * *---------------------------------------------------------------------- */ int Tcl_BadChannelOption( Tcl_Interp *interp, /* Current interpreter (can be NULL).*/ const char *optionName, /* 'bad option' name */ const char *optionList) /* Specific options list to append to the * standard generic options. Can be NULL for * generic options only. */ { if (interp != NULL) { const char *genericopt = "blocking buffering buffersize encoding eofchar translation"; const char **argv; int argc, i; Tcl_DString ds; Tcl_Obj *errObj; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { TclDStringAppendLiteral(&ds, " "); Tcl_DStringAppend(&ds, optionList, -1); } if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), &argc, &argv) != TCL_OK) { Tcl_Panic("malformed option list in channel driver"); } Tcl_ResetResult(interp); errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ", optionName ? optionName : ""); argc--; for (i = 0; i < argc; i++) { Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]); } Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]); Tcl_SetObjResult(interp, errObj); Tcl_DStringFree(&ds); ckfree(argv); } Tcl_SetErrno(EINVAL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelOption -- * * Gets a mode associated with an IO channel. If the optionName arg is * non NULL, retrieves the value of that option. If the optionName arg is * NULL, retrieves a list of alternating option names and values for the * given channel. * * Results: * A standard Tcl result. Also sets the supplied DString to the string * value of the option(s) returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetChannelOption( Tcl_Interp *interp, /* For error reporting - can be NULL. */ Tcl_Channel chan, /* Channel on which to get option. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { size_t len; /* Length of optionName string. */ char optionVal[128]; /* Buffer for snprintf. */ Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ int flags; /* * Disallow options on dead channels -- channels that have been closed but * not yet been deallocated. Such channels can be found if the exit * handler for channel cleanup has run but the channel is still registered * in an interpreter. */ if (CheckForDeadChannel(interp, statePtr)) { return TCL_ERROR; } /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; /* * If we are in the middle of a background copy, use the saved flags. */ if (statePtr->csPtrR) { flags = statePtr->csPtrR->readFlags; } else if (statePtr->csPtrW) { flags = statePtr->csPtrW->writeFlags; } else { flags = statePtr->flags; } /* * If the optionName is NULL it means that we want a list of all options * and values. */ if (optionName == NULL) { len = 0; } else { len = strlen(optionName); } if (len == 0 || HaveOpt(2, "-blocking")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-blocking"); } Tcl_DStringAppendElement(dsPtr, (flags & CHANNEL_NONBLOCKING) ? "0" : "1"); if (len > 0) { return TCL_OK; } } if (len == 0 || HaveOpt(7, "-buffering")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-buffering"); } if (flags & CHANNEL_LINEBUFFERED) { Tcl_DStringAppendElement(dsPtr, "line"); } else if (flags & CHANNEL_UNBUFFERED) { Tcl_DStringAppendElement(dsPtr, "none"); } else { Tcl_DStringAppendElement(dsPtr, "full"); } if (len > 0) { return TCL_OK; } } if (len == 0 || HaveOpt(7, "-buffersize")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-buffersize"); } TclFormatInt(optionVal, statePtr->bufSize); Tcl_DStringAppendElement(dsPtr, optionVal); if (len > 0) { return TCL_OK; } } if (len == 0 || HaveOpt(2, "-encoding")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-encoding"); } if (statePtr->encoding == NULL) { Tcl_DStringAppendElement(dsPtr, "binary"); } else { Tcl_DStringAppendElement(dsPtr, Tcl_GetEncodingName(statePtr->encoding)); } if (len > 0) { return TCL_OK; } } if (len == 0 || HaveOpt(2, "-eofchar")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-eofchar"); } if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { Tcl_DStringStartSublist(dsPtr); } if (flags & TCL_READABLE) { if (statePtr->inEofChar == 0) { Tcl_DStringAppendElement(dsPtr, ""); } else { char buf[2]; buf[1] = '\0'; buf[0] = statePtr->inEofChar; Tcl_DStringAppendElement(dsPtr, buf); } } if (flags & TCL_WRITABLE) { if (statePtr->outEofChar == 0) { Tcl_DStringAppendElement(dsPtr, ""); } else { char buf[2]; buf[1] = '\0'; buf[0] = statePtr->outEofChar; Tcl_DStringAppendElement(dsPtr, buf); } } if (!(flags & (TCL_READABLE|TCL_WRITABLE))) { /* * Not readable or writable (e.g. server socket) */ Tcl_DStringAppendElement(dsPtr, ""); } if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { Tcl_DStringEndSublist(dsPtr); } if (len > 0) { return TCL_OK; } } if (len == 0 || HaveOpt(1, "-translation")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-translation"); } if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { Tcl_DStringStartSublist(dsPtr); } if (flags & TCL_READABLE) { if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) { Tcl_DStringAppendElement(dsPtr, "auto"); } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) { Tcl_DStringAppendElement(dsPtr, "cr"); } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) { Tcl_DStringAppendElement(dsPtr, "crlf"); } else { Tcl_DStringAppendElement(dsPtr, "lf"); } } if (flags & TCL_WRITABLE) { if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) { Tcl_DStringAppendElement(dsPtr, "auto"); } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) { Tcl_DStringAppendElement(dsPtr, "cr"); } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) { Tcl_DStringAppendElement(dsPtr, "crlf"); } else { Tcl_DStringAppendElement(dsPtr, "lf"); } } if (!(flags & (TCL_READABLE|TCL_WRITABLE))) { /* * Not readable or writable (e.g. server socket) */ Tcl_DStringAppendElement(dsPtr, "auto"); } if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { Tcl_DStringEndSublist(dsPtr); } if (len > 0) { return TCL_OK; } } if (chanPtr->typePtr->getOptionProc != NULL) { /* * Let the driver specific handle additional options and result code * and message. */ return chanPtr->typePtr->getOptionProc(chanPtr->instanceData, interp, optionName, dsPtr); } else { /* * No driver specific options case. */ if (len == 0) { return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, NULL); } } /* *--------------------------------------------------------------------------- * * Tcl_SetChannelOption -- * * Sets an option on a channel. * * Results: * A standard Tcl result. On error, sets interp's result object if * interp is not NULL. * * Side effects: * May modify an option on a device. * *--------------------------------------------------------------------------- */ int Tcl_SetChannelOption( Tcl_Interp *interp, /* For error reporting - can be NULL. */ Tcl_Channel chan, /* Channel on which to set mode. */ const char *optionName, /* Which option to set? */ const char *newValue) /* New value for option. */ { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* State info for channel */ size_t len; /* Length of optionName string. */ int argc; const char **argv; /* * If the channel is in the middle of a background copy, fail. */ if (statePtr->csPtrR || statePtr->csPtrW) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unable to set channel options: background copy in" " progress", -1)); } return TCL_ERROR; } /* * Disallow options on dead channels -- channels that have been closed but * not yet been deallocated. Such channels can be found if the exit * handler for channel cleanup has run but the channel is still registered * in an interpreter. */ if (CheckForDeadChannel(NULL, statePtr)) { return TCL_ERROR; } /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; len = strlen(optionName); if (HaveOpt(2, "-blocking")) { int newMode; if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) { return TCL_ERROR; } if (newMode) { newMode = TCL_MODE_BLOCKING; } else { newMode = TCL_MODE_NONBLOCKING; } return SetBlockMode(interp, chanPtr, newMode); } else if (HaveOpt(7, "-buffering")) { len = strlen(newValue); if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) { ResetFlag(statePtr, CHANNEL_UNBUFFERED | CHANNEL_LINEBUFFERED); } else if ((newValue[0] == 'l') && (strncmp(newValue, "line", len) == 0)) { ResetFlag(statePtr, CHANNEL_UNBUFFERED); SetFlag(statePtr, CHANNEL_LINEBUFFERED); } else if ((newValue[0] == 'n') && (strncmp(newValue, "none", len) == 0)) { ResetFlag(statePtr, CHANNEL_LINEBUFFERED); SetFlag(statePtr, CHANNEL_UNBUFFERED); } else if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -buffering: must be one of" " full, line, or none", -1)); return TCL_ERROR; } return TCL_OK; } else if (HaveOpt(7, "-buffersize")) { int newBufferSize; if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) { return TCL_ERROR; } Tcl_SetChannelBufferSize(chan, newBufferSize); return TCL_OK; } else if (HaveOpt(2, "-encoding")) { Tcl_Encoding encoding; if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { encoding = NULL; } else { encoding = Tcl_GetEncoding(interp, newValue); if (encoding == NULL) { return TCL_ERROR; } } /* * When the channel has an escape sequence driven encoding such as * iso2022, the terminated escape sequence must write to the buffer. */ if ((statePtr->encoding != NULL) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START) && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { statePtr->outputEncodingFlags |= TCL_ENCODING_END; WriteChars(chanPtr, "", 0); } Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = encoding; statePtr->inputEncodingState = NULL; statePtr->inputEncodingFlags = TCL_ENCODING_START; statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA); UpdateInterest(chanPtr); return TCL_OK; } else if (HaveOpt(2, "-eofchar")) { if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if (argc == 0) { statePtr->inEofChar = 0; statePtr->outEofChar = 0; } else if (argc == 1 || argc == 2) { int outIndex = (argc - 1); int inValue = (int) argv[0][0]; int outValue = (int) argv[outIndex][0]; if (inValue & 0x80 || outValue & 0x80) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -eofchar: must be non-NUL ASCII" " character", -1)); } ckfree(argv); return TCL_ERROR; } if (GotFlag(statePtr, TCL_READABLE)) { statePtr->inEofChar = inValue; } if (GotFlag(statePtr, TCL_WRITABLE)) { statePtr->outEofChar = outValue; } } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -eofchar: should be a list of zero," " one, or two elements", -1)); } ckfree(argv); return TCL_ERROR; } if (argv != NULL) { ckfree(argv); } /* * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character * which signals eof can transform a current eof condition into a 'go * ahead'. Ditto for blocked. */ if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; return TCL_OK; } else if (HaveOpt(1, "-translation")) { const char *readMode, *writeMode; if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if (argc == 1) { readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL; writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL; } else if (argc == 2) { readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL; writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be a one or two" " element list", -1)); } ckfree(argv); return TCL_ERROR; } if (readMode) { TclEolTranslation translation; if (*readMode == '\0') { translation = statePtr->inputTranslation; } else if (strcmp(readMode, "auto") == 0) { translation = TCL_TRANSLATE_AUTO; } else if (strcmp(readMode, "binary") == 0) { translation = TCL_TRANSLATE_LF; statePtr->inEofChar = 0; Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = NULL; } else if (strcmp(readMode, "lf") == 0) { translation = TCL_TRANSLATE_LF; } else if (strcmp(readMode, "cr") == 0) { translation = TCL_TRANSLATE_CR; } else if (strcmp(readMode, "crlf") == 0) { translation = TCL_TRANSLATE_CRLF; } else if (strcmp(readMode, "platform") == 0) { translation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } ckfree(argv); return TCL_ERROR; } /* * Reset the EOL flags since we need to look at any buffered data * to see if the new translation mode allows us to complete the * line. */ if (translation != statePtr->inputTranslation) { statePtr->inputTranslation = translation; ResetFlag(statePtr, INPUT_SAW_CR | CHANNEL_NEED_MORE_DATA); UpdateInterest(chanPtr); } } if (writeMode) { if (*writeMode == '\0') { /* Do nothing. */ } else if (strcmp(writeMode, "auto") == 0) { /* * This is a hack to get TCP sockets to produce output in CRLF * mode if they are being set into AUTO mode. A better * solution for achieving this effect will be coded later. */ if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_CRLF; } else { statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; } } else if (strcmp(writeMode, "binary") == 0) { statePtr->outEofChar = 0; statePtr->outputTranslation = TCL_TRANSLATE_LF; Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = NULL; } else if (strcmp(writeMode, "lf") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_LF; } else if (strcmp(writeMode, "cr") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_CR; } else if (strcmp(writeMode, "crlf") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_CRLF; } else if (strcmp(writeMode, "platform") == 0) { statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } ckfree(argv); return TCL_ERROR; } } ckfree(argv); return TCL_OK; } else if (chanPtr->typePtr->setOptionProc != NULL) { return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp, optionName, newValue); } else { return Tcl_BadChannelOption(interp, optionName, NULL); } return TCL_OK; } /* *---------------------------------------------------------------------- * * CleanupChannelHandlers -- * * Removes channel handlers that refer to the supplied interpreter, so * that if the actual channel is not closed now, these handlers will not * run on subsequent events on the channel. This would be erroneous, * because the interpreter no longer has a reference to this channel. * * Results: * None. * * Side effects: * Removes channel handlers. * *---------------------------------------------------------------------- */ static void CleanupChannelHandlers( Tcl_Interp *interp, Channel *chanPtr) { ChannelState *statePtr = chanPtr->state; /* State info for channel */ EventScriptRecord *sPtr, *prevPtr, *nextPtr; /* * Remove fileevent records on this channel that refer to the given * interpreter. */ for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL; sPtr != NULL; sPtr = nextPtr) { nextPtr = sPtr->nextPtr; if (sPtr->interp == interp) { if (prevPtr == NULL) { statePtr->scriptRecordPtr = nextPtr; } else { prevPtr->nextPtr = nextPtr; } Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); ckfree(sPtr); } else { prevPtr = sPtr; } } } /* *---------------------------------------------------------------------- * * Tcl_NotifyChannel -- * * This procedure is called by a channel driver when a driver detects an * event on a channel. This procedure is responsible for actually * handling the event by invoking any channel handler callbacks. * * Results: * None. * * Side effects: * Whatever the channel handler callback procedure does. * *---------------------------------------------------------------------- */ void Tcl_NotifyChannel( Tcl_Channel channel, /* Channel that detected an event. */ int mask) /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which events were detected. */ { Channel *chanPtr = (Channel *) channel; ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelHandler *chPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); NextChannelHandler nh; Channel *upChanPtr; const Tcl_ChannelType *upTypePtr; /* * In contrast to the other API functions this procedure walks towards the * top of a stack and not down from it. * * The channel calling this procedure is the one who generated the event, * and thus does not take part in handling it. IOW, its HandlerProc is not * called, instead we begin with the channel above it. * * This behaviour also allows the transformation channels to generate * their own events and pass them upward. */ while (mask && (chanPtr->upChanPtr != NULL)) { Tcl_DriverHandlerProc *upHandlerProc; upChanPtr = chanPtr->upChanPtr; upTypePtr = upChanPtr->typePtr; upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr); if (upHandlerProc != NULL) { mask = upHandlerProc(upChanPtr->instanceData, mask); } /* * ELSE: Ignore transformations which are unable to handle the event * coming from below. Assume that they don't change the mask and pass * it on. */ chanPtr = upChanPtr; } channel = (Tcl_Channel) chanPtr; /* * Here we have either reached the top of the stack or the mask is empty. * We break out of the procedure if it is the latter. */ if (!mask) { return; } /* * We are now above the topmost channel in a stack and have events left. * Now call the channel handlers as usual. * * Preserve the channel struct in case the script closes it. */ TclChannelPreserve((Tcl_Channel)channel); Tcl_Preserve(statePtr); /* * Avoid processing if the channel owner has been changed. */ if (statePtr->managingThread != Tcl_GetCurrentThread()) { goto done; } /* * If we are flushing in the background, be sure to call FlushChannel for * writable events. Note that we have to discard the writable event so we * don't call any write handlers before the flush is complete. */ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) { if (0 == FlushChannel(NULL, chanPtr, 1)) { mask &= ~TCL_WRITABLE; } } /* * Add this invocation to the list of recursive invocations of * Tcl_NotifyChannel. */ nh.nextHandlerPtr = NULL; nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr; tsdPtr->nestedHandlerPtr = &nh; for (chPtr = statePtr->chPtr; chPtr != NULL; ) { /* * If this channel handler is interested in any of the events that * have occurred on the channel, invoke its procedure. */ if ((chPtr->mask & mask) != 0) { nh.nextHandlerPtr = chPtr->nextPtr; chPtr->proc(chPtr->clientData, chPtr->mask & mask); chPtr = nh.nextHandlerPtr; } else { chPtr = chPtr->nextPtr; } /* * Stop if the channel owner has been changed in-between. */ if (chanPtr->state->managingThread != Tcl_GetCurrentThread()) { goto done; } } /* * Update the notifier interest, since it may have changed after invoking * event handlers. Skip that if the channel was deleted in the call to the * channel handler. */ if (chanPtr->typePtr != NULL) { /* * TODO: This call may not be needed. If a handler induced a * change in interest, that handler should have made its own * UpdateInterest() call, one would think. */ UpdateInterest(chanPtr); } done: Tcl_Release(statePtr); TclChannelRelease(channel); tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr; } /* *---------------------------------------------------------------------- * * UpdateInterest -- * * Arrange for the notifier to call us back at appropriate times based on * the current state of the channel. * * Results: * None. * * Side effects: * May schedule a timer or driver handler. * *---------------------------------------------------------------------- */ static void UpdateInterest( Channel *chanPtr) /* Channel to update. */ { ChannelState *statePtr = chanPtr->state; /* State info for channel */ int mask = statePtr->interestMask; if (chanPtr->typePtr == NULL) { /* Do not update interest on a closed channel */ return; } /* * If there are flushed buffers waiting to be written, then we need to * watch for the channel to become writable. */ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { mask |= TCL_WRITABLE; } /* * If there is data in the input queue, and we aren't waiting for more * data, then we need to schedule a timer so we don't block in the * notifier. Also, cancel the read interest so we don't get duplicate * events. */ if (mask & TCL_READABLE) { if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) && (statePtr->inQueueHead != NULL) && IsBufferReady(statePtr->inQueueHead)) { mask &= ~TCL_READABLE; /* * Andreas Kupries, April 11, 2003 * * Some operating systems (Solaris 2.6 and higher (but not Solaris * 2.5, go figure)) generate READABLE and EXCEPTION events when * select()'ing [*] on a plain file, even if EOF was not yet * reached. This is a problem in the following situation: * * - An extension asks to get both READABLE and EXCEPTION events. * - It reads data into a buffer smaller than the buffer used by * Tcl itself. * - It does not process all events in the event queue, but only * one, at least in some situations. * * In that case we can get into a situation where * * - Tcl drops READABLE here, because it has data in its own * buffers waiting to be read by the extension. * - A READABLE event is synthesized via timer. * - The OS still reports the EXCEPTION condition on the file. * - And the extension gets the EXCEPTION event first, and handles * this as EOF. * * End result ==> Premature end of reading from a file. * * The concrete example is 'Expect', and its [expect] command * (and at the C-level, deep in the bowels of Expect, * 'exp_get_next_event'. See marker 'SunOS' for commentary in * that function too). * * [*] As the Tcl notifier does. See also for marker 'SunOS' in * file 'exp_event.c' of Expect. * * Our solution here is to drop the interest in the EXCEPTION * events too. This compiles on all platforms, and also passes the * testsuite on all of them. */ mask &= ~TCL_EXCEPTION; if (!statePtr->timer) { TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ChannelTimerProc, chanPtr); } } } ChanWatch(chanPtr, mask); } /* *---------------------------------------------------------------------- * * ChannelTimerProc -- * * Timer handler scheduled by UpdateInterest to monitor the channel * buffers until they are empty. * * Results: * None. * * Side effects: * May invoke channel handlers. * *---------------------------------------------------------------------- */ static void ChannelTimerProc( ClientData clientData) { Channel *chanPtr = (Channel *)clientData; /* State info for channel */ ChannelState *statePtr = chanPtr->state; if (chanPtr->typePtr == NULL) { statePtr->timer = NULL; TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); statePtr->timerChanPtr = NULL; } else { if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) && (statePtr->interestMask & TCL_READABLE) && (statePtr->inQueueHead != NULL) && IsBufferReady(statePtr->inQueueHead)) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. */ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ChannelTimerProc,chanPtr); Tcl_Preserve(statePtr); Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); Tcl_Release(statePtr); } else { statePtr->timer = NULL; UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); statePtr->timerChanPtr = NULL; } } } /* *---------------------------------------------------------------------- * * Tcl_CreateChannelHandler -- * * Arrange for a given procedure to be invoked whenever the channel * indicated by the chanPtr arg becomes readable or writable. * * Results: * None. * * Side effects: * From now on, whenever the I/O channel given by chanPtr becomes ready * in the way indicated by mask, proc will be invoked. See the manual * entry for details on the calling sequence to proc. If there is already * an event handler for chan, proc and clientData, then the mask will be * updated. * *---------------------------------------------------------------------- */ void Tcl_CreateChannelHandler( Tcl_Channel chan, /* The channel to create the handler for. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. Use 0 to disable a registered * handler. */ Tcl_ChannelProc *proc, /* Procedure to call for each selected * event. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { ChannelHandler *chPtr; Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ /* * Check whether this channel handler is not already registered. If it is * not, create a new record, else reuse existing record (smash current * values). */ for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) { if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) && (chPtr->clientData == clientData)) { break; } } if (chPtr == NULL) { chPtr = (ChannelHandler *)ckalloc(sizeof(ChannelHandler)); chPtr->mask = 0; chPtr->proc = proc; chPtr->clientData = clientData; chPtr->chanPtr = chanPtr; chPtr->nextPtr = statePtr->chPtr; statePtr->chPtr = chPtr; } /* * The remainder of the initialization below is done regardless of whether * this is a new record or a modification of an old one. */ chPtr->mask = mask; /* * Recompute the interest mask for the channel - this call may actually be * disabling an existing handler. */ statePtr->interestMask = 0; for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) { statePtr->interestMask |= chPtr->mask; } UpdateInterest(statePtr->topChanPtr); } /* *---------------------------------------------------------------------- * * Tcl_DeleteChannelHandler -- * * Cancel a previously arranged callback arrangement for an IO channel. * * Results: * None. * * Side effects: * If a callback was previously registered for this chan, proc and * clientData, it is removed and the callback will no longer be called * when the channel becomes ready for IO. * *---------------------------------------------------------------------- */ void Tcl_DeleteChannelHandler( Tcl_Channel chan, /* The channel for which to remove the * callback. */ Tcl_ChannelProc *proc, /* The procedure in the callback to delete. */ ClientData clientData) /* The client data in the callback to * delete. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ChannelHandler *chPtr, *prevChPtr; Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ NextChannelHandler *nhPtr; /* * Find the entry and the previous one in the list. */ for (prevChPtr = NULL, chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) { if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData) && (chPtr->proc == proc)) { break; } prevChPtr = chPtr; } /* * If not found, return without doing anything. */ if (chPtr == NULL) { return; } /* * If Tcl_NotifyChannel is about to process this handler, tell it to * process the next one instead - we are going to delete *this* one. */ for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL; nhPtr = nhPtr->nestedHandlerPtr) { if (nhPtr->nextHandlerPtr == chPtr) { nhPtr->nextHandlerPtr = chPtr->nextPtr; } } /* * Splice it out of the list of channel handlers. */ if (prevChPtr == NULL) { statePtr->chPtr = chPtr->nextPtr; } else { prevChPtr->nextPtr = chPtr->nextPtr; } ckfree(chPtr); /* * Recompute the interest list for the channel, so that infinite loops * will not result if Tcl_DeleteChannelHandler is called inside an event. */ statePtr->interestMask = 0; for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) { statePtr->interestMask |= chPtr->mask; } UpdateInterest(statePtr->topChanPtr); } /* *---------------------------------------------------------------------- * * DeleteScriptRecord -- * * Delete a script record for this combination of channel, interp and * mask. * * Results: * None. * * Side effects: * Deletes a script record and cancels a channel event handler. * *---------------------------------------------------------------------- */ static void DeleteScriptRecord( Tcl_Interp *interp, /* Interpreter in which script was to be * executed. */ Channel *chanPtr, /* The channel for which to delete the script * record (if any). */ int mask) /* Events in mask must exactly match mask of * script to delete. */ { ChannelState *statePtr = chanPtr->state; /* State info for channel */ EventScriptRecord *esPtr, *prevEsPtr; for (esPtr = statePtr->scriptRecordPtr, prevEsPtr = NULL; esPtr != NULL; prevEsPtr = esPtr, esPtr = esPtr->nextPtr) { if ((esPtr->interp == interp) && (esPtr->mask == mask)) { if (esPtr == statePtr->scriptRecordPtr) { statePtr->scriptRecordPtr = esPtr->nextPtr; } else { CLANG_ASSERT(prevEsPtr); prevEsPtr->nextPtr = esPtr->nextPtr; } Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); TclDecrRefCount(esPtr->scriptPtr); ckfree(esPtr); break; } } } /* *---------------------------------------------------------------------- * * CreateScriptRecord -- * * Creates a record to store a script to be executed when a specific * event fires on a specific channel. * * Results: * None. * * Side effects: * Causes the script to be stored for later execution. * *---------------------------------------------------------------------- */ static void CreateScriptRecord( Tcl_Interp *interp, /* Interpreter in which to execute the stored * script. */ Channel *chanPtr, /* Channel for which script is to be stored */ int mask, /* Set of events for which script will be * invoked. */ Tcl_Obj *scriptPtr) /* Pointer to script object. */ { ChannelState *statePtr = chanPtr->state; /* State info for channel */ EventScriptRecord *esPtr; int makeCH; for (esPtr=statePtr->scriptRecordPtr; esPtr!=NULL; esPtr=esPtr->nextPtr) { if ((esPtr->interp == interp) && (esPtr->mask == mask)) { TclDecrRefCount(esPtr->scriptPtr); esPtr->scriptPtr = NULL; break; } } makeCH = (esPtr == NULL); if (makeCH) { esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord)); } /* * Initialize the structure before calling Tcl_CreateChannelHandler, * because a reflected channel calling 'chan postevent' aka * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to * see uninitialized memory and crash. See [Bug 2918110]. */ esPtr->chanPtr = chanPtr; esPtr->interp = interp; esPtr->mask = mask; Tcl_IncrRefCount(scriptPtr); esPtr->scriptPtr = scriptPtr; if (makeCH) { esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, TclChannelEventScriptInvoker, esPtr); } } /* *---------------------------------------------------------------------- * * TclChannelEventScriptInvoker -- * * Invokes a script scheduled by "fileevent" for when the channel becomes * ready for IO. This function is invoked by the channel handler which * was created by the Tcl "fileevent" command. * * Results: * None. * * Side effects: * Whatever the script does. * *---------------------------------------------------------------------- */ void TclChannelEventScriptInvoker( ClientData clientData, /* The script+interp record. */ int mask) /* Not used. */ { Tcl_Interp *interp; /* Interpreter in which to eval the script. */ Channel *chanPtr; /* The channel for which this handler is * registered. */ EventScriptRecord *esPtr; /* The event script + interpreter to eval it * in. */ int result; /* Result of call to eval script. */ esPtr = (EventScriptRecord *)clientData; chanPtr = esPtr->chanPtr; mask = esPtr->mask; interp = esPtr->interp; /* * Be sure event executed in managed channel (covering bugs similar [f583715154]). */ assert(chanPtr->state->managingThread == Tcl_GetCurrentThread()); /* * We must preserve the interpreter so we can report errors on it later. * Note that we do not need to preserve the channel because that is done * by Tcl_NotifyChannel before calling channel handlers. */ Tcl_Preserve(interp); TclChannelPreserve((Tcl_Channel)chanPtr); result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL); /* * On error, cause a background error and remove the channel handler and * the script record. * * NOTE: Must delete channel handler before causing the background error * because the background error may want to reinstall the handler. */ if (result != TCL_OK) { if (chanPtr->typePtr != NULL) { DeleteScriptRecord(interp, chanPtr, mask); } Tcl_BackgroundException(interp, result); } TclChannelRelease((Tcl_Channel)chanPtr); Tcl_Release(interp); } /* *---------------------------------------------------------------------- * * Tcl_FileEventObjCmd -- * * This procedure implements the "fileevent" Tcl command. See the user * documentation for details on what it does. This command is based on * the Tk command "fileevent" which in turn is based on work contributed * by Mark Diekhans. * * Results: * A standard Tcl result. * * Side effects: * May create a channel handler for the specified channel. * *---------------------------------------------------------------------- */ int Tcl_FileEventObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Interpreter in which the channel for which * to create the handler is found. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Channel *chanPtr; /* The channel to create the handler for. */ ChannelState *statePtr; /* State info for channel */ Tcl_Channel chan; /* The opaque type for the channel. */ const char *chanName; int modeIndex; /* Index of mode argument. */ int mask; static const char *const modeOptions[] = {"readable", "writable", NULL}; static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; (void)dummy; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0, &modeIndex) != TCL_OK) { return TCL_ERROR; } mask = maskArray[modeIndex]; chanName = TclGetString(objv[1]); chan = Tcl_GetChannel(interp, chanName, NULL); if (chan == NULL) { return TCL_ERROR; } chanPtr = (Channel *) chan; statePtr = chanPtr->state; if (GotFlag(statePtr, mask) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s", (mask == TCL_READABLE) ? "readable" : "writable")); return TCL_ERROR; } /* * If we are supposed to return the script, do so. */ if (objc == 3) { EventScriptRecord *esPtr; for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL; esPtr = esPtr->nextPtr) { if ((esPtr->interp == interp) && (esPtr->mask == mask)) { Tcl_SetObjResult(interp, esPtr->scriptPtr); break; } } return TCL_OK; } /* * If we are supposed to delete a stored script, do so. */ if (*(TclGetString(objv[3])) == '\0') { DeleteScriptRecord(interp, chanPtr, mask); return TCL_OK; } /* * Make the script record that will link between the event and the script * to invoke. This also creates a channel event handler which will * evaluate the script in the supplied interpreter. */ CreateScriptRecord(interp, chanPtr, mask, objv[3]); return TCL_OK; } /* *---------------------------------------------------------------------- * * ZeroTransferTimerProc -- * * Timer handler scheduled by TclCopyChannel so that -command is * called asynchronously even when -size is 0. * * Results: * None. * * Side effects: * Calls CopyData for -command invocation. * *---------------------------------------------------------------------- */ static void ZeroTransferTimerProc( ClientData clientData) { /* calling CopyData with mask==0 still implies immediate invocation of the * -command callback, and completion of the fcopy. */ CopyData((CopyState *)clientData, 0); } /* *---------------------------------------------------------------------- * * TclCopyChannel -- * * This routine copies data from one channel to another, either * synchronously or asynchronously. If a command script is supplied, the * operation runs in the background. The script is invoked when the copy * completes. Otherwise the function waits until the copy is completed * before returning. * * Results: * A standard Tcl result. * * Side effects: * May schedule a background copy operation that causes both channels to * be marked busy. * *---------------------------------------------------------------------- */ int TclCopyChannelOld( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ Tcl_Channel outChan, /* Channel to write to. */ int toRead, /* Amount of data to copy, or -1 for all. */ Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ { return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, cmdPtr); } int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ Tcl_Channel outChan, /* Channel to write to. */ Tcl_WideInt toRead, /* Amount of data to copy, or -1 for all. */ Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ { Channel *inPtr = (Channel *) inChan; Channel *outPtr = (Channel *) outChan; ChannelState *inStatePtr, *outStatePtr; int readFlags, writeFlags; CopyState *csPtr; int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0; int moveBytes; inStatePtr = inPtr->state; outStatePtr = outPtr->state; if (BUSY_STATE(inStatePtr, TCL_READABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" is busy", Tcl_GetChannelName(inChan))); } return TCL_ERROR; } if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" is busy", Tcl_GetChannelName(outChan))); } return TCL_ERROR; } readFlags = inStatePtr->flags; writeFlags = outStatePtr->flags; /* * Set up the blocking mode appropriately. Background copies need * non-blocking channels. Foreground copies need blocking channels. If * there is an error, restore the old blocking mode. */ if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) { if (SetBlockMode(interp, inPtr, nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING) != TCL_OK) { return TCL_ERROR; } } if ((inPtr!=outPtr) && (nonBlocking!=(writeFlags&CHANNEL_NONBLOCKING)) && (SetBlockMode(NULL, outPtr, nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING) != TCL_OK) && (nonBlocking != (readFlags & CHANNEL_NONBLOCKING))) { SetBlockMode(NULL, inPtr, (readFlags & CHANNEL_NONBLOCKING) ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING); return TCL_ERROR; } /* * Make sure the output side is unbuffered. */ outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED) | CHANNEL_UNBUFFERED; /* * Test for conditions where we know we can just move bytes from input * channel to output channel with no transformation or even examination * of the bytes themselves. */ moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF && outStatePtr->outputTranslation == TCL_TRANSLATE_LF && inStatePtr->encoding == outStatePtr->encoding; /* * Allocate a new CopyState to maintain info about the current copy in * progress. This structure will be deallocated when the copy is * completed. */ csPtr = (CopyState *)ckalloc(TclOffset(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; csPtr->readFlags = readFlags; csPtr->writeFlags = writeFlags; csPtr->toRead = toRead; csPtr->total = (Tcl_WideInt) 0; csPtr->interp = interp; if (cmdPtr) { Tcl_IncrRefCount(cmdPtr); } csPtr->cmdPtr = cmdPtr; inStatePtr->csPtrR = csPtr; outStatePtr->csPtrW = csPtr; if (moveBytes) { return MoveBytes(csPtr); } /* * Special handling of -size 0 async transfers, so that the -command is * still called asynchronously. */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); return 0; } /* * Start copying data between the channels. */ return CopyData(csPtr, 0); } /* *---------------------------------------------------------------------- * * CopyData -- * * This function implements the lowest level of the copying mechanism for * TclCopyChannel. * * Results: * Returns TCL_OK on success, else TCL_ERROR. * * Side effects: * Moves data between channels, may create channel handlers. * *---------------------------------------------------------------------- */ static void MBCallback( CopyState *csPtr, Tcl_Obj *errObj) { Tcl_Obj *cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr); Tcl_WideInt total = csPtr->total; Tcl_Interp *interp = csPtr->interp; int code; Tcl_IncrRefCount(cmdPtr); StopCopy(csPtr); /* TODO: What if cmdPtr is not a list?! */ Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewWideIntObj(total)); if (errObj) { Tcl_ListObjAppendElement(NULL, cmdPtr, errObj); } Tcl_Preserve(interp); code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundException(interp, code); } Tcl_Release(interp); TclDecrRefCount(cmdPtr); } static void MBError( CopyState *csPtr, int mask, int errorCode) { Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr; Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr; Tcl_Obj *errObj; Tcl_SetErrno(errorCode); errObj = Tcl_ObjPrintf( "error %sing \"%s\": %s", (mask & TCL_READABLE) ? "read" : "writ", Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan), Tcl_PosixError(csPtr->interp)); if (csPtr->cmdPtr) { MBCallback(csPtr, errObj); } else { Tcl_SetObjResult(csPtr->interp, errObj); StopCopy(csPtr); } } static void MBEvent( ClientData clientData, int mask) { CopyState *csPtr = (CopyState *) clientData; Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr; Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr; ChannelState *inStatePtr = csPtr->readPtr->state; if (mask & TCL_WRITABLE) { Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr); switch (MBWrite(csPtr)) { case TCL_OK: MBCallback(csPtr, NULL); break; case TCL_CONTINUE: Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr); break; } } else if (mask & TCL_READABLE) { if (TCL_OK == MBRead(csPtr)) { /* When at least one full buffer is present, stop reading. */ if (IsBufferFull(inStatePtr->inQueueHead) || !Tcl_InputBlocked(inChan)) { Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); } /* Successful read -- set up to write the bytes we read */ Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr); } } } static int MBRead( CopyState *csPtr) { ChannelState *inStatePtr = csPtr->readPtr->state; ChannelBuffer *bufPtr = inStatePtr->inQueueHead; int code; if (bufPtr && BytesLeft(bufPtr) > 0) { return TCL_OK; } code = GetInput(inStatePtr->topChanPtr); if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) { return TCL_OK; } else { MBError(csPtr, TCL_READABLE, code); return TCL_ERROR; } } static int MBWrite( CopyState *csPtr) { ChannelState *inStatePtr = csPtr->readPtr->state; ChannelState *outStatePtr = csPtr->writePtr->state; ChannelBuffer *bufPtr = inStatePtr->inQueueHead; ChannelBuffer *tail = NULL; int code; Tcl_WideInt inBytes = 0; /* Count up number of bytes waiting in the input queue */ while (bufPtr) { inBytes += BytesLeft(bufPtr); tail = bufPtr; if (csPtr->toRead != -1 && csPtr->toRead < inBytes) { /* Queue has enough bytes to complete the copy */ break; } bufPtr = bufPtr->nextPtr; } if (bufPtr) { /* Split the overflowing buffer in two */ int extra = (int) (inBytes - csPtr->toRead); /* Note that going with int for extra assumes that inBytes is not too * much over toRead to require a wide itself. If that gets violated * then the calculations involving extra must be made wide too. * * Noted with Win32/MSVC debug build treating the warning (possible of * data in __int64 to int conversion) as error. */ bufPtr = AllocChannelBuffer(extra); tail->nextAdded -= extra; memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra); bufPtr->nextAdded += extra; bufPtr->nextPtr = tail->nextPtr; tail->nextPtr = NULL; inBytes = csPtr->toRead; } /* Update the byte counts */ if (csPtr->toRead != -1) { csPtr->toRead -= inBytes; } csPtr->total += inBytes; /* Move buffers from input to output channels */ if (outStatePtr->outQueueTail) { outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead; } else { outStatePtr->outQueueHead = inStatePtr->inQueueHead; } outStatePtr->outQueueTail = tail; inStatePtr->inQueueHead = bufPtr; if (inStatePtr->inQueueTail == tail) { inStatePtr->inQueueTail = bufPtr; } if (bufPtr == NULL) { inStatePtr->inQueueTail = NULL; } code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0); if (code) { MBError(csPtr, TCL_WRITABLE, code); return TCL_ERROR; } if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) { return TCL_OK; } return TCL_CONTINUE; } static int MoveBytes( CopyState *csPtr) /* State of copy operation. */ { ChannelState *outStatePtr = csPtr->writePtr->state; ChannelBuffer *bufPtr = outStatePtr->curOutPtr; int errorCode; if (bufPtr && BytesLeft(bufPtr)) { /* If we start with unflushed bytes in the destination * channel, flush them out of the way first. */ errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0); if (errorCode != 0) { MBError(csPtr, TCL_WRITABLE, errorCode); return TCL_ERROR; } } if (csPtr->cmdPtr) { Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr; Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr); return TCL_OK; } while (1) { int code; if (TCL_ERROR == MBRead(csPtr)) { return TCL_ERROR; } code = MBWrite(csPtr); if (code == TCL_OK) { Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total)); StopCopy(csPtr); return TCL_OK; } if (code == TCL_ERROR) { return TCL_ERROR; } /* code == TCL_CONTINUE --> continue the loop */ } return TCL_OK; /* Silence compiler warnings */ } static int CopyData( CopyState *csPtr, /* State of copy operation. */ int mask) /* Current channel event flags. */ { Tcl_Interp *interp; Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL; Tcl_Channel inChan, outChan; ChannelState *inStatePtr, *outStatePtr; int result = TCL_OK; int sizeb; Tcl_WideInt total; int size; const char *buffer; int inBinary, outBinary, sameEncoding; /* Encoding control */ int underflow; /* Input underflow */ inChan = (Tcl_Channel) csPtr->readPtr; outChan = (Tcl_Channel) csPtr->writePtr; inStatePtr = csPtr->readPtr->state; outStatePtr = csPtr->writePtr->state; interp = csPtr->interp; cmdPtr = csPtr->cmdPtr; /* * Copy the data the slow way, using the translation mechanism. * * Note: We have make sure that we use the topmost channel in a stack for * the copying. The caller uses Tcl_GetChannel to access it, and thus gets * the bottom of the stack. */ inBinary = (inStatePtr->encoding == NULL); outBinary = (outStatePtr->encoding == NULL); sameEncoding = (inStatePtr->encoding == outStatePtr->encoding); if (!(inBinary || sameEncoding)) { TclNewObj(bufObj); Tcl_IncrRefCount(bufObj); } while (csPtr->toRead != (Tcl_WideInt) 0) { /* * Check for unreported background errors. */ Tcl_GetChannelError(inChan, &msg); if ((inStatePtr->unreportedError != 0) || (msg != NULL)) { Tcl_SetErrno(inStatePtr->unreportedError); inStatePtr->unreportedError = 0; goto readError; } Tcl_GetChannelError(outChan, &msg); if ((outStatePtr->unreportedError != 0) || (msg != NULL)) { Tcl_SetErrno(outStatePtr->unreportedError); outStatePtr->unreportedError = 0; goto writeError; } if (cmdPtr && (mask == 0)) { /* * In async mode, we skip reading synchronously and fake an * underflow instead to prime the readable fileevent. */ size = 0; underflow = 1; } else { /* * Read up to bufSize bytes. */ if ((csPtr->toRead == (Tcl_WideInt) -1) || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { sizeb = csPtr->bufSize; } else { sizeb = (int) csPtr->toRead; } if (inBinary || sameEncoding) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */); } underflow = (size >= 0) && (size < sizeb); /* Input underflow */ } if (size < 0) { readError: if (interp) { TclNewObj(errObj); Tcl_AppendStringsToObj(errObj, "error reading \"", Tcl_GetChannelName(inChan), "\": ", (void *)NULL); if (msg != NULL) { Tcl_AppendObjToObj(errObj, msg); } else { Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp), (void *)NULL); } } if (msg != NULL) { Tcl_DecrRefCount(msg); } break; } else if (underflow) { /* * We had an underflow on the read side. If we are at EOF, and not * in the synchronous part of an asynchronous fcopy, then the * copying is done, otherwise set up a channel handler to detect * when the channel becomes readable again. */ if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) { break; } if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) && !(mask & TCL_READABLE)) { if (mask & TCL_WRITABLE) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } Tcl_CreateChannelHandler(inChan, TCL_READABLE, CopyEventProc, csPtr); } if (size == 0) { if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) { /* * We allowed a short read. Keep trying. */ continue; } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } return TCL_OK; } } /* * Now write the buffer out. */ if (inBinary || sameEncoding) { buffer = csPtr->buffer; sizeb = size; } else { buffer = TclGetStringFromObj(bufObj, &sizeb); } if (outBinary || sameEncoding) { sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb); } else { sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb); } /* * [Bug 2895565]. At this point 'size' still contains the number of * bytes or characters which have been read. We keep this to later to * update the totals and toRead information, see marker (UP) below. We * must not overwrite it with 'sizeb', which is the number of written * bytes or characters, and both EOL translation and encoding * conversion may have changed this number unpredictably in relation * to 'size' (It can be smaller or larger, in the latter case able to * drive toRead below -1, causing infinite looping). Completely * unsuitable for updating totals and toRead. */ if (sizeb < 0) { writeError: if (interp) { TclNewObj(errObj); Tcl_AppendStringsToObj(errObj, "error writing \"", Tcl_GetChannelName(outChan), "\": ", (void *)NULL); if (msg != NULL) { Tcl_AppendObjToObj(errObj, msg); } else { Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp), (void *)NULL); } } if (msg != NULL) { Tcl_DecrRefCount(msg); } break; } /* * Update the current byte count. Do it now so the count is valid * before a return or break takes us out of the loop. The invariant at * the top of the loop should be that csPtr->toRead holds the number * of bytes left to copy. */ if (csPtr->toRead != -1) { csPtr->toRead -= size; } csPtr->total += size; /* * Break loop if EOF && (size>0) */ if (Tcl_Eof(inChan)) { break; } /* * Check to see if the write is happening in the background. If so, * stop copying and wait for the channel to become writable again. * After input underflow we already installed a readable handler * therefore we don't need a writable handler. */ if (!underflow && GotFlag(outStatePtr, BG_FLUSH_SCHEDULED)) { if (!(mask & TCL_WRITABLE)) { if (mask & TCL_READABLE) { Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr); } Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc, csPtr); } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } return TCL_OK; } /* * For background copies, we only do one buffer per invocation so we * don't starve the rest of the system. */ if (cmdPtr && (csPtr->toRead != 0)) { /* * The first time we enter this code, there won't be a channel * handler established yet, so do it here. */ if (mask == 0) { Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc, csPtr); } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } return TCL_OK; } } /* while */ if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } /* * Make the callback or return the number of bytes transferred. The local * total is used because StopCopy frees csPtr. */ total = csPtr->total; if (cmdPtr && interp) { int code; /* * Get a private copy of the command so we can mutate it by adding * arguments. Note that StopCopy frees our saved reference to the * original command obj. */ cmdPtr = Tcl_DuplicateObj(cmdPtr); Tcl_IncrRefCount(cmdPtr); StopCopy(csPtr); Tcl_Preserve(interp); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total)); if (errObj) { Tcl_ListObjAppendElement(interp, cmdPtr, errObj); } code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundException(interp, code); result = TCL_ERROR; } TclDecrRefCount(cmdPtr); Tcl_Release(interp); } else { StopCopy(csPtr); if (interp) { if (errObj) { Tcl_SetObjResult(interp, errObj); result = TCL_ERROR; } else { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total)); } } } return result; } /* *---------------------------------------------------------------------- * * DoRead -- * * Stores up to "bytesToRead" bytes in memory pointed to by "dst". * These bytes come from reading the channel "chanPtr" and * performing the configured translations. No encoding conversions * are applied to the bytes being read. * * Results: * The number of bytes actually stored (<= bytesToRead), * or -1 if there is an error in reading the channel. Use * Tcl_GetErrno() to retrieve the error code for the error * that occurred. * * The number of bytes stored can be less than the number * requested when * - EOF is reached on the channel; or * - the channel is non-blocking, and we've read all we can * without blocking. * - a channel reading error occurs (and we return -1) * * Side effects: * May cause input to be buffered. * *---------------------------------------------------------------------- */ static int DoRead( Channel *chanPtr, /* The channel from which to read. */ char *dst, /* Where to store input read. */ int bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; char *p = dst; assert(bytesToRead >= 0); /* * Early out when we know a read will get the eofchar. * * NOTE: This seems to be a bug. The special handling for * a zero-char read request ought to come first. As coded * the EOF due to eofchar has distinguishing behavior from * the EOF due to reported EOF on the underlying device, and * that seems undesirable. However recent history indicates * that new inconsistent behavior in a patchlevel has problems * too. Keep on keeping on for now. */ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { SetFlag(statePtr, CHANNEL_EOF); assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); /* TODO: Don't need this call */ UpdateInterest(chanPtr); return 0; } /* * Special handling for zero-char read request. */ if (bytesToRead == 0) { if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; /* TODO: Don't need this call */ UpdateInterest(chanPtr); return 0; } TclChannelPreserve((Tcl_Channel)chanPtr); while (bytesToRead) { /* * Each pass through the loop is intended to process up to one channel * buffer. */ int bytesRead, bytesWritten; ChannelBuffer *bufPtr = statePtr->inQueueHead; /* * Don't read more data if we have what we need. */ while (!bufPtr || /* We got no buffer! OR */ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */ (BytesLeft(bufPtr) < bytesToRead))) { /* Not enough bytes in it yet * to fill the dst */ int code; moreData: code = GetInput(chanPtr); bufPtr = statePtr->inQueueHead; assert(bufPtr != NULL); if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) { /* * Further reads cannot do any more. */ break; } if (code) { /* * Read error */ UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return -1; } assert(IsBufferFull(bufPtr)); } assert(bufPtr != NULL); bytesRead = BytesLeft(bufPtr); bytesWritten = bytesToRead; TranslateInputEOL(statePtr, p, RemovePoint(bufPtr), &bytesWritten, &bytesRead); bufPtr->nextRemoved += bytesRead; p += bytesWritten; bytesToRead -= bytesWritten; if (!IsBufferEmpty(bufPtr)) { /* * Buffer is not empty. How can that be? * * 0) We stopped early because we got all the bytes we were * seeking. That's fine. */ if (bytesToRead == 0) { break; } /* * 1) We're @EOF because we saw eof char. */ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { break; } /* * 2) The buffer holds a \r while in CRLF translation, followed by * the end of the buffer. */ assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF); assert(RemovePoint(bufPtr)[0] == '\r'); assert(BytesLeft(bufPtr) == 1); if (bufPtr->nextPtr == NULL) { /* * There's no more buffered data... */ if (GotFlag(statePtr, CHANNEL_EOF)) { /* * ...and there never will be. */ *p++ = '\r'; bytesToRead--; bufPtr->nextRemoved++; } else if (GotFlag(statePtr, CHANNEL_BLOCKED)) { /* * ...and we cannot get more now. */ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); break; } else { /* * ...so we need to get some. */ goto moreData; } } if (bufPtr->nextPtr) { /* * There's a next buffer. Shift orphan \r to it. */ ChannelBuffer *nextPtr = bufPtr->nextPtr; nextPtr->nextRemoved -= 1; RemovePoint(nextPtr)[0] = '\r'; bufPtr->nextRemoved++; } } if (IsBufferEmpty(bufPtr)) { statePtr->inQueueHead = bufPtr->nextPtr; if (statePtr->inQueueHead == NULL) { statePtr->inQueueTail = NULL; } RecycleBuffer(statePtr, bufPtr, 0); bufPtr = statePtr->inQueueHead; } if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads) && GotFlag(statePtr, CHANNEL_BLOCKED)) { break; } /* * When there's no buffered data to read, and we're at EOF, escape to * the caller. */ if (GotFlag(statePtr, CHANNEL_EOF) && (bufPtr == NULL || IsBufferEmpty(bufPtr))) { break; } } if (bytesToRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); } assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return (int)(p - dst); } /* *---------------------------------------------------------------------- * * CopyEventProc -- * * This routine is invoked as a channel event handler for the background * copy operation. It is just a trivial wrapper around the CopyData * routine. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void CopyEventProc( ClientData clientData, int mask) { (void) CopyData((CopyState *)clientData, mask); } /* *---------------------------------------------------------------------- * * StopCopy -- * * This routine halts a copy that is in progress. * * Results: * None. * * Side effects: * Removes any pending channel handlers and restores the blocking and * buffering modes of the channels. The CopyState is freed. * *---------------------------------------------------------------------- */ static void StopCopy( CopyState *csPtr) /* State for bg copy to stop . */ { ChannelState *inStatePtr, *outStatePtr; Tcl_Channel inChan, outChan; int nonBlocking; if (!csPtr) { return; } inChan = (Tcl_Channel) csPtr->readPtr; outChan = (Tcl_Channel) csPtr->writePtr; inStatePtr = csPtr->readPtr->state; outStatePtr = csPtr->writePtr->state; /* * Restore the old blocking mode and output buffering mode. */ nonBlocking = csPtr->readFlags & CHANNEL_NONBLOCKING; if (nonBlocking != GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) { SetBlockMode(NULL, csPtr->readPtr, nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING); } if (csPtr->readPtr != csPtr->writePtr) { nonBlocking = csPtr->writeFlags & CHANNEL_NONBLOCKING; if (nonBlocking != GotFlag(outStatePtr, CHANNEL_NONBLOCKING)) { SetBlockMode(NULL, csPtr->writePtr, nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING); } } ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); SetFlag(outStatePtr, csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED)); if (csPtr->cmdPtr) { Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr); if (inChan != outChan) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr); TclDecrRefCount(csPtr->cmdPtr); } inStatePtr->csPtrR = NULL; outStatePtr->csPtrW = NULL; ckfree(csPtr); } /* *---------------------------------------------------------------------- * * StackSetBlockMode -- * * This function sets the blocking mode for a channel, iterating through * each channel in a stack and updates the state flags. * * Results: * 0 if OK, result code from failed blockModeProc otherwise. * * Side effects: * Modifies the blocking mode of the channel and possibly generates an * error. * *---------------------------------------------------------------------- */ static int StackSetBlockMode( Channel *chanPtr, /* Channel to modify. */ int mode) /* One of TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { int result = 0; Tcl_DriverBlockModeProc *blockModeProc; ChannelState *statePtr = chanPtr->state; /* * Start at the top of the channel stack * TODO: Examine what can go wrong when blockModeProc calls * disturb the stacking state of the channel. */ chanPtr = statePtr->topChanPtr; while (chanPtr != NULL) { blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr); if (blockModeProc != NULL) { result = blockModeProc(chanPtr->instanceData, mode); if (result != 0) { Tcl_SetErrno(result); return result; } } chanPtr = chanPtr->downChanPtr; } return 0; } /* *---------------------------------------------------------------------- * * SetBlockMode -- * * This function sets the blocking mode for a channel and updates the * state flags. * * Results: * A standard Tcl result. * * Side effects: * Modifies the blocking mode of the channel and possibly generates an * error. * *---------------------------------------------------------------------- */ static int SetBlockMode( Tcl_Interp *interp, /* Interp for error reporting. */ Channel *chanPtr, /* Channel to modify. */ int mode) /* One of TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { int result = 0; ChannelState *statePtr = chanPtr->state; /* State info for channel */ result = StackSetBlockMode(chanPtr, mode); if (result != 0) { if (interp != NULL) { /* * TIP #219. * Move error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. * * Note that we cannot have a message in the interpreter bypass * area, StackSetBlockMode is restricted to the channel bypass. * We still need the interp as the destination of the move. */ if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error setting blocking mode: %s", Tcl_PosixError(interp))); } } else { /* * TIP #219. * If we have no interpreter to put a bypass message into we have * to clear it, to prevent its propagation and use in other places * unrelated to the actual occurence of the problem. */ Tcl_SetChannelError((Tcl_Channel) chanPtr, NULL); } return TCL_ERROR; } if (mode == TCL_MODE_BLOCKING) { ResetFlag(statePtr, CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED); } else { SetFlag(statePtr, CHANNEL_NONBLOCKING); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelNames -- * * Return the names of all open channels in the interp. * * Results: * TCL_OK or TCL_ERROR. * * Side effects: * Interp result modified with list of channel names. * *---------------------------------------------------------------------- */ int Tcl_GetChannelNames( Tcl_Interp *interp) /* Interp for error reporting. */ { return Tcl_GetChannelNamesEx(interp, NULL); } /* *---------------------------------------------------------------------- * * Tcl_GetChannelNamesEx -- * * Return the names of open channels in the interp filtered filtered * through a pattern. If pattern is NULL, it returns all the open * channels. * * Results: * TCL_OK or TCL_ERROR. * * Side effects: * Interp result modified with list of channel names. * *---------------------------------------------------------------------- */ int Tcl_GetChannelNamesEx( Tcl_Interp *interp, /* Interp for error reporting. */ const char *pattern) /* Pattern to filter on. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ChannelState *statePtr; const char *name; /* Name for channel */ Tcl_Obj *resultPtr; /* Pointer to result object */ Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashEntry *hPtr; /* Search variable. */ Tcl_HashSearch hSearch; /* Search variable. */ if (interp == NULL) { return TCL_OK; } /* * Get the channel table that stores the channels registered for this * interpreter. */ hTblPtr = GetChannelTable(interp); TclNewObj(resultPtr); if ((pattern != NULL) && TclMatchIsTrivial(pattern) && !((pattern[0] == 's') && (pattern[1] == 't') && (pattern[2] == 'd'))) { if ((Tcl_FindHashEntry(hTblPtr, pattern) != NULL) && (Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(pattern, -1)) != TCL_OK)) { goto error; } goto done; } for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state; if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) { name = "stdin"; } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) { name = "stdout"; } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) { name = "stderr"; } else { /* * This is also stored in Tcl_GetHashKey(hTblPtr, hPtr), but it's * simpler to just grab the name from the statePtr. */ name = statePtr->channelName; } if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) && (Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(name, -1)) != TCL_OK)) { error: TclDecrRefCount(resultPtr); return TCL_ERROR; } } done: Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_IsChannelRegistered -- * * Checks whether the channel is associated with the interp. See also * Tcl_RegisterChannel and Tcl_UnregisterChannel. * * Results: * 0 if the channel is not registered in the interpreter, 1 else. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_IsChannelRegistered( Tcl_Interp *interp, /* The interp to query of the channel */ Tcl_Channel chan) /* The channel to check */ { Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashEntry *hPtr; /* Search variable. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of the real channel. */ /* * Always check bottom-most channel in the stack. This is the one that * gets registered. */ chanPtr = ((Channel *) chan)->state->bottomChanPtr; statePtr = chanPtr->state; hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { return 0; } hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName); if (hPtr == NULL) { return 0; } if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) { return 0; } return 1; } /* *---------------------------------------------------------------------- * * Tcl_IsChannelShared -- * * Checks whether the channel is shared by multiple interpreters. * * Results: * A boolean value (0 = Not shared, 1 = Shared). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_IsChannelShared( Tcl_Channel chan) /* The channel to query */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ return ((statePtr->refCount > 1) ? 1 : 0); } /* *---------------------------------------------------------------------- * * Tcl_IsChannelExisting -- * * Checks whether a channel of the given name exists in the * (thread)-global list of all channels. See Tcl_GetChannelNamesEx for * function exposed at the Tcl level. * * Results: * A boolean value (0 = Does not exist, 1 = Does exist). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_IsChannelExisting( const char *chanName) /* The name of the channel to look for. */ { ChannelState *statePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); const char *name; int chanNameLen; chanNameLen = strlen(chanName); for (statePtr = tsdPtr->firstCSPtr; statePtr != NULL; statePtr = statePtr->nextCSPtr) { if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) { name = "stdin"; } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) { name = "stdout"; } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) { name = "stderr"; } else { name = statePtr->channelName; } if ((*chanName == *name) && (memcmp(name, chanName, chanNameLen + 1) == 0)) { return 1; } } return 0; } /* *---------------------------------------------------------------------- * * Tcl_ChannelName -- * * Return the name of the channel type. * * Results: * A pointer the name of the channel type. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_ChannelName( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->typeName; } /* *---------------------------------------------------------------------- * * Tcl_ChannelVersion -- * * Return the of version of the channel type. * * Results: * One of the TCL_CHANNEL_VERSION_* constants from tcl.h * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2) || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) { /* * In version; } /* *---------------------------------------------------------------------- * * Tcl_ChannelBlockModeProc -- * * Return the Tcl_DriverBlockModeProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { /* * The v1 structure had the blockModeProc in a different place. */ return (Tcl_DriverBlockModeProc *) chanTypePtr->version; } return chanTypePtr->blockModeProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelCloseProc -- * * Return the Tcl_DriverCloseProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverCloseProc * Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->closeProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelClose2Proc -- * * Return the Tcl_DriverClose2Proc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->close2Proc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelInputProc -- * * Return the Tcl_DriverInputProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverInputProc * Tcl_ChannelInputProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->inputProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelOutputProc -- * * Return the Tcl_DriverOutputProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverOutputProc * Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->outputProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelSeekProc -- * * Return the Tcl_DriverSeekProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverSeekProc * Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->seekProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelSetOptionProc -- * * Return the Tcl_DriverSetOptionProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->setOptionProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelGetOptionProc -- * * Return the Tcl_DriverGetOptionProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->getOptionProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelWatchProc -- * * Return the Tcl_DriverWatchProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverWatchProc * Tcl_ChannelWatchProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->watchProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelGetHandleProc -- * * Return the Tcl_DriverGetHandleProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->getHandleProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelFlushProc -- * * Return the Tcl_DriverFlushProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { return NULL; } return chanTypePtr->flushProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelHandlerProc -- * * Return the Tcl_DriverHandlerProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { return NULL; } return chanTypePtr->handlerProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelWideSeekProc -- * * Return the Tcl_DriverWideSeekProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) { return NULL; } return chanTypePtr->wideSeekProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelThreadActionProc -- * * TIP #218, Channel Thread Actions. Return the * Tcl_DriverThreadActionProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) { return NULL; } return chanTypePtr->threadActionProc; } /* *---------------------------------------------------------------------- * * Tcl_SetChannelErrorInterp -- * * TIP #219, Tcl Channel Reflection API. * Store an error message for the I/O system. * * Results: * None. * * Side effects: * Discards a previously stored message. * *---------------------------------------------------------------------- */ void Tcl_SetChannelErrorInterp( Tcl_Interp *interp, /* Interp to store the data into. */ Tcl_Obj *msg) /* Error message to store. */ { Interp *iPtr = (Interp *) interp; if (iPtr->chanMsg != NULL) { TclDecrRefCount(iPtr->chanMsg); iPtr->chanMsg = NULL; } if (msg != NULL) { iPtr->chanMsg = FixLevelCode(msg); Tcl_IncrRefCount(iPtr->chanMsg); } return; } /* *---------------------------------------------------------------------- * * Tcl_SetChannelError -- * * TIP #219, Tcl Channel Reflection API. * Store an error message for the I/O system. * * Results: * None. * * Side effects: * Discards a previously stored message. * *---------------------------------------------------------------------- */ void Tcl_SetChannelError( Tcl_Channel chan, /* Channel to store the data into. */ Tcl_Obj *msg) /* Error message to store. */ { ChannelState *statePtr = ((Channel *) chan)->state; if (statePtr->chanMsg != NULL) { TclDecrRefCount(statePtr->chanMsg); statePtr->chanMsg = NULL; } if (msg != NULL) { statePtr->chanMsg = FixLevelCode(msg); Tcl_IncrRefCount(statePtr->chanMsg); } return; } /* *---------------------------------------------------------------------- * * FixLevelCode -- * * TIP #219, Tcl Channel Reflection API. * Scans an error message for bad -code / -level directives. Returns a * modified copy with such directives corrected, and the input if it had * no problems. * * Results: * A Tcl_Obj* * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Obj * FixLevelCode( Tcl_Obj *msg) { int explicitResult, numOptions, lcn; int lc; Tcl_Obj **lv, **lvn; int res, i, j, val, lignore, cignore; int newlevel = -1, newcode = -1; /* ASSERT msg != NULL */ /* * Process the caught message. * * Syntax = (option value)... ?message? * * Bad message syntax causes a panic, because the other side uses * Tcl_GetReturnOptions and list construction functions to marshal the * information. Hence an error means that we've got serious breakage. */ res = TclListObjGetElements(NULL, msg, &lc, &lv); if (res != TCL_OK) { Tcl_Panic("Tcl_SetChannelError: bad syntax of message"); } explicitResult = (1 == (lc % 2)); numOptions = lc - explicitResult; /* * No options, nothing to do. */ if (numOptions == 0) { return msg; } /* * Check for -code x, x != 1|error, and -level x, x != 0 */ for (i = 0; i < numOptions; i += 2) { if (0 == strcmp(TclGetString(lv[i]), "-code")) { /* * !"error", !integer, integer != 1 (numeric code for error) */ res = TclGetIntFromObj(NULL, lv[i+1], &val); if (((res == TCL_OK) && (val != 1)) || ((res != TCL_OK) && (0 != strcmp(TclGetString(lv[i+1]), "error")))) { newcode = 1; } } else if (0 == strcmp(TclGetString(lv[i]), "-level")) { /* * !integer, integer != 0 */ res = TclGetIntFromObj(NULL, lv [i+1], &val); if ((res != TCL_OK) || (val != 0)) { newlevel = 0; } } } /* * -code, -level are either not present or ok. Nothing to do. */ if ((newlevel < 0) && (newcode < 0)) { return msg; } lcn = numOptions; if (explicitResult) { lcn ++; } if (newlevel >= 0) { lcn += 2; } if (newcode >= 0) { lcn += 2; } lvn = (Tcl_Obj **)ckalloc(lcn * sizeof(Tcl_Obj *)); /* * New level/code information is spliced into the first occurrence of * -level, -code, further occurrences are ignored. The options cannot be * not present, we would not come here. Options which are ok are simply * copied over. */ lignore = cignore = 0; for (i=0, j=0; i= 0) { lvn[j++] = lv[i]; lvn[j++] = Tcl_NewIntObj(newlevel); newlevel = -1; lignore = 1; continue; } else if (lignore) { continue; } } else if (0 == strcmp(TclGetString(lv[i]), "-code")) { if (newcode >= 0) { lvn[j++] = lv[i]; lvn[j++] = Tcl_NewIntObj(newcode); newcode = -1; cignore = 1; continue; } else if (cignore) { continue; } } /* * Keep everything else, possibly copied down. */ lvn[j++] = lv[i]; lvn[j++] = lv[i+1]; } if (newlevel >= 0) { Tcl_Panic("Defined newlevel not used in rewrite"); } if (newcode >= 0) { Tcl_Panic("Defined newcode not used in rewrite"); } if (explicitResult) { lvn[j++] = lv[i]; } msg = Tcl_NewListObj(j, lvn); ckfree(lvn); return msg; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelErrorInterp -- * * TIP #219, Tcl Channel Reflection API. * Return the message stored by the channel driver. * * Results: * Tcl error message object. * * Side effects: * Resets the stored data to NULL. * *---------------------------------------------------------------------- */ void Tcl_GetChannelErrorInterp( Tcl_Interp *interp, /* Interp to query. */ Tcl_Obj **msg) /* Place for error message. */ { Interp *iPtr = (Interp *) interp; *msg = iPtr->chanMsg; iPtr->chanMsg = NULL; } /* *---------------------------------------------------------------------- * * Tcl_GetChannelError -- * * TIP #219, Tcl Channel Reflection API. * Return the message stored by the channel driver. * * Results: * Tcl error message object. * * Side effects: * Resets the stored data to NULL. * *---------------------------------------------------------------------- */ void Tcl_GetChannelError( Tcl_Channel chan, /* Channel to query. */ Tcl_Obj **msg) /* Place for error message. */ { ChannelState *statePtr = ((Channel *) chan)->state; *msg = statePtr->chanMsg; statePtr->chanMsg = NULL; } /* *---------------------------------------------------------------------- * * Tcl_ChannelTruncateProc -- * * TIP #208 (subsection relating to truncation, based on TIP #206). * Return the Tcl_DriverTruncateProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_5) { return NULL; } return chanTypePtr->truncateProc; } /* *---------------------------------------------------------------------- * * DupChannelInternalRep -- * * Initialize the internal representation of a new Tcl_Obj to a copy of * the internal representation of an existing string object. * * Results: * None. * * Side effects: * copyPtr's internal rep is set to a copy of srcPtr's internal * representation. * *---------------------------------------------------------------------- */ static void DupChannelInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "Channel". */ Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; resPtr->refCount++; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->typePtr = srcPtr->typePtr; } /* *---------------------------------------------------------------------- * * FreeChannelInternalRep -- * * Release statePtr storage. * * Results: * None. * * Side effects: * May cause state to be freed. * *---------------------------------------------------------------------- */ static void FreeChannelInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; objPtr->typePtr = NULL; if (--resPtr->refCount) { return; } Tcl_Release(resPtr->statePtr); ckfree(resPtr); } #if 0 /* * For future debugging work, a simple function to print the flags of a * channel in semi-readable form. */ static int DumpFlags( char *str, int flags) { int i = 0; char buf[24]; #define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_')) ChanFlag('r', TCL_READABLE); ChanFlag('w', TCL_WRITABLE); ChanFlag('n', CHANNEL_NONBLOCKING); ChanFlag('l', CHANNEL_LINEBUFFERED); ChanFlag('u', CHANNEL_UNBUFFERED); ChanFlag('F', BG_FLUSH_SCHEDULED); ChanFlag('c', CHANNEL_CLOSED); ChanFlag('E', CHANNEL_EOF); ChanFlag('S', CHANNEL_STICKY_EOF); ChanFlag('B', CHANNEL_BLOCKED); ChanFlag('/', INPUT_SAW_CR); ChanFlag('D', CHANNEL_DEAD); ChanFlag('R', CHANNEL_RAW_MODE); ChanFlag('x', CHANNEL_INCLOSE); buf[i] ='\0'; fprintf(stderr, "%s: %s\n", str, buf); return 0; } #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/generic/tclIOCmd.c0000644000175000017500000015212114554262142015062 0ustar sergeisergei/* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Callback structure for accept callback in a TCP server. */ typedef struct AcceptCallback { char *script; /* Script to invoke. */ Tcl_Interp *interp; /* Interpreter in which to run it. */ } AcceptCallback; /* * Thread local storage used to maintain a per-thread stdout channel obj. * It must be per-thread because of std channel limitations. */ typedef struct ThreadSpecificData { int initialized; /* Set to 1 when the module is initialized. */ Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Static functions for this file: */ static void FinalizeIOCmdTSD(ClientData clientData); static void AcceptCallbackProc(ClientData callbackData, Tcl_Channel chan, char *address, int port); static int ChanPendingObjCmd(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ChanTruncateObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void RegisterTcpServerInterpCleanup(Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr); static void TcpAcceptCallbacksDeleteProc(ClientData clientData, Tcl_Interp *interp); static void TcpServerCloseProc(ClientData callbackData); static void UnregisterTcpServerInterpCleanupProc( Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr); /* *---------------------------------------------------------------------- * * FinalizeIOCmdTSD -- * * Release the storage associated with the per-thread cache. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void FinalizeIOCmdTSD( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->stdoutObjPtr != NULL) { Tcl_DecrRefCount(tsdPtr->stdoutObjPtr); tsdPtr->stdoutObjPtr = NULL; } tsdPtr->initialized = 0; } /* *---------------------------------------------------------------------- * * Tcl_PutsObjCmd -- * * This function is invoked to process the "puts" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Produces output on a channel. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_PutsObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to puts on. */ Tcl_Obj *string; /* String to write. */ Tcl_Obj *chanObjPtr = NULL; /* channel object. */ int newline; /* Add a newline at end? */ int result; /* Result of puts operation. */ int mode; /* Mode in which channel is opened. */ ThreadSpecificData *tsdPtr; switch (objc) { case 2: /* [puts $x] */ string = objv[1]; newline = 1; break; case 3: /* [puts -nonewline $x] or [puts $chan $x] */ if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) { newline = 0; } else { newline = 1; chanObjPtr = objv[1]; } string = objv[2]; break; case 4: /* [puts -nonewline $chan $x] or * [puts $chan $x nonewline] */ newline = 0; if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) { chanObjPtr = objv[2]; string = objv[3]; break; } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) { /* * The code below provides backwards compatibility with an old * form of the command that is no longer recommended or * documented. See also [Bug #3151675]. Will be removed in Tcl 9, * maybe even earlier. */ chanObjPtr = objv[1]; string = objv[2]; break; } /* Fall through */ default: /* [puts] or * [puts some bad number of arguments...] */ Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string"); return TCL_ERROR; } if (chanObjPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->initialized) { tsdPtr->initialized = 1; TclNewLiteralStringObj(tsdPtr->stdoutObjPtr, "stdout"); Tcl_IncrRefCount(tsdPtr->stdoutObjPtr); Tcl_CreateThreadExitHandler(FinalizeIOCmdTSD, NULL); } chanObjPtr = tsdPtr->stdoutObjPtr; } if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for writing", TclGetString(chanObjPtr))); return TCL_ERROR; } TclChannelPreserve(chan); result = Tcl_WriteObj(chan, string); if (result < 0) { goto error; } if (newline != 0) { result = Tcl_WriteChars(chan, "\n", 1); if (result < 0) { goto error; } } TclChannelRelease(chan); return TCL_OK; /* * TIP #219. * Capture error messages put by the driver into the bypass area and put * them into the regular interpreter result. Fall back to the regular * message if nothing was found in the bypass. */ error: if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_FlushObjCmd -- * * This function is called to process the Tcl "flush" command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * May cause output to appear on the specified channel. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_FlushObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *chanObjPtr; Tcl_Channel chan; /* The channel to flush on. */ int mode; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } chanObjPtr = objv[1]; if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for writing", TclGetString(chanObjPtr))); return TCL_ERROR; } TclChannelPreserve(chan); if (Tcl_Flush(chan) != TCL_OK) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error flushing \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); return TCL_ERROR; } TclChannelRelease(chan); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetsObjCmd -- * * This function is called to process the Tcl "gets" command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * May consume input from channel. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_GetsObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to read from. */ int lineLen; /* Length of line just read. */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *linePtr, *chanObjPtr; int code = TCL_OK; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?"); return TCL_ERROR; } chanObjPtr = objv[1]; if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for reading", TclGetString(chanObjPtr))); return TCL_ERROR; } TclChannelPreserve(chan); TclNewObj(linePtr); lineLen = Tcl_GetsObj(chan, linePtr); if (lineLen < 0) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { Tcl_DecrRefCount(linePtr); /* * TIP #219. * Capture error messages put by the driver into the bypass area * and put them into the regular interpreter result. Fall back to * the regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error reading \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } code = TCL_ERROR; goto done; } lineLen = -1; } if (objc == 3) { if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr, TCL_LEAVE_ERR_MSG) == NULL) { code = TCL_ERROR; goto done; } Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen)); } else { Tcl_SetObjResult(interp, linePtr); } done: TclChannelRelease(chan); return code; } /* *---------------------------------------------------------------------- * * Tcl_ReadObjCmd -- * * This function is invoked to process the Tcl "read" command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * May consume input from channel. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_ReadObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to read from. */ int newline, i; /* Discard newline at end? */ int toRead; /* How many bytes to read? */ int charactersRead; /* How many characters were read? */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *resultPtr, *chanObjPtr; if ((objc != 2) && (objc != 3)) { Interp *iPtr; argerror: iPtr = (Interp *) interp; Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?"); /* * Do not append directly; that makes ensembles using this command as * a subcommand produce the wrong message. */ iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS; Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? channelId"); return TCL_ERROR; } i = 1; newline = 0; if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) { newline = 1; i++; } if (i == objc) { goto argerror; } chanObjPtr = objv[i]; if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for reading", TclGetString(chanObjPtr))); return TCL_ERROR; } i++; /* Consumed channel name. */ /* * Compute how many bytes to read. */ toRead = -1; if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { /* * The code below provides backwards compatibility with an old * form of the command that is no longer recommended or * documented. See also [Bug #3151675]. Will be removed in Tcl 9, * maybe even earlier. */ if (strcmp(TclGetString(objv[i]), "nonewline") != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected non-negative integer but got \"%s\"", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; } newline = 1; } } TclNewObj(resultPtr); Tcl_IncrRefCount(resultPtr); TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); if (charactersRead < 0) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error reading \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } /* * If requested, remove the last newline in the channel if at EOF. */ if ((charactersRead > 0) && (newline != 0)) { const char *result; int length; result = TclGetStringFromObj(resultPtr, &length); if (result[length - 1] == '\n') { Tcl_SetObjLength(resultPtr, length - 1); } } Tcl_SetObjResult(interp, resultPtr); TclChannelRelease(chan); Tcl_DecrRefCount(resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_SeekObjCmd -- * * This function is invoked to process the Tcl "seek" command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Moves the position of the access point on the specified channel. May * flush queued output. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_SeekObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ Tcl_WideInt offset; /* Where to seek? */ int mode; /* How to seek? */ Tcl_WideInt result; /* Of calling Tcl_Seek. */ int optionIndex; static const char *const originOptions[] = { "start", "current", "end", NULL }; static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) { return TCL_ERROR; } mode = SEEK_SET; if (objc == 4) { if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } mode = modeArray[optionIndex]; } TclChannelPreserve(chan); result = Tcl_Seek(chan, offset, mode); if (result == Tcl_LongAsWide(-1)) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error during seek on \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); } TclChannelRelease(chan); return TCL_ERROR; } TclChannelRelease(chan); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_TellObjCmd -- * * This function is invoked to process the Tcl "tell" command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_TellObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ Tcl_WideInt newLoc; int code; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } /* * Try to find a channel with the right name and permissions in the IO * channel table of this interpreter. */ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } TclChannelPreserve(chan); newLoc = Tcl_Tell(chan); /* * TIP #219. * Capture error messages put by the driver into the bypass area and put * them into the regular interpreter result. */ code = TclChanCaughtErrorBypass(interp, chan); TclChannelRelease(chan); if (code) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(newLoc)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_CloseObjCmd -- * * This function is invoked to process the Tcl "close" command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * May discard queued input; may flush queued output. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_CloseObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to close. */ static const char *const dirOptions[] = { "read", "write", NULL }; static const int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE}; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { int index, dir; /* * Get direction requested to close, and check syntax. */ if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0, &index) != TCL_OK) { return TCL_ERROR; } dir = dirArray[index]; /* * Check direction against channel mode. It is an error if we try to * close a direction not supported by the channel (already closed, or * never opened for that direction). */ if (!(dir & Tcl_GetChannelMode(chan))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Half-close of %s-side not possible, side not opened" " or already closed", dirOptions[index])); return TCL_ERROR; } /* * Special handling is needed if and only if the channel mode supports * more than the direction to close. Because if the close the last * direction supported we can and will go through the regular * process. */ if ((Tcl_GetChannelMode(chan) & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) { return Tcl_CloseEx(interp, chan, dir); } } if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) { /* * If there is an error message and it ends with a newline, remove the * newline. This is done for command pipeline channels where the error * output from the subprocesses is stored in interp's result. * * NOTE: This is likely to not have any effect on regular error * messages produced by drivers during the closing of a channel, * because the Tcl convention is that such error messages do not have * a terminating newline. */ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); const char *string; int len; if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); Tcl_SetObjResult(interp, resultPtr); } string = TclGetStringFromObj(resultPtr, &len); if ((len > 0) && (string[len - 1] == '\n')) { Tcl_SetObjLength(resultPtr, len - 1); } return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_FconfigureObjCmd -- * * This function is invoked to process the Tcl "fconfigure" command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * May modify the behavior of an IO channel. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_FconfigureObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *optionName, *valueName; Tcl_Channel chan; /* The channel to set a mode on. */ int i; /* Iterate over arg-value pairs. */ if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (objc == 2) { Tcl_DString ds; /* DString to hold result of calling * Tcl_GetChannelOption. */ Tcl_DStringInit(&ds); if (Tcl_GetChannelOption(interp, chan, NULL, &ds) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } Tcl_DStringResult(interp, &ds); return TCL_OK; } else if (objc == 3) { Tcl_DString ds; /* DString to hold result of calling * Tcl_GetChannelOption. */ Tcl_DStringInit(&ds); optionName = TclGetString(objv[2]); if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } Tcl_DStringResult(interp, &ds); return TCL_OK; } for (i = 3; i < objc; i += 2) { optionName = TclGetString(objv[i-1]); valueName = TclGetString(objv[i]); if (Tcl_SetChannelOption(interp, chan, optionName, valueName) != TCL_OK) { return TCL_ERROR; } } return TCL_OK; } /* *--------------------------------------------------------------------------- * * Tcl_EofObjCmd -- * * This function is invoked to process the Tcl "eof" command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Sets interp's result to boolean true or false depending on whether the * specified channel has an EOF condition. * *--------------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_EofObjCmd( ClientData unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_Eof(chan))); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ExecObjCmd -- * * This function is invoked to process the "exec" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_ExecObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *resultPtr; const char **argv; /* An array for the string arguments. Stored * on the _Tcl_ stack. */ const char *string; Tcl_Channel chan; int argc, background, i, index, keepNewline, result, skip, length; int ignoreStderr; static const char *const options[] = { "-ignorestderr", "-keepnewline", "--", NULL }; enum options { EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST }; /* * Check for any leading option arguments. */ keepNewline = 0; ignoreStderr = 0; for (skip = 1; skip < objc; skip++) { string = TclGetString(objv[skip]); if (string[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[skip], options, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } if (index == EXEC_KEEPNEWLINE) { keepNewline = 1; } else if (index == EXEC_IGNORESTDERR) { ignoreStderr = 1; } else { skip++; break; } } if (objc <= skip) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? arg ?arg ...?"); return TCL_ERROR; } /* * See if the command is to be run in background. */ background = 0; string = TclGetString(objv[objc - 1]); if ((string[0] == '&') && (string[1] == '\0')) { objc--; background = 1; } /* * Create the string argument array "argv". Make sure argv is large enough * to hold the argc arguments plus 1 extra for the zero end-of-argv word. */ argc = objc - skip; argv = (const char **)TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *)); /* * Copy the string conversions of each (post option) object into the * argument vector. */ for (i = 0; i < argc; i++) { argv[i] = TclGetString(objv[i + skip]); } argv[argc] = NULL; chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 : ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR)); /* * Free the argv array. */ TclStackFree(interp, (void *) argv); if (chan == NULL) { return TCL_ERROR; } if (background) { /* * Store the list of PIDs from the pipeline in interp's result and * detach the PIDs (instead of waiting for them). */ TclGetAndDetachPids(interp, chan); if (Tcl_Close(interp, chan) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } TclNewObj(resultPtr); if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) { if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) { /* * TIP #219. * Capture error messages put by the driver into the bypass area * and put them into the regular interpreter result. Fall back to * the regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error reading output from command: %s", Tcl_PosixError(interp))); Tcl_DecrRefCount(resultPtr); } return TCL_ERROR; } } /* * If the process produced anything on stderr, it will have been returned * in the interpreter result. It needs to be appended to the result * string. */ result = Tcl_Close(interp, chan); Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp)); /* * If the last character of the result is a newline, then remove the * newline character. */ if (keepNewline == 0) { string = TclGetStringFromObj(resultPtr, &length); if ((length > 0) && (string[length - 1] == '\n')) { Tcl_SetObjLength(resultPtr, length - 1); } } Tcl_SetObjResult(interp, resultPtr); return result; } /* *--------------------------------------------------------------------------- * * Tcl_FblockedObjCmd -- * * This function is invoked to process the Tcl "fblocked" command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Sets interp's result to boolean true or false depending on whether the * preceding input operation on the channel would have blocked. * *--------------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_FblockedObjCmd( ClientData unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; int mode; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for reading", TclGetString(objv[1]))); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_InputBlocked(chan))); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_OpenObjCmd -- * * This function is invoked to process the "open" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_OpenObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int pipeline, prot; const char *modeString, *what; Tcl_Channel chan; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "fileName ?access? ?permissions?"); return TCL_ERROR; } prot = 0666; if (objc == 2) { modeString = "r"; } else { modeString = TclGetString(objv[2]); if (objc == 4) { const char *permString = TclGetString(objv[3]); int code = TCL_ERROR; int scanned = TclParseAllWhiteSpace(permString, -1); /* * Support legacy octal numbers. */ if ((permString[scanned] == '0') && (permString[scanned+1] >= '0') && (permString[scanned+1] <= '7')) { Tcl_Obj *permObj; TclNewLiteralStringObj(permObj, "0o"); Tcl_AppendToObj(permObj, permString+scanned+1, -1); code = TclGetIntFromObj(NULL, permObj, &prot); Tcl_DecrRefCount(permObj); } if ((code == TCL_ERROR) && TclGetIntFromObj(interp, objv[3], &prot) != TCL_OK) { return TCL_ERROR; } } } pipeline = 0; what = TclGetString(objv[1]); if (what[0] == '|') { pipeline = 1; } /* * Open the file or create a process pipeline. */ if (!pipeline) { chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot); } else { int mode, seekFlag, cmdObjc, binary; const char **cmdArgv; if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) { return TCL_ERROR; } mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary); if (mode == -1) { chan = NULL; } else { int flags = TCL_STDERR | TCL_ENFORCE_MODE; switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { case O_RDONLY: flags |= TCL_STDOUT; break; case O_WRONLY: flags |= TCL_STDIN; break; case O_RDWR: flags |= (TCL_STDIN | TCL_STDOUT); break; default: Tcl_Panic("Tcl_OpenCmd: invalid mode value"); break; } chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags); if (binary && chan) { Tcl_SetChannelOption(interp, chan, "-translation", "binary"); } } ckfree(cmdArgv); } if (chan == NULL) { return TCL_ERROR; } Tcl_RegisterChannel(interp, chan); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TcpAcceptCallbacksDeleteProc -- * * Assocdata cleanup routine called when an interpreter is being deleted * to set the interp field of all the accept callback records registered * with the interpreter to NULL. This will prevent the interpreter from * being used in the future to eval accept scripts. * * Results: * None. * * Side effects: * Deallocates memory and sets the interp field of all the accept * callback records to NULL to prevent this interpreter from being used * subsequently to eval accept scripts. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void TcpAcceptCallbacksDeleteProc( ClientData clientData, /* Data which was passed when the assocdata * was registered. */ Tcl_Interp *interp) /* Interpreter being deleted - not used. */ { Tcl_HashTable *hTblPtr = (Tcl_HashTable *)clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_GetHashValue(hPtr); acceptCallbackPtr->interp = NULL; } Tcl_DeleteHashTable(hTblPtr); ckfree(hTblPtr); } /* *---------------------------------------------------------------------- * * RegisterTcpServerInterpCleanup -- * * Registers an accept callback record to have its interp field set to * NULL when the interpreter is deleted. * * Results: * None. * * Side effects: * When, in the future, the interpreter is deleted, the interp field of * the accept callback data structure will be set to NULL. This will * prevent attempts to eval the accept script in a deleted interpreter. * *---------------------------------------------------------------------- */ static void RegisterTcpServerInterpCleanup( Tcl_Interp *interp, /* Interpreter for which we want to be * informed of deletion. */ AcceptCallback *acceptCallbackPtr) /* The accept callback record whose interp * field we want set to NULL when the * interpreter is deleted. */ { Tcl_HashTable *hTblPtr; /* Hash table for accept callback records to * smash when the interpreter will be * deleted. */ Tcl_HashEntry *hPtr; /* Entry for this record. */ int isNew; /* Is the entry new? */ hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL); if (hTblPtr == NULL) { hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS); Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks", TcpAcceptCallbacksDeleteProc, hTblPtr); } hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew); if (!isNew) { Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table"); } Tcl_SetHashValue(hPtr, acceptCallbackPtr); } /* *---------------------------------------------------------------------- * * UnregisterTcpServerInterpCleanupProc -- * * Unregister a previously registered accept callback record. The interp * field of this record will no longer be set to NULL in the future when * the interpreter is deleted. * * Results: * None. * * Side effects: * Prevents the interp field of the accept callback record from being set * to NULL in the future when the interpreter is deleted. * *---------------------------------------------------------------------- */ static void UnregisterTcpServerInterpCleanupProc( Tcl_Interp *interp, /* Interpreter in which the accept callback * record was registered. */ AcceptCallback *acceptCallbackPtr) /* The record for which to delete the * registration. */ { Tcl_HashTable *hTblPtr; Tcl_HashEntry *hPtr; hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL); if (hTblPtr == NULL) { return; } hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr); if (hPtr != NULL) { Tcl_DeleteHashEntry(hPtr); } } /* *---------------------------------------------------------------------- * * AcceptCallbackProc -- * * This callback is invoked by the TCP channel driver when it accepts a * new connection from a client on a server socket. * * Results: * None. * * Side effects: * Whatever the script does. * *---------------------------------------------------------------------- */ static void AcceptCallbackProc( ClientData callbackData, /* The data stored when the callback was * created in the call to * Tcl_OpenTcpServer. */ Tcl_Channel chan, /* Channel for the newly accepted * connection. */ char *address, /* Address of client that was accepted. */ int port) /* Port of client that was accepted. */ { AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData; /* * Check if the callback is still valid; the interpreter may have gone * away, this is signalled by setting the interp field of the callback * data to NULL. */ if (acceptCallbackPtr->interp != NULL) { char portBuf[TCL_INTEGER_SPACE]; char *script = acceptCallbackPtr->script; Tcl_Interp *interp = acceptCallbackPtr->interp; int result; Tcl_Preserve(script); Tcl_Preserve(interp); TclFormatInt(portBuf, port); Tcl_RegisterChannel(interp, chan); /* * Artificially bump the refcount to protect the channel from being * deleted while the script is being evaluated. */ Tcl_RegisterChannel(NULL, chan); result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan), " ", address, " ", portBuf, NULL); if (result != TCL_OK) { Tcl_BackgroundException(interp, result); Tcl_UnregisterChannel(interp, chan); } /* * Decrement the artificially bumped refcount. After this it is not * safe anymore to use "chan", because it may now be deleted. */ Tcl_UnregisterChannel(NULL, chan); Tcl_Release(interp); Tcl_Release(script); } else { /* * The interpreter has been deleted, so there is no useful way to use * the client socket - just close it. */ Tcl_Close(NULL, chan); } } /* *---------------------------------------------------------------------- * * TcpServerCloseProc -- * * This callback is called when the TCP server channel for which it was * registered is being closed. It informs the interpreter in which the * accept script is evaluated (if that interpreter still exists) that * this channel no longer needs to be informed if the interpreter is * deleted. * * Results: * None. * * Side effects: * In the future, if the interpreter is deleted this channel will no * longer be informed. * *---------------------------------------------------------------------- */ static void TcpServerCloseProc( ClientData callbackData) /* The data passed in the call to * Tcl_CreateCloseHandler. */ { AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData; /* The actual data. */ if (acceptCallbackPtr->interp != NULL) { UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp, acceptCallbackPtr); } Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC); ckfree(acceptCallbackPtr); } /* *---------------------------------------------------------------------- * * Tcl_SocketObjCmd -- * * This function is invoked to process the "socket" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Creates a socket based channel. * *---------------------------------------------------------------------- */ int Tcl_SocketObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const socketOptions[] = { "-async", "-myaddr", "-myport", "-server", NULL }; enum socketOptions { SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER }; int optionIndex, a, server = 0, port, myport = 0, async = 0; const char *host, *script = NULL, *myaddr = NULL; Tcl_Channel chan; if (TclpHasSockets(interp) != TCL_OK) { return TCL_ERROR; } for (a = 1; a < objc; a++) { const char *arg = Tcl_GetString(objv[a]); if (arg[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, "option", TCL_EXACT, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum socketOptions) optionIndex) { case SKT_ASYNC: if (server == 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot set -async option for server sockets", -1)); return TCL_ERROR; } async = 1; break; case SKT_MYADDR: a++; if (a >= objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "no argument given for -myaddr option", -1)); return TCL_ERROR; } myaddr = TclGetString(objv[a]); break; case SKT_MYPORT: { const char *myPortName; a++; if (a >= objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "no argument given for -myport option", -1)); return TCL_ERROR; } myPortName = TclGetString(objv[a]); if (TclSockGetPort(interp, myPortName, "tcp", &myport) != TCL_OK) { return TCL_ERROR; } break; } case SKT_SERVER: if (async == 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot set -async option for server sockets", -1)); return TCL_ERROR; } server = 1; a++; if (a >= objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "no argument given for -server option", -1)); return TCL_ERROR; } script = TclGetString(objv[a]); break; default: Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions"); } } if (server) { host = myaddr; /* NULL implies INADDR_ANY */ if (myport != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "option -myport is not valid for servers", -1)); return TCL_ERROR; } } else if (a < objc) { host = TclGetString(objv[a]); a++; } else { Interp *iPtr; wrongNumArgs: iPtr = (Interp *) interp; Tcl_WrongNumArgs(interp, 1, objv, "?-myaddr addr? ?-myport myport? ?-async? host port"); iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS; Tcl_WrongNumArgs(interp, 1, objv, "-server command ?-myaddr addr? port"); return TCL_ERROR; } if (a == objc-1) { if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp", &port) != TCL_OK) { return TCL_ERROR; } } else { goto wrongNumArgs; } if (server) { AcceptCallback *acceptCallbackPtr = (AcceptCallback *) ckalloc(sizeof(AcceptCallback)); unsigned len = strlen(script) + 1; char *copyScript = (char *)ckalloc(len); memcpy(copyScript, script, len); acceptCallbackPtr->script = copyScript; acceptCallbackPtr->interp = interp; chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc, acceptCallbackPtr); if (chan == NULL) { ckfree(copyScript); ckfree(acceptCallbackPtr); return TCL_ERROR; } /* * Register with the interpreter to let us know when the interpreter * is deleted (by having the callback set the interp field of the * acceptCallbackPtr's structure to NULL). This is to avoid trying to * eval the script in a deleted interpreter. */ RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr); /* * Register a close callback. This callback will inform the * interpreter (if it still exists) that this channel does not need to * be informed when the interpreter is deleted. */ Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr); } else { chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async); if (chan == NULL) { return TCL_ERROR; } } Tcl_RegisterChannel(interp, chan); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_FcopyObjCmd -- * * This function is invoked to process the "fcopy" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Moves data between two channels and possibly sets up a background copy * handler. * *---------------------------------------------------------------------- */ int Tcl_FcopyObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel inChan, outChan; int mode, i, index; Tcl_WideInt toRead; Tcl_Obj *cmdPtr; static const char *const switches[] = { "-size", "-command", NULL }; enum { FcopySize, FcopyCommand }; if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) { Tcl_WrongNumArgs(interp, 1, objv, "input output ?-size size? ?-command callback?"); return TCL_ERROR; } /* * Parse the channel arguments and verify that they are readable or * writable, as appropriate. */ if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for reading", TclGetString(objv[1]))); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for writing", TclGetString(objv[2]))); return TCL_ERROR; } toRead = -1; cmdPtr = NULL; for (i = 3; i < objc; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case FcopySize: if (Tcl_GetWideIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) { return TCL_ERROR; } if (toRead < 0) { /* * Handle all negative sizes like -1, meaning 'copy all'. By * resetting toRead we avoid changes in the core copying * functions (which explicitly check for -1 and crash on any * other negative value). */ toRead = -1; } break; case FcopyCommand: cmdPtr = objv[i+1]; break; } } return TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr); } /* *--------------------------------------------------------------------------- * * ChanPendingObjCmd -- * * This function is invoked to process the Tcl "chan pending" command * (TIP #287). See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Sets interp's result to the number of bytes of buffered input or * output (depending on whether the first argument is "input" or * "output"), or -1 if the channel wasn't opened for that mode. * *--------------------------------------------------------------------------- */ /* ARGSUSED */ static int ChanPendingObjCmd( ClientData unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; int index, mode; static const char *const options[] = {"input", "output", NULL}; enum options {PENDING_INPUT, PENDING_OUTPUT}; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "mode channelId"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0, &index) != TCL_OK) { return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[2], &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case PENDING_INPUT: if (!(mode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan))); } break; case PENDING_OUTPUT: if (!(mode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan))); } break; } return TCL_OK; } /* *---------------------------------------------------------------------- * * ChanTruncateObjCmd -- * * This function is invoked to process the "chan truncate" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Truncates a channel (or rather a file underlying a channel). * *---------------------------------------------------------------------- */ static int ChanTruncateObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; Tcl_WideInt length; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { /* * User is supplying an explicit length. */ if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) { return TCL_ERROR; } if (length < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot truncate to negative length of file", -1)); return TCL_ERROR; } } else { /* * User wants to truncate to the current file position. */ length = Tcl_Tell(chan); if (length == Tcl_WideAsLong(-1)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not determine current location in \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } } if (Tcl_TruncateChannel(chan, length) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error during truncate on \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * ChanPipeObjCmd -- * * This function is invoked to process the "chan pipe" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Creates a pair of Tcl channels wrapping both ends of a new * anonymous pipe. * *---------------------------------------------------------------------- */ static int ChanPipeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel rchan, wchan; const char *channelNames[2]; Tcl_Obj *resultPtr; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } if (Tcl_CreatePipe(interp, &rchan, &wchan, 0) != TCL_OK) { return TCL_ERROR; } channelNames[0] = Tcl_GetChannelName(rchan); channelNames[1] = Tcl_GetChannelName(wchan); TclNewObj(resultPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(channelNames[0], -1)); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(channelNames[1], -1)); Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclChannelNamesCmd -- * * This function is invoked to process the "chan names" and "file * channels" Tcl commands. See the user documentation for details on * what they do. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclChannelNamesCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc < 1 || objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } return Tcl_GetChannelNamesEx(interp, ((objc == 1) ? NULL : TclGetString(objv[1]))); } /* *---------------------------------------------------------------------- * * TclInitChanCmd -- * * This function is invoked to create the "chan" Tcl command. See the * user documentation for details on what it does. * * Results: * A Tcl command handle. * * Side effects: * None (since nothing is byte-compiled). * *---------------------------------------------------------------------- */ Tcl_Command TclInitChanCmd( Tcl_Interp *interp) { /* * Most commands are plugged directly together, but some are done via * alias-like rewriting; [chan configure] is this way for security reasons * (want overwriting of [fconfigure] to control that nicely), and [chan * names] because the functionality isn't available as a separate command * function at the moment. */ static const EnsembleImplMap initMap[] = { {"blocked", Tcl_FblockedObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"close", Tcl_CloseObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0}, {"create", TclChanCreateObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */ {"eof", Tcl_EofObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"event", Tcl_FileEventObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0}, {"flush", Tcl_FlushObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"gets", Tcl_GetsObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"names", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"pending", ChanPendingObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #287 */ {"pipe", ChanPipeObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, /* TIP #304 */ {"pop", TclChanPopObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, /* TIP #230 */ {"postevent", TclChanPostEventObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */ {"push", TclChanPushObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #230 */ {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0}, {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0}, {"seek", Tcl_SeekObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0}, {"tell", Tcl_TellObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"truncate", ChanTruncateObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, /* TIP #208 */ {NULL, NULL, NULL, NULL, NULL, 0} }; static const char *const extras[] = { "configure", "::fconfigure", NULL }; Tcl_Command ensemble; Tcl_Obj *mapObj; int i; ensemble = TclMakeEnsemble(interp, "chan", initMap); Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj); for (i=0 ; extras[i] ; i+=2) { /* * Can assume that reference counts are all incremented. */ Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj(extras[i], -1), Tcl_NewStringObj(extras[i+1], -1)); } Tcl_SetEnsembleMappingDict(interp, ensemble, mapObj); return ensemble; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclIOGT.c0000644000175000017500000011464114554262142014676 0ustar sergeisergei/* * tclIOGT.c -- * * Implements a generic transformation exposing the underlying API at the * script level. Contributed by Andreas Kupries. * * Copyright (c) 2000 Ajuba Solutions * Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" /* * Forward declarations of internal procedures. First the driver procedures of * the transformation. */ static int TransformBlockModeProc(ClientData instanceData, int mode); static int TransformCloseProc(ClientData instanceData, Tcl_Interp *interp); static int TransformClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags); static int TransformInputProc(ClientData instanceData, char *buf, int toRead, int *errorCodePtr); static int TransformOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr); static int TransformSeekProc(ClientData instanceData, long offset, int mode, int *errorCodePtr); static int TransformSetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); static int TransformGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static void TransformWatchProc(ClientData instanceData, int mask); static int TransformGetFileHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static int TransformNotifyProc(ClientData instanceData, int mask); static Tcl_WideInt TransformWideSeekProc(ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr); /* * Forward declarations of internal procedures. Secondly the procedures for * handling and generating fileeevents. */ static void TransformChannelHandlerTimer(ClientData clientData); /* * Forward declarations of internal procedures. Third, helper procedures * encapsulating essential tasks. */ typedef struct TransformChannelData TransformChannelData; static int ExecuteCallback(TransformChannelData *ctrl, Tcl_Interp *interp, unsigned char *op, unsigned char *buf, int bufLen, int transmit, int preserve); /* * Action codes to give to 'ExecuteCallback' (argument 'transmit'), telling * the procedure what to do with the result of the script it calls. */ #define TRANSMIT_DONT 0 /* No transfer to do. */ #define TRANSMIT_DOWN 1 /* Transfer to the underlying channel. */ #define TRANSMIT_SELF 2 /* Transfer into our channel. */ #define TRANSMIT_IBUF 3 /* Transfer to internal input buffer. */ #define TRANSMIT_NUM 4 /* Transfer number to 'maxRead'. */ /* * Codes for 'preserve' of 'ExecuteCallback'. */ #define P_PRESERVE 1 #define P_NO_PRESERVE 0 /* * Strings for the action codes delivered to the script implementing a * transformation. Argument 'op' of 'ExecuteCallback'. */ #define A_CREATE_WRITE (UCHARP("create/write")) #define A_DELETE_WRITE (UCHARP("delete/write")) #define A_FLUSH_WRITE (UCHARP("flush/write")) #define A_WRITE (UCHARP("write")) #define A_CREATE_READ (UCHARP("create/read")) #define A_DELETE_READ (UCHARP("delete/read")) #define A_FLUSH_READ (UCHARP("flush/read")) #define A_READ (UCHARP("read")) #define A_QUERY_MAXREAD (UCHARP("query/maxRead")) #define A_CLEAR_READ (UCHARP("clear/read")) /* * Management of a simple buffer. */ typedef struct ResultBuffer ResultBuffer; static inline void ResultClear(ResultBuffer *r); static inline void ResultInit(ResultBuffer *r); static inline int ResultEmpty(ResultBuffer *r); static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf, size_t toRead); static inline void ResultAdd(ResultBuffer *r, unsigned char *buf, size_t toWrite); /* * This structure describes the channel type structure for Tcl-based * transformations. */ static const Tcl_ChannelType transformChannelType = { "transform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TransformCloseProc, /* Close proc. */ TransformInputProc, /* Input proc. */ TransformOutputProc, /* Output proc. */ TransformSeekProc, /* Seek proc. */ TransformSetOptionProc, /* Set option proc. */ TransformGetOptionProc, /* Get option proc. */ TransformWatchProc, /* Initialize notifier. */ TransformGetFileHandleProc, /* Get OS handles out of channel. */ TransformClose2Proc, /* close2proc */ TransformBlockModeProc, /* Set blocking/nonblocking mode.*/ NULL, /* Flush proc. */ TransformNotifyProc, /* Handling of events bubbling up. */ TransformWideSeekProc, /* Wide seek proc. */ NULL, /* Thread action. */ NULL /* Truncate. */ }; /* * Possible values for 'flags' field in control structure, see below. */ #define CHANNEL_ASYNC (1<<0) /* Non-blocking mode. */ /* * Definition of the structure containing the information about the internal * input buffer. */ struct ResultBuffer { unsigned char *buf; /* Reference to the buffer area. */ size_t allocated; /* Allocated size of the buffer area. */ size_t used; /* Number of bytes in the buffer, no more than * number allocated. */ }; /* * Additional bytes to allocate during buffer expansion. */ #define INCREMENT 512 /* * Number of milliseconds to wait before firing an event to flush out * information waiting in buffers (fileevent support). */ #define FLUSH_DELAY 5 /* * Convenience macro to make some casts easier to use. */ #define UCHARP(x) ((unsigned char *) (x)) /* * Definition of a structure used by all transformations generated here to * maintain their local state. */ struct TransformChannelData { /* * General section. Data to integrate the transformation into the channel * system. */ Tcl_Channel self; /* Our own Channel handle. */ int readIsFlushed; /* Flag to note whether in.flushProc was * called or not. */ int eofPending; /* Flag: EOF seen down, not raised up */ int flags; /* Currently CHANNEL_ASYNC or zero. */ int watchMask; /* Current watch/event/interest mask. */ int mode; /* Mode of parent channel, OR'ed combination * of TCL_READABLE, TCL_WRITABLE. */ Tcl_TimerToken timer; /* Timer for automatic flushing of information * sitting in an internal buffer. Required for * full fileevent support. */ /* * Transformation specific data. */ int maxRead; /* Maximum allowed number of bytes to read, as * given to us by the Tcl script implementing * the transformation. */ Tcl_Interp *interp; /* Reference to the interpreter which created * the transformation. Used to execute the * code below. */ Tcl_Obj *command; /* Tcl code to execute for a buffer */ ResultBuffer result; /* Internal buffer used to store the result of * a transformation of incoming data. Also * serves as buffer of all data not yet * consumed by the reader. */ int refCount; }; static void PreserveData( TransformChannelData *dataPtr) { dataPtr->refCount++; } static void ReleaseData( TransformChannelData *dataPtr) { if (--dataPtr->refCount) { return; } ResultClear(&dataPtr->result); Tcl_DecrRefCount(dataPtr->command); ckfree(dataPtr); } /* *---------------------------------------------------------------------- * * TclChannelTransform -- * * Implements the Tcl "testchannel transform" debugging command. This is * part of the testing environment. This sets up a tcl script (cmdObjPtr) * to be used as a transform on the channel. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int TclChannelTransform( Tcl_Interp *interp, /* Interpreter for result. */ Tcl_Channel chan, /* Channel to transform. */ Tcl_Obj *cmdObjPtr) /* Script to use for transform. */ { Channel *chanPtr; /* The actual channel. */ ChannelState *statePtr; /* State info for channel. */ int mode; /* Read/write mode of the channel. */ int objc; TransformChannelData *dataPtr; Tcl_DString ds; if (chan == NULL) { return TCL_ERROR; } if (TCL_OK != TclListObjLength(interp, cmdObjPtr, &objc)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("-command value is not a list", -1)); return TCL_ERROR; } chanPtr = (Channel *) chan; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; chan = (Tcl_Channel) chanPtr; mode = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE)); /* * Now initialize the transformation state and stack it upon the specified * channel. One of the necessary things to do is to retrieve the blocking * regime of the underlying channel and to use the same for us too. */ dataPtr = (TransformChannelData *)ckalloc(sizeof(TransformChannelData)); dataPtr->refCount = 1; Tcl_DStringInit(&ds); Tcl_GetChannelOption(interp, chan, "-blocking", &ds); dataPtr->readIsFlushed = 0; dataPtr->eofPending = 0; dataPtr->flags = 0; if (ds.string[0] == '0') { dataPtr->flags |= CHANNEL_ASYNC; } Tcl_DStringFree(&ds); dataPtr->watchMask = 0; dataPtr->mode = mode; dataPtr->timer = NULL; dataPtr->maxRead = 4096; /* Initial value not relevant. */ dataPtr->interp = interp; dataPtr->command = cmdObjPtr; Tcl_IncrRefCount(dataPtr->command); ResultInit(&dataPtr->result); dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr, mode, chan); if (dataPtr->self == NULL) { Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan)); ReleaseData(dataPtr); return TCL_ERROR; } Tcl_Preserve(dataPtr->self); /* * At last initialize the transformation at the script level. */ PreserveData(dataPtr); if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL, A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){ Tcl_UnstackChannel(interp, chan); ReleaseData(dataPtr); return TCL_ERROR; } if ((dataPtr->mode & TCL_READABLE) && ExecuteCallback(dataPtr, NULL, A_CREATE_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK) { ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE); Tcl_UnstackChannel(interp, chan); ReleaseData(dataPtr); return TCL_ERROR; } ReleaseData(dataPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * ExecuteCallback -- * * Executes the defined callback for buffer and operation. * * Side effects: * As of the executed tcl script. * * Result: * A standard TCL error code. In case of an error a message is left in * the result area of the specified interpreter. * *---------------------------------------------------------------------- */ static int ExecuteCallback( TransformChannelData *dataPtr, /* Transformation with the callback. */ Tcl_Interp *interp, /* Current interpreter, possibly NULL. */ unsigned char *op, /* Operation invoking the callback. */ unsigned char *buf, /* Buffer to give to the script. */ int bufLen, /* And its length. */ int transmit, /* Flag, determines whether the result of the * callback is sent to the underlying channel * or not. */ int preserve) /* Flag. If true the procedure will preserve * the result state of all accessed * interpreters. */ { Tcl_Obj *resObj; /* See below, switch (transmit). */ int resLen; unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command); Tcl_Interp *eval = dataPtr->interp; Tcl_Preserve(eval); /* * Step 1, create the complete command to execute. Do this by appending * operation and buffer to operate upon to a copy of the callback * definition. We *cannot* create a list containing 3 objects and then use * 'Tcl_EvalObjv', because the command may contain additional prefixed * arguments. Feather's curried commands would come in handy here. */ if (preserve == P_PRESERVE) { state = Tcl_SaveInterpState(eval, res); } Tcl_IncrRefCount(command); Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1)); /* * Use a byte-array to prevent the misinterpretation of binary data coming * through as Utf while at the tcl level. */ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen)); /* * Step 2, execute the command at the global level of the interpreter used * to create the transformation. Destroy the command afterward. If an * error occurred and the current interpreter is defined and not equal to * the interpreter for the callback, then copy the error message into * current interpreter. Don't copy if in preservation mode. */ res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(command); command = NULL; if ((res != TCL_OK) && (interp != NULL) && (eval != interp) && (preserve == P_NO_PRESERVE)) { Tcl_SetObjResult(interp, Tcl_GetObjResult(eval)); Tcl_Release(eval); return res; } /* * Step 3, transmit a possible conversion result to the underlying * channel, or ourselves. */ switch (transmit) { case TRANSMIT_DONT: /* nothing to do */ break; case TRANSMIT_DOWN: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf, resLen); break; case TRANSMIT_SELF: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); break; case TRANSMIT_IBUF: resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); ResultAdd(&dataPtr->result, resBuf, resLen); break; case TRANSMIT_NUM: /* * Interpret result as integer number. */ resObj = Tcl_GetObjResult(eval); TclGetIntFromObj(eval, resObj, &dataPtr->maxRead); break; } Tcl_ResetResult(eval); if (preserve == P_PRESERVE) { (void) Tcl_RestoreInterpState(eval, state); } Tcl_Release(eval); return res; } /* *---------------------------------------------------------------------- * * TransformBlockModeProc -- * * Trap handler. Called by the generic IO system during option processing * to change the blocking mode of the channel. * * Side effects: * Forwards the request to the underlying channel. * * Result: * 0 if successful, errno when failed. * *---------------------------------------------------------------------- */ static int TransformBlockModeProc( ClientData instanceData, /* State of transformation. */ int mode) /* New blocking mode. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; if (mode == TCL_MODE_NONBLOCKING) { dataPtr->flags |= CHANNEL_ASYNC; } else { dataPtr->flags &= ~CHANNEL_ASYNC; } return 0; } /* *---------------------------------------------------------------------- * * TransformCloseProc/TransformClose2Proc -- * * Trap handler. Called by the generic IO system during destruction of * the transformation channel. * * Side effects: * Releases the memory allocated in 'Tcl_TransformObjCmd'. * * Result: * None. * *---------------------------------------------------------------------- */ static int TransformCloseProc( ClientData instanceData, Tcl_Interp *interp) { TransformChannelData *dataPtr = instanceData; /* * Important: In this procedure 'dataPtr->self' already points to the * underlying channel. * * There is no need to cancel an existing channel handler, this is already * done. Either by 'Tcl_UnstackChannel' or by the general cleanup in * 'Tcl_Close'. * * But we have to cancel an active timer to prevent it from firing on the * removed channel. */ if (dataPtr->timer != NULL) { Tcl_DeleteTimerHandler(dataPtr->timer); dataPtr->timer = NULL; } /* * Now flush data waiting in internal buffers to output and input. The * input must be done despite the fact that there is no real receiver for * it anymore. But the scripts might have sideeffects other parts of the * system rely on (f.e. signalling the close to interested parties). */ PreserveData(dataPtr); if (dataPtr->mode & TCL_WRITABLE) { ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN, P_PRESERVE); } if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) { dataPtr->readIsFlushed = 1; ExecuteCallback(dataPtr, interp, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF, P_PRESERVE); } if (dataPtr->mode & TCL_WRITABLE) { ExecuteCallback(dataPtr, interp, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT, P_PRESERVE); } if (dataPtr->mode & TCL_READABLE) { ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0, TRANSMIT_DONT, P_PRESERVE); } ReleaseData(dataPtr); /* * General cleanup. */ Tcl_Release(dataPtr->self); dataPtr->self = NULL; ReleaseData(dataPtr); return TCL_OK; } static int TransformClose2Proc( ClientData instanceData, Tcl_Interp *interp, int flags) { if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return TransformCloseProc(instanceData, interp); } return EINVAL; } /* *---------------------------------------------------------------------- * * TransformInputProc -- * * Called by the generic IO system to convert read data. * * Side effects: * As defined by the conversion. * * Result: * A transformed buffer. * *---------------------------------------------------------------------- */ static int TransformInputProc( ClientData instanceData, char *buf, int toRead, int *errorCodePtr) { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; int gotBytes, read, copied; Tcl_Channel downChan; /* * Should assert(dataPtr->mode & TCL_READABLE); */ if (toRead == 0 || dataPtr->self == NULL) { /* * Catch a no-op. TODO: Is this a panic()? */ return 0; } gotBytes = 0; downChan = Tcl_GetStackedChannel(dataPtr->self); PreserveData(dataPtr); while (toRead > 0) { /* * Loop until the request is satisfied (or no data is available from * below, possibly EOF). */ copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead); toRead -= copied; buf += copied; gotBytes += copied; if (toRead == 0) { /* * The request was completely satisfied from our buffers. We can * break out of the loop and return to the caller. */ break; } /* * Length (dataPtr->result) == 0, toRead > 0 here. Use the incoming * 'buf'! as target to store the intermediary information read from * the underlying channel. * * Ask the tcl level how much data it allows us to read from the * underlying channel. This feature allows the transform to signal EOF * upstream although there is none downstream. Useful to control an * unbounded 'fcopy', either through counting bytes, or by pattern * matching. */ ExecuteCallback(dataPtr, NULL, A_QUERY_MAXREAD, NULL, 0, TRANSMIT_NUM /* -> maxRead */, P_PRESERVE); if (dataPtr->maxRead >= 0) { if (dataPtr->maxRead < toRead) { toRead = dataPtr->maxRead; } } /* else: 'maxRead < 0' == Accept the current value of toRead. */ if (toRead <= 0) { break; } if (dataPtr->eofPending) { /* * Already saw EOF from downChan; don't ask again. * NOTE: Could move this up to avoid the last maxRead * execution. Believe this would still be correct behavior, * but the test suite tests the whole command callback * sequence, so leave it unchanged for now. */ break; } /* * Get bytes from the underlying channel. */ read = Tcl_ReadRaw(downChan, buf, toRead); if (read < 0) { if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) { /* * Zero bytes available from downChan because blocked. * But nonzero bytes already copied, so total is a * valid blocked short read. Return to caller. */ break; } /* * Either downChan is not blocked (there's a real error). * or it is and there are no bytes copied yet. In either * case we want to pass the "error" along to the caller, * either to report an error, or to signal to the caller * that zero bytes are available because blocked. */ *errorCodePtr = Tcl_GetErrno(); gotBytes = -1; break; } else if (read == 0) { /* * Zero returned from Tcl_ReadRaw() always indicates EOF * on the down channel. */ dataPtr->eofPending = 1; dataPtr->readIsFlushed = 1; ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF, P_PRESERVE); if (ResultEmpty(&dataPtr->result)) { /* * We had nothing to flush. */ break; } continue; /* at: while (toRead > 0) */ } /* read == 0 */ /* * Transform the read chunk and add the result to our read buffer * (dataPtr->result). */ if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read, TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) { *errorCodePtr = EINVAL; gotBytes = -1; break; } } /* while toRead > 0 */ if (gotBytes == 0) { dataPtr->eofPending = 0; } ReleaseData(dataPtr); return gotBytes; } /* *---------------------------------------------------------------------- * * TransformOutputProc -- * * Called by the generic IO system to convert data waiting to be written. * * Side effects: * As defined by the transformation. * * Result: * A transformed buffer. * *---------------------------------------------------------------------- */ static int TransformOutputProc( ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; /* * Should assert(dataPtr->mode & TCL_WRITABLE); */ if (toWrite == 0) { /* * Catch a no-op. */ return 0; } PreserveData(dataPtr); if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite, TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) { *errorCodePtr = EINVAL; toWrite = -1; } ReleaseData(dataPtr); return toWrite; } /* *---------------------------------------------------------------------- * * TransformSeekProc -- * * This procedure is called by the generic IO level to move the access * point in a channel. * * Side effects: * Moves the location at which the channel will be accessed in future * operations. Flushes all transformation buffers, then forwards it to * the underlying channel. * * Result: * -1 if failed, the new position if successful. An output argument * contains the POSIX error code if an error occurred, or zero. * *---------------------------------------------------------------------- */ static int TransformSeekProc( ClientData instanceData, /* The channel to manipulate. */ long offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent); Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType); if ((offset == 0) && (mode == SEEK_CUR)) { /* * This is no seek but a request to tell the caller the current * location. Simply pass the request down. */ return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode, errorCodePtr); } /* * It is a real request to change the position. Flush all data waiting for * output and discard everything in the input buffers. Then pass the * request down, unchanged. */ PreserveData(dataPtr); if (dataPtr->mode & TCL_WRITABLE) { ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE); } if (dataPtr->mode & TCL_READABLE) { ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE); ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; dataPtr->eofPending = 0; } ReleaseData(dataPtr); return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode, errorCodePtr); } /* *---------------------------------------------------------------------- * * TransformWideSeekProc -- * * This procedure is called by the generic IO level to move the access * point in a channel, with a (potentially) 64-bit offset. * * Side effects: * Moves the location at which the channel will be accessed in future * operations. Flushes all transformation buffers, then forwards it to * the underlying channel. * * Result: * -1 if failed, the new position if successful. An output argument * contains the POSIX error code if an error occurred, or zero. * *---------------------------------------------------------------------- */ static Tcl_WideInt TransformWideSeekProc( ClientData instanceData, /* The channel to manipulate. */ Tcl_WideInt offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent); Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType); Tcl_DriverWideSeekProc *parentWideSeekProc = Tcl_ChannelWideSeekProc(parentType); ClientData parentData = Tcl_GetChannelInstanceData(parent); if ((offset == 0) && (mode == SEEK_CUR)) { /* * This is no seek but a request to tell the caller the current * location. Simply pass the request down. */ if (parentWideSeekProc != NULL) { return parentWideSeekProc(parentData, offset, mode, errorCodePtr); } return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode, errorCodePtr)); } /* * It is a real request to change the position. Flush all data waiting for * output and discard everything in the input buffers. Then pass the * request down, unchanged. */ PreserveData(dataPtr); if (dataPtr->mode & TCL_WRITABLE) { ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE); } if (dataPtr->mode & TCL_READABLE) { ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE); ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; dataPtr->eofPending = 0; } ReleaseData(dataPtr); /* * If we have a wide seek capability, we should stick with that. */ if (parentWideSeekProc != NULL) { return parentWideSeekProc(parentData, offset, mode, errorCodePtr); } /* * We're transferring to narrow seeks at this point; this is a bit complex * because we have to check whether the seek is possible first (i.e. * whether we are losing information in truncating the bits of the * offset). Luckily, there's a defined error for what happens when trying * to go out of the representable range. */ if (offsetTcl_LongAsWide(LONG_MAX)) { *errorCodePtr = EOVERFLOW; return Tcl_LongAsWide(-1); } return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset), mode, errorCodePtr)); } /* *---------------------------------------------------------------------- * * TransformSetOptionProc -- * * Called by generic layer to handle the reconfiguration of channel * specific options. As this channel type does not have such, it simply * passes all requests downstream. * * Side effects: * As defined by the channel downstream. * * Result: * A standard TCL error code. * *---------------------------------------------------------------------- */ static int TransformSetOptionProc( ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value) { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self); Tcl_DriverSetOptionProc *setOptionProc; setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan)); if (setOptionProc == NULL) { return TCL_ERROR; } return setOptionProc(Tcl_GetChannelInstanceData(downChan), interp, optionName, value); } /* *---------------------------------------------------------------------- * * TransformGetOptionProc -- * * Called by generic layer to handle requests for the values of channel * specific options. As this channel type does not have such, it simply * passes all requests downstream. * * Side effects: * As defined by the channel downstream. * * Result: * A standard TCL error code. * *---------------------------------------------------------------------- */ static int TransformGetOptionProc( ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr) { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self); Tcl_DriverGetOptionProc *getOptionProc; getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan)); if (getOptionProc != NULL) { return getOptionProc(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr); } else if (optionName == NULL) { /* * Request is query for all options, this is ok. */ return TCL_OK; } /* * Request for a specific option has to fail, since we don't have any. */ return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TransformWatchProc -- * * Initialize the notifier to watch for events from this channel. * * Side effects: * Sets up the notifier so that a future event on the channel will be * seen by Tcl. * * Result: * None. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void TransformWatchProc( ClientData instanceData, /* Channel to watch. */ int mask) /* Events of interest. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel downChan; /* * The caller expressed interest in events occurring for this channel. We * are forwarding the call to the underlying channel now. */ dataPtr->watchMask = mask; /* * No channel handlers any more. We will be notified automatically about * events on the channel below via a call to our 'TransformNotifyProc'. * But we have to pass the interest down now. We are allowed to add * additional 'interest' to the mask if we want to. But this * transformation has no such interest. It just passes the request down, * unchanged. */ if (dataPtr->self == NULL) { return; } downChan = Tcl_GetStackedChannel(dataPtr->self); Tcl_GetChannelType(downChan)->watchProc( Tcl_GetChannelInstanceData(downChan), mask); /* * Management of the internal timer. */ if ((dataPtr->timer != NULL) && (!(mask & TCL_READABLE) || ResultEmpty(&dataPtr->result))) { /* * A pending timer exists, but either is there no (more) interest in * the events it generates or nothing is available for reading, so * remove it. */ Tcl_DeleteTimerHandler(dataPtr->timer); dataPtr->timer = NULL; } if ((dataPtr->timer == NULL) && (mask & TCL_READABLE) && !ResultEmpty(&dataPtr->result)) { /* * There is no pending timer, but there is interest in readable events * and we actually have data waiting, so generate a timer to flush * that. */ dataPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY, TransformChannelHandlerTimer, dataPtr); } } /* *---------------------------------------------------------------------- * * TransformGetFileHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS specific file handle * from inside this channel. * * Side effects: * None. * * Result: * The appropriate Tcl_File or NULL if not present. * *---------------------------------------------------------------------- */ static int TransformGetFileHandleProc( ClientData instanceData, /* Channel to query. */ int direction, /* Direction of interest. */ ClientData *handlePtr) /* Place to store the handle into. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; /* * Return the handle belonging to parent channel. IOW, pass the request * down and the result up. */ return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self), direction, handlePtr); } /* *---------------------------------------------------------------------- * * TransformNotifyProc -- * * Handler called by Tcl to inform us of activity on the underlying * channel. * * Side effects: * May process the incoming event by itself. * * Result: * None. * *---------------------------------------------------------------------- */ static int TransformNotifyProc( ClientData clientData, /* The state of the notified * transformation. */ int mask) /* The mask of occurring events. */ { TransformChannelData *dataPtr = (TransformChannelData *)clientData; /* * An event occurred in the underlying channel. This transformation doesn't * process such events thus returns the incoming mask unchanged. */ if (dataPtr->timer != NULL) { /* * Delete an existing timer. It was not fired, yet we are here, so the * channel below generated such an event and we don't have to. The * renewal of the interest after the execution of channel handlers * will eventually cause us to recreate the timer (in * TransformWatchProc). */ Tcl_DeleteTimerHandler(dataPtr->timer); dataPtr->timer = NULL; } return mask; } /* *---------------------------------------------------------------------- * * TransformChannelHandlerTimer -- * * Called by the notifier (-> timer) to flush out information waiting in * the input buffer. * * Side effects: * As of 'Tcl_NotifyChannel'. * * Result: * None. * *---------------------------------------------------------------------- */ static void TransformChannelHandlerTimer( ClientData clientData) /* Transformation to query. */ { TransformChannelData *dataPtr = (TransformChannelData *)clientData; dataPtr->timer = NULL; if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) { /* * The timer fired, but either is there no (more) interest in the * events it generates or nothing is available for reading, so ignore * it and don't recreate it. */ return; } Tcl_NotifyChannel(dataPtr->self, TCL_READABLE); } /* *---------------------------------------------------------------------- * * ResultClear -- * * Deallocates any memory allocated by 'ResultAdd'. * * Side effects: * See above. * * Result: * None. * *---------------------------------------------------------------------- */ static inline void ResultClear( ResultBuffer *r) /* Reference to the buffer to clear out. */ { r->used = 0; if (r->allocated) { ckfree(r->buf); r->buf = NULL; r->allocated = 0; } } /* *---------------------------------------------------------------------- * * ResultInit -- * * Initializes the specified buffer structure. The structure will contain * valid information for an empty buffer. * * Side effects: * See above. * * Result: * None. * *---------------------------------------------------------------------- */ static inline void ResultInit( ResultBuffer *r) /* Reference to the structure to * initialize. */ { r->used = 0; r->allocated = 0; r->buf = NULL; } /* *---------------------------------------------------------------------- * * ResultEmpty -- * * Returns whether the number of bytes stored in the buffer is zero. * * Side effects: * None. * * Result: * A boolean. * *---------------------------------------------------------------------- */ static inline int ResultEmpty( ResultBuffer *r) /* The structure to query. */ { return r->used == 0; } /* *---------------------------------------------------------------------- * * ResultCopy -- * * Copies the requested number of bytes from the buffer into the * specified array and removes them from the buffer afterward. Copies * less if there is not enough data in the buffer. * * Side effects: * See above. * * Result: * The number of actually copied bytes, possibly less than 'toRead'. * *---------------------------------------------------------------------- */ static inline size_t ResultCopy( ResultBuffer *r, /* The buffer to read from. */ unsigned char *buf, /* The buffer to copy into. */ size_t toRead) /* Number of requested bytes. */ { if (ResultEmpty(r)) { /* * Nothing to copy in the case of an empty buffer. */ return 0; } else if (r->used == toRead) { /* * We have just enough. Copy everything to the caller. */ memcpy(buf, r->buf, toRead); r->used = 0; } else if (r->used > toRead) { /* * The internal buffer contains more than requested. Copy the * requested subset to the caller, and shift the remaining bytes down. */ memcpy(buf, r->buf, toRead); memmove(r->buf, r->buf + toRead, r->used - toRead); r->used -= toRead; } else { /* * There is not enough in the buffer to satisfy the caller, so take * everything. */ memcpy(buf, r->buf, r->used); toRead = r->used; r->used = 0; } return toRead; } /* *---------------------------------------------------------------------- * * ResultAdd -- * * Adds the bytes in the specified array to the buffer, by appending it. * * Side effects: * See above. * * Result: * None. * *---------------------------------------------------------------------- */ static inline void ResultAdd( ResultBuffer *r, /* The buffer to extend. */ unsigned char *buf, /* The buffer to read from. */ size_t toWrite) /* The number of bytes in 'buf'. */ { if ((r->used + toWrite + 1) > r->allocated) { /* * Extension of the internal buffer is required. */ if (r->allocated == 0) { r->allocated = toWrite + INCREMENT; r->buf = (unsigned char *)ckalloc(r->allocated); } else { r->allocated += toWrite + INCREMENT; r->buf = (unsigned char *)ckrealloc(r->buf, r->allocated); } } /* * Now we may copy the data. */ memcpy(r->buf + r->used, buf, toWrite); r->used += toWrite; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclIO.h0000644000175000017500000002712014554262142014443 0ustar sergeisergei/* * tclIO.h -- * * This file provides the generic portions (those that are the same on * all platforms and for all channel types) of Tcl's IO facilities. * * Copyright (c) 1998-2000 Ajuba Solutions * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not * compile on systems where neither is defined. We want both defined so that * we can test safely for both. In the code we still have to test for both * because there may be systems on which both are defined and have different * values. */ #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN))) # define EWOULDBLOCK EAGAIN #endif #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK))) # define EAGAIN EWOULDBLOCK #endif #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK))) #error one of EWOULDBLOCK or EAGAIN must be defined #endif /* * struct ChannelBuffer: * * Buffers data being sent to or from a channel. */ typedef struct ChannelBuffer { int refCount; /* Current uses count */ int nextAdded; /* The next position into which a character * will be put in the buffer. */ int nextRemoved; /* Position of next byte to be removed from * the buffer. */ int bufLength; /* How big is the buffer? */ struct ChannelBuffer *nextPtr; /* Next buffer in chain. */ char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real * buffer occupies this space + bufSize-1 * bytes. This must be the last field in the * structure. */ } ChannelBuffer; #define CHANNELBUFFER_HEADER_SIZE TclOffset(ChannelBuffer, buf) /* * How much extra space to allocate in buffer to hold bytes from previous * buffer (when converting to UTF-8) or to hold bytes that will go to next * buffer (when converting from UTF-8). */ #define BUFFER_PADDING 16 /* * The following defines the *default* buffer size for channels. */ #define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4) /* * The following structure describes the information saved from a call to * "fileevent". This is used later when the event being waited for to invoke * the saved script in the interpreter designed in this record. */ typedef struct EventScriptRecord { struct Channel *chanPtr; /* The channel for which this script is * registered. This is used only when an error * occurs during evaluation of the script, to * delete the handler. */ Tcl_Obj *scriptPtr; /* Script to invoke. */ Tcl_Interp *interp; /* In what interpreter to invoke script? */ int mask; /* Events must overlap current mask for the * stored script to be invoked. */ struct EventScriptRecord *nextPtr; /* Next in chain of records. */ } EventScriptRecord; /* * struct Channel: * * One of these structures is allocated for each open channel. It contains * data specific to the channel but which belongs to the generic part of the * Tcl channel mechanism, and it points at an instance specific (and type * specific) instance data, and at a channel type structure. */ typedef struct Channel { struct ChannelState *state; /* Split out state information */ ClientData instanceData; /* Instance-specific data provided by creator * of channel. */ const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */ struct Channel *downChanPtr;/* Refers to channel this one was stacked * upon. This reference is NULL for normal * channels. See Tcl_StackChannel. */ struct Channel *upChanPtr; /* Refers to the channel above stacked this * one. NULL for the top most channel. */ /* * Intermediate buffers to hold pre-read data for consumption by a newly * stacked transformation. See 'Tcl_StackChannel'. */ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */ int refCount; } Channel; /* * struct ChannelState: * * One of these structures is allocated for each open channel. It contains * data specific to the channel but which belongs to the generic part of the * Tcl channel mechanism, and it points at an instance specific (and type * specific) instance data, and at a channel type structure. */ typedef struct ChannelState { char *channelName; /* The name of the channel instance in Tcl * commands. Storage is owned by the generic * IO code, is dynamically allocated. */ int flags; /* OR'ed combination of the flags defined * below. */ Tcl_Encoding encoding; /* Encoding to apply when reading or writing * data on this channel. NULL means no * encoding is applied to data. */ Tcl_EncodingState inputEncodingState; /* Current encoding state, used when * converting input data bytes to UTF-8. */ int inputEncodingFlags; /* Encoding flags to pass to conversion * routine when converting input data bytes to * UTF-8. May be TCL_ENCODING_START before * converting first byte and TCL_ENCODING_END * when EOF is seen. */ Tcl_EncodingState outputEncodingState; /* Current encoding state, used when * converting UTF-8 to output data bytes. */ int outputEncodingFlags; /* Encoding flags to pass to conversion * routine when converting UTF-8 to output * data bytes. May be TCL_ENCODING_START * before converting first byte and * TCL_ENCODING_END when EOF is seen. */ TclEolTranslation inputTranslation; /* What translation to apply for end of line * sequences on input? */ TclEolTranslation outputTranslation; /* What translation to use for generating end * of line sequences in output? */ int inEofChar; /* If nonzero, use this as a signal of EOF on * input. */ int outEofChar; /* If nonzero, append this to the channel when * it is closed if it is open for writing. */ int unreportedError; /* Non-zero if an error report was deferred * because it happened in the background. The * value is the POSIX error code. */ int refCount; /* How many interpreters hold references to * this IO channel? */ struct CloseCallback *closeCbPtr; /* Callbacks registered to be called when the * channel is closed. */ char *outputStage; /* Temporary staging buffer used when * translating EOL before converting from * UTF-8 to external form. */ ChannelBuffer *curOutPtr; /* Current output buffer being filled. */ ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */ ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */ ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates * need to allocate a new buffer for "gets" * that crosses buffer boundaries. */ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */ struct ChannelHandler *chPtr;/* List of channel handlers registered for * this channel. */ int interestMask; /* Mask of all events this channel has * handlers for. */ EventScriptRecord *scriptRecordPtr; /* Chain of all scripts registered for event * handlers ("fileevent") on this channel. */ int bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ Channel *timerChanPtr; /* Needed in order to decrement the refCount of the right channel when the timer is deleted. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ struct CopyState *csPtrW; /* State of background copy for which channel * is output, or NULL. */ Channel *topChanPtr; /* Refers to topmost channel in a stack. Never * NULL. */ Channel *bottomChanPtr; /* Refers to bottommost channel in a stack. * This channel can be relied on to live as * long as the channel state. Never NULL. */ struct ChannelState *nextCSPtr; /* Next in list of channels currently open. */ Tcl_ThreadId managingThread;/* TIP #10: Id of the thread managing this * stack of channels. */ /* * TIP #219 ... Info for the I/O system ... * Error message set by channel drivers, for the propagation of arbitrary * Tcl errors. This information, if present (chanMsg not NULL), takes * precedence over a Posix error code returned by a channel operation. */ Tcl_Obj* chanMsg; Tcl_Obj* unreportedMsg; /* Non-NULL if an error report was deferred * because it happened in the background. The * value is the chanMg, if any. #219's * companion to 'unreportedError'. */ int epoch; /* Used to test validity of stored channelname * lookup results. */ } ChannelState; /* * Values for the flags field in Channel. Any OR'ed combination of the * following flags can be stored in the field. These flags record various * options and state bits about the channel. In addition to the flags below, * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set. */ #define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in nonblocking * mode. */ #define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be * flushed after every newline. */ #define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always * be flushed immediately. */ #define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued * output buffers has been * scheduled. */ #define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No further * Tcl-level IO on the channel is * allowed. */ #define CHANNEL_EOF (1<<9) /* EOF occurred on this channel. This * bit is cleared before every input * operation. */ #define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel * because we saw the input * eofChar. This bit prevents clearing * of the EOF bit before every input * operation. */ #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred on * this channel. This bit is cleared * before every input or output * operation. */ #define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input * translation mode and the last byte * seen was a "\r". */ #define CHANNEL_DEAD (1<<13) /* The channel has been closed by the * exit handler (on exit) but not * deallocated. When any IO operation * sees this flag on a channel, it * does not call driver level * functions to avoid referring to * deallocated data. */ #define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed * because there was not enough data * to complete the operation. This * flag is set when gets fails to get * a complete line or when read fails * to get a complete character. When * set, file events will not be * delivered for buffered data until * the state of the channel * changes. */ #define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is * being used. */ #define CHANNEL_INCLOSE (1<<19) /* Channel is currently being closed. * Its structures are still live and * usable, but it may not be closed * again from within the close * handler. */ #define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed. * No further Tcl-level write IO on * the channel is allowed. */ /* * The length of time to wait between synthetic timer events. Must be zero or * bad things tend to happen. */ #define SYNTHETIC_EVENT_TIME 0 /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclIORChan.c0000644000175000017500000025760614554262142015370 0ustar sergeisergei/* * tclIORChan.c -- * * This file contains the implementation of Tcl's generic channel * reflection code, which allows the implementation of Tcl channels in * Tcl code. * * Parts of this file are based on code contributed by Jean-Claude * Wippler. * * See TIP #219 for the specification of this functionality. * * Copyright (c) 2004-2005 ActiveState, a division of Sophos * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" #include #ifndef EINVAL #define EINVAL 9 #endif #ifndef EOK #define EOK 0 #endif /* * Signatures of all functions used in the C layer of the reflection. */ static int ReflectClose(ClientData clientData, Tcl_Interp *interp); static int ReflectClose2(ClientData clientData, Tcl_Interp *interp, int flags); static int ReflectInput(ClientData clientData, char *buf, int toRead, int *errorCodePtr); static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); #ifdef TCL_THREADS static void ReflectThread(ClientData clientData, int action); static int ReflectEventRun(Tcl_Event *ev, int flags); static int ReflectEventDelete(Tcl_Event *ev, ClientData cd); #endif static Tcl_WideInt ReflectSeekWide(ClientData clientData, Tcl_WideInt offset, int mode, int *errorCodePtr); static int ReflectSeek(ClientData clientData, long offset, int mode, int *errorCodePtr); static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int ReflectSetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, const char *newValue); /* * The C layer channel type/driver definition used by the reflection. */ static const Tcl_ChannelType tclRChannelType = { "tclrchannel", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ ReflectClose, /* Close channel, clean instance data */ ReflectInput, /* Handle read request */ ReflectOutput, /* Handle write request */ ReflectSeek, /* Move location of access point. NULL'able */ ReflectSetOption, /* Set options. NULL'able */ ReflectGetOption, /* Get options. NULL'able */ ReflectWatch, /* Initialize notifier */ NULL, /* Get OS handle from the channel. NULL'able */ ReflectClose2, /* No close2 support. NULL'able */ ReflectBlock, /* Set blocking/nonblocking. NULL'able */ NULL, /* Flush channel. Not used by core. NULL'able */ NULL, /* Handle events. NULL'able */ ReflectSeekWide, /* Move access point (64 bit). NULL'able */ #ifdef TCL_THREADS ReflectThread, /* thread action, tracking owner */ #else NULL, /* thread action */ #endif NULL /* truncate */ }; /* * Instance data for a reflected channel. =========================== */ typedef struct { Tcl_Channel chan; /* Back reference to generic channel * structure. */ Tcl_Interp *interp; /* Reference to the interpreter containing the * Tcl level part of the channel. NULL here * signals the channel is dead because the * interpreter/thread containing its Tcl * command is gone. */ #ifdef TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ Tcl_Obj *name; /* Name of the channel as created */ int mode; /* Mask of R/W mode */ int interest; /* Mask of events the channel is interested * in. */ int dead; /* Boolean signal that some operations * should no longer be attempted. */ /* * Note regarding the usage of timers. * * Most channel implementations need a timer in the C level to ensure that * data in buffers is flushed out through the generation of fake file * events. * * See 'refchan', 'memchan', etc. * * Here this is _not_ required. Interest in events is posted to the Tcl * level via 'watch'. And posting of events is possible from the Tcl level * as well, via 'chan postevent'. This means that the generation of all * events, fake or not, timer based or not, is completely in the hands of * the Tcl level. Therefore no timer here. */ } ReflectedChannel; /* * Structure of the table mapping from channel handles to reflected * channels. Each interpreter which has the handler command for one or more * reflected channels records them in such a table, so that 'chan postevent' * is able to find them even if the actual channel was moved to a different * interpreter and/or thread. * * The table is reachable via the standard interpreter AssocData, the key is * defined below. */ typedef struct { Tcl_HashTable map; } ReflectedChannelMap; #define RCMKEY "ReflectedChannelMap" /* * Event literals. ================================================== */ static const char *const eventOptions[] = { "read", "write", NULL }; typedef enum { EVENT_READ, EVENT_WRITE } EventOption; /* * Method literals. ================================================== */ static const char *const methodNames[] = { "blocking", /* OPT */ "cget", /* OPT \/ Together or none */ "cgetall", /* OPT /\ of these two */ "configure", /* OPT */ "finalize", /* */ "initialize", /* */ "read", /* OPT */ "seek", /* OPT */ "watch", /* */ "write", /* OPT */ NULL }; typedef enum { METH_BLOCKING, METH_CGET, METH_CGETALL, METH_CONFIGURE, METH_FINAL, METH_INIT, METH_READ, METH_SEEK, METH_WATCH, METH_WRITE } MethodName; #define FLAG(m) (1 << (m)) #define REQUIRED_METHODS \ (FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH)) #define NULLABLE_METHODS \ (FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \ FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL)) #define RANDW \ (TCL_READABLE | TCL_WRITABLE) #define IMPLIES(a,b) ((!(a)) || (b)) #define NEGIMPL(a,b) #define HAS(x,f) ((x) & FLAG(f)) #ifdef TCL_THREADS /* * Thread specific types and structures. * * We are here essentially creating a very specific implementation of 'thread * send'. */ /* * Enumeration of all operations which can be forwarded. */ typedef enum { ForwardedClose, ForwardedInput, ForwardedOutput, ForwardedSeek, ForwardedWatch, ForwardedBlock, ForwardedSetOpt, ForwardedGetOpt, ForwardedGetOptAll } ForwardedOperation; /* * Event used to forward driver invocations to the thread actually managing * the channel. We cannot construct the command to execute and forward that. * Because then it will contain a mixture of Tcl_Obj's belonging to both the * command handler thread (CT), and the thread managing the channel (MT), * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we * forward an operation code, the argument details, and reference to results. * The command is assembled in the CT and belongs fully to that thread. No * sharing problems. */ typedef struct ForwardParamBase { int code; /* O: Ok/Fail of the cmd handler */ char *msgStr; /* O: Error message for handler failure */ int mustFree; /* O: True if msgStr is allocated, false if * otherwise (static). */ } ForwardParamBase; /* * Operation specific parameter/result structures. (These are "subtypes" of * ForwardParamBase. Where an operation does not need any special types, it * has no "subtype" and just uses ForwardParamBase, as listed above.) */ struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ int toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ const char *buf; /* I: Where the bytes to write come from */ int toWrite; /* I: #bytes to write, * O: #bytes actually written */ }; struct ForwardParamSeek { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ int seekMode; /* I: How to seek */ Tcl_WideInt offset; /* I: Where to seek, * O: New location */ }; struct ForwardParamWatch { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ int mask; /* I: What events to watch for */ }; struct ForwardParamBlock { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ int nonblocking; /* I: What mode to activate */ }; struct ForwardParamSetOpt { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ const char *name; /* Name of option to set */ const char *value; /* Value to set */ }; struct ForwardParamGetOpt { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ const char *name; /* Name of option to get, maybe NULL */ Tcl_DString *value; /* Result */ }; /* * Now join all these together in a single union for convenience. */ typedef union ForwardParam { ForwardParamBase base; struct ForwardParamInput input; struct ForwardParamOutput output; struct ForwardParamSeek seek; struct ForwardParamWatch watch; struct ForwardParamBlock block; struct ForwardParamSetOpt setOpt; struct ForwardParamGetOpt getOpt; } ForwardParam; /* * Forward declaration. */ typedef struct ForwardingResult ForwardingResult; /* * General event structure, with reference to operation specific data. */ typedef struct ForwardingEvent { Tcl_Event event; /* Basic event data, has to be first item */ ForwardingResult *resultPtr; ForwardedOperation op; /* Forwarded driver operation */ ReflectedChannel *rcPtr; /* Channel instance */ ForwardParam *param; /* Packaged arguments and return values, a * ForwardParam pointer. */ } ForwardingEvent; /* * Structure to manage the result of the forwarding. This is not the result of * the operation itself, but about the success of the forward event itself. * The event can be successful, even if the operation which was forwarded * failed. It is also there to manage the synchronization between the involved * threads. */ struct ForwardingResult { Tcl_ThreadId src; /* Originating thread. */ Tcl_ThreadId dst; /* Thread the op was forwarded to. */ Tcl_Interp *dsti; /* Interpreter in the thread the op was * forwarded to. */ /* * Note regarding 'dsti' above: Its information is also available via the * chain evPtr->rcPtr->interp, however, as can be seen, two more * indirections are needed to retrieve it. And the evPtr may be gone, * breaking the chain. */ Tcl_Condition done; /* Condition variable the forwarder blocks * on. */ int result; /* TCL_OK or TCL_ERROR */ ForwardingEvent *evPtr; /* Event the result belongs to. */ ForwardingResult *prevPtr, *nextPtr; /* Links into the list of pending forwarded * results. */ }; typedef struct ThreadSpecificData { /* * Table of all reflected channels owned by this thread. This is the * per-thread version of the per-interpreter map. */ ReflectedChannelMap *rcmPtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * List of forwarded operations which have not completed yet, plus the mutex * to protect the access to this process global list. */ static ForwardingResult *forwardList = NULL; TCL_DECLARE_MUTEX(rcForwardMutex) /* * Function containing the generic code executing a forward, and wrapper * macros for the actual operations we wish to forward. Uses ForwardProc as * the event function executed by the thread receiving a forwarding event * (which executes the appropriate function and collects the result, if any). * * The ExitProc ensures that things do not deadlock when the sending thread * involved in the forwarding exits. It also clean things up so that we don't * leak resources when threads go away. */ static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr, ForwardedOperation op, const void *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); #define FreeReceivedError(p) \ if ((p)->base.mustFree) { \ ckfree((p)->base.msgStr); \ } #define PassReceivedErrorInterp(i,p) \ if ((i) != NULL) { \ Tcl_SetChannelErrorInterp((i), \ Tcl_NewStringObj((p)->base.msgStr, -1)); \ } \ FreeReceivedError(p) #define PassReceivedError(c,p) \ Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \ FreeReceivedError(p) #define ForwardSetStaticError(p,emsg) \ (p)->base.code = TCL_ERROR; \ (p)->base.mustFree = 0; \ (p)->base.msgStr = (char *) (emsg) #define ForwardSetDynamicError(p,emsg) \ (p)->base.code = TCL_ERROR; \ (p)->base.mustFree = 1; \ (p)->base.msgStr = (char *) (emsg) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); static ReflectedChannelMap * GetThreadReflectedChannelMap(void); static void DeleteThreadReflectedChannelMap(ClientData clientData); #endif /* TCL_THREADS */ #define SetChannelErrorStr(c,msgStr) \ Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1)) static Tcl_Obj * MarshallError(Tcl_Interp *interp); static void UnmarshallErrorResult(Tcl_Interp *interp, Tcl_Obj *msgObj); /* * Static functions for this file: */ static int EncodeEventMask(Tcl_Interp *interp, const char *objName, Tcl_Obj *obj, int *mask); static Tcl_Obj * DecodeEventMask(int mask); static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj); static Tcl_Obj * NextHandle(void); static Tcl_FreeProc FreeReflectedChannel; static int InvokeTclMethod(ReflectedChannel *rcPtr, MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); static void DeleteReflectedChannelMap(ClientData clientData, Tcl_Interp *interp); static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); static void MarkDead(ReflectedChannel *rcPtr); /* * Global constant strings (messages). ================== * These string are used directly as bypass errors, thus they have to be valid * Tcl lists where the last element is the message itself. Hence the * list-quoting to keep the words of the message together. See also [x]. */ static const char *msg_read_toomuch = "{read delivered more than requested}"; static const char *msg_write_toomuch = "{write wrote more than requested}"; static const char *msg_write_nothing = "{write wrote nothing}"; static const char *msg_seek_beforestart = "{Tried to seek before origin}"; #ifdef TCL_THREADS static const char *msg_send_originlost = "{Channel thread lost}"; #endif /* TCL_THREADS */ static const char *msg_send_dstlost = "{Owner lost}"; static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}"; /* * Main methods to plug into the 'chan' ensemble'. ================== */ /* *---------------------------------------------------------------------- * * TclChanCreateObjCmd -- * * This function is invoked to process the "chan create" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. The handle of the new channel is placed in the * interp result. * * Side effects: * Creates a new channel. * *---------------------------------------------------------------------- */ int TclChanCreateObjCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { ReflectedChannel *rcPtr; /* Instance data of the new channel */ Tcl_Obj *rcId; /* Handle of the new channel */ int mode; /* R/W mode of new channel. Has to match * abilities of handler commands */ Tcl_Obj *cmdObj; /* Command prefix, list of words */ Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Channel chan; /* Token for the new channel */ Tcl_Obj *modeObj; /* mode in obj form for method call */ int listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ Tcl_Obj *resObj; /* Result data for 'initialize' */ int methods; /* Bitmask for supported methods. */ Channel *chanPtr; /* 'chan' resolved to internal struct. */ Tcl_Obj *err; /* Error message */ ReflectedChannelMap *rcmPtr; /* Map of reflected channels with handlers in * this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ int isNew; /* Placeholder. */ (void)dummy; /* * Syntax: chan create MODE CMDPREFIX * [0] [1] [2] [3] * * Actually: rCreate MODE CMDPREFIX * [0] [1] [2] */ #define MODE (1) #define CMD (2) /* * Number of arguments... */ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix"); return TCL_ERROR; } /* * First argument is a list of modes. Allowed entries are "read", "write". * Empty list is uncommon, but allowed. Abbreviations are ok. */ modeObj = objv[MODE]; if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) { return TCL_ERROR; } /* * Second argument is command prefix, i.e. list of words, first word is * name of handler command, other words are fixed arguments. Run the * 'initialize' method to get the list of supported methods. Validate * this. */ cmdObj = objv[CMD]; /* * Basic check that the command prefix truly is a list. */ if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) { return TCL_ERROR; } /* * Now create the channel. */ rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); /* * Invoke 'initialize' and validate that the handler is present and ok. * Squash the channel if not. * * Note: The conversion of 'mode' back into a Tcl_Obj ensures that * 'initialize' is invoked with canonical mode names, and no * abbreviations. Using modeObj directly could feed abbreviations into the * handler, and the handler is not specified to handle such. */ modeObj = DecodeEventMask(mode); /* assert modeObj.refCount == 1 */ result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj); Tcl_DecrRefCount(modeObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ goto error; } /* * Verify the result. * - List, of method names. Convert to mask. * Check for non-optionals through the mask. * Compare open mode against optional r/w. */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned non-list: %s", Tcl_GetString(cmdObj), Tcl_GetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } methods = 0; while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, "method", TCL_EXACT, &methIndex) != TCL_OK) { TclNewLiteralStringObj(err, "chan handler \""); Tcl_AppendObjToObj(err, cmdObj); Tcl_AppendToObj(err, " initialize\" returned ", -1); Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp)); Tcl_SetObjResult(interp, err); Tcl_DecrRefCount(resObj); goto error; } methods |= FLAG(methIndex); listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" does not support all required methods", Tcl_GetString(cmdObj))); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" lacks a \"read\" method", Tcl_GetString(cmdObj))); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" lacks a \"write\" method", Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", Tcl_GetString(cmdObj))); goto error; } Tcl_ResetResult(interp); /* * Everything is fine now. */ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, mode); rcPtr->chan = chan; TclChannelPreserve(chan); chanPtr = (Channel *) chan; if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) { /* * Some of the nullable methods are not supported. We clone the * channel type, null the associated C functions, and use the result * as the actual channel type. */ Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)ckalloc(sizeof(Tcl_ChannelType)); memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType)); if (!(methods & FLAG(METH_CONFIGURE))) { clonePtr->setOptionProc = NULL; } if (!(methods & FLAG(METH_CGET)) && !(methods & FLAG(METH_CGETALL))) { clonePtr->getOptionProc = NULL; } if (!(methods & FLAG(METH_BLOCKING))) { clonePtr->blockModeProc = NULL; } if (!(methods & FLAG(METH_SEEK))) { clonePtr->seekProc = NULL; clonePtr->wideSeekProc = NULL; } chanPtr->typePtr = clonePtr; } /* * Register the channel in the I/O system, and in our our map for 'chan * postevent'. */ Tcl_RegisterChannel(interp, chan); rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName, &isNew); if (!isNew && chanPtr != Tcl_GetHashValue(hPtr)) { Tcl_Panic("TclChanCreateObjCmd: duplicate channel names"); } Tcl_SetHashValue(hPtr, chan); #ifdef TCL_THREADS rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName, &isNew); Tcl_SetHashValue(hPtr, chan); #endif /* * Return handle as result of command. */ Tcl_SetObjResult(interp, Tcl_NewStringObj(chanPtr->state->channelName, -1)); return TCL_OK; error: Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); ckfree((char*) rcPtr); return TCL_ERROR; #undef MODE #undef CMD } /* *---------------------------------------------------------------------- * * TclChanPostEventObjCmd -- * * This function is invoked to process the "chan postevent" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Posts events to a reflected channel, invokes event handlers. The * latter implies that arbitrary side effects are possible. * *---------------------------------------------------------------------- */ #ifdef TCL_THREADS typedef struct ReflectEvent { Tcl_Event header; ReflectedChannel *rcPtr; int events; } ReflectEvent; static int ReflectEventRun( Tcl_Event *ev, int flags) { /* OWNER thread * * Note: When the channel is closed any pending events of this type are * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls * accomplishing that. */ ReflectEvent *e = (ReflectEvent *) ev; (void)flags; Tcl_NotifyChannel(e->rcPtr->chan, e->events); return 1; } static int ReflectEventDelete( Tcl_Event *ev, ClientData cd) { /* OWNER thread * * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The * latter ensures that no pending events of this type are run on an * invalid channel. */ ReflectEvent *e = (ReflectEvent *) ev; if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) { return 0; } return 1; } #endif int TclChanPostEventObjCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { /* * Ensure -> HANDLER thread * * Syntax: chan postevent CHANNEL EVENTSPEC * [0] [1] [2] [3] * * Actually: rPostevent CHANNEL EVENTSPEC * [0] [1] [2] * * where EVENTSPEC = {read write ...} (Abbreviations allowed as well). */ #define CHAN (1) #define EVENT (2) const char *chanId; /* Tcl level channel handle */ Tcl_Channel chan; /* Channel associated to the handle */ const Tcl_ChannelType *chanTypePtr; /* Its associated driver structure */ ReflectedChannel *rcPtr; /* Associated instance data */ int events; /* Mask of events to post */ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in * this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ (void)dummy; /* * Number of arguments... */ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec"); return TCL_ERROR; } /* * First argument is a channel, a reflected channel, and the call of this * command is done from the interp defining the channel handler cmd. */ chanId = TclGetString(objv[CHAN]); rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can not find reflected channel named \"%s\"", chanId)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL); return TCL_ERROR; } /* * Note that the search above subsumes several of the older checks, * namely: * * (1) Does the channel handle refer to a reflected channel? * (2) Is the post event issued from the interpreter holding the handler * of the reflected channel? * * A successful search answers yes to both. Because the map holds only * handles of reflected channels, and only of such whose handler is * defined in this interpreter. * * We keep the old checks for both, for paranoia, but abort now instead of * throwing errors, as failure now means that our internal data structures * have gone seriously haywire. */ chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); chanTypePtr = Tcl_GetChannelType(chan); /* * We use a function referenced by the channel type as our cookie to * detect calls to non-reflecting channels. The channel type itself is not * suitable, as it might not be the static definition in this file, but a * clone thereof. And while we have reserved the name of the type nothing * in the core checks against violation, so someone else might have * created a channel type using our name, clashing with ourselves. */ if (chanTypePtr->watchProc != &ReflectWatch) { Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel"); } rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan); if (rcPtr->interp != interp) { Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter"); } /* * Second argument is a list of events. Allowed entries are "read", * "write". Expect at least one list element. Abbreviations are ok. */ if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) { return TCL_ERROR; } if (events == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("bad event list: is empty", -1)); return TCL_ERROR; } /* * Check that the channel is actually interested in the provided events. */ if (events & ~rcPtr->interest) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "tried to post events channel \"%s\" is not interested in", chanId)); return TCL_ERROR; } /* * We have the channel and the events to post. */ #ifdef TCL_THREADS if (rcPtr->owner == rcPtr->thread) { #endif Tcl_NotifyChannel(chan, events); #ifdef TCL_THREADS } else { ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent)); ev->header.proc = ReflectEventRun; ev->events = events; ev->rcPtr = rcPtr; /* * We are not preserving the structure here. When the channel is * closed any pending events are deleted, see ReflectClose(), and * ReflectEventDelete(). Trying to preserve and later release when the * event is run may generate a situation where the channel structure * is deleted but not our structure, crashing in * FreeReflectedChannel(). * * Force creation of the RCM, for proper cleanup on thread teardown. * The teardown of unprocessed events is currently coupled to the * thread reflected channel map */ (void) GetThreadReflectedChannelMap(); /* * XXX Race condition !! * XXX The destination thread may not exist anymore already. * XXX (Delayed postevent executed after channel got removed). * XXX Can we detect this ? (check the validity of the owner threadid ?) * XXX Actually, in that case the channel should be dead also ! */ Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL); Tcl_ThreadAlert(rcPtr->owner); } #endif /* * Squash interp results left by the event script. */ Tcl_ResetResult(interp); return TCL_OK; #undef CHAN #undef EVENT } /* * Channel error message marshalling utilities. */ static Tcl_Obj * MarshallError( Tcl_Interp *interp) { /* * Capture the result status of the interpreter into a string. => List of * options and values, followed by the error message. The result has * refCount 0. */ Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR); /* * => returnOpt.refCount == 0. We can append directly. */ Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp)); return returnOpt; } static void UnmarshallErrorResult( Tcl_Interp *interp, Tcl_Obj *msgObj) { int lc; Tcl_Obj **lv; int explicitResult; int numOptions; /* * Process the caught message. * * Syntax = (option value)... ?message? * * Bad syntax causes a panic. This is OK because the other side uses * Tcl_GetReturnOptions and list construction functions to marshal the * information; if we panic here, something has gone badly wrong already. */ if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) { Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result"); } if (interp == NULL) { return; } explicitResult = lc & 1; /* Odd number of values? */ numOptions = lc - explicitResult; if (explicitResult) { Tcl_SetObjResult(interp, lv[lc-1]); } (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv)); ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED; } int TclChanCaughtErrorBypass( Tcl_Interp *interp, Tcl_Channel chan) { Tcl_Obj *chanMsgObj = NULL; Tcl_Obj *interpMsgObj = NULL; Tcl_Obj *msgObj = NULL; /* * Get a bypassed error message from channel and/or interpreter, save the * reference, then kill the returned objects, if there were any. If there * are messages in both the channel has preference. */ if ((chan == NULL) && (interp == NULL)) { return 0; } if (chan != NULL) { Tcl_GetChannelError(chan, &chanMsgObj); } if (interp != NULL) { Tcl_GetChannelErrorInterp(interp, &interpMsgObj); } if (chanMsgObj != NULL) { msgObj = chanMsgObj; } else if (interpMsgObj != NULL) { msgObj = interpMsgObj; } if (msgObj != NULL) { Tcl_IncrRefCount(msgObj); } if (chanMsgObj != NULL) { Tcl_DecrRefCount(chanMsgObj); } if (interpMsgObj != NULL) { Tcl_DecrRefCount(interpMsgObj); } /* * No message returned, nothing caught. */ if (msgObj == NULL) { return 0; } UnmarshallErrorResult(interp, msgObj); Tcl_DecrRefCount(msgObj); return 1; } /* * Driver functions. ================================================ */ /* *---------------------------------------------------------------------- * * ReflectClose/ReflectClose2 -- * * This function is invoked when the channel is closed, to delete the * driver specific instance data. * * Results: * A Posix error. * * Side effects: * Releases memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectClose( ClientData clientData, Tcl_Interp *interp) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; int result; /* Result code for 'close' */ Tcl_Obj *resObj; /* Result data for 'close' */ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in * this interp */ Tcl_HashEntry *hPtr; /* Entry in the above map */ const Tcl_ChannelType *tctPtr; if (TclInThreadExit()) { /* * This call comes from TclFinalizeIOSystem. There are no * interpreters, and therefore we cannot call upon the handler command * anymore. Threading is irrelevant as well. Simply clean up all * the C level data structures and leave the Tcl level to the other * finalization functions. */ /* * THREADED => Forward this to the origin thread * * Note: DeleteThreadReflectedChannelMap() is the thread exit handler * for the origin thread. Use this to clean up the structure? Except * if lost? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; /* * Now squash the pending reflection events for this channel. */ Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { FreeReceivedError(&p); } } #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { ckfree((char *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } Tcl_EventuallyFree(rcPtr, FreeReflectedChannel); return EOK; } /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; /* * Now squash the pending reflection events for this channel. */ Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); } } else { #endif result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj); if ((result != TCL_OK) && (interp != NULL)) { Tcl_SetChannelErrorInterp(interp, resObj); } Tcl_DecrRefCount(resObj); /* Remove reference we held from the * invoke */ /* * Remove the channel from the map before releasing the memory, to * prevent future accesses (like by 'postevent') from finding and * dereferencing a dangling pointer. * * NOTE: The channel may not be in the map. This is ok, that happens * when the channel was created in a different interpreter and/or * thread and then was moved here. * * NOTE: The channel may have been removed from the map already via * the per-interp DeleteReflectedChannelMap exit-handler. */ if (!rcPtr->dead) { rcmPtr = GetReflectedChannelMap(rcPtr->interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } } #ifdef TCL_THREADS rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } } #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { ckfree((char *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } Tcl_EventuallyFree(rcPtr, FreeReflectedChannel); return (result == TCL_OK) ? EOK : EINVAL; } static int ReflectClose2( ClientData clientData, Tcl_Interp *interp, int flags) { if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return ReflectClose(clientData, interp); } return EINVAL; } /* *---------------------------------------------------------------------- * * ReflectInput -- * * This function is invoked when more data is requested from the channel. * * Results: * The number of bytes read. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectInput( ClientData clientData, char *buf, int toRead, int *errorCodePtr) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *toReadObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.input.buf = buf; p.input.toRead = toRead; ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { /* * No error message, this is an errno signal. */ *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; } p.input.toRead = -1; } else { *errorCodePtr = EOK; } return p.input.toRead; } #endif /* ASSERT: rcPtr->method & FLAG(METH_READ) */ /* ASSERT: rcPtr->mode & TCL_READABLE */ Tcl_Preserve(rcPtr); TclNewIntObj(toReadObj, toRead); Tcl_IncrRefCount(toReadObj); if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); if (toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); goto invalid; } *errorCodePtr = EOK; if (bytec > 0) { memcpy(buf, bytev, bytec); } stop: Tcl_DecrRefCount(toReadObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return bytec; invalid: *errorCodePtr = EINVAL; error: bytec = -1; goto stop; } /* *---------------------------------------------------------------------- * * ReflectOutput -- * * This function is invoked when data is writen to the channel. * * Results: * The number of bytes actually written. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectOutput( ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *bufObj; Tcl_Obj *resObj; /* Result data for 'write' */ int written; /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.output.buf = buf; p.output.toWrite = toWrite; ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { /* * No error message, this is an errno signal. */ *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; } p.output.toWrite = -1; } else { *errorCodePtr = EOK; } return p.output.toWrite; } #endif /* ASSERT: rcPtr->method & FLAG(METH_WRITE) */ /* ASSERT: rcPtr->mode & TCL_WRITABLE */ Tcl_Preserve(rcPtr); Tcl_Preserve(rcPtr->interp); bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } if (Tcl_InterpDeleted(rcPtr->interp)) { /* * The interp was destroyed during InvokeTclMethod(). */ SetChannelErrorStr(rcPtr->chan, msg_send_dstlost); goto invalid; } if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); goto invalid; } if ((written == 0) && (toWrite > 0)) { /* * The handler claims to have written nothing of what it was given. * That is bad. */ SetChannelErrorStr(rcPtr->chan, msg_write_nothing); goto invalid; } if (toWrite < written) { /* * The handler claims to have written more than it was given. That is * bad. Note that the I/O core would crash if we were to return this * information, trying to write -nnn bytes in the next iteration. */ SetChannelErrorStr(rcPtr->chan, msg_write_toomuch); goto invalid; } *errorCodePtr = EOK; stop: Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr->interp); Tcl_Release(rcPtr); return written; invalid: *errorCodePtr = EINVAL; error: written = -1; goto stop; } /* *---------------------------------------------------------------------- * * ReflectSeekWide / ReflectSeek -- * * This function is invoked when the user wishes to seek on the channel. * * Results: * The new location of the access point. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static Tcl_WideInt ReflectSeekWide( ClientData clientData, Tcl_WideInt offset, int seekMode, int *errorCodePtr) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *offObj, *baseObj; Tcl_Obj *resObj; /* Result for 'seek' */ Tcl_WideInt newLoc; /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.seek.seekMode = seekMode; p.seek.offset = offset; ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; p.seek.offset = -1; } else { *errorCodePtr = EOK; } return p.seek.offset; } #endif /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */ Tcl_Preserve(rcPtr); offObj = Tcl_NewWideIntObj(offset); baseObj = Tcl_NewStringObj( (seekMode == SEEK_SET) ? "start" : (seekMode == SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); goto invalid; } if (newLoc < 0) { SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart); goto invalid; } *errorCodePtr = EOK; stop: Tcl_DecrRefCount(offObj); Tcl_DecrRefCount(baseObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return newLoc; invalid: *errorCodePtr = EINVAL; newLoc = -1; goto stop; } static int ReflectSeek( ClientData clientData, long offset, int seekMode, int *errorCodePtr) { /* * This function can be invoked from a transformation which is based on * standard seeking, i.e. non-wide. Because of this we have to implement * it, a dummy is not enough. We simply delegate the call to the wide * routine. */ return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode, errorCodePtr); } /* *---------------------------------------------------------------------- * * ReflectWatch -- * * This function is invoked to tell the channel what events the I/O * system is interested in. * * Results: * None. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static void ReflectWatch( ClientData clientData, int mask) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *maskObj; /* * We restrict the interest to what the channel can support. IOW there * will never be write events for a channel which is not writable. * Analoguously for read events and non-readable channels. */ mask &= rcPtr->mode; if (mask == rcPtr->interest) { /* * Same old, same old, why should we do something? */ return; } /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.watch.mask = mask; ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p); /* * Any failure from the forward is ignored. We have no place to put * this. */ return; } #endif Tcl_Preserve(rcPtr); rcPtr->interest = mask; maskObj = DecodeEventMask(mask); /* assert maskObj.refCount == 1 */ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); } /* *---------------------------------------------------------------------- * * ReflectBlock -- * * This function is invoked to tell the channel which blocking behaviour * is required of it. * * Results: * A Posix error number. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectBlock( ClientData clientData, int nonblocking) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *blockObj; int errorNum; /* EINVAL or EOK (success). */ Tcl_Obj *resObj; /* Result data for 'blocking' */ /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.block.nonblocking = nonblocking; ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); return EINVAL; } return EOK; } #endif blockObj = Tcl_NewBooleanObj(!nonblocking); Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { errorNum = EOK; } Tcl_DecrRefCount(blockObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return errorNum; } #ifdef TCL_THREADS /* *---------------------------------------------------------------------- * * ReflectThread -- * * This function is invoked to tell the channel about thread movements. * * Results: * None. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static void ReflectThread( ClientData clientData, int action) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; switch (action) { case TCL_CHANNEL_THREAD_INSERT: rcPtr->owner = Tcl_GetCurrentThread(); break; case TCL_CHANNEL_THREAD_REMOVE: rcPtr->owner = NULL; break; default: Tcl_Panic("Unknown thread action code."); break; } } #endif /* *---------------------------------------------------------------------- * * ReflectSetOption -- * * This function is invoked to configure a channel option. * * Results: * A standard Tcl result code. * * Side effects: * Arbitrary, as it calls upon a Tcl script. * *---------------------------------------------------------------------- */ static int ReflectSetOption( ClientData clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *optionObj, *valueObj; int result; /* Result code for 'configure' */ Tcl_Obj *resObj; /* Result data for 'configure' */ /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.setOpt.name = optionName; p.setOpt.value = newValue; ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); UnmarshallErrorResult(interp, err); Tcl_DecrRefCount(err); FreeReceivedError(&p); } return p.base.code; } #endif Tcl_Preserve(rcPtr); optionObj = Tcl_NewStringObj(optionName, -1); valueObj = Tcl_NewStringObj(newValue, -1); Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); } Tcl_DecrRefCount(optionObj); Tcl_DecrRefCount(valueObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return result; } /* *---------------------------------------------------------------------- * * ReflectGetOption -- * * This function is invoked to retrieve all or a channel option. * * Results: * A standard Tcl result code. * * Side effects: * Arbitrary, as it calls upon a Tcl script. * *---------------------------------------------------------------------- */ static int ReflectGetOption( ClientData clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of reuqested option */ Tcl_DString *dsPtr) /* String to place the result into */ { /* * This code is special. It has regular passing of Tcl result, and errors. * The bypass functions are not required. */ ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ int listc, result = TCL_OK; Tcl_Obj **listv; MethodName method; /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { int opcode; ForwardParam p; p.getOpt.name = optionName; p.getOpt.value = dsPtr; if (optionName == NULL) { opcode = ForwardedGetOptAll; } else { opcode = ForwardedGetOpt; } ForwardOpToHandlerThread(rcPtr, opcode, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); UnmarshallErrorResult(interp, err); Tcl_DecrRefCount(err); FreeReceivedError(&p); } return p.base.code; } #endif if (optionName == NULL) { /* * Retrieve all options. */ method = METH_CGETALL; optionObj = NULL; } else { /* * Retrieve the value of one option. */ method = METH_CGET; optionObj = Tcl_NewStringObj(optionName, -1); Tcl_IncrRefCount(optionObj); } Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) { UnmarshallErrorResult(interp, resObj); goto error; } /* * The result has to go into the 'dsPtr' for propagation to the caller of * the driver. */ if (optionObj != NULL) { TclDStringAppendObj(dsPtr, resObj); goto ok; } /* * Extract the list and append each item as element. */ /* * NOTE (4): If we extract the string rep we can assume a properly quoted * string. Together with a separating space this way of simply appending * the whole string rep might be faster. It also doesn't check if the * result is a valid list. Nor that the list has an even number elements. */ if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { goto error; } if ((listc % 2) == 1) { /* * Odd number of elements is wrong. */ Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " "elements, got %d element%s instead", listc, (listc == 1 ? "" : "s"))); goto error; } else { int len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } goto ok; } ok: result = TCL_OK; stop: if (optionObj) { Tcl_DecrRefCount(optionObj); } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return result; error: result = TCL_ERROR; goto stop; } /* * Helpers. ========================================================= */ /* *---------------------------------------------------------------------- * * EncodeEventMask -- * * This function takes a list of event items and constructs the * equivalent internal bitmask. The list may be empty but will usually * contain at least one element. Valid elements are "read", "write", or * any unique abbreviation of them. Note that the bitmask is not changed * if problems are encountered. * * Results: * A standard Tcl error code. A bitmask where TCL_READABLE and/or * TCL_WRITABLE can be set. * * Side effects: * May shimmer 'obj' to a list representation. May place an error message * into the interp result. * *---------------------------------------------------------------------- */ static int EncodeEventMask( Tcl_Interp *interp, const char *objName, Tcl_Obj *obj, int *mask) { int events; /* Mask of events to post */ int listc; /* #elements in eventspec list */ Tcl_Obj **listv; /* Elements of eventspec list */ int evIndex; /* Id of event for an element of the eventspec * list. */ if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) { return TCL_ERROR; } events = 0; while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions, objName, 0, &evIndex) != TCL_OK) { return TCL_ERROR; } switch (evIndex) { case EVENT_READ: events |= TCL_READABLE; break; case EVENT_WRITE: events |= TCL_WRITABLE; break; } listc --; } *mask = events; return TCL_OK; } /* *---------------------------------------------------------------------- * * DecodeEventMask -- * * This function takes an internal bitmask of events and constructs the * equivalent list of event items. * * Results, Contract: * A Tcl_Obj reference. The object will have a refCount of one. The user * has to decrement it to release the object. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Obj * DecodeEventMask( int mask) { const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { case RANDW: eventStr = "read write"; break; case TCL_READABLE: eventStr = "read"; break; case TCL_WRITABLE: eventStr = "write"; break; default: eventStr = ""; break; } evObj = Tcl_NewStringObj(eventStr, -1); Tcl_IncrRefCount(evObj); /* assert evObj.refCount == 1 */ return evObj; } /* *---------------------------------------------------------------------- * * NewReflectedChannel -- * * This function is invoked to allocate and initialize the instance data * of a new reflected channel. * * Results: * A heap-allocated channel instance. * * Side effects: * Allocates memory. * *---------------------------------------------------------------------- */ static ReflectedChannel * NewReflectedChannel( Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; MethodName mn = METH_BLOCKING; rcPtr = (ReflectedChannel *)ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ rcPtr->chan = NULL; rcPtr->interp = interp; rcPtr->dead = 0; #ifdef TCL_THREADS rcPtr->thread = Tcl_GetCurrentThread(); #endif rcPtr->mode = mode; rcPtr->interest = 0; /* Initially no interest registered */ /* ASSERT: cmdpfxObj is a Tcl List */ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); Tcl_IncrRefCount(rcPtr->cmd); rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); while (mn <= METH_WRITE) { Tcl_ListObjAppendElement(NULL, rcPtr->methods, Tcl_NewStringObj(methodNames[mn++], -1)); } Tcl_IncrRefCount(rcPtr->methods); rcPtr->name = handleObj; Tcl_IncrRefCount(rcPtr->name); return rcPtr; } /* *---------------------------------------------------------------------- * * NextHandle -- * * This function is invoked to generate a channel handle for a new * reflected channel. * * Results: * A Tcl_Obj containing the string of the new channel handle. The * refcount of the returned object is -- zero --. * * Side effects: * May allocate memory. Mutex-protected critical section locks out other * threads for a short time. * *---------------------------------------------------------------------- */ static Tcl_Obj * NextHandle(void) { /* * Count number of generated reflected channels. Used for id generation. * Ids are never reclaimed and there is no dealing with wrap around. On * the other hand, "unsigned long" should be big enough except for * absolute longrunners (generate a 100 ids per second => overflow will * occur in 1 1/3 years). */ TCL_DECLARE_MUTEX(rcCounterMutex) static unsigned long rcCounter = 0; Tcl_Obj *resObj; Tcl_MutexLock(&rcCounterMutex); resObj = Tcl_ObjPrintf("rc%lu", rcCounter); rcCounter++; Tcl_MutexUnlock(&rcCounterMutex); return resObj; } static void FreeReflectedChannel( char *blockPtr) { ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr; Channel *chanPtr = (Channel *) rcPtr->chan; TclChannelRelease((Tcl_Channel)chanPtr); if (rcPtr->name) { Tcl_DecrRefCount(rcPtr->name); } if (rcPtr->methods) { Tcl_DecrRefCount(rcPtr->methods); } if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); } ckfree(rcPtr); } /* *---------------------------------------------------------------------- * * InvokeTclMethod -- * * This function is used to invoke the Tcl level of a reflected channel. * It handles all the command assembly, invocation, and generic state and * result mgmt. It does *not* handle thread redirection; that is the * responsibility of clients of this function. * * Results: * Result code and data as returned by the method. * * Side effects: * Arbitrary, as it calls upon a Tcl script. * * Contract: * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL * resObj.refCount in {0, 1, ...} * *---------------------------------------------------------------------- */ static int InvokeTclMethod( ReflectedChannel *rcPtr, MethodName method, Tcl_Obj *argOneObj, /* NULL'able */ Tcl_Obj *argTwoObj, /* NULL'able */ Tcl_Obj **resultObjPtr) /* NULL'able */ { Tcl_Obj *methObj = NULL; /* Method name in object form */ Tcl_InterpState sr; /* State of handler interp */ int result; /* Result code of method invocation */ Tcl_Obj *resObj = NULL; /* Result of method invocation. */ Tcl_Obj *cmd; if (rcPtr->dead) { /* * The channel is marked as dead. Bail out immediately, with an * appropriate error. */ if (resultObjPtr != NULL) { resObj = Tcl_NewStringObj(msg_dstlost,-1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } /* * Not touching argOneObj, argTwoObj, they have not been used. * See the contract as well. */ return TCL_ERROR; } /* * Insert method into the callback command, after the command prefix, * before the channel id. */ cmd = TclListObjCopy(NULL, rcPtr->cmd); Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); Tcl_ListObjAppendElement(NULL, cmd, methObj); Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); /* * Append the additional argument containing method specific details * behind the channel id. If specified. * * Because of the contract there is no need to increment the refcounts. * The objects will survive the Tcl_EvalObjv without change. */ if (argOneObj) { Tcl_ListObjAppendElement(NULL, cmd, argOneObj); if (argTwoObj) { Tcl_ListObjAppendElement(NULL, cmd, argTwoObj); } } /* * And run the handler... This is done in auch a manner which leaves any * existing state intact. */ Tcl_IncrRefCount(cmd); sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */); Tcl_Preserve(rcPtr->interp); result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL); /* * We do not try to extract the result information if the caller has no * interest in it. I.e. there is no need to put effort into creating * something which is discarded immediately after. */ if (resultObjPtr) { if (result == TCL_OK) { /* * Ok result taken as is, also if the caller requests that there * is no capture. */ resObj = Tcl_GetObjResult(rcPtr->interp); } else { /* * Non-ok result is always treated as an error. We have to capture * the full state of the result, including additional options. * * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ if (result != TCL_ERROR) { int cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rcPtr->interp); Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf( "chan handler returned bad code: %d", result)); Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(cmd); result = TCL_ERROR; } Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf( "\n (chan handler subcommand \"%s\")", methodNames[method])); resObj = MarshallError(rcPtr->interp); } Tcl_IncrRefCount(resObj); } Tcl_DecrRefCount(cmd); Tcl_RestoreInterpState(rcPtr->interp, sr); Tcl_Release(rcPtr->interp); /* * The resObj has a ref count of 1 at this location. This means that the * caller of InvokeTclMethod has to dispose of it (but only if it was * returned to it). */ if (resultObjPtr != NULL) { *resultObjPtr = resObj; } /* * There no need to handle the case where nothing is returned, because for * that case resObj was not set anyway. */ return result; } /* *---------------------------------------------------------------------- * * ErrnoReturn -- * * Checks a method error result if it returned an 'errno'. * * Results: * The negative errno found in the error result, or 0. * * Side effects: * None. * * Users: * ReflectInput/Output(), to enable the signaling of EAGAIN on 0-sized * short reads/writes. * *---------------------------------------------------------------------- */ static int ErrnoReturn( ReflectedChannel *rcPtr, Tcl_Obj *resObj) { int code; Tcl_InterpState sr; /* State of handler interp */ if (rcPtr->dead) { return 0; } sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */); UnmarshallErrorResult(rcPtr->interp, resObj); resObj = Tcl_GetObjResult(rcPtr->interp); if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK) || (code >= 0))) { if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) { code = -EAGAIN; } else { code = 0; } } Tcl_RestoreInterpState(rcPtr->interp, sr); return code; } /* *---------------------------------------------------------------------- * * GetReflectedChannelMap -- * * Gets and potentially initializes the reflected channel map for an * interpreter. * * Results: * A pointer to the map created, for use by the caller. * * Side effects: * Initializes the reflected channel map for an interpreter. * *---------------------------------------------------------------------- */ static ReflectedChannelMap * GetReflectedChannelMap( Tcl_Interp *interp) { ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL); if (rcmPtr == NULL) { rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RCMKEY, (Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr); } return rcmPtr; } /* *---------------------------------------------------------------------- * * DeleteReflectedChannelMap -- * * Deletes the channel table for an interpreter, closing any open * channels whose refcount reaches zero. This procedure is invoked when * an interpreter is deleted, via the AssocData cleanup mechanism. * * Results: * None. * * Side effects: * Deletes the hash table of channels. May close channels. May flush * output on closed channels. Removes any channelEvent handlers that were * registered in this interpreter. * *---------------------------------------------------------------------- */ static void MarkDead( ReflectedChannel *rcPtr) { if (rcPtr->dead) { return; } if (rcPtr->name) { Tcl_DecrRefCount(rcPtr->name); rcPtr->name = NULL; } if (rcPtr->methods) { Tcl_DecrRefCount(rcPtr->methods); rcPtr->methods = NULL; } if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); rcPtr->cmd = NULL; } rcPtr->dead = 1; } static void DeleteReflectedChannelMap( ClientData clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData; /* The map */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ ReflectedChannel *rcPtr; Tcl_Channel chan; #ifdef TCL_THREADS ForwardingResult *resultPtr; ForwardingEvent *evPtr; ForwardParam *paramPtr; #endif /* * Delete all entries. The channels may have been closed already, or will * be closed later, by the standard IO finalization of an interpreter * under destruction. Except for the channels which were moved to a * different interpreter and/or thread. They do not exist from the IO * systems point of view and will not get closed. Therefore mark all as * dead so that any future access will cause a proper error. For channels * in a different thread we actually do the same as * DeleteThreadReflectedChannelMap(), just restricted to the channels of * this interp. */ for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan); MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); ckfree(&rcmPtr->map); #ifdef TCL_THREADS /* * The origin interpreter for one or more reflected channels is gone. */ /* * Go through the list of pending results and cancel all whose events were * destined for this interpreter. While this is in progress we block any * other access to the list of pending results. */ Tcl_MutexLock(&rcForwardMutex); for (resultPtr = forwardList; resultPtr != NULL; resultPtr = resultPtr->nextPtr) { if (resultPtr->dsti != interp) { /* * Ignore results/events for other interpreters. */ continue; } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. * * Attention: Results may have been detached already, by either the * receiver, or this thread, as part of other parts in the thread * teardown. Such results are ignored. See ticket [b47b176adf] for the * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; /* * Basic crash safety until this routine can get revised [3411310] */ if (evPtr == NULL) { continue; } paramPtr = evPtr->param; if (!evPtr) { continue; } evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; resultPtr->result = TCL_ERROR; ForwardSetStaticError(paramPtr, msg_send_dstlost); Tcl_ConditionNotify(&resultPtr->done); } Tcl_MutexUnlock(&rcForwardMutex); /* * Get the map of all channels handled by the current thread. This is a * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go * through the channels and remove all which were handled by this * interpreter. They have already been marked as dead. */ rcmPtr = GetThreadReflectedChannelMap(); for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan); if (rcPtr->interp != interp) { /* * Ignore entries for other interpreters. */ continue; } MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } #endif } #ifdef TCL_THREADS /* *---------------------------------------------------------------------- * * GetThreadReflectedChannelMap -- * * Gets and potentially initializes the reflected channel map for a * thread. * * Results: * A pointer to the map created, for use by the caller. * * Side effects: * Initializes the reflected channel map for a thread. * *---------------------------------------------------------------------- */ static ReflectedChannelMap * GetThreadReflectedChannelMap(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rcmPtr) { tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); } return tsdPtr->rcmPtr; } /* *---------------------------------------------------------------------- * * DeleteThreadReflectedChannelMap -- * * Deletes the channel table for a thread. This procedure is invoked when * a thread is deleted. The channels have already been marked as dead, in * DeleteReflectedChannelMap(). * * Results: * None. * * Side effects: * Deletes the hash table of channels. * *---------------------------------------------------------------------- */ static void DeleteThreadReflectedChannelMap( ClientData dummy) /* The per-thread data structure. */ { Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ Tcl_ThreadId self = Tcl_GetCurrentThread(); ReflectedChannelMap *rcmPtr; /* The map */ ForwardingResult *resultPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)dummy; /* * The origin thread for one or more reflected channels is gone. * NOTE: If this function is called due to a thread getting killed the * per-interp DeleteReflectedChannelMap is apparently not called. */ /* * Go through the list of pending results and cancel all whose events were * destined for this thread. While this is in progress we block any other * access to the list of pending results. */ Tcl_MutexLock(&rcForwardMutex); for (resultPtr = forwardList; resultPtr != NULL; resultPtr = resultPtr->nextPtr) { ForwardingEvent *evPtr; ForwardParam *paramPtr; if (resultPtr->dst != self) { /* * Ignore results/events for other threads. */ continue; } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. * * Attention: Results may have been detached already, by either the * receiver, or this thread, as part of other parts in the thread * teardown. Such results are ignored. See ticket [b47b176adf] for the * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; /* * Basic crash safety until this routine can get revised [3411310] */ if (evPtr == NULL ) { continue; } paramPtr = evPtr->param; if (!evPtr) { continue; } evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; resultPtr->result = TCL_ERROR; ForwardSetStaticError(paramPtr, msg_send_dstlost); Tcl_ConditionNotify(&resultPtr->done); } Tcl_MutexUnlock(&rcForwardMutex); /* * Run over the event queue of this thread and remove all ReflectEvent's * still pending. These are inbound events for reflected channels this * thread owns but doesn't handle. The inverse of the channel map * actually. */ Tcl_DeleteEvents(ReflectEventDelete, NULL); /* * Get the map of all channels handled by the current thread. This is a * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go * through the channels, remove all, mark them as dead. */ rcmPtr = GetThreadReflectedChannelMap(); tsdPtr->rcmPtr = NULL; for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan); MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } ckfree(rcmPtr); } static void ForwardOpToHandlerThread( ReflectedChannel *rcPtr, /* Channel instance */ ForwardedOperation op, /* Forwarded driver operation */ const void *param) /* Arguments */ { /* * Core of the communication from OWNER to HANDLER thread. The receiver is * ForwardProc() below. */ Tcl_ThreadId dst = rcPtr->thread; ForwardingEvent *evPtr; ForwardingResult *resultPtr; /* * We gather the lock early. This allows us to check the liveness of the * channel without interference from DeleteThreadReflectedChannelMap(). */ Tcl_MutexLock(&rcForwardMutex); if (rcPtr->dead) { /* * The channel is marked as dead. Bail out immediately, with an * appropriate error. Do not forget to unlock the mutex on this path. */ ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost); Tcl_MutexUnlock(&rcForwardMutex); return; } /* * Create and initialize the event and data structures. */ evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent)); resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; evPtr->op = op; evPtr->rcPtr = rcPtr; evPtr->param = (ForwardParam *) param; resultPtr->src = Tcl_GetCurrentThread(); resultPtr->dst = dst; resultPtr->dsti = rcPtr->interp; resultPtr->done = NULL; resultPtr->result = -1; resultPtr->evPtr = evPtr; /* * Now execute the forward. */ TclSpliceIn(resultPtr, forwardList); /* * Do not unlock here. That is done by the ConditionWait. */ /* * Ensure cleanup of the event if the origin thread exits while this event * is pending or in progress. Exit of the destination thread is handled by * DeleteThreadReflectedChannelMap(), this is set up by * GetThreadReflectedChannelMap(). This is what we use the 'forwardList' * (see above) for. */ Tcl_CreateThreadExitHandler(SrcExitProc, evPtr); /* * Queue the event and poke the other thread's notifier. */ Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL); Tcl_ThreadAlert(dst); /* * (*) Block until the handler thread has either processed the transfer or * rejected it. */ while (resultPtr->result < 0) { /* * NOTE (1): Is it possible that the current thread goes away while * waiting here? IOW Is it possible that "SrcExitProc" is called while * we are here? See complementary note (2) in "SrcExitProc" * * The ConditionWait unlocks the mutex during the wait and relocks it * immediately after. */ Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL); } /* * Unlink result from the forwarder list. No need to lock. Either still * locked, or locked by the ConditionWait */ TclSpliceOut(resultPtr, forwardList); resultPtr->nextPtr = NULL; resultPtr->prevPtr = NULL; Tcl_MutexUnlock(&rcForwardMutex); Tcl_ConditionFinalize(&resultPtr->done); /* * Kill the cleanup handler now, and the result structure as well, before * returning the success code. * * Note: The event structure has already been deleted. */ Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); ckfree(resultPtr); } static int ForwardProc( Tcl_Event *evGPtr, int mask) { /* * HANDLER thread. * The receiver part for the operations coming from the OWNER thread. * See ForwardOpToHandlerThread() for the transmitter. * * Notes regarding access to the referenced data. * * In principle the data belongs to the originating thread (see * evPtr->src), however this thread is currently blocked at (*), i.e., * quiescent. Because of this we can treat the data as belonging to us, * without fear of race conditions. I.e. we can read and write as we like. * * The only thing we cannot be sure of is the resultPtr. This can be be * NULLed if the originating thread went away while the event is handled * here now. */ ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr; ForwardingResult *resultPtr = evPtr->resultPtr; ReflectedChannel *rcPtr = evPtr->rcPtr; Tcl_Interp *interp = rcPtr->interp; ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in * this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ (void)mask; /* * Ignore the event if no one is waiting for its result anymore. */ if (!resultPtr) { return 1; } paramPtr->base.code = TCL_OK; paramPtr->base.msgStr = NULL; paramPtr->base.mustFree = 0; switch (evPtr->op) { /* * The destination thread for the following operations is * rcPtr->thread, which contains rcPtr->interp, the interp we have to * call upon for the driver. */ case ForwardedClose: { /* * No parameters/results. */ if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } /* * Freeing is done here, in the origin thread, callback command * objects belong to this thread. Deallocating them in a different * thread is not allowed * * We remove the channel from both interpreter and thread maps before * releasing the memory, to prevent future accesses (like by * 'postevent') from finding and dereferencing a dangling pointer. */ rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); MarkDead(rcPtr); break; } case ForwardedInput: { Tcl_Obj *toReadObj; TclNewIntObj(toReadObj, paramPtr->input.toRead); Tcl_IncrRefCount(toReadObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){ int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { paramPtr->base.code = code; } else { ForwardSetObjError(paramPtr, resObj); } paramPtr->input.toRead = -1; } else { /* * Process a regular result. */ int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); if (paramPtr->input.toRead < bytec) { ForwardSetStaticError(paramPtr, msg_read_toomuch); paramPtr->input.toRead = -1; } else { if (bytec > 0) { memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; } } Tcl_Release(rcPtr); Tcl_DecrRefCount(toReadObj); break; } case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->output.buf, paramPtr->output.toWrite); Tcl_IncrRefCount(bufObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { paramPtr->base.code = code; } else { ForwardSetObjError(paramPtr, resObj); } paramPtr->output.toWrite = -1; } else { /* * Process a regular result. */ int written; if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); paramPtr->output.toWrite = -1; } else if (written==0 || paramPtr->output.toWriteoutput.toWrite = -1; } else { paramPtr->output.toWrite = written; } } Tcl_Release(rcPtr); Tcl_DecrRefCount(bufObj); break; } case ForwardedSeek: { Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset); Tcl_Obj *baseObj = Tcl_NewStringObj( (paramPtr->seek.seekMode==SEEK_SET) ? "start" : (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } else { /* * Process a regular result. If the type is wrong this may change * into an error. */ Tcl_WideInt newLoc; if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) { if (newLoc < 0) { ForwardSetStaticError(paramPtr, msg_seek_beforestart); paramPtr->seek.offset = -1; } else { paramPtr->seek.offset = newLoc; } } else { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } } Tcl_Release(rcPtr); Tcl_DecrRefCount(offObj); Tcl_DecrRefCount(baseObj); break; } case ForwardedWatch: { Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask); /* assert maskObj.refCount == 1 */ Tcl_Preserve(rcPtr); rcPtr->interest = paramPtr->watch.mask; (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); break; } case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(blockObj); break; } case ForwardedSetOpt: { Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1); Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); Tcl_DecrRefCount(valueObj); break; } case ForwardedGetOpt: { /* * Retrieve the value of one option. */ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); Tcl_IncrRefCount(optionObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { TclDStringAppendObj(paramPtr->getOpt.value, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); break; } case ForwardedGetOptAll: /* * Retrieve all options. */ Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { /* * Extract list, validate that it is a list, and #elements. See * NOTE (4) as well. */ int listc; Tcl_Obj **listv; if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); } else if ((listc % 2) == 1) { /* * Odd number of elements is wrong. [x]. */ char *buf = (char *)ckalloc(200); snprintf(buf, 200, "{Expected list with even number of elements, got %d %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { int len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } } Tcl_Release(rcPtr); break; default: /* * Bad operation code. */ Tcl_Panic("Bad operation code in ForwardProc"); break; } /* * Remove the reference we held on the result of the invoke, if we had * such. */ if (resObj != NULL) { Tcl_DecrRefCount(resObj); } if (resultPtr) { /* * Report the forwarding result synchronously to the waiting caller. * This unblocks (*) as well. This is wrapped into a conditional * because the caller may have exited in the mean time. */ Tcl_MutexLock(&rcForwardMutex); resultPtr->result = TCL_OK; Tcl_ConditionNotify(&resultPtr->done); Tcl_MutexUnlock(&rcForwardMutex); } return 1; } static void SrcExitProc( ClientData clientData) { ForwardingEvent *evPtr = (ForwardingEvent *)clientData; ForwardingResult *resultPtr; ForwardParam *paramPtr; /* * NOTE (2): Can this handler be called with the originator blocked? */ /* * The originator for the event exited. It is not sure if this can happen, * as the originator should be blocked at (*) while the event is in * transit/pending. * * We make sure that the event cannot refer to the result anymore, remove * it from the list of pending results and free the structure. Locking the * access ensures that we cannot get in conflict with "ForwardProc", * should it already execute the event. */ Tcl_MutexLock(&rcForwardMutex); resultPtr = evPtr->resultPtr; paramPtr = evPtr->param; evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; resultPtr->result = TCL_ERROR; ForwardSetStaticError(paramPtr, msg_send_originlost); /* * See below: TclSpliceOut(resultPtr, forwardList); */ Tcl_MutexUnlock(&rcForwardMutex); /* * This unlocks (*). The structure will be spliced out and freed by * "ForwardProc". Maybe. */ Tcl_ConditionNotify(&resultPtr->done); } static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { int len; const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; ForwardSetDynamicError(paramPtr, ckalloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/generic/tclIORTrans.c0000644000175000017500000026113214554262142015573 0ustar sergeisergei/* * tclIORTrans.c -- * * This file contains the implementation of Tcl's generic transformation * reflection code, which allows the implementation of Tcl channel * transformations in Tcl code. * * Parts of this file are based on code contributed by Jean-Claude * Wippler. * * See TIP #230 for the specification of this functionality. * * Copyright (c) 2007-2008 ActiveState. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" #include #ifndef EINVAL #define EINVAL 9 #endif #ifndef EOK #define EOK 0 #endif /* * Signatures of all functions used in the C layer of the reflection. */ static int ReflectClose(ClientData clientData, Tcl_Interp *interp); static int ReflectClose2(ClientData clientData, Tcl_Interp *interp, int flags); static int ReflectInput(ClientData clientData, char *buf, int toRead, int *errorCodePtr); static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); static Tcl_WideInt ReflectSeekWide(ClientData clientData, Tcl_WideInt offset, int mode, int *errorCodePtr); static int ReflectSeek(ClientData clientData, long offset, int mode, int *errorCodePtr); static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int ReflectSetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, const char *newValue); static int ReflectHandle(ClientData clientData, int direction, ClientData *handle); static int ReflectNotify(ClientData clientData, int mask); /* * The C layer channel type/driver definition used by the reflection. */ static const Tcl_ChannelType tclRTransformType = { "tclrtransform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel. */ ReflectClose, /* Close channel, clean instance data. */ ReflectInput, /* Handle read request. */ ReflectOutput, /* Handle write request. */ ReflectSeek, /* Move location of access point. */ ReflectSetOption, /* Set options. */ ReflectGetOption, /* Get options. */ ReflectWatch, /* Initialize notifier. */ ReflectHandle, /* Get OS handle from the channel. */ ReflectClose2, /* No close2 support. NULL'able. */ ReflectBlock, /* Set blocking/nonblocking. */ NULL, /* Flush channel. Not used by core. * NULL'able. */ ReflectNotify, /* Handle events. */ ReflectSeekWide, /* Move access point (64 bit). */ NULL, /* thread action */ NULL /* truncate */ }; /* * Structure of the buffer to hold transform results to be consumed by higher * layers upon reading from the channel, plus the functions to manage such. */ typedef struct { unsigned char *buf; /* Reference to the buffer area. */ size_t allocated; /* Allocated size of the buffer area. */ size_t used; /* Number of bytes in the buffer, * <= allocated. */ } ResultBuffer; #define ResultLength(r) ((r)->used) /* static int ResultLength(ResultBuffer *r); */ static inline void ResultClear(ResultBuffer *r); static inline void ResultInit(ResultBuffer *r); static inline void ResultAdd(ResultBuffer *r, unsigned char *buf, size_t toWrite); static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf, size_t toRead); #define RB_INCREMENT (512) /* * Convenience macro to make some casts easier to use. */ #define UCHARP(x) ((unsigned char *) (x)) /* * Instance data for a reflected transformation. =========================== */ typedef struct { Tcl_Channel chan; /* Back reference to the channel of the * transformation itself. */ Tcl_Channel parent; /* Reference to the channel the transformation * was pushed on. */ Tcl_Interp *interp; /* Reference to the interpreter containing the * Tcl level part of the channel. */ Tcl_Obj *handle; /* Reference to transform handle. Also stored * in the argv, see below. The separate field * gives us direct access, needed when working * with the reflection maps. */ #ifdef TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ #endif Tcl_TimerToken timer; /* See [==] as well. * Storage for the command prefix and the additional words required for * the invocation of methods in the command handler. * * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] * cmd ... pfx | method chan | detail1 detail2 * ~~~~ CT ~~~ ~~ CT ~~ * * CT = Belongs to the 'Command handler Thread'. */ int argc; /* Number of preallocated words - 2. */ Tcl_Obj **argv; /* Preallocated array for calling the handler. * args[0] is placeholder for cmd word. * Followed by the arguments in the prefix, * plus 4 placeholders for method, channel, * and at most two varying (method specific) * words. */ int methods; /* Bitmask of supported methods. */ /* * NOTE (9): Should we have predefined shared literals for the method * names? */ int mode; /* Mask of R/W mode */ int nonblocking; /* Flag: Channel is blocking or not. */ int readIsDrained; /* Flag: Read buffers are flushed. */ int eofPending; /* Flag: EOF seen down, but not raised up */ int dead; /* Boolean signal that some operations * should no longer be attempted. */ ResultBuffer result; } ReflectedTransform; /* * Structure of the table mapping from transform handles to reflected * transform (channels). Each interpreter which has the handler command for * one or more reflected transforms records them in such a table, so that we * are able to find them during interpreter/thread cleanup even if the actual * channel they belong to was moved to a different interpreter and/or thread. * * The table is reachable via the standard interpreter AssocData, the key is * defined below. */ typedef struct { Tcl_HashTable map; } ReflectedTransformMap; #define RTMKEY "ReflectedTransformMap" /* * Method literals. ================================================== */ static const char *const methodNames[] = { "clear", /* OPT */ "drain", /* OPT, drain => read */ "finalize", /* */ "flush", /* OPT, flush => write */ "initialize", /* */ "limit?", /* OPT */ "read", /* OPT */ "write", /* OPT */ NULL }; typedef enum { METH_CLEAR, METH_DRAIN, METH_FINAL, METH_FLUSH, METH_INIT, METH_LIMIT, METH_READ, METH_WRITE } MethodName; #define FLAG(m) (1 << (m)) #define REQUIRED_METHODS \ (FLAG(METH_INIT) | FLAG(METH_FINAL)) #define RANDW \ (TCL_READABLE | TCL_WRITABLE) #define IMPLIES(a,b) ((!(a)) || (b)) #define NEGIMPL(a,b) #define HAS(x,f) ((x) & FLAG(f)) #ifdef TCL_THREADS /* * Thread specific types and structures. * * We are here essentially creating a very specific implementation of 'thread * send'. */ /* * Enumeration of all operations which can be forwarded. */ typedef enum { ForwardedClear, ForwardedClose, ForwardedDrain, ForwardedFlush, ForwardedInput, ForwardedLimit, ForwardedOutput } ForwardedOperation; /* * Event used to forward driver invocations to the thread actually managing * the channel. We cannot construct the command to execute and forward that. * Because then it will contain a mixture of Tcl_Obj's belonging to both the * command handler thread (CT), and the thread managing the channel (MT), * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we * forward an operation code, the argument details, and reference to results. * The command is assembled in the CT and belongs fully to that thread. No * sharing problems. */ typedef struct ForwardParamBase { int code; /* O: Ok/Fail of the cmd handler */ char *msgStr; /* O: Error message for handler failure */ int mustFree; /* O: True if msgStr is allocated, false if * otherwise (static). */ } ForwardParamBase; /* * Operation specific parameter/result structures. (These are "subtypes" of * ForwardParamBase. Where an operation does not need any special types, it * has no "subtype" and just uses ForwardParamBase, as listed above.) */ struct ForwardParamTransform { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* I: Bytes to transform, * O: Bytes in transform result */ int size; /* I: #bytes to transform, * O: #bytes in the transform result */ }; struct ForwardParamLimit { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ int max; /* O: Character read limit */ }; /* * Now join all these together in a single union for convenience. */ typedef union ForwardParam { ForwardParamBase base; struct ForwardParamTransform transform; struct ForwardParamLimit limit; } ForwardParam; /* * Forward declaration. */ typedef struct ForwardingResult ForwardingResult; /* * General event structure, with reference to operation specific data. */ typedef struct ForwardingEvent { Tcl_Event event; /* Basic event data, has to be first item */ ForwardingResult *resultPtr; ForwardedOperation op; /* Forwarded driver operation */ ReflectedTransform *rtPtr; /* Channel instance */ ForwardParam *param; /* Packaged arguments and return values, a * ForwardParam pointer. */ } ForwardingEvent; /* * Structure to manage the result of the forwarding. This is not the result of * the operation itself, but about the success of the forward event itself. * The event can be successful, even if the operation which was forwarded * failed. It is also there to manage the synchronization between the involved * threads. */ struct ForwardingResult { Tcl_ThreadId src; /* Originating thread. */ Tcl_ThreadId dst; /* Thread the op was forwarded to. */ Tcl_Interp *dsti; /* Interpreter in the thread the op was * forwarded to. */ Tcl_Condition done; /* Condition variable the forwarder blocks * on. */ int result; /* TCL_OK or TCL_ERROR */ ForwardingEvent *evPtr; /* Event the result belongs to. */ ForwardingResult *prevPtr, *nextPtr; /* Links into the list of pending forwarded * results. */ }; typedef struct ThreadSpecificData { /* * Table of all reflected transformations owned by this thread. */ ReflectedTransformMap *rtmPtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * List of forwarded operations which have not completed yet, plus the mutex * to protect the access to this process global list. */ static ForwardingResult *forwardList = NULL; TCL_DECLARE_MUTEX(rtForwardMutex) /* * Function containing the generic code executing a forward, and wrapper * macros for the actual operations we wish to forward. Uses ForwardProc as * the event function executed by the thread receiving a forwarding event * (which executes the appropriate function and collects the result, if any). * * The two ExitProcs are handlers so that things do not deadlock when either * thread involved in the forwarding exits. They also clean things up so that * we don't leak resources when threads go away. */ static void ForwardOpToOwnerThread(ReflectedTransform *rtPtr, ForwardedOperation op, const void *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); #define FreeReceivedError(p) \ do { \ if ((p)->base.mustFree) { \ ckfree((p)->base.msgStr); \ } \ } while (0) #define PassReceivedErrorInterp(i,p) \ do { \ if ((i) != NULL) { \ Tcl_SetChannelErrorInterp((i), \ Tcl_NewStringObj((p)->base.msgStr, -1)); \ } \ FreeReceivedError(p); \ } while (0) #define PassReceivedError(c,p) \ do { \ Tcl_SetChannelError((c), \ Tcl_NewStringObj((p)->base.msgStr, -1)); \ FreeReceivedError(p); \ } while (0) #define ForwardSetStaticError(p,emsg) \ do { \ (p)->base.code = TCL_ERROR; \ (p)->base.mustFree = 0; \ (p)->base.msgStr = (char *) (emsg); \ } while (0) #define ForwardSetDynamicError(p,emsg) \ do { \ (p)->base.code = TCL_ERROR; \ (p)->base.mustFree = 1; \ (p)->base.msgStr = (char *) (emsg); \ } while (0) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); static ReflectedTransformMap * GetThreadReflectedTransformMap(void); static void DeleteThreadReflectedTransformMap( ClientData clientData); #endif /* TCL_THREADS */ #define SetChannelErrorStr(c,msgStr) \ Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1)) static Tcl_Obj * MarshallError(Tcl_Interp *interp); static void UnmarshallErrorResult(Tcl_Interp *interp, Tcl_Obj *msgObj); /* * Static functions for this file: */ static Tcl_Obj * DecodeEventMask(int mask); static ReflectedTransform * NewReflectedTransform(Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj, Tcl_Channel parentChan); static Tcl_Obj * NextHandle(void); static Tcl_FreeProc FreeReflectedTransform; static void FreeReflectedTransformArgs(ReflectedTransform *rtPtr); static int InvokeTclMethod(ReflectedTransform *rtPtr, const char *method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedTransformMap * GetReflectedTransformMap(Tcl_Interp *interp); static void DeleteReflectedTransformMap(ClientData clientData, Tcl_Interp *interp); /* * Global constant strings (messages). ================== * These string are used directly as bypass errors, thus they have to be valid * Tcl lists where the last element is the message itself. Hence the * list-quoting to keep the words of the message together. See also [x]. */ static const char *msg_read_unsup = "{read not supported by Tcl driver}"; static const char *msg_write_unsup = "{write not supported by Tcl driver}"; #ifdef TCL_THREADS static const char *msg_send_originlost = "{Channel thread lost}"; static const char *msg_send_dstlost = "{Owner lost}"; #endif /* TCL_THREADS */ static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}"; /* * Timer management (flushing out buffered data via artificial events). */ /* * Helper functions encapsulating some of the thread forwarding to make the * control flow in callers easier. */ static void TimerKill(ReflectedTransform *rtPtr); static void TimerSetup(ReflectedTransform *rtPtr); static void TimerRun(ClientData clientData); static int TransformRead(ReflectedTransform *rtPtr, int *errorCodePtr, Tcl_Obj *bufObj); static int TransformWrite(ReflectedTransform *rtPtr, int *errorCodePtr, unsigned char *buf, int toWrite); static int TransformDrain(ReflectedTransform *rtPtr, int *errorCodePtr); static int TransformFlush(ReflectedTransform *rtPtr, int *errorCodePtr, int op); static void TransformClear(ReflectedTransform *rtPtr); static int TransformLimit(ReflectedTransform *rtPtr, int *errorCodePtr, int *maxPtr); /* * Operation codes for TransformFlush(). */ #define FLUSH_WRITE 1 #define FLUSH_DISCARD 0 /* * Main methods to plug into the 'chan' ensemble'. ================== */ /* *---------------------------------------------------------------------- * * TclChanPushObjCmd -- * * This function is invoked to process the "chan push" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. The handle of the new channel is placed in the * interp result. * * Side effects: * Creates a new channel. * *---------------------------------------------------------------------- */ int TclChanPushObjCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { ReflectedTransform *rtPtr; /* Instance data of the new (transform) * channel. */ Tcl_Obj *chanObj; /* Handle of parent channel */ Tcl_Channel parentChan; /* Token of parent channel */ int mode; /* R/W mode of parent, later the new channel. * Has to match the abilities of the handler * commands */ Tcl_Obj *cmdObj; /* Command prefix, list of words */ Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Obj *rtId; /* Handle of the new transform (channel) */ Tcl_Obj *modeObj; /* mode in obj form for method call */ int listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ Tcl_Obj *resObj; /* Result data for 'initialize' */ int methods; /* Bitmask for supported methods. */ ReflectedTransformMap *rtmPtr; /* Map of reflected transforms with handlers * in this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ int isNew; /* Placeholder. */ (void)dummy; /* * Syntax: chan push CHANNEL CMDPREFIX * [0] [1] [2] [3] * * Actually: rPush CHANNEL CMDPREFIX * [0] [1] [2] */ #define CHAN (1) #define CMD (2) /* * Number of arguments... */ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "channel cmdprefix"); return TCL_ERROR; } /* * First argument is a channel handle. */ chanObj = objv[CHAN]; parentChan = Tcl_GetChannel(interp, Tcl_GetString(chanObj), &mode); if (parentChan == NULL) { return TCL_ERROR; } parentChan = Tcl_GetTopChannel(parentChan); /* * Second argument is command prefix, i.e. list of words, first word is * name of handler command, other words are fixed arguments. Run the * 'initialize' method to get the list of supported methods. Validate * this. */ cmdObj = objv[CMD]; /* * Basic check that the command prefix truly is a list. */ if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) { return TCL_ERROR; } /* * Now create the transformation (channel). */ rtId = NextHandle(); rtPtr = NewReflectedTransform(interp, cmdObj, mode, rtId, parentChan); /* * Invoke 'initialize' and validate that the handler is present and ok. * Squash the transformation if not. */ modeObj = DecodeEventMask(mode); /* assert modeObj.refCount == 1 */ result = InvokeTclMethod(rtPtr, "initialize", modeObj, NULL, &resObj); Tcl_DecrRefCount(modeObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ goto error; } /* * Verify the result. * - List, of method names. Convert to mask. Check for non-optionals * through the mask. Compare open mode against optional r/w. */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned non-list: %s", Tcl_GetString(cmdObj), Tcl_GetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } methods = 0; while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, "method", TCL_EXACT, &methIndex) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned %s", Tcl_GetString(cmdObj), Tcl_GetString(Tcl_GetObjResult(interp)))); Tcl_DecrRefCount(resObj); goto error; } methods |= FLAG(methIndex); listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" does not support all required methods", Tcl_GetString(cmdObj))); goto error; } /* * Mode tell us what the parent channel supports. The methods tell us what * the handler supports. We remove the non-supported bits from the mode * and check that the channel is not completely inaccessible. Afterward the * mode tells us which methods are still required, and these methods will * also be supported by the handler, by design of the check. */ if (!HAS(methods, METH_READ)) { mode &= ~TCL_READABLE; } if (!HAS(methods, METH_WRITE)) { mode &= ~TCL_WRITABLE; } if (!mode) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" makes the channel inaccessible", Tcl_GetString(cmdObj))); goto error; } /* * The mode and support for it is ok, now check the internal constraints. */ if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"drain\" but not \"read\"", Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"flush\" but not \"write\"", Tcl_GetString(cmdObj))); goto error; } Tcl_ResetResult(interp); /* * Everything is fine now. */ rtPtr->methods = methods; rtPtr->mode = mode; rtPtr->chan = Tcl_StackChannel(interp, &tclRTransformType, rtPtr, mode, rtPtr->parent); /* * Register the transform in our our map for proper handling of deleted * interpreters and/or threads. */ rtmPtr = GetReflectedTransformMap(interp); hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew); if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) { Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle"); } Tcl_SetHashValue(hPtr, rtPtr); #ifdef TCL_THREADS rtmPtr = GetThreadReflectedTransformMap(); hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew); Tcl_SetHashValue(hPtr, rtPtr); #endif /* TCL_THREADS */ /* * Return the channel as the result of the command. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( Tcl_GetChannelName(rtPtr->chan), -1)); return TCL_OK; error: /* * We are not going through ReflectClose as we never had a channel * structure. */ Tcl_EventuallyFree(rtPtr, FreeReflectedTransform); return TCL_ERROR; #undef CHAN #undef CMD } /* *---------------------------------------------------------------------- * * TclChanPopObjCmd -- * * This function is invoked to process the "chan pop" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * Posts events to a reflected channel, invokes event handlers. The * latter implies that arbitrary side effects are possible. * *---------------------------------------------------------------------- */ int TclChanPopObjCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { /* * Syntax: chan pop CHANNEL * [0] [1] [2] * * Actually: rPop CHANNEL * [0] [1] */ #define CHAN (1) const char *chanId; /* Tcl level channel handle */ Tcl_Channel chan; /* Channel associated to the handle */ int mode; /* Channel r/w mode */ (void)dummy; /* * Number of arguments... */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } /* * First argument is a channel, which may have a (reflected) * transformation. */ chanId = TclGetString(objv[CHAN]); chan = Tcl_GetChannel(interp, chanId, &mode); if (chan == NULL) { return TCL_ERROR; } /* * Removing transformations is generic, and not restricted to reflected * transformations. */ Tcl_UnstackChannel(interp, chan); return TCL_OK; #undef CHAN } /* * Channel error message marshalling utilities. */ static Tcl_Obj * MarshallError( Tcl_Interp *interp) { /* * Capture the result status of the interpreter into a string. => List of * options and values, followed by the error message. The result has * refCount 0. */ Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR); /* * => returnOpt.refCount == 0. We can append directly. */ Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp)); return returnOpt; } static void UnmarshallErrorResult( Tcl_Interp *interp, Tcl_Obj *msgObj) { int lc; Tcl_Obj **lv; int explicitResult; int numOptions; /* * Process the caught message. * * Syntax = (option value)... ?message? * * Bad syntax causes a panic. This is OK because the other side uses * Tcl_GetReturnOptions and list construction functions to marshall the * information; if we panic here, something has gone badly wrong already. */ if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) { Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result"); } if (interp == NULL) { return; } explicitResult = lc & 1; /* Odd number of values? */ numOptions = lc - explicitResult; if (explicitResult) { Tcl_SetObjResult(interp, lv[lc-1]); } Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv)); ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED; } /* * Driver functions. ================================================ */ /* *---------------------------------------------------------------------- * * ReflectClose -- * * This function is invoked when the channel is closed, to delete the * driver specific instance data. * * Results: * A Posix error. * * Side effects: * Releases memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectClose( ClientData clientData, Tcl_Interp *interp) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; int errorCode, errorCodeSet = 0; int result = TCL_OK; /* Result code for 'close' */ Tcl_Obj *resObj; /* Result data for 'close' */ ReflectedTransformMap *rtmPtr; /* Map of reflected transforms with handlers * in this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ if (TclInThreadExit()) { /* * This call comes from TclFinalizeIOSystem. There are no * interpreters, and therefore we cannot call upon the handler command * anymore. Threading is irrelevant as well. We simply clean up all * our C level data structures and leave the Tcl level to the other * finalization functions. */ /* * THREADED => Forward this to the origin thread * * Note: DeleteThreadReflectedTransformMap() is the thread exit handler * for the origin thread. Use this to clean up the structure? Except * if lost? */ #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p); result = p.base.code; if (result != TCL_OK) { FreeReceivedError(&p); } } #endif /* TCL_THREADS */ Tcl_EventuallyFree(rtPtr, FreeReflectedTransform); return EOK; } /* * In the reflected channel implementation a cleaned method mask here * implies that the channel creation was aborted, and "finalize" must not * be called. for transformations however we are not going through here on * such an abort, but directly through FreeReflectedTransform. So for us * that check is not necessary. We always go through 'finalize'. */ if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) { if (!TransformDrain(rtPtr, &errorCode)) { #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { Tcl_EventuallyFree(rtPtr, FreeReflectedTransform); return errorCode; } #endif /* TCL_THREADS */ errorCodeSet = 1; goto cleanup; } } if (HAS(rtPtr->methods, METH_FLUSH)) { if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) { #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { Tcl_EventuallyFree(rtPtr, FreeReflectedTransform); return errorCode; } #endif /* TCL_THREADS */ errorCodeSet = 1; goto cleanup; } } /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p); result = p.base.code; Tcl_EventuallyFree(rtPtr, FreeReflectedTransform); if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); return EINVAL; } return EOK; } #endif /* TCL_THREADS */ /* * Do the actual invocation of "finalize" now; we're in the right thread. */ result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj); if ((result != TCL_OK) && (interp != NULL)) { Tcl_SetChannelErrorInterp(interp, resObj); } Tcl_DecrRefCount(resObj); /* Remove reference we held from the * invoke. */ cleanup: /* * Remove the transform from the map before releasing the memory, to * prevent future accesses from finding and dereferencing a dangling * pointer. * * NOTE: The transform may not be in the map. This is ok, that happens * when the transform was created in a different interpreter and/or thread * and then was moved here. * * NOTE: The channel may have been removed from the map already via * the per-interp DeleteReflectedTransformMap exit-handler. */ if (!rtPtr->dead) { rtmPtr = GetReflectedTransformMap(rtPtr->interp); hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } /* * In a threaded interpreter we manage a per-thread map as well, * to allow us to survive if the script level pulls the rug out * under a channel by deleting the owning thread. */ #ifdef TCL_THREADS rtmPtr = GetThreadReflectedTransformMap(); hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } #endif /* TCL_THREADS */ } Tcl_EventuallyFree(rtPtr, FreeReflectedTransform); return errorCodeSet ? errorCode : ((result == TCL_OK) ? EOK : EINVAL); } static int ReflectClose2( ClientData clientData, Tcl_Interp *interp, int flags) { if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return ReflectClose(clientData, interp); } return EINVAL; } /* *---------------------------------------------------------------------- * * ReflectInput -- * * This function is invoked when more data is requested from the channel. * * Results: * The number of bytes read. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectInput( ClientData clientData, char *buf, int toRead, int *errorCodePtr) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; int gotBytes, copied, readBytes; Tcl_Obj *bufObj; /* * The following check can be done before thread redirection, because we * are reading from an item which is readonly, i.e. will never change * during the lifetime of the channel. */ if (!(rtPtr->methods & FLAG(METH_READ))) { SetChannelErrorStr(rtPtr->chan, msg_read_unsup); *errorCodePtr = EINVAL; return -1; } Tcl_Preserve(rtPtr); /* TODO: Consider a more appropriate buffer size. */ bufObj = Tcl_NewByteArrayObj(NULL, toRead); Tcl_IncrRefCount(bufObj); gotBytes = 0; if (rtPtr->eofPending) { goto stop; } rtPtr->readIsDrained = 0; while (toRead > 0) { /* * Loop until the request is satisfied (or no data available from * below, possibly EOF). */ copied = ResultCopy(&rtPtr->result, UCHARP(buf), toRead); toRead -= copied; buf += copied; gotBytes += copied; if (toRead == 0) { goto stop; } if (rtPtr->eofPending) { goto stop; } /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then * transform them for delivery. We may not get what we want (full EOF * or temporarily out of data). * * Length (rtPtr->result) == 0, toRead > 0 here. Use 'buf'! as target * to store the intermediary information read from the parent channel. * * Ask the transform how much data it allows us to read from the * underlying channel. This feature allows the transform to signal EOF * upstream although there is none downstream. Useful to control an * unbounded 'fcopy' for example, either through counting bytes, or by * pattern matching. */ if ((rtPtr->methods & FLAG(METH_LIMIT))) { int maxRead = -1; if (!TransformLimit(rtPtr, errorCodePtr, &maxRead)) { goto error; } if (maxRead == 0) { goto stop; } else if (maxRead > 0) { if (maxRead < toRead) { toRead = maxRead; } } /* else: 'maxRead < 0' == Accept the current value of toRead */ } if (toRead <= 0) { goto stop; } readBytes = Tcl_ReadRaw(rtPtr->parent, (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) { /* * Down channel is blocked and offers zero additional bytes. * The nonzero gotBytes already returned makes the total * operation a valid short read. Return to caller. */ goto stop; } /* * Either the down channel is not blocked (a real error) * or it is and there are gotBytes==0 byte copied so far. * In either case, pass up the error, so we either report * any real error, or do not mistakenly signal EOF by * returning 0 to the caller. */ *errorCodePtr = Tcl_GetErrno(); goto error; } if (readBytes == 0) { /* * Zero returned from Tcl_ReadRaw() always indicates EOF * on the down channel. */ rtPtr->eofPending = 1; /* * Now this is a bit different. The partial data waiting is * converted and returned. */ if (HAS(rtPtr->methods, METH_DRAIN)) { if (!TransformDrain(rtPtr, errorCodePtr)) { goto error; } } if (ResultLength(&rtPtr->result) == 0) { /* * The drain delivered nothing. */ goto stop; } continue; /* at: while (toRead > 0) */ } /* readBytes == 0 */ /* * Transform the read chunk, which was not empty. Anything we got back * is a transformation result is put into our buffers, and the next * iteration will put it into the result. */ Tcl_SetByteArrayLength(bufObj, readBytes); if (!TransformRead(rtPtr, errorCodePtr, bufObj)) { goto error; } if (Tcl_IsShared(bufObj)) { Tcl_DecrRefCount(bufObj); TclNewObj(bufObj); Tcl_IncrRefCount(bufObj); } Tcl_SetByteArrayLength(bufObj, 0); } /* while toRead > 0 */ stop: if (gotBytes == 0) { rtPtr->eofPending = 0; } Tcl_DecrRefCount(bufObj); Tcl_Release(rtPtr); return gotBytes; error: gotBytes = -1; goto stop; } /* *---------------------------------------------------------------------- * * ReflectOutput -- * * This function is invoked when data is written to the channel. * * Results: * The number of bytes actually written. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectOutput( ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * The following check can be done before thread redirection, because we * are reading from an item which is readonly, i.e. will never change * during the lifetime of the channel. */ if (!(rtPtr->methods & FLAG(METH_WRITE))) { SetChannelErrorStr(rtPtr->chan, msg_write_unsup); *errorCodePtr = EINVAL; return -1; } if (toWrite == 0) { /* * Nothing came in to write, ignore the call */ return 0; } /* * Discard partial data in the input buffers, i.e. on the read side. Like * we do when explicitly seeking as well. */ Tcl_Preserve(rtPtr); if ((rtPtr->methods & FLAG(METH_CLEAR))) { TransformClear(rtPtr); } /* * Hand the data to the transformation itself. Anything it deigned to * return to us is a (partial) transformation result and written to the * parent channel for further processing. */ if (!TransformWrite(rtPtr, errorCodePtr, UCHARP(buf), toWrite)) { Tcl_Release(rtPtr); return -1; } *errorCodePtr = EOK; Tcl_Release(rtPtr); return toWrite; } /* *---------------------------------------------------------------------- * * ReflectSeekWide / ReflectSeek -- * * This function is invoked when the user wishes to seek on the channel. * * Results: * The new location of the access point. * * Side effects: * Allocates memory. Arbitrary, per the parent channel, and the called * scripts. * *---------------------------------------------------------------------- */ static Tcl_WideInt ReflectSeekWide( ClientData clientData, Tcl_WideInt offset, int seekMode, int *errorCodePtr) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; Channel *parent = (Channel *) rtPtr->parent; Tcl_WideInt curPos; /* Position on the device. */ Tcl_DriverSeekProc *seekProc = Tcl_ChannelSeekProc(Tcl_GetChannelType(rtPtr->parent)); /* * Fail if the parent channel is not seekable. */ if (seekProc == NULL) { Tcl_SetErrno(EINVAL); return Tcl_LongAsWide(-1); } /* * Check if we can leave out involving the Tcl level, i.e. transformation * handler. This is true for tell requests, and transformations which * support neither flush, nor drain. For these cases we can pass the * request down and the result back up unchanged. */ Tcl_Preserve(rtPtr); if (((seekMode != SEEK_CUR) || (offset != 0)) && (HAS(rtPtr->methods, METH_CLEAR) || HAS(rtPtr->methods, METH_FLUSH))) { /* * Neither a tell request, nor clear/flush both not supported. We have * to go through the Tcl level to clear and/or flush the * transformation. */ if (rtPtr->methods & FLAG(METH_CLEAR)) { TransformClear(rtPtr); } /* * When flushing the transform for seeking the generated results are * irrelevant. We cannot put them into the channel, this would move * the location, throwing it off with regard to where we are and are * seeking to. */ if (HAS(rtPtr->methods, METH_FLUSH)) { if (!TransformFlush(rtPtr, errorCodePtr, FLUSH_DISCARD)) { Tcl_Release(rtPtr); return -1; } } } /* * Now seek to the new position in the channel as requested by the * caller. Note that we prefer the wideSeekProc if that is available and * non-NULL... */ if (Tcl_ChannelWideSeekProc(parent->typePtr) != NULL) { curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset, seekMode, errorCodePtr); } else if (offset < Tcl_LongAsWide(LONG_MIN) || offset > Tcl_LongAsWide(LONG_MAX)) { *errorCodePtr = EOVERFLOW; curPos = Tcl_LongAsWide(-1); } else { curPos = Tcl_LongAsWide(Tcl_ChannelSeekProc(parent->typePtr)( parent->instanceData, Tcl_WideAsLong(offset), seekMode, errorCodePtr)); } if (curPos == -1) { Tcl_SetErrno(*errorCodePtr); } *errorCodePtr = EOK; Tcl_Release(rtPtr); return curPos; } static int ReflectSeek( ClientData clientData, long offset, int seekMode, int *errorCodePtr) { /* * This function can be invoked from a transformation which is based on * standard seeking, i.e. non-wide. Because of this we have to implement * it, a dummy is not enough. We simply delegate the call to the wide * routine. */ return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode, errorCodePtr); } /* *---------------------------------------------------------------------- * * ReflectWatch -- * * This function is invoked to tell the channel what events the I/O * system is interested in. * * Results: * None. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static void ReflectWatch( ClientData clientData, int mask) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; Tcl_DriverWatchProc *watchProc; watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(rtPtr->parent)); watchProc(Tcl_GetChannelInstanceData(rtPtr->parent), mask); /* * Management of the internal timer. */ if (!(mask & TCL_READABLE) || (ResultLength(&rtPtr->result) == 0)) { /* * A pending timer may exist, but either is there no (more) interest * in the events it generates or nothing is available for reading. * Remove it, if existing. */ TimerKill(rtPtr); } else { /* * There might be no pending timer, but there is interest in readable * events and we actually have data waiting, so generate a timer to * flush that if it does not exist. */ TimerSetup(rtPtr); } } /* *---------------------------------------------------------------------- * * ReflectBlock -- * * This function is invoked to tell the channel which blocking behaviour * is required of it. * * Results: * A Posix error number. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectBlock( ClientData clientData, int nonblocking) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * Transformations simply record the blocking mode in their C level * structure for use by --> ReflectInput. The Tcl level doesn't see this * information or change. As such thread forwarding is not required. */ rtPtr->nonblocking = nonblocking; return EOK; } /* *---------------------------------------------------------------------- * * ReflectSetOption -- * * This function is invoked to configure a channel option. * * Results: * A standard Tcl result code. * * Side effects: * Arbitrary, per the parent channel. * *---------------------------------------------------------------------- */ static int ReflectSetOption( ClientData clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * Transformations have no options. Thus the call is passed down unchanged * to the parent channel for processing. Its results are passed back * unchanged as well. This all happens in the thread we are in. As the Tcl * level is not involved there is no need for thread forwarding. */ Tcl_DriverSetOptionProc *setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(rtPtr->parent)); if (setOptionProc == NULL) { return TCL_ERROR; } return setOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent), interp, optionName, newValue); } /* *---------------------------------------------------------------------- * * ReflectGetOption -- * * This function is invoked to retrieve all or a channel options. * * Results: * A standard Tcl result code. * * Side effects: * Arbitrary, per the parent channel. * *---------------------------------------------------------------------- */ static int ReflectGetOption( ClientData clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ Tcl_DString *dsPtr) /* String to place the result into */ { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * Transformations have no options. Thus the call is passed down unchanged * to the parent channel for processing. Its results are passed back * unchanged as well. This all happens in the thread we are in. As the Tcl * level is not involved there is no need for thread forwarding. * * Note that the parent not having a driver for option retrieval is not an * immediate error. A query for all options is ok. Only a request for a * specific option has to fail. */ Tcl_DriverGetOptionProc *getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(rtPtr->parent)); if (getOptionProc != NULL) { return getOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent), interp, optionName, dsPtr); } else if (optionName == NULL) { return TCL_OK; } else { return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * ReflectHandle -- * * This function is invoked to retrieve the associated file handle. * * Results: * A standard Tcl result code. * * Side effects: * Arbitrary, per the parent channel. * *---------------------------------------------------------------------- */ static int ReflectHandle( ClientData clientData, int direction, ClientData *handlePtr) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * Transformations have no handle of their own. As such we simply query * the parent channel for it. This way the query will ripple down through * all transformations until reaches the base channel. Which then returns * its handle, or fails. The former will then ripple up the stack. * * This all happens in the thread we are in. As the Tcl level is not * involved no forwarding is required. */ return Tcl_GetChannelHandle(rtPtr->parent, direction, handlePtr); } /* *---------------------------------------------------------------------- * * ReflectNotify -- * * This function is invoked to reported incoming events. * * Results: * A standard Tcl result code. * * Side effects: * Arbitrary, per the parent channel. * *---------------------------------------------------------------------- */ static int ReflectNotify( ClientData clientData, int mask) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * An event occurred in the underlying channel. * * We delete our timer. It was not fired, yet we are here, so the channel * below generated such an event and we don't have to. The renewal of the * interest after the execution of channel handlers will eventually cause * us to recreate the timer (in ReflectWatch). */ TimerKill(rtPtr); /* * Pass to higher layers. */ return mask; } /* * Helpers. ========================================================= */ /* *---------------------------------------------------------------------- * * DecodeEventMask -- * * This function takes an internal bitmask of events and constructs the * equivalent list of event items. * * Results: * A Tcl_Obj reference. The object will have a refCount of one. The user * has to decrement it to release the object. * * Side effects: * None. * *---------------------------------------------------------------------- * DUPLICATE of 'DecodeEventMask' in tclIORChan.c */ static Tcl_Obj * DecodeEventMask( int mask) { const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { case RANDW: eventStr = "read write"; break; case TCL_READABLE: eventStr = "read"; break; case TCL_WRITABLE: eventStr = "write"; break; default: eventStr = ""; break; } evObj = Tcl_NewStringObj(eventStr, -1); Tcl_IncrRefCount(evObj); return evObj; } /* *---------------------------------------------------------------------- * * NewReflectedTransform -- * * This function is invoked to allocate and initialize the instance data * of a new reflected channel. * * Results: * A heap-allocated channel instance. * * Side effects: * Allocates memory. * *---------------------------------------------------------------------- */ static ReflectedTransform * NewReflectedTransform( Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj, Tcl_Channel parentChan) { ReflectedTransform *rtPtr; int listc; Tcl_Obj **listv; int i; (void)mode; rtPtr = (ReflectedTransform *)ckalloc(sizeof(ReflectedTransform)); /* rtPtr->chan: Assigned by caller. Dummy data here. */ /* rtPtr->methods: Assigned by caller. Dummy data here. */ rtPtr->chan = NULL; rtPtr->methods = 0; #ifdef TCL_THREADS rtPtr->thread = Tcl_GetCurrentThread(); #endif rtPtr->parent = parentChan; rtPtr->interp = interp; rtPtr->handle = handleObj; Tcl_IncrRefCount(handleObj); rtPtr->timer = NULL; rtPtr->mode = 0; rtPtr->readIsDrained = 0; rtPtr->eofPending = 0; rtPtr->nonblocking = (((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING); rtPtr->dead = 0; /* * Query parent for current blocking mode. */ ResultInit(&rtPtr->result); /* * Method placeholder. */ /* ASSERT: cmdpfxObj is a Tcl List */ TclListObjGetElements(interp, cmdpfxObj, &listc, &listv); /* * See [==] as well. * Storage for the command prefix and the additional words required for * the invocation of methods in the command handler. * * listv [0] [listc-1] | [listc] [listc+1] | * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] * cmd ... pfx | method chan | detail1 detail2 */ rtPtr->argc = listc + 2; rtPtr->argv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (listc+4)); /* * Duplicate object references. */ for (i=0; iargv[i] = listv[i]; Tcl_IncrRefCount(word); } i++; /* Skip placeholder for method */ /* * See [x] in FreeReflectedTransform for release */ rtPtr->argv[i] = handleObj; Tcl_IncrRefCount(handleObj); /* * The next two objects are kept empty, varying arguments. */ /* * Initialization complete. */ return rtPtr; } /* *---------------------------------------------------------------------- * * NextHandle -- * * This function is invoked to generate a channel handle for a new * reflected channel. * * Results: * A Tcl_Obj containing the string of the new channel handle. The * refcount of the returned object is -- zero --. * * Side effects: * May allocate memory. Mutex protected critical section locks out other * threads for a short time. * *---------------------------------------------------------------------- */ static Tcl_Obj * NextHandle(void) { /* * Count number of generated reflected channels. Used for id generation. * Ids are never reclaimed and there is no dealing with wrap around. On * the other hand, "unsigned long" should be big enough except for * absolute longrunners (generate a 100 ids per second => overflow will * occur in 1 1/3 years). */ TCL_DECLARE_MUTEX(rtCounterMutex) static unsigned long rtCounter = 0; Tcl_Obj *resObj; Tcl_MutexLock(&rtCounterMutex); resObj = Tcl_ObjPrintf("rt%lu", rtCounter); rtCounter++; Tcl_MutexUnlock(&rtCounterMutex); return resObj; } static void FreeReflectedTransformArgs( ReflectedTransform *rtPtr) { int i, n = rtPtr->argc - 2; if (n < 0) { return; } Tcl_DecrRefCount(rtPtr->handle); rtPtr->handle = NULL; for (i=0; iargv[i]); } /* * See [x] in NewReflectedTransform for lock * n+1 = argc-1. */ Tcl_DecrRefCount(rtPtr->argv[n+1]); rtPtr->argc = 1; } static void FreeReflectedTransform( char *blockPtr) { ReflectedTransform *rtPtr = (ReflectedTransform *) blockPtr; TimerKill(rtPtr); ResultClear(&rtPtr->result); FreeReflectedTransformArgs(rtPtr); ckfree(rtPtr->argv); ckfree(rtPtr); } /* *---------------------------------------------------------------------- * * InvokeTclMethod -- * * This function is used to invoke the Tcl level of a reflected channel. * It handles all the command assembly, invocation, and generic state and * result mgmt. It does *not* handle thread redirection; that is the * responsibility of clients of this function. * * Results: * Result code and data as returned by the method. * * Side effects: * Arbitrary, as it calls upon a Tcl script. * * Contract: * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL * resObj.refCount in {0, 1, ...} * *---------------------------------------------------------------------- * Semi-DUPLICATE of 'InvokeTclMethod' in tclIORChan.c * - Semi because different structures are used. * - Still possible to factor out the commonalities into a separate structure. */ static int InvokeTclMethod( ReflectedTransform *rtPtr, const char *method, Tcl_Obj *argOneObj, /* NULL'able */ Tcl_Obj *argTwoObj, /* NULL'able */ Tcl_Obj **resultObjPtr) /* NULL'able */ { int cmdc; /* #words in constructed command */ Tcl_Obj *methObj = NULL; /* Method name in object form */ Tcl_InterpState sr; /* State of handler interp */ int result; /* Result code of method invocation */ Tcl_Obj *resObj = NULL; /* Result of method invocation. */ if (rtPtr->dead) { /* * The transform is marked as dead. Bail out immediately, with an * appropriate error. */ if (resultObjPtr != NULL) { resObj = Tcl_NewStringObj(msg_dstlost,-1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } return TCL_ERROR; } /* * NOTE (5): Decide impl. issue: Cache objects with method names? * Requires TSD data as reflections can be created in many different * threads. * NO: Caching of command resolutions means storage per channel. */ /* * Insert method into the preallocated area, after the command prefix, * before the channel id. */ methObj = Tcl_NewStringObj(method, -1); Tcl_IncrRefCount(methObj); rtPtr->argv[rtPtr->argc - 2] = methObj; /* * Append the additional argument containing method specific details * behind the channel id. If specified. * * Because of the contract there is no need to increment the refcounts. * The objects will survive the Tcl_EvalObjv without change. */ cmdc = rtPtr->argc; if (argOneObj) { rtPtr->argv[cmdc] = argOneObj; cmdc++; if (argTwoObj) { rtPtr->argv[cmdc] = argTwoObj; cmdc++; } } /* * And run the handler... This is done in a manner which leaves any * existing state intact. */ sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */); Tcl_Preserve(rtPtr); Tcl_Preserve(rtPtr->interp); result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL); /* * We do not try to extract the result information if the caller has no * interest in it. I.e. there is no need to put effort into creating * something which is discarded immediately after. */ if (resultObjPtr) { if (result == TCL_OK) { /* * Ok result taken as is, also if the caller requests that there * is no capture. */ resObj = Tcl_GetObjResult(rtPtr->interp); } else { /* * Non-ok result is always treated as an error. We have to capture * the full state of the result, including additional options. * * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv); int cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rtPtr->interp); Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf( "chan handler returned bad code: %d", result)); Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(cmd); result = TCL_ERROR; } Tcl_AppendObjToErrorInfo(rtPtr->interp, Tcl_ObjPrintf( "\n (chan handler subcommand \"%s\")", method)); resObj = MarshallError(rtPtr->interp); } Tcl_IncrRefCount(resObj); } Tcl_RestoreInterpState(rtPtr->interp, sr); Tcl_Release(rtPtr->interp); Tcl_Release(rtPtr); /* * Cleanup of the dynamic parts of the command. * * The detail objects survived the Tcl_EvalObjv without change because of * the contract. Therefore there is no need to decrement the refcounts. Only * the internal method object has to be disposed of. */ Tcl_DecrRefCount(methObj); /* * The resObj has a ref count of 1 at this location. This means that the * caller of InvokeTclMethod has to dispose of it (but only if it was * returned to it). */ if (resultObjPtr != NULL) { *resultObjPtr = resObj; } /* * There no need to handle the case where nothing is returned, because for * that case resObj was not set anyway. */ return result; } /* *---------------------------------------------------------------------- * * GetReflectedTransformMap -- * * Gets and potentially initializes the reflected channel map for an * interpreter. * * Results: * A pointer to the map created, for use by the caller. * * Side effects: * Initializes the reflected channel map for an interpreter. * *---------------------------------------------------------------------- */ static ReflectedTransformMap * GetReflectedTransformMap( Tcl_Interp *interp) { ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL); if (rtmPtr == NULL) { rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RTMKEY, (Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr); } return rtmPtr; } /* *---------------------------------------------------------------------- * * DeleteReflectedTransformMap -- * * Deletes the channel table for an interpreter, closing any open * channels whose refcount reaches zero. This procedure is invoked when * an interpreter is deleted, via the AssocData cleanup mechanism. * * Results: * None. * * Side effects: * Deletes the hash table of channels. May close channels. May flush * output on closed channels. Removes any channeEvent handlers that were * registered in this interpreter. * *---------------------------------------------------------------------- */ static void DeleteReflectedTransformMap( ClientData clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedTransformMap *rtmPtr; /* The map */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ ReflectedTransform *rtPtr; #ifdef TCL_THREADS ForwardingResult *resultPtr; ForwardingEvent *evPtr; ForwardParam *paramPtr; #endif /* TCL_THREADS */ /* * Delete all entries. The channels may have been closed already, or will * be closed later, by the standard IO finalization of an interpreter * under destruction. Except for the channels which were moved to a * different interpreter and/or thread. They do not exist from the IO * systems point of view and will not get closed. Therefore mark all as * dead so that any future access will cause a proper error. For channels * in a different thread we actually do the same as * DeleteThreadReflectedTransformMap(), just restricted to the channels of * this interp. */ rtmPtr = (ReflectedTransformMap *)clientData; for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) { rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr); rtPtr->dead = 1; Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rtmPtr->map); ckfree(&rtmPtr->map); #ifdef TCL_THREADS /* * The origin interpreter for one or more reflected channels is gone. */ /* * Get the map of all channels handled by the current thread. This is a * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go * through the channels and remove all which were handled by this * interpreter. They have already been marked as dead. */ rtmPtr = GetThreadReflectedTransformMap(); for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr); if (rtPtr->interp != interp) { /* * Ignore entries for other interpreters. */ continue; } rtPtr->dead = 1; FreeReflectedTransformArgs(rtPtr); Tcl_DeleteHashEntry(hPtr); } /* * Go through the list of pending results and cancel all whose events were * destined for this interpreter. While this is in progress we block any * other access to the list of pending results. */ Tcl_MutexLock(&rtForwardMutex); for (resultPtr = forwardList; resultPtr != NULL; resultPtr = resultPtr->nextPtr) { if (resultPtr->dsti != interp) { /* * Ignore results/events for other interpreters. */ continue; } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. */ evPtr = resultPtr->evPtr; if (evPtr == NULL) { continue; } paramPtr = evPtr->param; evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; resultPtr->result = TCL_ERROR; ForwardSetStaticError(paramPtr, msg_send_dstlost); Tcl_ConditionNotify(&resultPtr->done); } Tcl_MutexUnlock(&rtForwardMutex); #endif /* TCL_THREADS */ } #ifdef TCL_THREADS /* *---------------------------------------------------------------------- * * GetThreadReflectedTransformMap -- * * Gets and potentially initializes the reflected channel map for a * thread. * * Results: * A pointer to the map created, for use by the caller. * * Side effects: * Initializes the reflected channel map for a thread. * *---------------------------------------------------------------------- */ static ReflectedTransformMap * GetThreadReflectedTransformMap(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rtmPtr) { tsdPtr->rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL); } return tsdPtr->rtmPtr; } /* *---------------------------------------------------------------------- * * DeleteThreadReflectedTransformMap -- * * Deletes the channel table for a thread. This procedure is invoked when * a thread is deleted. The channels have already been marked as dead, in * DeleteReflectedTransformMap(). * * Results: * None. * * Side effects: * Deletes the hash table of channels. * *---------------------------------------------------------------------- */ static void DeleteThreadReflectedTransformMap( ClientData dummy) /* The per-thread data structure. */ { Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ Tcl_ThreadId self = Tcl_GetCurrentThread(); ReflectedTransformMap *rtmPtr; /* The map */ ForwardingResult *resultPtr; (void)dummy; /* * The origin thread for one or more reflected channels is gone. * NOTE: If this function is called due to a thread getting killed the * per-interp DeleteReflectedTransformMap is apparently not called. */ /* * Get the map of all channels handled by the current thread. This is a * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go * through the channels, remove all, mark them as dead. */ rtmPtr = GetThreadReflectedTransformMap(); for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) { ReflectedTransform *rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr); rtPtr->dead = 1; FreeReflectedTransformArgs(rtPtr); Tcl_DeleteHashEntry(hPtr); } ckfree(rtmPtr); /* * Go through the list of pending results and cancel all whose events were * destined for this thread. While this is in progress we block any * other access to the list of pending results. */ Tcl_MutexLock(&rtForwardMutex); for (resultPtr = forwardList; resultPtr != NULL; resultPtr = resultPtr->nextPtr) { ForwardingEvent *evPtr; ForwardParam *paramPtr; if (resultPtr->dst != self) { /* * Ignore results/events for other threads. */ continue; } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. */ evPtr = resultPtr->evPtr; if (evPtr == NULL) { continue; } paramPtr = evPtr->param; evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; resultPtr->result = TCL_ERROR; ForwardSetStaticError(paramPtr, msg_send_dstlost); Tcl_ConditionNotify(&resultPtr->done); } Tcl_MutexUnlock(&rtForwardMutex); } static void ForwardOpToOwnerThread( ReflectedTransform *rtPtr, /* Channel instance */ ForwardedOperation op, /* Forwarded driver operation */ const void *param) /* Arguments */ { Tcl_ThreadId dst = rtPtr->thread; ForwardingEvent *evPtr; ForwardingResult *resultPtr; /* * We gather the lock early. This allows us to check the liveness of the * channel without interference from DeleteThreadReflectedTransformMap(). */ Tcl_MutexLock(&rtForwardMutex); if (rtPtr->dead) { /* * The channel is marked as dead. Bail out immediately, with an * appropriate error. Do not forget to unlock the mutex on this path. */ ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost); Tcl_MutexUnlock(&rtForwardMutex); return; } /* * Create and initialize the event and data structures. */ evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent)); resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; evPtr->op = op; evPtr->rtPtr = rtPtr; evPtr->param = (ForwardParam *) param; resultPtr->src = Tcl_GetCurrentThread(); resultPtr->dst = dst; resultPtr->dsti = rtPtr->interp; resultPtr->done = NULL; resultPtr->result = -1; resultPtr->evPtr = evPtr; /* * Now execute the forward. */ TclSpliceIn(resultPtr, forwardList); /* Do not unlock here. That is done by the ConditionWait */ /* * Ensure cleanup of the event if the origin thread exits while this event * is pending or in progress. Exit of the destination thread is handled by * DeleteThreadReflectionChannelMap(), this is set up by * GetThreadReflectedTransformMap(). This is what we use the 'forwardList' * (see above) for. */ Tcl_CreateThreadExitHandler(SrcExitProc, evPtr); /* * Queue the event and poke the other thread's notifier. */ Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL); Tcl_ThreadAlert(dst); /* * (*) Block until the other thread has either processed the transfer or * rejected it. */ while (resultPtr->result < 0) { /* * NOTE (1): Is it possible that the current thread goes away while * waiting here? IOW Is it possible that "SrcExitProc" is called * while we are here? See complementary note (2) in "SrcExitProc" * * The ConditionWait unlocks the mutex during the wait and relocks it * immediately after. */ Tcl_ConditionWait(&resultPtr->done, &rtForwardMutex, NULL); } /* * Unlink result from the forwarder list. No need to lock. Either still * locked, or locked by the ConditionWait */ TclSpliceOut(resultPtr, forwardList); resultPtr->nextPtr = NULL; resultPtr->prevPtr = NULL; Tcl_MutexUnlock(&rtForwardMutex); Tcl_ConditionFinalize(&resultPtr->done); /* * Kill the cleanup handler now, and the result structure as well, before * returning the success code. * * Note: The event structure has already been deleted by the destination * notifier, after it serviced the event. */ Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); ckfree(resultPtr); } static int ForwardProc( Tcl_Event *evGPtr, int mask) { /* * Notes regarding access to the referenced data. * * In principle the data belongs to the originating thread (see * evPtr->src), however this thread is currently blocked at (*), i.e. * quiescent. Because of this we can treat the data as belonging to us, * without fear of race conditions. I.e. we can read and write as we like. * * The only thing we cannot be sure of is the resultPtr. This can be be * NULLed if the originating thread went away while the event is handled * here now. */ ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr; ForwardingResult *resultPtr = evPtr->resultPtr; ReflectedTransform *rtPtr = evPtr->rtPtr; Tcl_Interp *interp = rtPtr->interp; ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ ReflectedTransformMap *rtmPtr; /* Map of reflected channels with handlers in * this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ (void)mask; /* * Ignore the event if no one is waiting for its result anymore. */ if (!resultPtr) { return 1; } paramPtr->base.code = TCL_OK; paramPtr->base.msgStr = NULL; paramPtr->base.mustFree = 0; switch (evPtr->op) { /* * The destination thread for the following operations is * rtPtr->thread, which contains rtPtr->interp, the interp we have to * call upon for the driver. */ case ForwardedClose: /* * No parameters/results. */ if (InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } /* * Freeing is done here, in the origin thread, because the argv[] * objects belong to this thread. Deallocating them in a different * thread is not allowed */ /* * Remove the channel from the map before releasing the memory, to * prevent future accesses (like by 'postevent') from finding and * dereferencing a dangling pointer. */ rtmPtr = GetReflectedTransformMap(interp); hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); Tcl_DeleteHashEntry(hPtr); /* * In a threaded interpreter we manage a per-thread map as well, to * allow us to survive if the script level pulls the rug out under a * channel by deleting the owning thread. */ rtmPtr = GetThreadReflectedTransformMap(); hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); Tcl_DeleteHashEntry(hPtr); FreeReflectedTransformArgs(rtPtr); break; case ForwardedInput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->transform.buf, paramPtr->transform.size); Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); paramPtr->transform.size = -1; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { paramPtr->transform.buf = (char *)ckalloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; } } Tcl_DecrRefCount(bufObj); break; } case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->transform.buf, paramPtr->transform.size); Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); paramPtr->transform.size = -1; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { paramPtr->transform.buf = (char *)ckalloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; } } Tcl_DecrRefCount(bufObj); break; } case ForwardedDrain: if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); paramPtr->transform.size = -1; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { paramPtr->transform.buf = (char *)ckalloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; } } break; case ForwardedFlush: if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); paramPtr->transform.size = -1; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { paramPtr->transform.buf = (char *)ckalloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; } } break; case ForwardedClear: (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL); break; case ForwardedLimit: if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); paramPtr->limit.max = -1; } else if (Tcl_GetIntFromObj(interp, resObj, ¶mPtr->limit.max) != TCL_OK) { ForwardSetObjError(paramPtr, MarshallError(interp)); paramPtr->limit.max = -1; } break; default: /* * Bad operation code. */ Tcl_Panic("Bad operation code in ForwardProc"); break; } /* * Remove the reference we held on the result of the invoke, if we had * such. */ if (resObj != NULL) { Tcl_DecrRefCount(resObj); } if (resultPtr) { /* * Report the forwarding result synchronously to the waiting caller. * This unblocks (*) as well. This is wrapped into a conditional * because the caller may have exited in the mean time. */ Tcl_MutexLock(&rtForwardMutex); resultPtr->result = TCL_OK; Tcl_ConditionNotify(&resultPtr->done); Tcl_MutexUnlock(&rtForwardMutex); } return 1; } static void SrcExitProc( ClientData clientData) { ForwardingEvent *evPtr = (ForwardingEvent *)clientData; ForwardingResult *resultPtr; ForwardParam *paramPtr; /* * NOTE (2): Can this handler be called with the originator blocked? */ /* * The originator for the event exited. It is not sure if this can happen, * as the originator should be blocked at (*) while the event is in * transit/pending. * * We make sure that the event cannot refer to the result anymore, remove * it from the list of pending results and free the structure. Locking the * access ensures that we cannot get in conflict with "ForwardProc", * should it already execute the event. */ Tcl_MutexLock(&rtForwardMutex); resultPtr = evPtr->resultPtr; paramPtr = evPtr->param; evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; resultPtr->result = TCL_ERROR; ForwardSetStaticError(paramPtr, msg_send_originlost); /* * See below: TclSpliceOut(resultPtr, forwardList); */ Tcl_MutexUnlock(&rtForwardMutex); /* * This unlocks (*). The structure will be spliced out and freed by * "ForwardProc". Maybe. */ Tcl_ConditionNotify(&resultPtr->done); } static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { int len; const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; ForwardSetDynamicError(paramPtr, ckalloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif /* TCL_THREADS */ /* *---------------------------------------------------------------------- * * TimerKill -- * * Timer management. Removes the internal timer if it exists. * * Side effects: * See above. * * Result: * None. * *---------------------------------------------------------------------- */ static void TimerKill( ReflectedTransform *rtPtr) { if (rtPtr->timer == NULL) { return; } /* * Delete an existing flush-out timer, prevent it from firing on a * removed/dead channel. */ Tcl_DeleteTimerHandler(rtPtr->timer); rtPtr->timer = NULL; } /* *---------------------------------------------------------------------- * * TimerSetup -- * * Timer management. Creates the internal timer if it does not exist. * * Side effects: * See above. * * Result: * None. * *---------------------------------------------------------------------- */ static void TimerSetup( ReflectedTransform *rtPtr) { if (rtPtr->timer != NULL) { return; } rtPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, TimerRun, rtPtr); } /* *---------------------------------------------------------------------- * * TimerRun -- * * Called by the notifier (-> timer) to flush out information waiting in * channel buffers. * * Side effects: * As of 'Tcl_NotifyChannel'. * * Result: * None. * *---------------------------------------------------------------------- */ static void TimerRun( ClientData clientData) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; rtPtr->timer = NULL; Tcl_NotifyChannel(rtPtr->chan, TCL_READABLE); } /* *---------------------------------------------------------------------- * * ResultInit -- * * Initializes the specified buffer structure. The structure will contain * valid information for an empty buffer. * * Side effects: * See above. * * Result: * None. * *---------------------------------------------------------------------- */ static inline void ResultInit( ResultBuffer *rPtr) /* Reference to the structure to * initialize. */ { rPtr->used = 0; rPtr->allocated = 0; rPtr->buf = NULL; } /* *---------------------------------------------------------------------- * * ResultClear -- * * Deallocates any memory allocated by 'ResultAdd'. * * Side effects: * See above. * * Result: * None. * *---------------------------------------------------------------------- */ static inline void ResultClear( ResultBuffer *rPtr) /* Reference to the buffer to clear out */ { rPtr->used = 0; if (!rPtr->allocated) { return; } ckfree((char *) rPtr->buf); rPtr->buf = NULL; rPtr->allocated = 0; } /* *---------------------------------------------------------------------- * * ResultAdd -- * * Adds the bytes in the specified array to the buffer, by appending it. * * Side effects: * See above. * * Result: * None. * *---------------------------------------------------------------------- */ static inline void ResultAdd( ResultBuffer *rPtr, /* The buffer to extend */ unsigned char *buf, /* The buffer to read from */ size_t toWrite) /* The number of bytes in 'buf' */ { if ((rPtr->used + toWrite + 1) > rPtr->allocated) { /* * Extension of the internal buffer is required. * NOTE: Currently linear. Should be doubling to amortize. */ if (rPtr->allocated == 0) { rPtr->allocated = toWrite + RB_INCREMENT; rPtr->buf = UCHARP(ckalloc(rPtr->allocated)); } else { rPtr->allocated += toWrite + RB_INCREMENT; rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf, rPtr->allocated)); } } /* * Now copy data. */ memcpy(rPtr->buf + rPtr->used, buf, toWrite); rPtr->used += toWrite; } /* *---------------------------------------------------------------------- * * ResultCopy -- * * Copies the requested number of bytes from the buffer into the * specified array and removes them from the buffer afterward. Copies * less if there is not enough data in the buffer. * * Side effects: * See above. * * Result: * The number of actually copied bytes, possibly less than 'toRead'. * *---------------------------------------------------------------------- */ static inline size_t ResultCopy( ResultBuffer *rPtr, /* The buffer to read from */ unsigned char *buf, /* The buffer to copy into */ size_t toRead) /* Number of requested bytes */ { int copied; if (rPtr->used == 0) { /* * Nothing to copy in the case of an empty buffer. */ copied = 0; } else if (rPtr->used == toRead) { /* * We have just enough. Copy everything to the caller. */ memcpy(buf, rPtr->buf, toRead); rPtr->used = 0; copied = toRead; } else if (rPtr->used > toRead) { /* * The internal buffer contains more than requested. Copy the * requested subset to the caller, and shift the remaining bytes down. */ memcpy(buf, rPtr->buf, toRead); memmove(rPtr->buf, rPtr->buf + toRead, rPtr->used - toRead); rPtr->used -= toRead; copied = toRead; } else { /* * There is not enough in the buffer to satisfy the caller, so take * everything. */ memcpy(buf, rPtr->buf, rPtr->used); toRead = rPtr->used; rPtr->used = 0; copied = toRead; } /* -- common postwork code ------- */ return copied; } static int TransformRead( ReflectedTransform *rtPtr, int *errorCodePtr, Tcl_Obj *bufObj) { Tcl_Obj *resObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj, &(p.transform.size)); ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { PassReceivedError(rtPtr->chan, &p); *errorCodePtr = EINVAL; return 0; } *errorCodePtr = EOK; ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size); ckfree(p.transform.buf); return 1; } #endif /* TCL_THREADS */ /* ASSERT: rtPtr->method & FLAG(METH_READ) */ /* ASSERT: rtPtr->mode & TCL_READABLE */ if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 1; } static int TransformWrite( ReflectedTransform *rtPtr, int *errorCodePtr, unsigned char *buf, int toWrite) { Tcl_Obj *bufObj; Tcl_Obj *resObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.transform.buf = (char *) buf; p.transform.size = toWrite; ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p); if (p.base.code != TCL_OK) { PassReceivedError(rtPtr->chan, &p); *errorCodePtr = EINVAL; return 0; } *errorCodePtr = EOK; res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf, p.transform.size); ckfree(p.transform.buf); } else #endif /* TCL_THREADS */ { /* ASSERT: rtPtr->method & FLAG(METH_WRITE) */ /* ASSERT: rtPtr->mode & TCL_WRITABLE */ bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { *errorCodePtr = EINVAL; Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 0; } *errorCodePtr = EOK; bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } if (res < 0) { *errorCodePtr = Tcl_GetErrno(); return 0; } return 1; } static int TransformDrain( ReflectedTransform *rtPtr, int *errorCodePtr) { Tcl_Obj *resObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p); if (p.base.code != TCL_OK) { PassReceivedError(rtPtr->chan, &p); *errorCodePtr = EINVAL; return 0; } *errorCodePtr = EOK; ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size); ckfree(p.transform.buf); } else #endif /* TCL_THREADS */ { if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } rtPtr->readIsDrained = 1; return 1; } static int TransformFlush( ReflectedTransform *rtPtr, int *errorCodePtr, int op) { Tcl_Obj *resObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p); if (p.base.code != TCL_OK) { PassReceivedError(rtPtr->chan, &p); *errorCodePtr = EINVAL; return 0; } *errorCodePtr = EOK; if (op == FLUSH_WRITE) { res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf, p.transform.size); } else { res = 0; } ckfree(p.transform.buf); } else #endif /* TCL_THREADS */ { if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } if (op == FLUSH_WRITE) { bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); } else { res = 0; } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } if (res < 0) { *errorCodePtr = Tcl_GetErrno(); return 0; } return 1; } static void TransformClear( ReflectedTransform *rtPtr) { /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p); return; } #endif /* TCL_THREADS */ /* ASSERT: rtPtr->method & FLAG(METH_READ) */ /* ASSERT: rtPtr->mode & TCL_READABLE */ (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL); rtPtr->readIsDrained = 0; rtPtr->eofPending = 0; ResultClear(&rtPtr->result); } static int TransformLimit( ReflectedTransform *rtPtr, int *errorCodePtr, int *maxPtr) { Tcl_Obj *resObj; Tcl_InterpState sr; /* State of handler interp */ /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p); if (p.base.code != TCL_OK) { PassReceivedError(rtPtr->chan, &p); *errorCodePtr = EINVAL; return 0; } *errorCodePtr = EOK; *maxPtr = p.limit.max; return 1; } #endif /* ASSERT: rtPtr->method & FLAG(METH_WRITE) */ /* ASSERT: rtPtr->mode & TCL_WRITABLE */ if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */); if (Tcl_GetIntFromObj(rtPtr->interp, resObj, maxPtr) != TCL_OK) { Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_SetChannelError(rtPtr->chan, MarshallError(rtPtr->interp)); *errorCodePtr = EINVAL; Tcl_RestoreInterpState(rtPtr->interp, sr); return 0; } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_RestoreInterpState(rtPtr->interp, sr); return 1; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclIOSock.c0000644000175000017500000001660614554262142015265 0ustar sergeisergei/* * tclIOSock.c -- * * Common routines used by all socket based channel types. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #if defined(_WIN32) /* On Windows, we need to do proper Unicode->UTF-8 conversion. */ typedef struct ThreadSpecificData { int initialized; Tcl_DString errorMsg; /* UTF-8 encoded error-message */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #undef gai_strerror static const char *gai_strerror(int code) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->initialized) { Tcl_DStringFree(&tsdPtr->errorMsg); } else { tsdPtr->initialized = 1; } Tcl_WinTCharToUtf((TCHAR *)gai_strerrorW(code), -1, &tsdPtr->errorMsg); return Tcl_DStringValue(&tsdPtr->errorMsg); } #endif /* *--------------------------------------------------------------------------- * * TclSockGetPort -- * * Maps from a string, which could be a service name, to a port. Used by * socket creation code to get port numbers and resolve registered * service names to port numbers. * * Results: * A standard Tcl result. On success, the port number is returned in * portPtr. On failure, an error message is left in the interp's result. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TclSockGetPort( Tcl_Interp *interp, const char *string, /* Integer or service name */ const char *proto, /* "tcp" or "udp", typically */ int *portPtr) /* Return port number */ { struct servent *sp; /* Protocol info for named services */ Tcl_DString ds; const char *native; if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) { /* * Don't bother translating 'proto' to native. */ native = Tcl_UtfToExternalDString(NULL, string, -1, &ds); sp = getservbyname(native, proto); /* INTL: Native. */ Tcl_DStringFree(&ds); if (sp != NULL) { *portPtr = ntohs((unsigned short) sp->s_port); return TCL_OK; } } if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) { return TCL_ERROR; } if (*portPtr > 0xFFFF) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't open socket: port number too high", -1)); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclSockMinimumBuffers -- * * Ensure minimum buffer sizes (non zero). * * Results: * A standard Tcl result. * * Side effects: * Sets SO_SNDBUF and SO_RCVBUF sizes. * *---------------------------------------------------------------------- */ #if !defined(_WIN32) && !defined(__CYGWIN__) # define SOCKET int #endif int TclSockMinimumBuffers( void *sock, /* Socket file descriptor */ int size) /* Minimum buffer size */ { int current; socklen_t len; len = sizeof(int); getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF, (char *) ¤t, &len); if (current < size) { len = sizeof(int); setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF, (char *) &size, len); } len = sizeof(int); getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF, (char *) ¤t, &len); if (current < size) { len = sizeof(int); setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF, (char *) &size, len); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCreateSocketAddress -- * * This function initializes a sockaddr structure for a host and port. * * Results: * 1 if the host was valid, 0 if the host could not be converted to an IP * address. * * Side effects: * Fills in the *sockaddrPtr structure. * *---------------------------------------------------------------------- */ int TclCreateSocketAddress( Tcl_Interp *interp, /* Interpreter for querying * the desired socket family */ struct addrinfo **addrlist, /* Socket address list */ const char *host, /* Host. NULL implies INADDR_ANY */ int port, /* Port number */ int willBind, /* Is this an address to bind() to or * to connect() to? */ const char **errorMsgPtr) /* Place to store the error message * detail, if available. */ { struct addrinfo hints; struct addrinfo *p; struct addrinfo *v4head = NULL, *v4ptr = NULL; struct addrinfo *v6head = NULL, *v6ptr = NULL; char *native = NULL, portbuf[TCL_INTEGER_SPACE], *portstring; const char *family = NULL; Tcl_DString ds; int result; if (host != NULL) { native = Tcl_UtfToExternalDString(NULL, host, -1, &ds); } /* * Workaround for OSX's apparent inability to resolve "localhost", "0" * when the loopback device is the only available network interface. */ if (host != NULL && port == 0) { portstring = NULL; } else { TclFormatInt(portbuf, port); portstring = portbuf; } (void) memset(&hints, 0, sizeof(hints)); hints.ai_family = AF_UNSPEC; /* * Magic variable to enforce a certain address family - to be superseded * by a TIP that adds explicit switches to [socket] */ if (interp != NULL) { family = Tcl_GetVar(interp, "::tcl::unsupported::socketAF", 0); if (family != NULL) { if (strcmp(family, "inet") == 0) { hints.ai_family = AF_INET; } else if (strcmp(family, "inet6") == 0) { hints.ai_family = AF_INET6; } } } hints.ai_socktype = SOCK_STREAM; #if 0 /* * We found some problems when using AI_ADDRCONFIG, e.g. on systems that * have no networking besides the loopback interface and want to resolve * localhost. See [Bugs 3385024, 3382419, 3382431]. As the advantage of * using AI_ADDRCONFIG in situations where it works, is probably low, * we'll leave it out for now. After all, it is just an optimisation. * * Missing on: OpenBSD, NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ #if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux) hints.ai_flags |= AI_ADDRCONFIG; #endif /* AI_ADDRCONFIG && !_AIX && !__hpux */ #endif /* 0 */ if (willBind) { hints.ai_flags |= AI_PASSIVE; } result = getaddrinfo(native, portstring, &hints, addrlist); if (host != NULL) { Tcl_DStringFree(&ds); } if (result != 0) { *errorMsgPtr = #ifdef EAI_SYSTEM /* Doesn't exist on Windows */ (result == EAI_SYSTEM) ? Tcl_PosixError(interp) : #endif /* EAI_SYSTEM */ gai_strerror(result); return 0; } /* * Put IPv4 addresses before IPv6 addresses to maximize backwards * compatibility of [fconfigure -sockname] output. * * There might be more elegant/efficient ways to do this. */ if (willBind) { for (p = *addrlist; p != NULL; p = p->ai_next) { if (p->ai_family == AF_INET) { if (v4head == NULL) { v4head = p; } else { v4ptr->ai_next = p; } v4ptr = p; } else { if (v6head == NULL) { v6head = p; } else { v6ptr->ai_next = p; } v6ptr = p; } } *addrlist = NULL; if (v6head != NULL) { *addrlist = v6head; v6ptr->ai_next = NULL; } if (v4head != NULL) { v4ptr->ai_next = *addrlist; *addrlist = v4head; } } return 1; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclIOUtil.c0000644000175000017500000040416014554262142015277 0ustar sergeisergei/* * tclIOUtil.c -- * * This file contains the implementation of Tcl's generic filesystem * code, which supports a pluggable filesystem architecture allowing both * platform specific filesystems and 'virtual filesystems'. All * filesystem access should go through the functions defined in this * file. Most of this code was contributed by Vince Darley. * * Parts of this file are based on code contributed by Karl Lehenbauer, * Mark Diekhans and Peter da Silva. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 2001-2004 Vincent Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef _WIN32 # include "tclWinInt.h" #endif #include "tclFileSystem.h" #ifdef TCL_TEMPLOAD_NO_UNLINK #ifndef NO_FSTATFS #include #endif #endif /* * struct FilesystemRecord -- * * A filesystem record is used to keep track of each filesystem currently * registered with the core, in a linked list. */ typedef struct FilesystemRecord { ClientData clientData; /* Client specific data for the new filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; /* The next filesystem registered to Tcl, or * NULL if no more. */ struct FilesystemRecord *prevPtr; /* The previous filesystem registered to Tcl, * or NULL if no more. */ } FilesystemRecord; /* * This structure holds per-thread private copy of the current directory * maintained by the global cwdPathPtr. This structure holds per-thread * private copies of some global data. This way we avoid most of the * synchronization calls which boosts performance, at cost of having to update * this information each time the corresponding epoch counter changes. */ typedef struct ThreadSpecificData { int initialized; size_t cwdPathEpoch; size_t filesystemEpoch; Tcl_Obj *cwdPathPtr; ClientData cwdClientData; FilesystemRecord *filesystemList; size_t claims; } ThreadSpecificData; /* * Prototypes for functions defined later in this file. */ static Tcl_NRPostProc EvalFileCallback; static FilesystemRecord*FsGetFirstFilesystem(void); static void FsThrExitProc(ClientData cd); static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, const char *pattern); static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData); static void FsRecacheFilesystemList(void); static void Claim(void); static void Disclaim(void); static void * DivertFindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); static void DivertUnloadFile(Tcl_LoadHandle loadHandle); /* * These form part of the native filesystem support. They are needed here * because we have a few native filesystem functions (which are the same for * win/unix) in this file. There is no need to place them in tclInt.h, because * they are not (and should not be) used anywhere else. */ MODULE_SCOPE const char *const tclpFileAttrStrings[]; MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; /* * Declare the native filesystem support. These functions should be considered * private to Tcl, and should really not be called directly by any code other * than this file (i.e. neither by Tcl's core nor by extensions). Similarly, * the old string-based Tclp... native filesystem functions should not be * called. * * The correct API to use now is the Tcl_FS... set of functions, which ensure * correct and complete virtual filesystem support. * * We cannot make all of these static, since some of them are implemented in * the platform-specific directories. */ static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator; static Tcl_FSFreeInternalRepProc NativeFreeInternalRep; static Tcl_FSFileAttrStringsProc NativeFileAttrStrings; static Tcl_FSFileAttrsGetProc NativeFileAttrsGet; static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; /* * The only reason these functions are not static is that they are either * called by code in the native (win/unix) directories or they are actually * implemented in those directories. They should simply not be called by code * outside Tcl's native filesystem core i.e. they should be considered * 'static' to Tcl's filesystem code (if we ever built the native filesystem * support into a separate code library, this could actually be enforced). */ Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType; Tcl_FSInternalToNormalizedProc TclpNativeToNormalized; Tcl_FSStatProc TclpObjStat; Tcl_FSAccessProc TclpObjAccess; Tcl_FSMatchInDirectoryProc TclpMatchInDirectory; Tcl_FSChdirProc TclpObjChdir; Tcl_FSLstatProc TclpObjLstat; Tcl_FSCopyFileProc TclpObjCopyFile; Tcl_FSDeleteFileProc TclpObjDeleteFile; Tcl_FSRenameFileProc TclpObjRenameFile; Tcl_FSCreateDirectoryProc TclpObjCreateDirectory; Tcl_FSCopyDirectoryProc TclpObjCopyDirectory; Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory; Tcl_FSLinkProc TclpObjLink; Tcl_FSListVolumesProc TclpObjListVolumes; /* * Define the native filesystem dispatch table. If necessary, it is ok to make * this non-static, but it should only be accessed by the functions actually * listed within it (or perhaps other helper functions of them). Anything * which is not part of this 'native filesystem implementation' should not be * delving inside here! */ const Tcl_Filesystem tclNativeFilesystem = { "native", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_2, TclNativePathInFilesystem, TclNativeDupInternalRep, NativeFreeInternalRep, TclpNativeToNormalized, TclNativeCreateNativeRep, TclpObjNormalizePath, TclpFilesystemPathType, NativeFilesystemSeparator, TclpObjStat, TclpObjAccess, TclpOpenFileChannel, TclpMatchInDirectory, TclpUtime, #ifndef S_IFLNK NULL, #else TclpObjLink, #endif /* S_IFLNK */ TclpObjListVolumes, NativeFileAttrStrings, NativeFileAttrsGet, NativeFileAttrsSet, TclpObjCreateDirectory, TclpObjRemoveDirectory, TclpObjDeleteFile, TclpObjCopyFile, TclpObjRenameFile, TclpObjCopyDirectory, TclpObjLstat, /* Needs casts since we're using version_2. */ (Tcl_FSLoadFileProc *)(void *) TclpDlopen, (Tcl_FSGetCwdProc *) TclpGetNativeCwd, TclpObjChdir }; /* * Define the tail of the linked list. Note that for unconventional uses of * Tcl without a native filesystem, we may in the future wish to modify the * current approach of hard-coding the native filesystem in the lookup list * 'filesystemList' below. * * We initialize the record so that it thinks one file uses it. This means it * will never be freed. */ static FilesystemRecord nativeFilesystemRecord = { NULL, &tclNativeFilesystem, NULL, NULL }; /* * This is incremented each time we modify the linked list of filesystems. Any * time it changes, all cached filesystem representations are suspect and must * be freed. For multithreading builds, change of the filesystem epoch will * trigger cache cleanup in all threads. */ static size_t theFilesystemEpoch = 1; /* * Stores the linked list of filesystems. A 1:1 copy of this list is also * maintained in the TSD for each thread. This is to avoid synchronization * issues. */ static FilesystemRecord *filesystemList = &nativeFilesystemRecord; TCL_DECLARE_MUTEX(filesystemMutex) /* * Used to implement Tcl_FSGetCwd in a file-system independent way. */ static Tcl_Obj *cwdPathPtr = NULL; static size_t cwdPathEpoch = 0; static ClientData cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) static Tcl_ThreadDataKey fsDataKey; /* * One of these structures is used each time we successfully load a file from * a file system by way of making a temporary copy of the file on the native * filesystem. We need to store both the actual unloadProc/clientData * combination which was used, and the original and modified filenames, so * that we can correctly undo the entire operation when we want to unload the * code. */ typedef struct FsDivertLoad { Tcl_LoadHandle loadHandle; Tcl_FSUnloadFileProc *unloadProcPtr; Tcl_Obj *divertedFile; const Tcl_Filesystem *divertedFilesystem; ClientData divertedFileNativeRep; } FsDivertLoad; /* * The following functions are obsolete string based APIs, and should be * removed in a future release (Tcl 9 would be a good time). */ /* Obsolete */ int Tcl_Stat( const char *path, /* Path of file to stat (in current CP). */ struct stat *oldStyleBuf) /* Filled with results of stat call. */ { int ret; Tcl_StatBuf buf; Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSStat(pathPtr, &buf); Tcl_DecrRefCount(pathPtr); if (ret != -1) { #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt tmp1, tmp2, tmp3 = 0; # define OUT_OF_RANGE(x) \ (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \ ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX)) # define OUT_OF_URANGE(x) \ (((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX)) /* * Perform the result-buffer overflow check manually. * * Note that ino_t/ino64_t is unsigned... * * Workaround gcc warning of "comparison is always false due to * limited range of data type" by assigning to tmp var of type * Tcl_WideInt. */ tmp1 = (Tcl_WideInt) buf.st_ino; tmp2 = (Tcl_WideInt) buf.st_size; #ifdef HAVE_STRUCT_STAT_ST_BLOCKS tmp3 = (Tcl_WideInt) buf.st_blocks; #endif if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2) || OUT_OF_RANGE(tmp3)) { #if defined(EFBIG) errno = EFBIG; #elif defined(EOVERFLOW) errno = EOVERFLOW; #else #error "What status should be returned for file size out of range?" #endif return -1; } # undef OUT_OF_RANGE # undef OUT_OF_URANGE #endif /* !TCL_WIDE_INT_IS_LONG */ /* * Copy across all supported fields, with possible type coercion on * those fields that change between the normal and lf64 versions of * the stat structure (on Solaris at least). This is slow when the * structure sizes coincide, but that's what you get for using an * obsolete interface. */ oldStyleBuf->st_mode = buf.st_mode; oldStyleBuf->st_ino = (ino_t) buf.st_ino; oldStyleBuf->st_dev = buf.st_dev; oldStyleBuf->st_rdev = buf.st_rdev; oldStyleBuf->st_nlink = buf.st_nlink; oldStyleBuf->st_uid = buf.st_uid; oldStyleBuf->st_gid = buf.st_gid; oldStyleBuf->st_size = (off_t) buf.st_size; oldStyleBuf->st_atime = Tcl_GetAccessTimeFromStat(&buf); oldStyleBuf->st_mtime = Tcl_GetModificationTimeFromStat(&buf); oldStyleBuf->st_ctime = Tcl_GetChangeTimeFromStat(&buf); #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE oldStyleBuf->st_blksize = buf.st_blksize; #endif #ifdef HAVE_STRUCT_STAT_ST_BLOCKS #ifdef HAVE_BLKCNT_T oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks; #else oldStyleBuf->st_blocks = (unsigned long) buf.st_blocks; #endif #endif } return ret; } /* Obsolete */ int Tcl_Access( const char *path, /* Path of file to access (in current CP). */ int mode) /* Permission setting. */ { int ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSAccess(pathPtr,mode); Tcl_DecrRefCount(pathPtr); return ret; } /* Obsolete */ Tcl_Channel Tcl_OpenFileChannel( Tcl_Interp *interp, /* Interpreter for error reporting; can be * NULL. */ const char *path, /* Name of file to open. */ const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { Tcl_Channel ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions); Tcl_DecrRefCount(pathPtr); return ret; } /* Obsolete */ int Tcl_Chdir( const char *dirName) { int ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSChdir(pathPtr); Tcl_DecrRefCount(pathPtr); return ret; } /* Obsolete */ char * Tcl_GetCwd( Tcl_Interp *interp, Tcl_DString *cwdPtr) { Tcl_Obj *cwd = Tcl_FSGetCwd(interp); if (cwd == NULL) { return NULL; } Tcl_DStringInit(cwdPtr); TclDStringAppendObj(cwdPtr, cwd); Tcl_DecrRefCount(cwd); return Tcl_DStringValue(cwdPtr); } int Tcl_EvalFile( Tcl_Interp *interp, /* Interpreter in which to process file. */ const char *fileName) /* Name of file to process. Tilde-substitution * will be performed on this name. */ { int ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSEvalFile(interp, pathPtr); Tcl_DecrRefCount(pathPtr); return ret; } /* * Now move on to the basic filesystem implementation. */ static void FsThrExitProc( ClientData cd) { ThreadSpecificData *tsdPtr = cd; FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL; /* * Trash the cwd copy. */ if (tsdPtr->cwdPathPtr != NULL) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); tsdPtr->cwdPathPtr = NULL; } if (tsdPtr->cwdClientData != NULL) { NativeFreeInternalRep(tsdPtr->cwdClientData); } /* * Trash the filesystems cache. */ fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; fsRecPtr->fsPtr = NULL; ckfree(fsRecPtr); fsRecPtr = tmpFsRecPtr; } tsdPtr->filesystemList = NULL; tsdPtr->initialized = 0; } int TclFSCwdIsNative(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (tsdPtr->cwdClientData != NULL) { return 1; } else { return 0; } } /* *---------------------------------------------------------------------- * * TclFSCwdPointerEquals -- * * Check whether the current working directory is equal to the path * given. * * Results: * 1 (equal) or 0 (unequal) as appropriate. * * Side effects: * If the paths are equal, but are not the same object, this method will * modify the given pathPtrPtr to refer to the same object. In this case * the object pointed to by pathPtrPtr will have its refCount * decremented, and it will be adjusted to point to the cwd (with a new * refCount). * *---------------------------------------------------------------------- */ int TclFSCwdPointerEquals( Tcl_Obj **pathPtrPtr) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); Tcl_MutexLock(&cwdMutex); if (tsdPtr->cwdPathPtr == NULL || tsdPtr->cwdPathEpoch != cwdPathEpoch) { if (tsdPtr->cwdPathPtr != NULL) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); } if (tsdPtr->cwdClientData != NULL) { NativeFreeInternalRep(tsdPtr->cwdClientData); } if (cwdPathPtr == NULL) { tsdPtr->cwdPathPtr = NULL; } else { tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr); Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } if (cwdClientData == NULL) { tsdPtr->cwdClientData = NULL; } else { tsdPtr->cwdClientData = TclNativeDupInternalRep(cwdClientData); } tsdPtr->cwdPathEpoch = cwdPathEpoch; } Tcl_MutexUnlock(&cwdMutex); if (tsdPtr->initialized == 0) { Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr); tsdPtr->initialized = 1; } if (pathPtrPtr == NULL) { return (tsdPtr->cwdPathPtr == NULL); } if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { int len1, len2; const char *str1, *str2; str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2); if ((len1 == len2) && !memcmp(str1, str2, len1)) { /* * They are equal, but different objects. Update so they will be * the same object in the future. */ Tcl_DecrRefCount(*pathPtrPtr); *pathPtrPtr = tsdPtr->cwdPathPtr; Tcl_IncrRefCount(*pathPtrPtr); return 1; } else { return 0; } } } static void FsRecacheFilesystemList(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list; /* * Trash the current cache. */ fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; fsRecPtr->nextPtr = toFree; toFree = fsRecPtr; fsRecPtr = tmpFsRecPtr; } /* * Locate tail of the global filesystem list. */ Tcl_MutexLock(&filesystemMutex); fsRecPtr = filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr; fsRecPtr = fsRecPtr->nextPtr; } /* * Refill the cache honouring the order. */ list = NULL; fsRecPtr = tmpFsRecPtr; while (fsRecPtr != NULL) { tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord)); *tmpFsRecPtr = *fsRecPtr; tmpFsRecPtr->nextPtr = list; tmpFsRecPtr->prevPtr = NULL; list = tmpFsRecPtr; fsRecPtr = fsRecPtr->prevPtr; } tsdPtr->filesystemList = list; tsdPtr->filesystemEpoch = theFilesystemEpoch; Tcl_MutexUnlock(&filesystemMutex); while (toFree) { FilesystemRecord *next = toFree->nextPtr; toFree->fsPtr = NULL; ckfree(toFree); toFree = next; } /* * Make sure the above gets released on thread exit. */ if (tsdPtr->initialized == 0) { Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr); tsdPtr->initialized = 1; } } static FilesystemRecord * FsGetFirstFilesystem(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0) && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) { FsRecacheFilesystemList(); } return tsdPtr->filesystemList; } /* * The epoch can be changed by filesystems being added or removed, by changing * the "system encoding" and by env(HOME) changing. */ int TclFSEpochOk( size_t filesystemEpoch) { return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch); } static void Claim(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); tsdPtr->claims++; } static void Disclaim(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); tsdPtr->claims--; } size_t TclFSEpoch(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); return tsdPtr->filesystemEpoch; } /* * If non-NULL, clientData is owned by us and must be freed later. */ static void FsUpdateCwd( Tcl_Obj *cwdObj, ClientData clientData) { int len; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (cwdObj != NULL) { str = Tcl_GetStringFromObj(cwdObj, &len); } Tcl_MutexLock(&cwdMutex); if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); } if (cwdClientData != NULL) { NativeFreeInternalRep(cwdClientData); } if (cwdObj == NULL) { cwdPathPtr = NULL; cwdClientData = NULL; } else { /* * This must be stored as string obj! */ cwdPathPtr = Tcl_NewStringObj(str, len); Tcl_IncrRefCount(cwdPathPtr); cwdClientData = TclNativeDupInternalRep(clientData); } if (++cwdPathEpoch == 0) { ++cwdPathEpoch; } tsdPtr->cwdPathEpoch = cwdPathEpoch; Tcl_MutexUnlock(&cwdMutex); if (tsdPtr->cwdPathPtr) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); } if (tsdPtr->cwdClientData) { NativeFreeInternalRep(tsdPtr->cwdClientData); } if (cwdObj == NULL) { tsdPtr->cwdPathPtr = NULL; tsdPtr->cwdClientData = NULL; } else { tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len); tsdPtr->cwdClientData = clientData; Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } } /* *---------------------------------------------------------------------- * * TclFinalizeFilesystem -- * * Clean up the filesystem. After this, calls to all Tcl_FS... functions * will fail. * * We will later call TclResetFilesystem to restore the FS to a pristine * state. * * Results: * None. * * Side effects: * Frees any memory allocated by the filesystem. * *---------------------------------------------------------------------- */ void TclFinalizeFilesystem(void) { FilesystemRecord *fsRecPtr; /* * Assumption that only one thread is active now. Otherwise we would need * to put various mutexes around this code. */ if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); cwdPathPtr = NULL; cwdPathEpoch = 0; } if (cwdClientData != NULL) { NativeFreeInternalRep(cwdClientData); cwdClientData = NULL; } /* * Remove all filesystems, freeing any allocated memory that is no longer * needed. */ fsRecPtr = filesystemList; while (fsRecPtr != NULL) { FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr; /* The native filesystem is static, so we don't free it. */ if (fsRecPtr != &nativeFilesystemRecord) { ckfree(fsRecPtr); } fsRecPtr = tmpFsRecPtr; } if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; } filesystemList = NULL; /* * Now filesystemList is NULL. This means that any attempt to use the * filesystem is likely to fail. */ #ifdef _WIN32 TclWinEncodingsCleanup(); #endif } /* *---------------------------------------------------------------------- * * TclResetFilesystem -- * * Restore the filesystem to a pristine state. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclResetFilesystem(void) { filesystemList = &nativeFilesystemRecord; if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; } #ifdef _WIN32 /* * Cleans up the win32 API filesystem proc lookup table. This must happen * very late in finalization so that deleting of copied dlls can occur. */ TclWinResetInterfaces(); #endif } /* *---------------------------------------------------------------------- * * Tcl_FSRegister -- * * Insert the filesystem function table at the head of the list of * functions which are used during calls to all file-system operations. * The filesystem will be added even if it is already in the list. (You * can use Tcl_FSData to check if it is in the list, provided the * ClientData used was not NULL). * * Note that the filesystem handling is head-to-tail of the list. Each * filesystem is asked in turn whether it can handle a particular * request, until one of them says 'yes'. At that point no further * filesystems are asked. * * In particular this means if you want to add a diagnostic filesystem * (which simply reports all fs activity), it must be at the head of the * list: i.e. it must be the last registered. * * Results: * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could * not be allocated. * * Side effects: * Memory allocated and modifies the link list for filesystems. * *---------------------------------------------------------------------- */ int Tcl_FSRegister( ClientData clientData, /* Client specific data for this fs. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; if (fsPtr == NULL) { return TCL_ERROR; } newFilesystemPtr = ckalloc(sizeof(FilesystemRecord)); newFilesystemPtr->clientData = clientData; newFilesystemPtr->fsPtr = fsPtr; /* * Is this lock and wait strictly speaking necessary? Since any iterators * out there will have grabbed a copy of the head of the list and be * iterating away from that, if we add a new element to the head of the * list, it can't possibly have any effect on any of their loops. In fact * it could be better not to wait, since we are adjusting the filesystem * epoch, any cached representations calculated by existing iterators are * going to have to be thrown away anyway. * * However, since registering and unregistering filesystems is a very rare * action, this is not a very important point. */ Tcl_MutexLock(&filesystemMutex); newFilesystemPtr->nextPtr = filesystemList; newFilesystemPtr->prevPtr = NULL; if (filesystemList) { filesystemList->prevPtr = newFilesystemPtr; } filesystemList = newFilesystemPtr; /* * Increment the filesystem epoch counter, since existing paths might * conceivably now belong to different filesystems. */ if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; } Tcl_MutexUnlock(&filesystemMutex); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_FSUnregister -- * * Remove the passed filesystem from the list of filesystem function * tables. It also ensures that the built-in (native) filesystem is not * removable, although we may wish to change that decision in the future * to allow a smaller Tcl core, in which the native filesystem is not * used at all (we could, say, initialise Tcl completely over a network * connection). * * Results: * TCL_OK if the function pointer was successfully removed, TCL_ERROR * otherwise. * * Side effects: * Memory may be deallocated (or will be later, once no "path" objects * refer to this filesystem), but the list of registered filesystems is * updated immediately. * *---------------------------------------------------------------------- */ int Tcl_FSUnregister( const Tcl_Filesystem *fsPtr) /* The filesystem record to remove. */ { int retVal = TCL_ERROR; FilesystemRecord *fsRecPtr; Tcl_MutexLock(&filesystemMutex); /* * Traverse the 'filesystemList' looking for the particular node whose * 'fsPtr' member matches 'fsPtr' and remove that one from the list. * Ensure that the "default" node cannot be removed. */ fsRecPtr = filesystemList; while ((retVal == TCL_ERROR) && (fsRecPtr != &nativeFilesystemRecord)) { if (fsRecPtr->fsPtr == fsPtr) { if (fsRecPtr->prevPtr) { fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr; } else { filesystemList = fsRecPtr->nextPtr; } if (fsRecPtr->nextPtr) { fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr; } /* * Increment the filesystem epoch counter, since existing paths * might conceivably now belong to different filesystems. This * should also ensure that paths which have cached the filesystem * which is about to be deleted do not reference that filesystem * (which would of course lead to memory exceptions). */ if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; } ckfree(fsRecPtr); retVal = TCL_OK; } else { fsRecPtr = fsRecPtr->nextPtr; } } Tcl_MutexUnlock(&filesystemMutex); return retVal; } /* *---------------------------------------------------------------------- * * Tcl_FSMatchInDirectory -- * * This routine is used by the globbing code to search a directory for * all files which match a given pattern. The appropriate function for * the filesystem to which pathPtr belongs will be called. If pathPtr * does not belong to any filesystem and if it is NULL or the empty * string, then we assume the pattern is to be matched in the current * working directory. To avoid have the Tcl_FSMatchInDirectoryProc for * each filesystem from having to deal with this issue, we create a * pathPtr on the fly (equal to the cwd), and then remove it from the * results returned. This makes filesystems easy to write, since they can * assume the pathPtr passed to them is an ordinary path. In fact this * means we could remove such special case handling from Tcl's native * filesystems. * * If 'pattern' is NULL, then pathPtr is assumed to be a fully specified * path of a single file/directory which must be checked for existence * and correct type. * * Results: * * The return value is a standard Tcl result indicating whether an error * occurred in globbing. Error messages are placed in interp, but good * results are placed in the resultPtr given. * * Recursive searches, e.g. * glob -dir $dir -join * pkgIndex.tcl * which must recurse through each directory matching '*' are handled * internally by Tcl, by passing specific flags in a modified 'types' * parameter. This means the actual filesystem only ever sees patterns * which match in a single directory. * * Side effects: * The interpreter may have an error message inserted into it. * *---------------------------------------------------------------------- */ int Tcl_FSMatchInDirectory( Tcl_Interp *interp, /* Interpreter to receive error messages, but * may be NULL. */ Tcl_Obj *resultPtr, /* List object to receive results. */ Tcl_Obj *pathPtr, /* Contains path to directory to search. */ const char *pattern, /* Pattern to match against. */ Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. In particular the directory * flag is very important. */ { const Tcl_Filesystem *fsPtr; Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr; int resLength, i, ret = -1; if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) { /* * We don't currently allow querying of mounts by external code (a * valuable future step), so since we're the only function that * actually knows about mounts, this means we're being called * recursively by ourself. Return no matches. */ return TCL_OK; } if (pathPtr != NULL) { fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); } else { fsPtr = NULL; } /* * Check if we've successfully mapped the path to a filesystem within * which to search. */ if (fsPtr != NULL) { if (fsPtr->matchInDirectoryProc == NULL) { Tcl_SetErrno(ENOENT); return -1; } ret = fsPtr->matchInDirectoryProc(interp, resultPtr, pathPtr, pattern, types); if (ret == TCL_OK && pattern != NULL) { FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types); } return ret; } /* * If the path isn't empty, we have no idea how to match files in a * directory which belongs to no known filesystem. */ if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') { Tcl_SetErrno(ENOENT); return -1; } /* * We have an empty or NULL path. This is defined to mean we must search * for files within the current 'cwd'. We therefore use that, but then * since the proc we call will return results which include the cwd we * must then trim it off the front of each path in the result. We choose * to deal with this here (in the generic code), since if we don't, every * single filesystem's implementation of Tcl_FSMatchInDirectory will have * to deal with it for us. */ cwd = Tcl_FSGetCwd(NULL); if (cwd == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "glob couldn't determine the current working directory", -1)); } return TCL_ERROR; } fsPtr = Tcl_FSGetFileSystemForPath(cwd); if (fsPtr != NULL && fsPtr->matchInDirectoryProc != NULL) { TclNewObj(tmpResultPtr); Tcl_IncrRefCount(tmpResultPtr); ret = fsPtr->matchInDirectoryProc(interp, tmpResultPtr, cwd, pattern, types); if (ret == TCL_OK) { FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types); /* * Note that we know resultPtr and tmpResultPtr are distinct. */ ret = TclListObjGetElements(interp, tmpResultPtr, &resLength, &elemsPtr); for (i=0 ; ret==TCL_OK && itype & TCL_GLOB_TYPE_DIR)); Tcl_Obj *mounts = FsListMounts(pathPtr, pattern); if (mounts == NULL) { return; } if (TclListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) { goto endOfMounts; } if (TclListObjLength(NULL, resultPtr, &gLength) != TCL_OK) { goto endOfMounts; } for (i=0 ; ifsPtr == fsPtr) { retVal = fsRecPtr->clientData; } fsRecPtr = fsRecPtr->nextPtr; } return retVal; } /* *--------------------------------------------------------------------------- * * TclFSNormalizeToUniquePath -- * * Takes a path specification containing no ../, ./ sequences, and * converts it into a unique path for the given platform. On Unix, this * means the path must be free of symbolic links/aliases, and on Windows * it means we want the long form, with that long form's case-dependence * (which gives us a unique, case-dependent path). * * Results: * The pathPtr is modified in place. The return value is the last byte * offset which was recognised in the path string. * * Side effects: * None (beyond the memory allocation for the result). * * Special notes: * If the filesystem-specific normalizePathProcs can re-introduce ../, ./ * sequences into the path, then this function will not return the * correct result. This may be possible with symbolic links on Unix. * * Important assumption: if startAt is non-zero, it must point to a * directory separator that we know exists and is already normalized (so * it is important not to point to the char just after the separator). * *--------------------------------------------------------------------------- */ int TclFSNormalizeToUniquePath( Tcl_Interp *interp, /* Used for error messages. */ Tcl_Obj *pathPtr, /* The path to normalize in place. */ int startAt) /* Start at this char-offset. */ { FilesystemRecord *fsRecPtr, *firstFsRecPtr; /* * Call each of the "normalise path" functions in succession. This is a * special case, in which if we have a native filesystem handler, we call * it first. This is because the root of Tcl's filesystem is always a * native filesystem (i.e. '/' on Unix is native). */ firstFsRecPtr = FsGetFirstFilesystem(); Claim(); for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { if (fsRecPtr->fsPtr != &tclNativeFilesystem) { continue; } /* * TODO: Assume that we always find the native file system; it should * always be there... */ if (fsRecPtr->fsPtr->normalizePathProc != NULL) { startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, startAt); } break; } for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { /* * Skip the native system next time through. */ if (fsRecPtr->fsPtr == &tclNativeFilesystem) { continue; } if (fsRecPtr->fsPtr->normalizePathProc != NULL) { startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, startAt); } /* * We could add an efficiency check like this: * if (retVal == length-of(pathPtr)) {break;} * but there's not much benefit. */ } Disclaim(); return startAt; } /* *--------------------------------------------------------------------------- * * TclGetOpenMode -- * * This routine is an obsolete, limited version of TclGetOpenModeEx() * below. It exists only to satisfy any extensions imprudently using it * via Tcl's internal stubs table. * * Results: * Same as TclGetOpenModeEx(). * * Side effects: * Same as TclGetOpenModeEx(). * *--------------------------------------------------------------------------- */ int TclGetOpenMode( Tcl_Interp *interp, /* Interpreter to use for error reporting - * may be NULL. */ const char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */ int *seekFlagPtr) /* Set this to 1 if the caller should seek to * EOF during the opening of the file. */ { int binary = 0; return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary); } /* *--------------------------------------------------------------------------- * * TclGetOpenModeEx -- * * Computes a POSIX mode mask for opening a file, from a given string, * and also sets flags to indicate whether the caller should seek to EOF * after opening the file, and whether the caller should configure the * channel for binary data. * * Results: * On success, returns mode to pass to "open". If an error occurs, the * return value is -1 and if interp is not NULL, sets interp's result * object to an error message. * * Side effects: * Sets the integer referenced by seekFlagPtr to 1 to tell the caller to * seek to EOF after opening the file, or to 0 otherwise. Sets the * integer referenced by binaryPtr to 1 to tell the caller to seek to * configure the channel for binary data, or to 0 otherwise. * * Special note: * This code is based on a prototype implementation contributed by Mark * Diekhans. * *--------------------------------------------------------------------------- */ int TclGetOpenModeEx( Tcl_Interp *interp, /* Interpreter to use for error reporting - * may be NULL. */ const char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */ int *seekFlagPtr, /* Set this to 1 if the caller should seek to * EOF during the opening of the file. */ int *binaryPtr) /* Set this to 1 if the caller should * configure the opened channel for binary * operations. */ { int mode, modeArgc, c, i, gotRW; const char **modeArgv, *flag; #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR) /* * Check for the simpler fopen-like access modes (e.g. "r"). They are * distinguished from the POSIX access modes by the presence of a * lower-case first letter. */ *seekFlagPtr = 0; *binaryPtr = 0; mode = 0; /* * Guard against international characters before using byte oriented * routines. */ if (!(modeString[0] & 0x80) && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */ switch (modeString[0]) { case 'r': mode = O_RDONLY; break; case 'w': mode = O_WRONLY|O_CREAT|O_TRUNC; break; case 'a': /* * Added O_APPEND for proper automatic seek-to-end-on-write by the * OS. [Bug 680143] */ mode = O_WRONLY|O_CREAT|O_APPEND; *seekFlagPtr = 1; break; default: goto error; } i = 1; while (i<3 && modeString[i]) { if (modeString[i] == modeString[i-1]) { goto error; } switch (modeString[i++]) { case '+': /* * Must remove the O_APPEND flag so that the seek command * works. [Bug 1773127] */ mode &= ~(O_RDONLY|O_WRONLY|O_APPEND); mode |= O_RDWR; break; case 'b': *binaryPtr = 1; break; default: goto error; } } if (modeString[i] != 0) { goto error; } return mode; error: *seekFlagPtr = 0; *binaryPtr = 0; if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "illegal access mode \"%s\"", modeString)); } return -1; } /* * The access modes are specified using a list of POSIX modes such as * O_CREAT. * * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when a NULL * interpreter is passed in. */ if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) { if (interp != NULL) { Tcl_AddErrorInfo(interp, "\n while processing open access modes \""); Tcl_AddErrorInfo(interp, modeString); Tcl_AddErrorInfo(interp, "\""); } return -1; } gotRW = 0; for (i = 0; i < modeArgc; i++) { flag = modeArgv[i]; c = flag[0]; if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) { mode = (mode & ~RW_MODES) | O_RDONLY; gotRW = 1; } else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) { mode = (mode & ~RW_MODES) | O_WRONLY; gotRW = 1; } else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) { mode = (mode & ~RW_MODES) | O_RDWR; gotRW = 1; } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) { mode |= O_APPEND; *seekFlagPtr = 1; } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) { mode |= O_CREAT; } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) { mode |= O_EXCL; } else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) { #ifdef O_NOCTTY mode |= O_NOCTTY; #else if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "access mode \"%s\" not supported by this system", flag)); } ckfree(modeArgv); return -1; #endif } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { #ifdef O_NONBLOCK mode |= O_NONBLOCK; #else if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "access mode \"%s\" not supported by this system", flag)); } ckfree(modeArgv); return -1; #endif } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { mode |= O_TRUNC; } else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) { *binaryPtr = 1; } else { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid access mode \"%s\": must be RDONLY, WRONLY, " "RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK," " or TRUNC", flag)); } ckfree(modeArgv); return -1; } } ckfree(modeArgv); if (!gotRW) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "access mode must include either RDONLY, WRONLY, or RDWR", -1)); } return -1; } return mode; } /* *---------------------------------------------------------------------- * * Tcl_FSEvalFile, Tcl_FSEvalFileEx, TclNREvalFile -- * * Read in a file and process the entire file as one gigantic Tcl * command. Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument. * TclNREvalFile is an NRE-enabled version of Tcl_FSEvalFileEx. * * Results: * A standard Tcl result, which is either the result of executing the * file or an error indicating why the file couldn't be read. * * Side effects: * Depends on the commands in the file. During the evaluation of the * contents of the file, iPtr->scriptFile is made to point to pathPtr * (the old value is cached and replaced when this function returns). * *---------------------------------------------------------------------- */ int Tcl_FSEvalFile( Tcl_Interp *interp, /* Interpreter in which to process file. */ Tcl_Obj *pathPtr) /* Path of file to process. Tilde-substitution * will be performed on this name. */ { return Tcl_FSEvalFileEx(interp, pathPtr, NULL); } int Tcl_FSEvalFileEx( Tcl_Interp *interp, /* Interpreter in which to process file. */ Tcl_Obj *pathPtr, /* Path of file to process. Tilde-substitution * will be performed on this name. */ const char *encodingName) /* If non-NULL, then use this encoding for the * file. NULL means use the system encoding. */ { int length, result = TCL_ERROR; Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; Interp *iPtr; const char *string; Tcl_Channel chan; Tcl_Obj *objPtr; if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { return result; } if (Tcl_FSStat(pathPtr, &statBuf) == -1) { Tcl_SetErrno(errno); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return result; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return result; } /* * The eofchar is \32 (^Z). This is the usual on Windows, but we effect * this cross-platform to allow for scripted documents. [Bug: 2040] */ Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}"); /* * If the encoding is specified, set it for the channel. Else don't touch * it (and use the system encoding) Report error on unknown encoding. */ if (encodingName != NULL) { if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { Tcl_Close(interp,chan); return result; } } TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); /* * Try to read first character of stream, so we can check for utf-8 BOM to * be handled especially. */ if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) { Tcl_Close(interp, chan); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); goto end; } string = Tcl_GetString(objPtr); /* * If first character is not a BOM, append the remaining characters, * otherwise replace them. [Bug 3466099] */ if (Tcl_ReadChars(chan, objPtr, -1, memcmp(string, "\xEF\xBB\xBF", 3)) < 0) { Tcl_Close(interp, chan); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); goto end; } if (Tcl_Close(interp, chan) != TCL_OK) { goto end; } iPtr = (Interp *) interp; oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); string = Tcl_GetStringFromObj(objPtr, &length); /* * TIP #280 Force the evaluator to open a frame for a sourced file. */ iPtr->evalFlags |= TCL_EVAL_FILE; result = TclEvalEx(interp, string, length, 0, 1, NULL, string); /* * Now we have to be careful; the script may have changed the * iPtr->scriptFile value, so we must reset it without assuming it still * points to 'pathPtr'. */ if (iPtr->scriptFile != NULL) { Tcl_DecrRefCount(iPtr->scriptFile); } iPtr->scriptFile = oldScriptFile; if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { /* * Record information telling where the error occurred. */ const char *pathString = Tcl_GetStringFromObj(pathPtr, &length); int limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", (overflow ? limit : length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } end: Tcl_DecrRefCount(objPtr); return result; } int TclNREvalFile( Tcl_Interp *interp, /* Interpreter in which to process file. */ Tcl_Obj *pathPtr, /* Path of file to process. Tilde-substitution * will be performed on this name. */ const char *encodingName) /* If non-NULL, then use this encoding for the * file. NULL means use the system encoding. */ { Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile, *objPtr; Interp *iPtr; Tcl_Channel chan; const char *string; if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { return TCL_ERROR; } if (Tcl_FSStat(pathPtr, &statBuf) == -1) { Tcl_SetErrno(errno); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return TCL_ERROR; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return TCL_ERROR; } /* * The eofchar is \32 (^Z). This is the usual on Windows, but we effect * this cross-platform to allow for scripted documents. [Bug: 2040] */ Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}"); /* * If the encoding is specified, set it for the channel. Else don't touch * it (and use the system encoding) Report error on unknown encoding. */ if (encodingName != NULL) { if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { Tcl_Close(interp,chan); return TCL_ERROR; } } TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); /* * Try to read first character of stream, so we can check for utf-8 BOM to * be handled especially. */ if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) { Tcl_Close(interp, chan); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } string = Tcl_GetString(objPtr); /* * If first character is not a BOM, append the remaining characters, * otherwise replace them. [Bug 3466099] */ if (Tcl_ReadChars(chan, objPtr, -1, memcmp(string, "\xEF\xBB\xBF", 3)) < 0) { Tcl_Close(interp, chan); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } if (Tcl_Close(interp, chan) != TCL_OK) { Tcl_DecrRefCount(objPtr); return TCL_ERROR; } iPtr = (Interp *) interp; oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); /* * TIP #280: Force the evaluator to open a frame for a sourced file. */ iPtr->evalFlags |= TCL_EVAL_FILE; TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr, NULL); return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN); } static int EvalFileCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldScriptFile = data[0]; Tcl_Obj *pathPtr = data[1]; Tcl_Obj *objPtr = data[2]; /* * Now we have to be careful; the script may have changed the * iPtr->scriptFile value, so we must reset it without assuming it still * points to 'pathPtr'. */ if (iPtr->scriptFile != NULL) { Tcl_DecrRefCount(iPtr->scriptFile); } iPtr->scriptFile = oldScriptFile; if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { /* * Record information telling where the error occurred. */ int length; const char *pathString = Tcl_GetStringFromObj(pathPtr, &length); const int limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", (overflow ? limit : length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } Tcl_DecrRefCount(objPtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_GetErrno -- * * Gets the current value of the Tcl error code variable. This is * currently the global variable "errno" but could in the future change * to something else. * * Results: * The value of the Tcl error code variable. * * Side effects: * None. Note that the value of the Tcl error code variable is UNDEFINED * if a call to Tcl_SetErrno did not precede this call. * *---------------------------------------------------------------------- */ int Tcl_GetErrno(void) { /* * On some platforms, errno is really a thread local (implemented by the C * library). */ return errno; } /* *---------------------------------------------------------------------- * * Tcl_SetErrno -- * * Sets the Tcl error code variable to the supplied value. On some saner * platforms this is actually a thread-local (this is implemented in the * C library) but this is *really* unsafe to assume! * * Results: * None. * * Side effects: * Modifies the value of the Tcl error code variable. * *---------------------------------------------------------------------- */ void Tcl_SetErrno( int err) /* The new value. */ { /* * On some platforms, errno is really a thread local (implemented by the C * library). */ errno = err; } /* *---------------------------------------------------------------------- * * Tcl_PosixError -- * * This function is typically called after UNIX kernel calls return * errors. It stores machine-readable information about the error in * errorCode field of interp and returns an information string for the * caller's use. * * Results: * The return value is a human-readable string describing the error. * * Side effects: * The errorCode field of the interp is set. * *---------------------------------------------------------------------- */ const char * Tcl_PosixError( Tcl_Interp *interp) /* Interpreter whose errorCode field is to be * set. */ { const char *id, *msg; msg = Tcl_ErrnoMsg(errno); id = Tcl_ErrnoId(); if (interp) { Tcl_SetErrorCode(interp, "POSIX", id, msg, NULL); } return msg; } /* *---------------------------------------------------------------------- * * Tcl_FSStat -- * * This function replaces the library version of stat and lstat. * * The appropriate function for the filesystem to which pathPtr belongs * will be called. * * Results: * See stat documentation. * * Side effects: * See stat documentation. * *---------------------------------------------------------------------- */ int Tcl_FSStat( Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */ Tcl_StatBuf *buf) /* Filled with results of stat call. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->statProc != NULL) { return fsPtr->statProc(pathPtr, buf); } Tcl_SetErrno(ENOENT); return -1; } /* *---------------------------------------------------------------------- * * Tcl_FSLstat -- * * This function replaces the library version of lstat. The appropriate * function for the filesystem to which pathPtr belongs will be called. * If no 'lstat' function is listed, but a 'stat' function is, then Tcl * will fall back on the stat function. * * Results: * See lstat documentation. * * Side effects: * See lstat documentation. * *---------------------------------------------------------------------- */ int Tcl_FSLstat( Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */ Tcl_StatBuf *buf) /* Filled with results of stat call. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { if (fsPtr->lstatProc != NULL) { return fsPtr->lstatProc(pathPtr, buf); } if (fsPtr->statProc != NULL) { return fsPtr->statProc(pathPtr, buf); } } Tcl_SetErrno(ENOENT); return -1; } /* *---------------------------------------------------------------------- * * Tcl_FSAccess -- * * This function replaces the library version of access. The appropriate * function for the filesystem to which pathPtr belongs will be called. * * Results: * See access documentation. * * Side effects: * See access documentation. * *---------------------------------------------------------------------- */ int Tcl_FSAccess( Tcl_Obj *pathPtr, /* Path of file to access (in current CP). */ int mode) /* Permission setting. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->accessProc != NULL) { return fsPtr->accessProc(pathPtr, mode); } Tcl_SetErrno(ENOENT); return -1; } /* *---------------------------------------------------------------------- * * Tcl_FSOpenFileChannel -- * * The appropriate function for the filesystem to which pathPtr belongs * will be called. * * Results: * The new channel or NULL, if the named file could not be opened. * * Side effects: * May open the channel and may cause creation of a file on the file * system. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_FSOpenFileChannel( Tcl_Interp *interp, /* Interpreter for error reporting; can be * NULL. */ Tcl_Obj *pathPtr, /* Name of file to open. */ const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { const Tcl_Filesystem *fsPtr; Tcl_Channel retVal = NULL; /* * We need this just to ensure we return the correct error messages under * some circumstances. */ if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { return NULL; } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->openFileChannelProc != NULL) { int mode, seekFlag, binary; /* * Parse the mode, picking up whether we want to seek to start with * and/or set the channel automatically into binary mode. */ mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary); if (mode == -1) { return NULL; } /* * Do the actual open() call. */ retVal = fsPtr->openFileChannelProc(interp, pathPtr, mode, permissions); if (retVal == NULL) { return NULL; } /* * Apply appropriate flags parsed out above. */ if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END) < (Tcl_WideInt) 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not seek to end of file while opening \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); } Tcl_Close(NULL, retVal); return NULL; } if (binary) { Tcl_SetChannelOption(interp, retVal, "-translation", "binary"); } return retVal; } /* * File doesn't belong to any filesystem that can open it. */ Tcl_SetErrno(ENOENT); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } /* *---------------------------------------------------------------------- * * Tcl_FSUtime -- * * This function replaces the library version of utime. The appropriate * function for the filesystem to which pathPtr belongs will be called. * * Results: * See utime documentation. * * Side effects: * See utime documentation. * *---------------------------------------------------------------------- */ int Tcl_FSUtime( Tcl_Obj *pathPtr, /* File to change access/modification * times. */ struct utimbuf *tval) /* Structure containing access/modification * times to use. Should not be modified. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->utimeProc != NULL) { return fsPtr->utimeProc(pathPtr, tval); } /* TODO: set errno here? Tcl_SetErrno(ENOENT); */ return -1; } /* *---------------------------------------------------------------------- * * NativeFileAttrStrings -- * * This function implements the platform dependent 'file attributes' * subcommand, for the native filesystem, for listing the set of possible * attribute strings. This function is part of Tcl's native filesystem * support, and is placed here because it is shared by Unix and Windows * code. * * Results: * An array of strings * * Side effects: * None. * *---------------------------------------------------------------------- */ static const char *const * NativeFileAttrStrings( Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { return tclpFileAttrStrings; } /* *---------------------------------------------------------------------- * * NativeFileAttrsGet -- * * This function implements the platform dependent 'file attributes' * subcommand, for the native filesystem, for 'get' operations. This * function is part of Tcl's native filesystem support, and is placed * here because it is shared by Unix and Windows code. * * Results: * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK * was returned) is likely to have a refCount of zero. Either way we must * either store it somewhere (e.g. the Tcl result), or Incr/Decr its * refCount to ensure it is properly freed. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int NativeFileAttrsGet( Tcl_Interp *interp, /* The interpreter for error reporting. */ int index, /* index of the attribute command. */ Tcl_Obj *pathPtr, /* path of file we are operating on. */ Tcl_Obj **objPtrRef) /* for output. */ { return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef); } /* *---------------------------------------------------------------------- * * NativeFileAttrsSet -- * * This function implements the platform dependent 'file attributes' * subcommand, for the native filesystem, for 'set' operations. This * function is part of Tcl's native filesystem support, and is placed * here because it is shared by Unix and Windows code. * * Results: * Standard Tcl return code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int NativeFileAttrsSet( Tcl_Interp *interp, /* The interpreter for error reporting. */ int index, /* index of the attribute command. */ Tcl_Obj *pathPtr, /* path of file we are operating on. */ Tcl_Obj *objPtr) /* set to this value. */ { return tclpFileAttrProcs[index].setProc(interp, index, pathPtr, objPtr); } /* *---------------------------------------------------------------------- * * Tcl_FSFileAttrStrings -- * * This function implements part of the hookable 'file attributes' * subcommand. The appropriate function for the filesystem to which * pathPtr belongs will be called. * * Results: * The called function may either return an array of strings, or may * instead return NULL and place a Tcl list into the given objPtrRef. * Tcl will take that list and first increment its refCount before using * it. On completion of that use, Tcl will decrement its refCount. Hence * if the list should be disposed of by Tcl when done, it should have a * refCount of zero, and if the list should not be disposed of, the * filesystem should ensure it retains a refCount on the object. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char *const * Tcl_FSFileAttrStrings( Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->fileAttrStringsProc != NULL) { return fsPtr->fileAttrStringsProc(pathPtr, objPtrRef); } Tcl_SetErrno(ENOENT); return NULL; } /* *---------------------------------------------------------------------- * * TclFSFileAttrIndex -- * * Helper function for converting an attribute name to an index into the * attribute table. * * Results: * Tcl result code, index written to *indexPtr on result==TCL_OK * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclFSFileAttrIndex( Tcl_Obj *pathPtr, /* File whose attributes are to be indexed * into. */ const char *attributeName, /* The attribute being looked for. */ int *indexPtr) /* Where to write the found index. */ { Tcl_Obj *listObj = NULL; const char *const *attrTable; /* * Get the attribute table for the file. */ attrTable = Tcl_FSFileAttrStrings(pathPtr, &listObj); if (listObj != NULL) { Tcl_IncrRefCount(listObj); } if (attrTable != NULL) { /* * It's a constant attribute table, so use T_GIFO. */ Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, -1); int result; result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT, indexPtr); TclDecrRefCount(tmpObj); if (listObj != NULL) { TclDecrRefCount(listObj); } return result; } else if (listObj != NULL) { /* * It's a non-constant attribute list, so do a literal search. */ int i, objc; Tcl_Obj **objv; if (TclListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) { TclDecrRefCount(listObj); return TCL_ERROR; } for (i=0 ; ifileAttrsGetProc != NULL) { return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef); } Tcl_SetErrno(ENOENT); return -1; } /* *---------------------------------------------------------------------- * * Tcl_FSFileAttrsSet -- * * This function implements write access for the hookable 'file * attributes' subcommand. The appropriate function for the filesystem to * which pathPtr belongs will be called. * * Results: * Standard Tcl return code. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_FSFileAttrsSet( Tcl_Interp *interp, /* The interpreter for error reporting. */ int index, /* index of the attribute command. */ Tcl_Obj *pathPtr, /* filename we are operating on. */ Tcl_Obj *objPtr) /* Input value. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) { return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr); } Tcl_SetErrno(ENOENT); return -1; } /* *---------------------------------------------------------------------- * * Tcl_FSGetCwd -- * * This function replaces the library version of getcwd(). * * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its own * record (in a Tcl_Obj) of the cwd, and an attempt is made to synch this * with the cwd's containing filesystem, if that filesystem provides a * cwdProc (e.g. the native filesystem). * * Note that if Tcl's cwd is not in the native filesystem, then of course * Tcl's cwd and the native cwd are different: extensions should * therefore ensure they only access the cwd through this function to * avoid confusion. * * If a global cwdPathPtr already exists, it is cached in the thread's * private data structures and reference to the cached copy is returned, * subject to a synchronisation attempt in that cwdPathPtr's fs. * * Otherwise, the chain of functions that have been "inserted" into the * filesystem will be called in succession until either a value other * than NULL is returned, or the entire list is visited. * * Results: * The result is a pointer to a Tcl_Obj specifying the current directory, * or NULL if the current directory could not be determined. If NULL is * returned, an error message is left in the interp's result. * * The result already has its refCount incremented for the caller. When * it is no longer needed, that refCount should be decremented. * * Side effects: * Various objects may be freed and allocated. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSGetCwd( Tcl_Interp *interp) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (TclFSCwdPointerEquals(NULL)) { FilesystemRecord *fsRecPtr; Tcl_Obj *retVal = NULL; /* * We've never been called before, try to find a cwd. Call each of the * "Tcl_GetCwd" function in succession. A non-NULL return value * indicates the particular function has succeeded. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); for (; (retVal == NULL) && (fsRecPtr != NULL); fsRecPtr = fsRecPtr->nextPtr) { ClientData retCd; TclFSGetCwdProc2 *proc2; if (fsRecPtr->fsPtr->getCwdProc == NULL) { continue; } if (fsRecPtr->fsPtr->version == TCL_FILESYSTEM_VERSION_1) { retVal = fsRecPtr->fsPtr->getCwdProc(interp); continue; } proc2 = (TclFSGetCwdProc2 *) fsRecPtr->fsPtr->getCwdProc; retCd = proc2(NULL); if (retCd != NULL) { Tcl_Obj *norm; /* * Looks like a new current directory. */ retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd); Tcl_IncrRefCount(retVal); norm = TclFSNormalizeAbsolutePath(interp,retVal); if (norm != NULL) { /* * We found a cwd, which is now in our global storage. We * must make a copy. Norm already has a refCount of 1. * * Threading issue: note that multiple threads at system * startup could in principle call this function * simultaneously. They will therefore each set the * cwdPathPtr independently. That behaviour is a bit * peculiar, but should be fine. Once we have a cwd, we'll * always be in the 'else' branch below which is simpler. */ FsUpdateCwd(norm, retCd); Tcl_DecrRefCount(norm); } else { fsRecPtr->fsPtr->freeInternalRepProc(retCd); } Tcl_DecrRefCount(retVal); retVal = NULL; Disclaim(); goto cdDidNotChange; } else if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error getting working directory name: %s", Tcl_PosixError(interp))); } } Disclaim(); /* * Now the 'cwd' may NOT be normalized, at least on some platforms. * For the sake of efficiency, we want a completely normalized cwd at * all times. * * Finally, if retVal is NULL, we do not have a cwd, which could be * problematic. */ if (retVal != NULL) { Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal); if (norm != NULL) { /* * We found a cwd, which is now in our global storage. We must * make a copy. Norm already has a refCount of 1. * * Threading issue: note that multiple threads at system * startup could in principle call this function * simultaneously. They will therefore each set the cwdPathPtr * independently. That behaviour is a bit peculiar, but should * be fine. Once we have a cwd, we'll always be in the 'else' * branch below which is simpler. */ ClientData cd = (ClientData) Tcl_FSGetNativePath(norm); FsUpdateCwd(norm, TclNativeDupInternalRep(cd)); Tcl_DecrRefCount(norm); } Tcl_DecrRefCount(retVal); } } else { /* * We already have a cwd cached, but we want to give the filesystem it * is in a chance to check whether that cwd has changed, or is perhaps * no longer accessible. This allows an error to be thrown if, say, * the permissions on that directory have changed. */ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr); ClientData retCd = NULL; Tcl_Obj *retVal, *norm; /* * If the filesystem couldn't be found, or if no cwd function exists * for this filesystem, then we simply assume the cached cwd is ok. * If we do call a cwd, we must watch for errors (if the cwd returns * NULL). This ensures that, say, on Unix if the permissions of the * cwd change, 'pwd' does actually throw the correct error in Tcl. * (This is tested for in the test suite on Unix). */ if (fsPtr == NULL || fsPtr->getCwdProc == NULL) { goto cdDidNotChange; } if (fsPtr->version == TCL_FILESYSTEM_VERSION_1) { retVal = fsPtr->getCwdProc(interp); } else { /* * New API. */ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc; retCd = proc2(tsdPtr->cwdClientData); if (retCd == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error getting working directory name: %s", Tcl_PosixError(interp))); } if (retCd == tsdPtr->cwdClientData) { goto cdDidNotChange; } /* * Looks like a new current directory. */ retVal = fsPtr->internalToNormalizedProc(retCd); Tcl_IncrRefCount(retVal); } /* * Check if the 'cwd' function returned an error; if so, reset the * cwd. */ if (retVal == NULL) { FsUpdateCwd(NULL, NULL); goto cdDidNotChange; } /* * Normalize the path. */ norm = TclFSNormalizeAbsolutePath(interp, retVal); /* * Check whether cwd has changed from the value previously stored in * cwdPathPtr. Really 'norm' shouldn't be NULL, but we are careful. */ if (norm == NULL) { /* Do nothing */ if (retCd != NULL) { fsPtr->freeInternalRepProc(retCd); } } else if (norm == tsdPtr->cwdPathPtr) { goto cdEqual; } else { /* * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are normalized * paths. Therefore we can be more efficient than calling * 'Tcl_FSEqualPaths', and in addition avoid a nasty infinite loop * bug when trying to normalize tsdPtr->cwdPathPtr. */ int len1, len2; const char *str1, *str2; str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); str2 = Tcl_GetStringFromObj(norm, &len2); if ((len1 == len2) && (strcmp(str1, str2) == 0)) { /* * If the paths were equal, we can be more efficient and * retain the old path object which will probably already be * shared. In this case we can simply free the normalized path * we just calculated. */ cdEqual: Tcl_DecrRefCount(norm); if (retCd != NULL) { fsPtr->freeInternalRepProc(retCd); } } else { FsUpdateCwd(norm, retCd); Tcl_DecrRefCount(norm); } } Tcl_DecrRefCount(retVal); } cdDidNotChange: if (tsdPtr->cwdPathPtr != NULL) { Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } return tsdPtr->cwdPathPtr; } /* *---------------------------------------------------------------------- * * Tcl_FSChdir -- * * This function replaces the library version of chdir(). * * The path is normalized and then passed to the filesystem which claims * it. * * Results: * See chdir() documentation. If successful, we keep a record of the * successful path in cwdPathPtr for subsequent calls to getcwd. * * Side effects: * See chdir() documentation. The global cwdPathPtr may change value. * *---------------------------------------------------------------------- */ int Tcl_FSChdir( Tcl_Obj *pathPtr) { const Tcl_Filesystem *fsPtr, *oldFsPtr = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); int retVal = -1; if (tsdPtr->cwdPathPtr != NULL) { oldFsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr); } if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) { Tcl_SetErrno(ENOENT); return retVal; } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { if (fsPtr->chdirProc != NULL) { /* * If this fails, an appropriate errno will have been stored using * 'Tcl_SetErrno()'. */ retVal = fsPtr->chdirProc(pathPtr); } else { /* * Fallback on stat-based implementation. */ Tcl_StatBuf buf; /* * If the file can be stat'ed and is a directory and is readable, * then we can chdir. If any of these actions fail, then * 'Tcl_SetErrno()' should automatically have been called to set * an appropriate error code. */ if ((Tcl_FSStat(pathPtr, &buf) == 0) && (S_ISDIR(buf.st_mode)) && (Tcl_FSAccess(pathPtr, R_OK) == 0)) { /* * We allow the chdir. */ retVal = 0; } } } else { Tcl_SetErrno(ENOENT); } /* * The cwd changed, or an error was thrown. If an error was thrown, we can * just continue (and that will report the error to the user). If there * was no error we must assume that the cwd was actually changed to the * normalized value we calculated above, and we must therefore cache that * information. * * If the filesystem in question has a getCwdProc, then the correct logic * which performs the part below is already part of the Tcl_FSGetCwd() * call, so no need to replicate it again. This will have a side effect * though. The private authoritative representation of the current working * directory stored in cwdPathPtr in static memory will be out-of-sync * with the real OS-maintained value. The first call to Tcl_FSGetCwd will * however recalculate the private copy to match the OS-value so * everything will work right. * * However, if there is no getCwdProc, then we _must_ update our private * storage of the cwd, since this is the only opportunity to do that! * * Note: We currently call this block of code irrespective of whether * there was a getCwdProc or not, but the code should all in principle * work if we only call this block if fsPtr->getCwdProc == NULL. */ if (retVal == 0) { /* * Note that this normalized path may be different to what we found * above (or at least a different object), if the filesystem epoch * changed recently. This can actually happen with scripted documents * very easily. Therefore we ask for the normalized path again (the * correct value will have been cached as a result of the * Tcl_FSGetFileSystemForPath call above anyway). */ Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normDirName == NULL) { /* Not really true, but what else to do? */ Tcl_SetErrno(ENOENT); return -1; } if (fsPtr == &tclNativeFilesystem) { /* * For the native filesystem, we keep a cache of the native * representation of the cwd. But, we want to do that for the * exact format that is returned by 'getcwd' (so that we can later * compare the two representations for equality), which might not * be exactly the same char-string as the native representation of * the fully normalized path (e.g. on Windows there's a * forward-slash vs backslash difference). Hence we ask for this * again here. On Unix it might actually be true that we always * have the correct form in the native rep in which case we could * simply use: * cd = Tcl_FSGetNativePath(pathPtr); * instead. This should be examined by someone on Unix. */ ClientData cd; ClientData oldcd = tsdPtr->cwdClientData; /* * Assumption we are using a filesystem version 2. */ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc; cd = proc2(oldcd); if (cd != oldcd) { FsUpdateCwd(normDirName, cd); } } else { FsUpdateCwd(normDirName, NULL); } /* * If the filesystem changed between old and new cwd * force filesystem refresh on path objects. */ if (oldFsPtr != NULL && fsPtr != oldFsPtr) { Tcl_FSMountsChanged(NULL); } } return retVal; } /* *---------------------------------------------------------------------- * * Tcl_FSLoadFile -- * * Dynamically loads a binary code file into memory and returns the * addresses of two functions within that file, if they are defined. The * appropriate function for the filesystem to which pathPtr belongs will * be called. * * Note that the native filesystem doesn't actually assume 'pathPtr' is a * path. Rather it assumes pathPtr is either a path or just the name * (tail) of a file which can be found somewhere in the environment's * loadable path. This behaviour is not very compatible with virtual * filesystems (and has other problems documented in the load man-page), * so it is advised that full paths are always used. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. This may later be unloaded by * passing the clientData to the unloadProc. * *---------------------------------------------------------------------- */ int Tcl_FSLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code. */ const char *sym1, const char *sym2, /* Names of two functions to look up in the * file's symbol table. */ Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, /* Where to return the addresses corresponding * to sym1 and sym2. */ Tcl_LoadHandle *handlePtr, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ { const char *symbols[3]; void *procPtrs[2]; int res; /* * Initialize the arrays. */ symbols[0] = sym1; symbols[1] = sym2; symbols[2] = NULL; /* * Perform the load. */ res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr); if (res == TCL_OK) { *proc1Ptr = (Tcl_PackageInitProc *) procPtrs[0]; *proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1]; } else { *proc1Ptr = *proc2Ptr = NULL; } return res; } /* *---------------------------------------------------------------------- * * Tcl_LoadFile -- * * Dynamically loads a binary code file into memory and returns the * addresses of a number of given functions within that file, if they are * defined. The appropriate function for the filesystem to which pathPtr * belongs will be called. * * Note that the native filesystem doesn't actually assume 'pathPtr' is a * path. Rather it assumes pathPtr is either a path or just the name * (tail) of a file which can be found somewhere in the environment's * loadable path. This behaviour is not very compatible with virtual * filesystems (and has other problems documented in the load man-page), * so it is advised that full paths are always used. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. This may later be unloaded by * calling TclFS_UnloadFile. * *---------------------------------------------------------------------- */ /* * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY * error) yet somehow trash some internal data structures which prevents the * second and further shared libraries from getting properly loaded. Only the * first is ok. We try to get around the issue by not unlinking, * i.e. emulating the behaviour of the older HPUX which denied removal. * * Doing the unlink is also an issue within docker containers, whose AUFS * bungles this as well, see * https://github.com/dotcloud/docker/issues/1911 * * For these situations the change below makes the execution of the unlink * semi-controllable at runtime. * * An AUFS filesystem (if it can be detected) will force avoidance of * unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a * users general request (unlink and not. * * By default the unlink is done (if not in AUFS). However if the variable is * present and set to true (any integer > 0) then the unlink is skipped. */ #ifdef _WIN32 #define getenv(x) _wgetenv(L##x) #define atoi(x) _wtoi(x) #else #define WCHAR char #endif static int skipUnlink (Tcl_Obj* shlibFile) { /* Order of testing: * 1. On hpux we generally want to skip unlink in general * * Outside of hpux then: * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int) * 3. For general AUFS environment (statfs, if available). * * Ad 2: This variable can disable/override the AUFS detection, i.e. for * testing if a newer AUFS does not have the bug any more. * * Ad 3: This is conditionally compiled in. Condition currently must be set manually. * This part needs proper tests in the configure(.in). */ #ifdef hpux return 1; #else WCHAR *skipstr; skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK"); if (skipstr && (skipstr[0] != '\0')) { return atoi(skipstr); } #ifdef TCL_TEMPLOAD_NO_UNLINK #ifndef NO_FSTATFS { struct statfs fs; /* Have fstatfs. May not have the AUFS super magic ... Indeed our build * box is too old to have it directly in the headers. Define taken from * http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h * http://aufs.sourceforge.net/ * Better reference will be gladly taken. */ #ifndef AUFS_SUPER_MAGIC #define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's') #endif /* AUFS_SUPER_MAGIC */ if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) && (fs.f_type == AUFS_SUPER_MAGIC)) { return 1; } } #endif /* ... NO_FSTATFS */ #endif /* ... TCL_TEMPLOAD_NO_UNLINK */ /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected): * Don't skip */ return 0; #endif /* hpux */ } int Tcl_LoadFile( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code. */ const char *const symbols[],/* Names of functions to look up in the file's * symbol table. */ int flags, /* Flags */ void *procVPtrs, /* Where to return the addresses corresponding * to symbols[]. */ Tcl_LoadHandle *handlePtr) /* Filled with token for shared library * information which can be used in * TclpFindSymbol. */ { void **procPtrs = (void **) procVPtrs; const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); const Tcl_Filesystem *copyFsPtr; Tcl_FSUnloadFileProc *unloadProcPtr; Tcl_Obj *copyToPtr; Tcl_LoadHandle newLoadHandle = NULL; Tcl_LoadHandle divertedLoadHandle = NULL; Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL; FsDivertLoad *tvdlPtr; int retVal; int i; if (fsPtr == NULL) { Tcl_SetErrno(ENOENT); return TCL_ERROR; } if (fsPtr->loadFileProc != NULL) { retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc)) (interp, pathPtr, handlePtr, &unloadProcPtr, flags); if (retVal == TCL_OK) { if (*handlePtr == NULL) { return TCL_ERROR; } if (interp) { Tcl_ResetResult(interp); } goto resolveSymbols; } if (Tcl_GetErrno() != EXDEV) { return retVal; } } /* * The filesystem doesn't support 'load', so we fall back on the following * technique: * * First check if it is readable -- and exists! */ if (Tcl_FSAccess(pathPtr, R_OK) != 0) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load library \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); } return TCL_ERROR; } #ifdef TCL_LOAD_FROM_MEMORY /* * The platform supports loading code from memory, so ask for a buffer of * the appropriate size, read the file into it and load the code from the * buffer: */ { int ret, size; void *buffer; Tcl_StatBuf statBuf; Tcl_Channel data; ret = Tcl_FSStat(pathPtr, &statBuf); if (ret < 0) { goto mustCopyToTempAnyway; } size = (int) statBuf.st_size; /* * Tcl_Read takes an int: check that file size isn't wide. */ if (size != (Tcl_WideInt) statBuf.st_size) { goto mustCopyToTempAnyway; } data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666); if (!data) { goto mustCopyToTempAnyway; } buffer = TclpLoadMemoryGetBuffer(interp, size); if (!buffer) { Tcl_Close(interp, data); goto mustCopyToTempAnyway; } ret = Tcl_Read(data, buffer, size); Tcl_Close(interp, data); ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, &unloadProcPtr, flags); if (ret == TCL_OK && *handlePtr != NULL) { goto resolveSymbols; } } mustCopyToTempAnyway: if (interp) { Tcl_ResetResult(interp); } #endif /* TCL_LOAD_FROM_MEMORY */ /* * Get a temporary filename to use, first to copy the file into, and then * to load. */ copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr); if (copyToPtr == NULL) { return TCL_ERROR; } Tcl_IncrRefCount(copyToPtr); copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr); if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) { /* * We already know we can't use Tcl_FSLoadFile from this filesystem, * and we must avoid a possible infinite loop. Try to delete the file * we probably created, and then exit. */ Tcl_FSDeleteFile(copyToPtr); Tcl_DecrRefCount(copyToPtr); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't load from current filesystem", -1)); } return TCL_ERROR; } if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) != TCL_OK) { /* * Cross-platform copy failed. */ Tcl_FSDeleteFile(copyToPtr); Tcl_DecrRefCount(copyToPtr); return TCL_ERROR; } #ifndef _WIN32 /* * Do we need to set appropriate permissions on the file? This may be * required on some systems. On Unix we could loop over the file * attributes, and set any that are called "-permissions" to 0700. However * we just do this directly, like this: */ { int index; Tcl_Obj *perm; TclNewLiteralStringObj(perm, "0700"); Tcl_IncrRefCount(perm); if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) { Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm); } Tcl_DecrRefCount(perm); } #endif /* * We need to reset the result now, because the cross-filesystem copy may * have stored the number of bytes in the result. */ if (interp) { Tcl_ResetResult(interp); } retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs, &newLoadHandle); if (retVal != TCL_OK) { /* * The file didn't load successfully. */ Tcl_FSDeleteFile(copyToPtr); Tcl_DecrRefCount(copyToPtr); return retVal; } /* * Try to delete the file immediately - this is possible in some OSes, and * avoids any worries about leaving the copy laying around on exit. */ if ( !skipUnlink (copyToPtr) && (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) { Tcl_DecrRefCount(copyToPtr); /* * We tell our caller about the real shared library which was loaded. * Note that this does mean that the package list maintained by 'load' * will store the original (vfs) path alongside the temporary load * handle and unload proc ptr. */ *handlePtr = newLoadHandle; if (interp) { Tcl_ResetResult(interp); } return TCL_OK; } /* * When we unload this file, we need to divert the unloading so we can * unload and cleanup the temporary file correctly. */ tvdlPtr = ckalloc(sizeof(FsDivertLoad)); /* * Remember three pieces of information. This allows us to cleanup the * diverted load completely, on platforms which allow proper unloading of * code. */ tvdlPtr->loadHandle = newLoadHandle; tvdlPtr->unloadProcPtr = newUnloadProcPtr; if (copyFsPtr != &tclNativeFilesystem) { /* * copyToPtr is already incremented for this reference. */ tvdlPtr->divertedFile = copyToPtr; /* * This is the filesystem we loaded it into. Since we have a reference * to 'copyToPtr', we already have a refCount on this filesystem, so * we don't need to worry about it disappearing on us. */ tvdlPtr->divertedFilesystem = copyFsPtr; tvdlPtr->divertedFileNativeRep = NULL; } else { /* * We need the native rep. */ tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep( Tcl_FSGetInternalRep(copyToPtr, copyFsPtr)); /* * We don't need or want references to the copied Tcl_Obj or the * filesystem if it is the native one. */ tvdlPtr->divertedFile = NULL; tvdlPtr->divertedFilesystem = NULL; Tcl_DecrRefCount(copyToPtr); } copyToPtr = NULL; divertedLoadHandle = ckalloc(sizeof(struct Tcl_LoadHandle_)); divertedLoadHandle->clientData = tvdlPtr; divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol; divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile; *handlePtr = divertedLoadHandle; if (interp) { Tcl_ResetResult(interp); } return retVal; resolveSymbols: /* * At this point, *handlePtr is already set up to the handle for the * loaded library. We now try to resolve the symbols. */ if (symbols != NULL) { for (i=0 ; symbols[i] != NULL; i++) { procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]); if (procPtrs[i] == NULL) { /* * At least one symbol in the list was not found. Unload the * file, and report the problem back to the caller. * (Tcl_FindSymbol should already have left an appropriate * error message.) */ (*handlePtr)->unloadFileProcPtr(*handlePtr); *handlePtr = NULL; return TCL_ERROR; } } } return TCL_OK; } /* *---------------------------------------------------------------------- * * DivertFindSymbol -- * * Find a symbol in a shared library loaded by copy-from-VFS. * *---------------------------------------------------------------------- */ static void * DivertFindSymbol( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_LoadHandle loadHandle, /* Handle to the diverted module */ const char *symbol) /* Symbol to resolve */ { FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData; Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle; return originalHandle->findSymbolProcPtr(interp, originalHandle, symbol); } /* *---------------------------------------------------------------------- * * DivertUnloadFile -- * * Unloads a file that has been loaded by copying from VFS to the native * filesystem. * * Parameters: * loadHandle -- Handle of the file to unload * *---------------------------------------------------------------------- */ static void DivertUnloadFile( Tcl_LoadHandle loadHandle) { FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData; Tcl_LoadHandle originalHandle; /* * This test should never trigger, since we give the client data in the * function above. */ if (tvdlPtr == NULL) { return; } originalHandle = tvdlPtr->loadHandle; /* * Call the real 'unloadfile' proc we actually used. It is very important * that we call this first, so that the shared library is actually * unloaded by the OS. Otherwise, the following 'delete' may well fail * because the shared library is still in use. */ originalHandle->unloadFileProcPtr(originalHandle); /* * What filesystem contains the temp copy of the library? */ if (tvdlPtr->divertedFilesystem == NULL) { /* * It was the native filesystem, and we have a special function * available just for this purpose, which we know works even at this * late stage. */ TclpDeleteFile(tvdlPtr->divertedFileNativeRep); NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep); } else { /* * Remove the temporary file we created. Note, we may crash here * because encodings have been taken down already. */ if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile) != TCL_OK) { /* * The above may have failed because the filesystem, or something * it depends upon (e.g. encodings) have been taken down because * Tcl is exiting. * * We may need to work out how to delete this file more robustly * (or give the filesystem the information it needs to delete the * file more robustly). * * In particular, one problem might be that the filesystem cannot * extract the information it needs from the above path object * because Tcl's entire filesystem apparatus (the code in this * file) has been finalized, and it refuses to pass the internal * representation to the filesystem. */ } /* * And free up the allocations. This will also of course remove a * refCount from the Tcl_Filesystem to which this file belongs, which * could then free up the filesystem if we are exiting. */ Tcl_DecrRefCount(tvdlPtr->divertedFile); } ckfree(tvdlPtr); ckfree(loadHandle); } /* *---------------------------------------------------------------------- * * Tcl_FindSymbol -- * * Find a symbol in a loaded library * * Results: * Returns a pointer to the symbol if found. If not found, returns NULL * and leaves an error message in the interpreter result. * * This function was once filesystem-specific, but has been made portable by * having TclpDlopen return a structure that includes procedure pointers. * *---------------------------------------------------------------------- */ void * Tcl_FindSymbol( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_LoadHandle loadHandle, /* Handle to the loaded library */ const char *symbol) /* Name of the symbol to resolve */ { return loadHandle->findSymbolProcPtr(interp, loadHandle, symbol); } /* *---------------------------------------------------------------------- * * Tcl_FSUnloadFile -- * * Unloads a library given its handle. Checks first that the library * supports unloading. * *---------------------------------------------------------------------- */ int Tcl_FSUnloadFile( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_LoadHandle handle) /* Handle of the file to unload */ { if (handle->unloadFileProcPtr == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot unload: filesystem does not support unloading", -1)); } return TCL_ERROR; } if (handle->unloadFileProcPtr != NULL) { handle->unloadFileProcPtr(handle); } return TCL_OK; } /* *--------------------------------------------------------------------------- * * Tcl_FSLink -- * * This function replaces the library version of readlink() and can also * be used to make links. The appropriate function for the filesystem to * which pathPtr belongs will be called. * * Results: * If toPtr is NULL, then the result is a Tcl_Obj specifying the contents * of the symbolic link given by 'pathPtr', or NULL if the symbolic link * could not be read. The result is owned by the caller, which should * call Tcl_DecrRefCount when the result is no longer needed. * * If toPtr is non-NULL, then the result is toPtr if the link action was * successful, or NULL if not. In this case the result has no additional * reference count, and need not be freed. The actual action to perform * is given by the 'linkAction' flags, which is an or'd combination of: * * TCL_CREATE_SYMBOLIC_LINK * TCL_CREATE_HARD_LINK * * Note that most filesystems will not support linking across to * different filesystems, so this function will usually fail unless toPtr * is in the same FS as pathPtr. * * Side effects: * See readlink() documentation. A new filesystem link object may appear. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSLink( Tcl_Obj *pathPtr, /* Path of file to readlink or link. */ Tcl_Obj *toPtr, /* NULL or path to be linked to. */ int linkAction) /* Action to perform. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->linkProc != NULL) { return fsPtr->linkProc(pathPtr, toPtr, linkAction); } /* * If S_IFLNK isn't defined it means that the machine doesn't support * symbolic links, so the file can't possibly be a symbolic link. Generate * an EINVAL error, which is what happens on machines that do support * symbolic links when you invoke readlink on a file that isn't a symbolic * link. */ #ifndef S_IFLNK errno = EINVAL; /* TODO: Change to Tcl_SetErrno()? */ #else Tcl_SetErrno(ENOENT); #endif /* S_IFLNK */ return NULL; } /* *--------------------------------------------------------------------------- * * Tcl_FSListVolumes -- * * Lists the currently mounted volumes. The chain of functions that have * been "inserted" into the filesystem will be called in succession; each * may return a list of volumes, all of which are added to the result * until all mounted file systems are listed. * * Notice that we assume the lists returned by each filesystem (if non * NULL) have been given a refCount for us already. However, we are NOT * allowed to hang on to the list itself (it belongs to the filesystem we * called). Therefore we quite naturally add its contents to the result * we are building, and then decrement the refCount. * * Results: * The list of volumes, in an object which has refCount 0. * * Side effects: * None * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSListVolumes(void) { FilesystemRecord *fsRecPtr; Tcl_Obj *resultPtr; TclNewObj(resultPtr); /* * Call each of the "listVolumes" function in succession. A non-NULL * return value indicates the particular function has succeeded. We call * all the functions registered, since we want a list of all drives from * all filesystems. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr->listVolumesProc != NULL) { Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes); Tcl_DecrRefCount(thisFsVolumes); } } fsRecPtr = fsRecPtr->nextPtr; } Disclaim(); return resultPtr; } /* *--------------------------------------------------------------------------- * * FsListMounts -- * * List all mounts within the given directory, which match the given * pattern. * * Results: * The list of mounts, in a list object which has refCount 0, or NULL if * we didn't even find any filesystems to try to list mounts. * * Side effects: * None * *--------------------------------------------------------------------------- */ static Tcl_Obj * FsListMounts( Tcl_Obj *pathPtr, /* Contains path to directory to search. */ const char *pattern) /* Pattern to match against. */ { FilesystemRecord *fsRecPtr; Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL }; Tcl_Obj *resultPtr = NULL; /* * Call each of the "matchInDirectory" functions in succession, with the * specific type information 'mountsOnly'. A non-NULL return value * indicates the particular function has succeeded. We call all the * functions registered, since we want a list from each filesystems. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr != &tclNativeFilesystem && fsRecPtr->fsPtr->matchInDirectoryProc != NULL) { if (resultPtr == NULL) { TclNewObj(resultPtr); } fsRecPtr->fsPtr->matchInDirectoryProc(NULL, resultPtr, pathPtr, pattern, &mountsOnly); } fsRecPtr = fsRecPtr->nextPtr; } Disclaim(); return resultPtr; } /* *--------------------------------------------------------------------------- * * Tcl_FSSplitPath -- * * This function takes the given Tcl_Obj, which should be a valid path, * and returns a Tcl List object containing each segment of that path as * an element. * * Results: * Returns list object with refCount of zero. If the passed-in lenPtr is * non-NULL, we use it to return the number of elements in the returned * list. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSSplitPath( Tcl_Obj *pathPtr, /* Path to split. */ int *lenPtr) /* int to store number of path elements. */ { Tcl_Obj *result = NULL; /* Needed only to prevent gcc warnings. */ const Tcl_Filesystem *fsPtr; char separator = '/'; int driveNameLength; const char *p; /* * Perform platform specific splitting. */ if (TclFSGetPathType(pathPtr, &fsPtr, &driveNameLength) == TCL_PATH_ABSOLUTE) { if (fsPtr == &tclNativeFilesystem) { return TclpNativeSplitPath(pathPtr, lenPtr); } } else { return TclpNativeSplitPath(pathPtr, lenPtr); } /* * We assume separators are single characters. */ if (fsPtr->filesystemSeparatorProc != NULL) { Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(pathPtr); if (sep != NULL) { Tcl_IncrRefCount(sep); separator = Tcl_GetString(sep)[0]; Tcl_DecrRefCount(sep); } } /* * Place the drive name as first element of the result list. The drive * name may contain strange characters, like colons and multiple forward * slashes (for example 'ftp://' is a valid vfs drive name) */ TclNewObj(result); p = Tcl_GetString(pathPtr); Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(p, driveNameLength)); p += driveNameLength; /* * Add the remaining path elements to the list. */ for (;;) { const char *elementStart = p; int length; while ((*p != '\0') && (*p != separator)) { p++; } length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; if (elementStart[0] == '~') { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { nextElt = Tcl_NewStringObj(elementStart, length); } Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*p++ == '\0') { break; } } /* * Compute the number of elements in the result. */ if (lenPtr != NULL) { TclListObjLength(NULL, result, lenPtr); } return result; } /* *---------------------------------------------------------------------- * * TclGetPathType -- * * Helper function used by FSGetPathType. * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and * only if it is non-NULL and the function's return value is * TCL_PATH_ABSOLUTE. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_PathType TclGetPathType( Tcl_Obj *pathPtr, /* Path to determine type for. */ const Tcl_Filesystem **filesystemPtrPtr, /* If absolute path and this is not NULL, then * set to the filesystem which claims this * path. */ int *driveNameLengthPtr, /* If the path is absolute, and this is * non-NULL, then set to the length of the * driveName. */ Tcl_Obj **driveNameRef) /* If the path is absolute, and this is * non-NULL, then set to the name of the * drive, network-volume which contains the * path, already with a refCount for the * caller. */ { int pathLen; const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_PathType type; type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr, driveNameRef); if (type != TCL_PATH_ABSOLUTE) { type = TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef); if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) { *filesystemPtrPtr = &tclNativeFilesystem; } } return type; } /* *---------------------------------------------------------------------- * * TclFSNonnativePathType -- * * Helper function used by TclGetPathType. Its purpose is to check * whether the given path starts with a string which corresponds to a * file volume in any registered filesystem except the native one. For * speed and historical reasons the native filesystem has special * hard-coded checks dotted here and there in the filesystem code. * * Results: * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem * reference will be set if and only if it is non-NULL and the function's * return value is TCL_PATH_ABSOLUTE. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_PathType TclFSNonnativePathType( const char *path, /* Path to determine type for. */ int pathLen, /* Length of the path. */ const Tcl_Filesystem **filesystemPtrPtr, /* If absolute path and this is not NULL, then * set to the filesystem which claims this * path. */ int *driveNameLengthPtr, /* If the path is absolute, and this is * non-NULL, then set to the length of the * driveName. */ Tcl_Obj **driveNameRef) /* If the path is absolute, and this is * non-NULL, then set to the name of the * drive, network-volume which contains the * path, already with a refCount for the * caller. */ { FilesystemRecord *fsRecPtr; Tcl_PathType type = TCL_PATH_RELATIVE; /* * Call each of the "listVolumes" function in succession, checking whether * the given path is an absolute path on any of the volumes returned (this * is done by checking whether the path's prefix matches). */ fsRecPtr = FsGetFirstFilesystem(); Claim(); while (fsRecPtr != NULL) { /* * We want to skip the native filesystem in this loop because * otherwise we won't necessarily pass all the Tcl testsuite - this is * because some of the tests artificially change the current platform * (between Win, Unix) but the list of volumes we get by calling * fsRecPtr->fsPtr->listVolumesProc will reflect the current (real) * platform only and this may cause some tests to fail. In particular, * on Unix '/' will match the beginning of certain absolute Windows * paths starting '//' and those tests will go wrong. * * Besides these test-suite issues, there is one other reason to skip * the native filesystem - since the tclFilename.c code has nice fast * 'absolute path' checkers, we don't want to waste time repeating * that effort here, and this function is actually called quite often, * so if we can save the overhead of the native filesystem returning * us a list of volumes all the time, it is better. */ if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (fsRecPtr->fsPtr->listVolumesProc != NULL)) { int numVolumes; Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { if (TclListObjLength(NULL, thisFsVolumes, &numVolumes) != TCL_OK) { /* * This is VERY bad; the listVolumesProc didn't return a * valid list. Set numVolumes to -1 so that we skip the * while loop below and just return with the current value * of 'type'. * * It would be better if we could signal an error here * (but Tcl_Panic seems a bit excessive). */ numVolumes = -1; } while (numVolumes > 0) { Tcl_Obj *vol; int len; const char *strVol; numVolumes--; Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); strVol = Tcl_GetStringFromObj(vol,&len); if (pathLen < len) { continue; } if (strncmp(strVol, path, len) == 0) { type = TCL_PATH_ABSOLUTE; if (filesystemPtrPtr != NULL) { *filesystemPtrPtr = fsRecPtr->fsPtr; } if (driveNameLengthPtr != NULL) { *driveNameLengthPtr = len; } if (driveNameRef != NULL) { *driveNameRef = vol; Tcl_IncrRefCount(vol); } break; } } Tcl_DecrRefCount(thisFsVolumes); if (type == TCL_PATH_ABSOLUTE) { /* * We don't need to examine any more filesystems. */ break; } } } fsRecPtr = fsRecPtr->nextPtr; } Disclaim(); return type; } /* *--------------------------------------------------------------------------- * * Tcl_FSRenameFile -- * * If the two paths given belong to the same filesystem, we call that * filesystems rename function. Otherwise we simply return the POSIX * error 'EXDEV', and -1. * * Results: * Standard Tcl error code if a function was called. * * Side effects: * A file may be renamed. * *--------------------------------------------------------------------------- */ int Tcl_FSRenameFile( Tcl_Obj *srcPathPtr, /* Pathname of file or dir to be renamed * (UTF-8). */ Tcl_Obj *destPathPtr) /* New pathname of file or directory * (UTF-8). */ { int retVal = -1; const Tcl_Filesystem *fsPtr, *fsPtr2; fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr); fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr); if ((fsPtr == fsPtr2) && (fsPtr != NULL) && (fsPtr->renameFileProc != NULL)) { retVal = fsPtr->renameFileProc(srcPathPtr, destPathPtr); } if (retVal == -1) { Tcl_SetErrno(EXDEV); } return retVal; } /* *--------------------------------------------------------------------------- * * Tcl_FSCopyFile -- * * If the two paths given belong to the same filesystem, we call that * filesystem's copy function. Otherwise we simply return the POSIX error * 'EXDEV', and -1. * * Note that in the native filesystems, 'copyFileProc' is defined to copy * soft links (i.e. it copies the links themselves, not the things they * point to). * * Results: * Standard Tcl error code if a function was called. * * Side effects: * A file may be copied. * *--------------------------------------------------------------------------- */ int Tcl_FSCopyFile( Tcl_Obj *srcPathPtr, /* Pathname of file to be copied (UTF-8). */ Tcl_Obj *destPathPtr) /* Pathname of file to copy to (UTF-8). */ { int retVal = -1; const Tcl_Filesystem *fsPtr, *fsPtr2; fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr); fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr); if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyFileProc != NULL) { retVal = fsPtr->copyFileProc(srcPathPtr, destPathPtr); } if (retVal == -1) { Tcl_SetErrno(EXDEV); } return retVal; } /* *--------------------------------------------------------------------------- * * TclCrossFilesystemCopy -- * * Helper for above function, and for Tcl_FSLoadFile, to copy files from * one filesystem to another. This function will overwrite the target * file if it already exists. * * Results: * Standard Tcl error code. * * Side effects: * A file may be created. * *--------------------------------------------------------------------------- */ int TclCrossFilesystemCopy( Tcl_Interp *interp, /* For error messages. */ Tcl_Obj *source, /* Pathname of file to be copied (UTF-8). */ Tcl_Obj *target) /* Pathname of file to copy to (UTF-8). */ { int result = TCL_ERROR; int prot = 0666; Tcl_Channel in, out; Tcl_StatBuf sourceStatBuf; struct utimbuf tval; out = Tcl_FSOpenFileChannel(interp, target, "wb", prot); if (out == NULL) { /* * It looks like we cannot copy it over. Bail out... */ goto done; } in = Tcl_FSOpenFileChannel(interp, source, "rb", prot); if (in == NULL) { /* * This is very strange, caller should have checked this... */ Tcl_Close(interp, out); goto done; } /* * Copy it synchronously. We might wish to add an asynchronous option to * support vfs's which are slow (e.g. network sockets). */ if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) { result = TCL_OK; } /* * If the copy failed, assume that copy channel left a good error message. */ Tcl_Close(interp, in); Tcl_Close(interp, out); /* * Set modification date of copied file. */ if (Tcl_FSLstat(source, &sourceStatBuf) == 0) { tval.actime = Tcl_GetAccessTimeFromStat(&sourceStatBuf); tval.modtime = Tcl_GetModificationTimeFromStat(&sourceStatBuf); Tcl_FSUtime(target, &tval); } done: return result; } /* *--------------------------------------------------------------------------- * * Tcl_FSDeleteFile -- * * The appropriate function for the filesystem to which pathPtr belongs * will be called. * * Results: * Standard Tcl error code. * * Side effects: * A file may be deleted. * *--------------------------------------------------------------------------- */ int Tcl_FSDeleteFile( Tcl_Obj *pathPtr) /* Pathname of file to be removed (UTF-8). */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->deleteFileProc != NULL) { return fsPtr->deleteFileProc(pathPtr); } Tcl_SetErrno(ENOENT); return -1; } /* *--------------------------------------------------------------------------- * * Tcl_FSCreateDirectory -- * * The appropriate function for the filesystem to which pathPtr belongs * will be called. * * Results: * Standard Tcl error code. * * Side effects: * A directory may be created. * *--------------------------------------------------------------------------- */ int Tcl_FSCreateDirectory( Tcl_Obj *pathPtr) /* Pathname of directory to create (UTF-8). */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->createDirectoryProc != NULL) { return fsPtr->createDirectoryProc(pathPtr); } Tcl_SetErrno(ENOENT); return -1; } /* *--------------------------------------------------------------------------- * * Tcl_FSCopyDirectory -- * * If the two paths given belong to the same filesystem, we call that * filesystems copy-directory function. Otherwise we simply return the * POSIX error 'EXDEV', and -1. * * Results: * Standard Tcl error code if a function was called. * * Side effects: * A directory may be copied. * *--------------------------------------------------------------------------- */ int Tcl_FSCopyDirectory( Tcl_Obj *srcPathPtr, /* Pathname of directory to be copied * (UTF-8). */ Tcl_Obj *destPathPtr, /* Pathname of target directory (UTF-8). */ Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new * object containing name of file causing * error, with refCount 1. */ { int retVal = -1; const Tcl_Filesystem *fsPtr, *fsPtr2; fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr); fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr); if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyDirectoryProc != NULL){ retVal = fsPtr->copyDirectoryProc(srcPathPtr, destPathPtr, errorPtr); } if (retVal == -1) { Tcl_SetErrno(EXDEV); } return retVal; } /* *--------------------------------------------------------------------------- * * Tcl_FSRemoveDirectory -- * * The appropriate function for the filesystem to which pathPtr belongs * will be called. * * Results: * Standard Tcl error code. * * Side effects: * A directory may be deleted. * *--------------------------------------------------------------------------- */ int Tcl_FSRemoveDirectory( Tcl_Obj *pathPtr, /* Pathname of directory to be removed * (UTF-8). */ int recursive, /* If non-zero, removes directories that are * nonempty. Otherwise, will only remove empty * directories. */ Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new * object containing name of file causing * error, with refCount 1. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr == NULL || fsPtr->removeDirectoryProc == NULL) { Tcl_SetErrno(ENOENT); return -1; } /* * When working recursively, we check whether the cwd lies inside this * directory and move it if it does. */ if (recursive) { Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL); if (cwdPtr != NULL) { const char *cwdStr, *normPathStr; int cwdLen, normLen; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath != NULL) { normPathStr = Tcl_GetStringFromObj(normPath, &normLen); cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr, (size_t) normLen) == 0)) { /* * The cwd is inside the directory, so we perform a 'cd * [file dirname $path]'. */ Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr, TCL_PATH_DIRNAME); Tcl_FSChdir(dirPtr); Tcl_DecrRefCount(dirPtr); } } Tcl_DecrRefCount(cwdPtr); } } return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr); } /* *--------------------------------------------------------------------------- * * Tcl_FSGetFileSystemForPath -- * * This function determines which filesystem to use for a particular path * object, and returns the filesystem which accepts this file. If no * filesystem will accept this object as a valid file path, then NULL is * returned. * * Results: * NULL or a filesystem which will accept this path. * * Side effects: * The object may be converted to a path type. * *--------------------------------------------------------------------------- */ const Tcl_Filesystem * Tcl_FSGetFileSystemForPath( Tcl_Obj *pathPtr) { FilesystemRecord *fsRecPtr; const Tcl_Filesystem *retVal = NULL; if (pathPtr == NULL) { Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object"); return NULL; } /* * If the object has a refCount of zero, we reject it. This is to avoid * possible segfaults or nondeterministic memory leaks (i.e. the user * doesn't know if they should decrement the ref count on return or not). */ if (pathPtr->refCount == 0) { Tcl_Panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0"); return NULL; } /* * Check if the filesystem has changed in some way since this object's * internal representation was calculated. Before doing that, assure we * have the most up-to-date copy of the first filesystem. This is * accomplished by the FsGetFirstFilesystem() call. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) { Disclaim(); return NULL; } else if (retVal != NULL) { /* TODO: Can this happen? */ Disclaim(); return retVal; } /* * Call each of the "pathInFilesystem" functions in succession. A * non-return value of -1 indicates the particular function has succeeded. */ for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) { ClientData clientData = NULL; if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) { continue; } if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, &clientData)!=-1) { /* * We assume the type of pathPtr hasn't been changed by the above * call to the pathInFilesystemProc. */ TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData); Disclaim(); return fsRecPtr->fsPtr; } } Disclaim(); return NULL; } /* *--------------------------------------------------------------------------- * * Tcl_FSGetNativePath -- * * This function is for use by the Win/Unix native filesystems, so that * they can easily retrieve the native (char* or WCHAR*) representation * of a path. Other filesystems will probably want to implement similar * functions. They basically act as a safety net around * Tcl_FSGetInternalRep. Normally your file-system functions will always * be called with path objects already converted to the correct * filesystem, but if for some reason they are called directly (i.e. by * functions not in this file), then one cannot necessarily guarantee * that the path object pointer is from the correct filesystem. * * Note: in the future it might be desirable to have separate versions * of this function with different signatures, for example * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since * native paths are all string based, we use just one function. * * Results: * NULL or a valid native path. * * Side effects: * See Tcl_FSGetInternalRep. * *--------------------------------------------------------------------------- */ const void * Tcl_FSGetNativePath( Tcl_Obj *pathPtr) { return Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem); } /* *--------------------------------------------------------------------------- * * NativeFreeInternalRep -- * * Free a native internal representation, which will be non-NULL. * * Results: * None. * * Side effects: * Memory is released. * *--------------------------------------------------------------------------- */ static void NativeFreeInternalRep( ClientData clientData) { ckfree(clientData); } /* *--------------------------------------------------------------------------- * * Tcl_FSFileSystemInfo -- * * This function returns a list of two elements. The first element is the * name of the filesystem (e.g. "native" or "vfs"), and the second is the * particular type of the given path within that filesystem. * * Results: * A list of two elements. * * Side effects: * The object may be converted to a path type. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSFileSystemInfo( Tcl_Obj *pathPtr) { Tcl_Obj *resPtr; const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr == NULL) { return NULL; } resPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, resPtr, Tcl_NewStringObj(fsPtr->typeName, -1)); if (fsPtr->filesystemPathTypeProc != NULL) { Tcl_Obj *typePtr = fsPtr->filesystemPathTypeProc(pathPtr); if (typePtr != NULL) { Tcl_ListObjAppendElement(NULL, resPtr, typePtr); } } return resPtr; } /* *--------------------------------------------------------------------------- * * Tcl_FSPathSeparator -- * * This function returns the separator to be used for a given path. The * object returned should have a refCount of zero * * Results: * A Tcl object, with a refCount of zero. If the caller needs to retain a * reference to the object, it should call Tcl_IncrRefCount, and should * otherwise free the object. * * Side effects: * The path object may be converted to a path type. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSPathSeparator( Tcl_Obj *pathPtr) { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); Tcl_Obj *resultObj; if (fsPtr == NULL) { return NULL; } if (fsPtr->filesystemSeparatorProc != NULL) { return fsPtr->filesystemSeparatorProc(pathPtr); } /* * Allow filesystems not to provide a filesystemSeparatorProc if they wish * to use the standard forward slash. */ TclNewLiteralStringObj(resultObj, "/"); return resultObj; } /* *--------------------------------------------------------------------------- * * NativeFilesystemSeparator -- * * This function is part of the native filesystem support, and returns * the separator for the given path. * * Results: * String object containing the separator character. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static Tcl_Obj * NativeFilesystemSeparator( Tcl_Obj *pathPtr) { const char *separator = NULL; /* lint */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: separator = "/"; break; case TCL_PLATFORM_WINDOWS: separator = "\\"; break; } return Tcl_NewStringObj(separator,1); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclLink.c0000644000175000017500000005625714554262142015041 0ustar sergeisergei/* * tclLink.c -- * * This file implements linked variables (a C variable that is tied to a * Tcl variable). The idea of linked variables was first suggested by * Andreas Stolcke and this implementation is based heavily on a * prototype implementation provided by him. * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * For each linked variable there is a data structure of the following type, * which describes the link and is the clientData for the trace set on the Tcl * variable. */ typedef struct Link { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ Namespace *nsPtr; /* Namespace containing Tcl variable */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the * actual variable may be aliased at that time * via upvar. */ char *addr; /* Location of C variable. */ int type; /* Type of link (TCL_LINK_INT, etc.). */ union { char c; unsigned char uc; int i; unsigned int ui; short s; unsigned short us; long l; unsigned long ul; Tcl_WideInt w; Tcl_WideUInt uw; float f; double d; } lastValue; /* Last known value of C variable; used to * avoid string conversions. */ int flags; /* Miscellaneous one-bit values; see below for * definitions. */ } Link; /* * Definitions for flag bits: * LINK_READ_ONLY - 1 means errors should be generated if Tcl * script attempts to write variable. * LINK_BEING_UPDATED - 1 means that a call to Tcl_UpdateLinkedVar is * in progress for this variable, so trace * callbacks on the variable should be ignored. */ #define LINK_READ_ONLY 1 #define LINK_BEING_UPDATED 2 /* * Forward references to functions defined later in this file: */ static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp, const char *name1, const char *name2, int flags); static Tcl_Obj * ObjValue(Link *linkPtr); static int GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr); static int GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr); static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr); /* * Convenience macro for accessing the value of the C variable pointed to by a * link. Note that this macro produces something that may be regarded as an * lvalue or rvalue; it may be assigned to as well as read. Also note that * this macro assumes the name of the variable being accessed (linkPtr); this * is not strictly a good thing, but it keeps the code much shorter and * cleaner. */ #define LinkedVar(type) (*(type *) linkPtr->addr) /* *---------------------------------------------------------------------- * * Tcl_LinkVar -- * * Link a C variable to a Tcl variable so that changes to either one * causes the other to change. * * Results: * The return value is TCL_OK if everything went well or TCL_ERROR if an * error occurred (the interp's result is also set after errors). * * Side effects: * The value at *addr is linked to the Tcl variable "varName", using * "type" to convert between string values for Tcl and binary values for * *addr. * *---------------------------------------------------------------------- */ int Tcl_LinkVar( Tcl_Interp *interp, /* Interpreter in which varName exists. */ const char *varName, /* Name of a global variable in interp. */ char *addr, /* Address of a C variable to be linked to * varName. */ int type) /* Type of C variable: TCL_LINK_INT, etc. Also * may have TCL_LINK_READ_ONLY OR'ed in. */ { Tcl_Obj *objPtr; Link *linkPtr; Namespace *dummy; const char *name; int code; linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); if (linkPtr != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "variable '%s' is already linked", varName)); return TCL_ERROR; } linkPtr = ckalloc(sizeof(Link)); linkPtr->interp = interp; linkPtr->nsPtr = NULL; linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; linkPtr->type = type & ~TCL_LINK_READ_ONLY; if (type & TCL_LINK_READ_ONLY) { linkPtr->flags = LINK_READ_ONLY; } else { linkPtr->flags = 0; } objPtr = ObjValue(linkPtr); if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(linkPtr->varName); ckfree(linkPtr); return TCL_ERROR; } TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY, &(linkPtr->nsPtr), &dummy, &dummy, &name); linkPtr->nsPtr->refCount++; code = Tcl_TraceVar2(interp, varName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); if (code != TCL_OK) { Tcl_DecrRefCount(linkPtr->varName); TclNsDecrRefCount(linkPtr->nsPtr); ckfree(linkPtr); } return code; } /* *---------------------------------------------------------------------- * * Tcl_UnlinkVar -- * * Destroy the link between a Tcl variable and a C variable. * * Results: * None. * * Side effects: * If "varName" was previously linked to a C variable, the link is broken * to make the variable independent. If there was no previous link for * "varName" then nothing happens. * *---------------------------------------------------------------------- */ void Tcl_UnlinkVar( Tcl_Interp *interp, /* Interpreter containing variable to unlink */ const char *varName) /* Global variable in interp to unlink. */ { Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, NULL); if (linkPtr == NULL) { return; } Tcl_UntraceVar2(interp, varName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); Tcl_DecrRefCount(linkPtr->varName); if (linkPtr->nsPtr) { TclNsDecrRefCount(linkPtr->nsPtr); } ckfree(linkPtr); } /* *---------------------------------------------------------------------- * * Tcl_UpdateLinkedVar -- * * This function is invoked after a linked variable has been changed by C * code. It updates the Tcl variable so that traces on the variable will * trigger. * * Results: * None. * * Side effects: * The Tcl variable "varName" is updated from its C value, causing traces * on the variable to trigger. * *---------------------------------------------------------------------- */ void Tcl_UpdateLinkedVar( Tcl_Interp *interp, /* Interpreter containing variable. */ const char *varName) /* Name of global variable that is linked. */ { Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, NULL); int savedFlag; if (linkPtr == NULL) { return; } savedFlag = linkPtr->flags & LINK_BEING_UPDATED; linkPtr->flags |= LINK_BEING_UPDATED; Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); /* * Callback may have unlinked the variable. [Bug 1740631] */ linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, NULL); if (linkPtr != NULL) { linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag; } } /* *---------------------------------------------------------------------- * * LinkTraceProc -- * * This function is invoked when a linked Tcl variable is read, written, * or unset from Tcl. It's responsible for keeping the C variable in sync * with the Tcl variable. * * Results: * If all goes well, NULL is returned; otherwise an error message is * returned. * * Side effects: * The C variable may be updated to make it consistent with the Tcl * variable, or the Tcl variable may be overwritten to reject a * modification. * *---------------------------------------------------------------------- */ static char * LinkTraceProc( ClientData clientData, /* Contains information about the link. */ Tcl_Interp *interp, /* Interpreter containing Tcl variable. */ const char *name1, /* First part of variable name. */ const char *name2, /* Second part of variable name. */ int flags) /* Miscellaneous additional information. */ { Link *linkPtr = clientData; int changed; size_t valueLength; const char *value; char **pp; Tcl_Obj *valueObj; int valueInt; Tcl_WideInt valueWide; double valueDouble; /* * If the variable is being unset, then just re-create it (with a trace) * unless the whole interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) { Tcl_DecrRefCount(linkPtr->varName); if (linkPtr->nsPtr) { TclNsDecrRefCount(linkPtr->nsPtr); } ckfree(linkPtr); } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); } return NULL; } /* * If we were invoked because of a call to Tcl_UpdateLinkedVar, then don't * do anything at all. In particular, we don't want to get upset that the * variable is being modified, even if it is supposed to be read-only. */ if (linkPtr->flags & LINK_BEING_UPDATED) { return NULL; } /* * For read accesses, update the Tcl variable if the C variable has * changed since the last time we updated the Tcl variable. */ if (flags & TCL_TRACE_READS) { switch (linkPtr->type) { case TCL_LINK_INT: case TCL_LINK_BOOLEAN: changed = (LinkedVar(int) != linkPtr->lastValue.i); break; case TCL_LINK_DOUBLE: changed = (LinkedVar(double) != linkPtr->lastValue.d); break; case TCL_LINK_WIDE_INT: changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w); break; case TCL_LINK_WIDE_UINT: changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw); break; case TCL_LINK_CHAR: changed = (LinkedVar(char) != linkPtr->lastValue.c); break; case TCL_LINK_UCHAR: changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc); break; case TCL_LINK_SHORT: changed = (LinkedVar(short) != linkPtr->lastValue.s); break; case TCL_LINK_USHORT: changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us); break; case TCL_LINK_UINT: changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui); break; case TCL_LINK_LONG: changed = (LinkedVar(long) != linkPtr->lastValue.l); break; case TCL_LINK_ULONG: changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul); break; case TCL_LINK_FLOAT: changed = (LinkedVar(float) != linkPtr->lastValue.f); break; case TCL_LINK_STRING: changed = 1; break; default: return (char *) "internal error: bad linked variable type"; } if (changed) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); } return NULL; } /* * For writes, first make sure that the variable is writable. Then convert * the Tcl value to C if possible. If the variable isn't writable or can't * be converted, then restore the variable's old value and return an * error. Another tricky thing: we have to save and restore the interp's * result, since the variable access could occur when the result has been * partially set. */ if (linkPtr->flags & LINK_READ_ONLY) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "linked variable is read-only"; } valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY); if (valueObj == NULL) { /* * This shouldn't ever happen. */ return (char *) "internal error: linked variable couldn't be read"; } switch (linkPtr->type) { case TCL_LINK_INT: if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK && GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have integer value"; } LinkedVar(int) = linkPtr->lastValue.i; break; case TCL_LINK_WIDE_INT: if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK && GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have integer value"; } LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w; break; case TCL_LINK_DOUBLE: if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) { #ifdef ACCEPT_NAN if (valueObj->typePtr != &tclDoubleType) { #endif if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have real value"; } #ifdef ACCEPT_NAN } linkPtr->lastValue.d = valueObj->internalRep.doubleValue; #endif } LinkedVar(double) = linkPtr->lastValue.d; break; case TCL_LINK_BOOLEAN: if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have boolean value"; } LinkedVar(int) = linkPtr->lastValue.i; break; case TCL_LINK_CHAR: if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) || valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have char value"; } LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt; break; case TCL_LINK_UCHAR: if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) || valueInt < 0 || valueInt > UCHAR_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned char value"; } LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt; break; case TCL_LINK_SHORT: if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) || valueInt < SHRT_MIN || valueInt > SHRT_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have short value"; } LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt; break; case TCL_LINK_USHORT: if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) || valueInt < 0 || valueInt > USHRT_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned short value"; } LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt; break; case TCL_LINK_UINT: if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) || valueWide < 0 || valueWide > UINT_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned int value"; } LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide; break; case TCL_LINK_LONG: if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) || valueWide < LONG_MIN || valueWide > LONG_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have long value"; } LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide; break; case TCL_LINK_ULONG: if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned long value"; } LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide; break; case TCL_LINK_WIDE_UINT: /* * FIXME: represent as a bignum. */ if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned wide int value"; } LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide; break; case TCL_LINK_FLOAT: if ((Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK && GetInvalidDoubleFromObj(valueObj, &valueDouble) != TCL_OK) || valueDouble < -FLT_MAX || valueDouble > FLT_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have float value"; } LinkedVar(float) = linkPtr->lastValue.f = (float)valueDouble; break; case TCL_LINK_STRING: value = TclGetString(valueObj); valueLength = valueObj->length + 1; pp = (char **) linkPtr->addr; *pp = ckrealloc(*pp, valueLength); memcpy(*pp, value, valueLength); break; default: return (char *) "internal error: bad linked variable type"; } return NULL; } /* *---------------------------------------------------------------------- * * ObjValue -- * * Converts the value of a C variable to a Tcl_Obj* for use in a Tcl * variable to which it is linked. * * Results: * The return value is a pointer to a Tcl_Obj that represents the value * of the C variable given by linkPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Obj * ObjValue( Link *linkPtr) /* Structure describing linked variable. */ { char *p; Tcl_Obj *resultObj; switch (linkPtr->type) { case TCL_LINK_INT: linkPtr->lastValue.i = LinkedVar(int); return Tcl_NewIntObj(linkPtr->lastValue.i); case TCL_LINK_WIDE_INT: linkPtr->lastValue.w = LinkedVar(Tcl_WideInt); return Tcl_NewWideIntObj(linkPtr->lastValue.w); case TCL_LINK_DOUBLE: linkPtr->lastValue.d = LinkedVar(double); return Tcl_NewDoubleObj(linkPtr->lastValue.d); case TCL_LINK_BOOLEAN: linkPtr->lastValue.i = LinkedVar(int); return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0); case TCL_LINK_CHAR: linkPtr->lastValue.c = LinkedVar(char); return Tcl_NewIntObj(linkPtr->lastValue.c); case TCL_LINK_UCHAR: linkPtr->lastValue.uc = LinkedVar(unsigned char); return Tcl_NewIntObj(linkPtr->lastValue.uc); case TCL_LINK_SHORT: linkPtr->lastValue.s = LinkedVar(short); return Tcl_NewIntObj(linkPtr->lastValue.s); case TCL_LINK_USHORT: linkPtr->lastValue.us = LinkedVar(unsigned short); return Tcl_NewIntObj(linkPtr->lastValue.us); case TCL_LINK_UINT: linkPtr->lastValue.ui = LinkedVar(unsigned int); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui); case TCL_LINK_LONG: linkPtr->lastValue.l = LinkedVar(long); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l); case TCL_LINK_ULONG: linkPtr->lastValue.ul = LinkedVar(unsigned long); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul); case TCL_LINK_FLOAT: linkPtr->lastValue.f = LinkedVar(float); return Tcl_NewDoubleObj(linkPtr->lastValue.f); case TCL_LINK_WIDE_UINT: linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt); /* * FIXME: represent as a bignum. */ return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw); case TCL_LINK_STRING: p = LinkedVar(char *); if (p == NULL) { TclNewLiteralStringObj(resultObj, "NULL"); return resultObj; } return Tcl_NewStringObj(p, -1); /* * This code only gets executed if the link type is unknown (shouldn't * ever happen). */ default: TclNewLiteralStringObj(resultObj, "??"); return resultObj; } } static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static Tcl_ObjType invalidRealType = { "invalidReal", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL /* setFromAnyProc */ }; static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) { int length; const char *str; const char *endPtr; str = TclGetStringFromObj(objPtr, &length); if ((length == 1) && (str[0] == '.')){ objPtr->typePtr = &invalidRealType; objPtr->internalRep.doubleValue = 0.0; return TCL_OK; } if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr, TCL_PARSE_DECIMAL_ONLY) == TCL_OK) { /* If number is followed by [eE][+-]?, then it is an invalid * double, but it could be the start of a valid double. */ if (*endPtr == 'e' || *endPtr == 'E') { ++endPtr; if (*endPtr == '+' || *endPtr == '-') ++endPtr; if (*endPtr == 0) { double doubleValue = 0.0; Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue); if (objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr); objPtr->typePtr = &invalidRealType; objPtr->internalRep.doubleValue = doubleValue; return TCL_OK; } } } return TCL_ERROR; } /* * This function checks for integer representations, which are valid * when linking with C variables, but which are invalid in other * contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o" * (upperand lowercase). See bug [39f6304c2e]. */ int GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr) { const char *str = TclGetString(objPtr); if ((objPtr->length == 0) || ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) { *intPtr = 0; return TCL_OK; } else if ((objPtr->length == 1) && strchr("+-", str[0])) { *intPtr = (str[0] == '+'); return TCL_OK; } return TCL_ERROR; } int GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr) { int intValue; if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) { return TCL_ERROR; } *widePtr = intValue; return TCL_OK; } /* * This function checks for double representations, which are valid * when linking with C variables, but which are invalid in other * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o" * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e]. */ int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr) { int intValue; if (objPtr->typePtr == &invalidRealType) { goto gotdouble; } if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) { *doublePtr = (double) intValue; return TCL_OK; } if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) { gotdouble: *doublePtr = objPtr->internalRep.doubleValue; return TCL_OK; } return TCL_ERROR; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclListObj.c0000644000175000017500000015551414554262142015506 0ustar sergeisergei/* * tclListObj.c -- * * This file contains functions that implement the Tcl list object type. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Prototypes for functions defined later in this file: */ static List * AttemptNewList(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static List * NewListInternalRep(int objc, Tcl_Obj *const objv[], int p); static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeListInternalRep(Tcl_Obj *listPtr); static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfList(Tcl_Obj *listPtr); /* * The structure below defines the list Tcl object type by means of functions * that can be invoked by generic object code. * * The internal representation of a list object is a two-pointer * representation. The first pointer designates a List structure that contains * an array of pointers to the element objects, together with integers that * represent the current element count and the allocated size of the array. * The second pointer is normally NULL; during execution of functions in this * file that operate on nested sublists, it is occasionally used as working * storage to avoid an auxiliary stack. */ const Tcl_ObjType tclListType = { "list", /* name */ FreeListInternalRep, /* freeIntRepProc */ DupListInternalRep, /* dupIntRepProc */ UpdateStringOfList, /* updateStringProc */ SetListFromAny /* setFromAnyProc */ }; /* Macros to manipulate the List internal rep */ #define ListSetInternalRep(objPtr, listRepPtr) \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \ (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \ (listRepPtr)->refCount++, \ (objPtr)->typePtr = &tclListType #ifndef TCL_MIN_ELEMENT_GROWTH #define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *) #endif /* *---------------------------------------------------------------------- * * NewListInternalRep -- * * Creates a 'List' structure with space for 'objc' elements. 'objc' must * be > 0. If 'objv' is not NULL, The list is initialized with first * 'objc' values in that array. Otherwise the list is initialized to have * 0 elements, with space to add 'objc' more. Flag value 'p' indicates * how to behave on failure. * * Value * * A new 'List' structure with refCount 0. If some failure * prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic' * is called if it is not. * * Effect * * The refCount of each value in 'objv' is incremented as it is added * to the list. * *---------------------------------------------------------------------- */ static List * NewListInternalRep( int objc, Tcl_Obj *const objv[], int p) { List *listRepPtr; if (objc <= 0) { Tcl_Panic("NewListInternalRep: expects positive element count"); } /* * First check to see if we'd overflow and try to allocate an object * larger than our memory allocator allows. Note that this is actually a * fairly small value when you're on a serious 64-bit machine, but that * requires API changes to fix. See [Bug 219196] for a discussion. */ if ((size_t)objc > LIST_MAX) { if (p) { Tcl_Panic("max length of a Tcl list (%d elements) exceeded", LIST_MAX); } return NULL; } listRepPtr = (List *)attemptckalloc(LIST_SIZE(objc)); if (listRepPtr == NULL) { if (p) { Tcl_Panic("list creation failed: unable to alloc %u bytes", LIST_SIZE(objc)); } return NULL; } listRepPtr->canonicalFlag = 0; listRepPtr->refCount = 0; listRepPtr->maxElemCount = objc; if (objv) { Tcl_Obj **elemPtrs; int i; listRepPtr->elemCount = objc; elemPtrs = &listRepPtr->elements; for (i = 0; i < objc; i++) { elemPtrs[i] = objv[i]; Tcl_IncrRefCount(elemPtrs[i]); } } else { listRepPtr->elemCount = 0; } return listRepPtr; } /* *---------------------------------------------------------------------- * * AttemptNewList -- * * Like NewListInternalRep, but additionally sets an error message on failure. * *---------------------------------------------------------------------- */ static List * AttemptNewList( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { List *listRepPtr = NewListInternalRep(objc, objv, 0); if (interp != NULL && listRepPtr == NULL) { if (objc > LIST_MAX) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "list creation failed: unable to alloc %u bytes", LIST_SIZE(objc))); } Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return listRepPtr; } /* *---------------------------------------------------------------------- * * Tcl_NewListObj -- * * Creates a new list object and adds values to it. When TCL_MEM_DEBUG is * defined, 'Tcl_DbNewListObj' is called instead. * * Value * * A new list 'Tcl_Obj' to which is appended values from 'objv', or if * 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no * elements. The string representation of the new 'Tcl_Obj' is set to * NULL. The refCount of the list is 0. * * Effect * * The refCount of each elements in 'objv' is incremented as it is added * to the list. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewListObj Tcl_Obj * Tcl_NewListObj( int objc, /* Count of objects referenced by objv. */ Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */ { return Tcl_DbNewListObj(objc, objv, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewListObj( int objc, /* Count of objects referenced by objv. */ Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */ { List *listRepPtr; Tcl_Obj *listPtr; TclNewObj(listPtr); if (objc <= 0) { return listPtr; } /* * Create the internal rep. */ listRepPtr = NewListInternalRep(objc, objv, 1); /* * Now create the object. */ TclInvalidateStringRep(listPtr); ListSetInternalRep(listPtr, listRepPtr); return listPtr; } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewListObj -- * * Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the * file name and line number from its caller. This simplifies debugging * since the [memory active] command will report the correct file * name and line number when reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewListObj( int objc, /* Count of objects referenced by objv. */ Tcl_Obj *const objv[], /* An array of pointers to Tcl objects. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *listPtr; List *listRepPtr; TclDbNewObj(listPtr, file, line); if (objc <= 0) { return listPtr; } /* * Create the internal rep. */ listRepPtr = NewListInternalRep(objc, objv, 1); /* * Now create the object. */ TclInvalidateStringRep(listPtr); ListSetInternalRep(listPtr, listRepPtr); return listPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewListObj( int objc, /* Count of objects referenced by objv. */ Tcl_Obj *const objv[], /* An array of pointers to Tcl objects. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewListObj(objc, objv); } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_SetListObj -- * * Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of * creating a new one. * *---------------------------------------------------------------------- */ void Tcl_SetListObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ int objc, /* Count of objects referenced by objv. */ Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */ { List *listRepPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetListObj"); } /* * Free any old string rep and any internal rep for the old type. */ TclFreeIntRep(objPtr); TclInvalidateStringRep(objPtr); /* * Set the object's type to "list" and initialize the internal rep. * However, if there are no elements to put in the list, just give the * object an empty string rep and a NULL type. */ if (objc > 0) { listRepPtr = NewListInternalRep(objc, objv, 1); ListSetInternalRep(objPtr, listRepPtr); } else { objPtr->bytes = tclEmptyStringRep; objPtr->length = 0; } } /* *---------------------------------------------------------------------- * * TclListObjCopy -- * * Creates a new 'Tcl_Obj' which is a pure copy of a list value. This * provides for the C level a counterpart of the [lrange $list 0 end] * command, while using internals details to be as efficient as possible. * * Value * * The address of the new 'Tcl_Obj' which shares its internal * representation with 'listPtr', and whose refCount is 0. If 'listPtr' * is not actually a list, the value is NULL, and an error message is left * in 'interp' if it is not NULL. * * Effect * * 'listPtr' is converted to a list if it isn't one already. * *---------------------------------------------------------------------- */ Tcl_Obj * TclListObjCopy( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr) /* List object for which an element array is * to be returned. */ { Tcl_Obj *copyPtr; if (listPtr->typePtr != &tclListType) { if (SetListFromAny(interp, listPtr) != TCL_OK) { return NULL; } } TclNewObj(copyPtr); TclInvalidateStringRep(copyPtr); DupListInternalRep(listPtr, copyPtr); return copyPtr; } /* *---------------------------------------------------------------------- * * Tcl_ListObjGetElements -- * * Retreive the elements in a list 'Tcl_Obj'. * * Value * * TCL_OK * * A count of list elements is stored, 'objcPtr', And a pointer to the * array of elements in the list is stored in 'objvPtr'. * * The elements accessible via 'objvPtr' should be treated as readonly * and the refCount for each object is _not_ incremented; the caller * must do that if it holds on to a reference. Furthermore, the * pointer and length returned by this function may change as soon as * any function is called on the list object. Be careful about * retaining the pointer in a local data structure. * * TCL_ERROR * * 'listPtr' is not a valid list. An error message is left in the * interpreter's result if 'interp' is not NULL. * * Effect * * 'listPtr' is converted to a list object if it isn't one already. * *---------------------------------------------------------------------- */ int Tcl_ListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object for which an element array is * to be returned. */ int *objcPtr, /* Where to store the count of objects * referenced by objv. */ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of * pointers to the list's objects. */ { List *listRepPtr; if (listPtr->typePtr != &tclListType) { int result; if (listPtr->bytes == tclEmptyStringRep) { *objcPtr = 0; *objvPtr = NULL; return TCL_OK; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); *objcPtr = listRepPtr->elemCount; *objvPtr = &listRepPtr->elements; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ListObjAppendList -- * * Appends the elements of elemListPtr to those of listPtr. * * Value * * TCL_OK * * Success. * * TCL_ERROR * * 'listPtr' or 'elemListPtr' are not valid lists. An error * message is left in the interpreter's result if 'interp' is not NULL. * * Effect * * The reference count of each element of 'elemListPtr' as it is added to * 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType' * if they are not already. Appending the new elements may cause the * array of element pointers in 'listObj' to grow. If any objects are * appended to 'listPtr'. Any preexisting string representation of * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ int Tcl_ListObjAppendList( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append elements to. */ Tcl_Obj *elemListPtr) /* List obj with elements to append. */ { int objc; Tcl_Obj **objv; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList"); } /* * Pull the elements to append from elemListPtr. */ if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) { return TCL_ERROR; } /* * Insert the new elements starting after the lists's last element. * Delete zero existing elements. */ return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv); } /* *---------------------------------------------------------------------- * * Tcl_ListObjAppendElement -- * * Like 'Tcl_ListObjAppendList', but Appends a single value to a list. * * Value * * TCL_OK * * 'objPtr' is appended to the elements of 'listPtr'. * * TCL_ERROR * * listPtr does not refer to a list object and the object can not be * converted to one. An error message will be left in the * interpreter's result if interp is not NULL. * * Effect * * If 'listPtr' is not already of type 'tclListType', it is converted. * The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'. * Appending the new element may cause the array of element pointers * in 'listObj' to grow. Any preexisting string representation of * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ int Tcl_ListObjAppendElement( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append objPtr to. */ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ { List *listRepPtr, *newPtr = NULL; int numElems, numRequired, needGrow, isShared, attempt; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement"); } if (listPtr->typePtr != &tclListType) { int result; if (listPtr->bytes == tclEmptyStringRep) { Tcl_SetListObj(listPtr, 1, &objPtr); return TCL_OK; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); numElems = listRepPtr->elemCount; numRequired = numElems + 1 ; needGrow = (numRequired > listRepPtr->maxElemCount); isShared = (listRepPtr->refCount > 1); if (numRequired > LIST_MAX) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; } if (needGrow && !isShared) { /* * Need to grow + unshared internalrep => try to realloc */ attempt = 2 * numRequired; if (attempt <= LIST_MAX) { newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired; newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr) { listRepPtr = newPtr; listRepPtr->maxElemCount = attempt; needGrow = 0; } } if (isShared || needGrow) { Tcl_Obj **dst, **src = &listRepPtr->elements; /* * Either we have a shared internalrep and we must copy to write, or we * need to grow and realloc attempts failed. Attempt internalrep copy. */ attempt = 2 * numRequired; newPtr = AttemptNewList(NULL, attempt, NULL); if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } newPtr = AttemptNewList(NULL, attempt, NULL); } if (newPtr == NULL) { attempt = numRequired; newPtr = AttemptNewList(interp, attempt, NULL); } if (newPtr == NULL) { /* * All growth attempts failed; throw the error. */ return TCL_ERROR; } dst = &newPtr->elements; newPtr->refCount++; newPtr->canonicalFlag = listRepPtr->canonicalFlag; newPtr->elemCount = listRepPtr->elemCount; if (isShared) { /* * The original internalrep must remain undisturbed. Copy into the new * one and bump refcounts */ while (numElems--) { *dst = *src++; Tcl_IncrRefCount(*dst++); } listRepPtr->refCount--; } else { /* * Old internalrep to be freed, re-use refCounts. */ memcpy(dst, src, numElems * sizeof(Tcl_Obj *)); ckfree(listRepPtr); } listRepPtr = newPtr; } listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; /* * Add objPtr to the end of listPtr's array of element pointers. Increment * the ref count for the (now shared) objPtr. */ *(&listRepPtr->elements + listRepPtr->elemCount) = objPtr; Tcl_IncrRefCount(objPtr); listRepPtr->elemCount++; /* * Invalidate any old string representation since the list's internal * representation has changed. */ TclInvalidateStringRep(listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ListObjIndex -- * * Retrieve a pointer to the element of 'listPtr' at 'index'. The index * of the first element is 0. * * Value * * TCL_OK * * A pointer to the element at 'index' is stored in 'objPtrPtr'. If * 'index' is out of range, NULL is stored in 'objPtrPtr'. This * object should be treated as readonly and its 'refCount' is _not_ * incremented. The caller must do that if it holds on to the * reference. * * TCL_ERROR * * 'listPtr' is not a valid list. An error message is left in the * interpreter's result if 'interp' is not NULL. * * Effect * * If 'listPtr' is not already of type 'tclListType', it is converted. * *---------------------------------------------------------------------- */ int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to index into. */ int index, /* Index of element to return. */ Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ { List *listRepPtr; if (listPtr->typePtr != &tclListType) { int result; if (listPtr->bytes == tclEmptyStringRep) { *objPtrPtr = NULL; return TCL_OK; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); if ((index < 0) || (index >= listRepPtr->elemCount)) { *objPtrPtr = NULL; } else { *objPtrPtr = (&listRepPtr->elements)[index]; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ListObjLength -- * * Retrieve the number of elements in a list. * * Value * * TCL_OK * * A count of list elements is stored at the address provided by * 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is * converted. * * TCL_ERROR * * 'listPtr' is not a valid list. An error message will be left in * the interpreter's result if 'interp' is not NULL. * *---------------------------------------------------------------------- */ int Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object whose #elements to return. */ int *intPtr) /* The resulting int is stored here. */ { List *listRepPtr; if (listPtr->typePtr != &tclListType) { int result; if (listPtr->bytes == tclEmptyStringRep) { *intPtr = 0; return TCL_OK; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); *intPtr = listRepPtr->elemCount; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ListObjReplace -- * * Replace values in a list. * * If 'first' is zero or negative, it refers to the first element. If * 'first' outside the range of elements in the list, no elements are * deleted. * * If 'count' is zero or negative no elements are deleted, and any new * elements are inserted at the beginning of the list. * * Value * * TCL_OK * * The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr' * starting at 'first'. If 'objc' 0, no new elements are added. * * TCL_ERROR * * 'listPtr' is not a valid list. An error message is left in the * interpreter's result if 'interp' is not NULL. * * Effect * * If 'listPtr' is not of type 'tclListType', it is converted if possible. * * The 'refCount' of each element appended to the list is incremented. * Similarly, the 'refCount' for each replaced element is decremented. * * If 'listPtr' is modified, any previous string representation is * invalidated. * *---------------------------------------------------------------------- */ int Tcl_ListObjReplace( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *listPtr, /* List object whose elements to replace. */ int first, /* Index of first element to replace. */ int count, /* Number of elements to replace. */ int objc, /* Number of objects to insert. */ Tcl_Obj *const objv[]) /* An array of objc pointers to Tcl objects to * insert. */ { List *listRepPtr; Tcl_Obj **elemPtrs; int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } if (listPtr->typePtr != &tclListType) { if (listPtr->bytes == tclEmptyStringRep) { if (!objc) { return TCL_OK; } Tcl_SetListObj(listPtr, objc, NULL); } else { int result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } } /* * Note that when count == 0 and objc == 0, this routine is logically a * no-op, removing and adding no elements to the list. However, by flowing * through this routine anyway, we get the important side effect that the * resulting listPtr is a list in canonical form. This is important. * Resist any temptation to optimize this case. */ listRepPtr = ListRepPtr(listPtr); elemPtrs = &listRepPtr->elements; numElems = listRepPtr->elemCount; if (first < 0) { first = 0; } if (first >= numElems) { first = numElems; /* So we'll insert after last element. */ } if (count < 0) { count = 0; } else if (count > LIST_MAX /* Handle integer overflow */ || numElems < first+count) { count = numElems - first; } if (objc > LIST_MAX - (numElems - count)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); } return TCL_ERROR; } isShared = (listRepPtr->refCount > 1); numRequired = numElems - count + objc; /* Known <= LIST_MAX */ needGrow = numRequired > listRepPtr->maxElemCount; for (i = 0; i < objc; i++) { Tcl_IncrRefCount(objv[i]); } if (needGrow && !isShared) { /* Try to use realloc */ List *newPtr = NULL; int attempt = 2 * numRequired; if (attempt <= LIST_MAX) { newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired; newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr) { listRepPtr = newPtr; listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; elemPtrs = &listRepPtr->elements; listRepPtr->maxElemCount = attempt; needGrow = numRequired > listRepPtr->maxElemCount; } } if (!needGrow && !isShared) { int shift; /* * Can use the current List struct. First "delete" count elements * starting at first. */ for (j = first; j < first + count; j++) { Tcl_Obj *victimPtr = elemPtrs[j]; TclDecrRefCount(victimPtr); } /* * Shift the elements after the last one removed to their new * locations. */ start = first + count; numAfterLast = numElems - start; shift = objc - count; /* numNewElems - numDeleted */ if ((numAfterLast > 0) && (shift != 0)) { Tcl_Obj **src = elemPtrs + start; memmove(src+shift, src, numAfterLast * sizeof(Tcl_Obj*)); } } else { /* * Cannot use the current List struct; it is shared, too small, or * both. Allocate a new struct and insert elements into it. */ List *oldListRepPtr = listRepPtr; Tcl_Obj **oldPtrs = elemPtrs; int newMax; if (needGrow){ newMax = 2 * numRequired; } else { newMax = listRepPtr->maxElemCount; } listRepPtr = AttemptNewList(NULL, newMax, NULL); if (listRepPtr == NULL) { unsigned int limit = LIST_MAX - numRequired; unsigned int extra = numRequired - numElems + TCL_MIN_ELEMENT_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL); if (listRepPtr == NULL) { listRepPtr = AttemptNewList(interp, numRequired, NULL); if (listRepPtr == NULL) { for (i = 0; i < objc; i++) { /* See bug 3598580 */ objv[i]->refCount--; } return TCL_ERROR; } } } listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; listRepPtr->refCount++; elemPtrs = &listRepPtr->elements; if (isShared) { /* * The old struct will remain in place; need new refCounts for the * new List struct references. Copy over only the surviving * elements. */ for (i=0; i < first; i++) { elemPtrs[i] = oldPtrs[i]; Tcl_IncrRefCount(elemPtrs[i]); } for (i = first + count, j = first + objc; j < numRequired; i++, j++) { elemPtrs[j] = oldPtrs[i]; Tcl_IncrRefCount(elemPtrs[j]); } oldListRepPtr->refCount--; } else { /* * The old struct will be removed; use its inherited refCounts. */ if (first > 0) { memcpy(elemPtrs, oldPtrs, first * sizeof(Tcl_Obj *)); } /* * "Delete" count elements starting at first. */ for (j = first; j < first + count; j++) { Tcl_Obj *victimPtr = oldPtrs[j]; TclDecrRefCount(victimPtr); } /* * Copy the elements after the last one removed, shifted to their * new locations. */ start = first + count; numAfterLast = numElems - start; if (numAfterLast > 0) { memcpy(elemPtrs + first + objc, oldPtrs + start, (size_t) numAfterLast * sizeof(Tcl_Obj *)); } ckfree(oldListRepPtr); } } /* * Insert the new elements into elemPtrs before "first". */ for (i=0,j=first ; ielemCount = numRequired; /* * Invalidate and free any old string representation since it no longer * reflects the list's internal representation. */ TclInvalidateStringRep(listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclLindexList -- * * Implements the 'lindex' command when objc==3. * * Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures * the argument format into required form while taking care to manage * shimmering so as to tend to keep the most useful internalreps * and/or avoid the most expensive conversions. * * Value * * A pointer to the specified element, with its 'refCount' incremented, or * NULL if an error occurred. * * Notes * *---------------------------------------------------------------------- */ Tcl_Obj * TclLindexList( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* List being unpacked. */ Tcl_Obj *argPtr) /* Index or index list. */ { int index; /* Index into the list. */ Tcl_Obj *indexListCopy; /* * Determine whether argPtr designates a list or a single index. We have * to be careful about the order of the checks to avoid repeated * shimmering; see TIP#22 and TIP#33 for the details. */ if (argPtr->typePtr != &tclListType && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) { /* * argPtr designates a single index. */ return TclLindexFlat(interp, listPtr, 1, &argPtr); } /* * Here we make a private copy of the index list argument to avoid any * shimmering issues that might invalidate the indices array below while * we are still using it. This is probably unnecessary. It does not appear * that any damaging shimmering is possible, and no test has been devised * to show any error when this private copy is not made. But it's cheap, * and it offers some future-proofing insurance in case the TclLindexFlat * implementation changes in some unexpected way, or some new form of * trace or callback permits things to happen that the current * implementation does not. */ indexListCopy = TclListObjCopy(NULL, argPtr); if (indexListCopy == NULL) { /* * argPtr designates something that is neither an index nor a * well-formed list. Report the error via TclLindexFlat. */ return TclLindexFlat(interp, listPtr, 1, &argPtr); } { int indexCount = -1; /* Size of the array of list indices. */ Tcl_Obj **indices = NULL; /* Array of list indices. */ TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices); listPtr = TclLindexFlat(interp, listPtr, indexCount, indices); } Tcl_DecrRefCount(indexListCopy); return listPtr; } /* *---------------------------------------------------------------------- * * TclLindexFlat -- * * The core of the 'lindex' command, with all index * arguments presented as a flat list. * * Value * * A pointer to the object extracted, with its 'refCount' incremented, or * NULL if an error occurred. Thus, the calling code will usually do * something like: * * Tcl_SetObjResult(interp, result); * Tcl_DecrRefCount(result); * * *---------------------------------------------------------------------- */ Tcl_Obj * TclLindexFlat( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* Tcl object representing the list. */ int indexCount, /* Count of indices. */ Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that * represent the indices in the list. */ { int i; Tcl_IncrRefCount(listPtr); for (i=0 ; i error. */ break; } TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs); if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1, &index) == TCL_OK) { if (index<0 || index>=listLen) { /* * Index is out of range. Break out of loop with empty result. * First check remaining indices for validity */ while (++i < indexCount) { if (TclGetIntForIndexM(interp, indexArray[i], -1, &index) != TCL_OK) { Tcl_DecrRefCount(sublistCopy); return NULL; } } TclNewObj(listPtr); } else { /* * Extract the pointer to the appropriate element. */ listPtr = elemPtrs[index]; } Tcl_IncrRefCount(listPtr); } Tcl_DecrRefCount(sublistCopy); } return listPtr; } /* *---------------------------------------------------------------------- * * TclLsetList -- * * The core of [lset] when objc == 4. Objv[2] may be either a * scalar index or a list of indices. * * Implemented entirely as a wrapper around 'TclLindexFlat', as described * for 'TclLindexList'. * * Value * * The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if * there was an error. * *---------------------------------------------------------------------- */ Tcl_Obj * TclLsetList( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* Pointer to the list being modified. */ Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */ { int indexCount = 0; /* Number of indices in the index list. */ Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */ Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */ int index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; /* * Determine whether the index arg designates a list or a single index. * We have to be careful about the order of the checks to avoid repeated * shimmering; see TIP #22 and #23 for details. */ if (indexArgPtr->typePtr != &tclListType && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) { /* * indexArgPtr designates a single index. */ return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr); } indexListCopy = TclListObjCopy(NULL, indexArgPtr); if (indexListCopy == NULL) { /* * indexArgPtr designates something that is neither an index nor a * well formed list. Report the error via TclLsetFlat. */ return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr); } TclListObjGetElements(NULL, indexArgPtr, &indexCount, &indices); /* * Let TclLsetFlat perform the actual lset operation. */ retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr); Tcl_DecrRefCount(indexListCopy); return retValuePtr; } /* *---------------------------------------------------------------------- * * TclLsetFlat -- * * Core engine of the 'lset' command. * * Value * * The resulting list * * The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not * duplicated, its 'refCount' is incremented. The reference count of * an unduplicated object is therefore 2 (one for the returned pointer * and one for the variable that holds it). The reference count of a * duplicate object is 1, reflecting that result is the only active * reference. The caller is expected to store the result in the * variable and decrement its reference count. (INST_STORE_* does * exactly this.) * * NULL * * An error occurred. If 'listPtr' was duplicated, the reference * count on the duplicate is decremented so that it is 0, causing any * memory allocated by this function to be freed. * * * Effect * * On entry, the reference count of 'listPtr' does not reflect any * references held on the stack. The first action of this function is to * determine whether 'listPtr' is shared and to create a duplicate * unshared copy if it is. The reference count of the duplicate is * incremented. At this point, the reference count is 1 in either case so * that the object is considered unshared. * * The unshared list is altered directly to produce the result. * 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string * representations must be spoilt by threading via 'ptr2' of the * two-pointer internal representation. On entry to 'TclLsetFlat', the * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any * Tcl_Obj that has been modified is set to NULL. * *---------------------------------------------------------------------- */ Tcl_Obj * TclLsetFlat( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* Pointer to the list being modified. */ int indexCount, /* Number of index args. */ Tcl_Obj *const indexArray[], /* Index args. */ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */ { int index, result, len; Tcl_Obj *subListPtr, *retValuePtr, *chainPtr; /* * If there are no indices, simply return the new value. (Without * indices, [lset] is a synonym for [set]. */ if (indexCount == 0) { Tcl_IncrRefCount(valuePtr); return valuePtr; } /* * If the list is shared, make a copy we can modify (copy-on-write). We * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons: * 1) we have not yet confirmed listPtr is actually a list; 2) We make a * verbatim copy of any existing string rep, and when we combine that with * the delayed invalidation of string reps of modified Tcl_Obj's * implemented below, the outcome is that any error condition that causes * this routine to return NULL, will leave the string rep of listPtr and * all elements to be unchanged. */ subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr; /* * Anchor the linked list of Tcl_Obj's whose string reps must be * invalidated if the operation succeeds. */ retValuePtr = subListPtr; chainPtr = NULL; result = TCL_OK; /* * Loop through all the index arguments, and for each one dive into the * appropriate sublist. */ do { int elemCount; Tcl_Obj *parentList, **elemPtrs; /* * Check for the possible error conditions... */ if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs) != TCL_OK) { /* ...the sublist we're indexing into isn't a list at all. */ result = TCL_ERROR; break; } /* * WARNING: the macro TclGetIntForIndexM is not safe for * post-increments, avoid '*indexArray++' here. */ if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index) != TCL_OK) { /* ...the index we're trying to use isn't an index at all. */ result = TCL_ERROR; indexArray++; break; } indexArray++; if (index < 0 || index > elemCount) { /* ...the index points outside the sublist. */ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", NULL); } result = TCL_ERROR; break; } /* * No error conditions. As long as we're not yet on the last index, * determine the next sublist for the next pass through the loop, and * take steps to make sure it is an unshared copy, as we intend to * modify it. */ if (--indexCount) { parentList = subListPtr; if (index == elemCount) { TclNewObj(subListPtr); } else { subListPtr = elemPtrs[index]; } if (Tcl_IsShared(subListPtr)) { subListPtr = Tcl_DuplicateObj(subListPtr); } /* * Replace the original elemPtr[index] in parentList with a copy * we know to be unshared. This call will also deal with the * situation where parentList shares its internalrep with other * Tcl_Obj's. Dealing with the shared internalrep case can cause * subListPtr to become shared again, so detect that case and make * and store another copy. */ if (index == elemCount) { Tcl_ListObjAppendElement(NULL, parentList, subListPtr); } else { TclListObjSetElement(NULL, parentList, index, subListPtr); } if (Tcl_IsShared(subListPtr)) { subListPtr = Tcl_DuplicateObj(subListPtr); TclListObjSetElement(NULL, parentList, index, subListPtr); } /* * The TclListObjSetElement() calls do not spoil the string rep of * parentList, and that's fine for now, since all we've done so * far is replace a list element with an unshared copy. The list * value remains the same, so the string rep. is still valid, and * unchanged, which is good because if this whole routine returns * NULL, we'd like to leave no change to the value of the lset * variable. Later on, when we set valuePtr in its proper place, * then all containing lists will have their values changed, and * will need their string reps spoiled. We maintain a list of all * those Tcl_Obj's (via a little internalrep surgery) so we can spoil * them at that time. */ parentList->internalRep.twoPtrValue.ptr2 = chainPtr; chainPtr = parentList; } } while (indexCount > 0); /* * Either we've detected and error condition, and exited the loop with * result == TCL_ERROR, or we've successfully reached the last index, and * we're ready to store valuePtr. In either case, we need to clean up our * string spoiling list of Tcl_Obj's. */ while (chainPtr) { Tcl_Obj *objPtr = chainPtr; if (result == TCL_OK) { /* * We're going to store valuePtr, so spoil string reps of all * containing lists. */ TclInvalidateStringRep(objPtr); } /* * Clear away our internalrep surgery mess. */ chainPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr2; objPtr->internalRep.twoPtrValue.ptr2 = NULL; } if (result != TCL_OK) { /* * Error return; message is already in interp. Clean up any excess * memory. */ if (retValuePtr != listPtr) { Tcl_DecrRefCount(retValuePtr); } return NULL; } /* * Store valuePtr in proper sublist and return. The -1 is to avoid a * compiler warning (not a problem because we checked that we have a * proper list - or something convertible to one - above). */ len = -1; TclListObjLength(NULL, subListPtr, &len); if (index == len) { Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); } else { TclListObjSetElement(NULL, subListPtr, index, valuePtr); } TclInvalidateStringRep(subListPtr); Tcl_IncrRefCount(retValuePtr); return retValuePtr; } /* *---------------------------------------------------------------------- * * TclListObjSetElement -- * * Set a single element of a list to a specified value. * * It is the caller's responsibility to invalidate the string * representation of the 'listPtr'. * * Value * * TCL_OK * * Success. * * TCL_ERROR * * 'listPtr' does not refer to a list object and cannot be converted * to one. An error message will be left in the interpreter result if * interp is not NULL. * * TCL_ERROR * * An index designates an element outside the range [0..listLength-1], * where 'listLength' is the count of elements in the list object * designated by 'listPtr'. An error message is left in the * interpreter result. * * Effect * * If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If * 'listPtr' is not already of type 'tclListType', it is converted and the * internal representation is unshared. The 'refCount' of the element at * 'index' is decremented and replaced in the list with the 'valuePtr', * whose 'refCount' in turn is incremented. * * *---------------------------------------------------------------------- */ int TclListObjSetElement( Tcl_Interp *interp, /* Tcl interpreter; used for error reporting * if not NULL. */ Tcl_Obj *listPtr, /* List object in which element should be * stored. */ int index, /* Index of element to store. */ Tcl_Obj *valuePtr) /* Tcl object to store in the designated list * element. */ { List *listRepPtr; /* Internal representation of the list being * modified. */ Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */ int elemCount; /* Number of elements in the list. */ /* * Ensure that the listPtr parameter designates an unshared list. */ if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "TclListObjSetElement"); } if (listPtr->typePtr != &tclListType) { int result; if (listPtr->bytes == tclEmptyStringRep) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", NULL); } return TCL_ERROR; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); elemCount = listRepPtr->elemCount; /* * Ensure that the index is in bounds. */ if (index<0 || index>=elemCount) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", NULL); } return TCL_ERROR; } /* * If the internal rep is shared, replace it with an unshared copy. */ if (listRepPtr->refCount > 1) { Tcl_Obj **dst, **src = &listRepPtr->elements; List *newPtr = AttemptNewList(NULL, listRepPtr->maxElemCount, NULL); if (newPtr == NULL) { newPtr = AttemptNewList(interp, elemCount, NULL); if (newPtr == NULL) { return TCL_ERROR; } } newPtr->refCount++; newPtr->elemCount = elemCount; newPtr->canonicalFlag = listRepPtr->canonicalFlag; dst = &newPtr->elements; while (elemCount--) { *dst = *src++; Tcl_IncrRefCount(*dst++); } listRepPtr->refCount--; listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr; } elemPtrs = &listRepPtr->elements; /* * Add a reference to the new list element. */ Tcl_IncrRefCount(valuePtr); /* * Remove a reference from the old list element. */ Tcl_DecrRefCount(elemPtrs[index]); /* * Stash the new object in the list. */ elemPtrs[index] = valuePtr; return TCL_OK; } /* *---------------------------------------------------------------------- * * FreeListInternalRep -- * * Deallocate the storage associated with the internal representation of a * a list object. * * Effect * * The storage for the internal 'List' pointer of 'listPtr' is freed, the * 'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount' * of each element of the list is decremented. * *---------------------------------------------------------------------- */ static void FreeListInternalRep( Tcl_Obj *listPtr) /* List object with internal rep to free. */ { List *listRepPtr = ListRepPtr(listPtr); if (listRepPtr->refCount-- <= 1) { Tcl_Obj **elemPtrs = &listRepPtr->elements; int i, numElems = listRepPtr->elemCount; for (i = 0; i < numElems; i++) { Tcl_DecrRefCount(elemPtrs[i]); } ckfree(listRepPtr); } listPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DupListInternalRep -- * * Initialize the internal representation of a list 'Tcl_Obj' to share the * internal representation of an existing list object. * * Effect * * The 'refCount' of the List internal rep is incremented. * *---------------------------------------------------------------------- */ static void DupListInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { List *listRepPtr = ListRepPtr(srcPtr); ListSetInternalRep(copyPtr, listRepPtr); } /* *---------------------------------------------------------------------- * * SetListFromAny -- * * Convert any object to a list. * * Value * * TCL_OK * * Success. The internal representation of 'objPtr' is set, and the type * of 'objPtr' is 'tclListType'. * * TCL_ERROR * * An error occured during conversion. An error message is left in the * interpreter's result if 'interp' is not NULL. * * *---------------------------------------------------------------------- */ static int SetListFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { List *listRepPtr; Tcl_Obj **elemPtrs; /* * Dictionaries are a special case; they have a string representation such * that *all* valid dictionaries are valid lists. Hence we can convert * more directly. Only do this when there's no existing string rep; if * there is, it is the string rep that's authoritative (because it could * describe duplicate keys). */ if (objPtr->typePtr == &tclDictType && !objPtr->bytes) { Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done, size; /* * Create the new list representation. Note that we do not need to do * anything with the string representation as the transformation (and * the reverse back to a dictionary) are both order-preserving. Also * note that since we know we've got a valid dictionary (by * representation) we also know that fetching the size of the * dictionary or iterating over it will not fail. */ Tcl_DictObjSize(NULL, objPtr, &size); listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL); if (!listRepPtr) { return TCL_ERROR; } listRepPtr->elemCount = 2 * size; /* * Populate the list representation. */ elemPtrs = &listRepPtr->elements; Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done); while (!done) { *elemPtrs++ = keyPtr; *elemPtrs++ = valuePtr; Tcl_IncrRefCount(keyPtr); Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } } else { int estCount, length; const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length); /* * Allocate enough space to hold a (Tcl_Obj *) for each * (possible) list element. */ estCount = TclMaxListLength(nextElem, length, &limit); estCount += (estCount == 0); /* Smallest list struct holds 1 * element. */ listRepPtr = AttemptNewList(interp, estCount, NULL); if (listRepPtr == NULL) { return TCL_ERROR; } elemPtrs = &listRepPtr->elements; /* * Each iteration, parse and store a list element. */ while (nextElem < limit) { const char *elemStart; int elemSize, literal; if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { while (--elemPtrs >= &listRepPtr->elements) { Tcl_DecrRefCount(*elemPtrs); } ckfree((char *) listRepPtr); return TCL_ERROR; } if (elemStart == limit) { break; } /* TODO: replace panic with error on alloc failure? */ if (literal) { TclNewStringObj(*elemPtrs, elemStart, elemSize); } else { TclNewObj(*elemPtrs); (*elemPtrs)->bytes = (char *)ckalloc((unsigned) elemSize + 1); (*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart, (*elemPtrs)->bytes); } Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */ } listRepPtr->elemCount = elemPtrs - &listRepPtr->elements; } /* * Free the old internalRep before setting the new one. We do this as late * as possible to allow the conversion code, in particular * Tcl_GetStringFromObj, to use that old internalRep. */ TclFreeIntRep(objPtr); ListSetInternalRep(objPtr, listRepPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * UpdateStringOfList -- * * Update the string representation for a list object. * * Any previously-existing string representation is not invalidated, so * storage is lost if this has not been taken care of. * * Effect * * The string representation of 'listPtr' is set to the resulting string. * This string will be empty if the list has no elements. It is assumed * that the list internal representation is not NULL. * *---------------------------------------------------------------------- */ static void UpdateStringOfList( Tcl_Obj *listPtr) /* List object with string rep to update. */ { # define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; List *listRepPtr = ListRepPtr(listPtr); int numElems = listRepPtr->elemCount; int i, length; unsigned int bytesNeeded = 0; const char *elem; char *dst; Tcl_Obj **elemPtrs; /* * Mark the list as being canonical; although it will now have a string * rep, it is one we derived through proper "canonical" quoting and so * it's known to be free from nasties relating to [concat] and [eval]. */ listRepPtr->canonicalFlag = 1; /* * Handle empty list case first, so rest of the routine is simpler. */ if (numElems == 0) { listPtr->bytes = tclEmptyStringRep; listPtr->length = 0; return; } /* * Pass 1: estimate space, gather flags. */ if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { /* * We know numElems <= LIST_MAX, so this is safe. */ flagPtr = (char *)ckalloc(numElems); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } } if (bytesNeeded + numElems > INT_MAX + 1U) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; /* * Pass 2: copy into string rep buffer. */ /* * We used to set the string length here, relying on a presumed * guarantee that the number of bytes TclScanElement() calls reported * to be needed was a precise count and not an over-estimate, so long * as the same flag values were passed to TclConvertElement(). * * Then we saw [35a8f1c04a], where a bug in TclScanElement() caused * that guarantee to fail. Rather than trust there are no more bugs, * we set the length after the loop based on what was actually written, * an not on what was predicted. * listPtr->length = bytesNeeded - 1; * */ listPtr->bytes = (char *)ckalloc(bytesNeeded); dst = listPtr->bytes; for (i = 0; i < numElems; i++) { flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; } dst[-1] = '\0'; /* Here is the safe setting of the string length. */ listPtr->length = dst - 1 - listPtr->bytes; if (flagPtr != localFlags) { ckfree(flagPtr); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclLiteral.c0000644000175000017500000010644514554262142015533 0ustar sergeisergei/* * tclLiteral.c -- * * Implementation of the global and ByteCode-local literal tables used to * manage the Tcl objects created for literal values during compilation * of Tcl scripts. This implementation borrows heavily from the more * general hashtable implementation of Tcl hash tables that appears in * tclHash.c. * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" /* * When there are this many entries per bucket, on average, rebuild a * literal's hash table to make it larger. */ #define REBUILD_MULTIPLIER 3 /* * Function prototypes for static functions in this file: */ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); static unsigned HashString(const char *string, int length); #ifdef TCL_COMPILE_DEBUG static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif static void RebuildLiteralTable(LiteralTable *tablePtr); /* *---------------------------------------------------------------------- * * TclInitLiteralTable -- * * This function is called to initialize the fields of a literal table * structure for either an interpreter or a compilation's CompileEnv * structure. * * Results: * None. * * Side effects: * The literal table is made ready for use. * *---------------------------------------------------------------------- */ void TclInitLiteralTable( LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { #if (TCL_SMALL_HASH_TABLE != 4) Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable", TCL_SMALL_HASH_TABLE); #endif tablePtr->buckets = tablePtr->staticBuckets; tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0; tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0; tablePtr->numBuckets = TCL_SMALL_HASH_TABLE; tablePtr->numEntries = 0; tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE * REBUILD_MULTIPLIER; tablePtr->mask = 3; } /* *---------------------------------------------------------------------- * * TclDeleteLiteralTable -- * * This function frees up everything associated with a literal table * except for the table's structure itself. It is called when the * interpreter is deleted. * * Results: * None. * * Side effects: * Each literal in the table is released: i.e., its reference count in * the global literal table is decremented and, if it becomes zero, the * literal is freed. In addition, the table's bucket array is freed. * *---------------------------------------------------------------------- */ void TclDeleteLiteralTable( Tcl_Interp *interp, /* Interpreter containing shared literals * referenced by the table to delete. */ LiteralTable *tablePtr) /* Points to the literal table to delete. */ { LiteralEntry *entryPtr, *nextPtr; Tcl_Obj *objPtr; int i; /* * Release remaining literals in the table. Note that releasing a literal * might release other literals, modifying the table, so we restart the * search from the bucket chain we last found an entry. */ #ifdef TCL_COMPILE_DEBUG TclVerifyGlobalLiteralTable((Interp *) interp); #endif /*TCL_COMPILE_DEBUG*/ /* * We used to call TclReleaseLiteral for each literal in the table, which * is rather inefficient as it causes one lookup-by-hash for each * reference to the literal. We now rely at interp-deletion on each * bytecode object to release its references to the literal Tcl_Obj * without requiring that it updates the global table itself, and deal * here only with the table. */ for (i=0 ; inumBuckets ; i++) { entryPtr = tablePtr->buckets[i]; while (entryPtr != NULL) { objPtr = entryPtr->objPtr; TclDecrRefCount(objPtr); nextPtr = entryPtr->nextPtr; ckfree(entryPtr); entryPtr = nextPtr; } } /* * Free up the table's bucket array if it was dynamically allocated. */ if (tablePtr->buckets != tablePtr->staticBuckets) { ckfree(tablePtr->buckets); } } /* *---------------------------------------------------------------------- * * TclCreateLiteral -- * * Find, or if necessary create, an object in the interpreter's literal * table that has a string representation matching the argument * string. If nsPtr!=NULL then only literals stored for the namespace are * considered. * * Results: * The literal object. If it was created in this call *newPtr is set to * 1, else 0. NULL is returned if newPtr==NULL and no literal is found. * * Side effects: * Increments the ref count of the global LiteralEntry since the caller * now holds a reference. If LITERAL_ON_HEAP is set in flags, this * function is given ownership of the string: if an object is created * then its string representation is set directly from string, otherwise * the string is freed. Typically, a caller sets LITERAL_ON_HEAP if * "string" is an already heap-allocated buffer holding the result of * backslash substitutions. * *---------------------------------------------------------------------- */ Tcl_Obj * TclCreateLiteral( Interp *iPtr, char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ int length, /* Number of bytes in the string. */ unsigned hash, /* The string's hash. If -1, it will be * computed here. */ int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr) { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; int globalHash; Tcl_Obj *objPtr; /* * Is it in the interpreter's global literal table? */ if (hash == (unsigned) -1) { hash = HashString(bytes, length); } globalHash = (hash & globalTablePtr->mask); for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL; globalPtr = globalPtr->nextPtr) { objPtr = globalPtr->objPtr; if (globalPtr->nsPtr == nsPtr) { /* * Literals should always have UTF-8 representations... but this * is not guaranteed so we need to be careful anyway. * * https://stackoverflow.com/q/54337750/301832 */ int objLength; char *objBytes = TclGetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) || ((objBytes[0] == bytes[0]) && (memcmp(objBytes, bytes, length) == 0)))) { /* * A literal was found: return it */ if (newPtr) { *newPtr = 0; } if (globalPtrPtr) { *globalPtrPtr = globalPtr; } if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } globalPtr->refCount++; return objPtr; } } } if (!newPtr) { if ((flags & LITERAL_ON_HEAP)) { ckfree(bytes); } return NULL; } /* * The literal is new to the interpreter. Add it to the global literal * table. */ TclNewObj(objPtr); if ((flags & LITERAL_ON_HEAP)) { objPtr->bytes = bytes; objPtr->length = length; } else { TclInitStringRep(objPtr, bytes, length); } if ((flags & LITERAL_UNSHARED)) { /* * Make clear, that no global value is returned */ if (globalPtrPtr != NULL) { *globalPtrPtr = NULL; } return objPtr; } #ifdef TCL_COMPILE_DEBUG if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", "TclRegisterLiteral", (length>60? 60 : length), bytes); } #endif globalPtr = (LiteralEntry *)ckalloc(sizeof(LiteralEntry)); globalPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); globalPtr->refCount = 1; globalPtr->nsPtr = nsPtr; globalPtr->nextPtr = globalTablePtr->buckets[globalHash]; globalTablePtr->buckets[globalHash] = globalPtr; globalTablePtr->numEntries++; /* * If the global literal table has exceeded a decent size, rebuild it with * more buckets. */ if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) { RebuildLiteralTable(globalTablePtr); } #ifdef TCL_COMPILE_DEBUG TclVerifyGlobalLiteralTable(iPtr); { LiteralEntry *entryPtr; int found, i; found = 0; for (i=0 ; inumBuckets ; i++) { for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ; entryPtr=entryPtr->nextPtr) { if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) { found = 1; } } } if (!found) { Tcl_Panic("%s: literal \"%.*s\" wasn't global", "TclRegisterLiteral", (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ #ifdef TCL_COMPILE_STATS iPtr->stats.numLiteralsCreated++; iPtr->stats.totalLitStringBytes += (double) (length + 1); iPtr->stats.currentLitStringBytes += (double) (length + 1); iPtr->stats.literalCount[TclLog2(length)]++; #endif /*TCL_COMPILE_STATS*/ if (globalPtrPtr) { *globalPtrPtr = globalPtr; } *newPtr = 1; return objPtr; } /* *---------------------------------------------------------------------- * * TclFetchLiteral -- * * Fetch from a CompileEnv the literal value identified by an index * value, as returned by a prior call to TclRegisterLiteral(). * * Results: * The literal value, or NULL if the index is out of range. * *---------------------------------------------------------------------- */ Tcl_Obj * TclFetchLiteral( CompileEnv *envPtr, /* Points to the CompileEnv from which to * fetch the registered literal value. */ unsigned int index) /* Index of the desired literal, as returned * by prior call to TclRegisterLiteral() */ { if (index >= (unsigned int) envPtr->literalArrayNext) { return NULL; } return envPtr->literalArrayPtr[index].objPtr; } /* *---------------------------------------------------------------------- * * TclRegisterLiteral -- * * Find, or if necessary create, an object in a CompileEnv literal array * that has a string representation matching the argument string. * * Results: * The index in the CompileEnv's literal array that references a shared * literal matching the string. The object is created if necessary. * * Side effects: * To maximize sharing, we look up the string in the interpreter's global * literal table. If not found, we create a new shared literal in the * global table. We then add a reference to the shared literal in the * CompileEnv's literal array. * * If LITERAL_ON_HEAP is set in flags, this function is given ownership * of the string: if an object is created then its string representation * is set directly from string, otherwise the string is freed. Typically, * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated * buffer holding the result of backslash substitutions. * *---------------------------------------------------------------------- */ int TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ int length, /* Number of bytes in the string. If < 0, the * string consists of all bytes up to the * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already * malloc'd bytes and ownership is passed to * this function. If LITERAL_CMD_NAME then * the literal should not be shared across * namespaces. */ { CompileEnv *envPtr = ePtr; Interp *iPtr = envPtr->iPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; unsigned hash; int localHash, objIndex, new; Namespace *nsPtr; if (length < 0) { length = (bytes ? strlen(bytes) : 0); } hash = HashString(bytes, length); /* * Is the literal already in the CompileEnv's local literal array? If so, * just return its index. */ localHash = (hash & localTablePtr->mask); for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL; localPtr = localPtr->nextPtr) { objPtr = localPtr->objPtr; if ((objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) && (memcmp(objPtr->bytes, bytes, length) == 0)))) { if ((flags & LITERAL_ON_HEAP)) { ckfree(bytes); } objIndex = (localPtr - envPtr->literalArrayPtr); #ifdef TCL_COMPILE_DEBUG TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ return objIndex; } } /* * The literal is new to this CompileEnv. If it is a command name, avoid * sharing it across namespaces, and try not to share it with non-cmd * literals. Note that FQ command names can be shared, so that we register * the namespace as the interp's global NS. */ if ((flags & LITERAL_CMD_NAME)) { if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) { nsPtr = iPtr->globalNsPtr; } else { nsPtr = iPtr->varFramePtr->nsPtr; } } else { nsPtr = NULL; } /* * Is it in the interpreter's global literal table? If not, create it. */ globalPtr = NULL; objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags, &globalPtr); objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG if (globalPtr != NULL && globalPtr->refCount < 1) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclRegisterLiteral", (length>60? 60 : length), bytes, globalPtr->refCount); } TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ return objIndex; } #ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * * LookupLiteralEntry -- * * Finds the LiteralEntry that corresponds to a literal Tcl object * holding a literal. * * Results: * Returns the matching LiteralEntry if found, otherwise NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *entryPtr; const char *bytes; int length, globalHash; bytes = TclGetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { if (entryPtr->objPtr == objPtr) { return entryPtr; } } return NULL; } #endif /* *---------------------------------------------------------------------- * * TclHideLiteral -- * * Remove a literal entry from the literal hash tables, leaving it in the * literal array so existing references continue to function. This makes * it possible to turn a shared literal into a private literal that * cannot be shared. * * Results: * None. * * Side effects: * Removes the literal from the local hash table and decrements the * global hash entry's reference count. * *---------------------------------------------------------------------- */ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; int localHash, length; const char *bytes; Tcl_Obj *newObjPtr; lPtr = &envPtr->literalArrayPtr[index]; /* * To avoid unwanted sharing we need to copy the object and remove it from * the local and global literal tables. It still has a slot in the literal * array so it can be referred to by byte codes, but it will not be * matched by literal searches. */ newObjPtr = Tcl_DuplicateObj(lPtr->objPtr); Tcl_IncrRefCount(newObjPtr); TclReleaseLiteral(interp, lPtr->objPtr); lPtr->objPtr = newObjPtr; bytes = TclGetStringFromObj(newObjPtr, &length); localHash = (HashString(bytes, length) & localTablePtr->mask); nextPtrPtr = &localTablePtr->buckets[localHash]; for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) { if (entryPtr == lPtr) { *nextPtrPtr = lPtr->nextPtr; lPtr->nextPtr = NULL; localTablePtr->numEntries--; break; } nextPtrPtr = &entryPtr->nextPtr; } } /* *---------------------------------------------------------------------- * * TclAddLiteralObj -- * * Add a single literal object to the literal array. This function does * not add the literal to the local or global literal tables. The caller * is expected to add the entry to whatever tables are appropriate. * * Results: * The index in the CompileEnv's literal array that references the * literal. Stores the pointer to the new literal entry in the location * referenced by the localPtrPtr argument. * * Side effects: * Expands the literal array if necessary. Increments the refcount on the * literal object. * *---------------------------------------------------------------------- */ int TclAddLiteralObj( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The object to insert into the array. */ LiteralEntry **litPtrPtr) /* The location where the pointer to the new * literal entry should be stored. May be * NULL. */ { LiteralEntry *lPtr; int objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { ExpandLocalLiteralArray(envPtr); } objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); lPtr->refCount = -1; /* i.e., unused */ lPtr->nextPtr = NULL; if (litPtrPtr) { *litPtrPtr = lPtr; } return objIndex; } /* *---------------------------------------------------------------------- * * AddLocalLiteralEntry -- * * Insert a new literal into a CompileEnv's local literal array. * * Results: * The index in the CompileEnv's literal array that references the * literal. * * Side effects: * Expands the literal array if necessary. May rebuild the hash bucket * array of the CompileEnv's literal array if it becomes too large. * *---------------------------------------------------------------------- */ static int AddLocalLiteralEntry( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; int objIndex; objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr); /* * Add the literal to the local table. */ localPtr->nextPtr = localTablePtr->buckets[localHash]; localTablePtr->buckets[localHash] = localPtr; localTablePtr->numEntries++; /* * If the CompileEnv's local literal table has exceeded a decent size, * rebuild it with more buckets. */ if (localTablePtr->numEntries >= localTablePtr->rebuildSize) { RebuildLiteralTable(localTablePtr); } #ifdef TCL_COMPILE_DEBUG TclVerifyLocalLiteralTable(envPtr); { char *bytes; int length, found, i; found = 0; for (i=0 ; inumBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ; localPtr=localPtr->nextPtr) { if (localPtr->objPtr == objPtr) { found = 1; } } } if (!found) { bytes = Tcl_GetStringFromObj(objPtr, &length); Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", "AddLocalLiteralEntry", (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ return objIndex; } /* *---------------------------------------------------------------------- * * ExpandLocalLiteralArray -- * * Function that uses malloc to allocate more storage for a CompileEnv's * local literal array. * * Results: * None. * * Side effects: * The literal array in *envPtr is reallocated to a new array of double * the size, and if envPtr->mallocedLiteralArray is non-zero the old * array is freed. Entries are copied from the old array to the new one. * The local literal table is updated to refer to the new entries. * *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray( CompileEnv *envPtr)/* Points to the CompileEnv whose object array * must be enlarged. */ { /* * The current allocated local literal entries are stored between elements * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ LiteralTable *localTablePtr = &envPtr->localLitTable; int currElems = envPtr->literalArrayNext; size_t currBytes = (currElems * sizeof(LiteralEntry)); LiteralEntry *currArrayPtr = envPtr->literalArrayPtr; LiteralEntry *newArrayPtr; int i; unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; if (currBytes == newSize) { Tcl_Panic("max size of Tcl literal array (%d literals) exceeded", currElems); } if (envPtr->mallocedLiteralArray) { newArrayPtr = (LiteralEntry *)ckrealloc(currArrayPtr, newSize); } else { /* * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must * code a ckrealloc equivalent for ourselves. */ newArrayPtr = (LiteralEntry *)ckalloc(newSize); memcpy(newArrayPtr, currArrayPtr, currBytes); envPtr->mallocedLiteralArray = 1; } /* * Update the local literal table's bucket array. */ if (currArrayPtr != newArrayPtr) { for (i=0 ; inumBuckets ; i++) { if (localTablePtr->buckets[i] != NULL) { localTablePtr->buckets[i] = newArrayPtr + (localTablePtr->buckets[i] - currArrayPtr); } } } envPtr->literalArrayPtr = newArrayPtr; envPtr->literalArrayEnd = newSize / sizeof(LiteralEntry); } /* *---------------------------------------------------------------------- * * TclReleaseLiteral -- * * This function releases a reference to one of the shared Tcl objects * that hold literals. It is called to release the literals referenced by * a ByteCode that is being destroyed, and it is also called by * TclDeleteLiteralTable. * * Results: * None. * * Side effects: * The reference count for the global LiteralTable entry that corresponds * to the literal is decremented. If no other reference to a global * literal object remains, it is freed. * *---------------------------------------------------------------------- */ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr; LiteralEntry *entryPtr, *prevPtr; const char *bytes; int length, index; if (iPtr == NULL) { goto done; } globalTablePtr = &iPtr->literalTable; bytes = TclGetStringFromObj(objPtr, &length); index = (HashString(bytes, length) & globalTablePtr->mask); /* * Check to see if the object is in the global literal table and remove * this reference. The object may not be in the table if it is a hidden * local literal. */ for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index]; entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) { if (entryPtr->objPtr == objPtr) { entryPtr->refCount--; /* * If the literal is no longer being used by any ByteCode, delete * the entry then remove the reference corresponding to the global * literal table entry (decrement the ref count of the object). */ if (entryPtr->refCount == 0) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; } else { prevPtr->nextPtr = entryPtr->nextPtr; } ckfree(entryPtr); globalTablePtr->numEntries--; TclDecrRefCount(objPtr); #ifdef TCL_COMPILE_STATS iPtr->stats.currentLitStringBytes -= (double) (length + 1); #endif /*TCL_COMPILE_STATS*/ } break; } } /* * Remove the reference corresponding to the local literal table entry. */ done: Tcl_DecrRefCount(objPtr); } /* *---------------------------------------------------------------------- * * HashString -- * * Compute a one-word summary of a text string, which can be used to * generate a hash index. * * Results: * The return value is a one-word summary of the information in string. * * Side effects: * None. * *---------------------------------------------------------------------- */ static unsigned HashString( const char *string, /* String for which to compute hash value. */ int length) /* Number of bytes in the string. */ { unsigned int result = 0; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose * the one below (multiply by 9 and add new character) because of the * following reasons: * * 1. Multiplying by 10 is perfect for keys that are decimal strings, and * multiplying by 9 is just about as good. * 2. Times-9 is (shift-left-3) plus (old). This means that each * character's bits hang around in the low-order bits of the hash value * for ever, plus they spread fairly rapidly up to the high-order bits * to fill out the hash value. This seems works well both for decimal * and non-decimal strings. * * Note that this function is very weak against malicious strings; it's * very easy to generate multiple keys that have the same hashcode. On the * other hand, that hardly ever actually occurs and this function *is* * very cheap, even by comparison with industry-standard hashes like FNV. * If real strength of hash is required though, use a custom hash based on * Bob Jenkins's lookup3(), but be aware that it's significantly slower. * Tcl scripts tend to not have a big issue in this area, and literals * mostly aren't looked up by name anyway. * * See also HashStringKey in tclHash.c. * See also TclObjHashKey in tclObj.c. * * See [tcl-Feature Request #2958832] */ if (length > 0) { result = UCHAR(*string); while (--length) { result += (result << 3) + UCHAR(*++string); } } return result; } /* *---------------------------------------------------------------------- * * RebuildLiteralTable -- * * This function is invoked when the ratio of entries to hash buckets * becomes too large in a local or global literal table. It allocates a * larger bucket array and moves the entries into the new buckets. * * Results: * None. * * Side effects: * Memory gets reallocated and entries get rehashed into new buckets. * *---------------------------------------------------------------------- */ static void RebuildLiteralTable( LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; LiteralEntry **oldChainPtr, **newChainPtr; LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; unsigned int oldSize; int count, index, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; /* * Allocate and initialize the new bucket array, and set up hashing * constants for new array size. */ if (oldSize > UINT_MAX/(4 * sizeof(LiteralEntry *))) { /* * Memory allocator limitations will not let us create the * next larger table size. Best option is to limp along * with what we have. */ return; } tablePtr->numBuckets *= 4; tablePtr->buckets = (LiteralEntry **)ckalloc( tablePtr->numBuckets * sizeof(LiteralEntry *)); for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets; count>0 ; count--, newChainPtr++) { *newChainPtr = NULL; } tablePtr->rebuildSize *= 4; tablePtr->mask = (tablePtr->mask << 2) + 3; /* * Rehash all of the existing entries into the new bucket array. */ for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) { for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) { bytes = TclGetStringFromObj(entryPtr->objPtr, &length); index = (HashString(bytes, length) & tablePtr->mask); *oldChainPtr = entryPtr->nextPtr; bucketPtr = &tablePtr->buckets[index]; entryPtr->nextPtr = *bucketPtr; *bucketPtr = entryPtr; } } /* * Free up the old bucket array, if it was dynamically allocated. */ if (oldBuckets != tablePtr->staticBuckets) { ckfree(oldBuckets); } } /* *---------------------------------------------------------------------- * * TclInvalidateCmdLiteral -- * * Invalidate a command literal entry, if present in the literal hash * tables, by resetting its internal representation. This invalidation * leaves it in the literal tables and in existing literal arrays. As a * result, existing references continue to work but we force a fresh * command look-up upon the next use (see, in particular, * TclSetCmdNameObj()). * * Results: * None. * * Side effects: * Resets the internal representation of the CmdName Tcl_Obj * using TclFreeIntRep(). * *---------------------------------------------------------------------- */ void TclInvalidateCmdLiteral( Tcl_Interp *interp, /* Interpreter for which to invalidate a * command literal. */ const char *name, /* Points to the start of the cmd literal * name. */ Namespace *nsPtr) /* The namespace for which to lookup and * invalidate a cmd literal. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, (char *) name, strlen(name), -1, NULL, nsPtr, 0, NULL); if (literalObjPtr != NULL) { if (literalObjPtr->typePtr == &tclCmdNameType) { TclFreeIntRep(literalObjPtr); } /* Balance the refcount effects of TclCreateLiteral() above */ Tcl_IncrRefCount(literalObjPtr); TclReleaseLiteral(interp, literalObjPtr); } } #ifdef TCL_COMPILE_STATS /* *---------------------------------------------------------------------- * * TclLiteralStats -- * * Return statistics describing the layout of the hash table in its hash * buckets. * * Results: * The return value is a malloc-ed string containing information about * tablePtr. It is the caller's responsibility to free this string. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; double average, tmp; LiteralEntry *entryPtr; char *result, *p; /* * Compute a histogram of bucket usage. For each bucket chain i, j is the * number of entries in the chain. */ for (i=0 ; inumBuckets ; i++) { j = 0; for (entryPtr=tablePtr->buckets[i] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { j++; } if (j < NUM_COUNTERS) { count[j]++; } else { overflow++; } tmp = j; average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0; } /* * Print out the histogram and a few other pieces of information. */ result = (char *)ckalloc(NUM_COUNTERS*60 + 300); snprintf(result, 60, "%d entries in table, %d buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; ilocalLitTable; LiteralEntry *localPtr; char *bytes; int i; int length, count; count = 0; for (i=0 ; inumBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; if (localPtr->refCount != -1) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", "TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes, localPtr->refCount); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", "TclVerifyLocalLiteralTable"); } } } if (count != localTablePtr->numEntries) { Tcl_Panic("%s: local literal table had %d entries, should be %d", "TclVerifyLocalLiteralTable", count, localTablePtr->numEntries); } } /* *---------------------------------------------------------------------- * * TclVerifyGlobalLiteralTable -- * * Check an interpreter's global literal table literal for consistency. * * Results: * None. * * Side effects: * Tcl_Panic if problems are found. * *---------------------------------------------------------------------- */ void TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; char *bytes; int i; int length, count; count = 0; for (i=0 ; inumBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; if (globalPtr->refCount < 1) { bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclVerifyGlobalLiteralTable", (length>60? 60 : length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", "TclVerifyGlobalLiteralTable"); } } } if (count != globalTablePtr->numEntries) { Tcl_Panic("%s: global literal table had %d entries, should be %d", "TclVerifyGlobalLiteralTable", count, globalTablePtr->numEntries); } } #endif /*TCL_COMPILE_DEBUG*/ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclLoad.c0000644000175000017500000010054214554262142015006 0ustar sergeisergei/* * tclLoad.c -- * * This file provides the generic portion (those that are the same on all * platforms) of Tcl's dynamic loading facilities. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * The following structure describes a package that has been loaded either * dynamically (with the "load" command) or statically (as indicated by a call * to TclGetLoadedPackages). All such packages are linked together into a * single list for the process. Packages are never unloaded, until the * application exits, when TclFinalizeLoad is called, and these structures are * freed. */ typedef struct LoadedPackage { char *fileName; /* Name of the file from which the package was * loaded. An empty string means the package * is loaded statically. Malloc-ed. */ char *packageName; /* Name of package prefix for the package, * properly capitalized (first letter UC, * others LC), as in "Net". * Malloc-ed. */ Tcl_LoadHandle loadHandle; /* Token for the loaded file which should be * passed to (*unLoadProcPtr)() when the file * is no longer needed. If fileName is NULL, * then this field is irrelevant. */ Tcl_PackageInitProc *initProc; /* Initialization function to call to * incorporate this package into a trusted * interpreter. */ Tcl_PackageInitProc *safeInitProc; /* Initialization function to call to * incorporate this package into a safe * interpreter (one that will execute * untrusted scripts). NULL means the package * can't be used in unsafe interpreters. */ Tcl_PackageUnloadProc *unloadProc; /* Finalisation function to unload a package * from a trusted interpreter. NULL means that * the package cannot be unloaded. */ Tcl_PackageUnloadProc *safeUnloadProc; /* Finalisation function to unload a package * from a safe interpreter. NULL means that * the package cannot be unloaded. */ int interpRefCount; /* How many times the package has been loaded * in trusted interpreters. */ int safeInterpRefCount; /* How many times the package has been loaded * in safe interpreters. */ struct LoadedPackage *nextPtr; /* Next in list of all packages loaded into * this application process. NULL means end of * list. */ } LoadedPackage; /* * TCL_THREADS * There is a global list of packages that is anchored at firstPackagePtr. * Access to this list is governed by a mutex. */ static LoadedPackage *firstPackagePtr = NULL; /* First in list of all packages loaded into * this process. */ TCL_DECLARE_MUTEX(packageMutex) /* * The following structure represents a particular package that has been * incorporated into a particular interpreter (by calling its initialization * function). There is a list of these structures for each interpreter, with * an AssocData value (key "load") for the interpreter that points to the * first package (if any). */ typedef struct InterpPackage { LoadedPackage *pkgPtr; /* Points to detailed information about * package. */ struct InterpPackage *nextPtr; /* Next package in this interpreter, or NULL * for end of list. */ } InterpPackage; /* * Prototypes for functions that are private to this file: */ static void LoadCleanupProc(ClientData clientData, Tcl_Interp *interp); /* *---------------------------------------------------------------------- * * Tcl_LoadObjCmd -- * * This function is invoked to process the "load" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LoadObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *target; LoadedPackage *pkgPtr, *defaultPtr; Tcl_DString prefix, tmp, initName, safeInitName; Tcl_DString unloadName, safeUnloadName; InterpPackage *ipFirstPtr, *ipPtr; int code, namesMatch, filesMatch, offset; const char *symbols[2]; Tcl_PackageInitProc *initProc; const char *p, *fullFileName, *packageName; Tcl_LoadHandle loadHandle; Tcl_UniChar ch = 0; unsigned len; int index, flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { "-global", "-lazy", "--", NULL }; enum options { LOAD_GLOBAL, LOAD_LAZY, LOAD_LAST }; while (objc > 2) { if (TclGetString(objv[1])[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } ++objv; --objc; if (LOAD_GLOBAL == (enum options) index) { flags |= TCL_LOAD_GLOBAL; } else if (LOAD_LAZY == (enum options) index) { flags |= TCL_LOAD_LAZY; } else { break; } } if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } fullFileName = Tcl_GetString(objv[1]); Tcl_DStringInit(&prefix); Tcl_DStringInit(&initName); Tcl_DStringInit(&safeInitName); Tcl_DStringInit(&unloadName); Tcl_DStringInit(&safeUnloadName); Tcl_DStringInit(&tmp); packageName = NULL; if (objc >= 3) { packageName = Tcl_GetString(objv[2]); if (packageName[0] == '\0') { packageName = NULL; } } if ((fullFileName[0] == 0) && (packageName == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must specify either file name or package name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY", NULL); code = TCL_ERROR; goto done; } /* * Figure out which interpreter we're going to load the package into. */ target = interp; if (objc == 4) { const char *childIntName = Tcl_GetString(objv[3]); target = Tcl_GetChild(interp, childIntName); if (target == NULL) { code = TCL_ERROR; goto done; } } /* * Scan through the packages that are currently loaded to see if the * package we want is already loaded. We'll use a loaded package if it * meets any of the following conditions: * - Its name and file match the once we're looking for. * - Its file matches, and we weren't given a name. * - Its name matches, the file name was specified as empty, and there is * only no statically loaded package with the same name. */ Tcl_MutexLock(&packageMutex); defaultPtr = NULL; for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { if (packageName == NULL) { namesMatch = 0; } else { TclDStringClear(&prefix); Tcl_DStringAppend(&prefix, packageName, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&prefix)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&prefix)) == 0) { namesMatch = 1; } else { namesMatch = 0; } } TclDStringClear(&prefix); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { break; } if (namesMatch && (fullFileName[0] == 0)) { defaultPtr = pkgPtr; } if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { /* * Can't have two different packages loaded from the same file. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" is already loaded for package \"%s\"", fullFileName, pkgPtr->packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "SPLITPERSONALITY", NULL); code = TCL_ERROR; Tcl_MutexUnlock(&packageMutex); goto done; } } Tcl_MutexUnlock(&packageMutex); if (pkgPtr == NULL) { pkgPtr = defaultPtr; } /* * Scan through the list of packages already loaded in the target * interpreter. If the package we want is already loaded there, then * there's nothing for us to do. */ if (pkgPtr != NULL) { ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == pkgPtr) { code = TCL_OK; goto done; } } } if (pkgPtr == NULL) { /* * The desired file isn't currently loaded, so load it. It's an error * if the desired package is a static one. */ if (fullFileName[0] == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "package \"%s\" isn't loaded statically", packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC", NULL); code = TCL_ERROR; goto done; } /* * Figure out the module name if it wasn't provided explicitly. */ if (packageName != NULL) { Tcl_DStringAppend(&prefix, packageName, -1); } else { int retc; /* * Threading note - this call used to be protected by a mutex. */ retc = TclGuessPackageName(fullFileName, &prefix); if (!retc) { Tcl_Obj *splitPtr, *pkgGuessPtr; int pElements; const char *pkgGuess; /* * The platform-specific code couldn't figure out the module * name. Make a guess by taking the last element of the file * name, stripping off any leading "lib", and then using all * of the alphabetic and underline characters that follow * that. */ splitPtr = Tcl_FSSplitPath(objv[1], &pElements); Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr); pkgGuess = Tcl_GetString(pkgGuessPtr); if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') && (pkgGuess[2] == 'b')) { pkgGuess += 3; } #ifdef __CYGWIN__ if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y') && (pkgGuess[2] == 'g')) { pkgGuess += 3; } #endif /* __CYGWIN__ */ for (p = pkgGuess; *p != 0; p += offset) { offset = TclUtfToUniChar(p, &ch); if ((ch > 0x100) || !(isalpha(UCHAR(ch)) /* INTL: ISO only */ || (UCHAR(ch) == '_'))) { break; } } if (p == pkgGuess) { Tcl_DecrRefCount(splitPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't figure out package name for %s", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "WHATPACKAGE", NULL); code = TCL_ERROR; goto done; } Tcl_DStringAppend(&prefix, pkgGuess, p - pkgGuess); Tcl_DecrRefCount(splitPtr); } } /* * Fix the capitalization in the package name so that the first * character is in caps (or title case) but the others are all * lower-case. */ Tcl_DStringSetLength(&prefix, Tcl_UtfToTitle(Tcl_DStringValue(&prefix))); /* * Compute the names of the two initialization functions, based on the * package name. */ TclDStringAppendDString(&initName, &prefix); TclDStringAppendLiteral(&initName, "_Init"); TclDStringAppendDString(&safeInitName, &prefix); TclDStringAppendLiteral(&safeInitName, "_SafeInit"); TclDStringAppendDString(&unloadName, &prefix); TclDStringAppendLiteral(&unloadName, "_Unload"); TclDStringAppendDString(&safeUnloadName, &prefix); TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload"); /* * Call platform-specific code to load the package and find the two * initialization functions. */ symbols[0] = Tcl_DStringValue(&initName); symbols[1] = NULL; Tcl_MutexLock(&packageMutex); code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc, &loadHandle); Tcl_MutexUnlock(&packageMutex); if (code != TCL_OK) { goto done; } /* * Create a new record to describe this package. */ pkgPtr = ckalloc(sizeof(LoadedPackage)); len = strlen(fullFileName) + 1; pkgPtr->fileName = ckalloc(len); memcpy(pkgPtr->fileName, fullFileName, len); len = (unsigned) Tcl_DStringLength(&prefix) + 1; pkgPtr->packageName = ckalloc(len); memcpy(pkgPtr->packageName, Tcl_DStringValue(&prefix), len); pkgPtr->loadHandle = loadHandle; pkgPtr->initProc = initProc; pkgPtr->safeInitProc = (Tcl_PackageInitProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeInitName)); pkgPtr->unloadProc = (Tcl_PackageUnloadProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&unloadName)); pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeUnloadName)); pkgPtr->interpRefCount = 0; pkgPtr->safeInterpRefCount = 0; Tcl_MutexLock(&packageMutex); pkgPtr->nextPtr = firstPackagePtr; firstPackagePtr = pkgPtr; Tcl_MutexUnlock(&packageMutex); /* * The Tcl_FindSymbol calls may have left a spurious error message in * the interpreter result. */ Tcl_ResetResult(interp); } /* * Invoke the package's initialization function (either the normal one or * the safe one, depending on whether or not the interpreter is safe). */ if (Tcl_IsSafe(target)) { if (pkgPtr->safeInitProc == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't use package in a safe interpreter: no" " %s_SafeInit procedure", pkgPtr->packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE", NULL); code = TCL_ERROR; goto done; } code = pkgPtr->safeInitProc(target); } else { if (pkgPtr->initProc == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't attach package to interpreter: no %s_Init procedure", pkgPtr->packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT", NULL); code = TCL_ERROR; goto done; } code = pkgPtr->initProc(target); } /* * Test for whether the initialization failed. If so, transfer the error * from the target interpreter to the originating one. */ if (code != TCL_OK) { Tcl_TransferResult(target, code, interp); goto done; } /* * Record the fact that the package has been loaded in the target * interpreter. * * Update the proper reference count. */ Tcl_MutexLock(&packageMutex); if (Tcl_IsSafe(target)) { pkgPtr->safeInterpRefCount++; } else { pkgPtr->interpRefCount++; } Tcl_MutexUnlock(&packageMutex); /* * Refetch ipFirstPtr: loading the package may have introduced additional * static packages at the head of the linked list! */ ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); ipPtr = ckalloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr); done: Tcl_DStringFree(&prefix); Tcl_DStringFree(&initName); Tcl_DStringFree(&safeInitName); Tcl_DStringFree(&unloadName); Tcl_DStringFree(&safeUnloadName); Tcl_DStringFree(&tmp); return code; } /* *---------------------------------------------------------------------- * * Tcl_UnloadObjCmd -- * * This function is invoked to process the "unload" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_UnloadObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *target; /* Which interpreter to unload from. */ LoadedPackage *pkgPtr, *defaultPtr; Tcl_DString prefix, tmp; Tcl_PackageUnloadProc *unloadProc; InterpPackage *ipFirstPtr, *ipPtr; int i, index, code, complain = 1, keepLibrary = 0; int trustedRefCount = -1, safeRefCount = -1; const char *fullFileName = ""; const char *packageName; static const char *const options[] = { "-nocomplain", "-keeplibrary", "--", NULL }; enum options { UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST }; for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { fullFileName = Tcl_GetString(objv[i]); if (fullFileName[0] == '-') { /* * It looks like the command contains an option so signal an * error */ return TCL_ERROR; } else { /* * This clearly isn't an option; assume it's the filename. We * must clear the error. */ Tcl_ResetResult(interp); break; } } switch (index) { case UNLOAD_NOCOMPLAIN: /* -nocomplain */ complain = 0; break; case UNLOAD_KEEPLIB: /* -keeplibrary */ keepLibrary = 1; break; case UNLOAD_LAST: /* -- */ i++; goto endOfForLoop; } } endOfForLoop: if ((objc-i < 1) || (objc-i > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? fileName ?packageName? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { return TCL_ERROR; } fullFileName = Tcl_GetString(objv[i]); Tcl_DStringInit(&prefix); Tcl_DStringInit(&tmp); packageName = NULL; if (objc - i >= 2) { packageName = Tcl_GetString(objv[i+1]); if (packageName[0] == '\0') { packageName = NULL; } } if ((fullFileName[0] == 0) && (packageName == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must specify either file name or package name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY", NULL); code = TCL_ERROR; goto done; } /* * Figure out which interpreter we're going to load the package into. */ target = interp; if (objc - i == 3) { const char *childIntName = Tcl_GetString(objv[i + 2]); target = Tcl_GetChild(interp, childIntName); if (target == NULL) { return TCL_ERROR; } } /* * Scan through the packages that are currently loaded to see if the * package we want is already loaded. We'll use a loaded package if it * meets any of the following conditions: * - Its name and file match the once we're looking for. * - Its file matches, and we weren't given a name. * - Its name matches, the file name was specified as empty, and there is * only no statically loaded package with the same name. */ Tcl_MutexLock(&packageMutex); defaultPtr = NULL; for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { int namesMatch, filesMatch; if (packageName == NULL) { namesMatch = 0; } else { TclDStringClear(&prefix); Tcl_DStringAppend(&prefix, packageName, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&prefix)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&prefix)) == 0) { namesMatch = 1; } else { namesMatch = 0; } } TclDStringClear(&prefix); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { break; } if (namesMatch && (fullFileName[0] == 0)) { defaultPtr = pkgPtr; } if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { break; } } Tcl_MutexUnlock(&packageMutex); if (fullFileName[0] == 0) { /* * It's an error to try unload a static package. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "package \"%s\" is loaded statically and cannot be unloaded", packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC", NULL); code = TCL_ERROR; goto done; } if (pkgPtr == NULL) { /* * The DLL pointed by the provided filename has never been loaded. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" has never been loaded", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", NULL); code = TCL_ERROR; goto done; } /* * Scan through the list of packages already loaded in the target * interpreter. If the package we want is already loaded there, then we * should proceed with unloading. */ code = TCL_ERROR; if (pkgPtr != NULL) { ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == pkgPtr) { code = TCL_OK; break; } } } if (code != TCL_OK) { /* * The package has not been loaded in this interpreter. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" has never been loaded in this interpreter", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", NULL); code = TCL_ERROR; goto done; } /* * Ensure that the DLL can be unloaded. If it is a trusted interpreter, * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL. */ if (Tcl_IsSafe(target)) { if (pkgPtr->safeUnloadProc == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" cannot be unloaded under a safe interpreter", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", NULL); code = TCL_ERROR; goto done; } unloadProc = pkgPtr->safeUnloadProc; } else { if (pkgPtr->unloadProc == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" cannot be unloaded under a trusted interpreter", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", NULL); code = TCL_ERROR; goto done; } unloadProc = pkgPtr->unloadProc; } /* * We are ready to unload the package. First, evaluate the unload * function. If this fails, we cannot proceed with unload. Also, we must * specify the proper flag to pass to the unload callback. * TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback should * only remove itself from the interpreter; the library will be unloaded * in a future call of unload. In case the library will be unloaded just * after the callback returns, TCL_UNLOAD_DETACH_FROM_PROCESS is passed. */ code = TCL_UNLOAD_DETACH_FROM_INTERPRETER; if (!keepLibrary) { Tcl_MutexLock(&packageMutex); trustedRefCount = pkgPtr->interpRefCount; safeRefCount = pkgPtr->safeInterpRefCount; Tcl_MutexUnlock(&packageMutex); if (Tcl_IsSafe(target)) { safeRefCount--; } else { trustedRefCount--; } if (safeRefCount <= 0 && trustedRefCount <= 0) { code = TCL_UNLOAD_DETACH_FROM_PROCESS; } } code = unloadProc(target, code); if (code != TCL_OK) { Tcl_TransferResult(target, code, interp); goto done; } /* * The unload function executed fine. Examine the reference count to see * if we unload the DLL. */ Tcl_MutexLock(&packageMutex); if (Tcl_IsSafe(target)) { pkgPtr->safeInterpRefCount--; /* * Do not let counter get negative. */ if (pkgPtr->safeInterpRefCount < 0) { pkgPtr->safeInterpRefCount = 0; } } else { pkgPtr->interpRefCount--; /* * Do not let counter get negative. */ if (pkgPtr->interpRefCount < 0) { pkgPtr->interpRefCount = 0; } } trustedRefCount = pkgPtr->interpRefCount; safeRefCount = pkgPtr->safeInterpRefCount; Tcl_MutexUnlock(&packageMutex); code = TCL_OK; if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->interpRefCount <= 0 && !keepLibrary) { /* * Unload the shared library from the application memory... */ #if defined(TCL_UNLOAD_DLLS) || defined(_WIN32) /* * Some Unix dlls are poorly behaved - registering things like atexit * calls that can't be unregistered. If you unload such dlls, you get * a core on exit because it wants to call a function in the dll after * it's been unloaded. */ if (pkgPtr->fileName[0] != '\0') { Tcl_MutexLock(&packageMutex); if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) { /* * Remove this library from the loaded library cache. */ defaultPtr = pkgPtr; if (defaultPtr == firstPackagePtr) { firstPackagePtr = pkgPtr->nextPtr; } else { for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { if (pkgPtr->nextPtr == defaultPtr) { pkgPtr->nextPtr = defaultPtr->nextPtr; break; } } } /* * Remove this library from the interpreter's library cache. */ ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); ipPtr = ipFirstPtr; if (ipPtr->pkgPtr == defaultPtr) { ipFirstPtr = ipFirstPtr->nextPtr; } else { InterpPackage *ipPrevPtr; for (ipPrevPtr = ipPtr; ipPtr != NULL; ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == defaultPtr) { ipPrevPtr->nextPtr = ipPtr->nextPtr; break; } } } Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); ckfree(defaultPtr->fileName); ckfree(defaultPtr->packageName); ckfree(defaultPtr); ckfree(ipPtr); Tcl_MutexUnlock(&packageMutex); } else { code = TCL_ERROR; } } #else Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" cannot be unloaded: unloading disabled", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED", NULL); code = TCL_ERROR; #endif } done: Tcl_DStringFree(&prefix); Tcl_DStringFree(&tmp); if (!complain && (code != TCL_OK)) { code = TCL_OK; Tcl_ResetResult(interp); } return code; } /* *---------------------------------------------------------------------- * * Tcl_StaticPackage -- * * This function is invoked to indicate that a particular package has * been linked statically with an application. * * Results: * None. * * Side effects: * Once this function completes, the package becomes loadable via the * "load" command with an empty file name. * *---------------------------------------------------------------------- */ void Tcl_StaticPackage( Tcl_Interp *interp, /* If not NULL, it means that the package has * already been loaded into the given * interpreter by calling the appropriate init * proc. */ const char *prefix, /* Prefix (must be properly * capitalized: first letter upper case, * others lower case). */ Tcl_PackageInitProc *initProc, /* Function to call to incorporate this * package into a trusted interpreter. */ Tcl_PackageInitProc *safeInitProc) /* Function to call to incorporate this * package into a safe interpreter (one that * will execute untrusted scripts). NULL means * the package can't be used in safe * interpreters. */ { LoadedPackage *pkgPtr; InterpPackage *ipPtr, *ipFirstPtr; /* * Check to see if someone else has already reported this package as * statically loaded in the process. */ Tcl_MutexLock(&packageMutex); for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { if ((pkgPtr->initProc == initProc) && (pkgPtr->safeInitProc == safeInitProc) && (strcmp(pkgPtr->packageName, prefix) == 0)) { break; } } Tcl_MutexUnlock(&packageMutex); /* * If the package is not yet recorded as being loaded statically, add it * to the list now. */ if (pkgPtr == NULL) { pkgPtr = ckalloc(sizeof(LoadedPackage)); pkgPtr->fileName = ckalloc(1); pkgPtr->fileName[0] = 0; pkgPtr->packageName = ckalloc(strlen(prefix) + 1); strcpy(pkgPtr->packageName, prefix); pkgPtr->loadHandle = NULL; pkgPtr->initProc = initProc; pkgPtr->safeInitProc = safeInitProc; Tcl_MutexLock(&packageMutex); pkgPtr->nextPtr = firstPackagePtr; firstPackagePtr = pkgPtr; Tcl_MutexUnlock(&packageMutex); } if (interp != NULL) { /* * If we're loading the package into an interpreter, determine whether * it's already loaded. */ ipFirstPtr = Tcl_GetAssocData(interp, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == pkgPtr) { return; } } /* * Package isn't loade in the current interp yet. Mark it as now being * loaded. */ ipPtr = ckalloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr); } } /* *---------------------------------------------------------------------- * * TclGetLoadedPackages -- * * This function returns information about all of the files that are * loaded (either in a particular interpreter, or for all interpreters). * * Results: * The return value is a standard Tcl completion code. If successful, a * list of lists is placed in the interp's result. Each sublist * corresponds to one loaded file; its first element is the name of the * file (or an empty string for something that's statically loaded) and * the second element is the name of the package in that file. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGetLoadedPackages( Tcl_Interp *interp, /* Interpreter in which to return information * or error message. */ const char *targetName) /* Name of target interpreter or NULL. If * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ { Tcl_Interp *target; LoadedPackage *pkgPtr; InterpPackage *ipPtr; Tcl_Obj *resultObj, *pkgDesc[2]; if (targetName == NULL) { /* * Return information about all of the available packages. */ TclNewObj(resultObj); Tcl_MutexLock(&packageMutex); for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1); pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc)); } Tcl_MutexUnlock(&packageMutex); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * Return information about only the packages that are loaded in a given * interpreter. */ target = Tcl_GetChild(interp, targetName); if (target == NULL) { return TCL_ERROR; } ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL); TclNewObj(resultObj); for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { pkgPtr = ipPtr->pkgPtr; pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1); pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *---------------------------------------------------------------------- * * LoadCleanupProc -- * * This function is called to delete all of the InterpPackage structures * for an interpreter when the interpreter is deleted. It gets invoked * via the Tcl AssocData mechanism. * * Results: * None. * * Side effects: * Storage for all of the InterpPackage functions for interp get deleted. * *---------------------------------------------------------------------- */ static void LoadCleanupProc( ClientData clientData, /* Pointer to first InterpPackage structure * for interp. */ Tcl_Interp *interp) /* Interpreter that is being deleted. */ { InterpPackage *ipPtr, *nextPtr; ipPtr = clientData; while (ipPtr != NULL) { nextPtr = ipPtr->nextPtr; ckfree(ipPtr); ipPtr = nextPtr; } } /* *---------------------------------------------------------------------- * * TclFinalizeLoad -- * * This function is invoked just before the application exits. It frees * all of the LoadedPackage structures. * * Results: * None. * * Side effects: * Memory is freed. * *---------------------------------------------------------------------- */ void TclFinalizeLoad(void) { LoadedPackage *pkgPtr; /* * No synchronization here because there should just be one thread alive * at this point. Logically, packageMutex should be grabbed at this point, * but the Mutexes get finalized before the call to this routine. The only * subsystem left alive at this point is the memory allocator. */ while (firstPackagePtr != NULL) { pkgPtr = firstPackagePtr; firstPackagePtr = pkgPtr->nextPtr; #if defined(TCL_UNLOAD_DLLS) || defined(_WIN32) /* * Some Unix dlls are poorly behaved - registering things like atexit * calls that can't be unregistered. If you unload such dlls, you get * a core on exit because it wants to call a function in the dll after * it has been unloaded. */ if (pkgPtr->fileName[0] != '\0') { Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle); } #endif ckfree(pkgPtr->fileName); ckfree(pkgPtr->packageName); ckfree(pkgPtr); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclLoadNone.c0000644000175000017500000000703614554262142015632 0ustar sergeisergei/* * tclLoadNone.c -- * * This procedure provides a version of the TclpDlopen for use in * systems that don't support dynamic loading; it just returns an error. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* *---------------------------------------------------------------------- * * TclpDlopen -- * * This procedure is called to carry out dynamic loading of binary code; * it is intended for use only on systems that don't support dynamic * loading (it returns an error). * * Results: * The result is TCL_ERROR, and an error message is left in the interp's * result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "dynamic loading is not currently available on this system", -1)); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package name, * this procedure is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a package * name; generic code will then try to guess the package from the file * name. A return value of 1 would have meant that we figured out the * package name and put it in bufPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName( const char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ { return 0; } /* * These functions are fallbacks if we somehow determine that the platform can * do loading from memory but the user wishes to disable it. They just report * (gracefully) that they fail. */ #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE void * TclpLoadMemoryGetBuffer( Tcl_Interp *interp, /* Dummy: unused by this implementation */ int size) /* Dummy: unused by this implementation */ { return NULL; } MODULE_SCOPE int TclpLoadMemory( Tcl_Interp *interp, /* Used for error reporting. */ void *buffer, /* Dummy: unused by this implementation */ int size, /* Dummy: unused by this implementation */ int codeSize, /* Dummy: unused by this implementation */ Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Dummy: unused by this implementation */ int flags) /* Dummy: unused by this implementation */ { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory " "is not available on this system", -1)); } return TCL_ERROR; } #endif /* TCL_LOAD_FROM_MEMORY */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclMain.c0000644000175000017500000006110314554262142015012 0ustar sergeisergei/* * tclMain.c -- * * Main program for Tcl shells and other Tcl-based applications. * This file contains a generic main program for Tcl shells and other * Tcl-based applications. It can be used as-is for many applications, * just by supplying a different appInitProc function for each specific * application. Or, it can be used as a template for creating new main * programs for Tcl applications. * * Copyright (c) 1988-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 2000 Ajuba Solutions. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * On Windows, this file needs to be compiled twice, once with UNICODE and * _UNICODE defined. This way both Tcl_Main and Tcl_MainExW can be * implemented, sharing the same source code. */ #include "tclInt.h" /* * The default prompt used when the user has not overridden it. */ static const char DEFAULT_PRIMARY_PROMPT[] = "% "; /* * This file can be compiled on Windows in UNICODE mode, as well as on all * other platforms using the native encoding. This is done by using the normal * Windows functions like _tcscmp, but on platforms which don't have * we have to translate that to strcmp here. */ #ifndef _WIN32 # define TCHAR char # define TEXT(arg) arg # define _tcscmp strcmp #endif static inline Tcl_Obj * NewNativeObj( TCHAR *string) { Tcl_DString ds; #ifdef UNICODE Tcl_WinTCharToUtf(string, -1, &ds); #else Tcl_ExternalToUtfDString(NULL, (char *) string, -1, &ds); #endif return TclDStringToObj(&ds); } /* * Declarations for various library functions and variables (don't want to * include tclPort.h here, because people might copy this file out of the Tcl * source directory to make their own modified versions). */ #if defined _MSC_VER && _MSC_VER < 1900 /* isatty is always defined on MSVC 14.0, but not necessarily as CRTIMPORT. */ extern CRTIMPORT int isatty(int fd); #endif /* * The thread-local variables for this file's functions. */ typedef struct { Tcl_Obj *path; /* The filename of the script for *_Main() * routines to [source] as a startup script, * or NULL for none set, meaning enter * interactive mode. */ Tcl_Obj *encoding; /* The encoding of the startup script file. */ Tcl_MainLoopProc *mainLoopProc; /* Any installed main loop handler. The main * extension that installs these is Tk. */ } ThreadSpecificData; /* * Structure definition for information used to keep the state of an * interactive command processor that reads lines from standard input and * writes prompts and results to standard output. */ typedef enum { PROMPT_NONE, /* Print no prompt */ PROMPT_START, /* Print prompt for command start */ PROMPT_CONTINUE /* Print prompt for command continuation */ } PromptType; typedef struct { Tcl_Channel input; /* The standard input channel from which lines * are read. */ int tty; /* Non-zero means standard input is a * terminal-like device. Zero means it's a * file. */ Tcl_Obj *commandPtr; /* Used to assemble lines of input into Tcl * commands. */ PromptType prompt; /* Next prompt to print */ Tcl_Interp *interp; /* Interpreter that evaluates interactive * commands. */ } InteractiveState; /* * Forward declarations for functions defined later in this file. */ MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void); static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr); static void StdinProc(ClientData clientData, int mask); static void FreeMainInterp(ClientData clientData); #if !defined(_WIN32) || defined(UNICODE) && !defined(TCL_ASCII_MAIN) static Tcl_ThreadDataKey dataKey; /* *---------------------------------------------------------------------- * * Tcl_SetStartupScript -- * * Sets the path and encoding of the startup script to be evaluated by * Tcl_Main, used to override the command line processing. * * Results: * None. * * Side effects: * *---------------------------------------------------------------------- */ void Tcl_SetStartupScript( Tcl_Obj *path, /* Filesystem path of startup script file */ const char *encoding) /* Encoding of the data in that file */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_Obj *newEncoding = NULL; if (encoding != NULL) { newEncoding = Tcl_NewStringObj(encoding, -1); } if (tsdPtr->path != NULL) { Tcl_DecrRefCount(tsdPtr->path); } tsdPtr->path = path; if (tsdPtr->path != NULL) { Tcl_IncrRefCount(tsdPtr->path); } if (tsdPtr->encoding != NULL) { Tcl_DecrRefCount(tsdPtr->encoding); } tsdPtr->encoding = newEncoding; if (tsdPtr->encoding != NULL) { Tcl_IncrRefCount(tsdPtr->encoding); } } /* *---------------------------------------------------------------------- * * Tcl_GetStartupScript -- * * Gets the path and encoding of the startup script to be evaluated by * Tcl_Main. * * Results: * The path of the startup script; NULL if none has been set. * * Side effects: * If encodingPtr is not NULL, stores a (const char *) in it pointing to * the encoding name registered for the startup script. Tcl retains * ownership of the string, and may free it. Caller should make a copy * for long-term use. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetStartupScript( const char **encodingPtr) /* When not NULL, points to storage for the * (const char *) that points to the * registered encoding name for the startup * script. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (encodingPtr != NULL) { if (tsdPtr->encoding == NULL) { *encodingPtr = NULL; } else { *encodingPtr = Tcl_GetString(tsdPtr->encoding); } } return tsdPtr->path; } /*---------------------------------------------------------------------- * * Tcl_SourceRCFile -- * * This function is typically invoked by Tcl_Main of Tk_Main function to * source an application specific rc file into the interpreter at startup * time. * * Results: * None. * * Side effects: * Depends on what's in the rc script. * *---------------------------------------------------------------------- */ void Tcl_SourceRCFile( Tcl_Interp *interp) /* Interpreter to source rc file into. */ { Tcl_DString temp; const char *fileName; Tcl_Channel chan; fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; const char *fullName; Tcl_DStringInit(&temp); fullName = Tcl_TranslateFileName(interp, fileName, &temp); if (fullName == NULL) { /* * Couldn't translate the file name (e.g. it referred to a bogus * user or there was no HOME environment variable). Just do * nothing. */ } else { /* * Test for the existence of the rc file before trying to read it. */ c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != NULL) { Tcl_Close(NULL, c); if (Tcl_EvalFile(interp, fullName) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } } } Tcl_DStringFree(&temp); } } #endif /* !UNICODE */ /*---------------------------------------------------------------------- * * Tcl_Main, Tcl_MainEx -- * * Main program for tclsh and most other Tcl-based applications. * * Results: * None. This function never returns (it exits the process when it's * done). * * Side effects: * This function initializes the Tcl world and then starts interpreting * commands; almost anything could happen, depending on the script being * interpreted. * *---------------------------------------------------------------------- */ void Tcl_MainEx( int argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc, /* Application-specific initialization * function to call after most initialization * but before starting to execute commands. */ Tcl_Interp *interp) { Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; int code, exitCode = 0; Tcl_MainLoopProc *mainLoopProc; Tcl_Channel chan; InteractiveState is; TclpSetInitialEncodings(); TclpFindExecutable((const char *)argv[0]); Tcl_InitMemory(interp); is.interp = interp; is.prompt = PROMPT_START; TclNewObj(is.commandPtr); /* * If the application has not already set a startup script, parse the * first few command line arguments to determine the script path and * encoding. */ if (NULL == Tcl_GetStartupScript(NULL)) { /* * Check whether first 3 args (argv[1] - argv[3]) look like * -encoding ENCODING FILENAME * or like * FILENAME */ if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && ('-' != argv[3][0])) { Tcl_Obj *value = NewNativeObj(argv[2]); Tcl_SetStartupScript(NewNativeObj(argv[3]), Tcl_GetString(value)); Tcl_DecrRefCount(value); argc -= 3; argv += 3; } else if ((argc > 1) && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL); argc--; argv++; } } path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { appName = NewNativeObj(argv[0]); } else { appName = path; } Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY); argc--; argv++; Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++)); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); /* * Set the "tcl_interactive" variable. */ is.tty = isatty(0); Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ Tcl_Preserve(interp); if (appInitProc(interp) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteChars(chan, "application-specific initialization failed: ", -1); Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } if (Tcl_InterpDeleted(interp)) { goto done; } if (Tcl_LimitExceeded(interp)) { goto done; } if (TclFullFinalizationRequested()) { /* * Arrange for final deletion of the main interp */ /* ARGH Munchhausen effect */ Tcl_CreateExitHandler(FreeMainInterp, interp); } /* * Invoke the script specified on the command line, if any. Must fetch it * again, as the appInitProc might have reset it. */ path = Tcl_GetStartupScript(&encodingName); if (path != NULL) { Tcl_ResetResult(interp); code = Tcl_FSEvalFileEx(interp, path, encodingName); if (code != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); Tcl_Obj *keyPtr, *valuePtr; TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (valuePtr) { Tcl_WriteObj(chan, valuePtr); } Tcl_WriteChars(chan, "\n", 1); Tcl_DecrRefCount(options); } exitCode = 1; } goto done; } /* * We're running interactively. Source a user-specific startup file if the * application specified one and if the file exists. */ Tcl_SourceRCFile(interp); if (Tcl_LimitExceeded(interp)) { goto done; } /* * Process commands from stdin until there's an end-of-file. Note that we * need to fetch the standard channels again after every eval, since they * may have been changed. */ Tcl_IncrRefCount(is.commandPtr); /* * Get a new value for tty if anyone writes to ::tcl_interactive */ Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN); is.input = Tcl_GetStdChannel(TCL_STDIN); while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) { mainLoopProc = TclGetMainLoop(); if (mainLoopProc == NULL) { int length; if (is.tty) { Prompt(interp, &is); if (Tcl_InterpDeleted(interp)) { break; } if (Tcl_LimitExceeded(interp)) { break; } is.input = Tcl_GetStdChannel(TCL_STDIN); if (is.input == NULL) { break; } } if (Tcl_IsShared(is.commandPtr)) { Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_DuplicateObj(is.commandPtr); Tcl_IncrRefCount(is.commandPtr); } length = Tcl_GetsObj(is.input, is.commandPtr); if (length < 0) { if (Tcl_InputBlocked(is.input)) { /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try again. * This sets up a tight polling loop (since we have no * event loop running). If this causes bad CPU hogging, we * might try toggling the blocking on stdin instead. */ continue; } /* * Either EOF, or an error on stdin; we're done */ break; } /* * Add the newline removed by Tcl_GetsObj back to the string. Have * to add it back before testing completeness, because it can make * a difference. [Bug 1775878] */ if (Tcl_IsShared(is.commandPtr)) { Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_DuplicateObj(is.commandPtr); Tcl_IncrRefCount(is.commandPtr); } Tcl_AppendToObj(is.commandPtr, "\n", 1); if (!TclObjCommandComplete(is.commandPtr)) { is.prompt = PROMPT_CONTINUE; continue; } is.prompt = PROMPT_START; /* * The final newline is syntactically redundant, and causes some * error messages troubles deeper in, so lop it back off. */ (void)Tcl_GetStringFromObj(is.commandPtr, &length); Tcl_SetObjLength(is.commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL); is.input = Tcl_GetStdChannel(TCL_STDIN); Tcl_DecrRefCount(is.commandPtr); TclNewObj(is.commandPtr); Tcl_IncrRefCount(is.commandPtr); if (code != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); (void)Tcl_GetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); } } else { /* (mainLoopProc != NULL) */ /* * If a main loop has been defined while running interactively, we * want to start a fileevent based prompt by establishing a * channel handler for stdin. */ if (is.input) { if (is.tty) { Prompt(interp, &is); } Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is); } mainLoopProc(); Tcl_SetMainLoop(NULL); if (is.input) { Tcl_DeleteChannelHandler(is.input, StdinProc, &is); } is.input = Tcl_GetStdChannel(TCL_STDIN); } /* * This code here only for the (unsupported and deprecated) [checkmem] * command. */ #ifdef TCL_MEM_DEBUG if (tclMemDumpFileName != NULL) { Tcl_SetMainLoop(NULL); Tcl_DeleteInterp(interp); } #endif /* TCL_MEM_DEBUG */ } done: mainLoopProc = TclGetMainLoop(); if ((exitCode == 0) && mainLoopProc && !Tcl_LimitExceeded(interp)) { /* * If everything has gone OK so far, call the main loop proc, if it * exists. Packages (like Tk) can set it to start processing events at * this point. */ mainLoopProc(); Tcl_SetMainLoop(NULL); } if (is.commandPtr != NULL) { Tcl_DecrRefCount(is.commandPtr); } /* * Rather than calling exit, invoke the "exit" command so that users can * replace "exit" with some other command to do additional cleanup on * exit. The Tcl_EvalObjEx call should never return. */ if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); Tcl_IncrRefCount(cmd); Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmd); } /* * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual is * happening. Maybe interp has been deleted; maybe [exit] was redefined, * maybe we've blown up because of an exceeded limit. We still want to * cleanup and exit. */ Tcl_Exit(exitCode); } #if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE) #undef Tcl_Main extern DLLEXPORT void Tcl_Main( int argc, /* Number of arguments. */ char **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc) /* Application-specific initialization * function to call after most initialization * but before starting to execute commands. */ { Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp()); } #endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */ #if !defined(_WIN32) || defined(UNICODE) /* *--------------------------------------------------------------- * * Tcl_SetMainLoop -- * * Sets an alternative main loop function. * * Results: * None. * * Side effects: * This function will be called before Tcl exits, allowing for the * creation of an event loop. * *--------------------------------------------------------------- */ void Tcl_SetMainLoop( Tcl_MainLoopProc *proc) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->mainLoopProc = proc; } /* *--------------------------------------------------------------- * * TclGetMainLoop -- * * Returns the current alternative main loop function. * * Results: * Returns the previously defined main loop function, or NULL to indicate * that no such function has been installed and standard tclsh behaviour * (i.e., exit once the script is evaluated if not interactive) is * requested.. * * Side effects: * None (other than possible creation of this file's TSD block). * *--------------------------------------------------------------- */ Tcl_MainLoopProc * TclGetMainLoop(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); return tsdPtr->mainLoopProc; } /* *---------------------------------------------------------------------- * * TclFullFinalizationRequested -- * * This function returns true when either -DPURIFY is specified, or the * environment variable TCL_FINALIZE_ON_EXIT is set and not "0". This * predicate is called at places affecting the exit sequence, so that the * default behavior is a fast and deadlock-free exit, and the modified * behavior is a more thorough finalization for debugging purposes (leak * hunting etc). * * Results: * A boolean. * *---------------------------------------------------------------------- */ MODULE_SCOPE int TclFullFinalizationRequested(void) { #ifdef PURIFY return 1; #else const char *fin; Tcl_DString ds; int finalize = 0; fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds); finalize = ((fin != NULL) && strcmp(fin, "0")); if (fin != NULL) { Tcl_DStringFree(&ds); } return finalize; #endif /* PURIFY */ } #endif /* UNICODE */ /* *---------------------------------------------------------------------- * * StdinProc -- * * This function is invoked by the event dispatcher whenever standard * input becomes readable. It grabs the next line of input characters, * adds them to a command being assembled, and executes the command if * it's complete. * * Results: * None. * * Side effects: * Could be almost arbitrary, depending on the command that's typed. * *---------------------------------------------------------------------- */ static void StdinProc( ClientData clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { int code; int length; InteractiveState *isPtr = (InteractiveState *)clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; Tcl_Interp *interp = isPtr->interp; (void)mask; if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(chan, commandPtr); if (length < 0) { if (Tcl_InputBlocked(chan)) { return; } if (isPtr->tty) { /* * Would be better to find a way to exit the mainLoop? Or perhaps * evaluate [exit]? Leaving as is for now due to compatibility * concerns. */ Tcl_Exit(0); } Tcl_DeleteChannelHandler(chan, StdinProc, isPtr); return; } if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { isPtr->prompt = PROMPT_CONTINUE; goto prompt; } isPtr->prompt = PROMPT_START; (void)Tcl_GetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); /* * Disable the stdin channel handler while evaluating the command; * otherwise if the command re-enters the event loop we might process * commands from stdin before the current command is finished. Among other * things, this will trash the text of the command being evaluated. */ Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr); code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN); Tcl_DecrRefCount(commandPtr); TclNewObj(commandPtr); isPtr->commandPtr = commandPtr; Tcl_IncrRefCount(commandPtr); if (chan != NULL) { Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr); } if (code != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan != NULL) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } else if (isPtr->tty) { Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); (void)Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && (chan != NULL)) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); } /* * If a tty stdin is still around, output a prompt. */ prompt: if (isPtr->tty && (isPtr->input != NULL)) { Prompt(interp, isPtr); isPtr->input = Tcl_GetStdChannel(TCL_STDIN); } } /* *---------------------------------------------------------------------- * * Prompt -- * * Issue a prompt on standard output, or invoke a script to issue the * prompt. * * Results: * None. * * Side effects: * A prompt gets output, and a Tcl script may be evaluated in interp. * *---------------------------------------------------------------------- */ static void Prompt( Tcl_Interp *interp, /* Interpreter to use for prompting. */ InteractiveState *isPtr) /* InteractiveState. Filled with PROMPT_NONE * after a prompt is printed. */ { Tcl_Obj *promptCmdPtr; int code; Tcl_Channel chan; if (isPtr->prompt == PROMPT_NONE) { return; } promptCmdPtr = Tcl_GetVar2Ex(interp, (isPtr->prompt==PROMPT_CONTINUE ? "tcl_prompt2" : "tcl_prompt1"), NULL, TCL_GLOBAL_ONLY); if (Tcl_InterpDeleted(interp)) { return; } if (promptCmdPtr == NULL) { defaultPrompt: if (isPtr->prompt == PROMPT_START) { chan = Tcl_GetStdChannel(TCL_STDOUT); if (chan != NULL) { Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT, sizeof(DEFAULT_PRIMARY_PROMPT) - 1); } } } else { code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (script that generates prompt)"); chan = Tcl_GetStdChannel(TCL_STDERR); if (chan != NULL) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } goto defaultPrompt; } } chan = Tcl_GetStdChannel(TCL_STDOUT); if (chan != NULL) { Tcl_Flush(chan); } isPtr->prompt = PROMPT_NONE; } /* *---------------------------------------------------------------------- * * FreeMainInterp -- * * Exit handler used to cleanup the main interpreter and ancillary * startup script storage at exit. * *---------------------------------------------------------------------- */ static void FreeMainInterp( ClientData clientData) { Tcl_Interp *interp = (Tcl_Interp *)clientData; /*if (TclInExit()) return;*/ if (!Tcl_InterpDeleted(interp)) { Tcl_DeleteInterp(interp); } Tcl_SetStartupScript(NULL, NULL); Tcl_Release(interp); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclNamesp.c0000644000175000017500000045572514554262142015372 0ustar sergeisergei/* * tclNamesp.c -- * * Contains support for namespaces, which provide a separate context of * commands and global variables. The global :: namespace is the * traditional Tcl "global" scope. Other namespaces are created as * children of the global namespace. These other namespaces contain * special-purpose commands and variables for packages. * * Copyright (c) 1993-1997 Lucent Technologies. * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2002-2005 Donal K. Fellows. * Copyright (c) 2006 Neil Madden. * Contributions from Don Porter, NIST, 2007. (not subject to US copyright) * * Originally implemented by * Michael J. McLennan * Bell Labs Innovations for Lucent Technologies * mmclennan@lucent.com * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" /* for TclLogCommandInfo visibility */ /* * Thread-local storage used to avoid having a global lock on data that is not * limited to a single interpreter. */ typedef struct { long numNsCreated; /* Count of the number of namespaces created * within the thread. This value is used as a * unique id for each namespace. Cannot be * per-interp because the nsId is used to * distinguish objects which can be passed * around between interps in the same thread, * but does not need to be global because * object internal reps are always per-thread * anyway. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * This structure contains a cached pointer to a namespace that is the result * of resolving the namespace's name in some other namespace. It is the * internal representation for a nsName object. It contains the pointer along * with some information that is used to check the cached pointer's validity. */ typedef struct ResolvedNsName { Namespace *nsPtr; /* A cached pointer to the Namespace that the * name resolved to. */ Namespace *refNsPtr; /* Points to the namespace context in which * the name was resolved. NULL if the name is * fully qualified and thus the resolution * does not depend on the context. */ int refCount; /* Reference count: 1 for each nsName object * that has a pointer to this ResolvedNsName * structure as its internal rep. This * structure can be freed when refCount * becomes zero. */ } ResolvedNsName; /* * Declarations for functions local to this file: */ static void DeleteImportedCmd(ClientData clientData); static int DoImport(Tcl_Interp *interp, Namespace *nsPtr, Tcl_HashEntry *hPtr, const char *cmdName, const char *pattern, Namespace *importNsPtr, int allowOverwrite); static void DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr); static char * ErrorCodeRead(ClientData clientData,Tcl_Interp *interp, const char *name1, const char *name2, int flags); static char * ErrorInfoRead(ClientData clientData,Tcl_Interp *interp, const char *name1, const char *name2, int flags); static char * EstablishErrorCodeTraces(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static char * EstablishErrorInfoTraces(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void FreeNsNameInternalRep(Tcl_Obj *objPtr); static int GetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); static int InvokeImportedNRCmd(ClientData clientData, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static Tcl_ObjCmdProc InvokeImportedCmd; static Tcl_ObjCmdProc NamespaceChildrenCmd; static Tcl_ObjCmdProc NamespaceCodeCmd; static Tcl_ObjCmdProc NamespaceCurrentCmd; static Tcl_ObjCmdProc NamespaceDeleteCmd; static Tcl_ObjCmdProc NamespaceEvalCmd; static Tcl_ObjCmdProc NRNamespaceEvalCmd; static Tcl_ObjCmdProc NamespaceExistsCmd; static Tcl_ObjCmdProc NamespaceExportCmd; static Tcl_ObjCmdProc NamespaceForgetCmd; static void NamespaceFree(Namespace *nsPtr); static Tcl_ObjCmdProc NamespaceImportCmd; static Tcl_ObjCmdProc NamespaceInscopeCmd; static Tcl_ObjCmdProc NRNamespaceInscopeCmd; static Tcl_ObjCmdProc NamespaceOriginCmd; static Tcl_ObjCmdProc NamespaceParentCmd; static Tcl_ObjCmdProc NamespacePathCmd; static Tcl_ObjCmdProc NamespaceQualifiersCmd; static Tcl_ObjCmdProc NamespaceTailCmd; static Tcl_ObjCmdProc NamespaceUpvarCmd; static Tcl_ObjCmdProc NamespaceUnknownCmd; static Tcl_ObjCmdProc NamespaceWhichCmd; static int SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UnlinkNsPath(Namespace *nsPtr); static Tcl_NRPostProc NsEval_Callback; /* * This structure defines a Tcl object type that contains a namespace * reference. It is used in commands that take the name of a namespace as an * argument. The namespace reference is resolved, and the result in cached in * the object. */ static const Tcl_ObjType nsNameType = { "nsName", /* the type's name */ FreeNsNameInternalRep, /* freeIntRepProc */ DupNsNameInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetNsNameFromAny /* setFromAnyProc */ }; /* * Array of values describing how to implement each standard subcommand of the * "namespace" command. */ static const EnsembleImplMap defaultNamespaceMap[] = { {"children", NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0}, {"code", NamespaceCodeCmd, TclCompileNamespaceCodeCmd, NULL, NULL, 0}, {"current", NamespaceCurrentCmd, TclCompileNamespaceCurrentCmd, NULL, NULL, 0}, {"delete", NamespaceDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"ensemble", TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0}, {"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd, NULL, 0}, {"exists", NamespaceExistsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"export", NamespaceExportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0}, {"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0}, {"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0}, {"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0}, {"unknown", NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"upvar", NamespaceUpvarCmd, TclCompileNamespaceUpvarCmd, NULL, NULL, 0}, {"which", NamespaceWhichCmd, TclCompileNamespaceWhichCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* *---------------------------------------------------------------------- * * TclInitNamespaceSubsystem -- * * This function is called to initialize all the structures that are used * by namespaces on a per-process basis. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclInitNamespaceSubsystem(void) { /* * Does nothing for now. */ } /* *---------------------------------------------------------------------- * * Tcl_GetCurrentNamespace -- * * Returns a pointer to an interpreter's currently active namespace. * * Results: * Returns a pointer to the interpreter's current namespace. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetCurrentNamespace( Tcl_Interp *interp)/* Interpreter whose current namespace is * being queried. */ { return TclGetCurrentNamespace(interp); } /* *---------------------------------------------------------------------- * * Tcl_GetGlobalNamespace -- * * Returns a pointer to an interpreter's global :: namespace. * * Results: * Returns a pointer to the specified interpreter's global namespace. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetGlobalNamespace( Tcl_Interp *interp)/* Interpreter whose global namespace should * be returned. */ { return TclGetGlobalNamespace(interp); } /* *---------------------------------------------------------------------- * * Tcl_PushCallFrame -- * * Pushes a new call frame onto the interpreter's Tcl call stack. Called * when executing a Tcl procedure or a "namespace eval" or "namespace * inscope" command. * * Results: * Returns TCL_OK if successful, or TCL_ERROR (along with an error * message in the interpreter's result object) if something goes wrong. * * Side effects: * Modifies the interpreter's Tcl call stack. * *---------------------------------------------------------------------- */ int Tcl_PushCallFrame( Tcl_Interp *interp, /* Interpreter in which the new call frame is * to be pushed. */ Tcl_CallFrame *callFramePtr,/* Points to a call frame structure to push. * Storage for this has already been allocated * by the caller; typically this is the * address of a CallFrame structure allocated * on the caller's C stack. The call frame * will be initialized by this function. The * caller can pop the frame later with * Tcl_PopCallFrame, and it is responsible for * freeing the frame's storage. */ Tcl_Namespace *namespacePtr,/* Points to the namespace in which the frame * will execute. If NULL, the interpreter's * current namespace will be used. */ int isProcCallFrame) /* If nonzero, the frame represents a called * Tcl procedure and may have local vars. Vars * will ordinarily be looked up in the frame. * If new variables are created, they will be * created in the frame. If 0, the frame is * for a "namespace eval" or "namespace * inscope" command and var references are * treated as references to namespace * variables. */ { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = (CallFrame *) callFramePtr; Namespace *nsPtr; if (namespacePtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; /* * TODO: Examine whether it would be better to guard based on NS_DYING * or NS_KILLED. It appears that these are not tested because they can * be set in a global interp that has been [namespace delete]d, but * which never really completely goes away because of lingering global * things like ::errorInfo and [::unknown] and hidden commands. * Review of those designs might permit stricter checking here. */ if (nsPtr->flags & NS_DEAD) { Tcl_Panic("Trying to push call frame for dead namespace"); } } nsPtr->activationCount++; framePtr->nsPtr = nsPtr; framePtr->isProcCallFrame = isProcCallFrame; framePtr->objc = 0; framePtr->objv = NULL; framePtr->callerPtr = iPtr->framePtr; framePtr->callerVarPtr = iPtr->varFramePtr; if (iPtr->varFramePtr != NULL) { framePtr->level = (iPtr->varFramePtr->level + 1); } else { framePtr->level = 0; } framePtr->procPtr = NULL; /* no called procedure */ framePtr->varTablePtr = NULL; /* and no local variables */ framePtr->numCompiledLocals = 0; framePtr->compiledLocals = NULL; framePtr->clientData = NULL; framePtr->localCachePtr = NULL; framePtr->tailcallPtr = NULL; /* * Push the new call frame onto the interpreter's stack of procedure call * frames making it the current frame. */ iPtr->framePtr = framePtr; iPtr->varFramePtr = framePtr; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_PopCallFrame -- * * Removes a call frame from the Tcl call stack for the interpreter. * Called to remove a frame previously pushed by Tcl_PushCallFrame. * * Results: * None. * * Side effects: * Modifies the call stack of the interpreter. Resets various fields of * the popped call frame. If a namespace has been deleted and has no more * activations on the call stack, the namespace is destroyed. * *---------------------------------------------------------------------- */ void Tcl_PopCallFrame( Tcl_Interp *interp) /* Interpreter with call frame to pop. */ { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->framePtr; Namespace *nsPtr; /* * It's important to remove the call frame from the interpreter's stack of * call frames before deleting local variables, so that traces invoked by * the variable deletion don't see the partially-deleted frame. */ if (framePtr->callerPtr) { iPtr->framePtr = framePtr->callerPtr; iPtr->varFramePtr = framePtr->callerVarPtr; } else { /* Tcl_PopCallFrame: trying to pop rootCallFrame! */ } if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); ckfree(framePtr->varTablePtr); framePtr->varTablePtr = NULL; } if (framePtr->numCompiledLocals > 0) { TclDeleteCompiledLocalVars(iPtr, framePtr); if (--framePtr->localCachePtr->refCount == 0) { TclFreeLocalCache(interp, framePtr->localCachePtr); } framePtr->localCachePtr = NULL; } /* * Decrement the namespace's count of active call frames. If the namespace * is "dying" and there are no more active call frames, call * Tcl_DeleteNamespace to destroy it. */ nsPtr = framePtr->nsPtr; nsPtr->activationCount--; if ((nsPtr->flags & NS_DYING) && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; if (framePtr->tailcallPtr) { TclSetTailcall(interp, framePtr->tailcallPtr); } } /* *---------------------------------------------------------------------- * * TclPushStackFrame -- * * Allocates a new call frame in the interpreter's execution stack, then * pushes it onto the interpreter's Tcl call stack. Called when executing * a Tcl procedure or a "namespace eval" or "namespace inscope" command. * * Results: * Returns TCL_OK if successful, or TCL_ERROR (along with an error * message in the interpreter's result object) if something goes wrong. * * Side effects: * Modifies the interpreter's Tcl call stack. * *---------------------------------------------------------------------- */ int TclPushStackFrame( Tcl_Interp *interp, /* Interpreter in which the new call frame is * to be pushed. */ Tcl_CallFrame **framePtrPtr,/* Place to store a pointer to the stack * allocated call frame. */ Tcl_Namespace *namespacePtr,/* Points to the namespace in which the frame * will execute. If NULL, the interpreter's * current namespace will be used. */ int isProcCallFrame) /* If nonzero, the frame represents a called * Tcl procedure and may have local vars. Vars * will ordinarily be looked up in the frame. * If new variables are created, they will be * created in the frame. If 0, the frame is * for a "namespace eval" or "namespace * inscope" command and var references are * treated as references to namespace * variables. */ { *framePtrPtr = (Tcl_CallFrame *)TclStackAlloc(interp, sizeof(CallFrame)); return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr, isProcCallFrame); } void TclPopStackFrame( Tcl_Interp *interp) /* Interpreter with call frame to pop. */ { CallFrame *freePtr = ((Interp *) interp)->framePtr; Tcl_PopCallFrame(interp); TclStackFree(interp, freePtr); } /* *---------------------------------------------------------------------- * * EstablishErrorCodeTraces -- * * Creates traces on the ::errorCode variable to keep its value * consistent with the expectations of legacy code. * * Results: * None. * * Side effects: * Read and unset traces are established on ::errorCode. * *---------------------------------------------------------------------- */ static char * EstablishErrorCodeTraces( ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags) { Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS, ErrorCodeRead, NULL); Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS, EstablishErrorCodeTraces, NULL); return NULL; } /* *---------------------------------------------------------------------- * * ErrorCodeRead -- * * Called when the ::errorCode variable is read. Copies the current value * of the interp's errorCode field into ::errorCode. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static char * ErrorCodeRead( ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags) { Interp *iPtr = (Interp *) interp; if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) { return NULL; } if (iPtr->errorCode) { Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, iPtr->errorCode, TCL_GLOBAL_ONLY); return NULL; } if (NULL == Tcl_ObjGetVar2(interp, iPtr->ecVar, NULL, TCL_GLOBAL_ONLY)) { Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, Tcl_NewObj(), TCL_GLOBAL_ONLY); } return NULL; } /* *---------------------------------------------------------------------- * * EstablishErrorInfoTraces -- * * Creates traces on the ::errorInfo variable to keep its value * consistent with the expectations of legacy code. * * Results: * None. * * Side effects: * Read and unset traces are established on ::errorInfo. * *---------------------------------------------------------------------- */ static char * EstablishErrorInfoTraces( ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags) { Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS, ErrorInfoRead, NULL); Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS, EstablishErrorInfoTraces, NULL); return NULL; } /* *---------------------------------------------------------------------- * * ErrorInfoRead -- * * Called when the ::errorInfo variable is read. Copies the current value * of the interp's errorInfo field into ::errorInfo. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static char * ErrorInfoRead( ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags) { Interp *iPtr = (Interp *) interp; if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) { return NULL; } if (iPtr->errorInfo) { Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo, TCL_GLOBAL_ONLY); return NULL; } if (NULL == Tcl_ObjGetVar2(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY)) { Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, Tcl_NewObj(), TCL_GLOBAL_ONLY); } return NULL; } /* *---------------------------------------------------------------------- * * Tcl_CreateNamespace -- * * Creates a new namespace with the given name. If there is no active * namespace (i.e., the interpreter is being initialized), the global :: * namespace is created and returned. * * Results: * Returns a pointer to the new namespace if successful. If the namespace * already exists or if another error occurs, this routine returns NULL, * along with an error message in the interpreter's result object. * * Side effects: * If the name contains "::" qualifiers and a parent namespace does not * already exist, it is automatically created. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_CreateNamespace( Tcl_Interp *interp, /* Interpreter in which a new namespace is * being created. Also used for error * reporting. */ const char *name, /* Name for the new namespace. May be a * qualified name with names of ancestor * namespaces separated by "::"s. */ ClientData clientData, /* One-word value to store with namespace. */ Tcl_NamespaceDeleteProc *deleteProc) /* Function called to delete client data when * the namespace is deleted. NULL if no * function should be called. */ { Interp *iPtr = (Interp *) interp; Namespace *nsPtr, *ancestorPtr; Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr; Namespace *globalNsPtr = iPtr->globalNsPtr; const char *simpleName; Tcl_HashEntry *entryPtr; Tcl_DString buffer1, buffer2; Tcl_DString *namePtr, *buffPtr; int newEntry, nameLen; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); const char *nameStr; Tcl_DString tmpBuffer; Tcl_DStringInit(&tmpBuffer); /* * If there is no active namespace, the interpreter is being initialized. */ if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) { /* * Treat this namespace as the global namespace, and avoid looking for * a parent. */ parentPtr = NULL; simpleName = ""; goto doCreate; } /* * Ensure that there are no trailing colons as that causes chaos when a * deleteProc is specified. [Bug d614d63989] */ if (deleteProc != NULL) { nameStr = name + strlen(name) - 2; if (nameStr >= name && nameStr[1] == ':' && nameStr[0] == ':') { Tcl_DStringAppend(&tmpBuffer, name, -1); while ((nameLen = Tcl_DStringLength(&tmpBuffer)) > 0 && Tcl_DStringValue(&tmpBuffer)[nameLen-1] == ':') { Tcl_DStringSetLength(&tmpBuffer, nameLen-1); } name = Tcl_DStringValue(&tmpBuffer); } } /* * If we've ended up with an empty string now, we're attempting to create * the global namespace despite the global namespace existing. That's * naughty! */ if (*name == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace" " \"\": only global namespace can have empty name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEGLOBAL", NULL); Tcl_DStringFree(&tmpBuffer); return NULL; } /* * Find the parent for the new namespace. */ TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN, &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName); /* * If the unqualified name at the end is empty, there were trailing "::"s * after the namespace's name which we ignore. The new namespace was * already (recursively) created and is pointed to by parentPtr. */ if (*simpleName == '\0') { Tcl_DStringFree(&tmpBuffer); return (Tcl_Namespace *) parentPtr; } /* * Check for a bad namespace name and make sure that the name does not * already exist in the parent namespace. */ if ( #ifndef BREAK_NAMESPACE_COMPAT Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL #else parentPtr->childTablePtr != NULL && Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL #endif ) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create namespace \"%s\": already exists", name)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEEXISTING", NULL); Tcl_DStringFree(&tmpBuffer); return NULL; } /* * Create the new namespace and root it in its parent. Increment the count * of namespaces created. */ doCreate: nsPtr = (Namespace *)ckalloc(sizeof(Namespace)); nameLen = strlen(simpleName) + 1; nsPtr->name = (char *)ckalloc(nameLen); memcpy(nsPtr->name, simpleName, nameLen); nsPtr->fullName = NULL; /* Set below. */ nsPtr->clientData = clientData; nsPtr->deleteProc = deleteProc; nsPtr->parentPtr = parentPtr; #ifndef BREAK_NAMESPACE_COMPAT Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS); #else nsPtr->childTablePtr = NULL; #endif nsPtr->nsId = ++(tsdPtr->numNsCreated); nsPtr->interp = interp; nsPtr->flags = 0; nsPtr->activationCount = 0; nsPtr->refCount = 0; Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS); TclInitVarHashTable(&nsPtr->varTable, nsPtr); nsPtr->exportArrayPtr = NULL; nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; nsPtr->cmdRefEpoch = 0; nsPtr->resolverEpoch = 0; nsPtr->cmdResProc = NULL; nsPtr->varResProc = NULL; nsPtr->compiledVarResProc = NULL; nsPtr->exportLookupEpoch = 0; nsPtr->ensembles = NULL; nsPtr->unknownHandlerPtr = NULL; nsPtr->commandPathLength = 0; nsPtr->commandPathArray = NULL; nsPtr->commandPathSourceList = NULL; nsPtr->earlyDeleteProc = NULL; if (parentPtr != NULL) { entryPtr = Tcl_CreateHashEntry( TclGetNamespaceChildTable((Tcl_Namespace *) parentPtr), simpleName, &newEntry); Tcl_SetHashValue(entryPtr, nsPtr); } else { /* * In the global namespace create traces to maintain the ::errorInfo * and ::errorCode variables. */ iPtr->globalNsPtr = nsPtr; EstablishErrorInfoTraces(NULL, interp, NULL, NULL, 0); EstablishErrorCodeTraces(NULL, interp, NULL, NULL, 0); } /* * Build the fully qualified name for this namespace. */ Tcl_DStringInit(&buffer1); Tcl_DStringInit(&buffer2); namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { Tcl_DString *tempPtr = namePtr; TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); TclDStringAppendDString(buffPtr, namePtr); /* * Clear the unwanted buffer or we end up appending to previous * results, making the namespace fullNames of nested namespaces * very wrong (and strange). */ TclDStringClear(namePtr); /* * Now swap the buffer pointers so that we build in the other * buffer. This is faster than repeated copying back and forth * between buffers. */ namePtr = buffPtr; buffPtr = tempPtr; } } name = Tcl_DStringValue(namePtr); nameLen = Tcl_DStringLength(namePtr); nsPtr->fullName = (char *)ckalloc(nameLen + 1); memcpy(nsPtr->fullName, name, nameLen + 1); Tcl_DStringFree(&buffer1); Tcl_DStringFree(&buffer2); Tcl_DStringFree(&tmpBuffer); /* * If compilation of commands originating from the parent NS is * suppressed, suppress it for commands originating in this one too. */ if (nsPtr->parentPtr != NULL && nsPtr->parentPtr->flags & NS_SUPPRESS_COMPILATION) { nsPtr->flags |= NS_SUPPRESS_COMPILATION; } /* * Return a pointer to the new namespace. */ return (Tcl_Namespace *) nsPtr; } /* *---------------------------------------------------------------------- * * Tcl_DeleteNamespace -- * * Deletes a namespace and all of the commands, variables, and other * namespaces within it. * * Results: * None. * * Side effects: * When a namespace is deleted, it is automatically removed as a child of * its parent namespace. Also, all its commands, variables and child * namespaces are deleted. * *---------------------------------------------------------------------- */ void Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace((Tcl_Interp *) iPtr); Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr; /* * Ensure that this namespace doesn't get deallocated in the meantime. */ nsPtr->refCount++; /* * Give anyone interested - notably TclOO - a chance to use this namespace * normally despite the fact that the namespace is going to go. Allows the * calling of destructors. Will only be called once (unless re-established * by the called function). [Bug 2950259] * * Note that setting this field requires access to the internal definition * of namespaces, so it should only be accessed by code that knows about * being careful with reentrancy. */ if (nsPtr->earlyDeleteProc != NULL) { Tcl_NamespaceDeleteProc *earlyDeleteProc = nsPtr->earlyDeleteProc; nsPtr->earlyDeleteProc = NULL; nsPtr->activationCount++; earlyDeleteProc(nsPtr->clientData); nsPtr->activationCount--; } /* * Delete all coroutine commands now: break the circular ref cycle between * the namespace and the coroutine command [Bug 2724403]. This code is * essentially duplicated in TclTeardownNamespace() for all other * commands. Don't optimize to Tcl_NextHashEntry() because of traces. * * NOTE: we could avoid traversing the ns's command list by keeping a * separate list of coros. */ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL;) { cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); if (cmdPtr->nreProc == TclNRInterpCoroutine) { Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, (Tcl_Command) cmdPtr); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); } else { entryPtr = Tcl_NextHashEntry(&search); } } /* * If the namespace has associated ensemble commands, delete them first. * This leaves the actual contents of the namespace alone (unless they are * linked ensemble commands, of course). Note that this code is actually * reentrant so command delete traces won't purturb things badly. */ while (nsPtr->ensembles != NULL) { EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles; /* * Splice out and link to indicate that we've already been killed. */ nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next; ensemblePtr->next = ensemblePtr; Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token); } /* * If the namespace has a registered unknown handler (TIP 181), then free * it here. */ if (nsPtr->unknownHandlerPtr != NULL) { Tcl_DecrRefCount(nsPtr->unknownHandlerPtr); nsPtr->unknownHandlerPtr = NULL; } /* * If the namespace is on the call frame stack, it is marked as "dying" * (NS_DYING is OR'd into its flags): the namespace can't be looked up by * name but its commands and variables are still usable by those active * call frames. When all active call frames referring to the namespace * have been popped from the Tcl stack, Tcl_PopCallFrame will call this * function again to delete everything in the namespace. If no nsName * objects refer to the namespace (i.e., if its refCount is zero), its * commands and variables are deleted and the storage for its namespace * structure is freed. Otherwise, if its refCount is nonzero, the * namespace's commands and variables are deleted but the structure isn't * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the * namespace resolution code to recognize that the namespace is "deleted". * The structure's storage is freed by FreeNsNameInternalRep when its * refCount reaches 0. */ if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) { nsPtr->flags |= NS_DYING; if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry( TclGetNamespaceChildTable((Tcl_Namespace *) nsPtr->parentPtr), nsPtr->name); if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } } nsPtr->parentPtr = NULL; } else if (!(nsPtr->flags & NS_KILLED)) { /* * Delete the namespace and everything in it. If this is the global * namespace, then clear it but don't free its storage unless the * interpreter is being torn down. Set the NS_KILLED flag to avoid * recursive calls here - if the namespace is really in the process of * being deleted, ignore any second call. */ nsPtr->flags |= (NS_DYING|NS_KILLED); TclTeardownNamespace(nsPtr); if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) { /* * If this is the global namespace, then it may have residual * "errorInfo" and "errorCode" variables for errors that occurred * while it was being torn down. Try to clear the variable list * one last time. */ TclDeleteNamespaceVars(nsPtr); #ifndef BREAK_NAMESPACE_COMPAT Tcl_DeleteHashTable(&nsPtr->childTable); #else if (nsPtr->childTablePtr != NULL) { Tcl_DeleteHashTable(nsPtr->childTablePtr); ckfree(nsPtr->childTablePtr); } #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); nsPtr ->flags |= NS_DEAD; } else { /* * Restore the ::errorInfo and ::errorCode traces. */ EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0); EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0); /* * We didn't really kill it, so remove the KILLED marks, so it can * get killed later, avoiding mem leaks. */ nsPtr->flags &= ~(NS_DYING|NS_KILLED); } } TclNsDecrRefCount(nsPtr); } int TclNamespaceDeleted( Namespace *nsPtr) { return (nsPtr->flags & NS_DYING) ? 1 : 0; } /* *---------------------------------------------------------------------- * * TclTeardownNamespace -- * * Used internally to dismantle and unlink a namespace when it is * deleted. Divorces the namespace from its parent, and deletes all * commands, variables, and child namespaces. * * This is kept separate from Tcl_DeleteNamespace so that the global * namespace can be handled specially. * * Results: * None. * * Side effects: * Removes this namespace from its parent's child namespace hashtable. * Deletes all commands, variables and namespaces in this namespace. * *---------------------------------------------------------------------- */ void TclTeardownNamespace( Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; int i; /* * Start by destroying the namespace's variable table, since variables * might trigger traces. Variable table should be cleared but not freed! * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards. */ TclDeleteNamespaceVars(nsPtr); TclInitVarHashTable(&nsPtr->varTable, nsPtr); /* * Delete all commands in this namespace. Be careful when traversing the * hash table: when each command is deleted, it removes itself from the * command table. Because of traces (and the desire to avoid the quadratic * problems of just using Tcl_FirstHashEntry over and over, [Bug * f97d4ee020]) we copy to a temporary array and then delete all those * commands. */ while (nsPtr->cmdTable.numEntries > 0) { int length = nsPtr->cmdTable.numEntries; Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Command *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { cmds[i] = (Command *)Tcl_GetHashValue(entryPtr); cmds[i]->refCount++; i++; } for (i = 0 ; i < length ; i++) { Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, (Tcl_Command) cmds[i]); TclCleanupCommandMacro(cmds[i]); } TclStackFree((Tcl_Interp *) iPtr, cmds); } Tcl_DeleteHashTable(&nsPtr->cmdTable); Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS); /* * Remove the namespace from its parent's child hashtable. */ if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry( TclGetNamespaceChildTable((Tcl_Namespace *) nsPtr->parentPtr), nsPtr->name); if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } } nsPtr->parentPtr = NULL; /* * Delete the namespace path if one is installed. */ if (nsPtr->commandPathLength != 0) { UnlinkNsPath(nsPtr); nsPtr->commandPathLength = 0; } if (nsPtr->commandPathSourceList != NULL) { NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList; do { if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) { nsPathPtr->creatorNsPtr->cmdRefEpoch++; } nsPathPtr->nsPtr = NULL; nsPathPtr = nsPathPtr->nextPtr; } while (nsPathPtr != NULL); nsPtr->commandPathSourceList = NULL; } /* * Delete all the child namespaces. * * BE CAREFUL: When each child is deleted, it will divorce itself from its * parent. You can't traverse a hash table properly if its elements are * being deleted. Because of traces (and the desire to avoid the * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug * f97d4ee020]) we copy to a temporary array and then delete all those * namespaces. * * Important: leave the hash table itself still live. */ #ifndef BREAK_NAMESPACE_COMPAT while (nsPtr->childTable.numEntries > 0) { int length = nsPtr->childTable.numEntries; Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { children[i] = Tcl_GetHashValue(entryPtr); children[i]->refCount++; i++; } for (i = 0 ; i < length ; i++) { Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); TclNsDecrRefCount(children[i]); } TclStackFree((Tcl_Interp *) iPtr, children); } #else if (nsPtr->childTablePtr != NULL) { while (nsPtr->childTablePtr->numEntries > 0) { int length = nsPtr->childTablePtr->numEntries; Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { children[i] = Tcl_GetHashValue(entryPtr); children[i]->refCount++; i++; } for (i = 0 ; i < length ; i++) { Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); TclNsDecrRefCount(children[i]); } TclStackFree((Tcl_Interp *) iPtr, children); } } #endif /* * Free the namespace's export pattern array. */ if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { ckfree(nsPtr->exportArrayPtr[i]); } ckfree(nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; } /* * Free any client data associated with the namespace. */ if (nsPtr->deleteProc != NULL) { nsPtr->deleteProc(nsPtr->clientData); } nsPtr->deleteProc = NULL; nsPtr->clientData = NULL; /* * Reset the namespace's id field to ensure that this namespace won't be * interpreted as valid by, e.g., the cache validation code for cached * command references in Tcl_GetCommandFromObj. */ nsPtr->nsId = 0; } /* *---------------------------------------------------------------------- * * NamespaceFree -- * * Called after a namespace has been deleted, when its reference count * reaches 0. Frees the data structure representing the namespace. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void NamespaceFree( Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is * deleted by Tcl_DeleteNamespace. All that remains is to free its names * (for error messages), and the structure itself. */ ckfree(nsPtr->name); ckfree(nsPtr->fullName); ckfree(nsPtr); } /* *---------------------------------------------------------------------- * * TclNsDecrRefCount -- * * Drops a reference to a namespace and frees it if the namespace has * been deleted and the last reference has just been dropped. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclNsDecrRefCount( Namespace *nsPtr) { nsPtr->refCount--; if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) { NamespaceFree(nsPtr); } } /* *---------------------------------------------------------------------- * * Tcl_Export -- * * Makes all the commands matching a pattern available to later be * imported from the namespace specified by namespacePtr (or the current * namespace if namespacePtr is NULL). The specified pattern is appended * onto the namespace's export pattern list, which is optionally cleared * beforehand. * * Results: * Returns TCL_OK if successful, or TCL_ERROR (along with an error * message in the interpreter's result) if something goes wrong. * * Side effects: * Appends the export pattern onto the namespace's export list. * Optionally reset the namespace's export pattern list. * *---------------------------------------------------------------------- */ int Tcl_Export( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Namespace *namespacePtr,/* Points to the namespace from which commands * are to be exported. NULL for the current * namespace. */ const char *pattern, /* String pattern indicating which commands to * export. This pattern may not include any * namespace qualifiers; only commands in the * specified namespace may be exported. */ int resetListFirst) /* If nonzero, resets the namespace's export * list before appending. */ { #define INIT_EXPORT_PATTERNS 5 Namespace *nsPtr, *exportNsPtr, *dummyPtr; Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); const char *simplePattern; char *patternCpy; int neededElems, len, i; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { nsPtr = (Namespace *) currNsPtr; } else { nsPtr = (Namespace *) namespacePtr; } /* * If resetListFirst is true (nonzero), clear the namespace's export * pattern list. */ if (resetListFirst) { if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { ckfree(nsPtr->exportArrayPtr[i]); } ckfree(nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; TclInvalidateNsCmdLookup(nsPtr); nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; } } /* * Check that the pattern doesn't have namespace qualifiers. */ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern" " \"%s\": pattern can't specify a namespace", pattern)); Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL); return TCL_ERROR; } /* * Make sure that we don't already have the pattern in the array */ if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) { /* * The pattern already exists in the list. */ return TCL_OK; } } } /* * Make sure there is room in the namespace's pattern array for the new * pattern. */ neededElems = nsPtr->numExportPatterns + 1; if (neededElems > nsPtr->maxExportPatterns) { nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ? 2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS; nsPtr->exportArrayPtr = (char **)ckrealloc(nsPtr->exportArrayPtr, sizeof(char *) * nsPtr->maxExportPatterns); } /* * Add the pattern to the namespace's array of export patterns. */ len = strlen(pattern); patternCpy = (char *)ckalloc(len + 1); memcpy(patternCpy, pattern, len + 1); nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy; nsPtr->numExportPatterns++; /* * The list of commands actually exported from the namespace might have * changed (probably will have!) However, we do not need to recompute this * just yet; next time we need the info will be soon enough. */ TclInvalidateNsCmdLookup(nsPtr); return TCL_OK; #undef INIT_EXPORT_PATTERNS } /* *---------------------------------------------------------------------- * * Tcl_AppendExportList -- * * Appends onto the argument object the list of export patterns for the * specified namespace. * * Results: * The return value is normally TCL_OK; in this case the object * referenced by objPtr has each export pattern appended to it. If an * error occurs, TCL_ERROR is returned and the interpreter's result holds * an error message. * * Side effects: * If necessary, the object referenced by objPtr is converted into a list * object. * *---------------------------------------------------------------------- */ int Tcl_AppendExportList( Tcl_Interp *interp, /* Interpreter used for error reporting. */ Tcl_Namespace *namespacePtr,/* Points to the namespace whose export * pattern list is appended onto objPtr. NULL * for the current namespace. */ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the * export pattern list is appended. */ { Namespace *nsPtr; int i, result; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; } /* * Append the export pattern list onto objPtr. */ for (i = 0; i < nsPtr->numExportPatterns; i++) { result = Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(nsPtr->exportArrayPtr[i], -1)); if (result != TCL_OK) { return result; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_Import -- * * Imports all of the commands matching a pattern into the namespace * specified by namespacePtr (or the current namespace if contextNsPtr is * NULL). This is done by creating a new command (the "imported command") * that points to the real command in its original namespace. * * If matching commands are on the autoload path but haven't been loaded * yet, this command forces them to be loaded, then creates the links to * them. * * Results: * Returns TCL_OK if successful, or TCL_ERROR (along with an error * message in the interpreter's result) if something goes wrong. * * Side effects: * Creates new commands in the importing namespace. These indirect calls * back to the real command and are deleted if the real commands are * deleted. * *---------------------------------------------------------------------- */ int Tcl_Import( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Namespace *namespacePtr,/* Points to the namespace into which the * commands are to be imported. NULL for the * current namespace. */ const char *pattern, /* String pattern indicating which commands to * import. This pattern should be qualified by * the name of the namespace from which to * import the command(s). */ int allowOverwrite) /* If nonzero, allow existing commands to be * overwritten by imported commands. If 0, * return an error if an imported cmd * conflicts with an existing one. */ { Namespace *nsPtr, *importNsPtr, *dummyPtr; const char *simplePattern; Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; } /* * First, invoke the "auto_import" command with the pattern being * imported. This command is part of the Tcl library. It looks for * imported commands in autoloaded libraries and loads them in. That way, * they will be found when we try to create links below. * * Note that we don't just call Tcl_EvalObjv() directly because we do not * want absence of the command to be a failure case. */ if (Tcl_FindCommand(interp,"auto_import",NULL,TCL_GLOBAL_ONLY) != NULL) { Tcl_Obj *objv[2]; int result; TclNewLiteralStringObj(objv[0], "auto_import"); objv[1] = Tcl_NewStringObj(pattern, -1); Tcl_IncrRefCount(objv[0]); Tcl_IncrRefCount(objv[1]); result = Tcl_EvalObjv(interp, 2, objv, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(objv[0]); Tcl_DecrRefCount(objv[1]); if (result != TCL_OK) { return TCL_ERROR; } Tcl_ResetResult(interp); } /* * From the pattern, find the namespace from which we are importing and * get the simple pattern (no namespace qualifiers or ::'s) at the end. */ if (strlen(pattern) == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL); return TCL_ERROR; } TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (importNsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown namespace in import pattern \"%s\"", pattern)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL); return TCL_ERROR; } if (importNsPtr == nsPtr) { if (pattern == simplePattern) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no namespace specified in import pattern \"%s\"", pattern)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", NULL); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "import pattern \"%s\" tries to import from namespace" " \"%s\" into itself", pattern, importNsPtr->name)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", NULL); } return TCL_ERROR; } /* * Scan through the command table in the source namespace and look for * exported commands that match the string pattern. Create an "imported * command" in the current namespace for each imported command; these * commands redirect their invocations to the "real" command. */ if ((simplePattern != NULL) && TclMatchIsTrivial(simplePattern)) { hPtr = Tcl_FindHashEntry(&importNsPtr->cmdTable, simplePattern); if (hPtr == NULL) { return TCL_OK; } return DoImport(interp, nsPtr, hPtr, simplePattern, pattern, importNsPtr, allowOverwrite); } for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { char *cmdName = (char *)Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern) && DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite) == TCL_ERROR) { return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * DoImport -- * * Import a particular command from one namespace into another. Helper * for Tcl_Import(). * * Results: * Standard Tcl result code. If TCL_ERROR, appends an error message to * the interpreter result. * * Side effects: * A new command is created in the target namespace unless this is a * reimport of exactly the same command as before. * *---------------------------------------------------------------------- */ static int DoImport( Tcl_Interp *interp, Namespace *nsPtr, Tcl_HashEntry *hPtr, const char *cmdName, const char *pattern, Namespace *importNsPtr, int allowOverwrite) { int i = 0, exported = 0; Tcl_HashEntry *found; /* * The command cmdName in the source namespace matches the pattern. Check * whether it was exported. If it wasn't, we ignore it. */ while (!exported && (i < importNsPtr->numExportPatterns)) { exported |= Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i++]); } if (!exported) { return TCL_OK; } /* * Unless there is a name clash, create an imported command in the current * namespace that refers to cmdPtr. */ found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName); if ((found == NULL) || allowOverwrite) { /* * Create the imported command and its client data. To create the new * command in the current namespace, generate a fully qualified name * for it. */ Tcl_DString ds; Tcl_Command importedCmd; ImportedCmdData *dataPtr; Command *cmdPtr; ImportRef *refPtr; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, nsPtr->fullName, -1); if (nsPtr != ((Interp *) interp)->globalNsPtr) { TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, cmdName, -1); /* * Check whether creating the new imported command in the current * namespace would create a cycle of imported command references. */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) { Command *overwrite = (Command *)Tcl_GetHashValue(found); Command *linkCmd = cmdPtr; while (linkCmd->deleteProc == DeleteImportedCmd) { dataPtr = (ImportedCmdData *)linkCmd->objClientData; linkCmd = dataPtr->realCmdPtr; if (overwrite == linkCmd) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "import pattern \"%s\" would create a loop" " containing command \"%s\"", pattern, Tcl_DStringValue(&ds))); Tcl_DStringFree(&ds); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL); return TCL_ERROR; } } } dataPtr = (ImportedCmdData *)ckalloc(sizeof(ImportedCmdData)); importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), InvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd); dataPtr->realCmdPtr = cmdPtr; dataPtr->selfPtr = (Command *) importedCmd; dataPtr->selfPtr->compileProc = cmdPtr->compileProc; Tcl_DStringFree(&ds); /* * Create an ImportRef structure describing this new import command * and add it to the import ref list in the "real" command. */ refPtr = (ImportRef *)ckalloc(sizeof(ImportRef)); refPtr->importedCmdPtr = (Command *) importedCmd; refPtr->nextPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = refPtr; } else { Command *overwrite = (Command *)Tcl_GetHashValue(found); if (overwrite->deleteProc == DeleteImportedCmd) { ImportedCmdData *dataPtr = (ImportedCmdData *)overwrite->objClientData; if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) { /* * Repeated import of same command is acceptable. */ return TCL_OK; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't import command \"%s\": already exists", cmdName)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ForgetImport -- * * Deletes commands previously imported into the namespace indicated. * The by namespacePtr, or the current namespace of interp, when * namespacePtr is NULL. The pattern controls which imported commands are * deleted. A simple pattern, one without namespace separators, matches * the current command names of imported commands in the namespace. * Matching imported commands are deleted. A qualified pattern is * interpreted as deletion selection on the basis of where the command is * imported from. The original command and "first link" command for each * imported command are determined, and they are matched against the * pattern. A match leads to deletion of the imported command. * * Results: * Returns TCL_ERROR and records an error message in the interp result if * a namespace qualified pattern refers to a namespace that does not * exist. Otherwise, returns TCL_OK. * * Side effects: * May delete commands. * *---------------------------------------------------------------------- */ int Tcl_ForgetImport( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Namespace *namespacePtr,/* Points to the namespace from which * previously imported commands should be * removed. NULL for current namespace. */ const char *pattern) /* String pattern indicating which imported * commands to remove. */ { Namespace *nsPtr, *sourceNsPtr, *dummyPtr; const char *simplePattern; char *cmdName; Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; } /* * Parse the pattern into its namespace-qualification (if any) and the * simple pattern. */ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (sourceNsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown namespace in namespace forget pattern \"%s\"", pattern)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL); return TCL_ERROR; } if (strcmp(pattern, simplePattern) == 0) { /* * The pattern is simple. Delete any imported commands that match it. */ if (TclMatchIsTrivial(simplePattern)) { hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (hPtr != NULL) { Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); if (cmdPtr && (cmdPtr->deleteProc == DeleteImportedCmd)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); } } return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc != DeleteImportedCmd) { continue; } cmdName = (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); } } return TCL_OK; } /* * The pattern was namespace-qualified. */ for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { Tcl_CmdInfo info; Tcl_Command token = (Tcl_Command)Tcl_GetHashValue(hPtr); Tcl_Command origin = TclGetOriginalCommand(token); if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) { continue; /* Not an imported command. */ } if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) { /* * Original not in namespace we're matching. Check the first link * in the import chain. */ Command *cmdPtr = (Command *) token; ImportedCmdData *dataPtr = (ImportedCmdData *)cmdPtr->objClientData; Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr; if (firstToken == origin) { continue; } Tcl_GetCommandInfoFromToken(firstToken, &info); if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) { continue; } origin = firstToken; } if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)){ Tcl_DeleteCommandFromToken(interp, token); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclGetOriginalCommand -- * * An imported command is created in an namespace when a "real" command * is imported from another namespace. If the specified command is an * imported command, this function returns the original command it refers * to. * * Results: * If the command was imported into a sequence of namespaces a, b,...,n * where each successive namespace just imports the command from the * previous namespace, this function returns the Tcl_Command token in the * first namespace, a. Otherwise, if the specified command is not an * imported command, the function returns NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Command TclGetOriginalCommand( Tcl_Command command) /* The imported command for which the original * command should be returned. */ { Command *cmdPtr = (Command *) command; ImportedCmdData *dataPtr; if (cmdPtr->deleteProc != DeleteImportedCmd) { return NULL; } while (cmdPtr->deleteProc == DeleteImportedCmd) { dataPtr = (ImportedCmdData *)cmdPtr->objClientData; cmdPtr = dataPtr->realCmdPtr; } return (Tcl_Command) cmdPtr; } /* *---------------------------------------------------------------------- * * InvokeImportedCmd -- * * Invoked by Tcl whenever the user calls an imported command that was * created by Tcl_Import. Finds the "real" command (in another * namespace), and passes control to it. * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result object is set to an error message. * *---------------------------------------------------------------------- */ static int InvokeImportedNRCmd( ClientData clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; Command *realCmdPtr = dataPtr->realCmdPtr; TclSkipTailcall(interp); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr); } static int InvokeImportedCmd( ClientData clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData, objc, objv); } /* *---------------------------------------------------------------------- * * DeleteImportedCmd -- * * Invoked by Tcl whenever an imported command is deleted. The "real" * command keeps a list of all the imported commands that refer to it, so * those imported commands can be deleted when the real command is * deleted. This function removes the imported command reference from the * real command's list, and frees up the memory associated with the * imported command. * * Results: * None. * * Side effects: * Removes the imported command from the real command's import list. * *---------------------------------------------------------------------- */ static void DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; ImportRef *refPtr, *prevPtr; prevPtr = NULL; for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL; refPtr = refPtr->nextPtr) { if (refPtr->importedCmdPtr == selfPtr) { /* * Remove *refPtr from real command's list of imported commands * that refer to it. */ if (prevPtr == NULL) { /* refPtr is first in list. */ realCmdPtr->importRefPtr = refPtr->nextPtr; } else { prevPtr->nextPtr = refPtr->nextPtr; } ckfree(refPtr); ckfree(dataPtr); return; } prevPtr = refPtr; } Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references"); } /* *---------------------------------------------------------------------- * * TclGetNamespaceForQualName -- * * Given a qualified name specifying a command, variable, or namespace, * and a namespace in which to resolve the name, this function returns a * pointer to the namespace that contains the item. A qualified name * consists of the "simple" name of an item qualified by the names of an * arbitrary number of containing namespace separated by "::"s. If the * qualified name starts with "::", it is interpreted absolutely from the * global namespace. Otherwise, it is interpreted relative to the * namespace specified by cxtNsPtr if it is non-NULL. If cxtNsPtr is * NULL, the name is interpreted relative to the current namespace. * * A relative name like "foo::bar::x" can be found starting in either the * current namespace or in the global namespace. So each search usually * follows two tracks, and two possible namespaces are returned. If the * function sets either *nsPtrPtr or *altNsPtrPtr to NULL, then that path * failed. * * If "flags" contains TCL_GLOBAL_ONLY, the relative qualified name is * sought only in the global :: namespace. The alternate search (also) * starting from the global namespace is ignored and *altNsPtrPtr is set * NULL. * * If "flags" contains TCL_NAMESPACE_ONLY, the relative qualified name is * sought only in the namespace specified by cxtNsPtr. The alternate * search starting from the global namespace is ignored and *altNsPtrPtr * is set NULL. If both TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY are * specified, TCL_GLOBAL_ONLY is ignored and the search starts from the * namespace specified by cxtNsPtr. * * If "flags" contains TCL_CREATE_NS_IF_UNKNOWN, all namespace components * of the qualified name that cannot be found are automatically created * within their specified parent. This makes sure that functions like * Tcl_CreateCommand always succeed. There is no alternate search path, * so *altNsPtrPtr is set NULL. * * If "flags" contains TCL_FIND_ONLY_NS, the qualified name is treated as * a reference to a namespace, and the entire qualified name is followed. * If the name is relative, the namespace is looked up only in the * current namespace. A pointer to the namespace is stored in *nsPtrPtr * and NULL is stored in *simpleNamePtr. Otherwise, if TCL_FIND_ONLY_NS * is not specified, only the leading components are treated as namespace * names, and a pointer to the simple name of the final component is * stored in *simpleNamePtr. * * Results: * It sets *nsPtrPtr and *altNsPtrPtr to point to the two possible * namespaces which represent the last (containing) namespace in the * qualified name. If the function sets either *nsPtrPtr or *altNsPtrPtr * to NULL, then the search along that path failed. The function also * stores a pointer to the simple name of the final component in * *simpleNamePtr. If the qualified name is "::" or was treated as a * namespace reference (TCL_FIND_ONLY_NS), the function stores a pointer * to the namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets * *simpleNamePtr to point to an empty string. * * If there is an error, this function returns TCL_ERROR. If "flags" * contains TCL_LEAVE_ERR_MSG, an error message is returned in the * interpreter's result object. Otherwise, the interpreter's result * object is left unchanged. * * *actualCxtPtrPtr is set to the actual context namespace. It is set to * the input context namespace pointer in cxtNsPtr. If cxtNsPtr is NULL, * it is set to the current namespace context. * * For backwards compatibility with the TclPro byte code loader, this * function always returns TCL_OK. * * Side effects: * If "flags" contains TCL_CREATE_NS_IF_UNKNOWN, new namespaces may be * created. * *---------------------------------------------------------------------- */ int TclGetNamespaceForQualName( Tcl_Interp *interp, /* Interpreter in which to find the namespace * containing qualName. */ const char *qualName, /* A namespace-qualified name of an command, * variable, or namespace. */ Namespace *cxtNsPtr, /* The namespace in which to start the search * for qualName's namespace. If NULL start * from the current namespace. Ignored if * TCL_GLOBAL_ONLY is set. */ int flags, /* Flags controlling the search: an OR'd * combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, TCL_FIND_ONLY_NS, and * TCL_CREATE_NS_IF_UNKNOWN. */ Namespace **nsPtrPtr, /* Address where function stores a pointer to * containing namespace if qualName is found * starting from *cxtNsPtr or, if * TCL_GLOBAL_ONLY is set, if qualName is * found in the global :: namespace. NULL is * stored otherwise. */ Namespace **altNsPtrPtr, /* Address where function stores a pointer to * containing namespace if qualName is found * starting from the global :: namespace. * NULL is stored if qualName isn't found * starting from :: or if the TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, TCL_FIND_ONLY_NS, * TCL_CREATE_NS_IF_UNKNOWN flag is set. */ Namespace **actualCxtPtrPtr,/* Address where function stores a pointer to * the actual namespace from which the search * started. This is either cxtNsPtr, the :: * namespace if TCL_GLOBAL_ONLY was specified, * or the current namespace if cxtNsPtr was * NULL. */ const char **simpleNamePtr) /* Address where function stores the simple * name at end of the qualName, or NULL if * qualName is "::" or the flag * TCL_FIND_ONLY_NS was specified. */ { Interp *iPtr = (Interp *) interp; Namespace *nsPtr = cxtNsPtr; Namespace *altNsPtr; Namespace *globalNsPtr = iPtr->globalNsPtr; const char *start, *end; const char *nsName; Tcl_HashEntry *entryPtr; Tcl_DString buffer; int len; /* * Determine the context namespace nsPtr in which to start the primary * search. If the qualName name starts with a "::" or TCL_GLOBAL_ONLY was * specified, search from the global namespace. Otherwise, use the * namespace given in cxtNsPtr, or if that is NULL, use the current * namespace context. Note that we always treat two or more adjacent ":"s * as a namespace separator. */ if (flags & TCL_GLOBAL_ONLY) { nsPtr = globalNsPtr; } else if (nsPtr == NULL) { nsPtr = iPtr->varFramePtr->nsPtr; } start = qualName; /* Points to start of qualifying * namespace. */ if ((*qualName == ':') && (*(qualName+1) == ':')) { start = qualName+2; /* Skip over the initial :: */ while (*start == ':') { start++; /* Skip over a subsequent : */ } nsPtr = globalNsPtr; if (*start == '\0') { /* qualName is just two or more * ":"s. */ *nsPtrPtr = globalNsPtr; *altNsPtrPtr = NULL; *actualCxtPtrPtr = globalNsPtr; *simpleNamePtr = start; /* Points to empty string. */ return TCL_OK; } } *actualCxtPtrPtr = nsPtr; /* * Start an alternate search path starting with the global namespace. * However, if the starting context is the global namespace, or if the * flag is set to search only the namespace *cxtNsPtr, ignore the * alternate search path. */ altNsPtr = globalNsPtr; if ((nsPtr == globalNsPtr) || (flags & (TCL_NAMESPACE_ONLY | TCL_FIND_ONLY_NS))) { altNsPtr = NULL; } /* * Loop to resolve each namespace qualifier in qualName. */ Tcl_DStringInit(&buffer); end = start; while (*start != '\0') { /* * Find the next namespace qualifier (i.e., a name ending in "::") or * the end of the qualified name (i.e., a name ending in "\0"). Set * len to the number of characters, starting from start, in the name; * set end to point after the "::"s or at the "\0". */ len = 0; for (end = start; *end != '\0'; end++) { if ((*end == ':') && (*(end+1) == ':')) { end += 2; /* Skip over the initial :: */ while (*end == ':') { end++; /* Skip over the subsequent : */ } break; /* Exit for loop; end is after ::'s */ } len++; } if (*end=='\0' && !(end-start>=2 && *(end-1)==':' && *(end-2)==':')) { /* * qualName ended with a simple name at start. If TCL_FIND_ONLY_NS * was specified, look this up as a namespace. Otherwise, start is * the name of a cmd or var and we are done. */ if (flags & TCL_FIND_ONLY_NS) { nsName = start; } else { *nsPtrPtr = nsPtr; *altNsPtrPtr = altNsPtr; *simpleNamePtr = start; Tcl_DStringFree(&buffer); return TCL_OK; } } else { /* * start points to the beginning of a namespace qualifier ending * in "::". end points to the start of a name in that namespace * that might be empty. Copy the namespace qualifier to a buffer * so it can be null terminated. We can't modify the incoming * qualName since it may be a string constant. */ TclDStringClear(&buffer); Tcl_DStringAppend(&buffer, start, len); nsName = Tcl_DStringValue(&buffer); } /* * Look up the namespace qualifier nsName in the current namespace * context. If it isn't found but TCL_CREATE_NS_IF_UNKNOWN is set, * create that qualifying namespace. This is needed for functions like * Tcl_CreateCommand that cannot fail. */ if (nsPtr != NULL) { #ifndef BREAK_NAMESPACE_COMPAT entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName); #else if (nsPtr->childTablePtr == NULL) { entryPtr = NULL; } else { entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName); } #endif if (entryPtr != NULL) { nsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) { Tcl_CallFrame *framePtr; (void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0); nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName, NULL, NULL); TclPopStackFrame(interp); if (nsPtr == NULL) { Tcl_Panic("Could not create namespace '%s'", nsName); } } else { /* Namespace not found and was not * created. */ nsPtr = NULL; } } /* * Look up the namespace qualifier in the alternate search path too. */ if (altNsPtr != NULL) { #ifndef BREAK_NAMESPACE_COMPAT entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName); #else if (altNsPtr->childTablePtr != NULL) { entryPtr = Tcl_FindHashEntry(altNsPtr->childTablePtr, nsName); } else { entryPtr = NULL; } #endif if (entryPtr != NULL) { altNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); } else { altNsPtr = NULL; } } /* * If both search paths have failed, return NULL results. */ if ((nsPtr == NULL) && (altNsPtr == NULL)) { *nsPtrPtr = NULL; *altNsPtrPtr = NULL; *simpleNamePtr = NULL; Tcl_DStringFree(&buffer); return TCL_OK; } start = end; } /* * We ignore trailing "::"s in a namespace name, but in a command or * variable name, trailing "::"s refer to the cmd or var named {}. */ if ((flags & TCL_FIND_ONLY_NS) || (end>start && *(end-1)!=':')) { *simpleNamePtr = NULL; /* Found namespace name. */ } else { *simpleNamePtr = end; /* Found cmd/var: points to empty * string. */ } /* * As a special case, if we are looking for a namespace and qualName is "" * and the current active namespace (nsPtr) is not the global namespace, * return NULL (no namespace was found). This is because namespaces can * not have empty names except for the global namespace. */ if ((flags & TCL_FIND_ONLY_NS) && (*qualName == '\0') && (nsPtr != globalNsPtr)) { nsPtr = NULL; } *nsPtrPtr = nsPtr; *altNsPtrPtr = altNsPtr; Tcl_DStringFree(&buffer); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclEnsureNamespace -- * * Provide a namespace that is not deleted. * * Value * * namespacePtr, if it is not scheduled for deletion, or a pointer to a * new namespace with the same name otherwise. * * Effect * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * TclEnsureNamespace( Tcl_Interp *interp, Tcl_Namespace *namespacePtr) { Namespace *nsPtr = (Namespace *) namespacePtr; if (!(nsPtr->flags & NS_DYING)) { return namespacePtr; } return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL); } /* *---------------------------------------------------------------------- * * Tcl_FindNamespace -- * * Searches for a namespace. * * Results: * Returns a pointer to the namespace if it is found. Otherwise, returns * NULL and leaves an error message in the interpreter's result object if * "flags" contains TCL_LEAVE_ERR_MSG. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_FindNamespace( Tcl_Interp *interp, /* The interpreter in which to find the * namespace. */ const char *name, /* Namespace name. If it starts with "::", * will be looked up in global namespace. * Else, looked up first in contextNsPtr * (current namespace if contextNsPtr is * NULL), then in global namespace. */ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or * if the name starts with "::". Otherwise, * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; const char *dummy; /* * Find the namespace(s) that contain the specified namespace name. Add * the TCL_FIND_ONLY_NS flag to resolve the name all the way down to its * last component, a namespace. */ TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, flags|TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); if (nsPtr != NULL) { return (Tcl_Namespace *) nsPtr; } if (flags & TCL_LEAVE_ERR_MSG) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown namespace \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL); } return NULL; } /* *---------------------------------------------------------------------- * * Tcl_FindCommand -- * * Searches for a command. * * Results: * Returns a token for the command if it is found. Otherwise, if it can't * be found or there is an error, returns NULL and leaves an error * message in the interpreter's result object if "flags" contains * TCL_LEAVE_ERR_MSG. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Command Tcl_FindCommand( Tcl_Interp *interp, /* The interpreter in which to find the * command and to report errors. */ const char *name, /* Command's name. If it starts with "::", * will be looked up in global namespace. * Else, looked up first in contextNsPtr * (current namespace if contextNsPtr is * NULL), then in global namespace. */ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set. * Otherwise, points to namespace in which to * resolve name. If NULL, look up name in the * current namespace. */ int flags) /* An OR'd combination of flags: * TCL_GLOBAL_ONLY (look up name only in * global namespace), TCL_NAMESPACE_ONLY (look * up only in contextNsPtr, or the current * namespace if contextNsPtr is NULL), and * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY * and TCL_NAMESPACE_ONLY are given, * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; Namespace *cxtNsPtr; Tcl_HashEntry *entryPtr; Command *cmdPtr; const char *simpleName; int result; /* * If this namespace has a command resolver, then give it first crack at * the command resolution. If the interpreter has any command resolvers, * consult them next. The command resolver functions may return a * Tcl_Command value, they may signal to continue onward, or they may * signal an error. */ if ((flags & TCL_GLOBAL_ONLY) || !strncmp(name, "::", 2)) { cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp); } else if (contextNsPtr != NULL) { cxtNsPtr = (Namespace *) contextNsPtr; } else { cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp); } if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) { ResolverScheme *resPtr = iPtr->resolverPtr; Tcl_Command cmd; if (cxtNsPtr->cmdResProc) { result = cxtNsPtr->cmdResProc(interp, name, (Tcl_Namespace *) cxtNsPtr, flags, &cmd); } else { result = TCL_CONTINUE; } while (result == TCL_CONTINUE && resPtr) { if (resPtr->cmdResProc) { result = resPtr->cmdResProc(interp, name, (Tcl_Namespace *) cxtNsPtr, flags, &cmd); } resPtr = resPtr->nextPtr; } if (result == TCL_OK) { ((Command *)cmd)->flags |= CMD_VIA_RESOLVER; return cmd; } else if (result != TCL_CONTINUE) { return NULL; } } /* * Find the namespace(s) that contain the command. */ cmdPtr = NULL; if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2) && !(flags & TCL_NAMESPACE_ONLY)) { int i; Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr; (void) TclGetNamespaceForQualName(interp, name, cxtNsPtr, TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, &simpleName); if ((realNsPtr != NULL) && (simpleName != NULL)) { if ((cxtNsPtr == realNsPtr) || !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } /* * Next, check along the path. */ for (i=0 ; icommandPathLength && cmdPtr==NULL ; i++) { pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr; if (pathNsPtr == NULL) { continue; } (void) TclGetNamespaceForQualName(interp, name, pathNsPtr, TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, &simpleName); if ((realNsPtr != NULL) && (simpleName != NULL) && !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } /* * If we've still not found the command, look in the global namespace * as a last resort. */ if (cmdPtr == NULL) { (void) TclGetNamespaceForQualName(interp, name, NULL, TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, &simpleName); if ((realNsPtr != NULL) && (simpleName != NULL) && !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } } else { Namespace *nsPtr[2]; int search; TclGetNamespaceForQualName(interp, name, cxtNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /* * Look for the command in the command table of its namespace. Be sure * to check both possible search paths: from the specified namespace * context and from the global namespace. */ for (search = 0; (search < 2) && (cmdPtr == NULL); search++) { if ((nsPtr[search] != NULL) && (simpleName != NULL)) { entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } } if (cmdPtr != NULL) { cmdPtr->flags &= ~CMD_VIA_RESOLVER; return (Tcl_Command) cmdPtr; } if (flags & TCL_LEAVE_ERR_MSG) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown command \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL); } return NULL; } /* *---------------------------------------------------------------------- * * TclResetShadowedCmdRefs -- * * Called when a command is added to a namespace to check for existing * command references that the new command may invalidate. Consider the * following cases that could happen when you add a command "foo" to a * namespace "b": * 1. It could shadow a command named "foo" at the global scope. If * it does, all command references in the namespace "b" are * suspect. * 2. Suppose the namespace "b" resides in a namespace "a". Then to * "a" the new command "b::foo" could shadow another command * "b::foo" in the global namespace. If so, then all command * references in "a" * are suspect. * The same checks are applied to all parent namespaces, until we reach * the global :: namespace. * * Results: * None. * * Side effects: * If the new command shadows an existing command, the cmdRefEpoch * counter is incremented in each namespace that sees the shadow. This * invalidates all command references that were previously cached in that * namespace. The next time the commands are used, they are resolved from * scratch. * *---------------------------------------------------------------------- */ void TclResetShadowedCmdRefs( Tcl_Interp *interp, /* Interpreter containing the new command. */ Command *newCmdPtr) /* Points to the new command. */ { char *cmdName; Tcl_HashEntry *hPtr; Namespace *nsPtr; Namespace *trailNsPtr, *shadowNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); int found, i; int trailFront = -1; int trailSize = 5; /* Formerly NUM_TRAIL_ELEMS. */ Namespace **trailPtr = (Namespace **)TclStackAlloc(interp, trailSize * sizeof(Namespace *)); /* * Start at the namespace containing the new command, and work up through * the list of parents. Stop just before the global namespace, since the * global namespace can't "shadow" its own entries. * * The namespace "trail" list we build consists of the names of each * namespace that encloses the new command, in order from outermost to * innermost: for example, "a" then "b". Each iteration of this loop * eventually extends the trail upwards by one namespace, nsPtr. We use * this trail list to see if nsPtr (e.g. "a" in 2. above) could have * now-invalid cached command references. This will happen if nsPtr * (e.g. "a") contains a sequence of child namespaces (e.g. "b") such that * there is a identically-named sequence of child namespaces starting from * :: (e.g. "::b") whose tail namespace contains a command also named * cmdName. */ cmdName = (char *)Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr); for (nsPtr=newCmdPtr->nsPtr ; (nsPtr!=NULL) && (nsPtr!=globalNsPtr) ; nsPtr=nsPtr->parentPtr) { /* * Find the maximal sequence of child namespaces contained in nsPtr * such that there is a identically-named sequence of child namespaces * starting from ::. shadowNsPtr will be the tail of this sequence, or * the deepest namespace under :: that might contain a command now * shadowed by cmdName. We check below if shadowNsPtr actually * contains a command cmdName. */ found = 1; shadowNsPtr = globalNsPtr; for (i = trailFront; i >= 0; i--) { trailNsPtr = trailPtr[i]; #ifndef BREAK_NAMESPACE_COMPAT hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable, trailNsPtr->name); #else if (shadowNsPtr->childTablePtr != NULL) { hPtr = Tcl_FindHashEntry(shadowNsPtr->childTablePtr, trailNsPtr->name); } else { hPtr = NULL; } #endif if (hPtr != NULL) { shadowNsPtr = (Namespace *)Tcl_GetHashValue(hPtr); } else { found = 0; break; } } /* * If shadowNsPtr contains a command named cmdName, we invalidate all * of the command refs cached in nsPtr. As a boundary case, * shadowNsPtr is initially :: and we check for case 1. above. */ if (found) { hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName); if (hPtr != NULL) { nsPtr->cmdRefEpoch++; TclInvalidateNsPath(nsPtr); /* * If the shadowed command was compiled to bytecodes, we * invalidate all the bytecodes in nsPtr, to force a new * compilation. We use the resolverEpoch to signal the need * for a fresh compilation of every bytecode. */ if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL){ nsPtr->resolverEpoch++; } } } /* * Insert nsPtr at the front of the trail list: i.e., at the end of * the trailPtr array. */ trailFront++; if (trailFront == trailSize) { int newSize = 2 * trailSize; trailPtr = (Namespace **)TclStackRealloc(interp, trailPtr, newSize * sizeof(Namespace *)); trailSize = newSize; } trailPtr[trailFront] = nsPtr; } TclStackFree(interp, trailPtr); } /* *---------------------------------------------------------------------- * * TclGetNamespaceFromObj, GetNamespaceFromObj -- * * Gets the namespace specified by the name in a Tcl_Obj. * * Results: * Returns TCL_OK if the namespace was resolved successfully, and stores * a pointer to the namespace in the location specified by nsPtrPtr. If * the namespace can't be found, or anything else goes wrong, this * function returns TCL_ERROR and writes an error message to interp, * if non-NULL. * * Side effects: * May update the internal representation for the object, caching the * namespace reference. The next time this function is called, the * namespace value can be found quickly. * *---------------------------------------------------------------------- */ int TclGetNamespaceFromObj( Tcl_Interp *interp, /* The current interpreter. */ Tcl_Obj *objPtr, /* The object to be resolved as the name of a * namespace. */ Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */ { if (GetNamespaceFromObj(interp, objPtr, nsPtrPtr) == TCL_ERROR) { const char *name = TclGetString(objPtr); if ((name[0] == ':') && (name[1] == ':')) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "namespace \"%s\" not found", name)); } else { /* * Get the current namespace name. */ NamespaceCurrentCmd(NULL, interp, 1, NULL); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "namespace \"%s\" not found in \"%s\"", name, Tcl_GetStringResult(interp))); } Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL); return TCL_ERROR; } return TCL_OK; } static int GetNamespaceFromObj( Tcl_Interp *interp, /* The current interpreter. */ Tcl_Obj *objPtr, /* The object to be resolved as the name of a * namespace. */ Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */ { ResolvedNsName *resNamePtr; Namespace *nsPtr, *refNsPtr; if (objPtr->typePtr == &nsNameType) { /* * Check that the ResolvedNsName is still valid; avoid letting the ref * cross interps. */ resNamePtr = objPtr->internalRep.twoPtrValue.ptr1; nsPtr = resNamePtr->nsPtr; refNsPtr = resNamePtr->refNsPtr; if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) && (!refNsPtr || ((interp == refNsPtr->interp) && (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))){ *nsPtrPtr = (Tcl_Namespace *) nsPtr; return TCL_OK; } } if (SetNsNameFromAny(interp, objPtr) == TCL_OK) { resNamePtr = objPtr->internalRep.twoPtrValue.ptr1; *nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr; return TCL_OK; } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclInitNamespaceCmd -- * * This function is called to create the "namespace" Tcl command. See the * user documentation for details on what it does. * * Results: * Handle for the namespace command, or NULL on failure. * * Side effects: * none * *---------------------------------------------------------------------- */ Tcl_Command TclInitNamespaceCmd( Tcl_Interp *interp) /* Current interpreter. */ { return TclMakeEnsemble(interp, "namespace", defaultNamespaceMap); } /* *---------------------------------------------------------------------- * * NamespaceChildrenCmd -- * * Invoked to implement the "namespace children" command that returns a * list containing the fully-qualified names of the child namespaces of a * given namespace. Handles the following syntax: * * namespace children ?name? ?pattern? * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceChildrenCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; Namespace *nsPtr, *childNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); const char *pattern = NULL; Tcl_DString buffer; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Tcl_Obj *listPtr, *elemPtr; /* * Get a pointer to the specified namespace, or the current namespace. */ if (objc == 1) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else if ((objc == 2) || (objc == 3)) { if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK){ return TCL_ERROR; } nsPtr = (Namespace *) namespacePtr; } else { Tcl_WrongNumArgs(interp, 1, objv, "?name? ?pattern?"); return TCL_ERROR; } /* * Get the glob-style pattern, if any, used to narrow the search. */ Tcl_DStringInit(&buffer); if (objc == 3) { const char *name = TclGetString(objv[2]); if ((*name == ':') && (*(name+1) == ':')) { pattern = name; } else { Tcl_DStringAppend(&buffer, nsPtr->fullName, -1); if (nsPtr != globalNsPtr) { TclDStringAppendLiteral(&buffer, "::"); } Tcl_DStringAppend(&buffer, name, -1); pattern = Tcl_DStringValue(&buffer); } } /* * Create a list containing the full names of all child namespaces whose * names match the specified pattern, if any. */ listPtr = Tcl_NewListObj(0, NULL); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { unsigned int length = strlen(nsPtr->fullName); if (strncmp(pattern, nsPtr->fullName, length) != 0) { goto searchDone; } if ( #ifndef BREAK_NAMESPACE_COMPAT Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL #else nsPtr->childTablePtr != NULL && Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL #endif ) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(pattern, -1)); } goto searchDone; } #ifndef BREAK_NAMESPACE_COMPAT entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); #else if (nsPtr->childTablePtr == NULL) { goto searchDone; } entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); #endif while (entryPtr != NULL) { childNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); if ((pattern == NULL) || Tcl_StringMatch(childNsPtr->fullName, pattern)) { elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1); Tcl_ListObjAppendElement(interp, listPtr, elemPtr); } entryPtr = Tcl_NextHashEntry(&search); } searchDone: Tcl_SetObjResult(interp, listPtr); Tcl_DStringFree(&buffer); return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceCodeCmd -- * * Invoked to implement the "namespace code" command to capture the * namespace context of a command. Handles the following syntax: * * namespace code arg * * Here "arg" can be a list. "namespace code arg" produces a result * equivalent to that produced by the command * * list ::namespace inscope [namespace current] $arg * * However, if "arg" is itself a scoped value starting with "::namespace * inscope", then the result is just "arg". * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * If anything goes wrong, this function returns an error message as the * result in the interpreter's result object. * *---------------------------------------------------------------------- */ static int NamespaceCodeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; const char *arg; int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); return TCL_ERROR; } /* * If "arg" is already a scoped value, then return it directly. * Take care to only check for scoping in precisely the style that * [::namespace code] generates it. Anything more forgiving can have * the effect of failing in namespaces that contain their own custom " "namespace" command. [Bug 3202171]. */ arg = TclGetStringFromObj(objv[1], &length); if (*arg==':' && length > 20 && strncmp(arg, "::namespace inscope ", 20) == 0) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* * Otherwise, construct a scoped command by building a list with * "namespace inscope", the full name of the current namespace, and the * argument "arg". By constructing a list, we ensure that scoped commands * are interpreted properly when they are executed later, by the * "namespace inscope" command. */ TclNewObj(listPtr); TclNewLiteralStringObj(objPtr, "::namespace"); Tcl_ListObjAppendElement(interp, listPtr, objPtr); TclNewLiteralStringObj(objPtr, "inscope"); Tcl_ListObjAppendElement(interp, listPtr, objPtr); currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { TclNewLiteralStringObj(objPtr, "::"); } else { objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1); } Tcl_ListObjAppendElement(interp, listPtr, objPtr); Tcl_ListObjAppendElement(interp, listPtr, objv[1]); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceCurrentCmd -- * * Invoked to implement the "namespace current" command which returns the * fully-qualified name of the current namespace. Handles the following * syntax: * * namespace current * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceCurrentCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } /* * The "real" name of the global namespace ("::") is the null string, but * we return "::" for it as a convenience to programmers. Note that "" and * "::" are treated as synonyms by the namespace code so that it is still * easy to do things like: * * namespace [namespace current]::bar { ... } */ currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2)); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceDeleteCmd -- * * Invoked to implement the "namespace delete" command to delete * namespace(s). Handles the following syntax: * * namespace delete ?name name...? * * Each name identifies a namespace. It may include a sequence of * namespace qualifiers separated by "::"s. If a namespace is found, it * is deleted: all variables and procedures contained in that namespace * are deleted. If that namespace is being used on the call stack, it is * kept alive (but logically deleted) until it is removed from the call * stack: that is, it can no longer be referenced by name but any * currently executing procedure that refers to it is allowed to do so * until the procedure returns. If the namespace can't be found, this * function returns an error. If no namespaces are specified, this * command does nothing. * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Deletes the specified namespaces. If anything goes wrong, this * function returns an error message in the interpreter's result object. * *---------------------------------------------------------------------- */ static int NamespaceDeleteCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; const char *name; int i; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?name name...?"); return TCL_ERROR; } /* * Destroying one namespace may cause another to be destroyed. Break this * into two passes: first check to make sure that all namespaces on the * command line are valid, and report any errors. */ for (i = 1; i < objc; i++) { name = TclGetString(objv[i]); namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0); if ((namespacePtr == NULL) || (((Namespace *) namespacePtr)->flags & NS_KILLED)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown namespace \"%s\" in namespace delete command", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", TclGetString(objv[i]), NULL); return TCL_ERROR; } } /* * Okay, now delete each namespace. */ for (i = 1; i < objc; i++) { name = TclGetString(objv[i]); namespacePtr = Tcl_FindNamespace(interp, name, NULL, /* flags */ 0); if (namespacePtr) { Tcl_DeleteNamespace(namespacePtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceEvalCmd -- * * Invoked to implement the "namespace eval" command. Executes commands * in a namespace. If the namespace does not already exist, it is * created. Handles the following syntax: * * namespace eval name arg ?arg...? * * If more than one arg argument is specified, the command that is * executed is the result of concatenating the arguments together with a * space between each argument. * * Results: * Returns TCL_OK if the namespace is found and the commands are executed * successfully. Returns TCL_ERROR if anything goes wrong. * * Side effects: * Returns the result of the command in the interpreter's result object. * If anything goes wrong, this function returns an error message as the * result. * *---------------------------------------------------------------------- */ static int NamespaceEvalCmd( ClientData clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc, objv); } static int NRNamespaceEvalCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; CmdFrame *invoker; int word; Tcl_Namespace *namespacePtr; CallFrame *framePtr, **framePtrPtr; Tcl_Obj *objPtr; int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?"); return TCL_ERROR; } /* * Try to resolve the namespace reference, caching the result in the * namespace object along the way. */ result = GetNamespaceFromObj(interp, objv[1], &namespacePtr); /* * If the namespace wasn't found, try to create it. */ if (result == TCL_ERROR) { const char *name = TclGetString(objv[1]); namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL); if (namespacePtr == NULL) { return TCL_ERROR; } } /* * Make the specified namespace the current namespace and evaluate the * command(s). */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ framePtrPtr = &framePtr; (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc); if (objc == 3) { /* * TIP #280: Make actual argument location available to eval'd script. */ objPtr = objv[2]; invoker = iPtr->cmdFramePtr; word = 3; TclArgumentGet(interp, objPtr, &invoker, &word); } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. */ objPtr = Tcl_ConcatObj(objc-2, objv+2); invoker = NULL; word = 0; } /* * TIP #280: Make invoking context available to eval'd script. */ TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval", NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0, invoker, word); } static int NsEval_Callback( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0]; if (result == TCL_ERROR) { int length = strlen(namespacePtr->fullName); int limit = 200; int overflow = (length > limit); char *cmd = (char *)data[1]; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in namespace %s \"%.*s%s\" script line %d)", cmd, (overflow ? limit : length), namespacePtr->fullName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* * Restore the previous "current" namespace. */ TclPopStackFrame(interp); return result; } /* *---------------------------------------------------------------------- * * NamespaceExistsCmd -- * * Invoked to implement the "namespace exists" command that returns true * if the given namespace currently exists, and false otherwise. Handles * the following syntax: * * namespace exists name * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceExistsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj( GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK)); return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceExportCmd -- * * Invoked to implement the "namespace export" command that specifies * which commands are exported from a namespace. The exported commands * are those that can be imported into another namespace using "namespace * import". Both commands defined in a namespace and commands the * namespace has imported can be exported by a namespace. This command * has the following syntax: * * namespace export ?-clear? ?pattern pattern...? * * Each pattern may contain "string match"-style pattern matching special * characters, but the pattern may not include any namespace qualifiers: * that is, the pattern must specify commands in the current (exporting) * namespace. The specified patterns are appended onto the namespace's * list of export patterns. * * To reset the namespace's export pattern list, specify the "-clear" * flag. * * If there are no export patterns and the "-clear" flag isn't given, * this command returns the namespace's current export list. * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceExportCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int firstArg, i; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?"); return TCL_ERROR; } /* * If no pattern arguments are given, and "-clear" isn't specified, return * the namespace's current export pattern list. */ if (objc == 1) { Tcl_Obj *listPtr; TclNewObj(listPtr); (void)Tcl_AppendExportList(interp, NULL, listPtr); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* * Process the optional "-clear" argument. */ firstArg = 1; if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) { Tcl_Export(interp, NULL, "::", 1); Tcl_ResetResult(interp); firstArg++; } /* * Add each pattern to the namespace's export pattern list. */ for (i = firstArg; i < objc; i++) { int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0); if (result != TCL_OK) { return result; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceForgetCmd -- * * Invoked to implement the "namespace forget" command to remove imported * commands from a namespace. Handles the following syntax: * * namespace forget ?pattern pattern...? * * Each pattern is a name like "foo::*" or "a::b::x*". That is, the * pattern may include the special pattern matching characters recognized * by the "string match" command, but only in the command name at the end * of the qualified name; the special pattern characters may not appear * in a namespace name. All of the commands that match that pattern are * checked to see if they have an imported command in the current * namespace that refers to the matched command. If there is an alias, it * is removed. * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Imported commands are removed from the current namespace. If anything * goes wrong, this function returns an error message in the * interpreter's result object. * *---------------------------------------------------------------------- */ static int NamespaceForgetCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *pattern; int i, result; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?"); return TCL_ERROR; } for (i = 1; i < objc; i++) { pattern = TclGetString(objv[i]); result = Tcl_ForgetImport(interp, NULL, pattern); if (result != TCL_OK) { return result; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceImportCmd -- * * Invoked to implement the "namespace import" command that imports * commands into a namespace. Handles the following syntax: * * namespace import ?-force? ?pattern pattern...? * * Each pattern is a namespace-qualified name like "foo::*", "a::b::x*", * or "bar::p". That is, the pattern may include the special pattern * matching characters recognized by the "string match" command, but only * in the command name at the end of the qualified name; the special * pattern characters may not appear in a namespace name. All of the * commands that match the pattern and which are exported from their * namespace are made accessible from the current namespace context. This * is done by creating a new "imported command" in the current namespace * that points to the real command in its original namespace; when the * imported command is called, it invokes the real command. * * If an imported command conflicts with an existing command, it is * treated as an error. But if the "-force" option is included, then * existing commands are overwritten by the imported commands. * * If there are no pattern arguments and the "-force" flag isn't given, * this command returns the list of commands currently imported in * the current namespace. * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Adds imported commands to the current namespace. If anything goes * wrong, this function returns an error message in the interpreter's * result object. * *---------------------------------------------------------------------- */ static int NamespaceImportCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int allowOverwrite = 0; const char *string, *pattern; int i, result; int firstArg; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?"); return TCL_ERROR; } /* * Skip over the optional "-force" as the first argument. */ firstArg = 1; if (firstArg < objc) { string = TclGetString(objv[firstArg]); if ((*string == '-') && (strcmp(string, "-force") == 0)) { allowOverwrite = 1; firstArg++; } } else { /* * When objc == 1, command is just [namespace import]. Introspection * form to return list of imported commands. */ Tcl_HashEntry *hPtr; Tcl_HashSearch search; Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); Tcl_Obj *listPtr; TclNewObj(listPtr); for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc == DeleteImportedCmd) { Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj( (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1)); } } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* * Handle the imports for each of the patterns. */ for (i = firstArg; i < objc; i++) { pattern = TclGetString(objv[i]); result = Tcl_Import(interp, NULL, pattern, allowOverwrite); if (result != TCL_OK) { return result; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceInscopeCmd -- * * Invoked to implement the "namespace inscope" command that executes a * script in the context of a particular namespace. This command is not * expected to be used directly by programmers; calls to it are generated * implicitly when programs use "namespace code" commands to register * callback scripts. Handles the following syntax: * * namespace inscope name arg ?arg...? * * The "namespace inscope" command is much like the "namespace eval" * command except that it has lappend semantics and the namespace must * already exist. It treats the first argument as a list, and appends any * arguments after the first onto the end as proper list elements. For * example, * * namespace inscope ::foo {a b} c d e * * is equivalent to * * namespace eval ::foo [concat {a b} [list c d e]] * * This lappend semantics is important because many callback scripts are * actually prefixes. * * Results: * Returns TCL_OK to indicate success, or TCL_ERROR to indicate failure. * * Side effects: * Returns a result in the Tcl interpreter's result object. * *---------------------------------------------------------------------- */ static int NamespaceInscopeCmd( ClientData clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc, objv); } static int NRNamespaceInscopeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; CallFrame *framePtr, **framePtrPtr; int i; Tcl_Obj *cmdObjPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?"); return TCL_ERROR; } /* * Resolve the namespace reference. */ if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK) { return TCL_ERROR; } /* * Make the specified namespace the current namespace. */ framePtrPtr = &framePtr; /* This is needed to satisfy GCC's * strict aliasing rules. */ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc); /* * Execute the command. If there is just one argument, just treat it as a * script and evaluate it. Otherwise, create a list from the arguments * after the first one, then concatenate the first argument and the list * of extra arguments to form the command to evaluate. */ if (objc == 3) { cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); for (i = 3; i < objc; i++) { if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){ Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */ return TCL_ERROR; } } concatObjv[0] = objv[2]; concatObjv[1] = listPtr; cmdObjPtr = Tcl_ConcatObj(2, concatObjv); Tcl_DecrRefCount(listPtr); /* We're done with the list object. */ } TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", NULL, NULL); return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0); } /* *---------------------------------------------------------------------- * * NamespaceOriginCmd -- * * Invoked to implement the "namespace origin" command to return the * fully-qualified name of the "real" command to which the specified * "imported command" refers. Handles the following syntax: * * namespace origin name * * Results: * An imported command is created in an namespace when that namespace * imports a command from another namespace. If a command is imported * into a sequence of namespaces a, b,...,n where each successive * namespace just imports the command from the previous namespace, this * command returns the fully-qualified name of the original command in * the first namespace, a. If "name" does not refer to an alias, its * fully-qualified name is returned. The returned name is stored in the * interpreter's result object. This function returns TCL_OK if * successful, and TCL_ERROR if anything goes wrong. * * Side effects: * If anything goes wrong, this function returns an error message in the * interpreter's result object. * *---------------------------------------------------------------------- */ static int NamespaceOriginCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Command command, origCommand; Tcl_Obj *resultPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } command = Tcl_GetCommandFromObj(interp, objv[1]); if (command == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid command name \"%s\"", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", TclGetString(objv[1]), NULL); return TCL_ERROR; } origCommand = TclGetOriginalCommand(command); TclNewObj(resultPtr); if (origCommand == NULL) { /* * The specified command isn't an imported command. Return the * command's name qualified by the full name of the namespace it was * defined in. */ Tcl_GetCommandFullName(interp, command, resultPtr); } else { Tcl_GetCommandFullName(interp, origCommand, resultPtr); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceParentCmd -- * * Invoked to implement the "namespace parent" command that returns the * fully-qualified name of the parent namespace for a specified * namespace. Handles the following syntax: * * namespace parent ?name? * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceParentCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *nsPtr; if (objc == 1) { nsPtr = TclGetCurrentNamespace(interp); } else if (objc == 2) { if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) { return TCL_ERROR; } } else { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } /* * Report the parent of the specified namespace. */ if (nsPtr->parentPtr != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( nsPtr->parentPtr->fullName, -1)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespacePathCmd -- * * Invoked to implement the "namespace path" command that reads and * writes the current namespace's command resolution path. Has one * optional argument: if present, it is a list of named namespaces to set * the path to, and if absent, the current path should be returned. * Handles the following syntax: * * namespace path ?nsList? * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong * (most notably if the namespace list contains the name of something * other than a namespace). In the successful-exit case, may set the * interpreter result to the list of names of the namespaces on the * current namespace's path. * * Side effects: * May update the namespace path (triggering a recomputing of all command * names that depend on the namespace for resolution). * *---------------------------------------------------------------------- */ static int NamespacePathCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); int i, nsObjc, result = TCL_ERROR; Tcl_Obj **nsObjv; Tcl_Namespace **namespaceList = NULL; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?pathList?"); return TCL_ERROR; } /* * If no path is given, return the current path. */ if (objc == 1) { Tcl_Obj *resultObj; TclNewObj(resultObj); for (i=0 ; icommandPathLength ; i++) { if (nsPtr->commandPathArray[i].nsPtr != NULL) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( nsPtr->commandPathArray[i].nsPtr->fullName, -1)); } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * There is a path given, so parse it into an array of namespace pointers. */ if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) { goto badNamespace; } if (nsObjc != 0) { namespaceList = (Tcl_Namespace **)TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc); for (i=0 ; icommandPathSourceList; if (tmpPathArray[i].nextPtr != NULL) { tmpPathArray[i].nextPtr->prevPtr = &tmpPathArray[i]; } tmpPathArray[i].nsPtr->commandPathSourceList = &tmpPathArray[i]; } if (nsPtr->commandPathLength != 0) { UnlinkNsPath(nsPtr); } nsPtr->commandPathArray = tmpPathArray; } else { if (nsPtr->commandPathLength != 0) { UnlinkNsPath(nsPtr); } } nsPtr->commandPathLength = pathLength; nsPtr->cmdRefEpoch++; nsPtr->resolverEpoch++; } /* *---------------------------------------------------------------------- * * UnlinkNsPath -- * * Delete the given namespace's command name resolution path. Only call * if the path is non-empty. Caller must reset the counter containing the * path size. * * Results: * nothing * * Side effects: * Deletes the array of path entries and unlinks those path entries from * the target namespace's list of interested namespaces. * *---------------------------------------------------------------------- */ static void UnlinkNsPath( Namespace *nsPtr) { int i; for (i=0 ; icommandPathLength ; i++) { NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i]; if (nsPathPtr->prevPtr != NULL) { nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr; } if (nsPathPtr->nextPtr != NULL) { nsPathPtr->nextPtr->prevPtr = nsPathPtr->prevPtr; } if (nsPathPtr->nsPtr != NULL) { if (nsPathPtr->nsPtr->commandPathSourceList == nsPathPtr) { nsPathPtr->nsPtr->commandPathSourceList = nsPathPtr->nextPtr; } } } ckfree(nsPtr->commandPathArray); } /* *---------------------------------------------------------------------- * * TclInvalidateNsPath -- * * Invalidate the name resolution caches for all names looked up in * namespaces whose name path includes the given namespace. * * Results: * nothing * * Side effects: * Increments the command reference epoch in each namespace whose path * includes the given namespace. This causes any cached resolved names * whose root caching context starts at that namespace to be recomputed * the next time they are used. * *---------------------------------------------------------------------- */ void TclInvalidateNsPath( Namespace *nsPtr) { NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList; while (nsPathPtr != NULL) { if (nsPathPtr->nsPtr != NULL) { nsPathPtr->creatorNsPtr->cmdRefEpoch++; } nsPathPtr = nsPathPtr->nextPtr; } } /* *---------------------------------------------------------------------- * * NamespaceQualifiersCmd -- * * Invoked to implement the "namespace qualifiers" command that returns * any leading namespace qualifiers in a string. These qualifiers are * namespace names separated by "::"s. For example, for "::foo::p" this * command returns "::foo", and for "::" it returns "". This command is * the complement of the "namespace tail" command. Note that this command * does not check whether the "namespace" names are, in fact, the names * of currently defined namespaces. Handles the following syntax: * * namespace qualifiers string * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceQualifiersCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *p; int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } /* * Find the end of the string, then work backward and find the start of * the last "::" qualifier. */ name = TclGetString(objv[1]); for (p = name; *p != '\0'; p++) { /* empty body */ } while (--p >= name) { if ((*p == ':') && (p > name) && (*(p-1) == ':')) { p -= 2; /* Back up over the :: */ while ((p >= name) && (*p == ':')) { p--; /* Back up over the preceding : */ } break; } } if (p >= name) { length = p-name+1; Tcl_SetObjResult(interp, Tcl_NewStringObj(name, length)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceUnknownCmd -- * * Invoked to implement the "namespace unknown" command (TIP 181) that * sets or queries a per-namespace unknown command handler. This handler * is called when command lookup fails (current and global ns). The * default handler for the global namespace is ::unknown. The default * handler for other namespaces is to call the global namespace unknown * handler. Passing an empty list results in resetting the handler to its * default. * * namespace unknown ?handler? * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * If no handler is specified, returns a result in the interpreter's * result object, otherwise it sets the unknown handler pointer in the * current namespace to the script fragment provided. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceUnknownCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *currNsPtr; Tcl_Obj *resultPtr; int rc; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?script?"); return TCL_ERROR; } currNsPtr = TclGetCurrentNamespace(interp); if (objc == 1) { /* * Introspection - return the current namespace handler. */ resultPtr = Tcl_GetNamespaceUnknownHandler(interp, currNsPtr); if (resultPtr == NULL) { TclNewObj(resultPtr); } Tcl_SetObjResult(interp, resultPtr); } else { rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[1]); if (rc == TCL_OK) { Tcl_SetObjResult(interp, objv[1]); } return rc; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetNamespaceUnknownHandler -- * * Returns the unknown command handler registered for the given * namespace. * * Results: * Returns the current unknown command handler, or NULL if none exists * for the namespace. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetNamespaceUnknownHandler( Tcl_Interp *interp, /* The interpreter in which the namespace * exists. */ Tcl_Namespace *nsPtr) /* The namespace. */ { Namespace *currNsPtr = (Namespace *) nsPtr; if (currNsPtr->unknownHandlerPtr == NULL && currNsPtr == ((Interp *) interp)->globalNsPtr) { /* * Default handler for global namespace is "::unknown". For all other * namespaces, it is NULL (which falls back on the global unknown * handler). */ TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown"); Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr); } return currNsPtr->unknownHandlerPtr; } /* *---------------------------------------------------------------------- * * Tcl_SetNamespaceUnknownHandler -- * * Sets the unknown command handler for the given namespace to the * command prefix passed. * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Sets the namespace unknown command handler. If the passed in handler * is NULL or an empty list, then the handler is reset to its default. If * an error occurs, then an error message is left in the interpreter * result. * *---------------------------------------------------------------------- */ int Tcl_SetNamespaceUnknownHandler( Tcl_Interp *interp, /* Interpreter in which the namespace * exists. */ Tcl_Namespace *nsPtr, /* Namespace which is being updated. */ Tcl_Obj *handlerPtr) /* The new handler, or NULL to reset. */ { int lstlen = 0; Namespace *currNsPtr = (Namespace *) nsPtr; /* * Ensure that we check for errors *first* before we change anything. */ if (handlerPtr != NULL) { if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) { /* * Not a list. */ return TCL_ERROR; } if (lstlen > 0) { /* * We are going to be saving this handler. Increment the reference * count before decrementing the refcount on the previous handler, * so that nothing strange can happen if we are told to set the * handler to the previous value. */ Tcl_IncrRefCount(handlerPtr); } } /* * Remove old handler next. */ if (currNsPtr->unknownHandlerPtr != NULL) { Tcl_DecrRefCount(currNsPtr->unknownHandlerPtr); } /* * Install the new handler. */ if (lstlen > 0) { /* * Just store the handler. It already has the correct reference count. */ currNsPtr->unknownHandlerPtr = handlerPtr; } else { /* * If NULL or an empty list is passed, this resets to the default * handler. */ currNsPtr->unknownHandlerPtr = NULL; } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceTailCmd -- * * Invoked to implement the "namespace tail" command that returns the * trailing name at the end of a string with "::" namespace qualifiers. * These qualifiers are namespace names separated by "::"s. For example, * for "::foo::p" this command returns "p", and for "::" it returns "". * This command is the complement of the "namespace qualifiers" command. * Note that this command does not check whether the "namespace" names * are, in fact, the names of currently defined namespaces. Handles the * following syntax: * * namespace tail string * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceTailCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *p; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } /* * Find the end of the string, then work backward and find the last "::" * qualifier. */ name = TclGetString(objv[1]); for (p = name; *p != '\0'; p++) { /* empty body */ } while (--p > name) { if ((*p == ':') && (*(p-1) == ':')) { p++; /* Just after the last "::" */ break; } } if (p >= name) { Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceUpvarCmd -- * * Invoked to implement the "namespace upvar" command, that creates * variables in the current scope linked to variables in another * namespace. Handles the following syntax: * * namespace upvar ns otherVar myVar ?otherVar myVar ...? * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Creates new variables in the current scope, linked to the * corresponding variables in the stipulated namespace. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceUpvarCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Tcl_Namespace *nsPtr, *savedNsPtr; Var *otherPtr, *arrayPtr; const char *myName; if (objc < 2 || (objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, "ns ?otherVar myVar ...?"); return TCL_ERROR; } if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) { return TCL_ERROR; } objc -= 2; objv += 2; for (; objc>0 ; objc-=2, objv+=2) { /* * Locate the other variable. */ savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr; otherPtr = TclObjLookupVarEx(interp, objv[0], NULL, (TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS), "access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr; if (otherPtr == NULL) { return TCL_ERROR; } /* * Create the new variable and link it to otherPtr. */ myName = TclGetString(objv[1]); if (TclPtrMakeUpvar(interp, otherPtr, myName, 0, -1) != TCL_OK) { return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceWhichCmd -- * * Invoked to implement the "namespace which" command that returns the * fully-qualified name of a command or variable. If the specified * command or variable does not exist, it returns "". Handles the * following syntax: * * namespace which ?-command? ?-variable? name * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. * * Side effects: * Returns a result in the interpreter's result object. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- */ static int NamespaceWhichCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const opts[] = { "-command", "-variable", NULL }; int lookupType = 0; Tcl_Obj *resultPtr; if (objc < 2 || objc > 3) { badArgs: Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name"); return TCL_ERROR; } else if (objc == 3) { /* * Look for a flag controlling the lookup. */ if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, &lookupType) != TCL_OK) { /* * Preserve old style of error message! */ Tcl_ResetResult(interp); goto badArgs; } } TclNewObj(resultPtr); switch (lookupType) { case 0: { /* -command */ Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]); if (cmd != NULL) { Tcl_GetCommandFullName(interp, cmd, resultPtr); } break; } case 1: { /* -variable */ Tcl_Var var = Tcl_FindNamespaceVar(interp, TclGetString(objv[objc-1]), NULL, /*flags*/ 0); if (var != NULL) { Tcl_GetVariableFullName(interp, var, resultPtr); } break; } } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * FreeNsNameInternalRep -- * * Frees the resources associated with a nsName object's internal * representation. * * Results: * None. * * Side effects: * Decrements the ref count of any Namespace structure pointed to by the * nsName's internal representation. If there are no more references to * the namespace, it's structure will be freed. * *---------------------------------------------------------------------- */ static void FreeNsNameInternalRep( Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr = (ResolvedNsName *)objPtr->internalRep.twoPtrValue.ptr1; /* * Decrement the reference count of the namespace. If there are no more * references, free it up. */ resNamePtr->refCount--; if (resNamePtr->refCount == 0) { /* * Decrement the reference count for the cached namespace. If the * namespace is dead, and there are no more references to it, free * it. */ TclNsDecrRefCount(resNamePtr->nsPtr); ckfree(resNamePtr); } objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DupNsNameInternalRep -- * * Initializes the internal representation of a nsName object to a copy * of the internal representation of another nsName object. * * Results: * None. * * Side effects: * copyPtr's internal rep is set to refer to the same namespace * referenced by srcPtr's internal rep. Increments the ref count of the * ResolvedNsName structure used to hold the namespace reference. * *---------------------------------------------------------------------- */ static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr; resNamePtr->refCount++; copyPtr->typePtr = &nsNameType; } /* *---------------------------------------------------------------------- * * SetNsNameFromAny -- * * Attempt to generate a nsName internal representation for a Tcl object. * * Results: * Returns TCL_OK if the value could be converted to a proper namespace * reference. Otherwise, it returns TCL_ERROR, along with an error * message in the interpreter's result object. * * Side effects: * If successful, the object is made a nsName object. Its internal rep is * set to point to a ResolvedNsName, which contains a cached pointer to * the Namespace. Reference counts are kept on both the ResolvedNsName * and the Namespace, so we can keep track of their usage and free them * when appropriate. * *---------------------------------------------------------------------- */ static int SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; ResolvedNsName *resNamePtr; const char *name; if (interp == NULL) { return TCL_ERROR; } name = TclGetString(objPtr); TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); /* * If we found a namespace, then create a new ResolvedNsName structure * that holds a reference to it. */ if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) { /* * Our failed lookup proves any previously cached nsName internalrep is no * longer valid. Get rid of it so we no longer waste memory storing * it, nor time determining its invalidity again and again. */ if (objPtr->typePtr == &nsNameType) { TclFreeIntRep(objPtr); } return TCL_ERROR; } nsPtr->refCount++; resNamePtr = (ResolvedNsName *)ckalloc(sizeof(ResolvedNsName)); resNamePtr->nsPtr = nsPtr; if ((name[0] == ':') && (name[1] == ':')) { resNamePtr->refNsPtr = NULL; } else { resNamePtr->refNsPtr = (Namespace *)Tcl_GetCurrentNamespace(interp); } resNamePtr->refCount = 1; TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr; objPtr->typePtr = &nsNameType; return TCL_OK; } /* *---------------------------------------------------------------------- * * TclGetNamespaceCommandTable -- * * Returns the hash table of commands. * * Results: * Pointer to the hash table. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_HashTable * TclGetNamespaceCommandTable( Tcl_Namespace *nsPtr) { return &((Namespace *) nsPtr)->cmdTable; } /* *---------------------------------------------------------------------- * * TclGetNamespaceChildTable -- * * Returns the hash table of child namespaces. * * Results: * Pointer to the hash table. * * Side effects: * Might allocate memory. * *---------------------------------------------------------------------- */ Tcl_HashTable * TclGetNamespaceChildTable( Tcl_Namespace *nsPtr) { Namespace *nPtr = (Namespace *) nsPtr; #ifndef BREAK_NAMESPACE_COMPAT return &nPtr->childTable; #else if (nPtr->childTablePtr == NULL) { nPtr->childTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS); } return nPtr->childTablePtr; #endif } /* *---------------------------------------------------------------------- * * TclLogCommandInfo -- * * This function is invoked after an error occurs in an interpreter. It * adds information to iPtr->errorInfo/errorStack fields to describe the * command that was being executed when the error occurred. When pc and * tosPtr are non-NULL, conveying a bytecode execution "inner context", * and the offending instruction is suitable, that inner context is * recorded in errorStack. * * Results: * None. * * Side effects: * Information about the command is added to errorInfo/errorStack and the * line number stored internally in the interpreter is set. * *---------------------------------------------------------------------- */ void TclLogCommandInfo( Tcl_Interp *interp, /* Interpreter in which to log information. */ const char *script, /* First character in script containing * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ int length, /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ { const char *p; Interp *iPtr = (Interp *) interp; int overflow, limit = 150; Var *varPtr, *arrayPtr; if (iPtr->flags & ERR_ALREADY_LOGGED) { /* * Someone else has already logged error information for this command; * we shouldn't add anything more. */ return; } if (command != NULL) { /* * Compute the line number where the error occurred. */ iPtr->errorLine = 1; for (p = script; p != command; p++) { if (*p == '\n') { iPtr->errorLine++; } } if (length < 0) { length = strlen(command); } overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) ? "while executing" : "invoked from within"), (overflow ? limit : length), command, (overflow ? "..." : ""))); varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, NULL, 0, 0, &arrayPtr); if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) { /* * Should not happen. */ return; } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); if (tracePtr->traceProc != EstablishErrorInfoTraces) { /* * The most recent trace set on ::errorInfo is not the one the * core itself puts on last. This means some other code is * tracing the variable, and the additional trace(s) might be * write traces that expect the timing of writes to * ::errorInfo that existed Tcl releases before 8.5. To * satisfy that compatibility need, we write the current * -errorinfo value to the ::errorInfo variable. */ Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo, TCL_GLOBAL_ONLY); } } } /* * TIP #348 */ if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); iPtr->errorStack = newObj; } if (iPtr->resetErrorStack) { int len; iPtr->resetErrorStack = 0; TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. */ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL); if (pc != NULL) { Tcl_Obj *innerContext; innerContext = TclGetInnerContext(interp, pc, tosPtr); if (innerContext != NULL) { Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext); } } else if (command != NULL) { Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(command, length)); } } if (!iPtr->framePtr->objc) { /* * Special frame, nothing to report. */ } else if (iPtr->varFramePtr != iPtr->framePtr) { /* * uplevel case, [lappend errorstack UP $relativelevel] */ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj( iPtr->framePtr->level - iPtr->varFramePtr->level)); } else if (iPtr->framePtr != iPtr->rootFramePtr) { /* * normal case, [lappend errorstack CALL [info level 0]] */ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj( iPtr->framePtr->objc, iPtr->framePtr->objv)); } } /* *---------------------------------------------------------------------- * * TclErrorStackResetIf -- * * The TIP 348 reset/no-bc part of TLCI, for specific use by * TclCompileSyntaxError. * * Results: * None. * * Side effects: * Reset errorstack if it needs be, and in that case remember the * passed-in error message as inner context. * *---------------------------------------------------------------------- */ void TclErrorStackResetIf( Tcl_Interp *interp, const char *msg, int length) { Interp *iPtr = (Interp *) interp; if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); iPtr->errorStack = newObj; } if (iPtr->resetErrorStack) { int len; iPtr->resetErrorStack = 0; TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. */ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(msg, length)); } } /* *---------------------------------------------------------------------- * * Tcl_LogCommandInfo -- * * This function is invoked after an error occurs in an interpreter. It * adds information to iPtr->errorInfo/errorStack fields to describe the * command that was being executed when the error occurred. * * Results: * None. * * Side effects: * Information about the command is added to errorInfo/errorStack and the * line number stored internally in the interpreter is set. * *---------------------------------------------------------------------- */ void Tcl_LogCommandInfo( Tcl_Interp *interp, /* Interpreter in which to log information. */ const char *script, /* First character in script containing * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ int length) /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ { TclLogCommandInfo(interp, script, command, length, NULL, NULL); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ tcl8.6.14/generic/tclNotify.c0000644000175000017500000007460314565156356015422 0ustar sergeisergei/* * tclNotify.c -- * * This file implements the generic portion of the Tcl notifier. The * notifier is lowest-level part of the event system. It manages an event * queue that holds Tcl_Event structures. The platform specific portion * of the notifier is defined in the tcl*Notify.c files in each platform * directory. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Module-scope struct of notifier hooks that are checked in the default * notifier functions (for overriding via Tcl_SetNotifier). */ Tcl_NotifierProcs tclNotifierHooks = { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL }; /* * For each event source (created with Tcl_CreateEventSource) there is a * structure of the following type: */ typedef struct EventSource { Tcl_EventSetupProc *setupProc; Tcl_EventCheckProc *checkProc; ClientData clientData; struct EventSource *nextPtr; } EventSource; /* * The following structure keeps track of the state of the notifier on a * per-thread basis. The first three elements keep track of the event queue. * In addition to the first (next to be serviced) and last events in the * queue, we keep track of a "marker" event. This provides a simple priority * mechanism whereby events can be inserted at the front of the queue but * behind all other high-priority events already in the queue (this is used * for things like a sequence of Enter and Leave events generated during a * grab in Tk). These elements are protected by the queueMutex so that any * thread can queue an event on any notifier. Note that all of the values in * this structure will be initialized to 0. */ typedef struct ThreadSpecificData { Tcl_Event *firstEventPtr; /* First pending event, or NULL if none. */ Tcl_Event *lastEventPtr; /* Last pending event, or NULL if none. */ Tcl_Event *markerEventPtr; /* Last high-priority event in queue, or NULL * if none. */ Tcl_Mutex queueMutex; /* Mutex to protect access to the previous * three fields. */ int serviceMode; /* One of TCL_SERVICE_NONE or * TCL_SERVICE_ALL. */ int blockTimeSet; /* 0 means there is no maximum block time: * block forever. */ Tcl_Time blockTime; /* If blockTimeSet is 1, gives the maximum * elapsed time for the next block. */ int inTraversal; /* 1 if Tcl_SetMaxBlockTime is being called * during an event source traversal. */ EventSource *firstEventSourcePtr; /* Pointer to first event source in list of * event sources for this thread. */ Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */ ClientData clientData; /* Opaque handle for platform specific * notifier. */ int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; /* Next notifier in global list of notifiers. * Access is controlled by the listLock global * mutex. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Global list of notifiers. Access to this list is controlled by the listLock * mutex. If this becomes a performance bottleneck, this could be replaced * with a hashtable. */ static ThreadSpecificData *firstNotifierPtr = NULL; TCL_DECLARE_MUTEX(listLock) /* * Declarations for routines used only in this file. */ static void QueueEvent(ThreadSpecificData *tsdPtr, Tcl_Event *evPtr, Tcl_QueuePosition position); /* *---------------------------------------------------------------------- * * TclInitNotifier -- * * Initialize the thread local data structures for the notifier * subsystem. * * Results: * None. * * Side effects: * Adds the current thread to the global list of notifiers. * *---------------------------------------------------------------------- */ void TclInitNotifier(void) { ThreadSpecificData *tsdPtr; Tcl_ThreadId threadId = Tcl_GetCurrentThread(); Tcl_MutexLock(&listLock); for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId; tsdPtr = tsdPtr->nextPtr) { /* Empty loop body. */ } if (NULL == tsdPtr) { /* * Notifier not yet initialized in this thread. */ tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->threadId = threadId; tsdPtr->clientData = Tcl_InitNotifier(); tsdPtr->initialized = 1; tsdPtr->nextPtr = firstNotifierPtr; firstNotifierPtr = tsdPtr; } Tcl_MutexUnlock(&listLock); } /* *---------------------------------------------------------------------- * * TclFinalizeNotifier -- * * Finalize the thread local data structures for the notifier subsystem. * * Results: * None. * * Side effects: * Removes the notifier associated with the current thread from the * global notifier list. This is done only if the notifier was * initialized for this thread by call to TclInitNotifier(). This is * always true for threads which have been seeded with an Tcl * interpreter, since the call to Tcl_CreateInterp will, among other * things, call TclInitializeSubsystems() and this one will, in turn, * call the TclInitNotifier() for the thread. For threads created without * the Tcl interpreter, though, nobody is explicitly nor implicitly * calling the TclInitNotifier hence, TclFinalizeNotifier should not be * performed at all. * *---------------------------------------------------------------------- */ void TclFinalizeNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadSpecificData **prevPtrPtr; Tcl_Event *evPtr, *hold; if (!tsdPtr->initialized) { return; /* Notifier not initialized for the current thread */ } Tcl_MutexLock(&(tsdPtr->queueMutex)); for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) { hold = evPtr; evPtr = evPtr->nextPtr; ckfree(hold); } tsdPtr->firstEventPtr = NULL; tsdPtr->lastEventPtr = NULL; Tcl_MutexUnlock(&(tsdPtr->queueMutex)); Tcl_MutexLock(&listLock); Tcl_FinalizeNotifier(tsdPtr->clientData); Tcl_MutexFinalize(&(tsdPtr->queueMutex)); for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL; prevPtrPtr = &((*prevPtrPtr)->nextPtr)) { if (*prevPtrPtr == tsdPtr) { *prevPtrPtr = tsdPtr->nextPtr; break; } } tsdPtr->initialized = 0; Tcl_MutexUnlock(&listLock); } /* *---------------------------------------------------------------------- * * Tcl_SetNotifier -- * * Install a set of alternate functions for use with the notifier. In * particular, this can be used to install the Xt-based notifier for use * with the Browser plugin. * * Results: * None. * * Side effects: * Set the tclNotifierHooks global, which is checked in the default * notifier functions. * *---------------------------------------------------------------------- */ void Tcl_SetNotifier( Tcl_NotifierProcs *notifierProcPtr) { tclNotifierHooks = *notifierProcPtr; } /* *---------------------------------------------------------------------- * * Tcl_CreateEventSource -- * * This function is invoked to create a new source of events. The source * is identified by a function that gets invoked during Tcl_DoOneEvent to * check for events on that source and queue them. * * * Results: * None. * * Side effects: * SetupProc and checkProc will be invoked each time that Tcl_DoOneEvent * runs out of things to do. SetupProc will be invoked before * Tcl_DoOneEvent calls select or whatever else it uses to wait for * events. SetupProc typically calls functions like Tcl_SetMaxBlockTime * to indicate what to wait for. * * CheckProc is called after select or whatever operation was actually * used to wait. It figures out whether anything interesting actually * happened (e.g. by calling Tcl_AsyncReady), and then calls * Tcl_QueueEvent to queue any events that are ready. * * Each of these functions is passed two arguments, e.g. * (*checkProc)(ClientData clientData, int flags)); * ClientData is the same as the clientData argument here, and flags is a * combination of things like TCL_FILE_EVENTS that indicates what events * are of interest: setupProc and checkProc use flags to figure out * whether their events are relevant or not. * *---------------------------------------------------------------------- */ void Tcl_CreateEventSource( Tcl_EventSetupProc *setupProc, /* Function to invoke to figure out what to * wait for. */ Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ ClientData clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); EventSource *sourcePtr = ckalloc(sizeof(EventSource)); sourcePtr->setupProc = setupProc; sourcePtr->checkProc = checkProc; sourcePtr->clientData = clientData; sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr; tsdPtr->firstEventSourcePtr = sourcePtr; } /* *---------------------------------------------------------------------- * * Tcl_DeleteEventSource -- * * This function is invoked to delete the source of events given by proc * and clientData. * * Results: * None. * * Side effects: * The given event source is canceled, so its function will never again * be called. If no such source exists, nothing happens. * *---------------------------------------------------------------------- */ void Tcl_DeleteEventSource( Tcl_EventSetupProc *setupProc, /* Function to invoke to figure out what to * wait for. */ Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ ClientData clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); EventSource *sourcePtr, *prevPtr; for (sourcePtr = tsdPtr->firstEventSourcePtr, prevPtr = NULL; sourcePtr != NULL; prevPtr = sourcePtr, sourcePtr = sourcePtr->nextPtr) { if ((sourcePtr->setupProc != setupProc) || (sourcePtr->checkProc != checkProc) || (sourcePtr->clientData != clientData)) { continue; } if (prevPtr == NULL) { tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr; } else { prevPtr->nextPtr = sourcePtr->nextPtr; } ckfree(sourcePtr); return; } } /* *---------------------------------------------------------------------- * * Tcl_QueueEvent -- * * Queue an event on the event queue associated with the current thread. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_QueueEvent( Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, * TCL_QUEUE_MARK. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); QueueEvent(tsdPtr, evPtr, position); } /* *---------------------------------------------------------------------- * * Tcl_ThreadQueueEvent -- * * Queue an event on the specified thread's event queue. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_ThreadQueueEvent( Tcl_ThreadId threadId, /* Identifier for thread to use. */ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, * TCL_QUEUE_MARK. */ { ThreadSpecificData *tsdPtr; /* * Find the notifier associated with the specified thread. */ Tcl_MutexLock(&listLock); for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId; tsdPtr = tsdPtr->nextPtr) { /* Empty loop body. */ } /* * Queue the event if there was a notifier associated with the thread. */ if (tsdPtr) { QueueEvent(tsdPtr, evPtr, position); } else { ckfree(evPtr); } Tcl_MutexUnlock(&listLock); } /* *---------------------------------------------------------------------- * * QueueEvent -- * * Insert an event into the specified thread's event queue at one of * three positions: the head, the tail, or before a floating marker. * Events inserted before the marker will be processed in first-in- * first-out order, but before any events inserted at the tail of the * queue. Events inserted at the head of the queue will be processed in * last-in-first-out order. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void QueueEvent( ThreadSpecificData *tsdPtr, /* Handle to thread local data that indicates * which event queue to use. */ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, * TCL_QUEUE_MARK. */ { Tcl_MutexLock(&(tsdPtr->queueMutex)); if (position == TCL_QUEUE_TAIL) { /* * Append the event on the end of the queue. */ evPtr->nextPtr = NULL; if (tsdPtr->firstEventPtr == NULL) { tsdPtr->firstEventPtr = evPtr; } else { tsdPtr->lastEventPtr->nextPtr = evPtr; } tsdPtr->lastEventPtr = evPtr; } else if (position == TCL_QUEUE_HEAD) { /* * Push the event on the head of the queue. */ evPtr->nextPtr = tsdPtr->firstEventPtr; if (tsdPtr->firstEventPtr == NULL) { tsdPtr->lastEventPtr = evPtr; } tsdPtr->firstEventPtr = evPtr; } else if (position == TCL_QUEUE_MARK) { /* * Insert the event after the current marker event and advance the * marker to the new event. */ if (tsdPtr->markerEventPtr == NULL) { evPtr->nextPtr = tsdPtr->firstEventPtr; tsdPtr->firstEventPtr = evPtr; } else { evPtr->nextPtr = tsdPtr->markerEventPtr->nextPtr; tsdPtr->markerEventPtr->nextPtr = evPtr; } tsdPtr->markerEventPtr = evPtr; if (evPtr->nextPtr == NULL) { tsdPtr->lastEventPtr = evPtr; } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); } /* *---------------------------------------------------------------------- * * Tcl_DeleteEvents -- * * Calls a function for each event in the queue and deletes those for * which the function returns 1. Events for which the function returns 0 * are left in the queue. Operates on the queue associated with the * current thread. * * Results: * None. * * Side effects: * Potentially removes one or more events from the event queue. * *---------------------------------------------------------------------- */ void Tcl_DeleteEvents( Tcl_EventDeleteProc *proc, /* The function to call. */ ClientData clientData) /* The type-specific data. */ { Tcl_Event *evPtr; /* Pointer to the event being examined */ Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if * evPtr designates the first event in the * queue for the thread. */ Tcl_Event *hold; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_MutexLock(&(tsdPtr->queueMutex)); /* * Walk the queue of events for the thread, applying 'proc' to each to * decide whether to eliminate the event. */ prevPtr = NULL; evPtr = tsdPtr->firstEventPtr; while (evPtr != NULL) { if (proc(evPtr, clientData) == 1) { /* * This event should be deleted. Unlink it. */ if (prevPtr == NULL) { tsdPtr->firstEventPtr = evPtr->nextPtr; } else { prevPtr->nextPtr = evPtr->nextPtr; } /* * Update 'last' and 'marker' events if either has been deleted. */ if (evPtr->nextPtr == NULL) { tsdPtr->lastEventPtr = prevPtr; } if (tsdPtr->markerEventPtr == evPtr) { tsdPtr->markerEventPtr = prevPtr; } /* * Delete the event data structure. */ hold = evPtr; evPtr = evPtr->nextPtr; ckfree(hold); } else { /* * Event is to be retained. */ prevPtr = evPtr; evPtr = evPtr->nextPtr; } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); } /* *---------------------------------------------------------------------- * * Tcl_ServiceEvent -- * * Process one event from the event queue, or invoke an asynchronous * event handler. Operates on event queue for current thread. * * Results: * The return value is 1 if the function actually found an event to * process. If no processing occurred, then 0 is returned. * * Side effects: * Invokes all of the event handlers for the highest priority event in * the event queue. May collapse some events into a single event or * discard stale events. * *---------------------------------------------------------------------- */ int Tcl_ServiceEvent( int flags) /* Indicates what events should be processed. * May be any combination of TCL_WINDOW_EVENTS * TCL_FILE_EVENTS, TCL_TIMER_EVENTS, or other * flags defined elsewhere. Events not * matching this will be skipped for * processing later. */ { Tcl_Event *evPtr, *prevPtr; Tcl_EventProc *proc; int result; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Asynchronous event handlers are considered to be the highest priority * events, and so must be invoked before we process events on the event * queue. */ if (Tcl_AsyncReady()) { (void) Tcl_AsyncInvoke(NULL, 0); return 1; } /* * No event flags is equivalent to TCL_ALL_EVENTS. */ if ((flags & TCL_ALL_EVENTS) == 0) { flags |= TCL_ALL_EVENTS; } /* * Loop through all the events in the queue until we find one that can * actually be handled. */ Tcl_MutexLock(&(tsdPtr->queueMutex)); for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; evPtr = evPtr->nextPtr) { /* * Call the handler for the event. If it actually handles the event * then free the storage for the event. There are two tricky things * here, both stemming from the fact that the event code may be * re-entered while servicing the event: * * 1. Set the "proc" field to NULL. This is a signal to ourselves * that we shouldn't reexecute the handler if the event loop is * re-entered. * 2. When freeing the event, must search the queue again from the * front to find it. This is because the event queue could change * almost arbitrarily while handling the event, so we can't depend * on pointers found now still being valid when the handler * returns. */ proc = evPtr->proc; if (proc == NULL) { continue; } evPtr->proc = NULL; /* * Release the lock before calling the event function. This allows * other threads to post events if we enter a recursive event loop in * this thread. Note that we are making the assumption that if the * proc returns 0, the event is still in the list. */ Tcl_MutexUnlock(&(tsdPtr->queueMutex)); result = proc(evPtr, flags); Tcl_MutexLock(&(tsdPtr->queueMutex)); if (result) { /* * The event was processed, so remove it from the queue. */ if (tsdPtr->firstEventPtr == evPtr) { tsdPtr->firstEventPtr = evPtr->nextPtr; if (evPtr->nextPtr == NULL) { tsdPtr->lastEventPtr = NULL; } if (tsdPtr->markerEventPtr == evPtr) { tsdPtr->markerEventPtr = NULL; } } else { for (prevPtr = tsdPtr->firstEventPtr; prevPtr && prevPtr->nextPtr != evPtr; prevPtr = prevPtr->nextPtr) { /* Empty loop body. */ } if (prevPtr) { prevPtr->nextPtr = evPtr->nextPtr; if (evPtr->nextPtr == NULL) { tsdPtr->lastEventPtr = prevPtr; } if (tsdPtr->markerEventPtr == evPtr) { tsdPtr->markerEventPtr = prevPtr; } } else { evPtr = NULL; } } if (evPtr) { ckfree(evPtr); } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 1; } else { /* * The event wasn't actually handled, so we have to restore the * proc field to allow the event to be attempted again. */ evPtr->proc = proc; } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 0; } /* *---------------------------------------------------------------------- * * Tcl_GetServiceMode -- * * This routine returns the current service mode of the notifier. * * Results: * Returns either TCL_SERVICE_ALL or TCL_SERVICE_NONE. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetServiceMode(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); return tsdPtr->serviceMode; } /* *---------------------------------------------------------------------- * * Tcl_SetServiceMode -- * * This routine sets the current service mode of the tsdPtr-> * * Results: * Returns the previous service mode. * * Side effects: * Invokes the notifier service mode hook function. * *---------------------------------------------------------------------- */ int Tcl_SetServiceMode( int mode) /* New service mode: TCL_SERVICE_ALL or * TCL_SERVICE_NONE */ { int oldMode; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); oldMode = tsdPtr->serviceMode; tsdPtr->serviceMode = mode; Tcl_ServiceModeHook(mode); return oldMode; } /* *---------------------------------------------------------------------- * * Tcl_SetMaxBlockTime -- * * This function is invoked by event sources to tell the notifier how * long it may block the next time it blocks. The timePtr argument gives * a maximum time; the actual time may be less if some other event source * requested a smaller time. * * Results: * None. * * Side effects: * May reduce the length of the next sleep in the tsdPtr-> * *---------------------------------------------------------------------- */ void Tcl_SetMaxBlockTime( const Tcl_Time *timePtr) /* Specifies a maximum elapsed time for the * next blocking operation in the event * tsdPtr-> */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->blockTimeSet || (timePtr->sec < tsdPtr->blockTime.sec) || ((timePtr->sec == tsdPtr->blockTime.sec) && (timePtr->usec < tsdPtr->blockTime.usec))) { tsdPtr->blockTime = *timePtr; tsdPtr->blockTimeSet = 1; } /* * If we are called outside an event source traversal, set the timeout * immediately. */ if (!tsdPtr->inTraversal) { Tcl_SetTimer(&tsdPtr->blockTime); } } /* *---------------------------------------------------------------------- * * Tcl_DoOneEvent -- * * Process a single event of some sort. If there's no work to do, wait * for an event to occur, then process it. * * Results: * The return value is 1 if the function actually found an event to * process. If no processing occurred, then 0 is returned (this can * happen if the TCL_DONT_WAIT flag is set or if there are no event * handlers to wait for in the set specified by flags). * * Side effects: * May delay execution of process while waiting for an event, unless * TCL_DONT_WAIT is set in the flags argument. Event sources are invoked * to check for and queue events. Event handlers may produce arbitrary * side effects. * *---------------------------------------------------------------------- */ int Tcl_DoOneEvent( int flags) /* Miscellaneous flag values: may be any * combination of TCL_DONT_WAIT, * TCL_WINDOW_EVENTS, TCL_FILE_EVENTS, * TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or * others defined by event sources. */ { int result = 0, oldMode; EventSource *sourcePtr; Tcl_Time *timePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * The first thing we do is to service any asynchronous event handlers. */ if (Tcl_AsyncReady()) { (void) Tcl_AsyncInvoke(NULL, 0); return 1; } /* * No event flags is equivalent to TCL_ALL_EVENTS. */ if ((flags & TCL_ALL_EVENTS) == 0) { flags |= TCL_ALL_EVENTS; } /* * Set the service mode to none so notifier event routines won't try to * service events recursively. */ oldMode = tsdPtr->serviceMode; tsdPtr->serviceMode = TCL_SERVICE_NONE; /* * The core of this function is an infinite loop, even though we only * service one event. The reason for this is that we may be processing * events that don't do anything inside of Tcl. */ while (1) { /* * If idle events are the only things to service, skip the main part * of the loop and go directly to handle idle events (i.e. don't wait * even if TCL_DONT_WAIT isn't set). */ if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) { flags = TCL_IDLE_EVENTS | TCL_DONT_WAIT; goto idleEvents; } /* * Ask Tcl to service a queued event, if there are any. */ if (Tcl_ServiceEvent(flags)) { result = 1; break; } /* * If TCL_DONT_WAIT is set, be sure to poll rather than blocking, * otherwise reset the block time to infinity. */ if (flags & TCL_DONT_WAIT) { tsdPtr->blockTime.sec = 0; tsdPtr->blockTime.usec = 0; tsdPtr->blockTimeSet = 1; } else { tsdPtr->blockTimeSet = 0; } /* * Set up all the event sources for new events. This will cause the * block time to be updated if necessary. */ tsdPtr->inTraversal = 1; for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; sourcePtr = sourcePtr->nextPtr) { if (sourcePtr->setupProc) { sourcePtr->setupProc(sourcePtr->clientData, flags); } } tsdPtr->inTraversal = 0; if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) { timePtr = &tsdPtr->blockTime; } else { timePtr = NULL; } /* * Wait for a new event or a timeout. If Tcl_WaitForEvent returns -1, * we should abort Tcl_DoOneEvent. */ result = Tcl_WaitForEvent(timePtr); if (result < 0) { result = 0; break; } /* * Check all the event sources for new events. */ for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; sourcePtr = sourcePtr->nextPtr) { if (sourcePtr->checkProc) { sourcePtr->checkProc(sourcePtr->clientData, flags); } } /* * Check for events queued by the notifier or event sources. */ if (Tcl_ServiceEvent(flags)) { result = 1; break; } /* * We've tried everything at this point, but nobody we know about had * anything to do. Check for idle events. If none, either quit or go * back to the top and try again. */ idleEvents: if (flags & TCL_IDLE_EVENTS) { if (TclServiceIdle()) { result = 1; break; } } if (flags & TCL_DONT_WAIT) { break; } /* * If Tcl_WaitForEvent has returned 1, indicating that one system event * has been dispatched (and thus that some Tcl code might have been * indirectly executed), we break out of the loop in order, e.g. to * give vwait a chance to determine whether that system event had the * side effect of changing the variable (so the vwait can return and * unwind properly). * * NB: We will process idle events if any first, because otherwise we * might never do the idle events if the notifier always gets * system events. */ if (result) { break; } } tsdPtr->serviceMode = oldMode; return result; } /* *---------------------------------------------------------------------- * * Tcl_ServiceAll -- * * This routine checks all of the event sources, processes events that * are on the Tcl event queue, and then calls the any idle handlers. * Platform specific notifier callbacks that generate events should call * this routine before returning to the system in order to ensure that * Tcl gets a chance to process the new events. * * Results: * Returns 1 if an event or idle handler was invoked, else 0. * * Side effects: * Anything that an event or idle handler may do. * *---------------------------------------------------------------------- */ int Tcl_ServiceAll(void) { int result = 0; EventSource *sourcePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->serviceMode == TCL_SERVICE_NONE) { return result; } /* * We need to turn off event servicing like we do in Tcl_DoOneEvent, to * avoid recursive calls. */ tsdPtr->serviceMode = TCL_SERVICE_NONE; /* * Check async handlers first. */ if (Tcl_AsyncReady()) { (void) Tcl_AsyncInvoke(NULL, 0); } /* * Make a single pass through all event sources, queued events, and idle * handlers. Note that we wait to update the notifier timer until the end * so we can avoid multiple changes. */ tsdPtr->inTraversal = 1; tsdPtr->blockTimeSet = 0; for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; sourcePtr = sourcePtr->nextPtr) { if (sourcePtr->setupProc) { sourcePtr->setupProc(sourcePtr->clientData, TCL_ALL_EVENTS); } } for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; sourcePtr = sourcePtr->nextPtr) { if (sourcePtr->checkProc) { sourcePtr->checkProc(sourcePtr->clientData, TCL_ALL_EVENTS); } } while (Tcl_ServiceEvent(0)) { result = 1; } if (TclServiceIdle()) { result = 1; } if (!tsdPtr->blockTimeSet) { Tcl_SetTimer(NULL); } else { Tcl_SetTimer(&tsdPtr->blockTime); } tsdPtr->inTraversal = 0; tsdPtr->serviceMode = TCL_SERVICE_ALL; return result; } /* *---------------------------------------------------------------------- * * Tcl_ThreadAlert -- * * This function wakes up the notifier associated with the specified * thread (if there is one). * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_ThreadAlert( Tcl_ThreadId threadId) /* Identifier for thread to use. */ { ThreadSpecificData *tsdPtr; /* * Find the notifier associated with the specified thread. Note that we * need to hold the listLock while calling Tcl_AlertNotifier to avoid a * race condition where the specified thread might destroy its notifier. */ Tcl_MutexLock(&listLock); for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { if (tsdPtr->threadId == threadId) { Tcl_AlertNotifier(tsdPtr->clientData); break; } } Tcl_MutexUnlock(&listLock); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclObj.c0000644000175000017500000040065514561430135014646 0ustar sergeisergei/* * tclObj.c -- * * This file contains Tcl object-related functions that are used by many * Tcl commands. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * Copyright (c) 2001 by ActiveState Corporation. * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2007 Daniel A. Steffen * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #include /* * Table of all object types. */ static Tcl_HashTable typeTable; static int typeTableInitialized = 0; /* 0 means not yet initialized. */ TCL_DECLARE_MUTEX(tableMutex) /* * Head of the list of free Tcl_Obj structs we maintain. */ Tcl_Obj *tclFreeObjList = NULL; /* * The object allocator is single threaded. This mutex is referenced by the * TclNewObj macro, however, so must be visible. */ #ifdef TCL_THREADS MODULE_SCOPE Tcl_Mutex tclObjMutex; Tcl_Mutex tclObjMutex; #endif /* * Pointer to a heap-allocated string of length zero that the Tcl core uses as * the value of an empty string representation for an object. This value is * shared by all new objects allocated by Tcl_NewObj. */ char tclEmptyString = '\0'; char *tclEmptyStringRep = &tclEmptyString; #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) /* * Structure for tracking the source file and line number where a given * Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself, * for sanity checking purposes. */ typedef struct ObjData { Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */ const char *file; /* The name of the source file calling this * function; used for debugging. */ int line; /* Line number in the source file; used for * debugging. */ } ObjData; #endif /* TCL_MEM_DEBUG && TCL_THREADS */ /* * All static variables used in this file are collected into a single instance * of the following structure. For multi-threaded implementations, there is * one instance of this structure for each thread. * * Notice that different structures with the same name appear in other files. * The structure defined below is used in this file only. */ typedef struct ThreadSpecificData { Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj * generated by a call to the function * TclSubstTokens() from a literal text * where bs+nl sequences occurred in it, if * any. I.e. this table keeps track of * invisible and stripped continuation lines. * Its keys are Tcl_Obj pointers, the values * are ContLineLoc pointers. See the file * tclCompile.h for the definition of this * structure, and for references to all * related places in the core. */ #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) Tcl_HashTable *objThreadMap;/* Thread local table that is used to check * that a Tcl_Obj was not allocated by some * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; static void TclThreadFinalizeContLines(ClientData clientData); static ThreadSpecificData *TclGetContLineTable(void); /* * Nested Tcl_Obj deletion management support * * All context references used in the object freeing code are pointers to this * structure; every thread will have its own structure instance. The purpose * of this structure is to allow deeply nested collections of Tcl_Objs to be * freed without taking a vast depth of C stack (which could cause all sorts * of breakage.) */ typedef struct PendingObjData { int deletionCount; /* Count of the number of invocations of * TclFreeObj() are on the stack (at least * conceptually; many are actually expanded * macros). */ Tcl_Obj *deletionStack; /* Stack of objects that have had TclFreeObj() * invoked upon them but which can't be * deleted yet because they are in a nested * invocation of TclFreeObj(). By postponing * this way, we limit the maximum overall C * stack depth when deleting a complex object. * The down-side is that we alter the overall * behaviour by altering the order in which * objects are deleted, and we change the * order in which the string rep and the * internal rep of an object are deleted. Note * that code which assumes the previous * behaviour in either of these respects is * unsafe anyway; it was never documented as * to exactly what would happen in these * cases, and the overall contract of a * user-level Tcl_DecrRefCount() is still * preserved (assuming that a particular T_DRC * would delete an object is not very * safe). */ } PendingObjData; /* * These are separated out so that some semantic content is attached * to them. */ #define ObjDeletionLock(contextPtr) ((contextPtr)->deletionCount++) #define ObjDeletionUnlock(contextPtr) ((contextPtr)->deletionCount--) #define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0) #define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL) #define PushObjToDelete(contextPtr,objPtr) \ /* The string rep is already invalidated so we can use the bytes value \ * for our pointer chain: push onto the head of the stack. */ \ (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \ (contextPtr)->deletionStack = (objPtr) #define PopObjToDelete(contextPtr,objPtrVar) \ (objPtrVar) = (contextPtr)->deletionStack; \ (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes /* * Macro to set up the local reference to the deletion context. */ #ifndef TCL_THREADS static PendingObjData pendingObjData; #define ObjInitDeletionContext(contextPtr) \ PendingObjData *const contextPtr = &pendingObjData #elif defined(HAVE_FAST_TSD) static __thread PendingObjData pendingObjData; #define ObjInitDeletionContext(contextPtr) \ PendingObjData *const contextPtr = &pendingObjData #else static Tcl_ThreadDataKey pendingObjDataKey; #define ObjInitDeletionContext(contextPtr) \ PendingObjData *const contextPtr = \ Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) #endif /* * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep */ #define PACK_BIGNUM(bignum, objPtr) \ if ((bignum).used > 0x7FFF) { \ mp_int *temp = (mp_int *)ckalloc(sizeof(mp_int)); \ *temp = bignum; \ (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ } else { \ if ((bignum).alloc > 0x7FFF) { \ mp_shrink(&(bignum)); \ } \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(bignum).dp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(((bignum).sign << 30) \ | ((bignum).alloc << 15) | ((bignum).used)); \ } #define UNPACK_BIGNUM(objPtr, bignum) \ if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \ (bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \ } else { \ (bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1; \ (bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \ (bignum).alloc = \ (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7FFF; \ (bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7FFF; \ } /* * Prototypes for functions defined later in this file: */ static int ParseBoolean(Tcl_Obj *objPtr); static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); #ifndef TCL_WIDE_INT_IS_LONG static void UpdateStringOfWideInt(Tcl_Obj *objPtr); static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int copy, mp_int *bignumValue); /* * Prototypes for the array hash key methods. */ static Tcl_HashEntry * AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr); /* * Prototypes for the CommandName object type. */ static void DupCmdNameInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void FreeCmdNameInternalRep(Tcl_Obj *objPtr); static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); /* * The structures below defines the Tcl object types defined in this file by * means of functions that can be invoked by generic object code. See also * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager * implementations. */ static const Tcl_ObjType oldBooleanType = { "boolean", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ TclSetBooleanFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclBooleanType = { "booleanString", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ TclSetBooleanFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclDoubleType = { "double", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfDouble, /* updateStringProc */ SetDoubleFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclIntType = { "int", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; #ifndef TCL_WIDE_INT_IS_LONG const Tcl_ObjType tclWideIntType = { "wideInt", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfWideInt, /* updateStringProc */ SetWideIntFromAny /* setFromAnyProc */ }; #endif const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ DupBignum, /* dupIntRepProc */ UpdateStringOfBignum, /* updateStringProc */ NULL /* setFromAnyProc */ }; /* * The structure below defines the Tcl obj hash key type. */ const Tcl_HashKeyType tclObjHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ TclHashObjKey, /* hashKeyProc */ TclCompareObjKeys, /* compareKeysProc */ AllocObjEntry, /* allocEntryProc */ TclFreeObjEntry /* freeEntryProc */ }; /* * The structure below defines the command name Tcl object type by means of * functions that can be invoked by generic object code. Objects of this type * cache the Command pointer that results from looking up command names in the * command hashtable. Such objects appear as the zeroth ("command name") * argument in a Tcl command. * * NOTE: the ResolvedCmdName that gets cached is stored in the * twoPtrValue.ptr1 field, and the twoPtrValue.ptr2 field is unused. You might * think you could use the simpler otherValuePtr field to store the single * ResolvedCmdName pointer, but DO NOT DO THIS. It seems that some extensions * use the second internal pointer field of the twoPtrValue field for their * own purposes. * * TRICKY POINT! Some extensions update this structure! (Notably, these * include TclBlend and TCom). This is highly ill-advised on their part, but * does allow them to delete a command when references to it are gone, which * is fragile but useful given their somewhat-OO style. Because of this, this * structure MUST NOT be const so that the C compiler puts the data in * writable memory. [Bug 2558422] [Bug 07d13d99b0a9] * TODO: Provide a better API for those extensions so that they can coexist... */ Tcl_ObjType tclCmdNameType = { "cmdName", /* name */ FreeCmdNameInternalRep, /* freeIntRepProc */ DupCmdNameInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetCmdNameFromAny /* setFromAnyProc */ }; /* * Structure containing a cached pointer to a command that is the result of * resolving the command's name in some namespace. It is the internal * representation for a cmdName object. It contains the pointer along with * some information that is used to check the pointer's validity. */ typedef struct ResolvedCmdName { Command *cmdPtr; /* A cached Command pointer. */ Namespace *refNsPtr; /* Points to the namespace containing the * reference (not the namespace that contains * the referenced command). NULL if the name * is fully qualified.*/ long refNsId; /* refNsPtr's unique namespace id. Used to * verify that refNsPtr is still valid (e.g., * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ int refNsCmdEpoch; /* Value of the referencing namespace's * cmdRefEpoch when the pointer was cached. * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ int cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, * deleted, hidden, or exposed, and so the * pointer is invalid. */ int refCount; /* Reference count: 1 for each cmdName object * that has a pointer to this ResolvedCmdName * structure as its internal rep. This * structure can be freed when refCount * becomes zero. */ } ResolvedCmdName; /* *------------------------------------------------------------------------- * * TclInitObjectSubsystem -- * * This function is invoked to perform once-only initialization of the * type table. It also registers the object types defined in this file. * * Results: * None. * * Side effects: * Initializes the table of defined object types "typeTable" with builtin * object types defined in this file. * *------------------------------------------------------------------------- */ void TclInitObjSubsystem(void) { Tcl_MutexLock(&tableMutex); typeTableInitialized = 1; Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&tableMutex); Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); Tcl_RegisterObjType(&tclIntType); Tcl_RegisterObjType(&tclStringType); Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclDictType); Tcl_RegisterObjType(&tclByteCodeType); Tcl_RegisterObjType(&tclArraySearchType); Tcl_RegisterObjType(&tclCmdNameType); Tcl_RegisterObjType(&tclRegexpType); Tcl_RegisterObjType(&tclProcBodyType); /* For backward compatibility only ... */ Tcl_RegisterObjType(&oldBooleanType); #ifndef TCL_WIDE_INT_IS_LONG Tcl_RegisterObjType(&tclWideIntType); #endif #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); tclObjsAlloced = 0; tclObjsFreed = 0; { int i; for (i=0 ; iobjThreadMap; if (tablePtr != NULL) { for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ObjData *objData = Tcl_GetHashValue(hPtr); if (objData != NULL) { ckfree(objData); } } Tcl_DeleteHashTable(tablePtr); ckfree(tablePtr); tsdPtr->objThreadMap = NULL; } #endif } /* *---------------------------------------------------------------------- * * TclFinalizeObjects -- * * This function is called by Tcl_Finalize to clean up all registered * Tcl_ObjType's and to reset the tclFreeObjList. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFinalizeObjects(void) { Tcl_MutexLock(&tableMutex); if (typeTableInitialized) { Tcl_DeleteHashTable(&typeTable); typeTableInitialized = 0; } Tcl_MutexUnlock(&tableMutex); /* * All we do here is reset the head pointer of the linked list of free * Tcl_Obj's to NULL; the memory finalization will take care of releasing * memory for us. */ Tcl_MutexLock(&tclObjMutex); tclFreeObjList = NULL; Tcl_MutexUnlock(&tclObjMutex); } /* *---------------------------------------------------------------------- * * TclGetContLineTable -- * * This procedure is a helper which returns the thread-specific * hash-table used to track continuation line information associated with * Tcl_Obj*, and the objThreadMap, etc. * * Results: * A reference to the thread-data. * * Side effects: * May allocate memory for the thread-data. * * TIP #280 *---------------------------------------------------------------------- */ static ThreadSpecificData * TclGetContLineTable(void) { /* * Initialize the hashtable tracking invisible continuation lines. For * the release we use a thread exit handler to ensure that this is done * before TSD blocks are made invalid. The TclFinalizeObjects() which * would be the natural place for this is invoked afterwards, meaning that * we try to operate on a data structure already gone. */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->lineCLPtr) { tsdPtr->lineCLPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS); Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL); } return tsdPtr; } /* *---------------------------------------------------------------------- * * TclContinuationsEnter -- * * This procedure is a helper which saves the continuation line * information associated with a Tcl_Obj*. * * Results: * A reference to the newly created continuation line location table. * * Side effects: * Allocates memory for the table of continuation line locations. * * TIP #280 *---------------------------------------------------------------------- */ ContLineLoc * TclContinuationsEnter( Tcl_Obj *objPtr, int num, int *loc) { int newEntry; ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry); ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(TclOffset(ContLineLoc, loc) + (num + 1U) *sizeof(int)); if (!newEntry) { /* * We're entering ContLineLoc data for the same value more than one * time. Taking care not to leak the old entry. * * This can happen when literals in a proc body are shared. See for * example test info-30.19 where the action (code) for all branches of * the switch command is identical, mapping them all to the same * literal. An interesting result of this is that the number and * locations (offset) of invisible continuation lines in the literal * are the same for all occurrences. * * Note that while reusing the existing entry is possible it requires * the same actions as for a new entry because we have to copy the * incoming num/loc data even so. Because we are called from * TclContinuationsEnterDerived for this case, which modified the * stored locations (Rebased to the proper relative offset). Just * returning the stored entry would rebase them a second time, or * more, hosing the data. It is easier to simply replace, as we are * doing. */ ckfree(Tcl_GetHashValue(hPtr)); } clLocPtr->num = num; memcpy(&clLocPtr->loc, loc, num*sizeof(int)); clLocPtr->loc[num] = CLL_END; /* Sentinel */ Tcl_SetHashValue(hPtr, clLocPtr); return clLocPtr; } /* *---------------------------------------------------------------------- * * TclContinuationsEnterDerived -- * * This procedure is a helper which computes the continuation line * information associated with a Tcl_Obj* cut from the middle of a * script. * * Results: * None. * * Side effects: * Allocates memory for the table of continuation line locations. * * TIP #280 *---------------------------------------------------------------------- */ void TclContinuationsEnterDerived( Tcl_Obj *objPtr, int start, int *clNext) { int length, end, num; int *wordCLLast = clNext; /* * We have to handle invisible continuations lines here as well, despite * the code we have in TclSubstTokens (TST) for that. Why ? Nesting. If * our script is the sole argument to an 'eval' command, for example, the * scriptCLLocPtr we are using was generated by a previous call to TST, * and while the words we have here may contain continuation lines they * are invisible already, and the inner call to TST had no bs+nl sequences * to trigger its code. * * Luckily for us, the table we have to create here for the current word * has to be a slice of the table currently in use, with the locations * suitably modified to be relative to the start of the word instead of * relative to the script. * * That is what we are doing now. Determine the slice we need, and if not * empty, wrap it into a new table, and save the result into our * thread-global hashtable, as usual. */ /* * First compute the range of the word within the script. (Is there a * better way which doesn't shimmer?) */ TclGetStringFromObj(objPtr, &length); end = start + length; /* First char after the word */ /* * Then compute the table slice covering the range of the word. */ while (*wordCLLast >= 0 && *wordCLLast < end) { wordCLLast++; } /* * And generate the table from the slice, if it was not empty. */ num = wordCLLast - clNext; if (num) { int i; ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext); /* * Re-base the locations. */ for (i=0 ; iloc[i] -= start; /* * Continuation lines coming before the string and affecting us * should not happen, due to the proper maintenance of clNext * during compilation. */ if (clLocPtr->loc[i] < 0) { Tcl_Panic("Derived ICL data for object using offsets from before the script"); } } } } /* *---------------------------------------------------------------------- * * TclContinuationsCopy -- * * This procedure is a helper which copies the continuation line * information associated with a Tcl_Obj* to another Tcl_Obj*. It is * assumed that both contain the same string/script. Use this when a * script is duplicated because it was shared. * * Results: * None. * * Side effects: * Allocates memory for the table of continuation line locations. * * TIP #280 *---------------------------------------------------------------------- */ void TclContinuationsCopy( Tcl_Obj *objPtr, Tcl_Obj *originObjPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); if (hPtr) { ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr); TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc); } } /* *---------------------------------------------------------------------- * * TclContinuationsGet -- * * This procedure is a helper which retrieves the continuation line * information associated with a Tcl_Obj*, if it has any. * * Results: * A reference to the continuation line location table, or NULL if the * Tcl_Obj* has no such information associated with it. * * Side effects: * None. * * TIP #280 *---------------------------------------------------------------------- */ ContLineLoc * TclContinuationsGet( Tcl_Obj *objPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (!hPtr) { return NULL; } return Tcl_GetHashValue(hPtr); } /* *---------------------------------------------------------------------- * * TclThreadFinalizeContLines -- * * This procedure is a helper which releases all continuation line * information currently known. It is run as a thread exit handler. * * Results: * None. * * Side effects: * Releases memory. * * TIP #280 *---------------------------------------------------------------------- */ static void TclThreadFinalizeContLines( ClientData clientData) { /* * Release the hashtable tracking invisible continuation lines. */ ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(tsdPtr->lineCLPtr); ckfree(tsdPtr->lineCLPtr); tsdPtr->lineCLPtr = NULL; } /* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- * * This function is called to register a new Tcl object type in the table * of all object types supported by Tcl. * * Results: * None. * * Side effects: * The type is registered in the Tcl type table. If there was already a * type with the same name as in typePtr, it is replaced with the new * type. * *-------------------------------------------------------------- */ void Tcl_RegisterObjType( const Tcl_ObjType *typePtr) /* Information about object type; storage must * be statically allocated (must live * forever). */ { int isNew; Tcl_MutexLock(&tableMutex); Tcl_SetHashValue( Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr); Tcl_MutexUnlock(&tableMutex); } /* *---------------------------------------------------------------------- * * Tcl_AppendAllObjTypes -- * * This function appends onto the argument object the name of each object * type as a list element. This includes the builtin object types (e.g. * int, list) as well as those added using Tcl_NewObj. These names can be * used, for example, with Tcl_GetObjType to get pointers to the * corresponding Tcl_ObjType structures. * * Results: * The return value is normally TCL_OK; in this case the object * referenced by objPtr has each type name appended to it. If an error * occurs, TCL_ERROR is returned and the interpreter's result holds an * error message. * * Side effects: * If necessary, the object referenced by objPtr is converted into a list * object. * *---------------------------------------------------------------------- */ int Tcl_AppendAllObjTypes( Tcl_Interp *interp, /* Interpreter used for error reporting. */ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the * name of each registered type is appended as * a list element. */ { Tcl_HashEntry *hPtr; Tcl_HashSearch search; int numElems; /* * Get the test for a valid list out of the way first. */ if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) { return TCL_ERROR; } /* * Type names are NUL-terminated, not counted strings. This code relies on * that. */ Tcl_MutexLock(&tableMutex); for (hPtr = Tcl_FirstHashEntry(&typeTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1)); } Tcl_MutexUnlock(&tableMutex); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetObjType -- * * This function looks up an object type by name. * * Results: * If an object type with name matching "typeName" is found, a pointer to * its Tcl_ObjType structure is returned; otherwise, NULL is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { Tcl_HashEntry *hPtr; const Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typeName); if (hPtr != NULL) { typePtr = Tcl_GetHashValue(hPtr); } Tcl_MutexUnlock(&tableMutex); return typePtr; } /* *---------------------------------------------------------------------- * * Tcl_ConvertToType -- * * Convert the Tcl object "objPtr" to have type "typePtr" if possible. * * Results: * The return value is TCL_OK on success and TCL_ERROR on failure. If * TCL_ERROR is returned, then the interpreter's result contains an error * message unless "interp" is NULL. Passing a NULL "interp" allows this * function to be used as a test whether the conversion could be done * (and in fact was done). * * Side effects: * Any internal representation for the old type is freed. * *---------------------------------------------------------------------- */ int Tcl_ConvertToType( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object to convert. */ const Tcl_ObjType *typePtr) /* The target type. */ { if (objPtr->typePtr == typePtr) { return TCL_OK; } /* * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form * as appropriate for the target type. This frees the old internal * representation. */ if (typePtr->setFromAnyProc == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't convert value to type %s", typePtr->name)); Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", NULL); } return TCL_ERROR; } return typePtr->setFromAnyProc(interp, objPtr); } /* *-------------------------------------------------------------- * * TclDbDumpActiveObjects -- * * This function is called to dump all of the active Tcl_Obj structs this * allocator knows about. * * Results: * None. * * Side effects: * None. * *-------------------------------------------------------------- */ void TclDbDumpActiveObjects( FILE *outFile) { #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) Tcl_HashSearch hSearch; Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { fprintf(outFile, "total objects: %d\n", tablePtr->numEntries); for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ObjData *objData = Tcl_GetHashValue(hPtr); if (objData != NULL) { fprintf(outFile, "key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n", Tcl_GetHashKey(tablePtr, hPtr), objData->objPtr, objData->file, objData->line); } else { fprintf(outFile, "key = 0x%p\n", Tcl_GetHashKey(tablePtr, hPtr)); } } } #endif } /* *---------------------------------------------------------------------- * * TclDbInitNewObj -- * * Called via the TclNewObj or TclDbNewObj macros when TCL_MEM_DEBUG is * enabled. This function will initialize the members of a Tcl_Obj * struct. Initialization would be done inline via the TclNewObj macro * when compiling without TCL_MEM_DEBUG. * * Results: * The Tcl_Obj struct members are initialized. * * Side effects: * None. *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( Tcl_Obj *objPtr, const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { objPtr->refCount = 0; objPtr->bytes = tclEmptyStringRep; objPtr->length = 0; objPtr->typePtr = NULL; #ifdef TCL_THREADS /* * Add entry to a thread local map used to check if a Tcl_Obj was * allocated by the currently executing thread. */ if (!TclInExit()) { Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr; int isNew; ObjData *objData; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->objThreadMap == NULL) { tsdPtr->objThreadMap = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS); } tablePtr = tsdPtr->objThreadMap; hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew); if (!isNew) { Tcl_Panic("expected to create new entry for object map"); } /* * Record the debugging information. */ objData = (ObjData *)ckalloc(sizeof(ObjData)); objData->objPtr = objPtr; objData->file = file; objData->line = line; Tcl_SetHashValue(hPtr, objData); } #endif /* TCL_THREADS */ } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_NewObj -- * * This function is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates new Tcl objects that denote * the empty string. These objects have a NULL object type and NULL * string representation byte pointer. Type managers call this routine to * allocate new objects that they further initialize. * * When TCL_MEM_DEBUG is defined, this function just returns the result * of calling the debugging version Tcl_DbNewObj. * * Results: * The result is a newly allocated object that represents the empty * string. The new object's typePtr is set NULL and its ref count is set * to 0. * * Side effects: * If compiling with TCL_COMPILE_STATS, this function increments the * global count of allocated objects (tclObjsAlloced). * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewObj Tcl_Obj * Tcl_NewObj(void) { return Tcl_DbNewObj("unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewObj(void) { Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. */ TclNewObj(objPtr); return objPtr; } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewObj -- * * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It creates new Tcl objects that denote the * empty string. It is the same as the Tcl_NewObj function above except * that it calls Tcl_DbCkalloc directly with the file name and line * number from its caller. This simplifies debugging since then the * [memory active] command will report the correct file name and line * number when reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this function just returns the * result of calling Tcl_NewObj. * * Results: * The result is a newly allocated that represents the empty string. The * new object's typePtr is set NULL and its ref count is set to 0. * * Side effects: * If compiling with TCL_COMPILE_STATS, this function increments the * global count of allocated objects (tclObjsAlloced). * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj( const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. */ TclDbNewObj(objPtr, file, line); return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewObj( const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewObj(); } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * TclAllocateFreeObjects -- * * Function to allocate a number of free Tcl_Objs. This is done using a * single ckalloc to reduce the overhead for Tcl_Obj allocation. * * Assumes mutex is held. * * Results: * None. * * Side effects: * tclFreeObjList, the head of the list of free Tcl_Objs, is set to the * first of a number of free Tcl_Obj's linked together by their * internalRep.twoPtrValue.ptr1's. * *---------------------------------------------------------------------- */ #define OBJS_TO_ALLOC_EACH_TIME 100 void TclAllocateFreeObjects(void) { size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); char *basePtr; Tcl_Obj *prevPtr, *objPtr; int i; /* * This has been noted by Purify to be a potential leak. The problem is * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually * freeing the memory. TclFinalizeObjects() does not ckfree() this memory, * but leaves it to Tcl's memory subsystem finalization to release it. * Purify apparently can't figure that out, and fires a false alarm. */ basePtr = (char *)ckalloc(bytesToAlloc); prevPtr = NULL; objPtr = (Tcl_Obj *) basePtr; for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) { objPtr->internalRep.twoPtrValue.ptr1 = prevPtr; prevPtr = objPtr; objPtr++; } tclFreeObjList = prevPtr; } #undef OBJS_TO_ALLOC_EACH_TIME /* *---------------------------------------------------------------------- * * TclFreeObj -- * * This function frees the memory associated with the argument object. * It is called by the tcl.h macro Tcl_DecrRefCount when an object's ref * count is zero. It is only "public" since it must be callable by that * macro wherever the macro is used. It should not be directly called by * clients. * * Results: * None. * * Side effects: * Deallocates the storage for the object's Tcl_Obj structure after * deallocating the string representation and calling the type-specific * Tcl_FreeInternalRepProc to deallocate the object's internal * representation. If compiling with TCL_COMPILE_STATS, this function * increments the global count of freed objects (tclObjsFreed). * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclFreeObj( Tcl_Obj *objPtr) /* The object to be freed. */ { const Tcl_ObjType *typePtr = objPtr->typePtr; /* * This macro declares a variable, so must come here... */ ObjInitDeletionContext(context); # ifdef TCL_THREADS /* * Check to make sure that the Tcl_Obj was allocated by the current * thread. Don't do this check when shutting down since thread local * storage can be finalized before the last Tcl_Obj is freed. */ if (!TclInExit()) { Tcl_HashTable *tablePtr; Tcl_HashEntry *hPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tablePtr = tsdPtr->objThreadMap; if (!tablePtr) { Tcl_Panic("TclFreeObj: object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr); if (hPtr) { /* * As the Tcl_Obj is going to be deleted we remove the entry. */ ObjData *objData = Tcl_GetHashValue(hPtr); if (objData != NULL) { ckfree(objData); } Tcl_DeleteHashEntry(hPtr); } } # endif /* * Check for a double free of the same value. This is slightly tricky * because it is customary to free a Tcl_Obj when its refcount falls * either from 1 to 0, or from 0 to -1. Falling from -1 to -2, though, * and so on, is always a sign of a botch in the caller. */ if (objPtr->refCount < -1) { Tcl_Panic("Reference count for %p was negative", objPtr); } /* * Now, in case we just approved drop from 1 to 0 as acceptable, make * sure we do not accept a second free when falling from 0 to -1. * Skip that possibility so any double free will trigger the panic. */ objPtr->refCount = -1; /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) * with 'length == -1'. */ TclInvalidateStringRep(objPtr); objPtr->length = -1; if (ObjDeletePending(context)) { PushObjToDelete(context, objPtr); } else { TCL_DTRACE_OBJ_FREE(objPtr); if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { ObjDeletionLock(context); typePtr->freeIntRepProc(objPtr); ObjDeletionUnlock(context); } Tcl_MutexLock(&tclObjMutex); ckfree(objPtr); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); ObjDeletionLock(context); while (ObjOnStack(context)) { Tcl_Obj *objToFree; PopObjToDelete(context, objToFree); TCL_DTRACE_OBJ_FREE(objToFree); TclFreeIntRep(objToFree); Tcl_MutexLock(&tclObjMutex); ckfree(objToFree); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); } ObjDeletionUnlock(context); } /* * We cannot use TclGetContinuationTable() here, because that may * re-initialize the thread-data for calls coming after the finalization. * We have to access it using the low-level call and then check for * validity. This function can be called after TclFinalizeThreadData() has * already killed the thread-global data structures. Performing * TCL_TSD_INIT will leave us with an uninitialized memory block upon * which we crash (if we where to access the uninitialized hashtable). */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } #else /* TCL_MEM_DEBUG */ void TclFreeObj( Tcl_Obj *objPtr) /* The object to be freed. */ { /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) * with 'length == -1'. */ TclInvalidateStringRep(objPtr); objPtr->length = -1; if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) { /* * objPtr can be freed safely, as it will not attempt to free any * other objects: it will not cause recursive calls to this function. */ TCL_DTRACE_OBJ_FREE(objPtr); TclFreeObjStorage(objPtr); TclIncrObjsFreed(); } else { /* * This macro declares a variable, so must come here... */ ObjInitDeletionContext(context); if (ObjDeletePending(context)) { PushObjToDelete(context, objPtr); } else { /* * Note that the contents of the while loop assume that the string * rep has already been freed and we don't want to do anything * fancy with adding to the queue inside ourselves. Must take care * to unstack the object first since freeing the internal rep can * add further objects to the stack. The code assumes that it is * the first thing in a block; all current usages in the core * satisfy this. */ TCL_DTRACE_OBJ_FREE(objPtr); ObjDeletionLock(context); objPtr->typePtr->freeIntRepProc(objPtr); ObjDeletionUnlock(context); TclFreeObjStorage(objPtr); TclIncrObjsFreed(); ObjDeletionLock(context); while (ObjOnStack(context)) { Tcl_Obj *objToFree; PopObjToDelete(context, objToFree); TCL_DTRACE_OBJ_FREE(objToFree); if ((objToFree->typePtr != NULL) && (objToFree->typePtr->freeIntRepProc != NULL)) { objToFree->typePtr->freeIntRepProc(objToFree); } TclFreeObjStorage(objToFree); TclIncrObjsFreed(); } ObjDeletionUnlock(context); } } /* * We cannot use TclGetContinuationTable() here, because that may * re-initialize the thread-data for calls coming after the finalization. * We have to access it using the low-level call and then check for * validity. This function can be called after TclFinalizeThreadData() has * already killed the thread-global data structures. Performing * TCL_TSD_INIT will leave us with an uninitialized memory block upon * which we crash (if we where to access the uninitialized hashtable). */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * TclObjBeingDeleted -- * * This function returns 1 when the Tcl_Obj is being deleted. It is * provided for the rare cases where the reason for the loss of an * internal rep might be relevant. [FR 1512138] * * Results: * 1 if being deleted, 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclObjBeingDeleted( Tcl_Obj *objPtr) { return (objPtr->length == -1); } /* *---------------------------------------------------------------------- * * Tcl_DuplicateObj -- * * Create and return a new object that is a duplicate of the argument * object. * * Results: * The return value is a pointer to a newly created Tcl_Obj. This object * has reference count 0 and the same type, if any, as the source object * objPtr. Also: * 1) If the source object has a valid string rep, we copy it; * otherwise, the duplicate's string rep is set NULL to mark it * invalid. * 2) If the source object has an internal representation (i.e. its * typePtr is non-NULL), the new object's internal rep is set to a * copy; otherwise the new internal rep is marked invalid. * * Side effects: * What constitutes "copying" the internal representation depends on the * type. For example, if the argument object is a list, the element * objects it points to will not actually be copied but will be shared * with the duplicate list. That is, the ref counts of the element * objects will be incremented. * *---------------------------------------------------------------------- */ #define SetDuplicateObj(dupPtr, objPtr) \ { \ const Tcl_ObjType *typePtr = (objPtr)->typePtr; \ const char *bytes = (objPtr)->bytes; \ if (bytes) { \ TclInitStringRep((dupPtr), bytes, (objPtr)->length); \ } else { \ (dupPtr)->bytes = NULL; \ } \ if (typePtr) { \ if (typePtr->dupIntRepProc) { \ typePtr->dupIntRepProc((objPtr), (dupPtr)); \ } else { \ (dupPtr)->internalRep = (objPtr)->internalRep; \ (dupPtr)->typePtr = typePtr; \ } \ } \ } Tcl_Obj * Tcl_DuplicateObj( Tcl_Obj *objPtr) /* The object to duplicate. */ { Tcl_Obj *dupPtr; TclNewObj(dupPtr); SetDuplicateObj(dupPtr, objPtr); return dupPtr; } void TclSetDuplicateObj( Tcl_Obj *dupPtr, Tcl_Obj *objPtr) { if (Tcl_IsShared(dupPtr)) { Tcl_Panic("%s called with shared object", "TclSetDuplicateObj"); } TclInvalidateStringRep(dupPtr); TclFreeIntRep(dupPtr); SetDuplicateObj(dupPtr, objPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetString -- * * Returns the string representation byte array pointer for an object. * * Results: * Returns a pointer to the string representation of objPtr. The byte * array referenced by the returned pointer must not be modified by the * caller. Furthermore, the caller must copy the bytes if they need to * retain them since the object's string rep can change as a result of * other operations. * * Side effects: * May call the object's updateStringProc to update the string * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetString( Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes != NULL) { return objPtr->bytes; } /* * Note we do not check for objPtr->typePtr == NULL. An invariant of * a properly maintained Tcl_Obj is that at least one of objPtr->bytes * and objPtr->typePtr must not be NULL. If broken extensions fail to * maintain that invariant, we can crash here. */ if (objPtr->typePtr->updateStringProc == NULL) { /* * Those Tcl_ObjTypes which choose not to define an updateStringProc * must be written in such a way that (objPtr->bytes) never becomes * NULL. This panic was added in Tcl 8.1. */ Tcl_Panic("UpdateStringProc should not be invoked for type %s", objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); if (objPtr->bytes == NULL || objPtr->length < 0 || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", objPtr->typePtr->name); } return objPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_GetStringFromObj -- * * Returns the string representation's byte array pointer and length for * an object. * * Results: * Returns a pointer to the string representation of objPtr. If lengthPtr * isn't NULL, the length of the string representation is stored at * *lengthPtr. The byte array referenced by the returned pointer must not * be modified by the caller. Furthermore, the caller must copy the bytes * if they need to retain them since the object's string rep can change * as a result of other operations. * * Side effects: * May call the object's updateStringProc to update the string * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ int *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { (void) TclGetString(objPtr); if (lengthPtr != NULL) { *lengthPtr = objPtr->length; } return objPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_InvalidateStringRep -- * * This function is called to invalidate an object's string * representation. * * Results: * None. * * Side effects: * Deallocates the storage for any old string representation, then sets * the string representation NULL to mark it invalid. * *---------------------------------------------------------------------- */ void Tcl_InvalidateStringRep( Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be freed. */ { TclInvalidateStringRep(objPtr); } /* *---------------------------------------------------------------------- * * Tcl_NewBooleanObj -- * * This function is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and * initializes it from the argument boolean value. A nonzero "intValue" * is coerced to 1. * * When TCL_MEM_DEBUG is defined, this function just returns the result * of calling the debugging version Tcl_DbNewBooleanObj. * * Results: * The newly created object is returned. This object will have an invalid * string representation. The returned object has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ #undef Tcl_NewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewBooleanObj( int intValue) /* Boolean used to initialize new object. */ { return Tcl_DbNewBooleanObj(intValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewBooleanObj( int intValue) /* Boolean used to initialize new object. */ { Tcl_Obj *objPtr; TclNewBooleanObj(objPtr, intValue); return objPtr; } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewBooleanObj -- * * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the * same as the Tcl_NewBooleanObj function above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its * caller. This simplifies debugging since then the [memory active] * command will report the correct file name and line number when * reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this function just returns the * result of calling Tcl_NewBooleanObj. * * Results: * The newly created object is returned. This object will have an invalid * string representation. The returned object has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ #undef Tcl_DbNewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBooleanObj( int intValue, /* Boolean used to initialize new object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; objPtr->internalRep.longValue = (intValue? 1 : 0); objPtr->typePtr = &tclIntType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewBooleanObj( int intValue, /* Boolean used to initialize new object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewBooleanObj(intValue); } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_SetBooleanObj -- * * Modify an object to be a boolean object and to have the specified * boolean value. A nonzero "intValue" is coerced to 1. * * Results: * None. * * Side effects: * The object's old string rep, if any, is freed. Also, any old internal * rep is freed. * *---------------------------------------------------------------------- */ #undef Tcl_SetBooleanObj void Tcl_SetBooleanObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ int intValue) /* Boolean used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); } TclSetLongObj(objPtr, (intValue)!=0); } /* *---------------------------------------------------------------------- * * Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This * includes conversion from any of Tcl's numeric types. * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * The internalrep of *objPtr may be changed. * *---------------------------------------------------------------------- */ int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get boolean. */ int *intPtr) /* Place to store resulting boolean. */ { do { if (objPtr->typePtr == &tclIntType) { *intPtr = (objPtr->internalRep.longValue != 0); return TCL_OK; } if (objPtr->typePtr == &tclBooleanType) { *intPtr = (int) objPtr->internalRep.longValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { /* * Caution: Don't be tempted to check directly for the "double" * Tcl_ObjType and then compare the internalrep to 0.0. This isn't * reliable because a "double" Tcl_ObjType can hold the NaN value. * Use the API Tcl_GetDoubleFromObj, which does the checking and * sets the proper error message for us. */ double d; if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) { return TCL_ERROR; } *intPtr = (d != 0.0); return TCL_OK; } if (objPtr->typePtr == &tclBignumType) { *intPtr = 1; return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *intPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } #endif } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK == TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0))); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclSetBooleanFromAny -- * * Attempt to generate a boolean internal form for the Tcl object * "objPtr". * * Results: * The return value is a standard Tcl result. If an error occurs during * conversion, an error message is left in the interpreter's result * unless "interp" is NULL. * * Side effects: * If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal * representation and the type of "objPtr" is set to boolean. * *---------------------------------------------------------------------- */ int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine * whether a boolean conversion is possible without generating the string * rep. */ if (objPtr->bytes == NULL) { if (objPtr->typePtr == &tclIntType) { switch (objPtr->internalRep.longValue) { case 0L: case 1L: return TCL_OK; } goto badBoolean; } if (objPtr->typePtr == &tclBignumType) { goto badBoolean; } #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { goto badBoolean; } #endif if (objPtr->typePtr == &tclDoubleType) { goto badBoolean; } } if (ParseBoolean(objPtr) == TCL_OK) { return TCL_OK; } badBoolean: if (interp != NULL) { int length; const char *str = TclGetStringFromObj(objPtr, &length); Tcl_Obj *msg; TclNewLiteralStringObj(msg, "expected boolean value but got \""); Tcl_AppendLimitedToObj(msg, str, length, 50, ""); Tcl_AppendToObj(msg, "\"", -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL); } return TCL_ERROR; } static int ParseBoolean( Tcl_Obj *objPtr) /* The object to parse/convert. */ { int i, length, newBool; char lowerCase[6]; const char *str = TclGetStringFromObj(objPtr, &length); if ((length < 1) || (length > 5)) { /* * Longest valid boolean string rep. is "false". */ return TCL_ERROR; } switch (str[0]) { case '0': if (length == 1) { newBool = 0; goto numericBoolean; } return TCL_ERROR; case '1': if (length == 1) { newBool = 1; goto numericBoolean; } return TCL_ERROR; } /* * Force to lower case for case-insensitive detection. Filter out known * invalid characters at the same time. */ for (i=0; i < length; i++) { char c = str[i]; switch (c) { case 'A': case 'E': case 'F': case 'L': case 'N': case 'O': case 'R': case 'S': case 'T': case 'U': case 'Y': lowerCase[i] = c + (char) ('a' - 'A'); break; case 'a': case 'e': case 'f': case 'l': case 'n': case 'o': case 'r': case 's': case 't': case 'u': case 'y': lowerCase[i] = c; break; default: return TCL_ERROR; } } lowerCase[length] = 0; switch (lowerCase[0]) { case 'y': /* * Checking the 'y' is redundant, but makes the code clearer. */ if (strncmp(lowerCase, "yes", length) == 0) { newBool = 1; goto goodBoolean; } return TCL_ERROR; case 'n': if (strncmp(lowerCase, "no", length) == 0) { newBool = 0; goto goodBoolean; } return TCL_ERROR; case 't': if (strncmp(lowerCase, "true", length) == 0) { newBool = 1; goto goodBoolean; } return TCL_ERROR; case 'f': if (strncmp(lowerCase, "false", length) == 0) { newBool = 0; goto goodBoolean; } return TCL_ERROR; case 'o': if (length < 2) { return TCL_ERROR; } if (strncmp(lowerCase, "on", length) == 0) { newBool = 1; goto goodBoolean; } else if (strncmp(lowerCase, "off", length) == 0) { newBool = 0; goto goodBoolean; } return TCL_ERROR; default: return TCL_ERROR; } /* * Free the old internalRep before setting the new one. We do this as late * as possible to allow the conversion code, in particular * Tcl_GetStringFromObj, to use that old internalRep. */ goodBoolean: TclFreeIntRep(objPtr); objPtr->internalRep.longValue = newBool; objPtr->typePtr = &tclBooleanType; return TCL_OK; numericBoolean: TclFreeIntRep(objPtr); objPtr->internalRep.longValue = newBool; objPtr->typePtr = &tclIntType; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_NewDoubleObj -- * * This function is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates a new double object and * initializes it from the argument double value. * * When TCL_MEM_DEBUG is defined, this function just returns the result * of calling the debugging version Tcl_DbNewDoubleObj. * * Results: * The newly created object is returned. This object will have an * invalid string representation. The returned object has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewDoubleObj Tcl_Obj * Tcl_NewDoubleObj( double dblValue) /* Double used to initialize the object. */ { return Tcl_DbNewDoubleObj(dblValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewDoubleObj( double dblValue) /* Double used to initialize the object. */ { Tcl_Obj *objPtr; TclNewDoubleObj(objPtr, dblValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewDoubleObj -- * * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It creates new double objects. It is the * same as the Tcl_NewDoubleObj function above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its * caller. This simplifies debugging since then the [memory active] * command will report the correct file name and line number when * reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this function just returns the * result of calling Tcl_NewDoubleObj. * * Results: * The newly created object is returned. This object will have an invalid * string representation. The returned object has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDoubleObj( double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; objPtr->internalRep.doubleValue = dblValue; objPtr->typePtr = &tclDoubleType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewDoubleObj( double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewDoubleObj(dblValue); } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_SetDoubleObj -- * * Modify an object to be a double object and to have the specified * double value. * * Results: * None. * * Side effects: * The object's old string rep, if any, is freed. Also, any old internal * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetDoubleObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ double dblValue) /* Double used to set the object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj"); } TclSetDoubleObj(objPtr, dblValue); } /* *---------------------------------------------------------------------- * * Tcl_GetDoubleFromObj -- * * Attempt to return a double from the Tcl object "objPtr". If the object * is not already a double, an attempt will be made to convert it to one. * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * If the object is not already a double, the conversion will free any * old internal representation. * *---------------------------------------------------------------------- */ int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a double. */ double *dblPtr) /* Place to store resulting double. */ { do { if (objPtr->typePtr == &tclDoubleType) { if (TclIsNaN(objPtr->internalRep.doubleValue)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", NULL); } return TCL_ERROR; } *dblPtr = (double) objPtr->internalRep.doubleValue; return TCL_OK; } if (objPtr->typePtr == &tclIntType) { *dblPtr = objPtr->internalRep.longValue; return TCL_OK; } if (objPtr->typePtr == &tclBignumType) { mp_int big; UNPACK_BIGNUM(objPtr, big); *dblPtr = TclBignumToDouble(&big); return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *dblPtr = (double) objPtr->internalRep.wideValue; return TCL_OK; } #endif } while (SetDoubleFromAny(interp, objPtr) == TCL_OK); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * SetDoubleFromAny -- * * Attempt to generate an double-precision floating point internal form * for the Tcl object "objPtr". * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * If no error occurs, a double is stored as "objPtr"s internal * representation. * *---------------------------------------------------------------------- */ static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1, NULL, 0); } /* *---------------------------------------------------------------------- * * UpdateStringOfDouble -- * * Update the string representation for a double-precision floating point * object. This must obey the current tcl_precision value for * double-to-string conversions. Note: This function does not free an * existing old string rep so storage will be lost if this has not * already been done. * * Results: * None. * * Side effects: * The object's string is set to a valid string that results from the * double-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfDouble( Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { char buffer[TCL_DOUBLE_SPACE]; int len; Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer); len = strlen(buffer); objPtr->bytes = (char *)ckalloc(len + 1); memcpy(objPtr->bytes, buffer, len + 1); objPtr->length = len; } /* *---------------------------------------------------------------------- * * Tcl_NewIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to * Tcl_NewIntObj to create a new integer object end up calling the * debugging function Tcl_DbNewLongObj instead. * * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, * calls to Tcl_NewIntObj result in a call to one of the two * Tcl_NewIntObj implementations below. We provide two implementations so * that the Tcl core can be compiled to do memory debugging of the core * even if a client does not request it for itself. * * Integer and long integer objects share the same "integer" type * implementation. We store all integers as longs and Tcl_GetIntFromObj * checks whether the current value of the long can be represented by an * int. * * Results: * The newly created object is returned. This object will have an invalid * string representation. The returned object has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ #undef Tcl_NewIntObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewIntObj( int intValue) /* Int used to initialize the new object. */ { return Tcl_DbNewLongObj((long)intValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewIntObj( int intValue) /* Int used to initialize the new object. */ { Tcl_Obj *objPtr; TclNewIntObj(objPtr, intValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_SetIntObj -- * * Modify an object to be an integer and to have the specified integer * value. * * Results: * None. * * Side effects: * The object's old string rep, if any, is freed. Also, any old internal * rep is freed. * *---------------------------------------------------------------------- */ #undef Tcl_SetIntObj void Tcl_SetIntObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ int intValue) /* Integer used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); } TclSetIntObj(objPtr, intValue); } /* *---------------------------------------------------------------------- * * Tcl_GetIntFromObj -- * * Retrieve the integer value of 'objPtr'. * * Value * * TCL_OK * * Success. * * TCL_ERROR * * An error occurred during conversion or the integral value can not * be represented as an integer (it might be too large). An error * message is left in the interpreter's result if 'interp' is not * NULL. * * Effect * * 'objPtr' is converted to an integer if necessary if it is not one * already. The conversion frees any previously-existing internal * representation. * *---------------------------------------------------------------------- */ int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a int. */ int *intPtr) /* Place to store resulting int. */ { #if (LONG_MAX == INT_MAX) return TclGetLongFromObj(interp, objPtr, (long *) intPtr); #else void *p; int type; if ((TclGetNumberFromObj(NULL, objPtr, &p, &type) != TCL_OK) || (type == TCL_NUMBER_DOUBLE)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } if ((type != TCL_NUMBER_LONG) || ((ULONG_MAX > UINT_MAX) && ((*(long *)p > UINT_MAX) || (*(long *)p < -(long)UINT_MAX)))) { if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); } return TCL_ERROR; } *intPtr = (int)*(long *)p; return TCL_OK; #endif } /* *---------------------------------------------------------------------- * * SetIntFromAny -- * * Attempts to force the internal representation for a Tcl object to * tclIntType, specifically. * * Results: * The return value is a standard object Tcl result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * *---------------------------------------------------------------------- */ static int SetIntFromAny( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Pointer to the object to convert */ { long l; return TclGetLongFromObj(interp, objPtr, &l); } /* *---------------------------------------------------------------------- * * UpdateStringOfInt -- * * Update the string representation for an integer object. Note: This * function does not free an existing old string rep so storage will be * lost if this has not already been done. * * Results: * None. * * Side effects: * The object's string is set to a valid string that results from the * int-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfInt( Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char buffer[TCL_INTEGER_SPACE]; int len; len = TclFormatInt(buffer, objPtr->internalRep.longValue); objPtr->bytes = (char *)ckalloc(len + 1); memcpy(objPtr->bytes, buffer, len + 1); objPtr->length = len; } /* *---------------------------------------------------------------------- * * Tcl_NewLongObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to * Tcl_NewLongObj to create a new long integer object end up calling the * debugging function Tcl_DbNewLongObj instead. * * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, * calls to Tcl_NewLongObj result in a call to one of the two * Tcl_NewLongObj implementations below. We provide two implementations * so that the Tcl core can be compiled to do memory debugging of the * core even if a client does not request it for itself. * * Integer and long integer objects share the same "integer" type * implementation. We store all integers as longs and Tcl_GetIntFromObj * checks whether the current value of the long can be represented by an * int. * * Results: * The newly created object is returned. This object will have an invalid * string representation. The returned object has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewLongObj Tcl_Obj * Tcl_NewLongObj( long longValue) /* Long integer used to initialize the * new object. */ { return Tcl_DbNewLongObj(longValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewLongObj( long longValue) /* Long integer used to initialize the * new object. */ { Tcl_Obj *objPtr; TclNewLongObj(objPtr, longValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewLongObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to * Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer * objects end up calling the debugging function Tcl_DbNewLongObj * instead. We provide two implementations of Tcl_DbNewLongObj so that * whether the Tcl core is compiled to do memory debugging of the core is * independent of whether a client requests debugging for itself. * * When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj * calls Tcl_DbCkalloc directly with the file name and line number from * its caller. This simplifies debugging since then the [memory active] * command will report the caller's file name and line number when * reporting objects that haven't been freed. * * Otherwise, when the core is compiled without TCL_MEM_DEBUG defined, * this function just returns the result of calling Tcl_NewLongObj. * * Results: * The newly created long integer object is returned. This object will * have an invalid string representation. The returned object has ref * count 0. * * Side effects: * Allocates memory. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewLongObj( long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; objPtr->internalRep.longValue = longValue; objPtr->typePtr = &tclIntType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewLongObj( long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewLongObj(longValue); } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_SetLongObj -- * * Modify an object to be an integer object and to have the specified * long integer value. * * Results: * None. * * Side effects: * The object's old string rep, if any, is freed. Also, any old internal * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetLongObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ long longValue) /* Long integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); } TclSetLongObj(objPtr, longValue); } /* *---------------------------------------------------------------------- * * Tcl_GetLongFromObj -- * * Attempt to return an long integer from the Tcl object "objPtr". If the * object is not already an int object, an attempt will be made to * convert it to one. * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * If the object is not already an int object, the conversion will free * any old internal representation. * *---------------------------------------------------------------------- */ int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a long. */ long *longPtr) /* Place to store resulting long. */ { do { if (objPtr->typePtr == &tclIntType) { *longPtr = objPtr->internalRep.longValue; return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { /* * We return any integer in the range -ULONG_MAX to ULONG_MAX * converted to a long, ignoring overflow. The rule preserves * existing semantics for conversion of integers on input, but * avoids inadvertent demotion of wide integers to 32-bit ones in * the internal rep. */ Tcl_WideInt w = objPtr->internalRep.wideValue; if (w >= -(Tcl_WideInt)(ULONG_MAX) && w <= (Tcl_WideInt)(ULONG_MAX)) { *longPtr = Tcl_WideAsLong(w); return TCL_OK; } goto tooLarge; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { /* * Must check for those bignum values that can fit in a long, even * when auto-narrowing is enabled. Only those values in the signed * long range get auto-narrowed to tclIntType, while all the * values in the unsigned long range will fit in a long. */ mp_int big; UNPACK_BIGNUM(objPtr, big); if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) { unsigned long value = 0; size_t numBytes; long scratch; unsigned char *bytes = (unsigned char *) &scratch; if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { *longPtr = (long) (-value); } else { *longPtr = (long) value; } return TCL_OK; } } #ifndef TCL_WIDE_INT_IS_LONG tooLarge: #endif if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_Obj *msg = Tcl_NewStringObj(s, -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } #ifndef TCL_WIDE_INT_IS_LONG /* *---------------------------------------------------------------------- * * UpdateStringOfWideInt -- * * Update the string representation for a wide integer object. Note: this * function does not free an existing old string rep so storage will be * lost if this has not already been done. * * Results: * None. * * Side effects: * The object's string is set to a valid string that results from the * wideInt-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfWideInt( Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char buffer[TCL_INTEGER_SPACE+2]; unsigned len; Tcl_WideInt wideVal = objPtr->internalRep.wideValue; /* * Note that snprintf will generate a compiler warning under Mingw claiming * %I64 is an unknown format specifier. Just ignore this warning. We can't * use %L as the format specifier since that gets printed as a 32 bit * value. */ snprintf(buffer, sizeof(buffer), "%" TCL_LL_MODIFIER "d", wideVal); len = strlen(buffer); objPtr->bytes = (char *)ckalloc(len + 1); memcpy(objPtr->bytes, buffer, len + 1); objPtr->length = len; } #endif /* !TCL_WIDE_INT_IS_LONG */ /* *---------------------------------------------------------------------- * * Tcl_NewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to * Tcl_NewWideIntObj to create a new 64-bit integer object end up calling * the debugging function Tcl_DbNewWideIntObj instead. * * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, * calls to Tcl_NewWideIntObj result in a call to one of the two * Tcl_NewWideIntObj implementations below. We provide two * implementations so that the Tcl core can be compiled to do memory * debugging of the core even if a client does not request it for itself. * * Results: * The newly created object is returned. This object will have an invalid * string representation. The returned object has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewWideIntObj Tcl_Obj * Tcl_NewWideIntObj( Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { return Tcl_DbNewWideIntObj(wideValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewWideIntObj( Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); Tcl_SetWideIntObj(objPtr, wideValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to * Tcl_NewWideIntObj to create new wide integer end up calling the * debugging function Tcl_DbNewWideIntObj instead. We provide two * implementations of Tcl_DbNewWideIntObj so that whether the Tcl core is * compiled to do memory debugging of the core is independent of whether * a client requests debugging for itself. * * When the core is compiled with TCL_MEM_DEBUG defined, * Tcl_DbNewWideIntObj calls Tcl_DbCkalloc directly with the file name * and line number from its caller. This simplifies debugging since then * the checkmem command will report the caller's file name and line * number when reporting objects that haven't been freed. * * Otherwise, when the core is compiled without TCL_MEM_DEBUG defined, * this function just returns the result of calling Tcl_NewWideIntObj. * * Results: * The newly created wide integer object is returned. This object will * have an invalid string representation. The returned object has ref * count 0. * * Side effects: * Allocates memory. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewWideIntObj( Tcl_WideInt wideValue, /* Wide integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); Tcl_SetWideIntObj(objPtr, wideValue); return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewWideIntObj( Tcl_WideInt wideValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewWideIntObj(wideValue); } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_SetWideIntObj -- * * Modify an object to be a wide integer object and to have the specified * wide integer value. * * Results: * None. * * Side effects: * The object's old string rep, if any, is freed. Also, any old internal * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetWideIntObj( Tcl_Obj *objPtr, /* Object w. internal rep to init. */ Tcl_WideInt wideValue) /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); } #ifndef TCL_WIDE_INT_IS_LONG if ((wideValue < (Tcl_WideInt) LONG_MIN) || (wideValue > (Tcl_WideInt) LONG_MAX)) { TclSetWideIntObj(objPtr, wideValue); } else #endif TclSetLongObj(objPtr, (long) wideValue); } /* *---------------------------------------------------------------------- * * Tcl_GetWideIntFromObj -- * * Attempt to return a wide integer from the Tcl object "objPtr". If the * object is not already a wide int object, an attempt will be made to * convert it to one. * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * If the object is not already an int object, the conversion will free * any old internal representation. * *---------------------------------------------------------------------- */ int Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } #endif if (objPtr->typePtr == &tclIntType) { *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { /* * Must check for those bignum values that can fit in a * Tcl_WideInt, even when auto-narrowing is enabled. */ mp_int big; UNPACK_BIGNUM(objPtr, big); if ((size_t) big.used <= (CHAR_BIT * sizeof(Tcl_WideInt) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) { Tcl_WideUInt value = 0; size_t numBytes; Tcl_WideInt scratch; unsigned char *bytes = (unsigned char *) &scratch; if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { *wideIntPtr = (Tcl_WideInt) (-value); } else { *wideIntPtr = (Tcl_WideInt) value; } return TCL_OK; } } if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_Obj *msg = Tcl_NewStringObj(s, -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } #ifndef TCL_WIDE_INT_IS_LONG /* *---------------------------------------------------------------------- * * SetWideIntFromAny -- * * Attempts to force the internal representation for a Tcl object to * tclWideIntType, specifically. * * Results: * The return value is a standard object Tcl result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * *---------------------------------------------------------------------- */ static int SetWideIntFromAny( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Pointer to the object to convert */ { Tcl_WideInt w; return Tcl_GetWideIntFromObj(interp, objPtr, &w); } #endif /* !TCL_WIDE_INT_IS_LONG */ /* *---------------------------------------------------------------------- * * FreeBignum -- * * This function frees the internal rep of a bignum. * * Results: * None. * *---------------------------------------------------------------------- */ static void FreeBignum( Tcl_Obj *objPtr) { mp_int toFree; /* Bignum to free */ UNPACK_BIGNUM(objPtr, toFree); mp_clear(&toFree); if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) { ckfree(objPtr->internalRep.twoPtrValue.ptr1); } objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DupBignum -- * * This function duplicates the internal rep of a bignum. * * Results: * None. * * Side effects: * The destination object receives a copy of the source object * *---------------------------------------------------------------------- */ static void DupBignum( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { mp_int bignumVal; mp_int bignumCopy; copyPtr->typePtr = &tclBignumType; UNPACK_BIGNUM(srcPtr, bignumVal); if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) { Tcl_Panic("initialization failure in DupBignum"); } PACK_BIGNUM(bignumCopy, copyPtr); } /* *---------------------------------------------------------------------- * * UpdateStringOfBignum -- * * This function updates the string representation of a bignum object. * * Results: * None. * * Side effects: * The object's string is set to whatever results from the bignum- * to-string conversion. * * The object's existing string representation is NOT freed; memory will leak * if the string rep is still valid at the time this function is called. * *---------------------------------------------------------------------- */ static void UpdateStringOfBignum( Tcl_Obj *objPtr) { mp_int bignumVal; int size; int status; char *stringVal; UNPACK_BIGNUM(objPtr, bignumVal); status = mp_radix_size(&bignumVal, 10, &size); if (status != MP_OKAY) { Tcl_Panic("radix size failure in UpdateStringOfBignum"); } if (size < 2) { /* * mp_radix_size() returns < 2 when more than INT_MAX bytes would be * needed to hold the string rep (because mp_radix_size ignores * integer overflow issues). * * Note that so long as we enforce our bignums to the size that fits * in a packed bignum, this branch will never be taken. */ Tcl_Panic("UpdateStringOfBignum: string length limit exceeded"); } stringVal = (char *)ckalloc(size); status = mp_to_radix(&bignumVal, stringVal, size, NULL, 10); if (status != MP_OKAY) { Tcl_Panic("conversion failure in UpdateStringOfBignum"); } objPtr->bytes = stringVal; objPtr->length = size - 1; /* size includes a trailing NUL byte. */ } /* *---------------------------------------------------------------------- * * Tcl_NewBignumObj -- * * Creates and initializes a bignum object. * * Results: * Returns the newly created object. * * Side effects: * The bignum value is cleared, since ownership has transferred to Tcl. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewBignumObj Tcl_Obj * Tcl_NewBignumObj( mp_int *bignumValue) { return Tcl_DbNewBignumObj(bignumValue, "unknown", 0); } #else Tcl_Obj * Tcl_NewBignumObj( mp_int *bignumValue) { Tcl_Obj *objPtr; TclNewObj(objPtr); Tcl_SetBignumObj(objPtr, bignumValue); return objPtr; } #endif /* *---------------------------------------------------------------------- * * Tcl_DbNewBignumObj -- * * This function is normally called when debugging: that is, when * TCL_MEM_DEBUG is defined. It constructs a bignum object, recording the * creation point so that [memory active] can report it. * * Results: * Returns the newly created object. * * Side effects: * The bignum value is cleared, since ownership has transferred to Tcl. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBignumObj( mp_int *bignumValue, const char *file, int line) { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); Tcl_SetBignumObj(objPtr, bignumValue); return objPtr; } #else Tcl_Obj * Tcl_DbNewBignumObj( mp_int *bignumValue, const char *file, int line) { return Tcl_NewBignumObj(bignumValue); } #endif /* *---------------------------------------------------------------------- * * GetBignumFromObj -- * * This function retrieves a 'bignum' value from a Tcl object, converting * the object if necessary. Either copies or transfers the mp_int value * depending on the copy flag value passed in. * * Results: * Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise. * * Side effects: * A copy of bignum is stored in *bignumValue, which is expected to be * uninitialized or cleared. If conversion fails, and the 'interp' * argument is not NULL, an error message is stored in the interpreter * result. * *---------------------------------------------------------------------- */ static int GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ int copy, /* Whether to copy the returned bignum value */ mp_int *bignumValue) /* Returned bignum value. */ { do { if (objPtr->typePtr == &tclBignumType) { if (copy || Tcl_IsShared(objPtr)) { mp_int temp; UNPACK_BIGNUM(objPtr, temp); if (mp_init_copy(bignumValue, &temp) != MP_OKAY) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "insufficient memory to unpack bignum", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; } } else { UNPACK_BIGNUM(objPtr, *bignumValue); objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = NULL; if (objPtr->bytes == NULL) { TclInitStringRep(objPtr, tclEmptyStringRep, 0); } } return TCL_OK; } if (objPtr->typePtr == &tclIntType) { TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue); return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { TclBNInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_GetBignumFromObj -- * * This function retrieves a 'bignum' value from a Tcl object, converting * the object if necessary. * * Results: * Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise. * * Side effects: * A copy of bignum is stored in *bignumValue, which is expected to be * uninitialized or cleared. If conversion fails, an the 'interp' * argument is not NULL, an error message is stored in the interpreter * result. * * It is expected that the caller will NOT have invoked mp_init on the * bignum value before passing it in. Tcl will initialize the mp_int as * it sets the value. The value is a copy of the value in objPtr, so it * becomes the responsibility of the caller to call mp_clear on it. * *---------------------------------------------------------------------- */ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ mp_int *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 1, bignumValue); } /* *---------------------------------------------------------------------- * * Tcl_TakeBignumFromObj -- * * This function retrieves a 'bignum' value from a Tcl object, converting * the object if necessary. * * Results: * Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise. * * Side effects: * A copy of bignum is stored in *bignumValue, which is expected to be * uninitialized or cleared. If conversion fails and the 'interp' * argument is not NULL, an error message is stored in the interpreter * result. * * It is expected that the caller will NOT have invoked mp_init on the * bignum value before passing it in. Tcl will initialize the mp_int as * it sets the value. The value is transferred from the internals of * objPtr to the caller, passing responsibility of the caller to call * mp_clear on it. The objPtr is cleared to hold an empty value. * *---------------------------------------------------------------------- */ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ mp_int *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 0, bignumValue); } /* *---------------------------------------------------------------------- * * Tcl_SetBignumObj -- * * This function sets the value of a Tcl_Obj to a large integer. * * Results: * None. * * Side effects: * Object value is stored. The bignum value is cleared, since ownership * has transferred to Tcl. * *---------------------------------------------------------------------- */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ mp_int *bignumValue) /* Value to store */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj"); } if ((size_t) bignumValue->used <= (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) { unsigned long value = 0; size_t numBytes; long scratch; unsigned char *bytes = (unsigned char *) &scratch; if (mp_to_ubin(bignumValue, bytes, sizeof(long), &numBytes) != MP_OKAY) { goto tooLargeForLong; } while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) { goto tooLargeForLong; } if (bignumValue->sign) { TclSetLongObj(objPtr, (long)(-value)); } else { TclSetLongObj(objPtr, (long)value); } mp_clear(bignumValue); return; } tooLargeForLong: #ifndef TCL_WIDE_INT_IS_LONG if ((size_t) bignumValue->used <= (CHAR_BIT * sizeof(Tcl_WideInt) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) { Tcl_WideUInt value = 0; size_t numBytes; Tcl_WideInt scratch; unsigned char *bytes = (unsigned char *)&scratch; if (mp_to_ubin(bignumValue, bytes, sizeof(Tcl_WideInt), &numBytes) != MP_OKAY) { goto tooLargeForWide; } while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (value > ((UWIDE_MAX >> 1) + bignumValue->sign)) { goto tooLargeForWide; } if (bignumValue->sign) { TclSetWideIntObj(objPtr, (Tcl_WideInt)(-value)); } else { TclSetWideIntObj(objPtr, (Tcl_WideInt)value); } mp_clear(bignumValue); return; } tooLargeForWide: #endif TclInvalidateStringRep(objPtr); TclFreeIntRep(objPtr); TclSetBignumInternalRep(objPtr, bignumValue); } /* *---------------------------------------------------------------------- * * TclSetBignumInternalRep -- * * Install a bignum into the internal representation of an object. * * Results: * None. * * Side effects: * Object internal representation is updated and object type is set. The * bignum value is cleared, since ownership has transferred to the * object. * *---------------------------------------------------------------------- */ void TclSetBignumInternalRep( Tcl_Obj *objPtr, mp_int *bignumValue) { objPtr->typePtr = &tclBignumType; PACK_BIGNUM(*bignumValue, objPtr); /* * Clear the mp_int value. * * Don't call mp_clear() because it would free the digit array we just * packed into the Tcl_Obj. */ bignumValue->dp = NULL; bignumValue->alloc = bignumValue->used = 0; bignumValue->sign = MP_NEG; } /* *---------------------------------------------------------------------- * * TclGetNumberFromObj -- * * Extracts a number (of any possible numeric type) from an object. * * Results: * Whether the extraction worked. The type is stored in the variable * referred to by the typePtr argument, and a pointer to the * representation is stored in the variable referred to by the * clientDataPtr. * * Side effects: * Can allocate thread-specific data for handling the copy-out space for * bignums; this space is shared within a thread. * *---------------------------------------------------------------------- */ int TclGetNumberFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientDataPtr, int *typePtr) { do { if (objPtr->typePtr == &tclDoubleType) { if (TclIsNaN(objPtr->internalRep.doubleValue)) { *typePtr = TCL_NUMBER_NAN; } else { *typePtr = TCL_NUMBER_DOUBLE; } *clientDataPtr = &objPtr->internalRep.doubleValue; return TCL_OK; } if (objPtr->typePtr == &tclIntType) { *typePtr = TCL_NUMBER_LONG; *clientDataPtr = &objPtr->internalRep.longValue; return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *typePtr = TCL_NUMBER_WIDE; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } #endif if (objPtr->typePtr == &tclBignumType) { static Tcl_ThreadDataKey bignumKey; mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, (int) sizeof(mp_int)); UNPACK_BIGNUM(objPtr, *bigPtr); *typePtr = TCL_NUMBER_BIG; *clientDataPtr = bigPtr; return TCL_OK; } } while (TCL_OK == TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0)); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_DbIncrRefCount -- * * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. This checks to see whether or not the memory * has been freed before incrementing the ref count. * * When TCL_MEM_DEBUG is not defined, this function just increments the * reference count of the object. * * Results: * None. * * Side effects: * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbIncrRefCount( Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG if (objPtr->refCount == 0x61616161) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("incrementing refCount of previously disposed object"); } # ifdef TCL_THREADS /* * Check to make sure that the Tcl_Obj was allocated by the current * thread. Don't do this check when shutting down since thread local * storage can be finalized before the last Tcl_Obj is freed. */ if (!TclInExit()) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashTable *tablePtr = tsdPtr->objThreadMap; Tcl_HashEntry *hPtr; if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", "incr ref count"); } } # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ ++(objPtr)->refCount; } /* *---------------------------------------------------------------------- * * Tcl_DbDecrRefCount -- * * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. This checks to see whether or not the memory * has been freed before decrementing the ref count. * * When TCL_MEM_DEBUG is not defined, this function just decrements the * reference count of the object. * * Results: * None. * * Side effects: * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbDecrRefCount( Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG if (objPtr->refCount == 0x61616161) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("decrementing refCount of previously disposed object"); } # ifdef TCL_THREADS /* * Check to make sure that the Tcl_Obj was allocated by the current * thread. Don't do this check when shutting down since thread local * storage can be finalized before the last Tcl_Obj is freed. */ if (!TclInExit()) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashTable *tablePtr = tsdPtr->objThreadMap; Tcl_HashEntry *hPtr; if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", "decr ref count"); } } # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ if (objPtr->refCount-- <= 1) { TclFreeObj(objPtr); } } /* *---------------------------------------------------------------------- * * Tcl_DbIsShared -- * * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It tests whether the object has a ref count * greater than one. * * When TCL_MEM_DEBUG is not defined, this function just tests if the * object has a ref count greater than one. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_DbIsShared( Tcl_Obj *objPtr, /* The object to test for being shared. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG if (objPtr->refCount == 0x61616161) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("checking whether previously disposed object is shared"); } # ifdef TCL_THREADS /* * Check to make sure that the Tcl_Obj was allocated by the current * thread. Don't do this check when shutting down since thread local * storage can be finalized before the last Tcl_Obj is freed. */ if (!TclInExit()) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashTable *tablePtr = tsdPtr->objThreadMap; Tcl_HashEntry *hPtr; if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", "check shared status"); } } # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); if ((objPtr)->refCount <= 1) { tclObjsShared[1]++; } else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) { tclObjsShared[(objPtr)->refCount]++; } else { tclObjsShared[0]++; } Tcl_MutexUnlock(&tclObjMutex); #endif /* TCL_COMPILE_STATS */ return ((objPtr)->refCount > 1); } /* *---------------------------------------------------------------------- * * Tcl_InitObjHashTable -- * * Given storage for a hash table, set up the fields to prepare the hash * table for use, the keys are Tcl_Obj *. * * Results: * None. * * Side effects: * TablePtr is now ready to be passed to Tcl_FindHashEntry and * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitObjHashTable( Tcl_HashTable *tablePtr) /* Pointer to table record, which is supplied * by the caller. */ { Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS, &tclObjHashKeyType); } /* *---------------------------------------------------------------------- * * AllocObjEntry -- * * Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key. * * Results: * The return value is a pointer to the created entry. * * Side effects: * Increments the reference count on the object. * *---------------------------------------------------------------------- */ static Tcl_HashEntry * AllocObjEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; Tcl_HashEntry *hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry)); hPtr->key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); hPtr->clientData = NULL; return hPtr; } /* *---------------------------------------------------------------------- * * TclCompareObjKeys -- * * Compares two Tcl_Obj * keys. * * Results: * The return value is 0 if they are different and 1 if they are the * same. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; const char *p1, *p2; size_t l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller if (objPtr1 == objPtr2) return 1; */ /* * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being * in a register. */ p1 = TclGetString(objPtr1); l1 = objPtr1->length; p2 = TclGetString(objPtr2); l2 = objPtr2->length; /* * Only compare if the string representations are of the same length. */ if (l1 == l2) { for (;; p1++, p2++, l1--) { if (*p1 != *p2) { break; } if (l1 == 0) { return 1; } } } return 0; } /* *---------------------------------------------------------------------- * * TclFreeObjEntry -- * * Frees space for a Tcl_HashEntry containing the Tcl_Obj * key. * * Results: * The return value is a pointer to the created entry. * * Side effects: * Decrements the reference count of the object. * *---------------------------------------------------------------------- */ void TclFreeObjEntry( Tcl_HashEntry *hPtr) /* Hash entry to free. */ { Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue; Tcl_DecrRefCount(objPtr); ckfree(hPtr); } /* *---------------------------------------------------------------------- * * TclHashObjKey -- * * Compute a one-word summary of the string representation of the * Tcl_Obj, which can be used to generate a hash index. * * Results: * The return value is a one-word summary of the information in the * string representation of the Tcl_Obj. * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned int TclHashObjKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = keyPtr; int length; const char *string = TclGetStringFromObj(objPtr, &length); unsigned int result = 0; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose * the one below (multiply by 9 and add new character) because of the * following reasons: * * 1. Multiplying by 10 is perfect for keys that are decimal strings, and * multiplying by 9 is just about as good. * 2. Times-9 is (shift-left-3) plus (old). This means that each * character's bits hang around in the low-order bits of the hash value * for ever, plus they spread fairly rapidly up to the high-order bits * to fill out the hash value. This seems works well both for decimal * and non-decimal strings. * * Note that this function is very weak against malicious strings; it's * very easy to generate multiple keys that have the same hashcode. On the * other hand, that hardly ever actually occurs and this function *is* * very cheap, even by comparison with industry-standard hashes like FNV. * If real strength of hash is required though, use a custom hash based on * Bob Jenkins's lookup3(), but be aware that it's significantly slower. * Tcl does not use that level of strength because it typically does not * need it (and some of the aspects of that strength are genuinely * unnecessary given the rest of Tcl's hash machinery, and the fact that * we do not either transfer hashes to another machine, use them as a true * substitute for equality, or attempt to minimize work in rebuilding the * hash table). * * See also HashStringKey in tclHash.c. * See also HashString in tclLiteral.c. * * See [tcl-Feature Request #2958832] */ if (length > 0) { result = UCHAR(*string); while (--length) { result += (result << 3) + UCHAR(*++string); } } return result; } /* *---------------------------------------------------------------------- * * Tcl_GetCommandFromObj -- * * Returns the command specified by the name in a Tcl_Obj. * * Results: * Returns a token for the command if it is found. Otherwise, if it can't * be found or there is an error, returns NULL. * * Side effects: * May update the internal representation for the object, caching the * command reference so that the next time this function is called with * the same object, the command can be found quickly. * *---------------------------------------------------------------------- */ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ Tcl_Obj *objPtr) /* The object containing the command's name. * If the name starts with "::", will be * looked up in global namespace. Else, looked * up first in the current namespace, then in * global namespace. */ { ResolvedCmdName *resPtr; /* * Get the internal representation, converting to a command type if * needed. The internal representation is a ResolvedCmdName that points to * the actual command. * * Check the context namespace and the namespace epoch of the resolved * symbol to make sure that it is fresh. Note that we verify that the * namespace id of the context namespace is the same as the one we cached; * this insures that the namespace wasn't deleted and a new one created at * the same address with the same command epoch. Note that fully qualified * names have a NULL refNsPtr, these checks needn't be made. * * Check also that the command's epoch is up to date, and that the command * is not deleted. * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) { Command *cmdPtr = resPtr->cmdPtr; if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) && !(cmdPtr->flags & CMD_IS_DELETED) && (interp == cmdPtr->nsPtr->interp) && !(cmdPtr->nsPtr->flags & NS_DYING)) { Namespace *refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if ((resPtr->refNsPtr == NULL) || ((refNsPtr == resPtr->refNsPtr) && (resPtr->refNsId == refNsPtr->nsId) && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { return (Tcl_Command) cmdPtr; } } } /* * OK, must create a new internal representation (or fail) as any cache we * had is invalid one way or another. */ /* See [] why we cannot call SetCmdNameFromAny() directly here. */ if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) { return NULL; } resPtr = objPtr->internalRep.twoPtrValue.ptr1; return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL); } /* *---------------------------------------------------------------------- * * TclSetCmdNameObj -- * * Modify an object to be an CmdName object that refers to the argument * Command structure. * * Results: * None. * * Side effects: * The object's old internal rep is freed. Its string rep is not * changed. The refcount in the Command structure is incremented to keep * it from being freed if the command is later deleted until * TclNRExecuteByteCode has a chance to recognize that it was deleted. * *---------------------------------------------------------------------- */ void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { Interp *iPtr = (Interp *) interp; ResolvedCmdName *resPtr; Namespace *currNsPtr; const char *name; if (objPtr->typePtr == &tclCmdNameType) { resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) { return; } } cmdPtr->refCount++; resPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName)); resPtr->cmdPtr = cmdPtr; resPtr->cmdEpoch = cmdPtr->cmdEpoch; resPtr->refCount = 1; name = TclGetString(objPtr); if ((*name++ == ':') && (*name == ':')) { /* * The name is fully qualified: set the referring namespace to * NULL. */ resPtr->refNsPtr = NULL; } else { /* * Get the current namespace. */ currNsPtr = iPtr->varFramePtr->nsPtr; resPtr->refNsPtr = currNsPtr; resPtr->refNsId = currNsPtr->nsId; resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch; } TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = resPtr; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclCmdNameType; } /* *---------------------------------------------------------------------- * * FreeCmdNameInternalRep -- * * Frees the resources associated with a cmdName object's internal * representation. * * Results: * None. * * Side effects: * Decrements the ref count of any cached ResolvedCmdName structure * pointed to by the cmdName's internal representation. If this is the * last use of the ResolvedCmdName, it is freed. This in turn decrements * the ref count of the Command structure pointed to by the * ResolvedSymbol, which may free the Command structure. * *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL) { /* * Decrement the reference count of the ResolvedCmdName structure. If * there are no more uses, free the ResolvedCmdName structure. */ if (resPtr->refCount-- == 1) { /* * Now free the cached command, unless it is still in its hash * table or if there are other references to it from other cmdName * objects. */ Command *cmdPtr = resPtr->cmdPtr; TclCleanupCommandMacro(cmdPtr); ckfree(resPtr); } } objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DupCmdNameInternalRep -- * * Initialize the internal representation of an cmdName Tcl_Obj to a copy * of the internal representation of an existing cmdName object. * * Results: * None. * * Side effects: * "copyPtr"s internal rep is set to point to the ResolvedCmdName * structure corresponding to "srcPtr"s internal rep. Increments the ref * count of the ResolvedCmdName structure pointed to by the cmdName's * internal representation. * *---------------------------------------------------------------------- */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; if (resPtr != NULL) { resPtr->refCount++; } copyPtr->typePtr = &tclCmdNameType; } /* *---------------------------------------------------------------------- * * SetCmdNameFromAny -- * * Generate an cmdName internal form for the Tcl object "objPtr". * * Results: * The return value is a standard Tcl result. The conversion always * succeeds and TCL_OK is returned. * * Side effects: * A pointer to a ResolvedCmdName structure that holds a cached pointer * to the command with a name that matches objPtr's string rep is stored * as objPtr's internal representation. This ResolvedCmdName pointer will * be NULL if no matching command was found. The ref count of the cached * Command's structure (if any) is also incremented. * *---------------------------------------------------------------------- */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; Command *cmdPtr; Namespace *currNsPtr; ResolvedCmdName *resPtr; if (interp == NULL) { return TCL_ERROR; } /* * Find the Command structure, if any, that describes the command called * "name". Build a ResolvedCmdName that holds a cached pointer to this * Command, and bump the reference count in the referenced Command * structure. A Command structure will not be deleted as long as it is * referenced from a CmdName object. */ name = TclGetString(objPtr); cmdPtr = (Command *) Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0); /* * Free the old internalRep before setting the new one. Do this after * getting the string rep to allow the conversion code (in particular, * Tcl_GetStringFromObj) to use that old internalRep. */ if (cmdPtr) { cmdPtr->refCount++; resPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclCmdNameType) && resPtr && (resPtr->refCount == 1)) { /* * Reuse the old ResolvedCmdName struct instead of freeing it */ Command *oldCmdPtr = resPtr->cmdPtr; if (--oldCmdPtr->refCount == 0) { TclCleanupCommandMacro(oldCmdPtr); } } else { TclFreeIntRep(objPtr); resPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName)); resPtr->refCount = 1; objPtr->internalRep.twoPtrValue.ptr1 = resPtr; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclCmdNameType; } resPtr->cmdPtr = cmdPtr; resPtr->cmdEpoch = cmdPtr->cmdEpoch; if ((*name++ == ':') && (*name == ':')) { /* * The name is fully qualified: set the referring namespace to * NULL. */ resPtr->refNsPtr = NULL; } else { /* * Get the current namespace. */ currNsPtr = iPtr->varFramePtr->nsPtr; resPtr->refNsPtr = currNsPtr; resPtr->refNsId = currNsPtr->nsId; resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch; } } else { TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclCmdNameType; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_RepresentationCmd -- * * Implementation of the "tcl::unsupported::representation" command. * * Results: * Reports the current representation (Tcl_Obj type) of its argument. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_RepresentationCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { char ptrBuffer[2*TCL_INTEGER_SPACE+6]; Tcl_Obj *descObj; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } /* * Value is a bignum with a refcount of 14, object pointer at 0x12345678, * internal representation 0x45671234:0x98765432, string representation * "1872361827361287" */ snprintf(ptrBuffer, sizeof(ptrBuffer), "%p", (void *) objv[1]); descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d," " object pointer at %s", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, ptrBuffer); /* * This is a workaround to silence reports from `make valgrind` * on 64-bit systems. The problem is that the test suite * includes calling the [representation] command on values of * &tclDoubleType. When these values are created, the "doubleValue" * is set, but when the "twoPtrValue" is examined, its "ptr2" * field has never been initialized. Since [representation] * presents the value of the ptr2 value in its output, valgrind * alerts about the read of uninitialized memory. * * The general problem with [representation], that it can read * and report uninitialized fields, is still present. This is * just the minimal workaround to silence one particular test. */ if ((sizeof(void *) > 4) && objv[1]->typePtr == &tclDoubleType) { objv[1]->internalRep.twoPtrValue.ptr2 = NULL; } if (objv[1]->typePtr) { snprintf(ptrBuffer, sizeof(ptrBuffer), "%p:%p", (void *) objv[1]->internalRep.twoPtrValue.ptr1, (void *) objv[1]->internalRep.twoPtrValue.ptr2); Tcl_AppendPrintfToObj(descObj, ", internal representation %s", ptrBuffer); } if (objv[1]->bytes) { Tcl_AppendToObj(descObj, ", string representation \"", -1); Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length, 16, "..."); Tcl_AppendToObj(descObj, "\"", -1); } else { Tcl_AppendToObj(descObj, ", no string representation", -1); } Tcl_SetObjResult(interp, descObj); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/generic/tclOOBasic.c0000644000175000017500000010631214554262142015407 0ustar sergeisergei/* * tclOOBasic.c -- * * This file contains implementations of the "simple" commands and * methods from the object-system core. * * Copyright (c) 2005-2013 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp); static Tcl_NRPostProc AfterNRDestructor; static Tcl_NRPostProc DecrRefsPostClassConstructor; static Tcl_NRPostProc FinalizeConstruction; static Tcl_NRPostProc FinalizeEval; static Tcl_NRPostProc NextRestoreFrame; /* * ---------------------------------------------------------------------- * * AddCreateCallback, FinalizeConstruction -- * * Special version of TclNRAddCallback that allows the caller to splice * the object created later on. Always calls FinalizeConstruction, which * converts the object into its name and stores that in the interpreter * result. This is shared by all the construction methods (create, * createWithNamespace, new). * * Note that this is the only code in this file (or, indeed, the whole of * TclOO) that uses NRE internals; it is the only code that does * non-standard poking in the NRE guts. * * ---------------------------------------------------------------------- */ static inline Tcl_Object * AddConstructionFinalizer( Tcl_Interp *interp) { TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL); return (Tcl_Object *) &(TOP_CB(interp)->data[0]); } static int FinalizeConstruction( ClientData data[], Tcl_Interp *interp, int result) { Object *oPtr = data[0]; if (result != TCL_OK) { return result; } Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOO_Class_Constructor -- * * Implementation for oo::class constructor. * * ---------------------------------------------------------------------- */ int TclOO_Class_Constructor( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); Tcl_Obj **invoke; if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "?definitionScript?"); return TCL_ERROR; } else if (objc == Tcl_ObjectContextSkippedArgs(context)) { return TCL_OK; } /* * Delegate to [oo::define] to do the work. */ invoke = ckalloc(3 * sizeof(Tcl_Obj *)); invoke[0] = oPtr->fPtr->defineName; invoke[1] = TclOOObjectName(interp, oPtr); invoke[2] = objv[objc-1]; /* * Must add references or errors in configuration script will cause * trouble. */ Tcl_IncrRefCount(invoke[0]); Tcl_IncrRefCount(invoke[1]); Tcl_IncrRefCount(invoke[2]); TclNRAddCallback(interp, DecrRefsPostClassConstructor, invoke, NULL, NULL, NULL); /* * Tricky point: do not want the extra reported level in the Tcl stack * trace, so use TCL_EVAL_NOERR. */ return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL); } static int DecrRefsPostClassConstructor( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj **invoke = data[0]; TclDecrRefCount(invoke[0]); TclDecrRefCount(invoke[1]); TclDecrRefCount(invoke[2]); ckfree(invoke); return result; } /* * ---------------------------------------------------------------------- * * TclOO_Class_Create -- * * Implementation for oo::class->create method. * * ---------------------------------------------------------------------- */ int TclOO_Class_Create( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName; int len; /* * Sanity check; should not be possible to invoke this method on a * non-class. */ if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "object \"%s\" is not a class", TclGetString(cmdnameObj))); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL); return TCL_ERROR; } /* * Check we have the right number of (sensible) arguments. */ if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName ?arg ...?"); return TCL_ERROR; } objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } /* * Make the object and return its name. */ return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr, objName, NULL, objc, objv, Tcl_ObjectContextSkippedArgs(context)+1, AddConstructionFinalizer(interp)); } /* * ---------------------------------------------------------------------- * * TclOO_Class_CreateNs -- * * Implementation for oo::class->createWithNamespace method. * * ---------------------------------------------------------------------- */ int TclOO_Class_CreateNs( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName, *nsName; int len; /* * Sanity check; should not be possible to invoke this method on a * non-class. */ if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "object \"%s\" is not a class", TclGetString(cmdnameObj))); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL); return TCL_ERROR; } /* * Check we have the right number of (sensible) arguments. */ if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName namespaceName ?arg ...?"); return TCL_ERROR; } objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } nsName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "namespace name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } /* * Make the object and return its name. */ return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr, objName, nsName, objc, objv, Tcl_ObjectContextSkippedArgs(context)+2, AddConstructionFinalizer(interp)); } /* * ---------------------------------------------------------------------- * * TclOO_Class_New -- * * Implementation for oo::class->new method. * * ---------------------------------------------------------------------- */ int TclOO_Class_New( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); /* * Sanity check; should not be possible to invoke this method on a * non-class. */ if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "object \"%s\" is not a class", TclGetString(cmdnameObj))); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL); return TCL_ERROR; } /* * Make the object and return its name. */ return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr, NULL, NULL, objc, objv, Tcl_ObjectContextSkippedArgs(context), AddConstructionFinalizer(interp)); } /* * ---------------------------------------------------------------------- * * TclOO_Object_Destroy -- * * Implementation for oo::object->destroy method. * * ---------------------------------------------------------------------- */ int TclOO_Object_Destroy( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); CallContext *contextPtr; if (objc != Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } if (!(oPtr->flags & DESTRUCTOR_CALLED)) { oPtr->flags |= DESTRUCTOR_CALLED; contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); if (contextPtr != NULL) { contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; TclNRAddCallback(interp, AfterNRDestructor, contextPtr, NULL, NULL, NULL); TclPushTailcallPoint(interp); return TclOOInvokeContext(contextPtr, interp, 0, NULL); } } if (oPtr->command) { Tcl_DeleteCommandFromToken(interp, oPtr->command); } return TCL_OK; } static int AfterNRDestructor( ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; if (contextPtr->oPtr->command) { Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command); } TclOODeleteContext(contextPtr); return result; } /* * ---------------------------------------------------------------------- * * TclOO_Object_Eval -- * * Implementation for oo::object->eval method. * * ---------------------------------------------------------------------- */ int TclOO_Object_Eval( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { CallContext *contextPtr = (CallContext *) context; Tcl_Object object = Tcl_ObjectContextObject(context); const int skip = Tcl_ObjectContextSkippedArgs(context); CallFrame *framePtr, **framePtrPtr = &framePtr; Tcl_Obj *scriptPtr; CmdFrame *invoker; if (objc-1 < skip) { Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?"); return TCL_ERROR; } /* * Make the object's namespace the current namespace and evaluate the * command(s). */ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, Tcl_GetObjectNamespace(object), 0); framePtr->objc = objc; framePtr->objv = objv; /* Reference counts do not need to be * incremented here. */ if (!(contextPtr->callPtr->flags & PUBLIC_METHOD)) { object = NULL; /* Now just for error mesage printing. */ } /* * Work out what script we are actually going to evaluate. * * When there's more than one argument, we concatenate them together with * spaces between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. */ if (objc != skip+1) { scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip); invoker = NULL; } else { scriptPtr = objv[skip]; invoker = ((Interp *) interp)->cmdFramePtr; } /* * Evaluate the script now, with FinalizeEval to do the processing after * the script completes. */ TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL); return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip); } static int FinalizeEval( ClientData data[], Tcl_Interp *interp, int result) { if (result == TCL_ERROR) { Object *oPtr = data[0]; const char *namePtr; if (oPtr) { namePtr = TclGetString(TclOOObjectName(interp, oPtr)); } else { namePtr = "my"; } Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in \"%s eval\" script line %d)", namePtr, Tcl_GetErrorLine(interp))); } /* * Restore the previous "current" namespace. */ TclPopStackFrame(interp); return result; } /* * ---------------------------------------------------------------------- * * TclOO_Object_Unknown -- * * Default unknown method handler method (defined in oo::object). This * just creates a suitable error message. * * ---------------------------------------------------------------------- */ int TclOO_Object_Unknown( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { CallContext *contextPtr = (CallContext *) context; Object *oPtr = contextPtr->oPtr; const char **methodNames; int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context); Tcl_Obj *errorMsg; /* * If no method name, generate an error asking for a method name. (Only by * overriding *this* method can an object handle the absence of a method * name without an error). */ if (objc < skip+1) { Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?"); return TCL_ERROR; } /* * Get the list of methods that we want to know about. */ numMethodNames = TclOOGetSortedMethodList(oPtr, contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames); /* * Special message when there are no visible methods at all. */ if (numMethodNames == 0) { Tcl_Obj *tmpBuf = TclOOObjectName(interp, oPtr); const char *piece; if (contextPtr->callPtr->flags & PUBLIC_METHOD) { piece = "visible methods"; } else { piece = "methods"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "object \"%s\" has no %s", TclGetString(tmpBuf), piece)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[skip]), NULL); return TCL_ERROR; } errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ", TclGetString(objv[skip])); for (i=0 ; ivariable method. * * ---------------------------------------------------------------------- */ int TclOO_Object_LinkVar( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { Interp *iPtr = (Interp *) interp; Tcl_Object object = Tcl_ObjectContextObject(context); Namespace *savedNsPtr; int i; if (objc-Tcl_ObjectContextSkippedArgs(context) < 0) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "?varName ...?"); return TCL_ERROR; } /* * A sanity check. Shouldn't ever happen. (This is all that remains of a * more complex check inherited from [global] after we have applied the * fix for [Bug 2903811]; note that the fix involved *removing* code.) */ if (iPtr->varFramePtr == NULL) { return TCL_OK; } for (i=Tcl_ObjectContextSkippedArgs(context) ; ivarFramePtr->nsPtr; iPtr->varFramePtr->nsPtr = (Namespace *) Tcl_GetObjectNamespace(object); varPtr = TclObjLookupVar(interp, objv[i], NULL, TCL_NAMESPACE_ONLY, "define", 1, 0, &aryPtr); iPtr->varFramePtr->nsPtr = savedNsPtr; if (varPtr == NULL || aryPtr != NULL) { /* * Variable cannot be an element in an array. If aryPtr is not * NULL, it is an element, so throw up an error and return. */ TclVarErrMsg(interp, varName, NULL, "define", "name refers to an element in an array"); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL); return TCL_ERROR; } /* * Arrange for the lifetime of the variable to be correctly managed. * This is copied out of Tcl_VariableObjCmd... */ if (!TclIsVarNamespaceVar(varPtr)) { TclSetVarNamespaceVar(varPtr); } if (TclPtrMakeUpvar(interp, varPtr, varName, 0, -1) != TCL_OK) { return TCL_ERROR; } } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOO_Object_VarName -- * * Implementation of the oo::object->varname method. * * ---------------------------------------------------------------------- */ int TclOO_Object_VarName( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { Var *varPtr, *aryVar; Tcl_Obj *varNamePtr, *argPtr; const char *arg; if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "varName"); return TCL_ERROR; } argPtr = objv[objc-1]; arg = Tcl_GetString(argPtr); /* * Convert the variable name to fully-qualified form if it wasn't already. * This has to be done prior to lookup because we can run into problems * with resolvers otherwise. [Bug 3603695] * * We still need to do the lookup; the variable could be linked to another * variable and we want the target's name. */ if (arg[0] == ':' && arg[1] == ':') { varNamePtr = argPtr; } else { Tcl_Namespace *namespacePtr = Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)); varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1); Tcl_AppendToObj(varNamePtr, "::", 2); Tcl_AppendObjToObj(varNamePtr, argPtr); } Tcl_IncrRefCount(varNamePtr); varPtr = TclObjLookupVar(interp, varNamePtr, NULL, TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar); Tcl_DecrRefCount(varNamePtr); if (varPtr == NULL) { Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, NULL); return TCL_ERROR; } /* * Now that we've pinned down what variable we're really talking about * (including traversing variable links), convert back to a name. */ TclNewObj(varNamePtr); if (aryVar != NULL) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr); /* * WARNING! This code pokes inside the implementation of hash tables! */ hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr, &search); while (hPtr != NULL) { if (varPtr == Tcl_GetHashValue(hPtr)) { Tcl_AppendToObj(varNamePtr, "(", -1); Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr); Tcl_AppendToObj(varNamePtr, ")", -1); break; } hPtr = Tcl_NextHashEntry(&search); } } else { Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr); } Tcl_SetObjResult(interp, varNamePtr); return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOONextObjCmd, TclOONextToObjCmd -- * * Implementation of the [next] and [nextto] commands. Note that these * commands are only ever to be used inside the body of a procedure-like * method. * * ---------------------------------------------------------------------- */ int TclOONextObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; Tcl_ObjectContext context; /* * Start with sanity checks on the calling context to make sure that we * are invoked from a suitable method context. If so, we can safely * retrieve the handle to the object call context. */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s may only be called from inside a method", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } context = framePtr->clientData; /* * Invoke the (advanced) method call context in the caller context. Note * that this is like [uplevel 1] and not [eval]. */ TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL); iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); } int TclOONextToObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; Class *classPtr; CallContext *contextPtr; int i; Tcl_Object object; const char *methodType; /* * Start with sanity checks on the calling context to make sure that we * are invoked from a suitable method context. If so, we can safely * retrieve the handle to the object call context. */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s may only be called from inside a method", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } contextPtr = framePtr->clientData; /* * Sanity check the arguments; we need the first one to refer to a class. */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "class ?arg...?"); return TCL_ERROR; } object = Tcl_GetObjectFromObj(interp, objv[1]); if (object == NULL) { return TCL_ERROR; } classPtr = ((Object *)object)->classPtr; if (classPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" is not a class", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL); return TCL_ERROR; } /* * Search for an implementation of a method associated with the current * call on the call chain past the point where we currently are. Do not * allow jumping backwards! */ for (i=contextPtr->index+1 ; icallPtr->numChain ; i++) { struct MInvoke *miPtr = contextPtr->callPtr->chain + i; if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) { /* * Invoke the (advanced) method call context in the caller * context. Note that this is like [uplevel 1] and not [eval]. */ TclNRAddCallback(interp, NextRestoreFrame, framePtr, contextPtr, INT2PTR(contextPtr->index), NULL); contextPtr->index = i-1; iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, (Tcl_ObjectContext) contextPtr, objc, objv, 2); } } /* * Generate an appropriate error message, depending on whether the value * is on the chain but unreachable, or not on the chain at all. */ if (contextPtr->callPtr->flags & CONSTRUCTOR) { methodType = "constructor"; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { methodType = "destructor"; } else { methodType = "method"; } for (i=contextPtr->index ; i>=0 ; i--) { struct MInvoke *miPtr = contextPtr->callPtr->chain + i; if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s implementation by \"%s\" not reachable from here", methodType, TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE", NULL); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s has no non-filter implementation by \"%s\"", methodType, TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL); return TCL_ERROR; } static int NextRestoreFrame( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; CallContext *contextPtr = data[1]; iPtr->varFramePtr = data[0]; if (contextPtr != NULL) { contextPtr->index = PTR2INT(data[2]); } return result; } /* * ---------------------------------------------------------------------- * * TclOOSelfObjCmd -- * * Implementation of the [self] command, which provides introspection of * the call context. * * ---------------------------------------------------------------------- */ int TclOOSelfObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { static const char *const subcmds[] = { "call", "caller", "class", "filter", "method", "namespace", "next", "object", "target", NULL }; enum SelfCmds { SELF_CALL, SELF_CALLER, SELF_CLASS, SELF_FILTER, SELF_METHOD, SELF_NS, SELF_NEXT, SELF_OBJECT, SELF_TARGET }; Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; CallContext *contextPtr; Tcl_Obj *result[3]; int index; #define CurrentlyInvoked(contextPtr) \ ((contextPtr)->callPtr->chain[(contextPtr)->index]) /* * Start with sanity checks on the calling context and the method context. */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s may only be called from inside a method", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } contextPtr = framePtr->clientData; /* * Now we do "conventional" argument parsing for a while. Note that no * subcommand takes arguments. */ if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand"); return TCL_ERROR; } else if (objc == 1) { index = SELF_OBJECT; } else if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum SelfCmds) index) { case SELF_OBJECT: Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr)); return TCL_OK; case SELF_NS: Tcl_SetObjResult(interp, Tcl_NewStringObj( contextPtr->oPtr->namespacePtr->fullName,-1)); return TCL_OK; case SELF_CLASS: { Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr; if (clsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "method not defined by a class", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr)); return TCL_OK; } case SELF_METHOD: if (contextPtr->callPtr->flags & CONSTRUCTOR) { Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName); } else if (contextPtr->callPtr->flags & DESTRUCTOR) { Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName); } else { Tcl_SetObjResult(interp, CurrentlyInvoked(contextPtr).mPtr->namePtr); } return TCL_OK; case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); Object *oPtr; const char *type; if (miPtr->filterDeclarer != NULL) { oPtr = miPtr->filterDeclarer->thisPtr; type = "class"; } else { oPtr = contextPtr->oPtr; type = "object"; } result[0] = TclOOObjectName(interp, oPtr); result[1] = Tcl_NewStringObj(type, -1); result[2] = miPtr->mPtr->namePtr; Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); return TCL_OK; } case SELF_CALLER: if ((framePtr->callerVarPtr == NULL) || !(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){ Tcl_SetObjResult(interp, Tcl_NewStringObj( "caller is not an object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } else { CallContext *callerPtr = framePtr->callerVarPtr->clientData; Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr; Object *declarerPtr; if (mPtr->declaringClassPtr != NULL) { declarerPtr = mPtr->declaringClassPtr->thisPtr; } else if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; } else { /* * This should be unreachable code. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "method without declarer!", -1)); return TCL_ERROR; } result[0] = TclOOObjectName(interp, declarerPtr); result[1] = TclOOObjectName(interp, callerPtr->oPtr); if (callerPtr->callPtr->flags & CONSTRUCTOR) { result[2] = declarerPtr->fPtr->constructorName; } else if (callerPtr->callPtr->flags & DESTRUCTOR) { result[2] = declarerPtr->fPtr->destructorName; } else { result[2] = mPtr->namePtr; } Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); return TCL_OK; } case SELF_NEXT: if (contextPtr->index < contextPtr->callPtr->numChain-1) { Method *mPtr = contextPtr->callPtr->chain[contextPtr->index+1].mPtr; Object *declarerPtr; if (mPtr->declaringClassPtr != NULL) { declarerPtr = mPtr->declaringClassPtr->thisPtr; } else if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; } else { /* * This should be unreachable code. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "method without declarer!", -1)); return TCL_ERROR; } result[0] = TclOOObjectName(interp, declarerPtr); if (contextPtr->callPtr->flags & CONSTRUCTOR) { result[1] = declarerPtr->fPtr->constructorName; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { result[1] = declarerPtr->fPtr->destructorName; } else { result[1] = mPtr->namePtr; } Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); } return TCL_OK; case SELF_TARGET: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { Method *mPtr; Object *declarerPtr; int i; for (i=contextPtr->index ; icallPtr->numChain ; i++){ if (!contextPtr->callPtr->chain[i].isFilter) { break; } } if (i == contextPtr->callPtr->numChain) { Tcl_Panic("filtering call chain without terminal non-filter"); } mPtr = contextPtr->callPtr->chain[i].mPtr; if (mPtr->declaringClassPtr != NULL) { declarerPtr = mPtr->declaringClassPtr->thisPtr; } else if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; } else { /* * This should be unreachable code. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "method without declarer!", -1)); return TCL_ERROR; } result[0] = TclOOObjectName(interp, declarerPtr); result[1] = mPtr->namePtr; Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; } case SELF_CALL: result[0] = TclOORenderCallChain(interp, contextPtr->callPtr); TclNewIntObj(result[1], contextPtr->index); Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; } return TCL_ERROR; } /* * ---------------------------------------------------------------------- * * CopyObjectCmd -- * * Implementation of the [oo::copy] command, which clones an object (but * not its namespace). Note that no constructors are called during this * process. * * ---------------------------------------------------------------------- */ int TclOOCopyObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Object oPtr, o2Ptr; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "sourceName ?targetName? ?targetNamespace?"); return TCL_ERROR; } oPtr = Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } /* * Create a cloned object of the correct class. Note that constructors are * not called. Also note that we must resolve the object name ourselves * because we do not want to create the object in the current namespace, * but rather in the context of the namespace of the caller of the overall * [oo::define] command. */ if (objc == 2) { o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL); } else { const char *name, *namespaceName; name = TclGetString(objv[2]); if (name[0] == '\0') { name = NULL; } /* * Choose a unique namespace name if the user didn't supply one. */ namespaceName = NULL; if (objc == 4) { namespaceName = TclGetString(objv[3]); if (namespaceName[0] == '\0') { namespaceName = NULL; } else if (Tcl_FindNamespace(interp, namespaceName, NULL, 0) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s refers to an existing namespace", namespaceName)); return TCL_ERROR; } } o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); } if (o2Ptr == NULL) { return TCL_ERROR; } /* * Return the name of the cloned object. */ Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) o2Ptr)); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOO.c0000644000175000017500000024443414565156356014470 0ustar sergeisergei/* * tclOO.c -- * * This file contains the object-system core (NB: not Tcl_Obj, but ::oo) * * Copyright (c) 2005-2012 by Donal K. Fellows * Copyright (c) 2017 by Nathan Coulter * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" /* * Commands in oo::define. */ static const struct { const char *name; Tcl_ObjCmdProc *objProc; int flag; } defineCmds[] = { {"constructor", TclOODefineConstructorObjCmd, 0}, {"deletemethod", TclOODefineDeleteMethodObjCmd, 0}, {"destructor", TclOODefineDestructorObjCmd, 0}, {"export", TclOODefineExportObjCmd, 0}, {"forward", TclOODefineForwardObjCmd, 0}, {"method", TclOODefineMethodObjCmd, 0}, {"renamemethod", TclOODefineRenameMethodObjCmd, 0}, {"self", TclOODefineSelfObjCmd, 0}, {"unexport", TclOODefineUnexportObjCmd, 0}, {NULL, NULL, 0} }, objdefCmds[] = { {"class", TclOODefineClassObjCmd, 1}, {"deletemethod", TclOODefineDeleteMethodObjCmd, 1}, {"export", TclOODefineExportObjCmd, 1}, {"forward", TclOODefineForwardObjCmd, 1}, {"method", TclOODefineMethodObjCmd, 1}, {"renamemethod", TclOODefineRenameMethodObjCmd, 1}, {"unexport", TclOODefineUnexportObjCmd, 1}, {NULL, NULL, 0} }; /* * What sort of size of things we like to allocate. */ #define ALLOC_CHUNK 8 /* * Function declarations for things defined in this file. */ static Object * AllocObject(Tcl_Interp *interp, const char *nameStr, Namespace *nsPtr, const char *nsNameStr); static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method *mPtr, Tcl_Obj *namePtr, Method **newMPtrPtr); static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr); static void DeletedDefineNamespace(ClientData clientData); static void DeletedObjdefNamespace(ClientData clientData); static void DeletedHelpersNamespace(ClientData clientData); static Tcl_NRPostProc FinalizeAlloc; static Tcl_NRPostProc FinalizeNext; static Tcl_NRPostProc FinalizeObjectCall; static void initClassPath(Tcl_Interp * interp, Class *clsPtr); static int InitFoundation(Tcl_Interp *interp); static void KillFoundation(ClientData clientData, Tcl_Interp *interp); static void MyDeleted(ClientData clientData); static void ObjectNamespaceDeleted(ClientData clientData); static void ObjectRenamedTrace(ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); static inline void SquelchCachedName(Object *oPtr); static int PublicObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PublicNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PrivateObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PrivateNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static void RemoveClass(Class ** list, int num, int idx); static void RemoveObject(Object ** list, int num, int idx); /* * Methods in the oo::object and oo::class classes. First, we define a helper * macro that makes building the method type declaration structure a lot * easier. No point in making life harder than it has to be! * * Note that the core methods don't need clone or free proc callbacks. */ #define DCM(name,visibility,proc) \ {name,visibility,\ {TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}} static const DeclaredClassMethod objMethods[] = { DCM("destroy", 1, TclOO_Object_Destroy), DCM("eval", 0, TclOO_Object_Eval), DCM("unknown", 0, TclOO_Object_Unknown), DCM("variable", 0, TclOO_Object_LinkVar), DCM("varname", 0, TclOO_Object_VarName), {NULL, 0, {0, NULL, NULL, NULL, NULL}} }, clsMethods[] = { DCM("create", 1, TclOO_Class_Create), DCM("new", 1, TclOO_Class_New), DCM("createWithNamespace", 0, TclOO_Class_CreateNs), {NULL, 0, {0, NULL, NULL, NULL, NULL}} }; /* * And for the oo::class constructor... */ static const Tcl_MethodType classConstructor = { TCL_OO_METHOD_VERSION_CURRENT, "oo::class constructor", TclOO_Class_Constructor, NULL, NULL }; /* * Scripted parts of TclOO. First, the main script (cannot be outside this * file). */ static const char initScript[] = "package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};" "namespace eval ::oo { variable version " TCLOO_VERSION " };" "namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };"; /* "tcl_findLibrary tcloo $oo::version $oo::version" */ /* " tcloo.tcl OO_LIBRARY oo::library;"; */ /* * The scripted part of the definitions of slots. */ static const char *slotScript = "::oo::define ::oo::Slot {\n" " method Get {} {error unimplemented}\n" " method Set list {error unimplemented}\n" " method -set args {\n" " uplevel 1 [list [namespace which my] Set $args]\n" " }\n" " method -append args {\n" " uplevel 1 [list [namespace which my] Set [list" " {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n" " }\n" " method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n" " forward --default-operation my -append\n" " method unknown {args} {\n" " set def --default-operation\n" " if {[llength $args] == 0} {\n" " return [uplevel 1 [list [namespace which my] $def]]\n" " } elseif {![string match -* [lindex $args 0]]} {\n" " return [uplevel 1 [list [namespace which my] $def {*}$args]]\n" " }\n" " next {*}$args\n" " }\n" " export -set -append -clear\n" " unexport unknown destroy\n" "}\n" "::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n" "::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n" "::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n"; /* * The body of the method of oo::object. */ static const char *clonedBody = "foreach p [info procs [info object namespace $originObject]::*] {" " set args [info args $p];" " set idx -1;" " foreach a $args {" " lset args [incr idx] " " [if {[info default $p $a d]} {list $a $d} {list $a}]" " };" " set b [info body $p];" " set p [namespace tail $p];" " proc $p $args $b;" "};" "foreach v [info vars [info object namespace $originObject]::*] {" " upvar 0 $v vOrigin;" " namespace upvar [namespace current] [namespace tail $v] vNew;" " if {[info exists vOrigin]} {" " if {[array exists vOrigin]} {" " array set vNew [array get vOrigin];" " } else {" " set vNew $vOrigin;" " }" " }" "}"; /* * The actual definition of the variable holding the TclOO stub table. */ MODULE_SCOPE const TclOOStubs tclOOStubs; /* * Convenience macro for getting the foundation from an interpreter. */ #define GetFoundation(interp) \ ((Foundation *)((Interp *)(interp))->objectFoundation) /* * Macros to make inspecting into the guts of an object cleaner. * * The ocPtr parameter (only in these macros) is assumed to work fine with * either an oPtr or a classPtr. Note that the roots oo::object and oo::class * have _both_ their object and class flags tagged with ROOT_OBJECT and * ROOT_CLASS respectively. */ #define Destructing(oPtr) ((oPtr)->flags & OBJECT_DESTRUCTING) #define IsRootObject(ocPtr) ((ocPtr)->flags & ROOT_OBJECT) #define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS) #define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS)) #define RemoveItem(type, lst, i) \ do { \ Remove ## type ((lst).list, (lst).num, i); \ (lst).num--; \ } while (0) /* * ---------------------------------------------------------------------- * * TclOOInit -- * * Called to initialise the OO system within an interpreter. * * Result: * TCL_OK if the setup succeeded. Currently assumed to always work. * * Side effects: * Creates namespaces, commands, several classes and a number of * callbacks. Upon return, the OO system is ready for use. * * ---------------------------------------------------------------------- */ int TclOOInit( Tcl_Interp *interp) /* The interpreter to install into. */ { /* * Build the core of the OO system. */ if (InitFoundation(interp) != TCL_OK) { return TCL_ERROR; } /* * Run our initialization script and, if that works, declare the package * to be fully provided. */ if (Tcl_Eval(interp, initScript) != TCL_OK) { return TCL_ERROR; } return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL, &tclOOStubs); } /* * ---------------------------------------------------------------------- * * TclOOGetFoundation -- * * Get a reference to the OO core class system. * * ---------------------------------------------------------------------- */ Foundation * TclOOGetFoundation( Tcl_Interp *interp) { return GetFoundation(interp); } /* * ---------------------------------------------------------------------- * * InitFoundation -- * * Set up the core of the OO core class system. This is a structure * holding references to the magical bits that need to be known about in * other places, plus the oo::object and oo::class classes. * * ---------------------------------------------------------------------- */ static int InitFoundation( Tcl_Interp *interp) { static Tcl_ThreadDataKey tsdKey; ThreadLocalData *tsdPtr = Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); Foundation *fPtr = ckalloc(sizeof(Foundation)); Tcl_Obj *namePtr, *argsPtr, *bodyPtr; Class fakeCls; Object fakeObject; Tcl_DString buffer; Command *cmdPtr; int i; /* * Initialize the structure that holds the OO system core. This is * attached to the interpreter via an assocData entry; not very efficient, * but the best we can do without hacking the core more. */ memset(fPtr, 0, sizeof(Foundation)); ((Interp *) interp)->objectFoundation = fPtr; fPtr->interp = interp; fPtr->ooNs = Tcl_CreateNamespace(interp, "::oo", fPtr, NULL); Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1); fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr, DeletedDefineNamespace); fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr, DeletedObjdefNamespace); fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr, DeletedHelpersNamespace); fPtr->epoch = 0; fPtr->tsdPtr = tsdPtr; TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown"); TclNewLiteralStringObj(fPtr->constructorName, ""); TclNewLiteralStringObj(fPtr->destructorName, ""); TclNewLiteralStringObj(fPtr->clonedName, ""); TclNewLiteralStringObj(fPtr->defineName, "::oo::define"); Tcl_IncrRefCount(fPtr->unknownMethodNameObj); Tcl_IncrRefCount(fPtr->constructorName); Tcl_IncrRefCount(fPtr->destructorName); Tcl_IncrRefCount(fPtr->clonedName); Tcl_IncrRefCount(fPtr->defineName); Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition", TclOOUnknownDefinition, NULL, NULL); TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition"); Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr); Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr); /* * Create the subcommands in the oo::define and oo::objdefine spaces. */ Tcl_DStringInit(&buffer); for (i = 0 ; defineCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::define::"); Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } for (i = 0 ; objdefCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } Tcl_CallWhenDeleted(interp, KillFoundation, NULL); /* * Create the objects at the core of the object system. These need to be * spliced manually. */ /* * Stand up a phony class for bootstrapping. */ fPtr->objectCls = &fakeCls; /* * Referenced in TclOOAllocClass to increment the refCount. */ fakeCls.thisPtr = &fakeObject; fakeObject.refCount = 0; /* Do not increment an uninitialized value. */ fPtr->objectCls = TclOOAllocClass(interp, AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); /* * Corresponding TclOODecrRefCount in KillFoundation. */ AddRef(fPtr->objectCls->thisPtr); /* * This is why it is unnecessary in this routine to replace the * incremented reference count of fPtr->objectCls that was swallowed by * fakeObject. */ fPtr->objectCls->superclasses.num = 0; ckfree(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; /* * Special initialization for the primordial objects. */ fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; fPtr->objectCls->flags |= ROOT_OBJECT; fPtr->classCls = TclOOAllocClass(interp, AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); /* * Corresponding TclOODecrRefCount in KillFoundation. */ AddRef(fPtr->classCls->thisPtr); /* * Increment reference counts for each reference because these * relationships can be dynamically changed. * * Corresponding TclOODecrRefCount for all incremented refcounts is in * KillFoundation. */ /* * Rewire bootstrapped objects. */ fPtr->objectCls->thisPtr->selfCls = fPtr->classCls; AddRef(fPtr->classCls->thisPtr); TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls); fPtr->classCls->thisPtr->selfCls = fPtr->classCls; AddRef(fPtr->classCls->thisPtr); TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls); fPtr->classCls->thisPtr->flags |= ROOT_CLASS; fPtr->classCls->flags |= ROOT_CLASS; /* * Standard initialization for new Objects. */ TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls); /* * Basic method declarations for the core classes. */ for (i = 0 ; objMethods[i].name ; i++) { TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]); } for (i = 0 ; clsMethods[i].name ; i++) { TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]); } /* * Create the default method implementation, used when 'oo::copy' * is called to finish the copying of one object to another. */ TclNewLiteralStringObj(argsPtr, "originObject"); Tcl_IncrRefCount(argsPtr); bodyPtr = Tcl_NewStringObj(clonedBody, -1); TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr, bodyPtr, NULL); TclDecrRefCount(argsPtr); /* * Finish setting up the class of classes by marking the 'new' method as * private; classes, unlike general objects, must have explicit names. We * also need to create the constructor for classes. */ TclNewLiteralStringObj(namePtr, "new"); Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr, namePtr /* keeps ref */, 0 /* private */, NULL, NULL); fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL); /* * Create non-object commands and plug ourselves into the Tcl [info] * ensemble. */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next", NULL, TclOONextObjCmd, NULL, NULL); cmdPtr->compileProc = TclCompileObjectNextCmd; cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto", NULL, TclOONextToObjCmd, NULL, NULL); cmdPtr->compileProc = TclCompileObjectNextToCmd; cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self", TclOOSelfObjCmd, NULL, NULL); cmdPtr->compileProc = TclCompileObjectSelfCmd; Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL); TclOOInitInfo(interp); /* * Now make the class of slots. */ if (TclOODefineSlots(fPtr) != TCL_OK) { return TCL_ERROR; } return Tcl_Eval(interp, slotScript); } /* * ---------------------------------------------------------------------- * * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace -- * * Simple helpers used to clear fields of the foundation when they no * longer hold useful information. * * ---------------------------------------------------------------------- */ static void DeletedDefineNamespace( ClientData clientData) { Foundation *fPtr = clientData; fPtr->defineNs = NULL; } static void DeletedObjdefNamespace( ClientData clientData) { Foundation *fPtr = clientData; fPtr->objdefNs = NULL; } static void DeletedHelpersNamespace( ClientData clientData) { Foundation *fPtr = clientData; fPtr->helpersNs = NULL; } /* * ---------------------------------------------------------------------- * * KillFoundation -- * * Delete those parts of the OO core that are not deleted automatically * when the objects and classes themselves are destroyed. * * ---------------------------------------------------------------------- */ static void KillFoundation( ClientData clientData, /* Pointer to the OO system foundation * structure. */ Tcl_Interp *interp) /* The interpreter containing the OO system * foundation. */ { Foundation *fPtr = GetFoundation(interp); TclDecrRefCount(fPtr->unknownMethodNameObj); TclDecrRefCount(fPtr->constructorName); TclDecrRefCount(fPtr->destructorName); TclDecrRefCount(fPtr->clonedName); TclDecrRefCount(fPtr->defineName); TclOODecrRefCount(fPtr->objectCls->thisPtr); TclOODecrRefCount(fPtr->classCls->thisPtr); ckfree(fPtr); } /* * ---------------------------------------------------------------------- * * AllocObject -- * * Allocate an object of basic type. Does not splice the object into its * class's instance list. The caller must set the classPtr on the object * to either a class or NULL, call TclOOAddToInstances to add the object * to the class's instance list, and if the object itself is a class, use * call TclOOAddToSubclasses() to add it to the right class's list of * subclasses. * * ---------------------------------------------------------------------- */ static Object * AllocObject( Tcl_Interp *interp, /* Interpreter within which to create the * object. */ const char *nameStr, /* The name of the object to create, or NULL * if the OO system should pick the object * name itself (equal to the namespace * name). */ Namespace *nsPtr, /* The namespace to create the object in, or NULL if *nameStr is NULL */ const char *nsNameStr) /* The name of the namespace to create, or * NULL if the OO system should pick a unique * name itself. If this is non-NULL but names * a namespace that already exists, the effect * will be the same as if this was NULL. */ { Foundation *fPtr = GetFoundation(interp); Object *oPtr; Command *cmdPtr; CommandTrace *tracePtr; int creationEpoch; oPtr = ckalloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); /* * Every object has a namespace; make one. Note that this also normally * computes the creation epoch value for the object, a sequence number * that is unique to the object (and which allows us to manage method * caching without comparing pointers). * * When creating a namespace, we first check to see if the caller * specified the name for the namespace. If not, we generate namespace * names using the epoch until such time as a new namespace is actually * created. */ if (nsNameStr != NULL) { oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr, NULL); if (oPtr->namespacePtr != NULL) { creationEpoch = ++fPtr->tsdPtr->nsCount; goto configNamespace; } Tcl_ResetResult(interp); } while (1) { char objName[10 + TCL_INTEGER_SPACE]; snprintf(objName, sizeof(objName), "::oo::Obj%d", ++fPtr->tsdPtr->nsCount); oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL); if (oPtr->namespacePtr != NULL) { creationEpoch = fPtr->tsdPtr->nsCount; break; } /* * Could not make that namespace, so we make another. But first we * have to get rid of the error message from Tcl_CreateNamespace, * since that's something that should not be exposed to the user. */ Tcl_ResetResult(interp); } configNamespace: ((Namespace *) oPtr->namespacePtr)->refCount++; /* * Make the namespace know about the helper commands. This grants access * to the [self] and [next] commands. */ if (fPtr->helpersNs != NULL) { TclSetNsPath((Namespace *) oPtr->namespacePtr, 1, &fPtr->helpersNs); } TclOOSetupVariableResolver(oPtr->namespacePtr); /* * Suppress use of compiled versions of the commands in this object's * namespace and its children; causes wrong behaviour without expensive * recompilation. [Bug 2037727] */ ((Namespace *) oPtr->namespacePtr)->flags |= NS_SUPPRESS_COMPILATION; /* * Set up a callback to get notification of the deletion of a namespace * when enough of the namespace still remains to execute commands and * access variables in it. [Bug 2950259] */ ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = ObjectNamespaceDeleted; /* * Fill in the rest of the non-zero/NULL parts of the structure. */ oPtr->fPtr = fPtr; oPtr->creationEpoch = creationEpoch; /* * An object starts life with a refCount of 2 to mark the two stages of * destruction it occur: A call to ObjectRenamedTrace(), and a call to * ObjectNamespaceDeleted(). */ oPtr->refCount = 2; oPtr->flags = USE_CLASS_CACHE; /* * Finally, create the object commands and initialize the trace on the * public command (so that the object structures are deleted when the * command is deleted). */ if (!nameStr) { nameStr = oPtr->namespacePtr->name; nsPtr = (Namespace *)oPtr->namespacePtr; if (nsPtr->parentPtr != NULL) { nsPtr = nsPtr->parentPtr; } } oPtr->command = TclCreateObjCommandInNs(interp, nameStr, (Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL); /* * Add the NRE command and trace directly. While this breaks a number of * abstractions, it is faster and we're inside Tcl here so we're allowed. */ cmdPtr = (Command *) oPtr->command; cmdPtr->nreProc = PublicNRObjectCmd; cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace)); tracePtr->traceProc = ObjectRenamedTrace; tracePtr->clientData = oPtr; tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE; tracePtr->nextPtr = NULL; tracePtr->refCount = 1; oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr, PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted); return oPtr; } /* * ---------------------------------------------------------------------- * * SquelchCachedName -- * * Encapsulates how to throw away a cached object name. Called from * object rename traces and at object destruction. * * ---------------------------------------------------------------------- */ static inline void SquelchCachedName( Object *oPtr) { if (oPtr->cachedNameObj) { Tcl_DecrRefCount(oPtr->cachedNameObj); oPtr->cachedNameObj = NULL; } } /* * ---------------------------------------------------------------------- * * MyDeleted -- * * This callback is triggered when the object's [my] command is deleted * by any mechanism. It just marks the object as not having a [my] * command, and so prevents cleanup of that when the object itself is * deleted. * * ---------------------------------------------------------------------- */ static void MyDeleted( ClientData clientData) /* Reference to the object whose [my] has been * squelched. */ { Object *oPtr = clientData; oPtr->myCommand = NULL; } /* * ---------------------------------------------------------------------- * * ObjectRenamedTrace -- * * This callback is triggered when the object is deleted by any * mechanism. It runs the destructors and arranges for the actual cleanup * of the object's namespace, which in turn triggers cleansing of the * object data structures. * * ---------------------------------------------------------------------- */ static void ObjectRenamedTrace( ClientData clientData, /* The object being deleted. */ Tcl_Interp *interp, /* The interpreter containing the object. */ const char *oldName, /* What the object was (last) called. */ const char *newName, /* What it's getting renamed to. (unused) */ int flags) /* Why was the object deleted? */ { Object *oPtr = clientData; /* * If this is a rename and not a delete of the object, we just flush the * cache of the object name. */ if (flags & TCL_TRACE_RENAME) { SquelchCachedName(oPtr); return; } /* * The namespace is only deleted if it hasn't already been deleted. [Bug * 2950259]. */ if (!Destructing(oPtr)) { Tcl_DeleteNamespace(oPtr->namespacePtr); } oPtr->command = NULL; TclOODecrRefCount(oPtr); return; } /* * ---------------------------------------------------------------------- * * TclOODeleteDescendants -- * * Delete all descendants of a particular class. * * ---------------------------------------------------------------------- */ void TclOODeleteDescendants( Tcl_Interp *interp, /* The interpreter containing the class. */ Object *oPtr) /* The object representing the class. */ { Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr; Object *instancePtr; /* * Squelch classes that this class has been mixed into. */ if (clsPtr->mixinSubs.num > 0) { while (clsPtr->mixinSubs.num > 0) { mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num - 1]; /* * This condition also covers the case where mixinSubclassPtr == * clsPtr */ if (!Destructing(mixinSubclassPtr->thisPtr) && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, mixinSubclassPtr->thisPtr->command); } TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); } } if (clsPtr->mixinSubs.size > 0) { ckfree(clsPtr->mixinSubs.list); clsPtr->mixinSubs.size = 0; } /* * Squelch subclasses of this class. */ if (clsPtr->subclasses.num > 0) { while (clsPtr->subclasses.num > 0) { subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1]; if (!Destructing(subclassPtr->thisPtr) && !IsRoot(subclassPtr) && !(subclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); } TclOORemoveFromSubclasses(subclassPtr, clsPtr); } } if (clsPtr->subclasses.size > 0) { ckfree(clsPtr->subclasses.list); clsPtr->subclasses.list = NULL; clsPtr->subclasses.size = 0; } /* * Squelch instances of this class (includes objects we're mixed into). */ if (clsPtr->instances.num > 0) { while (clsPtr->instances.num > 0) { instancePtr = clsPtr->instances.list[clsPtr->instances.num - 1]; /* * This condition also covers the case where instancePtr == oPtr */ if (!Destructing(instancePtr) && !IsRoot(instancePtr) && !(instancePtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); } TclOORemoveFromInstances(instancePtr, clsPtr); } } if (clsPtr->instances.size > 0) { ckfree(clsPtr->instances.list); clsPtr->instances.list = NULL; clsPtr->instances.size = 0; } } /* * ---------------------------------------------------------------------- * * TclOOReleaseClassContents -- * * Tear down the special class data structure, including deleting all * dependent classes and objects. * * ---------------------------------------------------------------------- */ void TclOOReleaseClassContents( Tcl_Interp *interp, /* The interpreter containing the class. */ Object *oPtr) /* The object representing the class. */ { FOREACH_HASH_DECLS; int i; Class *clsPtr = oPtr->classPtr, *tmpClsPtr; Method *mPtr; Foundation *fPtr = oPtr->fPtr; Tcl_Obj *variableObj; /* * Sanity check! */ if (!Destructing(oPtr)) { if (IsRootClass(oPtr)) { Tcl_Panic("deleting class structure for non-deleted %s", "::oo::class"); } else if (IsRootObject(oPtr)) { Tcl_Panic("deleting class structure for non-deleted %s", "::oo::object"); } } /* * Squelch method implementation chain caches. */ if (clsPtr->constructorChainPtr) { TclOODeleteChain(clsPtr->constructorChainPtr); clsPtr->constructorChainPtr = NULL; } if (clsPtr->destructorChainPtr) { TclOODeleteChain(clsPtr->destructorChainPtr); clsPtr->destructorChainPtr = NULL; } if (clsPtr->classChainCache) { CallChain *callPtr; FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) { TclOODeleteChain(callPtr); } Tcl_DeleteHashTable(clsPtr->classChainCache); ckfree(clsPtr->classChainCache); clsPtr->classChainCache = NULL; } /* * Squelch our filter list. */ if (clsPtr->filters.num) { Tcl_Obj *filterObj; FOREACH(filterObj, clsPtr->filters) { TclDecrRefCount(filterObj); } ckfree(clsPtr->filters.list); clsPtr->filters.list = NULL; clsPtr->filters.num = 0; } /* * Squelch our metadata. */ if (clsPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; ClientData value; FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) { metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(clsPtr->metadataPtr); ckfree(clsPtr->metadataPtr); clsPtr->metadataPtr = NULL; } if (clsPtr->mixins.num) { FOREACH(tmpClsPtr, clsPtr->mixins) { TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr); TclOODecrRefCount(tmpClsPtr->thisPtr); } ckfree(clsPtr->mixins.list); clsPtr->mixins.list = NULL; clsPtr->mixins.num = 0; } if (clsPtr->superclasses.num > 0) { FOREACH(tmpClsPtr, clsPtr->superclasses) { TclOORemoveFromSubclasses(clsPtr, tmpClsPtr); TclOODecrRefCount(tmpClsPtr->thisPtr); } ckfree(clsPtr->superclasses.list); clsPtr->superclasses.num = 0; clsPtr->superclasses.list = NULL; } FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) { TclOODelMethodRef(mPtr); } Tcl_DeleteHashTable(&clsPtr->classMethods); TclOODelMethodRef(clsPtr->constructorPtr); TclOODelMethodRef(clsPtr->destructorPtr); FOREACH(variableObj, clsPtr->variables) { TclDecrRefCount(variableObj); } if (i) { ckfree(clsPtr->variables.list); } if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) { Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command); } } /* * ---------------------------------------------------------------------- * * ObjectNamespaceDeleted -- * * Callback when the object's namespace is deleted. Used to clean up the * data structures associated with the object. The complicated bit is * that this can sometimes happen before the object's command is deleted * (interpreter teardown is complex!) * * ---------------------------------------------------------------------- */ static void ObjectNamespaceDeleted( ClientData clientData) /* Pointer to the class whose namespace is * being deleted. */ { Object *oPtr = clientData; Foundation *fPtr = oPtr->fPtr; FOREACH_HASH_DECLS; Class *mixinPtr; Method *mPtr; Tcl_Obj *filterObj, *variableObj; Tcl_Interp *interp = oPtr->fPtr->interp; int i; if (Destructing(oPtr)) { /* * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, * this guard could be removed. */ return; } /* * One rule for the teardown routines is that if an object is in the * process of being deleted, nothing else may modify its bookkeeping * records. This is the flag that */ oPtr->flags |= OBJECT_DESTRUCTING; /* * Let the dominoes fall! */ if (oPtr->classPtr) { TclOODeleteDescendants(interp, oPtr); } /* * We do not run destructors on the core class objects when the * interpreter is being deleted; their incestuous nature causes problems * in that case when the destructor is partially deleted before the uses * of it have gone. [Bug 2949397] */ if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); int result; Tcl_InterpState state; oPtr->flags |= DESTRUCTOR_CALLED; if (contextPtr != NULL) { contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; state = Tcl_SaveInterpState(interp, TCL_OK); result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 0, NULL); if (result != TCL_OK) { Tcl_BackgroundException(interp, result); } Tcl_RestoreInterpState(interp, state); TclOODeleteContext(contextPtr); } } /* * Instruct everyone to no longer use any allocated fields of the object. * Also delete the command that refers to the object at this point (if it * still exists) because otherwise its pointer to the object points into * freed memory. */ if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) { /* * Something has already started the command deletion process. We can * go ahead and clean up the namespace, */ } else { /* * The namespace must have been deleted directly. Delete the command * as well. */ Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); } if (oPtr->myCommand) { Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand); } /* * Splice the object out of its context. After this, we must *not* call * methods on the object. */ /* TODO: Should this be protected with a !IsRoot() condition? */ TclOORemoveFromInstances(oPtr, oPtr->selfCls); if (oPtr->mixins.num > 0) { FOREACH(mixinPtr, oPtr->mixins) { TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } if (oPtr->mixins.list != NULL) { ckfree(oPtr->mixins.list); } } FOREACH(filterObj, oPtr->filters) { TclDecrRefCount(filterObj); } if (i) { ckfree(oPtr->filters.list); } if (oPtr->methodsPtr) { FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) { TclOODelMethodRef(mPtr); } Tcl_DeleteHashTable(oPtr->methodsPtr); ckfree(oPtr->methodsPtr); } FOREACH(variableObj, oPtr->variables) { TclDecrRefCount(variableObj); } if (i) { ckfree(oPtr->variables.list); } if (oPtr->chainCache) { TclOODeleteChainCache(oPtr->chainCache); } SquelchCachedName(oPtr); if (oPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; ClientData value; FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) { metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(oPtr->metadataPtr); ckfree(oPtr->metadataPtr); oPtr->metadataPtr = NULL; } /* * Because an object can be a class that is an instance of itself, the * class object's class structure should only be cleaned after most of * the cleanup on the object is done. * * The class of objects needs some special care; if it is deleted (and * we're not killing the whole interpreter) we force the delete of the * class of classes now as well. Due to the incestuous nature of those two * classes, if one goes the other must too and yet the tangle can * sometimes not go away automatically; we force it here. [Bug 2962664] */ if (IsRootObject(oPtr) && !Destructing(fPtr->classCls->thisPtr) && !Tcl_InterpDeleted(interp)) { Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); } if (oPtr->classPtr != NULL) { TclOOReleaseClassContents(interp, oPtr); } /* * Delete the object structure itself. */ TclNsDecrRefCount((Namespace *)oPtr->namespacePtr); oPtr->namespacePtr = NULL; TclOODecrRefCount(oPtr->selfCls->thisPtr); oPtr->selfCls = NULL; TclOODecrRefCount(oPtr); return; } /* * ---------------------------------------------------------------------- * * TclOODecrRef -- * * Decrement the refcount of an object and deallocate storage then object * is no longer referenced. Returns 1 if storage was deallocated, and 0 * otherwise. * * ---------------------------------------------------------------------- */ int TclOODecrRefCount(Object *oPtr) { if (oPtr->refCount-- <= 1) { if (oPtr->classPtr != NULL) { ckfree(oPtr->classPtr); } ckfree(oPtr); return 1; } return 0; } /* * ---------------------------------------------------------------------- * * TclOOObjectDestroyed -- * * Returns TCL_OK if an object is entirely deleted, i.e. the destruction * sequence has completed. * * ---------------------------------------------------------------------- */ int TclOOObjectDestroyed(Object *oPtr) { return (oPtr->namespacePtr == NULL); } /* * Setting the "empty" location to NULL makes debugging a little easier. */ #define REMOVEBODY { \ for (; idx < num - 1; idx++) { \ list[idx] = list[idx + 1]; \ } \ list[idx] = NULL; \ return; \ } void RemoveClass(Class **list, int num, int idx) REMOVEBODY void RemoveObject(Object **list, int num, int idx) REMOVEBODY /* * ---------------------------------------------------------------------- * * TclOORemoveFromInstances -- * * Utility function to remove an object from the list of instances within * a class. * * ---------------------------------------------------------------------- */ int TclOORemoveFromInstances( Object *oPtr, /* The instance to remove. */ Class *clsPtr) /* The class (possibly) containing the * reference to the instance. */ { int i, res = 0; Object *instPtr; FOREACH(instPtr, clsPtr->instances) { if (oPtr == instPtr) { RemoveItem(Object, clsPtr->instances, i); TclOODecrRefCount(oPtr); res++; break; } } return res; } /* * ---------------------------------------------------------------------- * * TclOOAddToInstances -- * * Utility function to add an object to the list of instances within a * class. * * ---------------------------------------------------------------------- */ void TclOOAddToInstances( Object *oPtr, /* The instance to add. */ Class *clsPtr) /* The class to add the instance to. It is * assumed that the class is not already * present as an instance in the class. */ { if (clsPtr->instances.num >= clsPtr->instances.size) { clsPtr->instances.size += ALLOC_CHUNK; if (clsPtr->instances.size == ALLOC_CHUNK) { clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK); } else { clsPtr->instances.list = ckrealloc(clsPtr->instances.list, sizeof(Object *) * clsPtr->instances.size); } } clsPtr->instances.list[clsPtr->instances.num++] = oPtr; AddRef(oPtr); } /* * ---------------------------------------------------------------------- * * TclOORemoveFromMixins -- * * Utility function to remove a class from the list of mixins within an * object. * * ---------------------------------------------------------------------- */ int TclOORemoveFromMixins( Class *mixinPtr, /* The mixin to remove. */ Object *oPtr) /* The object (possibly) containing the * reference to the mixin. */ { int i, res = 0; Class *mixPtr; FOREACH(mixPtr, oPtr->mixins) { if (mixinPtr == mixPtr) { RemoveItem(Class, oPtr->mixins, i); TclOODecrRefCount(mixPtr->thisPtr); res++; break; } } if (oPtr->mixins.num == 0) { ckfree(oPtr->mixins.list); oPtr->mixins.list = NULL; } return res; } /* * ---------------------------------------------------------------------- * * TclOORemoveFromSubclasses -- * * Utility function to remove a class from the list of subclasses within * another class. Returns the number of removals performed. * * ---------------------------------------------------------------------- */ int TclOORemoveFromSubclasses( Class *subPtr, /* The subclass to remove. */ Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { int i, res = 0; Class *subclsPtr; FOREACH(subclsPtr, superPtr->subclasses) { if (subPtr == subclsPtr) { RemoveItem(Class, superPtr->subclasses, i); TclOODecrRefCount(subPtr->thisPtr); res++; } } return res; } /* * ---------------------------------------------------------------------- * * TclOOAddToSubclasses -- * * Utility function to add a class to the list of subclasses within * another class. * * ---------------------------------------------------------------------- */ void TclOOAddToSubclasses( Class *subPtr, /* The subclass to add. */ Class *superPtr) /* The superclass to add the subclass to. It * is assumed that the class is not already * present as a subclass in the superclass. */ { if (Destructing(superPtr->thisPtr)) { return; } if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; if (superPtr->subclasses.size == ALLOC_CHUNK) { superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK); } else { superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list, sizeof(Class *) * superPtr->subclasses.size); } } superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr; AddRef(subPtr->thisPtr); } /* * ---------------------------------------------------------------------- * * TclOORemoveFromMixinSubs -- * * Utility function to remove a class from the list of mixinSubs within * another class. * * ---------------------------------------------------------------------- */ int TclOORemoveFromMixinSubs( Class *subPtr, /* The subclass to remove. */ Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { int i, res = 0; Class *subclsPtr; FOREACH(subclsPtr, superPtr->mixinSubs) { if (subPtr == subclsPtr) { RemoveItem(Class, superPtr->mixinSubs, i); TclOODecrRefCount(subPtr->thisPtr); res++; break; } } return res; } /* * ---------------------------------------------------------------------- * * TclOOAddToMixinSubs -- * * Utility function to add a class to the list of mixinSubs within * another class. * * ---------------------------------------------------------------------- */ void TclOOAddToMixinSubs( Class *subPtr, /* The subclass to add. */ Class *superPtr) /* The superclass to add the subclass to. It * is assumed that the class is not already * present as a subclass in the superclass. */ { if (Destructing(superPtr->thisPtr)) { return; } if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) { superPtr->mixinSubs.size += ALLOC_CHUNK; if (superPtr->mixinSubs.size == ALLOC_CHUNK) { superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK); } else { superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list, sizeof(Class *) * superPtr->mixinSubs.size); } } superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr; AddRef(subPtr->thisPtr); } /* * ---------------------------------------------------------------------- * * TclOOAllocClass -- * * Allocate a basic class. Does not add class to its class's instance * list. * * ---------------------------------------------------------------------- */ Class * TclOOAllocClass( Tcl_Interp *interp, /* Interpreter within which to allocate the * class. */ Object *useThisObj) /* Object that is to act as the class * representation. */ { Foundation *fPtr = GetFoundation(interp); Class *clsPtr = ckalloc(sizeof(Class)); memset(clsPtr, 0, sizeof(Class)); clsPtr->thisPtr = useThisObj; /* * Configure the namespace path for the class's object. */ initClassPath(interp, clsPtr); /* * Classes are subclasses of oo::object, i.e. the objects they create are * objects. */ clsPtr->superclasses.num = 1; clsPtr->superclasses.list = ckalloc(sizeof(Class *)); clsPtr->superclasses.list[0] = fPtr->objectCls; AddRef(fPtr->objectCls->thisPtr); /* * Finish connecting the class structure to the object structure. */ clsPtr->thisPtr->classPtr = clsPtr; /* * That's the complicated bit. Now fill in the rest of the non-zero/NULL * fields. */ Tcl_InitObjHashTable(&clsPtr->classMethods); return clsPtr; } static void initClassPath(Tcl_Interp *interp, Class *clsPtr) { Foundation *fPtr = GetFoundation(interp); if (fPtr->helpersNs != NULL) { Tcl_Namespace *path[2]; path[0] = fPtr->helpersNs; path[1] = fPtr->ooNs; TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path); } else { TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1, &fPtr->ooNs); } } /* * ---------------------------------------------------------------------- * * Tcl_NewObjectInstance -- * * Allocate a new instance of an object. * * ---------------------------------------------------------------------- */ Tcl_Object Tcl_NewObjectInstance( Tcl_Interp *interp, /* Interpreter context. */ Tcl_Class cls, /* Class to create an instance of. */ const char *nameStr, /* Name of object to create, or NULL to ask * the code to pick its own unique name. */ const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ int objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; Object *oPtr; ClientData clientData[4]; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) {return NULL;} /* * Run constructors, except when objc < 0, which is a special flag case * used for object cloning only. */ if (objc >= 0) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL); if (contextPtr != NULL) { int isRoot, result; Tcl_InterpState state; state = Tcl_SaveInterpState(interp, TCL_OK); contextPtr->callPtr->flags |= CONSTRUCTOR; contextPtr->skip = skip; /* * Adjust the ensemble tracking record if necessary. [Bug 3514761] */ isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv); result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc, objv); if (isRoot) { TclResetRewriteEnsemble(interp, 1); } clientData[0] = contextPtr; clientData[1] = oPtr; clientData[2] = state; clientData[3] = &oPtr; result = FinalizeAlloc(clientData, interp, result); if (result != TCL_OK) { return NULL; } } } return (Tcl_Object) oPtr; } int TclNRNewObjectInstance( Tcl_Interp *interp, /* Interpreter context. */ Tcl_Class cls, /* Class to create an instance of. */ const char *nameStr, /* Name of object to create, or NULL to ask * the code to pick its own unique name. */ const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ int objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { Class *classPtr = (Class *) cls; CallContext *contextPtr; Tcl_InterpState state; Object *oPtr; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) {return TCL_ERROR;} /* * Run constructors, except when objc < 0 (a special flag case used for * object cloning only). If there aren't any constructors, we do nothing. */ if (objc < 0) { *objectPtr = (Tcl_Object) oPtr; return TCL_OK; } contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL); if (contextPtr == NULL) { *objectPtr = (Tcl_Object) oPtr; return TCL_OK; } state = Tcl_SaveInterpState(interp, TCL_OK); contextPtr->callPtr->flags |= CONSTRUCTOR; contextPtr->skip = skip; /* * Adjust the ensemble tracking record if necessary. [Bug 3514761] */ if (TclInitRewriteEnsemble(interp, skip, skip, objv)) { TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } /* * Fire off the constructors non-recursively. */ TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, objectPtr); TclPushTailcallPoint(interp); return TclOOInvokeContext(contextPtr, interp, objc, objv); } Object * TclNewObjectInstanceCommon( Tcl_Interp *interp, Class *classPtr, const char *nameStr, const char *nsNameStr) { Tcl_HashEntry *hPtr; Foundation *fPtr = GetFoundation(interp); Object *oPtr; const char *simpleName = NULL; Namespace *nsPtr = NULL, *dummy, *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); if (nameStr) { TclGetNamespaceForQualName(interp, nameStr, inNsPtr, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName); /* * Disallow creation of an object over an existing command. */ hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName); if (hPtr) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create object \"%s\": command already exists with" " that name", nameStr)); Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); return NULL; } } /* * Create the object. */ oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr); oPtr->selfCls = classPtr; AddRef(classPtr->thisPtr); TclOOAddToInstances(oPtr, classPtr); /* * Check to see if we're really creating a class. If so, allocate the * class structure as well. */ if (TclOOIsReachable(fPtr->classCls, classPtr)) { /* * Is a class, so attach a class structure. Note that the * TclOOAllocClass function splices the structure into the object, so * we don't have to. Once that's done, we need to repatch the object * to have the right class since TclOOAllocClass interferes with that. */ TclOOAllocClass(interp, oPtr); TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); } else { oPtr->classPtr = NULL; } return oPtr; } static int FinalizeAlloc( ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; Object *oPtr = data[1]; Tcl_InterpState state = data[2]; Tcl_Object *objectPtr = data[3]; /* * Ensure an error if the object was deleted in the constructor. * Don't want to lose errors by accident. [Bug 2903011] */ if (result != TCL_ERROR && Destructing(oPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object deleted in constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); result = TCL_ERROR; } if (result != TCL_OK) { Tcl_DiscardInterpState(state); /* * Take care to not delete a deleted object; that would be bad. [Bug * 2903011] Also take care to make sure that we have the name of the * command before we delete it. [Bug 9dd1bd7a74] */ if (!Destructing(oPtr)) { (void) TclOOObjectName(interp, oPtr); Tcl_DeleteCommandFromToken(interp, oPtr->command); } /* * This decrements the refcount of oPtr. */ TclOODeleteContext(contextPtr); return TCL_ERROR; } Tcl_RestoreInterpState(interp, state); *objectPtr = (Tcl_Object) oPtr; /* * This decrements the refcount of oPtr. */ TclOODeleteContext(contextPtr); return TCL_OK; } /* * ---------------------------------------------------------------------- * * Tcl_CopyObjectInstance -- * * Creates a copy of an object. Does not copy the backing namespace, * since the correct way to do that (e.g., shallow/deep) depends on the * object/class's own policies. * * ---------------------------------------------------------------------- */ Tcl_Object Tcl_CopyObjectInstance( Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName) { Object *oPtr = (Object *) sourceObject, *o2Ptr; FOREACH_HASH_DECLS; Method *mPtr; Class *mixinPtr; CallContext *contextPtr; Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3]; int i, result; /* * Sanity check. */ if (IsRootClass(oPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not clone the class of classes", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL); return NULL; } /* * Build the instance. Note that this does not run any constructors. */ o2Ptr = (Object *) Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, -1, NULL, -1); if (o2Ptr == NULL) { return NULL; } /* * Copy the object-local methods to the new object. */ if (oPtr->methodsPtr) { FOREACH_HASH(keyPtr, mPtr, oPtr->methodsPtr) { if (CloneObjectMethod(interp, o2Ptr, mPtr, keyPtr) != TCL_OK) { Tcl_DeleteCommandFromToken(interp, o2Ptr->command); return NULL; } } } /* * Copy the object's mixin references to the new object. */ if (o2Ptr->mixins.num != 0) { FOREACH(mixinPtr, o2Ptr->mixins) { if (mixinPtr && mixinPtr != o2Ptr->selfCls) { TclOORemoveFromInstances(o2Ptr, mixinPtr); } TclOODecrRefCount(mixinPtr->thisPtr); } ckfree(o2Ptr->mixins.list); } DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *); FOREACH(mixinPtr, o2Ptr->mixins) { if (mixinPtr && mixinPtr != o2Ptr->selfCls) { TclOOAddToInstances(o2Ptr, mixinPtr); } /* * For the reference just created in DUPLICATE. */ AddRef(mixinPtr->thisPtr); } /* * Copy the object's filter list to the new object. */ DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *); FOREACH(filterObj, o2Ptr->filters) { Tcl_IncrRefCount(filterObj); } /* * Copy the object's variable resolution list to the new object. */ DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *); FOREACH(variableObj, o2Ptr->variables) { Tcl_IncrRefCount(variableObj); } /* * Copy the object's flags to the new object, clearing those that must be * kept object-local. The duplicate is never deleted at this point, nor is * it the root of the object system or in the midst of processing a filter * call. */ o2Ptr->flags = oPtr->flags & ~( OBJECT_DESTRUCTING | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); /* * Copy the object's metadata. */ if (oPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; ClientData value, duplicate; FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) { if (metadataTypePtr->cloneProc == NULL) { duplicate = value; } else { if (metadataTypePtr->cloneProc(interp, value, &duplicate) != TCL_OK) { Tcl_DeleteCommandFromToken(interp, o2Ptr->command); return NULL; } } if (duplicate != NULL) { Tcl_ObjectSetMetadata((Tcl_Object) o2Ptr, metadataTypePtr, duplicate); } } } /* * Copy the class, if present. Note that if there is a class present in * the source object, there must also be one in the copy. */ if (oPtr->classPtr != NULL) { Class *clsPtr = oPtr->classPtr; Class *cls2Ptr = o2Ptr->classPtr; Class *superPtr; /* * Copy the class flags across. */ cls2Ptr->flags = clsPtr->flags; /* * Ensure that the new class's superclass structure is the same as the * old class's. */ FOREACH(superPtr, cls2Ptr->superclasses) { TclOORemoveFromSubclasses(cls2Ptr, superPtr); TclOODecrRefCount(superPtr->thisPtr); } if (cls2Ptr->superclasses.num) { cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); } else { cls2Ptr->superclasses.list = ckalloc(sizeof(Class *) * clsPtr->superclasses.num); } memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); cls2Ptr->superclasses.num = clsPtr->superclasses.num; FOREACH(superPtr, cls2Ptr->superclasses) { TclOOAddToSubclasses(cls2Ptr, superPtr); /* * For the new item in cls2Ptr->superclasses that memcpy just * created. */ AddRef(superPtr->thisPtr); } /* * Duplicate the source class's filters. */ DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *); FOREACH(filterObj, cls2Ptr->filters) { Tcl_IncrRefCount(filterObj); } /* * Copy the source class's variable resolution list. */ DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *); FOREACH(variableObj, cls2Ptr->variables) { Tcl_IncrRefCount(variableObj); } /* * Duplicate the source class's mixins (which cannot be circular * references to the duplicate). */ if (cls2Ptr->mixins.num != 0) { FOREACH(mixinPtr, cls2Ptr->mixins) { TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } ckfree(clsPtr->mixins.list); } DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *); FOREACH(mixinPtr, cls2Ptr->mixins) { TclOOAddToMixinSubs(cls2Ptr, mixinPtr); /* * For the copy just created in DUPLICATE. */ AddRef(mixinPtr->thisPtr); } /* * Duplicate the source class's methods, constructor and destructor. */ FOREACH_HASH(keyPtr, mPtr, &clsPtr->classMethods) { if (CloneClassMethod(interp, cls2Ptr, mPtr, keyPtr, NULL) != TCL_OK) { Tcl_DeleteCommandFromToken(interp, o2Ptr->command); return NULL; } } if (clsPtr->constructorPtr) { if (CloneClassMethod(interp, cls2Ptr, clsPtr->constructorPtr, NULL, &cls2Ptr->constructorPtr) != TCL_OK) { Tcl_DeleteCommandFromToken(interp, o2Ptr->command); return NULL; } } if (clsPtr->destructorPtr) { if (CloneClassMethod(interp, cls2Ptr, clsPtr->destructorPtr, NULL, &cls2Ptr->destructorPtr) != TCL_OK) { Tcl_DeleteCommandFromToken(interp, o2Ptr->command); return NULL; } } /* * Duplicate the class's metadata. */ if (clsPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; ClientData value, duplicate; FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) { if (metadataTypePtr->cloneProc == NULL) { duplicate = value; } else { if (metadataTypePtr->cloneProc(interp, value, &duplicate) != TCL_OK) { Tcl_DeleteCommandFromToken(interp, o2Ptr->command); return NULL; } } if (duplicate != NULL) { Tcl_ClassSetMetadata((Tcl_Class) cls2Ptr, metadataTypePtr, duplicate); } } } } TclResetRewriteEnsemble(interp, 1); contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL); if (contextPtr) { args[0] = TclOOObjectName(interp, o2Ptr); args[1] = oPtr->fPtr->clonedName; args[2] = TclOOObjectName(interp, oPtr); Tcl_IncrRefCount(args[0]); Tcl_IncrRefCount(args[1]); Tcl_IncrRefCount(args[2]); result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 3, args); TclDecrRefCount(args[0]); TclDecrRefCount(args[1]); TclDecrRefCount(args[2]); TclOODeleteContext(contextPtr); if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (while performing post-copy callback)"); } if (result != TCL_OK) { Tcl_DeleteCommandFromToken(interp, o2Ptr->command); return NULL; } } return (Tcl_Object) o2Ptr; } /* * ---------------------------------------------------------------------- * * CloneObjectMethod, CloneClassMethod -- * * Helper functions used for cloning methods. They work identically to * each other, except for the difference between them in how they * register the cloned method on a successful clone. * * ---------------------------------------------------------------------- */ static int CloneObjectMethod( Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr) { if (mPtr->typePtr == NULL) { Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { ClientData newClientData; if (mPtr->typePtr->cloneProc(interp, mPtr->clientData, &newClientData) != TCL_OK) { return TCL_ERROR; } Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData); } else { Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData); } return TCL_OK; } static int CloneClassMethod( Tcl_Interp *interp, Class *clsPtr, Method *mPtr, Tcl_Obj *namePtr, Method **m2PtrPtr) { Method *m2Ptr; if (mPtr->typePtr == NULL) { m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { ClientData newClientData; if (mPtr->typePtr->cloneProc(interp, mPtr->clientData, &newClientData) != TCL_OK) { return TCL_ERROR; } m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData); } else { m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData); } if (m2PtrPtr != NULL) { *m2PtrPtr = m2Ptr; } return TCL_OK; } /* * ---------------------------------------------------------------------- * * Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_ObjectGetMetadata, * Tcl_ObjectSetMetadata -- * * Metadata management API. The metadata system allows code in extensions * to attach arbitrary non-NULL pointers to objects and classes without * the different things that might be interested being able to interfere * with each other. Apart from non-NULL-ness, these routines attach no * interpretation to the meaning of the metadata pointers. * * The Tcl_*GetMetadata routines get the metadata pointer attached that * has been related with a particular type, or NULL if no metadata * associated with the given type has been attached. * * The Tcl_*SetMetadata routines set or delete the metadata pointer that * is related to a particular type. The value associated with the type is * deleted (if present; no-op otherwise) if the value is NULL, and * attached (replacing the previous value, which is deleted if present) * otherwise. This means it is impossible to attach a NULL value for any * metadata type. * * ---------------------------------------------------------------------- */ ClientData Tcl_ClassGetMetadata( Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr) { Class *clsPtr = (Class *) clazz; Tcl_HashEntry *hPtr; /* * If there's no metadata store attached, the type in question has * definitely not been attached either! */ if (clsPtr->metadataPtr == NULL) { return NULL; } /* * There is a metadata store, so look in it for the given type. */ hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr); /* * Return the metadata value if we found it, otherwise NULL. */ if (hPtr == NULL) { return NULL; } return Tcl_GetHashValue(hPtr); } void Tcl_ClassSetMetadata( Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata) { Class *clsPtr = (Class *) clazz; Tcl_HashEntry *hPtr; int isNew; /* * Attach the metadata store if not done already. */ if (clsPtr->metadataPtr == NULL) { if (metadata == NULL) { return; } clsPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS); } /* * If the metadata is NULL, we're deleting the metadata for the type. */ if (metadata == NULL) { hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr); if (hPtr != NULL) { typePtr->deleteProc(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } return; } /* * Otherwise we're attaching the metadata. Note that if there was already * some metadata attached of this type, we delete that first. */ hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, (char *) typePtr, &isNew); if (!isNew) { typePtr->deleteProc(Tcl_GetHashValue(hPtr)); } Tcl_SetHashValue(hPtr, metadata); } ClientData Tcl_ObjectGetMetadata( Tcl_Object object, const Tcl_ObjectMetadataType *typePtr) { Object *oPtr = (Object *) object; Tcl_HashEntry *hPtr; /* * If there's no metadata store attached, the type in question has * definitely not been attached either! */ if (oPtr->metadataPtr == NULL) { return NULL; } /* * There is a metadata store, so look in it for the given type. */ hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr); /* * Return the metadata value if we found it, otherwise NULL. */ if (hPtr == NULL) { return NULL; } return Tcl_GetHashValue(hPtr); } void Tcl_ObjectSetMetadata( Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata) { Object *oPtr = (Object *) object; Tcl_HashEntry *hPtr; int isNew; /* * Attach the metadata store if not done already. */ if (oPtr->metadataPtr == NULL) { if (metadata == NULL) { return; } oPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS); } /* * If the metadata is NULL, we're deleting the metadata for the type. */ if (metadata == NULL) { hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr); if (hPtr != NULL) { typePtr->deleteProc(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } return; } /* * Otherwise we're attaching the metadata. Note that if there was already * some metadata attached of this type, we delete that first. */ hPtr = Tcl_CreateHashEntry(oPtr->metadataPtr, (char *) typePtr, &isNew); if (!isNew) { typePtr->deleteProc(Tcl_GetHashValue(hPtr)); } Tcl_SetHashValue(hPtr, metadata); } /* * ---------------------------------------------------------------------- * * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject -- * * Main entry point for object invocations. The Public* and Private* * wrapper functions (implementations of both object instance commands * and [my]) are just thin wrappers round the main TclOOObjectCmdCore * function. Note that the core is function is NRE-aware. * * ---------------------------------------------------------------------- */ static int PublicObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv); } static int PublicNRObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD, NULL); } static int PrivateObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv); } static int PrivateNRObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL); } int TclOOInvokeObject( Tcl_Interp *interp, /* Interpreter for commands, variables, * results, error reporting, etc. */ Tcl_Object object, /* The object to invoke. */ Tcl_Class startCls, /* Where in the class chain to start the * invoke from, or NULL to traverse the whole * chain including filters. */ int publicPrivate, /* Whether this is an invoke from a public * context (PUBLIC_METHOD), a private context * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed * that the name of the method to invoke will * be at index 1. */ { switch (publicPrivate) { case PUBLIC_METHOD: return TclOOObjectCmdCore((Object *) object, interp, objc, objv, PUBLIC_METHOD, (Class *) startCls); case PRIVATE_METHOD: return TclOOObjectCmdCore((Object *) object, interp, objc, objv, PRIVATE_METHOD, (Class *) startCls); default: return TclOOObjectCmdCore((Object *) object, interp, objc, objv, 0, (Class *) startCls); } } /* * ---------------------------------------------------------------------- * * TclOOObjectCmdCore, FinalizeObjectCall -- * * Main function for object invocations. Does call chain creation, * management and invocation. The function FinalizeObjectCall exists to * clean up after the non-recursive processing of TclOOObjectCmdCore. * * ---------------------------------------------------------------------- */ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ int objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ int flags, /* Whether this is an invocation through the * public or the private command interface. */ Class *startCls) /* Where to start in the call chain, or NULL * if we are to start at the front with * filters and the object's methods (which is * the normal case). */ { CallContext *contextPtr; Tcl_Obj *methodNamePtr; int result; /* * If we've no method name, throw this directly into the unknown * processing. */ if (objc < 2) { flags |= FORCE_UNKNOWN; methodNamePtr = NULL; goto noMapping; } /* * Give plugged in code a chance to remap the method name. */ methodNamePtr = objv[1]; if (oPtr->mapMethodNameProc != NULL) { Class **startClsPtr = &startCls; Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr); result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr, (Tcl_Class *) startClsPtr, mappedMethodName); if (result != TCL_OK) { TclDecrRefCount(mappedMethodName); if (result == TCL_BREAK) { goto noMapping; } else if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (while mapping method name)"); } return result; } /* * Get the call chain for the remapped name. */ Tcl_IncrRefCount(mappedMethodName); contextPtr = TclOOGetCallContext(oPtr, mappedMethodName, flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr); TclDecrRefCount(mappedMethodName); if (contextPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "impossible to invoke method \"%s\": no defined method or" " unknown method", TclGetString(methodNamePtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED", TclGetString(methodNamePtr), NULL); return TCL_ERROR; } } else { /* * Get the call chain. */ noMapping: contextPtr = TclOOGetCallContext(oPtr, methodNamePtr, flags | (oPtr->flags & FILTER_HANDLING), NULL); if (contextPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "impossible to invoke method \"%s\": no defined method or" " unknown method", TclGetString(methodNamePtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(methodNamePtr), NULL); return TCL_ERROR; } } /* * Check to see if we need to apply magical tricks to start part way * through the call chain. */ if (startCls != NULL) { for (; contextPtr->index < contextPtr->callPtr->numChain; contextPtr->index++) { struct MInvoke *miPtr = &contextPtr->callPtr->chain[contextPtr->index]; if (miPtr->isFilter) { continue; } if (miPtr->mPtr->declaringClassPtr == startCls) { break; } } if (contextPtr->index >= contextPtr->callPtr->numChain) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "no valid method implementation", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(methodNamePtr), NULL); TclOODeleteContext(contextPtr); return TCL_ERROR; } } /* * Invoke the call chain, locking the object structure against deletion * for the duration. */ TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL); return TclOOInvokeContext(contextPtr, interp, objc, objv); } static int FinalizeObjectCall( ClientData data[], Tcl_Interp *interp, int result) { /* * Dispose of the call chain, which drops the lock on the object's * structure. */ TclOODeleteContext(data[0]); return result; } /* * ---------------------------------------------------------------------- * * Tcl_ObjectContextInvokeNext, TclNRObjectContextInvokeNext, FinalizeNext -- * * Invokes the next stage of the call chain described in an object * context. This is the core of the implementation of the [next] command. * Does not do management of the call-frame stack. Available in public * (standard API) and private (NRE-aware) forms. FinalizeNext is a * private function used to clean up in the NRE case. * * ---------------------------------------------------------------------- */ int Tcl_ObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { CallContext *contextPtr = (CallContext *) context; int savedIndex = contextPtr->index; int savedSkip = contextPtr->skip; int result; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless the * interpreter is being torn down, in which case we might be getting * here because of methods/destructors doing a [next] (or equivalent) * unexpectedly. */ const char *methodType; if (Tcl_InterpDeleted(interp)) { return TCL_OK; } if (contextPtr->callPtr->flags & CONSTRUCTOR) { methodType = "constructor"; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { methodType = "destructor"; } else { methodType = "method"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no next %s implementation", methodType)); Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); return TCL_ERROR; } /* * Advance to the next method implementation in the chain in the method * call context while we process the body. However, need to adjust the * argument-skip control because we're guaranteed to have a single prefix * arg (i.e., 'next') and not the variable amount that can happen because * method invocations (i.e., '$obj meth' and 'my meth'), constructors * (i.e., '$cls new' and '$cls create obj') and destructors (no args at * all) come through the same code. */ contextPtr->index++; contextPtr->skip = skip; /* * Invoke the (advanced) method call context in the caller context. */ result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc, objv); /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ contextPtr->index = savedIndex; contextPtr->skip = savedSkip; return result; } int TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { CallContext *contextPtr = (CallContext *) context; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless the * interpreter is being torn down, in which case we might be getting * here because of methods/destructors doing a [next] (or equivalent) * unexpectedly. */ const char *methodType; if (Tcl_InterpDeleted(interp)) { return TCL_OK; } if (contextPtr->callPtr->flags & CONSTRUCTOR) { methodType = "constructor"; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { methodType = "destructor"; } else { methodType = "method"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no next %s implementation", methodType)); Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); return TCL_ERROR; } /* * Advance to the next method implementation in the chain in the method * call context while we process the body. However, need to adjust the * argument-skip control because we're guaranteed to have a single prefix * arg (i.e., 'next') and not the variable amount that can happen because * method invocations (i.e., '$obj meth' and 'my meth'), constructors * (i.e., '$cls new' and '$cls create obj') and destructors (no args at * all) come through the same code. */ TclNRAddCallback(interp, FinalizeNext, contextPtr, INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL); contextPtr->index++; contextPtr->skip = skip; /* * Invoke the (advanced) method call context in the caller context. */ return TclOOInvokeContext(contextPtr, interp, objc, objv); } static int FinalizeNext( ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ contextPtr->index = PTR2INT(data[1]); contextPtr->skip = PTR2INT(data[2]); return result; } /* * ---------------------------------------------------------------------- * * Tcl_GetObjectFromObj -- * * Utility function to get an object from a Tcl_Obj containing its name. * * ---------------------------------------------------------------------- */ Tcl_Object Tcl_GetObjectFromObj( Tcl_Interp *interp, /* Interpreter in which to locate the object. * Will have an error message placed in it if * the name does not refer to an object. */ Tcl_Obj *objPtr) /* The name of the object to look up, which is * exactly the name of its public command. */ { Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if (cmdPtr == NULL) { goto notAnObject; } if (cmdPtr->objProc != PublicObjectCmd) { cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) { goto notAnObject; } } return cmdPtr->objClientData; notAnObject: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s does not refer to an object", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr), NULL); return NULL; } /* * ---------------------------------------------------------------------- * * TclOOIsReachable -- * * Utility function that tests whether a class is a subclass (whether * directly or indirectly) of another class. * * ---------------------------------------------------------------------- */ int TclOOIsReachable( Class *targetPtr, Class *startPtr) { int i; Class *superPtr; tailRecurse: if (startPtr == targetPtr) { return 1; } if (startPtr->superclasses.num == 1 && startPtr->mixins.num == 0) { startPtr = startPtr->superclasses.list[0]; goto tailRecurse; } FOREACH(superPtr, startPtr->superclasses) { if (TclOOIsReachable(targetPtr, superPtr)) { return 1; } } FOREACH(superPtr, startPtr->mixins) { if (TclOOIsReachable(targetPtr, superPtr)) { return 1; } } return 0; } /* * ---------------------------------------------------------------------- * * TclOOObjectName, Tcl_GetObjectName -- * * Utility function that returns the name of the object. Note that this * simplifies cache management by keeping the code to do it in one place * and not sprayed all over. The value returned always has a reference * count of at least one. * * ---------------------------------------------------------------------- */ Tcl_Obj * TclOOObjectName( Tcl_Interp *interp, Object *oPtr) { Tcl_Obj *namePtr; if (oPtr->cachedNameObj) { return oPtr->cachedNameObj; } TclNewObj(namePtr); Tcl_GetCommandFullName(interp, oPtr->command, namePtr); Tcl_IncrRefCount(namePtr); oPtr->cachedNameObj = namePtr; return namePtr; } Tcl_Obj * Tcl_GetObjectName( Tcl_Interp *interp, Tcl_Object object) { return TclOOObjectName(interp, (Object *) object); } /* * ---------------------------------------------------------------------- * * assorted trivial 'getter' functions * * ---------------------------------------------------------------------- */ Tcl_Method Tcl_ObjectContextMethod( Tcl_ObjectContext context) { CallContext *contextPtr = (CallContext *) context; return (Tcl_Method) contextPtr->callPtr->chain[contextPtr->index].mPtr; } int Tcl_ObjectContextIsFiltering( Tcl_ObjectContext context) { CallContext *contextPtr = (CallContext *) context; return contextPtr->callPtr->chain[contextPtr->index].isFilter; } Tcl_Object Tcl_ObjectContextObject( Tcl_ObjectContext context) { return (Tcl_Object) ((CallContext *)context)->oPtr; } int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context) { return ((CallContext *)context)->skip; } Tcl_Namespace * Tcl_GetObjectNamespace( Tcl_Object object) { return ((Object *)object)->namespacePtr; } Tcl_Command Tcl_GetObjectCommand( Tcl_Object object) { return ((Object *)object)->command; } Tcl_Class Tcl_GetObjectAsClass( Tcl_Object object) { return (Tcl_Class) ((Object *)object)->classPtr; } int Tcl_ObjectDeleted( Tcl_Object object) { return ((Object *)object)->command == NULL; } Tcl_Object Tcl_GetClassAsObject( Tcl_Class clazz) { return (Tcl_Object) ((Class *)clazz)->thisPtr; } Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object) { return ((Object *) object)->mapMethodNameProc; } void Tcl_ObjectSetMethodNameMapper( Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc) { ((Object *) object)->mapMethodNameProc = mapMethodNameProc; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOOCall.c0000644000175000017500000013117614554262142015247 0ustar sergeisergei/* * tclOOCall.c -- * * This file contains the method call chain management code for the * object-system core. * * Copyright (c) 2005-2012 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" /* * Structure containing a CallContext and any other values needed only during * the construction of the CallContext. */ struct ChainBuilder { CallChain *callChainPtr; /* The call chain being built. */ int filterLength; /* Number of entries in the call chain that * are due to processing filters and not the * main call chain. */ Object *oPtr; /* The object that we are building the chain * for. */ }; /* * Extra flags used for call chain management. */ #define DEFINITE_PROTECTED 0x100000 #define DEFINITE_PUBLIC 0x200000 #define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC) #define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN) #define BUILDING_MIXINS 0x400000 #define TRAVERSED_MIXIN 0x800000 #define OBJECT_MIXIN 0x1000000 #define MIXIN_CONSISTENT(flags) \ (((flags) & OBJECT_MIXIN) || \ !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN)) /* * Function declarations for things defined in this file. */ static void AddClassFiltersToCallContext(Object *const oPtr, Class *clsPtr, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags); static void AddClassMethodNames(Class *clsPtr, int flags, Tcl_HashTable *const namesPtr, Tcl_HashTable *const examinedClassesPtr); static inline void AddMethodToCallChain(Method *const mPtr, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, Class *const filterDecl, int flags); static inline void AddSimpleChainToCallContext(Object *const oPtr, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, Class *const filterDecl); static void AddSimpleClassChainToCallContext(Class *classPtr, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, Class *const filterDecl); static int CmpStr(const void *ptr1, const void *ptr2); static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr); static Tcl_NRPostProc FinalizeMethodRefs; static void FreeMethodNameRep(Tcl_Obj *objPtr); static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); static Tcl_NRPostProc ResetFilterFlags; static Tcl_NRPostProc SetFilterFlags; static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr); /* * Object type used to manage type caches attached to method names. */ static const Tcl_ObjType methodNameType = { "TclOO method name", FreeMethodNameRep, DupMethodNameRep, NULL, NULL }; /* * ---------------------------------------------------------------------- * * TclOODeleteContext -- * * Destroys a method call-chain context, which should not be in use. * * ---------------------------------------------------------------------- */ void TclOODeleteContext( CallContext *contextPtr) { Object *oPtr = contextPtr->oPtr; TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { TclStackFree(oPtr->fPtr->interp, contextPtr); /* * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore */ TclOODecrRefCount(oPtr); } } /* * ---------------------------------------------------------------------- * * TclOODeleteChainCache -- * * Destroy the cache of method call-chains. * * ---------------------------------------------------------------------- */ void TclOODeleteChainCache( Tcl_HashTable *tablePtr) { FOREACH_HASH_DECLS; CallChain *callPtr; FOREACH_HASH_VALUE(callPtr, tablePtr) { if (callPtr) { TclOODeleteChain(callPtr); } } Tcl_DeleteHashTable(tablePtr); ckfree(tablePtr); } /* * ---------------------------------------------------------------------- * * TclOODeleteChain -- * * Destroys a method call-chain. * * ---------------------------------------------------------------------- */ void TclOODeleteChain( CallChain *callPtr) { if (callPtr == NULL || callPtr->refCount-- > 1) { return; } if (callPtr->chain != callPtr->staticChain) { ckfree(callPtr->chain); } ckfree(callPtr); } /* * ---------------------------------------------------------------------- * * TclOOStashContext -- * * Saves a reference to a method call context in a Tcl_Obj's internal * representation. * * ---------------------------------------------------------------------- */ static inline void StashCallChain( Tcl_Obj *objPtr, CallChain *callPtr) { callPtr->refCount++; TclGetString(objPtr); TclFreeIntRep(objPtr); objPtr->typePtr = &methodNameType; objPtr->internalRep.twoPtrValue.ptr1 = callPtr; } void TclOOStashContext( Tcl_Obj *objPtr, CallContext *contextPtr) { StashCallChain(objPtr, contextPtr->callPtr); } /* * ---------------------------------------------------------------------- * * DupMethodNameRep, FreeMethodNameRep -- * * Functions to implement the required parts of the Tcl_Obj guts needed * for caching of method contexts in Tcl_Objs. * * ---------------------------------------------------------------------- */ static void DupMethodNameRep( Tcl_Obj *srcPtr, Tcl_Obj *dstPtr) { CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1; dstPtr->typePtr = &methodNameType; dstPtr->internalRep.twoPtrValue.ptr1 = callPtr; callPtr->refCount++; } static void FreeMethodNameRep( Tcl_Obj *objPtr) { CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1; TclOODeleteChain(callPtr); objPtr->typePtr = NULL; } /* * ---------------------------------------------------------------------- * * TclOOInvokeContext -- * * Invokes a single step along a method call-chain context. Note that the * invocation of a step along the chain can cause further steps along the * chain to be invoked. Note that this function is written to be as light * in stack usage as possible. * * ---------------------------------------------------------------------- */ int TclOOInvokeContext( void *clientData, /* The method call context. */ Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method * implementation. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { CallContext *const contextPtr = (CallContext *)clientData; Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const int isFilter = contextPtr->callPtr->chain[contextPtr->index].isFilter; /* * If this is the first step along the chain, we preserve the method * entries in the chain so that they do not get deleted out from under our * feet. */ if (contextPtr->index == 0) { int i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { AddRef(contextPtr->callPtr->chain[i].mPtr); } /* * Ensure that the method name itself is part of the arguments when * we're doing unknown processing. */ if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) { contextPtr->skip--; } /* * Add a callback to ensure that method references are dropped once * this call is finished. */ TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL, NULL); } /* * Save whether we were in a filter and set up whether we are now. */ if (contextPtr->oPtr->flags & FILTER_HANDLING) { TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); } else { TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); } if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { contextPtr->oPtr->flags |= FILTER_HANDLING; } else { contextPtr->oPtr->flags &= ~FILTER_HANDLING; } /* * Run the method implementation. */ return mPtr->typePtr->callProc(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, objc, objv); } static int SetFilterFlags( void *data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = (CallContext *)data[0]; contextPtr->oPtr->flags |= FILTER_HANDLING; return result; } static int ResetFilterFlags( void *data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = (CallContext *)data[0]; contextPtr->oPtr->flags &= ~FILTER_HANDLING; return result; } static int FinalizeMethodRefs( void *data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = (CallContext *)data[0]; int i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); } return result; } /* * ---------------------------------------------------------------------- * * TclOOGetSortedMethodList, TclOOGetSortedClassMethodList -- * * Discovers the list of method names supported by an object or class. * * ---------------------------------------------------------------------- */ int TclOOGetSortedMethodList( Object *oPtr, /* The object to get the method names for. */ int flags, /* Whether we just want the public method * names. */ const char ***stringsPtr) /* Where to write a pointer to the array of * strings to. */ { Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list" * mapping. */ Tcl_HashTable examinedClasses; /* Used to track what classes have been looked * at. Is set-like in nature and keyed by * pointer to class. */ FOREACH_HASH_DECLS; int i; Class *mixinPtr; Tcl_Obj *namePtr; Method *mPtr; int isWantedIn; void *isWanted; Tcl_InitObjHashTable(&names); Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS); /* * Name the bits used in the names table values. */ #define IN_LIST 1 #define NO_IMPLEMENTATION 2 /* * Process method names due to the object. */ if (oPtr->methodsPtr) { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { int isNew; if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) { continue; } hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew); if (isNew) { isWantedIn = ((!(flags & PUBLIC_METHOD) || mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0); isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0); Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); } } } /* * Process method names due to private methods on the object's class. */ if (flags & PRIVATE_METHOD) { FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) { if (mPtr->flags & PRIVATE_METHOD) { int isNew; hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew); if (isNew) { isWantedIn = IN_LIST; if (mPtr->typePtr == NULL) { isWantedIn |= NO_IMPLEMENTATION; } Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); } else if (mPtr->typePtr != NULL) { isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr)); if (isWantedIn & NO_IMPLEMENTATION) { isWantedIn &= ~NO_IMPLEMENTATION; Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); } } } } } /* * Process (normal) method names from the class hierarchy and the mixin * hierarchy. */ AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses); FOREACH(mixinPtr, oPtr->mixins) { AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names, &examinedClasses); } Tcl_DeleteHashTable(&examinedClasses); /* * See how many (visible) method names there are. If none, we do not (and * should not) try to sort the list of them. */ i = 0; if (names.numEntries != 0) { const char **strings; /* * We need to build the list of methods to sort. We will be using * qsort() for this, because it is very unlikely that the list will be * heavily sorted when it is long enough to matter. */ strings = ckalloc(sizeof(char *) * names.numEntries); FOREACH_HASH(namePtr, isWanted, &names) { if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) { if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { continue; } strings[i++] = TclGetString(namePtr); } } /* * Note that 'i' may well be less than names.numEntries when we are * dealing with public method names. */ if (i > 0) { if (i > 1) { qsort((void *) strings, i, sizeof(char *), CmpStr); } *stringsPtr = strings; } else { ckfree(strings); } } Tcl_DeleteHashTable(&names); return i; } int TclOOGetSortedClassMethodList( Class *clsPtr, /* The class to get the method names for. */ int flags, /* Whether we just want the public method * names. */ const char ***stringsPtr) /* Where to write a pointer to the array of * strings to. */ { Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list" * mapping. */ Tcl_HashTable examinedClasses; /* Used to track what classes have been looked * at. Is set-like in nature and keyed by * pointer to class. */ FOREACH_HASH_DECLS; int i; Tcl_Obj *namePtr; void *isWanted; Tcl_InitObjHashTable(&names); Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS); /* * Process method names from the class hierarchy and the mixin hierarchy. */ AddClassMethodNames(clsPtr, flags, &names, &examinedClasses); Tcl_DeleteHashTable(&examinedClasses); /* * See how many (visible) method names there are. If none, we do not (and * should not) try to sort the list of them. */ i = 0; if (names.numEntries != 0) { const char **strings; /* * We need to build the list of methods to sort. We will be using * qsort() for this, because it is very unlikely that the list will be * heavily sorted when it is long enough to matter. */ strings = (const char **)ckalloc(sizeof(char *) * names.numEntries); FOREACH_HASH(namePtr, isWanted, &names) { if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) { if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { continue; } strings[i++] = TclGetString(namePtr); } } /* * Note that 'i' may well be less than names.numEntries when we are * dealing with public method names. */ if (i > 0) { if (i > 1) { qsort((void *) strings, i, sizeof(char *), CmpStr); } *stringsPtr = strings; } else { ckfree(strings); } } Tcl_DeleteHashTable(&names); return i; } /* * Comparator for GetSortedMethodList */ static int CmpStr( const void *ptr1, const void *ptr2) { const char **strPtr1 = (const char **) ptr1; const char **strPtr2 = (const char **) ptr2; return TclUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1); } /* * ---------------------------------------------------------------------- * * AddClassMethodNames -- * * Adds the method names defined by a class (or its superclasses) to the * collection being built. The collection is built in a hash table to * ensure that duplicates are excluded. Helper for GetSortedMethodList(). * * ---------------------------------------------------------------------- */ static void AddClassMethodNames( Class *clsPtr, /* Class to get method names from. */ int flags, /* Whether we are interested in just the * public method names. */ Tcl_HashTable *const namesPtr, /* Reference to the hash table to put the * information in. The hash table maps the * Tcl_Obj * method name to an integral value * describing whether the method is wanted. * This ensures that public/private override * semantics are handled correctly. */ Tcl_HashTable *const examinedClassesPtr) /* Hash table that tracks what classes have * already been looked at. The keys are the * pointers to the classes, and the values are * immaterial. */ { /* * If we've already started looking at this class, stop working on it now * to prevent repeated work. */ if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) { return; } /* * Scope all declarations so that the compiler can stand a good chance of * making the recursive step highly efficient. We also hand-implement the * tail-recursive case using a while loop; C compilers typically cannot do * tail-recursion optimization usefully. */ while (1) { FOREACH_HASH_DECLS; Tcl_Obj *namePtr; Method *mPtr; int isNew; (void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr, &isNew); if (!isNew) { break; } if (clsPtr->mixins.num != 0) { Class *mixinPtr; int i; FOREACH(mixinPtr, clsPtr->mixins) { if (mixinPtr != clsPtr) { AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr, examinedClassesPtr); } } } FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew); if (isNew) { int isWanted = (!(flags & PUBLIC_METHOD) || (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0; isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0); Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION) && mPtr->typePtr != NULL) { int isWanted = PTR2INT(Tcl_GetHashValue(hPtr)); isWanted &= ~NO_IMPLEMENTATION; Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); } } if (clsPtr->superclasses.num != 1) { break; } clsPtr = clsPtr->superclasses.list[0]; } if (clsPtr->superclasses.num != 0) { Class *superPtr; int i; FOREACH(superPtr, clsPtr->superclasses) { AddClassMethodNames(superPtr, flags, namesPtr, examinedClassesPtr); } } } /* * ---------------------------------------------------------------------- * * AddSimpleChainToCallContext -- * * The core of the call-chain construction engine, this handles calling a * particular method on a particular object. Note that filters and * unknown handling are already handled by the logic that uses this * function. * * ---------------------------------------------------------------------- */ static inline void AddSimpleChainToCallContext( Object *const oPtr, /* Object to add call chain entries for. */ Tcl_Obj *const methodNameObj, /* Name of method to add the call chain * entries for. */ struct ChainBuilder *const cbPtr, /* Where to add the call chain entries. */ Tcl_HashTable *const doneFilters, /* Where to record what call chain entries * have been processed. */ int flags, /* What sort of call chain are we building. */ Class *const filterDecl) /* The class that declared the filter. If * NULL, either the filter was declared by the * object or this isn't a filter. */ { int i; if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj); if (hPtr != NULL) { Method *mPtr = (Method *)Tcl_GetHashValue(hPtr); if (flags & PUBLIC_METHOD) { if (!(mPtr->flags & PUBLIC_METHOD)) { return; } else { flags |= DEFINITE_PUBLIC; } } else { flags |= DEFINITE_PROTECTED; } } } if (!(flags & SPECIAL)) { Tcl_HashEntry *hPtr; Class *mixinPtr; FOREACH(mixinPtr, oPtr->mixins) { AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl); } if (oPtr->methodsPtr) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj); if (hPtr != NULL) { AddMethodToCallChain((Method *)Tcl_GetHashValue(hPtr), cbPtr, doneFilters, filterDecl, flags); } } } AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } /* * ---------------------------------------------------------------------- * * AddMethodToCallChain -- * * Utility method that manages the adding of a particular method * implementation to a call-chain. * * ---------------------------------------------------------------------- */ static inline void AddMethodToCallChain( Method *const mPtr, /* Actual method implementation to add to call * chain (or NULL, a no-op). */ struct ChainBuilder *const cbPtr, /* The call chain to add the method * implementation to. */ Tcl_HashTable *const doneFilters, /* Where to record what filters have been * processed. If NULL, not processing filters. * Note that this function does not update * this hashtable. */ Class *const filterDecl, /* The class that declared the filter. If * NULL, either the filter was declared by the * object or this isn't a filter. */ int flags) /* Used to check if we're mixin-consistent * only. Mixin-consistent means that either * we're looking to add things from a mixin * and we have passed a mixin, or we're not * looking to add things from a mixin and have * not passed a mixin. */ { CallChain *callPtr = cbPtr->callChainPtr; int i; /* * Return if this is just an entry used to record whether this is a public * method. If so, there's nothing real to call and so nothing to add to * the call chain. * * This is also where we enforce mixin-consistency. */ if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) { return; } /* * Enforce real private method handling here. We will skip adding this * method IF * 1) we are not allowing private methods, AND * 2) this is a private method, AND * 3) this is a class method, AND * 4) this method was not declared by the class of the current object. * * This does mean that only classes really handle private methods. This * should be sufficient for [incr Tcl] support though. */ if (!(callPtr->flags & PRIVATE_METHOD) && (mPtr->flags & PRIVATE_METHOD) && (mPtr->declaringClassPtr != NULL) && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) { return; } /* * First test whether the method is already in the call chain. Skip over * any leading filters. */ for (i = cbPtr->filterLength ; i < callPtr->numChain ; i++) { if (callPtr->chain[i].mPtr == mPtr && callPtr->chain[i].isFilter == (doneFilters != NULL)) { /* * Call chain semantics states that methods come as *late* in the * call chain as possible. This is done by copying down the * following methods. Note that this does not change the number of * method invocations in the call chain; it just rearranges them. */ Class *declCls = callPtr->chain[i].filterDeclarer; for (; i + 1 < callPtr->numChain ; i++) { callPtr->chain[i] = callPtr->chain[i + 1]; } callPtr->chain[i].mPtr = mPtr; callPtr->chain[i].isFilter = (doneFilters != NULL); callPtr->chain[i].filterDeclarer = declCls; return; } } /* * Need to really add the method. This is made a bit more complex by the * fact that we are using some "static" space initially, and only start * realloc-ing if the chain gets long. */ if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) { callPtr->chain = (struct MInvoke *)ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); memcpy(callPtr->chain, callPtr->staticChain, sizeof(struct MInvoke) * callPtr->numChain); } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) { callPtr->chain = (struct MInvoke *)ckrealloc(callPtr->chain, sizeof(struct MInvoke) * (callPtr->numChain + 1)); } callPtr->chain[i].mPtr = mPtr; callPtr->chain[i].isFilter = (doneFilters != NULL); callPtr->chain[i].filterDeclarer = filterDecl; callPtr->numChain++; } /* * ---------------------------------------------------------------------- * * InitCallChain -- * Encoding of the policy of how to set up a call chain. Doesn't populate * the chain with the method implementation data. * * ---------------------------------------------------------------------- */ static inline void InitCallChain( CallChain *callPtr, Object *oPtr, int flags) { callPtr->flags = flags & (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING); if (oPtr->flags & USE_CLASS_CACHE) { oPtr = oPtr->selfCls->thisPtr; callPtr->flags |= USE_CLASS_CACHE; } callPtr->epoch = oPtr->fPtr->epoch; callPtr->objectCreationEpoch = oPtr->creationEpoch; callPtr->objectEpoch = oPtr->epoch; callPtr->refCount = 1; callPtr->numChain = 0; callPtr->chain = callPtr->staticChain; } /* * ---------------------------------------------------------------------- * * IsStillValid -- * * Calculates whether the given call chain can be used for executing a * method for the given object. The condition on a chain from a cached * location being reusable is: * - Refers to the same object (same creation epoch), and * - Still across the same class structure (same global epoch), and * - Still across the same object structure (same local epoch), and * - No public/private/filter magic leakage (same flags, modulo the fact * that a public chain will satisfy a non-public call). * * ---------------------------------------------------------------------- */ static inline int IsStillValid( CallChain *callPtr, Object *oPtr, int flags, int mask) { if ((oPtr->flags & USE_CLASS_CACHE)) { oPtr = oPtr->selfCls->thisPtr; flags |= USE_CLASS_CACHE; } return ((callPtr->objectCreationEpoch == oPtr->creationEpoch) && (callPtr->epoch == oPtr->fPtr->epoch) && (callPtr->objectEpoch == oPtr->epoch) && ((callPtr->flags & mask) == (flags & mask))); } /* * ---------------------------------------------------------------------- * * TclOOGetCallContext -- * * Responsible for constructing the call context, an ordered list of all * method implementations to be called as part of a method invocation. * This method is central to the whole operation of the OO system. * * ---------------------------------------------------------------------- */ CallContext * TclOOGetCallContext( Object *oPtr, /* The object to get the context for. */ Tcl_Obj *methodNameObj, /* The name of the method to get the context * for. NULL when getting a constructor or * destructor chain. */ int flags, /* What sort of context are we looking for. * Only the bits PUBLIC_METHOD, CONSTRUCTOR, * PRIVATE_METHOD, DESTRUCTOR and * FILTER_HANDLING are useful. */ Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is * to be in the same object as the * methodNameObj. */ { CallContext *contextPtr; CallChain *callPtr; struct ChainBuilder cb; int i, count; int doFilters; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; if (cacheInThisObj == NULL) { cacheInThisObj = methodNameObj; } if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) { hPtr = NULL; doFilters = 0; /* * Check if we have a cached valid constructor or destructor. */ if (flags & CONSTRUCTOR) { callPtr = oPtr->selfCls->constructorChainPtr; if ((callPtr != NULL) && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch) && (callPtr->epoch == oPtr->fPtr->epoch)) { callPtr->refCount++; goto returnContext; } } else if (flags & DESTRUCTOR) { callPtr = oPtr->selfCls->destructorChainPtr; if ((oPtr->mixins.num == 0) && (callPtr != NULL) && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch) && (callPtr->epoch == oPtr->fPtr->epoch)) { callPtr->refCount++; goto returnContext; } } } else { /* * Check if we can get the chain out of the Tcl_Obj method name or out * of the cache. This is made a bit more complex by the fact that * there are multiple different layers of cache (in the Tcl_Obj, in * the object, and in the class). */ const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD); if (cacheInThisObj->typePtr == &methodNameType) { callPtr = (CallChain *)cacheInThisObj->internalRep.twoPtrValue.ptr1; if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } FreeMethodNameRep(cacheInThisObj); } if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache != NULL) { hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache, (char *) methodNameObj); } else { hPtr = NULL; } } else { if (oPtr->chainCache != NULL) { hPtr = Tcl_FindHashEntry(oPtr->chainCache, (char *) methodNameObj); } else { hPtr = NULL; } } if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { callPtr = (CallChain *)Tcl_GetHashValue(hPtr); if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } Tcl_SetHashValue(hPtr, NULL); TclOODeleteChain(callPtr); } doFilters = 1; } callPtr = (CallChain *)ckalloc(sizeof(CallChain)); InitCallChain(callPtr, oPtr, flags); cb.callChainPtr = callPtr; cb.filterLength = 0; cb.oPtr = oPtr; /* * If we're working with a forced use of unknown, do that now. */ if (flags & FORCE_UNKNOWN) { AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; if (callPtr->numChain == 0) { TclOODeleteChain(callPtr); return NULL; } goto returnContext; } /* * Add all defined filters (if any, and if we're going to be processing * them; they're not processed for constructors, destructors or when we're * in the middle of processing a filter). */ if (doFilters) { Tcl_Obj *filterObj; Class *mixinPtr; doFilters = 1; Tcl_InitObjHashTable(&doneFilters); FOREACH(mixinPtr, oPtr->mixins) { AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters, TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN); AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters, OBJECT_MIXIN); } FOREACH(filterObj, oPtr->filters) { AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0, NULL); } AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters, BUILDING_MIXINS); AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters, 0); Tcl_DeleteHashTable(&doneFilters); } count = cb.filterLength = callPtr->numChain; /* * Add the actual method implementations. We have to do this twice to * handle class mixins right. */ AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL); /* * Check to see if the method has no implementation. If so, we probably * need to add in a call to the unknown method. Otherwise, set up the * cacheing of the method implementation (if relevant). */ if (count == callPtr->numChain) { /* * Method does not actually exist. If we're dealing with constructors * or destructors, this isn't a problem. */ if (flags & SPECIAL) { TclOODeleteChain(callPtr); return NULL; } AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else if (doFilters) { if (hPtr == NULL) { if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache == NULL) { oPtr->selfCls->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->selfCls->classChainCache); } hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache, (char *) methodNameObj, &i); } else { if (oPtr->chainCache == NULL) { oPtr->chainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->chainCache); } hPtr = Tcl_CreateHashEntry(oPtr->chainCache, (char *) methodNameObj, &i); } } callPtr->refCount++; Tcl_SetHashValue(hPtr, callPtr); StashCallChain(cacheInThisObj, callPtr); } else if (flags & CONSTRUCTOR) { if (oPtr->selfCls->constructorChainPtr) { TclOODeleteChain(oPtr->selfCls->constructorChainPtr); } oPtr->selfCls->constructorChainPtr = callPtr; callPtr->refCount++; } else if ((flags & DESTRUCTOR) && oPtr->mixins.num == 0) { if (oPtr->selfCls->destructorChainPtr) { TclOODeleteChain(oPtr->selfCls->destructorChainPtr); } oPtr->selfCls->destructorChainPtr = callPtr; callPtr->refCount++; } returnContext: contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); contextPtr->oPtr = oPtr; /* * Corresponding TclOODecrRefCount() in TclOODeleteContext */ AddRef(oPtr); contextPtr->callPtr = callPtr; contextPtr->skip = 2; contextPtr->index = 0; return contextPtr; } /* * ---------------------------------------------------------------------- * * TclOOGetStereotypeCallChain -- * * Construct a call-chain for a method that would be used by a * stereotypical instance of the given class (i.e., where the object has * no definitions special to itself). * * ---------------------------------------------------------------------- */ CallChain * TclOOGetStereotypeCallChain( Class *clsPtr, /* The object to get the context for. */ Tcl_Obj *methodNameObj, /* The name of the method to get the context * for. NULL when getting a constructor or * destructor chain. */ int flags) /* What sort of context are we looking for. * Only the bits PUBLIC_METHOD, CONSTRUCTOR, * PRIVATE_METHOD, DESTRUCTOR and * FILTER_HANDLING are useful. */ { CallChain *callPtr; struct ChainBuilder cb; int i, count; Foundation *fPtr = clsPtr->thisPtr->fPtr; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; Object obj; /* * Synthesize a temporary stereotypical object so that we can use existing * machinery to produce the stereotypical call chain. */ memset(&obj, 0, sizeof(Object)); obj.fPtr = fPtr; obj.selfCls = clsPtr; obj.refCount = 1; obj.flags = USE_CLASS_CACHE; /* * Check if we can get the chain out of the Tcl_Obj method name or out of * the cache. This is made a bit more complex by the fact that there are * multiple different layers of cache (in the Tcl_Obj, in the object, and * in the class). */ if (clsPtr->classChainCache != NULL) { hPtr = Tcl_FindHashEntry(clsPtr->classChainCache, (char *) methodNameObj); if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD); callPtr = (CallChain *)Tcl_GetHashValue(hPtr); if (IsStillValid(callPtr, &obj, flags, reuseMask)) { callPtr->refCount++; return callPtr; } Tcl_SetHashValue(hPtr, NULL); TclOODeleteChain(callPtr); } } else { hPtr = NULL; } callPtr = (CallChain *)ckalloc(sizeof(CallChain)); memset(callPtr, 0, sizeof(CallChain)); callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING); callPtr->epoch = fPtr->epoch; callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount; callPtr->objectEpoch = clsPtr->thisPtr->epoch; callPtr->refCount = 1; callPtr->chain = callPtr->staticChain; cb.callChainPtr = callPtr; cb.filterLength = 0; cb.oPtr = &obj; /* * Add all defined filters (if any, and if we're going to be processing * them; they're not processed for constructors, destructors or when we're * in the middle of processing a filter). */ Tcl_InitObjHashTable(&doneFilters); AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, BUILDING_MIXINS); AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0); Tcl_DeleteHashTable(&doneFilters); count = cb.filterLength = callPtr->numChain; /* * Add the actual method implementations. */ AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL); /* * Check to see if the method has no implementation. If so, we probably * need to add in a call to the unknown method. Otherwise, set up the * caching of the method implementation (if relevant). */ if (count == callPtr->numChain) { AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else { if (hPtr == NULL) { if (clsPtr->classChainCache == NULL) { clsPtr->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(clsPtr->classChainCache); } hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache, (char *) methodNameObj, &i); } callPtr->refCount++; Tcl_SetHashValue(hPtr, callPtr); StashCallChain(methodNameObj, callPtr); } return callPtr; } /* * ---------------------------------------------------------------------- * * AddClassFiltersToCallContext -- * * Logic to make extracting all the filters from the class context much * easier. * * ---------------------------------------------------------------------- */ static void AddClassFiltersToCallContext( Object *const oPtr, /* Object that the filters operate on. */ Class *clsPtr, /* Class to get the filters from. */ struct ChainBuilder *const cbPtr, /* Context to fill with call chain entries. */ Tcl_HashTable *const doneFilters, /* Where to record what filters have been * processed. Keys are objects, values are * ignored. */ int flags) /* Whether we've gone along a mixin link * yet. */ { int i; int clearedFlags = flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS); Class *superPtr, *mixinPtr; Tcl_Obj *filterObj; tailRecurse: if (clsPtr == NULL) { return; } /* * Add all the filters defined by classes mixed into the main class * hierarchy. */ FOREACH(mixinPtr, clsPtr->mixins) { AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters, flags|TRAVERSED_MIXIN); } /* * Add all the class filters from the current class. Note that the filters * are added starting at the object root, as this allows the object to * override how filters work to extend their behaviour. */ if (MIXIN_CONSISTENT(flags)) { FOREACH(filterObj, clsPtr->filters) { int isNew; (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew); if (isNew) { AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr); AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters, clearedFlags, clsPtr); } } } /* * Now process the recursive case. Notice the tail-call optimization. */ switch (clsPtr->superclasses.num) { case 1: clsPtr = clsPtr->superclasses.list[0]; goto tailRecurse; default: FOREACH(superPtr, clsPtr->superclasses) { AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters, flags); } case 0: return; } } /* * ---------------------------------------------------------------------- * * AddSimpleClassChainToCallContext -- * * Construct a call-chain from a class hierarchy. * * ---------------------------------------------------------------------- */ static void AddSimpleClassChainToCallContext( Class *classPtr, /* Class to add the call chain entries for. */ Tcl_Obj *const methodNameObj, /* Name of method to add the call chain * entries for. */ struct ChainBuilder *const cbPtr, /* Where to add the call chain entries. */ Tcl_HashTable *const doneFilters, /* Where to record what call chain entries * have been processed. */ int flags, /* What sort of call chain are we building. */ Class *const filterDecl) /* The class that declared the filter. If * NULL, either the filter was declared by the * object or this isn't a filter. */ { int i; Class *superPtr; /* * We hard-code the tail-recursive form. It's by far the most common case * *and* it is much more gentle on the stack. * * Note that mixins must be processed before the main class hierarchy. * [Bug 1998221] */ tailRecurse: FOREACH(superPtr, classPtr->mixins) { AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl); } if (flags & CONSTRUCTOR) { AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters, filterDecl, flags); } else if (flags & DESTRUCTOR) { AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters, filterDecl, flags); } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj); if (hPtr != NULL) { Method *mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!(flags & KNOWN_STATE)) { if (flags & PUBLIC_METHOD) { if (mPtr->flags & PUBLIC_METHOD) { flags |= DEFINITE_PUBLIC; } else { return; } } else { flags |= DEFINITE_PROTECTED; } } AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); } } switch (classPtr->superclasses.num) { case 1: classPtr = classPtr->superclasses.list[0]; goto tailRecurse; default: FOREACH(superPtr, classPtr->superclasses) { AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } /* FALLTHRU */ case 0: return; } } /* * ---------------------------------------------------------------------- * * TclOORenderCallChain -- * * Create a description of a call chain. Used in [info object call], * [info class call], and [self call]. * * ---------------------------------------------------------------------- */ Tcl_Obj * TclOORenderCallChain( Tcl_Interp *interp, CallChain *callPtr) { Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral; Tcl_Obj *resultObj, *descObjs[4], **objv; Foundation *fPtr = TclOOGetFoundation(interp); int i; /* * Allocate the literals (potentially) used in our description. */ filterLiteral = Tcl_NewStringObj("filter", -1); Tcl_IncrRefCount(filterLiteral); methodLiteral = Tcl_NewStringObj("method", -1); Tcl_IncrRefCount(methodLiteral); objectLiteral = Tcl_NewStringObj("object", -1); Tcl_IncrRefCount(objectLiteral); /* * Do the actual construction of the descriptions. They consist of a list * of triples that describe the details of how a method is understood. For * each triple, the first word is the type of invocation ("method" is * normal, "unknown" is special because it adds the method name as an * extra argument when handled by some method types, and "filter" is * special because it's a filter method). The second word is the name of * the method in question (which differs for "unknown" and "filter" types) * and the third word is the full name of the class that declares the * method (or "object" if it is declared on the instance). */ objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); for (i = 0 ; i < callPtr->numChain ; i++) { struct MInvoke *miPtr = &callPtr->chain[i]; descObjs[0] = miPtr->isFilter ? filterLiteral : callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj : methodLiteral; descObjs[1] = callPtr->flags & CONSTRUCTOR ? fPtr->constructorName : callPtr->flags & DESTRUCTOR ? fPtr->destructorName : miPtr->mPtr->namePtr; descObjs[2] = miPtr->mPtr->declaringClassPtr ? Tcl_GetObjectName(interp, (Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr) : objectLiteral; descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1); objv[i] = Tcl_NewListObj(4, descObjs); } /* * Drop the local references to the literals; if they're actually used, * they'll live on the description itself. */ Tcl_DecrRefCount(filterLiteral); Tcl_DecrRefCount(methodLiteral); Tcl_DecrRefCount(objectLiteral); /* * Finish building the description and return it. */ resultObj = Tcl_NewListObj(callPtr->numChain, objv); TclStackFree(interp, objv); return resultObj; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOODecls.h0000644000175000017500000002271514566153373015441 0ustar sergeisergei/* * This file is (mostly) automatically generated from tclOO.decls. */ #ifndef _TCLOODECLS #define _TCLOODECLS #ifndef TCLAPI # ifdef BUILD_tcl # define TCLAPI extern DLLEXPORT # else # define TCLAPI extern DLLIMPORT # endif #endif #ifdef USE_TCL_STUBS # undef USE_TCLOO_STUBS # define USE_TCLOO_STUBS #endif /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ /* 0 */ TCLAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 1 */ TCLAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); /* 2 */ TCLAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); /* 3 */ TCLAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); /* 4 */ TCLAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 5 */ TCLAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); /* 6 */ TCLAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); /* 7 */ TCLAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); /* 8 */ TCLAPI int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ TCLAPI int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 10 */ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, void *clientData); /* 13 */ TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 14 */ TCLAPI int Tcl_ObjectDeleted(Tcl_Object object); /* 15 */ TCLAPI int Tcl_ObjectContextIsFiltering( Tcl_ObjectContext context); /* 16 */ TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); /* 17 */ TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); /* 18 */ TCLAPI int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ TCLAPI void * Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 21 */ TCLAPI void * Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 23 */ TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 24 */ TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object); /* 25 */ TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 26 */ TCLAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 28 */ TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object); /* Slot 29 is reserved */ /* Slot 30 is reserved */ /* Slot 31 is reserved */ /* Slot 32 is reserved */ /* Slot 33 is reserved */ /* 34 */ TCLAPI void TclOOUnusedStubEntry(void); typedef struct { const struct TclOOIntStubs *tclOOIntStubs; } TclOOStubHooks; typedef struct TclOOStubs { int magic; const TclOOStubHooks *hooks; Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 0 */ Tcl_Object (*tcl_GetClassAsObject) (Tcl_Class clazz); /* 1 */ Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */ Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */ Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */ Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */ Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */ Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */ int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */ int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */ Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, void *clientData); /* 11 */ Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */ int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */ int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */ Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */ Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */ int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */ void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */ int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */ void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */ void (*reserved29)(void); void (*reserved30)(void); void (*reserved31)(void); void (*reserved32)(void); void (*reserved33)(void); void (*tclOOUnusedStubEntry) (void); /* 34 */ } TclOOStubs; extern const TclOOStubs *tclOOStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCLOO_STUBS) /* * Inline function declarations: */ #define Tcl_CopyObjectInstance \ (tclOOStubsPtr->tcl_CopyObjectInstance) /* 0 */ #define Tcl_GetClassAsObject \ (tclOOStubsPtr->tcl_GetClassAsObject) /* 1 */ #define Tcl_GetObjectAsClass \ (tclOOStubsPtr->tcl_GetObjectAsClass) /* 2 */ #define Tcl_GetObjectCommand \ (tclOOStubsPtr->tcl_GetObjectCommand) /* 3 */ #define Tcl_GetObjectFromObj \ (tclOOStubsPtr->tcl_GetObjectFromObj) /* 4 */ #define Tcl_GetObjectNamespace \ (tclOOStubsPtr->tcl_GetObjectNamespace) /* 5 */ #define Tcl_MethodDeclarerClass \ (tclOOStubsPtr->tcl_MethodDeclarerClass) /* 6 */ #define Tcl_MethodDeclarerObject \ (tclOOStubsPtr->tcl_MethodDeclarerObject) /* 7 */ #define Tcl_MethodIsPublic \ (tclOOStubsPtr->tcl_MethodIsPublic) /* 8 */ #define Tcl_MethodIsType \ (tclOOStubsPtr->tcl_MethodIsType) /* 9 */ #define Tcl_MethodName \ (tclOOStubsPtr->tcl_MethodName) /* 10 */ #define Tcl_NewInstanceMethod \ (tclOOStubsPtr->tcl_NewInstanceMethod) /* 11 */ #define Tcl_NewMethod \ (tclOOStubsPtr->tcl_NewMethod) /* 12 */ #define Tcl_NewObjectInstance \ (tclOOStubsPtr->tcl_NewObjectInstance) /* 13 */ #define Tcl_ObjectDeleted \ (tclOOStubsPtr->tcl_ObjectDeleted) /* 14 */ #define Tcl_ObjectContextIsFiltering \ (tclOOStubsPtr->tcl_ObjectContextIsFiltering) /* 15 */ #define Tcl_ObjectContextMethod \ (tclOOStubsPtr->tcl_ObjectContextMethod) /* 16 */ #define Tcl_ObjectContextObject \ (tclOOStubsPtr->tcl_ObjectContextObject) /* 17 */ #define Tcl_ObjectContextSkippedArgs \ (tclOOStubsPtr->tcl_ObjectContextSkippedArgs) /* 18 */ #define Tcl_ClassGetMetadata \ (tclOOStubsPtr->tcl_ClassGetMetadata) /* 19 */ #define Tcl_ClassSetMetadata \ (tclOOStubsPtr->tcl_ClassSetMetadata) /* 20 */ #define Tcl_ObjectGetMetadata \ (tclOOStubsPtr->tcl_ObjectGetMetadata) /* 21 */ #define Tcl_ObjectSetMetadata \ (tclOOStubsPtr->tcl_ObjectSetMetadata) /* 22 */ #define Tcl_ObjectContextInvokeNext \ (tclOOStubsPtr->tcl_ObjectContextInvokeNext) /* 23 */ #define Tcl_ObjectGetMethodNameMapper \ (tclOOStubsPtr->tcl_ObjectGetMethodNameMapper) /* 24 */ #define Tcl_ObjectSetMethodNameMapper \ (tclOOStubsPtr->tcl_ObjectSetMethodNameMapper) /* 25 */ #define Tcl_ClassSetConstructor \ (tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */ #define Tcl_ClassSetDestructor \ (tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */ #define Tcl_GetObjectName \ (tclOOStubsPtr->tcl_GetObjectName) /* 28 */ /* Slot 29 is reserved */ /* Slot 30 is reserved */ /* Slot 31 is reserved */ /* Slot 32 is reserved */ /* Slot 33 is reserved */ #define TclOOUnusedStubEntry \ (tclOOStubsPtr->tclOOUnusedStubEntry) /* 34 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #undef TclOOUnusedStubEntry #endif /* _TCLOODECLS */ tcl8.6.14/generic/tclOODefineCmds.c0000644000175000017500000021032714554262142016371 0ustar sergeisergei/* * tclOODefineCmds.c -- * * This file contains the implementation of the ::oo::define command, * part of the object-system core (NB: not Tcl_Obj, but ::oo). * * Copyright (c) 2006-2013 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" /* * The maximum length of fully-qualified object name to use in an errorinfo * message. Longer than this will be curtailed. */ #define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30 /* * Some things that make it easier to declare a slot. */ struct DeclaredSlot { const char *name; const Tcl_MethodType getterType; const Tcl_MethodType setterType; }; #define SLOT(name,getter,setter) \ {"::oo::" name, \ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \ getter, NULL, NULL}, \ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \ setter, NULL, NULL}} /* * A [string match] pattern used to determine if a method should be exported. */ #define PUBLIC_PATTERN "[a-z]*" /* * Forward declarations. */ static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr); static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr); static inline void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr, Tcl_Obj *savedNameObj, const char *typeOfSubject); static inline int MagicDefinitionInvoke(Tcl_Interp *interp, Tcl_Namespace *nsPtr, int cmdIndex, int objc, Tcl_Obj *const *objv); static inline Class * GetClassInOuterContext(Tcl_Interp *interp, Tcl_Obj *className, const char *errMsg); static inline int InitDefineContext(Tcl_Interp *interp, Tcl_Namespace *namespacePtr, Object *oPtr, int objc, Tcl_Obj *const objv[]); static inline void RecomputeClassCacheFlag(Object *oPtr); static int RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr, int useClass, Tcl_Obj *const fromPtr, Tcl_Obj *const toPtr); static int ClassFilterGet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ClassFilterSet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ClassMixinGet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ClassMixinSet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ClassSuperGet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ClassSuperSet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ClassVarsGet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ClassVarsSet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ObjFilterGet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ObjFilterSet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ObjMixinGet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ObjMixinSet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ObjVarsGet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ObjVarsSet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); /* * Now define the slots used in declarations. */ static const struct DeclaredSlot slots[] = { SLOT("define::filter", ClassFilterGet, ClassFilterSet), SLOT("define::mixin", ClassMixinGet, ClassMixinSet), SLOT("define::superclass", ClassSuperGet, ClassSuperSet), SLOT("define::variable", ClassVarsGet, ClassVarsSet), SLOT("objdefine::filter", ObjFilterGet, ObjFilterSet), SLOT("objdefine::mixin", ObjMixinGet, ObjMixinSet), SLOT("objdefine::variable", ObjVarsGet, ObjVarsSet), {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}} }; /* * ---------------------------------------------------------------------- * * BumpGlobalEpoch -- * Utility that ensures that call chains that are invalid will get thrown * away at an appropriate time. Note that exactly which epoch gets * advanced will depend on exactly what the class is tangled up in; in * the worst case, the simplest option is to advance the global epoch, * causing *everything* to be thrown away on next usage. * * ---------------------------------------------------------------------- */ static inline void BumpGlobalEpoch( Tcl_Interp *interp, Class *classPtr) { if (classPtr != NULL && classPtr->subclasses.num == 0 && classPtr->instances.num == 0 && classPtr->mixinSubs.num == 0) { /* * If a class has no subclasses or instances, and is not mixed into * anything, a change to its structure does not require us to * invalidate any call chains. Note that we still bump our object's * epoch if it has any mixins; the relation between a class and its * representative object is special. But it won't hurt. */ if (classPtr->thisPtr->mixins.num > 0) { classPtr->thisPtr->epoch++; } return; } /* * Either there's no class (?!) or we're reconfiguring something that is * in use. Force regeneration of call chains. */ TclOOGetFoundation(interp)->epoch++; } /* * ---------------------------------------------------------------------- * * RecomputeClassCacheFlag -- * Determine whether the object is prototypical of its class, and hence * able to use the class's method chain cache. * * ---------------------------------------------------------------------- */ static inline void RecomputeClassCacheFlag( Object *oPtr) { if ((oPtr->methodsPtr == NULL || oPtr->methodsPtr->numEntries == 0) && (oPtr->mixins.num == 0) && (oPtr->filters.num == 0)) { oPtr->flags |= USE_CLASS_CACHE; } else { oPtr->flags &= ~USE_CLASS_CACHE; } } /* * ---------------------------------------------------------------------- * * TclOOObjectSetFilters -- * Install a list of filter method names into an object. * * ---------------------------------------------------------------------- */ void TclOOObjectSetFilters( Object *oPtr, int numFilters, Tcl_Obj *const *filters) { int i; if (oPtr->filters.num) { Tcl_Obj *filterObj; FOREACH(filterObj, oPtr->filters) { Tcl_DecrRefCount(filterObj); } } if (numFilters == 0) { /* * No list of filters was supplied, so we're deleting filters. */ ckfree(oPtr->filters.list); oPtr->filters.list = NULL; oPtr->filters.num = 0; RecomputeClassCacheFlag(oPtr); } else { /* * We've got a list of filters, so we're creating filters. */ Tcl_Obj **filtersList; int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (oPtr->filters.num == 0) { filtersList = ckalloc(size); } else { filtersList = ckrealloc(oPtr->filters.list, size); } for (i = 0 ; i < numFilters ; i++) { filtersList[i] = filters[i]; Tcl_IncrRefCount(filters[i]); } oPtr->filters.list = filtersList; oPtr->filters.num = numFilters; oPtr->flags &= ~USE_CLASS_CACHE; } oPtr->epoch++; /* Only this object can be affected. */ } /* * ---------------------------------------------------------------------- * * TclOOClassSetFilters -- * Install a list of filter method names into a class. * * ---------------------------------------------------------------------- */ void TclOOClassSetFilters( Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters) { int i; if (classPtr->filters.num) { Tcl_Obj *filterObj; FOREACH(filterObj, classPtr->filters) { Tcl_DecrRefCount(filterObj); } } if (numFilters == 0) { /* * No list of filters was supplied, so we're deleting filters. */ ckfree(classPtr->filters.list); classPtr->filters.list = NULL; classPtr->filters.num = 0; } else { /* * We've got a list of filters, so we're creating filters. */ Tcl_Obj **filtersList; int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (classPtr->filters.num == 0) { filtersList = ckalloc(size); } else { filtersList = ckrealloc(classPtr->filters.list, size); } for (i = 0 ; i < numFilters ; i++) { filtersList[i] = filters[i]; Tcl_IncrRefCount(filters[i]); } classPtr->filters.list = filtersList; classPtr->filters.num = numFilters; } /* * There may be many objects affected, so bump the global epoch. */ BumpGlobalEpoch(interp, classPtr); } /* * ---------------------------------------------------------------------- * * TclOOObjectSetMixins -- * Install a list of mixin classes into an object. * * ---------------------------------------------------------------------- */ void TclOOObjectSetMixins( Object *oPtr, int numMixins, Class *const *mixins) { Class *mixinPtr; int i; if (numMixins == 0) { if (oPtr->mixins.num != 0) { FOREACH(mixinPtr, oPtr->mixins) { TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } ckfree(oPtr->mixins.list); oPtr->mixins.num = 0; } RecomputeClassCacheFlag(oPtr); } else { if (oPtr->mixins.num != 0) { FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr && mixinPtr != oPtr->selfCls) { TclOORemoveFromInstances(oPtr, mixinPtr); } TclOODecrRefCount(mixinPtr->thisPtr); } oPtr->mixins.list = ckrealloc(oPtr->mixins.list, sizeof(Class *) * numMixins); } else { oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins); oPtr->flags &= ~USE_CLASS_CACHE; } oPtr->mixins.num = numMixins; memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr != oPtr->selfCls) { TclOOAddToInstances(oPtr, mixinPtr); /* * For the new copy created by memcpy(). */ AddRef(mixinPtr->thisPtr); } } } oPtr->epoch++; } /* * ---------------------------------------------------------------------- * * TclOOClassSetMixins -- * Install a list of mixin classes into a class. * * ---------------------------------------------------------------------- */ void TclOOClassSetMixins( Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins) { Class *mixinPtr; int i; if (numMixins == 0) { if (classPtr->mixins.num != 0) { FOREACH(mixinPtr, classPtr->mixins) { TclOORemoveFromMixinSubs(classPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } ckfree(classPtr->mixins.list); classPtr->mixins.num = 0; } } else { if (classPtr->mixins.num != 0) { FOREACH(mixinPtr, classPtr->mixins) { TclOORemoveFromMixinSubs(classPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } classPtr->mixins.list = ckrealloc(classPtr->mixins.list, sizeof(Class *) * numMixins); } else { classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins); } classPtr->mixins.num = numMixins; memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, classPtr->mixins) { TclOOAddToMixinSubs(classPtr, mixinPtr); /* * For the new copy created by memcpy. */ AddRef(mixinPtr->thisPtr); } } BumpGlobalEpoch(interp, classPtr); } /* * ---------------------------------------------------------------------- * * RenameDeleteMethod -- * Core of the code to rename and delete methods. * * ---------------------------------------------------------------------- */ static int RenameDeleteMethod( Tcl_Interp *interp, Object *oPtr, int useClass, Tcl_Obj *const fromPtr, Tcl_Obj *const toPtr) { Tcl_HashEntry *hPtr, *newHPtr = NULL; Method *mPtr; int isNew; if (!useClass) { if (!oPtr->methodsPtr) { noSuchMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "method %s does not exist", TclGetString(fromPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(fromPtr), NULL); return TCL_ERROR; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr); if (hPtr == NULL) { goto noSuchMethod; } if (toPtr) { newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) toPtr, &isNew); if (hPtr == newHPtr) { renameToSelf: Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot rename method to itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL); return TCL_ERROR; } else if (!isNew) { renameToExisting: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "method called %s already exists", TclGetString(toPtr))); Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL); return TCL_ERROR; } } } else { hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods, (char *) fromPtr); if (hPtr == NULL) { goto noSuchMethod; } if (toPtr) { newHPtr = Tcl_CreateHashEntry(&oPtr->classPtr->classMethods, (char *) toPtr, &isNew); if (hPtr == newHPtr) { goto renameToSelf; } else if (!isNew) { goto renameToExisting; } } } /* * Complete the splicing by changing the method's name. */ mPtr = Tcl_GetHashValue(hPtr); if (toPtr) { Tcl_IncrRefCount(toPtr); Tcl_DecrRefCount(mPtr->namePtr); mPtr->namePtr = toPtr; Tcl_SetHashValue(newHPtr, mPtr); } else { if (!useClass) { RecomputeClassCacheFlag(oPtr); } TclOODelMethodRef(mPtr); } Tcl_DeleteHashEntry(hPtr); return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOOUnknownDefinition -- * Handles what happens when an unknown command is encountered during the * processing of a definition script. Works by finding a command in the * operating definition namespace that the requested command is a unique * prefix of. * * ---------------------------------------------------------------------- */ int TclOOUnknownDefinition( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_HashSearch search; Tcl_HashEntry *hPtr; int soughtLen; const char *soughtStr, *matchedStr = NULL; if (objc < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad call of unknown handler", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL); return TCL_ERROR; } if (TclOOGetDefineCmdContext(interp) == NULL) { return TCL_ERROR; } soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen); if (soughtLen == 0) { goto noMatch; } hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (hPtr != NULL) { const char *nameStr = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); if (strncmp(soughtStr, nameStr, soughtLen) == 0) { if (matchedStr != NULL) { goto noMatch; } matchedStr = nameStr; } hPtr = Tcl_NextHashEntry(&search); } if (matchedStr != NULL) { /* * Got one match, and only one match! */ Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1)); int result; newObjv[0] = Tcl_NewStringObj(matchedStr, -1); Tcl_IncrRefCount(newObjv[0]); if (objc > 2) { memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2)); } result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0); Tcl_DecrRefCount(newObjv[0]); TclStackFree(interp, newObjv); return result; } noMatch: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid command name \"%s\"", soughtStr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL); return TCL_ERROR; } /* * ---------------------------------------------------------------------- * * FindCommand -- * Specialized version of Tcl_FindCommand that handles command prefixes * and disallows namespace magic. * * ---------------------------------------------------------------------- */ static Tcl_Command FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { int length; const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length); Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; Tcl_Command cmd, cmd2; /* * If someone is playing games, we stop playing right now. */ if (string[0] == '\0' || strstr(string, "::") != NULL) { return NULL; } /* * Do the exact lookup first. */ cmd = Tcl_FindCommand(interp, string, namespacePtr, TCL_NAMESPACE_ONLY); if (cmd != NULL) { return cmd; } /* * Bother, need to perform an approximate match. Iterate across the hash * table of commands in the namespace. */ FOREACH_HASH(nameStr, cmd2, &nsPtr->cmdTable) { if (strncmp(string, nameStr, length) == 0) { if (cmd != NULL) { return NULL; } cmd = cmd2; } } /* * Either we found one thing or we found nothing. Either way, return it. */ return cmd; } /* * ---------------------------------------------------------------------- * * InitDefineContext -- * Does the magic incantations necessary to push the special stack frame * used when processing object definitions. It is up to the caller to * dispose of the frame (with TclPopStackFrame) when finished. * * ---------------------------------------------------------------------- */ static inline int InitDefineContext( Tcl_Interp *interp, Tcl_Namespace *namespacePtr, Object *oPtr, int objc, Tcl_Obj *const objv[]) { CallFrame *framePtr, **framePtrPtr = &framePtr; if (namespacePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot process definitions; support namespace deleted", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } /* * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules. */ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, FRAME_IS_OO_DEFINE); framePtr->clientData = oPtr; framePtr->objc = objc; framePtr->objv = objv; /* Reference counts do not need to be * incremented here. */ return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOOGetDefineCmdContext -- * Extracts the magic token from the current stack frame, or returns NULL * (and leaves an error message) otherwise. * * ---------------------------------------------------------------------- */ Tcl_Object TclOOGetDefineCmdContext( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; Tcl_Object object; if ((iPtr->varFramePtr == NULL) || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command may only be called from within the context of" " an ::oo::define or ::oo::objdefine command", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } object = iPtr->varFramePtr->clientData; if (Tcl_ObjectDeleted(object)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command cannot be called when the object has been" " deleted", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } return object; } /* * ---------------------------------------------------------------------- * * GetClassInOuterContext -- * Wrapper round Tcl_GetObjectFromObj to perform the lookup in the * context that called oo::define (or equivalent). Note that this may * have to go up multiple levels to get the level that we started doing * definitions at. * * ---------------------------------------------------------------------- */ static inline Class * GetClassInOuterContext( Tcl_Interp *interp, Tcl_Obj *className, const char *errMsg) { Interp *iPtr = (Interp *) interp; Object *oPtr; CallFrame *savedFramePtr = iPtr->varFramePtr; while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE) { if (iPtr->varFramePtr->callerVarPtr == NULL) { Tcl_Panic("getting outer context when already in global context"); } iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, className); iPtr->varFramePtr = savedFramePtr; if (oPtr == NULL) { return NULL; } if (oPtr->classPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(className), NULL); return NULL; } return oPtr->classPtr; } /* * ---------------------------------------------------------------------- * * GenerateErrorInfo -- * Factored out code to generate part of the error trace messages. * * ---------------------------------------------------------------------- */ static inline void GenerateErrorInfo( Tcl_Interp *interp, /* Where to store the error info trace. */ Object *oPtr, /* What object (or class) was being configured * when the error occurred? */ Tcl_Obj *savedNameObj, /* Name of object saved from before script was * evaluated, which is needed if the object * goes away part way through execution. OTOH, * if the object isn't deleted then its * current name (post-execution) has to be * used. This matters, because the object * could have been renamed... */ const char *typeOfSubject) /* Part of the message, saying whether it was * an object, class or class-as-object that * was being configured. */ { int length; Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) ? savedNameObj : TclOOObjectName(interp, oPtr); const char *objName = Tcl_GetStringFromObj(realNameObj, &length); int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in definition script for %s \"%.*s%s\" line %d)", typeOfSubject, (overflow ? limit : length), objName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* * ---------------------------------------------------------------------- * * MagicDefinitionInvoke -- * Part of the implementation of the "oo::define" and "oo::objdefine" * commands that is used to implement the more-than-one-argument case, * applying ensemble-like tricks with dispatch so that error messages are * clearer. Doesn't handle the management of the stack frame. * * ---------------------------------------------------------------------- */ static inline int MagicDefinitionInvoke( Tcl_Interp *interp, Tcl_Namespace *nsPtr, int cmdIndex, int objc, Tcl_Obj *const *objv) { Tcl_Obj *objPtr, *obj2Ptr, **objs; Tcl_Command cmd; int isRoot, dummy, result, offset = cmdIndex + 1; /* * More than one argument: fire them through the ensemble processing * engine so that everything appears to be good and proper in error * messages. Note that we cannot just concatenate and send through * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we cannot go * through Tcl_EvalObjv without the extra work to pre-find the command, as * that finds command names in the wrong namespace at the moment. Ugly! */ isRoot = TclInitRewriteEnsemble(interp, offset, 1, objv); /* * Build the list of arguments using a Tcl_Obj as a workspace. See * comments above for why these contortions are necessary. */ TclNewObj(objPtr); TclNewObj(obj2Ptr); cmd = FindCommand(interp, objv[cmdIndex], nsPtr); if (cmd == NULL) { /* * Punt this case! */ Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]); } else { Tcl_GetCommandFullName(interp, cmd, obj2Ptr); } Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr); /* TODO: overflow? */ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset); TclListObjGetElements(NULL, objPtr, &dummy, &objs); result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE); if (isRoot) { TclResetRewriteEnsemble(interp, 1); } Tcl_DecrRefCount(objPtr); return result; } /* * ---------------------------------------------------------------------- * * TclOODefineObjCmd -- * Implementation of the "oo::define" command. Works by effectively doing * the same as 'namespace eval', but with extra magic applied so that the * object to be modified is known to the commands in the target * namespace. Also does ensemble-like tricks with dispatch so that error * messages are clearer. * * ---------------------------------------------------------------------- */ int TclOODefineObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Foundation *fPtr = TclOOGetFoundation(interp); Object *oPtr; int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->classPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s does not refer to a class",TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[1]), NULL); return TCL_ERROR; } /* * Make the oo::define namespace the current namespace and evaluate the * command(s). */ if (InitDefineContext(interp, fPtr->defineNs, oPtr, objc,objv) != TCL_OK){ return TCL_ERROR; } AddRef(oPtr); if (objc == 3) { Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr); Tcl_IncrRefCount(objNameObj); result = TclEvalObjEx(interp, objv[2], 0, ((Interp *)interp)->cmdFramePtr, 2); if (result == TCL_ERROR) { GenerateErrorInfo(interp, oPtr, objNameObj, "class"); } TclDecrRefCount(objNameObj); } else { result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv); } TclOODecrRefCount(oPtr); /* * Restore the previous "current" namespace. */ TclPopStackFrame(interp); return result; } /* * ---------------------------------------------------------------------- * * TclOOObjDefObjCmd -- * Implementation of the "oo::objdefine" command. Works by effectively * doing the same as 'namespace eval', but with extra magic applied so * that the object to be modified is known to the commands in the target * namespace. Also does ensemble-like tricks with dispatch so that error * messages are clearer. * * ---------------------------------------------------------------------- */ int TclOOObjDefObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Foundation *fPtr = TclOOGetFoundation(interp); Object *oPtr; int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } /* * Make the oo::objdefine namespace the current namespace and evaluate the * command(s). */ if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){ return TCL_ERROR; } AddRef(oPtr); if (objc == 3) { Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr); Tcl_IncrRefCount(objNameObj); result = TclEvalObjEx(interp, objv[2], 0, ((Interp *)interp)->cmdFramePtr, 2); if (result == TCL_ERROR) { GenerateErrorInfo(interp, oPtr, objNameObj, "object"); } TclDecrRefCount(objNameObj); } else { result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv); } TclOODecrRefCount(oPtr); /* * Restore the previous "current" namespace. */ TclPopStackFrame(interp); return result; } /* * ---------------------------------------------------------------------- * * TclOODefineSelfObjCmd -- * Implementation of the "self" subcommand of the "oo::define" command. * Works by effectively doing the same as 'namespace eval', but with * extra magic applied so that the object to be modified is known to the * commands in the target namespace. Also does ensemble-like tricks with * dispatch so that error messages are clearer. * * ---------------------------------------------------------------------- */ int TclOODefineSelfObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Foundation *fPtr = TclOOGetFoundation(interp); Object *oPtr; int result; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); return TCL_ERROR; } oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } /* * Make the oo::objdefine namespace the current namespace and evaluate the * command(s). */ if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){ return TCL_ERROR; } AddRef(oPtr); if (objc == 2) { Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr); Tcl_IncrRefCount(objNameObj); result = TclEvalObjEx(interp, objv[1], 0, ((Interp *)interp)->cmdFramePtr, 2); if (result == TCL_ERROR) { GenerateErrorInfo(interp, oPtr, objNameObj, "class object"); } TclDecrRefCount(objNameObj); } else { result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv); } TclOODecrRefCount(oPtr); /* * Restore the previous "current" namespace. */ TclPopStackFrame(interp); return result; } /* * ---------------------------------------------------------------------- * * TclOODefineClassObjCmd -- * Implementation of the "class" subcommand of the "oo::objdefine" * command. * * ---------------------------------------------------------------------- */ int TclOODefineClassObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; Class *clsPtr; Foundation *fPtr = TclOOGetFoundation(interp); int wasClass, willBeClass; /* * Parse the context to get the object to operate on. */ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->flags & ROOT_OBJECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not modify the class of the root object class", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } if (oPtr->flags & ROOT_CLASS) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not modify the class of the class of classes", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } /* * Parse the argument to get the class to set the object's class to. */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } clsPtr = GetClassInOuterContext(interp, objv[1], "the class of an object must be a class"); if (clsPtr == NULL) { return TCL_ERROR; } if (oPtr == clsPtr->thisPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not change classes into an instance of themselves", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } /* * Set the object's class. */ wasClass = (oPtr->classPtr != NULL); willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr)); if (oPtr->selfCls != clsPtr) { TclOORemoveFromInstances(oPtr, oPtr->selfCls); TclOODecrRefCount(oPtr->selfCls->thisPtr); oPtr->selfCls = clsPtr; AddRef(oPtr->selfCls->thisPtr); TclOOAddToInstances(oPtr, oPtr->selfCls); /* * Create or delete the class guts if necessary. */ if (wasClass && !willBeClass) { /* * This is the most global of all epochs. Bump it! No cache can be * trusted! */ TclOORemoveFromMixins(oPtr->classPtr, oPtr); oPtr->fPtr->epoch++; oPtr->flags |= DONT_DELETE; TclOODeleteDescendants(interp, oPtr); oPtr->flags &= ~DONT_DELETE; TclOOReleaseClassContents(interp, oPtr); ckfree(oPtr->classPtr); oPtr->classPtr = NULL; } else if (!wasClass && willBeClass) { TclOOAllocClass(interp, oPtr); } if (oPtr->classPtr != NULL) { BumpGlobalEpoch(interp, oPtr->classPtr); } else { oPtr->epoch++; } } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineConstructorObjCmd -- * Implementation of the "constructor" subcommand of the "oo::define" * command. * * ---------------------------------------------------------------------- */ int TclOODefineConstructorObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; Class *clsPtr; Tcl_Method method; int bodyLength; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arguments body"); return TCL_ERROR; } /* * Extract and validate the context, which is the class that we wish to * modify. */ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; Tcl_GetStringFromObj(objv[2], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. */ method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr, PUBLIC_METHOD, NULL, objv[1], objv[2], NULL); if (method == NULL) { return TCL_ERROR; } } else { /* * Delete the constructor method record and set the field in the * class record to NULL. */ method = NULL; } /* * Place the method structure in the class record. Note that we might not * immediately delete the constructor as this might be being done during * execution of the constructor itself. */ Tcl_ClassSetConstructor(interp, (Tcl_Class) clsPtr, method); return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineDeleteMethodObjCmd -- * Implementation of the "deletemethod" subcommand of the "oo::define" * and "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int TclOODefineDeleteMethodObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int isInstanceDeleteMethod = (clientData != NULL); Object *oPtr; int i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?"); return TCL_ERROR; } oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceDeleteMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* * Delete the method structure from the appropriate hash table. */ if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod, objv[i], NULL) != TCL_OK) { return TCL_ERROR; } } if (isInstanceDeleteMethod) { oPtr->epoch++; } else { BumpGlobalEpoch(interp, oPtr->classPtr); } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineDestructorObjCmd -- * Implementation of the "destructor" subcommand of the "oo::define" * command. * * ---------------------------------------------------------------------- */ int TclOODefineDestructorObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; Class *clsPtr; Tcl_Method method; int bodyLength; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "body"); return TCL_ERROR; } oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; Tcl_GetStringFromObj(objv[1], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. */ method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr, PUBLIC_METHOD, NULL, NULL, objv[1], NULL); if (method == NULL) { return TCL_ERROR; } } else { /* * Delete the destructor method record and set the field in the class * record to NULL. */ method = NULL; } /* * Place the method structure in the class record. Note that we might not * immediately delete the destructor as this might be being done during * execution of the destructor itself. Also note that setting a * destructor during a destructor is fairly dumb anyway. */ Tcl_ClassSetDestructor(interp, (Tcl_Class) clsPtr, method); return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineExportObjCmd -- * Implementation of the "export" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int TclOODefineExportObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int isInstanceExport = (clientData != NULL); Object *oPtr; Method *mPtr; Tcl_HashEntry *hPtr; Class *clsPtr; int i, isNew, changed = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?"); return TCL_ERROR; } oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; if (!isInstanceExport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* * Exporting is done by adding the PUBLIC_METHOD flag to the method * record. If there is no such method in this object or class (i.e. * the method comes from something inherited from or that we're an * instance of) then we put in a blank record with that flag; such * records are skipped over by the call chain engine *except* for * their flags member. */ if (isInstanceExport) { if (!oPtr->methodsPtr) { oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i], &isNew); } else { hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i], &isNew); } if (isNew) { mPtr = ckalloc(sizeof(Method)); memset(mPtr, 0, sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = objv[i]; Tcl_IncrRefCount(objv[i]); Tcl_SetHashValue(hPtr, mPtr); } else { mPtr = Tcl_GetHashValue(hPtr); } if (isNew || !(mPtr->flags & PUBLIC_METHOD)) { mPtr->flags |= PUBLIC_METHOD; changed = 1; } } /* * Bump the right epoch if we actually changed anything. */ if (changed) { if (isInstanceExport) { oPtr->epoch++; } else { BumpGlobalEpoch(interp, clsPtr); } } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineForwardObjCmd -- * Implementation of the "forward" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int TclOODefineForwardObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int isInstanceForward = (clientData != NULL); Object *oPtr; Method *mPtr; int isPublic; Tcl_Obj *prefixObj; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name cmdName ?arg ...?"); return TCL_ERROR; } oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceForward && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN) ? PUBLIC_METHOD : 0; /* * Create the method structure. */ prefixObj = Tcl_NewListObj(objc - 2, objv + 2); if (isInstanceForward) { mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1], prefixObj); } else { mPtr = TclOONewForwardMethod(interp, oPtr->classPtr, isPublic, objv[1], prefixObj); } if (mPtr == NULL) { Tcl_DecrRefCount(prefixObj); return TCL_ERROR; } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineMethodObjCmd -- * Implementation of the "method" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int TclOODefineMethodObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int isInstanceMethod = (clientData != NULL); Object *oPtr; int isPublic; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "name args body"); return TCL_ERROR; } oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN) ? PUBLIC_METHOD : 0; /* * Create the method by using the right back-end API. */ if (isInstanceMethod) { if (TclOONewProcInstanceMethod(interp, oPtr, isPublic, objv[1], objv[2], objv[3], NULL) == NULL) { return TCL_ERROR; } } else { if (TclOONewProcMethod(interp, oPtr->classPtr, isPublic, objv[1], objv[2], objv[3], NULL) == NULL) { return TCL_ERROR; } } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineRenameMethodObjCmd -- * Implementation of the "renamemethod" subcommand of the "oo::define" * and "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int TclOODefineRenameMethodObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int isInstanceRenameMethod = (clientData != NULL); Object *oPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "oldName newName"); return TCL_ERROR; } oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceRenameMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } /* * Delete the method entry from the appropriate hash table, and transfer * the thing it points to to its new entry. To do this, we first need to * get the entries from the appropriate hash tables (this can generate a * range of errors...) */ if (RenameDeleteMethod(interp, oPtr, !isInstanceRenameMethod, objv[1], objv[2]) != TCL_OK) { return TCL_ERROR; } if (isInstanceRenameMethod) { oPtr->epoch++; } else { BumpGlobalEpoch(interp, oPtr->classPtr); } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineUnexportObjCmd -- * Implementation of the "unexport" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int TclOODefineUnexportObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int isInstanceUnexport = (clientData != NULL); Object *oPtr; Method *mPtr; Tcl_HashEntry *hPtr; Class *clsPtr; int i, isNew, changed = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?"); return TCL_ERROR; } oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; if (!isInstanceUnexport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* * Unexporting is done by removing the PUBLIC_METHOD flag from the * method record. If there is no such method in this object or class * (i.e. the method comes from something inherited from or that we're * an instance of) then we put in a blank record without that flag; * such records are skipped over by the call chain engine *except* for * their flags member. */ if (isInstanceUnexport) { if (!oPtr->methodsPtr) { oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i], &isNew); } else { hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i], &isNew); } if (isNew) { mPtr = ckalloc(sizeof(Method)); memset(mPtr, 0, sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = objv[i]; Tcl_IncrRefCount(objv[i]); Tcl_SetHashValue(hPtr, mPtr); } else { mPtr = Tcl_GetHashValue(hPtr); } if (isNew || mPtr->flags & PUBLIC_METHOD) { mPtr->flags &= ~PUBLIC_METHOD; changed = 1; } } /* * Bump the right epoch if we actually changed anything. */ if (changed) { if (isInstanceUnexport) { oPtr->epoch++; } else { BumpGlobalEpoch(interp, clsPtr); } } return TCL_OK; } /* * ---------------------------------------------------------------------- * * Tcl_ClassSetConstructor, Tcl_ClassSetDestructor -- * How to install a constructor or destructor into a class; API to call * from C. * * ---------------------------------------------------------------------- */ void Tcl_ClassSetConstructor( Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method) { Class *clsPtr = (Class *) clazz; if (method != (Tcl_Method) clsPtr->constructorPtr) { TclOODelMethodRef(clsPtr->constructorPtr); clsPtr->constructorPtr = (Method *) method; /* * Remember to invalidate the cached constructor chain for this class. * [Bug 2531577] */ if (clsPtr->constructorChainPtr) { TclOODeleteChain(clsPtr->constructorChainPtr); clsPtr->constructorChainPtr = NULL; } BumpGlobalEpoch(interp, clsPtr); } } void Tcl_ClassSetDestructor( Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method) { Class *clsPtr = (Class *) clazz; if (method != (Tcl_Method) clsPtr->destructorPtr) { TclOODelMethodRef(clsPtr->destructorPtr); clsPtr->destructorPtr = (Method *) method; if (clsPtr->destructorChainPtr) { TclOODeleteChain(clsPtr->destructorChainPtr); clsPtr->destructorChainPtr = NULL; } BumpGlobalEpoch(interp, clsPtr); } } /* * ---------------------------------------------------------------------- * * TclOODefineSlots -- * Create the "::oo::Slot" class and its standard instances. Class * definition is empty at the stage (added by scripting). * * ---------------------------------------------------------------------- */ int TclOODefineSlots( Foundation *fPtr) { const struct DeclaredSlot *slotInfoPtr; Tcl_Obj *getName = Tcl_NewStringObj("Get", -1); Tcl_Obj *setName = Tcl_NewStringObj("Set", -1); Class *slotCls; slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class) fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr; if (slotCls == NULL) { return TCL_ERROR; } Tcl_IncrRefCount(getName); Tcl_IncrRefCount(setName); for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) { Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0); if (slotObject == NULL) { continue; } Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0, &slotInfoPtr->getterType, NULL); Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0, &slotInfoPtr->setterType, NULL); } Tcl_DecrRefCount(getName); Tcl_DecrRefCount(setName); return TCL_OK; } /* * ---------------------------------------------------------------------- * * ClassFilterGet, ClassFilterSet -- * Implementation of the "filter" slot accessors of the "oo::define" * command. * * ---------------------------------------------------------------------- */ static int ClassFilterGet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj, *filterObj; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } TclNewObj(resultObj); FOREACH(filterObj, oPtr->classPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } static int ClassFilterSet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int filterc; Tcl_Obj **filterv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } TclOOClassSetFilters(interp, oPtr->classPtr, filterc, filterv); return TCL_OK; } /* * ---------------------------------------------------------------------- * * ClassMixinGet, ClassMixinSet -- * Implementation of the "mixin" slot accessors of the "oo::define" * command. * * ---------------------------------------------------------------------- */ static int ClassMixinGet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *mixinPtr; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->classPtr->mixins) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } static int ClassMixinSet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int mixinc, i; Tcl_Obj **mixinv; Class **mixins; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "mixinList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); for (i = 0; i < mixinc; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { i--; goto freeAndError; } if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not mix a class into itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } } TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins); TclStackFree(interp, mixins); return TCL_OK; freeAndError: TclStackFree(interp, mixins); return TCL_ERROR; } /* * ---------------------------------------------------------------------- * * ClassSuperGet, ClassSuperSet -- * Implementation of the "superclass" slot accessors of the "oo::define" * command. * * ---------------------------------------------------------------------- */ static int ClassSuperGet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *superPtr; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } TclNewObj(resultObj); FOREACH(superPtr, oPtr->classPtr->superclasses) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, superPtr->thisPtr)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } static int ClassSuperSet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int superc, i, j; Tcl_Obj **superv; Class **superclasses, *superPtr; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "superclassList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not modify the superclass of the root object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &superc, &superv) != TCL_OK) { return TCL_ERROR; } /* * Allocate some working space. */ superclasses = (Class **) ckalloc(sizeof(Class *) * superc); /* * Parse the arguments to get the class to use as superclasses. * * Note that zero classes is special, as it is equivalent to just the * class of objects. [Bug 9d61624b3d] */ if (superc == 0) { superclasses = ckrealloc(superclasses, sizeof(Class *)); if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { superclasses[0] = oPtr->fPtr->classCls; } else { superclasses[0] = oPtr->fPtr->objectCls; } superc = 1; AddRef(superclasses[0]->thisPtr); } else { for (i = 0; i < superc; i++) { superclasses[i] = GetClassInOuterContext(interp, superv[i], "only a class can be a superclass"); if (superclasses[i] == NULL) { goto failedAfterAlloc; } for (j = 0; j < i; j++) { if (superclasses[j] == superclasses[i]) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "class should only be a direct superclass once", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL); goto failedAfterAlloc; } } if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to form circular dependency graph", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); failedAfterAlloc: for (; i-- > 0 ;) { TclOODecrRefCount(superclasses[i]->thisPtr); } ckfree(superclasses); return TCL_ERROR; } /* * Corresponding TclOODecrRefCount() is near the end of this * function. */ AddRef(superclasses[i]->thisPtr); } } /* * Install the list of superclasses into the class. Note that this also * involves splicing the class out of the superclasses' subclass list that * it used to be a member of and splicing it into the new superclasses' * subclass list. */ if (oPtr->classPtr->superclasses.num != 0) { FOREACH(superPtr, oPtr->classPtr->superclasses) { TclOORemoveFromSubclasses(oPtr->classPtr, superPtr); TclOODecrRefCount(superPtr->thisPtr); } ckfree((char *) oPtr->classPtr->superclasses.list); } oPtr->classPtr->superclasses.list = superclasses; oPtr->classPtr->superclasses.num = superc; FOREACH(superPtr, oPtr->classPtr->superclasses) { TclOOAddToSubclasses(oPtr->classPtr, superPtr); } BumpGlobalEpoch(interp, oPtr->classPtr); return TCL_OK; } /* * ---------------------------------------------------------------------- * * ClassVarsGet, ClassVarsSet -- * Implementation of the "variable" slot accessors of the "oo::define" * command. * * ---------------------------------------------------------------------- */ static int ClassVarsGet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj, *variableObj; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } TclNewObj(resultObj); FOREACH(variableObj, oPtr->classPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } static int ClassVarsSet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int varc; Tcl_Obj **varv, *variableObj; int i; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } for (i = 0; i < varc; i++) { const char *varName = Tcl_GetString(varv[i]); if (strstr(varName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "contain namespace separators")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "refer to an array element")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } } for (i = 0; i < varc; i++) { Tcl_IncrRefCount(varv[i]); } FOREACH(variableObj, oPtr->classPtr->variables) { Tcl_DecrRefCount(variableObj); } if (i != varc) { if (varc == 0) { ckfree((char *) oPtr->classPtr->variables.list); } else if (i) { oPtr->classPtr->variables.list = (Tcl_Obj **) ckrealloc((char *) oPtr->classPtr->variables.list, sizeof(Tcl_Obj *) * varc); } else { oPtr->classPtr->variables.list = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * varc); } } oPtr->classPtr->variables.num = 0; if (varc > 0) { 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); } return TCL_OK; } /* * ---------------------------------------------------------------------- * * ObjectFilterGet, ObjectFilterSet -- * Implementation of the "filter" slot accessors of the "oo::objdefine" * command. * * ---------------------------------------------------------------------- */ static int ObjFilterGet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj, *filterObj; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(filterObj, oPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } static int ObjFilterSet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int filterc; Tcl_Obj **filterv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } TclOOObjectSetFilters(oPtr, filterc, filterv); return TCL_OK; } /* * ---------------------------------------------------------------------- * * ObjectMixinGet, ObjectMixinSet -- * Implementation of the "mixin" slot accessors of the "oo::objdefine" * command. * * ---------------------------------------------------------------------- */ static int ObjMixinGet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *mixinPtr; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } static int ObjMixinSet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int mixinc; Tcl_Obj **mixinv; Class **mixins; int i; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "mixinList"); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); for (i = 0; i < mixinc; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { TclStackFree(interp, mixins); return TCL_ERROR; } } TclOOObjectSetMixins(oPtr, mixinc, mixins); TclStackFree(interp, mixins); return TCL_OK; } /* * ---------------------------------------------------------------------- * * ObjectVarsGet, ObjectVarsSet -- * Implementation of the "variable" slot accessors of the "oo::objdefine" * command. * * ---------------------------------------------------------------------- */ static int ObjVarsGet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj, *variableObj; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(variableObj, oPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } static int ObjVarsSet( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int varc, i; Tcl_Obj **varv, *variableObj; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "variableList"); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } for (i = 0; i < varc; i++) { const char *varName = Tcl_GetString(varv[i]); if (strstr(varName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "contain namespace separators")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "refer to an array element")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } } for (i = 0; i < varc; i++) { Tcl_IncrRefCount(varv[i]); } FOREACH(variableObj, oPtr->variables) { Tcl_DecrRefCount(variableObj); } if (i != varc) { if (varc == 0) { ckfree((char *) oPtr->variables.list); } else if (i) { oPtr->variables.list = (Tcl_Obj **) ckrealloc((char *) oPtr->variables.list, sizeof(Tcl_Obj *) * varc); } else { oPtr->variables.list = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * varc); } } oPtr->variables.num = 0; if (varc > 0) { 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); } return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOO.h0000644000175000017500000001024114554262142014445 0ustar sergeisergei/* * tclOO.h -- * * This file contains the public API definitions and some of the function * declarations for the object-system (NB: not Tcl_Obj, but ::oo). * * Copyright (c) 2006-2010 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef TCLOO_H_INCLUDED #define TCLOO_H_INCLUDED /* * Be careful when it comes to versioning; need to make sure that the * standalone TclOO version matches. Also make sure that this matches the * version in the files: * * tests/oo.test * tests/ooNext2.test * unix/tclooConfig.sh * win/tclooConfig.sh */ #define TCLOO_VERSION "1.1.0" #define TCLOO_PATCHLEVEL TCLOO_VERSION #include "tcl.h" /* * For C++ compilers, use extern "C" */ #ifdef __cplusplus extern "C" { #endif extern const char *TclOOInitializeStubs( Tcl_Interp *, const char *version); #define Tcl_OOInitStubs(interp) \ TclOOInitializeStubs((interp), TCLOO_VERSION) #ifndef USE_TCL_STUBS # define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL) #endif /* * These are opaque types. */ typedef struct Tcl_Class_ *Tcl_Class; typedef struct Tcl_Method_ *Tcl_Method; typedef struct Tcl_Object_ *Tcl_Object; typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext; /* * Public datatypes for callbacks and structures used in the TIP#257 (OO) * implementation. These are used to implement custom types of method calls * and to allow the attachment of arbitrary data to objects and classes. */ typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); typedef void (Tcl_MethodDeleteProc)(void *clientData); typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData, void **newClientData); typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData); typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp, Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj); /* * The type of a method implementation. This describes how to call the method * implementation, how to delete it (when the object or class is deleted) and * how to create a clone of it (when the object or class is copied). */ typedef struct { int version; /* Structure version field. Always to be equal * to TCL_OO_METHOD_VERSION_CURRENT in * declarations. */ const char *name; /* Name of this type of method, mostly for * debugging purposes. */ Tcl_MethodCallProc *callProc; /* How to invoke this method. */ Tcl_MethodDeleteProc *deleteProc; /* How to delete this method's type-specific * data, or NULL if the type-specific data * does not need deleting. */ Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific * data, or NULL if the type-specific data can * be copied directly. */ } Tcl_MethodType; /* * The correct value for the version field of the Tcl_MethodType structure. * This allows new versions of the structure to be introduced without breaking * binary compatibility. */ #define TCL_OO_METHOD_VERSION_CURRENT 1 /* * The type of some object (or class) metadata. This describes how to delete * the metadata (when the object or class is deleted) and how to create a * clone of it (when the object or class is copied). */ typedef struct { int version; /* Structure version field. Always to be equal * to TCL_OO_METADATA_VERSION_CURRENT in * declarations. */ const char *name; Tcl_ObjectMetadataDeleteProc *deleteProc; /* How to delete the metadata. This must not * be NULL. */ Tcl_CloneProc *cloneProc; /* How to copy the metadata, or NULL if the * type-specific data can be copied * directly. */ } Tcl_ObjectMetadataType; /* * The correct value for the version field of the Tcl_ObjectMetadataType * structure. This allows new versions of the structure to be introduced * without breaking binary compatibility. */ #define TCL_OO_METADATA_VERSION_CURRENT 1 /* * Include all the public API, generated from tclOO.decls. */ #include "tclOODecls.h" #ifdef __cplusplus } #endif #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOOInfo.c0000644000175000017500000011224714554262142015265 0ustar sergeisergei/* * tclOODefineCmds.c -- * * This file contains the implementation of the ::oo-related [info] * subcommands. * * Copyright (c) 2006-2011 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" static inline Class * GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static Tcl_ObjCmdProc InfoObjectCallCmd; static Tcl_ObjCmdProc InfoObjectClassCmd; static Tcl_ObjCmdProc InfoObjectDefnCmd; static Tcl_ObjCmdProc InfoObjectFiltersCmd; static Tcl_ObjCmdProc InfoObjectForwardCmd; static Tcl_ObjCmdProc InfoObjectIsACmd; static Tcl_ObjCmdProc InfoObjectMethodsCmd; static Tcl_ObjCmdProc InfoObjectMethodTypeCmd; static Tcl_ObjCmdProc InfoObjectMixinsCmd; static Tcl_ObjCmdProc InfoObjectNsCmd; static Tcl_ObjCmdProc InfoObjectVarsCmd; static Tcl_ObjCmdProc InfoObjectVariablesCmd; static Tcl_ObjCmdProc InfoClassCallCmd; static Tcl_ObjCmdProc InfoClassConstrCmd; static Tcl_ObjCmdProc InfoClassDefnCmd; static Tcl_ObjCmdProc InfoClassDestrCmd; static Tcl_ObjCmdProc InfoClassFiltersCmd; static Tcl_ObjCmdProc InfoClassForwardCmd; static Tcl_ObjCmdProc InfoClassInstancesCmd; static Tcl_ObjCmdProc InfoClassMethodsCmd; static Tcl_ObjCmdProc InfoClassMethodTypeCmd; static Tcl_ObjCmdProc InfoClassMixinsCmd; static Tcl_ObjCmdProc InfoClassSubsCmd; static Tcl_ObjCmdProc InfoClassSupersCmd; static Tcl_ObjCmdProc InfoClassVariablesCmd; /* * List of commands that are used to implement the [info object] subcommands. */ static const EnsembleImplMap infoObjectCmds[] = { {"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0}, {"definition", InfoObjectDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"filters", InfoObjectFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"forward", InfoObjectForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"isa", InfoObjectIsACmd, TclCompileInfoObjectIsACmd, NULL, NULL, 0}, {"methods", InfoObjectMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0}, {"variables", InfoObjectVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* * List of commands that are used to implement the [info class] subcommands. */ static const EnsembleImplMap infoClassCmds[] = { {"call", InfoClassCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"constructor", InfoClassConstrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"definition", InfoClassDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"destructor", InfoClassDestrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"filters", InfoClassFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"forward", InfoClassForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"instances", InfoClassInstancesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"methods", InfoClassMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"methodtype", InfoClassMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"variables", InfoClassVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* * ---------------------------------------------------------------------- * * TclOOInitInfo -- * * Adjusts the Tcl core [info] command to contain subcommands ("object" * and "class") for introspection of objects and classes. * * ---------------------------------------------------------------------- */ void TclOOInitInfo( Tcl_Interp *interp) { Tcl_Command infoCmd; Tcl_Obj *mapDict; /* * Build the ensembles used to implement [info object] and [info class]. */ TclMakeEnsemble(interp, "::oo::InfoObject", infoObjectCmds); TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds); /* * Install into the [info] ensemble. */ infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); if (infoCmd) { Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), Tcl_NewStringObj("::oo::InfoObject", -1)); Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), Tcl_NewStringObj("::oo::InfoClass", -1)); Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } } /* * ---------------------------------------------------------------------- * * GetClassFromObj -- * * How to correctly get a class from a Tcl_Obj. Just a wrapper round * Tcl_GetObjectFromObj, but this is an idiom that was used heavily. * * ---------------------------------------------------------------------- */ static inline Class * GetClassFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { Object *oPtr = (Object *) Tcl_GetObjectFromObj(interp, objPtr); if (oPtr == NULL) { return NULL; } if (oPtr->classPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" is not a class", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objPtr), NULL); return NULL; } return oPtr->classPtr; } /* * ---------------------------------------------------------------------- * * InfoObjectClassCmd -- * * Implements [info object class $objName ?$className?] * * ---------------------------------------------------------------------- */ static int InfoObjectClassCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName ?className?"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } if (objc == 2) { Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr->selfCls->thisPtr)); return TCL_OK; } else { Class *mixinPtr, *o2clsPtr; int i; o2clsPtr = GetClassFromObj(interp, objv[2]); if (o2clsPtr == NULL) { return TCL_ERROR; } FOREACH(mixinPtr, oPtr->mixins) { if (!mixinPtr) { continue; } if (TclOOIsReachable(o2clsPtr, mixinPtr)) { Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); return TCL_OK; } } Tcl_SetObjResult(interp, Tcl_NewIntObj( TclOOIsReachable(o2clsPtr, oPtr->selfCls))); return TCL_OK; } } /* * ---------------------------------------------------------------------- * * InfoObjectDefnCmd -- * * Implements [info object definition $objName $methodName] * * ---------------------------------------------------------------------- */ static int InfoObjectDefnCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; Tcl_HashEntry *hPtr; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *resultObjs[2]; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName methodName"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } if (!oPtr->methodsPtr) { goto unknownMethod; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } } resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr)); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectFiltersCmd -- * * Implements [info object filters $objName] * * ---------------------------------------------------------------------- */ static int InfoObjectFiltersCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int i; Tcl_Obj *filterObj, *resultObj; Object *oPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "objName"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(filterObj, oPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectForwardCmd -- * * Implements [info object forward $objName $methodName] * * ---------------------------------------------------------------------- */ static int InfoObjectForwardCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; Tcl_HashEntry *hPtr; Tcl_Obj *prefixObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName methodName"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } if (!oPtr->methodsPtr) { goto unknownMethod; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "prefix argument list not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, prefixObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectIsACmd -- * * Implements [info object isa $category $objName ...] * * ---------------------------------------------------------------------- */ static int InfoObjectIsACmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *const categories[] = { "class", "metaclass", "mixin", "object", "typeof", NULL }; enum IsACats { IsClass, IsMetaclass, IsMixin, IsObject, IsType }; Object *oPtr, *o2Ptr; int idx, i, result = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0, &idx) != TCL_OK) { return TCL_ERROR; } /* * Now we know what test we are doing, we can check we've got the right * number of arguments. */ switch ((enum IsACats) idx) { case IsObject: case IsClass: case IsMetaclass: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "objName"); return TCL_ERROR; } break; case IsMixin: case IsType: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "objName className"); return TCL_ERROR; } break; } /* * Perform the check. Note that we can guarantee that we will not fail * from here on; "failures" result in a false-TCL_OK result. */ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); if (oPtr == NULL) { goto failPrecondition; } switch ((enum IsACats) idx) { case IsObject: result = 1; break; case IsClass: result = (oPtr->classPtr != NULL); break; case IsMetaclass: if (oPtr->classPtr != NULL) { result = TclOOIsReachable(TclOOGetFoundation(interp)->classCls, oPtr->classPtr); } break; case IsMixin: o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]); if (o2Ptr == NULL) { goto failPrecondition; } if (o2Ptr->classPtr != NULL) { Class *mixinPtr; FOREACH(mixinPtr, oPtr->mixins) { if (!mixinPtr) { continue; } if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) { result = 1; break; } } } break; case IsType: o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]); if (o2Ptr == NULL) { goto failPrecondition; } if (o2Ptr->classPtr != NULL) { result = TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls); } break; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; failPrecondition: Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectMethodsCmd -- * * Implements [info object methods $objName ?$option ...?] * * ---------------------------------------------------------------------- */ static int InfoObjectMethodsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; int flag = PUBLIC_METHOD, recurse = 0; FOREACH_HASH_DECLS; Tcl_Obj *namePtr, *resultObj; Method *mPtr; static const char *const options[] = { "-all", "-localprivate", "-private", NULL }; enum Options { OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } if (objc != 2) { int i, idx; for (i=2 ; i 0) { ckfree(names); } } else if (oPtr->methodsPtr) { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectMethodTypeCmd -- * * Implements [info object methodtype $objName $methodName] * * ---------------------------------------------------------------------- */ static int InfoObjectMethodTypeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; Tcl_HashEntry *hPtr; Method *mPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName methodName"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } if (!oPtr->methodsPtr) { goto unknownMethod; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } mPtr = Tcl_GetHashValue(hPtr); if (mPtr->typePtr == NULL) { /* * Special entry for visibility control: pretend the method doesnt * exist. */ goto unknownMethod; } Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectMixinsCmd -- * * Implements [info object mixins $objName] * * ---------------------------------------------------------------------- */ static int InfoObjectMixinsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *mixinPtr; Object *oPtr; Tcl_Obj *resultObj; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "objName"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->mixins) { if (!mixinPtr) { continue; } Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectNsCmd -- * * Implements [info object namespace $objName] * * ---------------------------------------------------------------------- */ static int InfoObjectNsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "objName"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectVariablesCmd -- * * Implements [info object variables $objName] * * ---------------------------------------------------------------------- */ static int InfoObjectVariablesCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; Tcl_Obj *variableObj, *resultObj; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "objName"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(variableObj, oPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectVarsCmd -- * * Implements [info object vars $objName ?$pattern?] * * ---------------------------------------------------------------------- */ static int InfoObjectVarsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; const char *pattern = NULL; FOREACH_HASH_DECLS; VarInHash *vihPtr; Tcl_Obj *nameObj, *resultObj; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName ?pattern?"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } if (objc == 3) { pattern = TclGetString(objv[2]); } TclNewObj(resultObj); /* * Extract the information we need from the object's namespace's table of * variables. Note that this involves horrific knowledge of the guts of * tclVar.c, so we can't leverage our hash-iteration macros properly. */ FOREACH_HASH_VALUE(vihPtr, &((Namespace *) oPtr->namespacePtr)->varTable.table) { nameObj = vihPtr->entry.key.objPtr; if (TclIsVarUndefined(&vihPtr->var) || !TclIsVarNamespaceVar(&vihPtr->var)) { continue; } if (pattern != NULL && !Tcl_StringMatch(TclGetString(nameObj), pattern)) { continue; } Tcl_ListObjAppendElement(NULL, resultObj, nameObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassConstrCmd -- * * Implements [info class constructor $clsName] * * ---------------------------------------------------------------------- */ static int InfoClassConstrCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *resultObjs[2]; Class *clsPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } if (clsPtr->constructorPtr == NULL) { return TCL_OK; } procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL); return TCL_ERROR; } TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } } resultObjs[1] = TclOOGetMethodBody(clsPtr->constructorPtr); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassDefnCmd -- * * Implements [info class definition $clsName $methodName] * * ---------------------------------------------------------------------- */ static int InfoClassDefnCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_HashEntry *hPtr; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *resultObjs[2]; Class *clsPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className methodName"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } } resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr)); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassDestrCmd -- * * Implements [info class destructor $clsName] * * ---------------------------------------------------------------------- */ static int InfoClassDestrCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Proc *procPtr; Class *clsPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } if (clsPtr->destructorPtr == NULL) { return TCL_OK; } procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassFiltersCmd -- * * Implements [info class filters $clsName] * * ---------------------------------------------------------------------- */ static int InfoClassFiltersCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int i; Tcl_Obj *filterObj, *resultObj; Class *clsPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(filterObj, clsPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassForwardCmd -- * * Implements [info class forward $clsName $methodName] * * ---------------------------------------------------------------------- */ static int InfoClassForwardCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_HashEntry *hPtr; Tcl_Obj *prefixObj; Class *clsPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className methodName"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "prefix argument list not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, prefixObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassInstancesCmd -- * * Implements [info class instances $clsName ?$pattern?] * * ---------------------------------------------------------------------- */ static int InfoClassInstancesCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; Class *clsPtr; int i; const char *pattern = NULL; Tcl_Obj *resultObj; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } if (objc == 3) { pattern = TclGetString(objv[2]); } TclNewObj(resultObj); FOREACH(oPtr, clsPtr->instances) { Tcl_Obj *tmpObj = TclOOObjectName(interp, oPtr); if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) { continue; } Tcl_ListObjAppendElement(NULL, resultObj, tmpObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassMethodsCmd -- * * Implements [info class methods $clsName ?-private?] * * ---------------------------------------------------------------------- */ static int InfoClassMethodsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int flag = PUBLIC_METHOD, recurse = 0; Tcl_Obj *namePtr, *resultObj; Method *mPtr; Class *clsPtr; static const char *const options[] = { "-all", "-localprivate", "-private", NULL }; enum Options { OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } if (objc != 2) { int i, idx; for (i=2 ; i 0) { ckfree(names); } } else { FOREACH_HASH_DECLS; FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassMethodTypeCmd -- * * Implements [info class methodtype $clsName $methodName] * * ---------------------------------------------------------------------- */ static int InfoClassMethodTypeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_HashEntry *hPtr; Method *mPtr; Class *clsPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className methodName"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } mPtr = Tcl_GetHashValue(hPtr); if (mPtr->typePtr == NULL) { /* * Special entry for visibility control: pretend the method doesnt * exist. */ goto unknownMethod; } Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1)); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassMixinsCmd -- * * Implements [info class mixins $clsName] * * ---------------------------------------------------------------------- */ static int InfoClassMixinsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr, *mixinPtr; Tcl_Obj *resultObj; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(mixinPtr, clsPtr->mixins) { if (!mixinPtr) { continue; } Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassSubsCmd -- * * Implements [info class subclasses $clsName ?$pattern?] * * ---------------------------------------------------------------------- */ static int InfoClassSubsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr, *subclassPtr; Tcl_Obj *resultObj; int i; const char *pattern = NULL; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } if (objc == 3) { pattern = TclGetString(objv[2]); } TclNewObj(resultObj); FOREACH(subclassPtr, clsPtr->subclasses) { Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr); if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) { continue; } Tcl_ListObjAppendElement(NULL, resultObj, tmpObj); } FOREACH(subclassPtr, clsPtr->mixinSubs) { Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr); if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) { continue; } Tcl_ListObjAppendElement(NULL, resultObj, tmpObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassSupersCmd -- * * Implements [info class superclasses $clsName] * * ---------------------------------------------------------------------- */ static int InfoClassSupersCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr, *superPtr; Tcl_Obj *resultObj; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(superPtr, clsPtr->superclasses) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, superPtr->thisPtr)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassVariablesCmd -- * * Implements [info class variables $clsName] * * ---------------------------------------------------------------------- */ static int InfoClassVariablesCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr; Tcl_Obj *variableObj, *resultObj; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); FOREACH(variableObj, clsPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoObjectCallCmd -- * * Implements [info object call $objName $methodName] * * ---------------------------------------------------------------------- */ static int InfoObjectCallCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; CallContext *contextPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName methodName"); return TCL_ERROR; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } /* * Get the call context and render its call chain. */ contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL); if (contextPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot construct any call chain", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, contextPtr->callPtr)); TclOODeleteContext(contextPtr); return TCL_OK; } /* * ---------------------------------------------------------------------- * * InfoClassCallCmd -- * * Implements [info class call $clsName $methodName] * * ---------------------------------------------------------------------- */ static int InfoClassCallCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr; CallChain *callPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className methodName"); return TCL_ERROR; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } /* * Get an render the stereotypical call chain. */ callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD); if (callPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot construct any call chain", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr)); TclOODeleteChain(callPtr); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOOIntDecls.h0000644000175000017500000001601014566153373016103 0ustar sergeisergei/* * This file is (mostly) automatically generated from tclOO.decls. */ #ifndef _TCLOOINTDECLS #define _TCLOOINTDECLS /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ /* 0 */ TCLAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); /* 1 */ TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */ TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 3 */ TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 5 */ TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 6 */ TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr); /* 7 */ TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ TCLAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 9 */ TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 12 */ TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 14 */ TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins, Class *const *mixins); /* 15 */ TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); typedef struct TclOOIntStubs { int magic; void *hooks; Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */ Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */ Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */ Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */ Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */ Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */ Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */ void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */ void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */ void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */ } TclOOIntStubs; extern const TclOOIntStubs *tclOOIntStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCLOO_STUBS) /* * Inline function declarations: */ #define TclOOGetDefineCmdContext \ (tclOOIntStubsPtr->tclOOGetDefineCmdContext) /* 0 */ #define TclOOMakeProcInstanceMethod \ (tclOOIntStubsPtr->tclOOMakeProcInstanceMethod) /* 1 */ #define TclOOMakeProcMethod \ (tclOOIntStubsPtr->tclOOMakeProcMethod) /* 2 */ #define TclOONewProcInstanceMethod \ (tclOOIntStubsPtr->tclOONewProcInstanceMethod) /* 3 */ #define TclOONewProcMethod \ (tclOOIntStubsPtr->tclOONewProcMethod) /* 4 */ #define TclOOObjectCmdCore \ (tclOOIntStubsPtr->tclOOObjectCmdCore) /* 5 */ #define TclOOIsReachable \ (tclOOIntStubsPtr->tclOOIsReachable) /* 6 */ #define TclOONewForwardMethod \ (tclOOIntStubsPtr->tclOONewForwardMethod) /* 7 */ #define TclOONewForwardInstanceMethod \ (tclOOIntStubsPtr->tclOONewForwardInstanceMethod) /* 8 */ #define TclOONewProcInstanceMethodEx \ (tclOOIntStubsPtr->tclOONewProcInstanceMethodEx) /* 9 */ #define TclOONewProcMethodEx \ (tclOOIntStubsPtr->tclOONewProcMethodEx) /* 10 */ #define TclOOInvokeObject \ (tclOOIntStubsPtr->tclOOInvokeObject) /* 11 */ #define TclOOObjectSetFilters \ (tclOOIntStubsPtr->tclOOObjectSetFilters) /* 12 */ #define TclOOClassSetFilters \ (tclOOIntStubsPtr->tclOOClassSetFilters) /* 13 */ #define TclOOObjectSetMixins \ (tclOOIntStubsPtr->tclOOObjectSetMixins) /* 14 */ #define TclOOClassSetMixins \ (tclOOIntStubsPtr->tclOOClassSetMixins) /* 15 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLOOINTDECLS */ tcl8.6.14/generic/tclOOInt.h0000644000175000017500000005612414554262142015132 0ustar sergeisergei/* * tclOOInt.h -- * * This file contains the structure definitions and some of the function * declarations for the object-system (NB: not Tcl_Obj, but ::oo). * * Copyright (c) 2006-2012 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef TCL_OO_INTERNAL_H #define TCL_OO_INTERNAL_H 1 #include "tclInt.h" #include "tclOO.h" /* * Hack to make things work with Objective C. Note that ObjC isn't really * supported, but we don't want to to be actively hostile to it. [Bug 2163447] */ #ifdef __OBJC__ #define Class TclOOClass #define Object TclOOObject #endif /* __OBJC__ */ /* * Forward declarations. */ struct CallChain; struct Class; struct Foundation; struct Object; /* * The data that needs to be stored per method. This record is used to collect * information about all sorts of methods, including forwards, constructors * and destructors. */ typedef struct Method { const Tcl_MethodType *typePtr; /* The type of method. If NULL, this is a * special flag record which is just used for * the setting of the flags field. */ int refCount; void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; /* The object that declares this method, or * NULL if it was declared by a class. */ struct Class *declaringClassPtr; /* The class that declares this method, or * NULL if it was declared directly on an * object. */ int flags; /* Assorted flags. Includes whether this * method is public/exported or not. */ } Method; /* * Pre- and post-call callbacks, to allow procedure-like methods to be fine * tuned in their behaviour. */ typedef int (TclOO_PreCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished); typedef int (TclOO_PostCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result); typedef void (TclOO_PmCDDeleteProc)(void *clientData); typedef void *(TclOO_PmCDCloneProc)(void *clientData); /* * Procedure-like methods have the following extra information. */ typedef struct ProcedureMethod { int version; /* Version of this structure. Currently must * be 0. */ Proc *procPtr; /* Core of the implementation of the method; * includes the argument definition and the * body bytecodes. */ int flags; /* Flags to control features. */ int refCount; void *clientData; TclOO_PmCDDeleteProc *deleteClientdataProc; TclOO_PmCDCloneProc *cloneClientdataProc; ProcErrorProc *errProc; /* Replacement error handler. */ TclOO_PreCallProc *preCallProc; /* Callback to allow for additional setup * before the method executes. */ TclOO_PostCallProc *postCallProc; /* Callback to allow for additional cleanup * after the method executes. */ GetFrameInfoValueProc *gfivProc; /* Callback to allow for fine tuning of how * the method reports itself. */ } ProcedureMethod; #define TCLOO_PROCEDURE_METHOD_VERSION 0 /* * Flags for use in a ProcedureMethod. * * When the USE_DECLARER_NS flag is set, the method will use the namespace of * the object or class that declared it (or the clone of it, if it was from * such that the implementation of the method came to the particular use) * instead of the namespace of the object on which the method was invoked. * This flag must be distinct from all others that are associated with * methods. */ #define USE_DECLARER_NS 0x80 /* * Forwarded methods have the following extra information. */ typedef struct ForwardMethod { Tcl_Obj *prefixObj; /* The list of values to use to replace the * object and method name with. Will be a * non-empty list. */ } ForwardMethod; /* * Helper definitions that declare a "list" array. The two varieties are * either optimized for simplicity (in the case that the whole array is * typically assigned at once) or efficiency (in the case that the array is * expected to be expanded over time). These lists are designed to be iterated * over with the help of the FOREACH macro (see later in this file). * * The "num" field always counts the number of listType_t elements used in the * "list" field. When a "size" field exists, it describes how many elements * are present in the list; when absent, exactly "num" elements are present. */ #define LIST_STATIC(listType_t) \ struct { int num; listType_t *list; } #define LIST_DYNAMIC(listType_t) \ struct { int num, size; listType_t *list; } /* * Now, the definition of what an object actually is. */ typedef struct Object { struct Foundation *fPtr; /* The basis for the object system. Putting * this here allows the avoidance of quite a * lot of hash lookups on the critical path * for object invocation and creation. */ Tcl_Namespace *namespacePtr;/* This object's namespace. */ Tcl_Command command; /* Reference to this object's public * command. */ Tcl_Command myCommand; /* Reference to this object's internal * command. */ struct Class *selfCls; /* This object's class. */ Tcl_HashTable *methodsPtr; /* Object-local Tcl_Obj (method name) to * Method* mapping. */ LIST_STATIC(struct Class *) mixins; /* Classes mixed into this object. */ LIST_STATIC(Tcl_Obj *) filters; /* List of filter names. */ struct Class *classPtr; /* This is non-NULL for all classes, and NULL * for everything else. It points to the class * structure. */ int refCount; /* Number of strong references to this object. * Note that there may be many more weak * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; int creationEpoch; /* Unique value to make comparisons of objects * easier. */ int epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to * the ClientData values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ Tcl_Obj *cachedNameObj; /* Cache of the name of the object. */ Tcl_HashTable *chainCache; /* Place to keep unused contexts. This table * is indexed by method name as Tcl_Obj. */ Tcl_ObjectMapMethodNameProc *mapMethodNameProc; /* Function to allow remapping of method * names. For itcl-ng. */ LIST_STATIC(Tcl_Obj *) variables; } Object; #define OBJECT_DESTRUCTING 1 /* Indicates that an object is being or has * been destroyed */ #define DESTRUCTOR_CALLED 2 /* Indicates that evaluation of destructor script for the object has began */ #define OO_UNUSED_4 4 /* No longer used. */ #define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of * the class hierarchy and should be treated * specially during teardown. */ #define FILTER_HANDLING 0x2000 /* Flag set when the object is processing a * filter; when set, filters are *not* * processed on the object, preventing nasty * recursive filtering problems. */ #define USE_CLASS_CACHE 0x4000 /* Flag set to say that the object is a pure * instance of the class, and has had nothing * added that changes the dispatch chain (i.e. * no methods, mixins, or filters. */ #define ROOT_CLASS 0x8000 /* Flag to say that this object is the root * class of classes, and should be treated * specially during teardown (and in a few * other spots). */ #define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the * unknown method handler at that point. */ #define DONT_DELETE 0x20000 /* Inhibit deletion of this object. */ /* * And the definition of a class. Note that every class also has an associated * object, through which it is manipulated. */ typedef struct Class { Object *thisPtr; /* Reference to the object associated with * this class. */ int flags; /* Assorted flags. */ LIST_STATIC(struct Class *) superclasses; /* List of superclasses, used for generation * of method call chains. */ LIST_DYNAMIC(struct Class *) subclasses; /* List of subclasses, used to ensure deletion * of dependent entities happens properly when * the class itself is deleted. */ LIST_DYNAMIC(Object *) instances; /* List of instances, used to ensure deletion * of dependent entities happens properly when * the class itself is deleted. */ LIST_STATIC(Tcl_Obj *) filters; /* List of filter names, used for generation * of method call chains. */ LIST_STATIC(struct Class *) mixins; /* List of mixin classes, used for generation * of method call chains. */ LIST_DYNAMIC(struct Class *) mixinSubs; /* List of classes that this class is mixed * into, used to ensure deletion of dependent * entities happens properly when the class * itself is deleted. */ Tcl_HashTable classMethods; /* Hash table of all methods. Hash maps from * the (Tcl_Obj*) method name to the (Method*) * method record. */ Method *constructorPtr; /* Method record of the class constructor (if * any). */ Method *destructorPtr; /* Method record of the class destructor (if * any). */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to * the ClientData values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ struct CallChain *constructorChainPtr; struct CallChain *destructorChainPtr; Tcl_HashTable *classChainCache; /* Places where call chains are stored. For * constructors, the class chain is always * used. For destructors and ordinary methods, * the class chain is only used when the * object doesn't override with its own mixins * (and filters and method implementations for * when getting method chains). */ LIST_STATIC(Tcl_Obj *) variables; } Class; /* * The foundation of the object system within an interpreter contains * references to the key classes and namespaces, together with a few other * useful bits and pieces. Probably ought to eventually go in the Interp * structure itself. */ typedef struct ThreadLocalData { int nsCount; /* Epoch counter is used for keeping * the values used in Tcl_Obj internal * representations sane. Must be thread-local * because Tcl_Objs can cross interpreter * boundaries within a thread (objects don't * generally cross threads). */ } ThreadLocalData; typedef struct Foundation { Tcl_Interp *interp; Class *objectCls; /* The root of the object system. */ Class *classCls; /* The class of all classes. */ Tcl_Namespace *ooNs; /* ::oo namespace. */ Tcl_Namespace *defineNs; /* Namespace containing special commands for * manipulating objects and classes. The * "oo::define" command acts as a special kind * of ensemble for this namespace. */ Tcl_Namespace *objdefNs; /* Namespace containing special commands for * manipulating objects and classes. The * "oo::objdefine" command acts as a special * kind of ensemble for this namespace. */ Tcl_Namespace *helpersNs; /* Namespace containing the commands that are * only valid when executing inside a * procedural method. */ int epoch; /* Used to invalidate method chains when the * class structure changes. */ ThreadLocalData *tsdPtr; /* Counter so we can allocate a unique * namespace to each object. */ Tcl_Obj *unknownMethodNameObj; /* Shared object containing the name of the * unknown method handler method. */ Tcl_Obj *constructorName; /* Shared object containing the "name" of a * constructor. */ Tcl_Obj *destructorName; /* Shared object containing the "name" of a * destructor. */ Tcl_Obj *clonedName; /* Shared object containing the name of a * "" pseudo-constructor. */ Tcl_Obj *defineName; /* Fully qualified name of oo::define. */ } Foundation; /* * A call context structure is built when a method is called. It contains the * chain of method implementations that are to be invoked by a particular * call, and the process of calling walks the chain, with the [next] command * proceeding to the next entry in the chain. */ #define CALL_CHAIN_STATIC_SIZE 4 struct MInvoke { Method *mPtr; /* Reference to the method implementation * record. */ int isFilter; /* Whether this is a filter invocation. */ Class *filterDeclarer; /* What class decided to add the filter; if * NULL, it was added by the object. */ }; typedef struct CallChain { int objectCreationEpoch; /* The object's creation epoch. Note that the * object reference is not stored in the call * chain; it is in the call context. */ int objectEpoch; /* Local (object structure) epoch counter * snapshot. */ int epoch; /* Global (class structure) epoch counter * snapshot. */ int flags; /* Assorted flags, see below. */ int refCount; /* Reference count. */ int numChain; /* Size of the call chain. */ struct MInvoke *chain; /* Array of call chain entries. May point to * staticChain if the number of entries is * small. */ struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE]; } CallChain; typedef struct CallContext { Object *oPtr; /* The object associated with this call. */ int index; /* Index into the call chain of the currently * executing method implementation. */ int skip; /* Current number of arguments to skip; can * vary depending on whether it is a direct * method call or a continuation via the * [next] command. */ CallChain *callPtr; /* The actual call chain. */ } CallContext; /* * Bits for the 'flags' field of the call chain. */ #define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */ #define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances * only) method. Supports itcl. */ #define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */ #define CONSTRUCTOR 0x08 /* This is a constructor. */ #define DESTRUCTOR 0x10 /* This is a destructor. */ /* * Structure containing definition information about basic class methods. */ typedef struct { const char *name; /* Name of the method in question. */ int isPublic; /* Whether the method is public by default. */ Tcl_MethodType definition; /* How to call the method. */ } DeclaredClassMethod; /* *---------------------------------------------------------------- * Commands relating to OO support. *---------------------------------------------------------------- */ MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE int TclOODefineObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOOObjDefObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineConstructorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineDestructorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineExportObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineForwardObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineRenameMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineUnexportObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineClassObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOOUnknownDefinition(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOOCopyObjectCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOONextObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOONextToObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOOSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); /* * Method implementations (in tclOOBasic.c). */ MODULE_SCOPE int TclOO_Class_Constructor(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Class_Create(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Class_CreateNs(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Class_New(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Object_Destroy(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Object_Eval(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Object_LinkVar(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Object_Unknown(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Object_VarName(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); /* * Private definitions, some of which perhaps ought to be exposed properly or * maybe just put in the internal stubs table. */ MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr); MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr); MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, Object *useThisObj); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip, Tcl_Object *objectPtr); MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, const char *nameStr, const char *nsNameStr); MODULE_SCOPE int TclOODecrRefCount(Object *oPtr); MODULE_SCOPE int TclOOObjectDestroyed(Object *oPtr); MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr); MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr); MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr); MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr); MODULE_SCOPE void TclOODeleteDescendants(Tcl_Interp *interp, Object *oPtr); MODULE_SCOPE void TclOODelMethodRef(Method *method); MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr, Tcl_Obj *methodNameObj, int flags, Tcl_Obj *cacheInThisObj); MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr, Tcl_Obj *methodNameObj, int flags); MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclOOGetFwdFromMethod(Method *mPtr); MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr); MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr); MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); MODULE_SCOPE int TclOOInvokeContext(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr, const DeclaredClassMethod *dcm); MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr); MODULE_SCOPE void TclOOReleaseClassContents(Tcl_Interp *interp, Object *oPtr); MODULE_SCOPE int TclOORemoveFromInstances(Object *oPtr, Class *clsPtr); MODULE_SCOPE int TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr); MODULE_SCOPE int TclOORemoveFromMixinSubs(Class *subPtr, Class *mixinPtr); MODULE_SCOPE int TclOORemoveFromSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp, CallChain *callPtr); MODULE_SCOPE void TclOOStashContext(Tcl_Obj *objPtr, CallContext *contextPtr); MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); /* * Include all the private API, generated from tclOO.decls. */ #include "tclOOIntDecls.h" /* * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release. */ #define AddRef(ptr) ((ptr)->refCount++) /* * A convenience macro for iterating through the lists used in the internal * memory management of objects. * REQUIRES DECLARATION: int i; */ #define FOREACH(var,ary) \ for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \ continue; \ } else if ((var) = (ary).list[i], 1) /* * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS * sets up the declarations needed for the main macro, FOREACH_HASH, which * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that * only iterates over values. */ #define FOREACH_HASH_DECLS \ Tcl_HashEntry *hPtr;Tcl_HashSearch search #define FOREACH_HASH(key,val,tablePtr) \ for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\ (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search)) #define FOREACH_HASH_VALUE(val,tablePtr) \ for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ ((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search)) /* * Convenience macro for duplicating a list. Needs no external declaration, * but all arguments are used multiple times and so must have no side effects. */ #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ #define DUPLICATE(target,source,type) \ do { \ size_t len = sizeof(type) * ((target).num=(source).num);\ if (len != 0) { \ memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \ } else { \ (target).list = NULL; \ } \ } while(0) #endif /* TCL_OO_INTERNAL_H */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOOMethod.c0000644000175000017500000014670514554262142015620 0ustar sergeisergei/* * tclOOMethod.c -- * * This file contains code to create and manage methods. * * Copyright (c) 2005-2011 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" #include "tclCompile.h" /* * Structure used to help delay computing names of objects or classes for * [info frame] until needed, making invocation faster in the normal case. */ struct PNI { Tcl_Interp *interp; /* Interpreter in which to compute the name of * a method. */ Tcl_Method method; /* Method to compute the name of. */ }; /* * Structure used to contain all the information needed about a call frame * used in a procedure-like method. */ typedef struct { CallFrame *framePtr; /* Reference to the call frame itself (it's * actually allocated on the Tcl stack). */ ProcErrorProc *errProc; /* The error handler for the body. */ Tcl_Obj *nameObj; /* The "name" of the command. */ Command cmd; /* The command structure. Mostly bogus. */ ExtraFrameInfo efi; /* Extra information used for [info frame]. */ Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a * recursive call returns. */ struct PNI pni; /* Specialist information used in the efi * field for this type of call. */ } PMFrameData; /* * Structure used to pass information about variable resolution to the * on-the-ground resolvers used when working with resolved compiled variables. */ typedef struct { Tcl_ResolvedVarInfo info; /* "Type" information so that the compiled * variable can be linked to the namespace * variable at the right time. */ Tcl_Obj *variableObj; /* The name of the variable. */ Tcl_Var cachedObjectVar; /* TODO: When to flush this cache? Can class * variables be cached? */ } OOResVarInfo; /* * Function declarations for things defined in this file. */ static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int toRewrite, int rewriteLength, Tcl_Obj *const *rewriteObjs, int *lengthPtr); static int InvokeProcedureMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static Tcl_NRPostProc FinalizeForwardCall; static Tcl_NRPostProc FinalizePMCall; static int PushMethodCallFrame(Tcl_Interp *interp, CallContext *contextPtr, ProcedureMethod *pmPtr, int objc, Tcl_Obj *const *objv, PMFrameData *fdPtr); static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr); static void DeleteProcedureMethod(void *clientData); static int CloneProcedureMethod(Tcl_Interp *interp, void *clientData, void **newClientData); static void MethodErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void ConstructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void DestructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); static Tcl_Obj * RenderDeclarerName(void *clientData); static int InvokeForwardMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static void DeleteForwardMethod(void *clientData); static int CloneForwardMethod(Tcl_Interp *interp, void *clientData, void **newClientData); static int ProcedureMethodVarResolver(Tcl_Interp *interp, const char *varName, Tcl_Namespace *contextNs, int flags, Tcl_Var *varPtr); static int ProcedureMethodCompiledVarResolver(Tcl_Interp *interp, const char *varName, int length, Tcl_Namespace *contextNs, Tcl_ResolvedVarInfo **rPtrPtr); /* * The types of methods defined by the core OO system. */ static const Tcl_MethodType procMethodType = { TCL_OO_METHOD_VERSION_CURRENT, "method", InvokeProcedureMethod, DeleteProcedureMethod, CloneProcedureMethod }; static const Tcl_MethodType fwdMethodType = { TCL_OO_METHOD_VERSION_CURRENT, "forward", InvokeForwardMethod, DeleteForwardMethod, CloneForwardMethod }; /* * Helper macros (derived from things private to tclVar.c) */ #define TclVarTable(contextNs) \ ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry))) /* * ---------------------------------------------------------------------- * * Tcl_NewInstanceMethod -- * * Attach a method to an object instance. * * ---------------------------------------------------------------------- */ Tcl_Method Tcl_NewInstanceMethod( Tcl_Interp *interp, /* Unused? */ Tcl_Object object, /* The object that has the method attached to * it. */ Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so, * up to caller to manage storage (e.g., when * it is a constructor or destructor). */ int flags, /* Whether this is a public method. */ const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { Object *oPtr = (Object *) object; Method *mPtr; Tcl_HashEntry *hPtr; int isNew; if (nameObj == NULL) { mPtr = (Method *)ckalloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } if (!oPtr->methodsPtr) { oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew); if (isNew) { mPtr = (Method *)ckalloc(sizeof(Method)); mPtr->namePtr = nameObj; mPtr->refCount = 1; Tcl_IncrRefCount(nameObj); Tcl_SetHashValue(hPtr, mPtr); } else { mPtr = (Method *)Tcl_GetHashValue(hPtr); if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) { mPtr->typePtr->deleteProc(mPtr->clientData); } } populate: mPtr->typePtr = typePtr; mPtr->clientData = clientData; mPtr->flags = 0; mPtr->declaringObjectPtr = oPtr; mPtr->declaringClassPtr = NULL; if (flags) { mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD); } oPtr->epoch++; return (Tcl_Method) mPtr; } /* * ---------------------------------------------------------------------- * * Tcl_NewMethod -- * * Attach a method to a class. * * ---------------------------------------------------------------------- */ Tcl_Method Tcl_NewMethod( Tcl_Interp *interp, /* The interpreter containing the class. */ Tcl_Class cls, /* The class to attach the method to. */ Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., * for constructors or destructors); if so, up * to caller to manage storage. */ int flags, /* Whether this is a public method. */ const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { Class *clsPtr = (Class *) cls; Method *mPtr; Tcl_HashEntry *hPtr; int isNew; if (nameObj == NULL) { mPtr = (Method *)ckalloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew); if (isNew) { mPtr = (Method *)ckalloc(sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = nameObj; Tcl_IncrRefCount(nameObj); Tcl_SetHashValue(hPtr, mPtr); } else { mPtr = (Method *)Tcl_GetHashValue(hPtr); if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) { mPtr->typePtr->deleteProc(mPtr->clientData); } } populate: clsPtr->thisPtr->fPtr->epoch++; mPtr->typePtr = typePtr; mPtr->clientData = clientData; mPtr->flags = 0; mPtr->declaringObjectPtr = NULL; mPtr->declaringClassPtr = clsPtr; if (flags) { mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD); } return (Tcl_Method) mPtr; } /* * ---------------------------------------------------------------------- * * TclOODelMethodRef -- * * How to delete a method. * * ---------------------------------------------------------------------- */ void TclOODelMethodRef( Method *mPtr) { if ((mPtr != NULL) && (mPtr->refCount-- <= 1)) { if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) { mPtr->typePtr->deleteProc(mPtr->clientData); } if (mPtr->namePtr != NULL) { Tcl_DecrRefCount(mPtr->namePtr); } ckfree(mPtr); } } /* * ---------------------------------------------------------------------- * * TclOONewBasicMethod -- * * Helper that makes it cleaner to create very simple methods during * basic system initialization. Not suitable for general use. * * ---------------------------------------------------------------------- */ void TclOONewBasicMethod( Tcl_Interp *interp, Class *clsPtr, /* Class to attach the method to. */ const DeclaredClassMethod *dcm) /* Name of the method, whether it is public, * and the function to implement it. */ { Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1); Tcl_IncrRefCount(namePtr); Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL); Tcl_DecrRefCount(namePtr); } /* * ---------------------------------------------------------------------- * * TclOONewProcInstanceMethod -- * * Create a new procedure-like method for an object. * * ---------------------------------------------------------------------- */ Method * TclOONewProcInstanceMethod( Tcl_Interp *interp, /* The interpreter containing the object. */ Object *oPtr, /* The object to modify. */ int flags, /* Whether this is a public method. */ Tcl_Obj *nameObj, /* The name of the method, which must not be * NULL. */ Tcl_Obj *argsObj, /* The formal argument list for the method, * which must not be NULL. */ Tcl_Obj *bodyObj, /* The body of the method, which must not be * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; ProcedureMethod *pmPtr; Tcl_Method method; if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; pmPtr->refCount = 1; method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (method == NULL) { ckfree(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } return (Method *) method; } /* * ---------------------------------------------------------------------- * * TclOONewProcMethod -- * * Create a new procedure-like method for a class. * * ---------------------------------------------------------------------- */ Method * TclOONewProcMethod( Tcl_Interp *interp, /* The interpreter containing the class. */ Class *clsPtr, /* The class to modify. */ int flags, /* Whether this is a public method. */ Tcl_Obj *nameObj, /* The name of the method, which may be NULL; * if so, up to caller to manage storage * (e.g., because it is a constructor or * destructor). */ Tcl_Obj *argsObj, /* The formal argument list for the method, * which may be NULL; if so, it is equivalent * to an empty list. */ Tcl_Obj *bodyObj, /* The body of the method, which must not be * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; /* -1 => delete argsObj before exit */ ProcedureMethod *pmPtr; const char *procName; Tcl_Method method; if (argsObj == NULL) { argsLen = -1; TclNewObj(argsObj); Tcl_IncrRefCount(argsObj); procName = ""; } else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } else { procName = (nameObj==NULL ? "" : TclGetString(nameObj)); } pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; pmPtr->refCount = 1; method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (argsLen == -1) { Tcl_DecrRefCount(argsObj); } if (method == NULL) { ckfree(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } return (Method *) method; } /* * ---------------------------------------------------------------------- * * TclOOMakeProcInstanceMethod -- * * The guts of the code to make a procedure-like method for an object. * Split apart so that it is easier for other extensions to reuse (in * particular, it frees them from having to pry so deeply into Tcl's * guts). * * ---------------------------------------------------------------------- */ Tcl_Method TclOOMakeProcInstanceMethod( Tcl_Interp *interp, /* The interpreter containing the object. */ Object *oPtr, /* The object to modify. */ int flags, /* Whether this is a public method. */ Tcl_Obj *nameObj, /* The name of the method, which _must not_ be * NULL. */ Tcl_Obj *argsObj, /* The formal argument list for the method, * which _must not_ be NULL. */ Tcl_Obj *bodyObj, /* The body of the method, which _must not_ be * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the * pointer in clientData. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr; if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj, procPtrPtr) != TCL_OK) { return NULL; } procPtr = *procPtrPtr; procPtr->cmdPtr = NULL; if (iPtr->cmdFramePtr) { CmdFrame context = *iPtr->cmdFramePtr; if (context.type == TCL_LOCATION_BC) { /* * Retrieve source information from the bytecode, if possible. If * the information is retrieved successfully, context.type will be * TCL_LOCATION_SOURCE and the reference held by * context.data.eval.path will be counted. */ TclGetSrcInfoForPc(&context); } else if (context.type == TCL_LOCATION_SOURCE) { /* * The copy into 'context' up above has created another reference * to 'context.data.eval.path'; account for it. */ Tcl_IncrRefCount(context.data.eval.path); } if (context.type == TCL_LOCATION_SOURCE) { /* * We can account for source location within a proc only if the * proc body was not created by substitution. * (FIXME: check that this is sane and correct!) */ if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; cfPtr->line = (int *)ckalloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = context.data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); cfPtr->cmd = NULL; cfPtr->len = 0; hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew); Tcl_SetHashValue(hPtr, cfPtr); } /* * 'context' is going out of scope; account for the reference that * it's holding to the path name. */ Tcl_DecrRefCount(context.data.eval.path); context.data.eval.path = NULL; } } return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, typePtr, clientData); } /* * ---------------------------------------------------------------------- * * TclOOMakeProcMethod -- * * The guts of the code to make a procedure-like method for a class. * Split apart so that it is easier for other extensions to reuse (in * particular, it frees them from having to pry so deeply into Tcl's * guts). * * ---------------------------------------------------------------------- */ Tcl_Method TclOOMakeProcMethod( Tcl_Interp *interp, /* The interpreter containing the class. */ Class *clsPtr, /* The class to modify. */ int flags, /* Whether this is a public method. */ Tcl_Obj *nameObj, /* The name of the method, which may be NULL; * if so, up to caller to manage storage * (e.g., because it is a constructor or * destructor). */ const char *namePtr, /* The name of the method as a string, which * _must not_ be NULL. */ Tcl_Obj *argsObj, /* The formal argument list for the method, * which _must not_ be NULL. */ Tcl_Obj *bodyObj, /* The body of the method, which _must not_ be * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the * pointer in clientData. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr; if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj, procPtrPtr) != TCL_OK) { return NULL; } procPtr = *procPtrPtr; procPtr->cmdPtr = NULL; if (iPtr->cmdFramePtr) { CmdFrame context = *iPtr->cmdFramePtr; if (context.type == TCL_LOCATION_BC) { /* * Retrieve source information from the bytecode, if possible. If * the information is retrieved successfully, context.type will be * TCL_LOCATION_SOURCE and the reference held by * context.data.eval.path will be counted. */ TclGetSrcInfoForPc(&context); } else if (context.type == TCL_LOCATION_SOURCE) { /* * The copy into 'context' up above has created another reference * to 'context.data.eval.path'; account for it. */ Tcl_IncrRefCount(context.data.eval.path); } if (context.type == TCL_LOCATION_SOURCE) { /* * We can account for source location within a proc only if the * proc body was not created by substitution. * (FIXME: check that this is sane and correct!) */ if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; cfPtr->line = (int *)ckalloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = context.data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); cfPtr->cmd = NULL; cfPtr->len = 0; hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew); Tcl_SetHashValue(hPtr, cfPtr); } /* * 'context' is going out of scope; account for the reference that * it's holding to the path name. */ Tcl_DecrRefCount(context.data.eval.path); context.data.eval.path = NULL; } } return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr, clientData); } /* * ---------------------------------------------------------------------- * * InvokeProcedureMethod, PushMethodCallFrame -- * * How to invoke a procedure-like method. * * ---------------------------------------------------------------------- */ static int InvokeProcedureMethod( void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { ProcedureMethod *pmPtr = (ProcedureMethod *)clientData; int result; PMFrameData *fdPtr; /* Important data that has to have a lifetime * matched by this function (or rather, by the * call frame's lifetime). */ /* * If the object namespace (or interpreter) were deleted, we just skip to * the next thing in the chain. */ if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) || Tcl_InterpDeleted(interp) ) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } /* * Allocate the special frame data. */ fdPtr = (PMFrameData *)TclStackAlloc(interp, sizeof(PMFrameData)); /* * Create a call frame for this method. */ result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr, objc, objv, fdPtr); if (result != TCL_OK) { TclStackFree(interp, fdPtr); return result; } pmPtr->refCount++; /* * Give the pre-call callback a chance to do some setup and, possibly, * veto the call. */ if (pmPtr->preCallProc != NULL) { int isFinished; result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { /* * Restore the old cmdPtr so that a subsequent use of [info frame] * won't crash on us. [Bug 3001438] */ pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } TclStackFree(interp, fdPtr); return result; } } /* * Now invoke the body of the method. */ TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); return TclNRInterpProcCore(interp, fdPtr->nameObj, Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); } static int FinalizePMCall( void *data[], Tcl_Interp *interp, int result) { ProcedureMethod *pmPtr = (ProcedureMethod *)data[0]; Tcl_ObjectContext context = (Tcl_ObjectContext)data[1]; PMFrameData *fdPtr = (PMFrameData *)data[2]; /* * Give the post-call callback a chance to do some cleanup. Note that at * this point the call frame itself is invalid; it's already been popped. */ if (pmPtr->postCallProc) { result = pmPtr->postCallProc(pmPtr->clientData, interp, context, Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)), result); } /* * Restore the old cmdPtr so that a subsequent use of [info frame] won't * crash on us. [Bug 3001438] */ pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; /* * Scrap the special frame data now that we're done with it. Note that we * are inlining DeleteProcedureMethod() here; this location is highly * sensitive when it comes to performance! */ if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } TclStackFree(interp, fdPtr); return result; } static int PushMethodCallFrame( Tcl_Interp *interp, /* Current interpreter. */ CallContext *contextPtr, /* Current method call context. */ ProcedureMethod *pmPtr, /* Information about this procedure-like * method. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv, /* Array of arguments. */ PMFrameData *fdPtr) /* Place to store information about the call * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; int result; const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; /* * Compute basic information on the basis of the type of method it is. */ if (contextPtr->callPtr->flags & CONSTRUCTOR) { namePtr = ""; fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName; fdPtr->errProc = ConstructorErrorHandler; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { namePtr = ""; fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName; fdPtr->errProc = DestructorErrorHandler; } else { fdPtr->nameObj = Tcl_MethodName( Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr)); namePtr = TclGetString(fdPtr->nameObj); fdPtr->errProc = MethodErrorHandler; } if (pmPtr->errProc != NULL) { fdPtr->errProc = pmPtr->errProc; } /* * Magic to enable things like [incr Tcl], which wants methods to run in * their class's namespace. */ if (pmPtr->flags & USE_DECLARER_NS) { Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { nsPtr = (Namespace *) mPtr->declaringClassPtr->thisPtr->namespacePtr; } else { nsPtr = (Namespace *) mPtr->declaringObjectPtr->namespacePtr; } } /* * Save the old cmdPtr so that when this recursive call returns, we can * restore it. To do otherwise causes crashes in [info frame] after we * return from a recursive call. [Bug 3001438] */ fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr; /* * Compile the body. This operation may fail. */ fdPtr->efi.length = 2; memset(&fdPtr->cmd, 0, sizeof(Command)); fdPtr->cmd.nsPtr = nsPtr; fdPtr->cmd.clientData = &fdPtr->efi; pmPtr->procPtr->cmdPtr = &fdPtr->cmd; /* * [Bug 2037727] Always call TclProcCompileProc so that we check not only * that we have bytecode, but also that it remains valid. Note that we set * the namespace of the code here directly; this is a hack, but the * alternative is *so* slow... */ if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) { ByteCode *codePtr = pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; codePtr->nsPtr = nsPtr; } result = TclProcCompileProc(interp, pmPtr->procPtr, pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr); if (result != TCL_OK) { goto failureReturn; } /* * Make the stack frame and fill it out with information about this call. * This operation may fail. */ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD); fdPtr->framePtr->clientData = contextPtr; fdPtr->framePtr->objc = objc; fdPtr->framePtr->objv = objv; fdPtr->framePtr->procPtr = pmPtr->procPtr; /* * Finish filling out the extra frame info so that [info frame] works. */ fdPtr->efi.fields[0].name = "method"; fdPtr->efi.fields[0].proc = NULL; fdPtr->efi.fields[0].clientData = fdPtr->nameObj; if (pmPtr->gfivProc != NULL) { fdPtr->efi.fields[1].name = ""; fdPtr->efi.fields[1].proc = pmPtr->gfivProc; fdPtr->efi.fields[1].clientData = pmPtr; } else { Tcl_Method method = Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr); if (Tcl_MethodDeclarerObject(method) != NULL) { fdPtr->efi.fields[1].name = "object"; } else { fdPtr->efi.fields[1].name = "class"; } fdPtr->efi.fields[1].proc = RenderDeclarerName; fdPtr->efi.fields[1].clientData = &fdPtr->pni; fdPtr->pni.interp = interp; fdPtr->pni.method = method; } return TCL_OK; /* * Restore the old cmdPtr so that a subsequent use of [info frame] won't * crash on us. [Bug 3001438] */ failureReturn: pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; return result; } /* * ---------------------------------------------------------------------- * * TclOOSetupVariableResolver, etc. -- * * Variable resolution engine used to connect declared variables to local * variables used in methods. The compiled variable resolver is more * important, but both are needed as it is possible to have a variable * that is only referred to in ways that aren't compilable and we can't * force LVT presence. [TIP #320] * * ---------------------------------------------------------------------- */ void TclOOSetupVariableResolver( Tcl_Namespace *nsPtr) { Tcl_ResolverInfo info; Tcl_GetNamespaceResolvers(nsPtr, &info); if (info.compiledVarResProc == NULL) { Tcl_SetNamespaceResolvers(nsPtr, NULL, ProcedureMethodVarResolver, ProcedureMethodCompiledVarResolver); } } static int ProcedureMethodVarResolver( Tcl_Interp *interp, const char *varName, Tcl_Namespace *contextNs, int flags, Tcl_Var *varPtr) { int result; Tcl_ResolvedVarInfo *rPtr = NULL; result = ProcedureMethodCompiledVarResolver(interp, varName, strlen(varName), contextNs, &rPtr); if (result != TCL_OK) { return result; } *varPtr = rPtr->fetchProc(interp, rPtr); /* * Must not retain reference to resolved information. [Bug 3105999] */ rPtr->deleteProc(rPtr); return (*varPtr ? TCL_OK : TCL_CONTINUE); } static Tcl_Var ProcedureMethodCompiledVarConnect( Tcl_Interp *interp, Tcl_ResolvedVarInfo *rPtr) { OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr; Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; CallContext *contextPtr; Tcl_Obj *variableObj; Tcl_HashEntry *hPtr; int i, isNew, cacheIt, varLen, len; const char *match, *varName; /* * Check that the variable is being requested in a context that is also a * method call; if not (i.e. we're evaluating in the object's namespace or * in a procedure of that namespace) then we do nothing. */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { return NULL; } contextPtr = (CallContext *)framePtr->clientData; /* * If we've done the work before (in a comparable context) then reuse that * rather than performing resolution ourselves. */ if (infoPtr->cachedObjectVar) { return infoPtr->cachedObjectVar; } /* * Check if the variable is one we want to resolve at all (i.e. whether it * is in the list provided by the user). If not, we mustn't do anything * either. */ varName = TclGetStringFromObj(infoPtr->variableObj, &varLen); if (contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr != NULL) { FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr->variables) { match = TclGetStringFromObj(variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 0; goto gotMatch; } } } else { FOREACH(variableObj, contextPtr->oPtr->variables) { match = TclGetStringFromObj(variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 1; goto gotMatch; } } } return NULL; /* * It is a variable we want to resolve, so resolve it. */ gotMatch: hPtr = Tcl_CreateHashEntry(TclVarTable(contextPtr->oPtr->namespacePtr), (char *) variableObj, &isNew); if (isNew) { TclSetVarNamespaceVar((Var *) TclVarHashGetValue(hPtr)); } if (cacheIt) { infoPtr->cachedObjectVar = TclVarHashGetValue(hPtr); /* * We must keep a reference to the variable so everything will * continue to work correctly even if it is unset; being unset does * not end the life of the variable at this level. [Bug 3185009] */ VarHashRefCount(infoPtr->cachedObjectVar)++; } return TclVarHashGetValue(hPtr); } static void ProcedureMethodCompiledVarDelete( Tcl_ResolvedVarInfo *rPtr) { OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr; /* * Release the reference to the variable if we were holding it. */ if (infoPtr->cachedObjectVar) { VarHashRefCount(infoPtr->cachedObjectVar)--; TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL); } Tcl_DecrRefCount(infoPtr->variableObj); ckfree(infoPtr); } static int ProcedureMethodCompiledVarResolver( Tcl_Interp *interp, const char *varName, int length, Tcl_Namespace *contextNs, Tcl_ResolvedVarInfo **rPtrPtr) { OOResVarInfo *infoPtr; Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length); /* * Do not create resolvers for cases that contain namespace separators or * which look like array accesses. Both will lead us astray. */ if (strstr(Tcl_GetString(variableObj), "::") != NULL || Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) { Tcl_DecrRefCount(variableObj); return TCL_CONTINUE; } infoPtr = (OOResVarInfo *)ckalloc(sizeof(OOResVarInfo)); infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect; infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete; infoPtr->cachedObjectVar = NULL; infoPtr->variableObj = variableObj; Tcl_IncrRefCount(variableObj); *rPtrPtr = &infoPtr->info; return TCL_OK; } /* * ---------------------------------------------------------------------- * * RenderDeclarerName -- * * Returns the name of the entity (object or class) which declared a * method. Used for producing information for [info frame] in such a way * that the expensive part of this (generating the object or class name * itself) isn't done until it is needed. * * ---------------------------------------------------------------------- */ static Tcl_Obj * RenderDeclarerName( void *clientData) { struct PNI *pni = (struct PNI *)clientData; Tcl_Object object = Tcl_MethodDeclarerObject(pni->method); if (object == NULL) { object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method)); } return TclOOObjectName(pni->interp, (Object *) object); } /* * ---------------------------------------------------------------------- * * MethodErrorHandler, ConstructorErrorHandler, DestructorErrorHandler -- * * How to fill in the stack trace correctly upon error in various forms * of procedure-like methods. LIMIT is how long the inserted strings in * the error traces should get before being converted to have ellipses, * and ELLIPSIFY is a macro to do the conversion (with the help of a * %.*s%s format field). Note that ELLIPSIFY is only safe for use in * suitable formatting contexts. * * ---------------------------------------------------------------------- */ #define LIMIT 60 #define ELLIPSIFY(str,len) \ ((len) > LIMIT ? LIMIT : (len)), (str), ((len) > LIMIT ? "..." : "") static void MethodErrorHandler( Tcl_Interp *interp, Tcl_Obj *methodNameObj) { int nameLen, objectNameLen; CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const char *objectName, *kindName, *methodName = Tcl_GetStringFromObj(mPtr->namePtr, &nameLen); Object *declarerPtr; (void)methodNameObj;/* We pull the method name out of context instead of from argument */ if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; kindName = "object"; } else { if (mPtr->declaringClassPtr == NULL) { Tcl_Panic("method not declared in class or object"); } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" method \"%.*s%s\" line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp))); } static void ConstructorErrorHandler( Tcl_Interp *interp, Tcl_Obj *methodNameObj) { CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; int objectNameLen; (void)methodNameObj;/* Ignore. We know it is the constructor. */ if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; kindName = "object"; } else { if (mPtr->declaringClassPtr == NULL) { Tcl_Panic("method not declared in class or object"); } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" constructor line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp))); } static void DestructorErrorHandler( Tcl_Interp *interp, Tcl_Obj *methodNameObj) { CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; int objectNameLen; (void)methodNameObj; /* Ignore. We know it is the destructor. */ if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; kindName = "object"; } else { if (mPtr->declaringClassPtr == NULL) { Tcl_Panic("method not declared in class or object"); } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" destructor line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp))); } /* * ---------------------------------------------------------------------- * * DeleteProcedureMethod, CloneProcedureMethod -- * * How to delete and clone procedure-like methods. * * ---------------------------------------------------------------------- */ static void DeleteProcedureMethodRecord( ProcedureMethod *pmPtr) { TclProcDeleteProc(pmPtr->procPtr); if (pmPtr->deleteClientdataProc) { pmPtr->deleteClientdataProc(pmPtr->clientData); } ckfree(pmPtr); } static void DeleteProcedureMethod( void *clientData) { ProcedureMethod *pmPtr = (ProcedureMethod *)clientData; if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } } static int CloneProcedureMethod( Tcl_Interp *interp, void *clientData, void **newClientData) { ProcedureMethod *pmPtr = (ProcedureMethod *)clientData; ProcedureMethod *pm2Ptr; Tcl_Obj *bodyObj, *argsObj; CompiledLocal *localPtr; /* * Copy the argument list. */ TclNewObj(argsObj); for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, argsObj, argObj); } } /* * Must strip the internal representation in order to ensure that any * bound references to instance variables are removed. [Bug 3609693] */ bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr); Tcl_GetString(bodyObj); TclFreeIntRep(bodyObj); /* * Create the actual copy of the method record, manufacturing a new proc * record. */ pm2Ptr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; Tcl_IncrRefCount(argsObj); Tcl_IncrRefCount(bodyObj); if (TclCreateProc(interp, NULL, "", argsObj, bodyObj, &pm2Ptr->procPtr) != TCL_OK) { Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); ckfree(pm2Ptr); return TCL_ERROR; } Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); if (pmPtr->cloneClientdataProc) { pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData); } *newClientData = pm2Ptr; return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOONewForwardInstanceMethod -- * * Create a forwarded method for an object. * * ---------------------------------------------------------------------- */ Method * TclOONewForwardInstanceMethod( Tcl_Interp *interp, /* Interpreter for error reporting. */ Object *oPtr, /* The object to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; ForwardMethod *fmPtr; if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "method forward prefix must be non-empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, &fwdMethodType, fmPtr); } /* * ---------------------------------------------------------------------- * * TclOONewForwardMethod -- * * Create a new forwarded method for a class. * * ---------------------------------------------------------------------- */ Method * TclOONewForwardMethod( Tcl_Interp *interp, /* Interpreter for error reporting. */ Class *clsPtr, /* The class to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; ForwardMethod *fmPtr; if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "method forward prefix must be non-empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, &fwdMethodType, fmPtr); } /* * ---------------------------------------------------------------------- * * InvokeForwardMethod -- * * How to invoke a forwarded method. Works by doing some ensemble-like * command rearranging and then invokes some other Tcl command. * * ---------------------------------------------------------------------- */ static int InvokeForwardMethod( void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { CallContext *contextPtr = (CallContext *) context; ForwardMethod *fmPtr = (ForwardMethod *)clientData; Tcl_Obj **argObjs, **prefixObjs; int numPrefixes, len, skip = contextPtr->skip; /* * Build the real list of arguments to use. Note that we know that the * prefixObj field of the ForwardMethod structure holds a reference to a * non-empty list, so there's a whole class of failures ("not a list") we * can ignore here. */ TclListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL); /* * NOTE: The combination of direct set of iPtr->lookupNsPtr and the use * of the TCL_EVAL_NOERR flag results in an evaluation configuration * very much like TCL_EVAL_INVOKE. */ ((Interp *)interp)->lookupNsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL); } static int FinalizeForwardCall( void *data[], Tcl_Interp *interp, int result) { Tcl_Obj **argObjs = (Tcl_Obj **)data[0]; TclStackFree(interp, argObjs); return result; } /* * ---------------------------------------------------------------------- * * DeleteForwardMethod, CloneForwardMethod -- * * How to delete and clone forwarded methods. * * ---------------------------------------------------------------------- */ static void DeleteForwardMethod( void *clientData) { ForwardMethod *fmPtr = (ForwardMethod *)clientData; Tcl_DecrRefCount(fmPtr->prefixObj); ckfree(fmPtr); } static int CloneForwardMethod( Tcl_Interp *interp, void *clientData, void **newClientData) { ForwardMethod *fmPtr = (ForwardMethod *)clientData; ForwardMethod *fm2Ptr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fm2Ptr->prefixObj = fmPtr->prefixObj; Tcl_IncrRefCount(fm2Ptr->prefixObj); *newClientData = fm2Ptr; return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOOGetProcFromMethod, TclOOGetFwdFromMethod -- * * Utility functions used for procedure-like and forwarding method * introspection. * * ---------------------------------------------------------------------- */ Proc * TclOOGetProcFromMethod( Method *mPtr) { if (mPtr->typePtr == &procMethodType) { ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData; return pmPtr->procPtr; } return NULL; } Tcl_Obj * TclOOGetMethodBody( Method *mPtr) { if (mPtr->typePtr == &procMethodType) { ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData; if (pmPtr->procPtr->bodyPtr->bytes == NULL) { (void) Tcl_GetString(pmPtr->procPtr->bodyPtr); } return pmPtr->procPtr->bodyPtr; } return NULL; } Tcl_Obj * TclOOGetFwdFromMethod( Method *mPtr) { if (mPtr->typePtr == &fwdMethodType) { ForwardMethod *fwPtr = (ForwardMethod *)mPtr->clientData; return fwPtr->prefixObj; } return NULL; } /* * ---------------------------------------------------------------------- * * InitEnsembleRewrite -- * * Utility function that wraps up a lot of the complexity involved in * doing ensemble-like command forwarding. Here is a picture of memory * management plan: * * <-----------------objc----------------------> * objv: |=============|===============================| * <-toRewrite-> | * \ * <-rewriteLength-> \ * rewriteObjs: |=================| \ * | | * V V * argObjs: |=================|===============================| * <------------------*lengthPtr-------------------> * * ---------------------------------------------------------------------- */ static Tcl_Obj ** InitEnsembleRewrite( Tcl_Interp *interp, /* Place to log the rewrite info. */ int objc, /* Number of real arguments. */ Tcl_Obj *const *objv, /* The real arguments. */ int toRewrite, /* Number of real arguments to replace. */ int rewriteLength, /* Number of arguments to insert instead. */ Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */ int *lengthPtr) /* Where to write the resulting length of the * array of rewritten arguments. */ { unsigned len = rewriteLength + objc - toRewrite; Tcl_Obj **argObjs = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * len); memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *)); memcpy(argObjs + rewriteLength, objv + toRewrite, sizeof(Tcl_Obj *) * (objc - toRewrite)); /* * Now plumb this into the core ensemble rewrite logging system so that * Tcl_WrongNumArgs() can rewrite its result appropriately. The rules for * how to store the rewrite rules get complex solely because of the case * where an ensemble rewrites itself out of the picture; when that * happens, the quality of the error message rewrite falls drastically * (and unavoidably). */ if (TclInitRewriteEnsemble(interp, toRewrite, rewriteLength, objv)) { TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } *lengthPtr = len; return argObjs; } /* * ---------------------------------------------------------------------- * * assorted trivial 'getter' functions * * ---------------------------------------------------------------------- */ Tcl_Object Tcl_MethodDeclarerObject( Tcl_Method method) { return (Tcl_Object) ((Method *) method)->declaringObjectPtr; } Tcl_Class Tcl_MethodDeclarerClass( Tcl_Method method) { return (Tcl_Class) ((Method *) method)->declaringClassPtr; } Tcl_Obj * Tcl_MethodName( Tcl_Method method) { return ((Method *) method)->namePtr; } int Tcl_MethodIsType( Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr) { Method *mPtr = (Method *) method; if (mPtr->typePtr == typePtr) { if (clientDataPtr != NULL) { *clientDataPtr = mPtr->clientData; } return 1; } return 0; } int Tcl_MethodIsPublic( Tcl_Method method) { return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0; } /* * Extended method construction for itcl-ng. */ Tcl_Method TclOONewProcInstanceMethodEx( Tcl_Interp *interp, /* The interpreter containing the object. */ Tcl_Object oPtr, /* The object to modify. */ TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, /* The name of the method, which must not be * NULL. */ Tcl_Obj *argsObj, /* The formal argument list for the method, * which must not be NULL. */ Tcl_Obj *bodyObj, /* The body of the method, which must not be * NULL. */ int flags, /* Whether this is a public method. */ void **internalTokenPtr) /* If non-NULL, points to a variable that gets * the reference to the ProcedureMethod * structure. */ { ProcedureMethod *pmPtr; Tcl_Method method = (Tcl_Method) TclOONewProcInstanceMethod(interp, (Object *) oPtr, flags, nameObj, argsObj, bodyObj, &pmPtr); if (method == NULL) { return NULL; } pmPtr->flags = flags & USE_DECLARER_NS; pmPtr->preCallProc = preCallPtr; pmPtr->postCallProc = postCallPtr; pmPtr->errProc = errProc; pmPtr->clientData = clientData; if (internalTokenPtr != NULL) { *internalTokenPtr = pmPtr; } return method; } Tcl_Method TclOONewProcMethodEx( Tcl_Interp *interp, /* The interpreter containing the class. */ Tcl_Class clsPtr, /* The class to modify. */ TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, /* The name of the method, which may be NULL; * if so, up to caller to manage storage * (e.g., because it is a constructor or * destructor). */ Tcl_Obj *argsObj, /* The formal argument list for the method, * which may be NULL; if so, it is equivalent * to an empty list. */ Tcl_Obj *bodyObj, /* The body of the method, which must not be * NULL. */ int flags, /* Whether this is a public method. */ void **internalTokenPtr) /* If non-NULL, points to a variable that gets * the reference to the ProcedureMethod * structure. */ { ProcedureMethod *pmPtr; Tcl_Method method = (Tcl_Method) TclOONewProcMethod(interp, (Class *) clsPtr, flags, nameObj, argsObj, bodyObj, &pmPtr); if (method == NULL) { return NULL; } pmPtr->flags = flags & USE_DECLARER_NS; pmPtr->preCallProc = preCallPtr; pmPtr->postCallProc = postCallPtr; pmPtr->errProc = errProc; pmPtr->clientData = clientData; if (internalTokenPtr != NULL) { *internalTokenPtr = pmPtr; } return method; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOOStubInit.c0000644000175000017500000000452614566153373016143 0ustar sergeisergei/* * This file is (mostly) automatically generated from tclOO.decls. * It is compiled and linked in with the tclOO package proper. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclOOInt.h" MODULE_SCOPE const TclOOStubs tclOOStubs; #ifdef __GNUC__ #pragma GCC dependency "tclOO.decls" #endif #define TclOOUnusedStubEntry 0 /* !BEGIN!: Do not edit below this line. */ static const TclOOIntStubs tclOOIntStubs = { TCL_STUB_MAGIC, 0, TclOOGetDefineCmdContext, /* 0 */ TclOOMakeProcInstanceMethod, /* 1 */ TclOOMakeProcMethod, /* 2 */ TclOONewProcInstanceMethod, /* 3 */ TclOONewProcMethod, /* 4 */ TclOOObjectCmdCore, /* 5 */ TclOOIsReachable, /* 6 */ TclOONewForwardMethod, /* 7 */ TclOONewForwardInstanceMethod, /* 8 */ TclOONewProcInstanceMethodEx, /* 9 */ TclOONewProcMethodEx, /* 10 */ TclOOInvokeObject, /* 11 */ TclOOObjectSetFilters, /* 12 */ TclOOClassSetFilters, /* 13 */ TclOOObjectSetMixins, /* 14 */ TclOOClassSetMixins, /* 15 */ }; static const TclOOStubHooks tclOOStubHooks = { &tclOOIntStubs }; const TclOOStubs tclOOStubs = { TCL_STUB_MAGIC, &tclOOStubHooks, Tcl_CopyObjectInstance, /* 0 */ Tcl_GetClassAsObject, /* 1 */ Tcl_GetObjectAsClass, /* 2 */ Tcl_GetObjectCommand, /* 3 */ Tcl_GetObjectFromObj, /* 4 */ Tcl_GetObjectNamespace, /* 5 */ Tcl_MethodDeclarerClass, /* 6 */ Tcl_MethodDeclarerObject, /* 7 */ Tcl_MethodIsPublic, /* 8 */ Tcl_MethodIsType, /* 9 */ Tcl_MethodName, /* 10 */ Tcl_NewInstanceMethod, /* 11 */ Tcl_NewMethod, /* 12 */ Tcl_NewObjectInstance, /* 13 */ Tcl_ObjectDeleted, /* 14 */ Tcl_ObjectContextIsFiltering, /* 15 */ Tcl_ObjectContextMethod, /* 16 */ Tcl_ObjectContextObject, /* 17 */ Tcl_ObjectContextSkippedArgs, /* 18 */ Tcl_ClassGetMetadata, /* 19 */ Tcl_ClassSetMetadata, /* 20 */ Tcl_ObjectGetMetadata, /* 21 */ Tcl_ObjectSetMetadata, /* 22 */ Tcl_ObjectContextInvokeNext, /* 23 */ Tcl_ObjectGetMethodNameMapper, /* 24 */ Tcl_ObjectSetMethodNameMapper, /* 25 */ Tcl_ClassSetConstructor, /* 26 */ Tcl_ClassSetDestructor, /* 27 */ Tcl_GetObjectName, /* 28 */ 0, /* 29 */ 0, /* 30 */ 0, /* 31 */ 0, /* 32 */ 0, /* 33 */ TclOOUnusedStubEntry, /* 34 */ }; /* !END!: Do not edit above this line. */ tcl8.6.14/generic/tclOOStubLib.c0000644000175000017500000000337414554262142015736 0ustar sergeisergei/* * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17 */ #include "tclOOInt.h" MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr; const TclOOStubs *tclOOStubsPtr = NULL; const TclOOIntStubs *tclOOIntStubsPtr = NULL; /* *---------------------------------------------------------------------- * * TclOOInitializeStubs -- * Load the tclOO package, initialize stub table pointer. Do not call * this function directly, use Tcl_OOInitStubs() macro instead. * * Results: * The actual version of the package that satisfies the request, or NULL * to indicate that an error occurred. * * Side effects: * Sets the stub table pointers. * *---------------------------------------------------------------------- */ #undef TclOOInitializeStubs MODULE_SCOPE const char * TclOOInitializeStubs( Tcl_Interp *interp, const char *version) { int exact = 0; const char *packageName = "TclOO"; const char *errMsg = NULL; TclOOStubs *stubsPtr = NULL; const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &stubsPtr); if (actualVersion == NULL) { return NULL; } if (stubsPtr == NULL) { errMsg = "missing stub table pointer"; } else { tclOOStubsPtr = stubsPtr; if (stubsPtr->hooks) { tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs; } else { tclOOIntStubsPtr = NULL; } return actualVersion; } tclStubsPtr->tcl_ResetResult(interp); tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, " (requested version ", version, ", actual version ", actualVersion, "): ", errMsg, NULL); return NULL; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclOptimize.c0000644000175000017500000002640014554262142015727 0ustar sergeisergei/* * tclOptimize.c -- * * This file contains the bytecode optimizer. * * Copyright (c) 2013 by Donal Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include /* * Forward declarations. */ static void AdvanceJumps(CompileEnv *envPtr); static void ConvertZeroEffectToNOP(CompileEnv *envPtr); static void LocateTargetAddresses(CompileEnv *envPtr, Tcl_HashTable *tablePtr); static void TrimUnreachable(CompileEnv *envPtr); /* * Helper macros. */ #define DefineTargetAddress(tablePtr, address) \ ((void) Tcl_CreateHashEntry((tablePtr), (void *) (address), &isNew)) #define IsTargetAddress(tablePtr, address) \ (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL) #define AddrLength(address) \ (tclInstructionTable[*(unsigned char *)(address)].numBytes) #define InstLength(instruction) \ (tclInstructionTable[UCHAR(instruction)].numBytes) /* * ---------------------------------------------------------------------- * * LocateTargetAddresses -- * * Populate a hash table with places that we need to be careful around * because they're the targets of various kinds of jumps and other * non-local behavior. * * ---------------------------------------------------------------------- */ static void LocateTargetAddresses( CompileEnv *envPtr, Tcl_HashTable *tablePtr) { unsigned char *currentInstPtr, *targetInstPtr; int isNew, i; Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS); /* * The starts of commands represent target addresses. */ for (i=0 ; inumCommands ; i++) { DefineTargetAddress(tablePtr, envPtr->codeStart + envPtr->cmdMapPtr[i].codeOffset); } /* * Find places where we should be careful about replacing instructions * because they are the targets of various types of jumps. */ for (currentInstPtr = envPtr->codeStart ; currentInstPtr < envPtr->codeNext ; currentInstPtr += AddrLength(currentInstPtr)) { switch (*currentInstPtr) { case INST_JUMP1: case INST_JUMP_TRUE1: case INST_JUMP_FALSE1: targetInstPtr = currentInstPtr+TclGetInt1AtPtr(currentInstPtr+1); goto storeTarget; case INST_JUMP4: case INST_JUMP_TRUE4: case INST_JUMP_FALSE4: case INST_START_CMD: targetInstPtr = currentInstPtr+TclGetInt4AtPtr(currentInstPtr+1); goto storeTarget; case INST_BEGIN_CATCH4: targetInstPtr = envPtr->codeStart + envPtr->exceptArrayPtr[ TclGetUInt4AtPtr(currentInstPtr+1)].codeOffset; storeTarget: DefineTargetAddress(tablePtr, targetInstPtr); break; case INST_JUMP_TABLE: hPtr = Tcl_FirstHashEntry( &JUMPTABLEINFO(envPtr, currentInstPtr+1)->hashTable, &hSearch); for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) { targetInstPtr = currentInstPtr + PTR2INT(Tcl_GetHashValue(hPtr)); DefineTargetAddress(tablePtr, targetInstPtr); } break; case INST_RETURN_CODE_BRANCH: for (i=TCL_ERROR ; iexceptArrayNext ; i++) { ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; if (rangePtr->type == CATCH_EXCEPTION_RANGE) { targetInstPtr = envPtr->codeStart + rangePtr->catchOffset; DefineTargetAddress(tablePtr, targetInstPtr); } else { targetInstPtr = envPtr->codeStart + rangePtr->breakOffset; DefineTargetAddress(tablePtr, targetInstPtr); if (rangePtr->continueOffset >= 0) { targetInstPtr = envPtr->codeStart + rangePtr->continueOffset; DefineTargetAddress(tablePtr, targetInstPtr); } } } } /* * ---------------------------------------------------------------------- * * TrimUnreachable -- * * Converts code that provably can't be executed into NOPs and reduces * the overall reported length of the bytecode where that is possible. * * ---------------------------------------------------------------------- */ static void TrimUnreachable( CompileEnv *envPtr) { unsigned char *currentInstPtr; Tcl_HashTable targets; LocateTargetAddresses(envPtr, &targets); for (currentInstPtr = envPtr->codeStart ; currentInstPtr < envPtr->codeNext-1 ; currentInstPtr += AddrLength(currentInstPtr)) { int clear = 0; if (*currentInstPtr != INST_DONE) { continue; } while (!IsTargetAddress(&targets, currentInstPtr + 1 + clear)) { clear += AddrLength(currentInstPtr + 1 + clear); } if (currentInstPtr + 1 + clear == envPtr->codeNext) { envPtr->codeNext -= clear; } else { while (clear --> 0) { *(currentInstPtr + 1 + clear) = INST_NOP; } } } Tcl_DeleteHashTable(&targets); } /* * ---------------------------------------------------------------------- * * ConvertZeroEffectToNOP -- * * Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also * replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an * operation that guarantees the check for arithmeticity) and eliminate * LNOT when we can invert the following JUMP condition. * * ---------------------------------------------------------------------- */ static void ConvertZeroEffectToNOP( CompileEnv *envPtr) { unsigned char *currentInstPtr; int size; Tcl_HashTable targets; LocateTargetAddresses(envPtr, &targets); for (currentInstPtr = envPtr->codeStart ; currentInstPtr < envPtr->codeNext ; currentInstPtr += size) { int blank = 0, i, nextInst; size = AddrLength(currentInstPtr); while ((currentInstPtr + size < envPtr->codeNext) && *(currentInstPtr+size) == INST_NOP) { if (IsTargetAddress(&targets, currentInstPtr + size)) { break; } size += InstLength(INST_NOP); } if (IsTargetAddress(&targets, currentInstPtr + size)) { continue; } nextInst = *(currentInstPtr + size); switch (*currentInstPtr) { case INST_PUSH1: if (nextInst == INST_POP) { blank = size + InstLength(nextInst); } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); int numBytes; (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { blank = size + InstLength(nextInst); } } break; case INST_PUSH4: if (nextInst == INST_POP) { blank = size + 1; } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); int numBytes; (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { blank = size + InstLength(nextInst); } } break; case INST_LNOT: switch (nextInst) { case INST_JUMP_TRUE1: blank = size; *(currentInstPtr + size) = INST_JUMP_FALSE1; break; case INST_JUMP_FALSE1: blank = size; *(currentInstPtr + size) = INST_JUMP_TRUE1; break; case INST_JUMP_TRUE4: blank = size; *(currentInstPtr + size) = INST_JUMP_FALSE4; break; case INST_JUMP_FALSE4: blank = size; *(currentInstPtr + size) = INST_JUMP_TRUE4; break; } break; case INST_TRY_CVT_TO_NUMERIC: switch (nextInst) { case INST_JUMP_TRUE1: case INST_JUMP_TRUE4: case INST_JUMP_FALSE1: case INST_JUMP_FALSE4: case INST_INCR_SCALAR1: case INST_INCR_ARRAY1: case INST_INCR_ARRAY_STK: case INST_INCR_SCALAR_STK: case INST_INCR_STK: case INST_LOR: case INST_LAND: case INST_EQ: case INST_NEQ: case INST_LT: case INST_LE: case INST_GT: case INST_GE: case INST_MOD: case INST_LSHIFT: case INST_RSHIFT: case INST_BITOR: case INST_BITXOR: case INST_BITAND: case INST_EXPON: case INST_ADD: case INST_SUB: case INST_DIV: case INST_MULT: case INST_LNOT: case INST_BITNOT: case INST_UMINUS: case INST_UPLUS: case INST_TRY_CVT_TO_NUMERIC: blank = size; break; } break; } if (blank > 0) { for (i=0 ; icodeStart ; currentInstPtr < envPtr->codeNext-1 ; currentInstPtr += AddrLength(currentInstPtr)) { int offset, delta, isNew; switch (*currentInstPtr) { case INST_JUMP1: case INST_JUMP_TRUE1: case INST_JUMP_FALSE1: offset = TclGetInt1AtPtr(currentInstPtr + 1); Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS); for (delta=0 ; offset+delta != 0 ;) { if (offset + delta < -128 || offset + delta > 127) { break; } Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew); if (!isNew) { offset = TclGetInt1AtPtr(currentInstPtr + 1); break; } offset += delta; switch (*(currentInstPtr + offset)) { case INST_NOP: delta = InstLength(INST_NOP); continue; case INST_JUMP1: delta = TclGetInt1AtPtr(currentInstPtr + offset + 1); continue; case INST_JUMP4: delta = TclGetInt4AtPtr(currentInstPtr + offset + 1); continue; } break; } Tcl_DeleteHashTable(&jumps); TclStoreInt1AtPtr(offset, currentInstPtr + 1); continue; case INST_JUMP4: case INST_JUMP_TRUE4: case INST_JUMP_FALSE4: Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS); Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew); for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) { Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew); if (!isNew) { offset = TclGetInt4AtPtr(currentInstPtr + 1); break; } switch (*(currentInstPtr + offset)) { case INST_NOP: offset += InstLength(INST_NOP); continue; case INST_JUMP1: offset += TclGetInt1AtPtr(currentInstPtr + offset + 1); continue; case INST_JUMP4: offset += TclGetInt4AtPtr(currentInstPtr + offset + 1); continue; } break; } Tcl_DeleteHashTable(&jumps); TclStoreInt4AtPtr(offset, currentInstPtr + 1); continue; } } } /* * ---------------------------------------------------------------------- * * TclOptimizeBytecode -- * * A very simple peephole optimizer for bytecode. * * ---------------------------------------------------------------------- */ void TclOptimizeBytecode( void *envPtr) { ConvertZeroEffectToNOP(envPtr); AdvanceJumps(envPtr); TrimUnreachable(envPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ tcl8.6.14/generic/tclPanic.c0000644000175000017500000000756014554262142015167 0ustar sergeisergei/* * tclPanic.c -- * * Source code for the "Tcl_Panic" library procedure for Tcl; individual * applications will probably call Tcl_SetPanicProc() to set an * application-specific panic procedure. * * Copyright (c) 1988-1993 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #if defined(_WIN32) || defined(__CYGWIN__) MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); #endif /* * The panicProc variable contains a pointer to an application specific panic * procedure. */ #if defined(__CYGWIN__) static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic; #else static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; #endif /* *---------------------------------------------------------------------- * * Tcl_SetPanicProc -- * * Replace the default panic behavior with the specified function. * * Results: * None. * * Side effects: * Sets the panicProc variable. * *---------------------------------------------------------------------- */ void Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *proc) { #if defined(_WIN32) /* tclWinDebugPanic only installs if there is no panicProc yet. */ if ((proc != tclWinDebugPanic) || (panicProc == NULL)) #elif defined(__CYGWIN__) if (proc == NULL) panicProc = tclWinDebugPanic; else #endif panicProc = proc; } /* *---------------------------------------------------------------------- * * Tcl_PanicVA -- * * Print an error message and kill the process. * * Results: * None. * * Side effects: * The process dies, entering the debugger if possible. * *---------------------------------------------------------------------- */ void Tcl_PanicVA( const char *format, /* Format string, suitable for passing to * fprintf. */ va_list argList) /* Variable argument list. */ { char *arg1, *arg2, *arg3; /* Additional arguments (variable in number) * to pass to fprintf. */ char *arg4, *arg5, *arg6, *arg7, *arg8; arg1 = va_arg(argList, char *); arg2 = va_arg(argList, char *); arg3 = va_arg(argList, char *); arg4 = va_arg(argList, char *); arg5 = va_arg(argList, char *); arg6 = va_arg(argList, char *); arg7 = va_arg(argList, char *); arg8 = va_arg(argList, char *); if (panicProc != NULL) { panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); #ifdef _WIN32 } else if (IsDebuggerPresent()) { tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); #endif } else { fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); fprintf(stderr, "\n"); fflush(stderr); #if defined(_WIN32) || defined(__CYGWIN__) # if defined(__GNUC__) __builtin_trap(); # elif defined(_WIN64) __debugbreak(); # elif defined(_MSC_VER) && defined (_M_IX86) _asm {int 3} # else DebugBreak(); # endif #endif #if defined(_WIN32) ExitProcess(1); #else abort(); #endif } } /* *---------------------------------------------------------------------- * * Tcl_Panic -- * * Print an error message and kill the process. * * Results: * None. * * Side effects: * The process dies, entering the debugger if possible. * *---------------------------------------------------------------------- */ /* ARGSUSED */ /* * The following comment is here so that Coverity's static analyzer knows that * a Tcl_Panic() call can never return and avoids lots of false positives. */ /* coverity[+kill] */ void Tcl_Panic( const char *format, ...) { va_list argList; va_start(argList, format); Tcl_PanicVA(format, argList); va_end (argList); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclParse.c0000644000175000017500000022342214554262142015204 0ustar sergeisergei/* * tclParse.c -- * * This file contains functions that parse Tcl scripts. They do so in a * general-purpose fashion that can be used for many different purposes, * including compilation, direct execution, code analysis, etc. * * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclParse.h" #include /* * The following table provides parsing information about each possible 8-bit * character. The table is designed to be referenced with either signed or * unsigned characters, so it has 384 entries. The first 128 entries * correspond to negative character values, the next 256 correspond to * positive character values. The last 128 entries are identical to the first * 128. The table is always indexed with a 128-byte offset (the 128th entry * corresponds to a character value of 0). * * The macro CHAR_TYPE is used to index into the table and return information * about its character argument. The following return values are defined. * * TYPE_NORMAL - All characters that don't have special significance to * the Tcl parser. * TYPE_SPACE - The character is a whitespace character other than * newline. * TYPE_COMMAND_END - Character is newline or semicolon. * TYPE_SUBS - Character begins a substitution or has other special * meaning in ParseTokens: backslash, dollar sign, or * open bracket. * TYPE_QUOTE - Character is a double quote. * TYPE_CLOSE_PAREN - Character is a right parenthesis. * TYPE_CLOSE_BRACK - Character is a right square bracket. * TYPE_BRACE - Character is a curly brace (either left or right). */ const char tclCharTypeTable[] = { /* * Negative character values, from -128 to -1: */ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, /* * Positive character values, from 0-127: */ TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE, TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL, TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS, TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL, /* * Large unsigned character values, from 128-255: */ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, }; /* * Prototypes for local functions defined in this file: */ static inline int CommandComplete(const char *script, int numBytes); static int ParseComment(const char *src, int numBytes, Tcl_Parse *parsePtr); static int ParseTokens(const char *src, int numBytes, int mask, int flags, Tcl_Parse *parsePtr); static int ParseWhiteSpace(const char *src, int numBytes, int *incompletePtr, char *typePtr); static int ParseHex(const char *src, int numBytes, int *resultPtr); /* *---------------------------------------------------------------------- * * TclParseInit -- * * Initialize the fields of a Tcl_Parse struct. * * Results: * None. * * Side effects: * The Tcl_Parse struct pointed to by parsePtr gets initialized. * *---------------------------------------------------------------------- */ void TclParseInit( Tcl_Interp *interp, /* Interpreter to use for error reporting */ const char *start, /* Start of string to be parsed. */ int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Points to struct to initialize */ { parsePtr->numWords = 0; parsePtr->tokenPtr = parsePtr->staticTokens; parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; parsePtr->string = start; parsePtr->end = start + numBytes; parsePtr->term = parsePtr->end; parsePtr->interp = interp; parsePtr->incomplete = 0; parsePtr->errorType = TCL_PARSE_SUCCESS; } /* *---------------------------------------------------------------------- * * Tcl_ParseCommand -- * * Given a string, this function parses the first Tcl command in the * string and returns information about the structure of the command. * * Results: * The return value is TCL_OK if the command was parsed successfully and * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an * error message is left in its result. On a successful return, parsePtr * is filled in with information about the command that was parsed. * * Side effects: * If there is insufficient space in parsePtr to hold all the information * about the command, then additional space is malloc-ed. If the function * returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to * release any additional space that was allocated. * *---------------------------------------------------------------------- */ int Tcl_ParseCommand( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ int nested, /* Non-zero means this is a nested command: * close bracket should be considered a * command terminator. If zero, then close * bracket has no special meaning. */ Tcl_Parse *parsePtr) /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { const char *src; /* Points to current character in the * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ int wordIndex; /* Index of word token for current word. */ int terminators; /* CHAR_TYPE bits that indicate the end of a * command. */ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ int scanned; if (numBytes < 0 && start) { numBytes = strlen(start); } TclParseInit(interp, start, numBytes, parsePtr); if ((start == NULL) && (numBytes != 0)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't parse a NULL pointer", -1)); } return TCL_ERROR; } parsePtr->commentStart = NULL; parsePtr->commentSize = 0; parsePtr->commandStart = NULL; parsePtr->commandSize = 0; if (nested != 0) { terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK; } else { terminators = TYPE_COMMAND_END; } /* * Parse any leading space and comments before the first word of the * command. */ scanned = ParseComment(start, numBytes, parsePtr); src = (start + scanned); numBytes -= scanned; if (numBytes == 0) { if (nested) { parsePtr->incomplete = nested; } } /* * The following loop parses the words of the command, one word in each * iteration through the loop. */ parsePtr->commandStart = src; while (1) { int expandWord = 0; /* * Create the token for the word. */ TclGrowParseTokenArray(parsePtr, 1); wordIndex = parsePtr->numTokens; tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->type = TCL_TOKEN_WORD; /* * Skip white space before the word. Also skip a backslash-newline * sequence: it should be treated just like white space. */ scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); src += scanned; numBytes -= scanned; if (numBytes == 0) { parsePtr->term = src; break; } if ((type & terminators) != 0) { parsePtr->term = src; src++; break; } tokenPtr->start = src; parsePtr->numTokens++; parsePtr->numWords++; /* * At this point the word can have one of four forms: something * enclosed in quotes, something enclosed in braces, and expanding * word, or an unquoted word (anything else). */ parseWord: if (*src == '"') { if (Tcl_ParseQuotedString(interp, src, numBytes, parsePtr, 1, &termPtr) != TCL_OK) { goto error; } src = termPtr; numBytes = parsePtr->end - src; } else if (*src == '{') { int expIdx = wordIndex + 1; Tcl_Token *expPtr; if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1, &termPtr) != TCL_OK) { goto error; } src = termPtr; numBytes = parsePtr->end - src; /* * Check whether the braces contained the word expansion prefix * {*} */ expPtr = &parsePtr->tokenPtr[expIdx]; if ((0 == expandWord) /* Haven't seen prefix already */ && (1 == parsePtr->numTokens - expIdx) /* Only one token */ && (((1 == (size_t) expPtr->size) /* Same length as prefix */ && (expPtr->start[0] == '*'))) /* Is the prefix */ && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr, numBytes, &parsePtr->incomplete, &type)) && (type != TYPE_COMMAND_END) /* Non-whitespace follows */) { expandWord = 1; parsePtr->numTokens--; goto parseWord; } } else { /* * This is an unquoted word. Call ParseTokens and let it do all of * the work. */ if (ParseTokens(src, numBytes, TYPE_SPACE|terminators, TCL_SUBST_ALL, parsePtr) != TCL_OK) { goto error; } src = parsePtr->term; numBytes = parsePtr->end - src; } /* * Finish filling in the token for the word and check for the special * case of a word consisting of a single range of literal text. */ tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->size = src - tokenPtr->start; tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); if (expandWord) { int i, isLiteral = 1; /* * When a command includes a word that is an expanded literal; for * example, {*}{1 2 3}, the parser performs that expansion * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand() * caller might have to expand. This notably makes it simpler for * those callers that wish to track line endings, such as those * that implement key parts of TIP 280. * * First check whether the thing to be expanded is a literal, * in the sense of being composed entirely of TCL_TOKEN_TEXT * tokens. */ for (i = 1; i <= tokenPtr->numComponents; i++) { if (tokenPtr[i].type != TCL_TOKEN_TEXT) { isLiteral = 0; break; } } if (isLiteral) { int elemCount = 0, code = TCL_OK, literal = 1; const char *nextElem, *listEnd, *elemStart; /* * The word to be expanded is a literal, so determine the * boundaries of the literal string to be treated as a list * and expanded. That literal string starts at * tokenPtr[1].start, and includes all bytes up to, but not * including (tokenPtr[tokenPtr->numComponents].start + * tokenPtr[tokenPtr->numComponents].size) */ listEnd = (tokenPtr[tokenPtr->numComponents].start + tokenPtr[tokenPtr->numComponents].size); nextElem = tokenPtr[1].start; /* * Step through the literal string, parsing and counting list * elements. */ while (nextElem < listEnd) { int size; code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, &size, &literal); if ((code != TCL_OK) || !literal) { break; } if (elemStart < listEnd) { elemCount++; } } if ((code != TCL_OK) || !literal) { /* * Some list element could not be parsed, or is not * present as a literal substring of the script. The * compiler cannot handle list elements that get generated * by a call to TclCopyAndCollapse(). Defer the * handling of this to compile/eval time, where code is * already in place to report the "attempt to expand a * non-list" error or expand lists that require * substitution. */ tokenPtr->type = TCL_TOKEN_EXPAND_WORD; } else if (elemCount == 0) { /* * We are expanding a literal empty list. This means that * the expanding word completely disappears, leaving no * word generated this pass through the loop. Adjust * accounting appropriately. */ parsePtr->numWords--; parsePtr->numTokens = wordIndex; } else { /* * Recalculate the number of Tcl_Tokens needed to store * tokens representing the expanded list. */ const char *listStart; int growthNeeded = wordIndex + 2*elemCount - parsePtr->numTokens; parsePtr->numWords += elemCount - 1; if (growthNeeded > 0) { TclGrowParseTokenArray(parsePtr, growthNeeded); tokenPtr = &parsePtr->tokenPtr[wordIndex]; } parsePtr->numTokens = wordIndex + 2*elemCount; /* * Generate a TCL_TOKEN_SIMPLE_WORD token sequence for * each element of the literal list we are expanding in * place. Take care with the start and size fields of each * token so they point to the right literal characters in * the original script to represent the right expanded * word value. */ listStart = nextElem = tokenPtr[1].start; while (nextElem < listEnd) { int quoted; tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; tokenPtr->numComponents = 1; tokenPtr++; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->numComponents = 0; TclFindElement(NULL, nextElem, listEnd - nextElem, &(tokenPtr->start), &nextElem, &(tokenPtr->size), NULL); quoted = (tokenPtr->start[-1] == '{' || tokenPtr->start[-1] == '"') && tokenPtr->start > listStart; tokenPtr[-1].start = tokenPtr->start - quoted; tokenPtr[-1].size = tokenPtr->start + tokenPtr->size - tokenPtr[-1].start + quoted; tokenPtr++; } } } else { /* * The word to be expanded is not a literal, so defer * expansion to compile/eval time by marking with a * TCL_TOKEN_EXPAND_WORD token. */ tokenPtr->type = TCL_TOKEN_EXPAND_WORD; } } else if ((tokenPtr->numComponents == 1) && (tokenPtr[1].type == TCL_TOKEN_TEXT)) { tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; } /* * Do two additional checks: (a) make sure we're really at the end of * a word (there might have been garbage left after a quoted or braced * word), and (b) check for the end of the command. */ scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); if (scanned) { src += scanned; numBytes -= scanned; continue; } if (numBytes == 0) { parsePtr->term = src; break; } if ((type & terminators) != 0) { parsePtr->term = src; src++; break; } if (src[-1] == '"') { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "extra characters after close-quote", -1)); } parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; } else { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "extra characters after close-brace", -1)); } parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; } parsePtr->term = src; goto error; } parsePtr->commandSize = src - parsePtr->commandStart; return TCL_OK; error: Tcl_FreeParse(parsePtr); parsePtr->commandSize = parsePtr->end - parsePtr->commandStart; return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclIsSpaceProc -- * * Report whether byte is in the set of whitespace characters used by * Tcl to separate words in scripts or elements in lists. * * Results: * Returns 1, if byte is in the set, 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclIsSpaceProc( int byte) { return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n'; } /* *---------------------------------------------------------------------- * * TclIsBareword-- * * Report whether byte is one that can be part of a "bareword". * This concept is named in expression parsing, where it determines * what can be a legal function name, but is the same definition used * in determining what variable names can be parsed as variable * substitutions without the benefit of enclosing braces. The set of * ASCII chars that are accepted are the numeric chars ('0'-'9'), * the alphabetic chars ('a'-'z', 'A'-'Z') and underscore ('_'). * * Results: * Returns 1, if byte is in the accepted set of chars, 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclIsBareword( int byte) { if (byte < '0' || byte > 'z') { return 0; } if (byte <= '9' || byte >= 'a') { return 1; } if (byte == '_') { return 1; } if (byte < 'A' || byte > 'Z') { return 0; } return 1; } /* *---------------------------------------------------------------------- * * ParseWhiteSpace -- * * Scans up to numBytes bytes starting at src, consuming white space * between words as defined by Tcl's parsing rules. * * Results: * Returns the number of bytes recognized as white space. Records at * parsePtr, information about the parse. Records at typePtr the * character type of the non-whitespace character that terminated the * scan. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ParseWhiteSpace( const char *src, /* First character to parse. */ int numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type * of character that ends run of whitespace */ { char type = TYPE_NORMAL; const char *p = src; while (1) { while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { numBytes--; p++; } if (numBytes && (type & TYPE_SUBS)) { if (*p != '\\') { break; } if (--numBytes == 0) { break; } if (p[1] != '\n') { break; } p += 2; if (--numBytes == 0) { *incompletePtr = 1; break; } continue; } break; } *typePtr = type; return (p - src); } /* *---------------------------------------------------------------------- * * TclParseAllWhiteSpace -- * * Scans up to numBytes bytes starting at src, consuming all white space * including the command-terminating newline characters. * * Results: * Returns the number of bytes recognized as white space. * *---------------------------------------------------------------------- */ int TclParseAllWhiteSpace( const char *src, /* First character to parse. */ int numBytes) /* Max number of byes to scan */ { int dummy; char type; const char *p = src; do { int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type); p += scanned; numBytes -= scanned; } while (numBytes && (*p == '\n') && (p++, --numBytes)); return (p-src); } /* *---------------------------------------------------------------------- * * ParseHex -- * * Scans a hexadecimal number as a Tcl_UniChar value (e.g., for parsing * \x and \u escape sequences). At most numBytes bytes are scanned. * * Results: * The numeric value is stored in *resultPtr. Returns the number of bytes * consumed. * * Notes: * Relies on the following properties of the ASCII character set, with * which UTF-8 is compatible: * * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' occupy * consecutive code points, and '0' < 'A' < 'a'. * *---------------------------------------------------------------------- */ int ParseHex( const char *src, /* First character to parse. */ int numBytes, /* Max number of byes to scan */ int *resultPtr) /* Points to storage provided by caller where * the character resulting from the * conversion is to be written. */ { int result = 0; const char *p = src; while (numBytes--) { unsigned char digit = UCHAR(*p); if (!isxdigit(digit) || (result > 0x10FFF)) { break; } p++; result <<= 4; if (digit >= 'a') { result |= (10 + digit - 'a'); } else if (digit >= 'A') { result |= (10 + digit - 'A'); } else { result |= (digit - '0'); } } *resultPtr = result; return (p - src); } /* *---------------------------------------------------------------------- * * TclParseBackslash -- * * Scans up to numBytes bytes starting at src, consuming a backslash * sequence as defined by Tcl's parsing rules. * * Results: * Records at readPtr the number of bytes making up the backslash * sequence. Records at dst the UTF-8 encoded equivalent of that * backslash sequence. Returns the number of bytes written to dst, at * most TCL_UTF_MAX. Either readPtr or dst may be NULL, if the results * are not needed, but the return value is the same either way. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclParseBackslash( const char *src, /* Points to the backslash character of a * backslash sequence. */ int numBytes, /* Max number of bytes to scan. */ int *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be * written. At most TCL_UTF_MAX bytes will be * written there. */ { const char *p = src+1; int result; int count; char buf[TCL_UTF_MAX] = ""; if (numBytes == 0) { if (readPtr != NULL) { *readPtr = 0; } return 0; } if (dst == NULL) { dst = buf; } if (numBytes == 1) { /* * Can only scan the backslash, so return it. */ result = '\\'; count = 1; goto done; } count = 2; switch (*p) { /* * Note: in the conversions below, use absolute values (e.g., 0xA) * rather than symbolic values (e.g. \n) that get converted by the * compiler. It's possible that compilers on some platforms will do * the symbolic conversions differently, which could result in * non-portable Tcl scripts. */ case 'a': result = 0x7; break; case 'b': result = 0x8; break; case 'f': result = 0xC; break; case 'n': result = 0xA; break; case 'r': result = 0xD; break; case 't': result = 0x9; break; case 'v': result = 0xB; break; case 'x': count += ParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result); if (count == 2) { /* * No hexdigits -> This is just "x". */ result = 'x'; } else { /* * Keep only the last byte (2 hex digits). */ result = UCHAR(result); } break; case 'u': count += ParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result); if (count == 2) { /* * No hexdigits -> This is just "u". */ result = 'u'; #if TCL_UTF_MAX > 3 } else if (((result & 0xFC00) == 0xD800) && (count == 6) && (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) { /* If high surrogate is immediately followed by a low surrogate * escape, combine them into one character. */ int low; int count2 = ParseHex(p+7, 4, &low); if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) { result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000; count += count2 + 2; } #endif } break; case 'U': count += ParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result); if (count == 2) { /* * No hexdigits -> This is just "U". */ result = 'U'; #if TCL_UTF_MAX > 3 } else if ((result & ~0x7FF) == 0xD800) { /* Upper or lower surrogate, not allowed in this syntax. */ result = 0xFFFD; #endif } break; case '\n': count--; do { p++; count++; } while ((count < numBytes) && ((*p == ' ') || (*p == '\t'))); result = ' '; break; case 0: result = '\\'; count = 1; break; default: /* * Check for an octal number \oo?o? */ if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */ result = *p - '0'; p++; if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */ || (UCHAR(*p) >= '8')) { break; } count = 3; result = (result << 3) + (*p - '0'); p++; if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */ || (UCHAR(*p) >= '8') || (result >= 0x20)) { break; } count = 4; result = UCHAR((result << 3) + (*p - '0')); break; } /* * We have to convert here in case the user has put a backslash in * front of a multi-byte utf-8 character. While this means nothing * special, we shouldn't break up a correct utf-8 character. [Bug * #217987] test subst-3.2 */ if (TclUCS4Complete(p, numBytes - 1)) { count = TclUtfToUCS4(p, &result) + 1; /* +1 for '\' */ } else { char utfBytes[8]; memcpy(utfBytes, p, numBytes - 1); utfBytes[numBytes - 1] = '\0'; count = TclUtfToUCS4(utfBytes, &result) + 1; } break; } done: if (readPtr != NULL) { *readPtr = count; } #if TCL_UTF_MAX < 4 if (result > 0xFFFF) { result = 0xFFFD; } #endif return TclUCS4ToUtf(result, dst); } /* *---------------------------------------------------------------------- * * ParseComment -- * * Scans up to numBytes bytes starting at src, consuming a Tcl comment as * defined by Tcl's parsing rules. * * Results: * Records in parsePtr information about the parse. Returns the number of * bytes consumed. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ParseComment( const char *src, /* First character to parse. */ int numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ { const char *p = src; while (numBytes) { char type; int scanned; do { scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete, &type); p += scanned; numBytes -= scanned; } while (numBytes && (*p == '\n') && (p++,numBytes--)); if ((numBytes == 0) || (*p != '#')) { break; } if (parsePtr->commentStart == NULL) { parsePtr->commentStart = p; } while (numBytes) { if (*p == '\\') { scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete, &type); if (scanned) { p += scanned; numBytes -= scanned; } else { /* * General backslash substitution in comments isn't part * of the formal spec, but test parse-15.47 and history * indicate that it has been the de facto rule. Don't * change it now. */ TclParseBackslash(p, numBytes, &scanned, NULL); p += scanned; numBytes -= scanned; } } else { p++; numBytes--; if (p[-1] == '\n') { break; } } } parsePtr->commentSize = p - parsePtr->commentStart; } return (p - src); } /* *---------------------------------------------------------------------- * * ParseTokens -- * * This function forms the heart of the Tcl parser. It parses one or more * tokens from a string, up to a termination point specified by the * caller. This function is used to parse unquoted command words (those * not in quotes or braces), words in quotes, and array indices for * variables. No more than numBytes bytes will be scanned. * * Results: * Tokens are added to parsePtr and parsePtr->term is filled in with the * address of the character that terminated the parse (the first one * whose CHAR_TYPE matched mask or the character at parsePtr->end). The * return value is TCL_OK if the parse completed successfully and * TCL_ERROR otherwise. If a parse error occurs and parsePtr->interp is * not NULL, then an error message is left in the interpreter's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ParseTokens( const char *src, /* First character to parse. */ int numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose * CHAR_TYPE contains any of the bits in * mask. */ int flags, /* OR-ed bits indicating what substitutions to * perform: TCL_SUBST_COMMANDS, * TCL_SUBST_VARIABLES, and * TCL_SUBST_BACKSLASHES */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated with additional tokens and * termination information. */ { char type; int originalTokens; int noSubstCmds = !(flags & TCL_SUBST_COMMANDS); int noSubstVars = !(flags & TCL_SUBST_VARIABLES); int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES); Tcl_Token *tokenPtr; /* * Each iteration through the following loop adds one token of type * TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or TCL_TOKEN_VARIABLE * to parsePtr. For TCL_TOKEN_VARIABLE tokens, additional tokens are added * for the parsed variable name. */ originalTokens = parsePtr->numTokens; while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) { TclGrowParseTokenArray(parsePtr, 1); tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->start = src; tokenPtr->numComponents = 0; if ((type & TYPE_SUBS) == 0) { /* * This is a simple range of characters. Scan to find the end of * the range. */ while ((++src, --numBytes) && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) { /* empty loop */ } tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = src - tokenPtr->start; parsePtr->numTokens++; } else if (*src == '$') { int varToken; if (noSubstVars) { tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 1; parsePtr->numTokens++; src++; numBytes--; continue; } /* * This is a variable reference. Call Tcl_ParseVarName to do all * the dirty work of parsing the name. */ varToken = parsePtr->numTokens; if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, parsePtr, 1) != TCL_OK) { return TCL_ERROR; } src += parsePtr->tokenPtr[varToken].size; numBytes -= parsePtr->tokenPtr[varToken].size; } else if (*src == '[') { Tcl_Parse *nestedPtr; if (noSubstCmds) { tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 1; parsePtr->numTokens++; src++; numBytes--; continue; } /* * Command substitution. Call Tcl_ParseCommand recursively (and * repeatedly) to parse the nested command(s), then throw away the * parse information. */ src++; numBytes--; nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); while (1) { const char *curEnd; if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1, nestedPtr) != TCL_OK) { parsePtr->errorType = nestedPtr->errorType; parsePtr->term = nestedPtr->term; parsePtr->incomplete = nestedPtr->incomplete; TclStackFree(parsePtr->interp, nestedPtr); return TCL_ERROR; } curEnd = src + numBytes; src = nestedPtr->commandStart + nestedPtr->commandSize; numBytes = curEnd - src; Tcl_FreeParse(nestedPtr); /* * Check for the closing ']' that ends the command * substitution. It must have been the last character of the * parsed command. */ if ((nestedPtr->term < parsePtr->end) && (*(nestedPtr->term) == ']') && !(nestedPtr->incomplete)) { break; } if (numBytes == 0) { if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( "missing close-bracket", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; parsePtr->term = tokenPtr->start; parsePtr->incomplete = 1; TclStackFree(parsePtr->interp, nestedPtr); return TCL_ERROR; } } TclStackFree(parsePtr->interp, nestedPtr); tokenPtr->type = TCL_TOKEN_COMMAND; tokenPtr->size = src - tokenPtr->start; parsePtr->numTokens++; } else if (*src == '\\') { if (noSubstBS) { tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 1; parsePtr->numTokens++; src++; numBytes--; continue; } /* * Backslash substitution. */ TclParseBackslash(src, numBytes, &tokenPtr->size, NULL); if (tokenPtr->size == 1) { /* * Just a backslash, due to end of string. */ tokenPtr->type = TCL_TOKEN_TEXT; parsePtr->numTokens++; src++; numBytes--; continue; } if (src[1] == '\n') { if (numBytes == 2) { parsePtr->incomplete = 1; } /* * Note: backslash-newline is special in that it is treated * the same as a space character would be. This means that it * could terminate the token. */ if (mask & TYPE_SPACE) { if (parsePtr->numTokens == originalTokens) { goto finishToken; } break; } } tokenPtr->type = TCL_TOKEN_BS; parsePtr->numTokens++; src += tokenPtr->size; numBytes -= tokenPtr->size; } else if (*src == 0) { tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 1; parsePtr->numTokens++; src++; numBytes--; } else { Tcl_Panic("ParseTokens encountered unknown character"); } } if (parsePtr->numTokens == originalTokens) { /* * There was nothing in this range of text. Add an empty token for the * empty range, so that there is always at least one token added. */ TclGrowParseTokenArray(parsePtr, 1); tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->start = src; tokenPtr->numComponents = 0; finishToken: tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 0; parsePtr->numTokens++; } parsePtr->term = src; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_FreeParse -- * * This function is invoked to free any dynamic storage that may have * been allocated by a previous call to Tcl_ParseCommand. * * Results: * None. * * Side effects: * If there is any dynamically allocated memory in *parsePtr, it is * freed. * *---------------------------------------------------------------------- */ void Tcl_FreeParse( Tcl_Parse *parsePtr) /* Structure that was filled in by a previous * call to Tcl_ParseCommand. */ { if (parsePtr->tokenPtr != parsePtr->staticTokens) { ckfree(parsePtr->tokenPtr); parsePtr->tokenPtr = parsePtr->staticTokens; } } /* *---------------------------------------------------------------------- * * Tcl_ParseVarName -- * * Given a string starting with a $ sign, parse off a variable name and * return information about the parse. No more than numBytes bytes will * be scanned. * * Results: * The return value is TCL_OK if the command was parsed successfully and * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an * error message is left in its result. On a successful return, tokenPtr * and numTokens fields of parsePtr are filled in with information about * the variable name that was parsed. The "size" field of the first new * token gives the total number of bytes in the variable name. Other * fields in parsePtr are undefined. * * Side effects: * If there is insufficient space in parsePtr to hold all the information * about the command, then additional space is malloc-ed. If the function * returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to * release any additional space that was allocated. * *---------------------------------------------------------------------- */ int Tcl_ParseVarName( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the variable name. */ int append) /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ { Tcl_Token *tokenPtr; const char *src; int varIndex; unsigned array; if (numBytes < 0 && start) { numBytes = strlen(start); } if (!append) { TclParseInit(interp, start, numBytes, parsePtr); } if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } /* * Generate one token for the variable, an additional token for the name, * plus any number of additional tokens for the index, if there is one. */ src = start; TclGrowParseTokenArray(parsePtr, 2); tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->type = TCL_TOKEN_VARIABLE; tokenPtr->start = src; varIndex = parsePtr->numTokens; parsePtr->numTokens++; tokenPtr++; src++; numBytes--; if (numBytes == 0) { goto justADollarSign; } tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src; tokenPtr->numComponents = 0; /* * The name of the variable can have three forms: * 1. The $ sign is followed by an open curly brace. Then the variable * name is everything up to the next close curly brace, and the * variable is a scalar variable. * 2. The $ sign is not followed by an open curly brace. Then the variable * name is everything up to the next character that isn't a letter, * digit, or underscore. :: sequences are also considered part of the * variable name, in order to support namespaces. If the following * character is an open parenthesis, then the information between * parentheses is the array element name. * 3. The $ sign is followed by something that isn't a letter, digit, or * underscore: in this case, there is no variable name and the token is * just "$". */ if (*src == '{') { src++; numBytes--; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src; tokenPtr->numComponents = 0; while (numBytes && (*src != '}')) { numBytes--; src++; } if (numBytes == 0) { if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( "missing close-brace for variable name", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; parsePtr->term = tokenPtr->start-1; parsePtr->incomplete = 1; goto error; } tokenPtr->size = src - tokenPtr->start; tokenPtr[-1].size = src - tokenPtr[-1].start; parsePtr->numTokens++; src++; } else { tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src; tokenPtr->numComponents = 0; while (numBytes) { if (TclIsBareword(*src)) { src += 1; numBytes -= 1; continue; } if ((src[0] == ':') && (numBytes != 1) && (src[1] == ':')) { src += 2; numBytes -= 2; while (numBytes && (*src == ':')) { src++; numBytes--; } continue; } break; } /* * Support for empty array names here. */ array = (numBytes && (*src == '(')); tokenPtr->size = src - tokenPtr->start; if ((tokenPtr->size == 0) && !array) { goto justADollarSign; } parsePtr->numTokens++; if (array) { /* * This is a reference to an array element. Call ParseTokens * recursively to parse the element name, since it could contain * any number of substitutions. */ if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, TCL_SUBST_ALL, parsePtr)) { goto error; } if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){ if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( "missing )", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_PAREN; parsePtr->term = src; parsePtr->incomplete = 1; goto error; } src = parsePtr->term + 1; } } tokenPtr = &parsePtr->tokenPtr[varIndex]; tokenPtr->size = src - tokenPtr->start; tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1); return TCL_OK; /* * The dollar sign isn't followed by a variable name. Replace the * TCL_TOKEN_VARIABLE token with a TCL_TOKEN_TEXT token for the dollar * sign. */ justADollarSign: tokenPtr = &parsePtr->tokenPtr[varIndex]; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 1; tokenPtr->numComponents = 0; return TCL_OK; error: Tcl_FreeParse(parsePtr); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_ParseVar -- * * Given a string starting with a $ sign, parse off a variable name and * return its value. * * Results: * The return value is the contents of the variable given by the leading * characters of string. If termPtr isn't NULL, *termPtr gets filled in * with the address of the character just after the last one in the * variable specifier. If the variable doesn't exist, then the return * value is NULL and an error message will be left in interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ const char *start, /* Start of variable substitution. First * character must be "$". */ const char **termPtr) /* If non-NULL, points to word to fill in with * character just after last one in the * variable specifier. */ { Tcl_Obj *objPtr; int code; Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) { TclStackFree(interp, parsePtr); return NULL; } if (termPtr != NULL) { *termPtr = start + parsePtr->tokenPtr->size; } if (parsePtr->numTokens == 1) { /* * There isn't a variable name after all: the $ is just a $. */ TclStackFree(interp, parsePtr); return "$"; } code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, NULL, 1, NULL, NULL); Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; } objPtr = Tcl_GetObjResult(interp); /* * At this point we should have an object containing the value of a * variable. Just return the string from that object. * * Since TclSubstTokens above returned TCL_OK, we know that objPtr * is shared. It is in both the interp result and the value of the * variable. Returning the string relies on that to be true. */ assert( Tcl_IsShared(objPtr) ); Tcl_ResetResult(interp); return TclGetString(objPtr); } /* *---------------------------------------------------------------------- * * Tcl_ParseBraces -- * * Given a string in braces such as a Tcl command argument or a string * value in a Tcl expression, this function parses the string and returns * information about the parse. No more than numBytes bytes will be * scanned. * * Results: * The return value is TCL_OK if the string was parsed successfully and * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an * error message is left in its result. On a successful return, tokenPtr * and numTokens fields of parsePtr are filled in with information about * the string that was parsed. Other fields in parsePtr are undefined. * termPtr is set to point to the character just after the last one in * the braced string. * * Side effects: * If there is insufficient space in parsePtr to hold all the information * about the command, then additional space is malloc-ed. If the function * returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to * release any additional space that was allocated. * *---------------------------------------------------------------------- */ int Tcl_ParseBraces( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ const char **termPtr) /* If non-NULL, points to word in which to * store a pointer to the character just after * the terminating '}' if the parse was * successful. */ { Tcl_Token *tokenPtr; const char *src; int startIndex, level, length; if (numBytes < 0 && start) { numBytes = strlen(start); } if (!append) { TclParseInit(interp, start, numBytes, parsePtr); } if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } src = start; startIndex = parsePtr->numTokens; TclGrowParseTokenArray(parsePtr, 1); tokenPtr = &parsePtr->tokenPtr[startIndex]; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src+1; tokenPtr->numComponents = 0; level = 1; while (1) { while (++src, --numBytes) { if (CHAR_TYPE(*src) != TYPE_NORMAL) { break; } } if (numBytes == 0) { goto missingBraceError; } switch (*src) { case '{': level++; break; case '}': if (--level == 0) { /* * Decide if we need to finish emitting a partially-finished * token. There are 3 cases: * {abc \newline xyz} or {xyz} * - finish emitting "xyz" token * {abc \newline} * - don't emit token after \newline * {} - finish emitting zero-sized token * * The last case ensures that there is a token (even if empty) * that describes the braced string. */ if ((src != tokenPtr->start) || (parsePtr->numTokens == startIndex)) { tokenPtr->size = (src - tokenPtr->start); parsePtr->numTokens++; } if (termPtr != NULL) { *termPtr = src+1; } return TCL_OK; } break; case '\\': TclParseBackslash(src, numBytes, &length, NULL); if ((length > 1) && (src[1] == '\n')) { /* * A backslash-newline sequence must be collapsed, even inside * braces, so we have to split the word into multiple tokens * so that the backslash-newline can be represented * explicitly. */ if (numBytes == 2) { parsePtr->incomplete = 1; } tokenPtr->size = (src - tokenPtr->start); if (tokenPtr->size != 0) { parsePtr->numTokens++; } TclGrowParseTokenArray(parsePtr, 2); tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->type = TCL_TOKEN_BS; tokenPtr->start = src; tokenPtr->size = length; tokenPtr->numComponents = 0; parsePtr->numTokens++; src += length - 1; numBytes -= length - 1; tokenPtr++; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src + 1; tokenPtr->numComponents = 0; } else { src += length - 1; numBytes -= length - 1; } break; } } missingBraceError: parsePtr->errorType = TCL_PARSE_MISSING_BRACE; parsePtr->term = start; parsePtr->incomplete = 1; if (parsePtr->interp == NULL) { /* * Skip straight to the exit code since we have no interpreter to put * error message in. */ goto error; } Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( "missing close-brace", -1)); /* * Guess if the problem is due to comments by searching the source string * for a possible open brace within the context of a comment. Since we * aren't performing a full Tcl parse, just look for an open brace * preceded by a '#' on the same line. */ { int openBrace = 0; while (--src > start) { switch (*src) { case '{': openBrace = 1; break; case '\n': openBrace = 0; break; case '#' : if (openBrace && TclIsSpaceProcM(src[-1])) { Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp), ": possible unbalanced brace in comment", -1); goto error; } break; } } } error: Tcl_FreeParse(parsePtr); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_ParseQuotedString -- * * Given a double-quoted string such as a quoted Tcl command argument or * a quoted value in a Tcl expression, this function parses the string * and returns information about the parse. No more than numBytes bytes * will be scanned. * * Results: * The return value is TCL_OK if the string was parsed successfully and * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an * error message is left in its result. On a successful return, tokenPtr * and numTokens fields of parsePtr are filled in with information about * the string that was parsed. Other fields in parsePtr are undefined. * termPtr is set to point to the character just after the quoted * string's terminating close-quote. * * Side effects: * If there is insufficient space in parsePtr to hold all the information * about the command, then additional space is malloc-ed. If the function * returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to * release any additional space that was allocated. * *---------------------------------------------------------------------- */ int Tcl_ParseQuotedString( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ const char **termPtr) /* If non-NULL, points to word in which to * store a pointer to the character just after * the quoted string's terminating close-quote * if the parse succeeds. */ { if (numBytes < 0 && start) { numBytes = strlen(start); } if (!append) { TclParseInit(interp, start, numBytes, parsePtr); } if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL, parsePtr)) { goto error; } if (*parsePtr->term != '"') { if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( "missing \"", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; parsePtr->term = start; parsePtr->incomplete = 1; goto error; } if (termPtr != NULL) { *termPtr = (parsePtr->term + 1); } return TCL_OK; error: Tcl_FreeParse(parsePtr); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclSubstParse -- * * Token parser used by the [subst] command. Parses the string made up of * 'numBytes' bytes starting at 'bytes'. Parsing is controlled by the * flags argument to provide support for the -nobackslashes, -nocommands, * and -novariables options, as represented by the flag values * TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES. * * Results: * None. * * Side effects: * The Tcl_Parse struct '*parsePtr' is filled with parse results. * The caller is expected to eventually call Tcl_FreeParse() to properly * cleanup the value written there. * * If a parse error occurs, the Tcl_InterpState value '*statePtr' is * filled with the state created by that error. When *statePtr is written * to, the caller is expected to make the required calls to either * Tcl_RestoreInterpState() or Tcl_DiscardInterpState() to dispose of the * value written there. * *---------------------------------------------------------------------- */ void TclSubstParse( Tcl_Interp *interp, const char *bytes, int numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr) { int length = numBytes; const char *p = bytes; TclParseInit(interp, p, length, parsePtr); /* * First parse the string rep of objPtr, as if it were enclosed as a * "-quoted word in a normal Tcl command. Honor flags that selectively * inhibit types of substitution. */ if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) { /* * There was a parse error. Save the interpreter state for possible * error reporting later. */ *statePtr = Tcl_SaveInterpState(interp, TCL_ERROR); /* * We need to re-parse to get the portion of the string we can [subst] * before the parse error. Sadly, all the Tcl_Token's created by the * first parse attempt are gone, freed according to the public spec * for the Tcl_Parse* routines. The only clue we have is parse.term, * which points to either the unmatched opener, or to characters that * follow a close brace or close quote. * * Call ParseTokens again, working on the string up to parse.term. * Keep repeating until we get a good parse on a prefix. */ do { parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; parsePtr->end = parsePtr->term; parsePtr->incomplete = 0; parsePtr->errorType = TCL_PARSE_SUCCESS; } while (TCL_OK != ParseTokens(p, parsePtr->end - p, 0, flags, parsePtr)); /* * The good parse will have to be followed by {, (, or [. */ switch (*(parsePtr->term)) { case '{': /* * Parse error was a missing } in a ${varname} variable * substitution at the toplevel. We will subst everything up to * that broken variable substitution before reporting the parse * error. Substituting the leftover '$' will have no side-effects, * so the current token stream is fine. */ break; case '(': /* * Parse error was during the parsing of the index part of an * array variable substitution at the toplevel. */ if (*(parsePtr->term - 1) == '$') { /* * Special case where removing the array index left us with * just a dollar sign (array variable with name the empty * string as its name), instead of with a scalar variable * reference. * * As in the previous case, existing token stream is OK. */ } else { /* * The current parse includes a successful parse of a scalar * variable substitution where there should have been an array * variable substitution. We remove that mistaken part of the * parse before moving on. A scalar variable substitution is * two tokens. */ Tcl_Token *varTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens - 2; if (varTokenPtr->type != TCL_TOKEN_VARIABLE) { Tcl_Panic("TclSubstParse: programming error"); } if (varTokenPtr[1].type != TCL_TOKEN_TEXT) { Tcl_Panic("TclSubstParse: programming error"); } parsePtr->numTokens -= 2; } break; case '[': /* * Parse error occurred during parsing of a toplevel command * substitution. */ parsePtr->end = p + length; p = parsePtr->term + 1; length = parsePtr->end - p; if (length == 0) { /* * No commands, just an unmatched [. As in previous cases, * existing token stream is OK. */ } else { /* * We want to add the parsing of as many commands as we can * within that substitution until we reach the actual parse * error. We'll do additional parsing to determine what length * to claim for the final TCL_TOKEN_COMMAND token. */ Tcl_Token *tokenPtr; const char *lastTerm = parsePtr->term; Tcl_Parse *nestedPtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); while (TCL_OK == Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) { Tcl_FreeParse(nestedPtr); p = nestedPtr->term + (nestedPtr->term < nestedPtr->end); length = nestedPtr->end - p; if ((length == 0) && (nestedPtr->term == nestedPtr->end)) { /* * If we run out of string, blame the missing close * bracket on the last command, and do not evaluate it * during substitution. */ break; } lastTerm = nestedPtr->term; } TclStackFree(interp, nestedPtr); if (lastTerm == parsePtr->term) { /* * Parse error in first command. No commands to subst, add * no more tokens. */ break; } /* * Create a command substitution token for whatever commands * got parsed. */ TclGrowParseTokenArray(parsePtr, 1); tokenPtr = &(parsePtr->tokenPtr[parsePtr->numTokens]); tokenPtr->start = parsePtr->term; tokenPtr->numComponents = 0; tokenPtr->type = TCL_TOKEN_COMMAND; tokenPtr->size = lastTerm - tokenPtr->start + 1; parsePtr->numTokens++; } break; default: Tcl_Panic("bad parse in TclSubstParse: %c", p[length]); } } } /* *---------------------------------------------------------------------- * * TclSubstTokens -- * * Accepts an array of count Tcl_Token's, and creates a result value in * the interp from concatenating the results of performing Tcl * substitution on each Tcl_Token. Substitution is interrupted if any * non-TCL_OK completion code arises. * * Results: * The return value is a standard Tcl completion code. The result in * interp is the substituted value, or an error message if TCL_ERROR is * returned. If tokensLeftPtr is not NULL, then it points to an int where * the number of tokens remaining to be processed is written. * * Side effects: * Can be anything, depending on the types of substitution done. * *---------------------------------------------------------------------- */ int TclSubstTokens( Tcl_Interp *interp, /* Interpreter in which to lookup variables, * execute nested commands, and report * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ int count, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ int *tokensLeftPtr, /* If not NULL, points to memory where an * integer representing the number of tokens * left to be substituted will be written */ int line, /* The line the script starts on. */ int *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set by * EvalEx() to properly handle [...]-nested * commands. The 'outerScript' refers to the * most-outer script containing the embedded * command, which is refered to by 'script'. * The 'clNextOuter' refers to the current * entry in the table of continuation lines in * this "main script", and the character * offsets are relative to the 'outerScript' * as well. * * If outerScript == script, then this call is * for words in the outer-most script or * command. See Tcl_EvalEx and TclEvalObjEx * for the places generating arguments for * which this is true. */ { Tcl_Obj *result; int code = TCL_OK; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL, i, adjust; int *clPosition = NULL; Interp *iPtr = (Interp *) interp; int inFile = iPtr->evalFlags & TCL_EVAL_FILE; /* * Each pass through this loop will substitute one token, and its * components, if any. The only thing tricky here is that we go to some * effort to pass Tcl_Obj's through untouched, to avoid string copying and * Tcl_Obj creation if possible, to aid performance and limit shimmering. * * Further optimization opportunities might be to check for the equivalent * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them. */ /* * For the handling of continuation lines in literals, first check if * this is actually a literal. If not then forego the additional * processing. Otherwise preallocate a small table to store the * locations of all continuation lines we find in this literal, if any. * The table is extended if needed. */ numCL = 0; maxNumCL = 0; isLiteral = 1; for (i=0 ; i < count; i++) { if ((tokenPtr[i].type != TCL_TOKEN_TEXT) && (tokenPtr[i].type != TCL_TOKEN_BS)) { isLiteral = 0; break; } } if (isLiteral) { maxNumCL = NUM_STATIC_POS; clPosition = ckalloc(maxNumCL * sizeof(int)); } adjust = 0; result = NULL; for (; count>0 && code==TCL_OK ; count--, tokenPtr++) { Tcl_Obj *appendObj = NULL; const char *append = NULL; int appendByteLength = 0; char utfCharBytes[TCL_UTF_MAX] = ""; switch (tokenPtr->type) { case TCL_TOKEN_TEXT: append = tokenPtr->start; appendByteLength = tokenPtr->size; break; case TCL_TOKEN_BS: appendByteLength = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, utfCharBytes); append = utfCharBytes; /* * If the backslash sequence we found is in a literal, and * represented a continuation line, we compute and store its * location (as char offset to the beginning of the _result_ * script). We may have to extend the table of locations. * * Note that the continuation line information is relevant even if * the word we are processing is not a literal, as it can affect * nested commands. See the branch for TCL_TOKEN_COMMAND below, * where the adjustment we are tracking here is taken into * account. The good thing is that we do not need a table of * everything, just the number of lines we have to add as * correction. */ if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && (tokenPtr->start[1] == '\n')) { if (isLiteral) { int clPos; if (result == 0) { clPos = 0; } else { Tcl_GetStringFromObj(result, &clPos); } if (numCL >= maxNumCL) { maxNumCL *= 2; clPosition = ckrealloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; numCL++; } adjust++; } break; case TCL_TOKEN_COMMAND: { /* TIP #280: Transfer line information to nested command */ iPtr->numLevels++; code = TclInterpReady(interp); if (code == TCL_OK) { /* * Test cases: info-30.{6,8,9} */ int theline; TclAdvanceContinuations(&line, &clNextOuter, tokenPtr->start - outerScript); theline = line + adjust; code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, 0, theline, clNextOuter, outerScript); TclAdvanceLines(&line, tokenPtr->start+1, tokenPtr->start + tokenPtr->size - 1); /* * Restore flag reset by nested eval for future bracketed * commands and their cmdframe setup */ if (inFile) { iPtr->evalFlags |= TCL_EVAL_FILE; } } iPtr->numLevels--; TclResetCancellation(interp, 0); appendObj = Tcl_GetObjResult(interp); break; } case TCL_TOKEN_VARIABLE: { Tcl_Obj *arrayIndex = NULL; Tcl_Obj *varName = NULL; if (tokenPtr->numComponents > 1) { /* * Subst the index part of an array variable reference. */ code = TclSubstTokens(interp, tokenPtr+2, tokenPtr->numComponents - 1, NULL, line, NULL, NULL); arrayIndex = Tcl_GetObjResult(interp); Tcl_IncrRefCount(arrayIndex); } if (code == TCL_OK) { varName = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); appendObj = Tcl_ObjGetVar2(interp, varName, arrayIndex, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(varName); if (appendObj == NULL) { code = TCL_ERROR; } } switch (code) { case TCL_OK: /* Got value */ case TCL_ERROR: /* Already have error message */ case TCL_BREAK: /* Will not substitute anyway */ case TCL_CONTINUE: /* Will not substitute anyway */ break; default: /* * All other return codes, we will subst the result from the * code-throwing evaluation. */ appendObj = Tcl_GetObjResult(interp); } if (arrayIndex != NULL) { Tcl_DecrRefCount(arrayIndex); } count -= tokenPtr->numComponents; tokenPtr += tokenPtr->numComponents; break; } default: Tcl_Panic("unexpected token type in TclSubstTokens: %d", tokenPtr->type); } if ((code == TCL_BREAK) || (code == TCL_CONTINUE)) { /* * Inhibit substitution. */ continue; } if (result == NULL) { /* * First pass through. If we have a Tcl_Obj, just use it. If not, * create one from our string. */ if (appendObj != NULL) { result = appendObj; } else { result = Tcl_NewStringObj(append, appendByteLength); } Tcl_IncrRefCount(result); } else { /* * Subsequent passes. Append to result. */ if (Tcl_IsShared(result)) { Tcl_DecrRefCount(result); result = Tcl_DuplicateObj(result); Tcl_IncrRefCount(result); } if (appendObj != NULL) { Tcl_AppendObjToObj(result, appendObj); } else { Tcl_AppendToObj(result, append, appendByteLength); } } } if (code != TCL_ERROR) { /* Keep error message in result! */ if (result != NULL) { Tcl_SetObjResult(interp, result); /* * If the code found continuation lines (which implies that this * word is a literal), then we store the accumulated table of * locations in the thread-global data structure for the bytecode * compiler to find later, assuming that the literal is a script * which will be compiled. */ if (numCL) { TclContinuationsEnter(result, numCL, clPosition); } /* * Release the temp table we used to collect the locations of * continuation lines, if any. */ if (maxNumCL) { ckfree(clPosition); } } else { Tcl_ResetResult(interp); } } if (tokensLeftPtr != NULL) { *tokensLeftPtr = count; } if (result != NULL) { Tcl_DecrRefCount(result); } return code; } /* *---------------------------------------------------------------------- * * CommandComplete -- * * This function is shared by TclCommandComplete and * Tcl_ObjCommandComplete; it does all the real work of seeing whether a * script is complete * * Results: * 1 is returned if the script is complete, 0 if there are open * delimiters such as " or (. 1 is also returned if there is a parse * error in the script other than unmatched delimiters. * * Side effects: * None. * *---------------------------------------------------------------------- */ static inline int CommandComplete( const char *script, /* Script to check. */ int numBytes) /* Number of bytes in script. */ { Tcl_Parse parse; const char *p, *end; int result; p = script; end = p + numBytes; while (Tcl_ParseCommand(NULL, p, end - p, 0, &parse) == TCL_OK) { p = parse.commandStart + parse.commandSize; if (p >= end) { break; } Tcl_FreeParse(&parse); } if (parse.incomplete) { result = 0; } else { result = 1; } Tcl_FreeParse(&parse); return result; } /* *---------------------------------------------------------------------- * * Tcl_CommandComplete -- * * Given a partial or complete Tcl script, this function determines * whether the script is complete in the sense of having matched braces * and quotes and brackets. * * Results: * 1 is returned if the script is complete, 0 otherwise. 1 is also * returned if there is a parse error in the script other than unmatched * delimiters. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_CommandComplete( const char *script) /* Script to check. */ { return CommandComplete(script, (int) strlen(script)); } /* *---------------------------------------------------------------------- * * TclObjCommandComplete -- * * Given a partial or complete Tcl command in a Tcl object, this function * determines whether the command is complete in the sense of having * matched braces and quotes and brackets. * * Results: * 1 is returned if the command is complete, 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { int length; const char *script = Tcl_GetStringFromObj(objPtr, &length); return CommandComplete(script, length); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclParse.h0000644000175000017500000000072314554262142015206 0ustar sergeisergei/* * Minimal set of shared macro definitions and declarations so that multiple * source files can make use of the parsing table in tclParse.c */ #define TYPE_NORMAL 0 #define TYPE_SPACE 0x1 #define TYPE_COMMAND_END 0x2 #define TYPE_SUBS 0x4 #define TYPE_QUOTE 0x8 #define TYPE_CLOSE_PAREN 0x10 #define TYPE_CLOSE_BRACK 0x20 #define TYPE_BRACE 0x40 #define CHAR_TYPE(c) (tclCharTypeTable+128)[(unsigned char)(c)] MODULE_SCOPE const char tclCharTypeTable[]; tcl8.6.14/generic/tclPathObj.c0000644000175000017500000022044114554262142015457 0ustar sergeisergei/* * tclPathObj.c -- * * This file contains the implementation of Tcl's "path" object type used * to represent and manipulate a general (virtual) filesystem entity in * an efficient manner. * * Copyright (c) 2003 Vince Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclFileSystem.h" #include /* * Prototypes for functions defined later in this file. */ static Tcl_Obj * AppendPath(Tcl_Obj *head, Tcl_Obj *tail); static void DupFsPathInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); static int FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); static int MakePathFromNormalized(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths * internally. */ static const Tcl_ObjType tclFsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ UpdateStringOfFsPath, /* updateStringProc */ SetFsPathFromAny /* setFromAnyProc */ }; /* * struct FsPath -- * * Internal representation of a Tcl_Obj of "path" type. This can be used to * represent relative or absolute paths, and has certain optimisations when * used to represent paths which are already normalized and absolute. * * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular * reference to the container Tcl_Obj of this FsPath. * * There are two cases, with the first being the most common: * * (i) flags == 0, => Ordinary path. * * translatedPathPtr contains the translated path (which may be a circular * reference to the object itself). If it is NULL then the path is pure * normalized (and the normPathPtr will be a circular reference). cwdPtr is * null for an absolute path, and non-null for a relative path (unless the cwd * has never been set, in which case the cwdPtr may also be null for a * relative path). * * (ii) flags != 0, => Special path, see TclNewFSPathObj * * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir * and normPathPtr is the $tail. * */ typedef struct FsPath { Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this * is NULL, then this is a pure normalized, * absolute path object, in which the parent * Tcl_Obj's string rep is already both * translated and normalized. */ Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or * ~user sequences. If the Tcl_Obj containing * this FsPath is already normalized, this may * be a circular reference back to the * container. If that is NOT the case, we have * a refCount on the object. */ Tcl_Obj *cwdPtr; /* If null, path is absolute, else this points * to the cwd object used for this path. We * have a refCount on the object. */ int flags; /* Flags to describe interpretation - see * below. */ ClientData nativePathPtr; /* Native representation of this path, which * is filesystem dependent. */ int filesystemEpoch; /* Used to ensure the path representation was * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */ } FsPath; /* * Flag values for FsPath->flags. */ #define TCLPATH_APPENDED 1 #define TCLPATH_NEEDNORM 4 /* * Define some macros to give us convenient access to path-object specific * fields. */ #define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1) #define SETPATHOBJ(pathPtr,fsPathPtr) \ ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr)) #define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* *--------------------------------------------------------------------------- * * TclFSNormalizeAbsolutePath -- * * Takes an absolute path specification and computes a 'normalized' path * from it. * * A normalized path is one which has all '../', './' removed. Also it is * one which is in the 'standard' format for the native platform. On * Unix, this means the path must be free of symbolic links/aliases, and * on Windows it means we want the long form, with that long form's * case-dependence (which gives us a unique, case-dependent path). * * The behaviour of this function if passed a non-absolute path is NOT * defined. * * pathPtr may have a refCount of zero, or may be a shared object. * * Results: * The result is returned in a Tcl_Obj with a refCount of 1, which is * therefore owned by the caller. It must be freed (with * Tcl_DecrRefCount) by the caller when no longer needed. * * Side effects: * None (beyond the memory allocation for the result). * * Special note: * This code was originally based on code from Matt Newman and * Jean-Claude Wippler, but has since been totally rewritten by Vince * Darley to deal with symbolic links. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclFSNormalizeAbsolutePath( Tcl_Interp *interp, /* Interpreter to use */ Tcl_Obj *pathPtr) /* Absolute path to normalize */ { const char *dirSep, *oldDirSep; int first = 1; /* Set to zero once we've passed the first * directory separator - we can't use '..' to * remove the volume in a path. */ Tcl_Obj *retVal = NULL; dirSep = TclGetString(pathPtr); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if ( (dirSep[0] == '/' || dirSep[0] == '\\') && (dirSep[1] == '/' || dirSep[1] == '\\') && (dirSep[2] == '?') && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended path */ dirSep += 4; if ( (dirSep[0] == 'U' || dirSep[0] == 'u') && (dirSep[1] == 'N' || dirSep[1] == 'n') && (dirSep[2] == 'C' || dirSep[2] == 'c') && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended UNC path */ dirSep += 4; } } if (dirSep[0] != 0 && dirSep[1] == ':' && (dirSep[2] == '/' || dirSep[2] == '\\')) { /* Do nothing */ } else if ((dirSep[0] == '/' || dirSep[0] == '\\') && (dirSep[1] == '/' || dirSep[1] == '\\')) { /* * UNC style path, where we must skip over the first separator, * since the first two segments are actually inseparable. */ dirSep += 2; dirSep += FindSplitPos(dirSep, '/'); if (*dirSep != 0) { dirSep++; } } } /* * Scan forward from one directory separator to the next, checking for * '..' and '.' sequences which must be handled specially. In particular * handling of '..' can be complicated if the directory before is a link, * since we will have to expand the link to be able to back up one level. */ while (*dirSep != 0) { oldDirSep = dirSep; if (!first) { dirSep++; } dirSep += FindSplitPos(dirSep, '/'); if (dirSep[0] == 0 || dirSep[1] == 0) { if (retVal != NULL) { Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); } break; } if (dirSep[1] == '.') { if (retVal != NULL) { Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); oldDirSep = dirSep; } again: if (IsSeparatorOrNull(dirSep[2])) { /* * Need to skip '.' in the path. */ int curLen; if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } Tcl_GetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } dirSep += 2; oldDirSep = dirSep; if (dirSep[0] != 0 && dirSep[1] == '.') { goto again; } continue; } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { Tcl_Obj *linkObj; int curLen; char *linkStr; /* * Have '..' so need to skip previous directory. */ if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } Tcl_GetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { linkObj = Tcl_FSLink(retVal, NULL, 0); /* Safety check in case driver caused sharing */ if (Tcl_IsShared(retVal)) { TclDecrRefCount(retVal); retVal = Tcl_DuplicateObj(retVal); Tcl_IncrRefCount(retVal); } if (linkObj != NULL) { /* * Got a link. Need to check if the link is relative * or absolute, for those platforms where relative * links exist. */ if (tclPlatform != TCL_PLATFORM_WINDOWS && Tcl_FSGetPathType(linkObj) == TCL_PATH_RELATIVE) { /* * We need to follow this link which is relative * to retVal's directory. This means concatenating * the link onto the directory of the path so far. */ const char *path = Tcl_GetStringFromObj(retVal, &curLen); while (--curLen >= 0) { if (IsSeparatorOrNull(path[curLen])) { break; } } /* * We want the trailing slash. */ Tcl_SetObjLength(retVal, curLen+1); Tcl_AppendObjToObj(retVal, linkObj); TclDecrRefCount(linkObj); linkStr = Tcl_GetStringFromObj(retVal, &curLen); } else { /* * Absolute link. */ TclDecrRefCount(retVal); if (Tcl_IsShared(linkObj)) { retVal = Tcl_DuplicateObj(linkObj); TclDecrRefCount(linkObj); } else { retVal = linkObj; } linkStr = Tcl_GetStringFromObj(retVal, &curLen); /* * Convert to forward-slashes on windows. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { int i; for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { linkStr[i] = '/'; } } } } } else { linkStr = Tcl_GetStringFromObj(retVal, &curLen); } /* * Either way, we now remove the last path element (but * not the first character of the path). */ while (--curLen >= 0) { if (IsSeparatorOrNull(linkStr[curLen])) { if (curLen) { Tcl_SetObjLength(retVal, curLen); } else { Tcl_SetObjLength(retVal, 1); } break; } } } dirSep += 3; oldDirSep = dirSep; if ((curLen == 0) && (dirSep[0] != 0)) { Tcl_SetObjLength(retVal, 0); } if (dirSep[0] != 0 && dirSep[1] == '.') { goto again; } continue; } } first = 0; if (retVal != NULL) { Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); } } /* * If we didn't make any changes, just use the input path. */ if (retVal == NULL) { retVal = pathPtr; Tcl_IncrRefCount(retVal); if (Tcl_IsShared(retVal)) { /* * Unfortunately, the platform-specific normalization code which * will be called below has no way of dealing with the case where * an object is shared. It is expecting to modify an object in * place. So, we must duplicate this here to ensure an object with * a single ref-count. * * If that changes in the future (e.g. the normalize proc is given * one object and is able to return a different one), then we * could remove this code. */ TclDecrRefCount(retVal); retVal = Tcl_DuplicateObj(pathPtr); Tcl_IncrRefCount(retVal); } } /* * Ensure a windows drive like C:/ has a trailing separator. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { int len; const char *path = Tcl_GetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { TclDecrRefCount(retVal); retVal = Tcl_DuplicateObj(retVal); Tcl_IncrRefCount(retVal); } Tcl_AppendToObj(retVal, "/", 1); } } /* * Now we have an absolute path, with no '..', '.' sequences, but it still * may not be in 'unique' form, depending on the platform. For instance, * Unix is case-sensitive, so the path is ok. Windows is case-insensitive, * and also has the weird 'longname/shortname' thing (e.g. C:/Program * Files/ and C:/Progra~1/ are equivalent). * * Virtual file systems which may be registered may have other criteria * for normalizing a path. */ TclFSNormalizeToUniquePath(interp, retVal, 0); /* * Since we know it is a normalized path, we can actually convert this * object into an FsPath for greater efficiency */ MakePathFromNormalized(interp, retVal); /* * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. */ return retVal; } /* *---------------------------------------------------------------------- * * Tcl_FSGetPathType -- * * Determines whether a given path is relative to the current directory, * relative to the current volume, or absolute. * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_PathType Tcl_FSGetPathType( Tcl_Obj *pathPtr) { return TclFSGetPathType(pathPtr, NULL, NULL); } /* *---------------------------------------------------------------------- * * TclFSGetPathType -- * * Determines whether a given path is relative to the current directory, * relative to the current volume, or absolute. If the caller wishes to * know which filesystem claimed the path (in the case for which the path * is absolute), then a reference to a filesystem pointer can be passed * in (but passing NULL is acceptable). * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and * only if it is non-NULL and the function's return value is * TCL_PATH_ABSOLUTE. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_PathType TclFSGetPathType( Tcl_Obj *pathPtr, const Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr) { FsPath *fsPathPtr; if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } fsPathPtr = PATHOBJ(pathPtr); if (fsPathPtr->cwdPtr == NULL) { return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } if (PATHFLAGS(pathPtr) == 0) { /* The path is not absolute... */ #ifdef _WIN32 /* ... on Windows we must make another call to determine whether * it's relative or volumerelative [Bug 2571597]. */ return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); #else /* On other systems, quickly deduce !absolute -> relative */ return TCL_PATH_RELATIVE; #endif } return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, driveNameLengthPtr); } /* *--------------------------------------------------------------------------- * * TclPathPart * * This function calculates the requested part of the given path, which * can be: * * - the directory above ('file dirname') * - the tail ('file tail') * - the extension ('file extension') * - the root ('file root') * * The 'portion' parameter dictates which of these to calculate. There * are a number of special cases both to be more efficient, and because * the behaviour when given a path with only a single element is defined * to require the expansion of that single element, where possible. * * Should look into integrating 'FileBasename' in tclFCmd.c into this * function. * * Results: * NULL if an error occurred, otherwise a Tcl_Obj owned by the caller * (i.e. most likely with refCount 1). * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclPathPart( Tcl_Interp *interp, /* Used for error reporting */ Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { if (pathPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { switch (portion) { case TCL_PATH_DIRNAME: { /* * Check if the joined-on bit has any directory delimiters in * it. If so, the 'dirname' would be a joining of the main * part with the dirname of the joined-on bit. We could handle * that special case here, but we don't, and instead just use * the standardPath code. */ int numBytes; const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } /* * If the joined-on bit is empty, then [file dirname] is * documented to return all but the last non-empty element * of the path, so we need to split apart the main part to * get the right answer. We could do that here, but it's * simpler to fall back to the standardPath code. * [Bug 2710920] */ if (numBytes == 0) { goto standardPath; } if (tclPlatform == TCL_PLATFORM_WINDOWS && strchr(rest, '\\') != NULL) { goto standardPath; } /* * The joined-on path is simple, so we can just return here. */ Tcl_IncrRefCount(fsPathPtr->cwdPtr); return fsPathPtr->cwdPtr; } case TCL_PATH_TAIL: { /* * Check if the joined-on bit has any directory delimiters in * it. If so, the 'tail' would be only the part following the * last delimiter. We could handle that special case here, but * we don't, and instead just use the standardPath code. */ int numBytes; const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } /* * If the joined-on bit is empty, then [file tail] is * documented to return the last non-empty element * of the path, so we need to split off the last element * of the main part to get the right answer. We could do * that here, but it's simpler to fall back to the * standardPath code. [Bug 2710920] */ if (numBytes == 0) { goto standardPath; } if (tclPlatform == TCL_PLATFORM_WINDOWS && strchr(rest, '\\') != NULL) { goto standardPath; } Tcl_IncrRefCount(fsPathPtr->normPathPtr); return fsPathPtr->normPathPtr; } case TCL_PATH_EXTENSION: return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; int length; fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { /* * There is no extension so the root is the same as the * path we were given. */ Tcl_IncrRefCount(pathPtr); return pathPtr; } else { /* * Need to return the whole path with the extension * suffix removed. Do that by joining our "head" to * our "tail" with the extension suffix removed from * the tail. */ Tcl_Obj *resultPtr = TclNewFSPathObj(fsPathPtr->cwdPtr, fileName, (int)(length - strlen(extension))); Tcl_IncrRefCount(resultPtr); return resultPtr; } } default: /* We should never get here */ Tcl_Panic("Bad portion to TclPathPart"); /* For less clever compilers */ return NULL; } } else if (fsPathPtr->cwdPtr != NULL) { /* Relative path */ goto standardPath; } else { /* Absolute path */ goto standardPath; } } else { int splitElements; Tcl_Obj *splitPtr, *resultPtr; standardPath: resultPtr = NULL; if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { int length; const char *fileName, *extension; fileName = Tcl_GetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { Tcl_IncrRefCount(pathPtr); return pathPtr; } else { Tcl_Obj *root = Tcl_NewStringObj(fileName, (int) (length - strlen(extension))); Tcl_IncrRefCount(root); return root; } } /* * The behaviour we want here is slightly different to the standard * Tcl_FSSplitPath in the handling of home directories; * Tcl_FSSplitPath preserves the "~" while this code computes the * actual full path name, if we had just a single component. */ splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); if (splitElements == 1 && TclGetString(pathPtr)[0] == '~') { Tcl_Obj *norm; TclDecrRefCount(splitPtr); norm = Tcl_FSGetNormalizedPath(interp, pathPtr); if (norm == NULL) { return NULL; } splitPtr = Tcl_FSSplitPath(norm, &splitElements); Tcl_IncrRefCount(splitPtr); } if (portion == TCL_PATH_TAIL) { /* * Return the last component, unless it is the only component, and * it is the root of an absolute path. */ if ((splitElements > 0) && ((splitElements > 1) || (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) { Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr); } else { TclNewObj(resultPtr); } } else { /* * Return all but the last component. If there is only one * component, return it if the path was non-relative, otherwise * return the current directory. */ if (splitElements > 1) { resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); } else if (splitElements == 0 || (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { TclNewLiteralStringObj(resultPtr, "."); } else { Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr); } } Tcl_IncrRefCount(resultPtr); TclDecrRefCount(splitPtr); return resultPtr; } } /* * Simple helper function */ static Tcl_Obj * GetExtension( Tcl_Obj *pathPtr) { const char *tail, *extension; Tcl_Obj *ret; tail = TclGetString(pathPtr); extension = TclGetExtension(tail); if (extension == NULL) { TclNewObj(ret); } else { ret = Tcl_NewStringObj(extension, -1); } Tcl_IncrRefCount(ret); return ret; } /* *--------------------------------------------------------------------------- * * Tcl_FSJoinPath -- * * This function takes the given Tcl_Obj, which should be a valid list, * and returns the path object given by considering the first 'elements' * elements as valid path segments (each path segment may be a complete * path, a partial path or just a single possible directory or file * name). If any path segment is actually an absolute path, then all * prior path segments are discarded. * * If elements < 0, we use the entire list that was given. * * It is possible that the returned object is actually an element of the * given list, so the caller should be careful to store a refCount to it * before freeing the list. * * Results: * Returns object with refCount of zero, (or if non-zero, it has * references elsewhere in Tcl). Either way, the caller must increment * its refCount before use. Note that in the case where the caller has * asked to join zero elements of the list, the return value will be an * empty-string Tcl_Obj. * * If the given listObj was invalid, then the calling routine has a bug, * and this function will just return NULL. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSJoinPath( Tcl_Obj *listObj, /* Path elements to join, may have a zero * reference count. */ int elements) /* Number of elements to use (-1 = all) */ { Tcl_Obj *res; int objc; Tcl_Obj **objv; if (TclListObjLength(NULL, listObj, &objc) != TCL_OK) { return NULL; } elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; TclListObjGetElements(NULL, listObj, &objc, &objv); res = TclJoinPath(elements, objv, 0); return res; } Tcl_Obj * TclJoinPath( int elements, /* Number of elements to use (-1 = all) */ Tcl_Obj * const objv[], /* Path elements to join */ int forceRelative) /* If non-zero, assume all more paths are * relative (e.g. simple normalization) */ { Tcl_Obj *res = NULL; int i; const Tcl_Filesystem *fsPtr = NULL; assert ( elements >= 0 ); if (elements == 0) { TclNewObj(res); return res; } assert ( elements > 0 ); if (elements == 2) { Tcl_Obj *elt = objv[0]; /* * This is a special case where we can be much more efficient, where * we are joining a single relative path onto an object that is * already of path type. The 'TclNewFSPathObj' call below creates an * object which can be normalized more efficiently. Currently we only * use the special case when we have exactly two elements, but we * could expand that in the future. * * Bugfix [a47641a0]. TclNewFSPathObj requires first argument * to be an absolute path. Added a check for that elt is absolute. */ if ((elt->typePtr == &tclFsPathType) && !((elt->bytes != NULL) && (elt->bytes[0] == '\0')) && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) { Tcl_Obj *tailObj = objv[1]; Tcl_PathType type; /* if forceRelative - second path is relative */ type = forceRelative ? TCL_PATH_RELATIVE : TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; int len; str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. * There's no need to return a special path object, when * the base itself is just fine! */ return elt; } /* * If it doesn't begin with '.' and is a Unix path or it a * windows path without backslashes, then we can be very * efficient here. (In fact even a windows path with * backslashes can be joined efficiently, but the path object * would not have forward slashes only, and this would * therefore contradict our 'file join' documentation). */ if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(str, '\\') == NULL))) { /* * Finally, on Windows, 'file join' is defined to convert * all backslashes to forward slashes, so the base part * cannot have backslashes either. */ if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(Tcl_GetString(elt), '\\') == NULL)) { if (PATHFLAGS(elt)) { return TclNewFSPathObj(elt, str, len); } if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) { return TclNewFSPathObj(elt, str, len); } (void) Tcl_FSGetNormalizedPath(NULL, elt); if (elt == PATHOBJ(elt)->normPathPtr) { return TclNewFSPathObj(elt, str, len); } } } /* * Otherwise we don't have an easy join, and we must let the * more general code below handle things. */ } else if (tclPlatform == TCL_PLATFORM_UNIX) { return tailObj; } else { const char *str = TclGetString(tailObj); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(str, '\\') == NULL) { return tailObj; } } } } } assert ( res == NULL ); for (i = 0; i < elements; i++) { int driveNameLength, strEltLen, length; Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; Tcl_Obj *elt = objv[i]; strElt = Tcl_GetStringFromObj(elt, &strEltLen); driveNameLength = 0; /* if forceRelative - all paths excepting first one are relative */ type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE : TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* * Zero out the current result. */ if (res != NULL) { TclDecrRefCount(res); } if (driveName != NULL) { /* * We've been given a separate drive-name object, because the * prefix in 'elt' is not in a suitable format for us (e.g. it * may contain irrelevant multiple separators, like * C://///foo). */ res = Tcl_DuplicateObj(driveName); TclDecrRefCount(driveName); /* * Do not set driveName to NULL, because we will check its * value below (but we won't access the contents, since those * have been cleaned-up). */ } else { res = Tcl_NewStringObj(strElt, driveNameLength); } strElt += driveNameLength; } else if (driveName != NULL) { Tcl_DecrRefCount(driveName); } /* * Optimisation block: if this is the last element to be examined, and * it is absolute or the only element, and the drive-prefix was ok (if * there is one), it might be that the path is already in a suitable * form to be returned. Then we can short-cut the rest of this * function. */ if ((driveName == NULL) && (i == (elements - 1)) && (type != TCL_PATH_RELATIVE || res == NULL)) { /* * It's the last path segment. Perform a quick check if the path * is already in a suitable form. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(strElt, '\\') != NULL) { goto noQuickReturn; } } ptr = strElt; /* [Bug f34cf83dd0] */ if (driveNameLength > 0) { if (ptr[0] == '/' && ptr[-1] == '/') { goto noQuickReturn; } } while (*ptr != '\0') { if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) { /* * We have a repeated file separator, which means the path * is not in normalized form */ goto noQuickReturn; } ptr++; } if (res != NULL) { TclDecrRefCount(res); } /* * This element is just what we want to return already; no further * manipulation is requred. */ return elt; } /* * The path element was not of a suitable form to be returned as is. * We need to perform a more complex operation here. */ noQuickReturn: if (res == NULL) { TclNewObj(res); ptr = Tcl_GetStringFromObj(res, &length); } else { ptr = Tcl_GetStringFromObj(res, &length); } /* * Strip off any './' before a tilde, unless this is the beginning of * the path. */ if (length > 0 && strEltLen > 0 && (strElt[0] == '.') && (strElt[1] == '/') && (strElt[2] == '~')) { strElt += 2; } /* * A NULL value for fsPtr at this stage basically means we're trying * to join a relative path onto something which is also relative (or * empty). There's nothing particularly wrong with that. */ if (*strElt == '\0') { continue; } if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) { TclpNativeJoinPath(res, strElt); } else { char separator = '/'; int needsSep = 0; if (fsPtr->filesystemSeparatorProc != NULL) { Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(res); if (sep != NULL) { separator = TclGetString(sep)[0]; Tcl_DecrRefCount(sep); } /* Safety check in case the VFS driver caused sharing */ if (Tcl_IsShared(res)) { TclDecrRefCount(res); res = Tcl_DuplicateObj(res); Tcl_IncrRefCount(res); } } if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); Tcl_GetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + (int) strlen(strElt)); ptr = TclGetString(res) + length; for (; *strElt != '\0'; strElt++) { if (*strElt == separator) { while (strElt[1] == separator) { strElt++; } if (strElt[1] != '\0') { if (needsSep) { *ptr++ = separator; } } } else { *ptr++ = *strElt; needsSep = 1; } } length = ptr - TclGetString(res); Tcl_SetObjLength(res, length); } } assert ( res != NULL ); return res; } /* *--------------------------------------------------------------------------- * * Tcl_FSConvertToPathType -- * * This function tries to convert the given Tcl_Obj to a valid Tcl path * type, taking account of the fact that the cwd may have changed even if * this object is already supposedly of the correct type. * * The filename may begin with "~" (to indicate current user's home * directory) or "~" (to indicate any user's home directory). * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ int Tcl_FSConvertToPathType( Tcl_Interp *interp, /* Interpreter in which to store error message * (if necessary). */ Tcl_Obj *pathPtr) /* Object to convert to a valid, current path * type. */ { /* * While it is bad practice to examine an object's type directly, this is * actually the best thing to do here. The reason is that if we are * converting this object to FsPath type for the first time, we don't need * to worry whether the 'cwd' has changed. On the other hand, if this * object is already of FsPath type, and is a relative path, we do have to * worry about the cwd. If the cwd has changed, we must recompute the * path. */ if (pathPtr->typePtr == &tclFsPathType) { if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { return TCL_OK; } if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } FreeFsPathInternalRep(pathPtr); } return SetFsPathFromAny(interp, pathPtr); /* * We used to have more complex code here: * * FsPath *fsPathPtr = PATHOBJ(pathPtr); * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { * return TCL_OK; * } else { * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { * return TCL_OK; * } else { * if (pathPtr->bytes == NULL) { * UpdateStringOfFsPath(pathPtr); * } * FreeFsPathInternalRep(pathPtr); * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); * } * } * * But we no longer believe this is necessary. */ } /* * Helper function for normalization. */ static int IsSeparatorOrNull( int ch) { if (ch == 0) { return 1; } switch (tclPlatform) { case TCL_PLATFORM_UNIX: return (ch == '/' ? 1 : 0); case TCL_PLATFORM_WINDOWS: return ((ch == '/' || ch == '\\') ? 1 : 0); } return 0; } /* * Helper function for SetFsPathFromAny. Returns position of first directory * delimiter in the path. If no separator is found, then returns the position * of the end of the string. */ static int FindSplitPos( const char *path, int separator) { int count = 0; switch (tclPlatform) { case TCL_PLATFORM_UNIX: while (path[count] != 0) { if (path[count] == separator) { return count; } count++; } break; case TCL_PLATFORM_WINDOWS: while (path[count] != 0) { if (path[count] == separator || path[count] == '\\') { return count; } count++; } break; } return count; } /* *--------------------------------------------------------------------------- * * TclNewFSPathObj -- * * Creates a path object whose string representation is '[file join * dirPtr addStrRep]', but does so in a way that allows for more * efficient creation and caching of normalized paths, and more efficient * 'file dirname', 'file tail', etc. * * Assumptions: * 'dirPtr' must be an absolute path. 'len' may not be zero. * * Results: * The new Tcl object, with refCount zero. * * Side effects: * Memory is allocated. 'dirPtr' gets an additional refCount. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclNewFSPathObj( Tcl_Obj *dirPtr, const char *addStrRep, int len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; const char *p; int state = 0, count = 0; /* [Bug 2806250] - this is only a partial solution of the problem. * The PATHFLAGS != 0 representation assumes in many places that * the "tail" part stored in the normPathPtr field is itself a * relative path. Strings that begin with "~" are not relative paths, * so we must prevent their storage in the normPathPtr field. * * More generally we ought to be testing "addStrRep" for any value * that is not a relative path, but in an unconstrained VFS world * that could be just about anything, and testing could be expensive. * Since this routine plays a big role in [glob], anything that slows * it down would be unwelcome. For now, continue the risk of further * bugs when some Tcl_Filesystem uses otherwise relative path strings * as absolute path strings. Sensible Tcl_Filesystems will avoid * that by mounting on path prefixes like foo:// which cannot be the * name of a file or directory read from a native [glob] operation. */ if (addStrRep[0] == '~') { Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len); pathPtr = AppendPath(dirPtr, tail); Tcl_DecrRefCount(tail); return pathPtr; } TclNewObj(pathPtr); fsPathPtr = ckalloc(sizeof(FsPath)); /* * Set up the path. */ fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len); Tcl_IncrRefCount(fsPathPtr->normPathPtr); fsPathPtr->cwdPtr = dirPtr; Tcl_IncrRefCount(dirPtr); fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; fsPathPtr->filesystemEpoch = 0; SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; pathPtr->typePtr = &tclFsPathType; pathPtr->bytes = NULL; pathPtr->length = 0; /* * Look for path components made up of only "." * This is overly conservative analysis to keep simple. It may mark some * things as needing more aggressive normalization that don't actually * need it. No harm done. */ for (p = addStrRep; len > 0; p++, len--) { switch (state) { case 0: /* So far only "." since last dirsep or start */ switch (*p) { case '.': count++; break; case '/': case '\\': case ':': if (count) { PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; len = 0; } break; default: count = 0; state = 1; } break; case 1: /* Scanning for next dirsep */ switch (*p) { case '/': case '\\': case ':': state = 0; break; } } } if (len == 0 && count) { PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; } return pathPtr; } static Tcl_Obj * AppendPath( Tcl_Obj *head, Tcl_Obj *tail) { int numBytes; const char *bytes; Tcl_Obj *copy = Tcl_DuplicateObj(head); /* * This is likely buggy when dealing with virtual filesystem drivers * that use some character other than "/" as a path separator. I know * of no evidence that such a foolish thing exists. This solution was * chosen so that "JoinPath" operations that pass through either path * internalrep produce the same results; that is, bugward compatibility. If * we need to fix that bug here, it needs fixing in TclJoinPath() too. */ bytes = Tcl_GetStringFromObj(tail, &numBytes); if (numBytes == 0) { Tcl_AppendToObj(copy, "/", 1); } else { TclpNativeJoinPath(copy, bytes); } return copy; } /* *--------------------------------------------------------------------------- * * TclFSMakePathRelative -- * * Only for internal use. * * Takes a path and a directory, where we _assume_ both path and * directory are absolute, normalized and that the path lies inside the * directory. Returns a Tcl_Obj representing filename of the path * relative to the directory. * * Results: * NULL on error, otherwise a valid object, typically with refCount of * zero, which it is assumed the caller will increment. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclFSMakePathRelative( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr, /* The path we have. */ Tcl_Obj *cwdPtr) /* Make it relative to this. */ { int cwdLen, len; const char *tempStr; if (pathPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { return fsPathPtr->normPathPtr; } } /* * We know the cwd is a normalised object which does not end in a * directory delimiter, unless the cwd is the name of a volume, in which * case it will end in a delimiter! We handle this situation here. A * better test than the '!= sep' might be to simply check if 'cwd' is a * root volume. * * Note that if we get this wrong, we will strip off either too much or * too little below, leading to wrong answers returned by glob. */ tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the * Windows special case? Perhaps we should just check if cwd is a root * volume. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (tempStr[cwdLen-1] != '/') { cwdLen++; } break; case TCL_PLATFORM_WINDOWS: if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') { cwdLen++; } break; } tempStr = Tcl_GetStringFromObj(pathPtr, &len); return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); } /* *--------------------------------------------------------------------------- * * MakePathFromNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an absolute * normalized path. Only for internal use. * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ static int MakePathFromNormalized( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* * Free old representation */ if (pathPtr->typePtr != NULL) { if (pathPtr->bytes == NULL) { if (pathPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't find object string representation", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF", NULL); } return TCL_ERROR; } pathPtr->typePtr->updateStringProc(pathPtr); } TclFreeIntRep(pathPtr); } fsPathPtr = ckalloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. */ fsPathPtr->translatedPathPtr = NULL; /* * Circular reference by design. */ fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; /* Remember the epoch under which we decided pathPtr was normalized */ fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; return TCL_OK; } /* *--------------------------------------------------------------------------- * * Tcl_FSNewNativePath -- * * This function performs the something like the reverse of the usual * obj->path->nativerep conversions. If some code retrieves a path in * native form (from, e.g. readlink or a native dialog), and that path is * to be used at the Tcl level, then calling this function is an * efficient way of creating the appropriate path object type. * * Any memory which is allocated for 'clientData' should be retained * until clientData is passed to the filesystem's freeInternalRepProc * when it can be freed. The built in platform-specific filesystems use * 'ckalloc' to allocate clientData, and ckfree to free it. * * Results: * NULL or a valid path object pointer, with refCount zero. * * Side effects: * New memory may be allocated. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, ClientData clientData) { Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); } if (pathPtr == NULL) { return NULL; } /* * Free old representation; shouldn't normally be any, but best to be * safe. */ if (pathPtr->typePtr != NULL) { if (pathPtr->bytes == NULL) { if (pathPtr->typePtr->updateStringProc == NULL) { return NULL; } pathPtr->typePtr->updateStringProc(pathPtr); } TclFreeIntRep(pathPtr); } fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; /* * Circular reference, by design. */ fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsPtr = fromFilesystem; fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; return pathPtr; } /* *--------------------------------------------------------------------------- * * Tcl_FSGetTranslatedPath -- * * This function attempts to extract the translated path from the given * Tcl_Obj. If the translation succeeds (i.e. the object is a valid * path), then it is returned. Otherwise NULL will be returned, and an * error message may be left in the interpreter (if it is non-NULL) * * Results: * NULL or a valid Tcl_Obj pointer. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSGetTranslatedPath( Tcl_Interp *interp, Tcl_Obj *pathPtr) { Tcl_Obj *retObj = NULL; FsPath *srcFsPathPtr; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { if (PATHFLAGS(pathPtr) != 0) { /* * We lack a translated path result, but we have a directory * (cwdPtr) and a tail (normPathPtr), and if we join the * translated version of cwdPtr to normPathPtr, we'll get the * translated result we need, and can store it for future use. */ Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp, srcFsPathPtr->cwdPtr); if (translatedCwdPtr == NULL) { return NULL; } retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, &srcFsPathPtr->normPathPtr); srcFsPathPtr->translatedPathPtr = retObj; if (translatedCwdPtr->typePtr == &tclFsPathType) { srcFsPathPtr->filesystemEpoch = PATHOBJ(translatedCwdPtr)->filesystemEpoch; } else { srcFsPathPtr->filesystemEpoch = 0; } Tcl_IncrRefCount(retObj); Tcl_DecrRefCount(translatedCwdPtr); } else { /* * It is a pure absolute, normalized path object. This is * something like being a 'pure list'. The object's string, * translatedPath and normalizedPath are all identical. */ retObj = srcFsPathPtr->normPathPtr; } } else { /* * It is an ordinary path object. */ retObj = srcFsPathPtr->translatedPathPtr; } if (retObj != NULL) { Tcl_IncrRefCount(retObj); } return retObj; } /* *--------------------------------------------------------------------------- * * Tcl_FSGetTranslatedStringPath -- * * This function attempts to extract the translated path from the given * Tcl_Obj. If the translation succeeds (i.e. the object is a valid * path), then the path is returned. Otherwise NULL will be returned, and * an error message may be left in the interpreter (if it is non-NULL) * * Results: * NULL or a valid string. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' * *--------------------------------------------------------------------------- */ const char * Tcl_FSGetTranslatedStringPath( Tcl_Interp *interp, Tcl_Obj *pathPtr) { Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { int len; const char *orig = Tcl_GetStringFromObj(transPtr, &len); char *result = ckalloc(len+1); memcpy(result, orig, len+1); TclDecrRefCount(transPtr); return result; } return NULL; } /* *--------------------------------------------------------------------------- * * Tcl_FSGetNormalizedPath -- * * This important function attempts to extract from the given Tcl_Obj a * unique normalised path representation, whose string value can be used * as a unique identifier for the file. * * Results: * NULL or a valid path object pointer. * * Side effects: * New memory may be allocated. The Tcl 'errno' may be modified in the * process of trying to examine various path possibilities. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSGetNormalizedPath( Tcl_Interp *interp, Tcl_Obj *pathPtr) { FsPath *fsPathPtr; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { /* * This is a special path object which is the result of something like * 'file join' */ Tcl_Obj *dir, *copy; int tailLen, cwdLen, pathType; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { return NULL; } /* TODO: Figure out why this is needed. */ if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { copy = AppendPath(dir, fsPathPtr->normPathPtr); } else { copy = Tcl_DuplicateObj(dir); } Tcl_IncrRefCount(dir); Tcl_IncrRefCount(copy); /* * We now own a reference on both 'dir' and 'copy' */ (void) Tcl_GetStringFromObj(dir, &cwdLen); /* Normalize the combined string. */ if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) { /* * If the "tail" part has components (like /../) that cause the * combined path to need more complete normalizing, call on the * more powerful routine to accomplish that so we avoid [Bug * 2385549] ... */ Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy); Tcl_DecrRefCount(copy); copy = newCopy; } else { /* * ... but in most cases where we join a trouble free tail to a * normalized head, we can more efficiently normalize the combined * path by passing over only the unnormalized tail portion. When * this is sufficient, prior developers claim this should be much * faster. We use 'cwdLen' so that we are already pointing at * the dir-separator that we know about. The normalization code * will actually start off directly after that separator. */ TclFSNormalizeToUniquePath(interp, copy, cwdLen); } /* Now we need to construct the new path object. */ if (pathType == TCL_PATH_RELATIVE) { Tcl_Obj *origDir = fsPathPtr->cwdPtr; /* * NOTE: here we are (dangerously?) assuming that origDir points * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The * pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); * above that set the pathType value should have established that, * but it's far less clear on what basis we know there's been no * shimmering since then. */ FsPath *origDirFsPathPtr = PATHOBJ(origDir); fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; Tcl_IncrRefCount(fsPathPtr->cwdPtr); TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; /* * That's our reference to copy used. */ TclDecrRefCount(dir); TclDecrRefCount(origDir); } else { TclDecrRefCount(fsPathPtr->cwdPtr); fsPathPtr->cwdPtr = NULL; TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; /* * That's our reference to copy used. */ TclDecrRefCount(dir); } PATHFLAGS(pathPtr) = 0; } /* * Ensure cwd hasn't changed. */ if (fsPathPtr->cwdPtr != NULL) { if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } FreeFsPathInternalRep(pathPtr); if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { return NULL; } fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { int cwdLen; Tcl_Obj *copy; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); /* * Normalize the combined string, but only starting after the end * of the previously normalized 'dir'. This should be much faster! */ TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); fsPathPtr->normPathPtr = copy; Tcl_IncrRefCount(fsPathPtr->normPathPtr); } } if (fsPathPtr->normPathPtr == NULL) { Tcl_Obj *useThisCwd = NULL; int pureNormalized = 1; /* * Since normPathPtr is NULL, but this is a valid path object, we know * that the translatedPathPtr cannot be NULL. */ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; const char *path = TclGetString(absolutePath); Tcl_IncrRefCount(absolutePath); /* * We have to be a little bit careful here to avoid infinite loops * we're asking Tcl_FSGetPathType to return the path's type, but that * call can actually result in a lot of other filesystem action, which * might loop back through here. */ if (path[0] == '\0') { /* * Special handling for the empty string value. This one is very * weird with [file normalize {}] => {}. (The reasoning supporting * this is unknown to DGP, but he fears changing it.) Attempt here * to keep the expectations of other parts of Tcl_Filesystem code * about state of the FsPath fields satisfied. * * In particular, capture the cwd value and save so it can be * stored in the cwdPtr field below. */ useThisCwd = Tcl_FSGetCwd(interp); } else { /* * We don't ask for the type of 'pathPtr' here, because that is * not correct for our purposes when we have a path like '~'. Tcl * has a bit of a contradiction in that '~' paths are defined as * 'absolute', but in reality can be just about anything, * depending on how env(HOME) is set. */ Tcl_PathType type = Tcl_FSGetPathType(absolutePath); if (type == TCL_PATH_RELATIVE) { useThisCwd = Tcl_FSGetCwd(interp); if (useThisCwd == NULL) { return NULL; } pureNormalized = 0; Tcl_DecrRefCount(absolutePath); absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); /* * We have a refCount on the cwd. */ #ifdef _WIN32 } else if (type == TCL_PATH_VOLUME_RELATIVE) { /* * Only Windows has volume-relative paths. */ Tcl_DecrRefCount(absolutePath); absolutePath = TclWinVolumeRelativeNormalize(interp, path, &useThisCwd); if (absolutePath == NULL) { return NULL; } pureNormalized = 0; #endif /* _WIN32 */ } } /* * Already has refCount incremented. */ fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath); /* * Check if path is pure normalized (this can only be the case if it * is an absolute path). */ if (pureNormalized) { int normPathLen, pathLen; const char *normPath; path = TclGetStringFromObj(pathPtr, &pathLen); normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen); if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) { /* * The path was already normalized. Get rid of the duplicate. */ TclDecrRefCount(fsPathPtr->normPathPtr); /* * We do *not* increment the refCount for this circular * reference. */ fsPathPtr->normPathPtr = pathPtr; } } if (useThisCwd != NULL) { /* * We just need to free an object we allocated above for relative * paths (this was returned by Tcl_FSJoinToPath above), and then * of course store the cwd. */ fsPathPtr->cwdPtr = useThisCwd; } TclDecrRefCount(absolutePath); } return fsPathPtr->normPathPtr; } /* *--------------------------------------------------------------------------- * * Tcl_FSGetInternalRep -- * * Extract the internal representation of a given path object, in the * given filesystem. If the path object belongs to a different * filesystem, we return NULL. * * If the internal representation is currently NULL, we attempt to * generate it, by calling the filesystem's * 'Tcl_FSCreateInternalRepProc'. * * Results: * NULL or a valid internal representation. * * Side effects: * An attempt may be made to convert the object. * *--------------------------------------------------------------------------- */ ClientData Tcl_FSGetInternalRep( Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr) { FsPath *srcFsPathPtr; if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { return NULL; } srcFsPathPtr = PATHOBJ(pathPtr); /* * We will only return the native representation for the caller's * filesystem. Otherwise we will simply return NULL. This means that there * must be a unique bi-directional mapping between paths and filesystems, * and that this mapping will not allow 'remapped' files -- files which * are in one filesystem but mapped into another. Another way of putting * this is that 'stacked' filesystems are not allowed. We recognise that * this is a potentially useful feature for the future. * * Even something simple like a 'pass through' filesystem which logs all * activity and passes the calls onto the native system would be nice, but * not easily achievable with the current implementation. */ if (srcFsPathPtr->fsPtr == NULL) { /* * This only usually happens in wrappers like TclpStat which create a * string object and pass it to TclpObjStat. Code which calls the * Tcl_FS.. functions should always have a filesystem already set. * Whether this code path is legal or not depends on whether we decide * to allow external code to call the native filesystem directly. It * is at least safer to allow this sub-optimal routing. */ Tcl_FSGetFileSystemForPath(pathPtr); /* * If we fail through here, then the path is probably not a valid path * in the filesystsem, and is most likely to be a use of the empty * path "" via a direct call to one of the objectified interfaces * (e.g. from the Tcl testsuite). */ srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->fsPtr == NULL) { return NULL; } } /* * There is still one possibility we should consider; if the file belongs * to a different filesystem, perhaps it is actually linked through to a * file in our own filesystem which we do care about. The way we can check * for this is we ask what filesystem this path belongs to. */ if (fsPtr != srcFsPathPtr->fsPtr) { const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); if (actualFs == fsPtr) { return Tcl_FSGetInternalRep(pathPtr, fsPtr); } return NULL; } if (srcFsPathPtr->nativePathPtr == NULL) { Tcl_FSCreateInternalRepProc *proc; char *nativePathPtr; proc = srcFsPathPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } nativePathPtr = proc(pathPtr); srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->nativePathPtr = nativePathPtr; srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } return srcFsPathPtr->nativePathPtr; } /* *--------------------------------------------------------------------------- * * TclFSEnsureEpochOk -- * * This will ensure the pathPtr is up to date and can be converted into a * "path" type, and that we are able to generate a complete normalized * path which is used to determine the filesystem match. * * Results: * Standard Tcl return code. * * Side effects: * An attempt may be made to convert the object. * *--------------------------------------------------------------------------- */ int TclFSEnsureEpochOk( Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr) { FsPath *srcFsPathPtr; if (pathPtr->typePtr != &tclFsPathType) { return TCL_OK; } srcFsPathPtr = PATHOBJ(pathPtr); /* * Check if the filesystem has changed in some way since this object's * internal representation was calculated. */ if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) { /* * We have to discard the stale representation and recalculate it. */ if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } FreeFsPathInternalRep(pathPtr); if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return TCL_ERROR; } srcFsPathPtr = PATHOBJ(pathPtr); } /* * Check whether the object is already assigned to a fs. */ if (srcFsPathPtr->fsPtr != NULL) { *fsPtrPtr = srcFsPathPtr->fsPtr; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclFSSetPathDetails -- * * ??? * * Results: * None * * Side effects: * ??? * *--------------------------------------------------------------------------- */ void TclFSSetPathDetails( Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr, ClientData clientData) { FsPath *srcFsPathPtr; /* * Make sure pathPtr is of the correct type. */ if (pathPtr->typePtr != &tclFsPathType) { if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return; } } srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->fsPtr = fsPtr; srcFsPathPtr->nativePathPtr = clientData; srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } /* *--------------------------------------------------------------------------- * * Tcl_FSEqualPaths -- * * This function tests whether the two paths given are equal path * objects. If either or both is NULL, 0 is always returned. * * Results: * 1 or 0. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tcl_FSEqualPaths( Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) { const char *firstStr, *secondStr; int firstLen, secondLen, tempErrno; if (firstPtr == secondPtr) { return 1; } if (firstPtr == NULL || secondPtr == NULL) { return 0; } firstStr = TclGetStringFromObj(firstPtr, &firstLen); secondStr = TclGetStringFromObj(secondPtr, &secondLen); if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) { return 1; } /* * Try the most thorough, correct method of comparing fully normalized * paths. */ tempErrno = Tcl_GetErrno(); firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr); secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr); Tcl_SetErrno(tempErrno); if (firstPtr == NULL || secondPtr == NULL) { return 0; } firstStr = TclGetStringFromObj(firstPtr, &firstLen); secondStr = TclGetStringFromObj(secondPtr, &secondLen); return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)); } /* *--------------------------------------------------------------------------- * * SetFsPathFromAny -- * * This function tries to convert the given Tcl_Obj to a valid Tcl path * type. * * The filename may begin with "~" (to indicate current user's home * directory) or "~" (to indicate any user's home directory). * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ static int SetFsPathFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* * First step is to translate the filename. This is similar to * Tcl_TranslateFilename, but shouldn't convert everything to windows * backslashes on that platform. The current implementation of this piece * is a slightly optimised version of the various Tilde/Split/Join stuff * to avoid multiple split/join operations. * * We remove any trailing directory separator. * * However, the split/join routines are quite complex, and one has to make * sure not to break anything on Unix or Win (fCmd.test, fileName.test and * cmdAH.test exercise most of the code). */ name = Tcl_GetStringFromObj(pathPtr, &len); /* * Handle tilde substitutions, if needed. */ if (len && name[0] == '~') { Tcl_DString temp; int split; char separator = '/'; /* * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc. * split becomes value 1 for '~/...' as well as for '~'. */ split = FindSplitPos(name, separator); /* * Do some tilde substitution. */ if (split == 1) { /* * We have just '~' (or '~/...') */ const char *dir; Tcl_DString dirString; dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't find HOME environment variable to" " expand path", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "HOMELESS", NULL); } return TCL_ERROR; } Tcl_DStringInit(&temp); Tcl_JoinPath(1, &dir, &temp); Tcl_DStringFree(&dirString); } else { /* * We have a user name '~user' */ const char *expandedUser; Tcl_DString userName; Tcl_DStringInit(&userName); Tcl_DStringAppend(&userName, name+1, split-1); expandedUser = Tcl_DStringValue(&userName); Tcl_DStringInit(&temp); if (TclpGetUserHome(expandedUser, &temp) == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "user \"%s\" doesn't exist", expandedUser)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", NULL); } Tcl_DStringFree(&userName); Tcl_DStringFree(&temp); return TCL_ERROR; } Tcl_DStringFree(&userName); } transPtr = TclDStringToObj(&temp); if (split != len) { /* * Join up the tilde substitution with the rest. */ if (name[split+1] == separator) { /* * Somewhat tricky case like ~//foo/bar. Make use of * Split/Join machinery to get it right. Assumes all paths * beginning with ~ are part of the native filesystem. */ int objc; Tcl_Obj **objv; Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); TclListObjGetElements(NULL, parts, &objc, &objv); /* * Skip '~'. It's replaced by its expansion. */ objc--; objv++; while (objc--) { TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++)); } TclDecrRefCount(parts); } else { Tcl_Obj *pair[2]; pair[0] = transPtr; pair[1] = Tcl_NewStringObj(name+split+1, -1); transPtr = TclJoinPath(2, pair, 1); if (transPtr != pair[0]) { Tcl_DecrRefCount(pair[0]); } if (transPtr != pair[1]) { Tcl_DecrRefCount(pair[1]); } } } } else { transPtr = TclJoinPath(1, &pathPtr, 1); } /* * Now we have a translated filename in 'transPtr'. This will have forward * slashes on Windows, and will not contain any ~user sequences. */ fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; if (transPtr != pathPtr) { Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); /* Redo translation when $env(HOME) changes */ fsPathPtr->filesystemEpoch = TclFSEpoch(); } else { fsPathPtr->filesystemEpoch = 0; } fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; /* * Free old representation before installing our new one. */ TclFreeIntRep(pathPtr); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; return TCL_OK; } static void FreeFsPathInternalRep( Tcl_Obj *pathPtr) /* Path object with internal rep to free. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (fsPathPtr->translatedPathPtr != NULL) { if (fsPathPtr->translatedPathPtr != pathPtr) { TclDecrRefCount(fsPathPtr->translatedPathPtr); } } if (fsPathPtr->normPathPtr != NULL) { if (fsPathPtr->normPathPtr != pathPtr) { TclDecrRefCount(fsPathPtr->normPathPtr); } fsPathPtr->normPathPtr = NULL; } if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); } if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = fsPathPtr->fsPtr->freeInternalRepProc; if (freeProc != NULL) { freeProc(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } ckfree(fsPathPtr); pathPtr->typePtr = NULL; } static void DupFsPathInternalRep( Tcl_Obj *srcPtr, /* Path obj with internal rep to copy. */ Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { FsPath *srcFsPathPtr = PATHOBJ(srcPtr); FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath)); SETPATHOBJ(copyPtr, copyFsPathPtr); if (srcFsPathPtr->translatedPathPtr == srcPtr) { /* Cycle in src -> make cycle in copy. */ copyFsPathPtr->translatedPathPtr = copyPtr; } else { copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; if (copyFsPathPtr->translatedPathPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); } } if (srcFsPathPtr->normPathPtr == srcPtr) { /* Cycle in src -> make cycle in copy. */ copyFsPathPtr->normPathPtr = copyPtr; } else { copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; if (copyFsPathPtr->normPathPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); } } copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; if (copyFsPathPtr->cwdPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->cwdPtr); } copyFsPathPtr->flags = srcFsPathPtr->flags; if (srcFsPathPtr->fsPtr != NULL && srcFsPathPtr->nativePathPtr != NULL) { Tcl_FSDupInternalRepProc *dupProc = srcFsPathPtr->fsPtr->dupInternalRepProc; if (dupProc != NULL) { copyFsPathPtr->nativePathPtr = dupProc(srcFsPathPtr->nativePathPtr); } else { copyFsPathPtr->nativePathPtr = NULL; } } else { copyFsPathPtr->nativePathPtr = NULL; } copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; copyPtr->typePtr = &tclFsPathType; } /* *--------------------------------------------------------------------------- * * UpdateStringOfFsPath -- * * Gives an object a valid string rep. * * Results: * None. * * Side effects: * Memory may be allocated. * *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); int cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { Tcl_Panic("Called UpdateStringOfFsPath with invalid object"); } copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; copy->bytes = tclEmptyStringRep; copy->length = 0; TclDecrRefCount(copy); } /* *--------------------------------------------------------------------------- * * TclNativePathInFilesystem -- * * Any path object is acceptable to the native filesystem, by default (we * will throw errors when illegal paths are actually tried to be used). * * However, this behavior means the native filesystem must be the last * filesystem in the lookup list (otherwise it will claim all files * belong to it, and other filesystems will never get a look in). * * Results: * TCL_OK, to indicate 'yes', -1 to indicate no. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TclNativePathInFilesystem( Tcl_Obj *pathPtr, ClientData *clientDataPtr) { /* * A special case is required to handle the empty path "". This is a valid * path (i.e. the user should be able to do 'file exists ""' without * throwing an error), but equally the path doesn't exist. Those are the * semantics of Tcl (at present anyway), so we have to abide by them here. */ if (pathPtr->typePtr == &tclFsPathType) { if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') { /* * We reject the empty path "". */ return -1; } /* * Otherwise there is no way this path can be empty. */ } else { /* * It is somewhat unusual to reach this code path without the object * being of tclFsPathType. However, we do our best to deal with the * situation. */ int len; (void) Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { /* * We reject the empty path "". */ return -1; } } /* * Path is of correct type, or is of non-zero length, so we accept it. */ return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclPipe.c0000644000175000017500000007610014554262142015026 0ustar sergeisergei/* * tclPipe.c -- * * This file contains the generic portion of the command channel driver * as well as various utility routines used in managing subprocesses. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * A linked list of the following structures is used to keep track of child * processes that have been detached but haven't exited yet, so we can make * sure that they're properly "reaped" (officially waited for) and don't lie * around as zombies cluttering the system. */ typedef struct Detached { Tcl_Pid pid; /* Id of process that's been detached but * isn't known to have exited. */ struct Detached *nextPtr; /* Next in list of all detached processes. */ } Detached; static Detached *detList = NULL;/* List of all detached proceses. */ TCL_DECLARE_MUTEX(pipeMutex) /* Guard access to detList. */ /* * Declarations for local functions defined in this file: */ static TclFile FileForRedirect(Tcl_Interp *interp, const char *spec, int atOk, const char *arg, const char *nextArg, int flags, int *skipPtr, int *closePtr, int *releasePtr); /* *---------------------------------------------------------------------- * * FileForRedirect -- * * This function does much of the work of parsing redirection operators. * It handles "@" if specified and allowed, and a file name, and opens * the file if necessary. * * Results: * The return value is the descriptor number for the file. If an error * occurs then NULL is returned and an error message is left in the * interp's result. Several arguments are side-effected; see the argument * list below for details. * * Side effects: * None. * *---------------------------------------------------------------------- */ static TclFile FileForRedirect( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ const char *spec, /* Points to character just after redirection * character. */ int atOK, /* Non-zero means that '@' notation can be * used to specify a channel, zero means that * it isn't. */ const char *arg, /* Pointer to entire argument containing spec: * used for error reporting. */ const char *nextArg, /* Next argument in argc/argv array, if needed * for file name or channel name. May be * NULL. */ int flags, /* Flags to use for opening file or to specify * mode for channel. */ int *skipPtr, /* Filled with 1 if redirection target was in * spec, 2 if it was in nextArg. */ int *closePtr, /* Filled with one if the caller should close * the file when done with it, zero * otherwise. */ int *releasePtr) { int writing = (flags & O_WRONLY); Tcl_Channel chan; TclFile file; *skipPtr = 1; if ((atOK != 0) && (*spec == '@')) { spec++; if (*spec == '\0') { spec = nextArg; if (spec == NULL) { goto badLastArg; } *skipPtr = 2; } chan = Tcl_GetChannel(interp, spec, NULL); if (chan == (Tcl_Channel) NULL) { return NULL; } file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE); if (file == NULL) { Tcl_Obj *msg; Tcl_GetChannelError(chan, &msg); if (msg) { Tcl_SetObjResult(interp, msg); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for %s", Tcl_GetChannelName(chan), ((writing) ? "writing" : "reading"))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "BADCHAN", NULL); } return NULL; } *releasePtr = 1; if (writing) { /* * Be sure to flush output to the file, so that anything written * by the child appears after stuff we've already written. */ Tcl_Flush(chan); } } else { const char *name; Tcl_DString nameString; if (*spec == '\0') { spec = nextArg; if (spec == NULL) { goto badLastArg; } *skipPtr = 2; } name = Tcl_TranslateFileName(interp, spec, &nameString); if (name == NULL) { return NULL; } file = TclpOpenFile(name, flags); Tcl_DStringFree(&nameString); if (file == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't %s file \"%s\": %s", (writing ? "write" : "read"), spec, Tcl_PosixError(interp))); return NULL; } *closePtr = 1; } return file; badLastArg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't specify \"%s\" as last word in command", arg)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL); return NULL; } /* *---------------------------------------------------------------------- * * Tcl_DetachPids -- * * This function is called to indicate that one or more child processes * have been placed in background and will never be waited for; they * should eventually be reaped by Tcl_ReapDetachedProcs. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_DetachPids( int numPids, /* Number of pids to detach: gives size of * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { Detached *detPtr; int i; Tcl_MutexLock(&pipeMutex); for (i = 0; i < numPids; i++) { detPtr = ckalloc(sizeof(Detached)); detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; detList = detPtr; } Tcl_MutexUnlock(&pipeMutex); } /* *---------------------------------------------------------------------- * * Tcl_ReapDetachedProcs -- * * This function checks to see if any detached processes have exited and, * if so, it "reaps" them by officially waiting on them. It should be * called "occasionally" to make sure that all detached processes are * eventually reaped. * * Results: * None. * * Side effects: * Processes are waited on, so that they can be reaped by the system. * *---------------------------------------------------------------------- */ void Tcl_ReapDetachedProcs(void) { Detached *detPtr; Detached *nextPtr, *prevPtr; int status; Tcl_Pid pid; Tcl_MutexLock(&pipeMutex); for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG); if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) { prevPtr = detPtr; detPtr = detPtr->nextPtr; continue; } nextPtr = detPtr->nextPtr; if (prevPtr == NULL) { detList = detPtr->nextPtr; } else { prevPtr->nextPtr = detPtr->nextPtr; } ckfree(detPtr); detPtr = nextPtr; } Tcl_MutexUnlock(&pipeMutex); } /* *---------------------------------------------------------------------- * * TclCleanupChildren -- * * This is a utility function used to wait for child processes to exit, * record information about abnormal exits, and then collect any stderr * output generated by them. * * Results: * The return value is a standard Tcl result. If anything at weird * happened with the child processes, TCL_ERROR is returned and a message * is left in the interp's result. * * Side effects: * If the last character of the interp's result is a newline, then it is * removed unless keepNewline is non-zero. File errorId gets closed, and * pidPtr is freed back to the storage allocator. * *---------------------------------------------------------------------- */ int TclCleanupChildren( Tcl_Interp *interp, /* Used for error messages. */ int numPids, /* Number of entries in pidPtr array. */ Tcl_Pid *pidPtr, /* Array of process ids of children. */ Tcl_Channel errorChan) /* Channel for file containing stderr output * from pipeline. NULL means there isn't any * stderr output. */ { int result = TCL_OK; int i, abnormalExit, anyErrorInfo; Tcl_Pid pid; int waitStatus; const char *msg; unsigned long resolvedPid; abnormalExit = 0; for (i = 0; i < numPids; i++) { /* * We need to get the resolved pid before we wait on it as the windows * implementation of Tcl_WaitPid deletes the information such that any * following calls to TclpGetPid fail. */ resolvedPid = TclpGetPid(pidPtr[i]); pid = Tcl_WaitPid(pidPtr[i], &waitStatus, 0); if (pid == (Tcl_Pid) -1) { result = TCL_ERROR; if (interp != NULL) { msg = Tcl_PosixError(interp); if (errno == ECHILD) { /* * This changeup in message suggested by Mark Diekhans to * remind people that ECHILD errors can occur on some * systems if SIGCHLD isn't in its default state. */ msg = "child process lost (is SIGCHLD ignored or trapped?)"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error waiting for process to exit: %s", msg)); } continue; } /* * Create error messages for unusual process exits. An extra newline * gets appended to each error message, but it gets removed below (in * the same fashion that an extra newline in the command's output is * removed). */ if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) { char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE]; result = TCL_ERROR; snprintf(msg1, sizeof(msg1), "%lu", resolvedPid); if (WIFEXITED(waitStatus)) { if (interp != NULL) { snprintf(msg2, sizeof(msg2), "%u", WEXITSTATUS(waitStatus)); Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL); } abnormalExit = 1; } else if (interp != NULL) { const char *p; if (WIFSIGNALED(waitStatus)) { p = Tcl_SignalMsg(WTERMSIG(waitStatus)); Tcl_SetErrorCode(interp, "CHILDKILLED", msg1, Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "child killed: %s\n", p)); } else if (WIFSTOPPED(waitStatus)) { p = Tcl_SignalMsg(WSTOPSIG(waitStatus)); Tcl_SetErrorCode(interp, "CHILDSUSP", msg1, Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "child suspended: %s\n", p)); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( "child wait status didn't make sense\n", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "ODDWAITRESULT", msg1, NULL); } } } } /* * Read the standard error file. If there's anything there, then return an * error and add the file's contents to the result string. */ anyErrorInfo = 0; if (errorChan != NULL) { /* * Make sure we start at the beginning of the file. */ if (interp != NULL) { int count; Tcl_Obj *objPtr; Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET); TclNewObj(objPtr); count = Tcl_ReadChars(errorChan, objPtr, -1, 0); if (count < 0) { result = TCL_ERROR; Tcl_DecrRefCount(objPtr); Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error reading stderr output file: %s", Tcl_PosixError(interp))); } else if (count > 0) { anyErrorInfo = 1; Tcl_SetObjResult(interp, objPtr); result = TCL_ERROR; } else { Tcl_DecrRefCount(objPtr); } } Tcl_Close(NULL, errorChan); } /* * If a child exited abnormally but didn't output any error information at * all, generate an error message here. */ if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "child process exited abnormally", -1)); } return result; } /* *---------------------------------------------------------------------- * * TclCreatePipeline -- * * Given an argc/argv array, instantiate a pipeline of processes as * described by the argv. * * This function is unofficially exported for use by BLT. * * Results: * The return value is a count of the number of new processes created, or * -1 if an error occurred while creating the pipeline. *pidArrayPtr is * filled in with the address of a dynamically allocated array giving the * ids of all of the processes. It is up to the caller to free this array * when it isn't needed anymore. If inPipePtr is non-NULL, *inPipePtr is * filled in with the file id for the input pipe for the pipeline (if * any): the caller must eventually close this file. If outPipePtr isn't * NULL, then *outPipePtr is filled in with the file id for the output * pipe from the pipeline: the caller must close this file. If errFilePtr * isn't NULL, then *errFilePtr is filled with a file id that may be used * to read error output after the pipeline completes. * * Side effects: * Processes and pipes are created. * *---------------------------------------------------------------------- */ int TclCreatePipeline( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ int argc, /* Number of entries in argv. */ const char **argv, /* Array of strings describing commands in * pipeline plus I/O redirection with <, <<, * >, etc. Argv[argc] must be NULL. */ Tcl_Pid **pidArrayPtr, /* Word at *pidArrayPtr gets filled in with * address of array of pids for processes in * pipeline (first pid is first process in * pipeline). */ TclFile *inPipePtr, /* If non-NULL, input to the pipeline comes * from a pipe (unless overridden by * redirection in the command). The file id * with which to write to this pipe is stored * at *inPipePtr. NULL means command specified * its own input source. */ TclFile *outPipePtr, /* If non-NULL, output to the pipeline goes to * a pipe, unless overridden by redirection in * the command. The file id with which to read * from this pipe is stored at *outPipePtr. * NULL means command specified its own output * sink. */ TclFile *errFilePtr) /* If non-NULL, all stderr output from the * pipeline will go to a temporary file * created here, and a descriptor to read the * file will be left at *errFilePtr. The file * will be removed already, so closing this * descriptor will be the end of the file. If * this is NULL, then all stderr output goes * to our stderr. If the pipeline specifies * redirection then the file will still be * created but it will never get any data. */ { Tcl_Pid *pidPtr = NULL; /* Points to malloc-ed array holding all the * pids of child processes. */ int numPids; /* Actual number of processes that exist at * *pidPtr right now. */ int cmdCount; /* Count of number of distinct commands found * in argc/argv. */ const char *inputLiteral = NULL; /* If non-null, then this points to a string * containing input data (specified via <<) to * be piped to the first process in the * pipeline. */ TclFile inputFile = NULL; /* If != NULL, gives file to use as input for * first process in pipeline (specified via < * or <@). */ int inputClose = 0; /* If non-zero, then inputFile should be * closed when cleaning up. */ int inputRelease = 0; TclFile outputFile = NULL; /* Writable file for output from last command * in pipeline (could be file or pipe). NULL * means use stdout. */ int outputClose = 0; /* If non-zero, then outputFile should be * closed when cleaning up. */ int outputRelease = 0; TclFile errorFile = NULL; /* Writable file for error output from all * commands in pipeline. NULL means use * stderr. */ int errorClose = 0; /* If non-zero, then errorFile should be * closed when cleaning up. */ int errorRelease = 0; const char *p; const char *nextArg; int skip, lastBar, lastArg, i, j, atOK, flags, needCmd, errorToOutput = 0; Tcl_DString execBuffer; TclFile pipeIn; TclFile curInFile, curOutFile, curErrFile; Tcl_Channel channel; if (inPipePtr != NULL) { *inPipePtr = NULL; } if (outPipePtr != NULL) { *outPipePtr = NULL; } if (errFilePtr != NULL) { *errFilePtr = NULL; } Tcl_DStringInit(&execBuffer); pipeIn = NULL; curInFile = NULL; curOutFile = NULL; numPids = 0; /* * First, scan through all the arguments to figure out the structure of * the pipeline. Process all of the input and output redirection arguments * and remove them from the argument list in the pipeline. Count the * number of distinct processes (it's the number of "|" arguments plus * one) but don't remove the "|" arguments because they'll be used in the * second pass to separate the individual child processes. Cannot start * the child processes in this pass because the redirection symbols may * appear anywhere in the command line - e.g., the '<' that specifies the * input to the entire pipe may appear at the very end of the argument * list. */ lastBar = -1; cmdCount = 1; needCmd = 1; for (i = 0; i < argc; i++) { errorToOutput = 0; skip = 0; p = argv[i]; switch (*p++) { case '|': if (*p == '&') { p++; } if (*p == '\0') { if ((i == (lastBar + 1)) || (i == (argc - 1))) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal use of | or |& in command", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", NULL); goto error; } } lastBar = i; cmdCount++; needCmd = 1; break; case '<': if (inputClose != 0) { inputClose = 0; TclpCloseFile(inputFile); } if (inputRelease != 0) { inputRelease = 0; TclpReleaseFile(inputFile); } if (*p == '<') { inputFile = NULL; inputLiteral = p + 1; skip = 1; if (*inputLiteral == '\0') { inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1]; if (inputLiteral == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't specify \"%s\" as last word in command", argv[i])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", NULL); goto error; } skip = 2; } } else { nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; inputLiteral = NULL; inputFile = FileForRedirect(interp, p, 1, argv[i], nextArg, O_RDONLY, &skip, &inputClose, &inputRelease); if (inputFile == NULL) { goto error; } } break; case '>': atOK = 1; flags = O_WRONLY | O_CREAT | O_TRUNC; if (*p == '>') { p++; atOK = 0; /* * Note that the O_APPEND flag only has an effect on POSIX * platforms. On Windows, we just have to carry on regardless. */ flags = O_WRONLY | O_CREAT | O_APPEND; } if (*p == '&') { if (errorClose != 0) { errorClose = 0; TclpCloseFile(errorFile); } errorToOutput = 1; p++; } /* * Close the old output file, but only if the error file is not * also using it. */ if (outputClose != 0) { outputClose = 0; if (errorFile == outputFile) { errorClose = 1; } else { TclpCloseFile(outputFile); } } if (outputRelease != 0) { outputRelease = 0; if (errorFile == outputFile) { errorRelease = 1; } else { TclpReleaseFile(outputFile); } } nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; outputFile = FileForRedirect(interp, p, atOK, argv[i], nextArg, flags, &skip, &outputClose, &outputRelease); if (outputFile == NULL) { goto error; } if (errorToOutput) { if (errorClose != 0) { errorClose = 0; TclpCloseFile(errorFile); } if (errorRelease != 0) { errorRelease = 0; TclpReleaseFile(errorFile); } errorFile = outputFile; } break; case '2': if (*p != '>') { break; } p++; atOK = 1; flags = O_WRONLY | O_CREAT | O_TRUNC; if (*p == '>') { p++; atOK = 0; /* * Note that the O_APPEND flag only has an effect on POSIX * platforms. On Windows, we just have to carry on regardless. */ flags = O_WRONLY | O_CREAT | O_APPEND; } if (errorClose != 0) { errorClose = 0; TclpCloseFile(errorFile); } if (errorRelease != 0) { errorRelease = 0; TclpReleaseFile(errorFile); } if (atOK && p[0] == '@' && p[1] == '1' && p[2] == '\0') { /* * Special case handling of 2>@1 to redirect stderr to the * exec/open output pipe as well. This is meant for the end of * the command string, otherwise use |& between commands. */ if (i != argc-1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "must specify \"%s\" as last word in command", argv[i])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", NULL); goto error; } errorFile = outputFile; errorToOutput = 2; skip = 1; } else { nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; errorFile = FileForRedirect(interp, p, atOK, argv[i], nextArg, flags, &skip, &errorClose, &errorRelease); if (errorFile == NULL) { goto error; } } break; default: /* * Got a command word, not a redirection. */ needCmd = 0; break; } if (skip != 0) { for (j = i + skip; j < argc; j++) { argv[j - skip] = argv[j]; } argc -= skip; i -= 1; } } if (needCmd) { /* * We had a bar followed only by redirections. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal use of | or |& in command", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", NULL); goto error; } if (inputFile == NULL) { if (inputLiteral != NULL) { /* * The input for the first process is immediate data coming from * Tcl. Create a temporary file for it and put the data into the * file. */ inputFile = TclpCreateTempFile(inputLiteral); if (inputFile == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create input file for command: %s", Tcl_PosixError(interp))); goto error; } inputClose = 1; } else if (inPipePtr != NULL) { /* * The input for the first process in the pipeline is to come from * a pipe that can be written from by the caller. */ if (TclpCreatePipe(&inputFile, inPipePtr) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create input pipe for command: %s", Tcl_PosixError(interp))); goto error; } inputClose = 1; } else { /* * The input for the first process comes from stdin. */ channel = Tcl_GetStdChannel(TCL_STDIN); if (channel != NULL) { inputFile = TclpMakeFile(channel, TCL_READABLE); if (inputFile != NULL) { inputRelease = 1; } } } } if (outputFile == NULL) { if (outPipePtr != NULL) { /* * Output from the last process in the pipeline is to go to a pipe * that can be read by the caller. */ if (TclpCreatePipe(outPipePtr, &outputFile) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create output pipe for command: %s", Tcl_PosixError(interp))); goto error; } outputClose = 1; } else { /* * The output for the last process goes to stdout. */ channel = Tcl_GetStdChannel(TCL_STDOUT); if (channel) { outputFile = TclpMakeFile(channel, TCL_WRITABLE); if (outputFile != NULL) { outputRelease = 1; } } } } if (errorFile == NULL) { if (errorToOutput == 2) { /* * Handle 2>@1 special case at end of cmd line. */ errorFile = outputFile; } else if (errFilePtr != NULL) { /* * Set up the standard error output sink for the pipeline, if * requested. Use a temporary file which is opened, then deleted. * Could potentially just use pipe, but if it filled up it could * cause the pipeline to deadlock: we'd be waiting for processes * to complete before reading stderr, and processes couldn't * complete because stderr was backed up. */ errorFile = TclpCreateTempFile(NULL); if (errorFile == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create error file for command: %s", Tcl_PosixError(interp))); goto error; } *errFilePtr = errorFile; } else { /* * Errors from the pipeline go to stderr. */ channel = Tcl_GetStdChannel(TCL_STDERR); if (channel) { errorFile = TclpMakeFile(channel, TCL_WRITABLE); if (errorFile != NULL) { errorRelease = 1; } } } } /* * Scan through the argc array, creating a process for each group of * arguments between the "|" characters. */ Tcl_ReapDetachedProcs(); pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid)); curInFile = inputFile; for (i = 0; i < argc; i = lastArg + 1) { int result, joinThisError; Tcl_Pid pid; const char *oldName; /* * Convert the program name into native form. */ if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) { goto error; } /* * Find the end of the current segment of the pipeline. */ joinThisError = 0; for (lastArg = i; lastArg < argc; lastArg++) { if (argv[lastArg][0] != '|') { continue; } if (argv[lastArg][1] == '\0') { break; } if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) { joinThisError = 1; break; } } /* * If this is the last segment, use the specified outputFile. * Otherwise create an intermediate pipe. pipeIn will become the * curInFile for the next segment of the pipe. */ if (lastArg == argc) { curOutFile = outputFile; } else { argv[lastArg] = NULL; if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create pipe: %s", Tcl_PosixError(interp))); goto error; } } if (joinThisError != 0) { curErrFile = curOutFile; } else { curErrFile = errorFile; } /* * Restore argv[i], since a caller wouldn't expect the contents of * argv to be modified. */ oldName = argv[i]; argv[i] = Tcl_DStringValue(&execBuffer); result = TclpCreateProcess(interp, lastArg - i, argv + i, curInFile, curOutFile, curErrFile, &pid); argv[i] = oldName; if (result != TCL_OK) { goto error; } Tcl_DStringFree(&execBuffer); pidPtr[numPids] = pid; numPids++; /* * Close off our copies of file descriptors that were set up for this * child, then set up the input for the next child. */ if ((curInFile != NULL) && (curInFile != inputFile)) { TclpCloseFile(curInFile); } curInFile = pipeIn; pipeIn = NULL; if ((curOutFile != NULL) && (curOutFile != outputFile)) { TclpCloseFile(curOutFile); } curOutFile = NULL; } *pidArrayPtr = pidPtr; /* * All done. Cleanup open files lying around and then return. */ cleanup: Tcl_DStringFree(&execBuffer); if (inputClose) { TclpCloseFile(inputFile); } else if (inputRelease) { TclpReleaseFile(inputFile); } if (outputClose) { TclpCloseFile(outputFile); } else if (outputRelease) { TclpReleaseFile(outputFile); } if (errorClose) { TclpCloseFile(errorFile); } else if (errorRelease) { TclpReleaseFile(errorFile); } return numPids; /* * An error occurred. There could have been extra files open, such as * pipes between children. Clean them all up. Detach any child processes * that have been created. */ error: if (pipeIn != NULL) { TclpCloseFile(pipeIn); } if ((curOutFile != NULL) && (curOutFile != outputFile)) { TclpCloseFile(curOutFile); } if ((curInFile != NULL) && (curInFile != inputFile)) { TclpCloseFile(curInFile); } if ((inPipePtr != NULL) && (*inPipePtr != NULL)) { TclpCloseFile(*inPipePtr); *inPipePtr = NULL; } if ((outPipePtr != NULL) && (*outPipePtr != NULL)) { TclpCloseFile(*outPipePtr); *outPipePtr = NULL; } if ((errFilePtr != NULL) && (*errFilePtr != NULL)) { TclpCloseFile(*errFilePtr); *errFilePtr = NULL; } if (pidPtr != NULL) { for (i = 0; i < numPids; i++) { if (pidPtr[i] != (Tcl_Pid) -1) { Tcl_DetachPids(1, &pidPtr[i]); } } ckfree(pidPtr); } numPids = -1; goto cleanup; } /* *---------------------------------------------------------------------- * * Tcl_OpenCommandChannel -- * * Opens an I/O channel to one or more subprocesses specified by argc and * argv. The flags argument determines the disposition of the stdio * handles. If the TCL_STDIN flag is set then the standard input for the * first subprocess will be tied to the channel: writing to the channel * will provide input to the subprocess. If TCL_STDIN is not set, then * standard input for the first subprocess will be the same as this * application's standard input. If TCL_STDOUT is set then standard * output from the last subprocess can be read from the channel; * otherwise it goes to this application's standard output. If TCL_STDERR * is set, standard error output for all subprocesses is returned to the * channel and results in an error when the channel is closed; otherwise * it goes to this application's standard error. If TCL_ENFORCE_MODE is * not set, then argc and argv can redirect the stdio handles to override * TCL_STDIN, TCL_STDOUT, and TCL_STDERR; if it is set, then it is an * error for argc and argv to override stdio channels for which * TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set. * * Results: * A new command channel, or NULL on failure with an error message left * in interp. * * Side effects: * Creates processes, opens pipes. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_OpenCommandChannel( Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be * NULL. */ int argc, /* How many arguments. */ const char **argv, /* Array of arguments for command pipe. */ int flags) /* Or'ed combination of TCL_STDIN, TCL_STDOUT, * TCL_STDERR, and TCL_ENFORCE_MODE. */ { TclFile *inPipePtr, *outPipePtr, *errFilePtr; TclFile inPipe, outPipe, errFile; int numPids; Tcl_Pid *pidPtr; Tcl_Channel channel; inPipe = outPipe = errFile = NULL; inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL; outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL; errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL; numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr, outPipePtr, errFilePtr); if (numPids < 0) { goto error; } /* * Verify that the pipes that were created satisfy the readable/writable * constraints. */ if (flags & TCL_ENFORCE_MODE) { if ((flags & TCL_STDOUT) && (outPipe == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't read output from command:" " standard output was redirected", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "BADREDIRECT", NULL); goto error; } if ((flags & TCL_STDIN) && (inPipe == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't write input to command:" " standard input was redirected", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "BADREDIRECT", NULL); goto error; } } channel = TclpCreateCommandChannel(outPipe, inPipe, errFile, numPids, pidPtr); if (channel == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "pipe for command could not be created", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL); goto error; } return channel; error: if (numPids > 0) { Tcl_DetachPids(numPids, pidPtr); ckfree(pidPtr); } if (inPipe != NULL) { TclpCloseFile(inPipe); } if (outPipe != NULL) { TclpCloseFile(outPipe); } if (errFile != NULL) { TclpCloseFile(errFile); } return NULL; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclPkg.c0000644000175000017500000016375314565156356014700 0ustar sergeisergei/* * tclPkg.c -- * * This file implements package and version control for Tcl via the * "package" command and a few C APIs. * * Copyright (c) 1996 Sun Microsystems, Inc. * Copyright (c) 2006 Andreas Kupries * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * TIP #268. * Heavily rewritten to handle the extend version numbers, and extended * package requirements. */ #include "tclInt.h" /* * Each invocation of the "package ifneeded" command creates a structure of * the following type, which is used to load the package into the interpreter * if it is requested with a "package require" command. */ typedef struct PkgAvail { char *version; /* Version string; malloc'ed. */ char *script; /* Script to invoke to provide this version of * the package. Malloc'ed and protected by * Tcl_Preserve and Tcl_Release. */ struct PkgAvail *nextPtr; /* Next in list of available versions of the * same package. */ } PkgAvail; /* * For each package that is known in any way to an interpreter, there is one * record of the following type. These records are stored in the * "packageTable" hash table in the interpreter, keyed by package name such as * "Tk" (no version number). */ typedef struct Package { Tcl_Obj *version; PkgAvail *availPtr; /* First in list of all available versions of * this package. */ const void *clientData; /* Client data. */ } Package; typedef struct Require { void * clientDataPtr; const char *name; Package *pkgPtr; char *versionToProvide; } Require; typedef struct RequireProcArgs { const char *name; void *clientDataPtr; } RequireProcArgs; /* * Prototypes for functions defined in this file: */ static int CheckVersionAndConvert(Tcl_Interp *interp, const char *string, char **internal, int *stable); static int CompareVersions(char *v1i, char *v2i, int *isMajorPtr); static int CheckRequirement(Tcl_Interp *interp, const char *string); static int CheckAllRequirements(Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]); static int RequirementSatisfied(char *havei, const char *req); static int SomeRequirementSatisfied(char *havei, int reqc, Tcl_Obj *const reqv[]); static void AddRequirementsToResult(Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]); static void AddRequirementsToDString(Tcl_DString *dstring, int reqc, Tcl_Obj *const reqv[]); static Package * FindPackage(Tcl_Interp *interp, const char *name); static int PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result); static int PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result); static int PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result); static int PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result); static int PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result); static int TclNRPkgRequireProc(ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]); static int SelectPackage(ClientData data[], Tcl_Interp *interp, int result); static int SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result); static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result); /* * Helper macros. */ #define DupBlock(v,s,len) \ ((v) = ckalloc(len), memcpy((v),(s),(len))) #define DupString(v,s) \ do { \ unsigned local__len = (unsigned) (strlen(s) + 1); \ DupBlock((v),(s),local__len); \ } while (0) /* *---------------------------------------------------------------------- * * Tcl_PkgProvide / Tcl_PkgProvideEx -- * * This function is invoked to declare that a particular version of a * particular package is now present in an interpreter. There must not be * any other version of this package already provided in the interpreter. * * Results: * Normally returns TCL_OK; if there is already another version of the * package loaded then TCL_ERROR is returned and an error message is left * in the interp's result. * * Side effects: * The interpreter remembers that this package is available, so that no * other version of the package may be provided for the interpreter. * *---------------------------------------------------------------------- */ #undef Tcl_PkgProvide int Tcl_PkgProvide( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of package. */ const char *version) /* Version string for package. */ { return Tcl_PkgProvideEx(interp, name, version, NULL); } int Tcl_PkgProvideEx( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of package. */ const char *version, /* Version string for package. */ const void *clientData) /* clientdata for this package (normally used * for C callback function table) */ { Package *pkgPtr; char *pvi, *vi; int res; pkgPtr = FindPackage(interp, name); if (pkgPtr->version == NULL) { pkgPtr->version = Tcl_NewStringObj(version, -1); Tcl_IncrRefCount(pkgPtr->version); pkgPtr->clientData = clientData; return TCL_OK; } if (CheckVersionAndConvert(interp, Tcl_GetString(pkgPtr->version), &pvi, NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) { ckfree(pvi); return TCL_ERROR; } res = CompareVersions(pvi, vi, NULL); ckfree(pvi); ckfree(vi); if (res == 0) { if (clientData != NULL) { pkgPtr->clientData = clientData; } return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "conflicting versions provided for package \"%s\": %s, then %s", name, Tcl_GetString(pkgPtr->version), version)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc -- * * This function is called by code that depends on a particular version * of a particular package. If the package is not already provided in the * interpreter, this function invokes a Tcl script to provide it. If the * package is already provided, this function makes sure that the * caller's needs don't conflict with the version that is present. * * Results: * If successful, returns the version string for the currently provided * version of the package, which may be different from the "version" * argument. If the caller's requirements cannot be met (e.g. the version * requested conflicts with a currently provided version, or the required * version cannot be found, or the script to provide the required version * generates an error), NULL is returned and an error message is left in * the interp's result. * * Side effects: * The script from some previous "package ifneeded" command may be * invoked to provide the package. * *---------------------------------------------------------------------- */ #undef Tcl_PkgRequire const char * Tcl_PkgRequire( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of desired package. */ const char *version, /* Version string for desired version; NULL * means use the latest version available. */ int exact) /* Non-zero means that only the particular * version given is acceptable. Zero means use * the latest compatible version. */ { return Tcl_PkgRequireEx(interp, name, version, exact, NULL); } const char * Tcl_PkgRequireEx( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of desired package. */ const char *version, /* Version string for desired version; NULL * means use the latest version available. */ int exact, /* Non-zero means that only the particular * version given is acceptable. Zero means use * the latest compatible version. */ void *clientDataPtr) /* Used to return the client data for this * package. If it is NULL then the client data * is not returned. This is unchanged if this * call fails for any reason. */ { Tcl_Obj *ov; const char *result = NULL; /* * If an attempt is being made to load this into a standalone executable * on a platform where backlinking is not supported then this must be a * shared version of Tcl (Otherwise the load would have failed). Detect * this situation by checking that this library has been correctly * initialised. If it has not been then return immediately as nothing will * work. */ if (tclEmptyStringRep == NULL) { /* * OK, so what's going on here? * * First, what are we doing? We are performing a check on behalf of * one particular caller, Tcl_InitStubs(). When a package is stub- * enabled, it is statically linked to libtclstub.a, which contains a * copy of Tcl_InitStubs(). When a stub-enabled package is loaded, its * *_Init() function is supposed to call Tcl_InitStubs() before * calling any other functions in the Tcl library. The first Tcl * function called by Tcl_InitStubs() through the stub table is * Tcl_PkgRequireEx(), so this code right here is the first code that * is part of the original Tcl library in the executable that gets * executed on behalf of a newly loaded stub-enabled package. * * One easy error for the developer/builder of a stub-enabled package * to make is to forget to define USE_TCL_STUBS when compiling the * package. When that happens, the package will contain symbols that * are references to the Tcl library, rather than function pointers * referencing the stub table. On platforms that lack backlinking, * those unresolved references may cause the loading of the package to * also load a second copy of the Tcl library, leading to all kinds of * trouble. We would like to catch that error and report a useful * message back to the user. That's what we're doing. * * Second, how does this work? If we reach this point, then the global * variable tclEmptyStringRep has the value NULL. Compare that with * the definition of tclEmptyStringRep near the top of the file * generic/tclObj.c. It clearly should not have the value NULL; it * should point to the char tclEmptyString. If we see it having the * value NULL, then somehow we are seeing a Tcl library that isn't * completely initialized, and that's an indicator for the error * condition described above. (Further explanation is welcome.) * * Third, so what do we do about it? This situation indicates the * package we just loaded wasn't properly compiled to be stub-enabled, * yet it thinks it is stub-enabled (it called Tcl_InitStubs()). We * want to report that the package just loaded is broken, so we want * to place an error message in the interpreter result and return NULL * to indicate failure to Tcl_InitStubs() so that it will also fail. * (Further explanation why we don't want to Tcl_Panic() is welcome. * After all, two Tcl libraries can't be a good thing!) * * Trouble is that's going to be tricky. We're now using a Tcl library * that's not fully initialized. In particular, it doesn't have a * proper value for tclEmptyStringRep. The Tcl_Obj system heavily * depends on the value of tclEmptyStringRep and all of Tcl depends * (increasingly) on the Tcl_Obj system, we need to correct that flaw * before making the calls to set the interpreter result to the error * message. That's the only flaw corrected; other problems with * initialization of the Tcl library are not remedied, so be very * careful about adding any other calls here without checking how they * behave when initialization is incomplete. */ tclEmptyStringRep = &tclEmptyString; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Cannot load package \"%s\" in standalone executable:" " This package is not compiled with stub support", name)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL); return NULL; } /* * Translate between old and new API, and defer to the new function. */ if (version == NULL) { if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) { result = Tcl_GetString(Tcl_GetObjResult(interp)); Tcl_ResetResult(interp); } } else { if (exact && TCL_OK != CheckVersionAndConvert(interp, version, NULL, NULL)) { return NULL; } ov = Tcl_NewStringObj(version, -1); if (exact) { Tcl_AppendStringsToObj(ov, "-", version, NULL); } Tcl_IncrRefCount(ov); if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) { result = Tcl_GetString(Tcl_GetObjResult(interp)); Tcl_ResetResult(interp); } TclDecrRefCount(ov); } return result; } int Tcl_PkgRequireProc( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of desired package. */ int reqc, /* Requirements constraining the desired * version. */ Tcl_Obj *const reqv[], /* 0 means to use the latest version * available. */ void *clientDataPtr) { RequireProcArgs args; args.name = name; args.clientDataPtr = clientDataPtr; return Tcl_NRCallObjProc(interp, TclNRPkgRequireProc, (void *)&args, reqc, reqv); } static int TclNRPkgRequireProc( ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]) { RequireProcArgs *args = clientData; Tcl_NRAddCallback(interp, PkgRequireCore, (void *)args->name, INT2PTR(reqc), (void *)reqv, args->clientDataPtr); return TCL_OK; } static int PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result) { const char *name = data[0]; int reqc = PTR2INT(data[1]); Tcl_Obj *const *reqv = data[2]; int code = CheckAllRequirements(interp, reqc, reqv); Require *reqPtr; if (code != TCL_OK) { return code; } reqPtr = ckalloc(sizeof(Require)); Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL); reqPtr->clientDataPtr = data[3]; reqPtr->name = name; reqPtr->pkgPtr = FindPackage(interp, name); if (reqPtr->pkgPtr->version == NULL) { Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreStep1); } else { Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); } return TCL_OK; } static int PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result) { Tcl_DString command; char *script; Require *reqPtr = data[0]; int reqc = PTR2INT(data[1]); Tcl_Obj **const reqv = data[2]; const char *name = reqPtr->name /* Name of desired package. */; if (reqPtr->pkgPtr->version == NULL) { /* * The package is not in the database. If there is a "package unknown" * command, invoke it. */ script = ((Interp *) interp)->packageUnknown; if (script == NULL) { Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); } else { Tcl_DStringInit(&command); Tcl_DStringAppend(&command, script, -1); Tcl_DStringAppendElement(&command, name); AddRequirementsToDString(&command, reqc, reqv); Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); Tcl_NREvalObj(interp, Tcl_NewStringObj(Tcl_DStringValue(&command), Tcl_DStringLength(&command)), TCL_EVAL_GLOBAL ); Tcl_DStringFree(&command); } return TCL_OK; } else { Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); } return TCL_OK; } static int PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result) { Require *reqPtr = data[0]; int reqc = PTR2INT(data[1]); Tcl_Obj **const reqv = data[2]; const char *name = reqPtr->name /* Name of desired package. */; if ((result != TCL_OK) && (result != TCL_ERROR)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad return code: %d", result)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); result = TCL_ERROR; } if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"package unknown\" script)"); return result; } Tcl_ResetResult(interp); /* pkgPtr may now be invalid, so refresh it. */ reqPtr->pkgPtr = FindPackage(interp, name); Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreFinal); return TCL_OK; } static int PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) { Require *reqPtr = data[0]; int reqc = PTR2INT(data[1]), satisfies; Tcl_Obj **const reqv = data[2]; char *pkgVersionI; void *clientDataPtr = reqPtr->clientDataPtr; const char *name = reqPtr->name /* Name of desired package. */; if (reqPtr->pkgPtr->version == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't find package %s", name)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL); AddRequirementsToResult(interp, reqc, reqv); return TCL_ERROR; } /* * Ensure that the provided version meets the current requirements. */ if (reqc != 0) { CheckVersionAndConvert(interp, Tcl_GetString(reqPtr->pkgPtr->version), &pkgVersionI, NULL); satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv); ckfree(pkgVersionI); if (!satisfies) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "version conflict for package \"%s\": have %s, need", name, Tcl_GetString(reqPtr->pkgPtr->version))); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL); AddRequirementsToResult(interp, reqc, reqv); return TCL_ERROR; } } if (clientDataPtr) { const void **ptr = (const void **) clientDataPtr; *ptr = reqPtr->pkgPtr->clientData; } Tcl_SetObjResult(interp, reqPtr->pkgPtr->version); return TCL_OK; } static int PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) { ckfree(data[0]); return result; } static int SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { PkgAvail *availPtr, *bestPtr, *bestStablePtr; char *availVersion, *bestVersion, *bestStableVersion; /* Internal rep. of versions */ int availStable, satisfies; Require *reqPtr = data[0]; int reqc = PTR2INT(data[1]); Tcl_Obj **const reqv = data[2]; const char *name = reqPtr->name; Package *pkgPtr = reqPtr->pkgPtr; Interp *iPtr = (Interp *) interp; /* * Check whether we're already attempting to load some version of this * package (circular dependency detection). */ if (pkgPtr->clientData != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "circular package dependency:" " attempt to provide %s %s requires %s", name, (char *) pkgPtr->clientData, name)); AddRequirementsToResult(interp, reqc, reqv); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL); return TCL_ERROR; } /* * The package isn't yet present. Search the list of available * versions and invoke the script for the best available version. We * are actually locating the best, and the best stable version. One of * them is then chosen based on the selection mode. */ bestPtr = NULL; bestStablePtr = NULL; bestVersion = NULL; bestStableVersion = NULL; for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { if (CheckVersionAndConvert(interp, availPtr->version, &availVersion, &availStable) != TCL_OK) { /* * The provided version number has invalid syntax. This * should not happen. This should have been caught by the * 'package ifneeded' registering the package. */ continue; } /* Check satisfaction of requirements before considering the current version further. */ if (reqc > 0) { satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv); if (!satisfies) { ckfree(availVersion); availVersion = NULL; continue; } } if (bestPtr != NULL) { int res = CompareVersions(availVersion, bestVersion, NULL); /* * Note: Used internal reps in the comparison! */ if (res > 0) { /* * The version of the package sought is better than the * currently selected version. */ ckfree(bestVersion); bestVersion = NULL; goto newbest; } } else { newbest: /* We have found a version which is better than our max. */ bestPtr = availPtr; CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL); } if (!availStable) { ckfree(availVersion); availVersion = NULL; continue; } if (bestStablePtr != NULL) { int res = CompareVersions(availVersion, bestStableVersion, NULL); /* * Note: Used internal reps in the comparison! */ if (res > 0) { /* * This stable version of the package sought is better * than the currently selected stable version. */ ckfree(bestStableVersion); bestStableVersion = NULL; goto newstable; } } else { newstable: /* We have found a stable version which is better than our max stable. */ bestStablePtr = availPtr; CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL); } ckfree(availVersion); availVersion = NULL; } /* end for */ /* * Clean up memorized internal reps, if any. */ if (bestVersion != NULL) { ckfree(bestVersion); bestVersion = NULL; } if (bestStableVersion != NULL) { ckfree(bestStableVersion); bestStableVersion = NULL; } /* * Now choose a version among the two best. For 'latest' we simply * take (actually keep) the best. For 'stable' we take the best * stable, if there is any, or the best if there is nothing stable. */ if ((iPtr->packagePrefer == PKG_PREFER_STABLE) && (bestStablePtr != NULL)) { bestPtr = bestStablePtr; } if (bestPtr == NULL) { Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL); } else { /* * We found an ifneeded script for the package. Be careful while * executing it: this could cause reentrancy, so (a) protect the * script itself from deletion and (b) don't assume that bestPtr * will still exist when the script completes. */ char *versionToProvide = bestPtr->version; pkgPtr->clientData = versionToProvide; Tcl_Preserve(versionToProvide); reqPtr->versionToProvide = versionToProvide; Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]); Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL); } return TCL_OK; } static int SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) { Require *reqPtr = data[0]; int reqc = PTR2INT(data[1]); Tcl_Obj **const reqv = data[2]; const char *name = reqPtr->name; char *versionToProvide = reqPtr->versionToProvide; reqPtr->pkgPtr = FindPackage(interp, name); if (result == TCL_OK) { Tcl_ResetResult(interp); if (reqPtr->pkgPtr->version == NULL) { result = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" " no version of package %s provided", name, versionToProvide, name)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED", NULL); } else { char *pvi, *vi; if (TCL_OK != CheckVersionAndConvert(interp, Tcl_GetString(reqPtr->pkgPtr->version), &pvi, NULL)) { result = TCL_ERROR; } else if (CheckVersionAndConvert(interp, versionToProvide, &vi, NULL) != TCL_OK) { ckfree(pvi); result = TCL_ERROR; } else { int res = CompareVersions(pvi, vi, NULL); ckfree(pvi); ckfree(vi); if (res != 0) { result = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" " package %s %s provided instead", name, versionToProvide, name, Tcl_GetString(reqPtr->pkgPtr->version))); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "WRONGPROVIDE", NULL); } } } } else if (result != TCL_ERROR) { Tcl_Obj *codePtr; TclNewIntObj(codePtr, result); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" " bad return code: %s", name, versionToProvide, TclGetString(codePtr))); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); TclDecrRefCount(codePtr); result = TCL_ERROR; } if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"package ifneeded %s %s\" script)", name, versionToProvide)); } Tcl_Release(versionToProvide); if (result != TCL_OK) { /* * Take a non-TCL_OK code from the script as an indication the * package wasn't loaded properly, so the package system * should not remember an improper load. * * This is consistent with our returning NULL. If we're not * willing to tell our caller we got a particular version, we * shouldn't store that version for telling future callers * either. */ if (reqPtr->pkgPtr->version != NULL) { Tcl_DecrRefCount(reqPtr->pkgPtr->version); reqPtr->pkgPtr->version = NULL; } reqPtr->pkgPtr->clientData = NULL; return result; } Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_PkgPresent / Tcl_PkgPresentEx -- * * Checks to see whether the specified package is present. If it is not * then no additional action is taken. * * Results: * If successful, returns the version string for the currently provided * version of the package, which may be different from the "version" * argument. If the caller's requirements cannot be met (e.g. the version * requested conflicts with a currently provided version), NULL is * returned and an error message is left in interp->result. * * Side effects: * None. * *---------------------------------------------------------------------- */ #undef Tcl_PkgPresent const char * Tcl_PkgPresent( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of desired package. */ const char *version, /* Version string for desired version; NULL * means use the latest version available. */ int exact) /* Non-zero means that only the particular * version given is acceptable. Zero means use * the latest compatible version. */ { return Tcl_PkgPresentEx(interp, name, version, exact, NULL); } const char * Tcl_PkgPresentEx( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of desired package. */ const char *version, /* Version string for desired version; NULL * means use the latest version available. */ int exact, /* Non-zero means that only the particular * version given is acceptable. Zero means use * the latest compatible version. */ void *clientDataPtr) /* Used to return the client data for this * package. If it is NULL then the client data * is not returned. This is unchanged if this * call fails for any reason. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; Package *pkgPtr; hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name); if (hPtr) { pkgPtr = Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { /* * At this point we know that the package is present. Make sure * that the provided version meets the current requirement by * calling Tcl_PkgRequireEx() to check for us. */ const char *foundVersion = Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr); if (foundVersion == NULL) { Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL); } return foundVersion; } } if (version != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "package %s %s is not present", name, version)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "package %s is not present", name)); } Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL); return NULL; } /* *---------------------------------------------------------------------- * * Tcl_PackageObjCmd -- * * This function is invoked to process the "package" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_PackageObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, NULL, objc, objv); } /* ARGSUSED */ int TclNRPackageObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const pkgOptions[] = { "forget", "ifneeded", "names", "prefer", "present", "provide", "require", "unknown", "vcompare", "versions", "vsatisfies", NULL }; enum pkgOptions { PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER, PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS, PKG_VSATISFIES }; Interp *iPtr = (Interp *) interp; int optionIndex, exact, i, newobjc, satisfies; PkgAvail *availPtr, *prevPtr; Package *pkgPtr; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable *tablePtr; const char *version; const char *argv2, *argv3, *argv4; char *iva = NULL, *ivb = NULL; Tcl_Obj *objvListPtr, **newObjvPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum pkgOptions) optionIndex) { case PKG_FORGET: { const char *keyString; for (i = 2; i < objc; i++) { keyString = TclGetString(objv[i]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString); if (hPtr == NULL) { continue; } pkgPtr = Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (pkgPtr->version != NULL) { Tcl_DecrRefCount(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); ckfree(availPtr); } ckfree(pkgPtr); } break; } case PKG_IFNEEDED: { int length, res; char *argv3i, *avi; if ((objc != 4) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?"); return TCL_ERROR; } argv3 = TclGetString(objv[3]); if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) { return TCL_ERROR; } argv2 = TclGetString(objv[2]); if (objc == 4) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr == NULL) { ckfree(argv3i); return TCL_OK; } pkgPtr = Tcl_GetHashValue(hPtr); } else { pkgPtr = FindPackage(interp, argv2); } argv3 = Tcl_GetStringFromObj(objv[3], &length); for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { if (CheckVersionAndConvert(interp, availPtr->version, &avi, NULL) != TCL_OK) { ckfree(argv3i); return TCL_ERROR; } res = CompareVersions(avi, argv3i, NULL); ckfree(avi); if (res == 0){ if (objc == 4) { ckfree(argv3i); Tcl_SetObjResult(interp, Tcl_NewStringObj(availPtr->script, -1)); return TCL_OK; } Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); break; } } ckfree(argv3i); if (objc == 4) { return TCL_OK; } if (availPtr == NULL) { availPtr = ckalloc(sizeof(PkgAvail)); DupBlock(availPtr->version, argv3, (unsigned) length + 1); if (prevPtr == NULL) { availPtr->nextPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr; } else { availPtr->nextPtr = prevPtr->nextPtr; prevPtr->nextPtr = availPtr; } } argv4 = Tcl_GetStringFromObj(objv[4], &length); DupBlock(availPtr->script, argv4, (unsigned) length + 1); break; } case PKG_NAMES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } else { Tcl_Obj *resultObj; TclNewObj(resultObj); tablePtr = &iPtr->packageTable; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { pkgPtr = Tcl_GetHashValue(hPtr); if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj( Tcl_GetHashKey(tablePtr, hPtr), -1)); } } Tcl_SetObjResult(interp, resultObj); } break; case PKG_PRESENT: { const char *name; if (objc < 3) { goto require; } argv2 = TclGetString(objv[2]); if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { if (objc != 5) { goto requireSyntax; } exact = 1; name = TclGetString(objv[3]); } else { exact = 0; name = argv2; } hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name); if (hPtr != NULL) { pkgPtr = Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { goto require; } } version = NULL; if (exact) { version = TclGetString(objv[4]); if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) { return TCL_ERROR; } } else { if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) { return TCL_ERROR; } if ((objc > 3) && (CheckVersionAndConvert(interp, TclGetString(objv[3]), NULL, NULL) == TCL_OK)) { version = TclGetString(objv[3]); } } Tcl_PkgPresentEx(interp, name, version, exact, NULL); return TCL_ERROR; break; } case PKG_PROVIDE: if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "package ?version?"); return TCL_ERROR; } argv2 = TclGetString(objv[2]); if (objc == 3) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { pkgPtr = Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { Tcl_SetObjResult(interp, pkgPtr->version); } } return TCL_OK; } argv3 = TclGetString(objv[3]); if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) { return TCL_ERROR; } return Tcl_PkgProvideEx(interp, argv2, argv3, NULL); case PKG_REQUIRE: require: if (objc < 3) { requireSyntax: Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?requirement ...?"); return TCL_ERROR; } version = NULL; argv2 = TclGetString(objv[2]); if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { Tcl_Obj *ov; if (objc != 5) { goto requireSyntax; } version = TclGetString(objv[4]); if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) { return TCL_ERROR; } /* * Create a new-style requirement for the exact version. */ ov = Tcl_NewStringObj(version, -1); Tcl_AppendStringsToObj(ov, "-", version, NULL); version = NULL; argv3 = TclGetString(objv[3]); Tcl_IncrRefCount(objv[3]); objvListPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(objvListPtr); Tcl_ListObjAppendElement(interp, objvListPtr, ov); TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv3, INT2PTR(newobjc), newObjvPtr, NULL); return TCL_OK; } else { Tcl_Obj *const *newobjv = objv + 3; newobjc = objc - 3; if (CheckAllRequirements(interp, objc - 3, objv + 3) != TCL_OK) { return TCL_ERROR; } objvListPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(objvListPtr); Tcl_IncrRefCount(objv[2]); for (i = 0; i < newobjc; i++) { /* * Tcl_Obj structures may have come from another interpreter, * so duplicate them. */ Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i])); } TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv2, INT2PTR(newobjc), newObjvPtr, NULL); return TCL_OK; } break; case PKG_UNKNOWN: { int length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(iPtr->packageUnknown, -1)); } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { ckfree(iPtr->packageUnknown); } argv2 = Tcl_GetStringFromObj(objv[2], &length); if (argv2[0] == 0) { iPtr->packageUnknown = NULL; } else { DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1); } } else { Tcl_WrongNumArgs(interp, 2, objv, "?command?"); return TCL_ERROR; } break; } case PKG_PREFER: { static const char *const pkgPreferOptions[] = { "latest", "stable", NULL }; /* * See tclInt.h for the enum, just before Interp. */ if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "?latest|stable?"); return TCL_ERROR; } else if (objc == 3) { /* * Seting the value. */ int newPref; if (Tcl_GetIndexFromObj(interp, objv[2], pkgPreferOptions, "preference", 0, &newPref) != TCL_OK) { return TCL_ERROR; } if (newPref < iPtr->packagePrefer) { iPtr->packagePrefer = newPref; } } /* * Always return current value. */ Tcl_SetObjResult(interp, Tcl_NewStringObj(pkgPreferOptions[iPtr->packagePrefer], -1)); break; } case PKG_VCOMPARE: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "version1 version2"); return TCL_ERROR; } argv3 = TclGetString(objv[3]); argv2 = TclGetString(objv[2]); if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK || CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) { if (iva != NULL) { ckfree(iva); } /* * ivb cannot be set in this branch. */ return TCL_ERROR; } /* * Comparison is done on the internal representation. */ Tcl_SetObjResult(interp, Tcl_NewIntObj(CompareVersions(iva, ivb, NULL))); ckfree(iva); ckfree(ivb); break; case PKG_VERSIONS: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "package"); return TCL_ERROR; } else { Tcl_Obj *resultObj; TclNewObj(resultObj); argv2 = TclGetString(objv[2]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { pkgPtr = Tcl_GetHashValue(hPtr); for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(availPtr->version, -1)); } } Tcl_SetObjResult(interp, resultObj); } break; case PKG_VSATISFIES: { char *argv2i = NULL; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "version ?requirement ...?"); return TCL_ERROR; } argv2 = TclGetString(objv[2]); if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) { ckfree(argv2i); return TCL_ERROR; } satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3); ckfree(argv2i); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies)); break; } default: Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions"); } return TCL_OK; } static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result) { TclDecrRefCount((Tcl_Obj *)data[0]); TclDecrRefCount((Tcl_Obj *)data[1]); return result; } /* *---------------------------------------------------------------------- * * FindPackage -- * * This function finds the Package record for a particular package in a * particular interpreter, creating a record if one doesn't already * exist. * * Results: * The return value is a pointer to the Package record for the package. * * Side effects: * A new Package record may be created. * *---------------------------------------------------------------------- */ static Package * FindPackage( Tcl_Interp *interp, /* Interpreter to use for package lookup. */ const char *name) /* Name of package to fine. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; int isNew; Package *pkgPtr; hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew); if (isNew) { pkgPtr = ckalloc(sizeof(Package)); pkgPtr->version = NULL; pkgPtr->availPtr = NULL; pkgPtr->clientData = NULL; Tcl_SetHashValue(hPtr, pkgPtr); } else { pkgPtr = Tcl_GetHashValue(hPtr); } return pkgPtr; } /* *---------------------------------------------------------------------- * * TclFreePackageInfo -- * * This function is called during interpreter deletion to free all of the * package-related information for the interpreter. * * Results: * None. * * Side effects: * Memory is freed. * *---------------------------------------------------------------------- */ void TclFreePackageInfo( Interp *iPtr) /* Interpereter that is being deleted. */ { Package *pkgPtr; Tcl_HashSearch search; Tcl_HashEntry *hPtr; PkgAvail *availPtr; for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { pkgPtr = Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { Tcl_DecrRefCount(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); ckfree(availPtr); } ckfree(pkgPtr); } Tcl_DeleteHashTable(&iPtr->packageTable); if (iPtr->packageUnknown != NULL) { ckfree(iPtr->packageUnknown); } } /* *---------------------------------------------------------------------- * * CheckVersionAndConvert -- * * This function checks to see whether a version number has valid syntax. * It also generates a semi-internal representation (string rep of a list * of numbers). * * Results: * If string is a properly formed version number the TCL_OK is returned. * Otherwise TCL_ERROR is returned and an error message is left in the * interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CheckVersionAndConvert( Tcl_Interp *interp, /* Used for error reporting. */ const char *string, /* Supposedly a version number, which is * groups of decimal digits separated by * dots. */ char **internal, /* Internal normalized representation */ int *stable) /* Flag: Version is (un)stable. */ { const char *p = string; char prevChar; int hasunstable = 0; /* * 4* assuming that each char is a separator (a,b become ' -x '). * 4+ to have space for an additional -2 at the end */ char *ibuf = ckalloc(4 + 4*strlen(string)); char *ip = ibuf; /* * Basic rules * (1) First character has to be a digit. * (2) All other characters have to be a digit or '.' * (3) Two '.'s may not follow each other. * * TIP 268, Modified rules * (1) s.a. * (2) All other characters have to be a digit, 'a', 'b', or '.' * (3) s.a. * (4) Only one of 'a' or 'b' may occur. * (5) Neither 'a', nor 'b' may occur before or after a '.' */ if (!isdigit(UCHAR(*p))) { /* INTL: digit */ goto error; } *ip++ = *p; for (prevChar = *p, p++; *p != 0; p++) { if (!isdigit(UCHAR(*p)) && /* INTL: digit */ ((*p!='.' && *p!='a' && *p!='b') || ((hasunstable && (*p=='a' || *p=='b')) || ((prevChar=='a' || prevChar=='b' || prevChar=='.') && (*p=='.')) || ((*p=='a' || *p=='b' || *p=='.') && prevChar=='.')))) { goto error; } if (*p == 'a' || *p == 'b') { hasunstable = 1; } /* * Translation to the internal rep. Regular version chars are copied * as is. The separators are translated to numerics. The new separator * for all parts is space. */ if (*p == '.') { *ip++ = ' '; *ip++ = '0'; *ip++ = ' '; } else if (*p == 'a') { *ip++ = ' '; *ip++ = '-'; *ip++ = '2'; *ip++ = ' '; } else if (*p == 'b') { *ip++ = ' '; *ip++ = '-'; *ip++ = '1'; *ip++ = ' '; } else { *ip++ = *p; } prevChar = *p; } if (prevChar!='.' && prevChar!='a' && prevChar!='b') { *ip = '\0'; if (internal != NULL) { *internal = ibuf; } else { ckfree(ibuf); } if (stable != NULL) { *stable = !hasunstable; } return TCL_OK; } error: ckfree(ibuf); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected version number but got \"%s\"", string)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * CompareVersions -- * * This function compares two version numbers (in internal rep). * * Results: * The return value is -1 if v1 is less than v2, 0 if the two version * numbers are the same, and 1 if v1 is greater than v2. If *satPtr is * non-NULL, the word it points to is filled in with 1 if v2 >= v1 and * both numbers have the same major number or 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CompareVersions( char *v1, char *v2, /* Versions strings, of form 2.1.3 (any number * of version numbers). */ int *isMajorPtr) /* If non-null, the word pointed to is filled * in with a 0/1 value. 1 means that the * difference occurred in the first element. */ { int thisIsMajor, res, flip; char *s1, *e1, *s2, *e2, o1, o2; /* * Each iteration of the following loop processes one number from each * string, terminated by a " " (space). If those numbers don't match then * the comparison is over; otherwise, we loop back for the next number. * * TIP 268. * This is identical the function 'ComparePkgVersion', but using the new * space separator as used by the internal rep of version numbers. The * special separators 'a' and 'b' have already been dealt with in * 'CheckVersionAndConvert', they were translated into numbers as well. * This keeps the comparison sane. Otherwise we would have to compare * numerics, the separators, and also deal with the special case of * end-of-string compared to separators. The semi-list rep we get here is * much easier to handle, as it is still regular. * * Rewritten to not compute a numeric value for the extracted version * number, but do string comparison. Skip any leading zeros for that to * work. This change breaks through the 32bit-limit on version numbers. */ thisIsMajor = 1; s1 = v1; s2 = v2; while (1) { /* * Parse one decimal number from the front of each string. Skip * leading zeros. Terminate found number for upcoming string-wise * comparison, if needed. */ while ((*s1 != 0) && (*s1 == '0')) { s1++; } while ((*s2 != 0) && (*s2 == '0')) { s2++; } /* * s1, s2 now point to the beginnings of the numbers to compare. Test * for their signs first, as shortcut to the result (different signs), * or determines if result has to be flipped (both negative). If there * is no shortcut we have to insert terminators later to limit the * strcmp. */ if ((*s1 == '-') && (*s2 != '-')) { /* s1 < 0, s2 >= 0 => s1 < s2 */ res = -1; break; } if ((*s1 != '-') && (*s2 == '-')) { /* s1 >= 0, s2 < 0 => s1 > s2 */ res = 1; break; } if ((*s1 == '-') && (*s2 == '-')) { /* a < b => -a > -b, etc. */ s1++; s2++; flip = 1; } else { flip = 0; } /* * The string comparison is needed, so now we determine where the * numbers end. */ e1 = s1; while ((*e1 != 0) && (*e1 != ' ')) { e1++; } e2 = s2; while ((*e2 != 0) && (*e2 != ' ')) { e2++; } /* * s1 .. e1 and s2 .. e2 now bracket the numbers to compare. Insert * terminators, compare, and restore actual contents. First however * another shortcut. Compare lengths. Shorter string is smaller * number! Thus we strcmp only strings of identical length. */ if ((e1-s1) < (e2-s2)) { res = -1; } else if ((e2-s2) < (e1-s1)) { res = 1; } else { o1 = *e1; *e1 = '\0'; o2 = *e2; *e2 = '\0'; res = strcmp(s1, s2); res = (res < 0) ? -1 : (res ? 1 : 0); *e1 = o1; *e2 = o2; } /* * Stop comparing segments when a difference has been found. Here we * may have to flip the result to account for signs. */ if (res != 0) { if (flip) { res = -res; } break; } /* * Go on to the next version number if the current numbers match. * However stop processing if the end of both numbers has been * reached. */ s1 = e1; s2 = e2; if (*s1 != 0) { s1++; } else if (*s2 == 0) { /* * s1, s2 both at the end => identical */ res = 0; break; } if (*s2 != 0) { s2++; } thisIsMajor = 0; } if (isMajorPtr != NULL) { *isMajorPtr = thisIsMajor; } return res; } /* *---------------------------------------------------------------------- * * CheckAllRequirements -- * * This function checks to see whether all requirements in a set have * valid syntax. * * Results: * TCL_OK is returned if all requirements are valid. Otherwise TCL_ERROR * is returned and an error message is left in the interp's result. * * Side effects: * May modify the interpreter result. * *---------------------------------------------------------------------- */ static int CheckAllRequirements( Tcl_Interp *interp, int reqc, /* Requirements to check. */ Tcl_Obj *const reqv[]) { int i; for (i = 0; i < reqc; i++) { if ((CheckRequirement(interp, TclGetString(reqv[i])) != TCL_OK)) { return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * CheckRequirement -- * * This function checks to see whether a requirement has valid syntax. * * Results: * If string is a properly formed requirement then TCL_OK is returned. * Otherwise TCL_ERROR is returned and an error message is left in the * interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CheckRequirement( Tcl_Interp *interp, /* Used for error reporting. */ const char *string) /* Supposedly a requirement. */ { /* * Syntax of requirement = version * = version-version * = version- */ char *dash = NULL, *buf; dash = strchr(string, '-'); if (dash == NULL) { /* * No dash found, has to be a simple version. */ return CheckVersionAndConvert(interp, string, NULL, NULL); } if (strchr(dash+1, '-') != NULL) { /* * More dashes found after the first. This is wrong. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected versionMin-versionMax but got \"%s\"", string)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL); return TCL_ERROR; } /* * Exactly one dash is present. Copy the string, split at the location of * dash and check that both parts are versions. Note that the max part can * be empty. Also note that the string allocated with strdup() must be * freed with free() and not ckfree(). */ DupString(buf, string); dash = buf + (dash - string); *dash = '\0'; /* buf now <=> min part */ dash++; /* dash now <=> max part */ if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) || ((*dash != '\0') && (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) { ckfree(buf); return TCL_ERROR; } ckfree(buf); return TCL_OK; } /* *---------------------------------------------------------------------- * * AddRequirementsToResult -- * * This function accumulates requirements in the interpreter result. * * Results: * None. * * Side effects: * The interpreter result is extended. * *---------------------------------------------------------------------- */ static void AddRequirementsToResult( Tcl_Interp *interp, int reqc, /* Requirements constraining the desired * version. */ Tcl_Obj *const reqv[]) /* 0 means to use the latest version * available. */ { Tcl_Obj *result = Tcl_GetObjResult(interp); int i, length; for (i = 0; i < reqc; i++) { const char *v = Tcl_GetStringFromObj(reqv[i], &length); if ((length & 0x1) && (v[length/2] == '-') && (strncmp(v, v+((length+1)/2), length/2) == 0)) { Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2)); } else { Tcl_AppendPrintfToObj(result, " %s", v); } } } /* *---------------------------------------------------------------------- * * AddRequirementsToDString -- * * This function accumulates requirements in a DString. * * Results: * None. * * Side effects: * The DString argument is extended. * *---------------------------------------------------------------------- */ static void AddRequirementsToDString( Tcl_DString *dsPtr, int reqc, /* Requirements constraining the desired * version. */ Tcl_Obj *const reqv[]) /* 0 means to use the latest version * available. */ { int i; if (reqc > 0) { for (i = 0; i < reqc; i++) { TclDStringAppendLiteral(dsPtr, " "); TclDStringAppendObj(dsPtr, reqv[i]); } } else { TclDStringAppendLiteral(dsPtr, " 0-"); } } /* *---------------------------------------------------------------------- * * SomeRequirementSatisfied -- * * This function checks to see whether a version satisfies at least one * of a set of requirements. * * Results: * If the requirements are satisfied 1 is returned. Otherwise 0 is * returned. The function assumes that all pieces have valid syntax. And * is allowed to make that assumption. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int SomeRequirementSatisfied( char *availVersionI, /* Candidate version to check against the * requirements. */ int reqc, /* Requirements constraining the desired * version. */ Tcl_Obj *const reqv[]) /* 0 means to use the latest version * available. */ { int i; for (i = 0; i < reqc; i++) { if (RequirementSatisfied(availVersionI, TclGetString(reqv[i]))) { return 1; } } return 0; } /* *---------------------------------------------------------------------- * * RequirementSatisfied -- * * This function checks to see whether a version satisfies a requirement. * * Results: * If the requirement is satisfied 1 is returned. Otherwise 0 is * returned. The function assumes that all pieces have valid syntax, and * is allowed to make that assumption. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int RequirementSatisfied( char *havei, /* Version string, of candidate package we * have. */ const char *req) /* Requirement string the candidate has to * satisfy. */ { /* * The have candidate is already in internal rep. */ int satisfied, res; char *dash = NULL, *buf, *min, *max; dash = strchr(req, '-'); if (dash == NULL) { /* * No dash found, is a simple version, fallback to regular check. The * 'CheckVersionAndConvert' cannot fail. We pad the requirement with * 'a0', i.e '-2' before doing the comparison to properly accept * unstables as well. */ char *reqi = NULL; int thisIsMajor; CheckVersionAndConvert(NULL, req, &reqi, NULL); strcat(reqi, " -2"); res = CompareVersions(havei, reqi, &thisIsMajor); satisfied = (res == 0) || ((res == 1) && !thisIsMajor); ckfree(reqi); return satisfied; } /* * Exactly one dash is present (Assumption of valid syntax). Copy the req, * split at the location of dash and check that both parts are versions. * Note that the max part can be empty. */ DupString(buf, req); dash = buf + (dash - req); *dash = '\0'; /* buf now <=> min part */ dash++; /* dash now <=> max part */ if (*dash == '\0') { /* * We have a min, but no max. For the comparison we generate the * internal rep, padded with 'a0' i.e. '-2'. */ CheckVersionAndConvert(NULL, buf, &min, NULL); strcat(min, " -2"); satisfied = (CompareVersions(havei, min, NULL) >= 0); ckfree(min); ckfree(buf); return satisfied; } /* * We have both min and max, and generate their internal reps. When * identical we compare as is, otherwise we pad with 'a0' to over the range * a bit. */ CheckVersionAndConvert(NULL, buf, &min, NULL); CheckVersionAndConvert(NULL, dash, &max, NULL); if (CompareVersions(min, max, NULL) == 0) { satisfied = (CompareVersions(min, havei, NULL) == 0); } else { strcat(min, " -2"); strcat(max, " -2"); satisfied = ((CompareVersions(min, havei, NULL) <= 0) && (CompareVersions(havei, max, NULL) < 0)); } ckfree(min); ckfree(max); ckfree(buf); return satisfied; } /* *---------------------------------------------------------------------- * * Tcl_PkgInitStubsCheck -- * * This is a replacement routine for Tcl_InitStubs() that is called * from code where -DUSE_TCL_STUBS has not been enabled. * * Results: * Returns the version of a conforming stubs table, or NULL, if * the table version doesn't satisfy the requested requirements, * according to historical practice. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_PkgInitStubsCheck( Tcl_Interp *interp, const char * version, int exact) { const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0); if (exact && actualVersion) { const char *p = version; int count = 0; while (*p) { count += !isdigit(UCHAR(*p++)); } if (count == 1) { if (0 != strncmp(version, actualVersion, strlen(version))) { /* Construct error message */ Tcl_PkgPresent(interp, "Tcl", version, 1); return NULL; } } else { return Tcl_PkgPresent(interp, "Tcl", version, 1); } } return actualVersion; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclPkgConfig.c0000644000175000017500000000673014554262142016002 0ustar sergeisergei/* * tclPkgConfig.c -- * * This file contains the configuration information to embed into the tcl * binary library. * * Copyright (c) 2002 Andreas Kupries * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* Note, the definitions in this module are influenced by the following C * preprocessor macros: * * OSCMa = shortcut for "old style configuration macro activates" * NSCMdt = shortcut for "new style configuration macro declares that" * * - TCL_THREADS OSCMa compilation as threaded core. * - TCL_MEM_DEBUG OSCMa memory debugging. * - TCL_COMPILE_DEBUG OSCMa debugging of bytecode compiler. * - TCL_COMPILE_STATS OSCMa bytecode compiler statistics. * * - TCL_CFG_DO64BIT NSCMdt tcl is compiled for a 64bit system. * - NDEBUG NSCMdt tcl is compiled with symbol info off. * - TCL_CFG_OPTIMIZED NSCMdt tcl is compiled with cc optimizations on * - TCL_CFG_PROFILED NSCMdt tcl is compiled with profiling info. * * - CFG_RUNTIME_* Paths to various stuff at runtime. * - CFG_INSTALL_* Paths to various stuff at installation time. * * - TCL_CFGVAL_ENCODING string containing the encoding used for the * configuration values. */ #include "tclInt.h" #ifndef TCL_CFGVAL_ENCODING # ifdef _WIN32 # define TCL_CFGVAL_ENCODING "cp1252" # else # define TCL_CFGVAL_ENCODING "iso8859-1" # endif #endif /* * Use C preprocessor statements to define the various values for the embedded * configuration information. */ #ifdef TCL_THREADS # define CFG_THREADED "1" #else # define CFG_THREADED "0" #endif #ifdef TCL_MEM_DEBUG # define CFG_MEMDEBUG "1" #else # define CFG_MEMDEBUG "0" #endif #ifdef TCL_COMPILE_DEBUG # define CFG_COMPILE_DEBUG "1" #else # define CFG_COMPILE_DEBUG "0" #endif #ifdef TCL_COMPILE_STATS # define CFG_COMPILE_STATS "1" #else # define CFG_COMPILE_STATS "0" #endif #ifdef TCL_CFG_DO64BIT # define CFG_64 "1" #else # define CFG_64 "0" #endif #ifndef NDEBUG # define CFG_DEBUG "1" #else # define CFG_DEBUG "0" #endif #ifdef TCL_CFG_OPTIMIZED # define CFG_OPTIMIZED "1" #else # define CFG_OPTIMIZED "0" #endif #ifdef TCL_CFG_PROFILED # define CFG_PROFILED "1" #else # define CFG_PROFILED "0" #endif static Tcl_Config const cfg[] = { {"debug", CFG_DEBUG}, {"threaded", CFG_THREADED}, {"profiled", CFG_PROFILED}, {"64bit", CFG_64}, {"optimized", CFG_OPTIMIZED}, {"mem_debug", CFG_MEMDEBUG}, {"compile_debug", CFG_COMPILE_DEBUG}, {"compile_stats", CFG_COMPILE_STATS}, /* Runtime paths to various stuff */ {"libdir,runtime", CFG_RUNTIME_LIBDIR}, {"bindir,runtime", CFG_RUNTIME_BINDIR}, {"scriptdir,runtime", CFG_RUNTIME_SCRDIR}, {"includedir,runtime", CFG_RUNTIME_INCDIR}, {"docdir,runtime", CFG_RUNTIME_DOCDIR}, /* Installation paths to various stuff */ {"libdir,install", CFG_INSTALL_LIBDIR}, {"bindir,install", CFG_INSTALL_BINDIR}, {"scriptdir,install", CFG_INSTALL_SCRDIR}, {"includedir,install", CFG_INSTALL_INCDIR}, {"docdir,install", CFG_INSTALL_DOCDIR}, /* Last entry, closes the array */ {NULL, NULL} }; void TclInitEmbeddedConfigurationInformation( Tcl_Interp *interp) /* Interpreter the configuration command is * registered in. */ { Tcl_RegisterConfig(interp, "tcl", cfg, TCL_CFGVAL_ENCODING); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclPlatDecls.h0000644000175000017500000001000314566153373016007 0ustar sergeisergei/* * tclPlatDecls.h -- * * Declarations of platform specific Tcl APIs. * * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. */ #ifndef _TCLPLATDECLS #define _TCLPLATDECLS #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tcl.decls script. */ /* * TCHAR is needed here for win32, so if it is not defined yet do it here. * This way, we don't need to include just for one define. */ #if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(_TCHAR_DEFINED) # if defined(_UNICODE) typedef wchar_t TCHAR; # else typedef char TCHAR; # endif # define _TCHAR_DEFINED #endif /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr); /* 1 */ EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); /* Slot 2 is reserved */ /* 3 */ EXTERN void TclWinConvertError_(unsigned errCode); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 2 */ EXTERN void TclMacOSXNotifierAddRunLoopMode_( const void *runLoopMode); #endif /* MACOSX */ typedef struct TclPlatStubs { int magic; void *hooks; #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */ char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */ void (*reserved2)(void); void (*tclWinConvertError_) (unsigned errCode); /* 3 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ void (*tclMacOSXNotifierAddRunLoopMode_) (const void *runLoopMode); /* 2 */ #endif /* MACOSX */ } TclPlatStubs; extern const TclPlatStubs *tclPlatStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) /* * Inline function declarations: */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ #define Tcl_WinTCharToUtf \ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ /* Slot 2 is reserved */ #define TclWinConvertError_ \ (tclPlatStubsPtr->tclWinConvertError_) /* 3 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ #define Tcl_MacOSXOpenBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #define TclMacOSXNotifierAddRunLoopMode_ \ (tclPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode_) /* 2 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry #undef TclMacOSXNotifierAddRunLoopMode_ #undef TclWinConvertError_ #ifdef MAC_OSX_TCL /* MACOSX */ #undef Tcl_MacOSXOpenBundleResources #define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e) #endif #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLPLATDECLS */ tcl8.6.14/generic/tclPort.h0000644000175000017500000000225614554262142015063 0ustar sergeisergei/* * tclPort.h -- * * This header file handles porting issues that occur because * of differences between systems. It reads in platform specific * portability files. * * Copyright (c) 1994-1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLPORT #define _TCLPORT #ifdef HAVE_TCL_CONFIG_H #include "tclConfig.h" #endif #if defined(_WIN32) # include "tclWinPort.h" #else # include "tclUnixPort.h" #endif #include "tcl.h" #if !defined(LLONG_MIN) # ifdef TCL_WIDE_INT_IS_LONG # define LLONG_MIN LONG_MIN # else # ifdef LLONG_BIT # define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1))) # else /* Assume we're on a system with a 64-bit 'long long' type */ # define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63)) # endif # endif /* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */ # define LLONG_MAX (~LLONG_MIN) #endif #define UWIDE_MAX ((Tcl_WideUInt)-1) #define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1)) #define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1)) #endif /* _TCLPORT */ tcl8.6.14/generic/tclPosixStr.c0000644000175000017500000007537214554262142015736 0ustar sergeisergei/* * tclPosixStr.c -- * * This file contains procedures that generate strings corresponding to * various POSIX-related codes, such as errno and signals. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* *---------------------------------------------------------------------- * * Tcl_ErrnoId -- * * Return a textual identifier for the current errno value. * * Results: * This procedure returns a machine-readable textual identifier that * corresponds to the current errno value (e.g. "EPERM"). The identifier * is the same as the #define name in errno.h. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_ErrnoId(void) { switch (errno) { #if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW)) case E2BIG: return "E2BIG"; #endif #ifdef EACCES case EACCES: return "EACCES"; #endif #ifdef EADDRINUSE case EADDRINUSE: return "EADDRINUSE"; #endif #ifdef EADDRNOTAVAIL case EADDRNOTAVAIL: return "EADDRNOTAVAIL"; #endif #ifdef EADV case EADV: return "EADV"; #endif #ifdef EAFNOSUPPORT case EAFNOSUPPORT: return "EAFNOSUPPORT"; #endif #ifdef EAGAIN case EAGAIN: return "EAGAIN"; #endif #ifdef EALIGN case EALIGN: return "EALIGN"; #endif #if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY)) case EALREADY: return "EALREADY"; #endif #ifdef EBADE case EBADE: return "EBADE"; #endif #ifdef EBADF case EBADF: return "EBADF"; #endif #ifdef EBADFD case EBADFD: return "EBADFD"; #endif #ifdef EBADMSG case EBADMSG: return "EBADMSG"; #endif #ifdef EBADR case EBADR: return "EBADR"; #endif #ifdef EBADRPC case EBADRPC: return "EBADRPC"; #endif #ifdef EBADRQC case EBADRQC: return "EBADRQC"; #endif #ifdef EBADSLT case EBADSLT: return "EBADSLT"; #endif #ifdef EBFONT case EBFONT: return "EBFONT"; #endif #ifdef EBUSY case EBUSY: return "EBUSY"; #endif #ifdef ECANCELED case ECANCELED: return "ECANCELED"; #endif #ifdef ECASECLASH case ECASECLASH: return "ECASECLASH"; #endif #ifdef ECHILD case ECHILD: return "ECHILD"; #endif #ifdef ECHRNG case ECHRNG: return "ECHRNG"; #endif #ifdef ECOMM case ECOMM: return "ECOMM"; #endif #ifdef ECONNABORTED case ECONNABORTED: return "ECONNABORTED"; #endif #ifdef ECONNREFUSED case ECONNREFUSED: return "ECONNREFUSED"; #endif #ifdef ECONNRESET case ECONNRESET: return "ECONNRESET"; #endif #if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK)) case EDEADLK: return "EDEADLK"; #endif #if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK)) case EDEADLOCK: return "EDEADLOCK"; #endif #ifdef EDESTADDRREQ case EDESTADDRREQ: return "EDESTADDRREQ"; #endif #ifdef EDIRTY case EDIRTY: return "EDIRTY"; #endif #ifdef EDOM case EDOM: return "EDOM"; #endif #ifdef EDOTDOT case EDOTDOT: return "EDOTDOT"; #endif #ifdef EDQUOT case EDQUOT: return "EDQUOT"; #endif #ifdef EDUPPKG case EDUPPKG: return "EDUPPKG"; #endif #ifdef EEXIST case EEXIST: return "EEXIST"; #endif #ifdef EFAULT case EFAULT: return "EFAULT"; #endif #ifdef EFBIG case EFBIG: return "EFBIG"; #endif #ifdef EFTYPE case EFTYPE: return "EFTYPE"; #endif #ifdef EHOSTDOWN case EHOSTDOWN: return "EHOSTDOWN"; #endif #ifdef EHOSTUNREACH case EHOSTUNREACH: return "EHOSTUNREACH"; #endif #if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS)) case EIDRM: return "EIDRM"; #endif #ifdef EINIT case EINIT: return "EINIT"; #endif #ifdef EILSEQ case EILSEQ: return "EILSEQ"; #endif #ifdef EINPROGRESS case EINPROGRESS: return "EINPROGRESS"; #endif #ifdef EINTR case EINTR: return "EINTR"; #endif #ifdef EINVAL case EINVAL: return "EINVAL"; #endif #ifdef EIO case EIO: return "EIO"; #endif #ifdef EISCONN case EISCONN: return "EISCONN"; #endif #ifdef EISDIR case EISDIR: return "EISDIR"; #endif #ifdef EISNAM case EISNAM: return "EISNAM"; #endif #ifdef EL2HLT case EL2HLT: return "EL2HLT"; #endif #ifdef EL2NSYNC case EL2NSYNC: return "EL2NSYNC"; #endif #ifdef EL3HLT case EL3HLT: return "EL3HLT"; #endif #ifdef EL3RST case EL3RST: return "EL3RST"; #endif #ifdef ELBIN case ELBIN: return "ELBIN"; #endif #ifdef ELIBACC case ELIBACC: return "ELIBACC"; #endif #ifdef ELIBBAD case ELIBBAD: return "ELIBBAD"; #endif #ifdef ELIBEXEC case ELIBEXEC: return "ELIBEXEC"; #endif #if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED)) case ELIBMAX: return "ELIBMAX"; #endif #ifdef ELIBSCN case ELIBSCN: return "ELIBSCN"; #endif #ifdef ELNRNG case ELNRNG: return "ELNRNG"; #endif #if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT)) case ELOOP: return "ELOOP"; #endif #ifdef EMEDIUMTYPE case EMEDIUMTYPE: return "EMEDIUMTYPE"; #endif #ifdef EMFILE case EMFILE: return "EMFILE"; #endif #ifdef EMLINK case EMLINK: return "EMLINK"; #endif #ifdef EMSGSIZE case EMSGSIZE: return "EMSGSIZE"; #endif #ifdef EMULTIHOP case EMULTIHOP: return "EMULTIHOP"; #endif #ifdef ENAMETOOLONG case ENAMETOOLONG: return "ENAMETOOLONG"; #endif #ifdef ENAVAIL case ENAVAIL: return "ENAVAIL"; #endif #ifdef ENET case ENET: return "ENET"; #endif #ifdef ENETDOWN case ENETDOWN: return "ENETDOWN"; #endif #ifdef ENETRESET case ENETRESET: return "ENETRESET"; #endif #ifdef ENETUNREACH case ENETUNREACH: return "ENETUNREACH"; #endif #ifdef ENFILE case ENFILE: return "ENFILE"; #endif #ifdef ENMFILE case ENMFILE: return "ENMFILE"; #endif #ifdef ENOANO case ENOANO: return "ENOANO"; #endif #if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR)) case ENOBUFS: return "ENOBUFS"; #endif #ifdef ENOCSI case ENOCSI: return "ENOCSI"; #endif #if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED)) case ENODATA: return "ENODATA"; #endif #ifdef ENODEV case ENODEV: return "ENODEV"; #endif #ifdef ENOENT case ENOENT: return "ENOENT"; #endif #ifdef ENOEXEC case ENOEXEC: return "ENOEXEC"; #endif #ifdef ENOLCK case ENOLCK: return "ENOLCK"; #endif #ifdef ENOLINK case ENOLINK: return "ENOLINK"; #endif #ifdef ENOMEM case ENOMEM: return "ENOMEM"; #endif #ifdef ENOMEDIUM case ENOMEDIUM: return "ENOMEDIUM"; #endif #ifdef ENOMSG case ENOMSG: return "ENOMSG"; #endif #ifdef ENONET case ENONET: return "ENONET"; #endif #ifdef ENOPKG case ENOPKG: return "ENOPKG"; #endif #ifdef ENOPROTOOPT case ENOPROTOOPT: return "ENOPROTOOPT"; #endif #ifdef ENOSHARE case ENOSHARE: return "ENOSHARE"; #endif #ifdef ENOSPC case ENOSPC: return "ENOSPC"; #endif #if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR)) case ENOSR: return "ENOSR"; #endif #if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR)) case ENOSTR: return "ENOSTR"; #endif #ifdef ENOSYM case ENOSYM: return "ENOSYM"; #endif #ifdef ENOSYS case ENOSYS: return "ENOSYS"; #endif #ifdef ENOTBLK case ENOTBLK: return "ENOTBLK"; #endif #ifdef ENOTCONN case ENOTCONN: return "ENOTCONN"; #endif #ifdef ENOTRECOVERABLE case ENOTRECOVERABLE: return "ENOTRECOVERABLE"; #endif #ifdef ENOTDIR case ENOTDIR: return "ENOTDIR"; #endif #if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST)) case ENOTEMPTY: return "ENOTEMPTY"; #endif #ifdef ENOTNAM case ENOTNAM: return "ENOTNAM"; #endif #ifdef ENOTSOCK case ENOTSOCK: return "ENOTSOCK"; #endif #ifdef ENOTSUP case ENOTSUP: return "ENOTSUP"; #endif #ifdef ENOTTY case ENOTTY: return "ENOTTY"; #endif #ifdef ENOTUNIQ case ENOTUNIQ: return "ENOTUNIQ"; #endif #ifdef ENXIO case ENXIO: return "ENXIO"; #endif #if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP)) case EOPNOTSUPP: return "EOPNOTSUPP"; #endif #ifdef EOTHER case EOTHER: return "EOTHER"; #endif #if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL)) case EOVERFLOW: return "EOVERFLOW"; #endif #ifdef EOWNERDEAD case EOWNERDEAD: return "EOWNERDEAD"; #endif #ifdef EPERM case EPERM: return "EPERM"; #endif #if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT)) case EPFNOSUPPORT: return "EPFNOSUPPORT"; #endif #ifdef EPIPE case EPIPE: return "EPIPE"; #endif #ifdef EPROCLIM case EPROCLIM: return "EPROCLIM"; #endif #ifdef EPROCUNAVAIL case EPROCUNAVAIL: return "EPROCUNAVAIL"; #endif #ifdef EPROGMISMATCH case EPROGMISMATCH: return "EPROGMISMATCH"; #endif #ifdef EPROGUNAVAIL case EPROGUNAVAIL: return "EPROGUNAVAIL"; #endif #ifdef EPROTO case EPROTO: return "EPROTO"; #endif #ifdef EPROTONOSUPPORT case EPROTONOSUPPORT: return "EPROTONOSUPPORT"; #endif #ifdef EPROTOTYPE case EPROTOTYPE: return "EPROTOTYPE"; #endif #ifdef ERANGE case ERANGE: return "ERANGE"; #endif #if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED)) case EREFUSED: return "EREFUSED"; #endif #ifdef EREMCHG case EREMCHG: return "EREMCHG"; #endif #ifdef EREMDEV case EREMDEV: return "EREMDEV"; #endif #ifdef EREMOTE case EREMOTE: return "EREMOTE"; #endif #ifdef EREMOTEIO case EREMOTEIO: return "EREMOTEIO"; #endif #ifdef EREMOTERELEASE case EREMOTERELEASE: return "EREMOTERELEASE"; #endif #ifdef ERESTART case ERESTART: return "ERESTART"; #endif #ifdef EROFS case EROFS: return "EROFS"; #endif #ifdef ERPCMISMATCH case ERPCMISMATCH: return "ERPCMISMATCH"; #endif #ifdef ERREMOTE case ERREMOTE: return "ERREMOTE"; #endif #ifdef ESHUTDOWN case ESHUTDOWN: return "ESHUTDOWN"; #endif #ifdef ESOCKTNOSUPPORT case ESOCKTNOSUPPORT: return "ESOCKTNOSUPPORT"; #endif #ifdef ESPIPE case ESPIPE: return "ESPIPE"; #endif #ifdef ESRCH case ESRCH: return "ESRCH"; #endif #ifdef ESRMNT case ESRMNT: return "ESRMNT"; #endif #ifdef ESTALE case ESTALE: return "ESTALE"; #endif #ifdef ESUCCESS case ESUCCESS: return "ESUCCESS"; #endif #if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP)) case ETIME: return "ETIME"; #endif #if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR)) case ETIMEDOUT: return "ETIMEDOUT"; #endif #ifdef ETOOMANYREFS case ETOOMANYREFS: return "ETOOMANYREFS"; #endif #ifdef ETXTBSY case ETXTBSY: return "ETXTBSY"; #endif #ifdef EUCLEAN case EUCLEAN: return "EUCLEAN"; #endif #ifdef EUNATCH case EUNATCH: return "EUNATCH"; #endif #ifdef EUSERS case EUSERS: return "EUSERS"; #endif #ifdef EVERSION case EVERSION: return "EVERSION"; #endif #if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN)) case EWOULDBLOCK: return "EWOULDBLOCK"; #endif #ifdef EXDEV case EXDEV: return "EXDEV"; #endif #ifdef EXFULL case EXFULL: return "EXFULL"; #endif } return "unknown error"; } /* *---------------------------------------------------------------------- * * Tcl_ErrnoMsg -- * * Return a human-readable message corresponding to a given errno value. * * Results: * The return value is the standard POSIX error message for errno. This * procedure is used instead of strerror because strerror returns * slightly different values on different machines (e.g. different * capitalizations), which cause problems for things such as regression * tests. This procedure provides messages for most standard errors, then * it calls strerror for things it doesn't understand. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_ErrnoMsg( int err) /* Error number (such as in errno variable). */ { switch (err) { #if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW)) case E2BIG: return "argument list too long"; #endif #ifdef EACCES case EACCES: return "permission denied"; #endif #ifdef EADDRINUSE case EADDRINUSE: return "address already in use"; #endif #ifdef EADDRNOTAVAIL case EADDRNOTAVAIL: return "cannot assign requested address"; #endif #ifdef EADV case EADV: return "advertise error"; #endif #ifdef EAFNOSUPPORT case EAFNOSUPPORT: return "address family not supported by protocol"; #endif #ifdef EAGAIN case EAGAIN: return "resource temporarily unavailable"; #endif #ifdef EALIGN case EALIGN: return "EALIGN"; #endif #if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY)) case EALREADY: return "operation already in progress"; #endif #ifdef EBADE case EBADE: return "bad exchange descriptor"; #endif #ifdef EBADF case EBADF: return "bad file number"; #endif #ifdef EBADFD case EBADFD: return "file descriptor in bad state"; #endif #ifdef EBADMSG case EBADMSG: return "not a data message"; #endif #ifdef EBADR case EBADR: return "bad request descriptor"; #endif #ifdef EBADRPC case EBADRPC: return "RPC structure is bad"; #endif #ifdef EBADRQC case EBADRQC: return "bad request code"; #endif #ifdef EBADSLT case EBADSLT: return "invalid slot"; #endif #ifdef EBFONT case EBFONT: return "bad font file format"; #endif #ifdef EBUSY case EBUSY: return "file busy"; #endif #ifdef ECANCELED case ECANCELED: return "operation canceled"; #endif #ifdef ECASECLASH case ECASECLASH: return "filename exists with different case"; #endif #ifdef ECHILD case ECHILD: return "no children"; #endif #ifdef ECHRNG case ECHRNG: return "channel number out of range"; #endif #ifdef ECOMM case ECOMM: return "communication error on send"; #endif #ifdef ECONNABORTED case ECONNABORTED: return "software caused connection abort"; #endif #ifdef ECONNREFUSED case ECONNREFUSED: return "connection refused"; #endif #ifdef ECONNRESET case ECONNRESET: return "connection reset by peer"; #endif #if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK)) case EDEADLK: return "resource deadlock avoided"; #endif #if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK)) case EDEADLOCK: return "resource deadlock avoided"; #endif #ifdef EDESTADDRREQ case EDESTADDRREQ: return "destination address required"; #endif #ifdef EDIRTY case EDIRTY: return "mounting a dirty fs w/o force"; #endif #ifdef EDOM case EDOM: return "math argument out of range"; #endif #ifdef EDOTDOT case EDOTDOT: return "cross mount point"; #endif #ifdef EDQUOT case EDQUOT: return "disk quota exceeded"; #endif #ifdef EDUPPKG case EDUPPKG: return "duplicate package name"; #endif #ifdef EEXIST case EEXIST: return "file already exists"; #endif #ifdef EFAULT case EFAULT: return "bad address in system call argument"; #endif #ifdef EFBIG case EFBIG: return "file too large"; #endif #ifdef EFTYPE case EFTYPE: return "inappropriate file type or format"; #endif #ifdef EHOSTDOWN case EHOSTDOWN: return "host is down"; #endif #ifdef EHOSTUNREACH case EHOSTUNREACH: return "host is unreachable"; #endif #if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS)) case EIDRM: return "identifier removed"; #endif #ifdef EINIT case EINIT: return "initialization error"; #endif #ifdef EILSEQ case EILSEQ: return "illegal byte sequence"; #endif #ifdef EINPROGRESS case EINPROGRESS: return "operation now in progress"; #endif #ifdef EINTR case EINTR: return "interrupted system call"; #endif #ifdef EINVAL case EINVAL: return "invalid argument"; #endif #ifdef EIO case EIO: return "I/O error"; #endif #ifdef EISCONN case EISCONN: return "socket is already connected"; #endif #ifdef EISDIR case EISDIR: return "illegal operation on a directory"; #endif #ifdef EISNAM case EISNAM: return "is a name file"; #endif #ifdef EL2HLT case EL2HLT: return "level 2 halted"; #endif #ifdef EL2NSYNC case EL2NSYNC: return "level 2 not synchronized"; #endif #ifdef EL3HLT case EL3HLT: return "level 3 halted"; #endif #ifdef EL3RST case EL3RST: return "level 3 reset"; #endif #ifdef ELBIN case ELBIN: return "inode is remote"; #endif #ifdef ELIBACC case ELIBACC: return "cannot access a needed shared library"; #endif #ifdef ELIBBAD case ELIBBAD: return "accessing a corrupted shared library"; #endif #ifdef ELIBEXEC case ELIBEXEC: return "cannot exec a shared library directly"; #endif #if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED)) case ELIBMAX: return "attempting to link in more shared libraries than system limit"; #endif #ifdef ELIBSCN case ELIBSCN: return ".lib section in a.out corrupted"; #endif #ifdef ELNRNG case ELNRNG: return "link number out of range"; #endif #if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT)) case ELOOP: return "too many levels of symbolic links"; #endif #ifdef EMEDIUMTYPE case EMEDIUMTYPE: return "wrong medium type"; #endif #ifdef EMFILE case EMFILE: return "too many open files"; #endif #ifdef EMLINK case EMLINK: return "too many links"; #endif #ifdef EMSGSIZE case EMSGSIZE: return "message too long"; #endif #ifdef EMULTIHOP case EMULTIHOP: return "multihop attempted"; #endif #ifdef ENAMETOOLONG case ENAMETOOLONG: return "file name too long"; #endif #ifdef ENAVAIL case ENAVAIL: return "not available"; #endif #ifdef ENET case ENET: return "ENET"; #endif #ifdef ENETDOWN case ENETDOWN: return "network is down"; #endif #ifdef ENETRESET case ENETRESET: return "network dropped connection on reset"; #endif #ifdef ENETUNREACH case ENETUNREACH: return "network is unreachable"; #endif #ifdef ENFILE case ENFILE: return "file table overflow"; #endif #ifdef ENMFILE case ENMFILE: return "no more files"; #endif #ifdef ENOANO case ENOANO: return "anode table overflow"; #endif #if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR)) case ENOBUFS: return "no buffer space available"; #endif #ifdef ENOCSI case ENOCSI: return "no CSI structure available"; #endif #if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED)) case ENODATA: return "no data available"; #endif #ifdef ENODEV case ENODEV: return "no such device"; #endif #ifdef ENOENT case ENOENT: return "no such file or directory"; #endif #ifdef ENOEXEC case ENOEXEC: return "exec format error"; #endif #ifdef ENOLCK case ENOLCK: return "no locks available"; #endif #ifdef ENOLINK case ENOLINK: return "link has been severed"; #endif #ifdef ENOMEM case ENOMEM: return "not enough memory"; #endif #ifdef ENOMEDIUM case ENOMEDIUM: return "no medium found"; #endif #ifdef ENOMSG case ENOMSG: return "no message of desired type"; #endif #ifdef ENONET case ENONET: return "machine is not on the network"; #endif #ifdef ENOPKG case ENOPKG: return "package not installed"; #endif #ifdef ENOPROTOOPT case ENOPROTOOPT: return "bad protocol option"; #endif #ifdef ENOSHARE case ENOSHARE: return "no such host or network path"; #endif #ifdef ENOSPC case ENOSPC: return "no space left on device"; #endif #if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR)) case ENOSR: return "out of stream resources"; #endif #if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR)) case ENOSTR: return "not a stream device"; #endif #ifdef ENOSYM case ENOSYM: return "unresolved symbol name"; #endif #ifdef ENOSYS case ENOSYS: return "function not implemented"; #endif #ifdef ENOTBLK case ENOTBLK: return "block device required"; #endif #ifdef ENOTCONN case ENOTCONN: return "socket is not connected"; #endif #ifdef ENOTDIR case ENOTDIR: return "not a directory"; #endif #if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST)) case ENOTEMPTY: return "directory not empty"; #endif #ifdef ENOTNAM case ENOTNAM: return "not a name file"; #endif #ifdef ENOTRECOVERABLE case ENOTRECOVERABLE: return "state not recoverable"; #endif #ifdef ENOTSOCK case ENOTSOCK: return "socket operation on non-socket"; #endif #ifdef ENOTSUP case ENOTSUP: return "operation not supported"; #endif #ifdef ENOTTY case ENOTTY: return "inappropriate device for ioctl"; #endif #ifdef ENOTUNIQ case ENOTUNIQ: return "name not unique on network"; #endif #ifdef ENXIO case ENXIO: return "no such device or address"; #endif #if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP)) case EOPNOTSUPP: return "operation not supported on socket"; #endif #ifdef EOTHER case EOTHER: return "other error"; #endif #if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL)) case EOVERFLOW: return "file too big"; #endif #ifdef EOWNERDEAD case EOWNERDEAD: return "owner died"; #endif #ifdef EPERM case EPERM: return "not owner"; #endif #if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT)) case EPFNOSUPPORT: return "protocol family not supported"; #endif #ifdef EPIPE case EPIPE: return "broken pipe"; #endif #ifdef EPROCLIM case EPROCLIM: return "too many processes"; #endif #ifdef EPROCUNAVAIL case EPROCUNAVAIL: return "bad procedure for program"; #endif #ifdef EPROGMISMATCH case EPROGMISMATCH: return "program version wrong"; #endif #ifdef EPROGUNAVAIL case EPROGUNAVAIL: return "RPC program not available"; #endif #ifdef EPROTO case EPROTO: return "protocol error"; #endif #ifdef EPROTONOSUPPORT case EPROTONOSUPPORT: return "protocol not supported"; #endif #ifdef EPROTOTYPE case EPROTOTYPE: return "protocol wrong type for socket"; #endif #ifdef ERANGE case ERANGE: return "math result unrepresentable"; #endif #if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED)) case EREFUSED: return "connection refused"; #endif #ifdef EREMCHG case EREMCHG: return "remote address changed"; #endif #ifdef EREMDEV case EREMDEV: return "remote device"; #endif #ifdef EREMOTE case EREMOTE: return "pathname hit remote file system"; #endif #ifdef EREMOTEIO case EREMOTEIO: return "remote i/o error"; #endif #ifdef EREMOTERELEASE case EREMOTERELEASE: return "remote peer released connection"; #endif #ifdef ERESTART case ERESTART: return "interrupted system call should be restarted"; #endif #ifdef EROFS case EROFS: return "read-only file system"; #endif #ifdef ERPCMISMATCH case ERPCMISMATCH: return "RPC version is wrong"; #endif #ifdef ERREMOTE case ERREMOTE: return "object is remote"; #endif #ifdef ESHUTDOWN case ESHUTDOWN: return "cannot send after socket shutdown"; #endif #ifdef ESOCKTNOSUPPORT case ESOCKTNOSUPPORT: return "socket type not supported"; #endif #ifdef ESPIPE case ESPIPE: return "invalid seek"; #endif #ifdef ESRCH case ESRCH: return "no such process"; #endif #ifdef ESRMNT case ESRMNT: return "srmount error"; #endif #ifdef ESTALE case ESTALE: return "stale remote file handle"; #endif #ifdef ESTRPIPE case ESTRPIPE: return "streams pipe error"; #endif #ifdef ESUCCESS case ESUCCESS: return "Error 0"; #endif #if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP)) case ETIME: return "timer expired"; #endif #if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR)) case ETIMEDOUT: return "connection timed out"; #endif #ifdef ETOOMANYREFS case ETOOMANYREFS: return "too many references: cannot splice"; #endif #ifdef ETXTBSY case ETXTBSY: return "text file or pseudo-device busy"; #endif #ifdef EUCLEAN case EUCLEAN: return "structure needs cleaning"; #endif #ifdef EUNATCH case EUNATCH: return "protocol driver not attached"; #endif #ifdef EUSERS case EUSERS: return "too many users"; #endif #ifdef EVERSION case EVERSION: return "version mismatch"; #endif #if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN)) case EWOULDBLOCK: return "operation would block"; #endif #ifdef EXDEV case EXDEV: return "cross-domain link"; #endif #ifdef EXFULL case EXFULL: return "message tables full"; #endif default: #ifdef NO_STRERROR return "unknown POSIX error"; #else return strerror(err); #endif } } /* *---------------------------------------------------------------------- * * Tcl_SignalId -- * * Return a textual identifier for a signal number. * * Results: * This procedure returns a machine-readable textual identifier that * corresponds to sig. The identifier is the same as the #define name in * signal.h. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_SignalId( int sig) /* Number of signal. */ { switch (sig) { #ifdef SIGABRT case SIGABRT: return "SIGABRT"; #endif #ifdef SIGALRM case SIGALRM: return "SIGALRM"; #endif #ifdef SIGBUS case SIGBUS: return "SIGBUS"; #endif #ifdef SIGCHLD case SIGCHLD: return "SIGCHLD"; #endif #if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD)) case SIGCLD: return "SIGCLD"; #endif #ifdef SIGCONT case SIGCONT: return "SIGCONT"; #endif #if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU)) case SIGEMT: return "SIGEMT"; #endif #ifdef SIGFPE case SIGFPE: return "SIGFPE"; #endif #ifdef SIGHUP case SIGHUP: return "SIGHUP"; #endif #ifdef SIGILL case SIGILL: return "SIGILL"; #endif #ifdef SIGINT case SIGINT: return "SIGINT"; #endif #ifdef SIGIO case SIGIO: return "SIGIO"; #endif #if defined(SIGIOT) && (!defined(SIGABRT) || (SIGIOT != SIGABRT)) case SIGIOT: return "SIGIOT"; #endif #ifdef SIGKILL case SIGKILL: return "SIGKILL"; #endif #if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO)) case SIGLOST: return "SIGLOST"; #endif #ifdef SIGPIPE case SIGPIPE: return "SIGPIPE"; #endif #if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO)) case SIGPOLL: return "SIGPOLL"; #endif #ifdef SIGPROF case SIGPROF: return "SIGPROF"; #endif #if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST)) case SIGPWR: return "SIGPWR"; #endif #ifdef SIGQUIT case SIGQUIT: return "SIGQUIT"; #endif #if defined(SIGSEGV) && (!defined(SIGBUS) || (SIGSEGV != SIGBUS)) case SIGSEGV: return "SIGSEGV"; #endif #ifdef SIGSTOP case SIGSTOP: return "SIGSTOP"; #endif #ifdef SIGSYS case SIGSYS: return "SIGSYS"; #endif #ifdef SIGTERM case SIGTERM: return "SIGTERM"; #endif #ifdef SIGTRAP case SIGTRAP: return "SIGTRAP"; #endif #ifdef SIGTSTP case SIGTSTP: return "SIGTSTP"; #endif #ifdef SIGTTIN case SIGTTIN: return "SIGTTIN"; #endif #ifdef SIGTTOU case SIGTTOU: return "SIGTTOU"; #endif #if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO)) case SIGURG: return "SIGURG"; #endif #if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO)) case SIGUSR1: return "SIGUSR1"; #endif #if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG)) case SIGUSR2: return "SIGUSR2"; #endif #ifdef SIGVTALRM case SIGVTALRM: return "SIGVTALRM"; #endif #ifdef SIGWINCH case SIGWINCH: return "SIGWINCH"; #endif #ifdef SIGXCPU case SIGXCPU: return "SIGXCPU"; #endif #ifdef SIGXFSZ case SIGXFSZ: return "SIGXFSZ"; #endif #if defined(SIGINFO) && (!defined(SIGPWR) || (SIGINFO != SIGPWR)) case SIGINFO: return "SIGINFO"; #endif } return "unknown signal"; } /* *---------------------------------------------------------------------- * * Tcl_SignalMsg -- * * Return a human-readable message describing a signal. * * Results: * This procedure returns a string describing sig that should make sense * to a human. It may not be easy for a machine to parse. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_SignalMsg( int sig) /* Number of signal. */ { switch (sig) { #ifdef SIGABRT case SIGABRT: return "SIGABRT"; #endif #ifdef SIGALRM case SIGALRM: return "alarm clock"; #endif #ifdef SIGBUS case SIGBUS: return "bus error"; #endif #ifdef SIGCHLD case SIGCHLD: return "child status changed"; #endif #if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD)) case SIGCLD: return "child status changed"; #endif #ifdef SIGCONT case SIGCONT: return "continue after stop"; #endif #if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU)) case SIGEMT: return "EMT instruction"; #endif #ifdef SIGFPE case SIGFPE: return "floating-point exception"; #endif #ifdef SIGHUP case SIGHUP: return "hangup"; #endif #ifdef SIGILL case SIGILL: return "illegal instruction"; #endif #ifdef SIGINT case SIGINT: return "interrupt"; #endif #ifdef SIGIO case SIGIO: return "input/output possible on file"; #endif #if defined(SIGIOT) && (!defined(SIGABRT) || (SIGABRT != SIGIOT)) case SIGIOT: return "IOT instruction"; #endif #ifdef SIGKILL case SIGKILL: return "kill signal"; #endif #if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO)) case SIGLOST: return "resource lost"; #endif #ifdef SIGPIPE case SIGPIPE: return "write on pipe with no readers"; #endif #if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO)) case SIGPOLL: return "input/output possible on file"; #endif #ifdef SIGPROF case SIGPROF: return "profiling alarm"; #endif #if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST)) case SIGPWR: return "power-fail restart"; #endif #ifdef SIGQUIT case SIGQUIT: return "quit signal"; #endif #if defined(SIGSEGV) && (!defined(SIGBUS) || (SIGSEGV != SIGBUS)) case SIGSEGV: return "segmentation violation"; #endif #ifdef SIGSTOP case SIGSTOP: return "stop"; #endif #ifdef SIGSYS case SIGSYS: return "bad argument to system call"; #endif #ifdef SIGTERM case SIGTERM: return "software termination signal"; #endif #ifdef SIGTRAP case SIGTRAP: return "trace trap"; #endif #ifdef SIGTSTP case SIGTSTP: return "stop signal from tty"; #endif #ifdef SIGTTIN case SIGTTIN: return "background tty read"; #endif #ifdef SIGTTOU case SIGTTOU: return "background tty write"; #endif #if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO)) case SIGURG: return "urgent I/O condition"; #endif #if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO)) case SIGUSR1: return "user-defined signal 1"; #endif #if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG)) case SIGUSR2: return "user-defined signal 2"; #endif #ifdef SIGVTALRM case SIGVTALRM: return "virtual time alarm"; #endif #ifdef SIGWINCH case SIGWINCH: return "window changed"; #endif #ifdef SIGXCPU case SIGXCPU: return "exceeded CPU time limit"; #endif #ifdef SIGXFSZ case SIGXFSZ: return "exceeded file size limit"; #endif #if defined(SIGINFO) && (!defined(SIGPWR) || (SIGINFO != SIGPWR)) case SIGINFO: return "information request"; #endif } return "unknown signal"; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclPreserve.c0000644000175000017500000003146114554262142015725 0ustar sergeisergei/* * tclPreserve.c -- * * This file contains a collection of functions that are used to make * sure that widget records and other data structures aren't reallocated * when there are nested functions that depend on their existence. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * The following data structure is used to keep track of all the Tcl_Preserve * calls that are still in effect. It grows as needed to accommodate any * number of calls in effect. */ typedef struct { ClientData clientData; /* Address of preserved block. */ int refCount; /* Number of Tcl_Preserve calls in effect for * block. */ int mustFree; /* Non-zero means Tcl_EventuallyFree was * called while a Tcl_Preserve call was in * effect, so the structure must be freed when * refCount becomes zero. */ Tcl_FreeProc *freeProc; /* Function to call to free. */ } Reference; /* * Global data structures used to hold the list of preserved data references. * These variables are protected by "preserveMutex". */ static Reference *refArray = NULL; /* First in array of references. */ static int spaceAvl = 0; /* Total number of structures available at * *firstRefPtr. */ static int inUse = 0; /* Count of structures currently in use in * refArray. */ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ #define INITIAL_SIZE 2 /* Initial number of reference slots to make */ /* * The following data structure is used to keep track of whether an arbitrary * block of memory has been deleted. This is used by the TclHandle code to * avoid the more time-expensive algorithm of Tcl_Preserve(). This mechanism * is mainly used when we have lots of references to a few big, expensive * objects that we don't want to live any longer than necessary. */ typedef struct HandleStruct { void *ptr; /* Pointer to the memory block being tracked. * This field will become NULL when the memory * block is deleted. This field must be the * first in the structure. */ #ifdef TCL_MEM_DEBUG void *ptr2; /* Backup copy of the above pointer used to * ensure that the contents of the handle are * not changed by anyone else. */ #endif int refCount; /* Number of TclHandlePreserve() calls in * effect on this handle. */ } HandleStruct; /* *---------------------------------------------------------------------- * * TclFinalizePreserve -- * * Called during exit processing to clean up the reference array. * * Results: * None. * * Side effects: * Frees the storage of the reference array. * *---------------------------------------------------------------------- */ /* ARGSUSED */ void TclFinalizePreserve(void) { Tcl_MutexLock(&preserveMutex); if (spaceAvl != 0) { ckfree(refArray); refArray = NULL; inUse = 0; spaceAvl = 0; } Tcl_MutexUnlock(&preserveMutex); } /* *---------------------------------------------------------------------- * * Tcl_Preserve -- * * This function is used by a function to declare its interest in a * particular block of memory, so that the block will not be reallocated * until a matching call to Tcl_Release has been made. * * Results: * None. * * Side effects: * Information is retained so that the block of memory will not be freed * until at least the matching call to Tcl_Release. * *---------------------------------------------------------------------- */ void Tcl_Preserve( ClientData clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; int i; /* * See if there is already a reference for this pointer. If so, just * increment its reference count. */ Tcl_MutexLock(&preserveMutex); for (i=0, refPtr=refArray ; iclientData == clientData) { refPtr->refCount++; Tcl_MutexUnlock(&preserveMutex); return; } } /* * Make a reference array if it doesn't already exist, or make it bigger * if it is full. */ if (inUse == spaceAvl) { spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE; refArray = ckrealloc(refArray, spaceAvl * sizeof(Reference)); } /* * Make a new entry for the new reference. */ refPtr = &refArray[inUse]; refPtr->clientData = clientData; refPtr->refCount = 1; refPtr->mustFree = 0; refPtr->freeProc = TCL_STATIC; inUse += 1; Tcl_MutexUnlock(&preserveMutex); } /* *---------------------------------------------------------------------- * * Tcl_Release -- * * This function is called to cancel a previous call to Tcl_Preserve, * thereby allowing a block of memory to be freed (if no one else cares * about it). * * Results: * None. * * Side effects: * If Tcl_EventuallyFree has been called for clientData, and if no other * call to Tcl_Preserve is still in effect, the block of memory is freed. * *---------------------------------------------------------------------- */ void Tcl_Release( ClientData clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; int i; Tcl_MutexLock(&preserveMutex); for (i=0, refPtr=refArray ; iclientData != clientData) { continue; } if (--refPtr->refCount != 0) { Tcl_MutexUnlock(&preserveMutex); return; } /* * Must remove information from the slot before calling freeProc to * avoid reentrancy problems if the freeProc calls Tcl_Preserve on the * same clientData. Copy down the last reference in the array to * overwrite the current slot. */ freeProc = refPtr->freeProc; mustFree = refPtr->mustFree; inUse--; if (i < inUse) { refArray[i] = refArray[inUse]; } /* * Now committed to disposing the data. But first, we've patched up * all the global data structures so we should release the mutex now. * Only then should we dabble around with potentially-slow memory * managers... */ Tcl_MutexUnlock(&preserveMutex); if (mustFree) { if (freeProc == TCL_DYNAMIC) { ckfree(clientData); } else { freeProc(clientData); } } return; } Tcl_MutexUnlock(&preserveMutex); /* * Reference not found. This is a bug in the caller. */ Tcl_Panic("Tcl_Release couldn't find reference for %p", clientData); } /* *---------------------------------------------------------------------- * * Tcl_EventuallyFree -- * * Free up a block of memory, unless a call to Tcl_Preserve is in effect * for that block. In this case, defer the free until all calls to * Tcl_Preserve have been undone by matching calls to Tcl_Release. * * Results: * None. * * Side effects: * Ptr may be released by calling free(). * *---------------------------------------------------------------------- */ void Tcl_EventuallyFree( ClientData clientData, /* Pointer to malloc'ed block of memory. */ Tcl_FreeProc *freeProc) /* Function to actually do free. */ { Reference *refPtr; int i; /* * See if there is a reference for this pointer. If so, set its "mustFree" * flag (the flag had better not be set already!). */ Tcl_MutexLock(&preserveMutex); for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) { if (refPtr->clientData != clientData) { continue; } if (refPtr->mustFree) { Tcl_Panic("Tcl_EventuallyFree called twice for %p", clientData); } refPtr->mustFree = 1; refPtr->freeProc = freeProc; Tcl_MutexUnlock(&preserveMutex); return; } Tcl_MutexUnlock(&preserveMutex); /* * No reference for this block. Free it now. */ if (freeProc == TCL_DYNAMIC) { ckfree(clientData); } else { freeProc(clientData); } } /* *--------------------------------------------------------------------------- * * TclHandleCreate -- * * Allocate a handle that contains enough information to determine if an * arbitrary malloc'd block has been deleted. This is used to avoid the * more time-expensive algorithm of Tcl_Preserve(). * * Results: * The return value is a TclHandle that refers to the given malloc'd * block. Doubly dereferencing the returned handle will give back the * pointer to the block, or will give NULL if the block has been deleted. * * Side effects: * The caller must keep track of this handle (generally by storing it in * a field in the malloc'd block) and call TclHandleFree() on this handle * when the block is deleted. Everything else that wishes to keep track * of whether the malloc'd block has been deleted should use calls to * TclHandlePreserve() and TclHandleRelease() on the associated handle. * *--------------------------------------------------------------------------- */ TclHandle TclHandleCreate( void *ptr) /* Pointer to an arbitrary block of memory to * be tracked for deletion. Must not be * NULL. */ { HandleStruct *handlePtr = ckalloc(sizeof(HandleStruct)); handlePtr->ptr = ptr; #ifdef TCL_MEM_DEBUG handlePtr->ptr2 = ptr; #endif handlePtr->refCount = 0; return (TclHandle) handlePtr; } /* *--------------------------------------------------------------------------- * * TclHandleFree -- * * Called when the arbitrary malloc'd block associated with the handle is * being deleted. Modifies the handle so that doubly dereferencing it * will give NULL. This informs any user of the handle that the block of * memory formerly referenced by the handle has been freed. * * Results: * None. * * Side effects: * If nothing is referring to the handle, the handle will be reclaimed. * *--------------------------------------------------------------------------- */ void TclHandleFree( TclHandle handle) /* Previously created handle associated with a * malloc'd block that is being deleted. The * handle is modified so that doubly * dereferencing it will give NULL. */ { HandleStruct *handlePtr; handlePtr = (HandleStruct *) handle; #ifdef TCL_MEM_DEBUG if (handlePtr->refCount == 0x61616161) { Tcl_Panic("using previously disposed TclHandle %p", handlePtr); } if (handlePtr->ptr2 != handlePtr->ptr) { Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p", handlePtr, handlePtr->ptr2, handlePtr->ptr); } #endif handlePtr->ptr = NULL; if (handlePtr->refCount == 0) { ckfree(handlePtr); } } /* *--------------------------------------------------------------------------- * * TclHandlePreserve -- * * Declare an interest in the arbitrary malloc'd block associated with * the handle. * * Results: * The return value is the handle argument, with its ref count * incremented. * * Side effects: * For each call to TclHandlePreserve(), there should be a matching call * to TclHandleRelease() when the caller is no longer interested in the * malloc'd block associated with the handle. * *--------------------------------------------------------------------------- */ TclHandle TclHandlePreserve( TclHandle handle) /* Declare an interest in the block of memory * referenced by this handle. */ { HandleStruct *handlePtr; handlePtr = (HandleStruct *) handle; #ifdef TCL_MEM_DEBUG if (handlePtr->refCount == 0x61616161) { Tcl_Panic("using previously disposed TclHandle %p", handlePtr); } if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) { Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p", handlePtr, handlePtr->ptr2, handlePtr->ptr); } #endif handlePtr->refCount++; return handle; } /* *--------------------------------------------------------------------------- * * TclHandleRelease -- * * This function is called to release an interest in the malloc'd block * associated with the handle. * * Results: * None. * * Side effects: * The ref count of the handle is decremented. If the malloc'd block has * been freed and if no one is using the handle any more, the handle will * be reclaimed. * *--------------------------------------------------------------------------- */ void TclHandleRelease( TclHandle handle) /* Unregister interest in the block of memory * referenced by this handle. */ { HandleStruct *handlePtr; handlePtr = (HandleStruct *) handle; #ifdef TCL_MEM_DEBUG if (handlePtr->refCount == 0x61616161) { Tcl_Panic("using previously disposed TclHandle %p", handlePtr); } if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) { Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p", handlePtr, handlePtr->ptr2, handlePtr->ptr); } #endif if ((--handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) { ckfree(handlePtr); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclProc.c0000644000175000017500000023473514554262142015046 0ustar sergeisergei/* * tclProc.c -- * * This file contains routines that implement Tcl procedures, including * the "proc" and "uplevel" commands. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 2004-2006 Miguel Sofer * Copyright (c) 2007 Daniel A. Steffen * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" /* * Variables that are part of the [apply] command implementation and which * have to be passed to the other side of the NRE call. */ typedef struct { Command cmd; ExtraFrameInfo efi; } ApplyExtraData; /* * Prototypes for static functions in this file */ static void DupLambdaInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void FreeLambdaInternalRep(Tcl_Obj *objPtr); static int InitArgsAndLocals(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip); static void InitResolvedLocals(Tcl_Interp *interp, ByteCode *codePtr, Var *defPtr, Namespace *nsPtr); static void InitLocalCache(Proc *procPtr); static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void ProcBodyFree(Tcl_Obj *objPtr); static int ProcWrongNumArgs(Tcl_Interp *interp, int skip); static void MakeProcError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void MakeLambdaError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static Tcl_NRPostProc ApplyNR2; static Tcl_NRPostProc InterpProcNR2; static Tcl_NRPostProc Uplevel_Callback; /* * The ProcBodyObjType type */ const Tcl_ObjType tclProcBodyType = { "procbody", /* name for this type */ ProcBodyFree, /* FreeInternalRep function */ ProcBodyDup, /* DupInternalRep function */ NULL, /* UpdateString function; Tcl_GetString and * Tcl_GetStringFromObj should panic * instead. */ NULL /* SetFromAny function; Tcl_ConvertToType * should panic instead. */ }; /* * The [upvar]/[uplevel] level reference type. Uses the longValue field * to remember the integer value of a parsed # format. * * Uses the default behaviour throughout, and never disposes of the string * rep; it's just a cache type. */ static const Tcl_ObjType levelReferenceType = { "levelReference", NULL, NULL, NULL, NULL }; /* * The type of lambdas. Note that every lambda will *always* have a string * representation. * * Internally, ptr1 is a pointer to a Proc instance that is not bound to a * command name, and ptr2 is a pointer to the namespace that the Proc instance * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO. */ const Tcl_ObjType tclLambdaType = { "lambdaExpr", /* name */ FreeLambdaInternalRep, /* freeIntRepProc */ DupLambdaInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetLambdaFromAny /* setFromAnyProc */ }; /* *---------------------------------------------------------------------- * * Tcl_ProcObjCmd -- * * This object-based function is invoked to process the "proc" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * A new procedure gets created. * *---------------------------------------------------------------------- */ #undef TclObjInterpProc int Tcl_ProcObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr; const char *procName; const char *simpleName, *procArgs, *procBody; Namespace *nsPtr, *altNsPtr, *cxtNsPtr; Tcl_Command cmd; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "name args body"); return TCL_ERROR; } /* * Determine the namespace where the procedure should reside. Unless the * command name includes namespace qualifiers, this will be the current * namespace. */ procName = TclGetString(objv[1]); TclGetNamespaceForQualName(interp, procName, NULL, 0, &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName); if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create procedure \"%s\": unknown namespace", procName)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL); return TCL_ERROR; } if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create procedure \"%s\": bad procedure name", procName)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL); return TCL_ERROR; } /* * Create the data structure to represent the procedure. */ if (TclCreateProc(interp, nsPtr, simpleName, objv[2], objv[3], &procPtr) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (creating proc \""); Tcl_AddErrorInfo(interp, simpleName); Tcl_AddErrorInfo(interp, "\")"); return TCL_ERROR; } cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr, TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc); /* * Now initialize the new procedure's cmdPtr field. This will be used * later when the procedure is called to determine what namespace the * procedure will run in. This will be different than the current * namespace if the proc was renamed into a different namespace. */ procPtr->cmdPtr = (Command *) cmd; /* * TIP #280: Remember the line the procedure body is starting on. In a * bytecode context we ask the engine to provide us with the necessary * information. This is for the initialization of the byte code compiler * when the body is used for the first time. * * This code is nearly identical to the #280 code in SetLambdaFromAny, see * this file. The differences are the different index of the body in the * line array of the context, and the lambda code requires some special * processing. Find a way to factor the common elements into a single * function. */ if (iPtr->cmdFramePtr) { CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *contextPtr = *iPtr->cmdFramePtr; if (contextPtr->type == TCL_LOCATION_BC) { /* * Retrieve source information from the bytecode, if possible. If * the information is retrieved successfully, context.type will be * TCL_LOCATION_SOURCE and the reference held by * context.data.eval.path will be counted. */ TclGetSrcInfoForPc(contextPtr); } else if (contextPtr->type == TCL_LOCATION_SOURCE) { /* * The copy into 'context' up above has created another reference * to 'context.data.eval.path'; account for it. */ Tcl_IncrRefCount(contextPtr->data.eval.path); } if (contextPtr->type == TCL_LOCATION_SOURCE) { /* * We can account for source location within a proc only if the * proc body was not created by substitution. */ if (contextPtr->line && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) { int isNew; Tcl_HashEntry *hePtr; CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); cfPtr->level = -1; cfPtr->type = contextPtr->type; cfPtr->line = (int *)ckalloc(sizeof(int)); cfPtr->line[0] = contextPtr->line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = contextPtr->data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); cfPtr->cmd = NULL; cfPtr->len = 0; hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *)procPtr, &isNew); if (!isNew) { /* * Get the old command frame and release it. See also * TclProcCleanupProc in this file. Currently it seems as * if only the procbodytest::proc command of the testsuite * is able to trigger this situation. */ CmdFrame *cfOldPtr = (CmdFrame *)Tcl_GetHashValue(hePtr); if (cfOldPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfOldPtr->data.eval.path); cfOldPtr->data.eval.path = NULL; } ckfree(cfOldPtr->line); cfOldPtr->line = NULL; ckfree(cfOldPtr); } Tcl_SetHashValue(hePtr, cfPtr); } /* * 'contextPtr' is going out of scope; account for the reference * that it's holding to the path name. */ Tcl_DecrRefCount(contextPtr->data.eval.path); contextPtr->data.eval.path = NULL; } TclStackFree(interp, contextPtr); } /* * Optimize for no-op procs: if the body is not precompiled (like a TclPro * procbody), and the argument list is just "args" and the body is empty, * define a compileProc to compile a no-op. * * Notes: * - cannot be done for any argument list without having different * compiled/not-compiled behaviour in the "wrong argument #" case, or * making this code much more complicated. In any case, it doesn't * seem to make a lot of sense to verify the number of arguments we * are about to ignore ... * - could be enhanced to handle also non-empty bodies that contain only * comments; however, parsing the body will slow down the compilation * of all procs whose argument list is just _args_ */ if (objv[3]->typePtr == &tclProcBodyType) { goto done; } procArgs = TclGetString(objv[2]); while (*procArgs == ' ') { procArgs++; } if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) { int numBytes; procArgs +=4; while (*procArgs != '\0') { if (*procArgs != ' ') { goto done; } procArgs++; } /* * The argument list is just "args"; check the body */ procBody = Tcl_GetStringFromObj(objv[3], &numBytes); if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) { goto done; } /* * The body is just spaces: link the compileProc */ ((Command *) cmd)->compileProc = TclCompileNoOp; } done: return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCreateProc -- * * Creates the data associated with a Tcl procedure definition. This * function knows how to handle two types of body objects: strings and * procbody. Strings are the traditional (and common) value for bodies, * procbody are values created by extensions that have loaded a * previously compiled script. * * Results: * Returns TCL_OK on success, along with a pointer to a Tcl procedure * definition in procPtrPtr where the cmdPtr field is not initialised. * This definition should be freed by calling TclProcCleanupProc() when * it is no longer needed. Returns TCL_ERROR if anything goes wrong. * * Side effects: * If anything goes wrong, this function returns an error message in the * interpreter. * *---------------------------------------------------------------------- */ int TclCreateProc( Tcl_Interp *interp, /* Interpreter containing proc. */ Namespace *nsPtr, /* Namespace containing this proc. */ const char *procName, /* Unqualified name of this proc. */ Tcl_Obj *argsPtr, /* Description of arguments. */ Tcl_Obj *bodyPtr, /* Command body. */ Proc **procPtrPtr) /* Returns: pointer to proc data. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr; int i, result, numArgs; CompiledLocal *localPtr = NULL; Tcl_Obj **argArray; int precompiled = 0; if (bodyPtr->typePtr == &tclProcBodyType) { /* * Because the body is a TclProProcBody, the actual body is already * compiled, and it is not shared with anyone else, so it's OK not to * unshare it (as a matter of fact, it is bad to unshare it, because * there may be no source code). * * We don't create and initialize a Proc structure for the procedure; * rather, we use what is in the body object. We increment the ref * count of the Proc struct since the command (soon to be created) * will be holding a reference to it. */ procPtr = bodyPtr->internalRep.twoPtrValue.ptr1; procPtr->iPtr = iPtr; procPtr->refCount++; precompiled = 1; } else { /* * If the procedure's body object is shared because its string value * is identical to, e.g., the body of another procedure, we must * create a private copy for this procedure to use. Such sharing of * procedure bodies is rare but can cause problems. A procedure body * is compiled in a context that includes the number of "slots" * allocated by the compiler for local variables. There is a local * variable slot for each formal parameter (the * "procPtr->numCompiledLocals = numArgs" assignment below). This * means that the same code can not be shared by two procedures that * have a different number of arguments, even if their bodies are * identical. Note that we don't use Tcl_DuplicateObj since we would * not want any bytecode internal representation. */ if (Tcl_IsShared(bodyPtr)) { const char *bytes; int length; Tcl_Obj *sharedBodyPtr = bodyPtr; bytes = TclGetStringFromObj(bodyPtr, &length); bodyPtr = Tcl_NewStringObj(bytes, length); /* * TIP #280. * Ensure that the continuation line data for the original body is * not lost and applies to the new body as well. */ TclContinuationsCopy(bodyPtr, sharedBodyPtr); } /* * Create and initialize a Proc structure for the procedure. We * increment the ref count of the procedure's body object since there * will be a reference to it in the Proc structure. */ Tcl_IncrRefCount(bodyPtr); procPtr = (Proc *)ckalloc(sizeof(Proc)); procPtr->iPtr = iPtr; procPtr->refCount = 1; procPtr->bodyPtr = bodyPtr; procPtr->numArgs = 0; /* Actual argument count is set below. */ procPtr->numCompiledLocals = 0; procPtr->firstLocalPtr = NULL; procPtr->lastLocalPtr = NULL; } /* * Break up the argument list into argument specifiers, then process each * argument specifier. If the body is precompiled, processing is limited * to checking that the parsed argument is consistent with the one stored * in the Proc. */ result = TclListObjGetElements(interp, argsPtr, &numArgs, &argArray); if (result != TCL_OK) { goto procError; } if (precompiled) { if (numArgs > procPtr->numArgs) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": arg list contains %d entries, " "precompiled header expects %d", procName, numArgs, procPtr->numArgs)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); goto procError; } localPtr = procPtr->firstLocalPtr; } else { procPtr->numArgs = numArgs; procPtr->numCompiledLocals = numArgs; } for (i = 0; i < numArgs; i++) { const char *argname, *p, *last; int fieldCount, nameLength; Tcl_Obj **fieldValues; /* * Now divide the specifier up into name and default. */ result = TclListObjGetElements(interp, argArray[i], &fieldCount, &fieldValues); if (result != TCL_OK) { goto procError; } if (fieldCount > 2) { Tcl_Obj *errorObj = Tcl_NewStringObj( "too many fields in argument specifier \"", -1); Tcl_AppendObjToObj(errorObj, argArray[i]); Tcl_AppendToObj(errorObj, "\"", -1); Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } /* * Check that the formal parameter name is a scalar. */ p = argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength); last = argname + nameLength; while (p < last) { if (*p == '(') { if (last[-1] == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", Tcl_GetString(fieldValues[0]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } } else if (p[0] == ':' && p[1] == ':') { Tcl_Obj *errorObj = Tcl_NewStringObj( "formal parameter \"", -1); Tcl_AppendObjToObj(errorObj, fieldValues[0]); Tcl_AppendToObj(errorObj, "\" is not a simple name", -1); Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } p++; } if (precompiled) { /* * Compare the parsed argument with the stored one. Note that the * only flag value that makes sense at this point is VAR_ARGUMENT * (its value was kept the same as pre VarReform to simplify * tbcload's processing of older byetcodes). * * The only other flag value that is important to retrieve from * precompiled procs is VAR_TEMPORARY (also unchanged). It is * needed later when retrieving the variable names. */ if ((localPtr->nameLength != nameLength) || (memcmp(localPtr->name, argname, nameLength) != 0) || (localPtr->frameIndex != i) || !(localPtr->flags & VAR_ARGUMENT) || (localPtr->defValuePtr == NULL && fieldCount == 2) || (localPtr->defValuePtr != NULL && fieldCount != 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": formal parameter %d is " "inconsistent with precompiled body", procName, i)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); goto procError; } /* * Compare the default value if any. */ if (localPtr->defValuePtr != NULL) { int tmpLength, valueLength; const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength); const char *value = TclGetStringFromObj(fieldValues[1], &valueLength); if ((valueLength != tmpLength) || memcmp(value, tmpPtr, tmpLength) != 0 ) { Tcl_Obj *errorObj = Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"", procName); Tcl_AppendObjToObj(errorObj, fieldValues[0]); Tcl_AppendToObj(errorObj, "\" has " "default value inconsistent with precompiled body", -1); Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); goto procError; } } if ((i == numArgs - 1) && (localPtr->nameLength == 4) && (localPtr->name[0] == 'a') && (strcmp(localPtr->name, "args") == 0)) { localPtr->flags |= VAR_IS_ARGS; } localPtr = localPtr->nextPtr; } else { /* * Allocate an entry in the runtime procedure frame's array of * local variables for the argument. */ localPtr = (CompiledLocal *)ckalloc( TclOffset(CompiledLocal, name) + 1U + fieldValues[0]->length); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; } localPtr->nextPtr = NULL; localPtr->nameLength = nameLength; localPtr->frameIndex = i; localPtr->flags = VAR_ARGUMENT; localPtr->resolveInfo = NULL; if (fieldCount == 2) { localPtr->defValuePtr = fieldValues[1]; Tcl_IncrRefCount(localPtr->defValuePtr); } else { localPtr->defValuePtr = NULL; } memcpy(localPtr->name, argname, fieldValues[0]->length + 1); if ((i == numArgs - 1) && (localPtr->nameLength == 4) && (localPtr->name[0] == 'a') && (memcmp(localPtr->name, "args", 4) == 0)) { localPtr->flags |= VAR_IS_ARGS; } } } *procPtrPtr = procPtr; return TCL_OK; procError: if (precompiled) { procPtr->refCount--; } else { Tcl_DecrRefCount(bodyPtr); while (procPtr->firstLocalPtr != NULL) { localPtr = procPtr->firstLocalPtr; procPtr->firstLocalPtr = localPtr->nextPtr; if (localPtr->defValuePtr != NULL) { Tcl_DecrRefCount(localPtr->defValuePtr); } ckfree(localPtr); } ckfree(procPtr); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclGetFrame -- * * Given a description of a procedure frame, such as the first argument * to an "uplevel" or "upvar" command, locate the call frame for the * appropriate level of procedure. * * Results: * The return value is -1 if an error occurred in finding the frame (in * this case an error message is left in the interp's result). 1 is * returned if string was either a number or a number preceded by "#" and * it specified a valid frame. 0 is returned if string isn't one of the * two things above (in this case, the lookup acts as if string were * "1"). The variable pointed to by framePtrPtr is filled in with the * address of the desired frame (unless an error occurs, in which case it * isn't modified). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGetFrame( Tcl_Interp *interp, /* Interpreter in which to find frame. */ const char *name, /* String describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { Interp *iPtr = (Interp *) interp; int curLevel, level, result; CallFrame *framePtr; /* * Parse string to figure out which level number to go to. */ result = 1; curLevel = iPtr->varFramePtr->level; if (*name== '#') { if (Tcl_GetInt(NULL, name+1, &level) != TCL_OK || level < 0) { goto levelError; } } else if (isdigit(UCHAR(*name))) { /* INTL: digit */ if (Tcl_GetInt(NULL, name, &level) != TCL_OK) { goto levelError; } level = curLevel - level; } else { /* * (historical, TODO) If name does not contain a level (#0 or 1), * TclGetFrame and Tcl_UpVar2 uses current level - 1 */ level = curLevel - 1; result = 0; name = "1"; /* be more consistent with TclObjGetFrame (error at top - 1) */ } /* * Figure out which frame to use, and return it to the caller. */ for (framePtr = iPtr->varFramePtr; framePtr != NULL; framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { break; } } if (framePtr == NULL) { goto levelError; } *framePtrPtr = framePtr; return result; levelError: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL); return -1; } /* *---------------------------------------------------------------------- * * TclObjGetFrame -- * * Given a description of a procedure frame, such as the first argument * to an "uplevel" or "upvar" command, locate the call frame for the * appropriate level of procedure. * * Results: * The return value is -1 if an error occurred in finding the frame (in * this case an error message is left in the interp's result). 1 is * returned if objPtr was either an int or an int preceded by "#" and * it specified a valid frame. 0 is returned if objPtr isn't one of the * two things above (in this case, the lookup acts as if objPtr were * "1"). The variable pointed to by framePtrPtr is filled in with the * address of the desired frame (unless an error occurs, in which case it * isn't modified). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclObjGetFrame( Tcl_Interp *interp, /* Interpreter in which to find frame. */ Tcl_Obj *objPtr, /* Object describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { Interp *iPtr = (Interp *) interp; int curLevel, level, result; const char *name = NULL; /* * Parse object to figure out which level number to go to. */ result = 0; curLevel = iPtr->varFramePtr->level; /* * Check for integer first, since that has potential to spare us * a generation of a stringrep. */ if (objPtr == NULL) { /* Do nothing */ } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level) && (level >= 0)) { level = curLevel - level; result = 1; } else if (objPtr->typePtr == &levelReferenceType) { level = (int) objPtr->internalRep.longValue; result = 1; } else { name = TclGetString(objPtr); if (name[0] == '#') { if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) { TclFreeIntRep(objPtr); objPtr->typePtr = &levelReferenceType; objPtr->internalRep.longValue = level; result = 1; } else { result = -1; } } else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */ /* * If this were an integer, we'd have succeeded already. * Docs say we have to treat this as a 'bad level' error. */ result = -1; } } if (result == 0) { level = curLevel - 1; name = "1"; } if (result != -1) { if (level >= 0) { CallFrame *framePtr; for (framePtr = iPtr->varFramePtr; framePtr != NULL; framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { *framePtrPtr = framePtr; return result; } } } if (name == NULL) { name = TclGetString(objPtr); } } Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL); return -1; } /* *---------------------------------------------------------------------- * * Tcl_UplevelObjCmd -- * * This object function is invoked to process the "uplevel" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Uplevel_Callback( ClientData data[], Tcl_Interp *interp, int result) { CallFrame *savedVarFramePtr = (CallFrame *)data[0]; if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"uplevel\" body line %d)", Tcl_GetErrorLine(interp))); } /* * Restore the variable frame, and return. */ ((Interp *)interp)->varFramePtr = savedVarFramePtr; return result; } int Tcl_UplevelObjCmd( ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, clientData, objc, objv); } int TclNRUplevelObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; int result; CallFrame *savedVarFramePtr, *framePtr; Tcl_Obj *objPtr; if (objc < 2) { /* to do * simplify things by interpreting the argument as a command when there * is only one argument. This requires a TIP since currently a single * argument is interpreted as a level indicator if possible. */ uplevelSyntax: Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?"); return TCL_ERROR; } else if (!TclHasStringRep(objv[1]) && objc == 2) { int status ,llength; status = TclListObjLength(interp, objv[1], &llength); if (status == TCL_OK && llength > 1) { /* the first argument can't interpreted as a level. Avoid * generating a string representation of the script. */ result = TclGetFrame(interp, "1", &framePtr); if (result == -1) { return TCL_ERROR; } objc -= 1; objv += 1; goto havelevel; } } /* * Find the level to use for executing the command. */ result = TclObjGetFrame(interp, objv[1], &framePtr); if (result == -1) { return TCL_ERROR; } objc -= result + 1; if (objc == 0) { goto uplevelSyntax; } objv += result + 1; havelevel: /* * Modify the interpreter state to execute in the given frame. */ savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = framePtr; /* * Execute the residual arguments as a command. */ if (objc == 1) { /* * TIP #280. Make actual argument location available to eval'd script */ TclArgumentGet(interp, objv[0], &invoker, &word); objPtr = objv[0]; } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. */ objPtr = Tcl_ConcatObj(objc, objv); } TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0, invoker, word); } /* *---------------------------------------------------------------------- * * TclFindProc -- * * Given the name of a procedure, return a pointer to the record * describing the procedure. The procedure will be looked up using the * usual rules: first in the current namespace and then in the global * namespace. * * Results: * NULL is returned if the name doesn't correspond to any procedure. * Otherwise, the return value is a pointer to the procedure's record. If * the name is found but refers to an imported command that points to a * "real" procedure defined in another namespace, a pointer to that * "real" procedure's structure is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ Proc * TclFindProc( Interp *iPtr, /* Interpreter in which to look. */ const char *procName) /* Name of desired procedure. */ { Tcl_Command cmd; Command *cmdPtr; cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName, NULL, /*flags*/ 0); if (cmd == (Tcl_Command) NULL) { return NULL; } cmdPtr = (Command *) cmd; return TclIsProc(cmdPtr); } /* *---------------------------------------------------------------------- * * TclIsProc -- * * Tells whether a command is a Tcl procedure or not. * * Results: * If the given command is actually a Tcl procedure, the return value is * the address of the record describing the procedure. Otherwise the * return value is 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ Proc * TclIsProc( Command *cmdPtr) /* Command to test. */ { Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr); if (origCmd != NULL) { cmdPtr = (Command *) origCmd; } if (cmdPtr->deleteProc == TclProcDeleteProc) { return (Proc *)cmdPtr->objClientData; } return NULL; } static int ProcWrongNumArgs( Tcl_Interp *interp, int skip) { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; Proc *procPtr = framePtr->procPtr; int localCt = procPtr->numCompiledLocals, numArgs, i; Tcl_Obj **desiredObjs; const char *final = NULL; /* * Build up desired argument list for Tcl_WrongNumArgs */ numArgs = framePtr->procPtr->numArgs; desiredObjs = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * (numArgs+1)); if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { #ifdef AVOID_HACKS_FOR_ITCL desiredObjs[0] = framePtr->objv[skip-1]; #else desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); #endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { Var *defPtr = (Var *)(&framePtr->localCachePtr->varName0 + localCt); for (i=1 ; i<=numArgs ; i++, defPtr++) { Tcl_Obj *argObj; Tcl_Obj *namePtr = localName(framePtr, i-1); if (defPtr->value.objPtr != NULL) { TclNewObj(argObj); Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL); } else if (defPtr->flags & VAR_IS_ARGS) { numArgs--; final = "?arg ...?"; break; } else { argObj = namePtr; Tcl_IncrRefCount(namePtr); } desiredObjs[i] = argObj; } } Tcl_ResetResult(interp); Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final); for (i=0 ; i<=numArgs ; i++) { Tcl_DecrRefCount(desiredObjs[i]); } TclStackFree(interp, desiredObjs); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclInitCompiledLocals -- * * This routine is invoked in order to initialize the compiled locals * table for a new call frame. * * DEPRECATED: functionality has been inlined elsewhere; this function * remains to insure binary compatibility with Itcl. * * Results: * None. * * Side effects: * May invoke various name resolvers in order to determine which * variables are being referenced at runtime. * *---------------------------------------------------------------------- */ void TclInitCompiledLocals( Tcl_Interp *interp, /* Current interpreter. */ CallFrame *framePtr, /* Call frame to initialize. */ Namespace *nsPtr) /* Pointer to current namespace. */ { Var *varPtr = framePtr->compiledLocals; Tcl_Obj *bodyPtr; ByteCode *codePtr; bodyPtr = framePtr->procPtr->bodyPtr; if (bodyPtr->typePtr != &tclByteCodeType) { Tcl_Panic("body object for proc attached to frame is not a byte code type"); } codePtr = bodyPtr->internalRep.twoPtrValue.ptr1; if (framePtr->numCompiledLocals) { if (!codePtr->localCachePtr) { InitLocalCache(framePtr->procPtr) ; } framePtr->localCachePtr = codePtr->localCachePtr; framePtr->localCachePtr->refCount++; } InitResolvedLocals(interp, codePtr, varPtr, nsPtr); } /* *---------------------------------------------------------------------- * * InitResolvedLocals -- * * This routine is invoked in order to initialize the compiled locals * table for a new call frame. * * Results: * None. * * Side effects: * May invoke various name resolvers in order to determine which * variables are being referenced at runtime. * *---------------------------------------------------------------------- */ static void InitResolvedLocals( Tcl_Interp *interp, /* Current interpreter. */ ByteCode *codePtr, Var *varPtr, Namespace *nsPtr) /* Pointer to current namespace. */ { Interp *iPtr = (Interp *) interp; int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr); CompiledLocal *firstLocalPtr, *localPtr; int varNum; Tcl_ResolvedVarInfo *resVarInfo; /* * Find the localPtr corresponding to varPtr */ varNum = varPtr - iPtr->framePtr->compiledLocals; localPtr = iPtr->framePtr->procPtr->firstLocalPtr; while (varNum--) { localPtr = localPtr->nextPtr; } if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) { goto doInitResolvedLocals; } /* * This is the first run after a recompile, or else the resolver epoch * has changed: update the resolver cache. */ firstLocalPtr = localPtr; for (; localPtr != NULL; localPtr = localPtr->nextPtr) { if (localPtr->resolveInfo) { if (localPtr->resolveInfo->deleteProc) { localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); } else { ckfree(localPtr->resolveInfo); } localPtr->resolveInfo = NULL; } localPtr->flags &= ~VAR_RESOLVED; if (haveResolvers && !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) { ResolverScheme *resPtr = iPtr->resolverPtr; Tcl_ResolvedVarInfo *vinfo; int result; if (nsPtr->compiledVarResProc) { result = nsPtr->compiledVarResProc(nsPtr->interp, localPtr->name, localPtr->nameLength, (Tcl_Namespace *) nsPtr, &vinfo); } else { result = TCL_CONTINUE; } while ((result == TCL_CONTINUE) && resPtr) { if (resPtr->compiledVarResProc) { result = resPtr->compiledVarResProc(nsPtr->interp, localPtr->name, localPtr->nameLength, (Tcl_Namespace *) nsPtr, &vinfo); } resPtr = resPtr->nextPtr; } if (result == TCL_OK) { localPtr->resolveInfo = vinfo; localPtr->flags |= VAR_RESOLVED; } } } localPtr = firstLocalPtr; codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS; /* * Initialize the array of local variables stored in the call frame. Some * variables may have special resolution rules. In that case, we call * their "resolver" procs to get our hands on the variable, and we make * the compiled local a link to the real variable. */ doInitResolvedLocals: for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { varPtr->flags = 0; varPtr->value.objPtr = NULL; /* * Now invoke the resolvers to determine the exact variables that * should be used. */ resVarInfo = localPtr->resolveInfo; if (resVarInfo && resVarInfo->fetchProc) { Var *resolvedVarPtr = (Var *) resVarInfo->fetchProc(interp, resVarInfo); if (resolvedVarPtr) { if (TclIsVarInHash(resolvedVarPtr)) { VarHashRefCount(resolvedVarPtr)++; } varPtr->flags = VAR_LINK; varPtr->value.linkPtr = resolvedVarPtr; } } } } void TclFreeLocalCache( Tcl_Interp *interp, LocalCache *localCachePtr) { int i; Tcl_Obj **namePtrPtr = &localCachePtr->varName0; for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) { Tcl_Obj *objPtr = *namePtrPtr; if (objPtr) { /* TclReleaseLiteral calls Tcl_DecrRefCount for us */ TclReleaseLiteral(interp, objPtr); } } ckfree(localCachePtr); } static void InitLocalCache( Proc *procPtr) { Interp *iPtr = procPtr->iPtr; ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; int localCt = procPtr->numCompiledLocals; int numArgs = procPtr->numArgs, i = 0; Tcl_Obj **namePtr; Var *varPtr; LocalCache *localCachePtr; CompiledLocal *localPtr; int isNew; /* * Cache the names and initial values of local variables; store the * cache in both the framePtr for this execution and in the codePtr * for future calls. */ localCachePtr = (LocalCache *)ckalloc(TclOffset(LocalCache, varName0) + localCt * sizeof(Tcl_Obj *) + numArgs * sizeof(Var)); namePtr = &localCachePtr->varName0; varPtr = (Var *) (namePtr + localCt); localPtr = procPtr->firstLocalPtr; while (localPtr) { if (TclIsVarTemporary(localPtr)) { *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, localPtr->nameLength, /* hash */ (unsigned int) -1, &isNew, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } if (i < numArgs) { varPtr->flags = (localPtr->flags & VAR_IS_ARGS); varPtr->value.objPtr = localPtr->defValuePtr; varPtr++; i++; } namePtr++; localPtr = localPtr->nextPtr; } codePtr->localCachePtr = localCachePtr; localCachePtr->refCount = 1; localCachePtr->numVars = localCt; } /* *---------------------------------------------------------------------- * * InitArgsAndLocals -- * * This routine is invoked in order to initialize the arguments and other * compiled locals table for a new call frame. * * Results: * A standard Tcl result. * * Side effects: * Allocates memory on the stack for the compiled local variables, the * caller is responsible for freeing them. Initialises all variables. May * invoke various name resolvers in order to determine which variables * are being referenced at runtime. * *---------------------------------------------------------------------- */ static int InitArgsAndLocals( Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; Proc *procPtr = framePtr->procPtr; ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; /* * Make sure that the local cache of variable names and initial values has * been initialised properly . */ if (localCt) { if (!codePtr->localCachePtr) { InitLocalCache(procPtr) ; } framePtr->localCachePtr = codePtr->localCachePtr; framePtr->localCachePtr->refCount++; defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); } else { defPtr = NULL; } /* * Create the "compiledLocals" array. Make sure it is large enough to hold * all the procedure's compiled local variables, including its formal * parameters. */ varPtr = (Var *)TclStackAlloc(interp, localCt * sizeof(Var)); framePtr->compiledLocals = varPtr; framePtr->numCompiledLocals = localCt; /* * Match and assign the call's actual parameters to the procedure's formal * arguments. The formal arguments are described by the first numArgs * entries in both the Proc structure's local variable list and the call * frame's local variable array. */ numArgs = procPtr->numArgs; argCt = framePtr->objc - skip; /* Set it to the number of args to the * procedure. */ if (numArgs == 0) { if (argCt) { goto incorrectArgs; } else { goto correctArgs; } } argObjs = framePtr->objv + skip; imax = ((argCt < numArgs-1) ? argCt : numArgs-1); for (i = 0; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) { /* * "Normal" arguments; last formal is special, depends on it being * 'args'. */ Tcl_Obj *objPtr = argObjs[i]; varPtr->flags = 0; varPtr->value.objPtr = objPtr; Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ } for (; i < numArgs-1; i++, varPtr++, defPtr ? defPtr++ : defPtr) { /* * This loop is entered if argCt < (numArgs-1). Set default values; * last formal is special. */ Tcl_Obj *objPtr = defPtr ? defPtr->value.objPtr : NULL; if (!objPtr) { goto incorrectArgs; } varPtr->flags = 0; varPtr->value.objPtr = objPtr; Tcl_IncrRefCount(objPtr); /* Local var reference. */ } /* * When we get here, the last formal argument remains to be defined: * defPtr and varPtr point to the last argument to be initialized. */ varPtr->flags = 0; if (defPtr && defPtr->flags & VAR_IS_ARGS) { Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i); varPtr->value.objPtr = listPtr; Tcl_IncrRefCount(listPtr); /* Local var is a reference. */ } else if (argCt == numArgs) { Tcl_Obj *objPtr = argObjs[i]; varPtr->value.objPtr = objPtr; Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ } else if ((argCt < numArgs) && defPtr && defPtr->value.objPtr) { Tcl_Obj *objPtr = defPtr->value.objPtr; varPtr->value.objPtr = objPtr; Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ } else { goto incorrectArgs; } varPtr++; /* * Initialise and resolve the remaining compiledLocals. In the absence of * resolvers, they are undefined local vars: (flags=0, value=NULL). */ correctArgs: if (numArgs < localCt) { if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) { memset(varPtr, 0, (localCt - numArgs)*sizeof(Var)); } else { InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr); } } return TCL_OK; /* * Initialise all compiled locals to avoid problems at DeleteLocalVars. */ incorrectArgs: if ((skip != 1) && TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) { TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } memset(varPtr, 0, ((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var)); return ProcWrongNumArgs(interp, skip); } /* *---------------------------------------------------------------------- * * TclPushProcCallFrame -- * * Compiles a proc body if necessary, then pushes a CallFrame suitable * for executing it. * * Results: * A standard Tcl object result value. * * Side effects: * The proc's body may be recompiled. A CallFrame is pushed, it will have * to be popped by the caller. * *---------------------------------------------------------------------- */ int TclPushProcCallFrame( ClientData clientData, /* Record describing procedure to be * interpreted. */ Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[], /* Argument value objects. */ int isLambda) /* 1 if this is a call by ApplyObjCmd: it * needs special rules for error msg */ { Proc *procPtr = (Proc *)clientData; Namespace *nsPtr = procPtr->cmdPtr->nsPtr; CallFrame *framePtr, **framePtrPtr; int result; ByteCode *codePtr; /* * If necessary (i.e. if we haven't got a suitable compilation already * cached) compile the procedure's body. The compiler will allocate frame * slots for the procedure's non-argument local variables. Note that * compiling the body might increase procPtr->numCompiledLocals if new * local variables are found while compiling. */ if (procPtr->bodyPtr->typePtr == &tclByteCodeType) { Interp *iPtr = (Interp *) interp; /* * When we've got bytecode, this is the check for validity. That is, * the bytecode must be for the right interpreter (no cross-leaks!), * the code must be from the current epoch (so subcommand compilation * is up-to-date), the namespace must match (so variable handling * is right) and the resolverEpoch must match (so that new shadowed * commands and/or resolver changes are considered). * Ensure the ByteCode's procPtr is the same (or it's precompiled). */ codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) || (codePtr->nsEpoch != nsPtr->resolverEpoch) || ((codePtr->procPtr != procPtr) && procPtr->bodyPtr->bytes) ) { goto doCompilation; } } else { doCompilation: result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr, (isLambda ? "body of lambda term" : "body of proc"), TclGetString(objv[isLambda])); if (result != TCL_OK) { return result; } } /* * Set up and push a new call frame for the new procedure invocation. * This call frame will execute in the proc's namespace, which might be * different than the current namespace. The proc's namespace is that of * its command, which can change if the command is renamed from one * namespace to another. */ framePtrPtr = &framePtr; (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, (Tcl_Namespace *) nsPtr, (isLambda? (FRAME_IS_PROC|FRAME_IS_LAMBDA) : FRAME_IS_PROC)); framePtr->objc = objc; framePtr->objv = objv; framePtr->procPtr = procPtr; return TCL_OK; } /* *---------------------------------------------------------------------- * * TclObjInterpProc -- * * When a Tcl procedure gets invoked during bytecode evaluation, this * object-based routine gets invoked to interpret the procedure. * * Results: * A standard Tcl object result value. * * Side effects: * Depends on the commands in the procedure. * *---------------------------------------------------------------------- */ int TclObjInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { /* * Not used much in the core; external interface for iTcl */ return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv); } int TclNRInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { int result = TclPushProcCallFrame(clientData, interp, objc, objv, /*isLambda*/ 0); if (result != TCL_OK) { return TCL_ERROR; } return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError); } /* *---------------------------------------------------------------------- * * TclNRInterpProcCore -- * * When a Tcl procedure, lambda term or anything else that works like a * procedure gets invoked during bytecode evaluation, this object-based * routine gets invoked to interpret the body. * * Results: * A standard Tcl object result value. * * Side effects: * Nearly anything; depends on the commands in the procedure body. * *---------------------------------------------------------------------- */ int TclNRInterpProcCore( Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ int skip, /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ ProcErrorProc *errorProc) /* How to convert results from the script into * results of the overall procedure. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr = iPtr->varFramePtr->procPtr; int result; CallFrame *freePtr; ByteCode *codePtr; result = InitArgsAndLocals(interp, procNameObj, skip); if (result != TCL_OK) { freePtr = iPtr->framePtr; Tcl_PopCallFrame(interp); /* Pop but do not free. */ TclStackFree(interp, freePtr->compiledLocals); /* Free compiledLocals. */ TclStackFree(interp, freePtr); /* Free CallFrame. */ return TCL_ERROR; } #if defined(TCL_COMPILE_DEBUG) if (tclTraceExec >= 1) { CallFrame *framePtr = iPtr->varFramePtr; int i; if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { fprintf(stdout, "Calling lambda "); } else { fprintf(stdout, "Calling proc "); } for (i = 0; i < framePtr->objc; i++) { TclPrintObject(stdout, framePtr->objv[i], 15); fprintf(stdout, " "); } fprintf(stdout, "\n"); fflush(stdout); } #endif /*TCL_COMPILE_DEBUG*/ #ifdef USE_DTRACE if (TCL_DTRACE_PROC_ARGS_ENABLED()) { int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; const char *a[10]; int i; for (i = 0 ; i < 10 ; i++) { a[i] = (l < iPtr->varFramePtr->objc ? TclGetString(iPtr->varFramePtr->objv[l]) : NULL); l++; } TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]); } if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) { Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); const char *a[6]; int i[2]; TclDTraceInfo(info, a, i); TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); TclDecrRefCount(info); } if (TCL_DTRACE_PROC_ENTRY_ENABLED()) { int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ? TclGetString(iPtr->varFramePtr->objv[l]) : NULL, iPtr->varFramePtr->objc - l - 1, (Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1)); } if (TCL_DTRACE_PROC_ENTRY_ENABLED()) { int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ? TclGetString(iPtr->varFramePtr->objv[l]) : NULL, iPtr->varFramePtr->objc - l - 1, (Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1)); } #endif /* USE_DTRACE */ /* * Invoke the commands in the procedure's body. */ procPtr->refCount++; codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc, NULL, NULL); return TclNRExecuteByteCode(interp, codePtr); } static int InterpProcNR2( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Proc *procPtr = iPtr->varFramePtr->procPtr; CallFrame *freePtr; Tcl_Obj *procNameObj = (Tcl_Obj *)data[0]; ProcErrorProc *errorProc = (ProcErrorProc *)data[1]; if (TCL_DTRACE_PROC_RETURN_ENABLED()) { int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ? TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result); } if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); } /* * Free the stack-allocated compiled locals and CallFrame. It is important * to pop the call frame without freeing it first: the compiledLocals * cannot be freed before the frame is popped, as the local variables must * be deleted. But the compiledLocals must be freed first, as they were * allocated later on the stack. */ if (result != TCL_OK) { goto process; } done: if (TCL_DTRACE_PROC_RESULT_ENABLED()) { int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; Tcl_Obj *r = Tcl_GetObjResult(interp); TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ? TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result, TclGetString(r), r); } freePtr = iPtr->framePtr; Tcl_PopCallFrame(interp); /* Pop but do not free. */ TclStackFree(interp, freePtr->compiledLocals); /* Free compiledLocals. */ TclStackFree(interp, freePtr); /* Free CallFrame. */ return result; /* * Process any non-TCL_OK result code. */ process: switch (result) { case TCL_RETURN: /* * If it is a 'return', do the TIP#90 processing now. */ result = TclUpdateReturnInfo((Interp *) interp); break; case TCL_CONTINUE: case TCL_BREAK: /* * It's an error to get to this point from a 'break' or 'continue', so * transform to an error now. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invoked \"%s\" outside of a loop", ((result == TCL_BREAK) ? "break" : "continue"))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL); result = TCL_ERROR; /* FALLTHRU */ case TCL_ERROR: /* * Now it _must_ be an error, so we need to log it as such. This means * filling out the error trace. Luckily, we just hand this off to the * function handed to us as an argument. */ errorProc(interp, procNameObj); } goto done; } /* *---------------------------------------------------------------------- * * TclProcCompileProc -- * * Called just before a procedure is executed to compile the body to byte * codes. If the type of the body is not "byte code" or if the compile * conditions have changed (namespace context, epoch counters, etc.) then * the body is recompiled. Otherwise, this function does nothing. * * Results: * None. * * Side effects: * May change the internal representation of the body object to compiled * code. * *---------------------------------------------------------------------- */ int TclProcCompileProc( Tcl_Interp *interp, /* Interpreter containing procedure. */ Proc *procPtr, /* Data associated with procedure. */ Tcl_Obj *bodyPtr, /* Body of proc. (Usually procPtr->bodyPtr, * but could be any code fragment compiled in * the context of this procedure.) */ Namespace *nsPtr, /* Namespace containing procedure. */ const char *description, /* string describing this body of code. */ const char *procName) /* Name of this procedure. */ { Interp *iPtr = (Interp *) interp; Tcl_CallFrame *framePtr; ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1; /* * If necessary, compile the procedure's body. The compiler will allocate * frame slots for the procedure's non-argument local variables. If the * ByteCode already exists, make sure it hasn't been invalidated by * someone redefining a core command (this might make the compiled code * wrong). Also, if the code was compiled in/for a different interpreter, * we recompile it. Note that compiling the body might increase * procPtr->numCompiledLocals if new local variables are found while * compiling. * * Ensure the ByteCode's procPtr is the same (or it is pure precompiled). * Precompiled procedure bodies, however, are immutable and therefore they * are not recompiled, even if things have changed. */ if (bodyPtr->typePtr == &tclByteCodeType) { if (((Interp *) *codePtr->interpHandle == iPtr) && (codePtr->compileEpoch == iPtr->compileEpoch) && (codePtr->nsPtr == nsPtr) && (codePtr->nsEpoch == nsPtr->resolverEpoch) && ((codePtr->procPtr == procPtr) || !bodyPtr->bytes) ) { return TCL_OK; } if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { if ((Interp *) *codePtr->interpHandle != iPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "a precompiled script jumped interps", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "CROSSINTERPBYTECODE", NULL); return TCL_ERROR; } codePtr->compileEpoch = iPtr->compileEpoch; codePtr->nsPtr = nsPtr; } else { TclFreeIntRep(bodyPtr); } } if (bodyPtr->typePtr != &tclByteCodeType) { Tcl_HashEntry *hePtr; #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 1) { /* * Display a line summarizing the top level command we are about * to compile. */ Tcl_Obj *message; TclNewLiteralStringObj(message, "Compiling "); Tcl_IncrRefCount(message); Tcl_AppendStringsToObj(message, description, " \"", NULL); Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL); fprintf(stdout, "%s\"\n", TclGetString(message)); Tcl_DecrRefCount(message); } #endif /* * Plug the current procPtr into the interpreter and coerce the code * body to byte codes. The interpreter needs to know which proc it's * compiling so that it can access its list of compiled locals. * * TRICKY NOTE: Be careful to push a call frame with the proper * namespace context, so that the byte codes are compiled in the * appropriate class context. */ iPtr->compiledProcPtr = procPtr; if (procPtr->numCompiledLocals > procPtr->numArgs) { CompiledLocal *clPtr = procPtr->firstLocalPtr; CompiledLocal *lastPtr = NULL; int i, numArgs = procPtr->numArgs; for (i = 0; i < numArgs; i++) { lastPtr = clPtr; clPtr = clPtr->nextPtr; } if (lastPtr) { lastPtr->nextPtr = NULL; } else { procPtr->firstLocalPtr = NULL; } procPtr->lastLocalPtr = lastPtr; while (clPtr) { CompiledLocal *toFree = clPtr; clPtr = clPtr->nextPtr; if (toFree->resolveInfo) { if (toFree->resolveInfo->deleteProc) { toFree->resolveInfo->deleteProc(toFree->resolveInfo); } else { ckfree(toFree->resolveInfo); } } ckfree(toFree); } procPtr->numCompiledLocals = procPtr->numArgs; } (void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0); /* * TIP #280: We get the invoking context from the cmdFrame which * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr). */ hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr); /* * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd. */ iPtr->invokeWord = 0; iPtr->invokeCmdFramePtr = hePtr ? (CmdFrame *)Tcl_GetHashValue(hePtr) : NULL; TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL); iPtr->invokeCmdFramePtr = NULL; TclPopStackFrame(interp); } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) { /* * The resolver epoch has changed, but we only need to invalidate the * resolver cache. */ codePtr->nsEpoch = nsPtr->resolverEpoch; codePtr->flags |= TCL_BYTECODE_RESOLVE_VARS; } return TCL_OK; } /* *---------------------------------------------------------------------- * * MakeProcError -- * * Function called by TclObjInterpProc to create the stack information * upon an error from a procedure. * * Results: * The interpreter's error info trace is set to a value that supplements * the error code. * * Side effects: * none. * *---------------------------------------------------------------------- */ static void MakeProcError( Tcl_Interp *interp, /* The interpreter in which the procedure was * called. */ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { int overflow, limit = 60, nameLen; const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (procedure \"%.*s%s\" line %d)", (overflow ? limit : nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* *---------------------------------------------------------------------- * * TclProcDeleteProc -- * * This function is invoked just before a command procedure is removed * from an interpreter. Its job is to release all the resources allocated * to the procedure. * * Results: * None. * * Side effects: * Memory gets freed, unless the procedure is actively being executed. * In this case the cleanup is delayed until the last call to the current * procedure completes. * *---------------------------------------------------------------------- */ void TclProcDeleteProc( ClientData clientData) /* Procedure to be deleted. */ { Proc *procPtr = (Proc *)clientData; if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); } } /* *---------------------------------------------------------------------- * * TclProcCleanupProc -- * * This function does all the real work of freeing up a Proc structure. * It's called only when the structure's reference count becomes zero. * * Results: * None. * * Side effects: * Memory gets freed. * *---------------------------------------------------------------------- */ void TclProcCleanupProc( Proc *procPtr) /* Procedure to be deleted. */ { CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; Tcl_HashEntry *hePtr = NULL; CmdFrame *cfPtr = NULL; Interp *iPtr = procPtr->iPtr; if (bodyPtr != NULL) { /* procPtr is stored in body's ByteCode, so ensure to reset it. */ if (bodyPtr->typePtr == &tclByteCodeType) { ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1; if (codePtr->procPtr == procPtr) { codePtr->procPtr = NULL; } } Tcl_DecrRefCount(bodyPtr); } for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; ) { CompiledLocal *nextPtr = localPtr->nextPtr; resVarInfo = localPtr->resolveInfo; if (resVarInfo) { if (resVarInfo->deleteProc) { resVarInfo->deleteProc(resVarInfo); } else { ckfree(resVarInfo); } } if (localPtr->defValuePtr != NULL) { defPtr = localPtr->defValuePtr; Tcl_DecrRefCount(defPtr); } ckfree(localPtr); localPtr = nextPtr; } ckfree(procPtr); /* * TIP #280: Release the location data associated with this Proc * structure, if any. The interpreter may not exist (For example for * procbody structures created by tbcload. */ if (iPtr == NULL) { return; } hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr); if (!hePtr) { return; } cfPtr = (CmdFrame *)Tcl_GetHashValue(hePtr); if (cfPtr) { if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); cfPtr->data.eval.path = NULL; } ckfree(cfPtr->line); cfPtr->line = NULL; ckfree(cfPtr); } Tcl_DeleteHashEntry(hePtr); } /* *---------------------------------------------------------------------- * * TclUpdateReturnInfo -- * * This function is called when procedures return, and at other points * where the TCL_RETURN code is used. It examines the returnLevel and * returnCode to determine the real return status. * * Results: * The return value is the true completion code to use for the procedure * or script, instead of TCL_RETURN. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclUpdateReturnInfo( Interp *iPtr) /* Interpreter for which TCL_RETURN exception * is being processed. */ { int code = TCL_RETURN; iPtr->returnLevel--; if (iPtr->returnLevel < 0) { Tcl_Panic("TclUpdateReturnInfo: negative return level"); } if (iPtr->returnLevel == 0) { /* * Now we've reached the level to return the requested -code. * Since iPtr->returnLevel and iPtr->returnCode have completed * their task, we now reset them to default values so that any * bare "return TCL_RETURN" that may follow will work [Bug 2152286]. */ code = iPtr->returnCode; iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; if (code == TCL_ERROR) { iPtr->flags |= ERR_LEGACY_COPY; } } return code; } /* *---------------------------------------------------------------------- * * TclGetObjInterpProc -- * * Returns a pointer to the TclObjInterpProc function; this is different * from the value obtained from the TclObjInterpProc reference on systems * like Windows where import and export versions of a function exported * by a DLL exist. * * Results: * Returns the internal address of the TclObjInterpProc function. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_ObjCmdProc * TclGetObjInterpProc(void) { return TclObjInterpProc; } /* *---------------------------------------------------------------------- * * TclNewProcBodyObj -- * * Creates a new object, of type "procbody", whose internal * representation is the given Proc struct. The newly created object's * reference count is 0. * * Results: * Returns a pointer to a newly allocated Tcl_Obj, NULL on error. * * Side effects: * The reference count in the ByteCode attached to the Proc is bumped up * by one, since the internal rep stores a pointer to it. * *---------------------------------------------------------------------- */ Tcl_Obj * TclNewProcBodyObj( Proc *procPtr) /* the Proc struct to store as the internal * representation. */ { Tcl_Obj *objPtr; if (!procPtr) { return NULL; } TclNewObj(objPtr); if (objPtr) { objPtr->typePtr = &tclProcBodyType; objPtr->internalRep.twoPtrValue.ptr1 = procPtr; procPtr->refCount++; } return objPtr; } /* *---------------------------------------------------------------------- * * ProcBodyDup -- * * Tcl_ObjType's Dup function for the proc body object. Bumps the * reference count on the Proc stored in the internal representation. * * Results: * None. * * Side effects: * Sets up the object in dupPtr to be a duplicate of the one in srcPtr. * *---------------------------------------------------------------------- */ static void ProcBodyDup( Tcl_Obj *srcPtr, /* Object to copy. */ Tcl_Obj *dupPtr) /* Target object for the duplication. */ { Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1; dupPtr->typePtr = &tclProcBodyType; dupPtr->internalRep.twoPtrValue.ptr1 = procPtr; procPtr->refCount++; } /* *---------------------------------------------------------------------- * * ProcBodyFree -- * * Tcl_ObjType's Free function for the proc body object. The reference * count on its Proc struct is decreased by 1; if the count reaches 0, * the proc is freed. * * Results: * None. * * Side effects: * If the reference count on the Proc struct reaches 0, the struct is * freed. * *---------------------------------------------------------------------- */ static void ProcBodyFree( Tcl_Obj *objPtr) /* The object to clean up. */ { Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); } } /* *---------------------------------------------------------------------- * * DupLambdaInternalRep, FreeLambdaInternalRep, SetLambdaFromAny -- * * How to manage the internal representations of lambda term objects. * Syntactically they look like a two- or three-element list, where the * first element is the formal arguments, the second is the the body, and * the (optional) third is the namespace to execute the lambda term * within (the global namespace is assumed if it is absent). * *---------------------------------------------------------------------- */ static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1; Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2; copyPtr->internalRep.twoPtrValue.ptr1 = procPtr; copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr; procPtr->refCount++; Tcl_IncrRefCount(nsObjPtr); copyPtr->typePtr = &tclLambdaType; } static void FreeLambdaInternalRep( Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2; if (procPtr->refCount-- == 1) { TclProcCleanupProc(procPtr); } TclDecrRefCount(nsObjPtr); objPtr->typePtr = NULL; } static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; int isNew, objc, result; CmdFrame *cfPtr = NULL; Proc *procPtr; if (interp == NULL) { return TCL_ERROR; } /* * Convert objPtr to list type first; if it cannot be converted, or if its * length is not 2, then it cannot be converted to tclLambdaType. */ result = TclListObjGetElements(NULL, objPtr, &objc, &objv); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL); return TCL_ERROR; } argsPtr = objv[0]; bodyPtr = objv[1]; /* * Create and initialize the Proc struct. The cmdPtr field is set to NULL * to signal that this is an anonymous function. */ name = TclGetString(objPtr); if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr, bodyPtr, &procPtr) != TCL_OK) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing lambda expression \"%s\")", name)); return TCL_ERROR; } /* * CAREFUL: TclCreateProc returns refCount==1! [Bug 1578454] * procPtr->refCount = 1; */ procPtr->cmdPtr = NULL; /* * TIP #280: Remember the line the apply body is starting on. In a Byte * code context we ask the engine to provide us with the necessary * information. This is for the initialization of the byte code compiler * when the body is used for the first time. * * NOTE: The body is the second word in the 'objPtr'. Its location, * accessible through 'context.line[1]' (see below) is therefore only the * first approximation of the actual line the body is on. We have to use * the string rep of the 'objPtr' to determine the exact line. This is * available already through 'name'. Use 'TclListLines', see 'switch' * (tclCmdMZ.c). * * This code is nearly identical to the #280 code in Tcl_ProcObjCmd, see * this file. The differences are the different index of the body in the * line array of the context, and the special processing mentioned in the * previous paragraph to track into the list. Find a way to factor the * common elements into a single function. */ if (iPtr->cmdFramePtr) { CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *contextPtr = *iPtr->cmdFramePtr; if (contextPtr->type == TCL_LOCATION_BC) { /* * Retrieve the source context from the bytecode. This call * accounts for the reference to the source file, if any, held in * 'context.data.eval.path'. */ TclGetSrcInfoForPc(contextPtr); } else if (contextPtr->type == TCL_LOCATION_SOURCE) { /* * We created a new reference to the source file path name when we * created 'context' above. Account for the reference. */ Tcl_IncrRefCount(contextPtr->data.eval.path); } if (contextPtr->type == TCL_LOCATION_SOURCE) { /* * We can record source location within a lambda only if the body * was not created by substitution. */ if (contextPtr->line && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) { int buf[2]; /* * Move from approximation (line of list cmd word) to actual * location (line of 2nd list element). */ cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; cfPtr->type = contextPtr->type; cfPtr->line = (int *)ckalloc(sizeof(int)); cfPtr->line[0] = buf[1]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = contextPtr->data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); cfPtr->cmd = NULL; cfPtr->len = 0; } /* * 'contextPtr' is going out of scope. Release the reference that * it's holding to the source file path */ Tcl_DecrRefCount(contextPtr->data.eval.path); } TclStackFree(interp, contextPtr); } Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr, &isNew), cfPtr); /* * Set the namespace for this lambda: given by objv[2] understood as a * global reference, or else global per default. */ if (objc == 2) { TclNewLiteralStringObj(nsObjPtr, "::"); } else { const char *nsName = TclGetString(objv[2]); if ((*nsName != ':') || (*(nsName+1) != ':')) { TclNewLiteralStringObj(nsObjPtr, "::"); Tcl_AppendObjToObj(nsObjPtr, objv[2]); } else { nsObjPtr = objv[2]; } } Tcl_IncrRefCount(nsObjPtr); /* * Free the list internalrep of objPtr - this will free argsPtr, but * bodyPtr retains a reference from the Proc structure. Then finish the * conversion to tclLambdaType. */ TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = procPtr; objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr; objPtr->typePtr = &tclLambdaType; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ApplyObjCmd -- * * This object-based function is invoked to process the "apply" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * Depends on the content of the lambda term (i.e., objv[1]). * *---------------------------------------------------------------------- */ int Tcl_ApplyObjCmd( ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, clientData, objc, objv); } int TclNRApplyObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr = NULL; Tcl_Obj *lambdaPtr, *nsObjPtr; int result; Tcl_Namespace *nsPtr; ApplyExtraData *extraPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg ...?"); return TCL_ERROR; } /* * Set lambdaPtr, convert it to tclLambdaType in the current interp if * necessary. */ lambdaPtr = objv[1]; if (lambdaPtr->typePtr == &tclLambdaType) { procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1; } if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) { result = SetLambdaFromAny(interp, lambdaPtr); if (result != TCL_OK) { return result; } procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1; } /* * Find the namespace where this lambda should run, and push a call frame * for that namespace. Note that TclObjInterpProc() will pop it. */ nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2; result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); if (result != TCL_OK) { return TCL_ERROR; } extraPtr = (ApplyExtraData *)TclStackAlloc(interp, sizeof(ApplyExtraData)); memset(&extraPtr->cmd, 0, sizeof(Command)); procPtr->cmdPtr = &extraPtr->cmd; extraPtr->cmd.nsPtr = (Namespace *) nsPtr; /* * TIP#280 (semi-)HACK! * * Using cmd.clientData to tell [info frame] how to render the lambdaPtr. * The InfoFrameCmd will detect this case by testing cmd.hPtr for NULL. * This condition holds here because of the memset() above, and nowhere * else (in the core). Regular commands always have a valid hPtr, and * lambda's never. */ extraPtr->efi.length = 1; extraPtr->efi.fields[0].name = "lambda"; extraPtr->efi.fields[0].proc = NULL; extraPtr->efi.fields[0].clientData = lambdaPtr; extraPtr->cmd.clientData = &extraPtr->efi; result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1); if (result == TCL_OK) { TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL); result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError); } return result; } static int ApplyNR2( ClientData data[], Tcl_Interp *interp, int result) { ApplyExtraData *extraPtr = (ApplyExtraData *)data[0]; TclStackFree(interp, extraPtr); return result; } /* *---------------------------------------------------------------------- * * MakeLambdaError -- * * Function called by TclObjInterpProc to create the stack information * upon an error from a lambda term. * * Results: * The interpreter's error info trace is set to a value that supplements * the error code. * * Side effects: * none. * *---------------------------------------------------------------------- */ static void MakeLambdaError( Tcl_Interp *interp, /* The interpreter in which the procedure was * called. */ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { int overflow, limit = 60, nameLen; const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (lambda term \"%.*s%s\" line %d)", (overflow ? limit : nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* *---------------------------------------------------------------------- * * TclGetCmdFrameForProcedure -- * * How to get the CmdFrame information for a procedure. * * Results: * A pointer to the CmdFrame (only guaranteed to be valid until the next * Tcl command is processed or the interpreter's state is otherwise * modified) or a NULL if the information is not available. * * Side effects: * none. * *---------------------------------------------------------------------- */ CmdFrame * TclGetCmdFrameForProcedure( Proc *procPtr) /* The procedure whose cmd-frame is to be * looked up. */ { Tcl_HashEntry *hePtr; if (procPtr == NULL || procPtr->iPtr == NULL) { return NULL; } hePtr = Tcl_FindHashEntry(procPtr->iPtr->linePBodyPtr, procPtr); if (hePtr == NULL) { return NULL; } return (CmdFrame *) Tcl_GetHashValue(hePtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclRegexp.c0000644000175000017500000007561714554262142015377 0ustar sergeisergei/* * tclRegexp.c -- * * This file contains the public interfaces to the Tcl regular expression * mechanism. * * Copyright (c) 1998 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclRegexp.h" /* *---------------------------------------------------------------------- * The routines in this file use Henry Spencer's regular expression package * contained in the following additional source files: * * regc_color.c regc_cvec.c regc_lex.c * regc_nfa.c regcomp.c regcustom.h * rege_dfa.c regerror.c regerrs.h * regex.h regexec.c regfree.c * regfronts.c regguts.h * * Copyright (c) 1998 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without * modification -- are permitted for any purpose, provided that * redistributions in source form retain this entire copyright notice and * indicate the origin and nature of any modifications. * * I'd appreciate being given credit for this package in the documentation of * software which uses it, but that is not a requirement. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * *** NOTE: this code has been altered slightly for use in Tcl: *** * *** 1. Names have been changed, e.g. from re_comp to *** * *** TclRegComp, to avoid clashes with other *** * *** regexp implementations used by applications. *** */ /* * Thread local storage used to maintain a per-thread cache of compiled * regular expressions. */ #define NUM_REGEXPS 30 typedef struct { int initialized; /* Set to 1 when the module is initialized. */ char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular * expression patterns. NULL means that this * slot isn't used. Malloc-ed. */ int patLengths[NUM_REGEXPS];/* Number of non-null characters in * corresponding entry in patterns. -1 means * entry isn't used. */ struct TclRegexp *regexps[NUM_REGEXPS]; /* Compiled forms of above strings. Also * malloc-ed, or NULL if not in use yet. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Declarations for functions used only in this file. */ static TclRegexp * CompileRegexp(Tcl_Interp *interp, const char *pattern, int length, int flags); static void DupRegexpInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FinalizeRegexp(ClientData clientData); static void FreeRegexp(TclRegexp *regexpPtr); static void FreeRegexpInternalRep(Tcl_Obj *objPtr); static int RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re, const Tcl_UniChar *uniString, int numChars, int nmatches, int flags); static int SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); /* * The regular expression Tcl object type. This serves as a cache of the * compiled form of the regular expression. */ const Tcl_ObjType tclRegexpType = { "regexp", /* name */ FreeRegexpInternalRep, /* freeIntRepProc */ DupRegexpInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetRegexpFromAny /* setFromAnyProc */ }; /* *---------------------------------------------------------------------- * * Tcl_RegExpCompile -- * * Compile a regular expression into a form suitable for fast matching. * This function is DEPRECATED in favor of the object version of the * command. * * Results: * The return value is a pointer to the compiled form of string, suitable * for passing to Tcl_RegExpExec. This compiled form is only valid up * until the next call to this function, so don't keep these around for a * long time! If an error occurred while compiling the pattern, then NULL * is returned and an error message is left in the interp's result. * * Side effects: * Updates the cache of compiled regexps. * *---------------------------------------------------------------------- */ Tcl_RegExp Tcl_RegExpCompile( Tcl_Interp *interp, /* For use in error reporting and to access * the interp regexp cache. */ const char *pattern) /* String for which to produce compiled * regular expression. */ { return (Tcl_RegExp) CompileRegexp(interp, pattern, (int) strlen(pattern), REG_ADVANCED); } /* *---------------------------------------------------------------------- * * Tcl_RegExpExec -- * * Execute the regular expression matcher using a compiled form of a * regular expression and save information about any match that is found. * * Results: * If an error occurs during the matching operation then -1 is returned * and the interp's result contains an error message. Otherwise the * return value is 1 if a matching range is found and 0 if there is no * matching range. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_RegExpExec( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tcl_RegExp re, /* Compiled regular expression; must have been * returned by previous call to * Tcl_GetRegExpFromObj. */ const char *text, /* Text against which to match re. */ const char *start) /* If text is part of a larger string, this * identifies beginning of larger string, so * that "^" won't match. */ { int flags, result, numChars; TclRegexp *regexp = (TclRegexp *) re; Tcl_DString ds; const Tcl_UniChar *ustr; /* * If the starting point is offset from the beginning of the buffer, then * we need to tell the regexp engine not to match "^". */ if (text > start) { flags = REG_NOTBOL; } else { flags = 0; } /* * Remember the string for use by Tcl_RegExpRange(). */ regexp->string = text; regexp->objPtr = NULL; /* * Convert the string to Unicode and perform the match. */ Tcl_DStringInit(&ds); ustr = Tcl_UtfToUniCharDString(text, -1, &ds); numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar); result = RegExpExecUniChar(interp, re, ustr, numChars, -1 /* nmatches */, flags); Tcl_DStringFree(&ds); return result; } /* *--------------------------------------------------------------------------- * * Tcl_RegExpRange -- * * Returns pointers describing the range of a regular expression match, * or one of the subranges within the match. * * Results: * The variables at *startPtr and *endPtr are modified to hold the * addresses of the endpoints of the range given by index. If the * specified range doesn't exist then NULLs are returned. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void Tcl_RegExpRange( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ int index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching * subrange. */ const char **startPtr, /* Store address of first character in * (sub-)range here. */ const char **endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; const char *string; if ((size_t) index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; } else if (regexpPtr->matches[index].rm_so == -1) { *startPtr = *endPtr = NULL; } else { if (regexpPtr->objPtr) { string = TclGetString(regexpPtr->objPtr); } else { string = regexpPtr->string; } *startPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_so); *endPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_eo); } } /* *--------------------------------------------------------------------------- * * RegExpExecUniChar -- * * Execute the regular expression matcher using a compiled form of a * regular expression and save information about any match that is found. * * Results: * If an error occurs during the matching operation then -1 is returned * and an error message is left in interp's result. Otherwise the return * value is 1 if a matching range was found or 0 if there was no matching * range. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int RegExpExecUniChar( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tcl_RegExp re, /* Compiled regular expression; returned by a * previous call to Tcl_GetRegExpFromObj */ const Tcl_UniChar *wString, /* String against which to match re. */ int numChars, /* Length of Tcl_UniChar string (must be * >=0). */ int nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means "don't know". */ int flags) /* Regular expression flags. */ { int status; TclRegexp *regexpPtr = (TclRegexp *) re; size_t last = regexpPtr->re.re_nsub + 1; size_t nm = last; if (nmatches >= 0 && (size_t) nmatches < nm) { nm = (size_t) nmatches; } status = TclReExec(®expPtr->re, wString, (size_t) numChars, ®expPtr->details, nm, regexpPtr->matches, flags); /* * Check for errors. */ if (status != REG_OKAY) { if (status == REG_NOMATCH) { return 0; } if (interp != NULL) { TclRegError(interp, "error while matching regular expression: ", status); } return -1; } return 1; } /* *--------------------------------------------------------------------------- * * TclRegExpRangeUniChar -- * * Returns pointers describing the range of a regular expression match, * or one of the subranges within the match, or the hypothetical range * represented by the rm_extend field of the rm_detail_t. * * Results: * The variables at *startPtr and *endPtr are modified to hold the * offsets of the endpoints of the range given by index. If the specified * range doesn't exist then -1s are supplied. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclRegExpRangeUniChar( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ int index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching * subrange, -1 means the range of the * rm_extend field. */ int *startPtr, /* Store address of first character in * (sub-)range here. */ int *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; if ((regexpPtr->flags®_EXPECT) && (index == -1)) { *startPtr = regexpPtr->details.rm_extend.rm_so; *endPtr = regexpPtr->details.rm_extend.rm_eo; } else if ((size_t) index > regexpPtr->re.re_nsub) { *startPtr = -1; *endPtr = -1; } else { *startPtr = regexpPtr->matches[index].rm_so; *endPtr = regexpPtr->matches[index].rm_eo; } } /* *---------------------------------------------------------------------- * * Tcl_RegExpMatch -- * * See if a string matches a regular expression. * * Results: * If an error occurs during the matching operation then -1 is returned * and the interp's result contains an error message. Otherwise the * return value is 1 if "text" matches "pattern" and 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_RegExpMatch( Tcl_Interp *interp, /* Used for error reporting. May be NULL. */ const char *text, /* Text to search for pattern matches. */ const char *pattern) /* Regular expression to match against text. */ { Tcl_RegExp re = Tcl_RegExpCompile(interp, pattern); if (re == NULL) { return -1; } return Tcl_RegExpExec(interp, re, text, text); } /* *---------------------------------------------------------------------- * * Tcl_RegExpExecObj -- * * Execute a precompiled regexp against the given object. * * Results: * If an error occurs during the matching operation then -1 is returned * and the interp's result contains an error message. Otherwise the * return value is 1 if "string" matches "pattern" and 0 otherwise. * * Side effects: * Converts the object to a Unicode object. * *---------------------------------------------------------------------- */ int Tcl_RegExpExecObj( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tcl_RegExp re, /* Compiled regular expression; must have been * returned by previous call to * Tcl_GetRegExpFromObj. */ Tcl_Obj *textObj, /* Text against which to match re. */ int offset, /* Character index that marks where matching * should begin. */ int nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means all of them. */ int flags) /* Regular expression execution flags. */ { TclRegexp *regexpPtr = (TclRegexp *) re; Tcl_UniChar *udata; int length; int reflags = regexpPtr->flags; #define TCL_REG_GLOBOK_FLAGS \ (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE) /* * Take advantage of the equivalent glob pattern, if one exists. * This is possible based only on the right mix of incoming flags (0) * and regexp compile flags. */ if ((offset == 0) && (nmatches == 0) && (flags == 0) && !(reflags & ~TCL_REG_GLOBOK_FLAGS) && (regexpPtr->globObjPtr != NULL)) { int nocase = (reflags & TCL_REG_NOCASE) ? TCL_MATCH_NOCASE : 0; /* * Pass to TclStringMatchObj for obj-specific handling. * XXX: Currently doesn't take advantage of exact-ness that * XXX: TclReToGlob tells us about */ return TclStringMatchObj(textObj, regexpPtr->globObjPtr, nocase); } /* * Save the target object so we can extract strings from it later. */ regexpPtr->string = NULL; regexpPtr->objPtr = textObj; udata = Tcl_GetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; } udata += offset; length -= offset; return RegExpExecUniChar(interp, re, udata, length, nmatches, flags); } /* *---------------------------------------------------------------------- * * Tcl_RegExpMatchObj -- * * See if an object matches a regular expression. * * Results: * If an error occurs during the matching operation then -1 is returned * and the interp's result contains an error message. Otherwise the * return value is 1 if "text" matches "pattern" and 0 otherwise. * * Side effects: * Changes the internal rep of the pattern and string objects. * *---------------------------------------------------------------------- */ int Tcl_RegExpMatchObj( Tcl_Interp *interp, /* Used for error reporting. May be NULL. */ Tcl_Obj *textObj, /* Object containing the String to search. */ Tcl_Obj *patternObj) /* Regular expression to match against * string. */ { Tcl_RegExp re; /* * For performance reasons, first try compiling the RE without support for * subexpressions. On failure, try again without TCL_REG_NOSUB in case the * RE has backreferences in it. Closely related to [Bug 1366683]. If this * still fails, an error message will be left in the interpreter. */ if (!(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED | TCL_REG_NOSUB)) && !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) { return -1; } return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */, 0 /* nmatches */, 0 /* flags */); } /* *---------------------------------------------------------------------- * * Tcl_RegExpGetInfo -- * * Retrieve information about the current match. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_RegExpGetInfo( Tcl_RegExp regexp, /* Pattern from which to get subexpressions. */ Tcl_RegExpInfo *infoPtr) /* Match information is stored here. */ { TclRegexp *regexpPtr = (TclRegexp *) regexp; infoPtr->nsubs = regexpPtr->re.re_nsub; infoPtr->matches = (Tcl_RegExpIndices *) regexpPtr->matches; infoPtr->extendStart = regexpPtr->details.rm_extend.rm_so; } /* *---------------------------------------------------------------------- * * Tcl_GetRegExpFromObj -- * * Compile a regular expression into a form suitable for fast matching. * This function caches the result in a Tcl_Obj. * * Results: * The return value is a pointer to the compiled form of string, suitable * for passing to Tcl_RegExpExec. If an error occurred while compiling * the pattern, then NULL is returned and an error message is left in the * interp's result. * * Side effects: * Updates the native rep of the Tcl_Obj. * *---------------------------------------------------------------------- */ Tcl_RegExp Tcl_GetRegExpFromObj( Tcl_Interp *interp, /* For use in error reporting, and to access * the interp regexp cache. */ Tcl_Obj *objPtr, /* Object whose string rep contains regular * expression pattern. Internal rep will be * changed to compiled form of this regular * expression. */ int flags) /* Regular expression compilation flags. */ { int length; TclRegexp *regexpPtr; const char *pattern; /* * This is OK because we only actually interpret this value properly as a * TclRegexp* when the type is tclRegexpType. */ regexpPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) { pattern = TclGetStringFromObj(objPtr, &length); regexpPtr = CompileRegexp(interp, pattern, length, flags); if (regexpPtr == NULL) { return NULL; } /* * Add a reference to the regexp so it will persist even if it is * pushed out of the current thread's regexp cache. This reference * will be removed when the object's internal rep is freed. */ regexpPtr->refCount++; /* * Free the old representation and set our type. */ TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr; objPtr->typePtr = &tclRegexpType; } return (Tcl_RegExp) regexpPtr; } /* *---------------------------------------------------------------------- * * TclRegAbout -- * * Return information about a compiled regular expression. * * Results: * The return value is -1 for failure, 0 for success, although at the * moment there's nothing that could fail. On success, a list is left in * the interp's result: first element is the subexpression count, second * is a list of re_info bit names. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclRegAbout( Tcl_Interp *interp, /* For use in variable assignment. */ Tcl_RegExp re) /* The compiled regular expression. */ { TclRegexp *regexpPtr = (TclRegexp *) re; struct infoname { int bit; const char *text; }; static const struct infoname infonames[] = { {REG_UBACKREF, "REG_UBACKREF"}, {REG_ULOOKAHEAD, "REG_ULOOKAHEAD"}, {REG_UBOUNDS, "REG_UBOUNDS"}, {REG_UBRACES, "REG_UBRACES"}, {REG_UBSALNUM, "REG_UBSALNUM"}, {REG_UPBOTCH, "REG_UPBOTCH"}, {REG_UBBS, "REG_UBBS"}, {REG_UNONPOSIX, "REG_UNONPOSIX"}, {REG_UUNSPEC, "REG_UUNSPEC"}, {REG_UUNPORT, "REG_UUNPORT"}, {REG_ULOCALE, "REG_ULOCALE"}, {REG_UEMPTYMATCH, "REG_UEMPTYMATCH"}, {REG_UIMPOSSIBLE, "REG_UIMPOSSIBLE"}, {REG_USHORTEST, "REG_USHORTEST"}, {0, NULL} }; const struct infoname *inf; Tcl_Obj *infoObj, *resultObj; /* * The reset here guarantees that the interpreter result is empty and * unshared. This means that we can use Tcl_ListObjAppendElement on the * result object quite safely. */ Tcl_ResetResult(interp); /* * Assume that there will never be more than INT_MAX subexpressions. This * is a pretty reasonable assumption; the RE engine doesn't scale _that_ * well and Tcl has other limits that constrain things as well... */ TclNewObj(resultObj); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewIntObj((int) regexpPtr->re.re_nsub)); /* * Now append a list of all the bit-flags set for the RE. */ TclNewObj(infoObj); for (inf=infonames ; inf->bit != 0 ; inf++) { if (regexpPtr->re.re_info & inf->bit) { Tcl_ListObjAppendElement(NULL, infoObj, Tcl_NewStringObj(inf->text, -1)); } } Tcl_ListObjAppendElement(NULL, resultObj, infoObj); Tcl_SetObjResult(interp, resultObj); return 0; } /* *---------------------------------------------------------------------- * * TclRegError -- * * Generate an error message based on the regexp status code. * * Results: * Places an error in the interpreter. * * Side effects: * Sets errorCode as well. * *---------------------------------------------------------------------- */ void TclRegError( Tcl_Interp *interp, /* Interpreter for error reporting. */ const char *msg, /* Message to prepend to error. */ int status) /* Status code to report. */ { char buf[100]; /* ample in practice */ char cbuf[TCL_INTEGER_SPACE]; size_t n; const char *p; Tcl_ResetResult(interp); n = TclReError(status, buf, sizeof(buf)); p = (n > sizeof(buf)) ? "..." : ""; Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p)); snprintf(cbuf, sizeof(cbuf), "%d", status); (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf)); Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL); } /* *---------------------------------------------------------------------- * * FreeRegexpInternalRep -- * * Deallocate the storage associated with a regexp object's internal * representation. * * Results: * None. * * Side effects: * Frees the compiled regular expression. * *---------------------------------------------------------------------- */ static void FreeRegexpInternalRep( Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */ { TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * If this is the last reference to the regexp, free it. */ if (regexpRepPtr->refCount-- <= 1) { FreeRegexp(regexpRepPtr); } objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * DupRegexpInternalRep -- * * We copy the reference to the compiled regexp and bump its reference * count. * * Results: * None. * * Side effects: * Increments the reference count of the regexp. * *---------------------------------------------------------------------- */ static void DupRegexpInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1; regexpPtr->refCount++; copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->typePtr = &tclRegexpType; } /* *---------------------------------------------------------------------- * * SetRegexpFromAny -- * * Attempt to generate a compiled regular expression for the Tcl object * "objPtr". * * Results: * The return value is TCL_OK or TCL_ERROR. If an error occurs during * conversion, an error message is left in the interpreter's result * unless "interp" is NULL. * * Side effects: * If no error occurs, a regular expression is stored as "objPtr"s * internal representation. * *---------------------------------------------------------------------- */ static int SetRegexpFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) { return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * CompileRegexp -- * * Attempt to compile the given regexp pattern. If the compiled regular * expression can be found in the per-thread cache, it will be used * instead of compiling a new copy. * * Results: * The return value is a pointer to a newly allocated TclRegexp that * represents the compiled pattern, or NULL if the pattern could not be * compiled. If NULL is returned, an error message is left in the * interp's result. * * Side effects: * The thread-local regexp cache is updated and a new TclRegexp may be * allocated. * *---------------------------------------------------------------------- */ static TclRegexp * CompileRegexp( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ const char *string, /* The regexp to compile (UTF-8). */ int length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; const Tcl_UniChar *uniString; int numChars, status, i, exact; Tcl_DString stringBuf; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->initialized) { tsdPtr->initialized = 1; Tcl_CreateThreadExitHandler(FinalizeRegexp, NULL); } /* * This routine maintains a second-level regular expression cache in * addition to the per-object regexp cache. The per-thread cache is needed * to handle the case where for various reasons the object is lost between * invocations of the regexp command, but the literal pattern is the same. */ /* * Check the per-thread compiled regexp cache. We can only reuse a regexp * if it has the same pattern and the same flags. */ for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) { if ((length == tsdPtr->patLengths[i]) && (tsdPtr->regexps[i]->flags == flags) && (strcmp(string, tsdPtr->patterns[i]) == 0)) { /* * Move the matched pattern to the first slot in the cache and * shift the other patterns down one position. */ if (i != 0) { int j; char *cachedString; cachedString = tsdPtr->patterns[i]; regexpPtr = tsdPtr->regexps[i]; for (j = i-1; j >= 0; j--) { tsdPtr->patterns[j+1] = tsdPtr->patterns[j]; tsdPtr->patLengths[j+1] = tsdPtr->patLengths[j]; tsdPtr->regexps[j+1] = tsdPtr->regexps[j]; } tsdPtr->patterns[0] = cachedString; tsdPtr->patLengths[0] = length; tsdPtr->regexps[0] = regexpPtr; } return tsdPtr->regexps[0]; } } /* * This is a new expression, so compile it and add it to the cache. */ regexpPtr = (TclRegexp*)ckalloc(sizeof(TclRegexp)); regexpPtr->objPtr = NULL; regexpPtr->string = NULL; regexpPtr->details.rm_extend.rm_so = -1; regexpPtr->details.rm_extend.rm_eo = -1; /* * Get the up-to-date string representation and map to unicode. */ Tcl_DStringInit(&stringBuf); uniString = Tcl_UtfToUniCharDString(string, length, &stringBuf); numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar); /* * Compile the string and check for errors. */ regexpPtr->flags = flags; status = TclReComp(®expPtr->re, uniString, (size_t) numChars, flags); Tcl_DStringFree(&stringBuf); if (status != REG_OKAY) { /* * Clean up and report errors in the interpreter, if possible. */ ckfree(regexpPtr); if (interp) { TclRegError(interp, "couldn't compile regular expression pattern: ", status); } return NULL; } /* * Convert RE to a glob pattern equivalent, if any, and cache it. If this * is not possible, then globObjPtr will be NULL. This is used by * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine). */ if (TclReToGlob(NULL, string, length, &stringBuf, &exact, NULL) == TCL_OK) { regexpPtr->globObjPtr = TclDStringToObj(&stringBuf); Tcl_IncrRefCount(regexpPtr->globObjPtr); } else { regexpPtr->globObjPtr = NULL; } /* * Allocate enough space for all of the subexpressions, plus one extra for * the entire pattern. */ regexpPtr->matches = (regmatch_t*)ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1)); /* * Initialize the refcount to one initially, since it is in the cache. */ regexpPtr->refCount = 1; /* * Free the last regexp, if necessary, and make room at the head of the * list for the new regexp. */ if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) { TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1]; if (oldRegexpPtr->refCount-- <= 1) { FreeRegexp(oldRegexpPtr); } ckfree(tsdPtr->patterns[NUM_REGEXPS-1]); } for (i = NUM_REGEXPS - 2; i >= 0; i--) { tsdPtr->patterns[i+1] = tsdPtr->patterns[i]; tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i]; tsdPtr->regexps[i+1] = tsdPtr->regexps[i]; } tsdPtr->patterns[0] = (char *)ckalloc(length + 1); memcpy(tsdPtr->patterns[0], string, length + 1); tsdPtr->patLengths[0] = length; tsdPtr->regexps[0] = regexpPtr; return regexpPtr; } /* *---------------------------------------------------------------------- * * FreeRegexp -- * * Release the storage associated with a TclRegexp. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void FreeRegexp( TclRegexp *regexpPtr) /* Compiled regular expression to free. */ { TclReFree(®expPtr->re); if (regexpPtr->globObjPtr) { TclDecrRefCount(regexpPtr->globObjPtr); } if (regexpPtr->matches) { ckfree(regexpPtr->matches); } ckfree(regexpPtr); } /* *---------------------------------------------------------------------- * * FinalizeRegexp -- * * Release the storage associated with the per-thread regexp cache. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void FinalizeRegexp( ClientData clientData) /* Not used. */ { int i; TclRegexp *regexpPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) { regexpPtr = tsdPtr->regexps[i]; if (regexpPtr->refCount-- <= 1) { FreeRegexp(regexpPtr); } ckfree(tsdPtr->patterns[i]); tsdPtr->patterns[i] = NULL; } /* * We may find ourselves reinitialized if another finalization routine * invokes regexps. */ tsdPtr->initialized = 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclRegexp.h0000644000175000017500000000320414554262142015363 0ustar sergeisergei/* * tclRegexp.h -- * * This file contains definitions used internally by Henry Spencer's * regular expression code. * * Copyright (c) 1998 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLREGEXP #define _TCLREGEXP #include "regex.h" /* * The TclRegexp structure encapsulates a compiled regex_t, the flags that * were used to compile it, and an array of pointers that are used to indicate * subexpressions after a call to Tcl_RegExpExec. Note that the string and * objPtr are mutually exclusive. These values are needed by Tcl_RegExpRange * in order to return pointers into the original string. */ typedef struct TclRegexp { int flags; /* Regexp compile flags. */ regex_t re; /* Compiled re, includes number of * subexpressions. */ const char *string; /* Last string passed to Tcl_RegExpExec. */ Tcl_Obj *objPtr; /* Last object passed to Tcl_RegExpExecObj. */ Tcl_Obj *globObjPtr; /* Glob pattern rep of RE or NULL if none. */ regmatch_t *matches; /* Array of indices into the Tcl_UniChar * representation of the last string matched * with this regexp to indicate the location * of subexpressions. */ rm_detail_t details; /* Detailed information on match (currently * used only for REG_EXPECT). */ int refCount; /* Count of number of references to this * compiled regexp. */ } TclRegexp; #endif /* _TCLREGEXP */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclResolve.c0000644000175000017500000003247014554262142015552 0ustar sergeisergei/* * tclResolve.c -- * * Contains hooks for customized command/variable name resolution * schemes. These hooks allow extensions like [incr Tcl] to add their own * name resolution rules to the Tcl language. Rules can be applied to a * particular namespace, to the interpreter as a whole, or both. * * Copyright (c) 1998 Lucent Technologies, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Declarations for functions local to this file: */ static void BumpCmdRefEpochs(Namespace *nsPtr); /* *---------------------------------------------------------------------- * * Tcl_AddInterpResolvers -- * * Adds a set of command/variable resolution functions to an interpreter. * These functions are consulted when commands are resolved in * Tcl_FindCommand, and when variables are resolved in TclLookupVar and * LookupCompiledLocal. Each namespace may also have its own set of * resolution functions which take precedence over those for the * interpreter. * * When a name is resolved, it is handled as follows. First, the name is * passed to the resolution functions for the namespace. If not resolved, * the name is passed to each of the resolution functions added to the * interpreter. Finally, if still not resolved, the name is handled using * the default Tcl rules for name resolution. * * Results: * Returns pointers to the current name resolution functions in the * cmdProcPtr, varProcPtr and compiledVarProcPtr arguments. * * Side effects: * If a compiledVarProc is specified, this function bumps the * compileEpoch for the interpreter, forcing all code to be recompiled. * If a cmdProc is specified, this function bumps the cmdRefEpoch in all * namespaces, forcing commands to be resolved again using the new rules. * *---------------------------------------------------------------------- */ void Tcl_AddInterpResolvers( Tcl_Interp *interp, /* Interpreter whose name resolution rules are * being modified. */ const char *name, /* Name of this resolution scheme. */ Tcl_ResolveCmdProc *cmdProc,/* New function for command resolution. */ Tcl_ResolveVarProc *varProc,/* Function for variable resolution at * runtime. */ Tcl_ResolveCompiledVarProc *compiledVarProc) /* Function for variable resolution at compile * time. */ { Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; unsigned len; /* * Since we're adding a new name resolution scheme, we must force all code * to be recompiled to use the new scheme. If there are new compiled * variable resolution rules, bump the compiler epoch to invalidate * compiled code. If there are new command resolution rules, bump the * cmdRefEpoch in all namespaces. */ if (compiledVarProc) { iPtr->compileEpoch++; } if (cmdProc) { BumpCmdRefEpochs(iPtr->globalNsPtr); } /* * Look for an existing scheme with the given name. If found, then replace * its rules. */ for (resPtr=iPtr->resolverPtr ; resPtr!=NULL ; resPtr=resPtr->nextPtr) { if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { resPtr->cmdResProc = cmdProc; resPtr->varResProc = varProc; resPtr->compiledVarResProc = compiledVarProc; return; } } /* * Otherwise, this is a new scheme. Add it to the FRONT of the linked * list, so that it overrides existing schemes. */ resPtr = ckalloc(sizeof(ResolverScheme)); len = strlen(name) + 1; resPtr->name = ckalloc(len); memcpy(resPtr->name, name, len); resPtr->cmdResProc = cmdProc; resPtr->varResProc = varProc; resPtr->compiledVarResProc = compiledVarProc; resPtr->nextPtr = iPtr->resolverPtr; iPtr->resolverPtr = resPtr; } /* *---------------------------------------------------------------------- * * Tcl_GetInterpResolvers -- * * Looks for a set of command/variable resolution functions with the * given name in an interpreter. These functions are registered by * calling Tcl_AddInterpResolvers. * * Results: * If the name is recognized, this function returns non-zero, along with * pointers to the name resolution functions in the Tcl_ResolverInfo * structure. If the name is not recognized, this function returns zero. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetInterpResolvers( Tcl_Interp *interp, /* Interpreter whose name resolution rules are * being queried. */ const char *name, /* Look for a scheme with this name. */ Tcl_ResolverInfo *resInfoPtr) /* Returns pointers to the functions, if * found */ { Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; /* * Look for an existing scheme with the given name. If found, then return * pointers to its functions. */ for (resPtr=iPtr->resolverPtr ; resPtr!=NULL ; resPtr=resPtr->nextPtr) { if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { resInfoPtr->cmdResProc = resPtr->cmdResProc; resInfoPtr->varResProc = resPtr->varResProc; resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc; return 1; } } return 0; } /* *---------------------------------------------------------------------- * * Tcl_RemoveInterpResolvers -- * * Removes a set of command/variable resolution functions previously * added by Tcl_AddInterpResolvers. The next time a command/variable name * is resolved, these functions won't be consulted. * * Results: * Returns non-zero if the name was recognized and the resolution scheme * was deleted. Returns zero otherwise. * * Side effects: * If a scheme with a compiledVarProc was deleted, this function bumps * the compileEpoch for the interpreter, forcing all code to be * recompiled. If a scheme with a cmdProc was deleted, this function * bumps the cmdRefEpoch in all namespaces, forcing commands to be * resolved again using the new rules. * *---------------------------------------------------------------------- */ int Tcl_RemoveInterpResolvers( Tcl_Interp *interp, /* Interpreter whose name resolution rules are * being modified. */ const char *name) /* Name of the scheme to be removed. */ { Interp *iPtr = (Interp *) interp; ResolverScheme **prevPtrPtr, *resPtr; /* * Look for an existing scheme with the given name. */ prevPtrPtr = &iPtr->resolverPtr; for (resPtr=iPtr->resolverPtr ; resPtr!=NULL ; resPtr=resPtr->nextPtr) { if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { break; } prevPtrPtr = &resPtr->nextPtr; } /* * If we found the scheme, delete it. */ if (resPtr) { /* * If we're deleting a scheme with compiled variable resolution rules, * bump the compiler epoch to invalidate compiled code. If we're * deleting a scheme with command resolution rules, bump the * cmdRefEpoch in all namespaces. */ if (resPtr->compiledVarResProc) { iPtr->compileEpoch++; } if (resPtr->cmdResProc) { BumpCmdRefEpochs(iPtr->globalNsPtr); } *prevPtrPtr = resPtr->nextPtr; ckfree(resPtr->name); ckfree(resPtr); return 1; } return 0; } /* *---------------------------------------------------------------------- * * BumpCmdRefEpochs -- * * This function is used to bump the cmdRefEpoch counters in the * specified namespace and all of its child namespaces. It is used * whenever name resolution schemes are added/removed from an * interpreter, to invalidate all command references. * * Results: * None. * * Side effects: * Bumps the cmdRefEpoch in the specified namespace and its children, * recursively. * *---------------------------------------------------------------------- */ static void BumpCmdRefEpochs( Namespace *nsPtr) /* Namespace being modified. */ { Tcl_HashEntry *entry; Tcl_HashSearch search; nsPtr->cmdRefEpoch++; #ifndef BREAK_NAMESPACE_COMPAT for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { Namespace *childNsPtr = Tcl_GetHashValue(entry); BumpCmdRefEpochs(childNsPtr); } #else if (nsPtr->childTablePtr != NULL) { for (entry = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { Namespace *childNsPtr = Tcl_GetHashValue(entry); BumpCmdRefEpochs(childNsPtr); } } #endif TclInvalidateNsPath(nsPtr); } /* *---------------------------------------------------------------------- * * Tcl_SetNamespaceResolvers -- * * Sets the command/variable resolution functions for a namespace, * thereby changing the way that command/variable names are interpreted. * This allows extension writers to support different name resolution * schemes, such as those for object-oriented packages. * * Command resolution is handled by a function of the following type: * * typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, * const char *name, Tcl_Namespace *context, * int flags, Tcl_Command *rPtr); * * Whenever a command is executed or Tcl_FindCommand is invoked within * the namespace, this function is called to resolve the command name. If * this function is able to resolve the name, it should return the status * code TCL_OK, along with the corresponding Tcl_Command in the rPtr * argument. Otherwise, the function can return TCL_CONTINUE, and the * command will be treated under the usual name resolution rules. Or, it * can return TCL_ERROR, and the command will be considered invalid. * * Variable resolution is handled by two functions. The first is called * whenever a variable needs to be resolved at compile time: * * typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp, * const char *name, Tcl_Namespace *context, * Tcl_ResolvedVarInfo *rPtr); * * If this function is able to resolve the name, it should return the * status code TCL_OK, along with variable resolution info in the rPtr * argument; this info will be used to set up compiled locals in the call * frame at runtime. The function may also return TCL_CONTINUE, and the * variable will be treated under the usual name resolution rules. Or, it * can return TCL_ERROR, and the variable will be considered invalid. * * Another function is used whenever a variable needs to be resolved at * runtime but it is not recognized as a compiled local. (For example, * the variable may be requested via Tcl_FindNamespaceVar.) This function * has the following type: * * typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, * const char *name, Tcl_Namespace *context, * int flags, Tcl_Var *rPtr); * * This function is quite similar to the compile-time version. It returns * the same status codes, but if variable resolution succeeds, this * function returns a Tcl_Var directly via the rPtr argument. * * Results: * Nothing. * * Side effects: * Bumps the command epoch counter for the namespace, invalidating all * command references in that namespace. Also bumps the resolver epoch * counter for the namespace, forcing all code in the namespace to be * recompiled. * *---------------------------------------------------------------------- */ void Tcl_SetNamespaceResolvers( Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being * modified. */ Tcl_ResolveCmdProc *cmdProc,/* Function for command resolution */ Tcl_ResolveVarProc *varProc,/* Function for variable resolution at * run-time */ Tcl_ResolveCompiledVarProc *compiledVarProc) /* Function for variable resolution at compile * time. */ { Namespace *nsPtr = (Namespace *) namespacePtr; /* * Plug in the new command resolver, and bump the epoch counters so that * all code will have to be recompiled and all commands will have to be * resolved again using the new policy. */ nsPtr->cmdResProc = cmdProc; nsPtr->varResProc = varProc; nsPtr->compiledVarResProc = compiledVarProc; nsPtr->cmdRefEpoch++; nsPtr->resolverEpoch++; TclInvalidateNsPath(nsPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetNamespaceResolvers -- * * Returns the current command/variable resolution functions for a * namespace. By default, these functions are NULL. New functions can be * installed by calling Tcl_SetNamespaceResolvers, to provide new name * resolution rules. * * Results: * Returns non-zero if any name resolution functions have been assigned * to this namespace; also returns pointers to the functions in the * Tcl_ResolverInfo structure. Returns zero otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetNamespaceResolvers( Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being * modified. */ Tcl_ResolverInfo *resInfoPtr) /* Returns: pointers for all name resolution * functions assigned to this namespace. */ { Namespace *nsPtr = (Namespace *) namespacePtr; resInfoPtr->cmdResProc = nsPtr->cmdResProc; resInfoPtr->varResProc = nsPtr->varResProc; resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc; if (nsPtr->cmdResProc != NULL || nsPtr->varResProc != NULL || nsPtr->compiledVarResProc != NULL) { return 1; } return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclResult.c0000644000175000017500000013230614554262142015410 0ustar sergeisergei/* * tclResult.c -- * * This file contains code to manage the interpreter result. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Indices of the standard return options dictionary keys. */ enum returnKeys { KEY_CODE, KEY_ERRORCODE, KEY_ERRORINFO, KEY_ERRORLINE, KEY_LEVEL, KEY_OPTIONS, KEY_ERRORSTACK, KEY_LAST }; /* * Function prototypes for local functions in this file: */ static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); static void SetupAppendBuffer(Interp *iPtr, int newSpace); /* * This structure is used to take a snapshot of the interpreter state in * Tcl_SaveInterpState. You can snapshot the state, execute a command, and * then back up to the result or the error that was previously in progress. */ typedef struct InterpState { int status; /* return code status */ int flags; /* Each remaining field saves the */ int returnLevel; /* corresponding field of the Interp */ int returnCode; /* struct. These fields taken together are */ Tcl_Obj *errorInfo; /* the "state" of the interp. */ Tcl_Obj *errorCode; Tcl_Obj *returnOpts; Tcl_Obj *objResult; Tcl_Obj *errorStack; int resetErrorStack; } InterpState; /* *---------------------------------------------------------------------- * * Tcl_SaveInterpState -- * * Fills a token with a snapshot of the current state of the interpreter. * The snapshot can be restored at any point by TclRestoreInterpState. * * The token returned must be eventally passed to one of the routines * TclRestoreInterpState or TclDiscardInterpState, or there will be a * memory leak. * * Results: * Returns a token representing the interp state. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_InterpState Tcl_SaveInterpState( Tcl_Interp *interp, /* Interpreter's state to be saved */ int status) /* status code for current operation */ { Interp *iPtr = (Interp *) interp; InterpState *statePtr = ckalloc(sizeof(InterpState)); statePtr->status = status; statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED; statePtr->returnLevel = iPtr->returnLevel; statePtr->returnCode = iPtr->returnCode; statePtr->errorInfo = iPtr->errorInfo; statePtr->errorStack = iPtr->errorStack; statePtr->resetErrorStack = iPtr->resetErrorStack; if (statePtr->errorInfo) { Tcl_IncrRefCount(statePtr->errorInfo); } statePtr->errorCode = iPtr->errorCode; if (statePtr->errorCode) { Tcl_IncrRefCount(statePtr->errorCode); } statePtr->returnOpts = iPtr->returnOpts; if (statePtr->returnOpts) { Tcl_IncrRefCount(statePtr->returnOpts); } if (statePtr->errorStack) { Tcl_IncrRefCount(statePtr->errorStack); } statePtr->objResult = Tcl_GetObjResult(interp); Tcl_IncrRefCount(statePtr->objResult); return (Tcl_InterpState) statePtr; } /* *---------------------------------------------------------------------- * * Tcl_RestoreInterpState -- * * Accepts an interp and a token previously returned by * Tcl_SaveInterpState. Restore the state of the interp to what it was at * the time of the Tcl_SaveInterpState call. * * Results: * Returns the status value originally passed in to Tcl_SaveInterpState. * * Side effects: * Restores the interp state and frees memory held by token. * *---------------------------------------------------------------------- */ int Tcl_RestoreInterpState( Tcl_Interp *interp, /* Interpreter's state to be restored. */ Tcl_InterpState state) /* Saved interpreter state. */ { Interp *iPtr = (Interp *) interp; InterpState *statePtr = (InterpState *) state; int status = statePtr->status; iPtr->flags &= ~ERR_ALREADY_LOGGED; iPtr->flags |= (statePtr->flags & ERR_ALREADY_LOGGED); iPtr->returnLevel = statePtr->returnLevel; iPtr->returnCode = statePtr->returnCode; iPtr->resetErrorStack = statePtr->resetErrorStack; if (iPtr->errorInfo) { Tcl_DecrRefCount(iPtr->errorInfo); } iPtr->errorInfo = statePtr->errorInfo; if (iPtr->errorInfo) { Tcl_IncrRefCount(iPtr->errorInfo); } if (iPtr->errorCode) { Tcl_DecrRefCount(iPtr->errorCode); } iPtr->errorCode = statePtr->errorCode; if (iPtr->errorCode) { Tcl_IncrRefCount(iPtr->errorCode); } if (iPtr->errorStack) { Tcl_DecrRefCount(iPtr->errorStack); } iPtr->errorStack = statePtr->errorStack; if (iPtr->errorStack) { Tcl_IncrRefCount(iPtr->errorStack); } if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } iPtr->returnOpts = statePtr->returnOpts; if (iPtr->returnOpts) { Tcl_IncrRefCount(iPtr->returnOpts); } Tcl_SetObjResult(interp, statePtr->objResult); Tcl_DiscardInterpState(state); return status; } /* *---------------------------------------------------------------------- * * Tcl_DiscardInterpState -- * * Accepts a token previously returned by Tcl_SaveInterpState. Frees the * memory it uses. * * Results: * None. * * Side effects: * Frees memory. * *---------------------------------------------------------------------- */ void Tcl_DiscardInterpState( Tcl_InterpState state) /* saved interpreter state */ { InterpState *statePtr = (InterpState *) state; if (statePtr->errorInfo) { Tcl_DecrRefCount(statePtr->errorInfo); } if (statePtr->errorCode) { Tcl_DecrRefCount(statePtr->errorCode); } if (statePtr->returnOpts) { Tcl_DecrRefCount(statePtr->returnOpts); } if (statePtr->errorStack) { Tcl_DecrRefCount(statePtr->errorStack); } Tcl_DecrRefCount(statePtr->objResult); ckfree(statePtr); } /* *---------------------------------------------------------------------- * * Tcl_SaveResult -- * * Takes a snapshot of the current result state of the interpreter. The * snapshot can be restored at any point by Tcl_RestoreResult. Note that * this routine does not preserve the errorCode, errorInfo, or flags * fields so it should not be used if an error is in progress. * * Once a snapshot is saved, it must be restored by calling * Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult. * * Results: * None. * * Side effects: * Resets the interpreter result. * *---------------------------------------------------------------------- */ #undef Tcl_SaveResult void Tcl_SaveResult( Tcl_Interp *interp, /* Interpreter to save. */ Tcl_SavedResult *statePtr) /* Pointer to state structure. */ { Interp *iPtr = (Interp *) interp; /* * Move the result object into the save state. Note that we don't need to * change its refcount because we're moving it, not adding a new * reference. Put an empty object into the interpreter. */ statePtr->objResultPtr = iPtr->objResultPtr; TclNewObj(iPtr->objResultPtr); Tcl_IncrRefCount(iPtr->objResultPtr); /* * Save the string result. */ statePtr->freeProc = iPtr->freeProc; if (iPtr->result == iPtr->resultSpace) { /* * Copy the static string data out of the interp buffer. */ statePtr->result = statePtr->resultSpace; strcpy(statePtr->result, iPtr->result); statePtr->appendResult = NULL; } else if (iPtr->result == iPtr->appendResult) { /* * Move the append buffer out of the interp. */ statePtr->appendResult = iPtr->appendResult; statePtr->appendAvl = iPtr->appendAvl; statePtr->appendUsed = iPtr->appendUsed; statePtr->result = statePtr->appendResult; iPtr->appendResult = NULL; iPtr->appendAvl = 0; iPtr->appendUsed = 0; } else { /* * Move the dynamic or static string out of the interpreter. */ statePtr->result = iPtr->result; statePtr->appendResult = NULL; } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; iPtr->freeProc = 0; } /* *---------------------------------------------------------------------- * * Tcl_RestoreResult -- * * Restores the state of the interpreter to a snapshot taken by * Tcl_SaveResult. After this call, the token for the interpreter state * is no longer valid. * * Results: * None. * * Side effects: * Restores the interpreter result. * *---------------------------------------------------------------------- */ #undef Tcl_RestoreResult void Tcl_RestoreResult( Tcl_Interp *interp, /* Interpreter being restored. */ Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { Interp *iPtr = (Interp *) interp; Tcl_ResetResult(interp); /* * Restore the string result. */ iPtr->freeProc = statePtr->freeProc; if (statePtr->result == statePtr->resultSpace) { /* * Copy the static string data into the interp buffer. */ iPtr->result = iPtr->resultSpace; strcpy(iPtr->result, statePtr->result); } else if (statePtr->result == statePtr->appendResult) { /* * Move the append buffer back into the interp. */ if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); } iPtr->appendResult = statePtr->appendResult; iPtr->appendAvl = statePtr->appendAvl; iPtr->appendUsed = statePtr->appendUsed; iPtr->result = iPtr->appendResult; } else { /* * Move the dynamic or static string back into the interpreter. */ iPtr->result = statePtr->result; } /* * Restore the object result. */ Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = statePtr->objResultPtr; } /* *---------------------------------------------------------------------- * * Tcl_DiscardResult -- * * Frees the memory associated with an interpreter snapshot taken by * Tcl_SaveResult. If the snapshot is not restored, this function must be * called to discard it, or the memory will be lost. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ #undef Tcl_DiscardResult void Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { TclDecrRefCount(statePtr->objResultPtr); if (statePtr->result == statePtr->appendResult) { ckfree(statePtr->appendResult); } else if (statePtr->freeProc == TCL_DYNAMIC) { ckfree(statePtr->result); } else if (statePtr->freeProc) { statePtr->freeProc(statePtr->result); } } /* *---------------------------------------------------------------------- * * Tcl_SetResult -- * * Arrange for "result" to be the Tcl return value. * * Results: * None. * * Side effects: * interp->result is left pointing either to "result" or to a copy of it. * Also, the object result is reset. * *---------------------------------------------------------------------- */ void Tcl_SetResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return value. */ char *result, /* Value to be returned. If NULL, the result * is set to an empty string. */ Tcl_FreeProc *freeProc) /* Gives information about the string: * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { Interp *iPtr = (Interp *) interp; Tcl_FreeProc *oldFreeProc = iPtr->freeProc; char *oldResult = iPtr->result; if (result == NULL) { iPtr->resultSpace[0] = 0; iPtr->result = iPtr->resultSpace; iPtr->freeProc = 0; } else if (freeProc == TCL_VOLATILE) { int length = strlen(result); if (length > TCL_RESULT_SIZE) { iPtr->result = ckalloc(length + 1); iPtr->freeProc = TCL_DYNAMIC; } else { iPtr->result = iPtr->resultSpace; iPtr->freeProc = 0; } memcpy(iPtr->result, result, length+1); } else { iPtr->result = (char *) result; iPtr->freeProc = freeProc; } /* * If the old result was dynamically-allocated, free it up. Do it here, * rather than at the beginning, in case the new result value was part of * the old result value. */ if (oldFreeProc != 0) { if (oldFreeProc == TCL_DYNAMIC) { ckfree(oldResult); } else { oldFreeProc(oldResult); } } /* * Reset the object result since we just set the string result. */ ResetObjResult(iPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetStringResult -- * * Returns an interpreter's result value as a string. * * Results: * The interpreter's result as a string. * * Side effects: * If the string result is empty, the object result is moved to the * string result, then the object result is reset. * *---------------------------------------------------------------------- */ const char * Tcl_GetStringResult( Tcl_Interp *interp)/* Interpreter whose result to return. */ { /* * If the string result is empty, move the object result to the string * result, then reset the object result. */ Interp *iPtr = (Interp *) interp; if (*(iPtr->result) == 0) { Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), TCL_VOLATILE); } return iPtr->result; } /* *---------------------------------------------------------------------- * * Tcl_SetObjResult -- * * Arrange for objPtr to be an interpreter's result value. * * Results: * None. * * Side effects: * interp->objResultPtr is left pointing to the object referenced by * objPtr. The object's reference count is incremented since there is now * a new reference to it. The reference count for any old objResultPtr * value is decremented. Also, the string result is reset. * *---------------------------------------------------------------------- */ void Tcl_SetObjResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return object value. */ Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj * result is made an empty string object. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldObjResult = iPtr->objResultPtr; iPtr->objResultPtr = objPtr; Tcl_IncrRefCount(objPtr); /* since interp result is a reference */ /* * We wait until the end to release the old object result, in case we are * setting the result to itself. */ TclDecrRefCount(oldObjResult); /* * Reset the string result since we just set the result object. */ if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; } /* *---------------------------------------------------------------------- * * Tcl_GetObjResult -- * * Returns an interpreter's result value as a Tcl object. The object's * reference count is not modified; the caller must do that if it needs * to hold on to a long-term reference to it. * * Results: * The interpreter's result as an object. * * Side effects: * If the interpreter has a non-empty string result, the result object is * either empty or stale because some function set interp->result * directly. If so, the string result is moved to the result object then * the string result is reset. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *objResultPtr; int length; /* * If the string result is non-empty, move the string result to the object * result, then reset the string result. */ if (iPtr->result[0] != 0) { ResetObjResult(iPtr); objResultPtr = iPtr->objResultPtr; length = strlen(iPtr->result); TclInitStringRep(objResultPtr, iPtr->result, length); if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace; iPtr->result[0] = 0; } return iPtr->objResultPtr; } /* *---------------------------------------------------------------------- * * Tcl_AppendResultVA -- * * Append a variable number of strings onto the interpreter's result. * * Results: * None. * * Side effects: * The result of the interpreter given by the first argument is extended * by the strings in the va_list (up to a terminating NULL argument). * * If the string result is non-empty, the object result forced to be a * duplicate of it first. There will be a string result afterwards. * *---------------------------------------------------------------------- */ void Tcl_AppendResultVA( Tcl_Interp *interp, /* Interpreter with which to associate the * return value. */ va_list argList) /* Variable argument list. */ { Tcl_Obj *objPtr = Tcl_GetObjResult(interp); if (Tcl_IsShared(objPtr)) { objPtr = Tcl_DuplicateObj(objPtr); } Tcl_AppendStringsToObjVA(objPtr, argList); Tcl_SetObjResult(interp, objPtr); /* * Strictly we should call Tcl_GetStringResult(interp) here to make sure * that interp->result is correct according to the old contract, but that * makes the performance of much code (e.g. in Tk) absolutely awful. So we * leave it out; code that really wants interp->result can just insert the * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion] */ #ifdef USE_INTERP_RESULT /* * Ensure that the interp->result is legal so old Tcl 7.* code still * works. There's still embarrasingly much of it about... */ (void) Tcl_GetStringResult(interp); #endif /* USE_INTERP_RESULT */ } /* *---------------------------------------------------------------------- * * Tcl_AppendResult -- * * Append a variable number of strings onto the interpreter's result. * * Results: * None. * * Side effects: * The result of the interpreter given by the first argument is extended * by the strings given by the second and following arguments (up to a * terminating NULL argument). * * If the string result is non-empty, the object result forced to be a * duplicate of it first. There will be a string result afterwards. * *---------------------------------------------------------------------- */ void Tcl_AppendResult( Tcl_Interp *interp, ...) { va_list argList; va_start(argList, interp); Tcl_AppendResultVA(interp, argList); va_end(argList); } /* *---------------------------------------------------------------------- * * Tcl_AppendElement -- * * Convert a string to a valid Tcl list element and append it to the * result (which is ostensibly a list). * * Results: * None. * * Side effects: * The result in the interpreter given by the first argument is extended * with a list element converted from string. A separator space is added * before the converted list element unless the current result is empty, * contains the single character "{", or ends in " {". * * If the string result is empty, the object result is moved to the * string result, then the object result is reset. * *---------------------------------------------------------------------- */ void Tcl_AppendElement( Tcl_Interp *interp, /* Interpreter whose result is to be * extended. */ const char *element) /* String to convert to list element and add * to result. */ { Interp *iPtr = (Interp *) interp; char *dst; int size; int flags; int quoteHash = 1; /* * If the string result is empty, move the object result to the string * result, then reset the object result. */ (void) Tcl_GetStringResult(interp); /* * See how much space is needed, and grow the append buffer if needed to * accommodate the list element. */ size = Tcl_ScanElement(element, &flags) + 1; if ((iPtr->result != iPtr->appendResult) || (iPtr->appendResult[iPtr->appendUsed] != 0) || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { SetupAppendBuffer(iPtr, size+iPtr->appendUsed); } /* * Convert the string into a list element and copy it to the buffer that's * forming, with a space separator if needed. */ dst = iPtr->appendResult + iPtr->appendUsed; if (TclNeedSpace(iPtr->appendResult, dst)) { iPtr->appendUsed++; *dst = ' '; dst++; /* * If we need a space to separate this element from preceding stuff, * then this element will not lead a list, and need not have it's * leading '#' quoted. */ quoteHash = 0; } else { while ((--dst >= iPtr->appendResult) && TclIsSpaceProcM(*dst)) { } quoteHash = !TclNeedSpace(iPtr->appendResult, dst+1); } dst = iPtr->appendResult + iPtr->appendUsed; if (!quoteHash) { flags |= TCL_DONT_QUOTE_HASH; } iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); } /* *---------------------------------------------------------------------- * * SetupAppendBuffer -- * * This function makes sure that there is an append buffer properly * initialized, if necessary, from the interpreter's result, and that it * has at least enough room to accommodate newSpace new bytes of * information. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void SetupAppendBuffer( Interp *iPtr, /* Interpreter whose result is being set up. */ int newSpace) /* Make sure that at least this many bytes of * new information may be added. */ { int totalSpace; /* * Make the append buffer larger, if that's necessary, then copy the * result into the append buffer and make the append buffer the official * Tcl result. */ if (iPtr->result != iPtr->appendResult) { /* * If an oversized buffer was used recently, then free it up so we go * back to a smaller buffer. This avoids tying up memory forever after * a large operation. */ if (iPtr->appendAvl > 500) { ckfree(iPtr->appendResult); iPtr->appendResult = NULL; iPtr->appendAvl = 0; } iPtr->appendUsed = strlen(iPtr->result); } else if (iPtr->result[iPtr->appendUsed] != 0) { /* * Most likely someone has modified a result created by * Tcl_AppendResult et al. so that it has a different size. Just * recompute the size. */ iPtr->appendUsed = strlen(iPtr->result); } totalSpace = newSpace + iPtr->appendUsed; if (totalSpace >= iPtr->appendAvl) { char *new; if (totalSpace < 100) { totalSpace = 200; } else { totalSpace *= 2; } new = ckalloc(totalSpace); strcpy(new, iPtr->result); if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); } iPtr->appendResult = new; iPtr->appendAvl = totalSpace; } else if (iPtr->result != iPtr->appendResult) { strcpy(iPtr->appendResult, iPtr->result); } Tcl_FreeResult((Tcl_Interp *) iPtr); iPtr->result = iPtr->appendResult; } /* *---------------------------------------------------------------------- * * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's * string result. It also resets the interpreter's result object. * Tcl_FreeResult is most commonly used when a function is about to * replace one result value with another. * * Results: * None. * * Side effects: * Frees the memory associated with interp's string result and sets * interp->freeProc to zero, but does not change interp->result or clear * error state. Resets interp's result object to an unshared empty * object. * *---------------------------------------------------------------------- */ void Tcl_FreeResult( Tcl_Interp *interp)/* Interpreter for which to free result. */ { Interp *iPtr = (Interp *) interp; if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); } iPtr->freeProc = 0; } ResetObjResult(iPtr); } /* *---------------------------------------------------------------------- * * Tcl_ResetResult -- * * This function resets both the interpreter's string and object results. * * Results: * None. * * Side effects: * It resets the result object to an unshared empty object. It then * restores the interpreter's string result area to its default * initialized state, freeing up any memory that may have been allocated. * It also clears any error information for the interpreter. * *---------------------------------------------------------------------- */ void Tcl_ResetResult( Tcl_Interp *interp)/* Interpreter for which to clear result. */ { Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, iPtr->errorCode, TCL_GLOBAL_ONLY); } Tcl_DecrRefCount(iPtr->errorCode); iPtr->errorCode = NULL; } if (iPtr->errorInfo) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo, TCL_GLOBAL_ONLY); } Tcl_DecrRefCount(iPtr->errorInfo); iPtr->errorInfo = NULL; } iPtr->resetErrorStack = 1; iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); iPtr->returnOpts = NULL; } iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_LEGACY_COPY); } /* *---------------------------------------------------------------------- * * ResetObjResult -- * * Function used to reset an interpreter's Tcl result object. * * Results: * None. * * Side effects: * Resets the interpreter's result object to an unshared empty string * object with ref count one. It does not clear any error information in * the interpreter. * *---------------------------------------------------------------------- */ static void ResetObjResult( Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { Tcl_Obj *objResultPtr = iPtr->objResultPtr; if (Tcl_IsShared(objResultPtr)) { TclDecrRefCount(objResultPtr); TclNewObj(objResultPtr); Tcl_IncrRefCount(objResultPtr); iPtr->objResultPtr = objResultPtr; } else { if (objResultPtr->bytes != tclEmptyStringRep) { if (objResultPtr->bytes) { ckfree(objResultPtr->bytes); } objResultPtr->bytes = tclEmptyStringRep; objResultPtr->length = 0; } TclFreeIntRep(objResultPtr); } } /* *---------------------------------------------------------------------- * * Tcl_SetErrorCodeVA -- * * This function is called to record machine-readable information about * an error that is about to be returned. * * Results: * None. * * Side effects: * The errorCode field of the interp is modified to hold all of the * arguments to this function, in a list form with each argument becoming * one element of the list. * *---------------------------------------------------------------------- */ void Tcl_SetErrorCodeVA( Tcl_Interp *interp, /* Interpreter in which to set errorCode */ va_list argList) /* Variable argument list. */ { Tcl_Obj *errorObj; /* * Scan through the arguments one at a time, appending them to the * errorCode field as list elements. */ TclNewObj(errorObj); while (1) { char *elem = va_arg(argList, char *); if (elem == NULL) { break; } Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1)); } Tcl_SetObjErrorCode(interp, errorObj); } /* *---------------------------------------------------------------------- * * Tcl_SetErrorCode -- * * This function is called to record machine-readable information about * an error that is about to be returned. * * Results: * None. * * Side effects: * The errorCode field of the interp is modified to hold all of the * arguments to this function, in a list form with each argument becoming * one element of the list. * *---------------------------------------------------------------------- */ void Tcl_SetErrorCode( Tcl_Interp *interp, ...) { va_list argList; /* * Scan through the arguments one at a time, appending them to the * errorCode field as list elements. */ va_start(argList, interp); Tcl_SetErrorCodeVA(interp, argList); va_end(argList); } /* *---------------------------------------------------------------------- * * Tcl_SetObjErrorCode -- * * This function is called to record machine-readable information about * an error that is about to be returned. The caller should build a list * object up and pass it to this routine. * * Results: * None. * * Side effects: * The errorCode field of the interp is set to the new value. * *---------------------------------------------------------------------- */ void Tcl_SetObjErrorCode( Tcl_Interp *interp, Tcl_Obj *errorObjPtr) { Interp *iPtr = (Interp *) interp; if (iPtr->errorCode) { Tcl_DecrRefCount(iPtr->errorCode); } iPtr->errorCode = errorObjPtr; Tcl_IncrRefCount(iPtr->errorCode); } /* *---------------------------------------------------------------------- * * Tcl_GetErrorLine -- * * Returns the line number associated with the current error. * *---------------------------------------------------------------------- */ #undef Tcl_GetErrorLine int Tcl_GetErrorLine( Tcl_Interp *interp) { return ((Interp *) interp)->errorLine; } /* *---------------------------------------------------------------------- * * Tcl_SetErrorLine -- * * Sets the line number associated with the current error. * *---------------------------------------------------------------------- */ #undef Tcl_SetErrorLine void Tcl_SetErrorLine( Tcl_Interp *interp, int value) { ((Interp *) interp)->errorLine = value; } /* *---------------------------------------------------------------------- * * GetKeys -- * * Returns a Tcl_Obj * array of the standard keys used in the return * options dictionary. * * Broadly sharing one copy of these key values helps with both memory * efficiency and dictionary lookup times. * * Results: * A Tcl_Obj * array. * * Side effects: * First time called in a thread, creates the keys (allocating memory) * and arranges for their cleanup at thread exit. * *---------------------------------------------------------------------- */ static Tcl_Obj ** GetKeys(void) { static Tcl_ThreadDataKey returnKeysKey; Tcl_Obj **keys = Tcl_GetThreadData(&returnKeysKey, (int) (KEY_LAST * sizeof(Tcl_Obj *))); if (keys[0] == NULL) { /* * First call in this thread, create the keys... */ int i; TclNewLiteralStringObj(keys[KEY_CODE], "-code"); TclNewLiteralStringObj(keys[KEY_ERRORCODE], "-errorcode"); TclNewLiteralStringObj(keys[KEY_ERRORINFO], "-errorinfo"); TclNewLiteralStringObj(keys[KEY_ERRORLINE], "-errorline"); TclNewLiteralStringObj(keys[KEY_ERRORSTACK],"-errorstack"); TclNewLiteralStringObj(keys[KEY_LEVEL], "-level"); TclNewLiteralStringObj(keys[KEY_OPTIONS], "-options"); for (i = KEY_CODE; i < KEY_LAST; i++) { Tcl_IncrRefCount(keys[i]); } /* * ... and arrange for their clenaup. */ Tcl_CreateThreadExitHandler(ReleaseKeys, keys); } return keys; } /* *---------------------------------------------------------------------- * * ReleaseKeys -- * * Called as a thread exit handler to cleanup return options dictionary * keys. * * Results: * None. * * Side effects: * Frees memory. * *---------------------------------------------------------------------- */ static void ReleaseKeys( ClientData clientData) { Tcl_Obj **keys = clientData; int i; for (i = KEY_CODE; i < KEY_LAST; i++) { Tcl_DecrRefCount(keys[i]); keys[i] = NULL; } } /* *---------------------------------------------------------------------- * * TclProcessReturn -- * * Does the work of the [return] command based on the code, level, and * returnOpts arguments. Note that the code argument must agree with the * -code entry in returnOpts and the level argument must agree with the * -level entry in returnOpts, as is the case for values returned from * TclMergeReturnOptions. * * Results: * Returns the return code the [return] command should return. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclProcessReturn( Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts) { Interp *iPtr = (Interp *) interp; Tcl_Obj *valuePtr; Tcl_Obj **keys = GetKeys(); /* * Store the merged return options. */ if (iPtr->returnOpts != returnOpts) { if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } iPtr->returnOpts = returnOpts; Tcl_IncrRefCount(iPtr->returnOpts); } if (code == TCL_ERROR) { if (iPtr->errorInfo) { Tcl_DecrRefCount(iPtr->errorInfo); iPtr->errorInfo = NULL; } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr); if (valuePtr != NULL) { int infoLen; (void) TclGetStringFromObj(valuePtr, &infoLen); if (infoLen) { iPtr->errorInfo = valuePtr; Tcl_IncrRefCount(iPtr->errorInfo); iPtr->flags |= ERR_ALREADY_LOGGED; } } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK], &valuePtr); if (valuePtr != NULL) { int len, valueObjc; Tcl_Obj **valueObjv; if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); iPtr->errorStack = newObj; } /* * List extraction done after duplication to avoid moving the rug * if someone does [return -errorstack [info errorstack]] */ if (TclListObjGetElements(interp, valuePtr, &valueObjc, &valueObjv) == TCL_ERROR) { return TCL_ERROR; } iPtr->resetErrorStack = 0; TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. */ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, valueObjv); } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], &valuePtr); if (valuePtr != NULL) { Tcl_SetObjErrorCode(interp, valuePtr); } else { Tcl_SetErrorCode(interp, "NONE", NULL); } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE], &valuePtr); if (valuePtr != NULL) { TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine); } } if (level != 0) { iPtr->returnLevel = level; iPtr->returnCode = code; return TCL_RETURN; } if (code == TCL_ERROR) { iPtr->flags |= ERR_LEGACY_COPY; } return code; } /* *---------------------------------------------------------------------- * * TclMergeReturnOptions -- * * Parses, checks, and stores the options to the [return] command. * * Results: * Returns TCL_ERROR if any of the option values are invalid. Otherwise, * returns TCL_OK, and writes the returnOpts, code, and level values to * the pointers provided. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclMergeReturnOptions( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ Tcl_Obj **optionsPtrPtr, /* If not NULL, points to space for a (Tcl_Obj * *) where the pointer to the merged return * options dictionary should be written. */ int *codePtr, /* If not NULL, points to space where the * -code value should be written. */ int *levelPtr) /* If not NULL, points to space where the * -level value should be written. */ { int code = TCL_OK; int level = 1; Tcl_Obj *valuePtr; Tcl_Obj *returnOpts; Tcl_Obj **keys = GetKeys(); TclNewObj(returnOpts); for (; objc > 1; objv += 2, objc -= 2) { int optLen; const char *opt = TclGetStringFromObj(objv[0], &optLen); int compareLen; const char *compare = TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen); if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) { Tcl_DictSearch search; int done = 0; Tcl_Obj *keyPtr; Tcl_Obj *dict = objv[1]; nestedOptions: if (TCL_ERROR == Tcl_DictObjFirst(NULL, dict, &search, &keyPtr, &valuePtr, &done)) { /* * Value is not a legal dictionary. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad %s value: expected dictionary but got \"%s\"", compare, TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL); goto error; } while (!done) { Tcl_DictObjPut(NULL, returnOpts, keyPtr, valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } Tcl_DictObjGet(NULL, returnOpts, keys[KEY_OPTIONS], &valuePtr); if (valuePtr != NULL) { dict = valuePtr; Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_OPTIONS]); goto nestedOptions; } } else { Tcl_DictObjPut(NULL, returnOpts, objv[0], objv[1]); } } /* * Check for bogus -code value. */ Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr); if (valuePtr != NULL) { if (TclGetCompletionCodeFromObj(interp, valuePtr, &code) == TCL_ERROR) { goto error; } Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]); } /* * Check for bogus -level value. */ Tcl_DictObjGet(NULL, returnOpts, keys[KEY_LEVEL], &valuePtr); if (valuePtr != NULL) { if ((TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &level)) || (level < 0)) { /* * Value is not a legal level. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad -level value: expected non-negative integer but got" " \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", NULL); goto error; } Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]); } /* * Check for bogus -errorcode value. */ Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr); if (valuePtr != NULL) { int length; if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) { /* * Value is not a list, which is illegal for -errorcode. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad -errorcode value: expected a list but got \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE", NULL); goto error; } } /* * Check for bogus -errorstack value. */ Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr); if (valuePtr != NULL) { int length; if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) { /* * Value is not a list, which is illegal for -errorstack. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad -errorstack value: expected a list but got \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", NULL); goto error; } if (length % 2) { /* * Errorstack must always be an even-sized list */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "forbidden odd-sized list for -errorstack: \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ODDSIZEDLIST_ERRORSTACK", NULL); goto error; } } /* * Convert [return -code return -level X] to [return -code ok -level X+1] */ if (code == TCL_RETURN) { level++; code = TCL_OK; } if (codePtr != NULL) { *codePtr = code; } if (levelPtr != NULL) { *levelPtr = level; } if (optionsPtrPtr == NULL) { /* * Not passing back the options (?!), so clean them up. */ Tcl_DecrRefCount(returnOpts); } else { *optionsPtrPtr = returnOpts; } return TCL_OK; error: Tcl_DecrRefCount(returnOpts); return TCL_ERROR; } /* *------------------------------------------------------------------------- * * Tcl_GetReturnOptions -- * * Packs up the interp state into a dictionary of return options. * * Results: * A dictionary of return options. * * Side effects: * None. * *------------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetReturnOptions( Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *options; Tcl_Obj **keys = GetKeys(); if (iPtr->returnOpts) { options = Tcl_DuplicateObj(iPtr->returnOpts); } else { TclNewObj(options); } if (result == TCL_RETURN) { Tcl_DictObjPut(NULL, options, keys[KEY_CODE], Tcl_NewIntObj(iPtr->returnCode)); Tcl_DictObjPut(NULL, options, keys[KEY_LEVEL], Tcl_NewIntObj(iPtr->returnLevel)); } else { Tcl_DictObjPut(NULL, options, keys[KEY_CODE], Tcl_NewIntObj(result)); Tcl_DictObjPut(NULL, options, keys[KEY_LEVEL], Tcl_NewIntObj(0)); } if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, ""); Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); } if (iPtr->errorCode) { Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode); } if (iPtr->errorInfo) { Tcl_DictObjPut(NULL, options, keys[KEY_ERRORINFO], iPtr->errorInfo); Tcl_DictObjPut(NULL, options, keys[KEY_ERRORLINE], Tcl_NewIntObj(iPtr->errorLine)); } return options; } /* *------------------------------------------------------------------------- * * TclNoErrorStack -- * * Removes the -errorstack entry from an options dict to avoid reference * cycles. * * Results: * The (unshared) argument options dict, modified in -place. * *------------------------------------------------------------------------- */ Tcl_Obj * TclNoErrorStack( Tcl_Interp *interp, Tcl_Obj *options) { Tcl_Obj **keys = GetKeys(); Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]); return options; } /* *------------------------------------------------------------------------- * * Tcl_SetReturnOptions -- * * Accepts an interp and a dictionary of return options, and sets the * return options of the interp to match the dictionary. * * Results: * A standard status code. Usually TCL_OK, but TCL_ERROR if an invalid * option value was found in the dictionary. If a -level value of 0 is in * the dictionary, then the -code value in the dictionary will be * returned (TCL_OK default). * * Side effects: * Sets the state of the interp. * *------------------------------------------------------------------------- */ int Tcl_SetReturnOptions( Tcl_Interp *interp, Tcl_Obj *options) { int objc, level, code; Tcl_Obj **objv, *mergedOpts; Tcl_IncrRefCount(options); if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected dict but got \"%s\"", TclGetString(options))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL); code = TCL_ERROR; } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv, &mergedOpts, &code, &level)) { code = TCL_ERROR; } else { code = TclProcessReturn(interp, code, level, mergedOpts); } Tcl_DecrRefCount(options); return code; } /* *------------------------------------------------------------------------- * * Tcl_TransferResult -- * * Transfer the result (and error information) from one interp to another. * Used when one interp has caused another interp to evaluate a script * and then wants to transfer the results back to itself. * * Results: * The result of targetInterp is set to the result read from sourceInterp. * The return options dictionary of sourceInterp is transferred to * targetInterp as appropriate for the return code value code. * * Side effects: * None. * *------------------------------------------------------------------------- */ void Tcl_TransferResult( Tcl_Interp *sourceInterp, /* Interp whose result and return options * should be moved to the target interp. * After moving result, this interp's result * is reset. */ int code, /* The return code value active in * sourceInterp. Controls how the return options * dictionary is retrieved from sourceInterp, * same as in Tcl_GetReturnOptions, to then be * transferred to targetInterp. */ Tcl_Interp *targetInterp) /* Interp where result and return options * should be stored. If source and target are * the same, nothing is done. */ { Interp *tiPtr = (Interp *) targetInterp; Interp *siPtr = (Interp *) sourceInterp; if (sourceInterp == targetInterp) { return; } if (code == TCL_OK && siPtr->returnOpts == NULL) { /* * Special optimization for the common case of normal command return * code and no explicit return options. */ if (tiPtr->returnOpts) { Tcl_DecrRefCount(tiPtr->returnOpts); tiPtr->returnOpts = NULL; } } else { Tcl_SetReturnOptions(targetInterp, Tcl_GetReturnOptions(sourceInterp, code)); tiPtr->flags &= ~(ERR_ALREADY_LOGGED); } Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp)); Tcl_ResetResult(sourceInterp); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/generic/tclScan.c0000644000175000017500000005711714554262142015024 0ustar sergeisergei/* * tclScan.c -- * * This file contains the implementation of the "scan" command. * * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Flag values used by Tcl_ScanObjCmd. */ #define SCAN_NOSKIP 0x1 /* Don't skip blanks. */ #define SCAN_SUPPRESS 0x2 /* Suppress assignment. */ #define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ #define SCAN_WIDTH 0x8 /* A width value was supplied. */ #define SCAN_LONGER 0x400 /* Asked for a wide value. */ #define SCAN_BIG 0x800 /* Asked for a bignum value. */ /* * The following structure contains the information associated with a * character set. */ typedef struct { Tcl_UniChar start; Tcl_UniChar end; } Range; typedef struct { int exclude; /* 1 if this is an exclusion set. */ int nchars; Tcl_UniChar *chars; int nranges; Range *ranges; } CharSet; /* * Declarations for functions used only in this file. */ static const char * BuildCharSet(CharSet *cset, const char *format); static int CharInSet(CharSet *cset, int ch); static void ReleaseCharSet(CharSet *cset); static int ValidateFormat(Tcl_Interp *interp, const char *format, int numVars, int *totalVars); /* *---------------------------------------------------------------------- * * BuildCharSet -- * * This function examines a character set format specification and builds * a CharSet containing the individual characters and character ranges * specified. * * Results: * Returns the next format position. * * Side effects: * Initializes the charset. * *---------------------------------------------------------------------- */ static const char * BuildCharSet( CharSet *cset, const char *format) /* Points to first char of set. */ { Tcl_UniChar ch = 0, start; int offset, nranges; const char *end; memset(cset, 0, sizeof(CharSet)); offset = TclUtfToUniChar(format, &ch); if (ch == '^') { cset->exclude = 1; format += offset; offset = TclUtfToUniChar(format, &ch); } end = format + offset; /* * Find the close bracket so we can overallocate the set. */ if (ch == ']') { end += TclUtfToUniChar(end, &ch); } nranges = 0; while (ch != ']') { if (ch == '-') { nranges++; } end += TclUtfToUniChar(end, &ch); } cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); if (nranges > 0) { cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges); } else { cset->ranges = NULL; } /* * Now build the character set. */ cset->nchars = cset->nranges = 0; format += TclUtfToUniChar(format, &ch); start = ch; if (ch == ']' || ch == '-') { cset->chars[cset->nchars++] = ch; format += TclUtfToUniChar(format, &ch); } while (ch != ']') { if (*format == '-') { /* * This may be the first character of a range, so don't add it * yet. */ start = ch; } else if (ch == '-') { /* * Check to see if this is the last character in the set, in which * case it is not a range and we should add the previous character * as well as the dash. */ if (*format == ']' || !cset->ranges) { cset->chars[cset->nchars++] = start; cset->chars[cset->nchars++] = ch; } else { format += TclUtfToUniChar(format, &ch); /* * Check to see if the range is in reverse order. */ if (start < ch) { cset->ranges[cset->nranges].start = start; cset->ranges[cset->nranges].end = ch; } else { cset->ranges[cset->nranges].start = ch; cset->ranges[cset->nranges].end = start; } cset->nranges++; } } else { cset->chars[cset->nchars++] = ch; } format += TclUtfToUniChar(format, &ch); } return format; } /* *---------------------------------------------------------------------- * * CharInSet -- * * Check to see if a character matches the given set. * * Results: * Returns non-zero if the character matches the given set. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CharInSet( CharSet *cset, int c) /* Character to test, passed as int because of * non-ANSI prototypes. */ { Tcl_UniChar ch = (Tcl_UniChar) c; int i, match = 0; for (i = 0; i < cset->nchars; i++) { if (cset->chars[i] == ch) { match = 1; break; } } if (!match) { for (i = 0; i < cset->nranges; i++) { if ((cset->ranges[i].start <= ch) && (ch <= cset->ranges[i].end)) { match = 1; break; } } } return (cset->exclude ? !match : match); } /* *---------------------------------------------------------------------- * * ReleaseCharSet -- * * Free the storage associated with a character set. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void ReleaseCharSet( CharSet *cset) { ckfree(cset->chars); if (cset->ranges) { ckfree(cset->ranges); } } /* *---------------------------------------------------------------------- * * ValidateFormat -- * * Parse the format string and verify that it is properly formed and that * there are exactly enough variables on the command line. * * Results: * A standard Tcl result. * * Side effects: * May place an error in the interpreter result. * *---------------------------------------------------------------------- */ static int ValidateFormat( Tcl_Interp *interp, /* Current interpreter. */ const char *format, /* The format string. */ int numVars, /* The number of variables passed to the scan * command. */ int *totalSubs) /* The number of variables that will be * required. */ { int gotXpg, gotSequential, value, i, flags; char *end; Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int)); Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ char buf[TCL_UTF_MAX+1] = ""; /* * Initialize an array that records the number of times a variable is * assigned to by the format string. We use this to detect if a variable * is multiply assigned or left unassigned. */ for (i = 0; i < nspace; i++) { nassign[i] = 0; } xpgSize = objIndex = gotXpg = gotSequential = 0; while (*format != '\0') { format += TclUtfToUniChar(format, &ch); flags = 0; if (ch != '%') { continue; } format += TclUtfToUniChar(format, &ch); if (ch == '%') { continue; } if (ch == '*') { flags |= SCAN_SUPPRESS; format += TclUtfToUniChar(format, &ch); goto xpgCheckDone; } if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ /* * Check for an XPG3-style %n$ specification. Note: there must * not be a mixture of XPG3 specs and non-XPG3 specs in the same * format string. */ unsigned long ul = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ if (*end != '$') { goto notXpg; } format = end+1; format += TclUtfToUniChar(format, &ch); gotXpg = 1; if (gotSequential) { goto mixedXPG; } if (ul == 0 || ul >= INT_MAX) { goto badIndex; } objIndex = (int) ul - 1; if (numVars && (objIndex >= numVars)) { goto badIndex; } else if (numVars == 0) { /* * In the case where no vars are specified, the user can * specify %9999$ legally, so we have to consider special * rules for growing the assign array. 'ul' is guaranteed * to be > 0 and < INT_MAX as per checks above. */ xpgSize = (xpgSize > (int)ul) ? xpgSize : (int)ul; } goto xpgCheckDone; } notXpg: gotSequential = 1; if (gotXpg) { mixedXPG: Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot mix \"%\" and \"%n$\" conversion specifiers", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL); goto error; } xpgCheckDone: /* * Parse any width specifier. */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ value = strtoul(format-1, (char **) &format, 10); /* INTL: "C" locale. */ flags |= SCAN_WIDTH; format += TclUtfToUniChar(format, &ch); } /* * Handle any size specifier. */ switch (ch) { case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } /* FALLTHRU */ case 'L': flags |= SCAN_LONGER; /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) { goto badIndex; } /* * Handle the various field types. */ switch (ch) { case 'c': if (flags & SCAN_WIDTH) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "field width may not be specified in %c conversion", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL); goto error; } /* FALLTHRU */ case 'n': case 's': if (flags & (SCAN_LONGER|SCAN_BIG)) { invalidFieldSize: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; errorMsg = Tcl_NewStringObj( "field size modifier may not be specified in %", -1); Tcl_AppendToObj(errorMsg, buf, -1); Tcl_AppendToObj(errorMsg, " conversion", -1); Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL); goto error; } /* * Fall through! */ case 'd': case 'e': case 'E': case 'f': case 'g': case 'G': case 'i': case 'o': case 'x': case 'X': case 'b': break; case 'u': if (flags & SCAN_BIG) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unsigned bignum scans are invalid", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL); goto error; } break; /* * Bracket terms need special checking */ case '[': if (flags & (SCAN_LONGER|SCAN_BIG)) { goto invalidFieldSize; } if (*format == '\0') { goto badSet; } format += TclUtfToUniChar(format, &ch); if (ch == '^') { if (*format == '\0') { goto badSet; } format += TclUtfToUniChar(format, &ch); } if (ch == ']') { if (*format == '\0') { goto badSet; } format += TclUtfToUniChar(format, &ch); } while (ch != ']') { if (*format == '\0') { goto badSet; } format += TclUtfToUniChar(format, &ch); } break; badSet: Tcl_SetObjResult(interp, Tcl_NewStringObj( "unmatched [ in format string", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL); goto error; default: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; errorMsg = Tcl_NewStringObj( "bad scan conversion character \"", -1); Tcl_AppendToObj(errorMsg, buf, -1); Tcl_AppendToObj(errorMsg, "\"", -1); Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); goto error; } if (!(flags & SCAN_SUPPRESS)) { if (objIndex >= nspace) { /* * Expand the nassign buffer. If we are using XPG specifiers, * make sure that we grow to a large enough size. xpgSize is * guaranteed to be at least one larger than objIndex. */ value = nspace; if (xpgSize) { nspace = xpgSize; } else { nspace += 16; /* formerly STATIC_LIST_SIZE */ } nassign = (int *)TclStackRealloc(interp, nassign, nspace * sizeof(int)); for (i = value; i < nspace; i++) { nassign[i] = 0; } } nassign[objIndex]++; objIndex++; } } /* * Verify that all of the variable were assigned exactly once. */ if (numVars == 0) { if (xpgSize) { numVars = xpgSize; } else { numVars = objIndex; } } if (totalSubs) { *totalSubs = numVars; } for (i = 0; i < numVars; i++) { if (nassign[i] > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "variable is assigned by multiple \"%n$\" conversion specifiers", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL); goto error; } else if (!xpgSize && (nassign[i] == 0)) { /* * If the space is empty, and xpgSize is 0 (means XPG wasn't used, * and/or numVars != 0), then too many vars were given */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "variable is not assigned by any conversion specifiers", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL); goto error; } } TclStackFree(interp, nassign); return TCL_OK; badIndex: if (gotXpg) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"%n$\" argument index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( "different numbers of variable names and field specifiers", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL); } error: TclStackFree(interp, nassign); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_ScanObjCmd -- * * This function is invoked to process the "scan" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_ScanObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; long value; const char *string, *end, *baseString; char op = 0; int width, underflow = 0; Tcl_WideInt wideValue; Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; (void)dummy; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "string format ?varName ...?"); return TCL_ERROR; } format = Tcl_GetString(objv[2]); numVars = objc-3; /* * Check for errors in the format string. */ if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) { return TCL_ERROR; } /* * Allocate space for the result objects. */ if (totalVars > 0) { objs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * totalVars); for (i = 0; i < totalVars; i++) { objs[i] = NULL; } } string = Tcl_GetString(objv[1]); baseString = string; /* * Iterate over the format string filling in the result objects until we * reach the end of input, the end of the format string, or there is a * mismatch. */ objIndex = 0; nconversions = 0; while (*format != '\0') { int parseFlag = TCL_PARSE_NO_WHITESPACE; format += TclUtfToUniChar(format, &ch); flags = 0; /* * If we see whitespace in the format, skip whitespace in the string. */ if (Tcl_UniCharIsSpace(ch)) { offset = TclUtfToUniChar(string, &sch); while (Tcl_UniCharIsSpace(sch)) { if (*string == '\0') { goto done; } string += offset; offset = TclUtfToUniChar(string, &sch); } continue; } if (ch != '%') { literal: if (*string == '\0') { underflow = 1; goto done; } string += TclUtfToUniChar(string, &sch); if (ch != sch) { goto done; } continue; } format += TclUtfToUniChar(format, &ch); if (ch == '%') { goto literal; } /* * Check for assignment suppression ('*') or an XPG3-style assignment * ('%n$'). */ if (ch == '*') { flags |= SCAN_SUPPRESS; format += TclUtfToUniChar(format, &ch); } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ char *formatEnd; value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */ if (*formatEnd == '$') { format = formatEnd+1; format += TclUtfToUniChar(format, &ch); objIndex = (int) value - 1; } } /* * Parse any width specifier. */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */ format += TclUtfToUniChar(format, &ch); } else { width = 0; } /* * Handle any size specifier. */ switch (ch) { case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } /* FALLTHRU */ case 'L': flags |= SCAN_LONGER; /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } /* * Handle the various field types. */ switch (ch) { case 'n': if (!(flags & SCAN_SUPPRESS)) { TclNewIntObj(objPtr, string - baseString); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } nconversions++; continue; case 'd': op = 'i'; parseFlag |= TCL_PARSE_DECIMAL_ONLY; break; case 'i': op = 'i'; parseFlag |= TCL_PARSE_SCAN_PREFIXES; break; case 'o': op = 'i'; parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES; break; case 'x': case 'X': op = 'i'; parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY; break; case 'b': op = 'i'; parseFlag |= TCL_PARSE_BINARY_ONLY; break; case 'u': op = 'i'; parseFlag |= TCL_PARSE_DECIMAL_ONLY; flags |= SCAN_UNSIGNED; break; case 'f': case 'e': case 'E': case 'g': case 'G': op = 'f'; break; case 's': op = 's'; break; case 'c': op = 'c'; flags |= SCAN_NOSKIP; break; case '[': op = '['; flags |= SCAN_NOSKIP; break; } /* * At this point, we will need additional characters from the string * to proceed. */ if (*string == '\0') { underflow = 1; goto done; } /* * Skip any leading whitespace at the beginning of a field unless the * format suppresses this behavior. */ if (!(flags & SCAN_NOSKIP)) { while (*string != '\0') { offset = TclUtfToUniChar(string, &sch); if (!Tcl_UniCharIsSpace(sch)) { break; } string += offset; } if (*string == '\0') { underflow = 1; goto done; } } /* * Perform the requested scanning operation. */ switch (op) { case 's': /* * Scan a string up to width characters or whitespace. */ if (width == 0) { width = ~0; } end = string; while (*end != '\0') { offset = TclUtfToUniChar(end, &sch); if (Tcl_UniCharIsSpace(sch)) { break; } end += offset; if (--width == 0) { break; } } if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewStringObj(string, end-string); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } string = end; break; case '[': { CharSet cset; if (width == 0) { width = ~0; } end = string; format = BuildCharSet(&cset, format); while (*end != '\0') { offset = TclUtfToUniChar(end, &sch); if (!CharInSet(&cset, (int)sch)) { break; } end += offset; if (--width == 0) { break; } } ReleaseCharSet(&cset); if (string == end) { /* * Nothing matched the range, stop processing. */ goto done; } if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewStringObj(string, end-string); Tcl_IncrRefCount(objPtr); objs[objIndex++] = objPtr; } string = end; break; } case 'c': /* * Scan a single Unicode character. */ offset = TclUtfToUCS4(string, &i); string += offset; if (!(flags & SCAN_SUPPRESS)) { TclNewIntObj(objPtr, i); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } break; case 'i': /* * Scan an unsigned or signed integer. */ TclNewIntObj(objPtr, 0); Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { underflow = 1; } } else { if (end == string + width) { underflow = 1; } } goto done; } string = end; if (flags & SCAN_SUPPRESS) { Tcl_DecrRefCount(objPtr); break; } if (flags & SCAN_LONGER) { if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { wideValue = WIDE_MIN; } else { wideValue = WIDE_MAX; } } if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { mp_int big; TclBNInitBignumFromWideUInt(&big, (Tcl_WideUInt)wideValue); Tcl_SetBignumObj(objPtr, &big); } else { Tcl_SetWideIntObj(objPtr, wideValue); } } else if (!(flags & SCAN_BIG)) { if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { value = LONG_MIN; } else { value = LONG_MAX; } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { #ifdef TCL_WIDE_INT_IS_LONG mp_int big; TclBNInitBignumFromWideUInt(&big, (unsigned long)value); Tcl_SetBignumObj(objPtr, &big); #else Tcl_SetWideIntObj(objPtr, (unsigned long)value); #endif } else { TclSetLongObj(objPtr, value); } } objs[objIndex++] = objPtr; break; case 'f': /* * Scan a floating point number */ objPtr = Tcl_NewDoubleObj(0.0); Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { underflow = 1; } } else { if (end == string + width) { underflow = 1; } } goto done; } else if (flags & SCAN_SUPPRESS) { Tcl_DecrRefCount(objPtr); string = end; } else { double dvalue; if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { #ifdef ACCEPT_NAN if (objPtr->typePtr == &tclDoubleType) { dvalue = objPtr->internalRep.doubleValue; } else #endif { Tcl_DecrRefCount(objPtr); goto done; } } Tcl_SetDoubleObj(objPtr, dvalue); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; string = end; } } nconversions++; } done: result = 0; code = TCL_OK; if (numVars) { /* * In this case, variables were specified (classic scan). */ for (i = 0; i < totalVars; i++) { if (objs[i] == NULL) { continue; } result++; /* * In case of multiple errors in setting variables, just report * the first one. */ if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], (code == TCL_OK) ? TCL_LEAVE_ERR_MSG : 0) == NULL) { code = TCL_ERROR; } Tcl_DecrRefCount(objs[i]); } } else { /* * Here no vars were specified, we want a list returned (inline scan) */ TclNewObj(objPtr); for (i = 0; i < totalVars; i++) { if (objs[i] != NULL) { Tcl_ListObjAppendElement(NULL, objPtr, objs[i]); Tcl_DecrRefCount(objs[i]); } else { /* * More %-specifiers than matching chars, so we just spit out * empty strings for these. */ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj()); } } } if (objs != NULL) { ckfree(objs); } if (code == TCL_OK) { if (underflow && (nconversions == 0)) { if (numVars) { TclNewIntObj(objPtr, -1); } else { if (objPtr) { Tcl_SetListObj(objPtr, 0, NULL); } else { TclNewObj(objPtr); } } } else if (numVars) { TclNewIntObj(objPtr, result); } Tcl_SetObjResult(interp, objPtr); } return code; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclStringObj.c0000644000175000017500000024756014560736524016053 0ustar sergeisergei/* * tclStringObj.c -- * * This file contains functions that implement string operations on Tcl * objects. Some string operations work with UTF strings and others * require Unicode format. Functions that require knowledge of the width * of each character, such as indexing, operate on Unicode data. * * A Unicode string is an internationalized string. Conceptually, a * Unicode string is an array of 16-bit quantities organized as a * sequence of properly formed UTF-8 characters. There is a one-to-one * map between Unicode and UTF characters. Because Unicode characters * have a fixed width, operations such as indexing operate on Unicode * data. The String object is optimized for the case where each UTF char * in a string is only one byte. In this case, we store the value of * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode * is explicitly called). * * The String object type stores one or both formats. The default * behavior is to store UTF. Once Unicode is calculated by a function, it * is stored in the internal rep for future access (without an additional * O(n) cost). * * To allow many appends to be done to an object without constantly * reallocating the space for the string or Unicode representation, we * allocate double the space for the string or Unicode and use the * internal representation to keep track of how much space is used vs. * allocated. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #include "tclStringRep.h" /* * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5. * This is an escape hatch in case the changes have some unexpected unwelcome * impact on performance. If things go well, this mechanism can go away when * post-8.6 development begins. */ #define COMPAT 0 /* * Prototypes for functions defined later in this file: */ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, const char *bytes, int numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, const char *bytes, int numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, const char *bytes, int numBytes, int numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); static int UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); /* * The structure below defines the string Tcl object type by means of * functions that can be invoked by generic object code. */ const Tcl_ObjType tclStringType = { "string", /* name */ FreeStringInternalRep, /* freeIntRepPro */ DupStringInternalRep, /* dupIntRepProc */ UpdateStringOfString, /* updateStringProc */ SetStringFromAny /* setFromAnyProc */ }; /* * TCL STRING GROWTH ALGORITHM * * When growing strings (during an append, for example), the following growth * algorithm is used: * * Attempt to allocate 2 * (originalLength + appendLength) * On failure: * attempt to allocate originalLength + 2*appendLength + TCL_MIN_GROWTH * * This algorithm allows very good performance, as it rapidly increases the * memory allocated for a given string, which minimizes the number of * reallocations that must be performed. However, using only the doubling * algorithm can lead to a significant waste of memory. In particular, it may * fail even when there is sufficient memory available to complete the append * request (but there is not 2*totalLength memory available). So when the * doubling fails (because there is not enough memory available), the * algorithm requests a smaller amount of memory, which is still enough to * cover the request, but which hopefully will be less than the total * available memory. * * The addition of TCL_MIN_GROWTH allows for efficient handling of very * small appends. Without this extra slush factor, a sequence of several small * appends would cause several memory allocations. As long as * TCL_MIN_GROWTH is a reasonable size, we can avoid that behavior. * * The growth algorithm can be tuned by adjusting the following parameters: * * TCL_MIN_GROWTH Additional space, in bytes, to allocate when * the double allocation has failed. Default is * 1024 (1 kilobyte). See tclInt.h. */ #ifndef TCL_MIN_UNICHAR_GROWTH #define TCL_MIN_UNICHAR_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_UniChar) #endif static void GrowStringBuffer( Tcl_Obj *objPtr, int needed, int flag) { /* * Preconditions: * objPtr->typePtr == &tclStringType * needed > stringPtr->allocated * flag || objPtr->bytes != NULL */ String *stringPtr = GET_STRING(objPtr); char *ptr = NULL; int attempt; if (objPtr->bytes == tclEmptyStringRep) { objPtr->bytes = NULL; } if (flag == 0 || stringPtr->allocated > 0) { if (needed <= INT_MAX / 2) { attempt = 2 * needed; ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U); } if (ptr == NULL) { /* * Take care computing the amount of modest growth to avoid * overflow into invalid argument values for attempt. */ unsigned int limit = INT_MAX - needed; unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); attempt = needed + growth; ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U); } } if (ptr == NULL) { /* * First allocation - just big enough; or last chance fallback. */ attempt = needed; ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1U); } objPtr->bytes = ptr; stringPtr->allocated = attempt; } static void GrowUnicodeBuffer( Tcl_Obj *objPtr, int needed) { /* * Preconditions: * objPtr->typePtr == &tclStringType * needed > stringPtr->maxChars * needed < STRING_MAXCHARS */ String *ptr = NULL, *stringPtr = GET_STRING(objPtr); int attempt; if (stringPtr->maxChars > 0) { /* * Subsequent appends - apply the growth algorithm. */ if (needed <= STRING_MAXCHARS / 2) { attempt = 2 * needed; ptr = stringAttemptRealloc(stringPtr, attempt); } if (ptr == NULL) { /* * Take care computing the amount of modest growth to avoid * overflow into invalid argument values for attempt. */ unsigned int limit = STRING_MAXCHARS - needed; unsigned int extra = needed - stringPtr->numChars + TCL_MIN_UNICHAR_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); attempt = needed + growth; ptr = stringAttemptRealloc(stringPtr, attempt); } } if (ptr == NULL) { /* * First allocation - just big enough; or last chance fallback. */ attempt = needed; ptr = stringRealloc(stringPtr, attempt); } stringPtr = ptr; stringPtr->maxChars = attempt; SET_STRING(objPtr, stringPtr); } /* *---------------------------------------------------------------------- * * Tcl_NewStringObj -- * * This function is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates a new string object and * initializes it from the byte pointer and length arguments. * * When TCL_MEM_DEBUG is defined, this function just returns the result * of calling the debugging version Tcl_DbNewStringObj. * * Results: * A newly created string object is returned that has ref count zero. * * Side effects: * The new object's internal string representation will be set to a copy * of the length bytes starting at "bytes". If "length" is negative, use * bytes up to the first NUL byte; i.e., assume "bytes" points to a * C-style NUL-terminated string. The object's type is set to NULL. An * extra NUL is added to the end of the new object's byte array. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewStringObj Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length) /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ { return Tcl_DbNewStringObj(bytes, length, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length) /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ { Tcl_Obj *objPtr; if (length < 0) { length = (bytes? strlen(bytes) : 0); } TclNewStringObj(objPtr, bytes, length); return objPtr; } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewStringObj -- * * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It creates new string objects. It is the * same as the Tcl_NewStringObj function above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its * caller. This simplifies debugging since then the [memory active] * command will report the correct file name and line number when * reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this function just returns the * result of calling Tcl_NewStringObj. * * Results: * A newly created string object is returned that has ref count zero. * * Side effects: * The new object's internal string representation will be set to a copy * of the length bytes starting at "bytes". If "length" is negative, use * bytes up to the first NUL byte; i.e., assume "bytes" points to a * C-style NUL-terminated string. The object's type is set to NULL. An * extra NUL is added to the end of the new object's byte array. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length, /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; if (length < 0) { length = (bytes? strlen(bytes) : 0); } TclDbNewObj(objPtr, file, line); TclInitStringRep(objPtr, bytes, length); return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length, /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewStringObj(bytes, length); } #endif /* TCL_MEM_DEBUG */ /* *--------------------------------------------------------------------------- * * Tcl_NewUnicodeObj -- * * This function is creates a new String object and initializes it from * the given Unicode String. If the Utf String is the same size as the * Unicode string, don't duplicate the data. * * Results: * The newly created object is returned. This object will have no initial * string representation. The returned object has a ref count of 0. * * Side effects: * Memory allocated for new object and copy of Unicode argument. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_NewUnicodeObj( const Tcl_UniChar *unicode, /* The unicode string used to initialize the * new object. */ int numChars) /* Number of characters in the unicode * string. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); SetUnicodeObj(objPtr, unicode, numChars); return objPtr; } /* *---------------------------------------------------------------------- * * Tcl_GetCharLength -- * * Get the length of the Unicode string from the Tcl object. * * Results: * Pointer to Unicode string representing the Unicode object. * * Side effects: * Frees old internal rep. Allocates memory for new "String" internal * rep. * *---------------------------------------------------------------------- */ int Tcl_GetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { String *stringPtr; int numChars; /* * Quick, no-shimmer return for short string reps. */ if ((objPtr->bytes) && (objPtr->length < 2)) { /* 0 bytes -> 0 chars; 1 byte -> 1 char */ return objPtr->length; } /* * Optimize the case where we're really dealing with a ByteArray object; * we don't need to convert to a string to perform the get-length operation. * * NOTE that we do not need the ByteArray to be "pure". A ByteArray value * with a string rep cannot be trusted to represent the same value as the * string rep, but it *can* be trusted to have the same character length * as the string rep, which is all this routine cares about. */ if (objPtr->typePtr == &tclByteArrayType) { int length; (void) Tcl_GetByteArrayFromObj(objPtr, &length); return length; } /* * OK, need to work with the object as a string. */ SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); numChars = stringPtr->numChars; /* * If numChars is unknown, compute it. */ if (numChars == -1) { TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; #if COMPAT if (numChars < objPtr->length) { /* * Since we've just computed the number of chars, and not all UTF * chars are 1-byte long, go ahead and populate the Unicode * string. */ FillUnicodeRep(objPtr); } #endif } return numChars; } /* *---------------------------------------------------------------------- * * TclCheckEmptyString -- * * Determine whether the string value of an object is or would be the * empty string, without generating a string representation. * * Results: * Returns 1 if empty, 0 if not, and -1 if unknown. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclCheckEmptyString ( Tcl_Obj *objPtr) { int length = -1; if (objPtr->bytes == tclEmptyStringRep) { return TCL_EMPTYSTRING_YES; } if (TclIsPureList(objPtr)) { TclListObjLength(NULL, objPtr, &length); return length == 0; } if (TclIsPureDict(objPtr)) { Tcl_DictObjSize(NULL, objPtr, &length); return length == 0; } if (objPtr->bytes == NULL) { return TCL_EMPTYSTRING_UNKNOWN; } return objPtr->length == 0; } /* *---------------------------------------------------------------------- * * Tcl_GetUniChar/TclGetUCS4 -- * * Get the index'th Unicode character from the String object. If index * is out of range, the result = 0xFFFD (Tcl_GetUniChar) resp. -1 (TclGetUCS4) * * Results: * Returns the index'th Unicode character in the Object. * * Side effects: * Fills unichar with the index'th Unicode character. * *---------------------------------------------------------------------- */ Tcl_UniChar Tcl_GetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ int index) /* Get the index'th Unicode character. */ { String *stringPtr; int length; if (index < 0) { return 0xFFFD; } /* * Optimize the case where we're really dealing with a ByteArray object * we don't need to convert to a string to perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return 0xFFFD; } return (Tcl_UniChar) bytes[index]; } /* * OK, need to work with the object as a string. */ SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode == 0) { /* * If numChars is unknown, compute it. */ if (stringPtr->numChars == -1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (index >= stringPtr->numChars) { return 0xFFFD; } if (stringPtr->numChars == objPtr->length) { return (unsigned char) objPtr->bytes[index]; } FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } if (index >= stringPtr->numChars) { return 0xFFFD; } return stringPtr->unicode[index]; } #if TCL_UTF_MAX == 4 int TclGetUCS4( Tcl_Obj *objPtr, /* The object to get the Unicode character * from. */ int index) /* Get the index'th Unicode character. */ { String *stringPtr; int ch, length; if (index < 0) { return -1; } /* * Optimize the case where we're really dealing with a ByteArray object * we don't need to convert to a string to perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; } return (int) bytes[index]; } /* * OK, need to work with the object as a string. */ SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode == 0) { /* * If numChars is unknown, compute it. */ if (stringPtr->numChars == -1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (index >= stringPtr->numChars) { return -1; } if (stringPtr->numChars == objPtr->length) { /* Pure ascii, can directly index bytes */ return (unsigned char) objPtr->bytes[index]; } FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } if (index >= stringPtr->numChars) { return -1; } ch = stringPtr->unicode[index]; #if TCL_UTF_MAX <= 4 /* See: bug [11ae2be95dac9417] */ if ((ch & 0xF800) == 0xD800) { if (ch & 0x400) { if ((index > 0) && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) { ch = -1; /* low surrogate preceded by high surrogate */ } } else if ((++index < stringPtr->numChars) && ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) { /* high surrogate followed by low surrogate */ ch = (((ch & 0x3FF) << 10) | (stringPtr->unicode[index] & 0x3FF)) + 0x10000; } } #endif return ch; } #endif /* *---------------------------------------------------------------------- * * Tcl_GetUnicode -- * * Get the Unicode form of the String object. If the object is not * already a String object, it will be converted to one. If the String * object does not have a Unicode rep, then one is created from the UTF * string format. * * Results: * Returns a pointer to the object's internal Unicode string. * * Side effects: * Converts the object to have the String internal rep. * *---------------------------------------------------------------------- */ Tcl_UniChar * Tcl_GetUnicode( Tcl_Obj *objPtr) /* The object to find the Unicode string * for. */ { return Tcl_GetUnicodeFromObj(objPtr, NULL); } /* *---------------------------------------------------------------------- * * Tcl_GetUnicodeFromObj -- * * Get the Unicode form of the String object with length. If the object * is not already a String object, it will be converted to one. If the * String object does not have a Unicode rep, then one is create from the * UTF string format. * * Results: * Returns a pointer to the object's internal Unicode string. * * Side effects: * Converts the object to have the String internal rep. * *---------------------------------------------------------------------- */ Tcl_UniChar * Tcl_GetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the Unicode string * for. */ int *lengthPtr) /* If non-NULL, the location where the string * rep's Tcl_UniChar length should be stored. If * NULL, no length is stored. */ { String *stringPtr; SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode == 0) { FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } if (lengthPtr != NULL) { *lengthPtr = stringPtr->numChars; } return stringPtr->unicode; } /* *---------------------------------------------------------------------- * * Tcl_GetRange -- * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a * String object, convert it to one. If first is negative, the returned * string start at the beginning of objPtr. If last is negative, the * returned string ends at the end of objPtr. * * Results: * Returns a new Tcl Object of the String type. * * Side effects: * Changes the internal rep of "objPtr" to the String type. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ int first, /* First index of the range. */ int last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; int length; if (first < 0) { first = 0; } /* * Optimize the case where we're really dealing with a ByteArray object * we don't need to convert to a string to perform the substring operation. */ if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (last < 0 || last >= length) { last = length - 1; } if (last < first) { TclNewObj(newObjPtr); return newObjPtr; } return Tcl_NewByteArrayObj(bytes + first, last - first + 1); } /* * OK, need to work with the object as a string. */ SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode == 0) { /* * If numChars is unknown, compute it. */ if (stringPtr->numChars == -1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } if (last < first) { TclNewObj(newObjPtr); return newObjPtr; } newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1); /* * Since we know the char length of the result, store it. */ SetStringFromAny(NULL, newObjPtr); stringPtr = GET_STRING(newObjPtr); stringPtr->numChars = newObjPtr->length; return newObjPtr; } FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } if (last < first) { TclNewObj(newObjPtr); return newObjPtr; } #if TCL_UTF_MAX == 4 /* See: bug [11ae2be95dac9417] */ if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } if ((last + 1 < stringPtr->numChars) && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { ++last; } #endif return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1); } /* *---------------------------------------------------------------------- * * Tcl_SetStringObj -- * * Modify an object to hold a string that is a copy of the bytes * indicated by the byte pointer and length arguments. * * Results: * None. * * Side effects: * The object's string representation will be set to a copy of the * "length" bytes starting at "bytes". If "length" is negative, use bytes * up to the first NUL byte; i.e., assume "bytes" points to a C-style * NUL-terminated string. The object's old string and internal * representations are freed and the object's type is set NULL. * *---------------------------------------------------------------------- */ void Tcl_SetStringObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ const char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ int length) /* The number of bytes to copy from "bytes" * when initializing the object. If negative, * use bytes up to the first NUL byte.*/ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetStringObj"); } /* * Set the type to NULL and free any internal rep for the old type. */ TclFreeIntRep(objPtr); /* * Free any old string rep, then set the string rep to a copy of the * length bytes starting at "bytes". */ TclInvalidateStringRep(objPtr); if (length < 0) { length = (bytes? strlen(bytes) : 0); } TclInitStringRep(objPtr, bytes, length); } /* *---------------------------------------------------------------------- * * Tcl_SetObjLength -- * * This function changes the length of the string representation of an * object. * * Results: * None. * * Side effects: * If the size of objPtr's string representation is greater than length, * then it is reduced to length and a new terminating null byte is stored * in the strength. If the length of the string representation is greater * than length, the storage space is reallocated to the given length; a * null byte is stored at the end, but other bytes past the end of the * original string representation are undefined. The object's internal * representation is changed to "expendable string". * *---------------------------------------------------------------------- */ void Tcl_SetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; if (length < 0) { /* * Setting to a negative length is nonsense. This is probably the * result of overflowing the signed integer range. */ Tcl_Panic("Tcl_SetObjLength: negative length requested: " "%d (integer overflow?)", length); } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); } if (objPtr->bytes && objPtr->length == length) { return; } SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (objPtr->bytes != NULL) { /* * Change length of an existing string rep. */ if (length > stringPtr->allocated) { /* * Need to enlarge the buffer. */ if (objPtr->bytes == tclEmptyStringRep) { objPtr->bytes = (char *)ckalloc((unsigned int)length + 1U); } else { objPtr->bytes = (char *)ckrealloc(objPtr->bytes, (unsigned int)length + 1U); } stringPtr->allocated = length; } objPtr->length = length; objPtr->bytes[length] = 0; /* * Invalidate the unicode data. */ stringPtr->numChars = -1; stringPtr->hasUnicode = 0; } else { /* * Changing length of pure unicode string. */ stringCheckLimits(length); if (length > stringPtr->maxChars) { stringPtr = stringRealloc(stringPtr, length); SET_STRING(objPtr, stringPtr); stringPtr->maxChars = length; } /* * Mark the new end of the Unicode string */ stringPtr->numChars = length; stringPtr->unicode[length] = 0; stringPtr->hasUnicode = 1; /* * Can only get here when objPtr->bytes == NULL. No need to invalidate * the string rep. */ } } /* *---------------------------------------------------------------------- * * Tcl_AttemptSetObjLength -- * * This function changes the length of the string representation of an * object. It uses the attempt* (non-panic'ing) memory allocators. * * Results: * 1 if the requested memory was allocated, 0 otherwise. * * Side effects: * If the size of objPtr's string representation is greater than length, * then it is reduced to length and a new terminating null byte is stored * in the strength. If the length of the string representation is greater * than length, the storage space is reallocated to the given length; a * null byte is stored at the end, but other bytes past the end of the * original string representation are undefined. The object's internal * representation is changed to "expendable string". * *---------------------------------------------------------------------- */ int Tcl_AttemptSetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; if (length < 0) { /* * Setting to a negative length is nonsense. This is probably the * result of overflowing the signed integer range. */ return 0; } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } if (objPtr->bytes && objPtr->length == length) { return 1; } SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (objPtr->bytes != NULL) { /* * Change length of an existing string rep. */ if (length > stringPtr->allocated) { /* * Need to enlarge the buffer. */ char *newBytes; if (objPtr->bytes == tclEmptyStringRep) { newBytes = (char *)attemptckalloc((unsigned int)length + 1U); } else { newBytes = (char *)attemptckrealloc(objPtr->bytes, (unsigned int)length + 1U); } if (newBytes == NULL) { return 0; } objPtr->bytes = newBytes; stringPtr->allocated = length; } objPtr->length = length; objPtr->bytes[length] = 0; /* * Invalidate the Unicode data. */ stringPtr->numChars = -1; stringPtr->hasUnicode = 0; } else { /* * Changing length of pure Unicode string. */ if (length > STRING_MAXCHARS) { return 0; } if (length > stringPtr->maxChars) { stringPtr = stringAttemptRealloc(stringPtr, length); if (stringPtr == NULL) { return 0; } SET_STRING(objPtr, stringPtr); stringPtr->maxChars = length; } /* * Mark the new end of the Unicode string. */ stringPtr->unicode[length] = 0; stringPtr->numChars = length; stringPtr->hasUnicode = 1; /* * Can only get here when objPtr->bytes == NULL. No need to invalidate * the string rep. */ } return 1; } /* *--------------------------------------------------------------------------- * * Tcl_SetUnicodeObj -- * * Modify an object to hold the Unicode string indicated by "unicode". * * Results: * None. * * Side effects: * Memory allocated for new "String" internal rep. * *--------------------------------------------------------------------------- */ void Tcl_SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The Unicode string used to initialize the * object. */ int numChars) /* Number of characters in the Unicode * string. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj"); } TclFreeIntRep(objPtr); SetUnicodeObj(objPtr, unicode, numChars); } static int UnicodeLength( const Tcl_UniChar *unicode) { int numChars = 0; if (unicode) { while (numChars >= 0 && unicode[numChars] != 0) { numChars++; } } stringCheckLimits(numChars); return numChars; } static void SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The Unicode string used to initialize the * object. */ int numChars) /* Number of characters in the Unicode * string. */ { String *stringPtr; if (numChars < 0) { numChars = UnicodeLength(unicode); } /* * Allocate enough space for the String structure + Unicode string. */ stringCheckLimits(numChars); stringPtr = stringAlloc(numChars); SET_STRING(objPtr, stringPtr); objPtr->typePtr = &tclStringType; stringPtr->maxChars = numChars; memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar)); stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; stringPtr->hasUnicode = 1; TclInvalidateStringRep(objPtr); stringPtr->allocated = 0; } /* *---------------------------------------------------------------------- * * Tcl_AppendLimitedToObj -- * * This function appends a limited number of bytes from a sequence of * bytes to an object, marking any limitation with an ellipsis. * * Results: * None. * * Side effects: * The bytes at *bytes are appended to the string representation of * objPtr. * *---------------------------------------------------------------------- */ void Tcl_AppendLimitedToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ int length, /* The number of bytes available to be * appended from "bytes". If < 0, then all * bytes up to a NUL byte are available. */ int limit, /* The maximum number of bytes to append to * the object. */ const char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes * at "bytes" were appended. */ { String *stringPtr; int toCopy = 0; int eLen = 0; if (length < 0) { length = (bytes ? strlen(bytes) : 0); } if (length == 0) { return; } if (limit <= 0) { return; } if (length <= limit) { toCopy = length; } else { if (ellipsis == NULL) { ellipsis = "..."; } eLen = strlen(ellipsis); while (eLen > limit) { eLen = TclUtfPrev(ellipsis+eLen, ellipsis) - ellipsis; } toCopy = TclUtfPrev(bytes+limit+1-eLen, bytes) - bytes; } /* * If objPtr has a valid Unicode rep, then append the Unicode conversion * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to * objPtr's string rep. */ if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj"); } SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode && stringPtr->numChars > 0) { AppendUtfToUnicodeRep(objPtr, bytes, toCopy); } else { AppendUtfToUtfRep(objPtr, bytes, toCopy); } if (length <= limit) { return; } stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode && stringPtr->numChars > 0) { AppendUtfToUnicodeRep(objPtr, ellipsis, eLen); } else { AppendUtfToUtfRep(objPtr, ellipsis, eLen); } } /* *---------------------------------------------------------------------- * * Tcl_AppendToObj -- * * This function appends a sequence of bytes to an object. * * Results: * None. * * Side effects: * The bytes at *bytes are appended to the string representation of * objPtr. * *---------------------------------------------------------------------- */ void Tcl_AppendToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ int length) /* The number of bytes to append from "bytes". * If < 0, then append all bytes up to NUL * byte. */ { Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); } /* *---------------------------------------------------------------------- * * Tcl_AppendUnicodeToObj -- * * This function appends a Unicode string to an object in the most * efficient manner possible. Length must be >= 0. * * Results: * None. * * Side effects: * Invalidates the string rep and creates a new Unicode string. * *---------------------------------------------------------------------- */ void Tcl_AppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The Unicode string to append to the * object. */ int length) /* Number of chars in unicode. */ { String *stringPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); } if (length == 0) { return; } SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); /* * If objPtr has a valid Unicode rep, then append unicode to the * objPtr's Unicode rep, otherwise the UTF conversion of unicode to * objPtr's string rep. */ if (stringPtr->hasUnicode #if COMPAT && stringPtr->numChars > 0 #endif ) { AppendUnicodeToUnicodeRep(objPtr, unicode, length); } else { AppendUnicodeToUtfRep(objPtr, unicode, length); } } /* *---------------------------------------------------------------------- * * Tcl_AppendObjToObj -- * * This function appends the string rep of one object to another. * "objPtr" cannot be a shared object. * * Results: * None. * * Side effects: * The string rep of appendObjPtr is appended to the string * representation of objPtr. * IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr. * Callers are counting on that. * *---------------------------------------------------------------------- */ void Tcl_AppendObjToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; int length, numChars, appendNumChars = -1; const char *bytes; /* * Special case: second object is standard-empty is fast case. We know * that appending nothing to anything leaves that starting anything... */ if (appendObjPtr->bytes == tclEmptyStringRep) { return; } /* * Handle append of one ByteArray object to another as a special case. * Note that we only do this when the objects don't have string reps; if * it did, then appending the byte arrays together could well lose * information; this is a special-case optimization only. */ if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep) && TclIsPureByteArray(appendObjPtr)) { /* * You might expect the code here to be * * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); * TclAppendBytesToByteArray(objPtr, bytes, length); * * and essentially all of the time that would be fine. However, it * would run into trouble in the case where objPtr and appendObjPtr * point to the same thing. That may never be a good idea. It seems to * violate Copy On Write, and we don't have any tests for the * situation, since making any Tcl commands that call * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On * Write!). For the sake of extensions that go off into that realm, * though, here's a more complex approach that can handle all the * cases. * * First, get the lengths. */ int lengthSrc; (void) Tcl_GetByteArrayFromObj(objPtr, &length); (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); /* * Grow buffer enough for the append. */ TclAppendBytesToByteArray(objPtr, NULL, lengthSrc); /* * Reset objPtr back to the original value. */ Tcl_SetByteArrayLength(objPtr, length); /* * Now do the append knowing that buffer growth cannot cause any * trouble. */ TclAppendBytesToByteArray(objPtr, Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc); return; } /* * Must append as strings. */ SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); /* * If objPtr has a valid Unicode rep, then get a Unicode string from * appendObjPtr and append it. */ if (stringPtr->hasUnicode #if COMPAT && stringPtr->numChars > 0 #endif ) { /* * If appendObjPtr is not of the "String" type, don't convert it. */ if (appendObjPtr->typePtr == &tclStringType) { Tcl_UniChar *unicode = Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); } else { bytes = TclGetStringFromObj(appendObjPtr, &length); AppendUtfToUnicodeRep(objPtr, bytes, length); } return; } /* * Append to objPtr's UTF string rep. If we know the number of characters * in both objects before appending, then set the combined number of * characters in the final (appended-to) object. */ bytes = TclGetStringFromObj(appendObjPtr, &length); numChars = stringPtr->numChars; if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) { String *appendStringPtr = GET_STRING(appendObjPtr); appendNumChars = appendStringPtr->numChars; } AppendUtfToUtfRep(objPtr, bytes, length); if (numChars >= 0 && appendNumChars >= 0 #if COMPAT && appendNumChars == length #endif ) { stringPtr->numChars = numChars + appendNumChars; } } /* *---------------------------------------------------------------------- * * AppendUnicodeToUnicodeRep -- * * Appends the contents of unicode to the Unicode rep of * objPtr, which must already have a valid Unicode rep. * * Results: * None. * * Side effects: * objPtr's internal rep is reallocated. * *---------------------------------------------------------------------- */ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ int appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr; int numChars; if (appendNumChars < 0) { appendNumChars = UnicodeLength(unicode); } if (appendNumChars == 0) { return; } SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); /* * If not enough space has been allocated for the Unicode rep, reallocate * the internal rep object with additional space. First try to double the * required allocation; if that fails, try a more modest increase. See the * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an * explanation of this growth algorithm. */ numChars = stringPtr->numChars + appendNumChars; stringCheckLimits(numChars); if (numChars > stringPtr->maxChars) { int offset = -1; /* * Protect against case where Unicode points into the existing * stringPtr->unicode array. Force it to follow any relocations due to * the reallocs below. */ if (unicode && unicode >= stringPtr->unicode && unicode <= stringPtr->unicode + stringPtr->maxChars) { offset = unicode - stringPtr->unicode; } GrowUnicodeBuffer(objPtr, numChars); stringPtr = GET_STRING(objPtr); /* * Relocate Unicode if needed; see above. */ if (offset >= 0) { unicode = stringPtr->unicode + offset; } } /* * Copy the new string onto the end of the old string, then add the * trailing null. */ if (unicode) { memmove(stringPtr->unicode + stringPtr->numChars, unicode, appendNumChars * sizeof(Tcl_UniChar)); } stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; stringPtr->allocated = 0; TclInvalidateStringRep(objPtr); } /* *---------------------------------------------------------------------- * * AppendUnicodeToUtfRep -- * * This function converts the contents of "unicode" to UTF and appends * the UTF to the string rep of "objPtr". * * Results: * None. * * Side effects: * objPtr's internal rep is reallocated. * *---------------------------------------------------------------------- */ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ int numChars) /* Number of chars of unicode to convert. */ { String *stringPtr = GET_STRING(objPtr); numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); if (stringPtr->numChars != -1) { stringPtr->numChars += numChars; } #if COMPAT /* * Invalidate the Unicode rep. */ stringPtr->hasUnicode = 0; #endif } /* *---------------------------------------------------------------------- * * AppendUtfToUnicodeRep -- * * This function converts the contents of "bytes" to Unicode and appends * the Unicode to the Unicode rep of "objPtr". objPtr must already have a * valid Unicode rep. numBytes must be non-negative. * * Results: * None. * * Side effects: * objPtr's internal rep is reallocated and string rep is cleaned. * *---------------------------------------------------------------------- */ static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to convert to Unicode. */ int numBytes) /* Number of bytes of "bytes" to convert. */ { String *stringPtr; if (numBytes == 0) { return; } ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1); TclInvalidateStringRep(objPtr); stringPtr = GET_STRING(objPtr); stringPtr->allocated = 0; } /* *---------------------------------------------------------------------- * * AppendUtfToUtfRep -- * * This function appends "numBytes" bytes of "bytes" to the UTF string * rep of "objPtr". objPtr must already have a valid String rep. * numBytes must be non-negative. * * Results: * None. * * Side effects: * objPtr's string rep is reallocated (by TCL STRING GROWTH ALGORITHM). * *---------------------------------------------------------------------- */ static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append. */ int numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; int newLength, oldLength; if (numBytes == 0) { return; } /* * Copy the new string onto the end of the old string, then add the * trailing null. */ if (objPtr->bytes == NULL) { objPtr->length = 0; } oldLength = objPtr->length; if (numBytes > INT_MAX - oldLength) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } newLength = numBytes + oldLength; stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { int offset = -1; /* * Protect against case where unicode points into the existing * stringPtr->unicode array. Force it to follow any relocations due to * the reallocs below. */ if (bytes && objPtr->bytes && (bytes >= objPtr->bytes) && (bytes <= objPtr->bytes + objPtr->length)) { offset = bytes - objPtr->bytes; } /* * TODO: consider passing flag=1: no overalloc on first append. This * would make test stringObj-8.1 fail. */ GrowStringBuffer(objPtr, newLength, 0); /* * Relocate bytes if needed; see above. */ if (offset >= 0) { bytes = objPtr->bytes + offset; } } /* * Invalidate the unicode data. */ stringPtr->numChars = -1; stringPtr->hasUnicode = 0; if (bytes) { memmove(objPtr->bytes + oldLength, bytes, numBytes); } objPtr->bytes[newLength] = 0; objPtr->length = newLength; } /* *---------------------------------------------------------------------- * * TclAppendUtfToUtf -- * * This function appends "numBytes" bytes of "bytes" to the UTF string * rep of "objPtr" (objPtr's internal rep converted to string on demand). * numBytes must be non-negative. * * Results: * None. * * Side effects: * objPtr's string rep is reallocated (by TCL STRING GROWTH ALGORITHM). * *---------------------------------------------------------------------- */ void TclAppendUtfToUtf( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append (or NULL to enlarge buffer). */ int numBytes) /* Number of bytes of "bytes" to append. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "TclAppendUtfToUtf"); } SetStringFromAny(NULL, objPtr); AppendUtfToUtfRep(objPtr, bytes, numBytes); } /* *---------------------------------------------------------------------- * * Tcl_AppendStringsToObjVA -- * * This function appends one or more null-terminated strings to an * object. * * Results: * None. * * Side effects: * The contents of all the string arguments are appended to the string * representation of objPtr. * *---------------------------------------------------------------------- */ void Tcl_AppendStringsToObjVA( Tcl_Obj *objPtr, /* Points to the object to append to. */ va_list argList) /* Variable argument list. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); } while (1) { const char *bytes = va_arg(argList, char *); if (bytes == NULL) { break; } Tcl_AppendToObj(objPtr, bytes, -1); } } /* *---------------------------------------------------------------------- * * Tcl_AppendStringsToObj -- * * This function appends one or more null-terminated strings to an * object. * * Results: * None. * * Side effects: * The contents of all the string arguments are appended to the string * representation of objPtr. * *---------------------------------------------------------------------- */ void Tcl_AppendStringsToObj( Tcl_Obj *objPtr, ...) { va_list argList; va_start(argList, objPtr); Tcl_AppendStringsToObjVA(objPtr, argList); va_end(argList); } /* *---------------------------------------------------------------------- * * Tcl_AppendFormatToObj -- * * This function appends a list of Tcl_Obj's to a Tcl_Obj according to * the formatting instructions embedded in the format string. The * formatting instructions are inspired by sprintf(). Returns TCL_OK when * successful. If there's an error in the arguments, TCL_ERROR is * returned, and an error message is written to the interp, if non-NULL. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_AppendFormatToObj( Tcl_Interp *interp, Tcl_Obj *appendObj, const char *format, int objc, Tcl_Obj *const objv[]) { const char *span = format, *msg, *errCode; int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; int originalLength, limit; Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; static const char *const badIndex[2] = { "not enough arguments for all format specifiers", "\"%n$\" argument index out of range" }; static const char *overflow = "max size for a Tcl value exceeded"; if (Tcl_IsShared(appendObj)) { Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } TclGetStringFromObj(appendObj, &originalLength); limit = INT_MAX - originalLength; /* * Format string is NUL-terminated. */ while (*format != '\0') { char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0; #ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; #endif int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); format += step; if (ch != '%') { numBytes += step; continue; } if (numBytes) { if (numBytes > limit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendToObj(appendObj, span, numBytes); limit -= numBytes; numBytes = 0; } /* * Saw a % : process the format specifier. * * Step 0. Handle special case of escaped format marker (i.e., %%). */ step = TclUtfToUniChar(format, &ch); if (ch == '%') { span = format; numBytes = step; format += step; continue; } /* * Step 1. XPG3 position specifier */ newXpg = 0; if (isdigit(UCHAR(ch))) { int position = strtoul(format, &end, 10); if (*end == '$') { newXpg = 1; objIndex = position - 1; format = end + 1; step = TclUtfToUniChar(format, &ch); } } if (newXpg) { if (gotSequential) { msg = mixedXPG; errCode = "MIXEDSPECTYPES"; goto errorMsg; } gotXpg = 1; } else { if (gotXpg) { msg = mixedXPG; errCode = "MIXEDSPECTYPES"; goto errorMsg; } gotSequential = 1; } if ((objIndex < 0) || (objIndex >= objc)) { msg = badIndex[gotXpg]; errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } /* * Step 2. Set of flags. */ sawFlag = 1; do { switch (ch) { case '-': gotMinus = 1; break; case '#': gotHash = 1; break; case '0': gotZero = 1; break; case ' ': gotSpace = 1; break; case '+': gotPlus = 1; break; default: sawFlag = 0; } if (sawFlag) { format += step; step = TclUtfToUniChar(format, &ch); } } while (sawFlag); /* * Step 3. Minimum field width. */ width = 0; if (isdigit(UCHAR(ch))) { width = strtoul(format, &end, 10); if (width < 0) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { if (objIndex >= objc - 1) { msg = badIndex[gotXpg]; errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { goto error; } if (width < 0) { width = -width; gotMinus = 1; } objIndex++; format += step; step = TclUtfToUniChar(format, &ch); } if (width > limit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } /* * Step 4. Precision. */ gotPrecision = precision = 0; if (ch == '.') { gotPrecision = 1; format += step; step = TclUtfToUniChar(format, &ch); } if (isdigit(UCHAR(ch))) { precision = strtoul(format, &end, 10); format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { if (objIndex >= objc - 1) { msg = badIndex[gotXpg]; errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } if (TclGetIntFromObj(interp, objv[objIndex], &precision) != TCL_OK) { goto error; } /* * TODO: Check this truncation logic. */ if (precision < 0) { precision = 0; } objIndex++; format += step; step = TclUtfToUniChar(format, &ch); } /* * Step 5. Length modifier. */ if (ch == 'h') { useShort = 1; format += step; step = TclUtfToUniChar(format, &ch); } else if (ch == 'l') { format += step; step = TclUtfToUniChar(format, &ch); if (ch == 'l') { useBig = 1; format += step; step = TclUtfToUniChar(format, &ch); #ifndef TCL_WIDE_INT_IS_LONG } else { useWide = 1; #endif } } format += step; span = format; /* * Step 6. The actual conversion character. */ segment = objv[objIndex]; numChars = -1; if (ch == 'i') { ch = 'd'; } switch (ch) { case '\0': msg = "format string ended in middle of field specifier"; errCode = "INCOMPLETE"; goto errorMsg; case 's': if (gotPrecision) { numChars = Tcl_GetCharLength(segment); if (precision < numChars) { if (precision < 1) { TclNewObj(segment); } else { segment = Tcl_GetRange(segment, 0, precision - 1); } numChars = precision; Tcl_IncrRefCount(segment); allocSegment = 1; } } break; case 'c': { char buf[4] = ""; int code, length; if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) { goto error; } length = Tcl_UniCharToUtf(code, buf); #if TCL_UTF_MAX > 3 if ((code >= 0xD800) && (length < 3)) { /* Special case for handling high surrogates. */ length += Tcl_UniCharToUtf(-1, buf + length); } #endif segment = Tcl_NewStringObj(buf, length); Tcl_IncrRefCount(segment); allocSegment = 1; break; } case 'u': if (useBig) { msg = "unsigned bignum format is invalid"; errCode = "BADUNSIGNED"; goto errorMsg; } /* FALLTHRU */ case 'd': case 'o': case 'x': case 'X': case 'b': { short s = 0; /* Silence compiler warning; only defined and * used when useShort is true. */ long l; Tcl_WideInt w; mp_int big; int toAppend, isNegative = 0; if (useBig) { if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { goto error; } isNegative = (mp_cmp_d(&big, 0) == MP_LT); #ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { Tcl_Obj *objPtr; if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { goto error; } mp_mod_2d(&big, CHAR_BIT*sizeof(Tcl_WideInt), &big); objPtr = Tcl_NewBignumObj(&big); Tcl_IncrRefCount(objPtr); Tcl_GetWideIntFromObj(NULL, objPtr, &w); Tcl_DecrRefCount(objPtr); } isNegative = (w < (Tcl_WideInt) 0); #endif } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { Tcl_Obj *objPtr; if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { goto error; } mp_mod_2d(&big, CHAR_BIT * sizeof(long), &big); objPtr = Tcl_NewBignumObj(&big); Tcl_IncrRefCount(objPtr); TclGetLongFromObj(NULL, objPtr, &l); Tcl_DecrRefCount(objPtr); } else { l = Tcl_WideAsLong(w); } if (useShort) { s = (short) l; isNegative = (s < (short) 0); } else { isNegative = (l < (long) 0); } } else if (useShort) { s = (short) l; isNegative = (s < (short) 0); } else { isNegative = (l < (long) 0); } TclNewObj(segment); allocSegment = 1; segmentLimit = INT_MAX; Tcl_IncrRefCount(segment); if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) { Tcl_AppendToObj(segment, (isNegative ? "-" : gotPlus ? "+" : " "), 1); segmentLimit -= 1; } if (gotHash) { switch (ch) { case 'o': Tcl_AppendToObj(segment, "0", 1); segmentLimit -= 1; precision--; break; case 'X': Tcl_AppendToObj(segment, "0X", 2); segmentLimit -= 2; break; case 'x': Tcl_AppendToObj(segment, "0x", 2); segmentLimit -= 2; break; case 'b': Tcl_AppendToObj(segment, "0b", 2); segmentLimit -= 2; break; } } switch (ch) { case 'd': { int length; Tcl_Obj *pure; const char *bytes; if (useShort) { TclNewIntObj(pure, (int) s); #ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { pure = Tcl_NewWideIntObj(w); #endif } else if (useBig) { pure = Tcl_NewBignumObj(&big); } else { pure = Tcl_NewLongObj(l); } Tcl_IncrRefCount(pure); bytes = TclGetStringFromObj(pure, &length); /* * Already did the sign above. */ if (*bytes == '-') { length--; bytes++; } toAppend = length; /* * Canonical decimal string reps for integers are composed * entirely of one-byte encoded characters, so "length" is the * number of chars. */ if (gotPrecision) { if (length < precision) { segmentLimit -= precision - length; } while (length < precision) { Tcl_AppendToObj(segment, "0", 1); length++; } gotZero = 0; } if (gotZero) { length += Tcl_GetCharLength(segment); if (length < width) { segmentLimit -= width - length; } while (length < width) { Tcl_AppendToObj(segment, "0", 1); length++; } } if (toAppend > segmentLimit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendToObj(segment, bytes, toAppend); Tcl_DecrRefCount(pure); break; } case 'u': case 'o': case 'x': case 'X': case 'b': { Tcl_WideUInt bits = (Tcl_WideUInt) 0; Tcl_WideInt numDigits = (Tcl_WideInt) 0; int length, numBits = 4, base = 16, index = 0, shift = 0; Tcl_Obj *pure; char *bytes; if (ch == 'u') { base = 10; } else if (ch == 'o') { base = 8; numBits = 3; } else if (ch == 'b') { base = 2; numBits = 1; } if (useShort) { unsigned short us = (unsigned short) s; bits = (Tcl_WideUInt) us; while (us) { numDigits++; us /= base; } #ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { Tcl_WideUInt uw = (Tcl_WideUInt) w; bits = uw; while (uw) { numDigits++; uw /= base; } #endif } else if (useBig && big.used) { int leftover = (big.used * MP_DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); numDigits = 1 + (((Tcl_WideInt) big.used * MP_DIGIT_BIT) / numBits); while ((mask & big.dp[big.used-1]) == 0) { numDigits--; mask >>= numBits; } if (numDigits > INT_MAX) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } } else if (!useBig) { unsigned long ul = (unsigned long) l; bits = (Tcl_WideUInt) ul; while (ul) { numDigits++; ul /= base; } } /* * Need to be sure zero becomes "0", not "". */ if ((numDigits == 0) && !((ch == 'o') && gotHash)) { numDigits = 1; } TclNewObj(pure); Tcl_SetObjLength(pure, (int) numDigits); bytes = TclGetString(pure); toAppend = length = (int) numDigits; while (numDigits--) { int digitOffset; if (useBig && big.used) { if (index < big.used && (size_t) shift < CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) { bits |= ((Tcl_WideUInt) big.dp[index++]) << shift; shift += MP_DIGIT_BIT; } shift -= numBits; } digitOffset = (int) (bits % base); if (digitOffset > 9) { if (ch == 'X') { bytes[numDigits] = 'A' + digitOffset - 10; } else { bytes[numDigits] = 'a' + digitOffset - 10; } } else { bytes[numDigits] = '0' + digitOffset; } bits /= base; } if (useBig) { mp_clear(&big); } if (gotPrecision) { if (length < precision) { segmentLimit -= precision - length; } while (length < precision) { Tcl_AppendToObj(segment, "0", 1); length++; } gotZero = 0; } if (gotZero) { length += Tcl_GetCharLength(segment); if (length < width) { segmentLimit -= width - length; } while (length < width) { Tcl_AppendToObj(segment, "0", 1); length++; } } if (toAppend > segmentLimit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendObjToObj(segment, pure); Tcl_DecrRefCount(pure); break; } } break; } case 'e': case 'E': case 'f': case 'g': case 'G': { #define MAX_FLOAT_SIZE 320 char spec[2*TCL_INTEGER_SPACE + 9], *p = spec; double d; int length = MAX_FLOAT_SIZE; char *bytes; if (Tcl_GetDoubleFromObj(interp, segment, &d) != TCL_OK) { /* TODO: Figure out ACCEPT_NAN here */ goto error; } *p++ = '%'; if (gotMinus) { *p++ = '-'; } if (gotHash) { *p++ = '#'; } if (gotZero) { *p++ = '0'; } if (gotSpace) { *p++ = ' '; } if (gotPlus) { *p++ = '+'; } if (width) { p += snprintf(p, TCL_INTEGER_SPACE, "%d", width); if (width > length) { length = width; } } if (gotPrecision) { *p++ = '.'; p += snprintf(p, TCL_INTEGER_SPACE, "%d", precision); if (precision > INT_MAX - length) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } length += precision; } /* * Don't pass length modifiers! */ *p++ = (char) ch; *p = '\0'; TclNewObj(segment); allocSegment = 1; if (!Tcl_AttemptSetObjLength(segment, length)) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } bytes = TclGetString(segment); if (!Tcl_AttemptSetObjLength(segment, snprintf(bytes, segment->length, spec, d))) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } break; } default: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); } goto error; } if (width>0 && numChars<0) { numChars = Tcl_GetCharLength(segment); } if (!gotMinus && width>0) { if (numChars < width) { limit -= width - numChars; } while (numChars < width) { Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); numChars++; } } TclGetStringFromObj(segment, &segmentNumBytes); if (segmentNumBytes > limit) { if (allocSegment) { Tcl_DecrRefCount(segment); } msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendObjToObj(appendObj, segment); limit -= segmentNumBytes; if (allocSegment) { Tcl_DecrRefCount(segment); } if (width > 0) { if (numChars < width) { limit -= width-numChars; } while (numChars < width) { Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); numChars++; } } objIndex += gotSequential; } if (numBytes) { if (numBytes > limit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendToObj(appendObj, span, numBytes); limit -= numBytes; numBytes = 0; } return TCL_OK; errorMsg: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL); } error: Tcl_SetObjLength(appendObj, originalLength); return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * Tcl_Format -- * * Results: * A refcount zero Tcl_Obj. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_Format( Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]) { int result; Tcl_Obj *objPtr; TclNewObj(objPtr); result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv); if (result != TCL_OK) { Tcl_DecrRefCount(objPtr); return NULL; } return objPtr; } /* *--------------------------------------------------------------------------- * * AppendPrintfToObjVA -- * * Results: * * Side effects: * *--------------------------------------------------------------------------- */ static Tcl_Obj * NewLongObj( char c, long value) { if ((value < 0) && strchr("puoxX", c)) { #ifdef TCL_WIDE_INT_IS_LONG mp_int bignumValue; mp_init_u64(&bignumValue, (unsigned long)value); return Tcl_NewBignumObj(&bignumValue); #else return Tcl_NewWideIntObj((unsigned long)value | ~(unsigned long)LONG_MAX); #endif } return Tcl_NewLongObj(value); } static void AppendPrintfToObjVA( Tcl_Obj *objPtr, const char *format, va_list argList) { int code, objc; Tcl_Obj **objv, *list; const char *p; TclNewObj(list); p = format; Tcl_IncrRefCount(list); while (*p != '\0') { int size = 0, seekingConversion = 1, gotPrecision = 0; int lastNum = -1; if (*p++ != '%') { continue; } if (*p == '%') { p++; continue; } do { switch (*p) { case '\0': seekingConversion = 0; break; case 's': { const char *q, *end, *bytes = va_arg(argList, char *); seekingConversion = 0; /* * The buffer to copy characters from starts at bytes and ends * at either the first NUL byte, or after lastNum bytes, when * caller has indicated a limit. */ end = bytes; while ((!gotPrecision || lastNum--) && (*end != '\0')) { end++; } /* * Within that buffer, we trim both ends if needed so that we * copy only whole characters, and avoid copying any partial * multi-byte characters. */ q = TclUtfPrev(end, bytes); if (!Tcl_UtfCharComplete(q, (int)(end - q))) { end = q; } q = bytes + TCL_UTF_MAX; while ((bytes < end) && (bytes < q) && ((*bytes & 0xC0) == 0x80)) { bytes++; } Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(bytes , (int)(end - bytes))); break; } case 'c': case 'i': case 'u': case 'd': case 'o': case 'x': case 'X': seekingConversion = 0; switch (size) { case -1: case 0: Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( (long)va_arg(argList, int))); break; case 1: Tcl_ListObjAppendElement(NULL, list, NewLongObj(*p, va_arg(argList, long))); break; } break; case 'e': case 'E': case 'f': case 'g': case 'G': Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( va_arg(argList, double))); seekingConversion = 0; break; case '*': lastNum = (int) va_arg(argList, int); Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum)); p++; break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { char *end; lastNum = (int) strtoul(p, &end, 10); p = end; break; } case '.': gotPrecision = 1; p++; break; /* TODO: support for wide (and bignum?) arguments */ case 'l': size = 1; p++; break; case 'h': size = -1; /* FALLTHRU */ default: p++; } } while (seekingConversion); } TclListObjGetElements(NULL, list, &objc, &objv); code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); if (code != TCL_OK) { Tcl_AppendPrintfToObj(objPtr, "Unable to format \"%s\" with supplied arguments: %s", format, Tcl_GetString(list)); } Tcl_DecrRefCount(list); } /* *--------------------------------------------------------------------------- * * Tcl_AppendPrintfToObj -- * * Results: * A standard Tcl result. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void Tcl_AppendPrintfToObj( Tcl_Obj *objPtr, const char *format, ...) { va_list argList; va_start(argList, format); AppendPrintfToObjVA(objPtr, format, argList); va_end(argList); } /* *--------------------------------------------------------------------------- * * Tcl_ObjPrintf -- * * Results: * A refcount zero Tcl_Obj. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjPrintf( const char *format, ...) { va_list argList; Tcl_Obj *objPtr; TclNewObj(objPtr); va_start(argList, format); AppendPrintfToObjVA(objPtr, format, argList); va_end(argList); return objPtr; } /* *--------------------------------------------------------------------------- * * TclGetStringStorage -- * * Returns the string storage space of a Tcl_Obj. * * Results: * The pointer value objPtr->bytes is returned and the number of bytes * allocated there is written to *sizePtr (if known). * * Side effects: * May set objPtr->bytes. * *--------------------------------------------------------------------------- */ char * TclGetStringStorage( Tcl_Obj *objPtr, unsigned int *sizePtr) { String *stringPtr; if (objPtr->typePtr != &tclStringType || objPtr->bytes == NULL) { return TclGetStringFromObj(objPtr, (int *)sizePtr); } stringPtr = GET_STRING(objPtr); *sizePtr = stringPtr->allocated; return objPtr->bytes; } /* *--------------------------------------------------------------------------- * * TclStringReverse -- * * Implements the [string reverse] operation. * * Results: * An unshared Tcl value which is the [string reverse] of the argument * supplied. When sharing rules permit, the returned value might be the * argument with modifications done in place. * * Side effects: * May allocate a new Tcl_Obj. * *--------------------------------------------------------------------------- */ static void ReverseBytes( unsigned char *to, /* Copy bytes into here... */ unsigned char *from, /* ...from here... */ int count) /* Until this many are copied, */ /* reversing as you go. */ { unsigned char *src = from + count; if (to == from) { /* Reversing in place */ while (--src > to) { unsigned char c = *src; *src = *to; *to++ = c; } } else { while (--src >= from) { *to++ = *src; } } } Tcl_Obj * TclStringReverse( Tcl_Obj *objPtr) { String *stringPtr; Tcl_UniChar ch = 0; #if TCL_UTF_MAX <= 4 int needFlip = 0; #endif if (TclIsPureByteArray(objPtr)) { int numBytes; unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); } ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes); return objPtr; } SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode) { Tcl_UniChar *from = Tcl_GetUnicode(objPtr); Tcl_UniChar *src = from + stringPtr->numChars; Tcl_UniChar *to; if (Tcl_IsShared(objPtr)) { /* * Create a non-empty, pure Unicode value, so we can coax * Tcl_SetObjLength into growing the Unicode rep buffer. */ objPtr = Tcl_NewUnicodeObj(&ch, 1); Tcl_SetObjLength(objPtr, stringPtr->numChars); to = Tcl_GetUnicode(objPtr); while (--src >= from) { #if TCL_UTF_MAX <= 4 ch = *src; if ((ch & 0xF800) == 0xD800) { needFlip = 1; } *to++ = ch; #else *to++ = *src; #endif } } else { /* * Reversing in place. */ #if TCL_UTF_MAX <= 4 to = src; #endif while (--src > from) { ch = *src; #if TCL_UTF_MAX <= 4 if ((ch & 0xF800) == 0xD800) { needFlip = 1; } #endif *src = *from; *from++ = ch; } } #if TCL_UTF_MAX <= 4 if (needFlip) { /* * Flip back surrogate pairs. */ from = to - stringPtr->numChars; while (--to >= from) { ch = *to; if ((ch & 0xFC00) == 0xD800) { if ((to-1 >= from) && ((to[-1] & 0xFC00) == 0xDC00)) { to[0] = to[-1]; to[-1] = ch; --to; } } } } #endif } if (objPtr->bytes) { int numChars = stringPtr->numChars; int numBytes = objPtr->length; char *to, *from = objPtr->bytes; if (Tcl_IsShared(objPtr)) { TclNewObj(objPtr); Tcl_SetObjLength(objPtr, numBytes); } to = objPtr->bytes; if (numChars < numBytes) { /* * Either numChars == -1 and we don't know how many chars are * represented by objPtr->bytes and we need Pass 1 just in case, * or numChars >= 0 and we know we have fewer chars than bytes, so * we know there's a multibyte character needing Pass 1. * * Pass 1. Reverse the bytes of each multi-byte character. */ int bytesLeft = numBytes; int chw; while (bytesLeft) { /* * NOTE: We know that the from buffer is NUL-terminated. It's * part of the contract for objPtr->bytes values. Thus, we can * skip calling Tcl_UtfCharComplete() here. */ int bytesInChar = TclUtfToUCS4(from, &chw); ReverseBytes((unsigned char *)to, (unsigned char *)from, bytesInChar); to += bytesInChar; from += bytesInChar; bytesLeft -= bytesInChar; } from = to = objPtr->bytes; } /* Pass 2. Reverse all the bytes. */ ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes); } return objPtr; } /* *--------------------------------------------------------------------------- * * FillUnicodeRep -- * * Populate the Unicode internal rep with the Unicode form of its string * rep. The object must already have a "String" internal rep. * * Results: * None. * * Side effects: * Reallocates the String internal rep. * *--------------------------------------------------------------------------- */ static void FillUnicodeRep( Tcl_Obj *objPtr) /* The object in which to fill the unicode * rep. */ { String *stringPtr = GET_STRING(objPtr); ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length, stringPtr->numChars); } static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, int numBytes, int numAppendChars) { String *stringPtr = GET_STRING(objPtr); int needed, numOrigChars = 0; Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; } if (numAppendChars == -1) { TclNumUtfChars(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; stringCheckLimits(needed); if (needed > stringPtr->maxChars) { GrowUnicodeBuffer(objPtr, needed); stringPtr = GET_STRING(objPtr); } stringPtr->hasUnicode = 1; if (bytes) { stringPtr->numChars = needed; } else { numAppendChars = 0; } for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) { bytes += TclUtfToUniChar(bytes, &unichar); *dst = unichar; } *dst = 0; } /* *---------------------------------------------------------------------- * * DupStringInternalRep -- * * Initialize the internal representation of a new Tcl_Obj to a copy of * the internal representation of an existing string object. * * Results: * None. * * Side effects: * copyPtr's internal rep is set to a copy of srcPtr's internal * representation. * *---------------------------------------------------------------------- */ static void DupStringInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "String". */ Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { String *srcStringPtr = GET_STRING(srcPtr); String *copyStringPtr = NULL; #if COMPAT==0 if (srcStringPtr->numChars == -1) { /* * The String struct in the source value holds zero useful data. Don't * bother copying it. Don't even bother allocating space in which to * copy it. Just let the copy be untyped. */ return; } if (srcStringPtr->hasUnicode) { int copyMaxChars; if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) { copyMaxChars = 2 * srcStringPtr->numChars; } else { copyMaxChars = srcStringPtr->maxChars; } copyStringPtr = stringAttemptAlloc(copyMaxChars); if (copyStringPtr == NULL) { copyMaxChars = srcStringPtr->numChars; copyStringPtr = stringAlloc(copyMaxChars); } copyStringPtr->maxChars = copyMaxChars; memcpy(copyStringPtr->unicode, srcStringPtr->unicode, srcStringPtr->numChars * sizeof(Tcl_UniChar)); copyStringPtr->unicode[srcStringPtr->numChars] = 0; } else { copyStringPtr = stringAlloc(0); copyStringPtr->maxChars = 0; copyStringPtr->unicode[0] = 0; } copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; copyStringPtr->numChars = srcStringPtr->numChars; /* * Tricky point: the string value was copied by generic object management * code, so it doesn't contain any extra bytes that might exist in the * source object. */ copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0; #else /* COMPAT!=0 */ /* * If the src obj is a string of 1-byte Utf chars, then copy the string * rep of the source object and create an "empty" Unicode internal rep for * the new object. Otherwise, copy Unicode internal rep, and invalidate * the string rep of the new object. */ if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) { /* * Copy the full allocation for the Unicode buffer. */ copyStringPtr = stringAlloc(srcStringPtr->maxChars); copyStringPtr->maxChars = srcStringPtr->maxChars; memcpy(copyStringPtr->unicode, srcStringPtr->unicode, srcStringPtr->numChars * sizeof(Tcl_UniChar)); copyStringPtr->unicode[srcStringPtr->numChars] = 0; copyStringPtr->allocated = 0; } else { copyStringPtr = stringAlloc(0); copyStringPtr->unicode[0] = 0; copyStringPtr->maxChars = 0; /* * Tricky point: the string value was copied by generic object * management code, so it doesn't contain any extra bytes that might * exist in the source object. */ copyStringPtr->allocated = copyPtr->length; } copyStringPtr->numChars = srcStringPtr->numChars; copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; #endif /* COMPAT==0 */ SET_STRING(copyPtr, copyStringPtr); copyPtr->typePtr = &tclStringType; } /* *---------------------------------------------------------------------- * * SetStringFromAny -- * * Create an internal representation of type "String" for an object. * * Results: * This operation always succeeds and returns TCL_OK. * * Side effects: * Any old internal representation for objPtr is freed and the internal * representation is set to "String". * *---------------------------------------------------------------------- */ static int SetStringFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { if (objPtr->typePtr != &tclStringType) { String *stringPtr = stringAlloc(0); /* * Convert whatever we have into an untyped value. Just A String. */ (void) TclGetString(objPtr); TclFreeIntRep(objPtr); /* * Create a basic String internalrep that just points to the UTF-8 string * already in place at objPtr->bytes. */ stringPtr->numChars = -1; stringPtr->allocated = objPtr->length; stringPtr->maxChars = 0; stringPtr->hasUnicode = 0; SET_STRING(objPtr, stringPtr); objPtr->typePtr = &tclStringType; } return TCL_OK; } /* *---------------------------------------------------------------------- * * UpdateStringOfString -- * * Update the string representation for an object whose internal * representation is "String". * * Results: * None. * * Side effects: * The object's string may be set by converting its Unicode representation * to UTF format. * *---------------------------------------------------------------------- */ static void UpdateStringOfString( Tcl_Obj *objPtr) /* Object with string rep to update. */ { String *stringPtr = GET_STRING(objPtr); /* * This routine is only called when we need to generate the * string rep objPtr->bytes because it does not exist -- it is NULL. * In that circumstance, any lingering claim about the size of * memory pointed to by that NULL pointer is clearly bogus, and * needs a reset. */ stringPtr->allocated = 0; if (stringPtr->numChars == 0) { TclInitStringRep(objPtr, tclEmptyStringRep, 0); } else { (void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode, stringPtr->numChars); } } static int ExtendStringRepWithUnicode( Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars) { /* * Precondition: this is the "string" Tcl_ObjType. */ int i, origLength, size = 0; char *dst, buf[4] = ""; String *stringPtr = GET_STRING(objPtr); if (numChars < 0) { numChars = UnicodeLength(unicode); } if (numChars == 0) { return 0; } if (objPtr->bytes == NULL) { objPtr->length = 0; } size = origLength = objPtr->length; /* * Quick cheap check in case we have more than enough room. */ if (numChars <= (INT_MAX - size)/TCL_UTF_MAX && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) { goto copyBytes; } for (i = 0; i < numChars && size >= 0; i++) { size += (unsigned int)Tcl_UniCharToUtf((int) unicode[i], buf); } if (size < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } /* * Grow space if needed. */ if (size > stringPtr->allocated) { GrowStringBuffer(objPtr, size, 1); } copyBytes: dst = objPtr->bytes + origLength; for (i = 0; i < numChars; i++) { dst += Tcl_UniCharToUtf(unicode[i], dst); } *dst = '\0'; objPtr->length = dst - objPtr->bytes; return numChars; } /* *---------------------------------------------------------------------- * * FreeStringInternalRep -- * * Deallocate the storage associated with a String data object's internal * representation. * * Results: * None. * * Side effects: * Frees memory. * *---------------------------------------------------------------------- */ static void FreeStringInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { ckfree(GET_STRING(objPtr)); objPtr->typePtr = NULL; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclStringRep.h0000644000175000017500000001017514554262142016053 0ustar sergeisergei/* * tclStringRep.h -- * * This file contains the definition of the Unicode string internal * representation and macros to access it. * * A Unicode string is an internationalized string. Conceptually, a * Unicode string is an array of 16-bit quantities organized as a * sequence of properly formed UTF-8 characters. There is a one-to-one * map between Unicode and UTF characters. Because Unicode characters * have a fixed width, operations such as indexing operate on Unicode * data. The String object is optimized for the case where each UTF char * in a string is only one byte. In this case, we store the value of * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode * is explicitly called). * * The String object type stores one or both formats. The default * behavior is to store UTF. Once Unicode is calculated by a function, it * is stored in the internal rep for future access (without an additional * O(n) cost). * * To allow many appends to be done to an object without constantly * reallocating the space for the string or Unicode representation, we * allocate double the space for the string or Unicode and use the * internal representation to keep track of how much space is used vs. * allocated. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * The following structure is the internal rep for a String object. It keeps * track of how much memory has been used and how much has been allocated for * the Unicode and UTF string to enable growing and shrinking of the UTF and * Unicode reps of the String object with fewer mallocs. To optimize string * length and indexing operations, this structure also stores the number of * characters (same of UTF and Unicode!) once that value has been computed. * * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This * can be officially modified by altering the definition of Tcl_UniChar in * tcl.h, but do not do that unless you are sure what you're doing! */ typedef struct String { int numChars; /* The number of chars in the string. -1 means * this value has not been calculated. >= 0 * means that there is a valid Unicode rep, or * that the number of UTF bytes == the number * of chars. */ int allocated; /* The amount of space actually allocated for * the UTF string (minus 1 byte for the * termination char). */ int maxChars; /* Max number of chars that can fit in the * space allocated for the Unicode array. */ int hasUnicode; /* Boolean determining whether the string has * a Unicode representation. */ Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size * of this field depends on the 'maxChars' * field above. */ } String; #define STRING_MAXCHARS \ (int)(((size_t)UINT_MAX - TclOffset(String, unicode))/sizeof(Tcl_UniChar) - 1) #define STRING_SIZE(numChars) \ (TclOffset(String, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar))) #define stringCheckLimits(numChars) \ do { \ if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ STRING_MAXCHARS); \ } \ } while (0) #define stringAttemptAlloc(numChars) \ (String *) attemptckalloc((unsigned) STRING_SIZE(numChars)) #define stringAlloc(numChars) \ (String *) ckalloc((unsigned) STRING_SIZE(numChars)) #define stringRealloc(ptr, numChars) \ (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars)) #define stringAttemptRealloc(ptr, numChars) \ (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars)) #define GET_STRING(objPtr) \ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclStringTrim.h0000644000175000017500000000236214554262142016237 0ustar sergeisergei/* * tclStringTrim.h -- * * This file contains the definition of what characters are to be trimmed * from a string by [string trim] by default. It's only needed by Tcl's * implementation; it does not form a public or private API at all. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * Copyright (c) 2002 ActiveState Corporation. * Copyright (c) 2003-2013 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef TCL_STRING_TRIM_H #define TCL_STRING_TRIM_H /* * Default set of characters to trim in [string trim] and friends. This is a * UTF-8 literal string containing all Unicode space characters. [TIP #413] */ MODULE_SCOPE const char tclDefaultTrimSet[]; /* * The whitespace trimming set used when [concat]enating. This is a subset of * the above, and deliberately so. * * TODO: Find a reasonable way to guarantee in sync with TclIsSpaceProc() */ #define CONCAT_TRIM_SET " \f\v\r\t\n" #endif /* TCL_STRING_TRIM_H */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclStrToD.c0000644000175000017500000041635014554262142015315 0ustar sergeisergei/* * tclStrToD.c -- * * This file contains a collection of procedures for managing conversions * to/from floating-point in Tcl. They include TclParseNumber, which * parses numbers from strings; TclDoubleDigits, which formats numbers * into strings of digits, and procedures for interconversion among * 'double' and 'mp_int' types. * * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #include #include #ifdef _WIN32 #define copysign _copysign #endif /* * Define KILL_OCTAL to suppress interpretation of numbers with leading zero * as octal. (Ceterum censeo: numeros octonarios delendos esse.) */ #undef KILL_OCTAL /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be * uniquely determined by radix and by the widths of significand and exponent. */ #if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024) # define IEEE_FLOATING_POINT #endif /* * Rounding controls. (Thanks a lot, Intel!) */ #ifdef __i386 /* * gcc on x86 needs access to rounding controls, because of a questionable * feature where it retains intermediate results as IEEE 'long double' values * somewhat unpredictably. It is tempting to include fpu_control.h, but that * file exists only on Linux; it is missing on Cygwin and MinGW. Most gcc-isms * and ix86-isms are factored out here. */ # if defined(__GNUC__) typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__))); # define _FPU_GETCW(cw) __asm__ __volatile__ ("fnstcw %0" : "=m" (*&cw)) # define _FPU_SETCW(cw) __asm__ __volatile__ ("fldcw %0" : : "m" (*&cw)) # define FPU_IEEE_ROUNDING 0x027F # define ADJUST_FPU_CONTROL_WORD # define TCL_IEEE_DOUBLE_ROUNDING_DECL \ fpu_control_t roundTo53Bits = FPU_IEEE_ROUNDING; \ fpu_control_t oldRoundingMode; # define TCL_IEEE_DOUBLE_ROUNDING \ _FPU_GETCW(oldRoundingMode); \ _FPU_SETCW(roundTo53Bits) # define TCL_DEFAULT_DOUBLE_ROUNDING \ _FPU_SETCW(oldRoundingMode) /* * Sun ProC needs sunmath for rounding control on x86 like gcc above. */ # elif defined(__sun) # include # define TCL_IEEE_DOUBLE_ROUNDING_DECL # define TCL_IEEE_DOUBLE_ROUNDING \ ieee_flags("set","precision","double",NULL) # define TCL_DEFAULT_DOUBLE_ROUNDING \ ieee_flags("clear","precision",NULL,NULL) # endif #endif /* * Other platforms are assumed to always operate in full IEEE mode, so we make * the macros to go in and out of that mode do nothing. */ #ifndef TCL_IEEE_DOUBLE_ROUNDING /* !__i386 || (!__GNUC__ && !__sun) */ # define TCL_IEEE_DOUBLE_ROUNDING_DECL # define TCL_IEEE_DOUBLE_ROUNDING ((void) 0) # define TCL_DEFAULT_DOUBLE_ROUNDING ((void) 0) #endif /* * MIPS floating-point units need special settings in control registers to use * gradual underflow as we expect. This fix is for the MIPSpro compiler. */ #if defined(__sgi) && defined(_COMPILER_VERSION) #include #endif /* * HP's PA_RISC architecture uses 7ff4000000000000 to represent a quiet NaN. * Everyone else uses 7ff8000000000000. (Why, HP, why?) */ #ifdef __hppa # define NAN_START 0x7FF4 # define NAN_MASK (((Tcl_WideUInt) 1) << 50) #else # define NAN_START 0x7FF8 # define NAN_MASK (((Tcl_WideUInt) 1) << 51) #endif /* * Constants used by this file (most of which are only ever calculated at * runtime). */ /* Magic constants */ #define LOG10_2 0.3010299956639812 #define TWO_OVER_3LOG10 0.28952965460216784 #define LOG10_3HALVES_PLUS_FUDGE 0.1760912590558 /* * Definitions of the parts of an IEEE754-format floating point number. */ #define SIGN_BIT 0x80000000 /* Mask for the sign bit in the first word of * a double. */ #define EXP_MASK 0x7FF00000 /* Mask for the exponent field in the first * word of a double. */ #define EXP_SHIFT 20 /* Shift count to make the exponent an * integer. */ #define HIDDEN_BIT (((Tcl_WideUInt) 0x00100000) << 32) /* Hidden 1 bit for the significand. */ #define HI_ORDER_SIG_MASK 0x000FFFFF /* Mask for the high-order part of the * significand in the first word of a * double. */ #define SIG_MASK (((Tcl_WideUInt) HI_ORDER_SIG_MASK << 32) \ | 0xFFFFFFFF) /* Mask for the 52-bit significand. */ #define FP_PRECISION 53 /* Number of bits of significand plus the * hidden bit. */ #define EXPONENT_BIAS 0x3FF /* Bias of the exponent 0. */ /* * Derived quantities. */ #define TEN_PMAX 22 /* floor(FP_PRECISION*log(2)/log(5)) */ #define QUICK_MAX 14 /* floor((FP_PRECISION-1)*log(2)/log(10))-1 */ #define BLETCH 0x10 /* Highest power of two that is greater than * DBL_MAX_10_EXP, divided by 16. */ #define DIGIT_GROUP 8 /* floor(MP_DIGIT_BIT*log(2)/log(10)) */ /* * Union used to dismantle floating point numbers. */ typedef union Double { struct { #ifdef WORDS_BIGENDIAN int word0; int word1; #else int word1; int word0; #endif } w; double d; Tcl_WideUInt q; } Double; static int maxpow10_wide; /* The powers of ten that can be represented * exactly as wide integers. */ static Tcl_WideUInt *pow10_wide; #define MAXPOW 22 static double pow10vals[MAXPOW+1]; /* The powers of ten that can be represented * exactly as IEEE754 doubles. */ static int mmaxpow; /* Largest power of ten that can be * represented exactly in a 'double'. */ static int log10_DIGIT_MAX; /* The number of decimal digits that fit in an * mp_digit. */ static int log2FLT_RADIX; /* Logarithm of the floating point radix. */ static int mantBits; /* Number of bits in a double's significand */ static mp_int pow5[9]; /* Table of powers of 5**(2**n), up to * 5**256 */ static double tiny = 0.0; /* The smallest representable double. */ static int maxDigits; /* The maximum number of digits to the left of * the decimal point of a double. */ static int minDigits; /* The maximum number of digits to the right * of the decimal point in a double. */ static const double pow_10_2_n[] = { /* Inexact higher powers of ten. */ 1.0, 100.0, 10000.0, 1.0e+8, 1.0e+16, 1.0e+32, 1.0e+64, 1.0e+128, 1.0e+256 }; static int n770_fp; /* Flag is 1 on Nokia N770 floating point. * Nokia's floating point has the words * reversed: if big-endian is 7654 3210, * and little-endian is 0123 4567, * then Nokia's FP is 4567 0123; * little-endian within the 32-bit words but * big-endian between them. */ /* * Table of powers of 5 that are small enough to fit in an mp_digit. */ static const mp_digit dpow5[13] = { 1, 5, 25, 125, 625, 3125, 15625, 78125, 390625, 1953125, 9765625, 48828125, 244140625 }; /* * Table of powers: pow5_13[n] = 5**(13*2**(n+1)) */ static mp_int pow5_13[5]; /* Table of powers: 5**13, 5**26, 5**52, * 5**104, 5**208 */ static const double tens[] = { 1e00, 1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09, 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20, 1e21, 1e22 }; static const int itens [] = { 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000 }; static const double bigtens[] = { 1e016, 1e032, 1e064, 1e128, 1e256 }; #define N_BIGTENS 5 static const int log2pow5[27] = { 01, 3, 5, 7, 10, 12, 14, 17, 19, 21, 24, 26, 28, 31, 33, 35, 38, 40, 42, 45, 47, 49, 52, 54, 56, 59, 61 }; #define N_LOG2POW5 27 static const Tcl_WideUInt wuipow5[] = { (Tcl_WideUInt) 1U, /* 5**0 */ (Tcl_WideUInt) 5U, (Tcl_WideUInt) 25U, (Tcl_WideUInt) 125U, (Tcl_WideUInt) 625U, (Tcl_WideUInt) 3125U, /* 5**5 */ (Tcl_WideUInt) 3125U*5U, (Tcl_WideUInt) 3125U*25U, (Tcl_WideUInt) 3125U*125U, (Tcl_WideUInt) 3125U*625U, (Tcl_WideUInt) 3125U*3125U, /* 5**10 */ (Tcl_WideUInt) 3125U*3125U*5U, (Tcl_WideUInt) 3125U*3125U*25U, (Tcl_WideUInt) 3125U*3125U*125U, (Tcl_WideUInt) 3125U*3125U*625U, (Tcl_WideUInt) 3125U*3125U*3125U, /* 5**15 */ (Tcl_WideUInt) 3125U*3125U*3125U*5U, (Tcl_WideUInt) 3125U*3125U*3125U*25U, (Tcl_WideUInt) 3125U*3125U*3125U*125U, (Tcl_WideUInt) 3125U*3125U*3125U*625U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U, /* 5**20 */ (Tcl_WideUInt) 3125U*3125U*3125U*3125U*5U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U*25U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U*125U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U*625U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U, /* 5**25 */ (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*5U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*25U /* 5**27 */ }; /* * Static functions defined in this file. */ static int AccumulateDecimalDigit(unsigned, int, Tcl_WideUInt *, mp_int *, int); static double MakeHighPrecisionDouble(int signum, mp_int *significand, int nSigDigs, long exponent); static double MakeLowPrecisionDouble(int signum, Tcl_WideUInt significand, int nSigDigs, long exponent); #ifdef IEEE_FLOATING_POINT static double MakeNaN(int signum, Tcl_WideUInt tag); #endif static double RefineApproximation(double approx, mp_int *exactSignificand, int exponent); static void MulPow5(mp_int *, unsigned, mp_int *); static int NormalizeRightward(Tcl_WideUInt *); static int RequiredPrecision(Tcl_WideUInt); static void DoubleToExpAndSig(double, Tcl_WideUInt *, int *, int *); static void TakeAbsoluteValue(Double *, int *); static char * FormatInfAndNaN(Double *, int *, char **); static char * FormatZero(int *, char **); static int ApproximateLog10(Tcl_WideUInt, int, int); static int BetterLog10(double, int, int *); static void ComputeScale(int, int, int *, int *, int *, int *); static void SetPrecisionLimits(int, int, int *, int *, int *, int *); static char * BumpUp(char *, char *, int *); static int AdjustRange(double *, int); static char * ShorteningQuickFormat(double, int, int, double, char *, int *); static char * StrictQuickFormat(double, int, int, double, char *, int *); static char * QuickConversion(double, int, int, int, int, int, int, int *, char **); static void CastOutPowersOf2(int *, int *, int *); static char * ShorteningInt64Conversion(Double *, int, Tcl_WideUInt, int, int, int, int, int, int, int, int, int, int, int, int *, char **); static char * StrictInt64Conversion(Double *, int, Tcl_WideUInt, int, int, int, int, int, int, int, int, int *, char **); static int ShouldBankerRoundUpPowD(mp_int *, int, int); static int ShouldBankerRoundUpToNextPowD(mp_int *, mp_int *, int, int, int, mp_int *); static char * ShorteningBignumConversionPowD(Double *dPtr, int convType, Tcl_WideUInt bw, int b2, int b5, int m2plus, int m2minus, int m5, int sd, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static char * StrictBignumConversionPowD(Double *dPtr, int convType, Tcl_WideUInt bw, int b2, int b5, int sd, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static int ShouldBankerRoundUp(mp_int *, mp_int *, int); static int ShouldBankerRoundUpToNext(mp_int *, mp_int *, mp_int *, int, int, mp_int *); static char * ShorteningBignumConversion(Double *dPtr, int convType, Tcl_WideUInt bw, int b2, int m2plus, int m2minus, int s2, int s5, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static char * StrictBignumConversion(Double *dPtr, int convType, Tcl_WideUInt bw, int b2, int s2, int s5, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static double BignumToBiasedFrExp(const mp_int *big, int *machexp); static double Pow10TimesFrExp(int exponent, double fraction, int *machexp); static double SafeLdExp(double fraction, int exponent); #ifdef IEEE_FLOATING_POINT static Tcl_WideUInt Nokia770Twiddle(Tcl_WideUInt w); #endif /* *---------------------------------------------------------------------- * * TclParseNumber -- * * Scans bytes, interpreted as characters in Tcl's internal encoding, and * parses the longest prefix that is the string representation of a * number in a format recognized by Tcl. * * The arguments bytes, numBytes, and objPtr are the inputs which * determine the string to be parsed. If bytes is non-NULL, it points to * the first byte to be scanned. If bytes is NULL, then objPtr must be * non-NULL, and the string representation of objPtr will be scanned * (generated first, if necessary). The numBytes argument determines the * number of bytes to be scanned. If numBytes is negative, the first NUL * byte encountered will terminate the scan. If numBytes is non-negative, * then no more than numBytes bytes will be scanned. * * The argument flags is an input that controls the numeric formats * recognized by the parser. The flag bits are: * * - TCL_PARSE_INTEGER_ONLY: accept only integer values; reject * strings that denote floating point values (or accept only the * leading portion of them that are integer values). * - TCL_PARSE_SCAN_PREFIXES: ignore the prefixes 0b and 0o that are * not part of the [scan] command's vocabulary. Use only in * combination with TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_BINARY_ONLY: parse only in the binary format, whether * or not a prefix is present that would lead to binary parsing. * Use only in combination with TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_OCTAL_ONLY: parse only in the octal format, whether * or not a prefix is present that would lead to octal parsing. * Use only in combination with TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_HEXADECIMAL_ONLY: parse only in the hexadecimal format, * whether or not a prefix is present that would lead to * hexadecimal parsing. Use only in combination with * TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_DECIMAL_ONLY: parse only in the decimal format, no * matter whether a 0 prefix would normally force a different * base. * - TCL_PARSE_NO_WHITESPACE: reject any leading/trailing whitespace * * The arguments interp and expected are inputs that control error * message generation. If interp is NULL, no error message will be * generated. If interp is non-NULL, then expected must also be non-NULL. * When TCL_ERROR is returned, an error message will be left in the * result of interp, and the expected argument will appear in the error * message as the thing TclParseNumber expected, but failed to find in * the string. * * The arguments objPtr and endPtrPtr as well as the return code are the * outputs. * * When the parser cannot find any prefix of the string that matches a * format it is looking for, TCL_ERROR is returned and an error message * may be generated and returned as described above. The contents of * objPtr will not be changed. If endPtrPtr is non-NULL, a pointer to the * character in the string that terminated the scan will be written to * *endPtrPtr. * * When the parser determines that the entire string matches a format it * is looking for, TCL_OK is returned, and if objPtr is non-NULL, then * the internal rep and Tcl_ObjType of objPtr are set to the "canonical" * numeric value that matches the scanned string. If endPtrPtr is not * NULL, a pointer to the end of the string will be written to *endPtrPtr * (that is, either bytes+numBytes or a pointer to a terminating NUL * byte). * * When the parser determines that a partial string matches a format it * is looking for, the value of endPtrPtr determines what happens: * * - If endPtrPtr is NULL, then TCL_ERROR is returned, with error message * generation as above. * * - If endPtrPtr is non-NULL, then TCL_OK is returned and objPtr * internals are set as above. Also, a pointer to the first * character following the parsed numeric string is written to * *endPtrPtr. * * In some cases where the string being scanned is the string rep of * objPtr, this routine can leave objPtr in an inconsistent state where * its string rep and its internal rep do not agree. In these cases the * internal rep will be in agreement with only some substring of the * string rep. This might happen if the caller passes in a non-NULL bytes * value that points somewhere into the string rep. It might happen if * the caller passes in a numBytes value that limits the scan to only a * prefix of the string rep. Or it might happen if a non-NULL value of * endPtrPtr permits a TCL_OK return from only a partial string match. It * is the responsibility of the caller to detect and correct such * inconsistencies when they can and do arise. * * Results: * Returns a standard Tcl result. * * Side effects: * The string representaton of objPtr may be generated. * * The internal representation and Tcl_ObjType of objPtr may be changed. * This may involve allocation and/or freeing of memory. * *---------------------------------------------------------------------- */ int TclParseNumber( Tcl_Interp *interp, /* Used for error reporting. May be NULL. */ Tcl_Obj *objPtr, /* Object to receive the internal rep. */ const char *expected, /* Description of the type of number the * caller expects to be able to parse * ("integer", "boolean value", etc.). */ const char *bytes, /* Pointer to the start of the string to * scan. */ int numBytes, /* Maximum number of bytes to scan, see * above. */ const char **endPtrPtr, /* Place to store pointer to the character * that terminated the scan. */ int flags) /* Flags governing the parse. */ { enum State { INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, BINARY, HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY #ifdef IEEE_FLOATING_POINT , sN, sNA, sNAN, sNANPAREN, sNANHEX, sNANFINISH #endif } state = INITIAL; enum State acceptState = INITIAL; int signum = 0; /* Sign of the number being parsed. */ Tcl_WideUInt significandWide = 0; /* Significand of the number being parsed (if * no overflow). */ mp_int significandBig; /* Significand of the number being parsed (if * it overflows significandWide). */ int significandOverflow = 0;/* Flag==1 iff significandBig is used. */ Tcl_WideUInt octalSignificandWide = 0; /* Significand of an octal number; needed * because we don't know whether a number with * a leading zero is octal or decimal until * we've scanned forward to a '.' or 'e'. */ mp_int octalSignificandBig; /* Significand of octal number once * octalSignificandWide overflows. */ int octalSignificandOverflow = 0; /* Flag==1 if octalSignificandBig is used. */ int numSigDigs = 0; /* Number of significant digits in the decimal * significand. */ int numTrailZeros = 0; /* Number of trailing zeroes at the current * point in the parse. */ int numDigitsAfterDp = 0; /* Number of digits scanned after the decimal * point. */ int exponentSignum = 0; /* Signum of the exponent of a floating point * number. */ long exponent = 0; /* Exponent of a floating point number. */ const char *p; /* Pointer to next character to scan. */ size_t len; /* Number of characters remaining after p. */ const char *acceptPoint; /* Pointer to position after last character in * an acceptable number. */ size_t acceptLen; /* Number of characters following that * point. */ int status = TCL_OK; /* Status to return to caller. */ char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ int explicitOctal = 0; #define MOST_BITS (UWIDE_MAX >> 1) /* * Initialize bytes to start of the object's string rep if the caller * didn't pass anything else. */ if (bytes == NULL) { bytes = TclGetString(objPtr); } p = bytes; len = numBytes; acceptPoint = p; acceptLen = len; while (1) { char c = len ? *p : '\0'; switch (state) { case INITIAL: /* * Initial state. Acceptable characters are +, -, digits, period, * I, N, and whitespace. */ if (TclIsSpaceProcM(c)) { if (flags & TCL_PARSE_NO_WHITESPACE) { goto endgame; } break; } else if (c == '+') { state = SIGNUM; break; } else if (c == '-') { signum = 1; state = SIGNUM; break; } /* FALLTHROUGH */ case SIGNUM: /* * Scanned a leading + or -. Acceptable characters are digits, * period, I, and N. */ if (c == '0') { if (flags & TCL_PARSE_DECIMAL_ONLY) { state = DECIMAL; } else { state = ZERO; } break; } else if (flags & TCL_PARSE_HEXADECIMAL_ONLY) { goto zerox; } else if (flags & TCL_PARSE_BINARY_ONLY) { goto zerob; } else if (flags & TCL_PARSE_OCTAL_ONLY) { goto zeroo; } else if (isdigit(UCHAR(c))) { significandWide = c - '0'; numSigDigs = 1; state = DECIMAL; break; } else if (flags & TCL_PARSE_INTEGER_ONLY) { goto endgame; } else if (c == '.') { state = LEADING_RADIX_POINT; break; } else if (c == 'I' || c == 'i') { state = sI; break; #ifdef IEEE_FLOATING_POINT } else if (c == 'N' || c == 'n') { state = sN; break; #endif } goto endgame; case ZERO: /* * Scanned a leading zero (perhaps with a + or -). Acceptable * inputs are digits, period, X, b, and E. If 8 or 9 is * encountered, the number can't be octal. This state and the * OCTAL state differ only in whether they recognize 'X' and 'b'. */ acceptState = state; acceptPoint = p; acceptLen = len; if (c == 'x' || c == 'X') { if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) { goto endgame; } state = ZERO_X; break; } if (flags & TCL_PARSE_HEXADECIMAL_ONLY) { goto zerox; } if (flags & TCL_PARSE_SCAN_PREFIXES) { goto zeroo; } if (c == 'b' || c == 'B') { if (flags & TCL_PARSE_OCTAL_ONLY) { goto endgame; } state = ZERO_B; break; } if (flags & TCL_PARSE_BINARY_ONLY) { goto zerob; } if (c == 'o' || c == 'O') { explicitOctal = 1; state = ZERO_O; break; } #ifdef KILL_OCTAL goto decimal; #endif /* FALLTHROUGH */ case OCTAL: /* * Scanned an optional + or -, followed by a string of octal * digits. Acceptable inputs are more digits, period, or E. If 8 * or 9 is encountered, commit to floating point. */ acceptState = state; acceptPoint = p; acceptLen = len; /* FALLTHROUGH */ case ZERO_O: zeroo: if (c == '0') { numTrailZeros++; state = OCTAL; break; } else if (c >= '1' && c <= '7') { if (objPtr != NULL) { shift = 3 * (numTrailZeros + 1); significandOverflow = AccumulateDecimalDigit( (unsigned)(c-'0'), numTrailZeros, &significandWide, &significandBig, significandOverflow); if (!octalSignificandOverflow) { /* * Shifting by as many or more bits than are in the * value being shifted is undefined behavior. Check * for too large shifts first. */ if ((octalSignificandWide != 0) && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) || (octalSignificandWide > (UWIDE_MAX >> shift)))) { octalSignificandOverflow = 1; TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); } } if (!octalSignificandOverflow) { /* * When the significand is 0, it is possible for the * amount to be shifted to equal or exceed the width * of the significand. Do not shift when the * significand is 0 to avoid undefined behavior. */ if (octalSignificandWide != 0) { octalSignificandWide <<= shift; } octalSignificandWide += c - '0'; } else { mp_mul_2d(&octalSignificandBig, shift, &octalSignificandBig); mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'), &octalSignificandBig); } } if (numSigDigs != 0) { numSigDigs += numTrailZeros+1; } else { numSigDigs = 1; } numTrailZeros = 0; state = OCTAL; break; } /* FALLTHROUGH */ case BAD_OCTAL: if (explicitOctal) { /* * No forgiveness for bad digits in explicitly octal numbers. */ goto endgame; } if (flags & TCL_PARSE_INTEGER_ONLY) { /* * No seeking floating point when parsing only integer. */ goto endgame; } #ifndef KILL_OCTAL /* * Scanned a number with a leading zero that contains an 8, 9, * radix point or E. This is an invalid octal number, but might * still be floating point. */ if (c == '0') { numTrailZeros++; state = BAD_OCTAL; break; } else if (isdigit(UCHAR(c))) { if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( (unsigned)(c-'0'), numTrailZeros, &significandWide, &significandBig, significandOverflow); } if (numSigDigs != 0) { numSigDigs += (numTrailZeros + 1); } else { numSigDigs = 1; } numTrailZeros = 0; state = BAD_OCTAL; break; } else if (c == '.') { state = FRACTION; break; } else if (c == 'E' || c == 'e') { state = EXPONENT_START; break; } #endif goto endgame; /* * Scanned 0x. If state is HEXADECIMAL, scanned at least one * character following the 0x. The only acceptable inputs are * hexadecimal digits. */ case HEXADECIMAL: acceptState = state; acceptPoint = p; acceptLen = len; /* FALLTHROUGH */ case ZERO_X: zerox: if (c == '0') { numTrailZeros++; state = HEXADECIMAL; break; } else if (isdigit(UCHAR(c))) { d = (c-'0'); } else if (c >= 'A' && c <= 'F') { d = (c-'A'+10); } else if (c >= 'a' && c <= 'f') { d = (c-'a'+10); } else { goto endgame; } if (objPtr != NULL) { shift = 4 * (numTrailZeros + 1); if (!significandOverflow) { /* * Shifting by as many or more bits than are in the * value being shifted is undefined behavior. Check * for too large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (UWIDE_MAX >> shift))) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); } } if (!significandOverflow) { /* * When the significand is 0, it is possible for the * amount to be shifted to equal or exceed the width * of the significand. Do not shift when the * significand is 0 to avoid undefined behavior. */ if (significandWide != 0) { significandWide <<= shift; } significandWide += d; } else { mp_mul_2d(&significandBig, shift, &significandBig); mp_add_d(&significandBig, (mp_digit) d, &significandBig); } } numTrailZeros = 0; state = HEXADECIMAL; break; case BINARY: acceptState = state; acceptPoint = p; acceptLen = len; /* FALLTHRU */ case ZERO_B: zerob: if (c == '0') { numTrailZeros++; state = BINARY; break; } else if (c != '1') { goto endgame; } if (objPtr != NULL) { shift = numTrailZeros + 1; if (!significandOverflow) { /* * Shifting by as many or more bits than are in the * value being shifted is undefined behavior. Check * for too large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (UWIDE_MAX >> shift))) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); } } if (!significandOverflow) { /* * When the significand is 0, it is possible for the * amount to be shifted to equal or exceed the width * of the significand. Do not shift when the * significand is 0 to avoid undefined behavior. */ if (significandWide != 0) { significandWide <<= shift; } significandWide += 1; } else { mp_mul_2d(&significandBig, shift, &significandBig); mp_add_d(&significandBig, (mp_digit) 1, &significandBig); } } numTrailZeros = 0; state = BINARY; break; case DECIMAL: /* * Scanned an optional + or - followed by a string of decimal * digits. */ #ifdef KILL_OCTAL decimal: #endif acceptState = state; acceptPoint = p; acceptLen = len; if (c == '0') { numTrailZeros++; state = DECIMAL; break; } else if (isdigit(UCHAR(c))) { if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( (unsigned)(c - '0'), numTrailZeros, &significandWide, &significandBig, significandOverflow); } numSigDigs += numTrailZeros+1; numTrailZeros = 0; state = DECIMAL; break; } else if (flags & TCL_PARSE_INTEGER_ONLY) { goto endgame; } else if (c == '.') { state = FRACTION; break; } else if (c == 'E' || c == 'e') { state = EXPONENT_START; break; } goto endgame; /* * Found a decimal point. If no digits have yet been scanned, E is * not allowed; otherwise, it introduces the exponent. If at least * one digit has been found, we have a possible complete number. */ case FRACTION: acceptState = state; acceptPoint = p; acceptLen = len; if (c == 'E' || c=='e') { state = EXPONENT_START; break; } /* FALLTHROUGH */ case LEADING_RADIX_POINT: if (c == '0') { numDigitsAfterDp++; numTrailZeros++; state = FRACTION; break; } else if (isdigit(UCHAR(c))) { numDigitsAfterDp++; if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( (unsigned)(c-'0'), numTrailZeros, &significandWide, &significandBig, significandOverflow); } if (numSigDigs != 0) { numSigDigs += numTrailZeros+1; } else { numSigDigs = 1; } numTrailZeros = 0; state = FRACTION; break; } goto endgame; case EXPONENT_START: /* * Scanned the E at the start of an exponent. Make sure a legal * character follows before using the C library strtol routine, * which allows whitespace. */ if (c == '+') { state = EXPONENT_SIGNUM; break; } else if (c == '-') { exponentSignum = 1; state = EXPONENT_SIGNUM; break; } /* FALLTHROUGH */ case EXPONENT_SIGNUM: /* * Found the E at the start of the exponent, followed by a sign * character. */ if (isdigit(UCHAR(c))) { exponent = c - '0'; state = EXPONENT; break; } goto endgame; case EXPONENT: /* * Found an exponent with at least one digit. Accumulate it, * making sure to hard-pin it to LONG_MAX on overflow. */ acceptState = state; acceptPoint = p; acceptLen = len; if (isdigit(UCHAR(c))) { if (exponent < (LONG_MAX - 9) / 10) { exponent = 10 * exponent + (c - '0'); } else { exponent = LONG_MAX; } state = EXPONENT; break; } goto endgame; /* * Parse out INFINITY by simply spelling it out. INF is accepted * as an abbreviation; other prefices are not. */ case sI: if (c == 'n' || c == 'N') { state = sIN; break; } goto endgame; case sIN: if (c == 'f' || c == 'F') { state = sINF; break; } goto endgame; case sINF: acceptState = state; acceptPoint = p; acceptLen = len; if (c == 'i' || c == 'I') { state = sINFI; break; } goto endgame; case sINFI: if (c == 'n' || c == 'N') { state = sINFIN; break; } goto endgame; case sINFIN: if (c == 'i' || c == 'I') { state = sINFINI; break; } goto endgame; case sINFINI: if (c == 't' || c == 'T') { state = sINFINIT; break; } goto endgame; case sINFINIT: if (c == 'y' || c == 'Y') { state = sINFINITY; break; } goto endgame; /* * Parse NaN's. */ #ifdef IEEE_FLOATING_POINT case sN: if (c == 'a' || c == 'A') { state = sNA; break; } goto endgame; case sNA: if (c == 'n' || c == 'N') { state = sNAN; break; } goto endgame; case sNAN: acceptState = state; acceptPoint = p; acceptLen = len; if (c == '(') { state = sNANPAREN; break; } goto endgame; /* * Parse NaN(hexdigits) */ case sNANHEX: if (c == ')') { state = sNANFINISH; break; } /* FALLTHROUGH */ case sNANPAREN: if (TclIsSpaceProcM(c)) { break; } if (numSigDigs < 13) { if (c >= '0' && c <= '9') { d = c - '0'; } else if (c >= 'a' && c <= 'f') { d = 10 + c - 'a'; } else if (c >= 'A' && c <= 'F') { d = 10 + c - 'A'; } else { goto endgame; } numSigDigs++; significandWide = (significandWide << 4) + d; state = sNANHEX; break; } goto endgame; case sNANFINISH: #endif case sINFINITY: acceptState = state; acceptPoint = p; acceptLen = len; goto endgame; } p++; len--; } endgame: if (acceptState == INITIAL) { /* * No numeric string at all found. */ status = TCL_ERROR; if (endPtrPtr != NULL) { *endPtrPtr = p; } } else { /* * Back up to the last accepting state in the lexer. */ p = acceptPoint; len = acceptLen; if (!(flags & TCL_PARSE_NO_WHITESPACE)) { /* * Accept trailing whitespace. */ while (len != 0 && TclIsSpaceProcM(*p)) { p++; len--; } } if (endPtrPtr == NULL) { if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) { status = TCL_ERROR; } } else { *endPtrPtr = p; } } /* * Generate and store the appropriate internal rep. */ if (status == TCL_OK && objPtr != NULL) { TclFreeIntRep(objPtr); switch (acceptState) { case SIGNUM: case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: case LEADING_RADIX_POINT: case EXPONENT_START: case EXPONENT_SIGNUM: case sI: case sIN: case sINFI: case sINFIN: case sINFINI: case sINFINIT: #ifdef IEEE_FLOATING_POINT case sN: case sNA: case sNANPAREN: case sNANHEX: #endif Tcl_Panic("TclParseNumber: bad acceptState %d parsing '%s'", acceptState, bytes); case BINARY: shift = numTrailZeros; if (!significandOverflow && significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (MOST_BITS + signum) >> shift)) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); } if (shift) { if (!significandOverflow) { /* * When the significand is 0, it is possible for the * amount to be shifted to equal or exceed the width * of the significand. Do not shift when the * significand is 0 to avoid undefined behavior. */ if (significandWide != 0) { significandWide <<= shift; } } else { mp_mul_2d(&significandBig, shift, &significandBig); } } goto returnInteger; case HEXADECIMAL: /* * Returning a hex integer. Final scaling step. */ shift = 4 * numTrailZeros; if (!significandOverflow && significandWide !=0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (MOST_BITS + signum) >> shift)) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); } if (shift) { if (!significandOverflow) { /* * When the significand is 0, it is possible for the * amount to be shifted to equal or exceed the width * of the significand. Do not shift when the * significand is 0 to avoid undefined behavior. */ if (significandWide != 0) { significandWide <<= shift; } } else { mp_mul_2d(&significandBig, shift, &significandBig); } } goto returnInteger; case OCTAL: /* * Returning an octal integer. Final scaling step. */ shift = 3 * numTrailZeros; if (!octalSignificandOverflow && octalSignificandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || octalSignificandWide > (MOST_BITS + signum) >> shift)) { octalSignificandOverflow = 1; TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); } if (shift) { if (!octalSignificandOverflow) { /* * When the significand is 0, it is possible for the * amount to be shifted to equal or exceed the width * of the significand. Do not shift when the * significand is 0 to avoid undefined behavior. */ if (octalSignificandWide != 0) { octalSignificandWide <<= shift; } } else { mp_mul_2d(&octalSignificandBig, shift, &octalSignificandBig); } } if (!octalSignificandOverflow) { if (octalSignificandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { #ifndef TCL_WIDE_INT_IS_LONG if (octalSignificandWide <= (MOST_BITS + signum)) { objPtr->typePtr = &tclWideIntType; if (signum) { objPtr->internalRep.wideValue = (Tcl_WideInt) (-octalSignificandWide); } else { objPtr->internalRep.wideValue = (Tcl_WideInt) octalSignificandWide; } break; } #endif TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); octalSignificandOverflow = 1; } else { objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.longValue = (long) (-octalSignificandWide); } else { objPtr->internalRep.longValue = (long) octalSignificandWide; } } } if (octalSignificandOverflow) { if (signum) { (void)mp_neg(&octalSignificandBig, &octalSignificandBig); } TclSetBignumInternalRep(objPtr, &octalSignificandBig); } break; case ZERO: case DECIMAL: significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1, &significandWide, &significandBig, significandOverflow); if (!significandOverflow && (significandWide > MOST_BITS+signum)) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); } returnInteger: if (!significandOverflow) { if (significandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { #ifndef TCL_WIDE_INT_IS_LONG if (significandWide <= MOST_BITS+signum) { objPtr->typePtr = &tclWideIntType; if (signum) { objPtr->internalRep.wideValue = (Tcl_WideInt) (-significandWide); } else { objPtr->internalRep.wideValue = (Tcl_WideInt) significandWide; } break; } #endif TclBNInitBignumFromWideUInt(&significandBig, significandWide); significandOverflow = 1; } else { objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.longValue = (long) (-significandWide); } else { objPtr->internalRep.longValue = (long) significandWide; } } } if (significandOverflow) { if (signum) { (void)mp_neg(&significandBig, &significandBig); } TclSetBignumInternalRep(objPtr, &significandBig); } break; case FRACTION: case EXPONENT: /* * Here, we're parsing a floating-point number. 'significandWide' * or 'significandBig' contains the exact significand, according * to whether 'significandOverflow' is set. The desired floating * point value is significand * 10**k, where * k = numTrailZeros+exponent-numDigitsAfterDp. */ objPtr->typePtr = &tclDoubleType; if (exponentSignum) { /* * At this point exponent>=0, so the following calculation * cannot underflow. */ exponent = -exponent; } /* * Adjust the exponent for the number of trailing zeros that * have not been accumulated, and the number of digits after * the decimal point. Pin any overflow to LONG_MAX/LONG_MIN * respectively. */ if (exponent >= 0) { if (exponent - numDigitsAfterDp > LONG_MAX - numTrailZeros) { exponent = LONG_MAX; } else { exponent = exponent - numDigitsAfterDp + numTrailZeros; } } else { if (exponent + numTrailZeros < LONG_MIN + numDigitsAfterDp) { exponent = LONG_MIN; } else { exponent = exponent + numTrailZeros - numDigitsAfterDp; } } /* * The desired number is now significandWide * 10**exponent * or significandBig * 10**exponent, depending on whether * the significand has overflowed a wide int. */ if (!significandOverflow) { objPtr->internalRep.doubleValue = MakeLowPrecisionDouble( signum, significandWide, numSigDigs, exponent); } else { objPtr->internalRep.doubleValue = MakeHighPrecisionDouble( signum, &significandBig, numSigDigs, exponent); } break; case sINF: case sINFINITY: if (signum) { objPtr->internalRep.doubleValue = -HUGE_VAL; } else { objPtr->internalRep.doubleValue = HUGE_VAL; } objPtr->typePtr = &tclDoubleType; break; #ifdef IEEE_FLOATING_POINT case sNAN: case sNANFINISH: objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide); objPtr->typePtr = &tclDoubleType; break; #endif case INITIAL: /* This case only to silence compiler warning. */ Tcl_Panic("TclParseNumber: state INITIAL can't happen here"); } } /* * Format an error message when an invalid number is encountered. */ if (status != TCL_OK) { if (interp != NULL) { Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"", expected); Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); if (state == BAD_OCTAL) { Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); } Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); } } /* * Free memory. */ if (octalSignificandOverflow) { mp_clear(&octalSignificandBig); } if (significandOverflow) { mp_clear(&significandBig); } return status; } /* *---------------------------------------------------------------------- * * AccumulateDecimalDigit -- * * Consume a decimal digit in a number being scanned. * * Results: * Returns 1 if the number has overflowed to a bignum, 0 if it still fits * in a wide integer. * * Side effects: * Updates either the wide or bignum representation. * *---------------------------------------------------------------------- */ static int AccumulateDecimalDigit( unsigned digit, /* Digit being scanned. */ int numZeros, /* Count of zero digits preceding the digit * being scanned. */ Tcl_WideUInt *wideRepPtr, /* Representation of the partial number as a * wide integer. */ mp_int *bignumRepPtr, /* Representation of the partial number as a * bignum. */ int bignumFlag) /* Flag == 1 if the number overflowed previous * to this digit. */ { int i, n; Tcl_WideUInt w; /* * Try wide multiplication first. */ if (!bignumFlag) { w = *wideRepPtr; if (w == 0) { /* * There's no need to multiply if the multiplicand is zero. */ *wideRepPtr = digit; return 0; } else if (numZeros >= maxpow10_wide || w > (UWIDE_MAX-digit)/pow10_wide[numZeros+1]) { /* * Wide multiplication will overflow. Expand the number to a * bignum and fall through into the bignum case. */ TclBNInitBignumFromWideUInt(bignumRepPtr, w); } else { /* * Wide multiplication. */ *wideRepPtr = w * pow10_wide[numZeros+1] + digit; return 0; } } /* * Bignum multiplication. */ if (numZeros < log10_DIGIT_MAX) { /* * Up to about 8 zeros - single digit multiplication. */ mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[numZeros+1], bignumRepPtr); mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr); } else { /* * More than single digit multiplication. Multiply by the appropriate * small powers of 5, and then shift. Large strings of zeroes are * eaten 256 at a time; this is less efficient than it could be, but * seems implausible. We presume that MP_DIGIT_BIT is at least 27. The * first multiplication, by up to 10**7, is done with a one-DIGIT * multiply (this presumes that MP_DIGIT_BIT >= 24). */ n = numZeros + 1; mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[n&0x7], bignumRepPtr); for (i=3; i<=7; ++i) { if (n & (1 << i)) { mp_mul(bignumRepPtr, pow5+i, bignumRepPtr); } } while (n >= 256) { mp_mul(bignumRepPtr, pow5+8, bignumRepPtr); n -= 256; } mp_mul_2d(bignumRepPtr, (int)(numZeros+1)&~0x7, bignumRepPtr); mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr); } return 1; } /* *---------------------------------------------------------------------- * * MakeLowPrecisionDouble -- * * Makes the double precision number, signum*significand*10**exponent. * * Results: * Returns the constructed number. * * Common cases, where there are few enough digits that the number can be * represented with at most roundoff, are handled specially here. If the * number requires more than one rounded operation to compute, the code * promotes the significand to a bignum and calls MakeHighPrecisionDouble * to do it instead. * *---------------------------------------------------------------------- */ static double MakeLowPrecisionDouble( int signum, /* 1 if the number is negative, 0 otherwise */ Tcl_WideUInt significand, /* Significand of the number */ int numSigDigs, /* Number of digits in the significand */ long exponent) /* Power of ten */ { TCL_IEEE_DOUBLE_ROUNDING_DECL mp_int significandBig; /* Significand expressed as a bignum. */ /* * With gcc on x86, the floating point rounding mode is double-extended. * This causes the result of double-precision calculations to be rounded * twice: once to the precision of double-extended and then again to the * precision of double. Double-rounding introduces gratuitous errors of 1 * ulp, so we need to change rounding mode to 53-bits. We also make * 'retval' volatile, so that it doesn't get promoted to a register. */ volatile double retval; /* Value of the number. */ /* * Test for zero significand, which requires explicit construction * of -0.0. (Unary minus returns a positive zero.) */ if (significand == 0) { return copysign(0.0, -signum); } /* * Set the FP control word for 53 bits, WARNING: It must be reset * before returning. */ TCL_IEEE_DOUBLE_ROUNDING; if (numSigDigs <= QUICK_MAX) { if (exponent >= 0) { if (exponent <= mmaxpow) { /* * The significand is an exact integer, and so is * 10**exponent. The product will be correct to within 1/2 ulp * without special handling. */ retval = (double) ((Tcl_WideInt)significand * pow10vals[exponent]); goto returnValue; } else { int diff = QUICK_MAX - numSigDigs; if (exponent-diff <= mmaxpow) { /* * 10**exponent is not an exact integer, but * 10**(exponent-diff) is exact, and so is * significand*10**diff, so we can still compute the value * with only one roundoff. */ volatile double factor = (double) ((Tcl_WideInt)significand * pow10vals[diff]); retval = factor * pow10vals[exponent-diff]; goto returnValue; } } } else { if (exponent >= -mmaxpow) { /* * 10**-exponent is an exact integer, and so is the * significand. Compute the result by one division, again with * only one rounding. */ retval = (double) ((Tcl_WideInt)significand / pow10vals[-exponent]); goto returnValue; } } } /* * All the easy cases have failed. Promote the significand to bignum and * call MakeHighPrecisionDouble to do it the hard way. */ TclBNInitBignumFromWideUInt(&significandBig, significand); retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs, exponent); mp_clear(&significandBig); /* * Come here to return the computed value. */ returnValue: if (signum) { retval = -retval; } /* * On gcc on x86, restore the floating point mode word. */ TCL_DEFAULT_DOUBLE_ROUNDING; return retval; } /* *---------------------------------------------------------------------- * * MakeHighPrecisionDouble -- * * Makes the double precision number, signum*significand*10**exponent. * * Results: * Returns the constructed number. * * MakeHighPrecisionDouble is used when arbitrary-precision arithmetic is * needed to ensure correct rounding. It begins by calculating a * low-precision approximation to the desired number, and then refines * the answer in high precision. * *---------------------------------------------------------------------- */ static double MakeHighPrecisionDouble( int signum, /* 1=negative, 0=nonnegative */ mp_int *significand, /* Exact significand of the number */ int numSigDigs, /* Number of significant digits */ long exponent) /* Power of 10 by which to multiply */ { TCL_IEEE_DOUBLE_ROUNDING_DECL int machexp; /* Machine exponent of a power of 10. */ /* * With gcc on x86, the floating point rounding mode is double-extended. * This causes the result of double-precision calculations to be rounded * twice: once to the precision of double-extended and then again to the * precision of double. Double-rounding introduces gratuitous errors of 1 * ulp, so we need to change rounding mode to 53-bits. We also make * 'retval' volatile to make sure that it doesn't get promoted to a * register. */ volatile double retval; /* * A zero significand requires explicit construction of -0.0. * (Unary minus returns positive zero.) */ if (mp_iszero(significand)) { return copysign(0.0, -signum); } /* * Set the 53-bit rounding mode. WARNING: It must be reset before * returning. */ TCL_IEEE_DOUBLE_ROUNDING; /* * Make quick checks for over/underflow. Be careful to avoid * integer overflow when calculating with 'exponent'. */ if (exponent >= 0 && exponent-1 > maxDigits-numSigDigs) { retval = HUGE_VAL; goto returnValue; } else if (exponent < 0 && numSigDigs+exponent < minDigits+1) { retval = 0.0; goto returnValue; } /* * Develop a first approximation to the significand. It is tempting simply * to force bignum to double, but that will overflow on input numbers like * 1.[string repeat 0 1000]1; while this is a not terribly likely * scenario, we still have to deal with it. Use fraction and exponent * instead. Once we have the significand, multiply by 10**exponent. Test * for overflow. Convert back to a double, and test for underflow. */ retval = BignumToBiasedFrExp(significand, &machexp); retval = Pow10TimesFrExp(exponent, retval, &machexp); if (machexp > DBL_MAX_EXP*log2FLT_RADIX) { retval = HUGE_VAL; goto returnValue; } retval = SafeLdExp(retval, machexp); if (tiny == 0.0) { tiny = SafeLdExp(1.0, DBL_MIN_EXP * log2FLT_RADIX - mantBits); } if (retval < tiny) { retval = tiny; } /* * Refine the result twice. (The second refinement should be necessary * only if the best approximation is a power of 2 minus 1/2 ulp). */ retval = RefineApproximation(retval, significand, exponent); retval = RefineApproximation(retval, significand, exponent); /* * Come here to return the computed value. */ returnValue: if (signum) { retval = -retval; } /* * On gcc on x86, restore the floating point mode word. */ TCL_DEFAULT_DOUBLE_ROUNDING; return retval; } /* *---------------------------------------------------------------------- * * MakeNaN -- * * Makes a "Not a Number" given a set of bits to put in the tag bits * * Note that a signalling NaN is never returned. * *---------------------------------------------------------------------- */ #ifdef IEEE_FLOATING_POINT static double MakeNaN( int signum, /* Sign bit (1=negative, 0=nonnegative. */ Tcl_WideUInt tags) /* Tag bits to put in the NaN. */ { union { Tcl_WideUInt iv; double dv; } theNaN; theNaN.iv = tags; theNaN.iv &= (((Tcl_WideUInt) 1) << 51) - 1; if (signum) { theNaN.iv |= ((Tcl_WideUInt) (0x8000 | NAN_START)) << 48; } else { theNaN.iv |= ((Tcl_WideUInt) NAN_START) << 48; } if (n770_fp) { theNaN.iv = Nokia770Twiddle(theNaN.iv); } return theNaN.dv; } #endif /* *---------------------------------------------------------------------- * * RefineApproximation -- * * Given a poor approximation to a floating point number, returns a * better one. (The better approximation is correct to within 1 ulp, and * is entirely correct if the poor approximation is correct to 1 ulp.) * * Results: * Returns the improved result. * *---------------------------------------------------------------------- */ static double RefineApproximation( double approxResult, /* Approximate result of conversion. */ mp_int *exactSignificand, /* Integer significand. */ int exponent) /* Power of 10 to multiply by significand. */ { int M2, M5; /* Powers of 2 and of 5 needed to put the * decimal and binary numbers over a common * denominator. */ double significand; /* Sigificand of the binary number. */ int binExponent; /* Exponent of the binary number. */ int msb; /* Most significant bit position of an * intermediate result. */ int nDigits; /* Number of mp_digit's in an intermediate * result. */ mp_int twoMv; /* Approx binary value expressed as an exact * integer scaled by the multiplier 2M. */ mp_int twoMd; /* Exact decimal value expressed as an exact * integer scaled by the multiplier 2M. */ int scale; /* Scale factor for M. */ int multiplier; /* Power of two to scale M. */ double num, den; /* Numerator and denominator of the correction * term. */ double quot; /* Correction term. */ double minincr; /* Lower bound on the absolute value of the * correction term. */ int roundToEven = 0; /* Flag == TRUE if we need to invoke * "round to even" functionality */ double rteSignificand; /* Significand of the round-to-even result */ int rteExponent; /* Exponent of the round-to-even result */ int shift; /* Shift count for converting numerator * and denominator of corrector to floating * point */ Tcl_WideInt rteSigWide; /* Wide integer version of the significand * for testing evenness */ int i; /* * The first approximation is always low. If we find that it's HUGE_VAL, * we're done. */ if (approxResult == HUGE_VAL) { return approxResult; } significand = frexp(approxResult, &binExponent); /* * We are trying to compute a corrector term that, when added to the * approximate result, will yield close to the exact result. * The exact result is exactSignificand * 10**exponent. * The approximate result is significand * 2**binExponent * If exponent<0, we need to multiply the exact value by 10**-exponent * to make it an integer, plus another factor of 2 to decide on rounding. * Similarly if binExponent 0) { M5 = 0; } else { M5 = -exponent; if (M5 - 1 > M2) { M2 = M5 - 1; } } /* * Compute twoMv as 2*M*v, where v is the approximate value. * This is done by bit-whacking to calculate 2**(M2+1)*significand, * and then multiplying by 5**M5. */ msb = binExponent + M2; /* 1008 */ nDigits = msb / MP_DIGIT_BIT + 1; mp_init_size(&twoMv, nDigits); i = (msb % MP_DIGIT_BIT + 1); twoMv.used = nDigits; significand *= SafeLdExp(1.0, i); while (--nDigits >= 0) { twoMv.dp[nDigits] = (mp_digit) significand; significand -= (mp_digit) significand; significand = SafeLdExp(significand, MP_DIGIT_BIT); } for (i = 0; i <= 8; ++i) { if (M5 & (1 << i)) { mp_mul(&twoMv, pow5+i, &twoMv); } } /* * Compute twoMd as 2*M*d, where d is the exact value. * This is done by multiplying by 5**(M5+exponent) and then multiplying * by 2**(M5+exponent+1), which is, of course, a left shift. */ mp_init_copy(&twoMd, exactSignificand); for (i=0; i<=8; ++i) { if ((M5 + exponent) & (1 << i)) { mp_mul(&twoMd, pow5+i, &twoMd); } } mp_mul_2d(&twoMd, M2+exponent+1, &twoMd); /* * Now let twoMd = twoMd - twoMv, the difference between the exact and * approximate values. */ mp_sub(&twoMd, &twoMv, &twoMd); /* * The result, 2Mv-2Md, needs to be divided by 2M to yield a correction * term. Because 2M may well overflow a double, we need to scale the * denominator by a factor of 2**binExponent-mantBits. Place that factor * times 1/2 ULP into twoMd. */ scale = binExponent - mantBits - 1; mp_set(&twoMv, 1); for (i=0; i<=8; ++i) { if (M5 & (1 << i)) { mp_mul(&twoMv, pow5+i, &twoMv); } } multiplier = M2 + scale + 1; if (multiplier > 0) { mp_mul_2d(&twoMv, multiplier, &twoMv); } else if (multiplier < 0) { mp_div_2d(&twoMv, -multiplier, &twoMv, NULL); } /* * Will the eventual correction term be less than, equal to, or * greater than 1/2 ULP? */ switch (mp_cmp_mag(&twoMd, &twoMv)) { case MP_LT: /* * If the error is less than 1/2 ULP, there's no correction to make. */ mp_clear(&twoMd); mp_clear(&twoMv); return approxResult; case MP_EQ: /* * If the error is exactly 1/2 ULP, we need to round to even. */ roundToEven = 1; break; case MP_GT: /* * We need to correct the result if the error exceeds 1/2 ULP. */ break; } /* * If we're in the 'round to even' case, and the significand is already * even, we're done. Return the approximate result. */ if (roundToEven) { rteSignificand = frexp(approxResult, &rteExponent); rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION); if ((rteSigWide & 1) == 0) { mp_clear(&twoMd); mp_clear(&twoMv); return approxResult; } } /* * Reduce the numerator and denominator of the corrector term so that * they will fit in the floating point precision. */ shift = mp_count_bits(&twoMv) - FP_PRECISION - 1; if (shift > 0) { mp_div_2d(&twoMv, shift, &twoMv, NULL); mp_div_2d(&twoMd, shift, &twoMd, NULL); } /* * Convert the numerator and denominator of the corrector term accurately * to floating point numbers. */ num = TclBignumToDouble(&twoMd); den = TclBignumToDouble(&twoMv); quot = SafeLdExp(num/den, scale); minincr = SafeLdExp(1.0, binExponent-mantBits); if (quot<0. && quot>-minincr) { quot = -minincr; } else if (quot>0. && quot>= 1; ++r; } if (p != result) { mp_copy(p, result); } } /* *---------------------------------------------------------------------- * * NormalizeRightward -- * * Shifts a number rightward until it is odd (that is, until the least * significant bit is nonzero. * * Results: * Returns the number of bit positions by which the number was shifted. * * Side effects: * Shifts the number in place; *wPtr is replaced by the shifted number. * *---------------------------------------------------------------------- */ static inline int NormalizeRightward( Tcl_WideUInt *wPtr) /* INOUT: Number to shift. */ { int rv = 0; Tcl_WideUInt w = *wPtr; if (!(w & (Tcl_WideUInt) 0xFFFFFFFF)) { w >>= 32; rv += 32; } if (!(w & (Tcl_WideUInt) 0xFFFF)) { w >>= 16; rv += 16; } if (!(w & (Tcl_WideUInt) 0xFF)) { w >>= 8; rv += 8; } if (!(w & (Tcl_WideUInt) 0xF)) { w >>= 4; rv += 4; } if (!(w & 0x3)) { w >>= 2; rv += 2; } if (!(w & 0x1)) { w >>= 1; ++rv; } *wPtr = w; return rv; } /* *---------------------------------------------------------------------- * * RequiredPrecision -- * * Determines the number of bits needed to hold an integer. * * Results: * Returns the position of the most significant bit (0 - 63). Returns 0 * if the number is zero. * *---------------------------------------------------------------------- */ static int RequiredPrecision( Tcl_WideUInt w) /* Number to interrogate. */ { int rv; unsigned long wi; if (w & ((Tcl_WideUInt) 0xFFFFFFFF << 32)) { wi = (unsigned long) (w >> 32); rv = 32; } else { wi = (unsigned long) w; rv = 0; } if (wi & 0xFFFF0000) { wi >>= 16; rv += 16; } if (wi & 0xFF00) { wi >>= 8; rv += 8; } if (wi & 0xF0) { wi >>= 4; rv += 4; } if (wi & 0xC) { wi >>= 2; rv += 2; } if (wi & 0x2) { wi >>= 1; ++rv; } if (wi & 0x1) { ++rv; } return rv; } /* *---------------------------------------------------------------------- * * DoubleToExpAndSig -- * * Separates a 'double' into exponent and significand. * * Side effects: * Stores the significand in '*significand' and the exponent in '*expon' * so that dv == significand * 2.0**expon, and significand is odd. Also * stores the position of the leftmost 1-bit in 'significand' in 'bits'. * *---------------------------------------------------------------------- */ static inline void DoubleToExpAndSig( double dv, /* Number to convert. */ Tcl_WideUInt *significand, /* OUTPUT: Significand of the number. */ int *expon, /* OUTPUT: Exponent to multiply the number * by. */ int *bits) /* OUTPUT: Number of significant bits. */ { Double d; /* Number being converted. */ Tcl_WideUInt z; /* Significand under construction. */ int de; /* Exponent of the number. */ int k; /* Bit count. */ d.d = dv; /* * Extract exponent and significand. */ de = (d.w.word0 & EXP_MASK) >> EXP_SHIFT; z = d.q & SIG_MASK; if (de != 0) { z |= HIDDEN_BIT; k = NormalizeRightward(&z); *bits = FP_PRECISION - k; *expon = k + (de - EXPONENT_BIAS) - (FP_PRECISION-1); } else { k = NormalizeRightward(&z); *expon = k + (de - EXPONENT_BIAS) - (FP_PRECISION-1) + 1; *bits = RequiredPrecision(z); } *significand = z; } /* *---------------------------------------------------------------------- * * TakeAbsoluteValue -- * * Takes the absolute value of a 'double' including 0, Inf and NaN * * Side effects: * The 'double' in *d is replaced with its absolute value. The signum is * stored in 'sign': 1 for negative, 0 for nonnegative. * *---------------------------------------------------------------------- */ static inline void TakeAbsoluteValue( Double *d, /* Number to replace with absolute value. */ int *sign) /* Place to put the signum. */ { if (d->w.word0 & SIGN_BIT) { *sign = 1; d->w.word0 &= ~SIGN_BIT; } else { *sign = 0; } } /* *---------------------------------------------------------------------- * * FormatInfAndNaN -- * * Bailout for formatting infinities and Not-A-Number. * * Results: * Returns one of the strings 'Infinity' and 'NaN'. The string returned * must be freed by the caller using 'ckfree'. * * Side effects: * Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating * NUL byte of the string if 'endPtr' is not NULL. * *---------------------------------------------------------------------- */ static inline char * FormatInfAndNaN( Double *d, /* Exceptional number to format. */ int *decpt, /* Decimal point to set to a bogus value. */ char **endPtr) /* Pointer to the end of the formatted data */ { char *retval; *decpt = 9999; if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) { retval = ckalloc(9); strcpy(retval, "Infinity"); if (endPtr) { *endPtr = retval + 8; } } else { retval = ckalloc(4); strcpy(retval, "NaN"); if (endPtr) { *endPtr = retval + 3; } } return retval; } /* *---------------------------------------------------------------------- * * FormatZero -- * * Bailout to format a zero floating-point number. * * Results: * Returns the constant string "0" * * Side effects: * Stores 1 in '*decpt' and puts a pointer to the NUL byte terminating * the string in '*endPtr' if 'endPtr' is not NULL. * *---------------------------------------------------------------------- */ static inline char * FormatZero( int *decpt, /* Location of the decimal point. */ char **endPtr) /* Pointer to the end of the formatted data */ { char *retval = ckalloc(2); strcpy(retval, "0"); if (endPtr) { *endPtr = retval+1; } *decpt = 0; return retval; } /* *---------------------------------------------------------------------- * * ApproximateLog10 -- * * Computes a two-term Taylor series approximation to the common log of a * number, and computes the number's binary log. * * Results: * Return an approximation to floor(log10(bw*2**be)) that is either exact * or 1 too high. * *---------------------------------------------------------------------- */ static inline int ApproximateLog10( Tcl_WideUInt bw, /* Integer significand of the number. */ int be, /* Power of two to scale bw. */ int bbits) /* Number of bits of precision in bw. */ { int i; /* Log base 2 of the number. */ int k; /* Floor(Log base 10 of the number) */ double ds; /* Mantissa of the number. */ Double d2; /* * Compute i and d2 such that d = d2*2**i, and 1 < d2 < 2. * Compute an approximation to log10(d), * log10(d) ~ log10(2) * i + log10(1.5) * + (significand-1.5)/(1.5 * log(10)) */ d2.q = bw << (FP_PRECISION - bbits) & SIG_MASK; d2.w.word0 |= (EXPONENT_BIAS) << EXP_SHIFT; i = be + bbits - 1; ds = (d2.d - 1.5) * TWO_OVER_3LOG10 + LOG10_3HALVES_PLUS_FUDGE + LOG10_2 * i; k = (int) ds; if (k > ds) { --k; } return k; } /* *---------------------------------------------------------------------- * * BetterLog10 -- * * Improves the result of ApproximateLog10 for numbers in the range * 1 .. 10**(TEN_PMAX)-1 * * Side effects: * Sets k_check to 0 if the new result is known to be exact, and to 1 if * it may still be one too high. * * Results: * Returns the improved approximation to log10(d). * *---------------------------------------------------------------------- */ static inline int BetterLog10( double d, /* Original number to format. */ int k, /* Characteristic(Log base 10) of the * number. */ int *k_check) /* Flag == 1 if k is inexact. */ { /* * Performance hack. If k is in the range 0..TEN_PMAX, then we can use a * powers-of-ten table to check it. */ if (k >= 0 && k <= TEN_PMAX) { if (d < tens[k]) { k--; } *k_check = 0; } else { *k_check = 1; } return k; } /* *---------------------------------------------------------------------- * * ComputeScale -- * * Prepares to format a floating-point number as decimal. * * Parameters: * floor(log10*x) is k (or possibly k-1). floor(log2(x) is i. The * significand of x requires bbits bits to represent. * * Results: * Determines integers b2, b5, s2, s5 so that sig*2**b2*5**b5/2**s2*2**s5 * exactly represents the value of the x/10**k. This value will lie in * the range [1 .. 10), and allows for computing successive digits by * multiplying sig%10 by 10. * *---------------------------------------------------------------------- */ static inline void ComputeScale( int be, /* Exponent part of number: d = bw * 2**be. */ int k, /* Characteristic of log10(number). */ int *b2, /* OUTPUT: Power of 2 in the numerator. */ int *b5, /* OUTPUT: Power of 5 in the numerator. */ int *s2, /* OUTPUT: Power of 2 in the denominator. */ int *s5) /* OUTPUT: Power of 5 in the denominator. */ { /* * Scale numerator and denominator powers of 2 so that the input binary * number is the ratio of integers. */ if (be <= 0) { *b2 = 0; *s2 = -be; } else { *b2 = be; *s2 = 0; } /* * Scale numerator and denominator so that the output decimal number is * the ratio of integers. */ if (k >= 0) { *b5 = 0; *s5 = k; *s2 += k; } else { *b2 -= k; *b5 = -k; *s5 = 0; } } /* *---------------------------------------------------------------------- * * SetPrecisionLimits -- * * Determines how many digits of significance should be computed (and, * hence, how much memory need be allocated) for formatting a floating * point number. * * Given that 'k' is floor(log10(x)): * if 'shortest' format is used, there will be at most 18 digits in the * result. * if 'F' format is used, there will be at most 'ndigits' + k + 1 digits * if 'E' format is used, there will be exactly 'ndigits' digits. * * Side effects: * Adjusts '*ndigitsPtr' to have a valid value. Stores the maximum memory * allocation needed in *iPtr. Sets '*iLimPtr' to the limiting number of * digits to convert if k has been guessed correctly, and '*iLim1Ptr' to * the limiting number of digits to convert if k has been guessed to be * one too high. * *---------------------------------------------------------------------- */ static inline void SetPrecisionLimits( int convType, /* Type of conversion: TCL_DD_SHORTEST, * TCL_DD_STEELE0, TCL_DD_E_FMT, * TCL_DD_F_FMT. */ int k, /* Floor(log10(number to convert)) */ int *ndigitsPtr, /* IN/OUT: Number of digits requested (will be * adjusted if needed). */ int *iPtr, /* OUT: Maximum number of digits to return. */ int *iLimPtr, /* OUT: Number of digits of significance if * the bignum method is used.*/ int *iLim1Ptr) /* OUT: Number of digits of significance if * the quick method is used. */ { switch (convType) { case TCL_DD_SHORTEST0: case TCL_DD_STEELE0: *iLimPtr = *iLim1Ptr = -1; *iPtr = 18; *ndigitsPtr = 0; break; case TCL_DD_E_FORMAT: if (*ndigitsPtr <= 0) { *ndigitsPtr = 1; } *iLimPtr = *iLim1Ptr = *iPtr = *ndigitsPtr; break; case TCL_DD_F_FORMAT: *iPtr = *ndigitsPtr + k + 1; *iLimPtr = *iPtr; *iLim1Ptr = *iPtr - 1; if (*iPtr <= 0) { *iPtr = 1; } break; default: *iPtr = -1; *iLimPtr = -1; *iLim1Ptr = -1; Tcl_Panic("impossible conversion type in TclDoubleDigits"); } } /* *---------------------------------------------------------------------- * * BumpUp -- * * Increases a string of digits ending in a series of nines to designate * the next higher number. xxxxb9999... -> xxxx(b+1)0000... * * Results: * Returns a pointer to the end of the adjusted string. * * Side effects: * In the case that the string consists solely of '999999', sets it to * "1" and moves the decimal point (*kPtr) one place to the right. * *---------------------------------------------------------------------- */ static inline char * BumpUp( char *s, /* Cursor pointing one past the end of the * string. */ char *retval, /* Start of the string of digits. */ int *kPtr) /* Position of the decimal point. */ { while (*--s == '9') { if (s == retval) { ++(*kPtr); *s = '1'; return s+1; } } ++*s; ++s; return s; } /* *---------------------------------------------------------------------- * * AdjustRange -- * * Rescales a 'double' in preparation for formatting it using the 'quick' * double-to-string method. * * Results: * Returns the precision that has been lost in the prescaling as a count * of units in the least significant place. * *---------------------------------------------------------------------- */ static inline int AdjustRange( double *dPtr, /* INOUT: Number to adjust. */ int k) /* IN: floor(log10(d)) */ { int ieps; /* Number of roundoff errors that have * accumulated. */ double d = *dPtr; /* Number to adjust. */ double ds; int i, j, j1; ieps = 2; if (k > 0) { /* * The number must be reduced to bring it into range. */ ds = tens[k & 0xF]; j = k >> 4; if (j & BLETCH) { j &= (BLETCH-1); d /= bigtens[N_BIGTENS - 1]; ieps++; } i = 0; for (; j != 0; j>>=1) { if (j & 1) { ds *= bigtens[i]; ++ieps; } ++i; } d /= ds; } else if ((j1 = -k) != 0) { /* * The number must be increased to bring it into range. */ d *= tens[j1 & 0xF]; i = 0; for (j = j1>>4; j; j>>=1) { if (j & 1) { ieps++; d *= bigtens[i]; } ++i; } } *dPtr = d; return ieps; } /* *---------------------------------------------------------------------- * * ShorteningQuickFormat -- * * Returns a 'quick' format of a double precision number to a string of * digits, preferring a shorter string of digits if the shorter string is * still within 1/2 ulp of the number. * * Results: * Returns the string of digits. Returns NULL if the 'quick' method fails * and the bignum method must be used. * * Side effects: * Stores the position of the decimal point at '*kPtr'. * *---------------------------------------------------------------------- */ static inline char * ShorteningQuickFormat( double d, /* Number to convert. */ int k, /* floor(log10(d)) */ int ilim, /* Number of significant digits to return. */ double eps, /* Estimated roundoff error. */ char *retval, /* Buffer to receive the digit string. */ int *kPtr) /* Pointer to stash the position of the * decimal point. */ { char *s = retval; /* Cursor in the return value. */ int digit; /* Current digit. */ int i; eps = 0.5 / tens[ilim-1] - eps; i = 0; for (;;) { /* * Convert a digit. */ digit = (int) d; d -= digit; *s++ = '0' + digit; /* * Truncate the conversion if the string of digits is within 1/2 ulp * of the actual value. */ if (d < eps) { *kPtr = k; return s; } if ((1. - d) < eps) { *kPtr = k; return BumpUp(s, retval, kPtr); } /* * Bail out if the conversion fails to converge to a sufficiently * precise value. */ if (++i >= ilim) { return NULL; } /* * Bring the next digit to the integer part. */ eps *= 10; d *= 10.0; } } /* *---------------------------------------------------------------------- * * StrictQuickFormat -- * * Convert a double precision number of a string of a precise number of * digits, using the 'quick' double precision method. * * Results: * Returns the digit string, or NULL if the bignum method must be used to * do the formatting. * * Side effects: * Stores the position of the decimal point in '*kPtr'. * *---------------------------------------------------------------------- */ static inline char * StrictQuickFormat( double d, /* Number to convert. */ int k, /* floor(log10(d)) */ int ilim, /* Number of significant digits to return. */ double eps, /* Estimated roundoff error. */ char *retval, /* Start of the digit string. */ int *kPtr) /* Pointer to stash the position of the * decimal point. */ { char *s = retval; /* Cursor in the return value. */ int digit; /* Current digit of the answer. */ int i; eps *= tens[ilim-1]; i = 1; for (;;) { /* * Extract a digit. */ digit = (int) d; d -= digit; if (d == 0.0) { ilim = i; } *s++ = '0' + digit; /* * When the given digit count is reached, handle trailing strings of 0 * and 9. */ if (i == ilim) { if (d > 0.5 + eps) { *kPtr = k; return BumpUp(s, retval, kPtr); } else if (d < 0.5 - eps) { while (*--s == '0') { /* do nothing */ } s++; *kPtr = k; return s; } else { return NULL; } } /* * Advance to the next digit. */ ++i; d *= 10.0; } } /* *---------------------------------------------------------------------- * * QuickConversion -- * * Converts a floating point number the 'quick' way, when only a limited * number of digits is required and floating point arithmetic can * therefore be used for the intermediate results. * * Results: * Returns the converted string, or NULL if the bignum method must be * used. * *---------------------------------------------------------------------- */ static inline char * QuickConversion( double e, /* Number to format. */ int k, /* floor(log10(d)), approximately. */ int k_check, /* 0 if k is exact, 1 if it may be too high */ int flags, /* Flags passed to dtoa: * TCL_DD_SHORTEN_FLAG */ int len, /* Length of the return value. */ int ilim, /* Number of digits to store. */ int ilim1, /* Number of digits to store if we misguessed * k. */ int *decpt, /* OUTPUT: Location of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the terminal null * byte. */ { int ieps; /* Number of 1-ulp roundoff errors that have * accumulated in the calculation. */ Double eps; /* Estimated roundoff error. */ char *retval; /* Returned string. */ char *end; /* Pointer to the terminal null byte in the * returned string. */ volatile double d; /* Workaround for a bug in mingw gcc 3.4.5 */ /* * Bring d into the range [1 .. 10). */ ieps = AdjustRange(&e, k); d = e; /* * If the guessed value of k didn't get d into range, adjust it by one. If * that leaves us outside the range in which quick format is accurate, * bail out. */ if (k_check && d < 1. && ilim > 0) { if (ilim1 < 0) { return NULL; } ilim = ilim1; --k; d = d * 10.0; ++ieps; } /* * Compute estimated roundoff error. */ eps.d = ieps * d + 7.; eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT; /* * Handle the peculiar case where the result has no significant digits. */ retval = ckalloc(len + 1); if (ilim == 0) { d = d - 5.; if (d > eps.d) { *retval = '1'; *decpt = k; return retval; } else if (d < -eps.d) { *decpt = k; return retval; } else { ckfree(retval); return NULL; } } /* * Format the digit string. */ if (flags & TCL_DD_SHORTEN_FLAG) { end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt); } else { end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt); } if (end == NULL) { ckfree(retval); return NULL; } *end = '\0'; if (endPtr != NULL) { *endPtr = end; } return retval; } /* *---------------------------------------------------------------------- * * CastOutPowersOf2 -- * * Adjust the factors 'b2', 'm2', and 's2' to cast out common powers of 2 * from numerator and denominator in preparation for the 'bignum' method * of floating point conversion. * *---------------------------------------------------------------------- */ static inline void CastOutPowersOf2( int *b2, /* Power of 2 to multiply the significand. */ int *m2, /* Power of 2 to multiply 1/2 ulp. */ int *s2) /* Power of 2 to multiply the common * denominator. */ { int i; if (*m2 > 0 && *s2 > 0) { /* Find the smallest power of 2 in the * numerator. */ if (*m2 < *s2) { /* Find the lowest common denominator. */ i = *m2; } else { i = *s2; } *b2 -= i; /* Reduce to lowest terms. */ *m2 -= i; *s2 -= i; } } /* *---------------------------------------------------------------------- * * ShorteningInt64Conversion -- * * Converts a double-precision number to the shortest string of digits * that reconverts exactly to the given number, or to 'ilim' digits if * that will yield a shorter result. The numerator and denominator in * David Gay's conversion algorithm are known to fit in Tcl_WideUInt, * giving considerably faster arithmetic than mp_int's. * * Results: * Returns the string of significant decimal digits, in newly allocated * memory * * Side effects: * Stores the location of the decimal point in '*decpt' and the location * of the terminal null byte in '*endPtr'. * *---------------------------------------------------------------------- */ static inline char * ShorteningInt64Conversion( Double *dPtr, /* Original number to convert. */ int convType, /* Type of conversion (shortest, Steele, * E format, F format). */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int m2plus, int m2minus, int m5, /* Scale factors for 1/2 ulp in the numerator * (will be different if bw == 1. */ int s2, int s5, /* Scale factors for the denominator. */ int k, /* Number of output digits before the decimal * point. */ int len, /* Number of digits to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { char *retval = ckalloc(len + 1); /* Output buffer. */ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2; /* Numerator of the fraction being * converted. */ Tcl_WideUInt S = wuipow5[s5] << s2; /* Denominator of the fraction being * converted. */ Tcl_WideUInt mplus, mminus; /* Ranges for testing whether the result is * within roundoff of being exact. */ int digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Current position in the output buffer. */ /* * Adjust if the logarithm was guessed wrong. */ if (b < S) { b = 10 * b; ++m2plus; ++m2minus; ++m5; ilim = ilim1; --k; } /* * Compute roundoff ranges. */ mplus = wuipow5[m5] << m2plus; mminus = wuipow5[m5] << m2minus; /* * Loop through the digits. */ i = 1; for (;;) { digit = (int)(b / S); if (digit > 10) { Tcl_Panic("wrong digit!"); } b = b % S; /* * Does the current digit put us on the low side of the exact value * but within within roundoff of being exact? */ if (b < mplus || (b == mplus && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) { /* * Make sure we shouldn't be rounding *up* instead, in case the * next number above is closer. */ if (2 * b > S || (2 * b == S && (digit & 1) != 0)) { ++digit; if (digit == 10) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } } /* * Stash the current digit. */ *s++ = '0' + digit; break; } /* * Does one plus the current digit put us within roundoff of the * number? */ if (b > S - mminus || (b == S - mminus && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) { if (digit == 9) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } ++digit; *s++ = '0' + digit; break; } /* * Have we converted all the requested digits? */ *s++ = '0' + digit; if (i == ilim) { if (2*b > S || (2*b == S && (digit & 1) != 0)) { s = BumpUp(s, retval, &k); } break; } /* * Advance to the next digit. */ b = 10 * b; mplus = 10 * mplus; mminus = 10 * mminus; ++i; } /* * Endgame - store the location of the decimal point and the end of the * string. */ *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } /* *---------------------------------------------------------------------- * * StrictInt64Conversion -- * * Converts a double-precision number to a fixed-length string of 'ilim' * digits that reconverts exactly to the given number. ('ilim' should be * replaced with 'ilim1' in the case where log10(d) has been * overestimated). The numerator and denominator in David Gay's * conversion algorithm are known to fit in Tcl_WideUInt, giving * considerably faster arithmetic than mp_int's. * * Results: * Returns the string of significant decimal digits, in newly allocated * memory * * Side effects: * Stores the location of the decimal point in '*decpt' and the location * of the terminal null byte in '*endPtr'. * *---------------------------------------------------------------------- */ static inline char * StrictInt64Conversion( Double *dPtr, /* Original number to convert. */ int convType, /* Type of conversion (shortest, Steele, * E format, F format). */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int s2, int s5, /* Scale factors for the denominator. */ int k, /* Number of output digits before the decimal * point. */ int len, /* Number of digits to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { char *retval = ckalloc(len + 1); /* Output buffer. */ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2; /* Numerator of the fraction being * converted. */ Tcl_WideUInt S = wuipow5[s5] << s2; /* Denominator of the fraction being * converted. */ int digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Current position in the output buffer. */ /* * Adjust if the logarithm was guessed wrong. */ if (b < S) { b = 10 * b; ilim = ilim1; --k; } /* * Loop through the digits. */ i = 1; for (;;) { digit = (int)(b / S); if (digit > 10) { Tcl_Panic("wrong digit!"); } b = b % S; /* * Have we converted all the requested digits? */ *s++ = '0' + digit; if (i == ilim) { if (2*b > S || (2*b == S && (digit & 1) != 0)) { s = BumpUp(s, retval, &k); } else { while (*--s == '0') { /* do nothing */ } ++s; } break; } /* * Advance to the next digit. */ b = 10 * b; ++i; } /* * Endgame - store the location of the decimal point and the end of the * string. */ *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } /* *---------------------------------------------------------------------- * * ShouldBankerRoundUpPowD -- * * Test whether bankers' rounding should round a digit up. Assumption is * made that the denominator of the fraction being tested is a power of * 2**MP_DIGIT_BIT. * * Results: * Returns 1 iff the fraction is more than 1/2, or if the fraction is * exactly 1/2 and the digit is odd. * *---------------------------------------------------------------------- */ static inline int ShouldBankerRoundUpPowD( mp_int *b, /* Numerator of the fraction. */ int sd, /* Denominator is 2**(sd*MP_DIGIT_BIT). */ int isodd) /* 1 if the digit is odd, 0 if even. */ { int i; static const mp_digit topbit = ((mp_digit)1) << (MP_DIGIT_BIT - 1); if (b->used < sd || (b->dp[sd-1] & topbit) == 0) { return 0; } if (b->dp[sd-1] != topbit) { return 1; } for (i = sd-2; i >= 0; --i) { if (b->dp[i] != 0) { return 1; } } return isodd; } /* *---------------------------------------------------------------------- * * ShouldBankerRoundUpToNextPowD -- * * Tests whether bankers' rounding will round down in the "denominator is * a power of 2**MP_DIGIT" case. * * Results: * Returns 1 if the rounding will be performed - which increases the * digit by one - and 0 otherwise. * *---------------------------------------------------------------------- */ static inline int ShouldBankerRoundUpToNextPowD( mp_int *b, /* Numerator of the fraction. */ mp_int *m, /* Numerator of the rounding tolerance. */ int sd, /* Common denominator is 2**(sd*MP_DIGIT_BIT). */ int convType, /* Conversion type: STEELE defeats * round-to-even (not sure why one wants to do * this; I copied it from Gay). FIXME */ int isodd, /* 1 if the integer significand is odd. */ mp_int *temp) /* Work area for the calculation. */ { int i; /* * Compare B and S-m - which is the same as comparing B+m and S - which we * do by computing b+m and doing a bitwhack compare against * 2**(MP_DIGIT_BIT*sd) */ mp_add(b, m, temp); if (temp->used <= sd) { /* Too few digits to be > s */ return 0; } if (temp->used > sd+1 || temp->dp[sd] > 1) { /* >= 2s */ return 1; } for (i = sd-1; i >= 0; --i) { /* Check for ==s */ if (temp->dp[i] != 0) { /* > s */ return 1; } } if (convType == TCL_DD_STEELE0) { /* Biased rounding. */ return 0; } return isodd; } /* *---------------------------------------------------------------------- * * ShorteningBignumConversionPowD -- * * Converts a double-precision number to the shortest string of digits * that reconverts exactly to the given number, or to 'ilim' digits if * that will yield a shorter result. The denominator in David Gay's * conversion algorithm is known to be a power of 2**MP_DIGIT_BIT, and hence * the division in the main loop may be replaced by a digit shift and * mask. * * Results: * Returns the string of significant decimal digits, in newly allocated * memory * * Side effects: * Stores the location of the decimal point in '*decpt' and the location * of the terminal null byte in '*endPtr'. * *---------------------------------------------------------------------- */ static inline char * ShorteningBignumConversionPowD( Double *dPtr, /* Original number to convert. */ int convType, /* Type of conversion (shortest, Steele, * E format, F format). */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int m2plus, int m2minus, int m5, /* Scale factors for 1/2 ulp in the numerator * (will be different if bw == 1). */ int sd, /* Scale factor for the denominator. */ int k, /* Number of output digits before the decimal * point. */ int len, /* Number of digits to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { char *retval = ckalloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ mp_int mplus, mminus; /* Bounds for roundoff. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ mp_int temp; int r1; /* * b = bw * 2**b2 * 5**b5 * mminus = 5**m5 */ TclBNInitBignumFromWideUInt(&b, bw); mp_init_set(&mminus, 1); MulPow5(&b, b5, &b); mp_mul_2d(&b, b2, &b); /* * Adjust if the logarithm was guessed wrong. */ if (b.used <= sd) { mp_mul_d(&b, 10, &b); ++m2plus; ++m2minus; ++m5; ilim = ilim1; --k; } /* * mminus = 5**m5 * 2**m2minus * mplus = 5**m5 * 2**m2plus */ mp_mul_2d(&mminus, m2minus, &mminus); MulPow5(&mminus, m5, &mminus); if (m2plus > m2minus) { mp_init_copy(&mplus, &mminus); mp_mul_2d(&mplus, m2plus-m2minus, &mplus); } mp_init(&temp); /* * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT) * by mp_digit extraction. */ i = 0; for (;;) { if (b.used <= sd) { digit = 0; } else { digit = b.dp[sd]; if (b.used > sd+1 || digit >= 10) { Tcl_Panic("wrong digit!"); } --b.used; mp_clamp(&b); } /* * Does the current digit put us on the low side of the exact value * but within within roundoff of being exact? */ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus); if (r1 == MP_LT || (r1 == MP_EQ && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) { /* * Make sure we shouldn't be rounding *up* instead, in case the * next number above is closer. */ if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) { ++digit; if (digit == 10) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } } /* * Stash the last digit. */ *s++ = '0' + digit; break; } /* * Does one plus the current digit put us within roundoff of the * number? */ if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd, convType, dPtr->w.word1 & 1, &temp)) { if (digit == 9) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } ++digit; *s++ = '0' + digit; break; } /* * Have we converted all the requested digits? */ *s++ = '0' + digit; if (i == ilim) { if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) { s = BumpUp(s, retval, &k); } break; } /* * Advance to the next digit. */ mp_mul_d(&b, 10, &b); mp_mul_d(&mminus, 10, &mminus); if (m2plus > m2minus) { mp_mul_2d(&mminus, m2plus-m2minus, &mplus); } ++i; } /* * Endgame - store the location of the decimal point and the end of the * string. */ if (m2plus > m2minus) { mp_clear(&mplus); } mp_clear_multi(&b, &mminus, &temp, NULL); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } /* *---------------------------------------------------------------------- * * StrictBignumConversionPowD -- * * Converts a double-precision number to a fixed-lengt string of 'ilim' * digits (or 'ilim1' if log10(d) has been overestimated). The * denominator in David Gay's conversion algorithm is known to be a power * of 2**MP_DIGIT_BIT, and hence the division in the main loop may be * replaced by a digit shift and mask. * * Results: * Returns the string of significant decimal digits, in newly allocated * memory. * * Side effects: * Stores the location of the decimal point in '*decpt' and the location * of the terminal null byte in '*endPtr'. * *---------------------------------------------------------------------- */ static inline char * StrictBignumConversionPowD( Double *dPtr, /* Original number to convert. */ int convType, /* Type of conversion (shortest, Steele, * E format, F format). */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int sd, /* Scale factor for the denominator. */ int k, /* Number of output digits before the decimal * point. */ int len, /* Number of digits to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { char *retval = ckalloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ mp_int temp; /* * b = bw * 2**b2 * 5**b5 */ TclBNInitBignumFromWideUInt(&b, bw); MulPow5(&b, b5, &b); mp_mul_2d(&b, b2, &b); /* * Adjust if the logarithm was guessed wrong. */ if (b.used <= sd) { mp_mul_d(&b, 10, &b); ilim = ilim1; --k; } mp_init(&temp); /* * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT) * by mp_digit extraction. */ i = 1; for (;;) { if (b.used <= sd) { digit = 0; } else { digit = b.dp[sd]; if (b.used > sd+1 || digit >= 10) { Tcl_Panic("wrong digit!"); } --b.used; mp_clamp(&b); } /* * Have we converted all the requested digits? */ *s++ = '0' + digit; if (i == ilim) { if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) { s = BumpUp(s, retval, &k); } while (*--s == '0') { /* do nothing */ } ++s; break; } /* * Advance to the next digit. */ mp_mul_d(&b, 10, &b); ++i; } /* * Endgame - store the location of the decimal point and the end of the * string. */ mp_clear_multi(&b, &temp, NULL); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } /* *---------------------------------------------------------------------- * * ShouldBankerRoundUp -- * * Tests whether a digit should be rounded up or down when finishing * bignum-based floating point conversion. * * Results: * Returns 1 if the number needs to be rounded up, 0 otherwise. * *---------------------------------------------------------------------- */ static inline int ShouldBankerRoundUp( mp_int *twor, /* 2x the remainder from thd division that * produced the last digit. */ mp_int *S, /* Denominator. */ int isodd) /* Flag == 1 if the last digit is odd. */ { int r = mp_cmp_mag(twor, S); switch (r) { case MP_LT: return 0; case MP_EQ: return isodd; case MP_GT: return 1; } Tcl_Panic("in ShouldBankerRoundUp, trichotomy fails!"); return 0; } /* *---------------------------------------------------------------------- * * ShouldBankerRoundUpToNext -- * * Tests whether the remainder is great enough to force rounding to the * next higher digit. * * Results: * Returns 1 if the number should be rounded up, 0 otherwise. * *---------------------------------------------------------------------- */ static inline int ShouldBankerRoundUpToNext( mp_int *b, /* Remainder from the division that produced * the last digit. */ mp_int *m, /* Numerator of the rounding tolerance. */ mp_int *S, /* Denominator. */ int convType, /* Conversion type: STEELE0 defeats * round-to-even. (Not sure why one would want * this; I coped it from Gay). FIXME */ int isodd, /* 1 if the integer significand is odd. */ mp_int *temp) /* Work area needed for the calculation. */ { int r; /* * Compare b and S-m: this is the same as comparing B+m and S. */ mp_add(b, m, temp); r = mp_cmp_mag(temp, S); switch(r) { case MP_LT: return 0; case MP_EQ: if (convType == TCL_DD_STEELE0) { return 0; } else { return isodd; } case MP_GT: return 1; } Tcl_Panic("in ShouldBankerRoundUpToNext, trichotomy fails!"); return 0; } /* *---------------------------------------------------------------------- * * ShorteningBignumConversion -- * * Convert a floating point number to a variable-length digit string * using the multiprecision method. * * Results: * Returns the string of digits. * * Side effects: * Stores the position of the decimal point in *decpt. Stores a pointer * to the end of the number in *endPtr. * *---------------------------------------------------------------------- */ static inline char * ShorteningBignumConversion( Double *dPtr, /* Original number being converted. */ int convType, /* Conversion type. */ Tcl_WideUInt bw, /* Integer significand and exponent. */ int b2, /* Scale factor for the significand. */ int m2plus, int m2minus, /* Scale factors for 1/2 ulp in numerator. */ int s2, int s5, /* Scale factors for denominator. */ int k, /* Guessed position of the decimal point. */ int len, /* Size of the digit buffer to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { char *retval = ckalloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ mp_int mminus; /* 1/2 ulp below the result. */ mp_int mplus; /* 1/2 ulp above the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ mp_int temp; /* Work area. */ int minit = 1; /* Fudge factor for when we misguess k. */ int i; int r1; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ TclBNInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); mp_init_set(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* * Handle the case where we guess the position of the decimal point wrong. */ if (mp_cmp_mag(&b, &S) == MP_LT) { mp_mul_d(&b, 10, &b); minit = 10; ilim =ilim1; --k; } /* * mminus = 2**m2minus * 5**m5 */ mp_init_set(&mminus, minit); mp_mul_2d(&mminus, m2minus, &mminus); if (m2plus > m2minus) { mp_init_copy(&mplus, &mminus); mp_mul_2d(&mplus, m2plus-m2minus, &mplus); } mp_init(&temp); /* * Loop through the digits. */ mp_init(&dig); i = 1; for (;;) { mp_div(&b, &S, &dig, &b); if (dig.used > 1 || dig.dp[0] >= 10) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; /* * Does the current digit leave us with a remainder small enough to * round to it? */ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus); if (r1 == MP_LT || (r1 == MP_EQ && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) { mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { ++digit; if (digit == 10) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } } *s++ = '0' + digit; break; } /* * Does the current digit leave us with a remainder large enough to * commit to rounding up to the next higher digit? */ if (ShouldBankerRoundUpToNext(&b, &mminus, &S, convType, dPtr->w.word1 & 1, &temp)) { ++digit; if (digit == 10) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } *s++ = '0' + digit; break; } /* * Have we converted all the requested digits? */ *s++ = '0' + digit; if (i == ilim) { mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } break; } /* * Advance to the next digit. */ if (s5 > 0) { /* * Can possibly shorten the denominator. */ mp_mul_2d(&b, 1, &b); mp_mul_2d(&mminus, 1, &mminus); if (m2plus > m2minus) { mp_mul_2d(&mplus, 1, &mplus); } mp_div_d(&S, 5, &S, NULL); --s5; /* * IDEA: It might possibly be a win to fall back to int64_t * arithmetic here if S < 2**64/10. But it's a win only for * a fairly narrow range of magnitudes so perhaps not worth * bothering. We already know that we shorten the * denominator by at least 1 mp_digit, perhaps 2, as we do * the conversion for 17 digits of significance. * Possible savings: * 10**26 1 trip through loop before fallback possible * 10**27 1 trip * 10**28 2 trips * 10**29 3 trips * 10**30 4 trips * 10**31 5 trips * 10**32 6 trips * 10**33 7 trips * 10**34 8 trips * 10**35 9 trips * 10**36 10 trips * 10**37 11 trips * 10**38 12 trips * 10**39 13 trips * 10**40 14 trips * 10**41 15 trips * 10**42 16 trips * thereafter no gain. */ } else { mp_mul_d(&b, 10, &b); mp_mul_d(&mminus, 10, &mminus); if (m2plus > m2minus) { mp_mul_2d(&mplus, 10, &mplus); } } ++i; } /* * Endgame - store the location of the decimal point and the end of the * string. */ if (m2plus > m2minus) { mp_clear(&mplus); } mp_clear_multi(&b, &mminus, &temp, &dig, &S, NULL); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } /* *---------------------------------------------------------------------- * * StrictBignumConversion -- * * Convert a floating point number to a fixed-length digit string using * the multiprecision method. * * Results: * Returns the string of digits. * * Side effects: * Stores the position of the decimal point in *decpt. Stores a pointer * to the end of the number in *endPtr. * *---------------------------------------------------------------------- */ static inline char * StrictBignumConversion( Double *dPtr, /* Original number being converted. */ int convType, /* Conversion type. */ Tcl_WideUInt bw, /* Integer significand and exponent. */ int b2, /* Scale factor for the significand. */ int s2, int s5, /* Scale factors for denominator. */ int k, /* Guessed position of the decimal point. */ int len, /* Size of the digit buffer to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { char *retval = ckalloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ mp_int temp; /* Work area. */ int g; /* Size of the current digit ground. */ int i, j; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ mp_init_multi(&temp, &dig, NULL); TclBNInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); mp_init_set(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* * Handle the case where we guess the position of the decimal point wrong. */ if (mp_cmp_mag(&b, &S) == MP_LT) { mp_mul_d(&b, 10, &b); ilim =ilim1; --k; } /* * Convert the leading digit. */ i = 0; mp_div(&b, &S, &dig, &b); if (dig.used > 1 || dig.dp[0] >= 10) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; /* * Is a single digit all that was requested? */ *s++ = '0' + digit; if (++i >= ilim) { mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } } else { for (;;) { /* * Shift by a group of digits. */ g = ilim - i; if (g > DIGIT_GROUP) { g = DIGIT_GROUP; } if (s5 >= g) { mp_div_d(&S, dpow5[g], &S, NULL); s5 -= g; } else if (s5 > 0) { mp_div_d(&S, dpow5[s5], &S, NULL); mp_mul_d(&b, dpow5[g - s5], &b); s5 = 0; } else { mp_mul_d(&b, dpow5[g], &b); } mp_mul_2d(&b, g, &b); /* * As with the shortening bignum conversion, it's possible at this * point that we will have reduced the denominator to less than * 2**64/10, at which point it would be possible to fall back to * to int64_t arithmetic. But the potential payoff is tremendously * less - unless we're working in F format - because we know that * three groups of digits will always suffice for %#.17e, the * longest format that doesn't introduce empty precision. * * Extract the next group of digits. */ mp_div(&b, &S, &dig, &b); if (dig.used > 1) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; for (j = g-1; j >= 0; --j) { int t = itens[j]; *s++ = digit / t + '0'; digit %= t; } i += g; /* * Have we converted all the requested digits? */ if (i == ilim) { mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } break; } } } while (*--s == '0') { /* do nothing */ } ++s; /* * Endgame - store the location of the decimal point and the end of the * string. */ mp_clear_multi(&b, &S, &temp, &dig, NULL); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } /* *---------------------------------------------------------------------- * * TclDoubleDigits -- * * Core of Tcl's conversion of double-precision floating point numbers to * decimal. * * Results: * Returns a newly-allocated string of digits. * * Side effects: * Sets *decpt to the index of the character in the string before the * place that the decimal point should go. If 'endPtr' is not NULL, sets * endPtr to point to the terminating '\0' byte of the string. Sets *sign * to 1 if a minus sign should be printed with the number, or 0 if a plus * sign (or no sign) should appear. * * This function is a service routine that produces the string of digits for * floating-point-to-decimal conversion. It can do a number of things * according to the 'flags' argument. Valid values for 'flags' include: * TCL_DD_SHORTEST - This is the default for floating point conversion if * ::tcl_precision is 0. It constructs the shortest string of * digits that will reconvert to the given number when scanned. * For floating point numbers that are exactly between two * decimal numbers, it resolves using the 'round to even' rule. * With this value, the 'ndigits' parameter is ignored. * TCL_DD_STEELE - This value is not recommended and may be removed in * the future. It follows the conversion algorithm outlined in * "How to Print Floating-Point Numbers Accurately" by Guy * L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, * pp. 112-126]. This rule has the effect of rendering 1e23 as * 9.9999999999999999e22 - which is a 'better' approximation in * the sense that it will reconvert correctly even if a * subsequent input conversion is 'round up' or 'round down' * rather than 'round to nearest', but is surprising otherwise. * TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format * conversion (or for default floating->string if tcl_precision * is not 0). It constructs a string of at most 'ndigits' digits, * choosing the one that is closest to the given number (and * resolving ties with 'round to even'). It is allowed to return * fewer than 'ndigits' if the number converts exactly; if the * TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG is supplied instead, it * also returns fewer digits if the shorter string will still * reconvert without loss to the given input number. In any case, * strings of trailing zeroes are suppressed. * TCL_DD_F_FORMAT - This value is used to prepare numbers for %f format * conversion. It requests that conversion proceed until * 'ndigits' digits after the decimal point have been converted. * It is possible for this format to result in a zero-length * string if the number is sufficiently small. Again, it is * permissible for TCL_DD_F_FORMAT to return fewer digits for a * number that converts exactly, and changing the argument to * TCL_DD_F_FORMAT|TCL_DD_SHORTEN_FLAG will allow the routine * also to return fewer digits if the shorter string will still * reconvert without loss to the given input number. Strings of * trailing zeroes are suppressed. * * To any of these flags may be OR'ed TCL_DD_NO_QUICK; this flag requires * all calculations to be done in exact arithmetic. Normally, E and F * format with fewer than about 14 digits will be done with a quick * floating point approximation and fall back on the exact arithmetic * only if the input number is close enough to the midpoint between two * decimal strings that more precision is needed to resolve which string * is correct. * * The value stored in the 'decpt' argument on return may be negative * (indicating that the decimal point falls to the left of the string) or * greater than the length of the string. In addition, the value -9999 is used * as a sentinel to indicate that the string is one of the special values * "Infinity" and "NaN", and that no decimal point should be inserted. * *---------------------------------------------------------------------- */ char * TclDoubleDigits( double dv, /* Number to convert. */ int ndigits, /* Number of digits requested. */ int flags, /* Conversion flags. */ int *decpt, /* OUTPUT: Position of the decimal point. */ int *sign, /* OUTPUT: 1 if the result is negative. */ char **endPtr) /* OUTPUT: If not NULL, receives a pointer to * one character beyond the end of the * returned string. */ { int convType = (flags & TCL_DD_CONVERSION_TYPE_MASK); /* Type of conversion being performed: * TCL_DD_SHORTEST0, TCL_DD_STEELE0, * TCL_DD_E_FORMAT, or TCL_DD_F_FORMAT. */ Double d; /* Union for deconstructing doubles. */ Tcl_WideUInt bw; /* Integer significand. */ int be; /* Power of 2 by which b must be multiplied */ int bbits; /* Number of bits needed to represent b. */ int denorm; /* Flag == 1 iff the input number was * denormalized. */ int k; /* Estimate of floor(log10(d)). */ int k_check; /* Flag == 1 if d is near enough to a power of * ten that k must be checked. */ int b2, b5, s2, s5; /* Powers of 2 and 5 in the numerator and * denominator of intermediate results. */ int ilim = -1, ilim1 = -1; /* Number of digits to convert, and number to * convert if log10(d) has been * overestimated. */ char *retval; /* Return value from this function. */ int i = -1; /* * Put the input number into a union for bit-whacking. */ d.d = dv; /* * Handle the cases of negative numbers (by taking the absolute value: * this includes -Inf and -NaN!), infinity, Not a Number, and zero. */ TakeAbsoluteValue(&d, sign); if ((d.w.word0 & EXP_MASK) == EXP_MASK) { return FormatInfAndNaN(&d, decpt, endPtr); } if (d.d == 0.0) { return FormatZero(decpt, endPtr); } /* * Unpack the floating point into a wide integer and an exponent. * Determine the number of bits that the big integer requires, and compute * a quick approximation (which may be one too high) of ceil(log10(d.d)). */ denorm = ((d.w.word0 & EXP_MASK) == 0); DoubleToExpAndSig(d.d, &bw, &be, &bbits); k = ApproximateLog10(bw, be, bbits); k = BetterLog10(d.d, k, &k_check); /* At this point, we have: * d is the number to convert. * bw are significand and exponent: d == bw*2**be, * bbits is the length of bw: 2**bbits-1 <= bw < 2**bbits * k is either ceil(log10(d)) or ceil(log10(d))+1. k_check is 0 if we * know that k is exactly ceil(log10(d)) and 1 if we need to check. * We want a rational number * r = b * 10**(1-k) = bw * 2**b2 * 5**b5 / (2**s2 / 5**s5), * with b2, b5, s2, s5 >= 0. Note that the most significant decimal * digit is floor(r) and that successive digits can be obtained by * setting r <- 10*floor(r) (or b <= 10 * (b % S)). Find appropriate * b2, b5, s2, s5. */ ComputeScale(be, k, &b2, &b5, &s2, &s5); /* * Correct an incorrect caller-supplied 'ndigits'. Also determine: * i = The maximum number of decimal digits that will be returned in the * formatted string. This is k + 1 + ndigits for F format, 18 for * shortest and Steele, and ndigits for E format. * ilim = The number of significant digits to convert if k has been * guessed correctly. This is -1 for shortest and Steele (which * stop when all significance has been lost), 'ndigits' for E * format, and 'k + 1 + ndigits' for F format. * ilim1 = The minimum number of significant digits to convert if k has * been guessed 1 too high. This, too, is -1 for shortest and * Steele, and 'ndigits' for E format, but it's 'ndigits-1' for F * format. */ SetPrecisionLimits(convType, k, &ndigits, &i, &ilim, &ilim1); /* * Try to do low-precision conversion in floating point rather than * resorting to expensive multiprecision arithmetic. */ if (ilim >= 0 && ilim <= QUICK_MAX && !(flags & TCL_DD_NO_QUICK)) { retval = QuickConversion(d.d, k, k_check, flags, i, ilim, ilim1, decpt, endPtr); if (retval != NULL) { return retval; } } /* * For shortening conversions, determine the upper and lower bounds for * the remainder at which we can stop. * m+ = (2**m2plus * 5**m5) / (2**s2 * 5**s5) is the limit on the high * side, and * m- = (2**m2minus * 5**m5) / (2**s2 * 5**s5) is the limit on the low * side. * We may need to increase s2 to put m2plus, m2minus, b2 over a common * denominator. */ if (flags & TCL_DD_SHORTEN_FLAG) { int m2minus = b2; int m2plus; int m5 = b5; int len = i; /* * Find the quantity i so that (2**i*5**b5)/(2**s2*5**s5) is 1/2 unit * in the least significant place of the floating point number. */ if (denorm) { i = be + EXPONENT_BIAS + (FP_PRECISION-1); } else { i = 1 + FP_PRECISION - bbits; } b2 += i; s2 += i; /* * Reduce the fractions to lowest terms, since the above calculation * may have left excess powers of 2 in numerator and denominator. */ CastOutPowersOf2(&b2, &m2minus, &s2); /* * In the special case where bw==1, the nearest floating point number * to it on the low side is 1/4 ulp below it. Adjust accordingly. */ m2plus = m2minus; if (!denorm && bw == 1) { ++b2; ++s2; ++m2plus; } if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) { /* * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word, * then all our intermediate calculations can be done using exact * 64-bit arithmetic with no need for expensive multiprecision * operations. (This will be true for all numbers in the range * [1.0e-3 .. 1.0e+24]). */ return ShorteningInt64Conversion(&d, convType, bw, b2, b5, m2plus, m2minus, m5, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } else if (s5 == 0) { /* * The denominator is a power of 2, so we can replace division by * digit shifts. First we round up s2 to a multiple of MP_DIGIT_BIT, * and adjust m2 and b2 accordingly. Then we launch into a version * of the comparison that's specialized for the 'power of mp_digit * in the denominator' case. */ if (s2 % MP_DIGIT_BIT != 0) { int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT); b2 += delta; m2plus += delta; m2minus += delta; s2 += delta; } return ShorteningBignumConversionPowD(&d, convType, bw, b2, b5, m2plus, m2minus, m5, s2/MP_DIGIT_BIT, k, len, ilim, ilim1, decpt, endPtr); } else { /* * Alas, there's no helpful special case; use full-up bignum * arithmetic for the conversion. */ return ShorteningBignumConversion(&d, convType, bw, b2, m2plus, m2minus, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } } else { /* * Non-shortening conversion. */ int len = i; /* * Reduce numerator and denominator to lowest terms. */ if (b2 >= s2 && s2 > 0) { b2 -= s2; s2 = 0; } else if (s2 >= b2 && b2 > 0) { s2 -= b2; b2 = 0; } if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) { /* * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word, * then all our intermediate calculations can be done using exact * 64-bit arithmetic with no need for expensive multiprecision * operations. */ return StrictInt64Conversion(&d, convType, bw, b2, b5, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } else if (s5 == 0) { /* * The denominator is a power of 2, so we can replace division by * digit shifts. First we round up s2 to a multiple of MP_DIGIT_BIT, * and adjust m2 and b2 accordingly. Then we launch into a version * of the comparison that's specialized for the 'power of mp_digit * in the denominator' case. */ if (s2 % MP_DIGIT_BIT != 0) { int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT); b2 += delta; s2 += delta; } return StrictBignumConversionPowD(&d, convType, bw, b2, b5, s2/MP_DIGIT_BIT, k, len, ilim, ilim1, decpt, endPtr); } else { /* * There are no helpful special cases, but at least we know in * advance how many digits we will convert. We can run the * conversion in steps of DIGIT_GROUP digits, so as to have many * fewer mp_int divisions. */ return StrictBignumConversion(&d, convType, bw, b2, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } } } /* *---------------------------------------------------------------------- * * TclInitDoubleConversion -- * * Initializes constants that are needed for conversions to and from * 'double' * * Results: * None. * * Side effects: * The log base 2 of the floating point radix, the number of bits in a * double mantissa, and a table of the powers of five and ten are * computed and stored. * *---------------------------------------------------------------------- */ void TclInitDoubleConversion(void) { int i; int x; Tcl_WideUInt u; double d; #ifdef IEEE_FLOATING_POINT union { double dv; Tcl_WideUInt iv; } bitwhack; #endif #if defined(__sgi) && defined(_COMPILER_VERSION) union fpc_csr mipsCR; mipsCR.fc_word = get_fpc_csr(); mipsCR.fc_struct.flush = 0; set_fpc_csr(mipsCR.fc_word); #endif /* * Initialize table of powers of 10 expressed as wide integers. */ maxpow10_wide = (int) floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.)); pow10_wide = (Tcl_WideUInt *) ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); u = 1; for (i = 0; i < maxpow10_wide; ++i) { pow10_wide[i] = u; u *= 10; } pow10_wide[i] = u; /* * Determine how many bits of precision a double has, and how many decimal * digits that represents. */ if (frexp((double) FLT_RADIX, &log2FLT_RADIX) != 0.5) { Tcl_Panic("This code doesn't work on a decimal machine!"); } log2FLT_RADIX--; mantBits = DBL_MANT_DIG * log2FLT_RADIX; d = 1.0; /* * Initialize a table of powers of ten that can be exactly represented in * a double. */ x = (int) (DBL_MANT_DIG * log((double) FLT_RADIX) / log(5.0)); if (x < MAXPOW) { mmaxpow = x; } else { mmaxpow = MAXPOW; } for (i=0 ; i<=mmaxpow ; ++i) { pow10vals[i] = d; d *= 10.0; } /* * Initialize a table of large powers of five. */ for (i=0; i<9; ++i) { mp_init(pow5 + i); } mp_set(pow5, 5); for (i=0; i<8; ++i) { mp_sqr(pow5+i, pow5+i+1); } mp_init_set_int(pow5_13, 1220703125); for (i = 1; i < 5; ++i) { mp_init(pow5_13 + i); mp_sqr(pow5_13 + i - 1, pow5_13 + i); } /* * Determine the number of decimal digits to the left and right of the * decimal point in the largest and smallest double, the smallest double * that differs from zero, and the number of mp_digits needed to represent * the significand of a double. */ maxDigits = (int) ((DBL_MAX_EXP * log((double) FLT_RADIX) + 0.5 * log(10.)) / log(10.)); minDigits = (int) floor((DBL_MIN_EXP - DBL_MANT_DIG) * log((double) FLT_RADIX) / log(10.)); log10_DIGIT_MAX = (int) floor(MP_DIGIT_BIT * log(2.) / log(10.)); /* * Nokia 770's software-emulated floating point is "middle endian": the * bytes within a 32-bit word are little-endian (like the native * integers), but the two words of a 'double' are presented most * significant word first. */ #ifdef IEEE_FLOATING_POINT bitwhack.dv = 1.000000238418579; /* 3ff0 0000 4000 0000 */ if ((bitwhack.iv >> 32) == 0x3FF00000) { n770_fp = 0; } else if ((bitwhack.iv & 0xFFFFFFFF) == 0x3FF00000) { n770_fp = 1; } else { Tcl_Panic("unknown floating point word order on this machine"); } #endif } /* *---------------------------------------------------------------------- * * TclFinalizeDoubleConversion -- * * Cleans up this file on exit. * * Results: * None * * Side effects: * Memory allocated by TclInitDoubleConversion is freed. * *---------------------------------------------------------------------- */ void TclFinalizeDoubleConversion(void) { int i; ckfree(pow10_wide); for (i=0; i<9; ++i) { mp_clear(pow5 + i); } for (i=0; i < 5; ++i) { mp_clear(pow5_13 + i); } } /* *---------------------------------------------------------------------- * * Tcl_InitBignumFromDouble -- * * Extracts the integer part of a double and converts it to an arbitrary * precision integer. * * Results: * None. * * Side effects: * Initializes the bignum supplied, and stores the converted number in * it. * *---------------------------------------------------------------------- */ int Tcl_InitBignumFromDouble( Tcl_Interp *interp, /* For error message. */ double d, /* Number to convert. */ mp_int *b) /* Place to store the result. */ { double fract; int expt; /* * Infinite values can't convert to bignum. */ if (TclIsInfinite(d)) { if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); } return TCL_ERROR; } fract = frexp(d,&expt); if (expt <= 0) { mp_init(b); mp_zero(b); } else { Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits); int shift = expt - mantBits; TclBNInitBignumFromWideInt(b, w); if (shift < 0) { mp_div_2d(b, -shift, b, NULL); } else if (shift > 0) { mp_mul_2d(b, shift, b); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclBignumToDouble -- * * Convert an arbitrary-precision integer to a native floating point * number. * * Results: * Returns the converted number. Sets errno to ERANGE if the number is * too large to convert. * *---------------------------------------------------------------------- */ double TclBignumToDouble( const mp_int *a) /* Integer to convert. */ { mp_int b; int bits, shift, i, lsb; double r; /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. */ bits = mp_count_bits(a); if (bits > DBL_MAX_EXP*log2FLT_RADIX) { errno = ERANGE; if (mp_isneg(a)) { return -HUGE_VAL; } else { return HUGE_VAL; } } shift = mantBits - bits; /* * If shift > 0, shift the significand left by the requisite number of * bits. If shift == 0, the significand is already exactly 'mantBits' * in length. If shift < 0, we will need to shift the significand right * by the requisite number of bits, and round it. If the '1-shift' * least significant bits are 0, but the 'shift'th bit is nonzero, * then the significand lies exactly between two values and must be * 'rounded to even'. */ mp_init(&b); if (shift == 0) { mp_copy(a, &b); } else if (shift > 0) { mp_mul_2d(a, shift, &b); } else if (shift < 0) { lsb = mp_cnt_lsb(a); if (lsb == -1-shift) { /* * Round to even */ mp_div_2d(a, -shift, &b, NULL); if (mp_isodd(&b)) { if (mp_isneg(&b)) { mp_sub_d(&b, 1, &b); } else { mp_add_d(&b, 1, &b); } } } else { /* * Ordinary rounding */ mp_div_2d(a, -1-shift, &b, NULL); if (mp_isneg(&b)) { mp_sub_d(&b, 1, &b); } else { mp_add_d(&b, 1, &b); } mp_div_2d(&b, 1, &b, NULL); } } /* * Accumulate the result, one mp_digit at a time. */ r = 0.0; for (i=b.used-1 ; i>=0 ; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } mp_clear(&b); /* * Scale the result to the correct number of bits. */ r = ldexp(r, bits - mantBits); /* * Return the result with the appropriate sign. */ if (mp_isneg(a)) { return -r; } else { return r; } } /* *---------------------------------------------------------------------- * * TclCeil -- * * Computes the smallest floating point number that is at least the * mp_int argument. * * Results: * Returns the floating point number. * *---------------------------------------------------------------------- */ double TclCeil( const mp_int *a) /* Integer to convert. */ { double r = 0.0; mp_int b; mp_init(&b); if (mp_cmp_d(a, 0) == MP_LT) { mp_neg(a, &b); r = -TclFloor(&b); } else { int bits = mp_count_bits(a); if (bits > DBL_MAX_EXP*log2FLT_RADIX) { r = HUGE_VAL; } else { int i, exact = 1, shift = mantBits - bits; if (shift > 0) { mp_mul_2d(a, shift, &b); } else if (shift < 0) { mp_int d; mp_init(&d); mp_div_2d(a, -shift, &b, &d); exact = mp_iszero(&d); mp_clear(&d); } else { mp_copy(a, &b); } if (!exact) { mp_add_d(&b, 1, &b); } for (i=b.used-1 ; i>=0 ; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } r = ldexp(r, bits - mantBits); } } mp_clear(&b); return r; } /* *---------------------------------------------------------------------- * * TclFloor -- * * Computes the largest floating point number less than or equal to the * mp_int argument. * * Results: * Returns the floating point value. * *---------------------------------------------------------------------- */ double TclFloor( const mp_int *a) /* Integer to convert. */ { double r = 0.0; mp_int b; mp_init(&b); if (mp_cmp_d(a, 0) == MP_LT) { mp_neg(a, &b); r = -TclCeil(&b); } else { int bits = mp_count_bits(a); if (bits > DBL_MAX_EXP*log2FLT_RADIX) { r = DBL_MAX; } else { int i, shift = mantBits - bits; if (shift > 0) { mp_mul_2d(a, shift, &b); } else if (shift < 0) { mp_div_2d(a, -shift, &b, NULL); } else { mp_copy(a, &b); } for (i=b.used-1 ; i>=0 ; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } r = ldexp(r, bits - mantBits); } } mp_clear(&b); return r; } /* *---------------------------------------------------------------------- * * BignumToBiasedFrExp -- * * Convert an arbitrary-precision integer to a native floating point * number in the range [0.5,1) times a power of two. NOTE: Intentionally * converts to a number that's a few ulp too small, so that * RefineApproximation will not overflow near the high end of the * machine's arithmetic range. * * Results: * Returns the converted number. * * Side effects: * Stores the exponent of two in 'machexp'. * *---------------------------------------------------------------------- */ static double BignumToBiasedFrExp( const mp_int *a, /* Integer to convert. */ int *machexp) /* Power of two. */ { mp_int b; int bits; int shift; int i; double r; /* * Determine how many bits we need, and extract that many from the input. * Round to nearest unit in the last place. */ bits = mp_count_bits(a); shift = mantBits - 2 - bits; mp_init(&b); if (shift > 0) { mp_mul_2d(a, shift, &b); } else if (shift < 0) { mp_div_2d(a, -shift, &b, NULL); } else { mp_copy(a, &b); } /* * Accumulate the result, one mp_digit at a time. */ r = 0.0; for (i=b.used-1; i>=0; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } mp_clear(&b); /* * Return the result with the appropriate sign. */ *machexp = bits - mantBits + 2; return (mp_isneg(a) ? -r : r); } /* *---------------------------------------------------------------------- * * Pow10TimesFrExp -- * * Multiply a power of ten by a number expressed as fraction and * exponent. * * Results: * Returns the significand of the result. * * Side effects: * Overwrites the 'machexp' parameter with the exponent of the result. * * Assumes that 'exponent' is such that 10**exponent would be a double, even * though 'fraction*10**(machexp+exponent)' might overflow. * *---------------------------------------------------------------------- */ static double Pow10TimesFrExp( int exponent, /* Power of 10 to multiply by. */ double fraction, /* Significand of multiplicand. */ int *machexp) /* On input, exponent of multiplicand. On * output, exponent of result. */ { int i, j; int expt = *machexp; double retval = fraction; if (exponent > 0) { /* * Multiply by 10**exponent. */ retval = frexp(retval * pow10vals[exponent&0xF], &j); expt += j; for (i=4; i<9; ++i) { if (exponent & (1<> 32) & 0xFFFFFFFF) | (w << 32)); } #endif /* *---------------------------------------------------------------------- * * TclNokia770Doubles -- * * Transpose the two words of a number for Nokia 770 floating point * handling. * *---------------------------------------------------------------------- */ int TclNokia770Doubles(void) { return n770_fp; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclStubInit.c0000644000175000017500000013774714566153373015721 0ustar sergeisergei/* * tclStubInit.c -- * * This file contains the initializers for the Tcl stub vectors. * * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath_private.h" #ifdef __CYGWIN__ # include #endif #ifdef __GNUC__ #pragma GCC dependency "tcl.decls" #pragma GCC dependency "tclInt.decls" #pragma GCC dependency "tclTomMath.decls" #endif /* * Remove macros that will interfere with the definitions below. */ #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc #undef Tcl_NewBooleanObj #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj #undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry #undef Tcl_Panic #undef Tcl_FindExecutable #undef TclpGetPid #undef TclSockMinimumBuffers #define TclBackgroundException Tcl_BackgroundException #undef Tcl_SetIntObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt #undef TclBN_mp_tc_and #undef TclBN_mp_tc_or #undef TclBN_mp_tc_xor #undef TclObjInterpProc #define TclBN_mp_tc_and TclBN_mp_and #define TclBN_mp_tc_or TclBN_mp_or #define TclBN_mp_tc_xor TclBN_mp_xor #define TclStaticPackage Tcl_StaticPackage #define TclMacOSXNotifierAddRunLoopMode_ TclMacOSXNotifierAddRunLoopMode #define TclUnusedStubEntry 0 /* See bug 510001: TclSockMinimumBuffers needs plat imp */ #ifdef _WIN64 # define TclSockMinimumBuffersOld 0 #else #define TclSockMinimumBuffersOld sockMinimumBuffersOld static int TclSockMinimumBuffersOld(int sock, int size) { return TclSockMinimumBuffers(INT2PTR(sock), size); } #endif MP_SET_UNSIGNED(mp_set_ull, Tcl_WideUInt) MP_GET_MAG(mp_get_mag_ull, Tcl_WideUInt) MP_SET_SIGNED(mp_set_ll, mp_set_ull, Tcl_WideInt, Tcl_WideUInt) mp_err TclBN_mp_set_int(mp_int *a, unsigned long i) { mp_set_ull(a, i); return MP_OKAY; } mp_err TclBN_mp_init_set_int(mp_int *a, unsigned long i) { mp_err result = mp_init(a); if (result == MP_OKAY) { mp_set_ull(a, i); } return result; } int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) { return mp_expt_u32(a, b, c); } #define TclBN_mp_div_ld TclBNMpDivLd static mp_err TclBN_mp_div_ld(const mp_int *a, Tcl_WideUInt b, mp_int *c, Tcl_WideUInt *d) { mp_err result; mp_digit d2; if ((b | (mp_digit)-1) != (mp_digit)-1) { return MP_VAL; } result = mp_div_d(a, (mp_digit)b, c, (d ? &d2 : NULL)); if (d) { *d = d2; } return result; } #define TclSetStartupScriptPath setStartupScriptPath static void TclSetStartupScriptPath(Tcl_Obj *path) { Tcl_SetStartupScript(path, NULL); } #define TclGetStartupScriptPath getStartupScriptPath static Tcl_Obj *TclGetStartupScriptPath(void) { return Tcl_GetStartupScript(NULL); } #define TclSetStartupScriptFileName setStartupScriptFileName static void TclSetStartupScriptFileName( const char *fileName) { Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL); } #define TclGetStartupScriptFileName getStartupScriptFileName static const char *TclGetStartupScriptFileName(void) { Tcl_Obj *path = Tcl_GetStartupScript(NULL); if (path == NULL) { return NULL; } return Tcl_GetString(path); } #if defined(_WIN32) || defined(__CYGWIN__) #undef TclWinNToHS #define TclWinNToHS winNToHS static unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } #define TclWinConvertError_ winConvertError static void TclWinConvertError_(unsigned errCode) { TclWinConvertError(errCode); } #endif #define TclpCreateTempFile_ TclpCreateTempFile #define TclUnixWaitForFile_ TclUnixWaitForFile #ifndef MAC_OSX_TCL /* On UNIX, fill with other stub entries */ #define TclMacOSXGetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj **))(void *)TclpCreateProcess #define TclMacOSXSetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj *))(void *)isatty #define TclMacOSXCopyFileAttributes (int (*)(const char *, const char *, const Tcl_StatBuf *))(void *)TclUnixCopyFile #define TclMacOSXMatchType (int (*)(Tcl_Interp *, const char *, const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))(void *)TclpMakeFile #define TclMacOSXNotifierAddRunLoopMode (void (*)(const void *))(void *)TclpOpenFile #endif #ifdef _WIN32 # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty isatty # define TclWinSetInterfaces (void (*) (int))(void *)doNothing # define TclWinAddProcess (void (*) (void *, unsigned int))(void *)doNothing # define TclWinFlushDirtyChannels doNothing # define TclWinResetInterfaces doNothing #define TclWinGetPlatformId winGetPlatformId static int TclWinGetPlatformId() { /* Don't bother to determine the real platform on cygwin, * because VER_PLATFORM_WIN32_NT is the only supported platform */ return 2; /* VER_PLATFORM_WIN32_NT */; } #define TclWinSetSockOpt winSetSockOpt static int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) { return setsockopt((int) s, level, optname, optval, optlen); } #define TclWinGetSockOpt winGetSockOpt static int TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen) { return getsockopt((int) s, level, optname, optval, optlen); } #define TclWinGetServByName winGetServByName static struct servent * TclWinGetServByName(const char *name, const char *proto) { return getservbyname(name, proto); } #define TclWinNoBackslash winNoBackslash static char * TclWinNoBackslash(char *path) { char *p; for (p = path; *p != '\0'; p++) { if (*p == '\\') { *p = '/'; } } return path; } void *TclWinGetTclInstance() { void *hInstance = NULL; GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, (const char *)&TclWinNoBackslash, &hInstance); return hInstance; } int TclpGetPid(Tcl_Pid pid) { return (int)(size_t)pid; } static void doNothing(void) { /* dummy implementation, no need to do anything */ } char * Tcl_WinUtfToTChar( const char *string, int len, Tcl_DString *dsPtr) { #if TCL_UTF_MAX > 4 Tcl_UniChar ch = 0; wchar_t *w, *wString; const char *p, *end; int oldLength; #endif Tcl_DStringInit(dsPtr); if (!string) { return NULL; } #if TCL_UTF_MAX > 4 if (len < 0) { len = strlen(string); } /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in * bytes. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (int) ((len + 1) * sizeof(wchar_t))); wString = (wchar_t *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; p = string; end = string + len - 4; while (p < end) { p += TclUtfToUniChar(p, &ch); if (ch > 0xFFFF) { *w++ = (wchar_t) (0xD800 + ((ch -= 0x10000) >> 10)); *w++ = (wchar_t) (0xDC00 | (ch & 0x3FF)); } else { *w++ = ch; } } end += 4; while (p < end) { if (Tcl_UtfCharComplete(p, end-p)) { p += TclUtfToUniChar(p, &ch); } else { ch = UCHAR(*p++); } if (ch > 0xFFFF) { *w++ = (wchar_t) (0xD800 + ((ch -= 0x10000) >> 10)); *w++ = (wchar_t) (0xDC00 | (ch & 0x3FF)); } else { *w++ = ch; } } *w = '\0'; Tcl_DStringSetLength(dsPtr, oldLength + ((char *) w - (char *) wString)); return (char *)wString; #else return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr); #endif } char * Tcl_WinTCharToUtf( const char *string, int len, Tcl_DString *dsPtr) { #if TCL_UTF_MAX > 4 const wchar_t *w, *wEnd; char *p, *result; int oldLength, blen = 1; #endif Tcl_DStringInit(dsPtr); if (!string) { return NULL; } if (len < 0) { len = wcslen((wchar_t *)string); } else { len /= 2; } #if TCL_UTF_MAX > 4 oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (len + 1) * 4); result = Tcl_DStringValue(dsPtr) + oldLength; p = result; wEnd = (wchar_t *)string + len; for (w = (wchar_t *)string; w < wEnd; ) { if (!blen && ((*w & 0xFC00) != 0xDC00)) { /* Special case for handling high surrogates. */ p += Tcl_UniCharToUtf(-1, p); } blen = Tcl_UniCharToUtf(*w, p); p += blen; if ((*w >= 0xD800) && (blen < 3)) { /* Indication that high surrogate is handled */ blen = 0; } w++; } if (!blen) { /* Special case for handling high surrogates. */ p += Tcl_UniCharToUtf(-1, p); } Tcl_DStringSetLength(dsPtr, oldLength + (p - result)); return result; #else return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr); #endif } #if defined(TCL_WIDE_INT_IS_LONG) /* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore * we have to make sure that all stub entries on Cygwin64 follow the Win64 * signature. Tcl 9 must find a better solution, but that cannot be done * without introducing a binary incompatibility. */ #define Tcl_DbNewLongObj (Tcl_Obj*(*)(long,const char*,int))(void *)dbNewLongObj static Tcl_Obj *dbNewLongObj( int intValue, const char *file, int line ) { #ifdef TCL_MEM_DEBUG Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; objPtr->internalRep.longValue = (long) intValue; objPtr->typePtr = &tclIntType; return objPtr; #else return Tcl_NewIntObj(intValue); #endif } #define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)Tcl_GetIntFromObj #define Tcl_NewLongObj (Tcl_Obj*(*)(long))(void *)Tcl_NewIntObj #define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))(void *)Tcl_SetIntObj static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ long longValue; int result = Tcl_ExprLong(interp, expr, &longValue); if (result == TCL_OK) { if ((longValue >= -(long)(UINT_MAX)) && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent", -1)); result = TCL_ERROR; } } return result; } #define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))(void *)exprInt static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ long longValue; int result = Tcl_ExprLongObj(interp, expr, &longValue); if (result == TCL_OK) { if ((longValue >= -(long)(UINT_MAX)) && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent", -1)); result = TCL_ERROR; } } return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)exprIntObj static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); } #define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcmp static int utfNcmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcmp(s1, s2, (unsigned long)n); } #define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcmp static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); } #define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); } #define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcasecmp static int formatInt(char *buffer, int n){ return TclFormatInt(buffer, (long)n); } #define TclFormatInt (int(*)(char *, long))(void *)formatInt #endif #else /* UNIX and MAC */ # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime #endif mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) { return mp_to_ubin(a, b, INT_MAX, NULL); } mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) { size_t n = mp_ubin_size(a); if (*outlen < (unsigned long)n) { return MP_VAL; } *outlen = (unsigned long)n; return mp_to_ubin(a, b, n, NULL); } mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) { if (maxlen < 0) { return MP_VAL; } return mp_to_radix(a, str, maxlen, NULL, radix); } void bn_reverse(unsigned char *s, int len) { if (len > 0) { s_mp_reverse(s, (size_t)len); } } /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations * below should be made in the generic/tcl.decls script. */ MODULE_SCOPE const TclStubs tclStubs; MODULE_SCOPE const TclTomMathStubs tclTomMathStubs; /* !BEGIN!: Do not edit below this line. */ static const TclIntStubs tclIntStubs = { TCL_STUB_MAGIC, 0, 0, /* 0 */ 0, /* 1 */ 0, /* 2 */ TclAllocateFreeObjects, /* 3 */ 0, /* 4 */ TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ TclCopyChannelOld, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ TclDeleteVars, /* 12 */ 0, /* 13 */ TclDumpMemoryInfo, /* 14 */ 0, /* 15 */ TclExprFloatError, /* 16 */ 0, /* 17 */ 0, /* 18 */ 0, /* 19 */ 0, /* 20 */ 0, /* 21 */ TclFindElement, /* 22 */ TclFindProc, /* 23 */ TclFormatInt, /* 24 */ TclFreePackageInfo, /* 25 */ 0, /* 26 */ 0, /* 27 */ TclpGetDefaultStdChannel, /* 28 */ 0, /* 29 */ 0, /* 30 */ TclGetExtension, /* 31 */ TclGetFrame, /* 32 */ 0, /* 33 */ TclGetIntForIndex, /* 34 */ 0, /* 35 */ 0, /* 36 */ TclGetLoadedPackages, /* 37 */ TclGetNamespaceForQualName, /* 38 */ TclGetObjInterpProc, /* 39 */ TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ TclpGetUserHome, /* 42 */ 0, /* 43 */ TclGuessPackageName, /* 44 */ TclHideUnsafeCommands, /* 45 */ TclInExit, /* 46 */ 0, /* 47 */ 0, /* 48 */ 0, /* 49 */ TclInitCompiledLocals, /* 50 */ TclInterpInit, /* 51 */ 0, /* 52 */ TclInvokeObjectCommand, /* 53 */ TclInvokeStringCommand, /* 54 */ TclIsProc, /* 55 */ 0, /* 56 */ 0, /* 57 */ TclLookupVar, /* 58 */ 0, /* 59 */ TclNeedSpace, /* 60 */ TclNewProcBodyObj, /* 61 */ TclObjCommandComplete, /* 62 */ TclObjInterpProc, /* 63 */ TclObjInvoke, /* 64 */ 0, /* 65 */ 0, /* 66 */ 0, /* 67 */ 0, /* 68 */ TclpAlloc, /* 69 */ 0, /* 70 */ 0, /* 71 */ 0, /* 72 */ 0, /* 73 */ TclpFree, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ TclpGetTime, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ TclpRealloc, /* 81 */ 0, /* 82 */ 0, /* 83 */ 0, /* 84 */ 0, /* 85 */ 0, /* 86 */ 0, /* 87 */ TclPrecTraceProc, /* 88 */ TclPreventAliasLoop, /* 89 */ 0, /* 90 */ TclProcCleanupProc, /* 91 */ TclProcCompileProc, /* 92 */ TclProcDeleteProc, /* 93 */ 0, /* 94 */ 0, /* 95 */ TclRenameCommand, /* 96 */ TclResetShadowedCmdRefs, /* 97 */ TclServiceIdle, /* 98 */ 0, /* 99 */ 0, /* 100 */ TclSetPreInitScript, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ TclSockMinimumBuffersOld, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ TclTeardownNamespace, /* 108 */ TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ Tcl_AppendExportList, /* 112 */ Tcl_CreateNamespace, /* 113 */ Tcl_DeleteNamespace, /* 114 */ Tcl_Export, /* 115 */ Tcl_FindCommand, /* 116 */ Tcl_FindNamespace, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ Tcl_ForgetImport, /* 121 */ Tcl_GetCommandFromObj, /* 122 */ Tcl_GetCommandFullName, /* 123 */ Tcl_GetCurrentNamespace, /* 124 */ Tcl_GetGlobalNamespace, /* 125 */ Tcl_GetVariableFullName, /* 126 */ Tcl_Import, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ TclpGetDate, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ 0, /* 137 */ TclGetEnv, /* 138 */ 0, /* 139 */ 0, /* 140 */ TclpGetCwd, /* 141 */ TclSetByteCodeFromAny, /* 142 */ TclAddLiteralObj, /* 143 */ TclHideLiteral, /* 144 */ TclGetAuxDataType, /* 145 */ TclHandleCreate, /* 146 */ TclHandleFree, /* 147 */ TclHandlePreserve, /* 148 */ TclHandleRelease, /* 149 */ TclRegAbout, /* 150 */ TclRegExpRangeUniChar, /* 151 */ TclSetLibraryPath, /* 152 */ TclGetLibraryPath, /* 153 */ 0, /* 154 */ 0, /* 155 */ TclRegError, /* 156 */ TclVarTraceExists, /* 157 */ TclSetStartupScriptFileName, /* 158 */ TclGetStartupScriptFileName, /* 159 */ 0, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ TclGetInstructionTable, /* 163 */ TclExpandCodeArray, /* 164 */ TclpSetInitialEncodings, /* 165 */ TclListObjSetElement, /* 166 */ TclSetStartupScriptPath, /* 167 */ TclGetStartupScriptPath, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ TclInThreadExit, /* 172 */ TclUniCharMatch, /* 173 */ 0, /* 174 */ TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ Tcl_SetStartupScript, /* 178 */ Tcl_GetStartupScript, /* 179 */ 0, /* 180 */ 0, /* 181 */ TclpLocaltime, /* 182 */ TclpGmtime, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ 0, /* 187 */ 0, /* 188 */ 0, /* 189 */ 0, /* 190 */ 0, /* 191 */ 0, /* 192 */ 0, /* 193 */ 0, /* 194 */ 0, /* 195 */ 0, /* 196 */ 0, /* 197 */ TclObjGetFrame, /* 198 */ 0, /* 199 */ TclpObjRemoveDirectory, /* 200 */ TclpObjCopyDirectory, /* 201 */ TclpObjCreateDirectory, /* 202 */ TclpObjDeleteFile, /* 203 */ TclpObjCopyFile, /* 204 */ TclpObjRenameFile, /* 205 */ TclpObjStat, /* 206 */ TclpObjAccess, /* 207 */ TclpOpenFileChannel, /* 208 */ 0, /* 209 */ 0, /* 210 */ 0, /* 211 */ TclpFindExecutable, /* 212 */ TclGetObjNameOfExecutable, /* 213 */ TclSetObjNameOfExecutable, /* 214 */ TclStackAlloc, /* 215 */ TclStackFree, /* 216 */ TclPushStackFrame, /* 217 */ TclPopStackFrame, /* 218 */ 0, /* 219 */ 0, /* 220 */ 0, /* 221 */ 0, /* 222 */ TclGetCStackPtr, /* 223 */ TclGetPlatform, /* 224 */ TclTraceDictPath, /* 225 */ TclObjBeingDeleted, /* 226 */ TclSetNsPath, /* 227 */ 0, /* 228 */ TclPtrMakeUpvar, /* 229 */ TclObjLookupVar, /* 230 */ TclGetNamespaceFromObj, /* 231 */ TclEvalObjEx, /* 232 */ TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ TclBackgroundException, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ TclNRRunCallbacks, /* 240 */ TclNREvalObjEx, /* 241 */ TclNREvalObjv, /* 242 */ TclDbDumpActiveObjects, /* 243 */ TclGetNamespaceChildTable, /* 244 */ TclGetNamespaceCommandTable, /* 245 */ TclInitRewriteEnsemble, /* 246 */ TclResetRewriteEnsemble, /* 247 */ TclCopyChannel, /* 248 */ TclDoubleDigits, /* 249 */ TclSetSlaveCancelFlags, /* 250 */ TclRegisterLiteral, /* 251 */ TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ 0, /* 258 */ 0, /* 259 */ 0, /* 260 */ TclUnusedStubEntry, /* 261 */ }; static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ TclpCreateProcess, /* 4 */ TclUnixWaitForFile_, /* 5 */ TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ TclMacOSXCopyFileAttributes, /* 17 */ TclMacOSXMatchType, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ 0, /* 20 */ 0, /* 21 */ TclpCreateTempFile_, /* 22 */ 0, /* 23 */ 0, /* 24 */ 0, /* 25 */ 0, /* 26 */ 0, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ TclWinConvertWSAError, /* 1 */ TclWinGetServByName, /* 2 */ TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ TclWinNToHS, /* 6 */ TclWinSetSockOpt, /* 7 */ TclpGetPid, /* 8 */ TclWinGetPlatformId, /* 9 */ TclpReaddir, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ TclUnixCopyFile, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ TclpInetNtoa, /* 21 */ TclpCreateTempFile, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ 0, /* 25 */ TclWinSetInterfaces, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ TclWinResetInterfaces, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ TclGetAndDetachPids, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ TclpCreateProcess, /* 4 */ TclUnixWaitForFile_, /* 5 */ TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ TclMacOSXCopyFileAttributes, /* 17 */ TclMacOSXMatchType, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ 0, /* 20 */ 0, /* 21 */ TclpCreateTempFile_, /* 22 */ 0, /* 23 */ 0, /* 24 */ 0, /* 25 */ 0, /* 26 */ 0, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* MACOSX */ }; static const TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, 0, #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ 0, /* 2 */ TclWinConvertError_, /* 3 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ Tcl_MacOSXOpenBundleResources, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ TclMacOSXNotifierAddRunLoopMode_, /* 2 */ #endif /* MACOSX */ }; const TclTomMathStubs tclTomMathStubs = { TCL_STUB_MAGIC, 0, TclBN_epoch, /* 0 */ TclBN_revision, /* 1 */ TclBN_mp_add, /* 2 */ TclBN_mp_add_d, /* 3 */ TclBN_mp_and, /* 4 */ TclBN_mp_clamp, /* 5 */ TclBN_mp_clear, /* 6 */ TclBN_mp_clear_multi, /* 7 */ TclBN_mp_cmp, /* 8 */ TclBN_mp_cmp_d, /* 9 */ TclBN_mp_cmp_mag, /* 10 */ TclBN_mp_copy, /* 11 */ TclBN_mp_count_bits, /* 12 */ TclBN_mp_div, /* 13 */ TclBN_mp_div_d, /* 14 */ TclBN_mp_div_2, /* 15 */ TclBN_mp_div_2d, /* 16 */ TclBN_mp_div_3, /* 17 */ TclBN_mp_exch, /* 18 */ TclBN_mp_expt_d, /* 19 */ TclBN_mp_grow, /* 20 */ TclBN_mp_init, /* 21 */ TclBN_mp_init_copy, /* 22 */ TclBN_mp_init_multi, /* 23 */ TclBN_mp_init_set, /* 24 */ TclBN_mp_init_size, /* 25 */ TclBN_mp_lshd, /* 26 */ TclBN_mp_mod, /* 27 */ TclBN_mp_mod_2d, /* 28 */ TclBN_mp_mul, /* 29 */ TclBN_mp_mul_d, /* 30 */ TclBN_mp_mul_2, /* 31 */ TclBN_mp_mul_2d, /* 32 */ TclBN_mp_neg, /* 33 */ TclBN_mp_or, /* 34 */ TclBN_mp_radix_size, /* 35 */ TclBN_mp_read_radix, /* 36 */ TclBN_mp_rshd, /* 37 */ TclBN_mp_shrink, /* 38 */ TclBN_mp_set, /* 39 */ TclBN_mp_sqr, /* 40 */ TclBN_mp_sqrt, /* 41 */ TclBN_mp_sub, /* 42 */ TclBN_mp_sub_d, /* 43 */ TclBN_mp_to_unsigned_bin, /* 44 */ TclBN_mp_to_unsigned_bin_n, /* 45 */ TclBN_mp_toradix_n, /* 46 */ TclBN_mp_unsigned_bin_size, /* 47 */ TclBN_mp_xor, /* 48 */ TclBN_mp_zero, /* 49 */ TclBN_reverse, /* 50 */ TclBN_fast_s_mp_mul_digs, /* 51 */ TclBN_fast_s_mp_sqr, /* 52 */ TclBN_mp_karatsuba_mul, /* 53 */ TclBN_mp_karatsuba_sqr, /* 54 */ TclBN_mp_toom_mul, /* 55 */ TclBN_mp_toom_sqr, /* 56 */ TclBN_s_mp_add, /* 57 */ TclBN_s_mp_mul_digs, /* 58 */ TclBN_s_mp_sqr, /* 59 */ TclBN_s_mp_sub, /* 60 */ TclBN_mp_init_set_int, /* 61 */ TclBN_mp_set_int, /* 62 */ TclBN_mp_cnt_lsb, /* 63 */ TclBNInitBignumFromLong, /* 64 */ TclBNInitBignumFromWideInt, /* 65 */ TclBNInitBignumFromWideUInt, /* 66 */ TclBN_mp_expt_d_ex, /* 67 */ TclBN_mp_set_ull, /* 68 */ TclBN_mp_get_mag_ull, /* 69 */ TclBN_mp_set_ll, /* 70 */ TclBN_mp_unpack, /* 71 */ TclBN_mp_pack, /* 72 */ TclBN_mp_tc_and, /* 73 */ TclBN_mp_tc_or, /* 74 */ TclBN_mp_tc_xor, /* 75 */ TclBN_mp_signed_rsh, /* 76 */ TclBN_mp_pack_count, /* 77 */ TclBN_mp_to_ubin, /* 78 */ TclBN_mp_div_ld, /* 79 */ TclBN_mp_to_radix, /* 80 */ }; static const TclStubHooks tclStubHooks = { &tclPlatStubs, &tclIntStubs, &tclIntPlatStubs }; const TclStubs tclStubs = { TCL_STUB_MAGIC, &tclStubHooks, Tcl_PkgProvideEx, /* 0 */ Tcl_PkgRequireEx, /* 1 */ Tcl_Panic, /* 2 */ Tcl_Alloc, /* 3 */ Tcl_Free, /* 4 */ Tcl_Realloc, /* 5 */ Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_CreateFileHandler, /* 9 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ 0, /* 9 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ Tcl_CreateFileHandler, /* 9 */ #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_DeleteFileHandler, /* 10 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ 0, /* 10 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ Tcl_DeleteFileHandler, /* 10 */ #endif /* MACOSX */ Tcl_SetTimer, /* 11 */ Tcl_Sleep, /* 12 */ Tcl_WaitForEvent, /* 13 */ Tcl_AppendAllObjTypes, /* 14 */ Tcl_AppendStringsToObj, /* 15 */ Tcl_AppendToObj, /* 16 */ Tcl_ConcatObj, /* 17 */ Tcl_ConvertToType, /* 18 */ Tcl_DbDecrRefCount, /* 19 */ Tcl_DbIncrRefCount, /* 20 */ Tcl_DbIsShared, /* 21 */ Tcl_DbNewBooleanObj, /* 22 */ Tcl_DbNewByteArrayObj, /* 23 */ Tcl_DbNewDoubleObj, /* 24 */ Tcl_DbNewListObj, /* 25 */ Tcl_DbNewLongObj, /* 26 */ Tcl_DbNewObj, /* 27 */ Tcl_DbNewStringObj, /* 28 */ Tcl_DuplicateObj, /* 29 */ TclFreeObj, /* 30 */ Tcl_GetBoolean, /* 31 */ Tcl_GetBooleanFromObj, /* 32 */ Tcl_GetByteArrayFromObj, /* 33 */ Tcl_GetDouble, /* 34 */ Tcl_GetDoubleFromObj, /* 35 */ Tcl_GetIndexFromObj, /* 36 */ Tcl_GetInt, /* 37 */ Tcl_GetIntFromObj, /* 38 */ Tcl_GetLongFromObj, /* 39 */ Tcl_GetObjType, /* 40 */ Tcl_GetStringFromObj, /* 41 */ Tcl_InvalidateStringRep, /* 42 */ Tcl_ListObjAppendList, /* 43 */ Tcl_ListObjAppendElement, /* 44 */ Tcl_ListObjGetElements, /* 45 */ Tcl_ListObjIndex, /* 46 */ Tcl_ListObjLength, /* 47 */ Tcl_ListObjReplace, /* 48 */ Tcl_NewBooleanObj, /* 49 */ Tcl_NewByteArrayObj, /* 50 */ Tcl_NewDoubleObj, /* 51 */ Tcl_NewIntObj, /* 52 */ Tcl_NewListObj, /* 53 */ Tcl_NewLongObj, /* 54 */ Tcl_NewObj, /* 55 */ Tcl_NewStringObj, /* 56 */ Tcl_SetBooleanObj, /* 57 */ Tcl_SetByteArrayLength, /* 58 */ Tcl_SetByteArrayObj, /* 59 */ Tcl_SetDoubleObj, /* 60 */ Tcl_SetIntObj, /* 61 */ Tcl_SetListObj, /* 62 */ Tcl_SetLongObj, /* 63 */ Tcl_SetObjLength, /* 64 */ Tcl_SetStringObj, /* 65 */ Tcl_AddErrorInfo, /* 66 */ Tcl_AddObjErrorInfo, /* 67 */ Tcl_AllowExceptions, /* 68 */ Tcl_AppendElement, /* 69 */ Tcl_AppendResult, /* 70 */ Tcl_AsyncCreate, /* 71 */ Tcl_AsyncDelete, /* 72 */ Tcl_AsyncInvoke, /* 73 */ Tcl_AsyncMark, /* 74 */ Tcl_AsyncReady, /* 75 */ Tcl_BackgroundError, /* 76 */ Tcl_Backslash, /* 77 */ Tcl_BadChannelOption, /* 78 */ Tcl_CallWhenDeleted, /* 79 */ Tcl_CancelIdleCall, /* 80 */ Tcl_Close, /* 81 */ Tcl_CommandComplete, /* 82 */ Tcl_Concat, /* 83 */ Tcl_ConvertElement, /* 84 */ Tcl_ConvertCountedElement, /* 85 */ Tcl_CreateAlias, /* 86 */ Tcl_CreateAliasObj, /* 87 */ Tcl_CreateChannel, /* 88 */ Tcl_CreateChannelHandler, /* 89 */ Tcl_CreateCloseHandler, /* 90 */ Tcl_CreateCommand, /* 91 */ Tcl_CreateEventSource, /* 92 */ Tcl_CreateExitHandler, /* 93 */ Tcl_CreateInterp, /* 94 */ Tcl_CreateMathFunc, /* 95 */ Tcl_CreateObjCommand, /* 96 */ Tcl_CreateSlave, /* 97 */ Tcl_CreateTimerHandler, /* 98 */ Tcl_CreateTrace, /* 99 */ Tcl_DeleteAssocData, /* 100 */ Tcl_DeleteChannelHandler, /* 101 */ Tcl_DeleteCloseHandler, /* 102 */ Tcl_DeleteCommand, /* 103 */ Tcl_DeleteCommandFromToken, /* 104 */ Tcl_DeleteEvents, /* 105 */ Tcl_DeleteEventSource, /* 106 */ Tcl_DeleteExitHandler, /* 107 */ Tcl_DeleteHashEntry, /* 108 */ Tcl_DeleteHashTable, /* 109 */ Tcl_DeleteInterp, /* 110 */ Tcl_DetachPids, /* 111 */ Tcl_DeleteTimerHandler, /* 112 */ Tcl_DeleteTrace, /* 113 */ Tcl_DontCallWhenDeleted, /* 114 */ Tcl_DoOneEvent, /* 115 */ Tcl_DoWhenIdle, /* 116 */ Tcl_DStringAppend, /* 117 */ Tcl_DStringAppendElement, /* 118 */ Tcl_DStringEndSublist, /* 119 */ Tcl_DStringFree, /* 120 */ Tcl_DStringGetResult, /* 121 */ Tcl_DStringInit, /* 122 */ Tcl_DStringResult, /* 123 */ Tcl_DStringSetLength, /* 124 */ Tcl_DStringStartSublist, /* 125 */ Tcl_Eof, /* 126 */ Tcl_ErrnoId, /* 127 */ Tcl_ErrnoMsg, /* 128 */ Tcl_Eval, /* 129 */ Tcl_EvalFile, /* 130 */ Tcl_EvalObj, /* 131 */ Tcl_EventuallyFree, /* 132 */ Tcl_Exit, /* 133 */ Tcl_ExposeCommand, /* 134 */ Tcl_ExprBoolean, /* 135 */ Tcl_ExprBooleanObj, /* 136 */ Tcl_ExprDouble, /* 137 */ Tcl_ExprDoubleObj, /* 138 */ Tcl_ExprLong, /* 139 */ Tcl_ExprLongObj, /* 140 */ Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ Tcl_FindExecutable, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ Tcl_FreeResult, /* 147 */ Tcl_GetAlias, /* 148 */ Tcl_GetAliasObj, /* 149 */ Tcl_GetAssocData, /* 150 */ Tcl_GetChannel, /* 151 */ Tcl_GetChannelBufferSize, /* 152 */ Tcl_GetChannelHandle, /* 153 */ Tcl_GetChannelInstanceData, /* 154 */ Tcl_GetChannelMode, /* 155 */ Tcl_GetChannelName, /* 156 */ Tcl_GetChannelOption, /* 157 */ Tcl_GetChannelType, /* 158 */ Tcl_GetCommandInfo, /* 159 */ Tcl_GetCommandName, /* 160 */ Tcl_GetErrno, /* 161 */ Tcl_GetHostName, /* 162 */ Tcl_GetInterpPath, /* 163 */ Tcl_GetMaster, /* 164 */ Tcl_GetNameOfExecutable, /* 165 */ Tcl_GetObjResult, /* 166 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_GetOpenFile, /* 167 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ 0, /* 167 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ Tcl_GetOpenFile, /* 167 */ #endif /* MACOSX */ Tcl_GetPathType, /* 168 */ Tcl_Gets, /* 169 */ Tcl_GetsObj, /* 170 */ Tcl_GetServiceMode, /* 171 */ Tcl_GetSlave, /* 172 */ Tcl_GetStdChannel, /* 173 */ Tcl_GetStringResult, /* 174 */ Tcl_GetVar, /* 175 */ Tcl_GetVar2, /* 176 */ Tcl_GlobalEval, /* 177 */ Tcl_GlobalEvalObj, /* 178 */ Tcl_HideCommand, /* 179 */ Tcl_Init, /* 180 */ Tcl_InitHashTable, /* 181 */ Tcl_InputBlocked, /* 182 */ Tcl_InputBuffered, /* 183 */ Tcl_InterpDeleted, /* 184 */ Tcl_IsSafe, /* 185 */ Tcl_JoinPath, /* 186 */ Tcl_LinkVar, /* 187 */ 0, /* 188 */ Tcl_MakeFileChannel, /* 189 */ Tcl_MakeSafe, /* 190 */ Tcl_MakeTcpClientChannel, /* 191 */ Tcl_Merge, /* 192 */ Tcl_NextHashEntry, /* 193 */ Tcl_NotifyChannel, /* 194 */ Tcl_ObjGetVar2, /* 195 */ Tcl_ObjSetVar2, /* 196 */ Tcl_OpenCommandChannel, /* 197 */ Tcl_OpenFileChannel, /* 198 */ Tcl_OpenTcpClient, /* 199 */ Tcl_OpenTcpServer, /* 200 */ Tcl_Preserve, /* 201 */ Tcl_PrintDouble, /* 202 */ Tcl_PutEnv, /* 203 */ Tcl_PosixError, /* 204 */ Tcl_QueueEvent, /* 205 */ Tcl_Read, /* 206 */ Tcl_ReapDetachedProcs, /* 207 */ Tcl_RecordAndEval, /* 208 */ Tcl_RecordAndEvalObj, /* 209 */ Tcl_RegisterChannel, /* 210 */ Tcl_RegisterObjType, /* 211 */ Tcl_RegExpCompile, /* 212 */ Tcl_RegExpExec, /* 213 */ Tcl_RegExpMatch, /* 214 */ Tcl_RegExpRange, /* 215 */ Tcl_Release, /* 216 */ Tcl_ResetResult, /* 217 */ Tcl_ScanElement, /* 218 */ Tcl_ScanCountedElement, /* 219 */ Tcl_SeekOld, /* 220 */ Tcl_ServiceAll, /* 221 */ Tcl_ServiceEvent, /* 222 */ Tcl_SetAssocData, /* 223 */ Tcl_SetChannelBufferSize, /* 224 */ Tcl_SetChannelOption, /* 225 */ Tcl_SetCommandInfo, /* 226 */ Tcl_SetErrno, /* 227 */ Tcl_SetErrorCode, /* 228 */ Tcl_SetMaxBlockTime, /* 229 */ Tcl_SetPanicProc, /* 230 */ Tcl_SetRecursionLimit, /* 231 */ Tcl_SetResult, /* 232 */ Tcl_SetServiceMode, /* 233 */ Tcl_SetObjErrorCode, /* 234 */ Tcl_SetObjResult, /* 235 */ Tcl_SetStdChannel, /* 236 */ Tcl_SetVar, /* 237 */ Tcl_SetVar2, /* 238 */ Tcl_SignalId, /* 239 */ Tcl_SignalMsg, /* 240 */ Tcl_SourceRCFile, /* 241 */ Tcl_SplitList, /* 242 */ Tcl_SplitPath, /* 243 */ Tcl_StaticPackage, /* 244 */ Tcl_StringMatch, /* 245 */ Tcl_TellOld, /* 246 */ Tcl_TraceVar, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ Tcl_Ungets, /* 250 */ Tcl_UnlinkVar, /* 251 */ Tcl_UnregisterChannel, /* 252 */ Tcl_UnsetVar, /* 253 */ Tcl_UnsetVar2, /* 254 */ Tcl_UntraceVar, /* 255 */ Tcl_UntraceVar2, /* 256 */ Tcl_UpdateLinkedVar, /* 257 */ Tcl_UpVar, /* 258 */ Tcl_UpVar2, /* 259 */ Tcl_VarEval, /* 260 */ Tcl_VarTraceInfo, /* 261 */ Tcl_VarTraceInfo2, /* 262 */ Tcl_Write, /* 263 */ Tcl_WrongNumArgs, /* 264 */ Tcl_DumpActiveMemory, /* 265 */ Tcl_ValidateAllMemory, /* 266 */ Tcl_AppendResultVA, /* 267 */ Tcl_AppendStringsToObjVA, /* 268 */ Tcl_HashStats, /* 269 */ Tcl_ParseVar, /* 270 */ Tcl_PkgPresent, /* 271 */ Tcl_PkgPresentEx, /* 272 */ Tcl_PkgProvide, /* 273 */ Tcl_PkgRequire, /* 274 */ Tcl_SetErrorCodeVA, /* 275 */ Tcl_VarEvalVA, /* 276 */ Tcl_WaitPid, /* 277 */ Tcl_PanicVA, /* 278 */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ Tcl_StackChannel, /* 281 */ Tcl_UnstackChannel, /* 282 */ Tcl_GetStackedChannel, /* 283 */ Tcl_SetMainLoop, /* 284 */ 0, /* 285 */ Tcl_AppendObjToObj, /* 286 */ Tcl_CreateEncoding, /* 287 */ Tcl_CreateThreadExitHandler, /* 288 */ Tcl_DeleteThreadExitHandler, /* 289 */ Tcl_DiscardResult, /* 290 */ Tcl_EvalEx, /* 291 */ Tcl_EvalObjv, /* 292 */ Tcl_EvalObjEx, /* 293 */ Tcl_ExitThread, /* 294 */ Tcl_ExternalToUtf, /* 295 */ Tcl_ExternalToUtfDString, /* 296 */ Tcl_FinalizeThread, /* 297 */ Tcl_FinalizeNotifier, /* 298 */ Tcl_FreeEncoding, /* 299 */ Tcl_GetCurrentThread, /* 300 */ Tcl_GetEncoding, /* 301 */ Tcl_GetEncodingName, /* 302 */ Tcl_GetEncodingNames, /* 303 */ Tcl_GetIndexFromObjStruct, /* 304 */ Tcl_GetThreadData, /* 305 */ Tcl_GetVar2Ex, /* 306 */ Tcl_InitNotifier, /* 307 */ Tcl_MutexLock, /* 308 */ Tcl_MutexUnlock, /* 309 */ Tcl_ConditionNotify, /* 310 */ Tcl_ConditionWait, /* 311 */ Tcl_NumUtfChars, /* 312 */ Tcl_ReadChars, /* 313 */ Tcl_RestoreResult, /* 314 */ Tcl_SaveResult, /* 315 */ Tcl_SetSystemEncoding, /* 316 */ Tcl_SetVar2Ex, /* 317 */ Tcl_ThreadAlert, /* 318 */ Tcl_ThreadQueueEvent, /* 319 */ Tcl_UniCharAtIndex, /* 320 */ Tcl_UniCharToLower, /* 321 */ Tcl_UniCharToTitle, /* 322 */ Tcl_UniCharToUpper, /* 323 */ Tcl_UniCharToUtf, /* 324 */ Tcl_UtfAtIndex, /* 325 */ Tcl_UtfCharComplete, /* 326 */ Tcl_UtfBackslash, /* 327 */ Tcl_UtfFindFirst, /* 328 */ Tcl_UtfFindLast, /* 329 */ Tcl_UtfNext, /* 330 */ Tcl_UtfPrev, /* 331 */ Tcl_UtfToExternal, /* 332 */ Tcl_UtfToExternalDString, /* 333 */ Tcl_UtfToLower, /* 334 */ Tcl_UtfToTitle, /* 335 */ Tcl_UtfToUniChar, /* 336 */ Tcl_UtfToUpper, /* 337 */ Tcl_WriteChars, /* 338 */ Tcl_WriteObj, /* 339 */ Tcl_GetString, /* 340 */ Tcl_GetDefaultEncodingDir, /* 341 */ Tcl_SetDefaultEncodingDir, /* 342 */ Tcl_AlertNotifier, /* 343 */ Tcl_ServiceModeHook, /* 344 */ Tcl_UniCharIsAlnum, /* 345 */ Tcl_UniCharIsAlpha, /* 346 */ Tcl_UniCharIsDigit, /* 347 */ Tcl_UniCharIsLower, /* 348 */ Tcl_UniCharIsSpace, /* 349 */ Tcl_UniCharIsUpper, /* 350 */ Tcl_UniCharIsWordChar, /* 351 */ Tcl_UniCharLen, /* 352 */ Tcl_UniCharNcmp, /* 353 */ Tcl_UniCharToUtfDString, /* 354 */ Tcl_UtfToUniCharDString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ Tcl_EvalTokens, /* 357 */ Tcl_FreeParse, /* 358 */ Tcl_LogCommandInfo, /* 359 */ Tcl_ParseBraces, /* 360 */ Tcl_ParseCommand, /* 361 */ Tcl_ParseExpr, /* 362 */ Tcl_ParseQuotedString, /* 363 */ Tcl_ParseVarName, /* 364 */ Tcl_GetCwd, /* 365 */ Tcl_Chdir, /* 366 */ Tcl_Access, /* 367 */ Tcl_Stat, /* 368 */ Tcl_UtfNcmp, /* 369 */ Tcl_UtfNcasecmp, /* 370 */ Tcl_StringCaseMatch, /* 371 */ Tcl_UniCharIsControl, /* 372 */ Tcl_UniCharIsGraph, /* 373 */ Tcl_UniCharIsPrint, /* 374 */ Tcl_UniCharIsPunct, /* 375 */ Tcl_RegExpExecObj, /* 376 */ Tcl_RegExpGetInfo, /* 377 */ Tcl_NewUnicodeObj, /* 378 */ Tcl_SetUnicodeObj, /* 379 */ Tcl_GetCharLength, /* 380 */ Tcl_GetUniChar, /* 381 */ Tcl_GetUnicode, /* 382 */ Tcl_GetRange, /* 383 */ Tcl_AppendUnicodeToObj, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ Tcl_SetNotifier, /* 386 */ Tcl_GetAllocMutex, /* 387 */ Tcl_GetChannelNames, /* 388 */ Tcl_GetChannelNamesEx, /* 389 */ Tcl_ProcObjCmd, /* 390 */ Tcl_ConditionFinalize, /* 391 */ Tcl_MutexFinalize, /* 392 */ Tcl_CreateThread, /* 393 */ Tcl_ReadRaw, /* 394 */ Tcl_WriteRaw, /* 395 */ Tcl_GetTopChannel, /* 396 */ Tcl_ChannelBuffered, /* 397 */ Tcl_ChannelName, /* 398 */ Tcl_ChannelVersion, /* 399 */ Tcl_ChannelBlockModeProc, /* 400 */ Tcl_ChannelCloseProc, /* 401 */ Tcl_ChannelClose2Proc, /* 402 */ Tcl_ChannelInputProc, /* 403 */ Tcl_ChannelOutputProc, /* 404 */ Tcl_ChannelSeekProc, /* 405 */ Tcl_ChannelSetOptionProc, /* 406 */ Tcl_ChannelGetOptionProc, /* 407 */ Tcl_ChannelWatchProc, /* 408 */ Tcl_ChannelGetHandleProc, /* 409 */ Tcl_ChannelFlushProc, /* 410 */ Tcl_ChannelHandlerProc, /* 411 */ Tcl_JoinThread, /* 412 */ Tcl_IsChannelShared, /* 413 */ Tcl_IsChannelRegistered, /* 414 */ Tcl_CutChannel, /* 415 */ Tcl_SpliceChannel, /* 416 */ Tcl_ClearChannelHandlers, /* 417 */ Tcl_IsChannelExisting, /* 418 */ Tcl_UniCharNcasecmp, /* 419 */ Tcl_UniCharCaseMatch, /* 420 */ Tcl_FindHashEntry, /* 421 */ Tcl_CreateHashEntry, /* 422 */ Tcl_InitCustomHashTable, /* 423 */ Tcl_InitObjHashTable, /* 424 */ Tcl_CommandTraceInfo, /* 425 */ Tcl_TraceCommand, /* 426 */ Tcl_UntraceCommand, /* 427 */ Tcl_AttemptAlloc, /* 428 */ Tcl_AttemptDbCkalloc, /* 429 */ Tcl_AttemptRealloc, /* 430 */ Tcl_AttemptDbCkrealloc, /* 431 */ Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ Tcl_GetUnicodeFromObj, /* 434 */ Tcl_GetMathFuncInfo, /* 435 */ Tcl_ListMathFuncs, /* 436 */ Tcl_SubstObj, /* 437 */ Tcl_DetachChannel, /* 438 */ Tcl_IsStandardChannel, /* 439 */ Tcl_FSCopyFile, /* 440 */ Tcl_FSCopyDirectory, /* 441 */ Tcl_FSCreateDirectory, /* 442 */ Tcl_FSDeleteFile, /* 443 */ Tcl_FSLoadFile, /* 444 */ Tcl_FSMatchInDirectory, /* 445 */ Tcl_FSLink, /* 446 */ Tcl_FSRemoveDirectory, /* 447 */ Tcl_FSRenameFile, /* 448 */ Tcl_FSLstat, /* 449 */ Tcl_FSUtime, /* 450 */ Tcl_FSFileAttrsGet, /* 451 */ Tcl_FSFileAttrsSet, /* 452 */ Tcl_FSFileAttrStrings, /* 453 */ Tcl_FSStat, /* 454 */ Tcl_FSAccess, /* 455 */ Tcl_FSOpenFileChannel, /* 456 */ Tcl_FSGetCwd, /* 457 */ Tcl_FSChdir, /* 458 */ Tcl_FSConvertToPathType, /* 459 */ Tcl_FSJoinPath, /* 460 */ Tcl_FSSplitPath, /* 461 */ Tcl_FSEqualPaths, /* 462 */ Tcl_FSGetNormalizedPath, /* 463 */ Tcl_FSJoinToPath, /* 464 */ Tcl_FSGetInternalRep, /* 465 */ Tcl_FSGetTranslatedPath, /* 466 */ Tcl_FSEvalFile, /* 467 */ Tcl_FSNewNativePath, /* 468 */ Tcl_FSGetNativePath, /* 469 */ Tcl_FSFileSystemInfo, /* 470 */ Tcl_FSPathSeparator, /* 471 */ Tcl_FSListVolumes, /* 472 */ Tcl_FSRegister, /* 473 */ Tcl_FSUnregister, /* 474 */ Tcl_FSData, /* 475 */ Tcl_FSGetTranslatedStringPath, /* 476 */ Tcl_FSGetFileSystemForPath, /* 477 */ Tcl_FSGetPathType, /* 478 */ Tcl_OutputBuffered, /* 479 */ Tcl_FSMountsChanged, /* 480 */ Tcl_EvalTokensStandard, /* 481 */ Tcl_GetTime, /* 482 */ Tcl_CreateObjTrace, /* 483 */ Tcl_GetCommandInfoFromToken, /* 484 */ Tcl_SetCommandInfoFromToken, /* 485 */ Tcl_DbNewWideIntObj, /* 486 */ Tcl_GetWideIntFromObj, /* 487 */ Tcl_NewWideIntObj, /* 488 */ Tcl_SetWideIntObj, /* 489 */ Tcl_AllocStatBuf, /* 490 */ Tcl_Seek, /* 491 */ Tcl_Tell, /* 492 */ Tcl_ChannelWideSeekProc, /* 493 */ Tcl_DictObjPut, /* 494 */ Tcl_DictObjGet, /* 495 */ Tcl_DictObjRemove, /* 496 */ Tcl_DictObjSize, /* 497 */ Tcl_DictObjFirst, /* 498 */ Tcl_DictObjNext, /* 499 */ Tcl_DictObjDone, /* 500 */ Tcl_DictObjPutKeyList, /* 501 */ Tcl_DictObjRemoveKeyList, /* 502 */ Tcl_NewDictObj, /* 503 */ Tcl_DbNewDictObj, /* 504 */ Tcl_RegisterConfig, /* 505 */ Tcl_CreateNamespace, /* 506 */ Tcl_DeleteNamespace, /* 507 */ Tcl_AppendExportList, /* 508 */ Tcl_Export, /* 509 */ Tcl_Import, /* 510 */ Tcl_ForgetImport, /* 511 */ Tcl_GetCurrentNamespace, /* 512 */ Tcl_GetGlobalNamespace, /* 513 */ Tcl_FindNamespace, /* 514 */ Tcl_FindCommand, /* 515 */ Tcl_GetCommandFromObj, /* 516 */ Tcl_GetCommandFullName, /* 517 */ Tcl_FSEvalFileEx, /* 518 */ Tcl_SetExitProc, /* 519 */ Tcl_LimitAddHandler, /* 520 */ Tcl_LimitRemoveHandler, /* 521 */ Tcl_LimitReady, /* 522 */ Tcl_LimitCheck, /* 523 */ Tcl_LimitExceeded, /* 524 */ Tcl_LimitSetCommands, /* 525 */ Tcl_LimitSetTime, /* 526 */ Tcl_LimitSetGranularity, /* 527 */ Tcl_LimitTypeEnabled, /* 528 */ Tcl_LimitTypeExceeded, /* 529 */ Tcl_LimitTypeSet, /* 530 */ Tcl_LimitTypeReset, /* 531 */ Tcl_LimitGetCommands, /* 532 */ Tcl_LimitGetTime, /* 533 */ Tcl_LimitGetGranularity, /* 534 */ Tcl_SaveInterpState, /* 535 */ Tcl_RestoreInterpState, /* 536 */ Tcl_DiscardInterpState, /* 537 */ Tcl_SetReturnOptions, /* 538 */ Tcl_GetReturnOptions, /* 539 */ Tcl_IsEnsemble, /* 540 */ Tcl_CreateEnsemble, /* 541 */ Tcl_FindEnsemble, /* 542 */ Tcl_SetEnsembleSubcommandList, /* 543 */ Tcl_SetEnsembleMappingDict, /* 544 */ Tcl_SetEnsembleUnknownHandler, /* 545 */ Tcl_SetEnsembleFlags, /* 546 */ Tcl_GetEnsembleSubcommandList, /* 547 */ Tcl_GetEnsembleMappingDict, /* 548 */ Tcl_GetEnsembleUnknownHandler, /* 549 */ Tcl_GetEnsembleFlags, /* 550 */ Tcl_GetEnsembleNamespace, /* 551 */ Tcl_SetTimeProc, /* 552 */ Tcl_QueryTimeProc, /* 553 */ Tcl_ChannelThreadActionProc, /* 554 */ Tcl_NewBignumObj, /* 555 */ Tcl_DbNewBignumObj, /* 556 */ Tcl_SetBignumObj, /* 557 */ Tcl_GetBignumFromObj, /* 558 */ Tcl_TakeBignumFromObj, /* 559 */ Tcl_TruncateChannel, /* 560 */ Tcl_ChannelTruncateProc, /* 561 */ Tcl_SetChannelErrorInterp, /* 562 */ Tcl_GetChannelErrorInterp, /* 563 */ Tcl_SetChannelError, /* 564 */ Tcl_GetChannelError, /* 565 */ Tcl_InitBignumFromDouble, /* 566 */ Tcl_GetNamespaceUnknownHandler, /* 567 */ Tcl_SetNamespaceUnknownHandler, /* 568 */ Tcl_GetEncodingFromObj, /* 569 */ Tcl_GetEncodingSearchPath, /* 570 */ Tcl_SetEncodingSearchPath, /* 571 */ Tcl_GetEncodingNameFromEnvironment, /* 572 */ Tcl_PkgRequireProc, /* 573 */ Tcl_AppendObjToErrorInfo, /* 574 */ Tcl_AppendLimitedToObj, /* 575 */ Tcl_Format, /* 576 */ Tcl_AppendFormatToObj, /* 577 */ Tcl_ObjPrintf, /* 578 */ Tcl_AppendPrintfToObj, /* 579 */ Tcl_CancelEval, /* 580 */ Tcl_Canceled, /* 581 */ Tcl_CreatePipe, /* 582 */ Tcl_NRCreateCommand, /* 583 */ Tcl_NREvalObj, /* 584 */ Tcl_NREvalObjv, /* 585 */ Tcl_NRCmdSwap, /* 586 */ Tcl_NRAddCallback, /* 587 */ Tcl_NRCallObjProc, /* 588 */ Tcl_GetFSDeviceFromStat, /* 589 */ Tcl_GetFSInodeFromStat, /* 590 */ Tcl_GetModeFromStat, /* 591 */ Tcl_GetLinkCountFromStat, /* 592 */ Tcl_GetUserIdFromStat, /* 593 */ Tcl_GetGroupIdFromStat, /* 594 */ Tcl_GetDeviceTypeFromStat, /* 595 */ Tcl_GetAccessTimeFromStat, /* 596 */ Tcl_GetModificationTimeFromStat, /* 597 */ Tcl_GetChangeTimeFromStat, /* 598 */ Tcl_GetSizeFromStat, /* 599 */ Tcl_GetBlocksFromStat, /* 600 */ Tcl_GetBlockSizeFromStat, /* 601 */ Tcl_SetEnsembleParameterList, /* 602 */ Tcl_GetEnsembleParameterList, /* 603 */ Tcl_ParseArgsObjv, /* 604 */ Tcl_GetErrorLine, /* 605 */ Tcl_SetErrorLine, /* 606 */ Tcl_TransferResult, /* 607 */ Tcl_InterpActive, /* 608 */ Tcl_BackgroundException, /* 609 */ Tcl_ZlibDeflate, /* 610 */ Tcl_ZlibInflate, /* 611 */ Tcl_ZlibCRC32, /* 612 */ Tcl_ZlibAdler32, /* 613 */ Tcl_ZlibStreamInit, /* 614 */ Tcl_ZlibStreamGetCommandName, /* 615 */ Tcl_ZlibStreamEof, /* 616 */ Tcl_ZlibStreamChecksum, /* 617 */ Tcl_ZlibStreamPut, /* 618 */ Tcl_ZlibStreamGet, /* 619 */ Tcl_ZlibStreamClose, /* 620 */ Tcl_ZlibStreamReset, /* 621 */ Tcl_SetStartupScript, /* 622 */ Tcl_GetStartupScript, /* 623 */ Tcl_CloseEx, /* 624 */ Tcl_NRExprObj, /* 625 */ Tcl_NRSubstObj, /* 626 */ Tcl_LoadFile, /* 627 */ Tcl_FindSymbol, /* 628 */ Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ 0, /* 631 */ 0, /* 632 */ 0, /* 633 */ 0, /* 634 */ 0, /* 635 */ 0, /* 636 */ 0, /* 637 */ 0, /* 638 */ 0, /* 639 */ 0, /* 640 */ 0, /* 641 */ 0, /* 642 */ 0, /* 643 */ 0, /* 644 */ 0, /* 645 */ 0, /* 646 */ 0, /* 647 */ 0, /* 648 */ 0, /* 649 */ 0, /* 650 */ 0, /* 651 */ 0, /* 652 */ 0, /* 653 */ 0, /* 654 */ 0, /* 655 */ 0, /* 656 */ 0, /* 657 */ 0, /* 658 */ 0, /* 659 */ 0, /* 660 */ 0, /* 661 */ 0, /* 662 */ 0, /* 663 */ 0, /* 664 */ 0, /* 665 */ 0, /* 666 */ 0, /* 667 */ 0, /* 668 */ 0, /* 669 */ 0, /* 670 */ 0, /* 671 */ 0, /* 672 */ 0, /* 673 */ 0, /* 674 */ 0, /* 675 */ 0, /* 676 */ 0, /* 677 */ 0, /* 678 */ 0, /* 679 */ 0, /* 680 */ 0, /* 681 */ 0, /* 682 */ 0, /* 683 */ 0, /* 684 */ 0, /* 685 */ 0, /* 686 */ 0, /* 687 */ TclUnusedStubEntry, /* 688 */ }; /* !END!: Do not edit above this line. */ tcl8.6.14/generic/tclStubLib.c0000644000175000017500000000606014554262142015473 0ustar sergeisergei/* * tclStubLib.c -- * * Stub object that will be statically linked into extensions that want * to access Tcl. * * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" MODULE_SCOPE const TclStubs *tclStubsPtr; MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; const TclStubs *tclStubsPtr = NULL; const TclPlatStubs *tclPlatStubsPtr = NULL; const TclIntStubs *tclIntStubsPtr = NULL; const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; /* * Use our own isDigit to avoid linking to libc on windows */ static int isDigit(const int c) { return (c >= '0' && c <= '9'); } /* *---------------------------------------------------------------------- * * Tcl_InitStubs -- * * Tries to initialise the stub table pointers and ensures that the * correct version of Tcl is loaded. * * Results: * The actual version of Tcl that satisfies the request, or NULL to * indicate that an error occurred. * * Side effects: * Sets the stub table pointers. * *---------------------------------------------------------------------- */ #undef Tcl_InitStubs MODULE_SCOPE const char * Tcl_InitStubs( Tcl_Interp *interp, const char *version, int exact) { Interp *iPtr = (Interp *) interp; const char *actualVersion = NULL; ClientData pkgData = NULL; const TclStubs *stubsPtr = iPtr->stubTable; /* * We can't optimize this check by caching tclStubsPtr because that * prevents apps from being able to load/unload Tcl dynamically multiple * times. [Bug 615304] */ if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism"; iPtr->freeProc = TCL_STATIC; return NULL; } actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); if (actualVersion == NULL) { return NULL; } if (exact) { const char *p = version; int count = 0; while (*p) { count += !isDigit(*p++); } if (count == 1) { const char *q = actualVersion; p = version; while (*p && (*p == *q)) { p++; q++; } if (*p || isDigit(*q)) { /* Construct error message */ stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; } } else { actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); if (actualVersion == NULL) { return NULL; } } } tclStubsPtr = (TclStubs *)pkgData; if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; } else { tclPlatStubsPtr = NULL; tclIntStubsPtr = NULL; tclIntPlatStubsPtr = NULL; } return actualVersion; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclTest.c0000644000175000017500000067332014560736524015066 0ustar sergeisergei/* * tclTest.c -- * * This file contains C command functions for a bunch of additional Tcl * commands that are used for testing out Tcl's C interfaces. These * commands are not normally included in Tcl applications; they're only * used for testing. * * Copyright (c) 1993-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. * Copyright (c) 2003 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #include "tclOO.h" #include /* * Required for Testregexp*Cmd */ #include "tclRegexp.h" /* * Required for TestlocaleCmd */ #include /* * Required for the TestChannelCmd and TestChannelEventCmd */ #include "tclIO.h" /* * Declare external functions used in Windows tests. */ /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the * Tcltest_Init declaration is in the source file itself, which is only * accessed when we are building a library. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT EXTERN int Tcltest_Init(Tcl_Interp *interp); EXTERN int Tcltest_SafeInit(Tcl_Interp *interp); /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect * the results of the various deletion callbacks. */ static Tcl_DString delString; static Tcl_Interp *delInterp; /* * One of the following structures exists for each asynchronous handler * created by the "testasync" command". */ typedef struct TestAsyncHandler { int id; /* Identifier for this handler. */ Tcl_AsyncHandler handler; /* Tcl's token for the handler. */ char *command; /* Command to invoke when the handler is * invoked. */ struct TestAsyncHandler *nextPtr; /* Next is list of handlers. */ } TestAsyncHandler; TCL_DECLARE_MUTEX(asyncTestMutex) static TestAsyncHandler *firstHandler = NULL; /* * The dynamic string below is used by the "testdstring" command to test the * dynamic string facilities. */ static Tcl_DString dstring; /* * The command trace below is used by the "testcmdtraceCmd" command to test * the command tracing facilities. */ static Tcl_Trace cmdTrace; /* * One of the following structures exists for each command created by * TestdelCmd: */ typedef struct { Tcl_Interp *interp; /* Interpreter in which command exists. */ char *deleteCmd; /* Script to execute when command is deleted. * Malloc'ed. */ } DelCmd; /* * The following is used to keep track of an encoding that invokes a Tcl * command. */ typedef struct { Tcl_Interp *interp; char *toUtfCmd; char *fromUtfCmd; } TclEncoding; /* * The counter below is used to determine if the TestsaveresultFree routine * was called for a result. */ static int freeCount; /* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. */ static int exitMainLoop = 0; /* * Event structure used in testing the event queue management procedures. */ typedef struct { Tcl_Event header; /* Header common to all events */ Tcl_Interp *interp; /* Interpreter that will handle the event */ Tcl_Obj *command; /* Command to evaluate when the event occurs */ Tcl_Obj *tag; /* Tag for this event used to delete it */ } TestEvent; /* * Simple detach/attach facility for testchannel cut|splice. Allow testing of * channel transfer in core testsuite. */ typedef struct TestChannel { Tcl_Channel chan; /* Detached channel */ struct TestChannel *nextPtr;/* Next in detached channel pool */ } TestChannel; static TestChannel *firstDetached; /* * Forward declarations for procedures defined later in this file: */ static int AsyncHandlerProc(ClientData clientData, Tcl_Interp *interp, int code); #ifdef TCL_THREADS static Tcl_ThreadCreateType AsyncThreadProc(ClientData); #endif static void CleanupTestSetassocdataTests( ClientData clientData, Tcl_Interp *interp); static void CmdDelProc1(ClientData clientData); static void CmdDelProc2(ClientData clientData); static Tcl_CmdProc CmdProc1; static Tcl_CmdProc CmdProc2; static void CmdTraceDeleteProc( ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, int argc, const char *argv[]); static void CmdTraceProc(ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, int argc, const char *argv[]); static Tcl_CmdProc CreatedCommandProc; static Tcl_CmdProc CreatedCommandProc2; static void DelCallbackProc(ClientData clientData, Tcl_Interp *interp); static Tcl_CmdProc DelCmdProc; static void DelDeleteProc(ClientData clientData); static void EncodingFreeProc(ClientData clientData); static int EncodingToUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int EncodingFromUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static void ExitProcEven(ClientData clientData); static void ExitProcOdd(ClientData clientData); static Tcl_ObjCmdProc GetTimesObjCmd; static void MainLoop(void); static Tcl_CmdProc NoopCmd; static Tcl_ObjCmdProc NoopObjCmd; static int ObjTraceProc(ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandToken, int objc, Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(ClientData clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static Tcl_FreeProc SpecialFree; static int StaticInitProc(Tcl_Interp *interp); static Tcl_CmdProc TestasyncCmd; static Tcl_ObjCmdProc TestbumpinterpepochObjCmd; static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; static Tcl_ObjCmdProc TestpurebytesobjObjCmd; static Tcl_ObjCmdProc TestbytestringObjCmd; static Tcl_ObjCmdProc TeststringbytesObjCmd; static Tcl_CmdProc TestcmdinfoCmd; static Tcl_CmdProc TestcmdtokenCmd; static Tcl_CmdProc TestcmdtraceCmd; static Tcl_CmdProc TestconcatobjCmd; static Tcl_CmdProc TestcreatecommandCmd; static Tcl_CmdProc TestdcallCmd; static Tcl_CmdProc TestdelCmd; static Tcl_CmdProc TestdelassocdataCmd; static Tcl_ObjCmdProc TestdoubledigitsObjCmd; static Tcl_CmdProc TestdstringCmd; static Tcl_ObjCmdProc TestencodingObjCmd; static Tcl_ObjCmdProc TestevalexObjCmd; static Tcl_ObjCmdProc TestevalobjvObjCmd; static Tcl_ObjCmdProc TesteventObjCmd; static int TesteventProc(Tcl_Event *event, int flags); static int TesteventDeleteProc(Tcl_Event *event, ClientData clientData); static Tcl_CmdProc TestexithandlerCmd; static Tcl_CmdProc TestexprlongCmd; static Tcl_ObjCmdProc TestexprlongobjCmd; static Tcl_CmdProc TestexprdoubleCmd; static Tcl_ObjCmdProc TestexprdoubleobjCmd; static Tcl_ObjCmdProc TestexprparserObjCmd; static Tcl_CmdProc TestexprstringCmd; static Tcl_ObjCmdProc TestfileCmd; static Tcl_ObjCmdProc TestfilelinkCmd; static Tcl_CmdProc TestfeventCmd; static Tcl_CmdProc TestgetassocdataCmd; static Tcl_CmdProc TestgetintCmd; static Tcl_CmdProc TestgetplatformCmd; static Tcl_ObjCmdProc TestgetvarfullnameCmd; static Tcl_CmdProc TestinterpdeleteCmd; static Tcl_CmdProc TestlinkCmd; static Tcl_ObjCmdProc TestlocaleCmd; static int TestMathFunc(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); static int TestMathFunc2(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); static Tcl_CmdProc TestmainthreadCmd; static Tcl_CmdProc TestsetmainloopCmd; static Tcl_CmdProc TestexitmainloopCmd; static Tcl_CmdProc TestpanicCmd; static Tcl_ObjCmdProc TestparseargsCmd; static Tcl_ObjCmdProc TestparserObjCmd; static Tcl_ObjCmdProc TestparsevarObjCmd; static Tcl_ObjCmdProc TestparsevarnameObjCmd; static Tcl_ObjCmdProc TestprintObjCmd; static Tcl_ObjCmdProc TestregexpObjCmd; static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); static Tcl_ObjCmdProc TestsaveresultCmd; static Tcl_FreeProc TestsaveresultFree; static Tcl_CmdProc TestsetassocdataCmd; static Tcl_CmdProc TestsetCmd; static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticpkgCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; static Tcl_ObjCmdProc TestWrongNumArgsObjCmd; static Tcl_ObjCmdProc TestGetIndexFromObjStructObjCmd; static Tcl_CmdProc TestChannelCmd; static Tcl_CmdProc TestChannelEventCmd; static Tcl_ObjCmdProc TestFilesystemObjCmd; static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel; static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory; static Tcl_FSChdirProc TestReportChdir; static Tcl_FSLstatProc TestReportLstat; static Tcl_FSCopyFileProc TestReportCopyFile; static Tcl_FSDeleteFileProc TestReportDeleteFile; static Tcl_FSRenameFileProc TestReportRenameFile; static Tcl_FSCreateDirectoryProc TestReportCreateDirectory; static Tcl_FSCopyDirectoryProc TestReportCopyDirectory; static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory; static int TestReportLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); static Tcl_FSLinkProc TestReportLink; static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings; static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet; static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet; static Tcl_FSUtimeProc TestReportUtime; static Tcl_FSNormalizePathProc TestReportNormalizePath; static Tcl_FSPathInFilesystemProc TestReportInFilesystem; static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep; static Tcl_FSDupInternalRepProc TestReportDupInternalRep; static Tcl_CmdProc TestServiceModeCmd; static Tcl_FSStatProc SimpleStat; static Tcl_FSAccessProc SimpleAccess; static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel; static Tcl_FSListVolumesProc SimpleListVolumes; static Tcl_FSPathInFilesystemProc SimplePathInFilesystem; static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr); static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; static Tcl_ObjCmdProc TestUtfNextCmd; static Tcl_ObjCmdProc TestUtfPrevCmd; static Tcl_ObjCmdProc TestNumUtfCharsCmd; static Tcl_ObjCmdProc TestGetUniCharCmd; static Tcl_ObjCmdProc TestFindFirstCmd; static Tcl_ObjCmdProc TestFindLastCmd; static Tcl_ObjCmdProc TestHashSystemHashCmd; static Tcl_NRPostProc NREUnwind_callback; static Tcl_ObjCmdProc TestNREUnwind; static Tcl_ObjCmdProc TestNRELevels; static Tcl_ObjCmdProc TestInterpResolverCmd; #if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL) static Tcl_ObjCmdProc TestcpuidCmd; #endif static Tcl_ObjCmdProc TestApplyLambdaObjCmd; static const Tcl_Filesystem testReportingFilesystem = { "reporting", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, TestReportInFilesystem, /* path in */ TestReportDupInternalRep, TestReportFreeInternalRep, NULL, /* native to norm */ NULL, /* convert to native */ TestReportNormalizePath, NULL, /* path type */ NULL, /* separator */ TestReportStat, TestReportAccess, TestReportOpenFileChannel, TestReportMatchInDirectory, TestReportUtime, TestReportLink, NULL /* list volumes */, TestReportFileAttrStrings, TestReportFileAttrsGet, TestReportFileAttrsSet, TestReportCreateDirectory, TestReportRemoveDirectory, TestReportDeleteFile, TestReportCopyFile, TestReportRenameFile, TestReportCopyDirectory, TestReportLstat, (Tcl_FSLoadFileProc *) TestReportLoadFile, NULL /* cwd */, TestReportChdir }; static const Tcl_Filesystem simpleFilesystem = { "simple", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, SimplePathInFilesystem, NULL, NULL, /* No internal to normalized, since we don't create any * pure 'internal' Tcl_Obj path representations */ NULL, /* No create native rep function, since we don't use it * or 'Tcl_FSNewNativePath' */ NULL, /* Normalize path isn't needed - we assume paths only have * one representation */ NULL, NULL, NULL, SimpleStat, SimpleAccess, SimpleOpenFileChannel, SimpleMatchInDirectory, NULL, /* We choose not to support symbolic links inside our vfs's */ NULL, SimpleListVolumes, NULL, NULL, NULL, NULL, NULL, NULL, /* No copy file - fallback will occur at Tcl level */ NULL, /* No rename file - fallback will occur at Tcl level */ NULL, /* No copy directory - fallback will occur at Tcl level */ NULL, /* Use stat for lstat */ NULL, /* No load - fallback on core implementation */ NULL, /* We don't need a getcwd or chdir - fallback on Tcl's versions */ NULL, NULL }; /* *---------------------------------------------------------------------- * * Tcltest_Init -- * * This procedure performs application-specific initialization. Most * applications, especially those that incorporate additional packages, * will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error message in * the interp's result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { Tcl_ValueType t3ArgTypes[2]; Tcl_Obj **objv, *objPtr; int objc, index; static const char *const specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) { return TCL_ERROR; } if (Tcl_OOInitStubs(interp) == NULL) { return TCL_ERROR; } /* TIP #268: Full patchlevel instead of just major.minor */ if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { return TCL_ERROR; } /* * Create additional commands and math functions for testing Tcl. */ Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", TestGetIndexFromObjStructObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbumpinterpepoch", TestbumpinterpepochObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, NULL, NULL); Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd, NULL, NULL); Tcl_DStringInit(&dstring); Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testevent", TesteventObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd, NULL, NULL); Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfile", TestfileCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testhashsystemhash", TestHashSystemHashCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgetint", TestgetintCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetvarfullname", TestgetvarfullnameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd, NULL, NULL); Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL, NULL); Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, NULL, NULL); Tcl_CreateCommand(interp, "testseterr", TestsetCmd, INT2PTR(TCL_LEAVE_ERR_MSG), NULL); Tcl_CreateCommand(interp, "testset2", Testset2Cmd, INT2PTR(TCL_LEAVE_ERR_MSG), NULL); Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testutfnext", TestUtfNextCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testutfprev", TestUtfPrevCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetunichar", TestGetUniCharCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindfirst", TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", TestFindLastCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); #if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL) Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, NULL, NULL); #endif t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, NULL); Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind, NULL, NULL); Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd, NULL, NULL); if (TclObjTest_Init(interp) != TCL_OK) { return TCL_ERROR; } if (Procbodytest_Init(interp) != TCL_OK) { return TCL_ERROR; } #ifdef TCL_THREADS if (TclThread_Init(interp) != TCL_OK) { return TCL_ERROR; } #endif /* * Check for special options used in ../tests/main.test */ objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); if (objPtr != NULL) { if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { return TCL_ERROR; } if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL, TCL_EXACT, &index) == TCL_OK)) { switch (index) { case 0: return TCL_ERROR; case 1: Tcl_DeleteInterp(interp); return TCL_ERROR; case 2: { int mode; Tcl_UnregisterChannel(interp, Tcl_GetChannel(interp, "stderr", &mode)); return TCL_ERROR; } case 3: if (objc-1) { Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, objv[1], TCL_GLOBAL_ONLY); } return TCL_ERROR; } } } /* * And finally add any platform specific test commands. */ return TclplatformtestInit(interp); } /* *---------------------------------------------------------------------- * * Tcltest_SafeInit -- * * This procedure performs application-specific initialization. Most * applications, especially those that incorporate additional packages, * will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error message in * the interp's result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcltest_SafeInit( Tcl_Interp *interp) /* Interpreter for application. */ { if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } return Procbodytest_SafeInit(interp); } /* *---------------------------------------------------------------------- * * TestasyncCmd -- * * This procedure implements the "testasync" command. It is used * to test the asynchronous handler facilities of Tcl. * * Results: * A standard Tcl result. * * Side effects: * Creates, deletes, and invokes handlers. * *---------------------------------------------------------------------- */ static int TestasyncCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { TestAsyncHandler *asyncPtr, *prevPtr; int id, code; static int nextId = 1; (void)dummy; if (argc < 2) { wrongNumArgs: Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { if (argc != 3) { goto wrongNumArgs; } asyncPtr = (TestAsyncHandler *)ckalloc(sizeof(TestAsyncHandler)); asyncPtr->command = (char *)ckalloc(strlen(argv[2]) + 1); strcpy(asyncPtr->command, argv[2]); Tcl_MutexLock(&asyncTestMutex); asyncPtr->id = nextId; nextId++; asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc, INT2PTR(asyncPtr->id)); asyncPtr->nextPtr = firstHandler; firstHandler = asyncPtr; Tcl_MutexUnlock(&asyncTestMutex); Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id)); } else if (strcmp(argv[1], "delete") == 0) { if (argc == 2) { Tcl_MutexLock(&asyncTestMutex); while (firstHandler != NULL) { asyncPtr = firstHandler; firstHandler = asyncPtr->nextPtr; Tcl_AsyncDelete(asyncPtr->handler); ckfree(asyncPtr->command); ckfree(asyncPtr); } Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; } if (argc != 3) { goto wrongNumArgs; } if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } Tcl_MutexLock(&asyncTestMutex); for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL; prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id != id) { continue; } if (prevPtr == NULL) { firstHandler = asyncPtr->nextPtr; } else { prevPtr->nextPtr = asyncPtr->nextPtr; } Tcl_AsyncDelete(asyncPtr->handler); ckfree(asyncPtr->command); ckfree(asyncPtr); break; } Tcl_MutexUnlock(&asyncTestMutex); } else if (strcmp(argv[1], "mark") == 0) { if (argc != 5) { goto wrongNumArgs; } if ((Tcl_GetInt(interp, argv[2], &id) != TCL_OK) || (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) { return TCL_ERROR; } Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { Tcl_AsyncMark(asyncPtr->handler); break; } } Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1)); Tcl_MutexUnlock(&asyncTestMutex); return code; #ifdef TCL_THREADS } else if (strcmp(argv[1], "marklater") == 0) { if (argc != 3) { goto wrongNumArgs; } if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { Tcl_ThreadId threadID; if (Tcl_CreateThread(&threadID, AsyncThreadProc, INT2PTR(id), TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { Tcl_AppendResult(interp, "can't create thread", NULL); Tcl_MutexUnlock(&asyncTestMutex); return TCL_ERROR; } break; } } Tcl_MutexUnlock(&asyncTestMutex); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, delete, int, mark, or marklater", NULL); return TCL_ERROR; #else /* !TCL_THREADS */ } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, delete, int, or mark", NULL); return TCL_ERROR; #endif } return TCL_OK; } static int AsyncHandlerProc( ClientData clientData, /* If of TestAsyncHandler structure. * in global list. */ Tcl_Interp *interp, /* Interpreter in which command was * executed, or NULL. */ int code) /* Current return code from command. */ { TestAsyncHandler *asyncPtr; int id = PTR2INT(clientData); const char *listArgv[4], *cmd; char string[TCL_INTEGER_SPACE]; Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { break; } } Tcl_MutexUnlock(&asyncTestMutex); if (!asyncPtr) { /* Woops - this one was deleted between the AsyncMark and now */ return TCL_OK; } TclFormatInt(string, code); listArgv[0] = asyncPtr->command; listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp)); listArgv[2] = string; listArgv[3] = NULL; cmd = Tcl_Merge(3, listArgv); if (interp != NULL) { code = Tcl_EvalEx(interp, cmd, -1, 0); } else { /* * this should not happen, but by definition of how async handlers are * invoked, it's possible. Better error checking is needed here. */ } ckfree(cmd); return code; } /* *---------------------------------------------------------------------- * * AsyncThreadProc -- * * Delivers an asynchronous event to a handler in another thread. * * Results: * None. * * Side effects: * Invokes Tcl_AsyncMark on the handler * *---------------------------------------------------------------------- */ #ifdef TCL_THREADS static Tcl_ThreadCreateType AsyncThreadProc( ClientData clientData) /* Parameter is the id of a * TestAsyncHandler, defined above. */ { TestAsyncHandler *asyncPtr; int id = PTR2INT(clientData); Tcl_Sleep(1); Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { Tcl_AsyncMark(asyncPtr->handler); break; } } Tcl_MutexUnlock(&asyncTestMutex); Tcl_ExitThread(TCL_OK); TCL_THREAD_CREATE_RETURN; } #endif static int TestbumpinterpepochObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *)interp; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } iPtr->compileEpoch++; return TCL_OK; } /* *---------------------------------------------------------------------- * * TestcmdinfoCmd -- * * This procedure implements the "testcmdinfo" command. It is used to * test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and * deletion. * * Results: * A standard Tcl result. * * Side effects: * Creates and deletes various commands and modifies their data. * *---------------------------------------------------------------------- */ static int TestcmdinfoCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_CmdInfo info; (void)dummy; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option cmdName\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { Tcl_CreateCommand(interp, argv[2], CmdProc1, (ClientData) "original", CmdDelProc1); } else if (strcmp(argv[1], "delete") == 0) { Tcl_DStringInit(&delString); Tcl_DeleteCommand(interp, argv[2]); Tcl_DStringResult(interp, &delString); } else if (strcmp(argv[1], "get") == 0) { if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) { Tcl_AppendResult(interp, "??", NULL); return TCL_OK; } if (info.proc == CmdProc1) { Tcl_AppendResult(interp, "CmdProc1", " ", (char *) info.clientData, NULL); } else if (info.proc == CmdProc2) { Tcl_AppendResult(interp, "CmdProc2", " ", (char *) info.clientData, NULL); } else { Tcl_AppendResult(interp, "unknown", NULL); } if (info.deleteProc == CmdDelProc1) { Tcl_AppendResult(interp, " CmdDelProc1", " ", (char *) info.deleteData, NULL); } else if (info.deleteProc == CmdDelProc2) { Tcl_AppendResult(interp, " CmdDelProc2", " ", (char *) info.deleteData, NULL); } else { Tcl_AppendResult(interp, " unknown", NULL); } Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL); if (info.isNativeObjectProc) { Tcl_AppendResult(interp, " nativeObjectProc", NULL); } else { Tcl_AppendResult(interp, " stringProc", NULL); } } else if (strcmp(argv[1], "modify") == 0) { info.proc = CmdProc2; info.clientData = (ClientData) "new_command_data"; info.objProc = NULL; info.objClientData = NULL; info.deleteProc = CmdDelProc2; info.deleteData = (ClientData) "new_delete_data"; if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) { Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, delete, get, or modify", NULL); return TCL_ERROR; } return TCL_OK; } static int CmdProc1( ClientData clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, NULL); return TCL_OK; } static int CmdProc2( ClientData clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL); return TCL_OK; } static void CmdDelProc1( ClientData clientData) /* String to save. */ { Tcl_DStringInit(&delString); Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1); Tcl_DStringAppend(&delString, (char *) clientData, -1); } static void CmdDelProc2( ClientData clientData) /* String to save. */ { Tcl_DStringInit(&delString); Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1); Tcl_DStringAppend(&delString, (char *) clientData, -1); } /* *---------------------------------------------------------------------- * * TestcmdtokenCmd -- * * This procedure implements the "testcmdtoken" command. It is used to * test Tcl_Command tokens and procedures such as Tcl_GetCommandFullName. * * Results: * A standard Tcl result. * * Side effects: * Creates and deletes various commands and modifies their data. * *---------------------------------------------------------------------- */ static int TestcmdtokenCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Command token; int *l; char buf[30]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option arg\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { token = Tcl_CreateCommand(interp, argv[2], CmdProc1, (ClientData) "original", NULL); snprintf(buf, sizeof(buf), "%p", (void *)token); Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "name") == 0) { Tcl_Obj *objPtr; if (sscanf(argv[2], "%p", &l) != 1) { Tcl_AppendResult(interp, "bad command token \"", argv[2], "\"", NULL); return TCL_ERROR; } objPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr); Tcl_AppendElement(interp, Tcl_GetCommandName(interp, (Tcl_Command) l)); Tcl_AppendElement(interp, Tcl_GetString(objPtr)); Tcl_DecrRefCount(objPtr); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create or name", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestcmdtraceCmd -- * * This procedure implements the "testcmdtrace" command. It is used * to test Tcl_CreateTrace and Tcl_DeleteTrace. * * Results: * A standard Tcl result. * * Side effects: * Creates and deletes a command trace, and tests the invocation of * a procedure by the command trace. * *---------------------------------------------------------------------- */ static int TestcmdtraceCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_DString buffer; int result; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option script\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "tracetest") == 0) { Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); } Tcl_DeleteTrace(interp, cmdTrace); Tcl_DStringFree(&buffer); } else if (strcmp(argv[1], "deletetest") == 0) { /* * Create a command trace then eval a script to check whether it is * called. Note that this trace procedure removes itself as a further * check of the robustness of the trace proc calling code in * TclNRExecuteByteCode. */ cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL); Tcl_EvalEx(interp, argv[2], -1, 0); } else if (strcmp(argv[1], "leveltest") == 0) { Interp *iPtr = (Interp *) interp; Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc, &buffer); result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); } Tcl_DeleteTrace(interp, cmdTrace); Tcl_DStringFree(&buffer); } else if (strcmp(argv[1], "resulttest") == 0) { /* Create an object-based trace, then eval a script. This is used * to test return codes other than TCL_OK from the trace engine. */ static int deleteCalled; deleteCalled = 0; cmdTrace = Tcl_CreateObjTrace(interp, 50000, TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc, &deleteCalled, ObjTraceDeleteProc); result = Tcl_Eval(interp, argv[2]); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { Tcl_AppendResult(interp, "Delete wasn't called", NULL); return TCL_ERROR; } else { return result; } } else if (strcmp(argv[1], "doubletest") == 0) { Tcl_Trace t1, t2; Tcl_DStringInit(&buffer); t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer); t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); result = Tcl_Eval(interp, argv[2]); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); } Tcl_DeleteTrace(interp, t2); Tcl_DeleteTrace(interp, t1); Tcl_DStringFree(&buffer); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be tracetest, deletetest, doubletest or resulttest", NULL); return TCL_ERROR; } return TCL_OK; } static void CmdTraceProc( ClientData clientData, /* Pointer to buffer in which the * command and arguments are appended. * Accumulates test result. */ Tcl_Interp *interp, /* Current interpreter. */ int level, /* Current trace level. */ char *command, /* The command being traced (after * substitutions). */ Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */ ClientData cmdClientData, /* Client data associated with command * procedure. */ int argc, /* Number of arguments. */ const char *argv[]) /* Argument strings. */ { Tcl_DString *bufPtr = (Tcl_DString *) clientData; int i; Tcl_DStringAppendElement(bufPtr, command); Tcl_DStringStartSublist(bufPtr); for (i = 0; i < argc; i++) { Tcl_DStringAppendElement(bufPtr, argv[i]); } Tcl_DStringEndSublist(bufPtr); } static void CmdTraceDeleteProc( ClientData clientData, /* Unused. */ Tcl_Interp *interp, /* Current interpreter. */ int level, /* Current trace level. */ char *command, /* The command being traced (after * substitutions). */ Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */ ClientData cmdClientData, /* Client data associated with command * procedure. */ int argc, /* Number of arguments. */ const char *argv[]) /* Argument strings. */ { /* * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace * callback causes the for loop in TclNRExecuteByteCode that calls traces to * reference freed memory. */ Tcl_DeleteTrace(interp, cmdTrace); } static int ObjTraceProc( ClientData clientData, /* unused */ Tcl_Interp *interp, /* Tcl interpreter */ int level, /* Execution level */ const char *command, /* Command being executed */ Tcl_Command token, /* Command information */ int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter list */ { const char *word = Tcl_GetString(objv[0]); if (!strcmp(word, "Error")) { Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); return TCL_ERROR; } else if (!strcmp(word, "Break")) { return TCL_BREAK; } else if (!strcmp(word, "Continue")) { return TCL_CONTINUE; } else if (!strcmp(word, "Return")) { return TCL_RETURN; } else if (!strcmp(word, "OtherStatus")) { return 6; } else { return TCL_OK; } } static void ObjTraceDeleteProc( ClientData clientData) { int *intPtr = (int *) clientData; *intPtr = 1; /* Record that the trace was deleted */ } /* *---------------------------------------------------------------------- * * TestcreatecommandCmd -- * * This procedure implements the "testcreatecommand" command. It is used * to test that the Tcl_CreateCommand creates a new command in the * namespace specified as part of its name, if any. It also checks that * the namespace code ignore single ":"s in the middle or end of a * command name. * * Results: * A standard Tcl result. * * Side effects: * Creates and deletes two commands ("test_ns_basic::createdcommand" * and "value:at:"). * *---------------------------------------------------------------------- */ static int TestcreatecommandCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { Tcl_CreateCommand(interp, "test_ns_basic::createdcommand", CreatedCommandProc, NULL, NULL); } else if (strcmp(argv[1], "delete") == 0) { Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand"); } else if (strcmp(argv[1], "create2") == 0) { Tcl_CreateCommand(interp, "value:at:", CreatedCommandProc2, NULL, NULL); } else if (strcmp(argv[1], "delete2") == 0) { Tcl_DeleteCommand(interp, "value:at:"); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, delete, create2, or delete2", NULL); return TCL_ERROR; } return TCL_OK; } static int CreatedCommandProc( ClientData clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_CmdInfo info; int found; found = Tcl_GetCommandInfo(interp, "test_ns_basic::createdcommand", &info); if (!found) { Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand", NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "CreatedCommandProc in ", info.namespacePtr->fullName, NULL); return TCL_OK; } static int CreatedCommandProc2( ClientData clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_CmdInfo info; int found; found = Tcl_GetCommandInfo(interp, "value:at:", &info); if (!found) { Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand", NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "CreatedCommandProc2 in ", info.namespacePtr->fullName, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestdcallCmd -- * * This procedure implements the "testdcall" command. It is used * to test Tcl_CallWhenDeleted. * * Results: * A standard Tcl result. * * Side effects: * Creates and deletes interpreters. * *---------------------------------------------------------------------- */ static int TestdcallCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int i, id; delInterp = Tcl_CreateInterp(); Tcl_DStringInit(&delString); for (i = 1; i < argc; i++) { if (Tcl_GetInt(interp, argv[i], &id) != TCL_OK) { return TCL_ERROR; } if (id < 0) { Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc, INT2PTR(-id)); } else { Tcl_CallWhenDeleted(delInterp, DelCallbackProc, INT2PTR(id)); } } Tcl_DeleteInterp(delInterp); Tcl_DStringResult(interp, &delString); return TCL_OK; } /* * The deletion callback used by TestdcallCmd: */ static void DelCallbackProc( ClientData clientData, /* Numerical value to append to delString. */ Tcl_Interp *interp) /* Interpreter being deleted. */ { int id = PTR2INT(clientData); char buffer[TCL_INTEGER_SPACE]; TclFormatInt(buffer, id); Tcl_DStringAppendElement(&delString, buffer); if (interp != delInterp) { Tcl_DStringAppendElement(&delString, "bogus interpreter argument!"); } } /* *---------------------------------------------------------------------- * * TestdelCmd -- * * This procedure implements the "testdel" command. It is used * to test calling of command deletion callbacks. * * Results: * A standard Tcl result. * * Side effects: * Creates a command. * *---------------------------------------------------------------------- */ static int TestdelCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { DelCmd *dPtr; Tcl_Interp *child; if (argc != 4) { Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } child = Tcl_GetChild(interp, argv[1]); if (child == NULL) { return TCL_ERROR; } dPtr = (DelCmd *)ckalloc(sizeof(DelCmd)); dPtr->interp = interp; dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1); strcpy(dPtr->deleteCmd, argv[3]); Tcl_CreateCommand(child, argv[2], DelCmdProc, dPtr, DelDeleteProc); return TCL_OK; } static int DelCmdProc( ClientData clientData, /* String result to return. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { DelCmd *dPtr = (DelCmd *) clientData; Tcl_AppendResult(interp, dPtr->deleteCmd, NULL); ckfree(dPtr->deleteCmd); ckfree(dPtr); return TCL_OK; } static void DelDeleteProc( ClientData clientData) /* String command to evaluate. */ { DelCmd *dPtr = (DelCmd *)clientData; Tcl_Eval(dPtr->interp, dPtr->deleteCmd); Tcl_ResetResult(dPtr->interp); ckfree(dPtr->deleteCmd); ckfree(dPtr); } /* *---------------------------------------------------------------------- * * TestdelassocdataCmd -- * * This procedure implements the "testdelassocdata" command. It is used * to test Tcl_DeleteAssocData. * * Results: * A standard Tcl result. * * Side effects: * Deletes an association between a key and associated data from an * interpreter. * *---------------------------------------------------------------------- */ static int TestdelassocdataCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " data_key\"", NULL); return TCL_ERROR; } Tcl_DeleteAssocData(interp, argv[1]); return TCL_OK; } /* *----------------------------------------------------------------------------- * * TestdoubledigitsCmd -- * * This procedure implements the 'testdoubledigits' command. It is * used to test the low-level floating-point formatting primitives * in Tcl. * * Usage: * testdoubledigits fpval ndigits type ?shorten" * * Parameters: * fpval - Floating-point value to format. * ndigits - Digit count to request from Tcl_DoubleDigits * type - One of 'shortest', 'Steele', 'e', 'f' * shorten - Indicates that the 'shorten' flag should be passed in. * *----------------------------------------------------------------------------- */ static int TestdoubledigitsObjCmd( ClientData unused, /* NULL */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj* const objv[]) /* Parameter vector */ { static const char *options[] = { "shortest", "Steele", "e", "f", NULL }; static const int types[] = { TCL_DD_SHORTEST, TCL_DD_STEELE, TCL_DD_E_FORMAT, TCL_DD_F_FORMAT }; const Tcl_ObjType* doubleType; double d; int status; int ndigits; int type; int decpt; int signum; char *str; char *endPtr; Tcl_Obj* strObj; Tcl_Obj* retval; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "fpval ndigits type ?shorten?"); return TCL_ERROR; } status = Tcl_GetDoubleFromObj(interp, objv[1], &d); if (status != TCL_OK) { doubleType = Tcl_GetObjType("double"); if (objv[1]->typePtr == doubleType || TclIsNaN(objv[1]->internalRep.doubleValue)) { status = TCL_OK; memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double)); } } if (status != TCL_OK || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", TCL_EXACT, &type) != TCL_OK) { fprintf(stderr, "bad value? %g\n", d); return TCL_ERROR; } type = types[type]; if (objc > 4) { if (strcmp(Tcl_GetString(objv[4]), "shorten")) { Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1)); return TCL_ERROR; } type |= TCL_DD_SHORTEN_FLAG; } str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr); strObj = Tcl_NewStringObj(str, endPtr-str); ckfree(str); retval = Tcl_NewListObj(1, &strObj); Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt)); strObj = Tcl_NewStringObj(signum ? "-" : "+", 1); Tcl_ListObjAppendElement(NULL, retval, strObj); Tcl_SetObjResult(interp, retval); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestdstringCmd -- * * This procedure implements the "testdstring" command. It is used * to test the dynamic string facilities of Tcl. * * Results: * A standard Tcl result. * * Side effects: * Creates, deletes, and invokes handlers. * *---------------------------------------------------------------------- */ static int TestdstringCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int count; if (argc < 2) { wrongNumArgs: Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } if (strcmp(argv[1], "append") == 0) { if (argc != 4) { goto wrongNumArgs; } if (Tcl_GetInt(interp, argv[3], &count) != TCL_OK) { return TCL_ERROR; } Tcl_DStringAppend(&dstring, argv[2], count); } else if (strcmp(argv[1], "element") == 0) { if (argc != 3) { goto wrongNumArgs; } Tcl_DStringAppendElement(&dstring, argv[2]); } else if (strcmp(argv[1], "end") == 0) { if (argc != 2) { goto wrongNumArgs; } Tcl_DStringEndSublist(&dstring); } else if (strcmp(argv[1], "free") == 0) { if (argc != 2) { goto wrongNumArgs; } Tcl_DStringFree(&dstring); } else if (strcmp(argv[1], "get") == 0) { if (argc != 2) { goto wrongNumArgs; } Tcl_SetResult(interp, Tcl_DStringValue(&dstring), TCL_VOLATILE); } else if (strcmp(argv[1], "gresult") == 0) { if (argc != 3) { goto wrongNumArgs; } if (strcmp(argv[2], "staticsmall") == 0) { Tcl_AppendResult(interp, "short", NULL); } else if (strcmp(argv[2], "staticlarge") == 0) { Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL); } else if (strcmp(argv[2], "free") == 0) { char *s = (char *)ckalloc(100); strcpy(s, "This is a malloc-ed string"); Tcl_SetResult(interp, s, TCL_DYNAMIC); } else if (strcmp(argv[2], "special") == 0) { char *s = (char *)ckalloc(100) + 16; strcpy(s, "This is a specially-allocated string"); Tcl_SetResult(interp, s, SpecialFree); } else { Tcl_AppendResult(interp, "bad gresult option \"", argv[2], "\": must be staticsmall, staticlarge, free, or special", NULL); return TCL_ERROR; } Tcl_DStringGetResult(interp, &dstring); } else if (strcmp(argv[1], "length") == 0) { if (argc != 2) { goto wrongNumArgs; } Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring))); } else if (strcmp(argv[1], "result") == 0) { if (argc != 2) { goto wrongNumArgs; } Tcl_DStringResult(interp, &dstring); } else if (strcmp(argv[1], "trunc") == 0) { if (argc != 3) { goto wrongNumArgs; } if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) { return TCL_ERROR; } Tcl_DStringSetLength(&dstring, count); } else if (strcmp(argv[1], "start") == 0) { if (argc != 2) { goto wrongNumArgs; } Tcl_DStringStartSublist(&dstring); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be append, element, end, free, get, length, " "result, trunc, or start", NULL); return TCL_ERROR; } return TCL_OK; } /* * The procedure below is used as a special freeProc to test how well * Tcl_DStringGetResult handles freeProc's other than free. */ static void SpecialFree( #if TCL_MAJOR_VERSION > 8 void *blockPtr /* Block to free. */ #else char *blockPtr /* Block to free. */ #endif ) { ckfree((char *)blockPtr - 16); } /* *------------------------------------------------------------------------ * * UtfTransformFn -- * * Implements a direct call into Tcl_UtfToExternal and Tcl_ExternalToUtf * as otherwise there is no script level command that directly exercises * these functions (i/o command cannot test all combinations) * The arguments at the script level are roughly those of the above * functions: * encodingname srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar? * * Results: * TCL_OK or TCL_ERROR. This any errors running the test, NOT the * result of Tcl_UtfToExternal or Tcl_ExternalToUtf. * * Side effects: * * The result in the interpreter is a list of the return code from the * Tcl_UtfToExternal/Tcl_ExternalToUtf functions, the encoding state, and * an encoded binary string of length dstLen. Note the string is the * entire output buffer, not just the part containing the decoded * portion. This allows for additional checks at test script level. * * If any of the srcreadvar, dstwrotevar and * dstcharsvar are specified and not empty, they are treated as names * of variables where the *srcRead, *dstWrote and *dstChars output * from the functions are stored. * * The function also checks internally whether nuls are correctly * appended as requested but the TCL_ENCODING_NO_TERMINATE flag * and that no buffer overflows occur. *------------------------------------------------------------------------ */ typedef int UtfTransformFn(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int UtfExtWrapper( Tcl_Interp *interp, UtfTransformFn *transformer, int objc, Tcl_Obj *const objv[]) { Tcl_Encoding encoding; Tcl_EncodingState encState, *encStatePtr; int srcLen, bufLen; const unsigned char *bytes; unsigned char *bufPtr; int srcRead, dstLen, dstWrote, dstChars; Tcl_Obj *srcReadVar, *dstWroteVar, *dstCharsVar; int result; int flags; Tcl_Obj **flagObjs; int nflags; static const struct { const char *flagKey; int flag; } flagMap[] = { {"start", TCL_ENCODING_START}, {"end", TCL_ENCODING_END}, {"stoponerror", TCL_ENCODING_STOPONERROR}, {"noterminate", TCL_ENCODING_NO_TERMINATE}, {"charlimit", TCL_ENCODING_CHAR_LIMIT}, {NULL, 0} }; int i; Tcl_WideInt wide; if (objc < 7 || objc > 10) { Tcl_WrongNumArgs(interp, 2, objv, "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?"); return TCL_ERROR; } if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) { return TCL_ERROR; } /* Flags may be specified as list of integers and keywords */ flags = 0; if (Tcl_ListObjGetElements(interp, objv[4], &nflags, &flagObjs) != TCL_OK) { return TCL_ERROR; } for (i = 0; i < nflags; ++i) { int flag; if (Tcl_GetIntFromObj(NULL, flagObjs[i], &flag) == TCL_OK) { flags |= flag; } else { int idx; if (Tcl_GetIndexFromObjStruct(interp, flagObjs[i], flagMap, sizeof(flagMap[0]), "flag", 0, &idx) != TCL_OK) { return TCL_ERROR; } flags |= flagMap[idx].flag; } } /* Assumes state is integer if not "" */ if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) { encState = (Tcl_EncodingState)(size_t)wide; encStatePtr = &encState; } else if (Tcl_GetCharLength(objv[5]) == 0) { encStatePtr = NULL; } else { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[6], &dstLen) != TCL_OK) { return TCL_ERROR; } srcReadVar = NULL; dstWroteVar = NULL; dstCharsVar = NULL; if (objc > 7) { /* Has caller requested srcRead? */ if (Tcl_GetCharLength(objv[7])) { srcReadVar = objv[7]; } if (objc > 8) { /* Ditto for dstWrote */ if (Tcl_GetCharLength(objv[8])) { dstWroteVar = objv[8]; } if (objc > 9) { if (Tcl_GetCharLength(objv[9])) { dstCharsVar = objv[9]; } } } } if (flags & TCL_ENCODING_CHAR_LIMIT) { /* Caller should have specified the dest char limit */ Tcl_Obj *valueObj; if (dstCharsVar == NULL || (valueObj = Tcl_ObjGetVar2(interp, dstCharsVar, NULL, 0)) == NULL ) { Tcl_SetResult(interp, "dstCharsVar must be specified with integer value if " "TCL_ENCODING_CHAR_LIMIT set in flags.", TCL_STATIC); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, valueObj, &dstChars) != TCL_OK) { return TCL_ERROR; } } else { dstChars = 0; /* Only used for output */ } bufLen = dstLen + 4; /* 4 -> overflow detection */ bufPtr = (unsigned char *) ckalloc(bufLen); memset(bufPtr, 0xFF, dstLen); /* Need to check nul terminator */ memmove(bufPtr + dstLen, "\xAB\xCD\xEF\xAB", 4); /* overflow detection */ bytes = Tcl_GetByteArrayFromObj(objv[3], &srcLen); /* Last! to avoid shimmering */ result = (*transformer)(interp, encoding, (const char *)bytes, srcLen, flags, encStatePtr, (char *) bufPtr, dstLen, srcReadVar ? &srcRead : NULL, &dstWrote, dstCharsVar ? &dstChars : NULL); if (memcmp(bufPtr + bufLen - 4, "\xAB\xCD\xEF\xAB", 4)) { Tcl_SetResult(interp, "Tcl_ExternalToUtf wrote past output buffer", TCL_STATIC); result = TCL_ERROR; } else if (result != TCL_ERROR) { Tcl_Obj *resultObjs[3]; switch (result) { case TCL_OK: resultObjs[0] = Tcl_NewStringObj("ok", -1); break; case TCL_CONVERT_MULTIBYTE: resultObjs[0] = Tcl_NewStringObj("multibyte", -1); break; case TCL_CONVERT_SYNTAX: resultObjs[0] = Tcl_NewStringObj("syntax", -1); break; case TCL_CONVERT_UNKNOWN: resultObjs[0] = Tcl_NewStringObj("unknown", -1); break; case TCL_CONVERT_NOSPACE: resultObjs[0] = Tcl_NewStringObj("nospace", -1); break; default: resultObjs[0] = Tcl_NewIntObj(result); break; } result = TCL_OK; resultObjs[1] = encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj(); resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen); if (srcReadVar) { if (Tcl_ObjSetVar2(interp, srcReadVar, NULL, Tcl_NewIntObj(srcRead), TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } if (dstWroteVar) { if (Tcl_ObjSetVar2(interp, dstWroteVar, NULL, Tcl_NewIntObj(dstWrote), TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } if (dstCharsVar) { if (Tcl_ObjSetVar2(interp, dstCharsVar, NULL, Tcl_NewIntObj(dstChars), TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewListObj(3, resultObjs)); } ckfree(bufPtr); Tcl_FreeEncoding(encoding); /* Free returned reference */ return result; } /* *---------------------------------------------------------------------- * * TestencodingCmd -- * * This procedure implements the "testencoding" command. It is used * to test the encoding package. * * Results: * A standard Tcl result. * * Side effects: * Load encodings. * *---------------------------------------------------------------------- */ static int TestencodingObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Encoding encoding; int index, length; const char *string; TclEncoding *encodingPtr; static const char *const optionStrings[] = { "create", "delete", "Tcl_ExternalToUtf", "Tcl_UtfToExternal", NULL }; enum options { ENC_CREATE, ENC_DELETE, ENC_EXTTOUTF, ENC_UTFTOEXT }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?args?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case ENC_CREATE: { Tcl_EncodingType type; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name toutfcmd fromutfcmd"); return TCL_ERROR; } encodingPtr = (TclEncoding *)ckalloc(sizeof(TclEncoding)); encodingPtr->interp = interp; string = Tcl_GetStringFromObj(objv[3], &length); encodingPtr->toUtfCmd = (char *)ckalloc(length + 1); memcpy(encodingPtr->toUtfCmd, string, length + 1); string = Tcl_GetStringFromObj(objv[4], &length); encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1); memcpy(encodingPtr->fromUtfCmd, string, length + 1); string = Tcl_GetStringFromObj(objv[2], &length); type.encodingName = string; type.toUtfProc = EncodingToUtfProc; type.fromUtfProc = EncodingFromUtfProc; type.freeProc = EncodingFreeProc; type.clientData = encodingPtr; type.nullSize = 1; Tcl_CreateEncoding(&type); break; } case ENC_DELETE: if (objc != 3) { return TCL_ERROR; } if (TCL_OK != Tcl_GetEncodingFromObj(interp, objv[2], &encoding)) { return TCL_ERROR; } Tcl_FreeEncoding(encoding); /* Free returned reference */ Tcl_FreeEncoding(encoding); /* Free to match CREATE */ break; case ENC_EXTTOUTF: return UtfExtWrapper(interp,Tcl_ExternalToUtf,objc,objv); case ENC_UTFTOEXT: return UtfExtWrapper(interp,Tcl_UtfToExternal,objc,objv); } return TCL_OK; } static int EncodingToUtfProc( ClientData clientData, /* TclEncoding structure. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Current state. */ char *dst, /* Output buffer. */ int dstLen, /* The maximum length of output buffer. */ int *srcReadPtr, /* Filled with number of bytes read. */ int *dstWrotePtr, /* Filled with number of bytes stored. */ int *dstCharsPtr) /* Filled with number of chars stored. */ { int len; TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { len = dstLen; } memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len); Tcl_ResetResult(encodingPtr->interp); *srcReadPtr = srcLen; *dstWrotePtr = len; *dstCharsPtr = len; return TCL_OK; } static int EncodingFromUtfProc( ClientData clientData, /* TclEncoding structure. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Current state. */ char *dst, /* Output buffer. */ int dstLen, /* The maximum length of output buffer. */ int *srcReadPtr, /* Filled with number of bytes read. */ int *dstWrotePtr, /* Filled with number of bytes stored. */ int *dstCharsPtr) /* Filled with number of chars stored. */ { int len; TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { len = dstLen; } memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len); Tcl_ResetResult(encodingPtr->interp); *srcReadPtr = srcLen; *dstWrotePtr = len; *dstCharsPtr = len; return TCL_OK; } static void EncodingFreeProc( ClientData clientData) /* ClientData associated with type. */ { TclEncoding *encodingPtr = (TclEncoding *)clientData; ckfree(encodingPtr->toUtfCmd); ckfree(encodingPtr->fromUtfCmd); ckfree(encodingPtr); } /* *---------------------------------------------------------------------- * * TestevalexObjCmd -- * * This procedure implements the "testevalex" command. It is * used to test Tcl_EvalEx. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestevalexObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length, flags; const char *script; flags = 0; if (objc == 3) { const char *global = Tcl_GetString(objv[2]); if (strcmp(global, "global") != 0) { Tcl_AppendResult(interp, "bad value \"", global, "\": must be global", NULL); return TCL_ERROR; } flags = TCL_EVAL_GLOBAL; } else if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "script ?global?"); return TCL_ERROR; } script = Tcl_GetStringFromObj(objv[1], &length); return Tcl_EvalEx(interp, script, length, flags); } /* *---------------------------------------------------------------------- * * TestevalobjvObjCmd -- * * This procedure implements the "testevalobjv" command. It is * used to test Tcl_EvalObjv. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestevalobjvObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int evalGlobal; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "global word ?word ...?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[1], &evalGlobal) != TCL_OK) { return TCL_ERROR; } return Tcl_EvalObjv(interp, objc-2, objv+2, (evalGlobal) ? TCL_EVAL_GLOBAL : 0); } /* *---------------------------------------------------------------------- * * TesteventObjCmd -- * * This procedure implements a 'testevent' command. The command * is used to test event queue management. * * The command takes two forms: * - testevent queue name position script * Queues an event at the given position in the queue, and * associates a given name with it (the same name may be * associated with multiple events). When the event comes * to the head of the queue, executes the given script at * global level in the current interp. The position may be * one of 'head', 'tail' or 'mark'. * - testevent delete name * Deletes any events associated with the given name from * the queue. * * Return value: * Returns a standard Tcl result. * * Side effects: * Manipulates the event queue as directed. * *---------------------------------------------------------------------- */ static int TesteventObjCmd( ClientData unused, /* Not used */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter vector */ { static const char *const subcommands[] = { /* Possible subcommands */ "queue", "delete", NULL }; int subCmdIndex; /* Index of the chosen subcommand */ static const char *const positions[] = { /* Possible queue positions */ "head", "tail", "mark", NULL }; int posIndex; /* Index of the chosen position */ static const Tcl_QueuePosition posNum[] = { /* Interpretation of the chosen position */ TCL_QUEUE_HEAD, TCL_QUEUE_TAIL, TCL_QUEUE_MARK }; TestEvent *ev; /* Event to be queued */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand", TCL_EXACT, &subCmdIndex) != TCL_OK) { return TCL_ERROR; } switch (subCmdIndex) { case 0: /* queue */ if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name position script"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[3], positions, "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { return TCL_ERROR; } ev = (TestEvent *)ckalloc(sizeof(TestEvent)); ev->header.proc = TesteventProc; ev->header.nextPtr = NULL; ev->interp = interp; ev->command = objv[4]; Tcl_IncrRefCount(ev->command); ev->tag = objv[2]; Tcl_IncrRefCount(ev->tag); Tcl_QueueEvent((Tcl_Event *) ev, posNum[posIndex]); break; case 1: /* delete */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "name"); return TCL_ERROR; } Tcl_DeleteEvents(TesteventDeleteProc, objv[2]); break; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TesteventProc -- * * Delivers a test event to the Tcl interpreter as part of event * queue testing. * * Results: * Returns 1 if the event has been serviced, 0 otherwise. * * Side effects: * Evaluates the event's callback script, so has whatever side effects * the callback has. The return value of the callback script becomes the * return value of this function. If the callback script reports an * error, it is reported as a background error. * *---------------------------------------------------------------------- */ static int TesteventProc( Tcl_Event *event, /* Event to deliver */ int flags) /* Current flags for Tcl_ServiceEvent */ { TestEvent *ev = (TestEvent *) event; Tcl_Interp *interp = ev->interp; Tcl_Obj *command = ev->command; int result = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); int retval; if (result != TCL_OK) { Tcl_AddErrorInfo(interp, " (command bound to \"testevent\" callback)"); Tcl_BackgroundError(interp); return 1; /* Avoid looping on errors */ } if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp), &retval) != TCL_OK) { Tcl_AddErrorInfo(interp, " (return value from \"testevent\" callback)"); Tcl_BackgroundError(interp); return 1; } if (retval) { Tcl_DecrRefCount(ev->tag); Tcl_DecrRefCount(ev->command); } return retval; } /* *---------------------------------------------------------------------- * * TesteventDeleteProc -- * * Removes some set of events from the queue. * * This procedure is used as part of testing event queue management. * * Results: * Returns 1 if a given event should be deleted, 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TesteventDeleteProc( Tcl_Event *event, /* Event to examine */ ClientData clientData) /* Tcl_Obj containing the name of the event(s) * to remove */ { TestEvent *ev; /* Event to examine */ const char *evNameStr; Tcl_Obj *targetName; /* Name of the event(s) to delete */ const char *targetNameStr; if (event->proc != TesteventProc) { return 0; } targetName = (Tcl_Obj *) clientData; targetNameStr = (char *) Tcl_GetString(targetName); ev = (TestEvent *) event; evNameStr = Tcl_GetString(ev->tag); if (strcmp(evNameStr, targetNameStr) == 0) { Tcl_DecrRefCount(ev->tag); Tcl_DecrRefCount(ev->command); return 1; } else { return 0; } } /* *---------------------------------------------------------------------- * * TestexithandlerCmd -- * * This procedure implements the "testexithandler" command. It is * used to test Tcl_CreateExitHandler and Tcl_DeleteExitHandler. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestexithandlerCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int value; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " create|delete value\"", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) { return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { Tcl_CreateExitHandler((value & 1) ? ExitProcOdd : ExitProcEven, INT2PTR(value)); } else if (strcmp(argv[1], "delete") == 0) { Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven, INT2PTR(value)); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create or delete", NULL); return TCL_ERROR; } return TCL_OK; } static void ExitProcOdd( ClientData clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; int len; snprintf(buf, sizeof(buf), "odd %d\n", (int)PTR2INT(clientData)); len = strlen(buf); if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcOdd: unable to write to stdout"); } } static void ExitProcEven( ClientData clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; int len; snprintf(buf, sizeof(buf), "even %d\n", (int)PTR2INT(clientData)); len = strlen(buf); if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcEven: unable to write to stdout"); } } /* *---------------------------------------------------------------------- * * TestexprlongCmd -- * * This procedure verifies that Tcl_ExprLong does not modify the * interpreter result if there is no error. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestexprlongCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { long exprResult; char buf[4 + TCL_INTEGER_SPACE]; int result; if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " expression\"", NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprLong(interp, argv[1], &exprResult); if (result != TCL_OK) { return result; } snprintf(buf, sizeof(buf), ": %ld", exprResult); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestexprlongobjCmd -- * * This procedure verifies that Tcl_ExprLongObj does not modify the * interpreter result if there is no error. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestexprlongobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument objects. */ { long exprResult; char buf[4 + TCL_INTEGER_SPACE]; int result; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "expression"); return TCL_ERROR; } Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprLongObj(interp, objv[1], &exprResult); if (result != TCL_OK) { return result; } snprintf(buf, sizeof(buf), ": %ld", exprResult); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestexprdoubleCmd -- * * This procedure verifies that Tcl_ExprDouble does not modify the * interpreter result if there is no error. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestexprdoubleCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { double exprResult; char buf[4 + TCL_DOUBLE_SPACE]; int result; if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " expression\"", NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprDouble(interp, argv[1], &exprResult); if (result != TCL_OK) { return result; } strcpy(buf, ": "); Tcl_PrintDouble(interp, exprResult, buf+2); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestexprdoubleobjCmd -- * * This procedure verifies that Tcl_ExprLongObj does not modify the * interpreter result if there is no error. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestexprdoubleobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument objects. */ { double exprResult; char buf[4 + TCL_DOUBLE_SPACE]; int result; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "expression"); return TCL_ERROR; } Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult); if (result != TCL_OK) { return result; } strcpy(buf, ": "); Tcl_PrintDouble(interp, exprResult, buf+2); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestexprstringCmd -- * * This procedure tests the basic operation of Tcl_ExprString. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestexprstringCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " expression\"", NULL); return TCL_ERROR; } return Tcl_ExprString(interp, argv[1]); } /* *---------------------------------------------------------------------- * * TestfilelinkCmd -- * * This procedure implements the "testfilelink" command. It is used to * test the effects of creating and manipulating filesystem links in Tcl. * * Results: * A standard Tcl result. * * Side effects: * May create a link on disk. * *---------------------------------------------------------------------- */ static int TestfilelinkCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Obj *contents; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "source ?target?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { /* Create link from source to target */ contents = Tcl_FSLink(objv[1], objv[2], TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK); if (contents == NULL) { Tcl_AppendResult(interp, "could not create link from \"", Tcl_GetString(objv[1]), "\" to \"", Tcl_GetString(objv[2]), "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } } else { /* Read link */ contents = Tcl_FSLink(objv[1], NULL, 0); if (contents == NULL) { Tcl_AppendResult(interp, "could not read link \"", Tcl_GetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } } Tcl_SetObjResult(interp, contents); if (objc == 2) { /* * If we are creating a link, this will actually just * be objv[3], and we don't own it */ Tcl_DecrRefCount(contents); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestgetassocdataCmd -- * * This procedure implements the "testgetassocdata" command. It is * used to test Tcl_GetAssocData. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestgetassocdataCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { char *res; if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " data_key\"", NULL); return TCL_ERROR; } res = (char *) Tcl_GetAssocData(interp, argv[1], NULL); if (res != NULL) { Tcl_AppendResult(interp, res, NULL); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestgetplatformCmd -- * * This procedure implements the "testgetplatform" command. It is * used to retrieve the value of the tclPlatform global variable. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestgetplatformCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { static const char *const platformStrings[] = { "unix", "mac", "windows" }; TclPlatformType *platform; platform = TclGetPlatform(); if (argc != 1) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], NULL); return TCL_ERROR; } Tcl_AppendResult(interp, platformStrings[*platform], NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestinterpdeleteCmd -- * * This procedure tests the code in tclInterp.c that deals with * interpreter deletion. It deletes a user-specified interpreter * from the hierarchy, and subsequent code checks integrity. * * Results: * A standard Tcl result. * * Side effects: * Deletes one or more interpreters. * *---------------------------------------------------------------------- */ static int TestinterpdeleteCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Interp *childToDelete; if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " path\"", NULL); return TCL_ERROR; } childToDelete = Tcl_GetChild(interp, argv[1]); if (childToDelete == NULL) { return TCL_ERROR; } Tcl_DeleteInterp(childToDelete); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestlinkCmd -- * * This procedure implements the "testlink" command. It is used * to test Tcl_LinkVar and related library procedures. * * Results: * A standard Tcl result. * * Side effects: * Creates and deletes various variable links, plus returns * values of the linked variables. * *---------------------------------------------------------------------- */ static int TestlinkCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { static int intVar = 43; static int boolVar = 4; static double realVar = 1.23; static Tcl_WideInt wideVar = 79; static char *stringVar = NULL; static char charVar = '@'; static unsigned char ucharVar = 130; static short shortVar = 3000; static unsigned short ushortVar = 60000; static unsigned int uintVar = 0xBEEFFEED; static long longVar = 123456789L; static unsigned long ulongVar = 3456789012UL; static float floatVar = 4.5; static Tcl_WideUInt uwideVar = 123; static int created = 0; char buffer[2*TCL_DOUBLE_SPACE]; int writable, flag; Tcl_Obj *tmp; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option ?arg arg arg arg arg arg arg arg arg arg arg arg" " arg arg?\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { if (argc != 16) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " intRO realRO boolRO stringRO wideRO charRO ucharRO shortRO" " ushortRO uintRO longRO ulongRO floatRO uwideRO\"", NULL); return TCL_ERROR; } if (created) { Tcl_UnlinkVar(interp, "int"); Tcl_UnlinkVar(interp, "real"); Tcl_UnlinkVar(interp, "bool"); Tcl_UnlinkVar(interp, "string"); Tcl_UnlinkVar(interp, "wide"); Tcl_UnlinkVar(interp, "char"); Tcl_UnlinkVar(interp, "uchar"); Tcl_UnlinkVar(interp, "short"); Tcl_UnlinkVar(interp, "ushort"); Tcl_UnlinkVar(interp, "uint"); Tcl_UnlinkVar(interp, "long"); Tcl_UnlinkVar(interp, "ulong"); Tcl_UnlinkVar(interp, "float"); Tcl_UnlinkVar(interp, "uwide"); } created = 1; if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "int", (char *)&intVar, TCL_LINK_INT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[3], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "real", (char *)&realVar, TCL_LINK_DOUBLE | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[4], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "bool", (char *)&boolVar, TCL_LINK_BOOLEAN | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[5], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "string", (char *)&stringVar, TCL_LINK_STRING | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[6], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "wide", (char *)&wideVar, TCL_LINK_WIDE_INT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[7], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "char", (char *)&charVar, TCL_LINK_CHAR | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[8], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "uchar", (char *)&ucharVar, TCL_LINK_UCHAR | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[9], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "short", (char *)&shortVar, TCL_LINK_SHORT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[10], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "ushort", (char *)&ushortVar, TCL_LINK_USHORT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[11], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "uint", (char *)&uintVar, TCL_LINK_UINT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[12], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "long", (char *)&longVar, TCL_LINK_LONG | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[13], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "ulong", (char *)&ulongVar, TCL_LINK_ULONG | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[14], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "float", (char *)&floatVar, TCL_LINK_FLOAT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[15], &writable) != TCL_OK) { return TCL_ERROR; } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "uwide", (char *)&uwideVar, TCL_LINK_WIDE_UINT | flag) != TCL_OK) { return TCL_ERROR; } } else if (strcmp(argv[1], "delete") == 0) { Tcl_UnlinkVar(interp, "int"); Tcl_UnlinkVar(interp, "real"); Tcl_UnlinkVar(interp, "bool"); Tcl_UnlinkVar(interp, "string"); Tcl_UnlinkVar(interp, "wide"); Tcl_UnlinkVar(interp, "char"); Tcl_UnlinkVar(interp, "uchar"); Tcl_UnlinkVar(interp, "short"); Tcl_UnlinkVar(interp, "ushort"); Tcl_UnlinkVar(interp, "uint"); Tcl_UnlinkVar(interp, "long"); Tcl_UnlinkVar(interp, "ulong"); Tcl_UnlinkVar(interp, "float"); Tcl_UnlinkVar(interp, "uwide"); created = 0; } else if (strcmp(argv[1], "get") == 0) { TclFormatInt(buffer, intVar); Tcl_AppendElement(interp, buffer); Tcl_PrintDouble(NULL, realVar, buffer); Tcl_AppendElement(interp, buffer); TclFormatInt(buffer, boolVar); Tcl_AppendElement(interp, buffer); Tcl_AppendElement(interp, (stringVar == NULL) ? "-" : stringVar); /* * Wide ints only have an object-based interface. */ tmp = Tcl_NewWideIntObj(wideVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); TclFormatInt(buffer, (int) charVar); Tcl_AppendElement(interp, buffer); TclFormatInt(buffer, (int) ucharVar); Tcl_AppendElement(interp, buffer); TclFormatInt(buffer, (int) shortVar); Tcl_AppendElement(interp, buffer); TclFormatInt(buffer, (int) ushortVar); Tcl_AppendElement(interp, buffer); TclFormatInt(buffer, (int) uintVar); Tcl_AppendElement(interp, buffer); tmp = Tcl_NewLongObj(longVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); tmp = Tcl_NewLongObj((long)ulongVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); Tcl_PrintDouble(NULL, (double)floatVar, buffer); Tcl_AppendElement(interp, buffer); tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); } else if (strcmp(argv[1], "set") == 0) { int v; if (argc != 16) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " intValue realValue boolValue stringValue wideValue" " charValue ucharValue shortValue ushortValue uintValue" " longValue ulongValue floatValue uwideValue\"", NULL); return TCL_ERROR; } if (argv[2][0] != 0) { if (Tcl_GetInt(interp, argv[2], &intVar) != TCL_OK) { return TCL_ERROR; } } if (argv[3][0] != 0) { if (Tcl_GetDouble(interp, argv[3], &realVar) != TCL_OK) { return TCL_ERROR; } } if (argv[4][0] != 0) { if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) { return TCL_ERROR; } } if (argv[5][0] != 0) { if (stringVar != NULL) { ckfree(stringVar); } if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { stringVar = (char *)ckalloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } } if (argv[6][0] != 0) { tmp = Tcl_NewStringObj(argv[6], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } Tcl_DecrRefCount(tmp); } if (argv[7][0]) { if (Tcl_GetInt(interp, argv[7], &v) != TCL_OK) { return TCL_ERROR; } charVar = (char) v; } if (argv[8][0]) { if (Tcl_GetInt(interp, argv[8], &v) != TCL_OK) { return TCL_ERROR; } ucharVar = (unsigned char) v; } if (argv[9][0]) { if (Tcl_GetInt(interp, argv[9], &v) != TCL_OK) { return TCL_ERROR; } shortVar = (short) v; } if (argv[10][0]) { if (Tcl_GetInt(interp, argv[10], &v) != TCL_OK) { return TCL_ERROR; } ushortVar = (unsigned short) v; } if (argv[11][0]) { if (Tcl_GetInt(interp, argv[11], &v) != TCL_OK) { return TCL_ERROR; } uintVar = (unsigned int) v; } if (argv[12][0]) { if (Tcl_GetInt(interp, argv[12], &v) != TCL_OK) { return TCL_ERROR; } longVar = (long) v; } if (argv[13][0]) { if (Tcl_GetInt(interp, argv[13], &v) != TCL_OK) { return TCL_ERROR; } ulongVar = (unsigned long) v; } if (argv[14][0]) { double d; if (Tcl_GetDouble(interp, argv[14], &d) != TCL_OK) { return TCL_ERROR; } floatVar = (float) d; } if (argv[15][0]) { Tcl_WideInt w; tmp = Tcl_NewStringObj(argv[15], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } Tcl_DecrRefCount(tmp); uwideVar = (Tcl_WideUInt) w; } } else if (strcmp(argv[1], "update") == 0) { int v; if (argc != 16) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " intValue realValue boolValue stringValue wideValue" " charValue ucharValue shortValue ushortValue uintValue" " longValue ulongValue floatValue uwideValue\"", NULL); return TCL_ERROR; } if (argv[2][0] != 0) { if (Tcl_GetInt(interp, argv[2], &intVar) != TCL_OK) { return TCL_ERROR; } Tcl_UpdateLinkedVar(interp, "int"); } if (argv[3][0] != 0) { if (Tcl_GetDouble(interp, argv[3], &realVar) != TCL_OK) { return TCL_ERROR; } Tcl_UpdateLinkedVar(interp, "real"); } if (argv[4][0] != 0) { if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) { return TCL_ERROR; } Tcl_UpdateLinkedVar(interp, "bool"); } if (argv[5][0] != 0) { if (stringVar != NULL) { ckfree(stringVar); } if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { stringVar = (char *)ckalloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } Tcl_UpdateLinkedVar(interp, "string"); } if (argv[6][0] != 0) { tmp = Tcl_NewStringObj(argv[6], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } Tcl_DecrRefCount(tmp); Tcl_UpdateLinkedVar(interp, "wide"); } if (argv[7][0]) { if (Tcl_GetInt(interp, argv[7], &v) != TCL_OK) { return TCL_ERROR; } charVar = (char) v; Tcl_UpdateLinkedVar(interp, "char"); } if (argv[8][0]) { if (Tcl_GetInt(interp, argv[8], &v) != TCL_OK) { return TCL_ERROR; } ucharVar = (unsigned char) v; Tcl_UpdateLinkedVar(interp, "uchar"); } if (argv[9][0]) { if (Tcl_GetInt(interp, argv[9], &v) != TCL_OK) { return TCL_ERROR; } shortVar = (short) v; Tcl_UpdateLinkedVar(interp, "short"); } if (argv[10][0]) { if (Tcl_GetInt(interp, argv[10], &v) != TCL_OK) { return TCL_ERROR; } ushortVar = (unsigned short) v; Tcl_UpdateLinkedVar(interp, "ushort"); } if (argv[11][0]) { if (Tcl_GetInt(interp, argv[11], &v) != TCL_OK) { return TCL_ERROR; } uintVar = (unsigned int) v; Tcl_UpdateLinkedVar(interp, "uint"); } if (argv[12][0]) { if (Tcl_GetInt(interp, argv[12], &v) != TCL_OK) { return TCL_ERROR; } longVar = (long) v; Tcl_UpdateLinkedVar(interp, "long"); } if (argv[13][0]) { if (Tcl_GetInt(interp, argv[13], &v) != TCL_OK) { return TCL_ERROR; } ulongVar = (unsigned long) v; Tcl_UpdateLinkedVar(interp, "ulong"); } if (argv[14][0]) { double d; if (Tcl_GetDouble(interp, argv[14], &d) != TCL_OK) { return TCL_ERROR; } floatVar = (float) d; Tcl_UpdateLinkedVar(interp, "float"); } if (argv[15][0]) { Tcl_WideInt w; tmp = Tcl_NewStringObj(argv[15], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } Tcl_DecrRefCount(tmp); uwideVar = (Tcl_WideUInt) w; Tcl_UpdateLinkedVar(interp, "uwide"); } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": should be create, delete, get, set, or update", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestlocaleCmd -- * * This procedure implements the "testlocale" command. It is used * to test the effects of setting different locales in Tcl. * * Results: * A standard Tcl result. * * Side effects: * Modifies the current C locale. * *---------------------------------------------------------------------- */ static int TestlocaleCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int index; const char *locale; static const char *const optionStrings[] = { "ctype", "numeric", "time", "collate", "monetary", "all", NULL }; static const int lcTypes[] = { LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY, LC_ALL }; /* * LC_CTYPE, etc. correspond to the indices for the strings. */ if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { locale = Tcl_GetString(objv[2]); } else { locale = NULL; } locale = setlocale(lcTypes[index], locale); if (locale) { Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestMathFunc -- * * This is a user-defined math procedure to test out math procedures * with no arguments. * * Results: * A normal Tcl completion code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestMathFunc( ClientData clientData, /* Integer value to return. */ Tcl_Interp *interp, /* Not used. */ Tcl_Value *args, /* Not used. */ Tcl_Value *resultPtr) /* Where to store result. */ { resultPtr->type = TCL_INT; resultPtr->intValue = PTR2INT(clientData); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestMathFunc2 -- * * This is a user-defined math procedure to test out math procedures * that do have arguments, in this case 2. * * Results: * A normal Tcl completion code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestMathFunc2( ClientData clientData, /* Integer value to return. */ Tcl_Interp *interp, /* Used to report errors. */ Tcl_Value *args, /* Points to an array of two Tcl_Value structs * for the two arguments. */ Tcl_Value *resultPtr) /* Where to store the result. */ { int result = TCL_OK; /* * Return the maximum of the two arguments with the correct type. */ if (args[0].type == TCL_INT) { int i0 = args[0].intValue; if (args[1].type == TCL_INT) { int i1 = args[1].intValue; resultPtr->type = TCL_INT; resultPtr->intValue = ((i0 > i1)? i0 : i1); } else if (args[1].type == TCL_DOUBLE) { double d0 = i0; double d1 = args[1].doubleValue; resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); } else if (args[1].type == TCL_WIDE_INT) { Tcl_WideInt w0 = Tcl_LongAsWide(i0); Tcl_WideInt w1 = args[1].wideValue; resultPtr->type = TCL_WIDE_INT; resultPtr->wideValue = ((w0 > w1)? w0 : w1); } else { Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); result = TCL_ERROR; } } else if (args[0].type == TCL_DOUBLE) { double d0 = args[0].doubleValue; if (args[1].type == TCL_INT) { double d1 = args[1].intValue; resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); } else if (args[1].type == TCL_DOUBLE) { double d1 = args[1].doubleValue; resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); } else if (args[1].type == TCL_WIDE_INT) { double d1 = Tcl_WideAsDouble(args[1].wideValue); resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); } else { Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); result = TCL_ERROR; } } else if (args[0].type == TCL_WIDE_INT) { Tcl_WideInt w0 = args[0].wideValue; if (args[1].type == TCL_INT) { Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue); resultPtr->type = TCL_WIDE_INT; resultPtr->wideValue = ((w0 > w1)? w0 : w1); } else if (args[1].type == TCL_DOUBLE) { double d0 = Tcl_WideAsDouble(w0); double d1 = args[1].doubleValue; resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); } else if (args[1].type == TCL_WIDE_INT) { Tcl_WideInt w1 = args[1].wideValue; resultPtr->type = TCL_WIDE_INT; resultPtr->wideValue = ((w0 > w1)? w0 : w1); } else { Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); result = TCL_ERROR; } } else { Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC); result = TCL_ERROR; } return result; } /* *---------------------------------------------------------------------- * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean * up any data left over from running the testsetassocdata command. * * Results: * None. * * Side effects: * Releases storage. * *---------------------------------------------------------------------- */ static void CleanupTestSetassocdataTests( ClientData clientData, /* Data to be released. */ Tcl_Interp *interp) /* Interpreter being deleted. */ { ckfree(clientData); } /* *---------------------------------------------------------------------- * * TestparserObjCmd -- * * This procedure implements the "testparser" command. It is * used for testing the new Tcl script parser in Tcl 8.1. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestparserObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; int length, dummy; Tcl_Parse parse; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "script length"); return TCL_ERROR; } script = Tcl_GetStringFromObj(objv[1], &dummy); if (Tcl_GetIntFromObj(interp, objv[2], &length)) { return TCL_ERROR; } if (length == 0) { length = dummy; } if (Tcl_ParseCommand(interp, script, length, 0, &parse) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (remainder of script: \""); Tcl_AddErrorInfo(interp, parse.term); Tcl_AddErrorInfo(interp, "\")"); return TCL_ERROR; } /* * The parse completed successfully. Just print out the contents * of the parse structure into the interpreter's result. */ PrintParse(interp, &parse); Tcl_FreeParse(&parse); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestexprparserObjCmd -- * * This procedure implements the "testexprparser" command. It is * used for testing the new Tcl expression parser in Tcl 8.1. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestexprparserObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; int length, dummy; Tcl_Parse parse; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "expr length"); return TCL_ERROR; } script = Tcl_GetStringFromObj(objv[1], &dummy); if (Tcl_GetIntFromObj(interp, objv[2], &length)) { return TCL_ERROR; } if (length == 0) { length = dummy; } parse.commentStart = NULL; parse.commentSize = 0; parse.commandStart = NULL; parse.commandSize = 0; if (Tcl_ParseExpr(interp, script, length, &parse) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (remainder of expr: \""); Tcl_AddErrorInfo(interp, parse.term); Tcl_AddErrorInfo(interp, "\")"); return TCL_ERROR; } /* * The parse completed successfully. Just print out the contents * of the parse structure into the interpreter's result. */ PrintParse(interp, &parse); Tcl_FreeParse(&parse); return TCL_OK; } /* *---------------------------------------------------------------------- * * PrintParse -- * * This procedure prints out the contents of a Tcl_Parse structure * in the result of an interpreter. * * Results: * Interp's result is set to a prettily formatted version of the * contents of parsePtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PrintParse( Tcl_Interp *interp, /* Interpreter whose result is to be set to * the contents of a parse structure. */ Tcl_Parse *parsePtr) /* Parse structure to print out. */ { Tcl_Obj *objPtr; const char *typeString; Tcl_Token *tokenPtr; int i; objPtr = Tcl_GetObjResult(interp); if (parsePtr->commentSize > 0) { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(parsePtr->commentStart, parsePtr->commentSize)); } else { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1)); } Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(parsePtr->numWords)); for (i = 0; i < parsePtr->numTokens; i++) { tokenPtr = &parsePtr->tokenPtr[i]; switch (tokenPtr->type) { case TCL_TOKEN_EXPAND_WORD: typeString = "expand"; break; case TCL_TOKEN_WORD: typeString = "word"; break; case TCL_TOKEN_SIMPLE_WORD: typeString = "simple"; break; case TCL_TOKEN_TEXT: typeString = "text"; break; case TCL_TOKEN_BS: typeString = "backslash"; break; case TCL_TOKEN_COMMAND: typeString = "command"; break; case TCL_TOKEN_VARIABLE: typeString = "variable"; break; case TCL_TOKEN_SUB_EXPR: typeString = "subexpr"; break; case TCL_TOKEN_OPERATOR: typeString = "operator"; break; default: typeString = "??"; break; } Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(typeString, -1)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(tokenPtr->start, tokenPtr->size)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(tokenPtr->numComponents)); } Tcl_ListObjAppendElement(NULL, objPtr, parsePtr->commandStart ? Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize, -1) : Tcl_NewObj()); } /* *---------------------------------------------------------------------- * * TestparsevarObjCmd -- * * This procedure implements the "testparsevar" command. It is * used for testing Tcl_ParseVar. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestparsevarObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *value, *name, *termPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName"); return TCL_ERROR; } name = Tcl_GetString(objv[1]); value = Tcl_ParseVar(interp, name, &termPtr); if (value == NULL) { return TCL_ERROR; } Tcl_AppendElement(interp, value); Tcl_AppendElement(interp, termPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestparsevarnameObjCmd -- * * This procedure implements the "testparsevarname" command. It is * used for testing the new Tcl script parser in Tcl 8.1. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestparsevarnameObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; int append, length, dummy; Tcl_Parse parse; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "script length append"); return TCL_ERROR; } script = Tcl_GetStringFromObj(objv[1], &dummy); if (Tcl_GetIntFromObj(interp, objv[2], &length)) { return TCL_ERROR; } if (length == 0) { length = dummy; } if (Tcl_GetIntFromObj(interp, objv[3], &append)) { return TCL_ERROR; } if (Tcl_ParseVarName(interp, script, length, &parse, append) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (remainder of script: \""); Tcl_AddErrorInfo(interp, parse.term); Tcl_AddErrorInfo(interp, "\")"); return TCL_ERROR; } /* * The parse completed successfully. Just print out the contents * of the parse structure into the interpreter's result. */ parse.commentSize = 0; parse.commandStart = script + parse.tokenPtr->size; parse.commandSize = 0; PrintParse(interp, &parse); Tcl_FreeParse(&parse); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestprintObjCmd -- * * This procedure implements the "testprint" command. It is * used for being able to test the Tcl_ObjPrintf() function. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestprintObjCmd( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_WideInt argv1 = 0; long argv2; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "format longint"); return TCL_OK; } Tcl_GetWideIntFromObj(interp, objv[2], &argv1); argv2 = (long)argv1; Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv2, argv2, argv2, argv2)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestregexpObjCmd -- * * This procedure implements the "testregexp" command. It is used to give * a direct interface for regexp flags. It's identical to * Tcl_RegexpObjCmd except for the -xflags option, and the consequences * thereof (including the REG_EXPECT kludge). * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int TestregexpObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, ii, indices, stringLength, match, about; int hasxflags, cflags, eflags; Tcl_RegExp regExpr; const char *string; Tcl_Obj *objPtr; Tcl_RegExpInfo info; static const char *const options[] = { "-indices", "-nocase", "-about", "-expanded", "-line", "-linestop", "-lineanchor", "-xflags", "--", NULL }; enum optionsEnum { REGEXP_INDICES, REGEXP_NOCASE, REGEXP_ABOUT, REGEXP_EXPANDED, REGEXP_MULTI, REGEXP_NOCROSS, REGEXP_NEWL, REGEXP_XFLAGS, REGEXP_LAST }; indices = 0; about = 0; cflags = REG_ADVANCED; eflags = 0; hasxflags = 0; for (i = 1; i < objc; i++) { const char *name; int index; name = Tcl_GetString(objv[i]); if (name[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum optionsEnum) index) { case REGEXP_INDICES: indices = 1; break; case REGEXP_NOCASE: cflags |= REG_ICASE; break; case REGEXP_ABOUT: about = 1; break; case REGEXP_EXPANDED: cflags |= REG_EXPANDED; break; case REGEXP_MULTI: cflags |= REG_NEWLINE; break; case REGEXP_NOCROSS: cflags |= REG_NLSTOP; break; case REGEXP_NEWL: cflags |= REG_NLANCH; break; case REGEXP_XFLAGS: hasxflags = 1; break; case REGEXP_LAST: i++; goto endOfForLoop; } } endOfForLoop: if (objc - i < hasxflags + 2 - about) { Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? exp string ?matchVar? ?subMatchVar ...?"); return TCL_ERROR; } objc -= i; objv += i; if (hasxflags) { string = Tcl_GetStringFromObj(objv[0], &stringLength); TestregexpXflags(string, stringLength, &cflags, &eflags); objc--; objv++; } regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; } if (about) { if (TclRegAbout(interp, regExpr) < 0) { return TCL_ERROR; } return TCL_OK; } objPtr = objv[1]; match = Tcl_RegExpExecObj(interp, regExpr, objPtr, 0 /* offset */, objc-2 /* nmatches */, eflags); if (match < 0) { return TCL_ERROR; } if (match == 0) { /* * Set the interpreter's object result to an integer object w/ * value 0. */ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { const char *varName; const char *value; int start, end; char resinfo[TCL_INTEGER_SPACE * 2]; varName = Tcl_GetString(objv[2]); TclRegExpRangeUniChar(regExpr, -1, &start, &end); snprintf(resinfo, sizeof(resinfo), "%d %d", start, end-1); value = Tcl_SetVar(interp, varName, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); return TCL_ERROR; } } else if (cflags & TCL_REG_CANMATCH) { const char *varName; const char *value; char resinfo[TCL_INTEGER_SPACE * 2]; Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); snprintf(resinfo, sizeof(resinfo), "%ld", info.extendStart); value = Tcl_SetVar(interp, varName, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); return TCL_ERROR; } } return TCL_OK; } /* * If additional variable names have been specified, return * index information in those variables. */ objc -= 2; objv += 2; Tcl_RegExpGetInfo(regExpr, &info); for (i = 0; i < objc; i++) { int start, end; Tcl_Obj *newPtr, *varPtr, *valuePtr; varPtr = objv[i]; ii = ((cflags®_EXPECT) && i == objc-1) ? -1 : i; if (indices) { Tcl_Obj *objs[2]; if (ii == -1) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); } else if (ii > info.nsubs) { start = -1; end = -1; } else { start = info.matches[ii].start; end = info.matches[ii].end; } /* * Adjust index so it refers to the last character in the match * instead of the first character after the match. */ if (end >= 0) { end--; } objs[0] = Tcl_NewLongObj(start); objs[1] = Tcl_NewLongObj(end); newPtr = Tcl_NewListObj(2, objs); } else { if (ii == -1) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); newPtr = Tcl_GetRange(objPtr, start, end); } else if (ii > info.nsubs || info.matches[ii].end <= 0) { newPtr = Tcl_NewObj(); } else { newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, info.matches[ii].end - 1); } } valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG); if (valuePtr == NULL) { return TCL_ERROR; } } /* * Set the interpreter's object result to an integer object w/ value 1. */ Tcl_SetIntObj(Tcl_GetObjResult(interp), 1); return TCL_OK; } /* *--------------------------------------------------------------------------- * * TestregexpXflags -- * * Parse a string of extended regexp flag letters, for testing. * * Results: * No return value (you're on your own for errors here). * * Side effects: * Modifies *cflagsPtr, a regcomp flags word, and *eflagsPtr, a * regexec flags word, as appropriate. * *---------------------------------------------------------------------- */ static void TestregexpXflags( const char *string, /* The string of flags. */ int length, /* The length of the string in bytes. */ int *cflagsPtr, /* compile flags word */ int *eflagsPtr) /* exec flags word */ { int i, cflags, eflags; cflags = *cflagsPtr; eflags = *eflagsPtr; for (i = 0; i < length; i++) { switch (string[i]) { case 'a': cflags |= REG_ADVF; break; case 'b': cflags &= ~REG_ADVANCED; break; case 'c': cflags |= TCL_REG_CANMATCH; break; case 'e': cflags &= ~REG_ADVANCED; cflags |= REG_EXTENDED; break; case 'q': cflags &= ~REG_ADVANCED; cflags |= REG_QUOTE; break; case 'o': /* o for opaque */ cflags |= REG_NOSUB; break; case 's': /* s for start */ cflags |= REG_BOSONLY; break; case '+': cflags |= REG_FAKE; break; case ',': cflags |= REG_PROGRESS; break; case '.': cflags |= REG_DUMP; break; case ':': eflags |= REG_MTRACE; break; case ';': eflags |= REG_FTRACE; break; case '^': eflags |= REG_NOTBOL; break; case '$': eflags |= REG_NOTEOL; break; case 't': cflags |= REG_EXPECT; break; case '%': eflags |= REG_SMALL; break; } } *cflagsPtr = cflags; *eflagsPtr = eflags; } /* *---------------------------------------------------------------------- * * TestreturnObjCmd -- * * This procedure implements the "testreturn" command. It is * used to verify that a * return TCL_RETURN; * has same behavior as * return Tcl_SetReturnOptions(interp, Tcl_NewObj()); * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int TestreturnObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return TCL_RETURN; } /* *---------------------------------------------------------------------- * * TestsetassocdataCmd -- * * This procedure implements the "testsetassocdata" command. It is used * to test Tcl_SetAssocData. * * Results: * A standard Tcl result. * * Side effects: * Modifies or creates an association between a key and associated * data for this interpreter. * *---------------------------------------------------------------------- */ static int TestsetassocdataCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { char *buf, *oldData; Tcl_InterpDeleteProc *procPtr; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " data_key data_item\"", NULL); return TCL_ERROR; } buf = (char *)ckalloc(strlen(argv[2]) + 1); strcpy(buf, argv[2]); /* * If we previously associated a malloced value with the variable, * free it before associating a new value. */ oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr); if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) { ckfree(oldData); } Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, buf); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestsetplatformCmd -- * * This procedure implements the "testsetplatform" command. It is * used to change the tclPlatform global variable so all file * name conversions can be tested on a single platform. * * Results: * A standard Tcl result. * * Side effects: * Sets the tclPlatform global variable. * *---------------------------------------------------------------------- */ static int TestsetplatformCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { size_t length; TclPlatformType *platform; platform = TclGetPlatform(); if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " platform\"", NULL); return TCL_ERROR; } length = strlen(argv[1]); if (strncmp(argv[1], "unix", length) == 0) { *platform = TCL_PLATFORM_UNIX; } else if (strncmp(argv[1], "windows", length) == 0) { *platform = TCL_PLATFORM_WINDOWS; } else { Tcl_AppendResult(interp, "unsupported platform: should be one of " "unix, or windows", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TeststaticpkgCmd -- * * This procedure implements the "teststaticpkg" command. * It is used to test the procedure Tcl_StaticPackage. * * Results: * A standard Tcl result. * * Side effects: * When the package given by argv[1] is loaded into an interpreter, * variable "x" in that interpreter is set to "loaded". * *---------------------------------------------------------------------- */ static int TeststaticpkgCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int safe, loaded; if (argc != 4) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " prefix safe loaded\"", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) { return TCL_ERROR; } tclStubsPtr->tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc, (safe) ? StaticInitProc : NULL); return TCL_OK; } static int StaticInitProc( Tcl_Interp *interp) /* Interpreter in which package is supposedly * being loaded. */ { Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY); return TCL_OK; } /* *---------------------------------------------------------------------- * * TesttranslatefilenameCmd -- * * This procedure implements the "testtranslatefilename" command. * It is used to test the Tcl_TranslateFileName command. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TesttranslatefilenameCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_DString buffer; const char *result; if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " path\"", NULL); return TCL_ERROR; } result = Tcl_TranslateFileName(interp, argv[1], &buffer); if (result == NULL) { return TCL_ERROR; } Tcl_AppendResult(interp, result, NULL); Tcl_DStringFree(&buffer); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestupvarCmd -- * * This procedure implements the "testupvar" command. It is used * to test Tcl_UpVar and Tcl_UpVar2. * * Results: * A standard Tcl result. * * Side effects: * Creates or modifies an "upvar" reference. * *---------------------------------------------------------------------- */ static int TestupvarCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = 0; if ((argc != 5) && (argc != 6)) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " level name ?name2? dest global\"", NULL); return TCL_ERROR; } if (argc == 5) { if (strcmp(argv[4], "global") == 0) { flags = TCL_GLOBAL_ONLY; } else if (strcmp(argv[4], "namespace") == 0) { flags = TCL_NAMESPACE_ONLY; } return Tcl_UpVar(interp, argv[1], argv[2], argv[3], flags); } else { if (strcmp(argv[5], "global") == 0) { flags = TCL_GLOBAL_ONLY; } else if (strcmp(argv[5], "namespace") == 0) { flags = TCL_NAMESPACE_ONLY; } return Tcl_UpVar2(interp, argv[1], argv[2], (argv[3][0] == 0) ? NULL : argv[3], argv[4], flags); } } /* *---------------------------------------------------------------------- * * TestseterrorcodeCmd -- * * This procedure implements the "testseterrorcodeCmd". This tests up to * five elements passed to the Tcl_SetErrorCode command. * * Results: * A standard Tcl result. Always returns TCL_ERROR so that * the error code can be tested. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestseterrorcodeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc > 6) { Tcl_AppendResult(interp, "too many args", NULL); return TCL_ERROR; } switch (argc) { case 1: Tcl_SetErrorCode(interp, "NONE", NULL); break; case 2: Tcl_SetErrorCode(interp, argv[1], NULL); break; case 3: Tcl_SetErrorCode(interp, argv[1], argv[2], NULL); break; case 4: Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL); break; case 5: Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL); break; case 6: Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], argv[5], NULL); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TestsetobjerrorcodeCmd -- * * This procedure implements the "testsetobjerrorcodeCmd". * This tests the Tcl_SetObjErrorCode function. * * Results: * A standard Tcl result. Always returns TCL_ERROR so that * the error code can be tested. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestsetobjerrorcodeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1)); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TestfeventCmd -- * * This procedure implements the "testfevent" command. It is * used for testing the "fileevent" command. * * Results: * A standard Tcl result. * * Side effects: * Creates and deletes interpreters. * *---------------------------------------------------------------------- */ static int TestfeventCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { static Tcl_Interp *interp2 = NULL; int code; Tcl_Channel chan; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option ?arg ...?", NULL); return TCL_ERROR; } if (strcmp(argv[1], "cmd") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " cmd script", NULL); return TCL_ERROR; } if (interp2 != NULL) { code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL); Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2)); return code; } else { Tcl_AppendResult(interp, "called \"testfevent code\" before \"testfevent create\"", NULL); return TCL_ERROR; } } else if (strcmp(argv[1], "create") == 0) { if (interp2 != NULL) { Tcl_DeleteInterp(interp2); } interp2 = Tcl_CreateInterp(); return Tcl_Init(interp2); } else if (strcmp(argv[1], "delete") == 0) { if (interp2 != NULL) { Tcl_DeleteInterp(interp2); } interp2 = NULL; } else if (strcmp(argv[1], "share") == 0) { if (interp2 != NULL) { chan = Tcl_GetChannel(interp, argv[2], NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } Tcl_RegisterChannel(interp2, chan); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestpanicCmd -- * * Calls the panic routine. * * Results: * Always returns TCL_OK. * * Side effects: * May exit application. * *---------------------------------------------------------------------- */ static int TestpanicCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { char *argString; /* * Put the arguments into a var args structure * Append all of the arguments together separated by spaces */ argString = Tcl_Merge(argc-1, argv+1); Tcl_Panic("%s", argString); ckfree(argString); return TCL_OK; } static int TestfileCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ Tcl_Obj *const argv[]) /* The argument objects. */ { int force, i, j, result; Tcl_Obj *error = NULL; const char *subcmd; if (argc < 3) { return TCL_ERROR; } force = 0; i = 2; if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) { force = 1; i = 3; } if (argc - i > 2) { return TCL_ERROR; } for (j = i; j < argc; j++) { if (Tcl_FSGetNormalizedPath(interp, argv[j]) == NULL) { return TCL_ERROR; } } subcmd = Tcl_GetString(argv[1]); if (strcmp(subcmd, "mv") == 0) { result = TclpObjRenameFile(argv[i], argv[i + 1]); } else if (strcmp(subcmd, "cp") == 0) { result = TclpObjCopyFile(argv[i], argv[i + 1]); } else if (strcmp(subcmd, "rm") == 0) { result = TclpObjDeleteFile(argv[i]); } else if (strcmp(subcmd, "mkdir") == 0) { result = TclpObjCreateDirectory(argv[i]); } else if (strcmp(subcmd, "cpdir") == 0) { result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error); } else if (strcmp(subcmd, "rmdir") == 0) { result = TclpObjRemoveDirectory(argv[i], force, &error); } else { result = TCL_ERROR; goto end; } if (result != TCL_OK) { if (error != NULL) { if (Tcl_GetString(error)[0] != '\0') { Tcl_AppendResult(interp, Tcl_GetString(error), " ", NULL); } Tcl_DecrRefCount(error); } Tcl_AppendResult(interp, Tcl_ErrnoId(), NULL); } end: return result; } /* *---------------------------------------------------------------------- * * TestgetvarfullnameCmd -- * * Implements the "testgetvarfullname" cmd that is used when testing * the Tcl_GetVariableFullName procedure. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestgetvarfullnameCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *name, *arg; int flags = 0; Tcl_Namespace *namespacePtr; Tcl_CallFrame *framePtr; Tcl_Var variable; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "name scope"); return TCL_ERROR; } name = Tcl_GetString(objv[1]); arg = Tcl_GetString(objv[2]); if (strcmp(arg, "global") == 0) { flags = TCL_GLOBAL_ONLY; } else if (strcmp(arg, "namespace") == 0) { flags = TCL_NAMESPACE_ONLY; } /* * This command, like any other created with Tcl_Create[Obj]Command, runs * in the global namespace. As a "namespace-aware" command that needs to * run in a particular namespace, it must activate that namespace itself. */ if (flags == TCL_NAMESPACE_ONLY) { namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var", NULL, TCL_LEAVE_ERR_MSG); if (namespacePtr == NULL) { return TCL_ERROR; } (void) TclPushStackFrame(interp, &framePtr, namespacePtr, /*isProcCallFrame*/ 0); } variable = Tcl_FindNamespaceVar(interp, name, NULL, (flags | TCL_LEAVE_ERR_MSG)); if (flags == TCL_NAMESPACE_ONLY) { TclPopStackFrame(interp); } if (variable == (Tcl_Var) NULL) { return TCL_ERROR; } Tcl_GetVariableFullName(interp, variable, Tcl_GetObjResult(interp)); return TCL_OK; } /* *---------------------------------------------------------------------- * * GetTimesObjCmd -- * * This procedure implements the "gettimes" command. It is used for * computing the time needed for various basic operations such as reading * variables, allocating memory, sprintf, converting variables, etc. * * Results: * A standard Tcl result. * * Side effects: * Allocates and frees memory, sets a variable "a" in the interpreter. * *---------------------------------------------------------------------- */ static int GetTimesObjCmd( ClientData unused, /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ int objc, /* Number of arguments. (not used)*/ Tcl_Obj *const dummy[]) /* The argument objects (not used). */ { Interp *iPtr = (Interp *) interp; int i, n; double timePer; Tcl_Time start, stop; Tcl_Obj *objPtr, **objv; const char *s; char newString[TCL_INTEGER_SPACE]; (void)objc; (void)dummy; /* alloc & free 100000 times */ fprintf(stderr, "alloc & free 100000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { objPtr = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)); ckfree(objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per alloc+free\n", timePer/100000); /* alloc 5000 times */ fprintf(stderr, "alloc 5000 6 word items\n"); objv = (Tcl_Obj **)ckalloc(5000 * sizeof(Tcl_Obj *)); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { objv[i] = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per alloc\n", timePer/5000); /* free 5000 times */ fprintf(stderr, "free 5000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { ckfree(objv[i]); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per free\n", timePer/5000); /* Tcl_NewObj 5000 times */ fprintf(stderr, "Tcl_NewObj 5000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { objv[i] = Tcl_NewObj(); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_NewObj\n", timePer/5000); /* Tcl_DecrRefCount 5000 times */ fprintf(stderr, "Tcl_DecrRefCount 5000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { objPtr = objv[i]; Tcl_DecrRefCount(objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000); ckfree(objv); /* TclGetString 100000 times */ fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n"); objPtr = Tcl_NewStringObj("12345", -1); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { (void) TclGetString(objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per TclGetStringFromObj of \"12345\"\n", timePer/100000); /* Tcl_GetIntFromObj 100000 times */ fprintf(stderr, "Tcl_GetIntFromObj of \"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { if (Tcl_GetIntFromObj(interp, objPtr, &n) != TCL_OK) { return TCL_ERROR; } } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_GetIntFromObj of \"12345\"\n", timePer/100000); Tcl_DecrRefCount(objPtr); /* Tcl_GetInt 100000 times */ fprintf(stderr, "Tcl_GetInt of \"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { if (Tcl_GetInt(interp, "12345", &n) != TCL_OK) { return TCL_ERROR; } } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_GetInt of \"12345\"\n", timePer/100000); /* snprintf 100000 times */ fprintf(stderr, "snprintf of 12345 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { snprintf(newString, sizeof(newString), "%d", 12345); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per snprintf of 12345\n", timePer/100000); /* hashtable lookup 100000 times */ fprintf(stderr, "hashtable lookup of \"gettimes\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { (void) Tcl_FindHashEntry(&iPtr->globalNsPtr->cmdTable, "gettimes"); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per hashtable lookup of \"gettimes\"\n", timePer/100000); /* Tcl_SetVar 100000 times */ fprintf(stderr, "Tcl_SetVar of \"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { s = Tcl_SetVar(interp, "a", "12345", TCL_LEAVE_ERR_MSG); if (s == NULL) { return TCL_ERROR; } } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_SetVar of a to \"12345\"\n", timePer/100000); /* Tcl_GetVar 100000 times */ fprintf(stderr, "Tcl_GetVar of a==\"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { s = Tcl_GetVar(interp, "a", TCL_LEAVE_ERR_MSG); if (s == NULL) { return TCL_ERROR; } } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_GetVar of a==\"12345\"\n", timePer/100000); Tcl_ResetResult(interp); return TCL_OK; } /* *---------------------------------------------------------------------- * * NoopCmd -- * * This procedure is just used to time the overhead involved in * parsing and invoking a command. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int NoopCmd( ClientData unused, /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ int argc, /* The number of arguments. */ const char **argv) /* The argument strings. */ { return TCL_OK; } /* *---------------------------------------------------------------------- * * NoopObjCmd -- * * This object-based procedure is just used to time the overhead * involved in parsing and invoking a command. * * Results: * Returns the TCL_OK result code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int NoopObjCmd( ClientData unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { return TCL_OK; } /* *---------------------------------------------------------------------- * * TeststringbytesObjCmd -- * Returns bytearray value of the bytes in argument string rep * * Results: * Returns the TCL_OK result code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TeststringbytesObjCmd( ClientData dummy, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int n; const unsigned char *p; (void)dummy; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n); Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(p, n)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestpurebytesobjObjCmd -- * * This object-based procedure constructs a pure bytes object * without type and with internal representation containing NULL's. * * If no argument supplied it returns empty object with tclEmptyStringRep, * otherwise it returns this as pure bytes object with bytes value equal * string. * * Results: * Returns the TCL_OK result code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestpurebytesobjObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Obj *objPtr; (void)dummy; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?string?"); return TCL_ERROR; } objPtr = Tcl_NewObj(); /* objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; */ memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep)); if (objc == 2) { const char *s = Tcl_GetString(objv[1]); objPtr->length = objv[1]->length; objPtr->bytes = (char *)ckalloc(objPtr->length + 1); memcpy(objPtr->bytes, s, objPtr->length); objPtr->bytes[objPtr->length] = 0; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestsetbytearraylengthObjCmd -- * * Testing command 'testsetbytearraylength` used to test the public * interface routine Tcl_SetByteArrayLength(). * * Results: * Returns the TCL_OK result code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestsetbytearraylengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int n; Tcl_Obj *obj = NULL; (void)dummy; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "value length"); return TCL_ERROR; } if (TCL_OK != Tcl_GetIntFromObj(interp, objv[2], &n)) { return TCL_ERROR; } if (Tcl_IsShared(objv[1])) { obj = Tcl_DuplicateObj(objv[1]); } else { obj = objv[1]; } Tcl_SetByteArrayLength(obj, n); Tcl_SetObjResult(interp, obj); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestbytestringObjCmd -- * * This object-based procedure constructs a string which can * possibly contain invalid UTF-8 bytes. * * Results: * Returns the TCL_OK result code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestbytestringObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int n = 0; const char *p; (void)dummy; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "bytearray"); return TCL_ERROR; } p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n); Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestsetCmd -- * * Implements the "testset{err,noerr}" cmds that are used when testing * Tcl_Set/GetVar C Api with/without TCL_LEAVE_ERR_MSG flag * * Results: * A standard Tcl result. * * Side effects: * Variables may be set. * *---------------------------------------------------------------------- */ static int TestsetCmd( ClientData data, /* Additional flags for Get/SetVar2. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); const char *value; if (argc == 2) { Tcl_AppendResult(interp, "before get", NULL); value = Tcl_GetVar2(interp, argv[1], NULL, flags); if (value == NULL) { return TCL_ERROR; } Tcl_AppendElement(interp, value); return TCL_OK; } else if (argc == 3) { Tcl_AppendResult(interp, "before set", NULL); value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags); if (value == NULL) { return TCL_ERROR; } Tcl_AppendElement(interp, value); return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " varName ?newValue?\"", NULL); return TCL_ERROR; } } static int Testset2Cmd( ClientData data, /* Additional flags for Get/SetVar2. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); const char *value; if (argc == 3) { Tcl_AppendResult(interp, "before get", NULL); value = Tcl_GetVar2(interp, argv[1], argv[2], flags); if (value == NULL) { return TCL_ERROR; } Tcl_AppendElement(interp, value); return TCL_OK; } else if (argc == 4) { Tcl_AppendResult(interp, "before set", NULL); value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags); if (value == NULL) { return TCL_ERROR; } Tcl_AppendElement(interp, value); return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " varName elemName ?newValue?\"", NULL); return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * TestsaveresultCmd -- * * Implements the "testsaveresult" cmd that is used when testing the * Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestsaveresultCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; static const char *const optionStrings[] = { "append", "dynamic", "free", "object", "small", NULL }; enum options { RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL }; /* * Parse arguments */ if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "type script discard"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) { return TCL_ERROR; } objPtr = NULL; /* Lint. */ switch ((enum options) index) { case RESULT_SMALL: Tcl_SetResult(interp, "small result", TCL_VOLATILE); break; case RESULT_APPEND: Tcl_AppendResult(interp, "append result", NULL); break; case RESULT_FREE: { char *buf = ckalloc(200); strcpy(buf, "free result"); Tcl_SetResult(interp, buf, TCL_DYNAMIC); break; } case RESULT_DYNAMIC: Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree); break; case RESULT_OBJECT: objPtr = Tcl_NewStringObj("object result", -1); Tcl_SetObjResult(interp, objPtr); break; } freeCount = 0; Tcl_SaveResult(interp, &state); if (((enum options) index) == RESULT_OBJECT) { result = Tcl_EvalObjEx(interp, objv[2], 0); } else { result = Tcl_Eval(interp, Tcl_GetString(objv[2])); } if (discard) { Tcl_DiscardResult(&state); } else { Tcl_RestoreResult(interp, &state); result = TCL_OK; } switch ((enum options) index) { case RESULT_DYNAMIC: { int present = iPtr->freeProc == TestsaveresultFree; int called = freeCount; Tcl_AppendElement(interp, called ? "called" : "notCalled"); Tcl_AppendElement(interp, present ? "present" : "missing"); break; } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); break; default: break; } return result; } /* *---------------------------------------------------------------------- * * TestsaveresultFree -- * * Special purpose freeProc used by TestsaveresultCmd. * * Results: * None. * * Side effects: * Increments the freeCount. * *---------------------------------------------------------------------- */ static void TestsaveresultFree( #if TCL_MAJOR_VERSION > 8 void *blockPtr) #else char *blockPtr) #endif { freeCount++; } /* *---------------------------------------------------------------------- * * TestmainthreadCmd -- * * Implements the "testmainthread" cmd that is used to test the * 'Tcl_GetCurrentThread' API. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestmainthreadCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc == 1) { Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); Tcl_SetObjResult(interp, idObj); return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * MainLoop -- * * A main loop set by TestsetmainloopCmd below. * * Results: * None. * * Side effects: * Event handlers could do anything. * *---------------------------------------------------------------------- */ static void MainLoop(void) { while (!exitMainLoop) { Tcl_DoOneEvent(0); } fprintf(stdout,"Exit MainLoop\n"); fflush(stdout); } /* *---------------------------------------------------------------------- * * TestsetmainloopCmd -- * * Implements the "testsetmainloop" cmd that is used to test the * 'Tcl_SetMainLoop' API. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestsetmainloopCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { exitMainLoop = 0; Tcl_SetMainLoop(MainLoop); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestexitmainloopCmd -- * * Implements the "testexitmainloop" cmd that is used to test the * 'Tcl_SetMainLoop' API. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestexitmainloopCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { exitMainLoop = 1; return TCL_OK; } /* *---------------------------------------------------------------------- * * TestChannelCmd -- * * Implements the Tcl "testchannel" debugging command and its * subcommands. This is part of the testing environment. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestChannelCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter for result. */ int argc, /* Count of additional args. */ const char **argv) /* Additional arg strings. */ { const char *cmdName; /* Sub command. */ Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ Channel *chanPtr; /* The actual channel. */ ChannelState *statePtr; /* state info for channel */ Tcl_Channel chan; /* The opaque type. */ size_t len; /* Length of subcommand string. */ int IOQueued; /* How much IO is queued inside channel? */ char buf[TCL_INTEGER_SPACE];/* For snprintf. */ int mode; /* rw mode of the channel */ if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " subcommand ?additional args..?\"", NULL); return TCL_ERROR; } cmdName = argv[1]; len = strlen(cmdName); chanPtr = NULL; if (argc > 2) { if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) { /* For splice access the pool of detached channels. * Locate channel, remove from the list. */ TestChannel **nextPtrPtr, *curPtr; chan = (Tcl_Channel) NULL; for (nextPtrPtr = &firstDetached, curPtr = firstDetached; curPtr != NULL; nextPtrPtr = &(curPtr->nextPtr), curPtr = curPtr->nextPtr) { if (strcmp(argv[2], Tcl_GetChannelName(curPtr->chan)) == 0) { *nextPtrPtr = curPtr->nextPtr; curPtr->nextPtr = NULL; chan = curPtr->chan; ckfree(curPtr); break; } } } else { chan = Tcl_GetChannel(interp, argv[2], &mode); } if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } chanPtr = (Channel *) chan; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; chan = (Tcl_Channel) chanPtr; } else { statePtr = NULL; chan = NULL; } if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) { Tcl_Obj *msg = Tcl_NewStringObj(argv[3], -1); Tcl_IncrRefCount(msg); Tcl_SetChannelError(chan, msg); Tcl_DecrRefCount(msg); Tcl_GetChannelError(chan, &msg); Tcl_SetObjResult(interp, msg); Tcl_DecrRefCount(msg); return TCL_OK; } if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) { Tcl_Obj *msg = Tcl_NewStringObj(argv[3], -1); Tcl_IncrRefCount(msg); Tcl_SetChannelErrorInterp(interp, msg); Tcl_DecrRefCount(msg); Tcl_GetChannelErrorInterp(interp, &msg); Tcl_SetObjResult(interp, msg); Tcl_DecrRefCount(msg); return TCL_OK; } /* * "cut" is actually more a simplified detach facility as provided by the * Thread package. Without the safeguards of a regular command (no * checking that the command is truly cut'able, no mutexes for * thread-safety). Its complementary command is "splice", see below. */ if ((cmdName[0] == 'c') && (strncmp(cmdName, "cut", len) == 0)) { TestChannel *det; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " cut channelName\"", NULL); return TCL_ERROR; } Tcl_RegisterChannel(NULL, chan); /* prevent closing */ Tcl_UnregisterChannel(interp, chan); Tcl_CutChannel(chan); /* Remember the channel in the pool of detached channels */ det = (TestChannel *)ckalloc(sizeof(TestChannel)); det->chan = chan; det->nextPtr = firstDetached; firstDetached = det; return TCL_OK; } if ((cmdName[0] == 'c') && (strncmp(cmdName, "clearchannelhandlers", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " clearchannelhandlers channelName\"", NULL); return TCL_ERROR; } Tcl_ClearChannelHandlers(chan); return TCL_OK; } if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " info channelName\"", NULL); return TCL_ERROR; } Tcl_AppendElement(interp, argv[2]); Tcl_AppendElement(interp, Tcl_ChannelName(chanPtr->typePtr)); if (statePtr->flags & TCL_READABLE) { Tcl_AppendElement(interp, "read"); } else { Tcl_AppendElement(interp, ""); } if (statePtr->flags & TCL_WRITABLE) { Tcl_AppendElement(interp, "write"); } else { Tcl_AppendElement(interp, ""); } if (statePtr->flags & CHANNEL_NONBLOCKING) { Tcl_AppendElement(interp, "nonblocking"); } else { Tcl_AppendElement(interp, "blocking"); } if (statePtr->flags & CHANNEL_LINEBUFFERED) { Tcl_AppendElement(interp, "line"); } else if (statePtr->flags & CHANNEL_UNBUFFERED) { Tcl_AppendElement(interp, "none"); } else { Tcl_AppendElement(interp, "full"); } if (statePtr->flags & BG_FLUSH_SCHEDULED) { Tcl_AppendElement(interp, "async_flush"); } else { Tcl_AppendElement(interp, ""); } if (statePtr->flags & CHANNEL_EOF) { Tcl_AppendElement(interp, "eof"); } else { Tcl_AppendElement(interp, ""); } if (statePtr->flags & CHANNEL_BLOCKED) { Tcl_AppendElement(interp, "blocked"); } else { Tcl_AppendElement(interp, "unblocked"); } if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) { Tcl_AppendElement(interp, "auto"); if (statePtr->flags & INPUT_SAW_CR) { Tcl_AppendElement(interp, "saw_cr"); } else { Tcl_AppendElement(interp, ""); } } else if (statePtr->inputTranslation == TCL_TRANSLATE_LF) { Tcl_AppendElement(interp, "lf"); Tcl_AppendElement(interp, ""); } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) { Tcl_AppendElement(interp, "cr"); Tcl_AppendElement(interp, ""); } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) { Tcl_AppendElement(interp, "crlf"); if (statePtr->flags & INPUT_SAW_CR) { Tcl_AppendElement(interp, "queued_cr"); } else { Tcl_AppendElement(interp, ""); } } if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) { Tcl_AppendElement(interp, "auto"); } else if (statePtr->outputTranslation == TCL_TRANSLATE_LF) { Tcl_AppendElement(interp, "lf"); } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) { Tcl_AppendElement(interp, "cr"); } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) { Tcl_AppendElement(interp, "crlf"); } IOQueued = Tcl_InputBuffered(chan); TclFormatInt(buf, IOQueued); Tcl_AppendElement(interp, buf); IOQueued = Tcl_OutputBuffered(chan); TclFormatInt(buf, IOQueued); Tcl_AppendElement(interp, buf); TclFormatInt(buf, (int)Tcl_Tell(chan)); Tcl_AppendElement(interp, buf); TclFormatInt(buf, statePtr->refCount); Tcl_AppendElement(interp, buf); return TCL_OK; } if ((cmdName[0] == 'i') && (strncmp(cmdName, "inputbuffered", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } IOQueued = Tcl_InputBuffered(chan); TclFormatInt(buf, IOQueued); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'i') && (strncmp(cmdName, "isshared", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } TclFormatInt(buf, Tcl_IsChannelShared(chan)); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } TclFormatInt(buf, Tcl_IsStandardChannel(chan)); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } if (statePtr->flags & TCL_READABLE) { Tcl_AppendElement(interp, "read"); } else { Tcl_AppendElement(interp, ""); } if (statePtr->flags & TCL_WRITABLE) { Tcl_AppendElement(interp, "write"); } else { Tcl_AppendElement(interp, ""); } return TCL_OK; } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan))); return TCL_OK; } if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } Tcl_AppendResult(interp, statePtr->channelName, NULL); return TCL_OK; } if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) { hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr)); } return TCL_OK; } if ((cmdName[0] == 'o') && (strncmp(cmdName, "outputbuffered", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } IOQueued = Tcl_OutputBuffered(chan); TclFormatInt(buf, IOQueued); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'q') && (strncmp(cmdName, "queuedcr", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } Tcl_AppendResult(interp, (statePtr->flags & INPUT_SAW_CR) ? "1" : "0", NULL); return TCL_OK; } if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) { hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { chanPtr = (Channel *) Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; if (statePtr->flags & TCL_READABLE) { Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr)); } } return TCL_OK; } if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } TclFormatInt(buf, statePtr->refCount); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } /* * "splice" is actually more a simplified attach facility as provided by * the Thread package. Without the safeguards of a regular command (no * checking that the command is truly cut'able, no mutexes for * thread-safety). Its complementary command is "cut", see above. */ if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } Tcl_SpliceChannel(chan); Tcl_RegisterChannel(interp, chan); Tcl_UnregisterChannel(NULL, chan); return TCL_OK; } if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr), NULL); return TCL_OK; } if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) { hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { chanPtr = (Channel *) Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; if (statePtr->flags & TCL_WRITABLE) { Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr)); } } return TCL_OK; } if ((cmdName[0] == 't') && (strncmp(cmdName, "transform", len) == 0)) { /* * Syntax: transform channel -command command */ if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " transform channelId -command cmd\"", NULL); return TCL_ERROR; } if (strcmp(argv[3], "-command") != 0) { Tcl_AppendResult(interp, "bad argument \"", argv[3], "\": should be \"-command\"", NULL); return TCL_ERROR; } return TclChannelTransform(interp, chan, Tcl_NewStringObj(argv[4], -1)); } if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) { /* * Syntax: unstack channel */ if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " unstack channel\"", NULL); return TCL_ERROR; } return Tcl_UnstackChannel(interp, chan); } Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be " "cut, clearchannelhandlers, info, isshared, mode, open, " "readable, splice, writable, transform, unstack", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TestChannelEventCmd -- * * This procedure implements the "testchannelevent" command. It is used * to test the Tcl channel event mechanism. * * Results: * A standard Tcl result. * * Side effects: * Creates, deletes and returns channel event handlers. * *---------------------------------------------------------------------- */ static int TestChannelEventCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Obj *resultListPtr; Channel *chanPtr; ChannelState *statePtr; /* state info for channel */ EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr; const char *cmd; int index, i, mask, len; if ((argc < 3) || (argc > 5)) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " channelName cmd ?arg1? ?arg2?\"", NULL); return TCL_ERROR; } chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL); if (chanPtr == NULL) { return TCL_ERROR; } statePtr = chanPtr->state; cmd = argv[2]; len = strlen(cmd); if ((cmd[0] == 'a') && (strncmp(cmd, "add", len) == 0)) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " channelName add eventSpec script\"", NULL); return TCL_ERROR; } if (strcmp(argv[3], "readable") == 0) { mask = TCL_READABLE; } else if (strcmp(argv[3], "writable") == 0) { mask = TCL_WRITABLE; } else if (strcmp(argv[3], "none") == 0) { mask = 0; } else { Tcl_AppendResult(interp, "bad event name \"", argv[3], "\": must be readable, writable, or none", NULL); return TCL_ERROR; } esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord)); esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; esPtr->chanPtr = chanPtr; esPtr->interp = interp; esPtr->mask = mask; esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1); Tcl_IncrRefCount(esPtr->scriptPtr); Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, TclChannelEventScriptInvoker, esPtr); return TCL_OK; } if ((cmd[0] == 'd') && (strncmp(cmd, "delete", len) == 0)) { if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " channelName delete index\"", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) { return TCL_ERROR; } if (index < 0) { Tcl_AppendResult(interp, "bad event index: ", argv[3], ": must be nonnegative", NULL); return TCL_ERROR; } for (i = 0, esPtr = statePtr->scriptRecordPtr; (i < index) && (esPtr != NULL); i++, esPtr = esPtr->nextPtr) { /* Empty loop body. */ } if (esPtr == NULL) { Tcl_AppendResult(interp, "bad event index ", argv[3], ": out of range", NULL); return TCL_ERROR; } if (esPtr == statePtr->scriptRecordPtr) { statePtr->scriptRecordPtr = esPtr->nextPtr; } else { for (prevEsPtr = statePtr->scriptRecordPtr; (prevEsPtr != NULL) && (prevEsPtr->nextPtr != esPtr); prevEsPtr = prevEsPtr->nextPtr) { /* Empty loop body. */ } if (prevEsPtr == NULL) { Tcl_Panic("TestChannelEventCmd: damaged event script list"); } prevEsPtr->nextPtr = esPtr->nextPtr; } Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); ckfree(esPtr); return TCL_OK; } if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " channelName list\"", NULL); return TCL_ERROR; } resultListPtr = Tcl_GetObjResult(interp); for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL; esPtr = esPtr->nextPtr) { if (esPtr->mask) { Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1)); } else { Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj("none", -1)); } Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr); } Tcl_SetObjResult(interp, resultListPtr); return TCL_OK; } if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " channelName removeall\"", NULL); return TCL_ERROR; } for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL; esPtr = nextEsPtr) { nextEsPtr = esPtr->nextPtr; Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); ckfree(esPtr); } statePtr->scriptRecordPtr = NULL; return TCL_OK; } if ((cmd[0] == 's') && (strncmp(cmd, "set", len) == 0)) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " channelName delete index event\"", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) { return TCL_ERROR; } if (index < 0) { Tcl_AppendResult(interp, "bad event index: ", argv[3], ": must be nonnegative", NULL); return TCL_ERROR; } for (i = 0, esPtr = statePtr->scriptRecordPtr; (i < index) && (esPtr != NULL); i++, esPtr = esPtr->nextPtr) { /* Empty loop body. */ } if (esPtr == NULL) { Tcl_AppendResult(interp, "bad event index ", argv[3], ": out of range", NULL); return TCL_ERROR; } if (strcmp(argv[4], "readable") == 0) { mask = TCL_READABLE; } else if (strcmp(argv[4], "writable") == 0) { mask = TCL_WRITABLE; } else if (strcmp(argv[4], "none") == 0) { mask = 0; } else { Tcl_AppendResult(interp, "bad event name \"", argv[4], "\": must be readable, writable, or none", NULL); return TCL_ERROR; } esPtr->mask = mask; Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, TclChannelEventScriptInvoker, esPtr); return TCL_OK; } Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of " "add, delete, list, set, or removeall", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TestServiceModeCmd -- * * This procedure implements the "testservicemode" command which gets or * sets the current Tcl ServiceMode. There are several tests which open * a file and assign various handlers to it. For these tests to be * deterministic it is important that file events not be processed until * all of the handlers are in place. * * Results: * A standard Tcl result. * * Side effects: * May change the ServiceMode setting. * *---------------------------------------------------------------------- */ static int TestServiceModeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int newmode, oldmode; if (argc > 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ?newmode?\"", NULL); return TCL_ERROR; } oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE); if (argc == 2) { if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) { return TCL_ERROR; } if (newmode == 0) { Tcl_SetServiceMode(TCL_SERVICE_NONE); } else { Tcl_SetServiceMode(TCL_SERVICE_ALL); } } Tcl_SetObjResult(interp, Tcl_NewIntObj(oldmode)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestWrongNumArgsObjCmd -- * * Test the Tcl_WrongNumArgs function. * * Results: * Standard Tcl result. * * Side effects: * Sets interpreter result. * *---------------------------------------------------------------------- */ static int TestWrongNumArgsObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, length; const char *msg; if (objc < 3) { goto insufArgs; } if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) { return TCL_ERROR; } msg = Tcl_GetStringFromObj(objv[2], &length); if (length == 0) { msg = NULL; } if (i > objc - 3) { /* * Asked for more arguments than were given. */ insufArgs: Tcl_AppendResult(interp, "insufficient arguments", NULL); return TCL_ERROR; } Tcl_WrongNumArgs(interp, i, &(objv[3]), msg); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestGetIndexFromObjStructObjCmd -- * * Test the Tcl_GetIndexFromObjStruct function. * * Results: * Standard Tcl result. * * Side effects: * Sets interpreter result. * *---------------------------------------------------------------------- */ static int TestGetIndexFromObjStructObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *const ary[] = { "a", "b", "c", "d", "ee", "ff", NULL, NULL }; int idx,target, flags = 0; if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue ?flags?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) { return TCL_ERROR; } if ((objc > 3) && (Tcl_GetIntFromObj(interp, objv[3], &flags) != TCL_OK)) { return TCL_ERROR; } if (Tcl_GetIndexFromObjStruct(interp, (Tcl_GetString(objv[1])[0] ? objv[1] : NULL), ary, 2*sizeof(char *), "dummy", flags, &idx) != TCL_OK) { return TCL_ERROR; } if (idx != target) { char buffer[64]; snprintf(buffer, sizeof(buffer), "%d", idx); Tcl_AppendResult(interp, "index value comparison failed: got ", buffer, NULL); snprintf(buffer, sizeof(buffer), "%d", target); Tcl_AppendResult(interp, " when ", buffer, " expected", NULL); return TCL_ERROR; } Tcl_WrongNumArgs(interp, objc, objv, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestFilesystemObjCmd -- * * This procedure implements the "testfilesystem" command. It is used to * test Tcl_FSRegister, Tcl_FSUnregister, and can be used to test that * the pluggable filesystem works. * * Results: * A standard Tcl result. * * Side effects: * Inserts or removes a filesystem from Tcl's stack. * *---------------------------------------------------------------------- */ static int TestFilesystemObjCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int res, boolVal; const char *msg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "boolean"); return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) { return TCL_ERROR; } if (boolVal) { res = Tcl_FSRegister(interp, &testReportingFilesystem); msg = (res == TCL_OK) ? "registered" : "failed"; } else { res = Tcl_FSUnregister(&testReportingFilesystem); msg = (res == TCL_OK) ? "unregistered" : "failed"; } Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1)); return res; } static int TestReportInFilesystem( Tcl_Obj *pathPtr, ClientData *clientDataPtr) { static Tcl_Obj *lastPathPtr = NULL; Tcl_Obj *newPathPtr; if (pathPtr == lastPathPtr) { /* Reject all files second time around */ return -1; } /* Try to claim all files first time around */ newPathPtr = Tcl_DuplicateObj(pathPtr); lastPathPtr = newPathPtr; Tcl_IncrRefCount(newPathPtr); if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) { /* Nothing claimed it. Therefore we don't either */ Tcl_DecrRefCount(newPathPtr); lastPathPtr = NULL; return -1; } lastPathPtr = NULL; *clientDataPtr = newPathPtr; return TCL_OK; } /* * Simple helper function to extract the native vfs representation of a path * object, or NULL if no such representation exists. */ static Tcl_Obj * TestReportGetNativePath( Tcl_Obj *pathPtr) { return (Tcl_Obj*) Tcl_FSGetInternalRep(pathPtr, &testReportingFilesystem); } static void TestReportFreeInternalRep( ClientData clientData) { Tcl_Obj *nativeRep = (Tcl_Obj *) clientData; if (nativeRep != NULL) { /* Free the path */ Tcl_DecrRefCount(nativeRep); } } static ClientData TestReportDupInternalRep( ClientData clientData) { Tcl_Obj *original = (Tcl_Obj *) clientData; Tcl_IncrRefCount(original); return clientData; } static void TestReport( const char *cmd, Tcl_Obj *path, Tcl_Obj *arg2) { Tcl_Interp *interp = (Tcl_Interp *) Tcl_FSData(&testReportingFilesystem); if (interp == NULL) { /* This is bad, but not much we can do about it */ } else { Tcl_Obj *savedResult; Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1); Tcl_DStringStartSublist(&ds); Tcl_DStringAppendElement(&ds, cmd); if (path != NULL) { Tcl_DStringAppendElement(&ds, Tcl_GetString(path)); } if (arg2 != NULL) { Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2)); } Tcl_DStringEndSublist(&ds); savedResult = Tcl_GetObjResult(interp); Tcl_IncrRefCount(savedResult); Tcl_SetObjResult(interp, Tcl_NewObj()); Tcl_Eval(interp, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); Tcl_ResetResult(interp); Tcl_SetObjResult(interp, savedResult); Tcl_DecrRefCount(savedResult); } } static int TestReportStat( Tcl_Obj *path, /* Path of file to stat (in current CP). */ Tcl_StatBuf *buf) /* Filled with results of stat call. */ { TestReport("stat", path, NULL); return Tcl_FSStat(TestReportGetNativePath(path), buf); } static int TestReportLstat( Tcl_Obj *path, /* Path of file to stat (in current CP). */ Tcl_StatBuf *buf) /* Filled with results of stat call. */ { TestReport("lstat", path, NULL); return Tcl_FSLstat(TestReportGetNativePath(path), buf); } static int TestReportAccess( Tcl_Obj *path, /* Path of file to access (in current CP). */ int mode) /* Permission setting. */ { TestReport("access", path, NULL); return Tcl_FSAccess(TestReportGetNativePath(path), mode); } static Tcl_Channel TestReportOpenFileChannel( Tcl_Interp *interp, /* Interpreter for error reporting; can be * NULL. */ Tcl_Obj *fileName, /* Name of file to open. */ int mode, /* POSIX open mode. */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { TestReport("open", fileName, NULL); return TclpOpenFileChannel(interp, TestReportGetNativePath(fileName), mode, permissions); } static int TestReportMatchInDirectory( Tcl_Interp *interp, /* Interpreter for error messages. */ Tcl_Obj *resultPtr, /* Object to lappend results. */ Tcl_Obj *dirPtr, /* Contains path to directory to search. */ const char *pattern, /* Pattern to match against. */ Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. */ { if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) { TestReport("matchmounts", dirPtr, NULL); return TCL_OK; } else { TestReport("matchindirectory", dirPtr, NULL); return Tcl_FSMatchInDirectory(interp, resultPtr, TestReportGetNativePath(dirPtr), pattern, types); } } static int TestReportChdir( Tcl_Obj *dirName) { TestReport("chdir", dirName, NULL); return Tcl_FSChdir(TestReportGetNativePath(dirName)); } static int TestReportLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *fileName, /* Name of the file containing the desired * code. */ Tcl_LoadHandle *handlePtr, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for * this file. */ { TestReport("loadfile", fileName, NULL); return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), NULL, NULL, NULL, NULL, handlePtr, unloadProcPtr); } static Tcl_Obj * TestReportLink( Tcl_Obj *path, /* Path of file to readlink or link */ Tcl_Obj *to, /* Path of file to link to, or NULL */ int linkType) { TestReport("link", path, to); return Tcl_FSLink(TestReportGetNativePath(path), to, linkType); } static int TestReportRenameFile( Tcl_Obj *src, /* Pathname of file or dir to be renamed * (UTF-8). */ Tcl_Obj *dst) /* New pathname of file or directory * (UTF-8). */ { TestReport("renamefile", src, dst); return Tcl_FSRenameFile(TestReportGetNativePath(src), TestReportGetNativePath(dst)); } static int TestReportCopyFile( Tcl_Obj *src, /* Pathname of file to be copied (UTF-8). */ Tcl_Obj *dst) /* Pathname of file to copy to (UTF-8). */ { TestReport("copyfile", src, dst); return Tcl_FSCopyFile(TestReportGetNativePath(src), TestReportGetNativePath(dst)); } static int TestReportDeleteFile( Tcl_Obj *path) /* Pathname of file to be removed (UTF-8). */ { TestReport("deletefile", path, NULL); return Tcl_FSDeleteFile(TestReportGetNativePath(path)); } static int TestReportCreateDirectory( Tcl_Obj *path) /* Pathname of directory to create (UTF-8). */ { TestReport("createdirectory", path, NULL); return Tcl_FSCreateDirectory(TestReportGetNativePath(path)); } static int TestReportCopyDirectory( Tcl_Obj *src, /* Pathname of directory to be copied * (UTF-8). */ Tcl_Obj *dst, /* Pathname of target directory (UTF-8). */ Tcl_Obj **errorPtr) /* If non-NULL, to be filled with UTF-8 name * of file causing error. */ { TestReport("copydirectory", src, dst); return Tcl_FSCopyDirectory(TestReportGetNativePath(src), TestReportGetNativePath(dst), errorPtr); } static int TestReportRemoveDirectory( Tcl_Obj *path, /* Pathname of directory to be removed * (UTF-8). */ int recursive, /* If non-zero, removes directories that * are nonempty. Otherwise, will only remove * empty directories. */ Tcl_Obj **errorPtr) /* If non-NULL, to be filled with UTF-8 name * of file causing error. */ { TestReport("removedirectory", path, NULL); return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive, errorPtr); } static const char *const * TestReportFileAttrStrings( Tcl_Obj *fileName, Tcl_Obj **objPtrRef) { TestReport("fileattributestrings", fileName, NULL); return Tcl_FSFileAttrStrings(TestReportGetNativePath(fileName), objPtrRef); } static int TestReportFileAttrsGet( Tcl_Interp *interp, /* The interpreter for error reporting. */ int index, /* index of the attribute command. */ Tcl_Obj *fileName, /* filename we are operating on. */ Tcl_Obj **objPtrRef) /* for output. */ { TestReport("fileattributesget", fileName, NULL); return Tcl_FSFileAttrsGet(interp, index, TestReportGetNativePath(fileName), objPtrRef); } static int TestReportFileAttrsSet( Tcl_Interp *interp, /* The interpreter for error reporting. */ int index, /* index of the attribute command. */ Tcl_Obj *fileName, /* filename we are operating on. */ Tcl_Obj *objPtr) /* for input. */ { TestReport("fileattributesset", fileName, objPtr); return Tcl_FSFileAttrsSet(interp, index, TestReportGetNativePath(fileName), objPtr); } static int TestReportUtime( Tcl_Obj *fileName, struct utimbuf *tval) { TestReport("utime", fileName, NULL); return Tcl_FSUtime(TestReportGetNativePath(fileName), tval); } static int TestReportNormalizePath( Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint) { TestReport("normalizepath", pathPtr, NULL); return nextCheckpoint; } static int SimplePathInFilesystem( Tcl_Obj *pathPtr, ClientData *clientDataPtr) { const char *str = Tcl_GetString(pathPtr); if (strncmp(str, "simplefs:/", 10)) { return -1; } return TCL_OK; } /* * This is a slightly 'hacky' filesystem which is used just to test a few * important features of the vfs code: (1) that you can load a shared library * from a vfs, (2) that when copying files from one fs to another, the 'mtime' * is preserved. (3) that recursive cross-filesystem directory copies have the * correct behaviour with/without -force. * * It treats any file in 'simplefs:/' as a file, which it routes to the * current directory. The real file it uses is whatever follows the trailing * '/' (e.g. 'foo' in 'simplefs:/foo'), and that file exists or not according * to what is in the native pwd. * * Please do not consider this filesystem a model of how things are to be * done. It is quite the opposite! But, it does allow us to test some * important features. */ static int TestSimpleFilesystemObjCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int res, boolVal; const char *msg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "boolean"); return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) { return TCL_ERROR; } if (boolVal) { res = Tcl_FSRegister(interp, &simpleFilesystem); msg = (res == TCL_OK) ? "registered" : "failed"; } else { res = Tcl_FSUnregister(&simpleFilesystem); msg = (res == TCL_OK) ? "unregistered" : "failed"; } Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1)); return res; } /* * Treats a file name 'simplefs:/foo' by using the file 'foo' in the current * (native) directory. */ static Tcl_Obj * SimpleRedirect( Tcl_Obj *pathPtr) /* Name of file to copy. */ { int len; const char *str; Tcl_Obj *origPtr; /* * We assume the same name in the current directory is ok. */ str = Tcl_GetStringFromObj(pathPtr, &len); if (len < 10 || strncmp(str, "simplefs:/", 10)) { /* Probably shouldn't ever reach here */ Tcl_IncrRefCount(pathPtr); return pathPtr; } origPtr = Tcl_NewStringObj(str+10, -1); Tcl_IncrRefCount(origPtr); return origPtr; } static int SimpleMatchInDirectory( Tcl_Interp *interp, /* Interpreter for error * messages. */ Tcl_Obj *resultPtr, /* Object to lappend results. */ Tcl_Obj *dirPtr, /* Contains path to directory to search. */ const char *pattern, /* Pattern to match against. */ Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. */ { int res; Tcl_Obj *origPtr; Tcl_Obj *resPtr; /* We only provide a new volume, therefore no mounts at all */ if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) { return TCL_OK; } /* * We assume the same name in the current directory is ok. */ resPtr = Tcl_NewObj(); Tcl_IncrRefCount(resPtr); origPtr = SimpleRedirect(dirPtr); res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types); if (res == TCL_OK) { int gLength, j; Tcl_ListObjLength(NULL, resPtr, &gLength); for (j = 0; j < gLength; j++) { Tcl_Obj *gElt, *nElt; Tcl_ListObjIndex(NULL, resPtr, j, &gElt); nElt = Tcl_NewStringObj("simplefs:/",10); Tcl_AppendObjToObj(nElt, gElt); Tcl_ListObjAppendElement(NULL, resultPtr, nElt); } } Tcl_DecrRefCount(origPtr); Tcl_DecrRefCount(resPtr); return res; } static Tcl_Channel SimpleOpenFileChannel( Tcl_Interp *interp, /* Interpreter for error reporting; can be * NULL. */ Tcl_Obj *pathPtr, /* Name of file to open. */ int mode, /* POSIX open mode. */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { Tcl_Obj *tempPtr; Tcl_Channel chan; if ((mode != 0) && !(mode & O_RDONLY)) { Tcl_AppendResult(interp, "read-only", NULL); return NULL; } tempPtr = SimpleRedirect(pathPtr); chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions); Tcl_DecrRefCount(tempPtr); return chan; } static int SimpleAccess( Tcl_Obj *pathPtr, /* Path of file to access (in current CP). */ int mode) /* Permission setting. */ { Tcl_Obj *tempPtr = SimpleRedirect(pathPtr); int res = Tcl_FSAccess(tempPtr, mode); Tcl_DecrRefCount(tempPtr); return res; } static int SimpleStat( Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */ Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ { Tcl_Obj *tempPtr = SimpleRedirect(pathPtr); int res = Tcl_FSStat(tempPtr, bufPtr); Tcl_DecrRefCount(tempPtr); return res; } static Tcl_Obj * SimpleListVolumes(void) { /* Add one new volume */ Tcl_Obj *retVal; retVal = Tcl_NewStringObj("simplefs:/", -1); Tcl_IncrRefCount(retVal); return retVal; } /* * Used to check operations of Tcl_UtfNext. * * Usage: testutfnext $bytes $offset */ static int TestUtfNextCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int numBytes; /* Number of bytes supplied in the test string */ int offset; /* Number of bytes we are permitted to read */ char *bytes; const char *result, *first; char buffer[32]; static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF"; const char *p = tobetested; (void)dummy; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "string ?numBytes?"); return TCL_ERROR; } bytes = Tcl_GetStringFromObj(objv[1], &numBytes); offset = numBytes +TCL_UTF_MAX -1; /* If no constraint is given, allow * the terminating NUL to limit * operations. */ if (objc == 3) { if (TCL_OK != TclGetIntForIndex(interp, objv[2], numBytes, &offset)) { return TCL_ERROR; } if (offset < 0) { offset = 0; } if (offset > numBytes +TCL_UTF_MAX -1) { offset = numBytes +TCL_UTF_MAX -1; } } if (numBytes > (int)sizeof(buffer) - 3) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"testutfnext\" can only handle %d bytes", (int)sizeof(buffer) - 4)); return TCL_ERROR; } memcpy(buffer + 1, bytes, numBytes); buffer[0] = buffer[numBytes + 1] = buffer[numBytes + 2] = buffer[numBytes + 3] = '\xA0'; if (!Tcl_UtfCharComplete(buffer + 1, offset)) { /* Cannot scan a complete sequence from the data */ Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); return TCL_OK; } first = result = Tcl_UtfNext(buffer + 1); while ((buffer[0] = *p++) != '\0') { /* Run Tcl_UtfNext with many more possible bytes at src[-1], all should give the same result */ result = Tcl_UtfNext(buffer + 1); if (first != result) { Tcl_AppendResult(interp, "Tcl_UtfNext is not supposed to read src[-1]", NULL); return TCL_ERROR; } } p = tobetested; while ((buffer[numBytes + 1] = *p++) != '\0') { /* Run Tcl_UtfNext with many more possible bytes at src[end], all should give the same result */ result = Tcl_UtfNext(buffer + 1); if (first != result) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Tcl_UtfNext is not supposed to read src[end]\n" "Different result when src[end] is %#x", UCHAR(p[-1]))); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewIntObj(first - buffer - 1)); return TCL_OK; } /* * Used to check operations of Tcl_UtfPrev. * * Usage: testutfprev $bytes $offset */ static int TestUtfPrevCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int numBytes, offset; char *bytes; const char *result; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?"); return TCL_ERROR; } bytes = Tcl_GetStringFromObj(objv[1], &numBytes); if (objc == 3) { if (TCL_OK != TclGetIntForIndex(interp, objv[2], numBytes, &offset)) { return TCL_ERROR; } if (offset < 0) { offset = 0; } if (offset > numBytes) { offset = numBytes; } } else { offset = numBytes; } result = TclUtfPrev(bytes + offset, bytes); Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes)); return TCL_OK; } /* * Used to check correct string-length determining in Tcl_NumUtfChars */ static int TestNumUtfCharsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc > 1) { int numBytes, len, limit = -1; const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); if (objc > 2) { if (TclGetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) { return TCL_ERROR; } if (limit > numBytes + 1) { limit = numBytes + 1; } } len = Tcl_NumUtfChars(bytes, limit); Tcl_SetObjResult(interp, Tcl_NewIntObj(len)); } return TCL_OK; } /* * Used to check correct operation of Tcl_GetUniChar * testgetunichar STRING INDEX * This differs from just using "string index" in being a direct * call to Tcl_GetUniChar without any prior range checking. */ static int TestGetUniCharCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[] /* Argument strings */ ) { int index; int c ; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "STRING INDEX"); return TCL_ERROR; } Tcl_GetIntFromObj(interp, objv[2], &index); c = Tcl_GetUniChar(objv[1], index); Tcl_SetObjResult(interp, Tcl_NewIntObj(c)); return TCL_OK; } /* * Used to check correct operation of Tcl_UtfFindFirst */ static int TestFindFirstCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc > 1) { int len = -1; if (objc > 2) { (void) Tcl_GetIntFromObj(interp, objv[2], &len); } Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1)); } return TCL_OK; } /* * Used to check correct operation of Tcl_UtfFindLast */ static int TestFindLastCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc > 1) { int len = -1; if (objc > 2) { (void) Tcl_GetIntFromObj(interp, objv[2], &len); } Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1)); } return TCL_OK; } #if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL) /* *---------------------------------------------------------------------- * * TestcpuidCmd -- * * Retrieves CPU ID information. * * Usage: * testwincpuid * * Parameters: * eax - The value to pass in the EAX register to a CPUID instruction. * * Results: * Returns a four-element list containing the values from the EAX, EBX, * ECX and EDX registers returned from the CPUID instruction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestcpuidCmd( ClientData dummy, Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int status, index, i; unsigned int regs[4]; Tcl_Obj *regsObjs[4]; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "eax"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) { return TCL_ERROR; } status = TclWinCPUID((unsigned) index, regs); if (status != TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewStringObj("operation not available", -1)); return status; } for (i=0 ; i<4 ; ++i) { regsObjs[i] = Tcl_NewIntObj((int) regs[i]); } Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); return TCL_OK; } #endif /* * Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag */ static int TestHashSystemHashCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const Tcl_HashKeyType hkType = { TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH, NULL, NULL, NULL, NULL }; Tcl_HashTable hash; Tcl_HashEntry *hPtr; int i, isNew, limit = 100; (void)dummy; if (objc>1 && Tcl_GetIntFromObj(interp, objv[1], &limit)!=TCL_OK) { return TCL_ERROR; } Tcl_InitCustomHashTable(&hash, TCL_CUSTOM_TYPE_KEYS, &hkType); if (hash.numEntries != 0) { Tcl_AppendResult(interp, "non-zero initial size", NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } for (i=0 ; iexecEnvPtr->callbackPtr; (void)dummy; (void)objc; (void)objv; if (refDepth == NULL) { refDepth = (ptrdiff_t *)TclGetCStackPtr(); } depth = (refDepth - (ptrdiff_t *)TclGetCStackPtr()); levels[0] = Tcl_NewIntObj(depth); levels[1] = Tcl_NewIntObj(iPtr->numLevels); levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level); levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level); levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr - iPtr->execEnvPtr->execStackPtr->stackWords); while (cbPtr) { i++; cbPtr = cbPtr->nextPtr; } levels[5] = Tcl_NewIntObj(i); Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestconcatobjCmd -- * * This procedure implements the "testconcatobj" command. It is used * to test that Tcl_ConcatObj does indeed return a fresh Tcl_Obj in all * cases and that it never corrupts its arguments. In other words, that * [Bug 1447328] was fixed properly. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestconcatobjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr; int result = TCL_OK, len; Tcl_Obj *objv[3]; /* * Set the start of the error message as obj result; it will be cleared at * the end if no errors were found. */ Tcl_SetObjResult(interp, Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1)); emptyPtr = Tcl_NewObj(); list1Ptr = Tcl_NewStringObj("foo bar sum", -1); Tcl_ListObjLength(NULL, list1Ptr, &len); if (list1Ptr->bytes != NULL) { ckfree(list1Ptr->bytes); list1Ptr->bytes = NULL; } list2Ptr = Tcl_NewStringObj("eeny meeny", -1); Tcl_ListObjLength(NULL, list2Ptr, &len); if (list2Ptr->bytes != NULL) { ckfree(list2Ptr->bytes); list2Ptr->bytes = NULL; } /* * Verify that concat'ing a list obj with one or more empty strings does * return a fresh Tcl_Obj (see also [Bug 2055782]). */ tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; objv[1] = emptyPtr; concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (a) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (a) concatObj is not a new obj ", NULL); switch (tmpPtr->refCount) { case 0: Tcl_AppendResult(interp, "(no new refCount)", NULL); break; case 1: Tcl_AppendResult(interp, "(refCount added)", NULL); break; default: Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } Tcl_DecrRefCount(concatPtr); Tcl_IncrRefCount(tmpPtr); concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (b) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (b) concatObj is not a new obj ", NULL); switch (tmpPtr->refCount) { case 0: Tcl_AppendResult(interp, "(refCount removed?)", NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); break; case 1: Tcl_AppendResult(interp, "(no new refCount)", NULL); break; case 2: Tcl_AppendResult(interp, "(refCount added)", NULL); Tcl_DecrRefCount(tmpPtr); break; default: Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } Tcl_DecrRefCount(concatPtr); objv[0] = emptyPtr; objv[1] = tmpPtr; objv[2] = emptyPtr; concatPtr = Tcl_ConcatObj(3, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (c) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (c) concatObj is not a new obj ", NULL); switch (tmpPtr->refCount) { case 0: Tcl_AppendResult(interp, "(no new refCount)", NULL); break; case 1: Tcl_AppendResult(interp, "(refCount added)", NULL); break; default: Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[1] = tmpPtr; } Tcl_DecrRefCount(concatPtr); Tcl_IncrRefCount(tmpPtr); concatPtr = Tcl_ConcatObj(3, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (d) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (d) concatObj is not a new obj ", NULL); switch (tmpPtr->refCount) { case 0: Tcl_AppendResult(interp, "(refCount removed?)", NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); break; case 1: Tcl_AppendResult(interp, "(no new refCount)", NULL); break; case 2: Tcl_AppendResult(interp, "(refCount added)", NULL); Tcl_DecrRefCount(tmpPtr); break; default: Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[1] = tmpPtr; } Tcl_DecrRefCount(concatPtr); /* * Verify that an unshared list is not corrupted when concat'ing things to * it. */ objv[0] = tmpPtr; objv[1] = list2Ptr; concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (e) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ", NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { case 3: Tcl_AppendResult(interp, "(failed to concat)", NULL); break; default: Tcl_AppendResult(interp, "(corrupted input!)", NULL); } if (Tcl_IsShared(tmpPtr)) { Tcl_DecrRefCount(tmpPtr); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } Tcl_DecrRefCount(concatPtr); objv[0] = tmpPtr; objv[1] = list2Ptr; Tcl_IncrRefCount(tmpPtr); concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (f) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ", NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { case 3: Tcl_AppendResult(interp, "(failed to concat)", NULL); break; default: Tcl_AppendResult(interp, "(corrupted input!)", NULL); } if (Tcl_IsShared(tmpPtr)) { Tcl_DecrRefCount(tmpPtr); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } Tcl_DecrRefCount(concatPtr); objv[0] = tmpPtr; objv[1] = list2Ptr; Tcl_IncrRefCount(tmpPtr); Tcl_IncrRefCount(tmpPtr); concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (g) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ", NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { case 3: Tcl_AppendResult(interp, "(failed to concat)", NULL); break; default: Tcl_AppendResult(interp, "(corrupted input!)", NULL); } Tcl_DecrRefCount(tmpPtr); if (Tcl_IsShared(tmpPtr)) { Tcl_DecrRefCount(tmpPtr); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } Tcl_DecrRefCount(concatPtr); /* * Clean everything up. Note that we don't actually know how many * references there are to tmpPtr here; in the no-error case, it should be * five... [Bug 2895367] */ Tcl_DecrRefCount(list1Ptr); Tcl_DecrRefCount(list2Ptr); Tcl_DecrRefCount(emptyPtr); while (tmpPtr->refCount > 1) { Tcl_DecrRefCount(tmpPtr); } Tcl_DecrRefCount(tmpPtr); if (result == TCL_OK) { Tcl_ResetResult(interp); } return result; } /* *---------------------------------------------------------------------- * * TestparseargsCmd -- * * This procedure implements the "testparseargs" command. It is used to * test that Tcl_ParseArgsObjv does indeed return the right number of * arguments. In other words, that [Bug 3413857] was fixed properly. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestparseargsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Arguments. */ { static int foo = 0; int count = objc; Tcl_Obj **remObjv, *result[3]; Tcl_ArgvInfo argTable[] = { {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END }; foo = 0; if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) { return TCL_ERROR; } result[0] = Tcl_NewIntObj(foo); result[1] = Tcl_NewIntObj(count); result[2] = Tcl_NewListObj(count, remObjv); Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); ckfree(remObjv); return TCL_OK; } /** * Test harness for command and variable resolvers. */ static int InterpCmdResolver( Tcl_Interp *interp, const char *name, Tcl_Namespace *dummy, int flags, Tcl_Command *rPtr) { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ? varFramePtr->procPtr : NULL; Namespace *callerNsPtr = varFramePtr->nsPtr; Tcl_Command resolvedCmdPtr = NULL; (void)dummy; (void)flags; /* * Just do something special on a cmd literal "z" in two cases: * A) when the caller is a proc "x", and the proc is either in "::" or in "::ns2". * B) the caller's namespace is "ctx1" or "ctx2" */ if ( (name[0] == 'z') && (name[1] == '\0') ) { Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0); if (procPtr != NULL && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr) || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr) ) ) { /* * Case A) * * - The context, in which this resolver becomes active, is * determined by the name of the caller proc, which has to be * named "x". * * - To determine the name of the caller proc, the proc is taken * from the topmost stack frame. * * - Note that the context is NOT provided during byte-code * compilation (e.g. in TclProcCompileProc) * * When these conditions hold, this function resolves the * passed-in cmd literal into a cmd "y", which is taken from the * the global namespace (for simplicity). */ const char *callingCmdName = Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr); if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) { resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); } } else if (callerNsPtr != NULL) { /* * Case B) * * - The context, in which this resolver becomes active, is * determined by the name of the parent namespace, which has * to be named "ctx1" or "ctx2". * * - To determine the name of the parent namesace, it is taken * from the 2nd highest stack frame. * * - Note that the context can be provided during byte-code * compilation (e.g. in TclProcCompileProc) * * When these conditions hold, this function resolves the * passed-in cmd literal into a cmd "y" or "Y" depending on the * context. The resolved procs are taken from the the global * namespace (for simplicity). */ CallFrame *parentFramePtr = varFramePtr->callerPtr; const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)"; if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) { resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/ } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) { resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY); /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/ } } if (resolvedCmdPtr != NULL) { *rPtr = resolvedCmdPtr; return TCL_OK; } } return TCL_CONTINUE; } static int InterpVarResolver( Tcl_Interp *interp, const char *name, Tcl_Namespace *context, int flags, Tcl_Var *rPtr) { /* * Don't resolve the variable; use standard rules. */ return TCL_CONTINUE; } typedef struct MyResolvedVarInfo { Tcl_ResolvedVarInfo vInfo; /* This must be the first element. */ Tcl_Var var; Tcl_Obj *nameObj; } MyResolvedVarInfo; static inline void HashVarFree( Tcl_Var var) { if (VarHashRefCount(var) < 2) { ckfree(var); } else { VarHashRefCount(var)--; } } static void MyCompiledVarFree( Tcl_ResolvedVarInfo *vInfoPtr) { MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vInfoPtr; Tcl_DecrRefCount(resVarInfo->nameObj); if (resVarInfo->var) { HashVarFree(resVarInfo->var); } ckfree(vInfoPtr); } #define TclVarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) static Tcl_Var MyCompiledVarFetch( Tcl_Interp *interp, Tcl_ResolvedVarInfo *vinfoPtr) { MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr; Tcl_Var var = resVarInfo->var; int isNewVar; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; if (var != NULL) { if (!(((Var *) var)->flags & VAR_DEAD_HASH)) { /* * The cached variable is valid, return it. */ return var; } /* * The variable is not valid anymore. Clean it up. */ HashVarFree(var); } hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable, (char *) resVarInfo->nameObj, &isNewVar); if (hPtr) { var = (Tcl_Var) TclVarHashGetValue(hPtr); } else { var = NULL; } resVarInfo->var = var; /* * Increment the reference counter to avoid ckfree() of the variable in * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree(); */ VarHashRefCount(var)++; return var; } static int InterpCompiledVarResolver( Tcl_Interp *interp, const char *name, int length, Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr) { if (*name == 'T') { MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)ckalloc(sizeof(MyResolvedVarInfo)); resVarInfo->vInfo.fetchProc = MyCompiledVarFetch; resVarInfo->vInfo.deleteProc = MyCompiledVarFree; resVarInfo->var = NULL; resVarInfo->nameObj = Tcl_NewStringObj(name, -1); Tcl_IncrRefCount(resVarInfo->nameObj); *rPtr = &resVarInfo->vInfo; return TCL_OK; } return TCL_CONTINUE; } static int TestInterpResolverCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *const table[] = { "down", "up", NULL }; int idx; #define RESOLVER_KEY "testInterpResolver" if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "up|down ?interp?"); return TCL_ERROR; } if (objc == 3) { interp = Tcl_GetChild(interp, Tcl_GetString(objv[2])); if (interp == NULL) { Tcl_AppendResult(interp, "provided interpreter not found", NULL); return TCL_ERROR; } } if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT, &idx) != TCL_OK) { return TCL_ERROR; } switch (idx) { case 1: /* up */ Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver, InterpVarResolver, InterpCompiledVarResolver); break; case 0: /*down*/ if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) { Tcl_AppendResult(interp, "could not remove the resolver scheme", NULL); return TCL_ERROR; } } return TCL_OK; } /* *------------------------------------------------------------------------ * * TestApplyLambdaObjCmd -- * * Implements the Tcl command testapplylambda. This tests the apply * implementation handling of a lambda where the lambda has a list * internal representation where the second element's internal * representation is already a byte code object. * * Results: * TCL_OK - Success. Caller should check result is 42 * TCL_ERROR - Error. * * Side effects: * In the presence of the apply bug, may panic. Otherwise * Interpreter result holds result or error message. * *------------------------------------------------------------------------ */ int TestApplyLambdaObjCmd ( ClientData notUsed, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *lambdaObjs[2]; Tcl_Obj *evalObjs[2]; Tcl_Obj *lambdaObj; int result; /* Create a lambda {{} {set a 42}} */ lambdaObjs[0] = Tcl_NewObj(); /* No parameters */ lambdaObjs[1] = Tcl_NewStringObj("set a 42", -1); /* Body */ lambdaObj = Tcl_NewListObj(2, lambdaObjs); Tcl_IncrRefCount(lambdaObj); /* Create the command "apply {{} {set a 42}" */ evalObjs[0] = Tcl_NewStringObj("apply", -1); Tcl_IncrRefCount(evalObjs[0]); /* * NOTE: IMPORTANT TO EXHIBIT THE BUG. We duplicate the lambda because * it will get shimmered to a Lambda internal representation but we * want to hold on to our list representation. */ evalObjs[1] = Tcl_DuplicateObj(lambdaObj); Tcl_IncrRefCount(evalObjs[1]); /* Evaluate it */ result = Tcl_EvalObjv(interp, 2, evalObjs, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_DecrRefCount(evalObjs[0]); Tcl_DecrRefCount(evalObjs[1]); return result; } /* * So far so good. At this point, * - evalObjs[1] has an internal representation of Lambda * - lambdaObj[1] ({set a 42}) has been shimmered to * an internal representation of ByteCode. */ Tcl_DecrRefCount(evalObjs[1]); /* Don't need this anymore */ /* * The bug trigger. Repeating the command but: * - we are calling apply with a lambda that is a list (as BEFORE), * BUT * - The body of the lambda (lambdaObjs[1]) ALREADY has internal * representation of ByteCode and thus will not be compiled again */ evalObjs[1] = lambdaObj; /* lambdaObj already has a ref count so no need for IncrRef */ result = Tcl_EvalObjv(interp, 2, evalObjs, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(evalObjs[0]); Tcl_DecrRefCount(lambdaObj); return result; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/generic/tclTestObj.c0000644000175000017500000012563414554262142015512 0ustar sergeisergei/* * tclTestObj.c -- * * This file contains C command functions for the additional Tcl commands * that are used for testing implementations of the Tcl object types. * These commands are not normally included in Tcl applications; they're * only used for testing. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #include "tommath.h" #include "tclStringRep.h" /* * Forward declarations for functions defined later in this file: */ static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex); static int GetVariableIndex(Tcl_Interp *interp, const char *string, int *indexPtr); static void SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr); static int TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestbooleanobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestindexobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestintobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestlistobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp) { int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); } Tcl_DeleteAssocData(interp, VARPTR_KEY); ckfree(varPtr); } static Tcl_Obj **GetVarPtr(Tcl_Interp *interp) { Tcl_InterpDeleteProc *proc; return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc); } /* *---------------------------------------------------------------------- * * TclObjTest_Init -- * * This function creates additional commands that are used to test the * Tcl object support. * * Results: * Returns a standard Tcl completion code, and leaves an error * message in the interp's result if an error occurs. * * Side effects: * Creates and registers several new testing commands. * *---------------------------------------------------------------------- */ int TclObjTest_Init( Tcl_Interp *interp) { int i; /* * An array of Tcl_Obj pointers used in the commands that operate on or get * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's * Tcl_Obj *. */ Tcl_Obj **varPtr; varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0])); if (!varPtr) { return TCL_ERROR; } Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr); for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { varPtr[i] = NULL; } Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestbignumobjCmd -- * * This function implements the "testbignumobj" command. It is used * to exercise the bignum Tcl object type implementation. * * Results: * Returns a standard Tcl object result. * * Side effects: * Creates and frees bignum objects; converts objects to have bignum * type. * *---------------------------------------------------------------------- */ static int TestbignumobjCmd( ClientData clientData, /* unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { static const char *const subcmds[] = { "set", "get", "mult10", "div10", "iseven", "radixsize", NULL }; enum options { BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN, BIGNUM_RADIXSIZE }; int index, varIndex; const char *string; mp_int bignumValue; Tcl_Obj **varPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } string = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) { return TCL_ERROR; } varPtr = GetVarPtr(interp); switch (index) { case BIGNUM_SET: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "var value"); return TCL_ERROR; } string = Tcl_GetString(objv[3]); if (mp_init(&bignumValue) != MP_OKAY) { Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_init", -1)); return TCL_ERROR; } if (mp_read_radix(&bignumValue, string, 10) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_read_radix", -1)); return TCL_ERROR; } /* * If the object currently bound to the variable with index varIndex * has ref count 1 (i.e. the object is unshared) we can modify that * object directly. Otherwise, if RC>1 (i.e. the object is shared), * we must create a new object to modify/set and decrement the old * formerly-shared object's ref count. This is "copy on write". */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBignumObj(varPtr[varIndex], &bignumValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue)); } break; case BIGNUM_GET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } break; case BIGNUM_MULT10: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (mp_mul_d(&bignumValue, 10, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_mul_d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBignumObj(varPtr[varIndex], &bignumValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue)); } break; case BIGNUM_DIV10: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (mp_div_d(&bignumValue, 10, &bignumValue, NULL) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_div_d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBignumObj(varPtr[varIndex], &bignumValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue)); } break; case BIGNUM_ISEVEN: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_mod_2d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], mp_iszero(&bignumValue)); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iszero(&bignumValue))); } mp_clear(&bignumValue); break; case BIGNUM_RADIXSIZE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (mp_radix_size(&bignumValue, 10, &index) != MP_OKAY) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], index); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(index)); } mp_clear(&bignumValue); break; } Tcl_SetObjResult(interp, varPtr[varIndex]); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestbooleanobjCmd -- * * This function implements the "testbooleanobj" command. It is used to * test the boolean Tcl object type implementation. * * Results: * A standard Tcl object result. * * Side effects: * Creates and frees boolean objects, and also converts objects to * have boolean type. * *---------------------------------------------------------------------- */ static int TestbooleanobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex, boolValue; const char *index, *subCmd; Tcl_Obj **varPtr; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } varPtr = GetVarPtr(interp); subCmd = Tcl_GetString(objv[1]); if (strcmp(subCmd, "set") == 0) { if (objc != 4) { goto wrongNumArgs; } if (Tcl_GetBooleanFromObj(interp, objv[3], &boolValue) != TCL_OK) { return TCL_ERROR; } /* * If the object currently bound to the variable with index varIndex * has ref count 1 (i.e. the object is unshared) we can modify that * object directly. Otherwise, if RC>1 (i.e. the object is shared), * we must create a new object to modify/set and decrement the old * formerly-shared object's ref count. This is "copy on write". */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBooleanObj(varPtr[varIndex], boolValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "get") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "not") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex], &boolValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBooleanObj(varPtr[varIndex], !boolValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), "\": must be set, get, or not", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestdoubleobjCmd -- * * This function implements the "testdoubleobj" command. It is used to * test the double-precision floating point Tcl object type * implementation. * * Results: * A standard Tcl object result. * * Side effects: * Creates and frees double objects, and also converts objects to * have double type. * *---------------------------------------------------------------------- */ static int TestdoubleobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex; double doubleValue; const char *index, *subCmd, *string; Tcl_Obj **varPtr; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } varPtr = GetVarPtr(interp); index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } subCmd = Tcl_GetString(objv[1]); if (strcmp(subCmd, "set") == 0) { if (objc != 4) { goto wrongNumArgs; } string = Tcl_GetString(objv[3]); if (Tcl_GetDouble(interp, string, &doubleValue) != TCL_OK) { return TCL_ERROR; } /* * If the object currently bound to the variable with index varIndex * has ref count 1 (i.e. the object is unshared) we can modify that * object directly. Otherwise, if RC>1 (i.e. the object is shared), we * must create a new object to modify/set and decrement the old * formerly-shared object's ref count. This is "copy on write". */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetDoubleObj(varPtr[varIndex], doubleValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "get") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "mult10") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex], &doubleValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetDoubleObj(varPtr[varIndex], doubleValue * 10.0); } else { SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue * 10.0)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "div10") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex], &doubleValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetDoubleObj(varPtr[varIndex], doubleValue / 10.0); } else { SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue / 10.0)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), "\": must be set, get, mult10, or div10", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestindexobjCmd -- * * This function implements the "testindexobj" command. It is used to * test the index Tcl object type implementation. * * Results: * A standard Tcl object result. * * Side effects: * Creates and frees int objects, and also converts objects to * have int type. * *---------------------------------------------------------------------- */ static int TestindexobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int allowAbbrev, index, index2, setError, i, result; const char **argv; static const char *const tablePtr[] = {"a", "b", "check", NULL}; /* * Keep this structure declaration in sync with tclIndexObj.c */ struct IndexRep { void *tablePtr; /* Pointer to the table of strings. */ int offset; /* Offset between table entries. */ int index; /* Selected index into table. */ }; struct IndexRep *indexRep; if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "check") == 0)) { /* * This code checks to be sure that the results of Tcl_GetIndexFromObj * are properly cached in the object and returned on subsequent * lookups. */ if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) { return TCL_ERROR; } Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); indexRep = objv[1]->internalRep.twoPtrValue.ptr1; indexRep->index = index2; result = Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), index); } return result; } if (objc < 5) { Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1); return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) { return TCL_ERROR; } argv = ckalloc((objc-3) * sizeof(char *)); for (i = 4; i < objc; i++) { argv[i-4] = Tcl_GetString(objv[i]); } argv[objc-4] = NULL; /* * Tcl_GetIndexFromObj assumes that the table is statically-allocated so * that its address is different for each index object. If we accidentally * allocate a table at the same address as that cached in the index * object, clear out the object's cached state. */ if (objv[3]->typePtr != NULL && !strcmp("index", objv[3]->typePtr->name)) { indexRep = objv[3]->internalRep.twoPtrValue.ptr1; if (indexRep->tablePtr == (void *) argv) { TclFreeIntRep(objv[3]); } } result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3], argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index); ckfree(argv); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), index); } return result; } /* *---------------------------------------------------------------------- * * TestintobjCmd -- * * This function implements the "testintobj" command. It is used to * test the int Tcl object type implementation. * * Results: * A standard Tcl object result. * * Side effects: * Creates and frees int objects, and also converts objects to * have int type. * *---------------------------------------------------------------------- */ static int TestintobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int intValue, varIndex, i; long longValue; const char *index, *subCmd, *string; Tcl_Obj **varPtr; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } varPtr = GetVarPtr(interp); index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } subCmd = Tcl_GetString(objv[1]); if (strcmp(subCmd, "set") == 0) { if (objc != 4) { goto wrongNumArgs; } string = Tcl_GetString(objv[3]); if (Tcl_GetInt(interp, string, &i) != TCL_OK) { return TCL_ERROR; } intValue = i; /* * If the object currently bound to the variable with index varIndex * has ref count 1 (i.e. the object is unshared) we can modify that * object directly. Otherwise, if RC>1 (i.e. the object is shared), we * must create a new object to modify/set and decrement the old * formerly-shared object's ref count. This is "copy on write". */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], intValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */ if (objc != 4) { goto wrongNumArgs; } string = Tcl_GetString(objv[3]); if (Tcl_GetInt(interp, string, &i) != TCL_OK) { return TCL_ERROR; } intValue = i; if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], intValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue)); } } else if (strcmp(subCmd, "setlong") == 0) { if (objc != 4) { goto wrongNumArgs; } string = Tcl_GetString(objv[3]); if (Tcl_GetInt(interp, string, &i) != TCL_OK) { return TCL_ERROR; } intValue = i; if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetLongObj(varPtr[varIndex], intValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "setmaxlong") == 0) { long maxLong = LONG_MAX; if (objc != 3) { goto wrongNumArgs; } if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetLongObj(varPtr[varIndex], maxLong); } else { SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(maxLong)); } } else if (strcmp(subCmd, "ismaxlong") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) { return TCL_ERROR; } Tcl_AppendToObj(Tcl_GetObjResult(interp), ((longValue == LONG_MAX)? "1" : "0"), -1); } else if (strcmp(subCmd, "get") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "get2") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } string = Tcl_GetString(varPtr[varIndex]); Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1); } else if (strcmp(subCmd, "inttoobigtest") == 0) { /* * If long ints have more bits than ints on this platform, verify that * Tcl_GetIntFromObj returns an error if the long int held in an * integer object's internal representation is too large to fit in an * int. */ if (objc != 3) { goto wrongNumArgs; } #if (INT_MAX == LONG_MAX) /* int is same size as long int */ Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1); #else if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetLongObj(varPtr[varIndex], LONG_MAX); } else { SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(LONG_MAX)); } if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1); return TCL_OK; } Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1); #endif } else if (strcmp(subCmd, "mult10") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &intValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], intValue * 10); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "div10") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &intValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], intValue / 10); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), "\": must be set, get, get2, mult10, or div10", NULL); return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * TestlistobjCmd -- * * This function implements the 'testlistobj' command. It is used to * test a few possible corner cases in list object manipulation from * C code that cannot occur at the Tcl level. * * Results: * A standard Tcl object result. * * Side effects: * Creates, manipulates and frees list objects. * *----------------------------------------------------------------------------- */ static int TestlistobjCmd( ClientData clientData, /* Not used */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { /* Subcommands supported by this command */ static const char *const subcommands[] = { "set", "get", "replace" }; enum listobjCmdIndex { LISTOBJ_SET, LISTOBJ_GET, LISTOBJ_REPLACE }; const char* index; /* Argument giving the variable number */ int varIndex; /* Variable number converted to binary */ int cmdIndex; /* Ordinal number of the subcommand */ int first; /* First index in the list */ int count; /* Count of elements in a list */ Tcl_Obj **varPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?"); return TCL_ERROR; } varPtr = GetVarPtr(interp); index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command", 0, &cmdIndex) != TCL_OK) { return TCL_ERROR; } switch(cmdIndex) { case LISTOBJ_SET: if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3); } else { SetVarToObj(varPtr, varIndex, Tcl_NewListObj(objc-3, objv+3)); } Tcl_SetObjResult(interp, varPtr[varIndex]); break; case LISTOBJ_GET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); break; case LISTOBJ_REPLACE: if (objc < 5) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex start count ?element...?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK || Tcl_GetIntFromObj(interp, objv[4], &count) != TCL_OK) { return TCL_ERROR; } if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } Tcl_ResetResult(interp); return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count, objc-5, objv+5); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestobjCmd -- * * This function implements the "testobj" command. It is used to test * the type-independent portions of the Tcl object type implementation. * * Results: * A standard Tcl object result. * * Side effects: * Creates and frees objects. * *---------------------------------------------------------------------- */ static int TestobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex, destIndex, i; const char *index, *subCmd, *string; const Tcl_ObjType *targetType; Tcl_Obj **varPtr; if (objc < 2) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } varPtr = GetVarPtr(interp); subCmd = Tcl_GetString(objv[1]); if (strcmp(subCmd, "assign") == 0) { if (objc != 4) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } string = Tcl_GetString(objv[3]); if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) { return TCL_ERROR; } SetVarToObj(varPtr, destIndex, varPtr[varIndex]); Tcl_SetObjResult(interp, varPtr[destIndex]); } else if (strcmp(subCmd, "bug3598580") == 0) { Tcl_Obj *listObjPtr, *elemObjPtr; if (objc != 2) { goto wrongNumArgs; } elemObjPtr = Tcl_NewIntObj(123); listObjPtr = Tcl_NewListObj(1, &elemObjPtr); /* Replace the single list element through itself, nonsense but legal. */ Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr); Tcl_SetObjResult(interp, listObjPtr); return TCL_OK; } else if (strcmp(subCmd, "convert") == 0) { const char *typeName; if (objc != 4) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } typeName = Tcl_GetString(objv[3]); if ((targetType = Tcl_GetObjType(typeName)) == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "no type ", typeName, " found", NULL); return TCL_ERROR; } if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "duplicate") == 0) { if (objc != 4) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } string = Tcl_GetString(objv[3]); if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) { return TCL_ERROR; } SetVarToObj(varPtr, destIndex, Tcl_DuplicateObj(varPtr[varIndex])); Tcl_SetObjResult(interp, varPtr[destIndex]); } else if (strcmp(subCmd, "freeallvars") == 0) { if (objc != 2) { goto wrongNumArgs; } for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i] != NULL) { Tcl_DecrRefCount(varPtr[i]); varPtr[i] = NULL; } } } else if (strcmp(subCmd, "invalidateStringRep") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } Tcl_InvalidateStringRep(varPtr[varIndex]); Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "newobj") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } SetVarToObj(varPtr, varIndex, Tcl_NewObj()); Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "objtype") == 0) { const char *typeName; /* * Return an object containing the name of the argument's type of * internal rep. If none exists, return "none". */ if (objc != 3) { goto wrongNumArgs; } if (objv[2]->typePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { typeName = objv[2]->typePtr->name; Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1)); } } else if (strcmp(subCmd, "refcount") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount)); } else if (strcmp(subCmd, "type") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (varPtr[varIndex]->typePtr == NULL) { /* a string! */ Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1); } else { Tcl_AppendToObj(Tcl_GetObjResult(interp), varPtr[varIndex]->typePtr->name, -1); } } else if (strcmp(subCmd, "types") == 0) { if (objc != 2) { goto wrongNumArgs; } if (Tcl_AppendAllObjTypes(interp, Tcl_GetObjResult(interp)) != TCL_OK) { return TCL_ERROR; } } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), "\": must be assign, convert, duplicate, freeallvars, " "newobj, objcount, objtype, refcount, type, or types", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TeststringobjCmd -- * * This function implements the "teststringobj" command. It is used to * test the string Tcl object type implementation. * * Results: * A standard Tcl object result. * * Side effects: * Creates and frees string objects, and also converts objects to * have string type. * *---------------------------------------------------------------------- */ static int TeststringobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; int varIndex, option, i, length; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; String *strPtr; Tcl_Obj **varPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", "set", "set2", "setlength", "maxchars", "range", "getunicode", "appendself", "appendself2", NULL }; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } varPtr = GetVarPtr(interp); index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option) != TCL_OK) { return TCL_ERROR; } switch (option) { case 0: /* append */ if (objc != 5) { goto wrongNumArgs; } if (Tcl_GetIntFromObj(interp, objv[4], &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } /* * If the object bound to variable "varIndex" is shared, we must * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } string = Tcl_GetString(objv[3]); Tcl_AppendToObj(varPtr[varIndex], string, length); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 1: /* appendstrings */ if (objc > (MAX_STRINGS+3)) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } /* * If the object bound to variable "varIndex" is shared, we must * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } for (i = 3; i < objc; i++) { strings[i-3] = Tcl_GetString(objv[i]); } for ( ; i < 12 + 3; i++) { strings[i - 3] = NULL; } Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1], strings[2], strings[3], strings[4], strings[5], strings[6], strings[7], strings[8], strings[9], strings[10], strings[11]); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 2: /* get */ if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 3: /* get2 */ if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr, varIndex)) { return TCL_ERROR; } string = Tcl_GetString(varPtr[varIndex]); Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1); break; case 4: /* length */ if (objc != 3) { goto wrongNumArgs; } Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) ? varPtr[varIndex]->length : -1); break; case 5: /* length2 */ if (objc != 3) { goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { Tcl_ConvertToType(NULL, varPtr[varIndex], Tcl_GetObjType("string")); strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = (int) strPtr->allocated; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; case 6: /* set */ if (objc != 4) { goto wrongNumArgs; } /* * If the object currently bound to the variable with index * varIndex has ref count 1 (i.e. the object is unshared) we can * modify that object directly. Otherwise, if RC>1 (i.e. the * object is shared), we must create a new object to modify/set * and decrement the old formerly-shared object's ref count. This * is "copy on write". */ string = Tcl_GetStringFromObj(objv[3], &length); if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetStringObj(varPtr[varIndex], string, length); } else { SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length)); } Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 7: /* set2 */ if (objc != 4) { goto wrongNumArgs; } SetVarToObj(varPtr, varIndex, objv[3]); break; case 8: /* setlength */ if (objc != 4) { goto wrongNumArgs; } if (Tcl_GetIntFromObj(interp, objv[3], &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] != NULL) { Tcl_SetObjLength(varPtr[varIndex], length); } break; case 9: /* maxchars */ if (objc != 3) { goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { Tcl_ConvertToType(NULL, varPtr[varIndex], Tcl_GetObjType("string")); strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; case 10: { /* range */ int first, last; if (objc != 5) { goto wrongNumArgs; } if ((Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &last) != TCL_OK)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last)); break; } case 11: /* getunicode */ if (objc != 3) { goto wrongNumArgs; } Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL); break; case 12: /* appendself */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } /* * If the object bound to variable "varIndex" is shared, we must * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } string = Tcl_GetStringFromObj(varPtr[varIndex], &length); if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { return TCL_ERROR; } if ((i < 0) || (i > length)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 13: /* appendself2 */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } /* * If the object bound to variable "varIndex" is shared, we must * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length); if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { return TCL_ERROR; } if ((i < 0) || (i > length)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; } return TCL_OK; } /* *---------------------------------------------------------------------- * * SetVarToObj -- * * Utility routine to assign a Tcl_Obj* to a test variable. The * Tcl_Obj* can be NULL. * * Results: * None. * * Side effects: * This routine handles ref counting details for assignment: i.e. the old * value's ref count must be decremented (if not NULL) and the new one * incremented (also if not NULL). * *---------------------------------------------------------------------- */ static void SetVarToObj( Tcl_Obj **varPtr, int varIndex, /* Designates the assignment variable. */ Tcl_Obj *objPtr) /* Points to object to assign to var. */ { if (varPtr[varIndex] != NULL) { Tcl_DecrRefCount(varPtr[varIndex]); } varPtr[varIndex] = objPtr; if (objPtr != NULL) { Tcl_IncrRefCount(objPtr); } } /* *---------------------------------------------------------------------- * * GetVariableIndex -- * * Utility routine to get a test variable index from the command line. * * Results: * A standard Tcl object result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetVariableIndex( Tcl_Interp *interp, /* Interpreter for error reporting. */ const char *string, /* String containing a variable index * specified as a nonnegative number less than * NUMBER_OF_OBJECT_VARS. */ int *indexPtr) /* Place to store converted result. */ { int index; if (Tcl_GetInt(interp, string, &index) != TCL_OK) { return TCL_ERROR; } if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1); return TCL_ERROR; } *indexPtr = index; return TCL_OK; } /* *---------------------------------------------------------------------- * * CheckIfVarUnset -- * * Utility function that checks whether a test variable is readable: * i.e., that varPtr[varIndex] is non-NULL. * * Results: * 1 if the test variable is unset (NULL); 0 otherwise. * * Side effects: * Sets the interpreter result to an error message if the variable is * unset (NULL). * *---------------------------------------------------------------------- */ static int CheckIfVarUnset( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tcl_Obj ** varPtr, int varIndex) /* Index of the test variable to check. */ { if (varPtr[varIndex] == NULL) { char buf[32 + TCL_INTEGER_SPACE]; snprintf(buf, sizeof(buf), "variable %d is unset (NULL)", varIndex); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1); return 1; } return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclTestProcBodyObj.c0000644000175000017500000002175714554262142017155 0ustar sergeisergei/* * tclTestProcBodyObj.c -- * * Implements the "procbodytest" package, which contains commands to test * creation of Tcl procedures whose body argument is a Tcl_Obj of type * "procbody" rather than a string. * * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" /* * name and version of this package */ static const char packageName[] = "procbodytest"; static const char packageVersion[] = "1.1"; /* * Name of the commands exported by this package */ static const char procCommand[] = "proc"; static const char checkCommand[] = "check"; /* * this struct describes an entry in the table of command names and command * procs */ typedef struct CmdTable { const char *cmdName; /* command name */ Tcl_ObjCmdProc *proc; /* command proc */ int exportIt; /* if 1, export the command */ } CmdTable; /* * Declarations for functions defined in this file. */ static int ProcBodyTestProcObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestCheckObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); static int RegisterCommand(Tcl_Interp* interp, const char *namespace, const CmdTable *cmdTablePtr); /* * List of commands to create when the package is loaded; must go after the * declarations of the enable command procedure. */ static const CmdTable commands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, { checkCommand, ProcBodyTestCheckObjCmd, 1 }, { 0, 0, 0 } }; static const CmdTable safeCommands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, { checkCommand, ProcBodyTestCheckObjCmd, 1 }, { 0, 0, 0 } }; /* *---------------------------------------------------------------------- * * Procbodytest_Init -- * * This function initializes the "procbodytest" package. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Procbodytest_Init( Tcl_Interp *interp) /* the Tcl interpreter for which the package * is initialized */ { return ProcBodyTestInitInternal(interp, 0); } /* *---------------------------------------------------------------------- * * Procbodytest_SafeInit -- * * This function initializes the "procbodytest" package. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Procbodytest_SafeInit( Tcl_Interp *interp) /* the Tcl interpreter for which the package * is initialized */ { return ProcBodyTestInitInternal(interp, 1); } /* *---------------------------------------------------------------------- * * RegisterCommand -- * * This function registers a command in the context of the given * namespace. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int RegisterCommand( Tcl_Interp* interp, /* the Tcl interpreter for which the operation * is performed */ const char *namespace, /* the namespace in which the command is * registered */ const CmdTable *cmdTablePtr)/* the command to register */ { char buf[128]; if (cmdTablePtr->exportIt) { snprintf(buf, sizeof(buf), "namespace eval %s { namespace export %s }", namespace, cmdTablePtr->cmdName); if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) { return TCL_ERROR; } } snprintf(buf, sizeof(buf), "%s::%s", namespace, cmdTablePtr->cmdName); Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0); return TCL_OK; } /* *---------------------------------------------------------------------- * * ProcBodyTestInitInternal -- * * This function initializes the Loader package. * The isSafe flag is 1 if the interpreter is safe, 0 otherwise. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ProcBodyTestInitInternal( Tcl_Interp *interp, /* the Tcl interpreter for which the package * is initialized */ int isSafe) /* 1 if this is a safe interpreter */ { const CmdTable *cmdTablePtr; cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0]; for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) { if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) { return TCL_ERROR; } } return Tcl_PkgProvide(interp, packageName, packageVersion); } /* *---------------------------------------------------------------------- * * ProcBodyTestProcObjCmd -- * * Implements the "procbodytest::proc" command. Here is the command * description: * procbodytest::proc newName argList bodyName * Looks up a procedure called $bodyName and, if the procedure exists, * constructs a Tcl_Obj of type "procbody" and calls Tcl_ProcObjCmd. * Arguments: * newName the name of the procedure to be created * argList the argument list for the procedure * bodyName the name of an existing procedure from which the * body is to be copied. * This command can be used to trigger the branches in Tcl_ProcObjCmd that * construct a proc from a "procbody", for example: * proc a {x} {return $x} * a 123 * procbodytest::proc b {x} a * Note the call to "a 123", which is necessary so that the Proc pointer * for "a" is filled in by the internal compiler; this is a hack. * * Results: * Returns a standard Tcl code. * * Side effects: * A new procedure is created. * Leaves an error message in the interp's result on error. * *---------------------------------------------------------------------- */ static int ProcBodyTestProcObjCmd( ClientData dummy, /* context; not used */ Tcl_Interp *interp, /* the current interpreter */ int objc, /* argument count */ Tcl_Obj *const objv[]) /* arguments */ { const char *fullName; Tcl_Command procCmd; Command *cmdPtr; Proc *procPtr = NULL; Tcl_Obj *bodyObjPtr; Tcl_Obj *myobjv[5]; int result; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName"); return TCL_ERROR; } /* * Find the Command pointer to this procedure */ fullName = Tcl_GetString(objv[3]); procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG); if (procCmd == NULL) { return TCL_ERROR; } cmdPtr = (Command *) procCmd; /* * check that this is a procedure and not a builtin command: * If a procedure, cmdPtr->objClientData is TclIsProc(cmdPtr). */ if (cmdPtr->objClientData != TclIsProc(cmdPtr)) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "command \"", fullName, "\" is not a Tcl procedure", NULL); return TCL_ERROR; } /* * it is a Tcl procedure: the client data is the Proc structure */ procPtr = (Proc *) cmdPtr->objClientData; if (procPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "procedure \"", fullName, "\" does not have a Proc struct!", NULL); return TCL_ERROR; } /* * create a new object, initialize our argument vector, call into Tcl */ bodyObjPtr = TclNewProcBodyObj(procPtr); if (bodyObjPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "failed to create a procbody object for procedure \"", fullName, "\"", NULL); return TCL_ERROR; } Tcl_IncrRefCount(bodyObjPtr); myobjv[0] = objv[0]; myobjv[1] = objv[1]; myobjv[2] = objv[2]; myobjv[3] = bodyObjPtr; myobjv[4] = NULL; result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv); Tcl_DecrRefCount(bodyObjPtr); return result; } /* *---------------------------------------------------------------------- * * ProcBodyTestCheckObjCmd -- * * Implements the "procbodytest::check" command. Here is the command * description: * procbodytest::check * * Performs an internal check that the Tcl_PkgPresent() command returns * the same version number as was registered when the procbodytest package * was provided. Places a boolean in the interp result indicating the * test outcome. * * Results: * Returns a standard Tcl code. * *---------------------------------------------------------------------- */ static int ProcBodyTestCheckObjCmd( ClientData dummy, /* context; not used */ Tcl_Interp *interp, /* the current interpreter */ int objc, /* argument count */ Tcl_Obj *const objv[]) /* arguments */ { const char *version; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); Tcl_SetObjResult(interp, Tcl_NewBooleanObj( strcmp(version, packageVersion) == 0)); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclThreadAlloc.c0000644000175000017500000006734214554262142016323 0ustar sergeisergei/* * tclThreadAlloc.c -- * * This is a very fast storage allocator for used with threads (designed * avoid lock contention). The basic strategy is to allocate memory in * fixed size blocks from block caches. * * The Initial Developer of the Original Code is America Online, Inc. * Portions created by AOL are Copyright (C) 1999 America Online, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) /* * If range checking is enabled, an additional byte will be allocated to store * the magic number at the end of the requested memory. */ #ifndef RCHECK #ifdef NDEBUG #define RCHECK 0 #else #define RCHECK 1 #endif #endif /* * The following define the number of Tcl_Obj's to allocate/move at a time and * the high water mark to prune a per-thread cache. On a 32 bit system, * sizeof(Tcl_Obj) = 24 so 800 * 24 = ~16k. */ #define NOBJALLOC 800 /* Actual definition moved to tclInt.h */ #define NOBJHIGH ALLOC_NOBJHIGH /* * The following union stores accounting information for each block including * two small magic numbers and a bucket number when in use or a next pointer * when free. The original requested size (not including the Block overhead) * is also maintained. */ typedef union Block { struct { union { union Block *next; /* Next in free list. */ struct { unsigned char magic1; /* First magic number. */ unsigned char bucket; /* Bucket block allocated from. */ unsigned char unused; /* Padding. */ unsigned char magic2; /* Second magic number. */ } s; } u; size_t reqSize; /* Requested allocation size. */ } b; unsigned char padding[TCL_ALLOCALIGN]; } Block; #define nextBlock b.u.next #define sourceBucket b.u.s.bucket #define magicNum1 b.u.s.magic1 #define magicNum2 b.u.s.magic2 #define MAGIC 0xEF #define blockReqSize b.reqSize /* * The following defines the minimum and and maximum block sizes and the number * of buckets in the bucket cache. */ #define MINALLOC ((sizeof(Block) + 8 + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (11 - (MINALLOC >> 5)) #define MAXALLOC (MINALLOC << (NBUCKETS - 1)) /* * The following structure defines a bucket of blocks with various accounting * and statistics information. */ typedef struct Bucket { Block *firstPtr; /* First block available */ Block *lastPtr; /* End of block list */ long numFree; /* Number of blocks available */ /* All fields below for accounting only */ long numRemoves; /* Number of removes from bucket */ long numInserts; /* Number of inserts into bucket */ long numWaits; /* Number of waits to acquire a lock */ long numLocks; /* Number of locks acquired */ long totalAssigned; /* Total space assigned to bucket */ } Bucket; /* * The following structure defines a cache of buckets and objs, of which there * will be (at most) one per thread. Any changes need to be reflected in the * struct AllocCache defined in tclInt.h, possibly also in the initialisation * code in Tcl_CreateInterp(). */ typedef struct Cache { struct Cache *nextPtr; /* Linked list of cache entries */ Tcl_ThreadId owner; /* Which thread's cache is this? */ Tcl_Obj *firstObjPtr; /* List of free objects for thread */ int numObjects; /* Number of objects for thread */ Tcl_Obj *lastPtr; /* Last object in this cache */ int totalAssigned; /* Total space assigned to thread */ Bucket buckets[NBUCKETS]; /* The buckets for this thread */ } Cache; /* * The following array specifies various per-bucket limits and locks. The * values are statically initialized to avoid calculating them repeatedly. */ static struct { size_t blockSize; /* Bucket blocksize. */ int maxBlocks; /* Max blocks before move to share. */ int numMove; /* Num blocks to move to share. */ Tcl_Mutex *lockPtr; /* Share bucket lock. */ } bucketInfo[NBUCKETS]; /* * Static functions defined in this file. */ static Cache * GetCache(void); static void LockBucket(Cache *cachePtr, int bucket); static void UnlockBucket(Cache *cachePtr, int bucket); static void PutBlocks(Cache *cachePtr, int bucket, int numMove); static int GetBlocks(Cache *cachePtr, int bucket); static Block * Ptr2Block(char *ptr); static char * Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize); static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove); static void PutObjs(Cache *fromPtr, int numMove); /* * Local variables defined in this file and initialized at startup. */ static Tcl_Mutex *listLockPtr; static Tcl_Mutex *objLockPtr; static Cache sharedCache; static Cache *sharedPtr = &sharedCache; static Cache *firstCachePtr = &sharedCache; #if defined(HAVE_FAST_TSD) static __thread Cache *tcachePtr; # define GETCACHE(cachePtr) \ do { \ if (!tcachePtr) { \ tcachePtr = GetCache(); \ } \ (cachePtr) = tcachePtr; \ } while (0) #else # define GETCACHE(cachePtr) \ do { \ (cachePtr) = TclpGetAllocCache(); \ if ((cachePtr) == NULL) { \ (cachePtr) = GetCache(); \ } \ } while (0) #endif /* *---------------------------------------------------------------------- * * GetCache --- * * Gets per-thread memory cache, allocating it if necessary. * * Results: * Pointer to cache. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Cache * GetCache(void) { Cache *cachePtr; /* * Check for first-time initialization. */ if (listLockPtr == NULL) { Tcl_Mutex *initLockPtr; unsigned int i; initLockPtr = Tcl_GetAllocMutex(); Tcl_MutexLock(initLockPtr); if (listLockPtr == NULL) { listLockPtr = TclpNewAllocMutex(); objLockPtr = TclpNewAllocMutex(); for (i = 0; i < NBUCKETS; ++i) { bucketInfo[i].blockSize = MINALLOC << i; bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i); bucketInfo[i].numMove = i < NBUCKETS - 1 ? 1 << (NBUCKETS - 2 - i) : 1; bucketInfo[i].lockPtr = TclpNewAllocMutex(); } } Tcl_MutexUnlock(initLockPtr); } /* * Get this thread's cache, allocating if necessary. */ cachePtr = TclpGetAllocCache(); if (cachePtr == NULL) { cachePtr = TclpSysAlloc(sizeof(Cache), 0); if (cachePtr == NULL) { Tcl_Panic("alloc: could not allocate new cache"); } memset(cachePtr, 0, sizeof(Cache)); Tcl_MutexLock(listLockPtr); cachePtr->nextPtr = firstCachePtr; firstCachePtr = cachePtr; Tcl_MutexUnlock(listLockPtr); cachePtr->owner = Tcl_GetCurrentThread(); TclpSetAllocCache(cachePtr); } return cachePtr; } /* *---------------------------------------------------------------------- * * TclFreeAllocCache -- * * Flush and delete a cache, removing from list of caches. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFreeAllocCache( void *arg) { Cache *cachePtr = arg; Cache **nextPtrPtr; unsigned int bucket; /* * Flush blocks. */ for (bucket = 0; bucket < NBUCKETS; ++bucket) { if (cachePtr->buckets[bucket].numFree > 0) { PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].numFree); } } /* * Flush objs. */ if (cachePtr->numObjects > 0) { PutObjs(cachePtr, cachePtr->numObjects); } /* * Remove from pool list. */ Tcl_MutexLock(listLockPtr); nextPtrPtr = &firstCachePtr; while (*nextPtrPtr != cachePtr) { nextPtrPtr = &(*nextPtrPtr)->nextPtr; } *nextPtrPtr = cachePtr->nextPtr; cachePtr->nextPtr = NULL; Tcl_MutexUnlock(listLockPtr); TclpSysFree(cachePtr); } /* *---------------------------------------------------------------------- * * TclpAlloc -- * * Allocate memory. * * Results: * Pointer to memory just beyond Block pointer. * * Side effects: * May allocate more blocks for a bucket. * *---------------------------------------------------------------------- */ char * TclpAlloc( unsigned int reqSize) { Cache *cachePtr; Block *blockPtr; int bucket; size_t size; #ifndef __LP64__ if (sizeof(int) >= sizeof(size_t)) { /* An unsigned int overflow can also be a size_t overflow */ const size_t zero = 0; const size_t max = ~zero; if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { /* Requested allocation exceeds memory */ return NULL; } } #endif GETCACHE(cachePtr); /* * Increment the requested size to include room for the Block structure. * Call TclpSysAlloc() directly if the required amount is greater than the * largest block, otherwise pop the smallest block large enough, * allocating more blocks if necessary. */ blockPtr = NULL; size = reqSize + sizeof(Block); #if RCHECK size++; #endif if (size > MAXALLOC) { bucket = NBUCKETS; blockPtr = TclpSysAlloc(size, 0); if (blockPtr != NULL) { cachePtr->totalAssigned += reqSize; } } else { bucket = 0; while (bucketInfo[bucket].blockSize < size) { bucket++; } if (cachePtr->buckets[bucket].numFree || GetBlocks(cachePtr, bucket)) { blockPtr = cachePtr->buckets[bucket].firstPtr; cachePtr->buckets[bucket].firstPtr = blockPtr->nextBlock; cachePtr->buckets[bucket].numFree--; cachePtr->buckets[bucket].numRemoves++; cachePtr->buckets[bucket].totalAssigned += reqSize; } } if (blockPtr == NULL) { return NULL; } return Block2Ptr(blockPtr, bucket, reqSize); } /* *---------------------------------------------------------------------- * * TclpFree -- * * Return blocks to the thread block cache. * * Results: * None. * * Side effects: * May move blocks to shared cache. * *---------------------------------------------------------------------- */ void TclpFree( char *ptr) { Cache *cachePtr; Block *blockPtr; int bucket; if (ptr == NULL) { return; } GETCACHE(cachePtr); /* * Get the block back from the user pointer and call system free directly * for large blocks. Otherwise, push the block back on the bucket and move * blocks to the shared cache if there are now too many free. */ blockPtr = Ptr2Block(ptr); bucket = blockPtr->sourceBucket; if (bucket == NBUCKETS) { cachePtr->totalAssigned -= blockPtr->blockReqSize; TclpSysFree(blockPtr); return; } cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize; blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr; cachePtr->buckets[bucket].firstPtr = blockPtr; if (cachePtr->buckets[bucket].numFree == 0) { cachePtr->buckets[bucket].lastPtr = blockPtr; } cachePtr->buckets[bucket].numFree++; cachePtr->buckets[bucket].numInserts++; if (cachePtr != sharedPtr && cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) { PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove); } } /* *---------------------------------------------------------------------- * * TclpRealloc -- * * Re-allocate memory to a larger or smaller size. * * Results: * Pointer to memory just beyond Block pointer. * * Side effects: * Previous memory, if any, may be freed. * *---------------------------------------------------------------------- */ char * TclpRealloc( char *ptr, unsigned int reqSize) { Cache *cachePtr; Block *blockPtr; void *newPtr; size_t size, min; int bucket; if (ptr == NULL) { return TclpAlloc(reqSize); } #ifndef __LP64__ if (sizeof(int) >= sizeof(size_t)) { /* An unsigned int overflow can also be a size_t overflow */ const size_t zero = 0; const size_t max = ~zero; if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { /* Requested allocation exceeds memory */ return NULL; } } #endif GETCACHE(cachePtr); /* * If the block is not a system block and fits in place, simply return the * existing pointer. Otherwise, if the block is a system block and the new * size would also require a system block, call TclpSysRealloc() directly. */ blockPtr = Ptr2Block(ptr); size = reqSize + sizeof(Block); #if RCHECK size++; #endif bucket = blockPtr->sourceBucket; if (bucket != NBUCKETS) { if (bucket > 0) { min = bucketInfo[bucket-1].blockSize; } else { min = 0; } if (size > min && size <= bucketInfo[bucket].blockSize) { cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize; cachePtr->buckets[bucket].totalAssigned += reqSize; return Block2Ptr(blockPtr, bucket, reqSize); } } else if (size > MAXALLOC) { cachePtr->totalAssigned -= blockPtr->blockReqSize; cachePtr->totalAssigned += reqSize; blockPtr = TclpSysRealloc(blockPtr, size); if (blockPtr == NULL) { return NULL; } return Block2Ptr(blockPtr, NBUCKETS, reqSize); } /* * Finally, perform an expensive malloc/copy/free. */ newPtr = TclpAlloc(reqSize); if (newPtr != NULL) { if (reqSize > blockPtr->blockReqSize) { reqSize = blockPtr->blockReqSize; } memcpy(newPtr, ptr, reqSize); TclpFree(ptr); } return newPtr; } /* *---------------------------------------------------------------------- * * TclThreadAllocObj -- * * Allocate a Tcl_Obj from the per-thread cache. * * Results: * Pointer to uninitialized Tcl_Obj. * * Side effects: * May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's if * list is empty. * * Note: * If this code is updated, the changes need to be reflected in the macro * TclAllocObjStorageEx() defined in tclInt.h * *---------------------------------------------------------------------- */ Tcl_Obj * TclThreadAllocObj(void) { Cache *cachePtr; Tcl_Obj *objPtr; GETCACHE(cachePtr); /* * Get this thread's obj list structure and move or allocate new objs if * necessary. */ if (cachePtr->numObjects == 0) { int numMove; Tcl_MutexLock(objLockPtr); numMove = sharedPtr->numObjects; if (numMove > 0) { if (numMove > NOBJALLOC) { numMove = NOBJALLOC; } MoveObjs(sharedPtr, cachePtr, numMove); } Tcl_MutexUnlock(objLockPtr); if (cachePtr->numObjects == 0) { Tcl_Obj *newObjsPtr; cachePtr->numObjects = numMove = NOBJALLOC; newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0); if (newObjsPtr == NULL) { Tcl_Panic("alloc: could not allocate %d new objects", numMove); } cachePtr->lastPtr = newObjsPtr + numMove - 1; objPtr = cachePtr->firstObjPtr; /* NULL */ while (--numMove >= 0) { newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr; objPtr = newObjsPtr + numMove; } cachePtr->firstObjPtr = newObjsPtr; } } /* * Pop the first object. */ objPtr = cachePtr->firstObjPtr; cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1; cachePtr->numObjects--; return objPtr; } /* *---------------------------------------------------------------------- * * TclThreadFreeObj -- * * Return a free Tcl_Obj to the per-thread cache. * * Results: * None. * * Side effects: * May move free Tcl_Obj's to shared list upon hitting high water mark. * * Note: * If this code is updated, the changes need to be reflected in the macro * TclAllocObjStorageEx() defined in tclInt.h * *---------------------------------------------------------------------- */ void TclThreadFreeObj( Tcl_Obj *objPtr) { Cache *cachePtr; GETCACHE(cachePtr); /* * Get this thread's list and push on the free Tcl_Obj. */ objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; cachePtr->firstObjPtr = objPtr; if (cachePtr->numObjects == 0) { cachePtr->lastPtr = objPtr; } cachePtr->numObjects++; /* * If the number of free objects has exceeded the high water mark, move * some blocks to the shared list. */ if (cachePtr->numObjects > NOBJHIGH) { PutObjs(cachePtr, NOBJALLOC); } } /* *---------------------------------------------------------------------- * * Tcl_GetMemoryInfo -- * * Return a list-of-lists of memory stats. * * Results: * None. * * Side effects: * List appended to given dstring. * *---------------------------------------------------------------------- */ void Tcl_GetMemoryInfo( Tcl_DString *dsPtr) { Cache *cachePtr; char buf[200]; unsigned int n; Tcl_MutexLock(listLockPtr); cachePtr = firstCachePtr; while (cachePtr != NULL) { Tcl_DStringStartSublist(dsPtr); if (cachePtr == sharedPtr) { Tcl_DStringAppendElement(dsPtr, "shared"); } else { snprintf(buf, sizeof(buf), "thread%p", cachePtr->owner); Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { snprintf(buf, sizeof(buf), "%lu %ld %ld %ld %ld %ld %ld", (unsigned long) bucketInfo[n].blockSize, cachePtr->buckets[n].numFree, cachePtr->buckets[n].numRemoves, cachePtr->buckets[n].numInserts, cachePtr->buckets[n].totalAssigned, cachePtr->buckets[n].numLocks, cachePtr->buckets[n].numWaits); Tcl_DStringAppendElement(dsPtr, buf); } Tcl_DStringEndSublist(dsPtr); cachePtr = cachePtr->nextPtr; } Tcl_MutexUnlock(listLockPtr); } /* *---------------------------------------------------------------------- * * MoveObjs -- * * Move Tcl_Obj's between caches. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void MoveObjs( Cache *fromPtr, Cache *toPtr, int numMove) { Tcl_Obj *objPtr = fromPtr->firstObjPtr; Tcl_Obj *fromFirstObjPtr = objPtr; toPtr->numObjects += numMove; fromPtr->numObjects -= numMove; /* * Find the last object to be moved; set the next one (the first one not * to be moved) as the first object in the 'from' cache. */ while (--numMove) { objPtr = objPtr->internalRep.twoPtrValue.ptr1; } fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * Move all objects as a block - they are already linked to each other, we * just have to update the first and last. */ toPtr->lastPtr = objPtr; objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr; /* NULL */ toPtr->firstObjPtr = fromFirstObjPtr; } /* *---------------------------------------------------------------------- * * PutObjs -- * * Move Tcl_Obj's from thread cache to shared cache. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PutObjs( Cache *fromPtr, int numMove) { int keep = fromPtr->numObjects - numMove; Tcl_Obj *firstPtr, *lastPtr = NULL; fromPtr->numObjects = keep; firstPtr = fromPtr->firstObjPtr; if (keep == 0) { fromPtr->firstObjPtr = NULL; } else { do { lastPtr = firstPtr; firstPtr = firstPtr->internalRep.twoPtrValue.ptr1; } while (--keep > 0); lastPtr->internalRep.twoPtrValue.ptr1 = NULL; } /* * Move all objects as a block - they are already linked to each other, we * just have to update the first and last. */ Tcl_MutexLock(objLockPtr); fromPtr->lastPtr->internalRep.twoPtrValue.ptr1 = sharedPtr->firstObjPtr; sharedPtr->firstObjPtr = firstPtr; if (sharedPtr->numObjects == 0) { sharedPtr->lastPtr = fromPtr->lastPtr; } sharedPtr->numObjects += numMove; Tcl_MutexUnlock(objLockPtr); fromPtr->lastPtr = lastPtr; } /* *---------------------------------------------------------------------- * * Block2Ptr, Ptr2Block -- * * Convert between internal blocks and user pointers. * * Results: * User pointer or internal block. * * Side effects: * Invalid blocks will abort the server. * *---------------------------------------------------------------------- */ static char * Block2Ptr( Block *blockPtr, int bucket, unsigned int reqSize) { void *ptr; blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC; blockPtr->sourceBucket = bucket; blockPtr->blockReqSize = reqSize; ptr = ((void *) (blockPtr + 1)); #if RCHECK ((unsigned char *)(ptr))[reqSize] = MAGIC; #endif return (char *) ptr; } static Block * Ptr2Block( char *ptr) { Block *blockPtr; blockPtr = (((Block *) ptr) - 1); if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) { Tcl_Panic("alloc: invalid block: %p: %x %x", blockPtr, blockPtr->magicNum1, blockPtr->magicNum2); } #if RCHECK if (((unsigned char *) ptr)[blockPtr->blockReqSize] != MAGIC) { Tcl_Panic("alloc: invalid block: %p: %x %x %x", blockPtr, blockPtr->magicNum1, blockPtr->magicNum2, ((unsigned char *) ptr)[blockPtr->blockReqSize]); } #endif return blockPtr; } /* *---------------------------------------------------------------------- * * LockBucket, UnlockBucket -- * * Set/unset the lock to access a bucket in the shared cache. * * Results: * None. * * Side effects: * Lock activity and contention are monitored globally and on a per-cache * basis. * *---------------------------------------------------------------------- */ static void LockBucket( Cache *cachePtr, int bucket) { Tcl_MutexLock(bucketInfo[bucket].lockPtr); cachePtr->buckets[bucket].numLocks++; sharedPtr->buckets[bucket].numLocks++; } static void UnlockBucket( Cache *cachePtr, int bucket) { Tcl_MutexUnlock(bucketInfo[bucket].lockPtr); } /* *---------------------------------------------------------------------- * * PutBlocks -- * * Return unused blocks to the shared cache. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PutBlocks( Cache *cachePtr, int bucket, int numMove) { /* * We have numFree. Want to shed numMove. So compute how many * Blocks to keep. */ int keep = cachePtr->buckets[bucket].numFree - numMove; Block *lastPtr = NULL, *firstPtr; cachePtr->buckets[bucket].numFree = keep; firstPtr = cachePtr->buckets[bucket].firstPtr; if (keep == 0) { cachePtr->buckets[bucket].firstPtr = NULL; } else { do { lastPtr = firstPtr; firstPtr = firstPtr->nextBlock; } while (--keep > 0); lastPtr->nextBlock = NULL; } /* * Aquire the lock and place the list of blocks at the front of the shared * cache bucket. */ LockBucket(cachePtr, bucket); cachePtr->buckets[bucket].lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr; sharedPtr->buckets[bucket].firstPtr = firstPtr; if (sharedPtr->buckets[bucket].numFree == 0) { sharedPtr->buckets[bucket].lastPtr = cachePtr->buckets[bucket].lastPtr; } sharedPtr->buckets[bucket].numFree += numMove; UnlockBucket(cachePtr, bucket); cachePtr->buckets[bucket].lastPtr = lastPtr; } /* *---------------------------------------------------------------------- * * GetBlocks -- * * Get more blocks for a bucket. * * Results: * 1 if blocks where allocated, 0 otherwise. * * Side effects: * Cache may be filled with available blocks. * *---------------------------------------------------------------------- */ static int GetBlocks( Cache *cachePtr, int bucket) { Block *blockPtr; int n; /* * First, attempt to move blocks from the shared cache. Note the * potentially dirty read of numFree before acquiring the lock which is a * slight performance enhancement. The value is verified after the lock is * actually acquired. */ if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].numFree > 0) { LockBucket(cachePtr, bucket); if (sharedPtr->buckets[bucket].numFree > 0) { /* * Either move the entire list or walk the list to find the last * block to move. */ n = bucketInfo[bucket].numMove; if (n >= sharedPtr->buckets[bucket].numFree) { cachePtr->buckets[bucket].firstPtr = sharedPtr->buckets[bucket].firstPtr; cachePtr->buckets[bucket].lastPtr = sharedPtr->buckets[bucket].lastPtr; cachePtr->buckets[bucket].numFree = sharedPtr->buckets[bucket].numFree; sharedPtr->buckets[bucket].firstPtr = NULL; sharedPtr->buckets[bucket].numFree = 0; } else { blockPtr = sharedPtr->buckets[bucket].firstPtr; cachePtr->buckets[bucket].firstPtr = blockPtr; sharedPtr->buckets[bucket].numFree -= n; cachePtr->buckets[bucket].numFree = n; while (--n > 0) { blockPtr = blockPtr->nextBlock; } sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock; cachePtr->buckets[bucket].lastPtr = blockPtr; blockPtr->nextBlock = NULL; } } UnlockBucket(cachePtr, bucket); } if (cachePtr->buckets[bucket].numFree == 0) { size_t size; /* * If no blocks could be moved from shared, first look for a larger * block in this cache to split up. */ blockPtr = NULL; n = NBUCKETS; size = 0; /* lint */ while (--n > bucket) { if (cachePtr->buckets[n].numFree > 0) { size = bucketInfo[n].blockSize; blockPtr = cachePtr->buckets[n].firstPtr; cachePtr->buckets[n].firstPtr = blockPtr->nextBlock; cachePtr->buckets[n].numFree--; break; } } /* * Otherwise, allocate a big new block directly. */ if (blockPtr == NULL) { size = MAXALLOC; blockPtr = TclpSysAlloc(size, 0); if (blockPtr == NULL) { return 0; } } /* * Split the larger block into smaller blocks for this bucket. */ n = size / bucketInfo[bucket].blockSize; cachePtr->buckets[bucket].numFree = n; cachePtr->buckets[bucket].firstPtr = blockPtr; while (--n > 0) { blockPtr->nextBlock = (Block *) ((char *) blockPtr + bucketInfo[bucket].blockSize); blockPtr = blockPtr->nextBlock; } cachePtr->buckets[bucket].lastPtr = blockPtr; blockPtr->nextBlock = NULL; } return 1; } /* *---------------------------------------------------------------------- * * TclFinalizeThreadAlloc -- * * This procedure is used to destroy all private resources used in this * file. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFinalizeThreadAlloc(void) { unsigned int i; for (i = 0; i < NBUCKETS; ++i) { TclpFreeAllocMutex(bucketInfo[i].lockPtr); bucketInfo[i].lockPtr = NULL; } TclpFreeAllocMutex(objLockPtr); objLockPtr = NULL; TclpFreeAllocMutex(listLockPtr); listLockPtr = NULL; TclpFreeAllocCache(NULL); } /* *---------------------------------------------------------------------- * * TclFinalizeThreadAllocThread -- * * This procedure is used to destroy single thread private resources * defined in this file. Called either during Tcl_FinalizeThread() or * Tcl_Finalize(). * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFinalizeThreadAllocThread(void) { Cache *cachePtr = TclpGetAllocCache(); if (cachePtr != NULL) { TclpFreeAllocCache(cachePtr); } } #else /* !(TCL_THREADS && USE_THREAD_ALLOC) */ /* *---------------------------------------------------------------------- * * Tcl_GetMemoryInfo -- * * Return a list-of-lists of memory stats. * * Results: * None. * * Side effects: * List appended to given dstring. * *---------------------------------------------------------------------- */ void Tcl_GetMemoryInfo( Tcl_DString *dsPtr) { Tcl_Panic("Tcl_GetMemoryInfo called when threaded memory allocator not in use"); } /* *---------------------------------------------------------------------- * * TclFinalizeThreadAlloc -- * * This procedure is used to destroy all private resources used in this * file. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFinalizeThreadAlloc(void) { Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use"); } #endif /* TCL_THREADS && USE_THREAD_ALLOC */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclThread.c0000644000175000017500000002614514554262142015344 0ustar sergeisergei/* * tclThread.c -- * * This file implements Platform independent thread operations. Most of * the real work is done in the platform dependent files. * * Copyright (c) 1998 by Sun Microsystems, Inc. * Copyright (c) 2008 by George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * There are three classes of synchronization objects: mutexes, thread data * keys, and condition variables. The following are used to record the memory * used for these objects so they can be finalized. * * These statics are guarded by the mutex in the caller of * TclRememberThreadData, e.g., TclpThreadDataKeyInit */ typedef struct { int num; /* Number of objects remembered */ int max; /* Max size of the array */ void **list; /* List of pointers */ } SyncObjRecord; static SyncObjRecord keyRecord = {0, 0, NULL}; static SyncObjRecord mutexRecord = {0, 0, NULL}; static SyncObjRecord condRecord = {0, 0, NULL}; /* * Prototypes of functions used only in this file. */ static void ForgetSyncObject(void *objPtr, SyncObjRecord *recPtr); static void RememberSyncObject(void *objPtr, SyncObjRecord *recPtr); /* * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not * specified. Here we undo that so the functions are defined in the stubs * table. */ #ifndef TCL_THREADS #undef Tcl_MutexLock #undef Tcl_MutexUnlock #undef Tcl_MutexFinalize #undef Tcl_ConditionNotify #undef Tcl_ConditionWait #undef Tcl_ConditionFinalize #endif /* *---------------------------------------------------------------------- * * Tcl_GetThreadData -- * * This function allocates and initializes a chunk of thread local * storage. * * Results: * A thread-specific pointer to the data structure. * * Side effects: * Will allocate memory the first time this thread calls for this chunk * of storage. * *---------------------------------------------------------------------- */ void * Tcl_GetThreadData( Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */ int size) /* Size of storage block */ { void *result; #ifdef TCL_THREADS /* * Initialize the key for this thread. */ result = TclThreadStorageKeyGet(keyPtr); if (result == NULL) { result = ckalloc(size); memset(result, 0, size); TclThreadStorageKeySet(keyPtr, result); } #else /* TCL_THREADS */ if (*keyPtr == NULL) { result = ckalloc(size); memset(result, 0, size); *keyPtr = result; RememberSyncObject(keyPtr, &keyRecord); } else { result = *keyPtr; } #endif /* TCL_THREADS */ return result; } /* *---------------------------------------------------------------------- * * TclThreadDataKeyGet -- * * This function returns a pointer to a block of thread local storage. * * Results: * A thread-specific pointer to the data structure, or NULL if the memory * has not been assigned to this key for this thread. * * Side effects: * None. * *---------------------------------------------------------------------- */ void * TclThreadDataKeyGet( Tcl_ThreadDataKey *keyPtr) /* Identifier for the data chunk. */ { #ifdef TCL_THREADS return TclThreadStorageKeyGet(keyPtr); #else /* TCL_THREADS */ return *keyPtr; #endif /* TCL_THREADS */ } /* *---------------------------------------------------------------------- * * RememberSyncObject * * Keep a list of (mutexes/condition variable/data key) used during * finalization. * * Assume global lock is held. * * Results: * None. * * Side effects: * Add to the appropriate list. * *---------------------------------------------------------------------- */ static void RememberSyncObject( void *objPtr, /* Pointer to sync object */ SyncObjRecord *recPtr) /* Record of sync objects */ { void **newList; int i, j; /* * Reuse any free slot in the list. */ for (i=0 ; i < recPtr->num ; ++i) { if (recPtr->list[i] == NULL) { recPtr->list[i] = objPtr; return; } } /* * Grow the list of pointers if necessary, copying only non-NULL * pointers to the new list. */ if (recPtr->num >= recPtr->max) { recPtr->max += 8; newList = ckalloc(recPtr->max * sizeof(void *)); for (i=0,j=0 ; inum ; i++) { if (recPtr->list[i] != NULL) { newList[j++] = recPtr->list[i]; } } if (recPtr->list != NULL) { ckfree(recPtr->list); } recPtr->list = newList; recPtr->num = j; } recPtr->list[recPtr->num] = objPtr; recPtr->num++; } /* *---------------------------------------------------------------------- * * ForgetSyncObject * * Remove a single object from the list. * Assume global lock is held. * * Results: * None. * * Side effects: * Remove from the appropriate list. * *---------------------------------------------------------------------- */ static void ForgetSyncObject( void *objPtr, /* Pointer to sync object */ SyncObjRecord *recPtr) /* Record of sync objects */ { int i; for (i=0 ; inum ; i++) { if (objPtr == recPtr->list[i]) { recPtr->list[i] = NULL; return; } } } /* *---------------------------------------------------------------------- * * TclRememberMutex * * Keep a list of mutexes used during finalization. * Assume global lock is held. * * Results: * None. * * Side effects: * Add to the mutex list. * *---------------------------------------------------------------------- */ void TclRememberMutex( Tcl_Mutex *mutexPtr) { RememberSyncObject(mutexPtr, &mutexRecord); } /* *---------------------------------------------------------------------- * * Tcl_MutexFinalize -- * * Finalize a single mutex and remove it from the list of remembered * objects. * * Results: * None. * * Side effects: * Remove the mutex from the list. * *---------------------------------------------------------------------- */ void Tcl_MutexFinalize( Tcl_Mutex *mutexPtr) { #ifdef TCL_THREADS TclpFinalizeMutex(mutexPtr); #endif TclpGlobalLock(); ForgetSyncObject(mutexPtr, &mutexRecord); TclpGlobalUnlock(); } /* *---------------------------------------------------------------------- * * TclRememberCondition * * Keep a list of condition variables used during finalization. * Assume global lock is held. * * Results: * None. * * Side effects: * Add to the condition variable list. * *---------------------------------------------------------------------- */ void TclRememberCondition( Tcl_Condition *condPtr) { RememberSyncObject(condPtr, &condRecord); } /* *---------------------------------------------------------------------- * * Tcl_ConditionFinalize -- * * Finalize a single condition variable and remove it from the list of * remembered objects. * * Results: * None. * * Side effects: * Remove the condition variable from the list. * *---------------------------------------------------------------------- */ void Tcl_ConditionFinalize( Tcl_Condition *condPtr) { #ifdef TCL_THREADS TclpFinalizeCondition(condPtr); #endif TclpGlobalLock(); ForgetSyncObject(condPtr, &condRecord); TclpGlobalUnlock(); } /* *---------------------------------------------------------------------- * * TclFinalizeThreadData -- * * This function cleans up the thread-local storage. Secondary, it cleans * thread alloc cache. * This is called once for each thread before thread exits. * * Results: * None. * * Side effects: * Frees up all thread local storage. * *---------------------------------------------------------------------- */ void TclFinalizeThreadData(int quick) { TclFinalizeThreadDataThread(); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) if (!quick) { /* * Quick exit principle makes it useless to terminate allocators */ TclFinalizeThreadAllocThread(); } #endif } /* *---------------------------------------------------------------------- * * TclFinalizeSynchronization -- * * This function cleans up all synchronization objects: mutexes, * condition variables, and thread-local storage. * * Results: * None. * * Side effects: * Frees up the memory. * *---------------------------------------------------------------------- */ void TclFinalizeSynchronization(void) { int i; void *blockPtr; Tcl_ThreadDataKey *keyPtr; #ifdef TCL_THREADS Tcl_Mutex *mutexPtr; Tcl_Condition *condPtr; TclpGlobalLock(); #endif /* * If we're running unthreaded, the TSD blocks are simply stored inside * their thread data keys. Free them here. */ if (keyRecord.list != NULL) { for (i=0 ; iid!=id) { threadPtr = threadPtr->nextThreadPtr; } if (threadPtr == NULL) { /* * Thread not found. Either not joinable, or already waited upon and * exited. Whatever, an error is in order. */ Tcl_MutexUnlock(&joinMutex); return TCL_ERROR; } /* * [1] If we don't lock the structure before giving up exclusive access to * the list some other thread just completing its wait on the same thread * can delete the structure from under us, leaving us with a dangling * pointer. */ Tcl_MutexLock(&threadPtr->threadMutex); Tcl_MutexUnlock(&joinMutex); /* * [2] Now that we have the structure mutex any other thread that just * tries to delete structure will wait at location [3] until we are done * with the structure. And in that case we are done with it rather quickly * as 'waitedUpon' will be set and we will have to error out. */ if (threadPtr->waitedUpon) { Tcl_MutexUnlock(&threadPtr->threadMutex); return TCL_ERROR; } /* * We are waiting now, let other threads recognize this. */ threadPtr->waitedUpon = 1; while (!threadPtr->done) { Tcl_ConditionWait(&threadPtr->cond, &threadPtr->threadMutex, NULL); } /* * We have to release the structure before trying to access the list again * or we can run into deadlock with a thread at [1] (see above) because of * us holding the structure and the other holding the list. There is no * problem with dangling pointers here as 'waitedUpon == 1' is still valid * and any other thread will error out and not come to this place. IOW, * the fact that we are here also means that no other thread came here * before us and is able to delete the structure. */ Tcl_MutexUnlock(&threadPtr->threadMutex); Tcl_MutexLock(&joinMutex); /* * We have to search the list again as its structure may (may, almost * certainly) have changed while we were waiting. Especially now is the * time to compute the predecessor in the list. Any earlier result can be * dangling by now. */ if (firstThreadPtr == threadPtr) { firstThreadPtr = threadPtr->nextThreadPtr; } else { JoinableThread *prevThreadPtr = firstThreadPtr; while (prevThreadPtr->nextThreadPtr != threadPtr) { prevThreadPtr = prevThreadPtr->nextThreadPtr; } prevThreadPtr->nextThreadPtr = threadPtr->nextThreadPtr; } Tcl_MutexUnlock(&joinMutex); /* * [3] Now that the structure is not part of the list anymore no other * thread can acquire its mutex from now on. But it is possible that * another thread is still holding the mutex though, see location [2]. So * we have to acquire the mutex one more time to wait for that thread to * finish. We can (and have to) release the mutex immediately. */ Tcl_MutexLock(&threadPtr->threadMutex); Tcl_MutexUnlock(&threadPtr->threadMutex); /* * Copy the result to us, finalize the synchronisation objects, then free * the structure and return. */ *result = threadPtr->result; Tcl_ConditionFinalize(&threadPtr->cond); Tcl_MutexFinalize(&threadPtr->threadMutex); ckfree(threadPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclRememberJoinableThread -- * * This procedure remembers a thread as joinable. Only a call to * TclJoinThread will remove the structure created (and initialized) here. * IOW, not waiting upon a joinable thread will cause memory leaks. * * Results: * None. * * Side effects: * Allocates memory, adds it to the global list of all joinable threads. * *---------------------------------------------------------------------- */ void TclRememberJoinableThread( Tcl_ThreadId id) /* The thread to remember as joinable */ { JoinableThread *threadPtr; threadPtr = (JoinableThread *)ckalloc(sizeof(JoinableThread)); threadPtr->id = id; threadPtr->done = 0; threadPtr->waitedUpon = 0; threadPtr->threadMutex = (Tcl_Mutex) NULL; threadPtr->cond = (Tcl_Condition) NULL; Tcl_MutexLock(&joinMutex); threadPtr->nextThreadPtr = firstThreadPtr; firstThreadPtr = threadPtr; Tcl_MutexUnlock(&joinMutex); } /* *---------------------------------------------------------------------- * * TclSignalExitThread -- * * This procedure signals that the specified thread is done with its * work. If the thread is joinable this signal is propagated to the * thread waiting upon it. * * Results: * None. * * Side effects: * Modifies the associated structure to hold the result. * *---------------------------------------------------------------------- */ void TclSignalExitThread( Tcl_ThreadId id, /* Id of the thread signaling its exit. */ int result) /* The result from the thread. */ { JoinableThread *threadPtr; Tcl_MutexLock(&joinMutex); threadPtr = firstThreadPtr; while ((threadPtr != NULL) && (threadPtr->id != id)) { threadPtr = threadPtr->nextThreadPtr; } if (threadPtr == NULL) { /* * Thread not found. Not joinable. No problem, nothing to do. */ Tcl_MutexUnlock(&joinMutex); return; } /* * Switch over the exclusive access from the list to the structure, then * store the result, set the flag and notify the waiting thread, provided * that it exists. The order of lock/unlock ensures that a thread entering * 'TclJoinThread' will not interfere with us. */ Tcl_MutexLock(&threadPtr->threadMutex); Tcl_MutexUnlock(&joinMutex); threadPtr->done = 1; threadPtr->result = result; if (threadPtr->waitedUpon) { Tcl_ConditionNotify(&threadPtr->cond); } Tcl_MutexUnlock(&threadPtr->threadMutex); } #else TCL_MAC_EMPTY_FILE(generic_tclThreadJoin_c) #endif /* _WIN32 */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclThreadStorage.c0000644000175000017500000002123114554262142016660 0ustar sergeisergei/* * tclThreadStorage.c -- * * This file implements platform independent thread storage operations to * work around system limits on the number of thread-specific variables. * * Copyright (c) 2003-2004 by Joe Mistachkin * Copyright (c) 2008 by George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef TCL_THREADS #include /* * IMPLEMENTATION NOTES: * * The primary idea is that we create one platform-specific TSD slot, and use * it for storing a table pointer. Each Tcl_ThreadDataKey has an offset into * the table of TSD values. We don't use more than 1 platform-specific TSD * slot, because there is a hard limit on the number of TSD slots. Valid key * offsets are greater than 0; 0 is for the initialized Tcl_ThreadDataKey. */ /* * The global collection of information about TSDs. This is shared across the * whole process, and includes the mutex used to protect it. */ static struct { void *key; /* Key into the system TSD structure. The * collection of Tcl TSD values for a * particular thread will hang off the * back-end of this. */ sig_atomic_t counter; /* The number of different Tcl TSDs used * across *all* threads. This is a strictly * increasing value. */ Tcl_Mutex mutex; /* Protection for the rest of this structure, * which holds per-process data. */ } tsdGlobal = { NULL, 0, NULL }; /* * The type of the data held per thread in a system TSD. */ typedef struct { ClientData *tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ } TSDTable; /* * The actual type of Tcl_ThreadDataKey. */ typedef union { volatile sig_atomic_t offset; /* The type is really an offset into the * thread-local table of TSDs, which is this * field. */ void *ptr; /* For alignment purposes only. Not actually * accessed through this. */ } TSDUnion; /* * Forward declarations of functions in this file. */ static TSDTable * TSDTableCreate(void); static void TSDTableDelete(TSDTable *tsdTablePtr); static void TSDTableGrow(TSDTable *tsdTablePtr, sig_atomic_t atLeast); /* * Allocator and deallocator for a TSDTable structure. */ static TSDTable * TSDTableCreate(void) { TSDTable *tsdTablePtr; sig_atomic_t i; tsdTablePtr = TclpSysAlloc(sizeof(TSDTable), 0); if (tsdTablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } tsdTablePtr->allocated = 8; tsdTablePtr->tablePtr = TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0); if (tsdTablePtr->tablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } for (i = 0; i < tsdTablePtr->allocated; ++i) { tsdTablePtr->tablePtr[i] = NULL; } return tsdTablePtr; } static void TSDTableDelete( TSDTable *tsdTablePtr) { sig_atomic_t i; for (i=0 ; iallocated ; i++) { if (tsdTablePtr->tablePtr[i] != NULL) { /* * These values were allocated in Tcl_GetThreadData in tclThread.c * and must now be deallocated or they will leak. */ ckfree(tsdTablePtr->tablePtr[i]); } } TclpSysFree(tsdTablePtr->tablePtr); TclpSysFree(tsdTablePtr); } /* *---------------------------------------------------------------------- * * TSDTableGrow -- * * This procedure makes the passed TSDTable grow to fit the atLeast * value. * * Results: * None. * * Side effects: * The table is enlarged. * *---------------------------------------------------------------------- */ static void TSDTableGrow( TSDTable *tsdTablePtr, sig_atomic_t atLeast) { sig_atomic_t newAllocated = tsdTablePtr->allocated * 2; ClientData *newTablePtr; sig_atomic_t i; if (newAllocated <= atLeast) { newAllocated = atLeast + 10; } newTablePtr = TclpSysRealloc(tsdTablePtr->tablePtr, sizeof(ClientData) * newAllocated); if (newTablePtr == NULL) { Tcl_Panic("unable to reallocate TSDTable"); } for (i = tsdTablePtr->allocated; i < newAllocated; ++i) { newTablePtr[i] = NULL; } tsdTablePtr->allocated = newAllocated; tsdTablePtr->tablePtr = newTablePtr; } /* *---------------------------------------------------------------------- * * TclThreadStorageKeyGet -- * * This procedure gets the value associated with the passed key. * * Results: * A pointer value associated with the Tcl_ThreadDataKey or NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ void * TclThreadStorageKeyGet( Tcl_ThreadDataKey *dataKeyPtr) { TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key); ClientData resultPtr = NULL; TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr; sig_atomic_t offset = keyPtr->offset; if ((tsdTablePtr != NULL) && (offset > 0) && (offset < tsdTablePtr->allocated)) { resultPtr = tsdTablePtr->tablePtr[offset]; } return resultPtr; } /* *---------------------------------------------------------------------- * * TclThreadStorageKeySet -- * * This procedure set an association of value with the key passed. The * associated value may be retrieved with TclThreadDataKeyGet(). * * Results: * None. * * Side effects: * The thread-specific table may be created or reallocated. * *---------------------------------------------------------------------- */ void TclThreadStorageKeySet( Tcl_ThreadDataKey *dataKeyPtr, void *value) { TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key); TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr; if (tsdTablePtr == NULL) { tsdTablePtr = TSDTableCreate(); TclpThreadSetGlobalTSD(tsdGlobal.key, tsdTablePtr); } /* * Get the lock while we check if this TSD is new or not. Note that this * is the only place where Tcl_ThreadDataKey values are set. We use a * double-checked lock to try to avoid having to grab this lock a lot, * since it is on quite a few critical paths and will only get set once in * each location. */ if (keyPtr->offset == 0) { Tcl_MutexLock(&tsdGlobal.mutex); if (keyPtr->offset == 0) { /* * The Tcl_ThreadDataKey hasn't been used yet. Make a new one. */ keyPtr->offset = ++tsdGlobal.counter; } Tcl_MutexUnlock(&tsdGlobal.mutex); } /* * Check if this is the first time this Tcl_ThreadDataKey has been used * with the current thread. Note that we don't need to hold a lock when * doing this, as we are *definitely* the only point accessing this * tsdTablePtr right now; it's thread-local. */ if (keyPtr->offset >= tsdTablePtr->allocated) { TSDTableGrow(tsdTablePtr, keyPtr->offset); } /* * Set the value in the Tcl thread-local variable. */ tsdTablePtr->tablePtr[keyPtr->offset] = value; } /* *---------------------------------------------------------------------- * * TclFinalizeThreadDataThread -- * * This procedure finalizes the data for a single thread. * * Results: * None. * * Side effects: * The TSDTable is deleted/freed. * *---------------------------------------------------------------------- */ void TclFinalizeThreadDataThread(void) { TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key); if (tsdTablePtr != NULL) { TSDTableDelete(tsdTablePtr); TclpThreadSetGlobalTSD(tsdGlobal.key, NULL); } } /* *---------------------------------------------------------------------- * * TclInitializeThreadStorage -- * * This procedure initializes the TSD subsystem with per-platform code. * This should be called before any Tcl threads are created. * * Results: * None. * * Side effects: * Allocates a system TSD. * *---------------------------------------------------------------------- */ void TclInitThreadStorage(void) { tsdGlobal.key = TclpThreadCreateKey(); } /* *---------------------------------------------------------------------- * * TclFinalizeThreadStorage -- * * This procedure cleans up the thread storage data key for all threads. * IMPORTANT: All Tcl threads must be finalized before calling this! * * Results: * None. * * Side effects: * Releases the thread data key. * *---------------------------------------------------------------------- */ void TclFinalizeThreadStorage(void) { TclpThreadDeleteKey(tsdGlobal.key); tsdGlobal.key = NULL; } #else /* !TCL_THREADS */ /* * Stub functions for non-threaded builds */ void TclInitThreadStorage(void) { } void TclFinalizeThreadDataThread(void) { } void TclFinalizeThreadStorage(void) { } #endif /* TCL_THREADS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclThreadTest.c0000644000175000017500000007535114554262142016207 0ustar sergeisergei/* * tclThreadTest.c -- * * This file implements the testthread command. Eventually this should be * tclThreadCmd.c * Some of this code is based on work done by Richard Hipp on behalf of * Conservation Through Innovation, Limited, with their permission. * * Copyright (c) 1998 by Sun Microsystems, Inc. * Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef TCL_THREADS /* * Each thread has an single instance of the following structure. There is one * instance of this structure per thread even if that thread contains multiple * interpreters. The interpreter identified by this structure is the main * interpreter for the thread. * * The main interpreter is the one that will process any messages received by * a thread. Any thread can send messages but only the main interpreter can * receive them. */ typedef struct ThreadSpecificData { Tcl_ThreadId threadId; /* Tcl ID for this thread */ Tcl_Interp *interp; /* Main interpreter for this thread */ int flags; /* See the TP_ defines below... */ struct ThreadSpecificData *nextPtr; /* List for "thread names" */ struct ThreadSpecificData *prevPtr; /* List for "thread names" */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * This list is used to list all threads that have interpreters. This is * protected by threadMutex. */ static ThreadSpecificData *threadList = NULL; /* * The following bit-values are legal for the "flags" field of the * ThreadSpecificData structure. */ #define TP_Dying 0x001 /* This thread is being canceled */ /* * An instance of the following structure contains all information that is * passed into a new thread when the thread is created using either the * "thread create" Tcl command or the ThreadCreate() C function. */ typedef struct ThreadCtrl { const char *script; /* The Tcl command this thread should * execute */ int flags; /* Initial value of the "flags" field in the * ThreadSpecificData structure for the new * thread. Might contain TP_Detached or * TP_TclThread. */ Tcl_Condition condWait; /* This condition variable is used to * synchronize the parent and child threads. * The child won't run until it acquires * threadMutex, and the parent function won't * complete until signaled on this condition * variable. */ } ThreadCtrl; /* * This is the event used to send scripts to other threads. */ typedef struct ThreadEvent { Tcl_Event event; /* Must be first */ char *script; /* The script to execute. */ struct ThreadEventResult *resultPtr; /* To communicate the result. This is NULL if * we don't care about it. */ } ThreadEvent; typedef struct ThreadEventResult { Tcl_Condition done; /* Signaled when the script completes */ int code; /* Return value of Tcl_Eval */ char *result; /* Result from the script */ char *errorInfo; /* Copy of errorInfo variable */ char *errorCode; /* Copy of errorCode variable */ Tcl_ThreadId srcThreadId; /* Id of sending thread, in case it dies */ Tcl_ThreadId dstThreadId; /* Id of target thread, in case it dies */ struct ThreadEvent *eventPtr; /* Back pointer */ struct ThreadEventResult *nextPtr; /* List for cleanup */ struct ThreadEventResult *prevPtr; } ThreadEventResult; static ThreadEventResult *resultList; /* * This is for simple error handling when a thread script exits badly. */ static Tcl_ThreadId mainThreadId; static Tcl_ThreadId errorThreadId; static char *errorProcString; /* * Access to the list of threads and to the thread send results is guarded by * this mutex. */ TCL_DECLARE_MUTEX(threadMutex) static int ThreadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ThreadCreate(Tcl_Interp *interp, const char *script, int joinable); static int ThreadList(Tcl_Interp *interp); static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, const char *script, int wait); static int ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id, const char *result, int flags); static Tcl_ThreadCreateType NewTestThread(ClientData clientData); static void ListRemove(ThreadSpecificData *tsdPtr); static void ListUpdateInner(ThreadSpecificData *tsdPtr); static int ThreadEventProc(Tcl_Event *evPtr, int mask); static void ThreadErrorProc(Tcl_Interp *interp); static void ThreadFreeProc(ClientData clientData); static int ThreadDeleteEvent(Tcl_Event *eventPtr, ClientData clientData); static void ThreadExitProc(ClientData clientData); extern int Tcltest_Init(Tcl_Interp *interp); /* *---------------------------------------------------------------------- * * TclThread_Init -- * * Initialize the test thread command. * * Results: * TCL_OK if the package was properly initialized. * * Side effects: * Add the "testthread" command to the interp. * *---------------------------------------------------------------------- */ int TclThread_Init( Tcl_Interp *interp) /* The current Tcl interpreter */ { /* * If the main thread Id has not been set, do it now. */ Tcl_MutexLock(&threadMutex); if (mainThreadId == 0) { mainThreadId = Tcl_GetCurrentThread(); } Tcl_MutexUnlock(&threadMutex); Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * ThreadObjCmd -- * * This procedure is invoked to process the "testthread" Tcl command. See * the user documentation for details on what it does. * * thread cancel ?-unwind? id ?result? * thread create ?-joinable? ?script? * thread send ?-async? id script * thread event * thread exit * thread id ?-main? * thread names * thread wait * thread errorproc proc * thread join id * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static int ThreadObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int option; static const char *const threadOptions[] = { "cancel", "create", "event", "exit", "id", "join", "names", "send", "wait", "errorproc", NULL }; enum options { THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0, &option) != TCL_OK) { return TCL_ERROR; } /* * Make sure the initial thread is on the list before doing anything. */ if (tsdPtr->interp == NULL) { Tcl_MutexLock(&threadMutex); tsdPtr->interp = interp; ListUpdateInner(tsdPtr); Tcl_CreateThreadExitHandler(ThreadExitProc, NULL); Tcl_MutexUnlock(&threadMutex); } switch ((enum options)option) { case THREAD_CANCEL: { Tcl_WideInt id; const char *result; int flags, arg; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? id ?result?"); return TCL_ERROR; } flags = 0; arg = 2; if ((objc == 4) || (objc == 5)) { if (strcmp("-unwind", Tcl_GetString(objv[arg])) == 0) { flags = TCL_CANCEL_UNWIND; arg++; } } if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) { return TCL_ERROR; } arg++; if (arg < objc) { result = Tcl_GetString(objv[arg]); } else { result = NULL; } return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags); } case THREAD_CREATE: { const char *script; int joinable, len; if (objc == 2) { /* * Neither joinable nor special script */ joinable = 0; script = "testthread wait"; /* Just enter event loop */ } else if (objc == 3) { /* * Possibly -joinable, then no special script, no joinable, then * its a script. */ script = Tcl_GetStringFromObj(objv[2], &len); if ((len > 1) && (script[0] == '-') && (script[1] == 'j') && (0 == strncmp(script, "-joinable", len))) { joinable = 1; script = "testthread wait"; /* Just enter event loop */ } else { /* * Remember the script */ joinable = 0; } } else if (objc == 4) { /* * Definitely a script available, but is the flag -joinable? */ script = Tcl_GetStringFromObj(objv[2], &len); joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j') && (0 == strncmp(script, "-joinable", len))); script = Tcl_GetString(objv[3]); } else { Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?"); return TCL_ERROR; } return ThreadCreate(interp, script, joinable); } case THREAD_EXIT: if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } ListRemove(NULL); Tcl_ExitThread(0); return TCL_OK; case THREAD_ID: if (objc == 2 || objc == 3) { Tcl_Obj *idObj; /* * Check if they want the main thread id or the current thread id. */ if (objc == 2) { idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); } else if (objc == 3 && strcmp("-main", Tcl_GetString(objv[2])) == 0) { Tcl_MutexLock(&threadMutex); idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)mainThreadId); Tcl_MutexUnlock(&threadMutex); } else { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, idObj); return TCL_OK; } else { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } case THREAD_JOIN: { Tcl_WideInt id; int result, status; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "id"); return TCL_ERROR; } if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) { return TCL_ERROR; } result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), status); } else { char buf[20]; snprintf(buf, sizeof(buf), "%" TCL_LL_MODIFIER "d", id); Tcl_AppendResult(interp, "cannot join thread ", buf, NULL); } return result; } case THREAD_NAMES: if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } return ThreadList(interp); case THREAD_SEND: { Tcl_WideInt id; const char *script; int wait, arg; if ((objc != 4) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script"); return TCL_ERROR; } if (objc == 5) { if (strcmp("-async", Tcl_GetString(objv[2])) != 0) { Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script"); return TCL_ERROR; } wait = 0; arg = 3; } else { wait = 1; arg = 2; } if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) { return TCL_ERROR; } arg++; script = Tcl_GetString(objv[arg]); return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait); } case THREAD_EVENT: { if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj( Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT))); return TCL_OK; } case THREAD_ERRORPROC: { /* * Arrange for this proc to handle thread death errors. */ const char *proc; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "proc"); return TCL_ERROR; } Tcl_MutexLock(&threadMutex); errorThreadId = Tcl_GetCurrentThread(); if (errorProcString) { ckfree(errorProcString); } proc = Tcl_GetString(objv[2]); errorProcString = ckalloc(strlen(proc) + 1); strcpy(errorProcString, proc); Tcl_MutexUnlock(&threadMutex); return TCL_OK; } case THREAD_WAIT: if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } while (1) { /* * If the script has been unwound, bail out immediately. This does * not follow the recommended guidelines for how extensions should * handle the script cancellation functionality because this is * not a "normal" extension. Most extensions do not have a command * that simply enters an infinite Tcl event loop. Normal * extensions should not specify the TCL_CANCEL_UNWIND when * calling Tcl_Canceled to check if the command has been canceled. */ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) { break; } (void) Tcl_DoOneEvent(TCL_ALL_EVENTS); } /* * If we get to this point, we have been canceled by another thread, * which is considered to be an "error". */ ThreadErrorProc(interp); return TCL_OK; } return TCL_OK; } /* *---------------------------------------------------------------------- * * ThreadCreate -- * * This procedure is invoked to create a thread containing an interp to * run a script. This returns after the thread has started executing. * * Results: * A standard Tcl result, which is the thread ID. * * Side effects: * Create a thread. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static int ThreadCreate( Tcl_Interp *interp, /* Current interpreter. */ const char *script, /* Script to execute */ int joinable) /* Flag, joinable thread or not */ { ThreadCtrl ctrl; Tcl_ThreadId id; ctrl.script = script; ctrl.condWait = NULL; ctrl.flags = 0; joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS; Tcl_MutexLock(&threadMutex); if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl, TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) { Tcl_MutexUnlock(&threadMutex); Tcl_AppendResult(interp, "can't create a new thread", NULL); return TCL_ERROR; } /* * Wait for the thread to start because it is using something on our stack! */ Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL); Tcl_MutexUnlock(&threadMutex); Tcl_ConditionFinalize(&ctrl.condWait); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)(size_t)id)); return TCL_OK; } /* *------------------------------------------------------------------------ * * NewTestThread -- * * This routine is the "main()" for a new thread whose task is to execute * a single Tcl script. The argument to this function is a pointer to a * structure that contains the text of the TCL script to be executed. * * Space to hold the script field of the ThreadControl structure passed * in as the only argument was obtained from malloc() and must be freed * by this function before it exits. Space to hold the ThreadControl * structure itself is released by the calling function, and the two * condition variables in the ThreadControl structure are destroyed by * the calling function. The calling function will destroy the * ThreadControl structure and the condition variable as soon as * ctrlPtr->condWait is signaled, so this routine must make copies of any * data it might need after that point. * * Results: * None * * Side effects: * A Tcl script is executed in a new thread. * *------------------------------------------------------------------------ */ Tcl_ThreadCreateType NewTestThread( ClientData clientData) { ThreadCtrl *ctrlPtr = clientData; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int result; char *threadEvalScript; /* * Initialize the interpreter. This should be more general. */ tsdPtr->interp = Tcl_CreateInterp(); result = Tcl_Init(tsdPtr->interp); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } /* * This is part of the test facility. Initialize _ALL_ test commands for * use by the new thread. */ result = Tcltest_Init(tsdPtr->interp); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } /* * Update the list of threads. */ Tcl_MutexLock(&threadMutex); ListUpdateInner(tsdPtr); /* * We need to keep a pointer to the alloc'ed mem of the script we are * eval'ing, for the case that we exit during evaluation */ threadEvalScript = ckalloc(strlen(ctrlPtr->script) + 1); strcpy(threadEvalScript, ctrlPtr->script); Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript); /* * Notify the parent we are alive. */ Tcl_ConditionNotify(&ctrlPtr->condWait); Tcl_MutexUnlock(&threadMutex); /* * Run the script. */ Tcl_Preserve(tsdPtr->interp); result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } /* * Clean up. */ Tcl_DeleteInterp(tsdPtr->interp); Tcl_Release(tsdPtr->interp); ListRemove(tsdPtr); Tcl_ExitThread(result); TCL_THREAD_CREATE_RETURN; } /* *------------------------------------------------------------------------ * * ThreadErrorProc -- * * Send a message to the thread willing to hear about errors. * * Results: * None * * Side effects: * Send an event. * *------------------------------------------------------------------------ */ static void ThreadErrorProc( Tcl_Interp *interp) /* Interp that failed */ { Tcl_Channel errChannel; const char *errorInfo, *argv[3]; char *script; char buf[TCL_DOUBLE_SPACE+1]; snprintf(buf, sizeof(buf), "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); if (errorProcString == NULL) { errChannel = Tcl_GetStdChannel(TCL_STDERR); Tcl_WriteChars(errChannel, "Error from thread ", -1); Tcl_WriteChars(errChannel, buf, -1); Tcl_WriteChars(errChannel, "\n", 1); Tcl_WriteChars(errChannel, errorInfo, -1); Tcl_WriteChars(errChannel, "\n", 1); } else { argv[0] = errorProcString; argv[1] = buf; argv[2] = errorInfo; script = Tcl_Merge(3, argv); ThreadSend(interp, errorThreadId, script, 0); ckfree(script); } } /* *------------------------------------------------------------------------ * * ListUpdateInner -- * * Add the thread local storage to the list. This assumes the caller has * obtained the mutex. * * Results: * None * * Side effects: * Add the thread local storage to its list. * *------------------------------------------------------------------------ */ static void ListUpdateInner( ThreadSpecificData *tsdPtr) { if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); } tsdPtr->threadId = Tcl_GetCurrentThread(); tsdPtr->nextPtr = threadList; if (threadList) { threadList->prevPtr = tsdPtr; } tsdPtr->prevPtr = NULL; threadList = tsdPtr; } /* *------------------------------------------------------------------------ * * ListRemove -- * * Remove the thread local storage from its list. This grabs the mutex to * protect the list. * * Results: * None * * Side effects: * Remove the thread local storage from its list. * *------------------------------------------------------------------------ */ static void ListRemove( ThreadSpecificData *tsdPtr) { if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); } Tcl_MutexLock(&threadMutex); if (tsdPtr->prevPtr) { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } else { threadList = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = 0; tsdPtr->interp = NULL; Tcl_MutexUnlock(&threadMutex); } /* *------------------------------------------------------------------------ * * ThreadList -- * * Return a list of threads running Tcl interpreters. * * Results: * A standard Tcl result. * * Side effects: * None. * *------------------------------------------------------------------------ */ static int ThreadList( Tcl_Interp *interp) { ThreadSpecificData *tsdPtr; Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); Tcl_MutexLock(&threadMutex); for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj((Tcl_WideInt)(size_t)tsdPtr->threadId)); } Tcl_MutexUnlock(&threadMutex); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *------------------------------------------------------------------------ * * ThreadSend -- * * Send a script to another thread. * * Results: * A standard Tcl result. * * Side effects: * None. * *------------------------------------------------------------------------ */ static int ThreadSend( Tcl_Interp *interp, /* The current interpreter. */ Tcl_ThreadId id, /* Thread Id of other interpreter. */ const char *script, /* The script to evaluate. */ int wait) /* If 1, we block for the result. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadEvent *threadEventPtr; ThreadEventResult *resultPtr; int found, code; Tcl_ThreadId threadId = (Tcl_ThreadId) id; /* * Verify the thread exists. */ Tcl_MutexLock(&threadMutex); found = 0; for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) { if (tsdPtr->threadId == threadId) { found = 1; break; } } if (!found) { Tcl_MutexUnlock(&threadMutex); Tcl_AppendResult(interp, "invalid thread id", NULL); return TCL_ERROR; } /* * Short circuit sends to ourself. Ought to do something with -async, like * run in an idle handler. */ if (threadId == Tcl_GetCurrentThread()) { Tcl_MutexUnlock(&threadMutex); return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL); } /* * Create the event for its event queue. */ threadEventPtr = ckalloc(sizeof(ThreadEvent)); threadEventPtr->script = ckalloc(strlen(script) + 1); strcpy(threadEventPtr->script, script); if (!wait) { resultPtr = threadEventPtr->resultPtr = NULL; } else { resultPtr = ckalloc(sizeof(ThreadEventResult)); threadEventPtr->resultPtr = resultPtr; /* * Initialize the result fields. */ resultPtr->done = NULL; resultPtr->code = 0; resultPtr->result = NULL; resultPtr->errorInfo = NULL; resultPtr->errorCode = NULL; /* * Maintain the cleanup list. */ resultPtr->srcThreadId = Tcl_GetCurrentThread(); resultPtr->dstThreadId = threadId; resultPtr->eventPtr = threadEventPtr; resultPtr->nextPtr = resultList; if (resultList) { resultList->prevPtr = resultPtr; } resultPtr->prevPtr = NULL; resultList = resultPtr; } /* * Queue the event and poke the other thread's notifier. */ threadEventPtr->event.proc = ThreadEventProc; Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr, TCL_QUEUE_TAIL); Tcl_ThreadAlert(threadId); if (!wait) { Tcl_MutexUnlock(&threadMutex); return TCL_OK; } /* * Block on the results and then get them. */ Tcl_ResetResult(interp); while (resultPtr->result == NULL) { Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL); } /* * Unlink result from the result list. */ if (resultPtr->prevPtr) { resultPtr->prevPtr->nextPtr = resultPtr->nextPtr; } else { resultList = resultPtr->nextPtr; } if (resultPtr->nextPtr) { resultPtr->nextPtr->prevPtr = resultPtr->prevPtr; } resultPtr->eventPtr = NULL; resultPtr->nextPtr = NULL; resultPtr->prevPtr = NULL; Tcl_MutexUnlock(&threadMutex); if (resultPtr->code != TCL_OK) { if (resultPtr->errorCode) { Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL); ckfree(resultPtr->errorCode); } if (resultPtr->errorInfo) { Tcl_AddErrorInfo(interp, resultPtr->errorInfo); ckfree(resultPtr->errorInfo); } } Tcl_AppendResult(interp, resultPtr->result, NULL); Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; ckfree(resultPtr->result); ckfree(resultPtr); return code; } /* *------------------------------------------------------------------------ * * ThreadCancel -- * * Cancels a script in another thread. * * Results: * A standard Tcl result. * * Side effects: * None. * *------------------------------------------------------------------------ */ static int ThreadCancel( Tcl_Interp *interp, /* The current interpreter. */ Tcl_ThreadId id, /* Thread Id of other interpreter. */ const char *result, /* The result or NULL for default. */ int flags) /* Flags for Tcl_CancelEval. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int found; Tcl_ThreadId threadId = (Tcl_ThreadId) id; /* * Verify the thread exists. */ Tcl_MutexLock(&threadMutex); found = 0; for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) { if (tsdPtr->threadId == threadId) { found = 1; break; } } if (!found) { Tcl_MutexUnlock(&threadMutex); Tcl_AppendResult(interp, "invalid thread id", NULL); return TCL_ERROR; } /* * Since Tcl_CancelEval can be safely called from any thread, * we do it now. */ Tcl_MutexUnlock(&threadMutex); Tcl_ResetResult(interp); return Tcl_CancelEval(tsdPtr->interp, (result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags); } /* *------------------------------------------------------------------------ * * ThreadEventProc -- * * Handle the event in the target thread. * * Results: * Returns 1 to indicate that the event was processed. * * Side effects: * Fills out the ThreadEventResult struct. * *------------------------------------------------------------------------ */ static int ThreadEventProc( Tcl_Event *evPtr, /* Really ThreadEvent */ int mask) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadEvent *threadEventPtr = (ThreadEvent *) evPtr; ThreadEventResult *resultPtr = threadEventPtr->resultPtr; Tcl_Interp *interp = tsdPtr->interp; int code; const char *result, *errorCode, *errorInfo; if (interp == NULL) { code = TCL_ERROR; result = "no target interp!"; errorCode = "THREAD"; errorInfo = ""; } else { Tcl_Preserve(interp); Tcl_ResetResult(interp); Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script); code = Tcl_EvalEx(interp, threadEventPtr->script,-1,TCL_EVAL_GLOBAL); Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script); if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); } else { errorCode = errorInfo = NULL; } result = Tcl_GetStringResult(interp); } ckfree(threadEventPtr->script); if (resultPtr) { Tcl_MutexLock(&threadMutex); resultPtr->code = code; resultPtr->result = ckalloc(strlen(result) + 1); strcpy(resultPtr->result, result); if (errorCode != NULL) { resultPtr->errorCode = ckalloc(strlen(errorCode) + 1); strcpy(resultPtr->errorCode, errorCode); } if (errorInfo != NULL) { resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1); strcpy(resultPtr->errorInfo, errorInfo); } Tcl_ConditionNotify(&resultPtr->done); Tcl_MutexUnlock(&threadMutex); } if (interp != NULL) { Tcl_Release(interp); } return 1; } /* *------------------------------------------------------------------------ * * ThreadFreeProc -- * * This is called from when we are exiting and memory needs * to be freed. * * Results: * None. * * Side effects: * Clears up mem specified in ClientData * *------------------------------------------------------------------------ */ /* ARGSUSED */ static void ThreadFreeProc( ClientData clientData) { if (clientData) { ckfree(clientData); } } /* *------------------------------------------------------------------------ * * ThreadDeleteEvent -- * * This is called from the ThreadExitProc to delete memory related * to events that we put on the queue. * * Results: * 1 it was our event and we want it removed, 0 otherwise. * * Side effects: * It cleans up our events in the event queue for this thread. * *------------------------------------------------------------------------ */ /* ARGSUSED */ static int ThreadDeleteEvent( Tcl_Event *eventPtr, /* Really ThreadEvent */ ClientData clientData) /* dummy */ { if (eventPtr->proc == ThreadEventProc) { ckfree(((ThreadEvent *) eventPtr)->script); return 1; } /* * If it was NULL, we were in the middle of servicing the event and it * should be removed */ return (eventPtr->proc == NULL); } /* *------------------------------------------------------------------------ * * ThreadExitProc -- * * This is called when the thread exits. * * Results: * None. * * Side effects: * It unblocks anyone that is waiting on a send to this thread. It cleans * up any events in the event queue for this thread. * *------------------------------------------------------------------------ */ /* ARGSUSED */ static void ThreadExitProc( ClientData clientData) { char *threadEvalScript = clientData; ThreadEventResult *resultPtr, *nextPtr; Tcl_ThreadId self = Tcl_GetCurrentThread(); ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->interp != NULL) { ListRemove(tsdPtr); } Tcl_MutexLock(&threadMutex); if (self == errorThreadId) { if (errorProcString) { /* Extra safety */ ckfree(errorProcString); errorProcString = NULL; } errorThreadId = 0; } if (threadEvalScript) { ckfree(threadEvalScript); threadEvalScript = NULL; } Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL); for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) { nextPtr = resultPtr->nextPtr; if (resultPtr->srcThreadId == self) { /* * We are going away. By freeing up the result we signal to the * other thread we don't care about the result. */ if (resultPtr->prevPtr) { resultPtr->prevPtr->nextPtr = resultPtr->nextPtr; } else { resultList = resultPtr->nextPtr; } if (resultPtr->nextPtr) { resultPtr->nextPtr->prevPtr = resultPtr->prevPtr; } resultPtr->nextPtr = resultPtr->prevPtr = 0; resultPtr->eventPtr->resultPtr = NULL; ckfree(resultPtr); } else if (resultPtr->dstThreadId == self) { /* * Dang. The target is going away. Unblock the caller. The result * string must be dynamically allocated because the main thread is * going to call free on it. */ const char *msg = "target thread died"; resultPtr->result = ckalloc(strlen(msg) + 1); strcpy(resultPtr->result, msg); resultPtr->code = TCL_ERROR; Tcl_ConditionNotify(&resultPtr->done); } } Tcl_MutexUnlock(&threadMutex); } #endif /* TCL_THREADS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclTimer.c0000644000175000017500000010767514554262142015225 0ustar sergeisergei/* * tclTimer.c -- * * This file provides timer event management facilities for Tcl, * including the "after" command. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * For each timer callback that's pending there is one record of the following * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained * together in a list sorted by time (earliest event first). */ typedef struct TimerHandler { Tcl_Time time; /* When timer is to fire. */ Tcl_TimerProc *proc; /* Function to call. */ ClientData clientData; /* Argument to pass to proc. */ Tcl_TimerToken token; /* Identifies handler so it can be deleted. */ struct TimerHandler *nextPtr; /* Next event in queue, or NULL for end of * queue. */ } TimerHandler; /* * The data structure below is used by the "after" command to remember the * command to be executed later. All of the pending "after" commands for an * interpreter are linked together in a list. */ typedef struct AfterInfo { struct AfterAssocData *assocPtr; /* Pointer to the "tclAfter" assocData for the * interp in which command will be * executed. */ Tcl_Obj *commandPtr; /* Command to execute. */ int id; /* Integer identifier for command; used to * cancel it. */ Tcl_TimerToken token; /* Used to cancel the "after" command. NULL * means that the command is run as an idle * handler rather than as a timer handler. * NULL means this is an "after idle" handler * rather than a timer handler. */ struct AfterInfo *nextPtr; /* Next in list of all "after" commands for * this interpreter. */ } AfterInfo; /* * One of the following structures is associated with each interpreter for * which an "after" command has ever been invoked. A pointer to this structure * is stored in the AssocData for the "tclAfter" key. */ typedef struct AfterAssocData { Tcl_Interp *interp; /* The interpreter for which this data is * registered. */ AfterInfo *firstAfterPtr; /* First in list of all "after" commands still * pending for this interpreter, or NULL if * none. */ } AfterAssocData; /* * There is one of the following structures for each of the handlers declared * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are * linked together into a list. */ typedef struct IdleHandler { Tcl_IdleProc *proc; /* Function to call. */ ClientData clientData; /* Value to pass to proc. */ int generation; /* Used to distinguish older handlers from * recently-created ones. */ struct IdleHandler *nextPtr;/* Next in list of active handlers. */ } IdleHandler; /* * The timer and idle queues are per-thread because they are associated with * the notifier, which is also per-thread. * * All static variables used in this file are collected into a single instance * of the following structure. For multi-threaded implementations, there is * one instance of this structure for each thread. * * Notice that different structures with the same name appear in other files. * The structure defined below is used in this file only. */ typedef struct ThreadSpecificData { TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ int lastTimerId; /* Timer identifier of most recently created * timer. */ int timerPending; /* 1 if a timer event is in the queue. */ IdleHandler *idleList; /* First in list of all idle handlers. */ IdleHandler *lastIdlePtr; /* Last in list (or NULL for empty list). */ int idleGeneration; /* Used to fill in the "generation" fields of * IdleHandler structures. Increments each * time Tcl_DoOneEvent starts calling idle * handlers, so that all old handlers can be * called without calling any of the new ones * created by old ones. */ int afterId; /* For unique identifiers of after events. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS computes * the number of milliseconds difference between two times. Both macros use * both of their arguments multiple times, so make sure they are cheap and * side-effect free. The "prototypes" for these macros are: * * static int TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2); * static long TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2); */ #define TCL_TIME_BEFORE(t1, t2) \ (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec)) #define TCL_TIME_DIFF_MS(t1, t2) \ (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ ((long)(t1).usec - (long)(t2).usec)/1000) #define TCL_TIME_DIFF_MS_CEILING(t1, t2) \ (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ ((long)(t1).usec - (long)(t2).usec + 999)/1000) /* * Sleeps under that number of milliseconds don't get double-checked * and are done in exactly one Tcl_Sleep(). This to limit gettimeofday()s. */ #define SLEEP_OFFLOAD_GETTIMEOFDAY 20 /* * The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay. * This is used to limit the maximum lag between interp limit and script * cancellation checks. */ #define TCL_TIME_MAXIMUM_SLICE 500 /* * Prototypes for functions referenced only in this file: */ static void AfterCleanupProc(ClientData clientData, Tcl_Interp *interp); static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms); static void AfterProc(ClientData clientData); static void FreeAfterPtr(AfterInfo *afterPtr); static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, Tcl_Obj *commandPtr); static ThreadSpecificData *InitTimer(void); static void TimerExitProc(ClientData clientData); static int TimerHandlerEventProc(Tcl_Event *evPtr, int flags); static void TimerCheckProc(ClientData clientData, int flags); static void TimerSetupProc(ClientData clientData, int flags); /* *---------------------------------------------------------------------- * * InitTimer -- * * This function initializes the timer module. * * Results: * A pointer to the thread specific data. * * Side effects: * Registers the idle and timer event sources. * *---------------------------------------------------------------------- */ static ThreadSpecificData * InitTimer(void) { ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); Tcl_CreateThreadExitHandler(TimerExitProc, NULL); } return tsdPtr; } /* *---------------------------------------------------------------------- * * TimerExitProc -- * * This function is call at exit or unload time to remove the timer and * idle event sources. * * Results: * None. * * Side effects: * Removes the timer and idle event sources and remaining events. * *---------------------------------------------------------------------- */ static void TimerExitProc( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { TimerHandler *timerHandlerPtr; timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; while (timerHandlerPtr != NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; ckfree(timerHandlerPtr); timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; } } } /* *-------------------------------------------------------------- * * Tcl_CreateTimerHandler -- * * Arrange for a given function to be invoked at a particular time in the * future. * * Results: * The return value is a token for the timer event, which may be used to * delete the event before it fires. * * Side effects: * When milliseconds have elapsed, proc will be invoked exactly once. * *-------------------------------------------------------------- */ Tcl_TimerToken Tcl_CreateTimerHandler( int milliseconds, /* How many milliseconds to wait before * invoking proc. */ Tcl_TimerProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { Tcl_Time time; /* * Compute when the event should fire. */ Tcl_GetTime(&time); time.sec += milliseconds/1000; time.usec += (milliseconds%1000)*1000; if (time.usec >= 1000000) { time.usec -= 1000000; time.sec += 1; } return TclCreateAbsoluteTimerHandler(&time, proc, clientData); } /* *-------------------------------------------------------------- * * TclCreateAbsoluteTimerHandler -- * * Arrange for a given function to be invoked at a particular time in the * future. * * Results: * The return value is a token for the timer event, which may be used to * delete the event before it fires. * * Side effects: * When the time in timePtr has been reached, proc will be invoked * exactly once. * *-------------------------------------------------------------- */ Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData) { TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); timerHandlerPtr = ckalloc(sizeof(TimerHandler)); /* * Fill in fields for the event. */ memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time)); timerHandlerPtr->proc = proc; timerHandlerPtr->clientData = clientData; tsdPtr->lastTimerId++; timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId); /* * Add the event to the queue in the correct position (ordered by event * firing time). */ for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) { if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) { break; } } timerHandlerPtr->nextPtr = tPtr2; if (prevPtr == NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr; } else { prevPtr->nextPtr = timerHandlerPtr; } TimerSetupProc(NULL, TCL_ALL_EVENTS); return timerHandlerPtr->token; } /* *-------------------------------------------------------------- * * Tcl_DeleteTimerHandler -- * * Delete a previously-registered timer handler. * * Results: * None. * * Side effects: * Destroy the timer callback identified by TimerToken, so that its * associated function will not be called. If the callback has already * fired, or if the given token doesn't exist, then nothing happens. * *-------------------------------------------------------------- */ void Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by * Tcl_DeleteTimerHandler. */ { TimerHandler *timerHandlerPtr, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { return; } for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; timerHandlerPtr != NULL; prevPtr = timerHandlerPtr, timerHandlerPtr = timerHandlerPtr->nextPtr) { if (timerHandlerPtr->token != token) { continue; } if (prevPtr == NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; } else { prevPtr->nextPtr = timerHandlerPtr->nextPtr; } ckfree(timerHandlerPtr); return; } } /* *---------------------------------------------------------------------- * * TimerSetupProc -- * * This function is called by Tcl_DoOneEvent to setup the timer event * source for before blocking. This routine checks both the idle and * after timer lists. * * Results: * None. * * Side effects: * May update the maximum notifier block time. * *---------------------------------------------------------------------- */ static void TimerSetupProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList) || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) { /* * There is an idle handler or a pending timer event, so just poll. */ blockTime.sec = 0; blockTime.usec = 0; } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { /* * Compute the timeout for the next timer on the list. */ Tcl_GetTime(&blockTime); blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - blockTime.usec; if (blockTime.usec < 0) { blockTime.sec -= 1; blockTime.usec += 1000000; } if (blockTime.sec < 0) { blockTime.sec = 0; blockTime.usec = 0; } } else { return; } Tcl_SetMaxBlockTime(&blockTime); } /* *---------------------------------------------------------------------- * * TimerCheckProc -- * * This function is called by Tcl_DoOneEvent to check the timer event * source for events. This routine checks both the idle and after timer * lists. * * Results: * None. * * Side effects: * May queue an event and update the maximum notifier block time. * *---------------------------------------------------------------------- */ static void TimerCheckProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Event *timerEvPtr; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { /* * Compute the timeout for the next timer on the list. */ Tcl_GetTime(&blockTime); blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - blockTime.usec; if (blockTime.usec < 0) { blockTime.sec -= 1; blockTime.usec += 1000000; } if (blockTime.sec < 0) { blockTime.sec = 0; blockTime.usec = 0; } /* * If the first timer has expired, stick an event on the queue. */ if (blockTime.sec == 0 && blockTime.usec == 0 && !tsdPtr->timerPending) { tsdPtr->timerPending = 1; timerEvPtr = ckalloc(sizeof(Tcl_Event)); timerEvPtr->proc = TimerHandlerEventProc; Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); } } } /* *---------------------------------------------------------------------- * * TimerHandlerEventProc -- * * This function is called by Tcl_ServiceEvent when a timer event reaches * the front of the event queue. This function handles the event by * invoking the callbacks for all timers that are ready. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_TIMER_EVENTS flag bit isn't set. * * Side effects: * Whatever the timer handler callback functions do. * *---------------------------------------------------------------------- */ static int TimerHandlerEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { TimerHandler *timerHandlerPtr, **nextPtrPtr; Tcl_Time time; int currentTimerId; ThreadSpecificData *tsdPtr = InitTimer(); /* * Do nothing if timers aren't enabled. This leaves the event on the * queue, so we will get to it as soon as ServiceEvents() is called with * timers enabled. */ if (!(flags & TCL_TIMER_EVENTS)) { return 0; } /* * The code below is trickier than it may look, for the following reasons: * * 1. New handlers can get added to the list while the current one is * being processed. If new ones get added, we don't want to process * them during this pass through the list to avoid starving other event * sources. This is implemented using the token number in the handler: * new handlers will have a newer token than any of the ones currently * on the list. * 2. The handler can call Tcl_DoOneEvent, so we have to remove the * handler from the list before calling it. Otherwise an infinite loop * could result. * 3. Tcl_DeleteTimerHandler can be called to remove an element from the * list while a handler is executing, so the list could change * structure during the call. * 4. Because we only fetch the current time before entering the loop, the * only way a new timer will even be considered runnable is if its * expiration time is within the same millisecond as the current time. * This is fairly likely on Windows, since it has a course granularity * clock. Since timers are placed on the queue in time order with the * most recently created handler appearing after earlier ones with the * same expiration time, we don't have to worry about newer generation * timers appearing before later ones. */ tsdPtr->timerPending = 0; currentTimerId = tsdPtr->lastTimerId; Tcl_GetTime(&time); while (1) { nextPtrPtr = &tsdPtr->firstTimerHandlerPtr; timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; if (timerHandlerPtr == NULL) { break; } if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) { break; } /* * Bail out if the next timer is of a newer generation. */ if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) { break; } /* * Remove the handler from the queue before invoking it, to avoid * potential reentrancy problems. */ *nextPtrPtr = timerHandlerPtr->nextPtr; timerHandlerPtr->proc(timerHandlerPtr->clientData); ckfree(timerHandlerPtr); } TimerSetupProc(NULL, TCL_TIMER_EVENTS); return 1; } /* *-------------------------------------------------------------- * * Tcl_DoWhenIdle -- * * Arrange for proc to be invoked the next time the system is idle (i.e., * just before the next time that Tcl_DoOneEvent would have to wait for * something to happen). * * Results: * None. * * Side effects: * Proc will eventually be called, with clientData as argument. See the * manual entry for details. * *-------------------------------------------------------------- */ void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); idlePtr = ckalloc(sizeof(IdleHandler)); idlePtr->proc = proc; idlePtr->clientData = clientData; idlePtr->generation = tsdPtr->idleGeneration; idlePtr->nextPtr = NULL; if (tsdPtr->lastIdlePtr == NULL) { tsdPtr->idleList = idlePtr; } else { tsdPtr->lastIdlePtr->nextPtr = idlePtr; } tsdPtr->lastIdlePtr = idlePtr; blockTime.sec = 0; blockTime.usec = 0; Tcl_SetMaxBlockTime(&blockTime); } /* *---------------------------------------------------------------------- * * Tcl_CancelIdleCall -- * * If there are any when-idle calls requested to a given function with * given clientData, cancel all of them. * * Results: * None. * * Side effects: * If the proc/clientData combination were on the when-idle list, they * are removed so that they will never be called. * *---------------------------------------------------------------------- */ void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr, *prevPtr; IdleHandler *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { while ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { nextPtr = idlePtr->nextPtr; ckfree(idlePtr); idlePtr = nextPtr; if (prevPtr == NULL) { tsdPtr->idleList = idlePtr; } else { prevPtr->nextPtr = idlePtr; } if (idlePtr == NULL) { tsdPtr->lastIdlePtr = prevPtr; return; } } } } /* *---------------------------------------------------------------------- * * TclServiceIdle -- * * This function is invoked by the notifier when it becomes idle. It will * invoke all idle handlers that are present at the time the call is * invoked, but not those added during idle processing. * * Results: * The return value is 1 if TclServiceIdle found something to do, * otherwise return value is 0. * * Side effects: * Invokes all pending idle handlers. * *---------------------------------------------------------------------- */ int TclServiceIdle(void) { IdleHandler *idlePtr; int oldGeneration; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); if (tsdPtr->idleList == NULL) { return 0; } oldGeneration = tsdPtr->idleGeneration; tsdPtr->idleGeneration++; /* * The code below is trickier than it may look, for the following reasons: * * 1. New handlers can get added to the list while the current one is * being processed. If new ones get added, we don't want to process * them during this pass through the list (want to check for other work * to do first). This is implemented using the generation number in the * handler: new handlers will have a different generation than any of * the ones currently on the list. * 2. The handler can call Tcl_DoOneEvent, so we have to remove the * handler from the list before calling it. Otherwise an infinite loop * could result. * 3. Tcl_CancelIdleCall can be called to remove an element from the list * while a handler is executing, so the list could change structure * during the call. */ for (idlePtr = tsdPtr->idleList; ((idlePtr != NULL) && ((oldGeneration - idlePtr->generation) >= 0)); idlePtr = tsdPtr->idleList) { tsdPtr->idleList = idlePtr->nextPtr; if (tsdPtr->idleList == NULL) { tsdPtr->lastIdlePtr = NULL; } idlePtr->proc(idlePtr->clientData); ckfree(idlePtr); } if (tsdPtr->idleList) { blockTime.sec = 0; blockTime.usec = 0; Tcl_SetMaxBlockTime(&blockTime); } return 1; } /* *---------------------------------------------------------------------- * * Tcl_AfterObjCmd -- * * This function is invoked to process the "after" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_AfterObjCmd( ClientData clientData, /* Unused */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_WideInt ms = 0; /* Number of milliseconds to wait */ Tcl_Time wakeup; AfterInfo *afterPtr; AfterAssocData *assocPtr; int length; int index; static const char *const afterSubCmds[] = { "cancel", "idle", "info", NULL }; enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; ThreadSpecificData *tsdPtr = InitTimer(); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } /* * Create the "after" information associated for this interpreter, if it * doesn't already exist. */ assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL); if (assocPtr == NULL) { assocPtr = ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr); } /* * First lets see if the command was passed a number as the first argument. */ if (objv[1]->typePtr == &tclIntType #ifndef TCL_WIDE_INT_IS_LONG || objv[1]->typePtr == &tclWideIntType #endif || objv[1]->typePtr == &tclBignumType || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK)) { index = -1; if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { const char *arg = Tcl_GetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument \"%s\": must be" " cancel, idle, info, or an integer", arg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", arg, NULL); return TCL_ERROR; } } /* * At this point, either index = -1 and ms contains the number of ms * to wait, or else index is the index of a subcommand. */ switch (index) { case -1: { if (ms < 0) { ms = 0; } if (objc == 2) { return AfterDelay(interp, ms); } afterPtr = ckalloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; } else { afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); } Tcl_IncrRefCount(afterPtr->commandPtr); /* * The variable below is used to generate unique identifiers for after * commands. This id can wrap around, which can potentially cause * problems. However, there are not likely to be problems in practice, * because after commands can only be requested to about a month in * the future, and wrap-around is unlikely to occur in less than about * 1-10 years. Thus it's unlikely that any old ids will still be * around when wrap-around occurs. */ afterPtr->id = tsdPtr->afterId; tsdPtr->afterId += 1; Tcl_GetTime(&wakeup); wakeup.sec += (long)(ms / 1000); wakeup.usec += ((long)(ms % 1000)) * 1000; if (wakeup.usec > 1000000) { wakeup.sec++; wakeup.usec -= 1000000; } afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc, afterPtr); afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); return TCL_OK; } case AFTER_CANCEL: { Tcl_Obj *commandPtr; const char *command, *tempCommand; int tempLength; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "id|command"); return TCL_ERROR; } if (objc == 3) { commandPtr = objv[2]; } else { commandPtr = Tcl_ConcatObj(objc-2, objv+2); } command = Tcl_GetStringFromObj(commandPtr, &length); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr, &tempLength); if ((length == tempLength) && !memcmp(command, tempCommand, length)) { break; } } if (afterPtr == NULL) { afterPtr = GetAfterEvent(assocPtr, commandPtr); } if (objc != 3) { Tcl_DecrRefCount(commandPtr); } if (afterPtr != NULL) { if (afterPtr->token != NULL) { Tcl_DeleteTimerHandler(afterPtr->token); } else { Tcl_CancelIdleCall(AfterProc, afterPtr); } FreeAfterPtr(afterPtr); } break; } case AFTER_IDLE: if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?"); return TCL_ERROR; } afterPtr = ckalloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; } else { afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); } Tcl_IncrRefCount(afterPtr->commandPtr); afterPtr->id = tsdPtr->afterId; tsdPtr->afterId += 1; afterPtr->token = NULL; afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; Tcl_DoWhenIdle(AfterProc, afterPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); break; case AFTER_INFO: if (objc == 2) { Tcl_Obj *resultObj; TclNewObj(resultObj); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { if (assocPtr->interp == interp) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( "after#%d", afterPtr->id)); } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "?id?"); return TCL_ERROR; } afterPtr = GetAfterEvent(assocPtr, objv[2]); if (afterPtr == NULL) { const char *eventStr = TclGetString(objv[2]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "event \"%s\" doesn't exist", eventStr)); Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL); return TCL_ERROR; } else { Tcl_Obj *resultListPtr; TclNewObj(resultListPtr); Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr); Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (afterPtr->token == NULL) ? "idle" : "timer", -1)); Tcl_SetObjResult(interp, resultListPtr); } break; default: Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); } return TCL_OK; } /* *---------------------------------------------------------------------- * * AfterDelay -- * * Implements the blocking delay behaviour of [after $time]. Tricky * because it has to take into account any time limit that has been set. * * Results: * Standard Tcl result code (with error set if an error occurred due to a * time limit being exceeded or being canceled). * * Side effects: * May adjust the time limit granularity marker. * *---------------------------------------------------------------------- */ static int AfterDelay( Tcl_Interp *interp, Tcl_WideInt ms) { Interp *iPtr = (Interp *) interp; Tcl_Time endTime, now; Tcl_WideInt diff; Tcl_GetTime(&now); endTime = now; endTime.sec += (long)(ms / 1000); endTime.usec += ((int)(ms % 1000)) * 1000; if (endTime.usec >= 1000000) { endTime.sec++; endTime.usec -= 1000000; } do { if (Tcl_AsyncReady()) { if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { return TCL_ERROR; } } if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { return TCL_ERROR; } if (iPtr->limit.timeEvent != NULL && TCL_TIME_BEFORE(iPtr->limit.time, now)) { iPtr->limit.granularityTicker = 0; if (Tcl_LimitCheck(interp) != TCL_OK) { return TCL_ERROR; } } if (iPtr->limit.timeEvent == NULL || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { diff = TCL_TIME_DIFF_MS_CEILING(endTime, now); #ifndef TCL_WIDE_INT_IS_LONG if (diff > LONG_MAX) { diff = LONG_MAX; } #endif if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { diff = 1; } if (diff > 0) { Tcl_Sleep((long) diff); if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { break; } } else { break; } } else { diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); #ifndef TCL_WIDE_INT_IS_LONG if (diff > LONG_MAX) { diff = LONG_MAX; } #endif if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } if (diff > 0) { Tcl_Sleep((long) diff); } if (Tcl_AsyncReady()) { if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { return TCL_ERROR; } } if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { return TCL_ERROR; } if (Tcl_LimitCheck(interp) != TCL_OK) { return TCL_ERROR; } } Tcl_GetTime(&now); } while (TCL_TIME_BEFORE(now, endTime)); return TCL_OK; } /* *---------------------------------------------------------------------- * * GetAfterEvent -- * * This function parses an "after" id such as "after#4" and returns a * pointer to the AfterInfo structure. * * Results: * The return value is either a pointer to an AfterInfo structure, if one * is found that corresponds to "cmdString" and is for interp, or NULL if * no corresponding after event can be found. * * Side effects: * None. * *---------------------------------------------------------------------- */ static AfterInfo * GetAfterEvent( AfterAssocData *assocPtr, /* Points to "after"-related information for * this interpreter. */ Tcl_Obj *commandPtr) { const char *cmdString; /* Textual identifier for after event, such as * "after#6". */ AfterInfo *afterPtr; int id; char *end; cmdString = TclGetString(commandPtr); if (strncmp(cmdString, "after#", 6) != 0) { return NULL; } cmdString += 6; id = strtoul(cmdString, &end, 10); if ((end == cmdString) || (*end != 0)) { return NULL; } for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { if (afterPtr->id == id) { return afterPtr; } } return NULL; } /* *---------------------------------------------------------------------- * * AfterProc -- * * Timer callback to execute commands registered with the "after" * command. * * Results: * None. * * Side effects: * Executes whatever command was specified. If the command returns an * error, then the command "bgerror" is invoked to process the error; if * bgerror fails then information about the error is output on stderr. * *---------------------------------------------------------------------- */ static void AfterProc( ClientData clientData) /* Describes command to execute. */ { AfterInfo *afterPtr = clientData; AfterAssocData *assocPtr = afterPtr->assocPtr; AfterInfo *prevPtr; int result; Tcl_Interp *interp; /* * First remove the callback from our list of callbacks; otherwise someone * could delete the callback while it's being executed, which could cause * a core dump. */ if (assocPtr->firstAfterPtr == afterPtr) { assocPtr->firstAfterPtr = afterPtr->nextPtr; } else { for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr; prevPtr = prevPtr->nextPtr) { /* Empty loop body. */ } prevPtr->nextPtr = afterPtr->nextPtr; } /* * Execute the callback. */ interp = assocPtr->interp; Tcl_Preserve(interp); result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (\"after\" script)"); Tcl_BackgroundException(interp, result); } Tcl_Release(interp); /* * Free the memory for the callback. */ Tcl_DecrRefCount(afterPtr->commandPtr); ckfree(afterPtr); } /* *---------------------------------------------------------------------- * * FreeAfterPtr -- * * This function removes an "after" command from the list of those that * are pending and frees its resources. This function does *not* cancel * the timer handler; if that's needed, the caller must do it. * * Results: * None. * * Side effects: * The memory associated with afterPtr is released. * *---------------------------------------------------------------------- */ static void FreeAfterPtr( AfterInfo *afterPtr) /* Command to be deleted. */ { AfterInfo *prevPtr; AfterAssocData *assocPtr = afterPtr->assocPtr; if (assocPtr->firstAfterPtr == afterPtr) { assocPtr->firstAfterPtr = afterPtr->nextPtr; } else { for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr; prevPtr = prevPtr->nextPtr) { /* Empty loop body. */ } prevPtr->nextPtr = afterPtr->nextPtr; } Tcl_DecrRefCount(afterPtr->commandPtr); ckfree(afterPtr); } /* *---------------------------------------------------------------------- * * AfterCleanupProc -- * * This function is invoked whenever an interpreter is deleted * to cleanup the AssocData for "tclAfter". * * Results: * None. * * Side effects: * After commands are removed. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void AfterCleanupProc( ClientData clientData, /* Points to AfterAssocData for the * interpreter. */ Tcl_Interp *interp) /* Interpreter that is being deleted. */ { AfterAssocData *assocPtr = clientData; AfterInfo *afterPtr; while (assocPtr->firstAfterPtr != NULL) { afterPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr->nextPtr; if (afterPtr->token != NULL) { Tcl_DeleteTimerHandler(afterPtr->token); } else { Tcl_CancelIdleCall(AfterProc, afterPtr); } Tcl_DecrRefCount(afterPtr->commandPtr); ckfree(afterPtr); } ckfree(assocPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/generic/tclTomMathDecls.h0000644000175000017500000006535214566153373016501 0ustar sergeisergei/* *---------------------------------------------------------------------- * * tclTomMathDecls.h -- * * This file contains the declarations for the 'libtommath' * functions that are exported by the Tcl library. * * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLTOMMATHDECLS #define _TCLTOMMATHDECLS #include "tcl.h" #ifndef BN_H_ #include "tclTomMath.h" #endif /* * Define the version of the Stubs table that's exported for tommath */ #define TCLTOMMATH_EPOCH 0 #define TCLTOMMATH_REVISION 0 #define Tcl_TomMath_InitStubs(interp,version) \ (TclTomMathInitializeStubs((interp),(version),\ TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION)) /* Define custom memory allocation for libtommath */ /* MODULE_SCOPE void* TclBNAlloc( size_t ); */ #define TclBNAlloc(s) ((void*)ckalloc((size_t)(s))) /* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */ #define TclBNCalloc(m,s) memset(ckalloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s)) /* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */ #define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s))) /* MODULE_SCOPE void TclBNFree( void* ); */ #define TclBNFree(x) (ckfree((char*)(x))) #define MP_MALLOC(size) TclBNAlloc(size) #define MP_CALLOC(nmemb, size) TclBNCalloc(nmemb, size) #define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize) #define MP_FREE(mem, size) TclBNFree(mem) /* Rename the global symbols in libtommath to avoid linkage conflicts */ #define bn_reverse TclBN_reverse #define mp_add TclBN_mp_add #define mp_add_d TclBN_mp_add_d #define mp_and TclBN_mp_and #define mp_clamp TclBN_mp_clamp #define mp_clear TclBN_mp_clear #define mp_clear_multi TclBN_mp_clear_multi #define mp_cmp TclBN_mp_cmp #define mp_cmp_d TclBN_mp_cmp_d #define mp_cmp_mag TclBN_mp_cmp_mag #define mp_cnt_lsb TclBN_mp_cnt_lsb #define mp_copy TclBN_mp_copy #define mp_count_bits TclBN_mp_count_bits #define mp_div TclBN_mp_div #define mp_div_2 TclBN_mp_div_2 #define mp_div_2d TclBN_mp_div_2d #define mp_div_3 TclBN_mp_div_3 #define mp_div_d TclBN_mp_div_d #define mp_exch TclBN_mp_exch #define mp_expt_d TclBN_mp_expt_d #define mp_expt_d_ex TclBN_mp_expt_d_ex #define mp_expt_u32 TclBN_mp_expt_d #define mp_get_mag_ull TclBN_mp_get_mag_ull #define mp_grow TclBN_mp_grow #define mp_init TclBN_mp_init #define mp_init_copy TclBN_mp_init_copy #define mp_init_multi TclBN_mp_init_multi #define mp_init_set TclBN_mp_init_set #define mp_init_set_int TclBN_mp_init_set_int #define mp_init_size TclBN_mp_init_size #define mp_lshd TclBN_mp_lshd #define mp_mod TclBN_mp_mod #define mp_mod_2d TclBN_mp_mod_2d #define mp_mul TclBN_mp_mul #define mp_mul_2 TclBN_mp_mul_2 #define mp_mul_2d TclBN_mp_mul_2d #define mp_mul_d TclBN_mp_mul_d #define mp_neg TclBN_mp_neg #define mp_or TclBN_mp_or #define mp_pack TclBN_mp_pack #define mp_pack_count TclBN_mp_pack_count #define mp_radix_size TclBN_mp_radix_size #define mp_read_radix TclBN_mp_read_radix #define mp_rshd TclBN_mp_rshd #define mp_set TclBN_mp_set #define mp_set_int(a,b) (TclBN_mp_set_int(a,(unsigned int)(b)),MP_OKAY) #define mp_set_ll TclBN_mp_set_ll #define mp_set_long(a,b) (TclBN_mp_set_int(a,b),MP_OKAY) #define mp_set_ul(a,b) (void)TclBN_mp_set_int(a,b) #define mp_set_ull TclBN_mp_set_ull #define mp_set_u64 TclBN_mp_set_ull #define mp_shrink TclBN_mp_shrink #define mp_sqr TclBN_mp_sqr #define mp_sqrt TclBN_mp_sqrt #define mp_sub TclBN_mp_sub #define mp_sub_d TclBN_mp_sub_d #define mp_signed_rsh TclBN_mp_signed_rsh #define mp_tc_and TclBN_mp_and #define mp_tc_div_2d TclBN_mp_signed_rsh #define mp_tc_or TclBN_mp_or #define mp_tc_xor TclBN_mp_xor #define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin #define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n #define mp_toradix_n TclBN_mp_toradix_n #define mp_to_radix TclBN_mp_to_radix #define mp_to_ubin TclBN_mp_to_ubin #define mp_unpack TclBN_mp_unpack #define mp_ubin_size TclBN_mp_unsigned_bin_size #define mp_unsigned_bin_size(a) ((int)TclBN_mp_unsigned_bin_size(a)) #define mp_xor TclBN_mp_xor #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add #define s_mp_balance_mul TclBN_mp_balance_mul #define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul #define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr #define s_mp_mul_digs TclBN_s_mp_mul_digs #define s_mp_mul_digs_fast TclBN_fast_s_mp_mul_digs #define s_mp_reverse TclBN_s_mp_reverse #define s_mp_sqr TclBN_s_mp_sqr #define s_mp_sqr_fast TclBN_fast_s_mp_sqr #define s_mp_sub TclBN_s_mp_sub #define s_mp_toom_mul TclBN_mp_toom_mul #define s_mp_toom_sqr TclBN_mp_toom_sqr #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tclInt.decls script. */ /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ /* 0 */ EXTERN int TclBN_epoch(void); /* 1 */ EXTERN int TclBN_revision(void); /* 2 */ EXTERN mp_err TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c); /* 3 */ EXTERN mp_err TclBN_mp_add_d(const mp_int *a, mp_digit b, mp_int *c); /* 4 */ EXTERN mp_err TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c); /* 5 */ EXTERN void TclBN_mp_clamp(mp_int *a); /* 6 */ EXTERN void TclBN_mp_clear(mp_int *a); /* 7 */ EXTERN void TclBN_mp_clear_multi(mp_int *a, ...); /* 8 */ EXTERN mp_ord TclBN_mp_cmp(const mp_int *a, const mp_int *b); /* 9 */ EXTERN mp_ord TclBN_mp_cmp_d(const mp_int *a, mp_digit b); /* 10 */ EXTERN mp_ord TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b); /* 11 */ EXTERN mp_err TclBN_mp_copy(const mp_int *a, mp_int *b); /* 12 */ EXTERN int TclBN_mp_count_bits(const mp_int *a); /* 13 */ EXTERN mp_err TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r); /* 14 */ EXTERN mp_err TclBN_mp_div_d(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 15 */ EXTERN mp_err TclBN_mp_div_2(const mp_int *a, mp_int *q); /* 16 */ EXTERN mp_err TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r); /* 17 */ EXTERN mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r); /* 18 */ EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b); /* 19 */ EXTERN mp_err TclBN_mp_expt_d(const mp_int *a, unsigned int b, mp_int *c); /* 20 */ EXTERN mp_err TclBN_mp_grow(mp_int *a, int size); /* 21 */ EXTERN mp_err TclBN_mp_init(mp_int *a); /* 22 */ EXTERN mp_err TclBN_mp_init_copy(mp_int *a, const mp_int *b); /* 23 */ EXTERN mp_err TclBN_mp_init_multi(mp_int *a, ...); /* 24 */ EXTERN mp_err TclBN_mp_init_set(mp_int *a, mp_digit b); /* 25 */ EXTERN mp_err TclBN_mp_init_size(mp_int *a, int size); /* 26 */ EXTERN mp_err TclBN_mp_lshd(mp_int *a, int shift); /* 27 */ EXTERN mp_err TclBN_mp_mod(const mp_int *a, const mp_int *b, mp_int *r); /* 28 */ EXTERN mp_err TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r); /* 29 */ EXTERN mp_err TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p); /* 30 */ EXTERN mp_err TclBN_mp_mul_d(const mp_int *a, mp_digit b, mp_int *p); /* 31 */ EXTERN mp_err TclBN_mp_mul_2(const mp_int *a, mp_int *p); /* 32 */ EXTERN mp_err TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p); /* 33 */ EXTERN mp_err TclBN_mp_neg(const mp_int *a, mp_int *b); /* 34 */ EXTERN mp_err TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c); /* 35 */ EXTERN mp_err TclBN_mp_radix_size(const mp_int *a, int radix, int *size); /* 36 */ EXTERN mp_err TclBN_mp_read_radix(mp_int *a, const char *str, int radix); /* 37 */ EXTERN void TclBN_mp_rshd(mp_int *a, int shift); /* 38 */ EXTERN mp_err TclBN_mp_shrink(mp_int *a); /* 39 */ EXTERN void TclBN_mp_set(mp_int *a, mp_digit b); /* 40 */ EXTERN mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b); /* 41 */ EXTERN mp_err TclBN_mp_sqrt(const mp_int *a, mp_int *b); /* 42 */ EXTERN mp_err TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c); /* 43 */ EXTERN mp_err TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); /* 44 */ EXTERN mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b); /* 45 */ EXTERN mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen); /* 46 */ EXTERN mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen); /* 47 */ EXTERN size_t TclBN_mp_unsigned_bin_size(const mp_int *a); /* 48 */ EXTERN mp_err TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c); /* 49 */ EXTERN void TclBN_mp_zero(mp_int *a); /* 50 */ EXTERN void TclBN_reverse(unsigned char *s, int len); /* 51 */ EXTERN mp_err TclBN_fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 52 */ EXTERN mp_err TclBN_fast_s_mp_sqr(const mp_int *a, mp_int *b); /* 53 */ EXTERN mp_err TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c); /* 54 */ EXTERN mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b); /* 55 */ EXTERN mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c); /* 56 */ EXTERN mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b); /* 57 */ EXTERN mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c); /* 58 */ EXTERN mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 59 */ EXTERN mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b); /* 60 */ EXTERN mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c); /* 61 */ EXTERN mp_err TclBN_mp_init_set_int(mp_int *a, unsigned long i); /* 62 */ EXTERN mp_err TclBN_mp_set_int(mp_int *a, unsigned long i); /* 63 */ EXTERN int TclBN_mp_cnt_lsb(const mp_int *a); /* 64 */ EXTERN int TclBNInitBignumFromLong(mp_int *bignum, long initVal); /* 65 */ EXTERN int TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal); /* 66 */ EXTERN int TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal); /* 67 */ EXTERN mp_err TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast); /* 68 */ EXTERN void TclBN_mp_set_ull(mp_int *a, Tcl_WideUInt i); /* 69 */ EXTERN Tcl_WideUInt TclBN_mp_get_mag_ull(const mp_int *a); /* 70 */ EXTERN void TclBN_mp_set_ll(mp_int *a, Tcl_WideInt i); /* 71 */ EXTERN mp_err TclBN_mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op); /* 72 */ EXTERN mp_err TclBN_mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op); /* 73 */ EXTERN mp_err TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c); /* 74 */ EXTERN mp_err TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c); /* 75 */ EXTERN mp_err TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c); /* 76 */ EXTERN mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c); /* 77 */ EXTERN size_t TclBN_mp_pack_count(const mp_int *a, size_t nails, size_t size); /* 78 */ EXTERN int TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written); /* 79 */ EXTERN mp_err TclBN_mp_div_ld(const mp_int *a, Tcl_WideUInt b, mp_int *q, Tcl_WideUInt *r); /* 80 */ EXTERN int TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix); typedef struct TclTomMathStubs { int magic; void *hooks; int (*tclBN_epoch) (void); /* 0 */ int (*tclBN_revision) (void); /* 1 */ mp_err (*tclBN_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 2 */ mp_err (*tclBN_mp_add_d) (const mp_int *a, mp_digit b, mp_int *c); /* 3 */ mp_err (*tclBN_mp_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 4 */ void (*tclBN_mp_clamp) (mp_int *a); /* 5 */ void (*tclBN_mp_clear) (mp_int *a); /* 6 */ void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */ mp_ord (*tclBN_mp_cmp) (const mp_int *a, const mp_int *b); /* 8 */ mp_ord (*tclBN_mp_cmp_d) (const mp_int *a, mp_digit b); /* 9 */ mp_ord (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b); /* 10 */ mp_err (*tclBN_mp_copy) (const mp_int *a, mp_int *b); /* 11 */ int (*tclBN_mp_count_bits) (const mp_int *a); /* 12 */ mp_err (*tclBN_mp_div) (const mp_int *a, const mp_int *b, mp_int *q, mp_int *r); /* 13 */ mp_err (*tclBN_mp_div_d) (const mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */ mp_err (*tclBN_mp_div_2) (const mp_int *a, mp_int *q); /* 15 */ mp_err (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */ mp_err (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, mp_digit *r); /* 17 */ void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */ mp_err (*tclBN_mp_expt_d) (const mp_int *a, unsigned int b, mp_int *c); /* 19 */ mp_err (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */ mp_err (*tclBN_mp_init) (mp_int *a); /* 21 */ mp_err (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b); /* 22 */ mp_err (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */ mp_err (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */ mp_err (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */ mp_err (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */ mp_err (*tclBN_mp_mod) (const mp_int *a, const mp_int *b, mp_int *r); /* 27 */ mp_err (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r); /* 28 */ mp_err (*tclBN_mp_mul) (const mp_int *a, const mp_int *b, mp_int *p); /* 29 */ mp_err (*tclBN_mp_mul_d) (const mp_int *a, mp_digit b, mp_int *p); /* 30 */ mp_err (*tclBN_mp_mul_2) (const mp_int *a, mp_int *p); /* 31 */ mp_err (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p); /* 32 */ mp_err (*tclBN_mp_neg) (const mp_int *a, mp_int *b); /* 33 */ mp_err (*tclBN_mp_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 34 */ mp_err (*tclBN_mp_radix_size) (const mp_int *a, int radix, int *size); /* 35 */ mp_err (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix); /* 36 */ void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */ mp_err (*tclBN_mp_shrink) (mp_int *a); /* 38 */ void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */ mp_err (*tclBN_mp_sqr) (const mp_int *a, mp_int *b); /* 40 */ mp_err (*tclBN_mp_sqrt) (const mp_int *a, mp_int *b); /* 41 */ mp_err (*tclBN_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 42 */ mp_err (*tclBN_mp_sub_d) (const mp_int *a, mp_digit b, mp_int *c); /* 43 */ mp_err (*tclBN_mp_to_unsigned_bin) (const mp_int *a, unsigned char *b); /* 44 */ mp_err (*tclBN_mp_to_unsigned_bin_n) (const mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */ mp_err (*tclBN_mp_toradix_n) (const mp_int *a, char *str, int radix, int maxlen); /* 46 */ size_t (*tclBN_mp_unsigned_bin_size) (const mp_int *a); /* 47 */ mp_err (*tclBN_mp_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 48 */ void (*tclBN_mp_zero) (mp_int *a); /* 49 */ void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */ mp_err (*tclBN_fast_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 51 */ mp_err (*tclBN_fast_s_mp_sqr) (const mp_int *a, mp_int *b); /* 52 */ mp_err (*tclBN_mp_karatsuba_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 53 */ mp_err (*tclBN_mp_karatsuba_sqr) (const mp_int *a, mp_int *b); /* 54 */ mp_err (*tclBN_mp_toom_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 55 */ mp_err (*tclBN_mp_toom_sqr) (const mp_int *a, mp_int *b); /* 56 */ mp_err (*tclBN_s_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 57 */ mp_err (*tclBN_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 58 */ mp_err (*tclBN_s_mp_sqr) (const mp_int *a, mp_int *b); /* 59 */ mp_err (*tclBN_s_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 60 */ mp_err (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */ mp_err (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */ int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */ int (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */ int (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */ int (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */ mp_err (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */ void (*tclBN_mp_set_ull) (mp_int *a, Tcl_WideUInt i); /* 68 */ Tcl_WideUInt (*tclBN_mp_get_mag_ull) (const mp_int *a); /* 69 */ void (*tclBN_mp_set_ll) (mp_int *a, Tcl_WideInt i); /* 70 */ mp_err (*tclBN_mp_unpack) (mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op); /* 71 */ mp_err (*tclBN_mp_pack) (void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op); /* 72 */ mp_err (*tclBN_mp_tc_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 73 */ mp_err (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 74 */ mp_err (*tclBN_mp_tc_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 75 */ mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c); /* 76 */ size_t (*tclBN_mp_pack_count) (const mp_int *a, size_t nails, size_t size); /* 77 */ int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written); /* 78 */ mp_err (*tclBN_mp_div_ld) (const mp_int *a, Tcl_WideUInt b, mp_int *q, Tcl_WideUInt *r); /* 79 */ int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix); /* 80 */ } TclTomMathStubs; extern const TclTomMathStubs *tclTomMathStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) /* * Inline function declarations: */ #define TclBN_epoch \ (tclTomMathStubsPtr->tclBN_epoch) /* 0 */ #define TclBN_revision \ (tclTomMathStubsPtr->tclBN_revision) /* 1 */ #define TclBN_mp_add \ (tclTomMathStubsPtr->tclBN_mp_add) /* 2 */ #define TclBN_mp_add_d \ (tclTomMathStubsPtr->tclBN_mp_add_d) /* 3 */ #define TclBN_mp_and \ (tclTomMathStubsPtr->tclBN_mp_and) /* 4 */ #define TclBN_mp_clamp \ (tclTomMathStubsPtr->tclBN_mp_clamp) /* 5 */ #define TclBN_mp_clear \ (tclTomMathStubsPtr->tclBN_mp_clear) /* 6 */ #define TclBN_mp_clear_multi \ (tclTomMathStubsPtr->tclBN_mp_clear_multi) /* 7 */ #define TclBN_mp_cmp \ (tclTomMathStubsPtr->tclBN_mp_cmp) /* 8 */ #define TclBN_mp_cmp_d \ (tclTomMathStubsPtr->tclBN_mp_cmp_d) /* 9 */ #define TclBN_mp_cmp_mag \ (tclTomMathStubsPtr->tclBN_mp_cmp_mag) /* 10 */ #define TclBN_mp_copy \ (tclTomMathStubsPtr->tclBN_mp_copy) /* 11 */ #define TclBN_mp_count_bits \ (tclTomMathStubsPtr->tclBN_mp_count_bits) /* 12 */ #define TclBN_mp_div \ (tclTomMathStubsPtr->tclBN_mp_div) /* 13 */ #define TclBN_mp_div_d \ (tclTomMathStubsPtr->tclBN_mp_div_d) /* 14 */ #define TclBN_mp_div_2 \ (tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */ #define TclBN_mp_div_2d \ (tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */ #define TclBN_mp_div_3 \ (tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */ #define TclBN_mp_exch \ (tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */ #define TclBN_mp_expt_d \ (tclTomMathStubsPtr->tclBN_mp_expt_d) /* 19 */ #define TclBN_mp_grow \ (tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */ #define TclBN_mp_init \ (tclTomMathStubsPtr->tclBN_mp_init) /* 21 */ #define TclBN_mp_init_copy \ (tclTomMathStubsPtr->tclBN_mp_init_copy) /* 22 */ #define TclBN_mp_init_multi \ (tclTomMathStubsPtr->tclBN_mp_init_multi) /* 23 */ #define TclBN_mp_init_set \ (tclTomMathStubsPtr->tclBN_mp_init_set) /* 24 */ #define TclBN_mp_init_size \ (tclTomMathStubsPtr->tclBN_mp_init_size) /* 25 */ #define TclBN_mp_lshd \ (tclTomMathStubsPtr->tclBN_mp_lshd) /* 26 */ #define TclBN_mp_mod \ (tclTomMathStubsPtr->tclBN_mp_mod) /* 27 */ #define TclBN_mp_mod_2d \ (tclTomMathStubsPtr->tclBN_mp_mod_2d) /* 28 */ #define TclBN_mp_mul \ (tclTomMathStubsPtr->tclBN_mp_mul) /* 29 */ #define TclBN_mp_mul_d \ (tclTomMathStubsPtr->tclBN_mp_mul_d) /* 30 */ #define TclBN_mp_mul_2 \ (tclTomMathStubsPtr->tclBN_mp_mul_2) /* 31 */ #define TclBN_mp_mul_2d \ (tclTomMathStubsPtr->tclBN_mp_mul_2d) /* 32 */ #define TclBN_mp_neg \ (tclTomMathStubsPtr->tclBN_mp_neg) /* 33 */ #define TclBN_mp_or \ (tclTomMathStubsPtr->tclBN_mp_or) /* 34 */ #define TclBN_mp_radix_size \ (tclTomMathStubsPtr->tclBN_mp_radix_size) /* 35 */ #define TclBN_mp_read_radix \ (tclTomMathStubsPtr->tclBN_mp_read_radix) /* 36 */ #define TclBN_mp_rshd \ (tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */ #define TclBN_mp_shrink \ (tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */ #define TclBN_mp_set \ (tclTomMathStubsPtr->tclBN_mp_set) /* 39 */ #define TclBN_mp_sqr \ (tclTomMathStubsPtr->tclBN_mp_sqr) /* 40 */ #define TclBN_mp_sqrt \ (tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */ #define TclBN_mp_sub \ (tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */ #define TclBN_mp_sub_d \ (tclTomMathStubsPtr->tclBN_mp_sub_d) /* 43 */ #define TclBN_mp_to_unsigned_bin \ (tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */ #define TclBN_mp_to_unsigned_bin_n \ (tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */ #define TclBN_mp_toradix_n \ (tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */ #define TclBN_mp_unsigned_bin_size \ (tclTomMathStubsPtr->tclBN_mp_unsigned_bin_size) /* 47 */ #define TclBN_mp_xor \ (tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */ #define TclBN_mp_zero \ (tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */ #define TclBN_reverse \ (tclTomMathStubsPtr->tclBN_reverse) /* 50 */ #define TclBN_fast_s_mp_mul_digs \ (tclTomMathStubsPtr->tclBN_fast_s_mp_mul_digs) /* 51 */ #define TclBN_fast_s_mp_sqr \ (tclTomMathStubsPtr->tclBN_fast_s_mp_sqr) /* 52 */ #define TclBN_mp_karatsuba_mul \ (tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */ #define TclBN_mp_karatsuba_sqr \ (tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */ #define TclBN_mp_toom_mul \ (tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */ #define TclBN_mp_toom_sqr \ (tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */ #define TclBN_s_mp_add \ (tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */ #define TclBN_s_mp_mul_digs \ (tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */ #define TclBN_s_mp_sqr \ (tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */ #define TclBN_s_mp_sub \ (tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */ #define TclBN_mp_init_set_int \ (tclTomMathStubsPtr->tclBN_mp_init_set_int) /* 61 */ #define TclBN_mp_set_int \ (tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */ #define TclBN_mp_cnt_lsb \ (tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */ #define TclBNInitBignumFromLong \ (tclTomMathStubsPtr->tclBNInitBignumFromLong) /* 64 */ #define TclBNInitBignumFromWideInt \ (tclTomMathStubsPtr->tclBNInitBignumFromWideInt) /* 65 */ #define TclBNInitBignumFromWideUInt \ (tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */ #define TclBN_mp_expt_d_ex \ (tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */ #define TclBN_mp_set_ull \ (tclTomMathStubsPtr->tclBN_mp_set_ull) /* 68 */ #define TclBN_mp_get_mag_ull \ (tclTomMathStubsPtr->tclBN_mp_get_mag_ull) /* 69 */ #define TclBN_mp_set_ll \ (tclTomMathStubsPtr->tclBN_mp_set_ll) /* 70 */ #define TclBN_mp_unpack \ (tclTomMathStubsPtr->tclBN_mp_unpack) /* 71 */ #define TclBN_mp_pack \ (tclTomMathStubsPtr->tclBN_mp_pack) /* 72 */ #define TclBN_mp_tc_and \ (tclTomMathStubsPtr->tclBN_mp_tc_and) /* 73 */ #define TclBN_mp_tc_or \ (tclTomMathStubsPtr->tclBN_mp_tc_or) /* 74 */ #define TclBN_mp_tc_xor \ (tclTomMathStubsPtr->tclBN_mp_tc_xor) /* 75 */ #define TclBN_mp_signed_rsh \ (tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */ #define TclBN_mp_pack_count \ (tclTomMathStubsPtr->tclBN_mp_pack_count) /* 77 */ #define TclBN_mp_to_ubin \ (tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */ #define TclBN_mp_div_ld \ (tclTomMathStubsPtr->tclBN_mp_div_ld) /* 79 */ #define TclBN_mp_to_radix \ (tclTomMathStubsPtr->tclBN_mp_to_radix) /* 80 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #ifdef USE_TCL_STUBS #undef TclBNInitBignumFromLong #define TclBNInitBignumFromLong(a,b) \ do { \ (a)->dp = NULL; \ (void)tclTomMathStubsPtr->tclBNInitBignumFromLong((a),(b)); \ if ((a)->dp == NULL) { \ Tcl_Panic("initialization failure in TclBNInitBignumFromLong"); \ } \ } while (0) #undef TclBNInitBignumFromWideInt #define TclBNInitBignumFromWideInt(a,b) \ do { \ (a)->dp = NULL; \ (void)tclTomMathStubsPtr->tclBNInitBignumFromWideInt((a),(b)); \ if ((a)->dp == NULL) { \ Tcl_Panic("initialization failure in TclBNInitBignumFromWideInt"); \ } \ } while (0) #undef TclBNInitBignumFromWideUInt #define TclBNInitBignumFromWideUInt(a,b) \ do { \ (a)->dp = NULL; \ (void)tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(b)); \ if ((a)->dp == NULL) { \ Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt"); \ } \ } while (0) #define mp_init_i32(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromLong((a),(int32_t)(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_l(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromLong((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_ll(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideInt((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_i64(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideInt((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_u32(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(uint32_t)(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_ul(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(unsigned long)(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_ull(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_u64(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #else #define mp_init_i32(a,b) (((a)->dp=NULL,(TclBNInitBignumFromLong)((a),(int32_t)(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_l(a,b) (((a)->dp=NULL,(TclBNInitBignumFromLong)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_ll(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideInt)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_i64(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideInt)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_u32(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideUInt)((a),(uint32_t)(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_ul(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideUInt)((a),(unsigned long)(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_ull(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideUInt)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #define mp_init_u64(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideUInt)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) #endif /* USE_TCL_STUBS */ #endif /* _TCLINTDECLS */ tcl8.6.14/generic/tclTomMath.h0000644000175000017500000007341414554262142015514 0ustar sergeisergei/* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef BN_H_ #define BN_H_ #ifndef MODULE_SCOPE #define MODULE_SCOPE extern #endif #ifdef __cplusplus extern "C" { #endif /* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */ #if (defined(_WIN32) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)) && !defined(MP_64BIT) # define MP_32BIT #endif /* detect 64-bit mode if possible */ #if defined(NEVER) # if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT)) # if defined(__GNUC__) /* we support 128bit integers only via: __attribute__((mode(TI))) */ # define MP_64BIT # else /* otherwise we fall back to MP_32BIT even on 64bit platforms */ # define MP_32BIT # endif # endif #endif #ifdef MP_DIGIT_BIT # error Defining MP_DIGIT_BIT is disallowed, use MP_8/16/31/32/64BIT #endif /* some default configurations. * * A "mp_digit" must be able to hold MP_DIGIT_BIT + 1 bits * A "mp_word" must be able to hold 2*MP_DIGIT_BIT + 1 bits * * At the very least a mp_digit must be able to hold 7 bits * [any size beyond that is ok provided it doesn't overflow the data type] */ #ifdef MP_8BIT #ifndef MP_DIGIT_DECLARED typedef unsigned char mp_digit; #define MP_DIGIT_DECLARED #endif #ifndef MP_WORD_DECLARED typedef unsigned short private_mp_word; #define MP_WORD_DECLARED #endif # define MP_SIZEOF_MP_DIGIT 1 # ifdef MP_DIGIT_BIT # error You must not define MP_DIGIT_BIT when using MP_8BIT # endif #elif defined(MP_16BIT) #ifndef MP_DIGIT_DECLARED typedef unsigned short mp_digit; #define MP_DIGIT_DECLARED #endif #ifndef MP_WORD_DECLARED typedef unsigned int private_mp_word; #define MP_WORD_DECLARED #endif # define MP_SIZEOF_MP_DIGIT 2 # ifdef MP_DIGIT_BIT # error You must not define MP_DIGIT_BIT when using MP_16BIT # endif #elif defined(MP_64BIT) /* for GCC only on supported platforms */ #ifndef MP_DIGIT_DECLARED typedef unsigned long long mp_digit; #define MP_DIGIT_DECLARED #endif typedef unsigned long private_mp_word __attribute__((mode(TI))); # define MP_DIGIT_BIT 60 #else /* this is the default case, 28-bit digits */ /* this is to make porting into LibTomCrypt easier :-) */ #ifndef MP_DIGIT_DECLARED typedef unsigned int mp_digit; #define MP_DIGIT_DECLARED #endif #ifndef MP_WORD_DECLARED #ifdef _WIN32 typedef unsigned __int64 private_mp_word; #else typedef unsigned long long private_mp_word; #endif #define MP_WORD_DECLARED #endif # ifdef MP_31BIT /* * This is an extension that uses 31-bit digits. * Please be aware that not all functions support this size, especially s_mp_mul_digs_fast * will be reduced to work on small numbers only: * Up to 8 limbs, 248 bits instead of up to 512 limbs, 15872 bits with MP_28BIT. */ # define MP_DIGIT_BIT 31 # else /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */ # define MP_DIGIT_BIT 28 # define MP_28BIT # endif #endif /* otherwise the bits per digit is calculated automatically from the size of a mp_digit */ #ifndef MP_DIGIT_BIT # define MP_DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1)) /* bits per digit */ #endif #define MP_MASK ((((mp_digit)1)<<((mp_digit)MP_DIGIT_BIT))-((mp_digit)1)) #define MP_DIGIT_MAX MP_MASK /* Primality generation flags */ #define MP_PRIME_BBS 0x0001 /* BBS style prime */ #define MP_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */ #define MP_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */ #define LTM_PRIME_BBS (MP_DEPRECATED_PRAGMA("LTM_PRIME_BBS has been deprecated, use MP_PRIME_BBS") MP_PRIME_BBS) #define LTM_PRIME_SAFE (MP_DEPRECATED_PRAGMA("LTM_PRIME_SAFE has been deprecated, use MP_PRIME_SAFE") MP_PRIME_SAFE) #define LTM_PRIME_2MSB_ON (MP_DEPRECATED_PRAGMA("LTM_PRIME_2MSB_ON has been deprecated, use MP_PRIME_2MSB_ON") MP_PRIME_2MSB_ON) #ifdef MP_USE_ENUMS typedef enum { MP_ZPOS = 0, /* positive */ MP_NEG = 1 /* negative */ } mp_sign; typedef enum { MP_LT = -1, /* less than */ MP_EQ = 0, /* equal */ MP_GT = 1 /* greater than */ } mp_ord; typedef enum { MP_NO = 0, MP_YES = 1 } mp_bool; typedef enum { MP_OKAY = 0, /* no error */ MP_ERR = -1, /* unknown error */ MP_MEM = -2, /* out of mem */ MP_VAL = -3, /* invalid input */ MP_ITER = -4, /* maximum iterations reached */ MP_BUF = -5 /* buffer overflow, supplied buffer too small */ } mp_err; typedef enum { MP_LSB_FIRST = -1, MP_MSB_FIRST = 1 } mp_order; typedef enum { MP_LITTLE_ENDIAN = -1, MP_NATIVE_ENDIAN = 0, MP_BIG_ENDIAN = 1 } mp_endian; #else typedef int mp_sign; #define MP_ZPOS 0 /* positive integer */ #define MP_NEG 1 /* negative */ typedef int mp_ord; #define MP_LT -1 /* less than */ #define MP_EQ 0 /* equal to */ #define MP_GT 1 /* greater than */ typedef int mp_bool; #define MP_YES 1 #define MP_NO 0 typedef int mp_err; #define MP_OKAY 0 /* no error */ #define MP_ERR -1 /* unknown error */ #define MP_MEM -2 /* out of mem */ #define MP_VAL -3 /* invalid input */ #define MP_RANGE (MP_DEPRECATED_PRAGMA("MP_RANGE has been deprecated in favor of MP_VAL") MP_VAL) #define MP_ITER -4 /* maximum iterations reached */ #define MP_BUF -5 /* buffer overflow, supplied buffer too small */ typedef int mp_order; #define MP_LSB_FIRST -1 #define MP_MSB_FIRST 1 typedef int mp_endian; #define MP_LITTLE_ENDIAN -1 #define MP_NATIVE_ENDIAN 0 #define MP_BIG_ENDIAN 1 #endif /* tunable cutoffs */ #ifndef MP_FIXED_CUTOFFS extern int KARATSUBA_MUL_CUTOFF, KARATSUBA_SQR_CUTOFF, TOOM_MUL_CUTOFF, TOOM_SQR_CUTOFF; #endif /* define this to use lower memory usage routines (exptmods mostly) */ /* #define MP_LOW_MEM */ /* default precision */ #ifndef MP_PREC # ifndef MP_LOW_MEM # define MP_PREC 32 /* default digits of precision */ # elif defined(MP_8BIT) # define MP_PREC 16 /* default digits of precision */ # else # define MP_PREC 8 /* default digits of precision */ # endif #endif /* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */ #define PRIVATE_MP_WARRAY (int)(1 << (((CHAR_BIT * sizeof(private_mp_word)) - (2 * MP_DIGIT_BIT)) + 1)) #if defined(__GNUC__) && __GNUC__ >= 4 # define MP_NULL_TERMINATED __attribute__((sentinel)) #else # define MP_NULL_TERMINATED #endif /* * MP_WUR - warn unused result * --------------------------- * * The result of functions annotated with MP_WUR must be * checked and cannot be ignored. * * Most functions in libtommath return an error code. * This error code must be checked in order to prevent crashes or invalid * results. * * If you still want to avoid the error checks for quick and dirty programs * without robustness guarantees, you can `#define MP_WUR` before including * tommath.h, disabling the warnings. */ #ifndef MP_WUR # if defined(__GNUC__) && __GNUC__ >= 4 # define MP_WUR __attribute__((warn_unused_result)) # else # define MP_WUR # endif #endif #if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405) # define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x))) #elif defined(_MSC_VER) && _MSC_VER >= 1500 # define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x)) #else # define MP_DEPRECATED(x) #endif #ifndef MP_NO_DEPRECATED_PRAGMA #if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301) # define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s) # define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s) #elif defined(_MSC_VER) && _MSC_VER >= 1500 # define MP_DEPRECATED_PRAGMA(s) __pragma(message(s)) #endif #endif #ifndef MP_DEPRECATED_PRAGMA # define MP_DEPRECATED_PRAGMA(s) #endif #define DIGIT_BIT MP_DIGIT_BIT #define USED(m) ((m)->used) #define DIGIT(m,k) ((m)->dp[(k)]) #define SIGN(m) ((m)->sign) /* the infamous mp_int structure */ #ifndef MP_INT_DECLARED #define MP_INT_DECLARED typedef struct mp_int mp_int; #endif struct mp_int { int used, alloc; mp_sign sign; mp_digit *dp; }; /* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */ typedef int private_mp_prime_callback(unsigned char *dst, int len, void *dat); typedef private_mp_prime_callback MP_DEPRECATED(mp_rand_source) ltm_prime_callback; /* error code to char* string */ /* const char *mp_error_to_string(mp_err code) MP_WUR; */ /* ---> init and deinit bignum functions <--- */ /* init a bignum */ /* mp_err mp_init(mp_int *a) MP_WUR; */ /* free a bignum */ /* void mp_clear(mp_int *a); */ /* init a null terminated series of arguments */ /* mp_err mp_init_multi(mp_int *mp, ...) MP_NULL_TERMINATED MP_WUR; */ /* clear a null terminated series of arguments */ /* void mp_clear_multi(mp_int *mp, ...) MP_NULL_TERMINATED; */ /* exchange two ints */ /* void mp_exch(mp_int *a, mp_int *b); */ /* shrink ram required for a bignum */ /* mp_err mp_shrink(mp_int *a) MP_WUR; */ /* grow an int to a given size */ /* mp_err mp_grow(mp_int *a, int size) MP_WUR; */ /* init to a given number of digits */ /* mp_err mp_init_size(mp_int *a, int size) MP_WUR; */ /* ---> Basic Manipulations <--- */ #define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO) #define mp_isodd(a) (((a)->used != 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO) #define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO) #define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO) /* set to zero */ /* void mp_zero(mp_int *a); */ /* get and set doubles */ /* double mp_get_double(const mp_int *a) MP_WUR; */ /* mp_err mp_set_double(mp_int *a, double b) MP_WUR; */ /* get integer, set integer and init with integer (int32_t) */ #ifndef MP_NO_STDINT /* int32_t mp_get_i32(const mp_int *a) MP_WUR; */ /* void mp_set_i32(mp_int *a, int32_t b); */ /* mp_err mp_init_i32(mp_int *a, int32_t b) MP_WUR; */ /* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint32_t) */ #define mp_get_u32(a) ((uint32_t)mp_get_i32(a)) /* void mp_set_u32(mp_int *a, uint32_t b); */ /* mp_err mp_init_u32(mp_int *a, uint32_t b) MP_WUR; */ /* get integer, set integer and init with integer (int64_t) */ /* int64_t mp_get_i64(const mp_int *a) MP_WUR; */ /* void mp_set_i64(mp_int *a, int64_t b); */ /* mp_err mp_init_i64(mp_int *a, int64_t b) MP_WUR; */ /* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint64_t) */ #define mp_get_u64(a) ((uint64_t)mp_get_i64(a)) /* void mp_set_u64(mp_int *a, uint64_t b); */ /* mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR; */ /* get magnitude */ /* uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR; */ /* uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR; */ #endif /* unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR; */ /* Tcl_WideUInt mp_get_mag_ull(const mp_int *a) MP_WUR; */ /* get integer, set integer (long) */ /* long mp_get_l(const mp_int *a) MP_WUR; */ /* void mp_set_l(mp_int *a, long b); */ /* mp_err mp_init_l(mp_int *a, long b) MP_WUR; */ /* get integer, set integer (unsigned long) */ #define mp_get_ul(a) ((unsigned long)mp_get_l(a)) /* void mp_set_ul(mp_int *a, unsigned long b); */ /* mp_err mp_init_ul(mp_int *a, unsigned long b) MP_WUR; */ /* get integer, set integer (Tcl_WideInt) */ /* Tcl_WideInt mp_get_ll(const mp_int *a) MP_WUR; */ /* void mp_set_ll(mp_int *a, Tcl_WideInt b); */ /* mp_err mp_init_ll(mp_int *a, Tcl_WideInt b) MP_WUR; */ /* get integer, set integer (Tcl_WideUInt) */ #define mp_get_ull(a) ((Tcl_WideUInt)mp_get_ll(a)) /* void mp_set_ull(mp_int *a, Tcl_WideUInt b); */ /* mp_err mp_init_ull(mp_int *a, Tcl_WideUInt b) MP_WUR; */ /* set to single unsigned digit, up to MP_DIGIT_MAX */ /* void mp_set(mp_int *a, mp_digit b); */ /* mp_err mp_init_set(mp_int *a, mp_digit b) MP_WUR; */ /* get integer, set integer and init with integer (deprecated) */ /* MP_DEPRECATED(mp_get_mag_u32/mp_get_u32) unsigned long mp_get_int(const mp_int *a) MP_WUR; */ /* MP_DEPRECATED(mp_get_mag_ul/mp_get_ul) unsigned long mp_get_long(const mp_int *a) MP_WUR; */ /* MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) Tcl_WideUInt mp_get_long_long(const mp_int *a) MP_WUR; */ /* MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int *a, unsigned long b); */ /* MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int *a, unsigned long b); */ /* MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, Tcl_WideUInt b); */ /* MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int *a, unsigned long b) MP_WUR; */ /* copy, b = a */ /* mp_err mp_copy(const mp_int *a, mp_int *b) MP_WUR; */ /* inits and copies, a = b */ /* mp_err mp_init_copy(mp_int *a, const mp_int *b) MP_WUR; */ /* trim unused digits */ /* void mp_clamp(mp_int *a); */ /* export binary data */ /* MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order, size_t size, int endian, size_t nails, const mp_int *op) MP_WUR; */ /* import binary data */ /* MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, const void *op) MP_WUR; */ /* unpack binary data */ /* mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) MP_WUR; */ /* pack binary data */ /* size_t mp_pack_count(const mp_int *a, size_t nails, size_t size) MP_WUR; */ /* mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op) MP_WUR; */ /* ---> digit manipulation <--- */ /* right shift by "b" digits */ /* void mp_rshd(mp_int *a, int b); */ /* left shift by "b" digits */ /* mp_err mp_lshd(mp_int *a, int b) MP_WUR; */ /* c = a / 2**b, implemented as c = a >> b */ /* mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) MP_WUR; */ /* b = a/2 */ /* mp_err mp_div_2(const mp_int *a, mp_int *b) MP_WUR; */ /* a/3 => 3c + d == a */ /* mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) MP_WUR; */ /* c = a * 2**b, implemented as c = a << b */ /* mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) MP_WUR; */ /* b = a*2 */ /* mp_err mp_mul_2(const mp_int *a, mp_int *b) MP_WUR; */ /* c = a mod 2**b */ /* mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c) MP_WUR; */ /* computes a = 2**b */ /* mp_err mp_2expt(mp_int *a, int b) MP_WUR; */ /* Counts the number of lsbs which are zero before the first zero bit */ /* int mp_cnt_lsb(const mp_int *a) MP_WUR; */ /* I Love Earth! */ /* makes a pseudo-random mp_int of a given size */ /* mp_err mp_rand(mp_int *a, int digits) MP_WUR; */ /* makes a pseudo-random small int of a given size */ /* MP_DEPRECATED(mp_rand) mp_err mp_rand_digit(mp_digit *r) MP_WUR; */ /* use custom random data source instead of source provided the platform */ /* void mp_rand_source(mp_err(*source)(void *out, size_t size)); */ #ifdef MP_PRNG_ENABLE_LTM_RNG /* A last resort to provide random data on systems without any of the other * implemented ways to gather entropy. * It is compatible with `rng_get_bytes()` from libtomcrypt so you could * provide that one and then set `ltm_rng = rng_get_bytes;` */ extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void)); extern void (*ltm_rng_callback)(void); #endif /* ---> binary operations <--- */ /* Checks the bit at position b and returns MP_YES * if the bit is 1, MP_NO if it is 0 and MP_VAL * in case of error */ /* MP_DEPRECATED(s_mp_get_bit) int mp_get_bit(const mp_int *a, int b) MP_WUR; */ /* c = a XOR b (two complement) */ /* MP_DEPRECATED(mp_xor) mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* c = a OR b (two complement) */ /* MP_DEPRECATED(mp_or) mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* c = a AND b (two complement) */ /* MP_DEPRECATED(mp_and) mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* b = ~a (bitwise not, two complement) */ /* mp_err mp_complement(const mp_int *a, mp_int *b) MP_WUR; */ /* right shift with sign extension */ /* MP_DEPRECATED(mp_signed_rsh) mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c) MP_WUR; */ /* mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c) MP_WUR; */ /* ---> Basic arithmetic <--- */ /* b = -a */ /* mp_err mp_neg(const mp_int *a, mp_int *b) MP_WUR; */ /* b = |a| */ /* mp_err mp_abs(const mp_int *a, mp_int *b) MP_WUR; */ /* compare a to b */ /* mp_ord mp_cmp(const mp_int *a, const mp_int *b) MP_WUR; */ /* compare |a| to |b| */ /* mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR; */ /* c = a + b */ /* mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* c = a - b */ /* mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* c = a * b */ /* mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* b = a*a */ /* mp_err mp_sqr(const mp_int *a, mp_int *b) MP_WUR; */ /* a/b => cb + d == a */ /* mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) MP_WUR; */ /* c = a mod b, 0 <= c < b */ /* mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* Increment "a" by one like "a++". Changes input! */ /* mp_err mp_incr(mp_int *a) MP_WUR; */ /* Decrement "a" by one like "a--". Changes input! */ /* mp_err mp_decr(mp_int *a) MP_WUR; */ /* ---> single digit functions <--- */ /* compare against a single digit */ /* mp_ord mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR; */ /* c = a + b */ /* mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; */ /* c = a - b */ /* mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; */ /* c = a * b */ /* mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; */ /* a/b => cb + d == a */ /* mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) MP_WUR; */ /* c = a mod b, 0 <= c < b */ /* mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c) MP_WUR; */ /* ---> number theory <--- */ /* d = a + b (mod c) */ /* mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; */ /* d = a - b (mod c) */ /* mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; */ /* d = a * b (mod c) */ /* mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; */ /* c = a * a (mod b) */ /* mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* c = 1/a (mod b) */ /* mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* c = (a, b) */ /* mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* produces value such that U1*a + U2*b = U3 */ /* mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) MP_WUR; */ /* c = [a, b] or (a*b)/(a, b) */ /* mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; */ /* finds one of the b'th root of a, such that |c|**b <= |a| * * returns error if a < 0 and b is even */ /* mp_err mp_root_u32(const mp_int *a, unsigned int b, mp_int *c) MP_WUR; */ /* MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; */ /* MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; */ /* special sqrt algo */ /* mp_err mp_sqrt(const mp_int *arg, mp_int *ret) MP_WUR; */ /* special sqrt (mod prime) */ /* mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) MP_WUR; */ /* is number a square? */ /* mp_err mp_is_square(const mp_int *arg, mp_bool *ret) MP_WUR; */ /* computes the jacobi c = (a | n) (or Legendre if b is prime) */ /* MP_DEPRECATED(mp_kronecker) mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c) MP_WUR; */ /* computes the Kronecker symbol c = (a | p) (like jacobi() but with {a,p} in Z */ /* mp_err mp_kronecker(const mp_int *a, const mp_int *p, int *c) MP_WUR; */ /* used to setup the Barrett reduction for a given modulus b */ /* mp_err mp_reduce_setup(mp_int *a, const mp_int *b) MP_WUR; */ /* Barrett Reduction, computes a (mod b) with a precomputed value c * * Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely * compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code]. */ /* mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) MP_WUR; */ /* setups the montgomery reduction */ /* mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) MP_WUR; */ /* computes a = B**n mod b without division or multiplication useful for * normalizing numbers in a Montgomery system. */ /* mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) MP_WUR; */ /* computes x/R == x (mod N) via Montgomery Reduction */ /* mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR; */ /* returns 1 if a is a valid DR modulus */ /* mp_bool mp_dr_is_modulus(const mp_int *a) MP_WUR; */ /* sets the value of "d" required for mp_dr_reduce */ /* void mp_dr_setup(const mp_int *a, mp_digit *d); */ /* reduces a modulo n using the Diminished Radix method */ /* mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) MP_WUR; */ /* returns true if a can be reduced with mp_reduce_2k */ /* mp_bool mp_reduce_is_2k(const mp_int *a) MP_WUR; */ /* determines k value for 2k reduction */ /* mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d) MP_WUR; */ /* reduces a modulo b where b is of the form 2**p - k [0 <= a] */ /* mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) MP_WUR; */ /* returns true if a can be reduced with mp_reduce_2k_l */ /* mp_bool mp_reduce_is_2k_l(const mp_int *a) MP_WUR; */ /* determines k value for 2k reduction */ /* mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) MP_WUR; */ /* reduces a modulo b where b is of the form 2**p - k [0 <= a] */ /* mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d) MP_WUR; */ /* Y = G**X (mod P) */ /* mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) MP_WUR; */ /* ---> Primes <--- */ /* number of primes */ #ifdef MP_8BIT # define PRIVATE_MP_PRIME_TAB_SIZE 31 #else # define PRIVATE_MP_PRIME_TAB_SIZE 256 #endif #define PRIME_SIZE (MP_DEPRECATED_PRAGMA("PRIME_SIZE has been made internal") PRIVATE_MP_PRIME_TAB_SIZE) /* table of first PRIME_SIZE primes */ #if defined(BUILD_tcl) || !defined(_WIN32) MODULE_SCOPE const mp_digit ltm_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE]; #endif /* result=1 if a is divisible by one of the first PRIME_SIZE primes */ /* MP_DEPRECATED(mp_prime_is_prime) mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) MP_WUR; */ /* performs one Fermat test of "a" using base "b". * Sets result to 0 if composite or 1 if probable prime */ /* mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR; */ /* performs one Miller-Rabin test of "a" using base "b". * Sets result to 0 if composite or 1 if probable prime */ /* mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR; */ /* This gives [for a given bit size] the number of trials required * such that Miller-Rabin gives a prob of failure lower than 2^-96 */ /* int mp_prime_rabin_miller_trials(int size) MP_WUR; */ /* performs one strong Lucas-Selfridge test of "a". * Sets result to 0 if composite or 1 if probable prime */ /* mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) MP_WUR; */ /* performs one Frobenius test of "a" as described by Paul Underwood. * Sets result to 0 if composite or 1 if probable prime */ /* mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) MP_WUR; */ /* performs t random rounds of Miller-Rabin on "a" additional to * bases 2 and 3. Also performs an initial sieve of trial * division. Determines if "a" is prime with probability * of error no more than (1/4)**t. * Both a strong Lucas-Selfridge to complete the BPSW test * and a separate Frobenius test are available at compile time. * With t<0 a deterministic test is run for primes up to * 318665857834031151167461. With t<13 (abs(t)-13) additional * tests with sequential small primes are run starting at 43. * Is Fips 186.4 compliant if called with t as computed by * mp_prime_rabin_miller_trials(); * * Sets result to 1 if probably prime, 0 otherwise */ /* mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result) MP_WUR; */ /* finds the next prime after the number "a" using "t" trials * of Miller-Rabin. * * bbs_style = 1 means the prime must be congruent to 3 mod 4 */ /* mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) MP_WUR; */ /* makes a truly random prime of a given size (bytes), * call with bbs = 1 if you want it to be congruent to 3 mod 4 * * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself * so it can be NULL * * The prime generated will be larger than 2^(8*size). */ #define mp_prime_random(a, t, size, bbs, cb, dat) (MP_DEPRECATED_PRAGMA("mp_prime_random has been deprecated, use mp_prime_rand instead") mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?MP_PRIME_BBS:0, cb, dat)) /* makes a truly random prime of a given size (bits), * * Flags are as follows: * * MP_PRIME_BBS - make prime congruent to 3 mod 4 * MP_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS) * MP_PRIME_2MSB_ON - make the 2nd highest bit one * * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself * so it can be NULL * */ /* MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat) MP_WUR; */ /* mp_err mp_prime_rand(mp_int *a, int t, int size, int flags) MP_WUR; */ /* Integer logarithm to integer base */ /* mp_err mp_log_u32(const mp_int *a, unsigned int base, unsigned int *c) MP_WUR; */ /* c = a**b */ /* mp_err mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) MP_WUR; */ /* MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; */ /* MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; */ /* ---> radix conversion <--- */ /* int mp_count_bits(const mp_int *a) MP_WUR; */ /* MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *a) MP_WUR; */ /* MP_DEPRECATED(mp_from_ubin) mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) MP_WUR; */ /* MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) MP_WUR; */ /* MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR; */ /* MP_DEPRECATED(mp_sbin_size) int mp_signed_bin_size(const mp_int *a) MP_WUR; */ /* MP_DEPRECATED(mp_from_sbin) mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) MP_WUR; */ /* MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin(const mp_int *a, unsigned char *b) MP_WUR; */ /* MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR; */ /* size_t mp_ubin_size(const mp_int *a) MP_WUR; */ /* mp_err mp_from_ubin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR; */ /* mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; */ /* size_t mp_sbin_size(const mp_int *a) MP_WUR; */ /* mp_err mp_from_sbin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR; */ /* mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; */ /* mp_err mp_read_radix(mp_int *a, const char *str, int radix) MP_WUR; */ /* MP_DEPRECATED(mp_to_radix) mp_err mp_toradix(const mp_int *a, char *str, int radix) MP_WUR; */ /* MP_DEPRECATED(mp_to_radix) mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) MP_WUR; */ /* mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; */ /* mp_err mp_radix_size(const mp_int *a, int radix, int *size) MP_WUR; */ #ifndef MP_NO_FILE /* mp_err mp_fread(mp_int *a, int radix, FILE *stream) MP_WUR; */ /* mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) MP_WUR; */ #endif #define mp_read_raw(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_signed_bin") mp_read_signed_bin((mp), (str), (len))) #define mp_raw_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_signed_bin_size") mp_signed_bin_size(mp)) #define mp_toraw(mp, str) (MP_DEPRECATED_PRAGMA("replaced by mp_to_signed_bin") mp_to_signed_bin((mp), (str))) #define mp_read_mag(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_unsigned_bin") mp_read_unsigned_bin((mp), (str), (len)) #define mp_mag_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_unsigned_bin_size") mp_unsigned_bin_size(mp)) #define mp_tomag(mp, str) (MP_DEPRECATED_PRAGMA("replaced by mp_to_unsigned_bin") mp_to_unsigned_bin((mp), (str))) #define mp_tobinary(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_binary") mp_toradix((M), (S), 2)) #define mp_tooctal(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_octal") mp_toradix((M), (S), 8)) #define mp_todecimal(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_decimal") mp_toradix((M), (S), 10)) #define mp_tohex(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_hex") mp_toradix((M), (S), 16)) #define mp_to_binary(M, S, N) mp_to_radix((M), (S), (N), NULL, 2) #define mp_to_octal(M, S, N) mp_to_radix((M), (S), (N), NULL, 8) #define mp_to_decimal(M, S, N) mp_to_radix((M), (S), (N), NULL, 10) #define mp_to_hex(M, S, N) mp_to_radix((M), (S), (N), NULL, 16) #ifdef __cplusplus } #endif #include "tclTomMathDecls.h" #endif tcl8.6.14/generic/tclTomMathInterface.c0000644000175000017500000001130314554262142017315 0ustar sergeisergei/* *---------------------------------------------------------------------- * * tclTomMathInterface.c -- * * This file contains procedures that are used as a 'glue' layer between * Tcl and libtommath. * * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" MODULE_SCOPE const TclTomMathStubs tclTomMathStubs; /* *---------------------------------------------------------------------- * * TclTommath_Init -- * * Initializes the TclTomMath 'package', which exists as a * placeholder so that the package data can be used to hold * a stub table pointer. * * Results: * Returns a standard Tcl result. * * Side effects: * Installs the stub table for tommath. * *---------------------------------------------------------------------- */ int TclTommath_Init( Tcl_Interp *interp) /* Tcl interpreter */ { /* TIP #268: Full patchlevel instead of just major.minor */ if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL, &tclTomMathStubs) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclBN_epoch -- * * Return the epoch number of the TclTomMath stubs table * * Results: * Returns an arbitrary integer that does not decrease with * release. Stubs tables with different epochs are incompatible. * *---------------------------------------------------------------------- */ int TclBN_epoch(void) { return TCLTOMMATH_EPOCH; } /* *---------------------------------------------------------------------- * * TclBN_revision -- * * Returns the revision level of the TclTomMath stubs table * * Results: * Returns an arbitrary integer that increases with revisions. * If a client requires a given epoch and revision, any Stubs table * with the same epoch and an equal or higher revision satisfies * the request. * *---------------------------------------------------------------------- */ int TclBN_revision(void) { return TCLTOMMATH_REVISION; } /* *---------------------------------------------------------------------- * * TclBNInitBignumFromLong -- * * Allocate and initialize a 'bignum' from a native 'long'. * * Results: * None. * * Side effects: * The 'bignum' is constructed. * *---------------------------------------------------------------------- */ int TclBNInitBignumFromLong( mp_int *a, long initVal) { unsigned long v; mp_digit *p; /* * Allocate enough memory to hold the largest possible long */ if (mp_init(a) != MP_OKAY) { Tcl_Panic("initialization failure in TclBNInitBignumFromLong"); } /* * Convert arg to sign and magnitude. */ if (initVal < 0) { a->sign = MP_NEG; v = -(unsigned long)initVal; } else { a->sign = MP_ZPOS; v = initVal; } /* * Store the magnitude in the bignum. */ p = a->dp; while (v) { *p++ = (mp_digit) (v & MP_MASK); v >>= MP_DIGIT_BIT; } a->used = p - a->dp; return MP_OKAY; } /* *---------------------------------------------------------------------- * * TclBNInitBignumFromWideInt -- * * Allocate and initialize a 'bignum' from a Tcl_WideInt * * Results: * None. * * Side effects: * The 'bignum' is constructed. * *---------------------------------------------------------------------- */ int TclBNInitBignumFromWideInt( mp_int *a, /* Bignum to initialize */ Tcl_WideInt v) /* Initial value */ { if (v < 0) { (void)TclBNInitBignumFromWideUInt(a, -(Tcl_WideUInt)v); return mp_neg(a, a); } (void)TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v); return MP_OKAY; } /* *---------------------------------------------------------------------- * * TclBNInitBignumFromWideUInt -- * * Allocate and initialize a 'bignum' from a Tcl_WideUInt * * Results: * None. * * Side effects: * The 'bignum' is constructed. * *---------------------------------------------------------------------- */ int TclBNInitBignumFromWideUInt( mp_int *a, /* Bignum to initialize */ Tcl_WideUInt v) /* Initial value */ { mp_digit *p; /* * Allocate enough memory to hold the largest possible Tcl_WideUInt. */ if (mp_init(a) != MP_OKAY) { Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt"); } a->sign = 0; /* * Store the magnitude in the bignum. */ p = a->dp; while (v) { *p++ = (mp_digit) (v & MP_MASK); v >>= MP_DIGIT_BIT; } a->used = p - a->dp; return MP_OKAY; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclTomMathInt.h0000644000175000017500000000010714554262142016154 0ustar sergeisergei#include "tclInt.h" #include "tclTomMath.h" #include "tommath_class.h" tcl8.6.14/generic/tclTomMathStubLib.c0000644000175000017500000000425014554262142016764 0ustar sergeisergei/* * tclTomMathStubLib.c -- * * Stub object that will be statically linked into extensions that want * to access Tcl. * * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; const TclTomMathStubs *tclTomMathStubsPtr = NULL; /* *---------------------------------------------------------------------- * * TclTomMathInitStubs -- * * Initializes the Stubs table for Tcl's subset of libtommath * * Results: * Returns a standard Tcl result. * * This procedure should not be called directly, but rather through * the TclTomMath_InitStubs macro, to insure that the Stubs table * matches the header files used in compilation. * *---------------------------------------------------------------------- */ MODULE_SCOPE const char * TclTomMathInitializeStubs( Tcl_Interp *interp, /* Tcl interpreter */ const char *version, /* Tcl version needed */ int epoch, /* Stubs table epoch from the header files */ int revision) /* Stubs table revision number from the * header files */ { int exact = 0; const char *packageName = "tcl::tommath"; const char *errMsg = NULL; TclTomMathStubs *stubsPtr = NULL; const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &stubsPtr); if (actualVersion == NULL) { return NULL; } if (stubsPtr == NULL) { errMsg = "missing stub table pointer"; } else if(stubsPtr->tclBN_epoch() != epoch) { errMsg = "epoch number mismatch"; } else if(stubsPtr->tclBN_revision() != revision) { errMsg = "requires a later revision"; } else { tclTomMathStubsPtr = stubsPtr; return actualVersion; } tclStubsPtr->tcl_ResetResult(interp); tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, " (requested version ", version, ", actual version ", actualVersion, "): ", errMsg, NULL); return NULL; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclTrace.c0000644000175000017500000027674014554262142015203 0ustar sergeisergei/* * tclTrace.c -- * * This file contains code to handle most trace management. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * Copyright (c) 2002 ActiveState Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Structures used to hold information about variable traces: */ typedef struct { int flags; /* Operations for which Tcl command is to be * invoked. */ size_t length; /* Number of non-NUL chars. in command. */ char command[1]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to hold * command. This field must be the last in the * structure, so that it can be larger than 1 * byte. */ } TraceVarInfo; typedef struct { VarTrace traceInfo; TraceVarInfo traceCmdInfo; } CombinedTraceVarInfo; /* * Structure used to hold information about command traces: */ typedef struct { int flags; /* Operations for which Tcl command is to be * invoked. */ size_t length; /* Number of non-NUL chars. in command. */ Tcl_Trace stepTrace; /* Used for execution traces, when tracing * inside the given command */ int startLevel; /* Used for bookkeeping with step execution * traces, store the level at which the step * trace was invoked */ char *startCmd; /* Used for bookkeeping with step execution * traces, store the command name which * invoked step trace */ int curFlags; /* Trace flags for the current command */ int curCode; /* Return code for the current command */ int refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ char command[1]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to hold * command. This field must be the last in the * structure, so that it can be larger than 1 * byte. */ } TraceCommandInfo; /* * Used by command execution traces. Note that we assume in the code that * TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and that * TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC. * * TCL_TRACE_ENTER_DURING_EXEC - Trace each command inside the command * currently being traced, before execution. * TCL_TRACE_LEAVE_DURING_EXEC - Trace each command inside the command * currently being traced, after execution. * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags. * TCL_TRACE_EXEC_IN_PROGRESS - The callback function on this trace is * currently executing. Therefore we don't let * further traces execute. * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly * by the command being traced, not because of * an internal trace. * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also be used * in command execution traces. */ #define TCL_TRACE_ENTER_DURING_EXEC 4 #define TCL_TRACE_LEAVE_DURING_EXEC 8 #define TCL_TRACE_ANY_EXEC 15 #define TCL_TRACE_EXEC_IN_PROGRESS 0x10 #define TCL_TRACE_EXEC_DIRECT 0x20 /* * Forward declarations for functions defined in this file: */ typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex, int objc, Tcl_Obj *const objv[]); static Tcl_TraceTypeObjCmd TraceVariableObjCmd; static Tcl_TraceTypeObjCmd TraceCommandObjCmd; static Tcl_TraceTypeObjCmd TraceExecutionObjCmd; /* * Each subcommand has a number of 'types' to which it can apply. Currently * 'execution', 'command' and 'variable' are the only types supported. These * three arrays MUST be kept in sync! In the future we may provide an API to * add to the list of supported trace types. */ static const char *const traceTypeOptions[] = { "execution", "command", "variable", NULL }; static Tcl_TraceTypeObjCmd *const traceSubCmds[] = { TraceExecutionObjCmd, TraceCommandObjCmd, TraceVariableObjCmd }; /* * Declarations for local functions to this file: */ static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr, Command *cmdPtr, const char *command, int numChars, int objc, Tcl_Obj *const objv[]); static char * TraceVarProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void TraceCommandProc(ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); static Tcl_CmdObjTraceProc TraceExecutionProc; static int StringTraceProc(ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *const objv[]); static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); static int TraceVarEx(Tcl_Interp *interp, const char *part1, const char *part2, VarTrace *tracePtr); /* * The following structure holds the client data for string-based * trace procs */ typedef struct StringTraceData { ClientData clientData; /* Client data from Tcl_CreateTrace */ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; /* * Convenience macros for iterating over the list of traces. Note that each of * these *must* be treated as a command, and *must* have a block following it. */ #define FOREACH_VAR_TRACE(interp, name, clientData) \ (clientData) = NULL; \ while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ 0, TraceVarProc, (clientData))) != NULL) #define FOREACH_COMMAND_TRACE(interp, name, clientData) \ (clientData) = NULL; \ while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ TraceCommandProc, (clientData))) != NULL) /* *---------------------------------------------------------------------- * * Tcl_TraceObjCmd -- * * This function is invoked to process the "trace" Tcl command. See the * user documentation for details on what it does. * * Standard syntax as of Tcl 8.4 is: * trace {add|info|remove} {command|variable} name ops cmd * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. *---------------------------------------------------------------------- */ int Tcl_TraceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int optionIndex; #ifndef TCL_REMOVE_OBSOLETE_TRACES const char *name; const char *flagOps, *p; #endif /* Main sub commands to 'trace' */ static const char *const traceOptions[] = { "add", "info", "remove", #ifndef TCL_REMOVE_OBSOLETE_TRACES "variable", "vdelete", "vinfo", #endif NULL }; /* 'OLD' options are pre-Tcl-8.4 style */ enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE, #ifndef TCL_REMOVE_OBSOLETE_TRACES TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO #endif }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum traceOptions) optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { /* * All sub commands of trace add/remove must take at least one more * argument. Beyond that we let the subcommand itself control the * argument structure. */ int typeIndex; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "type ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option", 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return traceSubCmds[typeIndex](interp, optionIndex, objc, objv); } case TRACE_INFO: { /* * All sub commands of trace info must take exactly two more arguments * which name the type of thing being traced and the name of the thing * being traced. */ int typeIndex; if (objc < 3) { /* * Delegate other complaints to the type-specific code which can * give a better error message. */ Tcl_WrongNumArgs(interp, 2, objv, "type name"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option", 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return traceSubCmds[typeIndex](interp, optionIndex, objc, objv); break; } #ifndef TCL_REMOVE_OBSOLETE_TRACES case TRACE_OLD_VARIABLE: case TRACE_OLD_VDELETE: { Tcl_Obj *copyObjv[6]; Tcl_Obj *opsList; int code; int numFlags; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); return TCL_ERROR; } TclNewObj(opsList); Tcl_IncrRefCount(opsList); flagOps = Tcl_GetStringFromObj(objv[3], &numFlags); if (numFlags == 0) { Tcl_DecrRefCount(opsList); goto badVarOps; } for (p = flagOps; *p != 0; p++) { Tcl_Obj *opObj; if (*p == 'r') { TclNewLiteralStringObj(opObj, "read"); } else if (*p == 'w') { TclNewLiteralStringObj(opObj, "write"); } else if (*p == 'u') { TclNewLiteralStringObj(opObj, "unset"); } else if (*p == 'a') { TclNewLiteralStringObj(opObj, "array"); } else { Tcl_DecrRefCount(opsList); goto badVarOps; } Tcl_ListObjAppendElement(NULL, opsList, opObj); } copyObjv[0] = NULL; memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *)); copyObjv[4] = opsList; if (optionIndex == TRACE_OLD_VARIABLE) { code = traceSubCmds[2](interp, TRACE_ADD, objc+1, copyObjv); } else { code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv); } Tcl_DecrRefCount(opsList); return code; } case TRACE_OLD_VINFO: { ClientData clientData; char ops[5]; Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "name"); return TCL_ERROR; } TclNewObj(resultListPtr); name = Tcl_GetString(objv[2]); FOREACH_VAR_TRACE(interp, name, clientData) { TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; char *q = ops; pairObjPtr = Tcl_NewListObj(0, NULL); if (tvarPtr->flags & TCL_TRACE_READS) { *q = 'r'; q++; } if (tvarPtr->flags & TCL_TRACE_WRITES) { *q = 'w'; q++; } if (tvarPtr->flags & TCL_TRACE_UNSETS) { *q = 'u'; q++; } if (tvarPtr->flags & TCL_TRACE_ARRAY) { *q = 'a'; q++; } *q = '\0'; /* * Build a pair (2-item list) with the ops string as the first obj * element and the tvarPtr->command string as the second obj * element. Append the pair (as an element) to the end of the * result object list. */ elemObjPtr = Tcl_NewStringObj(ops, -1); Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr); elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1); Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } #endif /* TCL_REMOVE_OBSOLETE_TRACES */ } return TCL_OK; #ifndef TCL_REMOVE_OBSOLETE_TRACES badVarOps: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad operations \"%s\": should be one or more of rwua", flagOps)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL); return TCL_ERROR; #endif } /* *---------------------------------------------------------------------- * * TraceExecutionObjCmd -- * * Helper function for Tcl_TraceObjCmd; implements the [trace * {add|remove|info} execution ...] subcommands. See the user * documentation for details on what these do. * * Results: * Standard Tcl result. * * Side effects: * Depends on the operation (add, remove, or info) being performed; may * add or remove command traces on a command. * *---------------------------------------------------------------------- */ static int TraceExecutionObjCmd( Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int commandLength, index; const char *name, *command; size_t length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { "enter", "leave", "enterstep", "leavestep", NULL }; enum operations { TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE, TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP }; switch ((enum traceOptions) optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { int flags = 0; int i, listLen, result; Tcl_Obj **elemPtrs; if (objc != 6) { Tcl_WrongNumArgs(interp, 3, objv, "name opList command"); return TCL_ERROR; } /* * Make sure the ops argument is a list object; get its length and a * pointer to its array of element pointers. */ result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (listLen == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad operation list \"\": must be one or more of" " enter, leave, enterstep, or leavestep", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", NULL); return TCL_ERROR; } for (i = 0; i < listLen; i++) { if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum operations) index) { case TRACE_EXEC_ENTER: flags |= TCL_TRACE_ENTER_EXEC; break; case TRACE_EXEC_LEAVE: flags |= TCL_TRACE_LEAVE_EXEC; break; case TRACE_EXEC_ENTER_STEP: flags |= TCL_TRACE_ENTER_DURING_EXEC; break; case TRACE_EXEC_LEAVE_STEP: flags |= TCL_TRACE_LEAVE_DURING_EXEC; break; } } command = Tcl_GetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( TclOffset(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; tcmdPtr->startLevel = 0; tcmdPtr->startCmd = NULL; tcmdPtr->length = length; tcmdPtr->refCount = 1; flags |= TCL_TRACE_DELETE; if (flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } memcpy(tcmdPtr->command, command, length+1); name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, tcmdPtr) != TCL_OK) { ckfree(tcmdPtr); return TCL_ERROR; } } else { /* * Search through all of our traces on this command to see if * there's one with the given command. If so, then delete the * first one that matches. */ ClientData clientData; /* * First ensure the name given is valid. */ name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } FOREACH_COMMAND_TRACE(interp, name, clientData) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; /* * In checking the 'flags' field we must remove any extraneous * flags which may have been temporarily added by various * pieces of the trace mechanism. */ if ((tcmdPtr->length == length) && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | TCL_TRACE_RENAME | TCL_TRACE_DELETE)) == flags) && (strncmp(command, tcmdPtr->command, length) == 0)) { flags |= TCL_TRACE_DELETE; if (flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } Tcl_UntraceCommand(interp, name, flags, TraceCommandProc, clientData); if (tcmdPtr->stepTrace != NULL) { /* * We need to remove the interpreter-wide trace which * we created to allow 'step' traces. */ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; ckfree(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Postpone deletion. */ tcmdPtr->flags = 0; } if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } break; } } } break; } case TRACE_INFO: { ClientData clientData; Tcl_Obj *resultListPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "name"); return TCL_ERROR; } name = Tcl_GetString(objv[3]); /* * First ensure the name given is valid. */ if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } resultListPtr = Tcl_NewListObj(0, NULL); FOREACH_COMMAND_TRACE(interp, name, clientData) { int numOps = 0; Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr; TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; /* * Build a list with the ops list as the first obj element and the * tcmdPtr->command string as the second obj element. Append this * list (as an element) to the end of the result object list. */ elemObjPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(elemObjPtr); if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) { TclNewLiteralStringObj(opObj, "enter"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) { TclNewLiteralStringObj(opObj, "leave"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) { TclNewLiteralStringObj(opObj, "enterstep"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) { TclNewLiteralStringObj(opObj, "leavestep"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } TclListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; } eachTraceObjPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_DecrRefCount(elemObjPtr); elemObjPtr = NULL; Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, Tcl_NewStringObj(tcmdPtr->command, -1)); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TraceCommandObjCmd -- * * Helper function for Tcl_TraceObjCmd; implements the [trace * {add|info|remove} command ...] subcommands. See the user documentation * for details on what these do. * * Results: * Standard Tcl result. * * Side effects: * Depends on the operation (add, remove, or info) being performed; may * add or remove command traces on a command. * *---------------------------------------------------------------------- */ static int TraceCommandObjCmd( Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int commandLength, index; const char *name, *command; size_t length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { "delete", "rename", NULL }; enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME }; switch ((enum traceOptions) optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { int flags = 0, result; int i, listLen; Tcl_Obj **elemPtrs; if (objc != 6) { Tcl_WrongNumArgs(interp, 3, objv, "name opList command"); return TCL_ERROR; } /* * Make sure the ops argument is a list object; get its length and a * pointer to its array of element pointers. */ result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (listLen == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad operation list \"\": must be one or more of" " delete or rename", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", NULL); return TCL_ERROR; } for (i = 0; i < listLen; i++) { if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum operations) index) { case TRACE_CMD_RENAME: flags |= TCL_TRACE_RENAME; break; case TRACE_CMD_DELETE: flags |= TCL_TRACE_DELETE; break; } } command = Tcl_GetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( TclOffset(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; tcmdPtr->startLevel = 0; tcmdPtr->startCmd = NULL; tcmdPtr->length = length; tcmdPtr->refCount = 1; flags |= TCL_TRACE_DELETE; memcpy(tcmdPtr->command, command, length+1); name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, tcmdPtr) != TCL_OK) { ckfree(tcmdPtr); return TCL_ERROR; } } else { /* * Search through all of our traces on this command to see if * there's one with the given command. If so, then delete the * first one that matches. */ ClientData clientData; /* * First ensure the name given is valid. */ name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } FOREACH_COMMAND_TRACE(interp, name, clientData) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags) && (strncmp(command, tcmdPtr->command, length) == 0)) { Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE, TraceCommandProc, clientData); tcmdPtr->flags |= TCL_TRACE_DESTROYED; if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } break; } } } break; } case TRACE_INFO: { ClientData clientData; Tcl_Obj *resultListPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "name"); return TCL_ERROR; } /* * First ensure the name given is valid. */ name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } resultListPtr = Tcl_NewListObj(0, NULL); FOREACH_COMMAND_TRACE(interp, name, clientData) { int numOps = 0; Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr; TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; /* * Build a list with the ops list as the first obj element and the * tcmdPtr->command string as the second obj element. Append this * list (as an element) to the end of the result object list. */ elemObjPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(elemObjPtr); if (tcmdPtr->flags & TCL_TRACE_RENAME) { TclNewLiteralStringObj(opObj, "rename"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } if (tcmdPtr->flags & TCL_TRACE_DELETE) { TclNewLiteralStringObj(opObj, "delete"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } TclListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; } eachTraceObjPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_DecrRefCount(elemObjPtr); elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TraceVariableObjCmd -- * * Helper function for Tcl_TraceObjCmd; implements the [trace * {add|info|remove} variable ...] subcommands. See the user * documentation for details on what these do. * * Results: * Standard Tcl result. * * Side effects: * Depends on the operation (add, remove, or info) being performed; may * add or remove variable traces on a variable. * *---------------------------------------------------------------------- */ static int TraceVariableObjCmd( Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int commandLength, index; const char *name, *command; size_t length; ClientData clientData; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { "array", "read", "unset", "write", NULL }; enum operations { TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE }; switch ((enum traceOptions) optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { int flags = 0, result; int i, listLen; Tcl_Obj **elemPtrs; if (objc != 6) { Tcl_WrongNumArgs(interp, 3, objv, "name opList command"); return TCL_ERROR; } /* * Make sure the ops argument is a list object; get its length and a * pointer to its array of element pointers. */ result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (listLen == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad operation list \"\": must be one or more of" " array, read, unset, or write", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", NULL); return TCL_ERROR; } for (i = 0; i < listLen ; i++) { if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum operations) index) { case TRACE_VAR_ARRAY: flags |= TCL_TRACE_ARRAY; break; case TRACE_VAR_READ: flags |= TCL_TRACE_READS; break; case TRACE_VAR_UNSET: flags |= TCL_TRACE_UNSETS; break; case TRACE_VAR_WRITE: flags |= TCL_TRACE_WRITES; break; } } command = Tcl_GetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)ckalloc( TclOffset(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); ctvarPtr->traceCmdInfo.flags = flags; #ifndef TCL_REMOVE_OBSOLETE_TRACES if (objv[0] == NULL) { ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE; } #endif ctvarPtr->traceCmdInfo.length = length; flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT; memcpy(ctvarPtr->traceCmdInfo.command, command, length+1); ctvarPtr->traceInfo.traceProc = TraceVarProc; ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo; ctvarPtr->traceInfo.flags = flags; name = Tcl_GetString(objv[3]); if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr) != TCL_OK) { ckfree(ctvarPtr); return TCL_ERROR; } } else { /* * Search through all of our traces on this variable to see if * there's one with the given command. If so, then delete the * first one that matches. */ name = Tcl_GetString(objv[3]); FOREACH_VAR_TRACE(interp, name, clientData) { TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; if ((tvarPtr->length == length) && ((tvarPtr->flags #ifndef TCL_REMOVE_OBSOLETE_TRACES & ~TCL_TRACE_OLD_STYLE #endif )==flags) && (strncmp(command, tvarPtr->command, length) == 0)) { Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); break; } } } break; } case TRACE_INFO: { Tcl_Obj *resultListPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "name"); return TCL_ERROR; } TclNewObj(resultListPtr); name = Tcl_GetString(objv[3]); FOREACH_VAR_TRACE(interp, name, clientData) { Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr; TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; /* * Build a list with the ops list as the first obj element and the * tcmdPtr->command string as the second obj element. Append this * list (as an element) to the end of the result object list. */ elemObjPtr = Tcl_NewListObj(0, NULL); if (tvarPtr->flags & TCL_TRACE_ARRAY) { TclNewLiteralStringObj(opObjPtr, "array"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr); } if (tvarPtr->flags & TCL_TRACE_READS) { TclNewLiteralStringObj(opObjPtr, "read"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr); } if (tvarPtr->flags & TCL_TRACE_WRITES) { TclNewLiteralStringObj(opObjPtr, "write"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr); } if (tvarPtr->flags & TCL_TRACE_UNSETS) { TclNewLiteralStringObj(opObjPtr, "unset"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr); } eachTraceObjPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_CommandTraceInfo -- * * Return the clientData value associated with a trace on a command. * This function can also be used to step through all of the traces on a * particular command that have the same trace function. * * Results: * The return value is the clientData value associated with a trace on * the given command. Information will only be returned for a trace with * proc as trace function. If the clientData argument is NULL then the * first such trace is returned; otherwise, the next relevant one after * the one given by clientData will be returned. If the command doesn't * exist then an error message is left in the interpreter and NULL is * returned. Also, if there are no (more) traces for the given command, * NULL is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_CommandTraceInfo( Tcl_Interp *interp, /* Interpreter containing command. */ const char *cmdName, /* Name of command. */ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY (can be 0). */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Command *cmdPtr; CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return NULL; } /* * Find the relevant trace, if any, and return its clientData. */ tracePtr = cmdPtr->tracePtr; if (prevClientData != NULL) { for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) { if ((tracePtr->clientData == prevClientData) && (tracePtr->traceProc == proc)) { tracePtr = tracePtr->nextPtr; break; } } } for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) { if (tracePtr->traceProc == proc) { return tracePtr->clientData; } } return NULL; } /* *---------------------------------------------------------------------- * * Tcl_TraceCommand -- * * Arrange for rename/deletes to a command to cause a function to be * invoked, which can monitor the operations. * * Also optionally arrange for execution of that command to cause a * function to be invoked. * * Results: * A standard Tcl return value. * * Side effects: * A trace is set up on the command given by cmdName, such that future * changes to the command will be mediated by proc. See the manual * entry for complete details on the calling sequence for proc. * *---------------------------------------------------------------------- */ int Tcl_TraceCommand( Tcl_Interp *interp, /* Interpreter in which command is to be * traced. */ const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return TCL_ERROR; } /* * Set up trace information. */ tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC); tracePtr->nextPtr = cmdPtr->tracePtr; tracePtr->refCount = 1; cmdPtr->tracePtr = tracePtr; if (tracePtr->flags & TCL_TRACE_ANY_EXEC) { /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){ Interp *iPtr = (Interp *) interp; iPtr->compileEpoch++; } cmdPtr->flags |= CMD_HAS_EXEC_TRACES; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_UntraceCommand -- * * Remove a previously-created trace for a command. * * Results: * None. * * Side effects: * If there exists a trace for the command given by cmdName with the * given flags, proc, and clientData, then that trace is removed. * *---------------------------------------------------------------------- */ void Tcl_UntraceCommand( Tcl_Interp *interp, /* Interpreter containing command. */ const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { CommandTrace *tracePtr; CommandTrace *prevPtr; Command *cmdPtr; Interp *iPtr = (Interp *)interp; ActiveCommandTrace *activePtr; int hasExecTraces = 0; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return; } flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC); for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { return; } if ((tracePtr->traceProc == proc) && ((tracePtr->flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC)) == flags) && (tracePtr->clientData == clientData)) { if (tracePtr->flags & TCL_TRACE_ANY_EXEC) { hasExecTraces = 1; } break; } } /* * The code below makes it possible to delete traces while traces are * active: it makes sure that the deleted trace won't be processed by * CallCommandTraces. */ for (activePtr = iPtr->activeCmdTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->nextTracePtr == tracePtr) { if (activePtr->reverseScan) { activePtr->nextTracePtr = prevPtr; } else { activePtr->nextTracePtr = tracePtr->nextPtr; } } } if (prevPtr == NULL) { cmdPtr->tracePtr = tracePtr->nextPtr; } else { prevPtr->nextPtr = tracePtr->nextPtr; } tracePtr->flags = 0; if (tracePtr->refCount-- <= 1) { ckfree(tracePtr); } if (hasExecTraces) { for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr->flags & TCL_TRACE_ANY_EXEC) { return; } } /* * None of the remaining traces on this command are execution traces. * We therefore remove this flag: */ cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES; /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ if (cmdPtr->compileProc != NULL) { iPtr->compileEpoch++; } } } /* *---------------------------------------------------------------------- * * TraceCommandProc -- * * This function is called to handle command changes that have been * traced using the "trace" command, when using the 'rename' or 'delete' * options. * * Results: * None. * * Side effects: * Depends on the command associated with the trace. * *---------------------------------------------------------------------- */ static void TraceCommandProc( ClientData clientData, /* Information about the command trace. */ Tcl_Interp *interp, /* Interpreter containing command. */ const char *oldName, /* Name of command being changed. */ const char *newName, /* New name of command. Empty string or NULL * means command is being deleted (renamed to * ""). */ int flags) /* OR-ed bits giving operation and other * information. */ { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; int code; Tcl_DString cmd; tcmdPtr->refCount++; if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { /* * Generate a command to execute by appending list elements for the * old and new command name and the operation. */ Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length); Tcl_DStringAppendElement(&cmd, oldName); Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { TclDStringAppendLiteral(&cmd, " rename"); } else if (flags & TCL_TRACE_DELETE) { TclDStringAppendLiteral(&cmd, " delete"); } /* * Execute the command. We discard any object result the command * returns. * * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to other * areas that this will be destroyed by us, otherwise a double-free * might occur depending on what the eval does. */ if (flags & TCL_TRACE_DESTROYED) { tcmdPtr->flags |= TCL_TRACE_DESTROYED; } code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* We ignore errors in these traced commands */ /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/ } Tcl_DStringFree(&cmd); } /* * We delete when the trace was destroyed or if this is a delete trace, * because command deletes are unconditional, so the trace must go away. */ if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) { int untraceFlags = tcmdPtr->flags; Tcl_InterpState state; if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; ckfree(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Postpone deletion, until exec trace returns. */ tcmdPtr->flags = 0; } /* * We need to construct the same flags for Tcl_UntraceCommand as were * passed to Tcl_TraceCommand. Reproduce the processing of [trace add * execution/command]. Be careful to keep this code in sync with that. */ if (untraceFlags & TCL_TRACE_ANY_EXEC) { untraceFlags |= TCL_TRACE_DELETE; if (untraceFlags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { untraceFlags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } } else if (untraceFlags & TCL_TRACE_RENAME) { untraceFlags |= TCL_TRACE_DELETE; } /* * Remove the trace since TCL_TRACE_DESTROYED tells us to, or the * command we're tracing has just gone away. Then decrement the * clientData refCount that was set up by trace creation. * * Note that we save the (return) state of the interpreter to prevent * bizarre error messages. */ state = Tcl_SaveInterpState(interp, TCL_OK); Tcl_UntraceCommand(interp, oldName, untraceFlags, TraceCommandProc, clientData); Tcl_RestoreInterpState(interp, state); tcmdPtr->refCount--; } if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } } /* *---------------------------------------------------------------------- * * TclCheckExecutionTraces -- * * Checks on all current command execution traces, and invokes functions * which have been registered. This function can be used by other code * which performs execution to unify the tracing system, so that * execution traces will function for that other code. * * For instance extensions like [incr Tcl] which use their own execution * technique can make use of Tcl's tracing. * * This function is called by 'TclEvalObjvInternal' * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR, etc. * * Side effects: * Those side effects made by any trace functions called. * *---------------------------------------------------------------------- */ int TclCheckExecutionTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ int numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; CommandTrace *tracePtr, *lastTracePtr; ActiveCommandTrace active; int curLevel; int traceCode = TCL_OK; Tcl_InterpState state = NULL; if (cmdPtr->tracePtr == NULL) { return traceCode; } curLevel = iPtr->varFramePtr->level; active.nextPtr = iPtr->activeCmdTracePtr; iPtr->activeCmdTracePtr = &active; active.cmdPtr = cmdPtr; lastTracePtr = NULL; for (tracePtr = cmdPtr->tracePtr; (traceCode == TCL_OK) && (tracePtr != NULL); tracePtr = active.nextTracePtr) { if (traceFlags & TCL_TRACE_LEAVE_EXEC) { /* * Execute the trace command in order of creation for "leave". */ active.reverseScan = 1; active.nextTracePtr = NULL; tracePtr = cmdPtr->tracePtr; while (tracePtr->nextPtr != lastTracePtr) { active.nextTracePtr = tracePtr; tracePtr = tracePtr->nextPtr; } } else { active.reverseScan = 0; active.nextTracePtr = tracePtr->nextPtr; } if (tracePtr->traceProc == TraceCommandProc) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData; if (tcmdPtr->flags != 0) { tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT; tcmdPtr->curCode = code; tcmdPtr->refCount++; if (state == NULL) { state = Tcl_SaveInterpState(interp, code); } traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel, command, (Tcl_Command) cmdPtr, objc, objv); if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } } } if (active.nextTracePtr) { lastTracePtr = active.nextTracePtr->nextPtr; } } iPtr->activeCmdTracePtr = active.nextPtr; if (state) { if (traceCode == TCL_OK) { (void) Tcl_RestoreInterpState(interp, state); } else { Tcl_DiscardInterpState(state); } } return traceCode; } /* *---------------------------------------------------------------------- * * TclCheckInterpTraces -- * * Checks on all current traces, and invokes functions which have been * registered. This function can be used by other code which performs * execution to unify the tracing system. For instance extensions like * [incr Tcl] which use their own execution technique can make use of * Tcl's tracing. * * This function is called by 'TclEvalObjvInternal' * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR, etc. * * Side effects: * Those side effects made by any trace functions called. * *---------------------------------------------------------------------- */ int TclCheckInterpTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ int numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; Trace *tracePtr, *lastTracePtr; ActiveInterpTrace active; int curLevel; int traceCode = TCL_OK; Tcl_InterpState state = NULL; if ((iPtr->tracePtr == NULL) || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) { return(traceCode); } curLevel = iPtr->numLevels; active.nextPtr = iPtr->activeInterpTracePtr; iPtr->activeInterpTracePtr = &active; lastTracePtr = NULL; for (tracePtr = iPtr->tracePtr; (traceCode == TCL_OK) && (tracePtr != NULL); tracePtr = active.nextTracePtr) { if (traceFlags & TCL_TRACE_ENTER_EXEC) { /* * Execute the trace command in reverse order of creation for * "enterstep" operation. The order is changed for "enterstep" * instead of for "leavestep" as was done in * TclCheckExecutionTraces because for step traces, * Tcl_CreateObjTrace creates one more linked list of traces which * results in one more reversal of trace invocation. */ active.reverseScan = 1; active.nextTracePtr = NULL; tracePtr = iPtr->tracePtr; while (tracePtr->nextPtr != lastTracePtr) { active.nextTracePtr = tracePtr; tracePtr = tracePtr->nextPtr; } if (active.nextTracePtr) { lastTracePtr = active.nextTracePtr->nextPtr; } } else { active.reverseScan = 0; active.nextTracePtr = tracePtr->nextPtr; } if (tracePtr->level > 0 && curLevel > tracePtr->level) { continue; } if (!(tracePtr->flags & TCL_TRACE_EXEC_IN_PROGRESS)) { /* * The proc invoked might delete the traced command which which * might try to free tracePtr. We want to use tracePtr until the * end of this if section, so we use Tcl_Preserve() and * Tcl_Release() to be sure it is not freed while we still need * it. */ Tcl_Preserve(tracePtr); tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; if (state == NULL) { state = Tcl_SaveInterpState(interp, code); } if (tracePtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) { /* * New style trace. */ if (tracePtr->flags & traceFlags) { if (tracePtr->proc == TraceExecutionProc) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData; tcmdPtr->curFlags = traceFlags; tcmdPtr->curCode = code; } traceCode = tracePtr->proc(tracePtr->clientData, interp, curLevel, command, (Tcl_Command) cmdPtr, objc, objv); } } else { /* * Old-style trace. */ if (traceFlags & TCL_TRACE_ENTER_EXEC) { /* * Old-style interpreter-wide traces only trigger before * the command is executed. */ traceCode = CallTraceFunction(interp, tracePtr, cmdPtr, command, numChars, objc, objv); } } tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; Tcl_Release(tracePtr); } } iPtr->activeInterpTracePtr = active.nextPtr; if (state) { if (traceCode == TCL_OK) { Tcl_RestoreInterpState(interp, state); } else { Tcl_DiscardInterpState(state); } } return traceCode; } /* *---------------------------------------------------------------------- * * CallTraceFunction -- * * Invokes a trace function registered with an interpreter. These * functions trace command execution. Currently this trace function is * called with the address of the string-based Tcl_CmdProc for the * command, not the Tcl_ObjCmdProc. * * Results: * None. * * Side effects: * Those side effects made by the trace function. * *---------------------------------------------------------------------- */ static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ Trace *tracePtr, /* Describes the trace function to call. */ Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ int numChars, /* The number of characters in the command's * source. */ int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; char *commandCopy; int traceCode; /* * Copy the command characters into a new string. */ commandCopy = (char *)TclStackAlloc(interp, numChars + 1); memcpy(commandCopy, command, numChars); commandCopy[numChars] = '\0'; /* * Call the trace function then free allocated storage. */ traceCode = tracePtr->proc(tracePtr->clientData, (Tcl_Interp *) iPtr, iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv); TclStackFree(interp, commandCopy); return traceCode; } /* *---------------------------------------------------------------------- * * CommandObjTraceDeleted -- * * Ensure the trace is correctly deleted by decrementing its refCount and * only deleting if no other references exist. * * Results: * None. * * Side effects: * May release memory. * *---------------------------------------------------------------------- */ static void CommandObjTraceDeleted( ClientData clientData) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } } /* *---------------------------------------------------------------------- * * TraceExecutionProc -- * * This function is invoked whenever code relevant to a 'trace execution' * command is executed. It is called in one of two ways in Tcl's core: * * (i) by the TclCheckExecutionTraces, when an execution trace has been * triggered. * (ii) by TclCheckInterpTraces, when a prior execution trace has created * a trace of the internals of a procedure, passing in this function as * the one to be called. * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR, etc. * * Side effects: * May invoke an arbitrary Tcl procedure, and may create or delete an * interpreter-wide trace. * *---------------------------------------------------------------------- */ static int TraceExecutionProc( ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command cmdInfo, int objc, Tcl_Obj *const objv[]) { int call = 0; Interp *iPtr = (Interp *) interp; TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; int flags = tcmdPtr->curFlags; int code = tcmdPtr->curCode; int traceCode = TCL_OK; if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Inside any kind of execution trace callback, we do not allow any * further execution trace callbacks to be called for the same trace. */ return traceCode; } if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { /* * Check whether the current call is going to eval arbitrary Tcl code * with a generated trace, or whether we are only going to setup * interpreter-wide traces to implement the 'step' traces. This latter * situation can happen if we create a command trace without either * before or after operations, but with either of the step operations. */ if (flags & TCL_TRACE_EXEC_DIRECT) { call = flags & tcmdPtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } else { call = 1; } /* * First, if we have returned back to the level at which we created an * interpreter trace for enterstep and/or leavestep execution traces, * we remove it here. */ if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel) && (strcmp(command, tcmdPtr->startCmd) == 0)) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; ckfree(tcmdPtr->startCmd); } /* * Second, create the tcl callback, if required. */ if (call) { Tcl_DString cmd, sub; int i, saveInterpFlags; Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length); /* * Append command with arguments. */ Tcl_DStringInit(&sub); for (i = 0; i < objc; i++) { Tcl_DStringAppendElement(&sub, Tcl_GetString(objv[i])); } Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub)); Tcl_DStringFree(&sub); if (flags & TCL_TRACE_ENTER_EXEC) { /* * Append trace operation. */ if (flags & TCL_TRACE_EXEC_DIRECT) { Tcl_DStringAppendElement(&cmd, "enter"); } else { Tcl_DStringAppendElement(&cmd, "enterstep"); } } else if (flags & TCL_TRACE_LEAVE_EXEC) { Tcl_Obj *resultCode; const char *resultCodeStr; /* * Append result code. */ TclNewIntObj(resultCode, code); resultCodeStr = Tcl_GetString(resultCode); Tcl_DStringAppendElement(&cmd, resultCodeStr); Tcl_DecrRefCount(resultCode); /* * Append result string. */ Tcl_DStringAppendElement(&cmd, Tcl_GetStringResult(interp)); /* * Append trace operation. */ if (flags & TCL_TRACE_EXEC_DIRECT) { Tcl_DStringAppendElement(&cmd, "leave"); } else { Tcl_DStringAppendElement(&cmd, "leavestep"); } } else { Tcl_Panic("TraceExecutionProc: bad flag combination"); } /* * Execute the command. We discard any object result the command * returns. */ saveInterpFlags = iPtr->flags; iPtr->flags |= INTERP_TRACE_IN_PROGRESS; tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; tcmdPtr->refCount++; /* * This line can have quite arbitrary side-effects, including * deleting the trace, the command being traced, or even the * interpreter. */ traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), 0); tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; /* * Restore the interp tracing flag to prevent cmd traces from * affecting interp traces. */ iPtr->flags = saveInterpFlags; if (tcmdPtr->flags == 0) { flags |= TCL_TRACE_DESTROYED; } Tcl_DStringFree(&cmd); } /* * Third, if there are any step execution traces for this proc, we * register an interpreter trace to invoke enterstep and/or leavestep * traces. We also need to save the current stack level and the proc * string in startLevel and startCmd so that we can delete this * interpreter trace when it reaches the end of this proc. */ if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { unsigned len = strlen(command) + 1; tcmdPtr->startLevel = level; tcmdPtr->startCmd = (char *)ckalloc(len); memcpy(tcmdPtr->startCmd, command, len); tcmdPtr->refCount++; tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted); } } if (flags & TCL_TRACE_DESTROYED) { if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; ckfree(tcmdPtr->startCmd); } } if (call) { if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } } return traceCode; } /* *---------------------------------------------------------------------- * * TraceVarProc -- * * This function is called to handle variable accesses that have been * traced using the "trace" command. * * Results: * Normally returns NULL. If the trace command returns an error, then * this function returns an error string. * * Side effects: * Depends on the command associated with the trace. * *---------------------------------------------------------------------- */ static char * TraceVarProc( ClientData clientData, /* Information about the variable trace. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable or array. */ const char *name2, /* Name of element within array; NULL means * scalar variable is being referenced. */ int flags) /* OR-ed bits giving operation and other * information. */ { TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; char *result; int code, destroy = 0; Tcl_DString cmd; int rewind = ((Interp *)interp)->execEnvPtr->rewind; /* * We might call Tcl_EvalEx() below, and that might evaluate * [trace remove variable] which might try to free tvarPtr. We want to * use tvarPtr until the end of this function, so we use Tcl_Preserve() * and Tcl_Release() to be sure it is not freed while we still need it. */ result = NULL; if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { if (tvarPtr->length) { /* * Generate a command to execute by appending list elements for * the two variable names and the operation. */ Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length); Tcl_DStringAppendElement(&cmd, name1); Tcl_DStringAppendElement(&cmd, (name2 ? name2 : "")); #ifndef TCL_REMOVE_OBSOLETE_TRACES if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { if (flags & TCL_TRACE_ARRAY) { TclDStringAppendLiteral(&cmd, " a"); } else if (flags & TCL_TRACE_READS) { TclDStringAppendLiteral(&cmd, " r"); } else if (flags & TCL_TRACE_WRITES) { TclDStringAppendLiteral(&cmd, " w"); } else if (flags & TCL_TRACE_UNSETS) { TclDStringAppendLiteral(&cmd, " u"); } } else { #endif if (flags & TCL_TRACE_ARRAY) { TclDStringAppendLiteral(&cmd, " array"); } else if (flags & TCL_TRACE_READS) { TclDStringAppendLiteral(&cmd, " read"); } else if (flags & TCL_TRACE_WRITES) { TclDStringAppendLiteral(&cmd, " write"); } else if (flags & TCL_TRACE_UNSETS) { TclDStringAppendLiteral(&cmd, " unset"); } #ifndef TCL_REMOVE_OBSOLETE_TRACES } #endif /* * Execute the command. We discard any object result the command * returns. * * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to * other areas that this will be destroyed by us, otherwise a * double-free might occur depending on what the eval does. */ if ((flags & TCL_TRACE_DESTROYED) && !(tvarPtr->flags & TCL_TRACE_DESTROYED)) { destroy = 1; tvarPtr->flags |= TCL_TRACE_DESTROYED; } /* * Make sure that unset traces are rune even if the execEnv is * rewinding (coroutine deletion, [Bug 2093947] */ if (rewind && (flags & TCL_TRACE_UNSETS)) { ((Interp *)interp)->execEnvPtr->rewind = 0; } code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), 0); if (rewind) { ((Interp *)interp)->execEnvPtr->rewind = rewind; } if (code != TCL_OK) { /* copy error msg to result */ Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } Tcl_DStringFree(&cmd); } } if (destroy && result != NULL) { Tcl_Obj *errMsgObj = (Tcl_Obj *) result; Tcl_DecrRefCount(errMsgObj); result = NULL; } return result; } /* *---------------------------------------------------------------------- * * Tcl_CreateObjTrace -- * * Arrange for a function to be called to trace command execution. * * Results: * The return value is a token for the trace, which may be passed to * Tcl_DeleteTrace to eliminate the trace. * * Side effects: * From now on, proc will be called just before a command function is * called to execute a Tcl command. Calls to proc will have the following * form: * * void proc(ClientData clientData, * Tcl_Interp * interp, * int level, * const char * command, * Tcl_Command commandInfo, * int objc, * Tcl_Obj *const objv[]); * * The 'clientData' and 'interp' arguments to 'proc' will be the same as * the arguments to Tcl_CreateObjTrace. The 'level' argument gives the * nesting depth of command interpretation within the interpreter. The * 'command' argument is the ASCII text of the command being evaluated - * before any substitutions are performed. The 'commandInfo' argument * gives a handle to the command procedure that will be evaluated. The * 'objc' and 'objv' parameters give the parameter vector that will be * passed to the command procedure. Proc does not return a value. * * The 'level' argument specifies the maximum nesting level of calls to * be traced. If the execution depth of the interpreter exceeds 'level', * the trace callback is not executed. * * The 'flags' argument is either zero or the value, * TCL_ALLOW_INLINE_COMPILATION. If the TCL_ALLOW_INLINE_COMPILATION flag * is not present, the bytecode compiler will not generate inline code * for Tcl's built-in commands. This behavior will have a significant * impact on performance, but will ensure that all command evaluations * are traced. If the TCL_ALLOW_INLINE_COMPILATION flag is present, the * bytecode compiler will have its normal behavior of compiling in-line * code for some of Tcl's built-in commands. In this case, the tracing * will be imprecise - in-line code will not be traced - but run-time * performance will be improved. The latter behavior is desired for many * applications such as profiling of run time. * * When the trace is deleted, the 'delProc' function will be invoked, * passing it the original client data. * *---------------------------------------------------------------------- */ Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ int level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ ClientData clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { Trace *tracePtr; Interp *iPtr = (Interp *) interp; /* * Test if this trace allows inline compilation of commands. */ if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) { if (iPtr->tracesForbiddingInline == 0) { /* * When the first trace forbidding inline compilation is created, * invalidate existing compiled code for this interpreter and * arrange (by setting the DONT_COMPILE_CMDS_INLINE flag) that * when compiling new code, no commands will be compiled inline * (i.e., into an inline sequence of instructions). We do this * because commands that were compiled inline will never result in * a command trace being called. */ iPtr->compileEpoch++; iPtr->flags |= DONT_COMPILE_CMDS_INLINE; } iPtr->tracesForbiddingInline++; } tracePtr = (Trace *)ckalloc(sizeof(Trace)); tracePtr->level = level; tracePtr->proc = proc; tracePtr->clientData = clientData; tracePtr->delProc = delProc; tracePtr->nextPtr = iPtr->tracePtr; tracePtr->flags = flags; iPtr->tracePtr = tracePtr; return (Tcl_Trace) tracePtr; } /* *---------------------------------------------------------------------- * * Tcl_CreateTrace -- * * Arrange for a function to be called to trace command execution. * * Results: * The return value is a token for the trace, which may be passed to * Tcl_DeleteTrace to eliminate the trace. * * Side effects: * From now on, proc will be called just before a command procedure is * called to execute a Tcl command. Calls to proc will have the following * form: * * void * proc(clientData, interp, level, command, cmdProc, cmdClientData, * argc, argv) * ClientData clientData; * Tcl_Interp *interp; * int level; * char *command; * int (*cmdProc)(); * ClientData cmdClientData; * int argc; * char **argv; * { * } * * The clientData and interp arguments to proc will be the same as the * corresponding arguments to this function. Level gives the nesting * level of command interpretation for this interpreter (0 corresponds to * top level). Command gives the ASCII text of the raw command, cmdProc * and cmdClientData give the function that will be called to process the * command and the ClientData value it will receive, and argc and argv * give the arguments to the command, after any argument parsing and * substitution. Proc does not return a value. * *---------------------------------------------------------------------- */ Tcl_Trace Tcl_CreateTrace( Tcl_Interp *interp, /* Interpreter in which to create trace. */ int level, /* Only call proc for commands at nesting * level<=argument level (1=>top level). */ Tcl_CmdTraceProc *proc, /* Function to call before executing each * command. */ ClientData clientData) /* Arbitrary value word to pass to proc. */ { StringTraceData *data = (StringTraceData *)ckalloc(sizeof(StringTraceData)); data->clientData = clientData; data->proc = proc; return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc, data, StringTraceDeleteProc); } /* *---------------------------------------------------------------------- * * StringTraceProc -- * * Invoke a string-based trace function from an object-based callback. * * Results: * None. * * Side effects: * Whatever the string-based trace function does. * *---------------------------------------------------------------------- */ static int StringTraceProc( ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *const *objv) { StringTraceData *data = (StringTraceData *)clientData; Command *cmdPtr = (Command *) commandInfo; const char **argv; /* Args to pass to string trace proc */ int i; /* * This is a bit messy because we have to emulate the old trace interface, * which uses strings for everything. */ argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(const char *)); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); } argv[objc] = 0; /* * Invoke the command function. Note that we cast away const-ness on two * parameters for compatibility with legacy code; the code MUST NOT modify * either command or argv. */ data->proc(data->clientData, interp, level, (char *) command, cmdPtr->proc, cmdPtr->clientData, objc, argv); TclStackFree(interp, (void *) argv); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringTraceDeleteProc -- * * Clean up memory when a string-based trace is deleted. * * Results: * None. * * Side effects: * Allocated memory is returned to the system. * *---------------------------------------------------------------------- */ static void StringTraceDeleteProc( ClientData clientData) { ckfree(clientData); } /* *---------------------------------------------------------------------- * * Tcl_DeleteTrace -- * * Remove a trace. * * Results: * None. * * Side effects: * From now on there will be no more calls to the function given in * trace. * *---------------------------------------------------------------------- */ void Tcl_DeleteTrace( Tcl_Interp *interp, /* Interpreter that contains trace. */ Tcl_Trace trace) /* Token for trace (returned previously by * Tcl_CreateTrace). */ { Interp *iPtr = (Interp *) interp; Trace *prevPtr, *tracePtr = (Trace *) trace; Trace **tracePtr2 = &iPtr->tracePtr; ActiveInterpTrace *activePtr; /* * Locate the trace entry in the interpreter's trace list, and remove it * from the list. */ prevPtr = NULL; while (*tracePtr2 != NULL && *tracePtr2 != tracePtr) { prevPtr = *tracePtr2; tracePtr2 = &prevPtr->nextPtr; } if (*tracePtr2 == NULL) { return; } *tracePtr2 = (*tracePtr2)->nextPtr; /* * The code below makes it possible to delete traces while traces are * active: it makes sure that the deleted trace won't be processed by * TclCheckInterpTraces. */ for (activePtr = iPtr->activeInterpTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->nextTracePtr == tracePtr) { if (activePtr->reverseScan) { activePtr->nextTracePtr = prevPtr; } else { activePtr->nextTracePtr = tracePtr->nextPtr; } } } /* * If the trace forbids bytecode compilation, change the interpreter's * state. If bytecode compilation is now permitted, flag the fact and * advance the compilation epoch so that procs will be recompiled to take * advantage of it. */ if (!(tracePtr->flags & TCL_ALLOW_INLINE_COMPILATION)) { iPtr->tracesForbiddingInline--; if (iPtr->tracesForbiddingInline == 0) { iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE; iPtr->compileEpoch++; } } /* * Execute any delete callback. */ if (tracePtr->delProc != NULL) { tracePtr->delProc(tracePtr->clientData); } /* * Delete the trace object. */ Tcl_EventuallyFree((char *) tracePtr, TCL_DYNAMIC); } /* *---------------------------------------------------------------------- * * TclTraceVarExists -- * * This is called from info exists. We need to trigger read and/or array * traces because they may end up creating a variable that doesn't * currently exist. * * Results: * A pointer to the Var structure, or NULL. * * Side effects: * May fill in error messages in the interp. * *---------------------------------------------------------------------- */ Var * TclVarTraceExists( Tcl_Interp *interp, /* The interpreter */ const char *varName) /* The variable name */ { Var *varPtr, *arrayPtr; /* * The choice of "create" flag values is delicate here, and matches the * semantics of GetVar. Things are still not perfect, however, because if * you do "info exists x" you get a varPtr and therefore trigger traces. * However, if you do "info exists x(i)", then you only get a varPtr if x * is already known to be an array. Otherwise you get NULL, and no trace * is triggered. This matches Tcl 7.6 semantics. */ varPtr = TclLookupVar(interp, varName, NULL, 0, "access", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } if ((varPtr->flags & VAR_TRACED_READ) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) { TclCallVarTraces((Interp *) interp, arrayPtr, varPtr, varName, NULL, TCL_TRACE_READS, /* leaveErrMsg */ 0); } /* * If the variable doesn't exist anymore and no-one's using it, then free * up the relevant structures and hash table entries. */ if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); return NULL; } return varPtr; } /* *---------------------------------------------------------------------- * * TclCheckArrayTraces -- * * This function is invoked to when we operate on an array variable, * to allow any array traces to fire. * * Results: * Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if * invocation of a trace function indicated an error. When TCL_ERROR is * returned, then error information is left in interp. * * Side effects: * Almost anything can happen, depending on trace; this function itself * doesn't have any side effects. * *---------------------------------------------------------------------- */ int TclCheckArrayTraces( Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index) { int code = TCL_OK; if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY) && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { Interp *iPtr = (Interp *)interp; code = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, name, NULL, (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, index); } return code; } /* *---------------------------------------------------------------------- * * TclCallVarTraces -- * * This function is invoked to find and invoke relevant trace functions * associated with a particular operation on a variable. This function * invokes traces both on the variable and on its containing array (where * relevant). * * Results: * Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if * invocation of a trace function indicated an error. When TCL_ERROR is * returned and leaveErrMsg is true, then the errorInfo field of iPtr has * information about the error placed in it. * * Side effects: * Almost anything can happen, depending on trace; this function itself * doesn't have any side effects. * *---------------------------------------------------------------------- */ int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, /* Variable's two-part name. */ int flags, /* Flags passed to trace functions: indicates * what's happening to variable, plus maybe * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */ int leaveErrMsg, /* If true, and one of the traces indicates an * error, then leave an error message and * stack trace information in *iPTr. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { const char *part1, *part2; if (!part1Ptr) { part1Ptr = localName(iPtr->varFramePtr, index); } if (!part1Ptr) { Tcl_Panic("Cannot trace a variable with no name"); } part1 = TclGetString(part1Ptr); part2 = part2Ptr? TclGetString(part2Ptr) : NULL; return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ const char *part1, const char *part2, /* Variable's two-part name. */ int flags, /* Flags passed to trace functions: indicates * what's happening to variable, plus maybe * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */ int leaveErrMsg) /* If true, and one of the traces indicates an * error, then leave an error message and * stack trace information in *iPTr. */ { VarTrace *tracePtr; ActiveVarTrace active; char *result; const char *openParen, *p; Tcl_DString nameCopy; int copiedName; int code = TCL_OK; int disposeFlags = 0; Tcl_InterpState state = NULL; Tcl_HashEntry *hPtr; int traceflags = flags & VAR_ALL_TRACES; /* * If there are already similar trace functions active for the variable, * don't call them again. */ if (TclIsVarTraceActive(varPtr)) { return code; } TclSetVarTraceActive(varPtr); if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } if (arrayPtr && TclIsVarInHash(arrayPtr)) { VarHashRefCount(arrayPtr)++; } /* * If the variable name hasn't been parsed into array name and element, do * it here. If there really is an array element, make a copy of the * original name so that NULLs can be inserted into it to separate the * names (can't modify the name string in place, because the string might * get used by the callbacks we invoke). */ copiedName = 0; if (part2 == NULL) { for (p = part1; *p ; p++) { if (*p == '(') { openParen = p; do { p++; } while (*p != '\0'); p--; if (*p == ')') { int offset = (openParen - part1); char *newPart1; Tcl_DStringInit(&nameCopy); Tcl_DStringAppend(&nameCopy, part1, p-part1); newPart1 = Tcl_DStringValue(&nameCopy); newPart1[offset] = 0; part1 = newPart1; part2 = newPart1 + offset + 1; copiedName = 1; } break; } } } /* * Ignore any caller-provided TCL_INTERP_DESTROYED flag. Only we can * set it correctly. */ flags &= ~TCL_INTERP_DESTROYED; /* * Invoke traces on the array containing the variable, if relevant. */ result = NULL; active.nextPtr = iPtr->activeVarTracePtr; iPtr->activeVarTracePtr = &active; Tcl_Preserve(iPtr); if (arrayPtr && !TclIsVarTraceActive(arrayPtr) && (arrayPtr->flags & traceflags)) { hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr); active.varPtr = arrayPtr; for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve(tracePtr); if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); } if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) { flags |= TCL_INTERP_DESTROYED; } result = tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { /* * Ignore errors in unset traces. */ DisposeTraceResult(tracePtr->flags, result); } else { disposeFlags = tracePtr->flags; code = TCL_ERROR; } } Tcl_Release(tracePtr); if (code == TCL_ERROR) { goto done; } } } /* * Invoke traces on the variable itself. */ if (flags & TCL_TRACE_UNSETS) { flags |= TCL_TRACE_DESTROYED; } active.varPtr = varPtr; if (varPtr->flags & traceflags) { hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve(tracePtr); if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); } if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) { flags |= TCL_INTERP_DESTROYED; } result = tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { /* * Ignore errors in unset traces. */ DisposeTraceResult(tracePtr->flags, result); } else { disposeFlags = tracePtr->flags; code = TCL_ERROR; } } Tcl_Release(tracePtr); if (code == TCL_ERROR) { goto done; } } } /* * Restore the variable's flags, remove the record of our active traces, * and then return. */ done: if (code == TCL_ERROR) { if (leaveErrMsg) { const char *verb = ""; const char *type = ""; switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) { case TCL_TRACE_READS: verb = "read"; type = verb; break; case TCL_TRACE_WRITES: verb = "set"; type = "write"; break; case TCL_TRACE_ARRAY: verb = "trace array"; type = "array"; break; } if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result); } else { Tcl_SetObjResult((Tcl_Interp *)iPtr, Tcl_NewStringObj(result, -1)); } Tcl_AddErrorInfo((Tcl_Interp *)iPtr, ""); Tcl_AppendObjToErrorInfo((Tcl_Interp *)iPtr, Tcl_ObjPrintf( "\n (%s trace on \"%s%s%s%s\")", type, part1, (part2 ? "(" : ""), (part2 ? part2 : ""), (part2 ? ")" : "") )); if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, Tcl_GetString((Tcl_Obj *) result)); } else { TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, result); } iPtr->flags &= ~(ERR_ALREADY_LOGGED); Tcl_DiscardInterpState(state); } else { Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); } DisposeTraceResult(disposeFlags,result); } else if (state) { if (code == TCL_OK) { code = Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); } else { Tcl_DiscardInterpState(state); } } if (arrayPtr && TclIsVarInHash(arrayPtr)) { VarHashRefCount(arrayPtr)--; } if (copiedName) { Tcl_DStringFree(&nameCopy); } TclClearVarTraceActive(varPtr); if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)--; } iPtr->activeVarTracePtr = active.nextPtr; Tcl_Release(iPtr); return code; } /* *---------------------------------------------------------------------- * * DisposeTraceResult-- * * This function is called to dispose of the result returned from a trace * function. The disposal method appropriate to the type of result is * determined by flags. * * Results: * None. * * Side effects: * The memory allocated for the trace result may be freed. * *---------------------------------------------------------------------- */ static void DisposeTraceResult( int flags, /* Indicates type of result to determine * proper disposal method. */ char *result) /* The result returned from a trace function * to be disposed. */ { if (flags & TCL_TRACE_RESULT_DYNAMIC) { ckfree(result); } else if (flags & TCL_TRACE_RESULT_OBJECT) { Tcl_DecrRefCount((Tcl_Obj *) result); } } /* *---------------------------------------------------------------------- * * Tcl_UntraceVar -- * * Remove a previously-created trace for a variable. * * Results: * None. * * Side effects: * If there exists a trace for the variable given by varName with the * given flags, proc, and clientData, then that trace is removed. * *---------------------------------------------------------------------- */ #undef Tcl_UntraceVar void Tcl_UntraceVar( Tcl_Interp *interp, /* Interpreter containing variable. */ const char *varName, /* Name of variable; may end with "(index)" to * signify an array reference. */ int flags, /* OR-ed collection of bits describing current * trace, including any of TCL_TRACE_READS, * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData); } /* *---------------------------------------------------------------------- * * Tcl_UntraceVar2 -- * * Remove a previously-created trace for a variable. * * Results: * None. * * Side effects: * If there exists a trace for the variable given by part1 and part2 with * the given flags, proc, and clientData, then that trace is removed. * *---------------------------------------------------------------------- */ void Tcl_UntraceVar2( Tcl_Interp *interp, /* Interpreter containing variable. */ const char *part1, /* Name of variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags, /* OR-ed collection of bits describing current * trace, including any of TCL_TRACE_READS, * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function associated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; ActiveVarTrace *activePtr; int flagMask, allFlags = 0; Tcl_HashEntry *hPtr; /* * Set up a mask to mask out the parts of the flags that we are not * interested in now. */ flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; varPtr = TclLookupVar(interp, part1, part2, flags & flagMask, /*msg*/ NULL, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL || !(varPtr->flags & VAR_ALL_TRACES & flags)) { return; } /* * Set up a mask to mask out the parts of the flags that we are not * interested in now. */ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; #ifndef TCL_REMOVE_OBSOLETE_TRACES flagMask |= TCL_TRACE_OLD_STYLE; #endif flags &= flagMask; hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr), prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { goto updateFlags; } if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags) && (tracePtr->clientData == clientData)) { break; } allFlags |= tracePtr->flags; } /* * The code below makes it possible to delete traces while traces are * active: it makes sure that the deleted trace won't be processed by * TclCallVarTraces. * * Caveat (Bug 3062331): When an unset trace handler on a variable * tries to delete a different unset trace handler on the same variable, * the results may be surprising. When variable unset traces fire, the * traced variable is already gone. So the TclLookupVar() call above * will not find that variable, and not finding it will never reach here * to perform the deletion. This means callers of Tcl_UntraceVar*() * attempting to delete unset traces from within the handler of another * unset trace have to account for the possibility that their call to * Tcl_UntraceVar*() is a no-op. */ for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->nextTracePtr == tracePtr) { activePtr->nextTracePtr = tracePtr->nextPtr; } } nextPtr = tracePtr->nextPtr; if (prevPtr == NULL) { if (nextPtr) { Tcl_SetHashValue(hPtr, nextPtr); } else { Tcl_DeleteHashEntry(hPtr); } } else { prevPtr->nextPtr = nextPtr; } tracePtr->nextPtr = NULL; Tcl_EventuallyFree(tracePtr, TCL_DYNAMIC); for (tracePtr = nextPtr; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { allFlags |= tracePtr->flags; } updateFlags: varPtr->flags &= ~VAR_ALL_TRACES; if (allFlags & VAR_ALL_TRACES) { varPtr->flags |= (allFlags & VAR_ALL_TRACES); } else if (TclIsVarUndefined(varPtr)) { /* * If this is the last trace on the variable, and the variable is * unset and unused, then free up the variable. */ TclCleanupVar(varPtr, NULL); } } /* *---------------------------------------------------------------------- * * Tcl_VarTraceInfo -- * * Return the clientData value associated with a trace on a variable. * This function can also be used to step through all of the traces on a * particular variable that have the same trace function. * * Results: * The return value is the clientData value associated with a trace on * the given variable. Information will only be returned for a trace with * proc as trace function. If the clientData argument is NULL then the * first such trace is returned; otherwise, the next relevant one after * the one given by clientData will be returned. If the variable doesn't * exist, or if there are no (more) traces for it, then NULL is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ #undef Tcl_VarTraceInfo ClientData Tcl_VarTraceInfo( Tcl_Interp *interp, /* Interpreter containing variable. */ const char *varName, /* Name of variable; may end with "(index)" to * signify an array reference. */ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY (can be 0). */ Tcl_VarTraceProc *proc, /* Function associated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData); } /* *---------------------------------------------------------------------- * * Tcl_VarTraceInfo2 -- * * Same as Tcl_VarTraceInfo, except takes name in two pieces instead of * one. * * Results: * Same as Tcl_VarTraceInfo. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_VarTraceInfo2( Tcl_Interp *interp, /* Interpreter containing variable. */ const char *part1, /* Name of variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function associated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Interp *iPtr = (Interp *) interp; Var *varPtr, *arrayPtr; Tcl_HashEntry *hPtr; varPtr = TclLookupVar(interp, part1, part2, flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ NULL, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return NULL; } /* * Find the relevant trace, if any, and return its clientData. */ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); if (hPtr) { VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); if (prevClientData != NULL) { for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { if ((tracePtr->clientData == prevClientData) && (tracePtr->traceProc == proc)) { tracePtr = tracePtr->nextPtr; break; } } } for (; tracePtr != NULL ; tracePtr = tracePtr->nextPtr) { if (tracePtr->traceProc == proc) { return tracePtr->clientData; } } } return NULL; } /* *---------------------------------------------------------------------- * * Tcl_TraceVar -- * * Arrange for reads and/or writes to a variable to cause a function to * be invoked, which can monitor the operations and/or change their * actions. * * Results: * A standard Tcl return value. * * Side effects: * A trace is set up on the variable given by varName, such that future * references to the variable will be mediated by proc. See the * manual entry for complete details on the calling sequence for proc. * The variable's flags are updated. * *---------------------------------------------------------------------- */ #undef Tcl_TraceVar int Tcl_TraceVar( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ const char *varName, /* Name of variable; may end with "(index)" to * signify an array reference. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData); } /* *---------------------------------------------------------------------- * * Tcl_TraceVar2 -- * * Arrange for reads and/or writes to a variable to cause a function to * be invoked, which can monitor the operations and/or change their * actions. * * Results: * A standard Tcl return value. * * Side effects: * A trace is set up on the variable given by part1 and part2, such that * future references to the variable will be mediated by proc. See * the manual entry for complete details on the calling sequence for * proc. The variable's flags are updated. * *---------------------------------------------------------------------- */ int Tcl_TraceVar2( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ const char *part1, /* Name of scalar variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; int result; tracePtr = (VarTrace *)ckalloc(sizeof(VarTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags; result = TraceVarEx(interp, part1, part2, tracePtr); if (result != TCL_OK) { ckfree(tracePtr); } return result; } /* *---------------------------------------------------------------------- * * TraceVarEx -- * * Arrange for reads and/or writes to a variable to cause a function to * be invoked, which can monitor the operations and/or change their * actions. * * Results: * A standard Tcl return value. * * Side effects: * A trace is set up on the variable given by part1 and part2, such that * future references to the variable will be mediated by the * traceProc listed in tracePtr. See the manual entry for complete * details on the calling sequence for proc. * *---------------------------------------------------------------------- */ static int TraceVarEx( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ const char *part1, /* Name of scalar variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ VarTrace *tracePtr)/* Structure containing flags, traceProc and * clientData fields. Others should be left * blank. Will be ckfree()d (eventually) if * this function returns TCL_OK, and up to * caller to free if this function returns * TCL_ERROR. */ { Interp *iPtr = (Interp *) interp; Var *varPtr, *arrayPtr; int flagMask, isNew; Tcl_HashEntry *hPtr; /* * We strip 'flags' down to just the parts which are relevant to * TclLookupVar, to avoid conflicts between trace flags and internal * namespace flags such as 'TCL_FIND_ONLY_NS'. This can now occur since we * have trace flags with values 0x1000 and higher. */ flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; varPtr = TclLookupVar(interp, part1, part2, (tracePtr->flags & flagMask) | TCL_LEAVE_ERR_MSG, "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } /* * Check for a nonsense flag combination. Note that this is a Tcl_Panic() * because there should be no code path that ever sets both flags. */ if ((tracePtr->flags & TCL_TRACE_RESULT_DYNAMIC) && (tracePtr->flags & TCL_TRACE_RESULT_OBJECT)) { Tcl_Panic("bad result flag combination"); } /* * Set up trace information. */ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; #ifndef TCL_REMOVE_OBSOLETE_TRACES flagMask |= TCL_TRACE_OLD_STYLE; #endif tracePtr->flags = tracePtr->flags & flagMask; hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew); if (isNew) { tracePtr->nextPtr = NULL; } else { tracePtr->nextPtr = (VarTrace *)Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, tracePtr); /* * Mark the variable as traced so we know to call them. */ varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclUniData.c0000644000175000017500000036164414554262142015470 0ustar sergeisergei/* * tclUniData.c -- * * Declarations of Unicode character information tables. This file is * automatically generated by the tools/uniParse.tcl script. Do not * modify this file by hand. * * Copyright (c) 1998 by Scriptics Corporation. * All rights reserved. */ /* * A 16-bit Unicode character is split into two parts in order to index * into the following tables. The lower OFFSET_BITS comprise an offset * into a page of characters. The upper bits comprise the page number. */ #define OFFSET_BITS 5 /* * The pageMap is indexed by page number and returns an alternate page number * that identifies a unique page of characters. Many Unicode characters map * to the same alternate page number. */ static const unsigned short pageMap[] = { 0, 32, 64, 96, 0, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448, 224, 480, 512, 544, 576, 608, 640, 672, 704, 704, 736, 768, 800, 832, 864, 896, 928, 960, 992, 224, 1024, 224, 1056, 224, 224, 1088, 1120, 1152, 1184, 1216, 1248, 1280, 1312, 1344, 1376, 1408, 1344, 1344, 1440, 1472, 1504, 1536, 1568, 1344, 1344, 1600, 1632, 1664, 1696, 1728, 1760, 1792, 1824, 1344, 1856, 1888, 1920, 1952, 1984, 2016, 2048, 2080, 2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2400, 2432, 2464, 2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, 2816, 2848, 2880, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, 3168, 3200, 3232, 3264, 3296, 3328, 3360, 3392, 3296, 3424, 3456, 3488, 3520, 3552, 3584, 3616, 3296, 1344, 3648, 3680, 3712, 3744, 3776, 3808, 3840, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3872, 1344, 3904, 3936, 3968, 1344, 4000, 1344, 4032, 4064, 4096, 4128, 4128, 4160, 4192, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4224, 4256, 1344, 1344, 4288, 4320, 4352, 4384, 4416, 1344, 4448, 4480, 4512, 4544, 1344, 4576, 4608, 4640, 4672, 1344, 4704, 4736, 4768, 4800, 4832, 1344, 4864, 4896, 4928, 4960, 1344, 4992, 5024, 5056, 5088, 5120, 3296, 5152, 5184, 5216, 5248, 5280, 5312, 1344, 5344, 1344, 5376, 5408, 5440, 5472, 5504, 5536, 5568, 5600, 5632, 5664, 5696, 5728, 5664, 704, 704, 224, 224, 224, 224, 5760, 224, 224, 224, 5792, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112, 6144, 6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, 6464, 6496, 6528, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6592, 6624, 4928, 6656, 6688, 6720, 6752, 6784, 4928, 6816, 6848, 6880, 6912, 6944, 6976, 7008, 4928, 4928, 4928, 4928, 4928, 7040, 7072, 7104, 4928, 4928, 4928, 7136, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7168, 7200, 4928, 7232, 7264, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 6560, 6560, 6560, 6560, 7296, 6560, 7328, 7360, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 4928, 7392, 7424, 7456, 7488, 4928, 4928, 4928, 7520, 7552, 7584, 7616, 224, 224, 224, 7648, 7680, 7712, 1344, 7744, 7776, 7808, 7808, 704, 7840, 7872, 7904, 3296, 7936, 4928, 4928, 7968, 4928, 4928, 4928, 4928, 4928, 4928, 8000, 8032, 8064, 8096, 3200, 1344, 8128, 4192, 1344, 8160, 8192, 8224, 1344, 1344, 8256, 1344, 4928, 8288, 8320, 8352, 8384, 4928, 8352, 8416, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4928, 4928, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8448, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8480, 4928, 8512, 5440, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8544, 8576, 224, 8608, 8640, 1344, 1344, 8672, 8704, 8736, 224, 8768, 8800, 8832, 8864, 8896, 8928, 8960, 1344, 8992, 9024, 9056, 9088, 9120, 1632, 9152, 9184, 9216, 1920, 9248, 9280, 9312, 1344, 9344, 9376, 9408, 1344, 9440, 9472, 9504, 9536, 9568, 9600, 9632, 9664, 9664, 1344, 9696, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9728, 9760, 9792, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9888, 1344, 1344, 9920, 3296, 9952, 9984, 10016, 1344, 1344, 10048, 10080, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272, 10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496, 10528, 4736, 10560, 10592 #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 ,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784, 10816, 10848, 10880, 10912, 8032, 10944, 3296, 3296, 3296, 3296, 9216, 1344, 10976, 11008, 1344, 11040, 11072, 11104, 11136, 1344, 11168, 3296, 11200, 11232, 11264, 1344, 11296, 11328, 11360, 11392, 1344, 11424, 1344, 11456, 11488, 11520, 3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 7776, 4704, 11552, 11584, 11616, 3296, 3296, 11648, 11680, 11712, 11744, 4736, 11776, 3296, 11808, 11840, 11872, 3296, 3296, 1344, 11904, 11936, 6880, 11968, 12000, 12032, 12064, 12096, 3296, 12128, 12160, 1344, 12192, 12224, 12256, 12288, 12320, 3296, 3296, 1344, 1344, 12352, 3296, 12384, 12416, 12448, 12480, 1344, 12512, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12544, 1344, 12576, 3296, 12608, 12096, 12640, 12672, 12704, 12736, 12704, 12768, 7776, 12800, 12832, 12864, 12896, 5280, 12928, 12960, 12992, 13024, 13056, 13088, 13120, 5280, 13152, 13184, 13216, 13248, 13280, 13312, 3296, 13344, 13376, 13408, 13440, 13472, 13504, 13536, 13568, 3296, 3296, 3296, 3296, 1344, 13600, 13632, 13664, 1344, 13696, 13728, 3296, 3296, 3296, 3296, 3296, 1344, 13760, 13792, 3296, 1344, 13824, 13856, 13888, 1344, 13920, 13952, 3296, 4032, 13984, 14016, 3296, 3296, 3296, 3296, 3296, 1344, 14048, 3296, 3296, 3296, 14080, 14112, 14144, 14176, 14208, 14240, 3296, 3296, 14272, 14304, 14336, 14368, 14400, 14432, 1344, 14464, 14496, 1344, 4608, 14528, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 14560, 14592, 14624, 14656, 14688, 14720, 3296, 3296, 14752, 14784, 14816, 14848, 14880, 13952, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 14912, 14944, 14976, 15008, 3296, 3296, 15040, 15072, 15104, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9920, 3296, 3296, 3296, 10816, 10816, 10816, 15136, 1344, 1344, 1344, 1344, 1344, 1344, 15168, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12704, 1344, 1344, 15200, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15232, 15264, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14016, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4608, 4736, 15296, 1344, 4736, 15328, 15360, 1344, 15392, 15424, 15456, 15488, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 14080, 14112, 15520, 3296, 3296, 3296, 1344, 1344, 15552, 15584, 15616, 3296, 3296, 15648, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15680, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4704, 3296, 12352, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 15712, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15744, 15776, 15808, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9792, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 15840, 15872, 15904, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 704, 15936, 15968, 4928, 4928, 4928, 16000, 3296, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 8000, 4928, 16032, 4928, 16064, 16096, 16128, 4928, 6848, 4928, 4928, 16160, 3296, 3296, 3296, 16192, 16192, 4928, 4928, 16224, 16256, 3296, 3296, 3296, 3296, 16288, 16320, 16352, 16384, 16416, 16448, 16480, 16512, 16544, 16576, 16608, 16640, 16672, 16288, 16320, 16704, 16384, 16736, 16768, 16800, 16512, 16832, 16864, 16896, 16928, 16960, 16992, 17024, 17056, 17088, 17120, 17152, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 704, 17184, 704, 17216, 17248, 17280, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 17312, 17344, 3296, 3296, 3296, 3296, 3296, 3296, 17376, 17408, 5664, 17440, 17472, 3296, 3296, 3296, 1344, 17504, 17536, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12704, 17568, 1344, 17600, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12704, 17632, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 17664, 1344, 1344, 1344, 1344, 1344, 1344, 17696, 3296, 17728, 17760, 17792, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 17824, 6880, 17856, 3296, 3296, 17888, 17920, 3296, 3296, 3296, 3296, 3296, 3296, 17952, 17984, 18016, 18048, 18080, 18112, 3296, 18144, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 4928, 18176, 4928, 4928, 7968, 18208, 18240, 8000, 18272, 4928, 4928, 4928, 4928, 18304, 3296, 18336, 18368, 18400, 18432, 18464, 3296, 3296, 3296, 3296, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 18496, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 18528, 18560, 4928, 4928, 4928, 18592, 4928, 4928, 18624, 18656, 18176, 4928, 18688, 4928, 18720, 18752, 3296, 3296, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7968, 18784, 18816, 18848, 18880, 18912, 4928, 4928, 4928, 4928, 18944, 4928, 6848, 18976, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9920, 1344, 1344, 1344, 1344, 1344, 1344, 11296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 19008, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 19040, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15488 #endif /* TCL_UTF_MAX > 3 */ }; /* * The groupMap is indexed by combining the alternate page number with * the page offset and returns a group number that identifies a unique * set of character attributes. */ static const unsigned char groupMap[] = { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, 7, 7, 3, 3, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 5, 3, 6, 11, 12, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5, 7, 6, 7, 1, 2, 3, 4, 4, 4, 4, 14, 3, 11, 14, 15, 16, 7, 17, 14, 11, 14, 7, 18, 18, 11, 19, 3, 3, 11, 18, 15, 20, 18, 18, 18, 3, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 7, 10, 10, 10, 10, 10, 10, 10, 21, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 7, 13, 13, 13, 13, 13, 13, 13, 22, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 25, 26, 23, 24, 23, 24, 23, 24, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 27, 23, 24, 23, 24, 23, 24, 28, 29, 30, 23, 24, 23, 24, 31, 23, 24, 32, 32, 23, 24, 21, 33, 34, 35, 23, 24, 32, 36, 37, 38, 39, 23, 24, 40, 21, 38, 41, 42, 43, 23, 24, 23, 24, 23, 24, 44, 23, 24, 44, 21, 21, 23, 24, 44, 23, 24, 45, 45, 23, 24, 23, 24, 46, 23, 24, 21, 15, 23, 24, 21, 47, 15, 15, 15, 15, 48, 49, 50, 48, 49, 50, 48, 49, 50, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 51, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 48, 49, 50, 23, 24, 52, 53, 23, 24, 23, 24, 23, 24, 23, 24, 54, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 21, 55, 23, 24, 56, 57, 58, 58, 23, 24, 59, 60, 61, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 62, 63, 64, 65, 66, 21, 67, 67, 21, 68, 21, 69, 70, 21, 21, 21, 67, 71, 21, 72, 21, 73, 74, 21, 75, 76, 74, 77, 78, 21, 21, 76, 21, 79, 80, 21, 21, 81, 21, 21, 21, 21, 21, 21, 21, 82, 21, 21, 83, 21, 84, 83, 21, 21, 21, 85, 83, 86, 87, 87, 88, 21, 21, 21, 21, 21, 89, 21, 15, 21, 21, 21, 21, 21, 21, 21, 21, 90, 91, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 11, 11, 11, 11, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 92, 92, 92, 92, 92, 11, 11, 11, 11, 11, 11, 11, 92, 11, 92, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 94, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 23, 24, 23, 24, 92, 11, 23, 24, 0, 0, 92, 42, 42, 42, 3, 95, 0, 0, 0, 0, 11, 11, 96, 3, 97, 97, 97, 0, 98, 0, 99, 99, 21, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 100, 101, 101, 101, 21, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 102, 13, 13, 13, 13, 13, 13, 13, 13, 13, 103, 104, 104, 105, 106, 107, 108, 108, 108, 109, 110, 111, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 112, 113, 114, 115, 116, 117, 7, 23, 24, 118, 23, 24, 21, 54, 54, 54, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 113, 113, 113, 113, 113, 113, 113, 113, 113, 113, 113, 113, 113, 113, 113, 113, 23, 24, 14, 93, 93, 93, 93, 93, 120, 120, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 121, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 122, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 0, 0, 92, 3, 3, 3, 3, 3, 3, 21, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 21, 21, 3, 8, 0, 0, 14, 14, 4, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 8, 93, 3, 93, 93, 3, 93, 93, 3, 93, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 7, 7, 7, 3, 3, 4, 3, 3, 14, 14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 17, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 15, 93, 93, 93, 93, 93, 93, 93, 17, 14, 93, 93, 93, 93, 93, 93, 92, 92, 93, 93, 14, 93, 93, 93, 93, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 14, 14, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 17, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 92, 92, 14, 3, 3, 3, 92, 0, 0, 93, 4, 4, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 92, 93, 93, 93, 93, 93, 93, 93, 93, 93, 92, 93, 93, 93, 92, 93, 93, 93, 93, 93, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 0, 0, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 15, 15, 15, 15, 15, 15, 0, 17, 17, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 17, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 125, 125, 93, 125, 125, 15, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 93, 15, 125, 125, 125, 93, 93, 93, 93, 0, 0, 125, 125, 0, 0, 125, 125, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 125, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4, 15, 3, 93, 0, 0, 93, 93, 125, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 0, 15, 15, 0, 0, 93, 0, 125, 125, 125, 93, 93, 0, 0, 0, 0, 93, 93, 0, 0, 93, 93, 93, 0, 0, 0, 93, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 93, 93, 15, 15, 15, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 0, 93, 93, 125, 0, 125, 125, 93, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 0, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 93, 15, 125, 93, 125, 93, 93, 93, 93, 0, 0, 125, 125, 0, 0, 125, 125, 93, 0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0, 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 125, 125, 93, 125, 125, 0, 0, 0, 125, 125, 125, 0, 125, 125, 125, 93, 0, 0, 15, 0, 0, 0, 0, 0, 0, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, 14, 4, 14, 0, 0, 0, 0, 0, 93, 125, 125, 125, 93, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 15, 93, 93, 93, 125, 125, 125, 125, 0, 93, 93, 93, 0, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 93, 93, 0, 15, 15, 15, 0, 0, 15, 0, 0, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 3, 18, 18, 18, 18, 18, 18, 18, 14, 15, 93, 125, 125, 3, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 93, 15, 125, 93, 125, 125, 125, 125, 125, 0, 93, 125, 125, 0, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 15, 15, 0, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 15, 125, 125, 125, 93, 93, 93, 93, 0, 125, 125, 125, 0, 125, 125, 125, 93, 15, 14, 0, 0, 0, 0, 15, 15, 15, 125, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 15, 15, 15, 15, 15, 15, 0, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 93, 0, 0, 0, 0, 125, 125, 125, 93, 93, 93, 0, 93, 0, 125, 125, 125, 125, 125, 125, 125, 125, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 125, 125, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 93, 93, 93, 93, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 0, 0, 15, 15, 15, 15, 15, 0, 92, 0, 93, 93, 93, 93, 93, 93, 93, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 15, 15, 15, 15, 15, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, 14, 93, 93, 14, 14, 14, 14, 14, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 93, 14, 93, 14, 93, 5, 6, 5, 6, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 3, 93, 93, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 14, 14, 14, 14, 14, 14, 14, 14, 93, 14, 14, 14, 14, 14, 14, 0, 14, 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 125, 93, 93, 125, 125, 93, 93, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 15, 15, 15, 15, 93, 93, 93, 15, 125, 125, 125, 15, 15, 125, 125, 125, 125, 125, 125, 125, 15, 15, 15, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 125, 93, 93, 125, 125, 125, 125, 125, 125, 93, 15, 125, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 125, 125, 125, 93, 14, 14, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 0, 126, 0, 0, 0, 0, 0, 126, 0, 0, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 3, 92, 127, 127, 127, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 3, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 105, 105, 105, 105, 105, 105, 0, 0, 111, 111, 111, 111, 111, 111, 0, 0, 8, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 2, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 5, 6, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 129, 129, 129, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 125, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93, 125, 125, 125, 125, 125, 125, 125, 125, 93, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 92, 3, 3, 3, 4, 15, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 93, 93, 93, 17, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 93, 93, 93, 125, 125, 125, 125, 93, 93, 125, 125, 125, 0, 0, 0, 0, 125, 125, 93, 125, 125, 125, 125, 125, 125, 93, 93, 93, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 125, 125, 93, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 125, 93, 93, 93, 93, 93, 93, 93, 0, 93, 125, 93, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 125, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 92, 3, 3, 3, 3, 3, 3, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 120, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 93, 93, 93, 93, 125, 93, 125, 125, 125, 125, 125, 93, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 3, 3, 0, 93, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 93, 93, 93, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 93, 125, 125, 125, 93, 125, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 3, 3, 130, 131, 132, 133, 133, 134, 135, 136, 137, 0, 0, 0, 0, 0, 0, 0, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 0, 0, 138, 138, 138, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 3, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15, 15, 93, 15, 15, 125, 93, 93, 15, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 139, 21, 21, 21, 140, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 141, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 92, 92, 92, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 142, 21, 21, 143, 21, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 0, 0, 145, 145, 145, 145, 145, 145, 0, 0, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 0, 0, 145, 145, 145, 145, 145, 145, 0, 0, 21, 144, 21, 144, 21, 144, 21, 144, 0, 145, 0, 145, 0, 145, 0, 145, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, 145, 146, 146, 147, 147, 147, 147, 148, 148, 149, 149, 150, 150, 151, 151, 0, 0, 144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152, 144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152, 144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152, 144, 144, 21, 153, 21, 0, 21, 21, 145, 145, 154, 154, 155, 11, 156, 11, 11, 11, 21, 153, 21, 0, 21, 21, 157, 157, 157, 157, 155, 11, 11, 11, 144, 144, 21, 21, 0, 0, 21, 21, 145, 145, 158, 158, 0, 11, 11, 11, 144, 144, 21, 21, 21, 114, 21, 21, 145, 145, 159, 159, 118, 11, 11, 11, 0, 0, 21, 153, 21, 0, 21, 21, 160, 160, 161, 161, 155, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17, 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3, 3, 3, 3, 162, 163, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17, 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 92, 0, 0, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 92, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 120, 120, 120, 120, 93, 120, 120, 120, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 108, 14, 14, 14, 14, 108, 14, 14, 21, 108, 108, 108, 21, 21, 108, 108, 108, 21, 14, 108, 14, 14, 7, 108, 108, 108, 108, 108, 14, 14, 14, 14, 14, 14, 108, 14, 164, 14, 108, 14, 165, 166, 108, 108, 14, 21, 108, 108, 167, 108, 21, 15, 15, 15, 15, 21, 14, 14, 21, 21, 108, 108, 7, 7, 7, 7, 7, 108, 21, 21, 21, 21, 14, 7, 14, 14, 168, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 129, 129, 129, 23, 24, 129, 129, 129, 129, 18, 14, 14, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 23, 24, 173, 174, 175, 176, 177, 23, 24, 23, 24, 23, 24, 178, 179, 180, 181, 21, 23, 24, 21, 23, 24, 21, 21, 21, 21, 21, 92, 92, 182, 182, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, 23, 24, 23, 24, 93, 93, 93, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, 3, 3, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 0, 183, 0, 0, 0, 0, 0, 183, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, 6, 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 8, 3, 3, 3, 3, 8, 3, 5, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 14, 3, 3, 3, 5, 6, 5, 6, 5, 6, 5, 6, 8, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 2, 3, 3, 3, 14, 92, 15, 129, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 129, 129, 129, 129, 129, 129, 129, 129, 129, 93, 93, 93, 93, 125, 125, 8, 92, 92, 92, 92, 92, 14, 14, 129, 129, 129, 92, 15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 11, 11, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 92, 92, 92, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 15, 93, 120, 120, 120, 3, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92, 92, 93, 93, 15, 15, 15, 15, 15, 15, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 93, 93, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 92, 92, 92, 92, 92, 92, 92, 92, 92, 11, 11, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92, 21, 21, 21, 21, 21, 21, 21, 21, 23, 24, 23, 24, 184, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92, 11, 11, 23, 24, 185, 21, 15, 23, 24, 23, 24, 186, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 187, 188, 189, 190, 187, 21, 191, 192, 193, 194, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 195, 196, 197, 23, 24, 23, 24, 0, 0, 0, 0, 0, 23, 24, 0, 21, 0, 21, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 23, 24, 15, 92, 92, 21, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 15, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 125, 14, 14, 14, 14, 93, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14, 14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, 3, 3, 3, 15, 3, 15, 15, 93, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 125, 125, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 93, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 125, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 93, 93, 93, 15, 15, 93, 93, 15, 15, 15, 15, 15, 93, 93, 15, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 92, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 125, 125, 3, 3, 15, 92, 92, 125, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 198, 21, 21, 21, 21, 21, 21, 21, 11, 92, 92, 92, 92, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 11, 11, 0, 0, 0, 0, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 15, 15, 15, 125, 125, 93, 125, 125, 93, 125, 125, 3, 125, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 6, 5, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 4, 14, 14, 14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 5, 6, 3, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3, 0, 3, 3, 3, 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4, 3, 3, 0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17, 0, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5, 7, 6, 7, 5, 6, 3, 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, 0, 0 #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 ,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 129, 15, 15, 15, 15, 15, 15, 15, 15, 129, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 129, 129, 129, 129, 129, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 0, 0, 0, 0, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 0, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 0, 204, 204, 204, 204, 204, 204, 204, 0, 204, 204, 0, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 0, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 0, 205, 205, 205, 205, 205, 205, 205, 0, 205, 205, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 18, 18, 15, 15, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 93, 93, 93, 0, 93, 93, 0, 0, 0, 0, 0, 93, 93, 93, 93, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 93, 0, 0, 0, 0, 93, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 0, 0, 0, 0, 18, 18, 18, 18, 18, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 93, 93, 8, 0, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 18, 18, 18, 18, 18, 18, 18, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 18, 18, 18, 18, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 125, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 93, 15, 15, 93, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 125, 125, 93, 93, 3, 3, 17, 3, 3, 3, 3, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93, 93, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 125, 125, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 15, 15, 15, 15, 3, 3, 3, 3, 93, 93, 93, 93, 3, 125, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 3, 15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 125, 125, 93, 125, 93, 93, 3, 3, 3, 3, 3, 3, 93, 15, 15, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 93, 93, 15, 125, 125, 93, 125, 125, 125, 125, 0, 0, 125, 125, 0, 0, 125, 125, 125, 0, 0, 15, 0, 0, 0, 0, 0, 0, 125, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 125, 125, 0, 0, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93, 93, 125, 93, 15, 15, 15, 15, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 3, 93, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 125, 93, 125, 125, 125, 125, 93, 93, 125, 93, 93, 15, 15, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 0, 0, 125, 125, 125, 125, 93, 93, 125, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 93, 93, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 93, 125, 93, 93, 3, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 125, 125, 93, 93, 93, 93, 93, 93, 125, 93, 15, 3, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 125, 125, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 3, 3, 3, 14, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 3, 0, 0, 0, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 0, 125, 125, 0, 0, 93, 93, 125, 93, 15, 125, 15, 125, 93, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 0, 0, 93, 93, 125, 125, 125, 125, 93, 15, 3, 15, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 125, 15, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 93, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 3, 3, 3, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 125, 93, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 125, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 0, 0, 0, 93, 0, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 15, 93, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 125, 125, 0, 93, 93, 0, 125, 125, 93, 125, 93, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 125, 125, 3, 3, 0, 0, 0, 0, 0, 0, 0, 93, 93, 15, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 93, 93, 93, 0, 0, 0, 125, 125, 93, 125, 93, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 4, 4, 4, 4, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 93, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 93, 93, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 14, 14, 14, 14, 92, 92, 92, 92, 3, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 18, 18, 18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 3, 3, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 93, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 92, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 0, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 14, 93, 93, 3, 17, 17, 17, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 125, 125, 93, 93, 93, 14, 14, 14, 125, 125, 125, 125, 125, 125, 17, 17, 17, 17, 17, 17, 17, 17, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93, 93, 93, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 0, 108, 108, 0, 0, 108, 0, 0, 108, 108, 0, 0, 108, 108, 108, 108, 0, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 0, 21, 0, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 0, 108, 108, 108, 108, 0, 0, 108, 108, 108, 108, 108, 108, 108, 108, 0, 108, 108, 108, 108, 108, 108, 108, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 0, 108, 108, 108, 108, 0, 108, 108, 108, 108, 108, 0, 108, 0, 0, 0, 108, 108, 108, 108, 108, 108, 108, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 0, 0, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93, 14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 15, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 0, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 92, 92, 92, 92, 92, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 15, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 93, 93, 93, 93, 93, 93, 93, 92, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 4, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, 0, 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11, 11, 11, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15 #endif /* TCL_UTF_MAX > 3 */ }; /* * Each group represents a unique set of character attributes. The attributes * are encoded into a 32-bit value as follows: * * Bits 0-4 Character category: see the constants listed below. * * Bits 5-7 Case delta type: 000 = identity * 010 = add delta for lower * 011 = add delta for lower, add 1 for title * 100 = subtract delta for title/upper * 101 = sub delta for upper, sub 1 for title * 110 = sub delta for upper, add delta for lower * 111 = subtract delta for upper * * Bits 8-31 Case delta: delta for case conversions. This should be the * highest field so we can easily sign extend. */ static const int groups[] = { 0, 15, 12, 25, 27, 21, 22, 26, 20, 9, 8257, 28, 19, 8322, 29, 5, 23, 16, 11, -190078, 24, 2, -30846, 321, 386, -50879, 59522, -30911, 76930, -49790, 53825, 52801, 52545, 20289, 51777, 52033, 53057, -24702, 54081, 53569, -41598, 54593, -33150, 54849, 55873, 55617, 56129, -14206, 609, 451, 674, 20354, -24767, -14271, -33215, 2763585, -41663, 2762817, -2768510, -49855, 17729, 18241, -2760318, -2759550, -2760062, 53890, 52866, 52610, 51842, 52098, -10833534, -10832510, 53122, -10823550, -10830718, 53634, 54146, -2750078, -10829950, -2751614, 54658, 54914, -2745982, 55938, -10830462, -10824062, 17794, 55682, 18306, 56194, -10818686, -10817918, 4, 6, -21370, 29761, 9793, 9537, 16449, 16193, 9858, 9602, 8066, 16514, 16258, 2113, 16002, 14722, 1, 12162, 13954, 2178, 22146, 20610, -1662, 29826, -15295, 24706, -1727, 20545, 7, 3905, 3970, 12353, 12418, 8, 1859649, -769822, 9949249, 10, 1601154, 1600898, 1598594, 1598082, 1598338, 1596546, 1582466, -9027966, -769983, -9044862, -976254, -9058174, 15234, -1949375, -1918, -1983, -18814, -21886, -25470, -32638, -28542, -32126, -1981, -2174, -18879, -2237, 1844610, -21951, -25535, -28607, -32703, -32191, 13, 14, -1924287, -2145983, -2115007, 7233, 7298, 4170, 4234, 6749, 6813, -2750143, -976319, -2746047, 2763650, 2762882, -2759615, -2751679, -2760383, -2760127, -2768575, 1859714, -9044927, -10823615, -12158, -10830783, -10833599, -10832575, -10830015, -10817983, -10824127, -10818751, 237633, -12223, -10830527, -9058239, 237698, 9949314, 18, 17, 10305, 10370, 10049, 10114, 8769, 8834 }; #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 # define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0) #else # define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0) #endif /* * The following constants are used to determine the category of a * Unicode character. */ enum { UNASSIGNED, UPPERCASE_LETTER, LOWERCASE_LETTER, TITLECASE_LETTER, MODIFIER_LETTER, OTHER_LETTER, NON_SPACING_MARK, ENCLOSING_MARK, COMBINING_SPACING_MARK, DECIMAL_DIGIT_NUMBER, LETTER_NUMBER, OTHER_NUMBER, SPACE_SEPARATOR, LINE_SEPARATOR, PARAGRAPH_SEPARATOR, CONTROL, FORMAT, PRIVATE_USE, SURROGATE, CONNECTOR_PUNCTUATION, DASH_PUNCTUATION, OPEN_PUNCTUATION, CLOSE_PUNCTUATION, INITIAL_QUOTE_PUNCTUATION, FINAL_QUOTE_PUNCTUATION, OTHER_PUNCTUATION, MATH_SYMBOL, CURRENCY_SYMBOL, MODIFIER_SYMBOL, OTHER_SYMBOL }; /* * The following macros extract the fields of the character info. The * GetDelta() macro is complicated because we can't rely on the C compiler * to do sign extension on right shifts. */ #define GetCaseType(info) (((info) & 0xE0) >> 5) #define GetCategory(ch) (GetUniCharInfo(ch) & 0x1F) #define GetDelta(info) ((info) >> 8) /* * This macro extracts the information about a character from the * Unicode character tables. */ #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 # define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) #else # define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) #endif tcl8.6.14/generic/tclUtf.c0000644000175000017500000017647214554263074014711 0ustar sergeisergei/* * tclUtf.c -- * * Routines for manipulating UTF-8 strings. * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Include the static character classification tables and macros. */ #include "tclUniData.c" /* * The following macros are used for fast character category tests. The x_BITS * values are shifted right by the category value to determine whether the * given category is included in the set. */ #define ALPHA_BITS ((1 << UPPERCASE_LETTER) | (1 << LOWERCASE_LETTER) \ | (1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) | (1< 3 4,4,4,4,4, #else 1,1,1,1,1, #endif 1,1,1,1,1,1,1,1,1,1,1 }; static const unsigned char complete[256] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* Tcl_UtfCharComplete() might point to 2nd byte of valid 4-byte sequence */ 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, /* End of "continuation byte section" */ 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, #if TCL_UTF_MAX > 3 4,4,4,4,4, #else /* Tcl_UtfToUniChar() accesses src[1] and src[2] to check whether * the UTF-8 sequence is valid, so we cannot use 1 here. */ 3,3,3,3,3, #endif 1,1,1,1,1,1,1,1,1,1,1 }; /* * Functions used only in this module. */ static int UtfCount(int ch); static int Invalid(const char *src); static int UCS4ToUpper(int ch); static int UCS4ToTitle(int ch); /* *--------------------------------------------------------------------------- * * UtfCount -- * * Find the number of bytes in the Utf character "ch". * * Results: * The return values is the number of bytes in the Utf character "ch". * * Side effects: * None. * *--------------------------------------------------------------------------- */ static inline int UtfCount( int ch) /* The Unicode character whose size is returned. */ { if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) { return 1; } if (ch <= 0x7FF) { return 2; } #if TCL_UTF_MAX > 3 if (((unsigned)(ch - 0x10000) <= 0xFFFFF)) { return 4; } #endif return 3; } /* *--------------------------------------------------------------------------- * * Invalid -- * * Given a pointer to a two-byte prefix of a well-formed UTF-8 byte * sequence (a lead byte followed by a trail byte) this routine * examines those two bytes to determine whether the sequence is * invalid in UTF-8. This might be because it is an overlong * encoding, or because it encodes something out of the proper range. * * Given a pointer to the bytes \xF8 or \xFC , this routine will * try to read beyond the end of the "bounds" table. Callers must * prevent this. * * Given a pointer to something else (an ASCII byte, a trail byte, * or another byte that can never begin a valid byte sequence such * as \xF5) this routine returns false. That makes the routine poorly * named, as it does not detect and report all invalid sequences. * * Callers have to take care that this routine does something useful * for their needs. * * Results: * A boolean. *--------------------------------------------------------------------------- */ static const unsigned char bounds[28] = { 0x80, 0x80, /* \xC0 accepts \x80 only */ 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, /* (\xC4 - \xDC) -- all sequences valid */ 0xA0, 0xBF, /* \xE0\x80 through \xE0\x9F are invalid prefixes */ 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, /* (\xE4 - \xEC) -- all valid */ #if TCL_UTF_MAX > 3 0x90, 0xBF, /* \xF0\x80 through \xF0\x8F are invalid prefixes */ 0x80, 0x8F /* \xF4\x90 and higher are invalid prefixes */ #else 0xC0, 0xBF, /* Not used, but reject all again for safety. */ 0xC0, 0xBF /* Not used, but reject all again for safety. */ #endif }; static int Invalid( const char *src) /* Points to lead byte of a UTF-8 byte sequence */ { unsigned char byte = UCHAR(*src); int index; if ((byte & 0xC3) == 0xC0) { /* Only lead bytes 0xC0, 0xE0, 0xF0, 0xF4 need examination */ index = (byte - 0xC0) >> 1; if (UCHAR(src[1]) < bounds[index] || UCHAR(src[1]) > bounds[index+1]) { /* Out of bounds - report invalid. */ return 1; } } return 0; } /* *--------------------------------------------------------------------------- * * Tcl_UniCharToUtf -- * * Stores the given Tcl_UniChar as a sequence of UTF-8 bytes in the * provided buffer. Equivalent to Plan 9 runetochar(). * * Results: * Returns the number of bytes stored into the buffer. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tcl_UniCharToUtf( int ch, /* The Tcl_UniChar to be stored in the * buffer. */ char *buf) /* Buffer in which the UTF-8 representation of * the Tcl_UniChar is stored. Buffer must be * large enough to hold the UTF-8 character * (at most TCL_UTF_MAX bytes). */ { if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) { buf[0] = (char) ch; return 1; } if (ch >= 0) { if (ch <= 0x7FF) { buf[1] = (char) (0x80 | (0x3F & ch)); buf[0] = (char) (0xC0 | (ch >> 6)); return 2; } if (ch <= 0xFFFF) { #if TCL_UTF_MAX > 3 if ((ch & 0xF800) == 0xD800) { if (ch & 0x0400) { /* Low surrogate */ if ( (0x80 == (0xC0 & buf[0])) && (0 == (0xCF & buf[1]))) { /* Previous Tcl_UniChar was a high surrogate, so combine */ buf[2] = (char) (0x80 | (0x3F & ch)); buf[1] |= (char) (0x80 | (0x0F & (ch >> 6))); return 3; } /* Previous Tcl_UniChar was not a high surrogate, so just output */ } else { /* High surrogate */ ch += 0x40; /* Fill buffer with specific 3-byte (invalid) byte combination, so following low surrogate can recognize it and combine */ buf[2] = (char) ((ch << 4) & 0x30); buf[1] = (char) (0x80 | (0x3F & (ch >> 2))); buf[0] = (char) (0xF0 | (0x07 & (ch >> 8))); return 1; } } #endif goto three; } #if TCL_UTF_MAX > 3 if (ch <= 0x10FFFF) { buf[3] = (char) (0x80 | (0x3F & ch)); buf[2] = (char) (0x80 | (0x3F & (ch >> 6))); buf[1] = (char) (0x80 | (0x3F & (ch >> 12))); buf[0] = (char) (0xF0 | (ch >> 18)); return 4; } } else if (ch == -1) { if ( (0x80 == (0xC0 & buf[0])) && (0 == (0xCF & buf[1])) && (0xF0 == (0xF8 & buf[-1]))) { ch = 0xD7C0 + ((0x07 & buf[-1]) << 8) + ((0x3F & buf[0]) << 2) + ((0x30 & buf[1]) >> 4); buf[1] = (char) (0x80 | (0x3F & ch)); buf[0] = (char) (0x80 | (0x3F & (ch >> 6))); buf[-1] = (char) (0xE0 | (ch >> 12)); return 2; } #endif } ch = 0xFFFD; three: buf[2] = (char) (0x80 | (0x3F & ch)); buf[1] = (char) (0x80 | (0x3F & (ch >> 6))); buf[0] = (char) (0xE0 | (ch >> 12)); return 3; } /* *--------------------------------------------------------------------------- * * Tcl_UniCharToUtfDString -- * * Convert the given Unicode string to UTF-8. * * Results: * The return value is a pointer to the UTF-8 representation of the * Unicode string. Storage for the return value is appended to the end of * dsPtr. * * Side effects: * None. * *--------------------------------------------------------------------------- */ char * Tcl_UniCharToUtfDString( const Tcl_UniChar *uniStr, /* Unicode string to convert to UTF-8. */ int uniLength, /* Length of Unicode string in Tcl_UniChars * (must be >= 0). */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { const Tcl_UniChar *w, *wEnd; char *p, *string; int oldLength; /* * UTF-8 string length in bytes will be <= Unicode string length * * TCL_UTF_MAX. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * TCL_UTF_MAX); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; wEnd = uniStr + uniLength; for (w = uniStr; w < wEnd; ) { p += Tcl_UniCharToUtf(*w, p); w++; } Tcl_DStringSetLength(dsPtr, oldLength + (p - string)); return string; } /* *--------------------------------------------------------------------------- * * Tcl_UtfToUniChar -- * * Extract the Tcl_UniChar represented by the UTF-8 string. Bad UTF-8 * sequences are converted to valid Tcl_UniChars and processing * continues. Equivalent to Plan 9 chartorune(). * * The caller must ensure that the source buffer is long enough that this * routine does not run off the end and dereference non-existent memory * looking for trail bytes. If the source buffer is known to be '\0' * terminated, this cannot happen. Otherwise, the caller should call * Tcl_UtfCharComplete() before calling this routine to ensure that * enough bytes remain in the string. * * If TCL_UTF_MAX <= 4, special handling of Surrogate pairs is done: * For any UTF-8 string containing a character outside of the BMP, the * first call to this function will fill *chPtr with the high surrogate * and generate a return value of 1. Calling Tcl_UtfToUniChar again * will produce the low surrogate and a return value of 3. Because *chPtr * is used to remember whether the high surrogate is already produced, it * is recommended to initialize the variable it points to as 0 before * the first call to Tcl_UtfToUniChar is done. * * Results: * *chPtr is filled with the Tcl_UniChar, and the return value is the * number of bytes from the UTF-8 string that were consumed. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tcl_UtfToUniChar( const char *src, /* The UTF-8 string. */ Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by * the UTF-8 string. */ { Tcl_UniChar byte; /* * Unroll 1 to 3 (or 4) byte UTF-8 sequences. */ byte = UCHAR(*src); if (byte < 0xC0) { /* * Handles properly formed UTF-8 characters between 0x01 and 0x7F. * Also treats \0 and naked trail bytes 0x80 to 0xBF as valid * characters representing themselves. */ #if TCL_UTF_MAX <= 4 /* If *chPtr contains a high surrogate (produced by a previous * Tcl_UtfToUniChar() call) and the next 3 bytes are UTF-8 continuation * bytes, then we must produce a follow-up low surrogate. We only * do that if the high surrogate matches the bits we encounter. */ if (((byte & 0xC0) == 0x80) && ((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && (((((byte - 0x10) << 2) & 0xFC) | 0xD800) == (*chPtr & 0xFCFC)) && ((src[1] & 0xF0) == (((*chPtr << 4) & 0x30) | 0x80))) { *chPtr = ((src[1] & 0x0F) << 6) + (src[2] & 0x3F) + 0xDC00; return 3; } #endif *chPtr = byte; return 1; } else if (byte < 0xE0) { if ((byte != 0xC1) && ((src[1] & 0xC0) == 0x80)) { /* * Two-byte-character lead-byte followed by a trail-byte. */ *chPtr = (((byte & 0x1F) << 6) | (src[1] & 0x3F)); if ((unsigned)(*chPtr - 1) >= (UNICODE_SELF - 1)) { return 2; } } /* * A two-byte-character lead-byte not followed by trail-byte * represents itself. */ } else if (byte < 0xF0) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) { /* * Three-byte-character lead byte followed by two trail bytes. */ *chPtr = (((byte & 0x0F) << 12) | ((src[1] & 0x3F) << 6) | (src[2] & 0x3F)); if (*chPtr > 0x7FF) { return 3; } } /* * A three-byte-character lead-byte not followed by two trail-bytes * represents itself. */ } else if (byte < 0xF5) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by at least two trail bytes. * We don't test the validity of 3th trail byte, see [ed29806ba] */ #if TCL_UTF_MAX <= 4 Tcl_UniChar high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2) | ((src[2] & 0x3F) >> 4)) - 0x40; if (high < 0x400) { /* produce high surrogate, advance source pointer */ *chPtr = 0xD800 + high; return 1; } /* out of range, < 0x10000 or > 0x10FFFF */ #else if ((src[3] & 0xC0) == 0x80) { *chPtr = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12) | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)); if ((unsigned)(*chPtr - 0x10000) <= 0xFFFFF) { return 4; } } #endif } /* * A four-byte-character lead-byte not followed by three trail-bytes * represents itself. */ } *chPtr = byte; return 1; } /* *--------------------------------------------------------------------------- * * Tcl_UtfToUniCharDString -- * * Convert the UTF-8 string to Unicode. * * Results: * The return value is a pointer to the Unicode representation of the * UTF-8 string. Storage for the return value is appended to the end of * dsPtr. The Unicode string is terminated with a Unicode NULL character. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_UniChar * Tcl_UtfToUniCharDString( const char *src, /* UTF-8 string to convert to Unicode. */ int length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized * DString. */ { Tcl_UniChar ch = 0, *w, *wString; const char *p; int oldLength; /* Pointer to the end of string. Never read endPtr[0] */ const char *endPtr = src + length; /* Pointer to last byte where optimization still can be used */ const char *optPtr = endPtr - TCL_UTF_MAX; if (length < 0) { length = strlen(src); } /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in * bytes. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + ((length + 1) * sizeof(Tcl_UniChar))); wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; p = src; endPtr = src + length; optPtr = endPtr - ((TCL_UTF_MAX > 3) ? 4 : 3) ; while (p <= optPtr) { p += TclUtfToUniChar(p, &ch); *w++ = ch; } while (p < endPtr) { if (Tcl_UtfCharComplete(p, endPtr-p)) { p += TclUtfToUniChar(p, &ch); *w++ = ch; } else { *w++ = UCHAR(*p++); } } *w = '\0'; Tcl_DStringSetLength(dsPtr, oldLength + ((char *) w - (char *) wString)); return wString; } /* *--------------------------------------------------------------------------- * * Tcl_UtfCharComplete -- * * Determine if the UTF-8 string of the given length is long enough to be * decoded by Tcl_UtfToUniChar(). This does not ensure that the UTF-8 * string is properly formed. Equivalent to Plan 9 fullrune(). * * Results: * The return value is 0 if the string is not long enough, non-zero * otherwise. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tcl_UtfCharComplete( const char *src, /* String to check if first few bytes contain * a complete UTF-8 character. */ int length) /* Length of above string in bytes. */ { return length >= complete[UCHAR(*src)]; } /* *--------------------------------------------------------------------------- * * Tcl_NumUtfChars -- * * Returns the number of characters (not bytes) in the UTF-8 string, not * including the terminating NULL byte. This is equivalent to Plan 9 * utflen() and utfnlen(). * * Results: * As above. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tcl_NumUtfChars( const char *src, /* The UTF-8 string to measure. */ int length) /* The length of the string in bytes, or -1 * for strlen(string). */ { Tcl_UniChar ch = 0; int i = 0; if (length < 0) { /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */ while ((*src != '\0') && (i < INT_MAX)) { src += TclUtfToUniChar(src, &ch); i++; } } else { /* Will return value between 0 and length. No overflow checks. */ /* Pointer to the end of string. Never read endPtr[0] */ const char *endPtr = src + length; /* Pointer to last byte where optimization still can be used */ const char *optPtr = endPtr - ((TCL_UTF_MAX > 3) ? 4 : 3); /* * Optimize away the call in this loop. Justified because... * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr) * By initialization above (endPtr - optPtr) = TCL_UTF_MAX * So (endPtr - src) >= TCL_UTF_MAX, and passing that to * Tcl_UtfCharComplete we know will cause return of 1. */ while (src <= optPtr /* && Tcl_UtfCharComplete(src, endPtr - src) */ ) { src += TclUtfToUniChar(src, &ch); i++; } /* Loop over the remaining string where call must happen */ while (src < endPtr) { if (Tcl_UtfCharComplete(src, endPtr - src)) { src += TclUtfToUniChar(src, &ch); } else { /* * src points to incomplete UTF-8 sequence * Treat first byte as character and count it */ src++; } i++; } } return i; } /* *--------------------------------------------------------------------------- * * Tcl_UtfFindFirst -- * * Returns a pointer to the first occurrence of the given Unicode character * in the NULL-terminated UTF-8 string. The NULL terminator is considered * part of the UTF-8 string. Equivalent to Plan 9 utfrune(). * * Results: * As above. If the Unicode character does not exist in the given string, * the return value is NULL. * * Side effects: * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfFindFirst( const char *src, /* The UTF-8 string to be searched. */ int ch) /* The Unicode character to search for. */ { while (1) { int find, len = TclUtfToUCS4(src, &find); if (find == ch) { return src; } if (*src == '\0') { return NULL; } src += len; } } /* *--------------------------------------------------------------------------- * * Tcl_UtfFindLast -- * * Returns a pointer to the last occurrence of the given Unicode character * in the NULL-terminated UTF-8 string. The NULL terminator is considered * part of the UTF-8 string. Equivalent to Plan 9 utfrrune(). * * Results: * As above. If the Unicode character does not exist in the given string, the * return value is NULL. * * Side effects: * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfFindLast( const char *src, /* The UTF-8 string to be searched. */ int ch) /* The Unicode character to search for. */ { const char *last = NULL; while (1) { int find, len = TclUtfToUCS4(src, &find); if (find == ch) { last = src; } if (*src == '\0') { break; } src += len; } return last; } /* *--------------------------------------------------------------------------- * * Tcl_UtfNext -- * * Given a pointer to some location in a UTF-8 string, Tcl_UtfNext * returns a pointer to the next UTF-8 character in the string. * The caller must not ask for the next character after the last * character in the string if the string is not terminated by a null * character. * * Results: * The return value is the pointer to the next character in the UTF-8 * string. * * Side effects: * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { int left; const char *next; #if TCL_UTF_MAX > 3 if (((*src) & 0xC0) == 0x80) { /* Continuation byte, so we start 'inside' a (possible valid) UTF-8 * sequence. Since we are not allowed to access src[-1], we cannot * check if the sequence is actually valid, the best we can do is * just assume it is valid and locate the end. */ if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) { ++src; } return src; } #endif left = totalBytes[UCHAR(*src)]; next = src + 1; while (--left) { if ((*next & 0xC0) != 0x80) { /* * src points to non-trail byte; We ran out of trail bytes * before the needs of the lead byte were satisfied. * Let the (malformed) lead byte alone be a character */ return src + 1; } next++; } /* * Call Invalid() here only if required conditions are met: * src[0] is known a lead byte. * src[1] is known a trail byte. * Especially important to prevent calls when src[0] == '\xF8' or '\xFC' * See tests utf-6.37 through utf-6.43 through valgrind or similar tool. */ if ((next == src + 1) || Invalid(src)) { return src + 1; } return next; } /* *--------------------------------------------------------------------------- * * Tcl_UtfPrev -- * * Given a pointer to some current location in a UTF-8 string, move * backwards one character. This works correctly when the pointer is in * the middle of a UTF-8 character. * * Results: * The return value is a pointer to the previous character in the UTF-8 * string. If the current location was already at the beginning of the * string, the return value will also be a pointer to the beginning of * the string. * * Side effects: * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfPrev( const char *src, /* A location in a UTF-8 string. */ const char *start) /* Pointer to the beginning of the string */ { int trailBytesSeen = 0; /* How many trail bytes have been verified? */ const char *fallback = src - 1; /* If we cannot find a lead byte that might * start a prefix of a valid UTF byte sequence, * we will fallback to a one-byte back step */ const char *look = fallback; /* Start search at the fallback position */ /* Quick boundary case exit. */ if (fallback <= start) { return start; } do { unsigned char byte = UCHAR(look[0]); if (byte < 0x80) { /* * Single byte character. Either this is a correct previous * character, or it is followed by at least one trail byte * which indicates a malformed sequence. In either case the * correct result is to return the fallback. */ return fallback; } if (byte >= 0xC0) { /* Non-trail byte; May be multibyte lead. */ if ((trailBytesSeen == 0) /* * We've seen no trailing context to use to check * anything. From what we know, this non-trail byte * is a prefix of a previous character, and accepting * it (the fallback) is correct. */ || (trailBytesSeen >= totalBytes[byte])) { /* * That is, (1 + trailBytesSeen > needed). * We've examined more bytes than needed to complete * this lead byte. No matter about well-formedness or * validity, the sequence starting with this lead byte * will never include the fallback location, so we must * return the fallback location. See test utf-7.17 */ return fallback; } /* * trailBytesSeen > 0, so we can examine look[1] safely. * Use that capability to screen out invalid sequences. */ if (Invalid(look)) { /* Reject */ return fallback; } return (const char *)look; } /* We saw a trail byte. */ trailBytesSeen++; if ((const char *)look == start) { /* * Do not read before the start of the string * * If we get here, we've examined bytes at every location * >= start and < src and all of them are trail bytes, * including (*start). We need to return our fallback * and exit this loop before we run past the start of the string. */ return fallback; } /* Continue the search backwards... */ look--; } while (trailBytesSeen < (TCL_UTF_MAX < 4 ? 3 : 4)); /* * We've seen 3 trail bytes, so we know there will not be a * properly formed byte sequence to find, and we can stop looking, * accepting the fallback. */ return fallback; } /* *--------------------------------------------------------------------------- * * Tcl_UniCharAtIndex -- * * Returns the Tcl_UniChar represented at the specified character * (not byte) position in the UTF-8 string. * * Results: * As above. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_UniChar Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; while (index-- >= 0) { src += TclUtfToUniChar(src, &ch); } return ch; } /* *--------------------------------------------------------------------------- * * Tcl_UtfAtIndex -- * * Returns a pointer to the specified character (not byte) position in * the UTF-8 string. * * Results: * As above. * * Side effects: * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int len = 0; while (index-- > 0) { len = TclUtfToUniChar(src, &ch); src += len; } #if TCL_UTF_MAX == 4 if ((ch >= 0xD800) && (len < 3)) { /* Index points at character following high Surrogate */ src += TclUtfToUniChar(src, &ch); } #endif return src; } /* *--------------------------------------------------------------------------- * * Tcl_UtfBackslash -- * * Figure out how to handle a backslash sequence. * * Results: * Stores the bytes represented by the backslash sequence in dst and * returns the number of bytes written to dst. At most TCL_UTF_MAX bytes * are written to dst; dst must have been large enough to accept those * bytes. If readPtr isn't NULL then it is filled in with a count of the * number of bytes in the backslash sequence. * * Side effects: * The maximum number of bytes it takes to represent a Unicode character * in UTF-8 is guaranteed to be less than the number of bytes used to * express the backslash sequence that represents that Unicode character. * If the target buffer into which the caller is going to store the bytes * that represent the Unicode character is at least as large as the * source buffer from which the backslashed sequence was extracted, no * buffer overruns should occur. * *--------------------------------------------------------------------------- */ int Tcl_UtfBackslash( const char *src, /* Points to the backslash character of a * backslash sequence. */ int *readPtr, /* Fill in with number of characters read from * src, unless NULL. */ char *dst) /* Filled with the bytes represented by the * backslash sequence. */ { #define LINE_LENGTH 128 int numRead; int result; result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst); if (numRead == LINE_LENGTH) { /* * We ate a whole line. Pay the price of a strlen() */ result = TclParseBackslash(src, strlen(src), &numRead, dst); } if (readPtr != NULL) { *readPtr = numRead; } return result; } /* *---------------------------------------------------------------------- * * Tcl_UtfToUpper -- * * Convert lowercase characters to uppercase characters in a UTF string * in place. The conversion may shrink the UTF string. * * Results: * Returns the number of bytes in the resulting string excluding the * trailing null. * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ int Tcl_UtfToUpper( char *str) /* String to convert in place. */ { int ch, upChar; char *src, *dst; int len; /* * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUCS4(src, &ch); upChar = UCS4ToUpper(ch); /* * To keep badly formed Utf strings from getting inflated by the * conversion (thereby causing a segfault), only copy the upper case * char to dst if its size is <= the original char. */ if (len < UtfCount(upChar)) { memmove(dst, src, len); dst += len; } else { dst += TclUCS4ToUtf(upChar, dst); } src += len; } *dst = '\0'; return (dst - str); } /* *---------------------------------------------------------------------- * * Tcl_UtfToLower -- * * Convert uppercase characters to lowercase characters in a UTF string * in place. The conversion may shrink the UTF string. * * Results: * Returns the number of bytes in the resulting string excluding the * trailing null. * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ int Tcl_UtfToLower( char *str) /* String to convert in place. */ { int ch, lowChar; char *src, *dst; int len; /* * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUCS4(src, &ch); lowChar = TclUCS4ToLower(ch); /* * To keep badly formed Utf strings from getting inflated by the * conversion (thereby causing a segfault), only copy the lower case * char to dst if its size is <= the original char. */ if (len < UtfCount(lowChar)) { memmove(dst, src, len); dst += len; } else { dst += TclUCS4ToUtf(lowChar, dst); } src += len; } *dst = '\0'; return (dst - str); } /* *---------------------------------------------------------------------- * * Tcl_UtfToTitle -- * * Changes the first character of a UTF string to title case or uppercase * and the rest of the string to lowercase. The conversion happens in * place and may shrink the UTF string. * * Results: * Returns the number of bytes in the resulting string excluding the * trailing null. * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ int Tcl_UtfToTitle( char *str) /* String to convert in place. */ { int ch, titleChar, lowChar; char *src, *dst; int len; /* * Capitalize the first character and then lowercase the rest of the * characters until we get to a null. */ src = dst = str; if (*src) { len = TclUtfToUCS4(src, &ch); titleChar = UCS4ToTitle(ch); if (len < UtfCount(titleChar)) { memmove(dst, src, len); dst += len; } else { dst += TclUCS4ToUtf(titleChar, dst); } src += len; } while (*src) { len = TclUtfToUCS4(src, &ch); lowChar = ch; /* Special exception for Georgian Asomtavruli chars, no titlecase. */ if ((unsigned)(lowChar - 0x1C90) >= 0x30) { lowChar = TclUCS4ToLower(lowChar); } if (len < UtfCount(lowChar)) { memmove(dst, src, len); dst += len; } else { dst += TclUCS4ToUtf(lowChar, dst); } src += len; } *dst = '\0'; return (dst - str); } /* *---------------------------------------------------------------------- * * TclpUtfNcmp2 -- * * Compare at most numBytes bytes of utf-8 strings cs and ct. Both cs and * ct are assumed to be at least numBytes bytes long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpUtfNcmp2( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ unsigned long numBytes) /* Number of *bytes* to compare. */ { return TclUtfNcmp2(cs, ct, numBytes); } int TclUtfNcmp2( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ size_t numBytes) /* Number of *bytes* to compare. */ { const char *cs = (const char *)csPtr; const char *ct = (const char *)ctPtr; /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes * fine in the strcmp manner. */ int result = 0; for ( ; numBytes != 0; numBytes--, cs++, ct++) { if (*cs != *ct) { result = UCHAR(*cs) - UCHAR(*ct); break; } } if (numBytes && ((UCHAR(*cs) == 0xC0) || (UCHAR(*ct) == 0xC0))) { unsigned char c1, c2; c1 = ((UCHAR(*cs) == 0xC0) && (UCHAR(cs[1]) == 0x80)) ? 0 : UCHAR(*cs); c2 = ((UCHAR(*ct) == 0xC0) && (UCHAR(ct[1]) == 0x80)) ? 0 : UCHAR(*ct); result = (c1 - c2); } return result; } /* *---------------------------------------------------------------------- * * Tcl_UtfNcmp -- * * Compare at most numChars UTF chars of string cs to string ct. Both cs * and ct are assumed to be at least numChars UTF chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ unsigned long numChars) /* Number of UTF chars to compare. */ { return TclUtfNcmp(cs, ct, numChars); } int TclUtfNcmp( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ size_t numChars) /* Number of UTF chars to compare. */ { const char *cs = (const char *)csPtr; const char *ct = (const char *)ctPtr; Tcl_UniChar ch1 = 0, ch2 = 0; /* * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001 * (the byte 0x01.) */ while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. This should be called * only when both strings are of at least n chars long (no need for \0 * check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX == 4 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } #endif return (ch1 - ch2); } } return 0; } /* *---------------------------------------------------------------------- * * Tcl_UtfNcasecmp -- * * Compare at most numChars UTF chars of string cs to string ct case * insensitive. Both cs and ct are assumed to be at least numChars UTF * chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ unsigned long numChars) /* Number of UTF chars to compare. */ { return TclUtfNcasecmp(cs, ct, numChars); } int TclUtfNcasecmp( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ size_t numChars) /* Number of UTF chars to compare. */ { const char *cs = (const char *)csPtr; const char *ct = (const char *)ctPtr; Tcl_UniChar ch1 = 0, ch2 = 0; while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. * This should be called only when both strings are of * at least n chars long (no need for \0 check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX == 4 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } #endif ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); if (ch1 != ch2) { return (ch1 - ch2); } } } return 0; } /* *---------------------------------------------------------------------- * * TclUtfCasecmp -- * * Compare UTF chars of string cs to string ct case insensitively. * Replacement for strcasecmp in Tcl core, in places where UTF-8 should * be handled. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclUtfCasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct) /* UTF string cs is compared to. */ { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX == 4 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } #endif ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); if (ch1 != ch2) { return ch1 - ch2; } } } return UCHAR(*cs) - UCHAR(*ct); } /* *---------------------------------------------------------------------- * * Tcl_UniCharToUpper -- * * Compute the uppercase equivalent of the given Unicode character. * * Results: * Returns the uppercase Unicode character. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int UCS4ToUpper( int ch) /* Unicode character to convert. */ { if (!UNICODE_OUT_OF_RANGE(ch)) { int info = GetUniCharInfo(ch); if (GetCaseType(info) & 0x04) { ch -= GetDelta(info); } } /* Clear away extension bits, if any */ return ch & 0x1FFFFF; } Tcl_UniChar Tcl_UniCharToUpper( int ch) /* Unicode character to convert. */ { return (Tcl_UniChar) UCS4ToUpper(ch); } /* *---------------------------------------------------------------------- * * Tcl_UniCharToLower -- * * Compute the lowercase equivalent of the given Unicode character. * * Results: * Returns the lowercase Unicode character. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclUCS4ToLower( int ch) /* Unicode character to convert. */ { if (!UNICODE_OUT_OF_RANGE(ch)) { int info = GetUniCharInfo(ch); int mode = GetCaseType(info); if ((mode & 0x02) && (mode != 0x7)) { ch += GetDelta(info); } } /* Clear away extension bits, if any */ return ch & 0x1FFFFF; } Tcl_UniChar Tcl_UniCharToLower( int ch) /* Unicode character to convert. */ { return (Tcl_UniChar) TclUCS4ToLower(ch); } /* *---------------------------------------------------------------------- * * Tcl_UniCharToTitle -- * * Compute the titlecase equivalent of the given Unicode character. * * Results: * Returns the titlecase Unicode character. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int UCS4ToTitle( int ch) /* Unicode character to convert. */ { if (!UNICODE_OUT_OF_RANGE(ch)) { int info = GetUniCharInfo(ch); int mode = GetCaseType(info); if (mode & 0x1) { /* * Subtract or add one depending on the original case. */ if (mode != 0x7) { ch += ((mode & 0x4) ? -1 : 1); } } else if (mode == 0x4) { ch -= GetDelta(info); } } /* Clear away extension bits, if any */ return ch & 0x1FFFFF; } Tcl_UniChar Tcl_UniCharToTitle( int ch) /* Unicode character to convert. */ { return (Tcl_UniChar) UCS4ToTitle(ch); } /* *---------------------------------------------------------------------- * * Tcl_UniCharLen -- * * Find the length of a UniChar string. The str input must be null * terminated. * * Results: * Returns the length of str in UniChars (not bytes). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharLen( const Tcl_UniChar *uniStr) /* Unicode string to find length of. */ { int len = 0; while (*uniStr != '\0') { len++; uniStr++; } return len; } /* *---------------------------------------------------------------------- * * Tcl_UniCharNcmp -- * * Compare at most numChars unichars of string ucs to string uct. * Both ucs and uct are assumed to be at least numChars unichars long. * * Results: * Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct. * * Side effects: * None. * *---------------------------------------------------------------------- */ #undef TclUniCharNcmp int Tcl_UniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ unsigned long numChars) /* Number of unichars to compare. */ { return TclUniCharNcmp(ucs, uct, numChars); } int TclUniCharNcmp( const void *ucsPtr, /* Unicode string to compare to uct. */ const void *uctPtr, /* Unicode string ucs is compared to. */ size_t numChars) /* Number of unichars to compare. */ { const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX != 4) /* * We are definitely on a big-endian machine; memcmp() is safe */ return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar)); #else /* !WORDS_BIGENDIAN */ /* * We can't simply call memcmp() because that is not lexically correct. */ for ( ; numChars != 0; ucs++, uct++, numChars--) { if (*ucs != *uct) { #if TCL_UTF_MAX == 4 /* special case for handling upper surrogates */ if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) { return 1; } else if (((*uct & 0xFC00) == 0xD800)) { return -1; } #endif return (*ucs - *uct); } } return 0; #endif /* WORDS_BIGENDIAN */ } /* *---------------------------------------------------------------------- * * Tcl_UniCharNcasecmp -- * * Compare at most numChars unichars of string ucs to string uct case * insensitive. Both ucs and uct are assumed to be at least numChars * unichars long. * * Results: * Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ unsigned long numChars) /* Number of Unichars to compare. */ { return TclUniCharNcasecmp(ucs, uct, numChars); } int TclUniCharNcasecmp( const void *ucsPtr, /* Unicode string to compare to uct. */ const void *uctPtr, /* Unicode string ucs is compared to. */ size_t numChars) /* Number of Unichars to compare. */ { const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); Tcl_UniChar lct = Tcl_UniCharToLower(*uct); if (lcs != lct) { #if TCL_UTF_MAX == 4 /* special case for handling upper surrogates */ if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) { return 1; } else if (((lct & 0xFC00) == 0xD800)) { return -1; } #endif return (lcs - lct); } } } return 0; } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsAlnum -- * * Test if a character is an alphanumeric Unicode character. * * Results: * Returns 1 if character is alphanumeric. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsAlnum( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return 0; } #endif return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsAlpha -- * * Test if a character is an alphabetic Unicode character. * * Results: * Returns 1 if character is alphabetic. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsAlpha( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return 0; } #endif return ((ALPHA_BITS >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsControl -- * * Test if a character is a Unicode control character. * * Results: * Returns non-zero if character is a control. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsControl( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { /* Clear away extension bits, if any */ ch &= 0x1FFFFF; return ((ch == 0xE0001) || ((unsigned)(ch - 0xE0020) <= 0x5F)); } #endif return ((CONTROL_BITS >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsDigit -- * * Test if a character is a numeric Unicode character. * * Results: * Returns non-zero if character is a digit. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsDigit( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return 0; } #endif return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsGraph -- * * Test if a character is any Unicode print character except space. * * Results: * Returns non-zero if character is printable, but not space. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsGraph( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return ((unsigned)((ch & 0x1FFFFF) - 0xE0100) <= 0xEF); } #endif return ((GRAPH_BITS >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsLower -- * * Test if a character is a lowercase Unicode character. * * Results: * Returns non-zero if character is lowercase. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsLower( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return 0; } #endif return (GetCategory(ch) == LOWERCASE_LETTER); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsPrint -- * * Test if a character is a Unicode print character. * * Results: * Returns non-zero if character is printable. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsPrint( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return ((unsigned)((ch & 0x1FFFFF) - 0xE0100) <= 0xEF); } #endif return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsPunct -- * * Test if a character is a Unicode punctuation character. * * Results: * Returns non-zero if character is punct. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsPunct( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return 0; } #endif return ((PUNCT_BITS >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsSpace -- * * Test if a character is a whitespace Unicode character. * * Results: * Returns non-zero if character is a space. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsSpace( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 /* Ignore upper 11 bits. */ ch &= 0x1FFFFF; #else /* Ignore upper 16 bits. */ ch &= 0xFFFF; #endif /* * If the character is within the first 127 characters, just use the * standard C function, otherwise consult the Unicode table. */ if (ch < 0x80) { return TclIsSpaceProcM((char) ch); #if TCL_UTF_MAX > 3 } else if (UNICODE_OUT_OF_RANGE(ch)) { return 0; #endif } else if (ch == 0x0085 || ch == 0x180E || ch == 0x200B || ch == 0x202F || ch == 0x2060 || ch == 0xFEFF) { return 1; } else { return ((SPACE_BITS >> GetCategory(ch)) & 1); } } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsUpper -- * * Test if a character is a uppercase Unicode character. * * Results: * Returns non-zero if character is uppercase. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsUpper( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return 0; } #endif return (GetCategory(ch) == UPPERCASE_LETTER); } /* *---------------------------------------------------------------------- * * Tcl_UniCharIsWordChar -- * * Test if a character is alphanumeric or a connector punctuation mark. * * Results: * Returns 1 if character is a word character. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharIsWordChar( int ch) /* Unicode character to test. */ { #if TCL_UTF_MAX > 3 if (UNICODE_OUT_OF_RANGE(ch)) { return 0; } #endif return ((WORD_BITS >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * * Tcl_UniCharCaseMatch -- * * See if a particular Unicode string matches a particular pattern. * Allows case insensitivity. This is the Unicode equivalent of the char* * Tcl_StringCaseMatch. The UniChar strings must be NULL-terminated. * This has no provision for counted UniChar strings, thus should not be * used where NULLs are expected in the UniChar string. Use * TclUniCharMatch where possible. * * Results: * The return value is 1 if string matches pattern, and 0 otherwise. The * matching operation permits the following special characters in the * pattern: *?\[] (see the manual entry for details on what these mean). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_UniCharCaseMatch( const Tcl_UniChar *uniStr, /* Unicode String. */ const Tcl_UniChar *uniPattern, /* Pattern, which may contain special * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { Tcl_UniChar ch1 = 0, p; while (1) { p = *uniPattern; /* * See if we're at the end of both the pattern and the string. If so, * we succeeded. If we're at the end of the pattern but not at the end * of the string, we failed. */ if (p == 0) { return (*uniStr == 0); } if ((*uniStr == 0) && (p != '*')) { return 0; } /* * Check for a "*" as the next pattern character. It matches any * substring. We handle this by skipping all the characters up to the * next matching one in the pattern, and then calling ourselves * recursively for each postfix of string, until either we match or we * reach the end of the string. */ if (p == '*') { /* * Skip all successive *'s in the pattern */ while (*(++uniPattern) == '*') { /* empty body */ } p = *uniPattern; if (p == 0) { return 1; } if (nocase) { p = Tcl_UniCharToLower(p); } while (1) { /* * Optimization for matching - cruise through the string * quickly if the next char in the pattern isn't a special * character */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*uniStr && (p != *uniStr) && (p != Tcl_UniCharToLower(*uniStr))) { uniStr++; } } else { while (*uniStr && (p != *uniStr)) { uniStr++; } } } if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) { return 1; } if (*uniStr == 0) { return 0; } uniStr++; } } /* * Check for a "?" as the next pattern character. It matches any * single character. */ if (p == '?') { uniPattern++; uniStr++; continue; } /* * Check for a "[" as the next pattern character. It is followed by a * list of characters that are acceptable, or by a range (two * characters separated by "-"). */ if (p == '[') { Tcl_UniChar startChar, endChar; uniPattern++; ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr); uniStr++; while (1) { if ((*uniPattern == ']') || (*uniPattern == 0)) { return 0; } startChar = (nocase ? Tcl_UniCharToLower(*uniPattern) : *uniPattern); uniPattern++; if (*uniPattern == '-') { uniPattern++; if (*uniPattern == 0) { return 0; } endChar = (nocase ? Tcl_UniCharToLower(*uniPattern) : *uniPattern); uniPattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* * Matches ranges of form [a-z] or [z-a]. */ break; } } else if (startChar == ch1) { break; } } while (*uniPattern != ']') { if (*uniPattern == 0) { uniPattern--; break; } uniPattern++; } uniPattern++; continue; } /* * If the next pattern character is '\', just strip off the '\' so we * do exact matching on the character that follows. */ if (p == '\\') { if (*(++uniPattern) == '\0') { return 0; } } /* * There's no special character. Just make sure that the next bytes of * each string match. */ if (nocase) { if (Tcl_UniCharToLower(*uniStr) != Tcl_UniCharToLower(*uniPattern)) { return 0; } } else if (*uniStr != *uniPattern) { return 0; } uniStr++; uniPattern++; } } /* *---------------------------------------------------------------------- * * TclUniCharMatch -- * * See if a particular Unicode string matches a particular pattern. * Allows case insensitivity. This is the Unicode equivalent of the char* * Tcl_StringCaseMatch. This variant of Tcl_UniCharCaseMatch uses counted * Strings, so embedded NULLs are allowed. * * Results: * The return value is 1 if string matches pattern, and 0 otherwise. The * matching operation permits the following special characters in the * pattern: *?\[] (see the manual entry for details on what these mean). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclUniCharMatch( const Tcl_UniChar *string, /* Unicode String. */ int strLen, /* Length of String */ const Tcl_UniChar *pattern, /* Pattern, which may contain special * characters. */ int ptnLen, /* Length of Pattern */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { const Tcl_UniChar *stringEnd, *patternEnd; Tcl_UniChar p; stringEnd = string + strLen; patternEnd = pattern + ptnLen; while (1) { /* * See if we're at the end of both the pattern and the string. If so, * we succeeded. If we're at the end of the pattern but not at the end * of the string, we failed. */ if (pattern == patternEnd) { return (string == stringEnd); } p = *pattern; if ((string == stringEnd) && (p != '*')) { return 0; } /* * Check for a "*" as the next pattern character. It matches any * substring. We handle this by skipping all the characters up to the * next matching one in the pattern, and then calling ourselves * recursively for each postfix of string, until either we match or we * reach the end of the string. */ if (p == '*') { /* * Skip all successive *'s in the pattern. */ while (*(++pattern) == '*') { /* empty body */ } if (pattern == patternEnd) { return 1; } p = *pattern; if (nocase) { p = Tcl_UniCharToLower(p); } while (1) { /* * Optimization for matching - cruise through the string * quickly if the next char in the pattern isn't a special * character. */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while ((string < stringEnd) && (p != *string) && (p != Tcl_UniCharToLower(*string))) { string++; } } else { while ((string < stringEnd) && (p != *string)) { string++; } } } if (TclUniCharMatch(string, stringEnd - string, pattern, patternEnd - pattern, nocase)) { return 1; } if (string == stringEnd) { return 0; } string++; } } /* * Check for a "?" as the next pattern character. It matches any * single character. */ if (p == '?') { pattern++; string++; continue; } /* * Check for a "[" as the next pattern character. It is followed by a * list of characters that are acceptable, or by a range (two * characters separated by "-"). */ if (p == '[') { Tcl_UniChar ch1, startChar, endChar; pattern++; ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string); string++; while (1) { if ((*pattern == ']') || (pattern == patternEnd)) { return 0; } startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern); pattern++; if (*pattern == '-') { pattern++; if (pattern == patternEnd) { return 0; } endChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern); pattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* * Matches ranges of form [a-z] or [z-a]. */ break; } } else if (startChar == ch1) { break; } } while (*pattern != ']') { if (pattern == patternEnd) { pattern--; break; } pattern++; } pattern++; continue; } /* * If the next pattern character is '\', just strip off the '\' so we * do exact matching on the character that follows. */ if (p == '\\') { if (++pattern == patternEnd) { return 0; } } /* * There's no special character. Just make sure that the next bytes of * each string match. */ if (nocase) { if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) { return 0; } } else if (*string != *pattern) { return 0; } string++; pattern++; } } /* *--------------------------------------------------------------------------- * * TclUtfToUCS4 -- * * Extracts the 4-byte codepoint from the leading bytes of the * Modified UTF-8 string "src". This is a utility routine to * contain the surrogate gymnastics in one place. * * The caller must ensure that the source buffer is long enough that this * routine does not run off the end and dereference non-existent memory * looking for trail bytes. If the source buffer is known to be '\0' * terminated, this cannot happen. Otherwise, the caller should call * TclUCS4Complete() before calling this routine to ensure that * enough bytes remain in the string. * * Results: * Fills *usc4Ptr with the UCS4 code point and returns the number of bytes * consumed from the source string. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TclUtfToUCS4( const char *src, /* The UTF-8 string. */ int *ucs4Ptr) /* Filled with the UCS4 codepoint represented * by the UTF-8 string. */ { Tcl_UniChar ch = 0; int len = Tcl_UtfToUniChar(src, &ch); #if TCL_UTF_MAX <= 4 if ((ch & ~0x3FF) == 0xD800) { Tcl_UniChar low = ch; int len2 = Tcl_UtfToUniChar(src+len, &low); if ((low & ~0x3FF) == 0xDC00) { *ucs4Ptr = (((ch & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000; return len + len2; } } #endif *ucs4Ptr = (int)ch; return len; } #if TCL_UTF_MAX == 4 int TclUniCharToUCS4( const Tcl_UniChar *src, /* The Tcl_UniChar string. */ int *ucs4Ptr) /* Filled with the UCS4 codepoint represented * by the Tcl_UniChar string. */ { if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) { *ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[01] & 0x3FF)) + 0x10000; return 2; } *ucs4Ptr = src[0]; return 1; } #endif /* *--------------------------------------------------------------------------- * * TclUCS4ToUtf -- * * Store the given Unicode character as a sequence of UTF-8 bytes in the * provided buffer. Might output 6 bytes, if the code point > 0xFFFF. * * Results: * The return values is the number of bytes in the buffer that were * consumed. If ch == -1, this function outputs 0 bytes (empty string), * since TclGetUCS4 returns -1 for out-of-range indices. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TclUCS4ToUtf( int ch, /* Unicode character to be stored in the * buffer. */ char *buf) /* Buffer in which the UTF-8 representation of * the Unicode character is stored. Buffer must be * large enough to hold the UTF-8 character(s) * (at most 6 bytes). */ { #if TCL_UTF_MAX <= 4 if (((unsigned)(ch - 0x10000) <= 0xFFFFF)) { /* Spit out a 4-byte UTF-8 character or 2 x 3-byte UTF-8 characters, depending on Tcl * version and/or TCL_UTF_MAX build value */ int len = Tcl_UniCharToUtf(0xD800 | ((ch - 0x10000) >> 10), buf); return len + Tcl_UniCharToUtf(0xDC00 | (ch & 0x7FF), buf + len); } #endif if ((ch & ~0x7FF) == 0xD800) { buf[2] = (char) ((ch | 0x80) & 0xBF); buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF); buf[0] = (char) ((ch >> 12) | 0xE0); return 3; } if (ch == -1) { return 0; } return Tcl_UniCharToUtf(ch, buf); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclUtil.c0000644000175000017500000037524514554262142015062 0ustar sergeisergei/* * tclUtil.c -- * * This file contains utility functions that are used by many Tcl * commands. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclParse.h" #include "tclStringTrim.h" #include /* * The absolute pathname of the executable in which this Tcl library is * running. */ static ProcessGlobalValue executableName = { 0, 0, NULL, NULL, NULL, NULL, NULL }; /* * The following values are used in the flags arguments of Tcl*Scan*Element * and Tcl*Convert*Element. The values TCL_DONT_USE_BRACES and * TCL_DONT_QUOTE_HASH are defined in tcl.h, like so: * #define TCL_DONT_USE_BRACES 1 #define TCL_DONT_QUOTE_HASH 8 * * Those are public flag bits which callers of the public routines * Tcl_Convert*Element() can use to indicate: * * TCL_DONT_USE_BRACES - 1 means the caller is insisting that brace * quoting not be used when converting the list * element. * TCL_DONT_QUOTE_HASH - 1 means the caller insists that a leading hash * character ('#') should *not* be quoted. This * is appropriate when the caller can guarantee * the element is not the first element of a * list, so [eval] cannot mis-parse the element * as a comment. * * The remaining values which can be carried by the flags of these routines * are for internal use only. Make sure they do not overlap with the public * values above. * * The Tcl*Scan*Element() routines make a determination which of 4 modes of * conversion is most appropriate for Tcl*Convert*Element() to perform, and * sets two bits of the flags value to indicate the mode selected. * * CONVERT_NONE The element needs no quoting. Its literal string is * suitable as is. * CONVERT_BRACE The conversion should be enclosing the literal string * in braces. * CONVERT_ESCAPE The conversion should be using backslashes to escape * any characters in the string that require it. * CONVERT_MASK A mask value used to extract the conversion mode from * the flags argument. * Also indicates a strange conversion mode where all * special characters are escaped with backslashes * *except for braces*. This is a strange and unnecessary * case, but it's part of the historical way in which * lists have been formatted in Tcl. To experiment with * removing this case, set the value of COMPAT to 0. * * One last flag value is used only by callers of TclScanElement(). The flag * value produced by a call to Tcl*Scan*Element() will never leave this bit * set. * * CONVERT_ANY The caller of TclScanElement() declares it can make no * promise about what public flags will be passed to the * matching call of TclConvertElement(). As such, * TclScanElement() has to determine the worst case * destination buffer length over all possibilities, and * in other cases this means an overestimate of the * required size. * * For more details, see the comments on the Tcl*Scan*Element and * Tcl*Convert*Element routines. */ #define COMPAT 1 #define CONVERT_NONE 0 #define CONVERT_BRACE 2 #define CONVERT_ESCAPE 4 #define CONVERT_MASK (CONVERT_BRACE | CONVERT_ESCAPE) #define CONVERT_ANY 16 /* * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to * access the precision to be used for double formatting. */ static Tcl_ThreadDataKey precisionKey; /* * Prototypes for functions defined later in this file. */ static void ClearHash(Tcl_HashTable *tablePtr); static void FreeProcessGlobalValue(ClientData clientData); static void FreeThreadHash(ClientData clientData); static int GetEndOffsetFromObj(Tcl_Obj *objPtr, int endValue, int *indexPtr); static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); static int SetEndOffsetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfEndOffset(Tcl_Obj *objPtr); static int FindElement(Tcl_Interp *interp, const char *string, int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that * represents a list index in the form, "end-offset". It is used as a * performance optimization in TclGetIntForIndex. The internal rep is an * integer, so no memory management is required for it. */ const Tcl_ObjType tclEndOffsetType = { "end-offset", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfEndOffset, /* updateStringProc */ SetEndOffsetFromAny }; /* * * STRING REPRESENTATION OF LISTS * * * * * The next several routines implement the conversions of strings to and from * Tcl lists. To understand their operation, the rules of parsing and * generating the string representation of lists must be known. Here we * describe them in one place. * * A list is made up of zero or more elements. Any string is a list if it is * made up of alternating substrings of element-separating ASCII whitespace * and properly formatted elements. * * The ASCII characters which can make up the whitespace between list elements * are: * * \u0009 \t TAB * \u000A \n NEWLINE * \u000B \v VERTICAL TAB * \u000C \f FORM FEED * \u000D \r CARRIAGE RETURN * \u0020 SPACE * * NOTE: differences between this and other places where Tcl defines a role * for "whitespace". * * * Unlike command parsing, here NEWLINE is just another whitespace * character; its role as a command terminator in a script has no * importance here. * * * Unlike command parsing, the BACKSLASH NEWLINE sequence is not * considered to be a whitespace character. * * * Other Unicode whitespace characters (recognized by [string is space] * or Tcl_UniCharIsSpace()) do not play any role as element separators * in Tcl lists. * * * The NUL byte ought not appear, as it is not in strings properly * encoded for Tcl, but if it is present, it is not treated as * separating whitespace, or a string terminator. It is just another * character in a list element. * * The interpretation of a formatted substring as a list element follows rules * similar to the parsing of the words of a command in a Tcl script. Backslash * substitution plays a key role, and is defined exactly as it is in command * parsing. The same routine, TclParseBackslash() is used in both command * parsing and list parsing. * * NOTE: This means that if and when backslash substitution rules ever change * for command parsing, the interpretation of strings as lists also changes. * * Backslash substitution replaces an "escape sequence" of one or more * characters starting with * \u005c \ BACKSLASH * with a single character. The one character escape sequence case happens only * when BACKSLASH is the last character in the string. In all other cases, the * escape sequence is at least two characters long. * * The formatted substrings are interpreted as element values according to the * following cases: * * * If the first character of a formatted substring is * \u007b { OPEN BRACE * then the end of the substring is the matching * \u007d } CLOSE BRACE * character, where matching is determined by counting nesting levels, and * not including any brace characters that are contained within a backslash * escape sequence in the nesting count. Having found the matching brace, * all characters between the braces are the string value of the element. * If no matching close brace is found before the end of the string, the * string is not a Tcl list. If the character following the close brace is * not an element separating whitespace character, or the end of the string, * then the string is not a Tcl list. * * NOTE: this differs from a brace-quoted word in the parsing of a Tcl * command only in its treatment of the backslash-newline sequence. In a * list element, the literal characters in the backslash-newline sequence * become part of the element value. In a script word, conversion to a * single SPACE character is done. * * NOTE: Most list element values can be represented by a formatted * substring using brace quoting. The exceptions are any element value that * includes an unbalanced brace not in a backslash escape sequence, and any * value that ends with a backslash not itself in a backslash escape * sequence. * * * If the first character of a formatted substring is * \u0022 " QUOTE * then the end of the substring is the next QUOTE character, not counting * any QUOTE characters that are contained within a backslash escape * sequence. If no next QUOTE is found before the end of the string, the * string is not a Tcl list. If the character following the closing QUOTE is * not an element separating whitespace character, or the end of the string, * then the string is not a Tcl list. Having found the limits of the * substring, the element value is produced by performing backslash * substitution on the character sequence between the open and close QUOTEs. * * NOTE: Any element value can be represented by this style of formatting, * given suitable choice of backslash escape sequences. * * * All other formatted substrings are terminated by the next element * separating whitespace character in the string. Having found the limits * of the substring, the element value is produced by performing backslash * substitution on it. * * NOTE: Any element value can be represented by this style of formatting, * given suitable choice of backslash escape sequences, with one exception. * The empty string cannot be represented as a list element without the use * of either braces or quotes to delimit it. * * This collection of parsing rules is implemented in the routine * FindElement(). * * In order to produce lists that can be parsed by these rules, we need the * ability to distinguish between characters that are part of a list element * value from characters providing syntax that define the structure of the * list. This means that our code that generates lists must at a minimum be * able to produce escape sequences for the 10 characters identified above * that have significance to a list parser. * * * * CANONICAL LISTS * * * * * * * In addition to the basic rules for parsing strings into Tcl lists, there * are additional properties to be met by the set of list values that are * generated by Tcl. Such list values are often said to be in "canonical * form": * * * When any canonical list is evaluated as a Tcl script, it is a script of * either zero commands (an empty list) or exactly one command. The command * word is exactly the first element of the list, and each argument word is * exactly one of the following elements of the list. This means that any * characters that have special meaning during script evaluation need * special treatment when canonical lists are produced: * * * Whitespace between elements may not include NEWLINE. * * The command terminating character, * \u003b ; SEMICOLON * must be BRACEd, QUOTEd, or escaped so that it does not terminate the * command prematurely. * * Any of the characters that begin substitutions in scripts, * \u0024 $ DOLLAR * \u005b [ OPEN BRACKET * \u005c \ BACKSLASH * need to be BRACEd or escaped. * * In any list where the first character of the first element is * \u0023 # HASH * that HASH character must be BRACEd, QUOTEd, or escaped so that it * does not convert the command into a comment. * * Any list element that contains the character sequence BACKSLASH * NEWLINE cannot be formatted with BRACEs. The BACKSLASH character * must be represented by an escape sequence, and unless QUOTEs are * used, the NEWLINE must be as well. * * * It is also guaranteed that one can use a canonical list as a building * block of a larger script within command substitution, as in this example: * set script "puts \[[list $cmd $arg]]"; eval $script * To support this usage, any appearance of the character * \u005d ] CLOSE BRACKET * in a list element must be BRACEd, QUOTEd, or escaped. * * * Finally it is guaranteed that enclosing a canonical list in braces * produces a new value that is also a canonical list. This new list has * length 1, and its only element is the original canonical list. This same * guarantee also makes it possible to construct scripts where an argument * word is given a list value by enclosing the canonical form of that list * in braces: * set script "puts {[list $one $two $three]}"; eval $script * This sort of coding was once fairly common, though it's become more * idiomatic to see the following instead: * set script [list puts [list $one $two $three]]; eval $script * In order to support this guarantee, every canonical list must have * balance when counting those braces that are not in escape sequences. * * Within these constraints, the canonical list generation routines * TclScanElement() and TclConvertElement() attempt to generate the string for * any list that is easiest to read. When an element value is itself * acceptable as the formatted substring, it is usually used (CONVERT_NONE). * When some quoting or escaping is required, use of BRACEs (CONVERT_BRACE) is * usually preferred over the use of escape sequences (CONVERT_ESCAPE). There * are some exceptions to both of these preferences for reasons of code * simplicity, efficiency, and continuation of historical habits. Canonical * lists never use the QUOTE formatting to delimit their elements because that * form of quoting does not nest, which makes construction of nested lists far * too much trouble. Canonical lists always use only a single SPACE character * for element-separating whitespace. * * * * FUTURE CONSIDERATIONS * * * * * When a list element requires quoting or escaping due to a CLOSE BRACKET * character or an internal QUOTE character, a strange formatting mode is * recommended. For example, if the value "a{b]c}d" is converted by the usual * modes: * * CONVERT_BRACE: a{b]c}d => {a{b]c}d} * CONVERT_ESCAPE: a{b]c}d => a\{b\]c\}d * * we get perfectly usable formatted list elements. However, this is not what * Tcl releases have been producing. Instead, we have: * * CONVERT_MASK: a{b]c}d => a{b\]c}d * * where the CLOSE BRACKET is escaped, but the BRACEs are not. The same effect * can be seen replacing ] with " in this example. There does not appear to be * any functional or aesthetic purpose for this strange additional mode. The * sole purpose I can see for preserving it is to keep generating the same * formatted lists programmers have become accustomed to, and perhaps written * tests to expect. That is, compatibility only. The additional code * complexity required to support this mode is significant. The lines of code * supporting it are delimited in the routines below with #if COMPAT * directives. This makes it easy to experiment with eliminating this * formatting mode simply with "#define COMPAT 0" above. I believe this is * worth considering. * * Another consideration is the treatment of QUOTE characters in list * elements. TclConvertElement() must have the ability to produce the escape * sequence \" so that when a list element begins with a QUOTE we do not * confuse that first character with a QUOTE used as list syntax to define * list structure. However, that is the only place where QUOTE characters need * quoting. In this way, handling QUOTE could really be much more like the way * we handle HASH which also needs quoting and escaping only in particular * situations. Following up this could increase the set of list elements that * can use the CONVERT_NONE formatting mode. * * More speculative is that the demands of canonical list form require brace * balance for the list as a whole, while the current implementation achieves * this by establishing brace balance for every element. * * Finally, a reminder that the rules for parsing and formatting lists are * closely tied together with the rules for parsing and evaluating scripts, * and will need to evolve in sync. */ /* *---------------------------------------------------------------------- * * TclMaxListLength -- * * Given 'bytes' pointing to 'numBytes' bytes, scan through them and * count the number of whitespace runs that could be list element * separators. If 'numBytes' is -1, scan to the terminating '\0'. Not a * full list parser. Typically used to get a quick and dirty overestimate * of length size in order to allocate space for an actual list parser to * operate with. * * Results: * Returns the largest number of list elements that could possibly be in * this string, interpreted as a Tcl list. If 'endPtr' is not NULL, * writes a pointer to the end of the string scanned there. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclMaxListLength( const char *bytes, int numBytes, const char **endPtr) { int count = 0; if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) { /* Empty string case - quick exit */ goto done; } /* * No list element before leading white space. */ count += 1 - TclIsSpaceProcM(*bytes); /* * Count white space runs as potential element separators. */ while (numBytes) { if ((numBytes == -1) && (*bytes == '\0')) { break; } if (TclIsSpaceProcM(*bytes)) { /* * Space run started; bump count. */ count++; do { bytes++; numBytes -= (numBytes != -1); } while (numBytes && TclIsSpaceProcM(*bytes)); if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) { break; } /* * (*bytes) is non-space; return to counting state. */ } bytes++; numBytes -= (numBytes != -1); } /* * No list element following trailing white space. */ count -= TclIsSpaceProcM(bytes[-1]); done: if (endPtr) { *endPtr = bytes; } return count; } /* *---------------------------------------------------------------------- * * TclFindElement -- * * Given a pointer into a Tcl list, locate the first (or next) element in * the list. * * Results: * The return value is normally TCL_OK, which means that the element was * successfully located. If TCL_ERROR is returned it means that list * didn't have proper list structure; the interp's result contains a more * detailed error message. * * If TCL_OK is returned, then *elementPtr will be set to point to the * first element of list, and *nextPtr will be set to point to the * character just after any white space following the last character * that's part of the element. If this is the last argument in the list, * then *nextPtr will point just after the last character in the list * (i.e., at the character at list+listLength). If sizePtr is non-NULL, * *sizePtr is filled in with the number of bytes in the element. If the * element is in braces, then *elementPtr will point to the character * after the opening brace and *sizePtr will not include either of the * braces. If there isn't an element in the list, *sizePtr will be zero, * and both *elementPtr and *nextPtr will point just after the last * character in the list. If literalPtr is non-NULL, *literalPtr is set * to a boolean value indicating whether the substring returned as the * values of **elementPtr and *sizePtr is the literal value of a list * element. If not, a call to TclCopyAndCollapse() is needed to produce * the actual value of the list element. Note: this function does NOT * collapse backslash sequences, but uses *literalPtr to tell callers * when it is required for them to do so. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclFindElement( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ const char *list, /* Points to the first byte of a string * containing a Tcl list with zero or more * elements (possibly in braces). */ int listLength, /* Number of bytes in the list's string. */ const char **elementPtr, /* Where to put address of first significant * character in first element of list. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list). */ int *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr * bytes starting at **elementPtr is/is not * the literal list element and therefore * does not/does require a call to * TclCopyAndCollapse() by the caller. */ { return FindElement(interp, list, listLength, "list", "LIST", elementPtr, nextPtr, sizePtr, literalPtr); } int TclFindDictElement( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ const char *dict, /* Points to the first byte of a string * containing a Tcl dictionary with zero or * more keys and values (possibly in * braces). */ int dictLength, /* Number of bytes in the dict's string. */ const char **elementPtr, /* Where to put address of first significant * character in the first element (i.e., key * or value) of dict. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * element (next arg or end of list). */ int *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr * bytes starting at **elementPtr is/is not * the literal key or value and therefore * does not/does require a call to * TclCopyAndCollapse() by the caller. */ { return FindElement(interp, dict, dictLength, "dict", "DICTIONARY", elementPtr, nextPtr, sizePtr, literalPtr); } static int FindElement( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ const char *string, /* Points to the first byte of a string * containing a Tcl list or dictionary with * zero or more elements (possibly in * braces). */ int stringLength, /* Number of bytes in the string. */ const char *typeStr, /* The name of the type of thing we are * parsing, for error messages. */ const char *typeCode, /* The type code for thing we are parsing, for * error messages. */ const char **elementPtr, /* Where to put address of first significant * character in first element. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list/dict). */ int *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr * bytes starting at **elementPtr is/is not * the literal list/dict element and therefore * does not/does require a call to * TclCopyAndCollapse() by the caller. */ { const char *p = string; const char *elemStart; /* Points to first byte of first element. */ const char *limit; /* Points just after list/dict's last byte. */ int openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; int size = 0; int numChars; int literal = 1; const char *p2; /* * Skim off leading white space and check for an opening brace or quote. * We treat embedded NULLs in the list/dict as bytes belonging to a list * element (or dictionary key or value). */ limit = (string + stringLength); while ((p < limit) && (TclIsSpaceProcM(*p))) { p++; } if (p == limit) { /* no element found */ elemStart = limit; goto done; } if (*p == '{') { openBraces = 1; p++; } else if (*p == '"') { inQuotes = 1; p++; } elemStart = p; /* * Find element's end (a space, close brace, or the end of the string). */ while (p < limit) { switch (*p) { /* * Open brace: don't treat specially unless the element is in * braces. In this case, keep a nesting count. */ case '{': if (openBraces != 0) { openBraces++; } break; /* * Close brace: if element is in braces, keep nesting count and * quit when the last close brace is seen. */ case '}': if (openBraces > 1) { openBraces--; } else if (openBraces == 1) { size = (p - elemStart); p++; if ((p >= limit) || TclIsSpaceProcM(*p)) { goto done; } /* * Garbage after the closing brace; return an error. */ if (interp != NULL) { p2 = p; while ((p2 < limit) && (!TclIsSpaceProcM(*p2)) && (p2 < p+20)) { p2++; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s element in braces followed by \"%.*s\" " "instead of space", typeStr, (int) (p2-p), p)); Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK", NULL); } return TCL_ERROR; } break; /* * Backslash: skip over everything up to the end of the backslash * sequence. */ case '\\': if (openBraces == 0) { /* * A backslash sequence not within a brace quoted element * means the value of the element is different from the * substring we are parsing. A call to TclCopyAndCollapse() is * needed to produce the element value. Inform the caller. */ literal = 0; } TclParseBackslash(p, limit - p, &numChars, NULL); p += (numChars - 1); break; /* * Double-quote: if element is in quotes then terminate it. */ case '"': if (inQuotes) { size = (p - elemStart); p++; if ((p >= limit) || TclIsSpaceProcM(*p)) { goto done; } /* * Garbage after the closing quote; return an error. */ if (interp != NULL) { p2 = p; while ((p2 < limit) && (!TclIsSpaceProcM(*p2)) && (p2 < p+20)) { p2++; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s element in quotes followed by \"%.*s\" " "instead of space", typeStr, (int) (p2-p), p)); Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK", NULL); } return TCL_ERROR; } break; default: if (TclIsSpaceProcM(*p)) { /* * Space: ignore if element is in braces or quotes; * otherwise terminate element. */ if ((openBraces == 0) && !inQuotes) { size = (p - elemStart); goto done; } } break; } p++; } /* * End of list/dict: terminate element. */ if (p == limit) { if (openBraces != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unmatched open brace in %s", typeStr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE", NULL); } return TCL_ERROR; } else if (inQuotes) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unmatched open quote in %s", typeStr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE", NULL); } return TCL_ERROR; } size = (p - elemStart); } done: while ((p < limit) && (TclIsSpaceProcM(*p))) { p++; } *elementPtr = elemStart; *nextPtr = p; if (sizePtr != 0) { *sizePtr = size; } if (literalPtr != 0) { *literalPtr = literal; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCopyAndCollapse -- * * Copy a string and substitute all backslash escape sequences * * Results: * Count bytes get copied from src to dst. Along the way, backslash * sequences are substituted in the copy. After scanning count bytes from * src, a null character is placed at the end of dst. Returns the number * of bytes that got written to dst. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclCopyAndCollapse( int count, /* Number of byte to copy from src. */ const char *src, /* Copy from here... */ char *dst) /* ... to here. */ { int newCount = 0; while (count > 0) { char c = *src; if (c == '\\') { int numRead; int backslashCount = TclParseBackslash(src, count, &numRead, dst); dst += backslashCount; newCount += backslashCount; src += numRead; count -= numRead; } else { *dst = c; dst++; newCount++; src++; count--; } } *dst = 0; return newCount; } /* *---------------------------------------------------------------------- * * Tcl_SplitList -- * * Splits a list up into its constituent fields. * * Results * The return value is normally TCL_OK, which means that the list was * successfully split up. If TCL_ERROR is returned, it means that "list" * didn't have proper list structure; the interp's result will contain a * more detailed error message. * * *argvPtr will be filled in with the address of an array whose elements * point to the elements of list, in order. *argcPtr will get filled in * with the number of valid elements in the array. A single block of * memory is dynamically allocated to hold both the argv array and a copy * of the list (with backslashes and braces removed in the standard way). * The caller must eventually free this memory by calling free() on * *argvPtr. Note: *argvPtr and *argcPtr are only modified if the * function returns normally. * * Side effects: * Memory is allocated. * *---------------------------------------------------------------------- */ int Tcl_SplitList( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, no error message is left. */ const char *list, /* Pointer to string with list structure. */ int *argcPtr, /* Pointer to location to fill in with the * number of elements in the list. */ const char ***argvPtr) /* Pointer to place to store pointer to array * of pointers to list elements. */ { const char **argv, *end, *element; char *p; int length, size, i, result, elSize; /* * Allocate enough space to work in. A (const char *) for each (possible) * list element plus one more for terminating NULL, plus as many bytes as * in the original string value, plus one more for a terminating '\0'. * Space used to hold element separating white space in the original * string gets re-purposed to hold '\0' characters in the argv array. */ size = TclMaxListLength(list, -1, &end) + 1; length = end - list; argv = (const char **)ckalloc((size * sizeof(char *)) + length + 1); for (i = 0, p = ((char *) argv) + size*sizeof(char *); *list != 0; i++) { const char *prevList = list; int literal; result = TclFindElement(interp, list, length, &element, &list, &elSize, &literal); length -= (list - prevList); if (result != TCL_OK) { ckfree(argv); return result; } if (*element == 0) { break; } if (i >= size) { ckfree(argv); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "internal error in Tcl_SplitList", -1)); Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList", NULL); } return TCL_ERROR; } argv[i] = p; if (literal) { memcpy(p, element, elSize); p += elSize; *p = 0; p++; } else { p += 1 + TclCopyAndCollapse(elSize, element, p); } } argv[i] = NULL; *argvPtr = argv; *argcPtr = i; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ScanElement -- * * This function is a companion function to Tcl_ConvertElement. It scans * a string to see what needs to be done to it (e.g. add backslashes or * enclosing braces) to make the string into a valid Tcl list element. * * Results: * The return value is an overestimate of the number of bytes that will * be needed by Tcl_ConvertElement to produce a valid list element from * src. The word at *flagPtr is filled in with a value needed by * Tcl_ConvertElement when doing the actual conversion. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_ScanElement( const char *src, /* String to convert to list element. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } /* *---------------------------------------------------------------------- * * Tcl_ScanCountedElement -- * * This function is a companion function to Tcl_ConvertCountedElement. It * scans a string to see what needs to be done to it (e.g. add * backslashes or enclosing braces) to make the string into a valid Tcl * list element. If length is -1, then the string is scanned from src up * to the first null byte. * * Results: * The return value is an overestimate of the number of bytes that will * be needed by Tcl_ConvertCountedElement to produce a valid list element * from src. The word at *flagPtr is filled in with a value needed by * Tcl_ConvertCountedElement when doing the actual conversion. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { char flags = CONVERT_ANY; int numBytes = TclScanElement(src, length, &flags); *flagPtr = flags; return numBytes; } /* *---------------------------------------------------------------------- * * TclScanElement -- * * This function is a companion function to TclConvertElement. It scans a * string to see what needs to be done to it (e.g. add backslashes or * enclosing braces) to make the string into a valid Tcl list element. If * length is -1, then the string is scanned from src up to the first null * byte. A NULL value for src is treated as an empty string. The incoming * value of *flagPtr is a report from the caller what additional flags it * will pass to TclConvertElement(). * * Results: * The recommended formatting mode for the element is determined and a * value is written to *flagPtr indicating that recommendation. This * recommendation is combined with the incoming flag values in *flagPtr * set by the caller to determine how many bytes will be needed by * TclConvertElement() in which to write the formatted element following * the recommendation modified by the flag values. This number of bytes * is the return value of the routine. In some situations it may be an * overestimate, but so long as the caller passes the same flags to * TclConvertElement(), it will be large enough. * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned int TclScanElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { const char *p = src; int nestingLevel = 0; /* Brace nesting count */ int forbidNone = 0; /* Do not permit CONVERT_NONE mode. Something * needs protection or escape. */ int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some * reason bare or brace-quoted form fails. */ int extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ unsigned int bytesNeeded; /* Buffer length computed to complete the * element formatting in the selected mode. */ #if COMPAT int preferEscape = 0; /* Use preferences to track whether to use */ int preferBrace = 0; /* CONVERT_MASK mode. */ int braceCount = 0; /* Count of all braces '{' '}' seen. */ #endif /* COMPAT */ if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) { /* * Empty string element must be brace quoted. */ *flagPtr = CONVERT_BRACE; return 2; } #if COMPAT /* * We have an established history in TclConvertElement() when quoting * because of a leading hash character to force what would be the * CONVERT_MASK mode into the CONVERT_BRACE mode. That is, we format * the element #{a"b} like this: * {#{a"b}} * and not like this: * \#{a\"b} * This is inconsistent with [list x{a"b}], but we will not change that now. * Set that preference here so that we compute a tight size requirement. */ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) { preferBrace = 1; } #endif if ((*p == '{') || (*p == '"')) { /* * Must escape or protect so leading character of value is not * misinterpreted as list element delimiting syntax. */ forbidNone = 1; #if COMPAT preferBrace = 1; #endif /* COMPAT */ } while (length) { if (CHAR_TYPE(*p) != TYPE_NORMAL) { switch (*p) { case '{': /* TYPE_BRACE */ #if COMPAT braceCount++; #endif /* COMPAT */ extra++; /* Escape '{' => '\{' */ nestingLevel++; break; case '}': /* TYPE_BRACE */ #if COMPAT braceCount++; #endif /* COMPAT */ extra++; /* Escape '}' => '\}' */ nestingLevel--; if (nestingLevel < 0) { /* * Unbalanced braces! Cannot format with brace quoting. */ requireEscape = 1; } break; case ']': /* TYPE_CLOSE_BRACK */ case '"': /* TYPE_SPACE */ #if COMPAT forbidNone = 1; extra++; /* Escapes all just prepend a backslash */ preferEscape = 1; break; #else /* FLOW THROUGH */ #endif /* COMPAT */ case '[': /* TYPE_SUBS */ case '$': /* TYPE_SUBS */ case ';': /* TYPE_COMMAND_END */ forbidNone = 1; extra++; /* Escape sequences all one byte longer. */ #if COMPAT preferBrace = 1; #endif /* COMPAT */ break; case '\\': /* TYPE_SUBS */ extra++; /* Escape '\' => '\\' */ if ((length == 1) || ((length == -1) && (p[1] == '\0'))) { /* * Final backslash. Cannot format with brace quoting. */ requireEscape = 1; break; } if (p[1] == '\n') { extra++; /* Escape newline => '\n', one byte longer */ /* * Backslash newline sequence. Brace quoting not permitted. */ requireEscape = 1; length -= (length > 0); p++; break; } if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { extra++; /* Escape sequences all one byte longer. */ length -= (length > 0); p++; } forbidNone = 1; #if COMPAT preferBrace = 1; #endif /* COMPAT */ break; case '\0': /* TYPE_SUBS */ if (length == -1) { goto endOfString; } /* TODO: Panic on improper encoding? */ break; default: if (TclIsSpaceProcM(*p)) { forbidNone = 1; extra++; /* Escape sequences all one byte longer. */ #if COMPAT preferBrace = 1; #endif } break; } } length -= (length > 0); p++; } endOfString: if (nestingLevel != 0) { /* * Unbalanced braces! Cannot format with brace quoting. */ requireEscape = 1; } /* * We need at least as many bytes as are in the element value... */ bytesNeeded = p - src; if (requireEscape) { /* * We must use escape sequences. Add all the extra bytes needed to * have room to create them. */ bytesNeeded += extra; /* * Make room to escape leading #, if needed. */ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) { bytesNeeded++; } *flagPtr = CONVERT_ESCAPE; goto overflowCheck; } if (*flagPtr & CONVERT_ANY) { /* * The caller has not let us know what flags it will pass to * TclConvertElement() so compute the max size we might need for any * possible choice. Normally the formatting using escape sequences is * the longer one, and a minimum "extra" value of 2 makes sure we * don't request too small a buffer in those edge cases where that's * not true. */ if (extra < 2) { extra = 2; } *flagPtr &= ~CONVERT_ANY; *flagPtr |= TCL_DONT_USE_BRACES; } if (forbidNone) { /* * We must request some form of quoting of escaping... */ #if COMPAT if (preferEscape && !preferBrace) { /* * If we are quoting solely due to ] or internal " characters use * the CONVERT_MASK mode where we escape all special characters * except for braces. "extra" counted space needed to escape * braces too, so subtract "braceCount" to get our actual needs. */ bytesNeeded += (extra - braceCount); /* Make room to escape leading #, if needed. */ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) { bytesNeeded++; } /* * If the caller reports it will direct TclConvertElement() to * use full escapes on the element, add back the bytes needed to * escape the braces. */ if (*flagPtr & TCL_DONT_USE_BRACES) { bytesNeeded += braceCount; } *flagPtr = CONVERT_MASK; goto overflowCheck; } #endif /* COMPAT */ if (*flagPtr & TCL_DONT_USE_BRACES) { /* * If the caller reports it will direct TclConvertElement() to * use escapes, add the extra bytes needed to have room for them. */ bytesNeeded += extra; /* * Make room to escape leading #, if needed. */ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) { bytesNeeded++; } } else { /* * Add 2 bytes for room for the enclosing braces. */ bytesNeeded += 2; } *flagPtr = CONVERT_BRACE; goto overflowCheck; } /* * So far, no need to quote or escape anything. */ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) { /* * If we need to quote a leading #, make room to enclose in braces. */ bytesNeeded += 2; } *flagPtr = CONVERT_NONE; overflowCheck: if (bytesNeeded > INT_MAX) { Tcl_Panic("TclScanElement: string length overflow"); } return bytesNeeded; } /* *---------------------------------------------------------------------- * * Tcl_ConvertElement -- * * This is a companion function to Tcl_ScanElement. Given the information * produced by Tcl_ScanElement, this function converts a string to a list * element equal to that string. * * Results: * Information is copied to *dst in the form of a list element identical * to src (i.e. if Tcl_SplitList is applied to dst it will produce a * string identical to src). The return value is a count of the number of * characters copied (not including the terminating NULL character). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } /* *---------------------------------------------------------------------- * * Tcl_ConvertCountedElement -- * * This is a companion function to Tcl_ScanCountedElement. Given the * information produced by Tcl_ScanCountedElement, this function converts * a string to a list element equal to that string. * * Results: * Information is copied to *dst in the form of a list element identical * to src (i.e. if Tcl_SplitList is applied to dst it will produce a * string identical to src). The return value is a count of the number of * characters copied (not including the terminating NULL character). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertCountedElement( const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { int numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; } /* *---------------------------------------------------------------------- * * TclConvertElement -- * * This is a companion function to TclScanElement. Given the information * produced by TclScanElement, this function converts a string to a list * element equal to that string. * * Results: * Information is copied to *dst in the form of a list element identical * to src (i.e. if Tcl_SplitList is applied to dst it will produce a * string identical to src). The return value is a count of the number of * characters copied (not including the terminating NULL character). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclConvertElement( const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { int conversion = flags & CONVERT_MASK; char *p = dst; /* * Let the caller demand we use escape sequences rather than braces. */ if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) { conversion = CONVERT_ESCAPE; } /* * No matter what the caller demands, empty string must be braced! */ if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) { src = tclEmptyStringRep; length = 0; conversion = CONVERT_BRACE; } /* * Escape leading hash as needed and requested. */ if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) { if (conversion == CONVERT_ESCAPE) { p[0] = '\\'; p[1] = '#'; p += 2; src++; length -= (length > 0); } else { conversion = CONVERT_BRACE; } } /* * No escape or quoting needed. Copy the literal string value. */ if (conversion == CONVERT_NONE) { if (length == -1) { /* TODO: INT_MAX overflow? */ while (*src) { *p++ = *src++; } return p - dst; } else { memcpy(dst, src, length); return length; } } /* * Formatted string is original string enclosed in braces. */ if (conversion == CONVERT_BRACE) { *p = '{'; p++; if (length == -1) { /* TODO: INT_MAX overflow? */ while (*src) { *p++ = *src++; } } else { memcpy(p, src, length); p += length; } *p = '}'; p++; return p - dst; } /* conversion == CONVERT_ESCAPE or CONVERT_MASK */ /* * Formatted string is original string converted to escape sequences. */ for ( ; length; src++, length -= (length > 0)) { switch (*src) { case ']': case '[': case '$': case ';': case ' ': case '\\': case '"': *p = '\\'; p++; break; case '{': case '}': #if COMPAT if (conversion == CONVERT_ESCAPE) #endif /* COMPAT */ { *p = '\\'; p++; } break; case '\f': *p = '\\'; p++; *p = 'f'; p++; continue; case '\n': *p = '\\'; p++; *p = 'n'; p++; continue; case '\r': *p = '\\'; p++; *p = 'r'; p++; continue; case '\t': *p = '\\'; p++; *p = 't'; p++; continue; case '\v': *p = '\\'; p++; *p = 'v'; p++; continue; case '\0': if (length == -1) { return p - dst; } /* * If we reach this point, there's an embedded NULL in the string * range being processed, which should not happen when the * encoding rules for Tcl strings are properly followed. If the * day ever comes when we stop tolerating such things, this is * where to put the Tcl_Panic(). */ break; } *p = *src; p++; } return p - dst; } /* *---------------------------------------------------------------------- * * Tcl_Merge -- * * Given a collection of strings, merge them together into a single * string that has proper Tcl list structured (i.e. Tcl_SplitList may be * used to retrieve strings equal to the original elements, and Tcl_Eval * will parse the string back into its original elements). * * Results: * The return value is the address of a dynamically-allocated string * containing the merged list. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * Tcl_Merge( int argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; int i; unsigned int bytesNeeded = 0; char *result, *dst; /* * Handle empty list case first, so logic of the general case can be * simpler. */ if (argc <= 0) { if (argc < 0) { Tcl_Panic("Tcl_Merge called with negative argc (%d)", argc); } result = (char *)ckalloc(1); result[0] = '\0'; return result; } /* * Pass 1: estimate space, gather flags. */ if (argc <= LOCAL_SIZE) { flagPtr = localFlags; } else { flagPtr = (char *)ckalloc(argc); } for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]); if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } } if (bytesNeeded + argc > INT_MAX + 1U) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += argc; /* * Pass two: copy into the result area. */ result = (char *)ckalloc(bytesNeeded); dst = result; for (i = 0; i < argc; i++) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]); *dst = ' '; dst++; } dst[-1] = 0; if (flagPtr != localFlags) { ckfree(flagPtr); } return result; } /* *---------------------------------------------------------------------- * * Tcl_Backslash -- * * Figure out how to handle a backslash sequence. * * Results: * The return value is the character that should be substituted in place * of the backslash sequence that starts at src. If readPtr isn't NULL * then it is filled in with a count of the number of characters in the * backslash sequence. * * Side effects: * None. * *---------------------------------------------------------------------- */ char Tcl_Backslash( const char *src, /* Points to the backslash character of a * backslash sequence. */ int *readPtr) /* Fill in with number of characters read from * src, unless NULL. */ { char buf[4] = ""; Tcl_UniChar ch = 0; Tcl_UtfBackslash(src, readPtr, buf); TclUtfToUniChar(buf, &ch); return (char) ch; } /* *---------------------------------------------------------------------- * * TclTrimRight -- * Takes two counted strings in the Tcl encoding. Conceptually * finds the sub string (offset) to trim from the right side of the * first string all characters found in the second string. * * Results: * The number of bytes to be removed from the end of the string. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclTrimRight( const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ int numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { const char *pp, *p = bytes + numBytes; int ch1, ch2; /* Empty strings -> nothing to do */ if ((numBytes == 0) || (numTrim == 0)) { return 0; } /* * Outer loop: iterate over string to be trimmed. */ do { const char *q = trim; int pInc = 0, bytesLeft = numTrim; pp = TclUtfPrev(p, bytes); #if TCL_UTF_MAX < 4 pp = TclUtfPrev(pp, bytes); #endif do { pp += pInc; pInc = TclUtfToUCS4(pp, &ch1); } while (pp + pInc < p); /* * Inner loop: scan trim string for match to current character. */ do { pInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; } q += pInc; bytesLeft -= pInc; } while (bytesLeft); if (bytesLeft == 0) { /* * No match; trim task done; *p is last non-trimmed char. */ break; } p = pp; } while (p > bytes); return numBytes - (p - bytes); } /* *---------------------------------------------------------------------- * * TclTrimLeft -- * * Takes two counted strings in the Tcl encoding. Conceptually * finds the sub string (offset) to trim from the left side of the * first string all characters found in the second string. * * Results: * The number of bytes to be removed from the start of the string. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclTrimLeft( const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ int numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { const char *p = bytes; int ch1, ch2; /* Empty strings -> nothing to do */ if ((numBytes == 0) || (numTrim == 0)) { return 0; } /* * Outer loop: iterate over string to be trimmed. */ do { int pInc = TclUtfToUCS4(p, &ch1); const char *q = trim; int bytesLeft = numTrim; /* * Inner loop: scan trim string for match to current character. */ do { int qInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; } q += qInc; bytesLeft -= qInc; } while (bytesLeft); if (bytesLeft == 0) { /* * No match; trim task done; *p is first non-trimmed char. */ break; } p += pInc; numBytes -= pInc; } while (numBytes > 0); return p - bytes; } /* *---------------------------------------------------------------------- * * TclTrim -- * Finds the sub string (offset) to trim from both sides of the * first string all characters found in the second string. * * Results: * The number of bytes to be removed from the start of the string * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclTrim( const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ /* Calls in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ int numTrim, /* ...and its length in bytes */ /* Calls in this routine * rely on (trim[numTrim] == '\0'). */ int *trimRightPtr) /* Offset from the end of the string. */ { int trimLeft = 0, trimRight = 0; /* Empty strings -> nothing to do */ if ((numBytes > 0) && (numTrim > 0)) { /* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */ trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim); numBytes -= trimLeft; /* If we did not trim the whole string, it starts with a character * that we will not trim. Skip over it. */ if (numBytes > 0) { int ch; const char *first = bytes + trimLeft; bytes += TclUtfToUCS4(first, &ch); numBytes -= (bytes - first); if (numBytes > 0) { /* When bytes is NUL-terminated, returns * 0 <= trimRight <= numBytes */ trimRight = TclTrimRight(bytes, numBytes, trim, numTrim); } } } *trimRightPtr = trimRight; return trimLeft; } /* *---------------------------------------------------------------------- * * Tcl_Concat -- * * Concatenate a set of strings into a single large string. * * Results: * The return value is dynamically-allocated string containing a * concatenation of all the strings in argv, with spaces between the * original argv elements. * * Side effects: * Memory is allocated for the result; the caller is responsible for * freeing the memory. * *---------------------------------------------------------------------- */ /* The whitespace characters trimmed during [concat] operations */ #define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1) char * Tcl_Concat( int argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { int i, needSpace = 0, bytesNeeded = 0; char *result, *p; /* * Dispose of the empty result corner case first to simplify later code. */ if (argc == 0) { result = (char *) ckalloc(1); result[0] = '\0'; return result; } /* * First allocate the result buffer at the size required. */ for (i = 0; i < argc; i++) { bytesNeeded += strlen(argv[i]); if (bytesNeeded < 0) { Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); } } if (bytesNeeded + argc - 1 < 0) { /* * Panic test could be tighter, but not going to bother for this * legacy routine. */ Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); } /* * All element bytes + (argc - 1) spaces + 1 terminating NULL. */ result = (char *)ckalloc(bytesNeeded + argc); for (p = result, i = 0; i < argc; i++) { int triml, trimr, elemLength; const char *element; element = argv[i]; elemLength = strlen(argv[i]); /* Trim away the leading/trailing whitespace. */ triml = TclTrim(element, elemLength, CONCAT_TRIM_SET, CONCAT_WS_SIZE, &trimr); element += triml; elemLength -= triml + trimr; /* Do not permit trimming to expose a final backslash character. */ elemLength += trimr && (element[elemLength - 1] == '\\'); /* * If we're left with empty element after trimming, do nothing. */ if (elemLength == 0) { continue; } /* * Append to the result with space if needed. */ if (needSpace) { *p++ = ' '; } memcpy(p, element, elemLength); p += elemLength; needSpace = 1; } *p = '\0'; return result; } /* *---------------------------------------------------------------------- * * Tcl_ConcatObj -- * * Concatenate the strings from a set of objects into a single string * object with spaces between the original strings. * * Results: * The return value is a new string object containing a concatenation of * the strings in objv. Its ref count is zero. * * Side effects: * A new object is created. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ConcatObj( int objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { int i, elemLength, needSpace = 0, bytesNeeded = 0; const char *element; Tcl_Obj *objPtr, *resPtr; /* * Check first to see if all the items are of list type or empty. If so, * we will concat them together as lists, and return a list object. This * is only valid when the lists are in canonical form. */ for (i = 0; i < objc; i++) { int length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } Tcl_GetStringFromObj(objPtr, &length); if (length > 0) { break; } } if (i == objc) { resPtr = NULL; for (i = 0; i < objc; i++) { objPtr = objv[i]; if (objPtr->bytes && objPtr->length == 0) { continue; } if (resPtr) { Tcl_Obj *elemPtr = NULL; Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr); if (elemPtr == NULL) { continue; } if (Tcl_GetString(elemPtr)[0] == '#' || TCL_OK != Tcl_ListObjAppendList(NULL, resPtr, objPtr)) { /* Abandon ship! */ Tcl_DecrRefCount(resPtr); goto slow; } } else { resPtr = TclListObjCopy(NULL, objPtr); } } if (!resPtr) { TclNewObj(resPtr); } return resPtr; } slow: /* * Something cannot be determined to be safe, so build the concatenation * the slow way, using the string representations. * * First try to preallocate the size required. */ for (i = 0; i < objc; i++) { element = TclGetStringFromObj(objv[i], &elemLength); bytesNeeded += elemLength; if (bytesNeeded < 0) { break; } } /* * Does not matter if this fails, will simply try later to build up the * string with each Append reallocating as needed with the usual string * append algorithm. When that fails it will report the error. */ TclNewObj(resPtr); (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1); Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { int triml, trimr; element = TclGetStringFromObj(objv[i], &elemLength); /* Trim away the leading/trailing whitespace. */ triml = TclTrim(element, elemLength, CONCAT_TRIM_SET, CONCAT_WS_SIZE, &trimr); element += triml; elemLength -= triml + trimr; /* Do not permit trimming to expose a final backslash character. */ elemLength += trimr && (element[elemLength - 1] == '\\'); /* * If we're left with empty element after trimming, do nothing. */ if (elemLength == 0) { continue; } /* * Append to the result with space if needed. */ if (needSpace) { Tcl_AppendToObj(resPtr, " ", 1); } Tcl_AppendToObj(resPtr, element, elemLength); needSpace = 1; } return resPtr; } /* *---------------------------------------------------------------------- * * Tcl_StringMatch -- * * See if a particular string matches a particular pattern. * * Results: * The return value is 1 if string matches pattern, and 0 otherwise. The * matching operation permits the following special characters in the * pattern: *?\[] (see the manual entry for details on what these mean). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_StringMatch( const char *str, /* String. */ const char *pattern) /* Pattern, which may contain special * characters. */ { return Tcl_StringCaseMatch(str, pattern, 0); } /* *---------------------------------------------------------------------- * * Tcl_StringCaseMatch -- * * See if a particular string matches a particular pattern. Allows case * insensitivity. * * Results: * The return value is 1 if string matches pattern, and 0 otherwise. The * matching operation permits the following special characters in the * pattern: *?\[] (see the manual entry for details on what these mean). * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_StringCaseMatch( const char *str, /* String. */ const char *pattern, /* Pattern, which may contain special * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { int p, charLen; int ch1 = 0, ch2 = 0; while (1) { p = *pattern; /* * See if we're at the end of both the pattern and the string. If so, * we succeeded. If we're at the end of the pattern but not at the end * of the string, we failed. */ if (p == '\0') { return (*str == '\0'); } if ((*str == '\0') && (p != '*')) { return 0; } /* * Check for a "*" as the next pattern character. It matches any * substring. We handle this by calling ourselves recursively for each * postfix of string, until either we match or we reach the end of the * string. */ if (p == '*') { /* * Skip all successive *'s in the pattern */ while (*(++pattern) == '*') {} p = *pattern; if (p == '\0') { return 1; } /* * This is a special case optimization for single-byte utf. */ if (UCHAR(*pattern) < 0x80) { ch2 = (int) (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern)); } else { TclUtfToUCS4(pattern, &ch2); if (nocase) { ch2 = TclUCS4ToLower(ch2); } } while (1) { /* * Optimization for matching - cruise through the string * quickly if the next char in the pattern isn't a special * character */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*str) { charLen = TclUtfToUCS4(str, &ch1); if (ch2==ch1 || ch2==TclUCS4ToLower(ch1)) { break; } str += charLen; } } else { /* * There's no point in trying to make this code * shorter, as the number of bytes you want to compare * each time is non-constant. */ while (*str) { charLen = TclUtfToUCS4(str, &ch1); if (ch2 == ch1) { break; } str += charLen; } } } if (Tcl_StringCaseMatch(str, pattern, nocase)) { return 1; } if (*str == '\0') { return 0; } str += TclUtfToUCS4(str, &ch1); } } /* * Check for a "?" as the next pattern character. It matches any * single character. */ if (p == '?') { pattern++; str += TclUtfToUCS4(str, &ch1); continue; } /* * Check for a "[" as the next pattern character. It is followed by a * list of characters that are acceptable, or by a range (two * characters separated by "-"). */ if (p == '[') { int startChar = 0, endChar = 0; pattern++; if (UCHAR(*str) < 0x80) { ch1 = (int) (nocase ? tolower(UCHAR(*str)) : UCHAR(*str)); str++; } else { str += TclUtfToUCS4(str, &ch1); if (nocase) { ch1 = TclUCS4ToLower(ch1); } } while (1) { if ((*pattern == ']') || (*pattern == '\0')) { return 0; } if (UCHAR(*pattern) < 0x80) { startChar = (int) (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern)); pattern++; } else { pattern += TclUtfToUCS4(pattern, &startChar); if (nocase) { startChar = TclUCS4ToLower(startChar); } } if (*pattern == '-') { pattern++; if (*pattern == '\0') { return 0; } if (UCHAR(*pattern) < 0x80) { endChar = (int) (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern)); pattern++; } else { pattern += TclUtfToUCS4(pattern, &endChar); if (nocase) { endChar = TclUCS4ToLower(endChar); } } if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* * Matches ranges of form [a-z] or [z-a]. */ break; } } else if (startChar == ch1) { break; } } /* If we reach here, we matched. Need to move past closing ] */ while (*pattern != ']') { if (*pattern == '\0') { /* We ran out of pattern after matching something in * (unclosed!) brackets. So long as we ran out of string * at the same time, we have a match. Otherwise, not. */ return (*str == '\0'); } pattern++; } pattern++; continue; } /* * If the next pattern character is '\', just strip off the '\' so we * do exact matching on the character that follows. */ if (p == '\\') { pattern++; if (*pattern == '\0') { return 0; } } /* * There's no special character. Just make sure that the next bytes of * each string match. */ str += TclUtfToUCS4(str, &ch1); pattern += TclUtfToUCS4(pattern, &ch2); if (nocase) { if (TclUCS4ToLower(ch1) != TclUCS4ToLower(ch2)) { return 0; } } else if (ch1 != ch2) { return 0; } } } /* *---------------------------------------------------------------------- * * TclByteArrayMatch -- * * See if a particular string matches a particular pattern. Does not * allow for case insensitivity. * Parallels tclUtf.c:TclUniCharMatch, adjusted for char* and sans nocase. * * Results: * The return value is 1 if string matches pattern, and 0 otherwise. The * matching operation permits the following special characters in the * pattern: *?\[] (see the manual entry for details on what these mean). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclByteArrayMatch( const unsigned char *string,/* String. */ int strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ int ptnLen, /* Length of Pattern */ int flags) { const unsigned char *stringEnd, *patternEnd; unsigned char p; stringEnd = string + strLen; patternEnd = pattern + ptnLen; while (1) { /* * See if we're at the end of both the pattern and the string. If so, * we succeeded. If we're at the end of the pattern but not at the end * of the string, we failed. */ if (pattern == patternEnd) { return (string == stringEnd); } p = *pattern; if ((string == stringEnd) && (p != '*')) { return 0; } /* * Check for a "*" as the next pattern character. It matches any * substring. We handle this by skipping all the characters up to the * next matching one in the pattern, and then calling ourselves * recursively for each postfix of string, until either we match or we * reach the end of the string. */ if (p == '*') { /* * Skip all successive *'s in the pattern. */ while ((++pattern < patternEnd) && (*pattern == '*')) { /* empty body */ } if (pattern == patternEnd) { return 1; } p = *pattern; while (1) { /* * Optimization for matching - cruise through the string * quickly if the next char in the pattern isn't a special * character. */ if ((p != '[') && (p != '?') && (p != '\\')) { while ((string < stringEnd) && (p != *string)) { string++; } } if (TclByteArrayMatch(string, stringEnd - string, pattern, patternEnd - pattern, 0)) { return 1; } if (string == stringEnd) { return 0; } string++; } } /* * Check for a "?" as the next pattern character. It matches any * single character. */ if (p == '?') { pattern++; string++; continue; } /* * Check for a "[" as the next pattern character. It is followed by a * list of characters that are acceptable, or by a range (two * characters separated by "-"). */ if (p == '[') { unsigned char ch1, startChar, endChar; pattern++; ch1 = *string; string++; while (1) { if ((*pattern == ']') || (pattern == patternEnd)) { return 0; } startChar = *pattern; pattern++; if (*pattern == '-') { pattern++; if (pattern == patternEnd) { return 0; } endChar = *pattern; pattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* * Matches ranges of form [a-z] or [z-a]. */ break; } } else if (startChar == ch1) { break; } } while (*pattern != ']') { if (pattern == patternEnd) { pattern--; break; } pattern++; } pattern++; continue; } /* * If the next pattern character is '\', just strip off the '\' so we * do exact matching on the character that follows. */ if (p == '\\') { if (++pattern == patternEnd) { return 0; } } /* * There's no special character. Just make sure that the next bytes of * each string match. */ if (*string != *pattern) { return 0; } string++; pattern++; } } /* *---------------------------------------------------------------------- * * TclStringMatchObj -- * * See if a particular string matches a particular pattern. Allows case * insensitivity. This is the generic multi-type handler for the various * matching algorithms. * * Results: * The return value is 1 if string matches pattern, and 0 otherwise. The * matching operation permits the following special characters in the * pattern: *?\[] (see the manual entry for details on what these mean). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclStringMatchObj( Tcl_Obj *strObj, /* string object. */ Tcl_Obj *ptnObj, /* pattern object. */ int flags) /* Only TCL_MATCH_NOCASE should be passed, or * 0. */ { int match, length, plen; /* * Promote based on the type of incoming object. * XXX: Currently doesn't take advantage of exact-ness that * XXX: TclReToGlob tells us about trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj)); */ if ((strObj->typePtr == &tclStringType) || (strObj->typePtr == NULL)) { Tcl_UniChar *udata, *uptn; udata = Tcl_GetUnicodeFromObj(strObj, &length); uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen); match = TclUniCharMatch(udata, length, uptn, plen, flags); } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj) && !flags) { unsigned char *data, *ptn; data = Tcl_GetByteArrayFromObj(strObj, &length); ptn = Tcl_GetByteArrayFromObj(ptnObj, &plen); match = TclByteArrayMatch(data, length, ptn, plen, 0); } else { match = Tcl_StringCaseMatch(TclGetString(strObj), TclGetString(ptnObj), flags); } return match; } /* *---------------------------------------------------------------------- * * Tcl_DStringInit -- * * Initializes a dynamic string, discarding any previous contents of the * string (Tcl_DStringFree should have been called already if the dynamic * string was previously in use). * * Results: * None. * * Side effects: * The dynamic string is initialized to be empty. * *---------------------------------------------------------------------- */ void Tcl_DStringInit( Tcl_DString *dsPtr) /* Pointer to structure for dynamic string. */ { dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; dsPtr->staticSpace[0] = '\0'; } /* *---------------------------------------------------------------------- * * Tcl_DStringAppend -- * * Append more bytes to the current value of a dynamic string. * * Results: * The return value is a pointer to the dynamic string's new value. * * Side effects: * Length bytes from "bytes" (or all of "bytes" if length is less than * zero) are added to the current value of the string. Memory gets * reallocated if needed to accommodate the string's new size. * *---------------------------------------------------------------------- */ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is -1 then this * must be null-terminated. */ int length) /* Number of bytes from "bytes" to append. If * < 0, then append all of bytes, up to null * at end. */ { int newSize; if (length < 0) { length = strlen(bytes); } newSize = length + dsPtr->length; /* * Allocate a larger buffer for the string if the current one isn't large * enough. Allocate extra space in the new buffer so that there will be * room to grow before we have to allocate again. */ if (newSize >= dsPtr->spaceAvl) { dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { char *newString = (char *)ckalloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { int offset = -1; /* See [16896d49fd] */ if (bytes >= dsPtr->string && bytes <= dsPtr->string + dsPtr->length) { offset = bytes - dsPtr->string; } dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); if (offset >= 0) { bytes = dsPtr->string + offset; } } } /* * Copy the new string into the buffer at the end of the old one. */ memcpy(dsPtr->string + dsPtr->length, bytes, length); dsPtr->length += length; dsPtr->string[dsPtr->length] = '\0'; return dsPtr->string; } /* *---------------------------------------------------------------------- * * TclDStringAppendObj, TclDStringAppendDString -- * * Simple wrappers round Tcl_DStringAppend that make it easier to append * from particular sources of strings. * *---------------------------------------------------------------------- */ char * TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { int length; char *bytes = Tcl_GetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); } char * TclDStringAppendDString( Tcl_DString *dsPtr, Tcl_DString *toAppendPtr) { return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr), Tcl_DStringLength(toAppendPtr)); } /* *---------------------------------------------------------------------- * * Tcl_DStringAppendElement -- * * Append a list element to the current value of a dynamic string. * * Results: * The return value is a pointer to the dynamic string's new value. * * Side effects: * String is reformatted as a list element and added to the current value * of the string. Memory gets reallocated if needed to accommodate the * string's new size. * *---------------------------------------------------------------------- */ char * Tcl_DStringAppendElement( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *element) /* String to append. Must be * null-terminated. */ { char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); char flags = 0; int quoteHash = 1, newSize; if (needSpace) { /* * If we need a space to separate the new element from something * already ending the string, we're not appending the first element * of any list, so we need not quote any leading hash character. */ quoteHash = 0; } else { /* * We don't need a space, maybe because there's some already there. * Checking whether we might be appending a first element is a bit * more involved. * * Backtrack over all whitespace. */ while ((--dst >= dsPtr->string) && TclIsSpaceProcM(*dst)) { } /* Call again without whitespace to confound things. */ quoteHash = !TclNeedSpace(dsPtr->string, dst+1); } if (!quoteHash) { flags |= TCL_DONT_QUOTE_HASH; } newSize = dsPtr->length + needSpace + TclScanElement(element, -1, &flags); if (!quoteHash) { flags |= TCL_DONT_QUOTE_HASH; } /* * Allocate a larger buffer for the string if the current one isn't large * enough. Allocate extra space in the new buffer so that there will be * room to grow before we have to allocate again. SPECIAL NOTE: must use * memcpy, not strcpy, to copy the string to a larger buffer, since there * may be embedded NULLs in the string in some cases. */ if (newSize >= dsPtr->spaceAvl) { dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { char *newString = (char *)ckalloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { int offset = -1; /* See [16896d49fd] */ if (element >= dsPtr->string && element <= dsPtr->string + dsPtr->length) { offset = element - dsPtr->string; } dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); if (offset >= 0) { element = dsPtr->string + offset; } } } dst = dsPtr->string + dsPtr->length; /* * Convert the new string to a list element and copy it into the buffer at * the end, with a space, if needed. */ if (needSpace) { *dst = ' '; dst++; dsPtr->length++; } dsPtr->length += TclConvertElement(element, -1, dst, flags); dsPtr->string[dsPtr->length] = '\0'; return dsPtr->string; } /* *---------------------------------------------------------------------- * * Tcl_DStringSetLength -- * * Change the length of a dynamic string. This can cause the string to * either grow or shrink, depending on the value of length. * * Results: * None. * * Side effects: * The length of dsPtr is changed to length and a null byte is stored at * that position in the string. If length is larger than the space * allocated for dsPtr, then a panic occurs. * *---------------------------------------------------------------------- */ void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ int length) /* New length for dynamic string. */ { int newsize; if (length < 0) { length = 0; } if (length >= dsPtr->spaceAvl) { /* * There are two interesting cases here. In the first case, the user * may be trying to allocate a large buffer of a specific size. It * would be wasteful to overallocate that buffer, so we just allocate * enough for the requested size plus the trailing null byte. In the * second case, we are growing the buffer incrementally, so we need * behavior similar to Tcl_DStringAppend. The requested length will * usually be a small delta above the current spaceAvl, so we'll end * up doubling the old size. This won't grow the buffer quite as * quickly, but it should be close enough. */ newsize = dsPtr->spaceAvl * 2; if (length < newsize) { dsPtr->spaceAvl = newsize; } else { dsPtr->spaceAvl = length + 1; } if (dsPtr->string == dsPtr->staticSpace) { char *newString = (char *)ckalloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); } } dsPtr->length = length; dsPtr->string[length] = 0; } /* *---------------------------------------------------------------------- * * Tcl_DStringFree -- * * Frees up any memory allocated for the dynamic string and reinitializes * the string to an empty state. * * Results: * None. * * Side effects: * The previous contents of the dynamic string are lost, and the new * value is an empty string. * *---------------------------------------------------------------------- */ void Tcl_DStringFree( Tcl_DString *dsPtr) /* Structure describing dynamic string. */ { if (dsPtr->string != dsPtr->staticSpace) { ckfree(dsPtr->string); } dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; dsPtr->staticSpace[0] = '\0'; } /* *---------------------------------------------------------------------- * * Tcl_DStringResult -- * * This function moves the value of a dynamic string into an interpreter * as its string result. Afterwards, the dynamic string is reset to an * empty string. * * Results: * None. * * Side effects: * The string is "moved" to interp's result, and any existing string * result for interp is freed. dsPtr is reinitialized to an empty string. * *---------------------------------------------------------------------- */ void Tcl_DStringResult( Tcl_Interp *interp, /* Interpreter whose result is to be reset. */ Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, TclDStringToObj(dsPtr)); } /* *---------------------------------------------------------------------- * * Tcl_DStringGetResult -- * * This function moves an interpreter's result into a dynamic string. * * Results: * None. * * Side effects: * The interpreter's string result is cleared, and the previous contents * of dsPtr are freed. * * If the string result is empty, the object result is moved to the * string result, then the object result is reset. * *---------------------------------------------------------------------- */ void Tcl_DStringGetResult( Tcl_Interp *interp, /* Interpreter whose result is to be reset. */ Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { Interp *iPtr = (Interp *) interp; if (dsPtr->string != dsPtr->staticSpace) { ckfree(dsPtr->string); } /* * Do more efficient transfer when we know the result is a Tcl_Obj. When * there's no string result, we only have to deal with two cases: * * 1. When the string rep is the empty string, when we don't copy but * instead use the staticSpace in the DString to hold an empty string. * 2. When the string rep is not there or there's a real string rep, when * we use Tcl_GetString to fetch (or generate) the string rep - which * we know to have been allocated with ckalloc() - and use it to * populate the DString space. Then, we free the internal rep. and set * the object's string representation back to the canonical empty * string. */ if (!iPtr->result[0] && iPtr->objResultPtr && !Tcl_IsShared(iPtr->objResultPtr)) { if (iPtr->objResultPtr->bytes == tclEmptyStringRep) { dsPtr->string = dsPtr->staticSpace; dsPtr->string[0] = 0; dsPtr->length = 0; dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; } else { dsPtr->string = TclGetString(iPtr->objResultPtr); dsPtr->length = iPtr->objResultPtr->length; dsPtr->spaceAvl = dsPtr->length + 1; TclFreeIntRep(iPtr->objResultPtr); iPtr->objResultPtr->bytes = tclEmptyStringRep; iPtr->objResultPtr->length = 0; } return; } /* * If the string result is empty, move the object result to the string * result, then reset the object result. */ (void) Tcl_GetStringResult(interp); dsPtr->length = strlen(iPtr->result); if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { dsPtr->string = iPtr->result; dsPtr->spaceAvl = dsPtr->length+1; } else { dsPtr->string = (char *)ckalloc(dsPtr->length+1); memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); iPtr->freeProc(iPtr->result); } dsPtr->spaceAvl = dsPtr->length+1; iPtr->freeProc = NULL; } else { if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { dsPtr->string = dsPtr->staticSpace; dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; } else { dsPtr->string = (char *)ckalloc(dsPtr->length+1); dsPtr->spaceAvl = dsPtr->length + 1; } memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; } /* *---------------------------------------------------------------------- * * TclDStringToObj -- * * This function moves a dynamic string's contents to a new Tcl_Obj. Be * aware that this function does *not* check that the encoding of the * contents of the dynamic string is correct; this is the caller's * responsibility to enforce. * * Results: * The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a * reference count of zero. * * Side effects: * The string is "moved" to the object. dsPtr is reinitialized to an * empty string; it does not need to be Tcl_DStringFree'd after this if * not used further. * *---------------------------------------------------------------------- */ Tcl_Obj * TclDStringToObj( Tcl_DString *dsPtr) { Tcl_Obj *result; if (dsPtr->string == dsPtr->staticSpace) { if (dsPtr->length == 0) { TclNewObj(result); } else { /* * Static buffer, so must copy. */ TclNewStringObj(result, dsPtr->string, dsPtr->length); } } else { /* * Dynamic buffer, so transfer ownership and reset. */ TclNewObj(result); result->bytes = dsPtr->string; result->length = dsPtr->length; } /* * Re-establish the DString as empty with no buffer allocated. */ dsPtr->string = dsPtr->staticSpace; dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; dsPtr->length = 0; dsPtr->staticSpace[0] = '\0'; return result; } /* *---------------------------------------------------------------------- * * Tcl_DStringStartSublist -- * * This function adds the necessary information to a dynamic string * (e.g. " {") to start a sublist. Future element appends will be in the * sublist rather than the main list. * * Results: * None. * * Side effects: * Characters get added to the dynamic string. * *---------------------------------------------------------------------- */ void Tcl_DStringStartSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) { TclDStringAppendLiteral(dsPtr, " {"); } else { TclDStringAppendLiteral(dsPtr, "{"); } } /* *---------------------------------------------------------------------- * * Tcl_DStringEndSublist -- * * This function adds the necessary characters to a dynamic string to end * a sublist (e.g. "}"). Future element appends will be in the enclosing * (sub)list rather than the current sublist. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_DStringEndSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { TclDStringAppendLiteral(dsPtr, "}"); } /* *---------------------------------------------------------------------- * * Tcl_PrintDouble -- * * Given a floating-point value, this function converts it to an ASCII * string using. * * Results: * The ASCII equivalent of "value" is written at "dst". It is written * using the current precision, and it is guaranteed to contain a decimal * point or exponent, so that it looks like a floating-point value and * not an integer. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_PrintDouble( Tcl_Interp *interp, /* Interpreter whose tcl_precision variable * used to be used to control printing. It's * ignored now. */ double value, /* Value to print as string. */ char *dst) /* Where to store converted value; must have * at least TCL_DOUBLE_SPACE characters. */ { char *p, c; int exponent; int signum; char *digits; char *end; int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * Handle NaN. */ if (TclIsNaN(value)) { TclFormatNaN(value, dst); return; } /* * Handle infinities. */ if (TclIsInfinite(value)) { /* * Remember to copy the terminating NUL too. */ if (value < 0) { memcpy(dst, "-Inf", 5); } else { memcpy(dst, "Inf", 4); } return; } /* * Ordinary (normal and denormal) values. */ if (*precisionPtr == 0) { digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, &exponent, &signum, &end); } else { /* * There are at least two possible interpretations for tcl_precision. * * The first is, "choose the decimal representation having * $tcl_precision digits of significance that is nearest to the given * number, breaking ties by rounding to even, and then trimming * trailing zeros." This gives the greatest possible precision in the * decimal string, but offers the anomaly that [expr 0.1] will be * "0.10000000000000001". * * The second is "choose the decimal representation having at most * $tcl_precision digits of significance that is nearest to the given * number. If no such representation converts exactly to the given * number, choose the one that is closest, breaking ties by rounding * to even. If more than one such representation converts exactly to * the given number, choose the shortest, breaking ties in favour of * the nearest, breaking remaining ties in favour of the one ending in * an even digit." * * Tcl 8.4 implements the first of these, which gives rise to * anomalies in formatting: * * % expr 0.1 * 0.10000000000000001 * % expr 0.01 * 0.01 * % expr 1e-7 * 9.9999999999999995e-08 * * For human readability, it appears better to choose the second rule, * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we prefer * the first (the recommended zero value for tcl_precision avoids the * problem entirely). * * Uncomment TCL_DD_SHORTEN_FLAG in the next call to prefer the method * that allows floating point values to be shortened if it can be done * without loss of precision. */ digits = TclDoubleDigits(value, *precisionPtr, TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, &exponent, &signum, &end); } if (signum) { *dst++ = '-'; } p = digits; if (exponent < -4 || exponent > 16) { /* * E format for numbers < 1e-3 or >= 1e17. */ *dst++ = *p++; c = *p; if (c != '\0') { *dst++ = '.'; while (c != '\0') { *dst++ = c; c = *++p; } } /* * Tcl 8.4 appears to format with at least a two-digit exponent; * preserve that behaviour when tcl_precision != 0 */ if (*precisionPtr == 0) { snprintf(dst, TCL_DOUBLE_SPACE, "e%+d", exponent); } else { snprintf(dst, TCL_DOUBLE_SPACE, "e%+03d", exponent); } } else { /* * F format for others. */ if (exponent < 0) { *dst++ = '0'; } c = *p; while (exponent-- >= 0) { if (c != '\0') { *dst++ = c; c = *++p; } else { *dst++ = '0'; } } *dst++ = '.'; if (c == '\0') { *dst++ = '0'; } else { while (++exponent < -1) { *dst++ = '0'; } while (c != '\0') { *dst++ = c; c = *++p; } } *dst++ = '\0'; } ckfree(digits); } /* *---------------------------------------------------------------------- * * TclPrecTraceProc -- * * This function is invoked whenever the variable "tcl_precision" is * written. * * Results: * Returns NULL if all went well, or an error message if the new value * for the variable doesn't make sense. * * Side effects: * If the new value doesn't make sense then this function undoes the * effect of the variable modification. Otherwise it modifies the format * string that's used by Tcl_PrintDouble. * *---------------------------------------------------------------------- */ char * TclPrecTraceProc( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable. */ const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { Tcl_Obj *value; int prec; int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * If the variable is unset, then recreate the trace. */ if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) { Tcl_TraceVar2(interp, name1, name2, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData); } return NULL; } /* * When the variable is read, reset its value from our shared value. This * is needed in case the variable was modified in some other interpreter * so that this interpreter's value is out of date. */ if (flags & TCL_TRACE_READS) { Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr), flags & TCL_GLOBAL_ONLY); return NULL; } /* * The variable is being written. Check the new value and disallow it if * it isn't reasonable or if this is a safe interpreter (we don't want * safe interpreters messing up the precision of other interpreters). */ if (Tcl_IsSafe(interp)) { return (char *) "can't modify precision from a safe interpreter"; } value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY); if (value == NULL || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK || prec < 0 || prec > TCL_MAX_PREC) { return (char *) "improper value for precision"; } *precisionPtr = prec; return NULL; } /* *---------------------------------------------------------------------- * * TclNeedSpace -- * * This function checks to see whether it is appropriate to add a space * before appending a new list element to an existing string. * * Results: * The return value is 1 if a space is appropriate, 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclNeedSpace( const char *start, /* First character in string. */ const char *end) /* End of string (place where space will be * added, if appropriate). */ { /* * A space is needed unless either: * (a) we're at the start of the string, or * * (NOTE: This check is now absorbed into the loop below.) * if (end == start) { return 0; } * */ /* * (b) we're at the start of a nested list-element, quoted with an open * curly brace; we can be nested arbitrarily deep, so long as the * first curly brace starts an element, so backtrack over open curly * braces that are trailing characters of the string; and * * (NOTE: Every character our parser is looking for is a proper * single-byte encoding of an ASCII value. It does not accept * overlong encodings. Given that, there's no benefit using * Tcl_UtfPrev. If it would find what we seek, so would byte-by-byte * backward scan. Save routine call overhead and risk of wrong * results should the behavior of Tcl_UtfPrev change in unexpected ways. * Reconsider this if we ever start treating non-ASCII Unicode * characters as meaningful list syntax, expanded Unicode spaces as * element separators, for example.) * end = Tcl_UtfPrev(end, start); while (*end == '{') { if (end == start) { return 0; } end = Tcl_UtfPrev(end, start); } * */ while ((--end >= start) && (*end == '{')) { } if (end < start) { return 0; } /* * (c) the trailing character of the string is already a list-element * separator, Use the same testing routine as TclFindElement to * enforce consistency. */ if (TclIsSpaceProcM(*end)) { int result = 0; /* * Trailing whitespace might be part of a backslash escape * sequence. Handle that possibility. */ while ((--end >= start) && (*end == '\\')) { result = !result; } return result; } return 1; } /* *---------------------------------------------------------------------- * * TclFormatInt -- * * This procedure formats an integer into a sequence of decimal digit * characters in a buffer. If the integer is negative, a minus sign is * inserted at the start of the buffer. A null character is inserted at * the end of the formatted characters. It is the caller's responsibility * to ensure that enough storage is available. This procedure has the * effect of sprintf(buffer, "%ld", n) but is faster as proven in * benchmarks. This is key to UpdateStringOfInt, which is a common path * for a lot of code (e.g. int-indexed arrays). * * Results: * An integer representing the number of characters formatted, not * including the terminating \0. * * Side effects: * The formatted characters are written into the storage pointer to by * the "buffer" argument. * *---------------------------------------------------------------------- */ int TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ long n) /* The integer to format. */ { unsigned long intVal; int i = 0; int numFormatted, j; static const char digits[] = "0123456789"; /* * Generate the characters of the result backwards in the buffer. */ intVal = (n < 0 ? -(unsigned long)n : (unsigned long)n); do { buffer[i++] = digits[intVal % 10]; intVal = intVal / 10; } while (intVal > 0); if (n < 0) { buffer[i++] = '-'; } buffer[i] = '\0'; numFormatted = i--; /* * Now reverse the characters. */ for (j = 0; j < i; j++, i--) { char tmp = buffer[i]; buffer[i] = buffer[j]; buffer[j] = tmp; } return numFormatted; } /* *---------------------------------------------------------------------- * * TclGetIntForIndex -- * * Provides an integer corresponding to the list index held in a Tcl * object. The string value 'objPtr' is expected have the format * integer([+-]integer)? or end([+-]integer)?. * * Value * TCL_OK * * The index is stored at the address given by by 'indexPtr'. If * 'objPtr' has the value "end", the value stored is 'endValue'. * * TCL_ERROR * * The value of 'objPtr' does not have one of the expected formats. If * 'interp' is non-NULL, an error message is left in the interpreter's * result object. * * Effect * * The object referenced by 'objPtr' is converted, as needed, to an * integer, wide integer, or end-based-index object. * *---------------------------------------------------------------------- */ int TclGetIntForIndex( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ int endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ int *indexPtr) /* Location filled in with an integer * representing an index. */ { int length; char *opPtr; const char *bytes; if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) { return TCL_OK; } if (GetEndOffsetFromObj(objPtr, endValue, indexPtr) == TCL_OK) { return TCL_OK; } bytes = TclGetStringFromObj(objPtr, &length); /* * Leading whitespace is acceptable in an index. */ while (length && TclIsSpaceProcM(*bytes)) { bytes++; length--; } if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) { int code, first, second; char savedOp = *opPtr; if ((savedOp != '+') && (savedOp != '-')) { goto parseError; } if (TclIsSpaceProcM(opPtr[1])) { goto parseError; } *opPtr = '\0'; code = Tcl_GetInt(interp, bytes, &first); *opPtr = savedOp; if (code == TCL_ERROR) { goto parseError; } if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) { goto parseError; } if (savedOp == '+') { *indexPtr = first + second; } else { *indexPtr = first - second; } return TCL_OK; } /* * Report a parse error. */ parseError: if (interp != NULL) { bytes = TclGetString(objPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad index \"%s\": must be integer?[+-]integer? or" " end?[+-]integer?", bytes)); if (!strncmp(bytes, "end-", 4)) { bytes += 4; } TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * UpdateStringOfEndOffset -- * * Update the string rep of a Tcl object holding an "end-offset" * expression. * * Results: * None. * * Side effects: * Stores a valid string in the object's string rep. * * This function does NOT free any earlier string rep. If it is called on an * object that already has a valid string rep, it will leak memory. * *---------------------------------------------------------------------- */ static void UpdateStringOfEndOffset( Tcl_Obj *objPtr) { char buffer[TCL_INTEGER_SPACE + 5]; int len = 3; memcpy(buffer, "end", 4); if (objPtr->internalRep.longValue != 0) { buffer[len++] = '-'; len += TclFormatInt(buffer+len, (long)(-(unsigned long)(objPtr->internalRep.longValue))); } objPtr->bytes = (char *)ckalloc(len+1); memcpy(objPtr->bytes, buffer, len+1); objPtr->length = len; } /* *---------------------------------------------------------------------- * * GetEndOffsetFromObj -- * * Look for a string of the form "end[+-]offset" and convert it to an * internal representation holding the offset. * * Results: * Tcl return code. * * Side effects: * May store a Tcl_ObjType. * *---------------------------------------------------------------------- */ static int GetEndOffsetFromObj( Tcl_Obj *objPtr, /* Pointer to the object to parse */ int endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ int *indexPtr) /* Location filled in with an integer * representing an index. */ { if (SetEndOffsetFromAny(NULL, objPtr) != TCL_OK) { return TCL_ERROR; } /* TODO: Handle overflow cases sensibly */ *indexPtr = endValue + (int)objPtr->internalRep.longValue; return TCL_OK; } /* *---------------------------------------------------------------------- * * SetEndOffsetFromAny -- * * Look for a string of the form "end[+-]offset" and convert it to an * internal representation holding the offset. * * Results: * Returns TCL_OK if ok, TCL_ERROR if the string was badly formed. * * Side effects: * If interp is not NULL, stores an error message in the interpreter * result. * *---------------------------------------------------------------------- */ static int SetEndOffsetFromAny( Tcl_Interp *interp, /* Tcl interpreter or NULL */ Tcl_Obj *objPtr) /* Pointer to the object to parse */ { int offset; /* Offset in the "end-offset" expression */ const char *bytes; /* String rep of the object */ int length; /* Length of the object's string rep */ /* * If it's already the right type, we're fine. */ if (objPtr->typePtr == &tclEndOffsetType) { return TCL_OK; } /* * Check for a string rep of the right form. */ bytes = TclGetStringFromObj(objPtr, &length); if ((*bytes != 'e') || (strncmp(bytes, "end", (size_t)((length > 3) ? 3 : length)) != 0)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad index \"%s\": must be end?[+-]integer?", bytes)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } return TCL_ERROR; } /* * Convert the string rep. */ if (length <= 3) { offset = 0; } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) { /* * This is our limited string expression evaluator. Pass everything * after "end-" to Tcl_GetInt, then reverse for offset. */ if (TclIsSpaceProcM(bytes[4])) { goto badIndexFormat; } if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) { return TCL_ERROR; } if (bytes[3] == '-') { offset = (int)(-(unsigned int)offset); } } else { /* * Conversion failed. Report the error. */ badIndexFormat: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad index \"%s\": must be end?[+-]integer?", bytes)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } return TCL_ERROR; } /* * The conversion succeeded. Free the old internal rep and set the new * one. */ TclFreeIntRep(objPtr); objPtr->internalRep.longValue = offset; objPtr->typePtr = &tclEndOffsetType; return TCL_OK; } /* *---------------------------------------------------------------------- * * TclIndexEncode -- * * Parse objPtr to determine if it is an index value. Two cases * are possible. The value objPtr might be parsed as an absolute * index value in the C signed int range. Note that this includes * index values that are integers as presented and it includes index * arithmetic expressions. The absolute index values that can be * directly meaningful as an index into either a list or a string are * those integer values >= TCL_INDEX_START (0) * and < TCL_INDEX_AFTER (INT_MAX). * The largest string supported in Tcl 8 has bytelength INT_MAX. * This means the largest supported character length is also INT_MAX, * and the index of the last character in a string of length INT_MAX * is INT_MAX-1. * * Any absolute index value parsed outside that range is encoded * using the before and after values passed in by the * caller as the encoding to use for indices that are either * less than or greater than the usable index range. TCL_INDEX_AFTER * is available as a good choice for most callers to use for * after. Likewise, the value TCL_INDEX_BEFORE is good for * most callers to use for before. Other values are possible * when the caller knows it is helpful in producing its own behavior * for indices before and after the indexed item. * * A token can also be parsed as an end-relative index expression. * All end-relative expressions that indicate an index larger * than end (end+2, end--5) point beyond the end of the indexed * collection, and can be encoded as after. The end-relative * expressions that indicate an index less than or equal to end * are encoded relative to the value TCL_INDEX_END (-2). The * index "end" is encoded as -2, down to the index "end-0x7FFFFFFE" * which is encoded as INT_MIN. Since the largest index into a * string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of * "end-0x7FFFFFFE" for that largest string would be 0. Thus, * if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed, * they can be encoded with the before value. * * These details will require re-examination whenever string and * list length limits are increased, but that will likely also * mean a revised routine capable of returning Tcl_WideInt values. * * Returns: * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. * * Side effects: * When TCL_OK is returned, the encoded index value is written * to *indexPtr. * *---------------------------------------------------------------------- */ int TclIndexEncode( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* Index value to parse */ int before, /* Value to return for index before beginning */ int after, /* Value to return for index after end */ int *indexPtr) /* Where to write the encoded answer, not NULL */ { int idx; if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &idx)) { /* We parsed a value in the range INT_MIN...INT_MAX */ integerEncode: if (idx < TCL_INDEX_START) { /* All negative absolute indices are "before the beginning" */ idx = before; } else if (idx == INT_MAX) { /* This index value is always "after the end" */ idx = after; } /* usual case, the absolute index value encodes itself */ } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) { /* * We parsed an end+offset index value. * idx holds the offset value in the range INT_MIN...INT_MAX. */ if (idx > 0) { /* * All end+positive or end-negative expressions * always indicate "after the end". */ idx = after; } else if (idx < INT_MIN - TCL_INDEX_END) { /* These indices always indicate "before the beginning" */ idx = before; } else { /* Encoded end-positive (or end+negative) are offset */ idx += TCL_INDEX_END; } /* TODO: Consider flag to suppress repeated end-offset parse. */ } else if (TCL_OK == TclGetIntForIndexM(interp, objPtr, 0, &idx)) { /* * Only reach this case when the index value is a * constant index arithmetic expression, and idx * holds the result. Treat it the same as if it were * parsed as an absolute integer value. */ goto integerEncode; } else { return TCL_ERROR; } *indexPtr = idx; return TCL_OK; } /* *---------------------------------------------------------------------- * * TclIndexDecode -- * * Decodes a value previously encoded by TclIndexEncode. The argument * endValue indicates what value of "end" should be used in the * decoding. * * Results: * The decoded index value. * *---------------------------------------------------------------------- */ int TclIndexDecode( int encoded, /* Value to decode */ int endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { if (encoded <= TCL_INDEX_END) { return (encoded - TCL_INDEX_END) + endValue; } return encoded; } /* *---------------------------------------------------------------------- * * TclCheckBadOctal -- * * This function checks for a bad octal value and appends a meaningful * error to the interp's result. * * Results: * 1 if the argument was a bad octal, else 0. * * Side effects: * The interpreter's result is modified. * *---------------------------------------------------------------------- */ int TclCheckBadOctal( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ const char *value) /* String to check. */ { const char *p = value; /* * A frequent mistake is invalid octal values due to an unwanted leading * zero. Try to generate a meaningful error message. */ while (TclIsSpaceProcM(*p)) { p++; } if (*p == '+' || *p == '-') { p++; } if (*p == '0') { if ((p[1] == 'o') || p[1] == 'O') { p += 2; } while (isdigit(UCHAR(*p))) { /* INTL: digit. */ p++; } while (TclIsSpaceProcM(*p)) { p++; } if (*p == '\0') { /* * Reached end of string. */ if (interp != NULL) { /* * Don't reset the result here because we want this result to * be added to an existing error message as extra info. */ Tcl_AppendToObj(Tcl_GetObjResult(interp), " (looks like invalid octal number)", -1); } return 1; } } return 0; } /* *---------------------------------------------------------------------- * * ClearHash -- * * Remove all the entries in the hash table *tablePtr. * *---------------------------------------------------------------------- */ static void ClearHash( Tcl_HashTable *tablePtr) { Tcl_HashSearch search; Tcl_HashEntry *hPtr; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_DecrRefCount(objPtr); Tcl_DeleteHashEntry(hPtr); } } /* *---------------------------------------------------------------------- * * GetThreadHash -- * * Get a thread-specific (Tcl_HashTable *) associated with a thread data * key. * * Results: * The Tcl_HashTable * corresponding to *keyPtr. * * Side effects: * The first call on a keyPtr in each thread creates a new Tcl_HashTable, * and registers a thread exit handler to dispose of it. * *---------------------------------------------------------------------- */ static Tcl_HashTable * GetThreadHash( Tcl_ThreadDataKey *keyPtr) { Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); if (NULL == *tablePtrPtr) { *tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr); Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS); } return *tablePtrPtr; } /* *---------------------------------------------------------------------- * * FreeThreadHash -- * * Thread exit handler used by GetThreadHash to dispose of a thread hash * table. * * Side effects: * Frees a Tcl_HashTable. * *---------------------------------------------------------------------- */ static void FreeThreadHash( ClientData clientData) { Tcl_HashTable *tablePtr = (Tcl_HashTable *)clientData; ClearHash(tablePtr); Tcl_DeleteHashTable(tablePtr); ckfree(tablePtr); } /* *---------------------------------------------------------------------- * * FreeProcessGlobalValue -- * * Exit handler used by Tcl(Set|Get)ProcessGlobalValue to cleanup a * ProcessGlobalValue at exit. * *---------------------------------------------------------------------- */ static void FreeProcessGlobalValue( ClientData clientData) { ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *)clientData; pgvPtr->epoch++; pgvPtr->numBytes = 0; ckfree(pgvPtr->value); pgvPtr->value = NULL; if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); pgvPtr->encoding = NULL; } Tcl_MutexFinalize(&pgvPtr->mutex); } /* *---------------------------------------------------------------------- * * TclSetProcessGlobalValue -- * * Utility routine to set a global value shared by all threads in the * process while keeping a thread-local copy as well. * *---------------------------------------------------------------------- */ void TclSetProcessGlobalValue( ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding) { const char *bytes; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; int dummy; Tcl_MutexLock(&pgvPtr->mutex); /* * Fill the global string value. */ pgvPtr->epoch++; if (NULL != pgvPtr->value) { ckfree(pgvPtr->value); } else { Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes); pgvPtr->value = (char *)ckalloc(pgvPtr->numBytes + 1); memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } pgvPtr->encoding = encoding; /* * Fill the local thread copy directly with the Tcl_Obj value to avoid * loss of the internalrep. Increment newValue refCount early to handle case * where we set a PGV to itself. */ Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_SetHashValue(hPtr, newValue); Tcl_MutexUnlock(&pgvPtr->mutex); } /* *---------------------------------------------------------------------- * * TclGetProcessGlobalValue -- * * Retrieve a global value shared among all threads of the process, * preferring a thread-local copy as long as it remains valid. * * Results: * Returns a (Tcl_Obj *) that holds a copy of the global value. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetProcessGlobalValue( ProcessGlobalValue *pgvPtr) { Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; int epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); if (pgvPtr->encoding != current) { /* * The system encoding has changed since the global string value * was saved. Convert the global value to be based on the new * system encoding. */ Tcl_DString native, newValue; Tcl_MutexLock(&pgvPtr->mutex); epoch = ++pgvPtr->epoch; Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value, pgvPtr->numBytes, &native); Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native), Tcl_DStringLength(&native), &newValue); Tcl_DStringFree(&native); ckfree(pgvPtr->value); pgvPtr->value = (char *)ckalloc(Tcl_DStringLength(&newValue) + 1); memcpy(pgvPtr->value, Tcl_DStringValue(&newValue), Tcl_DStringLength(&newValue) + 1); Tcl_DStringFree(&newValue); Tcl_FreeEncoding(pgvPtr->encoding); pgvPtr->encoding = current; Tcl_MutexUnlock(&pgvPtr->mutex); } else { Tcl_FreeEncoding(current); } } cacheMap = GetThreadHash(&pgvPtr->key); hPtr = Tcl_FindHashEntry(cacheMap, INT2PTR(epoch)); if (NULL == hPtr) { int dummy; /* * No cache for the current epoch - must be a new one. * * First, clear the cacheMap, as anything in it must refer to some * expired epoch. */ ClearHash(cacheMap); /* * If no thread has set the shared value, call the initializer. */ Tcl_MutexLock(&pgvPtr->mutex); if ((NULL == pgvPtr->value) && (pgvPtr->proc)) { pgvPtr->epoch++; pgvPtr->proc(&pgvPtr->value,&pgvPtr->numBytes,&pgvPtr->encoding); if (pgvPtr->value == NULL) { Tcl_Panic("PGV Initializer did not initialize"); } Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } /* * Store a copy of the shared value in our epoch-indexed cache. */ value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); Tcl_SetHashValue(hPtr, value); Tcl_IncrRefCount(value); } return (Tcl_Obj *)Tcl_GetHashValue(hPtr); } /* *---------------------------------------------------------------------- * * TclSetObjNameOfExecutable -- * * This function stores the absolute pathname of the executable file * (normally as computed by TclpFindExecutable). * * Results: * None. * * Side effects: * Stores the executable name. * *---------------------------------------------------------------------- */ void TclSetObjNameOfExecutable( Tcl_Obj *name, Tcl_Encoding encoding) { TclSetProcessGlobalValue(&executableName, name, encoding); } /* *---------------------------------------------------------------------- * * TclGetObjNameOfExecutable -- * * This function retrieves the absolute pathname of the application in * which the Tcl library is running, usually as previously stored by * TclpFindExecutable(). This function call is the C API equivalent to * the "info nameofexecutable" command. * * Results: * A pointer to an "fsPath" Tcl_Obj, or to an empty Tcl_Obj if the * pathname of the application is unknown. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetObjNameOfExecutable(void) { return TclGetProcessGlobalValue(&executableName); } /* *---------------------------------------------------------------------- * * Tcl_GetNameOfExecutable -- * * This function retrieves the absolute pathname of the application in * which the Tcl library is running, and returns it in string form. * * The returned string belongs to Tcl and should be copied if the caller * plans to keep it, to guard against it becoming invalid. * * Results: * A pointer to the internal string or NULL if the internal full path * name has not been computed or unknown. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_GetNameOfExecutable(void) { int numBytes; const char *bytes = Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes); if (numBytes == 0) { return NULL; } return bytes; } /* *---------------------------------------------------------------------- * * TclpGetTime -- * * Deprecated synonym for Tcl_GetTime. This function is provided for the * benefit of extensions written before Tcl_GetTime was exported from the * library. * * Results: * None. * * Side effects: * Stores current time in the buffer designated by "timePtr" * *---------------------------------------------------------------------- */ void TclpGetTime( Tcl_Time *timePtr) { Tcl_GetTime(timePtr); } /* *---------------------------------------------------------------------- * * TclGetPlatform -- * * This is a kludge that allows the test library to get access the * internal tclPlatform variable. * * Results: * Returns a pointer to the tclPlatform variable. * * Side effects: * None. * *---------------------------------------------------------------------- */ TclPlatformType * TclGetPlatform(void) { return &tclPlatform; } /* *---------------------------------------------------------------------- * * TclReToGlob -- * * Attempt to convert a regular expression to an equivalent glob pattern. * * Results: * Returns TCL_OK on success, TCL_ERROR on failure. If interp is not * NULL, an error message is placed in the result. On success, the * DString will contain an exact equivalent glob pattern. The caller is * responsible for calling Tcl_DStringFree on success. If exactPtr is not * NULL, it will be 1 if an exact match qualifies. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclReToGlob( Tcl_Interp *interp, const char *reStr, int reStrLen, Tcl_DString *dsPtr, int *exactPtr, int *quantifiersFoundPtr) { int anchorLeft, anchorRight, lastIsStar, numStars; char *dsStr, *dsStrStart; const char *msg, *p, *strEnd, *code; strEnd = reStr + reStrLen; Tcl_DStringInit(dsPtr); if (quantifiersFoundPtr != NULL) { *quantifiersFoundPtr = 0; } /* * "***=xxx" == "*xxx*", watch for glob-sensitive chars. */ if ((reStrLen >= 4) && (memcmp("***=", reStr, 4) == 0)) { /* * At most, the glob pattern has length 2*reStrLen + 2 to backslash * escape every character and have * at each end. */ Tcl_DStringSetLength(dsPtr, reStrLen + 2); dsStr = dsStrStart = Tcl_DStringValue(dsPtr); *dsStr++ = '*'; for (p = reStr + 4; p < strEnd; p++) { switch (*p) { case '\\': case '*': case '[': case ']': case '?': /* Only add \ where necessary for glob */ *dsStr++ = '\\'; /* fall through */ default: *dsStr++ = *p; break; } } *dsStr++ = '*'; Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart); if (exactPtr) { *exactPtr = 0; } return TCL_OK; } /* * At most, the glob pattern has length reStrLen + 2 to account for * possible * at each end. */ Tcl_DStringSetLength(dsPtr, reStrLen + 2); dsStr = dsStrStart = Tcl_DStringValue(dsPtr); /* * Check for anchored REs (ie ^foo$), so we can use string equal if * possible. Do not alter the start of str so we can free it correctly. * * Keep track of the last char being an unescaped star to prevent multiple * instances. Simpler than checking that the last star may be escaped. */ msg = NULL; code = NULL; p = reStr; anchorRight = 0; lastIsStar = 0; numStars = 0; if (*p == '^') { anchorLeft = 1; p++; } else { anchorLeft = 0; *dsStr++ = '*'; lastIsStar = 1; } for ( ; p < strEnd; p++) { switch (*p) { case '\\': p++; switch (*p) { case 'a': *dsStr++ = '\a'; break; case 'b': *dsStr++ = '\b'; break; case 'f': *dsStr++ = '\f'; break; case 'n': *dsStr++ = '\n'; break; case 'r': *dsStr++ = '\r'; break; case 't': *dsStr++ = '\t'; break; case 'v': *dsStr++ = '\v'; break; case 'B': case '\\': *dsStr++ = '\\'; *dsStr++ = '\\'; anchorLeft = 0; /* prevent exact match */ break; case '*': case '[': case ']': case '?': /* Only add \ where necessary for glob */ *dsStr++ = '\\'; anchorLeft = 0; /* prevent exact match */ /* fall through */ case '{': case '}': case '(': case ')': case '+': case '.': case '|': case '^': case '$': *dsStr++ = *p; break; default: msg = "invalid escape sequence"; code = "BADESCAPE"; goto invalidGlob; } break; case '.': if (quantifiersFoundPtr != NULL) { *quantifiersFoundPtr = 1; } anchorLeft = 0; /* prevent exact match */ if (p+1 < strEnd) { if (p[1] == '*') { p++; if (!lastIsStar) { *dsStr++ = '*'; lastIsStar = 1; numStars++; } continue; } else if (p[1] == '+') { p++; *dsStr++ = '?'; *dsStr++ = '*'; lastIsStar = 1; numStars++; continue; } } *dsStr++ = '?'; break; case '$': if (p+1 != strEnd) { msg = "$ not anchor"; code = "NONANCHOR"; goto invalidGlob; } anchorRight = 1; break; case '*': case '+': case '?': case '|': case '^': case '{': case '}': case '(': case ')': case '[': case ']': msg = "unhandled RE special char"; code = "UNHANDLED"; goto invalidGlob; default: *dsStr++ = *p; break; } lastIsStar = 0; } if (numStars > 1) { /* * Heuristic: if >1 non-anchoring *, the risk is large that glob * matching is slower than the RE engine, so report invalid. */ msg = "excessive recursive glob backtrack potential"; code = "OVERCOMPLEX"; goto invalidGlob; } if (!anchorRight && !lastIsStar) { *dsStr++ = '*'; } Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart); if (exactPtr) { *exactPtr = (anchorLeft && anchorRight); } return TCL_OK; invalidGlob: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL); } Tcl_DStringFree(dsPtr); return TCL_ERROR; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclVar.c0000644000175000017500000055373714554262142014701 0ustar sergeisergei/* * tclVar.c -- * * This file contains routines that implement Tcl variables (both scalars * and arrays). * * The implementation of arrays is modelled after an initial * implementation by Mark Diekhans and Karl Lehenbauer. * * Copyright (c) 1987-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * Copyright (c) 2001 Kevin B. Kenny. All rights reserved. * Copyright (c) 2007 Miguel Sofer * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclOOInt.h" /* * Prototypes for the variable hash key methods. */ static Tcl_HashEntry * AllocVarEntry(Tcl_HashTable *tablePtr, void *keyPtr); static void FreeVarEntry(Tcl_HashEntry *hPtr); static int CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr); static const Tcl_HashKeyType tclVarHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ TclHashObjKey, /* hashKeyProc */ CompareVarKeys, /* compareKeysProc */ AllocVarEntry, /* allocEntryProc */ FreeVarEntry /* freeEntryProc */ }; static inline Var * VarHashCreateVar(TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr); static inline Var * VarHashFirstVar(TclVarHashTable *tablePtr, Tcl_HashSearch *searchPtr); static inline Var * VarHashNextVar(Tcl_HashSearch *searchPtr); static inline void CleanupVar(Var *varPtr, Var *arrayPtr); #define VarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) /* * NOTE: VarHashCreateVar increments the recount of its key argument. * All callers that will call Tcl_DecrRefCount on that argument must * call Tcl_IncrRefCount on it before passing it in. This requirement * can bubble up to callers of callers .... etc. */ static inline Var * VarHashCreateVar( TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr) { Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table, key, newPtr); if (!hPtr) { return NULL; } return VarHashGetValue(hPtr); } #define VarHashFindVar(tablePtr, key) \ VarHashCreateVar((tablePtr), (key), NULL) #define VarHashInvalidateEntry(varPtr) \ ((varPtr)->flags |= VAR_DEAD_HASH) #define VarHashDeleteEntry(varPtr) \ Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry)) #define VarHashFirstEntry(tablePtr, searchPtr) \ Tcl_FirstHashEntry(&(tablePtr)->table, (searchPtr)) #define VarHashNextEntry(searchPtr) \ Tcl_NextHashEntry((searchPtr)) static inline Var * VarHashFirstVar( TclVarHashTable *tablePtr, Tcl_HashSearch *searchPtr) { Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr); if (!hPtr) { return NULL; } return VarHashGetValue(hPtr); } static inline Var * VarHashNextVar( Tcl_HashSearch *searchPtr) { Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr); if (!hPtr) { return NULL; } return VarHashGetValue(hPtr); } #define VarHashGetKey(varPtr) \ (((VarInHash *)(varPtr))->entry.key.objPtr) #define VarHashDeleteTable(tablePtr) \ Tcl_DeleteHashTable(&(tablePtr)->table) /* * The strings below are used to indicate what went wrong when a variable * access is denied. */ static const char NOSUCHVAR[] = "no such variable"; static const char ISARRAY[] = "variable is array"; static const char NEEDARRAY[] = "variable isn't array"; static const char NOSUCHELEMENT[] = "no such element in array"; static const char DANGLINGELEMENT[] = "upvar refers to element in deleted array"; static const char DANGLINGVAR[] = "upvar refers to variable in deleted namespace"; static const char BADNAMESPACE[] = "parent namespace doesn't exist"; static const char MISSINGNAME[] = "missing variable name"; static const char ISARRAYELEMENT[] = "name refers to an element in an array"; /* * A test to see if we are in a call frame that has local variables. This is * true if we are inside a procedure body. */ #define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC) /* * The following structure describes an enumerative search in progress on an * array variable; this are invoked with options to the "array" command. */ typedef struct ArraySearch { int id; /* Integer id used to distinguish among * multiple concurrent searches for the same * array. */ struct Var *varPtr; /* Pointer to array variable that's being * searched. */ Tcl_HashSearch search; /* Info kept by the hash module about progress * through the array. */ Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to * be enumerated (it's leftover from the * Tcl_FirstHashEntry call or from an "array * anymore" command). NULL means must call * Tcl_NextHashEntry to get value to * return. */ struct ArraySearch *nextPtr;/* Next in list of all active searches for * this variable, or NULL if this is the last * one. */ } ArraySearch; /* * Forward references to functions defined later in this file: */ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *patternPtr, int includeLinks); static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr); static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr, Var *varPtr, int flags, int index); static int LocateArray(Tcl_Interp *interp, Tcl_Obj *name, Var **varPtrPtr, int *isArrayPtr); static int NotArrayError(Tcl_Interp *interp, Tcl_Obj *name); static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp, Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr, int flags); static int ObjMakeUpvar(Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, const char *otherP2, int otherFlags, Tcl_Obj *myNamePtr, int myFlags, int index); static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr, Tcl_Obj *varNamePtr, Tcl_Obj *handleObj); static void UnsetVarStruct(Var *varPtr, Var *arrayPtr, Interp *iPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, int index); static int SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* * Functions defined in this file that may be exported in the future for use * by the bytecode compiler and engine or to the public interface. */ MODULE_SCOPE Var * TclLookupSimpleVar(Tcl_Interp *interp, Tcl_Obj *varNamePtr, int flags, int create, const char **errMsgPtr, int *indexPtr); static Tcl_DupInternalRepProc DupLocalVarName; static Tcl_FreeInternalRepProc FreeLocalVarName; static Tcl_UpdateStringProc PanicOnUpdateVarName; static Tcl_FreeInternalRepProc FreeParsedVarName; static Tcl_DupInternalRepProc DupParsedVarName; static Tcl_UpdateStringProc UpdateParsedVarName; static Tcl_UpdateStringProc PanicOnUpdateVarName; static Tcl_SetFromAnyProc PanicOnSetVarName; /* * Types of Tcl_Objs used to cache variable lookups. * * localVarName - INTERNALREP DEFINITION: * twoPtrValue.ptr1: pointer to name obj in varFramePtr->localCache * or NULL if it is this same obj * twoPtrValue.ptr2: index into locals table * * parsedVarName - INTERNALREP DEFINITION: * twoPtrValue.ptr1: pointer to the array name Tcl_Obj, or NULL if it is a * scalar variable * twoPtrValue.ptr2: pointer to the element name string (owned by this * Tcl_Obj), or NULL if it is a scalar variable */ static const Tcl_ObjType localVarNameType = { "localVarName", FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName }; static const Tcl_ObjType tclParsedVarNameType = { "parsedVarName", FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName }; /* * Type of Tcl_Objs used to speed up array searches. * * INTERNALREP DEFINITION: * twoPtrValue.ptr1: searchIdNumber (cast to pointer) * twoPtrValue.ptr2: variableNameStartInString (cast to pointer) * * Note that the value stored in ptr2 is the offset into the string of the * start of the variable name and not the address of the variable name itself, * as this can be safely copied. */ const Tcl_ObjType tclArraySearchType = { "array search", NULL, NULL, NULL, SetArraySearchObj }; Var * TclVarHashCreateVar( TclVarHashTable *tablePtr, const char *key, int *newPtr) { Tcl_Obj *keyPtr; Var *varPtr; keyPtr = Tcl_NewStringObj(key, -1); Tcl_IncrRefCount(keyPtr); varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr); Tcl_DecrRefCount(keyPtr); return varPtr; } static int LocateArray( Tcl_Interp *interp, Tcl_Obj *name, Var **varPtrPtr, int *isArrayPtr) { Var *arrayPtr, *varPtr = TclObjLookupVarEx(interp, name, NULL, /*flags*/ 0, /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (TclCheckArrayTraces(interp, varPtr, arrayPtr, name, -1) == TCL_ERROR) { return TCL_ERROR; } if (varPtrPtr) { *varPtrPtr = varPtr; } if (isArrayPtr) { *isArrayPtr = varPtr && !TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr); } return TCL_OK; } static int NotArrayError( Tcl_Interp *interp, Tcl_Obj *name) { const char *nameStr = Tcl_GetString(name); Tcl_SetObjResult(interp, Tcl_ObjPrintf("\"%s\" isn't an array", nameStr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclCleanupVar -- * * This function is called when it looks like it may be OK to free up a * variable's storage. If the variable is in a hashtable, its Var * structure and hash table entry will be freed along with those of its * containing array, if any. This function is called, for example, when * a trace on a variable deletes a variable. * * Results: * None. * * Side effects: * If the variable (or its containing array) really is dead and in a * hashtable, then its Var structure, and possibly its hash table entry, * is freed up. * *---------------------------------------------------------------------- */ static inline void CleanupVar( Var *varPtr, /* Pointer to variable that may be a candidate * for being expunged. */ Var *arrayPtr) /* Array that contains the variable, or NULL * if this variable isn't an array element. */ { if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr) && !TclIsVarTraced(varPtr) && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) { if (VarHashRefCount(varPtr) == 0) { ckfree(varPtr); } else { VarHashDeleteEntry(varPtr); } } if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) && TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) && (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) { if (VarHashRefCount(arrayPtr) == 0) { ckfree(arrayPtr); } else { VarHashDeleteEntry(arrayPtr); } } } void TclCleanupVar( Var *varPtr, /* Pointer to variable that may be a candidate * for being expunged. */ Var *arrayPtr) /* Array that contains the variable, or NULL * if this variable isn't an array element. */ { CleanupVar(varPtr, arrayPtr); } /* *---------------------------------------------------------------------- * * TclLookupVar -- * * This function is used to locate a variable given its name(s). It has * been mostly superseded by TclObjLookupVar, it is now only used by the * trace code. It is kept in tcl8.5 mainly because it is in the internal * stubs table, so that some extension may be calling it. * * Results: * The return value is a pointer to the variable structure indicated by * part1 and part2, or NULL if the variable couldn't be found. If the * variable is found, *arrayPtrPtr is filled in with the address of the * variable structure for the array that contains the variable (or NULL * if the variable is a scalar). If the variable can't be found and * either createPart1 or createPart2 are 1, a new as-yet-undefined * (VAR_UNDEFINED) variable structure is created, entered into a hash * table, and returned. * * If the variable isn't found and creation wasn't specified, or some * other error occurs, NULL is returned and an error message is left in * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. * * Note: it's possible for the variable returned to be VAR_UNDEFINED even * if createPart1 or createPart2 are 1 (these only cause the hash table * entry or array to be created). For example, the variable might be a * global that has been unset but is still referenced by a procedure, or * a variable that has been unset but it only being kept in existence (if * VAR_UNDEFINED) by a trace. * * Side effects: * New hashtable entries may be created if createPart1 or createPart2 * are 1. * *---------------------------------------------------------------------- */ Var * TclLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ const char *part1, /* If part2 isn't NULL, this is the name of an * array. Otherwise, this is a full variable * name that could include a parenthesized * array element. */ const char *part2, /* Name of element within array, or NULL. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * and TCL_LEAVE_ERR_MSG bits matter. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this * is set to NULL. */ { Var *varPtr; Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1); if (createPart1) { Tcl_IncrRefCount(part1Ptr); } varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, arrayPtrPtr); TclDecrRefCount(part1Ptr); return varPtr; } /* *---------------------------------------------------------------------- * * TclObjLookupVar, TclObjLookupVarEx -- * * This function is used by virtually all of the variable code to locate * a variable given its name(s). The parsing into array/element * components and (if possible) the lookup results are cached in * part1Ptr, which is converted to one of the varNameTypes. * * Results: * The return value is a pointer to the variable structure indicated by * part1Ptr and part2, or NULL if the variable couldn't be found. If * * the variable is found, *arrayPtrPtr is filled with the address of the * variable structure for the array that contains the variable (or NULL * if the variable is a scalar). If the variable can't be found and * either createPart1 or createPart2 are 1, a new as-yet-undefined * (VAR_UNDEFINED) variable structure is created, entered into a hash * table, and returned. * * If the variable isn't found and creation wasn't specified, or some * other error occurs, NULL is returned and an error message is left in * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. * * Note: it's possible for the variable returned to be VAR_UNDEFINED even * if createPart1 or createPart2 are 1 (these only cause the hash table * entry or array to be created). For example, the variable might be a * global that has been unset but is still referenced by a procedure, or * a variable that has been unset but it only being kept in existence (if * VAR_UNDEFINED) by a trace. * * Side effects: * New hashtable entries may be created if createPart1 or createPart2 * are 1. The object part1Ptr is converted to one of localVarNameType, * tclNsVarNameType or tclParsedVarNameType and caches as much of the * lookup as it can. * When createPart1 is 1, callers must IncrRefCount part1Ptr if they * plan to DecrRefCount it. * *---------------------------------------------------------------------- */ Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an * array. Otherwise, this is a full variable * name that could include a parenthesized * array element. */ const char *part2, /* Name of element within array, or NULL. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * and TCL_LEAVE_ERR_MSG bits matter. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this * is set to NULL. */ { Tcl_Obj *part2Ptr = NULL; Var *resPtr; if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); if (createPart2) { Tcl_IncrRefCount(part2Ptr); } } resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, msg, createPart1, createPart2, arrayPtrPtr); if (part2Ptr) { Tcl_DecrRefCount(part2Ptr); } return resPtr; } /* * When createPart1 is 1, callers must IncrRefCount part1Ptr if they * plan to DecrRefCount it. * When createPart2 is 1, callers must IncrRefCount part2Ptr if they * plan to DecrRefCount it. */ Var * TclObjLookupVarEx( Tcl_Interp *interp, /* Interpreter to use for lookup. */ Tcl_Obj *part1Ptr, /* If part2Ptr isn't NULL, this is the name of * an array. Otherwise, this is a full * variable name that could include a * parenthesized array element. */ Tcl_Obj *part2Ptr, /* Name of element within array, or NULL. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * and TCL_LEAVE_ERR_MSG bits matter. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this * is set to NULL. */ { Interp *iPtr = (Interp *) interp; Var *varPtr; /* Points to the variable's in-frame Var * structure. */ const char *part1; int index, len1, len2; int parsed = 0; Tcl_Obj *objPtr; const Tcl_ObjType *typePtr = part1Ptr->typePtr; const char *errMsg = NULL; CallFrame *varFramePtr = iPtr->varFramePtr; const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL; char *newPart2 = NULL; *arrayPtrPtr = NULL; if (typePtr == &localVarNameType) { int localIndex; localVarNameTypeHandling: localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2); if (HasLocalVars(varFramePtr) && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) && (localIndex < varFramePtr->numCompiledLocals)) { /* * Use the cached index if the names coincide. */ Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1; Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex); if ((!namePtr && (checkNamePtr == part1Ptr)) || (namePtr && (checkNamePtr == namePtr))) { varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]); goto donePart1; } } goto doneParsing; } /* * If part1Ptr is a tclParsedVarNameType, separate it into the preparsed * parts. */ if (typePtr == &tclParsedVarNameType) { if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) { if (part2Ptr != NULL) { /* * ERROR: part1Ptr is already an array element, cannot specify * a part2. */ if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, NOSUCHVAR, -1); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL); } return NULL; } part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2; if (newPart2) { part2Ptr = Tcl_NewStringObj(newPart2, -1); if (createPart2) { Tcl_IncrRefCount(part2Ptr); } } part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1; typePtr = part1Ptr->typePtr; if (typePtr == &localVarNameType) { goto localVarNameTypeHandling; } } parsed = 1; } part1 = TclGetStringFromObj(part1Ptr, &len1); if (!parsed && len1 && (*(part1 + len1 - 1) == ')')) { /* * part1Ptr is possibly an unparsed array element. */ int i; len2 = -1; for (i = 0; i < len1; i++) { if (*(part1 + i) == '(') { if (part2Ptr != NULL) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, NEEDARRAY, -1); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL); } return NULL; } /* * part1Ptr points to an array element; first copy the element * name to a new string part2. */ part2 = part1 + i + 1; len2 = len1 - i - 2; len1 = i; newPart2 = ckalloc(len2 + 1); memcpy(newPart2, part2, len2); *(newPart2+len2) = '\0'; part2 = newPart2; part2Ptr = Tcl_NewStringObj(newPart2, -1); if (createPart2) { Tcl_IncrRefCount(part2Ptr); } /* * Free the internal rep of the original part1Ptr, now renamed * objPtr, and set it to tclParsedVarNameType. */ objPtr = part1Ptr; TclFreeIntRep(objPtr); objPtr->typePtr = &tclParsedVarNameType; /* * Define a new string object to hold the new part1Ptr, i.e., * the array name. Set the internal rep of objPtr, reset * typePtr and part1 to contain the references to the array * name. */ TclNewStringObj(part1Ptr, part1, len1); Tcl_IncrRefCount(part1Ptr); objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr; objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2; typePtr = part1Ptr->typePtr; part1 = TclGetString(part1Ptr); break; } } } doneParsing: /* * part1Ptr is not an array element; look it up, and convert it to one of * the cached types if possible. */ TclFreeIntRep(part1Ptr); varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1, &errMsg, &index); if (varPtr == NULL) { if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", TclGetString(part1Ptr), NULL); } if (newPart2) { Tcl_DecrRefCount(part2Ptr); } return NULL; } /* * Cache the newly found variable if possible. */ if (index >= 0) { /* * An indexed local variable. */ Tcl_Obj *cachedNamePtr = localName(iPtr->varFramePtr, index); part1Ptr->typePtr = &localVarNameType; if (part1Ptr != cachedNamePtr) { part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr; Tcl_IncrRefCount(cachedNamePtr); if (cachedNamePtr->typePtr != &localVarNameType || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) { TclFreeIntRep(cachedNamePtr); } } else { part1Ptr->internalRep.twoPtrValue.ptr1 = NULL; } part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index); } else { /* * At least mark part1Ptr as already parsed. */ part1Ptr->typePtr = &tclParsedVarNameType; part1Ptr->internalRep.twoPtrValue.ptr1 = NULL; part1Ptr->internalRep.twoPtrValue.ptr2 = NULL; } donePart1: while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (part2Ptr != NULL) { /* * Array element sought: look it up. */ *arrayPtrPtr = varPtr; varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg, createPart1, createPart2, varPtr, -1); if (newPart2) { Tcl_DecrRefCount(part2Ptr); } } return varPtr; } /* *---------------------------------------------------------------------- * * TclLookupSimpleVar -- * * This function is used by to locate a simple variable (i.e., not an * array element) given its name. * * Results: * The return value is a pointer to the variable structure indicated by * varName, or NULL if the variable couldn't be found. If the variable * can't be found and create is 1, a new as-yet-undefined (VAR_UNDEFINED) * variable structure is created, entered into a hash table, and * returned. * * If the current CallFrame corresponds to a proc and the variable found * is one of the compiledLocals, its index is placed in *indexPtr. * Otherwise, *indexPtr will be set to (according to the needs of * TclObjLookupVar): * -1 a global reference * -2 a reference to a namespace variable * -3 a non-cacheable reference, i.e., one of: * . non-indexed local var * . a reference of unknown origin; * . resolution by a namespace or interp resolver * * If the variable isn't found and creation wasn't specified, or some * other error occurs, NULL is returned and the corresponding error * message is left in *errMsgPtr. * * Note: it's possible for the variable returned to be VAR_UNDEFINED even * if create is 1 (this only causes the hash table entry to be created). * For example, the variable might be a global that has been unset but is * still referenced by a procedure, or a variable that has been unset but * it only being kept in existence (if VAR_UNDEFINED) by a trace. * * Side effects: * A new hashtable entry may be created if create is 1. * Callers must Incr varNamePtr if they plan to Decr it if create is 1. * *---------------------------------------------------------------------- */ Var * TclLookupSimpleVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ Tcl_Obj *varNamePtr, /* This is a simple variable name that could * represent a scalar or an array. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG * bits matter. */ int create, /* If 1, create hash table entry for varname, * if it doesn't already exist. If 0, return * error if it doesn't exist. */ const char **errMsgPtr, int *indexPtr) { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; /* Points to the procedure call frame whose * variables are currently in use. Same as the * current procedure's frame, if any, unless * an "uplevel" is executing. */ TclVarHashTable *tablePtr; /* Points to the hashtable, if any, in which * to look up the variable. */ Tcl_Var var; /* Used to search for global names. */ Var *varPtr; /* Points to the Var structure returned for * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; int isNew, i, result, varLen; const char *varName = TclGetStringFromObj(varNamePtr, &varLen); varPtr = NULL; varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */ *indexPtr = -3; if (flags & TCL_GLOBAL_ONLY) { cxtNsPtr = iPtr->globalNsPtr; } else { cxtNsPtr = iPtr->varFramePtr->nsPtr; } /* * If this namespace has a variable resolver, then give it first crack at * the variable resolution. It may return a Tcl_Var value, it may signal * to continue onward, or it may signal an error. */ if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) && !(flags & TCL_AVOID_RESOLVERS)) { resPtr = iPtr->resolverPtr; if (cxtNsPtr->varResProc) { result = cxtNsPtr->varResProc(interp, varName, (Tcl_Namespace *) cxtNsPtr, flags, &var); } else { result = TCL_CONTINUE; } while (result == TCL_CONTINUE && resPtr) { if (resPtr->varResProc) { result = resPtr->varResProc(interp, varName, (Tcl_Namespace *) cxtNsPtr, flags, &var); } resPtr = resPtr->nextPtr; } if (result == TCL_OK) { return (Var *) var; } else if (result != TCL_CONTINUE) { return NULL; } } /* * Look up varName. Look it up as either a namespace variable or as a * local variable in a procedure call frame (varFramePtr). Interpret * varName as a namespace variable if: * 1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag, * 2) there is no active frame (we're at the global :: scope), * 3) the active frame was pushed to define the namespace context for a * "namespace eval" or "namespace inscope" command, * 4) the name has namespace qualifiers ("::"s). * Otherwise, if varName is a local variable, search first in the frame's * array of compiler-allocated local variables, then in its hashtable for * runtime-created local variables. * * If create and the variable isn't found, create the variable and, if * necessary, create varFramePtr's local var hashtable. */ if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0) || !HasLocalVars(varFramePtr) || (strstr(varName, "::") != NULL)) { const char *tail; int lookGlobal = (flags & TCL_GLOBAL_ONLY) || (cxtNsPtr == iPtr->globalNsPtr) || ((*varName == ':') && (*(varName+1) == ':')); if (lookGlobal) { *indexPtr = -1; flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; } else { if (flags & TCL_AVOID_RESOLVERS) { flags = (flags | TCL_NAMESPACE_ONLY); } if (flags & TCL_NAMESPACE_ONLY) { *indexPtr = -2; } } /* * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or * otherwise generate our own error! */ varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr, (Tcl_Namespace *) cxtNsPtr, (flags | TCL_AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG); if (varPtr == NULL) { Tcl_Obj *tailPtr; if (create) { /* Var wasn't found so create it. */ TclGetNamespaceForQualName(interp, varName, cxtNsPtr, flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail); if (varNsPtr == NULL) { *errMsgPtr = BADNAMESPACE; return NULL; } else if (tail == NULL) { *errMsgPtr = MISSINGNAME; return NULL; } if (tail != varName) { tailPtr = Tcl_NewStringObj(tail, -1); } else { tailPtr = varNamePtr; } varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &isNew); if (lookGlobal) { /* * The variable was created starting from the global * namespace: a global reference is returned even if it * wasn't explicitly requested. */ *indexPtr = -1; } else { *indexPtr = -2; } } else { /* Var wasn't found and not to create it. */ *errMsgPtr = NOSUCHVAR; return NULL; } } } else { /* Local var: look in frame varFramePtr. */ int localCt = varFramePtr->numCompiledLocals; if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; int localLen; for (i=0 ; icompiledLocals[i]; } } } } tablePtr = varFramePtr->varTablePtr; if (create) { if (tablePtr == NULL) { tablePtr = (TclVarHashTable *)ckalloc(sizeof(TclVarHashTable)); TclInitVarHashTable(tablePtr, NULL); varFramePtr->varTablePtr = tablePtr; } varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew); } else { varPtr = NULL; if (tablePtr != NULL) { varPtr = VarHashFindVar(tablePtr, varNamePtr); } if (varPtr == NULL) { *errMsgPtr = NOSUCHVAR; } } } return varPtr; } /* *---------------------------------------------------------------------- * * TclLookupArrayElement -- * * This function is used to locate a variable which is in an array's * hashtable given a pointer to the array's Var structure and the * element's name. * * Results: * The return value is a pointer to the variable structure , or NULL if * the variable couldn't be found. * * If arrayPtr points to a variable that isn't an array and createPart1 * is 1, the corresponding variable will be converted to an array. * Otherwise, NULL is returned and an error message is left in the * interp's result if TCL_LEAVE_ERR_MSG is set in flags. * * If the variable is not found and createPart2 is 1, the variable is * created. Otherwise, NULL is returned and an error message is left in * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. * * Note: it's possible for the variable returned to be VAR_UNDEFINED even * if createPart1 or createPart2 are 1 (these only cause the hash table * entry or array to be created). For example, the variable might be a * global that has been unset but is still referenced by a procedure, or * a variable that has been unset but it only being kept in existence (if * VAR_UNDEFINED) by a trace. * * Side effects: * The variable at arrayPtr may be converted to be an array if * createPart1 is 1. A new hashtable entry may be created if createPart2 * is 1. * When createElem is 1, callers must incr elNamePtr if they plan * to decr it. * *---------------------------------------------------------------------- */ Var * TclLookupArrayElement( Tcl_Interp *interp, /* Interpreter to use for lookup. */ Tcl_Obj *arrayNamePtr, /* This is the name of the array, or NULL if * index>= 0. */ Tcl_Obj *elNamePtr, /* Name of element within array. */ int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ int createArray, /* If 1, transform arrayName to be an array if * it isn't one yet and the transformation is * possible. If 0, return error if it isn't * already an array. */ int createElem, /* If 1, create hash table entry for the * element, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var *arrayPtr, /* Pointer to the array's Var structure. */ int index) /* If >=0, the index of the local array. */ { int isNew; Var *varPtr; TclVarHashTable *tablePtr; Namespace *nsPtr; /* * We're dealing with an array element. Make sure the variable is an array * and look up the element (create the element if desired). */ if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) { if (!createArray) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NOSUCHVAR, index); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL); } return NULL; } /* * Make sure we are not resurrecting a namespace variable from a * deleted namespace! */ if (TclIsVarDeadHash(arrayPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, DANGLINGVAR, index); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL); } return NULL; } TclSetVarArray(arrayPtr); tablePtr = ckalloc(sizeof(TclVarHashTable)); arrayPtr->value.tablePtr = tablePtr; if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) { nsPtr = TclGetVarNsPtr(arrayPtr); } else { nsPtr = NULL; } TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr); } else if (!TclIsVarArray(arrayPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NEEDARRAY, index); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL); } return NULL; } if (createElem) { varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr, &isNew); if (isNew) { if (arrayPtr->flags & VAR_SEARCH_ACTIVE) { DeleteSearches((Interp *) interp, arrayPtr); } TclSetVarArrayElement(varPtr); } } else { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, elNamePtr); if (varPtr == NULL) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NOSUCHELEMENT, index); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", TclGetString(elNamePtr), NULL); } } } return varPtr; } /* *---------------------------------------------------------------------- * * Tcl_GetVar -- * * Return the value of a Tcl variable as a string. * * Results: * The return value points to the current value of varName as a string. * If the variable is not defined or can't be read because of a clash in * array usage then a NULL pointer is returned and an error message is * left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set. * Note: the return value is only valid up until the next change to the * variable; if you depend on the value lasting longer than that, then * make yourself a private copy. * * Side effects: * None. * *---------------------------------------------------------------------- */ #undef Tcl_GetVar const char * Tcl_GetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ const char *varName, /* Name of a variable in interp. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG * bits. */ { Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1); Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags); TclDecrRefCount(varNamePtr); if (resultPtr == NULL) { return NULL; } return TclGetString(resultPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetVar2 -- * * Return the value of a Tcl variable as a string, given a two-part name * consisting of array name and element within array. * * Results: * The return value points to the current value of the variable given by * part1 and part2 as a string. If the specified variable doesn't exist, * or if there is a clash in array usage, then NULL is returned and a * message will be left in the interp's result if the TCL_LEAVE_ERR_MSG * flag is set. Note: the return value is only valid up until the next * change to the variable; if you depend on the value lasting longer than * that, then make yourself a private copy. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * Tcl_GetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ const char *part1, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ const char *part2, /* If non-NULL, gives the name of an element * in the array part1. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG * * bits. */ { Tcl_Obj *resultPtr; Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); Tcl_IncrRefCount(part2Ptr); } resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags); Tcl_DecrRefCount(part1Ptr); if (part2Ptr) { Tcl_DecrRefCount(part2Ptr); } if (resultPtr == NULL) { return NULL; } return TclGetString(resultPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetVar2Ex -- * * Return the value of a Tcl variable as a Tcl object, given a two-part * name consisting of array name and element within array. * * Results: * The return value points to the current object value of the variable * given by part1Ptr and part2Ptr. If the specified variable doesn't * exist, or if there is a clash in array usage, then NULL is returned * and a message will be left in the interpreter's result if the * TCL_LEAVE_ERR_MSG flag is set. * * Side effects: * The ref count for the returned object is _not_ incremented to reflect * the returned reference; if you want to keep a reference to the object * you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetVar2Ex( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ const char *part1, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ const char *part2, /* If non-NULL, gives the name of an element * in the array part1. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); Tcl_IncrRefCount(part2Ptr); } resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags); Tcl_DecrRefCount(part1Ptr); if (part2Ptr) { Tcl_DecrRefCount(part2Ptr); } return resPtr; } /* *---------------------------------------------------------------------- * * Tcl_ObjGetVar2 -- * * Return the value of a Tcl variable as a Tcl object, given a two-part * name consisting of array name and element within array. * * Results: * The return value points to the current object value of the variable * given by part1Ptr and part2Ptr. If the specified variable doesn't * exist, or if there is a clash in array usage, then NULL is returned * and a message will be left in the interpreter's result if the * TCL_LEAVE_ERR_MSG flag is set. * * Side effects: * The ref count for the returned object is _not_ incremented to reflect * the returned reference; if you want to keep a reference to the object * you must increment its ref count yourself. * * Callers must incr part2Ptr if they plan to decr it. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjGetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG bits. */ { Var *varPtr, *arrayPtr; /* * Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } return TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags, -1); } /* *---------------------------------------------------------------------- * * TclPtrGetVar -- * * Return the value of a Tcl variable as a Tcl object, given the pointers * to the variable's (and possibly containing array's) VAR structure. * * Results: * The return value points to the current object value of the variable * given by varPtr. If the specified variable doesn't exist, or if there * is a clash in array usage, then NULL is returned and a message will be * left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set. * * Side effects: * The ref count for the returned object is _not_ incremented to reflect * the returned reference; if you want to keep a reference to the object * you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrGetVar( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Tcl_Var varPtr, /* The variable to be read.*/ Tcl_Var arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { if (varPtr == NULL) { Tcl_Panic("varPtr must not be NULL"); } if (part1Ptr == NULL) { Tcl_Panic("part1Ptr must not be NULL"); } return TclPtrGetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr, part1Ptr, part2Ptr, flags, -1); } /* *---------------------------------------------------------------------- * * TclPtrGetVarIdx -- * * Return the value of a Tcl variable as a Tcl object, given the pointers * to the variable's (and possibly containing array's) VAR structure. * * Results: * The return value points to the current object value of the variable * given by varPtr. If the specified variable doesn't exist, or if there * is a clash in array usage, then NULL is returned and a message will be * left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set. * * Side effects: * The ref count for the returned object is _not_ incremented to reflect * the returned reference; if you want to keep a reference to the object * you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Var *varPtr, /* The variable to be read.*/ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { Interp *iPtr = (Interp *) interp; const char *msg; /* * Invoke any read traces that have been set for the variable. */ if ((varPtr->flags & VAR_TRACED_READ) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) { if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr, (flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY)) | TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) { goto errorReturn; } } /* * Return the element if it's an existing scalar variable. */ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) { return varPtr->value.objPtr; } if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarUndefined(varPtr) && arrayPtr && !TclIsVarUndefined(arrayPtr)) { msg = NOSUCHELEMENT; } else if (TclIsVarArray(varPtr)) { msg = ISARRAY; } else { msg = NOSUCHVAR; } TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index); } /* * An error. If the variable doesn't exist anymore and no-one's using it, * then free up the relevant structures and hash table entries. */ errorReturn: Tcl_SetErrorCode(interp, "TCL", "READ", "VARNAME", NULL); if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); } return NULL; } /* *---------------------------------------------------------------------- * * Tcl_SetObjCmd -- * * This function is invoked to process the "set" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result value. * * Side effects: * A variable's value may be changed. * *---------------------------------------------------------------------- */ int Tcl_SetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varValueObj; if (objc == 2) { varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG); if (varValueObj == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, varValueObj); return TCL_OK; } else if (objc == 3) { varValueObj = Tcl_ObjSetVar2(interp, objv[1], NULL, objv[2], TCL_LEAVE_ERR_MSG); if (varValueObj == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, varValueObj); return TCL_OK; } else { Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?"); return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * Tcl_SetVar -- * * Change the value of a variable. * * Results: * Returns a pointer to the malloc'ed string which is the character * representation of the variable's new value. The caller must not modify * this string. If the write operation was disallowed then NULL is * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory * message will be left in the interp's result. Note that the returned * string may not be the same as newValue; this is because variable * traces may modify the variable's value. * * Side effects: * If varName is defined as a local or global variable in interp, its * value is changed to newValue. If varName isn't currently defined, then * a new global variable by that name is created. * *---------------------------------------------------------------------- */ #undef Tcl_SetVar const char * Tcl_SetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ const char *varName, /* Name of a variable in interp. */ const char *newValue, /* New value for varName. */ int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ { Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(varNamePtr); varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, Tcl_NewStringObj(newValue, -1), flags); Tcl_DecrRefCount(varNamePtr); if (varValuePtr == NULL) { return NULL; } return TclGetString(varValuePtr); } /* *---------------------------------------------------------------------- * * Tcl_SetVar2 -- * * Given a two-part variable name, which may refer either to a scalar * variable or an element of an array, change the value of the variable. * If the named scalar or array or element doesn't exist then create one. * * Results: * Returns a pointer to the malloc'ed string which is the character * representation of the variable's new value. The caller must not modify * this string. If the write operation was disallowed because an array * was expected but not found (or vice versa), then NULL is returned; if * the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be * left in the interp's result. Note that the returned string may not be * the same as newValue; this is because variable traces may modify the * variable's value. * * Side effects: * The value of the given variable is set. If either the array or the * entry didn't exist then a new one is created. * *---------------------------------------------------------------------- */ const char * Tcl_SetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ const char *part1, /* If part2 is NULL, this is name of scalar * variable. Otherwise it is the name of an * array. */ const char *part2, /* Name of an element within an array, or * NULL. */ const char *newValue, /* New value for variable. */ int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or * TCL_LEAVE_ERR_MSG. */ { Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, Tcl_NewStringObj(newValue, -1), flags); if (varValuePtr == NULL) { return NULL; } return TclGetString(varValuePtr); } /* *---------------------------------------------------------------------- * * Tcl_SetVar2Ex -- * * Given a two-part variable name, which may refer either to a scalar * variable or an element of an array, change the value of the variable * to a new Tcl object value. If the named scalar or array or element * doesn't exist then create one. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the write operation was disallowed because an array was * expected but not found (or vice versa), then NULL is returned; if the * TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be * left in the interpreter's result. Note that the returned object may * not be the same one referenced by newValuePtr; this is because * variable traces may modify the variable's value. * * Side effects: * The value of the given variable is set. If either the array or the * entry didn't exist then a new variable is created. * * The reference count is decremented for any old value of the variable * and incremented for its new value. If the new value for the variable * is not the same one referenced by newValuePtr (perhaps as a result of * a variable trace), then newValuePtr's ref count is left unchanged by * Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if we * are appending it as a string value: that is, if "flags" includes * TCL_APPEND_VALUE but not TCL_LIST_ELEMENT. * * The reference count for the returned object is _not_ incremented: if * you want to keep a reference to the object you must increment its ref * count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_SetVar2Ex( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ const char *part1, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ const char *part2, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or * TCL_LEAVE_ERR_MSG. */ { Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); Tcl_IncrRefCount(part1Ptr); if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); Tcl_IncrRefCount(part2Ptr); } resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags); Tcl_DecrRefCount(part1Ptr); if (part2Ptr) { Tcl_DecrRefCount(part2Ptr); } return resPtr; } /* *---------------------------------------------------------------------- * * Tcl_ObjSetVar2 -- * * This function is the same as Tcl_SetVar2Ex above, except the variable * names are passed in Tcl object instead of strings. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the write operation was disallowed because an array was * expected but not found (or vice versa), then NULL is returned; if the * TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be * left in the interpreter's result. Note that the returned object may * not be the same one referenced by newValuePtr; this is because * variable traces may modify the variable's value. * * Side effects: * The value of the given variable is set. If either the array or the * entry didn't exist then a new variable is created. * Callers must Incr part1Ptr if they plan to Decr it. * Callers must Incr part2Ptr if they plan to Decr it. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjSetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *newValuePtr, /* New value for variable. */ int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; /* * Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG |TCL_APPEND_VALUE|TCL_LIST_ELEMENT); varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { if (newValuePtr->refCount == 0) { Tcl_DecrRefCount(newValuePtr); } return NULL; } return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, newValuePtr, flags, -1); } /* *---------------------------------------------------------------------- * * TclPtrSetVar -- * * This function is the same as Tcl_SetVar2Ex above, except that it * requires pointers to the variable's Var structs in addition to the * variable names. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the write operation was disallowed because an array was * expected but not found (or vice versa), then NULL is returned; if the * TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be * left in the interpreter's result. Note that the returned object may * not be the same one referenced by newValuePtr; this is because * variable traces may modify the variable's value. * * Side effects: * The value of the given variable is set. If either the array or the * entry didn't exist then a new variable is created. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrSetVar( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Tcl_Var varPtr, /* Reference to the variable to set. */ Tcl_Var arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { if (varPtr == NULL) { Tcl_Panic("varPtr must not be NULL"); } if (part1Ptr == NULL) { Tcl_Panic("part1Ptr must not be NULL"); } if (newValuePtr == NULL) { Tcl_Panic("newValuePtr must not be NULL"); } return TclPtrSetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr, part1Ptr, part2Ptr, newValuePtr, flags, -1); } /* *---------------------------------------------------------------------- * * TclPtrSetVarIdx -- * * This function is the same as Tcl_SetVar2Ex above, except that it * requires pointers to the variable's Var structs in addition to the * variable names. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the write operation was disallowed because an array was * expected but not found (or vice versa), then NULL is returned; if the * TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be * left in the interpreter's result. Note that the returned object may * not be the same one referenced by newValuePtr; this is because * variable traces may modify the variable's value. * * Side effects: * The value of the given variable is set. If either the array or the * entry didn't exist then a new variable is created. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrSetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Var *varPtr, /* Reference to the variable to set. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. NULL if the 'index' * parameter is >= 0 */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ int index) /* Index of local var where part1 is to be * found. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldValuePtr; Tcl_Obj *resultPtr = NULL; int result; int cleanupOnEarlyError = (newValuePtr->refCount == 0); /* * If the variable is in a hashtable and its hPtr field is NULL, then we * may have an upvar to an array element where the array was deleted or an * upvar to a namespace variable whose namespace was deleted. Generate an * error (allowing the variable to be reset would screw up our storage * allocation and is meaningless anyway). */ if (TclIsVarDeadHash(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArrayElement(varPtr)) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", DANGLINGELEMENT, index); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL); } else { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", DANGLINGVAR, index); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL); } } goto earlyError; } /* * It's an error to try to set an array variable itself. */ if (TclIsVarArray(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index); Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL); } goto earlyError; } /* * Invoke any read traces that have been set for the variable if it is * requested. This was done for INST_LAPPEND_* but that was inconsistent * with the non-bc instruction, and would cause failures trying to * lappend to any non-existing ::env var, which is inconsistent with * documented behavior. [Bug #3057639]. */ if ((flags & TCL_TRACE_READS) && ((varPtr->flags & VAR_TRACED_READ) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ)))) { if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) { goto earlyError; } } /* * Set the variable's new value. If appending, append the new value to the * variable, either as a list element or as a string. Also, if appending, * then if the variable's old value is unshared we can modify it directly, * otherwise we must create a new copy to modify: this is "copy on write". */ oldValuePtr = varPtr->value.objPtr; if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) { varPtr->value.objPtr = NULL; } if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) { if (flags & TCL_LIST_ELEMENT) { /* Append list element. */ if (oldValuePtr == NULL) { TclNewObj(oldValuePtr); varPtr->value.objPtr = oldValuePtr; Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */ } else if (Tcl_IsShared(oldValuePtr)) { varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */ } result = Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr); if (result != TCL_OK) { goto earlyError; } } else { /* Append string. */ /* * We append newValuePtr's bytes but don't change its ref count. */ if (oldValuePtr == NULL) { varPtr->value.objPtr = newValuePtr; Tcl_IncrRefCount(newValuePtr); } else { if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */ varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr); TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */ } Tcl_AppendObjToObj(oldValuePtr, newValuePtr); if (newValuePtr->refCount == 0) { Tcl_DecrRefCount(newValuePtr); } } } } else if (newValuePtr != oldValuePtr) { /* * In this case we are replacing the value, so we don't need to do * more than swap the objects. */ varPtr->value.objPtr = newValuePtr; Tcl_IncrRefCount(newValuePtr); /* Var is another ref. */ if (oldValuePtr != NULL) { TclDecrRefCount(oldValuePtr); /* Discard old value. */ } } /* * Invoke any write traces for the variable. */ if ((varPtr->flags & VAR_TRACED_WRITE) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_WRITE))) { if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG), index)) { goto cleanup; } } /* * Return the variable's value unless the variable was changed in some * gross way by a trace (e.g. it was unset and then recreated as an * array). */ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) { return varPtr->value.objPtr; } /* * A trace changed the value in some gross way. Return an empty string * object. */ resultPtr = iPtr->emptyObjPtr; /* * If the variable doesn't exist anymore and no-one's using it, then free * up the relevant structures and hash table entries. */ cleanup: if (resultPtr == NULL) { Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", NULL); } if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); } return resultPtr; earlyError: if (cleanupOnEarlyError) { Tcl_DecrRefCount(newValuePtr); } goto cleanup; } /* *---------------------------------------------------------------------- * * TclIncrObjVar2 -- * * Given a two-part variable name, which may refer either to a scalar * variable or an element of an array, increment the Tcl object value of * the variable by a specified Tcl_Obj increment value. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the specified variable doesn't exist, or there is a clash * in array usage, or an error occurs while executing variable traces, * then NULL is returned and a message will be left in the interpreter's * result. * * Side effects: * The value of the given variable is incremented by the specified * amount. If either the array or the entry didn't exist then a new * variable is created. The ref count for the returned object is _not_ * incremented to reflect the returned reference; if you want to keep a * reference to the object you must increment its ref count yourself. * Callers must Incr part1Ptr if they plan to Decr it. * Callers must Incr part2Ptr if they plan to Decr it. * *---------------------------------------------------------------------- */ Tcl_Obj * TclIncrObjVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *incrPtr, /* Amount to be added to variable. */ int flags) /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read", 1, 1, &arrayPtr); if (varPtr == NULL) { Tcl_AddErrorInfo(interp, "\n (reading value of variable to increment)"); return NULL; } return TclPtrIncrObjVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, incrPtr, flags, -1); } /* *---------------------------------------------------------------------- * * TclPtrIncrObjVar -- * * Given the pointers to a variable and possible containing array, * increment the Tcl object value of the variable by a Tcl_Obj increment. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the specified variable doesn't exist, or there is a clash * in array usage, or an error occurs while executing variable traces, * then NULL is returned and a message will be left in the interpreter's * result. * * Side effects: * The value of the given variable is incremented by the specified * amount. If either the array or the entry didn't exist then a new * variable is created. The ref count for the returned object is _not_ * incremented to reflect the returned reference; if you want to keep a * reference to the object you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrIncrObjVar( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ Tcl_Var varPtr, /* Reference to the variable to set. */ Tcl_Var arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ int flags) /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ { if (varPtr == NULL) { Tcl_Panic("varPtr must not be NULL"); } if (part1Ptr == NULL) { Tcl_Panic("part1Ptr must not be NULL"); } return TclPtrIncrObjVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr, part1Ptr, part2Ptr, incrPtr, flags, -1); } /* *---------------------------------------------------------------------- * * TclPtrIncrObjVarIdx -- * * Given the pointers to a variable and possible containing array, * increment the Tcl object value of the variable by a Tcl_Obj increment. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the specified variable doesn't exist, or there is a clash * in array usage, or an error occurs while executing variable traces, * then NULL is returned and a message will be left in the interpreter's * result. * * Side effects: * The value of the given variable is incremented by the specified * amount. If either the array or the entry didn't exist then a new * variable is created. The ref count for the returned object is _not_ * incremented to reflect the returned reference; if you want to keep a * reference to the object you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrIncrObjVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ Var *varPtr, /* Reference to the variable to set. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ int flags, /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { Tcl_Obj *varValuePtr; if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags, index); if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)--; } if (varValuePtr == NULL) { TclNewIntObj(varValuePtr, 0); } if (Tcl_IsShared(varValuePtr)) { /* Copy on write */ varValuePtr = Tcl_DuplicateObj(varValuePtr); if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) { return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, varValuePtr, flags, index); } else { Tcl_DecrRefCount(varValuePtr); return NULL; } } else { /* Unshared - can Incr in place */ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) { /* * This seems dumb to write the incremeted value into the var * after we just adjusted the value in place, but the spec for * [incr] requires that write traces fire, and making this call * is the way to make that happen. */ return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, varValuePtr, flags, index); } else { return NULL; } } } /* *---------------------------------------------------------------------- * * Tcl_UnsetVar -- * * Delete a variable, so that it may not be accessed anymore. * * Results: * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if * the variable can't be unset. In the event of an error, if the * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the * interp's result. * * Side effects: * If varName is defined as a local or global variable in interp, it is * deleted. * *---------------------------------------------------------------------- */ #undef Tcl_UnsetVar int Tcl_UnsetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ const char *varName, /* Name of a variable in interp. May be either * a scalar name or an array name or an * element in an array. */ int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or * TCL_LEAVE_ERR_MSG. */ { int result; Tcl_Obj *varNamePtr; varNamePtr = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(varNamePtr); /* * Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags); Tcl_DecrRefCount(varNamePtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_UnsetVar2 -- * * Delete a variable, given a 2-part name. * * Results: * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if * the variable can't be unset. In the event of an error, if the * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the * interp's result. * * Side effects: * If part1 and part2 indicate a local or global variable in interp, it * is deleted. If part1 is an array name and part2 is NULL, then the * whole array is deleted. * *---------------------------------------------------------------------- */ int Tcl_UnsetVar2( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ const char *part1, /* Name of variable or array. */ const char *part2, /* Name of element within array or NULL. */ int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { int result; Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); } /* * Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); result = TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags); Tcl_DecrRefCount(part1Ptr); if (part2Ptr) { Tcl_DecrRefCount(part2Ptr); } return result; } /* *---------------------------------------------------------------------- * * TclObjUnsetVar2 -- * * Delete a variable, given a 2-object name. * * Results: * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if * the variable can't be unset. In the event of an error, if the * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the * interp's result. * * Side effects: * If part1ptr and part2Ptr indicate a local or global variable in * interp, it is deleted. If part1Ptr is an array name and part2Ptr is * NULL, then the whole array is deleted. * *---------------------------------------------------------------------- */ int TclObjUnsetVar2( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ Tcl_Obj *part1Ptr, /* Name of variable or array. */ Tcl_Obj *part2Ptr, /* Name of element within array or NULL. */ int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset", /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } return TclPtrUnsetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags, -1); } /* *---------------------------------------------------------------------- * * TclPtrUnsetVar -- * * Delete a variable, given the pointers to the variable's (and possibly * containing array's) VAR structure. * * Results: * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if * the variable can't be unset. In the event of an error, if the * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the * interp's result. * * Side effects: * If varPtr and arrayPtr indicate a local or global variable in interp, * it is deleted. If varPtr is an array reference and part2Ptr is NULL, * then the whole array is deleted. * *---------------------------------------------------------------------- */ int TclPtrUnsetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ Tcl_Var varPtr, /* The variable to be unset. */ Tcl_Var arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { if (varPtr == NULL) { Tcl_Panic("varPtr must not be NULL"); } if (part1Ptr == NULL) { Tcl_Panic("part1Ptr must not be NULL"); } return TclPtrUnsetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr, part1Ptr, part2Ptr, flags, -1); } /* *---------------------------------------------------------------------- * * TclPtrUnsetVarIdx -- * * Delete a variable, given the pointers to the variable's (and possibly * containing array's) VAR structure. * * Results: * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if * the variable can't be unset. In the event of an error, if the * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the * interp's result. * * Side effects: * If varPtr and arrayPtr indicate a local or global variable in interp, * it is deleted. If varPtr is an array reference and part2Ptr is NULL, * then the whole array is deleted. * *---------------------------------------------------------------------- */ int TclPtrUnsetVarIdx( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ Var *varPtr, /* The variable to be unset. */ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ int flags, /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { Interp *iPtr = (Interp *) interp; int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK); /* * Keep the variable alive until we're done with it. We used to * increase/decrease the refCount for each operation, making it hard to * find [Bug 735335] - caused by unsetting the variable whose value was * the variable's name. */ if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index); /* * It's an error to unset an undefined variable. */ if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ((arrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index); Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL); } } /* * Finally, if the variable is truly not in use then free up its Var * structure and remove it from its hash table, if any. The ref count of * its value object, if any, was decremented above. */ if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)--; CleanupVar(varPtr, arrayPtr); } return result; } /* *---------------------------------------------------------------------- * * UnsetVarStruct -- * * Unset and delete a variable. This does the internal work for * TclObjUnsetVar2 and TclDeleteNamespaceVars, which call here for each * variable to be unset and deleted. * * Results: * None. * * Side effects: * If the arguments indicate a local or global variable in iPtr, it is * unset and deleted. * *---------------------------------------------------------------------- */ static void UnsetVarStruct( Var *varPtr, Var *arrayPtr, Interp *iPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, int index) { Var dummyVar; int traced = TclIsVarTraced(varPtr) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET)); if (arrayPtr && (arrayPtr->flags & VAR_SEARCH_ACTIVE)) { DeleteSearches(iPtr, arrayPtr); } else if (varPtr->flags & VAR_SEARCH_ACTIVE) { DeleteSearches(iPtr, varPtr); } /* * The code below is tricky, because of the possibility that a trace * function might try to access a variable being deleted. To handle this * situation gracefully, do things in three steps: * 1. Copy the contents of the variable to a dummy variable structure, and * mark the original Var structure as undefined. * 2. Invoke traces and clean up the variable, using the dummy copy. * 3. If at the end of this the original variable is still undefined and * has no outstanding references, then delete it (but it could have * gotten recreated by a trace). */ dummyVar = *varPtr; dummyVar.flags &= ~VAR_ALL_HASH; TclSetVarUndefined(varPtr); /* * Call trace functions for the variable being deleted. Then delete its * traces. Be sure to abort any other traces for the variable that are * still pending. Special tricks: * 1. We need to increment varPtr's refCount around this: TclCallVarTraces * will use dummyVar so it won't increment varPtr's refCount itself. * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call * unset traces even if other traces are pending. */ if (traced) { VarTrace *tracePtr = NULL; Tcl_HashEntry *tPtr; if (TclIsVarTraced(&dummyVar)) { /* * Transfer any existing traces on var, IF there are unset traces. * Otherwise just delete them. */ int isNew; tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); varPtr->flags &= ~VAR_ALL_TRACES; Tcl_DeleteHashEntry(tPtr); if (dummyVar.flags & VAR_TRACED_UNSET) { tPtr = Tcl_CreateHashEntry(&iPtr->varTraces, &dummyVar, &isNew); Tcl_SetHashValue(tPtr, tracePtr); } } if ((dummyVar.flags & VAR_TRACED_UNSET) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) { dummyVar.flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0, index); /* * The traces that we just called may have triggered a change in * the set of traces. If so, reload the traces to manipulate. */ tracePtr = NULL; if (TclIsVarTraced(&dummyVar)) { tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar); if (tPtr) { tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); Tcl_DeleteHashEntry(tPtr); } } } if (tracePtr) { ActiveVarTrace *activePtr; while (tracePtr) { VarTrace *prevPtr = tracePtr; tracePtr = tracePtr->nextPtr; prevPtr->nextPtr = NULL; Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } } dummyVar.flags &= ~VAR_ALL_TRACES; } } if (TclIsVarScalar(&dummyVar) && (dummyVar.value.objPtr != NULL)) { /* * Decrement the ref count of the var's value. */ Tcl_Obj *objPtr = dummyVar.value.objPtr; TclDecrRefCount(objPtr); } else if (TclIsVarArray(&dummyVar)) { /* * If the variable is an array, delete all of its elements. This must * be done after calling and deleting the traces on the array, above * (that's the way traces are defined). If the array name is not * present and is required for a trace on some element, it will be * computed at DeleteArray. */ DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS, index); } else if (TclIsVarLink(&dummyVar)) { /* * For global/upvar variables referenced in procedures, decrement the * reference count on the variable referred to, and free the * referenced variable if it's no longer needed. */ Var *linkPtr = dummyVar.value.linkPtr; if (TclIsVarInHash(linkPtr)) { VarHashRefCount(linkPtr)--; CleanupVar(linkPtr, NULL); } } /* * If the variable was a namespace variable, decrement its reference * count. */ TclClearVarNamespaceVar(varPtr); } /* *---------------------------------------------------------------------- * * Tcl_UnsetObjCmd -- * * This object-based function is invoked to process the "unset" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_UnsetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, flags = TCL_LEAVE_ERR_MSG; const char *name; if (objc == 1) { /* * Do nothing if no arguments supplied, so as to match command * documentation. */ return TCL_OK; } /* * Simple, restrictive argument parsing. The only options are -- and * -nocomplain (which must come first and be given exactly to be an * option). */ i = 1; name = TclGetString(objv[i]); if (name[0] == '-') { if (strcmp("-nocomplain", name) == 0) { i++; if (i == objc) { return TCL_OK; } flags = 0; name = TclGetString(objv[i]); } if (strcmp("--", name) == 0) { i++; } } for (; i < objc; i++) { if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK) && (flags == TCL_LEAVE_ERR_MSG)) { return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_AppendObjCmd -- * * This object-based function is invoked to process the "append" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * A variable's value may be changed. * *---------------------------------------------------------------------- */ int Tcl_AppendObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; Tcl_Obj *varValuePtr = NULL; /* Initialized to avoid compiler warning. */ int i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?"); return TCL_ERROR; } if (objc == 2) { varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { return TCL_ERROR; } } else { varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } for (i=2 ; iemptyObjPtr)) { return TCL_ERROR; } } } Tcl_SetObjResult(interp, varValuePtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LappendObjCmd -- * * This object-based function is invoked to process the "lappend" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * A variable's value may be changed. * *---------------------------------------------------------------------- */ int Tcl_LappendObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varValuePtr, *newValuePtr; int numElems, createdNewObj; Var *varPtr, *arrayPtr; int result; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?"); return TCL_ERROR; } if (objc == 2) { newValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (newValuePtr == NULL) { /* * The variable doesn't exist yet. Just create it with an empty * initial value. */ TclNewObj(varValuePtr); newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr, TCL_LEAVE_ERR_MSG); if (newValuePtr == NULL) { return TCL_ERROR; } } else { result = TclListObjLength(interp, newValuePtr, &numElems); if (result != TCL_OK) { return result; } } } else { /* * We have arguments to append. We used to call Tcl_SetVar2 to append * each argument one at a time to ensure that traces were run for each * append step. We now append the arguments all at once because it's * faster. Note that a read trace and a write trace for the variable * will now each only be called once. Also, if the variable's old * value is unshared we modify it directly, otherwise we create a new * copy to modify: this is "copy on write". */ createdNewObj = 0; /* * Protect the variable pointers around the TclPtrGetVarIdx call * to insure that they remain valid even if the variable was undefined * and unused. */ varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } if (arrayPtr && TclIsVarInHash(arrayPtr)) { VarHashRefCount(arrayPtr)++; } varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, objv[1], NULL, TCL_LEAVE_ERR_MSG, -1); if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)--; } if (arrayPtr && TclIsVarInHash(arrayPtr)) { VarHashRefCount(arrayPtr)--; } if (varValuePtr == NULL) { /* * We couldn't read the old value: either the var doesn't yet * exist or it's an array element. If it's new, we will try to * create it with Tcl_ObjSetVar2 below. */ TclNewObj(varValuePtr); createdNewObj = 1; } else if (Tcl_IsShared(varValuePtr)) { varValuePtr = Tcl_DuplicateObj(varValuePtr); createdNewObj = 1; } result = TclListObjLength(interp, varValuePtr, &numElems); if (result == TCL_OK) { result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0, (objc-2), (objv+2)); } if (result != TCL_OK) { if (createdNewObj) { TclDecrRefCount(varValuePtr); /* Free unneeded obj. */ } return result; } /* * Now store the list object back into the variable. If there is an * error setting the new value, decrement its ref count if it was new * and we didn't create the variable. */ newValuePtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, objv[1], NULL, varValuePtr, TCL_LEAVE_ERR_MSG, -1); if (newValuePtr == NULL) { return TCL_ERROR; } } /* * Set the interpreter's object result to refer to the variable's value * object. */ Tcl_SetObjResult(interp, newValuePtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArrayStartSearchCmd -- * * This object-based function is invoked to process the "array * startsearch" Tcl command. See the user documentation for details on * what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArrayStartSearchCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *)interp; Var *varPtr; Tcl_HashEntry *hPtr; int isNew, isArray; ArraySearch *searchPtr; const char *varName; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName"); return TCL_ERROR; } if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) { return TCL_ERROR; } if (!isArray) { return NotArrayError(interp, objv[1]); } /* * Make a new array search with a free name. */ varName = TclGetString(objv[1]); searchPtr = ckalloc(sizeof(ArraySearch)); hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew); if (isNew) { searchPtr->id = 1; varPtr->flags |= VAR_SEARCH_ACTIVE; searchPtr->nextPtr = NULL; } else { searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1; searchPtr->nextPtr = Tcl_GetHashValue(hPtr); } searchPtr->varPtr = varPtr; searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr, &searchPtr->search); Tcl_SetHashValue(hPtr, searchPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf("s-%d-%s", searchPtr->id, varName)); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArrayAnyMoreCmd -- * * This object-based function is invoked to process the "array anymore" * Tcl command. See the user documentation for details on what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArrayAnyMoreCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *)interp; Var *varPtr; Tcl_Obj *varNameObj, *searchObj; int gotValue, isArray; ArraySearch *searchPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId"); return TCL_ERROR; } varNameObj = objv[1]; searchObj = objv[2]; if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) { return TCL_ERROR; } if (!isArray) { return NotArrayError(interp, varNameObj); } /* * Get the search. */ searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj); if (searchPtr == NULL) { return TCL_ERROR; } /* * Scan forward to find if there are any further elements in the array * that are defined. */ while (1) { if (searchPtr->nextEntry != NULL) { varPtr = VarHashGetValue(searchPtr->nextEntry); if (!TclIsVarUndefined(varPtr)) { gotValue = 1; break; } } searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search); if (searchPtr->nextEntry == NULL) { gotValue = 0; break; } } Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[gotValue]); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArrayNextElementCmd -- * * This object-based function is invoked to process the "array * nextelement" Tcl command. See the user documentation for details on * what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArrayNextElementCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr; Tcl_Obj *varNameObj, *searchObj; ArraySearch *searchPtr; int isArray; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId"); return TCL_ERROR; } varNameObj = objv[1]; searchObj = objv[2]; if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) { return TCL_ERROR; } if (!isArray) { return NotArrayError(interp, varNameObj); } /* * Get the search. */ searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj); if (searchPtr == NULL) { return TCL_ERROR; } /* * Get the next element from the search, or the empty string on * exhaustion. Note that the [array anymore] command may well have already * pulled a value from the hash enumeration, so we have to check the cache * there first. */ while (1) { Tcl_HashEntry *hPtr = searchPtr->nextEntry; if (hPtr == NULL) { hPtr = Tcl_NextHashEntry(&searchPtr->search); if (hPtr == NULL) { return TCL_OK; } } else { searchPtr->nextEntry = NULL; } varPtr = VarHashGetValue(hPtr); if (!TclIsVarUndefined(varPtr)) { Tcl_SetObjResult(interp, VarHashGetKey(varPtr)); return TCL_OK; } } } /* *---------------------------------------------------------------------- * * ArrayDoneSearchCmd -- * * This object-based function is invoked to process the "array * donesearch" Tcl command. See the user documentation for details on * what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArrayDoneSearchCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *)interp; Var *varPtr; Tcl_HashEntry *hPtr; Tcl_Obj *varNameObj, *searchObj; ArraySearch *searchPtr, *prevPtr; int isArray; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId"); return TCL_ERROR; } varNameObj = objv[1]; searchObj = objv[2]; if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) { return TCL_ERROR; } if (!isArray) { return NotArrayError(interp, varNameObj); } /* * Get the search. */ searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj); if (searchPtr == NULL) { return TCL_ERROR; } /* * Unhook the search from the list of searches associated with the * variable. */ hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr); if (searchPtr == Tcl_GetHashValue(hPtr)) { if (searchPtr->nextPtr) { Tcl_SetHashValue(hPtr, searchPtr->nextPtr); } else { varPtr->flags &= ~VAR_SEARCH_ACTIVE; Tcl_DeleteHashEntry(hPtr); } } else { for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) { if (prevPtr->nextPtr == searchPtr) { prevPtr->nextPtr = searchPtr->nextPtr; break; } } } ckfree(searchPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArrayExistsCmd -- * * This object-based function is invoked to process the "array exists" * Tcl command. See the user documentation for details on what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArrayExistsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *)interp; int isArray; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName"); return TCL_ERROR; } if (TCL_ERROR == LocateArray(interp, objv[1], NULL, &isArray)) { return TCL_ERROR; } Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[isArray]); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArrayGetCmd -- * * This object-based function is invoked to process the "array get" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArrayGetCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr, *varPtr2; Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj; Tcl_Obj **nameObjPtr, *patternObj; Tcl_HashSearch search; const char *pattern; int i, count, result, isArray; switch (objc) { case 2: varNameObj = objv[1]; patternObj = NULL; break; case 3: varNameObj = objv[1]; patternObj = objv[2]; break; default: Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?"); return TCL_ERROR; } if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) { return TCL_ERROR; } /* If not an array, it's an empty result. */ if (!isArray) { return TCL_OK; } pattern = (patternObj ? TclGetString(patternObj) : NULL); /* * Store the array names in a new object. */ TclNewObj(nameLstObj); Tcl_IncrRefCount(nameLstObj); if ((patternObj != NULL) && TclMatchIsTrivial(pattern)) { varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj); if (varPtr2 == NULL) { goto searchDone; } if (TclIsVarUndefined(varPtr2)) { goto searchDone; } result = Tcl_ListObjAppendElement(interp, nameLstObj, VarHashGetKey(varPtr2)); if (result != TCL_OK) { TclDecrRefCount(nameLstObj); return result; } goto searchDone; } for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search); varPtr2; varPtr2 = VarHashNextVar(&search)) { if (TclIsVarUndefined(varPtr2)) { continue; } nameObj = VarHashGetKey(varPtr2); if (patternObj && !Tcl_StringMatch(TclGetString(nameObj), pattern)) { continue; /* Element name doesn't match pattern. */ } result = Tcl_ListObjAppendElement(interp, nameLstObj, nameObj); if (result != TCL_OK) { TclDecrRefCount(nameLstObj); return result; } } /* * Make sure the Var structure of the array is not removed by a trace * while we're working. */ searchDone: if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } /* * Get the array values corresponding to each element name. */ TclNewObj(tmpResObj); result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr); if (result != TCL_OK) { goto errorInArrayGet; } for (i=0 ; i 4)) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?"); return TCL_ERROR; } patternObj = (objc > 2 ? objv[objc-1] : NULL); if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) { return TCL_ERROR; } /* * Finish parsing the arguments. */ if ((objc == 4) && Tcl_GetIndexFromObj(interp, objv[2], options, "option", 0, &mode) != TCL_OK) { return TCL_ERROR; } /* If not an array, the result is empty. */ if (!isArray) { return TCL_OK; } /* * Check for the trivial cases where we can use a direct lookup. */ TclNewObj(resultObj); if (patternObj) { pattern = TclGetString(patternObj); } if ((mode==OPT_GLOB && patternObj && TclMatchIsTrivial(pattern)) || (mode==OPT_EXACT)) { varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj); if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) { /* * This can't fail; lappending to an empty object always works. */ Tcl_ListObjAppendElement(NULL, resultObj, VarHashGetKey(varPtr2)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * Must scan the array to select the elements. */ for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search); varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) { if (TclIsVarUndefined(varPtr2)) { continue; } nameObj = VarHashGetKey(varPtr2); if (patternObj) { const char *name = TclGetString(nameObj); int matched = 0; switch ((enum arrayNamesOptionsEnum) mode) { case OPT_EXACT: Tcl_Panic("exact matching shouldn't get here"); case OPT_GLOB: matched = Tcl_StringMatch(name, pattern); break; case OPT_REGEXP: matched = Tcl_RegExpMatchObj(interp, nameObj, patternObj); if (matched < 0) { TclDecrRefCount(resultObj); return TCL_ERROR; } break; } if (matched == 0) { continue; } } Tcl_ListObjAppendElement(NULL, resultObj, nameObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclFindArrayPtrElements -- * * Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry * for each existing element of the given array. The provided hash table * is assumed to be initially empty. * * Result: * none * * Side effects: * The keys of the array gain an extra reference. The supplied hash table * has elements added to it. * *---------------------------------------------------------------------- */ void TclFindArrayPtrElements( Var *arrayPtr, Tcl_HashTable *tablePtr) { Var *varPtr; Tcl_HashSearch search; if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr) || TclIsVarUndefined(arrayPtr)) { return; } for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search); varPtr!=NULL ; varPtr=VarHashNextVar(&search)) { Tcl_HashEntry *hPtr; Tcl_Obj *nameObj; int dummy; if (TclIsVarUndefined(varPtr)) { continue; } nameObj = VarHashGetKey(varPtr); hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy); Tcl_SetHashValue(hPtr, nameObj); } } /* *---------------------------------------------------------------------- * * ArraySetCmd -- * * This object-based function is invoked to process the "array set" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArraySetCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *arrayNameObj; Tcl_Obj *arrayElemObj; Var *varPtr, *arrayPtr; int result, i; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName list"); return TCL_ERROR; } if (TCL_ERROR == LocateArray(interp, objv[1], NULL, NULL)) { return TCL_ERROR; } arrayNameObj = objv[1]; varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } if (arrayPtr) { CleanupVar(varPtr, arrayPtr); TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", NEEDARRAY, -1); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", TclGetString(arrayNameObj), NULL); return TCL_ERROR; } /* * Install the contents of the dictionary or list into the array. */ arrayElemObj = objv[2]; if (arrayElemObj->typePtr == &tclDictType && arrayElemObj->bytes == NULL) { Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done; if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) { return TCL_ERROR; } if (done == 0) { /* * Empty, so we'll just force the array to be properly existing * instead. */ goto ensureArray; } /* * Don't need to look at result of Tcl_DictObjFirst as we've just * successfully used a dictionary operation on the same object. */ for (Tcl_DictObjFirst(interp, arrayElemObj, &search, &keyPtr, &valuePtr, &done) ; !done ; Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) { /* * At this point, it would be nice if the key was directly usable * by the array. This isn't the case though. */ Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj, keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1); if ((elemVarPtr == NULL) || (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj, keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) { Tcl_DictObjDone(&search); return TCL_ERROR; } } return TCL_OK; } else { /* * Not a dictionary, so assume (and convert to, for backward- * -compatibility reasons) a list. */ int elemLen; Tcl_Obj **elemPtrs, *copyListObj; result = TclListObjGetElements(interp, arrayElemObj, &elemLen, &elemPtrs); if (result != TCL_OK) { return result; } if (elemLen & 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "list must have an even number of elements", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL); return TCL_ERROR; } if (elemLen == 0) { goto ensureArray; } /* * We needn't worry about traces invalidating arrayPtr: should that be * the case, TclPtrSetVarIdx will return NULL so that we break out of * the loop and return an error. */ copyListObj = TclListObjCopy(NULL, arrayElemObj); for (i=0 ; ivalue.tablePtr = ckalloc(sizeof(TclVarHashTable)); TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr)); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArraySizeCmd -- * * This object-based function is invoked to process the "array size" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArraySizeCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr; Tcl_HashSearch search; Var *varPtr2; int isArray, size = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName"); return TCL_ERROR; } if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) { return TCL_ERROR; } /* We can only iterate over the array if it exists... */ if (isArray) { /* * Must iterate in order to get chance to check for present but * "undefined" entries. */ for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search); varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) { if (!TclIsVarUndefined(varPtr2)) { size++; } } } Tcl_SetObjResult(interp, Tcl_NewIntObj(size)); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArrayStatsCmd -- * * This object-based function is invoked to process the "array * statistics" Tcl command. See the user documentation for details on * what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArrayStatsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr; Tcl_Obj *varNameObj; char *stats; int isArray; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName"); return TCL_ERROR; } varNameObj = objv[1]; if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) { return TCL_ERROR; } if (!isArray) { return NotArrayError(interp, varNameObj); } stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr); if (stats == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "error reading array statistics", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); ckfree(stats); return TCL_OK; } /* *---------------------------------------------------------------------- * * ArrayUnsetCmd -- * * This object-based function is invoked to process the "array unset" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ArrayUnsetCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr, *varPtr2, *protectedVarPtr; Tcl_Obj *varNameObj, *patternObj, *nameObj; Tcl_HashSearch search; const char *pattern; int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */ int isArray; switch (objc) { case 2: varNameObj = objv[1]; patternObj = NULL; break; case 3: varNameObj = objv[1]; patternObj = objv[2]; break; default: Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?"); return TCL_ERROR; } if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) { return TCL_ERROR; } if (!isArray) { return TCL_OK; } if (!patternObj) { /* * When no pattern is given, just unset the whole array. */ return TclObjUnsetVar2(interp, varNameObj, NULL, 0); } /* * With a trivial pattern, we can just unset. */ pattern = TclGetString(patternObj); if (TclMatchIsTrivial(pattern)) { varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj); if (!varPtr2 || TclIsVarUndefined(varPtr2)) { return TCL_OK; } return TclPtrUnsetVarIdx(interp, varPtr2, varPtr, varNameObj, patternObj, unsetFlags, -1); } /* * Non-trivial case (well, deeply tricky really). We peek inside the hash * iterator in order to allow us to guarantee that the following element * in the array will not be scrubbed until we have dealt with it. This * stops the overall iterator from ending up pointing into deallocated * memory. [Bug 2939073] */ protectedVarPtr = NULL; for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search); varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) { /* * Drop the extra ref immediately. We don't need to free it at this * point though; we'll be unsetting it if necessary soon. */ if (varPtr2 == protectedVarPtr) { VarHashRefCount(varPtr2)--; } /* * Guard the next (peeked) item in the search chain by incrementing * its refcount. This guarantees that the hash table iterator won't be * dangling on the next time through the loop. */ if (search.nextEntryPtr != NULL) { protectedVarPtr = VarHashGetValue(search.nextEntryPtr); VarHashRefCount(protectedVarPtr)++; } else { protectedVarPtr = NULL; } /* * If the variable is undefined, clean it out as it has been hit by * something else (i.e., an unset trace). */ if (TclIsVarUndefined(varPtr2)) { CleanupVar(varPtr2, varPtr); continue; } nameObj = VarHashGetKey(varPtr2); if (Tcl_StringMatch(TclGetString(nameObj), pattern) && TclPtrUnsetVarIdx(interp, varPtr2, varPtr, varNameObj, nameObj, unsetFlags, -1) != TCL_OK) { /* * If we incremented a refcount, we must decrement it here as we * will not be coming back properly due to the error. */ if (protectedVarPtr) { VarHashRefCount(protectedVarPtr)--; CleanupVar(protectedVarPtr, varPtr); } return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclInitArrayCmd -- * * This creates the ensemble for the "array" command. * * Results: * The handle for the created ensemble. * * Side effects: * Creates a command in the global namespace. * *---------------------------------------------------------------------- */ Tcl_Command TclInitArrayCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap arrayImplMap[] = { {"anymore", ArrayAnyMoreCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"donesearch", ArrayDoneSearchCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0}, {"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, {"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"set", ArraySetCmd, TclCompileArraySetCmd, NULL, NULL, 0}, {"size", ArraySizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"startsearch", ArrayStartSearchCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"statistics", ArrayStatsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"unset", ArrayUnsetCmd, TclCompileArrayUnsetCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "array", arrayImplMap); } /* *---------------------------------------------------------------------- * * ObjMakeUpvar -- * * This function does all of the work of the "global" and "upvar" * commands. * * Results: * A standard Tcl completion code. If an error occurs then an error * message is left in interp. * * Side effects: * The variable given by myName is linked to the variable in framePtr * given by otherP1 and otherP2, so that references to myName are * redirected to the other variable like a symbolic link. * Callers must Incr myNamePtr if they plan to Decr it. * Callers must Incr otherP1Ptr if they plan to Decr it. * *---------------------------------------------------------------------- */ static int ObjMakeUpvar( Tcl_Interp *interp, /* Interpreter containing variables. Used for * error messages, too. */ CallFrame *framePtr, /* Call frame containing "other" variable. * NULL means use global :: context. */ Tcl_Obj *otherP1Ptr, const char *otherP2, /* Two-part name of variable in framePtr. */ int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of "other" variable. */ Tcl_Obj *myNamePtr, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ int index) /* If the variable to be linked is an indexed * scalar, this is its index. Otherwise, -1 */ { Interp *iPtr = (Interp *) interp; Var *otherPtr, *arrayPtr; CallFrame *varFramePtr; /* * Find "other" in "framePtr". If not looking up other in just the current * namespace, temporarily replace the current var frame pointer in the * interpreter in order to use TclObjLookupVar. */ if (framePtr == NULL) { framePtr = iPtr->rootFramePtr; } varFramePtr = iPtr->varFramePtr; if (!(otherFlags & TCL_NAMESPACE_ONLY)) { iPtr->varFramePtr = framePtr; } otherPtr = TclObjLookupVar(interp, otherP1Ptr, otherP2, (otherFlags | TCL_LEAVE_ERR_MSG), "access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!(otherFlags & TCL_NAMESPACE_ONLY)) { iPtr->varFramePtr = varFramePtr; } if (otherPtr == NULL) { return TCL_ERROR; } /* * Check that we are not trying to create a namespace var linked to a * local variable in a procedure. If we allowed this, the local * variable in the shorter-lived procedure frame could go away leaving * the namespace var's reference invalid. */ if (index < 0) { if (!(arrayPtr != NULL ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr))) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) || !HasLocalVars(varFramePtr) || (strstr(TclGetString(myNamePtr), "::") != NULL))) { Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( "bad variable name \"%s\": can't create namespace " "variable that refers to procedure variable", TclGetString(myNamePtr))); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL); return TCL_ERROR; } } return TclPtrObjMakeUpvarIdx(interp, otherPtr, myNamePtr, myFlags, index); } /* *---------------------------------------------------------------------- * * TclPtrMakeUpvar -- * * This procedure does all of the work of the "global" and "upvar" * commands. * * Results: * A standard Tcl completion code. If an error occurs then an error * message is left in interp. * * Side effects: * The variable given by myName is linked to the variable in framePtr * given by otherP1 and otherP2, so that references to myName are * redirected to the other variable like a symbolic link. * *---------------------------------------------------------------------- */ int TclPtrMakeUpvar( Tcl_Interp *interp, /* Interpreter containing variables. Used for * error messages, too. */ Var *otherPtr, /* Pointer to the variable being linked-to. */ const char *myName, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ int index) /* If the variable to be linked is an indexed * scalar, this is its index. Otherwise, -1 */ { Tcl_Obj *myNamePtr = NULL; int result; if (myName) { myNamePtr = Tcl_NewStringObj(myName, -1); Tcl_IncrRefCount(myNamePtr); } result = TclPtrObjMakeUpvarIdx(interp, otherPtr, myNamePtr, myFlags, index); if (myNamePtr) { Tcl_DecrRefCount(myNamePtr); } return result; } int TclPtrObjMakeUpvar( Tcl_Interp *interp, /* Interpreter containing variables. Used for * error messages, too. */ Tcl_Var otherPtr, /* Pointer to the variable being linked-to. */ Tcl_Obj *myNamePtr, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ int myFlags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ { return TclPtrObjMakeUpvarIdx(interp, (Var *) otherPtr, myNamePtr, myFlags, -1); } /* Callers must Incr myNamePtr if they plan to Decr it. */ int TclPtrObjMakeUpvarIdx( Tcl_Interp *interp, /* Interpreter containing variables. Used for * error messages, too. */ Var *otherPtr, /* Pointer to the variable being linked-to. */ Tcl_Obj *myNamePtr, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ int index) /* If the variable to be linked is an indexed * scalar, this is its index. Otherwise, -1 */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; const char *errMsg, *p, *myName; Var *varPtr; if (index >= 0) { if (!HasLocalVars(varFramePtr)) { Tcl_Panic("ObjMakeUpvar called with an index outside from a proc"); } varPtr = (Var *) &(varFramePtr->compiledLocals[index]); myNamePtr = localName(iPtr->varFramePtr, index); myName = myNamePtr? TclGetString(myNamePtr) : NULL; } else { /* * Do not permit the new variable to look like an array reference, as * it will not be reachable in that case [Bug 600812, TIP 184]. The * "definition" of what "looks like an array reference" is consistent * (and must remain consistent) with the code in TclObjLookupVar(). */ myName = TclGetString(myNamePtr); p = strstr(myName, "("); if (p != NULL) { p += strlen(p)-1; if (*p == ')') { /* * myName looks like an array reference. */ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( "bad variable name \"%s\": can't create a scalar " "variable that looks like an array element", myName)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL); return TCL_ERROR; } } /* * Lookup and eventually create the new variable. Set the flag bit * TCL_AVOID_RESOLVERS to indicate the special resolution rules for * upvar purposes: * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path. * - Bug #631741 - do not use special namespace or interp resolvers. */ varPtr = TclLookupSimpleVar(interp, myNamePtr, myFlags|TCL_AVOID_RESOLVERS, /* create */ 1, &errMsg, &index); if (varPtr == NULL) { TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", TclGetString(myNamePtr), NULL); return TCL_ERROR; } } if (varPtr == otherPtr) { Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj( "can't upvar from variable to itself", -1)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", NULL); return TCL_ERROR; } if (TclIsVarTraced(varPtr)) { Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( "variable \"%s\" has traces: can't use for upvar", myName)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", NULL); return TCL_ERROR; } else if (!TclIsVarUndefined(varPtr)) { Var *linkPtr; /* * The variable already existed. Make sure this variable "varPtr" * isn't the same as "otherPtr" (avoid circular links). Also, if it's * not an upvar then it's an error. If it is an upvar, then just * disconnect it from the thing it currently refers to. */ if (!TclIsVarLink(varPtr)) { Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( "variable \"%s\" already exists", myName)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", NULL); return TCL_ERROR; } linkPtr = varPtr->value.linkPtr; if (linkPtr == otherPtr) { return TCL_OK; } if (TclIsVarInHash(linkPtr)) { VarHashRefCount(linkPtr)--; if (TclIsVarUndefined(linkPtr)) { CleanupVar(linkPtr, NULL); } } } TclSetVarLink(varPtr); varPtr->value.linkPtr = otherPtr; if (TclIsVarInHash(otherPtr)) { VarHashRefCount(otherPtr)++; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_UpVar -- * * This function links one variable to another, just like the "upvar" * command. * * Results: * A standard Tcl completion code. If an error occurs then an error * message is left in the interp's result. * * Side effects: * The variable in frameName whose name is given by varName becomes * accessible under the name localNameStr, so that references to * localNameStr are redirected to the other variable like a symbolic * link. * *---------------------------------------------------------------------- */ #undef Tcl_UpVar int Tcl_UpVar( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ const char *frameName, /* Name of the frame containing the source * variable, such as "1" or "#0". */ const char *varName, /* Name of a variable in interp to link to. * May be either a scalar name or an element * in an array. */ const char *localNameStr, /* Name of link variable. */ int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of localNameStr. */ { int result; CallFrame *framePtr; Tcl_Obj *varNamePtr, *localNamePtr; if (TclGetFrame(interp, frameName, &framePtr) == -1) { return TCL_ERROR; } varNamePtr = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(varNamePtr); localNamePtr = Tcl_NewStringObj(localNameStr, -1); Tcl_IncrRefCount(localNamePtr); result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0, localNamePtr, flags, -1); Tcl_DecrRefCount(varNamePtr); Tcl_DecrRefCount(localNamePtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_UpVar2 -- * * This function links one variable to another, just like the "upvar" * command. * * Results: * A standard Tcl completion code. If an error occurs then an error * message is left in the interp's result. * * Side effects: * The variable in frameName whose name is given by part1 and part2 * becomes accessible under the name localNameStr, so that references to * localNameStr are redirected to the other variable like a symbolic * link. * *---------------------------------------------------------------------- */ int Tcl_UpVar2( Tcl_Interp *interp, /* Interpreter containing variables. Used for * error messages too. */ const char *frameName, /* Name of the frame containing the source * variable, such as "1" or "#0". */ const char *part1, const char *part2, /* Two parts of source variable name to link * to. */ const char *localNameStr, /* Name of link variable. */ int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of localNameStr. */ { int result; CallFrame *framePtr; Tcl_Obj *part1Ptr, *localNamePtr; if (TclGetFrame(interp, frameName, &framePtr) == -1) { return TCL_ERROR; } part1Ptr = Tcl_NewStringObj(part1, -1); Tcl_IncrRefCount(part1Ptr); localNamePtr = Tcl_NewStringObj(localNameStr, -1); Tcl_IncrRefCount(localNamePtr); result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0, localNamePtr, flags, -1); Tcl_DecrRefCount(part1Ptr); Tcl_DecrRefCount(localNamePtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_GetVariableFullName -- * * Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this function * appends to an object the namespace variable's full name, qualified by * a sequence of parent namespace names. * * Results: * None. * * Side effects: * The variable's fully-qualified name is appended to the string * representation of objPtr. * *---------------------------------------------------------------------- */ void Tcl_GetVariableFullName( Tcl_Interp *interp, /* Interpreter containing the variable. */ Tcl_Var variable, /* Token for the variable returned by a * previous call to Tcl_FindNamespaceVar. */ Tcl_Obj *objPtr) /* Points to the object onto which the * variable's full name is appended. */ { Interp *iPtr = (Interp *) interp; Var *varPtr = (Var *) variable; Tcl_Obj *namePtr; Namespace *nsPtr; if (!varPtr || TclIsVarArrayElement(varPtr)) { return; } /* * Add the full name of the containing namespace (if any), followed by the * "::" separator, then the variable name. */ nsPtr = TclGetVarNsPtr(varPtr); if (nsPtr) { Tcl_AppendToObj(objPtr, nsPtr->fullName, -1); if (nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } if (TclIsVarInHash(varPtr)) { if (!TclIsVarDeadHash(varPtr)) { namePtr = VarHashGetKey(varPtr); Tcl_AppendObjToObj(objPtr, namePtr); } } else if (iPtr->varFramePtr->procPtr) { int index = varPtr - iPtr->varFramePtr->compiledLocals; if (index >= 0 && index < iPtr->varFramePtr->numCompiledLocals) { namePtr = localName(iPtr->varFramePtr, index); Tcl_AppendObjToObj(objPtr, namePtr); } } } /* *---------------------------------------------------------------------- * * Tcl_GlobalObjCmd -- * * This object-based function is invoked to process the "global" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_GlobalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *objPtr, *tailPtr; const char *varName; const char *tail; int result, i; /* * If we are not executing inside a Tcl procedure, just return. */ if (!HasLocalVars(iPtr->varFramePtr)) { return TCL_OK; } for (i=1 ; i varName) && ((*tail != ':') || (*(tail-1) != ':'))) { tail--; } if ((*tail == ':') && (tail > varName)) { tail++; } if (tail == varName) { tailPtr = objPtr; } else { tailPtr = Tcl_NewStringObj(tail, -1); Tcl_IncrRefCount(tailPtr); } /* * Link to the variable "varName" in the global :: namespace. */ result = ObjMakeUpvar(interp, NULL, objPtr, NULL, TCL_GLOBAL_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, -1); if (tail != varName) { Tcl_DecrRefCount(tailPtr); } if (result != TCL_OK) { return result; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_VariableObjCmd -- * * Invoked to implement the "variable" command that creates one or more * global variables. Handles the following syntax: * * variable ?name value...? name ?value? * * One or more variables can be created. The variables are initialized * with the specified values. The value for the last variable is * optional. * * If the variable does not exist, it is created and given the optional * value. If it already exists, it is simply set to the optional value. * Normally, "name" is an unqualified name, so it is created in the * current namespace. If it includes namespace qualifiers, it can be * created in another namespace. * * If the variable command is executed inside a Tcl procedure, it creates * a local variable linked to the newly-created namespace variable. * * Results: * Returns TCL_OK if the variable is found or created. Returns TCL_ERROR * if anything goes wrong. * * Side effects: * If anything goes wrong, this function returns an error message as the * result in the interpreter's result object. * *---------------------------------------------------------------------- */ int Tcl_VariableObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *varName, *tail, *cp; Var *varPtr, *arrayPtr; Tcl_Obj *varValuePtr; int i, result; Tcl_Obj *varNamePtr, *tailPtr; for (i=1 ; ivarFramePtr)) { /* * varName might have a scope qualifier, but the name for the * local "link" variable must be the simple name at the tail. * * Locate tail in one pass: drop any prefix after two *or more* * consecutive ":" characters). */ for (tail=cp=varName ; *cp!='\0' ;) { if (*cp++ == ':') { while (*cp == ':') { tail = ++cp; } } } /* * Create a local link "tail" to the variable "varName" in the * current namespace. */ if (tail == varName) { tailPtr = varNamePtr; } else { tailPtr = Tcl_NewStringObj(tail, -1); Tcl_IncrRefCount(tailPtr); } result = ObjMakeUpvar(interp, NULL, varNamePtr, /*otherP2*/ NULL, /*otherFlags*/ TCL_NAMESPACE_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, -1); if (tail != varName) { Tcl_DecrRefCount(tailPtr); } if (result != TCL_OK) { return result; } } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_UpvarObjCmd -- * * This object-based function is invoked to process the "upvar" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_UpvarObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { CallFrame *framePtr; int result, hasLevel; Tcl_Obj *levelObj; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?level? otherVar localVar ?otherVar localVar ...?"); return TCL_ERROR; } if (objc & 1) { /* * Even number of arguments, so use the default level of "1" by * passing NULL to TclObjGetFrame. */ levelObj = NULL; hasLevel = 0; } else { /* * Odd number of arguments, so objv[1] must contain the level. */ levelObj = objv[1]; hasLevel = 1; } /* * Find the call frame containing each of the "other variables" to be * linked to. */ result = TclObjGetFrame(interp, levelObj, &framePtr); if (result == -1) { return TCL_ERROR; } if ((result == 0) && hasLevel) { /* * Synthesize an error message since TclObjGetFrame doesn't do this * for this particular case. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad level \"%s\"", TclGetString(levelObj))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", TclGetString(levelObj), NULL); return TCL_ERROR; } /* * We've now finished with parsing levels; skip to the variable names. */ objc -= hasLevel + 1; objv += hasLevel + 1; /* * Iterate over each (other variable, local variable) pair. Divide the * other variable name into two parts, then call MakeUpvar to do all the * work of linking it to the local variable. */ for (; objc>0 ; objc-=2, objv+=2) { result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0], NULL, 0, /* myVarName */ objv[1], /*flags*/ 0, -1); if (result != TCL_OK) { return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * SetArraySearchObj -- * * This function converts the given tcl object into one that has the * "array search" internal type. * * Results: * TCL_OK if the conversion succeeded, and TCL_ERROR if it failed (when * an error message will be placed in the interpreter's result.) * * Side effects: * Updates the internal type and representation of the object to make * this an array-search object. See the tclArraySearchType declaration * above for details of the internal representation. * *---------------------------------------------------------------------- */ static int SetArraySearchObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { const char *string; char *end; /* Can't be const due to strtoul defn. */ int id; size_t offset; /* * Get the string representation. Make it up-to-date if necessary. */ string = TclGetString(objPtr); /* * Parse the id into the three parts separated by dashes. */ if ((string[0] != 's') || (string[1] != '-')) { goto syntax; } id = strtoul(string+2, &end, 10); if ((end == (string+2)) || (*end != '-')) { goto syntax; } /* * Can't perform value check in this context, so place reference to place * in string to use for the check in the object instead. */ end++; offset = end - string; TclFreeIntRep(objPtr); objPtr->typePtr = &tclArraySearchType; objPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(id); objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(offset); return TCL_OK; syntax: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "illegal search identifier \"%s\"", string)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * ParseSearchId -- * * This function translates from a tcl object to a pointer to an active * array search (if there is one that matches the string). * * Results: * The return value is a pointer to the array search indicated by string, * or NULL if there isn't one. If NULL is returned, the interp's result * contains an error message. * * Side effects: * The tcl object might have its internal type and representation * modified. * *---------------------------------------------------------------------- */ static ArraySearch * ParseSearchId( Tcl_Interp *interp, /* Interpreter containing variable. */ const Var *varPtr, /* Array variable search is for. */ Tcl_Obj *varNamePtr, /* Name of array variable that search is * supposed to be for. */ Tcl_Obj *handleObj) /* Object containing id of search. Must have * form "search-num-var" where "num" is a * decimal number and "var" is a variable * name. */ { Interp *iPtr = (Interp *) interp; const char *string; size_t offset; int id; ArraySearch *searchPtr; const char *varName = TclGetString(varNamePtr); /* * Parse the id. */ if ((handleObj->typePtr != &tclArraySearchType) && (SetArraySearchObj(interp, handleObj) != TCL_OK)) { return NULL; } /* * Extract the information out of the Tcl_Obj. */ id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1); string = TclGetString(handleObj); offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2); /* * This test cannot be placed inside the Tcl_Obj machinery, since it is * dependent on the variable context. */ if (strcmp(string+offset, varName) != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "search identifier \"%s\" isn't for variable \"%s\"", string, varName)); goto badLookup; } /* * Search through the list of active searches on the interpreter to see if * the desired one exists. * * Note that we cannot store the searchPtr directly in the Tcl_Obj as that * would run into trouble when DeleteSearches() was called so we must scan * this list every time. */ if (varPtr->flags & VAR_SEARCH_ACTIVE) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr); for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL; searchPtr = searchPtr->nextPtr) { if (searchPtr->id == id) { return searchPtr; } } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't find search \"%s\"", string)); badLookup: Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL); return NULL; } /* *---------------------------------------------------------------------- * * DeleteSearches -- * * This function is called to free up all of the searches associated * with an array variable. * * Results: * None. * * Side effects: * Memory is released to the storage allocator. * *---------------------------------------------------------------------- */ static void DeleteSearches( Interp *iPtr, Var *arrayVarPtr) /* Variable whose searches are to be * deleted. */ { ArraySearch *searchPtr, *nextPtr; Tcl_HashEntry *sPtr; if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) { sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr); for (searchPtr = (ArraySearch *)Tcl_GetHashValue(sPtr); searchPtr != NULL; searchPtr = nextPtr) { nextPtr = searchPtr->nextPtr; ckfree(searchPtr); } arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE; Tcl_DeleteHashEntry(sPtr); } } /* *---------------------------------------------------------------------- * * TclDeleteNamespaceVars -- * * This function is called to recycle all the storage space associated * with a namespace's table of variables. * * Results: * None. * * Side effects: * Variables are deleted and trace functions are invoked, if any are * declared. * *---------------------------------------------------------------------- */ void TclDeleteNamespaceVars( Namespace *nsPtr) { TclVarHashTable *tablePtr = &nsPtr->varTable; Tcl_Interp *interp = nsPtr->interp; Interp *iPtr = (Interp *)interp; Tcl_HashSearch search; int flags = 0; Var *varPtr; /* * Determine what flags to pass to the trace callback functions. */ if (nsPtr == iPtr->globalNsPtr) { flags = TCL_GLOBAL_ONLY; } else if (nsPtr == (Namespace *) TclGetCurrentNamespace(interp)) { flags = TCL_NAMESPACE_ONLY; } for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; varPtr = VarHashFirstVar(tablePtr, &search)) { Tcl_Obj *objPtr; TclNewObj(objPtr); VarHashRefCount(varPtr)++; /* Make sure we get to remove from * hash. */ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags, -1); /* * We just unset the variable. However, an unset trace might * have re-set it, or might have re-established traces on it. * This namespace and its vartable are going away unconditionally, * so we cannot let such things linger. That would be a leak. * * First we destroy all traces. ... */ if (TclIsVarTraced(varPtr)) { Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); ActiveVarTrace *activePtr; while (tracePtr) { VarTrace *prevPtr = tracePtr; tracePtr = tracePtr->nextPtr; prevPtr->nextPtr = NULL; Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC); } Tcl_DeleteHashEntry(tPtr); varPtr->flags &= ~VAR_ALL_TRACES; for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } } } /* * ...and then, if the variable still holds a value, we unset it * again. This time with no traces left, we're sure it goes away. */ if (!TclIsVarUndefined(varPtr)) { UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags, -1); } Tcl_DecrRefCount(objPtr); /* free no longer needed obj */ VarHashRefCount(varPtr)--; VarHashDeleteEntry(varPtr); } VarHashDeleteTable(tablePtr); } /* *---------------------------------------------------------------------- * * TclDeleteVars -- * * This function is called to recycle all the storage space associated * with a table of variables. For this function to work correctly, it * must not be possible for any of the variables in the table to be * accessed from Tcl commands (e.g. from trace functions). * * Results: * None. * * Side effects: * Variables are deleted and trace functions are invoked, if any are * declared. * *---------------------------------------------------------------------- */ void TclDeleteVars( Interp *iPtr, /* Interpreter to which variables belong. */ TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; Var *varPtr; int flags; Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); /* * Determine what flags to pass to the trace callback functions. */ flags = TCL_TRACE_UNSETS; if (tablePtr == &iPtr->globalNsPtr->varTable) { flags |= TCL_GLOBAL_ONLY; } else if (tablePtr == &currNsPtr->varTable) { flags |= TCL_NAMESPACE_ONLY; } for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; varPtr = VarHashFirstVar(tablePtr, &search)) { UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags, -1); VarHashDeleteEntry(varPtr); } VarHashDeleteTable(tablePtr); } /* *---------------------------------------------------------------------- * * TclDeleteCompiledLocalVars -- * * This function is called to recycle storage space associated with the * compiler-allocated array of local variables in a procedure call frame. * This function resembles TclDeleteVars above except that each variable * is stored in a call frame and not a hash table. For this function to * work correctly, it must not be possible for any of the variable in the * table to be accessed from Tcl commands (e.g. from trace functions). * * Results: * None. * * Side effects: * Variables are deleted and trace functions are invoked, if any are * declared. * *---------------------------------------------------------------------- */ void TclDeleteCompiledLocalVars( Interp *iPtr, /* Interpreter to which variables belong. */ CallFrame *framePtr) /* Procedure call frame containing compiler- * assigned local variables to delete. */ { Var *varPtr; int numLocals, i; Tcl_Obj **namePtrPtr; numLocals = framePtr->numCompiledLocals; varPtr = framePtr->compiledLocals; namePtrPtr = &localName(framePtr, 0); for (i=0 ; inumCompiledLocals = 0; } /* *---------------------------------------------------------------------- * * DeleteArray -- * * This function is called to free up everything in an array variable. * It's the caller's responsibility to make sure that the array is no * longer accessible before this function is called. * * Results: * None. * * Side effects: * All storage associated with varPtr's array elements is deleted * (including the array's hash table). Deletion trace functions for * array elements are invoked, then deleted. Any pending traces for array * elements are also deleted. * *---------------------------------------------------------------------- */ static void DeleteArray( Interp *iPtr, /* Interpreter containing array. */ Tcl_Obj *arrayNamePtr, /* Name of array (used for trace callbacks), * or NULL if it is to be computed on * demand. */ Var *varPtr, /* Pointer to variable structure. */ int flags, /* Flags to pass to TclCallVarTraces: * TCL_TRACE_UNSETS and sometimes * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */ int index) { Tcl_HashSearch search; Tcl_HashEntry *tPtr; Var *elPtr; ActiveVarTrace *activePtr; Tcl_Obj *objPtr; VarTrace *tracePtr; for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search); elPtr != NULL; elPtr = VarHashNextVar(&search)) { if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) { objPtr = elPtr->value.objPtr; TclDecrRefCount(objPtr); elPtr->value.objPtr = NULL; } /* * Lie about the validity of the hashtable entry. In this way the * variables will be deleted by VarHashDeleteTable. */ VarHashInvalidateEntry(elPtr); if (TclIsVarTraced(elPtr)) { /* * Compute the array name if it was not supplied. */ if (elPtr->flags & VAR_TRACED_UNSET) { Tcl_Obj *elNamePtr = VarHashGetKey(elPtr); elPtr->flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr, elNamePtr, flags,/* leaveErrMsg */ 0, index); } tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr); tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); while (tracePtr) { VarTrace *prevPtr = tracePtr; tracePtr = tracePtr->nextPtr; prevPtr->nextPtr = NULL; Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC); } Tcl_DeleteHashEntry(tPtr); elPtr->flags &= ~VAR_ALL_TRACES; for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == elPtr) { activePtr->nextTracePtr = NULL; } } } TclSetVarUndefined(elPtr); /* * Even though array elements are not supposed to be namespace * variables, some combinations of [upvar] and [variable] may create * such beasts - see [Bug 604239]. This is necessary to avoid leaking * the corresponding Var struct, and is otherwise harmless. */ TclClearVarNamespaceVar(elPtr); } VarHashDeleteTable(varPtr->value.tablePtr); ckfree(varPtr->value.tablePtr); } /* *---------------------------------------------------------------------- * * TclObjVarErrMsg -- * * Generate a reasonable error message describing why a variable * operation failed. * * Results: * None. * * Side effects: * The interp's result is set to hold a message identifying the variable * given by part1 and part2 and describing why the variable operation * failed. * *---------------------------------------------------------------------- */ void TclVarErrMsg( Tcl_Interp *interp, /* Interpreter in which to record message. */ const char *part1, const char *part2, /* Variable's two-part name. */ const char *operation, /* String describing operation that failed, * e.g. "read", "set", or "unset". */ const char *reason) /* String describing why operation failed. */ { Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); } TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1); Tcl_DecrRefCount(part1Ptr); if (part2Ptr) { Tcl_DecrRefCount(part2Ptr); } } void TclObjVarErrMsg( Tcl_Interp *interp, /* Interpreter in which to record message. */ Tcl_Obj *part1Ptr, /* (may be NULL, if index >= 0) */ Tcl_Obj *part2Ptr, /* Variable's two-part name. */ const char *operation, /* String describing operation that failed, * e.g. "read", "set", or "unset". */ const char *reason, /* String describing why operation failed. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { if (!part1Ptr) { if (index == -1) { Tcl_Panic("invalid part1Ptr and invalid index together"); } part1Ptr = localName(((Interp *)interp)->varFramePtr, index); } Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s", operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""), (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""), reason)); } /* *---------------------------------------------------------------------- * * Internal functions for variable name object types -- * *---------------------------------------------------------------------- */ /* * Panic functions that should never be called in normal operation. */ static void PanicOnUpdateVarName( Tcl_Obj *objPtr) { Tcl_Panic("%s of type %s should not be called", "updateStringProc", objPtr->typePtr->name); } static int PanicOnSetVarName( Tcl_Interp *interp, Tcl_Obj *objPtr) { Tcl_Panic("%s of type %s should not be called", "setFromAnyProc", objPtr->typePtr->name); return TCL_ERROR; } /* * localVarName - * * INTERNALREP DEFINITION: * twoPtrValue.ptr1: pointer to name obj in varFramePtr->localCache * or NULL if it is this same obj * twoPtrValue.ptr2: index into locals table */ static void FreeLocalVarName( Tcl_Obj *objPtr) { Tcl_Obj *namePtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1; if (namePtr) { Tcl_DecrRefCount(namePtr); } objPtr->typePtr = NULL; } static void DupLocalVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { Tcl_Obj *namePtr = srcPtr->internalRep.twoPtrValue.ptr1; if (!namePtr) { namePtr = srcPtr; } dupPtr->internalRep.twoPtrValue.ptr1 = namePtr; Tcl_IncrRefCount(namePtr); dupPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2; dupPtr->typePtr = &localVarNameType; } /* * parsedVarName - * * INTERNALREP DEFINITION: * twoPtrValue.ptr1 = pointer to the array name Tcl_Obj (NULL if scalar) * twoPtrValue.ptr2 = pointer to the element name string (owned by this * Tcl_Obj), or NULL if it is a scalar variable */ static void FreeParsedVarName( Tcl_Obj *objPtr) { Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1; char *elem = objPtr->internalRep.twoPtrValue.ptr2; if (arrayPtr != NULL) { TclDecrRefCount(arrayPtr); ckfree(elem); } objPtr->typePtr = NULL; } static void DupParsedVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1; char *elem = srcPtr->internalRep.twoPtrValue.ptr2; char *elemCopy; unsigned elemLen; if (arrayPtr != NULL) { Tcl_IncrRefCount(arrayPtr); elemLen = strlen(elem); elemCopy = (char *)ckalloc(elemLen + 1); memcpy(elemCopy, elem, elemLen); *(elemCopy + elemLen) = '\0'; elem = elemCopy; } dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr; dupPtr->internalRep.twoPtrValue.ptr2 = elem; dupPtr->typePtr = &tclParsedVarNameType; } static void UpdateParsedVarName( Tcl_Obj *objPtr) { Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1; char *part2 = objPtr->internalRep.twoPtrValue.ptr2; const char *part1; char *p; int len1, len2, totalLen; if (arrayPtr == NULL) { /* * This is a parsed scalar name: what is it doing here? */ Tcl_Panic("scalar parsedVarName without a string rep"); } part1 = TclGetStringFromObj(arrayPtr, &len1); len2 = strlen(part2); totalLen = len1 + len2 + 2; p = ckalloc(totalLen + 1); objPtr->bytes = p; objPtr->length = totalLen; memcpy(p, part1, len1); p += len1; *p++ = '('; memcpy(p, part2, len2); p += len2; *p++ = ')'; *p = '\0'; } /* *---------------------------------------------------------------------- * * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c * * Searches for a namespace variable, a variable not local to a * procedure. The variable can be either a scalar or an array, but may * not be an element of an array. * * Results: * Returns a token for the variable if it is found. Otherwise, if it * can't be found or there is an error, returns NULL and leaves an error * message in the interpreter's result object if "flags" contains * TCL_LEAVE_ERR_MSG. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Var Tcl_FindNamespaceVar( Tcl_Interp *interp, /* The interpreter in which to find the * variable. */ const char *name, /* Variable's name. If it starts with "::", * will be looked up in global namespace. * Else, looked up first in contextNsPtr * (current namespace if contextNsPtr is * NULL), then in global namespace. */ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set. * Otherwise, points to namespace in which to * resolve name. If NULL, look up name in the * current namespace. */ int flags) /* An OR'd combination of: * TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look * up name only in global namespace), * TCL_NAMESPACE_ONLY (look up only in * contextNsPtr, or the current namespace if * contextNsPtr is NULL), and * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY * and TCL_NAMESPACE_ONLY are given, * TCL_GLOBAL_ONLY is ignored. */ { Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1); Tcl_Var var; var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags); Tcl_DecrRefCount(namePtr); return var; } static Tcl_Var ObjFindNamespaceVar( Tcl_Interp *interp, /* The interpreter in which to find the * variable. */ Tcl_Obj *namePtr, /* Variable's name. If it starts with "::", * will be looked up in global namespace. * Else, looked up first in contextNsPtr * (current namespace if contextNsPtr is * NULL), then in global namespace. */ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set. * Otherwise, points to namespace in which to * resolve name. If NULL, look up name in the * current namespace. */ int flags) /* An OR'd combination of: * TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look * up name only in global namespace), * TCL_NAMESPACE_ONLY (look up only in * contextNsPtr, or the current namespace if * contextNsPtr is NULL), and * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY * and TCL_NAMESPACE_ONLY are given, * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; const char *simpleName; Var *varPtr; int search; int result; Tcl_Var var; Tcl_Obj *simpleNamePtr; const char *name = TclGetString(namePtr); /* * If this namespace has a variable resolver, then give it first crack at * the variable resolution. It may return a Tcl_Var value, it may signal * to continue onward, or it may signal an error. */ if ((flags & TCL_GLOBAL_ONLY) != 0) { cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp); } else if (contextNsPtr != NULL) { cxtNsPtr = (Namespace *) contextNsPtr; } else { cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp); } if (!(flags & TCL_AVOID_RESOLVERS) && (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) { resPtr = iPtr->resolverPtr; if (cxtNsPtr->varResProc) { result = cxtNsPtr->varResProc(interp, name, (Tcl_Namespace *) cxtNsPtr, flags, &var); } else { result = TCL_CONTINUE; } while (result == TCL_CONTINUE && resPtr) { if (resPtr->varResProc) { result = resPtr->varResProc(interp, name, (Tcl_Namespace *) cxtNsPtr, flags, &var); } resPtr = resPtr->nextPtr; } if (result == TCL_OK) { return var; } else if (result != TCL_CONTINUE) { return NULL; } } /* * Find the namespace(s) that contain the variable. */ TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /* * Look for the variable in the variable table of its namespace. Be sure * to check both possible search paths: from the specified namespace * context and from the global namespace. */ varPtr = NULL; if (simpleName != name) { simpleNamePtr = Tcl_NewStringObj(simpleName, -1); } else { simpleNamePtr = namePtr; } for (search = 0; (search < 2) && (varPtr == NULL); search++) { if ((nsPtr[search] != NULL) && (simpleName != NULL)) { varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr); } } if (simpleName != name) { Tcl_DecrRefCount(simpleNamePtr); } if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown variable \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL); } return (Tcl_Var) varPtr; } /* *---------------------------------------------------------------------- * * InfoVarsCmd -- (moved over from tclCmdIL.c) * * Called to implement the "info vars" command that returns the list of * variables in the interpreter that match an optional pattern. The * pattern, if any, consists of an optional sequence of namespace names * separated by "::" qualifiers, which is followed by a glob-style * pattern that restricts which variables are returned. Handles the * following syntax: * * info vars ?pattern? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ int TclInfoVarsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *varName, *pattern, *simplePattern; Tcl_HashSearch search; Var *varPtr; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Obj *simplePatternPtr = NULL; /* * Get the pattern and find the "effective namespace" in which to list * variables. We only use this effective namespace if there's no active * Tcl procedure frame. */ if (objc == 1) { simplePattern = NULL; nsPtr = currNsPtr; specificNsInPattern = 0; } else if (objc == 2) { /* * From the pattern, get the effective namespace and the simple * pattern (no namespace qualifiers or ::'s) at the end. If an error * was found while parsing the pattern, return it. Otherwise, if the * namespace wasn't found, just leave nsPtr NULL: we will return an * empty list since no variables there can be found. */ Namespace *dummy1NsPtr, *dummy2NsPtr; pattern = TclGetString(objv[1]); TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern); if (nsPtr != NULL) { /* We successfully found the pattern's ns. */ specificNsInPattern = (strcmp(simplePattern, pattern) != 0); if (simplePattern == pattern) { simplePatternPtr = objv[1]; } else { simplePatternPtr = Tcl_NewStringObj(simplePattern, -1); } Tcl_IncrRefCount(simplePatternPtr); } } else { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } /* * If the namespace specified in the pattern wasn't found, just return. */ if (nsPtr == NULL) { return TCL_OK; } listPtr = Tcl_NewListObj(0, NULL); if (!HasLocalVars(iPtr->varFramePtr) || specificNsInPattern) { /* * There is no frame pointer, the frame pointer was pushed only to * activate a namespace, or we are in a procedure call frame but a * specific namespace was specified. Create a list containing only the * variables in the effective namespace's variable table. */ if (simplePattern && TclMatchIsTrivial(simplePattern)) { /* * If we can just do hash lookups, that simplifies things a lot. */ varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr); if (varPtr) { if (!TclIsVarUndefined(varPtr) || TclIsVarNamespaceVar(varPtr)) { if (specificNsInPattern) { TclNewObj(elemObjPtr); Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, elemObjPtr); } else { elemObjPtr = VarHashGetKey(varPtr); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { varPtr = VarHashFindVar(&globalNsPtr->varTable, simplePatternPtr); if (varPtr) { if (!TclIsVarUndefined(varPtr) || TclIsVarNamespaceVar(varPtr)) { Tcl_ListObjAppendElement(interp, listPtr, VarHashGetKey(varPtr)); } } } } else { /* * Have to scan the tables of variables. */ varPtr = VarHashFirstVar(&nsPtr->varTable, &search); while (varPtr) { if (!TclIsVarUndefined(varPtr) || TclIsVarNamespaceVar(varPtr)) { varNamePtr = VarHashGetKey(varPtr); varName = TclGetString(varNamePtr); if ((simplePattern == NULL) || Tcl_StringMatch(varName, simplePattern)) { if (specificNsInPattern) { TclNewObj(elemObjPtr); Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, elemObjPtr); } else { elemObjPtr = varNamePtr; } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } varPtr = VarHashNextVar(&search); } /* * If the effective namespace isn't the global :: namespace, and a * specific namespace wasn't requested in the pattern (i.e., the * pattern only specifies variable names), then add in all global * :: variables that match the simple pattern. Of course, add in * only those variables that aren't hidden by a variable in the * effective namespace. */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search); while (varPtr) { if (!TclIsVarUndefined(varPtr) || TclIsVarNamespaceVar(varPtr)) { varNamePtr = VarHashGetKey(varPtr); varName = TclGetString(varNamePtr); if ((simplePattern == NULL) || Tcl_StringMatch(varName, simplePattern)) { if (VarHashFindVar(&nsPtr->varTable, varNamePtr) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, varNamePtr); } } } varPtr = VarHashNextVar(&search); } } } } else if (iPtr->varFramePtr->procPtr != NULL) { AppendLocals(interp, listPtr, simplePatternPtr, 1); } if (simplePatternPtr) { Tcl_DecrRefCount(simplePatternPtr); } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * InfoGlobalsCmd -- (moved over from tclCmdIL.c) * * Called to implement the "info globals" command that returns the list * of global variables matching an optional pattern. Handles the * following syntax: * * info globals ?pattern? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ int TclInfoGlobalsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *varName, *pattern; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Tcl_HashSearch search; Var *varPtr; Tcl_Obj *listPtr, *varNamePtr, *patternPtr; if (objc == 1) { pattern = NULL; } else if (objc == 2) { pattern = TclGetString(objv[1]); /* * Strip leading global-namespace qualifiers. [Bug 1057461] */ if (pattern[0] == ':' && pattern[1] == ':') { while (*pattern == ':') { pattern++; } } } else { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } /* * Scan through the global :: namespace's variable table and create a list * of all global variables that match the pattern. */ listPtr = Tcl_NewListObj(0, NULL); if (pattern != NULL && TclMatchIsTrivial(pattern)) { if (pattern == TclGetString(objv[1])) { patternPtr = objv[1]; } else { patternPtr = Tcl_NewStringObj(pattern, -1); } Tcl_IncrRefCount(patternPtr); varPtr = VarHashFindVar(&globalNsPtr->varTable, patternPtr); if (varPtr) { if (!TclIsVarUndefined(varPtr)) { Tcl_ListObjAppendElement(interp, listPtr, VarHashGetKey(varPtr)); } } Tcl_DecrRefCount(patternPtr); } else { for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search); varPtr != NULL; varPtr = VarHashNextVar(&search)) { if (TclIsVarUndefined(varPtr)) { continue; } varNamePtr = VarHashGetKey(varPtr); varName = TclGetString(varNamePtr); if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { Tcl_ListObjAppendElement(interp, listPtr, varNamePtr); } } } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclInfoLocalsCmd -- (moved over from tclCmdIl.c) * * Called to implement the "info locals" command to return a list of * local variables that match an optional pattern. Handles the following * syntax: * * info locals ?pattern? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is an * error, the result is an error message. * *---------------------------------------------------------------------- */ int TclInfoLocalsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *patternPtr, *listPtr; if (objc == 1) { patternPtr = NULL; } else if (objc == 2) { patternPtr = objv[1]; } else { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } if (!HasLocalVars(iPtr->varFramePtr)) { return TCL_OK; } /* * Return a list containing names of first the compiled locals (i.e. the * ones stored in the call frame), then the variables in the local hash * table (if one exists). */ listPtr = Tcl_NewListObj(0, NULL); AppendLocals(interp, listPtr, patternPtr, 0); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * AppendLocals -- * * Append the local variables for the current frame to the specified list * object. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AppendLocals( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *listPtr, /* List object to append names to. */ Tcl_Obj *patternPtr, /* Pattern to match against. */ int includeLinks) /* 1 if upvars should be included, else 0. */ { Interp *iPtr = (Interp *) interp; Var *varPtr; int i, localVarCt, added; Tcl_Obj *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; if (includeLinks) { Tcl_InitObjHashTable(&addedTable); } if (localVarCt > 0) { Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0; for (i = 0; i < localVarCt; i++, varNamePtr++) { /* * Skip nameless (temporary) variables and undefined variables. */ if (*varNamePtr && !TclIsVarUndefined(varPtr) && (includeLinks || !TclIsVarLink(varPtr))) { varName = TclGetString(*varNamePtr); if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr); if (includeLinks) { Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added); } } } varPtr++; } } /* * Do nothing if no local variables. */ if (localVarTablePtr == NULL) { goto objectVars; } /* * Check for the simple and fast case. */ if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { varPtr = VarHashFindVar(localVarTablePtr, patternPtr); if (varPtr != NULL) { if (!TclIsVarUndefined(varPtr) && (includeLinks || !TclIsVarLink(varPtr))) { Tcl_ListObjAppendElement(interp, listPtr, VarHashGetKey(varPtr)); if (includeLinks) { Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr), &added); } } } goto objectVars; } /* * Scan over and process all local variables. */ for (varPtr = VarHashFirstVar(localVarTablePtr, &search); varPtr != NULL; varPtr = VarHashNextVar(&search)) { if (!TclIsVarUndefined(varPtr) && (includeLinks || !TclIsVarLink(varPtr))) { objNamePtr = VarHashGetKey(varPtr); 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); } /* * Hash table implementation - first, just copy and adapt the obj key stuff */ void TclInitVarHashTable( TclVarHashTable *tablePtr, Namespace *nsPtr) { Tcl_InitCustomHashTable(&tablePtr->table, TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType); tablePtr->nsPtr = nsPtr; } static Tcl_HashEntry * AllocVarEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; Tcl_HashEntry *hPtr; Var *varPtr; varPtr = (Var *)ckalloc(sizeof(VarInHash)); varPtr->flags = VAR_IN_HASHTABLE; varPtr->value.objPtr = NULL; VarHashRefCount(varPtr) = 1; hPtr = &(((VarInHash *) varPtr)->entry); Tcl_SetHashValue(hPtr, varPtr); hPtr->key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); return hPtr; } static void FreeVarEntry( Tcl_HashEntry *hPtr) { Var *varPtr = VarHashGetValue(hPtr); Tcl_Obj *objPtr = hPtr->key.objPtr; if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr) && (VarHashRefCount(varPtr) == 1)) { ckfree(varPtr); } else { VarHashInvalidateEntry(varPtr); TclSetVarUndefined(varPtr); VarHashRefCount(varPtr)--; } Tcl_DecrRefCount(objPtr); } static int CompareVarKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; const char *p1, *p2; int l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller * * if (objPtr1 == objPtr2) return 1; */ /* * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a * register. */ p1 = TclGetString(objPtr1); l1 = objPtr1->length; p2 = TclGetString(objPtr2); l2 = objPtr2->length; /* * Only compare string representations of the same length. */ return ((l1 == l2) && !memcmp(p1, p2, l1)); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tclZlib.c0000644000175000017500000032020414554262142015026 0ustar sergeisergei/* * tclZlib.c -- * * This file provides the interface to the Zlib library. * * Copyright (C) 2004-2005 Pascal Scheffers * Copyright (C) 2005 Unitas Software B.V. * Copyright (c) 2008-2012 Donal K. Fellows * * Parts written by Jean-Claude Wippler, as part of Tclkit, placed in the * public domain March 2003. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef HAVE_ZLIB #include #include "tclIO.h" /* * The version of the zlib "package" that this implements. Note that this * thoroughly supersedes the versions included with tclkit, which are "1.1", * so this is at least "2.0" (there's no general *commitment* to have the same * interface, even if that is mostly true). */ #define TCL_ZLIB_VERSION "2.0.1" /* * Magic flags used with wbits fields to indicate that we're handling the gzip * format or automatic detection of format. Putting it here is slightly less * gross! */ #define WBITS_RAW (-MAX_WBITS) #define WBITS_ZLIB (MAX_WBITS) #define WBITS_GZIP (MAX_WBITS | 16) #define WBITS_AUTODETECT (MAX_WBITS | 32) /* * Structure used for handling gzip headers that are generated from a * dictionary. It comprises the header structure itself plus some working * space that it is very convenient to have attached. */ #define MAX_COMMENT_LEN 256 typedef struct { gz_header header; char nativeFilenameBuf[MAXPATHLEN]; char nativeCommentBuf[MAX_COMMENT_LEN]; } GzipHeader; /* * Structure used for the Tcl_ZlibStream* commands and [zlib stream ...] */ typedef struct { Tcl_Interp *interp; z_stream stream; /* The interface to the zlib library. */ int streamEnd; /* If we've got to end-of-stream. */ Tcl_Obj *inData, *outData; /* Input / output buffers (lists) */ Tcl_Obj *currentInput; /* Pointer to what is currently being * inflated. */ int outPos; int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or * TCL_ZLIB_STREAM_INFLATE. */ int format; /* Flags from the TCL_ZLIB_FORMAT_* */ int level; /* Default 5, 0-9 */ int flush; /* Stores the flush param for deferred the * decompression. */ int wbits; /* The encoded compression mode, so we can * restart the stream if necessary. */ Tcl_Command cmd; /* Token for the associated Tcl command. */ Tcl_Obj *compDictObj; /* Byte-array object containing compression * dictionary (not dictObj!) to use if * necessary. */ int flags; /* Miscellaneous flag bits. */ GzipHeader *gzHeaderPtr; /* If we've allocated a gzip header * structure. */ } ZlibStreamHandle; #define DICT_TO_SET 0x1 /* If we need to set a compression dictionary * in the low-level engine at the next * opportunity. */ /* * Macros to make it clearer in some of the twiddlier accesses what is * happening. */ #define IsRawStream(zshPtr) ((zshPtr)->format == TCL_ZLIB_FORMAT_RAW) #define HaveDictToSet(zshPtr) ((zshPtr)->flags & DICT_TO_SET) #define DictWasSet(zshPtr) ((zshPtr)->flags |= ~DICT_TO_SET) /* * Structure used for stacked channel compression and decompression. */ typedef struct { Tcl_Channel chan; /* Reference to the channel itself. */ Tcl_Channel parent; /* The underlying source and sink of bytes. */ int flags; /* General flag bits, see below... */ int mode; /* Either the value TCL_ZLIB_STREAM_DEFLATE * for compression on output, or * TCL_ZLIB_STREAM_INFLATE for decompression * on input. */ int format; /* What format of data is going on the wire. * Needed so that the correct [fconfigure] * options can be enabled. */ int readAheadLimit; /* The maximum number of bytes to read from * the underlying stream in one go. */ z_stream inStream; /* Structure used by zlib for decompression of * input. */ z_stream outStream; /* Structure used by zlib for compression of * output. */ char *inBuffer, *outBuffer; /* Working buffers. */ int inAllocated, outAllocated; /* Sizes of working buffers. */ GzipHeader inHeader; /* Header read from input stream, when * decompressing a gzip stream. */ GzipHeader outHeader; /* Header to write to an output stream, when * compressing a gzip stream. */ Tcl_TimerToken timer; /* Timer used for keeping events fresh. */ Tcl_Obj *compDictObj; /* Byte-array object containing compression * dictionary (not dictObj!) to use if * necessary. */ } ZlibChannelData; /* * Value bits for the flags field. Definitions are: * ASYNC - Whether this is an asynchronous channel. * IN_HEADER - Whether the inHeader field has been registered with * the input compressor. * OUT_HEADER - Whether the outputHeader field has been registered * with the output decompressor. * STREAM_DECOMPRESS - Signal decompress pending data. * STREAM_DONE - Flag to signal stream end up to transform input. */ #define ASYNC 0x01 #define IN_HEADER 0x02 #define OUT_HEADER 0x04 #define STREAM_DECOMPRESS 0x08 #define STREAM_DONE 0x10 /* * Size of buffers allocated by default, and the range it can be set to. The * same sorts of values apply to streams, except with different limits (they * permit byte-level activity). Channels always use bytes unless told to use * larger buffers. */ #define DEFAULT_BUFFER_SIZE 4096 #define MIN_NONSTREAM_BUFFER_SIZE 16 #define MAX_BUFFER_SIZE 65536 /* * Prototypes for private procedures defined later in this file: */ static Tcl_CmdDeleteProc ZlibStreamCmdDelete; static Tcl_DriverBlockModeProc ZlibTransformBlockMode; static Tcl_DriverCloseProc ZlibTransformClose; static Tcl_DriverGetHandleProc ZlibTransformGetHandle; static Tcl_DriverGetOptionProc ZlibTransformGetOption; static Tcl_DriverHandlerProc ZlibTransformEventHandler; static Tcl_DriverInputProc ZlibTransformInput; static Tcl_DriverOutputProc ZlibTransformOutput; static Tcl_DriverSetOptionProc ZlibTransformSetOption; static Tcl_DriverWatchProc ZlibTransformWatch; static Tcl_ObjCmdProc ZlibCmd; static Tcl_ObjCmdProc ZlibStreamCmd; static Tcl_ObjCmdProc ZlibStreamAddCmd; static Tcl_ObjCmdProc ZlibStreamHeaderCmd; static Tcl_ObjCmdProc ZlibStreamPutCmd; static void ConvertError(Tcl_Interp *interp, int code, uLong adler); static Tcl_Obj * ConvertErrorToList(int code, uLong adler); static inline int Deflate(z_streamp strm, void *bufferPtr, int bufferSize, int flush, int *writtenPtr); static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj); static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj, GzipHeader *headerPtr, int *extraSizePtr); static int ZlibPushSubcmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ResultDecompress(ZlibChannelData *cd, char *buf, int toRead, int flush, int *errorCodePtr); static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp, int mode, int format, int level, int limit, Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr, Tcl_Obj *compDictObj); static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr); static int ZlibStreamSubcmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd); static void ZlibTransformTimerRun(ClientData clientData); /* * Type of zlib-based compressing and decompressing channels. */ static const Tcl_ChannelType zlibChannelType = { "zlib", TCL_CHANNEL_VERSION_5, ZlibTransformClose, ZlibTransformInput, ZlibTransformOutput, NULL, /* seekProc */ ZlibTransformSetOption, ZlibTransformGetOption, ZlibTransformWatch, ZlibTransformGetHandle, NULL, /* close2Proc */ ZlibTransformBlockMode, NULL, /* flushProc */ ZlibTransformEventHandler, NULL, /* wideSeekProc */ NULL, NULL }; /* *---------------------------------------------------------------------- * * ConvertError -- * * Utility function for converting a zlib error into a Tcl error. * * Results: * None. * * Side effects: * Updates the interpreter result and errorcode. * *---------------------------------------------------------------------- */ static void ConvertError( Tcl_Interp *interp, /* Interpreter to store the error in. May be * NULL, in which case nothing happens. */ int code, /* The zlib error code. */ uLong adler) /* The checksum expected (for Z_NEED_DICT) */ { const char *codeStr, *codeStr2 = NULL; char codeStrBuf[TCL_INTEGER_SPACE]; if (interp == NULL) { return; } switch (code) { /* * Firstly, the case that is *different* because it's really coming * from the OS and is just being reported via zlib. It should be * really uncommon because Tcl handles all I/O rather than delegating * it to zlib, but proving it can't happen is hard. */ case Z_ERRNO: Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1)); return; /* * Normal errors/conditions, some of which have additional detail and * some which don't. (This is not defined by array lookup because zlib * error codes are sometimes negative.) */ case Z_STREAM_ERROR: codeStr = "STREAM"; break; case Z_DATA_ERROR: codeStr = "DATA"; break; case Z_MEM_ERROR: codeStr = "MEM"; break; case Z_BUF_ERROR: codeStr = "BUF"; break; case Z_VERSION_ERROR: codeStr = "VERSION"; break; case Z_NEED_DICT: codeStr = "NEED_DICT"; codeStr2 = codeStrBuf; snprintf(codeStrBuf, sizeof(codeStrBuf), "%lu", adler); break; /* * These should _not_ happen! This function is for dealing with error * cases, not non-errors! */ case Z_OK: Tcl_Panic("unexpected zlib result in error handler: Z_OK"); case Z_STREAM_END: Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END"); /* * Anything else is bad news; it's unexpected. Convert to generic * error. */ default: codeStr = "UNKNOWN"; codeStr2 = codeStrBuf; snprintf(codeStrBuf, sizeof(codeStrBuf), "%d", code); break; } Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1)); /* * Tricky point! We might pass NULL twice here (and will when the error * type is known). */ Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL); } static Tcl_Obj * ConvertErrorToList( int code, /* The zlib error code. */ uLong adler) /* The checksum expected (for Z_NEED_DICT) */ { Tcl_Obj *objv[4]; TclNewLiteralStringObj(objv[0], "TCL"); TclNewLiteralStringObj(objv[1], "ZLIB"); switch (code) { case Z_STREAM_ERROR: TclNewLiteralStringObj(objv[2], "STREAM"); return Tcl_NewListObj(3, objv); case Z_DATA_ERROR: TclNewLiteralStringObj(objv[2], "DATA"); return Tcl_NewListObj(3, objv); case Z_MEM_ERROR: TclNewLiteralStringObj(objv[2], "MEM"); return Tcl_NewListObj(3, objv); case Z_BUF_ERROR: TclNewLiteralStringObj(objv[2], "BUF"); return Tcl_NewListObj(3, objv); case Z_VERSION_ERROR: TclNewLiteralStringObj(objv[2], "VERSION"); return Tcl_NewListObj(3, objv); case Z_ERRNO: TclNewLiteralStringObj(objv[2], "POSIX"); objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); return Tcl_NewListObj(4, objv); case Z_NEED_DICT: TclNewLiteralStringObj(objv[2], "NEED_DICT"); objv[3] = Tcl_NewWideIntObj((Tcl_WideInt) adler); return Tcl_NewListObj(4, objv); /* * These should _not_ happen! This function is for dealing with error * cases, not non-errors! */ case Z_OK: Tcl_Panic("unexpected zlib result in error handler: Z_OK"); case Z_STREAM_END: Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END"); /* * Catch-all. Should be unreachable because all cases are already * listed above. */ default: TclNewLiteralStringObj(objv[2], "UNKNOWN"); TclNewIntObj(objv[3], code); return Tcl_NewListObj(4, objv); } } /* *---------------------------------------------------------------------- * * GenerateHeader -- * * Function for creating a gzip header from the contents of a dictionary * (as described in the documentation). GetValue is a helper function. * * Results: * A Tcl result code. * * Side effects: * Updates the fields of the given gz_header structure. Adds amount of * extra space required for the header to the variable referenced by the * extraSizePtr argument. * *---------------------------------------------------------------------- */ static inline int GetValue( Tcl_Interp *interp, Tcl_Obj *dictObj, const char *nameStr, Tcl_Obj **valuePtrPtr) { Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1); int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr); TclDecrRefCount(name); return result; } static int GenerateHeader( Tcl_Interp *interp, /* Where to put error messages. */ Tcl_Obj *dictObj, /* The dictionary whose contents are to be * parsed. */ GzipHeader *headerPtr, /* Where to store the parsed-out values. */ int *extraSizePtr) /* Variable to add the length of header * strings (filename, comment) to. */ { Tcl_Obj *value; int len, result = TCL_ERROR; const char *valueStr; Tcl_Encoding latin1enc; static const char *const types[] = { "binary", "text" }; /* * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). */ latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); if (latin1enc == NULL) { Tcl_Panic("no latin-1 encoding"); } if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { Tcl_EncodingState state; valueStr = Tcl_GetStringFromObj(value, &len); result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_STOPONERROR, &state, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, NULL); if (result != TCL_OK) { if (result == TCL_CONVERT_UNKNOWN) { Tcl_AppendResult(interp, "Comment contains characters > 0xFF", NULL); } else { Tcl_AppendResult(interp, "Comment too large for zip", NULL); } result = TCL_ERROR; goto error; } headerPtr->nativeCommentBuf[len] = '\0'; headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf; if (extraSizePtr != NULL) { *extraSizePtr += len; } } if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) { goto error; } else if (value != NULL && Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) { goto error; } if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) { goto error; } else if (value != NULL) { Tcl_EncodingState state; valueStr = Tcl_GetStringFromObj(value, &len); result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_STOPONERROR, &state, headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL); if (result != TCL_OK) { if (result == TCL_CONVERT_UNKNOWN) { Tcl_AppendResult(interp, "Filename contains characters > 0xFF", NULL); } else { Tcl_AppendResult(interp, "Filename too large for zip", NULL); } result = TCL_ERROR; goto error; } headerPtr->nativeFilenameBuf[len] = '\0'; headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf; if (extraSizePtr != NULL) { *extraSizePtr += len; } } if (GetValue(interp, dictObj, "os", &value) != TCL_OK) { goto error; } else if (value != NULL && Tcl_GetIntFromObj(interp, value, &headerPtr->header.os) != TCL_OK) { goto error; } /* * Ignore the 'size' field, since that is controlled by the size of the * input data. */ if (GetValue(interp, dictObj, "time", &value) != TCL_OK) { goto error; } else if (value != NULL && Tcl_GetLongFromObj(interp, value, (long *) &headerPtr->header.time) != TCL_OK) { goto error; } if (GetValue(interp, dictObj, "type", &value) != TCL_OK) { goto error; } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types, "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) { goto error; } result = TCL_OK; error: Tcl_FreeEncoding(latin1enc); return result; } /* *---------------------------------------------------------------------- * * ExtractHeader -- * * Take the values out of a gzip header and store them in a dictionary. * SetValue is a helper macro. * * Results: * None. * * Side effects: * Updates the dictionary, which must be writable (i.e. refCount < 2). * *---------------------------------------------------------------------- */ #define SetValue(dictObj, key, value) \ Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value)) static void ExtractHeader( gz_header *headerPtr, /* The gzip header to extract from. */ Tcl_Obj *dictObj) /* The dictionary to store in. */ { Tcl_Encoding latin1enc = NULL; Tcl_DString tmp; if (headerPtr->comment != Z_NULL) { if (latin1enc == NULL) { /* * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). */ latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); if (latin1enc == NULL) { Tcl_Panic("no latin-1 encoding"); } } Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1, &tmp); SetValue(dictObj, "comment", TclDStringToObj(&tmp)); } SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); if (headerPtr->name != Z_NULL) { if (latin1enc == NULL) { /* * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). */ latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); if (latin1enc == NULL) { Tcl_Panic("no latin-1 encoding"); } } Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1, &tmp); SetValue(dictObj, "filename", TclDStringToObj(&tmp)); } if (headerPtr->os != 255) { SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os)); } if (headerPtr->time != 0 /* magic - no time */) { SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time)); } if (headerPtr->text != Z_UNKNOWN) { SetValue(dictObj, "type", Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1)); } if (latin1enc != NULL) { Tcl_FreeEncoding(latin1enc); } } /* * Disentangle the worst of how the zlib API is used. */ static int SetInflateDictionary( z_streamp strm, Tcl_Obj *compDictObj) { if (compDictObj != NULL) { int length; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); return inflateSetDictionary(strm, bytes, length); } return Z_OK; } static int SetDeflateDictionary( z_streamp strm, Tcl_Obj *compDictObj) { if (compDictObj != NULL) { int length; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); return deflateSetDictionary(strm, bytes, length); } return Z_OK; } static inline int Deflate( z_streamp strm, void *bufferPtr, int bufferSize, int flush, int *writtenPtr) { int e; strm->next_out = (Bytef *) bufferPtr; strm->avail_out = bufferSize; e = deflate(strm, flush); if (writtenPtr != NULL) { *writtenPtr = bufferSize - strm->avail_out; } return e; } static inline void AppendByteArray( Tcl_Obj *listObj, void *buffer, int size) { if (size > 0) { Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size); Tcl_ListObjAppendElement(NULL, listObj, baObj); } } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamInit -- * * This command initializes a (de)compression context/handle for * (de)compressing data in chunks. * * Results: * A standard Tcl result. * * Side effects: * The variable pointed to by zshandlePtr is initialised and memory * allocated for internal state. Additionally, if interp is not null, a * Tcl command is created and its name placed in the interp result obj. * * Note: * At least one of interp and zshandlePtr should be non-NULL or the * reference to the stream will be completely lost. * *---------------------------------------------------------------------- */ int Tcl_ZlibStreamInit( Tcl_Interp *interp, int mode, /* Either TCL_ZLIB_STREAM_INFLATE or * TCL_ZLIB_STREAM_DEFLATE. */ int format, /* Flags from the TCL_ZLIB_FORMAT_* set. */ int level, /* 0-9 or TCL_ZLIB_COMPRESS_DEFAULT. */ Tcl_Obj *dictObj, /* Dictionary containing headers for gzip. */ Tcl_ZlibStream *zshandlePtr) { int wbits = 0; int e; ZlibStreamHandle *zshPtr = NULL; Tcl_DString cmdname; GzipHeader *gzHeaderPtr = NULL; switch (mode) { case TCL_ZLIB_STREAM_DEFLATE: /* * Compressed format is specified by the wbits parameter. See zlib.h * for details. */ switch (format) { case TCL_ZLIB_FORMAT_RAW: wbits = WBITS_RAW; break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; if (dictObj) { gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); if (GenerateHeader(interp, dictObj, gzHeaderPtr, NULL) != TCL_OK) { ckfree(gzHeaderPtr); return TCL_ERROR; } } break; case TCL_ZLIB_FORMAT_ZLIB: wbits = WBITS_ZLIB; break; default: Tcl_Panic("incorrect zlib data format, must be " "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP or " "TCL_ZLIB_FORMAT_RAW"); } if (level < -1 || level > 9) { Tcl_Panic("compression level should be between 0 (no compression)" " and 9 (best compression) or -1 for default compression " "level"); } break; case TCL_ZLIB_STREAM_INFLATE: /* * wbits are the same as DEFLATE, but FORMAT_AUTO is valid too. */ switch (format) { case TCL_ZLIB_FORMAT_RAW: wbits = WBITS_RAW; break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); gzHeaderPtr->header.name = (Bytef *) gzHeaderPtr->nativeFilenameBuf; gzHeaderPtr->header.name_max = MAXPATHLEN - 1; gzHeaderPtr->header.comment = (Bytef *) gzHeaderPtr->nativeCommentBuf; gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1; break; case TCL_ZLIB_FORMAT_ZLIB: wbits = WBITS_ZLIB; break; case TCL_ZLIB_FORMAT_AUTO: wbits = WBITS_AUTODETECT; break; default: Tcl_Panic("incorrect zlib data format, must be " "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP, " "TCL_ZLIB_FORMAT_RAW or TCL_ZLIB_FORMAT_AUTO"); } break; default: Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or" " TCL_ZLIB_STREAM_INFLATE"); } zshPtr = (ZlibStreamHandle *)ckalloc(sizeof(ZlibStreamHandle)); zshPtr->interp = interp; zshPtr->mode = mode; zshPtr->format = format; zshPtr->level = level; zshPtr->wbits = wbits; zshPtr->currentInput = NULL; zshPtr->streamEnd = 0; zshPtr->compDictObj = NULL; zshPtr->flags = 0; zshPtr->gzHeaderPtr = gzHeaderPtr; memset(&zshPtr->stream, 0, sizeof(z_stream)); zshPtr->stream.adler = 1; /* * No output buffer available yet */ if (mode == TCL_ZLIB_STREAM_DEFLATE) { e = deflateInit2(&zshPtr->stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY); if (e == Z_OK && zshPtr->gzHeaderPtr) { e = deflateSetHeader(&zshPtr->stream, &zshPtr->gzHeaderPtr->header); } } else { e = inflateInit2(&zshPtr->stream, wbits); if (e == Z_OK && zshPtr->gzHeaderPtr) { e = inflateGetHeader(&zshPtr->stream, &zshPtr->gzHeaderPtr->header); } } if (e != Z_OK) { ConvertError(interp, e, zshPtr->stream.adler); goto error; } /* * I could do all this in C, but this is easier. */ if (interp != NULL) { if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", -1, 0) != TCL_OK) { goto error; } Tcl_DStringInit(&cmdname); TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_"); TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp)); if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname), NULL, 0) != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "BUG: Stream command name already exists", -1)); Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL); Tcl_DStringFree(&cmdname); goto error; } Tcl_ResetResult(interp); /* * Create the command. */ zshPtr->cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdname), ZlibStreamCmd, zshPtr, ZlibStreamCmdDelete); Tcl_DStringFree(&cmdname); if (zshPtr->cmd == NULL) { goto error; } } else { zshPtr->cmd = NULL; } /* * Prepare the buffers for use. */ zshPtr->inData = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(zshPtr->inData); zshPtr->outData = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(zshPtr->outData); zshPtr->outPos = 0; /* * Now set the variable pointed to by *zshandlePtr to the pointer to the * zsh struct. */ if (zshandlePtr) { *zshandlePtr = (Tcl_ZlibStream) zshPtr; } return TCL_OK; error: if (zshPtr->compDictObj) { Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { ckfree(zshPtr->gzHeaderPtr); } ckfree(zshPtr); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * ZlibStreamCmdDelete -- * * This is the delete command which Tcl invokes when a zlibstream command * is deleted from the interpreter (on stream close, usually). * * Results: * None * * Side effects: * Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit * *---------------------------------------------------------------------- */ static void ZlibStreamCmdDelete( ClientData cd) { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd; zshPtr->cmd = NULL; ZlibStreamCleanup(zshPtr); } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamClose -- * * This procedure must be called after (de)compression is done to ensure * memory is freed and the command is deleted from the interpreter (if * any). * * Results: * A standard Tcl result. * * Side effects: * Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit * *---------------------------------------------------------------------- */ int Tcl_ZlibStreamClose( Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit. */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; /* * If the interp is set, deleting the command will trigger * ZlibStreamCleanup in ZlibStreamCmdDelete. If no interp is set, call * ZlibStreamCleanup directly. */ if (zshPtr->interp && zshPtr->cmd) { Tcl_DeleteCommandFromToken(zshPtr->interp, zshPtr->cmd); } else { ZlibStreamCleanup(zshPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * ZlibStreamCleanup -- * * This procedure is called by either Tcl_ZlibStreamClose or * ZlibStreamCmdDelete to cleanup the stream context. * * Results: * None * * Side effects: * Invalidates the zlib stream handle. * *---------------------------------------------------------------------- */ void ZlibStreamCleanup( ZlibStreamHandle *zshPtr) { if (!zshPtr->streamEnd) { if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { deflateEnd(&zshPtr->stream); } else { inflateEnd(&zshPtr->stream); } } if (zshPtr->inData) { Tcl_DecrRefCount(zshPtr->inData); } if (zshPtr->outData) { Tcl_DecrRefCount(zshPtr->outData); } if (zshPtr->currentInput) { Tcl_DecrRefCount(zshPtr->currentInput); } if (zshPtr->compDictObj) { Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { ckfree(zshPtr->gzHeaderPtr); } ckfree(zshPtr); } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamReset -- * * This procedure will reinitialize an existing stream handle. * * Results: * A standard Tcl result. * * Side effects: * Any data left in the (de)compression buffer is lost. * *---------------------------------------------------------------------- */ int Tcl_ZlibStreamReset( Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; int e; if (!zshPtr->streamEnd) { if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { deflateEnd(&zshPtr->stream); } else { inflateEnd(&zshPtr->stream); } } Tcl_SetByteArrayLength(zshPtr->inData, 0); Tcl_SetByteArrayLength(zshPtr->outData, 0); if (zshPtr->currentInput) { Tcl_DecrRefCount(zshPtr->currentInput); zshPtr->currentInput = NULL; } zshPtr->outPos = 0; zshPtr->streamEnd = 0; memset(&zshPtr->stream, 0, sizeof(z_stream)); /* * No output buffer available yet. */ if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { e = deflateInit2(&zshPtr->stream, zshPtr->level, Z_DEFLATED, zshPtr->wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY); if (e == Z_OK && HaveDictToSet(zshPtr)) { e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj); if (e == Z_OK) { DictWasSet(zshPtr); } } } else { e = inflateInit2(&zshPtr->stream, zshPtr->wbits); if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr) && e == Z_OK) { e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj); if (e == Z_OK) { DictWasSet(zshPtr); } } } if (e != Z_OK) { ConvertError(zshPtr->interp, e, zshPtr->stream.adler); /* TODO:cleanup */ return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamGetCommandName -- * * This procedure will return the command name associated with the * stream. * * Results: * A Tcl_Obj with the name of the Tcl command or NULL if no command is * associated with the stream. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ZlibStreamGetCommandName( Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; Tcl_Obj *objPtr; if (!zshPtr->interp) { return NULL; } TclNewObj(objPtr); Tcl_GetCommandFullName(zshPtr->interp, zshPtr->cmd, objPtr); return objPtr; } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamEof -- * * This procedure This function returns 0 or 1 depending on the state of * the (de)compressor. For decompression, eof is reached when the entire * compressed stream has been decompressed. For compression, eof is * reached when the stream has been flushed with TCL_ZLIB_FINALIZE. * * Results: * Integer. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_ZlibStreamEof( Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; return zshPtr->streamEnd; } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamChecksum -- * * Return the checksum of the uncompressed data seen so far by the * stream. * *---------------------------------------------------------------------- */ int Tcl_ZlibStreamChecksum( Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; return zshPtr->stream.adler; } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamSetCompressionDictionary -- * * Sets the compression dictionary for a stream. This will be used as * appropriate for the next compression or decompression action performed * on the stream. * *---------------------------------------------------------------------- */ void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zshandle, Tcl_Obj *compressionDictionaryObj) { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; if (compressionDictionaryObj != NULL) { if (Tcl_IsShared(compressionDictionaryObj)) { compressionDictionaryObj = Tcl_DuplicateObj(compressionDictionaryObj); } Tcl_IncrRefCount(compressionDictionaryObj); zshPtr->flags |= DICT_TO_SET; } else { zshPtr->flags &= ~DICT_TO_SET; } if (zshPtr->compDictObj != NULL) { Tcl_DecrRefCount(zshPtr->compDictObj); } zshPtr->compDictObj = compressionDictionaryObj; } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamPut -- * * Add data to the stream for compression or decompression from a * bytearray Tcl_Obj. * *---------------------------------------------------------------------- */ #define BUFFER_SIZE_LIMIT 0xFFFF int Tcl_ZlibStreamPut( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* Data to compress/decompress */ int flush) /* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH, * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; char *dataTmp = NULL; int e; int size, outSize, toStore; if (zshPtr->streamEnd) { if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( "already past compressed stream end", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL); } return TCL_ERROR; } if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size); zshPtr->stream.avail_in = size; /* * Must not do a zero-length compress unless finalizing. [Bug 25842c161] */ if (size == 0 && flush != Z_FINISH) { return TCL_OK; } if (HaveDictToSet(zshPtr)) { e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj); if (e != Z_OK) { ConvertError(zshPtr->interp, e, zshPtr->stream.adler); return TCL_ERROR; } DictWasSet(zshPtr); } /* * deflateBound() doesn't seem to take various header sizes into * account, so we add 100 extra bytes. However, we can also loop * around again so we also set an upper bound on the output buffer * size. */ outSize = deflateBound(&zshPtr->stream, size) + 100; if (outSize > BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; } dataTmp = (char *)ckalloc(outSize); while (1) { e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore); /* * Test if we've filled the buffer up and have to ask deflate() to * give us some more. Note that the condition for needing to * repeat a buffer transfer when the result is Z_OK is whether * there is no more space in the buffer we provided; the zlib * library does not necessarily return a different code in that * case. [Bug b26e38a3e4] [Tk Bug 10f2e7872b] */ if ((e != Z_BUF_ERROR) && (e != Z_OK || toStore < outSize)) { if ((e == Z_OK) || (flush == Z_FINISH && e == Z_STREAM_END)) { break; } ConvertError(zshPtr->interp, e, zshPtr->stream.adler); return TCL_ERROR; } /* * Output buffer too small to hold the data being generated or we * are doing the end-of-stream flush (which can spit out masses of * data). This means we need to put a new buffer into place after * saving the old generated data to the outData list. */ AppendByteArray(zshPtr->outData, dataTmp, outSize); if (outSize < BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; /* There may be *lots* of data left to output... */ dataTmp = (char *)ckrealloc(dataTmp, outSize); } } /* * And append the final data block to the outData list. */ AppendByteArray(zshPtr->outData, dataTmp, toStore); ckfree(dataTmp); } else { /* * This is easy. Just append to the inData list. */ Tcl_ListObjAppendElement(NULL, zshPtr->inData, data); /* * and we'll need the flush parameter for the Inflate call. */ zshPtr->flush = flush; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ZlibStreamGet -- * * Retrieve data (now compressed or decompressed) from the stream into a * bytearray Tcl_Obj. * *---------------------------------------------------------------------- */ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ int count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; int e; int i, listLen, itemLen, dataPos = 0; Tcl_Obj *itemObj; unsigned char *dataPtr, *itemPtr; int existing; /* * Getting beyond the of stream, just return empty string. */ if (zshPtr->streamEnd) { return TCL_OK; } (void) Tcl_GetByteArrayFromObj(data, &existing); if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) { if (count == -1) { /* * The only safe thing to do is restict to 65k. We might cause a * panic for out of memory if we just kept growing the buffer. */ count = MAX_BUFFER_SIZE; } /* * Prepare the place to store the data. */ dataPtr = Tcl_SetByteArrayLength(data, existing+count); dataPtr += existing; zshPtr->stream.next_out = dataPtr; zshPtr->stream.avail_out = count; if (zshPtr->stream.avail_in == 0) { /* * zlib will probably need more data to decompress. */ if (zshPtr->currentInput) { Tcl_DecrRefCount(zshPtr->currentInput); zshPtr->currentInput = NULL; } TclListObjLength(NULL, zshPtr->inData, &listLen); if (listLen > 0) { /* * There is more input available, get it from the list and * give it to zlib. At this point, the data must not be shared * since we require the bytearray representation to not vanish * under our feet. [Bug 3081008] */ Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj); if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; zshPtr->stream.avail_in = itemLen; /* * And remove it from the list */ Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL); } } /* * When dealing with a raw stream, we set the dictionary here, once. * (You can't do it in response to getting Z_NEED_DATA as raw streams * don't ever issue that.) */ if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) { e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj); if (e != Z_OK) { ConvertError(zshPtr->interp, e, zshPtr->stream.adler); return TCL_ERROR; } DictWasSet(zshPtr); } e = inflate(&zshPtr->stream, zshPtr->flush); if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) { e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj); if (e == Z_OK) { DictWasSet(zshPtr); e = inflate(&zshPtr->stream, zshPtr->flush); } }; TclListObjLength(NULL, zshPtr->inData, &listLen); while ((zshPtr->stream.avail_out > 0) && (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) { /* * State: We have not satisfied the request yet and there may be * more to inflate. */ if (zshPtr->stream.avail_in > 0) { if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( "unexpected zlib internal state during" " decompression", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE", NULL); } Tcl_SetByteArrayLength(data, existing); return TCL_ERROR; } if (zshPtr->currentInput) { Tcl_DecrRefCount(zshPtr->currentInput); zshPtr->currentInput = 0; } /* * Get the next block of data to go to inflate. At this point, the * data must not be shared since we require the bytearray * representation to not vanish under our feet. [Bug 3081008] */ Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj); if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; zshPtr->stream.avail_in = itemLen; /* * Remove it from the list. */ Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL); listLen--; /* * And call inflate again. */ do { e = inflate(&zshPtr->stream, zshPtr->flush); if (e != Z_NEED_DICT || !HaveDictToSet(zshPtr)) { break; } e = SetInflateDictionary(&zshPtr->stream,zshPtr->compDictObj); DictWasSet(zshPtr); } while (e == Z_OK); } if (zshPtr->stream.avail_out > 0) { Tcl_SetByteArrayLength(data, existing + count - zshPtr->stream.avail_out); } if (!(e==Z_OK || e==Z_STREAM_END || e==Z_BUF_ERROR)) { Tcl_SetByteArrayLength(data, existing); ConvertError(zshPtr->interp, e, zshPtr->stream.adler); return TCL_ERROR; } if (e == Z_STREAM_END) { zshPtr->streamEnd = 1; if (zshPtr->currentInput) { Tcl_DecrRefCount(zshPtr->currentInput); zshPtr->currentInput = 0; } inflateEnd(&zshPtr->stream); } } else { TclListObjLength(NULL, zshPtr->outData, &listLen); if (count == -1) { count = 0; for (i=0; ioutData, i, &itemObj); (void) Tcl_GetByteArrayFromObj(itemObj, &itemLen); if (i == 0) { count += itemLen - zshPtr->outPos; } else { count += itemLen; } } } /* * Prepare the place to store the data. */ dataPtr = Tcl_SetByteArrayLength(data, existing + count); dataPtr += existing; while ((count > dataPos) && (TclListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK) && (listLen > 0)) { /* * Get the next chunk off our list of chunks and grab the data out * of it. */ Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); if (itemLen-zshPtr->outPos >= count-dataPos) { unsigned len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); zshPtr->outPos += len; dataPos += len; if (zshPtr->outPos == itemLen) { zshPtr->outPos = 0; } } else { unsigned len = itemLen - zshPtr->outPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); dataPos += len; zshPtr->outPos = 0; } if (zshPtr->outPos == 0) { Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL); listLen--; } } Tcl_SetByteArrayLength(data, existing + dataPos); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ZlibDeflate -- * * Compress the contents of Tcl_Obj *data with compression level in * output format, producing the compressed data in the interpreter * result. * *---------------------------------------------------------------------- */ int Tcl_ZlibDeflate( Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj) { int wbits = 0, e = 0, extraSize = 0; int inLen = 0; Byte *inData = NULL; z_stream stream; GzipHeader header; gz_header *headerPtr = NULL; Tcl_Obj *obj; if (!interp) { return TCL_ERROR; } /* * Compressed format is specified by the wbits parameter. See zlib.h for * details. */ if (format == TCL_ZLIB_FORMAT_RAW) { wbits = WBITS_RAW; } else if (format == TCL_ZLIB_FORMAT_GZIP) { wbits = WBITS_GZIP; /* * Need to allocate extra space for the gzip header and footer. The * amount of space is (a bit less than) 32 bytes, plus a byte for each * byte of string that we add. Note that over-allocation is not a * problem. [Bug 2419061] */ extraSize = 32; if (gzipHeaderDictObj) { headerPtr = &header.header; memset(headerPtr, 0, sizeof(gz_header)); if (GenerateHeader(interp, gzipHeaderDictObj, &header, &extraSize) != TCL_OK) { return TCL_ERROR; } } } else if (format == TCL_ZLIB_FORMAT_ZLIB) { wbits = WBITS_ZLIB; } else { Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, " "TCL_ZLIB_FORMAT_GZIP or TCL_ZLIB_FORMAT_ZLIB"); } if (level < -1 || level > 9) { Tcl_Panic("compression level should be between 0 (uncompressed) and " "9 (best compression) or -1 for default compression level"); } /* * Allocate some space to store the output. */ TclNewObj(obj); /* * Obtain the pointer to the byte array, we'll pass this pointer straight * to the deflate command. */ inData = Tcl_GetByteArrayFromObj(data, &inLen); memset(&stream, 0, sizeof(z_stream)); stream.avail_in = (uInt) inLen; stream.next_in = inData; /* * No output buffer available yet, will alloc after deflateInit2. */ e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY); if (e != Z_OK) { goto error; } if (headerPtr != NULL) { e = deflateSetHeader(&stream, headerPtr); if (e != Z_OK) { goto error; } } /* * Allocate the output buffer from the value of deflateBound(). This is * probably too much space. Before returning to the caller, we will reduce * it back to the actual compressed size. */ stream.avail_out = deflateBound(&stream, inLen) + extraSize; stream.next_out = Tcl_SetByteArrayLength(obj, stream.avail_out); /* * Perform the compression, Z_FINISH means do it in one go. */ e = deflate(&stream, Z_FINISH); if (e != Z_STREAM_END) { e = deflateEnd(&stream); /* * deflateEnd() returns Z_OK when there are bytes left to compress, at * this point we consider that an error, although we could continue by * allocating more memory and calling deflate() again. */ if (e == Z_OK) { e = Z_BUF_ERROR; } } else { e = deflateEnd(&stream); } if (e != Z_OK) { goto error; } /* * Reduce the ByteArray length to the actual data length produced by * deflate. */ Tcl_SetByteArrayLength(obj, stream.total_out); Tcl_SetObjResult(interp, obj); return TCL_OK; error: ConvertError(interp, e, stream.adler); TclDecrRefCount(obj); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_ZlibInflate -- * * Decompress data in an object into the interpreter result. * *---------------------------------------------------------------------- */ int Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, int bufferSize, Tcl_Obj *gzipHeaderDictObj) { int wbits = 0, e = 0; int inLen = 0, newBufferSize; Byte *inData = NULL, *outData = NULL, *newOutData = NULL; z_stream stream; gz_header header, *headerPtr = NULL; Tcl_Obj *obj; char *nameBuf = NULL, *commentBuf = NULL; if (!interp) { return TCL_ERROR; } /* * Compressed format is specified by the wbits parameter. See zlib.h for * details. */ switch (format) { case TCL_ZLIB_FORMAT_RAW: wbits = WBITS_RAW; gzipHeaderDictObj = NULL; break; case TCL_ZLIB_FORMAT_ZLIB: wbits = WBITS_ZLIB; gzipHeaderDictObj = NULL; break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; break; case TCL_ZLIB_FORMAT_AUTO: wbits = WBITS_AUTODETECT; break; default: Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, " "TCL_ZLIB_FORMAT_GZIP, TCL_ZLIB_FORMAT_RAW or " "TCL_ZLIB_FORMAT_AUTO"); } if (gzipHeaderDictObj) { headerPtr = &header; memset(headerPtr, 0, sizeof(gz_header)); nameBuf = (char *)ckalloc(MAXPATHLEN); header.name = (Bytef *) nameBuf; header.name_max = MAXPATHLEN - 1; commentBuf = (char *)ckalloc(MAX_COMMENT_LEN); header.comment = (Bytef *) commentBuf; header.comm_max = MAX_COMMENT_LEN - 1; } inData = Tcl_GetByteArrayFromObj(data, &inLen); if (bufferSize < 1) { /* * Start with a buffer (up to) 3 times the size of the input data. */ if (inLen < 32*1024*1024) { bufferSize = 3*inLen; } else if (inLen < 256*1024*1024) { bufferSize = 2*inLen; } else { bufferSize = inLen; } } TclNewObj(obj); outData = Tcl_SetByteArrayLength(obj, bufferSize); memset(&stream, 0, sizeof(z_stream)); stream.avail_in = (uInt) inLen+1; /* +1 because zlib can "over-request" * input (but ignore it!) */ stream.next_in = inData; stream.avail_out = bufferSize; stream.next_out = outData; /* * Initialize zlib for decompression. */ e = inflateInit2(&stream, wbits); if (e != Z_OK) { goto error; } if (headerPtr) { e = inflateGetHeader(&stream, headerPtr); if (e != Z_OK) { inflateEnd(&stream); goto error; } } /* * Start the decompression cycle. */ while (1) { e = inflate(&stream, Z_FINISH); if (e != Z_BUF_ERROR) { break; } /* * Not enough room in the output buffer. Increase it by five times the * bytes still in the input buffer. (Because 3 times didn't do the * trick before, 5 times is what we do next.) Further optimization * should be done by the user, specify the decompressed size! */ if ((stream.avail_in == 0) && (stream.avail_out > 0)) { e = Z_STREAM_ERROR; break; } newBufferSize = bufferSize + 5 * stream.avail_in; if (newBufferSize == bufferSize) { newBufferSize = bufferSize+1000; } newOutData = Tcl_SetByteArrayLength(obj, newBufferSize); /* * Set next out to the same offset in the new location. */ stream.next_out = newOutData + stream.total_out; /* * And increase avail_out with the number of new bytes allocated. */ stream.avail_out += newBufferSize - bufferSize; outData = newOutData; bufferSize = newBufferSize; } if (e != Z_STREAM_END) { inflateEnd(&stream); goto error; } e = inflateEnd(&stream); if (e != Z_OK) { goto error; } /* * Reduce the BA length to the actual data length produced by deflate. */ Tcl_SetByteArrayLength(obj, stream.total_out); if (headerPtr != NULL) { ExtractHeader(&header, gzipHeaderDictObj); SetValue(gzipHeaderDictObj, "size", Tcl_NewLongObj(stream.total_out)); ckfree(nameBuf); ckfree(commentBuf); } Tcl_SetObjResult(interp, obj); return TCL_OK; error: TclDecrRefCount(obj); ConvertError(interp, e, stream.adler); if (nameBuf) { ckfree(nameBuf); } if (commentBuf) { ckfree(commentBuf); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_ZlibCRC32, Tcl_ZlibAdler32 -- * * Access to the checksumming engines. * *---------------------------------------------------------------------- */ unsigned int Tcl_ZlibCRC32( unsigned int crc, const unsigned char *buf, int len) { /* Nothing much to do, just wrap the crc32(). */ return crc32(crc, (Bytef *) buf, len); } unsigned int Tcl_ZlibAdler32( unsigned int adler, const unsigned char *buf, int len) { return adler32(adler, (Bytef *) buf, len); } /* *---------------------------------------------------------------------- * * ZlibCmd -- * * Implementation of the [zlib] command. * *---------------------------------------------------------------------- */ static int ZlibCmd( ClientData notUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int command, dlen, i, option, level = -1; unsigned start, buffersize = 0; Byte *data; Tcl_Obj *headerDictObj; const char *extraInfoStr = NULL; static const char *const commands[] = { "adler32", "compress", "crc32", "decompress", "deflate", "gunzip", "gzip", "inflate", "push", "stream", NULL }; enum zlibCommands { CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE, CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0, &command) != TCL_OK) { return TCL_ERROR; } switch ((enum zlibCommands) command) { case CMD_ADLER: /* adler32 str ?startvalue? * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; } if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } if (objc < 4) { start = Tcl_ZlibAdler32(0, NULL, 0); } data = Tcl_GetByteArrayFromObj(objv[2], &dlen); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibAdler32(start, data, dlen))); return TCL_OK; case CMD_CRC: /* crc32 str ?startvalue? * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; } if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } if (objc < 4) { start = Tcl_ZlibCRC32(0, NULL, 0); } data = Tcl_GetByteArrayFromObj(objv[2], &dlen); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibCRC32(start, data, dlen))); return TCL_OK; case CMD_DEFLATE: /* deflate data ?level? * -> rawCompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?level?"); return TCL_ERROR; } if (objc > 3) { if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) { return TCL_ERROR; } if (level < 0 || level > 9) { goto badLevel; } } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], level, NULL); case CMD_COMPRESS: /* compress data ?level? * -> zlibCompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?level?"); return TCL_ERROR; } if (objc > 3) { if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) { return TCL_ERROR; } if (level < 0 || level > 9) { goto badLevel; } } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level, NULL); case CMD_GZIP: /* gzip data ?level? * -> gzippedCompressedData */ headerDictObj = NULL; /* * Legacy argument format support. */ if (objc == 4 && Tcl_GetIntFromObj(interp, objv[3], &level) == TCL_OK) { if (level < 0 || level > 9) { extraInfoStr = "\n (in -level option)"; goto badLevel; } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level, NULL); } if (objc < 3 || objc > 7 || ((objc & 1) == 0)) { Tcl_WrongNumArgs(interp, 2, objv, "data ?-level level? ?-header header?"); return TCL_ERROR; } for (i=3 ; i 9) { extraInfoStr = "\n (in -level option)"; goto badLevel; } break; } } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level, headerDictObj); case CMD_INFLATE: /* inflate rawcomprdata ?bufferSize? * -> decompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); return TCL_ERROR; } if (objc > 3) { if (Tcl_GetIntFromObj(interp, objv[3], (int *) &buffersize) != TCL_OK) { return TCL_ERROR; } if (buffersize < MIN_NONSTREAM_BUFFER_SIZE || buffersize > MAX_BUFFER_SIZE) { goto badBuffer; } } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], buffersize, NULL); case CMD_DECOMPRESS: /* decompress zlibcomprdata \ * ?bufferSize? * -> decompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); return TCL_ERROR; } if (objc > 3) { if (Tcl_GetIntFromObj(interp, objv[3], (int *) &buffersize) != TCL_OK) { return TCL_ERROR; } if (buffersize < MIN_NONSTREAM_BUFFER_SIZE || buffersize > MAX_BUFFER_SIZE) { goto badBuffer; } } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], buffersize, NULL); case CMD_GUNZIP: { /* gunzip gzippeddata ?bufferSize? * -> decompressedData */ Tcl_Obj *headerVarObj; if (objc < 3 || objc > 5 || ((objc & 1) == 0)) { Tcl_WrongNumArgs(interp, 2, objv, "data ?-headerVar varName?"); return TCL_ERROR; } headerDictObj = headerVarObj = NULL; for (i=3 ; i MAX_BUFFER_SIZE) { goto badBuffer; } break; case 1: headerVarObj = objv[i+1]; TclNewObj(headerDictObj); break; } } if (Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], buffersize, headerDictObj) != TCL_OK) { if (headerDictObj) { TclDecrRefCount(headerDictObj); } return TCL_ERROR; } if (headerVarObj != NULL && Tcl_ObjSetVar2(interp, headerVarObj, NULL, headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } return TCL_OK; } case CMD_STREAM: /* stream deflate/inflate/...gunzip \ * ?options...? * -> handleCmd */ return ZlibStreamSubcmd(interp, objc, objv); case CMD_PUSH: /* push mode channel options... * -> channel */ return ZlibPushSubcmd(interp, objc, objv); }; return TCL_ERROR; badLevel: Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); if (extraInfoStr) { Tcl_AddErrorInfo(interp, extraInfoStr); } return TCL_ERROR; badBuffer: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "buffer size must be %d to %d", MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * ZlibStreamSubcmd -- * * Implementation of the [zlib stream] subcommand. * *---------------------------------------------------------------------- */ static int ZlibStreamSubcmd( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *const stream_formats[] = { "compress", "decompress", "deflate", "gunzip", "gzip", "inflate", NULL }; enum zlibFormats { FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP, FMT_INFLATE }; int i, format, mode = 0, option, level; enum objIndices { OPT_COMPRESSION_DICTIONARY = 0, OPT_GZIP_HEADER = 1, OPT_COMPRESSION_LEVEL = 2, OPT_END = -1 }; Tcl_Obj *obj[3] = { NULL, NULL, NULL }; #define compDictObj obj[OPT_COMPRESSION_DICTIONARY] #define gzipHeaderObj obj[OPT_GZIP_HEADER] #define levelObj obj[OPT_COMPRESSION_LEVEL] typedef struct { const char *name; enum objIndices offset; } OptDescriptor; static const OptDescriptor compressionOpts[] = { { "-dictionary", OPT_COMPRESSION_DICTIONARY }, { "-level", OPT_COMPRESSION_LEVEL }, { NULL, OPT_END } }; static const OptDescriptor gzipOpts[] = { { "-header", OPT_GZIP_HEADER }, { "-level", OPT_COMPRESSION_LEVEL }, { NULL, OPT_END } }; static const OptDescriptor expansionOpts[] = { { "-dictionary", OPT_COMPRESSION_DICTIONARY }, { NULL, OPT_END } }; static const OptDescriptor gunzipOpts[] = { { NULL, OPT_END } }; const OptDescriptor *desc = NULL; Tcl_ZlibStream zh; if (objc < 3 || !(objc & 1)) { Tcl_WrongNumArgs(interp, 2, objv, "mode ?-option value...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0, &format) != TCL_OK) { return TCL_ERROR; } /* * The format determines the compression mode and the options that may be * specified. */ switch ((enum zlibFormats) format) { case FMT_DEFLATE: desc = compressionOpts; mode = TCL_ZLIB_STREAM_DEFLATE; format = TCL_ZLIB_FORMAT_RAW; break; case FMT_INFLATE: desc = expansionOpts; mode = TCL_ZLIB_STREAM_INFLATE; format = TCL_ZLIB_FORMAT_RAW; break; case FMT_COMPRESS: desc = compressionOpts; mode = TCL_ZLIB_STREAM_DEFLATE; format = TCL_ZLIB_FORMAT_ZLIB; break; case FMT_DECOMPRESS: desc = expansionOpts; mode = TCL_ZLIB_STREAM_INFLATE; format = TCL_ZLIB_FORMAT_ZLIB; break; case FMT_GZIP: desc = gzipOpts; mode = TCL_ZLIB_STREAM_DEFLATE; format = TCL_ZLIB_FORMAT_GZIP; break; case FMT_GUNZIP: desc = gunzipOpts; mode = TCL_ZLIB_STREAM_INFLATE; format = TCL_ZLIB_FORMAT_GZIP; break; default: Tcl_Panic("should be unreachable"); } /* * Parse the options. */ for (i=3 ; i 9) { Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); Tcl_AddErrorInfo(interp, "\n (in -level option)"); return TCL_ERROR; } /* * Construct the stream now we know its configuration. */ if (Tcl_ZlibStreamInit(interp, mode, format, level, gzipHeaderObj, &zh) != TCL_OK) { return TCL_ERROR; } if (compDictObj != NULL) { Tcl_ZlibStreamSetCompressionDictionary(zh, compDictObj); } Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh)); return TCL_OK; #undef compDictObj #undef gzipHeaderObj #undef levelObj } /* *---------------------------------------------------------------------- * * ZlibPushSubcmd -- * * Implementation of the [zlib push] subcommand. * *---------------------------------------------------------------------- */ static int ZlibPushSubcmd( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *const stream_formats[] = { "compress", "decompress", "deflate", "gunzip", "gzip", "inflate", NULL }; enum zlibFormats { FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP, FMT_INFLATE }; Tcl_Channel chan; int chanMode, format, mode = 0, level, i, option; static const char *const pushCompressOptions[] = { "-dictionary", "-header", "-level", NULL }; static const char *const pushDecompressOptions[] = { "-dictionary", "-header", "-level", "-limit", NULL }; const char *const *pushOptions = pushDecompressOptions; enum pushOptions {poDictionary, poHeader, poLevel, poLimit}; Tcl_Obj *headerObj = NULL, *compDictObj = NULL; int limit = DEFAULT_BUFFER_SIZE; int dummy; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0, &format) != TCL_OK) { return TCL_ERROR; } switch ((enum zlibFormats) format) { case FMT_DEFLATE: mode = TCL_ZLIB_STREAM_DEFLATE; format = TCL_ZLIB_FORMAT_RAW; pushOptions = pushCompressOptions; break; case FMT_INFLATE: mode = TCL_ZLIB_STREAM_INFLATE; format = TCL_ZLIB_FORMAT_RAW; break; case FMT_COMPRESS: mode = TCL_ZLIB_STREAM_DEFLATE; format = TCL_ZLIB_FORMAT_ZLIB; pushOptions = pushCompressOptions; break; case FMT_DECOMPRESS: mode = TCL_ZLIB_STREAM_INFLATE; format = TCL_ZLIB_FORMAT_ZLIB; break; case FMT_GZIP: mode = TCL_ZLIB_STREAM_DEFLATE; format = TCL_ZLIB_FORMAT_GZIP; pushOptions = pushCompressOptions; break; case FMT_GUNZIP: mode = TCL_ZLIB_STREAM_INFLATE; format = TCL_ZLIB_FORMAT_GZIP; break; default: Tcl_Panic("should be unreachable"); } if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK){ return TCL_ERROR; } /* * Sanity checks. */ if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "compression may only be applied to writable channels", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL); return TCL_ERROR; } if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "decompression may only be applied to readable channels",-1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL); return TCL_ERROR; } /* * Parse options. */ level = Z_DEFAULT_COMPRESSION; for (i=4 ; i objc-1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "value missing for %s option", pushOptions[option])); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); return TCL_ERROR; } switch ((enum pushOptions) option) { case poHeader: headerObj = objv[i]; if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) { goto genericOptionError; } break; case poLevel: if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) { goto genericOptionError; } if (level < 0 || level > 9) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "level must be 0 to 9", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); goto genericOptionError; } break; case poLimit: if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) { goto genericOptionError; } if (limit < 1 || limit > MAX_BUFFER_SIZE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "read ahead limit must be 1 to %d", MAX_BUFFER_SIZE)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL); goto genericOptionError; } break; case poDictionary: if (format == TCL_ZLIB_FORMAT_GZIP) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "a compression dictionary may not be set in the " "gzip format", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", NULL); goto genericOptionError; } compDictObj = objv[i]; break; } } if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan, headerObj, compDictObj) == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, objv[3]); return TCL_OK; genericOptionError: Tcl_AddErrorInfo(interp, "\n (in "); Tcl_AddErrorInfo(interp, pushOptions[option]); Tcl_AddErrorInfo(interp, " option)"); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * ZlibStreamCmd -- * * Implementation of the commands returned by [zlib stream]. * *---------------------------------------------------------------------- */ static int ZlibStreamCmd( ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; int command, count, code; Tcl_Obj *obj; static const char *const cmds[] = { "add", "checksum", "close", "eof", "finalize", "flush", "fullflush", "get", "header", "put", "reset", NULL }; enum zlibStreamCommands { zs_add, zs_checksum, zs_close, zs_eof, zs_finalize, zs_flush, zs_fullflush, zs_get, zs_header, zs_put, zs_reset }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option data ?...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "option", 0, &command) != TCL_OK) { return TCL_ERROR; } switch ((enum zlibStreamCommands) command) { case zs_add: /* $strm add ?$flushopt? $data */ return ZlibStreamAddCmd(zstream, interp, objc, objv); case zs_header: /* $strm header */ return ZlibStreamHeaderCmd(zstream, interp, objc, objv); case zs_put: /* $strm put ?$flushopt? $data */ return ZlibStreamPutCmd(zstream, interp, objc, objv); case zs_get: /* $strm get ?count? */ if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "?count?"); return TCL_ERROR; } count = -1; if (objc >= 3) { if (Tcl_GetIntFromObj(interp, objv[2], &count) != TCL_OK) { return TCL_ERROR; } } TclNewObj(obj); code = Tcl_ZlibStreamGet(zstream, obj, count); if (code == TCL_OK) { Tcl_SetObjResult(interp, obj); } else { TclDecrRefCount(obj); } return code; case zs_flush: /* $strm flush */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } TclNewObj(obj); Tcl_IncrRefCount(obj); code = Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH); TclDecrRefCount(obj); return code; case zs_fullflush: /* $strm fullflush */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } TclNewObj(obj); Tcl_IncrRefCount(obj); code = Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH); TclDecrRefCount(obj); return code; case zs_finalize: /* $strm finalize */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } /* * The flush commands slightly abuse the empty result obj as input * data. */ TclNewObj(obj); Tcl_IncrRefCount(obj); code = Tcl_ZlibStreamPut(zstream, obj, Z_FINISH); TclDecrRefCount(obj); return code; case zs_close: /* $strm close */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } return Tcl_ZlibStreamClose(zstream); case zs_eof: /* $strm eof */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream))); return TCL_OK; case zs_checksum: /* $strm checksum */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibStreamChecksum(zstream))); return TCL_OK; case zs_reset: /* $strm reset */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } return Tcl_ZlibStreamReset(zstream); } return TCL_OK; } static int ZlibStreamAddCmd( ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; int index, code, buffersize = -1, flush = -1, i; Tcl_Obj *obj, *compDictObj = NULL; static const char *const add_options[] = { "-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL }; enum addOptions { ao_buffer, ao_dictionary, ao_finalize, ao_flush, ao_fullflush }; for (i=2; i= 0) { flush = -2; } else { flush = Z_SYNC_FLUSH; } break; case ao_fullflush: /* -fullflush */ if (flush >= 0) { flush = -2; } else { flush = Z_FULL_FLUSH; } break; case ao_finalize: /* -finalize */ if (flush >= 0) { flush = -2; } else { flush = Z_FINISH; } break; case ao_buffer: /* -buffer */ if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-buffer\" option must be followed by integer " "decompression buffersize", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[++i], &buffersize) != TCL_OK) { return TCL_ERROR; } if (buffersize < 1 || buffersize > MAX_BUFFER_SIZE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "buffer size must be 1 to %d", MAX_BUFFER_SIZE)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL); return TCL_ERROR; } break; case ao_dictionary: if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" " compression dictionary bytes", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); return TCL_ERROR; } compDictObj = objv[++i]; break; } if (flush == -2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-flush\", \"-fullflush\" and \"-finalize\" options" " are mutually exclusive", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL); return TCL_ERROR; } } if (flush == -1) { flush = 0; } /* * Set the compression dictionary if requested. */ if (compDictObj != NULL) { int len; (void) Tcl_GetByteArrayFromObj(compDictObj, &len); if (len == 0) { compDictObj = NULL; } Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj); } /* * Send the data to the stream core, along with any flushing directive. */ if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) { return TCL_ERROR; } /* * Get such data out as we can (up to the requested length). */ TclNewObj(obj); code = Tcl_ZlibStreamGet(zstream, obj, buffersize); if (code == TCL_OK) { Tcl_SetObjResult(interp, obj); } else { TclDecrRefCount(obj); } return code; } static int ZlibStreamPutCmd( ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; int index, flush = -1, i; Tcl_Obj *compDictObj = NULL; static const char *const put_options[] = { "-dictionary", "-finalize", "-flush", "-fullflush", NULL }; enum putOptions { po_dictionary, po_finalize, po_flush, po_fullflush }; for (i=2; i= 0) { flush = -2; } else { flush = Z_SYNC_FLUSH; } break; case po_fullflush: /* -fullflush */ if (flush >= 0) { flush = -2; } else { flush = Z_FULL_FLUSH; } break; case po_finalize: /* -finalize */ if (flush >= 0) { flush = -2; } else { flush = Z_FINISH; } break; case po_dictionary: if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" " compression dictionary bytes", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); return TCL_ERROR; } compDictObj = objv[++i]; break; } if (flush == -2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-flush\", \"-fullflush\" and \"-finalize\" options" " are mutually exclusive", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL); return TCL_ERROR; } } if (flush == -1) { flush = 0; } /* * Set the compression dictionary if requested. */ if (compDictObj != NULL) { int len; (void) Tcl_GetByteArrayFromObj(compDictObj, &len); if (len == 0) { compDictObj = NULL; } Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj); } /* * Send the data to the stream core, along with any flushing directive. */ return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush); } static int ZlibStreamHeaderCmd( ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd; Tcl_Obj *resultObj; if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "only gunzip streams can produce header information", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", NULL); return TCL_ERROR; } TclNewObj(resultObj); ExtractHeader(&zshPtr->gzHeaderPtr->header, resultObj); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *---------------------------------------------------------------------- * Set of functions to support channel stacking. *---------------------------------------------------------------------- * * ZlibTransformClose -- * * How to shut down a stacked compressing/decompressing transform. * *---------------------------------------------------------------------- */ static int ZlibTransformClose( ClientData instanceData, Tcl_Interp *interp) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; int e, result = TCL_OK; int written; /* * Delete the support timer. */ ZlibTransformEventTimerKill(cd); /* * Flush any data waiting to be compressed. */ if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { cd->outStream.avail_in = 0; do { e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, Z_FINISH, &written); /* * Can't be sure that deflate() won't declare the buffer to be * full (with Z_BUF_ERROR) so handle that case. */ if (e == Z_BUF_ERROR) { e = Z_OK; written = cd->outAllocated; } if (e != Z_OK && e != Z_STREAM_END) { /* TODO: is this the right way to do errors on close? */ if (!TclInThreadExit()) { ConvertError(interp, e, cd->outStream.adler); } result = TCL_ERROR; break; } if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 0) { /* TODO: is this the right way to do errors on close? * Note: when close is called from FinalizeIOSubsystem then * interp may be NULL */ if (!TclInThreadExit() && interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error while finalizing file: %s", Tcl_PosixError(interp))); } result = TCL_ERROR; break; } } while (e != Z_STREAM_END); (void) deflateEnd(&cd->outStream); } else { /* * If we have unused bytes from the read input (overshot by * Z_STREAM_END or on possible error), unget them back to the parent * channel, so that they appear as not being read yet. */ if (cd->inStream.avail_in) { Tcl_Ungets (cd->parent, (char *)cd->inStream.next_in, cd->inStream.avail_in, 0); } (void) inflateEnd(&cd->inStream); } /* * Release all memory. */ if (cd->compDictObj) { Tcl_DecrRefCount(cd->compDictObj); cd->compDictObj = NULL; } if (cd->inBuffer) { ckfree(cd->inBuffer); cd->inBuffer = NULL; } if (cd->outBuffer) { ckfree(cd->outBuffer); cd->outBuffer = NULL; } ckfree(cd); return result; } /* *---------------------------------------------------------------------- * * ZlibTransformInput -- * * Reader filter that does decompression. * *---------------------------------------------------------------------- */ static int ZlibTransformInput( ClientData instanceData, char *buf, int toRead, int *errorCodePtr) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverInputProc *inProc = Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent)); int readBytes, gotBytes; if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead, errorCodePtr); } gotBytes = 0; readBytes = cd->inStream.avail_in; /* how many bytes in buffer now */ while (!(cd->flags & STREAM_DONE) && toRead > 0) { int n, decBytes; /* if starting from scratch or continuation after full decompression */ if (!cd->inStream.avail_in) { /* buffer to start, we can read to whole available buffer */ cd->inStream.next_in = (Bytef *) cd->inBuffer; } /* * If done - no read needed anymore, check we have to copy rest of * decompressed data, otherwise return with size (or 0 for Eof) */ if (cd->flags & STREAM_DECOMPRESS) { goto copyDecompressed; } /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then * transform them for delivery. We may not get what we want (full EOF * or temporarily out of data). */ /* Check free buffer size and adjust size of next chunk to read. */ n = cd->inAllocated - ((char *)cd->inStream.next_in - cd->inBuffer); if (n <= 0) { /* Normally unreachable: not enough input buffer to uncompress. * Todo: firstly try to realloc inBuffer upto MAX_BUFFER_SIZE. */ *errorCodePtr = ENOBUFS; return -1; } if (n > cd->readAheadLimit) { n = cd->readAheadLimit; } readBytes = Tcl_ReadRaw(cd->parent, (char *)cd->inStream.next_in, n); /* * Three cases here: * 1. Got some data from the underlying channel (readBytes > 0) so * it should be fed through the decompression engine. * 2. Got an error (readBytes < 0) which we should report up except * for the case where we can convert it to a short read. * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If * it is EOF, try flushing the data out of the decompressor. */ if (readBytes < 0) { /* See ReflectInput() in tclIORTrans.c */ if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { break; } *errorCodePtr = Tcl_GetErrno(); return -1; } /* more bytes (or Eof if readBytes == 0) */ cd->inStream.avail_in += readBytes; copyDecompressed: /* * Transform the read chunk, if not empty. Anything we get * back is a transformation result to be put into our buffers, and * the next iteration will put it into the result. * For the case readBytes is 0 which signaling Eof in parent, the * partial data waiting is converted and returned. */ decBytes = ResultDecompress(cd, buf, toRead, (readBytes != 0) ? Z_NO_FLUSH : Z_SYNC_FLUSH, errorCodePtr); if (decBytes == -1) { return -1; } gotBytes += decBytes; buf += decBytes; toRead -= decBytes; if (((decBytes == 0) || (cd->flags & STREAM_DECOMPRESS))) { /* * The drain delivered nothing (or buffer too small to decompress). * Time to deliver what we've got. */ if (!gotBytes && !(cd->flags & STREAM_DONE)) { /* if no-data, but not ready - avoid signaling Eof, * continue in blocking mode, otherwise EAGAIN */ if (Tcl_InputBlocked(cd->parent)) { continue; } *errorCodePtr = EAGAIN; return -1; } break; } /* * Loop until the request is satisfied (or no data available from * above, possibly EOF). */ } return gotBytes; } /* *---------------------------------------------------------------------- * * ZlibTransformOutput -- * * Writer filter that does compression. * *---------------------------------------------------------------------- */ static int ZlibTransformOutput( ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverOutputProc *outProc = Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent)); int e, produced; Tcl_Obj *errObj; if (cd->mode == TCL_ZLIB_STREAM_INFLATE) { return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite, errorCodePtr); } /* * No zero-length writes. Flushes must be explicit. */ if (toWrite == 0) { return 0; } cd->outStream.next_in = (Bytef *) buf; cd->outStream.avail_in = toWrite; while (cd->outStream.avail_in > 0) { e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, Z_NO_FLUSH, &produced); if (e != Z_OK || produced == 0) { break; } if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) { *errorCodePtr = Tcl_GetErrno(); return -1; } } if (e == Z_OK) { return toWrite - cd->outStream.avail_in; } errObj = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1)); Tcl_ListObjAppendElement(NULL, errObj, ConvertErrorToList(e, cd->outStream.adler)); Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj(cd->outStream.msg, -1)); Tcl_SetChannelError(cd->parent, errObj); *errorCodePtr = EINVAL; return -1; } /* *---------------------------------------------------------------------- * * ZlibTransformFlush -- * * How to perform a flush of a compressing transform. * *---------------------------------------------------------------------- */ static int ZlibTransformFlush( Tcl_Interp *interp, ZlibChannelData *cd, int flushType) { int e, len; cd->outStream.avail_in = 0; do { /* * Get the bytes to go out of the compression engine. */ e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, flushType, &len); if (e != Z_OK && e != Z_BUF_ERROR) { ConvertError(interp, e, cd->outStream.adler); return TCL_ERROR; } /* * Write the bytes we've received to the next layer. */ if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "problem flushing channel: %s", Tcl_PosixError(interp))); return TCL_ERROR; } /* * If we get to this point, either we're in the Z_OK or the * Z_BUF_ERROR state. In the former case, we're done. In the latter * case, it's because there's more bytes to go than would fit in the * buffer we provided, and we need to go round again to get some more. * * We also stop the loop if we would have done a zero-length write. * Those can cause problems at the OS level. */ } while (len > 0 && e == Z_BUF_ERROR); return TCL_OK; } /* *---------------------------------------------------------------------- * * ZlibTransformSetOption -- * * Writing side of [fconfigure] on our channel. * *---------------------------------------------------------------------- */ static int ZlibTransformSetOption( /* not used */ ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverSetOptionProc *setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent)); static const char *compressChanOptions = "dictionary flush"; static const char *gzipChanOptions = "flush"; static const char *decompressChanOptions = "dictionary limit"; static const char *gunzipChanOptions = "flush limit"; int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE); if (optionName && (strcmp(optionName, "-dictionary") == 0) && (cd->format != TCL_ZLIB_FORMAT_GZIP)) { Tcl_Obj *compDictObj; int code; TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); (void) Tcl_GetByteArrayFromObj(compDictObj, NULL); if (cd->compDictObj) { TclDecrRefCount(cd->compDictObj); } cd->compDictObj = compDictObj; code = Z_OK; if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { code = SetDeflateDictionary(&cd->outStream, compDictObj); if (code != Z_OK) { ConvertError(interp, code, cd->outStream.adler); return TCL_ERROR; } } else if (cd->format == TCL_ZLIB_FORMAT_RAW) { code = SetInflateDictionary(&cd->inStream, compDictObj); if (code != Z_OK) { ConvertError(interp, code, cd->inStream.adler); return TCL_ERROR; } } return TCL_OK; } if (haveFlushOpt) { if (optionName && strcmp(optionName, "-flush") == 0) { int flushType; if (value[0] == 'f' && strcmp(value, "full") == 0) { flushType = Z_FULL_FLUSH; } else if (value[0] == 's' && strcmp(value, "sync") == 0) { flushType = Z_SYNC_FLUSH; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown -flush type \"%s\": must be full or sync", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL); return TCL_ERROR; } /* * Try to actually do the flush now. */ return ZlibTransformFlush(interp, cd, flushType); } } else { if (optionName && strcmp(optionName, "-limit") == 0) { int newLimit; if (Tcl_GetInt(interp, value, &newLimit) != TCL_OK) { return TCL_ERROR; } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "-limit must be between 1 and 65536", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", NULL); return TCL_ERROR; } } } if (setOptionProc == NULL) { if (cd->format == TCL_ZLIB_FORMAT_GZIP) { return Tcl_BadChannelOption(interp, optionName, (cd->mode == TCL_ZLIB_STREAM_DEFLATE) ? gzipChanOptions : gunzipChanOptions); } else { return Tcl_BadChannelOption(interp, optionName, (cd->mode == TCL_ZLIB_STREAM_DEFLATE) ? compressChanOptions : decompressChanOptions); } } /* * Pass all unknown options down, to deeper transforms and/or the base * channel. */ return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp, optionName, value); } /* *---------------------------------------------------------------------- * * ZlibTransformGetOption -- * * Reading side of [fconfigure] on our channel. * *---------------------------------------------------------------------- */ static int ZlibTransformGetOption( ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverGetOptionProc *getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent)); static const char *compressChanOptions = "checksum dictionary"; static const char *gzipChanOptions = "checksum"; static const char *decompressChanOptions = "checksum dictionary limit"; static const char *gunzipChanOptions = "checksum header limit"; /* * The "crc" option reports the current CRC (calculated with the Adler32 * or CRC32 algorithm according to the format) given the data that has * been processed so far. */ if (optionName == NULL || strcmp(optionName, "-checksum") == 0) { uLong crc; char buf[12]; if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { crc = cd->outStream.adler; } else { crc = cd->inStream.adler; } snprintf(buf, sizeof(buf), "%lu", crc); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-checksum"); Tcl_DStringAppendElement(dsPtr, buf); } else { Tcl_DStringAppend(dsPtr, buf, -1); return TCL_OK; } } if ((cd->format != TCL_ZLIB_FORMAT_GZIP) && (optionName == NULL || strcmp(optionName, "-dictionary") == 0)) { /* * Embedded NUL bytes are ok; they'll be C080-encoded. */ if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-dictionary"); if (cd->compDictObj) { Tcl_DStringAppendElement(dsPtr, Tcl_GetString(cd->compDictObj)); } else { Tcl_DStringAppendElement(dsPtr, ""); } } else { if (cd->compDictObj) { int len; const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len); Tcl_DStringAppend(dsPtr, str, len); } return TCL_OK; } } /* * The "header" option, which is only valid on inflating gzip channels, * reports the header that has been read from the start of the stream. */ if ((cd->flags & IN_HEADER) && ((optionName == NULL) || (strcmp(optionName, "-header") == 0))) { Tcl_Obj *tmpObj; TclNewObj(tmpObj); ExtractHeader(&cd->inHeader.header, tmpObj); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-header"); Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { TclDStringAppendObj(dsPtr, tmpObj); Tcl_DecrRefCount(tmpObj); return TCL_OK; } } /* * Now we do the standard processing of the stream we wrapped. */ if (getOptionProc) { return getOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp, optionName, dsPtr); } if (optionName == NULL) { return TCL_OK; } if (cd->format == TCL_ZLIB_FORMAT_GZIP) { return Tcl_BadChannelOption(interp, optionName, (cd->mode == TCL_ZLIB_STREAM_DEFLATE) ? gzipChanOptions : gunzipChanOptions); } else { return Tcl_BadChannelOption(interp, optionName, (cd->mode == TCL_ZLIB_STREAM_DEFLATE) ? compressChanOptions : decompressChanOptions); } } /* *---------------------------------------------------------------------- * * ZlibTransformWatch, ZlibTransformEventHandler -- * * If we have data pending, trigger a readable event after a short time * (in order to allow a real event to catch up). * *---------------------------------------------------------------------- */ static void ZlibTransformWatch( ClientData instanceData, int mask) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverWatchProc *watchProc; /* * This code is based on the code in tclIORTrans.c */ watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent)); watchProc(Tcl_GetChannelInstanceData(cd->parent), mask); if (!(mask & TCL_READABLE) || !(cd->flags & STREAM_DECOMPRESS)) { ZlibTransformEventTimerKill(cd); } else if (cd->timer == NULL) { cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ZlibTransformTimerRun, cd); } } static int ZlibTransformEventHandler( ClientData instanceData, int interestMask) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; ZlibTransformEventTimerKill(cd); return interestMask; } static inline void ZlibTransformEventTimerKill( ZlibChannelData *cd) { if (cd->timer != NULL) { Tcl_DeleteTimerHandler(cd->timer); cd->timer = NULL; } } static void ZlibTransformTimerRun( ClientData clientData) { ZlibChannelData *cd = (ZlibChannelData *)clientData; cd->timer = NULL; Tcl_NotifyChannel(cd->chan, TCL_READABLE); } /* *---------------------------------------------------------------------- * * ZlibTransformGetHandle -- * * Anything that needs the OS handle is told to get it from what we are * stacked on top of. * *---------------------------------------------------------------------- */ static int ZlibTransformGetHandle( ClientData instanceData, int direction, ClientData *handlePtr) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); } /* *---------------------------------------------------------------------- * * ZlibTransformBlockMode -- * * We need to keep track of the blocking mode; it changes our behavior. * *---------------------------------------------------------------------- */ static int ZlibTransformBlockMode( ClientData instanceData, int mode) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; if (mode == TCL_MODE_NONBLOCKING) { cd->flags |= ASYNC; } else { cd->flags &= ~ASYNC; } return TCL_OK; } /* *---------------------------------------------------------------------- * * ZlibStackChannelTransform -- * * Stacks either compression or decompression onto a channel. * * Results: * The stacked channel, or NULL if there was an error. * *---------------------------------------------------------------------- */ static Tcl_Channel ZlibStackChannelTransform( Tcl_Interp *interp, /* Where to write error messages. */ int mode, /* Whether this is a compressing transform * (TCL_ZLIB_STREAM_DEFLATE) or a * decompressing transform * (TCL_ZLIB_STREAM_INFLATE). Note that * compressing transforms require that the * channel is writable, and decompressing * transforms require that the channel is * readable. */ int format, /* One of the TCL_ZLIB_FORMAT_* values that * indicates what compressed format to allow. * TCL_ZLIB_FORMAT_AUTO is only supported for * decompressing transforms. */ int level, /* What compression level to use. Ignored for * decompressing transforms. */ int limit, /* The limit on the number of bytes to read * ahead; always at least 1. */ Tcl_Channel channel, /* The channel to attach to. */ Tcl_Obj *gzipHeaderDictPtr, /* A description of header to use, or NULL to * use a default. Ignored if not compressing * to produce gzip-format data. */ Tcl_Obj *compDictObj) /* Byte-array object containing compression * dictionary (not dictObj!) to use if * necessary. */ { ZlibChannelData *cd = (ZlibChannelData *)ckalloc(sizeof(ZlibChannelData)); Tcl_Channel chan; int wbits = 0; if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) { Tcl_Panic("unknown mode: %d", mode); } memset(cd, 0, sizeof(ZlibChannelData)); cd->mode = mode; cd->format = format; cd->readAheadLimit = limit; if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) { if (mode == TCL_ZLIB_STREAM_DEFLATE) { if (gzipHeaderDictPtr) { cd->flags |= OUT_HEADER; if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader, NULL) != TCL_OK) { goto error; } } } else { cd->flags |= IN_HEADER; cd->inHeader.header.name = (Bytef *) &cd->inHeader.nativeFilenameBuf; cd->inHeader.header.name_max = MAXPATHLEN - 1; cd->inHeader.header.comment = (Bytef *) &cd->inHeader.nativeCommentBuf; cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; } } if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); Tcl_GetByteArrayFromObj(cd->compDictObj, NULL); } if (format == TCL_ZLIB_FORMAT_RAW) { wbits = WBITS_RAW; } else if (format == TCL_ZLIB_FORMAT_ZLIB) { wbits = WBITS_ZLIB; } else if (format == TCL_ZLIB_FORMAT_GZIP) { wbits = WBITS_GZIP; } else if (format == TCL_ZLIB_FORMAT_AUTO) { wbits = WBITS_AUTODETECT; } else { Tcl_Panic("bad format: %d", format); } /* * Initialize input inflater or the output deflater. */ if (mode == TCL_ZLIB_STREAM_INFLATE) { if (inflateInit2(&cd->inStream, wbits) != Z_OK) { goto error; } cd->inAllocated = DEFAULT_BUFFER_SIZE; if (cd->inAllocated < cd->readAheadLimit) { cd->inAllocated = cd->readAheadLimit; } cd->inBuffer = (char *)ckalloc(cd->inAllocated); if (cd->flags & IN_HEADER) { if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) { goto error; } } if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) { if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) { goto error; } } } else { if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) { goto error; } cd->outAllocated = DEFAULT_BUFFER_SIZE; cd->outBuffer = (char *)ckalloc(cd->outAllocated); if (cd->flags & OUT_HEADER) { if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) { goto error; } } if (cd->compDictObj) { if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) { goto error; } } } chan = Tcl_StackChannel(interp, &zlibChannelType, cd, Tcl_GetChannelMode(channel), channel); if (chan == NULL) { goto error; } cd->chan = chan; cd->parent = Tcl_GetStackedChannel(chan); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return chan; error: if (cd->inBuffer) { ckfree(cd->inBuffer); inflateEnd(&cd->inStream); } if (cd->outBuffer) { ckfree(cd->outBuffer); deflateEnd(&cd->outStream); } if (cd->compDictObj) { Tcl_DecrRefCount(cd->compDictObj); } ckfree(cd); return NULL; } /* *---------------------------------------------------------------------- * * ResultDecompress -- * * Extract uncompressed bytes from the compression engine and store them * in our buffer (buf) up to toRead bytes. * * Result: * Number of bytes decompressed or -1 if error (with *errorCodePtr updated with reason). * * Side effects: * After execution it updates cd->inStream (next_in, avail_in) to reflect * the data that has been decompressed. * *---------------------------------------------------------------------- */ static int ResultDecompress( ZlibChannelData *cd, char *buf, int toRead, int flush, int *errorCodePtr) { int e, written, resBytes = 0; Tcl_Obj *errObj; cd->flags &= ~STREAM_DECOMPRESS; cd->inStream.next_out = (Bytef *) buf; cd->inStream.avail_out = toRead; while (cd->inStream.avail_out > 0) { e = inflate(&cd->inStream, flush); if (e == Z_NEED_DICT && cd->compDictObj) { e = SetInflateDictionary(&cd->inStream, cd->compDictObj); if (e == Z_OK) { /* * A repetition of Z_NEED_DICT is just an error. */ e = inflate(&cd->inStream, flush); } } /* * avail_out is now the left over space in the output. Therefore * "toRead - avail_out" is the amount of bytes generated. */ written = toRead - cd->inStream.avail_out; /* * The cases where we're definitely done. */ if (e == Z_STREAM_END) { cd->flags |= STREAM_DONE; resBytes += written; break; } if (e == Z_OK) { if (written == 0) { break; } resBytes += written; } if ((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR)) { break; } /* * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html * * Just indicates that the zlib couldn't consume input/produce output, * and is fixed by supplying more input. * * Otherwise, we've got errors and need to report to higher-up. */ if ((e != Z_OK) && (e != Z_BUF_ERROR)) { goto handleError; } /* * Check if the inflate stopped early. */ if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) { break; } } if (!(cd->flags & STREAM_DONE)) { /* if we have pending input data, but no available output buffer */ if (cd->inStream.avail_in && !cd->inStream.avail_out) { /* next time try to decompress it got readable (new output buffer) */ cd->flags |= STREAM_DECOMPRESS; } } return resBytes; handleError: errObj = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1)); Tcl_ListObjAppendElement(NULL, errObj, ConvertErrorToList(e, cd->inStream.adler)); Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj(cd->inStream.msg, -1)); Tcl_SetChannelError(cd->parent, errObj); *errorCodePtr = EINVAL; return -1; } /* *---------------------------------------------------------------------- * Finally, the TclZlibInit function. Used to install the zlib API. *---------------------------------------------------------------------- */ int TclZlibInit( Tcl_Interp *interp) { Tcl_Config cfg[2]; /* * This does two things. It creates a counter used in the creation of * stream commands, and it creates the namespace that will contain those * commands. */ Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", -1, 0); /* * Create the public scripted interface to this file's functionality. */ Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0); /* * Store the underlying configuration information. * * TODO: Describe whether we're using the system version of the library or * a compatibility version built into Tcl? */ cfg[0].key = "zlibVersion"; cfg[0].value = zlibVersion(); cfg[1].key = NULL; Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1"); /* * Formally provide the package as a Tcl built-in. */ return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); } /* *---------------------------------------------------------------------- * Stubs used when a suitable zlib installation was not found during * configure. *---------------------------------------------------------------------- */ #else /* !HAVE_ZLIB */ int Tcl_ZlibStreamInit( Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); } return TCL_ERROR; } int Tcl_ZlibStreamClose( Tcl_ZlibStream zshandle) { return TCL_OK; } int Tcl_ZlibStreamReset( Tcl_ZlibStream zshandle) { return TCL_OK; } Tcl_Obj * Tcl_ZlibStreamGetCommandName( Tcl_ZlibStream zshandle) { return NULL; } int Tcl_ZlibStreamEof( Tcl_ZlibStream zshandle) { return 1; } int Tcl_ZlibStreamChecksum( Tcl_ZlibStream zshandle) { return 0; } int Tcl_ZlibStreamPut( Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush) { return TCL_OK; } int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, Tcl_Obj *data, int count) { return TCL_OK; } int Tcl_ZlibDeflate( Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); } return TCL_ERROR; } int Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, int bufferSize, Tcl_Obj *gzipHeaderDictObj) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); } return TCL_ERROR; } unsigned int Tcl_ZlibCRC32( unsigned int crc, const char *buf, int len) { return 0; } unsigned int Tcl_ZlibAdler32( unsigned int adler, const char *buf, int len) { return 0; } void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zshandle, Tcl_Obj *compressionDictionaryObj) { /* Do nothing. */ } #endif /* HAVE_ZLIB */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/generic/tommath.h0000644000175000017500000000003314554262142015074 0ustar sergeisergei#include "tclTomMathInt.h" tcl8.6.14/generic/tcl.decls0000644000175000017500000017751214554262142015071 0ustar sergeisergei# tcl.decls -- # # This file contains the declarations for all supported public # functions that are exported by the Tcl library via the stubs table. # This file is used to generate the tclDecls.h, tclPlatDecls.h # and tclStubInit.c files. # # Copyright ТЉ 1998-1999 Scriptics Corporation. # Copyright ТЉ 2001, 2002 Kevin B. Kenny. All rights reserved. # Copyright ТЉ 2007 Daniel A. Steffen # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. library tcl # Define the tcl interface with several sub interfaces: # tclPlat - platform specific public # tclInt - generic private # tclPlatInt - platform specific private interface tcl hooks {tclPlat tclInt tclIntPlat} scspec EXTERN # Declare each of the functions in the public Tcl interface. Note that # the an index should never be reused for a different function in order # to preserve backwards compatibility. declare 0 { int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, const char *version, const void *clientData) } declare 1 { CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } declare 2 { TCL_NORETURN void Tcl_Panic(const char *format, ...) } declare 3 { char *Tcl_Alloc(unsigned int size) } declare 4 { void Tcl_Free(char *ptr) } declare 5 { char *Tcl_Realloc(char *ptr, unsigned int size) } declare 6 { char *Tcl_DbCkalloc(unsigned int size, const char *file, int line) } declare 7 { void Tcl_DbCkfree(char *ptr, const char *file, int line) } declare 8 { char *Tcl_DbCkrealloc(char *ptr, unsigned int size, const char *file, int line) } # Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on Unix, # but they are part of the old generic interface, so we include them here for # compatibility reasons. declare 9 unix { void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData) } declare 10 unix { void Tcl_DeleteFileHandler(int fd) } declare 11 { void Tcl_SetTimer(const Tcl_Time *timePtr) } declare 12 { void Tcl_Sleep(int ms) } declare 13 { int Tcl_WaitForEvent(const Tcl_Time *timePtr) } declare 14 { int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 15 { void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...) } declare 16 { void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length) } declare 17 { Tcl_Obj *Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]) } declare 18 { int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr) } declare 19 { void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, int line) } declare 20 { void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line) } declare 21 { int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line) } declare 22 { Tcl_Obj *Tcl_DbNewBooleanObj(int intValue, const char *file, int line) } declare 23 { Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line) } declare 24 { Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file, int line) } declare 25 { Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, const char *file, int line) } declare 26 { Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line) } declare 27 { Tcl_Obj *Tcl_DbNewObj(const char *file, int line) } declare 28 { Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, int length, const char *file, int line) } declare 29 { Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr) } declare 30 { void TclFreeObj(Tcl_Obj *objPtr) } declare 31 { int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *intPtr) } declare 32 { int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr) } declare 33 { unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr) } declare 34 { int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr) } declare 35 { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } declare 36 { int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr) } declare 37 { int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr) } declare 38 { int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr) } declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) } declare 42 { void Tcl_InvalidateStringRep(Tcl_Obj *objPtr) } declare 43 { int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr) } declare 44 { int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr) } declare 45 { int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr) } declare 46 { int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr) } declare 47 { int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr) } declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]) } declare 49 { Tcl_Obj *Tcl_NewBooleanObj(int intValue) } declare 50 { Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int numBytes) } declare 51 { Tcl_Obj *Tcl_NewDoubleObj(double doubleValue) } declare 52 { Tcl_Obj *Tcl_NewIntObj(int intValue) } declare 53 { Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[]) } declare 54 { Tcl_Obj *Tcl_NewLongObj(long longValue) } declare 55 { Tcl_Obj *Tcl_NewObj(void) } declare 56 { Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length) } declare 57 { void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue) } declare 58 { unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int numBytes) } declare 59 { void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, int numBytes) } declare 60 { void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue) } declare 61 { void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) } declare 62 { void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]) } declare 63 { void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue) } declare 64 { void Tcl_SetObjLength(Tcl_Obj *objPtr, int length) } declare 65 { void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length) } declare 66 { void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) } declare 67 { void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, int length) } declare 68 { void Tcl_AllowExceptions(Tcl_Interp *interp) } declare 69 { void Tcl_AppendElement(Tcl_Interp *interp, const char *element) } declare 70 { void Tcl_AppendResult(Tcl_Interp *interp, ...) } declare 71 { Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, ClientData clientData) } declare 72 { void Tcl_AsyncDelete(Tcl_AsyncHandler async) } declare 73 { int Tcl_AsyncInvoke(Tcl_Interp *interp, int code) } declare 74 { void Tcl_AsyncMark(Tcl_AsyncHandler async) } declare 75 { int Tcl_AsyncReady(void) } declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } declare 77 { char Tcl_Backslash(const char *src, int *readPtr) } declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) } declare 79 { void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData) } declare 80 { void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData) } declare 81 { int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan) } declare 82 { int Tcl_CommandComplete(const char *cmd) } declare 83 { char *Tcl_Concat(int argc, CONST84 char *const *argv) } declare 84 { int Tcl_ConvertElement(const char *src, char *dst, int flags) } declare 85 { int Tcl_ConvertCountedElement(const char *src, int length, char *dst, int flags) } declare 86 { int Tcl_CreateAlias(Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv) } declare 87 { int Tcl_CreateAliasObj(Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]) } declare 88 { Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask) } declare 89 { void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData) } declare 90 { void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData) } declare 91 { Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) } declare 92 { void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData) } declare 93 { void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData) } declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } declare 95 { void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData) } declare 96 { Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) } declare 97 { Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *name, int isSafe) } declare 98 { Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, Tcl_TimerProc *proc, ClientData clientData) } declare 99 { Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData) } declare 100 { void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name) } declare 101 { void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData) } declare 102 { void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData) } declare 103 { int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName) } declare 104 { int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command) } declare 105 { void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData) } declare 106 { void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData) } declare 107 { void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData) } declare 108 { void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr) } declare 109 { void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr) } declare 110 { void Tcl_DeleteInterp(Tcl_Interp *interp) } declare 111 { void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr) } declare 112 { void Tcl_DeleteTimerHandler(Tcl_TimerToken token) } declare 113 { void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace) } declare 114 { void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData) } declare 115 { int Tcl_DoOneEvent(int flags) } declare 116 { void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData) } declare 117 { char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length) } declare 118 { char *Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element) } declare 119 { void Tcl_DStringEndSublist(Tcl_DString *dsPtr) } declare 120 { void Tcl_DStringFree(Tcl_DString *dsPtr) } declare 121 { void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr) } declare 122 { void Tcl_DStringInit(Tcl_DString *dsPtr) } declare 123 { void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr) } declare 124 { void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length) } declare 125 { void Tcl_DStringStartSublist(Tcl_DString *dsPtr) } declare 126 { int Tcl_Eof(Tcl_Channel chan) } declare 127 { CONST84_RETURN char *Tcl_ErrnoId(void) } declare 128 { CONST84_RETURN char *Tcl_ErrnoMsg(int err) } declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) } declare 130 { int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) } declare 131 { int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 132 { void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc) } declare 133 { TCL_NORETURN void Tcl_Exit(int status) } declare 134 { int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName) } declare 135 { int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr, int *ptr) } declare 136 { int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr) } declare 137 { int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr, double *ptr) } declare 138 { int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr) } declare 139 { int Tcl_ExprLong(Tcl_Interp *interp, const char *expr, long *ptr) } declare 140 { int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr) } declare 141 { int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr) } declare 142 { int Tcl_ExprString(Tcl_Interp *interp, const char *expr) } declare 143 { void Tcl_Finalize(void) } declare 144 { void Tcl_FindExecutable(const char *argv0) } declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 { int Tcl_Flush(Tcl_Channel chan) } declare 147 { void Tcl_FreeResult(Tcl_Interp *interp) } declare 148 { int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr) } declare 149 { int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv) } declare 150 { ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr) } declare 151 { Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName, int *modePtr) } declare 152 { int Tcl_GetChannelBufferSize(Tcl_Channel chan) } declare 153 { int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, ClientData *handlePtr) } declare 154 { ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan) } declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) } declare 156 { CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan) } declare 157 { int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr) } declare 158 { CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) } declare 159 { int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr) } declare 160 { CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command) } declare 161 { int Tcl_GetErrno(void) } declare 162 { CONST84_RETURN char *Tcl_GetHostName(void) } declare 163 { int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *childInterp) } declare 164 { Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp) } declare 165 { const char *Tcl_GetNameOfExecutable(void) } declare 166 { Tcl_Obj *Tcl_GetObjResult(Tcl_Interp *interp) } # Tcl_GetOpenFile is only available on unix, but it is a part of the old # generic interface, so we include it here for compatibility reasons. declare 167 unix { int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified # and therefore usually faster. declare 168 { Tcl_PathType Tcl_GetPathType(const char *path) } declare 169 { int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr) } declare 170 { int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 171 { int Tcl_GetServiceMode(void) } declare 172 { Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *name) } declare 173 { Tcl_Channel Tcl_GetStdChannel(int type) } declare 174 { CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp) } declare 175 { CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags) } declare 176 { CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } declare 177 { int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) } declare 178 { int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 179 { int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken) } declare 180 { int Tcl_Init(Tcl_Interp *interp) } declare 181 { void Tcl_InitHashTable(Tcl_HashTable *tablePtr, int keyType) } declare 182 { int Tcl_InputBlocked(Tcl_Channel chan) } declare 183 { int Tcl_InputBuffered(Tcl_Channel chan) } declare 184 { int Tcl_InterpDeleted(Tcl_Interp *interp) } declare 185 { int Tcl_IsSafe(Tcl_Interp *interp) } # Obsolete, use Tcl_FSJoinPath declare 186 { char *Tcl_JoinPath(int argc, CONST84 char *const *argv, Tcl_DString *resultPtr) } declare 187 { int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr, int type) } # This slot is reserved for use by the plus patch: # declare 188 { # Tcl_MainLoop # } declare 189 { Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode) } declare 190 { int Tcl_MakeSafe(Tcl_Interp *interp) } declare 191 { Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) } declare 192 { char *Tcl_Merge(int argc, CONST84 char *const *argv) } declare 193 { Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr) } declare 194 { void Tcl_NotifyChannel(Tcl_Channel channel, int mask) } declare 195 { Tcl_Obj *Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags) } declare 196 { Tcl_Obj *Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags) } declare 197 { Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags) } # This is obsolete, use Tcl_FSOpenFileChannel declare 198 { Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions) } declare 199 { Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int flags) } declare 200 { Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData) } declare 201 { void Tcl_Preserve(ClientData data) } declare 202 { void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst) } declare 203 { int Tcl_PutEnv(const char *assignment) } declare 204 { CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp) } declare 205 { void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position) } declare 206 { int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead) } declare 207 { void Tcl_ReapDetachedProcs(void) } declare 208 { int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags) } declare 209 { int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags) } declare 210 { void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } declare 211 { void Tcl_RegisterObjType(const Tcl_ObjType *typePtr) } declare 212 { Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, const char *pattern) } declare 213 { int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start) } declare 214 { int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern) } declare 215 { void Tcl_RegExpRange(Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr) } declare 216 { void Tcl_Release(ClientData clientData) } declare 217 { void Tcl_ResetResult(Tcl_Interp *interp) } declare 218 { int Tcl_ScanElement(const char *src, int *flagPtr) } declare 219 { int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } # Obsolete declare 220 { int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) } declare 221 { int Tcl_ServiceAll(void) } declare 222 { int Tcl_ServiceEvent(int flags) } declare 223 { void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData) } declare 224 { void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz) } declare 225 { int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue) } declare 226 { int Tcl_SetCommandInfo(Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr) } declare 227 { void Tcl_SetErrno(int err) } declare 228 { void Tcl_SetErrorCode(Tcl_Interp *interp, ...) } declare 229 { void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr) } declare 230 { void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) } declare 231 { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) } declare 232 { void Tcl_SetResult(Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc) } declare 233 { int Tcl_SetServiceMode(int mode) } declare 234 { void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr) } declare 235 { void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr) } declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } declare 237 { CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags) } declare 238 { CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) } declare 239 { CONST84_RETURN char *Tcl_SignalId(int sig) } declare 240 { CONST84_RETURN char *Tcl_SignalMsg(int sig) } declare 241 { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 { int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath declare 243 { void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr) } declare 244 { void Tcl_StaticPackage(Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) } declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } # Obsolete declare 246 { int Tcl_TellOld(Tcl_Channel chan) } declare 247 { int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 249 { char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr) } declare 250 { int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead) } declare 251 { void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName) } declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } declare 253 { int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) } declare 254 { int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } declare 255 { void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 256 { void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 257 { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName) } declare 258 { int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags) } declare 259 { int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags) } declare 260 { int Tcl_VarEval(Tcl_Interp *interp, ...) } declare 261 { ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) } declare 262 { ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) } declare 263 { int Tcl_Write(Tcl_Channel chan, const char *s, int slen) } declare 264 { void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message) } declare 265 { int Tcl_DumpActiveMemory(const char *fileName) } declare 266 { void Tcl_ValidateAllMemory(const char *file, int line) } declare 267 { void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) } declare 268 { void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) } declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 { CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, CONST84 char **termPtr) } declare 271 { CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, const char *version, int exact) } declare 272 { CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } declare 273 { int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, const char *version) } # TIP #268: The internally used new Require function is in slot 573. declare 274 { CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact) } declare 275 { void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) } declare 276 { int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) } declare 277 { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } declare 278 { TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList) } declare 279 { void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type) } declare 280 { void Tcl_InitMemory(Tcl_Interp *interp) } # Andreas Kupries , 03/21/1999 # "Trf-Patch for filtering channels" # # C-Level API for (un)stacking of channels. This allows the introduction # of filtering channels with relatively little changes to the core. # This patch was created in cooperation with Jan Nijtmans j.nijtmans@chello.nl # and is therefore part of his plus-patches too. # # It would have been possible to place the following definitions according # to the alphabetical order used elsewhere in this file, but I decided # against that to ease the maintenance of the patch across new tcl versions # (patch usually has no problems to integrate the patch file for the last # version into the new one). declare 281 { Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan) } declare 282 { int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan) } declare 283 { Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan) } # 284 was reserved, but added in 8.4a2 declare 284 { void Tcl_SetMainLoop(Tcl_MainLoopProc *proc) } # Reserved for future use (8.0.x vs. 8.1) # declare 285 { # } # Added in 8.1: declare 286 { void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr) } declare 287 { Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr) } declare 288 { void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) } declare 289 { void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) } declare 290 { void Tcl_DiscardResult(Tcl_SavedResult *statePtr) } declare 291 { int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags) } declare 292 { int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) } declare 293 { int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } declare 294 { void Tcl_ExitThread(int status) } declare 295 { int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 296 { char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr) } declare 297 { void Tcl_FinalizeThread(void) } declare 298 { void Tcl_FinalizeNotifier(ClientData clientData) } declare 299 { void Tcl_FreeEncoding(Tcl_Encoding encoding) } declare 300 { Tcl_ThreadId Tcl_GetCurrentThread(void) } declare 301 { Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name) } declare 302 { CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding) } declare 303 { void Tcl_GetEncodingNames(Tcl_Interp *interp) } declare 304 { int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr) } declare 305 { void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size) } declare 306 { Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } declare 307 { ClientData Tcl_InitNotifier(void) } declare 308 { void Tcl_MutexLock(Tcl_Mutex *mutexPtr) } declare 309 { void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr) } declare 310 { void Tcl_ConditionNotify(Tcl_Condition *condPtr) } declare 311 { void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr) } declare 312 { int Tcl_NumUtfChars(const char *src, int length) } declare 313 { int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag) } declare 314 { void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) } declare 315 { void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) } declare 316 { int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name) } declare 317 { Tcl_Obj *Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags) } declare 318 { void Tcl_ThreadAlert(Tcl_ThreadId threadId) } declare 319 { void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position) } declare 320 { Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index) } declare 321 { Tcl_UniChar Tcl_UniCharToLower(int ch) } declare 322 { Tcl_UniChar Tcl_UniCharToTitle(int ch) } declare 323 { Tcl_UniChar Tcl_UniCharToUpper(int ch) } declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index) } declare 326 { int Tcl_UtfCharComplete(const char *src, int length) } declare 327 { int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) } declare 328 { CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch) } declare 329 { CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch) } declare 330 { CONST84_RETURN char *Tcl_UtfNext(const char *src) } declare 331 { CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start) } declare 332 { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 333 { char *Tcl_UtfToExternalDString(Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr) } declare 334 { int Tcl_UtfToLower(char *src) } declare 335 { int Tcl_UtfToTitle(char *src) } declare 336 { int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr) } declare 337 { int Tcl_UtfToUpper(char *src) } declare 338 { int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen) } declare 339 { int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } declare 341 { CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void) } declare 342 { void Tcl_SetDefaultEncodingDir(const char *path) } declare 343 { void Tcl_AlertNotifier(ClientData clientData) } declare 344 { void Tcl_ServiceModeHook(int mode) } declare 345 { int Tcl_UniCharIsAlnum(int ch) } declare 346 { int Tcl_UniCharIsAlpha(int ch) } declare 347 { int Tcl_UniCharIsDigit(int ch) } declare 348 { int Tcl_UniCharIsLower(int ch) } declare 349 { int Tcl_UniCharIsSpace(int ch) } declare 350 { int Tcl_UniCharIsUpper(int ch) } declare 351 { int Tcl_UniCharIsWordChar(int ch) } declare 352 { int Tcl_UniCharLen(const Tcl_UniChar *uniStr) } declare 353 { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars) } declare 354 { char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr) } declare 355 { Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr) } declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } declare 357 { Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count) } declare 358 { void Tcl_FreeParse(Tcl_Parse *parsePtr) } declare 359 { void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, int length) } declare 360 { int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) } declare 361 { int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr) } declare 362 { int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr) } declare 363 { int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) } declare 364 { int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append) } # These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, # Tcl_FSAccess and Tcl_FSStat declare 365 { char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 366 { int Tcl_Chdir(const char *dirName) } declare 367 { int Tcl_Access(const char *path, int mode) } declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n) } declare 370 { int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) } declare 372 { int Tcl_UniCharIsControl(int ch) } declare 373 { int Tcl_UniCharIsGraph(int ch) } declare 374 { int Tcl_UniCharIsPrint(int ch) } declare 375 { int Tcl_UniCharIsPunct(int ch) } declare 376 { int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags) } declare 377 { void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr) } declare 378 { Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars) } declare 379 { void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars) } declare 380 { int Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 381 { Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index) } declare 382 { Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) } declare 383 { Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last) } declare 384 { void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length) } declare 385 { int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj) } declare 386 { void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr) } declare 387 { Tcl_Mutex *Tcl_GetAllocMutex(void) } declare 388 { int Tcl_GetChannelNames(Tcl_Interp *interp) } declare 389 { int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern) } declare 390 { int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 391 { void Tcl_ConditionFinalize(Tcl_Condition *condPtr) } declare 392 { void Tcl_MutexFinalize(Tcl_Mutex *mutex) } declare 393 { int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags) } # Introduced in 8.3.2 declare 394 { int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead) } declare 395 { int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen) } declare 396 { Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan) } declare 397 { int Tcl_ChannelBuffered(Tcl_Channel chan) } declare 398 { CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr) } declare 399 { Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) } declare 400 { Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) } declare 401 { Tcl_DriverCloseProc *Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr) } declare 402 { Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc( const Tcl_ChannelType *chanTypePtr) } declare 403 { Tcl_DriverInputProc *Tcl_ChannelInputProc( const Tcl_ChannelType *chanTypePtr) } declare 404 { Tcl_DriverOutputProc *Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr) } declare 405 { Tcl_DriverSeekProc *Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr) } declare 406 { Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc( const Tcl_ChannelType *chanTypePtr) } declare 407 { Tcl_DriverGetOptionProc *Tcl_ChannelGetOptionProc( const Tcl_ChannelType *chanTypePtr) } declare 408 { Tcl_DriverWatchProc *Tcl_ChannelWatchProc( const Tcl_ChannelType *chanTypePtr) } declare 409 { Tcl_DriverGetHandleProc *Tcl_ChannelGetHandleProc( const Tcl_ChannelType *chanTypePtr) } declare 410 { Tcl_DriverFlushProc *Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) } declare 411 { Tcl_DriverHandlerProc *Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) } # Introduced in 8.4a2 declare 412 { int Tcl_JoinThread(Tcl_ThreadId threadId, int *result) } declare 413 { int Tcl_IsChannelShared(Tcl_Channel channel) } declare 414 { int Tcl_IsChannelRegistered(Tcl_Interp *interp, Tcl_Channel channel) } declare 415 { void Tcl_CutChannel(Tcl_Channel channel) } declare 416 { void Tcl_SpliceChannel(Tcl_Channel channel) } declare 417 { void Tcl_ClearChannelHandlers(Tcl_Channel channel) } declare 418 { int Tcl_IsChannelExisting(const char *channelName) } declare 419 { int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars) } declare 420 { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase) } declare 421 { Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) } declare 422 { Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, const void *key, int *newPtr) } declare 423 { void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr) } declare 424 { void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr) } declare 425 { ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData) } declare 426 { int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 427 { void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 428 { char *Tcl_AttemptAlloc(unsigned int size) } declare 429 { char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line) } declare 430 { char *Tcl_AttemptRealloc(char *ptr, unsigned int size) } declare 431 { char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, const char *file, int line) } declare 432 { int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length) } # TIP#10 (thread-aware channels) akupries declare 433 { Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel) } # introduced in 8.4a3 declare 434 { Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) } # TIP#15 (math function introspection) dkf declare 435 { int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr) } declare 436 { Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) } # TIP#36 (better access to 'subst') dkf declare 437 { Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } # TIP#17 (virtual filesystem layer) vdarley declare 438 { int Tcl_DetachChannel(Tcl_Interp *interp, Tcl_Channel channel) } declare 439 { int Tcl_IsStandardChannel(Tcl_Channel channel) } declare 440 { int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) } declare 441 { int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr) } declare 442 { int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr) } declare 443 { int Tcl_FSDeleteFile(Tcl_Obj *pathPtr) } declare 444 { int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr) } declare 445 { int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types) } declare 446 { Tcl_Obj *Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction) } declare 447 { int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr) } declare 448 { int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) } declare 449 { int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) } declare 450 { int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval) } declare 451 { int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 452 { int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr) } declare 453 { const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 454 { int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) } declare 455 { int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode) } declare 456 { Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions) } declare 457 { Tcl_Obj *Tcl_FSGetCwd(Tcl_Interp *interp) } declare 458 { int Tcl_FSChdir(Tcl_Obj *pathPtr) } declare 459 { int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr) } declare 460 { Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, int elements) } declare 461 { Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) } declare 462 { int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) } declare 463 { Tcl_Obj *Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr) } declare 464 { Tcl_Obj *Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]) } declare 465 { ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr) } declare 466 { Tcl_Obj *Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr) } declare 467 { int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName) } declare 468 { Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem, ClientData clientData) } declare 469 { const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr) } declare 470 { Tcl_Obj *Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr) } declare 471 { Tcl_Obj *Tcl_FSPathSeparator(Tcl_Obj *pathPtr) } declare 472 { Tcl_Obj *Tcl_FSListVolumes(void) } declare 473 { int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr) } declare 474 { int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr) } declare 475 { ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr) } declare 476 { const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr) } declare 477 { CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) } declare 478 { Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr) } # TIP#49 (detection of output buffering) akupries declare 479 { int Tcl_OutputBuffered(Tcl_Channel chan) } declare 480 { void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr) } # TIP#56 (evaluate a parsed script) msofer declare 481 { int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count) } # TIP#73 (access to current time) kbk declare 482 { void Tcl_GetTime(Tcl_Time *timeBuf) } # TIP#32 (object-enabled traces) kbk declare 483 { Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc) } declare 484 { int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr) } declare 485 { int Tcl_SetCommandInfoFromToken(Tcl_Command token, const Tcl_CmdInfo *infoPtr) } ### New functions on 64-bit dev branch ### # TIP#72 (64-bit values) dkf declare 486 { Tcl_Obj *Tcl_DbNewWideIntObj(Tcl_WideInt wideValue, const char *file, int line) } declare 487 { int Tcl_GetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr) } declare 488 { Tcl_Obj *Tcl_NewWideIntObj(Tcl_WideInt wideValue) } declare 489 { void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue) } declare 490 { Tcl_StatBuf *Tcl_AllocStatBuf(void) } declare 491 { Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode) } declare 492 { Tcl_WideInt Tcl_Tell(Tcl_Channel chan) } # TIP#91 (back-compat enhancements for channels) dkf declare 493 { Tcl_DriverWideSeekProc *Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) } # ----- BASELINE -- FOR -- 8.4.0 ----- # # TIP#111 (dictionaries) dkf declare 494 { int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr) } declare 495 { int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr) } declare 496 { int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr) } declare 497 { int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr) } declare 498 { int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr) } declare 499 { void Tcl_DictObjNext(Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr) } declare 500 { void Tcl_DictObjDone(Tcl_DictSearch *searchPtr) } declare 501 { int Tcl_DictObjPutKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr) } declare 502 { int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv) } declare 503 { Tcl_Obj *Tcl_NewDictObj(void) } declare 504 { Tcl_Obj *Tcl_DbNewDictObj(const char *file, int line) } # TIP#59 (configuration reporting) akupries declare 505 { void Tcl_RegisterConfig(Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding) } # TIP #139 (partial exposure of namespace API - transferred from tclInt.decls) # dkf, API by Brent Welch? declare 506 { Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) } declare 507 { void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) } declare 508 { int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr) } declare 509 { int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst) } declare 510 { int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite) } declare 511 { int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern) } declare 512 { Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) } declare 513 { Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) } declare 514 { Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 515 { Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 516 { Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 517 { void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr) } # TIP#137 (encoding-aware source command) dgp for Anton Kovalenko declare 518 { int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName) } # TIP#121 (exit handler) dkf for Joe Mistachkin declare 519 { Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) } # TIP#143 (resource limits) dkf declare 520 { void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc) } declare 521 { void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData) } declare 522 { int Tcl_LimitReady(Tcl_Interp *interp) } declare 523 { int Tcl_LimitCheck(Tcl_Interp *interp) } declare 524 { int Tcl_LimitExceeded(Tcl_Interp *interp) } declare 525 { void Tcl_LimitSetCommands(Tcl_Interp *interp, int commandLimit) } declare 526 { void Tcl_LimitSetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr) } declare 527 { void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type, int granularity) } declare 528 { int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type) } declare 529 { int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type) } declare 530 { void Tcl_LimitTypeSet(Tcl_Interp *interp, int type) } declare 531 { void Tcl_LimitTypeReset(Tcl_Interp *interp, int type) } declare 532 { int Tcl_LimitGetCommands(Tcl_Interp *interp) } declare 533 { void Tcl_LimitGetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr) } declare 534 { int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type) } # TIP#226 (interpreter result state management) dgp declare 535 { Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status) } declare 536 { int Tcl_RestoreInterpState(Tcl_Interp *interp, Tcl_InterpState state) } declare 537 { void Tcl_DiscardInterpState(Tcl_InterpState state) } # TIP#227 (return options interface) dgp declare 538 { int Tcl_SetReturnOptions(Tcl_Interp *interp, Tcl_Obj *options) } declare 539 { Tcl_Obj *Tcl_GetReturnOptions(Tcl_Interp *interp, int result) } # TIP#235 (ensembles) dkf declare 540 { int Tcl_IsEnsemble(Tcl_Command token) } declare 541 { Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags) } declare 542 { Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags) } declare 543 { int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList) } declare 544 { int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict) } declare 545 { int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList) } declare 546 { int Tcl_SetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int flags) } declare 547 { int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr) } declare 548 { int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr) } declare 549 { int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr) } declare 550 { int Tcl_GetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int *flagsPtr) } declare 551 { int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr) } # TIP#233 (virtualized time) akupries declare 552 { void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData) } declare 553 { void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData) } # TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4 declare 554 { Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) } # TIP#237 (arbitrary-precision integers) kbk declare 555 { Tcl_Obj *Tcl_NewBignumObj(mp_int *value) } declare 556 { Tcl_Obj *Tcl_DbNewBignumObj(mp_int *value, const char *file, int line) } declare 557 { void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value) } declare 558 { int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value) } declare 559 { int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value) } # TIP #208 ('chan' command) jeffh declare 560 { int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length) } declare 561 { Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) } # TIP#219 (channel reflection api) akupries declare 562 { void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg) } declare 563 { void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj **msg) } declare 564 { void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg) } declare 565 { void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg) } # TIP #237 (additional conversion functions for bignum support) kbk/dgp declare 566 { int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, mp_int *toInit) } # TIP#181 (namespace unknown command) dgp for Neil Madden declare 567 { Tcl_Obj *Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr) } declare 568 { int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr) } # TIP#258 (enhanced interface for encodings) dgp declare 569 { int Tcl_GetEncodingFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr) } declare 570 { Tcl_Obj *Tcl_GetEncodingSearchPath(void) } declare 571 { int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath) } declare 572 { const char *Tcl_GetEncodingNameFromEnvironment(Tcl_DString *bufPtr) } # TIP#268 (extended version numbers and requirements) akupries declare 573 { int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr) } # TIP#270 (utility C routines for string formatting) dgp declare 574 { void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 575 { void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis) } declare 576 { Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]) } declare 577 { int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]) } declare 578 { Tcl_Obj *Tcl_ObjPrintf(const char *format, ...) } declare 579 { void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...) } # ----- BASELINE -- FOR -- 8.5.0 ----- # # TIP #285 (script cancellation support) jmistachkin declare 580 { int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags) } declare 581 { int Tcl_Canceled(Tcl_Interp *interp, int flags) } # TIP#304 (chan pipe) aferrieux declare 582 { int Tcl_CreatePipe(Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags) } # TIP #322 (NRE public interface) msofer declare 583 { Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) } declare 584 { int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } declare 585 { int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) } declare 586 { int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags) } declare 587 { void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3) } # For use by NR extenders, to have a simple way to also provide a (required!) # classic objProc declare 588 { int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]) } # TIP#316 (Tcl_StatBuf reader functions) dkf declare 589 { unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr) } declare 590 { unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr) } declare 591 { unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr) } declare 592 { int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr) } declare 593 { int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr) } declare 594 { int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr) } declare 595 { int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr) } declare 596 { Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr) } declare 597 { Tcl_WideInt Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr) } declare 598 { Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr) } declare 599 { Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr) } declare 600 { Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr) } declare 601 { unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr) } # TIP#314 (ensembles with parameters) dkf for Lars Hellstr"om declare 602 { int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList) } declare 603 { int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr) } # TIP#265 (option parser) dkf for Sam Bromley declare 604 { int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) } # TIP#336 (manipulate the error line) dgp declare 605 { int Tcl_GetErrorLine(Tcl_Interp *interp) } declare 606 { void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum) } # TIP#307 (move results between interpreters) dkf declare 607 { void Tcl_TransferResult(Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp) } # TIP#335 (detect if interpreter in use) jmistachkin declare 608 { int Tcl_InterpActive(Tcl_Interp *interp) } # TIP#337 (log exception for background processing) dgp declare 609 { void Tcl_BackgroundException(Tcl_Interp *interp, int code) } # TIP#234 (zlib interface) dkf/Pascal Scheffers declare 610 { int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj) } declare 611 { int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj) } declare 612 { unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf, int len) } declare 613 { unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf, int len) } declare 614 { int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle) } declare 615 { Tcl_Obj *Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle) } declare 616 { int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle) } declare 617 { int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle) } declare 618 { int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush) } declare 619 { int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count) } declare 620 { int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle) } declare 621 { int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle) } # TIP 338 (control over startup script) dgp declare 622 { void Tcl_SetStartupScript(Tcl_Obj *path, const char *encoding) } declare 623 { Tcl_Obj *Tcl_GetStartupScript(const char **encodingPtr) } # TIP#332 (half-close made public) aferrieux declare 624 { int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags) } # TIP #353 (NR-enabled expressions) dgp declare 625 { int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr) } # TIP #356 (NR-enabled substitution) dgp declare 626 { int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } # TIP #357 (Export TclLoadFile and TclpFindSymbol) kbk declare 627 { int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr) } declare 628 { void *Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol) } declare 629 { int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr) } # TIP #400 declare 630 { void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj) } # ----- BASELINE -- FOR -- 8.6.0 ----- # declare 688 { void TclUnusedStubEntry(void) } ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. interface tclPlat ################################ # Unix specific functions # (none) ################################ # Windows specific functions # Added in Tcl 8.1 declare 0 win { TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr) } declare 1 win { char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) } declare 3 win { void TclWinConvertError_(unsigned errCode) } ################################ # Mac OS X specific functions declare 0 macosx { int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath) } declare 1 macosx { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath) } declare 2 macosx { void TclMacOSXNotifierAddRunLoopMode_(const void *runLoopMode) } ############################################################################## # Public functions that are not accessible via the stubs table. export { void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) } export { void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp) } export { const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact) } export { const char *TclTomMathInitializeStubs(Tcl_Interp* interp, const char* version, int epoch, int revision) } export { const char *Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact) } export { void Tcl_GetMemoryInfo(Tcl_DString *dsPtr) } # Local Variables: # mode: tcl # End: tcl8.6.14/generic/tclInt.decls0000644000175000017500000006025514554262142015537 0ustar sergeisergei# tclInt.decls -- # # This file contains the declarations for all unsupported # functions that are exported by the Tcl library. This file # is used to generate the tclIntDecls.h, tclIntPlatDecls.h # and tclStubInit.c files # # Copyright ТЉ 1998-1999 Scriptics Corporation. # Copyright ТЉ 2001 Kevin B. Kenny. All rights reserved. # Copyright ТЉ 2007 Daniel A. Steffen # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. library tcl # Define the unsupported generic interfaces. interface tclInt scspec EXTERN # Declare each of the functions in the unsupported internal Tcl # interface. These interfaces are allowed to changed between versions. # Use at your own risk. Note that the position of functions should not # be changed between versions to avoid gratuitous incompatibilities. declare 3 { void TclAllocateFreeObjects(void) } declare 5 { int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan) } declare 6 { void TclCleanupCommand(Command *cmdPtr) } declare 7 { int TclCopyAndCollapse(int count, const char *src, char *dst) } declare 8 { int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) } # TclCreatePipeline unofficially exported for use by BLT. declare 9 { int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr) } declare 10 { int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr) } declare 11 { void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr) } declare 12 { void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr) } declare 14 { int TclDumpMemoryInfo(ClientData clientData, int flags) } declare 16 { void TclExprFloatError(Tcl_Interp *interp, double value) } declare 22 { int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr) } declare 23 { Proc *TclFindProc(Interp *iPtr, const char *procName) } # Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10 declare 24 { int TclFormatInt(char *buffer, long n) } declare 25 { void TclFreePackageInfo(Interp *iPtr) } declare 28 { Tcl_Channel TclpGetDefaultStdChannel(int type) } declare 31 { const char *TclGetExtension(const char *name) } declare 32 { int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr) } declare 34 { int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr) } declare 37 { int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName) } declare 38 { int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr) } declare 39 { Tcl_ObjCmdProc *TclGetObjInterpProc(void) } declare 40 { int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr) } declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } declare 44 { int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr) } declare 45 { int TclHideUnsafeCommands(Tcl_Interp *interp) } declare 46 { int TclInExit(void) } declare 50 { void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr) } declare 51 { int TclInterpInit(Tcl_Interp *interp) } declare 53 { int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv) } declare 54 { int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 55 { Proc *TclIsProc(Command *cmdPtr) } declare 58 { Var *TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr) } declare 60 { int TclNeedSpace(const char *start, const char *end) } declare 61 { Tcl_Obj *TclNewProcBodyObj(Proc *procPtr) } declare 62 { int TclObjCommandComplete(Tcl_Obj *cmdPtr) } declare 63 { int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 64 { int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) } declare 69 { char *TclpAlloc(unsigned int size) } declare 74 { void TclpFree(char *ptr) } declare 75 { unsigned long TclpGetClicks(void) } declare 76 { unsigned long TclpGetSeconds(void) } # deprecated declare 77 { void TclpGetTime(Tcl_Time *time) } declare 81 { char *TclpRealloc(char *ptr, unsigned int size) } declare 88 { char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags) } declare 89 { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd) } declare 91 { void TclProcCleanupProc(Proc *procPtr) } declare 92 { int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName) } declare 93 { void TclProcDeleteProc(ClientData clientData) } declare 96 { int TclRenameCommand(Tcl_Interp *interp, const char *oldName, const char *newName) } declare 97 { void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr) } declare 98 { int TclServiceIdle(void) } declare 101 { CONST86 char *TclSetPreInitScript(const char *string) } declare 102 { void TclSetupEnv(Tcl_Interp *interp) } declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } declare 104 { int TclSockMinimumBuffersOld(int sock, int size) } declare 108 { void TclTeardownNamespace(Namespace *nsPtr) } declare 109 { int TclUpdateReturnInfo(Interp *iPtr) } declare 110 { int TclSockMinimumBuffers(void *sock, int size) } # Procedures used in conjunction with Tcl namespaces. They are # defined here instead of in tcl.decls since they are not stable yet. declare 111 { void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 112 { int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr) } declare 113 { Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) } declare 114 { void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) } declare 115 { int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst) } declare 116 { Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 117 { Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) } declare 119 { int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo) } declare 120 { Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 121 { int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern) } declare 122 { Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 123 { void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr) } declare 124 { Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) } declare 125 { Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) } declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } declare 127 { int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite) } declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } declare 129 { int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame) } declare 130 { int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name) } declare 131 { void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 132 { int TclpHasSockets(Tcl_Interp *interp) } declare 133 { struct tm *TclpGetDate(const time_t *time, int useGMT) } declare 138 { CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr) } # This is used by TclX, but should otherwise be considered private declare 141 { CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData) } declare 143 { int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr) } declare 144 { void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr, int index) } declare 145 { const struct AuxDataType *TclGetAuxDataType(const char *typeName) } declare 146 { TclHandle TclHandleCreate(void *ptr) } declare 147 { void TclHandleFree(TclHandle handle) } declare 148 { TclHandle TclHandlePreserve(TclHandle handle) } declare 149 { void TclHandleRelease(TclHandle handle) } declare 150 { int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re) } declare 151 { void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, int *endPtr) } declare 152 { void TclSetLibraryPath(Tcl_Obj *pathPtr) } declare 153 { Tcl_Obj *TclGetLibraryPath(void) } declare 156 { void TclRegError(Tcl_Interp *interp, const char *msg, int status) } declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } # REMOVED (except from stub table) - use public Tcl_SetStartupScript() declare 158 { void TclSetStartupScriptFileName(const char *filename) } # REMOVED (except from stub table) - use public Tcl_GetStartupScript() declare 159 { const char *TclGetStartupScriptFileName(void) } declare 161 { int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr) } declare 162 { void TclChannelEventScriptInvoker(ClientData clientData, int flags) } # ALERT: The result of 'TclGetInstructionTable' is actually a # "const InstructionDesc*" but we do not want to describe this structure in # "tclInt.h". It is described in "tclCompile.h". Use a cast to the # correct type when calling this procedure. declare 163 { const void *TclGetInstructionTable(void) } # ALERT: The argument of 'TclExpandCodeArray' is actually a # "CompileEnv*" but we do not want to describe this structure in # "tclInt.h". It is described in "tclCompile.h". declare 164 { void TclExpandCodeArray(void *envPtr) } # These functions are vfs aware, but are generally only useful internally. declare 165 { void TclpSetInitialEncodings(void) } # New function due to TIP #33 declare 166 { int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr) } # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) # REMOVED (except from stub table) - use public Tcl_SetStartupScript() declare 167 { void TclSetStartupScriptPath(Tcl_Obj *pathPtr) } # REMOVED (except from stub table) - use public Tcl_GetStartupScript() declare 168 { Tcl_Obj *TclGetStartupScriptPath(void) } # variant of Tcl_UtfNcmp that takes n as bytes, not chars declare 169 { int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 171 { int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 172 { int TclInThreadExit(void) } declare 173 { int TclUniCharMatch(const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags) } declare 175 { int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg) } declare 176 { void TclCleanupVar(Var *varPtr, Var *arrayPtr) } declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } # TIP 338 made these public - now declared in tcl.h too declare 178 { void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) } declare 179 { Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) } declare 182 { struct tm *TclpLocaltime(const time_t *clock) } declare 183 { struct tm *TclpGmtime(const time_t *clock) } # For the new "Thread Storage" subsystem. declare 198 { int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr) } # 200-208 exported for use by the test suite [Bug 1054748] declare 200 { int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr) } declare 201 { int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr) } declare 202 { int TclpObjCreateDirectory(Tcl_Obj *pathPtr) } declare 203 { int TclpObjDeleteFile(Tcl_Obj *pathPtr) } declare 204 { int TclpObjCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) } declare 205 { int TclpObjRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) } declare 206 { int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) } declare 207 { int TclpObjAccess(Tcl_Obj *pathPtr, int mode) } declare 208 { Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions) } declare 212 { void TclpFindExecutable(const char *argv0) } declare 213 { Tcl_Obj *TclGetObjNameOfExecutable(void) } declare 214 { void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding) } declare 215 { void *TclStackAlloc(Tcl_Interp *interp, int numBytes) } declare 216 { void TclStackFree(Tcl_Interp *interp, void *freePtr) } declare 217 { int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame) } declare 218 { void TclPopStackFrame(Tcl_Interp *interp) } # for use in tclTest.c # Bug 7371b6270b declare 223 { void *TclGetCStackPtr(void) } declare 224 { TclPlatformType *TclGetPlatform(void) } declare 225 { Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags) } declare 226 { int TclObjBeingDeleted(Tcl_Obj *objPtr) } declare 227 { void TclSetNsPath(Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]) } declare 229 { int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index) } declare 230 { Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr) } declare 231 { int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr) } # Bits and pieces of TIP#280's guts declare 232 { int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word) } declare 233 { void TclGetSrcInfoForPc(CmdFrame *contextPtr) } # Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :( declare 234 { Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr) } declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } # TIP 337 made this one public declare 236 { void TclBackgroundException(Tcl_Interp *interp, int code) } # TIP #285: Script cancellation support. declare 237 { int TclResetCancellation(Tcl_Interp *interp, int force) } # NRE functions for "rogue" extensions to exploit NRE; they will need to # include NRE.h too. declare 238 { int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 239 { int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc) } declare 240 { int TclNRRunCallbacks(Tcl_Interp *interp, int result, struct NRE_callback *rootPtr) } declare 241 { int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word) } declare 242 { int TclNREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr) } # Tcl_Obj leak detection support. declare 243 { void TclDbDumpActiveObjects(FILE *outFile) } # Functions to make things better for itcl declare 244 { Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr) } declare 245 { Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr) } declare 246 { int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv) } declare 247 { void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble) } declare 248 { int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr) } declare 249 { char *TclDoubleDigits(double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr) } # TIP #285: Script cancellation support. declare 250 { void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force) } # Allow extensions for optimization declare 251 { int TclRegisterLiteral(void *envPtr, char *bytes, int length, int flags) } # Exporting of the internal API to variables. declare 252 { Tcl_Obj *TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags) } declare 253 { Tcl_Obj *TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags) } declare 254 { Tcl_Obj *TclPtrIncrObjVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags) } declare 255 { int TclPtrObjMakeUpvar(Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags) } declare 256 { int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags) } declare 257 { void TclStaticPackage(Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) } declare 261 { void TclUnusedStubEntry(void) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. interface tclIntPlat ################################ # Windows specific functions declare 0 win { void TclWinConvertError(DWORD errCode) } declare 1 win { void TclWinConvertWSAError(DWORD errCode) } declare 2 win { struct servent *TclWinGetServByName(const char *nm, const char *proto) } declare 3 win { int TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen) } declare 4 win { HINSTANCE TclWinGetTclInstance(void) } declare 5 win { int TclUnixWaitForFile(int fd, int mask, int timeout) } declare 6 win { unsigned short TclWinNToHS(unsigned short ns) } declare 7 win { int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) } declare 8 win { int TclpGetPid(Tcl_Pid pid) } declare 9 win { int TclWinGetPlatformId(void) } declare 10 win { Tcl_DirEntry *TclpReaddir(TclDIR *dir) } # Pipe channel functions declare 11 win { void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) } declare 12 win { int TclpCloseFile(TclFile file) } declare 13 win { Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) } declare 14 win { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } declare 15 win { int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } declare 16 win { int TclpIsAtty(int fd) } declare 17 win { int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts) } declare 18 win { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } declare 19 win { TclFile TclpOpenFile(const char *fname, int mode) } declare 20 win { void TclWinAddProcess(HANDLE hProcess, DWORD id) } declare 21 win { char *TclpInetNtoa(struct in_addr addr) } declare 22 win { TclFile TclpCreateTempFile(const char *contents) } declare 24 win { char *TclWinNoBackslash(char *path) } declare 26 win { void TclWinSetInterfaces(int wide) } declare 27 win { void TclWinFlushDirtyChannels(void) } declare 28 win { void TclWinResetInterfaces(void) } ################################ # Unix specific functions # Pipe channel functions declare 0 unix { void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) } declare 1 unix { int TclpCloseFile(TclFile file) } declare 2 unix { Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) } declare 3 unix { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } declare 4 unix { int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } declare 5 unix { int TclUnixWaitForFile_(int fd, int mask, int timeout) } declare 6 unix { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } declare 7 unix { TclFile TclpOpenFile(const char *fname, int mode) } declare 8 unix { int TclUnixWaitForFile(int fd, int mask, int timeout) } # Added in 8.1: declare 9 unix { TclFile TclpCreateTempFile(const char *contents) } # Added in 8.4: declare 10 unix { Tcl_DirEntry *TclpReaddir(TclDIR *dir) } # Slots 11 and 12 are forwarders for functions that were promoted to # generic Stubs declare 11 unix { struct tm *TclpLocaltime_unix(const time_t *clock) } declare 12 unix { struct tm *TclpGmtime_unix(const time_t *clock) } declare 13 unix { char *TclpInetNtoa(struct in_addr addr) } # Added in 8.5: declare 14 unix { int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts) } ################################ # Mac OS X specific functions declare 15 {unix macosx} { int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr) } declare 16 {unix macosx} { int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr) } declare 17 {unix macosx} { int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr) } declare 18 {unix macosx} { int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types) } declare 19 {unix macosx} { void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) } declare 22 {unix macosx} { TclFile TclpCreateTempFile_(const char *contents) } declare 29 {win unix} { int TclWinCPUID(unsigned int index, unsigned int *regs) } # Added in 8.6; core of TclpOpenTemporaryFile declare 30 {win unix} { int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) } # Local Variables: # mode: tcl # End: tcl8.6.14/generic/tclOO.decls0000644000175000017500000001502314554262142015313 0ustar sergeisergei# tclOO.decls -- # # This file contains the declarations for all supported public functions # that are exported by the TclOO package that is embedded within the Tcl # library via the stubs table. This file is used to generate the # tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files. # # Copyright ТЉ 2008-2013 Donal K. Fellows. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. library tclOO ###################################################################### # Public API, exposed for general users of TclOO. # interface tclOO hooks tclOOInt scspec TCLAPI declare 0 { Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName) } declare 1 { Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz) } declare 2 { Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object) } declare 3 { Tcl_Command Tcl_GetObjectCommand(Tcl_Object object) } declare 4 { Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 5 { Tcl_Namespace *Tcl_GetObjectNamespace(Tcl_Object object) } declare 6 { Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method) } declare 7 { Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method) } declare 8 { int Tcl_MethodIsPublic(Tcl_Method method) } declare 9 { int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr) } declare 10 { Tcl_Obj *Tcl_MethodName(Tcl_Method method) } declare 11 { Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, void *clientData) } declare 12 { Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, void *clientData) } declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip) } declare 14 { int Tcl_ObjectDeleted(Tcl_Object object) } declare 15 { int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context) } declare 16 { Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context) } declare 17 { Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context) } declare 18 { int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) } declare 19 { void *Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr) } declare 20 { void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 21 { void *Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr) } declare 22 { void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 23 { int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) } declare 24 { Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper( Tcl_Object object) } declare 25 { void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc) } declare 26 { void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method) } declare 27 { void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method) } declare 28 { Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object) } declare 34 { void TclOOUnusedStubEntry(void) } ###################################################################### # Private API, exposed to support advanced OO systems that plug in on top of # TclOO; not intended for general use and does not have any commitment to # long-term support. # interface tclOOInt declare 0 { Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp) } declare 1 { Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr) } declare 2 { Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr) } declare 3 { Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr) } declare 4 { Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr) } declare 5 { int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls) } declare 6 { int TclOOIsReachable(Class *targetPtr, Class *startPtr) } declare 7 { Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj) } declare 8 { Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj) } declare 9 { Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 10 { Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 11 { int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv) } declare 12 { void TclOOObjectSetFilters(Object *oPtr, int numFilters, Tcl_Obj *const *filters) } declare 13 { void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters) } declare 14 { void TclOOObjectSetMixins(Object *oPtr, int numMixins, Class *const *mixins) } declare 15 { void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins) } return # Local Variables: # mode: tcl # End: tcl8.6.14/generic/tclTomMath.decls0000644000175000017500000001627314554262142016357 0ustar sergeisergei# tclTomMath.decls -- # # This file contains the declarations for the functions in 'libtommath' # that are contained within the Tcl library. This file is used to # generate the 'tclTomMathDecls.h' and 'tclStubInit.c' files. # # If you edit this file, advance the revision number (and the epoch # if the new stubs are not backward compatible) in tclTomMathDecls.h # # Copyright ТЉ 2005 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. library tcl # Define the unsupported generic interfaces. interface tclTomMath scspec EXTERN # Declare each of the functions in the Tcl tommath interface declare 0 { int TclBN_epoch(void) } declare 1 { int TclBN_revision(void) } declare 2 { mp_err TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c) } declare 3 { mp_err TclBN_mp_add_d(const mp_int *a, mp_digit b, mp_int *c) } declare 4 { mp_err TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c) } declare 5 { void TclBN_mp_clamp(mp_int *a) } declare 6 { void TclBN_mp_clear(mp_int *a) } declare 7 { void TclBN_mp_clear_multi(mp_int *a, ...) } declare 8 { mp_ord TclBN_mp_cmp(const mp_int *a, const mp_int *b) } declare 9 { mp_ord TclBN_mp_cmp_d(const mp_int *a, mp_digit b) } declare 10 { mp_ord TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) } declare 11 { mp_err TclBN_mp_copy(const mp_int *a, mp_int *b) } declare 12 { int TclBN_mp_count_bits(const mp_int *a) } declare 13 { mp_err TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r) } declare 14 { mp_err TclBN_mp_div_d(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r) } declare 15 { mp_err TclBN_mp_div_2(const mp_int *a, mp_int *q) } declare 16 { mp_err TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r) } declare 17 { mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r) } declare 18 { void TclBN_mp_exch(mp_int *a, mp_int *b) } declare 19 { mp_err TclBN_mp_expt_d(const mp_int *a, unsigned int b, mp_int *c) } declare 20 { mp_err TclBN_mp_grow(mp_int *a, int size) } declare 21 { mp_err TclBN_mp_init(mp_int *a) } declare 22 { mp_err TclBN_mp_init_copy(mp_int *a, const mp_int *b) } declare 23 { mp_err TclBN_mp_init_multi(mp_int *a, ...) } declare 24 { mp_err TclBN_mp_init_set(mp_int *a, mp_digit b) } declare 25 { mp_err TclBN_mp_init_size(mp_int *a, int size) } declare 26 { mp_err TclBN_mp_lshd(mp_int *a, int shift) } declare 27 { mp_err TclBN_mp_mod(const mp_int *a, const mp_int *b, mp_int *r) } declare 28 { mp_err TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r) } declare 29 { mp_err TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p) } declare 30 { mp_err TclBN_mp_mul_d(const mp_int *a, mp_digit b, mp_int *p) } declare 31 { mp_err TclBN_mp_mul_2(const mp_int *a, mp_int *p) } declare 32 { mp_err TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p) } declare 33 { mp_err TclBN_mp_neg(const mp_int *a, mp_int *b) } declare 34 { mp_err TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c) } declare 35 { mp_err TclBN_mp_radix_size(const mp_int *a, int radix, int *size) } declare 36 { mp_err TclBN_mp_read_radix(mp_int *a, const char *str, int radix) } declare 37 { void TclBN_mp_rshd(mp_int *a, int shift) } declare 38 { mp_err TclBN_mp_shrink(mp_int *a) } declare 39 { void TclBN_mp_set(mp_int *a, mp_digit b) } declare 40 { mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b) } declare 41 { mp_err TclBN_mp_sqrt(const mp_int *a, mp_int *b) } declare 42 { mp_err TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) } declare 43 { mp_err TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) } declare 44 { mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b) } declare 45 { mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) } declare 46 { mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) } declare 47 { size_t TclBN_mp_unsigned_bin_size(const mp_int *a) } declare 48 { mp_err TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c) } declare 49 { void TclBN_mp_zero(mp_int *a) } # internal routines to libtommath - should not be called but must be # exported to accommodate the "tommath" extension declare 50 { void TclBN_reverse(unsigned char *s, int len) } declare 51 { mp_err TclBN_fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) } declare 52 { mp_err TclBN_fast_s_mp_sqr(const mp_int *a, mp_int *b) } declare 53 { mp_err TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) } declare 54 { mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b) } declare 55 { mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) } declare 56 { mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b) } declare 57 { mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) } declare 58 { mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) } declare 59 { mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b) } declare 60 { mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) } declare 61 { mp_err TclBN_mp_init_set_int(mp_int *a, unsigned long i) } declare 62 { mp_err TclBN_mp_set_int(mp_int *a, unsigned long i) } declare 63 { int TclBN_mp_cnt_lsb(const mp_int *a) } declare 64 { int TclBNInitBignumFromLong(mp_int *bignum, long initVal) } declare 65 { int TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal) } declare 66 { int TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal) } # Added in libtommath 1.0 declare 67 { mp_err TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) } # Added in libtommath 1.0.1 declare 68 { void TclBN_mp_set_ull(mp_int *a, Tcl_WideUInt i) } declare 69 { Tcl_WideUInt TclBN_mp_get_mag_ull(const mp_int *a) } declare 70 { void TclBN_mp_set_ll(mp_int *a, Tcl_WideInt i) } declare 71 { mp_err TclBN_mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) } declare 72 { mp_err TclBN_mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op) } # Added in libtommath 1.1.0 declare 73 { mp_err TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) } declare 74 { mp_err TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) } declare 75 { mp_err TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) } declare 76 { mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) } declare 77 { size_t TclBN_mp_pack_count(const mp_int *a, size_t nails, size_t size) } # Added in libtommath 1.2.0 declare 78 { int TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) } declare 79 { mp_err TclBN_mp_div_ld(const mp_int *a, Tcl_WideUInt b, mp_int *q, Tcl_WideUInt *r) } declare 80 { int TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) } # Local Variables: # mode: tcl # End: tcl8.6.14/generic/README0000644000175000017500000000030714554262142014136 0ustar sergeisergeiThis directory contains Tcl source files that work on all the platforms where Tcl runs (e.g. UNIX, PCs, and MacOSX). Platform-specific sources are in the directories ../unix, ../win, and ../macosx. tcl8.6.14/generic/tclGetDate.y0000644000175000017500000006750214554262142015502 0ustar sergeisergei/* * tclGetDate.y -- * * Contains yacc grammar for parsing date and time strings. The output of * this file should be the file tclDate.c which is used directly in the * Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is * only used when doing free-form date parsing, an ill-defined process * anyway. * * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ %parse-param {DateInfo* info} %lex-param {DateInfo* info} %define api.pure /* %error-verbose would be nice, but our token names are meaningless */ %locations %{ /* * tclDate.c -- * * This file is generated from a yacc grammar defined in the file * tclGetDate.y. It should not be edited directly. * * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tclInt.h" /* * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; time_t dateRelMonth; time_t dateRelDay; time_t dateRelSeconds; int dateHaveRel; time_t dateMonthOrdinal; int dateHaveOrdinalMonth; time_t dateDayOrdinal; time_t dateDayNumber; int dateHaveDay; const char *dateStart; const char *dateInput; time_t *dateRelPointer; int dateDigitCount; } DateInfo; #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) #define yyDSTmode (info->dateDSTmode) #define yyDayOrdinal (info->dateDayOrdinal) #define yyDayNumber (info->dateDayNumber) #define yyMonthOrdinal (info->dateMonthOrdinal) #define yyHaveDate (info->dateHaveDate) #define yyHaveDay (info->dateHaveDay) #define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) #define yyHaveRel (info->dateHaveRel) #define yyHaveTime (info->dateHaveTime) #define yyHaveZone (info->dateHaveZone) #define yyTimezone (info->dateTimezone) #define yyDay (info->dateDay) #define yyMonth (info->dateMonth) #define yyYear (info->dateYear) #define yyHour (info->dateHour) #define yyMinutes (info->dateMinutes) #define yySeconds (info->dateSeconds) #define yyMeridian (info->dateMeridian) #define yyRelMonth (info->dateRelMonth) #define yyRelDay (info->dateRelDay) #define yyRelSeconds (info->dateRelSeconds) #define yyRelPointer (info->dateRelPointer) #define yyInput (info->dateInput) #define yyDigitCount (info->dateDigitCount) #define EPOCH 1970 #define START_OF_TIME 1902 #define END_OF_TIME 2037 /* * The offset of tm_year of struct tm returned by localtime, gmtime, etc. * Posix requires 1900. */ #define TM_YEAR_BASE 1900 #define HOUR(x) ((int) (60 * (x))) #define SECSPERDAY (24L * 60L * 60L) #define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0)) /* * An entry in the lexical lookup table. */ typedef struct _TABLE { const char *name; int type; time_t value; } TABLE; /* * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; %} %union { time_t Number; enum _MERIDIAN Meridian; } %{ /* * Prototypes of internal functions. */ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); static void TclDateerror(YYLTYPE* location, DateInfo* info, const char *s); static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); static time_t ToSeconds(time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian); MODULE_SCOPE int yyparse(DateInfo*); %} %token tAGO %token tDAY %token tDAYZONE %token tID %token tMERIDIAN %token tMONTH %token tMONTH_UNIT %token tSTARDATE %token tSEC_UNIT %token tSNUMBER %token tUNUMBER %token tZONE %token tEPOCH %token tDST %token tISOBASE %token tDAY_UNIT %token tNEXT %type tDAY %type tDAYZONE %type tMONTH %type tMONTH_UNIT %type tDST %type tSEC_UNIT %type tSNUMBER %type tUNUMBER %type tZONE %type tISOBASE %type tDAY_UNIT %type unit %type sign %type tNEXT %type tSTARDATE %type tMERIDIAN %type o_merid %% spec : /* NULL */ | spec item ; item : time { yyHaveTime++; } | zone { yyHaveZone++; } | date { yyHaveDate++; } | ordMonth { yyHaveOrdinalMonth++; } | day { yyHaveDay++; } | relspec { yyHaveRel++; } | iso { yyHaveTime++; yyHaveDate++; } | trek { yyHaveTime++; yyHaveDate++; yyHaveRel++; } | number ; time : tUNUMBER tMERIDIAN { yyHour = $1; yyMinutes = 0; yySeconds = 0; yyMeridian = $2; } | tUNUMBER ':' tUNUMBER o_merid { yyHour = $1; yyMinutes = $3; yySeconds = 0; yyMeridian = $4; } | tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid { yyHour = $1; yyMinutes = $3; yySeconds = $5; yyMeridian = $6; } ; zone : tZONE tDST { yyTimezone = $1; if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100); yyDSTmode = DSTon; } | tZONE { yyTimezone = $1; if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100); yyDSTmode = DSToff; } | tDAYZONE { yyTimezone = $1; yyDSTmode = DSTon; } | sign tUNUMBER { yyTimezone = -$1*($2 % 100 + ($2 / 100) * 60); yyDSTmode = DSToff; } ; day : tDAY { yyDayOrdinal = 1; yyDayNumber = $1; } | tDAY ',' { yyDayOrdinal = 1; yyDayNumber = $1; } | tUNUMBER tDAY { yyDayOrdinal = $1; yyDayNumber = $2; } | sign tUNUMBER tDAY { yyDayOrdinal = $1 * $2; yyDayNumber = $3; } | tNEXT tDAY { yyDayOrdinal = 2; yyDayNumber = $2; } ; date : tUNUMBER '/' tUNUMBER { yyMonth = $1; yyDay = $3; } | tUNUMBER '/' tUNUMBER '/' tUNUMBER { yyMonth = $1; yyDay = $3; yyYear = $5; } | tISOBASE { yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; } | tUNUMBER '-' tMONTH '-' tUNUMBER { yyDay = $1; yyMonth = $3; yyYear = $5; } | tUNUMBER '-' tUNUMBER '-' tUNUMBER { yyMonth = $3; yyDay = $5; yyYear = $1; } | tMONTH tUNUMBER { yyMonth = $1; yyDay = $2; } | tMONTH tUNUMBER ',' tUNUMBER { yyMonth = $1; yyDay = $2; yyYear = $4; } | tUNUMBER tMONTH { yyMonth = $2; yyDay = $1; } | tEPOCH { yyMonth = 1; yyDay = 1; yyYear = EPOCH; } | tUNUMBER tMONTH tUNUMBER { yyMonth = $2; yyDay = $1; yyYear = $3; } ; ordMonth: tNEXT tMONTH { yyMonthOrdinal = 1; yyMonth = $2; } | tNEXT tUNUMBER tMONTH { yyMonthOrdinal = $2; yyMonth = $3; } ; iso : tUNUMBER '-' tUNUMBER '-' tUNUMBER tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER { if ($6 != HOUR( 7) + HOUR(100)) YYABORT; yyYear = $1; yyMonth = $3; yyDay = $5; yyHour = $7; yyMinutes = $9; yySeconds = $11; } | tISOBASE tZONE tISOBASE { if ($2 != HOUR( 7) + HOUR(100)) YYABORT; yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; yyHour = $3 / 10000; yyMinutes = ($3 % 10000)/100; yySeconds = $3 % 100; } | tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER { if ($2 != HOUR( 7) + HOUR(100)) YYABORT; yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; yyHour = $3; yyMinutes = $5; yySeconds = $7; } | tISOBASE tISOBASE { yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; yyHour = $2 / 10000; yyMinutes = ($2 % 10000)/100; yySeconds = $2 % 100; } ; trek : tSTARDATE tUNUMBER '.' tUNUMBER { /* * Offset computed year by -377 so that the returned years will be * in a range accessible with a 32 bit clock seconds value. */ yyYear = $2/1000 + 2323 - 377; yyDay = 1; yyMonth = 1; yyRelDay += (($2%1000)*(365 + IsLeapYear(yyYear)))/1000; yyRelSeconds += $4 * 144 * 60; } ; relspec : relunits tAGO { yyRelSeconds *= -1; yyRelMonth *= -1; yyRelDay *= -1; } | relunits ; relunits : sign tUNUMBER unit { *yyRelPointer += $1 * $2 * $3; } | tUNUMBER unit { *yyRelPointer += $1 * $2; } | tNEXT unit { *yyRelPointer += $2; } | tNEXT tUNUMBER unit { *yyRelPointer += $2 * $3; } | unit { *yyRelPointer += $1; } ; sign : '-' { $$ = -1; } | '+' { $$ = 1; } ; unit : tSEC_UNIT { $$ = $1; yyRelPointer = &yyRelSeconds; } | tDAY_UNIT { $$ = $1; yyRelPointer = &yyRelDay; } | tMONTH_UNIT { $$ = $1; yyRelPointer = &yyRelMonth; } ; number : tUNUMBER { if (yyHaveTime && yyHaveDate && !yyHaveRel) { yyYear = $1; } else { yyHaveTime++; if (yyDigitCount <= 2) { yyHour = $1; yyMinutes = 0; } else { yyHour = $1 / 100; yyMinutes = $1 % 100; } yySeconds = 0; yyMeridian = MER24; } } ; o_merid : /* NULL */ { $$ = MER24; } | tMERIDIAN { $$ = $1; } ; %% /* * Month and day table. */ static const TABLE MonthDayTable[] = { { "january", tMONTH, 1 }, { "february", tMONTH, 2 }, { "march", tMONTH, 3 }, { "april", tMONTH, 4 }, { "may", tMONTH, 5 }, { "june", tMONTH, 6 }, { "july", tMONTH, 7 }, { "august", tMONTH, 8 }, { "september", tMONTH, 9 }, { "sept", tMONTH, 9 }, { "october", tMONTH, 10 }, { "november", tMONTH, 11 }, { "december", tMONTH, 12 }, { "sunday", tDAY, 0 }, { "monday", tDAY, 1 }, { "tuesday", tDAY, 2 }, { "tues", tDAY, 2 }, { "wednesday", tDAY, 3 }, { "wednes", tDAY, 3 }, { "thursday", tDAY, 4 }, { "thur", tDAY, 4 }, { "thurs", tDAY, 4 }, { "friday", tDAY, 5 }, { "saturday", tDAY, 6 }, { NULL, 0, 0 } }; /* * Time units table. */ static const TABLE UnitsTable[] = { { "year", tMONTH_UNIT, 12 }, { "month", tMONTH_UNIT, 1 }, { "fortnight", tDAY_UNIT, 14 }, { "week", tDAY_UNIT, 7 }, { "day", tDAY_UNIT, 1 }, { "hour", tSEC_UNIT, 60 * 60 }, { "minute", tSEC_UNIT, 60 }, { "min", tSEC_UNIT, 60 }, { "second", tSEC_UNIT, 1 }, { "sec", tSEC_UNIT, 1 }, { NULL, 0, 0 } }; /* * Assorted relative-time words. */ static const TABLE OtherTable[] = { { "tomorrow", tDAY_UNIT, 1 }, { "yesterday", tDAY_UNIT, -1 }, { "today", tDAY_UNIT, 0 }, { "now", tSEC_UNIT, 0 }, { "last", tUNUMBER, -1 }, { "this", tSEC_UNIT, 0 }, { "next", tNEXT, 1 }, #if 0 { "first", tUNUMBER, 1 }, { "second", tUNUMBER, 2 }, { "third", tUNUMBER, 3 }, { "fourth", tUNUMBER, 4 }, { "fifth", tUNUMBER, 5 }, { "sixth", tUNUMBER, 6 }, { "seventh", tUNUMBER, 7 }, { "eighth", tUNUMBER, 8 }, { "ninth", tUNUMBER, 9 }, { "tenth", tUNUMBER, 10 }, { "eleventh", tUNUMBER, 11 }, { "twelfth", tUNUMBER, 12 }, #endif { "ago", tAGO, 1 }, { "epoch", tEPOCH, 0 }, { "stardate", tSTARDATE, 0 }, { NULL, 0, 0 } }; /* * The timezone table. (Note: This table was modified to not use any floating * point constants to work around an SGI compiler bug). */ static const TABLE TimezoneTable[] = { { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */ { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */ { "utc", tZONE, HOUR( 0) }, { "uct", tZONE, HOUR( 0) }, /* Universal Coordinated Time */ { "wet", tZONE, HOUR( 0) }, /* Western European */ { "bst", tDAYZONE, HOUR( 0) }, /* British Summer */ { "wat", tZONE, HOUR( 1) }, /* West Africa */ { "at", tZONE, HOUR( 2) }, /* Azores */ #if 0 /* For completeness. BST is also British Summer, and GST is * also Guam Standard. */ { "bst", tZONE, HOUR( 3) }, /* Brazil Standard */ { "gst", tZONE, HOUR( 3) }, /* Greenland Standard */ #endif { "nft", tZONE, HOUR( 7/2) }, /* Newfoundland */ { "nst", tZONE, HOUR( 7/2) }, /* Newfoundland Standard */ { "ndt", tDAYZONE, HOUR( 7/2) }, /* Newfoundland Daylight */ { "ast", tZONE, HOUR( 4) }, /* Atlantic Standard */ { "adt", tDAYZONE, HOUR( 4) }, /* Atlantic Daylight */ { "est", tZONE, HOUR( 5) }, /* Eastern Standard */ { "edt", tDAYZONE, HOUR( 5) }, /* Eastern Daylight */ { "cst", tZONE, HOUR( 6) }, /* Central Standard */ { "cdt", tDAYZONE, HOUR( 6) }, /* Central Daylight */ { "mst", tZONE, HOUR( 7) }, /* Mountain Standard */ { "mdt", tDAYZONE, HOUR( 7) }, /* Mountain Daylight */ { "pst", tZONE, HOUR( 8) }, /* Pacific Standard */ { "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */ { "yst", tZONE, HOUR( 9) }, /* Yukon Standard */ { "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */ { "hst", tZONE, HOUR(10) }, /* Hawaii Standard */ { "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */ { "cat", tZONE, HOUR(10) }, /* Central Alaska */ { "ahst", tZONE, HOUR(10) }, /* Alaska-Hawaii Standard */ { "nt", tZONE, HOUR(11) }, /* Nome */ { "idlw", tZONE, HOUR(12) }, /* International Date Line West */ { "cet", tZONE, -HOUR( 1) }, /* Central European */ { "cest", tDAYZONE, -HOUR( 1) }, /* Central European Summer */ { "met", tZONE, -HOUR( 1) }, /* Middle European */ { "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */ { "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */ { "swt", tZONE, -HOUR( 1) }, /* Swedish Winter */ { "sst", tDAYZONE, -HOUR( 1) }, /* Swedish Summer */ { "fwt", tZONE, -HOUR( 1) }, /* French Winter */ { "fst", tDAYZONE, -HOUR( 1) }, /* French Summer */ { "eet", tZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 */ { "bt", tZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 */ { "it", tZONE, -HOUR( 7/2) }, /* Iran */ { "zp4", tZONE, -HOUR( 4) }, /* USSR Zone 3 */ { "zp5", tZONE, -HOUR( 5) }, /* USSR Zone 4 */ { "ist", tZONE, -HOUR(11/2) }, /* Indian Standard */ { "zp6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */ #if 0 /* For completeness. NST is also Newfoundland Standard, and SST is * also Swedish Summer. */ { "nst", tZONE, -HOUR(13/2) }, /* North Sumatra */ { "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */ #endif /* 0 */ { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */ { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */ { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */ { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */ { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */ { "jdt", tDAYZONE, -HOUR( 9) }, /* Japan Daylight */ { "kst", tZONE, -HOUR( 9) }, /* Korea Standard */ { "kdt", tDAYZONE, -HOUR( 9) }, /* Korea Daylight */ { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */ { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */ { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */ { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */ { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */ { "nzt", tZONE, -HOUR(12) }, /* New Zealand */ { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */ { "nzdt", tDAYZONE, -HOUR(12) }, /* New Zealand Daylight */ { "idle", tZONE, -HOUR(12) }, /* International Date Line East */ /* ADDED BY Marco Nijdam */ { "dst", tDST, HOUR( 0) }, /* DST on (hour is ignored) */ /* End ADDED */ { NULL, 0, 0 } }; /* * Military timezone table. */ static const TABLE MilitaryTable[] = { { "a", tZONE, -HOUR( 1) + HOUR(100) }, { "b", tZONE, -HOUR( 2) + HOUR(100) }, { "c", tZONE, -HOUR( 3) + HOUR(100) }, { "d", tZONE, -HOUR( 4) + HOUR(100) }, { "e", tZONE, -HOUR( 5) + HOUR(100) }, { "f", tZONE, -HOUR( 6) + HOUR(100) }, { "g", tZONE, -HOUR( 7) + HOUR(100) }, { "h", tZONE, -HOUR( 8) + HOUR(100) }, { "i", tZONE, -HOUR( 9) + HOUR(100) }, { "k", tZONE, -HOUR(10) + HOUR(100) }, { "l", tZONE, -HOUR(11) + HOUR(100) }, { "m", tZONE, -HOUR(12) + HOUR(100) }, { "n", tZONE, HOUR( 1) + HOUR(100) }, { "o", tZONE, HOUR( 2) + HOUR(100) }, { "p", tZONE, HOUR( 3) + HOUR(100) }, { "q", tZONE, HOUR( 4) + HOUR(100) }, { "r", tZONE, HOUR( 5) + HOUR(100) }, { "s", tZONE, HOUR( 6) + HOUR(100) }, { "t", tZONE, HOUR( 7) + HOUR(100) }, { "u", tZONE, HOUR( 8) + HOUR(100) }, { "v", tZONE, HOUR( 9) + HOUR(100) }, { "w", tZONE, HOUR( 10) + HOUR(100) }, { "x", tZONE, HOUR( 11) + HOUR(100) }, { "y", tZONE, HOUR( 12) + HOUR(100) }, { "z", tZONE, HOUR( 0) + HOUR(100) }, { NULL, 0, 0 } }; /* * Dump error messages in the bit bucket. */ static void TclDateerror( YYLTYPE* location, DateInfo* infoPtr, const char *s) { Tcl_Obj* t; Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1); Tcl_AppendToObj(infoPtr->messages, s, -1); Tcl_AppendToObj(infoPtr->messages, " (characters ", -1); TclNewIntObj(t, location->first_column); Tcl_IncrRefCount(t); Tcl_AppendObjToObj(infoPtr->messages, t); Tcl_DecrRefCount(t); Tcl_AppendToObj(infoPtr->messages, "-", -1); TclNewIntObj(t, location->last_column); Tcl_IncrRefCount(t); Tcl_AppendObjToObj(infoPtr->messages, t); Tcl_DecrRefCount(t); Tcl_AppendToObj(infoPtr->messages, ")", -1); infoPtr->separatrix = "\n"; } static time_t ToSeconds( time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian) { if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) { return -1; } switch (Meridian) { case MER24: if (Hours < 0 || Hours > 23) { return -1; } return (Hours * 60L + Minutes) * 60L + Seconds; case MERam: if (Hours < 1 || Hours > 12) { return -1; } return ((Hours % 12) * 60L + Minutes) * 60L + Seconds; case MERpm: if (Hours < 1 || Hours > 12) { return -1; } return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds; } return -1; /* Should never be reached */ } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { char *p; char *q; const TABLE *tp; int i, abbrev; /* * Make it lowercase. */ Tcl_UtfToLower(buff); if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) { yylvalPtr->Meridian = MERam; return tMERIDIAN; } if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) { yylvalPtr->Meridian = MERpm; return tMERIDIAN; } /* * See if we have an abbreviation for a month. */ if (strlen(buff) == 3) { abbrev = 1; } else if (strlen(buff) == 4 && buff[3] == '.') { abbrev = 1; buff[3] = '\0'; } else { abbrev = 0; } for (tp = MonthDayTable; tp->name; tp++) { if (abbrev) { if (strncmp(buff, tp->name, 3) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } else if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } for (tp = TimezoneTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } for (tp = UnitsTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } /* * Strip off any plural and try the units table again. */ i = strlen(buff) - 1; if (i > 0 && buff[i] == 's') { buff[i] = '\0'; for (tp = UnitsTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } } for (tp = OtherTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } /* * Military timezones. */ if (buff[1] == '\0' && !(*buff & 0x80) && isalpha(UCHAR(*buff))) { /* INTL: ISO only */ for (tp = MilitaryTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } } /* * Drop out any periods and try the timezone table again. */ for (i = 0, p = q = buff; *q; q++) { if (*q != '.') { *p++ = *q; } else { i++; } } *p = '\0'; if (i) { for (tp = TimezoneTable; tp->name; tp++) { if (strcmp(buff, tp->name) == 0) { yylvalPtr->Number = tp->value; return tp->type; } } } return tID; } static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { char c; char *p; char buff[20]; int Count; location->first_column = yyInput - info->dateStart; for ( ; ; ) { while (TclIsSpaceProcM(*yyInput)) { yyInput++; } if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ /* * Convert the string into a number; count the number of digits. */ Count = 0; for (yylvalPtr->Number = 0; isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */ yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0'; Count++; } yyInput--; yyDigitCount = Count; /* * A number with 6 or more digits is considered an ISO 8601 base. */ if (Count >= 6) { location->last_column = yyInput - info->dateStart - 1; return tISOBASE; } else { location->last_column = yyInput - info->dateStart - 1; return tUNUMBER; } } if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */ for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */ || c == '.'; ) { if (p < &buff[sizeof buff - 1]) { *p++ = c; } } *p = '\0'; yyInput--; location->last_column = yyInput - info->dateStart - 1; return LookupWord(yylvalPtr, buff); } if (c != '(') { location->last_column = yyInput - info->dateStart; return *yyInput++; } Count = 0; do { c = *yyInput++; if (c == '\0') { location->last_column = yyInput - info->dateStart - 1; return c; } else if (c == '(') { Count++; } else if (c == ')') { Count--; } } while (Count > 0); } } int TclClockOldscanObjCmd( void *dummy, /* Unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Count of parameters */ Tcl_Obj *const *objv) /* Parameters */ { Tcl_Obj *result, *resultElement; int yr, mo, da; DateInfo dateInfo; DateInfo* info = &dateInfo; int status; (void)dummy; if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "stringToParse baseYear baseMonth baseDay" ); return TCL_ERROR; } yyInput = Tcl_GetString( objv[1] ); dateInfo.dateStart = yyInput; yyHaveDate = 0; if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { return TCL_ERROR; } yyYear = yr; yyMonth = mo; yyDay = da; yyHaveTime = 0; yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; yyHaveZone = 0; yyTimezone = 0; yyDSTmode = DSTmaybe; yyHaveOrdinalMonth = 0; yyMonthOrdinal = 0; yyHaveDay = 0; yyDayOrdinal = 0; yyDayNumber = 0; yyHaveRel = 0; yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL; TclNewObj(dateInfo.messages); dateInfo.separatrix = ""; Tcl_IncrRefCount(dateInfo.messages); status = yyparse(&dateInfo); if (status == 1) { Tcl_SetObjResult(interp, dateInfo.messages); Tcl_DecrRefCount(dateInfo.messages); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); return TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); Tcl_DecrRefCount(dateInfo.messages); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else if (status != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned " "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); Tcl_DecrRefCount(dateInfo.messages); Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); return TCL_ERROR; } Tcl_DecrRefCount(dateInfo.messages); if (yyHaveDate > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one date in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } if (yyHaveTime > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one time of day in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } if (yyHaveZone > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one time zone in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } if (yyHaveDay > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one weekday in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } if (yyHaveOrdinalMonth > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one ordinal month in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } TclNewObj(result); TclNewObj(resultElement); if (yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyYear)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyMonth)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyDay)); } Tcl_ListObjAppendElement(interp, result, resultElement); if (yyHaveTime) { Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian))); } else { Tcl_ListObjAppendElement(interp, result, Tcl_NewObj()); } TclNewObj(resultElement); if (yyHaveZone) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) -yyTimezone)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj(1 - yyDSTmode)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveRel) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyRelMonth)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyRelDay)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyRelSeconds)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveDay && !yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyDayOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyDayNumber)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyMonthOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj((int) yyMonth)); } Tcl_ListObjAppendElement(interp, result, resultElement); Tcl_SetObjResult(interp, result); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/changes0000644000175000017500000135724114565415452013220 0ustar sergeisergeiRecent user-visible changes to Tcl: 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. 2. Semi-colon now available for grouping commands on a line. 3. For a command to span multiple lines, must now use backslash-return at the end of each line but the last. 4. "Var" command has been changed to "set". 5. Double-quotes now available as an argument grouping character. 6. "Return" may be used at top-level. 7. More backslash sequences available now. In particular, backslash-newline may be used to join lines in command files. 8. New or modified built-in commands: case, return, for, glob, info, print, return, set, source, string, uplevel. 9. After an error, the variable "errorInfo" is filled with a stack trace showing what was being executed when the error occurred. 10. Command abbreviations are accepted when parsing commands, but are not recommended except for purely-interactive commands. 11. $, set, and expr all complain now if a non-existent variable is referenced. 12. History facilities exist now. See Tcl.man and Tcl_RecordAndEval.man. 13. Changed to distinguish between empty variables and those that don't exist at all. Interfaces to Tcl_GetVar and Tcl_ParseVar have changed (NULL return value is now possible). *** POTENTIAL INCOMPATIBILITY *** 14. Changed meaning of "level" argument to "uplevel" command (1 now means "go up one level", not "go to level 1"; "#1" means "go to level 1"). *** POTENTIAL INCOMPATIBILITY *** 15. 3/19/90 Added "info exists" option to see if variable exists. 16. 3/19/90 Added "noAbbrev" variable to prohibit command abbreviations. 17. 3/19/90 Added extra errorInfo option to "error" command. 18. 3/21/90 Double-quotes now only affect space: command, variable, and backslash substitutions still occur inside double-quotes. *** POTENTIAL INCOMPATIBILITY *** 19. 3/21/90 Added support for \r. 20. 3/21/90 List, concat, eval, and glob commands all expect at least one argument now. *** POTENTIAL INCOMPATIBILITY *** 21. 3/22/90 Added "?:" operators to expressions. 22. 3/25/90 Fixed bug in Tcl_Result that caused memory to get trashed. ------------------- Released version 3.1 --------------------- 23. 3/29/90 Fixed bug that caused "file a.b/c ext" to return ".b/c". 24. 3/29/90 Semi-colon is not treated specially when enclosed in double-quotes. ------------------- Released version 3.2 --------------------- 25. 4/16/90 Rewrote "exec" not to use select or signals anymore. Should be more Sys-V compatible, and no slower in the normal case. 26. 4/18/90 Rewrote "glob" to eliminate GNU code (there's no GNU code left in Tcl, now), and added Tcl_TildeSubst procedure. Added automatic tilde-substitution in many commands, including "glob". ------------------- Released version 3.3 --------------------- 27. 7/11/90 Added "Tcl_AppendResult" procedure. 28. 7/20/90 "History" with no options now defaults to "history info" rather than to "history redo". Although this is a backward incompatibility, it should only be used interactively and thus shouldn't present any compatibility problems with scripts. 29. 7/20/90 Added "Tcl_GetInteger", "Tcl_GetDouble", and "Tcl_GetBoolean" procedures. 30. 7/22/90 Removed "Tcl_WatchInterp" procedure: doesn't seem to be necessary, since the same effect can be achieved with the deletion callbacks on individual commands. *** POTENTIAL INCOMPATIBILITY *** 31. 7/23/90 Added variable tracing: Tcl_TraceVar, Tcl_UnTraceVar, and Tcl_VarTraceInfo procedures, "trace" command. 32. 8/9/90 Mailed out list of all bug fixes since 3.3 release. 33. 8/29/90 Fixed bugs in Tcl_Merge relating to backslashes and semi-colons. Mailed out patch. 34. 9/3/90 Fixed bug in tclBasic.c: quotes weren't quoting ]'s. Mailed out patch. 35. 9/19/90 Rewrote exec to always use files both for input and output to the process. The old pipe-based version didn't work if the exec'ed process forked a child and then exited: Tcl waited around for stdout to get closed, which didn't happen until the grandchild exited. 36. 11/5/90 ERR_IN_PROGRESS flag wasn't being cleared soon enough in Tcl_Eval, allowing error messages from different commands to pile up in $errorInfo. Fixed by re-arranging code in Tcl_Eval that re-initializes result and ERR_IN_PROGRESS flag. Didn't mail out patch: changes too complicated to describe. 37. 12/19/90 Added Tcl_VarEval procedure as a convenience for assembling and executing Tcl commands. 38. 1/29/91 Fixed core leak in Tcl_AddErrorInfo. Also changed procedure and Tcl_Eval so that first call to Tcl_AddErrorInfo need not come from Tcl_Eval. ----------------- Released version 5.0 with Tk ------------------ 39. 4/3/91 Removed change bars from manual entries, leaving only those that came after version 3.3 was released. 40. 5/17/91 Changed tests to conform to Mary Ann May-Pumphrey's approach. 41. 5/23/91 Massive revision to Tcl parser to simplify the implementation of string and floating-point support in expressions. Newlines inside [] are now treated as command separators rather than word separators (this makes newline treatment consistent throughout Tcl). *** POTENTIAL INCOMPATIBILITY *** 42. 5/23/91 Massive rewrite of expression code to support floating-point values and simple string comparisons. The C interfaces to expression routines have changed (Tcl_Expr is replaced by Tcl_ExprLong, Tcl_ExprDouble, etc.), but all old Tcl expression strings should be accepted by the new expression code. *** POTENTIAL INCOMPATIBILITY *** 43. 5/23/91 Modified tclHistory.c to check for negative "keep" value. 44. 5/23/91 Modified Tcl_Backslash to handle backslash-newline. It now returns 0 to indicate that a backslash sequence should be replaced by no character at all. *** POTENTIAL INCOMPATIBILITY *** 45. 5/29/91 Modified to use ANSI C function prototypes. Must set "USE_ANSI" switch when compiling to get prototypes. 46. 5/29/91 Completed test suite by providing tests for all of the built-in Tcl commands. 47. 5/29/91 Changed Tcl_Concat to eliminate leading and trailing white-space in each of the things it concatenates and to ignore elements that are empty or have only white space in them. This produces cleaner output from the "concat" command. *** POTENTIAL INCOMPATIBILITY *** 48. 5/31/91 Changed "set" command and Tcl_SetVar procedure to return new value of variable. 49. 6/1/91 Added "while" and "cd" commands. 50. 6/1/91 Changed "exec" to delete the last character of program output if it is a newline. In most cases this makes it easier to process program-generated output. *** POTENTIAL INCOMPATIBILITY *** 51. 6/1/91 Made sure that pointers are never used after freeing them. 52. 6/1/91 Fixed bug in TclWordEnd where it wasn't dealing with [] inside quotes correctly. 53. 6/8/91 Fixed exec.test to accept return values of either 1 or 255 from "false" command. 54. 7/6/91 Massive overhaul of variable management. Associative arrays now available, along with "unset" command (and Tcl_UnsetVar procedure). Variable traces have been completely reworked: interfaces different both from Tcl and C, and multiple traces may exist on same variable. Can no longer redefine existing local variable to be global. Calling sequences have changed slightly for Tcl_GetVar and Tcl_SetVar ("global" is now "flags"). Tcl_SetVar can fail and return a NULL result. New forms of variable-manipulation procedures: Tcl_GetVar2, Tcl_SetVar2, etc. Syntax of variable $-notation changed to support array indexing. *** POTENTIAL INCOMPATIBILITY *** 55. 7/6/91 Added new list-manipulation procedures: Tcl_ScanElement, Tcl_ConvertElement, Tcl_AppendElement. 56. 7/12/91 Created new procedure Tcl_EvalFile, which does most of the work of the "source" command. 57. 7/20/91 Major reworking of "exec" command to allow pipelines, more redirection, background. Added new procedures Tcl_Fork, Tcl_WaitPids, Tcl_DetachPids, and Tcl_CreatePipeline. The old "< input" notation has been replaced by "<< input" ("<" is for redirection from a file). Also handles error returns and abnormal terminations (e.g. signals) differently. *** POTENTIAL INCOMPATIBILITY *** 58. 7/21/91 Added "append" and "lappend" commands. 59. 7/22/91 Reworked error messages and manual entries to use ?x? as the notation for an optional argument x, instead of [x]. The bracket notation was often confused with the use of brackets for command substitution. Also modified error messages to be more consistent. 60. 7/23/91 Tcl_DeleteCommand now returns an indication of whether or not the command actually existed, and the "rename" command uses this information to return an error if an attempt is made to delete a non-existent command. *** POTENTIAL INCOMPATIBILITY *** 61. 7/25/91 Added new "errorCode" mechanism, along with procedures Tcl_SetErrorCode, Tcl_UnixError, and Tcl_ResetResult. Renamed Tcl_Return to Tcl_SetResult, but left a #define for Tcl_Return to avoid compatibility problems. 62. 7/26/91 Extended "case" command with alternate syntax where all patterns and commands are together in a single list argument: makes it easier to write multi-line case statements. 63. 7/27/91 Changed "print" command to perform tilde-substitution on the file name. 64. 7/27/91 Added "tolower", "toupper", "trim", "trimleft", and "trimright" options to "string" command. 65. 7/29/91 Added "atime", "mtime", "size", and "stat" options to "file" command. 66. 8/1/91 Added "split" and "join" commands. 67. 8/11/91 Added commands for file I/O, including "open", "close", "read", "gets", "puts", "flush", "eof", "seek", and "tell". 68. 8/14/91 Switched to use a hash table for command lookups. Command abbreviations no longer have direct support in the Tcl interpreter, but it should be possible to simulate them with the auto-load features described below. The "noAbbrev" variable is no longer used by Tcl. *** POTENTIAL INCOMPATIBILITY *** 68.5 8/15/91 Added support for "unknown" command, which can be used to complete abbreviations, auto-load library files, auto-exec shell commands, etc. 69. 8/15/91 Added -nocomplain switch to "glob" command. 70. 8/20/91 Added "info library" option and TCL_LIBRARY #define. Also added "info script" option. 71. 8/20/91 Changed "file" command to take "option" argument as first argument (before file name), for consistency with other Tcl commands. *** POTENTIAL INCOMPATIBILITY *** 72. 8/20/91 Changed format of information in $errorInfo variable: comments such as ("while" body line 1) are now on separate lines from commands being executed. *** POTENTIAL INCOMPATIBILITY *** 73. 8/20/91 Changed Tcl_AppendResult so that it (eventually) frees large buffers that it allocates. 74. 8/21/91 Added "linsert", "lreplace", "lsearch", and "lsort" commands. 75. 8/28/91 Added "incr" and "exit" commands. 76. 8/30/91 Added "regexp" and "regsub" commands. 77. 9/4/91 Changed "dynamic" field in interpreters to "freeProc" (procedure address). This allows for alternative storage managers. *** POTENTIAL INCOMPATIBILITY *** 78. 9/6/91 Added "index", "length", and "range" options to "string" command. Added "lindex", "llength", and "lrange" commands. 79. 9/8/91 Removed "index", "length", "print" and "range" commands. "Print" is redundant with "puts", but less general, and the other commands are replaced with the new commands described in change 78 above. *** POTENTIAL INCOMPATIBILITY *** 80. 9/8/91 Changed history revision to occur even when history command is nested; needed in order to allow "history" to be invoked from "unknown" procedure. 81. 9/13/91 Changed "panic" not to use vfprintf (it's uglier and less general now, but makes it easier to run Tcl on systems that don't have vfprintf). Also changed "strerror" not to redeclare sys_errlist. 82. 9/19/91 Lots of changes to improve portability to different UNIX systems, including addition of "config" script to adapt Tcl to the configuration of the system it's being compiled on. 83. 9/22/91 Added "pwd" command. 84. 9/22/91 Renamed manual pages so that their filenames are no more than 14 characters in length, moved to "doc" subdirectory. 85. 9/24/91 Redid manual entries so they contain the supplemental macros that they need; can just print with "troff -man" or "man" now. 86. 9/26/91 Created initial version of script library, including a version of "unknown" that does auto-loading, auto-execution, and abbreviation expansion. This library is used by tclTest automatically. See the "library" manual entry for details. ----------------- Released version 6.0, 9/26/91 ------------------ 87. 9/30/91 Made "string tolower" and "string toupper" check case before converting: on some systems, "tolower" and "toupper" assume that character already has particular case. 88. 9/30/91 Fixed bug in Tcl_SetResult: wasn't always setting freeProc correctly when called with NULL value. This tended to cause memory allocation errors later. 89. 10/3/91 Added "upvar" command. 90. 10/4/91 Changed "format" so that internally it converts %D to %ld, %U to %lu, %O to %lo, and %F to %f. This eliminates some compatibility problems on some machines without affecting behavior. 91. 10/10/91 Fixed bug in "regsub" that caused core dumps with the -all option when the last match wasn't at the end of the string. 92. 10/17/91 Fixed problems with backslash sequences: \r support was incomplete and \f and \v weren't supported at all. 93. 10/24/91 Added Tcl_InitHistory procedure. 94. 10/24/91 Changed "regexp" to store "-1 -1" in subMatchVars that don't match, rather than returning an error. 95. 10/27/91 Modified "regexp" to return actual strings in matchVar and subMatchVars instead of indices. Added "-indices" switch to cause indices to be returned. *** POTENTIAL INCOMPATIBILITY *** 96. 10/27/91 Fixed bug in "scan" where it used hardwired constants for sizes of floats and doubles instead of using "sizeof". 97. 10/31/91 Fixed bug in tclParse.c where parse-related error messages weren't being storage-managed correctly, causing spurious free's. 98. 10/31/91 Form feed and vertical tab characters are now considered to be space characters by the parser. 99. 10/31/91 Added TCL_LEAVE_ERR_MSG flag to procedures like Tcl_SetVar. 100. 11/7/91 Fixed bug in "case" where "in" argument couldn't be omitted if all case branches were embedded in a single list. 101. 11/7/91 Switched to use "pid_t" and "uid_t" and other official POSIC types and function prototypes. ----------------- Released version 6.1, 11/7/91 ------------------ 102. 12/2/91 Modified Tcl_ScanElement and Tcl_ConvertElement in several ways. First, allowed caller to request that only backslashes be used (no braces). Second, made Tcl_ConvertElement more aggressive in using backslashes for braces and quotes. 103. 12/5/91 Added "type", "lstat", and "readlink" options to "file" command, plus added new "type" element to output of "stat" and "lstat" options. 104. 12/10/91 Manual entries had first lines that caused "man" program to try weird preprocessor. Added blank comment lines to fix problem. 105. 12/16/91 Fixed a few bugs in auto_mkindex proc: wasn't handling errors properly, and hadn't been upgraded for new "regexp" syntax. 106. 1/2/92 Fixed bug in "file" command where it didn't properly handle a file names containing tildes where the indicated user doesn't exist. 107. 1/2/92 Fixed lots of cases in tclUnixStr.c where two different errno symbols (e.g. EWOULDBLOCK and EAGAIN) have the same number; Tcl will only use one of them. 108. 1/2/92 Lots of changes to configuration script to handle many more systems more gracefully. E.g. should now detect the bogus strtoul that comes with AIX and substitute Tcl's own version instead. ----------------- Released version 6.2, 1/10/92 ------------------ 109. 1/20/92 Config didn't have code to actually use "uid_t" variable to set TCL_UIT_T #define. 110. 2/10/92 Tcl_Eval didn't properly reset "numLevels" variable when too-deep recursion occurred. 111. 2/29/92 Added "on" and "off" to keywords accepted by Tcl_GetBoolean. 112. 3/19/92 Config wasn't installing default version of strtod.c for systems that don't have one in libc.a. 113. 3/23/92 Fixed bug in tclExpr.c where numbers with leading "."s, like 0.75, couldn't be properly substituted into expressions with variable or command substitution. 114. 3/25/92 Fixed bug in tclUnixAZ.c where "gets" command wasn't checking to make sure that it was able to write the variable OK. 115. 4/16/92 Fixed bug in tclUnixAZ.c where "read" command didn't compute file size right for device files. 116. 4/23/92 Fixed but in tclCmdMZ.c where "trace vinfo" was overwriting the trace command. ----------------- Released version 6.3, 5/1/92 ------------------ 117. 5/1/92 Added Tcl_GlobalEval. 118. 6/1/92 Changed auto-load facility to source files at global level. 119. 6/8/92 Tcl_ParseVar wasn't always setting termPtr after errors, which sometimes caused core dumps. 120. 6/21/92 Fixed bug in initialization of regexp pattern cache. This bug caused segmentation violations in regexp commands under some conditions. 121. 6/22/92 Changed implementation of "glob" command to eliminate trailing slashes on directory names: they confuse some systems. There shouldn't be any user-visible changes in functionality except for names in error messages not having trailing slashes. 122. 7/2/92 Fixed bug that caused 'string match ** ""' to return 0. 123. 7/2/92 Fixed bug in Tcl_CreateCmdBuf where it wasn't initializing the buffer to an empty string. 124. 7/6/92 Fixed bug in "case" command where it used NULL pattern string after errors in the "default" clause. 125. 7/25/92 Speeded up auto_load procedure: don't reread all the index files unless the path has changed. 126. 8/3/92 Changed tclUnix.h to define MAXPATHLEN from PATH_MAX, not _POSIX_PATH_MAX. ----------------- Released version 6.4, 8/7/92 ------------------ 127. 8/10/92 Changed tclBasic.c so that comment lines can be continued by putting a backslash before the newline. 128. 8/21/92 Modified "unknown" to allow the source-ing of a file for an auto-load to trigger other nested auto-loads, as long as there isn't any recursion on the same command name. 129. 8/25/92 Modified "format" command to allow " " and "+" flags, and allow flags in any order. 130. 9/14/92 Modified Tcl_ParseVar so that it doesn't actually attempt to look up the variable if "noEval" mode is in effect in the interpreter (it just parses the name). This avoids the errors that used to occur in statements like "expr {[info exists foo] && $foo}". 131. 9/14/92 Fixed bug in "uplevel" command where it didn't output the correct error message if a level was specified but no command. 132. 9/14/92 Renamed manual entries to have extensions like .3 and .n, and added "install" target to Makefile. 133. 9/18/92 Modified "unknown" command to emulate !!, !, and ^^ csh history substitutions. 134. 9/21/92 Made the config script cleverer about figuring out which switches to pass to "nm". 135. 9/23/92 Fixed tclVar.c to be sure to copy flags when growing variables. Used to forget about traces in progress and make extra recursive calls on trace procs. 136. 9/28/92 Fixed bug in auto_reset where it was unsetting variables that might not exist. 137. 10/7/92 Changed "parray" library procedure to print any array accessible to caller, local or global. 138. 10/15/92 Fixed bug where propagation of new environment variable values among interpreters took N! time if there exist N interpreters. 139. 10/16/92 Changed auto_reset procedure so that it also deletes any existing procedures that are in the auto_load index (the assumption is that they should be re-loaded to get the latest versions). 140. 10/21/92 Fixed bug that caused lists to be incorrectly generated for elements that contained backslash-newline sequences. 141. 12/9/92 Added support for TCL_LIBRARY environment variable: use it as library location if it's present. 142. 12/9/92 Added "info complete" command, Tcl_CommandComplete procedure. 143. 12/16/92 Changed the Makefile to check to make sure "config" has been run (can't run config directly from the Makefile because it modifies the Makefile; thus make has to be run again after running config). ----------------- Released version 6.5, 12/17/92 ------------------ 144. 12/21/92 Changed config to look in several places for libc file. 145. 12/23/92 Added "elseif" support to if. Also, "then", "else", and "elseif" may no longer be abbreviated. *** POTENTIAL INCOMPATIBILITY *** 146. 12/28/92 Changed "puts" and "read" to support initial "-nonewline" switch instead of additional "nonewline" argument. The old form is still supported, but it is discouraged and is no longer documented. Also changed "puts" to make the file argument default to stdout: e.g. "puts foo" will print foo on standard output. 147. 1/6/93 Fixed bug whereby backslash-newline wasn't working when typed interactively, or in "info complete". 148. 1/22/93 Fixed bugs in "lreplace" and "linsert" where close quotes were being lost from last element before replacement or insertion. 149. 1/29/93 Fixed bug in Tcl_AssembleCmd where it wasn't requiring a newline at the end of a line before considering a command to be complete. The bug caused some very long lines in script files to be processed as multiple separate commands. 150. 1/29/93 Various changes in Makefile to add more configuration options, simplify installation, fix bugs (e.g. don't use -f switch for cp), etc. 151. 1/29/93 Changed "name1" and "name2" identifiers to "part1" and "part2" to avoid name conflicts with stupid C++ implementations that use "name1" and "name2" in a reserved way. 152. 2/1/93 Added "putenv" procedure to replace the standard system version so that it will work correctly with Tcl's environment handling. ----------------- Released version 6.6, 2/5/93 ------------------ 153. 2/10/93 Fixed bugs in config script: missing "endif" in libc loop, and tried to use strncasecmp.c instead of strcasecmp.c. 154. 2/10/93 Makefile improvements: added RANLIB variable for easier Sys-V configuration, added SHELL variable for SGI systems. ----------------- Released version 6.7, 2/11/93 ------------------ 153. 2/6/93 Changes in backslash processing: - \Cx, \Mx, \CMx, \e sequences no longer special - \ also eats up any space after the newline, replacing the whole sequence with a single space character - Hex sequences like \x24 are now supported, along with ANSI C's \a. - "format" no longer does backslash processing on its format string - there is no longer any special meaning to a 0 return value from Tcl_Backslash - unknown backslash sequences, like (e.g. \*), are replaced with the following character (e.g. *), instead of just treating the backslash as an ordinary character. *** POTENTIAL INCOMPATIBILITY *** 154. 2/6/93 Updated all copyright notices. The meaning hasn't changed at all but the wording does a better job of protecting U.C. from liability (according to U.C. lawyers, anyway). 155. 2/6/93 Changed "regsub" so that it overwrites the result variable in all cases, even if there is no match. *** POTENTIAL INCOMPATIBILITY *** 156. 2/8/93 Added support for XPG3 %n$ conversion specifiers to "format" command. 157. 2/17/93 Fixed bug in Tcl_Eval where errors due to infinite recursion could result in core dumps. 158. 2/17/93 Improved the auto-load mechanism to deal gracefully (i.e. return an error) with a situation where a library file that supposedly defines a procedure doesn't actually define it. 159. 2/17/93 Renamed Tcl_UnixError procedure to Tcl_PosixError, and changed errorCode variable usage to use POSIX as keyword instead of UNIX. *** POTENTIAL INCOMPATIBILITY *** 160. 2/19/93 Changes to exec and process control: - Added support for >>, >&, >>&, |&, <@, >@, and >&@ forms of redirection. - When exec puts processes into background, it returns a list of their pids as result. - Added support for file, etc. (i.e. no space between ">" and file name. - Added -keepnewline option. - Deleted Tcl_Fork and Tcl_WaitPids procedures (just use fork and waitpid instead). - Added waitpid compatibility procedure for systems that don't have it. - Added Tcl_ReapDetachedProcs procedure. - Changed "exec" to return an error if there is stderr output, even if the command returns a 0 exit status (it's always been documented this way, but the implementation wasn't correct). - If a process returns a non-zero exit status but doesn't generate any diagnostic output, then Tcl generates an error message for it. *** POTENTIAL INCOMPATIBILITY *** 161. 2/25/93 Fixed two memory-management problems having to do with managing the old result during variable trace callbacks. 162. 3/1/93 Added dynamic string library: Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringFree, Tcl_DStringResult, etc. 163. 3/1/93 Modified glob command to only return the names of files that exist, and to only return names ending in "/" if the file is a directory. *** POTENTIAL INCOMPATIBILITY *** 164. 3/19/93 Modified not to use system calls like "read" directly, but instead to use special Tcl procedures that retry automatically if interrupted by signals. 165. 4/3/93 Eliminated "noSep" argument to Tcl_AppendElement, plus TCL_NO_SPACE flag for Tcl_SetVar and Tcl_SetVar2. *** POTENTIAL INCOMPATIBILITY *** 166. 4/3/93 Eliminated "flags" and "termPtr" arguments to Tcl_Eval. *** POTENTIAL INCOMPATIBILITY *** 167. 4/3/93 Changes to expressions: - The "expr" command now accepts multiple arguments, which are concatenated together with space separators. - Integers aren't automatically promoted to floating-point if they overflow the word size: errors are generated instead. - Tcl can now handle "NaN" and other special values if the underlying library procedures handle them. - When printing floating-point numbers, Tcl ensures that there is a "." or "e" in the number, so it can't be treated as an integer accidentally. The procedure Tcl_PrintDouble is available to provide this function in other contexts. Also, the variable "tcl_precision" can be used to set the precision for printing (must be a decimal number giving digits of precision). - Expressions now support transcendental and other functions, e.g. sin, acos, hypot, ceil, and round. Can add new math functions with Tcl_CreateMathFunc(). - Boolean expressions can now have any of the string values accepted by Tcl_GetBoolean, such as "yes" or "no". *** POTENTIAL INCOMPATIBILITY *** 168. 4/5/93 Changed Tcl_UnsetVar and Tcl_UnsetVar2 to return TCL_OK or TCL_ERROR instead of 0 or -1. *** POTENTIAL INCOMPATIBILITY *** 169. 4/5/93 Eliminated Tcl_CmdBuf structure and associated procedures; can use Tcl_DStrings instead. *** POTENTIAL INCOMPATIBILITY *** 170. 4/8/93 Changed interface to Tcl_TildeSubst to use a dynamic string for buffer space. This makes the procedure re-entrant and thread-safe, whereas it wasn't before. *** POTENTIAL INCOMPATIBILITY *** 171. 4/14/93 Eliminated tclHash.h, and moved everything from it to tcl.h *** POTENTIAL INCOMPATIBILITY *** 172. 4/15/93 Eliminated Tcl_InitHistory, made "history" command always be part of interpreter. *** POTENTIAL INCOMPATIBILITY *** 173. 4/16/93 Modified "file" command so that "readable" option always exists, even on machines that don't support symbolic links (always returns same error as if the file wasn't a symbolic link). 174. 4/26/93 Fixed bugs in "regsub" where ^ patterns didn't get handled right (pretended not to match when it really did, and looped infinitely if -all was specified). 175. 4/29/93 Various improvements in the handling of variables: - Can create variables and array elements during a read trace. - Can delete variables during traces (note: unset traces will be invoked when this happens). - Can upvar to array elements. - Can retarget an upvar to another variable by re-issuing the upvar command with a different "other" variable. 176. 5/3/93 Added Tcl_GetCommandInfo, which returns info about a Tcl command such as whether it exists and its ClientData. Also added Tcl_SetCommandInfo, which allows any of this information to be modified and also allows a command's delete procedure to have a different ClientData value than its command procedure. 177. 5/5/93 Added Tcl_RegExpMatch procedure. 178. 5/6/93 Fixed bug in "scan" where it didn't properly handle %% conversion specifiers. Also changed "scan" to use Tcl_PrintDouble for printing real values. 179. 5/7/93 Added "-exact", "-glob", and "-regexp" options to "lsearch" command to allow different kinds of pattern matching. 180. 5/7/93 Added many new switches to "lsort" to control the sorting process: "-ascii", "-integer", "-real", "-command", "-increasing", and "-decreasing". 181. 5/10/93 Changes to file I/O: - Modified "open" command to support a list of POSIX access flags like {WRONLY CREAT TRUNC} in addition to current fopen-style access modes. Also added "permissions" argument to set permissions of newly-created files. - Fixed Scott Bolte's bug (can close stdin etc. in application and then re-open them with Tcl commands). - Exported access to Tcl's file table with new procedures Tcl_EnterFile and Tcl_GetOpenFile. 182. 5/15/93 Added new "pid" command, which can be used to retrieve either the current process id or a list of the process ids in a pipeline opened with "open |..." 183. 6/3/93 Changed to use GNU autoconfig for configuration instead of the home-brew "config" script. Also made many other configuration-related changes, such as using instead of explicitly declaring system calls in tclUnix.h. 184. 6/4/93 Fixed bug where core-dumps could occur if a procedure redefined itself (the memory for the procedure's body could get reallocated in the middle of evaluating the body); implemented simple reference count mechanism. 185. 6/5/93 Changed tclIndex file format in two ways: (a) it's now eval-ed instead of parsed, which makes it 3-4x faster; (b) the entries in auto_index are now commands to evaluate, which allows commands to be loaded in different ways such as dynamic-loading of C code. The old tclIndex file format is still supported. 186. 6/7/93 Eliminated tclTest program, added new "tclsh" program that is more like wish (allows script files to be invoked automatically using "#!/usr/local/bin/tclsh", makes arguments available to script, etc.). Added support for Tcl_AppInit plus default version; this allows new Tcl applications to be created without modifying the main program for tclsh. 187. 6/7/93 Fixed bug in TclWordEnd that kept backslash-newline from working correctly in some cases during interactive input. 188. 6/9/93 Added Tcl_LinkVar and related procedures, which automatically keep a Tcl variable in sync with a C variable. 189. 6/16/93 Increased maximum nesting depth from 100 to 1000. 190. 6/16/93 Modified "trace var" command so that error messages from within traces are returned properly as the result of the variable access, instead of the generic "access disallowed by trace command" message. 191. 6/16/93 Added Tcl_CallWhenDeleted to provide callbacks when an interpreter is deleted (same functionality as Tcl_WatchInterp, which used to exist in versions before 6.0). 193. 6/16/93 Added "-code" argument to "return" command; it's there primarily for completeness, so that procedures implementing control constructs can reflect exceptional conditions back to their callers. 194. 6/16/93 Split up Tcl.n to make separate manual entries for each Tcl command. Tcl.n now contains a summary of the language syntax. 195. 6/17/93 Added new "switch" command to replace "case": allows alternate forms of pattern matching (exact, glob, regexp), replaces pattern lists with single patterns (but you can use "-" bodies to share one body among several patterns), eliminates "in" noise word. "Case" command is now obsolete. 196. 6/17/93 Changed the "exec", "glob", "regexp", and "regsub" commands to include a "--" switch. All initial arguments starting with "-" are now treated as switches unless a "--" switch is present to end the list. *** POTENTIAL INCOMPATIBILITY *** 197. 6/17/93 Changed auto-exec so that the subprocess gets stdin, stdout, and stderr from the parent. This allows truly interactive sub-processes (e.g. vi) to be auto-exec'ed from a tcl shell command line. 198. 6/18/93 Added patchlevel.h, for use in coordinating future patch releases, and also added "info patchlevel" command to make the patch level available to Tcl scripts. 199. 6/19/93 Modified "glob" command so that a leading "//" in a name gets left as is (this is needed for systems like Apollos where "//" is the super-root; Tcl used to collapse the two slashes into a single slash). 200. 7/7/93 Added Tcl_SetRecursionLimit procedure so that the maximum allowable nesting depth can be controlled for an interpreter from C. ----------------- Released version 7.0 Beta 1, 7/9/93 ------------------ 201. 7/12/93 Modified Tcl_GetInt and tclExpr.c so that full-precision unsigned integers can be specified without overflow errors. 202. 7/12/93 Configuration changes: eliminate leading blank line in configure script; provide separate targets in Makefile for installing binary and non-binary information; check for size_t and a few other potentially missing typedefs; don't put tclAppInit.o into libtcl.a; better checks for matherr support. 203. 7/14/93 Changed tclExpr.c to check the termination pointer before errno after strtod calls, to avoid problems with some versions of strtod that set errno in unexpected ways. 204. 7/16/93 Changed "scan" command to be more ANSI-conformant: eliminated %F, %D, etc., added code to ignore "l", "h", and "L" modifiers but always convert %e, %f, and %g with implicit "l"; also added support for %u and %i. Also changed "format" command to eliminate %D, %U, %O, and add %i. *** POTENTIAL INCOMPATIBILITY *** 205. 7/17/93 Changed "uplevel" and "upvar" so that they can be used from global level to global level: this used to generate an error. 206. 7/19/93 Renamed "setenv", "putenv", and "unsetenv" procedures to avoid conflicts with system procedures with the same names. If you want Tcl's procedures to override the system procedures, do it in the Makefile (instructions are in the Makefile). *** POTENTIAL INCOMPATIBILITY *** ----------------- Released version 7.0 Beta 2, 7/21/93 ------------------ 207. 7/21/93 Fixed bug in tclVar.c where freed memory was accidentally used if a procedure returned an element of a local array. 208. 7/22/93 Fixed bug in "unknown" where it didn't properly handle errors occurring in the "auto_load" procedure, leaving its state inconsistent. 209. 7/23/93 Changed exec's ">2" redirection operator to "2>" for consistency with sh. This is incompatible with earlier beta releases of 7.0 but not with pre-7.0 releases, which didn't support either operator. 210. 7/28/93 Changed backslash-newline handling so that the resulting space character *is* treated as a word separator unless the backslash sequence is in quotes or braces. This is incompatible with 7.0b1 and 7.0b2 but is more compatible with pre-7.0 versions that the b1 and b2 releases were. 211. 7/28/93 Eliminated Tcl_LinkedVarWritable, added TCL_LINK_READ_ONLY to Tcl_LinkVar to accomplish same purpose. This change is incompatible with earlier beta releases, but not with releases before Tcl 7.0. 212. 7/29/93 Renamed regexp C functions so they won't clash with POSIX regexp functions that use the same name. 213. 8/3/93 Added "-errorinfo" and "-errorcode" options to "return" command: these allow for much better handling of the errorInfo and errorCode variables in some cases. 214. 8/12/93 Changed "expr" so that % always returns a remainder with the same sign as the divisor and absolute value smaller than the divisor. 215. 8/14/93 Turned off auto-exec in "unknown" unless the command was typed interactively. This means you must use "exec" when invoking subprocesses, unless it's a command that's typed interactively. *** POTENTIAL INCOMPATIBILITY *** 216. 8/14/93 Added support for tcl_prompt1 and tcl_prompt2 variables to tclMain.c: makes prompts user-settable. 217. 8/14/93 Added asynchronous handlers (Tcl_AsyncCreate etc.) so that signals can be taken cleanly by Tcl applications. 218. 8/16/93 Moved information about open files from the interpreter structure to global variables so that a file can be opened in one interpreter and read or written in another. 219. 8/16/93 Removed ENV_FLAGS from Makefile, so that there's no official support for overriding setenv, unsetenv, and putenv. 220. 8/20/93 Various configuration improvements: coerce chars to unsigned chars before using macros like isspace; source ~/.tclshrc file during initialization if it exists and program is running interactively; allow there to be directories in auto_path that don't exist or don't have tclIndex files (ignore them); added Tcl_Init procedure and changed Tcl_AppInit to call it. 221. 8/21/93 Fixed bug in expr where "+", "-", and " " were all getting treated as integers with value 0. 222. 8/26/93 Added "tcl_interactive" variable to tclsh. 223. 8/27/93 Added procedure Tcl_FilePermissions to return whether a given file can be read or written or both. Modified Tcl_EnterFile to take a permissions mask rather than separate read and write arguments. 224. 8/28/93 Fixed performance bug in "glob" command (unnecessary call to "access" for each file caused a 5-10x slow-down for big directories). ----------------- Released version 7.0 Beta 3, 8/28/93 ------------------ 225. 9/9/93 Renamed regexp.h to tclRegexp.h to avoid conflicts with system include file by same name. 226. 9/9/93 Added Tcl_DontCallWhenDeleted. 227. 9/16/93 Changed not to call exit C procedure directly; instead always invoke "exit" Tcl command so that application can redefine the command to do additional cleanup. 228. 9/17/93 Changed auto-exec to handle names that contain slashes (i.e. don't use PATH for them). 229. 9/23/93 Fixed bug in "read" and "gets" commands where they didn't clear EOF conditions. ----------------- Released version 7.0, 9/29/93 ------------------ 230. 10/7/93 "Scan" command wasn't properly aligning things in memory, so segmentation faults could arise under some circumstances. 231. 10/7/93 Fixed bug in Tcl_ConvertElement where it forgot to backslash leading curly brace when creating lists. 232. 10/7/93 Eliminated dependency of tclMain.c on tclInt.h and tclUnix.h, so that people can copy the file out of the Tcl source directory to make modified private versions. 233. 10/8/93 Fixed bug in auto-loader that reversed the priority order of entries in auto_path for new-style index files. Now things are back to the way they were before 3.0: first in auto_path is always highest priority. 234. 10/13/93 Fixed bug where Tcl_CommandComplete didn't recognize comments and treat them as such. Thus if you typed the line # { interactively, Tcl would think that the command wasn't complete and wait for more input before evaluating the script. 235. 10/14/93 Fixed bug where "regsub" didn't set the output variable if the input string was empty. 236. 10/23/93 Fixed bug where Tcl_CreatePipeline didn't close off enough file descriptors in child processes, causing children not to exit properly in some cases. 237. 10/28/93 Changed "list" and "concat" commands not to generate errors if given zero arguments, but instead to just return an empty string. ----------------- Released version 7.1, 11/4/93 ------------------ Note: there is no 7.2 release. It was flawed and was thus withdrawn shortly after it was released. 238. 11/10/93 TclMain.c didn't compile on some systems because of R_OK in call to "access". Changed to eliminate call to "access". ----------------- Released version 7.3, 11/26/93 ------------------ 239. 11/6/93 Modified "lindex", "linsert", "lrange", and "lreplace" so that "end" can be specified as an index. 240. 11/6/93 Modified "append" and "lappend" to allow only two words total (i.e., nothing to append) without generating an error. 241. 12/2/93 Changed to use EAGAIN as the errno for non-blocking I/O instead of EWOULDBLOCK: this should fix problem where non-blocking I/O didn't work correctly on System-V systems. 242. 12/22/93 Fixed bug in expressions where cancelled evaluation wasn't always working correctly (e.g. "set one 1; eval {1 || 1/$one}" failed with a divide by zero error). 243. 1/6/94 Changed TCL_VOLATILE definition from -1 to the address of a dummy procedure Tcl_Volatile, since -1 causes portability problems on some machines (e.g., Crays). 244. 2/4/94 Added support for unary plus. 245. 2/17/94 Changed Tcl_RecordAndEval and "history" command to call Tcl_GlobalEval instead of Tcl_Eval. Otherwise, invocation of these facilities in nested procedures can cause unwanted results. 246. 2/17/94 Fixed bug in tclExpr.c where an expression such as "expr {"12398712938788234-1298379" != ""}" triggers an integer overflow error for the number in quotes, even though it isn't really a proper integer anyway. 247. 2/19/94 Added new procedure Tcl_DStringGetResult to move result from interpreter to a dynamic string. 248. 2/19/94 Fixed bug in Tcl_DStringResult that caused it to overwrite the contents of a static result in some situations. This can cause bizarre errors such as variables suddenly having empty values. 249. 2/21/94 Fixed bug in Tcl_AppendElement, Tcl_DStringAppendElement, and the "lappend" command that caused improper omission of a separator space in some cases. For example, the script set x "abc{"; lappend x "def" used to return the result "abc{def" instead of "abc{ def". 250. 3/3/94 Tcl_ConvertElement was outputting empty elements as \0 if TCL_DONT_USE_BRACES was set. This depends on old pre-7.0 meaning of \0, which is no longer in effect, so it didn't really work. Changed to output empty elements as {} always. 251. 3/3/94 Renamed Tcl_DStringTrunc to Tcl_DStringSetLength and extended it so that it can be used to lengthen a string as well as shorten it. Tcl_DStringTrunc is defined as a macro for backward compatibility, but it is deprecated. 252. 3/3/94 Added Tcl_AllowExceptions procedure. 253. 3/13/94 Fixed bug in Tcl_FormatCmd that could cause "format" to mis-behave on 64-bit Big-Endian machines. 254. 3/13/94 Changed to use vfork instead of fork on systems where vfork exists. 255. 3/23/94 Fixed bug in expressions where ?: didn't associate right-to-left as they should. 256. 4/3/94 Fixed "exec" to flush any files used in >@ or >&@ redirection in exec, so that data buffered for them is written before any new data added by the subprocess. 257. 4/3/94 Added "subst" command. 258. 5/20/94 The tclsh main program is now called Tcl_Main; tclAppInit.c has a "main" procedure that calls Tcl_Main. This makes it easier to use Tcl with C++ programs, which need their own main programs, and it also allows an application to prefilter the argument list before calling Tcl_Main. *** POTENTIAL INCOMPATIBILITY *** 259. 6/6/94 Fixed bug in procedure returns where the errorInfo variable could get truncated if an unset trace was invoked as part of returning from the procedure. 260. 6/13/94 Added "wordstart" and "wordend" options to "string" command. 261. 6/27/94 Fixed bug in expressions where they didn't properly cancel the evaluation of math functions in &&, ||, and ?:. 262. 7/11/94 Incorrect boolean values, like "ogle", weren't being handled properly. 263. 7/15/94 Added Tcl_RegExpCompile, Tcl_RegExpExec, and Tcl_RegExpRange, which provide lower-level access to regular expression pattern matching. 264. 7/22/94 Fixed bug in "glob" command where "glob -nocomplain ~bad_user" would complain about a missing user. Now it doesn't complain anymore. 265. 8/4/94 Fixed bug with linked variables where they didn't behave correctly when accessed via upvars. 266. 8/17/94 Fixed bug in Tcl_EvalFile where it didn't clear interp->result. 267. 8/31/94 Modified "open" command so that errors in exec-ing subprocesses are returned by the open immediately, rather than being delayed until the "close" is executed. 268. 9/9/94 Modified "expr" command to generate errors for integer overflow (includes addition, subtraction, negation, multiplication, division). 269. 9/23/94 Modified "regsub" to return a count of the number of matches and replacements, rather than 0/1. 279. 10/4/94 Added new features to "array" command: - added "get" and "set" commands for easy conversion between arrays and lists. - added "exists" command to see if a variable is an array, changed "names" and "size" commands to treat a non-existent array (or scalar variable) just like an empty one. - added pattern option to "names" command. 280. 10/6/94 Modified Tcl_SetVar2 so that read traces on variables get called during append operations. 281. 10/20/94 Fixed bug in "read" command where reading from stdin required two control-D's to stop the reading. 282. 11/3/94 Changed "expr" command to use longs for division just like all other expr operators; it previously used ints for division. 283. 11/4/94 Fixed bugs in "unknown" procedure: it wasn't properly handling exception returns from commands that were executed after being auto-loaded. ----------------- Released version 7.4b1, 12/23/94 ------------------ 284. 12/26/94 Fixed "install" target in Makefile (couldn't always find install program). 285. 12/26/94 Added strcncasecmp procedure to compat directory. 286. 1/3/95 Fixed all procedure calls to explicitly cast arguments: implicit conversions from prototypes (especially integer->double) don't work when compiling under non-ANSI compilers. Tcl is now clean under gcc -Wconversion. 287. 1/4/95 Fixed problem in Tcl_ArrayCmd where same name was used for both a label and a variable; caused problems on several older compilers, making array command misbehave and causing many errors in Tcl test suite. ----------------- Released version 7.4b2, 1/12/95 ------------------ 288. 2/9/95 Modified Tcl_CreateCommand to return a token, and added Tcl_GetCommandName procedure. Together, these procedures make it possible to track renames of a command. 289. 2/13/95 Fixed bug in expr where "089" was interpreted as a floating-point number rather than a bogus octal number. *** POTENTIAL INCOMPATIBILITY *** 290. 2/14/95 Added code to Tcl_GetInt and Tcl_GetDouble to check for overflows when reading in numbers. 291. 2/18/95 Changed "array set" to stop after first error, rather than continuing after error. 292. 2/20/95 Upgraded to use autoconf version 2.2. 293. 2/20/95 Fixed core dump that could occur in "scan" command if a close bracket was omitted. 294. 2/27/95 Changed Makefile to always use install-sh for installations: there's just too much variation among "install" system programs, which makes installation flakey. ----------------- Released version 7.4b3, 3/24/95 ------------------ 3/25/95 (bug fix) Changed "install" to "./install" in Makefile so that "make install" will work even when "." isn't in the search path. 3/29/95 (bug fix) Fixed bug where the auto-loading mechanism wasn't protecting the values of the errorCode and errorInfo variables. 3/29/95 (new feature) Added optional pattern argument to "parray" procedure. 3/29/95 (bug fix) Made the full functionality of "return -code ... -errorcode ..." work not just inside procedures, but also in sourced files and at top level. 4/6/95 (new feature) Added "pattern" option to "array names" command. 4/18/95 (bug fix) Fixed bug in parser where it didn't allow backslash-newline immediately after an argument in braces or quotes. 4/19/95 (new feature) Added tcl_library variable, which application can set to override default library directory. 4/30/95 (bug fix) During trace callbacks for array elements, the variable name used in the original reference would be temporarily modified to separate the array name and element name; if the trace callback used the same name string, it would get the wrong name (the array name without element). Fixed to restore the variable name before making trace callbacks. 4/30/95 (new feature) Added -nobackslashes, -nocommands, and -novariables switches to "subst" command. 5/4/95 (new feature) Added TCL_EVAL_GLOBAL flag to Tcl_RecordAndEval. 5/5/95 (bug fix) Format command would overrun memory when printing integers with very large precision, as in "format %.1000d 0". 5/5/95 (portability improvement) Changed to use BSDgettimeofday on IRIX machines, to avoid compilation problems with the gettimeofday declaration. 5/6/95 (bug fix) Changed manual entries to use the standard .TH macro instead of a custom .HS macro; the .HS macro confuses index generators like makewhatis. 5/9/95 (bug fix) Modified configure script to check for Solaris bug that makes vfork unreliable (core dumps result if vforked child changes a signal handler); will use fork instead of vfork if the bug is present. 6/5/95 (bug fix) Modified "lsort" command to disallow recursive calls to lsort from a comparison function. This is needed because qsort is not reentrant. 6/5/95 (bug fix) Undid change 243 above: changed TCL_VOLATILE and TCL_DYNAMIC back to integer constants rather than procedure addresses. This was needed because procedure addresses can have multiple values under some dynamic loading systems (e.g. SunOS 4.1 and Windows). 6/8/95 (feature change) Modified interface to Tcl_Main to pass in the address of the application-specific initialization procedure. Tcl_AppInit is no longer hardwired into Tcl_Main. This is needed in order to make Tcl a shared library. 6/8/95 (feature change) Modified Makefile so that the installed versions of tclsh and libtcl.a have version number in them (e.g. tclsh7.4 and libtcl7.4.a) and the library directory name also has an embedded version number (e.g., /usr/local/lib/tcl7.4). This should make it easier for Tcl 7.4 to coexist with earlier versions. ----------------- Released version 7.4b4, 6/16/95 ------------------ 6/19/95 (bug fix) Fixed bugs in tclCkalloc.c that caused core dumps if TCL_MEM_DEBUG was enabled on word-addressed machines such as Crays. 6/21/95 (feature removal) Removed overflow checks for integer arithmetic: they just cause too much trouble (e.g. for random number generators). 6/28/95 (new features) Added tcl_patchLevel and tcl_version variables, for consistency with Tk. 6/29/95 (bug fix) Fixed problem in Tcl_Eval where it didn't record the right termination character if a script ended with a comment. This caused erroneous output for the following command, among others: puts "[ expr 1+1 # duh! ]" 6/29/95 (message change) Changed the error message for ECHILD slightly to provide a hint about why the problem is occurring. ----------------- Released version 7.4, 7/1/95 ------------------ 7/18/95 (bug fix) Changed "lreplace" so that nothing is deleted if the last index is less than the first index or if the last index is < 0. 7/18/95 (bug fix) Fixed bugs with backslashes in comments: Tcl_CommandComplete (and "info complete") didn't properly handle strings ending in backslash-newline, and neither Tcl_CommandComplete nor the Tcl parser handled other backslash sequences right, such as two backslashes before a newline. 7/19/95 (bug fix) Modified Tcl_DeleteCommand to delete the hash table entry for the command before invoking its callback. This is needed in order to deal with reentrancy. 7/22/95 (bug fix) "exec" wasn't reaping processes correctly after certain errors (e.g. if the name of the executable was bogus, as in "exec foobar"). 7/27/95 (bug fix) Makefile.in wasn't using the LIBS variable provided by the "configure" script. This caused problems on some SCO systems. 7/27/95 (bug fix) The version of strtod in fixstrtod.c didn't properly handle the case where endPtr == NULL. ----------------- Released patch 7.4p1, 7/29/95 ----------------------- 8/4/95 (bug fix) C-level trace callbacks for variables were sometimes receiving the PART1_NOT_PARSED flag, which could cause errors in subsequent Tcl library calls using the flags. (JO) 8/4/95 (bug fix) Calls to toupper and tolower weren't using the UCHAR macros, which caused trouble in non-U.S. locales. (JO) 8/10/95 (new feature) Added the "load" command for dynamic loading of binary packages, and the Tcl_PackageInitProc prototype for package initialization procedures. (JO) 8/23/95 (new features) Added "info sharedlibextension" and "info nameofexecutable" commands, plus Tcl_FindExtension procedure. (JO) 8/25/95 (bug fix) If the target of an "upvar" was non-existent but had traces set, the traces were silently lost. Change to generate an error instead. (JO) 8/25/95 (bug fix) Undid change from 7/19, so that commands can stay around while their deletion callbacks execute. Added lots of code to handle all of the reentrancy problems that this opens up. (JO) 8/25/95 (bug fix) Fixed core dump that could occur in TclDeleteVars if there was an upvar from one entry in the table to the next entry in the same table. (JO) 8/28/95 (bug fix) Exec wasn't handling bad user names properly, as in "exec ~bogus_user/foo". (JO) 8/29/95 (bug fixes) Changed backslash-newline handling to correct two problems: - Only spaces and tabs following the backslash-newline are now absorbed as part of the backslash-newline. Newlinew are no longer absorbed (add another backslash if you want to absorb another newline). - TclWordEnd returns the character just before the backslash in the sequence as the end of the sequence; it used to not consider the backslash-newline as a word separator. (JO) 8/31/95 (new feature) Changed man page installation (with "mkLinks" script) to create additional links for manual pages corresponding to each of the procedure and command names described in the pages. (JO) 9/10/95 Reorganized Tcl sources for Windows and Mac ports. All sources are now in subdirectories: "generic" contains sources that work on all platforms, "windows", "mac", and "unix" directories contain platform- specific sources. Some UNIX sources are also used on other platforms. (SS) 9/10/95 (feature change) Eliminated exported global variables (they don't work with Windows DLLs). Replaced tcl_AsyncReady and tcl_FileCloseProc with procedures Tcl_AsyncReady() and Tcl_SetFileCloseProc(). Replaced C variable tcl_RcFileName with a Tcl variable tcl_rcFileName. (SS) *** POTENTIAL INCOMPATIBILITY *** 9/11/95 (new feature) Added procedure Tcl_SetPanicProc to override the default implementation of "panic". (SS) 9/11/95 (new feature) Added "interp" command to allow creation of new interpreters and execution of untrusted scripts. Added many new procedures, such as Tcl_CreateSlave, Tcl_CreateAlias,and Tcl_MakeSafe, to provide C-level access to the interpreter facility. This mechanism now provides almost all of the generic functions of Borenstein's and Rose's Safe-Tcl (but not any Tk or email-related stuff). (JL) 9/11/95 (feature change) Changed file management so that files are no longer shared between interpreters: a file cannot normally be referenced in one interpreter if it was opened in another. This feature is needed to support safe interpreters. Added Tcl_ShareHandle() procedure for allowing files to be shared, and added "interp" argument to Tcl_FilePermissions procedure. (JL) *** POTENTIAL INCOMPATIBILITY *** 9/11/95 (new feature) Added "AssocData" mechanism, whereby extensions can associate their own data with an interpreter and get called back when the interpreter is deleted. This is visible at C level via the procedures Tcl_SetAssocData and Tcl_GetAssocData. (JL) 9/11/95 (new feature) Added Tcl_ErrnoMsg to translate an errno value into a human-readable string. This is now used instead of calling strerror because strerror mesages vary dramatically from platform to platform, which messes up Tcl tests. Tcl_ErrnoMsg uses the standard POSIX messages for all the common signals, and calls strerror for signals it doesn't understand. ----------------- Released patch 7.4p2, 9/15/95 ----------------------- ----------------- Released 7.5a1, 9/15/95 ----------------------- 9/22/95 (bug fix) Changed auto_mkindex to create tclIndex files that handle directories whose paths might contain spaces. (RJ) 9/27/95 (bug fix) The "format" command didn't check for huge or negative width specifiers, which could cause core dumps. (JO) 9/27/95 (bug fix) Core dumps could occur if an interactive command typed to tclsh returned a very long result for tclsh to print out. The bug is actually in printf (in Solaris 2.3 and 2.4, at least); switched to use puts instead. (JO) 9/28/95 (bug fix) Changed makefile.bc to eliminate a false dependency for tcl1675.dll on the Borland run time library. (SS) 9/28/95 (bug fix) Fixed tcl75.dll so it looks for tcl1675.dll instead of tcl16.dll. (SS) 9/28/95 (bug fix) Tcl was not correctly detecting the difference between Win32s and Windows '95. (SS) 9/28/95 (bug fix) "exec" was not passing environment changes to child processes under Windows. (SS) 9/28/95 (bug fix) Changed Tcl to ensure that open files are not passed to child processes under Windows. (SS) 9/28/95 (bug fix) Fixed Windows '95 and NT versions of exec so it can handle both console and windows apps. (SS) 9/28/95 (bug fix) Fixed Windows version of exec so it no longer leaves temp files lying around. Also changed it so the temp files are created in the appropriate system dependent temp directory. (SS) 9/28/95 (bug fix) Eliminated source dependency on the Win32s Universal Thunk header file, since it is not bundled with VC++. (SS) 9/28/95 (bug fix) Under Windows, Tcl now constructs the HOME environment variable from HOMEPATH and HOMEDRIVE when HOME is not already set. (SS) 9/28/95 (bug fix) Added support for "info nameofexecutable" and "info sharedlibextension" to the Windows version. (SS) 9/28/95 (bug fix) Changed tclsh to correctly parse command line arguments so that backslashes are preserved under Windows. (SS) 9/29/95 (bug fix) Tcl 7.5a1 treated either return or newline as end of line in "gets", which caused lines ending in CRLF to be treated as two separate lines. Changed to allow only character as end-of-line: carriage return on Macs, newline elsewhere. (JO) 9/29/95 (new feature) Changed to install "configInfo" file in same directory as library scripts. It didn't used to get installed. (JO) 9/29/95 (bug fix) Tcl was not converting Win32 errors into POSIX errors under some circumstances. (SS) 10/2/95 (bug fix) Safe interpreters no longer get initialized with a call to Tcl_Init(). (JL) 10/1/95 (new feature) Added "tcl_platform" global variable to provide environment information such as the instruction set and operating system. (JO) 10/1/95 (bug fix) "exec" command wasn't always generating the "child process exited abnormally" message when it should have. (JO) 10/2/95 (bug fix) Changed "mkLinks.tcl" so that the scripts it generates won't create links that overwrite original manual entries (there was a problem where pack-old.n was overwriting pack.n). (JO) 10/2/95 (feature change) Changed to use -ldl for dynamic loading under Linux if it is available, but fall back to -ldld if it isn't. (JO) 10/2/95 (bug fix) File sharing was causing refcounts to reach 0 prematurely for stdin, stdout and stderr, under some circumstances. (JL) 10/2/95 (platform support) Added support for Visual C++ compiler on Windows, Windows '95 and Windows NT, code donated by Gordon Chaffee. (JL) 10/3/95 (bug fix) Tcl now frees any libraries that it loads before it exits. (SS) 10/03/95 (bug fix) Fixed bug in Macintosh ls command where the -l and -C options would fail in anything but the HOME directory. (RJ) ----------------- Released 7.5a2, 10/6/95 ----------------------- 10/10/95 (bug fix) "file dirnam /." was returning ":" on UNIX instead of "/". (JO) 10/13/95 (bug fix) Eliminated dependency on MKS toolkit for generating the tcl.def file from Borland object files. (SS) 10/17/95 (new features) Moved the event loop from Tcl to Tk, made major revisions along the way: - New Tcl commands: after, update, vwait (replaces "tkwait variable"). - "tkerror" is now replaced with "bgerror". - The following procedures are similar to their old Tk counterparts: Tcl_DoOneEvent, Tcl_Sleep, Tcl_DoWhenIdle, Tcl_CancelIdleCall, Tcl_CreateFileHandler, Tcl_DeleteFileHandler, Tcl_CreateTimerHandler, Tcl_DeleteTimerHandler, Tcl_BackgroundError. - Revised notifier, add new concept of "event source" with the following procedures: Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_WatchFile, Tcl_SetMaxBlockTime, Tcl_FileReady, Tcl_QueueEvent, Tcl_WaitForEvent. (JO) 10/31/95 (new features) Implemented cross platform file name support to make it easier to write cross platform scripts. Tcl now understands 4 file naming conventions: Windows (both DOS and UNC), Mac, Unix, and Network. The network convention is a new naming mechanism that can be used to paths in a platform independent fashion. See the "file" command manual page for more details. The primary interfaces changes are: - All Tcl commands that expect a file name now accept both network and native form. - Two new "file" subcommands, "nativename" and "networkname", provide a way to convert between network and native form. - Renamed Tcl_TildeSubst to Tcl_TranslateFileName, and changed it so that it always returns a filename in native form. Tcl_TildeSubst is defined as a macro for backward compatibility, but it is deprecated. (SS) 11/5/95 (new feature) Made "tkerror" and "bgerror" synonyms, so that either name can be used to manipulate the command (provides temporary backward compatibility for existing scripts that use tkerror). (JO) 11/5/95 (new feature) Added exit handlers and new C procedures Tcl_CreateExitHandler, Tcl_DeleteExitHandler, and Tcl_Exit. (JO) 11/6/95 (new feature) Added pid command for Macintosh version of Tcl (it didn't previously exist on the Mac). (RJ) 11/7/95 (new feature) New generic IO facility and support for IO to files, pipes and sockets based on a common buffering scheme. Support for asynchronous (non-blocking) IO and for event driver IO. Support for automatic (background) asynchronous flushing and asynchronous closing of channels. (JL) 11/7/95 (new feature) Added new commands "fconfigure" and "fblocked" to support new I/O features such as nonblocking I/O. Added "socket" command for creating TCP client and server sockets. (JL). 11/7/95 (new feature) Complete set of C APIs to the new generic IO facility: - Opening channels: Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_OpenTcpClient, Tcl_OpenTcpServer. - I/O procedures on channels, which roughly mirror the ANSI C stdio library: Tcl_Read, Tcl_Gets, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_Close, Tcl_Eof, Tcl_InputBlocked, Tcl_GetChannelOption, Tcl_SetChannelOption. - Extension mechanism for creating new kinds of channels: Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelFile, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_GetChannel. - Event-driven I/O on channels: Tcl_CreateChannelHandler, Tcl_DeleteChannelHandler. (JL) 11/7/95 (new feature) Channel driver interface specification to allow new types of channels to be added easily to Tcl. Currently being used in three drivers - for files, pipes and TCP-based sockets. (JL). 11/7/95 (new feature) interp delete now takes any number of path names of interpreters to delete, including zero. (JL). 11/8/95 (new feature) implemented 'info hostname' and Tcl_GetHostName command to get host name of machine on which the Tcl process is running. (JL) 11/9/95 (new feature) Implemented file APIs for access to low level files on each system. The APIs are: Tcl_CloseFile, Tcl_OpenFile, Tcl_ReadFile, Tcl_WriteFile and Tcl_SeekFile. Also implemented Tcl_WaitPid which waits in a system dependent manner for a child process. (JL) 11/9/95 (new feature) Added Tcl_UpdateLinkedVar procedure to force a Tcl variable to be updated after its C variable changes. (JO) 11/9/95 (bug fix) The glob command has been totally reimplemented so that it can support different file name conventions. It now handles Windows file names (both UNC and drive-relative) properly. It also supports nested braces correctly now. (SS) 11/13/95 (bug fix) Fixed Makefile.in so that configure can be run from a clean directory separate from the Tcl source tree, and compilations can be performed there. (JO) 11/14/95 (bug fix) Fixed file sharing between interpreters and file transferring between interpreters to correctly manage the refcount so that files are closed when the last reference to them is discarded. (JL) 11/14/95 (bug fix) Fixed gettimeofday implementation for the Macintosh. This fixes several timing related bugs. (RJ) 11/17/95 (new feature) Added missing support for info nameofexecutable on the Macintosh. (RJ) 11/17/95 (bug fix) The Tcl variables argc argv and argv0 now return something reasonable on the Mac. (RJ) 11/22/95 (new feature) Implemented "auto-detect" mode for end of line translations. On input, standalone "\r" mean MAC mode, standalone "\n" mean Unix mode and "\r\n" means Windows mode. On output, the mode is modified to whatever the platform specific mode for that platform is. (JL) 11/24/95 (feature change) Replaced "configInfo" file with tclConfig.sh, which is more complete and uses slightly different names. Also arranged for tclConfig.sh to be installed in the platform-specific library directory instead of Tcl's script library directory. (JO) *** POTENTIAL INCOMPATIBILITY with Tcl 7.5a2, but not with Tcl 7.4 *** ----------------- Released patch 7.4p3, 11/28/95 ----------------------- 12/5/95 (new feature) Added Tcl_File facility to support platform- independent file handles. Changed all interfaces that used Unix- style integer fd's to use Tcl_File's instead. (SS) *** POTENTIAL INCOMPATIBILITY *** 12/5/95 (new feature) Added a new "clock" command to Tcl. The command allows you to get the current "clicks" or seconds & allows you to format or scan human readable time/date strings. (RJ) 12/18/95 (new feature) Moved Tk_Preserve, Tk_Release, and Tk_EventuallyFree to Tcl, renamed to Tcl_Preserve, Tcl_Release, and Tcl_EventuallyFree. (JO) 12/18/95 (new feature) Added new "package" command and associated procedures Tcl_PkgRequire and Tcl_PkgProvide. Also wrote pkg_mkIndex library procedure to create index files from binaries and scripts. (JO) 12/20/95 (new feature) Added Tcl_WaitForFile procedure. (JO) 12/21/95 (new features) Made package name argument to "load" optional (Tcl will now attempt to guess the package name if necessary). Also added Tcl_StaticPackage and support in "load" for statically linked packages. (JO) 12/22/95 (new feature) Upgraded the foreach command to accept multiple loop variables and multiple value lists. This lets you iterate over multiple lists in parallel, and/or assign multiple loop variables from one value list during each iteration. The only potential compatibility problem is with scripts that used loop variables with a name that could be construed to be a list of variable names (i.e. contained spaces). (BW) 1/5/96 (new feature) Changed tclsh so it builds as a console mode application under Windows. Now tclsh can be used from the command line with pipes or interactively. Note that this only works under Windows 95 or NT. (SS) 1/17/96 (new feature) Modified Makefile and configure script to allow Tcl to be compiled as a shared library: use the --enable-shared option when configuing. (JO) 1/17/96 (removed obsolete features) Removed the procedures Tcl_EnterFile and Tcl_GetOpenFile: these no longer make sense with the new I/O system. (JL) *** POTENTIAL INCOMPATIBILITY *** 1/19/96 (bug fixes) Prevented formation of circular aliases, through the Tcl 'interp alias' command and through the 'rename' command, as well as through the C API Tcl_CreateAlias. (JL) 1/19/96 (bug fixes) Fixed several bugs in direct deletion of interpreters with Tcl_DeleteInterp when the interpreter is a slave; fixes based on a patch received from Viktor Dukhovni of ESM. (JL) 1/19/96 (new feature) Implemented on-close handlers for channels; added the C APIs Tcl_CreateCloseHandler and Tcl_DeleteCloseHandler. (JL) 1/19/96 (new feature) Implemented portable error reporting mechanism; added the C APIs Tcl_SetErrno and Tcl_GetErrno. (JL) 1/24/96 (bug fix) Unknown command processing properly invokes external commands under Windows NT and Windows '95 now. (SS) 1/23/96 (bug fix) Eliminated extremely long startup times under Windows '95. The problem was a result of the option database initialization code that concatenated $HOME with /.Xdefaults, resulting in a // in the middle of the file name. Under Windows '95, this is incorrectly interpreted as a UNC path. They delays came from the network timeouts needed to determine that the file name was invalid. Tcl_TranslateFileName now suppresses duplicate slashes that aren't at the beginning of the file name. (SS) 1/25/96 (bug fix) Changed exec and open to create children so they are attached to the application's console if it exists. (SS) 1/31/96 (bug fix) Fixed command line parsing to handle embedded spaces under Windows. (SS) ----------------- Released 7.5b1, 2/1/96 ----------------------- 2/7/96 (bug fix) Fixed off by one error in argument parsing code under Windows. (SS) 2/7/96 (bug fix) Fixed bugs in VC++ makefile that improperly initialized the tcl75.dll. Fixed bugs in Borland makefile that caused build failures under Windows NT. (SS) 2/9/96 (bug fix) Fixed deadlock problem in AUTO end of line translation mode which would cause a socket server with several concurrent clients writing in CRLF mode to hang. (JL) 2/9/96 (API change) Replaced -linemode option to fconfigure with a new -buffering option, added "none" setting to enable immediate write. (JL) *** INCOMPATIBILITY with b1 *** 2/9/96 (new feature) Added C API Tcl_InputBuffered which returns the count of bytes currently buffered in the input buffer of a channel, and o for output only channels. (JL) 2/9/96 (new feature) Implemented asynchronous connect for sockets. (JL) 2/9/96 (new feature) Added C API Tcl_SetDefaultTranslation to set (per channel) the default end of line translation mode. This is the mode that will be installed if an output operation is done on the channel while it is still in AUTO mode. (JL) 2/9/96 (bug fix) Changed Tcl_OpenCommandChannel interface to properly handle all of the combinations of stdio inheritance in background pipelines. See the Tcl_OpenFileChannel(3) man page for more info. This change fixes the bug where exec of a background pipeline was not getting passed the stdio handles properly. (SS) 2/9/96 (bug fix) Removed the new Tcl_CreatePipeline interface, and restored the old version for Unix platforms only. All new code should use Tcl_CreateCommandChannel instead. (SS) 2/9/96 (bug fix) Changed Makefile.in to use -L and -ltcl7.5 for Tcl library so that shared libraries are more likely to be found correctly on more platforms. (JO) 2/13/96 (new feature) Added C API Tcl_SetNotifierData and Tcl_GetNotifierData to allow notifier and channel driver writers to associate data with a Tcl_File. The result of this change is that Tcl_GetFileInfo now always returns an OS file handle, and Tcl_GetFile can be used to construct a Tcl_File for an externally constructed OS handle. (SS) 2/13/96 (bug fix) Changed Windows socket implementation so it doesn't set SO_REUSEADDR on server sockets. Now attempts to create a server socket on a port that is already in use will be properly identified and an error will be generated. (SS) 2/13/96 (bug fix) Fixed problems with DLL initialization under Visual C++ that left the C run time library uninitialized. (SS) 2/13/96 (bug fix) Fixed Windows socket initialization so it loads winsock the first time it is used, rather than at the time tcl75.dll is loaded. This should fix the bug where the modem immediately starts trying to connect to a service provider when wish or tclsh are started. (SS) 2/13/96 (new feature) Added C APIs Tcl_MakeFileChannel and Tcl_MakeTcpClientChannel to wrap up existing fds and sockets into channels. Provided implementations on Unix and Windows. (JL) 2/13/96 (bug fix) Fixed bug with seek leaving EOF and BLOCKING set. (JL) 2/14/96 (bug fix) Fixed reentrancy problem in fileevent handling and made it more robust in the face of errors. (JL) 2/14/96 (feature change) Made generic IO level emulate blocking mode if the channel driver is unable to provide it, e.g. if the low level device is always nonblocking. Thus, now blocking behavior is an advisory setting for channel drivers and can be ignored safely if the channel driver is unable to provide it. (JL) 2/15/96 (new feature) Added "binary" end of line translation mode, which is a synonym of "lf" mode. (JL) 2/15/96 (bug fix) Fixed reentrancy problem in fileevent handling vs deletion of channel event handlers. (JL) 2/15/96 (bug fix) Fixed bug in event handling which would cause a nonblocking channel to not see further readable events after the first readable event that had insufficient input. (JL) 2/17/96 (bug fix) "info complete" didn't properly handle comments in nested commands. (JO) 2/21/96 (bug fix) "exec" under Windows NT/95 did not properly handle very long command lines (>200 chars). (SS) 2/21/96 (bug fix) Sockets could get into an infinite loop if a read event arrived after all of the available data had been read. (SS) 2/22/96 (bug fix) Added cast of st_size elements to (long) before sprintf-ing in "file size" command. This is needed to handle systems like NetBSD with 64-bit file offsets. (JO) ----------------- Released 7.5b2, 2/23/96 ----------------------- 2/23/96 (bug fix) TCL_VARARGS macro in tcl.h wasn't defined properly when compiling with C++. (JO) 2/24/96 (bug fix) Removed dependencies on Makefile in the UNIX Makefile: this caused problems on some platforms (like Linux?). (JO) 2/24/96 (bug fix) Fixed configuration bug that made Tcl not compile correctly on Linux machines with neither -ldl or -ldld. (JO) 2/24/96 (new feature) Added a block of comments and definitions to Makefile.in to make it easier to have Tcl's TclSetEnv etc. replace the library procedures setenv etc, so that calls to setenv etc. in the application automatically update the Tcl "env" variable. (JO) 2/27/96 (feature change) Added optional Tcl_Interp * argument (may be NULL) to C API Tcl_Close and simplified closing of command channels. (JL) *** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** 2/27/96 (feature change) Added optional Tcl_Interp * argument (may be NULL) to C type definition Tcl_DriverCloseProc; modified all channel drivers to implement close procedures that accept the additional argument. (JL) *** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** 2/28/96 (bug fix) Fixed memory leak that could occur if an upvar referred to an element of an array in the same stack frame as the upvar. (JO) 2/29/96 (feature change) Modified both Tcl_DoOneEvent and Tcl_WaitForEvent so that they return immediately in cases where they would otherwise block forever (e.g. if there are no event handlers of any sort). (JO) 2/29/96 (new feature) Added C APIs Tcl_GetChannelBufferSize and Tcl_SetChannelBufferSize to set and retrieve the size, in bytes, for buffers allocated to store input or output in a channel. (JL) 2/29/96 (new feature) Added option -buffersize to Tcl fconfigure command to allow Tcl scripts to query and set the size of channel buffers. (JL) 2/29/96 (feature removed) Removed channel driver function to specify the buffer size to use when allocating a buffer. Removed the C typedef for Tcl_DriverBufferSizeProc. Channels are now created with a default buffer size of 4K. (JL) *** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** 2/29/96 (feature change) The channel driver function for setting blocking mode on the device may now be NULL. If the generic code detects that the function is NULL, operations that set the blocking mode on the channel simply succeed. (JL) 3/2/96 (bug fix) Fixed core dump that could occur if a syntax error (such as missing close paren) occurred in an array reference with a very long array name. (JO) 3/4/96 (bug fix) Removed code in the "auto_load" procedure that deletes all existing auto-load information whenever the "auto_path" variable is changed. Instead, new information adds to what was already there. Otherwise, changing the "auto_path" variable causes all package- related information to be lost. If you really want to get rid of existing auto-load information, use auto_reset before setting auto_path. (JO) 3/5/96 (new feature) Added version suffix to shared library names so that Tcl will compile under NetBSD and FreeBSD (I hope). (JO) 3/6/96 (bug fix) Cleaned up error messages in new I/O system to correspond more closely to old I/O system. (JO) 3/6/96 (new feature) Added -myaddr and -myport options to the socket command, removed -tcp and -- options. This lets clients and servers choose a particular interface. Also changed the default server address from the hostname to INADDR_ANY. The server accept callback now gets passed the client's port as well as IP address. The C interfaces for Tcl_OpenTcpClient and Tcl_OpenTcpServer have changed to support the above changes. (BW) *** POTENTIAL INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** 3/6/96 (changed feature) The library function auto_mkindex will now default to using the pattern "*.tcl" if no pattern is given. (RJ) 3/6/96 (bug fix) The socket channel code for the Macintosh has been rewritten to use native MacTcp. (RJ) 3/7/96 (new feature) Added Tcl_SetStdChannel and Tcl_GetStdChannel interfaces to allow applications to explicitly set and get the global standard channels. (SS) 3/7/96 (bug fix) Tcl did close not the file descriptors associated with "stdout", etc. when the corresponding channels were closed. (SS) 3/7/96 (bug fix) Reworked shared library and dynamic loading stuff to try to get it working under AIX. Added new @SHLIB_LD_LIBS@ autoconf symbol as part of this. AIX probably doesn't work yet, but it should be a lot closer. (JO) 3/7/96 (feature change) Added Tcl_ChannelProc typedef and changed the signature of Tcl_CreateChannelHandler and Tcl_DeleteChannelHandler to take Tcl_ChannelProc arguments instead of Tcl_FileProc arguments. This change should not affect any code outside Tcl because the signatures of Tcl_ChannelProc and Tcl_FileProc are compatible. (JL) 3/7/96 (API change) Modified signature of Tcl_GetChannelOption to return an int instead of char *, and to take a Tcl_DString * argument. Modified the implementation so that the option name can be NULL, to mean that the call should retrieve a list of alternating option names and values. (JL) *** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** 3/7/96 (API change) Added Tcl_DriverSetOptionProc, Tcl_DriverGetOptionProc typedefs, added two slots setOptionProc and getOptionProc to the channel type structure. These may be NULL to indicate that the channel type does not support any options. (JL) *** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** 3/7/96 (feature change) stdin, stdout and stderr can now be put into nonblocking mode. (JL) 3/8/96 (feature change) Eliminated dependence on the registry for finding the Tcl library files. (SS) ----------------- Released 7.5b3, 3/8/96 ----------------------- 3/12/96 (feature improvement) Modified startup script to look in several different places for the Tcl library directory. This should allow Tcl to find the libraries under all but the weirdest conditions, even without the TCL_LIBRARY environment variable being set. (JO) 3/13/96 (bug fix) Eliminated use of the "linger" option from the Windows socket implementation. (JL) 3/13/96 (new feature) Added -peername and -sockname options for fconfigure for socket channels. Code contributed by John Haxby of HP. (JL) 3/13/96 (bug fix) Fixed panic and core dump that would occur if the accept callback script on a server socket encountered an error. (JL) 3/13/96 (feature change) Added -async option to the Tcl socket command. If the command is creating a client socket and the flag is present, the client is connected asynchronously. If the option is absent (the default), the client socket is connected synchronously, and the command returns only when the connection has been completed or failed. This change was suggested by Mark Diekhans. (JL) 3/13/96 (feature change) Modified the signature of Tcl_OpenTcpClient to take an additional int argument, async. If nonzero, the client is connected to the server asynchronously. If the value is zero, the connection is made synchronously, and the call to Tcl_OpenTcpClient returns only when the connection fails or succeeds. This change was suggested by Mark Diekhans. (JL) *** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 *** 3/14/96 (bug fix) "tclsh bogus_file_name" didn't print an error message. (JO) 3/14/96 (bug fix) Added new procedures to tclCkalloc.c so that libraries and applications can be compiled with TCL_MEM_DEBUG even if Tcl isn't (however, the converse is still not true). Patches provided by Jan Nijtmans. (JO) 3/15/96 (bug fix) Marked standard IO handles of a process as close-on-exec to fix bug in Ultrix where exec was not sharing standard IO handles with subprocesses. Fix suggested by Mark Diekhans. (JL) 3/15/96 (bug fix) Fixed asynchronous close mechanism so that it closes the channel instead of leaking system resources. The manifestation was that Tcl would eventually run out of file descriptors if it was handling a large number of nonblocking sockets or pipes with high congestion. (JL) 3/15/96 (bug fix) Fixed tests so that they no longer leak file descriptors. The manifestation was that Tcl would eventually run out of file descriptors if the tests were rerun many times (> a hundred times on Solaris). (JL) 3/15/96 (bug fix) Fixed channel creation code so that it never creates unnamed channels. This would cause a panic and core dump when the channel was closed. (JL) 3/16/96 (bug fixes) Made lots of changes in configuration stuff to get Tcl working under AIX (finally). Tcl should now support the "load" command under AIX and should work either with or without shared libraries for Tcl and Tk. (JO) 3/21/96 (configuration improvement) Changed configure script so it doesn't use version numbers (as in -ltcl7.5 and libtcl7.5.so) under SunOS 4.1, where they don't work anyway. (JO) 3/22/96 (new feature) Added C API Tcl_InterpDeleted that allows extension writers to discover when an interpreter is being deleted. (JL) 3/22/96 (bug fix) The standard IO channels are now added to each trusted interpreter as soon as the interpreter is created. This ensures against the bug where a child would do IO before the master had done any, and then the child is destroyed - the standard IO channels would be then closed and the master would be unable to do any IO. (JL) 3/22/96 (bug fix) Made Tcl more robust against interpreter deletion, by using Tcl_Preserve, Tcl_Release and Tcl_EventuallyFree to split the process of interpreter deletion into two distinct phases. Also went through all of Tcl and added calls to Tcl_Preserve and Tcl_Delete where needed. (JL) 3/22/96 (bug fix) Fixed several places where C code was reading and writing into freed memory, especially during interpreter deletion. (JL) 3/22/96 (bug fix) Fixed very deep bug in Tcl_Release that caused memory to be freed twice if the release callback did Tcl_Preserve and Tcl_Release on the same memory as the chunk currently being freed. (JL) 3/22/96 (bug fix) Removed several memory leaks that would cause memory buildup on half-K chunks in the generic IO level. (JL) 3/22/96 (bug fix) Fixed several core dumps which occurred when new AssocData was being created during the cleanups in interpreter deletion. The solution implemented now is to loop repeatedly over the AssocData until none is left to clean up. (JL) 3/22/96 (bug fix) Fixed a bug in event handling which caused an infinite loop if there were no files being watched and no timer. Fix suggested by Jan Nijtmans. (JL) 3/22/96 (bug fix) Fixed Tcl_CreateCommand, Tcl_DeleteCommand to be more robust if the interpreter is being deleted. Also fixed several order dependency bugs in Tcl_DeleteCommand which kicked in when an interpreter was being deleted. (JL) 3/26/96 (bug fix) Upon a "short read", the generic code no longer calls the driver for more input. Doing this caused blocking on some platforms even on nonblocking channels. Bug and fix courtesy Mark Roseman. (JL) 3/26/96 (new feature) Added 'package Tcltest' which is present only in test versions of Tcl; this allows the testing commands to be loaded into new interpreters besides the main one. (JL) 3/26/96 (restored feature) Recreated the Tcl_GetOpenFile C API. You can now get a FILE * from a registered channel; Unix only. (JL) 3/27/96 (bug fix) The regular expression code did not support more than 9 subexpressions. It now supports up to 20. (SS) 4/1/96 (bug fixes) The CHANNEL_BLOCKED bit was being left on on a short read, so that fileevents wouldn't fire correctly. Bug reported by Mark Roseman.(JL, RJ) 4/1/96 (bug fix) Moved Tcl_Release to match Tcl_Preserve exactly, in tclInterp.c; previously interpreters were being freed only conditionally and sometimes not at all. (JL) 4/1/96 (bug fix) Fixed error reporting in slave interpreters when the error message was being generated directly by C code. Fix suggested by Viktor Dukhovni of ESM. (JL) 4/2/96 (bug fixes) Fixed a series of bugs in Windows sockets that caused events to variously get lost, to get sent multiple times, or to be ignored by the driver. The manifestation was blocking if the channel is blocking, and either getting EAGAIN or infinite loops if the channel is nonblocking. This series of bugs was found by Ian Wallis of Cisco. Now all tests (also those that were previously commented out) in socket.test pass. (JL, SS) 4/2/96 (feature change/bug fix) Eliminated network name support in favor of better native name support. Added "file split", "file join", and "file pathtype" commands. See the "file" man page for more details. (SS) *** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 *** 4/2/96 (bug fix) Changed implementation of auto_mkindex so tclIndex files will properly handle path names in a cross platform context. (SS) 4/5/96 (bug fix) Fixed Tcl_ReadCmd to use the channel buffer size as the chunk size it reads, instead of a fixed 4K size. Thus, on large reads, the user can set the channel buffer size to a large size and the read will occur orders of magnitude faster. For example, on a 2MB file, reading in 4K chunks took 34 seconds, while reading in 1MB chunks took 1.5 seconds (on a SS-20). Problem identified and fix suggested by John Haxby of HP. (JL) 4/5/96 (bug fix) Fixed socket creation code to invoke gethostbyname only if inet_addr failed (very unlikely). Before this change the order was reversed and this made things much slower than they needed to be (gethostbyname generally requires an RPC, which is slow). Problem identified and fix suggested by John Loverso of OSF. (JL) 4/9/96 (feature change) Modified "auto" translation mode so that it recognizes any of "\n", "\r" and "\r\n" in input as end of line, so that a file can have mixed end-of-line sequences. It now outputs the platform specific end of line sequence on each platform for files and pipes, and for sockets it produces crlf in output on all platforms. (JL) *** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 *** 4/11/96 (new feature) Added -eofchar option to Tcl_SetChannelOption to allow setting of an end of file character for input and output. If an input eof char is set, it is recognized as EOF and further input from the channel is not presented to the caller. If an output eof char is set, on output, that byte is appended to the channel when it is closed. On Unix and Macintosh, all channels start with no eof char set for input or output. On Windows, files and pipes start with input and output eof chars set to Crlt-Z (ascii 26), and sockets start with no input or output eof char. (JL) *** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 *** 4/17/96 (bug fix) Fixed series of bugs with handling of crlf sequence split across buffer boundaries in input, in AUTO mode. (JL, BW) 4/17/96 (test suite improvement) Fixed test suite so that tests that depend on the availability of Unix commands such as echo, cat and others are not run if these commands are not present. (JL) 4/17/96 (test suite improvement) The socket test now automatically starts, on platformst that support exec, a separate process for remote testsing. (JL) ----------------- Released 7.5, 4/21/96 ----------------------- 5/1/96 (bug fix) "file tail ~" did not correctly return the tail portion of the user's home directory. (SS) 5/1/96 (bug fix) Fixed bug in TclGetEnv where it didn't lookup environment variables correctly: could confuse "H" and "HOME", for example. (JO) 5/1/96 (bug fix) Changed to install tclConfig.sh under "make install-binaries", not "make install-libraries". (JO) 5/2/96 (bug fix) Changed pkg_mkIndex not to attempt to "load" a file unless it has the standard shared library extension. On SunOS, attempts to load Tcl scripts cause the whole application to be aborted (there's no way to get the error back into Tcl). (JO) 5/7/96 (bug fix) Moved initScript in tclUnixInit.c to writable memory to avoid potential core dumps. (JO) 5/7/96 (bug fix) Auto_reset procedure was removing procedure from init.tcl, such as pkg_mkIndex. (JO) 5/7/96 (bug fix) Fixed cast on socket address resolution code that would cause a failure to connect on Dec Alphas. (JL) 5/7/96 (bug fix) Added "time", "subst" and "fileevent" commands to set of commands available in a safe interpreter. (JL) 5/13/96 (bug fix) Preventing OS level handles for stdin, stdout and stderr from being implicitly closed when the last reference to the standard channel containing that handle is discarded when an interpreter is deleted. Explicitly closing standard channels by using "close" still works. (JL) 5/21/96 (bug fix) Do not create channels for stdin, stdout and stderr on Unix if the devices are closed. This prevents a duplicate channel name panic later on when the fd is used to open a channel and the channel is registered in an interpreter. (JL) 5/23/96 (bug fix) Fixed bug that prevented the use of standard channels in interpreters created after the last interpreter was destroyed. In the sequence interp = Tcl_CreateInterp(); Tcl_DeleteInterp(interp); interp = Tcl_CreateInterp(); channels for stdio would not be available in the second interpreter. (JL) 5/23/96 (bug fix) Fixed bug that allowed Tcl_MakeFileChannel to create new channels with Tcl_Files in them that are already used by another channel. This would cause core dumps when the Tcl_Files were being freed twice. (JL) 5/23/96 (bug fix) Fixed a logical timing bug that caused a standard channel to be removed from the standard channel table too early when the channel was being closed. If the channel was being flushed asynchronously, it could get recreated before being actually destroyed, and the recreated channel would contain the same Tcl_File as the one being closed, leading to dangling pointers and core dumps. (JL) 5/27/96 (bug fix) Fixed a bug in Tcl_GetChannelOption which caused it to always return a list of one element, a list of the settings, for -translation and -eofchar options. Now correctly returns the value described by the documentation (Mark Diekhans found this, thanks!). (JL) 5/30/96 (bug fix) Fixed a couple of syntax errors in io.test. (JL) 5/30/96 (bug fix) If a fileevent scripts gets an error, delete it before causing a background error. This is to allow the error handler to reinstall the fileevent and to prevent infinite loops if the event loop is reentered in the error handler. (JL) 5/31/96 (bug fix) Channels now will get properly flushed on exit. (JL) 6/5/96 (bug fix) Changed Tcl_Ckalloc, Tcl_Ckfree, and Tcl_Ckrealloc to Tcl_Alloc, Tcl_Free, and Tcl_Realloc. Added documentation for these routines now that they are officially supported. Extension writers should use these routines instead of free() and malloc(). (SS) 6/10/96 (bug fix) Changes the Tcl close command so that it no longer waits on nonblocking pipes for the piped processes to exit; instead it reaps them in the background. (JL) 6/11/96 (bug fix) Increased the length of the listen queue for server sockets on Unix from 5 to 100. Some OSes will disregard this and reset it to 5, but we should try to get as long a queue as we can, for performance reasons. (JL) 6/11/96 (bug fix) Fixed windows sockets bug that caused a cascade of events if the fileevent script read less than was available. Now reading less than is available does not cause a flood of Tcl events. (JL, SS) 6/11/96 (bug fix) Fixed bug in background flushing on closed channels that would prevent the last buffer from getting flushed. (JL) 6/13/96 (bug fix) Fixed bug in Windows sockets that caused a core dump if a DLL linked with tcl.dll and referred to e.g. ntohs() without opening a Tcl socket. The problem was that the indirection table was not being initialized. (JL) 6/13/96 (bug fix) Fixed OS level resource leak that would occur when a Tcl channel was still registered in some interpreter when the process exits. Previously the channel was not being closed and the OS level handles were not being released; the output was being flushed but the device was not being closed. Now the device is properly closed. This was only a problem on Win3.1 and MacOS. (JL, SS) 6/28/96 (bug fix) Fixed bug where transient errors were leaving an error code around, so that it would erroneously get reported later. This bug was exercised intermittently by closing a channel to a file on a very loaded NFS server, or to a socket whose other end blocked. (JL, BW) 7/3/96 (bug fix) Fileevents declared in an interpreter are now deleted when the channel is closed in that interpreter. Before this fix, the fileevent would hang around until the channel is completely closed, and would cause errors if events happened before the channel was closed. This could happen in two cases: first if the channel is shared between several interpreters, and second if an async flush is in progress that prevents the channel from being closed until the flush finishes. (JL) 7/10/96 (bug fix) Fixed bugs in both "lrange" and "lreplace" commands where too much white space was being removed. For example, the command lreplace {\}\ hello} end end was returning "\}\", losing the significant space in the first list element and corrupting the list. (JO) 7/20/96 (bug fix) The procedure pkg_mkIndex didn't work properly for extensions that depend on Tk, because it didn't load Tk into the child interpreter before loading the extension. Now it loads Tk if Tk is present in the parent. (JO) 7/23/96 (bug fix) Added compat version of strftime to fix crashes resulting from bad implementations under Windows. (SS) 7/23/96 (bug fix) Standard implementations of gmtime() and localtime() under Windows did not handle dates before 1970, so they were replaced with a revised implementation. (SS) 7/23/96 (bug fix) Tcl would crash on exit under Borland 5.0 because the global environ pointer was left pointing to freed memory. (SS) 7/29/96 (bug fix) Fixed memory leak in Tcl_LoadCmd that could occur if a package's AppInit procedure called Tcl_StaticPackage to register static packages. (JO) 8/1/96 (bug fix) Fixed a series of bugs in Windows sockets so that async writebehind in the presence of read event handlers now works, and so that async writebehind also works on sockets for which a read event handler was declared and whose channels were then closed before the async write finished. The bug was reported by John Loverso and Steven Wahl, independently, test case supplied by John Loverso. (JL) ----------------- Released patch 7.5p1, 8/2/96 ----------------------- 5/8/96 (new feature) Added Tcl_GetChannelMode C API for retrieving whether a channel is open for reading and writing. (JL) 5/8/96 (API changes) Revised C APIs for channel drivers: - Removed all Tcl_Files from channel driver interface; you can now have channels that are not based on Tcl_Files. - Added channelReadyProc and watchChannelProc procedures to interface; these are used to implement event notification for channels. - Added getFileProc to channel driver, to allow the generic IO code to retrieve a Tcl_File from a channel (presumably if the channel uses Tcl_Files they will be stored inside its instanceData). (JL) *** INCOMPATIBILITY with Tcl 7.5 *** 5/8/96 (API change) The Tcl_CreateChannel C API was modified to not take Tcl_File arguments, and instead to take a mask specifying whether the channel is readable and/or writable. (JL) *** INCOMPATIBILITY with Tcl 7.5 *** 6/3/96 (bug fix) Made Tcl_SetVar2 robust against the case where the value of the variable is a NULL pointer instead of "". (JL) 6/17/96 (bug fix) Fixed "reading uninitialized memory" error reported by Purify, in Tcl_Preserve/Tcl_Release. (JL) 8/9/96 (bug fix) Fixed bug in init.tcl that caused incorrect error message if the act of autoloading a procedure caused the procedure to be invoked again. (JO) 8/9/96 (bug fix) Configure script produced bad library names and extensions under SunOS and a few other platforms if the --disable-load switch was used. (JO) 8/9/96 (bug fix) Tcl_UpdateLinkedVar generated an error if the variable being updated was read-only. (JO) 8/14/96 (bug fix) The macintosh now supports synchronous socket connections. Other minor bugs were also fixed. (RJ) 8/15/96 (configuration improvement) Changed the file patchlevel.h to be tclPatch.h. This avoids conflict with the Tk file and is now in 8.3 format on the Windows platform. (RJ) 8/20/96 (bug fix) Fixed core dump in interp alias command for interpreters created with Tcl_CreateInterp (as opposed to with Tcl_CreateSlave). (JL) 8/20/96 (bug fix) No longer masking ECONNRESET on Windows sockets so that the higher level of the IO mechanism sees the error instead of entering an infinite loop. (JL) 8/20/96 (bug fix) Destroying the last interpreter no longer closes the standard channels. (JL) 8/20/96 (bug fix) Closing one of the stdin, stdout or stderr channels and then opening a new channel now correctly assigns the new channel as the standard channel that was closed. (JL) 8/20/96 (bug fix) Added code to unix/tclUnixChan.c for using ioctl with FIONBIO instead of fcntl with O_NONBLOCK, for those versions of Unix where either O_NONBLOCK is not supported or implemented incorrectly. (JL) 8/21/96 (bug fix) Fixed "file extension" so it correctly returns the extension on files like "foo..c" as "..c" instead of ".c". (SS) 8/22/96 (bug fix) If environ[] contains static strings, Tcl would core dump in TclSetupEnv because it was trying to write NULLs into the actual data in environ[]. Now we instead copy as appropriate. (JL) 8/22/96 (added impl) Added missing implementation of Tcl_MakeTcpClientChannel for Windows platform. Code contributed by Mark Diekhans. (JL) 8/22/96 (new feature) Added a new memory allocator for the Macintosh version of Tcl. It's quite a bit faster than MetroWerk's version. (RJ) 8/26/96 (documentation update) Removed old change bars (for all changes in Tcl 7.5 and earlier releases) from manual entries. (JO) 8/27/96 (enhancement) The exec and open commands behave better and work in more situations under Windows NT and Windows 95. Documentation describes what is still lacking. (CS) 8/27/96 (enhancement) The Windows makefiles will now compile even if the compiler is not in the path and/or the compiler's environment variables have not been set up. (CS) 8/27/96 (configuration improvement) The Windows resource files are automatically updated when the version/patch level changes. The header file now has a comment that reminds the user which other files must be manually updated when the version/patch level changes. (CS) 8/28/96 (new feature) Added file manipulation features (copy, rename, delete, mkdir) that are supported on all platforms. They are implemented as subcommands to the "file" command. See the documentation for the "file" command for more information. (JH) ----------------- Released 7.6b1, 8/30/96 ----------------------- 9/3/96 (bug fix) Simplified code so that standard channels are created lazily, they are added to an interpreter lazily, and they are never added to a safe interpreter. (JL) 9/3/96 (bug fix) Closing a channel after closing a standard channel, e.g. stdout, would cause the implicit recreation of that standard channel. (JL) 9/3/96 (new feature) Now calling Tcl_RegisterChannel with a NULL interpreter increments the refcount so that code outside any interpreter can use channels that are also registered in interpreters, without worrying that the channel may turn into a dangling pointer at any time. Calling Tcl_UnregisterChannel with a NULL interpreter only decrements the recount so that code outside any interpreter can safely declare it is no longer interested in a channel. (JL) 9/4/96 (new features) Two changes to dynamic loading: - If the file name is empty in the "load" command and there is no statically loaded version of the package, a dynamically loaded version will be used if there is one. - Tcl_StaticPackage ignores redundant calls for the same package. (JO) 9/6/96 (bug fix) Platform specific procedures for manipulating files are no longer macros and have been prefixed with "Tclp", such as TclpRenameFile. Unix file code now handles symbolic links and other special files correctly. The semantics of file copy and file rename has been changed so that if a target directory exists, the source files will NOT be merged with the existing files. (JH) 9/6/96 (bug fix) If standard channel is NULL, because Tcl cannot connect to the standard channel, do not increment the refcount. The channel can be NULL if there is for example no standard input. (JL) 9/6/96 (portability improvement) Changed parsing of backslash sequences like \n to translate directly to absolute values like 0xA instead of letting the compiler do the translation. This guarantees that the translation is done the same everywhere. (JO) 9/9/96 (bug fix) If channel is opened and not associated with any interpreter, but Tcl decides to use it as one of the standard channels, it became impossible to close the channel with Tcl_Close -- instead you had to call Tcl_UnregisterChannel. Fixed now so that it's safe to call Tcl_Close even when Tcl is using the channel as one of the standard ones. (JL) 9/11/96 (feature change) The Tcl library is now placed in the Tcl shared libraries resource. You no longer need to place the Tcl files in your applications explicitly. (RJ) 9/11/96 (feature change) Extensions no longer automatically have the resource fork of the extension opened for it. Instead you need to use the tclMacLibrary.c file in your extension. (RJ) *** POTENTIAL INCOMPATIBILITY *** 9/12/96 (bug fix) The extension loading mechanism on the Macintosh now looks at the 'cfrg' resource to determine where to load the code fragment from. This means FAT fragments should now work. (RJ) 9/18/96 (enhancement) The exec and open commands behave better and work in more situations under Windows 3.X. Documentation describes what is still lacking. (CS) 9/19/96 (bug fix) Fixed a panic which would occur if you delete a non-existent alias before any aliases are created. Now instead correctly returns an error that the alias is not found. (JL) 9/19/96 (bug fix) Slave interpreters could rename aliases and they would not get deleted when the alias was being redefined. This led to dangling pointers etc. (JL) 9/19/96 (bug fix) Fixed a panic where a hash table entry was being deleted twice during alias management operations. (JL) 9/19/96 (bug fix) Fixed bug in event loop that could cause the input focus in Tk to get confused during menu traversal, among other problems. The problem was related to handling of the "marker" when its event was deleted. (JO) 9/26/96 (bug fix) Windows was losing EOF on a socket if the FD_CLOSE event happened to precede any left over FD_READ events. Now correctly remembers seeing FD_CLOSE, so that trailing FD_READ events are not discarded if they do not contain any data. This allows Tcl to correctly get a zero read and notice EOF. (JL) 9/26/96 (bug fix) Was not resetting READABLE state properly on sockets under Windows if the driver discarded an FD_READ event because no data was present. Now correctly resets the state. (JL) 9/30/96 (bug fix) Made EOF sticky on Windows sockets, so that fileevent readable will fire repeatedly until the socket is closed. Previously the fileevent fired only once. This could lead to never-closed connections if the Tcl script in the fileevent wasn't closing the socket immediately. (JL) 10/2/96 (new feature) Improved the package loader: - Added new variable tcl_pkgPath, which holds the default directories under which packages are normally installed (each package goes in a separate subdirectory of a directory in $tcl_pkgPath). These directories are included in auto_path by default. - Changed the package auto-loader to look for pkgIndex.tcl files not only in the auto_path directories but also in their immediate children. This should make it easier to install and uninstall packages (don't have to change auto_path or merge pkgIndex.tcl files). (JO) 10/3/96 (bug fix) Changed tclsh to look for tclshrc.tcl instead of tclsh.rc on startup under Windows. This is more consistent with wish and uses the right extension. (SS) *** POTENTIAL INCOMPATIBILITY *** 10/8/96 (bug fix) Convertclock does not parse 24-hour times of the form "hhmm" correctly when hour = 00. In the parse code, hour must be >= 100 for minutes to be non-zero. Thanks to Lint LaCour for this bug fix. (RJ) 10/11/96 (bug fix) Under Windows, the pid command returned the process handle instead of the process id. (SS) ----------------- Released 7.6, 10/16/96 ----------------------- 10/29/96 (bug fix) Under Windows, sockets would consume 100% CPU time after the first accept(), due to a typo. (JL) 10/29/96 (bug fix) Incorrect refcount management caused standard channels not to get deleted at process exit or DLL unload time, causing a memory leak of upwards of 20K each time. (JL) 11/7/96 (bug fix) Auto-exec didn't work on file names that contained spaces. (JO) 11/8/96 (bug fix) Fixed core dump that would occur if more than one call to Tcl_DeleteChannelHandler was made to delete a given channel handler. (JL) 11/8/96 (bug fix) Fixed test for return value in Tcl_Seek and Tcl_SeekCmd to only treat -1 as error, instead of all negative numbers. (JL) 11/12/96 (bug fix) Do not blocking waiting for processes at the end of a pipe during exit cleanup. (JL) 11/12/96 (bug fix) If we are in exit cleanup, do not close the system level file descriptors 0, 1 and 2. Previously they were being closed which is incorrect, in the embedded case. This led to weird behavior for programs that want to interpose on I/O through the standard file descriptors (e.g. Netscape Navigator). (JL) 11/15/96 (bug fix) Fixed core dump on Windows sockets due to dependency on deletion order at exit. Now all socket functions check to see if sockets are (still) initialized, before calling through function pointers. Before, they would call and might end up calling unloaded object code. (JL) 11/15/96 (bug fix) Fixed core dump in Windows socket initialization routine if sockets were not installed on the system. Before, it was not properly checking the result of attempting to load the socket DLL, so it would call through uninitialized function pointers. (JL) 11/15/96 (bug fix) Fixed memory leak in Windows sockets which left socket DLL handle open and could hold the socket DLL in memory uneccessarily, until a reboot. (JL) 12/4/96 (bug fix) Fixed bug in Macintosh socket code that could result in lost data if a client was closed too soon after sending data. (RJ) 12/17/96 (bug fix) Fixed deadlock bug in Windows sockets due to losing an event. This was happening because of an interaction between buffering and nonblocking mode on sockets. Now switched to sockets being blocking by default, so we are also no longer emulating blocking through a private event loop. (JL) 1/21/97 (performance bug fix) Client TCP connections were slow to create because getservbyname was always called on the port. Now this is only done if Tcl_GetInt fails. (BW) 1/21/97 (configuration fix) Made it possible to override TCL_PACKAGE_PATH during make. Previously it was only set during autoconf process. 1/29/97 (bug fix) Fixed some problems with the clock command that impacted how dates were scaned after the year 2000. (RJ) ----------------- Released 7.6p2, 1/31/97 ----------------------- 2/5/97 (bug fix) Fixed a bug where in CR-LF translation mode, \r bytes in the input stream were not being handled correctly. (JL) 2/24/97 (bug fix) Fix bug with exec under Win32s not being able to create stderr file which caused all execs to fail. Fixed temp file leak under Win32s. Fixed optional parameter bug with SearchPath that only happened under Win32s 1.25. (CCS) ---------------------------------------------------------- Changes for Tcl 7.6 go above this line. Changes for Tcl 7.7 go below this line. ---------------------------------------------------------- 5/8/96 (new feature) Added Tcl_Ungets C API for putting a sequence of bytes into a channel's input buffer. This can be used for "push" model channels where the input is obtained via callbacks instead of by request of the generic IO code. No Tcl procedure yet. (JL) 11/15/96 (new feature) Implemented hidden commands. New C APIs: Tcl_HideCommand -- hides an existing exposed command. Tcl_ExposeCommand -- exposes an existing hidden command. New tcl APIs: interp invokehidden -- invokes a hidden command in a slave. interp hide -- hides an existing exposed command. interp expose -- exposes an existing hidden command. interp hidden -- returns a list of hidden commands. The implementation of Safe Tcl now uses the new hidden commands facility to implement the safe base, instead of deleting the commands from a safe interpreter. (JL) 11/15/96 (new feature) Implemented the safe base, a mechanism for installing and requesting security policies, purely in Tcl code. Overloads the package command to also allow an interpreter to "require" a policy. The following new library commands are provided: tcl_safeCreateInterp -- creates a slave an initializes the policy mechanism. tcl_safeInitInterp -- initializes an existing slave with the policy mechanism. tcl_safeDeleteInterp -- deletes a slave and deinitializes the policy mechanism. Added a new file to the library, safeinit.tcl, to hold implementation. (JL) On 7/9/97, removed the policy loading mechanism from the Safe Base. Left only the Safe Base aliases dealing with auto-loading and source. (JL) 12/6/96 (new feature) Implemented Tcl_Finalize, an API that should be called by a process when it is done using Tcl. This API runs all the exit handlers to allow them to clean up resources etc. (JL) 12/17/96 (new feature) Add an http Tcl script package to the Tcl library. This package implements the client side of HTTP/1.0; the GET, HEAD, and POST requests. (BW) 1/21/97 (new feature) Added a "marktrusted" subcommand to the "interp" and to the interpreter object command. It removes the "safe" mark on an interpreter and disables hard-wired checks for safety in the C sources. (JL) 1/21/97 (removed feature) Removed "vwait" from set of commands available in a safe interpreter. (JL) 2/11/97 (new feature, bug fix) http package. Added -accept to http_config so you can set the Accept header. Added -handler option to http_get so you can supply your own data handler. Also fixed POST operation to set the correct MIME type on the request. (BW) ---------------------------------------------------------- Changes for Tcl 7.7 go above this line. Changes for Tcl 8.0 go below this line. ---------------------------------------------------------- 9/17/96 (bug fix) Using "upvar" it was possible to turn an array element into an array itself. Changed to disallow this; it was quirky and didn't really work correctly anyway. (JO) 10/21/96 (new feature) The core of the Tcl interpreter has been replaced with an on-the-fly compiler that translates Tcl scripts to bytecoded instructions; a new interpreter then executes the bytecodes. The compiler introduces only a few minor changes at the level of Tcl scripts. The biggest changes are to expressions and lists. - A second level of substitutions is no longer done for expressions. This substantially improves their execution time. This means that the expression "$x*4" produces a different result than in the past if x is "$y+2". Fortunately, not much code depends on the old two-level semantics. Some expressions that do, such as "expr [join $list +]" can be recoded to work in Tcl8.0 by adding an eval: e.g., "eval expr [join $list +]". - Lists are now completely parsed on the first list operation to create a faster internal representation. In the past, if you had a misformed list but the erroneous part was after the point you inserted or extracted an element, then you never saw an error. In Tcl8.0 an error will be reported. This should only effect incorrect programs that took advantage of behavior of the old implementation that was not documented in the man pages. Other changes to Tcl scripts are discussed in the web page at http://www.scriptics.com/doc/compiler.html. (BL) *** POTENTIAL INCOMPATIBILITY *** 10/21/96 (new feature) In earlier versions of Tcl, strings were used as a universal representation; in Tcl 8.0 strings are replaced with Tcl_Obj structures ("objects") that can hold both a string value and an internal form such as a binary integer or compiled bytecodes. The new objects make it possible to store information in efficient internal forms and avoid the constant translations to and from strings that occurred with the old interpreter. There are new many new C APIs for managing objects. Some of the new library procedures for objects (such as Tcl_EvalObj) resemble existing string-based procedures (such as Tcl_Eval) but take advantage of the internal form stored in Tcl objects for greater speed. Other new procedures manage objects and allow extension writers to define new kinds of objects. See the manual entries doc/*Obj*.3 (BL) 10/24/96 (bug fix) Fixed memory leak on exit caused by some IO related data structures not being deallocated on exit because their refcount was artificially boosted. (JL) 10/24/96 (bug fix) Fixed core dump in Tcl_Close if called with NULL Tcl_Channel. (JL) 11/19/96 (new feature) Added library procedures for finding word breaks in strings in a platform specific manner. See the library.n manual entry for more information. (SS) 11/22/96 (feature improvements) Added support for different levels of tracing during bytecode compilation and execution. This should help in tracking down suspected problems with the compiler or with converting existing code to use Tcl8.0. Two global Tcl variables, traceCompile and traceExec, can be set to generate tracing information in stdout: - traceCompile: 0 no tracing (default) 1 trace compilations of top level commands and procs 2 trace and display instructions for all compilations - traceExec: 0 no tracing 1 trace only calls to Tcl procs 2 trace invocations of all commands including procs 3 detailed trace showing the result of each instruction traceExec >= 2 provides a one line summary of each called command and its arguments. Commands that have been "compiled away" such as set are not shown. (BL) 11/30/96 (bug fix) The command "info nameofexecutable" could sometimes return the name of a directory. (JO) 11/30/96 (feature improvements) Changed the code in library/init.tcl that reads in pkgIndex.tcl so that (a) it reads the files from child directories before those in the parent, so that the parent gets precedence, and (b) it doesn't quit if there is an error in a pkgIndex.tcl file; instead, it prints an error message on standard error and continues. (JO) 10/5/96 (feature improvements) Partial implementation of binary string support: the ability for Tcl string values to contain embedded null bytes. Changed the Tcl object-based APIs to take a byte pointer and length pair instead of a null-terminated C string. Modified several object type managers to support binary strings but not, for example, the list type manager. Existing string-based C APIs are unchanged and will truncate binary strings. Compiled scripts containing nulls are also truncated. (BL) 12/12/96 (feature change) Removed the commands "cp", "mkdir", "mv", "rm", and "rmdir" from the Macintosh version of Tcl. They were never officially supported and their functionality is now available via the file command. (RJ) ----------------- Released 8.0a1, 12/20/96 ----------------------- 1/7/97 (bug fix) Under Windows, "file stat c:" was returning error instead of stat for current dir on c: drive. 1/10/97 (new feature) Added Tcl_GetIndexFromObj procedure for quick lookups of keyword arguments. (JO) 1/12/97 (new feature) Serial IO channel drivers for Windows and Unix, available by using Tcl open command to open pseudo-files like "com1:" or "/dev/ttya". New option to Tcl fconfigure command for serial files: "-mode baud,parity,data,stop" to specify baud rate, parity, data bits, and stop bits. Serial IO is not yet available on Mac. 1/16/97 (feature change) Restored the Tcl7.x "two level substitution semantics" for expressions. Expressions not enclosed in braces are implemented, in general, by calling the expr command procedure (Tcl_ExprObjCmd) at runtime after the Tcl interpreter has already done a first round of substitutions. This is slow (about Tcl7.x speed) because new code for the expression is generally compiled each time. However, if the expression has only variable substitutions (and not command substitutions), "optimistic" fast code is generated inline. This inline code will fail if a second round of substitutions is needed (i.e., if the value of a substituted variable itself requires more substitutions). The optimistic code will catch the error and back off to call the slower but guaranteed correct expr command procedure. (BL) 1/16/97 (feature improvements) Added Tcl_ExprLongObj and Tcl_ExprDoubleObj to round out expression-related procedures. (BL) 1/16/97 (feature change) Under Windows, at startup the environment variables "path", "comspec", and "windir" in any capitalization are converted automatically to upper case. The PATH variable could be spelled as path, Path, PaTh, etc. and it makes programming rather annoying. All other environment variables are left alone. (CS) 1/20/97 (new features) Rewrote the "lsort" command: - The new version is based on reentrant merge sort code provided by Richard Hipp, so it eliminates the reentrancy and stability problems with the old qsort-based implementation. - The new version supports a -dictionary option for sorting, and it also supports a -index option for sorting lists using one element for comparison. - The new version is an object command, so it works well with the Tcl compiler, especially in conjunction with the new -index option. When the -index option is used, this version of lsort is more than 100 times faster than the Tcl 7.6 lsort, which had to use the -command option to get the same effect. (JO) 1/20/97 (feature improvements) Added the improved debugging support for Tcl objects prototyped by Karl Lehenbauer . If TCL_MEM_DEBUG is defined, the object creation calls use Tcl_DbCkalloc directly in order to record the caller's source file name and line number. (BL) 1/21/97 (removed feature) Desupported the tcl_precision variable: if set, it is ignored. Tcl now uses the full 17 digits of precision when converting real numbers to strings (with the new object system real numbers are rarely converted to strings so there is no efficiency disadvantage to printing all 17 digits; the new scheme improves accuracy and simplifies several APIs). (JO) *** POTENTIAL INCOMPATIBILITY *** 1/21/97 (feature change) Removed the "interp" argument for the procedures Tcl_GetStringFromObj, Tcl_StringObjAppend, and Tcl_StringObjAppendObj. Also removed the "interp" argument for the updateStringProc procedure in Tcl_ObjType structures. With the tcl_precision changes above, these are no longer needed. (JO) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0a1, but not with Tcl 7.6 *** 1/22/97 (bug fix) Fixed http.tcl so that http_reset does not result in an extra call to the command callback. In addition, if the transaction gets a premature eof, the state(status) is "eof", not "ok". (BW) ----------------- Released 8.0a2, 1/24/97 ----------------------- 1/29/97 (feature change) Changed how two digit years are parsed in the clock command. The old interface just added 1900 which will seem broken by the year 2000. The new scheme follows the POSIX standard and treats dates 70-99 as 1970-1999 and dates 00-38 as 2000-2038. All other two digit dates are undefined. (RJ) *** POTENTIAL INCOMPATIBILITY *** 2/4/97 (bug fix) Fixed bug in clock code that dealt with relative dates. Using the relative month code you could get an invalid date because it jumped into a non-existant day. (For example, Jan 31 to Feb 31.) The code now will return the last valid day of the month in these situations. Thanks to Hume Smith for sending in this bug fix. (RJ) 2/10/97 (feature change) Eliminated Tcl_StringObjAppend and Tcl_StringObjAppendObj procedures, replaced them with Tcl_AppendToObj and Tcl_AppendStringsToObj procedures. Added new procedure Tcl_SetObjLength. (JO) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2, but not with Tcl 7.6 *** 2/10/97 (new feature) Added Tcl_WrongNumArgs procedure for generating error messages about incorrect number of arguments. (JO) 2/11/97 (new feature, bug fix) http package. Added -accept to http_config so you can set the Accept header. Added -handler option to http_get so you can supply your own data handler. Also fixed POST operation to set the correct MIME type on the request. (BW) 2/22/97 (bug fix) Fixed bug that caused $tcl_platform(osVersion) to be computed incorrectly under AIX. (JO) 2/25/97 (new feature, feature change) Added support for both int and long integer objects. Added Tcl_NewLongObj/Tcl_GetLongFromObj/Tcl_SetLongFromObj procedures and renamed the Tcl_Obj internalRep intValue member to longValue. Tcl_GetIntFromObj now checks for integer values too large to represent as non-long integers. Changed Tcl_GetAllObjTypes to Tcl_AppendAllObjTypes. (BL) 3/5/97 (new feature) Added new Tcl_SetListObj procedure to round out collection of procedures that set the type and value of existing Tcl objects. (BL) 3/6/97 (new feature) Added -global flag for interp invokehidden. (JL) 3/6/97 (new feature, feature change) Added isNativeObjectProc field to the Tcl_CmdInfo structure to indicate (when 1) if the command has an object-based command procedure. Removed the nameLength arg from Tcl_CreateObjCommand since command names can't contain null characters. (BL) 3/6/97 (bug fix) Fixed bug in "unknown" procedure that caused auto- loading to fail on commands whose names begin with digits. (JO) 3/7/97 (bug fix) Auto-loading now works in Safe Base. Safe interpreters only accept the Version 2 and onwards tclIndex files. (JL) 3/13/97 (bug fix) Fixed core dump due to interaction between aliases and hidden commands. Bug found by Lindsay Marshall. (JL) 3/14/97 (bug fix) Fixed mac bugs relating to time. The -gmt option now adjusts the time in the correct direction. (Thanks to Ed Hume for reporting a fix to this problem.) Also fixed file "mtime" etc. to return times from GMT rather than local time zone. (RJ) 3/18/97 (feature change) Declaration of objv in Tcl_ObjCmdProc function changed from "Tcl_Obj *objv[]" to "Tcl_Obj *CONST objv[]". All Tcl object commands changed to use new declaration of objv. Naive translation of string-based command procs to object-based command procs could very easily have yielded code where the contents of the objv array were changed. This is not a problem with string-based command procs, but doing something as simple as objv[2] = objv[3] would corrupt the runtime stack and cause Tcl to crash. Introduced CONST in declaration of objv so that attempted assignment of new pointer values to elements of the objv array will be caught by the compiler. (CCS) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 *** 3/19/97 (bug fix) Fixed panic due to object sharing. The root cause was that old code was using Tcl_ResetResult instead of Tcl_ResetObjResult. (JL) 3/20/97 (new feature) Added a new subcommand for the file command. file attributes filename can give a list of platform-specific options (such as file/creator type on the Mac, permissions on Unix) or set the values of them. Added a new subcommand for the file command. file nativename name gives back the platform-specific form for the file. This is useful when the filename is needed to pass to the OS, such as exec under Windows 95 or AppleScript on the Mac. For more info, see file.n. (SRP) 3/24/97 (removed feature) Removed the tcl_safePolicyPath procedure. Now the policy path is computed from the auto_path by appending the directory 'policies' to each element. Also fixed several bugs in automatic tracking of auto_path by computed policy path. (JL) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 but not with Tcl 7.6 *** 4/8/97 (new feature) If the variable whose name is passed to lappend doesn't already exist, and there are no value arguments, lappend now creates the variable with an empty value instead of returning an error. Change suggested by Tom Tromey. (BL) 4/9/97 (feature change) Changed the name of the TCL_PART1_NOT_PARSED flag to TCL_PARSE_PART1. (BL) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 but not with Tcl 7.6 *** 4/10/97 (bug fixes) Fixed various compilation-related bugs: - "UpdateStringOfCmdName should never be invoked" panic. - Bad code generated for expressions not in {}'s inside catch commands. - Segmentation fault in some command procedures when two argument object pointers refer to the same object. - Second level of substitutions were never done for expressions not in {}'s that consist of a single variable reference: e.g., "set x 27; set bool {$x}; if $bool {puts foo}" would fail with error. - Bad code generated when code storage was grown while compiling some expressions: ones with compilation errors or consisting of only a variable reference. - Bugs involving multiple interpreters: wasn't checking that a procedure's code was compiled for the same interpreter as the one executing it, and didn't invalidate code on hidden-exposed command transitions. - "Bad stack top" panic when executing scripts that require a huge amount of stack space. - Incorrect sharing of code for procedure bodies, and procedure code deallocated before last execution of the procedure finished. - Fixed compilation of expression words in quotes. For example, if "0 < 3" {puts foo}. - Fixed performance bug in array set command with large assignments. - Tcl_SetObjLength segmentation fault setting length of empty object. - If Tcl_SetObjectResult was passed the same object as the interpreter's result object, it freed the object instead of doing nothing. Bug fix by Michael J. McLennan. - Tcl_ListObjAppendList inserted elements from the wrong list. Bug fix by Michael J. McLennan. - Segmentation fault if empty variable list was specified in a foreach command. Bug fix by Jan Nijtmans. - NULL command name was always passed to Tcl_CreateTrace callback procedure. - Wrong string representation generated for the value LONG_MIN. For example, expr 1<<31 printed incorrectly on a 32 bit machine. - "set {a($x)} 1" stored value in wrong variable. - Tcl_GetBooleanFromObj was not checking for garbage after a numeric value. - Garbled "bad operand type" error message when evaluating expressions not surrounded by {}'s. (BL) 4/16/97 (new feature) The expr command now has the "rand()" and "srand()" functions for getting random numbers in expr. (RJ) 4/23/97 (bug fix) Fixed core dump in bgerror when the error handler command deletes the current interpreter. Found by Juergen Schoenwald. (JL) 4/23/97 (feature change) The notifier interfaces have been redesigned to make embedding in applications with external event loops possible. A number of interfaces in the notifier and the channel drivers have changed. Refer to the Notifier.3 and CrtChannel.3 manual entries for more details. (SS) *** POTENTIAL INCOMPATIBILITY *** 4/23/97 (removed feature) The Tcl_File interfaces have been removed. The Tcl_CreateFileHandler/Tcl_DeleteFileHandler interfaces now take Unix fd's and are only supported on the Unix platform. Tcl_GetChannelFile has been replaced with Tcl_GetChannelHandle. Tcl_MakeFileChannel now takes a platform specific file handle. (SS) *** POTENTIAL INCOMPATIBILITY *** 4/23/97 (removed feature) The modal timeout interface has been removed (Tcl_CreateModalTimeout/Tcl_DeleteModalTimeout) (SS) *** POTENTIAL INCOMPATIBILITY *** 4/23/97 (feature change) Channel drivers are now required to correctly implement blocking behavior when they are in blocking mode. (SS) *** POTENTIAL INCOMPATIBILITY *** 4/23/97 (new feature) Added the "binary" command for manipulating binary strings. Also, changed the "puts", "gets", and "read" commands to preserve embedded nulls. (SS) 4/23/97 (new feature) Added tcl_platform(byteOrder) element to the tcl_platform array to identify the native byte order for the current host. (SS) 4/23/97 (bug fix) Fixed bug in date parsing around year boundaries. (SS) 4/24/97 (bug fix) In the process of copying a file owned by another user, Tcl was changing the owner of the copy back to the owner of the original file, therefore causing further file operations to fail because the current user didn't own the copy anymore. The owner of the copy is now left as the current user. (CCS) 4/24/97 (feature change) Under Windows, don't automatically uppercase the environment variable "windir" -- it's supposed to be lower case. (CCS) 4/29/97 (new feature) Added namespace support based on a namespace implementation by Michael J. McLennan of Lucent Technologies. A namespace encapsulates a collection of commands and variables to ensure that they won't interfere the commands and variables of other namespaces. The global namespace holds all global variables and commands. Additional namespaces are created with the new namespace command. The new variable command lets you create Tcl variables inside a namespace. The names of Tcl variables and commands may now be qualified by the name of the namespace containing them. The key namespace-related commands are summarized below: - namespace ?eval? name arg ?arg...? Used to define the commands and variables in a namespace. Optionally creates the namespace. - namespace export ?-clear? ?pattern pattern...? Specifies which commands are exported from a namespace. These are the ones that can be imported into another namespace. - namespace import ?-force? ?pattern pattern...? Makes the specified commands accessible in the current namespace. - namespace current Returns the name of the current namespace. - variable name ?value? ?name ?value?...? Creates one or more namespace variables. (BTL) 5/1/97 (bug fix) Under Windows, file times were reported in GMT. Should be reported in local time. (CCS) 5/2/97 (feature change) Changed the name of the two Tcl variables used for tracing bytecode compilation and execution to tcl_traceCompile and tcl_traceExec respectively. These variables are now documented in the tclvars man page. (BL) 5/5/97 (new feature) Support "end" as the index for "lsort -index". (BW) 5/5/97 (bug fixes) Cleaned up the way the http package resets connections (BW) 5/8/97 (feature change) Newly created Tcl objects now have a reference count of zero instead of one. This simplifies C code that stores newly created objects in Tcl variables or in data structures such as list objects. That C code must increment the new object's reference count since the variable or data structure will contain a long-term reference to the object. Formerly, when new objects started out with reference count one, it was necessary to decrement the new object's reference count after the store to make sure it was left with the correct value; this is no longer necessary. (BL) 5/9/97 (new feature) Added the Tcl_GetsObj interface that takes an object reference instead of a dynamic string (as in Tcl_Gets). (SS) 5/12/97 (new feature) Added Tcl_CreateAliasObj and Tcl_GetAliasObj C APIs to allow an alias command to be created with a vector of Tcl_Obj structures and to get the vector back later. (JL) 5/12/97 (feature change) Changed Tcl_ExposeCommand and Tcl_HideCommand to leave an object result instead of a string result. (JL) 5/14/97 (feature change) Improved the handling of the interpreter result. This is still either an object or a string, but the two values are now kept consistent unless some C code reads or writes interp->result directly. See the SetResult man page for details. Removed the Tcl_ResetObjResult procedure. (BL) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 *** 5/16/97 (new feature) Added "fcopy" command to move data between channels. Refer to the manual page for more information. Removed the "unsupported0" command since it is obsolete now. (SS) 5/16/97 (new feature) Added Tcl_GetStringResult procedure to allow programs to get an interpreter's result as a string. If the result was previously set to an object, this procedure will convert the object to a string. Use of Tcl_GetStringResult is intended to replace direct access to interp->result, which is not safe. (BL) 5/20/97 (new features) Fixed "fcopy" to return the number of bytes transferred in the blocking case. Updated the http package to use fcopy instead of unsupported0. Added -timeout and -handler options to http_get. http_get is now blocking by default. It is only non-blocking if you supply a -command argument. (BW) 5/22/97 (bug fix) Fixed several bugs in the "lsort" command having to do with the -dictionary option and the presence of numbers embedded in the strings. (JO) ----------------- Released 8.0b1, 5/27/97 ----------------------- 6/2/97 (bug fix) Fixed bug in startup code that caused a problem in finding the library files when they are installed in a directory containing a space in the name. (SS) 6/2/97 (bug fix) Fixed bug in Unix notifier where the select mask was not being cleared under some circumstances. (SS) 6/4/97 (bug fix) Fixed bug that prevented creation of Tk widgets in namespaces. Tcl_CreateObjCommand and Tcl_CreateCommand now always create commands in the global namespace unless the command names are qualified. Tcl procedures continue to be created in the current namespace by default. (BL) 6/6/97 (new features) Added new namespace API procedures Tcl_AppendExportList and Tcl_Export to allow C code to get and set a namespace's export list. (BL) 6/11/97 (new feature) Added Tcl_ConcatObj. This object-based routine parallels the string-based routine Tcl_Concat. (SRP) 6/11/97 (new feature) Added Tcl_SetObjErrorCode. This object-based routines parallels the string-based routine Tcl_SetErrorCode. (SRP) 6/12/97 (bug fix) Fix the "unknown" procedure so that wish under Windows will exec an external program, instead of always complaining "console1 not opened for writing". (CCS) 6/12/97 (bug fix) Fixed core dump experienced by the following simple script: interp create x x alias exec exec interp delete x This panic was caused by not installing the new CmdDeleteProc when exec got redefined by the alias creation step. Reported by Lindsay Marshal (JL) 6/13/97 (new features) Tcl objects newly created by Tcl_NewObj now have a string representation that points to a shared heap string of length 1. (They used to have NULL bytes and typePtr fields. This was treated as a special case to indicate an empty string, but made type manager implementations complex and error prone.) The new procedure Tcl_InvalidateStringRep is used to mark an object's string representation invalid and to free any storage associated with the old string representation. (BL) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl7.6 *** 6/16/97 (bug fix) Tcl_ScanCountedElement could leave braces unmatched if the string ended with a backslash. (JO) 6/17/97 (bug fix) Fixed channel event bug where readable events would be lost during recursive events loops if the input buffers contained data. (SS) 6/17/97 (bug fix) Fixed bug in Windows socket code that didn't reenable read events in the case where an external entity is also reading from the socket. (SS) 6/18/97 (bug fix) Changed initial setting of the notifier service mode to TCL_SERVICE_NONE to avoid unexpected event handling during initialization. (SS) 6/19/97 (bug fix/feature change) The command callback to fcopy is now called in case of errors during the background copy. This adds a second, optional argument to the callback that is the error string. The callback in case of errors is required for proper cleanup by the user of fcopy. (BW) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 *** 6/19/97 (bug fix) Fixed a panic due to the following four line script: interp create x x alias foo bar x eval rename foo blotz x alias foo {} The problem was that the interp code was not using the actual current name of the command to be deleted as a result of unaliasing foo. (JL) 6/19/97 (feature change) Pass interp down to the ChannelOption and driver specific calls so system errors can be differentiated from syntax ones. Changed Tcl_DriverGetOptionProc type. Affects Tcl_GetChannelOption, TcpGetOptionProc, TtyGetOptionProc, etc. (DL) *** POTENTIAL INCOMPATIBILITY *** 6/19/97 (new feature) Added Tcl_BadChannelOption for use by by driver specific option procedures (Set and Get) to return a complete and meaningful error message. (DL) 6/19/97 (bug fixes) If a system call error occurs while doing an fconfigure on tcp or tty/com channel: return the appropriate error message (instead of the syntax error one or none). (Fixed for Unix and most of the Win and Mac drivers). (DL) 6/20/97 (feature change) Eval is no longer assumed as the subcommand name in namespace commands: you must now write "namespace eval nsName {...}". Abbreviations of namespace subcommand names are now allowed. (BL) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl7.6 *** 6/20/97 (feature change) Changed the errorInfo traceback message for compilation errors from "invoked from within" to "while compiling". (BL) 6/20/97 (bug fixes) Fixed various compilation-related bugs: - "UpdateStringOfCmdName should never be called" and "UpdateStringOfByteCode should never be called" panics. - Segfault in TclObjInterpProc getting procedure name after evaluation stack is reallocated (grown). - Could not use ":" at end of variable and command names. - Bad code generated for while and for commands with test expressions enclosed in quotes: e.g., "set i 0; while "$i > 5" {}". - Command trace procedures would crash if they did a Tcl_EvalObj that reallocated the evaluation stack. - Break and continue commands did not reset the interpreter result. - The Tcl_ExprXXX routines, both string- or object-based, always modified the interpreter result even if there was no error. - The argument parsing procedure used by several compile procedures always treated "]" as end of a command: e.g., "set a ]" would fail. - Changed errorInfo traceback message for compilation errors from "invoked from within" to "while compiling". - Problem initializing Tcl object managers during interpreter creation. - Added check and error message if formal parameter to a procedure is an array element. (BL) 6/23/97 (new feature) Added "registry" package to allow manipulation of the Windows system registry. See manual entry for details. (SS) 6/24/97 (feature change) Converted http to a package and added the http1.0 subdirectory of the Tcl script library. This means you have to do a "package require http" to use this, as advertised in the man page. (BW) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 *** 6/24/97 (bug fix) Ensure that Tcl_Set/GetVar C APIs, when called without TCL_LEAVE_ERR_MSG, don't touch the interp result. (DL) 6/26/97 (feature change) Changed name of Tcl_ExprStringObj to Tcl_ExprObj. (BL) *** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 *** ----------------- Released 8.0b2, 6/30/97 ----------------------- 7/1/97 (new feature) TCL_BUILD_SHARED flag set in tclConfig.sh when Tcl has been built with --enable-shared. A new tclLibObjs make target, echoing the list of the .o's needed to build a tcl library, is now provided. (DL) 7/1/97 (feature change) compat/getcwd.c removed and changed the only place where getcwd is used so a new USEGETWD flag selects the use of the replacement "getwd". Adding this flag is recommended for SunOS 4 (because getcwd on SunOS 4 uses a pipe to pwd(1)!). (DL) 7/7/97 (feature change) The split command now supports binary data (i.e., null characters in strings). (BL) 7/7/97 (bug fix) string first returned the wrong result if the first argument string was empty. (BL) 7/8/97 (bug fix) Fixed core dump in fcopy that could occur when a command callback was supplied and an error or eof condition caused no background activity. A refcount bug triggered a panic in Tcl_ListObjAppendElement. (BW) 7/8/97 (bug fix) Relaxed the pattern matching on http_get so you do not need a trailing path component. You can now get away with just http_get www.scriptics.com (BW) 7/9/97 (bug fix) Creating anonymous interpreters no longer smashes existing commands with names similar to the generated name. Previously creating an anonymous interpreter could smash an existing command, now it skips until it finds a command name that isn't being used. (JL) 7/9/97 (feature change) Removed the policy management mechanism from the Safe Base; left the aliases to source and load modules, and to do a limited form of the "file" command. See entry of 11/15/96. (JL) 7/9/97 (bug fixes) Fixed various compilation-related bugs: - Line numbers in errorInfo now are the same as those in Tcl7.6 unless there are compilation errors. Compilation error messages now include the entire command in error. - Trailing ::s after namespace names weren't being ignored. - Could not refer to an namespace variable with an empty name using a name of the form "n::". (BL) 7/9/97 (bug fix) Fixed bug in Tcl_Export that prevented you from exporting from other than the current namespace. (BL) 7/9/97 (bug fix) env.test was removing env var needed for proper finding of libraries in child process. (DL) 7/10/97 (bug fixes/new feature) Cleanup in Tcl_MakeSafe. Less information is leaked to safe interps. Error message fixes for interp sub commands. Likewise changes in safealias.tcl; tcl_safeCreateInterp can now be called without argument to generate the slave name (like in interp create). (DL) 7/10/97 (bug fixes) Bytecode compiler now generates more detailed command location information: subcommands as well as commands now have location information. This means command trace procedures now get the correct source string for each command in their command parameter. (BL) 7/22/97 (bug fixes) Performance improvement in Safe interpreters handling. Added new mask value to (tclInt.h) Interp.flags record. (DL) 7/22/97 (bug fix) Fixed panic in 'interp target {} foo'. This bug was present since Tcl 7.6. (JL) 7/22/97 (bug fix) Fixed bug in compilation of procedures in namespaces: the procedure's namespace must be used to look up compile procedures, not the current namespace. (BL) 7/22/97 (bug fix) Use of the -channel option of http_get was not setting the end of line translations mode on the channel, so copying binary data with the -channel option was corrupting the result on non-unix platforms. (BW) 7/22/97 (bug fixes) file commands and ~user (seg fault and other improper returns). (DL) 7/23/97 (feature change) Reenabled "vwait" in Safe Base. (JL) 7/23/97 (bug fixes) Fixed two bugs involving read traces on array variables in procedures: trace procedures were sometimes not called, and reading nonexistant array elements didn't create undefined element variables that could later be defined by trace procedures. (BL) 7/24/97 (bug fix) Windows memory allocation performance was superlinear in some cases. Made the Mac allocator generic and changed both the Mac and Windows platforms to use the new allocator instead of malloc and free. (SS) 7/24/97 - 8/12/97 (bug fixes/change of features) Completely revamped safe sourcing/loading (see safe.n) to hide pathnames, use virtual paths tokens instead, improved security in several respects and made it more tunable. Multi level interp loading can work too now. Package auto loading now works in safe interps as long as the package directory is in the auto_path (no deep crawling allowed in safe interps). (DL) *** POTENTIAL INCOMPATIBILITY with previous alpha and beta releases *** 7/24/97 (bug fixes) Made Tcl_SetVar* and Tcl_NewString* treat a NULL value as an empty string. (This fixes hairy crash case where you would crash because load command for other interps assumed presence of errorInfo...). (DL) 7/28/97 (bug fix) Fixed pkg_mkIndex to understand namespaces. It will use the export list of a namespace and create auto_index entries for all export commands. Those names are in their fully qualified form in the auto_index. Therefore, I tweaked unknown to try both $cmd and ::$cmd. Also fixed pkg_mkIndex so you can have "package require" commands inside your packages. These commands are ignored, which is mostly ok except when you must load another package before loading yours because of linking dependencies. (BW) 7/28/97 (bug fix) A variable created by the variable command now persists until the namespace is destroyed or the variable is unset. This is true even if the variable has not been initialized; these variables used to be destroyed if an error occurred when accessing them. In addition, the "info vars" command lists uninitialized namespace variables, while the "info exists" command returns 0 for them. (BL) 7/29/97 (feature change) Changed the http package to use the ::http namespace. http_get renamed to http::geturl, http_config renamed to http::config, http_formatQuery renamed to http::formatQuery. It now provides the 2.0 version of the package. The 1.0 version is still available with the old names. *** POTENTIAL INCOMPATIBILITY with Tcl 8.0b2 but not with Tcl 7.6 *** 7/29/97 (bug fix, new feature) Tcl_Main now uses Tcl objects internally to preserve NULLs in commands and command output. Added new API procedure Tcl_RecordAndEvalObj that resembles Tcl_RecordAndEval but takes an object containing a command. (BL) 7/30/97 (bug fix) Tcl freed strings in the environ array even if it did not allocate them. (SS) 7/30/97 (bug fix) If a procedure is renamed into a different namespace, it now executes in the context of that namespace. (BL) 7/30/97 (bug fix) Prevent renaming of commands into and from namespaces as part of hiding them. (JL) 7/31/97 (feature change) Moved the history command from C to tcl. This uses the ::history namespace. The "words" and "substitute" options are no longer supported. In addition, the "keep" option without a value returns the current keep limit. There is a new "clear" option. The unknown command now supports !! again. (BW) *** POTENTIAL INCOMPATIBILTY *** 7/30/97 (bug fix) Made sure that a slave can not fool the master into hiding the wrong command. Made sure we don't crash in hiding + namespaces issues. (DL) 8/4/97 (bug fix) Concat, eval, uplevel, and similar commands were incorrectly trimming trailing space characters from their arguments even when the space characters were preceded by a backslash. (JO) 8/4/97 (bug fix) Removed the hard link between bgerror and tkerror. Only bgerror is supported in tcl core. Tk will still look for a tkerror but using regular tcl code for that feature. (DL) *** POTENTIAL INCOMPATIBILTY with code relying on the hard link *** 8/6/97 (bug fix) Reduced size required for compiled bytecodes by using a more compact encoding for the command pc-to-source map. (BL) 8/6/97 (new feature) Added support for additional compilation and execution statistics when Tcl is compiled with the TCL_COMPILE_STATS flag. (BL) 8/7/97 (bug fix) Expressions not in {}s that have a comparison operator as the topmost operator must be compiled out-of-line (call the expr cmd at runtime) to properly support expr's two-level substitution semantics. An example is "set a 2; set b {$a}; puts [expr $b == 2]". (BL) 8/11/97 (bug fix) The catch command would sometimes crash if a variable name was given and the bytecode evaluation stack was grown when executing the argument script. (BL) 8/12/97 (feature change) Reinstated the variable tcl_precision to control the number of digits used when floating-point values are converted to strings, with default of 12 digits. However, had to make tcl_precision shared among all interpreters (except that safe interpreters can't modify it). This makes the Tcl 8.0 behavior almost identical to 7.6 except that the default precision is 12 instead of 6. (JO) *** POTENTIAL INCOMPATIBILITY *** ----------------- Released 8.0, 8/18/97 ----------------------- 8/19/97 (bug fix) Minimal fix for glob -nocomplain bugs: "glob -nocomplain unreadableDir/*" was generating an anonymous error. More in depth fixes will come with 8.1. (DL). 8/20/97 (bug fix) Removed check for FLT_MIN in binary command so underflow conditions are handled by the compiler automatic conversions. (SS) 8/20/97 (bug fixes) Fixed several compilation-related bugs: - Array cmd wasn't detecting arrays that, while compiled, do not yet exist (e.g., are marked undefined since they haven't been assigned to yet). - The GetToken procedure in tclCompExpr.c wasn't recognizing properly whether an integer token was invalid. For example, "0x$" is not a valid integer. - Performance bug in TclExecuteByteCode: the size of its stack frame was reduced by over 20% by moving errorInfo code elsewhere. - Uninitialized memory read error in tclCompile.c. (BL) 8/21/97 (bug fix) safe::interpConfigure now behave like Tk widget's configure : it changes only the options you provide and you can get the current value of any single option. New ?-nested boolean? and ?-statics boolean? for all safe::interp* commands but we still accept (upward compatibility) the previously defined non valued flags ?-noStatics? and ?-nestedLoadOk?. Improved the documentation. (DL). 8/22/97 (bug fix) Updated PrintDbl.3 to reflect the fact that the tcl_precision variable is still used and that it is now shared by all interpreters. (BL) 8/25/97 (bug fix) Fixed array access bug in IllegalExprOperandType procedure in tclExecute.c: it was not properly supporting the || and && operators. (BL) 8/27/97 (bug fix) In cases where a channel handler was created with an empty event mask while data was still buffered in the channel, the channel code would get stuck spinning on a timer that would starve idle handlers. This mostly happened in Tk when reading from stdin. (SS) 9/4/97 (bug fix) Slave interps now inherit the maximum recursion limit of their parent instead of starting back at the default. {nb: this still does not prevent stack overflow by multi-interps recursion or aliasing} (DL) 9/11/97 (bug fix) An uninitialized variable in Tcl_WaitPid caused pipes to fail to report eof properly under Windows. (SS) 9/12/97 (bug fix) "exec" was misidentifying some DOS executables as not executable. (CCS) 9/14/97 (bug fix) Was using the wrong structure in sizeof operation in tclUnixChan.c. (JL) 9/15/97 (bug fix) Fixed notifier to break out of do-one-event loop if Tcl_WaitForEvent returns 1, so that callers of Tcl_DoOneEvent will get a chance to check whether the event just handled is significant. This affected mainly recursive calls to Tcl_VWaitCmd; these did not get a chance to notice that the variable they were waiting for has been set and thus they didn't terminate the vwait. (JL, DL, SS) 9/15/97 (bug fix) Alignment problems in "binary format" would cause a crash on some platforms when formatting floating point numbers. (SS) 9/15/97 (bug fix) Fixed bug in Macintosh socket code. Now passes all tests in socket.test that are not platform specific. (Thanks to Mark Roseman for the pointer on the fix.) (RJ) 9/18/97 (bug fix) Fixed bug -dictionary option of lsort that could cause the compare function to run off the end of an array if the number only contained 0's. (Thanks to Greg Couch for the report.) (RJ) 9/18/97 (bug fix) TclFinalizeEnvironment was not cleaning up properly. (DL, JI) 9/18/97 (bug fix) Fixed long-standing bug where an "array get" command did not trigger traces on the array or its elements. (BL) 9/18/97 (bug fixes) Fixed compilation-related bugs: - Fixed errorInfo traceback information for toplevel coomands that contain nested commands. - In the expr command, && and || now accept boolean operands as well as numeric ones. (BL) 9/22/97 (bug fix) Fixed bug that prevented translation modes from being set independently for input and output on sockets if input was "auto". (JL) 9/24/97 (bug fix) Tcl_EvalFile(3) and thus source(n) now works fine on files containing NUL chars. (DL) 9/26/97 (bug fix) Fixed use of uninitialized memory in the environ array that later could cause random core dumps. Applies to all platforms. (JL) 9/26/97 (bug fix) Fixed use of uninitialized memory in socket address data structure under some circumstances. This could cause random core dumps. This applies only to Unix. (JL) 9/26/97 (bug fix) Opening files on PC-NFS volumes would cause a hang until the system timed after the file was closed. (SS) 10/6/97 (bug fix) The join(n) command, though objectified, was loosing NULs in the joinString and in list elements after the 2nd one. Now you can "join $list \0" for instance. (DL) 10/9/97 (bug fix) Under windows, if env(TMP) or env(TEMP) referred to a non-existent directory, exec would fail when trying to create its temporary files. (CCS) 10/9/97 (bug fix) Under mac and windows, "info hostname" would crash if sockets were installed but the hostname could not be determined anyhow. Tcl_GetHostName() was returning NULL when it should have been returning an empty string. (CCS) 10/10/97 (bug fix) "file attribute /" returned error on windows. (CCS) 10/10/97 (bug fix) Fixed the auto_load procedure to handle procedures defined in namespaces better. Also fixed pgk_mkIndex so it sees procedures defined in nested namespaces. Index entries are still only made for exported procedures. (BW) 10/13/97 (bug fix) On unix, for files with unknown group or owner attributes, querying the "file attributes" would return an error rather than returning the group's or owner's id number, although tha command accepts numbers when setting the file's group or owner. (CCS) 10/22/97 (bug fix) "fcopy" did not eval the callback script at the global scope. (SS) 10/22/97 (bug fix) Fixed the signature of the CopyDone callback used in the http package(s) so they can handle error cases properly. (BW) 10/28/97 (bug fixes) Fixed a problem where lappend would free the Tcl object in a variable if a Tcl_ObjSetVar2 failed because of an error calling a trace on the variable. (BL) 10/28/97 (bug fix) Changed binary scan to properly handle sign extension of integers on 64-bit or larger machines. (SS) 11/3/97 (bug fixes) Fixed several bugs: - expressions such as "expr ($x)" must be compiled out-of-line (call the expr command procedure at runtime) to ensure the correct behavior when "$x" is an expression such as "5+10". - "array set a {}" now creates a new array var with an empty array value if the var didn't already exist. - "lreplace $foo end end" no longer returns an error (just an empty list) if foo is empty. - upvar will no longer create a variable in a namespace that refers to a variable in a procedure. - deleting a command trace within a command trace callback would make the code that calls traces to reference freed memory. - significantly sped up "string first" and "string last" (fix from darrel@gemstone.com). - seg fault in Tcl_NewStringObj() when a NULL is passed as the byte pointer argument and Tcl is compiled with -DTCL_MEM_DEBUG. - documentation and error msg fixes. (BL) 11/3/97 (bug fix) Fixed a number of I/O bugs related to word sizes on 64-bit machines. (SS) 11/6/97 (bug fix) The exit code of the first process created by Tcl on Windows was not properly reported due to an initialization problem. (SS) ----------------- Released 8.0p1, 11/7/97 ----------------------- 11/19/97 (bug fix) Fixed bug in linsert where it sometimes accidently cleared out a shared argument list object. (BL). 11/19/97 (bug fix) Autoloading in namespaces was not working properly. auto_mkindex is still not really namespace aware but most common cases should now be handled properly (see init.test). (BW, DL) 11/20/97 (enhancement) Made the changes required by the new Apple Universal Headers V.3.0, so that Tcl will compile with CW Pro 2. 11/24/97 (bug fix) Fixed tests in clock test suite that needed the -gmt flag set. Thanks to Jan Nijtmans for reporting the problem. (RJ) ----------------- Released 8.0p2, 11/25/97 ----------------------- 12/3/97 (bug fix/optimization) Removed uneeded and potentially dangerous instances of double evaluations if "if" and "expr" statements from the library files. It is recommended that unless you need a double evaluation you always use "expr {...}" instead of "expr ..." and "if {...} ..." instead of "if ... ...". It will also be faster thanks to the byte compiler. (DL) ---- Shipped as part of the plugin2.0b5 as 8.0p2Plugin1, Dec 8th 97 ---- 12/8/97 (bug fix) Need to protect the newly accepted channel in an accept callback on a socket, otherwise the callback may close it and cause an error, which would cause the C code to attempt to close the now deleted channel. Bumping the refcount assures that the channel sticks around to be really closed in this case. (JL) 12/8/97 (bug fix) Need to protect the channel in a fileevent so that it is not deleted before the fileevent handler returns. (CS, JL) 12/18/97 (bug fix) In the opt argument parsing package: if the description had only flags, the "too many arguments" case was not detected. The default value was not used for the special "args" ending argument. (DL) 1/15/98 (improvement) Moved common part of initScript in common file. Moved windows specific initialization to init.tcl so you can initialize Tcl in windows without having to call Tcl_Init which is now only searching for init.tcl {back ported from 8.1}. (DL) ---- Shipped as part of the plugin as 8.0p2Plugin2, Jan 15th 98 ---- 5/27/98 (bug fix) Windows socket driver did not notice new data arriving on nonblocking sockets until the event loop was entered. (SS) 5/27/98 (bug fix) Windows socket driver used FIONREAD, which is not supported correctly by WinSock. (SS) 6/9/98 (bug fix) Generic channel code failed to report readable file events on buffered data that was left behind by a gets or read that did not consume all available data. (SS) 6/18/98 (bug fix) Compilation of loop expressions was too aggressive and incorrectly inlined non-literal expressions. (SS) 6/18/98 (bug fix) "info var" and "info locals" incorrectly reported the existence of compiler temporary variables. (SS) 6/18/98 (bug fix) Dictionary sorting used signed character comparisons. (SS) 6/18/98 (bug fix) Compile procs corrupted the exception stack in some cases. (SS) 6/18/98 (bug fix) Array set had erratic behavior when initializing a variable from an empty value list. (SS) 6/18/98 (bug fix) The Windows registry package had a bad bounds check that could lead to a crash. (SS) 6/18/98 (bug fix) The foreach compile proc did not correctly handle non-local variable references. (SS) 6/25/98 (new features) Added name resolution hooks to support [incr Tcl]. There are new internal Tcl_*Resolver* APIs to add, query and remove the hooks. With this changes it should be possible to dynamically load [incr Tcl] as an extension. (MM) 7/1/97 (bug fix) The commands "info args, body, default, procs" did not correctly handle imported procedures. (RJ) 7/6/98 (improvement) pkg_mkIndex now implements the "package require" command. This makes it possible to create index files for packages that require another package and then execute code from that package in their file. Previously, this would throw an error because the required package had not been loaded. The -nopkgrequied flag is provided to revert back to the old functionality. (EMS) 7/6/98 (improvement) back-ported the -direct flag from 8.1 into pkg_mkIndex. This results in pkgIndex.tcl files that contain direct source or load commands instead of tclPkgSetup commands. (EMS) 7/6/98 (improvement) made changes to the AuxData items structures to support storage of compiled scripts on disk. Also some related minor changes in the compilation and execution engine. (EMS) 6/4/98 (enhancement) Added new internal routines to support inserting and deleting from the stat, access, and open-file-channel mechanisms. TclAccessInsertProc, TclStatInsertProc, & TclOpenFileChannelInsertProc insert pointers to such routines; TclAccessDeleteProc, TclStatDeleteProc, & TclOpenFileChannelDeleteProc delete pointers to such routines. See the file generic/tclIOUtils.c for more details. (SKS) 7/1/98 (enhancement) Added a new internal C variable tclPreInitScript. This is a pointer to a string that may hold an initialization script; If this pointer is non-NULL it is evaluated in Tcl_Init() prior to the built-in initialization script defined in the file generic/tclInitScript.h. (SKS) 7/6/98 (bug fix) Removed dead code in PlatformInitExitHandler so that the TCL_LIBRARY value can be safely patched in binaries. (BW) 7/24/98 (enhancement) Incorporated a new version of auto_mkindex that can support the [incr Tcl] class structures. This version will index all procedures in a source file, not just those where "proc" starts at the beginning of the line. If you want the old behavior, use the auto_mkindex_old procedure. (MM) 7/24/98 (feature change) Changed the Windows registry key to be HKEY_LOCAL_MACHINE\Software\Scriptics\Tcl\8.0, and to store the path in the default value instead of "Root". Also, this key can be specified at compile time in case Tcl is being used in a different context where it needs an alternate library path from the standard Tcl installation. (SS) 7/24/98 (feature change) Changed the search order for init.tcl. The tcl_library variable can now be set before calling Tcl_Init to avoid doing any searches. If it isn't set, then Tcl checks env(TCL_LIBRARY), the static value set at compile time, an install directory relative to the executable, a source directory relative to the executable, and a tcl directory relative to the source heirarchy containing the executable. See the comment at the top of generic/tclInitScript.h for more details. (SS) 7/27/98 (config change) Changed the use of the DBGX flag in configure.in and the makefile to be TCL_DBGX. Users of tclConfig.sh may need to pass this through their configure files with AC_SUBST. (BW) 729/98 (bug fix) Changed [info body] to return a copy of the body of a compiled procedure instead of the body itself, to avoid invalidation of the internal rep and loss of the byte-codes. (EMS) 8/5/98 (bug fix) The platform init code could walk off the end of a buffer when reading the PkgPath registry value on Windows. (SS) 8/5/98 (Windows makefile change) Introduced a set of macros to deal with exporting symbols when compiling DLLS on Windows. See win/README for details. (EMS) 8/5/98 (addendum) Added a second Windows registry key under HKEY_LOCAL_MACHINE\Software\Scriptics\Tcl\8.0, named "pkgPath". This is a multi-string value used to initialize the tcl_pkgPath variable. This is required if extension DLLs are in architecture specific subdirectories. (SS) 8/6/98 (new feature) Added tcl_findLibrary to init.tcl for use by extensions, including Tk. This searches in a canonical way for an extensions library directory and initialization file. (BW) 8/10/98 (bug fix) Imported commands used to get lost if the target of the import was redefined. Tcl_CreateCommand and Tcl_CreateObjCommand were updated to restore import links. (Note that if you rename a command, the import links move to the new name, and if you delete a command then the import links get lost. These semantics have not changed.) (MC) -------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/10/98 ------ 9/3/98 (bug fix) Tcl_Realloc was failing under Windows because the GlobalReAlloc API was not correctly re-allocating blocks that were 32k+. The fix was to use newer Win32 APIs (HeapAlloc, HeapFree, and HeapReAlloc.) (BS) 10/5/98 (bug fix) Fixed bug in pkg_mkIndex that caused some files that do a "package require" of packages in the Tcl libraries to give a warning like warning: "xx.tcl" provides more than one package ({xx 2.0} {yy 0.3}) and generate a broken pkgIndex.tcl file. (EMS) 10/5/98 (bug fix) Pkg_mkIndex was not doing a case-insensitive comparison of extensions to determine whether to load or source a file. Thus, under Windows, MYDLLNAME.DLL was sourced, and mydllname.dll loaded. (EMS) 10/5/98 (new feature) Created a new Tcl_Obj type, "procbody". This object's internal representation holds a pointer to a Proc structure. Extended TclCreateProc to take both strings and "procbody". (EMS) 10/13/98 (bug fix) The "info complete" command can now handle strings with NULLs embedded. Thanks to colin@field.medicine.adelaide.edu.au for providing this fix. (RJ) 10/13/98 (bug fix) The "lsort -dictionary" command did not properly handle some numbers starting with 0. Thanks to Richard Hipp for submitting the fix to Scriptics. (RJ) 10/13/98 (bug fix) The function Tcl_SetListObj was creating an invalid Tcl_Obj if the list had zero elements (despite what the comments said it would do). Thanks to Sebastian Wangnick for reporting the problem. (RJ) 10/20/98 (new feature) Added tcl_platform(debug) element to the tcl_platform array on Windows platform. The existence of the debug element of the tcl_platform array indicates that the particular Tcl shell has been compiled with debug information. Using "info exists tcl_platform(debug)" a Tcl script can direct the interpreter to load debug versions of DLLs with the load command. (SKS) 10/20/98 (feature change) The Makefile and configure scripts have been changed for IRIX to build n32 binaries instead of the old 32 abi format. If you have extensions built with the o32 abi's you will need to update them to n32 for them to work with Tcl. (RJ) *** POTENTIAL INCOMPATIBILITY *** 10/23/98 (bug fix) tcl_findLibrary had a stray ] in one of the pathnames it searched for the initialization script. tclInitScript.h was incorrectly adding the parent of tcl_library to tcl_pkgPath. This logic was moved into init.tcl, and the initialization of auto_path was documented. Thanks to Donald Porter and Tom Silva for related patches. (BW) 10/29/98 (bug fix) Fixed Tcl_NotifyChannel to use Tcl_Preserve instead of Tcl_RegisterChannel so that 1) unregistered channels do not get closed after their first fileevent, and 2) errors that occur during close in a fileevent script are actually reflected by the close command. (BW) 10/30/98 (bug fix) Overhaul of pkg_mkIndex to deal with transitive package requires and packages split among scripts and binary files. Also fixed ommision of global for errorInfo in tcl_findLibrary. (BW) 11/08/98 (bug fix) Fixed the resource command to always detect the case where a file is opened a second time with the same permissions. IM claims that this will always cause the same FileRef to be returned, but in MacOS 8.1+, this is no longer the case, so we have to test for this explicitly. (JI) 11/10/98 (feature change) When compiling with Metrowerk's MSL, use the exit function from MSL rather than ExitToShell. This allows MSL to clean up its temporary files. Thanks to Vince Darley for this improvement. (JI) ----------------- Released 8.0.4, 11/19/98 ------------------------- 11/20/98 (bug fix) Handle possible NULL return in TclGetStdFiles. (RJ) 11/20/98 (bug fix) The dltests would not build on SGI. They reported that you could not mix n32 with 032 binaries. The configure script has been modified to get the EXTRA_CFLAGS from the tcl configure script. [Bug id: 840] (RJ) 12/3/98 (bug fix) Windows NT creates sockets so they are inheritable by default. Fixed socket code so it turns off this bit right after creation so sockets aren't kept open by exec'ed processes. [Bug: 892] Thanks to Kevin Kenny for this fix. (SS) 1/11/98 (bug fix) On HP, "info sharedlibextension" was returning empty string on static apps. It now always returns ".sl". (RJ) 1/28/99 (configure change) Now support -pipe option on gcc. (RJ) 2/2/99 (bug fix) Fixed initialization problem on Windows where no searching for init.tcl would be performed if the registry keys were missing. (stanton) 2/2/99 (bug fix) Added support for HKEY_PERFORMANCE_DATA and HKEY_DYN_DATA keys in the "registry" command. (stanton) 2/2/99 (bug fix) ENOTSUP and EOPNOTSUPP clashed on some Linux variants. (stanton) 2/2/99 (enhancement) The "open" command has been changed to use the object interfaces. (stanton) 2/2/99 (bug fix) In some cases Tcl would crash due to an overflow of the exception stack resulting from a missing byte code in some expressions. (stanton) 2/2/99 (bug fix) Changed configure so Linux and IRIX shared libraries are linked with the system libraries. (stanton) 2/2/99 (bug fix) Added support for BSDI 4.x (BSD/OS-4*) to the configure script. (stanton) 2/2/99 (bug fix) Fixed bug where upvar could resurrect a namespace variable after the namespace had been deleted. (stanton) 2/2/99 (bug fix) In some cases when creating variables, the interpreter result was being modified even if the TCL_LEAVE_ERR_MSG flag was set. (stanton) 2/2/99 (bug fix & new feature) Changed the socket drivers to properly handle failures during an async socket connection. Added a new fconfigure option "-error" to retrieve the failure message. See the socket.n manual entry for details. (stanton) 2/2/99 (bug fix) Deleting a renamed interp alias could result in a panic. (stanton) 2/2/99 (feature change/bug fix) Changed the behavior of "file extension" so that it splits at the last period. Now the extension of a file like "foo..o" is ".o" instead of "..o" as in previous versions. *** POTENTIAL INCOMPATIBILITY *** ----------------- Released 8.0.5, 3/9/99 ------------------------- ======== Changes for 8.0 go above this line ======== ======== Changes for 8.1 go below this line ======== 6/18/97 (new feature) Tcl now supports international character sets: - All C APIs now accept UTF-8 strings instead of iso8859-1 strings, wherever you see "char *", unless explicitly noted otherwise. - All Tcl strings represented in UTF-8, which is a convenient multi-byte encoding of Unicode. Variable names, procedure names, and all other values in Tcl may include arbitrary Unicode characters. For example, the Tcl command "string length" returns how many Unicode characters are in the argument string. - For Java compatibility, embedded null bytes in C strings are represented as \xC080 in UTF-8 strings, but the null byte at the end of a UTF-8 string remains \0. Thus Tcl strings once again do not contain null bytes, except for termination bytes. - For Java compatibility, "\uXXXX" is used in Tcl to enter a Unicode character. "\u0000" through "\uffff" are acceptable Unicode characters. - "\xXX" is used to enter a small Unicode character (between 0 and 255) in Tcl. - Tcl automatically translates between UTF-8 and the normal encoding for the platform during interactions with the system. - The fconfigure command now supports a -encoding option for specifying the encoding of an open file or socket. Tcl will automatically translate between the specified encoding and UTF-8 during I/O. See the directory library/encoding to find out what encodings are supported (eventually there will be an "encoding" command that makes this information more accessible). - There are several new C APIs that support UTF-8 and various encodings. See Utf.3 for procedures that translate between Unicode and UTF-8 and manipulate UTF-8 strings. See Encoding.3 for procedures that create new encodings and translate between encodings. See ToUpper.3 for procedures that perform case conversions on UTF-8 strings. 9/18/97 (enhancement) Literal objects are now shared by the ByteCode structures created when compiled different scripts. This saves up to 45% of the total memory needed for all literals. (BL) 9/24/97 (bug fixes) Fixed Tcl_ParseCommand parsing of backslash-newline sequences at start of command words. Suppressed Tcl_EvalDirect error logging if non-TCL_OK result wasn't an error. (BL) 10/17/97 (feature enhancement) "~username" now refers to the users' home directory on Windows (previously always returned failure). (CCS) 10/20/97 (implementation change) The Tcl parser has been completely rewritten to make it more modular. It can now be used to parse a script without actually executing it. The APIs for the new parser are not correctly exported, but they will eventually be exported and augmented with Tcl commands so that Tcl scripts can parse other Tcl scripts. (JO) 10/21/97 (API change) Added "flags" argument to Tcl_EvalObj, removed Tcl_GlobalEvalObj procedure. Added new procedures Tcl_Eval2 and Tcl_EvalObjv. (JO) *** POTENTIAL INCOMPATIBILITY *** 10/22/97 (API change) Renamed Tcl_ObjSetVar2 and Tcl_ObjGetVar2 to Tcl_SetObjVar2 and Tcl_GetObjVar2 (for consistency with other C APIs) and changed the name arguments to be strings instead of objects. (JO) *** POTENTIAL INCOMPATIBILITY *** 10/27/97 (enhancement) Bytecode compiler rewritten to use the new Tcl parser. (BL) 11/3/97 (New routines) Added Tcl_AppendObjToObj, which appends the string rep of one Tcl_Obj to another. Added Tcl_GetIndexFromObjStruct, which is similar to Tcl_GetIndexFromObj, except that you can give an offset between strings. This allows Tcl_GetIndexFromObjStruct to be called with a table of records which have strings in them. (SRP) 12/4/97 (enhancement) New Tcl expression parser added. Added new procedure Tcl_ParseExpr and new token types TCL_TOKEN_SUB_EXPR and TCL_TOKEN_OPERATOR. Expression compiler is reimplemented to use this parser. (BL) 12/9/97 (bug fix) Tcl_EvalObj() increments/decrements the refcount of the script object to prevent the object from deleting itself while in the middle of being evaluated. (CCS) 12/9/97 (bug fix) Memory leak in Tcl_GetsObjCmd(). (CCS) 12/11/97 (bug fix) Environment array leaked memory when compiled with Visual C++. (SS) 12/11/97 (bug fix) File events and non-blocking I/O did not work on pipes under Windows. Changed to use threads to achieve non-blocking behavior. (SS) 12/18/97 (bug fixes) Fixed segfault in "namespace import"; importing a procedure that causes a cycle now returns an error. Modified "info procs", "info args", "info body", and "info default" to return information about imported procedures as well as procedures defined in a namespace. (BL) 12/19/97 (enhancement) Added new Tcl_GetString() procedure that can be used in place of Tcl_GetStringFromObj() if the string representation's length isn't needed. (BL) 12/18/97 (bug fix) In the opt argument parsing package: if the description had only flags, the "too many arguments" case was not detected. The default value was not used for the special "args" ending argument. (DL) 1/7/98 (clean up) Moved everything not absolutly necessary out of init.tcl procs now in auto.tcl and package.tcl can be autoloaded if needed. (DL) 1/7/98 (enhancement) tcltest made at install time will search for it's init.tcl where it is, even when using virtual path compilation. (DL) 1/8/98 (os bug workaround) when needed, using a replacement for memcmp so string compare "char with high bit set" "char w/o high bit set" returns the expected value on all platforms. (DL) 1/8/98 (unix portability/configure) building from .../unix/targetName/ subdirectories and simply using "../configure" should now work fine. (DL) 1/14/98 (enhancement) Added new regular expression package that supports AREs, EREs, and BREs. The new package includes new escape characters, meta-syntax, and character classes inside brackets. Regexps involving backslashes may behave differently. (MH) *** POTENTIAL INCOMPATIBILITY *** 1/16/98 (os workaround) Under windows, "file volume" was causing chatter and/or several seconds of hanging when querying empty floppy drives. Changed implementation to call an empirically-derived function that doesn't cause this. (CCS) 1/16/98 (enhancement) Converted regular expressions to a Tcl_Obj type so their compiled form gets cached automatically. Reduced NSUBEXP from 100 to 20. (BW) 1/16/98 (documentation) Change unclear documentation and comments for functions like Tcl_TranslateFileName() and Tcl_ExternalToUtfDString(). Now it explicitly says they take an uninitialized or free DString. A DString that is "empty" or "not holding anything" could have been interpreted as one currently with a zero length, but with a large dynamically allocated buffer. (CCS) ----------------- Released 8.1a1, 1/22/98 ----------------------- 1/28/98 (new feature) Added a "-direct" optional flag to pkg_mkIndex to generate direct loading package indexes (such those you need if you use namespaces and plan on using namespace import just after package require). pkg_mkIndex still has limitations regarding package dependencies but errors are now ignored and with -direct, correct package indexes can be generated even if there are dependencies as long as the "package provide" are done early enough in the files. (DL) 1/28/98 (enhancement) Performance tuning of regexp and regsub. (CCS) 1/28/98 (bug fix) regexp and regsub with "-indices" returned the byte-offsets of the characters in the UTF-8 representation, not the character offsets themselves. (CCS) 1/28/98 (bug fix) "clock format 0 -format %Z -gmt 1" would return the local timezone string instead of "GMT" on Solaris and Windows. 1/28/98 (bug fix) Restore tty settings when closing serial device on Unix. This is good behavior when closing real serial devices, essential when closing the pseudo-device /dev/tty because the user's terminal settings would be left useless, in raw mode, when tcl quit. (CCS) 1/28/98 (bug fix) Tcl_OpenCommandChannel() was modifying the contents of the argv array passed to it, causing problems for any caller that wanted to continue to use the argv array after calling Tcl_OpenCommandChannel(). (CCS) 2/1/98 (bug fix) More bugs with %Z in format string argument to strftime(): 1. Borland always returned empty string. 2. MSVC always returned the timezone string for the current time, not the timezone string for the specified time. 3. With MSVC, "clock format 0 -format %Z -gmt 1" would return "GMT" the first time it was called, but would return the current timezone string on all subsequent calls. (CCS) 2/1/98 (bug fix) "file stat" was broken on Windows. 1. "file stat" of a root directory (local or network) or a relative path that resolved to a root directory (c:. when in pwd was c:/) was returning error. 2. "file stat" on a regular file (S_IFREG), the st_mode was sign extended to a negative int if the platform-dependant type "mode_t" was declared as a short instead of an unsigned short. 3. "file stat" of a network directory, the st_dev was incorrectly reported as the id of the last accessed local drive rather than the id of the network drive. (CCS) 2/1/98 (bug fix) "file attributes" of a relative path that resolved to a root directory was returning error. (CCS) 2/1/98 (bug fix) Change error message when "file attribute" could not determine the attributes for a file. Previously it would return different error messages on Unix vs. Windows vs. Mac. (CCS) 2/4/98 (bug fixes) Fixed several instances of bugs where the parser/compiler would reach outside the range of allocated memory. Improved the array lookup algorithm in set compilation. (DL) 2/5/98 (change) The TCL_PARSE_PART1 flag for Set/Get(Obj)Var2 C APIs is now deprecated and ignored. The part1 is always parsed when the part2 argument is NULL. This is to avoid a pattern of errors for extension writers converting from string based Tcl_SetVar() to new Tcl_SetObjVar2() and who could easily forget to provide the flag and thus get code working for normal variables but not for array elements. The performance hit is minimal. A side effect of that change is that is is no longer possible to create scalar variables that can't be accessed by tcl scripts because of their invalid name (ending with parenthesis). Likewise it is also parsed and checked to ensure that you don't create array elements of array whose name is a valid array element because they would not be accessible from scripts anyway. Note: There is still duplicate array elements parsing code. (DL) *** POTENTIAL INCOMPATIBILITY *** 2/11/98 (bug fix) Sharing objects between interps, such as by "interp eval" or "send" could cause a crash later when dereferencing an interp that had been deleted, given code such as: set a {set x y} interp create foo interp eval foo $a interp delete foo unset a Interp "foo" was gone, but "a" had a internal rep consisting of bytecodes containing a dangling pointer to "foo". Unsetting "a" would attempt to return resources back to "foo", causing a crash as random memory was accessed. The lesson is that that if an object's internal rep depends on an interp (or any other data structure) it must preserve that data in some fashion. (CCS) 2/11/98 (enhancement) The "interp" command was returning inconsistent error messages when the specified slave interp could not be found. (CCS) 2/11/98 (bug fix) Result codes like TCL_BREAK and TCL_CONTINUE were not propagating through the master/slave interp boundaries, such as "interp eval" and "interp alias". TCL_OK, TCL_ERROR, and non-standard codes like teh integer 57 work. There is still a question as to whether TCL_RETURN can/should propagate. (CCS) 2/11/98 (bug fix) TclCompileScript() was derefering memory 1 byte before start of the string to compile, looking for ']'. (CCS,DL) 2/11/98 (bug fix) Tcl_Eval2() was derefering memory 1 byte before start of the string to eval, looking for ']'. (CCS,DL) 2/11/98 (bug fix) Compiling "set a(b" was running off end of string. (CCS,DL) 2/11/98 (bug fix) Windows initialization code was dereferencing uninitialized memory if TCL_LIBRARY environment didn't exist. (CCS) 2/11/98 (bug fix) Windows "registry" command was dereferencing uninitialized memory when constructing the $errorCode for a failed registry call. (CCS) 2/11/98 (enhancement) Eliminate the TCL_USE_TIMEZONE_VAR definition from configure.in, because it was the same information as the already existing HAVE_TM_ZONE definition. The lack of HAVE_TM_ZONE is used to work around a Solaris and Windows bug where "clock format [clock sec] -format %Z -gmt 1" produces the local timezone string instead of "GMT". (CCS) 2/11/98 (bug fix) Memleaks and dereferencing of uninitialized memory in regexp if an error occurred while compiling a regular expression. (CCS). 2/18/98 (new feature) Added mutexes and thread local storage in order to make Tcl thread safe. For testing purposes, there is a testthread command that creates a new thread and an interpreter inside it. See thread.test for examples, but this script-level interface is not fixed. Each thread has its own notifier instance to manage its own events, and threads can post messages to each other's message queue. This uses pthreads on UNIX, and native thread support on other platforms. You enable this by configuring with --enable-threads. Note that at this time *Tk* is still not thread safe. Special thanks to Richard Hipp: his earlier implementation inspired this work. (BW, SS, JI) 2/18/98 (hidden feature change) The way the env() array is shared among interpreters changed. Updates to env used to trigger write traces in other interpreters. This undocumented feature is no longer implemented. Instead, variable tracing is used to keep the C-level environ array in sync with the Tcl-level env array. This required adding TCL_TRACE_ARRAY support to Tcl_TraceVar2 so that array names works properly. (BW) *** POTENTIAL INCOMPATIBILITY *** 2/18/98 (enhancement) Conditional compilation for unix systems (e.g., IRIX, SCO) that use f_bsize instead of st_blksize to determine disk block size. (CCS) 2/23/98 (bug fix) Fixed the emulation of polling selects in the threaded version of the Unix notifier. The bug was showing up on a multiprocessor as starvation of the notifier thread. (BW) ----------------- Released 8.1a2, Feb 23 1998 ----------------------- 9/22/98 (bug fix) Changed the value of TCL_TRACE_ARRAY so it no longer conflicts with the deprecated TCL_PARSE_PART1 flag. This should improve portability of C code. (stanton) 10/6/98 (bug fix) The compile procedure for "if" incorrectly attempted to match against the literal string "if", resulting in a stack overflow when "::if" was compiled. It also would incorrectly accept "if" instead of "elsif" in later clauses. (stanton) 10/15/98 (new feature) Added a "totitle" subcommand to the "string" command to convert strings to capitalize the first character of a string and lowercase all of the other characters. (stanton) 10/15/98 (bug fix) Changed regexp and string commands to properly handle case folding according to the Unicode character tables. (stanton) 10/21/98 (new feature) Added an "encoding" command to facilitate translations of strings between different character encodings. See the encoding.n manual entry for more details. (stanton) 11/3/98 (bug fix) The regular expression character classification syntax now includes Unicode characters in the supported classes. (stanton) 11/6/98 (bug fix) Variable traces were causing crashes when upvar variables went out of scope. [Bug: 796] (stanton) 11/9/98 (bug fix) "format" now correctly handles multibyte characters in %s format strings. (stanton) 11/10/98 (new feature) "regexp" now accepts three new switches ("-line", "-lineanchor", and "-linestop") that control how regular expressions treat line breaks. See the regexp manual entry for more details. (stanton) 11/17/98 (bug fix) "scan" now correctly handles Unicode characters. (stanton) 11/17/98 (new feature) "scan" now supports XPG3 position specifiers and the "%n" conversion character. See the "scan" manual entry for more details. (stanton) 11/17/98 (bug fix) The Tcl memory allocator now returns 8-byte aligned chunks of memory which improves performance on Windows and avoids crashes on other platforms. [Bug: 834] (stanton) 11/23/98 (bug fix) Applied various regular expression performance bug fixes supplied by Henry Spencer. (stanton) 11/30/98 (bug fix) Fixed various thread related race conditions. [Bug: 880 & 607] (stanton) 11/30/98 (bug fix) Fixed a number of memory overflow and leak bugs. [Bug: 584] (stanton) 12/1/98 (new feaure) Added support for Korean encodings. (stanton) 12/1/98 (feature change) Changed the Tcl_EvalObjv interface to remove the string and length arguments. *** POTENTIAL INCOMPATIBILITY with previous alpha releases *** 12/2/98 (bug fix) Fixed various bugs related to line feed translation. [Bug: 887] (stanton) 12/4/98 (new feature) Added a message catalog facility to help with localizing Tcl scripts. Thanks to Mark Harrison for contributing the initial implementation of the "msgcat" package. (stanton) 12/7/98 (bug fix) The memory allocator was failing to update the block list for large memory blocks that were reallocated into a different address. [Bug: 933] (stanton) ----------------- Released 8.1b1, Dec 10 1998 ----------------------- 12/22/98 (performance improvement) Improved the -command option of the lsort command to better use the object system for improved performance (about 5x speed up). Thanks to Syd Polk for suppling the patch. [RFE: 726] (rjohnson) 2/10/99 (bug fix) Restored the Tcl_ObjSetVar2/Tcl_ObjGetVar2 interfaces from 8.0 and renamed the Tcl_GetObjVar2/Tcl_SetObjVar2 interfaces to Tcl_GetVar2Ex and Tcl_SetVar2Ex. This should provide better compatibility with 8.0. (stanton) *** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases *** 2/10/99 (bug fix) Made the eval interfaces compatible with 8.0 by renaming Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to Tcl_EvalEx and restoring Tcl_EvalObj and Tcl_GlobalEvalObj interfaces so they match Tcl 8.0. (stanton) *** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases *** 2/25/99 (bug fix/new feature) On Windows, the channel drivers for consoles and serial ports now completely support file events. (redman) 3/5/99 (bug fix) Integrated patches to fix various configure problems that affected HP-UX-11, 64-bit IRIX, Linux, and Solaris. (stanton) 3/9/99 (bug fix) Integrated various AIX related patches to improve support for shared libraries. (stanton) 3/9/99 (new feature) Added tcl_platform(user) to provide a portable way to get the name of the current user. (welch) 3/9/99 (new feature) Integrated the stub library mechanism contributed by Jan Nijtmans, Paul Duffin, and Jean-Claude Wippler. This feature should make it possible to write extensions that support multiple versions of Tcl simultaneously. It also makes it possible to dynamically load extensions into statically linked interpreters. This patch includes the following changes: - Added a Tcl_InitStubs() interface - Added Tcl_PkgProvideEx, Tcl_PkgRequireEx, Tcl_PkgPresentEx, and Tcl_PkgPresent. - Added va_list versions of all VARARGS functions so they can be invoked from wrapper functions. See the manual for more information. (stanton) 3/10/99 (feature change) Replaced Tcl_AlertNotifier with Tcl_ThreadAlert since the Tcl_AlertNotifier function relied on passing internal data structures. (stanton) *** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases *** 3/10/99 (new feature) Added a Tcl_GetVersion API to make it easier to check the Tcl version and patch level from C. (redman) 3/14/99 (feature change) Tried to unify the TclpInitLibrary path routines to look in similar places from Windows to UNIX. The new library search path is: TCL_LIBRARY, TCL_LIBRARY/../tcl8.1, relative to DLL (Windows Only) relative to installed executable, relative to develop executable, and relative to compiled-in in location (UNIX Only.) This fix included: - Defining a TclpFindExecutable - Moving Tcl_FindExecutable to a common area in tclEncoding.c - Modifying the TclpInitLibraryPath routines. (surles) 3/14/99 (feature change) Added hooks for TclPro Wrapper to initialize the location of the encoding files and libraries. This fix included: - Adding the TclSetPerInitScript routine. - Modifying the Tcl_Init routines to evaluate the non-NULL preinit script. - Adding the Tcl_SetdefaultEncodingDir and Tcl_GetDefaultEncodingDir routines. - Modifying the TclpInitLibrary routines to append the default encoding dir. (surles) 3/14/99 (feature change) Test suite now uses "test" namespace to define the test procedure and other auxiliary procedures as well as global variables. - Global array testConfige is now called ::test::testConfig. - Global variable VERBOSE is now called ::test::verbose, and ::test::verbose no longer works with numerical values. We've switched to a bitwise character string. You can set ::test::verbose by using the -verbose option on the Tcl command line. - Global variable TESTS is now called ::test::matchingTests, and can be set on the Tcl command line via the -match option. - There is now a ::test::skipTests variable (works similarly to ::test::matchTests) that can be set on the Tcl command line via the -match option. - The test suite can now be run in any working directory. When you run "make test", the working directory is nolonger switched to ../tests. (hirschl) *** POTENTIAL INCOMPATIBILITY *** --------------- Released 8.1b2, March 16, 1999 ---------------------- 3/18/99 (bug fix) Fixed missing/incorrect characters in shift-jis table (stanton) 3/18/99 (feature change) The glob command ignores the FS_CASE_IS_PRESERVED bit on file systesm and always returns exactly what it gets from the system. (stanton) *** POTENTIAL INCOMPATIBILITY *** 3/19/99 (new feature) Added support for --enable-64bit. For now, this is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun compiler. (redman) 3/23/99 (bug fix) Fixed fileevents and gets on Windows consoles and serial devices so that non-blocking channels do not block on partial input lines. (redman) 3/23/99 (bug fix) Added a new Tcl_ServiceModeHook interface. This is used on Windows to avoid the various problems that people have been seeing where the system hangs when tclsh is running outside of the event loop. As part of this, renamed TclpAlertNotifier back to Tcl_AlertNotifier since it is public. (stanton) 3/23/99 (feature change) Test suite now uses "tcltest" namespace to define the test procedure and other auxiliary procedures as well as global variables. The previously chosen "test" namespace was thought to be too generic and likely to create conflits. (hirschl) *** POTENTIAL INCOMPATIBILITY *** 3/24/99 (bug fix) Make sockets thread safe on Windows. (redman) 3/24/99 (bug fix) Fix cases where expr would incorrect return a floating point value instead of an integer. (stanton) 3/25/99 (bug fix) Added ASCII to big5 and gb2312 encodings. (stanton) 3/25/99 (feature change) Changed so aliases are invoked at current scope in the target interpreter instead of at the global scope. This was an incompatibility introduced in 8.1 that is being removed. (stanton) *** POTENTIAL INCOMPATIBILITY with previous beta releases *** 3/26/99 (feature change) --enable-shared is now the default and build Tcl as a shared library; specify --disable-shared to build a static Tcl library and shell. *** POTENTIAL INCOMPATIBILITY *** 3/29/99 (bug fix) Removed the stub functions and changed the stub macros to just use the name without params. Pass &tclStubs into the interp (don't use tclStubsPtr because of collisions with the stubs on Solaris). (redman) 3/30/99 (bug fix) Loadable modules are now unloaded at the last possible moment during Tcl_Finalize to fix various exit-time crashes. (welch) 3/30/99 (bug fix) Tcl no longer calls setlocale(). It looks at env(LANG) and env(LC_TYPE) instead. (stanton) 4/1/99 (bug fix) Fixed the Ultrix multiple symbol definition problem. Now, even Tcl includes a copy of the Tcl stub library. (redman) 4/1/99 (bug fix) Internationalized the registry package. 4/1/99 (bug fix) Changed the implemenation of Tcl_ConditionWait and Tcl_ConditionNotify on Windows. The new algorithm eliminates a race condition and was suggested by Jim Davidson. (welch) 4/2/99 (new apis) Made various Unicode utility functions public. Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsDigit, Tcl_UniCharIsLower, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar, Tcl_WinUtfToTChar, Tcl_WinTCharToUtf (stanton) 4/2/99 (feature change) Add new DDE package and removed the Tk send command from the Windows version. Changed DDE-based send code into "dde eval" command. The DDE package can be loaded into tclsh, not just wish. Windows only. (redman) 4/5/99 (bug fix) Changed safe-tcl so that the encoding command is an alias that masks out the "encoding system" subcommand. (redman) 4/5/99 (bug fix) Configure patches to improve support for OS/390 and BSD/OS 4.*. (stanton) 4/5/99 (bug fix) Fixed crash in the clock command that occurred with negative time values in timezones east of GMT. (stanton) 4/6/99 (bug fix) Moved the "array set" C level code into a common routine (TclArraySet). The TclSetupEnv routine now uses this API to create an env array w/ no elements. This fixes the bug caused when every environ varaible is removed, and the Tcl env variable is synched. If no environ vars existed, the Tcl env var would never be created. (surles) 4/6/99 (bug fix) Made the Env module I18N compliant. (surles) 4/6/99 (bug fix) Changed the FindVariable routine to TclpFindVariable, that now does a case insensitive string comparison on Windows, and not on UNIX. (surles) --------------- Released 8.1b3, April 6, 1999 ---------------------- 4/9/99 (bug fix) Fixed notifier deadlock situation when the pipe used to talk back notifier thread is filled with data. Found as a result of the focus.test for Tk hanging. (redman) 4/13/99 (bug fix) Fixed bug where socket -async combined with fileevent for writing did not work under Windows NT. (redman) 4/13/99 (encoding fix) Restored the double byte definition of GB2312 and added the EUC-CN encoding. EUC-CN is a variant of GB2312 that shifts the characters into bytes with the high bit set and includes ASCII as a subset. (stanton) 4/27/99 (bug fix) Added 'extern "C" {}' block around the stub table pointer declaration so the stub library can be used from C++. (stanton) --------------- Released 8.1 final, April 29, 1999 ---------------------- 4/22/99 (bug fix) Changed Windows NT socket implementation to avoid creating a communication window. This avoids the problem where the system hangs waiting for tclsh to respond to a system-wide synchronous broadcast (e.g. if you change system colors). (redman) 4/22/99 (bug fix) Added call to TclWinInit from TclpInitPlatform when building a static library since DllMain will not be invoked. This could break old code that explicitly called TclWinInit, but should be simpler in the long run. (stanton) *** POTENTIAL INCOMPATIBILITY *** 4/23/99 (bug fix) Added support for the koi8-r Cyrillic encoding. [Bug: 1771] (stanton) 4/28/99 (bug fix) Changed internal Tcl_Obj usage to avoid freeing the internal representation after the string representation has been freed. This makes it easier to debug extensions. (stanton) 4/30/99 (bug fix) Fixed a memory leak in CommandComplete. (stanton) 5/3/99 (bug fix) Fixed a bug where the Tcl_ObjType was not being set in a duplicated Tcl_Obj. [Bug: 1975, 2047] (stanton) 5/3/99 (bug fix) Changed Tcl_ParseCommand to avoid modifying eval'ed strings that are already null terminated. [Bug: 1793] (stanton) 5/3/99 (new feature) Applied Jeff Hobbs's string patch which includes the following changes: - added new subcommands: equal, repeat, map, is, replace - added -length option to "string compare|equal" - added -nocase option to "string compare|equal|match" - string and list indices can be an integer or end?-integer?. - added optional first and last index args to string toupper, et al. See the string.n manual entry for more details about the new string features. [Bug: 1845] (stanton) 5/6/99 (new feature) Added Tcl_UtfNcmp and Tcl_UtfNcasecmp to make Utf string comparision easier. (stanton) 5/7/99 (bug fix) Improved OS/390 support. [Bug: 1976, 1997] (stanton) 5/12/99 (bug fix) Changed Windows initialization code to avoid using GetUserName system call in favor of the env(USERNAME) variable. This provides a significant startup speed improvement. (stanton) 5/12/99 (bug fix) Replaced the per-interpreter regexp cache with a per-thread cache. Changed the Regexp object to take advantage of this extra cache. Added a reference count to the TclRegexp type so regexps can be shared by multiple objects. Removed the per-interp regexp cache from the interpreter. Now regexps can be used with no need for an interpreter. This set of changes should provide significant speed improvements for many Tcl scripts. [Bug: 1063] (stanton) 5/14/99 (bug fix) Durining initialization on Unix, Tcl now extracts the encoding subfield from the LANG/LC_ALL environment variables in cases where the locale is not found in the built-in locale table. It also attempts to initialize the locale subsystem so X11 is happy. [Bug: 1989] (stanton) 5/14/99 (bug fix) Applied the patch to fix 100-year and 400-year boundaries in leap year code, from Isaac Hollander. [Bug: 2066] (redman) 5/14/99 (bug fix) Fixed a crash caused by a failure to reset the result before evaluating the test expression in an uncompiled for statement. (stanton) 5/18/99 (bug fix) Modified initialization code on Windows to avoid inherenting closed or invalid channels. If the standard input is anything other than a console, file, serial port, or pipe, then we fall back to the standard Tk window console. (stanton) 5/19/99 (bug fix) Added an extern "C" block around the entire tcl.h header file to avoid C++ linkage issues. (redman) 5/19/99 (new feature) Applied Jeff Hobb's patch to add Tcl_StringCaseMatch to support case insensitive glob style matching and Tcl_UniCharIs* character classification functions. (stanton) 5/20/99 (bug fix) Added the directory containing the executuble and the ../lib directory relative to that to the auto_path variable. (redman) --------------- Released 8.1.1, May 25, 1999 ---------------------- 5/21/99 (bug fix) Fixed launching command.com on Win95/98, no longer hangs. [Bug: 2105] (redman) 5/28/99 (bug fix) Fixed bug where dde calls were being passed an invalid dde handle. [Bug: 2124] (stanton) 6/1/99 (bug fix) Small configure.in patches. [Bug: 2121] (stanton) 6/1/99 (bug fix) Applied latest regular expression patches to fix an infinite loop bug and add support for testing whether a string could match with additional input. [Bug: 2117] (stanton) 6/2/99 (bug fix) Fixed incorrect computation of relative ordering in Utf case-insensitive comparison. [Bug: 2135] (stanton) 6/3/99 (bug fix) Fxied bug where string equal/compare -nocase reported wrong result on null strings. [Bug: 2138] (stanton) 6/4/99 (new feature) Windows build now uses Cygwin tools plus GNU make and autoconf to build static/dynamic and debug/nodebug. (stanton) 6/7/99 (new feature) Optimized string index, length, range, and append commands. Added a new Unicode object type. (hershey) 6/8/99 (bug fix) Rolled back Windows socket driver to 8.1.0 version. (stanton) 6/9/99 (new feature) Added Tcl_RegExpMatchObj and Tcl_RegExpGetInfo to public Tcl API, these functions are needed by Expect. Changed tools/genStubs.tcl to always write output in LF mode. (stanton) 6/14/99 (new feature) Merged string and Unicode object types. Added new public Tcl API functions: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendUnicodeToObj. (hershey) 6/16/99 (new feature) Changed to conform to TEA specification, added tcl.m4 and aclocal.m4 macro libraries for configure. (wart) 6/17/99 (new feature) Added new regexp interfaces: -expanded, -line, -linestop, and -lineanchor switches. Renamed Tcl_RegExpMatchObj to Tcl_RegExpExecObj and added new Tcl_RegExpMatchObj that is equivalent to Tcl_RegExpMatch. Added public macros for regexp flags. Added REG_BOSONLY flag to allow Expect to iterate through a string and only find matches that start at the current position within the string. (stanton) 6/21/99 (bug fix) Fixed memory leak in TclpThreadCreate where thread attributes were not being released. [Bug: 2254] (stanton) 6/23/99 (new feature) Updated Unicode character tables to reflect Unicode 2.1 data. (stanton) 6/25/99 (new feature) Fixed bugs in non-greedy quantifiers for regular expression code. (stanton) 6/25/99 (new feature) Added initial implementation of new Tcl test harness package. Modified test files to use new tcltest package. (jenn) 6/26/99 (new feature) Applied patch from Peter Hardie to add poke command to dde and changed the dde package version number to 1.1. (redman) 6/28/99 (bug fix) Applied patch from Peter Hardie to fix problem in Tcl_GetIndexFromObj() when the key being passed is the empty string. [Bug: 1738] (redman) 6/29/99 (new feature) Added options to tcltest package: -preservecore, -limitconstraints, -help, -file, -notfile, and flags. (jenn) 7/3/99 (new feature) Changed parsing of variable names to allow empty array names. Now "$(foo)" is a variable reference. Previously you had to use something line $::(foo), which is slower. This change was requested by Jean-Luc Fontaine for his STOOOP package. (welch) 7/3/99 (new feature) Added Tcl_SetNotifier (public API) and associated hook points in the notifiers to be able to replace the notifier calls at runtime. The Xt notifier and test program use this hook. (welch) 7/3/99 (new feature) Added a new variant of the "Trf core patch" from Andreas Kupries that adds new C APIs Tcl_StackChannel, Tcl_UnstackChannel, and Tcl_GetStackedChannel. This allows the Trf extension to work without applying patches to the Tcl core. (welch) 7/6/99 (new feature) Added -timeout option to http.tcl to handle timeouts that occur during connection attempts to hosts that are down. (welch) 7/6/99 (bug fix) Applied new implementation of the Windows serial port driver from Rolf Schroedter that fixes reading only one byte from the port at a time. Uses polling every 10ms to implement fileevents. [Bug: 1980 2217] (redman) 7/8/99 (bug fix) Applied fix for bug in DFA state caching under lookahead conditions (regular expressions). [Bug: 2318] (stanton) 7/8/99 (bug fix) Fixed bug in string range bounds checking code. (stanton) --------------- Released 8.2b1, July 14, 1999 ---------------------- 7/16/99 (bug fix) Added Tcl_SetNotifier to stub table. [Bug: 2364] Added check for Alpha/Linux to correct the IEEE floating point flag, patch from Don Porter. (redman) 7/20/99 (bug fix) Merged 8.0.5 code to handle tcl_library properly, also fixed a bug that caused TCL_LIBRARY to be ignored. (hershey) 7/21/99 (bug fix) Implemented modified socket driver for Windows that uses a thread to manage the socket event window. Code works the same on all supported versions of Windows and was based on original 8.1.0 code. [Bug: 2178 2256 2259 2329 2323 2355] (redman) 7/21/99 (new feature) Applied patch from Rolf Schroedter to add -pollinterval option to fconfigure for Windows serial ports. Allows the maxblocktime to be modified to control how often serial ports are checked for fileevents. Also added documentation for \\.\comX notation for opening serial ports on Windows. (redman) 7/21/99 (bug fix) Changed APIs in stub tables to use "unsigned long" instead of the platform-specific "size_t", primarily after SunOS 4 users could no longer compile. (redman) 7/22/99 (bug fix) Fixed crashing during "array set a(b) {}". [Bug: 2427] (redman) 7/22/99 (bug fix) The install-sh script must be given execute permissions prior to running. [Bug: 2413] (redman) 7/22/99 (bug fix) Applied patch from Ulrich Ring to remove ANSI-style prototypes in the code. [Bug: 2391] (redman) 7/22/99 (bug fix) Added #if blocks around #includes of sys/*.h header files, to allow an extension author on Windows to use the MetroWerks compiler. [Bug: 2385] (redman) 7/22/99 (bug fix) Fixed running the safe.test test suite, one change to the Windows Makefile.in to fix paths and another in safe.test to check for the tcl_platform(threaded) variable properly. (redman) 7/22/99 (bug fix) Fixed hanging in new Win32 socket driver with threads enabled. (redman) 7/26/99 (bug fix) Fixed terminating of helper threads by holding any mutexes from the primary thread while waiting for the helper thread to terminate. Fixes dual-CPU WinNT hangs, only one rare sporadic hang that still exists with dual-CPU WinNT. Also fixed test cases so that they would not depend as much on timing for dual-CPU WinNT. (redman) 7/27/99 (bug fix) Some test suite cleanup. (jenn) 7/29/99 (bug fix) Applied patch to fix typo in .SH NAME line in doc/Encoding.n [Bug: 2451]. Applied patch to avoid linking pack.n to pack-old.n [Bug: 2469]. Patches from Don Porter. (redman) 7/29/99 (bug fix) Allow tcl to open CON and NUL, even for redirection of std channels. [Bug: 2393 2392 2209 2458] (redman) 7/30/99 (bug fix) Applied fixed Trf patch from Andreas Kupries. [Bug: 2386] (hobbs) 7/30/99 (bug fix) Fixed bug in info complete. [Bug: 2383 2466] (hobbs) 7/30/99 (bug fix) Applied patch to fix threading on Irix 6.5, patch provided by James Dennett. [Bug: 2450] (redman) 7/30/99 (bug fix) Fixed launching of 16bit applications on Win9x from wish. The command line was being primed with tclpip82.dll, but it was ignored later. 7/30/99 (bug fix) Added functions to stub table, patch provided by Jan Nijtmans. [Bug: 2445] (hobbs) 8/1/99 (bug fix) Changed Windows socket driver to terminate threads by sending a message to the window rather than calling TerminateThread(), which seems to leak about 4k from the helper thread's stack space. (redman) --------------- Released 8.2b2, August 5, 1999 ---------------------- 8/4/99 (bug fix) Applied patches supplied by Henry Spencer to greatly enhance performance of certain classes of regular expressions. [Bug: 2440 2447] (stanton) 8/5/99 (doc change) Made it clear that tcl_pkgPath was not set for Windows. [Bug: 2455] (hobbs) 8/5/99 (bug fix) Fixed reference to bytes that might not be null terminated in tclLiteral.c. [Bug: 2496] (hobbs) 8/5/99 (bug fix) Fixed typo in http.tcl. [Bug: 2502] (hobbs) 8/9/99 (bug fix) Fixed test suite to handle larger integers (64bit). Patch from Don Porter. (hobbs) 8/9/99 (documentation fix) Clarified Tcl_DecrRefCount docs [Bug: 1952]. Clarified array pattern docs [Bug: 1330]. Fixed clock docs [Bug: 693]. Fixed formatting errors [Bug: 2188 2189]. Fixed doc error in tclvars.n [Bug: 2042]. (hobbs) 8/9/99 (bug fix) Fixed path handling in auto_execok [Bug: 1276] (hobbs) 8/9/99 (internal api change) Removed the TclpMutexLock and TclpMutexUnlock APIs and added a new exported api, Tcl_GetAllocMutex. These APIs are all for the mutex used in the simple memory allocators. By making this change we are able to substitute different implementations of the thread-related APIs without having to recompile the Tcl core. (welch) 8/9/99 (new C API) Tcl_GetChannelNames returns a list of open channel names in the interpreter result. Still no Tcl-level version of this, but server-like applications can use this to clean up files without deleting interpreters. (welch) 8/9/99 (bug fix) Traces were not firing on "info exists", which used to happen in Tcl 7.6 and earlier. An "info exists" now fires a read trace, if defined. This makes it possible to fully implement variables that are defined via traces. (welch) 8/10/99 (bug fix) Fixed Brent's changes so that they work on Windows. (redman) --------------- Released 8.2b3, August 11, 1999 ---------------------- 8/12/99 (Mac) Rearrange projects in tclMacProjects.sea.hqx so that the build directory is separate from the sources. (Jim Ingham) 8/12/99 (bug fix) Fixed bug in Tcl_EvalEx where the termOffset was not being updated in cases where the evaluation returned a non TCL_OK error code. [Bug: 2535] (stanton) --------------- Released 8.2.0, August 17, 1999 ---------------------- 9/21/99 (config fixes) fixed several AIX configuration issues. gcc and threading may still cause problems on AIX. (hobbs) 9/21/99 (bug fix) fixed expr double-eval problem. [Bug: 732] (hobbs) 9/21/99 (bug fix) fixed static buffer overflow problem. [Bug: 2483] (hobbs) 9/21/99 (bug fix) fixed end-int linsert interpretation. [Bug: 2693] (hobbs) 9/21/99 (bug fix) fixed bug when setting array in non-existent namespace. [Bug: 2613] (hobbs) --- Released 8.2.1, October 04, 1999 --- See ChangeLog for details --- 10/30/99 (feature enhancement) new regexp engine from Henry Spencer was patched in - should greatly reduce stack space usage. (spencer) 10/30/99 (bug fix) fixed Purify reported memory leaks in findexecutable test command, TclpCreateProcess on Unix, in handling of C environ array, and in testthread code. No more known (reported) mem leaks for Tcl built using gcc on Solaris 2.5.1. Also none reported for Tcl on NT (using Purify 6.0). (hobbs) 10/30/99 (bug fix) fixed improper bytecode handling of 'eval {set array($unknownvar) 5}' (also for incr) (hobbs) 10/30/99 (bug fix) fixed event/io threading problems by making triggerPipe non-blocking (nick kisserbeth) 10/30/99 (bug fix) fixed Tcl_AppendStringsToObjVA and Tcl_AppendResultVA to only iterates once over the va_list (avoiding non-portable memcpy). (joe english, hobbs) 10/30/99 (bug fix) removed savedChar trick in tclCompile.c that appeared to be causing a segv when the literal table was released. [Bug: 2459, 2515] (David Whitehouse) 10/30/99 (bug fix) fixed [string index] to return ByteArrayObj when indexing into one (test case string-5.16) [Bug: 2871] (hobbs) 10/30/99 (bug fix) fixes for mac UTF filename handling (ingham) --- Released 8.2.2, November 04, 1999 --- See ChangeLog for details --- 11/19/99 (feature enhancement) bug fixes for http package as well as patch required by TLS (SSL) extension that adds http::(un)register and -type to http::geturl. Up'd http pkg version to 2.2. 11/19/99 (bug fix) removed extra decr of numLevels in Tcl_EvalObjEx that could cause seg fault (mjansen@wendt.de) 11/19/99 (bug fixes) numerous minor big fixes, including correcting the installation of the koi8-r encoding and tcltest1.0 on Windows. 11/30/99 (bug fix) fixes scan where %[..] didn't match anything 11/30/99 (bug fix) fixed setting of isNonBlocking flag in PipeBlockModeProc so you can now close a non-blocking channel without waiting. 11/30/99 (bug work-around) prevented the unloading of DLLs for Unix in TclFinalizeLoad. This stops the seg fault on exit that some users would see (ie with oratcl) when using DLLs that do nasty things like register atexit handlers. 12/07/99 (bug fix) fixes for 'expr + {[incr]}' and 'expr + {[error]}' cases (different causes). --- Released 8.2.3, December 16, 1999 --- See ChangeLog for details --- 1999-09-14 (feature enhancement) added -start switch to regexp and regsub. 1999-09-15 (feature enhancement) add 'array unset' command. 1999-09-15 (feature enhancement) rewrote runtime libraries to use new string functions 1999-08-18 (feature enhancement) added 'file channels' command, along with Tcl_GetChannelNames(Ex) public C APIs. 1999-10-19 (feature enhancement) enhanced tcltest package 1999-09-16 (feature enhancement) added -milliseconds switch to 'clock clicks' 1999-10-28 (feature enhancement) added support for inline 'scan' 1999-10-28 (feature enhancement) added support for touch functionality by extendeding 'file atime' and 'file mtime' to take an optional time argument 1999-11-24 (feature enhancement) added 'fconfigure $sock -lasterror' command to Windows to query the last error received on a serial socket. 1999-11-30 (bug fix) fixed handling of %Z on NT for timezones that don't have DST 1999-12-03 (feature enhancement) improved error message in bad octal cases and improper use of comments. (hobbs) 1999-12-07 (bug fix) fixed Tcl_ScanCountedElement to not step beyond the end of the counted string 1999-12-09 (feature enhancement) removed all references to 16 bit compatibility code for Windows (hobbs) 1999-12-10 (bug fix) removed check for vfork - Tcl now uses only fork in exec. (hobbs) 1999-12-10 (optimization) changed Tcl_ConcatObj to return a list object when it receives all pure list objects as input (used by 'concat'), added optimizations in Tcl_EvalObjEx for pure list case, and optimized INST_TRY_CVT_TO_NUMERIC in TclExecuteByteCode for boolean objects. (oakley, hobbs) 1999-12-12 (feature enhancement) enhanced glob command with -type, -path, -directory and -join switches. (darley, hobbs) 1999-12-21 (bug fix) changed CreateThread to _beginthreadex and ExitThread to _endthreadex to prevent 4K mem leak (gravereaux) 1999-12-21 (bug fix) fixed applescript for I18N 1999-12-21 (feature enhancement) added -unique option to lsort (hobbs) 1999-12-21 (bug fix) changed thread ids to longs (for 64bit systems) --- Released 8.3b1, December 22, 1999 --- See ChangeLog for details --- 2000-01-10 (feature enhancement) clock scan now supports the common ISO 8601 date/time formats. See docs for details. (melski) 2000-01-10 (bug fix) prevented \ooo substitution from accepting non-octal digits [Bug: 3975] (hobbs) 2000-01-11 (bug fix) fixed improper handling of DST by clock when using relative times (like "1 month" or "tomorrow"). (melski) 2000-01-12 (bug fix) improved build support for Tru64 v5, NetBSD and Reliant Unix (hobbs) 2000-01-12 (bug fix) made imported commands also import their compile procedure (duffin) 2000-01-12 (bug fix) fixed 'info procs ::namesp::*' behavior to return procs in a namespace (dejong) 2000-01-12 (feature enhancement) added support for setting permissions symbolicly (like chmod) in [file attributes $file -permissions ...] (schoebel) 2000-01-13 (bug fix) fixed lsort -dictionary problem when sorting characters between 'Z' and 'a' (flawed upper/lower comparison logic) (melski) --- Released 8.3b2, January 13, 2000 --- See ChangeLog for details --- 2000-01-14 (feature enhancement) clock format %Q added, clock scan updated 2000-01-20 (bug fix) corrected complex array elem compiling (Spjuth) 2000-01-20 (bug fix) made [info body] always return a string type arg, to prevent possible misuse of bytecodes in the wrong context (hobbs) 2000-01-20 (bug fixes) several fixes to variable handling to prevent possible crashes, and further definition of correct behavior (melski) 2000-01-25 (bug fixes) improved QNX, Ultrix and OSF1 (Tru64) config and compatibility (edge, furukawa) 2000-01-25 (bug fix) fixed mem leak when calling lsort with a bad -command argument (hobbs) 2000-01-27 (feature enhancement) package mechanism overhaul: changed behavior of pkg_mkIndex to do -direct by default, added -lazy option. Fixed pkg_mkIndex to handle odd proc names and auto_mkIndex to use platform independent file paths. Other fixes for odd package quirks. Added ::pkg namespace and ::pkg::create helper function. (melski) 2000-02-01 (bug fix) fixed problem where http POST would send one extra newline (vasiljevic) 2000-02-02 (feature enhancement) added docs for new regexp -inline and -all switches. (hobbs) 2000-02-08 (bug fix) corrected handling of "next monthname" in clock scan (melski) 2000-02-09 (bug fix) restored Mac source to build readiness and prevented mac panic from an error when closing an async socket (steffen, ingham) 2000-02-10 (feature enhancement) improved error reporting for failed loads on Windows (dejong, hobbs) --- Released 8.3.0, February 10, 2000 --- See ChangeLog for details --- 2000-03 (bug fixes, feature enhancement) overhaul of http package for proper handling of async callbacks (new options), version is now at 2.3 (tamhankar, welch) 2000-03 (performance enhancement) speedup in Windows filename handling (newman) and ==/!= empty string in exprs. (hobbs) 2000-03-27 (bug fix) added uniq'ing test to namespace export list to prevent unnecessary mem growth (hobbs) 2000-03-29 (bug fix) fixed mem leak when repeatedly sourcing the same bytecompiled (tbc) code repeatedly across different interpreters (hobbs) 2000-03-29 (config enhancement) improved build support for gcc/mingw on Windows (nijtmans, hobbs) and added RPM target (melski) 2000-03-31 (bug fix) corrected data encoding problem when using "exec << $data" construct (melski) 2000-04 (feature enhancement) overhaul of threading mechanism to better support tcl level thread command (new APIs Tcl_ConditionFinalize, Tcl_MutexFinalize, Tcl_CreateThread, etc, all docs in Thread.3). (kupries, graveraux) This enables the tcl level thread extension. (welch) 2000-04-10 (bug fix) fixed infinite loop case in regexp -all (melski) 2000-04-13 (config enhancement) added support for --enable-64bit-vis Sparc target. (hobbs) 2000-04-18 (bug fix) moved tclLibraryPath to thread-local storage to fix possible race condition on MP machines (hobbs) 2000-04-18 (config enhancement) added MacOS X build target and tclLoadDyld.c dl type. (sanchez) 2000-04-23 (bug fix) several Mac socket fixes (ingham) 2000-04-24 (bug fix) fixed hang in threaded Unix case when backgrounded exec process was running (dejong) --- Released 8.3.1, April 26, 2000 --- See ChangeLog for details --- 2000-04-26 (doc fix) updated/added documentation for many API's and commands (melski) 2000-05-02 (feature enhancement) added support for joinable threads; extended API's for channels to allow channels to move between threads (kupries) 2000-05-02 (feature enhancement) changed error return for procedures with incorrect args to be like the Tcl_WrongNumArgs API, with a "wrong # args: ..." message printed, with an args list (hobbs) 2000-05-08 (feature enhancement) added [array statistics] command 2000-05-08 (performance enhancement) rewrote Tcl_StringCaseMatch algorithm for better performance; this affects the [string match] command; added "eq" and "ne" operands to expr, for testing string equality and inequality (hobbs) 2000-05-09 (feature enhancement) extended [lsearch] to support sorted list searches and typed list searches (melski) 2000-05-10 (feature enhancement) added [namespace exists] command (darley) 2000-05-18 (build enhancement) added support for mingw compile env and cross-compiling (dejong) 2000-05-18 (bug fix) corrected clock grammar to properly handle the "ago" keyword when it follows multiple relative unit specifiers (melski) 2000-05-22 (compile fix) type cast cleanups (dejong) 2000-05-23 (performance enhancement) added byte-compiled implementation of [return] command and [string] command (melski) 2000-05-26 (performance enhancement) extended byte-compiled [string] command with support for [string compare/index/match] (hobbs) 2000-05-27 (feature enhancement) added ability to set [info script] return value ([info script ?newFileName?]) (welch) 2000-05-31 (feature enhancement) added support for regexp and exact pattern matching for [array names] (gazetta) 2000-05-31 (feature enhancement) added -nocomplain and -- flags to [unset] to allow for silent unset operation (hobbs) --- Released 8.4a1, June 6, 2000 --- See ChangeLog for details --- 2000-05-29 (bug fix) corrected resource cleanup in http error cases. Improved handling of error cases in http. (tamhankar) 2000-07 (feature rewrite) complete rewrite of the Tcl IO channel subsystem to correct problems (hangs, core dumps) with the initial stacked channel implementation. The new system has many more tests for robustness and scalability. There are new C APIs (see Tcl_CreateChannel), but only stacked channel drivers are affected (ie: TLS, Trf, iogt). The iogt extension has been added to the core test code to test the system. (hobbs, kupries) **** POTENTIAL INCOMPATABILITY **** 2000-07 (build improvements) cleanup of the makefiles and configure scripts to correct support for building under gcc for Windows. (dejong) 2000-08-07 (bug fix) corrected sizeof error in Tcl_GetIndexFromObjStruct. (perkins) 2000-08-07 (bug fix) correct off-by-one error in HistIndex, which was causing [history redo] to start its search at the wrong event index. (melski) 2000-08-07 (bug fix) corrected setlocale calls for XIM support and locale issues in startup. (takahashi) 2000-08-07 (bug fix) correct code to handle locale specific return values from strftime, if any. (wagner) 2000-08-07 (bug fix) tweaked grammar to properly handle the "ago" keyword when it follows multiple relative unit specifiers, as in "2 days 2 hours ago". (melski) 2000-08-07 (doc fixes) numerous doc fixes to correct SEE ALSO and NAME sections. (english) 2000-08-07 (bug fix) new man pages memory.n, TCL_MEM_DEBUG.3, Init.3 and DumpActiveMemory.3. (melski) --- Released 8.3.2, August 9, 2000 --- See ChangeLog for details --- 2000-06 thru 2000-11 (build improvements) Added support for mingw (gcc on Windows), AIX-5 and Win64 builds (dejong, hobbs) 2000-06-23 (feature enhancement) ability to use Tcl_Obj *s as hash keys (duffin) 2000-06-29 (new features) added [mcmax] and [mcmset] and extended [unknown] in msgcat package (duperval, krone, nelson) => msgcat 1.1 2000-08 thru 2000-09 added tclPlatDecls.h to default install (melski, hobbs) 2000-08-24 (new feature) Enhanced trace syntax to add: trace {add|remove|list} {variable|command} name ops command (darley, melski) 2000-09-06 (cross-platform feature) Set ^Z (\32) as default EOF char. (hobbs) 2000-09-07 partial fix for bug 2460 to prevent exec mem leak on Windows for the common case (gravereaux) 2000-09-14 Improved string allocation growth for large strings (hintermayer, melski) 2000-09-14 New non-panic'ing mem allocation functions Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_AttemptSetObjLength (melski) 2000-09-20 (new features) completely new, enhanced syntax in tcltest package. Backwards compatable with tcltest v1. (hom) => tcltest 2.0 2000-09-27 (bug fix) fixed a bug introduced by a partial fix in 8.3.2 that didn't set nonBlocking correctly when resetting the flags for the write side (mem leak) Correct mem leak in channels when statePtr was released (hobbs) 2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason) 2000-10-06 (bug fix) corrected [file channels] to only return channels in the current interpreter (hobbs) 2000-10-20 (performance enhancement) call stat only when necessary in 'glob' to speed up command significantly in base cases (hobbs) 2000-10-27 Fixed mem leak in Tcl_CreateChannel. Re-purified core via test suites. (hobbs) 2000-10-30 (new feature) add "ja_JP.eucJP" map to "euc-jp" encoding (takahashi) 2000-11-01 (mem leak) Corrected excessive mem use of info exists on a non-existent array element (hobbs) 2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded environment (gravereaux) 2000-11-03 (new feature) Tcl_SetMainLoop enables defining an event loop for tclsh. This enables Tk as a truly loadable package. (hobbs) --- Released 8.4a2, November 3, 2000 --- See ChangeLog for details --- 2000-09-27 (bug fix) fixed a bug introduced by a partial fix in 8.3.2 that didn't set nonBlocking correctly when resetting the flags for the write side (mem leak) Correct mem leak in channels when statePtr was released (hobbs) 2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason) 2000-10-06 (bug fix) corrected [file channels] to only return channels in the current interpreter (hobbs) 2000-10-20 (performance enhancement) call stat only when necessary in 'glob' to speed up command significantly in base cases (hobbs) 2000-11-01 (mem leak) Corrected excessive mem use of info exists on a non-existent array element (hobbs) 2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded environment (gravereaux) 2000-11-23 (mem leak) fixed potential memory leak in error case of lsort (fellows) 2000-12-09 (feature enhancement) changed %o and %x to use strtoul instead of strtol to correctly preserve scan<>format conversion of large integers (hobbs) Fixed handling of {!} in expressions (hobbs, fellows) 2000-12-14 (feature enhancement) improved (s)rand for 64-bit platforms (porter) 2001-01-04 (bug fix) corrected parsing of $tcl_libPath at startup on Windows (porter) 2001-01-30 (bug fix) Fixed possible hangs in fcopy. (porter) 2001-02-15 (performance enhancement) improved efficiency of [string split] (fellows) 2001-03-13 (bug fix) Correctly possible memory corruption in string map {} $str (fellows) 2001-03-29 (bug fix) prevent potential race condition and security leak in tmp filename creation on Unix. (max) Fixed handling of timeout for threads (corrects excessive CPU usage issue for Tk on Unix in threaded Tcl environment). (ruppert) 2001-03-30 (bug fix) corrected Windows memory error on exit (wu) Fixed race condition in readability of socket on Windows. 2001-04-03 (doc fixes) numerous doc corrections and clarifications. Update of READMEs. 2001-04-04 (build improvements) redid Mac build structure (steffen) Corrected IRIX-5* configure (english). Added support for AIX-5 (hobbs). Added support for Win64 (hobbs). --- Released 8.3.3, April 6, 2001 --- See ChangeLog for details --- 2000-11-23 (new feature)[TIP 7] higher resolution timer on Windows (kenny) 2001-01-18 (new feature) Tcl_InitHashTableEx renamed to Tcl_InitCustomHashTable (kupries) 2001-03-30 (new feature)[TIP 10] support for thread-aware/hot channels (kupries) 2001-04-06 (new feature)[219280] auto-loading hidden in ::errorInfo (porter) 2001-04-07 (bug fix)[406709] corrected panic when extra items left on the byte compiler execution stack (sofer) 2001-04-09 (bug fix)[219136,232558] improved use of thread-safe functions in unix time commands (kenny) 2001-04-24 (new feature)[TIP 27] started CONST-ification of the Tcl APIs (kenny) 2001-05-03 (new feature) [auto_import] now matches patterns like [namespace import], not like [string match] (porter) **** POTENTIAL INCOMPATABILITY **** 2001-05-07 (new feature)[416643] distinct srand() seed per interp (sofer) 2001-05-15 (new feature) new Tcl_GetUnicodeFromObj API (hobbs) 2001-05-16 (performance enhancement) byte-compiled versions of [lappend], [append] simple cases (hobbs) 2001-05-23 (new feature) added ISO-8859-15 and koi8-u encodings, updated other encoding tables based on http://www.unicode.org/Public/MAPPINGS/ (kuhn) 2001-05-27 (new feature) updated to Unicode 3.1.0 data set (still using 16 bits for Tcl_UniChar though) (hobbs) 2001-05-30 (new feature)[TIP 15] Tcl_GetMathFuncInfo, Tcl_ListMathFuncs, Tcl_InfoObjCmd, InfoFunctionsCmd APIs (fellows) 2001-06-08 (bug fix,feature enhancement)[219170,414936] all Tcl_Panic definitions brought into agreement (porter) 2001-06-12 (bug fix)[219232] regexp returned non-matching sub-pairs to have index pair {-1 -1} (fellows) 2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII characters. (hobbs, riefenstahl) 2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer) 2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings (hobbs, barras) 2001-07-12 (new feature)[TIP 36] Tcl_SubstObj API (fellows) 2001-07-16 (bug fix) corrected thread-enabled pipe closing on Windows (hobbs, jsmith) 2001-07-18 (bug fix)[427196] corrected memory overwrite error when buffer size of a channel is changed after channel use has already begun (kupries, porter) 2001-07-31 (new feature)[TIP 17] TclFS* APIs provide new virtual file system. This includes the addition of 'file normalize', 'file system', 'file separator' and 'glob -tails' (darley) 2001-08-06 (bug fix) removed use of tmpnam in TclpCreateTempFile on Unix (lim) * improved build support for IRIX, GNU HURD, Mac OS 9 and OS X * configure scripts revamped for better support of cygwin and gcc on Windows (mdejong) * corrected several minor errors noted by Purify (hobbs) --- Released 8.4a3, August 6, 2001 --- See ChangeLog for details --- 2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII characters. (hobbs, riefenstahl) 2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer) 2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings (hobbs, barras) 2001-07-16 (bug fix) corrected thread-enabled pipe closing on Windows (hobbs, jsmith) 2001-07-18 (bug fix)[427196] corrected memory overwrite error when buffer size of a channel is changed after channel use has already begun (kupries, porter) 2001-08-06 (bug fix)[442665] corrected object reference counting in [gets] (jikamens) 2001-08-06 (new feature) added GNU (HURD) configuration target. (brinkmann) 2001-08-07 (bug fix)[406709] corrected panic when extra items left on the byte compiler execution stack (see test foreach-5.5) (sofer, tallneil, jstrot) 2001-08-08 (new features) updated packages msgcat 1.1.1, opt 0.4.3, tcltest 1.0.1, dependencies checked (porter) 2001-08-20 (new feature)[452217] http 2.3.2: include port number in Host: header to comply with HTTP/1.1 spec (RFC 2068) (hobbs, tils) 2001-08-23 (new feature) added QNX-6 build support (loverso) 2001-08-23 (bug fix) corrected handling of spaces in path name passed to [exec] on Windows (kenpoole) 2001-08-24 (bug fix) corrected [package forget] stopping on non-existent package (porter) 2001-08-24 (bug fix) corrected construction of script library search path relative to executable (porter) 2001-08-24 (bug fix) [auto_import] now matches patterns like [namespace import], not like [string match] (porter) **** POTENTIAL INCOMPATABILITY **** 2001-08-27 (new feature) added Tcl_SetMainLoop() to enable loading Tk as a true package (hobbs) 2001-08-30 (bug fix) build support for Crays (andreasen) 2001-09-01 (bug fix) rewrite of Tcl_Async* APIs to better manage thread cleanup (gravereaux) 2001-09-06 (new feature) http 2.4: honor the Content-encoding and charset parameters; add -binary switch for forcing the issue (hobbs, saoukhi, orwell) => http 2.4 2001-09-06 (performance enhancement) rewrite of file I/O flush management on Windows. Approximately 100x speedup for some operations. (kupries, traum) 2001-09-10 (bug fix) corrected finalization error in TclInExit (darley) 2001-09-10 (bug fix) protect against alias loops (hobbs) 2001-09-12 (bug fix) added missing #include in tclLoadShl.c (techentin) 2001-09-12 (bug fix) script library path construction on Windows no longer uses registry, nor adds the current working directory to the path (porter) 2001-09-12 (bug fix) correct bugs in compatibility strtod() (porter) 2001-09-13 (bug fix) Tcl_UtfPrev now returns the proper location when the middle of a UTF-8 byte is passed in (hobbs) 2001-09-19 (bug fix) [format] and [scan] corrected for 64-bit machines (rmax) 2001-09-19 (new feature) --enable-64-bit support for HP-11. (hobbs) 2001-09-19 (new feature) native memory allocator now default on Windows (hobbs) 2001-09-20 (new feature) WIN64 support and extra processor definitions (hobbs, mstacy) 2001-09-26 (bug fix) corrected potential deadlock in channels that do not provide a BlockModeProc (kupries, kogorman) 2001-10-03 (new feature) WIN64 build support (hobbs) 2001-10-03 (bug fix) correction in thread finalization (rbrunner) 2001-10-04 (new feature) updated encodings with latest mappings from www.unicode.org (hobbs) 2001-10-11 (bug fix) corrected cleanup of self-referential bytecodes at interpreter deletion (sofer, rbrunner) 2001-10-16 (new feature) config support for MacOSX / Darwin (steffen) 2001-10-16 (new feature, Mac) change in binary extension format from MachO bundles to standard .dylib dynamic libraries like on other unices. *** POTENTIAL INCOMPATIBILITY *** 2001-10-18 (bug fix) corrected off-by-one-day error in clock scan with relative months and years during swing hours. (lavana) --- Released 8.3.4, October 19, 2001 --- See ChangeLog for details --- 2001-08-21 (bug fix)[219184] overagressive compilation of [catch] (sofer) 2001-08-22 (new feature)[227482] [dde request -binary] (hobbs) => dde 1.2 2001-08-30 (performance enhancement)[456668] fully qualified command names use cached Command for all namespaces, avoiding repeated lookups (sofer) 2001-08-31 (performance enhancement) bytecompiled [list] (hobbs) 2001-09-02 (bug fix)[403553] Add -Zl to VC++ compile line for tclStubLib to avoid any specific C-runtime library dependence. (gravereaux) 2001-09-05 (new feature) restored support for Borland compiler (gravereaux) 2001-09-05 (new feature)[TIP 49] Tcl_OutputBuffered API (schroedter, fellows) 2001-09-07 (new feature) restored VC++ 5.0 compatibility (gravereaux) 2001-09-10 (performance enhancement)[TIP 53,451441] [proc foo args {}] now compiles to 0 bytecodes (sofer) 2001-09-13 (new feature)[TIP 56] Tcl_EvalTokensStandard API (sofer) 2001-09-13 (new feature) Old ChangeLog entries => ChangeLog.1999 (hobbs) 2001-09-17 (new feature) compiling with TCL_COMPILE_DEBUG now required to enable all compile and execution tracing (sofer) *** POTENTIAL INCOMPATIBILITY *** 2001-09-19 (bug fix)[411825] made TclNeedSpace UTF-8 aware (fellows) 2001-09-19 (bug fix)[219166] overagressive compilation of "quoted" bodies of [for], [foreach], [if], and [while] (sofer) 2001-09-19 (performance enhancement) bytecompiled [string match] (hobbs) 2001-10-15 (new feature)[TIP 35] serial channel configuration: Win (schroedter) 2001-11-06 (bug fix)[478856] loss of fileevents due to short reads (kupries) 2001-11-06 (new feature) revitalized makefile.vc (gravereaux) 2001-11-07 (new feature) Cygwin gcc support dropped. Use mingw (dejong) *** POTENTIAL INCOMPATIBILITY *** 2001-11-07 (new feature) Support --include-dir= and --libdir= options to configure. Store in tclConfig.sh as TCL_INCLUDE_SPEC and TCL_LIB_SPEC. (dejong) *** POTENTIAL INCOMPATIBILITY *** 2001-11-08 (new feature) Enable --enable-threads on FreeBSD (dejong) 2001-11-08 (new feature) New make target 'make gdb' (dejong) 2001-11-09 (bug fix)[480176] [global] mishandled varnames matching :* (porter) 2001-11-12 (new feature)[TIP 22,33,45] new command [lset], [lindex] extended to accept multiple indices. (kenny, hobbs) 2001-11-16 (new feature) new configure option --enable-langinfo=no. By default, nl_langinfo() is used on Unix to determine system encoding. Tcl's built-in system is used only if that fails, or configured with --enable-langinfo=no. (hobbs, wagner) 2001-11-19 (new feature)[TIP 62] A Tcl_VarTraceProc can now return Tcl_Obj * or a dynamic string as well as a static string to indicate an error (fellows) 2001-11-19 (new feature)[TIP 73] Tcl_GetTime API (kenny) 2001-11-19 (bug fix)[478847] overflows in [time] of >2**31 microseconds (kenny) 2001-11-29 (performance enhancement) caching scheme added to [binary scan] (fellows) 2001-12-05 (new feature) new algorithm for [array get] adds safety when read traces modify the array. (sofer) *** POTENTIAL INCOMPATIBILITY *** 2001-12-10 (bug fix)[490514] doc fixes (porter,english) 2001-12-18 (new feature) removed unix/dltest/configure; unix/configure does all (dejong) 2001-12-19 (new feature) New make target 'make shell' (dejong) 2001-12-21 (new feature) MaxOSX / Darwin support (steffen) 2001-12-28 (new feature) new command [memory onexit] replaces [checkmem] when compiled with TCL_MEM_DEBUG. Added documentation. (porter) *** POTENTIAL INCOMPATIBILITY *** 2001-12-28 (bug fix) proper case in [auto_execok] use of $env(COMPSPEC) (hobbs) 2002-01-05 (feature rewrite) Tcl_Main() rewritten and documentation improved. Interactive operation and event loop operation (via Tcl_SetMainLoop) now interleave cleanly. Also more robust against strange happenings. (porter) 2002-01-17 (bug fix)[504642] Tcl_Obj refCounts in [gets] (griffen,kupries) 2002-01-21 (bug fix)[506297] infinite loop writing in iso2022-jap encoding (forssen,kupries) 2002-01-24 (HTTP server bug workaround)[504508] leave the default port out of the Host: header value => http 2.4.1 (hobbs) 2002-01-25 (new feature)[496733] socket options -eofchar and -translation return read-only values (dejong) 2002-01-28 (new feature) Old ChangeLog entries => ChangeLog.20900 (hobbs) 2002-01-28 (performance enhancement) bytecompiled [regexp] for trivial cases that amount to string matching. Also -nocase and --. (hobbs) 2002-02-05 (bug fix) [http::error] called when [::error] intended => http 2.4.2 (porter) 2002-02-05 (bug fix)[465765] avoid zero-byte writes to STREAMs (talcott,kupries) 2002-02-06 (performance enhancement) [regsub] special cases that map to [string map] detected. (hobbs) 2002-02-06 (bug fix)[495213] [scan] accept 0x as prefix of base 16 value (hobbs) 2002-02-10 (new feature)[TIP 32,79] Tcl_CreateObjTrace API (kenny) 2002-02-12 (new feature) partial support for DJGPP Tcl on DOS (gravereaux) 2002-02-14 (mem leak) Fixed leaking an empty Tcl_Obj when [gets $chan] errored out. (kupries, sofer) 2002-02-15 (new feature)[TIP 72] support for 64-bit integer values on 32-bit platforms and ability to work with >2GiB files. Extends many commands. See ChangeLog and TIP for details. *** POTENTIAL INCOMPATIBILITY *** 2002-02-22 (bug fix)[476537] Fix panic when loading shared library without proper use of stubs on platform without backlinking (porter) 2002-02-22 (new feature) 64-bit support for xlc compiler on AIX-4 (hobbs) 2002-02-22 (new feature)[521560] Removed limits on filename length and format [source]able through the Safe Base (hobbs) 2002-02-22 (performance enhancement) optimized bytecodes for [if], [for], [while] and constant conditions (sofer) 2002-02-22 (new feature)[TIP 76] [regsub] can now return result (fellows) 2002-02-25 (bug fix)[495207] buffer overrun when closing ] left out of argument to [subst] (sofer, english) 2002-02-25 (bug fix)[514392] [load] updated for Mac OS X 10.1 (steffen) 2002-02-26 (bug fix) [info hostname] choked on names >31 characters (hobbs) 2002-02-26 (new feature)[TIP 35] serial channel configuration: Unix (schroedter, hobbs) 2002-02-25 (bug fix)[483575] [fconfigure ... -error] now no-op on Mac (kupries) 2002-02-28 (performance enhancement)[458872] fully qualified command names use cached Command for all namespaces, avoiding repeated lookups (sofer) * (new feature)[TIP 27] completed CONST-ification of TCL APIs. Added compiler macro USE_NON_CONST to keep using those old API prototypes that present irreconcilable source incompatibilities with header files of prior Tcl releases. Others will need to be reconciled. *** POTENTIAL INCOMPATIBILITY *** 2002-03-04 (bug fix)[474358, 218099, 219314, 524674] fixed several problems related to the handling of iso2022 text and finalization of escape-based encodings. (taguchi, takahashi, hobbs) --- Released 8.4a4, March 5, 2002 --- See ChangeLog for details --- 2002-03-06 (new feature)[TIP 80] expanded [lsearch] options (wilkason, fellows) 2002-03-07 (new feature)[TIP 87] [interp recursionlimit] (trier) 2002-03-08 (platform feature) mingw 1.1 build favored (dejong) 2002-03-20 (new feature)[TIP 27] CONST-ified variable access functions (porter) 2002-03-24 (bug fix)[511666,511658,523217,530960] expanded Tcl_FSMatchInDirectory to handle assorted [glob] bugs in VFS. (darley) *** POTENTIAL INCOMPATIBILITY with prior 8.4a releases *** 2002-03-25 (bug fix)[495726] stopped tcltest disabling of auto-loading (porter) 2002-03-25 (bug fix)[495977] allow \n in test constraints (porter) 2002-03-27 (platform support)[527941,533862] VC/winhelp/W9X (spjuth, gravereaux) 2002-03-28 (bug fix)[219181] exception at level 0 issues (sofer) 2002-03-28 (bug fix)[219362] command termination; Tcl_CreateTrace (knoll,sofer) 2002-04-05 (bug fix)[536879] exceptions during variable subst (porter) 2002-04-15 (bug fix)[497446,513983] tcltest syntax errors now raised (porter) ***POTENTIAL INCOMPATIBILITY with prior tcltest 2.0.* (8.4aX)*** 2002-04-17 (bug fix)[495660] [(save|restore)state] deprecated (porter) 2002-04-17 (bug fix)[526524] escape-based encodings corrected (yamamoto, hobbs) 2002-04-18 (bug fix)[542588] [expr] error msgs improved (ehrens, sofer) 2002-04-18 (bug fix)[545325] [info level $level] now returns [namespace eval] as documented (suchenwirth,sofer) 2002-04-19 (bug fix)[544727] export [mcload]; ns context of [mcmax] (porter) => msgcat 1.2.3 2002-04-22 (performance enhancement) threaded memory allocator (AOL, hobbs) 2002-04-24 (new feature) TCLTK_NO_LIBRARY_TEXT_RESOURCES #define disables inclusion of tcl library code in resource fork on Mac. (steffen) 2002-05-21 (platform support) static libs on OSF (dejong) 2002-05-24 (bug fix)[557878] set encoding on listening socket (staplin, kupries) 2002-05-24 (new feature)[TIP 91] Tcl_Seek compatibility (fellows) 2002-05-28 (bug fix)[545579] VFS [load] left temp file (darley) 2002-05-28 (bug fix)[559376] plug timezone env leak on Windows (hobbs) 2002-05-29 (performance enhancement) [string compare] optimized (hobbs,fellows) 2002-05-31 (bug fix)[550534] plug interp leak in [pkg_mkIndex] (helmut) 2002-05-31 (dead code)[474335,555635] removed all use of matherr() (english) *** POTENTIAL INCOMPATIBILITY *** 2002-06-04 (new feature)[TIP 85,521362] custom result match in tcltest (markus, porter) => tcltest 2.1 2002-06-06 (bug fix)[524352] encoding, threading, and environment issues on MacOSX (steffen) 2002-06-06 (bug fix)[512214,558742,512214,461000] lazy initialization of tcltest constraints (porter) 2002-06-07 (bug fix)[563122,564595] EOVERFLOW definitions (fellows) 2002-06-11 (bug fix)[567386] [info locals] corrections (sofer) 2002-06-14 (new feature)[TIP 102] [trace list] renamed [trace info] (fellows) 2002-06-17 (new feature)[525522,525525] msgcat support for XPG4 locales; examination of LC_ALL, LC_MESSAGES environment variables (haible, porter) => msgcat 1.3 2002-06-17 (new feature)[565088] header files assume modern C compiler by default; older compilers may need configuration (english) *** POTENTIAL INCOMPATIBILITY *** 2002-06-17 (bug fix)[554068] [exec] argument quoting on Windows (darley) 2002-06-17 (new feature)[TIP 62,462580] command execution traces (lavana) 2002-06-19 (bug fix)[558324] regexp sets a linked variable (watson) * (performance enhancment) optimizations of bytecode execution (sofer) 2002-06-21 (new feature)[TIP 99,562970] new [file link] command (darley) 2002-06-24 (new feature)[TIP 101] new [tcltest::configure] command (porter) => tcltest 2.2 2002-06-25 (new feature) --enable-man-symlinks and --enable-man-compression options to configure (max) 2002-06-26 (bug fix)[565880] [clock format] now respects locale (max) *** POTENTIAL INCOMPATIBILITY *** 2002-07-03 (bug fix)[577015] [catch] catches even compile errors (sofer) --- Released 8.4b1, July 5, 2002 --- See ChangeLog for details --- 2002-07-08 (bug fix) restored compatibility of [viewFile] in tcltest (porter) 2002-07-11 (bug fix) [file normalize] returns long form on Win 95/98/ME (darley) 2002-07-15 (performance enhancment) variable operations rewritten to store and use cached Var pointers (sofer) 2002-07-22 (bug fix)[218000] Inf and Nan are floating-point values (fellows) 2002-07-23 (platform support)[219220] 64-bit compile on IRIX (dejong) 2002-07-25 (bug fix)[219218] return codes in background errors (english) 2002-07-28 (bug fix)[582522] alias fires exec traces (sofer) 2002-07-29 (bug fix)[578363] regexp (fellows,pvgoran) 2002-07-30 (bug fix)[584603] WriteChars infinite loop non-UTF-8 string (kupries) 2002-08-04 (new feature)[584051,580433,585105,582429][TIP 27] Tcl interfaces are now fully CONST-ified. Use the symbols USE_NON_CONST or USE_COMPAT_CONST to select interfaces with fewer changes. *** POTENTIAL INCOMPATIBILITY *** 2002-08-05 (bug fix)[589859] tcltest setup and cleanup scripts skipped when test body is skipped (porter) => tcltest 2.2 2002-08-07 (bug fix)[587488] mem leak with USE_THREAD_ALLOC (sofer,sass) 2002-08-07 (feature enhancement)[584794,584650,472576] boolean values are no longer always re-parsed from string. (sofer) Many internal bugs fixed. Considerable cleanup of the test suite. --- Released 8.4b2, August 9, 2002 --- See ChangeLog for details --- 2002-08-20 (new feature) --enable-memdebug configure option (kupries) 2002-08-23 (bug fix)[597936] mem leak with USE_THREAD_ALLOC (sofer,zoran) 2002-08-26 (bug fix)[599788] segfault in compiler (sofer,wilkason) 2002-08-28 (bug fix)[414910] avoid mem leaks accessing environment variables on Windows (welton,gravereaux) 2002-08-31 (platform support)[TIP 108] Mac OS X port (steffen,ingham) 2002-09-02 (platfrom support) 64-bit compile on HP-11 (martin) --- Released 8.4.0, September 10, 2002 --- See ChangeLog for details --- 2002-09-18 (platform support) Updated support for compiling with Cygwin and either mingw or gcc. (khan, howell, dejong) 2002-09-22 (bug fix)[612786, 611922] Corrected [puts -nonewline] within test bodies. Also corrected reporting of body return code. Updated tcltest to v2.2.1. 2002-09-24 (bug fix)[613117] More robust 64-bit wide integer value detection (fellows) 2002-09-26 (bug fix) correct overeager optimization of noop proc to handle the precompiled case. (sofer, hobbs) 2002-09-26 (bug fix)[615115] removed extraneous spaces in koi8-u.enc that confused encoding reader. 2002-09-29 (bug fix)[219355] Added proper exiting conditions using Win32 console signals. This handles the existing lack of a Ctrl+C exit to call exit handlers when built for thread support. Also, properly handles exits from other conditions such as CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, and CTRL_SHUTDOWN_EVENT signals. In all cases, exit handlers will be called. (gravereaux) 2002-09-30 (bug fix) improve the checking for bad regular expressions during regexp compilation. Resultant compiles were correct, but much slower than necessary. (hobbs) 2002-10-01 (bug fix) fix precompiled locals to support 8.3 precompiled code. (hobbs) 2002-10-09 (bug fix)[620735] Added code to set an exit handler on Windows that terminates the thread that calibrates the performance counter, so that the thread won't outlive unloading the Tcl DLL. (kenny) 2002-10-09 (build support) all --enable-symbols to take the enhanced options yes|no|mem|compile|all. (hobbs) 2002-10-10 (build support) enable USE_THREAD_ALLOC (new threaded allocator) by default on Windows. (hobbs, gravereaux) 2002-10-14 (bug fix)[623269] correct possible mem leak in Tcl_PutEnv. (brouwers) 2002-10-15 (bug fix)[615043] fix in execution traces with idle tasks firing. (lavana) 2002-10-15 (platform support) Correct AIX-5 ppc and 4/5 64-bit build flags. Correct HP 11 64-bit gcc building. (martin, hobbs) 2002-10-17 (bug fix)[624755] Fixed code that check for proper # of args to [array names] (porter) 2002-10-18 (feature enhancement)[625453] Added support for broadcasting changes to the registry Environment on Windows. Updated registry package to v1.1. (hobbs) 2002-10-22 (platform support)[624509] On macosx, add embedded framework dirs to tcl_pkgPath: @executable_path/../Frameworks and @executable_path/../PrivateFrameworks (if they exist), as well as the dirs in DYLD_FRAMEWORK_PATH (if set). (steffen) --- Released 8.4.1, October 22, 2002 --- See ChangeLog for details --- 2002-10-28 (bug fix)[627660] [package unknown] chaining for platform specifics 2002-10-29 (bug fix)[627546] verbose [load] (dyld) error mesages on MacOSX 2002-11-01 (bug fix) [package provide registry] consistent versions. 2002-11-06 (bug fix)[582039] missing ar program -> configuration error 2002-11-06 (feature enhancement) added new TclInThreadExit function to test for thread exit vs whole process exit condition. The TclInExit function now correctly returns 1 during Tcl_Finalize processing. *** POTENTIAL INCOMPATIBILITY *** 2002-11-13 (bug fix)[615043] some execution traces were not firing 2002-11-18 (bug fix)[634856] multiple signs no longer accepted as valid integer [string is integer ++1] => 0 *** POTENTIAL INCOMPATIBILITY *** 2002-11-26 (bug fix)[593810,597924] clean exit of channel worker threads on Win 2002-11-28 (new feature) `make valgrind` target 2002-12-03 (bug fix)[615304] repeated load/unload of Tcl now possible 2002-12-11 (bug fix)[647307] negative return codes now propagated by procs 2002-12-11 (bug fix)[648441] syntax error in [expr 0x] now detected. 2003-01-07 (bug fix)[633204] [catch {return}] => 2 (not 0) 2003-01-09 (bug fix)[634151] [file (a|m)time $nonASCIIpath $time] now works 2003-01-16 (bug fix) dde eval with {} service name does not crash. => dde 1.2.1 2003-01-16 (bug fix)[635200,655645,615043,571385] many command trace fixes 2003-01-31 (bug fix)[675614,678415,676978] tcltest conflicts in cleanup and -outfile; also failure in space-containing path; also missing [close] => tcltest 2.2.2 2003-02-01 (bug fix)[670042] corrected [info loaded {}] for static packages in multiple interps. 2003-02-01 (bug fix)[675356] [clock clicks {}]; [clock clicks -] - syntax errs 2003-02-01 (bug fix)[656660] MT-safety for [clock format] 2003-02-03 (bug fix)[651271] command rename traces get fully-qualified names *** POTENTIAL INCOMPATIBILITY *** 2003-02-07 (performance improvement) [glob] on Windows is 2.5 times faster 2003-02-07 (feature change) lack of Cygwin support indicated by config error 2003-02-11 (bug fix)[684744] [info complete] stopped by \x00 2003-02-11 (bug fix)[685445] [glob -types l] missed broken symlinks on Unix 2003-02-11 (bug fix) [lsearch -regexp $a $a] doesn't crash 2003-02-13 (bug fix)[685926] accept non-ASCII7 for tcl_platform(user) on Win 2003-02-15 (bug fix)[673714] stop crash when Tcl_DeleteEvents deletes last 2003-02-15 (bug fix)[681841] parser missed some missing ] syntax errors 2003-02-17 (bug fix)[684756] memory leak during command rename plugged 2003-02-18 (bug fix)[689100] reduced per-thread memory overhead 2003-02-18 (platform support)[651811] use xnet library on HP 11 (64 bit). 2003-02-20 (bug fix)[Patch 689341] correct jis round-trip encoding 2003-02-20 (bug fix)[689835] stop MacOSX hang trying to read a write-only pipe 2003-02-07 (performance improvement) [tclPkgUnknown]: fewer vfs calls 2003-02-18 (platform support) cut and splice procs for file channels on Mac 2003-02-21 (bug fix)[690774] [binary scan] failed on some wide ints 2003-02-22 (bug fix)[571002] plugged data leak during thread exit 2003-02-25 (feature change) [pkg_mkIndex -load]: case-insensitive match *** POTENTIAL INCOMPATIBILITY *** 2003-02-27 (bug fix)[694232] stop [lsearch -start 0 {} x] segfault --- Released 8.4.2, March 3, 2003 --- See ChangeLog for details --- 2003-03-06 (bug fix)[699042] Correct case-insensitive unicode string comparison in Tcl_UniCharNcasecmp 2003-03-11 (bug fix) Corrected loading of tclpip8x.dll on Win9x 2003-03-12 (bug fix)[702383] Corrected parsing of interp create -- 2003-03-12 (bug fix)[685106] Correct Tcl_SubstObj handling of \x00 bytes 2003-03-14 (bug fix)[702622 699060] Correct wide int issues in 'format' 2003-03-14 (bug fix)[698146] Remove assumption that file times and longs are the same size. 2003-03-18 (bug fix)[697862] Allow Tcl to differentiate between reparse points which are symlinks and mounted drives on Windows 2003-03-19 (bug fix)[705406] Bad command count on TCL_OUT_LINE_COMPILE 2003-03-20 (bug fix)[707174] Store pointers to notifier funcs in a struct to work around some platform linker issues 2003-03-22 (bug fix)[708218] Load correct (non-)debug dll for dde or registry 2003-03-24 (bug fix)[631741 696893] Fixing ObjMakeUpvar's lookup algorithm for the created local variable 2003-04-07 (bug fix)[713562] Make sure that tclWideIntType is defined and somewhat sensible everywhere 2003-04-07 (bug fix)[711371] Corrected string limits of arguments interpolated in error messages for 'if' 2003-04-11 (bug fix)[718878] Corrected inconsistent results of [string is integer] observed on systems where sizeof(long) != sizeof(int) 2003-04-12 (bug fix) Substantial changes to the Windows clock synch phase-locked loop in a quest for improved loop stability 2003-04-16 [713562] Made changes so that the "wideInt" Tcl_ObjType is defined on all platforms, even those where TCL_WIDE_INT_IS_LONG is defined. Also made the Tcl_Value struct have a wideValue field on all platforms. Potential incompatibility for TCL_WIDE_INT_IS_LONG platforms because that struct changes size. *** POTENTIAL INCOMPATIBILITY *** 2003-04-25 (bug fix)[727271] Catch any errors returned by the Windows functions handling TLS ASAP instead of waiting to get some mysterious crash later on due to bogus pointers. 2003-04-29 (bug fix) Correct 'glob -path {[tcl]} *', where leading special character instead lists files in '/'. Bug only occurs on Windows where '\' is also a directory separator. 2003-05-09 (bug fix)[731754] Fixed memory leak in threaded allocator on Windows caused by treating cachePtr as a TLS index 2003-05-10 (bug fix)[710642] Ensure cd is thread-safe 2003-05-10 (bug fix)[718002] Correct mem leak on closing a Windows serial port 2003-05-10 (bug fix)[714106] Prevent string repeat crash when overflow sizes were given (throws error). 2003-05-13 (feature enhancement)[736774] Use new versioned bundle resource API to get tcl runtime library for TCL_VERSION on Mac OS X. 2003-05-13 (bug fix)[711232] Worked around the issue of realpath() not being thread-safe on Mac OS X by defining NO_REALPATH for threaded builds on Mac OS X. 2003-05-14 (bug fix)[557030] Correct handling of the gb2312 encoding by making it an alias of the euc-cn encoding and creating a gb2312-raw encoding for the original. Most uses of gb2312 really mean euc-cn. 2003-05-14 (bug fix)[736421] Corrected another putenv() copy behavior problem when compiling on Windows and using Microsoft's runtime. --- Released 8.4.3, May 20, 2003 --- See ChangeLog for details --- 2003-05-23 (bug fix)[726018] reverted internals change to the 'cmdName' Tcl_ObjType that broke several extensions (TclBlend, e4graph...) in the 8.4.3 release. 2003-06-10 (bug fix)[495830] stop eval of bytecode in deleted interp. 2003-06-17 (bug fix) corrections to regexp when matching emtpy string. 2003-06-25 (bug fix)[748957] -*ieee compiler flags for Tru64 builds. 2003-07-11 (bug fix) [pkg_mkIndex] indexes provided packages, not indexed ones. 2003-07-15 (feature enhancement) MacOSX build system rewrite. 2003-07-15 (bug fix)[771613] corrected segfault in [if] (buffer overflow) 2003-07-16 (bug fix)[756791] corrected assumption that Tcl_Free == free 2003-07-16 (feature enhancement) -DTCL_UTF_MAX=6 compile option forces internal UCS-4 representation of Unicode (default is recommended UCS-2). 2003-07-16 (bug fix)[767578] 64-bit corrections in thread notifier. 2003-07-16 (bug fix)[759607] Safe Base tests normalized paths. 2003-07-16 (feature enhancement)[Patch 679315] improved Cygwin path support 2003-07-18 (bug fix)[706359] corrected broken -output option of [tcltest::test] => tcltest 2.4.4 2003-07-18 (bug fix)[753315] MT-safety of VFS records. 2003-07-18 (bug fix)[759888] support for user:pass in URL by [http::geturl] => http 2.4.4 Improved documentation, new tests, and some code cleanup. [655300, 720634, 735364, 748700, 756112, 756744, 756951, 758488, 760768, 763312, 769895, 771539, 771840, 771947, 771949, 772333] --- Released 8.4.4, July 22, 2003 --- See ChangeLog for details --- 2003-07-23 (bug fix)[775976] fix registry compilation for VC7. 2003-08-05 (enhancement)[781585] Use Tcl_ResetResult in bytecodes to prevent potential costly Tcl_Obj duplication. 2003-08-06 (bug fix)[781609] prevent non-Windows platforms from trying to use the registry package inside msgcat. 2003-08-27 (bug fix)[411825] Fix TclNeedSpace to handle non-breaking space (\u00A0) and backslash escapes correctly. 2003-09-01 (bug fix)[788780] Fix thread-safety issues in filesystem records. 2003-09-19 (bug fix)[804681] Protect ::errorInfo and ::errorCode traces from corrupting stack. 2003-09-23 (bug fix)[218871] Fix handling of glob-sensitive chars in auto_load and auto_import. 2003-10-03 (bug fix)[811483] Fixed refcount management for command and execution traces. 2003-10-04 (bug fix)[789040] Fixed exec command.com error for Win9x. 2003-10-06 (bug fix)[767834, 813273] Fixed volumerelative file normalization and 'file join' inconsistencies. 2003-10-08 (bug fix)[769812] Fix Tcl_NumUtfChars string length calculation when negative parameter is given. 2003-10-22 (bug fix)[800106] Handle VFS mountpoints inside glob'd dirs. 2003-10-22 (bug fix)[599468] Watch for FD_CLOSE too on Windows when asked for writable events by the generic layer. 2003-10-23 (bug fix)[813606] Detect OS X pipes correctly. 2003-11-05 (bug fix)[832657] Allow .. in libpath initialization. 2003-11-11 (bug fix) Improve AIX-64 build configuration. 2003-11-17 (bug fix)[230589, 504785, 505048, 703709, 840258] fixes to various odd regexp "can't happen" bugs. --- Released 8.4.5, November 20, 2003 --- See ChangeLog for details --- 2003-12-02 (bug fix)[851747] object sharing fix in [binary scan] 2003-12-09 (platform support)[852369] update errno usage for recent glibc 2003-12-12 (bug fix)[858937] fix for [file normalize ~nobody] 2003-12-17 (bug fix)[839519] fixed two memory leaks (vasiljevic) 2004-01-09 (bug fix)[873311] fixed infinite loop in TclFinalizeFilesystem 2004-02-02 (bug fix)[405995] Tcl_Ungets buffer filling fix 2004-02-04 (bug fix)[833910] tcltest command line option parsing error => tcltest 2.4.5 2004-02-04 (bug fix)[833637] code error in tcltest -preservecore operation 2004-02-12 (feature enhancement) update HP-11 build libs setup 2004-02-17 (bug fix)[849514,859251] corrected [file normailze] of $link/.. 2004-02-17 (bug fix)[772288] Unix std channels forced to exist at startup. 2004-02-17 (new default) tcltest::configure -verbose {body error} 2004-02-19 (bug fix) init.tcl search path with unusual --libdir (samson) 2004-02-25 (bug fix)[554068] stopped broken [exec] quoting of { (gravereaux) 2004-02-25 (bug fix)[888777] plugged memory leak with long host names (cassoff) 2004-03-01 (bug fix)[462580] corrected level interpretation of Tcl_CreateTrace 2004-03-01 (platform support)[218561] Allow 64-bit configure on IRIX64-6.5* --- Released 8.4.6, March 1, 2004 --- See ChangeLog for details --- Changes to 8.5a1 include all changes to the 8.4 line through 8.4.6, plus the following, which focuses on the high-level feature changes in this changeset (new minor version) rather than bug fixes: * refactored IO code to split FS path code into generic/tclPathObj.c and generic/tclFileSystem.h * refactored trace code into generic/tclTrace.c * configure scripts now require autoconf 2.57 for regeneration * updated runtime library scripts to use newer Tcl code features (like replacing regsub with string map) * improve robustness of tcltest test suite across environments * changed the bytecode evaluation-stack addressing mode, from array-style to pointer-style; the catch stack and evaluation stack are now contiguous in memory * switch command is now byte-compiled * enhanced checking in 'file' command for Windows NT file permissions * [TIP #57] new 'lassign' command (adopted from TclX) * [TIP #75] switch -regexp now provides submatch info * [TIP #90] extended 'catch' and 'return' to enable creation of procs that are a true replacement for 'return' * [TIP #100] new 'unload' command (can unload DLLs loaded via 'load', requires the extension writer to support it) * [TIP #111] new 'dict' command. Several commands have been updated to handle the list form of dicts implicitly at the C level where only lists were previously accepted * [TIP #112] 'namespace ensemble' command addition allows for ensembles that build on the namespace abstraction * [TIP #118] file attributes -readonly option for unices that support chflags(), support Mac Classic attribute options on OS X, add -rsrclength for OS X, enhance file copy on OS X to copy finder attributes and resource forks transparently * [TIP #120] enable dde in safe interpreters * [TIP #130] enable unique dde server names on Windows * [TIP #135] change dde servername -exact option to -force => dde 1.3 * [TIP #121] new Tcl_SetExitProc C API to control application shutdown * [TIP #123] expr ** exponentiation operator * [TIP #124] 'clock clicks -milliseconds' now returns a wide integer and a new 'clock clicks -microseconds' returns a wide integer, representing the number of microseconds, both since the Posix epoch * [TIP #127] added 'lsearch -index' option * [TIP #136] added 'lrepeat' command * [TIP #137/151] Add -encoding option to 'source' command and main tclsh executable. *** POTENTIAL INCOMPATIBILITY *** For Tcl embedders that build on Tcl_Main() and make use of Tcl_Main's former ability to pass a leading "-encoding" option to interactive shell operations, this will now be consumed by Tcl. * [TIP #138] New TCL_HASH_KEY_SYSTEM_HASH option for Tcl hash tables * [TIP #139] documented portions of Tcl's namespace C APIs * [TIP #148] correct [list]-quoting of the '#' character *** POTENTIAL INCOMPATIBILITY *** For scripts that assume a particular (buggy) string rep for lists. * [TIP #156] add "root locale" to msgcat => msgcat 1.4 * [TIP #157] leading {expand} syntax on words to cause argument expansion. This is a safer/cleaner alternative to the use of 'eval'. --- Released 8.5a1, March 3, 2004 --- See ChangeLog for details --- 2004-03-04 (new feature) registry package is [unload]able (thoyts) => registry 1.1.4 2004-03-08 (bug fix)[910525] [glob -path] in root directory (darley) 2004-03-12 (new feature)[TIP 163] [dict merge] (english, fellows) 2004-03-18 (platform support) support for Mac Classic removed (steffen) 2004-03-28 (bug fix)[925121] corrected segfault in bc compiler (sofer) 2004-03-30 (bug fix)[495830,729692] bytecode execution checks each command/interp validity before executing. (sofer) 2004-03-31 (bug fix)[811457] support translation to "" (porter) 2004-03-31 (bug fix)[811461] ignore locales with no "language" part (porter) => msgcat 1.4.1 2004-04-01 (bug fix) make [glob -type d -dir . *] work across VFS boundary 2004-04-06 (clean up) refactored Tcl header file #include order. Might create need for changes in extensions that #include private headers. Changed source code files should work with older Tcl as well. See ChangeLog. *** POTENTIAL INCOMPATIBILITY *** 2004-04-07 (bug fix)[920667] install into any Unicode path on Win (hobbs) 2004-04-07 (platform support) properly substitute more values in Windows tclConfig.sh (hobbs) 2004-04-23 (bug fix)[930851] reset channel EOF when eofchar changes (kupries) 2004-04-28 (bug fix)[600812][TIP 184] [upvar 0 scalar array(foo)] raises error 2004-05-03 (bug fix)[947070] stack overflow prevention on Win (kenny) 2004-05-03 (bug fix)[868853] fix leak in [fconfigure $serial -xchar] (cassoff) 2004-05 (bug fix)[928353,929892,928808,947440,948177] test fixes: OSX (abner) 2004-05-05 (bug fix)[794839] socket connect error -> r/w fileevents (gravereaux) 2004-05-07 (bug fix)[949905] corrected utf-8 encoding of \u0000 on I/O (max) 2004-05-13 (new feature)[TIP 129] [binary scan tnmrRqQ] (markus, fellows) 2004-05-13 (new feature)[TIP 142] [interp limit] (fellows) 2004-05-14 (bug fix)[940278,922848] [clock] notices $::env(TZ) changes, gmt works on all platforms. (kenny, welton, glessner) 2004-05-16 (feature rewrite) bytecode execution of {expand} changed *** POTENTIAL INCOMPATIBILITY with prior 8.5a releases *** 2004-05-18 (platform support) makefile.vc now generates tclConfig.sh (thoyts) 2004-05-18 (bug fix)[500285,500389,852944] [clock %G %V] ISO8601 week numbers (kenny) 2004-05-22 (bug fix)[735335,736729] variable name resolution error (sofer) 2004-05-24 (bug fix) support for non-WIDE_INT aware math functions (hobbs) 2004-05-25 (new feature) [http::config -urlencoding] (hobbs) => http 2.5.0 2004-05-26 (bug fix)[960926] file count doubled when -singleproc 1 (porter) => tcltest 2.2.6 2004-05-26 (bug fix)[874058] improved build configuration on 64-bit systems. Corrects Tcl_StatBuf definition issues. (hobbs) 2004-05-30 (platform support) Win: allow signed short exit codes (gravereaux) 2004-06-05 (bug fix)[976722] hi-res clock fixes: Win (godfrey, suchenwirth, kenny) 2004-06-10 (bug fix)[932314] bad return values from Tcl_FSChdir() (vasiljevic) 2004-06-18 (platform support) regonize more unix locales (huang) 2004-06-18 (bug fix) prevent stack overflow from long free() chains (fellows) 2004-06-21 (platform support) exceptions w/ gcc -O3 on Win (dejong) 2004-06-23 (feature rewrite)[976496] thread local storage done with hash tables to avoid system limits (mistachkin) 2004-06-29 (bug fix)[981733] SafeBase global pollution (fellows) 2004-06-30 (new feature)[TIP 188] [string is wideinteger] (kenny) 2004-07-02 (new feature)[TIP 202] pipe redirection 2>@1 (hobbs) 2004-07-03 (bug fix)[908375] round() wide integer support (lavana, sofer) 2004-07-07 (bug fix)[458361] shimmer of single-word scripts suppressed (sofer) 2004-07-15 (bug fix)[770053] crash in thread finalize of notifier (vasiljevic) 2004-07-15 (bug fix)[990453] plug mutex leaks on reinit (mistachkin, vasiljevic) 2004-07-16 (bug fix)[990500] clean exit of notifier thread (mistachkin, kupries) 2004-07-19 (bug fix)[987967] improved self-init of mutexes on Win (vasiljevic) 2004-07-20 (bug fix) pure Darwin/CFLite support (steffen) 2004-07-20 (bug fix)[736426] plug leaky allocator reinit (mistachkin, kenny) 2004-07-30 (bug fix)[999084] no deadlock in re-entrant Tcl_Finalize (porter) 2004-08-02 (new feature)[TIP 207] [interp invokehidden -namespace] (porter) 2004-08-10 (bug fix) thread IDs on 64-bit systems (ratcliff,vasiljevic) 2004-08-13 (bug fix) avoid malicious code acceptance by [mclocale] (porter) => msgcat 1.3.3 2004-08-16 (bug fix)[1008314] Tcl_SetVar TCL_LIST_ELEMENT (sofer,porter) 2004-08-18 (new feature)[TIP 173,209] complete [clock] rewrite (kenny) *** POTENTIAL INCOMPATIBILITY *** 2004-08-18 (new feature)[TIP 189] package loading for Tcl Modules (kupries) 2004-08-19 (bug fix)[1011860] [scan %ld] fix on LP64 (fellows,porter) 2004-08-23 (bug fix)[695441] extend [tcl_findLibrary] search path to include $::auto_path and [pkgconfig get scriptdir,runtime] (porter) 2004-08-27 (platform support) TCL_MODULE_PATH values for Mac OSX (steffen) 2004-08-27 (bug fix)[1017022] recognize imported ensembles (fellows) 2004-08-30 (bug fix) [string map $x $x] crash (fellows) 2004-09-01 (bug fix)[1020445] WIN64 support (hobbs) 2004-09-03 (bug fix)[1020538] crash in [file copy] (violi,fellows) 2004-09-07 (bug fix)[1016167] [after] overwrites its imports (kenny) 2004-09-08 (bug fix) fixed [clock format 0 -format %k] (kenny) 2004-09-09 (bug fix)[560297] fixed broken [namespace forget] logic (porter) 2004-09-09 (bug fix)[1017299] fixed [namespace import] cycle prevention (porter) 2004-09-10 (performance) $x[set x {}] is now fast [K $x [set x {}]] (sofer) 2004-09-10 (bug fix)[868489] better control over int <-> wideInt (fellows,kenny) 2004-09-10 (bug fix)[1025359] POSIX errorCode from wide seeks (kupries,fellows) 2004-09-10 (bug fix)[707104,1026493] fix [rename] of [interp alias] (porter) 2004-09-18 (bug fix)[868467] fix [expr 5>>32] => 0, not 5 (hintermayer,fellows) 2004-09-21 (bug fix) consistent errorinfo from [namespace eval x error foo bar] and [namespace eval c {error foo bar}] (porter) 2004-09-22 (feature change) syntax errors not reported at compile time; deferred to runtime. Support [return -errorline]. (porter) 2004-09-23 (bug fix)[1016726] fix `make clean` in static config (leitgeb,dejong) 2004-09-22 (feature change) report all compile errors at runtime (porter) 2004-09-29 (bug fix)[1036649] syntax error in [subst] => buffer overflow (sofer) 2004-09-30 (bug fix)[1038021] save/restore error state: var traces (porter) 2004-10-01 (performance) stackframe level values in internal reps (fellows) 2004-10-01 (feature change)[1037235] auto-create [dict] key paths (fellows) 2004-10-04 (bug fix)[884830] eq and ne parse in expr (fellows) 2004-10-05 (reform) errorInfo, errorCode management (porter) *** POTENTIAL INCOMPATIBILITY for traces on those vars *** 2004-10-06 (feature change)[1041072] re-bless and enhance Tcl_AppendResult (dkf) 2004-10-06 (reform) more robust interp result appends (porter) => dde 1.3.1 => registry 1.1.5 2004-10-06 (reform) re-write of [glob] guts (fellows) 2004-10-07 (reform)[925620] improved platform split of VFS code (darley) 2004-10-08 (new feature)[TIP 201] "in" and "ni" expr operators (fellows) 2004-10-08 (new feature)[TIP 212] [dict update]; [dict with] (fellows) 2004-10-08 (bug fix)[954263] case insensitive [file exec] for Win (hobbs,darley) 2004-10-14 (performance) [info commands/globals/procs/vars $pattern] faster when $pattern is trivial (fellows) 2004-10-14 (new feature)[TIP 217] [lsort -indices] (salsman,fellows) 2004-10-24 (reform) replaced bit flag values with macros for Var handling *** POTENTIAL INCOMPATIBILITY for accesses to Var internals *** 2004-10-26 (new feature)[1054370] install msgcat, http, tcltest as TM's (porter) 2004-10-26 (bug fix)[767676] negative PIDs with pipes (giese,gravereaux) 2004-10-27 (bug fix)[731778] stop critical section leaks (mistachkin,gravereaux) 2004-10-27 (bug fix)[926088] -load option to find tested packages (gravereaux) 2004-10-28 (bug fix)[1030548] restore the --enable-symbols --enable-threads build on Win (mistachkin,kenny,kupries) 2004-10-29 (bug fix)[1055673] fix command line syntax error message (porter) => tcltest 2.2.7 2004-10-30 (bug fix)[926106] fix [file mtime] DST anomaly (kenny) 2004-10-31 (bug fix)[1057461] fix [info globals ::varName] (fellows) 2004-11-02 (bug fix)[761471] fix [expr {NaN == NaN}] (sofer) 2004-11-02 (bug fix)[1017151] misleading errorInfo after tests (seeger,porter) 2004-11-03 (bug fix)[527164] preserve errorinfo from var traces (porter) 2004-11-08 (bug fix){947693] Made -blocking option of channel during [close] consistent on Windows with Unix (gravereaux) *** POTENTIAL INCOMPATIBILITY *** 2004-11-11 (bug fix)[1034337] recursive file delete, MacOSX (steffen) 2004-11-12 (new feature)[TIP 221] [interp bgerror] (porter) 2004-11-12 (new feature)[TIP 226] Tcl_(Save|Restore|Discard)InterpState (porter) 2004-11-12 (new feature)[TIP 227] Tcl_(Get|Set)ReturnOptions (porter) 2004-11-12 (bug fix)[1004065] stop crash when TCL_UTF_MAX==6 (hobbs,porter) 2004-11-15 (bug fix)[10653678] [trace variable],[trace remove] interop (porter) 2004-11-16 (bug fix)[1067709] crash in [fconfigure -ttycontrol] (hobbs) 2004-11-18 (new feature) configure options --enable-man-suffix (max) 2004-11-22 (bug fix)[1030465] Improve HAVE_TYPE_OFF64_T check (dejong) 2004-11-22 (bug fix)[1043129] Fixed the treatment of backslashes in file join on Windows (darley) 2004-11-22 (bug fix)[976438] Move init.tcl search path construction to tclInit (porter) 2004-11-24 (bug fix)[1072654] Fixed segfault in info vars trivial matching branch (new in 8.4.8) (porter) 2004-11-24 (bug fix)[1001325, 1071701] Fixed readdir_r detection and usage (dejong, kenny, porter) 2004-11-24 (bug fix)[1071807] Fixed all uses of 'select' to use standard macros rather than older bit-whacking style (kenny) 2004-11-26 (bug fix)[1073524] Simplify the code to check for correctness of strstr, strtoul and strtod on unix (fellows) 2004-11-26 (bug fix)[1072136] Remove file normalize on tcl_findLibrary search path uniqification added in 8.4.8 (porter) 2004-11-30 (bug fix)[976520] Rework startup/initialization of the Tcl library, encoding search initialization, and Tcl_FindExecutable structure. [tclInit] no longer driven by the value of $::tcl_libPath (TCLLIBPATH). (porter) *** POTENTIAL INCOMPATIBILITY : makes encoding names case sensitive on Windows, where they have been case insensitive *** 2004-12-02 (bug fix)[1074671] Ensure tilde paths are not returned specially by 'glob' (darley) Doc improvements [759545,926590,935853,1017072,1018486,1022527,1027849, 1032243,1047928,1048005,1058446,1062647,1065732,1073334,etc.] Test suite expansion [1036649,1001997,etc.] --- Released 8.5a2, December 7, 2004 --- See ChangeLog for details --- 2004-12-13 (bug fix)[1083082] encoding memory leaks (ade,porter) 2004-12-13 (bug fix)[1082349] restored C++ extension support (porter) 2004-12-14 (bug fix)[1081541] workaround automake-ism "$U" (porter) 2004-12-15 (new feature) CallFrames on execution, not C, stack (sofer) 2004-12-16 (bug fix)[1085023] [interp limit] support in [vwait], etc. (fellows) 2004-12-29 (bug fix)[1090413] make [clock scan 0030] work (morian,kenny) 2004-12-29 (bug fix)[1092789] make [clock scan 10000] work (porter,kenny) 2004-12-29 (platform support)[1092952,1091967] MSVC7, gcc OPT compiles (hobbs) 2005-01-06 (performance)[1020491] [http::mapReply] (fellows) => http 2.5.1 2005-01-09 (bug fix)[1095909] stopped use of readdir_r (english) 2005-01-10 (enhancement)[1081595] stopped use of TCL_DBGX (english) 2005-01-17 (bug fix)[1100542] [glob] of Windows shares (schar,darley) 2005-01-19 (new feature)[TIP 235] C API for ensembles (fellows) 2005-01-21 (new feature)[TIP 233] virtual time (kupries) 2005-01-25 (bug fix)[1101670] [auto_reset] update for [namespace] (porter) ***POTENTIAL INCOMPATIBILITY*** May cause re-[source]-ing of files that have not anticipated that before. 2005-01-27 (new feature)[TIP 218] Tcl_Channel API update for threads (kupries) 2005-01-27 (bug fix)[1109484] Tcl_Expr* updates for Tcl_WideInt (hobbs) 2005-01-28 (platform support)[1021871] Solaris gcc 64-bit support (hobbs) 2005-02-10 (bug fix)[1119369] Tcl_EvalObjEx: avoid shimmer loss of List intrep (sofer,macdonald) 2005-02-11 (platform support) correct gcc builds for AIX-4+, HP-UX-11 (hobbs) 2005-02-24 (bug fix)[1119798] prevent [source $directory] (porter,mpettigr) => tcltest 2.2.8 2005-03-10 (bug fix)[1153871] bad ClientData cast (porter,victorovich) 2005-03-15 (platform support) OpenBSD ports patch (thoyts) 2005-03-18 (bug fix)[1115904] restore recursion limit in direct eval (porter) 2005-03-24 (bug fix) stop conflict between Tcltest and Thread packages (porter) 2005-03-29 (platform support) allow msys builds without cygwin (hobbs) 2005-04-01 (internal change)[1158008] internal rep of "list" Tcl_Obj's now uses a refcounted struct (sofer) ***POTENTIAL INCOMPATIBILITY*** For any code that goes poking into the internals of "list" Tcl_Obj's 2005-04-05 (performance)[1174551] Tcl_DecrRefCount of Tcl_Obj "chains" (sofer) 2005-04-08 (performance)[1077262] better Tcl_Encoding cache lifetimes (porter) 2005-04-10 (bug fix)[1180368] [interp invokehidden] mem leak (kenny,porter) 2005-04-12 (performance)[1177363] startup encoding file scan (porter) 2005-04-12 (performance)[1182459] [clock format] (kenny) 2005-04-13 (bug fix) min buffer size dropped from 10 to 1 byte (gravereaux) 2005-04-16 (bug fix)[1178445] fix memory waste at thread exit (vasiljevic) 2004-04-16 (bug fix)[1084111] [array names] memory leak (ade,sofer) 2005-04-19 (bug fix)[1185933] [clock] init clobbered global vars (ring,kenny) 2005-04-19 (new feature) [::tcl::unsupported::EncodingDirs] - unsupported command to set search path for encoding files (porter) 2005-04-20 (bug fix)[1090869] Tcl_GetInt accept 0x80000000, 64-bit (porter,singh) 2005-04-22 (bug fix)[1187123] [string is boolean] respect EIAS (porter) 2005-04-25 (enhancement) update to tzdata2005i (kenny) 2005-04-25 (platform support) builds on Mac OS X 10.1 (steffen) 2005-04-27 (new feature)[TIP 183] [open $f {... BINARY ...}] (porter) 2005-04-29 (new feature)[TIP 176] simple index arithmetic (porter) 2005-05-06 (platform support) x86_64 Solarix cc and Solaris 10 builds (hobbs) 2005-05-10 (bug fix)[1198892] [expr {i**0}] error (kaitschu,markus) 2005-05-10 (new feature)[TIP 132] floating-point conversion to string (kenny) ***POTENTIAL INCOMPATIBILITY*** For scripts that rely on (tcl_precision==12) number formatting 2005-05-10 (new feature)[TIP 232] math functions as commands (kenny) ***POTENTIAL INCOMPATIBILITY*** Tcl_GetMathFuncInfo functioning is reduced; routine is now deprecated 2005-05-13 (feature removed) TCL_NO_MATH compiler directive (porter) 2005-05-14 (platform support) Mac OSX: configurable CoreFoundation API (steffen) 2005-05-14 (platform support) Mac OSX: use realpath when threadsafe (steffen) 2005-05-17 (feature removed) Tcl_ObjType's "list", "procbody", "index", "ensembleCommand", "localVarName", "levelReference, "boolean" are no longer registered (porter) ***POTENTIAL INCOMPATIBILITY*** For any callers of Tcl_GetObjType on those strings 2005-05-20 (bug fix)[1201589] boolean literal prefix in expressions (porter) 2005-05-24 (platform support) Darwin build support merged into unix (steffen) 2005-05-24 (new feature)[1202209] Mac OSX: support [load] of .bundle binaries Can support [load] from memory as well (steffen) 2005-05-24 (new feature)[1202178] [time] returns non-integer result (steffen) 2005-05-25 (new feature)[TIP 182] [expr {bool(...)}] (mistachkin,porter) 2005-05-30 (new feature)[TIP 229] [namespace path] (fellows) 2005-05-31 (bug fix)[1082283] Unix: notifier thread now joinable (vasiljevic) 2005-06-01 (new feature)[TIP 241] -nocase: lsort, lsearch, switch (mistachkin) 2005-06-01 (bug fix)[1209759] "return TCL_RETURN;" could cause panic (porter) Documentation improvements [1075433,1085127,1117017,1124160,1149605,etc.] --- Released 8.5a3, June 4, 2005 --- See ChangeLog for details --- 2005-06-06 (bug fix)[1213678] Windows/gcc: crash in stack.test (kenny) 2005-06-07 (new feature)[TIP 208] [chan] and [chan truncate] (fellows) 2005-06-07 (revert) Restored registration of "procbody" Tcl_ObjType (porter) Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17. 2005-06-13 (bug fix)[1217375,1219176] [file mkdir] race (diekhans,darley) 2005-06-14 (bug fix)[1220058] [namespace delete] crash (duquette,fellows) 2005-06-17 (bug fix)[1221395] Tcl_LimitSetTime able to break [vwait] (fellows) 2005-06-18 (bug fix)[1154163] [format %h] on 64-bit OS's (kraft,fellows) 2005-06-21 (bug fix)[1201035,1224585] execution trace crashes (porter) 2005-06-21 (bug fix)[1194458] Windows: [file split] (kenny,porter) 2005-06-22 (bug fix)[1225727] Windows: pipe finalization crash (kenny) 2005-06-22 (bug fix)[1225571] Windows: [file pathtype] buffer overflow (thoyts) 2005-06-22 (bug fix)[1225044] Windows: UMR in pipe close (kenny) 2005-06-23 (bug fix)[1225957] Windows/gcc: crashes in assembler code (kenny) 2005-06-24 (bug fix) make Tcl_Preserve safe in Tk exit handlers (kenny) 2005-07-01 (bug fix)[1222872] notifier spurious wake-up protection (vasiljevic) 2005-07-05 (bug fix)[1230597] allow idempotent [namespace import] (porter) 2005-07-15 (bug fix)[1237907] localtime() => NULL => crash (kenny) 2005-07-21 (dropped support) IRIX 4, RISCos, Ultrix, and ancient BSD (kenny) ***POTENTIAL INCOMPATIBILITY*** 2005-07-22 (enhancement)[1237755] 8.4 features in script library (fradin,porter) 2005-07-24 (new feature) configure macros SC_PROG_TCLSH, SC_BUILD_TCLSH (dejong) 2005-07-26 (bug fix)[1047286] cmd delete traces during namespace delete (porter) 2005-07-26 (new unix feature)[1231015] ${prefix}/share on ::tcl_pkgPath (dejong) ***POTENTIAL INCOMPATIBILITY*** 2005-07-27 (bug fix)[1214462] [unknown] can return exceptions (porter) 2005-07-27 (new feature) value of ::tcl_precision now kept per-thread (porter) ***POTENTIAL INCOMPATIBILITY*** 2005-07-28 (unix bug fix)[1245953] O_APPEND for >> redirection (fellows) 2005-07-29 (bug fix)[1247135] [info globals] return only existing vars (fellows) 2005-07-30 (new Darwin feature) TCL_LOAD_FROM_MEMORY configuration (steffen) 2005-08-05 (bug fix)[1241572] correct [expr abs($LONG_MIN)] (kenny) 2005-08-05 (Solaris bug fix)[1252475] recognize cp1251 encoding (wagner,fellows) 2005-08-11 (config options) eliminated USE_THREAD_STORAGE option (kenny) 2005-08-23 (toolchain support) autoconf-2.59 now required (dejong) 2005-08-24 (new feature)[TIP 219] reflected channels ([chan create]) (kupries) 2005-08-25 (bug fix)[1267380] [lrepeat] buffer overflow prevention (fellows) 2005-08-26 (bug fix) fix [namespace ensemble] crashes in Snit (fellows) 2005-08-29 (bug fix)[1275043] restore round() away from zero (kenny) 2005-08-29 (bug fix)[1189657] correct [tcl::tm::roots] (porter) 2005-09-07 (bug fix)[1283976] invalid [format %c -1] result (porter) 2005-09-08 (new feature)[1242844][TIP 254] new types for Tcl_LinkVar (fellows) 2005-09-07 (toolchain support) deprecate TCL_VARARGS*; stdarg.h assumed (porter) ***POTENTIAL INCOMPATIBILITY*** 2005-09-15 (RHEL bug fix)[1287638] support open >2GB files RHEL 3 (palan) 2005-09-08 (new feature)[TIP 255] [expr min()] and [expr max()] (hobbs) 2005-09-30 (bug fix)[1306162] $argv encoding and list formatting (porter) 2005-10-04 (bug fix)[1067708] [fconfigure -ttycontrol] leak (hobbs) 2005-10-04 (bug fix)[1182373] [http::mapReply] update to RFC 3986 (aho,hobbs) => http 2.5.2 2005-10-04 (HPUX bug fix)[1204237] shl_load() and DYNAMIC_PATH (collins,hobbs) 2005-10-05 (bug fix)[979640] buffer overrun mixing putenv(), ::env (bold,hobbs) 2005-10-08 (new feature)[TIP 237] unlimited range for integers (kenny,porter) ***POTENTIAL INCOMPATIBILITY*** for any code that relies on implicit truncation of integer calculations to the range of a C long 2005-10-14 (platform support)[1256937] MSVC++ static builds (thoyts) 2005-10-19 (bug fix)[1331475] [dict append] crash (bills,sofer) 2005-10-20 (bug fix)[1333036] [lset] shared sublist handling (sofer) 2005-10-23 (bug fix)[1335006] memleack in [glob] (melbardis,darley) 2005-10-23 (bug fix)[1325803] Win: [file stat] on links (bonilla,darley) 2005-11-01 (bug fix)[1337941] Tcl_TraceCommand() -> crash (devilliers,porter) 2005-11-02 (platform support)[1256937] MSVC 8 support (thoyts) 2005-11-03 (new Win NT/XP feature) Unicode console support (kovalenko,thoyts) 2005-11-04 (bug fix)[1337229,1338280] [namespace delete] / unset traces (sofer) 2005-11-04 (enhancement) Korean timezone abbreviations (kenny) 2005-11-04 (platform support)[1163896] LynxOS [load] (heidibr) 2005-11-04 (bug fix)[1334947] value refcount error in var setting (sofer) 2005-11-04 (Win enhancement)[1267871] extended exit codes (newman,thoyts) 2005-11-07 (bug fix)[1348775] unset trace memory leak (sofer) 2005-11-08 (bug fix)[1162286] [package require] checks that the script registered by [package ifneeded] provides the version it claims (lavana,porter) *** POTENTIAL INCOMPATIBILITY *** 2005-11-09 (bug fix)[1350293,1350291] [after $negative $script] fixed (kenny) 2005-11-12 (bug fix)[1352734,1354540,1355942,1355342] [namespace delete] issues with [namespace path] and command delete traces (sofer,fellows) 2005-11-18 (bug fix)[1358369] URL parsing standards compliance (wu,fellows) => http 2.5.2 2005-11-18 (revert) Restored registration of "list" Tcl_ObjType (porter) Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17. 2005-11-18 (bug fix)[1359094] Tclkit crash (thoyts, kupries) 2005-11-20 (bug fix)[1091431] Tcl_InitStubs failure crashes wish (english) 2005-11-27 (platform support) Darwin 64bit, Tiger copyfile(), and Max OSX universal binaries support (steffen) 2005-11-28 (bug fix) [clock] DST transition error (mackerras,kenny) 2005-11-29 (bug fix)[1366683] [lsearch -regexp] backrefs (cleverly,fellows) 2005-11-30 (performance) recoded portions of [clock] in C (kenny) 2005-11-30 (enhancement) improved bytecode compiling of [switch] (fellows) *** POTENTIAL INCOMPATIBILITY *** For loading bytecode compiled and saved by earlier 8.5alpha releases 2005-12-05 (Darwin bug fix)[1034337] NFS recursive file delete (steffen) 2005-12-08 (platform support) Win x64 build (hobbs) 2005-12-09 (bug fix)[1374778] [lsearch -start $pastEnd] => -1 (fellows) 2005-12-12 (bug fix)[1377619] configure syntax error exposed in bash-3.1 (hobbs) 2005-12-13 (bug fix)[1379349] [dict for] CoW error (ring,hippler,fellows) 2005-12-18 (bug fix)[1382528] [dict for {k v} {} {}] crash (kovalenko,fellows) 2005-12-27 clock tzdata updated to Olson's tzdata2005r (kenny) 2005-12-27 libtommath updated to release 0.37 (kenny) 2006-01-09 (bug fix)[1480572] [info level $l] => "namespace inscope" (porter) 2006-01-11 (compat support)[1397843] when ::errorInfo is traced, fall back to old pattern of stack trace construction (porter). Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2004-10-05. 2006-01-12 (bug fix)[1366227] Win: [file stat] sharing violation (darley) 2006-01-23 (bug fix)[1410553] Tcl_GetRange Unicode confusion (twylite,spjuth) 2006-01-23 (bug fix)[1412695] args handling in precompiled procs (traum,sofer) 2006-02-01 (new feature)[1275435][TIP 250] [namespace upvar] (sofer) 2006-02-01 (new feature)[958222][TIP 181] [namespace unknown] (madden) 2006-02-01 (new feature)[944803][TIP 194] [apply] (mistachkin) 2006-02-08 (new feature)[1413934][TIP 258] [encoding dirs], etc. (porter) 2006-02-09 (new feature)[1413115][TIP 215] auto-init [incr] (leitgeb) 2006-03-02 (bug fix)[1379287] norm of paths with /../ back to root (porter) 2006-03-03 (compat support) Restored registration of a "boolean" Tcl_ObjType (porter) Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17. 2006-03-06 (bug fix)[1439836,1444291] fix TCL_EVAL_{GLOBAL,INVOKE} handling when auto-loading or exec traces are present (porter) 2006-03-10 (bug fix)[1437595] Win socket finalize with threads (vasiljevic) 2006-03-13 (revert 2005-07-26 change) ${prefix}/share on ::tcl_pkgPath (porter) 2006-03-14 (bug fix)[1448251] TCLX.y_TM_PATH handling (noble, kupries) 2006-03-14 (bug fix)[768659] pipeline error when last command missing (kupries) 2006-03-18 (bug fix)[1193497] Win porting of [file writable] (darley,vogel) 2006-03-18 (bug fix)[1084705] [glob -nocomplain] silence empty result only, no other errors (darley) ***POTENTIAL INCOMPATIBILITY*** 2006-03-21 (platform enhancement)[823329] HFS globbing support (steffen) 2006-03-23 (platform support) updated tcl.spec file (max) 2006-03-28 (bug fix)[1064247] BSD: path normalization with realpath() (steffen) 2006-04-03 (bug fix)[1462248] crash reading utf-8 chars spanning multiple buffers at end of file (kraft,kupries) 2006-04-05 (bug fix)[1464039] Tcl_GetIndexFromObj: empty key (fellows) 2006-04-05 (bug fix) overdue dde, registry patchelevel increments (porter) => dde 1.3.2 => registry 1.2 2006-04-06 (bug fix)[1457515] TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING removed (steffen) 2006-04-11 (bug fix)[1458266] enter/enterstep trace interference (leunissen) 2006-04-12 (feature change)[1376892] revised definition of [:print:] (fellows) (platform support) Use of _ANSI_ARGS_ purged. ANSI compiler required (fellows) Documentation improvements [1211078,1190891,1292427,1277503,1104682,1359183, 1415725,666770] --- Released 8.5a4, April 27, 2006 --- See ChangeLog for details --- 2006-05-04 (bug fix)[1480509] srand() accept wide input (porter,afredd) 2006-05-05 (bug fix)[1481986] interactive Tcl_Main blocks main loop (porter,lin) 2006-05-13 (bug fix)[1482718] proc re-compile: preserve the previous bytecode while references still on the stack (porter,ryazanov) 2006-05-27 (bug fix)[923072] Darwin: made unthreaded CoreFoundation notifier naked-fork safe on Tiger (steffen) 2006-06-20 (internal change) Dropped the internal routines used to hook into filesystem operations back in the pre-Tcl_Filesystem days. (porter) ***POTENTIAL INCOMPATIBILITY*** For extensions and programs that have never migrated to the supported Tcl 8.4 interface for virtual filesystems 2006-07-05 (enhancement) Expression parser rewrite avoids stack overflow, reduces from O(N^2) to O(N) complexity, and greatly improves syntas error messages (porter) ***POTENTIAL INCOMPATIBILITY*** For any code relying on exact error messages. 2006-07-20 (platform support) Mac OS X weak linking (steffen) 2006-07-20 (bug fix) Darwin: execve() works iff event loop not yet run (steffen) 2006-07-24 (bug fix)[1518166] Uninitialized Tcl_DString (afredd) 2006-07-30 (bug fix)[1426279,1505383,1494664,1531530] [clock] fixes (kenny) 2006-08-09 (bug fix)[1531184] [dict for {file stat} x {}] crash (fellows) 2006-08-10 (bug fix)[1538262,1530474] code cleanup; optimizations (afredd) 2006-08-18 (bug fix) intermittent failures in TclUnixWaitForFile() (steffen) 2006-08-18 (platform support) Darwin x86_64 (steffen) 2006-08-21 (bug fix)[1457797] Darwin 64-bit notifier hang (steffen) 2006-08-21 (bug fix) Darwin: recursively called event loop (steffen) 2006-08-21 (enhancement) Darwin: nanosec resolution clicks and [time] (steffen) 2006-08-28 (bug fix)[1547681] TclFormatObj count arguments (mistachkin,porter) 2006-08-28 (bug fix) stack.test failure on FreeBSD (mistachkin) 2006-08-30 (bug fix)[1548263] filesystem segfaults (hobbs,mccormack) 2006-08-31 (bug fix)[1541274] [expr {sqrt(-1)}] => -NaN (suchenwirth,porter) 2006-09-06 (bug fix)[999544] use of MT-safe system calls (vasiljevic) 2006-09-10 (platform support) Darwin: msgcat use CFLocale (steffen) => msgcat 1.4.2 2006-09-10 (new feature) tcltest option: -verbose line (steffen) => tcltest 2.3a1 2006-09-19 (bug fix)[1555271,1561260] Several ** operator bugs (porter) 2006-09-22 (bug fix)[1562528] NULL terminates variadic calls (fellows,ryazanov) 2006-09-22 (new feature)[1520767][TIP 268] [package] alpha/beta version; [package require] ranges, [package prefer] selection mode (kupries) 2006-09-26 (platform support) MSVC8 AMD64 support (thoyts) 2006-09-27 (bug fix)[1567222] bignum << errors (porter) 2006-09-30 (enhancement)[1190441] quiet no-op [history] (sofer) 2006-10-04 clock tzdata updated to Olson's tzdata2006m (kenny) 2006-10-05 (bug fix)[1570718] make [lappend $nonList] complain (sofer,virden) 2006-10-05 (bug fix)[1122671] alignment fixes in unicode encoding routines (hobbs,staplin) 2006-10-05 (enhancement) Allow "_" in Tcl Module filenames (kupries) 2006-10-05 (new feature) [set ::http::strict 0] (default value is 1) to disable URL validity checking against RFC 2986 (hobbs) => http 2.5.3 2006-10-06 (new feature)[1565751][TIP 275] [binary scan] unsigned (thoyts) 2006-10-10 (bug fix)[1566526] crash cleaning up [namespace path] data (porter) 2006-10-12 (bug fix)[1576006] better error messages from [interp alias] (sofer) 2006-10-13 (platform support) get stack size on Darwin (steffen) --- Released 8.5a5, October 20, 2006 --- See ChangeLog for details --- 2006-10-20 (configure change) Added autodetection for OS-supplied timezone files (max) 2006-10-23 (enhancement)[1577278] Ensure the Tcl call stack always has a CallFrame, even at level 0 (sofer) *** POTENTIAL INCOMPATIBILITY for users of tclInt.h *** 2006-10-23 (enhancement)[1577492] Tcl_PushCallFrame and [info level] enhanced for ensemble rewrites (sofer) *** POTENTIAL INCOMPATIBILITY for [info level 0] on interp alias *** 2006-11-02 (feature change)[TIP 293] Replace {expand} with {*} (hobbs) *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** 2006-11-04 (new feature)[TIP 274] Exponentiation operator is right associative (porter) 2006-11-09 (new feature)[TIP 272] Added [lreverse] and [string reverse] commands (fellows) 2006-11-14 (new feature)[TIP 261] [namespace import] returns list of imported commands (porter) 2006-11-15 (new feature)[TIP 270] New C routines Tcl_ObjPrintf, Tcl_AppendObjToErrorInfo, Tcl_Format, Tcl_AppendLimitedToObj, Tcl_AppendFormatToObj, Tcl_AppendPrintfToObj (porter) 2006-11-22 (feature change) Moved TCL_REG_BOSONLY from tcl.h to tclInt (porter) 2006-11-22 (new feature)[TIP 269] Added [string is list] classification command (mistackin, fellows) 2006-11-25 (new feature)[TIP 174] Added commands corresponding to most expr operators in ::tcl::mathop (fellows) 2006-11-26 (platform support)[1230558] --enable-64bit on more systems (steffen) 2006-11-27 (bug fix)[1602208] Fix 64-bit handling of select() on unix where fd was greater than 32 (fontaine, kenny) 2006-11-28 (new feature)[TIP 280] Added [info frame] command for more Tcl-level debugging information (kupries) 2006-12-01 (feature change)[TIP 298] Change Tcl_GetBignumAndClearObj to Tcl_TakeBignumFromObj (porter) 2006-12-01 (new feature)[TIP 287] Added [chan pending] subcommand (cleverly) 2006-12-01 (new feature)[TIP 299] Added isqrt() expr operator (kenny) 2006-12-04 (new feature)[TIP 267] Added -ignorestderr option to exec (fellows) 2006-12-05 (new feature)[TIP 291] ::tcl_platform(pointerSize) key (kupries) 2007-01-11 (configure change) Remove "-Wconversion" from deflt CFLAGS (english) 2007-01-25 (configure change) Ensure CPPFLAGS env var is used when set (steffen) 2007-02-19 (configure change) Use SHLIB_SUFFIX=".so" on HP-UX IA64 (was ".sl") (hobbs) 2007-02-20 (bug fix)[1479814] Handle Windows NT \\?\... extended paths (thoyts) 2007-03-01 (bug fix)[1671138] Fix infinite loop in compiled foreach with an empty list (fellows) 2007-03-07 (enhancement) Improved Windows time zone tables to handle new US DST rules (kenny) 2007-03-09 (enhancement) Improved Y2038 compliance of zoneinfo files (kenny) 2007-04-02 (enhancement) Added bytecode compilation for global, variable, upvar and namespace upvar (sofer) 2007-04-20 (bug fix) Improve clock localization for Japanese locale (kenny) 2007-04-20 (enhancement) Document Tcl_SetNotifier & Tcl_ServiceModeHook (kenny) 2007-04-23 (bug fix) fts_open() crash on 64bit Darwin 8 or earlier (steffen) --- Released 8.5a6, April 25, 2007 --- See ChangeLog for details --- 2007-04-30 (bug fix)[1705778] many valgrind-detected leaks corrected 2007-05-01 (bug fix)[1710709] leak in [string map] (porter) 2007-05-02 (bug fix)[1710707] leaks in filesystem paths (mistachkin,kenny) 2007-05-18 (feature change) {expand} syntax support removed. (porter) *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** 2007-05-29 (bug fix)[1712723] Joinable thread death on 64-bit (virden,hobbs) 2007-05-30 (feature change)[1725186] When expanded literals are parsed, (example: {*}{1 2 3}), TCL_TOKEN_EXPAND_WORD token is no longer returned. Tokens reflecting the expansion are returned instead. (porter) *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** 2007-06-06 (platform support) Darwin: add plist to tclsh (steffen) 2007-06-12 (enhancement) [info] is now a [namespace ensemble] (fellows) 2007-06-20 (enhancement) better `make html` results (hobbs) 2007-06-21 (feature change)[1740962] leave traces created during execution of traced command do not fire (sofer) *** POTENTIAL INCOMPATIBILITY *** 2007-06-23 (bug fix) Darwin: prevent post-fork() abort() (steffen) 2007-06-27 (bug fix)[1743941] Infinite loop in Tcl_CreateTrace traces (porter) 2007-06-29 (enhancement) Tcl_Alloc alignment on Darwin (steffen) 2007-06-30 (bug fix)[1726873] crash in thread sync objects (vasiljevic,twylite) 2007-06-30 (bug fix)[1717186] [lsort -command \{ $l] leak (afredd,fellows) 2007-07-05 (bug fix)[1743676] no command named "" error message (porter,virden) 2007-07-11 (bug fix)[1752146] [while 1 {}] & [interp limit] on commands (sofer) 2007-07-31 (bug fix)[681877] tcl_platform(user) from system, not env (fellows) 2007-07-31 (enhancement)[1750051] space efficiency of Tcl variables (sofer) *** POTENTIAL INCOMPATIBILITY for C code that accesses internal Tcl structs Var, Bytecode, Namespace, or CallFrame. *** 2007-08-01 (enhancement)[1764318] word.tcl proc rewrites (petasis,fellows) 2007-08-08 (bug fix)[1770224] [tcl::mathop::>> $big1 $big2] errors (porter) 2007-08-14 (platform support) Darwin [load] from VFS on intel & 64bit (steffen) 2007-08-15 (bug fix)[1773127] corrected open mode "a+" (rottman,fellows) 2007-08-16 (bug fix)[1773040] ::errorInfo trace crash (janssen,porter) 2007-08-16 (performance)[1564517] precompile constant expressions (porter) 2007-08-21 (bug fix)[1775878] 'puts \' in interactive tclsh failed to move to prompt for continuation line (porter) 2007-08-25 (bug fix)[1781282] [clock scan] case senstivity (kenny) 2007-08-25 (performance)[1767293] ** on native integer types (kenny) 2007-09-03 clock tzdata updated to Olson's tzdata2007g (kenny) 2007-09-06 (platform support) Darwin: drop support for Xcode 1.5 project, add project for Xcode 3.0 (steffen) 2007-09-08 (bug fix)[1786481] nested [dict update] crash (fellows) 2007-09-08 (bug fix)[1710710] TclPtrSetVar leak (mistachkin,sofer) 2005-09-09 (feature removed) Tcl_ObjType "nsName" no longer registered (porter) *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("nsName") *** 2007-09-10 (bug fix)[1740631] Linked variable unlink prevention (maros,hobbs) 2007-09-11 (bug fix)[1786481] [dict update] stack management (sofer) *** POTENTIAL INCOMPATIBILITY with previous 8.5 alpha bytecode only *** 2007-09-11 (bug fix)[1578344] [package require -exact] 8.4 compat (porter) *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** 2007-09-11 (bug fix)[1772989,1071322] Support _, : in test constraints (porter) => tcltest 2.3b1 2007-09-11 (platform support) Windows AMD64 support (thoyts) 2007-09-14 (enhancement)[1793984] DTrace provider for Tcl (steffen) 2007-09-14 (bug fix)[1519940] surplus ns path invalidation (fellows,bauer) 2007-09-15 (platform support) SunOS-5.1x link with cc, not ld (steffen) 2007-09-17 (platform support)[1748251] Fix NetBSD link failures (english) (bug fix)[1066755] Several stack efficiency efforts increases recursion limit on Windows to be larger than the default [interp recursionlimit] value --- Released 8.5b1, September 26, 2007 --- See ChangeLog for details --- 2007-10-02 (bug fix)[1806422] proper [tcl::tm::path] autoload (porter) 2007-10-02 (bug fix) Improve Tcl_DecrRefCount() robustness (staplin) 2007-10-11 (bug fix)[1805887] [string is int -failindex] for 0o, 0b (porter) 2007-10-15 (bug fix)[1813528] Tcl_ParseBraces read past buffer (mistachkin) 2007-10-25 (bug fix)[1726873] intermittent crash in threads (vasiljevic) --- Released 8.5b2, October 26, 2007 --- See ChangeLog for details --- 2007-10-27 (bug fix)[1821159] fixed broken compile on x86_64 (sofer) 2007-10-27 (bug fix)[1810264] stop panic in RE lexer (fellows) 2007-10-28 (enhancement)[1826906] Embed iso8859-1 encoding in libtcl (fellows) 2007-11-01 (bug fix)[1808258] [string is ascii \000] (fellows) 2007-11-05 (bug fix)[1823576] [fconfigure $serial -xchar \000] (cassof) 2007-11-07 (performance)[1827996] binary glob matching (hobbs) 2007-11-07 (performance) binary [gets] (hobbs) 2007-11-09 (performance)[1829248] interp state reset (sofer) 2007-11-10 (performance) stack checking (sofer) 2007-11-10 (performance) list indexing bytecode (sofer) 2007-11-11 (performance)[1830038] macros to fetch Tcl_Obj intreps (sofer) 2007-11-11 (performance)[1830166] RE bytecode for simple cases (hobbs) 2007-11-13 (performance) [switch] & [regexp] use RE bytecode (hobbs, fellows) 2007-11-14 (performance) bytecode for [info exists] (fellows) 2007-11-15 (new feature)[1231022] configure option: --disable-rpath (fellows) 2007-11-15 (bug fix)[1810038] infinite loop in RE compiler (lane,porter) Many significant documentation improvements (fellows, sofer) --- Released 8.5b3, November 19, 2007 --- See ChangeLog for details --- 2007-11-20 (enhancement) string rep of dict has stable order (fellows) 2007-11-21 (enhancement) compiled ensemble support (fellows) 2007-11-22 (enhancement) [dict] is now an ensemble (fellows) 2007-11-23 (enhancement) [string] is now an ensemble (fellows) 2007-11-26 (bug fix)[1815573] Correct stack checking failure (sofer,golovan) 2007-11-27 (bug fix)[800753] Document single byte char limit for [chan configure -eofchar] (cassoff) 2007-12-03 (enhancement)[1836519] [switch $val $body] safe/fast (fellows,spjuth) 2007-12-03 (release) tcltest package bump to 2.3.0 (porter) 2007-12-03 (bug fix)[1618235] fix BSD compile errors (fellows) 2007-12-05 (bug fix)[1844789] fix [lsearch -exact -integer] crash (fellows) 2007-12-05 (performance)[1845092] Tcl_ObjType for channel names (hobbs) 2007-12-14 (bug fix)[1602539] NUL pollution in [glob] result (hobbs) 2007-12-17 (bug fix)[1851832,1851524] memory alignment correction (sofer) 2007-12-18 (bug fix)[1810264] revised regexp engine to prevent debilitating over-consumption of resources (drewry,lane,ormandy,fellows) Several documentation and release notes improvements --- Released 8.5.0, December 20, 2007 --- See ChangeLog for details --- 2007-12-23 (bug fix)[1857126] restore backref support to regexps (hobbs) 2007-12-26 (enhancement)[1856994] [lsort] performance (sofer) 2008-01-10 (bug fix)[1867855] fix [format %lli 0] crash (porter) 2008-01-11 (bug fix)[1850424,1860425] stack checking on *bsd (sofer,noble) 2008-01-13 (bug fix)[1353846] crash in read-only serial (hobbs,newman) 2008-01-15 (bug fix)[1869989] mem leak; expr literals (porter,melbardis) 2008-01-20 (bug fix)[1869405] binary [gets]; stacked channels (hobbs,ficicchia) 2008-01-22 (bug fix)[1867855] fix [lreverse {}] crash (sofer,madden) 2008-01-30 (bug fix)[1882373] fix Tcl_GetAlias pointer code (an00na) Several documentation and release notes improvements --- Released 8.5.1, February 5, 2008 --- See ChangeLog for details --- 2008-02-06 (enhancement) [clock format] performance (kenny) 2008-02-12 (bug fix)[1891827] compiled [switch -nocase] error (fellows) 2008-02-22 (bug fix)[1818565] missing state array in http::status (thoyts) => http 2.5.4 2008-02-26 (bug fix)[1868845] corrected [eof] ordering (thoyts) 2008-02-26 (new feature) [http::meta] command (thoyts) => http 2.5.5 2008-02-26 (bug fix)[1902436] fixed regexps ending in \* (hobbs) 2008-02-27 (bug fix)[1862555,1902423] [clock] range & l10n (kenny) 2008-02-28 (bug fix) [return -level 0] memory leak (porter) 2008-02-28 (bug fix) [format %llx $big] memory leak (porter) 2008-02-28 (bug fix) expression parser error message memory leak (porter) 2008-02-28 (bug fix) memory leak when enter trace modifies command (porter) 2008-02-29 (enhancement) Consumer refcounting for Tcl_SetReturnOptions() and Tcl_AddObjToErrorInfo() (spjuth,porter) *** POTENTIAL INCOMPATIBILITY *** 2008-03-07 (bug fix)[1899164] Avoid expr and script bytecode confusion (porter) 2008-03-07 (bug fix)[1904907] finalize crash in Tcl_GetReturnOptions (kupries) 2008-03-10 (bug fix)[1893815] expr {abs(-1e-350)} => -0.0 (porter) 2008-03-10 (bug fix)[1901113] crash in [tcl::Bgerror {} {}] (madden,porter) 2008-03-11 (bug fix)[1911919] unset trace inf loop in namespace delete (sofer) 2008-03-12 (new feature) some HTTP 1.1 support in http (and more!) (hobbs) => http 2.7 2008-03-13 (enhancement) support space in INSTALL_ROOT or $builddir (steffen) 2008-03-16 (bug fix)[1903325] bytecode stack space prediction crash (fellows) 2008-03-18 (bug fix)[1914604] Tcl Modules: encoding fixed to utf-8; environment variables without "." added to customization hooks (kupries) *** POTENTIAL INCOMPATIBILITY *** 2008-03-18 (bug fix)[1914503] alignment of TclStackAlloc() return (sofer)\ 2008-03-20 (bug fix)[1868171] expose Tcl_GetMemoryInfo (for AOLserver) (fellows) 2008-03-24 (bug fix)[1923966] crash in [binary format x0s] (thoyts) 2008-03-27 (platform support)[1921166] Solaris 64bit build fixes (steffen) 2008-03-27 clock tzdata updated to Olson's tzdata2008b (kenny) --- Released 8.5.2, March 28, 2008 --- See ChangeLog for details --- 2008-03-30 (bug fix)[1783544] more robust TclIsNaN() (kenny,teterin) 2008-04-01 (interface)[1819422] tclStubsPtr no longer in libtcl (porter) *** POTENTIAL INCOMPATIBILITY *** 2008-04-01 (bug fix)[1839067] FP round fix for Solaris/x86 (kupries,schlenker) 2008-04-02 (bug fix)[780533,1932639] [fcopy] callbacks unreliable (ferrieux) 2008-04-02 (interface)[1819422] libtclstub symbols MODULE_SCOPE (steffen) 2008-04-04 (bug fix) [chan postevent] crash (kupries) 2008-04-07 (bug fix) Fix broken [format {% d}] (max) 2008-04-07 (bug fix)[1350564] Bi-directional [fcopy] now supported (ferrieux) 2008-04-16 (bug fix)[1938497] Tcl_SetNotifier() fixes (steffen) 2008-04-16 (interface)[1938497] make stubs tables 'static const' (steffen) 2008-05-02 (new feature) [binary] is now a [namespace ensemble] (thoyts) 2008-05-07 (bug fix) [dict append] crash (mccormack,fellows) 2008-05-21 (bug fix)[1968882] [info complete "\\\n"] => 0 (porter) 2008-05-22 (bug fix)[1968245] Tcl_LogCommandInfo() accept length=-1 (darroch) 2008-05-23 (bug fix)[1965787] 32-bit overflow in [tell] result (ferrieux) 2008-05-31 (new feature)[TIP 257] [oo::*] commands from TclOO (fellows) 2008-06-04 (new feature)[TIP 317] [binary encode]; [binary decode] (thoyts) 2008-06-06 (new feature)[TIP 230] [chan push]; [chan pop] (kupries) 2008-06-08 (enhancement)[1973096] bytecompiled [uplevel] scripts (sofer) 2008-06-12 (platform support) Solaris static build with DTrace (steffen) 2008-06-12 (platform support) Solaris/amd64 gcc 64bit support (steffen) 2008-06-13 (new feature)[TIP 285] [interp cancel]; Tcl_CancelEval() (mistachkin) 2008-06-20 (bug fix)[1999035] make [interp bgerror $i] act in $i (porter) 2008-06-23 (bug fix)[1972879] bad path intrep caching (porter) 2008-06-24 (bug fix)[1999176] crash in [glob -dir {} a] (porter) 2008-06-25 (bug fix)[1999119] Support TM packages in Safe Base (kupries) --- Released 8.6a1, June 25, 2008 --- See ChangeLog for details --- 2008-06-29 (bug fix)[2004480] plug memory leaks (ade,porter,steffen) 2008-07-01 (enhancement)[1905562] embed recursion limit in RE engine (fellows) 2008-07-03 (bug fix)[1969717] fix package finding on Samba shares (jos) 2008-07-03 (bug fix)[1987821] mem leak in [seek] on reflected chan (kupries) 2008-07-13 (enhancement)[2017110] new Non-Recursive Evaluation implementation enables deep Tcl evaluation stacks without deep C stacks. (sofer) 2008-07-20 (enhancement)[2008248] dict->list preserve item intreps (pasadyn) 2008-07-21 (bug fix)[582506] imported cmds now fire execution traces (sofer) 2008-07-21 (bug fix)[2015723] [file] bad use of inodes on Windows (thoyts) 2008-07-21 (new feature)[TIP 304] [chan pipe] (ferrieux) 2008-07-21 (bug fix)[2021443] more consistent "wrong # args" msgs (nijtmans) 2008-07-21 (enhancement) [info frame] returns file data in more cases (kupries) 2008-07-29 (bug fix)[2030670] fix rare panic in TclStackFree (pasadyn,sofer) 2008-08-01 Tcl_Finalize() no longer called implicitly on DLL_PROCESS_DETACH. 2008-08-05 (enhancement)[1994512] async connect logic simplified (jenglish) 2008-08-06 (bug fix)[2040295] stopped supplying a workaround for bugs in Itcl's use of [namespace code]. Itcl now supplies its own workaround. *** POTENTIAL INCOMPATIBILITY for older Itcl releases *** 2008-08-06 (bug fix)[2039178] repaired guard against dispatching oo methods in a deleted interp. (porter) 2008-08-08 tzdata updated to Olson's tzdata2008e (kenny) 2008-08-11 (bug fix)[2046846] 64bit support for http zlib crc (thoyts) => http 2.7.1 2008-08-11 (enhancement) automatic [package provide] for TMs (kupries) 2008-08-17 (bug fix)[2055782] crash involving Tcl_ConcatObj (sofer) 2008-08-21 (new feature) CONST-ified Tcl routines passing (Tcl_ObjType *), (Tcl_Filesystem *), or (Tcl_Timer *) arguments (nijtmans,porter) *** POTENTIAL INCOMPATIBILITY *** 2008-08-21 (bug fix)[2065115] Restored ***= regexp functioning (hobbs,porter) --- Released 8.6a2, August 25, 2008 --- See ChangeLog for details --- 2008-08-29 (bug fix)[2082299] Install TclOO header files (fellows) 2008-09-01 oo methods called during interp deletion no longer skipped if they do not need the dying interp (fellows) 2008-09-02 (support) Dropped support for pre-ANSI compilers. (porter) 2008-09-04 (bug fix)[2093947] var unset trace in coroutine (fellows,sofer) 2008-09-10 (enhancement) efficient list->dict conversion (elby,fellows) 2008-09-10 (bug fix)[2102930] faulty numLevels count (madden,sofer) 2008-09-16 (bug fix)[2114165] eval failure following cancel (sofer) 2008-09-17 (bug fix)[2116053] export [min] and [max] from tcl::mathfunc (sofer) 2008-09-22 (new feature)[TIP 320] oo common variable declaration (fellows) 2008-09-24 (new feature)[TIP 316] portable access to Tcl_StatBuf (fellows) 2008-09-24 (new feature)[TIP 323] [file delete], [file mkdir] zero pathNames (porter) 2008-09-25 (new feature)[TIP 315] new var: tcl_platform(pathSeparator) (vu,fellows) 2008-09-25 (new feature)[TIP 323] [global], [variable] zero varNames (porter) 2008-09-26 (new feature)[TIP 323] [lassign], [namespace upvar], [my variable] zero varNames (porter) 2008-09-26 (new feature)[TIP 323] [tcl::tm::path add|remove] zero pathNames (porter) 2008-09-26 (new feature)[TIP 323] [lrepeat] zero elements; zero repeats (porter) 2008-09-27 (bug fix)[2130992] prevent overflow crash in [lrepeat] (fellows) 2008-09-28 (new feature)[TIP 314] ensemble parameters before subcommand (hellstrУЖm,fellows) 2008-09-29 (new feature)[TIP 318] revised defaults for [string trim] (poser) *** POTENTIAL INCOMPATIBILITY *** 2008-09-29 (new feature)[TIP 313] [lsearch -bisect] (spjuth) 2008-09-29 (new feature)[TIP 326] [lsort -stride] (elby) 2008-09-29 (new feature)[TIP 323] [linsert] zero elements (porter) 2008-09-29 (new feature)[TIP 323] [glob] zero patterns (porter) 2008-10-02 (new feature)[TIP 330] interp->result access disabled (kenny) *** POTENTIAL INCOMPATIBILITY *** 2008-10-03 (new feature)[TIP 265] Tcl_ParseArgv() (bromley) 2008-10-03 (new feature)[TIP 195] [tcl::prefix] (spjuth) 2008-10-04 (new feature) CONST-ified Tcl routines Tcl_GetIndexFromObj, Tcl_RegisterConfig, Tcl_InitCustomHashTable, and routines passing (Tcl_ChannelType *). (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2008-10-04 (bug fix)[2059262] unload only libraries marked unloadable (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2008-10-05 (new feature)[TIP 331] [lset listVar end+1 $value] (kenny) 2008-10-05 (bug fix)[2143288] correct bad isqrt() results (boffey,kenny) 2008-10-05 (new feature) CONST-ified return value of the Tcl_FSFileAttrStringsProc prototype. (nijtmans) *** POTENTIAL INCOMPATIBILITY for Tcl_Filesystems *** 2008-10-07 (new feature)[TIP 327] [tailcall] (sofer) 2008-10-07 (new feature)[TIP 328] [coroutine],[yield],[info coroutine] (sofer) 2008-10-08 (bug fix)[2151707] fix stack trace from variable trace (porter) 2008-10-10 (bug fix)[2155658] crash in oo method export (fellows) --- Released 8.6a3, October 10, 2008 --- See ChangeLog for details --- 2008-10-13 (bug fix) Fix ability to join threads on 64-bit Windows (thoyts) 2008-10-23 (bug fix)[2186888] Direct-eval [for] handling of [continue] was broken by NRE reform (sofer,porter) 2008-10-24 (bug fix) fix failure to read SHOUTcast streams (thoyts) => http 2.7.2 2008-10-27 (enhancement) system encoding at startup is now "iso8859-1", and no longer "identity". Use of identity encoding minimized (porter) *** POTENTIAL INCOMPATIBILITY *** 2008-10-31 (bug fix)[2200824] revised [oo::define] to include caller context when resolving names. (nassau,fellows) 2008-11-10 (bug fix)[2255235] [platform::shell::LOCATE] update (ring,kupries) => platform::shell 1.1.4 2008-11-13 (bug fix)[2269431] VFS [load] -> tempfile litter (ficicchia,nijtmans) 2008-11-26 (bug fix)[2114900] updated tclIndex file (cassoff,kenny) 2008-11-27 (bug fix)[2251175] [{*}{\{}] errors (hellstrУЖm,ferrieux,porter) 2008-11-29 (new feature)[TIP 210] [file tempfile] (techentin,fellows) 2008-11-30 (bug fix)[2362156] [clock]: colon in format string (mizuno,kenny) 2008-12-02 (bug fix)[2270477] hang in channel finalization (ferrieux,kupries) 2008-12-02 (new feature)[TIP 336] Tcl_*ErrorLine() routines. Direct access to the errorLine field of the interp struct denied by default. (porter) *** POTENTIAL INCOMPATIBILITY *** *** Define USE_INTERP_ERRORLINE to restore access for legacy code *** 2008-12-04 (bug fix)[2385549] [file normalize] failed on some paths (porter) 2008-12-05 (new feature)[TIP 307] Tcl_TransferResult() (leunissen,fellows) 2008-12-05 (new feature)[TIP 335] Tcl_InterpActive() (mistachkin,fellows) 2008-12-09 (new feature)[TIP 337] Tcl_BackgroundException() (porter) 2008-12-10 (new feature)[TIP 341] >1 [dict filter] patterns (hellstrУЖm,fellows) 2008-12-10 (new feature)[TIP 343] [format %b $n] [scan $s %b] (ferrieux) 2008-12-10 tzdata updated to Olson's tzdata2008i (kenny) 2008-12-11 (new feature)[TIP 234] [zlib] and Tcl_Zlib*() (sheffers,fellows) 2008-12-11 (bug fix)[2407783] spoil ChannelState when channel name passes among multiple interps (kupries) 2008-12-12 (new feature)[TIP 322] Tcl_NR*() routines to enabled non-recursive evaluation in extensions (sofer,kenny) 2008-12-09 (new feature)[TIP 338] Tcl_*StartupScript() (porter) *** POTENTIAL INCOMPATIBILITY for callers of Tcl*Startup* routines *** 2008-12-16 (new feature)[TIP 329] [try] [throw] (davel,fellows) 2008-12-17 (new feature)[TIP 308] package tdbc 1.0b1 (kenny) 2008-12-18 (new feature)[TIP 332] [close $chan read|write] (ferrieux) 2008-12-18 (bug fix)[2444274] panic in long commands from {*} (goth,porter) --- Released 8.6b1, December 19, 2008 --- See ChangeLog for details --- 2008-12-27 [TIP 234] Tcl_Zlib* interface revisions (fellows) *** INCOMPATIBILITY with interface of 8.6b1 *** 2009-01-02 (platform support)[878333] IRIX compat for mkstemp() (fellows) 2009-01-03 (bug fix)[2481670] [clock add] error message (talvo) 2009-01-05 (bug fix)[2412068] NR-enable [source] (fellows) 2009-01-06 (bug fix)[2489836] crash unknown method dispatch (nadkarni,fellows) 2009-01-06 (bug fix)[2481109] fix context of instance name check (fellows) 2009-01-08 (enhancement) more -errorcode values (fellows) 2009-01-19 (new feature) CONFIG_INSTALL_DIR - where tclConfig.sh goes (cassoff) 2009-01-19 (platform support) better tools for BSD ports (cassoff) 2009-01-21 (bug fix)[2458202] exit crash with [chan create]d channel (kupries) 2009-01-26 (bug fix)[2446662] uniformly declare EOF on RST on sockets (ferrieux) 2009-01-26 (bug fix)[1028264] delay WSACleanup() from under our feet (ferrieux) 2009-01-29 (bug fix)[2519474] Tcl_FindCommand() bug exposed by oo (fellows) 2009-01-29 (bug fix)[2537939] Fix Tcl_OOInitStubs() for no-stubs build (fellows) 2009-02-04 (bug fix)[2561746] [string repeat] overflow crash (porter) 2009-02-05 (enhancement) optimize string operations on bytearrays (fellows) 2009-02-12 (bug fix) enable simpler [oo::define] extension (ferri,fellows) 2009-02-15 (bug fix)[2603158] Tcl_AppendObjToObj: append to self crash (porter) 2009-02-17 (platform support) MSVC and _WIN64 (hobbs) 2009-02-20 (bug fix)[2571597] [file pathtype /a] wrong result (nadkarni,porter) 2009-03-03 (bug fix)[2662434] [zlib crc32] result now unsigned (gavilan,fellows) 2009-03-15 (platform support) translate SIGINFO where defined (BSD) (teterin) 2009-03-15 (bug fix)[2687952] TSD struct memleak (mistachkin) 2009-03-18 (bug fix)[2688184] memleak in [file normalize] (mistachkin) 2009-03-20 (bug fix)[2597185] crash in Tcl_AppendStringToObj (porter) 2009-03-20 (bug fix)[2561794,2669109,2494093,2553906] string overflow (porter) 2009-03-22 (bug fix)[2502037] NR-enable [namespace unknown] (sofer) 2009-03-27 (bug fix)[2710920] [file dirname|tail /foo/] errors (epler,porter) 2009-04-08 (bug fix)[2570363] unsafe [eval]s in tcltest (bron,porter) => tcltest 2.3.1 2009-04-08 (platform support) more Darwin kernel patterns (steffen) => platform 1.0.4 2009-04-09 (bug fix)[26245326] [http::geturl] connection failures (golovan) => http 2.7.3 2009-04-10 (new feature) Darwin: embeddable CoreFoundation notifier (steffen) 2009-04-10 (bug fix)[1961211] Darwin [load] back-compatibility (steffen) 2009-04-09 (new feature) http chunked+gzip modes (thoyts) => http 2.8.0 2009-04-11 (enhancement) clarified cmd name resolution in oo forwards (fellows) 20009-04-19 (bug fix)[2715421] http: excess bytes after POST (thoyts) => http 2.8.1 2009-04-30 (bug fix)[2486550] coroutine in [interp invokehidden] (sofer) 2009-05-07 (bug fix)[2785893] find command in deleted namespace (sofer) 2009-05-08 (bug fix)[2414858] tailcall in oo constructor (fellows) 2009-05-14 (new subcommand)[TIP 354] [info object namespace] (fellows) 2009-05-29 (platform support) account for ia64_32 (kupries) => platform 1.0.5 2009-06-02 (bug fix)[2798543] incorrect [expr] integer ** results (porter) 2009-06-10 (bug fix)[2801413] overflow in [format] (porter) 2009-06-13 (bug fix)[2802881] corrected compile env context (tasada,porter) 2009-06-17 (redesign) reduced ambition of [exit] finalization with aim to avoid otherwise very tricky multi-thread finalization bugs. (staplin,ferrieux) *** POTENTIAL INCOMPATIBILITY for exit handlers *** 2009-06-26 (platform support) updates for Xcode 3.1 & 3.2 (steffen) 2009-06-30 (platform support) clang static analyzer macros (steffen) 2009-07-01 (bug fix)[2806622] Win: bad tcl_platform(user) value (thoyts) 2009-07-05 (bug fix) zlib support asynch [chan copy] on chan transform (fellows) 2009-07-12 (bug fix)[1895546] TclOO support for Itcl 4 method caching (fellows) 2009-07-13 (bug fix)[1605269] NR-related [info frame] fixes (kupries) 2009-07-14 (bug fix)[2821401] NR-enable direct eval [switch] (kenny) 2009-07-16 (bug fix)[2819200] underflow settings on MIPS systems (porter) 2009-07-19 (interface)[TIP 354] new routine Tcl_GetObjectName() (fellows) 2009-07-20 (performance) favor [string is] success cases over empty (fellows) 2009-07-22 (interface) removed TclpPanic() routine (nijtmans) 2009-07-23 (bug fix)[2820349] plug event leak in notifier (mistachkin) 2009-07-24 (bug fix)[2826248] crash in Tcl_GetChannelHandle (sonnenburg,kupries) 2009-07-31 (bug fix)[2830354] overflow in [format] (misch,porter) 2009-08-06 (bug fix)[2827000] reflected channels can signal EGAIN (kupries) 2009-08-12 (new feature)[TIP 353] Tcl_NRExprObj() (porter) 2009-08-20 (bug fix)[2823276] NR-enable [if], [for], [while] (fellows) 2009-08-20 (bug fix)[2806250] EIAS violation in ~foo pathnames (porter) 2009-08-21 (bug fix)[2837800] [glob */foo] return ./~x/foo (porter) 2009-08-24 (bug fix) nested event loop notifier w/TkAqua Cocoa (alaoui,steffen) 2009-08-25 (bug fix) [info frame] account for continuation lines (kupries) 2009-08-27 (bug fix)[2845535] overflows in [format] (porter) 2009-09-01 (bug fix) improved error message in tcltest (porter) => tcltest 2.3.2 2009-09-11 (bug fix)[2849860] http handle "quoted" charset value (fellows) => http 2.7.4 2009-09-11 (enhancement)[2314561] [subst] now bytecompiled, NR-enabled (porter) 2009-09-24 (new feature)[TIP 356] Tcl_NRSubstObj() (porter) 2009-10-04 (bug fix)[2569449] Core Foundation memory bug in Tiger (steffen) 2009-10-06 (bug fix) repair intrep loss in slave interp evaluations introduced by first versions of the NRE conversion (nadkarni,porter) 2009-10-06 (bug fix)[1941434] broken tclTomMath.h includes (porter) 2009-10-07 (bug fix)[2871908] leaked hash table (mistachkin,kupries) 2009-10-08 (bug fix)[2874678] bignum leak in [dict incr] (fellows) 2009-10-17 (bug fix)[2629338] crash in var unset traces (raney,fellows) 2009-10-19 (bug fix)[2107634] extend [read] and [gets] to Tcl string limits (morrison,parker,porter) 2009-10-21 (bug fix)[2882561] Haiku OS signal support (morrison,fellows) 2009-10-22 (bug fix)[2883857] [my varname arr(index)] (boudaillier,fellows) 2009-10-23 (bug fix) 0-length writes: spurious SIG_PIPE (teterin,kupries) 2009-10-24 Broken DST applied EU rules to US zones (lehenbauer,kenny) 2009-10-29 (bug fix)[2800740] halved bignum memory on 64-bit systems (porter) *** POTENTIAL INCOMPATIBILITY *** 2009-11-05 (bug fix)[2854929] TM search path support in Safe Base (kupries) 2009-11-05 (enhancement) rewrite of the Safe Base commands (kupries) 2009-11-11 (bug fix)[2888099] [close] loses ENOSPC error (khomoutov,ferrieux) 2009-11-11 (bug fix)[2891171] RFC 3986 compliance for ? in URL (nijtmans) => http 2.8.2 2009-11-12 (bug fix)[2895565] [fcopy -size] miscounts when converting encodings (kupries) 2009-11-16 (bug fix)[2891556] encoding finalization crash (mistachkin,ferrieux) 2009-11-18 (bug fix)[2849797] consistent names for std chans (nijtmans,fellows) *** POTENTIAL INCOMPATIBILITY *** 2009-11-19 (enhancement) [load]able Tcltest extension (nijtmans) 2009-11-24 (bug fix)[2893771] [file stat] on Win locked files (thoyts) 2009-11-24 (bug fix)[2903011] crash call destructor from constructor (fellows) 2009-12-03 (bug fix)[2906841] Safe Base [glob ../*] fixes (fellows) 2009-12-09 (bug fix)[2901998] consistent I/O buffering (ferrieux,kupries) 2009-12-11 (bug fix)[2806407] NR-enabled coroutines (sofer) 2009-12-16 (bug fix)[2913616] msgcat: improved safe interp support (fellows) => msgcat 1.4.3 2009-12-22 (bug fix)[2918962] [lsort -index -stride] crash (moore,fellows) 2009-12-23 (bug fix)[2913625] [info script/nameof] in safe interps (fellows) 2009-12-28 (bug fix)[2891362] enable time limit in child interps (fellows) 2009-12-29 (bug fix)[2922555] [binary decode hex { }] crash (thoyts) 2009-12-29 (bug fix)[2895741] enable min(), max() in safe interps (fellows) 2009-12-30 (bug fix)[2824981] guard [unknown] against [set] undef (sofer) 2010-01-05 (bug fix)[2918610] [file rootname] corruption (magerya,porter) 2010-01-18 (bug fix)[2932421] less [format %s] shimmer (ferrieux) 2010-01-18 (bug fix)[2918110] [chan postevent] crash (bron,kupries) 2010-01-21 (bug fix)[2910748] NR-enable epoch fallback direct eval (sofer) 2010-01-30 (enhancement) [unset] now bytecompiled (fellows) 2010-02-01 (bug fix)[2942697] faster match: some pathological regexp patterns (lane,fellows) 2010-02-01 (bug fix)[2939073] [array unset] unset trace crash (ferrieux) 2010-02-02 (bug fix)[2944404] crash in oo destructor (fellows) 2010-02-02 (new feature) [array] is now a [namespace ensemble] (fellows) 2010-02-05 (enhancement) [error] now bytecompiled (fellows) 2010-02-08 (bug fix)[2947783] Tcl_Zlib*flate fail on shared values (fellows) 2010-02-09 (enhancement) [try] now bytecompiled (fellows) 2010-02-11 (bug fix)[2826551] line-sensitive matching in regexp (dejong) 2010-02-11 (bug fix)[2949740] [open |noSuch rb] crash (kovalenko,fellows) 2010-02-15 (bug fix)[2950259] harden (delete obj ns -> delete obj) (fellows) 2010-02-21 (bug fix)[2954959] get sign of abs($zero) right (nijtmans) 2010-02-22 (bug fix)[2762041] zlib chan transforms read EOF too early (kupries) 2010-02-27 (bug fix)[801429] Tcl_SetMainLoop() thread safety (fellows) *** POTENTIAL INCOMPATIBILITY *** 2010-03-02 (enhancement) -fvisibility-hidden build support (nijtmans) 2010-03-04 (bug fix)[2962664] [oo::class destroy] crash (fellows) 2010-03-05 (interface) TclOO typedefs for function pointers (fellows) *** POTENTIAL INCOMPATIBILITY *** 2010-03-09 (bug fix)[2936225] stop [chan copy] to slow channel consuming all memory with buffer backup (ferrieux) 2010-03-17 (bug fix)[2921116] crash in chan transfrom teardown (kupries) 2010-03-19 (enhancement) [throw] now bytecompiled (fellows) 2010-03-20 (enhancement) permit [fcopy] of > 2**31 bytes (fellows) 2010-03-24 (new feature) [info object methodtype] (fellows) 2010-03-24 (bug fix)[2383005] [return -errorcode] reject non-list (porter) 2010-03-25 (bug fix)[2976504] broken fstatfs() call (reeuwijk,fellows) 2010-03-30 (new feature)[TIP 362] [registry -32bit|-64bit] (courtney,fellows) => registry 1.3 2010-03-30 (bug fix)[2978773] refchan mem preservation (kupries) 2010-04-02 (new feature)[TIP 357] Tcl_LoadFile, Tcl_FindSymbol, etc. (kenny) 2010-04-05 (configure change)[TIP 364] default build: --enable-threads (fellows) *** POTENTIAL INCOMPATIBILITY *** 2010-04-02 (new feature)[TIP 348] [info errorstack], [return -errorstack] (ferrieux) 2010-04-20 (enhancement) update bundled zlib to 1.2.5 (nijtmans) 2010-04-29 (enhancement)[2992970] optimize bytearray appends (fellows) 2010-05-19 (bug fix)[3004007] dict/list shimmer w/o string rep loss (fellows) 2010-06-09 (bug fixes) platform: several fixes for 64 bit systems (kupries) => platform 1.0.9 2010-06-16 (bug fix)[3016135] [clock format] in he_IL locale (nijtmans) 2010-06-18 (bug fix)[3017997] Add .cmd to file extensions for [exec] (fellows) 2010-06-28 (bug fix)[3019634] support errno.h changes in MSVC++ 2010 (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2010-07-02 (enhancement) -errorcode for [expr] domain errors (fellows) 2010-07-28 (bug fix)[3037525] crash deleting vars @ callframe pop (sofer) 2010-08-04 (bug fix)[3034840] mem corrupt when refchan loses interp (kupries) 2010-08-04 (enhancement) Win [load] use LOAD_WITH_ALTERED_SEARCH_PATH (hobbs) 2010-08-04 (platform support) panic on detection of win9x system (hobbs) *** POTENTIAL INCOMPATIBILITY *** 2010-08-10 (fix) Handle non-null-terminated bytearrys in glob matching (hobbs) 2010-08-11 (fix) copy-paste bug in [yield] implementation (sofer, goth) 2010-08-11 (platform) Drop pre-aix 4.2 support, ldAix (hobbs) 2010-08-14 (frq)[2819611] changed signatures of hash fnctions, delete-file, and get-native-path (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2010-08-15 (bug fix)[3045010] tweaked error message for wrong#args of lambda's (fellows) 2010-08-18 (bug fix)[3004191] fixed safe [glob] (fellows) 2010-08-21 (patch)[3034251] genStubs steal features of ttkGenStubs (nijtmans) 2010-08-26 (bug fix)[1230554] configure, OSF-1 problems, windows manifest issues (hobbs) 2010-08-30 (bug fix) [3046594,3047235,3048771] reimplemented tailcall (sofer) 2010-08-31 fixed manifest handling on windows (hobbs, kupries) 2010-08-31 windows makefile and stub changes (nijtmans) 2010-09-01 (bug fix)[3057639] compiled lappend trace consistency (hobbs,kupries) *** POTENTIAL INCOMPATIBILITY *** 2010-09-01 fixed safe glob handling of -directory (kupries) 2010-09-02 fixed safe glob handling of -join (kupries) 2010-09-08 (bug fix)[3059922] build with mingw on amd64 (porter, mescalinum) 2010-09-15 (bug fix)[3067036] stop hang in bytearray append (fellows) 2010-09-22 unified set of link libraries between mingw and vc (nijtmans) 2010-09-22 (bug fix)[3072640] protect writes to ::error* variables (sofer) 2010-09-23 fix leak of return options [catch $err m constant] (porter, hobbs) 2010-09-24 (bugfix)[3056775] fixed race condition in windows sockets (kupries) 2010-09-24 (performance) string eq/cmp (hobbs) 2010-09-26 (patch)[3072080] rewritten NRE core (sofer) 2010-09-28 (new feature)[TIP 162] implementation of ipv6 sockets (max) 2010-10-02 (bug fix)[3079830] properly invalidate string rep of dicts (fellows) 2010-10-06 (bug fix)[3081065] fix writing to freed Tcl_Obj (porter) 2010-10-08 fix in ipv6 code on windows (nijtmans) 2010-10-09 fixed overallocation of execution stack (sofer) 2010-10-11 windows unicode changes (nijtmans) 2010-10-12 (bug fix)[3084338] fixed meamleak in ipv6 code (max) 2010-10-13 (bug fix)[467523,983660] alt fix allows empty literal share (porter) 2010-10-15 (bugfix)[3085863] updated unicode tables (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2010-10-16 refactored implementation of dict iteration (fellows) 2010-10-17 (patch)[2995655] report inner contexts on error stack (ferrieux) 2010-10-19 (bug fix)[3081008] fixed bytearray zlib interaction (fellows) 2010-10-19 improved crc, appending to bytearray (fellows) 2010-10-20 improved compilation of [dict for] (fellows) 2010-10-26 Added private support to disable reverse dns (max) 2010-10-26 Prevent crashes when querying socket options (fellows, max) 2010-10-28 (bug fix)[3093120] prevent freeaddrinfo(NULL) (porter, virden) 2010-10-29 (bug fix)[2905784] stop cycle waste in short [after] (ferrieux) 2010-11-01 tzdata updated to Olson's tzdata2010o (kenny) 2010-11-04 (bug fix)[3099086] Clarified docs of var substitution (fellows) 2010-11-04 improved install targets (cassof) 2010-11-04 improved testing of sockets (max) 2010-11-05 (frq)[491789] setargv/unicode cmdline for MSVC (nijtmans) 2010-11-09 (bug fix)[3105999] fixed memleak in OO var resolver (fellows) 2010-11-15 (TIP 378)[3081184] improved TIP 280 performance (kupries) 2010-11-16 (platform) VS 2005 SP1 MSVC compiler (nijtmans) 2010-11-18 (bug fix)[3111059] leak in [namespace delete] w coroutines (sofer) 2010-11-28 [3120139,3105247] Tcl_PrintDouble improvements (kenny) 2010-11-29 (new cmd) [tcl::unsupported::inject] (ferrieux,sofer) 2010-11-30 (enhancement) Restore TclFormatInt for performance (hobbs) 2010-12-09 (new feature) [file] is now a [namespace ensemble] (fellows) 2010-12-19 (bug fix) [fcopy -size 1 -command] asynchronous (ferrieux) 2010-12-12 (platform) OpenBSD build improvements (cassoff) 2010-12-17 (platform) Revisions to support rpm 4.4.2 (cassoff) 2010-12-27 (bug fix) crash in [lsort] w multiple -index options (fellows) 2010-12-30 (bug fix)[3142026] GrowEvaluationStack OBOE (harder,sofer) 2011-01-18 (bug fix)[3001438] [info frame -1] crash (mccormack,fellows) 2011-03-01 (performance)[3168398] optimize [interp cancel] (mistachkin) 2011-03-05 (bug fix)[3185009] crash in OO variables (danckaert,fellows) 2011-03-05 (new cmd) [tcl::unsupported::assemble] (ugurlu,kenny) 2011-03-06 (bug fix)[3200987,3192636] parser buffer overruns (porter) 2011-03-08 (bug fix)[3202905] failed intrep release of interp result (mccormack) 2011-03-09 (bug fix)[3202171] repair [namespace inscope] optimizer (porter) 2011-03-10 (new version) better tcltest reporting from child interps (fellows) => tcltest 2.3.3 2011-03-10 (new feature) [namespace] is now a [namespace ensemble] (fellows) 2011-03-12 (interface) reduce casting by ckalloc(), ckfree() callers (fellows) 2011-03-14 (bug fix) Fixes from libtommath 0.42.0 release (fellows) 2011-03-21 (bug fix)[3216070] [load] extension from embed Tcl apps (nijtmans) ***POTENTIAL INCOMPATIBILITY*** 2011-03-27 (performance) NRE: LIST lset foreach benchmark (twylite) 2011-04-11 (bug fix)[3282869] coroutine + eval + locals crash (ferrieux,sofer) 2011-04-13 (bug fix)[2662380] crash when variable append trace unsets (sofer) 2011-04-13 (bug fix)[3285375] Buffer overflow in [concat] (porter) 2011-05-02 (internals change) revised TclFindElement() interface (porter) *** POTENTIAL INCOMPATIBILITY *** 2011-05-05 (enhancement) dict->list w/o string rep generation (porter) 2011-05-10 (bug fix)[3173086] Crash parsing long lists (rogers,porter) 2011-05-24 (enhancement) msgcat internal improvements (fellows) => msgcat 1.4.4 2011-05-25 (TIP 381) [info object|class call] [self call] [nextto] (fellows) 2011-05-31 (bug fix)[3293874] let lists grow all the way to the limit (porter) 2011-06-02 (bug fix)[3185407] cmd resolution epoch flaw (nadkarni,fellows) 2011-06-13 (bug fix)[3315098] mem leak generating double string rep (neumann) 2011-06-22 (new feature) DEB_HOST_MULTIARCH support (kupries) => platform 1.0.10 2011-07-15 (bug fix)[3357771] Prevent circular refs in bytecode (porter) 2011-07-28 tzdata updated to Olson's tzdata2011h (porter) 2011-08-01 (bug fix)[3383616] memleak exposed by XOTcl (neumann,sofer) Many more Tcl built-in command errors now set an -errorcode. --- Released 8.6b2, August 8, 2011 --- See ChangeLog for details --- 2011-07-02 (bug fix)[3349507] correct double(1[string repeat 0 23]) (kenny) 2011-07-19 (bug fix)[3371644] Tcl_ConvertElement() segfault (sader, ferrieux) 2011-07-21 (bug fix)[3372130] hypot(.) segfault (nijtmans) 2011-08-12 (bug fix)[3389764] memleaks due to reference cycles in dup'd paths 2011-08-15 (bug fix)[3390272] leak of [info script] value (porter) 2011-08-17 (bug fix)[3393150] bignum leaks in Tcl_Get*() routines (porter) 2011-08-18 (bug fix)[3393714] [string toupper] overflow (nijtmans) 2011-08-30 (bug fix)[3398794] panic in interp limit setting (gavlian,fellows) 2011-09-08 (bug fix)[3401704] revised expr parser to permit function names like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter) *** POTENTIAL INCOMPATIBILITY *** 2011-09-10 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows) 2011-09-13 (bug fix)[3390638] solaris studio cc workaround (kechel,porter) 2011-09-13 (bug fix)[3405652] DTrace workaround (michelson,porter) 2011-09-16 (bug fix)[3391977] -headers overrides -type (ziegenhagen,fellows) => http 2.8.3 2011-09-16 (TIP 388) New \Uhhhhhhhh syntax (nijtmans) 2011-10-06 (enhancement) bytecode compile [dict with] (fellows) 2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans) 2011-10-20 (bug fix)[3418547] cmd lits and custom resolvers (soberning,fellows) 2011-10-31 (bug fix)[3414754] EIAS violation in fs paths (porter) 2011-11-22 (bug fix)[3354324] Win: [file mtime] sets wrong time (nijtmans) 2011-11-30 (bug fix)[967195] Simply args passed to child processes (nijtmans) => tcltest 2.3.4 2011-12-07 (bug fix)[3444754] fix [string tolower \u01C5] (nijtmans) 2011-12-11 (update)[3457031] Update [[:print:]] to Unicode 6.0 (nijtmans) 2011-12-24 (bug fix)[3464428] fix [string is graph \u0120] (nijtmans) 2012-01-08 (bug fix)[3470928] zoneinfo trouble with Windhoek data file (kenny) 2012-01-13 (bug fix)[3472316] fix retrieval of socket error (fellows) 2012-01-21 (bug fix)[3475667] [regexp] buffer read overflow (sebres) 2012-01-22 (bug fix)[3475264] [dict exists] return 0, not error (fellows) 2012-01-25 (bug fix)[3474460] [oo::copy] var resolution list (fellows) 2012-01-26 (bug fix)[3475569,3479689] mem corrupt in fs path (sebres,porter) 2012-01-30 (enhancement) improve bytecode compile of [catch] (fellows) 2012-02-02 (bug fix)[2974459,2879351,1951574,1852572,1661378,1613456] Fix problems where [file *able] would return false results on Win/Samba (porter) 2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer) 2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows) 2012-02-15 (enhancement) bytecode compile [lrange],[lreplace] (fellows) 2012-02-17 (bug fix)[2233954] compile problem on AIX & Android (nijtmans) 2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans) 2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries) 2012-03-26 (TIP 380) New builtin class [oo::Slot] (fellows) *** POTENTIAL INCOMPATIBILITY *** 2012-03-27 (TIP 397) method to extend [oo::copy] (fellows) *** POTENTIAL INCOMPATIBILITY *** 2012-03-27 (TIP 395) New subcommand [string is entier] (fellows) 2012-04-02 (TIP 396) New command [yieldto] (fellows) 2012-04-04 (bug fix)[3514761] crash combining objects and ensembles (fellows) 2012-04-09 (bug fix)[2712377] [info vars] and oo variables (fellows) 2012-04-09 (bug fix)[3396896] no dups in oo var lists (fellows) 2012-04-11 (bug fix)[3448512] [clock scan 1958-01-01] fail on Win (nijtmans) 2012-04-15 (bug fix)[3517696] fix flush of zlib chan xform (fellows) 2012-04-18 tzdata updated to Olson's tzdata2012c (kenny) 2012-04-28 (TIP 398) exit non-blocking chan without flush (ferrieux) *** POTENTIAL INCOMPATIBILITY *** 2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans) 2012-05-03 (bug fix)[3428753] Unbreak synchronous [socket -async] (porter) 2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux) 2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans) 2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows) 2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows) 2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows) *** POTENTIAL INCOMPATIBILITY *** 2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann) => dde 1.4.0 2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event] (fellows,ferrieux,kupries) 2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows) 2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans) => registry 1.3.0 2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows) 2012-06-25 (bug fix)[3024359] crash when multi-thread concurrent [file system] and Tcl_FSMountsChanged(). (porter) 2012-06-29 (bug fix)[3536888] fix locale guessing (oehlmann,nijtmans) 2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter) 2012-07-08 (bug fix)[3531209] accept IPv6 URLs (max) => http 2.8.4 2012-07-24 (bug fix) stop mem corruption in stacked channel events (max,porter) 2012-07-25 (bug fix)[3546275] [auto_execok] search match [exec] (danckaert) 2012-07-27 (update)[3464401] Support Unicode 6.2 (nijtmans) 2012-08-20 (bug fix)[3559678] [file normalize] EIAS failure (phao,dgp) 2012-08-25 (bug fix)[3561330] Ukranian translation of "March" (teterin) 2012-09-07 (TIP 404) New msgcat commands [mcflset], [mcflmset] (oehlmann) => msgcat 1.5.0 Many revisions to better support a Cygwin environment (nijtmans) Dropped support for OS X versions less than 10.4 (Tiger) (fellows) --- Released 8.6b3, September 18, 2012 --- See ChangeLog for details --- 2012-09-20 (enhancement) full Unicode support (nijtmans) => dde 1.4.0 2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans) 2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter) 2012-10-14 (bug fix) [tcl::Bgerror] crash on non-dict options (nijtmans) 2012-10-16 (TIP 400) New [zlib] options to set compression dict (fellows) 2012-10-16 (TIP 405) New commands [lmap] and [dict map] (fellows) 2012-10-24 (enhancement) [dict unset] now bytecompiled (fellows) 2012-11-05 (TIP 413) Revisions to default [string trim*] trimset (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2012-11-05 (enhancement) Now bytecompiled: [array exists], [array set], [array unset], [dict create], [dict exists], [dict merge], [format], [info commands], [info coroutine], [info level], [info object], [namespace current], [namespace code], [namespace qualifiers], [namespace tail], [namespace which], [regsub], [self], [string first], [string last], [string map], [string range], [tailcall], [yield]. (fellows) 2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows) => http 2.8.5 2012-11-07 tzdata updated to Olson's tzdata2012i (kenny) 2012-11-13 (bug fix)[3567063] thread fp settings from master (mistachkin) 2012-11-14 (bug fix)[2933003] tempfile creation in $TMPDIR (fellows) 2012-11-15 (TIP 416) New [load] options -global and -lazy (nijtmans) 2012-11-20 (bug fix)[3033307] base64 trail whitespace (kovalenko,goth) 2012-12-03 (bug fix) [configure] query broke init from argv (porter) => tcltest 2.3.5 2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter) 2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter) --- Released 8.6.0, December 20, 2012 --- See ChangeLog for details --- 2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd) 2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans) 2013-01-04 (bug fix) memleak in [format] compiler (fellows) 2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points 2013-01-09 (bug fix)[3599395] status line processing (nijtmans) 2013-01-23 (bug fix)[2911139] repair async connection management (fellows) => http 2.8.6 2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans) 2013-01-28 (enhancement) improve ensemble bytecode (fellows) 2013-01-30 (enhancement) selected script code improvements (fradin) => tcltest 2.3.6 2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries) => platform 1.0.11 2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff) 2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin) 2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows) 2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows) 2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans) => msgcat 1.5.1 2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick) 2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter) 2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max) 2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane) 2013-03-03 (bug fix)[3606258] major serial port update (english) 2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs (grathwohl,lane,porter) 2013-03-12 (enhancement) better build support for Debian arch (shadura) 2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans) 2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin) 2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter 2013-04-04 (bug fix) Support URLs with query but no path (max) => http 2.8.7 2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas) 2013-04-29 (enhancement) [array set] compile improvement (fellows) 2013-04-30 (enhancement) broaden glibc version detection (kupries) => platform 1.0.12 2013-05-06 (platform support) Cygwin64 (nijtmans) 2013-05-15 (enhancement) Improved [list {*}...] compile (fellows) 2013-05-16 (platform support) mingw-4.0 (nijtmans) 2013-05-19 (platform support) FreeBSD updates (cerutti) 2013-05-20 (bug fix)[3613567] access error temp file creation (keene) 2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene) 2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows) 2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann) => msgcat 1.5.2 2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter) 2013-06-03 Restored lost performance appending to long strings (elby,porter) 2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows) 2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans) 2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans) 2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang) 2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin) 2013-07-06 tzdata updated to Olson's tzdata2013d (kenny) 2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter) 2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter) 2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane) 2013-07-29 [string is space \u202f] => 1 (nijtmans) 2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans) 2013-08-01 (bug fix)[1905562] RE recursion limit increased to support reported usage of large expressions (porter) 2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows) 2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows) 2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter) 2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter) 2013-08-15 Errors from execution traces become errors of the command (porter) 2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter) 2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter) 2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows) 2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter) 2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows) => TclOO 1.0.1 2013-09-17 (bug fix)[2152292] [binary encode uuencode] corrected (fellows) 2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter) 2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter) Many optmizations, improvements, and tightened stack management in bytecode. --- Released 8.6.1, September 20, 2013 --- https://core.tcl-lang.org/tcl/ for details 2013-09-27 (enhancement) improved ::env synchronization (fellows) 2013-10-20 (bug fix)[2835313] segfault from [apply {{} {while 1 {a {*}[return -level 0 -code continue]}}}] (fellows) 2013-10-22 (bug fix)[3556215] [scan %E%G%X] support (fellows) 2013-10-25 (bug fix)[3eb2ec1] upper case scheme names in url. (nijtmans) => http 2.8.8 2013-10-29 (bug fix)[414d103] HP-UX: restore [exec] in threaded Tcl (nijtmans) 2013-11-04 (bug fix) C++ friendly stubs struct declarations (nijtmans) 2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans) 2013-11-12 (bug fix)[5425f2c] [fconfigure -error] breaks [socket -async] 2013-11-20 (bug fix) Improved environment variable management (nijtmans) => tcltest 2.3.7 2013-11-21 (platforms) Support for Windows 8.1 (nijtmans) 2013-12-06 (RFE) improved [foreach] bytecode (fellows) 2013-12-10 (RFE) improved [lmap] bytecode (sofer) 2013-12-11 (RFE) improved [catch] bytecode (sofer) 2013-12-18 (bug fix)[0b874c3] SEGV [coroutine X coroutine Y info frame] (porter) 2013-12-20 (RFE) reduced numeric conversion in bytecode (sofer) 2014-01-07 (RFE) compilers for [concat], [linsert], [namespace origin], [next], [string replace], [string tolower], [string totitle], [string toupper], [string trim], [string trimleft], [string trimright] (fellows) 2014-01-22 (RFE) compilers for [nextto], [yieldto] (fellows) 2014-02-02 (RFE) compiler for [string is] (fellows) 2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter) 2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans) 2014-03-26 (RFE)[b42b208] Cygwin: [file attr -readonly -archive -hidden -system] (nijtmans) 2014-03-27 (bug fix) segfault iocmd-23.11 (porter) 2014-04-02 (bug fix)[581937a] Win: readable event on async connect failure 2014-04-04 (bug fix)[581937a,97069ea] async socket connect fail (oehlmann) 2014-04-10 (bug fix)[792641f] Win: no \ in normalized path (nijtmans) 2014-04-11 (bug fix)[3118489] protect NUL in filenames (nijtmans) 2014-04-15 (bug fix)[88aef05] segfault iocmd-21.20 (porter) 2014-04-16 (update) Win: use Winsock 2.2 (nijtmans) 2014-04-16 (bug fix)[d19a30d] segfault clock-67.[23] (sebres) 2014-04-21 (bug fix) segfault iocmd-21.2[12] (porter) 2014-04-22 (bug fix) segfault iogt-2.4 (porter) 2014-04-23 (bug fix)[3493120] memleak in thread exit 2014-05-08 refactoring of core I/O functions (porter) 2014-05-09 (bug fix)[3389978] Win: extended paths support (nijtmans) 2014-05-09 (bug fix) segfault iocmd-32.1 (porter) 2014-05-11 (bug fix)[6d2f249] nested ensemble compile failure (fellows) 2014-05-17 (RFE)[47d6625] wideint support in [lsearch -integer] [lsort -integer] (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2014-05-20 (bug fix) Stop eof and blocked state leaking thru stacks (porter) *** POTENTIAL INCOMPATIBILITY *** 2014-05-20 (bug fix)[13d3af3] Win: socket -async tried only first IP address 2014-05-28 (platforms) work around systems that fail when a shared library is deleted after it is [load]ed (kupries) 2014-05-31 (bug fix) chan events on pipes must be on proper ends (porter) 2014-06-04 (bug fix) socket-2.12 (porter) 2014-06-05 (bug fix) io-12.6 (kupries,porter) 2014-06-15 (RFE)[1b0266d] [dict replace|remove] return canonical dict (fellows) *** POTENTIAL INCOMPATIBILITY *** 2014-06-16 (bug fix) socket-2.13 workaround broken select() (porter) 2014-06-20 (bug fix)[b47b176] iortrans.tf-11.0 (porter) 2014-06-22 (RFE)[2f9df4c] -cleanup scripts before -out compare (nijtmans) 2014-07-04 (update) Update Unicode data to 7.0 (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2014-07-08 (bug) [chan push] converts blocked writes to error (aspect,porter) 2014-07-10 (bug fix)[7368d2] memleak Tcl_SetVar2(..,TCL_APPEND_VALUE) (porter) *** POTENTIAL INCOMPATIBILITY *** 2014-07-11 (bug) leaks in SetFsPathFromAny, [info frame] (porter) 2014-07-15 (bug) compress dict leak in zlib xform channel close (porter) 2014-07-17 (bug fix)[9969cf8] leak trace data in coroutine deletion (porter) 2014-07-18 (RFE)[b43f2b4] fix [lappend] multi performance collapse (fellows) 2014-07-19 (bug fix)[75b8433] memleak managing oo instance lists (porter) 2014-07-21 (bug fix)[e6477e1] memleak in AtForkChild() (porter) 2014-07-22 (bug fix)[12b0997] memleak in iocmd.tf-32.0 (porter) 2014-07-28 (RFE) Optimized binary [chan copy] by moving buffers (porter) 2014-07-30 (enhancement) use refcounts, not Tcl_Preserve to manage lifetime of Tcl_Channel (porter) *** POTENTIAL INCOMPATIBILITY *** 2014-07-31 (bug fix)[a84a720] double free in oo chain deletion (porter) 2014-08-01 (bug fix)[e75faba] SEGV [apply {{} {namespace upvar a b [x]}}] (porter) 2014-08-01 (update) "macosx*-i386-x86_64" "macosx-universal" no longer compatible (kupries) => platform 1.0.13 2014-08-12 tzdata updated to Olson's tzdata2014f (kenny) 2014-08-17 (bug fix)[7d52e11] [info class subclasses oo::object] should include ::oo::class (fellows) 2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux) --- Released 8.6.2, August 27, 2014 --- https://core.tcl-lang.org/tcl/ for details 2014-08-28 (bug)[b9e1a3] Correct Method Search Order (nadkarni,fellows) => TclOO 1.0.3 *** POTENTIAL INCOMPATIBILITY *** 2014-09-05 (bug)[ccc2c2] Regression [lreplace {} 1 1] (bron,fellows) 2014-09-08 (bug) Crash regression in [oo::class destroy] (porter) 2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (fellows) 2014-09-10 (bug)[cee90e] [try {} on ok {} - on return {} {}] panic (porter) 2014-09-20 (feature) [tcl::unsupported::getbytecode] disassember (fellows) 2014-09-27 (enhancement) [string cat] bytecode optimization (leitgeb,ferrieux) 2014-09-27 (bug)[82521b] segfault in mangled bytecode (ogilvie,sofer) 2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter) 2014-10-03 (bug)[bc1a96] segfault in [array set] of traced array (tab,porter) 2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans) 2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter) 2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter) 2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter) 2014-10-26 Support for Windows 10 (nijtmans) 2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans) 2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter) 2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter) --- Released 8.6.3, November 12, 2014 --- https://core.tcl-lang.org/tcl/ for details 2014-11-21 (bug)[743338] Win: socket error encoding (ladayaroslav,nijtmans) 2014-12-01 (bug) restore tbcload/tclcompiler support (kupries) 2014-12-03 (bug)[0c043a] Fix compiled [set var($) val] (porter) 2014-12-04 (bug)[d2ffcc] Limit $... and bareword parsing to ASCII (ladayaroslav,porter) *** POTENTIAL INCOMPATIBILITY *** 2014-12-06 (bug)[c6cd4a] Win: hang in async socket connection (shults,nadkarni) 2014-12-10 tzdata updated to Olson's tzdata2014j (venkat) 2014-12-13 fix header files installation on OS X (houben) 2014-12-17 (TIP 427) [fconfigure $h -connecting, -peername, -sockname] (oehlmann,rmax) 2014-12-18 (bug)[af08c8] Crash in full finalize encoding teardown (porter) 2014-12-18 (bug)[7c187a] [chan copy] crash (io-53.17) (benno,porter) 2015-01-26 (bug)[df0848] Trouble with INFINITY macro (dower,nijtmans) 2015-01-29 (bug) Stop crashes when extension var resolvers misbehave (porter) 2015-01-29 (bug)[088727] [read] past EOF (io-73.4) (fenugrec,porter) 2015-02-11 tzdata updated to Olson's tzdata2015a (venkat) 2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect) 2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer) *** POTENTIAL INCOMPATIBILITY *** --- Released 8.6.4, March 12, 2015 --- https://core.tcl-lang.org/tcl/ for details 2015-03-19 (bug)[e66e44] Win: Ctrl-C/Ctrl-Break in console not EOF (nadkarni) 2015-03-21 (bug)[d87cb1] Proper tailcall from compiled ensembles (sofer) 2015-04-23 (bug)[19ea02] Win: shared read from linked dirs (bogdan,oehhar) 2015-04-24 (bug)[879a07] Incomplete chars @ buffer ends (leunissen,porter) 2015-04-29 (bug)[894da1] Hang flushing blocking channels (yorick) 2015-05-14 (enhance)[b9d043] Default use of gzip transfer encoding (fellows) => http 2.8.9 *** POTENTIAL INCOMPATIBILITY *** 2015-05-15 (bug)[9dd1bd] destructor [self] after failed constructor (calvo,fellows) 2015-05-15 (bug)[0f42ff] [tailcall] combined with [next] (aspect,fellows) 2015-05-18 (bug)[c11a51] http: race condition in -accept option (fellows) 2015-05-19 (enhance) More pure lists from compiled [list] (porter,fellows) 2015-05-27 (enhancement) Relax memdebug constraint on extensions (kupries) 2015-06-03 (bug)[268b23] crash in traced [expr] (execute-11.2)(tomkinson,porter) 2015-06-11 (bug)[478c44] Memleak in zlib compresion errors (mistachkin) 2015-06-16 (bug)[e770d9] Higher baud on serial channels (woods,nijtmans) 2015-06-18 (update) Update Unicode data to 8.0 (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2015-06-18 (bug)[a4cb3f] compiled [lreplace] handling of end (bron,aspect) 2015-06-23 (enhance) Use Unicode SendMessageTimeout() (nijtmans) => registry 1.3.1 2015-06-25 (TIP 412) msgcat dynamic locale change and package private locale (oehlmann) => msgcat 1.6.0 2015-07-05 (bug)[a0ece9] crash in traced [expr] (execute-11.3) (hans,porter) 2015-07-10 (TIP 436) [info object isa] favors 'false' over error (fellows) => TclOO 1.0.4 2015-07-15 (bug)[b1534b][9bad63] writes beyond buffer bounds (hanno,porter) 2015-07-18 (bug)[a3309d] Memleak in compiled [unset a($i)] (jeff,porter) 2015-07-23 (bug)[57945b] lock in forking/multi-threading (neumann,mistachkin) 2015-07-29 (bug)[3e7eca] Allocation overflow in expr parsing (rickyb,porter) 2015-07-30 (bug)[f00009] Win: Memleak in [file] (rp,sebres) 2015-07-31 (bug) Correct problems found in Coverity audit (sofer) 2015-08-19 (bug)[00189c] MSVC 14: semi-static UCRT support (dower,nijtmans) 2015-08-26 (bug)[0df7a1] Tolerate getcwd() failures (cato,nijtmans) 2015-09-21 (bug)[1115587][a3c350][d7ea9f][0e0e15][187d7f] Many fixes and improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich) 2015-09-23 (enhance) hash lookup microoptimization (hipp) 2015-09-23 (bug)[e0a7b3] Input buffer draining & file events (griffin,porter) 2015-09-29 (bug)[219866] Cygwin support error (yorick,nijtmans) => platform 1.0.14 2015-10-06 (bug)[b42a85] Win: [file normalize ~user] wrong dir (nadkarni) 2015-10-21 (bug)[1080042][8f2450] More regexp from Postgres (lane,porter) 2015-10-23 (bug)[4a0c16] [clock] react to msgcat locale change (oehlmann) 2015-11-10 (bug)[261a8a] Overflow segfault in I/O translation (brooks,porter) 2015-11-20 (bug)[40f628] ListObjReplace callers fail to detect max (porter) 2015-11-30 (enhance)[32c574] Improve list growth performance (brooks,porter) 2015-12-11 (bug)[c9eb6b] tolerate unset ::env(TZ) (gahr, nijtmans) 2016-01-29 (TIP 440) tcl_platform(engine) -- Tcl implementation (mistachkin) 2016-02-03 (bug)[25842c] stream [zlib deflate] fails with 0 input (ade,fellows) 2016-02-04 (bug)[3d96b7][593baa][cf74de] crashes in OO teardown (porter,fellows) 2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans) --- Released 8.6.5, February 29, 2016 --- https://core.tcl-lang.org/tcl/ for details 2016-03-01 (bug)[803042] mem leak due to reference cycle (porter) 2016-03-08 (bug)[bbc304] reflected watch race condition (porter) 2016-03-17 (bug)[fadc99] compile-5.3 (rodriguez,porter) 2016-03-17 (enhancement)[1a25fd] compile [variable ${ns}::v] (porter) 2016-03-20 (bug)[1af8de] crash in compiled [string replace] (harder,fellows) 2016-03-21 (bug)[d30718] segv in notifier finalize (hirofumi,nijtmans) 2016-03-23 (enhancement)[7d0db7] parallel make (yarda,nijtmans) 2016-03-23 [f12535] enable test bindings customization (vogel,nijtmans) 2016-04-04 (bug)[47ac84] compiled [lreplace] fixes (aspect,ferrieux,fellows) *** POTENTIAL INCOMPATIBILITY *** 2016-04-08 (bug)[866368] RE \w includes 'Punctuation Connector' (nijtmans) 2016-04-08 (bug)[2538f3] Win crash Tcl_OpenTcpServer() (griffin) 2016-04-10 [07d13d] Restore TclBlend support lost in 8.6.1 (buratti) 2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny) 2016-05-13 (bug) registry package support any Unicode env (nijtmans) => registry 1.3.2 2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows) 2016-06-02 (TIP 447) execution time verbosity option (cerutti) => tcltest 2.4.0 2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter) 2016-06-16 (enhancement)[4b61af] good [info frame] from more cases (beric) 2016-06-21 (bug)[c383eb] crash in [glob -path a] (oehlmann,porter) 2016-06-21 (update) Update Unicode data to 9.0 (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2016-06-22 (bug)[16896d] Tcl_DString tolerate append to self. (dah,porter) 2016-06-23 (bug)[d55322] crash in [dict update] (yorick,fellows) 2016-06-27 (bug)[dd260a] crash in [chan configure -dictionary] (madden,aspect) 2016-07-02 (bug)[f961d7] usage message with parameters with spaces (porter) *** POTENTIAL INCOMPATIBILITY *** 2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam) 2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni) *** POTENTIAL INCOMPATIBILITY *** 2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni) 2016-07-09 [ae61a6] [file] handling of Win hard-coded names (CON) (nadkarni) *** POTENTIAL INCOMPATIBILITY *** 2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni) 2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows) *** POTENTIAL INCOMPATIBILITY *** 2016-07-10 (bug)[da340d] integer division in clock math (nadkarni) 2016-07-20 tzdata updated to Olson's tzdata2016f (venkat) --- Released 8.6.6, July 27, 2016 --- https://core.tcl-lang.org/tcl/ for details 2016-09-07 (bug)[c09edf] Bad caching with custom resolver (neumann,nijtmans) 2016-09-07 (bug)[4dbdd9] Memleak in test var-8.3 (mr_calvin,porter) 2016-10-03 (bug)[2bf561] Allow empty command as alias target (yorick,nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2016-10-04 (bug)[4d5ae7] Crash in async connects host no address (gahr,fellows) 2016-10-08 (bug)[838e99] treat application/xml as text (gahr,fellows) => http 2.8.10 2016-10-11 (bug)[3cc1d9] Thread finalization crash in zippy (neumann) 2016-10-12 (bug)[be003d] Fix [scan 0x1 %b], [scan 0x1 %o] (porter) 2016-10-14 (bug)[eb6b68] Fix stringComp-14.5 (porter) 2016-10-30 (bug)[b26e38] Fix zlib-7.8 (fellows) 2016-10-30 (bug)[1ae129] Fix memleak in [history] destruction (fellows) 2016-11-04 (feature) Provisional Tcl 9 support in msgcat and tcltest (nijtmans) => msgcat 1.6.1 => tcltest 2.4.1 2016-11-04 (bug)[824752] Crash in Tcl_ListObjReplace() (gahr,porter) 2016-11-11 (bug)[79614f] invalidate VFS mounts on sytem encoding change (yorick) 2016-11-14 OSX: End panic() as legacy support macro; system conflicts (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2016-11-15 (bug) TclOO fix stops crash mixing Itcl and snit (fellows) 2016-11-17 (update) Reconcile libtommath updates; purge unused files (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2017-01-09 (bug)[b87ad7] Repair drifts in timer clock (sebres) 2017-01-17 (update) => zlib 1.2.11 (nijtmans) 2017-01-31 (bug)[39f630] Revise Tcl_LinkVar to tolerate some prefixes (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2017-02-01 (bug)[d0f7ba] Improper NAN optimization. expr-22.1[01] (aspect) 2017-02-26 (bug)[25842c] zlib stream finalization (aspect) 2017-03-07 (deprecate) Remove unmaintained makefile.bc file (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2017-03-14 (enhancement) [clock] and [encoding] are now ensembles (kenny) 2017-03-15 (enhancement) several [clock] subcommands bytecoded (kenny) 2017-03-23 tzdata updated to Olson's tzdata2017b (jima) 2017-03-29 (bug)[900cb0] Fix OO unexport introspection (napier) 2017-04-12 (bug)[42202b] Nesting imbalance in coro injection (nadkarni,sebres) 2017-04-18 (bug)[bc4322] http package support for safe interps (nash,nijtmans) 2017-04-28 (bug)[f34cf8] [file join a //b] => /b (neumann,porter) 2017-05-01 (bug)[8bd13f] Windows threads and pipes (sebres,nijtmans) 2017-05-01 (bug)[f9fe90] [file join //a b] EIAS violation (aspect,porter) 2017-05-04 (bug) Make test filesystem-1.52 pass on Windows (nijtmans) 2017-05-05 (bug)[601522] [binary] field spec overflow -> segfault (porter) 2017-05-08 (bug)[6ca52a] http memleak handling keep-alive (aspect,nijtmans) => http 2.8.11 2017-05-29 (bug)[a3fb33] crash in [lsort] on long lists (sebres) 2017-06-05 (bug)[67aa9a] Tcl_UtfToUniChar() revised handling invalid UTF-8 (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2017-06-08 (bug)[2738427] Tcl_NumUtfChars() corner case utf-4.9 (nijtmans) 2017-06-22 (update) Update Unicode data to 10.0 (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2017-06-22 (TIP 473) Let [oo::copy] specify target namespace (fellows) 2017-06-26 (bug)[46f801] Repair autoloader fragility (porter) 2017-07-06 (bug)[adb198] Plug memleak in TclJoinPath (sebres,porter) 2017-07-17 (bug)[fb2208] Repeatable tclIndex generation (wiedemann,nijtmans) --- Released 8.6.7, August 9, 2017 --- https://core.tcl-lang.org/tcl/ for details 2017-08-10 [array names -regexp] supports backrefs (goth) 2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows) 2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter) 2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) => http 2.8.12 2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) 2017-10-19 (bug)[1a5655] [info * methods] includes mixins (fellows) 2017-10-23 tzdata updated to Olson's tzdata2017c (jima) 2017-10-24 (bug)[fc1409] segfault in method cloning, oo-15.15 (coulter,fellows) 2017-11-03 (bug)[6f2f83] More robust [load] for ReactOS (werner) 2017-11-08 (bug)[3298012] Stop crash when hash tables overflow 32 bits (porter) 2017-11-14 (bug)[5d6de6] Close failing case of [package prefer stable] (kupries) 2017-11-17 (bug)[fab924] Fix misleading [load] message on Windows (oehlmann) 2017-12-05 (bug)[4f6a1e] Crash when ensemble map and list are same (sebres) 2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter) 2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni) 2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter) --- Released 8.6.8, December 22, 2017 --- https://core.tcl-lang.org/tcl/ for details 2018-02-11 (enhance) stop blocking conversion of object to/from class (coulter) 2018-02-12 (enhance) NR-enable [package require] (coulter) 2018-02-14 (bug)[9fd5c6] crash in object deletion, test oo-11.5 (coulter) 2018-02-14 (bug)[3c32a3] crash deleting object with class mixed in (coulter) 2018-02-15 (platform) stop using -lieee, removed from glibc-2.27 (porter) ***POTENTIAL INCOMPATIBILITY for math programs that embed Tcl*** 2018-02-23 (bug)[8e6a9a] bad binary [string match], test string-11.55 (porter) 2018-03-05 (bug)[1873ea] repair multi-thread std channel init (sebres) 2018-03-09 (bug)[db36fa] broken bytecode for index values (porter) 2018-03-13 (bug) broken compiled [string replace], test string-14.19 (porter) 2018-03-14 (bug) [string trim*] engine crashed on invalid UTF (sebres) 2018-04-17 (bug) missing trace in compiled [array set], test var-20.11 (porter) 2018-04-22 (bug)[46a241] crash in unset array with search, var-13.[23] (goth) 2018-04-30 (bug)[27b682] race made [file delete] raise "no such file" (sebres) 2018-06-04 (bug)[925643] 32/64 cleanup of filesystem DIR operations (sebres) 2018-06-18 (bug) leaks in TclSetEnv and env cache (coulter) 2018-06-24 (bug)[3592747] [yieldto] dying namespace, tailcall-14.1 (coulter) 2018-07-09 (bug)[270f78] race in [file mkdir] (sebres) 2018-07-12 (bug)[3f7af0] [file delete] raised "permission denied" (sebres) 2018-07-26 (bug)[d051b7] overflow crash in [format] (sebres) 2018-08-29 revised quoting of [exec] args in generated command line (sebres) ***POTENTIAL INCOMPATIBILITY*** 2018-09-20 HTTP Keep-Alive with pipelined requests (nash) => http 2.9.0 2018-09-27 (new)[TIP 505] [lreplace] accepts all out of range indices (porter) 2018-10-04 (bug) Prevent crash from NULL keyName (nijtmans) => registry 1.3.3 2018-10-26 (enhance) advance dde version (nijtmans) => dde 1.4.1 2018-10-27 tzdata updated to Olson's tzdata2018g (jima) 2018-10-29 Update tcltest package for Travis support (fellows) => tcltest 2.5.0 2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens) 2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres) - Released 8.6.9, November 16, 2018 - details at https://core.tcl-lang.org/tcl/ - 2018-11-22 (bug)[7a9dc5] [file normalize ~/~foo] segfault (sebres) 2018-12-30 (bug)[3cf3a9] variable 'timezone' deprecated in vc2017 (nijtmans) 2019-01-09 (bug)[cc1e91] [list [list {*}[set a " "]]] regression (sebres) 2019-02-01 (bug)[e3f481] tests var-1.2[01] (sebres) 2019-03-01 (new) Update to Unicode 12.0 (nijtmans) 2019-03-05 (new)[TIP 527] New command [timerate] (sebres) 2019-03-08 (bug)[39fed4] [package require] memory validity (hume,porter) 2019-04-23 (new) New command tcl::unsupported::corotype (fellows) 2019-05-04 (bug) memlink when namespace deletion kills linked var (porter) 2019-05-28 (new) README file converted to README.md in Markdown (nijtmans) 2019-06-17 (bug)[8b9854] [info level 0] regression with ensembles (porter) 2019-06-20 (bug)[6bdadf] crash multi-arg write-traced [lappend] (fellows,porter) 2019-06-21 (bug)[f8a33c] crash Tcl_Exit before init (brooks,sebres) 2019-08-27 (bug)[fa6bf3] Bytecode fails epoch recovery at numLevel=0 (sebres) 2019-08-29 (bug)[fec0c1] C stack overflow compiling bytecode (ade,sebres) 2019-09-12 tzdata updated to Olson's tzdata2019c (jima) 2019-09-20 (new) registry/dde no longer need -DUNICODE (nijtmans) => registry 1.3.4 => dde 1.4.2 2019-10-02 (bug)[16768d] Fix [info hostname] on NetBSD (rytaro) 2019-10-23 (new) libtommath updated to release 1.2.0 (nijtmans) 2019-10-25 OSX: system Tcl deprecated. End default use of its packages. (walzer) 2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter) 2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres) 2019-11-18 (bug)[13657a] application/json us text, not binary (noe,nijtmans) => http 2.9.1 - Released 8.6.10, Nov 21, 2019 - details at https://core.tcl-lang.org/tcl/ - 2019-12-03 (bug)[3cd9be] Corner case in surrogate handling (nijtmans) 2019-12-09 (new) Add tcltest::(Setup|Eval|Cleanup|)Test (coulter,sebres) => tcltest 2.5.2 2019-12-12 (new) Add 3 libtommath functions to stub table (nijtmans) 2019-12-23 (bug)[ce3b9f] compilation errors with clang, windows msys2 (nijtmans) 2019-12-27 (bug)[1de6b0] [expr 1e2147483648] => 0.0 (kbk) 2020-01-04 (bug)[912886] tis-620 encoding fails to load (coulter) 2020-01-13 (bug)[0b9332] Win: support system encoding init to utf-8 (jedliФka) 2020-01-17 (bug)[8cd2fe] [unload] corrupted list of loaded packages (berc) 2020-01-17 (bug)[5d989f] segfault in lsort for large list length (sebres) 2020-01-30 (bug) Reset WSAGetLastError()/errno in channel close (nijtmans) 2020-02-17 (bug) Win: avoid create of legacy error-vars on init phase (sebres) 2020-02-25 (bug) release refs when setting class's superclasses fails (dkf) 2020-02-26 (bug) C++ compiler compatibility for registry and dde (nijtmans) => registry 1.3.5 => dde 1.4.3 2020-03-05 (new) Update to Unicode-13 (nijtmans) 2020-03-16 (bug)[8f89e2] Win: env var encoding, env-2.5 (sebres, nijtmans) 2020-03-27 (bug)[767e07] Tcl_Get(Range|UniChar) validate index inputs (nijtmans) 2020-03-28 (bug)[8edfce] [binary encode base64] & multi-byte wrapchars (dgp) 2020-03-28 (bug)[ffeb20] [binary decode base64] ignore invalid chars (dgp) See RFC 2045 *** POTENTIAL INCOMPATIBILITY *** 2020-03-31 (bug)[b8e82d] some -maxlen values break uuencode round trip (dgp) *** POTENTIAL INCOMPATIBILITY *** 2020-04-01 (bug)[f58371] Fileevent run in proper thread (bron,sebres) 2020-04-13 (bug)[afa4b2] TclNeedSpace bug; tests util-8.5 .. util-8.11 (dgp) 2020-04-13 (bug)[085913] Tcl_DStringAppendElement # quoting precision (dgp) *** POTENTIAL INCOMPATIBILITY *** 2020-04-13 (bug)[a7f685] test util-5.52 (dgp) 2020-04-13 (bug)[c61818] Tcl_UtfPrev regression (dgp) 2020-04-15 (bug)[8af92d] zlib transform issue, bad inflate (sebres) 2020-04-16 (bug)[5e6346] Tcl_UtfPrev handling of overlong sequences (dgp) 2020-04-27 (bug)[45ca23] [string tolower] inconsistency (dgp) 2020-04-30 (bug)[da2352] init [info hostname] with DNS, not NetBIOS (nadkarni) 2020-05-11 (bug)[d402ff] Win32 potential crash when using main() (werner) 2020-05-13 (bug)[81242a] revised documentation for Tcl_UtfAtIndex() (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2020-05-13 (bug)[ed2980] Tcl_UtfToUniChar reads > TCL_UTF_MAX bytes (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2020-06-02 (bug) prevent segfault in parser (sebres) 2020-06-21 (bug)[f81bec] http POST a binary file (alakendu,nash) => http 2.9.2 2020-06-23 (bug)[41c985] auto_path nonsense in Safe Base (nash) 2020-06-24 (bug)[f70ce1] zlib multi-stream inflate acts only on first (sebres) 2020-07-09 (bug)[a1bd37] [clock scan] new ISO format (clock-34.(19-24)) (sebres) *** POTENTIAL INCOMPATIBILITY *** 2020-07-10 (bug)[501974] [clock scan] +time zone (clock-34.(53-68)) (sebres) *** POTENTIAL INCOMPATIBILITY *** 2020-07-15 (bug)[3c6e47] compiled [lappend] performance, avoid copy (sebres) 2020-07-16 (bug)[5bbd04] Fix index underflow (schwab) 2020-07-27 (bug)[cb0373] http::geturl -keepalive fixes (nash) => http 2.9.3 2020-08-10 (bug)[29e884] cmd resolution cycle (namespace-57.0) (coulter,sebres) 2020-08-12 (bug)[e87000] Tcl_BadChannelOption tolerate NULL (werner,nijtmans) 2020-08-31 (TIP #581) disfavor Master/Slave terminology (nijtmans) => opt 0.4.8 2020-09-11 (bug)[3bc0f4] UBSan complains about body.chars[] usage (nijtmans) 2020-09-17 (bug)[835c93] Support TIP 525 exit code for -singleproc 1 (nijtmans) => tcltest 2.5.3 2020-09-25 (new) force -eofchar \032 when evaluating library scripts (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2020-09-29 (bug)[0063cb] http::geturl -headers must be dict (oehlmann,nijtmans) 2020-10-19 (bug)[cb4582] Update install-sh script (stu,nijtmans) 2020-10-22 (bug)[c97593] Usage of gnu_printf in latest mingw-w64 (nijtmans) 2020-10-26 (new)[48898a] improve error message consistency (stu) *** POTENTIAL INCOMPATIBILITY *** 2020-11-06 (new) revised case of module names (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2020-12-10 (bug)[ed5be7] Win: recognize "comx:" as serial port (oehlmann) 2020-12-11 (new) support for msys2, Big Sur (nijtmans) => platform 1.0.15 2020-12-23 tzdata updated to Olson's tzdata2020e (jima) - Released 8.6.11, Dec 31, 2020 - details at https://core.tcl-lang.org/tcl/ - 2021-02-02 (new) support for MacOS Big Sur updates (nijtmans) => platform 1.0.17 2021-02-15 (bug)[d43f96] [string trim*] broken for Emoji (werner) 2021-02-16 (bug)[22324b] [string reverse] broken for Emoji (werner) 2021-02-19 (bug)[1dab71,7c64aa] BRE broken by uninitialized value use (lane) 2021-03-09 (bug)[8419c5] Unix tty channels tolerate EINTR (nijtmans) *** POTENTIAL INCOMPATIBILITY *** 2021-03-10 (bug)[4c591f] [string compare] EIAS violation (nijtmans) 2021-04-08 (new) dde package installation compatible with Tcl 9 (nijtmans) => dde 1.4.4 2021-04-14 (bug)[266494] [concat foo [list #]] EIAS violation (porter) 2021-05-03 (bug)[24b918] Save IO buffers from modern optimizers (rupprecht) 2021-05-06 (new) support for POSIX error EILSEQ (nijtmans) 2021-05-17 (bug)[688fcc] segfault during traced delete of alias (coulter) 2021-06-22 (bug)[bad6cc] More secure build tool. CVE-2021-35331 (nijtmans) 2021-07-17 (bug)[592a25] Win: segfault in Tcl_PutEnv() (danckaert,nijtmans) 2021-09-02 (bug)[ccc448] segfault in ensemble rewrite machinery (coulter) 2021-09-14 (new) Update to Unicode-14 (nijtmans) 2021-10-08 (bug)[a8579d] failed proc argument spec processing (russell,coulter) 2021-10-27 (new) support for MacOS Monterey (nijtmans) => platform 1.0.18 2021-10-27 tzdata updated to Olson's tzdata2021e (nijtmans) - Released 8.6.12, Nov 5, 2021 - details at https://core.tcl-lang.org/tcl/ - 2021-12-08 (update) tcltest package to version 2.5.4 2022-01-13 (bug)[26f132] Crash when sizeof(int) < sizeof(void *) (Plan 9 port) 2022-01-19 (TIP 623)[e9a271] Tcl_GetRange index args < 0 (petasis,nijtmans) 2022-03-08 (bug) test string-5.22 (porter) 2022-03-11 (bug)[8a7ec8] fat binary compile on Mac M1 (davis, nijtmans) 2022-04-04 (bug)[e5ed1b] numeric IPv6 in URLs (nijtmans) => http 2.9.6 2022-04-26 (bug)[27520c] test error-9.6 (goth,sebres) 2022-05-04 (bug)[8eb64b] http package tolerant again invalid reply header 2022-05-11 (bug)[6898f9] http package failed detection of shiftjis charset 2022-05-25 (bug)[76ad7a] tests string-6.13[23] (mistachkin, nijtmans) 2022-06-20 (bug)[55bf73] Avoid connection reuse after response code 101. => http 2.9.8 2022-07-22 (bug)[713653] FP rounding exposed by x86 musl (rubicon,sebres) 2022-07-22 More portable notation of microseconds in verbose output (sebres) => tcltest 2.5.5 2022-07-27 (bug)[b3977d] Process CR-LF split across packets (nadkarni,sebres) 2022-07-29 (bug)[4eb3a1] crash due to undetected bytecode invalidity (nadkarni) 2022-08-23 (new)[371080] Portability to CHERI-enabled Morello processor (jrtc27) 2022-09-06 (bug)[55a02f] Fallback init env(HOME) from USERPROFILE (nadkarni) 2022-09-13 (bug)[1073da] crash writing invalid utf-8 (nijtmans) 2022-09-14 (new) Update to Unicode-15 (nijtmans) 2022-10-14 tzdata updated to Olson's tzdata2022e (nijtmans) Update bundled zlib to 1.2.13 Update bundled libtommath Many code fixes to avoid overflow or undefined behavior. Thanks chrstphrchvz. - Released 8.6.13, Nov 22, 2022 - details at https://core.tcl-lang.org/tcl/ - 2022-12-01 Backport TIP #402: path name starting with '//' not replaced by '/' also on Cygwin and QNX (nijtmans) 2022-12-12 Windows binaries licence metadata changed to University of California to match licence (nadkarni) 2022-12-16 check mknod, tcdrain and uname in build script for VxWorks or others (nijtmans) 2022-12-16 32-bit cygwin is dead, so --enable-64bit in a Cygwin build no longer needed (nijtmans) 2023-01-01 (bug)[8e811b] Wrong formatting of arguments in man page (nijtmans) 2023-01-06 (bug) [0f19ed]: Windows 11 not reported in tcl_platform(osVersion) (nijtmans) 2023-01-15 (bug) [8f7fde] string compare failing on big endian (coulter) 2023-01-22 (bug) [3e8074] y2k38 problem in [interp limit time -seconds] (nijtmans) 2023-01-22 (bug) [e3dcab] crash with tcl_precision equal 15..18 (kenny) 2023-02-22 (bug) [d19fe0] output replacement character on incomplete sequences in unicode encoding (nijtmans) 2023-02-22 (bug) [534172] sporadic crash in memchan thread cleanup. (neumann,nijtmans) 2023-02-28 (bug) [f9eafc] throw error in zip command when file comment/filename to long or not iso-latin-1 (nijtmans) 2023-03-04 (bug) [1b8df1] fix usec on windows returned by Tcl_GetTime (nadkarni) 2023-03-05 (bug) [9c5a00]. Fix ~ and ~user path prefix on Windows (nadkarni) 2023-03-13 (bug)[183a1a] Prevent BO by Tcl_UtfToExternal (nadkarni) 2023-03-14 (bug) [ea69b0], crash when using a channel transformation on TCP client socket (coulter) 2023-03-22 (bug)[026575] Prevent invalid read in Tcl_UtfToUniChar (nijtmans) 2023-03-30 (rfe) Allow empty mode in [chan create] to allow refchan version of [socket -server] (max) 2023-03-30 [0cb355] macOS 13 SDK deprecates sprintf() (chavez) 2023-05-02 (bug) [ab123c] argument position overflow in [scan %num$mode] (nadkarni) 2023-05-02 (bug) [784bef] tailcall crash (nadkarni) 2023-06-03 (bug) [af3ebc] clock scan and clock add bugs in error cases / with abbreviated options (ade) 2023-07-05 (bug) [66ffaf] incomplete double byte encoding sequences ignored like in [encoding convertfrom gb12345 x] (nadkarni) 2023-07-26 (rfe) [c54e4a] fork multithreading performance by using vfork/spawn when supported (neumann) 2023-08-29 Update zlib to version 1.3 (nijtmans) 2023-09-04 Update libtommath to version 1.2.1 (nijtmans) 2023-09-05 (bug) [60cacf] Fix tclvfs tkt Segmentation Fault at interpreter exit when tclvfs loaded. 2023-09-05 (bug) [b5ac3e] Tcl_GetUniChar reads beyond string length for ASCII strings (nadkarni) 2023-09-06 (bug) [d3465c] Update install-sh to version 2020-11-14.01 (nijtmans) 2023-09-08 Unicode 15.1 (nijtmans) 2023-09-12 Remove option utf16 from win/makefile.vc (nijtmans) 2023-09-13 (bug) [43b065] MS Windows: files with emojis are found by glob but not recognized by file exists or open (nijtmans) 2023-09-13 (bug) [a1f11d] VC6 compilation error of core-8-6-branch: error C2065: 'int16_t' : undeclared identifier (nijtmans) 2023-09-14 (bug) [00655c] ClockGetdatefieldsObjCmd(): avoid signed integer overflow and platform-dependent behavior (nijtmans) 2023-09-28 TIP #662: Tcl_VarEval is not depreciated any more (nijtmans) 2023-10-01 (bug) [7b3167] tclOO.c: initialize fakeObject.refCount (nijtmans) 2023-10-04 (bug) [7371b6] AddressSanitizer use-after-return detection breaks NRE tests, coroutines (nijtmans) 2023-11-20 (bug)[32b889] prevent spurious errors from [clock format] (gahr) 2023-11-30 (bug) [fb2fa9],[21b062] reallow [exec %var%] on MS-Windows. It was forbidden in 8.6.13 (brester) 2023-12-30 (rfe) [0ac9d0] Don't call getsockname(2) in Tcl_MakeFileChannel(3) unless absolutely necessary. Permits better constraining of Tcl/tclsh via OpenBSD's pledge(2) or similar mechanisms. Minor rewrite. 2024-01-09 (feature) Adapt tcltest to support Tcl 9. => tcltest 2.5.7 2024-01-11 (bug) [fd27ad] doc change of Tcl_PkgRequire & friends: version string specification refers to "package require". 2024-01-27 (bug) [16e25e] error for [tcl_startOfPreviousWord string end-1] (nijtmans) 2024-01-29 Update to zlib 1.3.1 (nijtmans) 2024-01-29 [db4f28] segfault when Tcl_ReadChars is called with unicode object (brester) 2024-02-04 tzdata updated to Olson's tzdata2024a (nijtmans) 2024-02-05 fix/document Tcl_ObjPrintf with "ll" modifier (nijtmans) 2024-02-06 [8e666d] endless loop when redefining proc ::history (nash) 2024-02-06 [86b3c1] endless loop when ::unknown is moved into a namespace (nash) - Released 8.6.14, Feb 28, 2024 - details at https://core.tcl-lang.org/tcl/ - tcl8.6.14/ChangeLog0000644000175000017500000122232414554262142013422 0ustar sergeisergeiA NOTE ON THE CHANGELOG: Starting in early 2011, Tcl source code has been under the management of fossil, hosted at https://core.tcl-lang.org/tcl/ . Fossil presents a "Timeline" view of changes made that is superior in every way to a hand edited log file. Because of this, many Tcl developers are now out of the habit of maintaining this log file. You may still find useful things in it, but the Timeline is a better first place to look now. ============================================================================ 2013-09-19 Don Porter *** 8.6.1 TAGGED FOR RELEASE *** * generic/tcl.h: Bump version number to 8.6.1. * library/init.tcl: * unix/configure.in: * win/configure.in: * unix/tcl.spec: * README: * unix/configure: autoconf-2.59 * win/configure: 2013-09-19 Donal Fellows * doc/next.n (METHOD SEARCH ORDER): Bug [3606943]: Corrected description of method search order. 2013-09-18 Donal Fellows Bump TclOO version to 1.0.1 for release. 2013-09-17 Donal Fellows * generic/tclBinary.c (BinaryEncodeUu, BinaryDecodeUu): [Bug 2152292]: Corrected implementation of the core of uuencode handling so that the line length processing is correctly applied. ***POTENTIAL INCOMPATIBILITY*** Existing code that was using the old versions and working around the limitations will now need to do far less. The -maxlen option now has strict limits on the range of supported lengths; this is a limitation of the format itself. 2013-09-09 Donal Fellows * generic/tclOOMethod.c (CloneProcedureMethod): [Bug 3609693]: Strip the internal representation of method bodies during cloning in order to ensure that any bound references to instance variables are removed. 2013-09-01 Donal Fellows * generic/tclBinary.c (BinaryDecodeHex): [Bug b98fa55285]: Ensure that whitespace at the end of a string don't cause the decoder to drop the last decoded byte. 2013-08-03 Donal Fellows * library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found by the autoloading mechanism. 2013-08-02 Donal Fellows * generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop crashes when emptying the superclass slot, even when doing elaborate things with metaclasses. 2013-08-01 Harald Oehlmann * tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier thread again if we were forked, to solve Rivet bug 55153. 2013-07-05 Kevin B. Kenny * library/tzdata/Africa/Casablanca: * library/tzdata/America/Asuncion: * library/tzdata/Antarctica/Macquarie: * library/tzdata/Asia/Gaza: * library/tzdata/Asia/Hebron: * library/tzdata/Asia/Jerusalem: http://www.iana.org/time-zones/repository/releases/tzdata2013d.tar.gz 2013-07-03 Jan Nijtmans * unix/tclXtNotify.c: Bug [817249]: bring tclXtNotify.c up to date with Tcl_SetNotifier() change. 2013-07-02 Jan Nijtmans * unix/tcl.m4: Bug [32afa6e256]: dirent64 check is incorrect in tcl.m4 * unix/configure: (thanks to Brian Griffin) 2013-06-27 Jan Nijtmans * generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs * generic/tclMain.c: initialized encodings. 2013-06-18 Jan Nijtmans * generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread issue. 2013-06-17 Jan Nijtmans * generic/regc_locale.c: Bug [a876646efe]: re_expr character class [:cntrl:] should contain \u0000 - \u001f 2013-06-09 Donal K. Fellows * generic/tclCompCmdsSZ.c (TclCompileTryCmd): [Bug 779d38b996]: Rewrote the [try] compiler to generate better code in some cases and to behave correctly in others; when an error happens during the processing of an exception-trap clause or a finally clause, the *original* return options are now captured in a -during option, even when fully compiled. 2013-06-05 Donal K. Fellows * generic/tclExecute.c (INST_EXPAND_DROP): [Bugs 2835313, 3614226]: New opcode to allow resetting the stack to get rid of an expansion, restoring the stack to a known state in the process. * generic/tclCompile.c, generic/tclCompCmds.c: Adjusted the compilers for [break] and [continue] to get stack cleanup right in the majority of cases. * tests/for.test (for-7.*): Set of tests for these evil cases. 2013-06-04 Jan Nijtmans * unix/tcl.m4: Eliminate NO_VIZ macro as current zlib uses HAVE_HIDDEN instead. One more last-moment fix for FreeBSD by Pietro Cerutti 2013-06-03 Miguel Sofer * generic/tclExecute.c: fix for perf bug detected by Kieran (https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ), diagnosed by dgp to be a close relative of [Bug 781585], which was fixed by commit [f46fb50cb3]. This bug was introduced by myself in commit [cbfe055d8c]. 2013-06-03 Donal K. Fellows * generic/tclCompCmds.c (TclCompileBreakCmd, TclCompileContinueCmd): Added code to allow [break] and [continue] to be issued as a jump (in the most common cases) rather than using the more expensive exception processing path in the bytecode engine. [Bug 3614226]: Partial fix for the issues relating to cleaning up the stack when dealing with [break] and [continue]. 2013-05-27 Harald Oehlmann * library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from registry key HCU\Control Panel\Desktop : PreferredUILanguages to honor installed language packs on Vista+. Bumped msgcat version to 1.5.2 2013-05-22 Andreas Kupries * tclCompile.c: Removed duplicate const qualifier causing the HP native cc to error out. 2013-05-22 Donal K. Fellows * generic/tclUtf.c (TclUtfCasecmp): [Bug 3613609]: Replace problematic uses of strcasecmp with a proper UTF-8-aware version. Affects both [lsearch -nocase] and [lsort -nocase]. 2013-05-22 Donal K. Fellows * doc/file.n: [Bug 3613671]: Added note to portability section on the fact that [file owned] does not produce useful results on Windows. 2013-05-20 Donal K. Fellows * unix/tclUnixFCmd.c (DefaultTempDir): [Bug 3613567]: Corrected logic for checking return code of access() system call, which was inverted. 2013-05-19 Jan Nijtmans * unix/tcl.m4: Fix for FreeBSD, and remove support for older * unix/configure: FreeBSD versions. Patch by Pietro Cerutti. 2013-05-18 Donal K. Fellows * generic/tclCompCmdsGR.c: Split tclCompCmds.c again to keep size of code down. 2013-05-16 Jan Nijtmans * generic/tclBasic.c: Add panic in order to detect incompatible mingw32 sys/stat.h and sys/time.h headers. 2013-05-13 Jan Nijtmans * compat/zlib/*: Upgrade to zlib 1.2.8 2013-05-10 Donal K. Fellows Optimizations and general bytecode generation improvements. * generic/tclCompCmds.c (TclCompileAppendCmd, TclCompileLappendCmd): (TclCompileReturnCmd): Make these generate bytecode in more cases. (TclCompileListCmd): Make this able to push a literal when it can. * generic/tclCompile.c (TclSetByteCodeFromAny, PeepholeOptimize): Added checks to see if we can apply some simple cross-command-boundary optimizations, and defined a small number of such optimizations. (TclCompileScript): Added the special ability to compile the list command with expansion ([list {*}blah]) into bytecode that does not call an external command. 2013-05-06 Jan Nijtmans * generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit * generic/tclDecls.h: "long" type. Binary compatibility with win64 requires that all stub entries use 32-bit long's, therefore the need for various wrapper functions/macros. For Tcl 9 a better solution is needed, but that cannot be done without introducing binary incompatibility. 2013-04-30 Andreas Kupries * library/platform/platform.tcl (::platform::LibcVersion): * library/platform/pkgIndex.tcl: Followup to the 2013-01-30 change. The RE become too restrictive again. SuSe added a timestamp after the version. Loosened up a bit. Bumped package to version 1.0.12. 2013-04-29 Donal K. Fellows * generic/tclCompCmds.c (TclCompileArraySetCmd): Generate better code when the list of things to set is a literal. 2013-04-25 Jan Nijtmans * generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it only eliminates code duplication. * generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's exactly the same as TCL_WIDE_INT_IS_LONG 2013-04-19 Jan Nijtmans * generic/tclDecls.h: Implement many Tcl_*Var* functions and Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp their Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct. 2013-04-12 Jan Nijtmans * generic/tclDecls.h: Implement Tcl_Pkg* functions as (faster/stack-saving) macros around Tcl_Pkg*Ex functions. 2013-04-08 Don Porter * generic/regc_color.c: [Bug 3610026]: Stop crash when the number of * generic/regerrs.h: "colors" in a regular expression overflows a * generic/regex.h: short int. Thanks to Heikki Linnakangas for * generic/regguts.h: the report and the patch. * tests/regexp.test: 2013-04-04 Reinhard Max * library/http/http.tcl (http::geturl): Allow URLs that don't have a path, but a query query, e.g. http://example.com?foo=bar * Bump the http package to 2.8.7. 2013-03-22 Venkat Iyer * library/tzdata/Africa/Cairo: Update to tzdata2013b. * library/tzdata/Africa/Casablanca: * library/tzdata/Africa/Gaborone: * library/tzdata/Africa/Tripoli: * library/tzdata/America/Asuncion: * library/tzdata/America/Barbados: * library/tzdata/America/Bogota: * library/tzdata/America/Costa_Rica: * library/tzdata/America/Curacao: * library/tzdata/America/Nassau: * library/tzdata/America/Port-au-Prince: * library/tzdata/America/Santiago: * library/tzdata/Antarctica/Palmer: * library/tzdata/Asia/Aden: * library/tzdata/Asia/Hong_Kong: * library/tzdata/Asia/Muscat: * library/tzdata/Asia/Rangoon: * library/tzdata/Asia/Shanghai: * library/tzdata/Atlantic/Bermuda: * library/tzdata/Europe/Vienna: * library/tzdata/Pacific/Easter: * library/tzdata/Pacific/Fiji: * library/tzdata/Asia/Khandyga: (new) * library/tzdata/Asia/Ust-Nera: (new) * library/tzdata/Europe/Busingen: (new) 2013-03-21 Don Porter * library/auto.tcl: [Bug 2102614]: Add ensemble indexing support to * tests/autoMkindex.test: [auto_mkindex]. Thanks Brian Griffin. 2013-03-19 Don Porter * generic/tclFCmd.c: [Bug 3597000]: Consistent [file copy] result. * tests/fileSystem.test: 2013-03-19 Jan Nijtmans * win/tclWinFile.c: [Bug 3608360]: Incompatible behaviour of "file exists". 2013-03-18 Donal K. Fellows * tests/cmdAH.test (cmdAH-19.12): [Bug 3608360]: Added test to ensure that we never ever allow [file exists] to do globbing. 2013-03-12 Jan Nijtmans * unix/tcl.m4: Patch by Andrew Shadura, providing better support for three architectures they have in Debian. 2013-03-11 Don Porter * generic/tclCompile.c: [Bugs 3607246,3607372]: Unbalanced refcounts * generic/tclLiteral.c: of literals in the global literal table. 2013-03-06 Don Porter * generic/regc_nfa.c: [Bugs 3604074,3606683]: Rewrite of the * generic/regcomp.c: fixempties() routine (and supporting routines) to completely eliminate the infinite loop hazard. Thanks to Tom Lane for the much improved solution. 2013-02-28 Don Porter * generic/tclLiteral.c: Revise TclReleaseLiteral() to tolerate a NULL interp argument. * generic/tclCompile.c: Update callers and revise mistaken comments. * generic/tclProc.c: 2013-02-27 Jan Nijtmans * generic/regcomp.c: [Bug 3606139]: missing error check allows * tests/regexp.test: regexp to crash Tcl. Thanks to Tom Lane for providing the test-case and the patch. 2013-02-26 Donal K. Fellows * tests/chanio.test (chan-io-28.7): [Bug 3605120]: Stop test from hanging when run standalone. 2013-02-26 Jan Nijtmans * generic/tclObj.c: Don't panic if Tcl_ConvertToType is called for a type that doesn't have a setFromAnyProc, create a proper error message. 2013-02-25 Donal K. Fellows * tests/binary.test (binary-41.*): [Bug 3605721]: Test independence fixes. Thanks to Rolf Ade for pointing out the problem. 2013-02-25 Don Porter * tests/assocd.test: [Bugs 3605719,3605720]: Test independence. * tests/basic.test: Thanks Rolf Ade for patches. 2013-02-23 Jan Nijtmans * compat/fake-rfc2553.c: [Bug 3599194]: compat/fake-rfc2553.c is broken. 2013-02-22 Don Porter * generic/tclAssembly.c: Shift more burden of smart cleanup * generic/tclCompile.c: onto the TclFreeCompileEnv() routine. Stop crashes when the hookProc raises an error. 2013-02-20 Don Porter * generic/tclNamesp.c: [Bug 3605447]: Make sure the -clear option * tests/namespace.test: to [namespace export] always clears, whether or not new export patterns are specified. 2013-02-20 Jan Nijtmans * win/tclWinDde.c: [Bug 3605401]: Compiler error with latest mingw-w64 headers. 2013-02-19 Jan Nijtmans * generic/tclTrace.c: [Bug 2438181]: Incorrect error reporting in * tests/trace.test: traces. Test-case and fix provided by Poor Yorick. 2013-02-15 Don Porter * generic/regc_nfa.c: [Bug 3604074]: Fix regexp optimization to * tests/regexp.test: stop hanging on the expression ((((((((a)*)*)*)*)*)*)*)* . Thanks to BjУИrn Grathwohl for discovery. 2013-02-14 Harald Oehlmann * library/msgcat/msgcat.tcl: [Bug 3604576]: Catch missing registry entry "HCU\Control Panel\International". Bumped msgcat version to 1.5.1 2013-02-11 Donal K. Fellows * generic/tclZlib.c (ZlibTransformOutput): [Bug 3603553]: Ensure that data gets written to the underlying stream by compressing transforms when the amount of data to be written is one buffer's-worth; problem was particularly likely to occur when compressing large quantities of not-very-compressible data. Many thanks to Piera Poggio (vampiera) for reporting. 2013-02-09 Donal K. Fellows * generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 3603695]: Change the way that the 'varname' method is implemented so that there are no longer problems with interactions due to the resolver. Thanks to Taylor Venable for identifying the problem. 2013-02-08 Donal K. Fellows * generic/regc_nfa.c (duptraverse): [Bug 3603557]: Increase the maximum depth of recursion used when duplicating an automaton in response to encountering a "wild" RE that hit the previous limit. Allow the limit (DUPTRAVERSE_MAX_DEPTH) to be set by defining its value in the Makefile. Problem reported by Jonathan Mills. 2013-02-05 Don Porter * win/tclWinFile.c: [Bug 3603434]: Make sure TclpObjNormalizePath() properly declares "a:/" to be normalized, even when no "A:" drive is present on the system. 2013-02-05 Donal K. Fellows * generic/tclLoadNone.c (TclpLoadMemory): [Bug 3433012]: Added dummy version of this function to use in the event that a platform thinks it can load from memory but cannot actually do so due to it being disabled at configuration time. 2013-02-04 Donal K. Fellows * generic/tclCompCmds.c (TclCompileArraySetCmd): [Bug 3603163]: Stop crash in weird case where [eval] is used to make [array set] get confused about whether there is a local variable table or not. Thanks to Poor Yorick for identifying a reproducible crashing case. 2013-01-30 Andreas Kupries * library/platform/platform.tcl (::platform::LibcVersion): See * library/platform/pkgIndex.tcl: [Bug 3599098]: Fixed the RE * unix/Makefile.in: extracting the version to avoid issues with * win/Makefile.in: recent changes to the glibc banner. Now targeting a less variable part of the string. Bumped package to version 1.0.11. 2013-01-28 Donal K. Fellows * generic/tclCompCmds.c (TclCompileArraySetCmd) (TclCompileArrayUnsetCmd, TclCompileDictAppendCmd) (TclCompileDictCreateCmd, CompileDictEachCmd, TclCompileDictIncrCmd) (TclCompileDictLappendCmd, TclCompileDictMergeCmd) (TclCompileDictUnsetCmd, TclCompileDictUpdateCmd) (TclCompileDictWithCmd, TclCompileInfoCommandsCmd): * generic/tclCompCmdsSZ.c (TclCompileStringMatchCmd) (TclCompileStringMapCmd): Improve the code generation in cases where full compilation is impossible but a full ensemble invoke is provably not necessary. 2013-01-26 Jan Nijtmans * unix/tclUnixCompat.c: [Bug 3601804]: platformCPUID segmentation fault on Darwin. 2013-01-23 Donal K. Fellows * library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait for connect to avoid reentrancy problems (except when operating without a -command option). Internally, this means that all sockets created by the http package will always be operated in asynchronous mode. 2013-01-21 Jan Nijtmans * generic/tclInt.decls: Put back Tcl[GS]etStartupScript(Path|FileName) in private stub table, so extensions using this (like Tk 8.4) will continue to work in all Tcl 8.x versions. Extensions using this still cannot be compiled against Tcl 8.6 headers. 2013-01-18 Jan Nijtmans * generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include sys/stat.h 2013-01-17 Donal K. Fellows * generic/tclCompCmds.c (PushVarName): [Bug 3600328]: Added mechanism for suppressing compilation of variables when we couldn't cope with the results. Useful for some [array] subcommands. * generic/tclEnsemble.c (CompileToCompiledCommand): Must restore the compilation environment when a command compiler fails. 2013-01-16 Donal K. Fellows * generic/tclZlib.c (TclZlibInit): [Bug 3601086]: Register the config info in the iso8859-1 encoding as that is guaranteed to be present. 2013-01-16 Jan Nijtmans * Makefile.in: Allow win32 build with -DTCL_NO_DEPRECATED, just as * generic/tcl.h: in the UNIX build. Define Tcl_EvalObj and * generic/tclDecls.h: Tcl_GlobalEvalObj as macros, even when * generic/tclBasic.c: TCL_NO_DEPRECATED is defined, so Tk can benefit from it too. 2013-01-14 Jan Nijtmans * win/tcl.m4: More flexible search for win32 tclConfig.sh, backported from TEA (not actually used in Tcl, only for Tk) 2013-01-14 Jan Nijtmans * generic/tclInt.decls: Put back Tcl_[GS]etStartupScript in internal stub table, so extensions using this, compiled against 8.5 headers still run in Tcl 8.6. 2013-01-13 Alexandre Ferrieux * doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false positives" in the case of multibyte encodings/transforms. 2013-01-13 Jan Nijtmans * generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make sure that TIP #139 functions all are taken from the public stub table, even if the inclusion is through tclInt.h. 2013-01-12 Jan Nijtmans * generic/tclInt.decls: Put back TclBackgroundException in internal stub table, so extensions using this, compiled against 8.5 headers still run in Tcl 8.6. 2013-01-09 Jan Nijtmans * library/http/http.tcl: [Bug 3599395]: http assumes status line is a proper Tcl list. 2013-01-08 Jan Nijtmans * win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path components. [Bug 3587096]: win vista/7: "can't find init.tcl" when called via junction without folder list access. 2013-01-07 Jan Nijtmans * generic/tclOOStubLib.c: Restrict the stub library to only use * generic/tclTomMathStubLib.c: Tcl_PkgRequireEx, Tcl_ResetResult and Tcl_AppendResult, not any other function. This puts least restrictions on eventual Tcl 9 stubs re-organization, and it works on the widest range of Tcl versions. 2013-01-06 Jan Nijtmans * library/http/http.tcl: Don't depend on Spencer-specific regexp * tests/env.test: syntax (/u and /U) any more in unrelated places. * tests/exec.test: Bump http package to 2.8.6. 2013-01-04 Donal K. Fellows * generic/tclEnsemble.c (CompileBasicNArgCommand): Added very simple compiler (which just compiles to a normal invoke of the implementation command) for many ensemble subcommands where we can prove that there is no way for scripts to detect the difference even through error handling or [info level]/[info frame]. This improves the code produced from some ensembles (e.g., [info], [string]) to the point where the ensemble is now not normally seen at the bytecode level at all. 2013-01-04 Miguel Sofer * generic/tclInt.h: Insure that PURIFY builds cannot exploit the * generic/tclExecute.c: Tcl stack to hide mem defects. 2013-01-03 Donal K. Fellows * doc/fconfigure.n, doc/CrtChannel.3: Updated to reflect the fact that the minimum buffer size is one byte, not ten. Identified by Schelte Bron on the Tcler's Chat. * generic/tclExecute.c (TEBCresume:INST_INVOKE_REPLACE): * generic/tclEnsemble.c (TclCompileEnsemble): Added new mechanism to allow for more efficient dispatch of non-bytecode-compiled subcommands of bytecode-compiled ensembles. This can provide substantial speed benefits in some cases. 2013-01-02 Miguel Sofer * generic/tclEnsemble.c: Remove stray calls to Tcl_Alloc and friends: * generic/tclExecute.c: the core should only use ckalloc to allow * generic/tclIORTrans.c: MEM_DEBUG to work properly. * generic/tclTomMathInterface.c: 2012-12-31 Donal K. Fellows * doc/string.n: Noted the obsolescence of the 'bytelength', 'wordstart' and 'wordend' subcommands, and moved them to later in the file. 2012-12-27 Jan Nijtmans * generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release deleted elements too early. 2012-12-22 Alexandre Ferrieux * generic/tclUtil.c: [Bug 3598150]: Stop leaking allocated space when objifying a zero-length DString. Spotted by afredd. 2012-12-21 Jan Nijtmans * unix/dltest/pkgb.c: Inline compat Tcl_GetDefaultEncodingDir. * generic/tclStubLib.c: Eliminate unnecessary static HasStubSupport() and isDigit() functions, just do the same inline. 2012-12-18 Donal K. Fellows * generic/tclCompCmdsSZ.c (TclSubstCompile): Improved the sequence of instructions issued for [subst] when dealing with simple variable references. 2012-12-14 Don Porter *** 8.6.0 TAGGED FOR RELEASE *** * changes: updates for 8.6.0 2012-12-13 Don Porter * generic/tclZlib.c: Repair same issue with misusing the * tests/zlib.test: 'fire and forget' nature of Tcl_ObjSetVar2 in the new TIP 400 implementation. 2012-12-13 Miguel Sofer * generic/tclCmdAH.c: (CatchObjCmdCallback): do not decrRefCount * tests/cmdAH.test: the newValuePtr sent to Tcl_ObjSetVar2: TOSV2 is 'fire and forget', it decrs on its own. Fix for [Bug 3595576], found by andrewsh. 2012-12-13 Jan Nijtmans * generic/tcl.h: Fix Tcl_DecrRefCount macro such that it doesn't access its objPtr parameter twice any more. 2012-12-11 Don Porter * generic/tcl.h: Bump version number to 8.6.0. * library/init.tcl: * unix/configure.in: * win/configure.in: * unix/tcl.spec: * README: * unix/configure: autoconf-2.59 * win/configure: 2012-12-10 Donal K. Fellows * tools/tcltk-man2html.tcl (plus-pkgs): Increased robustness of version number detection code to deal with packages whose names are prefixes of other packages. * unix/Makefile.in (dist): Added pkgs/package.list.txt to distribution builds to ensure that 'make html' will work better. 2012-12-09 Alexandre Ferrieux * tests/chan.test: Clean up unwanted eofchar side-effect of chan-4.6 leading to a spurious "'" at end of chan.test under certain conditions (see [Bug 3389289] and [Bug 3389251]). * doc/expr.n: [Bug 3594188]: Clarifications about commas. 2012-12-08 Alexandre Ferrieux * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT when there are unflushed nonblocking channels. Thanks Miguel for spotting. 2012-12-07 Jan Nijtmans * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should either result in an error-message, either succeed, but never crash. 2012-11-28 Donal K. Fellows * generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism for complex option resolution that has fewer problems with more finicky compilers. 2012-11-26 Reinhard Max * unix/tclUnixSock.c: Factor out creation of the -sockname and -peername lists from TcpGetOptionProc() to TcpHostPortList(). Make it robust against implementations of getnameinfo() that error out if reverse mapping fails instead of falling back to the numeric representation. 2012-11-20 Donal K. Fellows * generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected handling of trailing whitespace when decoding base64. Thanks to Anton Kovalenko for reporting, and Andy Goth for the fix and tests. 2012-11-19 Donal K. Fellows * generic/tclExecute.c (INST_STR_RANGE_IMM): [Bug 3588366]: Corrected implementation of bounds restriction for end-indexed compiled [string range]. Thanks to Emiliano Gavilan for diagnosis and fix. 2012-11-15 Jan Nijtmans IMPLEMENTATION OF TIP#416 New Options for 'load': -global and -lazy * generic/tcl.h: * generic/tclLoad.c * unix/tclLoadDl.c * unix/tclLoadDyld.c * tests/load.test * doc/Load.3 * doc/load.n 2012-11-14 Donal K. Fellows * unix/tclUnixFCmd.c (TclUnixOpenTemporaryFile): [Bug 2933003]: Factor out all the code to do temporary file creation so that it is possible to make it correct in one place. Allow overriding of the back-stop default temporary file location at compile time by setting the TCL_TEMPORARY_FILE_DIRECTORY #def to a string containing the directory name (defaults to "/tmp" as that is the most common default). 2012-11-13 Joe Mistachkin * win/tclWinInit.c: also search for the library directory (init.tcl, encodings, etc) relative to the build directory associated with the source checkout. 2012-11-10 Miguel Sofer * generic/tclBasic.c: re-enable bcc-tailcall, after fixing an * generic/tclExecute.c: infinite loop in the TCL_COMPILE_DEBUG mode 2012-11-07 Kevin B. Kenny * library/tzdata/Africa/Casablanca: * library/tzdata/America/Araguaina: * library/tzdata/America/Bahia: * library/tzdata/America/Havana: * library/tzdata/Asia/Amman: * library/tzdata/Asia/Gaza: * library/tzdata/Asia/Hebron: * library/tzdata/Asia/Jerusalem: * library/tzdata/Pacific/Apia: * library/tzdata/Pacific/Fakaofo: * library/tzdata/Pacific/Fiji: Import tzdata2012i. 2012-11-06 Donal K. Fellows * library/http/http.tcl (http::Finish): [Bug 3581754]: Ensure that callbacks are done at most once to prevent problems with timeouts on a keep-alive connection (combined with reentrant http package use) causing excessive stack growth. Not a fix for the underlying problem, but ensures that pain will be mostly kept away from users. Bump http package to 2.8.5. 2012-11-05 Donal K. Fellows Added bytecode compilation of many Tcl commands. Some of these are total compilations and some are only partial (i.e., only compile in some cases). The (sub-)commands affected are: * array: exists, set, unset * dict: create, exists, merge * format: (simple cases only) * info: commands, coroutine, level, object * info object: class, isa object, namespace * namespace: current, code, qualifiers, tail, which * regsub: (only cases convertable to simple [string map]) * self: (only no-argument and [self object] cases) * string: first, last, map, range * tailcall: * yield: [This was work originally done on the 'dkf-compile-misc-info' branch.] 2012-11-05 Jan Nijtmans IMPLEMENTATION OF TIP#413 Align the [string trim] and [string is space] commands, such that [string trim] by default trims all characters for which [string is space] returns 1, augmented with the NUL character. * generic/tclUtf.c: Add NEL, BOM and two more characters to [string is space] * generic/tclCmdMZ.c: Modify [string trim] for Unicode modifications. * generic/regc_locale.c: Regexp engine must match [string is space] * doc/string.n * tests/string.test ***POTENTIAL INCOMPATIBILITY*** Code that relied on characters not previously trimmed being not removed will notice a difference; it is believed that this is rare, but a workaround to get the behavior in Tcl 8.5 is to use " \t\n\r" as an explicit trim set. 2012-10-31 Jan Nijtmans * win/Makefile.in: Dde version number to 1.4.0, ready for Tcl 8.6.0rc1 * win/makefile.vc * win/tclWinDde.c * library/dde/pkgIndex.tcl * tests/winDde.test 2012-10-24 Donal K. Fellows * generic/tclCompCmds.c (TclCompileDictUnsetCmd): Added compilation of the [dict unset] command (for scalar var in LVT only). 2012-10-23 Jan Nijtmans * generic/tclInt.h: Add "flags" parameter from Tcl_LoadFile to * generic/tclIOUtil.c: to various internal functions, so these * generic/tclLoadNone.c: flags are available through the whole * unix/tclLoad*.c: filesystem for (future) internal use. * win/tclWinLoad.c: 2012-10-17 Miguel Sofer * generic/tclBasic.c (TclNRCoroutineObjCmd): insure that numlevels are properly set, fix bug discovered by dkf and reported at http://code.activestate.com/lists/tcl-core/12213/ 2012-10-16 Donal K. Fellows IMPLEMENTATION OF TIP#405 New commands for applying a transformation to the elements of a list to produce another list (the [lmap] command) and to the mappings of a dictionary to produce another dictionary (the [dict map] command). In both cases, a [continue] will cause the skipping of an element/pair, and a [break] will terminate the construction early and successfully. * generic/tclCmdAH.c (Tcl_LmapObjCmd, TclNRLmapCmd): Implementation of the new [lmap] command, based on (and sharing much of) [foreach]. * generic/tclDictObj.c (DictMapNRCmd): Implementation of the new [dict map] subcommand, based on (and sharing much of) [dict for]. * generic/tclCompCmds.c (TclCompileLmapCmd, TclCompileDictMapCmd): Compilation engines for [lmap] and [dict map]. IMPLEMENTATION OF TIP#400 * generic/tclZlib.c: Allow the specification of a compression dictionary (a binary blob used to seed the compression engine) in both streams and channel transformations. Also some reorganization to allow for getting gzip header dictionaries and controlling buffering levels in channel transformations (allowing a trade-off between formal correctness and speed). (Tcl_ZlibStreamSetCompressionDictionary): New C API to allow setting the compression dictionary without using a Tcl script. 2012-10-14 Jan Nijtmans * generic/tclDictObj.c: [Bug 3576509]: ::tcl::Bgerror crashes with * generic/tclEvent.c: invalid arguments. Better fix, which helps for all Tcl_DictObjGet() calls in Tcl's source code. 2012-10-13 Jan Nijtmans * generic/tclEvent.c: [Bug 3576509]: tcl::Bgerror crashes with invalid arguments 2012-10-06 Jan Nijtmans * win/Makefile.in: [Bug 2459774]: tcl/win/Makefile.in not compatible with msys 0.8. 2012-10-03 Don Porter * generic/tclIO.c: When checking for std channels being closed, compare the channel state, not the channel itself so that stacked channels do not cause trouble. 2012-09-26 Reinhard Max * generic/tclIOSock.c (TclCreateSocketAddress): Work around a bug in getaddrinfo() on OSX that caused name resolution to fail for [socket -server foo -myaddr localhost 0]. 2012-09-20 Jan Nijtmans * win/configure.in: New import libraries for zlib 1.2.7, usable for * win/configure: all win32/win64 compilers * compat/zlib/win32/zdll.lib: * compat/zlib/win64/zdll.lib: * win/tclWinDde.c: [FRQ 3527238]: Full unicode support for dde. Dde version is now 1.4.0b2. ***POTENTIAL INCOMPATIBILITY*** 2012-09-19 Jan Nijtmans * generic/tcl.h: Make Tcl_Interp a fully opaque structure if TCL_NO_DEPRECATED is set (TIP 330 and 336). * win/nmakehlp.c: Let "nmakehlp -V" start searching digits after the found match (suggested by Harald Oehlmann). 2012-09-19 Harald Oehlmann IMPLEMENTATION OF TIP#412. * library/msgcat/msgcat.tcl: dynamic locale change with mc file * library/clock.tcl: load on locale change. clock uses new msgcat features. 2012-09-07 Harald Oehlmann *** 8.6b3 TAGGED FOR RELEASE *** IMPLEMENTATION OF TIP#404. * library/msgcat/msgcat.tcl: [FRQ 3544988]: New commands [mcflset] * library/msgcat/pkgIndex.tcl: and [mcflmset] to set mc entries with * unix/Makefile.in: implicit message file locale. * win/Makefile.in: Bump to 1.5.0. 2012-08-25 Donal K. Fellows * library/msgs/uk.msg: [Bug 3561330]: Use the correct full name of March in Ukrainian. Thanks to Mikhail Teterin for reporting. 2012-08-23 Jan Nijtmans * generic/tclBinary.c: [Bug 3496014]: Unecessary memset() in Tcl_SetByteArrayObj(). 2012-08-20 Don Porter * generic/tclPathObj.c: [Bug 3559678]: Fix bad filename normalization when the last component is the empty string. 2012-08-20 Jan Nijtmans * win/tclWinPort.h: Remove wrapper macro for ntohs(): unnecessary, because it doesn't require an initialized winsock_2 library. See: * win/tclWinSock.c: * generic/tclStubInit.c: 2012-08-17 Jan Nijtmans * win/nmakehlp.c: Add "-V" option, in order to be able to detect partial version numbers. 2012-08-15 Jan Nijtmans * win/buildall.vc.bat: Only build the threaded builds by default * win/rules.vc: Some code cleanup 2010-08-13 Stuart Cassoff * unix/tclUnixCompat.c: [Bug 3555454]: Rearrange a bit to quash 'declared but never defined' compiler warnings. 2012-08-13 Jan Nijtmans * compat/zlib/win64/zlib1.dll: Add 64-bit build of zlib1.dll, and use * compat/zlib/win64/zdll.lib: it for the dynamic mingw-w64 build. * win/Makefile.in: * win/configure.in: * win/configure: 2012-08-09 Reinhard Max * tests/http.test: Fix http-3.29 for machines without IPv6 support. 2010-08-08 Stuart Cassoff * unix/tclUnixCompat.c: Change one '#ifdef' to '#if defined()' for improved consistency within the file. 2012-08-08 Jan Nijtmans * generic/tclfileName.c: [Bug #1536227]: Cygwin network pathname * tests/fileName.test: support 2012-08-07 Don Porter * generic/tclIOUtil.c: [Bug 3554250]: Overlooked one field of cleanup in the thread exit handler for the filesystem subsystem. 2012-07-31 Donal K. Fellows * generic/tclInterp.c (Tcl_GetInterpPath): * unix/tclUnixPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd): * win/tclWinPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd): Purge use of Tcl_AppendElement, and corrected conversion of PIDs to integer objects. 2012-07-31 Jan Nijtmans * win/nmakehlp.c: Add -Q option from sampleextension. * win/Makefile.in: [FRQ 3544967]: Missing objectfiles in static lib * win/makefile.vc: (Thanks to Jos Decoster). 2012-07-29 Jan Nijtmans * win/Makefile.in: No longer build tcltest.exe to run the tests, but use tclsh86.exe in combination with tcltest86.dll to do that. * tests/*.test: load tcltest86.dll if necessary. 2012-07-28 Jan Nijtmans * tests/clock.test: [Bug 3549770]: Multiple test failures running * tests/registry.test: tcltest outside build tree * tests/winDde.test: 2012-07-27 Jan Nijtmans * generic/tclUniData.c: Support Unicode 6.2 (Add Turkish lira sign) * generic/regc_locale.c: 2012-07-25 Alexandre Ferrieux * win/tclWinPipe.c: [Bug 3547994]: Abandon the synchronous Windows pipe driver to its fate when needed to honour TIP#398. 2012-07-24 Trevor Davel * win/tclWinSock.c: [Bug: 3545363]: Loop over multiple underlying file descriptors for a socket where required (TcpCloseProc, SocketProc). Refactor socket/descriptor setup to manage linked list operations in one place. Fix memory leak in socket close (TcpCloseProc) and related dangling pointers in SocketEventProc. 2012-07-19 Reinhard Max * win/tclWinSock.c (TcpAccept): [Bug: 3545363]: Use a large enough buffer for accept()ing IPv6 connections. Fix conversion of host and port for passing to the accept proc to be independent of the IP version. 2012-07-23 Alexandre Ferrieux * generic/tclIO.c: [Bug 3545365]: Never try a bg-flush on a dead channel, just like before 2011-08-17. 2012-07-19 Joe Mistachkin * generic/tclTest.c: Fix several more missing mutex-locks in TestasyncCmd. 2012-07-19 Alexandre Ferrieux * generic/tclTest.c: [Bug 3544685]: Missing mutex-lock in TestasyncCmd since 2011-08-19. Unbounded gratitude to Stuart Cassoff for spotting it. 2012-07-17 Jan Nijtmans * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails 2012-07-16 Donal K. Fellows * generic/tclUtil.c (UpdateStringOfEndOffset): [Bug 3544658]: Stop 1-byte overrun in memcpy, that object placement rules made harmless but which still caused compiler complaints. 2012-07-16 Jan Nijtmans * library/reg/pkgIndex.tcl: Make registry 1.3 package dynamically loadable when ::tcl::pkgconfig is available. 2012-07-11 Jan Nijtmans * win/tclWinReg.c: [Bug 3362446]: registry keys command fails with 8.5/8.6. Follow Microsofts example better in order to prevent problems when using HKEY_PERFORMANCE_DATA. 2012-07-10 Jan Nijtmans * unix/tclUnixNotfy.c: [Bug 3541646]: Don't panic on triggerPipe overrun. 2012-07-10 Donal K. Fellows * win/tclWinSock.c (InitializeHostName): Corrected logic that extracted the name of the computer from the gethostname call so that it would use the name on success, not failure. Also ensured that the buffer size is exactly that recommended by Microsoft. 2012-07-08 Reinhard Max * library/http/http.tcl: [Bug 3531209]: Add fix and test for URLs that * tests/http.test: contain literal IPv6 addresses. 2012-07-05 Don Porter * unix/tclUnixPipe.c: [Bug 1189293]: Make "<<" binary safe. * win/tclWinPipe.c: 2012-07-03 Donal K. Fellows * generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString): * generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear): * generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make common cases of appending to Tcl_DStrings simpler to write. Prompted by looking at [FRQ 1357401] (these are an _internal_ implementation of that FRQ). 2012-06-29 Jan Nijtmans * library/msgcat/msgcat.tcl: Add tn, ro_MO and ru_MO to msgcat. 2012-06-29 Harald Oehlmann * library/msgcat/msgcat.tcl: [Bug 3536888]: Locale guessing of * library/msgcat/pkgIndex.tcl: msgcat fails on (some) Windows 7. Bump * unix/Makefile.in: to 1.4.5 * win/Makefile.in: 2012-06-29 Donal K. Fellows * doc/GetIndex.3: Reinforced the description of the requirement for the tables of names to index over to be static, following posting to tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying this rule correctly. This does not represent a functionality change, merely a clearer documentation of a long-standing constraint. 2012-06-26 Jan Nijtmans * unix/tcl.m4: Let Cygwin shared build link with * unix/configure.in: zlib1.dll, not cygz.dll (two less * unix/configure: dependencies on cygwin-specific dll's) * unix/Makefile.in: 2012-06-26 Reinhard Max * generic/tclIOSock.c: Use EAI_SYSTEM only if it exists. * unix/tclUnixSock.c: 2012-06-25 Don Porter * generic/tclFileSystem.h: [Bug 3024359]: Make sure that the * generic/tclIOUtil.c: per-thread cache of the list of file systems * generic/tclPathObj.c: currently registered is only updated at times when no active loops are traversing it. Also reduce the amount of epoch storing and checking to where it can make a difference. 2012-06-25 Donal K. Fellows * generic/tclCmdAH.c (EncodingDirsObjCmd): [Bug 3537605]: Do the right thing when reporting errors with the number of arguments. 2012-06-25 Jan Nijtmans * generic/tclfileName.c: [Patch 1536227]: Cygwin network pathname * tests/fileName.test: support. 2012-06-23 Jan Nijtmans * unix/tclUnixNotfy.c: [Bug 3508771]: Cygwin notifier for handling win32 events. 2012-06-22 Reinhard Max * generic/tclIOSock.c: Rework the error message generation of [socket], * unix/tclUnixSock.c: so that the error code of getaddrinfo is used * win/tclWinSock.c: instead of errno unless it is EAI_SYSTEM. 2012-06-21 Jan Nijtmans * win/tclWinReg.c: [Bug 3362446]: registry keys command fails * tests/registry.test: with 8.5/8.6 2012-06-11 Don Porter * generic/tclBasic.c: [Bug 3532959]: Make sure the lifetime * generic/tclProc.c: management of entries in the linePBodyPtr * tests/proc.test: hash table can tolerate either order of teardown, interp first, or Proc first. 2012-06-08 Don Porter * unix/configure.in: Update autogoo for gettimeofday(). * unix/tclUnixPort.h: Thanks Joe English. * unix/configure: autoconf 2.13 * unix/tclUnixPort.h: [Bug 3530533]: Centralize #include * unix/tclUnixThrd.c: in the tclUnixPort.h header so that old unix systems that need inclusion in all compilation units are supported. 2012-06-08 Jan Nijtmans * win/tclWinDde.c: Revise the "null data" check: null strings are possible, but empty binary arrays are not. * tests/winDde.test: Add test-case (winDde-9.4) for transferring null-strings with dde. Convert tests to tcltest-2 syntax. 2012-06-06 Donal K. Fellows * generic/tclZlib.c (TclZlibInit): Declare that Tcl is publishing the zlib package (version 2.0) as part of its bootstrap process. This will have an impact on tclkit (which includes zlib 1.1) but otherwise be very low impact. 2012-06-06 Jan Nijtmans * unix/tclUnixInit.c: On Cygwin, use win32 API in stead of uname() to determine the tcl_platform variables. 2012-05-31 Jan Nijtmans * generic/tclZlib.c: [Bug 3530536]: zlib-7.4 fails on IRIX64 * tests/zlib.test: * doc/zlib.n: Document that [stream checksum] doesn't do what's expected for "inflate" and "deflate" formats 2012-05-31 Donal K. Fellows * library/safe.tcl (safe::AliasFileSubcommand): Don't assume that slaves have corresponding commands, as that is not true for sub-subinterpreters (used in Tk's test suite). * doc/safe.n: [Bug 1997845]: Corrected formatting so that generated HTML can link properly. * tests/socket.test (socket*-13.1): Prevented intermittent test failure due to race condition. 2012-05-29 Donal K. Fellows * doc/expr.n, doc/mathop.n: [Bug 2931407]: Clarified semantics of division and remainder operators. 2012-05-29 Jan Nijtmans * win/tclWinDde.c: [Bug 3525762]: Encoding handling in dde. * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX 2012-05-28 Donal K. Fellows * library/safe.tcl (safe::AliasFileSubcommand): [Bug 3529949]: Made a more sophisticated method for preventing information leakage; it changes references to "~user" into "./~user", which is safe. 2012-05-25 Donal K. Fellows * doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is going on with respect to qualification of command prefixes in ensemble subcommand maps. * generic/tclIO.h (SYNTHETIC_EVENT_TIME): Factored out the definition of the amount of time that should be waited before firing a synthetic event on a channel. 2012-05-25 Jan Nijtmans * win/tclWinDde.c: [Bug 473946]: Special characters were not correctly sent, now for XTYP_EXECUTE as well as XTYP_REQUEST. * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX 2012-05-24 Jan Nijtmans * tools/genStubs.tcl: Take cygwin handling of X11 into account. * generic/tcl*Decls.h: re-generated * generic/tclStubInit.c: Implement TclpIsAtty, Cygwin only. * doc/dde.n: Doc fix: "dde execute iexplore" doesn't work without -async, because iexplore doesn't return a value 2012-05-24 Jan Nijtmans * tools/genStubs.tcl: Let cygwin share stub table with win32 * win/tclWinSock.c: implement TclpInetNtoa for win32 * generic/tclInt.decls: Revert most of [3caedf05df], since when we let cygwin share the win32 stub table this is no longer necessary * generic/tcl*Decls.h: re-generated * doc/dde.n: 1.3 -> 1.4 2012-05-23 Donal K. Fellows * generic/tclZlib.c (ZlibTransformInput): [Bug 3525907]: Ensure that decompressed input is flushed through the transform correctly when the input stream gets to the end. Thanks to Alexandre Ferrieux and Andreas Kupries for their work on this. 2012-05-21 Don Porter * generic/tclFileName.c: When using Tcl_SetObjLength() calls to * generic/tclPathObj.c: grow and shrink the objPtr->bytes buffer, care must be taken that the value cannot possibly become pure Unicode. Calling Tcl_AppendToObj() has the possibility of making such a conversion. Bug found while valgrinding the trunk. 2012-05-21 Jan Nijtmans IMPLEMENTATION OF TIP#106 * win/tclWinDde.c: Added encoding-related abilities to * library/dde/pkgIndex.tcl: the [dde] command. The dde package's * tests/winDde.test: version is now 1.4.0. * doc/dde.n: 2012-05-20 Donal K. Fellows * generic/tclOOBasic.c (TclOO_Class_Constructor): [Bug 2023112]: Cut the amount of hackiness in class constructors, and refactor some of the error message handling from [oo::define] to be saner in the face of odd happenings. 2012-05-17 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected resulting indexes from -indexvar option to be usable with [string range]; this was always the intention (and is consistent with [regexp -indices] too). ***POTENTIAL INCOMPATIBILITY*** Uses of [switch -regexp -indexvar] that previously compensated for the wrong offsets (by subtracting 1 from the end indices) now do not need to do so as the value is correct. * library/safe.tcl (safe::InterpInit): Ensure that the module path is constructed in the correct order. (safe::AliasGlob): [Bug 2964715]: More extensive handling of what globbing is required to support package loading. * doc/expr.n: [Bug 3525462]: Corrected statement about what happens when comparing "0y" and "0x12"; the previously documented behavior was actually a subtle bug (now long-corrected). 2012-05-16 Donal K. Fellows * generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3445787]: Improve the compatibility of safe interpreters' version of 'file' with that of unsafe interpreters. * library/safe.tcl (::safe::InterpInit): Teach the safe-interp scripts about how to expose 'file' properly. 2012-05-13 Jan Nijtmans * win/tclWinDde.c: Protect against receiving strings without ending \0, as external applications (or Tcl with TIP #106) could generate that. 2012-05-10 Jan Nijtmans * win/tclWinDde.c: [Bug 473946]: Special characters not correctly sent * library/dde/pkgIndex.tcl: Increase version to 1.3.3 2012-05-10 Alexandre Ferrieux * {win,unix}/configure{,.in}: [Bug 2812981]: Clean up bundled packages' build directory from within Tcl's ./configure, to avoid stale configuration. 2012-05-09 Andreas Kupries * generic/tclIORChan.c: [Bug 3522560]: Fixed the crash, enabled the test case. Modified [chan postevent] to properly inject the event(s) into the owner thread's event queue for execution in the correct context. Renamed the ForwardOpTo...Thread() function to match with our terminology. * tests/ioCmd.test: [Bug 3522560]: Added a test which crashes the core if it were not disabled as knownBug. For a reflected channel transfered to a different thread the [chan postevent] run in the handler thread tries to execute the owner threads's fileevent scripts by itself, wrongly reaching across thread boundaries. 2012-04-28 Alexandre Ferrieux * generic/tclIO.c: Properly close nonblocking channels even when not flushing them. 2012-05-03 Jan Nijtmans * compat/zlib/*: Upgrade to zlib 1.2.7 (prebuilt dll is still 1.2.5, will be upgraded as soon as the official build is available) 2012-05-03 Don Porter * tests/socket.test: [Bug 3428754]: Test socket-14.2 tolerate [socket -async] connection that connects synchronously. * unix/tclUnixSock.c: [Bug 3428753]: Fix [socket -async] connections that manage to connect synchronously. 2012-05-02 Jan Nijtmans * generic/configure.in: Better detection and implementation for * generic/configure: cpuid instruction on Intel-derived * generic/tclUnixCompat.c: processors, both 32-bit and 64-bit. * generic/tclTest.c: Move cpuid testcase from win-specific to * win/tclWinTest.c: generic tests, as it should work on all * tests/platform.test: Intel-related platforms now. 2012-04-30 Alexandre Ferrieux * tests/ioCmd.test: [Bug 3522560]: Tame deadlocks in broken refchan tests. 2012-04-28 Alexandre Ferrieux IMPLEMENTATION OF TIP#398 * generic/tclIO.c: Quickly Exit with Non-Blocking Blocked Channels * tests/io.test : *** POTENTIAL INCOMPATIBILITY *** * doc/close.n : (compat flag available) 2012-04-27 Jan Nijtmans * generic/tclPort.h: Move CYGWIN-specific stuff from tclPort.h to * generic/tclEnv.c: tclUnixPort.h, where it belongs. * unix/tclUnixPort.h: * unix/tclUnixFile.c: 2012-04-27 Donal K. Fellows * library/init.tcl (auto_execok): Allow shell builtins to be detected even if they are upper-cased. 2012-04-26 Jan Nijtmans * generic/tclStubInit.c: Get rid of _ANSI_ARGS_ and CONST * generic/tclIO.c: * generic/tclIOCmd.c: * generic/tclTest.c: * unix/tclUnixChan.c: 2012-04-25 Donal K. Fellows * generic/tclUtil.c (TclDStringToObj): Added internal function to make the fairly-common operation of converting a DString into an Obj a more efficient one; for long strings, it can just transfer the ownership of the buffer directly. Replaces this: obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); with this: obj=TclDStringToObj(&ds); 2012-04-24 Jan Nijtmans * generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin tclsh * generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt, * generic/tclStubInit.c: TclWinGetServByName and TclWinCPUID for * generic/tclUnixCompat.c: Cygwin. * unix/configure.in: * unix/configure: * unix/tclUnixCompat.c: 2012-04-18 Kevin B. Kenny * library/tzdata/Africa/Casablanca: * library/tzdata/America/Port-au-Prince: * library/tzdata/Asia/Damascus: * library/tzdata/Asia/Gaza: * library/tzdata/Asia/Hebron: tzdata2012c 2012-04-16 Donal K. Fellows * doc/FileSystem.3 (Tcl_FSOpenFileChannelProc): [Bug 3518244]: Fixed documentation of this filesystem callback function; it must not register its created channel - that's the responsibility of the caller of Tcl_FSOpenFileChannel - as that leads to reference leaks. 2012-04-15 Donal K. Fellows * generic/tclEnsemble.c (NsEnsembleImplementationCmdNR): * generic/tclIOUtil.c (Tcl_FSEvalFileEx): Cut out levels of the C stack by going direct to the relevant internal evaluation function. * generic/tclZlib.c (ZlibTransformSetOption): [Bug 3517696]: Make flushing work correctly in a pushed compressing channel transform. 2012-04-12 Jan Nijtmans * generic/tclInt.decls: [Bug 3514475]: Remove TclpGetTimeZone and * generic/tclIntDecls.h: TclpGetTZName * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: * unix/tclUnixTime.c: * unix/tclWinTilemc: 2012-04-11 Jan Nijtmans * win/tclWinInit.c: [Bug 3448512]: clock scan "1958-01-01" fails * win/tcl.m4: only in debug compilation. * win/configure: * unix/tcl.m4: Use NDEBUG consistantly meaning: no debugging. * unix/configure: * generic/tclBasic.c: * library/dde/pkgIndex.tcl: Use [::tcl::pkgconfig get debug] instead * library/reg/pkgIndex.tcl: of [info exists ::tcl_platform(debug)] 2012-04-10 Donal K. Fellows * generic/tcl.h (TCL_DEPRECATED_API): [Bug 2458976]: Added macro that can be used to mark parts of Tcl's API as deprecated. Currently only used for fields of Tcl_Interp, which TIPs 330 and 336 have deprecated with a migration strategy; we want to encourage people to move away from those fields. 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 of a hack so it is no longer a big problem. 2012-04-04 Donal K. Fellows * generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance): [Bug 3514761]: Fixed bogosity with automated argument description handling when constructing an instance of a class that is itself a member of an ensemble. Thanks to Andreas Kupries for identifying that this was a problem case at all! (Tcl_CopyObjectInstance): Fix potential bleed-over of ensemble information into [oo::copy]. 2012-04-04 Jan Nijtmans * win/tclWinSock.c: [Bug 510001]: TclSockMinimumBuffers needs * generic/tclIOSock.c: platform implementation. * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: 2012-04-03 Jan Nijtmans * generic/tclStubInit.c: Remove the TclpGetTZName implementation for * generic/tclIntDecls.h: Cygwin (from 2012-04-02 commit), re-generated * generic/tclIntPlatDecls.h: 2012-04-02 Donal K. Fellows IMPLEMENTATION OF TIP#396. * generic/tclBasic.c (builtInCmds, TclNRYieldToObjCmd): Convert the formerly-unsupported yieldm and yieldTo commands into [yieldto]. 2012-04-02 Jan Nijtmans * generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin tclsh * generic/tclIntPlatDecls.h: Implement TclWinGetTclInstance, * generic/tclStubInit.c: TclpGetTZName, and various more win32-specific internal functions for Cygwin, so win32 extensions using those can be loaded in the cygwin version of tclsh. 2012-03-30 Jan Nijtmans * unix/tcl.m4: [Bug 3511806]: Compiler checks too early * unix/configure.in: This change allows to build the cygwin and * unix/tclUnixPort.h: mingw32 ports of Tcl/Tk to build out-of-the-box * win/tcl.m4: using a native or cross-compiler. * win/configure.in: * win/tclWinPort.h: * win/README Document how to build win32 or win64 executables with Linux, Cygwin or Darwin. 2012-03-29 Jan Nijtmans * generic/tclCmdMZ.c (StringIsCmd): Faster mem-leak free implementation of [string is entier]. 2012-03-27 Donal K. Fellows IMPLEMENTATION OF TIP#395. * generic/tclCmdMZ.c (StringIsCmd): Implementation of the [string is entier] check. Code by Jos Decoster. 2012-03-27 Jan Nijtmans * generic/tcl.h: [Bug 3508771]: Wrong Tcl_StatBuf used on MinGW. * generic/tclFCmd.c: [Bug 2015723]: Duplicate inodes from file stat * generic/tclCmdAH.c: on windows (but now for cygwin as well). * generic/tclOODefineCmds.c: minor gcc warning * win/tclWinPort.h: Use lower numbers, preventing integer overflow. Remove the workaround for mingw-w64 [Bug 3407992]. It's long fixed. 2012-03-27 Donal K. Fellows IMPLEMENTATION OF TIP#397. * generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: Make the target object name optional when copying classes. [RFE 3485060]: Add callback method ("") so that scripted control over copying is easier. ***POTENTIAL INCOMPATIBILITY*** If you'd previously been using the "" method name, this now has a standard semantics and call interface. Only a problem if you are also using [oo::copy]. 2012-03-26 Donal K. Fellows IMPLEMENTATION OF TIP#380. * doc/define.n, doc/object.n, generic/tclOO.c, generic/tclOOBasic.c: * generic/tclOOCall.c, generic/tclOODefineCmds.c, generic/tclOOInt.h: * tests/oo.test: Switch definitions of lists of things in objects and classes to a slot-based approach, which gives a lot more flexibility and programmability at the script-level. Introduce new [::oo::Slot] class which is the implementation of these things. ***POTENTIAL INCOMPATIBILITY*** The unknown method handler now may be asked to deal with the case where no method name is provided at all. The default implementation generates a compatible error message, and any override that forces the presence of a first argument (i.e., a method name) will continue to function as at present as well, so this is a pretty small change. * generic/tclOOBasic.c (TclOO_Object_Destroy): Made it easier to do a tailcall inside a normally-invoked destructor; prevented leakage out to calling command. 2012-03-25 Jan Nijtmans * generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin * generic/tclIntPlatDecls.h: tclsh. Implement TclWinConvertError, * generic/tclStubInit.c: TclWinConvertWSAError, and various more * unix/Makefile.in: win32-specific internal functions for * unix/tcl.m4: Cygwin, so win32 extensions using those * unix/configure: can be loaded in the cygwin version of * win/tclWinError.c: tclsh. 2012-03-23 Jan Nijtmans * generic/tclInt.decls: Revert some cygwin-related signature * generic/tclIntPlatDecls.h: changes from [835f8e1e9d] (2010-01-22). * win/tclWinError.c: They were an attempt to make the cygwin port compile again, but since cygwin is based on unix this serves no purpose any more. * win/tclWinSerial.c: Use EAGAIN in stead of EWOULDBLOCK, * win/tclWinSock.c: because in VS10+ the value of EWOULDBLOCK is no longer the same as EAGAIN. * unix/Makefile.in: Add tclWinError.c to the CYGWIN build. * unix/tcl.m4: * unix/configure: 2012-03-20 Jan Nijtmans * generic/tcl.decls: [Bug 3508771]: load tclreg.dll in cygwin * generic/tclInt.decls: tclsh. Implement TclWinGetPlatformId, * generic/tclIntPlatDecls.h: Tcl_WinUtfToTChar, Tcl_WinTCharToUtf (and * generic/tclPlatDecls.h: a dummy TclWinCPUID) for Cygwin, so win32 * generic/tclStubInit.c: extensions using those can be loaded in * unix/tclUnixCompat.c: the cygwin version of tclsh. 2012-03-19 Venkat Iyer * library/tzdata/America/Atikokan: Update to tzdata2012b. * library/tzdata/America/Blanc-Sablon: * library/tzdata/America/Dawson_Creek: * library/tzdata/America/Edmonton: * library/tzdata/America/Glace_Bay: * library/tzdata/America/Goose_Bay: * library/tzdata/America/Halifax: * library/tzdata/America/Havana: * library/tzdata/America/Moncton: * library/tzdata/America/Montreal: * library/tzdata/America/Nipigon: * library/tzdata/America/Rainy_River: * library/tzdata/America/Regina: * library/tzdata/America/Santiago: * library/tzdata/America/St_Johns: * library/tzdata/America/Swift_Current: * library/tzdata/America/Toronto: * library/tzdata/America/Vancouver: * library/tzdata/America/Winnipeg: * library/tzdata/Antarctica/Casey: * library/tzdata/Antarctica/Davis: * library/tzdata/Antarctica/Palmer: * library/tzdata/Asia/Yerevan: * library/tzdata/Atlantic/Stanley: * library/tzdata/Pacific/Easter: * library/tzdata/Pacific/Fakaofo: * library/tzdata/America/Creston: (new) 2012-03-19 Reinhard Max * unix/tclUnixSock.c (Tcl_OpenTcpServer): Use the values returned by getaddrinfo() for all three arguments to socket() instead of only using ai_family. Try to keep the most meaningful error while iterating over the result list, because using the last error can be misleading. 2012-03-15 Jan Nijtmans * generic/tcl.h: [Bug 3288345]: Wrong Tcl_StatBuf used on Cygwin * unix/tclUnixFile.c: * unix/tclUnixPort.h: * win/cat.c: Remove cygwin stuff no longer needed * win/tclWinFile.c: * win/tclWinPort.h: 2012-03-12 Jan Nijtmans * win/tclWinFile.c: [Bug 3388350]: mingw64 compiler warnings 2012-03-11 Donal K. Fellows * doc/*.n, doc/*.3: A number of small spelling and wording fixes. 2012-03-08 Donal K. Fellows * doc/info.n: Various minor fixes (prompted by Andreas Kupries * doc/socket.n: detecting a spelling mistake). 2012-03-07 Andreas Kupries * library/http/http.tcl: [Bug 3498327]: Generate upper-case * library/http/pkgIndex.tcl: hexadecimal output for compliance * tests/http.test: with RFC 3986. Bumped version to 2.8.4. * unix/Makefile.in: * win/Makefile.in: 2012-03-06 Jan Nijtmans * win/tclWinPort.h: Compatibility with older Visual Studio versions. 2012-03-04 Jan Nijtmans * generic/tclLoad.c: Patch from the cygwin folks * unix/tcl.m4: * unix/configure: (re-generated) 2012-03-02 Donal K. Fellows * generic/tclBinary.c (Tcl_SetByteArrayObj): [Bug 3496014]: Only zero out the memory block if it is not being immediately overwritten. (Our caller might still overwrite, but we should at least avoid known-useless work.) 2012-02-29 Jan Nijtmans * generic/tclIOUtil.c: [Bug 3466099]: BOM in Unicode * generic/tclEncoding.c: * tests/source.test: 2012-02-23 Donal K. Fellows * tests/reg.test (14.21-23): Add tests relating to Bug 1115587. Actual bug is characterised by test marked with 'knownBug'. 2012-02-17 Jan Nijtmans * generic/tclIOUtil.c: [Bug 2233954]: AIX: compile error * unix/tclUnixPort.h: 2012-02-16 Donal K. Fellows * generic/tclExecute.c (INST_LIST_RANGE_IMM): Enhance implementation so that shortening a (not multiply-referenced) list by lopping the end off with [lrange] or [lreplace] is efficient. 2012-02-15 Donal K. Fellows * generic/tclCompCmds.c (TclCompileLreplaceCmd): Added a compilation strategy for [lreplace] that tackles the cases which are equivalent to a static [lrange]. (TclCompileLrangeCmd): Add compiler for [lrange] with constant indices so we can take advantage of existing TCL_LIST_RANGE_IMM opcode. (TclCompileLindexCmd): Improve coverage of constant-index-style compliation using technique developed for [lrange] above. (TclCompileDictForCmd): [Bug 3487626]: Fix crash in compilation of [dict for] when its implementation command is used directly rather than through the ensemble. 2012-02-09 Don Porter * generic/tclStringObj.c: Converted the memcpy() calls in append operations to memmove() calls. This adds safety in the case of overlapping copies, and improves performance on some benchmarks. 2012-02-06 Don Porter * generic/tclEnsemble.c: [Bug 3485022]: TclCompileEnsemble() avoid * tests/trace.test: compile when exec traces set. 2012-02-06 Miguel Sofer * generic/tclTrace.c: [Bug 3484621]: Ensure that execution traces on * tests/trace.test: bytecoded commands bump the interp's compile epoch. 2012-02-02 Jan Nijtmans * generic/tclUniData.c: [FRQ 3464401]: Support Unicode 6.1 * generic/regc_locale.c: 2012-02-02 Don Porter * win/tclWinFile.c: [Bugs 2974459,2879351,1951574,1852572, 1661378,1613456]: Revisions to the NativeAccess() routine that queries file permissions on Windows native filesystems. Meant to fix numerous bugs where [file writable|readable|executable] "lies" about what operations are possible, especially when the file resides on a Samba share. 2012-02-01 Donal K. Fellows * doc/AddErrInfo.3: [Bug 3482614]: Documentation nit. 2012-01-30 Donal K. Fellows * generic/tclCompCmds.c (TclCompileCatchCmd): Added a more efficient bytecode generator for the case where 'catch' is used without any variable arguments; don't capture the result just to discard it. 2012-01-26 Don Porter * generic/tclCmdAH.c: [Bug 3479689]: New internal routine * generic/tclFCmd.c: TclJoinPath(). Refactor all the * generic/tclFileName.c: *Join*Path* routines to give them more * generic/tclInt.h: useful interfaces that are easier to * generic/tclPathObj.c: manage getting the refcounts right. 2012-01-26 Don Porter * generic/tclPathObj.c: [Bug 3475569]: Add checks for unshared values before calls demanding them. [Bug 3479689]: Stop memory corruption when shimmering 0-refCount value to "path" type. 2012-01-25 Donal K. Fellows * generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: When copying an object, make sure that the configuration of the variable resolver is also duplicated. 2012-01-22 Jan Nijtmans * tools/uniClass.tcl: [FRQ 3473670]: Various Unicode-related * tools/uniParse.tcl: speedups/robustness. Enhanced tools to be * generic/tclUniData.c: able to handle characters > 0xFFFF. Done in * generic/tclUtf.c: all branches in order to simplify merges for * generic/regc_locale.c: new Unicode versions (such as 6.1) 2012-01-22 Donal K. Fellows * generic/tclDictObj.c (DictExistsCmd): [Bug 3475264]: Ensure that errors only ever happen when insufficient arguments are supplied, and not when a path doesn't exist or a dictionary is poorly formatted (the two cases can't be easily distinguished). 2012-01-21 Jan Nijtmans * generic/tcl.h: [Bug 3474726]: Eliminate detection of struct * generic/tclWinPort.h: _stat32i64, just use _stati64 in combination * generic/tclFCmd.c: with _USE_32BIT_TIME_T, which is the same * generic/tclTest.c: then. Only keep _stat32i64 usage for cygwin, * win/configure.in: so it will not conflict with cygwin's own * win/configure: struct stat. 2012-01-21 Don Porter * generic/tclCmdMZ.c: [Bug 3475667]: Prevent buffer read overflow. Thanks to "sebres" for the report and fix. 2012-01-17 Donal K. Fellows * doc/dict.n (dict with): [Bug 3474512]: Explain better what is going on when a dictionary key and the dictionary variable collide. 2012-01-13 Donal K. Fellows * library/http/http.tcl (http::Connect): [Bug 3472316]: Ensure that we only try to read the socket error exactly once. 2012-01-12 Donal K. Fellows * doc/tclvars.n: [Bug 3466506]: Document more environment variables. 2012-01-09 Jan Nijtmans * generic/tclUtf.c: [Bug 3464428]: [string is graph \u0120] was * generic/regc_locale.c: wrong. Add table for Unicode [:cntrl:] class. * tools/uniClass.tcl: Generate Unicode [:cntrl:] class table. * tests/utf.test: 2012-01-08 Kevin B. Kenny * library/clock.tcl (ReadZoneinfoFile): [Bug 3470928]: Corrected a bug * tests/clock.test (clock-56.4): where loading zoneinfo would fail if one timezone abbreviation was a proper tail of another, and zic used the same bytes of the file to represent both of them. Added a test case for the bug, using the same data that caused the observed failure "in the wild." 2011-12-30 Venkat Iyer * library/tzdata/America/Bahia: Update to Olson's tzdata2011n * library/tzdata/America/Havana: * library/tzdata/Europe/Kiev: * library/tzdata/Europe/Simferopol: * library/tzdata/Europe/Uzhgorod: * library/tzdata/Europe/Zaporozhye: * library/tzdata/Pacific/Fiji: 2011-12-23 Jan Nijtmans * generic/tclUtf.c: [Bug 3464428]: [string is graph \u0120] is wrong. * generic/tclUniData.c: * generic/regc_locale.c: * tests/utf.test: * tools/uniParse.tcl: Clean up some unused stuff, and be more robust against changes in UnicodeData.txt syntax 2011-12-13 Andreas Kupries * generic/tclCompile.c (TclInitAuxDataTypeTable): Extended to register the DictUpdateInfo structure as an AuxData type. For use by tbcload, tclcompiler. 2011-12-11 Jan Nijtmans * generic/regc_locale.c: [Bug 3457031]: Some Unicode 6.0 chars not * tests/utf.test: in [:print:] class 2011-12-07 Jan Nijtmans * tools/uniParse.tcl: [Bug 3444754]: string tolower \u01c5 is wrong * generic/tclUniData.c: * tests/utf.test: 2011-11-30 Jan Nijtmans * library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work when tclsh is compiled without using the setargv() function on mingw. 2011-11-29 Jan Nijtmans * win/Makefile.in: don't install tommath_(super)?class.h * unix/Makefile.in: don't install directories like 8.2 and 8.3 * generic/tclTomMath.h: [Bug 2991415]: move include tclInt.h from * generic/tclTomMathInt.h: tclTomMath.h to tclTomMathInt.h 2011-11-25 Donal K. Fellows * library/history.tcl (history): Simplify the dance of variable management used when chaining to the implementation command. 2011-11-22 Donal K. Fellows * generic/tclExecute.c (TclCompileObj): Simplify and de-indent the logic so that it is easier to comprehend. 2011-11-22 Jan Nijtmans * win/tclWinPort.h: [Bug 3354324]: Windows: [file mtime] sets wrong * win/tclWinFile.c: time (VS2005+ only). * generic/tclTest.c: 2011-11-20 Joe Mistachkin * tests/thread.test: Remove unnecessary [after] calls from the thread tests. Make error message matching more robust for tests that may have built-in race conditions. Test thread-7.26 must first unset all thread testing related variables. Revise results of the thread-7.28 through thread-7.31 tests to account for the fact they are canceled via a script sent to the thread asynchronously, which then impacts the error message handling. Attempt to manually drain the event queue for the main thread after joining the test thread to make sure no stray events are processed at the wrong time on the main thread. Revise all the synchronization and comparison semantics related to the thread id and error message. 2011-11-18 Joe Mistachkin * tests/thread.test: Remove all use of thread::release from the thread 7.x tests, replacing it with a script that can easily cause "stuck" threads to self-destruct for those test cases that require it. Also, make the error message handling far more robust by keeping track of every asynchronous error. 2011-11-17 Joe Mistachkin * tests/thread.test: Refactor all the remaining thread-7.x tests that were using [testthread]. Note that this test file now requires the very latest version of the Thread package to pass all tests. In addition, the thread-7.18 and thread-7.19 tests have been flagged as knownBug because they cannot pass without modifications to the [expr] command, persuant to TIP #392. 2011-11-17 Joe Mistachkin * generic/tclThreadTest.c: For [testthread cancel], avoid creating a new Tcl_Obj when the default script cancellation result is desired. 2011-11-11 Donal K. Fellows * win/tclWinConsole.c: Refactor common thread handling patterns. 2011-11-11 Alexandre Ferrieux * tests/zlib.test: [Bug 3428756]: Use nonblocking writes in single-threaded IO tests to avoid deadlocks when going beyond OS buffers. Tidy up [chan configure] flags across zlib.test. 2011-11-03 Donal K. Fellows * unix/tclUnixCompat.c (TclpGetPwNam, TclpGetPwUid, TclpGetGrNam) (TclpGetGrGid): Use the elaborate memory management scheme outlined on http://www.opengroup.org/austin/docs/austin_328.txt to handle Tcl's use of standard reentrant versions of the passwd/group access functions so that everything can work on all BSDs. Problem identified by Stuart Cassoff. 2011-10-20 Don Porter * library/http/http.tcl: Bump to version 2.8.3 * library/http/pkgIndex.tcl: * unix/Makefile.in: * win/Makefile.in: * changes: Updates toward 8.6b3 release. 2011-10-20 Donal K. Fellows * generic/tclLiteral.c (TclInvalidateCmdLiteral): [Bug 3418547]: Additional code for handling the invalidation of literals. * generic/tclBasic.c (Tcl_CreateObjCommand, Tcl_CreateCommand) (TclRenameCommand, Tcl_ExposeCommand): The four additional places that need extra care when dealing with literals. * generic/tclTest.c (TestInterpResolverCmd): Additional test machinery for interpreter resolvers. 2011-10-18 Reinhard Max * library/clock.tcl (::tcl::clock::GetSystemTimeZone): Cache the time zone only if it was detected by one of the expensive methods. Otherwise after unsetting TCL_TZ or TZ the previous value will still be used. 2011-10-15 Venkat Iyer * library/tzdata/America/Sitka: Update to Olson's tzdata2011l * library/tzdata/Pacific/Fiji: * library/tzdata/Asia/Hebron: (New) 2011-10-11 Jan Nijtmans * win/tclWinFile.c: [Bug 2935503]: Incorrect mode field returned by [file stat] command. 2011-10-09 Donal K. Fellows * generic/tclCompCmds.c (TclCompileDictWithCmd): Corrected handling of qualified names, and added spacial cases for empty bodies (used when [dict with] is just used for extracting variables). 2011-10-07 Jan Nijtmans * generic/tcl.h: Fix gcc warnings (discovered with latest * generic/tclIORChan.c: mingw, based on gcc 4.6.1) * tests/env.test: Fix env.test, when running under wine 1.3. 2011-10-06 Donal K. Fellows * generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish): * generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental compilation for the [dict with] subcommand, using parts factored out from the interpreted version of the command. 2011-10-05 Jan Nijtmans * win/tclWinInt.h: Remove tclWinProcs, as it is no longer * win/tclWin32Dll.c: being used. 2011-10-03 Venkat Iyer * library/tzdata/Africa/Dar_es_Salaam: Update to Olson's tzdata2011k * library/tzdata/Africa/Kampala: * library/tzdata/Africa/Nairobi: * library/tzdata/Asia/Gaza: * library/tzdata/Europe/Kaliningrad: * library/tzdata/Europe/Kiev: * library/tzdata/Europe/Minsk: * library/tzdata/Europe/Simferopol: * library/tzdata/Europe/Uzhgorod: * library/tzdata/Europe/Zaporozhye: * library/tzdata/Pacific/Apia: 2011-09-29 Donal K. Fellows * tools/tcltk-man2html.tcl, tools/tcltk-man2html-utils.tcl: More refactoring so that more of the utility code is decently out of the way. Adjusted the header-material generator so that version numbers are only included in locations where there is room. 2011-09-28 Jan Nijtmans * generic/tclOO.h: [RFE 3010352]: make all TclOO API functions * generic/tclOODecls.h: MODULE_SCOPE * generic/tclOOIntDecls.h: 2011-09-27 Donal K. Fellows * generic/tclIndexObj.c (Tcl_ParseArgsObjv): [Bug 3413857]: Corrected the memory management for the code parsing arguments when returning "large" numbers of arguments. Also unbroke the TCL_ARGV_AUTO_REST macro in passing. 2011-09-26 Donal K. Fellows * generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3211758]: Also make the main [file] command hidden by default in safe interpreters, because that's what existing code expects. This will reduce the amount which the code breaks, but not necessarily eliminate it... 2011-09-23 Don Porter * generic/tclIORTrans.c: More revisions to get finalization of ReflectedTransforms correct, including adopting a "dead" field as was done in tclIORChan.c. * tests/thread.test: Stop using the deprecated thread management commands of the tcltest package. The test suite ought to provide these tools for itself. They do not belong in a testing harness. 2011-09-22 Don Porter * generic/tclCmdIL.c: Revise [info frame] so that it stops creating cycles in the iPtr->cmdFramePtr stack. 2011-09-22 Donal K. Fellows * doc/re_syntax.n: [Bug 2903743]: Add more magic so that we can do at least something sane on Solaris. * tools/tcltk-man2html-utils.tcl (process-text): Teach the HTML generator how to handle this magic. 2011-09-21 Don Porter * generic/tclThreadTest.c: Revise the thread exit handling of the [testthread] command so that it properly maintains the per-process data structures even when the thread exits for reasons other than the [testthread exit] command. 2011-09-21 Alexandre Ferrieux * unix/tclIO.c: [Bug 3412487]: Now short reads are allowed in synchronous fcopy, avoid mistaking them as nonblocking ones. 2011-09-21 Andreas Kupries * generic/tclIORTrans.c (ForwardOpToOwnerThread): Fixed the missing initialization of the 'dsti' field. Reported by Don Porter, on chat. 2011-09-20 Don Porter * generic/tclIORChan.c: Re-using the "interp" field to signal a dead channel (via NULL value) interfered with conditional cleanup tasks testing for "the right interp". Added a new field "dead" to perform the dead channel signalling task so the corrupted logic is avoided. * generic/tclIORTrans.c: Revised ReflectClose() and FreeReflectedTransform() so that we stop leaking ReflectedTransforms, yet free all Tcl_Obj values in the same thread that alloced them. 2011-09-19 Don Porter * tests/ioTrans.test: Conversion from [testthread] to Thread package stops most memory leaks. * tests/thread.test: Plug most memory leaks in thread.test. Constrain the rest to be skipped during `make valgrind'. Tests using the [testthread cancel] testing command are leaky. Corrections wait for either addition of [thread::cancel] to the Thread package, or improvements to the [testthread] testing command to make leak-free versions of these tests possible. * generic/tclIORChan.c: Plug all memory leaks in ioCmd.test exposed * tests/ioCmd.test: by `make valgrind'. * unix/Makefile.in: 2011-09-16 Jan Nijtmans IMPLEMENTATION OF TIP #388 * doc/Tcl.n: * doc/re_syntax.n: * generic/regc_lex.c: * generic/regcomp.c: * generic/regcustom.h: * generic/tcl.h: * generic/tclParse.c: * tests/reg.test: * tests/utf.test: 2011-09-16 Donal K. Fellows * generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]: Corrected the handling of procedure error messages (found by TclOO). 2011-09-16 Jan Nijtmans * generic/tcl.h: Don't change Tcl_UniChar type when * generic/regcustom.h: TCL_UTF_MAX == 4 (not supported anyway) 2011-09-16 Donal K. Fellows * generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]: Ensemble-like rewriting of error messages is complex, and TclOO (in combination with iTcl) hits the most tricky cases. * library/http/http.tcl (http::geturl): [Bug 3391977]: Ensure that the -headers option overrides the -type option (important because -type has a default that is not always appropriate, and the header must not be duplicated). 2011-09-15 Don Porter * generic/tclCompExpr.c: [Bug 3408408]: Partial improvement by sharing as literals the computed values of constant subexpressions when we can do so without incurring the cost of string rep generation. 2011-09-13 Don Porter * generic/tclUtil.c: [Bug 3390638]: Workaround broken Solaris Studio cc optimizer. Thanks to Wolfgang S. Kechel. * generic/tclDTrace.d: [Bug 3405652]: Portability workaround for broken system DTrace support. Thanks to Dagobert Michelson. 2011-09-12 Jan Nijtmans * win/tclWinPort.h: [Bug 3407070]: tclPosixStr.c won't build with EOVERFLOW==E2BIG 2011-09-11 Don Porter * tests/thread.test: Convert [testthread] use to Thread package use in thread-6.1. Eliminates a memory leak in `make valgrind`. * tests/socket.test: [Bug 3390699]: Convert [testthread] use to Thread package use in socket_*-13.1. Eliminates a memory leak in `make valgrind`. 2011-09-09 Don Porter * tests/chanio.test: [Bug 3389733]: Convert [testthread] use to * tests/io.test: Thread package use in *io-70.1. Eliminates a memory leak in `make valgrind`. 2011-09-07 Don Porter * generic/tclCompExpr.c: [Bug 3401704]: Allow function names like * tests/parseExpr.test: influence(), nanobot(), and 99bottles() that have been parsed as missing operator syntax errors before with the form NUMBER + FUNCTION. ***POTENTIAL INCOMPATIBILITY*** 2011-09-06 Venkat Iyer * library/tzdata/America/Goose_Bay: Update to Olson's tzdata2011i * library/tzdata/America/Metlakatla: * library/tzdata/America/Resolute: * library/tzdata/America/St_Johns: * library/tzdata/Europe/Kaliningrad: * library/tzdata/Pacific/Apia: * library/tzdata/Pacific/Honolulu: * library/tzdata/Africa/Juba: (new) 2011-09-06 Jan Nijtmans * generic/tcl.h: [RFE 1711975]: Tcl_MainEx() (like Tk_MainEx()) * generic/tclDecls.h: * generic/tclMain.c: 2011-09-02 Don Porter * tests/http.test: Convert [testthread] use to Thread package use. Eliminates memory leak seen in `make valgrind`. 2011-09-01 Alexandre Ferrieux * unix/tclUnixSock.c: [Bug 3401422]: Cache script-level changes to the nonblocking flag of an async client socket in progress, and commit them on completion. 2011-09-01 Don Porter * generic/tclStrToD.c: [Bug 3402540]: Corrections to TclParseNumber() * tests/binary.test: to make it reject invalid Nan(Hex) strings. * tests/scan.test: [scan Inf %g] is portable; remove constraint. 2011-08-30 Donal K. Fellows * generic/tclInterp.c (SlaveCommandLimitCmd, SlaveTimeLimitCmd): [Bug 3398794]: Ensure that low-level conditions in the limit API are enforced at the script level through errors, not a Tcl_Panic. This means that interpreters cannot read their own limits (writing already did not work). 2011-08-30 Reinhard Max * unix/tclUnixSock.c (TcpWatchProc): [Bug 3394732]: Put back the check for server sockets. 2011-08-29 Don Porter * generic/tclIORTrans.c: Leak of ReflectedTransformMap. 2011-08-27 Don Porter * generic/tclStringObj.c: [RFE 3396731]: Revise the [string reverse] * tests/string.test: implementation to operate on the representation that comes in, avoid conversion to other reps. 2011-08-23 Don Porter * generic/tclIORChan.c: [Bug 3396948]: Leak of ReflectedChannelMap. 2011-08-19 Don Porter * generic/tclIORTrans.c: [Bugs 3393279, 3393280]: ReflectClose(.) is missing Tcl_EventuallyFree() calls at some of its exits. * generic/tclIO.c: [Bugs 3394654, 3393276]: Revise FlushChannel() to account for the possibility that the ChanWrite() call might recycle the buffer out from under us. * generic/tclIO.c: Preserve the chanPtr during FlushChannel so that channel drivers don't yank it away before we're done with it. 2011-08-19 Alexandre Ferrieux * generic/tclTest.c: [Bug 2981154]: async-4.3 segfault. * tests/async.test: [Bug 1774689]: async-4.3 sometimes fails. 2011-08-18 Alexandre Ferrieux * generic/tclIO.c: [Bug 3096275]: Sync fcopy buffers input. 2011-08-18 Jan Nijtmans * generic/tclUniData.c: [Bug 3393714]: Overflow in toupper delta * tools/uniParse.tcl: * tests/utf.test: 2011-08-17 Alexandre Ferrieux * generic/tclIO.c: [Bug 2946474]: Consistently resume backgrounded * tests/ioCmd.test: flushes+closes when exiting. 2011-08-17 Alexandre Ferrieux * doc/interp.n: Document TIP 378's one-way-ness. 2011-08-17 Don Porter * generic/tclGet.c: [Bug 3393150]: Overlooked free of intreps. (It matters for bignums!) 2011-08-16 Don Porter * generic/tclCompile.c: [Bug 3392070]: More complete prevention of Tcl_Obj reference cycles when producing an intrep of ByteCode. 2011-08-16 Donal K. Fellows * generic/tclListObj.c (TclLindexList, TclLsetFlat): Silence warnings about (unreachable) cases of uninitialized variables. * generic/tclCmdIL.c (SelectObjFromSublist): Improve the generation of * generic/tclIndexObj.c (Tcl_ParseArgsObjv): messages through the use * generic/tclVar.c (ArrayStartSearchCmd): of Tcl_ObjPrintf. 2011-08-15 Don Porter * generic/tclBasic.c: [Bug 3390272]: Leak of [info script] value. 2011-08-15 Jan Nijtmans * generic/tclPosixStr.c: [Bug 3388350]: mingw64 compiler warnings * win/tclWinPort.h: * win/configure.in: * win/configure: 2011-08-14 Jan Nijtmans * doc/FindExec.3: [Patch 3124554]: Move WishPanic from Tk to Tcl * doc/Panic.3 Added Documentation 2011-08-12 Don Porter * generic/tclPathObj.c: [Bug 3389764]: Eliminate possibility that dup of a "path" value can create reference cycle. 2011-08-12 Donal K. Fellows * generic/tclZlib.c (ZlibTransformOutput): [Bug 3390073]: Return the correct length of written data for a compressing transform. 2011-08-10 Alexandre Ferrieux * generic/tclTestObj.c: [Bug 3386721]: Allow multiple [load]ing of the Tcltest package. 2011-08-09 Alexandre Ferrieux * generic/tclBasic.c: [Bug 2919042]: Restore "valgrindability" of Tcl * generic/tclEvent.c: that was lost by the streamlining of [exit], by * generic/tclExecute.c: conditionally forcing a full Finalize: * generic/tclInt.h: use -DPURIFY or ::env(TCL_FINALIZE_ON_EXIT) 2011-08-09 Alexandre Ferrieux * generic/tclCompCmds.c: [Bug 3386417]: Avoid a reference loop between * generic/tclInt.h: the bytecode and its companion errostack * generic/tclResult.c: when compiling a syntax error. 2011-08-09 Jan Nijtmans * win/tclWinConsole.c: [Bug 3388350]: mingw64 compiler warnings * win/tclWinDde.c: * win/tclWinPipe.c: * win/tclWinSerial.c: 2011-08-09 Jan Nijtmans * generic/tclInt.h: Change the signature of TclParseHex(), such that * generic/tclParse.c: it can now parse up to 8 hex characters. 2011-08-08 Donal K. Fellows * generic/tclZlib.c (ZlibStreamCmd): Make the -buffersize option to '$zstream add' function correctly instead of having its value just be discarded unceremoniously. Also generate error codes from more of the code, not just the low-level code but also the Tcl infrastructure. 2011-08-07 Donal K. Fellows * generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory leak in call chain introspection. 2011-08-06 Kevin B, Kenny * generic/tclAssemnbly.c: [Bug 3384840]: Plug another memory leak. * generic/tclStrToD.c: [Bug 3386975]: Plug another memory leak. 2011-08-05 Kevin B. Kenny * generic/tclStrToD.c: [Bug 3386975]: Plugged a memory leak in double->string conversion. 2011-08-05 Don Porter *** 8.6b2 TAGGED FOR RELEASE *** * changes: Updates for 8.6b2 release. 2011-08-05 Donal K. Fellows * generic/tclAssembly.c (AssembleOneLine): Ensure that memory isn't leaked when an unknown instruction is encountered. Also simplify code through use of Tcl_ObjPrintf in error message generation. * generic/tclZlib.c (ZlibTransformClose): [Bug 3386197]: Plug a memory leak found by Miguel with valgrind, and ensure that the correct direction's buffers are released. 2011-08-04 Miguel Sofer * generic/tclVar.c (TclPtrSetVar): Fix valgrind-detected error when newValuePtr is the interp's result obj. 2011-08-04 Donal K. Fellows * generic/tclAssembly.c (FreeAssemblyEnv): [Bug 3384840]: Plug another possible memory leak due to over-complex code for freeing the table of labels. 2011-08-04 Reinhard Max * generic/tclIOSock.c (TclCreateSocketAddress): Don't bother using AI_ADDRCONFIG for now, as it was causing problems in various situations. 2011-08-04 Donal K. Fellows * generic/tclAssembly.c (AssembleOneLine, GetBooleanOperand) (GetIntegerOperand, GetListIndexOperand, FindLocalVar): [Bug 3384840]: A Tcl_Obj is allocated by GetNextOperand, so callers of it must not hold a reference to one in the 'out' parameter when calling it. This was causing a great many memory leaks. * tests/assemble.test (assemble-51.*): Added group of memory leak tests. 2011-08-02 Don Porter * changes: Updates for 8.6b2 release. * tools/tcltk-man2html.tcl: Variable substitution botch. 2011-08-02 Donal K. Fellows * generic/tclObj.c (Tcl_DbIncrRefCount, Tcl_DbDecrRefCount) (Tcl_DbIsShared): [Bug 3384007]: Fix the panic messages so they share what should be shared and have the right number of spaces. 2011-08-01 Miguel Sofer * generic/tclProc.c (TclProcCompileProc): [Bug 3383616]: Fix for leak of resolveInfo when recompiling procs. Thanks go to Gustaf Neumann for detecting the bug and providing the fix. 2011-08-01 Donal K. Fellows * doc/tclvars.n (EXAMPLES): Added some examples of how some of the standard global variables can be used, following prompting by a request by Robert Hicks. * tools/tcltk-man2html.tcl (plus-pkgs): [Bug 3382474]: Added code to determine the version number of contributed packages from their directory names so that HTML documentation builds are less confusing. 2011-07-29 Donal K. Fellows * tools/tcltk-man2html.tcl (ensemble_commands, remap_link_target): Small enhancements to improve cross-linking with contributed packages. * tools/tcltk-man2html-utils.tcl (insert-cross-references): Enhance to cope with contributed packages' C API. 2011-07-28 Reinhard Max * unix/tcl.m4 (SC_TCL_IPV6): Fix AC_DEFINE invocation for NEED_FAKE_RFC2553. * unix/configure: autoconf-2.59 2011-07-28 Don Porter * changes: Updates for 8.6b2 release. * library/tzdata/Asia/Anadyr: Update to Olson's tzdata2011h * library/tzdata/Asia/Irkutsk: * library/tzdata/Asia/Kamchatka: * library/tzdata/Asia/Krasnoyarsk: * library/tzdata/Asia/Magadan: * library/tzdata/Asia/Novokuznetsk: * library/tzdata/Asia/Novosibirsk: * library/tzdata/Asia/Omsk: * library/tzdata/Asia/Sakhalin: * library/tzdata/Asia/Vladivostok: * library/tzdata/Asia/Yakutsk: * library/tzdata/Asia/Yekaterinburg: * library/tzdata/Europe/Kaliningrad: * library/tzdata/Europe/Moscow: * library/tzdata/Europe/Samara: * library/tzdata/Europe/Volgograd: * library/tzdata/America/Kralendijk: (new) * library/tzdata/America/Lower_Princes: (new) 2011-07-26 Donal K. Fellows * generic/tclOO.c (initScript): Ensure that TclOO is properly found by all the various package mechanisms (by adding a dummy ifneeded script) and not just some of them. 2011-07-21 Jan Nijtmans * win/tclWinPort.h: [Bug 3372130]: Fix hypot math function with MSVC10 2011-07-19 Don Porter * generic/tclUtil.c: [Bug 3371644]: Repair failure to properly handle * tests/util.test: (length == -1) scanning in TclConvertElement(). Thanks to Thomas Sader and Alexandre Ferrieux. 2011-07-19 Donal K. Fellows * doc/*.3, doc/*.n: Many small fixes to documentation as part of project to improve quality of generated HTML docs. * tools/tcltk-man2html.tcl (remap_link_target): More complete set of definitions of link targets, especially for major C API types. * tools/tcltk-man2html-utils.tcl (output-IP-list, cross-reference): Update to generation to produce proper HTML bulleted and enumerated lists. 2011-07-19 Alexandre Ferrieux * doc/upvar.n: Undocument long gone limitation of [upvar]. 2011-07-18 Don Porter * generic/tcl.h: Bump version number to 8.6b2. * library/init.tcl: * unix/configure.in: * win/configure.in: * unix/tcl.spec: * tools/tcl.wse.in: * README: * unix/configure: autoconf-2.59 * win/configure: 2011-07-15 Don Porter * generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats() is called in a deleted interp. * generic/tclCompile.c: [Bug 467523, 3357771]: Prevent circular references in values with ByteCode intreps. They can lead to memory leaks. 2011-07-14 Donal K. Fellows * generic/tclOOCall.c (TclOORenderCallChain): [Bug 3365156]: Remove stray refcount bump that caused a memory leak. 2011-07-12 Don Porter * generic/tclUnixSock.c: [Bug 3364777]: Stop segfault caused by reading from struct after it had been freed. 2011-07-11 Joe Mistachkin * generic/tclExecute.c: [Bug 3339502]: Correct cast for CURR_DEPTH to silence compiler warning. 2011-07-08 Donal K. Fellows * doc/http.n: [FRQ 3358415]: State what RFC defines HTTP/1.1. 2011-07-07 Miguel Sofer * generic/tclBasic.c: Add missing INT2PTR 2011-07-03 Donal K. Fellows * doc/FileSystem.3: Corrected statements about ctime field of 'struct stat'; that was always the time of the last metadata change, not the time of creation. 2011-07-02 Kevin B. Kenny * generic/tclStrToD.c: * generic/tclTomMath.decls: * generic/tclTomMathDecls.h: * macosx/Tcl.xcode/project.pbxproj: * macosx/Tcl.xcodeproj/project.pbxproj: * tests/util.test: * unix/Makefile.in: * win/Makefile.in: * win/Makefile.vc: [Bug 3349507]: Fix a bug where bignum->double conversion is "round up" and not "round to nearest" (causing expr double(1[string repeat 0 23]) not to be 1e+23). 2011-06-28 Reinhard Max * unix/tclUnixSock.c (CreateClientSocket): [Bug 3325339]: Fix and simplify posting of the writable fileevent at the end of an asynchronous connection attempt. Improve comments for some of the trickery around [socket -async]. * tests/socket.test: Adjust tests to the async code changes. Add more tests for corner cases of async sockets. 2011-06-22 Andreas Kupries * library/platform/pkgIndex.tcl: Updated to platform 1.0.10. Added * library/platform/platform.tcl: handling of the DEB_HOST_MULTIARCH * unix/Makefile.in: location change for libc. * win/Makefile.in: * generic/tclInt.h: Fixed the inadvertently committed disabling of stack checks, see my 2010-11-15 commit. 2011-06-22 Reinhard Max Merge from rmax-ipv6-branch: * unix/tclUnixSock.c: Fix [socket -async], so that all addresses returned by getaddrinfo() are tried, not just the first one. This requires the event loop to be running while the async connection is in progress. ***POTENTIAL INCOMPATIBILITY*** * tests/socket.test: Add a test for the above. * doc/socket: Document the fact that -async needs the event loop * generic/tclIOSock.c: AI_ADDRCONFIG is broken on HP-UX 2011-06-21 Don Porter * generic/tclLink.c: [Bug 3317466]: Prevent multiple links to a single Tcl variable when calling Tcl_LinkVar(). 2011-06-13 Don Porter * generic/tclStrToD.c: [Bug 3315098]: Mem leak fix from Gustaf Neumann. 2011-06-08 Andreas Kupries * generic/tclExecute.c: Reverted the fix for [Bug 3274728] committed on 2011-04-06 and replaced with one which is 64bit-safe. The existing fix crashed tclsh on Windows 64bit. 2011-06-08 Donal K. Fellows * tests/fileSystem.test: Reduce the amount of use of duplication of complex code to perform common tests, and convert others to do the test result check directly using Tcltest's own primitives. 2011-06-06 Jan Nijtmans * tests/socket.test: Add test constraint, so 6.2 and 6.3 don't fail when the machine does not have support for ip6. Follow-up to checkin from 2011-05-11 by rmax. 2011-06-02 Don Porter * generic/tclBasic.c: Removed TclCleanupLiteralTable(), and old * generic/tclInt.h: band-aid routine put in place while a fix for * generic/tclLiteral.c: [Bug 994838] took shape. No longer needed. 2011-06-02 Donal K. Fellows * generic/tclInt.h (TclInvalidateNsCmdLookup): [Bug 3185407]: Extend the set of epochs that are potentially bumped when a command is created, for a slight performance drop (in some circumstances) and improved semantics. 2011-06-01 Miguel Sofer * generic/tclBasic.c: Using the two free data elements in NRCommand to store objc and objv - useful for debugging. 2011-06-01 Jan Nijtmans * generic/tclUtil.c: Fix for [Bug 3309871]: Valgrind finds: invalid read in TclMaxListLength(). 2011-05-31 Don Porter * generic/tclInt.h: Use a complete growth algorithm for lists so * generic/tclListObj.c: that length limits do not overconstrain by a * generic/tclStringObj.c: factor of 2. [Bug 3293874]: Fix includes * generic/tclUtil.c: rooting all growth routines by default on a common tunable parameter TCL_MIN_GROWTH. 2011-05-25 Don Porter * library/msgcat/msgcat.tcl: Bump to msgcat 1.4.4. * library/msgcat/pkgIndex.tcl: * unix/Makefile.in: * win/Makefile.in: 2011-05-25 Donal K. Fellows * generic/tclOO.h (TCLOO_VERSION): Bump version. IMPLEMENTATION OF TIP#381. * doc/next.n, doc/ooInfo.n, doc/self.n, generic/tclOO.c, * generic/tclOOBasic.c, generic/tclOOCall.c, generic/tclOOInfo.c, * generic/tclOOInt.h, tests/oo.test, tests/ooNext2.test: Added introspection of call chains ([self call], [info object call], [info class call]) and ability to skip ahead in chain ([nextto]). 2011-05-24 Venkat Iyer * library/tzdata/Africa/Cairo: Update to Olson tzdata2011g 2011-05-24 Donal K. Fellows * library/msgcat/msgcat.tcl (msgcat::mcset, msgcat::mcmset): Remove some useless code; [dict set] builds dictionary levels for us. 2011-05-17 Andreas Kupries * generic/tclCompile.c (TclFixupForwardJump): Tracked down and fixed * generic/tclBasic.c (TclArgumentBCEnter): the cause of a violation of my assertion that 'ePtr->nline == objc' in TclArgumentBCEnter. When a bytecode was grown during jump fixup the pc -> command line mapping was not updated. When things aligned just wrong the mapping would direct command A to the data for command B, with a different number of arguments. 2011-05-11 Reinhard Max * unix/tclUnixSock.c (TcpWatchProc): No need to check for server sockets here, as the generic server code already takes care of that. * tests/socket.test (accept): Add tests to make sure that this remains so. 2011-05-10 Don Porter * generic/tclInt.h: New internal routines TclScanElement() and * generic/tclUtil.c: TclConvertElement() are rewritten guts of machinery to produce string rep of lists. The new routines avoid and correct [Bug 3173086]. See comments for much more detail. * generic/tclDictObj.c: Update all callers. * generic/tclIndexObj.c: * generic/tclListObj.c: * generic/tclUtil.c: * tests/list.test: 2011-05-09 Donal K. Fellows * generic/tclNamesp.c (NamespacePathCmd): Convert to use Tcl_Obj API * generic/tclPkg.c (Tcl_PackageObjCmd): for result generation in * generic/tclTimer.c (Tcl_AfterObjCmd): [after info], [namespace path] and [package versions]. 2011-05-09 Don Porter * generic/tclListObj.c: Revise empty string tests so that we avoid potentially expensive string rep generations, especially for dicts. 2011-05-07 Donal K. Fellows * generic/tclLoad.c (TclGetLoadedPackages): Convert to use Tcl_Obj API for result generation. 2011-05-07 Miguel Sofer * generic/tclInt.h: Fix USE_TCLALLOC so that it can be enabled without * unix/Makefile.in: editing the Makefile. 2011-05-05 Don Porter * generic/tclListObj.c: Stop generating string rep of dict when converting to list. Tolerate NULL interps more completely. 2011-05-03 Don Porter * generic/tclUtil.c: Tighten Tcl_SplitList(). * generic/tclListObj.c: Tighten SetListFromAny(). * generic/tclDictObj.c: Tighten SetDictFromAny(). * tests/join.test: * tests/mathop.test: 2011-05-02 Don Porter * generic/tclCmdMZ.c: Revised TclFindElement() interface. The final * generic/tclDictObj.c: argument had been bracePtr, the address of a * generic/tclListObj.c: boolean var, where the caller can be told * generic/tclParse.c: whether or not the parsed list element was * generic/tclUtil.c: enclosed in braces. In practice, no callers really care about that. What the callers really want to know is whether the list element value exists as a literal substring of the string being parsed, or whether a call to TclCopyAndCollpase() is needed to produce the list element value. Now the final argument is changed to do what callers actually need. This is a better fit for the calls in tclParse.c, where now a good deal of post-processing checking for "naked backslashes" is no longer necessary. ***POTENTIAL INCOMPATIBILITY*** For any callers calling in via the internal stubs table who really do use the final argument explicitly to check for the enclosing brace scenario. Simply looking for the braces where they must be is the revision available to those callers, and it will backport cleanly. * tests/parse.test: Tests for expanded literals quoting detection. * generic/tclCompCmdsSZ.c: New TclFindElement() is also a better fit for the [switch] compiler. * generic/tclInt.h: Replace TclCountSpaceRuns() with * generic/tclListObj.c: TclMaxListLength() which is the function we * generic/tclUtil.c: actually want. * generic/tclCompCmdsSZ.c: * generic/tclCompCmdsSZ.c: Rewrite of parts of the switch compiler to better use the powers of TclFindElement() and do less parsing on its own. 2011-04-28 Don Porter * generic/tclInt.h: New utility routines: * generic/tclParse.c: TclIsSpaceProc() and TclCountSpaceRuns() * generic/tclUtil.c: * generic/tclCmdMZ.c: Use new routines to replace calls to isspace() * generic/tclListObj.c: and their /* INTL */ risk. * generic/tclStrToD.c: * generic/tclUtf.c: * unix/tclUnixFile.c: * generic/tclStringObj.c: Improved reaction to out of memory. 2011-04-27 Don Porter * generic/tclCmdMZ.c: TclFreeIntRep() correction & cleanup. * generic/tclExecute.c: * generic/tclIndexObj.c: * generic/tclInt.h: * generic/tclListObj.c: * generic/tclNamesp.c: * generic/tclResult.c: * generic/tclStringObj.c: * generic/tclVar.c: * generic/tclListObj.c: FreeListInternalRep() cleanup. 2011-04-21 Don Porter * generic/tclInt.h: Use macro to set List intreps. * generic/tclListObj.c: * generic/tclCmdIL.c: Limits on list length were too strict. * generic/tclInt.h: Revised panics to errors where possible. * generic/tclListObj.c: * tests/lrepeat.test: * generic/tclCompile.c: Make sure SetFooFromAny routines react * generic/tclIO.c: reasonably when passed a NULL interp. * generic/tclIndexObj.c: * generic/tclListObj.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclProc.c: * macosx/tclMacOSXFCmd.c: 2011-04-21 Jan Nijtmans * generic/tcl.h: fix for [Bug 3288345]: Wrong Tcl_StatBuf * generic/tclInt.h: used on MinGW. Make sure that all _WIN32 * win/tclWinFile.c: compilers use exactly the same layout * win/configure.in: for Tcl_StatBuf - the one used by MSVC6 - * win/configure: in all situations. 2011-04-19 Don Porter * generic/tclConfig.c: Reduce internals access in the implementation of [::pkgconfig list]. 2011-04-18 Don Porter * generic/tclCmdIL.c: Use ListRepPtr(.) and other cleanup. * generic/tclConfig.c: * generic/tclListObj.c: * generic/tclInt.h: Define and use macros that test whether a Tcl * generic/tclBasic.c: list value is canonical. * generic/tclUtil.c: 2011-04-18 Donal K. Fellows * doc/dict.n: [Bug 3288696]: Command summary was confusingly wrong when it came to [dict filter] with a 'value' filter. 2011-04-16 Donal K. Fellows * generic/tclFCmd.c (TclFileAttrsCmd): Add comments to make this code easier to understand. Added a panic to handle the case where the VFS layer does something odd. 2011-04-13 Don Porter * generic/tclUtil.c: [Bug 3285375]: Rewrite of Tcl_Concat*() routines to prevent segfaults on buffer overflow. Build them out of existing primitives already coded to handle overflow properly. Uses the new TclTrim*() routines. * generic/tclCmdMZ.c: New internal utility routines TclTrimLeft() * generic/tclInt.h: and TclTrimRight(). Refactor the * generic/tclUtil.c: [string trim*] implementations to use them. 2011-04-13 Miguel Sofer * generic/tclVar.c: [Bug 2662380]: Fix crash caused by appending to a variable with a write trace that unsets it. 2011-04-13 Donal K. Fellows * generic/tclUtil.c (Tcl_ConcatObj): [Bug 3285375]: Make the crash less mysterious through the judicious use of a panic. Not yet properly fixed, but at least now clearer what the failure mode is. 2011-04-12 Don Porter * tests/string.test: Test for [Bug 3285472]. Not buggy in trunk. 2011-04-12 Venkat Iyer * library/tzdata/Atlantic/Stanley: Update to Olson tzdata2011f 2011-04-12 Miguel Sofer * generic/tclBasic.c: Fix for [Bug 2440625], kbk's patch 2011-04-11 Miguel Sofer * generic/tclBasic.c: * tests/coroutine.test: [Bug 3282869]: Ensure that 'coroutine eval' runs the initial command in the proper context. 2011-04-11 Jan Nijtmans * generic/tcl.h: Fix for [Bug 3281728]: Tcl sources from 2011-04-06 * unix/tcl.m4: do not build on GCC9 (RH9) * unix/configure: 2011-04-08 Jan Nijtmans * win/tclWinPort.h: Fix for [Bug 3280043]: win2k: unresolved DLL * win/configure.in: imports. * win/configure 2011-04-06 Miguel Sofer * generic/tclExecute.c (TclCompileObj): Earlier return if Tip280 gymnastics not needed. * generic/tclExecute.c: Fix for [Bug 3274728]: making *catchTop an unsigned long. 2011-04-06 Jan Nijtmans * unix/tclAppInit.c: Make symbols "main" and "Tcl_AppInit" MODULE_SCOPE: there is absolutely no reason for exporting them. * unix/tcl.m4: Don't use -fvisibility=hidden with static * unix/configure libraries (--disable-shared) 2011-04-06 Donal K. Fellows * generic/tclFCmd.c, macosx/tclMacOSXFCmd.c, unix/tclUnixChan.c, * unix/tclUnixFCmd.c, win/tclWinChan.c, win/tclWinDde.c, * win/tclWinFCmd.c, win/tclWinLoad.c, win/tclWinPipe.c, * win/tclWinReg.c, win/tclWinSerial.c, win/tclWinSock.c: More generation of error codes (most platform-specific parts not already using Tcl_PosixError). 2011-04-05 Venkat Iyer * library/tzdata/Africa/Casablanca: Update to Olson's tzdata2011e * library/tzdata/America/Santiago: * library/tzdata/Pacific/Easter: * library/tzdata/America/Metlakatla: (new) * library/tzdata/America/North_Dakota/Beulah: (new) * library/tzdata/America/Sitka: (new) 2011-04-04 Donal K. Fellows * generic/tclOO.c, generic/tclOOBasic.c, generic/tclOODefineCmds.c * generic/tclOOInfo.c, generic/tclOOMethod.c: More generation of error codes (TclOO miscellany). * generic/tclCmdAH.c, generic/tclCmdIL.c: More generation of error codes (miscellaneous commands mostly already handled). 2011-04-04 Don Porter * README: [Bug 3202030]: Updated README files, repairing broken * macosx/README:URLs and removing other bits that were clearly wrong. * unix/README: Still could use more eyeballs on the detailed build * win/README: advice on various plaforms. 2011-04-04 Donal K. Fellows * library/init.tcl (tcl::mathfunc::rmmadwiw): Disable by default to make test suite work. * generic/tclBasic.c, generic/tclStringObj.c, generic/tclTimer.c, * generic/tclTrace.c, generic/tclUtil.c: More generation of error codes ([format], [after], [trace], RE optimizer). 2011-04-04 Jan Nijtmans * generic/tclCmdAH.c: Better error-message in case of errors * generic/tclCmdIL.c: related to setting a variable. This fixes * generic/tclDictObj.c: a warning: "Why make your own error * generic/tclScan.c: message? Why?" * generic/tclTest.c: * test/error.test: * test/info.test: * test/scan.test: * unix/tclUnixThrd.h: Remove this unused header file. 2011-04-03 Donal K. Fellows * generic/tclNamesp.c, generic/tclObj.c, generic/tclPathObj.c: * generic/tclPipe.c, generic/tclPkg.c, generic/tclProc.c: * generic/tclScan.c: More generation of error codes (namespace creation, path normalization, pipeline creation, package handling, procedures, [scan] formats) 2011-04-02 Kevin B. Kenny * generic/tclStrToD.c (QuickConversion): Replaced another couple of 'double' declarations with 'volatile double' to work around misrounding issues in mingw-gcc 3.4.5. 2011-04-02 Donal K. Fellows * generic/tclInterp.c, generic/tclListObj.c, generic/tclLoad.c: More generation of errorCodes ([interp], [lset], [load], [unload]). * generic/tclEvent.c, generic/tclFileName.c: More generation of errorCode information (default [bgerror] and [glob]). 2011-04-01 Reinhard Max * library/init.tcl: TIP#131 implementation. 2011-03-31 Donal K. Fellows * generic/tclGetDate.y, generic/tclDate.c (TclClockOldscanObjCmd): More generation of errorCode information. 2011-03-28 Donal K. Fellows * generic/tclCmdMZ.c, generic/tclConfig.c, generic/tclUtil.c: More generation of errorCode information, notably when lists are mis-parsed * generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): Use the error messages generated by the variable management code rather than creating our own. 2011-03-27 Miguel Sofer * generic/tclBasic.c (TclNREvalObjEx): fix performance issue, notably apparent in tclbench's "LIST lset foreach". Many thanks to Twylite for patiently researching the issue and explaining it to me: a missing Tcl_ResetObjResult that causes unwanted sharing of the current result Tcl_Obj. 2011-03-26 Donal K. Fellows * generic/tclNamesp.c (Tcl_Export, Tcl_Import, DoImport): More generation of errorCode information. * generic/tclCompExpr.c, generic/tclCompile.c, generic/tclExecute.c: * generic/tclListObj.c, generic/tclNamesp.c, generic/tclObj.c: * generic/tclStringObj.c, generic/tclUtil.c: Reduce the number of casts used to manage Tcl_Obj internal representations. 2011-03-24 Don Porter * generic/tcl.h (ckfree,etc.): Restored C++ usability to the memory allocation and free macros. 2011-03-24 Donal K. Fellows * generic/tclFCmd.c (TclFileAttrsCmd): Ensure that any reference to temporary index tables is squelched immediately rather than hanging around to trip us up in the future. 2011-03-23 Miguel Sofer * generic/tclObj.c: Exploit HAVE_FAST_TSD for the deletion context in TclFreeObj() 2011-03-22 Miguel Sofer * generic/tclThreadAlloc.c: Simpler initialization of Cache under HAVE_FAST_TSD, from mig-alloc-reform. 2011-03-21 Jan Nijtmans * unix/tclLoadDl.c: [Bug 3216070]: Loading extension libraries * unix/tclLoadDyld.c: from embedded Tcl applications. ***POTENTIAL INCOMPATIBILITY*** For extensions which rely on symbols from other extensions being present in the global symbol table. For an example and some discussion of workarounds, see http://stackoverflow.com/q/8330614/301832 2011-03-21 Miguel Sofer * generic/tclCkAlloc.c: * generic/tclInt.h: Remove one level of allocator indirection in non-memdebug builds, imported from mig-alloc-reform. 2011-03-20 Miguel Sofer * generic/tclThreadAlloc.c: Imported HAVE_FAST_TSD support from mig-alloc-reform. The feature has to be enabled by hand: no autoconf support has been added. It is not clear how universal a build using this will be: it also requires some loader support. 2011-03-17 Donal K. Fellows * generic/tclCompExpr.c (ParseExpr): Generate errorCode information on failure to parse expressions. 2011-03-17 Jan Nijtmans * generic/tclMain.c: [Patch 3124683]: Reorganize the platform-specific stuff in (tcl|tk)Main.c. 2011-03-16 Jan Nijtmans * generic/tclCkalloc.c: [Bug 3197864]: Pointer truncation on Win64 TCL_MEM_DEBUG builds. 2011-03-16 Don Porter * generic/tclBasic.c: Some rewrites to eliminate calls to isspace() * generic/tclParse.c: and their /* INTL */ risk. * generic/tclProc.c: 2011-03-16 Jan Nijtmans * unix/tcl.m4: Make SHLIB_LD_LIBS='${LIBS}' the default and * unix/configure: set to "" on per-platform necessary basis. Backported from TEA, but kept all original platform code which was removed from TEA. 2011-03-14 Kevin B. Kenny * tools/tclZIC.tcl (onDayOfMonth): Allow for leading zeroes in month and day so that tzdata2011d parses correctly. * library/tzdata/America/Havana: * library/tzdata/America/Juneau: * library/tzdata/America/Santiago: * library/tzdata/Europe/Istanbul: * library/tzdata/Pacific/Apia: * library/tzdata/Pacific/Easter: * library/tzdata/Pacific/Honolulu: tzdata2011d * generic/tclAssembly.c (BBEmitInstInt1): Changed parameter data types in an effort to silence a MSVC warning reported by Ashok P. Nadkarni. Unable to test, since both forms work on my machine in VC2005, 2008, 2010, in both release and debug builds. * tests/tclTest.c (TestdstringCmd): Restored MSVC buildability broken by [5574bdd262], which changed the effective return type of 'ckalloc' from 'char*' to 'void*'. 2011-03-13 Miguel Sofer * generic/tclExecute.c: remove TEBCreturn() 2011-03-12 Donal K. Fellows * generic/tcl.h (ckalloc,ckfree,ckrealloc): Moved casts into these macro so that they work with VOID* (which is a void* on all platforms which Tcl actually builds on) and unsigned int for the length parameters, removing the need for MANY casts across the rest of Tcl. Note that this is a strict source-level-only change, so size_t cannot be used (would break binary compatibility on 64-bit platforms). 2011-03-12 Jan Nijtmans * win/tclWinFile.c: [Bug 3185609]: File normalization corner case of ... broken with -DUNICODE 2011-03-11 Donal K. Fellows * tests/unixInit.test: Make better use of tcltest2. 2011-03-10 Donal K. Fellows * generic/tclBasic.c, generic/tclCompCmds.c, generic/tclEnsemble.c: * generic/tclInt.h, generic/tclNamesp.c, library/auto.tcl: * tests/interp.test, tests/namespace.test, tests/nre.test: Converted the [namespace] command into an ensemble. This has the consequence of making it vital for Tcl code that wishes to work with namespaces to _not_ delete the ::tcl namespace. ***POTENTIAL INCOMPATIBILITY*** * library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter): Added this command to handle connecting tcltest to a slave interpreter. This adds in the hook (inside the tcltest namespace) that allows the tests run in the child interpreter to be reported as part of the main sequence of test results. Bumped version of tcltest to 2.3.3. * tests/init.test, tests/package.test: Adapted these test files to use the new feature. * generic/tclAlloc.c, generic/tclCmdMZ.c, generic/tclCompExpr.c: * generic/tclCompile.c, generic/tclEnv.c, generic/tclEvent.c: * generic/tclIO.c, generic/tclIOCmd.c, generic/tclIORChan.c: * generic/tclIORTrans.c, generic/tclLiteral.c, generic/tclNotify.c: * generic/tclParse.c, generic/tclStringObj.c, generic/tclUtil.c: * generic/tclZlib.c, unix/tclUnixFCmd.c, unix/tclUnixNotfy.c: * unix/tclUnixPort.h, unix/tclXtNotify.c: Formatting fixes, mainly to comments, so code better fits the style in the Engineering Manual. 2011-03-09 Donal K. Fellows * tests/incr.test: Update more of the test suite to use Tcltest 2. 2011-03-09 Don Porter * generic/tclNamesp.c: [Bug 3202171]: Tighten the detector of nested * tests/namespace.test: [namespace code] quoting that the quoted scripts function properly even in a namespace that contains a custom "namespace" command. * doc/tclvars.n: Formatting fix. Thanks to Pat Thotys. 2011-03-09 Donal K. Fellows * tests/dstring.test, tests/init.test, tests/link.test: Update more of the test suite to use Tcltest 2. 2011-03-08 Jan Nijtmans * generic/tclBasic.c: Fix gcc warnings: variable set but not used * generic/tclProc.c: * generic/tclIORChan.c: * generic/tclIORTrans.c: * generic/tclAssembly.c: Fix gcc warning: comparison between signed and unsigned integer expressions 2011-03-08 Don Porter * generic/tclInt.h: Remove TclMarkList() routine, an experimental * generic/tclUtil.c: dead-end from the 8.5 alpha days. * generic/tclResult.c (ResetObjResult): [Bug 3202905]: Correct failure to clear invalid intrep. Thanks to Colin McDonald. 2011-03-08 Donal K. Fellows * generic/tclAssembly.c, tests/assemble.test: Migrate to use a style more consistent with the rest of Tcl. 2011-03-06 Don Porter * generic/tclBasic.c: More replacements of Tcl_UtfBackslash() calls * generic/tclCompile.c: with TclParseBackslash() where possible. * generic/tclCompCmdsSZ.c: * generic/tclParse.c: * generic/tclUtil.c: * generic/tclUtil.c (TclFindElement): [Bug 3192636]: Guard escape sequence scans to not overrun the string end. 2011-03-05 Don Porter * generic/tclParse.c (TclParseBackslash): [Bug 3200987]: Correct * tests/parse.test: trunction checks in \x and \u substitutions. 2011-03-05 Miguel Sofer * generic/tclExecute.c (TclStackFree): insure that the execStack satisfies "at most one free stack after the current one" when consecutive reallocs caused the creation of intervening stacks. 2011-03-05 Kevin B. Kenny * generic/tclAssembly.c (new file): * generic/tclBasic.c (Tcl_CreateInterp): * generic/tclInt.h: * tests/assemble.test (new file): * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: Merged dogeen-assembler-branch into HEAD. Since all functional changes are in the tcl::unsupported namespace, there's no reason to sequester this code on a separate branch. 2011-03-05 Miguel Sofer * generic/tclExecute.c: Cleaner mem management for TEBCdata * generic/tclExecute.c: * tests/nre.test: Renamed BottomData to TEBCdata, so that the name refers to what it is rather than to its storage location. * generic/tclBasic.c: Renamed struct TEOV_callback to the more * generic/tclCompExpr.c: descriptive NRE_callback. * generic/tclCompile.c: * generic/tclExecute.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclTest.c: 2011-03-04 Donal K. Fellows * generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect) (ProcedureMethodCompiledVarDelete): [Bug 3185009]: Keep references to resolved object variables so that an unset doesn't leave any dangling pointers for code to trip over. 2011-03-01 Miguel Sofer * generic/tclBasic.c (TclNREvalObjv): Missing a variable declaration in commented out non-optimised code, left for ref in checkin [b97b771b6d] 2011-03-03 Don Porter * generic/tclResult.c (Tcl_AppendResultVA): Use the directive USE_INTERP_RESULT [TIP 330] to force compat with interp->result access, instead of the improvised hack USE_DIRECT_INTERP_RESULT_ACCESS from releases past. 2011-03-01 Miguel Sofer * generic/tclCompCmdsSZ.c (TclCompileThrowCmd, TclCompileUnsetCmd): fix leaks * generic/tclBasic.c: This is [Patch 3168398], * generic/tclCompCmdsSZ.c: Joe Mistachkin's optimisation * generic/tclExecute.c: of Tip #285 * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclInterp.c: * generic/tclOODecls.h: * generic/tclStubInit.c: * win/makefile.vc: * generic/tclExecute.c (ExprObjCallback): Fix object leak * generic/tclExecute.c (TEBCresume): Store local var array and constants in automatic vars to reduce indirection, slight perf increase * generic/tclOOCall.c (TclOODeleteContext): Added missing '*' so that trunk compiles. * generic/tclBasic.c (TclNRRunCallbacks): [Patch 3168229]: Don't do the trampoline dance for commands that do not have an nreProc. 2011-03-01 Donal K. Fellows * generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance) (TclOOObjectCmdCore, FinalizeObjectCall): * generic/tclOOBasic.c (TclOO_Object_Destroy, AfterNRDestructor): * generic/tclOOCall.c (TclOODeleteContext, TclOOGetCallContext): Reorganization of call context reference count management so that code is (mostly) simpler. 2011-01-26 Donal K. Fellows * doc/RegExp.3: [Bug 3165108]: Corrected documentation of description of subexpression info in Tcl_RegExpInfo structure. 2011-01-25 Jan Nijtmans * generic/tclPreserve.c: Don't miss 64-bit address bits in panic message. * win/tclWinChan.c: Fix various gcc-4.5.2 64-bit warning * win/tclWinConsole.c: messages, e.g. by using full 64-bits for * win/tclWinDde.c: socket fd's * win/tclWinPipe.c: * win/tclWinReg.c: * win/tclWinSerial.c: * win/tclWinSock.c: * win/tclWinThrd.c: 2011-01-19 Jan Nijtmans * tools/genStubs.tcl: [FRQ 3159920]: Tcl_ObjPrintf() crashes with * generic/tcl.decls bad format specifier. * generic/tcl.h: * generic/tclDecls.h: 2011-01-18 Donal K. Fellows * generic/tclOOMethod.c (PushMethodCallFrame): [Bug 3001438]: Make sure that the cmdPtr field of the procPtr is correct and relevant at all times so that [info frame] can report sensible information about a frame after a return to it from a recursive call, instead of probably crashing (depending on what else has overwritten the Tcl stack!) 2011-01-18 Jan Nijtmans * generic/tclBasic.c: Various mismatches between Tcl_Panic * generic/tclCompCmds.c: format string and its arguments, * generic/tclCompCmdsSZ.c: discovered thanks to [Bug 3159920] * generic/tclCompExpr.c: * generic/tclEnsemble.c: * generic/tclPreserve.c: * generic/tclTest.c: 2011-01-17 Jan Nijtmans * generic/tclIOCmd.c: [Bug 3148192]: Commands "read/puts" incorrectly * tests/chanio.test: interpret parameters. Improved error-message * tests/io.test regarding legacy form. * tests/ioCmd.test 2011-01-15 Kevin B. Kenny * doc/tclvars.n: * generic/tclStrToD.c: * generic/tclUtil.c (Tcl_PrintDouble): * tests/util.test (util-16.*): [Bug 3157475]: Restored full Tcl 8.4 compatibility for the formatting of floating point numbers when $::tcl_precision is not zero. Added compatibility tests to make sure that excess trailing zeroes are suppressed for all eight major code paths. 2011-01-12 Jan Nijtmans * win/tclWinFile.c: Use _vsnprintf in stead of vsnprintf, because MSVC 6 doesn't have it. Reported by andreask. * win/tcl.m4: handle --enable-64bit=ia64 for gcc * win/configure.in: more accurate test for correct * win/configure: (autoconf-2.59) * win/tclWin32Dll.c: VS 2005 64-bit does not have intrin.h, and * generic/tclPanic.c: does not need it. 2011-01-07 Kevin B. Kenny * tests/util.test (util-15.*): Added test cases for floating point conversion of the largest denormal and the smallest normal number, to avoid any possibility of the failure suffered by PHP in the last couple of days. (They didn't fail, so no actual functional change.) 2011-01-05 Donal K. Fellows * tests/package.test, tests/pkg.test: Coalesce these tests into one file that is concerned with the package system. Convert to use tcltest2 properly. * tests/autoMkindex.test, tests/pkgMkIndex.test: Convert to use tcltest2 properly. 2011-01-01 Donal K. Fellows * tests/cmdAH.test, tests/cmdMZ.test, tests/compExpr.test, * tests/compile.test, tests/concat.test, tests/eval.test, * tests/fileName.test, tests/fileSystem.test, tests/interp.test, * tests/lsearch.test, tests/namespace-old.test, tests/namespace.test, * tests/oo.test, tests/proc.test, tests/security.test, * tests/switch.test, tests/unixInit.test, tests/var.test, * tests/winDde.test, tests/winPipe.test: Clean up of tests and conversion to tcltest 2. Target has been to get init and cleanup code out of the test body and into the -setup/-cleanup stanzas. * tests/execute.test (execute-11.1): [Bug 3142026]: Added test that fails (with a crash) in an unfixed memdebug build on 64-bit systems. 2010-12-31 Donal K. Fellows * generic/tclCmdIL.c (SortElement): Use unions properly in the definition of this structure so that there is no need to use nasty int/pointer type punning. Made it clearer what the purposes of the various parts of the structure are. 2010-12-31 Jan Nijtmans * unix/dltest/*.c: [Bug 3148192]: Fix broken [load] tests by ensuring that the affected files are never compiled with -DSTATIC_BUILD. 2010-12-30 Miguel Sofer * generic/tclExecute.c (GrowEvaluationStack): Off-by-one error in sizing the new allocation - was ok in comment but wrong in the code. Triggered by [Bug 3142026] which happened to require exactly one more than what was in existence. 2010-12-26 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix crash when multiple -index options are used. Simplified memory handling logic. 2010-12-20 Jan Nijtmans * win/tclWin32Dll.c: [Patch 3059922]: fixes for mingw64 - gcc4.5.1 tdm64-1: completed for all environments. 2010-12-20 Jan Nijtmans * win/configure.in: Explicitely test for intrinsics support in compiler, before assuming only MSVC has it. * win/configure: (autoconf-2.59) * generic/tclPanic.c: 2010-12-19 Jan Nijtmans * win/tclWin32Dll.c: [Patch 3059922]: fixes for mingw64 - gcc4.5.1 tdm64-1: Fixed for gcc, not yet for MSVC 64-bit. 2010-12-17 Stuart Cassoff * unix/Makefile.in: Remove unwanted/obsolete 'ddd' target. 2010-12-17 Stuart Cassoff * unix/Makefile.in: Clean up '.PHONY:' targets: Arrange those common to Tcl and Tk as in Tk's Makefile.in, add any missing ones and remove duplicates. 2010-12-17 Stuart Cassoff * unix/Makefile.in: [Bug 2446711]: Remove 'allpatch' target. 2010-12-17 Stuart Cassoff * unix/Makefile.in: [Bug 2537626]: Use 'rpmbuild', not 'rpm'. 2010-12-16 Jan Nijtmans * generic/tclPanic.c: [Patch 3124554]: Move WishPanic from Tk to Tcl * win/tclWinFile.c: Better communication with debugger, if present. 2010-12-15 Kevin B. Kenny [dogeen-assembler-branch] * tclAssembly.c: * assemble.test: Reworked beginCatch/endCatch handling to enforce the more severe (but more correct) restrictions on catch handling that appeared in the discussion of [Bug 3098302] and in tcl-core traffic beginning about 2010-10-29. 2010-12-15 Jan Nijtmans * generic/tclPanic.c: Restore abort() as it was before. * win/tclWinFile.c: [Patch 3124554]: Use ExitProcess() here, like in wish. 2010-12-14 Jan Nijtmans * generic/tcl.h: [Bug 3137454]: Tcl CVS HEAD does not build on GCC 3. 2010-12-14 Reinhard Max * win/tclWinSock.c (CreateSocket): Swap the loops over * unix/tclUnixSock.c (CreateClientSocket): local and remote addresses, so that the system's address preference for the remote side decides which family gets tried first. Cleanup and clarify some of the comments. 2010-12-13 Jan Nijtmans * generic/tcl.h: [Bug 3135271]: Link error due to hidden * unix/tcl.m4: symbols (CentOS 4.2) * unix/configure: (autoconf-2.59) * win/tclWinFile.c: Undocumented feature, only meant to be used by Tk_Main. See [Patch 3124554]: Move WishPanic from Tk to Tcl 2010-12-12 Stuart Cassoff * unix/tcl.m4: Better building on OpenBSD. * unix/configure: (autoconf-2.59) 2010-12-10 Jan Nijtmans * generic/tcl.h: [Bug 3129448]: Possible over-allocation on * generic/tclCkalloc.c: 64-bit platforms, part 2 * generic/tclCompile.c: * generic/tclHash.c: * generic/tclInt.h: * generic/tclIO.h: * generic/tclProc.c: 2010-12-10 Alexandre Ferrieux * generic/tclIO.c: Make sure [fcopy -size ... -command ...] always * tests/io.test: calls the callback asynchronously, even for size zero. 2010-12-10 Jan Nijtmans * generic/tclBinary.c: Fix gcc -Wextra warning: missing initializer * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclDictObj.c: * generic/tclIndexObj.c: * generic/tclIOCmd.c: * generic/tclVar.c: * win/tcl.m4: Fix manifest-generation for 64-bit gcc (mingw-w64) * win/configure.in: Check for availability of intptr_t and uintptr_t * win/configure: (autoconf-2.59) * generic/tclInt.decls: Change 1st param of TclSockMinimumBuffers * generic/tclIntDecls.h: to ClientData, and TclWin(Get|Set)SockOpt * generic/tclIntPlatDecls.h:to SOCKET, because on Win64 those are * generic/tclIOSock.c: 64-bit, which does not fit. * win/tclWinSock.c: * unix/tclUnixSock.c: 2010-12-09 Donal K. Fellows * tests/fCmd.test: Improve sanity of constraints now that we don't support anything before Windows 2000. * generic/tclCmdAH.c (TclInitFileCmd, TclMakeFileCommandSafe, ...): Break up [file] into an ensemble. Note that the ensemble is safe in itself, but the majority of its subcommands are not. * generic/tclFCmd.c (FileCopyRename,TclFileDeleteCmd,TclFileAttrsCmd) (TclFileMakeDirsCmd): Adjust these subcommand implementations to work inside an ensemble. (TclFileLinkCmd, TclFileReadLinkCmd, TclFileTemporaryCmd): Move these subcommand implementations from tclCmdAH.c, where they didn't really belong. * generic/tclIOCmd.c (TclChannelNamesCmd): Move to more appropriate source file. * generic/tclEnsemble.c (TclMakeEnsemble): Start of code to make partially-safe ensembles. Currently does not function as expected due to various shortcomings in how safe interpreters are constructed. * tests/cmdAH.test, tests/fCmd.test, tests/interp.test: Test updates to take into account systematization of error messages. * tests/append.test, tests/appendComp.test: Clean up tests so that they don't leave things in the global environment (detected when doing -singleproc testing). 2010-12-07 Donal K. Fellows * tests/fCmd.test, tests/safe.test, tests/uplevel.test, * tests/upvar.test, tests/var.test: Convert more tests to tcltest2 and factor them to be easier to understand. * generic/tclStrToD.c: Tidy up code so that more #ifdef-fery is quarantined at the front of the file and function headers follow the modern Tcl style. 2010-12-06 Jan Nijtmans * generic/tclBinary.c: [Bug 3129448]: Possible over-allocation on * generic/tclCkalloc.c: 64-bit platforms. * generic/tclTrace.c: 2010-12-05 Jan Nijtmans * unix/tcl.m4: [Patch 3116490]: Cross-compile support for unix * unix/configure: (autoconf-2.59) 2010-12-03 Jeff Hobbs * generic/tclUtil.c (TclReToGlob): Add extra check for multiple inner *s that leads to poor recursive glob matching, defer to original RE instead. tclbench RE var backtrack. 2010-12-03 Jan Nijtmans * generic/tclUtil.c: Silence gcc warning when using -Wwrite-strings * generic/tclStrToD.c: Silence gcc warning for non-IEEE platforms * win/Makefile.in: [Patch 3116490]: Cross-compile Tcl mingw32 on unix * win/tcl.m4: This makes it possible to cross-compile Tcl/Tk for * win/configure.in: Windows (either 32-bit or 64-bit) out-of-the-box * win/configure: on UNIX, using mingw-w64 build tools (If Itcl, tdbc and Thread take over the latest tcl.m4, they can do that too). 2010-12-01 Kevin B. Kenny * generic/tclStrToD.c (SetPrecisionLimits, TclDoubleDigits): [Bug 3124675]: Added meaningless initialization of 'i', 'ilim' and 'ilim1' to silence warnings from the C compiler about possible use of uninitialized variables, Added a panic to the 'switch' that assigns them, to assert that the 'default' case is impossible. 2010-12-01 Jan Nijtmans * generic/tclBasic.c: Fix gcc 64-bit warnings: cast from pointer to * generic/tclHash.c: integer of different size. * generic/tclTest.c: * generic/tclThreadTest.c: * generic/tclStrToD.c: Fix gcc(-4.5.2) warning: 'static' is not at beginning of declaration. * generic/tclPanic.c: Allow Tcl_Panic() to enter the debugger on win32 * generic/tclCkalloc.c: Use Tcl_Panic() in stead of duplicating the code. 2010-11-30 Jeff Hobbs * generic/tclInt.decls, generic/tclInt.h, generic/tclIntDecls.h: * generic/tclStubInit.c: TclFormatInt restored at slot 24 * generic/tclUtil.c (TclFormatInt): restore TclFormatInt func from 2005-07-05 macro-ization. Benchmarks indicate it is faster, as a key int->string routine (e.g. int-indexed arrays). 2010-11-29 Alexandre Ferrieux * generic/tclBasic.c: Patch by Miguel, providing a [::tcl::unsupported::inject coroname command args], which prepends ("injects") arbitrary code to a suspended coro's future resumption. Neat for debugging complex coros without heavy instrumentation. 2010-11-29 Kevin B. Kenny * generic/tclInt.decls: * generic/tclInt.h: * generic/tclStrToD.c: * generic/tclTest.c: * generic/tclTomMath.decls: * generic/tclUtil.c: * tests/util.test: * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: Rewrite of Tcl_PrintDouble and TclDoubleDigits that (a) fixes a severe performance problem with floating point shimmering reported by Karl Lehenbauer, (b) allows TclDoubleDigits to generate the digit strings for 'e' and 'f' format, so that it can be used for tcl_precision != 0 (and possibly later for [format]), (c) fixes [Bug 3120139] by making TclPrintDouble inherently locale-independent, (d) adds test cases to util.test for correct rounding in difficult cases of TclDoubleDigits where fixed- precision results are requested. (e) adds test cases to util.test for the controversial aspects of [Bug 3105247]. As a side effect, two more modules from libtommath (bn_mp_set_int.c and bn_mp_init_set_int.c) are brought into the build, since the new code uses them. * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclTomMathDecls.h: Regenerated. 2010-11-24 Donal K. Fellows * tests/chanio.test, tests/iogt.test, tests/ioTrans.test: Convert more tests to tcltest2 and factor them to be easier to understand. 2010-11-20 Donal K. Fellows * tests/chanio.test: Converted many tests to tcltest2 by marking the setup and cleanup parts as such. 2010-11-19 Jan Nijtmans * win/tclWin32Dll.c: Fix gcc warnings: unused variable 'registration' * win/tclWinChan.c: * win/tclWinFCmd.c: 2010-11-18 Jan Nijtmans * win/tclAppInit.c: [FRQ 491789]: "setargv() doesn't support a unicode cmdline" now implemented for cygwin and mingw32 too. * tests/main.test: No longer disable tests Tcl_Main-1.4 and 1.6 on Windows, because those now work on all supported platforms. * win/configure.in: Set NO_VIZ=1 when zlib is compiled in libtcl, this resolves compiler warnings in 64-bit and static builds. * win/configure (regenerated) 2010-11-18 Donal K. Fellows * doc/file.n: [Bug 3111298]: Typofix. * tests/oo.test: [Bug 3111059]: Added testing that neatly trapped this issue. 2010-11-18 Miguel Sofer * generic/tclNamesp.c: [Bug 3111059]: Fix leak due to bad looping construct. 2010-11-17 Jan Nijtmans * win/tcl.m4: [FRQ 491789]: "setargv() doesn't support a unicode cmdline" now implemented for mingw-w64 * win/configure (re-generated) 2010-11-16 Jan Nijtmans * win/tclAppInit.c:Bring compilation under mingw-w64 a bit closer * win/cat.c: to reality. See for what's missing: * win/tcl.m4: * win/configure: (re-generated) * win/tclWinPort.h: [Bug 3110161]: Extensions using TCHAR don't compile on VS2005 SP1 2010-11-15 Andreas Kupries * doc/interp.n: [Bug 3081184]: TIP #378. * doc/tclvars.n: Performance fix for TIP #280. * generic/tclBasic.c: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclInterp.c: * tests/info.test: * tests/interp.test: 2010-11-10 Andreas Kupries * changes: Updates for 8.6b2 release. 2010-11-09 Donal K. Fellows * generic/tclOOMethod.c (ProcedureMethodVarResolver): [Bug 3105999]: * tests/oo.test: Make sure that resolver structures that are only temporarily needed get squelched. 2010-11-05 Jan Nijtmans * generic/tclMain.c: Thanks, Kevin, for the fix, but this how it was supposed to be (TCL_ASCII_MAIN is only supposed to be defined on WIN32). 2010-11-05 Kevin B. Kenny * generic/tclMain.c: Added missing conditional on _WIN32 around code that messes around with the definition of _UNICODE, to correct a badly broken Unix build from Jan's last commit. 2010-11-04 Jan Nijtmans * generic/tclDecls.h: [FRQ 491789]: "setargv() doesn't support a * generic/tclMain.c: unicode cmdline" implemented for Tcl on MSVC++ * doc/Tcl_Main.3: * win/tclAppInit.c: * win/makefile.vc: * win/Makefile.in: * win/tclWin32Dll.c: Eliminate minor MSVC warning TCHAR -> char conversion 2010-11-04 Reinhard Max * tests/socket.test: Run the socket tests three times with the address family set to any, inet, and inet6 respectively. Use constraints to skip the tests if a family is found to be unsupported or not configured on the local machine. Adjust the tests to dynamically adapt to the address family that is being tested. Rework some of the tests to speed them up by avoiding (supposedly) unneeded [after]s. 2010-11-04 Stuart Cassoff * unix/Makefile.in: [Patch 3101127]: Installer Improvements. * unix/install-sh: 2010-11-04 Donal K. Fellows * tests/error.test (error-19.13): Another variation on testing for issues in [try] compilation. * doc/Tcl.n (Variable substitution): [Bug 3099086]: Increase clarity of explanation of what characters are actually permitted in variable substitutions. Note that this does not constitute a change of behavior; it is just an improvement of explanation. 2010-11-04 Don Porter * changes: Updates for 8.6b2 release. (Thanks Andreas Kupries) 2010-11-03 Jan Nijtmans * win/tclWinFcmd.c: [FRQ 2965056]: Windows build with -DUNICODE * win/tclWinFile.c: (more clean-ups for pre-win2000 stuff) * win/tclWinReg.c: 2010-11-03 Donal K. Fellows * generic/tclCmdMZ.c (TryPostBody): Ensure that errors when setting * tests/error.test (error-19.1[12]): message/opt capture variables get reflected properly to the caller. 2010-11-03 Kevin B. Kenny * generic/tclCompCmds.c (TclCompileCatchCmd): [Bug 3098302]: * tests/compile.test (compile-3.6): Reworked the compilation of the [catch] command so as to avoid placing any code that might throw an exception (specifically, any initial substitutions or any stores to result or options variables) between the BEGIN_CATCH and END_CATCH but outside the exception range. Added a test case that panics on a stack smash if the change is not made. 2010-11-01 Stuart Cassoff * library/safe.tcl: Improved handling of non-standard module path * tests/safe.test: lists, empty path lists in particular. 2010-11-01 Kevin B. Kenny * library/tzdata/Asia/Hong_Kong: * library/tzdata/Pacific/Apia: * library/tzdata/Pacific/Fiji: Olson's tzdata2010o. 2010-10-29 Alexandre Ferrieux * generic/tclTimer.c: [Bug 2905784]: Stop small [after]s from wasting CPU while keeping accuracy. 2010-10-28 Kevin B. Kenny [dogeen-assembler-branch] * generic/tclAssembly.c: * tests/assembly.test (assemble-31.*): Added jump tables. 2010-10-28 Don Porter * tests/http.test: [Bug 3097490]: Make http-4.15 pass in isolation. * unix/tclUnixSock.c: [Bug 3093120]: Prevent calls of freeaddrinfo(NULL) which can crash some systems. Thanks Larry Virden. 2010-10-26 Reinhard Max * Changelog.2008: Split off from Changelog. * generic/tclIOSock.c (TclCreateSocketAddress): The interp != NULL check is needed for ::tcl::unsupported::socketAF as well. 2010-10-26 Donal K. Fellows * unix/tclUnixSock.c (TcpGetOptionProc): Prevent crash if interp is * win/tclWinSock.c (TcpGetOptionProc): NULL (a legal situation). 2010-10-26 Reinhard Max * unix/tclUnixSock.c (TcpGetOptionProc): Added support for ::tcl::unsupported::noReverseDNS, which if set to any value, prevents [fconfigure -sockname] and [fconfigure -peername] from doing reverse DNS queries. 2010-10-24 Kevin B. Kenny [dogeen-assembler-branch] * generic/tclAssembly.c: * tests/assembly.test (assemble-17.15): Reworked branch handling so that forward branches can use jump1 (jumpTrue1, jumpFalse1). Added test cases that the forward branches will expand to jump4, jumpTrue4, jumpFalse4 when needed. 2010-10-23 Kevin B. Kenny [dogeen-assembler-branch] * generic/tclAssembly.h (removed): Removed file that was included in only one source file. * generictclAssembly.c: Inlined tclAssembly.h. 2010-10-17 Alexandre Ferrieux * doc/info.n: [Patch 2995655]: * generic/tclBasic.c: Report inner contexts in [info errorstack] * generic/tclCompCmds.c: * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclNamesp.c: * tests/error.test: * tests/result.test: 2010-10-20 Donal K. Fellows * generic/tclCompCmds.c (TclCompileDictForCmd): Update the compilation * generic/tclCompile.c (tclInstructionTable): of [dict for] so that * generic/tclExecute.c (TEBCresume): it no longer makes any use of INST_DICT_DONE now that's not needed, and make it clearer in the implementation of the instruction that it's just a deprecated form of unset operation. Followup to my commit of 2010-10-16. 2010-10-19 Donal K. Fellows * generic/tclZlib.c (Tcl_ZlibStreamGet): [Bug 3081008]: Ensure that when a bytearray gets its internals entangled with zlib for more than a passing moment, that bytearray will never be shimmered away. This increases the amount of copying but is simple to get right, which is a reasonable trade-off. * generic/tclStringObj.c (Tcl_AppendObjToObj): Added some special cases so that most of the time when you build up a bytearray by appending, it actually ends up being a bytearray rather than shimmering back and forth to string. * tests/http11.test (check_crc): Use a simpler way to express the functionality of this procedure. * generic/tclZlib.c: Purge code that wrote to the object returned by Tcl_GetObjResult, as we don't want to do that anti-pattern no more. 2010-10-18 Jan Nijtmans * tools/uniParse.tcl: [Bug 3085863]: tclUniData was 9 years old; Ignore non-BMP characters and fix comment about UnicodeData.txt file. * generic/regcomp.c: Fix comment * tests/utf.test: Add some Unicode 6 testcases 2010-10-17 Alexandre Ferrieux * doc/info.n: Document [info errorstack] faithfully. 2010-10-16 Donal K. Fellows * generic/tclExecute.c (ReleaseDictIterator): Factored out the release of the bytecode-level dictionary iterator information so that the side-conditions on instruction issuing are simpler. 2010-10-15 Jan Nijtmans * generic/reg_locale.c: [Bug 3085863]: tclUniData 9 years old: Updated * generic/tclUniData.c: Unicode tables to latest UnicodeData.txt, * tools/uniParse.tcl: corresponding with Unicode 6.0 (except for out-of-range chars > 0xFFFF) 2010-10-13 Don Porter * generic/tclCompile.c: Alternative fix for [Bugs 467523,983660] where * generic/tclExecute.c: sharing of empty scripts is allowed again. 2010-10-13 Jan Nijtmans * win/tclWinThrd.h: (removed) because it is just empty en used nowhere * win/tcl.dsp 2010-10-12 Jan Nijtmans * tools/uniClass.tcl: Spacing and comments: let uniClass.tcl * generic/regc_locale.c: generation match better the current (hand-modified) regc_locale.c * tools/uniParse.tcl: Generate proper const qualifiers for * generic/tclUniData.c: tclUniData.c 2010-10-12 Reinhard Max * unix/tclUnixSock.c (CreateClientSocket): [Bug 3084338]: Fix a memleak and refactor the calls to freeaddrinfo(). 2010-10-11 Jan Nijtmans * win/tclWinDde.c: [FRQ 2965056]: Windows build with -DUNICODE * win/tclWinReg.c: * win/tclWinTest.c: More cleanups * win/tclWinFile.c: Add netapi32 to the link line, so we no longer * win/tcl.m4: have to use LoadLibrary to access those functions. * win/makefile.vc: * win/configure: (Re-generate with autoconf-2.59) * win/rules.vc Update for VS10 2010-10-09 Miguel Sofer * generic/tclExecute.c: Fix overallocation of exec stack in TEBC (due to mixing numwords and numbytes) 2010-10-08 Jan Nijtmans * generic/tclIOSock.c: On Windows, use gai_strerrorA 2010-10-06 Don Porter * tests/winPipe.test: Test hygiene with makeFile and removeFile. * generic/tclCompile.c: [Bug 3081065]: Prevent writing to the intrep * tests/subst.test: fields of a freed Tcl_Obj. 2010-10-06 Kevin B. Kenny [dogeen-assembler-branch] * generic/tclAssembly.c: * generic/tclAssembly.h: * tests/assemble.test: Added catches. Still needs a lot of testing. 2010-10-02 Kevin B. Kenny [dogeen-assembler-branch] * generic/tclAssembly.c: * generic/tclAssembly.h: * tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend, dictSet, dictUnset, nop, regexp, nsupvar, upvar, and variable. 2010-10-02 Donal K. Fellows * generic/tclExecute.c (TEBCresume): [Bug 3079830]: Added invalidation of string representations of dictionaries in some cases. 2010-10-01 Jeff Hobbs * generic/tclExecute.c (EvalStatsCmd): change 'evalstats' to return data to interp by default, or if given an arg, use that as filename to output to (accepts 'stdout' and 'stderr'). Fix output to print used inst count data. * generic/tclCkalloc.c: Change TclDumpMemoryInfo sig to allow objPtr * generic/tclInt.decls: as well as FILE* as output. * generic/tclIntDecls.h: 2010-10-01 Donal K. Fellows * generic/tclBasic.c, generic/tclClock.c, generic/tclEncoding.c, * generic/tclEnv.c, generic/tclLoad.c, generic/tclNamesp.c, * generic/tclObj.c, generic/tclRegexp.c, generic/tclResolve.c, * generic/tclResult.c, generic/tclUtil.c, macosx/tclMacOSXFCmd.c: More purging of strcpy() from locations where we already know the length of the data being copied. 2010-10-01 Kevin B. Kenny [dogeen-assembler-branch] * tests/assemble.test: * generic/tclAssemble.h: * generic/tclAssemble.c: Added listIn, listNotIn, and dictGet. 2010-09-30 Kevin B. Kenny [dogeen-assembler-branch] * tests/assemble.test: Added tryCvtToNumeric and several more list * generic/tclAssemble.c: operations. * generic/tclAssemble.h: 2010-09-29 Kevin B. Kenny [dogeen-assembler-branch] * tests/assemble.test: Completed conversion of tests to a * generic/tclAssemble.c: "white box" structure that follows the C code. Added missing safety checks on the operands of 'over' and 'reverse' so that negative operand counts don't smash the stack. 2010-09-29 Jan Nijtmans * unix/configure: Re-generate with autoconf-2.59 * win/configure: * generic/tclMain.c: Make compilable with -DUNICODE as well 2010-09-28 Reinhard Max TIP #162 IMPLEMENTATION * doc/socket.n: Document the changes to the [socket] and [fconfigure] commands. * generic/tclInt.h: Introduce TclCreateSocketAddress() as a * generic/tclIOSock.c: replacement for the platform-dependent * unix/tclUnixSock.c: TclpCreateSocketAddress() functions. Extend * unix/tclUnixChan.c: the [socket] and [fconfigure] commands to * unix/tclUnixPort.h: behave as proposed in TIP #162. This is the * win/tclWinSock.c: core of what is required to support the use of * win/tclWinPort.h: IPv6 sockets in Tcl. * compat/fake-rfc2553.c: A compat implementation of the APIs defined * compat/fake-rfc2553.h: in RFC-2553 (getaddrinfo() and friends) on top of the existing gethostbyname() etc. * unix/configure.in: Test whether the fake-implementation is * unix/tcl.m4: needed. * unix/Makefile.in: Add a compile target for fake-rfc2553. * win/configure.in: Allow cross-compilation by default. * tests/socket.test: Improve the test suite to make more use of * tests/remote.tcl: randomized ports to reduce interference with tests running in parallel or other services on the machine. 2010-09-28 Kevin B. Kenny [dogeen-assembler-branch] * tests/assemble.test: Added more "white box" tests. * generic/tclAssembly.c: Added the error checking and reporting for undefined labels. Revised code so that no pointers into the bytecode sequence are held (because the sequence can move!), that no Tcl_HashEntry pointers are held (because the hash table doesn't guarantee their stability!) and to eliminate the BBHash table, which is merely additional information indexed by jump labels and can just as easily be held in the 'label' structure. Renamed shared structures to CamelCase, and renamed 'label' to JumpLabel because other types of labels may eventually be possible. 2010-09-27 Kevin B. Kenny [dogeen-assembler-branch] * tests/assemble.test: Added more "white box" tests. * generic/tclAssembly.c: Fixed bugs exposed by the new tests. (a) [eval] and [expr] had incorrect stack balance computed if the arg was not a simple word. (b) [concat] accepted a negative operand count. (c) [invoke] accepted a zero or negative operand count. (d) more misspelt error messages. Also replaced a funky NRCallTEBC with the new call TclNRExecuteByteCode, necessitated by a merge with changes on the HEAD. 2010-09-26 Miguel Sofer * generic/tclBasic.c: [Patch 3072080] (minus the itcl * generic/tclCmdIL.c: update): a saner NRE. * generic/tclCompExpr.c: * generic/tclCompile.c: This makes TclNRExecuteByteCode (ex TEBC) * generic/tclCompile.h: to be a normal NRE citizen: it loses its * generic/tclExecute.c: special status. * generic/tclInt.decls: The logic flow within the BC engine is * generic/tclInt.h: simplified considerably. * generic/tclIntDecls.h: * generic/tclObj.c: * generic/tclProc.c: * generic/tclTest.c: * generic/tclVar.c: Use the macro HasLocalVars everywhere 2010-09-26 Miguel Sofer * generic/tclOOMethod.c (ProcedureMethodVarResolver): avoid code duplication, let the runtime var resolver call the compiled var resolver. 2010-09-26 Kevin B. Kenny [dogeen-assembler-branch] * tests/assemble.test: Added many new tests moving toward a more comprehensive test suite for the assembler. * generic/tclAssembly.c: Fixed bugs exposed by the new tests: (a) [bitnot] and [not] had incorrect operand counts. (b) INST_CONCAT cannot concatenate zero objects. (c) misspelt error messages. (d) the "assembly code" internal representation lacked a duplicator, which caused double-frees of the Bytecode object if assembly code ever was duplicated. 2010-09-25 Kevin B. Kenny [dogeen-assembler-branch] * generic/tclAssembly.c: Massive refactoring of the assembler * generic/tclAssembly.h: to use a Tcl-like syntax (and use * tests/assemble.test: Tcl_ParseCommand to parse it). The * tests/assemble1.bench: refactoring also ensures that Tcl_Tokens in the assembler have string ranges inside the source code, which allows for [eval] and [expr] assembler directives that simply call TclCompileScript and TclCompileExpr recursively. 2010-09-24 Jeff Hobbs * tests/stringComp.test: improved string eq/cmp test coverage * generic/tclExecute.c (TclExecuteByteCode): merge INST_STR_CMP and INST_STR_EQ/INST_STR_NEQ paths. Speeds up eq/ne/[string eq] with obj-aware comparisons and eq/==/ne/!= with length equality check. 2010-09-24 Andreas Kupries * tclWinsock.c: [Bug 3056775]: Fixed race condition between thread and internal co-thread access of a socket's structure because of the thread not using the socketListLock in TcpAccept(). Added documentation on how the module works to the top. 2010-09-23 Jan Nijtmans * generic/tclDecls.h: Make Tcl_SetPanicProc and Tcl_GetStringResult * unix/tclAppInit.c: callable without stubs, just as Tcl_SetVar. * win/tclAppInit.c: 2010-09-23 Don Porter * generic/tclCmdAH.c: Fix cases where value returned by * generic/tclEvent.c: Tcl_GetReturnOptions() was leaked. * generic/tclMain.c: Thanks to Jeff Hobbs for discovery of the anti-pattern to seek and destroy. 2010-09-23 Jan Nijtmans * unix/tclAppInit.c: Make compilable with -DUNICODE (not activated * win/tclAppInit.c: yet), many clean-ups in comments. 2010-09-22 Miguel Sofer * generic/tclExecute: [Bug 3072640]: One more DECACHE_STACK_INFO() was missing. * tests/execute.test: Added execute-10.3 for [Bug 3072640]. The test causes a mem failure. * generic/tclExecute: Protect all possible writes to ::errorInfo or ::errorCode with DECACHE_STACK_INFO(), as they could run traces. The new calls to be protected are Tcl_ResetResult(), Tcl_SetErrorCode(), IllegalExprOperandType(), TclExprFloatError(). The error was triggered by [Patch 3072080]. 2010-09-22 Jan Nijtmans * win/tcl.m4: Add kernel32 to LIBS, so the link line for * win/configure: mingw is exactly the same as for MSVC++. 2010-09-21 Jeff Hobbs * generic/tclExecute.c (TclExecuteByteCode): * generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect): * generic/tclVar.c (TclLookupSimpleVar, CompareVarKeys): * generic/tclPathObj.c (Tcl_FSGetNormalizedPath, Tcl_FSEqualPaths): * generic/tclIOUtil.c (TclFSCwdPointerEquals): peephole opt * generic/tclResult.c (TclMergeReturnOptions): Use memcmp where applicable as possible speedup on some libc variants. 2010-09-21 Kevin B. Kenny [BRANCH: dogeen-assembler-branch] * generic/tclAssembly.c (new file): * generic/tclAssembly.h: * generic/tclBasic.c (builtInCmds, Tcl_CreateInterp): * generic/tclInt.h: * tests/assemble.test (new file): * tests/assemble1.bench (new file): * unix/Makefile.in: * win/Makefile.in: * win/Makefile.vc: Initial commit of Ozgur Dogan Ugurlu's (SF user: dogeen) assembler for the Tcl bytecode language. 2010-09-21 Jan Nijtmans * win/tclWinFile.c: Fix declaration after statement. * win/tcl.m4: Add -Wdeclaration-after-statement, so this * win/configure: mistake cannot happen again. * win/tclWinFCmd.c: [Bug 3069278]: Breakage on head Windows * win/tclWinPipe.c: triggered by install-tzdata, final fix 2010-09-20 Jan Nijtmans * win/tclWinFCmd.c: Eliminate tclWinProcs->useWide everywhere, since * win/tclWinFile.c: the value is always "1" on platforms >win95 * win/tclWinPipe.c: 2010-09-19 Donal K. Fellows * doc/file.n (file readlink): [Bug 3070580]: Typofix. 2010-09-18 Jan Nijtmans * win/tclWinFCmd.c [Bug 3069278]: Breakage on head Windows triggered by install-tzdata. Temporary don't compile this with -DUNICODE, while investigating this bug. 2010-09-16 Jeff Hobbs * win/tclWinFile.c: Remove define of FINDEX_INFO_LEVELS as all supported versions of compilers should now have it. * unix/Makefile.in: Do not pass current build env vars when using NATIVE_TCLSH in targets. 2010-09-16 Jan Nijtmans * generic/tclDecls.h: Make Tcl_FindExecutable() work in UNICODE * generic/tclEncoding.c: compiles (windows-only) as well as ASCII. * generic/tclStubInit.c: Needed for [FRQ 491789]: setargv() doesn't support a unicode cmdline. 2010-09-15 Donal K. Fellows * generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 3067036]: Make sure we never try to double zero repeatedly to get a buffer size. Also added a check for sanity on the size of buffer being appended. 2010-09-15 Don Porter * unix/Makefile.in: Revise `make dist` target to tolerate the case of zero bundled packages. 2010-09-15 Jan Nijtmans * tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl * generic/tcl.decls: features to genStubs.tcl. Make the "generic" * generic/tclInt.decls: argument in the *.decls files optional * generic/tclOO.decls: (no change to any tcl*Decls.h files) * generic/tclTomMath.decls: This allows genStubs.tcl to generate the ttk stub files as well, while keeping full compatibility with existing *.decls files. 2010-09-14 Jan Nijtmans * win/tclWinPort.h: Allow all Win2000+ API entries in Tcl * win/tclWin32Dll.c: Eliminate dynamical loading of advapi23 and kernel32 symbols. 2010-09-13 Jan Nijtmans * win/tclWinChan.c: Various clean-ups, converting from * win/tclWinConsole.c: tclWinProc->xxxProc directly to Xxx * win/tclWinInit.c: (no change in functionality) * win/tclWinLoad.c: * win/tclWinSerial.c: * win/tclWinSock.c: * tools/genStubs.tcl: Add scspec feature from ttkGenStubs.tcl (no change in output for *Decls.h files) 2010-09-10 Jan Nijtmans * win/tclWin32Dll.c: Partly revert yesterday's change, to make it work on VC++ 6.0 again. 2010-09-10 Donal K. Fellows * doc/regsub.n: [Bug 3063568]: Fix for gotcha in example due to Tcl's special handling of backslash-newline. Makes example slightly less pure, but more useful. 2010-09-09 Jan Nijtmans * win/makefile.vc: Mingw should always link with -ladvapi32. * win/tcl.m4: * win/configure: (regenerated) * win/tclWinInt.h: Remove ascii variant of tkWinPocs table, it is * win/tclWin32Dll.c: no longer necessary. Fix CreateProcess signature * win/tclWinPipe.c: and remove unused GetModuleFileName and lstrcpy. * win/tclWinPort.h: Mingw/cygwin fixes: should always be included, and fix conflict in various macro values: Always force the same values as in VC++. 2010-09-08 Don Porter * win/tclWinChan.c: [Bug 3059922]: #ifdef protections to permit * win/tclWinFCmd.c: builds with mingw on amd64 systems. Thanks to "mescalinum" for reporting and testing. 2010-09-08 Andreas Kupries * doc/tm.n: Added underscore to the set of characters accepted in module names. This is true for quite some time in the code, this change catches up the documentation. 2010-09-03 Donal K. Fellows * tools/tcltk-man2html.tcl (plus-pkgs): Improve the package documentation search pattern to support the doctoos-generated directory structure. * tools/tcltk-man2html-utils.tcl (output-name): Made this more resilient against misformatted NAME sections, induced by import of Thread package documentation into Tcl doc tree. 2010-09-02 Andreas Kupries * doc/glob.n: Fixed documentation ambiguity regarding the handling of -join. * library/safe.tcl (safe::AliasGlob): Fixed another problem, the option -join does not stop option processing in the core builtin, so the emulation must not do that either. 2010-09-01 Andreas Kupries * library/safe.tcl (safe::AliasGlob): Moved the command extending the actual glob command with a -directory flag to when we actually have a proper untranslated path, 2010-09-01 Andreas Kupries * generic/tclExecute.c: [Bug 3057639]: Applied patch by Jeff to make * generic/tclVar.c: the behaviour of lappend in bytecompiled mode * tests/append.test: consistent with direct-eval and 'append' * tests/appendComp.test: generally. Added tests (append*-9.*) showing the difference. 2010-08-31 Jan Nijtmans * win/rules.vc: Typo (thanks to Twylite discovering this) * generic/tclStubLib.c: Revert to previous version: MSVC++ 6.0 * generic/tclTomMathStubLib.c:cannot handle the new construct. * generic/tcl.decls [Patch 2997642]: Many type casts needed * generic/tclDecls.h: when using Tcl_Pkg* API. Remaining part. * generic/tclPkg.c: * generic/tclBasic.c: * generic/tclTomMathInterface.c: * doc/PkgRequire.3 2010-08-31 Andreas Kupries * win/tcl.m4: Applied patch by Jeff fixing issues with the manifest handling on Win64. * win/configure: Regenerated. 2010-08-30 Miguel Sofer * generic/tclBasic.c: [Bugs 3046594,3047235,3048771]: New * generic/tclCmdAH.c: implementation for [tailcall] command: it now * generic/tclCmdMZ.c: schedules the command and returns TCL_RETURN. * generic/tclExecute.c: This fixes all issues with [catch] and [try]. * generic/tclInt.h: Thanks dgp for exploring the dark corners. * generic/tclNamesp.c: More thorough testing is required. * tests/tailcall.test: 2010-08-30 Jan Nijtmans * win/Makefile.in: [FRQ 2965056]: Windows build with -DUNICODE * win/rules.vc: * win/tclWinFCmd.c: Make sure that allocated TCHAR arrays are * win/tclWinFile.c: always properly aligned as wchar_t, and * win/tclWinPipe.c: not bigger than necessary. * win/tclWinSock.c: * win/tclWinDde.c: Those 3 files are not converted yet to be * win/tclWinReg.c: built with -DUNICODE, so add a TODO. * win/tclWinTest.c: * generic/tcl.decls: [Patch 2997642]: Many type casts needed when * generic/tclDecls.h: using Tcl_Pkg* API. Partly. * generic/tclPkg.c: * generic/tclStubLib.c: Demonstration how this change can benefit code. * generic/tclTomMathStubLib.c: * doc/PkgRequire.3: 2010-08-29 Donal K. Fellows * doc/dict.n: [Bug 3046999]: Corrected cross reference to array manpage to refer to (correct) existing subcommand. 2010-08-26 Jeff Hobbs * unix/configure, unix/tcl.m4: SHLIB_LD_LIBS='${LIBS}' for OSF1-V*. Add /usr/lib64 to set of auto-search dirs. [Bug 1230554] (SC_PATH_X): Correct syntax error when xincludes not found. * win/Makefile.in (VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE): * win/configure, win/configure.in, win/tcl.m4: SC_EMBED_MANIFEST macro and --enable-embedded-manifest configure arg added to support manifest embedding where we know the magic. Help prevents DLL hell with MSVC8+. 2010-08-24 Jan Nijtmans * generic/tcl.decls: [Bug 3007895]: Tcl_(Find|Create)HashEntry * generic/tclHash.c: stub entries can never be called. * generic/tclDecls.h: * generic/tclStubInit.c: [Patch 2994165]: Change signature of Tcl_FSGetNativePath and TclpDeleteFile follow-up: move stub entry back to original location. 2010-08-23 Kevin B. Kenny * library/tzdata/Africa/Cairo: * library/tzdata/Asia/Gaza: Olson's tzdata2010l. 2010-08-22 Jan Nijtmans * generic/tclBasic.c: [Patch 3009403]: Signature of Tcl_GetHashKey, * generic/tclBinary.c: Tcl_(Create|Find)HashEntry follow-up: * generic/tclCmdIL.c: Remove many type casts which are no longer * generic/tclCompile.c:necessary as a result of this signature change. * generic/tclDictObj.c: * generic/tclEncoding.c: * generic/tclExecute.c: * generic/tclInterp.c: * generic/tclIOCmd.c: * generic/tclObj.c: * generic/tclProc.c: * generic/tclTest.c: * generic/tclTrace.c: * generic/tclUtil.c: * generic/tclVar.c: 2010-08-21 Donal K. Fellows * doc/linsert.n: [Bug 3045123]: Make description of what is actually happening more accurate. 2010-08-21 Jan Nijtmans * tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl features to genStubs.tcl, partly: Use void (*reserved$i)(void) = 0 instead of void *reserved$i = NULL for unused stub entries, in case pointer-to-function and pointer-to-object are different sizes. * generic/tcl*Decls.h: (regenerated) * generic/tcl*StubInit.c:(regenerated) 2010-08-20 Jan Nijtmans * doc/Method.3: Fix definition of Tcl_MethodType. 2010-08-19 Donal K. Fellows * generic/tclTrace.c (TraceExecutionObjCmd, TraceCommandObjCmd) (TraceVariableObjCmd): [Patch 3048354]: Use memcpy() instead of strcpy() to avoid buffer overflow; we have the correct length of data to copy anyway since we've just allocated the target buffer. 2010-08-18 Jan Nijtmans * tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl features to genStubs.tcl, partly: remove unneeded ifdeffery and put C++ guard around stubs pointer definition. * generic/*Decls.h: (regenerated) 2010-08-18 Miguel Sofer * generic/tclBasic.c: New redesign of [tailcall]: find * generic/tclExecute.c: errors early on, so that errorInfo * generic/tclInt.h: contains the proper info [Bug 3047235] * generic/tclNamesp.c: * generic/tclCmdAH.c (TclNRTryObjCmd): [Bug 3046594]: Block tailcalling out of the body of a non-bc'ed [try]. * generic/tclBasic.c: Redesign of [tailcall] to * generic/tclCmdAH.c: (a) fix [Bug 3047235] * generic/tclCompile.h: (b) enable fix for [Bug 3046594] * generic/tclExecute.c: (c) enable recursive tailcalls * generic/tclInt.h: * generic/tclNamesp.c: * tests/tailcall.test: 2010-08-18 Donal K. Fellows * library/safe.tcl (AliasGlob): [Bug 3004191]: Restore safe [glob] to working condition. 2010-08-15 Donal K. Fellows * generic/tclProc.c (ProcWrongNumArgs): [Bug 3045010]: Make the handling of passing the wrong number of arguments to [apply] somewhat less verbose when a lambda term is present. 2010-08-14 Jan Nijtmans * compat/unicows: Remove completely, see [FRQ 2819611]. * doc/FileSystem.3: [Patch 2994165]: Change signature of * generic/tcl.decls Tcl_FSGetNativePath and TclpDeleteFile * generic/tclDecls.h: * generic/tclIOUtil.c: * generic/tclStubInit.c: * generic/tclInt.h: * unix/tclUnixFCmd.c: * win/tclWinFCmd.c: * doc/Hash.3: [Patch 3009403]: Signature of Tcl_GetHashKey, * generic/tcl.h: Tcl_(Create|Find)HashEntry 2010-08-11 Jeff Hobbs * unix/ldAix: Remove ancient (pre-4.2) AIX support * unix/configure: Regen with ac-2.59 * unix/configure.in, unix/tclConfig.sh.in, unix/Makefile.in: * unix/tcl.m4 (AIX): Remove the need for ldAIX, replace with -bexpall/-brtl. Remove TCL_EXP_FILE (export file) and other baggage that went with it. Remove pre-4 AIX build support. 2010-08-11 Miguel Sofer * generic/tclBasic.c (TclNRYieldToObjCmd): * tests/coroutine.test: Fixed bad copypasta snafu. Thanks to Andy Goth for finding the bug. 2010-08-10 Jeff Hobbs * generic/tclUtil.c (TclByteArrayMatch): Patterns may not be null-terminated, so account for that. 2010-08-09 Don Porter * changes: Updates for 8.6b2 release. 2010-08-04 Jeff Hobbs * win/Makefile.in, win/makefile.bc, win/makefile.vc, win/tcl.dsp: * win/tclWinPipe.c (TclpCreateProcess): * win/stub16.c (removed): Removed Win9x tclpip8x.dll build and 16-bit application loader stub support. Win9x is no longer supported. * win/tclWin32Dll.c (TclWinInit): Hard-enforce Windows 9x as an unsupported platform with a panic. Code to support it still exists in other files (to go away in time), but new APIs are being used that don't exist on Win9x. * unix/tclUnixFCmd.c: Adjust license header as per ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change * license.terms: Fix DFARs note for number-adjusted rights clause * win/tclWin32Dll.c (asciiProcs, unicodeProcs): * win/tclWinLoad.c (TclpDlopen): 'load' use LoadLibraryEx with * win/tclWinInt.h (TclWinProcs): LOAD_WITH_ALTERED_SEARCH_PATH to prefer dependent DLLs in same dir as loaded DLL. * win/Makefile.in (%.${OBJEXT}): better implicit rules support 2010-08-04 Andreas Kupries * generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting in * generic/tclIORTrans.c: InvokeTclMethod and callers. * tests/ioTrans.test: 2010-08-03 Andreas Kupries * tests/var.test (var-19.1): [Bug 3037525]: Added test demonstrating the local hashtable deletion crash and fix. * tests/info.test (info-39.1): Added forward copy of test in 8.5 branch about [Bug 2933089]. Should not fail, and doesn't, after updating the line numbers to the changed position. 2010-08-02 Kevin B. Kenny * library/tzdata/America/Bahia_Banderas: * library/tzdata/Pacific/Chuuk: * library/tzdata/Pacific/Pohnpei: * library/tzdata/Africa/Cairo: * library/tzdata/Europe/Helsinki: * library/tzdata/Pacific/Ponape: * library/tzdata/Pacific/Truk: * library/tzdata/Pacific/Yap: Olson's tzdata2010k. 2010-08-02 Miguel Sofer * generic/tclVar.c: Correcting bad port of [Bug 3037525] fix 2010-07-28 Miguel Sofer * generic/tclVar.c: [Bug 3037525]: Lose fickle optimisation in TclDeleteVars (used for runtime-created locals) that caused crash. 2010-07-29 Jan Nijtmans * compat/zlib/win32/README.txt: Official build of zlib1.dll 1.2.5 is * compat/zlib/win32/USAGE.txt: finally available, so put it in. * compat/zlib/win32/zlib1.dll: 2010-07-25 Donal K. Fellows * doc/http.n: Corrected description of location of one of the entries in the state array. 2010-07-24 Jan Nijtmans * generic/tclDecls.h: [Bug 3029891]: Functions that don't belong in * generic/tclTest.c: the stub table. * generic/tclBasic.c: From [Bug 3030870] make itcl 3.x built with pre-8.6 work in 8.6: Relax the relation between Tcl_CallFrame and CallFrame. 2010-07-16 Donal K. Fellows * generic/tclBasic.c: Added more errorCode setting. 2010-07-15 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Ensure that [dict get] * generic/tclDictObj.c (DictGetCmd): always generates an errorCode on a failure to look up an entry. 2010-07-11 Pat Thoyts * unix/configure: (regenerated) * unix/configure.in: For the NATIVE_TCLSH variable use the autoconf * unix/Makefile.in: SC_PROG_TCLSH to try and find a locally installed native binary. This avoids manually fixing up when cross compiling. If there is not one, revert to using the build product. 2010-07-02 Don Porter * generic/tclInt.decs: Reverted to the original TIP 337 implementation on what to do with the obsolete internal stub for TclBackgroundException() (eliminate it!) * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: 2010-07-02 Jan Nijtmans * generic/tclInt.decls: [Bug 803489]: Tcl_FindNamespace problem in * generic/tclIntDecls.h: the Stubs table * generic/tclStubInit.c: 2010-07-02 Donal K. Fellows * generic/tclExecute.c (IllegalExprOperandType): [Bug 3024379]: Made sure that errors caused by an argument to an operator being outside the domain of the operator all result in ::errorCode being ARITH DOMAIN and not NONE. 2010-07-01 Jan Nijtmans * win/rules.vc: [Bug 3020677]: wish can't link reg1.2 * tools/checkLibraryDoc.tcl: formatting, spacing, cleanup unused * tools/eolFix.tcl: variables; no change in generated output * tools/fix_tommath_h.tcl: * tools/genStubs.tcl: * tools/index.tcl: * tools/man2help2.tcl: * tools/regexpTestLib.tcl: * tools/tsdPerf.tcl: * tools/uniClass.tcl: * tools/uniParse.tcl: 2010-07-01 Donal K. Fellows * doc/mathop.n: [Bug 3023165]: Fix typo that was preventing proper rendering of the exclusive-or operator. 2010-06-28 Jan Nijtmans * generic/tclPosixStr.c: [Bug 3019634]: errno.h and tclWinPort.h have conflicting definitions. Added messages for ENOTRECOVERABLE, EOTHER, ECANCELED and EOWNERDEAD, and fixed various typing mistakes in other messages. 2010-06-25 Reinhard Max * tests/socket.test: Prevent a race condition during shutdown of the remote test server that can cause a hang when the server is being run in verbose mode. 2010-06-24 Jan Nijtmans * win/tclWinPort.h: [Bug 3019634]: errno.h and tclWinPort.h have conflicting definitions. ***POTENTIAL INCOMPATIBILITY*** On win32, the correspondence between errno and the related error message, as handled by Tcl_ErrnoMsg() changes. The error message is kept the same, but the corresponding errno value might change. 2010-06-22 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsetObjCmd): [Bug 3019351]: Corrected wrong args message. 2010-06-21 Jan Nijtmans * unix/tclLoadDl.c: Eliminate various unnecessary type casts, use * unix/tclLoadNext.c: function typedefs whenever possible * unix/tclUnixChan.c: * unix/tclUnixFile.c: * unix/tclUnixNotfy.c: * unix/tclUnixSock.c: * unix/tclUnixTest.c: * unix/tclXtTest.c: * generic/tclZlib.c: Remove hack needed for zlib 1.2.3 on win32 2010-06-18 Donal K. Fellows * library/init.tcl (auto_execok): [Bug 3017997]: Add .cmd to the default list of extensions that we can execute interactively. 2010-06-16 Jan Nijtmans * tools/loadICU.tcl: [Bug 3016135]: Traceback using clock format * library/msgs/he.msg: with locale of he_IL. * generic/tcl.h: Simplify Tcl_AppInit and *_Init definitions, * generic/tclInt.h: spacing. Change TclpThreadCreate and * generic/tcl.decls: Tcl_CreateThread signature, making clear that * generic/tclDecls.h: "proc" is a function pointer, as in all other * generic/tclEvent.c: "proc" function parameters. * generic/tclTestProcBodyObj.c: * win/tclWinThrd.c: * unix/tclUnixThrd.c: * doc/Thread.3: * doc/Class.3: Fix Tcl_ObjectMetadataType definition. 2010-06-14 Jan Nijtmans * unix/Makefile.in: Fix compilation of xttest with 8.6 changes * unix/tclXtNotify.c: * unix/tclXtTest.c: * generic/tclPipe.c: Fix gcc warning (with -fstrict-aliasing=2) * library/auto.tcl: Spacing and style fixes. * library/history.tcl: * library/init.tcl: * library/package.tcl: * library/safe.tcl: * library/tm.tcl: 2010-06-13 Donal K. Fellows * tools/tcltk-man2html.tcl (make-man-pages): [Bug 3015327]: Make the title of a manual page be stored relative to its resulting directory name as well as its source filename. This was caused by both Tcl and a contributed package ([incr Tcl]) defining an Object.3. Also corrected the joining of strings in titles to avoid extra braces. 2010-06-09 Andreas Kupries * library/platform/platform.tcl: Added OSX Intel 64bit * library/platform/pkgIndex.tcl: Package updated to version 1.0.9. * unix/Makefile.in: * win/Makefile.in: 2010-06-09 Jan Nijtmans * tools/tsdPerf.c: Fix export of symbol Tsdperf_Init, when using -fvisibility=hidden. Make two functions static, eliminate some unnecessary type casts. * tools/configure.in: Update to Tcl 8.6 * tools/configure: (regenerated) * tools/.cvsignore new file 2010-06-07 Alexandre Ferrieux * generic/tclExecute.c: Ensure proper reset of [info errorstack] even * generic/tclNamesp.c: when compiling constant expr's with errors. 2010-06-05 Miguel Sofer * generic/tclBasic.c: [Bug 3008307]: make callerPtr chains be * generic/tclExecute.c: traversable accross coro boundaries. Add the special coroutine CallFrame (partially reverting commit of 2009-12-10), as it is needed for coroutines that do not push a CF, eg, those with [eval] as command. Thanks to Colin McCormack (coldstore) and Alexandre Ferrieux for the hard work on this. 2010-06-03 Alexandre Ferrieux * generic/tclNamesp.c: Safer (and faster) computation of [uplevel] * tests/error.test: offsets in TIP 348. Toplevel offsets no longer * tests/result.test: overestimated. 2010-06-02 Jan Nijtmans * generic/tclOO.h: BUILD_tcloo is never defined (leftover) * win/makefile.bc: Don't set BUILD_tcloo (leftover) See also entry below: 2008-06-01 Joe Mistachkin 2010-06-01 Alexandre Ferrieux * generic/tclNamesp.c: Fix computation of [uplevel] offsets in TIP 348 * tests/error.test: Only depend on callerPtr chaining now. * tests/result.test: Needed for upcoming coro patch. 2010-05-31 Jan Nijtmans * generic/tclVar.c: Eliminate some casts to (Tcl_HashTable *) * generic/tclExecute.c: * tests/fileSystem.test: Fix filesystem-5.1 test failure on CYGWIN 2010-05-28 Jan Nijtmans * generic/tclInt.h: [Patch 3008541]: Order of TIP #348 fields in Interp structure 2010-05-28 Donal K. Fellows * generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions): [3007374]: Corrected error in handling of catch contexts to prevent crash with chained handlers. * generic/tclExecute.c (TclExecuteByteCode): Restore correct operation of instruction-level execution tracing (had been broken by NRE). 2010-05-27 Jan Nijtmans * library/opt/optParse.tcl: Don't generate spaces at the end of a * library/opt/pkgIndex.tcl: line, eliminate ';' at line end, bump to * tools/uniParse.tcl: v0.4.6 * generic/tclUniData.c: * tests/opt.test: * tests/safe.test: 2010-05-21 Jan Nijtmans * tools/installData.tcl: Make sure that copyDir only receives normalized paths, otherwise it might result in a crash on CYGWIN. Restyle according to the Tcl style guide. * generic/tclStrToD.c: [Bug 3005233]: Fix for build on OpenBSD vax 2010-05-19 Alexandre Ferrieux * tests/dict.test: Add missing tests for [Bug 3004007], fixed under the radar on 2010-02-24 (dkf): EIAS violation in list-dict conversions 2010-05-19 Jan Nijtmans * generic/regcomp.c: Don't use arrays of length 1, just use a * generic/tclFileName.c: single element then, it makes code more * generic/tclLoad.c: readable. (Here it even prevents a type cast) 2010-05-17 Jan Nijtmans * generic/tclStrToD.c: [Bug 2996549]: Failure in expr.test on Win32 2010-05-17 Donal K. Fellows * generic/tclCmdIL.c (TclInfoFrame): Change this code to use Tcl_GetCommandFullName rather than rolling its own. Discovered during the hunting of [Bug 3001438] but unlikely to be a fix. 2010-05-11 Jan Nijtmans * win/tclWinConsole.c: [Patch 2997087]: Unnecessary type casts. * win/tclWinDde.c: * win/tclWinLoad.c: * win/tclWinNotify.c: * win/tclWinSerial.c: * win/tclWinSock.c: * win/tclWinTime.c: * win/tclWinPort.h: Don't duplicate CYGWIN timezone #define from tclPort.h 2010-05-07 Andreas Kupries * library/platform/platform.tcl: Fix cpu name for Solaris/Intel 64bit. * library/platform/pkgIndex.tcl: Package updated to version 1.0.8. * unix/Makefile.in: * win/Makefile.in: 2010-05-06 Jan Nijtmans * generic/tclPkg.c: Unnecessary type casts, see [Patch 2997087] 2010-05-04 Jan Nijtmans * win/tclWinNotify.c: TCHAR-related fixes, making those two files * win/tclWinSock.c: compile fine when TCHAR != char. Please see comments in [FRQ 2965056] (2965056-1.patch). 2010-05-03 Jan Nijtmans * generic/tclIORChan.c: Use "tclIO.h" and "tclTomMathDecls.h" * generic/tclIORTrans.c: everywhere * generic/tclTomMath.h: * tools/fix_tommath_h.tcl: * libtommath/tommath.h: Formatting (# should always be first char on line) * win/tclAppInit.c: For MINGW/CYGWIN, use GetCommandLineA explicitly. * unix/.cvsignore: Add pkg, *.dll * libtommath/tommath.h: CONSTify various useful internal * libtommath/bn_mp_cmp_d.c: functions (TclBignumToDouble, TclCeil, * libtommath/bn_mp_cmp_mag.c: TclFloor), and related tommath functions * libtommath/bn_mp_cmp.c: * libtommath/bn_mp_copy.c: * libtommath/bn_mp_count_bits.c: * libtommath/bn_mp_div_2d.c: * libtommath/bn_mp_mod_2d.c: * libtommath/bn_mp_mul_2d.c: * libtommath/bn_mp_neg.c: * generic/tclBasic.c: Handle TODO: const correctness ? * generic/tclInt.h: * generic/tclStrToD.c: * generic/tclTomMath.decls: * generic/tclTomMath.h: * generic/tclTomMathDecls.h: 2010-04-30 Don Porter * generic/tcl.h: Bump patchlevel to 8.6b1.2 to distinguish * library/init.tcl: CVS snapshots from earlier snapshots as well * unix/configure.in: as the 8.6b1 and 8.6b2 releases. * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: * generic/tclBinary.c (TclAppendBytesToByteArray): Add comments * generic/tclInt.h (TclAppendBytesToByteArray): placing overflow protection responsibility on caller. Convert "len" argument to signed int which any value already vetted for overflow issues will fit into. * generic/tclStringObj.c: Update caller; standardize panic msg. * generic/tclBinary.c (UpdateStringOfByteArray): [Bug 2994924]: Add panic when the generated string representation would grow beyond Tcl's size limits. 2010-04-30 Donal K. Fellows * generic/tclBinary.c (TclAppendBytesToByteArray): Add extra armour against buffer overflows. * generic/tclBasic.c (NRInterpCoroutine): Corrected handling of * tests/coroutine.test (coroutine-6.4): arguments to deal with trickier cases. 2010-04-30 Miguel Sofer * tests/coroutine.test: testing coroutine arguments after [yield]: check that only 0/1 allowed 2010-04-30 Donal K. Fellows * generic/tclBasic.c (NRInterpCoroutine): Corrected handling of arguments to deal with trickier cases. * generic/tclCompCmds.c (TclCompileVariableCmd): Slightly tighter issuing of instructions. * generic/tclExecute.c (TclExecuteByteCode): Add peephole optimization of the fact that INST_DICT_FIRST and INST_DICT_NEXT always have a conditional jump afterwards. * generic/tclBasic.c (TclNRYieldObjCmd, TclNRYieldmObjCmd) (NRInterpCoroutine): Replace magic values for formal argument counts for coroutine command implementations with #defines, for an increase in readability. 2010-04-30 Jan Nijtmans * generic/tclMain.c: Unnecessary TCL_STORAGE_CLASS re-definition. It was used for an ancient dummy reference to Tcl_LinkVar(), but that's already gone since 2002-05-29. 2010-04-29 Miguel Sofer * generic/tclCompExpr.c: Slight change in the literal sharing * generic/tclCompile.c: mechanism to avoid shimmering of * generic/tclCompile.h: command names. * generic/tclLiteral.c: 2010-04-29 Andreas Kupries * library/platform/platform.tcl: Another stab at getting the /lib, * library/platform/pkgIndex.tcl: /lib64 difference right for linux. * unix/Makefile.in: Package updated to version 1.0.7. * win/Makefile.in: 2010-04-29 Kevin B. Kenny * library/tzdata/Antarctica/Macquarie: * library/tzdata/Africa/Casablanca: * library/tzdata/Africa/Tunis: * library/tzdata/America/Santiago: * library/tzdata/America/Argentina/San_Luis: * library/tzdata/Antarctica/Casey: * library/tzdata/Antarctica/Davis: * library/tzdata/Asia/Anadyr: * library/tzdata/Asia/Damascus: * library/tzdata/Asia/Dhaka: * library/tzdata/Asia/Gaza: * library/tzdata/Asia/Kamchatka: * library/tzdata/Asia/Karachi: * library/tzdata/Asia/Taipei: * library/tzdata/Europe/Samara: * library/tzdata/Pacific/Apia: * library/tzdata/Pacific/Easter: * library/tzdata/Pacific/Fiji: Olson's tzdata2010i. 2010-04-29 Donal K. Fellows * generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 2992970]: Make * generic/tclStringObj.c (Tcl_AppendObjToObj): an append of a byte array to another into an efficent operation. The problem was the (lack of) a proper growth management strategy for the byte array. 2010-04-29 Jan Nijtmans * compat/dirent2.h: Include "tcl.h", not , like everywhere * compat/dlfcn.h: else, to ensure that the version in the Tcl * compat/stdlib.h: distribution is used, not some version from * compat/string.h: somewhere else. * compat/unistd.h: 2010-04-28 Jan Nijtmans * win/Makefile.in: Remove unused @MAN2TCLFLAGS@ * win/tclWinPort.h: Move include from tclInt.h to * generic/tclInt.h: tclWinPort.h, and eliminate unneeded * generic/tclEnv.c: , and , which are already in tclInt.h * generic/regcustom.h: Move "tclInt.h" from regcustom.h up to * generic/regex.h: regex.h. * generic/tclAlloc.c: Unneeded include. * generic/tclExecute.c: Fix gcc warning: comparison between signed and unsigned. 2010-04-28 Donal K. Fellows * generic/tclInt.h (TclIsVarDirectUnsettable): Corrected flags so that deletion of traces is not optimized out... * generic/tclExecute.c (ExecuteExtendedBinaryMathOp) (TclCompareTwoNumbers,ExecuteExtendedUnaryMathOp,TclExecuteByteCode): [Patch 2981677]: Move the less common arithmetic operations (i.e., exponentiation and operations on non-longs) out of TEBC for a big drop in the overall size of the stack frame for most code. Net effect on speed is minimal (slightly faster overall in tclbench). Also extended the number of places where TRESULT handling is replaced with a jump to dedicated code. 2010-04-27 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Rearrange location of an assignment to shorten the object code. 2010-04-27 Jan Nijtmans * generic/tclIOUtil.c (Tcl_FSGetNativePath): [Bug 2992292]: tclIOUtil.c assignment type mismatch compiler warning * generic/regguts.h: If tclInt.h or tclPort.h is already * generic/tclBasic.c: included, don't include * generic/tclExecute.c: again. Follow-up to [Bug 2991415]: * generic/tclIORChan.c: tclport.h #included before limits.h * generic/tclIORTrans.c: See comments in [Bug 2991415] * generic/tclObj.c: * generic/tclOOInt.h: * generic/tclStrToD.c: * generic/tclTomMath.h: * generic/tclTomMathInterface.c: * generic/tclUtil.c: * compat/strtod.c: * compat/strtol.c: 2010-04-27 Kevin B. Kenny * unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Simplified the logic so that the casts added in Donal Fellows's change for the same bug are no longer necessary. 2010-04-26 Donal K. Fellows * unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Added an explicit cast because auto-casting between function and non-function types is never naturally warning-free. * generic/tclStubInit.c: Add a small amount of gcc-isms (with #ifdef * generic/tclOOStubInit.c: guards) to ensure that warnings are issued when these files are older than the various *.decls files. 2010-04-25 Miguel Sofer * generic/tclBasic.c: Add unsupported [yieldm] command. Credit * generic/tclInt.h: Lars Hellstrom for the basic idea. 2010-04-24 Miguel Sofer * generic/tclBasic.c: Modify api of TclSpliceTailcall() to fix * generic/tclExecute.c: [yieldTo], which had not survived the latest * generic/tclInt.h: mods to tailcall. Thanks kbk for detecting the problem. 2010-04-23 Jan Nijtmans * unix/tclUnixPort.h: [Bug 2991415]: tclport.h #included before limits.h 2010-04-22 Jan Nijtmans * generic/tclPlatDecls.h: Move TCHAR fallback typedef from tcl.h to * generic/tcl.h: tclPlatDecls.h (as suggested by dgp) * generic/tclInt.h: fix typo * generic/tclIOUtil.c: Eliminate various unnecessary * unix/tclUnixFile.c: type casts. * unix/tclUnixPipe.c: * win/tclWinChan.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclWinLoad.c: * win/tclWinPipe.c: 2010-04-20 Jan Nijtmans * generic/tclTest.c: Use function prototypes from the FS API. * compat/zlib/*: Upgrade to zlib 1.2.5 2010-04-19 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Improve commenting and reduce indentation for the Invocation Block. 2010-04-18 Donal K. Fellows * doc/unset.n: [Bug 2988940]: Fix typo. 2010-04-15 Jan Nijtmans * win/tclWinPort.h: Move inclusion of from * generic/tcl.h: tclPlatDecls.h to tclWinPort.h, where it * generic/tclPlatDecls.h: belongs. Add fallback in tcl.h, so TCHAR is available in win32 always. 2010-04-15 Donal K. Fellows * doc/try.n: [Bug 2987551]: Fix typo. 2010-04-14 Andreas Kupries * library/platform/platform.tcl: Linux platform identification: * library/platform/pkgIndex.tcl: Check /lib64 for existence of files * unix/Makefile.in: matching libc* before accepting it as base * win/Makefile.in: directory. This can happen on weirdly installed 32bit systems which have an empty or partially filled /lib64 without an actual libc. Bumped to version 1.0.6. 2010-04-13 Jan Nijtmans * win/tclWinPort.h: Fix [Patch 2986105]: conditionally defining * win/tclWinFile.c: strcasecmp/strncasecmp * win/tclWinLoad.c: Fix gcc warning: comparison of unsigned expression >= 0 is always true 2010-04-08 Donal K. Fellows * generic/tclCompCmdsSZ.c (TclSubstCompile): If the first token does not result in a *guaranteed* push of a Tcl_Obj on the stack, we must push an empty object. Otherwise it is possible to get to a 'concat1' or 'done' without enough values on the stack, resulting in a crash. Thanks to Joe Mistachkin for identifying a script that could trigger this case. 2010-04-07 Donal K. Fellows * doc/catch.n, doc/info.n, doc/return.n: Formatting. 2010-04-06 Donal K. Fellows * doc/Load.3: Minor corrections of formatting and cross links. 2010-04-06 Jan Nijtmans * win/configure: (regenerate with autoconf-2.59) * unix/configure: * unix/installManPage: [Bug 2982540]: configure and install* script * unix/install-sh: files should always have LF line ending. * doc/Load.3: Fix signature of Tcl_LoadFile in documentation. 2010-04-05 Alexandre Ferrieux TIP #348 IMPLEMENTATION * generic/tclBasic.c: [Patch 2868499]: Substituted error stack * generic/tclCmdIL.c: * generic/tclInt.h: * generic/tclNamesp.c: * generic/tclResult.c: * doc/catch.n: * doc/info.n: * doc/return.n: * tests/cmdMZ.test: * tests/error.test: * tests/execute.test: * tests/info.test: * tests/init.test: * tests/result.test: 2010-04-05 Donal K. Fellows * unix/tcl.m4 (SC_ENABLE_THREADS): Flip the default for whether to * win/tcl.m4 (SC_ENABLE_THREADS): build in threaded mode. Part of * win/rules.vc: TIP #364. * unix/tclLoadDyld.c (FindSymbol): Better human-readable error message generation to match code in tclLoadDl.c. 2010-04-04 Donal K. Fellows * generic/tclIOUtil.c, unix/tclLoadDl.c: Minor changes to enforce Engineering Manual style rules. * doc/FileSystem.3, doc/Load.3: Documentation for TIP#357. * macosx/tclMacOSXBundle.c (OpenResourceMap): [Bug 2981528]: Only define this function when HAVE_COREFOUNDATION is defined. 2010-04-02 Jan Nijtmans * generic/tcl.decls (Tcl_LoadFile): Add missing "const" in signature, * generic/tclIOUtil.c (Tcl_LoadFile): and some formatting fixes * generic/tclDecls.h: (regenerated) 2010-04-02 Donal K. Fellows * generic/tclIOUtil.c (Tcl_LoadFile): Corrections to previous commit * unix/tclLoadDyld.c (TclpDlopen): to make it build on OSX. 2010-04-02 Kevin B. Kenny TIP #357 IMPLEMENTATION TIP #362 IMPLEMENTATION * generic/tclStrToD.c: [Bug 2952904]: Defer creation of the smallest floating point number until it is actually used. (This change avoids a bogus syslog message regarding a 'floating point software assist fault' on SGI systems.) * library/reg/pkgIndex.tcl: [TIP #362]: Fixed first round of bugs * tests/registry.test: resulting from the recent commits of * win/tclWinReg.c: changes in support of the referenced TIP. * generic/tcl.decls: [TIP #357]: First round of changes * generic/tclDecls.h: to export Tcl_LoadFile, * generic/tclIOUtil.c: Tcl_FindSymbol, and Tcl_FSUnloadFile * generic/tclInt.h: to the public API. * generic/tclLoad.c: * generic/tclLoadNone.c: * generic/tclStubInit.c: * tests/fileSystem.test: * tests/load.test: * tests/unload.test: * unix/tclLoadDl.c: * unix/tclLoadDyld.c: * unix/tclLoadNext.c: * unix/tclLoadOSF.c: * unix/tclLoadShl.c: * unix/tclUnixPipe.c: * win/Makefile.in: * win/tclWinLoad.c: 2010-03-31 Donal K. Fellows * doc/registry.n: Added missing documentation of TIP#362 flags. * doc/package.n: [Bug 2980210]: Document the arguments taken by the [package present] command correctly. * doc/Thread.3: Added some better documentation of how to create and use a thread using the C-level thread API, based on realization that no such tutorial appeared to exist. 2010-03-31 Jan Nijtmans * test/cmdMZ.test: [FRQ 2974744]: share exception codes (ObjType?): * test/error.test: Revised test cases, making sure that abbreviated * test/proc-old.test: codes are checked resulting in an error, and checking for the exact error message. 2010-03-30 Andreas Kupries * generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput, (ReflectSeekWide, ReflectWatch, ReflectBlock, ReflectSetOption, (ReflectGetOption, ForwardProc): [Bug 2978773]: Preserve ReflectedChannel* structures across handler invocations, to avoid crashes when the handler implementation induces nested callbacks and destruction of the channel deep inside such a nesting. 2010-03-30 Don Porter * generic/tclObj.c (Tcl_GetCommandFromObj): [Bug 2979402]: Reorder the validity tests on internal rep of a "cmdName" value to avoid invalid reads reported by valgrind. 2010-03-30 Jan Nijtmans * generic/tclIndexObj: [FRQ 2974744]: share exception codes * generic/tclResult.c: further optimization, making use of indexType. * generic/tclZlib.c: [Bug 2979399]: uninitialized value troubles 2010-03-30 Donal K. Fellows TIP #362 IMPLEMENTATION * win/tclWinReg.c: [Patch 2960976]: Apply patch from Damon Courtney to * tests/registry.test: allow the registry command to be told to work * win/Makefile.in: with both 32-bit and 64-bit registries. Bump * win/configure.in: version of registry package to 1.3. * win/makefile.bc: * win/makefile.vc: * win/configure: autoconf-2.59 2010-03-29 Jan Nijtmans * unix/tcl.m4: Only test for -visibility=hidden with gcc (Second remark in [Bug 2976508]) * unix/configure: regen 2010-03-29 Don Porter * generic/tclStringObj.c: Fix array overrun in test format-1.12 caught by valgrind testing. 2010-03-27 Jan Nijtmans * generic/tclInt.h: [FRQ 2974744]: share exception codes * generic/tclResult.c: (ObjType?) * generic/tclCmdMZ.c: * generic/tclCompCmdsSZ.c: 2010-03-26 Jan Nijtmans * generic/tclExecute.c: [Bug 2976508]: Tcl HEAD fails on HP-UX 2010-03-25 Donal K. Fellows * unix/tclUnixFCmd.c (TclUnixCopyFile): [Bug 2976504]: Corrected number of arguments to fstatfs() call. * macosx/tclMacOSXBundle.c, macosx/tclMacOSXFCmd.c: * macosx/tclMacOSXNotify.c: Reduce the level of ifdeffery in the functions of these files to improve readability. They need to be audited for whether complexity can be removed based on the minimum supported version of OSX, but that requires a real expert. 2010-03-24 Don Porter * generic/tclResult.c: [Bug 2383005]: Revise [return -errorcode] so * tests/result.test: that it rejects illegal non-list values. 2010-03-24 Donal K. Fellows * generic/tclOOInfo.c (InfoObjectMethodTypeCmd) (InfoClassMethodTypeCmd): Added introspection of method types so that it is possible to find this info out without using errors. * generic/tclOOMethod.c (procMethodType): Now that introspection can reveal the name of method types, regularize the name of normal methods to be the name of the definition type used to create them. * tests/async.test (async-4.*): Reduce obscurity of these tests by putting the bulk of the code for them inside the test body with the help of [apply]. * generic/tclCmdMZ.c (TryPostBody, TryPostHandler): Make sure that the [try] command does not trap unwinding due to limits. 2010-03-23 Don Porter * generic/tclCmdMZ.c: [Bug 2973361]: Revised fix for computing indices of script arguments to [try]. 2010-03-23 Jan Nijtmans * generic/tclCmdMZ.c: Make error message in "try" implementation * generic/tclCompCmdsSZ.c: exactly the same as the one in "return" * tests/error.test: * libtommath/mtests/mpi.c: Single "const" addition 2010-03-22 Don Porter * generic/tclCmdMZ.c: [Bug 2973361]: Compute the correct integer values to identify the argument indices of the various script arguments to [try]. Passing in -1 led to invalid memory reads. 2010-03-20 Donal K. Fellows * doc/exec.n: Make it a bit clearer that there is an option to run a pipeline in the background. * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Lift the restriction * generic/tclIO.c (TclCopyChannel, CopyData): on the [fcopy] command * generic/tclIO.h (CopyState): that forced it to only copy up to 2GB per script-level callback. Now it is anything that can fit in a (signed) 64-bit integer. Problem identified by Frederic Bonnet on comp.lang.tcl. Note that individual low-level reads and writes are still smaller as the optimal buffer size is smaller. 2010-03-20 Jan Nijtmans * win/stub16.c: Don't hide that we use the ASCII API here. (does someone still use that?) * win/tclWinPipe.c: 2 unnecessary type casts. 2010-03-19 Donal K. Fellows * generic/tclCompCmdsSZ.c (TclCompileThrowCmd): Added compilation for the [throw] command. 2010-03-18 Don Porter * generic/tclListObj.c: [Bug 2971669]: Prevent in overflow trouble in * generic/tclTestObj.c: ListObjReplace operations. Thanks to kbk for * tests/listObj.test: fix and test. 2010-03-18 Donal K. Fellows * generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions): [Bug 2971921]: Corrected jump so that it doesn't skip into the middle of an instruction! Tightened the instruction issuing. Moved endCatch calls closer to their point that they guard, ensuring correct ordering of result values. 2010-03-17 Andreas Kupries * generic/tclIORTrans.c (ReflectInput, ReflectOutput) (ReflectSeekWide): [Bug 2921116]: Added missing TclEventuallyFree calls for preserved ReflectedTransform* structures. Reworked ReflectInput to preserve the structure for its whole life, not only in InvokeTclMethod. * generic/tclIO.c (Tcl_GetsObj): [Bug 2921116]: Regenerate topChan, may have been changed by a self-modifying transformation. * tests/ioTrans/test (iortrans-4.8, iortrans-4.9, iortrans-5.11) (iortrans-7.4, iortrans-8.3): New test cases. 2010-03-16 Jan Nijtmans * compat/zlib/*: Upgrade zlib to version 1.2.4. * win/makefile.vc: * unix/Makefile.in: * win/tclWinChan.c: Don't cast away "const" without reason. 2010-03-12 Jan Nijtmans * win/makefile.vc: [Bug 2967340]: Static build was failing. * win/.cvsignore: 2010-03-10 Jan Nijtmans * generic/tclTest.c: Remove unnecessary '&' decoration for * generic/tclIOUtil.c: function pointers * win/tclWin32Dll.c: Double declaration of TclNativeDupInternalRep * unix/tclIOUtil.c: * unix/dltest/.cvsignore: Ignore *.so here 2010-03-09 Andreas Kupries * generic/tclIORChan.c: [Bug 2936225]: Thanks to Alexandre Ferrieux * doc/refchan.n: for debugging and * tests/ioCmd.test: fixing the problem. It is the write-side equivalent to the bug fixed 2009-08-06. 2010-03-09 Don Porter * library/tzdata/America/Matamoros: New locale * library/tzdata/America/Ojinaga: New locale * library/tzdata/America/Santa_Isabel: New locale * library/tzdata/America/Asuncion: * library/tzdata/America/Tijuana: * library/tzdata/Antarctica/Casey: * library/tzdata/Antarctica/Davis: * library/tzdata/Antarctica/Mawson: * library/tzdata/Asia/Dhaka: * library/tzdata/Pacific/Fiji: Olson tzdata2010c. 2010-03-07 Jan Nijtmans * generic/tclTest.c: Test that tclOO stubs are present in stub library * generic/tclOOMethod.c: Applied missing part of [Patch 2961556] * win/tclWinInt.h: Change all tclWinProcs signatures to use * win/tclWin32Dll.c: TCHAR* in stead of WCHAR*. This is meant * win/tclWinDde.c: as preparation to make [Enh 2965056] * win/tclWinFCmd.c: possible at all. * win/tclWinFile.c: * win/tclWinPipe.c: * win/tclWinSock.c: 2010-03-06 Jan Nijtmans * generic/tclStubLib.c: Remove presence of tclTomMathStubsPtr here. * generic/tclTest.c: Test that tommath stubs are present in stub library. 2010-03-05 Donal K. Fellows * generic/tclIORTrans.c (ForwardProc): [Bug 2964425]: When cleaning the stables, it is sometimes necessary to do more than the minimum. In this case, rationalizing the variables for a forwarded limit? method required removing an extra Tcl_DecrRefCount too. * generic/tclOO.h, generic/tclOOInt.h: [Patch 2961556]: Change TclOO to use the same style of function typedefs as Tcl, as this is about the last chance to get this right. ***POTENTIAL INCOMPATIBILITY*** Source code that uses function typedefs from TclOO will need to update variables and argument definitions so that pointers to the function values are used instead. Binary compatibility is not affected. * generic/*.c, generic/tclInt.h, unix/*.c, macosx/*.c: Applied results of doing a Code Audit. Principal changes: * Use do { ... } while (0) in macros * Avoid shadowing one local variable with another * Use clearer 'foo.bar++;' instead of '++foo.bar;' where result not required (i.e., semantically equivalent); clarity is increased because it is bar that is incremented, not foo. * Follow Engineering Manual rules on spacing and declarations 2010-03-04 Donal K. Fellows * generic/tclOO.c (ObjectRenamedTrace): [Bug 2962664]: Add special handling so that when the class of classes is deleted, so is the class of objects. Immediately. * generic/tclOOInt.h (ROOT_CLASS): Add new flag for specially marking the root class. Simpler and more robust than the previous technique. 2010-03-04 Jan Nijtmans * generic/tclGetDate.y: 3 unnecessary MODULE_SCOPE * generic/tclDate.c: symbols * generic/tclStubLib.c: Split tommath stub lib * generic/tclTomMathStubLib.c: in separate file. * win/makefile.bc: * win/Makefile.in: * win/makefile.vc: * win/tcl.dsp: * unix/Makefile.in: * unix/tcl.m4: Cygwin only gives warning * unix/configure: using -fvisibility=hidden * compat/strncasecmp.c: A few more const's * compat/strtod.c: * compat/strtoul.c: 2010-03-03 Andreas Kupries * doc/refchan.n: Followup to ChangeLog entry 2009-10-07 (generic/tclIORChan.c). Fixed the documentation to explain that errno numbers are operating system dependent, and reworked the associated example. 2010-03-02 Jan Nijtmans * unix/tcl.m4: [FRQ 2959069]: Support for -fvisibility=hidden * unix/configure (regenerated with autoconf-2.59) 2010-03-01 Alexandre Ferrieux * unix/tclUnixSock.c: Refrain from a possibly lengthy reverse-DNS lookup on 0.0.0.0 when calling [fconfigure -sockname] on an universally-bound (default) server socket. * generic/tclIndexObj.c: fix [AT 86258]: special-casing of empty tables when generating error messages for [::tcl::prefix match]. 2010-02-28 Donal K. Fellows * generic/tclCmdIL.c: More additions of {TCL LOOKUP} error-code generation to various subcommands of [info] as part of long-term project to classify all Tcl's generated errors. 2010-02-28 Jan Nijtmans * generic/tclStubInit.c: [Bug 2959713]: Link error with gcc 4.1 2010-02-27 Donal K. Fellows * generic/tclCmdMZ.c (StringFirstCmd, StringLastCmd): [Bug 2960021]: Only search for the needle in the haystack when the needle isn't larger than the haystack. Prevents an odd crash from sometimes happening when things get mixed up (a common programming error). * generic/tclMain.c (Tcl_Main): [Bug 801429]: Factor out the holding of the client-installed main loop function into thread-specific data. ***POTENTIAL INCOMPATIBILITY*** Code that previously tried to set the main loop from another thread will now fail. On the other hand, there is a fairly high probability that such programs would have been failing before due to the lack of any kind of inter-thread memory barriers guarding accesses to this part of Tcl's state. 2010-02-26 Donal K. Fellows * generic/tclCompCmds.c: Split this file into two pieces to make it * generic/tclCompCmdsSZ.c: easier to work with. It's still two very long files even after the split. 2010-02-26 Reinhard Max * doc/safe.n: Name the installed file after the command it documents. Use "Safe Tcl" instead of the "Safe Base", "Safe Tcl" mixture. 2010-02-26 Donal K. Fellows * unix/Makefile.in (NATIVE_TCLSH): Added this variable to allow for better control of what tclsh to use for various scripts when doing cross compiling. An imperfect solution, but works. * unix/installManPage: Remap non-alphanumeric sequences in filenames to single underscores (especially colons). 2010-02-26 Pat Thoyts * tests/zlib.test: Add tests for [Bug 2818131] which was crashing with mismatched zlib algorithms used in combination with gets. This issue has been fixed by Andreas's last commit. 2010-02-25 Jan Nijtmans * generic/tclHash.c: [FRQ 2958832]: Further speed-up of the * generic/tclLiteral.c: ouster-hash function. * generic/tclObj.c: * generic/tclCkalloc.c: Eliminate various unnecessary (ClientData) * generic/tclTest.c: type casts. * generic/tclTestObj.c: * generic/tclTestProcBodyObj.c: * unix/tclUnixTest.c: * unix/tclUnixTime.c: * unix/tclXtTest.c: 2010-02-24 Donal K. Fellows * generic/tclDictObj.c (SetDictFromAny): Prevent the list<->dict * generic/tclListObj.c (SetListFromAny): conversion code from taking too many liberties. Stops loss of duplicate keys in some scenarios. Many thanks to Jean-Claude Wippler for finding this. * generic/tclExecute.c (TclExecuteByteCode): Reduce ifdef-fery and size of activation record. More variables shared across instructions than before. * doc/socket.n: [Bug 2957688]: Clarified that [socket -server] works with a command prefix. Extended example to show this in action. 2010-02-22 Andreas Kupries * generic/tclZlib.c (ZlibTransformInput): [Bug 2762041]: Added a hack to work around the general problem, early EOF recognition based on the base-channel, instead of the data we have ready for reading in the transform. Long-term we need a proper general fix (likely tracking EOF on each level of the channel stack), with attendant complexity. Furthermore, Z_BUF_ERROR can be ignored, and must be when feeding the zlib code with single characters. 2010-02-22 Jan Nijtmans * unix/tclUnixPort.h: Remove unnecessary EXTERN's, which already are in the global stub table. * unix/configure.in: Use @EXEEXT@ in stead of @EXT_SUFFIX@ * unix/tcl.m4: * unix/Makefile.in: Use -DBUILD_tcl for CYGWIN * unix/configure: (regenerated) * unix/dltest/pkg*.c: Use EXTERN to control CYGWIN exported symbols * generic/tclCmdMZ.c: Remove some unnecessary type casts. * generic/tclCompCmds.c: * generic/tclTest.c: * generic/tclUtil.c: 2010-02-21 Mo DeJong * tests/regexp.test: Add test cases back ported from Jacl regexp work. 2010-02-21 Jan Nijtmans * generic/tclDate.c: Some more const tables. * generic/tclGetDate.y: * generic/regc_lex.c: * generic/regerror.c: * generic/tclStubLib.c: * generic/tclBasic.c: Fix [Bug 2954959] expr abs(0.0) is -0.0 * tests/expr.test: 2010-02-20 Donal K. Fellows * generic/tclCompCmds.c (TclCompileStringLenCmd): Make [string length] of a constant string be handled better (i.e., handle backslashes too). 2010-02-19 Stuart Cassoff * tcl.m4: Correct compiler/linker flags for threaded builds on OpenBSD. * configure: (regenerated). 2010-02-19 Donal K. Fellows * unix/installManPage: [Bug 2954638]: Correct behaviour of manual page installer. Also added armouring to check that assumptions about the initial state are actually valid (e.g., look for existing input file). 2010-02-17 Donal K. Fellows * generic/tclHash.c (HashStringKey): Restore these hash functions * generic/tclLiteral.c (HashString): to use the classic algorithm. * generic/tclObj.c (TclHashObjKey): Community felt normal case speed to be more important than resistance to malicious cases. For now, hashes that need to deal with the malicious case can use a custom hash table and install their own hash function, though that is not functionality exposed to the script level. * generic/tclCompCmds.c (TclCompileDictUpdateCmd): Stack depth must be correctly described when compiling a body to prevent crashes in some debugging modes. 2010-02-16 Jan Nijtmans * generic/tclInt.h: Change order of various struct members, fixing potential binary incompatibility with Tcl 8.5 2010-02-16 Donal K. Fellows * unix/configure.in, generic/tclIOUtil.c (Tcl_Stat): Updated so that we do not assume that all unix systems have the POSIX blkcnt_t type, since OpenBSD apparently does not. * generic/tclLiteral.c (HashString): Missed updating to FNV in one place; the literal table (a copy of the hash table code...) 2010-02-15 Jan Nijtmans * tools/genStubs.tcl: Reverted earlier rename from tcl*Stubs to * generic/tclBasic.c: tcl*ConstStubs, it's not necessary at all. * generic/tclOO.c: * generic/tclTomMathInterface.c: * generic/tclStubInit.c: (regenerated) * generic/tclOOStubInit.c: (regenerated) * generic/tclEnsemble.c:Fix signed-unsigned mismatch * win/tclWinInt.h: make tclWinProcs "const" * win/tclWin32Dll.c: * win/tclWinFCmd.c: Eliminate all internal Tcl_WinUtfToTChar * win/tclWinFile.c: and Tcl_WinTCharToUtf calls, needed * win/tclWinInit.c: for mslu support. * win/tclWinLoad.c: * win/tclWinPipe.c: * win/tclWinSerial.c: * win/.cvsignore: * compat/unicows/readme.txt: [FRQ 2819611]: Add first part of MSLU * compat/unicows/license.txt: support. * compat/unicows/unicows.lib: 2010-02-15 Donal K. Fellows * generic/tclOO.c (AllocObject, SquelchedNsFirst, ObjectRenamedTrace): * generic/tclNamesp.c (Tcl_DeleteNamespace): [Bug 2950259]: Revised the namespace deletion code to provide an additional internal callback that gets triggered early enough in namespace deletion to allow TclOO destructors to run sanely. Adjusted TclOO to take advantage of this, so making tearing down an object by killing its namespace appear to work seamlessly, which is needed for Itcl. (Note that this is not a feature that will ever be backported to 8.5, and it remains not a recommended way of deleting an object.) 2010-02-13 Donal K. Fellows * generic/tclCompCmds.c (TclCompileSwitchCmd): Divided the [switch] compiler into three pieces (after the model of [try]): a parser, an instruction-issuer for chained tests, and an instruction-issuer for jump tables. * generic/tclEnsemble.c: Split the ensemble engine out into its own file rather than keeping it mashed together with the namespace code. 2010-02-12 Jan Nijtmans * win/tcl.m4: Use -pipe for gcc on win32 * win/configure: (mingw/cygwin) (regenerated) * win/.cvsignore: Add .lib, .exp and .res here 2010-02-11 Mo DeJong * tests/list.test: Add tests for explicit \0 in a string argument to the list command. 2010-02-11 Donal K. Fellows * generic/tclIOCmd.c (Tcl_OpenObjCmd): [Bug 2949740]: Make sure that we do not try to put a NULL pipeline channel into binary mode. 2010-02-11 Mo DeJong [Bug 2826551, Patch 2948425]: Assorted regexp bugs related to -all, -line and -start options and newlines. * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): If -offset is given, treat it as the start of the line if the previous character was a newline. Fix nasty edge case where a zero length match would not advance the index. * tests/regexp.test: Add regression tests back ported from Jacl. Checks for a number of issues related to -line and newline handling. A few of tests were broken before the patch and continue to be broken, marked as knownBug. 2010-02-11 Donal K. Fellows * generic/tclOO.c (ObjectRenamedTrace): [Bug 2949397]: Prevent destructors from running on the two core class objects when the whole interpreter is being destroyed. 2010-02-09 Donal K. Fellows * generic/tclCompCmds.c (TclCompileTryCmd, IssueTryInstructions) (IssueTryFinallyInstructions): Added compiler for the [try] command. It is split into three pieces that handle the parsing of the tokens, the issuing of instructions for finally-free [try], and the issuing of instructions for [try] with finally; there are enough differences between the all cases that it was easier to split the code rather than have a single function do the whole thing. 2010-02-09 Alexandre Ferrieux * tools/genStubs.tcl: Remove dependency on 8.5+ idiom "in" in expressions. 2010-02-08 Donal K. Fellows * generic/tclZlib.c (Tcl_ZlibDeflate, Tcl_ZlibInflate): [Bug 2947783]: Make sure that the result is an unshared object before appending to it so that nothing crashes if it is shared (use in Tcl code was not affected by this, but use from C was an issue). 2010-02-06 Donal K. Fellows * generic/tclHash.c (HashStringKey): Replace Tcl's crusty old hash * generic/tclObj.c (TclHashObjKey): function with the algorithm due to Fowler, Noll and Vo. This is slightly faster (assuming the presence of hardware multiply) and has somewhat better distribution properties of the resulting hash values. Note that we only ever used the 32-bit version of the FNV algorithm; Tcl's core hash engine assumes that hash values are simple unsigned ints. ***POTENTIAL INCOMPATIBILITY*** Code that depends on hash iteration order (especially tests) may well be disrupted by this. Where a definite order is required, the fix is usually to just sort the results after extracting them from the hash. Where this is insufficient, the code that has ceased working was always wrong and was only working by chance. 2010-02-05 Donal K. Fellows * generic/tclCompCmds.c (TclCompileErrorCmd): Added compilation of the [error] command. No new bytecodes. 2010-02-05 Jan Nijtmans * tools/genStubs.tcl: Follow-up to earlier commit today: Eliminate the need for an extra Stubs Pointer for adressing a static stub table: Just change the exported table from static to MODULE_SCOPE. * generic/tclBasic.c * generic/tclOO.c * generic/tclTomMathInterface.c * generic/tcl*Decls.h (regenerated) * generic/tclStubInit.c (regenerated) * generic/tclOOStubInit.c (regenerated) * generic/tclTest.c (minor formatting) 2010-02-05 Donal K. Fellows * generic/tclVar.c: More consistency in errorcode generation. * generic/tclOOBasic.c (TclOO_Object_Destroy): Rewrote to be NRE-aware when calling destructors. Note that there is no guarantee that destructors will always be called in an NRE context; that's a feature of the 'destroy' method only. * generic/tclEncoding.c: Add 'const' to many function-internal vars that are never pointing to things that are written to. 2010-02-05 Jan Nijtmans * tools/genStubs.tcl: Follow-up to [2010-01-29] commit: prevent space within stub table function parameters if the parameter type is a pointer. * win/tclWinInt.h: Minor Formatting * generic/tcl.h: VOID -> void and other formatting * generic/tclInt.h: Minor formatting * generic/tclInt.decls: Change signature of TclNRInterpProcCore, * generic/tclOO.decls: and TclOONewProc(Instance|)MethodEx, * generic/tclProc.c: indicating that errorProc is a function, * generic/tclOOMethod.c:pointer, and other formatting * generic/tcl*Decls.h: (regenerated) * generic/tclVar.c: gcc warning(line 3703): 'pattern' may be used uninitialized in this function gcc warning(line 3788): 'matched' may be used uninitialized in this function 2010-02-04 Donal K. Fellows * generic/tclVar.c: Added more use of error-codes and reduced the stack overhead of older interfaces. (ArrayGetCmd): Stop silly crash when using a trivial pattern due to error in conversion to ensemble. (ArrayNamesCmd): Use the object RE interface for faster matching. 2010-02-03 Donal K. Fellows * generic/tclVar.c (ArrayUnsetCmd): More corrections. 2010-02-02 Donal K. Fellows * generic/tclVar.c: Turned the [array] command into a true ensemble. * generic/tclOO.c (AllocObject, MyDeleted): A slightly faster way to handle the deletion of [my] is with a standard delete callback. This is because it doesn't require an additional memory allocation during object creation. Also reduced the amount of string manipulation performed during object creation to further streamline memory handling; this is not backported to the 8.5 package as it breaks a number of abstractions. * generic/tclOOBasic.c (TclOO_Object_Destroy): [Bug 2944404]: Do not crash when a destructor deletes the object that is executing that destructor. 2010-02-01 Donal K. Fellows * generic/tclVar.c (Tcl_ArrayObjCmd): [Bug 2939073]: Stop the [array unset] command from having dangling pointer problems when an unset trace deletes the element that is going to be processed next. Many thanks to Alexandre Ferrieux for the bulk of this fix. * generic/regexec.c (ccondissect, crevdissect): [Bug 2942697]: Rework these functions so that certain pathological patterns are matched much more rapidly. Many thanks to Tom Lane for dianosing this issue and providing an initial patch. 2010-01-30 Donal K. Fellows * generic/tclCompile.c (tclInstructionTable): Bytecode instructions * generic/tclCompCmds.c (TclCompileUnsetCmd): to allow the [unset] * generic/tclExecute.c (TclExecuteByteCode): command to be compiled with the compiler being a complete compilation for all compile-time decidable uses. * generic/tclVar.c (TclPtrUnsetVar): Var reference version of the code to unset a variable. Required for INST_UNSET bytecodes. 2010-01-29 Jan Nijtmans * generic/tcl.h: [Bug 2942081]: Reverted Tcl_ThreadDataKey type change Changed some Tcl_CallFrame fields from "char *" to "void *". This saves unnecessary space on Cray's (and it's simply more correct). * tools/genStubs.tcl: No longer generate a space after "*" and immediately after a function name, so the format of function definitions in tcl*Decls.h match all other tcl*.h header files. * doc/ParseArgs.3: Change Tcl_ArgvFuncProc, Tcl_ArgvGenFuncProc * generic/tcl.h: and GetFrameInfoValueProc to be function * generic/tclInt.h: definitions, not pointers, for consistency * generic/tclOOInt.h: with all other Tcl function definitions. * generic/tclIndexObj.c: * generic/regguts.h: CONST -> const * generic/tcl.decls: Formatting * generic/tclTomMath.decls: Formatting * generic/tclDecls.h: (regenerated) * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclOODecls.h: * generic/tclOOIntDecls.h: * generic/tclPlatDecls.h: * generic/tclTomMathDecls.h: 2010-01-28 Donal K. Fellows * generic/tclOOBasic.c (TclOO_Object_Destroy): Move the execution of destructors to a point where they can produce an error. This will not work for all destructors, but it does mean that more failing calls of them will be caught. * generic/tclOO.c (AllocObject, MyDeletedTrace, ObjectRenamedTrace): (ObjectNamespaceDeleted): Stop various ways of getting at commands with dangling pointers to the object. Also increases the reliability of calling of destructors (though most destructors won't benefit; when an object is deleted namespace-first, its destructors are not run in a nice state as the namespace is partially gone). 2010-01-25 Jan Nijtmans * generic/tclOOStubInit.c: Remove double includes (which causes a * generic/tclOOStubLib.c: warning in CYGWIN compiles) * unix/.cvsignore: add confdefs.h 2010-01-22 Donal K. Fellows * doc/proc.n: [Bug 1970629]: Define a bit better what the current namespace of a procedure is. 2010-01-22 Jan Nijtmans * generic/tclInt.decls: Don't use DWORD and HANDLE here. * generic/tclIntPlatDecls.h: * generic/tcl.h: Revert [2009-12-21] change, instead * generic/tclPort.h: resolve the CYGWIN inclusion problems by * win/tclWinPort.h: re-arranging the inclusions at other places. * win/tclWinError.c * win/tclWinPipe.c * win/tcl.m4: Make cygwin configuration error into * win/configure.in: a warning: CYGWIN compilation works * win/configure: although there still are test failures. 2010-01-22 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Improve error code generation from some of the tailcall-related bits of TEBC. 2010-01-21 Miguel Sofer * generic/tclCompile.h: [Bug 2910748]: NRE-enable direct eval on BC * generic/tclExecute.c: spoilage. * tests/nre.test: 2010-01-19 Donal K. Fellows * doc/dict.n: [Bug 2929546]: Clarify just what [dict with] and [dict update] are doing with variables. 2010-01-18 Andreas Kupries * generic/tclIO.c (CreateScriptRecord): [Bug 2918110]: Initialize the EventScriptRecord (esPtr) fully before handing it to Tcl_CreateChannelHandler for registration. Otherwise a reflected channel calling 'chan postevent' (== Tcl_NotifyChannel) in its 'watchProc' will cause the function 'TclChannelEventScriptInvoker' to be run on an uninitialized structure. 2010-01-18 Donal K. Fellows * generic/tclStringObj.c (Tcl_AppendFormatToObj): [Bug 2932421]: Stop the [format] command from causing argument objects to change their internal representation when not needed. Thanks to Alexandre Ferrieux for this fix. 2010-01-13 Donal K. Fellows * tools/tcltk-man2html.tcl: More factoring out of special cases * tools/tcltk-man2html-utils.tcl: so that they are described outside the engine file. Now there is only one real set of special cases in there, to handle the .SO/.OP/.SE directives. 2010-01-13 Jan Nijtmans * generic/tcl.h: Fix TCL_LL_MODIFIER for Cygwin * generic/tclEnv.c: Fix CYGWIN compilation problems, * generic/tclInt.h: and remove some unnecessary * generic/tclPort.h: double includes. * generic/tclPlatDecls.h: * win/cat.c: * win/tclWinConsole.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclWinPipe.c: * win/tclWinSerial.c: * win/tclWinThrd.c: * win/tclWinPort.h: Put win32 includes first * unix/tclUnixChan.c: Forgot one CONST change 2010-01-12 Donal K. Fellows * tools/tcltk-man2html.tcl: Make the generation of the list of things to process the docs from simpler and more flexible. Also factored out the lists of special cases. 2010-01-10 Jan Nijtmans * win/tclWinDde.c: VC++ 6.0 doesn't have * win/tclWinReg.c: PDWORD_PTR * win/tclWinThrd.c: Fix various minor gcc warnings. * win/tclWinTime.c: * win/tclWinConsole.c: Put channel type definitions * win/tclWinChan.c: in static const memory * win/tclWinPipe.c: * win/tclWinSerial.c: * win/tclWinSock.c: * generic/tclIOGT.c: * generic/tclIORChan.c: * generic/tclIORTrans.c: * unix/tclUnixChan.c: * unix/tclUnixPipe.c: * unix/tclUnixSock.c: * unix/configure: (regenerated with autoconf 2.59) * tests/info.test: Make test independant from tcltest implementation. 2010-01-10 Donal K. Fellows * tests/namespace.test (namespace-51.17): [Bug 2898722]: Demonstrate that there are still bugs in the handling of resolution epochs. This bug is not yet fixed. * tools/tcltk-man2html.tcl: Split the man->html converter into * tools/tcltk-man2html-utils.tcl: two pieces for easier maintenance. Also made it much less verbose in its printed messages by default. 2010-01-09 Donal K. Fellows * tools/tcltk-man2html.tcl: Added basic support for building the docs for contributed packages into the HTML versions. Prompted by question on Tcler's Chat by Tom Krehbiel. Note that there remain problems in the documentation generated due to errors in the contributed docs. 2010-01-05 Don Porter * generic/tclPathObj.c (TclPathPart): [Bug 2918610]: Correct * tests/fileName.test (filename-14.31): inconsistency between the string rep and the intrep of a path value created by [file rootname]. Thanks to Vitaly Magerya for reporting. 2010-01-03 Donal K. Fellows * unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 1636685]: Use the configuration for modern FreeBSD suggested by the FreeBSD porter. 2010-01-03 Miguel Sofer * generic/tclBasic.c: [Bug 2724403]: Fix leak of coroutines on * generic/tclCompile.h: namespace deletion. Added a test for this * generic/tclNamesp.c: leak, and also a test for leaks on namespace * tests/coroutine.test: deletion. * tests/namespace.test: 2009-12-30 Donal K. Fellows * library/safe.tcl (AliasSource): [Bug 2923613]: Make the safer * tests/safe.test (safe-8.9): [source] handle a [return] at the end of the file correctly. 2009-12-30 Miguel Sofer * library/init.tcl (unknown): [Bug 2824981]: Fix infinite recursion of ::unknown when [set] is undefined. 2009-12-29 Donal K. Fellows * generic/tclHistory.c (Tcl_RecordAndEvalObj): Reduce the amount of allocation and deallocation of memory by caching objects in the interpreter assocData table. * generic/tclObj.c (Tcl_GetCommandFromObj): Rewrite the logic so that it does not require making assignments part way through an 'if' condition, which was deeply unclear. * generic/tclInterp.c (Tcl_MakeSafe): [Bug 2895741]: Make sure that the min() and max() functions are supported in safe interpreters. 2009-12-29 Pat Thoyts * generic/tclBinary.c: [Bug 2922555]: Handle completely invalid input * tests/binary.test: to the decode methods. 2009-12-28 Donal K. Fellows * unix/Makefile.in (trace-shell, trace-test): [FRQ 1083288]: Added targets to allow easier tracing of shell and test invocations. * unix/configure.in: [Bug 942170]: Detect the st_blocks field of * generic/tclCmdAH.c (StoreStatData): 'struct stat' correctly. * generic/tclFileName.c (Tcl_GetBlocksFromStat): * generic/tclIOUtil.c (Tcl_Stat): * generic/tclInterp.c (TimeLimitCallback): [Bug 2891362]: Ensure that * tests/interp.test (interp-34.13): the granularity ticker is reset when we check limits because of the time limit event firing. 2009-12-27 Donal K. Fellows * doc/namespace.n (SCOPED SCRIPTS): [Bug 2921538]: Updated example to not be quite so ancient. 2009-12-25 Jan Nijtmans * generic/tclCmdMZ.c: CONST -> const * generic/tclParse.c 2009-12-23 Donal K. Fellows * library/safe.tcl (AliasSource, AliasExeName): [Bug 2913625]: Stop information about paths from leaking through [info script] and [info nameofexecutable]. 2009-12-23 Jan Nijtmans * unix/tcl.m4: Install libtcl8.6.dll in bin directory * unix/Makefile.in: * unix/configure: (regenerated) 2009-12-22 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsortObjCmd): [Bug 2918962]: Stop crash when -index and -stride are used together. 2009-12-21 Jan Nijtmans * generic/tclThreadStorage.c: Fix gcc warning, using gcc-4.3.4 on cygwin: missing initializer * generic/tclOOInt.h: Prevent conflict with DUPLICATE definition in WINAPI's nb30.h * generic/rege_dfa.c: Fix macro conflict on CYGWIN: don't use "small". * generic/tcl.h: Include before on CYGWIN * generic/tclPathObj.c * generic/tclPort.h * tests/env.test: Don't unset WINDIR and TERM, it has a special meaning on CYGWIN (both in UNIX and WIN32 mode!) * generic/tclPlatDecls.h: Include through tclPlatDecls.h * win/tclWinPort.h: stricmp -> strcasecmp * win/tclWinDde.c: _wcsicmp -> wcscasecmp * win/tclWinFile.c * win/tclWinPipe.c * win/tclWinSock.c * unix/tcl.m4: Add dynamic loading support to CYGWIN * unix/configure (regenerated) * unix/Makefile.in 2009-12-19 Miguel Sofer * generic/tclBasic.c: [Bug 2917627]: Fix for bad cmd resolution by * tests/coroutine.test: coroutines. Thanks to schelte for finding it. 2009-12-16 Donal K. Fellows * library/safe.tcl (::safe::AliasGlob): Upgrade to correctly support a larger fraction of [glob] functionality, while being stricter about directory management. 2009-12-11 Jan Nijtmans * generic/tclTest.c: Fix gcc warning: ignoring return value of * unix/tclUnixNotify.c: "write", declared with attribute * unix/tclUnixPipe.c: warn_unused_result. * generic/tclInt.decls: CONSTify functions TclpGetUserHome and * generic/tclIntDecls.h:TclSetPreInitScript (TIP #27) * generic/tclInterp.c: * win/tclWinFile.c: * unix/tclUnixFile.c: 2009-12-16 Donal K. Fellows * doc/tm.n: [Bug 1911342]: Formatting rewrite to avoid bogus crosslink to the list manpage when generating HTML. * library/msgcat/msgcat.tcl (Init): [Bug 2913616]: Do not use platform tests that are not needed and which don't work in safe interpreters. 2009-12-14 Donal K. Fellows * doc/file.n (file tempfile): [Bug 2388866]: Note that this only ever creates files on the native filesystem. This is a design feature. 2009-12-13 Miguel Sofer * generic/tclBasic.c: Release TclPopCallFrame() from its * generic/tclExecute.c: tailcall-management duties * generic/tclNamesp.c: * generic/tclBasic.c: Moving TclBCArgumentRelease call from * generic/tclExecute.c: TclNRTailcallObjCmd to TEBC, so that the pairing of the Enter and Release calls is clearer. 2009-12-12 Donal K. Fellows * generic/tclTest.c (TestconcatobjCmd): [Bug 2895367]: Stop memory leak when testing. We don't need extra noise of this sort when tracking down real problems! 2009-12-11 Jan Nijtmans * generic/tclBinary.c: Fix gcc warning, using gcc-4.3.4 on cygwin * generic/tclCompExpr.c:warning: array subscript has type 'char' * generic/tclPkg.c: * libtommath/bn_mp_read_radix.c: * win/makefile.vc: [Bug 2912773]: Revert to version 1.203 * unix/tclUnixCompat.c: Fix gcc warning: signed and unsigned type in conditional expression. 2009-12-11 Donal K. Fellows * tools/tcltk-man2html.tcl (long-toc, cross-reference): [FRQ 2897296]: Added cross links to sections within manual pages. 2009-12-11 Miguel Sofer * generic/tclBasic.c: [Bug 2806407]: Full nre-enabling of coroutines * generic/tclExecute.c: * generic/tclBasic.c: Small cleanup * generic/tclExecute.c: Fix panic in http11.test caused by buggy earlier commits in coroutine management. 2009-12-10 Andreas Kupries * generic/tclObj.c (TclContinuationsEnter): [Bug 2895323]: Updated comments to describe when the function can be entered for the same Tcl_Obj* multiple times. This is a continuation of the 2009-11-10 entry where a memory leak was plugged, but where not sure if that was just a band-aid to paper over some other error. It isn't, this is a legal situation. 2009-12-10 Miguel Sofer * generic/tclBasic.c: Reducing the # of moving parts for coroutines * generic/tclExecute.c: by delegating more to tebc; eliminate the special coroutine CallFrame. 2009-12-09 Andreas Kupries * generic/tclIO.c: [Bug 2901998]: Applied Alexandre Ferrieux's patch fixing the inconsistent buffered I/O. Tcl's I/O now flushes buffered output before reading, discards buffered input before writing, etc. 2009-12-09 Miguel Sofer * generic/tclBasic.c: Ensure right lifetime of varFrame's (objc,objv) for coroutines. * generic/tclExecute.c: Code regrouping 2009-12-09 Donal K. Fellows * generic/tclBasic.c: Added some of the missing setting of errorcode values. 2009-12-08 Miguel Sofer * generic/tclExecute.c (TclStackFree): Improved panic msg. 2009-12-08 Miguel Sofer * generic/tclBasic.c: Partial nre-enabling of coroutines. The * generic/tclExecute.c: initial call still requires its own * generic/tclInt.h: instance of tebc, but on resume coros can execute in the caller's tebc. * generic/tclExecute.c (TEBC): Silence warning about pcAdjustment. 2009-12-08 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Make the dict opcodes more sparing in their use of C variables, to reduce size of TEBC activiation record a little bit. 2009-12-07 Miguel Sofer * generic/tclExecute.c (TEBC): Grouping "slow" variables into structs, to reduce register pressure and help the compiler with variable allocation. 2009-12-07 Miguel Sofer * generic/tclExecute.c: Start cleaning the TEBC stables * generic/tclInt.h: * generic/tclCmdIL.c: [Bug 2910094]: Fix by aku * tests/coroutine.test: * generic/tclBasic.c: Arrange for [tailcall] to be created with the other builtins: was being created in a separate call, leftover from pre-tip days. 2009-12-07 Don Porter * generic/tclStrToD.c: [Bug 2902010]: Correct conditional compile directives to better detect the toolchain that needs extra work for proper underflow treatment instead of merely detecting the MIPS platform. 2009-12-07 Miguel Sofer * generic/tclBasic.c: [Patch 2910056]: Add ::tcl::unsupported::yieldTo * generic/tclInt.h: 2009-12-07 Donal K. Fellows * generic/tclCmdMZ.c (TryPostBody): [Bug 2910044]: Close off memory leak in [try] when a variable-free handler clause is present. 2009-12-05 Miguel Sofer * generic/tclBasic.c: Small changes for clarity in tailcall * generic/tclExecute.c: and coroutine code. * tests/coroutine.test: * tests/tailcall.test: Remove some old unused crud; improved the stack depth tests. * generic/tclBasic.c: Fixed things so that you can tailcall * generic/tclNamesp.c: properly out of a coroutine. * tests/tailcall.test: * generic/tclInterp.c: Fixed tailcalls for same-interp aliases (no test) 2009-12-03 Donal K. Fellows * library/safe.tcl (::safe::AliasEncoding): Make the safe encoding command behave more closely like the unsafe one (for safe ops). (::safe::AliasGlob): [Bug 2906841]: Clamp down on evil use of [glob] in safe interpreters. * tests/safe.test: Rewrite to use tcltest2 better. 2009-12-02 Jan Nijtmans * tools/genStubs.tcl: Add support for win32 CALLBACK functions and remove obsolete "emitStubs" and "genStubs" functions. * win/Makefile.in: Use tcltest86.dll for all tests, and add .PHONY rules to preemptively stop trouble that plagued Tk from hitting Tcl too. 2009-11-30 Jan Nijtmans * generic/tcl.h: Don't use EXPORT for Tcl_InitStubs * win/Makefile.in: Better dependancies in case of static build. 2009-11-30 Donal K. Fellows * doc/Tcl.n: [Bug 2901433]: Improved description of expansion to mention that it is using list syntax. 2009-11-27 Kevin B. Kenny * win/tclAppInit.c (Tcl_AppInit): [Bug 2902965]: Reverted Jan's change that added a call to Tcl_InitStubs. The 'tclsh' and 'tcltest' programs are providers, not consumers of the Stubs table, and should not link with the Stubs library, but only with the main Tcl library. (In any case, the presence of Tcl_InitStubs broke the build.) 2009-11-27 Donal K. Fellows * doc/BoolObj.3, doc/Class.3, doc/CrtChannel.3, doc/DictObj.3: * doc/DoubleObj.3, doc/Ensemble.3, doc/Environment.3: * doc/FileSystem.3, doc/Hash.3, doc/IntObj.3, doc/Limit.3: * doc/Method.3, doc/NRE.3, doc/ObjectType.3, doc/PkgRequire.3: * doc/SetChanErr.3, doc/SetResult.3: [Patch 2903921]: Many small spelling fixes from Larry Virden. BUMP VERSION OF TCLOO TO 0.6.2. Too many people need accumulated small versions and bugfixes, so the version-bump removes confusion. * generic/tclOOBasic.c (TclOO_Object_LinkVar): [Bug 2903811]: Remove unneeded restrictions on who can usefully call this method. 2009-11-26 Donal K. Fellows * unix/Makefile.in: Add .PHONY rules and documentation to preemptively stop trouble that plagued Tk from hitting Tcl too, and to make the overall makefile easier to understand. Some reorganization too to move related rules closer together. 2009-11-26 Jan Nijtmans * win/Makefile.in: [Bug 2902965]: Fix stub related changes that * win/makefile.vc: caused tclkit build to break. * win/tclAppInit.c * unix/tcl.m4 * unix/Makefile.in * unix/tclAppInit.c * unix/configure: (regenerated) 2009-11-25 Kevin B. Kenny * win/Makefile.in: Added a 'test-tcl' rule that is identical to 'test' except that it does not go spelunking in 'pkgs/'. (This rule has existed in unix/Makefile.in for some time.) 2009-11-25 Stuart Cassoff * unix/configure.in: [Patch 2892871]: Remove unneeded * unix/tcl.m4: AC_STRUCT_TIMEZONE and use * unix/tclConfig.h.in: AC_CHECK_MEMBERS([struct stat.st_blksize]) * unix/tclUnixFCmd.c: instead of AC_STRUCT_ST_BLKSIZE. * unix/configure: Regenerated with autoconf-2.59. 2009-11-24 Andreas Kupries * library/tclIndex: Manually redone the part of tclIndex dealing with safe.tcl and tm.tcl. This part passes the testsuite. Note that automatic regeneration of this part is not possible because it wrongly puts 'safe::Setup' on the list, and wrongly leaves out 'safe::Log' which is more dynamically created than the generator expects. Further note that the file "clock.tcl" is explicitly loaded by "init.tcl", the first time the clock command is invoked. The relevant code can be found at line 172ff, roughly, the definition of the procedure 'clock'. This means none of the procedures of this file belong in the tclIndex. Another indicator that automatic regeneration of tclIndex is ill-advised. 2009-11-24 Donal K. Fellows * generic/tclOO.c (FinalizeAlloc, Tcl_NewObjectInstance): [Bug 2903011]: Make it an error to destroy an object in a constructor, and also make sure that an object is not deleted twice in the error case. 2009-11-24 Pat Thoyts * tests/fCmd.test: [Bug 2893771]: Teach [file stat] to handle locked * win/tclWinFile.c: files so that [file exists] no longer lies. 2009-11-23 Kevin Kenny * tests/fCmd.test (fCmd-30.1): Changed registry location of the 'My Documents' folder to the one that's correct for Windows 2000, XP, Server 2003, Vista, Server 2008, and Windows 7. (See http://support.microsoft.com/kb/310746) 2009-11-23 Jan Nijtmans * win/tclWinDde.c: #undef STATIC_BUILD, in order to make sure * win/tclWinReg.c: that Xxxxx_Init is always exported even when * generic/tclTest.c: Tcl is built static (otherwise we cannot create a DLL). * generic/tclThreadTest.c: Make all functions static, except TclThread_Init. * tests/fCmd.test: Enable fCmd-30.1 when registry is available. * win/tcl.m4: Fix ${SHLIB_LD_LIBS} definition, fix conflicts * win/Makefile.in: Simplifications related to tcl.m4 changes. * win/configure.in: Between static libraries and import library on windows. * win/configure: (regenerated) * win/makefile.vc: Add stub library to necessary link lines. 2009-11-23 Kevin B. Kenny * generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Further machinations to get NewTestThread actually to launch the thread, not just compile. 2009-11-22 Donal K. Fellows * generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Fix small error in function naming which blocked a threaded test build. 2009-11-19 Jan Nijtmans * win/Makefile.in: Create tcltest86.dll as dynamic Tcltest package. * generic/tclTest.c: Remove extraneous prototypes, follow-up to * generic/tclTestObj.c: [Bug 2883850] * tests/chanio.test: Test-cases for fixed [Bug 2849797] * tests/io.test: * tests/safe.test: Fix safe-10.1 and safe-10.4 test cases, making the wrong assumption that Tcltest is a static package. * generic/tclEncoding.c:[Bug 2857044]: Updated freeIntRepProc routines * generic/tclVar.c: so that they set the typePtr field to NULL so that the Tcl_Obj is not left in an inconsistent state. * unix/tcl.m4: [Patch 2883533]: tcl.m4 support for Haiku OS * unix/configure: autoconf-2.59 2009-11-19 Don Porter * unix/tclAppInit.c: [Bug 2883850, 2900542]: Repair broken build of * win/tclAppInit.c: the tcltest executable. 2009-11-19 Donal K. Fellows * library/auto.tcl (tcl_findLibrary): * library/clock.tcl (MakeUniquePrefixRegexp, MakeParseCodeFromFields) (SetupTimeZone, ProcessPosixTimeZone): Restored the use of a literal * library/history.tcl (HistAdd): 'then' when following a multi- * library/safe.tcl (interpConfigure): line test expresssion. It's an * library/tm.tcl (UnknownHandler): aid to readability then. 2009-11-19 Jan Nijtmans * generic/tclInt.h: Make all internal initialization * generic/tclTest.c: routines MODULE_SCOPE * generic/tclTestObj.c: * generic/tclTestProcBodyObj.c: * generic/tclThreadTest.c: * unix/Makefile.in: Fix [Bug 2883850]: pkgIndex.tcl doesn't * unix/tclAppInit.c: get created with static Tcl build * unix/tclXtTest.c: * unix/tclXtNotify.c: * unix/tclUnixTest.c: * win/Makefile.in: * win/tcl.m4: * win/configure: (regenerated) * win/tclAppInit.c: * win/tclWinDde.c: Always compile with Stubs. * win/tclWinReg.c: * win/tclWinTest.c: 2009-11-18 Jan Nijtmans * doc/CrtChannel.3: [Bug 2849797]: Fix channel name inconsistences * generic/tclIORChan.c: as suggested by DKF. * generic/tclIO.c: Minor *** POTENTIAL INCOMPATIBILITY *** because Tcl_CreateChannel() and derivatives now sometimes ignore their "chanName" argument. * generic/tclAsync.c: Eliminate various gcc warnings (with -Wextra) * generic/tclBasic.c * generic/tclBinary.c * generic/tclCmdAH.c * generic/tclCmdIL.c * generic/tclCmdMZ.c * generic/tclCompile.c * generic/tclDate.c * generic/tclExecute.c * generic/tclDictObj.c * generic/tclIndexObj.c * generic/tclIOCmd.c * generic/tclIOUtil.c * generic/tclIORTrans.c * generic/tclOO.c * generic/tclZlib.c * generic/tclGetDate.y * win/tclWinInit.c * win/tclWinChan.c * win/tclWinConsole.c * win/tclWinNotify.c * win/tclWinReg.c * library/auto.tcl: Eliminate "then" keyword * library/clock.tcl * library/history.tcl * library/safe.tcl * library/tm.tcl * library/http/http.tcl: Eliminate unnecessary spaces * library/http1.0/http.tcl * library/msgcat/msgcat.tcl * library/opt/optparse.tcl * library/platform/platform.tcl * tools/tcltk-man2html.tcl * tools/tclZIC.tcl * tools/tsdPerf.c 2009-11-17 Andreas Kupries * unix/tclUnixChan.c (TtyParseMode): Partial undo of Donal's tidy-up from a few days ago (2009-11-9, not in ChangeLog). It seems that strchr is apparently a macro on AIX and reacts badly to preprocessor directives in its arguments. 2009-11-16 Alexandre Ferrieux * generic/tclEncoding.c: [Bug 2891556]: Fix and improve test to * generic/tclTest.c: detect similar manifestations in the future. * tests/encoding.test: Add tcltest support for finalization. 2009-11-15 Mo DeJong * win/tclWinDde.c: Avoid gcc compiler warning by explicitly casting DdeCreateStringHandle argument. 2009-11-12 Andreas Kupries * generic/tclIO.c (CopyData): [Bug 2895565]: Dropped bogosity which * tests/io.test: used the number of _written_ bytes or character to update the counters for the read bytes/characters. New test io-53.11. This is a forward port from the 8.5 branch. 2009-11-11 Don Porter * generic/tclClock.c (TclClockInit): Do not create [clock] support commands in safe interps. 2009-11-11 Jan Nijtmans * library/http/http.tcl (http::geturl): [Bug 2891171]: URL checking too strict when using multiple question marks. * tests/http.test * library/http/pkgIndex.tcl: Bump to http 2.8.2 * unix/Makefile.in: * win/Makefile.in: 2009-11-11 Alexandre Ferrieux * generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) by saving the errno from the first of two FlushChannel()s. Uneasy to test; might need specific channel drivers. Four-hands with aku. 2009-11-10 Pat Thoyts * tests/winFCmd.test: Cleanup directories that have been set chmod 000. On Windows7 and Vista we really have no access and these were getting left behind. A few tests were changed to reflect the intent of the test where setting a directory chmod 000 should prevent any modification. This restriction was ignored on XP but is honoured on Vista 2009-11-10 Andreas Kupries * generic/tclBasic.c: Plug another leak in TCL_EVAL_DIRECT evaluation. Forward port from Tcl 8.5 branch, change by Don Porter. * generic/tclObj.c: [Bug 2895323]: Plug memory leak in TclContinuationsEnter(). Forward port from Tcl 8.5 branch, change by Don Porter. 2009-11-09 Stuart Cassoff * win/README: [bug 2459744]: Removed outdated Msys + Mingw info. 2009-11-09 Andreas Kupries * generic/tclBasic.c (TclEvalObjEx): Moved the #280 decrement of refCount for the file path out of the branch after the whole conditional, closing a memory leak. Added clause on structure type to prevent seg.faulting. Forward port from valgrinding the Tcl 8.5 branch. * tests/info.test: Resolve ambiguous resolution of variable "res". Forward port from 8.5 2009-11-08 Donal K. Fellows * doc/string.n (bytelength): Noted that this command is not a good thing to use, and suggested a better alternatve. Also factored out the description of the indices into its own section. 2009-11-07 Pat Thoyts * tests/fCmd.test: [Bug 2891026]: Exclude tests using chmod 555 directories on vista and win7. The current user has access denied and so cannot rename the directory without admin privileges. 2009-11-06 Andreas Kupries * library/safe.tcl (::safe::Setup): Added documentation of the contents of the state array. Also killed the 'InterpState' procedure with its upleveled variable/upvar combination, and replaced all uses with 'namespace upvar'. 2009-11-05 Andreas Kupries * library/safe.tcl: A series of patches which bring the SafeBase up to date with code guidelines, Tcl's features, also eliminating a number of inefficiencies along the way. (1) Changed all procedure names to be fully qualified. (2) Moved the procedures out of the namespace eval. Kept their locations. IOW, broke the namespace eval apart into small sections not covering the procedure definitions. (3) Reindented the code. Just lots of whitespace changes. Functionality unchanged. (4) Moved the multiple namespace eval's around. Command export at the top, everything else (var decls, argument parsing setup) at the bottom. (5) Moved the argument parsing setup into a procedure called when the code is loaded. Easier management of temporary data. (6) Replaced several uses of 'Set' with calls to the new procedure 'InterpState' and direct access to the per-slave state array. (7) Replaced the remaining uses of 'Set' and others outside of the path/token handling, and deleted a number of procedures related to state array access which are not used any longer. (8) Converted the path token system to cache normalized paths and path <-> token conversions. Removed more procedures not used any longer. Removed the test cases 4.3 and 4.4 from safe.test. They were testing the now deleted command "InterpStateName". (9) Changed the log command setup so that logging is compiled out completely when disabled (default). (10) Misc. cleanup. Inlined IsInterp into CheckInterp, its only user. Consistent 'return -code error' for error reporting. Updated to use modern features (lassign, in/ni, dicts). The latter are used to keep a reverse path -> token map and quicker check of existence. (11) Fixed [Bug 2854929]: Recurse into all subdirs under all TM root dirs and put them on the access path. 2009-11-02 Kevin B. Kenny * library/tzdata/Asia/Novokuznetsk: New tzdata locale for Kemerovo oblast', which now keeps Novosibirsk time and not Kranoyarsk time. * library/tzdata/Asia/Damascus: Syrian DST changes. * library/tzdata/Asia/Hong_Kong: Hong Kong historic DST corrections. Olson tzdata2009q. 2009-11-02 Donal K. Fellows * doc/object.n (DESCRIPTION): Substantive revision to make it clearer what the fundamental semantics of an object actually are. 2009-11-01 Joe Mistachkin * doc/Cancel.3: Minor cosmetic fixes. * win/makefile.vc: Make htmlhelp target work again. An extra set of double quotes around the definition of the HTML help compiler tool appears to be required. Previously, there was one set of double quotes around the definition of the tool and one around the actual invocation. This led to confusion because it was the only such tool path to include double quotes around its invocation. Also, it was somewhat inflexible in the event that somebody needed to override the tool command to include arguments. Therefore, even though it may look "wrong", there are now two double quotes on either side of the tool path definition. This fixes the problem that currently prevents the htmlhelp target from building and maintains flexibility in case somebody needs to override it via the command line or an environment variable. 2009-11-01 Joe English * doc/Eval.3, doc/Cancel.3: Move TIP#285 routines out of Eval.3 into their own manpage. 2009-10-31 Donal K. Fellows * generic/tclBasic.c (ExprRoundFunc): [Bug 2889593]: Correctly report the expected number of arguments when generating an error for round(). 2009-10-30 Pat Thoyts * tests/tcltest.test: When creating the notwritabledir we deny the current user access to delete the file. We must grant this right when we cleanup. Required on Windows 7 when the user does not automatically have administrator rights. 2009-10-29 Don Porter * generic/tcl.h: Changed the typedef for the mp_digit type from: typedef unsigned long mp_digit; to: typedef unsigned int mp_digit; For 32-bit builds where "long" and "int" are two names for the same thing, this is no change at all. For 64-bit builds, though, this causes the dp[] array of an mp_int to be made up of 32-bit elements instead of 64-bit elements. This is a huge improvement because details elsewhere in the mp_int implementation cause only 28 bits of each element to be actually used storing number data. Without this change bignums are over 50% wasted space on 64-bit systems. [Bug 2800740]. ***POTENTIAL INCOMPATIBILITY*** For 64-bit builds, callers of routines with (mp_digit) or (mp_digit *) arguments *will*, and callers of routines with (mp_int *) arguments *may* suffer both binary and stubs incompatibilities with Tcl releases 8.5.0 - 8.5.7. Such possibilities should be checked, and if such incompatibilities are present, suitable [package require] requirements on the Tcl release should be put in place to keep such built code [load]-ing only in Tcl interps that are compatible. 2009-10-29 Donal K. Fellows * tests/dict.test: Make variable-clean and simplify tests by utilizing the fact that dictionaries have defined orders. * generic/tclZlib.c (TclZlibCmd): Remove accidental C99-ism which reportedly makes the AIX native compiler choke. 2009-10-29 Kevin B. Kenny * library/clock.tcl (LocalizeFormat): * tests/clock.test (clock-67.1): [Bug 2819334]: Corrected a problem where '%%' followed by a letter in a format group could expand recursively: %%R would turn into %%H:%M:%S 2009-10-28 Don Porter * generic/tclLiteral.c: [Bug 2888044]: Fixed 2 bugs. * tests/info.test: First, as noted in the comments of the TclCleanupLiteralTable routine, since the teardown of the intrep of one Tcl_Obj can cause the teardown of others in the same table, the full table cleanup must be done with care, but the code did not contain the same care demanded in the comment. Second, recent additions to the info.test file had poor hygiene, leaving an array variable ::a lying around, which breaks later interp.test tests during a -singleproc 1 run of the test suite. 2009-10-28 Kevin B. Kenny * tests/fileName.test (fileName-20.[78]): Corrected poor test hygiene (failure to save and restore the working directory) that caused these two tests to fail on Windows (and [Bug 2806250] to be reopened). 2009-10-27 Don Porter * generic/tclPathObj.c: [Bug 2884203]: Missing refcount on cached normalized path caused crashes. 2009-10-27 Kevin B. Kenny * library/clock.tcl (ParseClockScanFormat): [Bug 2886852]: Corrected a problem where [clock scan] didn't load the timezone soon enough when processing a time format that lacked a complete date. * tests/clock.test (clock-66.1): Added a test case for the above bug. * library/tzdata/America/Argentina/Buenos_Aires: * library/tzdata/America/Argentina/Cordoba: * library/tzdata/America/Argentina/San_Luis: * library/tzdata/America/Argentina/Tucuman: New DST rules for Argentina. (Olson's tzdata2009p.) 2009-10-26 Don Porter * unix/Makefile.in: Remove $(PACKAGE).* and prototype from the `make distclean` target. Completes 2009-10-20 commit. 2009-10-24 Kevin B. Kenny * library/clock.tcl (ProcessPosixTimeZone): Corrected a regression in the fix to [Bug 2207436] that caused [clock] to apply EU daylight saving time rules in the US. Thanks to Karl Lehenbauer for reporting this regression. * tests/clock.test (clock-52.4): Added a regression test for the above bug. * library/tzdata/Asia/Dhaka: * library/tzdata/Asia/Karachi: New DST rules for Bangladesh and Pakistan. (Olson's tzdata2009o.) 2009-10-23 Andreas Kupries * generic/tclIO.c (FlushChannel): Skip OutputProc for low-level 0-length writes. When closing pipes which have already been closed not skipping leads to spurious SIG_PIPE signals. Reported by Mikhail Teterin . 2009-10-22 Donal K. Fellows * generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 2883857]: Allow the passing of array element names through this method. 2009-10-21 Donal K. Fellows * generic/tclPosixStr.c: [Bug 2882561]: Work around oddity on Haiku OS where SIGSEGV and SIGBUS are the same value. * generic/tclTrace.c (StringTraceProc): [Bug 2881259]: Added back cast to work around silly bug in MSVC's handling of auto-casting. 2009-10-20 Don Porter * unix/Makefile.in: Removed the long outdated and broken targets package-* that were for building Solaris packages. Appears that the pieces needed for these targets to function have never been present in the current era of Tcl development and belong completely to Tcl prehistory. 2009-10-19 Don Porter * generic/tclIO.c: [Patch 2107634]: Revised ReadChars and FilterInputBytes routines to permit reads to continue up to the string limits of Tcl values. Before revisions, large read attempts could panic when as little as half the limiting value length was reached. Thanks to Sean Morrison and Bob Parker for their roles in the fix. 2009-10-18 Joe Mistachkin * generic/tclObj.c (TclDbDumpActiveObjects, TclDbInitNewObj) (Tcl_DbIncrRefCount, Tcl_DbDecrRefCount, Tcl_DbIsShared): [Bug 2871908]: Enforce separation of concerns between the lineCLPtr and objThreadMap thread specific data members. 2009-10-18 Joe Mistachkin * tests/thread.test (thread-4.[345]): [Bug 1565466]: Correct tests to save their error state before the final call to threadReap just in case it triggers an "invalid thread id" error. This error can occur if one or more of the target threads has exited prior to the attempt to send it an asynchronous exit command. 2009-10-17 Donal K. Fellows * generic/tclVar.c (UnsetVarStruct, TclDeleteNamespaceVars) (TclDeleteCompiledLocalVars, DeleteArray): * generic/tclTrace.c (Tcl_UntraceVar2): [Bug 2629338]: Stop traces that are deleted part way through (a feature used by tdom) from causing freed memory to be accessed. 2009-10-08 Donal K. Fellows * generic/tclDictObj.c (DictIncrCmd): [Bug 2874678]: Don't leak any bignums when doing [dict incr] with a value. * tests/dict.test (dict-19.3): Memory leak detection code. 2009-10-07 Andreas Kupries * generic/tclObj.c: [Bug 2871908]: Plug memory leaks of objThreadMap and lineCLPtr hashtables. Also make the names of the continuation line information initialization and finalization functions more consistent. Patch supplied by Joe Mistachkin . * generic/tclIORChan.c (ErrnoReturn): Replace hardwired constant 11 with proper errno #define, EAGAIN. What was I thinking? The BSD's have a different errno assignment and break with the hardwired number. Reported by emiliano on the chat. 2009-10-06 Don Porter * generic/tclInterp.c (SlaveEval): Agressive stomping of internal reps was added as part of the NRE patch of 2008-07-13. This doesn't appear to actually be needed, and it hurts quite a bit when large lists lose their intreps and require reparsing. Thanks to Ashok Nadkarni for reporting the problem. * generic/tclTomMathInt.h (new): Public header tclTomMath.h had * generic/tclTomMath.h: dependence on private headers, breaking use * generic/tommath.h: by extensions [Bug 1941434]. 2009-10-05 Andreas Kupries * library/safe.tcl (AliasGlob): Fixed conversion of catch to try/finally, it had an 'on ok msg' branch missing, causing a silent error immediately, and bogus glob results, breaking search for Tcl modules. 2009-10-04 Daniel Steffen * macosx/tclMacOSXBundle.c: [Bug 2569449]: Workaround CF memory * unix/tclUnixInit.c: managment bug in Mac OS X 10.4 & earlier. 2009-10-02 Kevin B. Kenny * library/tzdata/Africa/Cairo: * library/tzdata/Asia/Gaza: * library/tzdata/Asia/Karachi: * library/tzdata/Pacific/Apia: Olson's tzdata2009n. 2009-09-29 Don Porter * generic/tclDictObj.c: [Bug 2857044]: Updated freeIntRepProc * generic/tclExecute.c: routines so that they set the typePtr * generic/tclIO.c: field to NULL so that the Tcl_Obj is * generic/tclIndexObj.c: not left in an inconsistent state. * generic/tclInt.h: * generic/tclListObj.c: * generic/tclNamesp.c: * generic/tclOOCall.c: * generic/tclObj.c: * generic/tclPathObj.c: * generic/tclProc.c: * generic/tclRegexp.c: * generic/tclStringObj.c: * generic/tclAlloc.c: Cleaned up various routines in the * generic/tclCkalloc.c: call stacks for memory allocation to * generic/tclInt.h: guarantee that any size values computed * generic/tclThreadAlloc.c: are within the domains of the routines they get passed to. [Bugs 2557696 and 2557796]. 2009-09-28 Don Porter * generic/tclCmdMZ.c: Replaced TclProcessReturn() calls with * tests/error.test: Tcl_SetReturnOptions() calls as a simple fix for [Bug 2855247]. Thanks to Anton Kovalenko for the report and fix. Additional fixes for other failures demonstrated by new tests. 2009-09-27 Don Porter * tests/error.test (error-15.8.*): Coverage tests illustrating flaws in the propagation of return options by [try]. 2009-09-26 Donal K. Fellows * unix/tclooConfig.sh, win/tclooConfig.sh: [Bug 2026844]: Added dummy versions of tclooConfig.sh that make it easier to build extensions against both Tcl8.5+TclOO-standalone and Tcl8.6. 2009-09-24 Don Porter TIP #356 IMPLEMENTATION * generic/tcl.decls: Promote internal routine TclNRSubstObj() * generic/tclCmdMZ.c: to public Tcl_NRSubstObj(). Still needs docs. * generic/tclCompile.c: * generic/tclInt.h: * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: 2009-09-23 Miguel Sofer * doc/namespace.n: the description of [namespace unknown] failed to mention [namespace path]: fixed. Thx emiliano. 2009-09-21 Mo DeJong * tests/regexp.test: Added check for error message from unbalanced [] in regexp. Added additional simple test cases of basic regsub command. 2009-09-21 Don Porter * generic/tclCompile.c: Correct botch in the conversion of Tcl_SubstObj(). Thanks to Kevin Kenny for detection and report. 2009-09-17 Don Porter * generic/tclCompile.c: Re-implement Tcl_SubstObj() as a simple * generic/tclParse.c: wrapper around TclNRSubstObj(). This has * tests/basic.test: the effect of caching compiled bytecode in * tests/parse.test: the value to be substituted. Note that Tcl_SubstObj() now exists only for extensions. Tcl itself no longer makes any use of it. Note also that TclSubstTokens() is now reachable only by Tcl_EvalEx() and Tcl_ParseVar() so tests aiming to test its functioning needed adjustment to still have the intended effect. 2009-09-16 Alexandre Ferrieux * generic/tclObj.c: Extended ::tcl::unsupported::representation. 2009-09-11 Don Porter * generic/tclBasic.c: Completed the NR-enabling of [subst]. * generic/tclCmdMZ.c: [Bug 2314561]. * generic/tclCompCmds.c: * generic/tclCompile.c: * generic/tclInt.h: * tests/coroutine.test: * tests/parse.test: 2009-09-11 Donal K. Fellows * tests/http.test: Added in cleaning up of http tokens for each test to reduce amount of global-variable pollution. 2009-09-10 Donal K. Fellows * library/http/http.tcl (http::Event): [Bug 2849860]: Handle charset names in double quotes; some servers like generating them like that. 2009-09-07 Don Porter * generic/tclParse.c: [Bug 2850901]: Corrected line counting error * tests/into.test: in multi-command script substitutions. 2009-09-07 Daniel Steffen * generic/tclExecute.c: Fix potential uninitialized variable use and * generic/tclFCmd.c: null dereference flagged by clang static * generic/tclProc.c: analyzer. * generic/tclTimer.c: * generic/tclUtf.c: * generic/tclExecute.c: Silence false positives from clang static * generic/tclIO.c: analyzer about potential null dereference. * generic/tclScan.c: * generic/tclCompExpr.c: 2009-09-04 Don Porter * generic/tclCompCmds.c (TclCompileSubstCmd): [Bug 2314561]: * generic/tclBasic.c: Added a bytecode compiler routine for the * generic/tclCmdMZ.c: [subst] command. This is a partial solution to * generic/tclCompile.c: the need to NR-enable [subst] since bytecode * generic/tclCompile.h: execution is already NR-enabled. Two new * generic/tclExecute.c: bytecode instructions, INST_NOP and * generic/tclInt.h: INST_RETURN_CODE_BRANCH were added to support * generic/tclParse.c: the new routine. INST_RETURN_CODE_BRANCH is * tests/basic.test: likely to be useful in any future effort to * tests/info.test: add a bytecode compiler routine for [try]. * tests/parse.test: 2009-09-03 Donal K. Fellows * doc/LinkVar.3: [Bug 2844962]: Added documentation of issues relating to use of this API in a multi-threaded environment. 2009-09-01 Andreas Kupries * generic/tclIORTrans.c (ReflectInput): Remove error response to 0-result from method 'limit?' of transformations. Return the number of copied bytes instead, which is possibly nothing. The latter then triggers EOF handling in the higher layers, making the 0-result of limit? the way to inject artificial EOF's into the data stream. 2009-09-01 Don Porter * library/tcltest/tcltest.tcl: Bump to tcltest 2.3.2 after revision * library/tcltest/pkgIndex.tcl: to verbose error message. * unix/Makefile.in: * win/Makefile.in: 2009-08-27 Don Porter * generic/tclStringObj.c: [Bug 2845535]: A few more string overflow cases in [format]. 2009-08-25 Andreas Kupries * generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard) (Tcl_EvalEx, TclEvalEx, TclAdvanceContinuations, TclNREvalObjEx): * generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines): * generic/tclCompCmds.c (*): * generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv) (TclFreeCompileEnv, TclCompileScript, TclCompileTokens): * generic/tclCompile.h (CompileEnv): * generic/tclInt.h (ContLineLoc, Interp): * generic/tclObj.c (ThreadSpecificData, ContLineLocFree) (TclThreadFinalizeObjects, TclInitObjSubsystem, TclContinuationsEnter, (TclContinuationsEnterDerived, TclContinuationsCopy, TclFreeObj) (TclContinuationsGet): * generic/tclParse.c (TclSubstTokens, Tcl_SubstObj): * generic/tclProc.c (TclCreateProc): * generic/tclVar.c (TclPtrSetVar): * tests/info.test (info-30.0-24): Extended the parser, compiler, and execution engine with code and attendant data structures tracking the position of continuation lines which are not visible in the resulting script Tcl_Obj*'s, to properly account for them while counting lines for #280. 2009-08-24 Daniel Steffen * generic/tclInt.h: Annotate Tcl_Panic as noreturn for clang static analyzer in PURIFY builds, replacing preprocessor/assert technique. * macosx/tclMacOSXNotify.c: Fix multiple issues with nested event loops when CoreFoundation notifier is running in embedded mode. (Fixes problems in TkAqua Cocoa reported by Youness Alaoui on tcl-mac) 2009-08-21 Don Porter * generic/tclFileName.c: Correct regression in [Bug 2837800] fix. * tests/fileName.test: 2009-08-20 Don Porter * generic/tclFileName.c: [Bug 2837800]: Correct the result produced by [glob */test] when * matches something like ~foo. * generic/tclPathObj.c: [Bug 2806250]: Prevent the storage of strings starting with ~ in the "tail" part (normPathPtr field) of the path intrep when PATHFLAGS != 0. This establishes the assumptions relied on elsewhere that the name stored there is a relative path. Also refactored to make an AppendPath() routine instead of the cut/paste stanzas that were littered throughout. 2009-08-20 Donal K. Fellows * generic/tclCmdIL.c (TclNRIfObjCmd): [Bug 2823276]: Make [if] NRE-safe on all arguments when interpreted. (Tcl_LsortObjCmd): Close off memory leak. 2009-08-19 Donal K. Fellows * generic/tclCmdAH.c (TclNRForObjCmd, etc.): [Bug 2823276]: Make [for] and [while] into NRE-safe commands, even when interpreted. 2009-08-18 Don Porter * generic/tclPathObj.c: [Bug 2837800]: Added NULL check to prevent * tests/fileName.test: crashes during [glob]. 2009-08-16 Jan Nijtmans * unix/dltest/pkge.c: const addition * unix/tclUnixThrd.c: Use in stead of "pthread.h" * win/tclWinDde.c: Eliminate some more gcc warnings * win/tclWinReg.c: * generic/tclInt.h: Change ForIterData, make it const-safe. * generic/tclCmdAH.c: 2009-08-12 Don Porter TIP #353 IMPLEMENTATION * doc/NRE.3: New public routine Tcl_NRExprObj() permits * generic/tcl.decls: extension commands to evaluate Tcl expressions * generic/tclBasic.c: in NR-enabled command procedures. * generic/tclCmdAH.c: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclObj.c: * tests/expr.test: * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: 2009-08-06 Andreas Kupries * doc/refchan.n [Bug 2827000]: Extended the implementation of * generic/tclIORChan.c: reflective channels (TIP 219, method * tests/ioCmd.test: 'read'), enabling handlers to signal EAGAIN to indicate 'no data, but not at EOF either', and other system errors. Updated documentation, extended testsuite (New test cases iocmd*-23.{9,10}). 2009-08-02 Miguel Sofer * tests/coroutine.test: fix testfile cleanup 2009-08-02 Donal K. Fellows * generic/tclObj.c (Tcl_RepresentationCmd): Added an unsupported command for reporting the representation of an object. Result string is deliberately a bit obstructive so that people are not encouraged to make code that depends on it; it's a debugging tool only! * unix/tclUnixFCmd.c (GetOwnerAttribute, SetOwnerAttribute) (GetGroupAttribute, SetGroupAttribute): [Bug 1942222]: Stop calling * unix/tclUnixFile.c (TclpGetUserHome): endpwent() and endgrent(); they've been unnecessary for ages. 2009-08-02 Jan Nijtmans * win/tclWin32Dll.c: Eliminate TclWinResetInterfaceEncodings, since it * win/tclWinInit.c: does exactly the same as TclWinEncodingsCleanup, * win/tclWinInt.h: make sure that tclWinProcs and tclWinTCharEncoding are always set and reset concurrently. * win/tclWinFCmd.c: Correct check for win95 2009-07-31 Don Porter * generic/tclStringObj.c: [Bug 2830354]: Corrected failure to * tests/format.test: grow buffer when format spec request large width floating point values. Thanks to Clemens Misch. 2009-07-26 Donal K. Fellows * library/auto.tcl (tcl_findLibrary, auto_mkindex): * library/package.tcl (pkg_mkIndex, tclPkgUnknown, MacOSXPkgUnknown): * library/safe.tcl (interpAddToAccessPath, interpDelete, AliasGlob): (AliasSource, AliasLoad, AliasEncoding): * library/tm.tcl (UnknownHandler): Simplify by swapping some [catch] gymnastics for use of [try]. 2009-07-26 Alexandre Ferrieux * tools/genStubs.tcl: Forced LF translation when generating .h's to avoid spurious diffs when regenerating on a Windows box. 2009-07-26 Jan Nijtmans * win/Makefile.in: [Bug 2827066]: msys build --enable-symbols broken * win/tcl.m4: And modified the same for unicows.dll, as a * win/configure: preparation for [Enh 2819611]. 2009-07-25 Donal K. Fellows * library/history.tcl (history): Reworked the history mechanism in terms of ensembles, rather than the ad hoc ensemble-lite mechanism used previously. 2009-07-24 Donal K. Fellows * doc/self.n (self class): [Bug 2704302]: Add some text to make it clearer how to get the name of the current object's class. 2009-07-23 Andreas Kupries * generic/tclIO.c (Tcl_GetChannelHandle): [Bug 2826248]: Do not crash * generic/tclPipe.c (FileForRedirect): for getHandleProc == NULL, this is allowed. Provide a nice error message in the bypass area. Updated caller to check the bypass for a mesage. Bug reported by Andy Sonnenburg 2009-07-23 Joe Mistachkin * generic/tclNotify.c: [Bug 2820349]: Ensure that queued events are freed once processed. 2009-07-22 Jan Nijtmans * macosx/tclMacOSXFCmd.c: CONST -> const * generic/tclGetDate.y: * generic/tclDate.c: * generic/tclLiteral.c: (char *) cast in ckfree call * generic/tclPanic.c: [Feature Request 2814786]: remove TclpPanic * generic/tclInt.h * unix/tclUnixPort.h * win/tclWinPort.h 2009-07-22 Alexandre Ferrieux * generic/tclEvent.c: [Bug 2001201 again]: Refined the 20090617 patch on [exit] streamlining, so that it now correctly calls thread exit handlers for the calling thread, including bindings in Tk. 2009-07-21 Kevin B. Kenny * library/tzdata/Asia/Dhaka: * library/tzdata/Indian/Mauritius: Olson's tzdata2009k. 2009-07-20 Donal K. Fellows * generic/tclCmdMZ.c (StringIsCmd): Reorganize so that [string is] is more efficient when parsing things that are correct, at a cost of making the empty string test slightly more costly. With this, the cost of doing [string is integer -strict $x] matches [catch {expr {$x+0}}] in the successful case, and greatly outstrips it in the failing case. 2009-07-19 Donal K. Fellows * generic/tclOO.decls, generic/tclOO.c (Tcl_GetObjectName): Expose a function for efficiently returning the current name of an object. 2009-07-18 Daniel Steffen * unix/Makefile.in: Define NDEBUG in optimized (non-symbols) build to disable NRE assert()s and threaded allocator range checks. 2009-07-16 Don Porter * generic/tclBinary.c: Removed unused variables. * generic/tclCmdIL.c: * generic/tclCompile.c: * generic/tclExecute.c: * generic/tclHash.c: * generic/tclIOUtil.c: * generic/tclVar.c: * generic/tclBasic.c: Silence compiler warnings about ClientData. * generic/tclProc.c: * generic/tclScan.c: Typo in ACCEPT_NAN configuration. * generic/tclStrToD.c: [Bug 2819200]: Set floating point control register on MIPS systems so that the gradual underflow expected by Tcl is in effect. 2009-07-15 Donal K. Fellows * generic/tclInt.h (Namespace): Added machinery to allow * generic/tclNamesp.c (many functions): reduction of memory used * generic/tclResolve.c (BumpCmdRefEpochs): by namespaces. Currently #ifdef'ed out because of compatibility concerns. * generic/tclInt.decls: Added four functions for better integration with itcl-ng. 2009-07-14 Kevin B. Kenny * generic/tclInt.h (TclNRSwitchObjCmd): * generic/tclBasic.c (builtInCmds): * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): * tests/switch.test (switch-15.1): [Bug 2821401]: Make non-bytecoded [switch] command aware of NRE. 2009-07-13 Andreas Kupries * generic/tclCompile.c (TclInitCompileEnv, EnterCmdWordIndex) (TclCleanupByteCode, TclCompileScript): * generic/tclExecute.c (TclCompileObj, TclExecuteByteCode): * tclCompile.h (ExtCmdLoc): * tclInt.h (ExtIndex, CFWordBC, CmdFrame): * tclBasic.c (DeleteInterpProc, TclArgumentBCEnter) (TclArgumentBCRelease, TclArgumentGet, SAVE_CONTEXT) (RESTORE_CONTEXT, NRCoroutineExitCallback, TclNRCoroutineObjCmd): * generic/tclCmdAH.c (TclNRForObjCmd, TclNRForIterCallback, (ForNextCallback): * generic/tclCmdMZ.c (TclNRWhileObjCmd): Extended the bytecode compiler initialization to recognize the compilation of whole files (NRE enabled 'source' command) and switch to the counting of absolute lines in that case. Further extended the bytecode compiler to track the start line in the generated information, and modified the bytecode execution to recompile an object if the location as per the calling context doesn't match the location saved in the bytecode. This part could be optimized more by using more memory to keep all possibilities which occur around, or by just adjusting the location information instead of a total recompile. Reworked the handling of literal command arguments in bytecode to be saved (compiler) and used (execution) per command (See the TCL_INVOKE_STK* instructions), and not per the whole bytecode. This, and the previous change remove the problems with location data caused by literal sharing (across whole files, but also proc bodies). Simplified the associated datastructures (ExtIndex is gone, as is the function EnterCmdWordIndex). The last change causes the hashtable 'lineLABCPtr' to be state which has to be kept per coroutine, like the CmdFrame stack. Reworked the coroutine support code to create, delete and switch the information as needed. Further reworked the tailcall command as well, it has to pop its own arguments when run in a bytecode context to keep a proper stack in 'lineLABCPtr'. Fixed the mishandling of line information in the NRE-enabled 'for' and 'while' commands introduced when both were made to share their iteration callbacks without taking into account that the loop body is found in different words of the command. Introduced a separate data structure to hold all the callback information, as we went over the limit of 4 direct client-data values for NRE callbacks. The above fixes [Bug 1605269]. 2009-07-12 Donal K. Fellows * generic/tclCmdMZ.c (StringIndexCmd, StringEqualCmd, StringCmpCmd): * generic/tclExecute.c (TclExecuteByteCode): [Bug 2637173]: Factor out * generic/tclInt.h (TclIsPureByteArray): the code to determine if * generic/tclUtil.c (TclStringMatchObj): it is safe to work with byte arrays directly, so that we get the check correct _once_. * generic/tclOOCall.c (TclOOGetCallContext): [Bug 1895546]: Changed * generic/tclOO.c (TclOOObjectCmdCore): the way that the cache is managed so that when itcl does cunning things, those cunning things can be cached properly. 2009-07-11 Donal K. Fellows * doc/vwait.n: Substantially increased the discussion of issues and work-arounds relating to nested vwaits, following discussion on the tcl-core mailing list on the topic. 2009-07-10 Pat Thoyts * tests/zlib.test: ZlibTransformClose may be called with a NULL * generic/tclZlib.c: interpreter during finalization and Tcl_SetChannelError requires a list. Added some tests to ensure error propagation from the zlib library to the interp. 2009-07-09 Pat Thoyts * tests/zlib.test: [Bug 2818131]: Added tests and fixed a typo that broke [zlib push] for deflate format. 2009-07-09 Donal K. Fellows * compat/mkstemp.c (mkstemp): [Bug 2819227]: Use rand() for random numbers as it is more portable. 2009-07-05 Donal K. Fellows * generic/tclZlib.c (ZlibTransformWatch): Correct the handling of events so that channel transforms work with things like an asynch [chan copy]. Problem reported by Pat Thoyts. 2009-07-01 Pat Thoyts * win/tclWinInt.h: [Bug 2806622]: Handle the GetUserName API call * win/tclWin32Dll.c: via the tclWinProcs indirection structure. This * win/tclWinInit.c: fixes a problem obtaining the username when the USERNAME environment variable is unset. 2009-06-30 Daniel Steffen * generic/tclInt.h: Add assert macros for clang static * generic/tclPanic.c: analyzer and redefine Tcl_Panic to * generic/tclStubInit.c: assert after panic in clang PURIFY builds. * generic/tclCmdIL.c: Add clang assert for false positive from static analyzer. 2009-06-26 Daniel Steffen * macosx/Tcl-Common.xcconfig: Update projects for Xcode 3.1 and * macosx/Tcl.xcode/*: 3.2, standardize on gcc 4.2, remove * macosx/Tcl.xcodeproj/*: obsolete configurations and pre-Xcode * macosx/Tcl.pbproj/* (removed): project. * macosx/README: Update project docs, cleanup. * unix/Makefile.in: Update dist target for project changes. 2009-06-24 Donal K. Fellows * tests/oo.test (oo-19.1): [Bug 2811598]: Make more resilient. 2009-06-24 Pat Thoyts * tests/http11.test: [Bug 2811492]: Clean up procs after testing. 2009-06-18 Donal K. Fellows * generic/tclCkalloc.c (MemoryCmd): [Bug 988703]: * generic/tclObj.c (ObjData, TclFinalizeThreadObjects): Add mechanism for discovering what Tcl_Objs are allocated when built for memory debugging. Developed by Joe Mistachkin. 2009-06-17 Alexandre Ferrieux * generic/tclEvent.c: Applied a patch by George Peter Staplin drastically reducing the ambition of [exit] wrt finalization, and thus solving many multi-thread teardown issues. [Bugs 2001201, 486399, and possibly 597575, 990457, 1437595, 2750491] 2009-06-15 Don Porter * generic/tclStringObj.c: sprintf() -> Tcl_ObjPrintf() conversion. 2009-06-15 Reinhard Max * unix/tclUnixPort.h: Move all socket-related code from tclUnixChan.c * unix/tclUnixChan.c: to tclUnixSock.c. * unix/tclUnixSock.c: 2009-06-15 Donal K. Fellows * tools/tcltk-man2html.tcl (make-man-pages): [Patch 557486]: Apply last remaining meaningful part of this patch, a clean up of some closing tags. 2009-06-13 Don Porter * generic/tclCompile.c: [Bug 2802881]: The value stashed in * generic/tclProc.c: iPtr->compiledProcPtr when compiling a proc * tests/execute.test: survives too long. We only need it there long enough for the right TclInitCompileEnv() call to re-stash it into envPtr->procPtr. Once that is done, the CompileEnv controls. If we let the value of iPtr->compiledProcPtr linger, though, then any other bytecode compile operation that takes place will also have its CompileEnv initialized with it, and that's not correct. The value is meant to control the compile of the proc body only, not other compile tasks that happen along. Thanks to Carlos Tasada for discovering and reporting the problem. 2009-06-10 Don Porter * generic/tclStringObj.c: [Bug 2801413]: Revised [format] to not overflow the integer calculations computing the length of the %ll formats of really big integers. Also added protections so that [format]s that would produce results overflowing the maximum string length of Tcl values throw a normal Tcl error instead of a panic. * generic/tclStringObj.c: [Bug 2803109]: Corrected failures to deal with the "pure unicode" representation of an empty string. Thanks to Julian Noble for reporting the problem. 2006-06-09 Kevin B. Kenny * generic/tclGetDate.y: Fixed a thread safety bug in the generated * library/clock.tcl: Bison parser (needed a %pure-parser * tests/clock.test: declaration to avoid static variables). Discovered that the %pure-parser declaration allowed for returning the Bison error message to the Tcl caller in the event of a syntax error, so did so. * generic/tclDate.c: bison 2.3 2006-06-08 Kevin B. Kenny * library/tzdata/Asia/Dhaka: New DST rule for Bangladesh. (Olson's tzdata2009i.) 2009-06-08 Donal K. Fellows * doc/copy.n: Fix error in example spotted by Venkat Iyer. 2009-06-02 Don Porter * generic/tclExecute.c: Replace dynamically-initialized table with a table of static constants in the lookup table for exponent operator computations that fit in a 64 bit integer result. * generic/tclExecute.c: [Bug 2798543]: Corrected implementations and selection logic of the INST_EXPON instruction. 2009-06-01 Don Porter * tests/expr.test: [Bug 2798543]: Added many tests demonstrating the broken cases. 009-05-30 Kevin B. Kenny * library/tzdata/Africa/Cairo: * library/tzdata/Asia/Amman: Olson's tzdata2009h. 2009-05-29 Andreas Kupries * library/platform/platform.tcl: Fixed handling of cpu ia64, * library/platform/pkgIndex.tcl: taking ia64_32 into account * unix/Makefile.in: now. Bumped version to 1.0.5. Updated the * win/Makefile.in: installation commands. 2009-05-26 Alexandre Ferrieux * doc/expr.n: Fixed documentation of the right-associativity of the ** operator. (spotted by kbk) 2009-05-14 Donal K. Fellows * generic/tclOOInfo.c (InfoObjectNsCmd): Added introspection mechanism for finding out what an object's namespace is. Experience suggests that it is just too useful to be able to do without it. 2009-05-12 Donal K. Fellows * doc/vwait.n: Added more words to make it clear just how bad it is to nest [vwait]s. * compat/mkstemp.c: Add more headers to make this file build on IRIX 6.5. Thanks to Larry McVoy for this. 2009-05-08 Donal K. Fellows * generic/tclOO.c (TclNRNewObjectInstance): [Bug 2414858]: Add a * generic/tclBasic.c (TclPushTailcallPoint): marker to the stack of NRE callbacks at the right point so that tailcall works correctly in a constructor. * tests/exec.test (cat): [Bug 2788468]: Adjust the scripted version of cat so that it does not perform transformations on the data it is working with, making it more like the standard Unix 'cat' program. 2009-05-07 Miguel Sofer * generic/tclObj.c (Tcl_GetCommandFromObj): [Bug 2785893]: Ensure that a command in a deleted namespace can't be found through a cached name. * generic/tclBasic.c: Let coroutines start with a much smaller * generic/tclCompile.h: stack: 200 words (previously was 2000, the * generic/tclExecute.c: same as interps). 2009-05-07 Donal K. Fellows * tests/env.test (printenvScript, env-4.3, env-4.5): [Bug 1513659]: * tests/exec.test (exec-2.6): These tests had subtle dependencies on being on platforms that were either ISO 8859-1 or UTF-8. Stabilized the results by forcing the encoding. 2009-05-06 Don Porter * generic/tclCmdMZ.c: [Bug 2582327]: Improve overflow error message from [string repeat]. * tests/interp.test: interp-20.50 test for Bug 2486550. 2009-05-04 Donal K. Fellows * generic/tclOO.c (InitFoundation, AllocObject, AllocClass): * generic/tclOODefineCmds.c (InitDefineContext): Make sure that when support namespaces are deleted, nothing bad can subsequently happen. Issue spotted by Don Porter. 2009-05-03 Donal K. Fellows * doc/Tcl.n: [Bug 2538432]: Clarified exact treatment of ${arr(idx)} form of variable substitution. This is not a change of behavior, just an improved description of the current situation. 2009-04-30 Miguel Sofer * generic/tclBasic.c (TclObjInvoke): [Bug 2486550]: Make sure that a null objProc is not used, use Tcl_NRCallObjProc instead. 2009-05-01 Jan Nijtmans * win/configure.in Fix 64-bit detection for zlib on Win64 * win/configure (regenerated) 2009-04-28 Jeff Hobbs * unix/tcl.m4, unix/configure (SC_CONFIG_CFLAGS): harden the check to add _r to CC on AIX with threads. 2009-04-27 Donal K. Fellows * doc/concat.n (EXAMPLES): [Bug 2780680]: Rewrote so that the spacing of result messages is correct. (The exact way they were wrong was different when rendered through groff or as HTML, but it was still wrong both ways.) 2009-04-27 Jan Nijtmans * generic/tclIndexObj.c: Reset internal INTERP_ALTERNATE_WRONG_ARGS * generic/tclIOCmd.c: flag inside the Tcl_WrongNumArgs function, so the caller no longer has to do the reset. 2009-04-24 Stuart Cassoff * unix/Makefile.in: [Patch 2769530]: Don't chmod/exec installManPage. 2009-04-19 Pat Thoyts * library/http/http.tcl: [Bug 2715421]: Removed spurious newline added * tests/http11.test: after POST and added tests to detect excess * tests/httpd11.tcl: bytes being POSTed. * library/http/pkgIndex.tcl: * makefiles: package version now 2.8.1 2009-04-15 Donal K. Fellows * doc/chan.n, doc/close.n: Tidy up documentation of TIP #332. 2009-04-14 Kevin B. Kenny * library/tzdata/Asia/Karachi: Updated rules for Pakistan Summer Time (Olson's tzdata2009f) 2009-04-11 Donal K. Fellows * generic/tclOOMethod.c (InvokeForwardMethod): Clarify the resolution behaviour of the name of the command that is forwarded to: it's now resolved using the object's namespace as context, which is much more useful than the previous (somewhat random) behaviour of using the caller's current namespace. 2009-04-10 Pat Thoyts * library/http/http.tcl: Improved HTTP/1.1 support and added * library/http/pkgIndex.tcl: specific HTTP/1.1 testing to ensure * tests/http11.test: we handle chunked+gzip for the various * tests/httpd11.test: modes (normal, -channel and -handler) * makefiles: package version set to 2.8.0 2009-04-10 Daniel Steffen * unix/tclUnixChan.c: TclUnixWaitForFile(): use FD_* macros * macosx/tclMacOSXNotify.c: to manipulate select masks (Cassoff). [FRQ 1960647] [Bug 3486554] * unix/tclLoadDyld.c: Use RTLD_GLOBAL instead of RTLD_LOCAL. [Bug 1961211] * macosx/tclMacOSXNotify.c: revise CoreFoundation notifier to allow embedding into applications that already have a CFRunLoop running and want to run the tcl event loop via Tcl_ServiceModeHook(TCL_SERVICE_ALL). * macosx/tclMacOSXNotify.c: add CFRunLoop based Tcl_Sleep() and * unix/tclUnixChan.c: TclUnixWaitForFile() implementations * unix/tclUnixEvent.c: and disable select() based ones in CoreFoundation builds. * unix/tclUnixNotify.c: simplify, sync with tclMacOSXNotify.c. * generic/tclInt.decls: add TclMacOSXNotifierAddRunLoopMode() * generic/tclIntPlatDecls.h: internal API, regen. * generic/tclStubInit.c: * unix/configure.in (Darwin): use Darwin SUSv3 extensions if available; remove /Network locations from default tcl package search path (NFS mounted locations and thus slow). * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 * macosx/tclMacOSXBundle.c: on Mac OS X 10.4 and later, replace deprecated NSModule API by dlfcn API. 2009-04-10 Donal K. Fellows * doc/StringObj.3: [Bug 2089279]: Corrected example so that it works on 64-bit machines as well. 2009-04-10 Pat Thoyts * tests/http.test: [Bug 26245326]: Added specific check for problem * tests/httpd: (return incomplete HTTP response header). 2009-04-08 Kevin B. Kenny * tools/tclZIC.tcl: Always emit files with Unix line termination. * library/tzdata: Olson's tzdata2009e 2009-04-09 Don Porter * library/http/http.tcl: [Bug 26245326]: Handle incomplete lines in the "connecting" state. Thanks to Sergei Golovan. 2009-04-08 Andreas Kupries * library/platform/platform.tcl: Extended the darwin sections to add * library/platform/pkgIndex.tcl: a kernel version number to the * unix/Makefile.in: identifier for anything from Leopard (10.5) on up. * win/Makefile.in: Extended patterns for same. Extended cpu * doc/platform.n: recognition for 64bit Tcl running on a 32bit kernel on a 64bit processor (By Daniel Steffen). Bumped version to 1.0.4. Updated Makefiles. 2009-04-08 Don Porter * library/tcltest/tcltest.tcl: [Bug 2570363]: Converted [eval]s (some * library/tcltest/pkgIndex.tcl: unsafe!) to {*} in tcltest package. * unix/Makefile.in: => tcltest 2.3.1 * win/Makefile.in: 2009-04-07 Don Porter * generic/tclStringObj.c: Correction so that value of TCL_GROWTH_MIN_ALLOC is everywhere expressed in bytes as comment claims. 2009-04-04 Donal K. Fellows * doc/vwait.n: [Bug 1910136]: Extend description and examples to make it clearer just how this command interprets variable names. 2009-03-30 Don Porter * doc/Alloc.3: [Bug 2556263]: Size argument is "unsigned int". 2009-03-27 Don Porter * generic/tclPathObj.c (TclPathPart): [Bug 2710920]: TclPathPart() * tests/fileName.test: was computing the wrong results for both [file dirname] and [file tail] on "path" arguments with the PATHFLAGS != 0 intrep and with an empty string for the "joined-on" part. 2009-03-25 Jan Nijtmans * doc/tclsh.1: Bring doc and tools in line with * tools/installData.tcl: https://wiki.tcl-lang.org/page/exec+magic * tools/str2c * tools/tcltk-man2html.tcl 2009-03-25 Donal K. Fellows * doc/coroutine.n: [Bug 2152285]: Added basic documentation for the coroutine and yield commands. 2009-03-24 Donal K. Fellows * generic/tclOOBasic.c (TclOOSelfObjCmd): [Bug 2704302]: Make 'self class' better defined in the context of objects that change class. * generic/tclVar.c (Tcl_UpvarObjCmd): [Bug 2673163] (ferrieux) * generic/tclProc.c (TclObjGetFrame): Make the upvar command more able to handle its officially documented syntax. 2009-03-22 Miguel Sofer * generic/tclBasic.c: [Bug 2502037]: NR-enable the handling of unknown commands. 2009-03-21 Miguel Sofer * generic/tclBasic.c: Fixed "leaks" in aliases, imports and * generic/tclInt.h: ensembles. Only remaining known leak is in * generic/tclInterp.c: ensemble unknown dispatch (as it not * generic/tclNamesp.c: NR-enabled) * tests/tailcall.test: * tclInt.h: comments * tests/tailcall.test: Added tests to show that [tailcall] does not currently always execute in constant space: interp-alias, ns-imports and ensembles "leak" as of this commit. * tests/nre.test: [foreach] has been NR-enabled for a while, the test was marked 'knownBug': unmark it. * generic/tclBasic.c: Fix for (among others) [Bug 2699087] * generic/tclCmdAH.c: Tailcalls now perform properly even from * generic/tclExecute.c: within [eval]ed scripts. * generic/tclInt.h: More tests missing, as well as proper exploration and testing of the interaction with "redirectors" like interp-alias (suspect that it does not happen in constant space) and pure-eval commands. * generic/tclExecute.c: Proper fix for [Bug 2415422]. Reenabled * tests/nre.test: the failing assertion that was disabled on 2008-12-18: the assertion is correct, the fault was in the management of expansions. * generic/tclExecute.c: Fix both test and code for tailcall * tests/tailcall.test: from within a compiled [eval] body. * tests/tailcall.test: Slightly improved tests 2009-03-20 Don Porter * tests/stringObj.test: [Bug 2597185]: Test stringObj-6.9 checks that Tcl_AppendStringsToObj() no longer crashes when operating on a pure unicode value. * generic/tclExecute.c (INST_CONCAT1): [Bug 2669109]: Panic when appends overflow the max length of a Tcl value. 2009-03-19 Miguel Sofer * generic/tcl.h: * generic/tclInt.h: * generic/tclBasic.c: * generic/tclExecute.c: * generic/tclNamesp.c (Tcl_PopCallFrame): Rewritten tailcall implementation, ::unsupported::atProcExit is (temporarily?) gone. The new approach is much simpler, and also closer to being correct. This commit fixes [Bug 2649975] and [Bug 2695587]. * tests/coroutine.test: Moved the tests to their own files, * tests/tailcall.test: removed the unsupported.test. Added * tests/unsupported.test: tests for the fixed bugs. 2009-03-19 Donal K. Fellows * doc/tailcall.n: Added documentation for tailcall command. 2009-03-18 Don Porter * win/tclWinFile.c (TclpObjNormalizePath): [Bug 2688184]: Corrected Tcl_Obj leak. Thanks to Joe Mistachkin for detection and patch. * generic/tclVar.c (TclLookupSimpleVar): [Bug 2689307]: Shift all calls to Tcl_SetErrorCode() out of TclLookupSimpleVar and onto its callers, where control with TCL_LEAVE_ERR_MSG flag is more easily handled. 2009-03-16 Donal K. Fellows * generic/tclCmdMZ.c (TryPostBody): [Bug 2688063]: Extract information from list before getting rid of last reference to it. 2009-03-15 Joe Mistachkin * generic/tclThread.c: [Bug 2687952]: Modify fix for TSD leak to match * generic/tclThreadStorage.c: Tcl 8.5 (and prior) allocation semantics 2009-03-15 Donal K. Fellows * generic/tclThreadStorage.c (TSDTableDelete): [Bug 2687952]: Ensure * generic/tclThread.c (Tcl_GetThreadData): that structures in Tcl's TSD system are all freed. Use the correct matching allocator. * generic/tclPosixStr.c (Tcl_SignalId,Tcl_SignalMsg): [Patch 1513655]: Added support for SIGINFO, which is present on BSD platforms. 2009-03-14 Donal K. Fellows * unix/tcl.pc.in (new file): [Patch 2243948] (hat0) * unix/configure.in, unix/Makefile.in: Added support for reporting Tcl's public build configuration via the pkg-config system. TEA is still the official mechanism though, in part because pkg-config is not universally supported across all Tcl's supported platforms. 2009-03-11 Miguel Sofer * generic/tclBasic.c (TclNRCoroutineObjCmd): fix Tcl_Obj leak. Diagnosis and fix thanks to GPS. 2009-03-09 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_TryObjCmd, TclNRTryObjCmd): Moved the implementation of [try] from Tcl code into C. Still lacks a bytecode version, but should be better than what was before. 2009-03-04 Donal K. Fellows * generic/tclZlib.c (TclZlibCmd): Checksums are defined to be unsigned 32-bit integers, use Tcl_WideInt to pass to scripts. [Bug 2662434] (ZlibStreamCmd, ChanGetOption): A few other related corrections. 2009-02-27 Jan Nijtmans * generic/tcl.decls: [Bug 218977]: Tcl_DbCkfree needs return value * generic/tclCkalloc.c * generic/tclDecls.h: (regenerated) * generic/tclInt.decls: don't use CONST84/CONST86 here * generic/tclCompile.h: don't use CONST86 here, comment fixing. * generic/tclIO.h: don't use CONST86 here, comment fixing. * generic/tclIntDecls.h (regenerated) 2009-02-25 Don Porter * generic/tclUtil.c (TclStringMatchObj): [Bug 2637173]: Revised the branching on the strObj->typePtr so that untyped values get converted to the "string" type and pass through the Unicode matcher. [Bug 2613766]: Also added checks to only perform "bytearray" optimization on pure bytearray values. * generic/tclCmdMZ.c: Since Tcl_GetCharLength() has its own * generic/tclExecute.c: optimizations for the tclByteArrayType, stop having the callers do them. 2009-02-24 Donal K. Fellows * doc/clock.n, doc/fblocked.n, doc/format.n, doc/lsort.n, * doc/pkgMkIndex.n, doc/regsub.n, doc/scan.n, doc/tclvars.n: General minor documentation improvements. * library/http/http.tcl (geturl, Eof): Added support for 8.6's built in zlib routines. 2009-02-22 Alexandre Ferrieux * tests/lrange.test: Revert commits of 2008-07-23. Those were speed * tests/binary.test: tests, that are inherently brittle. 2009-02-21 Don Porter * generic/tclStringObj.c: Several revisions to the shimmering patterns between Unicode and UTF string reps. Most notably the call: objPtr = Tcl_NewUnicodeObj(...,0); followed by a loop of calls: Tcl_AppendUnicodeToObj(objPtr, u, n); will now grow and append to the Unicode representation. Before this commit, the sequence would convert each append to UTF and perform the append to the UTF rep. This is puzzling and likely a bug. The performance of [string map] is significantly improved by this change (according to the MAP collection of benchmarks in tclbench). Just in case there was some wisdom in the old ways that I missed, I left in the ability to restore the old patterns with a #define COMPAT 1 at the top of the file. 2009-02-20 Don Porter * generic/tclPathObj.c: [Bug 2571597]: Fixed mistaken logic in * tests/fileName.test: TclFSGetPathType() that assumed (not "absolute") => "relative". This is a false assumption on Windows, where "volumerelative" is another possibility. 2009-02-18 Don Porter * generic/tclStringObj.c: Simplify the logic of the Tcl_*SetObjLength() routines. * generic/tclStringObj.c: Rewrite GrowStringBuffer() so that it has parallel structure with GrowUnicodeBuffer(). The revision permits allocation attempts to continue all the way up to failure, with no gap. It also directly manipulates the String and Tcl_Obj internals instead of inefficiently operating via Tcl_*SetObjLength() with all of its extra protections and underdocumented special cases. * generic/tclStringObj.c: Another round of simplification on the allocation macros. 2009-02-17 Jeff Hobbs * win/tcl.m4, win/configure: Check if cl groks _WIN64 already to avoid CC manipulation that can screw up later configure checks. Use 'd'ebug runtime in 64-bit builds. 2009-02-17 Don Porter * generic/tclStringObj.c: Pare back the length of the unicode array in a non-extended String struct to one Tcl_UniChar, meant to hold the terminating NUL character. Non-empty unicode strings are then stored by extending the String struct by stringPtr->maxChars additional slots in that array with sizeof(Tcl_UniChar) bytes per slot. This revision makes the allocation macros much simpler. * generic/tclStringObj.c: Factor out common GrowUnicodeBuffer() and solve overflow and growth algorithm fallbacks in it. * generic/tclStringObj.c: Factor out common GrowStringBuffer(). * generic/tclStringObj.c: Convert Tcl_AppendStringsToObj into * tests/stringObj.test: a radically simpler implementation where we just loop over calls to Tcl_AppendToObj. This fixes [Bug 2597185]. It also creates a *** POTENTIAL INCOMPATIBILITY *** in that T_ASTO can now allocate more space than is strictly required, like all the other Tcl_Append* routines. The incompatibility was detected by test stringObj-6.5, which I've updated to reflect the new behavior. * generic/tclStringObj.c: Revise buffer growth implementation in ExtendStringRepWithUnicode. Use cheap checks to determine that no reallocation is necessary without cost of computing the precise number of bytes needed. Also make use of the string growth algortihm in the case of repeated appends. 2009-02-16 Jan Nijtmans * generic/tclZlib.c: Hack needed for official zlib1.dll build. * win/configure.in: fix [Feature Request 2605263] use official * win/Makefile.in: zlib build. * win/configure: (regenerated) * compat/zlib/zdll.lib: new files * compat/zlib/zlib1.dll: * win/Makefile.in: [Bug 2605232]: tdbc doesn't build when Tcl is compiled with --disable-shared. 2009-02-15 Don Porter * generic/tclStringObj.c: [Bug 2603158]: Added protections from * generic/tclTestObj.c: invalid memory accesses when we append * tests/stringObj.test: (some part of) a Tcl_Obj to itself. Added the appendself and appendself2 subcommands to the [teststringobj] testing command and added tests to the test suite. * generic/tclStringObj.c: Factor out duplicate code from Tcl_AppendObjToObj. * generic/tclStringObj.c: Replace the 'size_t uallocated' field of the String struct, storing the number of bytes allocated to store the Tcl_UniChar array, with an 'int maxChars' field, storing the number of Tcl_UniChars that may be stored in the allocated space. This reduces memory requirement a small bit, and makes some range checks simpler to code. * generic/tclTestObj.c: Replace the [teststringobj ualloc] testing * tests/stringObj.test: command with [teststringobj maxchars] and update the tests. * generic/tclStringObj.c: Removed limitation in Tcl_AppendObjToObj where the char length of the result was only computed if the appended string was all single byte characters. This limitation was in place to dodge a bug in Tcl_GetUniChar. With that bug gone, we can take advantage of always recording the length of append results when we know it. 2009-02-14 Don Porter * generic/tclStringObj.c: Revisions so that we avoid creating the strange representation of an empty string with objPtr->bytes == NULL and stringPtr->hasUnicode == 0. Instead in the situations where that was being created, create a traditional two-legged stork representation (objPtr->bytes = tclEmptyStringRep and stringPtr->hasUnicode = 1). In the situations where the strange rep was treated differently, continue to do so by testing stringPtr->numChars == 0 to detect it. These changes make the code more conventional so easier for new maintainers to pick up. Also sets up further simplifications. * generic/tclTestObj.c: Revise updates to [teststringobj] so we don't get blocked by MODULE_SCOPE limits. 2009-02-12 Don Porter * generic/tclStringObj.c: Rewrites of the routines Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetUnicodeFromObj, Tcl_GetRange, and TclStringObjReverse to use the new macro, and to more simply and clearly split the cases depending on whether a valid unicode rep is present or needs to be created. New utility routine UnicodeLength(), to compute the length of unicode buffer arguments when no length is passed in, with built-in overflow protection included. Update three callers to use it. * generic/tclInt.h: New macro TclNumUtfChars meant to be a faster replacement for a full Tcl_NumUtfChars() call when the string has all single-byte characters. * generic/tclStringObj.c: Simplified Tcl_GetCharLength by * generic/tclTestObj.c: removing code that did nothing. Added early returns from Tcl_*SetObjLength when the desired length is already present; adapted test command to the change. * generic/tclStringObj.c: Re-implemented AppendUtfToUnicodeRep so that we no longer pass through Tcl_DStrings which have their own sets of problems when lengths overflow the int range. Now AUTUR and FillUnicodeRep share a common core routine. 2009-02-12 Donal K. Fellows * generic/tclOODefineCmds.c (TclOOGetDefineCmdContext): Use the correct field in the Interp structure for retrieving the frame to get the context object so that people can extend [oo::define] without deep shenanigans. Bug found by Federico Ferri. 2009-02-11 Don Porter * generic/tclStringObj.c: Re-implemented AppendUnicodeToUtfRep so that we no longer pass through Tcl_DStrings which have their own sets of problems when lengths overflow the int range. Now AUTUR and UpdateStringOfString share a common core routine. * generic/tclStringObj.c: Changed type of the 'allocated' field * generic/tclTestObj.c: of the String struct (and the TestString counterpart) from size_t to int since only int values are ever stored in it. 2009-02-10 Jan Nijtmans * generic/tclEncoding.c: Eliminate some unnessary type casts * generic/tclEvent.c: some internal const decorations * generic/tclExecute.c: spacing * generic/tclIndexObj.c: * generic/tclInterp.c: * generic/tclIO.c: * generic/tclIOCmd.c: * generic/tclIORChan.c: * generic/tclIOUtil.c: * generic/tclListObj.c: * generic/tclLiteral.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclOOBasic.c: * generic/tclPathObj.c: * generic/tclPkg.c: * generic/tclProc.c: * generic/tclRegexp.c: * generic/tclScan.c: * generic/tclStringObj.c: * generic/tclTest.c: * generic/tclTestProcBodyObj.c: * generic/tclThread.c: * generic/tclThreadTest.c: * generic/tclTimer.c: * generic/tclTrace.c: * generic/tclUtil.c: * generic/tclVar.c: * generic/tclStubInit.c: (regenerated) 2009-02-10 Jan Nijtmans * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when using the native CC. * unix/configure: (autoconf-2.59) 2009-02-10 Don Porter * generic/tclObj.c (Tcl_GetString): Added comments and validity checks following the call to an UpdateStringProc. * generic/tclStringObj.c: Reduce code duplication in Tcl_GetUnicode*. Restrict AppendUtfToUtfRep to non-negative length appends. Convert all Tcl_InvalidateStringRep() calls into macros. Simplify Tcl_AttemptSetObjLength by removing unreachable code. Simplify SetStringFromAny() by removing unreachable and duplicate code. Simplify Tcl_SetObjLength by removing unreachable code. Removed handling of (objPtr->bytes != NULL) from UpdateStringOfString, which is only called when objPtr->bytes is NULL. 2009-02-09 Jan Nijtmans * generic/tclCompile.c: [Bug 2555129]: const compiler warning (as error) in tclCompile.c 2009-02-07 Donal K. Fellows * generic/tclZlib.c (TclZlibCmd): [Bug 2573172]: Ensure that when invalid subcommand name is given, the list of valid subcommands is produced. This gives a better experience when using the command interactively. 2009-02-05 Joe Mistachkin * generic/tclInterp.c: [Bug 2544618]: Fix argument checking for [interp cancel]. * unix/Makefile.in: Fix build issue with zlib on FreeBSD (and possibly other platforms). 2009-02-05 Donal K. Fellows * generic/tclCmdMZ.c (StringIndexCmd, StringRangeCmd, StringLenCmd): Simplify the implementation of some commands now that the underlying string API knows more about bytearrays. * generic/tclExecute.c (TclExecuteByteCode): [Bug 2568434]: Make sure that INST_CONCAT1 will not lose string reps wrongly. * generic/tclStringObj.c (Tcl_AppendObjToObj): Special-case the appending of one bytearray to another, which can be extremely rapid. Part of scheme to address [Bug 1665628] by making the basic string operations more efficient on byte arrays. (Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetRange): More special casing work for bytearrays. 2009-02-04 Don Porter * generic/tclStringObj.c: [Bug 2561794]: Added overflow protections to the AppendUtfToUtfRep routine to either avoid invalid arguments and crashes, or to replace them with controlled panics. * generic/tclCmdMZ.c: [Bug 2561746]: Prevent crashes due to int overflow of the length of the result of [string repeat]. 2009-02-03 Jan Nijtmans * macosx/tclMacOSXFCmd.c: Eliminate some unnessary type casts * unix/tclLoadDyld.c: some internal const decorations * unix/tclUnixCompat.c: spacing * unix/tclUnixFCmd.c * unix/tclUnixFile.c * win/tclWinDde.c * win/tclWinFCmd.c * win/tclWinInit.c * win/tclWinLoad.c * win/tclWinPipe.c * win/tclWinReg.c * win/tclWinTest.c * generic/tclBasic.c * generic/tclBinary.c * generic/tclCmdAH.c * generic/tclCmdIL.c * generic/tclCmdMZ.c * generic/tclCompCmds.c * generic/tclDictObj.c 2009-02-03 Donal K. Fellows * generic/tclObj.c (tclCmdNameType): [Bug 2558422]: Corrected the type of this structure so that extensions that write it (yuk!) will still be able to function correctly. 2009-02-03 Don Porter * generic/tclStringObj.c (SetUnicodeObj): [Bug 2561488]: Corrected failure of Tcl_SetUnicodeObj() to panic on a shared object. Also factored out common code to reduce duplication. * generic/tclObj.c (Tcl_GetStringFromObj): Reduce code duplication. 2009-02-02 Don Porter * generic/tclInterp.c: Reverted the conversion of [interp] into an * tests/interp.test: ensemble. Such conversion is not necessary * tests/nre.test: (or even all that helpful) in the NRE-enabling of [interp invokehidden], and it has other implications -- including significant forkage of the 8.5 and 8.6 implementations -- that are better off avoided if there's no gain. * generic/tclStringObj.c (STRING_NOMEM): [Bug 2494093]: Add missing cast of NULL to (char *) that upsets some compilers. * generic/tclStringObj.c (Tcl_(Attempt)SetObjLength): [Bug 2553906]: Added protections against callers asking for negative lengths. It is likely when this happens that an integer overflow is to blame. 2009-02-01 David Gravereaux * win/makefile.vc: Allow nmake flags such as -a (rebuild all) to pass down to the pkgs targets, too. 2009-01-30 Donal K. Fellows * doc/chan.n: [Bug 1216074]: Added another extended example. * doc/refchan.n: Added an example of how to build a scripted channel. 2009-01-29 Donal K. Fellows * tests/stringObj.test: [Bug 2006888]: Remove non-ASCII chars from non-comment locations in the file, making it work more reliably in locales with a non-Latin-1 default encoding. * generic/tclNamesp.c (Tcl_FindCommand): [Bug 2519474]: Ensure that the path is not searched when the TCL_NAMESPACE_ONLY flag is given. * generic/tclOODecls.h (Tcl_OOInitStubs): [Bug 2537839]: Make the declaration of this macro work correctly in the non-stub case. 2009-01-29 Don Porter * generic/tclInterp.c: Convert the [interp] command into a * tests/interp.test: [namespace ensemble]. Work in progress * tests/nre.test: to NRE-enable the [interp invokehidden] subcommand. 2009-01-29 Donal K. Fellows * generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529117]: Make this function behave more sensibly when presented with a fully-qualified name, rather than doing strange stuff. 2009-01-28 Donal K. Fellows * generic/tclBasic.c (TclInvokeObjectCommand): Made this understand what to do if it ends up being used on a command with no objProc; that shouldn't happen, but... * generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529157]: Made this understand NRE command implementations better. * generic/tclDictObj.c (DictForCmd): Eliminate unnecessary command implementation. 2009-01-27 Donal K. Fellows * generic/tclOODefineCmds.c (Tcl_ClassSetConstructor): [Bug 2531577]: Ensure that caches of constructor chains are cleared when the constructor is changed. 2009-01-26 Alexandre Ferrieux * generic/tclInt.h: [Bug 1028264]: WSACleanup() too early. * generic/tclEvent.c: The fix introduces "late exit handlers" for * win/tclWinSock.c: similar late process-wide cleanups. 2009-01-26 Alexandre Ferrieux * win/tclWinSock.c: [Bug 2446662]: Resync Win behavior on RST with that of unix (EOF). 2009-01-26 Donal K. Fellows * generic/tclZlib.c (ChanClose): [Bug 2536400]: Only generate error messages in the interpreter when the thread is not being closed down. 2009-01-23 Donal K. Fellows * doc/zlib.n: Added a note that 'zlib push' is reversed by 'chan pop'. 2009-01-22 Jan Nijtmans * generic/tclCompile.h: CONSTify TclPrintInstruction (TIP #27) * generic/tclCompile.c * generic/tclInt.h: CONSTify TclpNativeJoinPath (TIP #27) * generic/tclFileName.c * generic/tcl.decls: {unix win} is equivalent to {generic} * generic/tclInt.decls * generic/tclDecls.h: (regenerated) * generic/tclIntDecls.h * generic/tclGetDate.y: Single internal const decoration. * generic/tclDate.c: 2009-01-22 Kevin B. Kenny * unix/tcl.m4: Corrected a typo ($(SHLIB_VERSION) should be ${SHLIB_VERSION}). * unix/configure: Autoconf 2.59 2009-01-21 Andreas Kupries * generic/tclIORChan.c (ReflectClose): [Bug 2458202]: * generic/tclIORTrans.c (ReflectClose): Closing a channel may supply NULL for the 'interp'. Test for finalization needs to be different, and one place has to pull the interp out of the channel instead. 2009-01-21 Don Porter * generic/tclStringObj.c: New fix for [Bug 2494093] replaces the flawed attempt committed 2009-01-09. 2009-01-19 Kevin B. Kenny * unix/Makefile.in: [Patch 907924]:Added a CONFIG_INSTALL_DIR * unix/tcl.m4: parameter so that distributors can control where tclConfig.sh goes. Made the installation of 'ldAix' conditional upon actually being on an AIX system. Allowed for downstream packagers to customize SHLIB_VERSION on BSD-derived systems. Thanks to Stuart Cassoff for his help. * unix/configure: Autoconf 2.59 2009-01-19 David Gravereaux * win/build.vc.bat: Improved tools detection and error message * win/makefile.vc: Reorganized the $(TCLOBJ) file list into separate parts for easier maintenance. Matched all sources built using -GL to both $(lib) and $(link) to use -LTCG and avoid a warning message. Addressed the over-building nature of the htmlhelp target by moving from a pseudo target to a real target dependent on the entire docs/ directory contents. * win/nmakehlp.c: Removed -g option and GrepForDefine() func as it isn't being used anymore. The -V option method is much better. 2009-01-16 Don Porter * generic/tcl.h: Bump patchlevel to 8.6b1.1 to distinguish * library/init.tcl: CVS snapshots from the 8.6b1 and 8.6b2 releases * unix/configure.in: and to deal with the fact that the 8.6b1 * win/configure.in: version of init.tcl will not [source] in the HEAD version of Tcl. * unix/configure: autoconf-2.59 * win/configure: 2009-01-14 Don Porter * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Reverted most of the substance of my 2009-01-12 commit. NULLing the objProc field of a Command when deleting it is important so that tests for certain classes of commands don't return false positives when applied to deleted command tokens. Overall change is now just replacement of a false comment with a true one. 2009-01-13 Jan Nijtmans * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when using the native CC. * unix/configure (autoconf-2.59) 2009-01-13 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_ThrowObjCmd): Move implementation of [throw] * library/init.tcl (throw): to C from Tcl. 2009-01-12 Don Porter * generic/tclBasic.c (Tcl_DeleteCommandFromToken): One consequence of the NRE rewrite is that there are now situations where a NULL objProc field in a Command struct is perfectly normal. Removed an outdated comment in Tcl_DeleteCommandFromToken that claimed we use cmdPtr->objPtr==NULL as a test of command validity. In fact we use cmdPtr->flags&CMD_IS_DELETED to perform that test. Also removed the setting to NULL, since any extension following the advice of the old comment is going to be broken by NRE anyway, and needs to shift to flag-based testing (or stop intruding into such internal matters). Part of [Bug 2486550]. 2009-01-09 Don Porter * generic/tclStringObj.c (STRING_SIZE): [Bug 2494093]: Corrected failure to limit memory allocation requests to the sizes that can be supported by Tcl's memory allocation routines. 2009-01-09 Donal K. Fellows * generic/tclNamesp.c (NamespaceEnsembleCmd): [Bug 1558654]: Error out when someone gives wrong # of args to [namespace ensemble create]. 2009-01-08 Don Porter * generic/tclStringObj.c (STRING_UALLOC): [Bug 2494093]: Added missing parens required to get correct results out of things like STRING_UALLOC(num + append). 2009-01-08 Donal K. Fellows * generic/tclDictObj.c, generic/tclIndexObj.c, generic/tclListObj.c, * generic/tclObj.c, generic/tclStrToD.c, generic/tclUtil.c, * generic/tclVar.c: Generate errorcodes for the error cases which approximate to "I can't interpret that string as one of those" and "You gave me the wrong number of arguments". 2009-01-07 Donal K. Fellows * doc/dict.n: [Tk Bug 2491235]: Added more examples. * tests/oo.test (oo-22.1): Adjusted test to be less dependent on the specifics of how [info frame] reports general frame information, and instead to focus on what methods add to it; that's really what the test is about anyway. 2009-01-06 Don Porter * tests/stringObj.test: Revise tests that demand a NULL Tcl_ObjType in certain values to construct those values with [testdstring] so there's no lack of robustness depending on the shimmer history of shared literals. 2009-01-06 Donal K. Fellows * generic/tclDictObj.c (DictIncrCmd): Corrected twiddling in internals of dictionaries so that literals can't get destroyed. * tests/expr.test: [Bug 2006879]: Eliminate non-ASCII char. * generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd): [Bug 2489836]: Only delete pointers that were actually allocated! * generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance): [Bug 2481109]: Perform search for existing commands in right context. 2009-01-05 Donal K. Fellows * generic/tclCmdMZ.c (TclNRSourceObjCmd): [Bug 2412068]: Make * generic/tclIOUtil.c (TclNREvalFile): implementation of the [source] command be NRE enabled so that [yield] inside a script sourced in a coroutine can work. 2009-01-04 Donal K. Fellows * generic/tclCmdAH.c: Tidy up spacing and code style. 2009-01-03 Kevin B. Kenny * library/clock.tcl (tcl::clock::add): Fixed error message formatting in the case where [clock add] is presented with a bad switch. * tests/clock.test (clock-65.1) Added a test case for the above problem [Bug 2481670]. 2009-01-02 Donal K. Fellows * unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 878333]: Force the use of the compatibility version of mkstemp() on IRIX. * unix/configure.in, unix/Makefile.in (mkstemp.o): * compat/mkstemp.c (new file): [Bug 741967]: Added a compatibility implementation of the mkstemp() function, which is apparently needed on some platforms. ****************************************************************** *** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008" *** *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" *** *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" *** *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" *** *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ****************************************************************** tcl8.6.14/README.md0000644000175000017500000001625214554262142013127 0ustar sergeisergei# README: Tcl This is the **Tcl 8.6.14** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). [![Build Status](https://github.com/tcltk/tcl/workflows/Linux/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-6-branch) [![Build Status](https://github.com/tcltk/tcl/workflows/Windows/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-6-branch) [![Build Status](https://github.com/tcltk/tcl/workflows/macOS/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-6-branch) ## Contents 1. [Introduction](#intro) 2. [Documentation](#doc) 3. [Compiling and installing Tcl](#build) 4. [Development tools](#devtools) 5. [Tcl newsgroup](#complangtcl) 6. [The Tcler's Wiki](#wiki) 7. [Mailing lists](#email) 8. [Support and Training](#support) 9. [Tracking Development](#watch) 10. [Thank You](#thanks) ## 1. Introduction Tcl provides a powerful platform for creating integration applications that tie together diverse applications, protocols, devices, and frameworks. When paired with the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that run on PCs, Unix, and Mac OS X. Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. Tcl is maintained, enhanced, and distributed freely by the Tcl community. Source code development and tracking of bug reports and feature requests take place at [core.tcl-lang.org](https://core.tcl-lang.org/). Tcl/Tk release and mailing list services are [hosted by SourceForge](https://sourceforge.net/projects/tcl/) with the Tcl Developer Xchange hosted at [www.tcl-lang.org](https://www.tcl-lang.org). Tcl is a freely available open-source package. You can do virtually anything you like with it, such as modifying it, redistributing it, and selling it either in whole or in part. See the file `license.terms` for complete information. ## 2. Documentation Extensive documentation is available on our website. The home page for this release, including new features, is [here](https://www.tcl-lang.org/software/tcltk/8.6.html). Detailed release notes can be found at the [file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/) by clicking on the relevant version. Information about Tcl itself can be found at the [Developer Xchange](https://www.tcl-lang.org/about/). There have been many Tcl books on the market. Many are mentioned in [the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206). The complete set of reference manual entries for Tcl 8.6 is [online, here](https://www.tcl-lang.org/man/tcl8.6/). ### 2a. Unix Documentation The `doc` subdirectory in this release contains a complete set of reference manual entries for Tcl. Files with extension "`.1`" are for programs (for example, `tclsh.1`); files with extension "`.3`" are for C library procedures; and files with extension "`.n`" describe Tcl commands. The file "`doc/Tcl.n`" gives a quick summary of the Tcl language syntax. To print any of the man pages on Unix, cd to the "doc" directory and invoke your favorite variant of troff using the normal -man macros, for example groff -man -Tpdf Tcl.n >output.pdf to print Tcl.n to PDF. If Tcl has been installed correctly and your "man" program supports it, you should be able to access the Tcl manual entries using the normal "man" mechanisms, such as man Tcl ### 2b. Windows Documentation The "doc" subdirectory in this release contains a complete set of Windows help files for Tcl. Once you install this Tcl release, a shortcut to the Windows help Tcl documentation will appear in the "Start" menu: Start | Programs | Tcl | Tcl Help ## 3. Compiling and installing Tcl There are brief notes in the `unix/README`, `win/README`, and `macosx/README` about compiling on these different platforms. There is additional information about building Tcl from sources [online](https://www.tcl-lang.org/doc/howto/compile.html). ## 4. Development tools ActiveState produces a high-quality set of commercial quality development tools that is available to accelerate your Tcl application development. Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger, static code checker, single-file wrapping utility, bytecode compiler, and more. More information can be found at https://www.activestate.com/products/tcl/ ## 5. Tcl newsgroup There is a USENET newsgroup, "`comp.lang.tcl`", intended for the exchange of information about Tcl, Tk, and related applications. The newsgroup is a great place to ask general information questions. For bug reports, please see the "Support and bug fixes" section below. ## 6. Tcl'ers Wiki There is a [wiki-based open community site](https://wiki.tcl-lang.org/) covering all aspects of Tcl/Tk. It is dedicated to the Tcl programming language and its extensions. A wealth of useful information can be found there. It contains code snippets, references to papers, books, and FAQs, as well as pointers to development tools, extensions, and applications. You can also recommend additional URLs by editing the wiki yourself. ## 7. Mailing lists Several mailing lists are hosted at SourceForge to discuss development or use issues (like Macintosh and Windows topics). For more information and to subscribe, visit [here](https://sourceforge.net/projects/tcl/) and go to the Mailing Lists page. ## 8. Support and Training We are very interested in receiving bug reports, patches, and suggestions for improvements. We prefer that you send this information to us as tickets entered into [our issue tracker](https://core.tcl-lang.org/tcl/reportlist). We will log and follow-up on each bug, although we cannot promise a specific turn-around time. Enhancements may take longer and may not happen at all unless there is widespread support for them (we're trying to slow the rate at which Tcl/Tk turns into a kitchen sink). It's very difficult to make incompatible changes to Tcl/Tk at this point, due to the size of the installed base. The Tcl community is too large for us to provide much individual support for users. If you need help we suggest that you post questions to `comp.lang.tcl` or ask a question on [Stack Overflow](https://stackoverflow.com/questions/tagged/tcl). We read the newsgroup and will attempt to answer esoteric questions for which no one else is likely to know the answer. In addition, see the wiki for [links to other organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training. ## 9. Tracking Development Tcl is developed in public. You can keep an eye on how Tcl is changing at [core.tcl-lang.org](https://core.tcl-lang.org/). ## 10. Thank You We'd like to express our thanks to the Tcl community for all the helpful suggestions, bug reports, and patches we have received. Tcl/Tk has improved vastly and will continue to do so with your help. tcl8.6.14/ChangeLog.19990000644000175000017500000026201314554262142014032 0ustar sergeisergei1999-12-22 Jeff Hobbs * changes: updated changes file * tools/tclSplash.bmp: updated to show 8.3 1999-12-21 Jeff Hobbs * README: * generic/tcl.h: * mac/README: * unix/configure.in: * tools/tcl.wse.in: * win/README.binary: * win/configure.in: updated to patch level 8.3b1 * unix/Makefile.in: added -srcdir=... for 'make html' * doc/Hash.3: fixed reference to ckfree [Bug 3912] * doc/RegExp.3: fixed calling params for Tcl_RegExecFromObj * doc/open.n: fixed minor formatting errors * doc/string.n: fixed minor formatting errors * doc/lsort.n: added -unique docs * tests/cmdIL.test: * generic/tclCmdIL.c: added -unique option to lsort * generic/tclThreadTest.c: changed thread ids to longs [Bug 3902] * mac/tclMacOSA.c: fixed applescript for I18N [Bug 3644] * win/mkd.bat: * win/rmd.bat: removed necessity of tag.txt [Bug 3874] * win/tclWinThrd.c: changed CreateThread to _beginthreadex and ExitThread to _endthreadex 1999-12-12 Jeff Hobbs * doc/glob.n: * tests/fileName.test: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclEncoding.c: * generic/tclFileName.c: * mac/tclMacFile.c: * unix/tclUnixFile.c: * win/tclWinFile.c: enhanced the glob command with the new options -types -path -directory and -join. Deprecated TclpMatchFiles with TclpMatchFilesTypes, extended TclGlob and TclDoGlob and added GlobTypeData structure. [Bug 2363] 1999-12-10 Jeff Hobbs * tests/var.test: * generic/tclCompile.c: fixed problem where setting to {} array would intermittently not work. [Bug 3339] (Fontaine) * generic/tclCmdMZ.c: * generic/tclExecute.c: optimized INST_TRY_CVT_TO_NUMERIC to recognize boolean objects. [Bug 2815] (Spjuth) * tests/info.test: * tests/parseOld.test: * generic/tclCmdAH.c: * generic/tclProc.c: changed Tcl_UplevelObjCmd (uplevel) and Tcl_EvalObjCmd (eval) to use TCL_EVAL_DIRECT in the single arg case as well, to take advantage of potential pure list input optimization. This means that it won't get byte compiled though, which should be acceptable. * generic/tclBasic.c: made Tcl_EvalObjEx pure list object aware in the TCL_EVAL_DIRECT case for efficiency. * generic/tclUtil.c: made Tcl_ConcatObj pure list object aware, and return a list object in that case [Bug 2098 2257] * generic/tclMain.c: changed Tcl_Main to not constantly reuse the commandPtr object (interactive case) as it could be shared. (Fellows) * unix/configure.in: * unix/tcl.m4: * unix/tclUnixPipe.c: removed checking for compatible vfork function and use of the vfork function. Modern VM systems rarely suffer any performance degradation when fork is used, and it solves multiple problems with vfork. Users that still want vfork can add -Dfork=vfork to the compile flags. [Bug 942 2228 1312] 1999-12-09 Jeff Hobbs * win/aclocal.m4: made it just include tcl.m4 * doc/exec.n: * doc/open.n: * win/tclWin32Dll.c: * win/tclWinChan.c: * win/tclWinFCmd.c: * win/tclWinInit.c: * win/tclWinPipe.c: * win/tclWinSock.c: removed all code that supported Win32s. It was no longer officially supported, and likely didn't work anyway. * win/makefile.vc: removed 16 bit stuff, cleaned up. * win/tcl16.rc: * win/tclWin16.c: * win/winDumpExts.c: these files have been removed from the source tree (no longer necessary to build) 1999-12-07 Jeff Hobbs * tests/io.test: removed 'knownBug' tests that were for unsupported0, which is now fcopy (that already has tests) * mac/tclMacPort.h: added utime.h include * generic/tclDate.c: * unix/Makefile.in: fixed make gendate to swap const with CONST so it uses the Tcl defined CONST type [Bug 3521] * generic/tclIO.c: removed panic that could occur in FlushChannel when a "blocking" channel would receive EAGAIN, instead treating it the same as non-blocking. [Bug 3773] * generic/tclUtil.c: fixed Tcl_ScanCountedElement to not step beyond the end of the counted string. [Bug 3336] 1999-12-03 Jeff Hobbs * doc/load.n: added note about NT's buggy handling of './' with LoadLibrary * library/http2.1/http.tcl: fixed error handling in http::Event. [Bug 3752] * tests/env.test: removed knownBug limitation from working test * tests/all.tcl: ensured that ::tcltest::testsDirectory would be set to an absolute path * tests/expr-old.test: * tests/parseExpr.test: * tests/string.test: * generic/tclGet.c: * generic/tclInt.h: * generic/tclObj.c: * generic/tclParseExpr.c: * generic/tclUtil.c: * generic/tclExecute.c: added TclCheckBadOctal routine to enhance error message checking for when users use invalid octal numbers (like 08), as well as replumbed the Expr*Funcs with a new VerifyExprObjType to simplify type handling. [Bug 2467] * tests/expr.test: * generic/tclCompile.c: fixed 'bad code length' error for 'expr + {[incr]}' case, with new test case [Bug 3736] and seg fault on 'expr + {[error]}' (different cause) that was caused by a correct optimization that didn't correctly track how it was modifying the source string in the opt. The optimization was removed, which means that: expr 1 + {[string length abc]} will be not be compiled inline as before, but this should be written: expr {1 + [string length abc]} which will be compiled inline for speed. This prevents: expr 1 + {[mindless error]} from seg faulting, and only affects optimizations for degenerate cases [Bug 3737] 1999-12-01 Scott Redman * generic/tcl.decls: * generic/tclMain.c: * unix/tclAppInit.c: * win/tclAppInit.c: Added two new internal functions, TclSetStartupScriptFileName() and TclGetStartupScriptFileName() and added hooks into the main() code for supporting TclPro and other "big" shells more easily without requiring a copy of the main() code. * generic/tclEncoding.c: * generic/tclEvent.c: Moved encoding-related startup code from tclEvent.c into the more appropriate tclEncoding.c. 1999-11-30 Jeff Hobbs * generic/tclIO.c: fix from Kupries for Tcl_UnstackChannel that correctly handles resetting translation and encoding. * generic/tclLoad.c: #def'd out the unloading of DLLs at finalize time for Unix in TclFinalizeLoad. [Bug 2560 3373] Should be parametrized to allow for user to specify unload or not. * win/tclWinTime.c: fixed handling of %Z on NT for time zones that don't have DST. 1999-11-29 Jeff Hobbs * library/dde1.1/pkgIndex.tcl: * library/reg1.0/pkgIndex.tcl: added supported for debugged versions of the libraries * unix/tclUnixPipe.c: fixed PipeBlockModeProc to properly set isNonBlocking flag on pipe. [Bug 1356 710] removed spurious fcntl call from PipeBlockModeProc * tests/scan.test: * generic/tclScan.c: fixed scan where %[..] didn't match anything and added test case. [Bug 3700] 1999-11-24 Jeff Hobbs * doc/open.n: * win/tclWinSerial.c: adopted patch from Schroedter to handle fconfigure $sock -lasterror on Windows. [RFE 3368] * generic/tclCmdIL.c: made SORTMODE_INTEGER work with Longs [Bug 3652] 1999-11-23 Scott Stanton * library/tcltest1.0/tcltest.tcl: Fixed bug where tcltest output went to stdout instead of the specified output file in some cases. 1999-11-19 Jeff Hobbs * generic/tclProc.c: backed out change from 1999-11-18 as it could affect return string from upvar as well. * tools/tcl.wse.in: added tcltest1.0 library to distribution list * doc/http.n: * library/http2.1/http.tcl: * library/http2.1/pkgIndex.tcl: updated http package to 2.2 1999-11-18 Jeff Hobbs * unix/tcl.m4: added defined for _THREAD_SAFE in --enable-threads case; added check for pthread_mutex_init in libc; in AIX case, with --enable-threads ${CC}_r is used; fixed flags when using gcc on SCO * generic/tclProc.c: corrected error reporting for default case at the global level for uplevel command. * generic/tclIOSock.c: changed int to size_t type for len in TclSockMinimumBuffers. * generic/tclCkalloc.c: fixed Tcl_DbCkfree to return a value on NULL input. [Bug 3400] * generic/tclStringObj.c: fixed support for passing in negative length to Tcl_SetUnicodeObj, et al handling routines. [Bug 3380] * doc/scan.n: * tests/scan.test: * generic/tclScan.c: finished support for inline scan by supporting XPG identifiers. * doc/http.n: * library/http2.1/http.tcl: added register and unregister commands to http:: package (better support for tls/SSL), as well as -type argument to http::geturl. [RFE 2617] * generic/tclBasic.c: removed extra decr of numLevels in Tcl_EvalObjEx that could cause seg fault. (mjansen@wendt.de) * generic/tclEvent.c: fixed possible lack of MutexUnlock in Tcl_DeleteExitHandler. [Bug 3545] * unix/tcl.m4: Added better pthreads library check and inclusion of _THREAD_SAFE in --enable-threads case Added support for gcc config on SCO * doc/glob.n: added note about ..../ glob behavior on Win9* * doc/tcltest.n: fixed minor example errors. [Bug 3551] 1999-11-17 Brent Welch * library/http2.1/http.tcl: Correctly fixed the -timeout problem mentioned in the 10-29 change. Also added error handling for failed writes on the socket during the protocol. 1999-11-09 Jeff Hobbs * doc/open.n: corrected docs for 'a' open mode. * generic/tclIOUtil.c: changed Tcl_Alloc to ckalloc * generic/tclInt.h: * generic/tclObj.c: rolled back changes from 1999-10-29 Purify noted new leaks with that code * generic/tclParse.c: added code in Tcl_ParseBraces to test for possible unbalanced open brace in a comment * library/init.tcl: removed the installed binary directory from the auto_path variable * tools/tcl.wse.in: updated to 8.3a1, fixed install of twind.tcl and koi8-r.enc files * unix/tcl.m4: added recognition of pthreads library for AIX 1999-10-29 Brent Welch * generic/tclInt.h: Modified the TclNewObj and TclDecrRefCount in two ways. First, in the case of TCL_THREADS, we do not use the special Tcl_Obj allocator because that is a source of lock contention. Second, general code cleanup to eliminate duplicated code. In particular, TclDecrRefCount now uses TclFreeObj instead of duplicating that code, so it is now identical to Tcl_DecrRefCount. * generic/tclObj.c: Changed Tcl_NewObj so it uses the TclNewObj macro instead of duplicating the code. Adjusted TclFreeObj so it understands the TCL_THREADS case described above. * library/http2.1/http.tcl: Fixed a bug in the handling of the state(status) variable when the -timeout flag is specified. Previously it was possible to leave the status undefined instead of empty, which caused errors in http::status 1999-10-28 Jeff Hobbs * unix/aclocal.m4: made it just include tcl.m4 * library/tcltest1.0/tcltest.tcl: updated makeFile to return full pathname of file created * generic/tclStringObj.c: fixed Tcl_AppendStringsToObjVA so it only iterates once over the va_list (avoiding a memcpy of it, which is not portable). * generic/tclEnv.c: fixed possible ABR error in environ array * tests/scan.test: * generic/tclScan.c: added support for use of inline scan, XPG3 currently not included * tests/incr.test: * tests/set.test: * generic/tclCompCmds.c: fixed improper bytecode handling of 'eval {set array($unknownvar) 5}' (also for incr). [Bug 3184] * win/tclWinTest.c: added testvolumetype command, as atime is completely ignored for Windows FAT file systems * win/tclWinPort.h: added sys/utime.h to includes * unix/tclUnixPort.h: added utime.h to includes * doc/file.n: * tests/cmdAH.test: * generic/tclCmdAH.c: added time arguments to atime and mtime file command methods (support 'touch' functionality) 1999-10-20 Jeff Hobbs * unix/tclUnixNotfy.c: fixed event/io threading problems by making triggerPipe non-blocking. [Bug 2792] * library/tcltest1.0/tcltest.tcl: * generic/tclThreadTest.c: fixed mem leaks in threads * generic/tclResult.c: fixed Tcl_AppendResultVA so it only iterates once over the va_list (avoiding a memcpy of it, which is not portable). * generic/regc_color.c: fixed mem leak and assertion, from HS * generic/tclCompile.c: removed savedChar trick that appeared to be causing a segv when the literal table was released * tests/string.test: * generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj when indexing into one (test case string-5.16). [Bug 2871] * library/http2.1/http.tcl: protected gets with catch. [Bug 2665] 1999-10-19 Jennifer Hom * tests/tcltest.test: * doc/tcltest.n: * library/tcltest1.0/tcltest.tcl: Removed the extra return at the end of the tcltest.tcl file, added version information about tcl. Applied patches sent in by Andreas Kupries to add helper procs for debug output, add 3 new flags (-testsdir, -load, -loadfile), and internally refactors common code for dealing with paths into separate procedures. [Bug 2838, 2842] Merged code from core-8-2-1 branch that changes the checks for the value of tcl_interactive to also incorporate a check for the existence of the variable. * tests/autoMkindex.test: * tests/pkgMkIndex.test: Explicitly cd to ::tcltest::testsDirectory at the beginning of the test run * tests/basic.test: Use version information defined in tcltest instead of hard-coded version number * tests/socket.test: package require tcltest before attempting to use variable defined in tcltest namespace * tests/unixInit.test: * tests/unixNotfy.test: Added explicit exits needed to avoid problems when the tests area run in wish. 1999-10-12 Jim Ingham * mac/tclMacLoad.c: Stupid bug - we converted the filename to external, but used the unconverted version. * mac/tclMacFCmd.c: Fix a merge error in the bug fix for [Bug 2869] 1999-10-12 Jeff Hobbs * generic/regc_color.c: * generic/regc_cvec.c: * generic/regc_lex.c: * generic/regc_locale.c: * generic/regcomp.c: * generic/regcustom.h: * generic/regerrs.h: * generic/regex.h: * generic/regexec.c: * generic/regguts.h: * generic/tclRegexp.c: * generic/tclTest.c: * tests/reg.test: updated to Henry Spencer's new regexp engine (mid-Sept 99). Should greatly reduce stack space reqs. * library/tcltest1.0/pkgIndex.tcl: fixed procs in pkgIndex.tcl file * generic/tclEnv.c: fixed mem leak with putenv and DStrings * doc/Encoding.3: corrected docs * tests/basic.test: updated test cases for 8.3 * tests/encoding.test: fixed test case that change system encoding to a double-byte one (this causes a bogus mem read error for purify) * unix/Makefile.in: purify has to use -best-effort to instrument * unix/tclAppInit.c: identified potential mem leak when compiling tcltest (not critical) * unix/tclUnixPipe.c: fixed mem leak in TclpCreateProcess when doing alloc between vfork and execvp. * unix/tclUnixTest.c: fixed mem leak in findexecutable test command 1999-10-05 Jeff Hobbs * {win,mac,unix,tools,}/README: * win/README.binary: * win/makefile.vc: * {win,unix}/configure.in: * generic/tcl.h: * library/init.tcl: updated to 8.3a1 from 8.2.0. * library/http2.1/http.tcl: fixed possible use of global c var. * win/tclWinReg.c: fixed registry command to properly 'get' HKEY_PERFORMANCE_DATA root key data. Needs more work. * generic/tclNamesp.c: * generic/tclVar.c: * generic/tclCmdIL.c: fixed comment typos * mac/tclMacFCmd.c: fixed filename stuff to support UTF-8. [Bug 2869] * win/tclWinSerial.c: changed SerialSetOptionProc to return TCL_OK by default. (patch from Rolf Schroedter) 1999-09-21 Jennifer Hom * library/tcltest1.0/tcltest.tcl: Applied patches sent in by Andreas Kupries to fix typos in comments and ::tcltest::grep, fix hook redefinition problems, and change "string compare" to "string equal". [Bug 2836, 2837, 2839, 2840] 1999-09-20 Jeff Hobbs * tests/env.test: * unix/Makefile.in: added support for AIX LIBPATH env var. [Bug 2793] removed second definition of INCLUDE_INSTALL_DIR (the one that referenced @includedir@) [Bug 2805] * unix/dltest/Makefile.in: added -lc to LIBS. [Bug 2794] 1999-09-16 Jeff Hobbs * tests/timer.test: changed after delay in timer test 6.29 from 1 to 10. [Bug 2796] * tests/pkg.test: * generic/tclPkg.c: fixed package version check to disallow 1.2..3 [Bug 2539] * unix/Makefile.in: fixed gendate target - this never worked since RCS was intro'd. * generic/tclGetDate.y: updated to reflect previous changes to tclDate.c (leap year calc) and added CEST and UCT time zone recognition. Fixed 4 missing UCHAR() casts. [Bug 2717, 954, 1245, 1249] * generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really dump to stderr and close it [Bug 725] and changed Tcl_Ckrealloc and Tcl_Ckfree to not bomb when NULL was passed in [Bug 1719] and changed Tcl_Alloc, et al to not panic when a alloc request for zero came through and NULL was returned (valid on AIX, Tru64) [Bug 2795, etc] * tests/clock.test: * doc/clock.n: * generic/tclClock.c: added -milliseconds switch to clock clicks to guarantee that the return value of clicks is in the millisecs granularity. [Bug 2682, 1332] 1999-09-15 Jeff Hobbs * generic/tclIOCmd.c: fixed potential core dump in conjunction with stacked channels with result obj manipulation in Tcl_ReadChars. [Bug 2623] * tests/format.test: * generic/tclCmdAH.c: fixed translation of %0#s in format. [Bug 2605] * doc/msgcat.n: fixed \\ bug in example. [Bug 2548] * unix/tcl.m4: * unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition [Bug 2070] and fix for IRIX SHLIB_LB_LIBS. [Bug 2610] * doc/array.n: * tests/var.test: * tests/set.test: * generic/tclVar.c: added an array unset operation, with docs and tests. Variation of [Bug 1775]. Added fix in TclArraySet to check when trying to set in a non-existent namespace. [Bug 2613] 1999-09-14 Jeff Hobbs * tests/linsert.test: * doc/linsert.n: * generic/tclCmdIL.c: fixed end-int interpretation of linsert to correctly calculate value for end, added test and docs. [Bug 2693] * doc/regexp.n: * doc/regsub.n: * tests/regexp.test: * generic/tclCmdMZ.c: add -start switch to regexp and regsub with docs and tests * doc/switch.n: added proper use of comments to example. * generic/tclCmdMZ.c: changed switch to complain when an error occurs that seems to be due to a misplaced comment. * generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions in regsub. [Bug 2723] * generic/tclCmdMZ.c: changed [string equal] to return an Int type object (was a Boolean) 1999-09-01 Jennifer Hom * library/tcltest1.0/tcltest.tcl: Process command-line arguments only ::tcltest doesn't have a child namespace (requires that command-line args are processed in that namespace) 1999-09-01 Jeff Hobbs * generic/tclParseExpr.c: changed '"' to '\"' to make FreeBSD happy. [Bug 2625] * generic/tclProc.c: moved static buf to better location and changed static msg that would overflow in ProcessProcResultCode [Bug 2483] and added Tcl_DStringFree to Tcl_ProcObjCmd. Also reworked size of static buffers. * tests/stringObj.test: added test 9.11 * generic/tclStringObj.c: changed Tcl_AppendObjToObj to properly handle the 1-byte dest and mixed src case where both had had Unicode string len checks made on them. [Bug 2678] * unix/aclocal.m4: * unix/tcl.m4: adjusted fix from 8-21 to add -bnoentry to the AIX-* case and readjusted the range 1999-08-31 Jennifer Hom * library/tcltest1.0/tcltest.tcl: * doc/tcltest.n: * tests/README: Modified testConstraints variable so that it isn't unset every time ::tcltest::initConstraints is called and cleaned up documentation in the README file and the man page. 1999-08-27 Jennifer Hom * tests/env.test: * tests/exec.test: * tests/io.test: * tests/event.test: * tests/tcltest.test: Added 'exit' calls to scripts that the tests themselves write, and removed accidental checkin of knownBugThreaded constraints for Solaris and Linux. * library/tcltest1.0/tcltest.tcl: Modified tcltest so that variables are only initialized to their default values if they did not previously exist. 1999-08-26 Jennifer Hom * tests/tcltest.test: * library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a variable named ::tcltest::parameters based on whatever's being sent in as the argument to the -args flag. 1999-08-23 Jennifer Hom * tests/tcltest.test: Added additional tests for -tmpdir, marked all tests that use exec as unixOrPc. * tests/encoding.test: * tests/interp.test: * tests/macFCmd.test: * tests/parseOld.test: * tests/regexp.test: Applied patches from Jim Ingham to add encoding to a Mac only interp test, change an error message in macFCmd.tet, put a comment in parseOld.test, fix tests using the testencoding path command, and put unixOrPc constraints on tests that use exec. 1999-08-21 Jeff Hobbs * unix/aclocal.m4: Changed AIX-4.[2-9] check to AIX-4.[1-9] [Bug 1909] 1999-08-20 Jeff Hobbs * generic/tclPosixStr.c: fixed typo. [Bug 2592] * doc/*: fixed various nroff bugs in man pages. [Bug 2503 2588] 1999-08-19 Jeff Hobbs * win/README.binary: fixed version info and some typos. [Bug 2561] * doc/interp.n: updated list of commands available in a safe interpreter. [Bug 2526] * generic/tclIO.c: changed Tcl_GetChannelNames* to use style guide headers (pleases HP cc) 1999-08-18 Jeff Hobbs * doc/Eval.3: fixed doc on input args. [Bug 2114] * doc/OpenFileChnl.3: * doc/file.n: * tests/cmdAH.test: * tclIO.c: * tclCmdAH.c: added "file channels ?pattern?" tcl command, with associated Tcl_GetChannelNames and Tcl_GetChannelNamesEx public C APIs (added to tcl.decls as well), with docs and tests. * tests/expr.test: * generic/tclCompile.c: add TCL_TOKEN_VARIABLE to the part types that cause differed compilation for exprs, to correct the expr double-evaluation problem for vars. Added test cases. Related to [Bug 732] * unix/Makefile.in: changed the dependency structure so that install-* is dependent on * (ie - install-binaries is dependent on binaries). * library/auto.tcl: * library/init.tcl: * library/ldAout.tcl: * library/package.tcl: * library/safe.tcl: * library/word.tcl: * library/http2.1/http.tcl: * library/msgcat1.0/msgcat.tcl: updated libraries to better Tcl style guide (no more string comparisons with == or !=, spacing changes). 1999-08-05 Jim Ingham * mac/tclMacProjects.sea.hqx: Rearrange the projects so that the build directory is separate from the sources. Much more convenient! 1999-08-13 Scott Redman * /: 8.2.0 tagged for final release 1999-08-12 Scott Stanton * win/Makefile.in: Added COMPILE_DEBUG_FLAGS macro to make it easier to turn on compiler tracing. * tests/parse.test: * generic/tclParse.c: Fixed bug in Tcl_EvalEx where the termOffset was not being updated in cases where the evaluation returned a non TCL_OK error code. [Bug 2535] 1999-08-12 Scott Redman * win/tclWinSerial.c: Applied patch from Petteri Kettunen to remove compiler warning. 1999-08-10 Scott Redman * generic/tclAlloc.c: * generic/tclCmdIL.c: * generic/tclIO.c: * generic/tclThread.c: * win/tclWinThrd.c: * unix/tclUnixThrd.c: Fixed Brent's changes so that they work on Windows (and he fixed the bug in the Unix thread implementation). 1999-08-09 Brent Welch * generic/tcl.decls: * generic/tclAlloc.c: * generic/tclCkalloc.c: * generic/tclCmdIL.c: * generic/tclDecls.h: * generic/tclIO.c: * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclVar.c: * mac/tclMacThrd.c: * unix/tclUnixThrd.c: * win/tclWinThrd.c: Added use of Tcl_GetAllocMutex to tclAlloc.c and tclCkalloc.c so they can be linked against alternate thread packages. Added Tcl_GetChannelNames to tclIO.c. Added TclVarTraceExists hook so "info exists" triggers read traces exactly like it did in Tcl 7.6. Stubs table changes to reflect new internal and external APIs. 1999-08-09 Jeff Hobbs * tests/string.test: added largest_int proc to adapt for >32 bit machines and int overflow testing. * tests/tcltest.test: fixed minor error in 8.2 result (from dgp) * doc/Object.3: clarified Tcl_DecrRefCount docs. [Bug 1952] * doc/array.n: clarified array pattern docs. [Bug 1330] * doc/clock.n: fixed clock docs. [Bug 693] * doc/lindex.n: clarified to account for new end-int behavior. * doc/string.n: fixed formatting errors. [Bug 2188 2189] * doc/tclvars.n: fixed doc error. [Bug 2042] * library/init.tcl: fixed path handling in auto_execok (it could miss including the normal path on some Windows machines). [Bug 1276] 1999-08-05 Jeff Hobbs * doc/tclvars.n: Made it clear that tcl_pkgPath was not set for Windows (already mentioned in init.tcl). [Bug 2455] * generic/tclLiteral.c: fixed reference to bytes that might not be null terminated (using objPtr->bytes, which is). [Bug 2496] * library/http2.1/http.tcl: Made use of "i" in init section use local var and start at 0 (was 1). [Bug 2502] 1999-08-04 Scott Stanton * tests/reg.test: Added test for REG_EXPECT bug fixed by Henry's patch. * generic/regc_nfa.c: * generic/regcomp.c: * generic/rege_dfa.c: * generic/regexec.c: * generic/regguts.h: Applied patches supplied by Henry Spencer to greatly enhance the performance of certain classes of regular expressions. [Bug 2440, 2447] 1999-08-03 Scott Redman * win/tclWinInt.h: Remove function declarations in header that was moved to tclInt.decls file in previous changes. 1999-08-02 Scott Redman * unix/configure.in: * win/configure.in: Change beta level to b2. * generic/tcl.h: * generic/tcl.decls: * generic/tclDecls.h: * generic/tclInt.h: * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclRegexp.h: * generic/tclStubInit.c: Move some exported public and internal functions to the stub tables. Removed functions that are in the stub tables (from this and previous changes) from the original header files. 1999-08-01 Scott Redman * win/tclWinSock.c: Added comment block to SocketThread() function. Added code to avoid calling TerminateThread(), but instead to send a message to the socket event window to tell it to terminate its thread. 1999-07-30 Jennifer Hom * tests/tcltest.test: * library/tcltest1.0/tcltest.tcl: Exit with non-zero status if there were problems with the way the test suite was started (e.g. wrong # arguments). 1999-07-30 Jeff Hobbs * generic/tclInt.decls: added declaractions necessary for the Tcl test code to work wth stubs. [Bug 2445] 1999-07-30 Scott Redman * win/tclWinPipe.c: * win/Makefile.in: Fixing launching of 16-bit apps on Win9x from wish. The command line was primed with tclpip82.dll, but it was ignored. Fixed that, then fixed the gmake makefile to build tclpip82.dll as an executable. * win/tclWinSock.c: Applied small patch to get thread-specific data after initializing the socket driver. * unix/tclUnixThrd.c: Applied patch to fix threads on Irix 6.5. Patch from James Dennett. [Bug 2450] * tests/info.test: Enable test for tclParse.c change (info complete). 1999-07-30 Jeff Hobbs * tclIO.c: added fix for Kupries' trf patch. [Bug 2386] * tclParse.c: fixed bug in info complete regarding nested square brackets. [Bug 2382, 2466] 1999-07-29 Scott Redman * win/tclWinChan.c: Allow tcl to open CON and NUL, even for std channels. Checking for bad/unusable std channels was moved to Tk since its only purpose was to check whether to use the Tk Console Window for the std channels. [Bug 2393 2392 2209 2458] * unix/mkLinks.tcl: Applied patch to avoid linking pack.n to pack-old.n. Patch from Don Porter. [Bug 2469] * doc/Encoding.n: Applied patch to fix typo in .SH NAME line. Patch from Don Porter. [Bug 2451] * win/tclWinSock.c: Free Win32 Event handles when destroying the socket helper thread. 1999-07-28 Jennifer Hom * tests/tcltest.test: * library/tcltest1.0/tcltest.tcl: Fixed the condition under which ::tcltest::PrintError had an infinite loop problem and added a test case for it. Added an optional argument to ::tcltest::getMatchingFiles telling it where to search for test files. 1999-07-27 Scott Redman * tools/tclSplash.bmp: Updated Windows installer bitmap to ready Tcl/Tk Version 8.2. 1999-07-26 Scott Redman * tests/tcltest.test: Need to close the new core file, there seems to be a hang in threaded WinNT if the file isn't closed. Open issue, need to fix that hang. * tests/httpold.test: Add time delay in response from Http server so that test cases can properly detect timeout conditions with threads enabled on multi-CPU WinNT. * tests/winFCmd.test: Test case winFcmd-1.33 was looking for c:\windows, which may not exist. Instead, create a new directory on c:\ and use it for the test. * win/tclWinConsole.c: * win/tclWinPipe.c: * win/tclWinSock.c: Fix terminating helper threads by holding any mutexes from the primary thread while waiting for the helper thread to terminate. Without these changes, the test suite hangs on WinNT with 2 CPUs and threads enabled. Open issue, seems to be a sporadic hang on dual CPU systems still (very rare). 1999-07-26 Jennifer Hom * tests/tcltest.test: * library/tcltest1.0/tcltest.tcl: * doc/tcltest.n: Cleaned up code in ::tcltest::PrintError, revised documentation, and added tests for the tcltest package. 1999-07-23 Scott Redman * tests/info.test: * generic/tclParse.c: Removed patch for info command, breaks test cases on Unix. Patch was bad and needs to be redone properly. [Bug 2382] 1999-07-22 Scott Redman * Changed version to 8.2b2. * win/tclWinSock.c: Fixed hang with threads enabled, fixed semaphores with threads disabled. * win/safe.test: Fixed safe-6.3 with threads enabled. * win/Makefile.in: Fixed calling of tcltest to fix safe.test failures due to path TCL_LIBRARY path. * win/tclWinPort.h: Block out include of sys/*.h in order to build extensions with MetroWerks compiler for Win32. [Bug 2385] * generic/tclCmdMZ.c: * generic/tclIO.c: Fix ANSI-style prototypes based on patch from Ulrich Ring. [Bug 2391] * unix/Makefile.in: Need to make install-sh executable before calling (with chmod +x). [Bug 2413] * tests/var.test: * generic/tclVar.c: Fixed bug that caused a seg. fault when using "array set a(b) {}", which is a bad array name anyway. Now the "array set" command will return an error in this case. Added test case and fixed existing test. [Bug 2427] 1999-07-21 Scott Redman * tests/info.test: * generic/tclParse.c: Applied patch to fix "info complete" for the string {[a [b]}. Patch from Peter Spjuth. [Bug 2382] * doc/Utf.3: * generic/tcl.decls: * generic/tclDecls.h: * generic/tclUtf.c: Changed function declarations in non-platform-specific public APIs to use "unsigned long" instead of "size_t", which may not be defined on certain compilers (rather than include sys/types.h, which may not exist). * unix/Makefile.in: Added the Windows configure script to the distribution file list, already shipping configure.in and the .m4 files, but needed the configure script itself. * win/makefile.vc: Changed version number of DDE package in VC++ makefile to use 1.1 instead of 1.0. * doc/open.n: Added documentation of \\.\comX notation for opening serial ports on Windows (alternative to comX:). * tests/ioCmd.test: * doc/open.n: * win/tclWinSerial.c: Applied patch from Rolf Schroedter to add -pollinterval option to fconfigure to modify the maxblocktime used in the fileevent polling. Added documentation and fixed the test case as well. * win/tclWinSock.c: Modified 8.1.0 version of the Win32 socket driver to move the handling of the socket event window in a separate thread. It also turned out that Win95 & Win98 were, in some cases, getting multiple FD_ACCEPTs but only handling one. Added a count for the FD_ACCEPT to take care of this. Tested on NT4 SP3, NT4 SP4, Win95, and Win98. [Bug 2178 2256 2259 2329 2323 2355] 1999-07-21 Jerry Peek * README: Small tweaks to clean up typos and wording. 1999-07-20 Melissa Hirschl * generic/tclInitScript.h: * unix/tclUnixInit.c: merged code with 8.0.5. We now use an intermediate global tcl var "tclDefaultLibrary" to keep the "tcl_library" var from being set by the default value in the Makefile. Also fixed a bug in which caused the value of TCL_LIBRARY env var to be ignored. * unix/tclWinInit.c: just updated some comments. 1999-07-19 Melissa Hirschl * library/http2.1/http.tcl: updated -useragent text to say version 2.1. 1999-07-16 Scott Redman * generic/tcl.decls: * generic/tclDecls.h: * generic/tclStubInit.c: Add Tcl_SetNotifier to stub table. [Bug 2364] * unix/aclocal.m4: * unix/tcl.m4: Add check for Alpha/Linux to correct the IEEE floating flag to the compiler, should be -mieee. Patch from Don Porter. * tools/tcl.hpj.in: Change version number of .cnt file referenced in .HPJ file. 1999-07-15 Scott Redman * tools/tcl.wse.in: Fixed naming of target files for Windows. 1999-07-14 Jerry Peek * doc/re_syntax.n: Deleted sentence as suggested by Scott S. 1999-07-12 Jerry Peek * doc/re_syntax.n: Removed two notes to myself (oops), cleaned up wording, fixed changebars, made two examples easier to read. 1999-07-11 Scott Redman * win/makefile.vc: Since the makefile.vc should continue to work while we're working out bugs/issues in the new TEA-style autoconf/configure/gmake build mechanism for Windows, the version numbers of the Tcl libraries need to remain in sync. Modified the version numbers in the makefile to reflect the change to 8.2b1. 1999-07-09 Scott Redman * win/configure.in: Eval DLLSUFFIX, LIBSUFFIX, and EXESUFFIX in the configure script so that substitutions get expanded before being placed in the Makefile. The "d" portion for debug libraries and DLLs was not being set properly. 1999-07-08 Scott Stanton * tests/string.test: * generic/tclCmdMZ.c: Fixed bug in string range bounds checking code. 1999-07-08 Jennifer Hom * doc/tcltest.n: * library/tcltest1.0/tcltest.tcl: Removed -asidefromdir and -relateddir flags, removed unused ::tcltest::dotests proc, cleaned up implementation of core file checking, and fixed the code that checks for 1-letter flag abbreviations. 1999-07-08 Scott Stanton * win/Makefile.in: Added tcltest target so runtest works properly. Added missing names to the clean/distclean targets. * tests/reg.test: * generic/rege_dfa.c: Applied fix supplied by Henry Spencer for bug in DFA state caching under lookahead conditions. [Bug 2318] 1999-07-07 Scott Stanton * doc/fconfigure.n: Clarified default buffering behavior for the standard channels. [Bug 2335] 1999-07-06 Scott Redman * win/tclWinSerial.c: New implementation of serial port driver from Rolf Shroedter (Rolf.Schroedter@dlr.de) that allows more than one byte to be read from the port. Implemented using polling instead of threads, there is a max. 10ms latency between checking the port for file events. [Bug 1980 2217] 1999-07-06 Brent Welch * library/http2.0/http.tcl: Fixed the -timeout option so it handles timeouts that occur during connection attempts to hosts that are down (the only case that really matters!) 1999-07-03 Brent Welch * doc/ChnlStack.3: * generic/tcl.decls: * generic/tclIO.c: Added a new variant of the "Trf patch" from Andreas Kupres that adds new C APIs Tcl_StackChannel, Tcl_UnstackChannel, and Tcl_GetStackedChannel. 1999-07-03 Brent Welch * generic/tclNotify.c: * unix/tclUnixNotfy.c: * unix/tclXtTest.c: * unix/tclXtNotify.c: * win/tclWinNotify.c: * mac/tclMacNotify.c: Added Tcl_SetNotifier and the associated hook points in the notifiers to be able to replace the notifier calls at runtime. The Xt notifier and test program use this hook. 1999-07-03 Brent Welch * generic/tclParse.c: Changed parsing of variable names to allow empty array names. Now "$(foo)" is a variable reference! Previous you had to use something like $::(foo), which is slower. This change is requested by Jean-Luc Fontaine for his STOOOP package. 1999-07-01 Scott Redman * generic/tclCmdAH.c: * generic/tclFCmd.c: Call TclStat instead of TclpStat in order to allow Tcl_Stat hooks to work properly. 1999-06-29 Jennifer Hom * library/tcltest1.0/pkgIndex.tcl: * library/tcltest1.0/tcltest.tcl: * doc/tcltest.n: * tests/all.tcl: Added -preservecore, -limitconstraints, -help, -file, -notfile, -relateddir and -asidefromdir flags to the tcltest package along with exported proc ::tcltest::getMatchingFiles. The documentation was modified to match and all.tcl was modified to use the new functionality instead of implementing -file itself. 1999-06-28 Scott Redman * generic/tclIndexObj.c: * doc/GetIndex.3: * tests/binary.test: * tests/winDde.test: Applied patch from Peter Hardie (with changes) to fix problem with Tcl_GetIndexFromObj() when the key being passed is the empty string. It used to match "" and return TCL_OK, but it should have returned TCL_ERROR instead. Added test case to "binary" and "dde" commands to check the behavior. Added documentation note as well. 1999-06-26 Scott Redman * win/tclWinDde.c: Applied patch from Peter Hardie to add poke command to dde. Also rev'd version of dde package to 1.1. [Bug 1738] 1999-06-25 Jennifer Hom * unix/Makefile.in: * win/Makefile.in: * library/tcltest1.0/pkgIndex.tcl: * library/tcltest1.0/tcltest.tcl: * library/tcltest1.0: Added initial implementation of the Tcl test harness package. This package was based on the defs.tcl file that was part of the tests directory. Reversed the way that tests were evaluated to fix a problem with false passes. * doc/tcltest.n: Added documentation for the tcltest package. * tests/README: * tests/defs.tcl: * tests/all.tcl: Modified all test files (tests/*.test) and all.tcl to use the new tcltest package and removed references to the defs.tcl file. Modified the README file to point to the man page for tcltest. 1999-06-25 Scott Stanton * tests/reg.test: * generic/regexec.c: Fixed bugs in non-greedy quantifiers. 1999-06-23 Jerry Peek * doc/re_syntax.n: * doc/switch.n: * doc/lsearch.n: * doc/RegExp.3: * doc/regexp.n: * doc/regsub.n: Moved information about syntax of 8.1 regular expressions from regexp(n) manpage into new re_syntax(n) page. Added pointers from other manpages to new re_syntax(n) page. 1999-06-23 Scott Stanton * unix/Makefile.in: Changed install-doc to install-man. * tools/uniParse.tcl: * tools/uniClass.tcl: * tools/README: * tests/string.test: * generic/regc_locale.c: * generic/tclUniData.c: * generic/tclUtf.c: * doc/string.n: Updated Unicode character tables to reflect latest Unicode 2.1 data. Also rationalized "regexp" and "string is" definitions of character classes. 1999-06-21 Scott Stanton * unix/tclUnixThrd.c (TclpThreadCreate): Fixed memory leak where thread attributes were not being released. [Bug 2254] 1999-06-17 Scott Stanton * tests/regexp.test: * generic/tclCmdMZ.c: * generic/tclCmdIL.c: Changed to use new regexp interfaces. Added -expanded, -line, -linestop, and -lineanchor switches to regsub. * doc/RegExp.3: Documented the new regexp interfaces and the compile/execute flags. * generic/tclTest.c: * generic/tclRegexp.h: * generic/tclRegexp.c: * generic/tcl.h: * generic/tcl.decls: Renamed Tcl_RegExpMatchObj to Tcl_RegExpExecObj and added a new Tcl_RegExpMatchObj that is equivalent to Tcl_RegExpMatch. Added public macros for the regexp compile/execute flags. Changed to store either an object pointer or a string pointer in the TclRegexp structure. Changed to avoid adding a reference to the object or copying the string. * generic/regcomp.c: lint * tests/reg.test: * generic/regex.h: * generic/regc_lex.c: Added REG_BOSONLY flag to allow Expect to iterate through a string an only find matches that start at the current position within the string. 1999-06-16 Michael Thomas * unix/configure.in: * unix/Makefile.in: * unix/tcl.m4: * unix/aclocal.m4: Numerous build changes to make Tcl conform to the proposed TEA spec 1999-06-16 Melissa Hirschl * generic/tclVar.c (Tcl_VariableObjCmd): fixed premature increment in loop that was causing out-of-bounds reads on array "varName". 1999-06-16 Scott Stanton * tests/execute.test: * generic/tclExecute.c (TclExecuteByteCode): Fixed crash caused by a bug in INST_LOAD_SCALAR1 where the scalar index was read as a signed 1 byte value instead of unsigned. [Bug 2243] 1999-06-14 Melissa Hirschl * doc/StringObj.3 * test/stringObj.test * unix/Makefile.in * win/Makefile.in * win/makefile.vc * generic/tclStringObj.c: Merged String and Unicode object types. Added new functions to the puplic API: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendUnicodeToObj. 1999-06-09 Scott Stanton * generic/tclUnicodeObj.c: Lots of cleanup and simplification. Fixed several memory bugs. Added TclAppendUnicodeToObj. * generic/tclInt.h: Added declarations for various Unicode string functions. * generic/tclRegexp.c: * generic/tclCmdMZ.c: Changed to use new Unicode string interfaces for better performance. * generic/tclRegexp.h: * generic/tclRegexp.c: * generic/tcl.h: * generic/tcl.decls: Added Tcl_RegExpMatchObj and Tcl_RegExpGetInfo calls to access lower level regexp API. These features are needed by Expect. This is a preliminary implementation pending final review and cleanup. * generic/tclCmdMZ.c: * tests/string.test: Fixed bug where string map failed on null strings * generic/regexec.c: * unix/tclUnixNotfy.c: lint * tools/genStubs.tcl: Changed to always write output in LF mode. 1999-06-08 Scott Stanton * win/tclWinSock.c: Rolled back to the 8.1.0 implementation because of serious problems with the new driver. Basically no incoming socket connections would be reported to a server port. The 8.1.1 code needs to be redesigned and fixed correctly. 1999-06-07 Melissa Hirschl * tests/string.test: * generic/tclVar.c (Tcl_SetVar2Ex): * generic/tclStringObj.c (Tcl_AppendObjToObj): * generic/tclCmdMZ.c (Tcl_StringObjCmd): optimized the string index, string length, string range, and append command in cases where the object's internal rep is a bytearray. Objects with other internal reps are converted to have the new unicode internal rep. * unix/Makefile.in: * win/Makefile.in: * win/Makefile.vc: * tests/unicode.test: * generic/tclInt.h: * generic/tclObj.c: * generic/tclUnicodeObj.c: added a new object type to store the unicode representation of a string. * generic/tclTestObj.c: added the objtype option to the testobj command. This option returns the name of the type of internal rep an object has. 1999-06-04 Scott Stanton * win/configure.in: * win/Makefile.in: Windows build now handles static/dynamic debug/nodebug builds and supports the standard targets using Cygwin user tools plus GNU make and autoconf. 1999-06-03 Scott Stanton * generic/tclCmdMZ.c (Tcl_StringObjCmd): * tests/string.test: Fixed bug where string equal/compare -nocase reported wrong result on null strings. [Bug 2138] 1999-06-02 Scott Stanton * generic/tclUtf.c (Tcl_UtfNcasecmp): Fixed incorrect computation of relative ordering. [Bug 2135] 1999-06-01 Scott Stanton * unix/configure.in: Fixed various small configure.in patches submitted by Jan Nijtmans. [Bug 2121] * tests/reg.test: * generic/regc_color.c: * generic/regc_cvec.c: * generic/regc_lex.c: * generic/regc_locale.c: * generic/regc_nfa.c: * generic/regcomp.c: * generic/regcustom.h: * generic/rege_dfa.c: * generic/regerror.c: * generic/regerrs.h: * generic/regex.h: * generic/regexec.c: * generic/regfree.c: * generic/regfronts.c: * generic/regguts.h: * generic/tclCmdMZ.c: * generic/tclRegexp.c: * generic/tclRegexp.h: * generic/tclTest.c: Applied Henry Spencer's latest regexp patches that fix an infinite loop bug and add support for testing whether a string could match with additional input. [Bug 2117] 1999-05-28 Scott Stanton * generic/tclObj.c: Changed to eliminate use of isupper/tolower in favor of the Unicode versions. * win/Makefile.in: * win/configure.in: Added preliminary TEA implementation. * win/tclWinDde.c: Fixed bug where dde calls were being passed an invalid dde handle because Initialize had not been called. [Bug 2124] 1999-05-26 Scott Redman * generic/tclThreadTest.c: Fixed race condition in testthread code that showed up in the WinNT test suite intermittently. * win/tclWinSock.c: Fixed a hang in the WinNT socket driver, wake up the socket thread every 100ms to check for events on the sockets that did not wake up the thread (race condition). 1999-05-24 Scott Stanton * tools/genStubs.tcl: Changed to allow a list of platforms instead of just one at a time. * generic/tcl.decls: * generic/tclCmdMZ.c: * generic/tclDecls.h: * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclPort.h: * generic/tclStubInit.c: * generic/tclStubLib.c: Various header file related changes and other lint to try to get the Mac builds working. 1999-05-21 Scott Redman * win/tclWinPipe.c: Fix bug when launching command.com on Win95/98. Need to wait for the procInfo.hProcess of the process that was created, not the hProcess of the current process. [Bug 2105] 1999-05-20 Scott Redman * library/init.tcl: Add the directory where the executable is, and the ../lib directory relative to that, to the auto_path variable. 1999-05-19 Scott Stanton Merged in various changes submitted by Jeff Hobbs: * generic/tcl.decls: * generic/tclUtf.c: Added Tcl_UniCharIs* functions for control, graph, print, and punct classes. * generic/tclUtil.c: * doc/StrMatch.3: Added Tcl_StringCaseMatch() implementation to support case-insensitive globbing. * doc/string.n: * unix/mkLinks: * tests/string.test: * generic/tclCmdMZ.c: Added additional character class tests, added -nocase switch to "string match", changed string first/last to use offsets. 1999-05-19 Scott Redman * generic/tcl.h: Add extern "C" block around entire header file for C++ compilers to fix linkage issues. Submitted by Don Porter and Paul Duffin. * generic/tclRegexp.c: Fix bug when the regexp cache is empty and an empty pattern is used in regexp ( such as {} or "" ). 1999-05-18 Scott Stanton * win/tclWinChan.c: Modified initialization code to avoid inherenting closed or invalid channels. If the standard input is anything other than a console, file, serial port, or pipe, then we fall back to the standard Tk window console. 1999-05-14 Scott Stanton * generic/tclCmdAH.c (Tcl_ForObjCmd): Fixed crash caused by failure to reset the result before evaluating the test expression. 1999-05-14 Bryan Surles * generic/tclBasic.c (Tcl_CreateInterp): Added introspection variable for threaded interps. If the interp was compiled with threads enabled, the tcl_platform(threaded) variable will exist. 1999-05-14 Scott Redman * generic/tclDate.c: Applied patch to fix 100-year and 400-year boundaries in leap year code, from Isaac Hollander. [Bug 2066] 1999-05-13 Scott Stanton * unix/Makefile.in: * unix/tclAppInit.c: Minor cleanup related to Xt notifier. * unix/tclUnixInit.c (TclpSetInitialEncodings): Tcl now looks for an encoding subfield in the LANG/LC_ALL variables in cases where the locale is not found in the locale table. Ensure that setlocale() is called at least once so X11 will initialize properly. Also, forces the LC_NUMERIC locale to be "C" so numeric processing in scripts is not affected by the current locale setting. [Bug 1989] * generic/tclRegexp.c: Increased per-thread regexp cache to 30 slots. This seems to be about the right number for larger applications like exmh. [Bug 1063] 1999-05-12 Scott Stanton * doc/tclsh.1: Updated references to rc script names to accurately reflect the platform differences on Windows. * tests/regexp.test: * generic/tclInt.h: * generic/tclBasic.c: * generic/tclRegexp.h: * generic/tclRegexp.c: Replaced the per-interpreter regexp cache with a per-thread cache. Changed the Regexp object to take advantage of this extra cache. Added a reference count to the TclRegexp type so regexps can be shared by multiple objects. Removed the per-interp regexp cache from the interpreter. Now regexps can be used with no need for an interpreter. [Bug 1063] * win/tclWinInit.c (TclpSetVariables): Avoid calling GetUserName if the value can be determined from the USERNAME environment variable. GetUserName is very slow. 1999-05-07 Scott Stanton * win/winDumpExts.c: * win/makefile.vc: Removed incorrect patch. [Bug 1998] * generic/tcl.decls: Replaced const with CONST. * generic/tclResult.c (Tcl_AppendResultVA): * generic/tclStringObj.c (Tcl_AppendStringsToObjVA): Fixed to copy arglist using memcpy instead of assignment so it works properly on OS/390. [Bug 1997] * generic/tclLoadNone.c: Updated to use current interfaces, added TclpUnloadFile. [Bug 2003] * win/winDumpExts.c: * win/makefile.vc: Changed to emit library name in defs file. [Bug 1998] * unix/configure.in: Added fix for OS/390. [Bug 1976] 1999-05-06 Scott Stanton * tests/string.test: * generic/tclCmdMZ.c: * doc/string.n: Fixed bug in string equal/compare code when using -length option. Cleaned up docs a bit more. * tests/http.test: Unset "data" array before running tests to avoid failures due to previous tests. * doc/string.n: * tests/cmdIL.test: * tests/cmdMZ.test: * tests/error.test: * tests/ioCmd.test: * tests/lindex.test: * tests/linsert.test: * tests/lrange.test: * tests/lreplace.test: * tests/string.test: * tests/cmdIL.test: * generic/tclUtil.c: * generic/tclCmdMZ.c: Replaced "string icompare/iequal" with -nocase and -length switches to "string compare/equal". Added a -nocase option to "string map". Changed index syntax to allow integer or end?-integer? instead of a full expression. This is much simpler with safeTcl scripts since it avoids double substitution issues. * doc/Utf.3: * generic/tclStubInit.c: * generic/tclDecls.h: * generic/tclUtf.c: * generic/tcl.decls: Added Tcl_UtfNcmp and Tcl_UtfNcasecmp. 1999-05-05 Scott Stanton * win/makefile.vc: Added encoding directory to install-libraries target. 1999-05-03 Scott Stanton * doc/string.n: * tests/cmdMZ.test: * tests/string.test: * generic/tclCmdMZ.c (Tcl_StringObjCmd): Changed "string length" to avoid regenerating the string rep of a ByteArray object. * tests/cmdIL.test: * tests/cmdMZ.test: * tests/error.test: * tests/lindex.test: * tests/linsert.test: * tests/lrange.test: * tests/lreplace.test: * tests/string.test: * generic/tclCmdMZ.c (Tcl_StringObjCmd): * generic/tclUtil.c (TclGetIntForIndex): Applied Jeff Hobbs's string patch which includes the following changes [Bug 1845]: - string compare now takes optional length arg (for strncmp behavior) - added string equal (just a few lines of code blended in with string compare) - added string icompare/iequal for case-insensitive comparisons - string index's index can now be ?end[+-]?expression I made this change in the private TclGetIntForIndex, which means that the list commands also benefit, as well as string range, et al. - added [string repeat string count] Repeats given string number of times - added string replace, string equiv to lreplace (quasi opposite of string range): string replace first last ?string? Example of use, replacing end of string with ... should the string be more than 16 chars long: string replace $string 16 end "..." This just returns the string len < 16, so it will only affect the long strings. - added optional first and last args to string to* This allows you to just affect certain regions of a string with the command (like just capping the first letter). I found the original totitle to be too draconian to be useful. - added [string map charMap string] where charMap is a {from to from to} list that equates to what one might get from [array get]. Each and can be multiple chars (or none at all). For Tcl/CGI users, this is a MAJOR speed booster. * generic/tclParse.c (Tcl_ParseCommand): Changed to avoid modifying eval'ed strings that are already null terminated. [Bug 1793] * tests/binary.test: * generic/tclBinary.c (DupByteArrayInternalRep): Fixed bug where type was not being set in duplicated object. [Bug 1975, 2047] 1999-04-30 Scott Stanton * Changed version to 8.1.1. 1999-04-30 Scott Stanton * Merged changes from 8.1.0 branch: * generic/tclParse.c: Fixed memory leak in CommandComplete. * generic/tclPlatDecls.h: * generic/tclIntPlatDecls.h: * generic/tclIntDecls.h: * generic/tclDecls.h: * tools/genStubs.tcl: Added 'extern "C" {}' block around the stub table pointer declaration so the stub library can be used from C++. [Bug 1934] * Lots of documentation and other release engineering fixes. 1999-04-28 Scott Stanton * mac/tclMacResource.c: * generic/tclListObj.c: * generic/tclObj.c: * generic/tclStringObj.c: Changed to avoid freeing the string representation before freeing the internal rep. This helps with debugging since the string rep will still be valid when the free proc is invoked. 1999-04-27 Scott Stanton * generic/tclLiteral.c (TclHideLiteral): Fixed so hidden literals get duplicated to avoid accidental sharing in the global object table. 1999-04-23 Scott Stanton * generic/tclStubInit.c: * tools/genStubs.tcl: Changed to avoid the need for forward declarations in stub initializers. 1999-04-23 Scott Stanton * library/encoding/koi8-r.enc: * tools/encoding/koi8-r.txt: Added support for the koi8-r Cyrillic encoding. [Bug 1771] 1999-04-22 Scott Stanton * win/tclWinFCmd.c: * win/tclWin32Dll.c: Changed uses of "try" to "__try", since that is the actual keyword. This eliminates the need for some -D flags from the makefile. * generic/tclPort.h: Added include of tcl.h since it defines various Windows macros that are needed before deciding which platform porting file to use. * generic/tclEvent.c: lint * win/tclWinInit.c (TclpInitPlatform): Added call to TclWinInit when building a static library since DllMain will not be invoked. This could break old code that explicitly called TclWinInit, but should be simpler in the long run. 1999-04-22 Scott Stanton * generic/tclInt.h: * generic/tclInt.decls: * generic/tclCompile.c: Added TclSetByteCodeFromAny that takes a hook procedure to invoke after compilation but before the byte codes are emitted. This makes it possible to do postprocessing on the compiled byte codes before the ByteCode is generated. * generic/tclLiteral.c: Added TclHideLiteral and TclAddLiteralObj to make it possible to create local unshared literal objects. * win/tclWinInit.c: * unix/tclUnixInit.c: Changed initial search path to match that found used by tcl_findLibrary. 1999-04-22 Scott Redman * win/tclWinPort.h: * win/tclWinSock.c: Added code to use WinSock 2.0 API on NT to avoid creating a window to handle sockets. API not available on Win95 and needs to be fixed on Win98, until then continue to use the older (window-based) scheme on those two OSes. 1999-04-15 Scott Stanton * Merged 8.1 back into the main trunk 1999-04-13 Scott Stanton * library/encoding/gb2312.enc: * library/encoding/euc-cn.enc: * tools/encoding/gb2312.txt: * tools/encoding/cp950.txt: * tools/encoding/Makefile: Restored the double byte definition of GB2312 and added the EUC-CN encoding. EUC-CN is a variant of GB2312 that shifts the characters into bytes with the high bit set and includes ASCII as a subset. [Bug 632] 1999-04-13 Scott Redman * win/tclWinSock.c: Apply patch to allow write access to a socket if FD_WRITE is sent but FD_CONNECT is not. Some strange problem with either Win32 or a socket driver. [Bug 1664 1776] 1999-04-09 Scott Redman * unix/tclUnixNotfy.c: Fixed notifier deadlock situation when the pipe used to talk back notifier thread is filled with data. When calling the write() function to feed data down that pipe, unlock the notifierMutex to allow the notifier to wake up again. Found as a result of the focus.test for Tk hanging. [Bug 1700] 1999-04-06 Scott Stanton * tests/unixNotfy.test: Fixed hang in tests when built with thread support. * tests/httpold.test: Fixed broken test that didn't wait long enough for events to arrive. * tests/unixInit.test: Fixed race condition in test. * tests/unixInit.test: * tests/fileName.test: Minor test nits. * unix/tclUnixInit.c (TclpSetInitialEncodings): Fixed bad initial encoding string. 1999-04-06 Bryan Surles * generic/tclVar.c: * generic/tclEnv.c: Moved the "array set" C level code into a common routine (TclArraySet). The TclSetupEnv routine now uses this API to create an env array w/ no elements. * generic/tclEnv.c: * generic/tclWinInit.h: * generic/tclUnixInit.h: * generic/tclInt.h: Made the Env module I18N compliant. Changed the FindVariable routine to TclpFindVariable, that now does a case insensitive string comparison on Windows, and not on UNIX. [Bug 1299, 1500] 1999-04-05 Scott Stanton * tests/io.test: Minor test cleanup. * generic/tclEncoding.c (Tcl_CreateEncoding): Minor lint to make it easier to compile on Digital-unix. [Bug 1659] * unix/configure.in: * unix/tclUnixPort.h: Applied patch for OS/390 to handle lack of sys/param.h. [Bug 1725] * unix/configure.in: Fixed BSD/OS 4.* configuration to support shared libraries properly. [Bug 1730] 1999-04-05 Scott Redman * win/tclWinDde.c: decrease timeout value for DDE calls to 30k. [Bug 1639] * generic/tcl.decls: * generic/tcl.h: * generic/tclDecls.h: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclUtil.c: Added more functions to the Tcl stubs table, including all Tcl_ functions not already in it (except Cmd functions) and Tcl_GetCwd() and Tcl_Chdir() (new functions). * tests/safe.test: * doc/safe.n: * generic/tclBasic.c: * library/safe.tcl: The encoding command is not safe as-is, so create a safe alias to mask out the "encoding system " but allow all other uses including "encoding system". Added test cases and updated the man page for Safe Tcl. 1999-04-05 Scott Stanton * tests/winTime.test: * win/tclWinTime.c: Fixed crash in clock command that occurred when manipulating negative time values in timezones east of GMT. [Bug 1142, 1458] * tests/platform.test: * tests/fileName.test: Fixed broken tests. * generic/tclFileName.c: Moved global regexps into thread local storage. * tests/socket.test: Changed so tests don't reuse sockets, since Windows is slow to release sockets. * win/tclWinConsole.c: * win/tclWinPipe.c: * win/tclWinSerial.c: Fixed race condition where background threads were terminated while they still held a lock in the notifier. 1999-04-02 Scott Stanton * tests/http.test: Fixed bad test initialization code. * generic/tclThreadTest.c (ThreadExitProc): Fixed bug where static memory was being returned instead of a dynamically allocated result in error cases. 1999-04-02 Scott Redman * doc/dde.n: * tools/tcl.wse.in: * win/makefile.vc: * win/pkgIndex.tcl: * win/tclWinDde.c: Add new DDE package, code removed from Tk now separated into its own package. Changed DDE-based send code into "dde eval" command. Can be loaded into tclsh (not just wish). Windows only. 1999-04-02 Scott Stanton * tests/expr.test: * tests/for-old.test: * tests/for.test: * tests/foreach.test: * tests/format.test: * tests/httpold.test: * tests/if.test: * tests/init.test: * tests/interp.test: * tests/while.test: Added some tests for known bugs (marked with knownBug constraint), and cleaned up a few bad tests. * generic/regc_locale.c: * generic/regcustom.h: * generic/tcl.decls: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclInt.h: * generic/tclRegexp.c: * generic/tclScan.c: * generic/tclTest.c: * generic/tclUtf.c: * win/tclWinFCmd.c: * win/tclWinFile.c: Made various Unicode utility functions public. The following functions were made public and added to the stubs table: Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsDigit, Tcl_UniCharIsLower, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar 1999-04-01 Scott Stanton * tests/registry.test: * win/tclWinReg.c: Internationalized the registry code. It now uses Unicode interfaces on NT. [Bug 1197] * tests/parse.test: * generic/tclParse.c: Fixed crash due to multiple frees in parser during error cleanup when parsing commands with more tokens than will fit in the static area of the parse structure. [Bug 1681] * generic/tclInt.h: Removed duplicate declarations. * generic/tclInt.decls: * generic/tcl.decls: Added Tcl_WinUtfToTChar and Tcl_WinTCharToUtf to the tclPlat table. 1999-04-01 Scott Redman * generic/tcl.decls: * generic/tcl.h: * generic/tclBasic.c: * generic/tclDecls.h: * generic/StubInit.c: * tools/genStubs.tcl: * unix/Makefile.in: * win/makefile.vc: Applied patch from Jan Nijtmans to fix Ultrix multiple symbol definition problem. Now, even Tcl includes a copy of the Tcl stub library. Also fixed TCL_MEM_DEBUG mode (for Tk). 1999-03-31 Scott Redman * win/tclWinConsole.c: WinNT has a bug when reading a single character from the console. Rewrote the code for the console to read an entire line at a time using the reader thread. 1999-03-30 Scott Stanton * unix/Makefile.in: Removed trailing backslash that broke the "depend" target. * unix/tclUnixInit.c (TclpSetInitialEncodings): Changed to avoid calling setlocale(). We now look directly at env(LANG) and env(LC_CTYPE) instead. [Bug 1636] * generic/tclFileName.c: * generic/tclDecls.h: * generic/tcl.decls: Removed CONST from Tcl_JoinPath and Tcl_TranslateFileName because it changes the signature of Tcl_JoinPath in an incompatible manner. * generic/tclInt.h: * generic/tclLoad.c (TclFinalizeLoad): * generic/tclEvent.c (Tcl_Finalize): Defer unloading of loadable modules until all exit handlers have been invoked. [Bug 998, 1273, 1573, 1593] 1999-03-29 Scott Stanton * generic/tclFileName.c: * generic/tclDecls.h: * generic/tcl.decls: Added CONST to Tcl_JoinPath and Tcl_TranslateFileName. 1999-03-29 Scott Redman * tools/genStubs.tcl: * unix/configure.in: * unix/Makefile.in: * win/makefile.vc: * generic/tcl.h: * generic/tclBasic.c: * generic/tclDecls.h: * generic/tclIntDecls.h: * generic/tclPlatDecls.h: * generic/tclIntPlatDecls.h: Removed the stub functions and changed the stub macros to just use the name without params. Pass &tclStubs into the interp (don't use tclStubsPtr because of collisions with the stubs on Solaris). 1999-03-27 Scott Redman * win/makefile.bc: Removed makefile for Borland compiler, no longer supported. 1999-03-26 Scott Redman * win/tclWinSerial.c: * win/tclWinConsole.c: * win/tclWinPipe.c: Don't close the Win32 handle for a channel if it's a stdio handle (GetStdHandle()) during shutdown of a thread to prevent it from destroying the stdio of other threads. 1999-03-26 Suresh Ankolekar * unix/configure.in: --nameble-shared is now the default and build Tcl as a shared library; specify --disable-shared to build a static Tcl library and shell. 1999-03-25 Scott Stanton * tests/interp.test: * generic/tclInterp.c (AliasObjCmd): Changed so aliases are invoked at current scope in the target interpreter instead of at the global scope. This was an incompatibility introduced in 8.1 that is being removed. [Bug 1153, 1556] * library/encoding/big5.enc: * library/encoding/gb2312.enc: * tools/encoding/big5.enc: * tools/encoding/gb2312.enc: Added ASCII to big5 and gb2312 encodings. [Bug 632] * generic/tclPkg.c (Tcl_PkgRequireEx): Fixed broken clientData initialization in package code. * unix/Makefile.in (dist): Added tcl.decls and tclInt.decls to source distribution. [Bug 1571] * doc/Thread.3: Updated documentation of Tcl_MutexLock to indicate that the recursive locking behavior is undefined. On Windows, it does not block, on Unix it deadlocks. [Bug 1275] 1999-03-24 Scott Stanton * tests/execute.test: * generic/tclExecute.c (TclExecuteByteCode): Fixed expression code that incorrectly returned floating point values for integers if the internal rep happened to be a double. Now we check to see if the object has a string rep that looks like an integer before using the double internal rep. [Bug 1516] 1999-03-24 Scott Redman * generic/tclAlloc.c: * generic/tclEncoding.c: * generic/tclProc.c: * unix/tclUnixTime.c: * win/tclWinSerial.c: Fixed compilation warnings/errors for VC++ 5.0 and 6.0 and HP-UX native compiler without -Aa or -Ae. [Bug 1323 1518 1324 1583 1585 1586] * win/tclWinSock.c: Make sockets thread-safe on Windows. The current implementation uses windows to handle events on the socket, one for each thread (thread local storage). Previously, there was only one window shared between threads, which didn't work. [Bug 1326] 1999-03-23 Scott Stanton * tools/tcl.wse: Fixed file association to look in the right place for the wish icon. [Bug 1544] * tests/winNotify.test: * tests/ioCmd.test: * tests/event.test: Changed to use new style conditionals. * tests/encoding.test: Fixed nonportable test. * unix/dltest/configure.in: * unix/dltest/Makefile.in: Added missing DBGX macros. [Bug 1564] * tests/winNotify.test: * mac/tclMacNotify.c: * win/tclWinNotify.c: * unix/tclUnixNotfy.c: * generic/tclNotify.c: Added a new Tcl_ServiceModeHook interface that is invoked whenever the service mode changes. This is needed to allow the Windows notifier to create a communication window the first time Tcl is about to enter an external modal event loop instead of at startup time. This will avoid the various problems that people have been seeing where the system hangs when tclsh is running outside of the event loop. [Bug 783] * generic/tclInt.h: * generic/tcl.decls: Renamed TclpAlertNotifier back to Tcl_AlertNotifier since it is part of the public notifier driver API. 1999-03-23 Scott Redman * win/tclWinSerial.c: Fixed problem with fileevent on the serial port and nonblocking mode. Gets no longer hangs, fileevents fire whenever there is any character data on the port. * tests/winConsole.test: * win/tclWinConsole.c: Fixed problem with fileevents and gets from a console stdin. Previously, fileevents were firing before an entire line was available for reading, which meant that when you did a gets or read, it blocked (even in nonblocking mode). Now, it should work the same as Unix: fileevents fire when an entire line is ready, and gets and read do not block in non-blocking mode. Added an interactive test case to check for this. 1999-03-22 Scott Stanton * tests/reg.test: * generic/regc_color.c: Applied regexp bug fix from Henry Spencer. 1999-03-19 Scott Redman * generic/tclCmdIL.c: Fixed the initialization of an array so that the Sun 5.0 C compiler wouldn't complain. * unix/configure.in: Added support for --enable-64bit. For now, this is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun compiler (not gcc). 1999-03-18 Scott Stanton * win/tclWinChan.c (TclpOpenFileChannel, Tcl_MakeFileChannel): Changed to only test for console or comm handles when the type is FILE_TYPE_CHAR to avoid useless tests on simple files. Also reordered tests so consoles are tested first as this is more common. * win/makefile.vc: Regularized usage of mkd and rmd and rm. * library/encoding/shiftjis.enc: * tools/encoding/shiftjis.txt: Missing/incorrect characters in shift-jis table. [Bug 1008, 1526] * generic/tclInt.decls: * generic/tcl.decls: Eliminated use of "string" and "list" from argument lists to avoid conflicts with C++ STL. [Bug 1181] * win/tclWinFile.c (TclpMatchFiles): Changed to ignore the FS_CASE_IS_PRESERVED bit and always return exactly what we get from the system. 1999-03-17 Scott Stanton * win/README.binary: * win/README: * unix/configure.in: * generic/tcl.h: * README: Updated version to 8.1b3. 1999-03-14 Scott Stanton * win/tclWinConsole.c: * win/tclWinPipe.c: * win/tclWinSerial.c: Changed so channel drivers wait for the reader/writer threads to exit before returning during a close operation. This ensures that the main thread is the last thread to exit, so the process return value is set properly. * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclIntPlatStubs.c: * generic/tclIntStubs.c: * generic/tclPlatDecls.h: * generic/tclPlatStubs.c: * generic/tclStubInit.c: * generic/tclStubs.c: Fixed bad eol characters. * generic/tclInt.decls: Changed "const" to "CONST" in declarations for better portability. * generic/tcl.decls: Renamed panic and panicVA to Tcl_Panic and Tcl_PanicVA in the stub files. * generic/tclInterp.c (Tcl_MakeSafe): Remove tcl_platform(user) from safe interps. 1999-03-11 Scott Stanton * unix/Makefile.in: * unix/configure.in: Include compat files in the stub library in addition to the main library. Compat files are now built for dynamic use in all cases. * generic/tcl.h: Changed magic number so it doesn't match the plus patch, at Jan's request. * unix/tclConfig.sh.in: * unix/dltest/Makefile.in: * unix/dltest/configure.in: * unix/dltest/pkga.c: * unix/dltest/pkgb.c: * unix/dltest/pkgc.c: * unix/dltest/pkgd.c: * unix/dltest/pkge.c: * unix/dltest/pkgf.c: Changed package tests to build against the stubs library. 1999-03-10 Scott Stanton * generic/tcl.h: * generic/tcl.decls: Changed Tcl_ReleaseType from an enum to macros so it can be used in .rc files. Added Tcl_GetString. * mac/tclMacNotify.c: * generic/tclNotify.c: * generic/tclInt.h: * win/tclWinNotify.c: * generic/tcl.h: Renamed Tcl_AlertNotifier to TclpAlertNotifier. * generic/tclInt.decls: Added TclWinAddProcess to make it possible for expect to use Tcl_WaitForPid(). This patch is from Gordon Chaffee. * mac/tclMacPort.h: * win/tclWinInit.c: * unix/tclUnixPort.h: * generic/tclAsync.c: Added TclpAsyncMark to fix bug in async handling on Windows where async events don't wake up the event loop. This patch comes from Gordon Chaffee. * generic/tcl.decls: Fixed declarations of reserved slots. 1999-03-10 Scott Redman * generic/tclCompile.h: Ensure that the ByteCode struct is binary compatible with the version in 8.0.6. * generic/tcl.h: * generic/tclBasic.c: Add Tcl_GetVersion() function to the public C API to allow programs to check the version number of the Tcl library at runtime. Also added an enum to clarify the release level (alpha, beta, final). 1999-03-09 Scott Stanton * Integrated changes from Tcl 8.0 including: stubs mechanism configure patches from Jan Nijtmans rename of panic to Tcl_Panic 1999-03-08 Lee Bernhard * win/tclWin32Dll.c: Removed Dll instance from thread-local storage. 1999-03-08 Scott Stanton * generic/tcl.h: Moved Tcl_Mutex, etc. macros above the inclusion of tclDecls.h to avoid macro conflicts. * generic/tclInt.h: * generic/regc_color.c: * generic/regcomp.c: * generic/tclCmdIL.c: * generic/tclCmdAH.c: * generic/tclIOCmd.c: * generic/tclParse.c: * generic/tclStringObj.c: * unix/tclUnixNotfy.c: Cleaned up various compiler warnings, eliminated UCHAR bugs. * unix/tclUnixNotfy.c: * unix/tclUnixThrd.c: * generic/tclThreadTest.c: * mac/tclMacThrd.c: Changed TclpCondition*() to Tcl_Condition*(). * INTEGRATED PATCHES FROM 8.0.6: * generic/tcl.decls: * generic/tcl.h: * generic/tclBasic.c: * generic/tclDecls.h: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclIntPlatStubs.c: * generic/tclIntStubs.c: * generic/tclPlatDecls.h: * generic/tclPlatStubs.c: * generic/tclStubInit.c: * generic/tclStubLib.c: * generic/tclStubs.c: * tools/genStubs.tcl: * unix/configure.in: * unix/Makefile.in: * unix/tclConfig.sh.in: * win/makefile.vc: * win/tclWinPort.h: Added Tcl stubs implementation. There are now two new macros USE_TCL_STUBS and USE_TCL_STUB_PROCS that enable use of stubs and disable stub macros respectively. All of the public and private function declarations from tcl.h and tclInt.h have moved into the *.decls files and the *Stubs.c and *Decls.h files are generated using the genStubs.tcl script. * unix/Makefile.in: * unix/configure.in: * unix/ldAix: Enhanced AIX shared library support. * win/tclWinSock.c: Removed a bunch of extraneous PASCAL FAR attributes from internal functions. * win/tclWinReg.c: Changed registry package to use stubs mechanism so it no longer depends on the specific version of Tcl. * doc/AddErrInfo.3: * doc/Eval.3: * doc/PkgRequire.3: * doc/SetResult.3: * doc/StringObj.3: * generic/tcl.h: * generic/tclBasic.c: * generic/tclPanic.c: * generic/tclStringObj.c: * generic/tclUtil.c: * unix/mkLinks: Added va_list versions of all VARARGS functions so they can be invoked from the stub functions. * doc/package.n: * doc/PkgRequire.3: * generic/tclPkg.c: Added Tcl_PkgProvideEx, Tcl_RequireEx, Tcl_PresentEx, and Tcl_PkgPresent. Added "package present" command. * generic/tclFileName.c: * mac/tclMacFile.c: * mac/tclMacShLib.exp: * unix/tclUnixFile.c: * win/tclWinFile.c: Changed so TclGetUserHome is defined on all platforms, even though it is currently a noop on mac and windows, and renamed it to TclpGetUserHome. * generic/tclPanic.c: * generic/panic.c: Renamed panic to Tcl_Panic. 1999-02-25 Scott Redman * win/makefile.vc: Added tclWinConsole.c and tclWinSerial.c * win/tclWinConsole.c: New code to properly deal with fileevents and nonblocking mode on consoles. * win/tclWinSerial.c: New code to properly deal with fileevents and nonblocking mode on serial ports. * win/tclWinPipe.c: * win/tclWinPort.h: Exported functions to allow creation of pipe channels from tclWinChan.c * win/tclWinChan.c: Check the type of a channel, including for the standard (stdin/stdout/stderr), and use the correct channel type to create the channel (file, serial, console, or pipe). 1999-02-11 Scott Stanton * README: * generic/tcl.h: * win/README.binary: * win/README: * unix/configure.in: * mac/README: Updated version numbers to 8.1b2. 1999-02-10 Scott Stanton * library/auto.tcl: Fixed auto_mkindex so it handles .tbc files. Did some general cleanup to handle bad eval statements that didn't use "list". * unix/mkLinks: * doc/SetVar.3: * generic/tcl.h: * generic/tclVar.c: Restored Tcl_ObjGetVar2 and Tcl_ObjSetVar2 from 8.0. Renamed Tcl_Get/SetObjVar2 to Tcl_GetVar2Ex and Tcl_SetVar2Ex. 1999-02-10 Scott Stanton INTEGRATED PATCHES FROM 8.0.5b2: * test/winPipe.test: Changed to remove echoArgs.tcl temporary file when done. * tests/cmdAH.test: * generic/tclFileName.c (TclGetExtension): Changed behavior so the split happens at the last period in the name instead of the first period of the last run of periods. So, "foo..o" is split into "foo." and ".o" now. [Bug 1126] * win/makefile.vc: Added better support for paths with spaces in the name. Added .lib and support .dlls to the install-binaries target. Added generate of a pkgIndex.tcl script to the install-libraries target. * win/tclAppInit.c: * unix/tclAppInit.c: * mac/tclMacAppInit.c: * generic/tclTest.c: Changed some EXTERN declarations to extern since they are not defining exported interfaces. This avoids generating useless declspec() attributes and makes the windows makefile simpler. * generic/tcl.h: Moved Tcl_AppInit declaration to end and cleared out TCL_STORAGE_CLASS so it is not declared with a declspec(). * tests/interp.test: * generic/tclInterp.c (DeleteAlias): Changed to use Tcl_DeleteCommandFromToken so we handle renames properly. This avoids senseless panic. [Bug 736] * unix/tclUnixChan.c: * win/tclWinSock.c: * doc/socket.n: Applied Gordon Chaffee's patch to handle failures during asynchronous socket connection operations. This adds a new "-error" fconfgure option to socket channels. [Bug 893] * generic/tclProc.c: * generic/tclNamesp.c: * generic/tclInt.h: * generic/tclCmdIL.c: * generic/tclBasic.c: * generic/tclVar.c: Applied patch from Viktor Dukhovni to rationalize TCL_LEAVE_ERR_MSG behavior when creating variables. * generic/tclVar.c: Fixed bug in namespace tail computation. Fixed bug where upvar could resurrect a namespace variable whose namespace had been deleted. * generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another bogus optimization in expression compilation. * unix/configure.in: Added branch for BSD/OS-4* to shared library case statement. [Bug 975] Fixed to correctly handle IRIX 6.5 n32 library support. [Bug 1117] * win/winDumpExts.c: Patched to be pickier about stripping @'s. [Bug 920] * library/http2.0/http.tcl: Added catch around eof test in CopyDone since the user may have already called http::reset. [Bug 1108] * unix/configure.in: Changed Linux and IRIX to set SHLIB_LIBS to LIBS so shared libraries are linked with the system libraries. [Bug 1018] * generic/tclCompile.c (CompileExprWord): Fixed exception stack overflow bug caused by missing statement. [Bug 928] * generic/tclIOCmd.c: * generic/tclBasic.c: Objectified the "open" command. [Bug 1113] * generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): When using egcs, ENOTSUP and EOPNOTSUPP are the same, so now we handle that case. [Bug 1137] * library/init.tcl: Various small changes requested by Jan Nijtmans. - If the variable $tcl_library contains the empty string, this empty string will be put in $auto_path. This is not useful at all, it only slows down later package processing. - If the variable tcl_pkgPath is not set, the "unset __dir" fails. Thich makes init.tcl totally unusable. Better put a "catch" around it. - In the function tcl_findLibraries, the "string match" function only works correctly if $tcl_patchLevel is in one of the forms "?.?a?", "?.?b?" or "?.?.?". Could a "regexp" be used instead, then it allows anything to be appended to the patchLevel string. And it is more efficient. - The tclPkgSetup function assumes that if $type != "load" then the type must be "source". This needn't be true. Some users want to add their own setup types. [RFE 1138] [Bug 978] * win/tclWinReg.c: * doc/registry.n: Added support for HKEY_PERFORMANCE_DATA and HKEY_DYN_DATA keys. [Bug 1109] * win/tclWinInit.c (TclPlatformInit): Added code to ensure tcl_pkgPath is set to "" when no registry entry is found. [Bug 978] 1999-02-01 Scott Stanton * generic/tclBasic.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclExecute.c: * generic/tclHistory.c: * generic/tclIO.c: * generic/tclIOUtil.c: * generic/tclInterp.c: * generic/tclMain.c: * generic/tclNamesp.c: * generic/tclParse.c: * generic/tclProc.c: * generic/tclTest.c: * generic/tclTimer.c: * generic/tcl.h: Made eval interfaces compatible with 8.0 by renaming Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to Tcl_EvalEx and restoring Tcl_EvalObj and Tcl_GlobalEvalObj interfaces so they match Tcl 8.0. 1999-01-28 Scott Stanton * Merged Tcl 8.0.5b1 changes. * generic/tclUtil.c (Tcl_DStringSetLength): Changed so the buffer overallocates in a manner similar to Tcl_DStringAppend. This should improve performance for TclUniCharToUtfDString. 1998-12-11 === Tcl 8.1b1 Release === 1998-12-10 Scott Stanton * Fixed lots of files that used TCL_THREAD instead of TCL_THREADS. * generic/tclEncoding.c (Tcl_FreeEncoding): Moved most of the code into a static FreeEncoding routine that does not grab the encodingMutex to avoid deadlocks/races when called from other routines that already have the mutex. 1998-12-09 Scott Stanton * library/msgcat1.0/msgcat.tcl: Fixed bad export list, fixed so all locale strings are converted to lower case, including file names. * generic/regcomp.c (makescan): Fixed bug in longest match case that caused anchored patterns to fail. [Bug 897] 1998-12-08 Scott Stanton * library/msgcat1.0/msgcat.tcl: changed mc to invoke mcunknown in the calling context, changed locale lookups to be case insensitive 1998-12-07 Scott Stanton * generic/tclAlloc.c (TclpRealloc): Fixed a memory allocation bug where big blocks that were reallocated into a different heap location were not being placed into the bigBlocks list. [Bug 933] * tests/msgcat.test: Added message catalog test suite. * library/msgcat1.0/msgcat.tcl: minor bug fixes, integrated latest changes from Mark Harrison. 1998-12-04 Scott Stanton * library/msgcat1.0/msgcat.tcl: Changed code to conform to Tcl coding standards. Changed to use file join for portability. * library/msgcat1.0: Added initial implementaion of Tcl message catalog package contributed by Mark Harrison. 1998-12-03 Scott Stanton * win/tclWinPipe.c (BuildCommandLine): Fixed bug that kept arguments containing spaces from being properly quoted. * tests/defs: Changed so auto_path is set to only contain the Tcl library directory. This keeps the tests from accidentally picking up stuff in installed packages. * generic/tclUtil.c (Tcl_StringMatch): Changed to match 8.0 behavior in corner case where there is no closing bracket. 1998-12-02 Scott Stanton * win/tclWinPipe.c (TclpCreateCommandChannel): Changed reader/writer threads to have THREAD_PRIORITY_HIGHEST so they will have a chance to run whenever there is something to do. * generic/tclIO.c (WriteBytes, WriteChars): Fixed so extraneous flushes do not happen in line mode. (TranslateOutputEOL): Made translation more efficient in line mode and fixed a buffer overflow bug in CRLF translation. [Bug 887] 1998-12-02 Brent Welch * Updated patchlevel to 8.1b1 1998-12-02 Scott Stanton * generic/regc_color.c (subcolor): Added check for error case to avoid an out of bounds array reference. * generic/tclCmdAH.c (Tcl_EncodingObjCmd): Changed to avoid using Tcl_DStringResult because it is not binary clean. * generic/tclParse.c (Tcl_ParseCommand): Fixed bug in comment parsing where a trailing comment looked like an incomplete command. 1998-12-02 Brent Welch * Merged changes from 8.0.4, especially the new pkg_mkIndex 1998-12-01 Scott Stanton * generic/tclIO.c (Tcl_ReadChars): Added a call to UpdateInterest so we don't block when there is data sitting in the buffers. * generic/tclTest.c (TestevalobjvObjCmd): Updated for EvalObjv change. * tests/parse.test: Updated tests for EvalObjv change. * generic/tclParse.c (EvalObjv, Tcl_EvalObjv): Changed Tcl_EvalObjv interface to remove string and length arguments, preserved original interface as EvalObjv for internal use. * generic/tcl.h: Changed Tcl_EvalObjv interface to remove string and length arguments. * doc/Eval.3: Updated documentation for Tcl_EvalObjv to remove string and length arguments. * generic/tclCompCmds.c (TclCompileForeachCmd): Fixed code that corrupted the exceptDepth value in the compile environment when foreach failed to compile inline. [Bug 884] * library/encoding/euc-kr.enc: * library/encoding/ksc5601.enc: * tools/encoding/ksc5601.txt: * unix/tclUnixInit.c: Added support for Korean EUC. * win/tclWinChan.c (TclpGetDefaultStdChannel): added check for a failure during Tcl_MakeFileChannel. 1998-11-30 Scott Stanton * unix/tclUnixNotfy.c (Tcl_WaitForEvent): Fixed hang that occurs when trying to close a pipe that is currently being waited on by the notifier thread. [Bug 607] * unix/tclUnixFCmd.c (GetPermissionsAttribute): Increase size of returnString buffer to avoid overflow. [Bug 584] * generic/tclThreadTest.c (TclThreadSend): Fixed memory leak due to use of TCL_VOLATILE instead of TCL_DYNAMIC. * generic/tclThread.c (TclRememberSyncObject): Fixed memory leak caused by failure to reuse condition variables. * unix/tclUnixNotfy.c (Tcl_AlertNotifier, Tcl_WaitForEvent, (NotifierThreadProc, Tcl_InitNotifier): Fixed race condition caused by incorrect use of condition variables when sending messages between threads. [Bug 607] * generic/tclTestObj.c (TeststringobjCmd): MAX_STRINGS was off by one so the strings array was too small. * generic/tclCkalloc.c (Tcl_DbCkfree): Moved mutex lock so ValidateMemory is done inside the mutex to avoid a race condition when validate_memory is enabled. [Bug 880] 1998-11-23 Scott Stanton * regexec.c: more performance tuning from Henry Spencer. 1998-11-17 Scott Stanton * tclScan.c: moved "scan" implementation out of tclCmdMZ.c and added Unicode support. This required a complete reimplementation of the command to avoid using scanf(), which isn't Unicode aware. Two new features were added in the process: %n to return the current number of characters consumed, and XPG3-style %n$ argument order specifiers similar to those provided by the "format" command. [Bug 833] * tclAlloc.c: changed so allocated memory is always 8-byte aligned to improve memory performance and to ensure that it will work on systems that don't like accessing 4-byte aligned values (e.g. Solaris and HP-UX). [Bug 834] 1998-11-06 Scott Stanton * tclVar.c (TclGetIndexedScalar): Fixed bug 796, var name was getting lost before being passed to CallTraces. 1998-10-21 Scott Stanton * added "encoding" command * Moved internal regexp declarations from tclInt.h to tclRegexp.h * integrated regexp updates from Henry Spencer 1998-10-15 Scott Stanton * tclUtf.c: added Unicode character table support * tclInt.h: added Tcl_UniCharIsWordChar * tclCmdMZ.c (Tcl_StringObjCmd): added "totitle" subcommand, changed "wordend" and "wordstart" to properly handle Unicode word characters and connector punctuation 1998-10-05 Scott Stanton * auto.tcl, package.tcl: fixed SCCS strings * tclIndex: updated index to reflect 8.1 files * tclCompile.c (TclCompileScript): changed to avoid modifying the input string in place because name lookup operations could have arbitrary side effects * tclInterp.c: added guard against deleting current interpreter * tclMacFile.c, tclUnixFile.c, tclWinFile.c, tclFileName.c: added warnings around code that modifies strings in place * tclExecute.c: fixed off-by-one copying error, fixed merge bugs * tclEvent.c: changed so USE_TCLALLOC is tested for value instead of definition * tclCompCmds.c: replaced SCCS strings, added warnings around code that modifies strings in place * interp.test: added test for interp deleting itself 1998-09-30 Scott Stanton * makefile.vc: fixed so TCL_LIBRARY is set before running tcltest * tclWin32Dll.c: removed TclpFinalize, cleanup of merges tcl8.6.14/ChangeLog.20000000644000175000017500000026735714554262142014020 0ustar sergeisergei2000-12-14 Don Porter * generic/tclExecute.c: * tests/expr-old.test: Re-wrote Tcl's [expr rand()] and [expr srand($seed)] implementations, fixing a range error on some 64-bit platforms. Added tests that detect the bug. The rewrite changes the seed -> sequence map on 64-bit platforms, only for seed >= 2^31, a slight incompatibility. [Bug 121072, Patch 102781] 2000-12-10 Don Porter * library/init.tcl: * library/msgcat/msgcat.tcl: * library/msgcat/pkgIndex.tcl: * library/opt/optparse.tcl: * library/opt/pkgIndex.tcl: Where [uplevel] is used in a proc to evaluate a Tcl built-in command in the caller's context, the built-in commands are now fully namespace-qualified. This prevents problems when the caller context is in a namespace where the built-in command name has been used by a command in the namespace. (For example, [::ns::set] might be called instead of the intended [::set]). [Bug 119422, Patch 102545] 2000-12-09 Jeff Hobbs * win/tclWinTime.c (CalibrationThread): added lint return value to prevent compiler warning. [Bug 125005] * docs/scan.n: * tests/scan.test: * generic/tclScan.c (Tcl_ScanObjCmd): changed %o and %x to use strtoul instead of strtol to correctly preserve scan<>format conversion of large integers. [Patch 102663, Bug 124600] * generic/tclExecute.c (TclExecuteByteCode): Commited patch fixing handling of {!} in expressions. [Patch 102702] 2000-12-08 Jeff Hobbs * library/init.tcl: Added support for PATHEXT variable in auto_execok, recognizing the proper set of executable extensions on Windows. [Patch 102719] 2000-12-08 Andreas Kupries * generic/tclEncoding.c (LoadTableEncoding): Changed dangerous code to something less critical. This fixes [Bug 119417], part A without affecting the speed when loading encodings. 2000-12-08 Donal K. Fellows * doc/open.n: Added xref to fconfigure and advice on the opening of binary files. Should help prevent a recurrence of bugs like [Bug 124558] 2000-12-07 Jeff Hobbs * generic/tcl.h: added note about need to updated library/dde/pkgIndex.tcl with minor version increment. * library/dde/pkgIndex.tcl: updated to use 84 version to reflect the makefile. Should probably be updated to use its real version at some point. [Patch 102560, Bug 119421] 2000-12-06 Eric Melski * generic/tcl.h (attemptckalloc): Fixed typo for #define of attemptckalloc (was defined to Tcl_AttempDbCkalloc, should have been Tcl_AttemptDbCkalloc). [Bug 124384] * generic/tclCkalloc.c: Added TCL_MEM_DEBUG versions of Tcl_AttemptDbCkrealloc and Tcl_AttemptDbCkalloc. [Bug 124384]. 2000-11-24 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Logical negation "!" can now handle string booleans, provided those values are placed in variables. * tests/expr.test (expr-13.17): Check that [expr {!$var}] can negate the string-versions of booleans "yes", "false", etc. * library/tcltest/tcltest.tcl (getMatchingFiles, (getMatchingDirectories): * tools/man2html.tcl (doDir): * tools/man2help.tcl (doDir): * library/package.tcl (tclPkgUnknown,tclMacPkgSearch): * library/safe.tcl (AddSubDirs): [glob] uses -directory instead of unsafe [file join]. [Bug 123313] * generic/tclIndexObj.c: * generic/tclTestObj.c (TestindexobjCmd): Changed internal representation of index objects to fix [Bug 119082]; fix shouldn't be visible to outside world... * generic/tclTest.c (TestGetIndexFromObjStructObjCmd): * tests/indexObj.test: (indexObj-6.*) Added to test for presence of [Bug 119082]. 2000-11-23 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsortObjCmd): Fixed memory leak from [Bug 119398] * library/init.tcl (unknown): Added specific level parameters to all uplevel invocation to boost performance; didn't dare touch the "namespace inscope" stuff though, since it looks sensitive to me! Should fix [Bug 123217], though testing is tricky... 2000-11-21 Andreas Kupries All of the changes below are described in TIP #7 ~ Specification and result from the application of the patch contained therein. Creator of the patch is Kevin Kenny . The patch used here is actually a bit different. Two MS specific constant values (format FOOui64) were replaced with a more portable formatting of the values and an additional cast to LONGLONG. My cross-compiling gcc was unable to process the original form. [Patch 102459] * tclWinTime.c: Add to the static data a set of variables that manage the phase-locked techniques, including a ''CRITICAL_SECTION'' to guard them so that multi-threaded code is stable. * tclWinTime.c: Modify ''TclpGetSeconds'' to call ''TclpGetTime'' and return the 'seconds' portion of the result. This change is necessary to make sure that the two times are consistent near the rollover from one second to another. * tclWinTime.c: Modify ''TclpGetClicks'' to use TclpGetTime to determine the click count as a number of microseconds. * tclWinTime.c: Modify ''TclpGetTime'' to return the time as M*Q+B, where Q is the result of ''QueryPerformanceCounter'', and M and B are variables maintained by the phase-locked loop to keep the result as close as possible to the system clock. The ''TclpGetTime'' call will also launch the phase-lock management in a separate thread the first time that it is invoked. If the performance counter is unavailable, or if its frequency is not one of the two common 8254-compatible rates, then ''TclpGetTime'' will return the result of ''ftime'' as it does in Tcl 8.3.2. * tclWinTime.c: Add the clock calibration procedure. The calibration is somewhat complex; to save space, the reader is referred to the reference implementation for the details of how the time base and frequency are maintained. * tclWinNotify.c: Modify ''Tcl_Sleep'' to test that the process has, in fact, slept for the requisite time by calling ''TclpGetTime'' and comparing with the desired time. Otherwise, roundoff errors may cause the process to awaken early. * tclWinTest.c: Add a ''testwinclock'' command. This command returns a four element list comprising the seconds and microseconds portions of the system clock and the seconds and microseconds portions of the Tcl clock. * winTime.test: Add to the test suite a test that makes sure that the Tcl clock stays within 1.1 ms of the system clock over the duration of the test. 2000-11-21 Donal K. Fellows * doc/global.n: * doc/upvar.n: * doc/variable.n: Improved documentation to mention that variables so created are listed in [info locals] and added a few more cross-links between these commands. [Bug 119387] 2000-11-17 Donal K. Fellows * tests/safe.test: (safe-4.3): * generic/tclVar.c (TclLookupVar): Changed again. Now passes all the tests, though one needed modifying since it required the wrong answer. (Why on earth do we have inline modification of argument strings? This sort of thing is horrendous to debug and doesn't work well in a multithreaded environment!) [Bug 119192] * tests/var.test: (var-1.19) If my attempts to fix the problem aren't right yet, my attempts to describe it look pretty good to me... 2000-11-16 Andreas Kupries * win/tclWinPort.h (line 69): Changed reference to winsock2.h into winsock.h. This was a leftover from a foray into using winsock version 2 (History lesson from Scott Redman and Jeff Hobbs). This code was no problem when compiling Tcl itself, but could trip extensions. [Bug 122568] 2000-11-15 Jeff Hobbs * unix/Makefile.in: removed bp.c references (hasn't existed in a long time). Corrected 'make dist' to make dist with unversioned library directories (same as out of cvs), so make install works correctly with either source tree. 2000-11-15 Jeff Hobbs * generic/tclVar.c (TclLookupVar): reverted fix below as it broke all other array unset error reporting. Bug 119192 is still open. 2000-11-15 Donal K. Fellows * generic/tclVar.c (TclLookupVar): Changed references to part2 to use elName instead in various error message generating spots. [Bug 119192] 2000-11-03 David Gravereaux * win/.cvsignore: Removed 'configure' from the glob list now that it's included. 2000-11-03 Jeff Hobbs 8.4a2 RELEASE * unix/Makefile.in (install-libraries, dist): * win/makefile.vc (install-libraries): * win/Makefile.in (install-libraries): updated to install unversioned library directories into versioned directories. * tools/tcl.wse.in: updated for unversioning of library dirs * unix/mkLinks: updated mkLinks with latest doc updates * doc/Tcl_Main.3: added docs for Tcl_SetMainLoop * generic/tclStubInit.c: * generic/tclDecls.h: * generic/tcl.decls: added Tcl_SetMainLoop proc that allows people to set a main loop that will run for tclsh. * generic/tcl.h: added Tcl_MainLoopProc typedef * generic/tclMain.c (Tcl_SetMainLoop, StdinProc, Prompt): new StdinProc and Prompt static procs and Tcl_SetMainLoop stubs proc. The first two handle a fileevent based prompt (taken from tkMain.c). Tcl_SetMainLoop enables the interactive setting of a main loop procedure. This enables Tk to be a loadable package. 2000-11-02 David Gravereaux * generic/tclEvent.c: tclLibraryPath Tcl_Obj didn't have a way to share its data among threads. This caused Tcl_Init() to always fail in threads. Added a way to pass the data around with a global char*. [BUG: 5301] 2000-11-02 Jeff Hobbs * unix/configure: * unix/dltest/configure: * win/configure: * tools/configure: checked in configure scripts so people doing CVS checkouts aren't required to have autoconf. Changes to configure.in in the future will require the corresponding configure script to also be re-autoconf'ed and checked in. * win/makefile.vc: * win/tcl.m4: makefile fixes for Win64 support * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): minor cast changes. 2000-11-01 Jeff Hobbs * unix/tcl.m4: removed use of -lbsd and -ldl for AIX-5. * tests/subst.test: added tests for non-zero return code handling by subst. * generic/tclParse.c (Tcl_EvalEx): corrected handling of non-zero, non-error return code cases for subst. [Bug 119829] * generic/tclVar.c (TclVarTraceExists): Corrected excessive mem use when info exists was called on a non-existent array element. [Bug 119213, 119336] 2000-10-30 David Gravereaux * win/configure.in: * win/Makefile.in: * win/makefile.vc: * win/tcl.rc: * win/tclsh.rc: Added logic to derive filenames better in the resource scripts based on compile options. 2000-10-30 Jeff Hobbs * unix/tclUnixInit.c: added default encoding map from "ja_JP.eucJP" to "euc-jp". (takahashi) * tests/clock.test: corrected clock-2.* test numbering * unix/configure.in (SC_TCL_LINK_LIBS): removed code that was commented out (it had been moved to tcl.m4's SC_TCL_LINK_LIBS already). * unix/tcl.m4: consolidated gettimeofday check for AIX. 2000-10-27 Jeff Hobbs * unix/configure.in: * unix/tcl.m4: added support for AIX-5. * generic/tclIO.c (Tcl_NotifyChannel): removed #ifdef around code for old channel structures, placed preserve/release around statePtr * generic/tclIO.c (CloseChannel): the statePtr for a channel was not being freed when the last channel in a stack was freed, causing a mem leak. * unix/tclUnixChan.c: updated channel types to strict TCL_CHANNEL_VERSION_2 style to avoid compiler warnings. They work either way, but this avoids compiler warnings (that worries people). 2000-10-27 Jennifer Hom * library/tcltest1.0/tcltest.tcl: Removed a cd into the test directory in runAllTests that screwed up the temporary directory setting, effectively preventing users from running tests on multiple platforms at the same time. 2000-10-26 David Gravereaux * win/tclWinFile.c (TclpMatchFilesTypes): NULL was being set to "attr" which was a DWORD. Changed NULL to zero because a 'void *' can't be set to a DWORD to avoid the compiler warning. 2000-10-24 Jennifer Hom * tests/all.tcl: Removed support for tcltest 1.0. * tests/tcltest.test: * library/tcltest1.0/tcltest.tcl: * library/tcltest1.0/pkgIndex.tcl: * docs/tcltest.n: Moved tcltest2 code so that it's the standard version of tcltest. Removed all tcltest2 files (tests/tcltest2.test, library/tcltest1.0/tcltest2.tcl, docs/tcltest2.n). 2000-10-20 Jeff Hobbs * win/tclWinFile.c (TclpMatchFilesTypes): made the stat call only occur when necessary (for 'glob' command). Significantly speeds up glob command from 8.3. [BUG: 6216] 2000-10-19 Jennifer Hom * library/tcltest1.0/tcltest2.tcl: * tests/tcltest2 * doc/tcltest2.n: Code and documentation cleanup. Modified -verbose to take list of keywords as well as string of letters. Removed Tcl version information from tcltest. Removed tcltest::grep from tcltest package. Added optional 3rd directory argument to makeFile/makeDirectory and removeFile/removeDirectory. * tests/basic.test: Changed references to tcltest::tclVersion to hard-coded numbers. * generic/tcl.h: Changed reference to tcltest2.tcl and tcltest.tcl in comments to tests/basic.test. 2000-10-06 David Gravereaux * win/tclWinChan.c: moved Win2K bug case test with GetStdHandle() from TclpGetDefaultStdChannel into Tcl_MakeFileChannel to enable a more general method in detecting invalid OS handles rather than just a specific known case. [BUG: 5971] 2000-10-06 Jeff Hobbs * tests/cmdAH.test: extra tests for 'file channels' that include multiple interpreter tests and channel sharing * generic/tclIO.c (Tcl_GetChannelNamesEx): corrected function (and consequently 'file channels') to return channels that are actually registered for this specific interp, rather than this thread. * doc/CrtChannel.3: fixed spelling mistakes 2000-09-29 Jennifer Hom * library/tcltest1.0/tcltest2.tcl: * tests/tcltest2.test: * doc/tcltest2.n: Modified the new form of the test command to accept both attribute-value pairs and command line options. Updated the tests and the documentation for this new format. Also changed the option names for the test command. 2000-09-29 Jeff Hobbs * win/tclWinSerial.c (SerialGetOptionProc): corrected reporting of space parity on Windows (Eason) [Bug 6057]. * win/Makefile.in: commented use of TESTFLAGS * unix/Makefile.in: added TESTFLAGS to test target to conform with Windows makefile and TEA style. * tests/stack.test: prevented possible crash on systems with low default stacksize (Tru64, AIX) in infinite recursion test. A solution to check remaining stack space in the core is best, but hard to do in a cross-platform manner. * generic/tclIOGT.c (FLUSH_DELAY): renamed DELAY define to FLUSH_DELAY to avoid defn conflict using Tru64's cc. 2000-09-28 Jeff Hobbs * tools/tcl.wse.in: added tclPlatDecls.h and tkPlatDecls.h to the Windows .exe install. * tests/fCmd.test (fCmd-6.20): corrected test to remove c:/tcl8975@ after creating it. * tests/fileName.test: cleaned up the testing of glob patterns for c:/globTest (Windows) to directly create/remove directory. 2000-09-27 Jeff Hobbs * generic/tcl.decls: * generic/tclIO.c: updated Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the new stacked channel implementation. Their stub slots were also moved to give preference to the new 8.3.2 stub functions. This will cause an incompatibility with 8.4a1 only. (StopCopy): fixed a bug introduced by a partial fix in 8.3.2 that didn't set nonBlocking correctly when resetting the flags for the write side. [Bug: 6261] * doc/ChnlStack.3: * doc/CrtChannel.3: * generic/tcl.decls: * generic/tcl.h: * generic/tclDecls.h: * generic/tclIO.c: * generic/tclIO.h: * generic/tclIOGT.c: * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclTest.c: * tests/iogt.test: * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: * win/tclConfig.sh.in: * win/tclWinChan.c: * win/tclWinConsole.c: * win/tclWinPipe.c: * win/tclWinSerial.c: * win/tclWinSock.c: Up-port of changes made in 8.3.2 to 8.4a2 code base. Most of these changes relate to the rewrite of the stacked channel implementation, with a few config related fixes. Following is an asynchronous include of the applicable ChangeLog entries from 8.3.2. ******************************************************** ** START OF ASYNCHRONOUS UP-PORT LOG (8.3.2 -> 8.4a2) ** ******************************************************** 2000-08-07 Jeff Hobbs * doc/ChnlStack.3: * doc/CrtChannel.3: updated the docs to be aware of the TCL_CHANNEL_VERSION_2 style of Tcl channels. * generic/tclIO.c (Tcl_CreateChannel): added assertion to verify that the new channel versioning will be binary compatible with older channel drivers. 2000-08-05 Jeff Hobbs * generic/tclIOGT.c (TclChannelTransform): fixed segfault that would occur when transforming a channel with a proc that did not yet exist. (Kupries) * generic/tclTest.c (TestChannelCmd): added some lint init'ing of statePtr and chan vars. 2000-07-26 Jeff Hobbs Merged core-8-3-1-io-rewrite back into core-8-3-1-branch. The core-8-3-1-io-rewrite branch should now be considered defunct. * generic/tclStubInit.c: * generic/tclDecls.h: * generic/tcl.decls: * generic/tcl.h: * generic/tclIO.c: moved the Tcl_Channel* macros from tcl.h to tclIO.c and made them proper stubbed functions. These are: Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, and Tcl_ChannelHandlerProc. These should be used to access the Tcl_ChannelType structure instead of direct pointer dereferencing. * tests/iogt.test: added RCS string, marked tests 2.* to be unixOnly due to underlying system differences. 2000-07-25 Andreas Kupries * tests/iogt.test: (line 866f) New tests iogt-6.[01], highlighting buffering trouble when stacking and unstacking transformations. iogt-6.0 is solved, see the changes below. iogt-6.1 remains, for now, due to the perceived complexity of solutions. * generic/tclIO.h: (line 139f) struct Channel, added a buffer queue, to hold data pushed back when stacking a transformation. * generic/tclIO.c: (line 91f, line 7434f) New internal function 'CopyBuffer'. Derived from 'CopyAndTranslateBuffer', with translation removed. (line 1025f, line 1212f): Initialization of new queue. (line 1164f, Tcl_StackChannel): Pushback of input queue. (line 1293f, Tcl_UnstackChannel): Discard input and pushback. (line 3748f, Tcl_ReadRaw): Modified to use data in the push back area before going to the driver. Uses 'CopyBuffer', s.a. (line 4702f, GetInput): Modified to use data in the push back area before going to the driver. (line 4867f, Tcl_Seek): Modified to take pushback of the topmost channel in a stack into account. (line 5620f, Tcl_InputBuffered): See above. Added 'Tcl_ChannelBuffered'. Analog to 'Tcl_InputBuffered' but for the buffer area in the channel. * generic/tcl.decls: New public API 'Tcl_ChannelBuffered'. S.a. 2000-07-17 Jeff Hobbs * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: added tclIOGT.c to objects list to compile. * generic/tclStubInit.c: * generic/tclIntDecls.h: * generic/tclInt.decls: commented out internal decls for TclTestChannelCmd and TclTestChannelEventCmd as they were moved to tclTest.c. Added new decls for TclChannelEventScriptInvoker and TclChannelTransform. * generic/tclIO.c (CloseChannel): stopped masking out of the TCL_READABLE|TCL_WRITABLE bits from the state flags in CloseChannel, instead adding extra intelligence to CheckChannelErrors with a new CHANNEL_RAW_MODE bit for special behavior when called from Raw channel APIs. 2000-07-13 Jeff Hobbs * generic/tclIO.c (StackSetBlockMode): moved set of chanPtr outside of blockModeProc check to avoid infinite loop when blockModeProc was NULL. Updated TransformSeekProc to not call Tcl_Seek directly (Kupries). * win/tclWinChan.c: updated fileChannelType to v2 channel struct * win/tclWinConsole.c: updated consoleChannelType to v2 channel struct * win/tclWinPipe.c: updated pipeChannelType to v2 channel struct * win/tclWinSerial.c: updated serialChannelType to v2 channel struct * win/tclWinSock.c: updated tcpChannelType to v2 channel struct 2000-07-11 Brent Welch * win/tclConfig.sh.in (TCL_LIBS): Cleaned up unix-specific autoconf variables. 2000-07-11 Jeff Hobbs * tests/iogt.test: made tests [345].0 not run by default as they were failing in the new design, but I'm not convinced that the returned result isn't correct. * generic/tclDecls.h: * generic/tclStubInit.c: * generic/tcl.decls: added Tcl_GetTopChannel C API that returns the current top channel of a channel stack. Tcl_GetChannel was changed earlier to return the bottommost channel of a stack because that is the one that is guaranteed to stay around the longest, and this was needed to compensate for certain operations that want to look at the state of the main channel. Most channel APIs already compensate for grabbing the top, so it shouldn't be needed often. * generic/tclIO.c (Tcl_StackChannel, Tcl_UnstackChannel): Added flushing of buffers (Kupries), removed use of DownChannel macro, added Tcl_GetTopChannel public API to get to the top channel of the channel stack (necessary for TLS). Rewrote Tcl_NotifyChannel for new channel design (Kupries). Did some code cleanup in the transform code. tclIO.c must still be broken into bits (separate out test code and giot code, create tclIO.h). 2000-07-10 Andreas Kupries * tests/iogt.test: Reverted some earlier changes as a fix by Jeff revived the original and correct behaviour. IOW, the tests showed a genuine error and I didn't see it :(. * generic/tclIO.c (Tcl_Read|Write_Raw): Changed to directly use the drivers and not DoRead|DoWrite. The latter use the buffering system, encoding and eol-translation and this wreaks havoc with the data going through the transformations. Both procedures use CheckForchannelErrors and let it believe that there is no background copy in progress or else stacked channels could not be used for that. * generic/tclIO.c (TclCopyChannel, CopyData): Moved access to the topmost channel from the first to the second procedure to make the decision about that at the last possible time (Callbacks can change the stacking). test suite: failures of iogt-[345].0 2000-07-06 Jeff Hobbs * tests/iogt.test: new tests for stacked channel stuff based off new 'testchannel transform|unstack' code (Kupries IOGT extension). * generic/tcl.decls: * generic/tcl.h: * generic/tclDecls.h: * generic/tclStubsInit.c: * generic/tclIO.c: complete rewrite of Tcl Channel code for stacked channels. Channels are now designed to work in a more stacked fashion with a shared ChannelState data structure. 2000-06-02 Jeff Hobbs * generic/tclIO.c (CloseChannel): removed the &ing out of (TCL_READABLE|TCL_WRITABLE) from the flags, as CloseChannel does this on the next pass through for the top channel, and it appeared to be causing hangs by not allowing the final flush. 2000-06-01 Jeff Hobbs * generic/tclIO.c (CloseChannel): Rewrote CloseChannel code to unstack a channel during the close process. Fixed a refcount bug in Tcl_UnstackChannel. [Bug: 5623] (CloseChannel): further extended CloseChannel in the stacked case to effect certain operations on the next channel that would have been done in Tcl_Close. Also added CHANNEL_CLOSED and removed (TCL_READABLE|TCL_WRITABLE) bits from chanPtr->flags. Changed final reset of the WatchProc to check the chanDownPtr's (next) interestMask. ****************************************************** ** END OF ASYNCHRONOUS UP-PORT LOG (8.3.2 -> 8.4a2) ** ****************************************************** 2000-09-20 Jeff Hobbs * tests/socket.test: removed doTestsWithRemoteServer constraint from socket-12.*. It requires 'exec', not a remote server. Cleaned up some coding errors. 2000-09-20 Jennifer Hom * library/tcltest1.0/pkgIndex.tcl: Updated to load tcltest 2.0. * library/tcltest1.0/tcltest2.tcl: New version of tcltest. Cleanup of command line parsing: allows users to specify command line arguments through an environment variable named TCLTEST_OPTIONS [RFE: 3748], does not respond to incorrect arguments, and forces usage of entire flag name when using command line arguments. Defines accessor procs for all tcltest variables. Allows users to use 'return' in test scripts. Allow users to specify whether test files should be sourced or run in a separate process. 'all.tcl' code moved to tcltest package. 'test' proc modified to use attribute-value pairs. Allow users to specify what return codes, output, and errors can be compared and whether these values should be compared using regexp, glob, or exact matching. makeDirectory & removeDirectory now operate with respect to temporaryDirectory [Bug: 6001]. Test results from tests run in slave interpreters are now included in test totals [Bug: 1493]. Test files that return error values are now reported. * tests/all.tcl: Added code to check for the tcltest version loaded; modified to figure out which tests to run based on the tcltest version loaded. * tests/tcltest.test: Modified to explicitly load version 1.0 of tcltest. * tests/tcltest2.test: New test suite for tcltest; includes all of the old tests plus new ones reflecting changes made for version 2.0. * tests/cmdAH.test: Added singleTestInterp constraint to cmdAH-31.2; this test does not run if tests aren't sourced into a single interpreter. * tests/socket.test: Fixed two tests that were referencing variables outside of scope. * tools/tcl.wse.in: Added code to install tcltest2.tcl. * doc/tcltest2.n: New documentation for tcltest version 2.0. Removes documentation for tcltest namespace variables. Adds documentation for new tcltest procs. * unix/mkLinks: Added code to link to tcltest2.n. * generic/tcl.h: Added comment to modify tcltest2.tcl as well as tcltest.tcl for version changes. 2000-09-19 Eric Melski * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): When using -all, all attempts after the first to match the regexp against the string should include the TCL_REG_NOTBOL flag, to avoid erroneously matching ^ in the middle of the string. Added code to set this flag after the first pass through the matching loop. [Bug: 6284]. 2000-09-19 David Gravereaux * doc/Eval.3: Added a note about the script argument to Tcl_Eval() should be in UTF-8 or risk implied conversion errors when possible combinations of upper ascii can be valid UTF-8 special codes. 2000-09-17 Eric Melski * tests/cmdIL.test: Added a test for fix for [Bug: 6212]. * generic/tclCmdIL.c (Tcl_LsortObjCmd): Applied patch from [Bug: 6212], which corrected an error in the handling of the -index option. 2000-09-14 Eric Melski * doc/Alloc.3: Added entries for Tcl_AttemptAlloc, Tcl_AttempRealloc. * doc/StringObj.3: Added entry for Tcl_AttemptSetObjLength. * generic/tclDecls.h: * generic/tclStubInit.c: Regen'ed stubs files from new tcl.decls. * generic/tcl.decls: Added stubs for the Tcl_Attempt* memory allocators and for Tcl_AttemptSetObjLength. * generic/tcl.h: Added #define's for attemptckalloc, attemptckrealloc, which map to the Tcl_Attempt* memory allocators. * generic/tclCkalloc.c: Added non-panic'ing versions of Tcl_Alloc, Tcl_Realloc, etc.; these are called Tcl_AttemptAlloc, Tcl_AttemptRealloc, etc. These are used by Tcl_AttemptSetObjLength and the string obj append functions. * generic/tclStringObj.c: Modified string growth algorithm to use doubling algorithm as long as possible, and only fall back when that fails. Added Tcl_AttemptSetObjLength, and modified AppendUnicodeToUnicodeRep, AppendUtfToUtfRep, and Tcl_AppendStringsToObjVA to support this. 2000-09-07 David Gravereaux * win/.cvsignore: changed the glob patterns a bit to exclude VC++ project conversion backups. * win/tclWinPipe.c: Stage-1 bug fix for TR#2460 "exec leaks memory". Added more logic around the close-down of the pipe reader thread so as to avoid, at all cost, a TerminateThread. Most cases with exec are fixed, but I don't consider 2460 done yet. Closing down the read side of a pipe before the child process, doesn't really fit the windows model. [BUG: 2460] 2000-09-07 Jeff Hobbs * doc/trace.n: minor doc cleanup 2000-09-06 AndrУЉ PУЖnitz * doc/*.n: added or changed "SEE ALSO:" section 2000-09-06 Jeff Hobbs * win/tclWinLoad.c (TclpLoadFile): added special message for ERROR_PROC_NOT_FOUND exception in loading a dll. * win/tclWinError.c: changed ERROR_PROC_NOT_FOUND to map from ESRCH (POSIX: no such process) to EINVAL because there is no good mapping for "procedure not found". * README: * generic/tcl.h: * library/tcltest1.0/tcltest.tcl: * tools/tcl.wse.in: * tools/tcltk-man2html.tcl: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: updated patchlevel to 8.4a2 * unix/tclUnixPipe.c (TclpCreateProcess): Removed WNOHANG from Tcl_WaitPid call in error case of process creation on Unix, as it would lead to defunct processes. [Bug: 6148] * tests/string.test: extended string repeat tests * generic/tclCmdMZ.c (Tcl_StringObjCmd): changed STR_REPEAT to preallocate the full space of the final string, avoided repeated appends. * doc/source.n: * doc/Eval.3: added extra note about how to safe use ^Z in code, as it is now a cross-platform (was just Windows) EOF char. 2000-09-05 Jeff Hobbs * generic/tclHash.c: fixed pedantic warning of incorrectly placed #endif * generic/tclExecute.c (TclExecuteByteCode): INST_STR_INDEX fixed pedantic cast warning. Corrected support for building with -DTCL_COMPILE_STATS. Added efficiency check of object equality. 2000-08-29 Eric Melski * generic/tclStringObj.c: Applied patch from Gerhard Hintermayer to provide a more conservative string growth algorithm for strings larger than one megabyte; this allows more efficient use of memory for very large strings. 2000-08-25 Eric Melski * tests/trace.test: Extended array tracing tests. * doc/trace.n: Clarified information about when array traces will be fired. * generic/tclVar.c (Tcl_ArrayObjCmd): Corrected call to CallTraces (for TCL_TRACE_ARRAY) to only be called when the variable is either an array or is undefined, to ensure that array traces do not fire for scalar variables. 2000-08-24 Eric Melski * doc/man.macros: Tweaked tab settings for .SO (Standard Options) sections, based on suggestion from Peter Spjuth. 2000-08-24 Mo DeJong * unix/README: Update to account for removal of --enable-gcc. * unix/configure.in: * unix/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option. * win/README: Add note about building with Cygwin. * win/configure.in: * win/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option. Remove quick hack that provided cross compile support for windows builds. 2000-08-24 Eric Melski Overall change: Added support for command rename/delete traces and new trace syntax, from patch from Vince Darley. Added support for array traces for variables. [RFE: 5048, 5967]. * doc/trace.n: Updated documentation for new syntax; flagged old syntax as deprecated; added documentation for command rename/delete traces and variable array traces. * tests/trace.test: Updated tests for new trace syntax; new tests for command rename/delete traces; new tests for array traces. * generic/tclVar.c: Support for new trace syntax; support for TCL_TRACE_ARRAY. * generic/tclStubInit.c: * generic/tclDecls.h: * generic/tcl.decls: Stub functions for command rename/delete traces. * generic/tcl.h: * generic/tclInt.h: * generic/tclBasic.c: Support for command traces. * generic/tclCmdMZ.c (TclTraceVariableObjCmd): Patched to support new [trace] syntax: trace {add|remove|list} {variable|command} name ops command Added support for command traces (rename, delete operations). Added support for TCL_TRACE_ARRAY at Tcl level (array operation for variable traces). 2000-08-20 Eric Melski * generic/tclVar.c: Added check for non-arrays for [array statistics] command (patch from Mark Patton). 2000-08-19 David Gravereaux * generic/tclPlatDecls.h: without a previous '#include ', tclPlatDecls.h can't be parsed due to a missing definition of TCHAR. Added a check to include it when not defined. ***POSSIBLE OBSCURE BUG*** could be caused when the compile flags for the core happen to be different than a project who uses these publics regarding -D_MBCS and -D_UNICODE. This added check might have to be revisited later with a better understanding of the reprocusions. I think TCHAR should be replaced with it's expansion. 2000-08-18 David Gravereaux * win/.cvsignore (added): provides a cleaner build environment with graphical CVS clients. 2000-08-15 Eric Melski * library/tcltest1.0/tcltest.tcl: Set debug level in tcltest::restoreState to 2, for consistancy with the debug level in tcltest::saveState [Bug: 4505]. 2000-08-14 Eric Melski * win/makefile.vc: * win/Makefile.in: * unix/Makefile.in: Added tclPlatDecls.h to the list of installed headers, for more complete stubs support. [Bug: 5241]. * generic/tcl.h: Added #include "tclPlatDecls.h" to get platform-specific stubs declarations (Tcl_WinTCharToUtf, etc) [Bug: 5241]. * README: Updated link for instructions on compiling Tcl from sources to point to correct location (http://dev.scriptics.com/doc/... instead of http://dev.scriptics.com/support/...). 2000-08-11 Eric Melski * generic/tclEnv.c (TclUnsetEnv): Changed declaration of length variable from "unsigned int" to "int", to match usage when passed to TclpFindVariable [Bug: 6126]. 2000-08-10 Eric Melski * library/msgcat1.0/pkgIndex.tcl: Bumped version number to 1.2 [Bug: 6100]. * library/msgcat1.0/msgcat.tcl: Removed erroneous [package forget] in msgcat namespace initializer. Bumped version number to 1.2 [Bug: 6100] 2000-08-10 David Gravereaux * generic/tclObj.c: r1.15 accidentally changed a global mutex name tclObjMutex to ObjMutex. Put the correct name back. 2000-08-07 Eric Melski * tests/indexObj.test: Added tests using the [testwrongnumargs] command to test Tcl_WrongNumArgs. * generic/tclTest.c (TestWrongNumArgsObjCmd): Added test function for the Tcl_WrongNumArgs function. * generic/tclIndexObj.c (Tcl_WrongNumArgs): Corrected algorithm to not insert a space before the message component when objc == 0 [Bug: 6078] 2000-07-27 Mo DeJong * win/configure.in: TCL_STUB_LIB_FLAG should not include ${TCL_DBGX} in win/tclConfig.sh, fix that. 2000-07-25 David Gravereaux * doc/Async.3: * generic/tclAsync.c: * generic/tclInt.decls: * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: * generic/tclTest.c: * mac/tclMacPort.h: * unix/tclUnixPort.h: * win/tclWinInit.c: Thread-safe rewrite for tclAsync.c. Added notifier alerting on all platforms as it was only working on Win before. Removed older Win hacks that would end-up waking the wrong notifier in the presence of a threaded build. All tests pass as before. New test cases will be added soon for the new behavior. [BUG: 5791] 2000-07-25 Eric Melski * generic/tclVar.c (CallTraces): Added check for VAR_TRACE_ACTIVE on the array containing the variable before executing traces on that array, to conform with normal variable traces and the documentation, which states that while executing a trace, other traces on that variable are disabled. [Bug: 6049]. * win/tclWinPipe.c (BuildCommandLine): Added Tcl_DStringFree call to prevent potential memory leaks [Bug: 6041]. 2000-07-24 Eric Melski * doc/msgcat.n: Added documentation about the selection of the default locale on Windows. 2000-07-23 Joe English * doc/AddErrInfo.3: * doc/ChnlStack.3: * doc/Exit.3: * doc/GetIndex.3: * doc/Notifier.3: * doc/Object.3: * doc/RegExp.3: * doc/SetResult.3: * doc/SplitList.3: * doc/Thread.3: Added missing entries to NAME section. * doc/AddErrInfo.3: * doc/CrtObjCmd.3: * doc/RecEvalObj.3: Changed Tcl_EvalObj to Tcl_EvalObjEx 2000-07-21 Eric Melski * generic/tclStubInit.c: * generic/tclObj.c: * generic/tclInt.h: * generic/tclHash.c: * generic/tclDecls.h: * generic/tcl.h: * generic/tcl.decls: * doc/Hash.3: Reapplied patch from Paul Duffin to extend hash tables to allow custom key types, such as Tcl_Obj *'s, and others. * doc/binary.n: Noted that the example in the introduction assumes a 32-bit system [Bug: 6035]. 2000-07-21 Mo DeJong * win/configure.in: Define ${prefix} and ${exec_prefix} like unix/configure.in. Fix or add TCL_SRC_DIR, TCL_STUB_LIB_FILE, TCL_STUB_LIB_FLAG, TCL_BUILD_STUB_LIB_SPEC, TCL_STUB_LIB_SPEC, TCL_BUILD_STUB_LIB_PATH, TCL_STUB_LIB_PATH. 2000-07-20 Eric Melski * generic/tclStubInit.c: * generic/tclObj.c: * generic/tclInt.h: * generic/tclHash.c: * generic/tclDecls.h: * generic/tcl.h: * generic/tcl.decls: * doc/Hash.3: Reverted patch from Paul Duffin to extend hash tables to allow custom key types, such as Tcl_Obj *'s, and others; it seems to break Tk. 2000-07-19 Eric Melski * generic/tclStubInit.c: * generic/tclObj.c: * generic/tclInt.h: * generic/tclHash.c: * generic/tclDecls.h: * generic/tcl.h: * generic/tcl.decls: * doc/Hash.3: Applied patch from Paul Duffin to extend hash tables to allow custom key types, such as Tcl_Obj *'s, and others. * tests/pkgMkIndex.test: Added tests for pkg_compareExtension. * library/package.tcl: Enhanced pkg_compareExtension to handle Unixes which tack the version number on to the end of library names (eg, foo.so.1.2); such filenames will be correctly matched. (Patch from Vince Darley). * win/makefile.vc: Applied patch from Don Porter to provide better nmake support for NT/Alpha [RFE: 5938]. 2000-07-18 Mo DeJong * unix/configure.in: * unix/tcl.m4: * win/tcl.m4: Properly quote arguments to m4 macros. This allows Tcl to work with the new version of autoconf. 2000-07-18 Eric Melski * tests/opt.test: Removed references to Lfirst, Lrest functions. * library/opt0.4/optparse.tcl: Applied patch from Chris Nelson, which replaces the [Lfirst] function with an inline [lindex ... 0] and [Lrest] with [lrange ... 1 end], for better performance. [RFE: 6019] 2000-07-18 Eric Melski * compat/string.h: Fixed function prototypes for strpbrk and strtok [Bug: 6020]. 2000-07-17 David Gravereaux * win/tclWinChan.c: Win2K OS bug with GetStdHandle(STD_OUTPUT_HANDLE) giving the wrong answer. This made TclpGetDefaultStdChannel grab what it thought was a valid native stdout handle. Added a new WriteFile() test to make sure it's really valid. This OS bug doesn't affect the shells. Only -subsystem:windows (aka WinMain) application that dynamically load tclXX.dll [BUG: 5971] 2000-07-17 Eric Melski * library/msgcat1.0/msgcat.tcl: * doc/msgcat.n: * tests/msgcat.test: Applied patches from Chris Nelson, to provide the mcmset function, which allows the translator to set multiple string translations in a single function call, rather than requiring many calls to mcset. [RFE: 6000, 5993]. In addition, these patches correct mcload to use utf-8 encoding on when reading message catalog files, and provides for better default behavior for determining the locale on a Windows system. 2000-07-17 Mo DeJong * unix/tcl.m4 (SC_ENABLE_GCC): Don't set CC=gcc before running AC_PROG_CC if CC is already set. 2000-07-13 AndrУЉ PУЖnitz * doc/lappend.n: * doc/lindex.n: * doc/linsert.n: * doc/list.n: * doc/llength.n: * doc/lrange.n: * doc/lreplace.n: * doc/lsearch.n: * doc/lsort.n: Added SEE ALSO sections. 2000-07-07 Mo DeJong * win/configure.in: Fix definition of TCL_SRC_DIR so that it matches the Unix version. * win/tclConfig.sh.in: Removed duplicate variables. 2000-07-06 Eric Melski * tests/msgcat.test: * library/msgcat1.0/msgcat.tcl: Applied patch from Christian Krone, to provide extended args support for msgcat::unknown, which is used for strings without a known translation in the current locale [Bug: 5984]. 2000-06-29 Eric Melski * doc/msgcat.n: Doc's for mcmax function. * library/msgcat1.0/msgcat.tcl: Applied patches from Laurent Duperval, to add mcmax function, which computes the length of the longest of several translated strings. Bumped version number to 1.1. 2000-06-27 Eric Melski * tests/stringObj.test: Tweaked tests to avoid hard-coded high-ASCII characters (which will fail in multibyte locales); instead used \uXXXX syntax. [Bug: 3842]. 2000-06-26 Eric Melski * doc/package.n: Corrected information about [package forget] arguments [Bug: 5418]. 2000-06-23 Eric Melski * doc/Hash.3: Added documentation patch for Tcl_Obj *'s as keys in Tcl hash tables [RFE: 5934]. * generic/tcl.h: * generic/tclHash.c: Applied patch from [RFE: 5934], which extends Tcl hash tables to allow Tcl_Obj *'s as the key. 2000-06-20 Eric Melski * tests/opt.test: * library/opt0.4/optparse.tcl: Applied patch from [Bug: 5922], which corrected an incorrect use of [string match]. * unix/tclConfig.sh.in: * win/tclConfig.sh.in: Applied patch from [Bug: 5921], which corrects a typo in the comments in these files. 2000-06-19 Eric Melski * doc/RegExp.3: Replaced instances of "Tcl_GetRegExpInfo" with "Tcl_RegExpGetInfo", the correct name of the function [Bug: 5901]. 2000-06-13 Eric Melski * win/tcl.m4: * win/configure.in: * win/Makefile.in: Applied patch from [RFE: 5844], to extend support for mingw compile environment on Windows. * win/tclWinDde.c: * win/tclWinInit.c: * win/tclWinNotify.c: * win/tclWinPipe.c: * win/tclWinReg.c: * win/tclWinThrd.c: Applied patch from [Bug: 5794], to fix compiler warnings when using mingw on Windows. 2000-05-31 Jeff Hobbs * tests/set-old.test: * doc/unset.n: * generic/tclVar.c (Tcl_UnsetObjCmd): added -nocomplain and -- options to unset, to allow for a silent unset operation. 2000-05-31 Eric Melski * generic/tclVar.c (Tcl_ArrayObjCmd): Added support for regexp and exact matching for [array names] command. [RFE: 3684]. * doc/array.n: Added documentation for [array names -exact/-regexp/-glob] [RFE: 3684]. * tests/set-old.test: Added tests for [array names -exact/-regexp/-glob] [RFE: 3684]. 2000-06-06 Jeff Hobbs 8.4a1 RELEASE * generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP): added test of iResult return from memcmp, as memcmp isn't required to return only -1,0,1. 2000-06-03 Jeff Hobbs * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Corrected caching of the index ptr to account for offsets != sizeof(char *). [Bug: 5153] 2000-05-29 Sandeep Tamhankar * tests/http.test * doc/http.n * library/http2.3/http.tcl: Fixed bug 5741, where unsuccessful geturl calls sometimes leaked memory and resources (sockets). Also, switched around some of the logic so that http::wait never throws an exception. This is because in an asynchronous geturl, the command callback will probably end up doing all the error handling anyway, and in an asynchronous situation, the user expects to check the state when the transaction completes, as opposed to being thrown an exception. For the http package, this menas the user can check http::status for "error" and http::error for the error message after doing the http::wait. 2000-05-27 Jeff Hobbs * tests/info.test: * doc/info.n: * generic/tclIOUtil.c (Tcl_EvalFile): * generic/tclCmdIL.c (InfoScriptCmd): added ability to set the info script return value [info script ?newFileName?]. This will be beneficial for virtual file system programs. [Bug: 4225] 2000-05-26 Jeff Hobbs * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): reworked to operate in Unicode, tweaked for performance. (Tcl_StringObjCmd) changed STR_FIRST/STR_LAST error message to something more understandable, reworked STR_FIRST, STR_LAST, STR_MAP, STR_MATCH, STR_RANGE, STR_REPLACE to operate in Unicode. Removed inneffectual STR_RANGE "special" ByteArray support. Optimized STR_MAP algorithm, especially optimized for one-pair case. Fixed possible mem overrun in STR_INDEX bytearray case. * generic/tclCompExpr.c: changed INST_STREQ -> INST_STR_EQ, INST_STRNEQ -> INST_STR_NEQ * generic/tclCompile.c: added streq, strneq, strcmp, strlen & strmatch to the compiled stats instructionTable * generic/tclCompile.h: added instructions INST_STR_CMP, INST_STR_INDEX, INST_STR_MATCH * generic/tclCompCmds.c: added byte compiler support for [string compare|match|index]. * generic/tclExecute.c: Changed INST_STR_(N)EQ to return an Int object and not bother trying to reuse the top stack object. Added INST_STR_CMP, INST_STR_INDEX, INST_STR_MATCH bytecode ops. Extended evalstats output info with Tcl_IsShared stat info. * generic/tclInt.h: * generic/tclObj.c (Tcl_DbIsShared): added support for checking result of Tcl_IsShared in evalstats (TCL_COMPILE_STATS). * generic/tclStringObj.c (Tcl_AppendUnicodeToObj): removed dead code. (AppendUnicodeToUnicodeRep) removed overallocation by extra sizeof(Tcl_UniChar) multiplier. * tests/string.test: added string map tests for the one-pair case, corrected tests to reflect improved error messages in first/last. Added tests against mem overrun in string index bytearray case. 2000-05-23 Eric Melski * generic/tclInt.h: Added function prototypes for TclCompileStringCmd and TclCompileReturnCmd. * generic/tclCompile.h: Added definition of INST_STRLEN opcode and updated LAST_INST_OPCODE value. * generic/tclBasic.c: Added information about TclCompileStringCmd and TclCompileReturnCmd to BuiltInCmds table. * generic/tclExecute.c (TclExecuteByteCode): Added support for the INST_STRLEN opcode. * generic/tclCompCmds.c (TclCompileStringCmd): Basic implementation of byte-compiled [string] command. Not all subcommands are implemented; those that are not an out-line compiled. (TclCompileReturnCmd): Byte-compiled implementation of [return] command. Only "simple" returns are byte-compiled; in particular, if the -code, -errorinfo or -errorcode flags are used, the command is not byte-compiled. 2000-05-22 Jeff Hobbs * doc/scan.n: * doc/array.n: minor doc fixes [Bug: 5396] * generic/tclEnv.c: cast cleanup [Bug: 5624] * win/tclWinConsole.c: cast and header cleanup [Bug: 5625] * win/tclWinSerial.c: cast cleanup [Bug: 5626] * win/tclWinFCmd.c: cast cleanup [Bug: 5627] 2000-05-19 Jeff Hobbs * generic/tclTest.c: * generic/tclIO.c: moved channel test commands from tclIO.c to tclTest.c. * generic/tclIO.h: new file, split out from tclIO.c to allow test commands to be moved to tclTest.c. * generic/tclStubInit.c: * generic/tclIntDecls.h: * generic/tclInt.decls: removed TclTestChannel*Cmd from internal stubs table and added TclChannelEventScriptInvoker to the internal stubs table so it can be used from the test code. 2000-05-18 Eric Melski * tests/clock.test: Added test for "2 days 2 hours ago" style specifications. * generic/tclDate.c: Regenerated from tclGetDate.y. * generic/tclGetDate.y: Tweaked grammar to properly handle the "ago" keyword when it follows multiple relative unit specifiers, as in "2 days 2 hours ago". [Bug: 5497] 2000-05-18 Jeff Hobbs * win/{tcl.m4,Makefile.in,configure.in}: added support for mingw compile env and cross-compiling. [Bug: 5499] * generic/tclClock.c (FormatClock): correct code to handle locale specific return values from strftime, if any. [Bug: 3345] * unix/tclUnixInit.c (TclpSetInitialEncodings): attempt to correct setlocale calls for XIM support and locale issues. [BUG: 5422 3345 4236 2522 2521] 2000-05-17 Jeff Hobbs * library/init.tcl (auto_import): added check to see if a valid pattern was coming in, to avoid simple error cases [Bug: 3326] * doc/regsub.n: correct regsub docs [Bug: 5346] 2000-05-15 Eric Melski * library/history.tcl: Corrected an off-by-one error in HistIndex, which was causing [history redo] to start its search at the wrong event index. [Bug: 1269]. 2000-05-10 Jeff Hobbs * generic/tclPosixStr.c (Tcl_SignalMsg): clarified #defines for Linux on Sparc to compile correctly. [Bug: 5364] * doc/namespace.n: * tests/namespace.test: * generic/tclNamesp.c (Tcl_NamespaceObjCmd): added 'namespace exists' command. [Bug: 4665] * doc/source.n: * doc/Eval.3: * tests/source.test: * generic/tclIOUtil.c (Tcl_EvalFile): added explicit \32 (^Z) eofchar (affects Tcl_EvalFile in C, "source" in Tcl). This was implicit on Windows already, and is now cross-platform to allow for scripted documents. 2000-05-09 Andreas Kupries operating as proxy for David Gravereaux * win/tclWinThrd.c (TclpInitLock, TclpMasterLock): Added missing initialization of joinLock. 2000-05-09 Eric Melski * tests/lsearch.test: * doc/lsearch.n: * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Extended [lsearch] to support sorted list searching and typed list searching. [RFE: 4098]. 2000-05-08 Jeff Hobbs * doc/expr.n: * tests/expr.test: * tests/expr-old.test: added tests for 'eq' and 'ne' * generic/tclExecute.c: * generic/tclCompile.h: added INST_STREQ and INST_STRNEQ opcodes that do strict string comparisons. * generic/tclCompExpr.c: added 'eq' and 'ne' string comparison operators. * generic/tclParseExpr.c (GetLexeme): added 'eq' and 'ne' expr parse terms (string (in)equality check). * generic/tclCmdIL.c (Tcl_LinsertObjCmd): made use of Tcl_DuplicateObj where code was otherwise duplicated. Made special case of inserting one element at the end work again (where index == len). (Tcl_LreplaceObjCmd): moved Tcl_DuplicateObj call lower and cleaned up use of other arguments. * generic/tclObj.c (Tcl_DuplicateObj): simplified code to call TclInitStringRep, which the code was just duplicating in part. * doc/Utf.3: * generic/tclStubInit.c: * generic/tcl.decls: * generic/tclDecls.h: * generic/tclUtf.c: Added new functions Tcl_UniCharNcasecmp and Tcl_UniCharCaseMatch (unicode parallel to Tcl_StringCaseMatch) * generic/tclUtil.c: rewrote Tcl_StringCaseMatch algorithm for optimization and made Tcl_StringMatch just call Tcl_StringCaseMatch * tests/string.test: extended string match tests 2000-05-08 Eric Melski * tests/set-old.test: * doc/array.n: * generic/tclVar.c: Added [array statistics] command [RFE: 4557] 2000-05-06 Andreas Kupries operating as proxy for David Gravereaux * tclThreadJoin.c: Fixed several places with missing a & in arguments to calls of Tcl_Mutex(Un)lock and Tcl_ConditionNotify functions. 2000-05-02 Jeff Hobbs * README: * generic/tcl.h: * library/init.tcl: * library/reg1.0/pkgIndex.tcl: * library/tcltest1.0/tcltest.tcl: * mac/README: * tools/tcl.hpj.in: * tools/tcl.wse.in: * unix/README: * unix/configure.in: * unix/tcl.spec: * win/README: * win/README.binary: * win/configure.in: * win/makefile.vc: * win/tcl.m4: updated patchlevel to 8.4a1 * tests/compile.test: * tests/init.test: * tests/proc.test: * tests/proc-old.test: * tests/rename.test: * generic/tclProc.c: reworked error return for procedures with incorrect args to be like the C Tcl_WrongNumArgs, where a "wrong # args: ..." message is printed out with the args list. * unix/Makefile.in: add tclsh.ico and tcl.spec to dist target 2000-05-02 Andreas Kupries Overall changes: (1) Implementation of joinable threads for all platforms. (2) Additional API's for channels. Required to allow the thread extension to move channels between threads. * generic/tcl.decls (lines 1360f): Added Tcl_JoinThread, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting and Tcl_ClearChannelHandlers (slots 394 to 400). * generic/tclIO.c: Implemented Tcl_IsChannelRegistered, Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting and Tcl_ClearChannelHandlers. Tcl_CutChannel uses code from CloseChannel. Replaced this code by a call to Tcl_CutChannel. Replaced several code fragments adding channels to the channel list with calls to Tcl_SpliceChannel. Removed now unused variables from CloseChannel and Tcl_UnstackChannel. Tcl_ClearChannelHandlers uses code from Tcl_Close. Replaced this code by a call to Tcl_ClearChannelHandlers. Removed now unused variables from Tcl_Close. Added the subcommands 'cut', 'forgetch', 'splice' and 'isshared' to the test code (TclTestChannelCmd). * unix/tclUnixThread.c: Implemented Tcl_JoinThread using the pthread-functionality. * win/tclWinThrd.c: Fixed several small typos in comments. Implemented Tcl_JoinThread using a platform independent emulation layer (see generic/tclThreadJoin.c below). Added 'joinLock' to serialize Tcl_CreateThread and TclpExitThread to prevent a race for joinable threads. * mac/tclMacThrd.c: Implemented Tcl_JoinThread using a platform independent emulation layer (see generic/tclThreadJoin.c below). Due to the cooperative nature of threading on this platform the race mentioned above is not present. * generic/tclThreadJoin.c: New file. Contains a platform independent emulation layer helping in the implementation of joinable threads for the win and mac platforms. * generic/tclInt.h: Added declarations for TclJoinThread, TclRememberJoinableThread and TclSignalExitThread. These procedures define the API of the emulation layer for joinable threads (see generic/tclThreadJoin.c above). * win/Makefile.in: * win/makefile.vc: Added generic/tclTheadJoin.o to the rules. * mac/: I don't know to which file generic/tclTheadJoin.o has to be added to so that it compiles. Sorry. * unix/tclUnixChan.c: #ifdef'd the thread-local list of file channels as it prevents us from transfering channels. To restore this we may need an extended interface to drivers in the future. Target: 9.0. Found while testing the new transfer of channels. The information in this list for a channel was left behind and then crashed the system during finalization. * generic/tclThreadTest.c: Added -joinable flag to 'testthread create'. Added subcommand 'testthread join'. * doc/CrtChannel.3: Added documentation for Tcl_IsChannelRegistered, Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting and Tcl_ClearChannelHandlers. * doc/Thread.3: Added documentation for Tcl_JoinThread. * tests/thread.test: Added tests for joining of threads. 2000-04-27 Eric Melski * doc/library.n: Added entries for auto_qualify and auto_import [Bug: 1271]. * doc/Init.3: Manual entry for Tcl_Init [Bug: 1820]. * doc/expr.n: Added documentation for each of the math library functions that expr supports [Bug: 1054]. 2000-04-26 Eric Melski * doc/memory.n: Man page for Tcl "memory" command, which is created when TCL_MEM_DEBUG is defined at compile time. * doc/TCL_MEM_DEBUG.3: Man page with overall information about TCL_MEM_DEBUG usage. * doc/DumpActiveMemory.3: Man page for Tcl_DumpActiveMemory, Tcl_InitMemory, and Tcl_ValidateAllMemory [Bug: 1816, 1835]. * generic/tclCkalloc.c: Fixed some function headers. * unix/mkLinks: Regen'd with new mkLinks.tcl. * unix/mkLinks.tcl: Fixed indentation, made link setup more intelligent (only do one existence test per man page, instead of one per function). * doc/library.n: Fixed .SH NAME macro to include each function documented on the page, so that mkLinks will know about the functions listed there, and so that the Windows help file index will get set up correctly [Bug: 1898, 5273]. 2000-04-26 Jeff Hobbs 8.3.1 RELEASE * README: * mac/README: * tools/tcl.wse.in: * unix/README: * unix/tcl.spec: * win/README: * win/README.binary: Updating URLs to reference dev.scriptics.com 2000-04-25 Jeff Hobbs * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: updated for http change and some cleanup * library/http2.[13]: moved dir http2.1 to http2.3 to match version * doc/Utf.3: clarified docs for Tcl_(UniChar|Utf)AtIndex * unix/tclUnixThrd.c: removed {}s around PTHREAD_MUTEX_INITIALIZER [Bug: 5254] * unix/tclLoadDyld.c (TclpLoadFile): removed use of interp->result 2000-04-25 Eric Melski * unix/mkLinks: * doc/AddErrInfo.3: Added information about Tcl_LogCommandInfo [Bug: 1818]. 2000-04-24 Eric Melski * unix/mkLinks: * doc/OpenFileChnl.3: Added man entry for Tcl_Ungets [Bug: 1834]. * unix/mkLinks: * doc/SourceRCFile.3: Man page for Tcl_SourceRCFile [Bug: 1833]. * unix/mkLinks: * doc/ParseCmd.3: Added documentation for Tcl_ParseVar [Bug: 1828]. 2000-04-24 Jeff Hobbs * unix/tclUnixNotfy.c (Tcl_FinalizeNotifier, NotifierThreadProc): added write of 'q' into triggerPipe for notifier in threaded case, so that Tcl doesn't hang when children are still running [Bug: 4139] * unix/tclUnixThrd.c (Tcl_MutexLock): minor comment fixes. 2000-04-23 Jim Ingham These changes make some error handling marginally better for Mac sockets. It is still somewhat flakey, however. * mac/tclMacSock.c (TcpClose): Add timeouts to the close - these don't seem to be honored, however. Use a separate PB for the release, since an async connect socket will still be using the original buffer. Make sure TCPRelease returns noErr before freeing the recvBuff. If the call returns an error, then the buffer is not right. * mac/tclMacSock.c (CreateSocket): Add timeouts to the async create. These don't seem to trigger, however. Sigh... * mac/tclMacSock.c (WaitForSocketEvent): If an TCP_ASYNC_CONNECT socket errors out, then return EWOULDBLOCK & error out. * mac/tclMacSock.c (NotifyRoutine): Added a NotifyRoutine for experimenting with MacTCP. 2000-04-22 Jim Ingham * library/package.tcl (tclPkgUnknown): Fixed a typo in the Mac package search part of tclPkgUnknown. 2000-04-21 Sandeep Tamhankar * library/http2.1/http.tcl: Fixed a newly introduced bug where if there's a -command callback and something goes wrong, geturl threw an exception, called the callback, and unset the token. I changed it so that it will not call the callback when throwing an exception (so the caller only finds out about a given error from one place). Also, fixed http::ncode so that it actually gives you back the http return code (i.e. 200, 404, etc.) instead of the first digit of the version of HTTP being used (i.e. 1). 2000-04-21 Brent Welch * library/http2.1/http.tcl: More thrashing with the "server closes without reading post data" scenario. Reverted to the previous fileevent configuratiuon, which seems to work better with small amounts of post data. 2000-04-20 Jeff Hobbs * generic/tclAlloc.c: wrapped caddr_t define to not be done on Unix * unix/tclUnixPort.h: added Tclp*Alloc defines to allow the use of USE_TCLALLOC on Unix. [Bug: 4731] 2000-04-19 Jeff Hobbs * library/dde1.1/pkgIndex.tcl: * library/reg1.0/pkgIndex.tcl: * win/tclWinChan.c: * win/tclWinThrd.c: converted CRLF to LF the */tcl.hpj.in files were not converted, as it confuses hcw locally. [Bug: 5096] * win/Makefile.in: expanded cleanup target for help files * doc/Thread.3: minor macro cleanup * generic/tclFileName.c (SplitUnixPath): added support for QNX node ids. 2000-04-18 Jeff Hobbs * README: * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * win/README.binary: bumped version to 8.3.1 * win/tcl.hpj.in: updated copyright date * generic/tclEnv.c: environment support for Mac OS/X * unix/tclUnixPort.h: environment support for Mac OS/X * unix/tclLoadDyld.c: new file for Mac OS/X dl functions * unix/Makefile.in: added install-strip target; bindir, libdir, mandir, includedir vars; tclLoadDyld.c target [Bug: 2527] * unix/tclUnixChan.c (CreateSocket): force a socket back into blocking mode (default state) after a -async connect succeeds. [Bug: 4388] * generic/tclEvent.c (TclInitSubsystems): Moved tclLibraryPath to thread-local storage to prevent thread-related race condition. [Bug: 5033] * unix/tclAppInit.c (main): removed #ifdef TCL_TEST that sets the library path as it was unnecessary and conflicts with move of tclLibraryPath to thread-local storage. 2000-04-18 Scott Redman * win/Makefile.in: * win/tcl.rc: * win/tclsh.rc: * win/tclsh.ico: Modified copyright dates in Windows resource files. Added an icon for tclsh.exe. 2000-04-17 Brent Welch * generic/tcl.h, generic/tclThreadTest.c, unix/tclUnixThrd.c, * win/tclWinThread.c, mac/tclMacThread.c: Added Tcl_CreateThreadType and TCL_RETURN_THREAD_TYPE macros for declaring the NewThread callback proc. 2000-04-14 Jeff Hobbs * unix/tclUnixChan.c (TtyParseMode): Only allow setting mark/space parity on platforms that support it [Bug: 5089] * generic/tclBasic.c (Tcl_GetVersion): adjusted use of major/minor to not conflict with global decl on some systems [Bug: 2882] * doc/AppInit.3: * doc/Async.3: * doc/BackgdErr.3: * doc/CrtChannel.3: * doc/CrtInterp.3: * doc/CrtMathFnc.3: * doc/DString.3: * doc/Eval.3: * doc/ExprLong.3: * doc/GetInt.3: * doc/GetOpnFl.3: * doc/Interp.3: * doc/LinkVar.3: * doc/OpenFileChnl.3: * doc/OpenTcp.3: * doc/PkgRequire.3: * doc/RecordEval.3: * doc/SetResult.3: * doc/SplitList.3: * doc/StaticPkg.3: * doc/TraceVar.3: * doc/Translate.3: * doc/UpVar.3: * doc/load.n: removed or updated references to interp->result use. 2000-04-13 Jeff Hobbs * doc/regexp.n: doc clarification [Bug: 5037] * doc/update.n: typo fix [Bug: 4996] * unix/tcl.m4 (SC_ENABLE_THREADS): enhanced the detection of pthread_mutex_init [Bug: 4359] and (SC_CONFIG_CFLAGS) added --enable-64bit-vis switch for Sparc VIS compilation [Bug: 4995] 2000-04-12 Jeff Hobbs * doc/dde.n: corrected dde poke docs. [Bug: 4991] 2000-04-11 Eric Melski * win/tclWinPipe.c: Added "CONST" keyword to declaration of char *native in TclpCreateTempFile, to supress compiler warnings. 2000-04-10 Brent Welch * generic/tcl.h: Fixed Tcl_CreateThread declaration. * library/tcltest1.0/tcltest.tcl: Fixed the "mainThread" initialization to work with either testthread or the thread extension * unix/tclUnixThrd.c: Fixed compiler warning when compiling with -DTCL_THREADS 2000-04-10 Eric Melski * win/tclWinPipe.c (TclpCreateTempFile): Added conversion of contents string from UTF to native encoding [Bug: 4030]. * tests/regexp.test: Added tests for infinite looping in [regexp -all]. * generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all] [Bug: 4981]. * tests/*.test: Changed all occurrences of "namespace import ::tcltest" to "namespace import -force ::tcltest" [Bug: 3948]. 2000-04-09 Brent Welch * lib/httpd2.1/http.tcl: Worked on the "server closes before reading post data" case, which unfortunately causes different error cases on Solaris, which can read the reply, and Linux and Windows, which cannot read anything. This is all in the loop-back case - client and server on the same host. Also unified the error handling so the "ioerror" status goes away and errors are reflected in a more uniform way. Updated the man page to document the behavior. 2000-04-09 Jeff Hobbs * tests/reg.test (matchexpected): corrected tests to use tcltest constraint types to skip certain tests. * generic/tclBasic.c (Tcl_SetCommandInfo): comment fix * unix/tclUnixThrd.c (Tcl_CreateThread): moved TCL_THREADS ifdef inside of func as it is declared for non-threads builds as well. In the non-threads case, it always returns TCL_ERROR (couldn't create thread). 2000-04-08 Andreas Kupries * Overall change: Definition of a public API for the creation of new threads. * generic/tclInt.h (line 1802f): Removed the definition of 'TclpThreadCreate'. (line 793f) Removed the definition of 'Tcl_ThreadCreateProc'. * generic/tcl.h (line 388f): Readded the definition of 'Tcl_ThreadCreateProc'. Added Win32 stuff send in by David Graveraux to that too (__stdcall, ...). Added macros for the default stacksize and allowed flags. * generic/tcl.decls (line 1356f): Added definition of 'Tcl_CreateThread', slot 393 of the stub table. Two new arguments in the public API, for stacksize and flags. * win/tclWinThrd.c: * mac/tclMacThrd.c: Renamed TclpThreadCreate to Tcl_CreateThread, added handling of the stacksize. Flags are currently ignored. * unix/tclUnixThrd.c: See above, but handles joinable flag. Ignores the specified stacksize if the macro HAVE_PTHREAD_ATTR_SETSTACKSIZE is not defined. * generic/tclThreadTest.c (line 363): See below. * unix/tclUnixNotfy.c (line 210): Adapted to the changes above. Uses default stacksize and no flags now. * unic/tcl.m4 (line 382f): Added a check for 'pthread_attr_setstacksize' to detect platforms not implementing this feature of pthreads. If it is implemented, configure will define the macro HAVE_PTHREAD_ATTR_SETSTACKSIZE (See unix/tclUnixThrd.c too). * doc/Thread.3: Added Tcl_CreateThread and its arguments to the list of described functions. Removed stuff about not providing a public C-API for thread-creation. 2000-04-07 Jeff Hobbs * doc/binary.n: clarified docs on sign extension in binary scan [Bug: 3466] * library/tcltest1.0/tcltest.tcl (initConstraints): removed win32s references (no longer supported) * tests/fCmd.test: marked test 8.1 knownBug because it is dangerous on poorly configured systems [Bug: 3881] and added 8.2 to keep essence of 8.1 tested. 2000-04-05 Andreas Kupries * generic/tclIO.c (Tcl_UnstackChannel, line 1831): Forcing interest mask to the correct value after an unstack and re-initialization of the notifier via the watchProc. Without this the first fileevent after an unstack will come through and be processed, but no more. [Bug: ??]. 2000-03-04 Brent Welch * {win,unix}/Makefile.in: added dependency of tclStubInit.c on tcl.decls and tclInt.decls * generic/tclThread.c: Tweak so this compiles w/out TCL_THREADS * generic/{tcl.decls,tclStubInit.c}: Just touched the tcl.decls and regenerated the tclStubInit.c file 2000-03-29 Sandeep Tamhankar * library/http2.1/http.tcl: For the -querychannel option, fconfigure the socket to be binary so that we don't translate anything while reading the data. This is because we determine the content length of the data on the channel by using seek (to the end of the file) and tell on the file handle, and we need the content-length to match the amount of data actually sent, and translation can affect the number of bytes posted. 2000-04-03 Andreas Kupries * Overall change: Definition of public API's for the finalization of conditions and mutexes. [Bug: 4199]. * generic/tclInt.h: Removed definitions of TclFinalizeMutex and TclFinalizeCondition. * generic/tcl.decls: Added declarations of Tcl_MutexFinalize and Tcl_ConditionFinalize. * generic/tclThread.c: Renamed TclFinalizeMutex to Tcl_MutexFinalize. Renamed TclFinalizeCondition to Tcl_ConditionFinalize. * generic/tclNotify.c: Changed usage of TclFinalizeMutex to Tcl_MutexFinalize. * unix/tclUnixNotfy.c: * generic/tclThreadTest.c: Changed usages of TclFinalizeCondition to Tcl_ConditionFinalize. * generic/tcl.h: Added empty macros for Tcl_MutexFinalize and Tcl_ConditionFinalize, to be used when the core is compiled without threads. * doc/Thread.3: Added description the new API's. 2000-04-03 Jeff Hobbs * generic/tclCmdIL.c (InfoVarsCmd): checked for non-NULL procPtr to prevent itcl info override crash [Bug: 4064] * tests/foreach.test: * tests/namespace.test: * tests/var.test: Added lsorts to avoid random sorted return problems. [Bug: 2682] * tests/fileName.test: fixed 14.1 test fragility [Bug: 1482] * tools/man2help2.tcl: fixed winhelp cross-linking error [Bug: 4156] improved translation to winhelp [Bug: 3679] * unix/Makefile.in (MAN_INSTALL_DIR): patch to accept --mandir correctly [Bug: 4085] * unix/dltest/pkg[a-e].c: Cleaned up test packages [Bug: 2293] 2000-04-03 Eric Melski * unix/tclUnixFCmd.c (SetGroupAttribute): * unix/tclUnixFCmd.c (SetOwnerAttribute): Added (uid_t) and (gid_t) casts to avoid compiler warnings. 2000-03-31 Eric Melski * generic/tclGet.c (Tcl_GetDouble): Added additional conditions to error test (previously only errno was checked, but the return value of strtod() should be checked as well). [Bug: 4118] * tests/exec.test: Added test for proper conversion of UTF data when used with "<< $dataWithUTF" on exec's. * unix/tclUnixPipe.c (TclpCreateTempFile): Added Tcl_UtfToExternalDString call, so that if there is UTF content in the string it will be properly converted to the system encoding before being written [Bug: 4030]. (TclpCreateTempFile): Added a check on the return value of tmpnam; some systems (Linux, for example) will start to return NULL after tmpnam has been called TMP_MAX times; not checking for this can have bad results (overwriting temp files, core dumps, etc.) 2000-03-30 Jeff Hobbs * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Added comments noting the need to pair ckalloc with ckfree. [Bug: 4262] * generic/tclInt.decls: * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: * win/tclWin32Dll.c: removed TclWinSynchSpawn (vestige of Win32s support). * win/tclWinReg.c: made use of TclWinGetPlatformId instead of getting info again * win/tclWinPort.h: * win/Makefile.in: * win/configure.in: * win/tcl.m4: Added support for gcc/mingw on Windows [Bug: 4234] 2000-03-29 Jeff Hobbs * generic/tclCompile.c (TclCleanupByteCode): made ByteCode cleanup more aware of TCL_BYTECODE_PRECOMPILED flagged structs (gen'd by tbcload), to correctly clean them up. * generic/tclClock.c (FormatClock): moved check for empty format earlier, commented 0 result return value 2000-03-29 Sandeep Tamhankar * library/http2.1/http.tcl: Removed an unnecessary fileevent statement from the error processing part of the Write method. Also, fixed two potential memory leaks in wait and reset, in which the state array wasn't being unset before throwing an exception. Prior to this version, Brent checked in a fix to catch a fileevent statement that was sometimes causing a stack trace when geturl was called with -timeout. I believe Brent's fix is necessary because TLS closes bad sockets for secure connections, and the fileevent was trying to act on a socket that no longer existed. 2000-03-27 Jeff Hobbs * tests/httpd: removed unnecessary 'puts stderr "Post Dispatch"' * tests/namespace.test: * generic/tclNamesp.c (Tcl_Export): added a uniq'ing test to the export list so only one instance of each export pattern would exist in the list. * generic/tclExecute.c (TclExecuteByteCode): optimized case for the empty string in ==/!= comparisons 2000-03-27 Eric Melski * unix/tclUnixChan.c: Added (off_t) type casts in lseek() call [Bug: 4409]. * unix/tclLoadAout.c: * unix/tclUnixPipe.c: Added (off_t) type casts in lseek() calls [Bug: 4410]. 2000-03-22 Sandeep Tamhankar * library/http2.1/http.tcl: Fixed a bug where string query data that was bigger than queryblocksize would get duplicate characters at block boundaries. 2000-03-22 Sandeep Tamhankar * library/http2.1/http.tcl: Fixed bug 4463, where we were getting a stack trace if we tried to publish a project to a good host but a port where there was no server listening. It turned out the problem was a stray fileevent that needed to be cleared. Also, fixed a bug where http::code could stack trace if called on a bad token (one which didn't represent a successful geturl) by adding an http element to the state array in geturl. 2000-03-21 Eric Melski * tests/clock.test: Modified some tests that were not robust with respect to the time zone in which they were run and were thus failing. * doc/clock.n: Clarified meaning of -gmt with respect to -base when used with [clock scan] (-gmt does not affect the interpretation of -base). 2000-03-19 Sandeep Tamhankar * library/http2.1/http.tcl: geturl used to throw an exception when the connection failed; I accidentally returned a token with the error info, breaking backwards compatibility. I changed it back to throwing an exception, but unsetting the state array first (thus still eliminating the original memory leak problem). 2000-03-19 Sandeep Tamhankar * library/http2.1/http.tcl: Added -querychannel option and altered some of Brent's modifications to allow asynchronous posts (via -command). Also modified -queryprogress so that it calls the query callback as to be consistent with -progress. Added -queryblocksize option with default 8192 bytes for post blocksize. Fixed a bunch of potential memory leaks for the case when geturl receives bad args or can't open a socket, etc. Overall, the package really rocks now. * doc/http.n: Added -queryblocksize, -querychannel, and -queryprogress. Also, changed the description of -blocksize, which states that the -progress callback will be called for each block, to now qualify that with an "if -progress is specified". * tests/http.test: Added a querychannel test for synchronous and asynchronous posts, altered the queryprogress test such that the callback conforms to the -progress format. Also, had to use the -queryblocksize option to do the post 16K at a time to match Brent's expected results (and to test that -queryblocksize works). 2000-03-15 Brent Welch * library/http2.1/http.tcl: Added -queryprogress callback to http::geturl and also changed it so that writing the post data is event driven if the queryprogress callback or a timeout is given. This allows a timeout to occur when writing lots of post data. The queryprogress callback is called after each block of query data is posted. It has the same signature as the -progress callback. 2000-03-06 Eric Melski * library/package.tcl: Applied patch from Bug: 2570; rather than setting geometry of slave interp to 0x0 when Tk was loaded, it now does "wm withdraw .". Both remove the main window from the display, but the former caused some internal structures to get initialized to zero, which caused crashes with some extensions. 2000-03-02 Jeff Hobbs * library/package.tcl (tclPkgUnknown): extended to allow recognizes changes in the auto_path while sourcing in other pkgIndex.tcl files * doc/FindExec.3: fixed doc for declaration of Tcl_FindExecutable [Bug: 4275] * generic/tclFileName.c (Tcl_TranslateFileName): Applied patch from Newman to significantly speedup file split/join on Windows (replaces regexp with custom parser). [Bug: 2867] * win/README.binary: change mailing lists from @consortium.org to @scriptics.com [Bug: 4173] 2000-02-28 Eric Melski * tests/clock.test: Added test for ISO bases < 100000 * generic/tclDate.c: (generated on Solaris) * generic/tclGetDate.y: Changed condition for deciding if a number is an ISO 8601 base from number >= 100000 to numberOfDigits >= 6. Previously it would fail to recognize 000000 as an ISO base. 2000-02-14 Eric Melski * unix/Makefile.in: Added rpm target to generate Tcl binary RPM. * unix/tcl.spec: RPM specification file for a Tcl binary RPM for Linux. 2000-02-10 Jeff Hobbs 8.3.0 RELEASE * changes: updated for 8.3.0 release * doc/load.n: added notes about dll load errors on Windows * unix/README: * unix/Makefile.in (dist): removed porting.notes and porting.old from distribution and CVS. The information was very outdated. Now refer to http://dev.scriptics.com/services/support/platforms.html * tests/unixInit.test: fixed japanese LANG encoding test [Bug: 3549] * unix/configure.in: * unix/tcl.m4: correct CFLAG_WARNING setting, fixed gcc config for AIX, added -export-dynamic to LDFLAGS for FreeBSD-3+ [Bug: 2998] * win/tclWinLoad.c (TclpLoadFile): improved error message for load failures, could perhaps be even more intelligent. 2000-02-09 Jim Ingham * mac/tclMacSock.c: Don't panic when you get an error closing an async socket. This doesn't seem to hurt anything, and we return the error so the caller can do the right thing. New Files: * mac/MW_TclHeader.h: * mac/MW_TclTestHeader.h: * mac/MW_TclTestHeader.pch: * mac/MW_TclAppleScriptHeader.h: More convenient to use .h prefix files in the preference panels... The above are curtesy of Daniel Steffen (steffen@math.mq.edu.au) 2000-02-08 Eric Melski * tests/clock.test: Added tests for "next monthname" constructs. * generic/tclDate.c: * generic/tclGetDate.y (Message): Added a grammar rule for "next monthname" so that we can handle "next january" and similar constructs (bug #4146). 2000-02-08 Jeff Hobbs * README: * tools/tcl.wse.in: * unix/configure.in: * win/configure.in: * win/README: * win/README.binary: * generic/tcl.h (TCL_RELEASE_SERIAL): Moved to 8.3.0 patchlevel * doc/library.n: * library/auto.tcl: fixed crufty puts code and docs [Bug: 4122] * library/tcltest1.0/tcltest.tcl: correctly protected searchDirectory list to allow dirnames with spaces * unix/tcl.m4: changed all -fpic to -fPIC * generic/tclDecls.h: * generic/tcl.decls: change Tcl_GetOpenFile to use decl of 'int forWriting' instead of 'int write' to avoid shadowing [Bug: 4121] * tests/httpold.test: changed test script to source in the httpd server procs from httpd instead of having its own set. * tests/httpd: improved query support in test httpd to handle fix in http.tcl. [Bug: 4089 change 2000-02-01] * unix/README: fixed notes about --enable-shared and add note about --disable-shared. 2000-02-07 Eric Melski * tests/package.test: * library/tclIndex: * library/package.tcl: Renamed ::package namespace to ::pkg. 2000-02-03 Eric Melski * doc/Package.n: * doc/packagens.n: Renamed Package.n -> packagens.n because Windows can't deal with case-sensitive names. 2000-02-02 Jeff Hobbs * tests/regexp.test: added tests for -all and -inline switches * doc/regexp.n: added docs for -all and -inline switches * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): added extra comments for new -all and -inline switches to regexp command 2000-02-01 Eric Melski * library/init.tcl: Applied patch from rfe 1734 regarding auto_load errors not setting error message and errorInfo properly. 2000-02-01 Jeff Hobbs * win/Makefile.in (install-*): reduced verbosity of install * generic/tclFileName.c (Tcl_JoinPath): improved support for special QNX node id prefixes in pathnames [Bug: 4053] * library/http1.0/http.tcl: * library/http2.1/http.tcl: The query data POSTed was newline terminated when it shouldn't be altered [Bug: 4089] 2000-01-31 Eric Melski * tests/package.test: * library/tclIndex: * library/package.tcl: Added ::package namespace and ::package::create function. * library/init.tcl: Fixed problem with auto_load and determining if commands were loaded. * library/auto.tcl: "Fixed" issues with $ in files to be auto indexed. * doc/Package.n: New man page for package::create function. * doc/pkgMkIndex.n: Added additional information. * doc/library.n: Added additional qualification regarding auto_mkindex. 2000-01-28 Eric Melski * tests/pkg/magicchar2.tcl: * tests/autoMkindex.test: Test for auto loader fix (bug #2480). * library/init.tcl: auto_load was using [info commands $name] to determine if a given command was available; if the command name had * or [] it, this would fail because info commands uses glob-style matching. This is fixed. (Bug #2480). * tests/pkg/spacename.tcl: * tests/pkgMkIndex.test: Tests for fix for bug #2360. * library/package.tcl: Fixed to extract only the first element of the list returned by auto_qualify (bug #2360). * tests/pkg/magicchar.tcl: * tests/autoMkindex.test: Test for fix for bug #2611. * library/auto.tcl: Fixed the regular expression that performs $ escaping before sourcing a file to index. It was erroneously adding \ escapes even to $'s that were already escaped, effectively "unescaping" those $'s. (bug #2611). 2000-01-27 Eric Melski * tests/autoMkindex.test: * library/auto.tcl: Applied patch (with slight modification) from bug #2701: auto_mkIndex uses platform dependent file paths. Added test for fix. 2000-01-27 Jennifer Hom * library/tcltest1.0/tcltest.tcl: Changed NormalizePath to normalizePath and exported it as a public proc. This proc creates an absolute path given the name of the variable containing the path to modify. The path is modified in place. * library/tcltest1.0/pkgIndex.tcl: Added normalizePath. * tests/all.tcl: Changed code to use normalizePath. 2000-01-27 Eric Melski * tests/pkg/samename.tcl: test file for bug #1983 * tests/pkgMkIndex.test: * doc/pkgMkIndex.n: * library/package.tcl: Per rfe #4097, optimized creation of direct load packages to bypass computing the list of commands added by the new package. Also made direct loading the default, and added a -lazy option. Fixed bug #1983, dealing with pkg_mkIndex incorrectly handling situations with two procs by the same name but in different namespaces (ie, foo::baz and bar::baz). 2000-01-26 Eric Melski * generic/tclNamesp.c: Undid fix for #956, which broke backwards compatibility. * doc/variable.n: * doc/trace.n: * doc/namespace.n: * doc/info.n: Added further information about differences between "namespace which" and "info exists". * doc/SetErrno.3: Added descriptions of ErrnoId() and ErrnoMsg() functions. 2000-01-25 Jeff Hobbs * unix/tcl.m4: modified EXTRA_CFLAGS to add -DHAVE_TZSET for OSF1-V* and ULTRIX-4.* when not using gcc. Also added higher min stack size for OSF1-V* when building with threads. [Bug: 4063] * generic/tclClock.c (FormatClock): inlined resultPtr, as it conflicted with var creation for HAVE_TZSET #def [Bug: 4063] * generic/tclCmdIL.c (Tcl_LsortObjCmd): fixed potential leak when calling lsort -command with bad command [Bug: 4067] * generic/tclFileName.c (Tcl_JoinPath): added support for special QNX node id prefixes in pathnames [Bug: 4053] * doc/ListObj.3: clarified Tcl_ListObjGetElements docs [Bug: 4080] * doc/glob.n: clarified Mac path separator determination docs. * win/makefile.vc: added some support for building helpfile on Windows 2000-01-23 Jeff Hobbs * library/init.tcl (auto_execok): added 'start' to list of recognized built-in commands for COMSPEC on NT. [Bug: 2858] * unix/tclUnixPort.h: moved include of lower since some systems (UTS) require sys/types.h to be included first [Bug: 4031] * unix/tclUnixChan.c (CreateSocketAddress): changed comparison with -1 to 0xFFFFFFFF, to ensure 32 bit comparison even on 64 bit systems. [Bug: 3878] * generic/tclFileName.c: improved guessing of path separator for the Mac. (Darley) * generic/tclInt.h: * generic/tcl.decls: moved Tcl_ProcObjCmd to stubs table [Bug: 3827] and removed 'register' from stub definition of Tcl_AppendUnicodeToObj [Bug: 4038] 2000-01-21 Eric Melski * unix/mkLinks: * doc/GetHostName.3: Man page for Tcl_GetHostName (bug #1817). * doc/lreplace.n: Corrected man page with respect to treatment of empty lists, and "prettied up" the page. (bug #1705). 2000-01-20 Eric Melski * tests/namespace.test: Added test for undefined variables with namespace which (bug #956). * generic/tclNamesp.c: Added check for undefined variables in NamespaceWhichCmd (bug #956). * tests/var.test: Added tests for corrected variable behavior (bug #981). * doc/upvar.n: Expanded explanation of upvar behavior with respect to variable traces. (bugs 3917 1433 2110). * generic/tclVar.c: Changed behavior of variable command when name refers to an element in an array (ie, "variable foo(x)") to always return an error, regardless of existence of that element in the array (now behavior is consistant with docs too) (bug #981). 2000-01-20 Jeff Hobbs * generic/tclCmdIL.c (InfoBodyCmd): made [info body] return a string if the body has been bytecompiled. * generic/tclBasic.c (Tcl_EvalObjEx): added pedantic check for originating proc body of bytecompiled code, #def'd out as the change for [info body] should make it unnecessary * unix/tclUnixNotfy.c (Tcl_InitNotifier): added cast for tsdPtr * tests/set.test: added test for complex array elem name compiling * generic/tclCompCmds.c (TclCompileSetCmd): Fixed parsing of array elements during compiling, and slightly optimised same [Bug: 3889] * doc/tclvars.n: added definitions for tcl_(non)wordchars * doc/vwait.n: added notes about requirement for vwait var being globally scoped [Bug: 3329] * library/word.tcl: changed tcl_(non)wordchars settings to use new unicode regexp char class escapes instead of char sequences 2000-01-14 Eric Melski * tests/var.test: Added a test for the array multiple delete protection in Tcl_UnsetVar2. * generic/tclVar.c: Added protection in Tcl_UnsetVar2 against attempts to multiply delete arrays when unsetting them (bug #3453). This could happen if there was an unset trace on an array element and the trace proc made a global or upvar link to the array, and then the array was unset at the global level. See the bug reference for more information. * unix/tclUnixTime.c: New clock format format. * compat/strftime.c: New clock format format. * generic/tclGetDate.y: New clock scan format. 2000-01-13 Jeff Hobbs * changes: updated changes file to reflect 8.3b2 mods * README: * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.m4: * win/README.binary: * win/configure.in: updated to patchlevel 8.3b2 * generic/regexec.c: added var initialization to prevent compiler warning 2000-01-13 Eric Melski * tests/cmdIL.test: Added tests for lsort -dictionary with characters that occur between Z and a in ASCII. * generic/tclCmdIL.c: Modified DictionaryCompare function (used by lsort -dictionary) to do upper/lower case equivalency before doing character comparisons, instead of after. This fixes bug #1357, in which lsort -dictionary [list ` AA c CC] and lsort -dictionary [list AA c ` CC] gave different (and both wrong) results. 2000-01-12 Eric Melski * tests/clock.test: Added tests for "next " and "" Added tests for "monday 1 week ago", etc, from RFE #3671. * doc/tests/clock.test: Added numerous tests for clock scan. * doc/generic/tclGetDate.y: Fixed some shift/reduce conflicts in clock grammar. * doc/doc/clock.n: Added documentation for new supported clock scan formats and additional explanation of daylight savings time correction algorithm. 2000-01-12 Jeff Hobbs * doc/file.n: * tests/unixFCmd.test: * unix/tclUnixFCmd.c: added support for symbolic permissions setting in SetPermissionsAttribute (file attr $file -perm ...) [Bug: 3970] * generic/tclClock.c: fixed support for 64bit handling of clock values [Bug: 1806] * generic/tclThreadTest.c: upped a buffer size to hold double * tests/info.test: * generic/tclCmdIL.c: fixed 'info procs ::namesp::*' behavior (Dejong) * generic/tclNamesp.c: made imported commands also import their compile proc [Bug: 2100] * tests/expr.test: * unix/Makefile.in: * unix/configure.in: * unix/tcl.m4: recognize strtod bug on Tru64 v5.0 [Bug: 3378] and added tests to prevent unnecessary chmod +x in sources while installing, as well as more intelligent setsockopt/gethostbyname checks [Bug: 3366, 3389] * unix/tclUnixThrd.c: added compile time support (through use of the TCL_THREAD_STACK_MIN define) for increasing the default stack size for a thread. [Bug: 3797, 1966] 2000-01-11 Eric Melski * generic/tclGetDate.y: Added comments for the Convert function. Added a fix for daylight savings time handling for relative time spans of days, weeks or fortnights. (bug 3441, 3868). * generic/tclDate.c: Fixed compiler warning issues. 2000-01-10 Jeff Hobbs * compat/waitpid.c: use pid_t type instead of int [Bug: 3999] * tests/utf.test: fixed test that allowed \8 as octal value * generic/tclUtf.c: changed Tcl_UtfBackslash to not allow non-octal digits (8,9) in \ooo substs. [Bug: 3975] * generic/tcl.h: noted need to change win/tcl.m4 and tools/tclSplash.bmp for minor version changes * library/http2.1/http.tcl: trim value for $state(meta) key * unix/tclUnixFile.c: fixed signature style on functions * unix/Makefile.in: made sure tcl.m4 would be installed with dist * unix/tcl.m4: added ELF support for NetBSD [Bug: 3959] 2000-01-10 Eric Melski * generic/tclGetDate.y: Added rules for ISO 8601 formats (BUG #847): CCYY-MM-DD CCYYMMDD YY-MM-DD YYMMDD CCYYMMDDTHHMMSS CCYYMMDD HHMMSS CCYYMMDDTHH:MM:SS Fixed "clock scan " to scan the number as an hour for the current day, rather than a minute after 00:00 for the current day (bug #2732). 2000-01-07 Eric Melski * generic/tclClock.c: Changed switch in Tcl_ClockObjCmd to use enumerated values instead of constants. (ie, COMMAND_SCAN instead of 3). tcl8.6.14/ChangeLog.20010000644000175000017500000041562614554262142014013 0ustar sergeisergei2001-12-28 Jeff Hobbs * library/init.tcl: make sure env(COMSPEC) on Windows is executed with the right case, as it may otherwise fail inexplicably. 2001-12-28 Don Porter * generic/tclCkalloc.c (MemoryCmd, TclFinalizeMemorySubsystem): Added the [memory onexit] command, intended to replace [checkmem]. * doc/DumpActiveMemory.3: * doc/memory.n: Updated documentation for [memory] and related matters. [Bug 487677] * mac/tclMacBOAMain.c (Tcl_Main, CheckmemCmd): Removed all the machinery for the [checkmem] command that is completely duplicated by code in generic/tclCkalloc.c. * generic/tclBinary.c: * generic/tclListObj.c: * generic/tclObj.c: * generic/tclStringObj.c: Removed references to [checkmem] in comments, referencing [memory active] instead, since it is documented. 2001-12-28 Daniel Steffen * mac/tclMacInit.c: * mac/tclMacTclCode.r: synced up tclInit features to unix/win: implemented TclSetPreInitScript support, use of existing tclInit proc if defined, check of default encoding dir if set. Changed script library resource names to lowercase (i.e. same as corresponding files). Used Tcl_JoinPath instead of string append. Check that system encoding could be loaded before utf translating the LibraryPath. * mac/tclMacApplication.r: * mac/tclMacLibrary.r: * mac/tclMacOSA.r: * mac/tclMacResource.r: minor version resources cleanup 2001-12-21 Mo DeJong * unix/tcl.m4 (SC_PATH_TCLCONFIG, SC_PATH_TKCONFIG): Search for config file using exec_prefix instead of prefix when no --with-tcl or --with-tk argument is used. [Bug 492418] 2001-12-21 Daniel Steffen * unix/tcl.m4: fixed incorrect SHLIB_LD_LIBS setting for MacOSX / Darwin. * unix/configure: Regen. * unix/mkLinks.tcl: improved case-insensitive filesystem support. * unix/mkLinks: Regen. 2001-12-19 Don Porter * unix/Makefile.in (dist): corrected use of eolFix.tcl on working files. It should operate on distributed files. [Bug 495120] 2001-12-19 David Gravereaux * tools/tcl.wse.in: Fix for [Bug 495120]. tcl.wse.in was stored in cvs with improper . This resulted in corrupted when checked-out on translating CVS clients such as windows (CRCRLF) and mac (CRCR). 2001-12-19 Mo DeJong * unix/configure: * unix/tcl.m4 (SC_CONFIG_CFLAGS): Update SunOS 5.[0-6] target so that correct linker options are passed to gcc or ld. [Tk Bug 220863] 2001-12-19 Mo DeJong * unix/README: Update to account for changes in the unix/dltest directory, the way autoconf is run, and the new "make shell" target. 2001-12-19 Mo DeJong * unix/Makefile.in: Rename dltest to dlpkgs to fix problem where lib files were not getting built because dltest/ directory already existed. 2001-12-19 Jeff Hobbs * win/tclWinSerial.c (SerialCheckProc): corrected time calculations to be unsigned. (schroedter) 2001-12-18 Mo DeJong * unix/Makefile.in: Define new dltest target that simply does a cd to dltest/ before running make. There is no need for the separate configure script that was previously being used. * unix/configure: Regen. * unix/configure.in: Subst into dltest/Makefile. * unix/dltest/Makefile.in: Define LIBS using DL_LIBS, LIBS, and MATH_LIBS variables instead of TCL_LIBS variable from tclConfig.sh. * unix/dltest/README: Update readme to account for new configure free implementation. * unix/dltest/configure: Removed. * unix/dltest/configure.in: Removed. 2001-12-18 Donal K. Fellows * generic/tcl.h (TCL_STUB_MAGIC): Added cast to force type to be an int and get rid of a persistent and pointless warning with SunPro compiler. * generic/tclCkalloc.c (Tcl_AttemptDbCkalloc,Tcl_AttemptDbCkrealloc): * generic/tcl.decls (Tcl_AttemptDbCkalloc,Tcl_AttemptDbCkrealloc): Made the file parameters to these functions into CONST char *, like they always should have been to match the other Tcl*Db* API functions. 2001-12-17 Andreas Kupries * Applied [Bug 219311] on behalf of Rolf Schroedter to prevent fcopy on serial ports from flooding the event queue. 2001-12-11 Miguel Sofer * doc/CrtInterp.3: * generic/tclBasic.c: docs and comments corrections. [Bug 493412] Bug & patch by Don Porter. 2001-12-14 Donal K. Fellows * win/tclWinNotify.c (Tcl_FinalizeNotifier): Stop Tcl on Windows from crashing when shutdown from a non-Tcl thread. Fixes [Bug 217982] [orig. 5804] reported by Hugh Vu and Gene Leache. I'm not convinced that the shutdown process is right even with this, but it was definitely wrong without... 2001-12-13 Andreas Kupries * win/tclWinSock.c (TcpGetOptionProc): Fix for [Bug 478565] reported by an unknown person. Bypasses all calls to "gethostbyaddr" for address "0.0.0.0" to prevent delays on Win/NT. 2001-12-12 Jeff Hobbs * doc/Preserve.3: doc'd TCL_DYNAMIC use. [Patch 483989] (porter) 2001-12-12 Andreas Kupries * generic/tclIO.c (Tcl_GetsObj): Applied patch for [Bug 491341] as provided by Don Porter . Fixes the assumption of having an empty Tcl_Obj to work with. 2001-12-11 Miguel Sofer * generic/tclCompCmds.c: * generic/tclCompile.c: * generic/tclExecute.c: consistency patch, to make all instructions that pop a variable number of Tcl_Obj's off the execution stack take the number of popped objects as first operand. Modified *only* the new instructions INST_LIST_INDEX_MULTI and INST_LSET_FLAT, so this has no effect on bytecodes generated up to tcl8.4a3 inclusive. * generic/tclExecute.c: fix debug messages in INST_LSET_LIST. * generic/tclCompCmds.c (TclCompileLindexCmd): * generic/tclCompExpr.c (CompileMathFuncCall): removed the last two overestimates of the necessary stack depth for bytecodes in the fix of [Bug 483611] 2001-12-10 Andreas Kupries * unix/tclUnixPipe.c (TclpCreateProcess): Applied Don Porter's patch fixing [Bug 437489]. 2001-12-10 Miguel Sofer * generic/tclEvent.c: * tests/event.test: fix background error reporting in the absence of a bgerror proc [Bug 219142]. 2001-12-10 Don Porter * doc/Access.3: * doc/CrtChannel.3: * doc/DString.3: * doc/ExprLong.3: * doc/FileSystem.3: * doc/GetStdChan.3: * doc/OpenFileChnl.3: * doc/StdChannels.3: * doc/TCL_MEM_DEBUG.3: * doc/Tcl_Main.3: * doc/Utf.3: * doc/file.n: * doc/tclsh.1: Several typo and formatting corrections discovered during conversion to TMML. Thanks to Joe English. [Patch 490514] * unix/mkLinks: 'make mklinks' 2001-12-10 Miguel Sofer * generic/tclCompCmds.c: * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclProc.c: fixed the calculation of the maximal stack depth required by bytecodes. [Bug 483611] 2001-12-07 Miguel Sofer * generic/tclVar.c: * tests/trace.test: restored consistency in refCount accounting by array traces [Bug 4484339], submitted by Don Porter. 2001-12-06 Donal K. Fellows * tests/parseExpr.test, tests/for.test, tests/expr.test: * tests/expr-old.test, tests/compile.test, tests/compExpr.test * tests/compExpr-old.test: Kept up to date with syntax errors. * generic/tclParseExpr.c (ParsePrimaryExpr): Rewrote to give even better syntax errors in the fairly common case of an identifier without decorations by guessing based on the currently available functions. Also made messages consistent between memdebug and ordinary builds. 2001-12-05 Miguel Sofer * generic/tclVar.c: * tests/trace.test: new algorithm for [array get], safe when there are traces that modify the array. [Bug 449893] 2001-12-04 Donal K. Fellows * tests/compExpr-old.test, tests/compExpr.test, tests/compile.test: * tests/expr-old.test, tests/expr.test, tests/for.test: * tests/while.test, tests/if.test: Rewrite to handle more specific syntax errors. * tests/parseExpr.test: Rewrite to get rid of dup test numbers and handle more specific syntax errors. * generic/tclParseExpr.c (LogSyntaxError): Added a detail message argument to help explain what the syntax error is. (Tcl_ParseExpr, ParseCondExpr, ParsePrimaryExpr): Added detail messages. (UNKNOWN_CHAR): New lexeme for characters that are always illegal in expressions outside strings. 2001-12-03 Donal K. Fellows * doc/expr.n: Various documentation improvements in relation to the function calls. Includes fix for [Bug 487704] submitted by Devin Eyre. 2001-12-03 David Gravereaux * win/makefile.vc: Some install target bugs repaired along with $(TCLSTUBLIB) added to the dependencies rather than implicit through the dde and reg extensions which don't happen to always require it for some build types. 2001-11-30 Miguel Sofer * generic/tclVar.c: Tcl_Preserve'ing VarTrace structures to avoid memory corruption. Patch for [Bug 484334] provided by Don Porter 2001-11-29 Miguel Sofer * tests/namespace.test: modified namespace-41.2, added 41.3 {knownbug} after discussion with Don Porter and Kevin Kenny. 2001-11-29 Miguel Sofer * tests/namespace.test: added namespace-41.2, a simpler test for [Bug 231259] 2001-11-29 Donal K. Fellows * generic/tclBinary.c (BINARY_SCAN_MAX_CACHE, Tcl_BinaryObjCmd, (ScanNumber): Added caching scheme to reduce number of object allocations when doing scans of large repetitive binary strings. See comments in file for reasoning behind implementation. Suggested by Miguel Sofer in [Patch 429916], but independently implemented. 2001-11-28 Donal K. Fellows * doc/regsub.n, doc/regexp.n: Converted dangling references to METASYNTAX section into references to the re_syntax manual page. 2001-11-27 D. Richard Hipp * win/tclWinFCmd.c: Fix a coredump in the filename normalizer code for Win95/98. 2001-11-27 David Gravereaux * win/makefile.vc: Removed the Tk reference for the 'winhelp' target. Converge at install will need to be the solution for Tk and all other extensions. 2001-11-27 Donal K. Fellows * tests/cmdAH.test (cmdAH-24.2): Made test less sensitive to OS preemption, but perfection isn't practical. [Bug 463189, reported by Don Porter] * tests/switch.test (switch-9.*): Added tests to exercise more of the argument checking. (switch-7.2,switch-7.3): Test changed behaviour slightly. * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reworked argument parsing to be stricter about what it accepts. This should make uses of the [switch] command be more maintainable. [Bug 475397, reported by Don Porter] 2001-11-26 Don Porter * generic/tclIntPlatDecls.h: 'make genstubs' after changes in 2001-11-23 commit from Daniel Steffen. 2001-11-24 Mo DeJong * unix/Makefile.in: Add comments to better describe TCL_EXE and when it should be available. * win/Makefile.in: Add TCL_EXE variable to be used by rules like `make genstubs`. Don't set TCL_LIBRARY before running `make genstubs` since we will be running with a tclsh from the PATH not the one we build. 2001-11-24 Mo DeJong * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): Add comctl32.lib to wish link libs. This change was originally added to Tk on 2001-11-09 but was not committed to Tcl. 2001-11-23 Daniel Steffen * unix/Makefile.in: * unix/configure.in: * unix/install-sh: * unix/mkLinks: * unix/mkLinks.tcl: * unix/tclLoadDyld.c: * unix/tclMtherr.c: Mac OSX support: build system, dynamic code loading and support for case-insensitive filesystems in mkLinks. [Patch 435258] 2001-11-23 Daniel Steffen Up-port to 8.4 of mac code changes for 8.3.3 & various new changes for 8.4, some already backported to 8.3.4. [Patch 435658] * generic/tclObj.c: added #include to fix missing prototype errors * generic/tcl.h: MAC_TCL: addition of ConditionalMacros.h and use of DLLIMPORT and DLLEXPORT like on other platforms. ( => no longer need the .exp files and can remove use of #pragma export that never worked well) removed line continuation in #if clause as this breaks the mac resource compiler (note that *.r files include tcl.h) * mac/tclMacFile.c: fixed bug in permission checking code * mac/tclMacLoad.c: corrected utf-8 handling, comparison of package names to code fragment names changed to only match on the length of package name, this allows for fragment names with version numbers appended. * mac/tclMacInt.h: * generic/tclInt.h: * mac/tclMacTime.c: * generic/tclIOUtil.c: moved declaration of TclpGetGMTOffset() * mac/tclMacShLib.exp: * mac/tclMacOSA.exp: * mac/tclMacMSLPrefix.h: removed files * unix/Makefile.in: removed reference to .exp files * mac/MW_TclBuildLibHeader.h: * mac/MW_TclBuildLibHeader.pch: * mac/MW_TclHeaderCommon.h: * mac/MW_TclStaticHeader.h: * mac/MW_TclStaticHeader.pch: new precompiled header files * mac/MW_TclAppleScriptHeader.pch: * mac/MW_TclHeader.pch: * mac/MW_TclTestHeader.pch: * mac/tclMacCommonPch.h: revised precompiled header handling: now include a common header file 'MW_TclHeaderCommon.h' from all .pch files, the .pch files themselves now only setup #defines (e.g. BUILD_tcl, STATIC_BUILD, TCL_DEBUG, TCL_THREADS) like in makefiles on other platforms. * mac/tclMac.h: * mac/tclMacPort.h: * mac/tclMacInt.h: use of BUILD_tcl and TCL_STORAGE_CLASS like on other platforms, standardize #include'd files to what's done on other platforms, removed use of #pragma export. * mac/tcltkMacBuildSupport.sea.hqx: new archive of mac build support files & suggested build environment directory hierarchy: 'Building MacTclTk' & 'CW Pro6 changes' readme's. projects for MoreFiles 1.5.2 static & shared libraries. project & sources for 'pseudoCarbonSupport', see below. included XML versions of the projects for CW Pro5 or Pro7 users. * mac/tclMacProjects.sea.hqx: updated mac build project files: build support for CodeWarrior Pro6, UnivIntf 3.4 & shared runtime libraries: the MSL libraries and MoreFiles are no longer compiled into Tcl.shlb, all non-static binaries now use the Pro6 shared runtime libraries and MoreFiles.shlb. These shlbs are merged into the standard Wish and TclShell, but 3rd party applications linking with Tcl.shlb or Tk.shlb need to setup access to them. (see the "(sh-ppc)" targets for how to do this.) included XML versions of the projects for CW Pro5 or Pro7 users. use compat/strtod.c instead of MSL's strtod() use WASTE versions of MSL for tcl test target to avoid text buffer cutoff at 32k. Merging the full MSL.shlb and the other shlbs into Wish & TclShell makes them a bit larger than before, use unmerged binaries to avoid copying the shared code with every application, e.g. when deploying numerous Wish based droplets. Note that using CW Pro5 to compile extensions is in principle still possible, but need to link with Pro6 runtime libraries. Tclapplescript now loads and runs on CFM68k. Highly experimental "pseudoCarbon" support for Tcl only on OS 8/9: binaries in "Build:(Carbon):" link against CarbonLib instead of InterfaceLib, however the actual code has not been carbonized! i.e. it will not run on OSX and may not even run properly with CarbonLib. This should in principle allow you to build & test OS9 CFM Carbon binaries that need to link with Tcl.shlb. On OSX you can use the native Tcl.framework, but you have to build a MachO binary as there is no CFM glue lib for Tcl.framework. the library pseudoCarbonSupport.shlb manually loads the symbols from InterfaceLib that are not in CarbonLib but are needed by the uncarbonized code in Tcl.shlb and TclShell. * generic/tclMain.c: MAC_TCL: workaround for broken/non-standard isatty on MW Pro6, #include instead of defining isatty * mac/tclMacPort.h: MW Pro6 changes for MSL fcntl.h, stat.h & isatty * mac/tclMacAppInit.c: add EXTERN to InstallConsole to enable DLL export via the TCL_STORAGE_CLASS mechanism. * mac/tclMacFCmd.c: fix for FSpDirectoryCopy API change * mac/tclMacLibrary.c: emit compile time error when TCL_REGISTER_LIBRARY and USE_TCL_STUBS are both defined at the same time in an extension, this use is not currently supported and will result in a crash when dynamically loading the extension. * mac/tclMacApplication.r: * mac/tclMacLibrary.r: * mac/tclMacOSA.r: * mac/tclMacResource.r: fixed obsolete copyrights/dates in version strings; updated version strings to standard usage; added support for '(Support Libraries)' subfolder for shared runtime libraries in unmerged binaries; commented out demo setting of "Tcl Environment Variables"; reorganized resources among these files to avoid multiple copies in applications and shared libraries, the script libraries are now no longer duplicated in Tclsh but are only included in the resources of Tcl.shlb. * mac/tclMacChan.c: * mac/tclMacSock.c: cast for *BlockMode * mac/tclMacUtil.c: * mac/tclMacMath.h: removed obsolete hypot() definition * generic/tclIntPlatDecls.h: * generic/tclInt.decls: * generic/tclStubInit.c: * mac/tclMacNotify.c: * mac/tclMacOSA.c: * mac/tclMacUtil.c: * generic/tclThreadTest.c: renamed routines conflicting with standard Apple or MoreFiles headers (at compile or link time): GetGlobalMouse -> GetGlobalMouseTcl FSpGetDirectoryID -> FSpGetDirectoryIDTcl FSpOpenResFileCompat -> FSpOpenResFileCompatTcl FSpCreateResFileCompat -> FSpCreateResFileCompatTcl NewThread -> NewTestThread the renamed MoreFiles *Tcl routines are just wrappers calling into the MoreFiles DLL. * mac/tclMacCommonPch.h: * mac/tclMacThrd.c: * mac/tclMacPanic.c: removed OLDROUTINENAMES define, renamed obsolete apple API names to modern equivalents; UH3.4 support: added #include , updated New*Proc() calls to New*UPP(). * mac/tclMacUnix.c: added missing (Tcl_Obj ***) cast to Tcl_ListObjGetElements call * mac/tclMacAlloc.c: modernized TclpSysAlloc() to use temporary memory instead of system heap memory when available (MacOS >= 7.5 and possibly earlier, use of system heap has been discouraged for a long time and has many disadvantages, e.g. memory isn't paged out, and errors can very easily bring the system down); fixed crashing bug in TclpSysRealloc() and CleanUpExitProc() where memory was being accessed after having been deallocated; fixed memory leak in (de)allocation code (for every block ever allocated with TclpSysAlloc, a Ptr was leaked), if temporary memory is available, don't track allocated memory, instead use RecoverHandle() to get Handle from Ptr, otherwise use doubly linked list to correctly track memory and free all allocated memory; added new option for ConfigureMemory: MEMORY_DONT_USE_TEMPMEM, disables use of temporary memory even when it would be available, only necessary when writing e.g. a driver (using tcl??); increased fraction of application heap reserved for OS routines to 512K * compat/strftime.c: * mac/tclMacTime.c: * mac/tclMacPort.h: * generic/tclInt.decls: * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: timezone support for mac via TclpGetTZName() like on windows, using an inverse timezone table adapted from tclDate.c to map gmtoffset in seconds gotten from the MacOS APIs to a timezone string, as there is no good way to get this info from MacOS. I had to make up some unusual timezones and arbitrarily decide on the most standard of the multiple choices available for every timezone. * generic/tclExecute.c: workaround for a MSL bug/misfeature: for very small floats, MSL can return errno ERANGE but a non-zero value (< LDBL_MIN however) * mac/tclMacAppInit.c: support for WASTE text library using temporary memory, setting has no effect if WASTE is not used. * mac/tclMacPanic.c: removed duplicate code from generic/tclPanic.c and added that file to projects instead. * tests/all.tcl: set tcltest::singleProcess 1 as multiple processes are not available on the mac. * tests/cmdAH.test: access time not available on the mac, skip the atime touch test * tests/appendComp.test: * tests/cmdMZ.test: * tests/compile.test: * tests/exec.test: * tests/fileName.test: * tests/lset.test: * tests/namespace.test: * tests/tcltest.test: added missing cleanups/tests/catches that caused tests to fail on the mac. * doc/tclvars.n: doc bug, env(PWD) should be env(HOME) [Bug 463834] 2001-11-21 Don Porter * tests/trace.test (trace-8.8): Corrected test for Bug 219393. * generic/tclBasic.c (Tcl_DeleteCommandFromToken,CallCommandTraces): * generic/tclCmdMZ>c (Tcl_UntraceCommand): Added Tcl_Preserve and Tcl_Release calls to prevent deletion of CommandTrace structures until all callers are done using them, preventing memory corruption. [Bug 453805] 2001-11-20 Kevin B. Kenny * doc/GetTime.3 (Tcl_GetTime): * generic/tcl.decls (Tcl_GetTime): * generic/tclClock.c (Tcl_ClockObjCmd): * generic/tclCompile.c (TclCleanupByteCode, TclInitByteCodeObj): * generic/tclCmdMZ.c (Tcl_TimeObjCmd): * generic/tclUtil.c (TclpGetTime): * generic/tclTest.c (GetTimesCmd): * generic/tclTimer.c (Tcl_CreateTimerHandler, TimerSetupProc, (TimerCheckProc, TimerHandlerEventProc): * mac/tclMacNotify.c (Tcl_SetTimer): * mac/tclMacShLib.exp (Tcl_GetTime): * mac/tclMacTime.c (Tcl_GetTime): * unix/tclUnixChan.c (TclUnixWaitForFile): * unix/tclUnixEvent.c (Tcl_Sleep): * unix/tclUnixThrd.c (Tcl_ConditionWait): * unix/tclUnixTime.c (Tcl_GetTime): * win/tclWinNotify.c (Tcl_Sleep): * win/tclWinTest.c (TestwinclockCmd): * win/tclWinTime.c (TclpGetSeconds, TclpGetClicks, Tcl_GetTime): Changed all uses of TclpGetTime to Tcl_GetTime. Added Tcl_GetTime to the Stubs table and the library documentation. Added a TclpGetTime in tclUtil.c for backward compatibility of extensions. [Patch 483500, TIP#73] * generic/tclCmdMZ.c (Tcl_TimeObjCmd): Corrected an error in the [time] command that caused incorrect results to be returned if the total duration of all iterations exceeded 2**31 microseconds. [Bug 478847] * generic/tclInt.decls: * generic/tclInt.h: * generic/tclStubInit.h: Reran 'make genstubs' 2001-11-20 Miguel Sofer * generic/tclBasic.c * generic/tclCompile.h: * generic/tclExecute.c: moving all code relative to bytecodes from tclBasic.c to tclExecute.c - the functions RecordTracebackInfo and Tcl_ExprObj went to tclExecute.c, and new interface function was defined (TclCompEvalObj). The final objective of this sequence of moves is to provide a clean, clear-cut interface between Tcl's core and the compiler/engine subsystem. 2001-11-20 Miguel Sofer * generic/tclBasic.c * generic/tclCompile.h: * generic/tclExecute.c: factoring out of common code in tclBasic.c (new function TclInterpReady defined: it resets the interp's result, then checks that it hasn't been deleted and that the nesting level is acceptable). Passed the responsibility of calling it to the *callers* of TclEvalObjvInternal. 2001-11-20 Miguel Sofer * generic/tclBasic.c * generic/tclExecute.c: a better variant of the previous-to-last commit (restoring numLevels computations). The managing of the levels now has to be done by the *callers* of TclEvalObjvInternal 2001-11-20 Miguel Sofer * generic/tclExecute.c: missing variable declaration under TCL_COMPILE_DEBUG. 2001-11-20 Miguel Sofer * generic/tclExecute.c: * generic/tclProc.c: restoring the computations of iPtr->numLevels to the original logic (previous to buggy modifs on 2001-11-16). 2001-11-20 Jeff Hobbs * tools/eolFix.tcl (new-file): * unix/Makefile.in: added EOL correction for Windows bat files to dist target. [Bug 219409] (davygrvy) * unix/tclUnixInit.c (TclpSetInitialEncodings): update of patch from 2001-11-16 that uses the old Tcl encoding check mechanism as a fallback to the original. Also added a TCL_DEFAULT_ENCODING #define (defaults to iso8859-1). Tcl will first try setlocale and nl_langinfo, and if that fails, guess based on certain LANG|LC_* env vars. [Patch 418645] 2001-11-19 David Gravereaux * win/buildall.vc.bat: Added useful comments. 2001-11-19 Miguel Sofer * tests/compile.test: added a test for bug [Bug 483309] 2001-11-19 Vince Darley * win/tclWinFile.c: * win/tclWinFCmd.c: * win/tclWin32Dll.c: * doc/file.n: * tests/winFCmd.test: improved speed of file normalization for Win95/98, and clarified docs on differences in file normalization between NT/2000 and the older operating systems. Added test to ensure normalization is correct. 2001-11-19 Miguel Sofer * generic/tclBasic.c: * generic/tclParse.c: Code reorganisation. Moved all evaluation functions from tclParse.c to tclBasic.c, so that now tclParse.c deals exclusively with parsing and all evaluations are done by code in tclBasic.c. The functions moved are: TclEvalObjvInternal, Tcl_EvalObjv, Tcl_LogCommandInfo, Tcl_EvalTokensStandard, Tcl_EvalTokens, Tcl_EvalEx, Tcl_Eval, Tcl_EvalObj and Tcl_GlobalEvalObj. 2001-11-19 Donal K. Fellows * tests/trace.test (trace-8.8): Added adapted version of [Bug 219393] as new test; the test won't reliably show up the old problem unless it is being run under something like Purify, but something is better than nothing... * generic/tclVar.c (Tcl_TraceVar2, Tcl_UntraceVar2): Added missing mask bits for trace result type and a check for a nonsense flag combination. * generic/tclCmdMZ.c (TraceVarProc): Added missing test for NULL when deleting a trace that doesn't cause an error. * doc/TraceVar.3: Added documentation for change due to TIP#68. * generic/tclCmdMZ.c (TraceVarInfo): Removed problematic errMsg field from structure. (TraceVarProc): Removed references to errMsg field and changed handling of errors so that they returned a Tcl_Obj* containing the error string. This minimizes the number of calls to the memory management subsystem. (TclTraceCommandObjCmd, TraceCommandProc): Removed references to errMsg field which was never used in command traces in any case. (Tcl_TraceObjCmd, TclTraceVariableObjCmd): Removed references to errMsg field and made variable traces register with TCL_TRACE_RESULT_OBJECT bit set. * generic/tcl.h (TCL_TRACE_RESULT_DYNAMIC,TCL_TRACE_RESULT_OBJECT): New constants to define how to handle the strings returned from trace callbacks [TIP#68] * generic/tclVar.c (CallTraces, Tcl_GetVar2Ex, TclGetIndexedScalar, (TclGetElementOfIndexedArray, Tcl_SetVar2Ex, TclSetIndexedScalar, (TclSetElementOfIndexedArray, Tcl_UnsetVar2, Tcl_ArrayObjCmd, (TclDeleteVars, TclDeleteCompiledLocalVars, DeleteArray, (TclVarTraceExists): Support for those new trace flags. 2001-11-19 Miguel Sofer * generic/tclCompCmds.c: patch for [Bug 483309] (petasis). 2001-11-16 Kevin B. Kenny * generic/tclListObj.c: removed a C++-style comment that was inadvertently left in the source code. 2001-11-16 Jeff Hobbs * tests/interp.test: * generic/tclInterp.c (SlaveObjCmd): Corrected argument checking for '$interp alias|aliases|issafe'. [Patch 479560] (thoyts, hobbs) * unix/tclUnixInit.c: added HAVE_LANGINFO code block. * unix/configure: regened * unix/configure.in: added SC_ENABLE_LANGINFO call * unix/tcl.m4: made SHLIB_LD_LIBS='${LIBS}' for FreeBSD* (meyer) Added modified version of Wagner patch to make use of nl_langinfo where possible to determine Unix platform encoding, instead of the inflexible built-in system. This is used by default when possible, and can be disabled with --enable-langinfo=no. [Patch 418645] (hobbs, wagner) 2001-11-16 Miguel Sofer * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclObj.c: moved Tcl_GetCommandFromObj and all defining code for tclCmdNameType objects to tclObj.c (from tclExecute.c). This code has nothing to do with bytecodes. 2001-11-16 Miguel Sofer * generic/tclBasic.c: * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclParse.c: * generic/tclProc.c: * tests/stack.test: consolidation of duplicated code (in TclExecuteByteCode and EvalObjv); renaming of EvalObjv to TclEvalObjv as it is not static anymore; restored consistency of level counts between compiled and directly evaled code. [Bug 480896] 2001-11-12 David Gravereaux * win/makefile.vc: * win/rules.vc: Small bug fixes. * win/README: added some docs pointing to the docs in makefile.vc for it's use. 2001-10-17 Kevin B. Kenny * doc/lappend.n: * doc/lindex.n: * doc/linsert.n: * doc/list.n: * doc/llength.n: * doc/lrange.n: * doc/lsearch.n: * doc/lset.n (new-file): * doc/lsort.n: * generic/tclBasic.c (builtInCmds, Tcl_EvalObjEx): * generic/tclCmdIL.c (Tcl_LindexObjCmd, Tcl_LindexList): (Tcl_LindexFlat, Tcl_LsetObjCmd): * generic/tclCompCmds.c (Tcl_CompileLindexCmd, Tcl_CompileLsetCmd): * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclExecute.c (TclExecuteByteCode): * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclListObj.c (TclLsetList, TclLsetFlat, TclSetListElement): * generic/tclObj.c (TclInitObjSubsystem): * generic/tclStubInit.c: * generic/tclTestObj.c (TestobjCmd): * generic/tclUtil.c (TclGetIntForIndex, SetEndOffsetFromAny): * generic/tclVar.c (Tcl_LappendObjCmd): * tests/lindex.test: * tests/lset.test (new-file): * tests/lsetComp.test (new-file): * tests/obj.test: * tests/string.test: * tests/stringComp.test: Reference implementation of TIP's #22, #33 and #45. Adds the ability of the [lindex] command to have multiple index arguments, and adds the [lset] command. Both commands are byte-code compiled. [Patch 471874] (work by Kenny, commited by Hobbs) 2001-11-12 David Gravereaux * win/buildall.vc.bat(new): * win/makefile.vc: Small fix with deriving the "OriginalFilename" string in the .rc scripts. Added a quick batchfile for building the entire thing. 2001-11-12 Jeff Hobbs * doc/FileSystem.3: * doc/file.n: * doc/tcltest.n: converted use of \' to more reasonable format. 2001-11-10 Mo DeJong * unix/Makefile.in: * win/Makefile.in: Add "make gdb" target. This target can run tclsh inside either gdb or insight. 2001-11-10 David Gravereaux * win/makefile.vc: Added a check to make sure one runs the makefile from the /win directory only. * win/mkd.bat: * win/rmd.bat: Changes from Llyod Lim for better stability. [Patch 456759] 2001-11-09 David Gravereaux * win/makefile.vc: * win/tcl.dsp: winhelp target fixes for non-NT systems. It seems NMAKE under these remembers changed directories during commands. A new tcltest feature from Peter Spjuth to specify a pattern file from the commandline and redirecting output to a file when not under NT with it's scrollback console. Then it replays it, piped through more. Added 2 new static "configurations" to tcl.dsp. I could keep adding more, but I think we should leave it up to the user for customizing it. Sticky-points left: 'profile' option. 2001-11-09 Jeff Hobbs * doc/FileSystem.3: * doc/StdChannels.3: * doc/file.n: * doc/tcltest.n: * tools/man2help.tcl: * tools/man2help2.tcl: fixed winhelp generation problems [Patch 480268] * unix/configure: * unix/tcl.m4: added -lc to AIX libs, fixed path to ldAix 2001-11-09 Don Porter * tests/var.test: * generic/tclVar.c: Corrected bug in [global] when dealing with variable names matching :*. [Bug 480176] 2001-11-08 Mo DeJong Fixup stack size under OSF1. [Patch 474790] * unix/configure: Regen. * unix/tcl.m4: Add HAVE_PTHREAD_ATTR_SETSTACKSIZE define to EXTRA_CFLAGS to adjust initial stack size. 2001-11-08 Mo DeJong Enable thread support under FreeBSD. [Bug 473708] * unix/configure: Regen. * unix/tcl.m4 (SC_ENABLE_THREADS): Check for pthread functions in libc_r and enable thread support if found. * unix/dltest/Makefile.in: Set SHLIB_LD_LIBS and use it in the Makefile to properly link a shared library. 2001-11-08 Mo DeJong * unix/Makefile.in: * unix/dltest/Makefile.in: Avoid adding libc to the LIBS variable since it is not needed when linking with CC. If required when linking with LD it should be done on a case by case basis in tcl.m4. 2001-11-08 David Gravereaux * win/rules.vc: * win/makefile.vc: Fixed install target to adjust for the different build types. Added a 'linkexten' option to link the win extensions inside the shell when built static. Placed win/tclAppInit.c patch in SF patch DB for approval. 'profile' option not hooked in yet. Everything else know is done. * win/tcl.dsp(new): * win/tcl.dsw(new): Simple MsDev stub project files that calls makefile.vc. Will help run Tcl in the debugger easier without confusing MsDev for where the .pdb files are. 2001-11-07 Mo DeJong * unix/Makefile.in: * win/Makefile.in: Print a message indicating that the user should run "make genstubs" when the generated tclStubInit.c file is out of date. We can't regenerate automatically since there may be no tclsh on the system and that would cause bootstrap problems. [Bug 465874] 2001-11-07 Mo DeJong Define TCL_INCLUDE_SPEC in tclConfig.sh. It should be included by extensions that need to find Tcl include headers in the install location. The user can override the include install dir with --includedir so we need to record this information for extensions. [Bug 421835] * unix/configure: Regen. * unix/configure.in: Define TCL_INCLUDE_SPEC. * unix/tclConfig.sh.in: Define TCL_INCLUDE_SPEC. * win/configure: Regen. * win/configure.in: Define TCL_INCLUDE_SPEC. * win/tclConfig.sh.in: Define TCL_INCLUDE_SPEC. 2001-11-07 David Gravereaux * win/rules.vc: * win/makefile.vc: Dropped the NOMSVCRT macro and put it on the option list instead. It makes more sense to me this way as NOMSVCRT=0 would only be the valid setting. Fixed the dde and reg extension for building static. Improved, but not perfected, the winhelp target. 2001-11-07 Mo DeJong * win/README: Change minimum VC++ version to 5.X since 4.X is known not to work. Indicate that Mingw is required and building with Cygwin gcc is not supported. Include instructions that indicate how to install Mingw and what URLs folks should use to download the supported version of Mingw. * win/configure: Regen. * win/configure.in: Error out if user tries to compile the Windows version of Tcl with Cygwin gcc. Users should compile with Mingw gcc instead. 2001-11-06 Andreas Kupries * generic/tclIO.c (ReadChars): Fixed [Bug 478856] reported by Stuart Cassoff . The bug caused loss of fileevents when [read]ing less data from the channel than buffered. Due to an empty input buffer the flag CHANNEL_NEED_MORE_DATA was set but never reset, causing the I/O system to wait for more data instead of using a timer to synthesize fileevents and to flush the pending data out of the buffers. 2001-11-06 David Gravereaux * win/rules.vc (new): * win/makefile.vc: Complete over/under rewrite to support numerous build options all from the commandline itself without needing to edit the makefile. Now requires vcvars32.bat to be run prior to running nmake for bootstraping the environment. Fully doc'd usage for it is in makefile.vc. Commentary welcome. Sticky points left are: 1) winhelp target shows errors in the converting script. 2) .rc scripts aren't getting the right #defines to build the correct "OriginalFilename" strings. (have patch, won't commit yet) 3) Naming convention with suffixes describing the buildtype are 'tsdx' which will need public acceptance. ie. tclsh84tsx.exe is a (t) threaded shell (s) statically linked to the core and (x) uses msvcrt instead of libcmt. 2001-11-04 Vince Darley * library/init.tcl: made filesystem fallback proc ::tcl::CopyDirectory more robust to vagaries of non-native filesystems. 2001-11-02 Vince Darley * doc/file.n: * generic/tclIOUtil.c: updated documentation and comments to clarify behaviour of 'file copy' wrt soft links. 2001-10-29 Vince Darley * win/tclWinFile.c: fix to '-types {f r}' bug in TclpMatchInDirectory (which could cause a UMR, as well as returning wrong results). Also improved API for 'stat' to resolve [Bug 219258]. * win/tclWin32Dll.c * win/tclWinInt.h: addition of improved stat API to internal lookup table. * tests/fileName.test: two new tests for the above bug. * generic/tclIOUtil.c: some cleanup of comments and #ifdefs 2001-10-29 Donal K. Fellows * unix/tclUnixFile.c (TclpMatchInDirectory): Argument to access() was entryPtr->d_name instead of nativeEntry which failed when trying to check access for files in other than the current directory. [Bug 475941, reported by Georgios Petasis] 2001-10-25 Donal K. Fellows * unix/tclUnixChan.c: Added stateUpdated member to struct TtyState. (TtyCloseProc,TtySetOptionProc,TtyInit): Use stateUpdated member of TtyState to decide whether it is necessary to reset a serial port when Tcl closes it. Blindly resetting can cause Tcl to be sent an unexpected SIGTSTP when it is executing in the background [Bug 471374, reported by Chris Nelson] 2001-10-22 Andreas Kupries * doc/ObjectType.3: Minor documentation fix, reported by David N. Welton directly to me. 2001-10-22 Vince Darley * win/tclWinFCmd.c: fix to stop test suite from hanging process under some versions of WinNT. [Bug 466102] (Kevin Kenny) 2001-10-18 Jeff Hobbs * tests/clock.test (clock-8.1): * generic/tclDate.c (RelativeMonth): * generic/tclGetDate.y (RelativeMonth): corrected off-by-one-day error in clock scan with relative months and years during swing hours. [Bug 413397, Patch 414024] (lavana) 2001-10-18 Vince Darley * generic/tclIOUtil.c: fix to bug in Tcl_FSChdir shown up by recent tclkit builds. 2001-10-17 Jeff Hobbs * unix/tclUnixPipe.c (PipeInputProc, PipeOutputProc): do immediate retry when error is returned with errno == EINTR. [Bug 415131] (leger) 2001-10-16 Jeff Hobbs * unix/tclLoadAout.c (TclGuessPackageName): removed unused vars and fixed warnings. [Bug 446622] (lim) 2001-10-15 Miguel Sofer * generic/tclProc.c: changing a memcmp to strncmp to avoid a memory error detected by purify (thanks Jeff); modify style to agrre with the style guide. 2001-10-15 Andreas Kupries * generic/tclInt.decls (TclExpandCodeArray,TclGetInstructionTable): Added to internal stubs table. Tclcompiler (Tclpro project) needs them if used as loadable package under Windows. Changed signatures. We don't want to describe compiler internal structures in "tclInt.h". * generic/tclCompile.h: S.a. Removed function declarations. * generic/tclCompile.c: S.a. Adapted to changed signatures. 2001-10-15 Jeff Hobbs * unix/configure: * unix/configure.in: * win/configure: * win/configure.in: * win/tcl.m4: reworked to be a little cleaner in comparison to each other, and to AC_SUBST even empty vars for win/tclConfig.sh * generic/tclFileName.c: minor code cleanup * generic/tcl.h: moved #define of WIN32 to tcl.h where __WIN32__ is defined and added #ifndef check. * doc/open.n: moved all fconfigure option docs to fconfigure.n * doc/fconfigure.n: added serial config options * win/tclWinChan.c: * win/tclWinPort.h: * win/tclWinSerial.c: added TIP #35 Windows enhancements for serial configuration. [Patch 438509] (schroedter) 2001-10-15 Vince Darley * generic/tclFCmd.c: fix to memory leak in TclFileDeleteCmd on certain error conditions. * doc/FileSystem.3: fix to typo. 2001-10-12 Jeff Hobbs * library/encoding/ebcdic.enc: * tools/encoding/ebcdic.txt: EBCDIC charset mapping. [Patch 219323] (nijtmans) * library/encoding/tis-620.enc: * tools/encoding/tis-620.txt: TIS-620 charset mapping. [Patch 467423] (poonlap) * tests/http.test: added removeFile for outdata * tests/ioCmd.test: added catch around file removal, as Windows file locking throws errors. * tests/socket.test (socket-7.2): corrected to work on Win2K. 2001-10-12 Miguel Sofer * tests/compile.test: new tests for [Bug 467523]; they are only effective if TCL_MEM_DEBUG was set during compilation. 2001-10-11 Miguel Sofer * generic/tclLiteral.c (TclReleaseLiteral): insured that self-referential bytecodes are properly cleaned up on interpreter deletion [Bug 467523] (Ronnie Brunner) 2001-10-10 David Gravereaux * win/tclWinPort.h: #include needed to get moved to after #include or wierd misunderstandings took place when -D_WIN32_WINNT=0x0400 is set for outside code that requires knowledge of Tcl innards. General header macro magic applied liberally... 2001-10-10 Don Porter * tests/unixInit.test: Corrected restore of ::env(LANG). 2001-10-09 Jeff Hobbs * generic/tclFileName.c (Tcl_SplitPath): corrected mem leak intro'd with VFS code where the result obj from Tcl_FSSplitPath was not getting freed. 2001-10-09 Miguel Sofer * generic/tclLiteral.c: (TclReleaseLiteral) reverted previous patch for [Bug 467523] - cure is worse than the illness. 2001-10-05 Miguel Sofer * generic/tclLiteral.c: (TclReleaseLiteral) insured that self-referential bytecodes are properly cleaned up on interpreter deletion. [Bug 467523] (Ronnie Brunner) 2001-10-04 Jeff Hobbs * tools/configure: * tools/configure.in: noted 8.4 as default Tcl version * library/encoding/cp936.enc: * library/encoding/cp949.enc: * library/encoding/cp950.enc: * library/encoding/iso8859-16.enc: * library/encoding/macCroatian.enc: * library/encoding/macCyrillic.enc: * library/encoding/macGreek.enc: * library/encoding/macIceland.enc: * library/encoding/macRoman.enc: * library/encoding/macTurkish.enc: * tools/encoding/cp1250.txt: * tools/encoding/cp1251.txt: * tools/encoding/cp1252.txt: * tools/encoding/cp1253.txt: * tools/encoding/cp1254.txt: * tools/encoding/cp1255.txt: * tools/encoding/cp1256.txt: * tools/encoding/cp1257.txt: * tools/encoding/cp1258.txt: * tools/encoding/cp874.txt: * tools/encoding/cp932.txt: * tools/encoding/cp936.txt: * tools/encoding/cp949.txt: * tools/encoding/cp950.txt: * tools/encoding/iso8859-1.txt: * tools/encoding/iso8859-10.txt: * tools/encoding/iso8859-13.txt: * tools/encoding/iso8859-14.txt: * tools/encoding/iso8859-15.txt: * tools/encoding/iso8859-16.txt: * tools/encoding/iso8859-2.txt: * tools/encoding/iso8859-3.txt: * tools/encoding/iso8859-4.txt: * tools/encoding/iso8859-5.txt: * tools/encoding/iso8859-6.txt: * tools/encoding/iso8859-7.txt: * tools/encoding/iso8859-8.txt: * tools/encoding/iso8859-9.txt: * tools/encoding/koi8-r.txt: * tools/encoding/macCentEuro.txt: * tools/encoding/macCroatian.txt: * tools/encoding/macCyrillic.txt: * tools/encoding/macGreek.txt: * tools/encoding/macIceland.txt: * tools/encoding/macRoman.txt: * tools/encoding/macTurkish.txt: Updated encodings with latest mappings from www.unicode.org. This did not include some Mac encodings that have special multi-unichar translations now (like symbols, dingbats and japanese). Also does not include big5, gb or euc* as those have different formats in the latest Unicode version that need new conversion tools. Not all related .enc files changed as some had been updates separately. 2001-10-03 Jeff Hobbs * generic/tclEvent.c (Tcl_FinalizeThread): moved freeing of tclLibraryPath to before the thread exit handlers are called. Slight modification to change on 2001-09-24. 2001-10-01 Jeff Hobbs * win/configure: regen'ed * win/tcl.m4: * win/makefile.vc: added Win64 SDK RC1 compilation support * win/Makefile.in: added $(LDFLAGS_CONSOLE) to TCLSH, TCLTEST and PIPE_DLL_FILE targets to get the link flags * win/tclWinInit.c: minor 64bit casts 2001-10-01 Miguel Sofer * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclParseExpr.c: removed unnecessary inclusion of tclCompile.h and made a small modification in (InfoBodyCmd) to improve the isolation of the compiler/engine subsystem. 2001-09-29 Vince Darley * generic/tclIOUtil.c: * doc/FileSystem.3: corrected and clarified documentation for 'Tcl_FSListVolumes(Proc)'. No code changes. 2001-09-28 Miguel Sofer * doc/FindExec.3: added a comment not to change the working directory before calling Tcl_GetNameOfExecutable. [Bug 219215] 2001-09-28 Kevin Kenny * generic/tclIO.c: added two more '(ClientData)' casts on calls to Tcl_Preserve and Tcl_Release -- ones that Vince apparently missed. 2001-09-28 Donal K. Fellows * doc/lsort.n: Improved doc... * generic/tclCmdIL.c (Tcl_LsortObjCmd, SortCompare): Made offset-from-end indexing work, and factored out some "magic numbers" for easier understanding. [Bug 465674] * tests/cmdIL.test (cmdIL-1.26): Added test for offset-from-end indexing for lsort. 2001-09-28 Vince Darley * win/tclWinFCmd.c: * unix/tclUnixFCmd.c: fix to performance issue reported by jcw in which 'access("")' is called unnecessarily when normalizing any absolute path. * generic/tclIO.c: added '(ClientData)' cast to calls to Tcl_(Preserve|Release) newly introduced, fixing compile error on Windows. 2001-09-27 Don Porter * doc/FileSystem.3 (Tcl_FSLoadFile): * generic/tcl.decls (Tcl_FSLoadFile): * generic/tcl.h (Tcl_FSLoadFileProc): * generic/tclInt.h (TclpLoadFile): * generic/tclIOUtil.c (Tcl_FSLoadFile): * generic/tclLoadNone.c (TclpLoadFile): * generic/tclTest.c (TestReportLoadFile): * library/ldAout.tcl: * mac/tclMacLoad.c (TclpLoadFile): * unix/tclLoadAix.c (TclpLoadFile): * unix/tclLoadAout.c (TclpLoadFile): * unix/tclLoadDl.c (TclpLoadFile): * unix/tclLoadDld.c (TclpLoadFile): * unix/tclLoadDyld.c (TclpLoadFile): * unix/tclLoadNext.c (TclpLoadFile): * unix/tclLoadOSF.c (TclpLoadFile): * unix/tclLoadShl.c (TclpLoadFile): * win/tclWinLoad.c (TclpLoadFile): * win/tclWinFCmd.c (DoRemoveJustDirectory): More CONST poisoning fixes from the 2001-09-24 TIP 27 changes. CONST-ified Tcl_FSLoadFile and TclpLoadFile. Report and patch from Kevin Kenny. [Bug 465833] * generic/tclIO.c (ChannelTimerProc): Added Tcl_Preserve() and Tcl_Release() to fix segfault introduced by the 2001-09-26 changes. [Bug 465494] * doc/TCL_MEM_DEBUG.3: Updated out-of-date reference to #define GUARD_SIZE. * doc/UpVar.3 (Tcl_UpVar,Tcl_UpVar2): * generic/tcl.decls (Tcl_UpVar,Tcl_UpVar2): * generic/tclInt.decls (TclFindProc,TclGetFrame): * generic/tclInt.h (TclFindProc,TclGetFrame,TclLookupVar, (TclPrecTraceProc,TclProcInterpProc}): * generic/tclProc.c (TclGetFrame,TclFindProc): * generic/tclVar.c (Tcl_UpVar,Tcl_UpVar2,MakeUpvar): Updated APIs in generic/tclProc.c and generic/tclVar.c according to the guidelines of TIP 27. [Patch 465442] * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs 2001-09-26 Andreas Kupries * doc/fileevent.n: Accepted [Patch 465279] adding an example to the fileevent manpage. Minor modifications to get a better formatting. Report and patch by David N. Welton . * The changes below fix [Bug 462317] where Expect tried to read more than was in the buffers and then blocked in the OS call as its pty channel driver provides no blockmodeproc through which the OS could be notified of blocking-behaviour. Because of this the general I/O core has to take more care than usual to preserve the semantics of non-blocking channels. The problem was reported by "Kevin O'Gorman" . * generic/tclIO.c (Tcl_ReadRaw): Do not read from the driver if the channel is non-blocking and the fileevent causing the read was generated by a timer. We do not know if there is data available from the OS. Instead of going to the OS for more and potentially blocking we simply signal EWOULDBLOCK to the higher levels to cause the system to wait for true fileevents. (GetInput): Same as before. (ChannelTimerProc): Added set and clear of CHANNEL_TIMER_FEV. * generic/tclIO.h (CHANNEL_TIMER_FEV): New flag for channels. Is set if a fileevent was generated by a timer, the channel is not blocking and the driver did not provide a blockmodeproc. In that case the I/O core has to be especially careful about going to the driver for more data. 2001-09-26 Don Porter * doc/SplitPath.3 (Tcl_GetPathType): * generic/tcl.decls (Tcl_GetPathType): * generic/tclFileName.c (Tcl_GetPathType): * win/tclWinFile.c (TclpMatchInDirectory, NativeStat): Vince Darley reports the 2001-09-24 TIP 27 changes left the win directory CONST poisoned. These changes should fix that. * generic/tclDecls.h: make genstubs 2001-09-25 Don Porter * doc/GetInt.3: * generic/tclInt.h (TclGetLong deleted): * generic/tcl.decls: * generic/tclInt.decls: * generic/tclGet.c: Updated APIs in generic/tclGet.c according to the guidelines of TIP 27. [Patch 464674] * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs 2001-09-25 Miguel Sofer * generic/tclVar.c: removed comments referring to unused flag TCL_PARSE_PART1. 2001-09-24 Don Porter * doc/Concat.3: * doc/DString.3: * doc/SplitList.3: * generic/tclInt.h (TclCheckBadOctal): * generic/tcl.decls: * generic/tclInt.decls: * generic/tclEncoding.c (OpenEncodingFile): * generic/tclMain.c (Tcl_Main): * generic/tclUtil.c: * unix/tclLoadDl.c (TclpLoadFile): Updated APIs in generic/tclUtil.c according to the guidelines of TIP 27. [Patch 464553] * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs 2001-09-24 Andreas Kupries The change below fixes [Bug 464380]. The bug was reported by Ronnie Brunner . He also provided the patch. * generic/tclEvent.c (Tcl_Finalize): Moved release of 'tclLibraryPath' to Tcl_FinalizeThread. (Tcl_FinalizeThread): See above, new place for release of 'tclLibraryPath'. 2001-09-24 Donal K. Fellows * tools/encoding/cp1252.txt: File was missing part of the encoding [euro, ZCaron and zcaron]. * doc/OpenFileChnl.3: Add docs for Tcl_OutputBuffered; remove some old changebars. 2001-09-21 Jeff Hobbs * generic/tclExecute.c (TclExecuteByteCode): corrected INST_STR_CMP else case for strings to pass true utf char length to Tcl_UtfNCmp. 2001-09-20 Jeff Hobbs * win/tclWinInit.c: added extra processor definitions. (mstacy) * win/tclWinSock.c (SocketThread): corrected pointer cast for _WIN64. * win/tclWinNotify.c: removed unnecessary winsock include (it is already in from tclWinPort.h). * win/tclWinPort.h: changed winsock.h include to winsock2.h. Reverses change from 2000-11-16, but is necessary for WIN64. Extensions should comply with defined OS words, or use #ifndef. 2001-09-20 Donal K. Fellows * tests/socket.test: removed dependence on being run from same dir as remote.tcl, which only now needs to be in the same dir as this file. [Bug 219326] 2001-09-19 Jeff Hobbs * generic/tclTest.c (TestcmdtokenCmd): corrected pointer storage/retrieval for 64bit machines. * generic/tclCmdAH.c (Tcl_FormatObjCmd): * generic/tclScan.c (Tcl_ScanObjCmd): corrected handling of format and scan on 64-bit machines. [Bug 412696] (rmax) * unix/configure: regen'ed * unix/tcl.m4: added --enable-64bit support for HP-11 with the 64-bit kernel. * tests/basic.test: * tests/cmdInfo.test: improved skip reporting of missing commands * tests/winFCmd.test: simplified error check for winFCmd-7.9 * tests/winPipe.test: removed obsolete cat16 tests * generic/tclExecute.c (TclExecuteByteCode): fixed invalid usage of valuePtr in TRACE_WITH_OBJ in INST_EVAL_STK case. [Bug 462594] Changed INST_STR_CMP instruction to promote to Unicode strings only when one of the strings is already of Unicode type. * generic/tclExecute.c (TclExecuteByteCode): * generic/tclCompile.c (instructionTable): * generic/tclCompCmds.c (TclCompileStringCmd): INST_STR_MATCH - Updated to Int1 instruction type and added special case to use INST_STR_EQ instead when no glob chars are specified in a static string. * tests/{for.test,foreach.test,if.test,while.test}: * generic/tclCompCmds.c (TclCompileForCmd, TclCompileForeachCmd, TclCompileIfCmd, TclCompileWhileCmd): Corrected the overaggressive compiling of loop bodies enclosed in ""s. [Bug 219166] (msofer) 2001-09-19 Miguel Sofer * generic/tclExecute.c: insured that execution stack errors are also detected at abnormal returns. 2001-09-19 Donal K. Fellows * doc/socket.n: Added documentation to mention what happens when a server socket is created with port=0. Removed an old change bar, and no new change bar because Tcl has always behaved this way as it is really a poorly-documented standards-defined OS feature. * tests/util.test (util-8.1): Test derived from code to detect the problem, but the test always works in the C locale, so beware if you are maintaining the code. * generic/tclUtil.c (TclNeedSpace): Rewrote to be UTF-8 aware. [Bug 411825, but not that patch which would have added extra spaces if there was a real non-ASCII space involved.] 2001-09-18 Andreas Kupries * generic/tclIOCmd.c (Tcl_PutsObjCmd): Rewritten to have saner and faster argument handling. [Bug 123552], [Patch 402564] (fellows) 2001-09-18 Don Porter * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): On Linux, disable inlining when one of the compat/*.c routines is to be linked in. [Patch 440891] 2001-09-17 Jeff Hobbs * generic/tcl.h: removed forced #define USE_TCLALLOC 1 for Windows. This means the native system allocator will be used by default. This should be binary and source compatible with extensions, as Tcl_Alloc is a properly stubbed function. 2001-09-17 Miguel Sofer * generic/tclExecute.c: corrected small bug in [Patch 456668] - the varFramePtr was not restored in one possible exit. 2001-09-17 Miguel Sofer * doc/tclvars.n: * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclProc.c: disabled all compile and execution tracing functionality in standard builds; TCL_COMPILE_DEBUG is now necessary to enable it. [Bug 451858] 2001-09-14 Andreas Kupries * doc/gets.n: * doc/read.n: * doc/puts.n: * doc/flush.n: * doc/fconfigure.n: * doc/flush.n: * doc/eof.n: * doc/seek.n: * doc/tell.n: * doc/close.n: * doc/fileevent.n: Added references to the Tcl standard channels. Item [219250], reported by David LeBlanc . Thanks to Christopher Nelson for doing editorial work. 2001-09-13 Andreas Kupries * win/Makefile.in: * win/configure.in: * win/makefile.bc: * win/makefile.vc: * library/dde/pkgIndex.tcl: Fixed version numbers from bogus tcl versions to independent versions for dde and registry packages. 2001-09-13 Jeff Hobbs * tests/regexp.test (regexp-20.1): * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): had to adjust fix from 2001-08-06 to actually duplicate the objects in certain cases. This is really a place where feather would have been essential. [Bug 461322] * generic/tclUtf.c (Tcl_UtfPrev): corrected to return the proper location when the middle of a UTF-8 byte was passed in [Tk Bug 450504] * ChangeLog.1999: * ChangeLog: broke changes from 199x into ChangeLog.1999 to reduce size of the main ChangeLog. 2001-09-13 Andreas Kupries * tests/ioCmd.test: Changed the computation of the result for iocmd-8.1[123] so that the tests work for single- and multi-process execution of the testsuite. Depending on the choice of the user stdout is a tty or not and thus reports different channel options. Fixes [460993] reported by Don Porter. 2001-09-13 Miguel Sofer * doc/ParseCmd.3: * generic/tcl.decls: * generic/tclCmdMZ.c (Tcl_SubstObjCmd): * generic/tclDecls.h: * generic/tclParse.c: * generic/tclStubInit.c: * tests/parse.test: Deprecate the use of Tcl_EvalTokens, replaced by the new Tcl_EvalTokensStandard. The new function performs the same duties but adheres to the standard return convention for Tcl evaluations; the deprecated function could only return TCL_OK or TCL_ERROR, which caused [Bug 219384] and [Bug 455151]. This patch implements [TIP 56]. 2001-09-12 Mo DeJong * unix/configure: Regen. * unix/tcl.m4: Invert the logic that checks for $GCC. Instead of checking for "$GCC" = "no" we check for "$GCC" != "yes" or simply swap the true and false blocks of code in an if statement. That way if GCC is set to "" everything will still work. [Bug 460991] 2001-09-12 Don Porter * tests/appendComp.test: * tests/lsearch.test: * tests/namespace.test: * tests/rename.test: * tests/split.test: Corrected tests to better isolate tests in one file from influencing tests in other files. [Bug 460591] 2001-09-12 Miguel Sofer * generic/tcl.decls: reserved stub #481 for the implementation of [TIP 56] 2001-09-11 Andreas Kupries * doc/OpenFileChnl.3: Added documentation for Tcl_WriteRaw and Tcl_ReadRaw [Bug 414929]. * doc/CrtChannel.3: Added documentation for Tcl_ChannelBuffered and Tcl_GetTopChannel [Bug 414929]. * The changes below are a fix for [Bug 219253]. * tests/socket.test: Removed _most_ instances of hardwired port numbers for listening sockets. Remaining are the ports in all tests with constraint 'doTestsWithRemoteServer'. These seem to be designed for a more controlled environment and are usually skipped when running the testsuite. * tests/io.test: Removed all instances of hardwired port numbers for listening sockets. 2001-09-10 Jeff Hobbs * generic/tclEvent.c (TclInExit): Corrected handling of tsd in late stages of finalization. [Bug 419449] (darley) * tests/stack.test: * generic/tclInterp.c (AliasObjCmd): Check the numLevels to ensure that we aren't hitting some alias loop condition. [Bug 443184] 2001-09-10 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Don't include . characters in the Tcl library name when building on FreeBSD 3.X and later systems. [Patch 450725] 2001-09-10 Andreas Kupries * doc/tclsh.1: * doc/Tcl_Main.3: * doc/CrtChannel.3: * doc/OpenFileChnl.3: * doc/GetStdChan.3: Enhanced the manpages with cross-references to the new manpage and more explanations how these functions deal with the standard channels in various situations. * doc/StdChannels.3: New manpage describing handling of the standard channels by the Tcl library. [Bug 402725] 2001-09-10 Don Porter * unix/mkLinks (Tcl_FSLink): Updated to reflect 2001-08-23 file system changes. * unix/tclLoadShl.c: Added #include of tclInt.h; access to Tcl internals, notably TclpUnloadFile(), is required. Thanks to Bob Techentin for report and patch. [Bug 459305] * generic/tclInitScript.h (initScript): * win/tclWinInit.c (TCL_REGISTRY_KEY, TclpSetVariables): Removed vestiges of Tcl's old initialization from registry variables. [Bug 455645] 2001-09-10 Andreas Kupries * generic/tclInt.decls: Also added 'TclWinFlushDirtyChannels' to the internal platform specific stub table. * win/tclWinFile.c (TclpObjStat): Now added the call to 'TclWinFlushDirtyChannels' to this function. I don't know where my head was last thursday (2001-09-06), but the call was actually added to 'TclpObjChdir', i.e. the implementation of [cd]. Corrected this now. Thanks to Vince Darley for spotting this. 2001-09-10 Miguel Sofer * generic/tclProc.c: * tests/proc.test: made [proc] bytecompile a no-op for procs defined with _args_ as single argument and an empty body. [FRQ 451441] 2001-09-09 Mo DeJong * unix/Makefile.in: * win/Makefile.in: Use () around variable name instead of {}. Use TCLTEST variable directly instead of depending on the tcltest alias. 2001-09-09 David Gravereaux * generic/tcl.h: * generic/tclPlatDecls.h: Reminder from David Cuthbert that I hadn't finished the Borland compatibility stuff. [Patch 436116] 2001-09-09 Mo DeJong * tests/cmdAH.test: Modify cmdAH-20.5 and cmdAH-24.8 to display the file atime or mtime results if the test fails. 2001-09-08 David Gravereaux * win/mkd.bat: * win/rmd.bat: made these text files, text files again. [Patch 451333] 2001-09-08 Mo DeJong * win/mkd.bat: * win/rmd.bat: Apply binary property (cvs admin -kb) to files and convert to CRLF linefeed format to fix the VC++ build. [Bug 219409] 2001-09-08 Vince Darley * generic/tclInt.h: * generic/tclFCmd.c: * doc/FileSystem.3: * generic/tclIOUtil.c: removed Tcl_FSCopyFile fallback to channel copying, since the channels will not have access to interpreters and the channel copying currently requires an interp. Code which required cross-platform copies always has interpreters, so that solves the problem. Fixes bug in TclKit. 2001-09-07 David Gravereaux * win/tcl.m4: Added -link50compat option so a VC6 linker makes a VC5 (pre sp3) compatible import library. [Bug 219257] 2001-09-07 Mo DeJong * win/tclWinThrd.c (TclpThreadExit): Cast status argument to _endthreadex to unsigned instead of DWORD to match the Win32 function prototype. 2001-09-06 Andreas Kupries * All the changes below serve to fix bug [219148] which reports a 80x performance hit for file I/O on Win* systems. On my system it was closer to a 120x hit. Problem report by Uwe Traum . The fix goes like this: The obstacle is 'FlushFileBuffers', executed whenever Tcl writes data to the OS, as Tcl has to wait for the disk to complete I/O, and disks are slow. We remove that obstacle. This opens another problem, [file size] reports back wrong numbers. So for [file size] we add the call back in. As optimization we keep track of the channels which were written to and flush only these. * win/tclWinFile.c (TclpObjStat): Added a call to 'TclWinFlushDirtyChannels'. This ensures that [file size] and related commands report the correct size of a file even if Tcl has recently written to it. Unixoid OS's always report the correct size even for files with pending data, but Win* syssystem don't. They only report what is actually on disk. * win/tclWinInt.h: Added declaration of 'TclWinFlushDirtyChannels', making it available to other parts of the tcl core. * win/tclWinChan.c (TclWinFlushDirtyChannels): New, internal, procedure. Goes through the list of open file channels and forces the OS to flush its file buffers for all which were written to since the last call of this function. This is an expensive operation as Tcl has to wait for the OS to complete actual writes to the disk. (FileInfo): Added dirty flag required by the procedure above. (FileOutputProc): Removed flushing of file buffers, setting the dirty flag instead. This means that the previously incurred delays do not happen anymore. (TclWinOpenFileChannel): Added initialization of 'dirty' flag. 2001-09-06 Jeff Hobbs * doc/http.n: noted -binary, charset and coding state keys. * tests/http.test: * library/http/pkgIndex.tcl: * library/http/http.tcl (geturl): correctly get charset parameter and convert text according to specified encoding (if known). RFC iso8859-1 is used by default. Also recognize Content-encoding to see if we should do binary translation. Added a CYA -binary switch for the cases that were missed. [Bugs 219211, 219399] * tests/ioUtil.test: changed to make better use of constraints and remove knownBug constraints that weren't valid. 2001-09-06 Don Porter * tests/unixInit.test (unixInit-3.2): Updated test to support newer HP-UX releases that properly report euc-jp as the system encoding for Japanese. Bug report and patch verification by Bob Techentin. [Bug 453883] * doc/http.n: * library/http/*.tcl: * tools/tcl.wse.in: * tools/tclmin.wse: * unix/Makefile.in: * win/{Mm}akefile.*: Updated http package to version 2.4, reflecting the new features just added. 2001-09-06 Vince Darley * generic/tclTest.c: tests of old-fs hooks no longer cause problems in threaded builds. Also removed unused unload proc. * generic/tcl.decls: * generic/tclIOUtilc: added Tcl_FSMountsChanged so that a vfs can inform the filesystem that the filesystem epoch must be changed (since cached filesystems may now be incorrect). Fixes problem running tclvfs extension. * library/tcltest/tcltest.tcl: if tests aren't in a native filesystem, then don't use pipes to run them. [Bug 458741] 2001-09-06 Donal K. Fellows * generic/tcl.decls (479 generic): * generic/tclIO.c (Tcl_Seek,Tcl_Tell,Tcl_OutputBuffered): Added public function to return the size of the output buffer and reworked other channel functions to use this shared functionality and that of Tcl_InputBuffered() too. [TIP#49, Rolf Schroedter] 2001-09-05 David Gravereaux * generic/tclPlatDecls.h: Another small trim finalizing Borland support. * win/tclWinPipe.c: * win/tclWinPort.h: More Borland compatibility fixes. Changed EDQUOT #define from 49 to 69. Borland had a clash as it was already using this number. Upon advice from Helmut Giese, EDQUOT has been found in other header files #defined as 69. [Patch 436116] * win/.cvsignore: A few more glob patterns added. * win/makefile.bc (new): Borland lives once more! rejoice.. * generic/tclAlloc.c: Small Borland compatibility fix. * win/tclWinTime.c: More Borland compatibility fixes. [Patch 436116] 2001-09-05 Vince Darley * tests/winFCmd.test: made notWin2000 constraint false if not running on Windows at all. 2001-09-04 David Gravereaux * win/tclWinThrd.c: Revisited _beginthreadex() stuff. Instead of assuming a c-runtime implimentation of _beginthreadex normal, I reversed the logic to not assume, and use when is by explicitly needing to add runtimes that support it such as Borland. * generic/tcl.h: * generic/tclPlatDecls.h: Borland compatibility change so ClientData was properly typed as a void* and TCHAR would not be defined twice. * generic/tcl.h: Removed a small mistake from before. Changes to the EXTERN macro for proper Borland compatibility will have to see a TIP. What's this with the MS compiler: __declspec(dllexport) int func (int a, int b); will have to be this with Borland: int __cdecl __export func (int a, int b); The order of the attribute needs to be after the return type. 2001-09-04 Don Porter * compat/strtod.c (strtod): Fixed failure to handle expressions like 3eq2 and failure to set errno on overflow. [Bug 440894] 2001-09-04 Miguel Sofer * generic/tclProc.c: * tests/proc.test: made [proc] check that formal args have simple names. [Bug 458548] 2001-09-04 Vince Darley Minor bug fixes in filesystem, plus small vfs changes as a result of enabling the test filesystem to work properly. * tests/fileName.test: ensure new test cleans up after itself * doc/filename.n: * generic/tclFileName.c: improved Mac path handling and document why [Bug 421842] on Windows handling of UNC paths is not valid. Documentation and code now much clearer on what is and is not a UNC path. * doc/FileSystem.3: * unix/tclUnixPipe.c: * generic/tclFCmd.c: * generic/tclIOUtil.c: fixed error message, fixed [Bug 453512] about dangerous use of tmpnam, replaced with mkstemp. Documented all the changes. * generic/tclTest.c: made test vfs fully functional as a 'reporting filesystem'. * generic/tcl.stubs: * generic/tcl.h: * generic/tclInt.h: * generic/tclIOUtil.c: * doc/file.n: * various platform-specific 'TclpLoadFile': fixed comments about unload behaviour, and completed objectification of loading. Required change to Tcl_Filesystem lookup table, so incompatible with 8.4a3, but not older versions of Tcl. The change also allows 'link' and 'reporting' filesystems to function correctly when loading files. Implementation of 'file delete -force' copes with case where cwd is inside the directory. Moved overlooked Tcl_FSGetPathType from internal to external API. Made sure filesystems which are registered and then unregistered are only freed when all references to them are gone. Documented changes. * unix/tclUnixFCmd.c: when deleting directories recursively, make sure permissions are ok. Together with the above, this fixes [Bug 219139] * tests/winFCmd.test: differentiated test results for win2k versus not. This fixes [Bug: 219239] * tests/fCmd.test: added tests for 'file delete -force' where the cwd is inside, and when permissions are inadequate. 2001-09-04 Miguel Sofer * generic/tclCompile.c: fixed incorrect operands for INST_LIST [Bug 458241] (David Cuthbert, dacut@users.sourceforge.net) 2001-09-03 Jeff Hobbs * generic/tclExecute.c (TclExecuteByteCode): fixed missing comma in debug macro. 2001-09-03 Donal K. Fellows * doc/ExprLongObj.3: Fixed error in documentation of argument type to Tcl_ExprObj [Bug 457435] 2001-09-02 David Gravereaux * win/tclWinThrd.c: Portability fix for Cygwin who's c-runtime, not surprisingly, doesn't have the MSVCRT specific _beginthreadex / _endthreadex pair. This might have to be revisited for proper Borland, lcc32, Watcom and other support as well. [Patch 444255] * win/tclWinThrd.c: Moved FinalizeConditionEvent() proto to within the main #ifdef TCL_THREADS block to avoid mingw warning about it being there but unused. * win/makefile.vc: Added -Zl (zee el) to tclStubLib.c compile line to make sure the tclstub84.lib static library is built without requiring a specific C-runtime library at link-time for the end-use developer. It has been noted on c.l.t that this trips many first time users trying to make extensions. [Patch 403533] 2001-08-31 Jeff Hobbs * generic/tclInt.h: added TclCompileListCmd header * generic/tclBasic.c: added TclCompileListCmd compile proc * generic/tclCompCmds.c (TclCompileListCmd): function to compile the 'list' command at parse time. * generic/tclExecute.c (TclExecuteByteCode): definition of INST_LIST bytecode. * doc/StringObj.3: added words of warning to use Tcl_ResetResult with the Tcl_Append* functions. * tests/compile.test: added compile-11.* interp result checks * generic/tclUtil.c (TclGetIntForIndex): added Tcl_ResetResult before Tcl_AppendStringsToObj to prevent shared object crash when called from bcc instruction. The Tcl_Append* calls that append to the result object that are invoked by bcc insts must remember to call Tcl_ResetResult because the bcc doesn't do this for us. [Bug 456892] 2001-08-30 Jeff Hobbs * generic/tclIndexObj.c: fixed some casting problems that upset Crays. [Bug 419528] (andreasen) 2001-08-30 Don Porter * generic/tcl.h: Silence warning from Sun compiler. [Bug 454374] 2001-08-30 Miguel Sofer * generic/tclExecute.c: allow cached fully-qualified command names to be usable from different namespaces within the same interpreter without forcing a new lookup. This speeds up scripts that pass command names in variables ("this" in some OO packages). [Patch 456668] 2001-08-30 Vince Darley Further fs updates. After examining the most common Tcl extensions (TclX, BLT, Tk, TclPro, Mktclapp), it has been determined that only TclpGetCwd and the Access/Stat/Open insert/delete hooks of the internal fs functions are ever used. The remaining functions from Tcl's internal interfaces have therefore been removed, since Tcl now exports a more suitable public API (Tcl_FS...) * generic/tclInt.stubs: * generic/tclInt.h: updated for removed internal functions. Some new internal functions have been put in tclInt.h (and not exported in the stub table because good public equivalents exist). * generic/tclTest.c: some test functions used the internal private APIs. These tests have been retained, but modified to use public APIs. Also objectified the internal filesystem tests. * win/tclWinFile.c: removed TclpStat, TclpAccess and refactored code to use NativeAccess, NativeStat. This should speed up stat, access and glob commands. * win/tclWinFCmd.c: removed all TclpCopy/Rename/Delete File/Directory string-based procedures which aren't used any more. Improved efficiency of some other procedures. Ensure that filename conversions with a NULL interp do not crash Tcl. * mac/tclMacFCmd.c: wrapped long lines and cleaned up TclpObjNormalizePath, removed all TclpCopy/Rename/Delete File/Directory string-based procedures which aren't used any more. * mac/tclMacFile.c: removed obsolete TclpStat, TclpAccess, TclpChdir, etc. * unix/tclUnixFCmd.c: removed use of TclpAccess, removed all TclpCopy/Rename/Delete File/Directory string-based procedures which aren't used any more. * unix/tclUnixFile.c: removed obsolete TclpStat, TclpAccess, TclpChdir, etc. * tcl(Unix|Mac|Win)Chan.c: objectified TclpOpenFileChannel. * various 'load' implementations all objectified. * generic/tclFileName.c: removed redundant code. * generic/tclIOUtil.c: removed TclStat, TclAccess, TclpListVolumes. Fix to MatchInDirectory at the root of a volume. Also improved some documentation, and improved default path joining behaviour for virtual filesystems, especially regarding '~'. * tests/fileName.test: added tests to check for bugs fixed above. * doc/FileName.3: improved documentation 2001-08-30 David Gravereaux * generic/tclAsync.c: * generic/tclEvent.c: * generic/tclInt.h: Improper cleanup of asyncMutex in tclAsync.c repaired. TclFinalizeSynchronization() was trying to remove a registered mutex that was dumped earlier when the TSD it was stored in was cleared. This was only surfacing on *nix. Windows was being masked by mutexes not actually being returned to the system! That was repaired in a previous patch. Needed to add a private TclFinalizeAsync() to tclAsync.c and called from Tcl_FinalizeThread(). Pheww.. Is this done yet? [Bug 414419] requested by Rob Ratcliff 2001-08-28 Jeff Hobbs * generic/tclCompCmds.c (TclPushVarName): noted 'static' defn. [Bug 453872] 2001-08-26 Don Porter * library/auto.tcl (tcl_findLibrary): * tests/unixInit.test (unixInit-2.{1,9}): * unix/tclUnixInit.c (TclpInitLibraryPath): * win/tclWinInit.c (TclpInitLibraryPath): Corrected inconsistency between the search path for script libraries and the directory name $DISTNAME into which distributions built by 'make test' unpack. [Bug 455642] 2001-08-24 Jeff Hobbs * tests/stringComp.test: added string-1.3 * generic/tclCompCmds.c (TclCompileStringCmd): changed to return TCL_OUT_LINE_COMPILE instead of TCL_ERROR when compiling and an unknown string method is called. This is necessary as the string command may be never called, or not until 'string' is redefined. 2001-08-24 Vince Darley * doc/glob.n: documented windows-style path issue with glob. [Bug 219392] * doc/filename.n: documented windows path/file length limitation. [Bug 454597] 2001-08-24 Don Porter * tests/unixInit.test (unixInit-2.9): Corrected expected result to match Tcl's quirky construction of its init library path. 2001-08-23 Andreas Kupries * win/tclWinPipe.c (BuildCommandLine): Fixed [Bug 432499]. Part of the code used the non-absolute path to the executable to determine quoting. This failed if the absolute path contained spaces, but the application name itself not. This bug caused no trouble on Win NT 5, but does for other variants in the Win* family. Report and fix due to Ken Poole . 2001-08-23 Jeff Hobbs * unix/configure: * unix/tcl.m4: added QNX-6 build support. [Bug 219410] (loverso) * unix/tclUnixFCmd.c: * generic/tclIOUtil.c: * generic/tclFileName.c: corrected minor compiler warnings. 2001-08-23 Vince Darley Variety of small filesystem and vfs issues fixed or improved. The new fs code allows many new opportunities for efficiency improvements through the objectified API. The main changes integrated here are such efficiency improvements. Some limitations of the original implementation have also now been lifted. Meanwhile a variety of fs bugs (some old, some new) have also been fixed. * generic/tclFileName.c: Made Tcl_FSSplitPath more efficient, and removed some static string-based procedures which are no longer used. Much more objectification. Tcl_FSJoinPath is now very efficient and more aware of virtual filesystems. Clarified where the Mac-specific code attempts to interpret Unix-style paths. Modified TclDoGlob to use lstat not access to fix [Bug 434876] (L. Virden) * tcl(Win|Unix|Mac)FCmd.c: * tcl(Win|Unix|Mac)File.c: replaced TclpListVolumes with TclpObjListVolumes with different signature, updated code due to more efficient signature of Tcl_FSGetTranslatedPath. Used cached native paths where possible to improve efficiency -- this was completed on MacOS, but on Unix and Win the traversal functions make the task much more complex, so there are still some improvements possible there. Removed unused TclpNormalizePath which had been left in tclWinFCmd.c. Objectified all 'file attributes' functions. Fixed the new [Bug 451571, Bruce Stephens] which is most obvious on Unix, but could occur on MacOS or Windows. This bug actually existed in Tcl 8.3.x but was only made obvious by the recent filesystem overhaul when the code was exercised more heavily. * tests/fileName.test: Three new tests to exercise the above bug, and make sure it is fixed correctly. * unix/tclUnixFile.c: avoid panic in glob when a link doesn't point anywhere. It would probably be good to define exactly what Tcl should do in circumstances like these, and make sure mac/win/unix all behave accordingly. [Bug 417111] (Hemang Lavana). Also fixed misleading/obsolete comment in the code. * generic/tcl.stubs: changed signature of Tcl_FSGetTranslatedPath and added Tcl_FSGetTranslatedStringPath. These changes allow further optimisations in the FS code. * generic/tcl.h: changed signature of Tcl_FSListVolumes so that it doesn't require a Tcl interpreter plus result. Renamed Tcl_FSReadLink to Tcl_FSLink with additional argument so we can support making links in the future. [Patch: 450340] * generic/tclInt.h: added declaration for TclpObjListVolumes. Objectified internal call signatures for 'file attributes' functions, and added an internal objectified get path type function. * generic/tclIOUtil.c: added the moved function TclpListVolumes which calls platform specific code (needed for backwards compatibility), and improved efficiency of parts of the FS (particularly file normalization). Much less copying and memory allocation is required now. added new GetPathType so that changes in 'file volumes' can actually affect files' types, and objectified more code. Made current code work with test suite artificially changing current platform. Added 'static' keywords where required. * generic/tclIO.c: * generic/tclTest.c: Added 'static' keywords, fixing [Bug 453872] (Bob Techentin) * generic/tclCmdAH.c: file command implementation updated for API changes, removed unnecessary special-case SplitPath static function, since it no longer helps prevent code duplication. Moved setting of interpreter result to each individual location that actually required it, to avoid very large code separation between reading and setting the result. * doc/FileSystem.3: updated documentation for the new or changed APIs, and clarified some issues. * doc/SplitPath.3: added pointer to newer APIs in FileSystem.3 * doc/filename.n: clarified current implementation of tilde support on Mac/Win. [Bug 453514] (Sergey Kuzmin) * doc/glob.n: improved documentation for '-directory' and '-path' options. There are now many private, obsolete, platform-specific 'Tclp' string-based filesystem APIs which could be removed. We should check whether any of these are used by extensions and, at least in Tcl 9, remove them. The above changes signify a ***POTENTIAL INCOMPATIBILITY*** with 8.4a3, since signatures of two functions in the new API have changed, but not with older versions of Tcl. 2001-08-23 Donal K. Fellows * generic/tclBinary.c (FormatNumber): Extract a long from the object and not an int, to stop [binary format] from being unable to format some input numbers on architectures where sizeof(int) is less than sizeof(long) (particularly Alpha). [tiprender Bug 441861] * tests/format.test: Converted conditional execution of tests into a test constraint. 2001-08-22 Jeff Hobbs * win/Makefile.in: * win/makefile.vc: updated install target for dde1.2 * doc/dde.n: fixed dde man page (which was totally incorrect). * tests/winDde.test: * win/tclWinDde.c (Tcl_DdeObjCmd): added -binary option to dde request command to allow for returning binary data. [Bug 227482] Updated dde to 1.2 * tests/tcltest.test: added unixExecs constraint to files that used 'grep' in the test. [Bug 453143] * library/tcltest/tcltest.tcl: fixed stdio constraint test. [Patch 454050] (stanton) Simplified unixExecs constraint test. 2001-08-22 Don Porter * tests/ioUtil.test (ioUtil-3.*): Corrected errors in tests revealed by fix of overagressive compiler. [Bug 451200] 2001-08-21 Miguel Sofer * generic/tclCompCmds.c: * tests/compile.test: Fixed overagressive compilation of [catch]: it was catching errors at substitution time. [Bug 219184] 2001-08-21 Jeff Hobbs * tests/tcltest.test (tcltest-12.2): fixed test that would break when env vars weren't Tcl list friendly [Patch 454046] (stanton) 2001-08-20 Jeff Hobbs * library/http/http.tcl (geturl): added port number to Host: header to comply with HTTP/1.1 spec (RFC 2068). [Bug 452217] 2001-08-16 David Gravereaux * tools/tcl.wse.in: * tools/tcl.hpj.in: * win/tcl.hpj.in: Removed -kb storage in CVS to ensure these text files are checked-out in the translation mode CVS is in. Setting these as binary as part of an effort to make sure they are always in CRLF, no matter what the CVS translation, is bypassing how CVS works and is confusing. * tools/genStubs.tcl: Removed LF-only output. Having to reconvert back to CRLF before committing to CVS was giving me a headache. [Bug 451333] * win/makefile.vc: replaced $(WINDIR) with $(include32) for the .rc.res inference rule. winver.h wasn't getting included. [Bug 445630] 2001-08-14 Miguel Sofer * generic/tclBasic.c: make the intial maxNestingDepth of an interpreter be MAX_NESTING_DEPTH instead of a hardwired value. [Bug 232564] 2001-08-13 Miguel Sofer * tests/trace.test: Corrected test numbers. [Bug 449794] 2001-08-12 Mo DeJong * unix/configure: Regen. * unix/configure.in: * unix/tcl.m4: Use GCC variable set by AC_PROG_CC instead of defining our own using_gcc variable. 2001-08-11 Vince Darley Variety of small issues introduced by the vfs code fixed: * generic/tclIOUtil.c: uninitialised read. * generic/tclFCmd.c: possible memory leak in file delete with error condition. 2001-08-10 Miguel Sofer * generic/tclVar.c: * tests/trace.test: Insure that [array] traces work correctly for undefined variables. [Bug 449094] 2001-08-09 Mo DeJong * unix/Makefile.in: Delete the unused getcwd.o target. [Bug 440942] 2001-08-08 Don Porter * library/dde/pkgIndex.tcl: * library/http/http.tcl: * library/http/pkgIndex.tcl: * library/msgcat/msgcat.tcl: * library/msgcat/pkgIndex.tcl: * library/opt/optparse.tcl: * library/opt/pkgIndex.tcl: * library/reg/pkgIndex.tcl: * library/tcltest/tcltest.tcl: * library/tcltest/pkgIndex.tcl: Added checks for package dependencies. Bumped patchlevels of changed packages: http 2.3.2, msgcat 1.2.2, opt 0.4.3, tcltest 2.0.1. [Patch 448931] * README: * generic/tcl.h: * tools/tcl.wse.in: * unix/configure: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure: * win/configure.in: Bumped up patchlevel to 8.4a4 to distinguish CVS snapshots from the 8.4a3 release. This does not necessarily mean there will be an 8.4a4 release. [Bug 448938] 2001-08-06 Jeff Hobbs 8.4a3 RELEASE * changes: * README: * mac/README: * unix/README: * win/README.binary: updated for 8.4a3 release * generic/tclFileName.c (Tcl_FSSplitPath): update to Tcl style guide. * generic/tclFCmd.c (FileCopyRename): fixed mem leak in introduction of vfs code where a new Tcl_Obj wasn't freed. * generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): reordered the retrieval of arguments to avoid shimmering bug when the pattern and string referenced the same object. * unix/configure: regenerated * unixE/tcl.m4: added GNU (HURD) configuration target. [Patch 442974] (brinkmann) * win/README: made note of URL for Windows compilation notes * win/tclWinThrd.c (TclpFinalizeMutex, TclpFinalizeCondition): added DeleteCriticalSection calls for cleanup [Patch 419683] * unix/tclUnixPipe.c (TclpCreateTempFile): fixed use of tmpnam, which is dangerous. [Patch 442636] (lim) The use of tmpnam in TclpTempFileName must still be changed. * tests/http.test (http-4.14): fixed variable error return. [Bug 424252] 2001-08-03 Jeff Hobbs * win/configure: regenerated * win/tcl.m4: fixed DLLSUFFIX definition to always be ${DBGX}.dll. This is necessary for TEA compliant builds that build shared against a static-built Tcl. * win/Makefile.in ($(TCLSH)): added $(TCL_STUB_LIB_FILE) to build target, otherwise it wouldn't get generated in a static build. 2001-08-06 Andreas Kupries * generic/tclIOCmd.c (Tcl_GetsObjCmd): Applied patch from [Bug 442665] to fix the bug reported by it. The function can corrupt a freed object if it is called with objc == 3. This is because it retrieves resultPtr and does not increment its reference count, but then calls Tcl_ObjSetVar2, which causes the retrieved resultPtr object to be released. 2001-08-06 Don Porter * doc/tclsh.1: Added note that the tclsh program is frequently installed with the Tcl version numer as part of the name. [Patch 402725] * generic/tclPkg.c: * tests/pkg.test: [package forget] now forgets all of the package arguments it receives, not stopping when a package is not found. [Bug 415273] 2001-08-02 Jeff Hobbs * generic/tclIOUtil.c (Tcl_FSMatchInDirectory): corrected uninitialized value. 2001-08-02 Mo DeJong * generic/tclPlatDecls.h: * win/tclWinPort.h: Revert related changes made to improve Cygwin support on 2001-07-18. This change ended up breaking the VC++ build because of conflicts between Windows APIs and internal Tk APIs. 2001-08-01 Jeff Hobbs * unix/tclUnixFCmd.c: minor casts to eliminate warnings. (lim) [Patch 440218] * tests/parseOld.test: changed some tests that required testwordend to exist to skip in a proper tcltest manner. [Bug 442663] * library/http/http.tcl (http::mapReply): the regsub'ing of \n and \t to escape them was unnecessary. 2001-07-31 Vince Darley Changes from TIP#17 "Redo Tcl's filesystem" The following files were impacted: * doc/Access.3: * doc/FileSystem.3: * doc/OpenFileChnl.3: * doc/file.n: * doc/glob.n: * generic/tcl.decls: * generic/tcl.h: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclDate.c: * generic/tclDecls.h: * generic/tclEncoding.c: * generic/tclFCmd.c: * generic/tclFileName.c: * generic/tclGetDate.y: * generic/tclIO.c: * generic/tclIOCmd.c: * generic/tclIOUtil.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclLoad.c: * generic/tclStubInit.c: * generic/tclTest.c: * generic/tclUtil.c: * library/init.tcl: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacInit.c: * mac/tclMacPort.h: * mac/tclMacResource.c: * mac/tclMacTime.c: * tests/cmdAH.test: * tests/event.test: * tests/fCmd.test: * tests/fileName.test: * tests/io.test: * tests/ioCmd.test: * tests/proc-old.test: * tests/registry.test: * tests/unixFCmd.test: * tests/winDde.test: * tests/winFCmd.test: * unix/mkLinks: * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * unix/tclUnixInit.c: * unix/tclUnixPipe.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclWinInit.c: * win/tclWinPipe.c: 2001-07-24 Mo DeJong * win/tclWinThrd.c (Tcl_CreateThread): Close Windows HANDLE returned by _beginthreadex. The MS documentation states that this handle is not closed by a later call to _endthreadex. 2001-07-21 Don Porter * doc/pkgMkindex.n: * library/package.tcl: Corrected documentation and usage message of [pkg_mkIndex]. 2001-07-18 Mo DeJong * generic/tclPlatDecls.h: Define TCHAR by including windows.h instead of tchar.h since Cygwin does not support the tchar.h header. Include CHECK_UNICODE_CALLS logic from tclWinPort.h. * win/tclWinPort.h: Remove CHECK_UNICODE_CALLS logic. Remove include of windows.h since this now done it tclPlatDecls.h. * win/tclWinReg.c: Remove duplicate include of windows.h. 2001-07-18 Andreas Kupries * generic/tclIO.c: Aftermath to [Bug 427196]. Squash empty buffers if they are smaller than the requested buffersize, to prevent reusage of old buffers and to honor changes in the requested buffersize made by the user. 2001-07-17 Mo DeJong * win/tclWinFile.c (TclpReadlink): Add Cygwin specific definition for the TclpReadlink function. This method implements reading of symbolic links when build with Cygwin. 2001-07-17 Mo DeJong * win/tclWinPort.h: Add Cygwin specific defines for environ and timezone variables. 2001-07-17 Andreas Kupries * generic/tclIO.c (GetInput): Fixed [Bug 427196]. Memory was overwritten because a buffer was used after a change of the requested buffersize together with that requested buffersize and not its actual size, which was smaller. Note that the continous reuse of the smaller buffer negatively impacts performance. The system never allocates a buffer with the newly requested bigger buffersize. 2001-07-16 Mo DeJong * generic/tcl.h: Define __WIN32__ when __CYGWIN__ or __MINGW32__ is defined. * generic/tclAlloc.c: Define caddr_t when compiling with VC++ or mingw. This type is already defined when compiling with Cygwin. 2001-07-16 Mo DeJong * win/tclWinConsole.c: * win/tclWinPipe.c: * win/tclWinPort.h: * win/tclWinSerial.c: * win/tclWinThrd.c: Remove unnecessary #includes of dos.h, direct.h, and tchar.h. This will help the Cygwin porting effort since these headers do not exist under Cygwin. 2001-07-16 Jeff Hobbs * win/tclWinPipe.c (PipeClose2Proc): constrained the mutex lock to just the TerminateThread call and waiting for termination. (jsmith) * generic/tclCmdMZ.c: Removed extra copy of the SCAN_* macros #defined in generic/tclScan.c. [Bug 441230] (porter) 2001-07-12 Donal K. Fellows * tests/unixInit.test (unixInit-2.8): Added extra constraint, notInstalledInTmp, to stop this test from damaging installations in /tmp; not much fun to have to reinstall the Tcl library every time you run the test suite! * tests/subst.test (subst-10.*): Updated tests to check new behaviour for 'break' in command substitutions. (subst-1.2,subst-7.1): Error messages changed. * doc/SubstObj.3: New file, to document Tcl_SubstObj. * doc/subst.n: Improved and updated documentation for 'subst' to help support the changed behaviour. * generic/tcl.decls (generic-437): Declaration for Tcl_SubstObj * generic/tcl.h (TCL_SUBST_*): Added flags for Tcl_SubstObj. * generic/tclCmdMZ.c (Tcl_SubstObj,Tcl_SubstObjCmd): Divided into two parts to allow people to access the innards of 'subst' and changed the behaviour when command substitutions do a 'break' to be different from 'continue'. Also now works with objects, which allows for some nifty optimisations with variable substitutions and a slight improvement with command substitutions. [TIP#36] 2001-07-10 Mo DeJong * unix/Makefile.in: Add AR variable for use in STLIB_LD. * unix/configure: Regen. * unix/configure.in: Use STLIB_LD when defining MAKE_LIB and MAKE_STUB_LIB. Subst RANLIB and AR. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add doc comment about STLIB_LD command. Check ${AR} env var when setting STLIB_LD and delay evaluation until make time. * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): Delay evaluation of ${AR} in STLIB_LD and add flags to better match the Unix implementation. Don't bother defining AR when using VC++ since it is not used. 2001-07-06 Mo DeJong * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): Pass -e _WinMain@16 in addition to the -mwindows flag to work around a problem with ld when it incorrectly use main() as the executable entry point when both WinMain() and main() are available. 2001-07-06 Donal K. Fellows * tests/cmdAH.test: Added leading zero to file modes to work around fault in HPUX strtol() which ignores the base parameter. [Bug 438808] 2001-07-05 Mo DeJong * win/Makefile.in: Subst DEPARG directly instead of relying on a variable. This will make Cygwin builds faster since an extra exec will be avoided. * win/configure: Regen. * win/configure.in: Subst DEPARG. * win/tcl.m4 (SC_CONFIG_CFLAGS): Move AC_MSG_CHECKING after the AC_CHECK_PROG so that status messages do not get mixed together. Set DEPARG based on the results of the cygpath check so that we avoid using an extra exec when it is not needed. Use ac_cv_cygwin status flag instead of looking at the output of gcc -v, which works in the case where -mno-cygwin is set in the CFLAGS. 2001-07-04 Jeff Hobbs * README: * mac/README: * unix/README: * win/README: * win/README.binary: updated READMEs with purls 2001-07-03 Mo DeJong * win/Makefile.in: Remove PATHTYPE variable. * win/configure: Regen. * win/configure.in: Don't subst PATHTYPE. * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove PATHTYPE variable. Set CYGPATH to "cygpath -w" if the cygpath executable is found on the path. This approach works for native Cygwin builds and cross compiles. 2001-07-03 Jeff Hobbs * tests/var.test: * generic/tclVar.c (Tcl_VariableObjCmd): added patch to check for number of args. [Patch 426038] * generic/tclVar.c (Tcl_GetVar2Ex): added ability to recognize TCL_TRACE_READS flags to cause creation of part1 in TclLookupVar to make sure newly created array will get read traces triggered appropriately. This is called by Tcl_ObjGetVar2, Tcl_GetVar, and Tcl_GetVar2. (TclSetIndexedScalar, TclSetElementOfIndexedArray): added read trace triggering for lappend case. (Tcl_LappendObjCmd): pass TCL_TRACE_READS to Tcl_ObjGetVar2 to trigger possible read traces for new arrays. * generic/tclExecute.c (TclExecuteByteCode): added TCL_TRACE_READS flag to INST_LAPPEND(_ARRAY)_STK case to trigger read traces for newly created arrays. Removed unnecessary #ifdef for TCL_COMPILE_DEBUG in INST_LOAD_SCALAR1 case. * tests/append.test: * tests/appendComp.test: added tests for read trace triggering for append and lappend. 2001-07-03 Mo DeJong * tests/clock.test (clock-2.5): Adjust test so that it passes when the time slice is 60 msecs, now passes under Windows 98. 2001-07-03 Mo DeJong * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't pass the v flag to ${AR} when using gcc, verbose output is not needed. 2001-07-03 Don Porter * tests/unixInit.test (unixInit-2.8): Changed test back to using installation layout, adding comments explaining why the test writes to the directories it does, and checks to avoid destroying other files in /tmp. 2001-07-03 Donal K. Fellows * tests/unixInit.test (unixInit-1.2): Fixed faults reported in [Bug 438070] - well, at least enough to work on Solaris - and added comments that should make what is going on in the test clearer. 2001-07-02 Jeff Hobbs * tests/util.test: added util-4.6 * generic/tclUtil.c (Tcl_ConcatObj): Corrected walking backwards over utf-8 chars. [Bug 227512] 2001-07-02 Don Porter * tests/unixInit.test (unixInit-2.8): Corrected test for all absolute pathnames in library path when executable is installed near root directory to use correct development directory layout. [Bug 438014] * tests/unixInit.test (unixInit-2.9): * unix/tclUnixInit.c (TclpInitLibraryPath): * win/tclWinInit.c (TclpInitLibraryPath): Corrected buggy construction of search path entries relative to executable. Added test for bad construction. [Bug 438014] 2001-06-28 Miguel Sofer * generic/tclNamesp.c: Correction to faulty patch from [Bug 231259] 2001-06-28 Donal K. Fellows * tests/unixInit.test (unixInit-1.2): Modified so as not to require a local echo service, which fails on many systems which have that turned off for security reasons... 2001-06-27 Jeff Hobbs * generic/tclInt.h: * generic/tclObj.c: * unix/Makefile.in: added a -DPURIFY mode that makes Tcl_Obj's allocated and free singularly (instead of in alloc in blocks and never free) to allow checkers like Purify to operate better. * library/encoding/koi8-u.enc: added koi8-u (Ukranian variant) encoding. * tests/subst.test: * generic/tclUtf.c (Tcl_UtfBackslash): Corrected backslash handling of multibyte utf-8 chars. [Bug 217987] * generic/tclCmdIL.c (InfoProcsCmd): fixed potential mem leak in info procs that created objects without using them. * generic/tclCompCmds.c (TclCompileStringCmd): fixed mem leak when string command failed to parse the subcommand. * doc/interp.n: * doc/unknown.n: updated notes about what is in a safe interp. [Bug 218605] 2001-06-27 Donal K. Fellows * tests/event.test (event-11.5): Removed hard-coded port number which could fail on some systems. [Bug 436727] 2001-06-26 Mo DeJong * unix/Makefile.in: * win/Makefile.in: Add `make shell` target. This target will set the proper env vars before invoking tclsh from the build directory. 2001-06-26 Mo DeJong * win/Makefile.in: Use : to separate VPATH entries. This works for both Cygwin builds and cross builds, the VPSEP variable is simply unneeded complexity. * win/configure: Regen. * win/configure.in: Don't subst VPSEP. * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove VPSEP variable. 2001-06-26 Mo DeJong * unix/configure: Regen. * unix/configure.in: Fix last checkin by removing export since that only works in bash. * win/configure: Regen. * win/configure.in: Ditto. 2001-06-26 Mo DeJong * unix/configure: Regen. * unix/configure.in: Set CFLAGS to "" if the user did not set CFLAGS in the env. This keeps AC_PROG_CC from adding "-g -O2" to the CFLAGS by default. * win/configure: Regen. * win/configure.in: Ditto. 2001-06-25 Mo DeJong * win/configure: Regen. * win/configure.in: Use RC_DEFINE flag from tcl.m4. * win/tcl.m4 (SC_CONFIG_CFLAGS): Set RC_DEFINE flag based on the compiler in use. 2001-06-25 Mo DeJong * win/tcl.m4 (SC_CONFIG_CFLAGS): Link to the imm32 library when building with mingw gcc. 2001-06-25 Mo DeJong * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): When building with gcc, don't attempt to link with LD or support dllwrap. Simply require a recent version of Cygwin gcc or Mingw gcc that supports -shared. When linking, use gcc instead of ld since gcc automatically includes libs like -lmsvcrt. 2001-06-22 Mo DeJong * win/configure: Regen. * win/configure.in: Add resource compiler fix from 8.3.3 to fix compiling with mingw. 2001-06-22 Mo DeJong * win/configure: Regen. * win/tcl.m4: Fix silly typo in last checkin. 2001-06-22 Mo DeJong * unix/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@. Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. Add LDFLAGS_DEBUG and LDFLAGS_OPTIMIZE to match the way CFLAGS_DEFAULT works. This will support user set CFLAGS or LDFLAGS at configure time. * unix/configure: Regen. * unix/configure.in: Don't set CFLAGS to CFLAGS_DEFAULT, instead subst CFLAGS_DEFAULT into the Makefile. Add AC_SUBST for CFLAGS_DEFAULT, LDFLAGS_DEFAULT, LDFLAGS_DEBUG, and LDFLAGS_OPTIMIZE. * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that it uses a Makefile variable just like CFLAGS_DEFAULT. * win/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@. Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. This will support user set CFLAGS or LDFLAGS at configure time. * win/configure: Regen. * win/configure.in: Don't set CFLAGS or LDFLAGS, instead subst CFLAGS_DEFAULT and LDFLAGS_DEFAULT into the Makefile. * win/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that it uses a Makefile variable just like CFLAGS_DEFAULT. 2001-06-22 Mo DeJong * win/configure: * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't set LDFLAGS_DEBUG to -g or LDFLAGS_OPTIMIZE to -O when compiling with gcc. These flags are not needed and can cause problems with the Cygwin version of ld. 2001-06-18 Donal K. Fellows * tests/unixInit.test (unixInit-1.2,unixInit-2.8): Added test for code described below, and fixed a couple of errors that caused problems during testing; the code to determine the installedTcl constraint was wrong, and test unixInit-2.8 assumed that /tmp/lib was free for use and could be deleted, which clashed nastily with my installation and made other tests fail unnecessarily! * unix/tclUnixChan.c (TtyInit,TclpOpenFileChannel, (Tcl_MakeFileChannel,TclpGetDefaultStdChannel): Alterations so that the standard channels - stdin, stdout and stderr - have the correct type and fconfigure options. This required making the initialisation of serial lines a little more sophisticated to make the console behave correctly in interactive mode... [Bug 219137 and duplicates] 2001-06-16 Don Porter * generic/tclInt.decls: * generic/tclInt.h: * generic/tclPanic.c (Tcl_PanicVA): * mac/tclMacAppInit.c (main): * mac/tclMacPanic.c (TclpPanic): * unix/tclUnixPort.h: * win/tclWinPort.h: Replaced TclMacSetPanic with TclpPanic for setting a platform-specific panic handler. TclpPanic is NULL on Unix and Windows. Fixes broken wish on Mac due to earlier patches. [Patch 415648] * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: `make gentubs` after above changes. 2001-06-13 Don Porter * mac/tclMacAppInit.c (main, Macintosh_Init): * mac/tclMacBOAAppInit.c (main): * mac/tclMacPanic.c: Applied patches from Dan Steffen correcting problems on the Macintosh in the 2001-06-08 changes. 2001-06-12 Donal K. Fellows * tests/regexp.test (regexp-18.12): * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): Fixed so that submatches that do not match always have index pair {-1 -1} [Bug 219232] 2001-06-08 Don Porter * generic/tcl.h: * generic/tcl.decls: * generic/tclPanic.c: Added CONST to Tcl_*Panic* public interfaces. [Patch 415648, TIP 27] * generic/tclInt.decls: * mac/tclMacAppInit.c (main): * mac/tclMacBOAAppInit.c (main): * mac/tclMacPanic.c: Modified special Mac implementations of Tcl_*Panic* to be exact copies of the generic implementations. Added TclMacSetPanic. The generic implementations should be used directly, rather than copies, but that requires further changes by someone familiar with the Mac build systems. [Patch 415648] * generic/tclDecls.h: * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: `make gentubs` after above changes. * doc/Panic.3: * unix/mkLinks: New file documenting Tcl_*Panic* public interfaces, followed by `make mklinks`. [Patch 415648, Bug 219170, Bug 414936] 2001-06-03 Jeff Hobbs * generic/tclUtil.c (Tcl_DStringAppendElement): patch to save an extra strlen call. [Bug 428572] 2001-05-30 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Added two casts to INST_STR_CMP implementation to get rid of a couple warnings from the SUNWspro C compiler. * generic/tclBasic.c (Tcl_GetMathFuncInfo,Tcl_ListMathFuncs): * generic/tclCmdIL.c (Tcl_InfoObjCmd,InfoFunctionsCmd): * generic/tcl.decls (generic table, positions 435+436): * tests/info.test: * doc/CrtMathFnc.3: * doc/info.n: Changes due to TIP #15 "Functions to List and Detail Math Functions" 2001-05-28 Jeff Hobbs * library/init.tcl (unknown): removed errant " in error message 2001-05-27 Jeff Hobbs * generic/regc_locale.c: updated character class range data for Unicode v3.1.0 compliance. * generic/tclUniData.c: regenerated from Unicode v3.1.0 data file (new as of 2001-05-16). This brings Tcl to current unicode compliance. * tests/utf.test: added tests to check unicode 3 compliance * unix/Makefile.in (tclUtf.o): added tclUniData.c dependency. * tools/uniClass.tcl: added comments to output format and the script for clarification. * tools/uniParse.tcl: corrected filename output and GetDelta macro to use 'info' as param (was 'infO') 2001-05-26 Donal K. Fellows * generic/tclVar.c (tclArraySearchType,SetArraySearchObj, (ParseSearchId): Added code to speed up array searching by reducing the amount of parsing needed for searchIds. * generic/tclObj.c (TclInitObjSubsystem): * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): * generic/tclNamesp.c (TclInitNamespaceSubsystem): * generic/tclInt.h: Moved some Tcl_ObjType initialisation to TclInitObjSubsystem to be with the bulk of the rest. [Patch 424851] Committed by Miguel Sofer 2001-05-23 Jeff Hobbs * tests/io.test: changed io-52.[9-11] to not be platform sensitive with EOL translation. * library/encoding/cp1250.enc: * library/encoding/cp1251.enc: * library/encoding/cp1252.enc: * library/encoding/cp1253.enc: * library/encoding/cp1254.enc: * library/encoding/cp1255.enc: * library/encoding/cp1256.enc: * library/encoding/cp1257.enc: * library/encoding/cp1258.enc: * library/encoding/cp874.enc: * library/encoding/iso8859-6.enc: * library/encoding/iso8859-7.enc: * library/encoding/iso8859-8.enc: * library/encoding/iso8859-10.enc (new): * library/encoding/iso8859-13.enc (new): * library/encoding/iso8859-14.enc (new): updated encoding tables based on http://www.unicode.org/Public/MAPPINGS/. (kuhn) 2001-05-23 Mo DeJong * unix/tcl.m4 (SC_PATH_TCLCONFIG): Fix comments, and typo in cached variable name. 2001-05-23 Mo DeJong * unix/tcl.m4 (SC_LOAD_TKCONFIG): Remove use of undefined TCLCONFIG variable and call AC_MSG_RESULT to print the checking result. * win/tcl.m4: Ditto. 2001-05-22 Jeff Hobbs * generic/tclObj.c (TclAllocateFreeObjects): simplified objSizePlusPadding to use sizeof(Tcl_Obj) (max) Corrected use of tclObjsAlloced/Freed/Shared in TCL_MEM_DEBUG compile. 2001-05-22 Miguel Sofer * generic/tclExecute.c: removed Tcl_DuplicateObj in INST_DUP 2001-05-21 Jeff Hobbs * tests/tcltest.test (tcltest-19.1): fixed failing test that was getting affected by Windows env handling of empty valued elements. * unix/tcl.m4: added more common install directories in which to search for *Config.sh. [Bug 419812] * tests/cmdMZ.test (cmdMZ-1.4): added notLinux constraint to test to prevent failure message on Linux due to OS caching bug. * tests/httpd (httpdRespond): added response to timeout value in query string. * tests/http.test: removed unused notLinux constraint setting * generic/tclRegexp.c (Tcl_RegExpExecObj): added use of Tcl_GetUnicodeFromObj. 2001-05-19 Andreas Kupries * Note that "tclbench" (see project "tcllib") was extended with performance benchmarks for [fcopy] too. * doc/fcopy.n: Updated to reflect the extended behaviour of 'fcopy'. * tests/io.test: Added tests 'io-52.9', 'io-52.10' and 'io-52.11' to test the handling of encodings by 'fcopy' / 'TclCopychannel'. [Bug 209210] * generic/tclIO.c: Split of both 'Tcl_ReadChars' and 'Tcl_WriteChars' into a public error checking and an internal working part. The public functions now use the new internal ones. The new functions are 'DoReadChars' and 'DoWriteChars'. Extended 'CopyData' to use the new functions 'DoXChars' when required by the encodings on the input and output channels. [Bug 209210] 2001-05-16 Jeff Hobbs * library/history.tcl (tcl::HistAdd): prevent empty calls from being added to the history (arndt) * tests/error.test: updated error-1.3 message to account for string index being compiled at toplevel. * tests/appendComp.test: * tests/stringComp.test: new files for extended bytecode testing * generic/tclBasic.c: added new CompileProc invocations to basic command initialization. * generic/tclCompCmds.c: added new compile commands for append, lappend, lindex and llength. Refactored set and incr compile commands to use new TclPushVarName function for handling the varname component during compilation (also used by append and lappend). Changed string compile command to compile toplevel code as well (when possible). * generic/tclCompile.c: added new instruction enums * generic/tclCompile.h: added debug info for new instructions * generic/tclExecute.c (TclExecuteByteCode): moved elemPtr to toplevel var (oft-used). Added definitions for new bytecode instructions INST_LIST_INDEX, INST_LIST_LENGTH, INST_APPEND_SCALAR1, INST_APPEND_SCALAR4, INST_APPEND_ARRAY1, INST_APPEND_ARRAY4, INST_APPEND_ARRAY_STK, INST_APPEND_STK, INST_LAPPEND_SCALAR1, INST_LAPPEND_SCALAR4, INST_LAPPEND_ARRAY1, INST_LAPPEND_ARRAY4, INST_LAPPEND_ARRAY_STK, INST_LAPPEND_STK. Refactored repititious code for reuse with INST_LOAD_STK (same as INST_LOAD_SCALAR_STK), INST_STORE_STK (same as INST_STORE_SCALAR_STK). Updated INST_STR_CMP with style of fix of 2001-04-06 Fellows [Bug 219201] as that fix only affected the runtime eval'ed "string" (string compare is normally byte-compiled now). We may want to back these out for speed in the future, noting the problems with \x00 comparisons in the docs. * generic/tclInt.h: declarations for new compile commands. * generic/tclVar.c: change TclGetIndexedScalar, TclGetElementOfIndexedArray, TclSetElementOfIndexedArray and TclSetIndexedScalar to use flags. The Set functions now support TCL_APPEND_ELEMENT and TCL_LIST_ELEMENT as well. * generic/tclInt.decls: * generic/tclIntDecls.h: minor signature changes for above. * generic/tclCmdMZ.c: made use of new Tcl_GetUnicodeFromObj. 2001-05-16 Donal K. Fellows * doc/console.n: Deleted. Put it in the wrong source tree! D'oh! 2001-05-15 Jeff Hobbs * generic/tcl.decls: * generic/tclDecls.h: * generic/tclStubInit.c: * generic/tclStringObj.c (Tcl_GetUnicodeFromObj): new function to parallel Tcl_GetStringFromObj (fix of an API oversight). * unix/tclUnixPipe.c: updated pipeChannelType to TCL_CHANNEL_VERSION_2 type specification. * tests/fileName.test: corrected tests not to fail on win when a C:/test dir exists. * generic/tclFileName.c (ExtractWinRoot): corrected ABR error 2001-05-15 Miguel Sofer * tests/lindex.test: added test for nested braces [Patch 423617] 2001-05-15 Miguel Sofer * generic/tclInt.h: * generic/tclNamesp.c: invalidate all bytecodes in a namespace if a new command shadows a bytecoded command. * tests/namespace.test: Patched from [Bug 231259] 2001-05-15 Donal K. Fellows * doc/console.n: Created. It seems very odd to me that the console implementation is part of the Tcl distribution and not part of Tk, but given the location of the source, the documentation must obviously match up... 2001-05-14 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_StringObjCmd): * tests/string.test (string-4.14): Negative string indices should not be added as offsets to the result of [string first] but instead be treated as referring to the start of the string. [Bug 423581] 2001-05-11 Mo DeJong * unix/Makefile.in: Add a LDFLAGS variable to the Makefile instead of directly substing @LDFLAGS@. * unix/configure: Regen. * unix/tcl.m4: Fix CFLAGS_DEFAULT so that the name of a Makefile variable is passed as @CFLAGS@. * win/Makefile.in: Move the setting of CFLAGS higher up in the Makefile. * win/configure: Regen. * win/configure.in: Use dnl to comment out macros so that they are not accidently expanded. * win/tcl.m4: Fix CFLAGS_DEFAULT so that the name of a Makefile variable is passed as @CFLAGS@. 2001-05-07 Miguel Sofer * generic/tclExecute.c: insure different rand() seeds in different threads. [Bug 416643] 2001-05-03 Jeff Hobbs * tests/tcltest.test: removed extraneous 'c' (doh!) [Bug: 414031] * tools/tcltk-man2html.tcl: removed use of 'exec' for portability and fixed up code. 2001-05-03 Don Porter * doc/library.n: * library/init.tcl: * tests/autoMkindex.t*: Modified [auto_import] to apply pattern matching in the [namespace import] style. [Bug 420186] ***POTENTIAL INCOMPATIBILITY*** for any callers of [auto_import] from outside Tcl that expect the pattern matching to be like that of [string match]. 2001-05-03 Miguel Sofer * generic/tclParse.c: * tests/namespace.test: Insure consistent behaviour of the [unknown] command: when a command is unknown, it is always processed by [::unknown], ignoring any namespace proc which happens to be called "unknown" [Patch 421166, Bug 420507] 2001-05-02 Don Porter * tools/genStubs.tcl: Add a package require of Tcl 8 at the beginning of the script so that the script will print a descriptive error message when run in an old Tcl 7 shell. 2001-04-27 Kevin Kenny * generic/tclInt.decls: * generic/tclInt.h: * generic/tclCmdIL.c: * generic/tclProc.c: * generic/tclVar.c: Added another collection of missing CONSTs related to TclGetNamespaceForQualName. * generic/tclIntDecls.h: Regenerated. 2001-04-25 Mo DeJong * unix/configure: Regen. * unix/tcl.m4: Subst TCL_THREADS into tclConfig.sh. * unix/tclConfig.sh.in: Add TCL_THREADS variable. * win/configure: Regen. * win/tcl.m4: Subst TCL_THREADS into tclConfig.sh. * win/tclConfig.sh.in: Add TCL_THREADS variable. 2001-04-25 Mo DeJong * unix/configure: Regen. * unix/configure.in: Use $@ in MAKE_LIB and MAKE_STUB_LIB commands instead of using a delayed subst variable. Replace instances of STUB_LIB_FILE with TCL_STUB_LIB_FILE. 2001-04-25 Mo DeJong * unix/Makefile.in: Use TCL_STUB_LIB_FILE instead of STUB_LIB_FILE. * unix/configure: Regen. * unix/configure.in: Don't subst STUB_LIB_FILE, use TCL_STUB_LIB_FILE instead. 2001-04-25 Donal K. Fellows * tools/encoding/iso8859-15.txt: * library/encoding/iso8859-15.enc: Oops! Got the full encoding wrong. Should be fixed now... * tools/encoding/iso8859-15.txt: * library/encoding/iso8859-15.enc: * tools/tcl.wse.in: Added ISO 8859-15 (a.k.a. Latin-1 + Euro currency symbol) support. * generic/tclNamesp.c: * generic/tclBasic.c (TclRenameCommand): Missing CONST from several declarations relating to use of TclGetNamespaceForQualName 2001-04-24 Kevin B. Kenny * doc/AssocData.3: * doc/CrtCommand.3: * doc/CrtMathFnc.3: * doc/CrtObjCmd.3: * doc/ExprLong.3: * generic/tclBasic.c: * generic/tclCmdMZ.c: * doc/CrtSlave.3: * generic/tclNamesp.c: * generic/tcl.decls: * generic/tcl.h: * generic/tclInt.decls: * generic/tclInt.h: (TIP #27) Another round of CONST changes, this time adding CONST to the API's exported from tclBasic.c. [Patch 415179] ***POTENTIAL INCOMPATIBILITY*** from 8.4a2, in which Vince Darley's changes to command tracing were added. A const has been added to the type signature of one of the parameters to Tcl_CommandTraceProc. 2001-04-10 Kevin B. Kenny * unix/tclUnixTime.c: Altered code to use memcpy instead of structure assigments in an effort to achieve better K&R compatibility. 2001-04-10 Kevin B. Kenny * unix/tclUnixTime.c: Fixed silly typo in calls to 'gmtime' and 'localtime' that broke the Linux build. 2001-04-09 Kevin B. Kenny * unix/tclLoadShl.c: Added DYNAMIC_PATH to the load flags so that the SHLIB_PATH will be searched for other libraries. [Bug 219140] 2001-04-09 Kevin B. Kenny * unix/tcl.m4: Added _REENTRANT to Solaris build so that thread safe library routines are included. * unix/configure: Re-ran 'autoconf' with changed tcl.m4 * tclUnixTime.c: Modified for thread safety of 'gmtime' and 'localtime' system calls. [Bugs 219136 and 232558] 2001-04-09 Donal K. Fellows * tests/expr.test (expr-21.*): Tests to check below fix. * generic/tclParseExpr.c (GetLexeme): Now recognises the non-numeric boolean literals for what they are. It no longer makes sense for anyone to create functions with the same name as one of them, but this was true in 7.* as well [Bug 217777; finally!] 2001-04-07 Miguel Sofer * generic/tclExecute.c: Avoid panic when there are extra items in the tcl stack. [Bug 406709, Patch 414470] * tests/foreach.test: test to exercise the patch 2001-04-07 Miguel Sofer * doc/namespace.n: document correct functionality * generic/tclNamesp.c: corrected behaviour of [namespace code] [Bug 219385, Patch 403530] * library/init.tcl: * tests/namespace-old.test: test correct functionality * tests/namespace.test: test correct functionality 2001-04-07 Andreas Kupries * unix/Makefile.in (checkdoc): New target, checking the definitions as found in the compiled library against the manpages to find undocumented public functionality. * unix/mkLinks: Updated to include the new manpage. * doc/UniCharIsAlpha.3: New manpage documenting the Unicode character classification APIs. [Bug 218720] 2001-04-07 Andreas Kupries * unix/mkLinks: Updated to incorporate the changes below. * doc/StringObj.3: Added 'Tcl_AttemptSetObjLength' to the NAME section. [Bug 414435] * doc/Alloc.3: Added both 'Tcl_AttemptAlloc' and 'Tcl_AttemptRealloc' to the NAME section. [Bug 414435] * doc/Utf.3: Added both 'Tcl_UniCharCaseMatch' and 'Tcl_UniCharNcasecmp' to the NAME section. [Bug 414435] 2001-04-06 Don Porter * library/init.tcl: * tests/init.test: Modified processing of $::errorInfo by [unknown] when the auto-loaded command throws an error to better cover the tracks of auto-loading. [Bug 219280, Patch 403551] 2001-04-06 Donal K. Fellows * doc/read.n: Added section on "USE WITH SERIAL PORTS" to resolve [Bug 219402] * tests/string.test (string-2.30): Test for this case * generic/tclCmdMZ.c (Tcl_StringObjCmd, STR_COMPARE branch): Fixed problem caused by Utf-rep of \x00 being more than Utf-rep of \x01 fooling memcmp by forcing everything through Utf-based comparisons. Added optimizations for case where objects have a string/unicode-rep or a bytearray-rep (i.e. where we can perform comparisons on fixed-size units). [Bug 219201] * generic/tclUtf.c (Tcl_UtfNcmp): Corrected seriously erroneous comment. 2001-04-05 Andreas Kupries * doc/Macintosh.3: Removed duplicates from .SH line. [Bug 413983] 2001-04-05 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_StringObjCmd): Fixed so will compile with K&R compilers. [Patch 413844, Bug 413847] 2001-04-04 Don Porter * generic/tclMain.c: Patch from Kevin Kenny to restore support of pre-ANSI compilers. [Bug 413846, Patch 413842] 2001-04-04 Andreas Kupries * unix/mkLinks: Updated to contain the new manpage. * doc/Environment.3: New manpage, describes Tcl_PutEnv. [Bug 219171] * doc/Macintosh.3: New manpage describing the macintosh specific parts of the public API. [Bug 219169] 2001-04-04 Jeff Hobbs * unix/configure: * unix/tcl.m4: extended test of termios vs. termio vs. sgtty to better detect result on Linux and when certain configure redirections are being used. [Patch 402923; Bug 227412, 219194] (max) 2001-04-04 Andreas Kupries * generic/tclTest.c: * tests/io.tests: TIP #10 followup correcting a problem with the original patch because of the lack of 'testthread id' for a non-threaded compilation. 2001-04-04 Kevin Kenny * doc/ByteArrObj.3: * doc/DumpActiveMemory.3: * doc/InitStubs.3: * doc/PkgRequire.3: * doc/StringObj.3: * generic/tcl.decls: * generic/tcl.h: * generic/tclBinary.c: * generic/tclCkalloc.c: * generic/tclDecls.h: * generic/tclListObj.c: * generic/tclObj.c: * generic/tclPkg.c: * generic/tclStringObj.c: * generic/tclStubLib.c: (TIP#27) Changed a number of Tcl API's to accept "CONST char*" in place of simple "char*". (kennykb) [Patch 404026] 2001-04-04 Jeff Hobbs * generic/tclListObj.c (Tcl_SetListObj): set objPtr->length = 0 in empty object case to maintain sanctity of Tcl_Obj bytes/length pairing. [Patch 405998] (porter) 2001-04-03 Andreas Kupries * unix/mkLinks: Added 'Signal.3', 'Tcl_WaitPid'. * doc/DetachPids.3: Added description of 'Tcl_WaitPid' [Bug 219173]. * doc/Signal.3: New man page describing the public API procedures 'Tcl_SignalId' and 'Tcl_SignalMsg'. [Bug 219172] 2001-04-02 Jeff Hobbs * README: * win/README: * win/README.binary: further notes corrections. * win/configure: * win/tcl.m4 (SHLIB_LD): added -incremental:no. [Bug 219381] 2001-04-01 Jeff Hobbs * README: * mac/README: * win/README: * win/README.binary: * unix/README: updated patchlevel information to 8.4a3 and updated links and notes. * generic/tcl.h: * tools/tcl.wse.in: * win/configure.in (VER): * win/configure: * unix/configure: * unix/configure.in (VER): * unix/tcl.spec: updated patchlevel information to 8.4a3 2001-03-30 Jeff Hobbs * generic/tclCkalloc.c (TclFinalizeMemorySubsystem): set curTagPtr to NULL to allow for reuse. * generic/tclEvent.c (Tcl_Finalize): moved the tsdPtr initialization inside the subsystemsInitialized check to prevent it potentially getting called twice during finalization. [Patch 403532, Bug 219391] (wu) * generic/tclThreadTest.c (Tcl_ThreadObjCmd): cast fixes * generic/tclTest.c (TestChannelCmd): added cast to mollify Windows debug build. * win/tclWinSock.c (SocketEventProc): Fixed race condition in readability of socket on Windows. [Patch 410674, Bug 219205, 219333] * win/tcl.m4: added imm32.lib to LIBS_GUI for Tk IME support. * win/Makefile.in (install-libraries): removed extra \s that broke the target. (install-doc): improved install-* targets to use their base build dependency. 2001-03-30 Andreas Kupries * All of the changes below belong to TIP #10 [Tcl I/O Enhancement: Thread-Aware Channels]. See also [Patch 403358] at SF. * generic/tclIO.h (struct ChannelState, line 236f): Extended the structure with a new field of type 'Tcl_ThreadId' to hold the id of the thread currently managing all channels with this state. Note: This structure is shared by all channels in a stack of transformations. * generic/tclIO.c (Tcl_CreateChannel, lines 1058-1065): Modified to store the Id of the current thread in the 'ChannelState' of the new channel. * generic/tclIO.c (Tcl_SpliceChannel, lines 2265-2270): Modified in the same manner as 'Tcl_CreateChannel' as the channel will be managed by the current thread afterward. * generic/tclIO.c (Tcl_GetChannelThread, lines 1478-1503): * generic/tcl.decls (Tcl_GetChannelThread, lines 1504-1506): New API function to retrieve the Id of the managing thread from a channel. Implementation and declaration. * generic/tclTest.c (TestChannelCmd, lines 4520-4532): Added subcommand 'mthread' to query a channel about its managing thread. 2001-03-29 Mo DeJong * tests/interp.test: Print out warning when testinterpdelete command is not defined. Add tests that checks to make sure a child interp inherits the parent's cwd. 2001-03-29 Jeff Hobbs * doc/tcltest.n: corrected incorrect macro usage. * doc/lsort.n: corrected unbalanced nroff macros. * unix/tclUnixPipe.c (TclpCreateTempFile): prevent potential race condition and security leak in tmp filename creation. [Patch 402924] (max) * unix/configure: * unix/tcl.m4: corrected IRIX-5.x config to not use -n32. [Patch 403626] (english) * unix/tclUnixThrd.c (Tcl_ConditionWait): fixed handling of timeout for threads (corrects excessive CPU usage issue for Tk on Unix in threaded Tcl environment). [Bug 411603] (ruppert) 2001-03-29 Donal K. Fellows * doc/lsort.n: Added some notes that clarify the behaviour of [lsort] as well as a whole bunch of examples. [Bug 219202] 2001-03-27 Jeff Hobbs * doc/Alloc.3: corrected docs to note that Tcl_Attempt* return char *'s, not ints. [Bug 411388] * tests/regexp.test (regexp-19.1): * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): fixed handling of nulls in subspec value. 2001-03-26 Don Porter * generic/tclDecls.h (Tcl_InitCustomHashTable): Correction to patch from 2001-01-18; tclDecls.h was not generated using 'make genstubs'. 2001-03-26 Donal K. Fellows * win/tclWinInt.h (tclWinTCharEncoding): Removed as now a static variable in win/tclWin32Dll.c instead. 2001-03-23 Jeff Hobbs * generic/tclVar.c (Tcl_ArrayObjCmd): Corrected retrieval of resultPtr to prevent possible corruption. * generic/tclNamesp.c (Tcl_Import): Correctly freed a DString. [Patch 403755] (lavana) 2001-03-15 Donal K. Fellows * tests/set-old.test (set-old-7.2): Changed error behaviour of [unset] to agree with documentation, so must change test as well. 2001-03-14 Don Porter * library/package.tcl (pkg_mkIndex): Added patch from Vince Darley to make [pkg_mkIndex -verbose] even more verbose. [Bug 219349, Patch 403529] 2001-03-13 Donal K. Fellows * doc/info.n: Improved documentation for [info hostname]. [Bug 403840] * generic/tclVar.c (Tcl_UnsetObjCmd): Made command behave as documented [issue remaining from Bug 405769] * generic/tclCmdMZ.c (Tcl_StringObjCmd): A missing {return TCL_OK;} was causing memory corruption. [Bug 408002] * generic/tclExecute.c (TclDeleteExecEnv, GrowEvaluationStack, (TclExecuteByteCode): Added some casts to ClientData that are apparently needed on some architectures. 2001-03-12 Donal K. Fellows * tests/string.test: Fixed some test numberings and added a test. [Patch 403229] 2001-03-06 Donal K. Fellows * generic/tclVar.c (Tcl_UnsetObjCmd): Rewrote argument parser to avoid a read off the end of the argument array that could occur when executing something like [unset -nocomplain] was executed. Improved the error message given when not enough arguments are given (-nocomplain should obviously be *before* --, not after it) and also modified the test suite to take account of that and the documentation to use the same improvement. [Bug 405769] 2001-03-02 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Fixed bug that could pass pointers to freed memory to command implementations, which most obviously caused some weird behaviour with [info level], but could have caused problems with user code and command traces too. [Bug 404865, Patch 405436] 2001-02-23 msofer * no changes; fixing up the missing comment in the previous one. Sorry. 2001-02-23 msofer * /cvsroot/tcl/tcl/tests/execute.test: added test for evaluation of an expression in a variable; evals once by compiling, second time using the previous compilation 2001-02-18 Kevin B. Kenny * doc/clock.n: Updated documentation to reflect the addition of compat/strftime.c, including the correct formatting of ISO-8601:1988 fiscal week number (%V). 2001-02-15 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_SplitObjCmd): Improved efficiency of splitting strings into individual characters by adding hash so that only one Tcl_Obj per character is created. Improves performance of splitting of short strings and makes a huge difference to splitting of long strings, such as is done in the mime package in tcllib. [Bug 131523] 2001-01-31 Don Porter * win/makefile.vc (install-libraries): Corrected misdirected install directory for the msgcat 1.2 package. 2001-01-30 Don Porter * generic/tclIO.c (CopyData): Moved code that updates the count of how many bytes are left to copy. Corrects bug that when writing occurs in the background, the copy loop could be escaped without updating the count, causing CopyData() to try to copy more bytes than the toRead value originally passed to TclCopyChannel(), leading to hangs and misreporting of number of bytes copied. [Bug 118203, Patch 103432] 2001-01-18 Andreas Kupries Everything below belongs together, it fixes [Bug 123153] * generic/tcl.h (line 342): A bit more explanation about the default value for TCL_PRESERVE_BINARY_COMPATABILITY. * generic/tcl.h (line 1208): Define the macro 'Tcl_InitHashTable' only when TCL_PRESERVE_BINARY_COMPATIBILITY is not set as it kills binary compatibility to 8.3 and earlier versions. This is the main part of the patch/change. * generic/tcl.decls (line 1469): * generic/tclHash.c (Tcl_InitHashTable): * generic/tclHash.c (Tcl_InitHashTableEx): * generic/tclObj.c (Tcl_InitObjHashTable): Changed 'Tcl_InitHashTableEx' to 'Tcl_InitCustomHashTable'. This change is more of an estethical nature, replacing the ubiquitous 'Ex' suffix with a more meaningful name. The introduced binary incompatibility is deemed acceptable as it is between alpha versions. Updated callers. * doc/Hash.3: * unix/mkLinks: Changed 'Tcl_InitHashTableEx' to 'Tcl_InitCustomHashTable'. 2001-01-10 Donal K. Fellows * tests/winPipe.test (winpipe-1.20): * tests/winDde.test (createChildProcess): * tests/pkgMkIndex.test (pkgtest::createIndex): Removed assumption that paths contain no spaces which causes problems with both [eval] and [open |...] due to the well-known differences between lists and strings. Fixes [Bug 119406] 2001-01-04 Don Porter * tests/unixInit.test: * unix/tclUnixInit.c (TclpInitLibraryPath): * win/tclWinInit.c (TclpInitLibraryPath): Several entries in the library path ($tcl_libPath) are determined relative to the absolute path of the executable. When the executable is installed in or near the root directory of the file system, relative pathnames were being incorrectly generated, and in the worst case, memory access violations were crashing the program. [Bug 119416, Patch 102972] ****************************************************************** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ****************************************************************** tcl8.6.14/ChangeLog.20020000644000175000017500000054235714554262142014016 0ustar sergeisergei2002-12-18 David Gravereaux * win/makefile.vc: some uses of xcopy swapped to the @$(CPY) macro. Reported by Joe Mistachkin . 2002-12-17 Jeff Hobbs * generic/tclNotify.c (TclFinalizeNotifier, Tcl_SetServiceMode): (Tcl_ThreadAlert): Check that the stub functions are non-NULL before calling them. They could be set to NULL by Tcl_SetNotifier. 2002-12-16 David Gravereaux * generic/tclPipe.c (TclCleanupChildren): * tests/winPipe.test: * win/tclWinPipe.c (Tcl_WaitPid): * win/tclWinTest.c: Gave Tcl_WaitPid the ability to return a Win32 exception code translated into a Posix-style SIG*. This allows [close] to report "CHILDKILLED" without the meaning getting lost in a truncated exit code. In TclCleanupChildren(), TclpGetPid() had to get moved to before Tcl_WaitPid() as the the handle is removed from the list taking away the ability to get the process id after the wait is done. This shouldn't effect the unix implimentaion unless waitpid is called with a pid of zero, meaning "any". I don't think it is.. 2002-12-13 Don Porter * unix/configure.in: Updated configure of CVS snapshots to reflect * win/configure.in: the 8.4.1.1 patchlevel. * unix/configure: autoconf * win/configure autoconf 2002-12-11 Don Porter * generic/tclProc.c (ProcessProcResultCode): Fix failure to propagate negative return codes up the call stack. [Bug 647307] * tests/proc.test (proc-6.1): Test for Bug 647307 * generic/tclParseExpr.c (TclParseInteger): Return 1 for the string "0x" (recognize leading "0" as an integer). [Bug 648441] * tests/parseExpr.test (parseExpr-19.1): Test for Bug 648441. 2002-12-09 Jeff Hobbs * win/tclWinThrd.c (TclpMasterUnlock): * generic/tclThread.c (TclFinalizeThreadData): TclpMasterUnlock must exist and be called unconditional of TCL_THREADS. [Bug 651139] 2002-12-08 David Gravereaux * win/tclWinSock.c (SocketThreadExitHandler, InitSockets): Check that the tsdPtr is valid before dereferencing as we call it from the exit handler, too [Bug 650353]. Another WSAStartup() loaded version comparison byte swap issue fixed. Although 0x0101 byte swapped is still 0x0101, properly claiming which is major/minor is more correct. 2002-12-06 Jeff Hobbs * generic/tclStubInit.c: regen * generic/tclIntPlatDecls.h: regen * generic/tclInt.decls: added TclWinResetInterface * win/tclWin32Dll.c (TclWinResetInterfaces): * win/tclWinInit.c (TclpSetInitialEncodings, WinEncodingsCleanup): add exit handler that resets the encoding information to a state where we can reuse Tcl. Following these changes, it is possible to reuse Tcl (following Tcl_FindExecutable or Tcl_CreateInterp) following a Tcl_Finalize. * generic/tclIOUtil.c (TclFinalizeFilesystem): reset statics to their original values on finalize to allow reuse of the library. 2002-12-04 David Gravereaux * win/tclWinPipe.c: reverted back to -r1.27 due to numerous test failures that need to be resolved first. The idea was good, but the details aren't. 2002-12-04 David Gravereaux * win/tclWinPipe.c (Tcl_WaitPid): When a process exits with an exception, pass this notice on to the caller with a SIG* code rather than truncating the exit code and missing the meaning. This allows TclCleanupChildren() to report "CHILDKILLED". This has a different behavior than unix in that closing the read pipe to a process sends the SIGPIPE signal which is returned as a SIGPIPE exit status. On windows, we send the process a CTRL_BREAK_EVENT and get back a CONTROL_C_EXIT which is documented to mean a SIGINT which seems wrong as a system, but is the correct exit status. 2002-12-04 Vince Darley * generic/tclIOUtil.c: fix to redirected 'load' in virtual filesystem for some Unix systems. * generic/tclEvent.c: the filesystem must be cleaned up before the encoding subsystem because it needs access to encodings. Fixes crash on exit observed in embedded applications. * generic/tclTestObj.c: patch omitted from previous change of 2002-11-13 2002-12-03 Jeff Hobbs * generic/tclStubLib.c (Tcl_InitStubs): prevent the cached check of tclStubsPtr to allow for repeated load/unload of the Tcl dll by hosting apps. [Bug 615304] 2002-12-03 David Gravereaux * win/tclAppInit.c (sigHandler): Protect from trying to close a NULL handle. * win/tclWinPipe.c (PipeClose2Proc, TclpCreateProcess): Send a real Win32 signal (CTRL_C_EVENT) when the read channel is brought down to alert the child to close on its side. Start the process with CREATE_NEW_PROCESS_GROUP to allow the ability to send these signals. The following test case now brings down the child without the use of an external [kill] command. % set p [open "|[info name]" w+] file8d5380 % pid $p 2876 % close $p <- now doesn't block in Tcl_WaitPid() % * win/tclWinPipe.c (PipeClose2Proc): Changed CTRL_C_EVENT to CTRL_BREAK_EVENT as it can't be ignored by the child and proved to work on [open "|netstat 1" w+] where CTRL_C_EVENT didn't. 2002-11-27 David Gravereaux * win/tclWinPort.h: Don't turn off winsock prototypes! TclX didn't like it. Even though the core doesn't use the prototypes, do offer them. * win/tclWinSock.c: Removed shutdown() from the function table as it wasn't referenced anywhere and cleaned-up some casting that that wasn't needed. * win/tclWinSock.c: WSAStartup() loaded version comparison error which resulted in 2.0 looking less than 1.1. * win/tclWinChan.c (Tcl_MakeFileChannel): return of DuplicateHandle() incorrectly used. [Bug 618852] 2002-11-26 Jeff Hobbs * generic/tclEncoding.c (TclFinalizeEncodingSubsystem): properly cleanup all encodings by using Tcl_FirstHashEntry in the while loop. * unix/Makefile.in (valgrind): add simple valgrind target * tests/exec.test: unset path var to allow singleproc testing * generic/tclInterp.c (AliasCreate): preserve/release interps to prevent possible FMR error in bad alias cases. 2002-11-26 David Gravereaux * win/tclWinPort.h: * win/tclWinSock.c: This patch does two things: 1) Cleans-up the winsock typedefs by using the typedefs provided by winsock2.h. This has no effect on how winsock is initialized; just makes the source code easier to read. [Patch 561305 561301] 2) Revamps how the socket message handler thread is brought up and down to allow for cleaner exits without the use of TerminateThread(). TerminateThread is evil. No attempt has been made to resolve [Bug 593810] which may need a new channel driver version for adding a registering function within the transfered thread to init the handler thread. IOW, initialization of the TSD structure is getting bypassed through the thread extension's [thread::transfer] command. 2002-11-26 David Gravereaux * win/tclWinConsole.c: * win/tclWinPipe.c: * win/tclWinSerial.c: * win/tclWinSock.c: * win/tclWinThrd.c: * win/tclWinTime.c: General cleanup of all worker threads used by the channel drivers. Eliminates the normal case where the worker thread is terminated ('cept the winsock one). Instead, use kernel events to signal a clean exit. Only when the worker thread is blocked on an I/O call is the thread terminated. Essentially, this makes all other channel worker threads behave like the PipeReaderThread() function for it's cleaner exit behavior. This appears to fix [Bug 597924] but needs 3rd party confirmation to close the issue. 2002-11-26 Mo DeJong * win/README: Update msys build env URL. This release #4 build both tcl and tk without problems. 2002-11-22 Jeff Hobbs * library/init.tcl: code cleanup to reduce use of * library/opt/optparse.tcl: string compare * tests/interp.test: interp-14.4 * generic/tclInterp.c (TclPreventAliasLoop): prevent seg fault when creating an alias command over the interp name. [Bug 641195] 2002-11-18 Jeff Hobbs * generic/tclUtil.c (SetEndOffsetFromAny): handle integer offset after the "end-" prefix. * generic/get.test: * generic/string.test: * generic/tclObj.c (SetIntFromAny, SetWideIntFromAny): * generic/tclGet.c (TclGetLong, Tcl_GetInt): simplify sign handling before calling strtoul(l). [Bug 634856] 2002-11-18 David Gravereaux * win/tclWinThrd.c (Tcl_CreateThread/TclpThreadExit): Fixed improper compiler macros that missed the VC++ compiler. This resulted in VC++ builds using CreateThread()/ExitThread() in place of the proper _beginthreadex()/_endthreadex(). This was a large error and am surprised I missed seeing it earlier. 2002-11-13 Jeff Hobbs * generic/regexpComp.test: added tests 22.* * generic/tclCompCmds.c (TclCompileRegexpCmd): add left and right anchoring (^ and $) recognition and check starting or ending .* to extend the number of REs that can be compiled to string match or string equal. 2002-11-13 Vince Darley * generic/tclCmdMZ.c: * tests/trace.test: applied patch from Hemang Levana to fix [Bug 615043] in execution traces with 'return -code error'. * generic/tclTestObj.c: * tests/stringObj.test: added 'knownBug' test for [Bug 635200] * generic/tclStringObj.c: corrected typos in comments * generic/tclFileName.c: * tests/fileName.test: applied patch for bug reported against tclvfs concerning handling of Windows serial ports like 'com1', 'lpt3' by the virtual filesystem code. * doc/RegExp.3: clarification of the 'extendMatch' return values. 2002-11-11 Jeff Hobbs * generic/tclUtil.c (Tcl_Backslash): use TclUtfToUniChar. (Tcl_StringCaseMatch): use TclUtfToUniChar and add further optimizations for the one-byte/char case. * generic/tclUtf.c: make use of TclUtfToUniChar macro throughout the functions, and add extra optimization to Tcl_NumUtfChars for one-byte/char case. * generic/tclVar.c (DisposeTraceResult, CallVarTraces): add proper static declarations. * generic/tclStringObj.c (Tcl_GetCharLength): optimize for the ascii char case. (Tcl_GetUniChar): remove unnecessary use of Tcl_UtfToUniChar. (FillUnicodeRep): Use TclUtfToUniChar. * generic/tclHash.c (HashStringKey): move string++ lower to save an instruction. * generic/tclExecute.c (TclExecuteByteCode): improve INST_STR_CMP to use memcmp in the one-byte/char case, also use direct index for INST_STR_INDEX in that case. * generic/tclEncoding.c (UtfToUtfProc, UtfToUnicodeProc): (TableFromUtfProc, EscapeFromUtfProc): Use TclUtfToUniChar. (UnicodeToUtfProc, TableToUtfProc): add 1-byte char optimizations for Tcl_UniCharToUtf call. These improve encoded channel conversion speeds by up to 20%. * tests/split.test: added 1-char string split tests * generic/tclCmdMZ.c (Tcl_SplitObjCmd): Use TclUtfToUniChar. Also added a special case for single-ascii-char splits. (Tcl_StringObjCmd): Use TclUtfToUniChar. For STR_RANGE, support getting ranges of ByteArrays (reverts change from 2000-05-26). (TraceExecutionProc) add proper static declaration. * generic/tclInt.h: add macro version of Tcl_UtfToUniChar (TclUtfToUniChar) that does the one-byte utf-char check without calling Tcl_UtfToUniChar, for use by the core. This brings notable speedups for primarily ascii string handling. * generic/tcl.h (TCL_PATCH_LEVEL): bump to 8.4.1.1 for patchlevel only. This interim number will only be reflected by [info patchlevel]. 2002-11-11 Kevin Kenny * doc/Tcl.n: Corrected indentation of the new language. Oops. 2002-11-10 Kevin Kenny * doc/Tcl.n: Added language to the Endekalogue to make it clear that substitutions always take place from left to right. [Bug 635644] 2002-11-06 Mo DeJong * changes: Note TclInExit TclInThreadExit changes. * generic/tclEvent.c (TclInExit, TclInThreadExit): Split out functionality of TclInExit to make it clear which one should be called in each situation. * generic/tclInt.decls: Declare TclInThreadExit. * generic/tclIntDecls.h: Regen. * generic/tclStubInit.c: Regen. * mac/tclMacChan.c (StdIOClose): * unix/tclUnixChan.c (FileCloseProc): * win/tclWinChan.c (FileCloseProc): * win/tclWinConsole.c (ConsoleCloseProc): * win/tclWinPipe.c (TclpCloseFile): * win/tclWinSerial.c (SerialCloseProc): Invoke the new TclInThreadExit method instead of TclInExit. 2002-11-06 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Generate a fatal configure error if no ar program can be found on the path. [Bug 582039] * win/configure: Regen. * win/configure.in: Check that AR, RANLIB, and RC are found on the path when building with gcc. 2002-11-03 David Gravereaux * win/tclAppInit.c: Calls Registry_Init() and Dde_Init() when STATIC_BUILD and TCL_USE_STATIC_PACKAGES macros are set. * win/makefile.vc: * win/rules.vc: linkexten option now sets the TCL_USE_STATIC_PACKAGES macro which also adds the registry and dde object files to the link of the shell. [Patch 479697] Also factored some additional macros that will be helpful for extension authors. Version grepping of tcl.h will need to be added to complete this. * win/buildall.vc.bat: Added more descriptive commentary. 2002-11-01 David Gravereaux * win/tclWinReg.c: Changed the Tcl_PkgProvide() line to declare the registry extension at version 1.1 from 1.0. 2002-10-31 Andreas Kupries * library/word.tcl: Changed $tcl_platform to $::tcl_platform to avoid possible scope trouble. 2002-10-29 Vince Darley * win/tclWinInt.h: * win/tclWin32Dll.c: added comments about certain NULL function pointers which will be filled in when Tcl_FindExecutable is called, so that users don't report invalid bugs on this topic. (No code changes at all). 2002-10-29 Daniel Steffen * unix/tclLoadDyld.c (TclpFindSymbol): pass all dyld error messages upstream [Bug 627546]. 2002-10-28 Andreas Kupries * library/dde/pkgIndex.tcl: * library/reg/pkgIndex.tcl: Changed the hardwired debug suffix (d) to the correct suffix (g). 2002-10-28 Don Porter * library/auto.tcl: Converted the Mac-specific [package unknown] * library/init.tcl: behavior to use a chaining mechanism to extend * library/package.tcl: the default [tclPkgUnknown]. [Bug 627660] * library/tclIndex: [Patch 624509] (steffen) 2002-10-26 David Gravereaux * win/makefile.vc: xcopy on NT 4.0 doesn't support the /Y switch (overwrite). Added logic to handle this. [Bug 618019] 2002-10-23 Donal K. Fellows * generic/tclInt.h: Removed definitions of obsolete HistoryEvent and HistoryRev structures (the history mechanism has been written in Tcl for some time now.) 2002-10-22 Jeff Hobbs *** 8.4.1 TAGGED FOR RELEASE *** * changes: updated for 8.4.1 release * win/Makefile.in: removed @MEM_DEBUG_FLAGS@ subst. * win/configure: regen * win/configure.in: removed SC_ENABLE_MEMDEBUG call * win/tcl.m4: replaced SC_ENABLE_MEMDEBUG with a more intelligent SC_ENABLE_SYMBOLS that takes yes|no|mem|compile|all as options now. 2002-10-22 Daniel Steffen * library/auto.tcl (tcl_findLibrary): * library/package.tcl (tclPkgUnknown): on macosx, search inside the Resources/Scripts subdirectory of any potential package directory. * macosx/Tcl.pbproj/project.pbxproj: add standard Frameworks dirs to TCL_PACKAGE_PATH make argument. * unix/tclUnixInit.c (TclpSetVariables): on macosx, add embedded framework dirs to tcl_pkgPath: @executable_path/../Frameworks and @executable_path/../PrivateFrameworks (if they exist), as well as the dirs in DYLD_FRAMEWORK_PATH (if set). [Patch 624509] use standard MAXPATHLEN instead of literal 1024 2002-10-22 Donal K. Fellows * doc/StringObj.3, doc/Object.3: Documented that Tcl_Obj's standard string form is a modified UTF-8; apparently, this was not mentioned anywhere in the main docs, and lead to [Bug 624919]. 2002-10-21 Daniel Steffen * macosx/Tcl.pbproj/project.pbxproj: bumped version to 8.4.1 * generic/tcl.h: Added reminder comment to edit macosx/Tcl.pbproj/project.pbxproj when version number changes. 2002-10-18 Jeff Hobbs * library/reg/pkgIndex.tcl: * win/configure: * win/configure.in: * win/Makefile.in: * win/makefile.vc: * win/makefile.bc: Updated to reg1.1 * doc/registry.n: Added support for broadcasting changes to the * tests/registry.test: registry Environment. Noted proper code in the * win/tclWinReg.c: docs. [Patch 625453] * unix/Makefile.in (dist): add any mac/tcl*.sea.hqx files 2002-10-17 Don Porter * generic/tclVar.c: Fixed code that check for proper # of args to * tests/var.test: [array names]. Added test. [Bug 624755] 2002-10-16 Jeff Hobbs * win/configure: add workaround for cygwin windres * win/tcl.m4 (SC_CONFIG_CFLAGS): problem. [Patch 624010] (howell) 2002-10-15 Jeff Hobbs * README: added archives.tcl.tk note * unix/configure: * unix/tcl.m4: Correct AIX-5 ppc build flags. Correct HP 11 64-bit gcc building. [Patch 601051] (martin) 2002-10-15 Vince Darley * generic/tclCmdMZ.c: * tests/trace.test: applied patch from Hemang Levana to fix [Bug 615043] in execution traces with idle tasks firing. 2002-10-14 Jeff Hobbs * generic/tclEnv.c (Tcl_PutEnv): correct possible mem leak. [Patch 623269] (brouwers) 2002-10-11 Donal K. Fellows * generic/tcl.h: Need a different strategy through the maze of #defines to let people building with Cygwin build correctly. Also made some comments less misleading... 2002-10-10 Jeff Hobbs * README: fixed minor nits [Bug 607776] (virden) * win/configure: * win/tcl.m4: enable USE_THREAD_ALLOC (new threaded allocator) by default in cygwin configure on Windows. 2002-10-10 Don Porter * doc/Tcl.n: Clarified that namespace separators are legal in the variable names during $-subtitution. [Bug 615139] * doc/regexp.n: Typo correction. Thanks Ronnie Brunner. [Bug 606826] 2002-10-10 Vince Darley * unix/tclLoadAout.c * unix/tclLoadDl.c * unix/tclLoadDld.c * unix/tclLoadDyld.c * unix/tclLoadNext.c * unix/tclLoadOSF.c * unix/tclLoadShl.c * win/tclWinLoad.c: allow either full paths or simply dll names to be specified when loading files (the latter will be looked up by the OS on your PATH/LD_LIBRARY_PATH as appropriate). Fixes [Bug 611108] 2002-10-09 Jeff Hobbs * unix/README: doc'ed --enable-symbols options. * unix/Makefile.in: removed @MEM_DEBUG_FLAGS@ subst. * unix/configure: regen * unix/configure.in: removed SC_ENABLE_MEMDEBUG call * unix/tcl.m4: replaced SC_ENABLE_MEMDEBUG with a more intelligent SC_ENABLE_SYMBOLS that takes yes|no|mem|compile|all as options now. 2002-10-09 Kevin B. Kenny * win/tclWinTime.c: Added code to set an exit handler that terminates the thread that calibrates the performance counter, so that the thread won't outlive unloading the Tcl DLL. [Bug 620735] 2002-10-09 Donal K. Fellows * doc/binary.n: More clarification of [binary scan]'s behaviour. 2002-10-09 Daniel Steffen * generic/tclIntDecls.h: fixed botched regen. 2002-10-09 Daniel Steffen * generic/tclInt.decls: made TclSetPreInitScript() declaration generic as it is used on mac & aqua as well. * generic/tclIntDecls.h: * generic/tclStubInit.c: regen. * generic/tclCompile.h: added prototype for TclCompileVariableCmd. * mac/tclMacPort.h: removed incorrect definitions and obsolete definitions. * mac/tclMacChan.c: removed obsolete GetOpenMode() and replaced associated constants with the analogues (they existing defs were inconsistent with which was causing havoc when Tcl_GetOpenMode was used instead of private GetOpenMode). * mac/tclMacFCmd.c: removed GenerateUniqueName(), use equivalent (and identically named) routine from MoreFiles instead. * mac/tclMacLoad.c: CONSTification, fixes to Vince's last changes. * mac/tclMacFile.c: * mac/tclMacTest.c: * mac/tclMacUnix.c: CONSTification. * mac/tclMacOSA.c: CONSTification, sprintf fixes, UH 3.4.x changes; fix for missing autoname token from TclOSACompileCmd. (bdesgraupes) * mac/AppleScript.html(AppleScript delete): doc fix. (bdesgraupes) * mac/tcltkMacBuildSupport.sea.hqx: updated MoreFiles to 1.5.3, updated build instructions for 8.4. * mac/tclMacProjects.sea.hqx: rebuilt archive. 2002-10-09 Donal K. Fellows * doc/Alloc.3: Added a note to mention that attempting to allocate a zero-length block can return NULL. [Tk Bug 619544] 2002-10-04 Donal K. Fellows * doc/binary.n: Doc improvements [Patch 616480] * tests/fCmd.test, tests/winFCmd.test: * tools/eolFix.tcl, tools/genStubs.tcl: [file exist] -> [file exists] Thanks to David Welton. 2002-10-03 Don Porter * doc/tcltest.n: fixed typo [Bug 618018]. Thanks to "JJM". 2002-10-03 Donal K. Fellows * tools/man2help2.tcl: * tests/http.test, tests/httpd, tests/httpold.test: * tests/env.test, tests/binary.test, tests/autoMkindex.test: * library/init.tcl, library/http/http.tcl: [info exist] should really be [info exists]. [Bug 602566] * doc/lsearch.n: Better specification of what happens when -sorted is mixed with other options. [Bug 617816] 2002-10-01 Jeff Hobbs * generic/tclProc.c (TclCreateProc): mask out VAR_UNDEFINED for precompiled locals to support 8.3 precompiled code. (Tcl_ProcObjCmd): correct 2002-09-26 fix to look for tclProcBodyType. 2002-10-01 Donal K. Fellows * doc/socket.n: Mentioned that ports may be specified as serivce names as well as integers. [Bug 616843] 2002-09-30 Jeff Hobbs * generic/tclCompCmds.c (TclCompileRegexpCmd): correct the checking for bad re's that didn't terminate the re string. Resultant compiles were correct, but much slower than necessary. 2002-09-29 David Gravereaux * win/tclAppInit.c: Added proper exiting conditions using Win32 console signals. This handles the existing lack of a Ctrl+C exit to call exit handlers when built for thread support. Also, properly handles exits from other conditions such as CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, and CTRL_SHUTDOWN_EVENT signals. In all cases, exit handlers will be called. [Bug 219355] * win/makefile.vc: Added missing tclThreadAlloc.c to the build rules and defines USE_THREAD_ALLOC when TCL_THREADS is defined to get the new behavior by default. 2002-09-27 Don Porter * README: Bumped to version 8.4.1 to avoid confusion of * generic/tcl.h: CVS snapshots with the actual 8.4.0 release. * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf * win/configure: 2002-09-26 Jeff Hobbs * unix/configure: regen. * unix/tcl.m4: improve AIX-4/5 64bit compilation support. * generic/tclProc.c (Tcl_ProcObjCmd): correct overeager optimization of noop proc to handle the precompiled case. (sofer) * unix/ldAix (nmopts): add -X32_64 to make it work for 32 or 64bit mode compilation. * library/encoding/koi8-u.enc: removed extraneous spaces that confused encoding reader. [Bug 615115] * unix/Makefile.in: generate source dists with -src designator and do not generate .Z anymore (just .gz and .zip). 2002-09-18 Mumit Khan Added basic Cygwin support. * win/tcl.m4 (SC_PATH_TCLCONFIG): Support one-tree build. (SC_PATH_TKCONFIG): Likewise. (SC_PROG_TCLSH): Likewise. (SC_CONFIG_CFLAGS): Assume real Cygwin port and remove -mno-cygwin flags. Add -mwin32 to extra_cflags and extra_ldflags. Remove ``-e _WinMain@16'' from LDFLAGS_WINDOW. * win/configure.in: Allow Cygwin build. (SEH test): Define to be 1 instead of empty value. (EXCEPTION_DISPOSITION): Add test. * win/configure: Regenerate. * generic/tcl.h: Don't explicitly define __WIN32__ for Cygwin, let the user decide whether to use Windows or POSIX personality. (TCL_WIDE_INT_TYPE, TCL_LL_MODIFIER, struct Tcl_StatBuf): Define for Cygwin. * generic/tclEnv.c (Tcl_CygwinPutenv): putenv replacement for Cygwin. * generic/tclFileName.c (Tcl_TranslateFileName): Convert POSIX to native format. (TclDoGlob): Likewise. * generic/tclPlatDecls.h (TCHAR): Define for Cygwin. * win/tclWinPort.h (putenv, TclpSysAlloc, TclpSysFree, (TclpSysRealloc): Define for Cygwin. 2002-09-26 Daniel Steffen * macosx/Makefile: preserve environment value of INSTALL_ROOT. When embedding only use deployment build. Force relink before embedded build to ensure new linker flags are picked up. * macosx/Tcl.pbproj/project.pbxproj: add symbolic links to debug lib, stub libs and tclConfig.sh in framework toplevel. Configure target dependency fix. Fix to 'clean' action. Added private tcl headers to framework. Install tclsh symbolic link. Html doc build works when no installed tclsh available. Made html doc structure in framework more like in Apple frameworks. 2002-09-24 Donal K. Fellows * unix/tcl.m4 (SC_TCL_64BIT_FLAGS): Yet more robust 64-bit value detection to close [Bug 613117] on more systems. * generic/tclCompile.c (TclPrintSource): More CONSTifying. * generic/tclExecute.c (EvalStatsCmd): Object-ify to reduce warnings. Thanks to 'CoderX2' on the chat for bringing this to my attention... * unix/tcl.m4: Forgot to define TCL_WIDE_INT_IS_LONG at the appropriate moment. I believe this is the cause of [Bug 613117] * doc/lset.n: Changed 'list' to 'varName' for consistency with lappend documentation. Thanks to Glenn Jackman [Bug 611719] 2002-09-22 Don Porter * library/tcltest/tcltest.tcl: Corrected [puts -nonewline] within test bodies. Thanks to Harald Kirsch. [Bug 612786, Patch 612788] Also corrected reporting of body return code. Thanks to David Taback [Bug 611922] * library/tcltest/pkgIndex.tcl: Bump to version 2.2.1. * tests/tcltest.test: added tests for these bugs. 2002-09-15 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add PEEK_XCLOSEIM define under Linux. This is used by Tk to double check that an X input context is cleaned up before it is closed. 2002-09-12 David Gravereaux * win/coffbase.txt: Added BLT to the virtual base address listings table should BLT's build tools decide to use it. 2002-09-12 Daniel Steffen * generic/tcl.h: * mac/tclMacApplication.r: * mac/tclMacLibrary.r: * mac/tclMacResource.r: unified use of the two equivalent resource compiler header inclusion defines RC_INVOKED and RESOURCE_INCLUDED, now use RC_INVOKED throughout. 2002-09-10 Mo DeJong * unix/README: Add note about building extensions with the same compiler Tcl was built with. [Tk Bug 592096] 2002-09-10 Daniel Steffen * macosx/Tcl.pbproj/project.pbxproj: disabled building html documentation during embedded build. 2002-09-10 Daniel Steffen * unix/Makefile.in: added DYLIB_INSTALL_DIR variable for macosx and set it to default value ${LIB_RUNTIME_DIR} * unix/tcl.m4 (Darwin): use DYLIB_INSTALL_DIR instead of LIB_RUNTIME_DIR in the -install_name argument to ld. * unix/configure: regen. * macosx/Tcl.pbproj/project.pbxproj: * macosx/Makefile: added support for building Tcl as an embedded framework, i.e. using an dyld install_name containing @executable_path/../Frameworks via the new DYLIB_INSTALL_DIR unix/Makefile variable. 2002-09-10 Jeff Hobbs *** 8.4.0 TAGGED FOR RELEASE *** 2002-09-06 Don Porter * doc/file.n: Format correction, and clarified [file normalize] returns an absolute path. * doc/tcltest.n: Added examples section, as long promised. 2002-09-06 Reinhard Max * tests/tcltest.test: Added nonRoot flag to tests 8.3, 8.4, and 8.12. 2002-09-05 Don Porter * doc/tcltest.n: Clarified phrasing. * generic/tclBasic.c (TclRenameCommand,CallCommandTraces): * tests/trace.test (trace-27.1): Corrected memory leak when a rename trace deleted the command being traced. Test added. Thanks to Hemang Lavana for the fix. [Bug 604609] * generic/tclVar.c (TclDeleteVars): Corrected logic for setting the TCL_INTERP_DESTROYED flag when calling variable traces. [Tk Bug 605121] 2002-09-04 Miguel Sofer * generic/tclVar.c (DeleteArray): leak plug [Bug 604239]. Thanks to dkf and dgp for the long and difficult discussion in the chat. 2002-09-03 Jeff Hobbs * generic/tclVar.c (Tcl_UpVar2): code cleanup to not use goto * unix/configure: remove -pthread from LIBS on FreeBSD in thread * unix/tcl.m4: enabled build. [Bug 602849] 2002-09-03 Miguel Sofer * generic/tclInterp.c (AliasCreate): a Tcl_Obj was leaked on error return from TclPreventAliasLoop. 2002-09-03 Daniel Steffen * macosx/Tcl.pbproj/project.pbxproj: Bumped version number to 8.4.0 and updated copyright info. 2002-09-03 Miguel Sofer * generic/tclVar.c (Tcl_UpVar2): a Tcl_Obj was being leaked on error return from TclGetFrame. 2002-09-03 Don Porter * changes: Updated changes for 8.4.0 release. 2002-09-02 Jeff Hobbs * unix/tclUnixFile.c (TclpObjLink): removed unnecessary/unfreed extra native char*. * unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): make sure to init flags field of TcpState ptr to 0. * unix/configure: * unix/tcl.m4: added 64-bit gcc compilation support on HP-11. [Patch 601051] (martin) * README: Bumped version number to 8.4.0 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure: * win/configure.in: * generic/tclInterp.c (SlaveCreate): make sure that the memory and checkmem commands are initialized in non-safe slave interpreters when TCL_MEM_DEBUG is used. [Bug 583445] * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe if there was something to write. This may prevent infinite wait on exit. * tests/exec.test: marked exec-18.1 unixOnly until the Windows incompatibility (in the test, not the core) can be resolved. * tests/http.test (http-3.11): added close $fp that was causing an error on Windows because the file was not closed before deleting. * unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): made this static function only appear when HAVE_CFBUNDLE is defined. 2002-08-31 Daniel Steffen * unix/tcl.m4: added TK_SHLIB_LD_EXTRAS analogue of existing TCL_SHLIB_LD_EXTRAS for linker settings only used when linking Tk. * unix/configure: regen 2002-08-31 Daniel Steffen *** macosx-8-4-branch merged into the mainline [Patch 602770] *** * generic/tcl.decls: added new macosx specific entry to stubs table. * tools/genStubs.tcl: added generation of platform guards for macosx. This is a little more complex than it seems, because MacOS X IS "unix" plus a little bit, for the purposes of Tcl. BUT unfortunately, Tk uses "unix" to mean X11. So added platform keys for macosx (the little added to "unix"), "aqua" and "x11" to distinguish these for Tk. * generic/tcl.h: added a #ifnded RESOURCE_INCLUDED so that tcl.h can be passed to the resource compiler. * generic/tcl.h: * generic/tclNotify.c: added a few Notifier procs, to be able to modify more bits of the Tcl notifier dynamically. Required to get Mac OS X Tk to live on top of the Tcl Unix threaded notifier. Changes the size of the Tcl_NotifierProcs structure, but doesn't move any elements around. * unix/tclUnixNotfy.c: moved the call to Tcl_ConditionNotify till AFTER we are done mucking with the pointer swap. Fixes cases where the thread waiting on the condition wakes & accesses the waitingListPtr before it gets reset, causing a hang. * library/auto.tcl (tcl_findLibrary): added checking the directories in the tcl_pkgPath for library files on macosx to enable support of the standard Mac OSX library locations. * unix/Makefile.in: * unix/configure.in: * unix/tcl.m4: added MAC_OSX_DIR. Added PLAT_OBJS to the OBJS: there are some MacOS X specific files now for Tcl, and when I get the resource & applescript stuff ported over, and restore support for FindFiles, etc, there will be a few more. Added LD_LIBRARY_PATH_VAR configure variable to avoid having to set all possible LD_LIBRARY_PATH analogues on all platforms. LD_LIBRARY_PATH_VAR is "LD_LIBRARY_PATH" by default, "LIBPATH" on AIX, "SHLIB_PATH" on HPUX and "DYLD_LIBRARY_PATH" on Mac OSX. Added configure option to package Tcl as a framework on Mac OSX. * macosx/tclMacOSXBundle.c (new): support for finding Tcl extension packaged as 'bundles' in the standard Mac OSX library locations. * unix/tclUnixInit.c: added support for findig the tcl script library inside Tcl packaged as a framework on Mac OSX. * macosx/Tcl.pbproj/jingham.pbxuser (new): * macosx/Tcl.pbproj/project.pbxproj (new): project for Apple's ProjectBuilder IDE. * macosx/Makefile (new): simple makefile for building the project from the command line via the ProjectBuilder tool 'pbxbuild'. * unix/configure: * generic/tclStubInit.c: * generic/tclPlatDecls.h: regen 2002-08-29 Andreas Kupries * win/tclWinThrd.c (TclpFinalizeThreadData, TclWinFreeAllocCache): Applied patch for [Bug 599428], provided by Miguel Sofer . 2002-08-28 David Gravereaux * generic/tclEnv.c: * unix/configure.in: * win/tclWinPort.h: putenv() on some systems copies the buffer rather than taking reference to it. This causes memory leaks and is know to effect mswindows (msvcrt) and NetBSD 1.5.2 . This patch tests for this behavior and turns on -DHAVE_PUTENV_THAT_COPIES=1 when approriate. Thanks to David Welton for assistance. [Bug 414910] * unix/configure: regen'd 2002-08-28 Donal K. Fellows * doc/eval.n: Added mention of list command and corrected "SEE ALSO". * unix/configure.in: Cache handling of ac_cv_type_socklen_t was wrong. [Bug 600931] reported by John Ellson. Fixed by putting the brackets where they belong. 2002-08-26 Miguel Sofer * generic/tclCompCmds.c: fix for [Bug 599788] (error in element name causing segfault), reported by Tom Wilkason. Fixed by copying the tokens instead of the source string. 2002-08-26 Miguel Sofer * generic/tclThreadAlloc.c: small optimisation, reducing the new allocator's overhead. 2002-08-23 Miguel Sofer * generic/tclObj.c (USE_THREAD_ALLOC): fixed leak [Bug 597936]. Thanks to Zoran Vasiljevic. 2002-08-23 Miguel Sofer * generic/tclThreadAlloc.c (USE_THREAD_ALLOC): moving objects between caches as a block, instead of one-by-one. 2002-08-22 Miguel Sofer * generic/tclBasic.c: * generic/tclCmdMZ.c: fix for freed memory r/w in delete traces [Bug 589863], patch by Hemang Lavana. 2002-08-20 Andreas Kupries * win/Makefile.in (CFLAGS): * unix/Makefile.in (MEM_DEBUG_FLAGS): Added usage of @MEM_DEBUG_FLAGS@. * win/configure.in: * unix/configure.in: Added usage of SC_ENABLE_MEMDEBUG. * win/tcl.m4: * unix/tcl.m4: Added macro SC_ENABLE_MEMDEBUG. Allows a user of configure to (de)activate memory validation and debugging (TCL_MEM_DEBUG). No need to modify the makefile anymore. 2002-08-20 Don Porter * generic/tclCkalloc.c: CONSTified MemoryCmd and CheckmemCmd. * README: Bumped version number to 8.4b3 to distinguish * generic/tcl.h: HEAD from the 8.4b2 release. * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf * win/configure: * library/http/http.tcl: Corrected installation directory of * library/msgcat/msgcat.tcl: the package tcltest 2.2. Added * library/opt/optparse.tcl: comments in other packages to remind * library/tcltest/tcltest.tcl: that installation directories need * unix/Makefile.in: updates to match increasing version * win/Makefile.in: numbers. [Bug 597450] * win/makefile.bc: * win/makefile.vc: 2002-08-19 Andreas Kupries * unix/tclUnixTest.c (TestfilehandlerCmd): Changed readable/writable to the more common readable|writable. Fixes [Bug 596034] reported by Larry Virden . 2002-08-16 Donal K. Fellows * tests/fCmd.test: Added test to make sure that the cause of the problem is detectable with an unpatched Tcl. * doc/ObjectType.3: Added note on the root cause of this problem to the documentation, since it is possible for user code to trigger this sort of behaviour too. * generic/tclIOUtil.c (SetFsPathFromAny): Objects should only have their old representation deleted when we know that we are about to install a new one. This stops a weird TclX bug under Linux with certain kinds of memory debugging enabled which essentally came down to a double-free of a string. 2002-08-14 Miguel Sofer * generic/tclInt.h: * generic/tclObj.c: (code cleanup) factored the parts in the macros TclNewObj() / TclDecrRefCount() into a common part for all memory allocators and two new macros TclAllocObjStorage() / TclFreeObjStorage() that are specific to each allocator and fully describe the differences. Removed allocator-specific code from tclObj.c by using the macros. 2002-08-12 Miguel Sofer * generic/tclCmdMZ.c: fixing UMR in delete traces, [Bug 589863]. 2002-08-08 David Gravereaux * tools/man2help.tcl: Fixed $argv handling bug where if -bitmap wasn't specified $argc was off by one. 2002-08-08 Miguel Sofer * tests/uplevel.test: added 6.1 to test [uplevel] with shadowed commands [Bug 524383] * tests/subst.test: added 5.8-10 as further tests for [Bug 495207] 2002-08-08 Don Porter * tests/README: Noted removal of defs.tcl. 2002-08-08 Jeff Hobbs * doc/lsearch.n: corrected lsearch docs to use -inline in examples. *** 8.4b2 TAGGED FOR RELEASE *** * tests/fCmd.test: * tests/unixFCmd.test: updated tests for new link copy behavior. * generic/tclFCmd.c (CopyRenameOneFile): changed the behavior to follow links to endpoints and copy that file/directory instead of just copying the surface link. This means that trying to copy a link that has no endpoint (danling link) is an error. [Patch 591647] (darley) (CopyRenameOneFile): this is currently disabled by default until further issues with such behavior (like relative links) can be handled correctly. * tests/README: slight wording improvements 2002-08-07 Miguel Sofer * docs/BoolObj.3: added description of valid string reps for a boolean object. [Bug 584794] * generic/tclObj.c: optimised Tcl_GetBooleanFromObj and SetBooleanFromAny to avoid parsing the string rep when it can be avoided. [Bugs 584650, 472576] 2002-08-07 Miguel Sofer * generic/tclCompile.h: * generic/tclObj.c: making tclCmdNameType static ([Bug 584567], Don Porter). 2002-08-07 Miguel Sofer * generic/tclObj.c (Tcl_NewObj): added conditional code for USE_THREAD_ALLOC; objects allocated through Tcl_NewObj() were otherwise being leaked. [Bug 587488] reported by Sven Sass. 2002-08-06 Daniel Steffen * generic/tclInt.decls: * unix/tclUnixThrd.c: Added stubs and implementations for non-threaded build for the tclUnixThrd.c procs TclpReaddir, TclpLocaltime, TclpGmtime and TclpInetNtoa. Fixes link errors in stubbed & threaded extensions that include tclUnixPort.h and use any of the procs readdir, localtime, gmtime or inet_ntoa (e.g. TclX 8.4) [Bug 589526] * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: Regen. 2002-08-05 Don Porter * library/tcltest/tcltest.tcl: The setup and cleanup scripts are now * library/tcltest/pkgIndex.tcl: skipped when a test is skipped, fixing * tests/tcltest.test: [Bug 589859]. Test for bug added, and corrected tcltest package bumped to version 2.2. * generic/tcl.decls: Restored Tcl_Concat to return (char *). Like * generic/tclDecls.h: Tcl_Merge, it transfers ownership of a dynamic * generic/tclUtil.c: allocated string to the caller. 2002-08-04 Don Porter * doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify all * doc/Concat.3: remaining public interfaces of Tcl. Notably, * doc/CrtCommand.3: the parser no longer writes on the string it * doc/CrtSlave.3: is parsing, so it is no longer necessary for * doc/CrtTrace.3: Tcl_Eval() to be given a writable string. Also * doc/Eval.3: the refactoring of the Tcl_*Var* routines by * doc/ExprLong.3: by Miguel Sofer is included, so that the * doc/LinkVar.3: "part1" argument for them no longer needs to * doc/ParseCmd.3: be writable either. * doc/SetVar.3: * doc/TraceVar.3: * doc/UpVar.3: Compatibility support has been enhanced so * generic/tcl.decls: that a #define of USE_NON_CONST will remove * generic/tcl.h: all possible source incompatibilities with the * generic/tclBasic.c: 8.3 version of the header file(s). The new * generic/tclCmdMZ.c: #define of USE_COMPAT_CONST now does what * generic/tclCompCmds.c:USE_NON_CONST used to do -- disable only those * generic/tclCompExpr.c:new CONST's that introduce irreconcilable * generic/tclCompile.c: incompatibilities. * generic/tclCompile.h: * generic/tclDecls.h: Several bugs are also fixed by this patch. * generic/tclEnv.c: [Bugs 584051,580433] [Patches 585105,582429] * generic/tclEvent.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclInterp.c: * generic/tclLink.c: * generic/tclObj.c: * generic/tclParse.c: * generic/tclParseExpr.c: * generic/tclProc.c: * generic/tclTest.c: * generic/tclUtf.c: * generic/tclUtil.c: * generic/tclVar.c: * mac/tclMacTest.c: * tests/expr-old.test: * tests/parseExpr.test: * unix/tclUnixTest.c: * unix/tclXtTest.c: * win/tclWinTest.c: 2002-08-01 Miguel Sofer * generic/tclExecute.c: bugfix (reading freed memory). Testsuite passed on linux/i386, compile-13.1 hung on linux/alpha. 2002-08-01 Miguel Sofer * generic/tclExecute.c: added a reference count for the complete execution stack, instead of Tcl_Preserve/Tcl_Release. 2002-08-01 Mo DeJong * generic/tclCkalloc.c (TclFinalizeMemorySubsystem): Don't lock the ckalloc mutex before invoking the Tcl_DumpActiveMemory function since it also locks the same mutex. This code is only executed when "memory onexit filename" has been executed and Tcl is compiled with -DTCL_MEM_DEBUG. 2002-08-01 Reinhard Max * win/tclWinPort.h: The windows headers don't provide socklen_t, so we have to do it. 2002-07-31 Miguel Sofer * generic/tclInt.h (USE_THREAD_ALLOC): for unshared objects, TclDecrRefCount now frees the internal rep before the string rep - just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802]. For the other allocators the fix was done on 2002-03-06. 2002-07-31 Miguel Sofer * generic/tclInterp.c: signed/unsigned comparison warning fixed (Vince Darley). 2002-07-31 Donal K. Fellows * unix/tcl.m4 (SC_BUGGY_STRTOD): Enabled caching of test results. * unix/tcl.m4 (SC_BUGGY_STRTOD): Solaris 2.8 still has a buggy strtod() implementation; make sure we detect it. * tests/expr.test (expr-22.*): Marked as non-portable because it seems that these tests have an annoying tendency to fail in unexpected ways. [Bugs 584825, 584950, 585986] 2002-07-30 Andreas Kupries * tests/io.test: * generic/tclIO.c (WriteChars): Added flag to break out of loop if nothing of the input is consumed at all, to prevent infinite looping of called with a non-UTF-8 string. Fixes Bug 584603 (partially). Added new test "io-60.1". Might need additional changes to Tcl_Main so that unprintable results are printed as binary data. 2002-07-29 Mo DeJong * unix/Makefile.in: Use CC_SEARCH_FLAGS instead of LD_SEARCH_FLAGS when linking with ${CC}. * unix/configure: Regen. * unix/configure.in: Don't subst CC_SEARCH_FLAGS or LD_SEARCH_FLAGS since this is now done in tcl.m4. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Document and set CC_SEARCH_FLAGS whenever LD_SEARCH_FLAGS is set. [Patch 588290] 2002-07-29 Reinhard Max * unix/tcl.m4 (SC_SERIAL_PORT): Fixed detection for cases when configure's stdin is not a tty. * unix/tclUnixPort.h: * generic/tclIOSock.c: Changed size_t to socklen_t in socket-related function calls. * unix/configure.in: Added test and fallback definition for socklen_t. * unix/configure: generated. 2002-07-29 Miguel Sofer * generic/tclObj.c: fixed a comment * generic/tcl.h: * generic/tclBasic.c: * generic/tclInterp.c: added the new flag TCL_EVAL_INVOKE to the interface of the Tcl_Eval* functions, removing the TCL_EVAL_NO_TRACEBACK added yesterday: alias invocations not only require no tracebacks, but also look up the command name in the global scope - see new test interp-9.4 * tests/interp.test: added 9.3 to test for safety of aliases to hidden commands, 9.4 to test for correct command lookup scope. 2002-07-29 Donal K. Fellows * generic/regc_locale.c (cclass): [[:xdigit:]] is only a defined concept on western characters, so should not allow any unicode digit, and hence number of ranges in [[:xdigit:]] is fixed. * tests/reg.test: Added test to detect the bug. * generic/regc_cvec.c (newcvec): Corrected initial size value in character vector structure. [Bug 578363] Many thanks to pvgoran@users.sf.net for tracking this down. 2002-07-28 Miguel Sofer * generic/tcl.h: * generic/tclBasic.c: added the new flag TCL_EVAL_NO_TRACEBACK to the interface of the Tcl_Eval* functions. Modified the error message for too many nested evaluations. * generic/tclInterp.h: changed the Alias struct to be of variable length and store the prefix arguments directly (instead of a pointer to a Tcl_Obj list). Made AliasObjCmd call Tcl_EvalObjv instead of TclObjInvoke - thus making aliases trigger execution traces [Bug 582522]. * tests/interp.test: * tests/stack.test: adapted to the new error message. * tests/trace.test: added tests for aliases firing the exec traces. 2002-07-27 Mo DeJong * unix/Makefile.in: Revert fix for Tcl bug 529801 since it was incorrect and broke the build on other systems. Fix [Bug 587299]. Add MAJOR_VERSION, MINOR_VERSION, PATCH_LEVEL, SHLIB_LD_FLAGS, SHLIB_LD_LIBS, CC_SEARCH_FLAGS, LD_SEARCH_FLAGS, and LIB_FILE variables to support more generic library build/install rules. * unix/configure: Regen. * unix/configure.in: Move AC_PROG_RANLIB into tcl.m4. Move shared build test and setting of MAKE_LIB and MAKE_STUB_LIB into tcl.m4. Move subst of a number of variables into tcl.m4 where they are defined. * unix/tcl.m4 (SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS): Subst vars where they are defined. Add MAKE_LIB, MAKE_STUB_LIB, INSTALL_LIB, and INSTALL_STUB_LIB rules to deal with the ugly details of running ranlib on static libs at build and install time. Replace TCL_SHLIB_LD_EXTRAS with SHLIB_LD_FLAGS and use it when building a shared library. * unix/tclConfig.sh.in: Add TCL_CC_SEARCH_FLAGS. 2002-07-26 Miguel Sofer * generic/tclExecute.c: fixed Tcl_Obj leak in code corresponding to the macro NEXT_INST_V(x, 0, 1) [Bug 587495]. 2002-07-26 Miguel Sofer * generic/tclVar.c (TclObjLookupVar): leak fix and improved comments. 2002-07-26 Jeff Hobbs * generic/tclVar.c (TclLookupVar): removed early returns that prevented the parens from being restored. Also removed goto label as it was not necessary. 2002-07-24 Miguel Sofer * generic/tclExecute.c: * tests/expr-old.test: fix for erroneous error messages in [expr], [Bug 587140] reported by Martin Lemburg. 2002-07-25 Joe English * generic/tclProc.c: fix for [Tk Bug 219218] "error handling with bgerror in Tk" 2002-07-24 Miguel Sofer * generic/tclExecute.c: restoring full TCL_COMPILE_DEBUG functionality. 2002-07-24 Don Porter * tests/unixInit.test: relaxed unixInit-3.1 to accept iso8859-15 as a valid C encoding. [Bug 575336] 2002-07-24 Miguel Sofer * generic/tclExecute.c: restoring the tcl_traceCompile functionality while I repair tcl_traceExec. The core now compiles and runs also under TCL_COMPILE_DEBUG, but execution in the bytecode engine can still not be traced. 2002-07-24 Daniel Steffen * unix/Makefile.in: * unix/configure.in: corrected fix for [Bug 529801]: ranlib only needed for static builds on Mac OS X. * unix/configure: Regen. * unix/tclLoadDyld.c: fixed small bugs introduced by Vince, implemented library unloading correctly (needs OS X 10.2). 2002-07-23 Joe English * doc/OpenFileChnl.3: (Updates from Larry Virden) * doc/open.n: * doc/tclsh.1: Fix section numbers in Unix man page references. * doc/lset.n: In EXAMPLES section, include command to set the initial value used in subsequent examples. * doc/http.n: Package version updated to 2.4. 2002-07-23 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Enable 64 bit compilation when using the native compiler on a 64 bit version of IRIX. [Bug 219220] 2002-07-23 Mo DeJong * unix/Makefile.in: Combine ranlib tests and avoid printing unless ranlib is actually run. 2002-07-23 Mo DeJong * unix/tcl.m4 (SC_PATH_X): Set XINCLUDES to "" instead of "# no special path needed" or "# no include files found" when x headers cannot be located. 2002-07-22 Vince Darley * generic/tclIOUtil.c: made tclNativeFilesystem static (since 07-19 changes removed its usage elsewhere), and added comments about its usage. * generic/tclLoad.c: * generic/tcl.h: * generic/tcl.decls: * doc/FileSystem.3: converted last load-related ClientData parameter to Tcl_LoadHandle opaque structure, removing a couple of casts in the process. * generic/tclInt.h: removed tclNativeFilesystem declaration since it is now static again. 2002-07-22 Donal K. Fellows * tests/expr.test (expr-22.*): Added tests to help detect the corrected handling. * generic/tclExecute.c (IllegalExprOperandType): Improved error message generated when attempting to manipulate Inf and NaN values. * generic/tclParseExpr.c (GetLexeme): Allowed parser to recognise 'Inf' as a floating-point number. [Bug 218000] 2002-07-21 Don Porter * tclIOUtil.c: Silence compiler warning. [Bug 584408]. 2002-07-19 Vince Darley * generic/tclIOUtil.c: fix to GetFilesystemRecord * win/tclWinFile.c: * unix/tclUnixFile.c: fix to subtle problem with links shown up by latest tclkit builds. 2002-07-19 Mo DeJong * unix/configure: * unix/configure.in: * win/configure: * win/configure.in: Add AC_PREREQ(2.13) in an attempt to make it more clear that the configure scripts must be generated with autoconf version 2.13. [Bug 583573] 2002-07-19 Vince Darley * unix/Makefile.in: fix to build on MacOS X [Bug 529801], bug report and fix from jcw. 2002-07-19 Donal K. Fellows * win/tclWinSerial.c (no_timeout): Made this variable static. * generic/tclExecute.c, generic/tclCompile.c, generic/tclBasic.c: * generic/tclCompile.h (builtinFuncTable, instructionTable): Added prefix to these symbols because they are visible outside the Tcl library. * generic/tclCompExpr.c (operatorTable): * unix/tclUnixTime.c (tmKey): * generic/tclIOUtil.c (theFilesystemEpoch, filesystemWantToModify, filesystemIteratorsInProgress, filesystemOkToModify): Made these variables static. * unix/tclUnixFile.c: Renamed nativeFilesystem to * win/tclWinFile.c: tclNativeFilesystem and declared * generic/tclIOUtil.c: it properly in tclInt.h * generic/tclInt.h: * generic/tclUtf.c (totalBytes): Made this array static and const. * generic/tclParse.c (typeTable): Made this array static and const. (Tcl_ParseBraces): Simplified error handling case so that scans are only performed when needed, and flags are simpler too. * license.terms: Added AS to list of copyright holders; it's only fair for the current gatekeepers to be listed here! * tests/cmdMZ.test: Renamed constraint for clarity. [Bug 583427] Added tests for the [time] command, which was previously only indirectly tested! 2002-07-18 Vince Darley * generic/tclInt.h: * generic/tcl.h: * */*Load*.c: added comments on changes of 07/17 and replaced clientData with Tcl_LoadHandle in all locations. * generic/tclFCmd.c: * tests/fileSystem.test: fixed a 'knownBug' with 'file attributes ""' * tests/winFCmd.test: * tests/winPipe.test: * tests/fCmd.test: * tessts/winFile.test: added 'pcOnly' constraint to some tests to make for more useful 'tests skipped' log from running all tests on non-Windows platforms. 2002-07-17 Miguel Sofer * generic/tclBasic.c (CallCommandTraces): delete traces now receive the FQ old name of the command. [Bug 582532] (Don Porter) 2002-07-18 Vince Darley * tests/ioUtil.test: added constraints to 1.4,2.4 so they don't run outside of tcltest. [Bugs 583276, 583277] 2002-07-17 Miguel Sofer * generic/tclVar.c (DupParsedVarName): nasty bug fixed, reported by Vince Darley. 2002-07-17 Miguel Sofer * generic/tclVar.c (TclPtrIncrVar): missing CONST in declarations, inconsistent with tclInt.h. Thanks to Vince Darley for reporting, boo to gcc for not complaining. 2002-07-17 Vince Darley * generic/tclInt.h: * generic/tclIOUtil.c: * generic/tclLoadNone.c: * unix/tclLoadAout.c: * unix/tclLoadDl.c: * unix/tclLoadDld.c: * unix/tclLoadDyld.c: * unix/tclLoadNext.c: * unix/tclLoadOSF.c: * unix/tclLoadShl.c: * mac/tclMacLoad.c: * win/tclWinLoad.c: modified to move more functionality to the generic code and avoid duplication. Partial replacement of internal uses of clientData with opaque Tcl_LoadHandle. A little further work still needed, but significant changes are done. 2002-07-17 D. Richard Hipp * library/msgcat/msgcat.tcl: fix a comment that was causing problems for programs (ex: mktclapp) that embed the initialization scripts in strings. 2002-07-17 Miguel Sofer * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclVar.c: removing the now redundant functions to access indexed variables: Tcl(Get|Set|Incr)IndexedScalar() and Tcl(Get|Set|Incr)ElementOfIndexedArray(). 2002-07-17 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Minor fixes to make this file compile with SunPro CC... 2002-07-17 Miguel Sofer * generic/tclExecute.c: modified to do variable lookup explicitly, and then either inlining the variable access or else calling the new TclPtr(Set|Get|Incr)Var functions in tclVar.c * generic/tclInt.h: declare some functions previously local to tclVar.c for usage by TEBC. * generic/tclVar.c: removed local declarations; moved all special accessor functions for indexed variables to the end of the file - they are unused and ready for removal, but left there for the time being as they are in the internal stubs table. ** WARNING FOR BYTECODE MAINTAINERS ** TCL_COMPILE_DEBUG is currently not functional; will be fixed ASAP. 2002-07-16 Mo DeJong * unix/Makefile.in: * win/Makefile.in: Add a more descriptive warning in the event `make genstubs` needs to be rerun. 2002-07-16 Mo DeJong * unix/Makefile.in: Use dltest.marker file to keep track of when the dltest package is up to date. This fixes [Bug 575768] since tcltest is no longer linked every time. * unix/dltest/Makefile.in: Create ../dltest.marker after a successful `make all` run in dltest. 2002-07-16 Mo DeJong * unix/configure: Regen. * unix/configure.in: Remove useless subst of TCL_BIN_DIR. 2002-07-15 Miguel Sofer * generic/tclVar.c: inaccurate comment fixed 2002-07-15 Miguel Sofer * generic/tclBasic.c (Tcl_AddObjErrorInfo): * generic/tclExecute.c (TclUpdateReturnInfo): * generic/tclInt.h: * generic/tclProc.c: Added two Tcl_Obj to the ExecEnv structure to hold the fully qualified names "::errorInfo" and "::errorCode" to cache the addresses of the corresponding variables. The two most frequent setters of these variables now profit from the new variable name caching. 2002-07-15 Miguel Sofer * generic/tclVar.c: refactorisation to reuse already looked-up Var pointers; definition of three new Tcl_Obj types to cache variable name parsing and lookup for later reuse; modification of internal functions to profit from the caching. * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclNamesp.c: adding CONST qualifiers to variable names passed to Tcl_FindNamespaceVar and to variable resolvers; adding CONST qualifier to the 'msg' argument to TclLookupVar. Needed to avoid code duplication in the new tclVar.c code. * tests/set-old.test: * tests/var.test: slight modification of error messages due to the modifications in the tclVar.c code. 2002-07-15 Don Porter * tests/unixInit.test: Improved constraints to protect /tmp. [Bug 581403] 2002-07-15 Vince Darley * tests/winFCmd.test: renamed 'win2000' and 'notWin2000' to more appropriate constraint names. * win/tclWinFile.c: updated comments to reflect 07-11 changes. * win/tclWinFCmd.c: made ConvertFileNameFormat static again, since no longer used in tclWinFile.c * mac/tclMacFile.c: completed TclpObjLink implementation which was previously lacking. * generic/tclIOUtil.c: comment cleanup and code speedup. 2002-07-14 Don Porter * generic/tclInt.h: Removed declarations that duplicated entries in the (internal) stub table. * library/tcltest/tcltest.tcl: Corrected errors in handling of configuration options -constraints and -limitconstraints. * README: Bumped HEAD to version 8.4b2 so we can * generic/tcl.h: distinguish it from the 8.4b1 release. * tools/tcl.wse.in: * unix/configure*: * unix/tcl.spec: * win/README.binary: * win/configure*: 2002-07-11 Vince Darley * doc/file.n: * win/tclWinFile.c: on Win 95/98/ME the long form of the path is used as a normalized form. This is required because short forms are not a robust representation. The file normalization function has been sped up, but more performance gains might be possible, if speed is still an issue on these platforms. 2002-07-11 Don Porter * library/tcltest/tcltest.tcl: Corrected reaction to existing but false ::tcl_interactive. * doc/Hash.3: Overlooked CONST documentation update. 2002-07-11 Donal K. Fellows * generic/tclCkalloc.c: ckalloc() and friends take the block size as an unsigned, so we should use %ud when reporting it in fprintf() and panic(). 2002-07-11 Miguel Sofer * generic/tclCompile.c: now setting local vars undefined at compile time, instead of waiting until the proc is initialized. * generic/tclProc.c: use macro TclSetVarUndefined instead of directly setting the flag. 2002-07-11 Donal K. Fellows * tests/cmdAH.test: [file attr -perm] is Unix-only, so add [catch] when not inside a suitably-protected test. 2002-07-10 Donal K. Fellows * tests/unixFCmd.test, tests/fileName.test: * tests/fCmd.test: Removed [exec] of Unix utilities that have equivalents in standard Tcl. [Bug 579268] Also simplified some of unixFCmd.test while I was at it. 2002-07-10 Don Porter * tests/tcltest.test: Greatly reduced the number of [exec]s, using slave interps instead. * library/tcltest/tcltest.tcl: Fixed bug uncovered in the conversion where a message was written to stdout instead of [outputChannel]. * tests/basic.test: Cleaned up, constrained, and reduced the * tests/compile.test: amount of [exec] usage in the test suite. * tests/encoding.test: * tests/env.test: * tests/event.test: * tests/exec.test: * tests/io.test: * tests/ioCmd.test: * tests/regexp.test: * tests/regexpComp.test: * tests/socket.test: * tests/tcltest.test: * tests/unixInit.test: * tests/winDde.test: * tests/winPipe.test: 2002-07-10 Donal K. Fellows * tests/cmdAH.test: Removed [exec] of Unix utilities. [Bug 579211] * tests/expr.test: Added tests to make sure that this works. * generic/tclExecute.c (ExprCallMathFunc): Functions should also be able to return wide-ints. [Bug 579284] 2002-07-08 Andreas Kupries * tests/socket.test: Fixed [Bug 578164]. The original reason for the was a DNS outage while running the testsuite. Changed [info hostname] to 127.0.0.1 to bypass DNS, knowing that we operate on the local host. 2002-07-08 Don Porter * doc/tcltest.n: Fixed incompatibility in [viewFile]. * library/tcltest/tcltest.tcl: Corrected docs. Bumped to 2.2.1. * library/tcltest/pkgIndex.tcl: [Bug 578163] 2002-07-08 Vince Darley * tests/cmdAH.test: * tests/fCmd.test: * tests/fileName.test: tests which rely on 'file link' need a constraint so they don't run on older Windows OS. [Bug 578158] * generic/tclIOUtil.c: * generic/tcl.h: * generic/tclInt.h: * generic/tclTest.c: * mac/tclMacChan.c: * unix/tclUnixChan.c: * win/tclWinChan.c: * doc/FileSystem.3: cleaned up internal handling of Tcl_FSOpenFileChannel to remove duplicate code, and make writing external vfs's clearer and easier. No functionality change. Also clarify that objects with refCount zero should not be passed in to the Tcl_FS API, and prevent segfaults from occuring on such user errors. [Bug 578617] 2002-07-06 Don Porter * tests/pkgMkIndex.test: Constrained tests of [load] package indexing to those platforms where the testing shared libraries have been built. [Bug 578166] 2002-07-05 Don Porter * changes: added recent changes 2002-07-05 Reinhard Max * generic/tclClock.c (FormatClock): Convert the format string to utf-8 before calling TclpStrftime, so that non-ASCII characters don't get mangled when the result string is being converted back. * tests/clock.test: Added a test for that. 2002-07-05 Donal K. Fellows * unix/Makefile.in (ro-test,ddd,GDB,DDD): Created new targets to allow running the test suite with a read-only current directory, running under ddd instead of gdb, and factored out some executable names for broken sites (like mine) where gdb and ddd are installed with non-standard names... * tests/httpold.test: Altered test names to httpold-* to avoid clashes with http.test, and stopped tests from failing when the current directory is not writable... * tests/event.test: Stop these tests from failing when the * tests/ioUtil.test: current directory is not writable... * tests/regexp.test: * tests/regexpComp.test: * tests/source.test: * tests/unixFile.test: * tests/unixNotfy.test: * tests/unixFCmd.test: Trying to make these test-files not * tests/macFCmd.test: bomb out with an error when the * tests/http.test: current directory is not writable... * tests/fileName.test: * tests/env.test: 2002-07-05 Jeff Hobbs *** 8.4b1 TAGGED FOR RELEASE *** 2002-07-04 Donal K. Fellows * tests/cmdMZ.test (cmdMZ-1.4): * tests/cmdAH.test: More fixing of writable-current-dir assumption. [Bug 575824] 2002-07-04 Miguel Sofer * tests/basic.test: Same issue as below; fixed [Bug 575817] 2002-07-04 Andreas Kupries * tests/socket.test: * tests/winPipe.test: * tests/pid.test: Fixed [Bug 575848]. See below for a description the general problem. * All the bugs below are instances of the same problem: The testsuite assumes [pwd] = [temporaryDirectory] and writable. * tests/iogt.test: Fixed [Bug 575860]. * tests/io.test: Fixed [Bug 575862]. * tests/exec.test: * tests/ioCmd.test: Fixed [Bug 575836]. 2002-07-03 Don Porter * tests/pkg1/direct1.tcl: removed * tests/pkg1/pkgIndex.tcl: removed * tests/pkgMkIndex.test: Imported auxilliary files from tests/pkg1 into the test file pkgMkIndex.test itself. Formatting fixes. * unix/Makefile.in: removed tests/pkg/* from `make dist` * tests/pkg/circ1.tcl: removed * tests/pkg/circ2.tcl: removed * tests/pkg/circ3.tcl: removed * tests/pkg/global.tcl: removed * tests/pkg/import.tcl: removed * tests/pkg/pkg1.tcl: removed * tests/pkg/pkg2_a.tcl: removed * tests/pkg/pkg2_b.tcl: removed * tests/pkg/pkg3.tcl: removed * tests/pkg/pkg4.tcl: removed * tests/pkg/pkg5.tcl: removed * tests/pkg/pkga.tcl: removed * tests/pkg/samename.tcl: removed * tests/pkg/simple.tcl: removed * tests/pkg/spacename.tcl: removed * tests/pkg/std.tcl: removed * tests/pkgMkIndex.test: Fixed [Bug 575857] where this test file expected to be able to write to [file join [testsDirectory] pkg]. Part of the fix was to import several auxilliary files into the test file itself. * tests/main.test: Cheap fix for [Bugs 575851, 575858]. Avoid * tests/tcltest.test: non-writable . by [cd [temporaryDirectory]]. * library/auto.tcl: Fix [tcl_findLibrary] to be sure it sets $varName only if a successful library script is found. [Bug 577033] 2002-07-03 Miguel Sofer * generic/tclCompCmds.c (TclCompileCatchCmd): return TCL_OUT_LINE_COMPILE instead of TCL_ERROR: let the failure happen at runtime so that it can be caught [Bug 577015]. 2002-07-02 Joe English * doc/tcltest.n: Markup fixes, spellcheck. 2002-07-02 Don Porter * doc/tcltest.n: more refinements of the documentation. * library/tcltest/tcltest.tcl: Added trace to be sure the stdio constraint is updated whenever the [interpreter] changes. * doc/tcltest.n: Reverted [makeFile] and [viewFile] to * library/tcltest/tcltest.tcl: their former behavior, and documented * tests/cmdAH.test: it. Corrected misspelling of hook * tests/event.test: procedure. Restored tests. * tests/http.test: * tests/io.test: * library/tcltest/tcltest.tcl: Simplified logic of [GetMatchingFiles] and [GetMatchingDirectories], removing special case processing. * doc/tcltest.n: More documentation updates. Reference sections are complete. Only examples need adding. 2002-07-02 Vince Darley * tests/fCmd.test: * generic/tclCmdAH.c: clearer error msgs for 'file link', as per the man page. 2002-07-01 Joe English * doc/Access.3: * doc/AddErrInfo.3: * doc/Alloc.3: * doc/Backslash.3: * doc/CrtChannel.3: * doc/CrtSlave.3: * doc/Encoding.3: * doc/Eval.3: * doc/FileSystem.3: * doc/Notifier.3: * doc/OpenFileChnl.3: * doc/ParseCmd.3: * doc/RegExp.3: * doc/Tcl_Main.3: * doc/Thread.3: * doc/TraceCmd.3: * doc/Utf.3: * doc/WrongNumArgs.3: * doc/binary.n: * doc/clock.n: * doc/expr.n: * doc/fconfigure.n: * doc/glob.n: * doc/http.n: * doc/interp.n: * doc/lsearch.n: * doc/lset.n: * doc/msgcat.n: * doc/packagens.n: * doc/pkgMkIndex.n: * doc/registry.n: * doc/resource.n: * doc/safe.n: * doc/scan.n: * doc/tclvars.n: Spell-check, fixed typos (Updates from Larry Virden). 2002-07-01 Donal K. Fellows * unix/tcl.m4 (SC_CONFIG_CFLAGS): Made Solaris use gcc for linking when building with gcc to resolve problems with undefined symbols being present when tcl library used with non-gcc linker at later stage. Symbols were compiler-generated, so it is the compiler's business to define them. [Bug 541181] 2002-07-01 Don Porter * doc/tcltest.n: more work in progress updating tcltest docs. * library/tcltest/tcltest.tcl: Change [configure -match] to stop treating an empty list as a list of the single pattern "*". Changed the default value to [list *] so default operation remains the same. * tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test. * library/tcltest/tcltest.tcl: restored writability testing of -tmpdir, augmented by a special exception for the deafault value. 2002-07-01 Donal K. Fellows * doc/concat.n: Documented the *real* behaviour of [concat]! 2002-06-30 Don Porter * doc/tcltest.n: more work in progress updating tcltest docs. * tests/README: Updated the instructions on running and * tests/cmdMZ.test: adding to the test suite. Also updated * tests/encoding.test: several tests, mostly to correctly create * tests/fCmd.test: and destroy any temporary files in the * tests/info.test: [temporaryDirectory] of tcltest. * tests/interp.test: * library/tcltest/tcltest.tcl: Stopped checking for writability of -tmpdir value because no default directory can be guaranteed to be writable. * tests/autoMkindex.tcl: removed. * tests/pkg/samename.tcl: removed. * tests/pkg/magicchar.tcl: removed. * tests/pkg/magicchar2.tcl: removed. * tests/autoMkindex.test: Updated auto_mkIndex tests to use [makeFile] and [removeFile] so tests are done in [temporaryDirecotry] where write access is guaranteed. * library/tcltest/tcltest.tcl: Fixed [makeFile] and [viewFile] to * tests/cmdAH.test: accurately reflect a file's contents. * tests/event.test: Updated tests that depended on buggy * tests/http.test: behavior. Also added warning messages * tests/io.test: to "-debug 1" operations to debug test * tests/iogt.test: calls to (make|remove)(File|Directory) * unix/mkLinks: `make mklinks` on 6-27 commits. 2002-06-28 Miguel Sofer * generic/tclCompile.h: modified the macro TclEmitPush to not call its first argument repeatedly or pass it to other macros, [Bug 575194] reported by Peter Spjuth. 2002-06-28 Don Porter * docs/tcltest.n: Doc revisions in progress. * library/tcltest/tcltest.tcl: Corrected -testdir default value. Was not reliable, and disagreed with docs! Thanks to Hemang Lavana. [Bug 575150] 2002-06-28 Donal K. Fellows * unix/tclUnixThrd.c: Renamed the Tcl_Platform* #defines to TclOS* * unix/tclUnixPipe.c: because they are only used internally. Also * unix/tclUnixFile.c: stopped double-#def of TclOSlstat [Bug 566099, * unix/tclUnixFCmd.c: post-rename] * unix/tclUnixChan.c: * unix/tclUnixPort.h: * doc/string.n: Improved documentation for [string last] along lines described in [Bug 574799] so it indicates that the supplied index marks the end of the search space. 2002-06-27 Don Porter * doc/dde.n: Work in progress updating the documentation * doc/http.n: of the packages that come bundled with * doc/msgcat.n: the Tcl source distribution, notably tcltest. * doc/registry.n: * doc/tcltest.n: * library/tcltest/tcltest.tcl: Made sure that the TCLTEST_OPTIONS environment variablle configures tcltest at package load time. 2002-06-26 Vince Darley * tests/fileSystem.test: * generic/tclIOUtil.c: fix to handling of empty paths "" which are not claimed by any filesystem [Bug 573758]. Ensure good error messages are given in all cases. * tests/cmdAH.test: * unix/tclUnixFCmd.c: fix to bug reported as part of [Patch 566669]. Thanks to Taguchi, Takeshi for the report. 2002-06-26 Reinhard Max * unix/tclUnixTime.c: Make [clock format] respect locale settings. * tests/clock.test: [Bug 565880]. ***POTENTIAL INCOMPATIBILITY*** 2002-06-26 Miguel Sofer * doc/CrtInterp.3: * doc/StringObj.3: clarifications by Don Porter, [Bug 493995] and [Bug 500930]. 2002-06-24 Don Porter * library/tcltest/tcltest.tcl: Corrected suppression of -verbose skip * tests/tcltest.test: and start by [test -output]. Also corrected test suite errors exposed by corrected code. [Bug 564656] 2002-06-25 Reinhard Max * unix/tcl.m4: New macro SC_CONFIG_MANPAGES. * unix/configure.in: Added support for symlinks and compression when * unix/Makefile.in: installing the manpages. [Patch 518052] * unix/mkLinks.tcl: Default is still hardlinks and no compression. * unix/mkLinks: generated * unix/configure: * unix/README: Added documentation for the new features. * unix/tcl.m4 (SC_PATH_TCLCONFIG): Replaced ${exec_prefix}/lib by ${libdir}. 2002-06-25 Donal K. Fellows * generic/tclUtil.c (TclGetIntForIndex): Fix of critical [Bug 533364] generated when the index is bad and the result is a shared object. The T_ASTO(T_GOR, ...) idiom likely exists elsewhere though. Also removed some cruft that just complicated things to no advantage. (SetEndOffsetFromAny): Same fix, though this wasn't on the path excited by the bug. 2002-06-24 Don Porter * library/tcltest/tcltest.tcl: Implementation of TIP 101. Adds abd * tests/parseOld.test: exports a [configure] command from * tests/tcltest.test: tcltest. 2002-06-22 Don Porter * changes: updated changes file for 8.4b1 release. * library/tcltest/tcltest.tcl: Corrections to tcltest and the Tcl * tests/basic.test: test suite so that a test with options * tests/cmdInfo.test: -constraints knownBug * tests/compile.test: -limitConstraints 1 only tests the * tests/encoding.test: knownBug tests. Mostly involves * tests/env.test: replacing direct access to the * tests/event.test: testConstraints array with calls to * tests/exec.test: the testConstraint command (which * tests/execute.test: requires tcltest version 2) * tests/fCmd.test: * tests/format.test: * tests/http.test: * tests/httpold.test: * tests/ioUtil.test: * tests/link.test: * tests/load.test: * tests/namespace.test: * tests/pkgMkIndex.test: * tests/reg.test: * tests/result.test: * tests/scan.test: * tests/stack.test: 2002-06-22 Donal K. Fellows * tools/tcl.wse.in (Disk Label), unix/tcl.spec (version): * win/README.binary, README, win/configure.in, unix/configure.in: * generic/tcl.h (TCL_RELEASE_*, TCL_PATCH_LEVEL): Bump to beta1. 2002-06-21 Joe English * generic/tclCompExpr.c: * generic/tclParseExpr.c: LogSyntaxError() should reset the interpreter result [Bug 550142 "Tcl_ExprObj -> abort"] 2002-06-21 Don Porter * unix/Makefile.in: Updated all package install directories * win/Makefile.in: to match current Major.minor versions * win/makefile.bc: of the packages. Added tcltest package * win/makefile.vc: to installation on Windows. * library/init.tcl: Corrected comments and namespace style issues. Thanks to Bruce Stephens. [Bug 572025] 2002-06-21 Vince Darley * tests/cmdAH.test: Added TIP#99 implementation of 'file * tests/fCmd.test: link'. Supports creation of symbolic and * tests/fileName.test: hard links in the native filesystems and * tests/fileSystem.test: in vfs's, when the individual filesystem * generic/tclTest.c: supports the concept. * generic/tclCmdAH.c: * generic/tclIOUtil.c: * generic/tcl.h: * generic/tcl.decls: * doc/FileSystem.3: * doc/file.n: * mac/tclMacFile.c: * unix/tclUnixFile.c: * win/tclWinFile.c: Also enhanced speed of 'file normalize' on Windows. 2002-06-20 Miguel Sofer * generic/tclBasic.c (TclEvalObjvInternal): fix for [Bug 571385] in the implementation of TIP#62 (command tracing). Vince Darley, Hemang Lavana & Don Porter: thanks. 2002-06-20 Miguel Sofer * generic/tclExecute.c (TclCompEvalObj): clarified and simplified the logic for compilation/recompilation. 2002-06-19 Joe English * doc/file.n: Fixed indentation. No substantive changes. 2002-06-19 Jeff Hobbs * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): get the resultPtr again as the Tcl_ObjSetVar2 may cause the result to change. [Patch 558324] (watson) 2002-06-19 Miguel Sofer * generic/tclExecute.c (TEBC): removing unused "for(;;)" loop; improved comments; re-indentation. 2002-06-18 Miguel Sofer * generic/tclExecute.c (TEBC): - elimination of duplicated code in the non-immediate INST_INCR instructions. - elimination of 103 (!) TclDecrRefCount macros. The different instructions now jump back to a common "DecrRefCount zone" at the top of the loop. The macro "ADJUST_PC" was replaced by two macros "NEXT_INST_F" and "NEXT_INST_V" that take three params (pcAdjustment, # of stack objects to discard, resultObjPtr handling flag). The only instructions that retain a TclDecrRefCount are INST_POP (for speed), the common code for the non-immediate INST_INCR, INST_FOREACH_STEP and the two INST_LSET. The object size of tclExecute.o was reduced by approx 20% since the start of the consolidation drive, while making room for some peep-hole optimisation at runtime. 2002-06-18 Miguel Sofer * generic/tclExecute.c (TEBC, INST_DONE): small bug in the panic code for tcl-stack corruption. 2002-06-17 David Gravereaux Trims to support the removal of RESOURCE_INCLUDED from rc scripts from [FRQ 565088]. * generic/tcl.h: moved the #ifndef RC_INVOKED start block up in the file. rc scripts don't need to know thread mutexes. * win/tcl.rc: * win/tclsh.rc: removed the #define RESOURCE_INCLUDED to let the built-in -DRC_INVOKED to the work. 2002-06-17 Jeff Hobbs * doc/CrtTrace.3: Added TIP#62 implementation of command * doc/trace.n: execution tracing [FRQ 462580] (lavana). * generic/tcl.h: This includes enter/leave tracing as well * generic/tclBasic.c: as inter-procedure stepping. * generic/tclCmdMZ.c: * generic/tclCompile.c: * generic/tclExecute.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclVar.c: * tests/trace.test: 2002-06-17 Andreas Kupries * win/tclWinPipe.c (BuildCommandLine): Fixed [Bug 554068] ([exec] on windows did not treat { in filenames well.). Bug reported by Vince Darley , patch provided by Vince too. 2002-06-17 Joe English * generic/tcl.h: #ifdef logic for K&R C backwards compatibility changed to assume modern C by default. See [FRQ 565088] for full details. 2002-06-17 Don Porter * doc/msgcat.n: Corrected en_UK references to en_GB. UK is not a country designation recognized in ISO 3166. * library/msgcat/msgcat.tcl: More Windows Registry locale codes from Bruno Haible. * doc/msgcat.n: * library/msgcat/msgcat.tcl: * library/msgcat/pkgIndex.tcl: * tests/msgcat.test: Revised locale initialization to interpret environment variable locale values according to XPG4, and to recognize the LC_ALL and LC_MESSAGES values over that of LANG. Also added many Windows Registry locale values to those recognized by msgcat. Revised tests and docs. Bumped to version 1.3. Thanks to Bruno Haible for the report and assistance crafting the solution. [Bug 525522, 525525] 2002-06-16 Miguel Sofer * generic/tclCompile.c (TclCompileTokens): a better algorithm for the previous bug fix. 2002-06-16 Miguel Sofer * generic/tclCompile.c (TclCompileTokens): * tests/compile.test: [Bug 569438] in the processing of dollar variables; report by Georgios Petasis. 2002-06-16 Miguel Sofer * generic/tclExecute.c: bug in the consolidation of the INCR_..._STK instructions; the bug could not be exercised as the (faulty) instruction INST_INCR_ARRAY_STK was never compiled-in (related to [Bug 569438]). 2002-06-14 Miguel Sofer * generic/tclExecute.c (TclExecuteByteCode): runtime peep-hole optimisation of variables (INST_STORE, INST_INCR) and commands (INST_INVOKE); faster check for the existence of a catch. (TclExecuteByteCode): runtime peep-hole optimisation of comparisons. (TclExecuteByteCode): runtime peep-hole optimisation of INST_FOREACH - relies on peculiarities of the code produced by the bytecode compiler. 2002-06-14 David Gravereaux * win/rules.vc: The test for compiler optimizations was in error. Thanks goes to Roy Terry for his assistance with this. 2002-06-14 Donal K. Fellows * doc/trace.n, tests/trace.test: * generic/tclCmdMZ.c (Tcl_TraceObjCmd,TclTraceCommandObjCmd) (TclTraceVariableObjCmd): Changed references to "trace list" to "trace info" as mandated by TIP#102. 2002-06-13 Miguel Sofer * generic/tclExecute.c (TclExecuteByteCode): consolidated code for the conditional branch instructions. 2002-06-13 Miguel Sofer * generic/tclExecute.c (TclExecuteByteCode): fixed the previous patch; wouldn't compile with TCL_COMPILE_DEBUG set. 2002-06-13 Miguel Sofer * generic/tclExecute.c (TclExecuteByteCode): consolidated the handling of exception returns to INST_INVOKE and INST_EVAL, as well as most of the code for INST_CONTINUE and INST_BREAK, in the new jump target "processExceptionReturn". 2002-06-13 Miguel Sofer * generic/tclExecute.c (TclExecuteByteCode): consolidated variable handling opcodes, replaced redundant code with some 'goto'. All store/append/lappend opcodes on the same data type now share the main code; same with incr opcodes. * generic/tclVar.c: added the bit TCL_TRACE_READS to the possible flags to Tcl_SetVar2Ex - it causes read traces to be fired prior to setting the variable. This is used in the core for [lappend]. ***NOTE*** the usage of TCL_TRACE_READS in Tcl_(Obj)?GetVar.* is not documented; there, it causes the call to create the variable if it does not exist. The new usage in Tcl_(Obj)?SetVar.* remains undocumented too ... 2002-06-13 Vince Darley * tests/fCmd.test: * tests/winFile.test: * tests/fileSystem.test: * generic/tclTest.c: * generic/tclCmdAH.c: * generic/tclIOUtil.c: * doc/FileSystem.3: * mac/tclMacFile.c: * unix/tclUnixFile.c: * win/tclWinFile.c: fixed up further so both compiles and actually works with VC++ 5 or 6. * win/tclWinInt.h: * win/tclWin32Dll.c: cleaned up code and vfs tests and added tests for the internal changes of 2002-06-12, to see whether WinTcl on NTFS can coexist peacefully with links in the filesystem. Added new test command 'testfilelink' to enable the newer code to be tested. * tests/fCmd.test: (made certain tests of 'testfilelink' not run on unix). 2002-06-12 Miguel Sofer * tclBasic.c (Tcl_DeleteTrace): fixed [Bug 568123] (thanks to Hemang Lavana) 2002-06-12 Jeff Hobbs * win/tclWinFile.c: corrected the symbolic link handling code to allow it to compile. Added real definition of REPARSE_DATA_BUFFER (found in winnt.h). Most of the added definitions appear to have correct, cross-Win-version equivalents in winnt.h and should be removed, but just making things "work" for now. 2002-06-12 Vince Darley * generic/tclIOUtil.c: * generic/tcl.decls: * generic/tclDecls.h: made code for Tcl_FSNewNativePath agree with man pages. * doc/FileSystem.3: clarified the circumstances under which certain functions are called in the presence of symlinks. * win/tclWinFile.c: * win/tclWinPort.h: * win/tclWinInt.h: * win/tclWinFCmd.c: Fix for Windows to allow 'file lstat', 'file type', 'glob -type l', 'file copy', 'file delete', 'file normalize', and all VFS code to work correctly in the presence of symlinks (previously Tcl's behaviour was not very well defined). This also fixes possible serious problems in all versions of WinTcl where 'file delete' on a NTFS symlink could delete the original, not the symlink. Note: symlinks cannot yet be created in pure Tcl. 2002-06-11 Miguel Sofer * generic/tclBasic.c: * generic/tclCompCmds.c: * generic/tclInt.h: reverted the new compilation functions; replaced by a more general approach described below. * generic/tclCompCmds.c: * generic/tclCompile.c: made *all* compiled variable access attempts create an indexed variable - even get or incr without previous set. This allows indexed access to local variables that are created and set at runtime, for example by [global], [upvar], [variable], [regexp], [regsub]. 2002-06-11 Miguel Sofer * 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 * generic/tclExecute.c: optimised algorithm for exception range lookup; part of [Patch 453709]. 2002-06-10 Vince Darley * unix/tclUnixFCmd.c: fixed [Bug 566669] * generic/tclIOUtil.c: improved and sped up handling of native paths (duplication and conversion to normalized paths), particularly on Windows. * modified part of above commit, due to problems on Linux. Will re-examine bug report and evaluate more closely. 2002-06-07 Don Porter * tests/tcltest.test: More corrections to test suite so that tests of failing [test]s don't show up themselves as failing tests. 2002-06-07 Donal K. Fellows * generic/tclExecute.c: Tidied up headers in relation to float.h to cut the cruft and ensure DBL_MAX is defined since doubles seem to be the same size everywhere; if the assumption isn't true, the variant platforms had better have run configure... * unix/tclUnixPort.h (EOVERFLOW): Added code to define it if it wasn't previously defined. Also some other general tidying and adding of comments. [Bugs 563122, 564595] * compat/tclErrno.h: Added definition for EOVERFLOW copied from Solaris headers; I've been unable to find any uses of EFTYPE, which was the error code previously occupying the slot, in Tcl, or any definition of it in the Solaris headers. 2002-06-06 Mo DeJong * unix/dltest/Makefile.in: Remove hard coded CFLAGS=-g and add CFLAGS_DEBUG, CFLAGS_OPTIMIZE, and CFLAGS_DEFAULT varaibles. [Bug 565488] 2002-06-06 Don Porter * tests/tcltest.test: Corrections to test suite so that tests of failing [test]s don't show up themselves as failing tests. * tests/io.test: Fixed up namespace variable resolution issues revealed by running test suite with "-singleproc 1". * doc/tcltest.n: * library/tcltest/tcltest.tcl: * tests/tcltest.test: Several updates to tcltest. 1) changed to lazy initialization of test constraints 2) deprecated [initConstraintsHook] 3) repaired badly broken [limitConstraints]. 4) deprecated [threadReap] and [mainThread] [Patch 512214, Bug 558742, Bug 461000, Bug 534903] 2002-06-06 Daniel Steffen * unix/tclUnixThrd.c (TclpReaddir, TclpLocaltime, TclpGmtime): added mutex wrapped calls to readdir, localtime & gmtime in case their thread-safe *_r counterparts are not available. * unix/tcl.m4: added configure check for readdir_r * unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on MacOSX (where Posix file apis expect utf-8, not iso8859-1). * unix/configure: regen * unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel to LD_LIBRARY_PATH for MacOSX dynamic linker. * generic/tclEnv.c (TclSetEnv): fix env var setting on MacOSX (adapted from [Patch 524352] by jkbonfield). 2002-06-05 Don Porter * doc/Tcl_Main.3: Documented $tcl_rcFileName and added more clarifications about the intended use of Tcl_Main(). [Bug 505651] 2002-06-05 Daniel Steffen * generic/tclFileName.c (TclGlob): mac specific fix to recent changes in 'glob -tails' handling. * mac/tclMacPort.h: * mac/tclMacChan.c: fixed TIP#91 bustage. * mac/tclMacResource.c (Tcl_MacConvertTextResource): added utf conversion of text resource contents. * tests/macFCmd.test (macFCmd-1.2): allow CWIE creator. 2002-06-04 Don Porter * library/tcltest/tcltest.tcl: * tests/init.test: * tests/tcltest.test: Added more TIP 85 tests from Arjen Markus. Converted tcltest.test to use a private namespace. Fixed bugs in [tcltest::Eval] revealed by calling [tcltest::test] from a non-global namespace, and namespace errors in init.test. 2002-06-04 Mo DeJong * win/README: Update msys+mingw URL. 2002-06-03 Don Porter * doc/tcltest.n: * library/tcltest/tcltest.tcl: * library/tcltest/pkgIndex.tcl: * tests/tcltest.test: Implementation of TIP 85. Allows tcltest users to add new legal values of the -match option to [test], associating each with a Tcl command that does the matching of expected results with actual results of tests. Thanks to Arjen Markus. => tcltest 2.1 [Patch 521362] 2002-06-03 Miguel Sofer * doc/namespace.n: added description of [namepace forget] behaviour for unqualified patterns. [Bug 559268] 2002-06-03 Miguel Sofer * generic/tclExecute.c: reverting an accidental modification in the last commit. 2002-06-03 Miguel Sofer * doc/Tcl.n: clarify the empty variable name issue ([Bug 549285] reported by Tom Krehbiel, patch by Don Porter). 2002-05-31 Don Porter * library/package.tcl: Fixed leak of slave interp in [pkg_mkIndex]. Thanks to Helmut for report. [Bug 550534] * tests/io.test: * tests/main.test: Use the "stdio" constraint to control whether an [open "|[interpreter]"] is attempted. * generic/tclExecute.c (TclMathInProgress,TclExecuteByteCode (ExprCallMathFunc): * generic/tclInt.h (TclMathInProgress): * unix/Makefile.in (tclMtherr.*): * unix/configure.in (NEED_MATHERR): * unix/tclAppInit.c (matherr): * unix/tclMtherr.c (removed file): * win/tclWinMtherr.c (_matherr): Removed internal routine TclMathInProgress and Unix implementation of matherr(). These are now obsolete, dealing with very old versions of the C math library. Windows version is retained in case Borland compilers require it, but it is inactive. Thanks to Joe English. [Bug 474335, Patch 555635] * unix/configure: regen 2002-05-30 Miguel Sofer * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclCompile.h: removed exprIsJustVarRef and exprIsComparison from the ExprInfo and CompileEnv structs. These were set, but not used since dec 1999 [Bug 562383]. 2002-05-30 Vince Darley * generic/tclFileName.c (TclGlob): fix to longstanding 'knownBug' in fileName tests 15.2-15.4, and fix to a new Tcl 8.4 bug in certain uses of 'glob -tails'. * tests/fileName.test: removed 'knownBug' flag from some tests, added some new tests for above bugs. 2002-05-29 Jeff Hobbs * unix/configure: regen'ed * unix/configure.in: replaced bigendian check with autoconf standard AC_C_BIG_ENDIAN, which defined WORDS_BIGENDIAN on bigendian systems. * generic/tclUtf.c (Tcl_UniCharNcmp): * generic/tclInt.h (TclUniCharNcmp): use WORDS_BIGENDIAN instead of TCL_OPTIMIZE_UNICODE_COMPARE to enable memcmp alternative. * generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP): * generic/tclCmdMZ.c (Tcl_StringObjCmd): changed the case for choosing the Tcl_UniCharNcmp compare to when both objs are of StringType, as benchmarks show that is the optimal check (both bigendian and littleendian systems). 2002-05-29 Don Porter * generic/tclMain.c: Removed "dummy" reference to Tcl_LinkVar. It is no longer needed since Tcl_Main() now actually calls Tcl_LinkVar(). Thanks to Joe English for pointing that out. 2002-05-29 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): * generic/tclCmdMZ.c (Tcl_StringObjCmd): Use the macro version. * generic/tclInt.h (TclUniCharNcmp): Optimised still further with a macro for use in sensitive places like tclExecute.c * generic/tclUtf.c (Tcl_UniCharNcmp): Use new flag to figure out when we can use an optimal comparison scheme, and default to the old scheme in other cases which is at least safe. * unix/configure.in (TCL_OPTIMIZE_UNICODE_COMPARE): New optional flag that indicates when we can use memcmp() to compare Unicode strings (i.e. when the high-byte of a Tcl_UniChar precedes the low-byte.) 2002-05-29 Jeff Hobbs * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclUtf.c: added TclpUtfNcmp2 private command that mirrors Tcl_UtfNcmp, but takes n in bytes, not utf-8 chars. This provides a faster alternative for comparing utf strings internally. (Tcl_UniCharNcmp, Tcl_UniCharNcasecmp): removed the explicit end of string check as it wasn't correct for the function (by doc and logic). * generic/tclCmdMZ.c (Tcl_StringObjCmd): reworked the string equal comparison code to use TclpUtfNcmp2 as well as short-circuit for equal objects or unequal length strings in the equal case. Removed the use of goto and streamlined the other parts. * generic/tclExecute.c (TclExecuteByteCode): added check for object equality in the comparison instructions. Added short-circuit for != length strings in INST_EQ, INST_NEQ and INST_STR_CMP. Reworked INST_STR_CMP to use TclpUtfNcmp2 where appropriate, and only use Tcl_UniCharNcmp when at least one of the objects is a Unicode obj with no utf bytes. * generic/tclCompCmds.c (TclCompileStringCmd): removed error creation in code that no longer throws an error. * tests/string.test: * tests/stringComp.test: added more string comparison checks. * tests/clock.test: better qualified 9.1 constraint check for %s. 2002-05-28 Jeff Hobbs * generic/tclThreadAlloc.c (TclpRealloc, TclpFree): protect against the case when NULL is based. * tests/clock.test: added clock-9.1 * compat/strftime.c: * generic/tclClock.c: * generic/tclInt.decls: * generic/tclIntDecls.h: * unix/tclUnixTime.c: fix for Windows msvcrt mem leak caused by using an env(TZ) setting trick for in clock format -gmt 1. This also makes %s seem to work correctly with -gmt 1 as well as making it a lot faster by avoid the env(TZ) hack. TclpStrftime now takes useGMT as an arg. [Bug 559376] 2002-05-28 Vince Darley * generic/tclIOUtil.c: fixes to Tcl_FSLoadFile when called on a file inside a vfs. This should avoid leaving temporary files sitting around on exit. [Bug 545579] 2002-05-27 Donal K. Fellows * win/tclWinError.c: Added comment on conversion of ERROR_NEGATIVE_SEEK because that is a mapping that really belongs, and not a catch-all case. * win/tclWinPort.h (EOVERFLOW): Should be either EFBIG or EINVAL * generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): EOVERFLOW can potentially be a synonym for EINVAL. 2002-05-24 Donal K. Fellows === Changes due to TIP#91 === * win/tclWinPort.h: Added declaration of EOVERFLOW. * doc/CrtChannel.3: Added documentation of wideSeekProc. * generic/tclIOGT.c (TransformSeekProc, TransformWideSeekProc): Adapted to use the new channel mechanism. * unix/tclUnixChan.c (FileSeekProc, FileWideSeekProc): Renamed FileSeekProc to FileWideSeekProc and created new FileSeekProc which has the old-style interface and which errors out with EOVERFLOW when the returned file position can't fit into the return type (int for historical reasons). * win/tclWinChan.c (FileSeekProc, FileWideSeekProc): Renamed FileSeekProc to FileWideSeekProc and created new FileSeekProc which has the old-style interface and which errors out with EOVERFLOW when the returned file position can't fit into the return type (int for historical reasons). * mac/tclMacChan.c (FileSeek): Reverted to old interface; Macs lack large-file support because I can't see how to add it. * generic/tclIO.c (Tcl_Seek, Tcl_Tell): Given these functions knowledge of the new arrangement of channel types. (Tcl_ChannelVersion): Added recognition of new version code. (HaveVersion): New function to do version checking. (Tcl_ChannelBlockModeProc, Tcl_ChannelFlushProc) (Tcl_ChannelHandlerProc): Made these functions use HaveVersion for ease of future maintainability. (Tcl_ChannelBlockModeProc): Obvious lookup function. * generic/tcl.h (Tcl_ChannelType): New wideSeekProc field, and seekProc type restored to old interpretation. (TCL_CHANNEL_VERSION_3): New channel version. 2002-05-24 Andreas Kupries * tests/winPipe.test: Applied patch for [Bug 549617]. Patch and bug report by Kevin Kenny . * win/tclWinSock.c (TcpWatchProc): Fixed [Bug 557878]. We are not allowed to mess with the watch mask if the socket is a server socket. I believe that the original reporter is George Peter Staplin. 2002-05-21 Mo DeJong * unix/configure: Regen. * unix/configure.in: Invoke SC_ENABLE_SHARED before calling SC_CONFIG_CFLAGS so that the SHARED_BUILD variable can be checked inside SC_CONFIG_CFLAGS. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Pass -non_shared instead of -shared to ld when configured with --disable-shared under OSF. [Bug 540390] 2002-05-20 Daniel Steffen * generic/tclInt.h: added prototype for TclpFilesystemPathType(). * mac/tclMacChan.c: use MSL provided creator type if available instead of the default 'MPW '. 2002-05-16 Joe English * doc/CrtObjCmd.3: Added Tcl_GetCommandFromObj, Tcl_GetCommandFullName [Bugs 547987, 414921] 2002-05-14 Donal K. Fellows * unix/tclUnixChan.c (TtyOutputProc): #if/#endif-ed this function out to stop compiler warnings. Also much general tidying of comments in this file and removal of whitespace from blank lines. 2002-05-13 Donal K. Fellows * unix/tclUnixChan.c (SETBREAK): Solaris thinks ioctl() takes a signed second argument, and Linux thinks ioctl() takes an unsigned second argument. So need a longer definition of this macro to get neither to spew warnings... 2002-05-13 Vince Darley * generic/tclEvent.c: * generic/tclIOUtil.c: * generic/tclInt.h: clean up all memory allocated by the filesystem, via introduction of 'TclFinalizeFilesystem'. Move TclFinalizeLoad into TclFinalizeFilesystem so we can be sure it is called at just the right time. Fix bad comment also. [Bug 555078 and 'fs' part of 543549] * win/tclWinChan.c: fix comment referring to wrong function. 2002-05-10 Don Porter * tests/load.test: * tests/safe.test: * tests/tcltest.test: Corrected some list-quoting issues and other matters that cause tests to fail when the patch includes special characters. Report from Vince Darley. [Bug 554068] 2002-05-08 David Gravereaux * doc/file.n: * tools/man2tcl.c: * tools/man2help2.tcl: Thanks to Peter Spjuth , again. My prior fix for single-quote macro mis-understanding was wrong. Reverted to reimpliment the 'macro2' proc which handles single-quote macros and restored file.n text arrangement to avoid single-quotes on the first line. Sorry for all the confusion. 2002-05-08 David Gravereaux * tools/man2tcl.c: * tools/man2help2.tcl: Proper source of macro error misunderstanding single-quote as the leading macro command found and repaired. * doc/file.n: Reverted to prior state before I messed with it. 2002-05-08 Don Porter * library/tcltest/tcltest.tcl: Corrected [uplevel] quoting when [source]-ing test script in subdirectories. * tests/fileName.test: * tests/load.test: * tests/main.test: * tests/tcltest.test: * tests/unixInit.test: Fixes to test suite when there's a space in the working path. Thanks to Kevin Kenny. 2002-05-07 David Gravereaux -- Changes from Peter Spjuth * tools/man2tcl.c: Increased line buffer size and a bail-out if that should ever be over-run. * tools/man2help.tcl: Include Courier New font in rtf header. * tools/man2help2.tcl: Improved handling of CS/CE fields. Use Courier New for code samples and indent better. * doc/file.n: * doc/TraceCmd.3: winhelp conversion tools where understanding a ' as the first character on a line to be an unknown macro. Not knowing how to repair tools/man2tcl.c, I decided to rearrange the text in the docs instead. 2002-05-07 Vince Darley * generic/tclFileName.c: fix to similar segfault when using 'glob -types nonsense -dir dirname -join * *'. [Bug 553320] * doc/FileSystem.3: further documentation on vfs. * tests/cmdAH.test: * tests/fileSystem.test: * tests/pkgMkindex.test: Fix to testsuite bugs when running out of directory whose name contains '{' or '['. 2002-05-07 Miguel Sofer * tests/basic.test: Fix for [Bug 549607] * tests/encoding.test: Fix for [Bug 549610] These are testsuite bugs that caused failures when the filename contained spaces. Report & fix by Kevin Kenny. 2002-05-02 Vince Darley * generic/tclFileName.c: fix to freeing a bad object (i.e. segfault) when using 'glob -types nonsense -dir dirname'. * generic/tclWinFile.c: fix to [Bug 551306], also wrapped some long lines. * tests/fileName.test: added several tests for the above bugs. * doc/FileSystem.3: clarified documentation on refCount requirements of the object returned by the path type function. * generic/tclIOUtil.c: * win/tclWinFile.c: * unix/tclUnixFile.c: * mac/tclMacFile.c: moved TclpFilesystemPathType to the platform- specific directories, so we can add missing platform-specific implementations. On Windows, 'file system' now returns useful results like "native NTFS", "native FAT" for that system. Unix and MacOS still only return "native". * doc/file.n: clarified documentation. * tests/winFile.test: test for 'file system' returning correct values. * tests/fileSystem.test: test for 'file system' returning correct values. Clean up after failed previous test run. 2002-04-26 Jeff Hobbs * unix/configure: * unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so that the .sl knows its dependent libs. 2002-04-26 Donal K. Fellows * tests/obj.test (obj-11.[56]): Test conversion to boolean more thoroughly. * generic/tclObj.c (SetBooleanFromAny): Was not calling an integer parsing function on native 64-bit platforms! [Bug 548686] 2002-04-24 Jeff Hobbs * generic/tclInt.h: corrected TclRememberJoinableThread decl to use VOID instead of void. * generic/tclThreadJoin.c: noted that this code isn't needed on Unix. 2002-04-23 Jeff Hobbs * doc/exec.n: * doc/tclvars.n: doc updates [Patch 509426] (gravereaux) 2002-04-24 Daniel Steffen * mac/tclMacResource.r: added check of TCLTK_NO_LIBRARY_TEXT_RESOURCES #define to allow disabling the inclusion of the tcl library code in the resource fork of Tcl executables and shared libraries. 2002-04-23 Donal K. Fellows * doc/TraceCmd.3: New file that documents Tcl_CommandTraceInfo, Tcl_TraceCommand and Tcl_UntraceCommand [Bug 414927] 2002-04-22 Jeff Hobbs * generic/tclAlloc.c: * generic/tclInt.h: * generic/tclThreadAlloc.c (new): * unix/Makefile.in: * unix/tclUnixThrd.c: * win/Makefile.in: * win/tclWinInt.h: * win/tclWinThrd.c: added new threaded allocator contributed by AOL that significantly reduces lock contention when multiple threads are in use. Only Windows and Unix implementations are ready, and the Windows one may need work. It is only used by default on Unix for now, and requires that USE_THREAD_ALLOC be defined (--enable-threads on Unix will define this). * generic/tclIOUtil.c (Tcl_FSRegister, Tcl_FSUnregister): corrected calling of Tcl_ConditionWait to ensure that there would be a condition to wait upon. * generic/tclCmdAH.c (Tcl_FileObjCmd): added cast in FILE_SIZE. * win/tclWinFCmd.c (DoDeleteFile): check return of setattr API calls in file deletion for correct Win32 API handling. * win/Makefile.in: correct dependencies for shell, gdb, runtest targets. * doc/clock.n: * compat/strftime.c (_fmt): change strftime to correctly handle localized %c, %x and %X on Windows. Added some notes about how the other values could be further localized. 2002-04-19 Don Porter * generic/tclMain.c (Tcl_Main): Free the memory allocated for the startup script path. [Bug 543549] * library/msgcat/msgcat.tcl: [mcmax] wasn't using the caller's namespace when determining the max translated length. Also made revisions for better use of namespace variables and more efficient [uplevel]s. * doc/msgcat.n: * library/msgcat/msgcat.tcl: * library/msgcat/pkgIndex.tcl: Added [mcload] to the export list of msgcat; bumped to 1.2.3. [Bug 544727] 2002-04-20 Daniel Steffen * generic/tclInt.decls: * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacUtil.c: Modified TclpObjNormalizePath to be alias file aware, and replaced various calls to FSpLocationFrom*Path by calls to new alias file aware versions FSpLLocationFrom*Path. The alias file aware routines don't resolve the last component of a path if it is an alias. This allows [file copy/delete] etc. to act correctly on alias files. (c.f. discussion in [Bug 511666]) 2002-04-19 Donal K. Fellows * tests/lindex.test (lindex-3.7): * generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from hitting wide ints. [Bug 526717] 2002-04-18 Miguel Sofer * generic/tclNamesp.c: * tests/info.test: [Bug 545325] info level didn't report namespace eval, bug report by Richard Suchenwirth. 2002-04-18 Don Porter * doc/subst.n: Clarified documentation on handling unusual return codes during substitution, and on variable substitutions implied by command substitution, and vice versa. [Bug 536838] 2002-04-18 Donal K. Fellows * generic/tclCmdIL.c (InfoBodyCmd): * tests/info.test (info-2.6): Proc bodies without string reps would report as empty. [Bug 545644] * generic/tclCmdMZ.c (Tcl_SubstObj): More clarification for comment on behaviour when substitutions are not well-formed, prompted by [Bug 536831]; alas, removing the ill-defined behaviour is a lot of work. 2002-04-18 Miguel Sofer * generic/tclExecute.c: * tests/expr-old.test: fix for [Bug 542588] (Phil Ehrens), where "too large integers" were reported as "floating-point value" in [expr] error messages. 2002-04-17 Jeff Hobbs * generic/tclEncoding.c (EscapeFromUtfProc): * generic/tclIO.c (WriteChars, Tcl_Close): corrected the handling of outputting end escapes for escape-based encodings. [Bug 526524] (yamamoto) 2002-04-17 Don Porter * doc/tcltest.n: Removed [saveState] and [restoreState] from tcltest 2 documentation, effectively deprecating them. [Bug 495660] * library/tcltest/tcltest.tcl: Made separate export for commands kept only for tcltest 1 compatibility. * tests/iogt.test: Revised to run tests in a namespace, rather than use the useless and buggy [saveState] and [restoreState] commands of tcltest. Updated to use tcltest 2 as well. [Patch 544911] 2002-04-16 Don Porter * tests/io.test: Revised to run tests in a namespace, rather than use the useless and buggy [saveState] and [restoreState] commands of tcltest. Updated to use tcltest 2 as well. [Patch 544546] 2002-04-15 Miguel Sofer * generic/tclProc.c: * tests/proc-old.test: Improved stack trace for TCL_BREAK and TCL_CONTINUE returns from procs. Patch by Don Porter [Bug 536955]. * generic/tclExecute.c: * tests/compile.test: made bytecodes check for a catch before returning; the compiled [return] is otherwise non-catchable. [Bug 542142] reported by Andreas Kupries. 2002-04-15 Don Porter * tests/socket.test: Increased timeout values so that tests have time to successfully complete even on slow/busy machines. [Bug 523470] * doc/tcltest.n: * library/tcltest/tcltest.tcl: * tests/tcltest.test: Revised [tcltest::test] to return errors when called with invalid syntax and to accept exactly two arguments as documented. Improved error messages. [Bug 497446, Patch 513983] ***POTENTIAL INCOMPATIBILITY***: Incompatible with previous tcltest 2.* releases, found only in alpha releases of Tcl 8.4. 2002-04-11 Jeff Hobbs * generic/tclNotify.c (TclFinalizeNotifier): remove remaining unserviced events on finalization. * win/tcl.m4: Enabled COFF as well as CV style debug info with --enable-symbols to allow Dr. Watson users to see function info. More info on debugging levels can be obtained at: http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp * tests/ioCmd.test: fixed iocmd-8.15 to have mac and unixPc variants. * generic/tclParse.c (Tcl_ParseVar): conditionally incr obj refcount to prevent possible mem leak. 2002-04-08 Daniel Steffen * generic/tcl.h: no on mac. * mac/tclMacFile.c: minor fixes to Vince's changes from 03-24. * mac/tclMacOSA.c: * mac/tclMacResource.c: added missing Tcl_UtfToExternalDString conversions of resource file names. * mac/tclMacSock.c (TcpGetOptionProc): fixed bug introduced by Andreas on 02-25; changed strcmp's to strncmp's so that option comparison behaves like on other platforms. * mac/tcltkMacBuildSupport.sea.hqx (CW Pro6 changes): added support to allow Tk to hookup C library stderr/stdout to TkConsole. * tests/basic.test: * tests/cmdAH.test: * tests/encoding.test: * tests/fileSystem.test: * tests/ioCmd.test: fixed tests failing on mac: check for existence of [exec], changed some result strings. 2002-04-06 Jeff Hobbs * unix/tclUnixFCmd.c (Realpath): added a little extra code to initialize a realpath arg when compiling in PURIFY mode in order to prevent spurious purify warnings. We should really create our own realpath implementation, but this will at least quiet purify for now. 2002-04-05 Don Porter * generic/tclCmdMZ.c (Tcl_SubstObj): * tests/subst.test: Corrected [subst] so that return codes TCL_BREAK and TCL_CONTINUE returned by variable substitution have the same effect as when those codes are returned by command substitution. [Bug 536879] 2002-04-03 Jeff Hobbs * library/tcltest/tcltest.tcl: added getMatchingFiles back (alias to GetMatchingFiles), which was a public function in tcltest 1.0. 2002-04-01 Vince Darley * generic/tclEnv.c: * generic/tclIOUtil.c: invalidate filesystem cache when the user changes env(HOME). Fixes [Bug 535621]. Also cleaned up some of the documentation. * tests/fileSystem.test: added test for bug just fixed. 2002-04-01 Kevin Kenny * win/tclWinTime.c (Tcl_GetTime): made the checks of clock frequency more permissive to cope with the fact that Win98SE is observed to return 1.19318 in place of 1.193182 for the performance counter frequency. 2002-03-29 Jeff Hobbs * generic/tclCmdMZ.c (Tcl_TraceObjCmd, TraceVarProc) (TraceCommandProc, TclTraceCommandObjCmd): corrected potential double-free of traces on variables by flagging in Trace*Proc that it will free the var in case the eval wants to delete the var trace as well. [Bug 536937] Also converted Tcl_UntraceVar -> Tcl_UntraceVar2 and Tcl_Eval to Tcl_EvalEx in Trace*Proc for slight efficiency improvement. 2002-03-29 Don Porter * doc/AllowExc.3: * generic/tclBasic.c (Tcl_EvalObjv,Tcl_EvalEx,Tcl_EvalObjEx): * generic/tclCompile.h (TclCompEvalObj): * generic/tclExecute.c (TclCompEvalObj,TclExecuteByteCode): * tests/basic.test: Corrected problems with Tcl_AllowExceptions having influence over the wrong scope of Tcl_*Eval* calls. Patch from Miguel Sofer. Report from Jean-Claude Wippler. [Bug 219181] 2002-03-28 Don Porter * generic/tclVar.c: Refactored CallTraces to collect repeated handling of its returned value into CallTraces itself. 2002-03-28 David Gravereaux * tools/feather.bmp: * tools/man2help.tcl: * tools/man2help2.tcl: * win/makefile.vc: More winhelp target fixups. Added a feather bitmap to the non-scrollable area and changed the color to be yellow from a plain white. The colors can be whatever we want them to be, but thought I would start with something bold. [Bug 527941] * doc/SetVar.3: * doc/TraceVar.3: * doc/UpVar.3: .AP macro syntax repair. 2002-03-27 David Gravereaux * tools/man2help.tcl: * win/makefile.vc: winhelp target now copies all needed files from tools/ to a workarea under $(OUT_DIR) and builds it from there. No build cruft is left in tools/ anymore. All paths used in man2help.tcl are now relative to where the script is. [Bug 527941] 2002-03-27 David Gravereaux * win/.cvsignore: * win/buildall.vc.bat: * win/coffbase.txt: * win/makefile.vc: * win/nmakehlp.c (new): * win/rules.vc: First draft fix for [Bug 527941]. More changes need to done to the makehelp target to get to stop leaving build files in the tools/ directory. This does not address the syntax errors in the man files. Having the contents of tcl.hpj(.in) inside makefile.vc allows for version numbers to be replaced with macros. The new nmakehlp.c is built by rules.vc in preprocessing and removes the need to use tricky shell syntax that wasn't compatible on Win9x systems. Clean targets made Win9x complient. This is a first draft repair for [Bug 533862]. 2002-03-28 Miguel Sofer * generic/tclBasic.c (Tcl_EvalEx): passing the correct commandSize to TclEvalObjvInternal. [Bug 219362], fix by David Knoll. 2002-03-28 Miguel Sofer * generic/tclBasic.c (Tcl_EvalEx): * tests/basic.test: avoid exceptional returns at level 0. [Bug 219181] 2002-03-27 Don Porter * doc/tcltest.n ([mainThread]): * library/tcltest/tcltest.tcl: * tests/tcltest.test: Major code cleanup to deal with whitespace, coding conventions, and namespace issues, with several minor bugs fixed in the process. * tests/main.test: Added missing [after cancel]s. 2002-03-25 Don Porter * tests/main.test: Removed workarounds for Bug 495977. * library/tcltest/tcltest.tcl: Keep the value of $::auto_path unchanged, so that the tcltest package can test code that depends on auto-loading. If a testing application needs $::auto_path pruned, it should do that itself. [Bug 495726] Improve the processing of the -constraints option to [test] so that constraint lists can have arbitrary whitespace, and non-lists don't blow things up. [Bug 495977] Corrected faulty variable initialization. [Bug 534845] 2002-03-25 Miguel Sofer * doc/CrtTrace.3: small doc correction * generic/tclBasic.c (Tcl_DeleteTrace): Allow NULL callback on trace deletions. [Bug 534728] (Hemang Lavana) 2002-03-24 Miguel Sofer * generic/tclBasic.c (Tcl_EvalObjv): replaced obscure, incorrect code as described in [Bug 533907] (Don Porter). 2002-03-24 Don Porter * library/tcltest/tcltest.tcl: Use [interpreter] to set/query the executable currently running the tcltest package. [Bug 454050] * library/tcltest/tcltest.tcl: Allow non-proc commands to be used as the customization hooks. [Bug 495662] 2002-03-24 Vince Darley * generic/tclFilename.c: * generic/tclFCmd.c: * generic/tclTest.c: * generic/tcl.h: * generic/tclIOUtil.c: * win/tclWinFile.c: * win/tclWinFCmd.c: * win/tclWinPipe.c: * unix/tclUnixFile.c: * unix/tclUnixFCmd.c: * mac/tclMacFile.c: * doc/FileSystem.3: * doc/file.n: * tests/cmdAH.test: * tests/fileName.test: * tests/fileSystem.test: (new file) * tests/winFCmd.test: fix [Bug 511666] and [Bug 511658], and improved documentation of some aspects of the filesystem, particularly 'Tcl_FSMatchInDirectory' which now might match a single file/directory only, and 'file normalize' which wasn't very clear before. Removed inconsistency betweens docs and the Tcl_Filesystem structure. Also fixed [Bug 523217] and corrected file normalization on Unix so that it expands symbolic links. Added some new tests of the filesystem code (in the new file 'fileSystem.test'), and some extra tests for correct handling of symbolic links. Fix to [Bug 530960] which shows up on Win98. Made comparison with ".com" case insensitive in tclWinPipe.c ***POTENTIAL INCOMPATIBILITY***: But only between alpha releases (users of the new Tcl_Filesystem lookup table in Tcl 8.4a4 need to handle the new way in which Tcl may call Tcl_FSMatchInDirectory, and 'file normalize' on unix now behaves correctly). Only known impact is with the 'tclvfs' extension. 2002-03-22 Miguel Sofer * tests/basic.test (basic-46.1): adding test for [Bug 533758], fixed earlier today. 2002-03-22 Jeff Hobbs * win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug 478579] 2002-03-22 Miguel Sofer * generic/tclBasic.c (Tcl_EvalObjEx): * generic/tclExecute.c (TclCompEvalObj): fixed the errorInfo for return codes other than (TCL_OK, TCL_ERROR) to runLevel 0.[Bug 533758] Removed the static RecordTracebackInfo(), as its functionality is easily replicated by Tcl_LogCommandInfo. Bug and redundancy noted by Don Porter. 2002-03-21 Donal K. Fellows * doc/expr.n: Improved documentation for ceil and floor. [Bug 530535] 2002-03-20 Don Porter * doc/SetVar.3: * doc/TraceVar.3: * doc/UpVar.3: * generic/tcl.h (Tcl_VarTraceProc): * generic/tcl.decls (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, (Tcl_UnsetVar2, Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, (Tcl_GetVar2Ex, TclSetVar2Ex): * generic/tclCmdMZ.c (TraceVarProc): * generic/tclEnv.c (EnvTraceProc): * generic/tclEvent.c (VwaitVarProc): * generic/tclInt.decls (TclLookupVar,TclPrecTraceProc): * generic/tclLink.c (LinkTraceProc): * generic/tclUtil.c (TclPrecTraceProc): * generic/tclVar.c (CallTraces, MakeUpvar, VarErrMsg, TclLookupVar, (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, Tcl_UnsetVar2, (Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, Tcl_GetVar2Ex, (TclSetVar2Ex): Updated interfaces of generic/tclVar.c according to TIP 27. In particular, the "part2" arguments were CONSTified. [Patch 532642] * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs 2002-03-15 Donal K. Fellows * tests/compile.test (compile-12.3): Test to detect bug 530320. * generic/tclCompile.c (TclCompileTokens): Fixed buffer overrun reported in bug 530320. 2002-03-14 Mo DeJong * win/configure: Regen. * win/configure.in: Add configure time test for SEH support in the compiler. * win/tclWin32Dll.c (ESP, EBP, TclpCheckStackSpace, (_except_checkstackspace_handler): * win/tclWinChan.c (ESP, EBP, Tcl_MakeFileChannel, (_except_makefilechannel_handler): * win/tclWinFCmd.c (ESP, EBP, DoRenameFile, DoCopyFile, (_except_dorenamefile_handler, _except_docopyfile_handler): Implement SEH support under gcc using inline asm. Tcl and Tk should now compile with Mingw 1.1. [Patch 525746] 2002-03-14 Mo DeJong * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Handle an SEH exception with EXCEPTION_EXECUTE_HANDLER instead of restarting the faulting instruction with EXCEPTION_CONTINUE_EXECUTION. [Bug 466102] provides an example of how restarting could send Tcl into an infinite loop. [Patch 525746] 2002-03-11 Mo DeJong * win/tclWinFCmd.c (DoRenameFile, DoCopyFile, DoDeleteFile, (DoRemoveJustDirectory): Make sure we don't pass NULL or "" as a path name to Win32 API functions since this was crashing under Windows 98. 2002-03-11 Don Porter * library/tcltest/tcltest.tcl: * library/tcltest/pkgIndex.tcl: Bumped tcltest package to 2.0.2. 2002-03-11 Mo DeJong * library/tcltest/tcltest.tcl (getMatchingFiles): Pass a proper list to foreach to avoid munging a Windows patch like D:\Foo\Bar into D:FooBar before the glob. 2002-03-11 Mo DeJong * generic/tclEncoding.c: Fix typo in comment. * generic/tclIO.c (DoReadChars, ReadBytes, ReadChars): Use NULL value instead of pointer set to NULL to make things more clear. Reorder arguments so that they match the function signatures. Cleanup little typos and add more descriptive comment. 2002-03-08 Mo DeJong * win/README: Update to indicate that Mingw 1.1 is required to build Tcl. Add section describing new msys based build process. Update Cygwin build instructions so users know where to find Mingw 1.1. 2002-03-08 Jeff Hobbs * win/tclWinFCmd.c (DoCopyFile): correctly set retval to TCL_OK. 2002-03-07 Mo DeJong * win/tclWin32Dll.c (TclpCheckStackSpace): * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Replace hard coded constants with Win32 symbolic names. Move control flow statements out of __try blocks since the documentation indicates it is frowned upon. 2002-03-07 Don Porter * doc/interp.n: * generic/tclInterp.c (Tcl_InterpObjCmd, SlaveObjCmd, (SlaveRecursionLimit): * generic/tclTest.c: * tests/interp.test: Added the [interp recursionlimit] command to set/query the recursion limit of an interpreter. Proposal and implementation from Stephen Trier. [TIP 87, Patch 522849] 2002-03-06 Donal K. Fellows * generic/tcl.h, tools/tcl.wse.in, unix/configure.in, * unix/tcl.spec, win/README.binary, win/configure.in, README: Bumped patchlevel; this might need to change in the future, but it will help us distinguish between the CVS version and the most recent released version. 2002-03-06 Miguel Sofer * generic/tclInt.h: for unshared objects, TclDecrRefCount now frees the internal rep before the string rep - just like the non-macro Tcl_DecrRefCount/TclFreeObj. [Bug 524802] 2002-03-06 Donal K. Fellows * doc/lsearch.n: Documentation of new features, plus examples. * tests/lsearch.test: Tests of new features. * generic/tclCmdIL.c (Tcl_LsearchObjCmd): TIP#80 support. See http://purl.org/tcl/tip/80 for details. 2002-03-05 Jeff Hobbs *** 8.4a4 TAGGED FOR RELEASE *** * unix/tclUnixChan.c: initial remedy for [Bug 525783] flush problem introduced by TIP #35. This may not satisfy true serial channels, but it restores the correct flushing of std* channels on exit. * unix/README: added --enable-langinfo doc. * unix/tcl.spec: * tools/tcl.wse.in: fixed URL refs to use www.tcl.tk or SF. 2002-03-04 Jeff Hobbs * README: * mac/README: * unix/Makefile.in: * unix/README: * win/README: * win/README.binary: updated to use www.tcl.tk URL. * unix/Makefile.in: added older ChangeLogs to dist target. * tests/io.test: * tests/encoding.test: corrected iso2022 encoding results. added encoding-24.* * generic/tclEncoding.c (EscapeFromUtfProc): corrected output of escape codes as per RFC 1468. [Patch 474358] (taguchi) (TclFinalizeEncodingSubsystem): corrected potential double-free when encodings were finalized on exit. [Bugs 219314, 524674] 2002-03-01 Jeff Hobbs * library/encoding/iso2022-jp.enc: * library/encoding/iso2022.enc: * tools/encoding/iso2022-jp.esc: * tools/encoding/iso2022.esc: gave $B precedence over $@, based on comments (point 1) in [Bug 219283] (rfc 1468) * tests/encoding.test: added encoding-23.* tests * generic/tclIO.c (FilterInputBytes): reset the TCL_ENCODING_START flags in the ChannelState when using 'gets'. [Bug 523988] Also reduced the value of ENCODING_LINESIZE from 30 to 20 as this seems to improve the performance of 'gets' according to tclbench. 2002-02-28 Jeff Hobbs * generic/tclCmdMZ.c (TraceCommandProc): ensure that TraceCommandInfo structure was also deleted when a command was deleted to prevent a mem leak. * generic/tclBasic.c (Tcl_CreateObjTrace): set tracePtr->flags correctly. * generic/tclTimer.c (TimerExitProc): remove remaining events in tls on thread exit. 2002-02-28 Miguel Sofer * generic/tclNamesp.c: allow cached fully-qualified namespace names to be usable from different namespaces within the same interpreter without forcing a new lookup [Patch 458872]. 2002-02-28 Miguel Sofer * generic/tclExecute.c: Replaced a few direct stack accesses with the POP_OBJECT() macro [Bug 507181] (Don Porter). 2002-02-27 Don Porter * doc/GetIndex.3: * generic/tcl.decls (Tcl_GetIndexFromObjStruct): * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Revised the prototype of the Tcl_GetIndexFromObjStruct to take its struct table as a (CONST VOID *) argument, better describing what it is, maintaining source compatibility, and adding CONST correctness according to TIP 27. Thanks to Joe English for an elegant solution. [Bug 520304] * generic/tclDecls.h: make genstubs * generic/tclMain.c (Tcl_Main,StdinProc): Corrected some reference count management errors on the interactive command Tcl_Obj found by Purify. Thanks to Jeff Hobbs for the report and assistance. 2002-02-27 Jeff Hobbs * generic/tclBasic.c (Tcl_EvalTokensStandard): corrected mem leak in error case. * generic/tclTest.c (TestStatProc[123]): correct harmless UMRs. * generic/tclLink.c (Tcl_LinkVar): correct mem leak in error case. 2002-02-27 Andreas Kupries * tests/socket.test (2.7): Accepted and applied patch for [Bug 523470] provided by Don Porter to avoid timing problems in that test. * unix/tclUnixChan.c (TclpOpenFileChannel): Added code to regonize "/dev/tty" (by name) and to not handle it as tty / serial line. This is the controlling terminal and is special. Setting it into raw mode as is done for other tty's is a bad idea. This is a hackish fix for expect [Bug 520624]. The fix has limitation: Tcl_MakeFileChannel handles tty's specially too, but is unable to recognize /dev/tty as it only gets a file descriptor, and no name for it. 2002-02-26 Jeff Hobbs * generic/tclCmdAH.c (StoreStatData): corrected mem leak. * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): prevent obj leak in remedial regsub case. * generic/tclFileName.c (Tcl_TranslateFileName): decr refcount for error case to prevent mem leak. * generic/tclVar.c (Tcl_ArrayObjCmd): removed extra obj allocation. * unix/tclUnixSock.c (Tcl_GetHostName): added an extra gethostbyname check to guard against failure with truncated names returned by uname. * unix/configure: * unix/tcl.m4 (SC_SERIAL_PORT): added sys/modem.h check and defined _XOPEN_SOURCE_EXTENDED for HP-11 to get updated header decls. * unix/tclUnixChan.c: added Unix implementation of TIP #35, serial port support. [Patch 438509] (schroedter) 2002-02-26 Miguel Sofer * generic/tclCmpCmds.c: (bugfix to the bugfix, hopefully the last) Bugfix to the new [for] compiling code: was setting a exceptArray parameter using another param which wasn't yet initialised, thus filling it with noise. 2002-02-25 Andreas Kupries * mac/tclMacSock.c (TcpGetOptionProc): Changed to recognize the option "-error". Essentially ignores the option, always returning an empty string. 2002-02-25 Jeff Hobbs * doc/Alloc.3: * doc/LinkVar.3: * doc/ObjectType.3: * doc/PkgRequire.3: * doc/Preserve.3: * doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc, ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and to accurately describe when and how they are used. [Bug 497459] (dgp) * generic/tclHash.c (AllocArrayEntry, AllocStringEntry): Before invoking ckalloc when creating a Tcl_HashEntry, check that the amount of memory being allocated is at least as large as sizeof(Tcl_HashEntry). The previous code was allocating memory regions that were one or two bytes short. [Bug 521950] (dejong) 2002-02-25 Miguel Sofer * generic/tclBasic.c (Tcl_EvalEx): avoiding a buffer overrun reported by Joe English, and restoring tcl7.6 behaviour for [subst]: badly terminated nested scripts will raise an error and not be evaluated. [Bug 495207] 2002-02-25 Don Porter * unix/tclUnixPort.h: corrected strtoll prototype mismatch on Tru64. * compat/strtod.c (strtod): simplified #includes * compat/strtol.c (strtol): gather result in a long before returning as a long: necessary on platforms where sizeof(int) != sizeof(long). 2002-02-25 Daniel Steffen * unix/tclLoadDyld.c: updated to use Mac OS X 10.1 dyld APIs that have more libdl-like semantics. [Bug 514392] 2002-02-25 Miguel Sofer * generic/tclCompCmds: fixing a bug in patch dated 2002-02-22, in the code for [for] and [while]. Under certain conditions, for long bodies, the exception range parameters were badly computed. Tests forthcoming: I still can't reproduce the conditions in the testsuite (!), although the bug (with assorted segfault or panic!) can be triggered from the console or with the new parse.bench in tclbench. 2002-02-25 Donal K. Fellows * compat/strtoul.c, compat/strtol.c, compat/strtod.c: Added UCHAR, CONST and #includes to clean up GCC output. 2002-02-23 Don Porter * compat/strtoull.c (strtoull): * compat/strtoll.c (strtoll): * compat/strtoul.c (strtoul): Fixed failure to handle leading sign symbols '+' and '-' and '0X' and raise overflow errors. [Bug 440916] Also corrects prototype and errno problems. 2002-02-23 Mo DeJong * configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Link with -n32 instead of -32 when building on IRIX64-6.* system. [Bug 521707] 2002-02-22 Don Porter * generic/tclInt.h: * generic/tclObj.c: renamed global variable emptyString -> tclEmptyString because it is no longer static. * generic/tclPkg.c: Fix for panic when library is loaded on a platform without backlinking without proper use of stubs. [Bug 476537] 2002-02-22 Jeff Hobbs * tests/regexpComp.test: updated regexp-11.[1-4] to match changes in regexp.test for new regsub syntax * unix/configure: * unix/tcl.m4: added --enable-64bit support for AIX-4 (using -q64 flag) when using IBM's xlc compiler. * tests/safe.test: updated safe-8.5 and safe-8.7 * library/safe.tcl (CheckFileName): removed the limit on sourceable file names (was only *.tcl or tclIndex files with no more than one dot and 14 chars). There is enough internal protection in a safe interpreter already. [Tk Bug 521560] 2002-02-22 Miguel Sofer * generic/tclCompCmds: [FR 465811]. Optimising [if], [for] and [while] for constant conditions; in addition, [for] and [while] are now compiled with the "loop rotation" optimisation (thanks to Kevin Kenny). 2002-02-22 Donal K. Fellows --- TIP#76 CHANGES --- * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): Final-argument-less [regsub] returns the modified string. * doc/regsub.n: Updated docs. * tests/regexp.test: Updated and added tests. * compat/strtoll.c (strtoll): * compat/strtoull.c (strtoull): * unix/tclUnixPort.h: * win/tclWinPort.h: Const-ing 64-bit compatibility declarations. Note that the return pointer is non-const because it is entirely legal for the functions to be called from somewhere that owns the string being passed. Fixes problem reported by Larry Virden. 2002-02-21 David Gravereaux * win/mkd.bat (removed): * win/coffbase.txt (new): * win/makefile.bc: * win/makefile.vc: Changed the 'setup' target to stop using the mkd.bat file and just make the directory right in the rule. Same change to makefile.bc. Neither configure.in nor Makefile.in use it. coffbase.txt will be the master list for our "prefered base addresses" set by the linker. This should improve load-time (NT only) by avoiding relocations. Submissions to the list by extension authors are encouraged. Added a 'tidy' target to compliment 'clean' and 'hose' to remove just the outputs. Also removed the $(winlibs) macro as it wasn't being used. Stuff left to do: 1) get the winhelp target to stop building in the tools/ directory. 2) stop using rmd.bat 3) add more dependacy rules. * win/tclAppInit.c: Reverted back to -r1.6, as the header file change to tclPort.h won't allow for easy embedded support outside of the source dist. Thanks to Don Porter for pointing this out to me. 2002-02-21 David Gravereaux * win/makefile.vc: * win/rules.vc: Added a new "loimpact" option that sets the -ws:aggressive linker option. Off by default. It's said to keep the heap use low at the expense of alloc speed. * win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to remove the raw windows.h include. tclPort.h brings in windows.h already and lessens the precompiled-header mush and the randomly useless #pragma comment (lib,...) references throughout the big windows.h tree (as observed at high linker warning levels). 2002-02-21 Donal K. Fellows * generic/tcl.h: Better guessing of LP64/ILP32 architecture, but now sensitive to presence of (suitable) 2002-02-20 Don Porter * generic/tcl.decls (Tcl_RegExpRange,Tcl_GetIndexFromObjStruct): Overlooked a few source incompatibilities. Now using CONST84. * generic/tclDecls.h: make genstubs * generic/tcl.h (Tcl_CmdObjTraceProc): silence warning from Sun Workshop compiler. 2002-02-20 David Gravereaux * win/buildall.vc.bat: * win/makefile.vc: * win/rules.vc: General clean-ups. Added compiler and linker tests for a) the pentium 0x0F errata, b) optimizing (not all have this), and c) linker v6 section alignment confusion. All these are tested first to make sure any D4002 or LNK1117 warnings aren't displayed. The pentium 0x0F errata is a recommended switch. The v5 linker's section alignment default is 512, but the v6 linker was changed to 4096 in an attempt to speed loading on Win98. I changed the default to always be 512 across both linkers, unless linking statically, then 4096 is used for the claimed speed effect. Using a 512 alignment saves 12k bytes of dead space in the DLL. Added IA64 B-stepping errata switch when the compiler supports it. Added profiling to $(lflags) when requested and also removed the explict -entry option as the default works fine as is. Removed win/tclWinInit.c from the special case section to let it use the common implicit rule as the $(EXTFLAGS) macro it had was never referenced anywhere. 2002-02-20 Donal K. Fellows * generic/tcl.h: Added code to guess the correct settings for TCL_WIDE_INT_IS_LONG and TCL_WIDE_INT_TYPE when configure doesn't tell us them, as can happen with extensions. 2002-02-19 Donal K. Fellows * doc/format.n: Updated docs to list the specification. * generic/tclCmdAH.c (Tcl_FormatObjCmd): Made behaviour on 64-bit platforms correctly meet the specification, that %d works with the native word-sized integer, instead of trying to guess (wrongly) from the value being passed. 2002-02-19 Don Porter * changes: First draft of updated changes for 8.4a4 release. 2002-02-15 Jeff Hobbs * unix/tclUnixPort.h: add strtoll/strtoull declarations for platforms that do not define them. * generic/tclIndexObj.c (STRING_AT): removed ptrdiff_t cast and use of VOID* in default case (GNU-ism). 2002-02-15 Kevin Kenny * compat/strtoll.c: * compat/strtoul.c: * compat/strtoull.c: * generic/tclIOUtil.c: * generic/tclPosixStr.c: * generic/tclTest.c: * generic/tclTestObj.c: * tests/get.test: * win/Makefile.vc: Further tweaks to the TIP 72 patch to make it compile under VC++. 2002-02-15 Andreas Kupries * tclExecute.c: * tclIOGT.c: * tclIndexObj.c: Touchups to the TIP 72 patch to make it compileable under Windows again. The changes are not complete, there is one nasty regarding _stati64 2002-02-15 Donal K. Fellows +----------------------+ | TIP #72 IMPLEMENTED. | +----------------------+ There are a lot of changes from this TIP, so please see http://purl.org/tcl/tip/72.html for discussion of backward-compatibility issues, but the main ones modifications are in: * generic/tcl.h: New types. * generic/tcl.decls: New public functions. * generic/tclExecute.c: 64-bit aware bytecode engine. * generic/tclBinary.c: 64-bit handling in [binary] command. * generic/tclScan.c: 64-bit handling in [scan] command. * generic/tclCmdAH.c: 64-bit handling in [file] and [format] commands. * generic/tclBasic.c: New "wordSize" entry in ::tcl_platform. * generic/tclFCmd.c: Large-file support (with many consequences.) * generic/tclIO.c: Large-file support (with many consequences.) * compat/strtoll.c, compat/strtoull.c: New support functions. * unix/tcl.m4, unix/configure: 64-bit support and greatly enhanced caching. Most other changes, including all those in doc/* and test/* as well as the majority in the platform directories, follow on from these. Also coming out of the woodwork: * generic/tclIndex.c: Better support for Cray PVP. * win/tclWinMtherr.c: Better Borland support. Note that, in a number of places through the Unix part of the platform support, there are Tcl_Platform* references. These are expanded into the correct way to call that particular underlying function, i.e. with or without a '64' suffix, and should be used by people working on the core in preference to the API functions they overlay so that the code remains portable depending on the presence or absence of 64-bit support on the underlying platform. ***POTENTIAL INCOMPATIBILITY***: Extracted from the TIP SUMMARY OF INCOMPATIBILITIES AND FIXES ====================================== The behaviour of expressions containing constants that appear positive but which have a negative internal representation will change, as these will now usually be interpreted as wide integers. This is always fixable by replacing the constant with int(constant). Extensions creating new channel types will need to be altered as different types are now in use in those areas. The change to the declaration of Tcl_FSStat and Tcl_FSLstat (which are the new preferred API in any case) are less serious as no non-alpha releases have been made yet with those API functions. Scripts that are lax about the use of the l modifier in format and scan will probably need to be rewritten. This should be very uncommon though as previously it had absolutely no effect. Extensions that create new math functions that take more than one argument will need to be recompiled (the size of Tcl_Value changes), and functions that accept arguments of any type (TCL_EITHER) will need to be rewritten to handle wide integer values. (I do not expect this to affect many extensions at all.) 2002-02-14 Andreas Kupries * generic/tclIOCmd.c (Tcl_GetsObjCmd): Trivial fix for [Bug 517503], a memory leak reported by Miguel Sofer . The leak happens if an error occurs for "set var [gets $chan]" and leak one empty object. 2002-02-12 David Gravereaux * djgpp/ (new directory) * djgpp/Makefile (new): * unix/tclAppInit.c: * unix/tclMtherr.c: * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * unix/tclUnixInit.c: * unix/tclUnixPort.h: Early stage of DJGPP support for building Tcl on DOS. Dynamic loading isn't working, yet. Requires watt32 for the TCP/IP stack. No autoconf, yet. Barely tested, but makes a working exe that runs Tcl in protected-mode, flat memory. [exec] and pipes will need the most work as multi-tasking on DOS has to be carefully. 2002-02-10 Kevin Kenny * doc/CrtObjCmd.3: * doc/CrtTrace.3: * generic/tcl.decls: * generic/tcl.h: * generic/tclBasic.c: * generic/tclInt.h: * generic/tclTest.c: * tests/basic.test: Added Tcl_CreateObjTrace, Tcl_GetCommandInfoFromToken and Tcl_SetCommandInfoFromToken. (TIPs #32 and #79.) * generic/tclDecls.h: * generic/tclStubInit.c: Regenerated Stubs tables. 2002-02-08 Jeff Hobbs * unix/configure: * unix/tcl.m4: added -pthread for FreeBSD to EXTRA_CFLAGS and LDFLAGS. Also triggered nodots only for FreeBSD-3. Added AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) for Solaris. * unix/tclUnixPort.h: * unix/tclUnixThrd.c: added thread-safe versions of readdir, localtime, gmtime and inet_ntoa for threaded build. (jgdavidson) * generic/tclScan.c (Tcl_ScanObjCmd): prevented ckfree being called on a pointer to NULL. 2002-02-07 Don Porter * doc/DString.3: * doc/Encoding.3: * doc/GetCwd.3: * doc/SplitPath.3: * doc/Translate.3: * doc/Utf.3: * generic/tcl.decls: * generic/tcl.h: * generic/tclEncoding.c: * generic/tclEnv.c: * generic/tclFileName.c: * generic/tclIOUtil.c: * generic/tclUtf.c: * generic/tclUtil.c: * mac/tclMacInit.c: * unix/tclUnixFile.c: * unix/tclUnixInit.c: * unix/tclUnixPipe.c: * win/tclWin32Dll.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclWinInit.c: Partial TIP 27 rollback. Following routines restored to return (char *): Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_JoinPath, Tcl_TranslateFileName, Tcl_ExternalToUtfDString, Tcl_UtfToExternalDString, Tcl_UniCharToUtfDString, Tcl_GetCwd, Tcl_WinTCharToUtf. Also restored Tcl_WinUtfToTChar to return (TCHAR *) and Tcl_UtfToUniCharDString to return (Tcl_UniChar *). Modified some callers. This change recognizes that Tcl_DStrings are de-facto white-box objects. * generic/tclDecls.h: * generic/tclPlatDecls.h: make genstubs * generic/tclCmdMZ.c: corrected use of C++-style comment. 2002-02-06 Jeff Hobbs * tests/scan.test: * generic/tclScan.c (Tcl_ScanObjCmd): corrected scan 0x... %x handling that didn't accept the 0x as a prelude to a base 16 number. [Bug 495213] * generic/tclCompCmds.c (TclCompileRegexpCmd): made early check for bad RE to stop checking further. * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): added special case to search for simple 'string map' style regsub calls. Delayed creation of resultPtr object until an initial match is made, as the input string object can then be reused for no matches. (Tcl_StringObjCmd): optimization improvements to the STR_MAP algorithm for zero-length and nocase cases. * tests/regexp.test: * tests/regexpComp.test: extra code coverage tests. * tests/string.test: added 10.18 and 10.19 extra tests. * generic/regc_locale.c (casecmp): slight performance improvement. 2002-02-05 Don Porter * library/http/http.tcl: * library/http/pkgIndex.tcl: Corrected use of http::error when ::error was intended. Bump to http 2.4.2. 2002-02-04 Andreas Kupries * unix/tclUnixChan.c (FileOutputProc): Fixed [bug 465765] reported by Dale Talcott . Avoid writing nothing into a file as STREAM based implementations will consider this a EOF (if the file is a pipe). Not done in the generic layer as this type of writing is actually useful to check the state of a socket. * doc/open.n: Fixed [Bug 511540], added cross-reference to 'pid' as the command to use to retrieve the pid of a command pipeline created via 'open'. 2002-02-01 Jeff Hobbs * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): handle quirky about case earlier to avoid shimmering problem. 2002-02-01 Andreas Kupries * tests/io.test: io-39.22 split into two tests, one platform dependent, the other not. -eofchar is not empty on the windows platform. 2002-02-01 Vince Darley * generic/tclTest.c: fix to picky windows compiler problem with the 'MainLoop' function declaration. 2002-01-31 Andreas Kupries * win/tclWinFCmd.c: TIP 27: Applied patch fixing CONST warnings on behalf of Don Porter . 2002-01-30 Don Porter * generic/tcl.decls: * generic/tcl.h: * generic/tclInt.h: For each interface identified in the TIP 27 changes below as a POTENTIAL INCOMPATIBILITY, the source of the incompatibility has been parameterized so that it can be removed. When compiling extension code against the Tcl header files, use the compiler flag -DUSE_NON_CONST to remove the irresolvable source incompatibilities introduced by the TIP 27 changes. Resolvable changes are left for extension authors to resolve. * generic/tclDecls.h: make genstubs 2002-01-30 Vince Darley * doc/FileSystem.3: added documentation for 3 public functions which had been overlooked. [Bug 507701] * unix/mkLinks: make mklinks 2002-01-29 Jeff Hobbs * tests/regexpComp.test: * generic/tclCompCmds.c (TclCompileRegexpCmd): enhanced to support -nocase and -- options. 2002-01-28 Mo DeJong * unix/tcl.m4 (SC_LOAD_TCLCONFIG): * win/tcl.m4 (SC_LOAD_TCLCONFIG): Set TCL_LIB_SPEC, TCL_STUB_LIB_SPEC, and TCL_STUB_LIB_PATH to the values of TCL_BUILD_LIB_SPEC, TCL_BUILD_STUB_LIB_SPEC, and TCL_BUILD_STUB_LIB_PATH when tclConfig.sh is loaded from the build directory. A Tcl extension should make use of the non-build versions of these variables since they will work in both cases. This modification was described in TIP 34. 2002-01-28 Jeff Hobbs * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey) (DeleteKey,GetKeyNames,GetType,GetValue,OpenSubKey,SetValue): redid the CONSTification as previous changes caused failing tests. * tests/regexpComp.test (new): * generic/tclInt.h: * generic/tclBasic.c: added TclCompileRegexpCmd entry * generic/tclCompCmds.c (TclCompileStringCmd): corrected to return TCL_OUT_LINE_COMPILE instead of TCL_ERROR for parsing errors, so it only throws the error for runtime compile, in case the user modifies 'string'. (TclCompileRegexpCmd): first try at a byte-compiled regexp command. It handles static strings and ^$ bounded static strings. (TclCompileAppendCmd): made TclPushVarName call always use TCL_CREATE_VAR as numWords is always > 2 at that point. * generic/tclExecute.c (TclExecuteByteCode:INST_LIST): correct possibly dangerous decr in macro call. * win/tclWinInit.c (TclpFindVariable): CONSTification touch-up * win/tclWinReg.c (OpenSubKey): corrected bug introduced in CONSTification that dropped pointer reference. * ChangeLog.2000 (new file): * ChangeLog: broke changes from 2000 into ChangeLog.2000 to reduce size of the main ChangeLog. 2002-01-28 David Gravereaux * generic/tclPlatDecls.h: Added preprocessor logic to force a typedef of TCHAR when __STDC__ is defined when using the uncommon -Za compiler switch with the microsoft compiler. 2002-01-27 Don Porter * doc/package.n: Documented global namespace context for script evaluation by [package require]. 2002-01-27 Daniel Steffen * generic/tclInt.decls: * generic/tclIntPlatDecls.h: * mac/tclMacChan.c: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacInit.c: * mac/tclMacLoad.c: * mac/tclMacResource.c: * mac/tclMacSock.c: TIP 27 CONSTification induced changes * tests/event.test: * tests/main.test: added catches/constraints to test that use features that don't exist on the mac. 2002-01-25 Mo DeJong Make -eofchar and -translation options read only for server sockets. [Bug 496733] * generic/tclIO.c (Tcl_GetChannelOption, Tcl_SetChannelOption): Instead of returning nothing for the -translation option on a server socket, always return "auto". Return the empty string enclosed in quotes for the -eofchar option on a server socket. Fixup -eofchar usage message so that it matches the implementation. * tests/io.test: Add -eofchar tests and -translation tests to ensure options are read only on server sockets. * tests/socket.test: Update tests to account for -eofchar and -translation option changes. 2002-01-25 Don Porter * compat/strstr.c (strstr): * generic/tclCmdAH.c (Tcl_FormatObjCmd): * generic/tclCmdIL.c (InfoNameOfExecutableCmd): * generic/tclEnv.c (ReplaceString): * generic/tclFileName.c (ExtractWinRoot): * generic/tclIO.c (FlushChannel,Tcl_BadChannelOption): * generic/tclStringObj.c (AppendUnicodeToUtfRep): * generic/tclThreadTest.c (TclCreateThread): * generic/tclUtf.c (Tcl_UtfPrev): * mac/tclMacFCmd.c (TclpObjListVolumes): * mac/tclMacResource.c (TclMacRegisterResourceFork, (BuildResourceForkList): * win/tclWinInit.c (AppendEnvironment): Sought out and eliminated instances of CONST-casting that are no longer needed after the TIP 27 effort. * Following is [Patch 501006] * generic/tclInt.decls (Tcl_AddInterpResolvers, Tcl_Export, (Tcl_FindNamespace, Tcl_GetInterpResolvers, Tcl_ForgetImport, (Tcl_Import, Tcl_RemoveInterpResolvers): * generic/tclNamesp.c (Tcl_Export, Tcl_Import, Tcl_ForgetImport, (Tcl_FindNamespace): * generic/tclResolve.c (Tcl_AddInterpResolvers,Tcl_GetInterpResolvers, (Tcl_RemoveInterpResolvers): Updated APIs in generic/tclResolve.c and generic/tclNamesp.c according to the guidelines of TIP 27. * generic/tclIntDecls.h: make genstubs * Following is [Patch 505630] * doc/AddErrorInfo.3: * generic/tcl.decls (Tcl_LogCommandInfo): * generic/tclBasic.c (Tcl_LogCommandInfo): Updated interfaces of generic/tclBasic.cc according to TIP 27. * generic/tclDecls.h: make genstubs * Following is [Patch 506818] * doc/Hash.3: * generic/tcl.decls (Tcl_HashStats): * generic/tclHash.c (Tcl_HashStats): Updated APIs of generic/tclHash.c according to guidelines of TIP 27. * generic/tclDecls.h: make genstubs * generic/tclVar.c (Tcl_ArrayObjCmd): Updated callers. * Following is [Patch 506807] * doc/ObjectType.3: * generic/tcl.decls (Tcl_GetObjType): * generic/tclObj.c (Tcl_GetObjType): Updated APIs of generic/tclObj.c according to guidelines of TIP 27. * generic/tclDecls.h: make genstubs * Following is [Patch 507304] * doc/Encoding.3: * generic/tcl.decls (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf): * win/tclWin32Dll.c (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf): Updated interfaces in win/tclWin32Dll.c according to TIP 27. * generic/tclPlatDecls.h: make genstubs * generic/tclIOUtil.c (TclpNativeToNormalized): * win/tclWinFCmd.c (TclpObjNormalizePath): * win/tclWinFile.c (TclpFindExecutable,TclpMatchInDirectory, (NativeIsExec,NativeStat): * win/tclWinLoad.c (TclpLoadFile): * win/tclWinPipe.c (TclpOpenFile,ApplicationType): * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey,DeleteKey, (GetKeyNames,GetType,GetValue,OpenSubKey,SetValue): * win/tclWinSerial.c (SerialSetOptionProc): Update callers. * Following is [Patch 505072] * doc/Concat.3: * doc/Encoding.3: * doc/Filesystem.3: * doc/Macintosh.3: * doc/OpenFileChnl.3 * doc/SetResult.3: * doc/SetVar.3: * doc/SplitList.3: * doc/SplitPath.3: * doc/Translate.3: * generic/tcl.h (Tcl_FSMatchInDirectoryProc): * generic/tclInt.h (TclpMatchInDirectory): * generic/tcl.decls (Tcl_Concat,Tcl_GetStringResult,Tcl_GetVar, (Tcl_GetVar2,Tcl_JoinPath,Tcl_Merge,Tcl_OpenCommandChannel,Tcl_SetVar, (Tcl_SetVar2,Tcl_SplitList,Tcl_SplitPath,Tcl_TranslateFileName, (Tcl_ExternalToUtfDString,Tcl_GetEncodingName,Tcl_UtfToExternalDString, (Tcl_GetDefaultEncodingDir,Tcl_SetDefaultEncodingDir, (Tcl_FSMatchInDirectory,Tcl_MacEvalResource,Tcl_MacFindResource): * generic/tclInt.decls (TclCreatePipeline,TclGetEnv,TclpGetCwd, (TclpCreateProcess): * mac/tclMacFile.c (TclpGetCwd): * generic/tclEncoding.c (Tcl_GetDefaultEncodingDir, (Tcl_SetDefaultEncodingDir,Tcl_GetEncodingName, (Tcl_ExternalToUtfDString,Tcl_UtfToExternalDString, OpenEncodingFile, (LoadEscapeEncoding): * generic/tclFileName.c (DoTildeSubst,Tcl_JoinPath,Tcl_SplitPath, (Tcl_TranslateFileName): * generic/tclIOUtil.c (Tcl_FSMatchInDirectory): * generic/tclPipe.c (FileForRedirect,TclCreatePipeline, (Tcl_OpenCommandChannel): * generic/tclResult.c (Tcl_GetStringResult): * generic/tclUtil.c (Tcl_Concat,Tcl_SplitList,Tcl_Merge): * generic/tclVar.c (Tcl_GetVar,Tcl_GetVar2,Tcl_SetVar,Tcl_SetVar2): * mac/tclMacResource.c (Tcl_MacEvalResource,Tcl_MacFindResource): Updated interfaces of generic/tclEncoding, generic/tclFilename.c, generic/tclIOUtil.c, generic/tclPipe.c, generic/tclResult.c, generic/tclUtil.c, generic/tclVar.c and mac/tclMacResource.c according to TIP 27. Tcl_TranslateFileName rewritten as wrapper around VFS-aware version. ***POTENTIAL INCOMPATIBILITY*** Includes source incompatibilities: argv arguments of Tcl_Concat, Tcl_JoinPath, Tcl_OpenCommandChannel, Tcl_Merge; argvPtr arguments of Tcl_SplitList and Tcl_SplitPath. * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs * generic/tclCkalloc.c (MemoryCmd): * generic/tclClock.c (FormatClock): * generic/tclCmdAH.c (Tcl_CaseObjCmd,Tcl_EncodingObjCmd,Tcl_FileObjCmd): * generic/tclCmdIL.c (InfoLibraryCmd,InfoPatchLevelCmd, (InfoTclVersionCmd): * generic/tclCompCmds.c (TclCompileForeachCmd): * generic/tclCompCmds.h (TclCompileForeachCmd): * generic/tclCompile.c (TclFindCompiledLocal): * generic/tclEnv.c (TclSetupEnv,TclSetEnv,Tcl_PutEnv,TclGetEnv, (EnvTraceProc): * generic/tclEvent.c (Tcl_BackgroundError): * generic/tclIO.c (Tcl_BadChannelOption,Tcl_SetChannelOption): * generic/tclIOCmd.c (Tcl_ExecObjCmd,Tcl_OpenObjCmd): * generic/tclIOSock.c (TclSockGetPort): * generic/tclIOUtil.c (SetFsPathFromAny): * generic/tclLink.c (LinkTraceProc): * generic/tclMain.c (Tcl_Main): * generic/tclNamesp.c (TclTeardownNamespace): * generic/tclProc.c (TclCreateProc): * generic/tclTest.c (TestregexpObjCmd,TesttranslatefilenameCmd, (TestchmodCmd,GetTimesCmd,TestsetCmd,TestOpenFileChannelProc1, (TestOpenFileChannelProc2,TestOpenFileChannelProc3,AsyncHandlerProc, (TestpanicCmd): * generic/tclThreadTest.c (ThreadErrorProc,ThreadEventProc): * generic/tclUtil.c (TclPrecTraceProc): * mac/tclMacFCmd.c (GetFileSpecs): * mac/tclMacFile.c (TclpMatchInDirectory): * mac/tclMacInit.c (TclpInitLibraryPath,Tcl_SourceRCFile): * mac/tclMacOSA.c (tclOSAStore,tclOSALoad): * mac/tclMacResource.c (Tcl_MacEvalResource): * unix/tclUnixFCmd.c (TclpObjNormalizePath): * unix/tclUnixFile.c (TclpMatchInDirectory,TclpGetUserHome,TclpGetCwd, (TclpReadLink): * unix/tclUnixInit.c (TclpInitLibraryPath,TclpSetVariables, (Tcl_SourceRCFile): * unix/tclUnixPipe.c (TclpOpenFile,TclpCreateTempFile, (TclpCreateProcess): * win/tclWinFile.c (TclpGetCwd,TclpMatchInDirectory): * win/tclWinInit.c (TclpInitLibraryPath,Tcl_SourceRCFile, (TclpSetVariables): * win/tclWinPipe.c (TclpCreateProcess): Updated callers. 2002-01-24 Don Porter * generic/tclIOUtil.c (SetFsPathFromAny): Corrected tilde-substitution of pathnames where > 1 separator follows the ~. [Bug 504950] 2002-01-24 Jeff Hobbs * library/http/pkgIndex.tcl: * library/http/http.tcl: don't add port in default case to handle broken servers. http bumped to 2.4.1 [Bug 504508] 2002-01-23 Andreas Kupries * unix/mkLinks: Regenerated. * doc/CrtChannel.3: * doc/ChnlStack.3: Moved documentation for 'Tcl_GetTopChannel' from 'CrtChannel' to 'ChnlStack'. Added documentation of 'Tcl_GetStackedChannel'. [Bug 506147] reported by Mark Patton . 2002-01-23 Don Porter * win/tclWinFile.c (NativeAccess,NativeStat,NativeIsExec, (TclpGetUserHome): * win/tclWinPort.h (TclWinSerialReopen): * win/tclWinSerial.c (TclWinSerialReopen): * win/tclWinSock.c (Tcl_OpenTcpServer): Corrections to earlier TIP 27 changes. Thanks to Andreas Kupries for the feedback. * generic/tclPlatDecls.h: make genstubs * doc/GetHostName.3: * doc/GetOpnFl.3: * doc/OpenTcp.3: * tcl.decls (Tcl_GetHostName,Tcl_GetOpenFile,Tcl_OpenTcpClient, (Tcl_OpenTclServer): * mac/tclMacSock.c (CreateSocket,Tcl_OpenTcpClient,Tcl_OpenTcpServer, (Tcl_GetHostName,GetHostFromString): * unix/tclUnixChan.c (CreateSocket,CreateSocketAddress, (Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetOpenFile): * unix/tclUnixSock.c (Tcl_GetHostName): * win/tclWinSock.c (CreateSocket,CreateSocketAddress, (Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetHostName): Updated socket interfaces according to TIP 27. * generic/tclCmdIL.c (InfoHostnameCmd): Updated callers. * generic/tclDecls.h: make genstubs 2002-01-21 David Gravereaux * generic/tclLoadNone.c: TclpLoadFile() didn't match proto of typedef Tcl_FSLoadFileProc. OK'd by vincentdarley. [Patch 502488] 2002-01-21 Andreas Kupries * generic/tclIO.c (WriteChars): Fix for [Bug 506297], reported by Martin Forssen . The encoding chosen in the script exposing the bug writes out three intro characters when TCL_ENCODING_START is set, but does not consume any input as TCL_ENCODING_END is cleared. As some output was generated the enclosing loop calls UtfToExternal again, again with START set. Three more characters in the out and still no use of input ... To break this infinite loop we remove TCL_ENCODING_START from the set of flags after the first call (no condition is required, the later calls remove an unset flag, which is a no-op). This causes the subsequent calls to UtfToExternal to consume and convert the actual input. 2002-01-21 Don Porter * generic/tclTest.c: Converted declarations of TestReport file system to more portable form. [Bug 501417] * generic/tcl.decls (Tcl_TraceCommand,Tcl_UntraceCommand, (Tcl_CommandTraceInfo): * generic/tclCmdMZ.c (Tcl_TraceCommand,Tcl_UntraceCommand, (Tcl_CommandTraceInfo): Updated APIs in generic/tclCmdMZ.c according to the guidelines of TIP 27. * generic/tclDecls.h: make genstubs 2002-01-18 Don Porter * win/tclWinChan.c: * win/tclWinFCmd.c: * win/tclWinFile.c: Overlooked callers of Tcl_FSGetNativePath * win/tclWinDde.c: * win/tclWinReg.c: Overlooked callers of Tcl_GetIndexFromObj 2002-01-18 Daniel Steffen * generic/tclThreadTest.c: * mac/tclMacChan.c: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacLoad.c: * mac/tclMacResource.c: TIP 27 CONSTification broke the mac build in a number of places. 2002-01-17 Andreas Kupries * generic/tclIOCmd.c (Tcl_GetsObjCmd): Fixed [Bug 504642] as reported by Brian Griffin , using his patch. Before the patch the generic I/O layer held an unannounced reference to the interp result to store the read line into. This unfortunately has disastrous results if the channel driver executes a tcl script to perform its operation, this freeing the interp result. In that case we are dereferencing essentially a dangling reference. It is not truly dangling because the object is in the free list, but this only causes us to smash the free list and have the error occur later somewhere else. The patch simply creates a new object for the line and later sets it into the interp result when we are done with reading. 2002-01-16 Mo DeJong * unix/tcl.m4 (SC_LOAD_TCLCONFIG): * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst TCL_DBGX into TCL_STUB_LIB_FILE and TCL_STUB_LIB_FLAG variables so that an extension does not need to subst TCL_DBGX into its makefile. [Tk Bug 504356] 2002-01-16 Don Porter * doc/FileSystem.3: * doc/GetCwd.3: * doc/GetIndex.3: * generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct, (Tcl_GetCwd, Tcl_FSFileAttrStrings, Tcl_FSGetNativePath, (Tcl_FSGetTranslatedStringPath): * generic/tcl.h (Tcl_FSFileAttrStringsProc): * generic/tclFCmd.c (TclFileAttrsCmd): * generic/tclIOUtil.c (Tcl_GetCwd,NativeFileAttrStrings, (Tcl_FSFileAttrStrings,Tcl_FSGetTranslatedStringPath, (Tcl_FSGetNativePath): * generic/tclIndexObj.c (Tcl_GetIndexFromObj, (Tcl_GetIndexFromObjStruct): More TIP 27 updates in tclIOUtil.c and tclIndexObj.c that were overlooked before. [Patch 504671] ***POTENTIAL INCOMPATIBILITY*** Includes a source incompatibility in the tablePtr arguments of the Tcl_GetIndexFromObj* routines. * generic/tclDecls.h: make genstubs * generic/tclBinary.c (Tcl_BinaryObjCmd): * generic/tclClock.c (Tcl_ClockObjCmd): * generic/tclCmdAH.c (Tcl_EncodingObjCmd, Tcl_FileObjCmd): * generic/tclCmdIL.c (Tcl_InfoObjCmd,Tcl_LsearchObjCmd,Tcl_LsortObjCmd): * generic/tclCmdMZ.c (Tcl_TraceObjCmd,Tcl_RegexpObjCmd,Tcl_RegsubObjCmd, (Tcl_StringObjCmd,Tcl_SubstObjCmd,Tcl_SwitchObjCmd, (TclTraceCommandObjCmd,TclTraceVariableObjCmd): * generic/tclCompCmds.c (TclCompileStringCmd): * generic/tclEvent.c (Tcl_UpdateObjCmd): * generic/tclFileName.c (Tcl_GlobObjCmd): * generic/tclIO.c (Tcl_FileEventObjCmd): * generic/tclIOCmd.c (Tcl_SeekObjCmd,Tcl_ExecObjCmd,Tcl_SocketObjCmd, (Tcl_FcopyObjCmd): * generic/tclInterp.c (Tcl_InterpObjCmd,SlaveObjCmd): * generic/tclNamesp.c (Tcl_NamespaceObjCmd): * generic/tclPkg.c (Tcl_PackageObjCmd): * generic/tclTest.c (Tcltest_Init,TestencodingObjCmd,TestgetplatformCmd, (TestlocaleCmd,TestregexpObjCmd,TestsaveresultCmd, (TestGetIndexFromObjStructObjCmd,TestReportFileAttrStrings): * generic/tclTestObj.c (TestindexObjCmd,TeststringObjCmd): * generic/tclTimer.c (Tcl_AfterObjCmd): * generic/tclVar.c (Tcl_ArrayObjCmd): * mac/tclMacFCmd.c (SetFileFinderAttributes): * unix/tclUnixChan.c (TclpOpenFileChannel): * unix/tclUnixFCmd.c (tclpFileAttrStrings): * unix/tclUnixFile.c (TclpObjAccess,TclpObjChdir,TclpObjStat, (TclpObjLstat): * win/tclWinFCmd.c (tclpFileAttrStrings): Updated callers. * doc/RegExp.3: * doc/Utf.3: * generic/tcl.decls: * generic/tclInt.decls: * generic/tclRegexp.c: * generic/tclUtf.c: Updated APIs in generic/tclUtf.c and generic/tclRegexp.c according to the guidelines of TIP 27. [Patch 471509] * generic/regc_locale.c (element,cclass): * generic/tclCmdMZ.c (Tcl_StringObjCmd): * generic/tclFileName.c (TclpGetNativePathType,SplitMacPath): * generic/tclIO.c (ReadChars): * mac/tclMacLoad.c (TclpLoadFile): * win/tclWinFile.c (TclpGetUserHome): Updated callers. * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs * doc/ParseCmd.3 (Tcl_ParseVar): * generic/tcl.decls (Tcl_ParseVar): * generic/tclParse.c (Tcl_ParseVar): * generic/tclTest.c (TestparsevarObjCmd): Updated APIs in generic/tclParse.c according to the guidelines of TIP 27. Updated callers. [Patch 501046] * generic/tclDecls.h: make genstubs * generic/tcl.decls (Tcl_RecordAndEval): * generic/tclDecls.h: make genstubs * generic/tclHistory.c (Tcl_RecordAndEval): Updated APIs in generic/tclHistory.c according to the guidelines of TIP 27. [Patch 504091] * doc/CrtSlave.3: * generic/tcl.decls (Tcl_CreateAlias, Tcl_CreateAliasObj, (Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave): * generic/tclInterp.c (Tcl_CreateAlias, Tcl_CreateAliasObj, (Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave): Updated APIs in the file generic/tclInterp.c according to the guidelines of TIP 27. [Patch 501371] ***POTENTIAL INCOMPATIBILITY*** Includes a source incompatibility in the targetCmdPtr arguments of the Tcl_GetAlias* routines. * generic/tclDecls.h: make genstubs 2002-01-15 Don Porter * doc/SetErrno.3 (Tcl_ErrnoMsg): Corrected documentation for Tcl_ErrnoMsg; it takes an integer argument. Thanks to Georgios Petasis. [Bug 468183] * doc/AddErrInfo.3 (Tcl_PosixError): * doc/Eval.3 (Tcl_EvalFile): * doc/FileSystem.c (Tcl_FSOpenFileChannel,Tcl_FSOpenFileChannelProc): * doc/OpenFileChnl.3 (Tcl_OpenFileChannel): * doc/SetErrno.3 (Tcl_ErrnoId,Tcl_ErrnoMsg): * doc/Signal.3 (Tcl_SignalId,Tcl_SignalMsg): * generic/tcl.decls (Tcl_ErrnoId,TclErrnoMsg,Tcl_EvalFile, (Tcl_OpenFileChannel,Tcl_PosixError,Tcl_SignalId,Tcl_SignalMsg, (Tcl_FSOpenFileChannel): * generic/tcl.h (Tcl_FSOpenFileChannelProc): * generic/tclIO.c (FlushChannel): * generic/tclIOUtil.c (Tcl_OpenFileChannel,Tcl_EvalFile,TclGetOpenMode, (Tcl_PosixError,Tcl_FSOpenFileChannel): * generic/tclInt.decls (TclGetOpenMode): * generic/tclInt.h (TclOpenFileChannelProc_,TclGetOpenMode, (TclpOpenFileChannel): * generic/tclPipe.c (TclCleanupChildren): * generic/tclPosixStr.c (Tcl_ErrnoId,Tcl_ErrnoMsg,Tcl_SignalId, (Tcl_SignalMsg): * generic.tclTest.c (PretendTclpOpenFileChannel, (TestOpenFileChannelProc1,TestOpenFileChannelProc2, (TestOpenFileChannelProc3,TestReportOpenFileChannel): * mac/tclMacChan.c (TclpOpenFileChannel): * unix/tclUnixChan.c (TclpOpenFileChannel): * win/tclWinChan.c (TclpOpenFileChannel): Updated APIs in generic/tclIOUtil.c and generic/tclPosixStr.c according to the guidelines of TIP 27. Updated callers. [Patch 499196] * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs * doc/CrtChannel.3: * doc/OpenFileChnl.3: * generic/tcl.decls: * generic/tclIO.h: * generic/tclIO.c (DoWrite, Tcl_RegisterChannel, Tcl_GetChannel, (Tcl_CreateChannel, Tcl_GetChannelName, CloseChannel, Tcl_Write, (Tcl_WriteRaw, Tcl_Ungets, Tcl_BadChannelOption, Tcl_GetChannelOption, (Tcl_SetChannelOption, Tcl_GetChannelNamesEx, Tcl_ChannelName): Updated APIs in the file generic/tclIO.c according to the guidelines of TIP 27. Several minor documentation corrections as well. [Patch 503565] * generic/tclDecls.h: make genstubs * generic/tcl.h (Tcl_DriverOutputProc, Tcl_DriverGetOptionProc, (Tcl_DriverSetOptionProc): * generic/tclIOGT.c (TransformOutputProc, TransformGetOptionProc, (TransformSetOptionProc): * mac/tclMacChan.c (FileOutput, StdIOOutput): * man/tclMacSock.c (TcpGetOptionProc, TcpOutput): * unix/tclUnixChan.c (FileOutputProc, TcpGetOptionProc, TcpOutputProc, (TtyGetOptionProc, TtySetOptionProc): * unix/tclUnixPipe.c (PipeOuputProc): * win/tclWinChan.c (FileOutputProc): * win/tclWinConsole.c (ConsleOutputProc): * win/tclWinPipe.c (PipeOuputProc): * win/tclWinSerial.c (SerialOutputProc, SerialGetOptionProc, (SerialSetOptionProc): * win/tclWinSock.c (TcpGetOptionProc, TcpOutput): Updated channel driver interface according to the guidelines of TIP 27. See also [Bug 500348]. * doc/CrtChannel.3: * generic/tcl.h: * generic/tclIO.c: * generic/tclIO.h: * generic/tclInt.h: * tools/checkLibraryDoc.tcl: Moved Tcl_EolTranslation enum declaration from generic/tcl.h to generic/tclInt.h (renamed to TclEolTranslation). It is not used anywhere in Tcl's public interface. 2002-01-14 Don Porter * doc/GetIndex.3: * doc/WrongNumArgs.3: * generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct, (Tcl_WrongNumArgs): * generic/tclIndexObj.c (Tcl_GetIndexFromObj,Tcl_GetIndexFromObjStruct, (Tcl_WrongNumArgs): Updated APIs in the file generic/tclIndexObj.c according to the guidelines of TIP 27. [Patch 501491] * generic/tclDecls.h: make genstubs 2002-01-11 Mo DeJong * unix/configure: Regen. * unix/configure.in: * win/configure: Regen. * win/configure.in: Use ${libdir} instead of ${exec_prefix}/lib to properly support the --libdir option to configure. [Bug 489370] 2002-01-11 Andreas Kupries * win/tclWinSerial.c (SerialSetOptionProc): Applied patch for [Bug 500348] supplied by Rolf Schroedter . The function modified the contents of the the 'value' string and now does not do this anymore. This is a followup to the change made on 2001-12-17. 2002-01-11 David Gravereaux * win/makefile.vc: Removed -GD compiler option. It was intended for future use, but MS is again changing the future at their whim. The D4002 warning was harmless though, but someone using VC .NET logged it as a concern. [Bug 501565] 2002-01-11 Mo DeJong * unix/Makefile.in: Burn Tcl build directory into tcltest executable to avoid crashes caused by ld loading a previously installed version of the tcl shared library. [Bug 218110] 2002-01-10 Don Porter , Kevin Kenny * unix/tclLoadDld.c (TclpLoadFile): syntax error: unbalanced parens. Kevin notes that it's far from clear that this file is ever included in an actual build; Linux without dlopen appears to be a nonexistent configuration. 2002-01-08 Don Porter , Kevin Kenny * doc/StaticPkg.3 (Tcl_StaticPackage): * generic/tcl.decls (Tcl_StaticPackage): * generic/tclDecls.h (Tcl_StaticPackage): * generic/tclInt.decls (TclGuessPackageName): * generic/tclInt.h (TclGuessPackageName): * generic/tclLoad.c (Tcl_StaticPackage): * generic/tclLoadNone.c (TclGuessPackageName): * mac/tclMacLoad.c (TclGuessPackageName): * unix/tclLoadAout.c (TclGuessPackageName): * unix/tclLoadDl.c (TclGuessPackageName): * unix/tclLoadDld.c (TclGuessPackageName): * unix/tclLoadDyld.c (TclGuessPackageName): * unix/tclLoadNext.c (TclGuessPackageName): * unix/tclLoadOSF.c (TclGuessPackageName): * unix/tclLoadShl.c (TclGuessPackageName): * win/tclWinLoad.c (TclGuessPackageName): Updated APIs in the files */tcl*Load*.c according to the guidelines of TIP 27. [Patch 501096] 2002-01-09 Don Porter * generic/tclTest.c (MainLoop): * tests/main.test (Tcl_Main-1.{3,4,5,6}): Corrected some non-portable tests from the new Tcl_Main changes. Thanks to Kevin Kenny. 2002-01-07 Don Porter * generic/tclEvent.c (TclInExit): * generic/tclIOUtil.c (SetFsPathFromAbsoluteNormalized, (SetFsPathFromAny,Tcl_FSNewNativePath,DupFsPathInternalRep): * generic/tclListObj.c (TclLsetList,TclLsetFlat): Added some type casts to satisfy picky compilers. * generic/tclMain.c: Bug fix: neglected the NULL case in TclGetStartupScriptFileName(). Broke Tk/wish. 2002-01-05 Don Porter * doc/Tcl_Main.3: * generic/tclMain.c: Substantial rewrite and expanded documentation of Tcl_Main to correct a number of bugs and flaws: - Interactive Tcl_Main can now enter a main loop, exit that loop and continue interactive operations. The loop may even exit in the midst of interactive command typing without loss of the partial command. [Bugs 486453, 474131] - Tcl_Main now gracefully handles deletion of its master interpreter. - Interactive Tcl_Main can now operate with non-blocking stdin - Interactive Tcl_Main can now detect EOF on stdin even in mid-command. [Bug 491341] - Added VFS-aware internal routines for managing the startup script selection. - Tcl variable 'tcl_interactive' is now linked to C variable 'tty' so that one can disable/enable interactive prompts at the script level when there is no startup script. This is meant for use by the test suite. - Consistent use of the Tcl libraries standard channels as returned by Tcl_GetStdChannel(); as opposed to the channels named 'stdin', 'stdout', and 'stderr' in the master interp, which can be different or unavailable. - Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the master interpreter returns, assuring Tcl_Main does not return. - Documented Tcl_Main's absence from public stub table - Documented that Tcl_Main does not return. - Documented Tcl variables set by Tcl_Main. - All prompts are done from a single procedure, Prompt. - Use of Tcl_Obj-enabled interfaces everywhere. * generic/tclInt.decls (TclGetStartupScriptPath, (TclSetStartupScriptPath): New internal VFS-aware routines for managing the startup script of Tcl_Main. * generic/tclIntDecls.h: * generic/tclStubInit.c: make genstubs * generic/tclTest.c (TestsetmainloopCmd,TestexitmainloopCmd, (Tcltest_Init,TestinterpdeleteCmd): * tests/main.test (new): Added new file to test suite that thoroughly tests generic/tclMain.c; added some new test commands for testing Tcl_SetMainLoop(). 2002-01-04 Don Porter * doc/Alloc.3: * doc/Concat.3: * doc/CrtMathFnc.3: * doc/Hash.3: * doc/Interp.3: * doc/LinkVar.3: * doc/ObjectType.3: * doc/PkgRequire.3: * doc/Preserve.3: * doc/SetResult.3: * doc/SplitList.3: * doc/SplitPath.3: * doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc, ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and to accurately describe when and how they are used. [Bug 497459] * generic/tclThreadJoin.c (TclRememberJoinableThread,TclJoinThread): Replaced Tcl_Alloc and Tcl_Free calls with ckalloc and ckfree so that memory debugging is supported. 2002-01-04 Daniel Steffen * mac/tclMacTime.c (TclpGetTZName): fix for daylight savings TZName bug 2002-01-03 Don Porter * doc/FileSystem.3: * generic/tclIOUtil.c: Updated some old uses of "fileName" to new VFS terminology, "pathPtr". 2002-01-03 Donal K. Fellows * tests/basic.test (basic-39.4): Greatly simplified test while still leaving it so that it crashes when run without the fix to the [foreach] implementation. * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stopped [Bug 494348] from happening by not trying to be so clever with cacheing; if nothing untoward is happening anyway, the less efficient technique will only add a few instruction cycles (one function call and a few derefs/assigns per list per iteration, with no change in the number of tests) and if something odd *is* going on, the code is now far more robust. * tests/basic.test (basic-39.4): Reproducable script from [Bug 494348] 2002-01-02 Donal K. Fellows * tests/util.test (Wrapper_Tcl_StringMatch,util-5.*): Rewrote so the test is performed with the right internal function since [string match] no longer uses Tcl_StringCaseMatch internally. * tests/string.test (string-11.51): * generic/tclUtf.c (Tcl_UniCharCaseMatch): * generic/tclUtil.c (Tcl_StringCaseMatch): Fault with matching case-insensitive non-ASCII patterns containing upper case characters. [Bug 233257] ****************************************************************** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ****************************************************************** tcl8.6.14/ChangeLog.20030000644000175000017500000037661414554262142014020 0ustar sergeisergei2003-12-25 Mo DeJong * win/tclWin32Dll.c (DllMain): Add HAVE_NO_SEH blocks in place of __try and __except statements to support gcc builds. This is needed after David's changes on 2003-12-21. [Patch 858493] 2003-12-23 David Gravereaux * generic/tclAlloc.c: All uses of 'panic' (the macro) changed to * generic/tclBasic.c: 'Tcl_Panic' (the function). The #define of * generic/tclBinary.c: panic in tcl.h clearly states it is deprecated * generic/tclCkalloc.c: in the comments. [Patch 865264] * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclCompCmds.c: * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclConfig.c: * generic/tclDictObj.c: * generic/tclEncoding.c: * generic/tclEvent.c: * generic/tclExecute.c: * generic/tclHash.c: * generic/tclInterp.c: * generic/tclIO.c: * generic/tclIOCmd.c: * generic/tclIOUtil.c: * generic/tclListObj.c: * generic/tclLiteral.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclParse.c: * generic/tclPathObj.c: * generic/tclPkg.c: * generic/tclPreserve.c: * generic/tclProc.c: * generic/tclStringObj.c: * generic/tclTest.c: * generic/tclThreadAlloc.c: * generic/tclTimer.c: * generic/tclTrace.c: * generic/tclVar.c: * mac/tclMacChan.c: * mac/tclMacOSA.c: * mac/tclMacResource.c: * mac/tclMacSock.c * mac/tclMacThrd.c: * unix/tclUnixChan.c: * unix/tclUnixNotfy.c: * unix/tclUnixThrd.c: * unix/tclXtNotify.c: * win/tclWin32Dll.c: * win/tclWinChan.c: * win/tclWinFCmd.c: * win/tclWinNotify.c: * win/tclWinPipe.c: * win/tclWinSock.c: * win/tclWinThrd.c: * generic/tclInt.h: Deprecated use of Tcl_Ckalloc changed to Tcl_Alloc in the TclAllocObjStorage macro. 2003-12-22 David Gravereaux * win/nmakehlp.c: * win/rules.vc: New feature for extensions that use rules.vc. Now reads header files for version strings. No more hard coding TCL_VERSION = 8.5 and having to edit it when you swap cores. * win/makefile.vc: VERSION macro now set by reading tcl.h for it. * generic/tcl.h: Removed note that makefile.vc needs to have a version number changed. 2003-12-21 David Gravereaux * win/tclWin32Dll.c: Structured Exception Handling added around Tcl_Finalize called from DllMain's DLL_PROCESS_DETACH. We can't be 100% assured that Tcl is being unloaded by the OS in a stable condition and we need to protect the exit handlers should the stack be in a hosed state. AT&T style assembly for SEH under MinGW has not been added yet. This is a first part change for [Patch 858493] 2003-12-17 Daniel Steffen * generic/tclBinary.c (DeleteScanNumberCache): fixed crashing bug when numeric scan-value cache contains NULL value. 2003-12-17 Vince Darley * generic/tclCmdAH.c: * unix/tclUnixFile.c: * win/tclWinFCmd.c: * tests/fCmd.test: * tests/fileSystem.test: * doc/file.n: final fix to support for relative links and its implications on normalization and other parts of the filesystem code. Fixes [Bug 859251] and some Windows problems with recursive file delete/copy and symbolic links. 2003-12-17 Vince Darley * generic/tclPathObj.c: * tests/fileSystem.test: fix and tests for [Bug 860402] in new file normalization code. 2003-12-17 Zoran Vasiljevic * generic/tclIOUtil.c: fixed 2 memory (object) leaks. [Bug 839519] * generic/tclPathObj.c: fixed Tcl_FSGetTranslatedPath to always return properly refcounted path object. [Bug 861515] 2003-12-16 Vince Darley * tests/fCmd.test: marking fCmd-9.14.2, as nonPortable, since on Solaris one can change the name of the current directory with 'file rename'. * doc/FileSystem.3: clarified documentation on ownership of return objects/strings of some Tcl_FS* calls. 2003-12-16 Donal K. Fellows * generic/tclThreadAlloc.c (binfo): Made variable file-local. 2003-12-15 David Gravereaux * win/tcl.rc: * win/tclsh.rc: Slight modification to the STRINGIFY macro to support Borland's rc tool. * win/tclWinFile.c (TclpUtime) : utimbuf struct not a problem with Borland. * win/tclWinTime.c (TclpGetDate) : Borland's localtime() has a slight behavioral difference. From Helmut Giese [Patch 758097]. 2003-12-14 David Gravereaux * generic/tclInt.decls: commented-out entry for TclpCheckStackSpace, removing it from the Stubs table. It's already declared in tclInt.h and labeled as a function that is not to be exported. Regened tables. 2003-12-14 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): TIP#75 Implementation * tests/switch.test: Can now get submatch information when using * doc/switch.n: -regexp matching in [switch]. 2003-12-14 Vince Darley * generic/tclPathObj.c: complete rewrite of generic file normalization code to cope with links followed by '..'. [Bug 849514], and parts of [Bug 859251] 2003-12-12 David Gravereaux * win/tclWinChan.c: Win32's SetFilePointer() takes LONGs not DWORDs (a signed/unsigned mismatch). Redid local vars to avoid all casting except where truly required. 2003-12-12 Vince Darley * generic/tclCmdAH.c: fix to normalization of non-existent user name ('file normalize ~nobody') [Bug 858937] * doc/file.n: clarify behaviour of 'file link' when the target is not an absolute path. * doc/filename.n: correct documentation to say that Windows Tcl does handle '~user', for recent Windows releases, and clarified distinction between MacOS 'classic' and MacOS X. * doc/glob.n: clarification of glob's behaviour when returning filenames starting with a '~'. * tests/fileSystem.test: * tests/fileName.test: new tests added for the normalization problem above and other recentlt reported issues. * win/tclWinFile.c: corrected unclear comments * unix/tclUnixFile.c: allow creation of relative links. [Bug 833713] 2003-12-11 David Gravereaux * win/tclWinSock.c (SocketThreadExitHandler) : added a TerminateThread fallback just in case the socket handler thread is really in a paused state. This can happen when Tcl is being unloaded by the OS from an exception handler. See MSDN docs on DllMain, it states this behavior. 2003-12-09 Jeff Hobbs * unix/configure: * unix/tcl.m4: updated OpenBSD build configuration based on [Patch #775246] (cassoff) 2003-12-09 Donal K. Fellows * unix/tclUnixPort.h: #ifdef'd out declarations of errno which are * tools/man2tcl.c: known to cause problems with recent glibc. [Bug 852369] 2003-12-09 Vince Darley * win/tclWinFile.c: fix to NT file permissions code [Bug 855923] * tests/winFile.test: added tests for NT file permissions - patch and test scripts supplied by Benny. * tests/winFCmd.test: fixed one test for when not running in C:/ 2003-12-02 Donal K. Fellows * generic/tclBinary.c (DeleteScanNumberCache, ScanNumber): Made the numeric scan-value cache have proper references to the objects within it so strange patterns of writes won't cause references to freed objects. Thanks to Paul Obermeir for the report. [Bug 851747] 2003-12-01 Miguel Sofer * doc/lset.n: fix typo [Bug 852224] 2003-11-24 Don Porter * generic/tclParse.c: Corrected faulty check for trailing white space in {expand} parsing. Thanks Andreas Leitgeb. [Bug 848262] * tests/parse.test: New tests for the bug. 2003-11-24 Vince Darley * generic/tclPathObj.c: fix to [Bug 845778] - Infinite recursion on [cd] (Windows only bug), for which new tests have just been added. 2003-11-21 Don Porter * tests/winFCmd.test (winFCmd-16.10,11): Merged new tests from core-8-4-branch. 2003-11-20 Miguel Sofer * generic/tclVar.c: fix flag bit collision between LOOKUP_FOR_UPVAR and TCL_PARSE_PART1 (deprecated) [Bug 835020] 2003-11-19 Don Porter * tests/compile.test (compile-16.22.0): Improved test for the recent fix for Bug 845412. 2003-11-19 Donal K. Fellows * generic/tclCompile.c (TclCompileScript): Added a guard for the expansion code so that long non-expanding commands don't get expansion infrastructure inserted in them, especially when that infrastructure isn't initialised. [Bug 845412] 2003-11-18 David Gravereaux * contrib/djgpp/Makefile: Changes from Victor Wagner * contrib/djgpp/langinfo.c (new): for better * contrib/djgpp/langinfo.h (new): DJGPP support. * unix/tclUnixInit.c: . * unix/tclUnixChan.c: . * unix/tclUnixFCmd.c: . 2003-11-17 Don Porter * tests/reg.test: Added tests for [Bugs 230589, 504785, 505048, 840258] recently fixed by 2003-11-15 commit to regcomp.c by Pavel Goran. His notes on the fix: This bug results from an error in code that splits states into "progress" and "no-progress" ones. This error causes an interesting situation with the precollected single-linked list of states to be splitted: many items were added to the list, but only several of them are accessible from the list beginning, since the "tmp" member of struct state (which is used here to hold a pointer to the next list item) gets overwritten, which results in a "looped" chain. As a result, not all of states are splitted, and one state is splitted two times, causing incorrect "no-progress" flag values. 2003-11-16 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Make sure that Tcl_AsyncInvoke is called regularly when processing bytecodes. * generic/tclTest.c (AsyncThreadProc, TestasyncCmd): Extended testing harness to send an asynchronous marking without relying on UNIX signals. * tests/async.test (async-4.*): Tests to check that async events are handled by the bytecode core. [Bug 746722] 2003-11-15 Donal K. Fellows * generic/tclTest.c (TestHashSystemHashCmd): Removed 'const' modifier from hash type structure; it should be const and the hash code assumes it behaves like const, but that's not how the API is defined. Like this, we are following in the same footsteps as Tcl_RegisterObjType() which has the same conditions on its argument. Stops VC++5.2 warning. [Bug 842511] 2003-11-14 Donal K. Fellows * generic/tclHash.c (Tcl_DeleteHashTable,Tcl_HashStats,RebuildTable): * generic/tclTest.c (TestHashSystemHashCmd): TIP#138 implementation, * tests/misc.test: plus a new chunk of stuff to test the hash functions more thoroughly in the test suite. [Patch 731356, modified] * doc/Tcl.n: Updated Tcl version number and changebars. 2003-11-14 Don Porter * doc/ParseCmd.3: Implementation of TIP 157. Adds recognition * doc/Tcl.n: of the new leading {expand} syntax on words. * generic/tcl.h: Parses such words as the new Tcl_Token type * generic/tclBasic.c: TCL_TOKEN_EXPAND_WORD. Updated Tcl_EvalEx and * generic/tclCompile.c: the bytecode compiler/execution engine to * generic/tclCompile.h: recognize the new token type. New opcodes * generic/tclExecute.c: INST_LIST_VERIFY and INST_INVOKE_EXP and a new * generic/tclParse.c: operand type OPERAND_ULIST1 are defined. Docs * generic/tclTest.c: and tests are included. * tests/basic.test: * tests/compile.test: * tests/parse.test: * library/auto.tcl: Replaced several [eval]s used to perform * library/package.tcl: argument expansion with the new syntax. In the * library/safe.tcl: test files lindex.test and lset.test, replaced * tests/cmdInfo.test: use of [eval] to force direct string * tests/encoding.test: evaluation with use of [testevalex] which more * tests/execute.test: directly and robustly serves the same purpose. * tests/fCmd.test: * tests/http.test: * tests/init.test: * tests/interp.test: * tests/io.test: * tests/ioUtil.test: * tests/iogt.test: * tests/lindex.test: * tests/lset.test: * tests/namespace-old.test: * tests/namespace.test: * tests/pkg.test: * tests/pkgMkIndex.test: * tests/proc.test: * tests/reg.test: * tests/trace.test: * tests/upvar.test: * tests/winConsole.test: * tests/winFCmd.test: 2003-11-12 Jeff Hobbs * tests/cmdMZ.test (cmdMZ-1.4): change to nonPortable as more systems are using permissions caching, and this isn't really a Tcl controlled issue. 2003-11-11 Jeff Hobbs * unix/configure: * unix/tcl.m4: improve AIX --enable-64bit handling remove -D__NO_STRING_INLINES -D__NO_MATH_INLINES from CFLAGS_OPTIMIZE on Linux. Make default opt -O2 (was -O). 2003-11-11 David Gravereaux * contrib/djgpp/Makefile: Suggested changes from vitus@45.free.net (Victor Wagner) * unix/tclUnixPort.h: added socklen_t typedef for DJGPP 2003-11-10 Don Porter * unix/tclUnixInit.c (TclpInitLibraryPath): * win/tclWinInit.c (TclpInitLibraryPath): Fix for [Bug 832657] that should not run afoul of startup constraints. * library/dde/pkgIndex.tcl: Added safeguards so that registry and * library/reg/pkgIndex.tcl: dde packages are not offered on * win/tclWinDde.c: non-Windows platforms. Bumped to * win/tclWinReg.c: registry 1.1.3 and dde 1.3. * win/Makefile.in: * win/configure.in: * win/makefile.bc: * win/makefile.vc: * win/configure: autoconf (2.57) 2003-11-10 Donal K. Fellows * tests/cmdIL.test: Stopped cmdIL-5.5 from stomping over the test command, and updated the tests to use some tcltest2 features in relation to cleanup. [Bug 838384] 2003-11-10 Vince Darley * generic/tclCmdAH.c: * tests/fCmd.test: fix to misleading error message in 'file link'. [Bug 836208] 2003-11-07 Vince Darley * generic/tclIOUtil.c: fix to compiler warning/error with some compilers. [Bug 835918] 2003-11-07 Daniel Steffen * macosx/Makefile: optimized builds define NDEBUG to turn off ThreadAlloc range checking. 2003-11-05 Don Porter * tests/unixInit.test (unixInit-2.10): New test to expose [Bug 832657] failure of TclpInitLibraryPath() to properly handle .. in the path of the executable. 2003-11-04 Daniel Steffen * macosx/Makefile: added 'test' target. 2003-11-03 Vince Darley * generic/tclIOUtil.c * generic/tclInt.h: added comments and re-arranged code to clarify distinction between Tcl_LoadHandle, ClientData for 'load'ed code, and point out limitations of the design introduced with Tcl 8.4. * unix/tclUnixFile.c: fix to memory leak * generic/tclCmdIL.c: removed warning on Windows. 2003-11-01 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Check for sensible list lengths and allow for soft failure of the memory subsystem in the [lconcat] command [Bug 829027]. Uses direct list creation to avoid extra copies when working near the limit of available memory. Also reorganized to encourage optimizing compilers to optimize heavily. * generic/tclListObj.c (TclNewListObjDirect): New list constructor that does not copy the array of objects. Useful for creating potentially very large lists or where you are about to throw away the array argument which is being used in its entirety. 2003-10-28 Miguel Sofer * generic/tclExecute.c (NEXT_INST macros): replaced macro variable "result" by "resultHandling" to avoid confusion. 2003-10-23 Andreas Kupries * unix/tclUnixChan.c (Tcl_MakeFileChannel): Applied [Patch 813606] fixing [Bug 813087]. Detection of sockets was off for Mac OS X which implements pipes as local sockets. The new code ensures that only IP sockets are detected as such. * win/tclWinSock.c (TcpWatchProc): Watch for FD_CLOSE too when asked for writable events by the generic layer. (SocketEventProc): Generate a writable event too when a close is detected. Together the changes fix [Bug 599468]. 2003-10-23 Vince Darley * tests/resource.test: * mac/tclMacResource.c: fix to resource freeing problem in 'resource' command reported by Bernard Desgraupes. * doc/FileSystem.3: updated documentation for 'glob' fix on 2003-10-13 below 2003-10-22 Donal K. Fellows * generic/tclCmdAH.c (Tcl_FileObjCmd): Changed FILE_ prefix to FCMD_ to stop symbol/#def clashes on Cygwin/Mingw32 on NT. [Bug 822528] 2003-10-21 Daniel Steffen * tools/tcltk-man2html.tcl: fixed incorrect html generated for .IP/.TP lists, now use
...
...

...
...
instead of illegal

...
...

...
...
. Added skipping of directives directly after .TP to avoid them being used as item descriptions, e.g. .TP\n.VS in clock.n. 2003-10-21 Andreas Kupries * win/tclWinPipe.c (BuildCommandLine): Applied the patch coming with [Bug 805605] to the code, fixing the incorrect use of ispace noted by Ronald Dauster . 2003-10-20 Kevin B. Kenny * doc/msgcat.n: * library/msgcat/msgcat.tcl (mclocale,mcload): * tools/tcl.wse.in: * unix/Makefile.in: Implementation of TIP#156, add a "root locale" * win/makefile.bc: to the 'msgcat' package. Advanced msgcat * win/Makefile.in: version number to 1.4 * win/Makefile.vc: 2003-10-15 Donal K. Fellows * generic/tclCmdIL.c (SortInfo,etc): Reorganized so that SortInfo carries an array of integer indices instead of a Tcl list. This nips shimmering problems in the bud and simplifies SelectObjFromSublist at the cost of making setup slightly more complex. [Bug 823768] 2003-10-14 David Gravereaux * win/tclAppInit.c (sigHandler): Punt gracefully if exitToken has already been destroyed. 2003-10-14 Vince Darley * generic/tclCmdMZ.c: * tests/regexp.test: fix to [Bug 823524] in regsub; added three new tests. 2003-10-14 Don Porter * generic/tclBasic.c (TclAppendObjToErrorInfo): New internal routine that appends a Tcl_Obj to the errorInfo, saving the caller the trouble of extracting the string rep. * generic/tclStringObj.c (TclAppendLimitedToObj): New internal routine that supports truncated appends with optional ellipsis marking. This single routine supports UTF-8-safe truncated appends needed in several places throughout the Tcl source code, mostly for error and stack messages. Clean fix for [Bug 760872]. * generic/tclInt.h: Declarations for new internal routines. * generic/tclCmdMZ.c: Updated callers to use the new routines. * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclExecute.c: * generic/tclIOUtil.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclParseExpr.c: * generic/tclProc.c: * generic/tclStringObj.c: * mac/tclMacResource.c: * library/init.tcl: Updated ::errorInfo cleanup in [unknown] to reflect slight modifications to Tcl_LogCommandInfo(). Corrects failing init-4.* tests. 2003-10-14 Donal K. Fellows TIP#127 IMPLEMENTATION FROM JOE MICHAEL SCHLENKER * generic/tclCmdIL.c (SelectObjFromSublist): Element selection engine. * generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd): * tests/lsearch.test: Set up and use of element selection engine, * tests/cmdIL.test: plus tests and documentation. * doc/lsearch.n: Based on [Patch 693836] * doc/lsort.n: 2003-10-13 Vince Darley * generic/tcl.h: * generic/tclFileName.c: * generic/tclIOUtil.c: * generic/tclPathObj.c: * generic/tclTest.c: * mac/tclMacFile.c: * tests/fileName.test: better tests for [Bug 813273] * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * win/tclWin32Dll.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclFileInt.h: Fixed [Bug 800106] in which 'glob' was incapable of merging the results of a directory listing (real or virtual) and any virtual filesystem mountpoints in that directory (the latter were ignored). This meant boundaries between different filesystems were not seamless (e.g. 'glob */*' across a filesystem boundary was wrong). Added new entry to Tcl_GlobTypeData in a totally backwards compatible way. To allow listing of mounts, registered filesystems must support the 'TCL_GLOB_TYPE_MOUNT' flag. If this is not supported (e.g. in tclvfs 1.2) then mounts will simply not be listed for that filesystem. Fixed [Bug 749876] 'file writable/readable/etc' (NativeAccess) using correct permission checking code for Windows NT/2000/XP where more complex user-based security/access priveleges are available, particularly on shared volumes. The performance impact of this extra checking will need further investigation. Note: Win 95,98,ME have no support for this. Also made better use of normalized rather than translated paths in the platform specific code. 2003-10-12 Jeff Hobbs * unix/tclUnixTest.c (TestalarmCmd): don't bother checking return value of alarm. [Bug #664755] (english) 2003-10-09 Pat Thoyts * win/makefile.vc: Applied patches for bug #801467 by Joe Mistachkin * win/tclAppInit.c: to fix incompatible TCL_MEM_DEBUG handling in * generic/tclObj.c: Win32 VC builds. 2003-10-08 Don Porter * generic/tclBasic.c: Save and restore the iPtr->flag bits that control the state of errorCode and errorInfo management when calling "leave" execution traces, so that all error information of the traced command is still available whether traced or not. [Bug 760947] Thanks to Yahalom Emet. 2003-10-08 Donal K. Fellows * generic/tclTest.c (TestNumUtfCharsCmd): Command to allow finer access to Tcl_NumUtfChars for testing. * generic/tclUtf.c (Tcl_NumUtfChars): Corrected string length determining when the length parameter is negative; the terminator is a zero byte, not (necessarily) a \u0000 character. [Bug 769812] 2003-10-07 Don Porter * tests/cmdAH.test: * tests/exec.test: Corrected temporary file management * tests/fileSystem.test: issues uncovered by -debug 1 test * tests/io.test: operations. Also backported some * tests/ioCmd.test: other fixes from the HEAD. * tests/main.test: * tests/pid.test: [Bugs 675605, 675655, 675659] * tests/socket.test: * tests/source.test: * tests/fCmd.test: Run tests with the [temporaryDirectory] as the current directory, so that tests can depend on ability to write files. [Bug 575837] * doc/OpenFileChnl.3: Updated Tcl_Tell and Tcl_Seek documentation to reflect that they now return Tcl_WideInt (TIP 72). [Bug 787537] * tests/io.test: Corrected several tests that failed when paths * tests/ioCmd.test: included regexp-special chars. [Bug 775394] 2003-10-06 Jeff Hobbs * win/configure: * win/tcl.m4: removed incorrect checks for existence of optimization. TCL_CFG_OPTIMIZED is now defined whenever the user does not build with --enable-symbols. 2003-10-06 Don Porter * tests/regexp.test: Matched [makeFile] with [removeFile]. * tests/regexpComp.test: [Bug 675652] * tests/fCmd.test (fCmd-8.2): Test only that tilde-substitution happens, not for any particular result. [Bug 685991] * unix/tcl.m4 (SC_PATH_TCLCONFIG): Corrected search path so that alpha and beta releases of Tcl are not favored. [Bug 608698] * tests/reg.test: Corrected duplicate test names. * tests/resource.test: [Bugs 710370, 710358] * tests/dict.test: * tests/dict.test: Updated [package require tcltest] lines to * tests/fileSystem.test: indiciate that these test files * tests/lrepeat.test: use features of tcltest 2. [Bug 706114] * tests/notify.test: * tests/parseExpr.test: * tests/unixNotfy.test: * tests/winDde.test: 2003-10-04 Miguel Sofer * generic/tclExecute.c (TEBC): * tests/execute.test (execute-8.2): fix for [Bug 816641] - faulty execution and catch stack management. 2003-10-03 Don Porter * generic/tclBasic.c: Fixed error in ref count management of command * generic/tclCmdMZ.c: and execution traces that caused access to freed memory in trace-32.1. [Bug 811483] 2003-10-02 Don Porter * generic/tclTrace.c: Corrected comingling of introspection results of [trace info command] and [trace info execution]. [Bug 807243] Thanks to Mark Saye. 2003-10-01 Daniel Steffen * macosx/Makefile: fixed redo prebinding bug when DESTDIR="". * mac/tclMacResource.c: fixed possible NULL dereference (bdesgraupes). 2003-09-29 Vince Darley * generic/tclPathObj.c: * tests/fileName.test: fix to inconsistent handling of backslash path separators on Windows in 'file join' [Bug 813273] 2003-09-29 Donal K. Fellows * generic/tclPathObj.c (TclNativePathInFilesystem,TclFSGetPathType): * generic/tclIOUtil.c (TclNativeDupInternalRep,TclGetPathType): Rename to make sure function names won't interfere with other non-Tcl code (reported by George Staplin) TIP#121 IMPLEMENTATION FROM JOE MISTACHKIN * generic/tclEvent.c (Tcl_SetExitProc,Tcl_Exit): Implementation of application exit handler scheme. * generic/tcl.decls (Tcl_SetExitProc): Public declaration. * doc/Exit.3: Documentation of new API function. TIP#112 IMPLEMENTATION * generic/tclNamesp.c: Core of implementation. * generic/tclInt.h (Namespace,TclInvalidateNsCmdLookup): Add command list epoch counter and list of ensembles to namespace structure, and define a macro to ease update of the epoch counter. * generic/tclBasic.c (Tcl_CreateObjCommand,etc.): Update epoch counter when list of commands in a namespace changes. * generic/tclObj.c (TclInitObjSubsystem): Register ensemble subcommand type. * tests/namespace.test (42.1-47.6): Tests. * doc/namespace.n: Documentation. * library/http/http.tcl (geturl): Correctly check the type of boolean-valued options. [Bug 811170] * unix/tcl.m4 (SC_ENABLE_FRAMEWORK): Added note to make it clearer that this is an OSX feature, not a general Unix feature. [Bug 619440] 2003-09-28 David Gravereaux * win/tclWinPipe.c: The windows port of expect can call TclWinAddProcess before any of the other pipe functions. Added a missing PipeInit() call to make sure the initialization happens. 2003-09-25 Daniel Steffen * macosx/Makefile: ensure SYMROOT exists if OBJROOT is overridden on command line. Replaced explict use of /usr/bin by ${BINDIR}. 2003-09-24 Vince Darley * library/package.tcl (tcl::MacPkgUnknown, tcl::MacOSXPkgUnknown): Minor performance tweaks to reduce the number of [file] invocations. Meant to improve startup times, at least a little bit. (The generic equivalent patch was applied on 2003-02-21). 2003-09-24 Vince Darley * trace.test: removed 'knownBug' from a test which doesn't illustrate a bug, just a bad test. 2003-09-23 Miguel Sofer * generic/tclExecute.c: * generic/tclInt.h: changed the evaluation-stack addressing mode, from array-style to pointer-style; the catch stack and evaluation stack are now contiguous in memory. [Patch 457449] 2003-09-23 Don Porter * tests/trace.test (trace-31,32-*): Added tests for [Bug 807243] and [Bug 811483]. * library/init.tcl (auto_load, auto_import): Expanded Eric Melski's 2000-01-28 fix for [Bug 218871] to all potentially troubled uses of [info commands] on input data, where glob-special characters could cause problems. 2003-09-20 Donal K. Fellows * tests/expr.test (expr-23.4): Prevented accidental wrapping round of exponential operation; it isn't portable, and not what I intended to test either. [Bug 808244] 2003-09-19 Miguel Sofer * generic/tclExecute.c: adding (DE)CACHE_STACK_INFO() pairs to protect all calls that may cause traces on ::errorInfo or ::errorCode to corrupt the stack. [Bug 804681] 2003-09-17 Vince Darley * tclPathObj.c: fix to test-suite problem introduced by the bug fix below. No problem in ordinary code, just test suite code which manually adjusts tclPlatform. [Bug 808247] 2003-09-16 Vince Darley * doc/filename.n: documentation of Windows-specific feature as discussed in [Bug 541989] * generic/tclPathObj.c: fix for normalization of volume-relative paths [Bug 767834] * tests/winFCmd.test: new tests for both of the above. * tests/cmdAH.test: fix for AFS problem in test suite [Bug 748960] 2003-09-13 Donal K. Fellows TIP#123 IMPLEMENTATION BASED ON WORK BY ARJEN MARKUS * generic/tclCompile.h (INST_EXPON): Implementation of * generic/tclCompile.c (tclInstructionTable): exponential operator. * generic/tclCompExpr.c (operatorTable): * generic/tclParseExpr.c (ParseExponentialExpr, GetLexeme): * generic/tclExecute.c (TclExecuteByteCode, ExponWide, ExponLong): (IllegalExprOperandType): * tests/expr.test: * tests/compExpr-old.test: * doc/expr.n: 2003-09-10 Don Porter * library/opt/optparse.tcl: Latest revisions caused [OptGuessType] to guess "int" instead of "string" for empty strings. Missed the required "-strict" option to [string is]. Thanks to Revar Desmera. [Bug 803968] 2003-09-08 David Gravereaux * win/tclWinLoad.c (TclpDlopen): Changed the error message for ERROR_PROC_NOT_FOUND to be a bit more helpful in giving us clues. "can't find specified procedure" means a function in the import table, for implicit loading, couldn't be resolved and that's why the load failed. 2003-09-04 Don Porter * doc/Tcl_Main.3: * doc/FileSystem.3: Implementation of * doc/source.n: TIPs 137/151. Adds a * doc/tclsh.1: -encoding option to * generic/tcl.decls: the [source] command * generic/tclCmdMZ.c (Tcl_SourceObjCmd): and a new C routine, * generic/tclIOUtil.c (Tcl_FSEvalFileEx): Tcl_FSEvalFileEx(), * generic/tclMain.c (Tcl_Main): that provides C access * mac/tclMacResource.c (Tcl_MacSourceObjCmd): to the same function. * tests/cmdMZ.test: Also adds command line * tests/main.test: option handling in Tcl_Main() so that tclsh * tests/source.test: and other apps built on Tcl_Main() respect a -encoding command line option before a script filename. Docs and tests updated as well. [Patch 742683] This is a ***POTENTIAL INCOMPATIBILITY*** only for those C programs that embed Tcl, build on Tcl_Main(), and make use of Tcl_Main's former ability to pass a leading "-encoding" option to interactive shell operations. * generic/tclInt.decls: Added internal stub * generic/tclMain.c (Tcl*StartupScript*): table entries for two new functions Tcl_SetStartupScript() and Tcl_GetStartupScript() that set/get the path and encoding for the startup script to be evaluated by either Tcl_Main() or Tk_Main(). Given public names in anticipation of their exposure by a followup TIP. * generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclStubInit.c: 2003-09-04 Don Porter * doc/SplitList.3: Implementation of TIP 148. Fixes [Bug 489537]. * generic/tcl.h: Updated Tcl_ConvertCountedElement() to quote * generic/tclUtil.c: the leading "#" character of all list elements unless the TCL_DONT_QUOTE_HASH flag is passed in. * generic/tclDictObj.c: Updated Tcl_ConvertCountedElement() callers * generic/tclListObj.c: to pass in the TCL_DONT_QUOTE_HASH flags * generic/tclResult.c: when appropriate. 2003-08-31 Don Porter * doc/return.n: Updated [return] docs to cover new TIP 90 features. * doc/break.n: Added SEE ALSO references to return.n * doc/continue.n: 2003-09-01 Donal K. Fellows * doc/Namespace.3: Basic documentation for the TIP#139 functions. This will need improving, but the basic bits are there at least. 2003-08-31 Don Porter * doc/catch.n: Updated [catch] docs to cover new TIP 90 features. 2003-08-29 Don Porter * generic/tclCmdAH.c: Corrected bug in TIP 90 implementation where * tests/cmdMZ.test: the default -errorcode NONE value was not copied into the return options dictionary. This correction modified one test result. 2003-08-27 David Gravereaux * compat/strftime.c (_fmt): Removed syst array intializer that couldn't take variables within it under the watcom compiler: 'Initializers must be constant'. I believe Borland has this strictness as well. VC++ must be non-standard about this. Changed Win32 platform #ifdef from 'WIN32' to '__WIN32__' as this is the correct one to use across the Tcl sources. Even though we do force it in tcl.h, the true parent one is __WIN32__. Added missing CONST'ification usage to match prototype listed in tclInt.decls. * win/tclWinPort.h: Added a block for OpenWatcom adjustments that fixes 1) the same issue Mo did for MinGW lack of missing LPFN_* typedefs in their WINE derived and 2) The need to be strict about how the char type needs to be signed by default. * win/tclWinSock.c: Added OpenWatcom to the commentary about the #ifdef HAVE_NO_LPFN_DECLS block. * win/tclWinTime.c: Changed use of '_timezone' to 'timezone' as this difference is already adjusted for in tclWinPort.h. Removed unreferenced posixEpoch file-scope global. * win/tclWinFile.c (WinReadLinkDirectory): Fix for 'Initializers must be constant' with the driveSpec array using OpenWatcom. 2003-08-27 Don Porter * generic/tclUtil.c: Corrected [Bug 411825] and other bugs in TclNeedSpace() where non-breaking space (\u00A0) and backslash-escaped spaces were handled incorrectly. * tests/util.test: Added new tests util-8.[2-6]. 2003-08-26 David Gravereaux * generic/tcl.h: Added some support for the LCC-Win32 compiler. Unfortunetly, this compiler has a bug in its preprocessor and can't build Tcl even with this minor patch. Also added some support for the OpenWatcom compiler. A new win/makefile.wc to follow soon. 2003-08-25 Donal K. Fellows * tools/genStubs.tcl (genStubs::makeDecl): A more subtle way of generating stubbed declarations allows us to have declarations of a function in multiple interfaces simultaneously. * generic/tcl.decls: Duplicated some namespace declarations from tclInt.decls here, as mandated by TIP #139. This is OK since the declarations match and will end up using the declarations in the public code from now on because of #include ordering. Keeping the old declarations in tclInt.decls; there's no need to gratuitously break compatibility for those extensions which are already clients of the namespace code. 2003-08-23 Zoran Vasiljevic * generic/tclIOUtil.c: merged fixes for thread-unsafe handling of filesystem records [Bug 753315]. This also fixed the [Bug 788780] * generic/tclPathObj.c: merged fixes for thread-unsafe handling of filesystem records. [Bug 753315] * generic/tclFileSystem.h: merged fixes for thread-unsafe handling of filesystem records. [Bug 753315] 2003-08-19 Pat Thoyts * win/tclWinSerial.c (SerialErrorStr): Fixed a syntax error created in the previous code cleanup. 2003-08-19 Donal K. Fellows * win/tclWinSerial.c: Adjusted commenting and spacing usage to follow the principles of the Style Guide better. 2003-08-18 Mo DeJong * win/configure: Regen. * win/tcl.m4 (SC_ENABLE_SYMBOLS): Use test instead of -eq, which does not work. [Bug 781109] 2003-08-13 Chengye Mao * win/tclWinPipe.c: fixed a bug in BuildCommandLine. This bug built a command line with a missing space between tclpipe.dll and the following arguments. It caused error in Windows 98 when exec command.com (e.g. dir). [Bug 789040] 2003-08-11 Donal K. Fellows TIP #136 IMPLEMENTATION from Simon Geard * generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Adapted version of Simon's * doc/lrepeat.n: patch, updated to the HEAD * tests/lrepeat.test: and matching the core style. * generic/tclBasic.c (buildIntCmds): Splice into core. * generic/tclInt.h: * doc/list.n: Cross-reference. 2003-08-06 Jeff Hobbs * win/tclWinInit.c: recognize amd64 and ia32_on_win64 cpus. 2003-08-06 Don Porter * library/msgcat/msgcat.tcl: Added escape so that non-Windows * library/msgcat/pkgIndex.tcl: platforms do not try to use the registry package. This can save a costly and pointless package search. Bumped to 1.3.1. Thanks to Dave Bodenstab. [Bug 781609] 2003-08-05 Miguel Sofer * generic/tclExecute.c (INST_INVOKE, INST_EVAL, INST_PUSH_RESULT): added a Tcl_ResetResult(interp) at each point where the interp's result is pushed onto the stack, to avoid keeping an extra reference that may cause costly Tcl_Obj duplication. Detected by Franco Violi, analyzed by Peter Spjuth and Donal Fellows. [Bug 781585] 2003-07-28 Vince Darley * doc/FileSystem.3: * doc/Translate.3: better documentation of Tcl_TranslateFileName and related functions. [Bug 775220] 2003-07-24 Mo DeJong * generic/tcl.h: Revert change made on 2003-07-21 since it made the sizeof(Tcl_Obj) different for regular vs mem debug builds. * generic/tclInt.h: Define TclDecrRefCount in terms of Tcl_DbDecrRefCount which removes one layer of inderection. * generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount, (Tcl_DbDecrRefCount, Tcl_DbIsShared): Define ThreadSpecificData that contains a hashtable. The table is used to ensure that a Tcl_Obj is only acted upon in the thread that allocated it. This checking code is enabled only when mem debug and threads are enabled. 2003-07-24 Don Porter * tests/async.test: Added several tests that demonstrate [Bug * tests/basic.test: 489537], Tcl's longstanding failure to * tests/dict.test: properly quote any leading '#' character when * tests/dstring.test: generating the string rep of a list so that * tests/list.test: the comment-power of that character is hidden * tests/parse.test: from any [eval], in order to satisfy the * tests/util.test: documentation that [list] does [eval]-safe quoting. 2003-07-24 Reinhard Max * library/package.tcl: Fixed a typo that broke pkg_mkIndex -verbose. * tests/pkgMkIndex.test: Added a test for [pkg_mkIndex -verbose]. * ChangeLog.2002 (new file): * ChangeLog: broke changes from 2002 into ChangeLog.2002 to reduce size of the main ChangeLog. 2003-07-23 Daniel Steffen * unix/Makefile.in: changes to html-tcl & html-tk targets for compatibility with non-gnu makes. * unix/Makefile.in: added macosx/README to dist target. 2003-07-23 Pat Thoyts * win/tclWinReg.c (OpenSubKey): Fixed bug 775976 which causes the registry set command to fail when built with VC7. * library/reg/pkgIndex.tcl: Incremented the version to 1.1.2. 2003-07-21 Mo DeJong Check that the thread incrementing or decrementing the ref count of a Tcl_Obj is the thread that originally allocated the thread. This fail fast behavior will catch programming errors that allow a single Tcl_Obj to be accessed from multiple threads. * generic/tcl.h (Tcl_Obj): Add allocThread member to Tcl_Obj. This member records the thread id the Tcl_Obj was allocated. It is used to check that any future ref count incr or decr is done from the same thread that allocated the Tcl_Obj. This member is defined only when threads and mem debug are enabled. * generic/tclInt.h (TclNewObj, TclDbNewObj, TclDecrRefCount): Define TclNewObj and TclDbNewObj using TclDbInitNewObj when mem debug is enabled. This fixes a problem where TclNewObj calls did not work the same as TclDbNewObj when mem debug was enabled. * generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount, (Tcl_DbDecrRefCount): Add new helper to init Tcl_Obj members when mem debug is enabled. Init the allocThread member in TclDbInitNewObj and check it in Tcl_DbIncrRefCount and Tcl_DbDecrRefCount to make sure a Tcl_Obj allocated in one thread is not being acted upon in another thread. 2003-07-21 Vince Darley * test/cmdAH.test: ensure certain tests run in local filesystem. [Bug 748960] 2003-07-18 Daniel Steffen * macosx/Makefile: added option to allow installing manpages in addition to default html help. 2003-07-18 Donal K. Fellows * doc/Utf.3: Tightened up documentation of Tcl_UtfNext and Tcl_UtfPrev to better match the behaviour. [Bug 769895] 2003-07-18 Jeff Hobbs * library/http/pkgIndex.tcl: upped to http v2.4.4 * library/http/http.tcl: add support for user:pass info in URL. * tests/http.test: [Bug 759888] (shiobara) 2003-07-18 Don Porter * doc/tcltest.n: Restored the [Eval] proc to replace * library/tcltest/tcltest.tcl: the [::puts] command when either the -output or -error option for [test] is in use, in order to capture data written to the output or error channels for comparison against what is expected. This is easier to document and agrees better with most user expectations than the previous attempt to replace [puts] only in the caller's namespace. Documentation made more precise on the subject. [Bug 706359] * doc/AddErrInfo.3: Improved consistency of documentation by * doc/CrtTrace.3: using "null" everywhere to refer to the * doc/Encoding.3: character '\0', and using "NULL" everywhere * doc/Eval.3: to refer to the value of a pointer that points * doc/GetIndex.3: to nowhere. Also dropped references to ASCII * doc/Hash.3: that are no longer true, and standardized on * doc/LinkVar.3: the hyphenated spelling of "null-terminated". * doc/Macintosh.3: * doc/OpenFileChnl.3: * doc/SetVar.3: * doc/StringObj.3: * doc/Utf.3: * doc/CrtSlave.3 (Tcl_MakeSafe): Removed warning about possible deprecation (no TIP on that). 2003-07-17 Daniel Steffen * unix/tclUnixFCmd.c: fix for compilation errors on platforms where configure detects non-functional chflags(). [Bug 748946] * macosx/Makefile: Rewrote buildsystem for Mac OS X framework build to be purely make driven; in order to become independent of Apple's closed-source IDE and build tool. The changes are intended to be transparent to the Makefile user, all existing make targets and cmd line variable overrides should continue to work. Changed build to only include tcl specific html help in Tcl.framework, the tk specific html help is now included in Tk.framework. Added var to allow overriding of tclsh used during html help building (Landon Fuller). * macosx/Tcl.pbproj/project.pbxproj: * macosx/Tcl.pbproj/jingham.pbxuser: Changed to purely call through to the make driven buildsystem; Tcl.framework is no longer assembled by ProjectBuilder. Set default SYMROOT in target options to simplify setting up PB (manually setting common build folder for tcl & tk no longer needed). * tools/tcltk-man2html.tcl: Added options to allow building only the tcl or tk html help files; the default behaviour with none of the new options is to build both, as before. * unix/Makefile.in: Added targets for building only the tcl or tk help * macosx/README (new): Tcl specific excerpts of tk/macosx/README. * generic/tcl.h: Updated reminder comment about editing macosx/Tcl.pbproj/project.pbxproj when version number changes. 2003-07-16 Mumit Khan * generic/tclPathObj.c (SetFsPathFromAny): Add Cygwin specific code to convert POSIX filename to native format. * generic/tclFileName.c (Tcl_TranslateFileName): And remove from here. (TclDoGlob): Adjust for cygwin and append / for dirs instead of \ * win/tclWinFile.c (TclpObjChdir): Use chdir on Cygwin. [Patch 679315] 2003-07-16 Jeff Hobbs * library/safe.tcl (FileInAccessPath): normalize paths before comparison. [Bug 759607] (myers) * unix/tclUnixNotfy.c (NotifierThreadProc): correct size of found and word vars from int to long. [Bug 767578] (hgo) * generic/tcl.h: Add recognition of -DTCL_UTF_MAX=6 on the make * generic/regcustom.h: line to support UCS-4 mode. No config arg at this time, as it is not the recommended build mode. * generic/tclPreserve.c: In Result and Preserve'd routines, do not * generic/tclUtil.c: assume that ckfree == free, as that is not * generic/tclResult.c: always true. [Bug 756791] (fuller) 2003-07-16 Donal K. Fellows * doc/CrtSlave.3 (Tcl_MakeSafe): Updated documentation to strongly discourage use. IMHO code outside the core that uses this function is a bug... [Bug 655300] 2003-07-16 Don Porter * generic/tclFileName.c (Tcl_GlobObjCmd): [Bug 771840] * generic/tclPathObj.c (Tcl_FSConvertToPathType):[Bug 771947] * unix/tclUnixFCmd.c (GetModeFromPermString): [Bug 771949] Silence compiler warnings about unreached lines. * library/tcltest/tcltest.tcl (ProcessFlags): Corrected broken call * library/tcltest/pkgIndex.tcl: to [lrange]. Bumped to version 2.2.4. [Bug 772333] 2003-07-15 Mo DeJong * unix/dltest/pkga.c (Pkga_EqObjCmd): Fix typo that was causing a crash in load.test. 2003-07-15 Donal K. Fellows * doc/array.n: Make sure docs are synched with the 8.4 release. 2003-07-15 Don Porter * doc/http.n: Updated SYNOPSIS to match actual syntax of commands. [Bug 756112] * unix/dltest/pkga.c: Updated to not use Tcl_UtfNcmp and counted strings instead of strcmp (not defined in any #include'd header) and presumed NULL-terminated strings. * generic/tclCompCmds.c (TclCompileIfCmd): Prior fix of Bug 711371 on 2003-04-07 introduced a buffer overflow. Corrected. [Bug 771613] 2003-07-15 Kevin B. Kenny * win/rules.vc: Added a missing $(OPTDEFINES) which broke the build if STATS=memdbg was specified. 2003-07-15 Donal K. Fellows * generic/tclCmdIL.c (SortCompare): Cleared up confusing error message. [Bug 771539] 2003-07-11 Donal K. Fellows * tests/binary.test (binary-46.*): Tests to help enforce the current behaviour. * doc/binary.n: Documented that [binary format a] and [binary scan a] do encoding conversion by dropping high bytes, unlike the rest of the core. [Bug 735364] 2003-07-11 Don Porter * library/package.tcl: Corrected [pkg_mkIndex] bug reported on comp.lang.tcl. The indexer was searching for newly indexed packages instead of newly provided packages. 2003-07-08 Vince Darley * tests/winFCmd.test: fix for five tests under win98 [Bug 767679] 2003-07-07 Jeff Hobbs * doc/array.n: add examples from Welton 2003-06-23 Vince Darley * doc/file.n: clarification of 'file tail' behaviour [Bug 737977] 2003-07-04 Donal K. Fellows * doc/expr.n: Tighten up the wording of some operations. [Bug 758488] * tests/cmdAH.test: Made tests of [file mtime] work better on FAT filesystems. [Patch 760768] Also a little general cleanup. * generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept dictionaries for maps. This is much trickier than it looks, since map entry ordering is significant. [Bug 759936] * generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get] and [array set] work with dictionaries, producing them and consuming them. Note that for compatibility reasons, you will never get a dict from feeding a string literal to [array set] since that alters the trace behaviour of "multi-key" sets. [Bug 759935] 2003-06-23 Vince Darley * generic/tclTrace.c: fix to Window debug build compilation error. 2003-06-27 Don Porter * tests/init.test: Added [cleanupTests] to report results of tests * tests/pkg.test: that run in slave interps. [Bugs 761334,761344] * tests/http.test: Used more reliable path to find httpd script. 2003-06-25 Don Porter * tests/init.test: Added tests init-4.6.* to illustrate [Bug 760872] 2003-06-25 Donal K. Fellows * generic/tclTrace.c: New file, factoring out of virtually all the various trace-related things from tclBasic.c and tclCmdMZ.c with the goal of making this a separate maintenance area. 2003-06-25 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add -ieee when compiling with cc and add -mieee when compiling with gcc under OSF1-V5 "Tru64" systems. [Bug 748957] 2003-06-24 Donal K. Fellows * doc/encoding.n: Corrected the docs to say that [source] uses the system encoding, which it always did anyway (since 8.1) [Bug 742100] 2003-06-24 Donal K. Fellows * generic/tclHash.c (Tcl_HashStats): Prevented occurrence of division-by-zero problems. [Bug 759749] 2003-06-24 Mo DeJong * unix/tclUnixPort.h: #undef inet_ntoa before #define to avoid compiler warning under freebsd. [Bug 745844] 2003-06-23 Pat Thoyts * doc/dde.n: Committed TIP #135 which changes the * win/tclWinDde.c: -exact option to -force. Also cleaned a * tests/winDde.test: bug in the tests. * library/dde/pkgIndex.tcl: Incremented version to 1.2.5 * doc/dde.n: Committed TIP #120 which provides the * win/tclWinDde.c: dde package for safe interpreters. * tests/winDde.test: Incremented package version to 1.2.4 * library/dde/pkgIndex.tcl: 2003-06-23 Vince Darley * generic/tclFCmd.c: fix to bad error message when trying to do 'file copy foo ""'. [Bug 756951] * tests/fCmd.test: added two new tests for the bug. * win/tclWinFile.c: * win/tclWin32Dll.c: recommitted some filesystem globbing speed-ups, but disabled some on the older Win 95/98/ME where they don't seem to work. * doc/FileSystem.3: documentation fix [Bug 720634] 2003-06-18 Miguel Sofer * generic/tclNamesp.c (Tcl_Export): removed erroneous comments. [Bug 756744] 2003-06-17 Vince Darley * win/makefile.vc: fixes to check-in below so compilation now works again on Windows. * generic/tclCmdMZ.c: * tests/regexp.test: fixing of bugs related to regexp and regsub matching of empty strings. Addition of a number of new tests. [Bug 755335] 2003-06-16 Andreas Kupries * win/Makefile.in: Haven't heard back from David for a week. Now * win/configure: committing the remaining changes. * win/configure.in: Note: In active contact with Helmut Giese about * win/makefile.vc: the borland relatedchanges. This part will see * win/rules.vc: future updates. * win/tcl.m4: * win/makefile.bc: 2003-06-10 Andreas Kupries * generic/tclConfig.c (ASSOC_KEY): Changed the key to "tclPackageAboutDict" (tcl prefix) to make collisions with the keys of other packages more unlikely. 2003-06-10 Miguel Sofer * generic/tclBasic.c: * generic/tclExecute.c: let TclExecuteObjvInternal call TclInterpReady instead of relying on its callers to do so; fix for the part of [Bug 495830] that is new in 8.4. * tests/interp.test: Added tests 18.9 (knownbug) and 18.10 2003-06-09 Andreas Kupries * generic/tcl.decls: Ported the changes from the * generic/tcl.h: 'tip-59-implementation' branch into the CVS * generic/tclBasic.c: head. Regenerated stub table. Regenerated the * generic/tclInt.h: configure's scripts, with help from Joe English. * generic/tclDecls.h: * generic/tclStubInit.c: * generic/tclConfig.c: * generic/tclPkgConfig.c: * unix/Makefile.in: * unix/configure.in: The changes in the windows section are not yet * unix/tcl.m4: committed, they await feedback from David * unix/mkLinks: Gravereaux. * doc/RegConfig.3: * mac/tclMacPkgConfig.c: * tests/config.test: 2003-06-09 Don Porter * string.test (string-4.15): Added test for [string first] bug reported in Tcl 8.3, where test for all-single-byte-encoded strings was not reliable. 2003-06-04 Joe Mistachkin * tools/man2help.tcl: Added duplicate help section checking and * tools/index.tcl: corrected a comment typo for the getTopics proc in index.tcl. [Bug 748700] 2003-06-02 Vince Darley * win/tclWinFCmd.c: * tests/fCmd.test: fix to [Bug #747575] in which a bad error message is given when trying to rename a busy directory to one with the same prefix, but not the same name. Added three new tests. 2003-05-23 D. Richard Hipp * win/tclWinTime.c: Add tests to detect and avoid a division by zero in the windows precision timer calibration logic. 2003-05-23 Don Porter * generic/tclObj.c (tclCmdNameType): Converted internal rep management of the cmdName Tcl_ObjType the opposite way, to always use the twoPtrValue instead of always using the otherValuePtr. Previous fix on 2003-05-12 broke several extensions that wanted to poke around with the twoPtrValue.ptr2 value of a cmdName Tcl_Obj, like TclBlend and e4graph. [Bug 726018] Thanks to George Petasis for the bug report and Jacob Levy for testing assistance. 2003-05-23 Mo DeJong * unix/mkLinks: Set the var S to "" at the top of the file to avoid error when user has set S to something. [Tk Bug 739833] 2003-05-22 Daniel Steffen * macosx/Tcl.pbproj/project.pbxproj: added missing references to new source files tclPathObj.c and tclMacOSXFCmd.c. * macosx/tclMacOSXBundle.c: fixed a problem that caused only the first call to Tcl_MacOSXOpenVersionedBundleResources() for a given bundle identifier to succeed. This caused the tcl runtime library not to be found in all interps created after the inital one. 2003-05-19 Kevin B. Kenny * unix/tclUnixTime.c: Corrected a bug in conversion of non-ASCII chars in the format string. 2003-05-19 Daniel Steffen * macosx/Tcl.pbproj/project.pbxproj: changed tclConfig.sh location in versioned framework subdirectories to be identical to location in framework toplevel; fixed stub library symbolic links to be tcl version specific. * unix/tclUnixTime.c: fixed typo. 2003-05-18 Kevin Kenny * compat/strftime.c: Modified TclpStrftime to return its result in * generic/tclClock.c: UTF-8 encoding, and removed the conversion from * mac/tclMacTime.c: system encoding to UTF-8 from [clock format]. * unix/tclUnixTime.c: Needed to avoid double conversion of the * win/tclWinTime.c: timezone name on Windows systems. [Bug 624408] 2003-05-16 Pat Thoyts * library/dde/pkgIndex.tcl: Applied TIP #130 which provides for * tests/winDde.test: unique dde server names. Added some more * win/tclWinDde.c: tests. Fixes [Bug 219293] * doc/dde.n: Updated documentation re TIP #130. * tests/winDde.test: Applied patch for [Bug 738929] by KKB and changed to new-style tests. 2003-05-16 Kevin B. Kenny * unix/Makefile.in: Removed one excess source file tclDToA.c 2003-05-16 Daniel Steffen * macosx/Tcl.pbproj/project.pbxproj: updated copyright year. 2003-05-15 Kevin B. Kenny * generic/tclGetDate.y: added further hackery to the yacc * generic/tclDate.c: post-processing to arrange for the code to set * unix/Makefile.in: up exit handlers to free the stacks. [Bug 736425] 2003-05-15 Jeff Hobbs * win/tclWinFile.c (TclpMatchInDirectory): revert glob code to r1.44 as 2003-04-11 optimizations broke Windows98 glob'ing. * doc/socket.n: nroff font handling correction * library/encoding/gb2312-raw.enc (new): This is the original gb2312.enc renamed to allow for it to still be used. This is needed by Tk (unix) because X fonts with gb2312* charsets really do want the original gb2312 encoding. [Bug 557030] 2003-05-14 Donal K. Fellows * generic/tclCmdAH.c (Tcl_FormatObjCmd): Stop unwarranted demotion of wide values to longs by formatting of int values. [Bug 699060] 2003-05-14 Jeff Hobbs * library/encoding/gb2312.enc: copy euc-cn.enc over original gb2312.enc. gb2312.enc appeared to not work as expected, and most uses of gb2312 really mean euc-cn (which may be the cause of the problem). [Bug 557030] 2003-05-14 Daniel Steffen Implementation of TIP 118: * generic/tclFCmd.c (TclFileAttrsCmd): return the list of attributes that can be retrieved without error for a given file, instead of aborting the whole command when any error occurs. * unix/tclUnixFCmd.c: added support for new file attributes and for copying Mac OS X file attributes & resource fork during [file copy]. * generic/tclInt.decls: added declarations of new external commands needed by new file attributes support in tclUnixFCmd.c. * macosx/tclMacOSXFCmd.c (new): Mac OS X specific implementation of new file attributes and of attribute & resource fork copying. * mac/tclMacFCmd.c: added implementation of -rsrclength attribute & fixes to other attributes for consistency with OSX implementation. * mac/tclMacResource.c: fixes to OSType handling. * doc/file.n: documentation of [file attributes] changes. * unix/configure.in: check for APIs needed by new file attributes. * unix/Makefile.in: * unix/tcl.m4: added new platform specifc tclMacOSXFCmd.c source. * unix/configure: * generic/tclStubInit.c: * generic/tclIntPlatDecls.h: regen. * tools/genStubs.tcl: fixes to completely broken code trying to prevent overlap of "aqua", "macosx", "x11" and "unix" stub entries. * tests/unixFCmd.test: added tests of -readonly attribute. * tests/macOSXFCmd.test (new): tests of macosx file attributes and of preservation of attributes & resource fork during [file copy]. * tests/macFCmd.test: restore -readonly attribute of test dir, as otherwise its removal can fail on unices supporting -readonly. 2003-05-13 David Gravereaux * generic/tclEnv.c: Another putenv() copy behavior problem repaired when compiling on windows and using microsoft's runtime. [Bug 736421] 2003-05-13 Jeff Hobbs * generic/tclIOUtil.c: ensure cd is thread-safe. [Bug 710642] (vasiljevic) 2003-05-13 Donal K. Fellows * generic/tclEvent.c (Tcl_Finalize): Removed unused variable to reduce compiler warnings. [Bug 664745] 2003-05-13 Joe Mistachkin * generic/tcl.decls: Changed Tcl_JoinThread parameter name from * generic/tclDecls.h: "id" to "threadId". [Bug 732477] * unix/tclUnixThrd.c: * win/tclWinThrd.c: * mac/tclMacThrd.c: 2003-05-13 Daniel Steffen * generic/tcl.decls: * macosx/tclMacOSXBundle.c: added extended version of the Tcl_MacOSXOpenBundleResources() API taking an extra version number argument: Tcl_MacOSXOpenVersionedBundleResources(). This is needed to be able to access bundle resources in versioned frameworks such as Tcl and Tk, otherwise if multiple versions were installed, only the latest version's resources could be accessed. [Bug 736774] * unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): use new versioned bundle resource API to get tcl runtime library for TCL_VERSION. [Bug 736774] * generic/tclPlatDecls.h: * generic/tclStubInit.c: regen. * unix/tclUnixPort.h: worked around the issue of realpath() not being thread-safe on Mac OS X by defining NO_REALPATH for threaded builds on Mac OS X. [Bug 711232] 2003-05-12 Donal K. Fellows * tests/cmdAH.test: General clean-up of tests so that all tcltest-specific commands are protected by constraints and all platforms see the same number of tests. [Bug 736431] 2003-05-12 Don Porter * generic/tclInterp.c: (AliasObjCmd): Added refCounting of the words * tests/interp.test (interp-33.1): of the target of an interp alias during its execution. Also added test. [Bug 730244] * generic/tclBasic.c (TclInvokeObjectCommand): objv[argc] is no longer set to NULL (Tcl_CreateObjCommand docs already say that it should not be accessed). * tests/cmdMZ.test: Forgot to import [temporaryDirectory]. * generic/tclObj.c (tclCmdNameType): Corrected variable use of the otherValuePtr or the twoPtrValue.ptr1 fields to store a (ResolvedCmdName *) as the internal rep. [Bug 726018] * doc/Eval.3: Corrected prototype for Tcl_GlobalEvalObj [Bug 727622]. 2003-05-12 Miguel Sofer * generic/tclVar.c (TclObjLookupVar): [Bug 735335] temporary fix, disabling usage of tclNsVarNameType. * tests/var.test (var-15.1): test for [Bug 735335] 2003-05-10 Jeff Hobbs * win/tclWinSerial.c (SerialCloseProc): correct mem leak on closing a Windows serial port [Bug 718002] (schroedter) * generic/tclCmdMZ.c (Tcl_StringObjCmd): prevent string repeat crash when overflow sizes were given (throws error). [Bug 714106] 2003-05-09 Joe Mistachkin * generic/tclThreadAlloc.c (TclFreeAllocCache): Fixed memory leak caused by treating cachePtr as a TLS index. [Bug 731754] * win/tclAppInit.c (Tcl_AppInit): Fixed memory leaks caused by not freeing the memory allocated by setargv and the async handler created by Tcl_AppInit. An exit handler has been created that takes care of both leaks. In addition, Tcl_AppInit now uses ckalloc instead of Tcl_Alloc to allow for easier leak tracking and to be more consistent with the rest of the Tcl core. [Bugs 733156, 733221] * tools/encoding/txt2enc.c (main): Fixed memory leak caused by failing to free the memory used by the toUnicode array of strings [Bug 733221] 2003-05-09 Miguel Sofer * generic/tclCompile.c (TclCompileScript): * tests/compile.test (compile-3.5): corrected wrong test and behaviour in the earlier fix for [Bug 705406]; Don Porter reported this as [Bug 735055], and provided the solution. 2003-05-09 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_ReturnObjCmd): The array of strings passed to Tcl_GetIndexFromObj must be NULL terminated. [Bug 735186] Thanks to Joe Mistachkin for spotting this. 2003-05-07 Donal K. Fellows * doc/trace.n: Fixed very strange language in the documentation for 'trace add execution'. [Bug 729821] * generic/tclCmdMZ.c (Tcl_TraceObjCmd): Made error message for 'trace info' more consistent with documentation. [Bug 706961] * generic/tclDictObj.c (DictInfoCmd): Fixed memory leak caused by confusion about string ownership. [Bug 731706] 2003-05-05 Don Porter * generic/tclBasic.c: Implementation of TIP 90, which * generic/tclCmdAH.c: extends the [catch] and [return] * generic/tclCompCmds.c: commands to enable creation of a * generic/tclExecute.c: proc that is a replacement for * generic/tclInt.h: [return]. [Patch 531640] * generic/tclProc.c: * generic/tclResult.c: * tests/cmdAH.test: * tests/cmdMZ.test: * tests/error.test: * tests/proc-old.test: * library/tcltest/tcltest.tcl: The -returnCodes option to [test] failed to recognize the symbolic name "ok" for return code 0. 2003-05-05 Donal K. Fellows * generic/tclBasic.c (Tcl_HideCommand): Fixed error message for grammar and spelling. 2003-04-28 Donal K. Fellows * generic/tclDictObj.c (DictIncrCmd): Updated to reflect the behaviour with wide increments of the normal [incr] command. * generic/tclInt.decls: Added TclIncrWideVar2 to internal stub table and cleaned up. * tests/incr.test (incr-3.*): * generic/tclVar.c (TclIncrWideVar2, TclPtrIncrWideVar): * generic/tclExecute.c (TclExecuteByteCode): * generic/tclCmdIL.c (Tcl_IncrObjCmd): Make [incr] work when trying to increment by wide values. [Bug 728838] * generic/tclCompCmds.c (TclCompileSwitchCmd): Default mode of operation of [switch] is exact matching. [Bug 727563] 2003-04-25 Don Porter * generic/tclBasic.c: Tcl_EvalObjv() failed to honor the TCL_EVAL_GLOBAL flag when resolving command names. Tcl_EvalEx passed a string rep including leading whitespace and comments to TclEvalObjvInternal(). 2003-04-25 Andreas Kupries * win/tclWinThrd.c: Applied SF patch #727271. This patch changes the code to catch any errors returned by the windows functions handling TLS ASAP instead of waiting to get some mysterious crash later on due to bogus pointers. Patch provided by Joe Mistachkin. This is a stop-gap measure to deal with the low number of ?TLS slots provided by some of the variants of Windows (60-80). 2003-04-24 Vince Darley * generic/tclFileName.c: fix to bug reported privately by Jeff where, for example, 'glob -path {[tcl]} *' gets confused by the leading special character (which is escaped internally), and instead lists files in '/'. Bug only occurs on Windows where '\' is also a directory separator. * tests/fileName.test: added test for the above bug. 2003-04-22 Andreas Kupries * The changes below fix SF bugs [593810], and [718045]. * generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel): Invoke TclpCutSockChannel and TclpSpliceSockChannel. * generic/tclInt.h: Declare TclpCutSockChannel and TclpSpliceSockChannel. * unix/tclUnixSock.c (TclpCutSockChannel, TclpSpliceSockChannel): Dummy functions, on unix the sockets are _not_ handled specially. * mac/tclMacSock.c (TclpCutSockChannel, TclpSpliceSockChannel): * win/tclWinSock.c (TclpCutSockChannel, TclpSpliceSockChannel): New functions to handle socket specific cut/splice operations: auto-init of socket system for thread on splice, management of the module internal per-thread list of sockets, management of association of sockets with HWNDs for event notification. * win/tclWinSock.c (NewSocketInfo): Extended initialization assignments to cover all items of the structure. During debugging of the new code mentioned above I found that two fileds could contain bogus data. * win/tclWinFile.c: Added #undef HAVE_NO_FINDEX_ENUMS before definition because when compiling in debug mode the compiler complains about a redefinition, and this warning is also treated as an error. 2003-04-21 Don Porter * library/tcltest/tcltest.tcl: When the return code of a test does not meet expectations, report that as the reason for test failure, and do not attempt to check the test result for correctness. [Bug 725253] 2003-04-18 Jeff Hobbs * win/tclWinInt.h (VER_PLATFORM_WIN32_CE): conditionally define. * win/tclWinInit.c: recognize Windows CE as a Win platform. This just recognizes CE - full support will come later. * win/configure: regen * win/configure.in (SHELL): force it to /bin/sh as autoconf 2.5x uses /bin/bash, which can fail to find exes in the path (ie: lib). * generic/tclExecute.c (ExprCallMathFunc): remove incorrect extraneous cast from Tcl_WideAsDouble. 2003-04-18 Donal K. Fellows * doc/open.n: Moved serial port options from [fconfigure] to * doc/fconfigure.n: [open] as it is up to the creator of a channel to describe the channel's special config options. [Bug 679010] 2003-04-16 Don Porter * generic/tcl.h: Made changes so that the "wideInt" Tcl_ObjType * generic/tclObj.c: is defined on all platforms, even those where * generic/tclPort.h: TCL_WIDE_INT_IS_LONG is defined. Also made the Tcl_Value struct have a wideValue field on all platforms. This is a ***POTENTIAL INCOMPATIBILITY*** for TCL_WIDE_INT_IS_LONG platforms because that struct changes size. This is the same TIP 72 incompatibility that was seen on other platforms at the 8.4.0 release, when this change should have happened as well. [Bug 713562] * generic/tclInt.h: New internal macros TclGetWide() and TclGetLongFromWide() to deal with both forms of the "wideInt" Tcl_ObjType, so that conditional TCL_WIDE_INT_IS_LONG code is confined to the header file. * generic/tclCmdAH.c: Replaced most coding that was conditional * generic/tclCmdIL.c: on TCL_WIDE_INT_IS_LONG with code that * generic/tclExecute.c: works across platforms, sometimes using * generic/tclTest.c: the new macros above to do it. * generic/tclUtil.c: * generic/tclVar.c: 2003-04-17 Donal K. Fellows * doc/socket.n: Added a paragraph to remind people to specify their encodings when using sockets. [Bug 630621] 2003-04-16 Donal K. Fellows * doc/CrtMathFnc.3: Functions also have to deal with wide ints, but this was not documented. [Bug 709720] 2003-04-16 Vince Darley * generic/tclPathObj.c: removed undesired 'static' for function which is now shared (previously it was duplicated). 2003-04-15 Joe English * doc/namespace.n: added example section "SCOPED SCRIPTS", supplied by Kevin Kenny. [Bug 219183] 2003-04-15 Kevin Kenny * makefile.vc: Updated makefile.vc to conform with Mo DeJong's changes to Makefile.in and tclWinPipe.c on 2003-04-14. Now passes TCL_PIPE_DLL in place of TCL_DBGX. * win/tclWinTime.c: Corrected use of types to make compilation compatible with VC++5. 2003-04-15 Vince Darley * generic/tclIOUtil.c: finished check-in from yesterday, removing duplicate function definition. 2003-04-14 Don Porter * generic/tclClock.c: Corrected compiler warnings. * generic/tclTest.c: 2003-04-14 Mo DeJong * win/Makefile.in: Don't define TCL_DBGX symbol for every compile. Instead, define TCL_PIPE_DLL only when compiling tclWinPipe.c. This will break other build systems, so they will need to remove the TCL_DBGX define and replace it with a define for TCL_PIPE_DLL. * win/tclWinPipe.c (TclpCreateProcess): Remove PREFIX_IDENT and DEBUG_IDENT from top of file. Use TCL_PIPE_DLL passed in from build env instead of trying to construct the dll name from already defined symbols. This approach is more flexible and better in the long run. 2003-04-14 Kevin Kenny * win/tclWinFile.c: added conditionals to restore compilation on VC++6, which was broken by recent changes. 2003-04-14 Vince Darley * generic/tclIOUtil.c: * generic/tclPathObj.c: * generic/tclFileSystem.h: overlooked one function which was duplicated, so this is now shared between modules. * win/tclWinFile.c: allow this file to compile with VC++ 5.2 again since Mingw build fixes broke that. 2003-04-13 Mo DeJong * win/configure: Regen. * win/configure.in: Add check for FINDEX_INFO_LEVELS from winbase.h, known to be a problem in VC++ 5.2. Define HAVE_NO_FINDEX_ENUMS if the define does not exist. * win/tclWinFile.c: Put declarations for FINDEX_INFO_LEVELS and FINDEX_SEARCH_OPS inside a check for HAVE_NO_FINDEX_ENUMS so that these are not declared twice. This fixes the Mingw build. * win/tclWinTime.c: Rework the init of timeInfo so that the number or initializers matches the declaration. This was broken under Mingw. Add cast to avoid compile warning when calling the AccumulateSample function. 2003-04-12 Jeff Hobbs * win/Makefile.in (GENERIC_OBJS): add missing tclPathObj.c 2003-04-12 Kevin Kenny * doc/clock.n: * generic/tclClock.c (Tcl_ClockObjCmd): * tests/clock.test: Implementation of TIP #124. Also renumbered test cases to avoid duplicates. [Bug 710310] * tests/winTime.test: * win/tclWinTest.c (TestwinclockCmd, TestwinsleepCmd): * win/tclWinTime.c (Tcl_WinTime, UpdateTimeEachSecond, (ResetCounterSamples, AccumulateSample, SAMPLES, TimeInfo): Made substantial changes to the phase-locked loop (replaced an IIR filter with an FIR one) in a quest for improved loop stability (Bug not logged at SF, but cited in private communication from Jeff Hobbs). 2003-04-11 Don Porter * generic/tclCmdMZ.c (Tcl_StringObjCmd,STR_IS_INT): Corrected inconsistent results of [string is integer] observed on systems where sizeof(long) != sizeof(int). [Bug 718878] * tests/string.test: Added tests for Bug 718878. * doc/string.n: Clarified that [string is integer] accepts 32-bit integers. 2003-04-11 Andreas Kupries * generic/tclIO.c (UpdateInterest): When dropping interest in TCL_READABLE now dropping interest in TCL_EXCEPTION too. This fixes a bug where Expect detects eof on a file prematurely on solaris 2.6 and higher. A much more complete explanation is in the code itself (40 lines of comments for a one-line change :) 2003-04-11 Vince Darley * tests/cmdAH.test: fix test suite problem if /home is a symlink. [Bug 703264] * generic/tclIOUtil.c: fix bad error message with 'cd ""'. [Bug 704917] * win/tclWinFile.c, win/tclWin32Dll.c: * win/tclWinInt.h: allow Tcl to differentiate between reparse points which are symlinks and mounted volumes, and correctly handle the latter. This involves some elaborate code to find the actual drive letter (if possible) corresponding to a mounted volume. [Bug 697862] * tests/fileSystem.test: add constraints to stop tests running in ordinary tcl interpreter. [Bug 705675] * generic/tclIOUtil.c: * generic/tclPathObj.c: (new file) * generic/tclFileSystem.h: (new file) * win/makefile.vc: Split path object handling out of the virtual filesystem layer, into tclPathObj.c. This refactoring cleans up the internal filesystem code, and will make any future optimisations and forthcoming better thread-safety much easier. * generic/tclTest.c: * tests/reg.test: added some 'knownBug' tests for problems in Tcl's regexp code with the TCL_REG_CAN_MATCH flag (see Bug 703709). Code too impenetrable to fix right now, but a fix is needed for tip113 to work correctly. * tests/fCmd.test * win/tclWinFile.c: added some filesystem optimisation to the 'glob' implementation, and some new tests. * generic/tclCmdMZ.c: fix typo in comment * tests/winFile.test: * tests/ioUtil.test: * tests/unixFCmd.test: renumbered tests with duplicate numbers. [Bug 710361] 2003-04-10 Donal K. Fellows * doc/binary.n: Fixed typo in [binary format w] desc. [Bug 718543] 2003-04-08 Donal K. Fellows * generic/tclCmdAH.c (Tcl_ErrorObjCmd): Strings are only empty if they have zero length, not if their first byte is zero, so fix test guarding Tcl_AddObjErrorInfo to take this into account. [Bug reported by Don Porter; no bug-id.] 2003-04-07 Don Porter * generic/tclCompCmds.c (TclCompileIfCmd): Corrected string limits of arguments interpolated in error messages. [Bug 711371] * generic/tclCmdMZ.c (TraceExecutionProc): Added missing Tcl_DiscardResult() call to avoid memory leak. 2003-04-07 Donal K. Fellows * generic/tclDictObj.c (Tcl_DictObjCmd): Stopped compilers from moaning about switch fall-through. [Bug 716327] (DictFilterCmd): Yet more warning killing, this time reported by Miguel Sofer by private chat. 2003-04-07 Donal K. Fellows * tests/dict.test (dict-2.6): * generic/tclDictObj.c (Tcl_NewDictObj, Tcl_DbNewDictObj): Oops! Failed to fully initialise the Dict structure. (DictIncrCmd): Moved valueAlreadyInDictionary label to stop compiler complaints. [Bug 715751] * generic/tclDictObj.c (DictIncrCmd): Followed style in the rest of the core by commenting out wide-specific operations on platforms where wides are longs, and used longs more thoroughly than ints through [dict incr] anyway to forestall further bugs. * generic/tclObj.c: Made sure there's always a tclWideIntType implementation available, not that it is always useful. [Bug 713562] 2003-04-05 Donal K. Fellows * generic/tclDictObj.c: Removed commented out notes on declarations to be moved to elsewhere in the Tcl core. * generic/tclInt.h: Final stages of plumbing in. * generic/tclBasic.c: * generic/tclObj.c (TclInitObjSubsystem): * unix/Makefile.in, win/Makefile.in, win/makefile.[bv]c: Build support. * generic/tcl.decls: Added dict public API to stubs table. * generic/tcl.h (Tcl_DictSearch): Added declaration of structure to allow user code to iterate over dictionaries. * doc/DictObj.3: New files containing dictionary implementation * doc/dict.n: documentation and tests as as mandated by TIP * generic/tclDictObj.c: #111. * tests/dict.test: 2003-04-03 Mo DeJong * unix/configure: * unix/tcl.m4 (SC_CONFIG_CFLAGS): Don't set TCL_LIBS if it is already set to support use of TCL_LIBS var from tclConfig.sh in the Tk configure script. 2003-04-03 Mo DeJong * unix/Makefile.in: Don't subst MATH_LIBS, LIBS, and DL_LIBS separately. Instead, just subst TCL_LIBS since it includes the others. * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS, SC_TCL_LINK_LIBS): Set and subst TCL_LIBS in SC_CONFIG_CFLAGS instead of SC_TCL_LINK_LIBS. Don't subst MATH_LIBS since it is now covered by TCL_LIBS. * unix/tclConfig.sh.in: Use TCL_LIBS instead of DL_LIBS, LIBS, and MATH_LIBS. * unix/dltest/Makefile.in: Ditto. 2003-04-03 Don Porter * generic/tclCompCmds.c (TclCompileReturnCmd): Now that [return] compiles to INST_RETURN, it is safe to compile even outside a proc. 2003-04-02 Mo DeJong * win/configure: Regen. * win/configure.in: Set stub lib flag based on new LIBFLAGSUFFIX variable. * win/tcl.m4 (SC_CONFIG_CFLAGS): Set new LIBFLAGSUFFIX that works like LIBSUFFIX, it is used when creating library names. The previous implementation would generate -ltclstub85 instead of -ltclstub85s when configured with --disable-shared. 2003-04-02 Don Porter * generic/tclParse.c (TclSubstTokens): Moved declaration of utfCharBytes to beginning of procedure so that it does not go out of scope (get free()d) while append is still pointing to it. [Bugs 703167, 713754] 2003-04-01 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Check for inet_ntoa in -lbind inside the BeOS block since doing it later broke the build under SuSE 7.3. [Bug 713128] 2003-04-01 Don Porter * tests/README: Direct [source] of *.test files is no longer recommended. The tests/*.test files should only be evaluated under the control of the [runAllTests] command in tests/all.tcl. * generic/tclExecute.c (INST_RETURN): Bytecompiled [return] failed to reset iPtr->returnCode, causing tests parse-18.17 and parse-18.21 to fail strangely. * tests/parse.test (parse-18.21): Corrected now functioning test. Added further coverage tests. 2003-03-31 Don Porter * tests/parse.test (parse-18.*): Coverage tests for the new implementation of Tcl_SubstObj(). Note that tests parse-18.17 and parse-18.21 demonstrate some bugs left to fix in the current code. 2003-03-27 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Use -Wl,--export-dynamic instead of -rdynamic for LDFLAGS. The -rdynamic is not documented so it seems better to pass the --export-dynamic flag to the linker. [Patch 573395] 2003-03-27 Miguel Sofer * tests/encoding.test: * tests/proc-old.test: * tests/set-old.test: Altered test numers to eliminate duplicates, [Bugs 710313, 710320, 710352] 2003-03-27 Donal K. Fellows * tests/parseOld.test: Altered test numers to eliminate duplicates. * tests/parse.test: [Bugs 710365, 710369] * tests/expr-old.test: * tests/expr.test: * tests/utf.test: Altered test numers to eliminate duplicates. * tests/trace.test: [Bugs 710322, 710327, 710349, 710363] * tests/lsearch.test: * tests/list.test: * tests/info.test: * tests/incr-old.test: * tests/if-old.test: * tests/format.test: * tests/foreach.test: 2003-03-26 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS, SC_TCL_LINK_LIBS): Add BeOS system to SC_CONFIG_CFLAGS. Check for inet_ntoa in -lbind, needed for BeOS. 2003-03-26 Don Porter * doc/tcltest.n: * library/tcltest/tcltest.tcl: Added reporting during [configure -debug 1] operations to warn about multiple uses of the same test name. [FRQ 576693] * tests/msgcat.test (msgcat-2.2.1): changed test name to avoid duplication. [Bug 710356] * unix/dltest/pkg?.c: Changed all Tcl_InitStubs calls to pass argument exact = 0, so that rebuilds are not required when Tcl bumps to a new version. [Bug 701926] 2003-03-24 Miguel Sofer * generic/tclVar.c: * tests/var.test: fixing ObjMakeUpvar's lookup algorithm for the created local variable. [Bug 631741] (Chris Darroch) and [Bug 696893] (David Hilker) 2003-03-24 Pat Thoyts * library/dde/pkgIndex.tcl: bumped version to 1.2.2 in tclWinDde.c, now adding here too. 2003-03-22 Kevin Kenny * library/dde/pkgIndex.tcl: * library/reg/pkgIndex.tcl: Fixed a bug where [package require dde] or [package require registry] attempted to load the release version of the DLL into a debug build. [Bug 708218] Thanks to Joe Mistachkin for the patch. * win/makefile.vc: Added quoting around the script name in the 'test' target; Joe Mistachkin insists that he has a configuration that fails to launch tcltest without it, and it appears harmless otherwise. 2003-03-22 Pat Thoyts * win/tclWinDde.c: Make dde services conform the the documentation such that giving only a topic name really returns all services with that topic. [Bug 219155] Prevent hangup caused by dde server applications failing to process messages. [Bug 707822] * tests/winDde.test: Corrected labels and added a test for search by topic name. 2003-03-20 Don Porter * generic/tclInt.h (tclOriginalNotifier): * generic/tclStubInit.c (tclOriginalNotifier): * mac/tclMacNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): * unix/tclUnixNotfy.c (Tcl_SetTimer,Tcl_WaitForEvent, (Tcl_CreateFileHandler,Tcl_DeleteFileHandler): * win/tclWinNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): Some linkers apparently use a different representation for a pointer to a function within the same compilation unit and a pointer to a function in a different compilation unit. This causes checks like those in the original notifier procedures to fall into infinite loops. The fix is to store pointers to the original notifier procedures in a struct defined in the same compilation unit as the stubs tables, and compare against those values. [Bug 707174] * generic/tclInt.h: Removed definition of ParseValue struct that is no longer used. 2003-03-19 Miguel Sofer * generic/tclCompile.c: * tests/compile.test: bad command count on TCL_OUT_LINE_COMPILE. [Bug 705406] (Don Porter) 2003-03-19 Don Porter * library/auto.tcl: Replaced [regexp] and [regsub] with * library/history.tcl: [string map] where possible. Thanks * library/ldAout.tcl: to David Welton. [Bugs 667456,667558] * library/safe.tcl: Bumped to http 2.4.3, opt 0.4.5, and * library/http/http.tcl: tcltest 2.2.3. * library/http/pkgIndex.tcl: * library/opt/optparse.tcl: * library/opt/pkgIndex.tcl: * library/tcltest/tcltest.tcl: * library/tcltest/pkgIndex.tcl: * tools/genStubs.tcl: * tools/tcltk-man2html.tcl: * unix/mkLinks.tcl: * doc/Eval.3 (Tcl_EvalObjEx): Corrected CONST and * doc/ParseCmd.3 (Tcl_EvalTokensStandard): return type errors in documentation. [Bug 683994] * generic/tclCompCmds.c (TclCompileReturnCmd): Alternative fix for * generic/tclCompile.c (INST_RETURN): [Bug 633204] that uses a new * generic/tclCompile.h (INST_RETURN): bytecode INST_RETURN to * generic/tclExecute.c (INST_RETURN): properly bytecode the [return] command to something that returns TCL_RETURN. 2003-03-18 Mo DeJong * win/configure: Regen. * win/configure.in: Don't run the AC_CYGWIN macro since it uses AC_CANONICAL_HOST under autoconf 2.5X. Just check to see if __CYGWIN__ is defined by the compiler and set the ac_cv_cygwin variable based on that. [Bug 705912] 2003-03-18 Kevin Kenny * tests/registry.test: Changed the conditionals to avoid an abort if [testlocale] is missing, as when running the test in tclsh rather than tcltest. [Bug 705677] 2003-03-18 Daniel Steffen * tools/tcltk-man2html.tcl: added support for building 'make html' from inside distribution directories named with 8.x.x version numbers. tcltk-man2html now uses the latest tcl8.x.x resp. tk8.x.x directories found inside its --srcdir argument. 2003-03-17 Mo DeJong * tests/format.test: Renumber tests, a bunch of tests all had the same id. 2003-03-17 Donal K. Fellows * doc/lsearch.n: Altered documentation of -ascii options so * doc/lsort.n: they don't specify that they operate on ASCII strings, which they never did anyway. [Bug 703807] 2003-03-14 Donal K. Fellows * generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier that indicates we've got a wide int when we're formatting in an integer style. Stops some libc's from going mad. [Bug 702622] Also tidied whitespace. 2003-03-13 Mo DeJong * win/tcl.m4 (SC_WITH_TCL): Port version number fix that was made in tk instead of tcl sources. 2003-03-13 Mo DeJong Require autoconf 2.57 or newer, see TIP 34 for a detailed explanation of why this is good. This will no doubt break the build on some platforms, let the flaming begin. * tools/configure: Regen with autoconf 2.57. * tools/configure.in: Require autoconf 2.57. * unix/configure: Regen with autoconf 2.57. * unix/configure.in: Require autoconf 2.57. Apply AC_LIBOBJ changes from patch 529884. * unix/tcl.m4: Ditto. * win/configure: Regen with autoconf 2.57. * win/configure.in: Require autoconf 2.57. Don't subst LIBOBJS since this happens by default, this avoids an autoconf error. 2003-03-12 Don Porter * generic/tclBasic.c (Tcl_EvalTokensStandard): * generic/tclCmdMZ.c (Tcl_SubstObj): * generic/tclCompCmds.c (TclCompileSwitchCmd): * generic/tclCompExpr.c (CompileSubExpr): * generic/tclCompile.c (TclSetByteCodeFromAny,TclCompileScript, (TclCompileTokens,TclCompileCmdWord): * generic/tclCompile.h (TclCompileScript): * generic/tclExecute.c (TclCompEvalObj): * generic/tclInt.h (Interp,TCL_BRACKET_TERM,TclSubstTokens): * generic/tclParse.c (ParseTokens,Tcl_SubstObj,TclSubstTokens): * tests/subst.test (2.4, 8.7, 8.8, 11.4, 11.5): Substantial refactoring of Tcl_SubstObj to make use of the same parsing and substitution procedures as normal script evaluation. Tcl_SubstObj() moved to tclParse.c. New routine TclSubstTokens() created in tclParse.c which implements all substantial functioning of Tcl_EvalTokensStandard(). TclCompileScript() loses its "nested" argument, the Tcl_Interp struct loses its termOffset field and the TCL_BRACKET_TERM flag in the evalFlags field, all of which were only used (indirectly) by Tcl_SubstObj(). Tests subst-8.7,8.8,11.4,11.5 modified to accomodate the only behavior change: reporting of parse errors now takes precedence over [return] and [continue] exceptions. All other behavior should remain compatible. [RFE 536831,684982] [Bug 685106] * generic/tcl.h: Removed TCL_PREFIX_IDENT and TCL_DEBUG_IDENT * win/tclWinPipe.c: from tcl.h -- they are not part of Tcl's public interface. Put them in win/tclWinPipe.c where they are used. * generic/tclInterp.c (Tcl_InterpObjCmd): Corrected and added * tests/interp.test (interp-2.13): test for option parsing beyond objc for [interp create --]. Thanks to Marco Maggi. [Bug 702383] 2003-03-11 Kevin Kenny * win/makefile.vc: Added two missing uses of $(DBGX) so that tclpip8x.dll loads without panicking on Win9x. 2003-03-09 Kevin Kenny * generic/tclTest.c (TestChannelCmd): Removed an unused local variable that caused compilation problems on some platforms. 2003-03-08 Don Porter * doc/tcltest.n: Added missing "-body" to example. Thanks to Helmut Giese. [Bug 700011] 2003-03-07 Mo DeJong * tests/io.test: * tests/ioCmd.test: Define a fcopy constraint and add it to the constraint list of any test that depends on the fcopy command. This is only useful to Jacl which does not support fcopy. 2003-03-07 Mo DeJong * tests/encoding.test: Name temp files *.tcltestout instead of *.out so that when they are removed later, we don't accidently toast any files named *.out that the user has created in the build directory. 2003-03-07 Donal K. Fellows * generic/tclCmdAH.c (Tcl_FileObjCmd): Fix the setting of a file's mtime and atime on 64-bit platforms. [Bug 698146] 2003-03-06 Mo DeJong * tests/io.test: Doh! Undo accidental commenting out of a couple of tests. 2003-03-06 Mo DeJong * tests/io.test: Define a fileevent constraint and add it to the constraint list of any test that depends on the fileevent command. This is only useful to Jacl which does not support fileevent. 2003-03-06 Mo DeJong * tests/io.test: Define an openpipe constraint and add it to the constraint list of any test that creates a pipe using the open command. This is only useful to Jacl which does not support pipes. 2003-03-06 Don Porter * generic/TclUtf.c (Tcl_UniCharNcasecmp): Corrected failure to * tests/utf.test (utf-25.*): properly compare Unicode strings of different case in a case insensitive manner. [Bug 699042] 2003-03-06 Kevin Kenny * generic/tclCompCmds.c (TclCompileSwitchCmd): Replaced a non-portable 'bzero' with a portable 'memset'. [Bug 698442] 2003-03-06 Mo DeJong * generic/tclIO.c (Tcl_Seek, Tcl_OutputBuffered): If there is data buffered in the statePtr->curOutPtr member then set the BUFFER_READY flag in Tcl_Seek. This is needed so that the next call to FlushChannel will write any buffered bytes before doing the seek. The existing code would set the BUFFER_READY flag inside the Tcl_OutputBuffered function. This was a programming error made when Tcl_OutputBuffered was originally created in CVS revision 1.35. The setting of the BUFFER_READY flag should not have been included in the Tcl_OutputBuffered function. * generic/tclTest.c (TestChannelCmd): Use the Tcl_InputBuffered and Tcl_OutputBuffered util methods to query the amount of buffered input and output. 2003-03-06 Mo DeJong * generic/tclIO.c (Tcl_Flush): Compare the nextAdded member of the ChannelBuffer to the nextRemoved member to determine if any output has been buffered. The previous check against the value 0 seems to have just been a coding error. See other methods like Tcl_OutputBuffered for examples where nextAdded is compared to nextRemoved to find the number of bytes buffered. 2003-03-06 Mo DeJong * generic/tclIO.c (Tcl_GetsObj): Check that the eol pointer has not gone past the end of the string when in auto translation mode and the INPUT_SAW_CR flag is set. The previous code worked because the end of string value \0 was being compared to \n, this patch just skips that pointless check. 2003-03-06 Mo DeJong * generic/tclIO.c (WriteBytes, WriteChars, Tcl_GetsObj, ReadBytes): Rework calls to TranslateOutputEOL to make it clear that a boolean value is being returned. Add some comments in an effort to make the code more clear. This patch makes no functional changes. 2003-03-06 Mo DeJong * generic/tclIO.c (Tcl_SetChannelOption): Invoke the Tcl_SetChannelBufferSize method as a result of changing the -buffersize option to fconfigure. The previous implementation used some inlined code that reset the buffer size to the default size instead of ignoring the request as implemented in Tcl_SetChannelBufferSize. * tests/io.test: Update test case so that it actually checks the implementation of Tcl_SetChannelBufferSize. 2003-03-05 David Gravereaux * win/rules.vc: updated default tcl version to 8.5. 2003-03-05 Donal K. Fellows * generic/tclCompCmds.c (TclCompileSwitchCmd): First attempt at a bytecode-compiled switch command. It only handles the most common case of switching, but that should be enough for this to speed up a lot of people's code. It is expected that the speed gains come from two things: better handling of the switch itself, and integrated compilation of the arms instead of embedding separate bytecode sequences (i.e. better local variable handling.) * tests/switch.test (switch-10.*): Tests of both uncompiled and compiled switch behaviour. [Patch #644819] * generic/tclCompile.h (TclFixupForwardJumpToHere): Additional macro to make the most common kind of jump fixup a bit easier. 2003-03-04 Don Porter * README: Bumped version number of * generic/tcl.h: Tcl to 8.5a0. * library/init.tcl: * mac/README: * macosx/Tcl.pbproj/project.pbxproj: * tests/basic.test: * tools/configure.in: * tools/tcl.hpj.in: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README: * win/README.binary: * win/configure.in: * win/makefile.bc: * win/makefile.vc: * win/tcl.m4: * tools/configure: autoconf * unix/configure: * win/configure: 2003-03-03 Jeff Hobbs *** 8.4.2 TAGGED FOR RELEASE *** 2003-03-03 Daniel Steffen Mac OS Classic specific fixes: * generic/tclIOUtil.c (TclNewFSPathObj): on TCL_PLATFORM_MAC, skip potential directory separator at the beginning of addStrRep. * mac/tclMacChan.c (OpenFileChannel, CommonWatch): followup fixes to cut and splice implementation for file channels. * mac/tclMacFile.c (TclpUtime): pass native path to utime(). * mac/tclMacFile.c (TclpObjLink): correctly implemented creation of alias files via new static proc CreateAliasFile(). * mac/tclMacPort.h: define S_ISLNK macro to fix stat'ing of links. * mac/tclMacUtil.c (FSpLocationFromPathAlias): fix to enable stat'ing of broken links. 2003-03-03 Kevin Kenny * win/Makefile.vc: corrected bug introduced by 'g' for debug builds. 2003-03-03 Don Porter * library/dde/pkgIndex.tcl: dde bumped to version 1.2.1 for * win/tclWinDde.c: bundled release with Tcl 8.4.2 * library/reg/pkgIndex.tcl: registry bumped to version 1.1.1 for * win/tclWinReg.c: bundled release with Tcl 8.4.2 * library/opt/pkgIndex.tcl: updated package index to version 0.4.4 2003-02-28 Jeff Hobbs * win/configure: * win/configure.in: check for 'g' for debug build type, not 'd'. * win/rules.vc (DBGX): correct to use 'g' for nmake win makefile to match the cygwin makefile for debug builds. [Bug 635107] 2003-02-28 Vince Darley * doc/file.n: subcommand is 'file volumes' not 'file volume' 2003-02-27 Jeff Hobbs * generic/tclIOUtil.c (MakeFsPathFromRelative): removed dead code check of typePtr (darley). * tests/winTime.test: added note about PCI hardware dependency issues with high performance clock. 2003-02-27 Donal K. Fellows * tests/lsearch.test (lsearch-10.7): * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Stopped -start option from causing an option when used with an empty list. [Bug 694232] 2003-02-26 Chengye Mao * win/tclWinInit.c: fixed a bug in TclpSetVariables by initializing dwUserNameLen with the sizeof(szUserName) before calling GetUserName. Don't know if this bug has been recorded: it caused crash in starting Tcl or wish in Windows. 2003-02-26 Jeff Hobbs * generic/tclCmdMZ.c (TraceCommandProc): Fix mem leak when deleting a command that had trace on it. [Bug 693564] (sofer) 2003-02-25 Don Porter * doc/pkgMkIndex.n: Modified [pkg_mkIndex] to use -nocase matching * library/package.tcl: of -load patterns, to better accomodate common user errors due to confusion between [package names] names and [info loaded] names. 2003-02-25 Andreas Kupries * tests/pid.test: See below [Bug 678412]. * tests/io.test: Made more robust against spaces in paths [Bug 678400] 2003-02-25 Miguel Sofer * tests/execute.test: cleaning up testobj's at the end, to avoid leak warning by valgrind. 2003-02-22 Zoran Vasiljevic * generic/tclEvent.c (Tcl_FinalizeThread): Fix [Bug 571002] 2003-02-21 Donal K. Fellows * tests/binary.test (binary-44.[34]): * generic/tclBinary.c (ScanNumber): Fixed problem with unwanted sign-bit propagation when scanning wide ints. [Bug 690774] 2003-02-21 Daniel Steffen * mac/tclMacChan.c (TclpCutFileChannel, TclpSpliceFileChannel): Implemented missing cut and splice procs for file channels. 2003-02-21 Don Porter * library/package.tcl (tclPkgUnknown): Minor performance tweaks to reduce the number of [file] invocations. Meant to improve startup times, at least a little bit. [Patch 687906] 2003-02-20 Daniel Steffen * unix/tcl.m4: * unix/tclUnixPipe.c: (macosx) use vfork() instead of fork() to create new processes, as recommended by Apple (vfork can be up to 100 times faster thank fork on macosx). * unix/configure: regen. 2003-02-20 Jeff Hobbs * generic/tclEncoding.c (LoadTableEncoding): * library/encoding/cp932.enc: Correct jis round-trip encoding * library/encoding/euc-jp.enc: by adding 'R' type to .enc files. * library/encoding/iso2022-jp.enc: [Patch 689341] (koboyasi, taguchi) * library/encoding/jis0208.enc: * library/encoding/shiftjis.enc: * tests/encoding.test: * unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): add MakeTcpClientChannelMode that takes actual mode flags to avoid hang on OS X (may be OS X bug, but patch works x-plat). [Bug 689835] (steffen) 2003-02-20 Donal K. Fellows * doc/regsub.n: Typo fix [Bug 688943] 2003-02-19 Jeff Hobbs * unix/tclUnixThrd.c (TclpReaddir): * unix/tclUnixPort.h: update to Bug 689100 patch to ensure that there is a defined value of MAXNAMLEN (aka NAME_MAX in POSIX) and that we have some buffer allocated. 2003-02-19 Daniel Steffen * generic/tclStringObj.c: restored Tcl_SetObjLength() side-effect of always invalidating unicode rep (if the obj has a string rep). Added hasUnicode flag to String struct, allows decoupling of validity of unicode rep from buffer size allocated to it (improves memory allocation efficiency). [Bugs 686782, 671138, 635200] * macosx/Tcl.pbproj/project.pbxproj: * macosx/Makefile: reworked embedded build to no longer require relinking but to use install_name_tool instead to change the install_names for embedded frameworks. [Bug 644510] * macosx/Tcl.pbproj/project.pbxproj: preserve mod dates when running 'make install' to build framework (avoids bogus rebuilds of dependent frameworks because tcl headers appear changed). * tests/ioCmd.test (iocmd-1.8): fix failure when system encoding is utf-8: use iso8859-1 encoding explicitly. 2003-02-18 Miguel Sofer * generic/tclCompile.c (TclCompileExprWords): remove unused variable "range" [Bug 664743] * generic/tclExecute.c (ExprSrandFunc): remove unused variable "result" [Bug 664743] * generic/tclStringObj.c (UpdateStringOfString): remove unused variable "length" [Bug 664751] * tests/execute.test (execute-7.30): fix for [Bug 664775] 2003-02-18 Andreas Kupries * unix/tcl.m4: [Bug #651811] Added definition of _XOPEN_SOURCE and linkage of 'xnet' library to HP 11 branch. This kills a lot of socket-related failures in the testsuite when Tcl was compiled in 64 bit mode (both PA-RISC 2.0W, and IA 64). * unix/configure: Regenerated. 2003-02-18 Jeff Hobbs * generic/tclIO.c (HaveVersion): correctly decl static * unix/tclUnixThrd.c (TclpReaddir): reduce size of name string in tsd to NAME_MAX instead of PATH_MAX. [Bug 689100] (waters) 2003-02-18 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_ENABLE_THREADS): Make sure -lpthread gets passed on the link line when checking for the pthread_attr_setstacksize symbol. 2003-02-18 Vince Darley * generic/tclTest.c: cleanup of new 'simplefs' test code, and better documentation. 2003-02-17 Miguel Sofer * generic/tclBasic.c (TclRenameCommand): fixing error in previous commit. 2003-02-17 Jeff Hobbs * generic/tclExecute.c (TclExecuteByteCode INST_STR_MATCH): * generic/tclCmdMZ.c (Tcl_StringObjCmd STR_MATCH): * generic/tclUtf.c (TclUniCharMatch): * generic/tclInt.decls: add private TclUniCharMatch function that * generic/tclIntDecls.h: does string match on counted unicode * generic/tclStubInit.c: strings. Tcl_UniCharCaseMatch has the failing * tests/string.test: that it can't handle strings or patterns with * tests/stringComp.test: embedded NULLs. Added tests that actually try strings/pats with NULLs. TclUniCharMatch should be TIPed and made public in the next minor version rev. 2003-02-17 Miguel Sofer * generic/tclBasic.c (TclRenameCommand): 'oldFullName' object was not being freed on all function exits, causing a memory leak. [Bug 684756] 2003-02-17 Mo DeJong * generic/tclIO.c (Tcl_GetsObj): Minor change so that eol is only assigned at the top of the TCL_TRANSLATE_AUTO case block. The other cases assign eol so this does not change any functionality. 2003-02-17 Kevin Kenny * tests/notify.test: Removed Windows line terminators. [Bug 687913]. 2003-02-15 Miguel Sofer * generic/tclBasic.c (Tcl_EvalEx): * generic/tclCompExpr.c (CompileSubExpr): * generic/tclCompile.c (TclCompileScript): * generic/tclParse.c (Tcl_ParseCommand, ParseTokens): * generic/tclParseExpr.c (ParsePrimaryExpr): * tests/basic.test (47.1): * tests/main.test (3.4): * tests/misc.test (1.2): * tests/parse.test (6.18): * tests/parseExpr.test (15.35): * tests/subst.test (8.6): Don Porter's fix for bad parsing of nested scripts. [Bug 681841] 2003-02-15 Kevin Kenny * tests/notify.test (new-file): * generic/tclTest.c (TclTest_Init, EventtestObjCmd, EventtestProc, (EventTestDeleteProc): * generic/tclNotify.c (Tcl_DeleteEvents): Fixed Tcl_DeleteEvents not to get a pointer smash when deleting the last event in the queue. Added test code in 'tcltest' and a new file of test cases 'notify.test' to exercise this functionality; several of the new test cases fail for the original code and pass for the corrected code. [Bug 673714] * unix/tclUnixTest.c (TestfilehandlerCmd): Corrected a couple of typos in error messages. [Bug 596027] 2003-02-14 Jeff Hobbs * README: Bumped to version 8.4.2. * generic/tcl.h: * tools/tcl.wse.in: * unix/configure: * unix/configure.in: * unix/tcl.m4: * unix/tcl.spec: * win/README.binary: * win/configure: * win/configure.in: * macosx/Tcl.pbproj/project.pbxproj: * generic/tclStringObj.c (Tcl_GetCharLength): perf tweak * unix/tcl.m4: correct HP-UX ia64 --enable-64bit build flags 2003-02-14 Kevin Kenny * win/tclWinTime.c: Added code to test and compensate for forward leaps of the performance counter. See the MSDN Knowledge Base article Q274323 for the hardware problem that makes this necessary on certain machines. * tests/winTime.test: Revised winTime-2.1 - it had a tolerance of thousands of seconds, rather than milliseconds. (What's six orders of magnitude among friends?) Both the above changes are triggered by a problem reported at: http://aspn.activestate.com/ASPN/Mail/Message/ActiveTcl/1536811 although the developers find it difficult to believe that it accounts for the observed behavior and suspect a fault in the RTC chip. 2003-02-13 Kevin Kenny * win/tclWinInit.c: Added conversion from the system encoding to tcl_platform(user), so that it works with non-ASCII7 user names. [Bug 685926] * doc/tclsh.1: Added language to describe the handling of the end-of-file character \u001a embedded in a script file. [Bug 685485] 2003-02-11 Vince Darley * tests/fileName.test: * unix/tclUnixFile.c: fix for [Bug 685445] when using 'glob -l' on broken symbolic links. Added two new tests for this bug. 2003-02-11 Kevin Kenny * tests/http.test: Corrected a problem where http-4.14 would fail when run in an environment with a proxy server. Replaced references to scriptics.com by tcl.tk. 2003-02-11 Jeff Hobbs * tests/lsearch.test: * generic/tclCmdIL.c (Tcl_LsearchObjCmd): protect against the case that lsearch -regepx list and pattern objects are equal. * tests/stringObj.test: * generic/tclStringObj.c (Tcl_GetCharLength): correct ascii char opt of 2002-11-11 to not stop early on \x00. [Bug 684699] * tests.parse.test: remove excess EOF whitespace * generic/tclParse.c (CommandComplete): more paranoid check to break on (p >= end) instead of just (p == end). 2003-02-11 Miguel Sofer * generic/tclParse.c (CommandComplete): * tests/parse.test: fix for [Bug 684744], by Don Porter. 2003-02-11 Jeff Hobbs * generic/tclIOUtil.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath): (UpdateStringOfFsPath): revert the cwdLen == 0 check and instead follow a different code path in Tcl_FSJoinPath. (Tcl_FSConvertToPathType, Tcl_FSGetNormalizedPath): (Tcl_FSGetFileSystemForPath): Update string rep of path objects before freeing the internal object. (darley) * tests/fileSystem.test: added test 8.3 * generic/tclIOUtil.c (Tcl_FSGetNormalizedPath): (UpdateStringOfFsPath): handle the cwdLen == 0 case * unix/tclUnixFile.c (TclpMatchInDirectory): simplify the hidden file match check. 2003-02-10 Mo DeJong * win/configure: * win/configure.in: Generate error when attempting to build under Cygwin. The Cygwin port of Tcl/Tk does not build and people are filing bug reports under the mistaken impression that someone is actually maintaining the Cygwin port. A post to comp.lang.tcl asking someone to volunteer as an area maintainer has generated no results. Closing bugs 680840, 630199, and 634772 and marking as "Won't fix". 2003-02-10 Donal K. Fellows * doc/append.n: Return value was not documented. [Bug 683188] 2003-02-10 Vince Darley * doc/FileSystem.3: * generic/tclIOUtil.c: * generic/tclInt.h: * tests/fileSystem.test: * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * win/tclWinFile.c: further filesystem optimization, applying [Patch 682500]. In particular, these code examples are faster now: foreach f $flist { if {[file exists $f]} {file stat $f arr;...}} foreach f [glob -dir $dir *] { # action and/or recursion on $f } cd $dir foreach f [glob *] { # action and/or recursion on $f } cd .. * generic/tclTest.c: Fix for [Bug 683181] where test suite left files in 'tmp'. 2003-02-08 Jeff Hobbs * library/safe.tcl: code cleanup of eval and string comp use. 2003-02-07 Vince Darley * win/tclWinFCmd.c: cleanup long lines * win/tclWinFile.c: sped up pure 'glob' by a factor of 2.5 ('foreach f [glob *] { file exists $f }' is still slow) * tests/fileSystem.text: * tests/fileName.test: added new tests to ensure correct behaviour in optimized filesystem code. 2003-02-07 Vince Darley * generic/tclTest.c: * tests/fileSystem.text: fixed test 7.2 to avoid a possible crash, and not change the pwd. * tests/http.text: added comment to test 4.15, that it may fail if you use a proxy server. 2003-02-06 Mo DeJong * generic/tclCompCmds.c (TclCompileIncrCmd): * tests/incr.test: Don't include the text "(increment expression)" in the errorInfo generated by the compiled version of the incr command since it does not match the message generated by the non-compiled version of incr. It is also not possible to match this error output under Jacl, which does not support a compiler. 2003-02-06 Mo DeJong * generic/tclExecute.c (TclExecuteByteCode): When an error is encountered reading the increment value during a compiled call to incr, add a "(reading increment)" error string to the errorInfo variable. This makes the errorInfo variable set by the compiled incr command match the value set by the non-compiled version. * tests/incr-old.test: Change errorInfo result for the compiled incr command case to match the modified implementation. * tests/incr.test: Add tests to make sure the compiled and non-compiled errorInfo messages are the same. 2003-02-06 Don Porter * library/tcltest/tcltest.tcl: Filename arguments to [outputChannel] and [errorChannel] (also -outfile and -errfile) were [open]ed but never [closed]. Also, [cleanupTests] could remove output or error files. [Bug 676978]. * library/tcltest/pkgIndex.tcl: Bumped to version 2.2.2. 2003-02-05 Mo DeJong * tests/interp.test: * tests/set-old.test: Run test cases that depend on hash order through lsort so that the tests also pass under Jacl. Does not change test results under Tcl. 2003-02-04 Vince Darley * generic/tclIOUtil.c: * generic/tclEvent.c: * generic/tclInt.h: * mac/tclMacFCmd.c: * unix/tclUnixFCmd.c: * win/tclWin32Dll.c: * win/tclWinFCmd.c: * win/tclWinInit.c: * win/tclWinInt.h: * tests/fileSystem.test: fix to finalization/unloading/encoding issues to make filesystem much less dependent on encodings for its cleanup, and therefore allow it to be finalized later in the exit process. This fixes fileSystem.test-7.1. Also fixed one more bug in setting of modification dates of files which have undergone cross-platform copies. [Patch 676271] * tests/basic.test: * tests/exec.test: * tests/fileName.test: * tests/io.test: fixed some test failures when tests are run from a directory containing spaces. * tests/fileSystem.test: * generic/tclTest.c: added regression test for the modification date setting of cross-platform file copies. 2003-02-03 Kevin Kenny * generic/tclBasic.c: Changed [trace add command] so that 'rename' callbacks get fully qualified names of the command. [Bug 651271]. ***POTENTIAL INCOMPATIBILITY*** * tests/trace.test: Modified the test cases for [trace add command] to expect fully qualified names on the 'rename' callbacks. Added a case for renaming a proc within a namespace. * doc/trace.n: Added language about use of fully qualified names in trace callbacks. 2003-02-01 Kevin Kenny * generic/tclCompCmds.c: Removed an unused variable that caused compiler warnings on SGI. [Bug 664379] * generic/tclLoad.c: Changed the code so that if Tcl_StaticPackage is called to report the same package as being loaded in two interps, it shows up in [info loaded {}] in both of them (previously, it didn't appear in the static package list in the second). * tests/load.test Added regression test for the above bug. [Bug 670042] * generic/tclClock.c: Fixed a bug that incorrectly allowed [clock clicks {}] and [clock clicks -] to be accepted as if they were [clock clicks -milliseconds]. * tests/clock.test: Added regression tests for the above bug. [Bug 675356] * tests/unixNotfy.test: Added cleanup of working files. [Bug 675609] * doc/Tcl.n: Added headings to the eleven paragraphs, to improve formatting in the tools that attempt to extract tables of contents from the manual pages. [Bug 627455] * generic/tclClock.c: Expanded mutex protection around the setting of env(TZ) and the thread-unsafe call to tzset(). [Bug 656660] 2003-01-31 Don Porter * tests/tcltest.test: Cleaned up management of file/directory creation/deletion to improve "-debug 1" output. [Bug 675614] The utility [slave] command failed to properly [list]-quote a constructed [open] command, causing failure when the pathname contained whitespace. [Bug 678415] * tests/main.test: Stopped main.test from deleting existing file. Test suite should not delete files that already exist. [Bug 675660] 2003-01-28 Don Porter * tests/main.test: Constrain tests that do not work on Windows. [Bug 674387] 2003-01-28 Vince Darley * generic/tclIOUtil.c: fix to setting modification date in TclCrossFilesystemCopy. Also added 'panic' in Tcl_FSGetFileSystemForPath under illegal calling circumstances which lead to hard-to-track-down bugs. * generic/tclTest.c: added test suite code to allow exercising a vfs-crash-on-exit bug in Tcl's finalization caused by the encodings being cleaned up before unloading occurs. * tests/fileSystem.test: added new 'knownBug' test 7.1 to demonstrate the crash on exit. 2003-01-28 Mo DeJong * generic/tcl.h: Add TCL_PREFIX_IDENT and TCL_DEBUG_IDENT, used only by TclpCreateProcess. * unix/Makefile.in: Define TCL_DBGX. * win/Makefile.in: Define TCL_DBGX. * win/tclWinPipe.c (TclpCreateProcess): Check that the Tcl pipe dll actually exists in the Tcl bin directory and panic if it is not found. Incorporate TCL_DBGX into the Tcl pipe dll name. This fixes a really mysterious error that would show up when exec'ing a 16 bit application under Win95 or Win98 when Tcl was compiled with symbols. The error seemed to indicate that the executable could not be found, but it was actually the Tcl pipe dll that could not be found. 2003-01-26 Mo DeJong * win/README: Update msys+mingw URL to release 6. This version bundles gcc 3. 2003-01-26 Mo DeJong * win/configure: Regen. * win/configure.in: Add test that checks to see if the compiler can cast to a union type. * win/tclWinTime.c: Squelch compiler warning about union initializer by casting to union type when compiling with gcc. 2003-01-25 Mo DeJong * generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel): Invoke TclpCutFileChannel and TclpSpliceFileChannel. * generic/tclInt.h: Declare TclpCutFileChannel and TclpSpliceFileChannel. * unix/tclUnixChan.c (FileCloseProc, TclpOpenFileChannel, (Tcl_MakeFileChannel, TclpCutFileChannel, TclpSpliceFileChannel): Implement thread load data cut and splice for file channels. This avoids an invalid memory ref when compiled with -DDEPRECATED. * win/tclWinChan.c (FileCloseProc, TclpCutFileChannel, (TclpSpliceFileChannel): Implement thread load data cut and splice for file channels. This avoids an invalid memory ref that was showing up in the thread extension. 2003-01-25 Mo DeJong * win/tclWin32Dll.c (TclpCheckStackSpace, squelch_warnings): * win/tclWinChan.c (Tcl_MakeFileChannel, squelch_warnings): * win/tclWinFCmd.c (DoRenameFile, DoCopyFile, squelch_warnings): Re-implement inline ASM SEH handlers for gcc. The esp and ebp registers are now saved on the stack instead of in global variables so that the code is thread safe. Add additional checks when TCL_MEM_DEBUG is defined to be sure the values were recovered from the stack properly. Remove squelch_warnings functions and add a dummy call in the handler methods to squelch compiler warnings. 2003-01-25 Mo DeJong * win/configure: * win/configure.in: Define HAVE_ALLOCA_GCC_INLINE when we detect that no alloca function is found in malloc.h and we are compiling with GCC. Remove HAVE_NO_ALLOC_DECL define. * win/tclWin32Dll.c (TclpCheckStackSpace): Don't define alloca as a cdecl function. Doing this caused a tricky runtime bug because the _alloca function expects the size argument to be passed in a register and not on the stack. To fix this problem, we use inline ASM when compiling with gcc to invoke _alloca with the size argument loaded into a register. 2003-01-24 Jeff Hobbs * win/tclWinDde.c (Dde_Init): clarified use of tsdPtr. (DdeServerProc): better refcount handling of returnPackagePtr. * generic/tclEvent.c (Tcl_Finalize): revert finalize change on 2002-12-04 to correct the issue with extensions that have TSD needing to finalize that before they are unloaded. This issue needs further clarification. * tests/unixFCmd.test: only do groups check on unix 2003-01-24 Vince Darley * generic/tclStringObj.c: proper fixes for Tcl_SetObjLength and Tcl_AttemptSetObjectLength dealing with string objects with both pure-unicode and normal internal representations. Previous fix didn't handle all cases correctly. * generic/tclIO.c: Add 'Tcl_GetString()' to ensure the object has a valid 'objPtr->bytes' field before manipulating it directly. This fixes [Bug 635200] and [Bug 671138], but may reduce performance of Unicode string handling in some cases. A further patch will be applied to address this, once the code is known to be correct. 2003-01-24 Mo DeJong * win/configure: Regen. * win/configure.in: Add test to see if alloca is undefined in malloc.h. * win/tclWin32Dll.c (TclpCheckStackSpace): Rework the SEH exception handler logic to avoid using the stack since alloca will modify the stack. This was causing a nasty bug that would set the exception handler to 0 because it tried to pop the previous exception handler off the top of the stack. 2003-01-23 Donal K. Fellows * doc/lset.n: Fixed fault in return values from lset in documentation examples [SF Bug #658463] and tidied up a bit at the same time. 2003-01-21 Joe English * doc/namespace.n (namespace inscope): Clarified documentation [Patch 670110] 2003-01-21 Mo DeJong * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): Set SHLIB_SUFFIX so that TCL_SHLIB_SUFFIX will be set to a useful value in the generated tclConfig.sh. Set SHLIB_LD_LIBS to "" or '${LIBS}' based on the --enable-shared flag. This matches the UNIX implementation. 2003-01-18 Jeff Hobbs * generic/tclCkalloc.c: change %ud to %u as appropriate. 2003-01-17 Mo DeJong * win/tclWinDde.c (DdeServerProc): Deallocate the Tcl_Obj returned by ExecuteRemoteObject if it was not saved in a connection object. 2003-01-17 Mo DeJong * generic/tcl.h: Revert earlier change that defined TCL_WIDE_INT_TYPE as long long and TCL_LL_MODIFIER as L when compiling with mingw. This change ended up causing some test case failures when compiling with mingw. * generic/tclObj.c (UpdateStringOfWideInt): Describe the warning generated by mingw and why it needs to be ignored so that someone is not tempted to "fix" this problem again in the future. 2003-01-16 Vince Darley * generic/tclStringObj.c: Tcl_SetObjLength fix for when the object has a unicode string rep. [Bug 635200] * tests/stringObj.test: removed 'knownBug' constraint from test 14.1 now that this bug is fixed. * generic/tclInt.h: * generic/tclBasic.c: * generic/tclCmdMZ.z: * tests/trace.test: execution and command tracing bug fixes and cleanup. In particular fixed [Bug 655645], [Bug 615043], [Bug 571385] - fixed some subtle cleanup problems with tracing. This required replacing Tcl_Preserve/Tcl_Release with a more robust refCount approach. Solves at least one known crash caused by memory corruption. - fixed some confusion in the code between new style traces (Tcl 8.4) and the very limited 'Tcl_CreateTrace' which existed before. - made behaviour consistent with documentation (several tests even contradicted the documentation before). - fixed some minor error message details - added a number of new tests 2003-01-16 Jeff Hobbs * win/tclWinSerial.c (SerialOutputProc): add casts for bytesWritten to allow strict compilation (no warnings). * tests/winDde.test: * win/tclWinDde.c (Tcl_DdeObjCmd): Prevent crash when empty service name is passed to 'dde eval' and goto errorNoResult in request and poke error cases to free up any allocated data. 2003-01-16 Mo DeJong * win/tclWin32Dll.c (squelch_warnings): Squelch compiler warnings from SEH ASM code. * win/tclWinChan.c (squelch_warnings): Squelch compiler warnings from SEH ASM code. * win/tclWinDde.c: Add casts to avoid compiler warnings. Pass pointer to DWORD instead of int to avoid compiler warnings. * win/tclWinFCmd.c (squelch_warnings): Add casts and fixup decls to avoid compiler warnings. Squelch compiler warnings from SEH ASM code. * win/tclWinFile.c: Add casts and fixup decls to avoid compiler warnings. Remove unused variable. * win/tclWinNotify.c: Declare as DWORD instead of int to avoid compiler warning. * win/tclWinReg.c: Add casts to avoid compiler warning. Fix assignment in if expression bug. * win/tclWinSerial.c: Add casts to avoid compiler warnings. Remove unused variable. * win/tclWinSock.c: Add casts and fixup decls to avoid compiler warnings. 2003-01-14 Jeff Hobbs * generic/tclClock.c (FormatClock): corrected typo that incorrectly conditionally defined savedTZEnv and savedTimeZone. 2003-01-13 Mo DeJong Fix mingw build problems and compiler warnings. * generic/tcl.h: Add if defined(__MINGW32__) check to code that sets the TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER. * generic/tclClock.c (FormatClock): Don't define savedTimeZone and savedTZEnv if we are not going to use them. * generic/tclEnv.c: Add cast to avoid warning. * win/tclWinChan.c: Use DWORD instead of int to avoid compiler warning * win/tclWinThrd.c: Only define allocLock, allocLockPtr, and dataKey when TCL_THREADS is defined. This avoid a compiler warning about unused variables. 2003-01-12 Mo DeJong * win/README: Update msys + mingw URL, the new release includes the released 1.0.8 version of msys which includes a number of bug fixes. 2003-01-12 Mo DeJong * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): Pull in addition of shell32.lib to LIBS_GUI that was added to the Tk tcl.m4 but never made it back into the Tcl version. 2003-01-12 Mo DeJong * generic/tcl.h: Skip Tcl's define of CHAR, SHORT, and LONG when HAVE_WINNT_IGNORE_VOID is defined. This avoids a bunch of compiler warnings when building with Cygwin or Mingw. * win/configure: Regen. * win/configure.in: Define HAVE_WINNT_IGNORE_VOID when we detect a winnt.h that still defines CHAR, SHORT, and LONG when VOID has already been defined. * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst the TCL_DEFS loaded from tclConfig.sh so that Tcl defines can make it into the Tk Makefile. 2003-01-12 Mo DeJong * win/configure: Regen. * win/configure.in: Check for typedefs like LPFN_ACCEPT in winsock2.h and define HAVE_NO_LPFN_DECLS if not found. * win/tclWinSock.c: Define LPFN_* typedefs if HAVE_NO_LPFN_DECLS is defined. This fixes the build under Mingw and Cygwin, it was broken by the changes made on 2002-11-26. 2003-01-10 Vince Darley * generic/tclIOUtil.c: * win/tclWinInt.h: * win/tclWinInit.c: fix to new WinTcl crash on exit with vfs, introduced on 2002-12-06. Encodings must be cleaned up after the filesystem. * win/makefile.vc: fix to minor VC++ 5.2 syntax problem 2003-01-09 Don Porter * generic/tclCompCmds.c (TclCompileReturnCmd): Corrected off-by-one problem with recent commit. [Bug 633204] 2003-01-09 Vince Darley * generic/tclFileName.c: remove unused variable 'macSpecialCase' [Bug 664749] * generic/tclIOUtil.c: * generic/tclInt.h: * unix/tclUnixFile.c: * mac/tclMacFile.c: * win/tclWinFile.c: * win/tclWinInt.h: * win/tclWin32Dll.c: * tests/cmdAH.test: fix to non-ascii chars in paths when setting mtime and atime through 'file (a|m)time $path $time'. [Bug 634151] 2003-01-08 Don Porter * generic/tclExecute.c (TclExprFloatError): Use the IS_NAN macro for greater clarity of code. 2003-01-07 Don Porter * generic/tclCompCmds.c (TclCompileReturnCmd): * tests/compile.test: Corrects failure of bytecompiled [catch {return}] to have result TCL_RETURN (not TCL_OK) [Bug 633204]. This patch is a workaround for 8.4.X. A new opcode INST_RETURN is a better long term solution for 8.5 and later. 2003-01-04 David Gravereaux * win/makefile.vc: * win/rules.vc: Fixed INSTALLDIR macro problem that blanked itself by accident causing the install target to put the tree at the root of the drive built on. Whoops.. Renamed the 'linkexten' option to be 'staticpkg'. Added 'thrdalloc' to allow the switching _on_ of the thread allocator. Under testing, I found it not to be benificial under windows for the purpose of the application I was using it for. It was more important for this app that resources for tcl threads be returned to the system rather than saved/moved to the global recycler. Be extra clean or extra fast for the default threaded build? Let's move to clean and allow it to be switched on for users who find it benificial for their use of threads. ****************************************************************** *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ****************************************************************** tcl8.6.14/ChangeLog.20040000644000175000017500000054206414554262142014013 0ustar sergeisergei2004-12-29 Jeff Hobbs * win/tcl.m4, win/configure: update MSVC CFLAGS_OPT to -O2, remove -Gs (included in -O2) and -GD (outdated). Use "link -lib" instead of "lib" binary and remove -YX for MSVC7 portability. Add -fomit-frame-pointer for gcc OPT compiles. [Bug 1092952, 1091967] Align LIBS_GUI with Tk head needs. 2004-12-29 Kevin B. Kenny * generic/tclDate.c: Regen * generic/tclGetDate.y (TclDatelex): Fixed a problem where a four-digit group with >=2 leading zeroes appeared to be a two-digit group, leading to misinterpreting the time 0012 as 1200. [Bug 1090413] * library/clock.tcl: Added code to interpret correctly months outside the range 01-12 as reduced modulo 12 with a corresponding adjustment to the year. [Bug 1092789] * tests/clock.test: Added regression test cases for the above two bugs * unix/Makefile.in: Added --no-lines to the 'bison' command line to * win/Makefile.in: help constrain the number of diffs in a cvs checkin 2004-12-24 Miguel Sofer * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclLiteral.c: * generic/tclProc.c: Avoid sharing cmdName literals accross namespaces, and generalise usage of the TclRegisterNewLiteral macro. [Patch 1090905] 2004-12-20 Miguel Sofer * generic/tclCompile.c: moved TclInitCompiledLocals to tclProc.c * generic/tclProc.c: new static InitCompiledLocals to allow for a single pass over the proc's arguments at proc load time (instead of two as previously). TclObjInterpProc() now allocates the compiledLocals on the tcl execution stack, using the new TclStackAlloc/Free functions. 2004-12-16 Donal K. Fellows * generic/tclInterp.c (Tcl_LimitSetTime, TimeLimitCallback): (TclLimitRemoveAllHandlers, TclInitLimitSupport): Set a timer event to trigger when the time limit runs out. All the time limit actually does is check to see if the time limit has been exceeded, but this is enough to fix [Bug 1085023]. * generic/tclInt.h (struct Interp): Added a field to hold the token for the timer event handler associated with the current time limit. * generic/tclEvent.c (Tcl_UpdateObjCmd, Tcl_VwaitObjCmd): Add error message when limit exceeded. * tests/interp.test (interp-34.[89]): Check that time limits handle the two cases reported in [Bug 1085023] * generic/tclTimer.c (TclCreateAbsoluteTimerHandler): New internal function that allows setting a timer handler that will be triggered at (or after) a specific time instead of at some number of milliseconds in the future. This is a candidate for future exposure via a TIP. 2004-12-15 Miguel Sofer * generic/tclBasic.c: * generic/tclExecute.c: * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclNamesp.c: * generic/tclProc.c: * generic/tclStubInit.c: * generic/tclTest.c: Added two new functions to allocate memory from the execution stack (TclStackAlloc, TclStackFree). Added functions TclPushStackFrame and TclPopStackFrame that do the work of Tcl_PushCallFrame and Tcl_PopCallFrame, but using frames allocated in the execution stack - i.e., heap instead of C-stack. The core uses these two new functions exclusively; the old ones remain for backwards compat, as at least two popular extensions (itcl, xotcl) are known to use them. 2004-12-14 Miguel Sofer * generic/tclCmdIL.c: * generic/tclInt.h: * generic/tclProc.c: * generic/tclVar.c: changing the isProcCallFrame field of the CallFrame struct from a 0/1 field to flags. Should be perfectly backwards compatible. 2004-12-14 Don Porter * unix/configure.in: Added special processing to remove "$U" from libraries in the LIBOBJS value. This is an auto-make-ism we need to avoid. [Bug 1081541] * unix/configure: autoconf-2.57 2004-12-13 Don Porter * generic/tcl.h: Restored extern "C" guards so that C++ code sees function pointer typedef linkage consistent with earlier Tcl releases. [Bug 1082349] * generic/tclEncoding.c: Plugged some memory leaks. Thanks to Rolf Ade * generic/tclUtil.c: for reports and testing [Bug 1083082] 2004-12-13 Kevin B. Kenny * doc/clock.n: Clarify that the [clock scan] command does not accept the full range of ISO8601 point-in-time formats. [Bug 1075433] 2004-12-12 Miguel Sofer * generic/tclVar.c (TclArrayObjCmd - ARRAY_NAMES): leaking an object [Bug 1084111] - thanks to Rolf Ade. 2004-12-12 Miguel Sofer * generic/tclObj.c (TclSetCmdNameObj): special handling for fully qualified command names (as in fix [Patch 456668]). 2004-12-11 Miguel Sofer * generic/tclInt.h: * generic/tclNamesp.c: converting the static function GetNamespaceFromObj() to MODULE_SCOPE TclGetNamespaceFromObj(). 2004-12-10 Donal K. Fellows * tools/tcl.wse.in, unix/tcl.spec, win/README.binary, README: * win/configure.in, unix/configure.in, generic/tcl.h: Bumped version number to 8.5a3 to distinguish HEAD of CVS development from the recent 8.5a2 release. 2004-12-10 Miguel Sofer * generic/tclCompile.c (TclInitCompiledLocals): * generic/tclCompile.h: * generic/tclInt.h: * generic/tclProc.c (TclObjInterpProc, TclCreateProc): optimised loops that initialise a proc's arguments and compiled local variables, removing tests from inner loops. 2004-12-10 Donal K. Fellows * generic/tclInt.h: Move ensemble API decls here from tclNamesp.c 2004-12-09 Donal K. Fellows * generic/tclNamesp.c (TclMakeEnsembleCmd, TclSetEnsemble*) (TclSetEnsemble*, TclFindEnsemble): Build an internal API for creating and manipulating ensembles; they can be deleted using the normal command-deletion API. * doc/Async.3: Reword for better grammar, better nroff and get the flag name right. (Reported by David Welton.) 2004-12-07 Don Porter * tests/unixInit.test (2.1-4): Added constraints so that when a value of TCL_LIBRARY is required for process initialization, we skip the tests that mess with that value. 2004-12-07 Donal K. Fellows *** 8.5a2 TAGGED FOR RELEASE *** * unix/Makefile.in: add library/{tzdata,msgs} to dist target (kbk) * doc/foreach.n: Adjust tabs to be friendlier to some HTML converters. [Bug 1078760] 2004-12-06 Jeff Hobbs * unix/tclUnixNotfy.c (NotifierThreadProc): init numFdBits [Bug 1079286] * doc/error.n, doc/SaveResult.3, doc/Thread.3: minor nroff typos 2004-12-06 Don Porter * tests/safe.test: Trim auto_path to improve performance [1080039] * tests/msgcat.test: makeFile/removeFile cleanup [1079117] 2004-12-04 Don Porter * generic/tclEncoding.c: Different fix for [Bug 1077005]. * generic/tclEvent.c: Broke apart TclpSetInitialEncodings() on * generic/tclInt.h: Windows into TclpSetInterfaces(), that is * unix/tclUnixInit.c: fundamentally essential, and the initialization * win/tclWinInit.c: of the system encoding, which is not. Made the TclpSetInterfaces call part of TclInitSubsystems so it cannot be overlooked. 2004-12-03 Jeff Hobbs * changes: updated for 8.5a2 release 2004-12-02 Don Porter * generic/tclUtil.c (TclSetProcessGlobalValue): Handle the case where a ProcessGlobalValue might be assigned to itself. * generic/tclEncoding.c (MakeFileMap): Correct refcounting errors managing values returned by TclPathPart (with refCount of 1!) that led to a memory leak. [Bug 1077474]. 2004-12-02 Vince Darley * generic/tclPathObj.c: fix and new tests for [Bug 1074671] to ensure * tests/fileSystem.test: tilde paths are not returned specially by 'glob'. 2004-12-02 Kevin B. Kenny * win/Makefile.in: Added a 'sed' in the setting of ROOT_DIR_NATIVE to compensate for a bug in cygpath (at least version 1.36) that leaves a trailing backslash on the end of the converted path. 2004-12-02 Donal K. Fellows * generic/tclInterp.c (Alias,Target,Master): Rewrote these so that the aliases that refer to an interpreter are stored in a list and not a hashtable (which was only ever a convenience, and forced the use of a global mutex to generate keys!) [FRQ 1077210] * generic/tclNamesp.c (numNsCreated): Moved into thread-local storage to remove a global mutex. [FRQ 1077210] 2004-12-01 Don Porter * generic/tclUtil.c (TclGetProcessGlobalValue): Narrowed the scope of mutex locks. * generic/tclUtil.c: Updated Tcl_GetNameOfExecutable() to * generic/tclEncoding.c: make use of a ProcessGlobalValue for * generic/tclEvent.c: storing the executable name. Added internal routines Tcl(Get|Set)ObjNameOfExecutable() to access that storage in Tcl_Obj, rather than string format. * unix/tclUnixFile.c: Rewrote TclpFindExecutable() to use * win/tclWinFile.c: TclSetObjNameOfExecutable to store the executable name it computes. * generic/tclInt.h: Added internal stub entries for * generic/tclInt.decls: TclpFindExecutable and Tcl(Get|Set)ObjNameOfExecutable. * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclCmdIL.c: Retrieve executable name in Tcl_Obj form * win/tclWinPipe.c: instead of string form. * unix/tclUnixTest.c: Update [testfindexecutable] command to use new internal interfaces. * generic/tclEncoding.c: Moved TclpSetInitialEncodings() call from Tcl_FindExecutable() into TclInitEncodingSubsystem(). This is important on Windows where it establishes whether the "ascii" or "unicode" set of system routines will be used, and that needs to be done earlier to support filesystem operations. [Bug 1077005] 2004-12-01 Donal K. Fellows * tests/winDde.test: Rewritten to use tcltest2 features more thoroughly (reducing the [catch] count!) and fix the problem with winDde-6.1 being out of synch with the implementation. 2004-11-30 Don Porter * library/init.tcl ([unknown]): Restored the save/restore of the variables ::errorCode and ::errorInfo. This is needed when the [::bgerror] command is auto-loaded (as it is by Tk). Patch 976520 reworks several of the details involved with startup/initialization of the Tcl library, focused on the activities of Tcl_FindExecutable(). * generic/tclIO.c: Removed bogus claim in comment that encoding "iso8859-1" is "built-in" to Tcl. * generic/tclInt.h: Created a new struct ProcessGlobalValue, * generic/tclUtil.c: routines Tcl(Get|Set)ProcessGlobalValue, and function type TclInitProcessGlobalValueProc. Together, these take care of the housekeeping for "values" (things that can be held in a Tcl_Obj) that are global across a whole process. That is, they are shared among multiple threads, and epoch and mutex protection must govern the validity of cached copies maintained in each thread. * generic/tclNotify.c: Modified TclInitNotifier() to tolerate being called multiple times in the same thread. * generic/tclEvent.c: Dropped the unused argv0 argument to TclInitSubsystems(). Removed machinery to unsure only one TclInitNotifier() call per thread, now that that is safe. Converted Tcl(Get|Set)LibraryPath to use a ProcessGlobalValue, and moved them to tclEncoding.c. * generic/tclBasic.c: Updated caller. * generic/tclInt.h: TclpFindExecutable now returns void. * unix/tclUnixFile.c: * win/tclWinFile.c: * win/tclWinPipe.c: * generic/tclEncoding.c: Built new encoding search initialization on a foundation of ProcessGlobalValues, exposing new routines Tcl(Get|Set)EncodingSearchPath. A cache of a map from encoding name to directory pathname keeps track of where encodings are available for loading. Tcl_FindExecutable greatly simplified into just three function calls. The "library path" is now misnamed, as its only remaining purpose is as a foundation for the default encoding search path. * generic/tclInterp.c: Inlined the initScript that is evaluated by Tcl_Init(). Added verification after initScript evaluation that Tcl can find its installed *.enc files, and that it has initialized [encoding system] in agreement with what the environment expects. [tclInit] no longer driven by the value of $::tcl_libPath; it largely constructs its own search path now, rather than attempt to share one with the encoding system. * unix/tclUnixInit.c: TclpSetInitialEncodings factored so that a new * win/tclWinInit.c: routine TclpGetEncodingNameFromEnvironment can reveal that Tcl thinks the [encoding system] should be, even when an incomplete encoding search path, or a missing *.enc file won't allow that initialization to succeed. TclpInitLibraryPath reworked as an initializer of a ProcessGlobalValue. * unix/tclUnixTest.c: Update implementations of [testfindexecutable], [testgetdefenc], and [testsetdefenc]. * tests/unixInit.test: Corrected tests to operate properly even when a value of TCL_LIBRARY is required to find encodings. * generic/tclInt.decls: New internal stubs: TclGetEncodingSearchPath, TclSetEncodingSearchPath, TclpGetEncodingNameFromEnvironment. These are candidates for public exposure by future TIPs. * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclTest.c: Updated [testencoding] to use * tests/encoding.test: Tcl(Get|Set)EncodingSearchPath. Updated tests. 2004-11-30 Kevin B. Kenny * library/clock.tcl: Corrected the regular expressions that match a time zone to allow for time zones specified as +HH or -HH. * tests/clock.test: Added regression test case for the above issue. Thanks to Rolf Ade for reporting this issue [https://wiki.tcl-lang.org/page/Parsing+ISO8601+dates+and+times] * win/tclWinDde.c (Tcl_DdeObjCmd): Corrected a typo that caused a compilation failure on VC++. 2004-11-29 Andreas Kupries * win/Makefile.in (install-libraries): Brought entry '2004-10-26 Don Porter (Tcl Modules)' into the windows world, actually the win/configure buildsystem. The other windows buildsystems (.vc, .bc) still have to be updated as well. 2004-11-26 Andreas Kupries * win/tclWinDde.c (ExecuteRemoteObject): Removed bogus semicolon found at the end of the header for the function definition, terminating it early and preventing a compile. This is likely a fix for '2004-11-25 Donal'. I have to conclude that it is also unknown if the other changes to this file actually pass the testsuite. Running testsuite ... They don't. winDde-6.1 fails. This is only a message discrepance, i.e. not too bad. Leaving resolution of that to Pat and Donal. 2004-11-26 Don Porter * library/auto.tcl (tcl_findLibrary): Made sure the uniquifying operations on the search path does not also normalize. [Bug 1072136] 2004-11-26 Donal K. Fellows * unix/configure.in: Simplify the code to check for correctness of strstr, strtoul and strtod. * unix/tcl.m4 (SC_TCL_CHECK_BROKEN_FUNC): Split a complex stanza out of configure.in into its own function. Also force it to do the right thing with caching of results of AC_TRY_RUN to deal with issue raised in [Patch 1073524] * doc/foreach.n: Added simple example. [FRQ 1073334] 2004-11-25 Donal K. Fellows * generic/tclProc.c (TclObjInterpProc): Make it so that only * generic/tclIndexObj.c (Tcl_WrongNumArgs): [proc] instances do * tests/indexObj.test (indexObj-5.7): quoting of their first arguments, so keeping [Bug 942757] fixed and making [Bug 1066837] be fixed as well. Done with a load of #ifdef-ery because this hack is so ugly nobody should keep it around once Itcl's fixed. 2004-11-25 Reinhard Max * tests/tcltest.test: The order in which [glob] returns the file names is undefined, so tests should not depend on it. 2004-11-25 Zoran Vasiljevic * doc/Thread.3: * doc/Notifier.3: Added changes from the core-8-4-branch 2004-11-25 Donal K. Fellows * doc/dde.n: Synchronized the documentation of the commands with the header of the docs and what the package actually does. Thanks to Andreas Kupries for spotting this. * win/tclWinDde.c (Tcl_DdeObjCmd): Much cleanup of argument parsing code. 2004-11-24 David Gravereaux * generic/tclPort.h: Relative include of tclWinPort.h returned as it was requiring me set -I$(tcl_root)/win for my extensions that need to include tclInt.h and doesn't appear to serve any purpose for windows builds. 2004-11-24 Kevin B. Kenny * unix/tcl.m4 (SC_ENABLE_THREADS): Corrected bad check for 3-argument readdir_r [Bug 1001325]. * unix/configure: Regenerated. * unix/tclUnixNotfy.c: Corrected all uses of 'select' to manage their masks using the FD_CLR, FD_ISSET, FD_SET, and FD_ZERO macros rather than bit-whacking that failed under Solaris-Sparc-64. [Bug 1071807] * win/tclWinInit.c (TclpInitLibraryPath): Removed unused vars 'pathc' and 'pathv' that caused compilation problems on VC++ with --enable-symbols. 2004-11-24 Don Porter * unix/tcl.m4 (SC_ENABLE_THREADS): Corrected failure to determine the number of arguments for readdir_r on SunOS systems. [Bug 1071701] * unix/configure: autoconf-2.57 * generic/tclCmdIL.c (InfoVarsCmd): Corrected segfault in new * tests/info.test (info-19.6): trivial matching branch [Bug 1072654] 2004-11-24 Donal K. Fellows * tools/man2html.tcl, tools/man2html1.tcl: Update to use Tcl 8.4. * tools/man2html2.tcl: Fix broken .SS handling. 2004-11-23 Donal K. Fellows * unix/Makefile.in: Add (commented-out) code to integrate tclConfig.h into the dependency tree and 'make distclean'. [Bug 1068171] * generic/tclResult.c (Tcl_AppendResultVA): Remove call to Tcl_GetStringResult to speed up repeated calls to Tcl_AppendResult with the side effect that code that wants to access interp->result should always call Tcl_GetStringResult first. See [Patch 1041072] discussion for more details. 2004-11-22 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_TCL_64BIT_FLAGS): Define HAVE_TYPE_OFF64_T only when off64_t, open64(), and lseek64() are defined. IRIX 5.3 is known to not include an open64 function. [Bug 1030465] 2004-11-22 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_ENABLE_THREADS): Check for a 2 argument version of readdir_r that is known to exists under IRIX 5.3. * unix/tclUnixThrd.c (TclpReaddir): Use either 2 arg or 3 arg version of readdir_r. [Bug 1001325] 2004-11-22 Don Porter * unix/tclUnixInit.c (TclpInitLibraryPath): Purged dead code that used * win/tclWinInit.c (TclpInitLibraryPath): to extend the "library path". Search path construction for init.tcl is now done within the [tclInit] proc. * generic/tclInterp.c: Restored several directories to the search * tests/unixInit.test: path used to locate init.tcl within [tclInit]. This change does not restore any directories to the encoding search path, so should still avoid the price of an unreasonably large number of filesystem accesses during encoding initialization at startup [Bug 976438] 2004-11-22 Vince Darley * generic/tclPathObj.c: fix and new test for [Bug 1043129] in the * tests/fileSystem.test: treatment of backslashes in file join on Windows. 2004-11-21 Don Porter * doc/AddErrInfo.3: Typo corrections (Thanks Daniel South). * doc/interp.n: 2004-11-19 Don Porter * doc/AddErrInfo.3: Docs for Tcl_(Get|Set)ReturnOptions. [TIP 227] * doc/AddErrInfo.3: * doc/Async.3: Documentation updates to replace references * doc/BackgdErr.3: to global variable ::errorInfo and ::errorCode * doc/SaveResult.3: and to the ::bgerror command with references * doc/after.n: to their preferred replacements, the * doc/bgerror.n: -errorinfo and -errorcode return options, * doc/error.n: the Tcl_*InterpState routines, and the * doc/exec.n: [interp bgerror] command. * doc/exit.n: * doc/fileevent.n: * doc/interp.n: * doc/return.n: * doc/tclvars.n: * doc/update.n: * tests/unixInit.test: Removed "knownBug" constraints to prompt bug fixing before 8.5a2 release. 2004-11-19 Daniel Steffen * macosx/Makefile: * unix/configure.in: * unix/tclUnixInit.c (MacOSXGetLibraryPath): changed detection of tcl framework build when determining tclLibPath from overloaded TCL_LIBRARY to configuration define TCL_FRAMEWORK. [Bug 1068088] * unix/configure: autoconf-2.57 * unix/tclConfig.h.in: autoheader-2.57 2004-11-18 Don Porter * doc/SaveResult.3: Documentation for Tcl_*InterpState (TIP 226). * generic/tclEvent.c (HandleBgErrors): Simplified program flow. * tests/basic.test: Updated functional (not testing) uses of * tests/io.test: [bgerror] to make use of [interp bgerror]. * tests/socket.test: * tests/timer.test: * tests/interp.test (interp-36.*): [interp bgerror] tests. * generic/tclInterp.c: Corrected [interp bgerror] error messages. 2004-11-18 Reinhard Max * unix/tcl.m4 (SC_CONFIG_MANPAGES): Applied an improved version of * unix/configure.in: [Patch 996085], that introduces * unix/Makefile.in: --enable-man-suffix. * unix/installManPage: added * unix/mkLinks.tcl: removed * unix/mkLinks: removed * unix/configure: generated * unix/Makefile.in: Don't install tclConfig.h . 2004-11-17 Don Porter * unix/configure.in: The change below reveals that the public data type Tcl_StatBuf relies on config information. For now, disabled the use of the tclConfig.h file until its full impact on Tcl's interface can be assessed. * unix/configure: autoconf-2.57 * generic/tcl.h: Moved the #include "tclConfig.h" out of * generic/tclInt.h: tcl.h. The config settings are not part of * generic/tclPort.: the public interface, and having it there breaks compiled against uninstalled Tcl and extensions using autoconf-2.5*. 2004-11-16 Jeff Hobbs * unix/tclUnixChan.c (TtySetOptionProc): fixed crash configuring -ttycontrol on a channel. [Bug 1067708] 2004-11-16 Don Porter * generic/tclIOUtil.c (TclFSEpochOk): There were two code paths via which the thread copy of filesystemEpoch could be synched with the master copy, but only one kept the filesystem list cache up to date. Fix routes everything through a single code path. [Bug 1035775]. 2004-11-16 Donal K. Fellows * unix/tcl.m4 (SC_CONFIG_CFLAGS): Stop architecture flags to 'ld' from getting lost when [load] is disabled. [Bug 1016796] 2004-11-16 Daniel Steffen * generic/tcl.h: * unix/configure.in: changed HAVE_CONFIG_H to HAVE_TCL_CONFIG_H. * unix/configure: autoconf-2.57 2004-11-15 Don Porter * generic/tclInt.h: Added comment warning that the old ERR_IN_PROGRESS and ERROR_CODE_SET flag values should not be re-used for the sake of those extensions that have accessed them. * generic/tclCmdMZ.c (Tcl_TraceObjCmd): Fixed Bug 1065378 which failed * tests/trace.test (trace-33.1): to permit a variable trace created with [trace variable] to be destroyed with [trace remove]. Thanks to Keith Vetter for the report. 2004-11-15 Donal K. Fellows * doc/tclvars.n: Added section to documentation on global variables that are specific to tclsh and wish. [Patch 1065732] 2004-11-12 Jeff Hobbs * generic/tclEncoding.c (TableFromUtfProc): correct crash condition when TCL_UTF_MAX == 6. [Bug 1004065] 2004-11-12 Donal K. Fellows * doc/interp.n: Basic documentation of the TIP#221 API. 2004-11-12 Don Porter TIP #221 IMPLEMENTATION * generic/tclBasic.c: Define [::tcl::Bgerror] in new interps. * generic/tclEvent.c: Update Tcl_BackgroundError to make use of the registered [interp bgerror] command. * generic/tclInterp.c: New [interp bgerror] subcommand. * tests/interp.test: syntax tests updated. TIP #226 IMPLEMENTATION * generic/tcl.decls: Stubs for Tcl_(Save|Restore|Discard)InterpState * generic/tcl.h: New public opaque type, Tcl_InterpState. * generic/tclInt.h: Drop old private declarations. Add Tcl(Get|Set)BgErrorHandler * generic/tclResult.c: Tcl_*InterpState implementations. * generic/tclDictObj.c: Update callers. * generic/tclIOGT.c: * generic/tclTrace.c: TIP #227 IMPLEMENTATION * generic/tcl.decls: Stubs for Tcl_(Get|Set)ReturnOptions. * generic/tclInt.h: Drop old private declarations. * generic/tclResult.c: Tcl_*ReturnOptions implementations. * generic/tclCmdAH.c: Update callers. * generic/tclMain.c: * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: * unix/tclAppInit.c: Removed tclConfig.h #include, now that tcl.h takes care of it for us. * generic/tclInt.h: Moved verification of ptrdiff_t typedef from * generic/tclExecute.c: multiple .c files into one common header where * generic/tclVar.c: it is verifiably after tclConfig.h inclusion. 2004-11-12 Daniel Steffen * generic/tcl.h: * generic/tclInt.h: * unix/Makefile.in: include tclConfig.h from tcl.h and install it as a public header. Normalized compiler include path order to -I${BUILD_DIR} -I${UNIX_DIR} -I${GENERIC_DIR}. * unix/dltest/Makefile.in: add ${BUILD_DIR}/.. to include path to pick up tclConfig.h. * unix/tclUnixInit.c: moved check for HAVE_CFBUNDLE define after #include "tclInt.h" to ensure tclConfig.h has been included. 2004-11-12 Reinhard Max * unix/config.h.in: * unix/tclConfig.h.in: renamed * unix/Makefile.in: Completed support for config header, * unix/configure.in: fixed building outside of the unix dir, * unix/tclAppinit.c: and reflected the name change of config.h. * generic/tclInt.h: * unix/configure: generated 2004-11-12 Donal K. Fellows * unix/config.h.in: Allow configure to put all the C #defs into * unix/configure.in: a file (called config.h) so that Unix builds * unix/tcl.m4: now take far fewer lines of scrollback to * unix/Makefile.in: proceed (making it less likely that any errors * generic/tclInt.h: or warnings will get missed). * unix/tclAppInit.c: Part of the TIP#34 upgrades. * unix/tcl.m4, unix/tclUnixPort.h: Check for pthread_attr_get_np in before forcing the use of to make things work on NetBSD 2.0. [Bug 1064882] * doc/binary.n, doc/upvar.n: More minor fixes. 2004-11-12 Daniel Steffen * doc/CrtChannel.3: * doc/Interp.3: * doc/Limit.3: * doc/binary.n: * doc/dict.n: * doc/tm.n: * doc/upvar.n: fixed *roff errors uncovered by running 'make html'. * tools/tcltk-man2html.tcl: added faked support for bullet point lists, i.e. *nroff ".IP \(bu" syntax. 2004-11-11 Daniel Steffen * tests/fCmd.test: * unix/tclUnixFCmd.c (TraverseUnixTree): added option to rewind() the readdir() loop whenever the source hierarchy has been modified by traverseProc (e.g. by deleting files); this is required to ensure complete traversal of the source hierarchy on certain filesystems like HFS+. Added test for failing recursive delete on Mac OS X that was due to this. [Bug 1034337] * generic/tclListObj.c (Tcl_ListObjReplace): use memmove() instead of manual copy loop to shift list elements. Decreases time spent in Tcl_ListObjReplace() from 5.2% to 1.7% of overall runtime of tclbench on a ppc 7455 (i.e. 200% speed increase). [Patch 1064243] * generic/tclHash.c: hoisted some constant pointer dereferences out of loops to eliminate redundant loads that the gcc optimizer didn't deal with. Decreases time spend in Tcl_FindHashEntry() by 10% over a full run of the tcl testuite on a ppc 7455. [Patch 1064243] * tests/fileName.test: * tests/fileSystem.test: * tests/io.test: * tests/msgcat.test: * tests/tcltest.test: * tests/unixInit.test: fixed bugs causing failures when running tests with -tmpdir arg not set to working dir. * macosx/Makefile: corrected path to html help inside framework. Prevent parallel make from building several targets at the same time. * macosx/tclMacOSXFCmd.c (struct fileinfobuf): force struct to be packed to prevent failures when builing with -malign=natural. 2004-11-10 Andreas Kupries * unix/tclUnixChan.c: [Bug 727786]. Exterminated the code marked DEPRECATED. This code has not been used in over a year now, and we have no complaints. 2004-11-08 David Gravereaux * win/tclWinPipe.c: The pipe channel driver now respects the -blocking option when closing is the same way the UNIX side works. This is to avoid a hung shell when exiting due to open pipes that refuse to close in a graceful manner. * doc/open.n: Added a note about -blocking 0 and lack of exit status as it had never been documented. [Bug 947693] ***POTENTIAL INCOMPATIBILITY*** Scripts that use async pipes on windows, must (like the UNIX side) set -blocking to 1 before calling [close] to receive the exit status. 2004-11-07 David Gravereaux * tests/winFile.test: added contraint to winFile-4.0 to prevent it being run on NT4 [Bug 981829] 2004-11-05 Donal K. Fellows * tests/reg.test: Major reorganization so that this file is much easier for a normal Tcl maintainer to comprehend. The test flags are still very cryptic, but they appear to have to be that way. The number of skipped tests has increased, but now the skipped tests have much more meaningful content. * tests/tm.test (genpaths): Add a [file normalize] so we pick up Windows drive letters, etc. [Bug 1053568] 2004-11-04 Don Porter * changes: Updates toward an 8.5a2 release. 2004-11-03 Kevin B. Kenny * library/clock.tcl (FreeScan): Fixed a bug where scanning "Monday" with a base time other than midnight incorrectly carried the base time forward. * test/clock.test (clock-33.{5,5a}): Made the test failure more informative. * tests/clock.test (clock-34.{28,44,45,46}): Removed 'knownBug' constraints from tests that no longer fail. Thanks to Don Porter for reporting these. 2004-11-03 David Gravereaux * generic/tcl.h: Moved the preprocessor logic * generic/tclDecls.h: from tclInt.h of setting the * generic/tclInt.h: TCL_STORAGE_CLASS macro to the * generic/tclIntDecls.h: tcl*Decls.h files now that no * generic/tclIntPlatDecls.h: use of EXTERN is left in tclInt.h. * generic/tclPlatDecls.h: Proto for Tcl_Main moved in tcl.h * win/tclWinPort.h: to prior the inclusion of the Stubs headers as they are now resetting TCL_STORAGE_CLASS. Removed extraineous reset from tclWinPort.h. [Patch 1055668] * generic/tclCompile.h: Removed extrainious reset of TCL_STORAGE_CLASS missed in my last edit. 2004-11-03 Don Porter * library/init.tcl ([unknown]): Corrections to the 2004-10-25 mods to Aunt ??? in [unknown]. Flaws revealed by Itcl test suite, which still apparently relies on this brokenness. Also added comment suggesting the error message that any code using this hack *ought* to receive in reply. * generic/tclTrace.c (TclCallVarTraces): Improved ability to debug * tests/incr-old.test (incr-old-2.6): errors during variable * tests/incr.test (incr-{1,2}.28): traces by preserving the * tests/set.test (set-{2,4}.4): -errorinfo data. * tests/trace.test (trace-33.1): [Bug 527164] 2004-11-02 David Gravereaux * generic/tclInt.h: added a check for #ifdef __cplusplus around the #define of MODULE_SCOPE. About the only time it would be problem is when someone is statically linking to Tcl and accessing internals from a C++ file and has name mangling issues from the lack of "C" after 'extern' [Patch 1055668]. * generic/tclCompile.h: Exchanged use of the EXTERN macro to the new MODULE_SCOPE macro. Lowered exported internals count by 35. [Patch 1055668] * win/tclWinInt.h: * win/tclWinPort.h: exported internals dropped by a count of 14. * generic/tclFileSystem.h: Added use of MODULE_SCOPE on protos. * generic/tclRegexp.h: manipulating TCL_STORAGE_CLASS unnecessary. 2004-11-02 Don Porter * library/tcltest/tcltest.tcl: Corrected some misleading * tests/tcltest.test (tcltest-26.1,2): displays of ::errorInfo and ::errorCode information when the -setup, -body, and/or -cleanup scripts return an unexpected return code. Thanks to Robert Seeger for the fix. [RFE 1017151]. 2004-11-02 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Improved version of the NaN fix from Miguel Sofer. [Bug 761471] 2004-11-02 Kevin Kenny * library/tzdata/America/Cuiaba: Change to DST rules for * library/tzdata/America/Havana: autumn of 2004. [ftp://elsie.nci.nih.gov/pub/tzdata2004g.tar.gz] * tools/tclZIC.tcl: Updated to be compatible with recent changes in library/clock.tcl. 2004-11-02 Vince Darley * win/tclWinFile.c: Simplify TclpUtime to use Tcl_FSGetNativePath, and add comments. 2004-11-02 Donal K. Fellows * generic/tclInt.h: Change uses of EXTERN to MODULE_SCOPE (defined in this file too to be 'extern' if not overridden) as nothing declared in tclInt.h is supposed to be visible outside the Tcl core. If there *is* anything that extensions are actually using, we can open this up later on. [Patch 1055668] * doc/CrtChannel.3 (Tcl_GetChannelMode): Add synopsis. [Bug 1058446] 2004-11-01 Kevin B. Kenny * win/tclWinFile.c (FromCTime, TclpUtime): Replaced a call to the Posix 'utime' function with calls to Windows-API equivalents, to avoid a bug where the VC++ versions misconvert times across a Daylight Saving Time boundary. [Bug 926106] * win/tclWinInt.h (TclWinProcs): * win/tclWin32Dll.c (asciiProcs, unicodeProcs): Removed now-unused reference to 'utime'. * tests/cmdAH.test (cmdAH-24.12): Added test case for the above bug. 2004-11-01 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Make INST_EQ and friends handle NaN correctly in all cases. [Bug 761471] * generic/tclNamesp.c (NamespaceInscopeCmd): Make the error message generation the same as in NamespaceEvalCmd(). (Tcl_Import): Rationalized to use Tcl_EvalObjv(). 2004-10-31 Donal K. Fellows * tests/io.test (io-40.3): Convert umask2 test constraint into a form that most people will be able to satisfy. * tests/cmdAH.test (cmdAH-8.45): Removed broken test constraint. It didn't do what it was intended to do, and it implied the other correct constraint. [Bug 1053908] * generic/tclCmdIL.c (InfoGlobalsCmd): * tests/info.test (info-8.4): Strip leading global-namespace specifiers from the pattern argument. [Bug 1057461] 2004-10-30 Kevin Kenny * generic/clock.c: Replaced WIN32 macro with __WIN32__. [Bug 1054357]. Thanks to David Gravereaux for the patch. * win/tclWinFile.c: Removed a long-standing bug that causes incorrect conversion between file time and UTC time if the file time is recorded in a different Daylight Saving Time status than the current one. [Bug 926106] 2004-10-29 Don Porter * library/tcltest/tcltest.tcl: Correct reaction to errors in the obsolete processCmdLineArgsHook. [Bug 1055673] * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.7 * unix/Makefile.in: * tests/all.tcl: Update to use [tcltest::configure]. 2004-10-29 Donal K. Fellows * library/tm.tcl (::tcl::tm::*): Use the core proc engine to generate the wrong-num-args error messages for the path ensemble. Ensembles can now (sometimes) rewrite the error messages of their subcommands so they appear more like the arguments that the user passed to the ensemble. Below is a description of changes involved in doing this. * tests/namespace.test (namespace-50.*): Tests of ensemble subcommand error message rewriting. * generic/tclProc.c (TclObjInterpProc): Make procedures implement their wrong-num-args message using Tcl_WrongNumArgs instead of something baked-at-home. * generic/tclNamesp.c (TclIsEnsemble, NsEnsembleImplementationCmd): Added test of ensemble-hood (available to rest of core) and made ensembles set up the rewriting for Tcl_WrongNumArgs to take advantage of. * generic/tclInt.h (Interp.ensembleRewrite): Extra fields. * generic/tclIndexObj.c (Tcl_WrongNumArgs): Add knowledge of what is going on in ensembles' command rewriting so this command can generate the right error message itself. * generic/tclBasic.c (Tcl_CreateInterp, TclEvalObjvInternal): Added code to initialize (as empty) the rewriting fields and reset them when we leak outside an ensemble implementation. 2004-10-28 Miguel Sofer * generic/tclExecute.c (INST_START_CMD): * tests/execute.test (execute-8.3): fix for execution stack corruption [Bug 1055676]. Credit dgp for detective work and fix. 2004-10-27 Don Porter * tests/socket.test (socket-13.1): Balanced [makeFile] and [removeFile] commands. * tests/clock.test: Correct duplicate test names. * tests/namespace.test: * tests/string.test: * tests/io.test (io-50.4): Use namespace variables. 2004-10-27 David Gravereaux * generic/tclInt.decls: The following 9 functions were moved from * generic/tclInt.h: tclInt.h to the private/int Stubs table for * generic/tclIntDecls.h: use by the test suite. As tclTest.obj is * generic/tclStubInit.c: linked to the shell, these functions need "blessed" status so as to always be exported from the library. Being placed in the Stubs table guarantees this [Bug 1054748]: TclpObjRemoveDirectory, TclpObjCopyDirectory, TclpObjCreateDirectory, TclpObjDeleteFile, TclpObjCopyFile, TclpObjRenameFile, TclpObjStat, TclpObjAccess, TclpOpenFileChannel * tests/registry.test: Fixed test files to load the correct * tests/winDde.test: registry and dde packages by using the info * win/Makefile.in: from makefiles to tell tcltest where to load * win/makefile.vc: them from. This avoids grabbing the wrong package from $auto_path which might be the install point rather than the dev location. Kudos to Jennifer Hom for adding -load and -loadfile to the tcltest package. [Bug 926088] * win/tclWinThrd.c (TclFinalizeLock): release the critical section before deleting it. [Bug 731778] * generic/tcl.h: Removed the file level 'extern "C" {' and the coresponding closing block as it serves no purpose given that all the function prototypes have the proper extern usage already. * unix/tclAppInit.c: When built as tcltest, TclThread_Init was * win/tclAppInit.c: getting called twice. First by Tcltest_Init, then again in Tcl_AppInit. The call from Tcl_AppInit is now removed. 2004-10-27 Andreas Kupries * tests/tm.test: Expanded on the testsuite entered by Donal. * library/tm.tcl: Even found bugs, these have been corrected. 2004-10-26 Kevin Kenny * tests/format.test (format-19.1): Additional regression test for [Bug 868489]. 2004-10-27 Donal K. Fellows * doc/*.n: Many small general documentation fixes. 2004-10-26 David Gravereaux * generic/tclPipe.c (TclCleanupChildren): bad cast of resolvedPid caused PIDs on win95 to go negative. winpipe-4.2 brought this to the surface. Fixed with sprintf in place of TclFormatInt. Thanks to hgiese [Patch 767676] 2004-10-26 Andreas Kupries * library/tm.tcl (::tcl::tm::Defaults): Added a second [file dirname] around the location of the executable. This fixes [Bug 1038705]. Instable of a bogus "foo/bin/lib" we now have the correct "foo/lib" as a base path for modules. 2004-10-26 Don Porter * generic/tclParse.c (Tcl_SubstObj): Fix for failed subst-12.3 test * tests/subst.test (subst-12.3-5): More tests for Bug 1036649. * unix/Makefile.in (install-libraries): Updated the installation of the http, msgcat, and tcltest packages to install as Tcl Modules on Unix systems. Other platform Makefiles still need updating. [Patch 1054370] * tests/basic.test: Added missing constraints. * tests/compile.test: * tests/fileSystem.test: * tests/init.test (init-2.8): Updated to not rely on http package. 2004-10-26 Miguel Sofer * generic/tclInt.h: * generic/tclVar.c: removed more direct references to the VAR flags, replaced with access macros. 2004-10-26 Donal K. Fellows * doc/expr.n: Clarified that non-num/non-bool literals require quoting. [Bug 1027849]. Also listed booleans as acceptable values. 2004-10-26 Kevin B. Kenny * library/clock.tcl (FreeScan): Fixed a bug that caused relative days of the week in free-form [clock scan] to be evaluated in the wrong time zone. * tests/clock.test (clock-31.[456]): Made sure that there isn't an env(TZ) or env(TCL_TZ) lying around that will override the time zone that we're trying to establish with the simulated registry. Both problems reported as [Bug 1054101]. 2004-10-25 Donal K. Fellows * doc/string.n (map): Rewrote to clarify that we don't just map single characters. [Bug 1048005] * doc/info.n (procs): Clarified that the pattern argument may have namespace separators in it. [Bug 1047928] * tests/cmdAH.test (cmdAH-8.45): Simplify in the hope that the reasons for [Bug 1053908] will become clearer. 2004-10-25 Don Porter * generic/tclExecute.c (IllegalExprOperandType,TclExecuteByteCode): Removed several DECACHE_INFO/CACHE_INFO pairs that are no longer needed for protection because routines like Tcl_SetErrorCode() and Tcl_AddErrorInfo() can no longer re-enter bytecode execution. * generic/tclResult.c (TclProcessReturn): Bug fix. Be sure that a missing -errorinfo option when code == TCL_ERROR causes the errorInfo field to get reset. * tests/thread.test (thread-4.4): Test depended on a ::errorInfo value initialized to "". Added code to test to setup that requirement. * library/auto.tcl: Purged Tcl's script library of all * library/clock.tcl: remaining references to global vars * library/init.tcl: ::errorInfo and ::errorCode. * generic/tclMain.c (Tcl_Main): Updated to make use of TclGetReturnOptions instead of ::errorInfo variable. * generic/tclInterp.c (tclInit): Bug fix. Access dict variables with [dict get], not array syntax. 2004-10-25 Donal K. Fellows * tests/tm.test: Rewrote the tests to actually perform syntax checks on the public API. Added a new test (currently failing) to indicate that the test suite is not complete yet. * library/tm.tcl (path): Rewrote to turn this command into an ensemble to make it faster and simpler. 2004-10-24 Miguel Sofer * generic/tclCmdIL.c: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclTrace.c: defined new macros to get/set the flags of variables. The only files that still access the flag values directly are tclCompCmds.c, tclCompile.c, tclProc.c and tclVar.c 2004-10-24 Don Porter * generic/tclBasic.c (Tcl_LogCommandInfo,Tcl_AddObjErrorInfo): Shift the initialization of errorCode to NONE to more central location. * generic/tclEvent.c (BgError,Tcl_BackgroundError,HandleBgErrors): Rewrite to build on the new TclGet/SetReturnOptions routines. * generic/tclResult.c (TclGetReturnOptions): Add call to Tcl_AddObjErrorInfo to be sure error fields are initialized. * generic/tclResult.c (TclTransferResult): Rewrite to build on the new TclGet/SetReturnOptions routines. 2004-10-22 Donal K. Fellows * doc/tm.n: Tightened up the documentation. * tests/tm.test: Created (with partially dummy content) so TIP#189 can be marked Final. * generic/tclNamesp.c (NsEnsembleImplementationCmd): Make ensembles cut their implementations out of error traces. This is the right thing to do more often than not. 2004-10-22 Kevin B. Kenny * library/clock.tcl: Fixed a typo where the fallback time zone became ::localtime instead of :localtime. Fixed a bug where time zone names containing hyphens could not be loaded. * tests/clock.test: Added regression test cases that covers both bugs. Thanks to Todd M. Helfter for finding these bugs. 2004-10-22 Donal K. Fellows * generic/tclExecute.c (TclCompEvalObj, Tcl_ExprObj): * generic/tclProc.c (TclProcCompileProc): Always call object freeIntRepProc's in the same way. 2004-10-22 Miguel Sofer * generic/tclVar.c: fixed bug in commit of 2004-07-23, which was causing a leak of Proc structures and failure of compile-12.1. Two lines were 'zombies' from the previous way localVarNames worked. Credit dgp for finding this. 2004-10-21 Don Porter * generic/tclInt.h (Interp): * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp): * generic/tclResult.c (GetKeys,ReleaseKeys,etc.): Moved the key values of the return options dictionary out of private fields of the Interp struct and into thread-static values managed in tclResult.c. * generic/tclCmdAH.c (Tcl_CatchObjCmd, Tcl_ErrorObjCmd): Updated to call the new TclGet/SetReturnOptions routines to do much of their work. * generic/tclInt.h (TclGetReturnOptions,TclSetReturnOptions): * generic/tclResult.c (TclGetReturnOptions,TclSetReturnOptions): New utility routines to get/set the return options of an interp. Intent is that these routines will be converted to public routines after TIP approval. * generic/tclCmdMZ.c (TclProcessReturn,TclMergeReturnOptions): * generic/tclResult.c (TclProcessReturn,TclMergeReturnOptions): Move internal utility routines from tclCmdMZ.c to tclResult.c. * generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp): * generic/tclResult.c (TclTransferResult): Rework so that iPtr->returnOpts can be NULL when there are no special options. * generic/tclResult.c (TclRestoreInterpState): Plug potential memory leak. 2004-10-21 Kevin B. Kenny * generic/tclBasic.c: Various changes to [clock format] that, * generic/tclClock.c: together, make it roughly twice as fast * generic/tclInt.h: while all tests in the test suite * library/clock.tcl: continue to pass. 2004-10-20 Andreas Kupries * win/Makefile.in (install-msgs): Fixed a problem with the * win/Makefile.in (install-tzdata): installation of timezone data and message catalogs. They used the installed tcl library directory, not the source library. Before it was installed. Switched to source lib dir. Thanks to Kevin for the help in figuring this out. 2004-10-20 Don Porter * generic/tclThreadTest.c (ThreadEventProc): Corrected subtle bug where the returned (char *) from Tcl_GetStringResult(interp) continued to be used without copying or refcounting, while activity on the interp continued. That's not safe, and recent changes demonstrated the lack of safety with failing tests thread-4.3 and thread-4.5. 2004-10-19 Donal K. Fellows * generic/tclDictObj.c (DictWithCmd): Make sure all paths (that are not themselves error paths) do not lose the result code. 2004-10-19 Don Porter * generic/tclInt.h (Tcl*InterpState): New internal routines * generic/tclResult.c (Tcl*InterpState): TclSaveInterpState, TclRestoreInterpState, and TclDiscardInterpState are superior replacements for Tcl_(Save|Restore|Discard)Result. Intent is that these routines will be converted to public routines after TIP approval. Interfaces for these routines were shamelessly stolen from Itcl. * generic/tclBasic.c (TclEvalObjvInternal): * generic/tclDictObj.c (DictUpdateCmd, DictWithCmd): * generic/tclIOGT.c (ExecuteCallback): * generic/tclTrace.c (Trace*Proc,TclCheck*Traces,TclCallVarTraces): Callers of Tcl_*Result updated to call the new routines. The calls were relocated in several cases to perform save/restore operations only when needed. * generic/tclEvent.c (HandleBgErrors): * generic/tclFCmd.c (CopyRenameOneFile): Calls to Tcl_*Result that were eliminated because they appeared to serve no useful purpose, typically saving/restoring an error message, only to throw it away. 2004-10-18 Don Porter * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp): * generic/tclCmdAH.c (Tcl_CatchObjCmd): * generic/tclCmdMZ.c (TclMergeReturnOptions,TclProcessReturn): * generic/tclCompCmds.c (TclCompileReturnCmd): * generic/tclExecute.c (TclCompEvalObj): * generic/tclInt.h (Interp): * generic/tclProc.c (TclUpdateReturnInfo): Place primary storage of the -level and -code information in private fields of the Interp struct, rather than in a DictObj. This should significantly improve performance of TclUpdateReturnInfo. 2004-10-17 Miguel Sofer * generic/tclResult.c: removed unused variable [Bug 1048588]. Thanks to Daniel South. 2004-10-15 Don Porter * generic/tclCmdMZ.c (TclProcessReturn): Now that primary * generic/tclProc.c (TclUpdateReturnInfo): storage for the errorInfo and errorCode values are internal fields, we can set them at the time of the [return] command, and not have to wait until the specified number of "-level"s have popped. * generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp) (TclEvalObjvInternal, Tcl_LogCommandInfo, TclAddObjErrorInfo): * generic/tclCmdAH.c (Tcl_CatchObjCmd): * generic/tclEvent.c (BgError, ErrAssocData, Tcl_BackgroundError) (HandleBgErrors, BgErrorDeleteProc): * generic/tclExecute.c (TclCreateExecEnv, TclDeleteExecEnv): * generic/tclIOUtil.c (comments only): * generic/tclInt.h (ExecEnv,Interp, ERR_IN_PROGRESS): * generic/tclInterp.c ([tclInit]): * generic/tclMain.c (comments only): * generic/tclNamesp.c (Tcl_CreateNamespace, Tcl_DeleteNamespace) (TclTeardownNamespace): * generic/tclProc.c (TclUpdateReturnInfo): * generic/tclResult.c (Tcl_ResetResult, TclTransferResult): * generic/tclTrace.c (CallVarTraces): Reworked management of the "errorInfo" data of an interp. That information is now primarily stored in a new private (Tcl_Obj *) field of the Interp struct, rather than using a global variable ::errorInfo as the primary storage. The ERR_IN_PROGRESS flag bit value is no longer required to manage the value in its new location, and is removed. Variable traces are established to support compatibility for any code expecting the ::errorInfo variable to hold the information. ***POTENTIAL INCOMPATIBILITY*** Code that sets traces on the ::errorInfo variable may notice a difference in timing of the firing of those traces. Code that uses the value ERR_IN_PROGRESS. 2004-10-14 Donal K. Fellows TIP#217 IMPLEMENTATION * generic/tclCmdIL.c (Tcl_LsortObjCmd): Add -indices option from James Salsman. [Patch 1017532] * generic/tclUtil.c (TclMatchIsTrivial): Detect degenerate cases of glob matching that let us avoid scanning through hash tables. * generic/tclCmdIL.c (InfoCommandsCmd, InfoGlobalsCmd, InfoProcsCmd): (InfoVarsCmd): Use this to speed up some [info] subcommands. 2004-10-12 Kevin B. Kenny * library/tzdata/America/Campo_Grande: * library/tzdata/America/Cuiaba: * library/tzdata/America/Sao_Paulo * library/tzdata/America/Argentina/Mendoza: * library/tzdata/America/Argentina/San_Juan: Synchronized to Olson's 'tzdata2004e'. 2004-10-08 Donal K. Fellows TIP#201 AND TIP#212 IMPLEMENTATIONS * doc/dict.n, doc/expr.n: Documentation for new functionality. * tests/expr.test: Basic tests of 'in' and 'ni' behaviour. * tests/dict.test (dict-21.*,dict-22.*): Tests for [dict update] and [dict with]. * generic/tclExecute.c (TclExecuteByteCode): Implementation of the INST_LIST_IN and INST_LIST_NOT_IN bytecodes. * generic/tclParseExpr.c (GetLexeme): Parse the 'in' and 'ni' operators for TIP#201. * generic/tclDictObj.c (DictUpdateCmd,DictWithCmd): Core of implementation of TIP#212; docs and tests still to do... 2004-10-07 Don Porter * generic/tclTest.c (TestsetobjerrorcodeCmd): Simplified. 2004-10-07 Vince Darley * generic/tclFileName.c: * generic/tclFileSystem.h: * generic/tclIOUtil.c: * generic/tclPathObj.c: * unix/tclUnixFile.c: * win/tclWinFile.c: * tests/fileName.test: * tests/winFCmd.test: code reorganization for better generic/platform code splitting [Bug 925620] removing the need for several #ifdef's, and tests and fix for an unreported Windows glob problem ('glob -dir C: -tails *'). 2004-10-07 Donal K. Fellows * *.3: Convert CONST to const and VOID to void so we document how people should actually use the Tcl API and not the compatibility hacks that it has to have. * doc/man.macros, *.3: Update .AS macro so it can know how wide to make the third column of the argument list. Update documentation for C API (only users) to take advantage of this. * doc/FileSystem.3: Formatting fixes for greater documentation clarity. 2004-10-06 Donal K. Fellows * generic/tclFileName.c (DoGlob, TclGlob): Stop messy sharing of interpreter result and instead use a private object for collecting the result of the glob. This simplifies TclGlob quite a lot. * generic/tclIOUtil.c (Tcl_FSMatchInDirectory): Simplify by removing some nesting. Also standardize variable names. (FsAddMountsToGlobResult): Force updates to the list to be done in-place, putting a side-condition of non-shared-ness on the resultPtr argument to Tcl_FSMatchInDirectory, but everything would have broken before if that was shared *anyway*. * generic/tclEncoding.c (LoadTableEncoding): Removed reference to Tcl interpreter; it wasn't needed as direct object use is more efficient. * generic/tclPathObj.c: Made this file follow the style rules in the Engineering Manual more closely, and also take advantage of the internal object manipulation macros more. * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reorganized to have fewer magic flag variables and to separate the code that scans for a match from the code that processes a match body. 2004-10-06 Don Porter * generic/tclBasic.c: * generic/tclBinary.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclCompExpr.c: * generic/tclDictObj.c: * generic/tclEncoding.c: * generic/tclExecute.c: * generic/tclFCmd.c: * generic/tclHistory.c: * generic/tclIndexObj.c: * generic/tclInterp.c: * generic/tclIO.c: * generic/tclIOCmd.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclPkg.c: * generic/tclResult.c: * generic/tclScan.c: * generic/tclTimer.c: * generic/tclTrace.c: * generic/tclUtil.c: * generic/tclVar.c: * unix/tclUnixFCmd.c: * unix/tclUnixPipe.c: * win/tclWinDde.c: * win/tclWinFCmd.c: * win/tclWinPipe.c: * win/tclWinReg.c: It is a poor practice to directly set or append to the value of the objResult of an interp, because that value might be shared, and in that circumstance a Tcl_Panic() will be the result. Searched for example of this practice and replaced with safer alternatives, often using the Tcl_AppendResult() routine that dkf just rehabilitated. * library/dde/pkgIndex.tcl: Bump to dde 1.3.1 * library/reg/pkgIndex.tcl: Bump to registry 1.1.5 2004-10-06 Donal K. Fellows * doc/SetResult.3: Made Tcl_AppendResult non-deprecated; better that people use it than most of the common alternatives! * generic/tclResult.c (Tcl_AppendResultVA): Make this work better with Tcl_Objs. [Patch 1041072] (Tcl_SetResult, Tcl_AppendElement): Change string to stringPtr to avoid C++ keywords. 2004-10-05 Don Porter * generic/tclBasic.c (TclObjInvoke): More simplification of the TclObjInvoke routine toward unification with the rest of the evaluation stack. * generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp) (TclEvalObjvInternal, Tcl_LogCommandInfo): * generic/tclCmdAH.c (Tcl_CatchObjCmd): * generic/tclEvent.c (BgError, Tcl_BackgroundError, HandleBgErrors): * generic/tclInt.h (Interp, ERROR_CODE_SET): * generic/tclNamesp.c (Tcl_CreateNamespace, Tcl_DeleteNamespace) (TclTeardownNamespace): * generic/tclResult.c (Tcl_ResetResult, Tcl_SetObjErrorCode) (TclTransferResult): * generic/tclTrace.c (CallVarTraces): Reworked management of the "errorCode" data of an interp. That information is now primarily stored in a new private (Tcl_Obj *) field of the Interp struct, rather than using a global variable ::errorCode as the primary storage. The ERROR_CODE_SET flag bit value is no longer required to manage the value in its new location, and is removed. Variable traces are established to support compatibility for any code expecting the ::errorCode variable to hold the information. ***POTENTIAL INCOMPATIBILITY*** Code that sets traces on the ::errorCode variable may notice a difference in timing of the firing of those traces. * generic/tclNamesp.c (Tcl_PopCallFrame): Removed Bug 1038021 workaround. That bug is now fixed. 2004-10-04 Kevin B. Kenny * tests/clock.test (clock-34.*): Removed an antibug that forced comparison of [clock scan] results with the :localtime time zone. Now that [clock scan] uses the current time zone instead, the antibug caused several tests to fail. [Bug 1038554] 2004-10-04 Donal K. Fellows * generic/tclParseExpr.c (GetLexeme): Ensure that the 'eq' and 'ne' operators are followed by non-alphabetic characters so lexemes can't run together. [Bug 884830] * doc/DictObj.3, doc/dict.n: Clarified that a dictionary is not order-preserving. [Bug 1032243] Also added another example to show off more ways of using a dictionary and a few other formatting improvements. 2004-10-02 Donal K. Fellows * generic/tclDictObj.c (TraceDictPath, Tcl_DictObjPutKeyList): Add support for automatic creation of dictionary paths since that is what everyone seems to actually expect of the API! [Bug 1037235] (Tcl_DictObjNext): Make calling this after Tcl_DictObjDone non-fatal as that simplifies a number of internal APIs. This doesn't break any existing working code as it is a case which previously caused a panic. 2004-10-02 Don Porter * tests/namespace.test (namespace-8.7): Another test for save/restore of ::errorInfo and ::errorCode during global namespace teardown. 2004-10-01 Donal K. Fellows * generic/tclProc.c (TclObjGetFrame, Tcl_UplevelObjCmd): * generic/tclVar.c (Tcl_UpvarObjCmd): Cache stackframe level references in the level object for speed. 2004-09-30 Don Porter * generic/tclBasic.c (Tcl_CreateInterp): * generic/tclInt.h (Interp): Removed the flag bit value EXPR_INITIALIZED. It was set during interp creation and never tested. Whatever purpose it had is in the past. * generic/tclBasic.c (Tcl_EvalObjEx): Removed the flag bit value * generic/tclInt.h (Interp): USE_EVAL_DIRECT. It was used * generic/tcLTest.c (TestevalexObjCmd): only in the testing command * tests/parser.test (parse-9.2): [testevalex] and nothing in the test suite made use of the capability it enabled. * generic/tclBasic.c (Tcl_AddObjErrorInfo): More re-organization * generic/tclCmdAH.c (Tcl_ErrorObjCmd): of the management of * generic/tclCmdMZ.c (TclProcessReturn): the errorCode value. * tests/error.test (error-6.4-9): * generic/tclNamespace.c (TclTeardownNamespace): Tcl_Obj-ified * tests/namespace.test (namespace-8.5,6): the save/restore of ::errorInfo and ::errorCode during global namespace teardown. Revised the comment to clarify why this is done, and added tests that will fail if this is not done. * generic/tclResult.c (TclTransferResult): Added safety checks so that unexpected undefined ::errorInfo or ::errorCode will not lead to a segfault. * generic/tclTrace.c (TclCallVarTraces): Save/restore the flag values * tests/var.test (var-16.1): that define part of the interpreter state during variable traces. [Bug 1038021]. 2004-09-30 Miguel Sofer * tests/subst.test (12.1-2): added tests for [Bug 1036649] 2004-09-29 Don Porter * tests/basic.test (49.*): New tests for TCL_EVAL_GLOBAL. 2004-09-29 Donal K. Fellows * generic/tclVar.c (TclObjLookupVar, TclObjLookupVar): (TclObjUnsetVar2, SetArraySearchObj): * generic/tclUtil.c (SetEndOffsetFromAny): * generic/tclStringObj.c (Tcl_SetStringObj): (Tcl_SetUnicodeObj, SetStringFromAny): * generic/tclResult.c (ResetObjResult): * generic/tclRegexp.c (Tcl_GetRegExpFromObj): * generic/tclPathObj.c (TclFSMakePathRelative, SetFsPathFromAny): (TclFSMakePathFromNormalized, Tcl_FSNewNativePath): * generic/tclObj.c (TclFreeObj, Tcl_SetBooleanObj, SetBooleanFromAny): (Tcl_SetDoubleObj, SetDoubleFromAny, Tcl_SetIntObj): (SetIntOrWideFromAny, Tcl_SetLongObj, SetWideIntFromAny): (Tcl_SetWideIntObj, TclSetCmdNameObj, SetCmdNameFromAny): * generic/tclNamesp.c (SetNsNameFromAny, MakeCachedEnsembleCommand): * generic/tclListObj.c (Tcl_SetListObj, SetListFromAny): * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): * generic/tclDictObj.c (SetDictFromAny): * generic/tclCompile.c (TclInitByteCodeObj): * generic/tclBinary.c (Tcl_SetByteArrayObj, SetByteArrayFromAny): * generic/tclInt.h (TclFreeIntRep): Factorize out deletion of object internal representation to a shared macro, so simplifying much code. 2004-09-27 Miguel Sofer * generic/tclBasic.c (TclObjInvoke): fix for bogus gcc warning about uninitialised variable. 2004-09-27 Don Porter * generic/tclBasic.c: Removed internal routines TclInvoke, * generic/tclInt.decls: TclGlobalInvoke, TclObjInvokeGlobal and the * tests/basic.test: portion of TclObjInvoke that handles calls without TCL_INVOKE_HIDDEN enabled. None of this code is called any longer within the core, and the superior public interface, Tcl_EvalObjv, is available for any external callers. * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclEvent.c (HandleBgErrors): Updated [bgerror] invocations to make use of Tcl_Obj based routines, dropping the calls to TclGlobalInvoke() 2004-09-27 Vince Darley * generic/tclFileName.c: * generic/tclFileSystem.h: * generic/tclIOUtil.c: * generic/tclPathObj.c: * tests/cmdAH.test: * tests/fileSystem.test: * tests/winFCmd.test: fix to bad error message with 'cd' on windows, when permissions are inadequate [Bug 1035462] and to treatment of a volume-relative pwd on Windows [Bug 1018980]. * doc/FileSystem.3: added missing Tcl_GlobTypeData documentation [Bug 935853] 2004-09-27 Kevin Kenny * compat/strftime.c (Removed): * generic/tclClock.c (removed TclClockOldscanObjCmd): * generic/tclDate.c (Regenerated): * generic/tclGetDate.y: * generic/tclInt.decls (removed TclGetDate and TclpStrftime): * generic/tclInt.h (removed TclGetDateInfo): * generic/tclIntDecls.h (Regenerated): * generic/tclStubInit.c (Regenerated): * library/clock.tcl: * unix/tclUnixTime.c (removed TclpStrftime): * win/Makefile.in: * win/makefile.bc: * win/makefile.bc: * win/tcl.dsp: Continued refactoring of [clock] for TIP 173 changes. Broke the free-form parser apart so that the Bison parser is responsible for only parsing, while clock.tcl handles relative times like "next Thursday", "next January". This change is needed to make timezones other than :localtime and :Etc/UTC work with free-form scanning. This change closes out the issue identified as being "for another day" in my log message of 2004-09-08. The refactored code also eliminates the last known references to TclpStrftime and TclGetDate, so those routines (including compat/strftime.c) have been removed. The refactoring also has the benefit that all storage in the Bison parser is now on the C stack, eliminating any need for mutex protection around [clock scan]. Also, changed the Makefiles so that 'make gendate' is available on Windows as well as Unix. * generic/tclCmdAH.c (Tcl_FormatObjCmd): Removed some grubby * generic/tclObj.c (SetBooleanFromAny): work-around code that was needed only because of Bug 868489. * generic/tclBasic.c (TclObjInvoke): Removed three unused variables to silence a compiler warning in VC++. 2004-09-27 Vince Darley * doc/FileSystem.3: fix to small typo. 2004-09-26 Miguel Sofer * generic/tclCompCmds.c: * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclInt.h: * generic/tclProc.c: * tests/compExpr-old.test: * tests/compExpr.test: * tests/expr.test: * tests/for.test: * tests/if.test: * tests/incr.test: * tests/while.test: Report compilation errors at runtime, [Patch 1033689] by dgp. 2004-09-23 Mo DeJong * unix/dltest/Makefile.in (clean): Fixup make clean rule so that it does not delete all files when SHLIB_SUFFIX is set to the empty string in a static build. [Bug 1016726] 2004-09-23 Don Porter * generic/tclBasic.c: Corrections to the 2004-09-21 commit * generic/tclExecute.c: regarding ERR_ALREADY_LOGGED. That commit * generic/tclNamesp.c: caused Tk test send-10.7 to fail. Added * tests/namespace.test (25.7,8): tests in the Tcl test suite * tests/pkg.test (2.25,26): to catch this error without the aid of Tk in the future. * generic/tclCmdAH.c (Tcl_ExprObjCmd): Simplified the TclObjCmdProc of [expr] with a call to Tcl_ConcatObj. 2004-09-22 Don Porter * generic/tclCmdMZ.c (TclProcessReturn): Support the -errorline * generic/tclCompile.c (TclCompileScript): option to [return]. * tests/compile.test (16.23.*): Use that capability to defer reporting * tests/misc.test (1.2): of parse errors until runtime. Updated tests to reflect change. [Bug 1032805] 2004-09-22 Miguel Sofer * generic/tclExecute.c (INST_START_CMD): * tests/proc.test (7.2-3): fix for [Bug 729692] was incorrect whenever a loop exception was returned. 2004-09-22 Kevin B. Kenny * library/tzdata/America/Montevideo: Updated to reflect ftp://elsie.nci.nih.gov/pub/tzdata2004d.tar.gz. (Changes to Asia/Jerusalem were in the comments only.) [Routine maintenance - no bug] Spanish-language description of the change at http://www.presidencia.gub.uy/decretos/2004091502.htm 2004-09-21 Don Porter * generic/tclCompCmds.c: Tolerate [append] syntax errors * tests/appendComp.test (8.1): at compile time, and allow runtime to raise the error (or succeed if a redefined [append] allows). * generic/tclBasic.c: Reworked management of the interp flag * generic/tclCompile.c: ERR_ALREADY_LOGGED, to reduce its exposure. * generic/tclExecute.c: Still left several referebces that are just * generic/tclNamesp.c: too nice on performace to do away with. These changes also resolve an inconsistency in the ::errorInfo values produced by [namespace eval x error foo bar] and [namespace eval x {error foo bar}]. * generic/tclExecute.c (TclCompEvalObj): Simplified the TclCompEvalObj routine. Much housekeeping now reliably happens elsewhere. [Patch 1031949] 2004-09-21 Donal K. Fellows * doc/interp.n: Tighten up wording on how [interp eval] and [interp invokehidden] operate w.r.t. stack frames. [Bug 926590] 2004-09-20 Don Porter * tests/error.test (error-6.2,3): Added more tests to verify ::errorCode setting by/after a [catch]. 2004-09-19 Miguel Sofer * generic/tclCmdAH.c: removed outdated comment [Bug 1029518]. 2004-09-18 David Gravereaux * win/tclAppInit.c: Dde package can load into a safe interp. Claim this fact for the Tcl_StaticPackage() call when the shell is built with the TCL_USE_STATIC_PACKAGES option. 2004-09-18 Donal K. Fellows * generic/tclExecute.c (TEBC-INST_LSHIFT,INST_RSHIFT): Ensure that large shifts end up shifting correctly. [Bug 868467] * doc/FileSystem.3, doc/OpenFileChnl.3: More documentation fixes from Mikhail Kolesnitchenko. [Patch 1022527] * doc/*: Standardize highlighting of symbols defined in tcl.h 2004-09-17 Don Porter * generic/tclBasic.c (Tcl_AddObjErrorInfo, Tcl_LogCommandInfo): * generic/tclCmdAH.c ([catch], [error]): * generic/tclCmdMZ.c ([return]): * generic/tclProc.c (TclUpdateReturnInfo): * generic/tclResult.c (Tcl_SetErrorCodeVA, Tcl_SetObjErrorCode) (TclTransferResult): Refactored so that all errorCode setting flows through Tcl_SetObjErrorCode(). This greatly reduces the number of different places in the code that need to know details about an internal bitflag field of the Interp struct. Also places errorCode setting in one place for easier future mods. 2004-09-17 Kevin B.Kenny * generic/tclDate.c: Revised tclGetDate.y to use bison instead of * generic/tclGetDate.y: yacc to build the parser, eliminating all the * generic/tclInt.h: complicated hackery involving 'sed' * unix/Makefile.in: postprocessing. Rebuilt the parser. 2004-09-14 Kevin B. Kenny * generic/tclClock.c (ClockOldscanObjCmd): Silenced a compiler warning (long passed as a param where unsigend long was expected). 'Unsigned long' is wrong, but the fix is really to change the signature of TclGetDate to return a structure of its 'yy' variables and then do the remaining work inside clock.tcl. But, as I said on 2004-09-08, that's a job for another day. [Bug 1027993] 2004-09-10 Miguel Sofer * doc/interp.n: * generic/tclInterp.c (TclPreventAliasLoop, AliasCreate): * tests/interp.test (17.4-6, 19.3-4): fixing problems with renaming of aliases [Bugs 707104 1026493]. Fix designed by dgp. 2004-09-13 Donal K. Fellows * generic/tclNamesp.c (NsEnsembleImplementationCmd): Add token field to internal rep of EnsembleCmdRep structure so that we can check it to see if the subcommand object is really being used with the same ensemble. [Bug 1026903] 2004-09-11 Kevin B. Kenny * generic/tclClock.c (TclMktimeObjCmd): Corrected a bad check for error return from 'mktime'. * generic/tclObj.c (Tcl_GetIntFromObj): Corrected a problem where demoting a wide to an int failed on a big-endian machine. [Bug 1026125]. * tests/clock.test (clock-43.1): Added regression test for error return from 'mktime'. 2004-09-11 Miguel Sofer * generic/tclExecute.c (INST_CONCAT1): fix for [Bug 1025834]; avoid unnecessary string copies. 2004-09-10 David Gravereaux * tests/tcltest.test: tcltest-12.3-4 needed to have ::tcltest::loadScript set to empty in their -setup 2004-09-10 Donal K. Fellows * generic/tclObj.c (SetIntOrWideFromAny): Rewritten integral value parsing code so that values do not flip so easily between numeric representations. Thanks to KBK for this! [Bug 868489] * generic/tclIO.c (Tcl_Seek): Make sure wide seeks do not fail to set ::errorCode on error. [Bug 1025359] 2004-09-10 Andreas Kupries * generic/tcl.h: Micro formatting fixes. * generic/tclIOGT.c: Channel version fixed, must be 3, to have wideseekProc. Thanks to David Graveraux . 2004-09-11 Don Porter * generic/tclNamespace.c (TclGetNamespaceForQualName): Resolved longstanding inconsistency in the treatment of the TCL_NAMESPACE_ONLY flag revealed by testing the 2004-09-09 commits against Itcl. TCL_NAMESPACE_ONLY now acts as specified in the pre-function comment, forcing resolution in the passed in context namespace. It has been incorrectly forcing resolution in the interp's current namespace. 2004-09-10 Kevin Kenny * library/clock.tcl: Fixed a bug where %z always put a plus sign on the time zone in :localtime. * tests/clock.test: Added test case for the above bug. 2004-09-10 Miguel Sofer * generic/tclExecute.c (INST_CONCAT1): added a peephole optimisation for concatting an empty string. This enables replacing the idiom 'K $x [set x {}]' by '$x[set x {}]' for fastest execution. 2004-09-09 David Gravereaux * win/tclWinConsole.c: Calls to WriteFile and WriteConsoleA changed to WriteConsole for simplicity. 2004-09-09 Don Porter * generic/tclNamesp.c (Tcl_ForgetImport): Corrected faulty * tests/namespace.test: logic that relied exclusively on string matching and failed in the presence of [rename]s. [Bug 560297] Also corrected faulty prevention of [namespace import] cycles. [Bug 1017299] 2004-09-08 Don Porter * generic/tclBasic.c (Tcl_CreateInterp): Removed obsolete field for storing the string-based command procedure of built-in commands. We no longer have any string-based built-in commands! 2004-09-08 Kevin B. Kenny * compat/strftime.c (_conv): Corrected a problem where hour 0 would format as a blank format group with %k. * doc/clock.n: Corrected a buglet in the header information. [Bug 1024058] * generic/tclClock.c (TclClockMktimeObjCmd): Fixed a bug where the month was scanned incorrectly in -timezone :localtime. * tests/clock.test (clock-34.*,clock-40.1, clock-41.1): Adjusted the clock-34.* test cases so that the consistency check is performed in :localtime rather than the current time zone. This change allows dealing with issues where the C library has a different idea of DST conversion than Tcl. (Real fix would be to break TclGetDate into separate parser and time converter, and do the time conversion in clock.tcl. That's for another day.) Added regression test case for the bug where month was scanned incorrectly in -timezone :localtime. [Bug 1023779] Added regression test case for %k at the zero hour. 2004-09-07 David Gravereaux * win/makefile.vc: some quoting needed to be removed as it was breaking with VC7. [Bug 1023150] 2004-09-07 Kevin B. Kenny * doc/clock.n: Documented the default -format, and changed references to a (nonexistent) msgcat command to refer to the msgcat package. [Bug 1023870] * generic/tclTimer.c: Removed a premature optimisation that attempted to store the assoc data in the client data; the optimisation caused a bug that [after] would overwrite its imports. [Bug 1016167] * library/clock.tcl (InitTZData, ClearCaches): Changed so that the in-memory time zone :UTC (and its aliases) always gets reinitialised, in case tzdata is absent. [Bug 1019537, 1023779] * library/tzdata/*: Regenerated. * tests/clock.test (clock-31.*, clock-39.1): Corrected a problem where the 'system' locale tests fail on a non-English Windows machine. [Bug 1023761]. Added a test to make sure that alias time zones load correctly. [Bug 1023779]. * tests/timer.test (timer-1.1, timer-2.1): Changed to (one hopes!) be more resilient on an overloaded system, if [after 200] sleeps for 300 ms or longer. * tools/tclZIC.tcl (writeLinks): Corrected a problem where alias time zone names were written incorrectly, causing them to fail to load at run time. [Bug 1023779]. * win/tclWinTime.c (Tcl_GetTime): Eliminated CPUID tests on Win64 - assuming that HAL vendors now do a better job of keeping the performance counters synchronized among CPU's. [Bug 1020445] 2004-09-06 Donal K. Fellows * doc/tclvars.n, doc/tcltest.n, doc/tclsh.1, doc/safe.n, doc/expr.n * doc/WrongNumArgs.3, doc/Utf.3, doc/TraceVar.3, doc/Thread.3 * doc/TCL_MEM_DEBUG.3, doc/SubstObj.3, doc/StdChannels.3 * doc/SetResult.3, doc/RegExp.3, doc/RegConfig.3, doc/RecEvalObj.3 * doc/PrintDbl.3, doc/ParseCmd.3, doc/Panic.3, doc/ObjectType.3 * doc/Object.3, doc/Namespace.3, doc/Interp.3, doc/IntObj.3 * doc/Hash.3, doc/GetOpnFl.3, doc/GetIndex.3, doc/Eval.3 * doc/Encoding.3, doc/DoubleObj.3, doc/DictObj.3, doc/CrtTimerHdlr.3 * doc/CrtObjCmd.3, doc/CrtMathFnc.3, doc/CrtCommand.3, doc/CrtChannel.3 * doc/ChnlStack.3, doc/ByteArrObj.3, doc/AssocData.3, doc/Alloc.3: More documentation fixes from Mikhail Kolesnitchenko. [Patch 1022527] 2004-09-03 Donal K. Fellows * unix/tclUnixFCmd.c: Stop NULL interp arguments from triggering a crash when an error happens. [Bug 1020538] 2004-09-02 Donal K. Fellows * doc/lsearch.n: Clarified meaning of -dictionary. [Bug 759545] 2004-09-02 Vince Darley * win/makefile.vc: clock.tcl needs to be installed. 2004-09-01 Jeff Hobbs * win/tclWinReg.c (BroadcastValue): WIN64 cast corrections * win/tclWinDde.c (DdeClientWindowProc): (DdeServicesOnAck, DdeEnumWindowsCallback): WIN64 corrections * win/tclWin32Dll.c (TclWinCPUID): need _asm for WIN64 (Itanium), until we have it, just return unknown. [Bug 1020445] 2004-09-01 Donal K. Fellows * doc/regsub.n, doc/RegConfig.3, doc/Environment.3: * doc/CrtChannel.3, doc/safe.n: Use correct abbreviations. 2004-08-31 Donal K. Fellows * doc/trace.n, doc/socket.n, doc/registry.n, doc/pid.n: * doc/namespace.n, doc/msgcat.n, doc/lsort.n, doc/lsearch.n: * doc/linsert.n, doc/info.n, doc/http.n, doc/history.n: * doc/format.n, doc/file.n, doc/exec.n, doc/dde.n, doc/clock.n: * doc/catch.n, doc/binary.n: More spelling and grammar fixes from Mikhail Kolesnitchenko. [Patch 1018486] 2004-08-31 Vince Darley * doc/FileSystem.3: * generic/tclIOUtil.c: Clarified documentation regarding ability of a filesystem to say that it doesn't support a given operation using the EXDEV Posix error code (copyFileProc, renameFileProc, etc), and updated one piece of code to ensure correct behaviour when an operation is not supported [Bug 1017072] * tests/fCmd.test: fix to test suite problem [Bug 1002884] 2004-08-31 Daniel Steffen * unix/Makefile.in (install-libraries): portable sh fix. 2004-08-30 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_StringObjCmd): Stop [string map] from crashing when its map and input string are the same object. 2004-08-27 Donal K. Fellows * generic/tclNamesp.c (FindEnsemble): Factor out the code to convert a command name into an ensemble configuration and add support for ignoring [namespace import] link chains. [Bug 1017022] (NamespaceWhichCmd): Rework to use newer option parsing API. 2004-08-27 Daniel Steffen * unix/Makefile.in: added customization of default module path roots via TCL_MODULE_PATH makefile variable. * macosx/Makefile: add platform standard locations to default module path roots. [Patch 942881] * tests/env.test: macosx fixes. 2004-08-25 Don Porter * tests/timer.test (timer-10.1): Test for Bug 1016167. * generic/tclTimer.c: Workaround for situation when a [namespace import] causes the objv[0] value to be something other than what Tcl_AfterObjCmd expects. [Bug 1016167]. 2004-08-25 Donal K. Fellows * generic/tclNamesp.c (NsEnsembleImplementationCmd): Use the ensemble command token to get the name of the ensemble for passing to the -unknown handler instead of relying on objv[0], which may contain useless info in the presence of [namespace import]. Problem found by Don Porter when investigating [Bug 1016167]. 2004-08-24 Don Porter * generic/tclProc.c: The routine TclProcInterpProc was a * generic/tclTestProcBodyObj.c: specific instance of the general service already provided by TclObjInvokeProc. Removed TclProcInterpProc and TclGetInterpProc from the code... * generic/tclInt.decls: ...and from the internal stubs table. * generic/tclIntDecls.h * generic/tclStubInit.c 2004-08-24 Donal K. Fellows * doc/string.n: Added clarifying note. 2004-08-23 Don Porter * library/auto.tcl: Updated [tcl_findLibrary] search path to include any [::pkgconfig get scriptdir,runtime] directory, as well as the $::auto_path. [RFE 695441] 2004-08-21 Kevin B. Kenny * tests/clock.test (clock-38.1): Changed TZ setting to specify CET in excruciating detail to deal with systems that lack the Posix defaults for DST changes (and to be formally correct with the change dates for CET). 2004-08-19 Donal K. Fellows * generic/tclScan.c (Tcl_ScanObjCmd, ValidateFormat): Ensure that the %ld conversion works correctly on 64-bit platforms. [Bug 1011860] 2004-08-19 Kevin Kenny * library/clock.tcl (format): Changed default timezone format from alphabetic to numeric to produce scannable times in more locales. * tests/clock.test (clock-37.1): Removed now-unused 'needPST' constraint and the comments that refer to it. 2004-08-18 Andreas Kupries * library/init.tcl: Integrated TIP #189. We source a separate file (see below), instead of inlining the contents of that file. This should beeasier to maintain, and easier to backport/install in 8.4 installations. Note: Usage of Tcl Modules is restricted to non-safe interps. It cannot be loaded into a safe interp. * library/tm.tcl: New file, the v2 reference implementation for TIP #189, Tcl Modules. * doc/tm.n: New file, documentation for Tcl Modules, based on the TIP. * unix/mkLinks: Regenerated. * win/makefile.vc: Added tm.tcl to list of files to install. 2004-08-18 Kevin Kenny * tests/httpd (httpdRespond): Corrected an abuse of the [clock] command that caused test failures for some values of [clock clicks]. * doc/clock.n * generic/tclBasic.c (Tcl_CreateInterp, Tcl_HideUnsafeCommands): * generic/tclClock.c (all): * generic/tclInt.h: * generic/tclInterp.c (CreateSlave): * library/clock.tcl: (new file) * library/init.tcl (clock): * library/msgs/*.msg:(new files) * library/tzdata/*: * library/tzdata/*/*: * library/tzdata/*/*/*: (new files) * tools/installData.tcl: (new file) * tools/loadICU.tcl: (new file) * tools/makeTestCases.tcl: (new file) * tools/tclZIC.tcl: (new file) * unix/Makefile.in: * unix/configure: (regenerated) * unix/tcl.m4: * tests/clock.test (all): * win/Makefile.in: * win/Makefile.vc: Implementation of TIPs #173 and #209. The [clock] command is now a Tcl ensemble, with most of its functionality written in Tcl and callouts to C code only to access low-level functions such as localtime, mktime and tzset. In addition to the functionality changes called out in the two TIPs, it is worth noting that the [clock] command in a safe slave interpreter is now an alias to the [clock] command in the master, and that [clock] is otherwise not expected to function entirely correctly in safe interps. C code that simply does Tcl_MakeSafe needs to be aware that [clock] may need special handling. (It appears unlikely that such code actually exists.) One incompatibility of note is that if the time zone cannot be determined from the TZ, TCL_TZ environment variables, or from the Windows control panel, so that the C library must be used for date and time conversions, then times outside the range of time_t will fail; they used to return bad data silently. Many thanks to all the many people who assisted with testing, debugging, criticism of the specification, and localisation. Deserving of particular mention are Joe English, Clif Flynt, Donal K. Fellows, Jeff Hobbs, Cameron Laird, Arjen Markus, Reinhard Max, Christopher Nelson, Steve Offutt, Donald G. Porter, Pascal Scheffers, Peter da Silva and Richard Suchenwirth-Bauersachs. *** POTENTIAL INCOMPATIBILITY *** 2004-08-16 Miguel Sofer * doc/SetVar.3: * generic/tclTest.c (TestseterrorcodeCmd): * generic/tclVar.c (TclPtrSetVar): * tests/result.test (result-4.*, result-5.*): [Bug 1008314] detected and fixed by dgp. 2004-08-13 Don Porter * library/msgcat/msgcat.tcl: Added checks to prevent [mclocale] * tests/msgcat.test: from registering filesystem paths to possibly malicious code to be evaluated by a later [mcload]. 2004-08-10 Zoran Vasiljevic * unix/tclUnixThrd.c (TclpThreadCreate): changed handling of the returned thread ID since broken on 64-bit systems (Cray). Thanks to Rob Ratcliff for reporting the bug. 2004-08-03 Donal K. Fellows * generic/tclNamesp.c (MakeCachedEnsembleCommand): Initialize the epoch field cached in the subcommand. [Bug 989298] (NsEnsembleImplementationCmd): Plug a leak (thanks to Miguel Sofer for spotting it with valgrind) and reduce the number of goto labels to make the code clearer. 2004-08-02 Don Porter * library/package.tcl (pkg_mkIndex): Updated [pkg_mkIndex] to make use of [glob -directory $dir -tails] and return options. TIP#207 IMPLEMENTATION * doc/interp.n: Added support for a -namespace option to the * generic/tclBasic.c: [interp invokehidden] command. Also added an * generic/tclInt.h: internal routine TclObjInvokeNamespace() and * generic/tclInterp.c: corrected the flag names TCL_FIND_ONLY_NS and * generic/tclNamesp.c: TCL_CREATE_NS_IF_UNKNOWN that are passed to the * generic/tclTrace.c: internal routine TclGetNamespaceForQualName(). * tests/interp.test: [Patch 981841] * generic/tclLiteral.c (TclCleanupLiteralTable): Corrected * tests/compile.test (compile-12.4): flawed deletion of literal internal reps that could lead to accessing of freed memory. Thanks to Kevin Kenny for test case and fix [Bug 1001997]. 2004-07-30 Don Porter * tests/safe.test (safe-2.1): Disabled senseless test. [Bug 999612] * library/auto.tcl (auto_reset): Removed "protected" list of commands from [auto_reset]. All entries in the auto_index can be re-loaded. * library/package.tcl: Updated comment to reflect 2004-07-28 commit. * generic/tclEvent.c (Tcl_Finalize): Re-organized Tcl_Finalize so that Tcl_ExitProc's that call Tcl_Finalize recursively do not cause deadlock. [Patch 999084 fixes Tk Bug 714956] 2004-07-30 Daniel Steffen * unix/configure: * unix/tcl.m4 (SC_CONFIG_CFLAGS): Darwin: instead of setting PLAT_OBJS to explict object files in tcl.m4, refer to MAC_OSX_OBJS makefile var. * unix/Makefile.in: added MAC_OSX_OBJS variable. 2004-07-29 Don Porter * library/package.tcl: [::pkg::create] is now an alias. Test safe-2.1 will now fail until Bug 999612 is corrected. 2004-07-28 Don Porter * library/package.tcl: Moved private command * library/tclIndex: [pkg_compareExtension] into ::tcl::Pkg. * tests/pkg_mkIndex.test: Also moved implementation of [::pkg::create] to [::tcl::Pkg::Create]. 2004-07-25 Pat Thoyts * tests/io.test: Make io-61.1 create file as binary to pass on Win32 2004-07-23 Miguel Sofer * generic/tclVar.c: simplify tclLocalVarNameType, removing the reference to the corresponding proc. The reference is now seen as unnecessary, and it may cause leaking circular references under some circumstances (see for example [Bug 994838]). 2004-07-22 Don Porter * tests/eofchar.data (removed): Test io-61.1 now generates its own * tests/io.test: file of test data as needed. 2004-07-20 Jeff Hobbs * generic/tclEvent.c: Correct threaded obj allocator to * generic/tclInt.h: fully cleanup on exit and allow for * generic/tclThreadAlloc.c: reinitialization. [Bug 736426] * unix/tclUnixThrd.c: (mistachkin, kenny) * win/tclWinThrd.c: 2004-07-21 Kevin Kenny * generic/tclBasic.c (DeleteInterpProc): * generic/tclLiteral.c (TclCleanupLiteralTable): * generic/tclInt.h: added a TclCleanupLiteralTable function, called from DeleteInterpProc, that frees internal representations of shared literals early when an interpreter is being deleted. This change corrects a number of memory mismanagement issues in the cases where the internal representation of one literal contains a reference to another, and avoids conditions such as resolved variable names referring to procedure and namespace contexts that no longer exist. [Bug 994838] 2004-07-20 Daniel Steffen * unix/Makefile.in: * win/Makefile.in: added 'install-private-headers' makefile target to allow optionally installing private tcl headers. [FR 922727] * macosx/Makefile: use new 'install-private-headers' target to install private headers into framework. [FR 922727] * unix/tclUnixFile.c (NativeMatchType): added support for readonly matching of user immutable files (where available). * macosx/tclMacOSXBundle.c: dynamically acquire address for CFBundleOpenBundleResourceMap symbol, since it is only present in full CoreFoundation on Mac OS X and not in CFLite on pure Darwin. 2004-07-19 Zoran Vasiljevic * win/tclwinThrd.c: redefined MASTER_LOCK to call TclpMasterLock. Fixes [Bug 987967] 2004-07-17 Vince Darley * generic/tclIOUtil.c: fix to rare 'cd' infinite loop in normalization with vfs [Bug 991420]. * tests/fileSystem.test: added test for above bug. * doc/FileSystem.3: clarified documentation of Posix error codes in 'remove directory' FS proc - 'EEXIST' is used to signify a non-empty directory error (bug reported against tclvfs). 2004-07-16 Jeff Hobbs * unix/Makefile.in, unix/tcl.m4: move (C|LD)FLAGS after their * unix/configure.in, unix/configure: _DEFAULT to allow for env setting to override m4 switches. Move SC_MISSING_POSIX_HEADERS up and consolidate calls to limit redundancy in configure. (CFLAGS_WARNING): Remove -Wconversion (SC_ENABLE_THREADS): Set m4 to force threaded build when built against a threaded Tcl core. 2004-07-16 Andreas Kupries * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Corrected a typo in the generation of error messages and simplified by reusing data in a variable instead of retrieving the string again. Fixes [Bug 835289]. * doc/OpenFileChnl.3: Added description of the behaviour of Tcl_ReadChars when its 'charsToRead' argument is set to -1. Fixes [Bug 934511]. * doc/CrtCommand.3: Added note that the arguments given to the command proc of a Tcl_CreateCommand are in utf-8 since Tcl 8.1. Closing [Patch 414778]. * doc/ChnlStack.3: Removed the declaration that the interp argument to Tcl_(un)StackChannel can be NULL. This fixes [Bug 881220], reported by Marco Maggi . * tests/socket.test: Accepted two new testcases by Stuart Casoff checking that -server and -async don't go together [Bug 796534]. * unix/tclUnixNotfy.c (NotifierThreadProc): Accepted Joe Mistachkin's patch for [Bug 990500], properly closing the notifier thread when its exits. 2004-07-15 Andreas Kupries * unix/tclUnixThrd.c (TclpFinalizeMutex): Accepted Joe Mistachkin's patch for [Bug 990453], closing leakage of mutexes. They were not destroyed properly upon finalization. 2004-07-15 Andreas Kupries * generic/tclIO.h (CHANNEL_INCLOSE): New flag. Set in * generic/tclIO.c (Tcl_UnregisterChannel): 'Tcl_Close' while the * generic/tclIO.c (Tcl_Close): close callbacks are run. Checked in 'Tcl_Close' and 'Tcl_Unregister' to prevent recursive call of 'close' in the close-callbacks. This is a possible error made by implementors of virtual filesystems based on 'tclvfs', thinking that they have to close the channel in the close handler for the filesystem. 2004-07-14 Andreas Kupries * generic/tclIO.c: * generic/tclIO.h: * Not reverting, but #ifdef'ing the changes from May 19, 2004 out of the core. This removes the ***POTENTIAL INCOMPATIBILITY*** for channel drivers it introduced. This has become possible due to Expect gaining a BlockModeProc and now handling blockingg and non-blocking modes correctly. Thus [SF Tcl Bug 943274] is still fixed if a recent enough version of Expect is used. * doc/CrtChannel.3: Added warning about usage of a channel without a BlockModeProc. 2004-07-15 Andreas Kupries * generic/tclIOCmd.c (Tcl_PutsObjCmd): Added length check to the old depreceated newline syntax, to ensure that only "nonewline" is accepted. [Tcl SF Bug 985869], reported by Joe Mistachkin . 2004-07-15 Zoran Vasiljevic * generic/tclEvent.c (Tcl_Finalize): stuffed memory leak incurred by re-initializing of TSD slots after the last call to TclFinalizeThreadData (done from within Tcl_FinalizeThread()). We basically just repeat the TclFinalizeThreadData() once more before tearing down TSD keys in TclFinalizeSynchronization(). There should be more elaborate mechanism in place for handling such issues, based on thread cleanup handlers registered on the OS level. Such change requires much more work and would also require TIP because some visible parts of Tcl API would have to be modified. In the meantime, this will do. * generic/tclNotify.c (TclFinalizeNotifier): Added conditional notifier finalization based on the fact that an TclInitNotifier has been called for the current thread. This fixes the [Bug 770053] again. Hopefully this time w/o unwanted side-effects. 2004-07-15 Kevin Kenny * generic/tclLiteral.c (TclReleaseLiteral): Removed unused variable 'codePtr' to silence a message from VC++. 2004-07-15 Miguel Sofer * generic/tclCompile.c (TclCompileScript): * generic/tclLiteral.c (TclReleaseLiteral): fix for [Bug 467523], which resurfaced with the latest changes. The previous strategy was to have special code in TclReleaseLiteral to handle the self-references generated by empty scripts. The new approach avoids the self-reference altogether, by having empty scripts return an unshared literal. 2004-07-15 Zoran Vasiljevic * generic/tclEvent.c (NewThreadProc): Backout of changes to fix the [Bug 770053]. See SF bugreport for more info. 2004-07-11 Miguel Sofer * generic/tclBasic.c (Tcl_EvalEx): leak fix by dgp, release objv[objectsUsed] on error. 2004-07-11 Miguel Sofer * generic/tclParse.c (Tcl_SubstObj): leak fix by dgp, release result on error. 2004-07-11 Donal K. Fellows * generic/tclNamesp.c (BuildEnsembleConfig): Don't forget to clean out references when deleting the hash table. * generic/tclDictObj.c (Tcl_DictObjRemoveKeyList): Oops, forgot to delete value object when removing the hash entry. [Bug 989093 in part] 2004-07-11 Miguel Sofer * generic/tclExecute.c (TEBC): fixed leak of expandNestList objs when there is an error while an expansion is in progress (code added at checkForCatch). 2004-07-11 Vince Darley * generic/tclIOUtil.c: fix to 'cd' bug when vfs is active [tclvfs Bug 986944] - this bug recently introduced by some threading fixes. Need to work out how to add tests for this. 2004-07-10 Kevin Kenny * tests/clock.test (clock-2.11): Changed the test so that it isn't an infinite loop when run under valgrind on a slow virtual machine. Thanks to Miguel Sofer for the bug report. Also put in code to restore env(LC_TIME) after tests complete, silencing a warning from 'make TESTFLAGS="-debug 1" test'. 2004-07-08 Miguel Sofer * generic/tclBasic.c (DeleteInterpProc): reverted the modification of 3 days ago, as the leak of [Bug 983660] is now handled by the change in TclCleanupByteCode. * generic/tclCompile.c (TclCleanupByteCode): let each bytecode remove its references to literals at interp deletion, without updating the dying literal table. * generic/tclLiteral.c (TclDeleteLiteralTable): with the above change to TclCleanupByteCode, this function now removes a single reference to the literal object and cleans up its own structures. 2004-07-08 Kevin Kenny * win/tclWinInit.c (AppendEnvironment): Silenced a compilation warning about a type mismatch. 2004-07-07 Miguel Sofer * generic/tclCompile.c (TclCompileScript): fix for [Bug 458361]. Single-word scripts are compiled with an unshared cmdName to avoid shimmering between bytecode and cmdName reps. 2004-07-07 Don Porter * generic/tclCmdMZ.c (TclMergeReturnOptions): Simplified logic and removed potential memory leak. [Bug 986257]. 2004-07-07 Donal K. Fellows * tools/man2help2.tcl (setTabs, IPmacro): Added support for the more advanced *roff macros used in Tk's doc/bind.n * generic/tclObj.c (TclInitObjSubsystem): Declare all current object types. 2004-07-06 Don Porter * tests/cmdMZ.test (cmdMZ-return-2.17): Added a test that a word containing backslash-quoted value is treated correctly. * generic/tclCompile.c (TclWordKnownAtCompileTime): [Bug 986196] Corrected flaw above and the flaw that caused TCL_TOKEN_SIMPLE_WORDs to have their original word value copied ( "{a b}" ) rather than the actual value ( "a b" ). Thanks to Kevin Kenny for report and tests. 2004-07-06 Kevin B. Kenny * tests/cmdMZ.test (cmdMZ-return-2.15,cmdMZ-return-2.16): Added a test that a return code containing spaces is correctly returned. 2004-07-06 Donal K. Fellows * tools/man2html2.tcl (IPmacro, setTabs): Added support for the more advanced *roff macros used in Tk's doc/bind.n 2004-07-05 Miguel Sofer * generic/tclBasic.c (DeleteInterpProc): fix for [Bug 983660], found by pspjuth. Tear down the global namespace before freeing the interp handle, to allow the bytecodes to free their non-shared literals. * generic/tclLiteral.c (TclReleaseLiteral): moved special code for self-ref so that it is also used for non-shared literals. Possible bug found by inspection. 2004-07-03 Miguel Sofer * generic/tclExecute.c (ExprRoundFunc): * tests/expr-old.test (39.1): added support for wide integers to round(); [Bug 908375], reported by Hemang Lavana. 2004-07-03 Miguel Sofer * generic/tclCompile.h: * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: Moved declaration of TclCompEvalObj() from tclCompile.h to the internal stubs table, for compiler experimentation. 2004-07-02 Jeff Hobbs * generic/regcomp.c (stid): correct minor pointer size error * generic/tclPipe.c (TclCreatePipeline): applied TIP #202 patch that * doc/exec.n, tests/exec.test: adds 2>@1 as a special case redirection of stderr to the result output. 2004-07-02 Kevin B. Kenny * tests/io.test: Changed several tests to run the event loop rather than just calling [update] periodically, avoiding intermittent failures (usually in io-29.32) that stemmed from unreaped processes on Windows. * tests/winPipe.test (winpipe-1.11): Fixed a bug that caused test to fail if the path name of the working directory contained whitespace [Bug 678430] 2004-07-01 Vince Darley * tests/fileSystem.test: Added test for [Bug 970529] 2004-07-01 Donal K. Fellows * win/README.binary, win/README: Updated references to Tcl and Tk 8.4 to point to 8.5 instead. Thanks to Theo Verelst for spotting this. * generic/tcl.h: Added note to help prevent those changes from getting missed in the future. * doc/Namespace.3, doc/load.n, doc/Limit.3: Typo fixes and remove duplicate documentation. [Bug 983146] 2004-06-30 Don Porter * tests/fileSystem.test: Minor correction to new fileSystem-9.X tests so that they clean up temporary directories correctly. 2004-06-30 Vince Darley * doc/filename.n: clarified behaviour concerning trailing slashes in filenames [Bug 971976] * win/tclWinFile.c: * tests/fileSystem.test: fix and tests for [Bug 979879] 2004-06-30 Donal K. Fellows TIP#188 IMPLEMENTATION * doc/string.n, tests/string.test: Add 'wideinteger' to things * generic/tclCmdMZ.c (Tcl_StringObjCmd): that can be tested for with the [string is] subcommand. [Patch 940915, by Kevin Kenny] 2004-06-29 Don Porter * win/tclWinInit.c: Corrected reference counting flaw in recent changes. Thanks to Pat Thoyts. [Bug 981893]. 2004-06-29 Vince Darley * win/tclWin32Dll.c: fix to compilation with VC++ 5.2 2004-06-29 Donal K. Fellows * library/safe.tcl: Make sure that the temporary variable is local to the namespace and not inadvertently global. [Bug 981733] 2004-06-24 Donal K. Fellows * tests/unixNotfy.test: Modified constraints so that testing with a threaded tclsh (not tcltest) will not hang. 2004-06-23 Don Porter * generic/tclThreadStorage.c: Corrected type casting errors that led to calculation of a negative index value, thus accesses outside the threadStorageCache array, thus memory corruption. Crash observed on Mac OS X platform. 2004-06-23 Joe Mistachkin * generic/tclThread.c: Implements platform independent thread storage * generic/tclThreadStorage.c: mechanism and fixes associated bugs on platforms where there is limited thread local storage space (Win98/WinNT4). [Patch 976496] * generic/tclInt.decls: * generic/tclIntDecls.h: Added thread storage functions to the * generic/tclStubInit.c: internal stubs table. * unix/Makefile.in: * unix/configure: * unix/tcl.m4: * win/makefile.vc: * win/rules.vc: * win/Makefile.in: Modified the unix, VC++, and Cygwin build systems * win/configure: to include the new "tclThreadStorage.c" and the new * win/tcl.m4: USE_THREAD_STORAGE define. 2004-06-23 Pat Thoyts * tests/io.test: Added -force to 18.1 and 18.2. This was failing on WinXP. * tests/winFCmd.test: Added a cleanup to winFCmd-16.11 to avoid a failure in 16.12. * tests/eofchar.data: Added -kb option to ensure a binary checkout to win32 systems. This fixes a failure in io-61.1 * win/makefile.vc: fix for [Bug 977369] about launching tclsh to generate a tclConfig.sh with the nmake build system 2004-06-23 Kevin B. Kenny * tests/winDde.test (createChildProcess): Added a 200-ms delay (with the event loop live) when shutting down the test DDE server process. With the delay in place, nuisance failures of tests winDde-4.2, -6.5, and -6.6 appear to be much less frequent. [Bug 957449] 2004-06-23 Donal K. Fellows * tests/*.test: Standardize use of platform constraints. * unix/tclUnixInit.c (GetStackSize, TclpCheckStackSpace): * unix/tclUnixThrd.c (TclpThreadGetStackSize): Added code to check whether the C stack is about to be exceeded, from [Patch 746378] by Joe Mistachkin but with substantial revisions. 2004-06-22 Kevin Kenny * generic/tclEvent.c (NewThreadProc): Fixed broken build on Windows caused by missing TCL_THREAD_CREATE_RETURN. * tests/stack.test (stack-3.1): Corrected nuisance error in threaded builds. 2004-06-22 Zoran Vasiljevic * generic/tclEvent.c: * generic/tclInt.h: * unix/tclUnixNotfy.c: * unix/tclUnixThrd.c: * win/tclWinThrd.c: [Bug 770053]. See bug report for more information about what it does. * tests/unixNotfy.test: rewritten to use tcltest::threadReap to gracefully wait for the test thread to exit. Otherwise we got a race condition with main thread exiting before the test thread. This exposed the long-standing Tcl lib issue with resource garbage-collection on application exit. 2004-06-21 Mo DeJong * win/tclWin32Dll.c (DllMain, _except_dllmain_detach_handler) (TclpCheckStackSpace, _except_checkstackspace_handler) (TclWinCPUID, _except_TclWinCPUID_detach_handler): * win/tclWinChan.c (Tcl_MakeFileChannel) (_except_makefilechannel_handler): * win/tclWinFCmd.c (DoRenameFile, _except_dorenamefile_handler) (DoCopyFile, _except_docopyfile_handler): Rework pushing of exception handler function pointer so that compiling with gcc -O3 works. Remove empty function call to avoid compiler warning. Mark the DllMain function as noinline to avoid compiler error from duplicated asm labels in generated code. 2004-06-21 Donal K. Fellows * generic/tclThreadAlloc.c (Ptr2Block): Rewrote so as to maximize the chance of detecting and reporting a memory inconsistency without relying on things being consistent. [Bug 975895] 2004-06-18 Don Porter * tests/load.test: Relaxed strictness of error message matching for test load-2.3 so that it will pass on Mac OSX. * generic/tclEncoding.c: Static TclFindEncodings -> FindEncodings. * generic/tclInt.h: Updated TclpFindExecutable() so that failed * generic/tclUtil.c: attempts to find the executable are saved * unix/tclUnixFile.c: just as successful finds are. [Patch 966053] * unix/tclUnixTest.c: 2004-06-18 Kevin B. Kenny * tests/winFCmd.test (winFCmd-16.12): Changed test to compute the target directory, so as not to fail if the user's HOME isn't the root. 2004-06-19 Daniel Steffen * unix/tcl.m4: autoconf 2.5 fixes in Darwin section. * unix/configure: autoconf-2.57 2004-06-18 Donal K. Fellows * unix/tclUnixInit.c (localeTable): Added some more locale to encoding mapping info from Jim Huang * generic/tclInt.h (PendingObjData,TclFreeObjMacro,etc): * generic/tclObj.c (TclFreeObj): Added scheme for making TclFreeObj() avoid blowing up the C stack when freeing up very large object trees. [Bug 886231] * win/tclWinInit.c (SetDefaultLibraryDir): Fix logic, simplify and add comments. 2004-06-17 Don Porter * generic/tclObj.c: Added missing space in panic message. * win/tclWinInit.c: Inform [tclInit] about the default library directory via the ::tclDefaultLibrary variable. This should correct a problem with my 2004-06-11 commit. Better solutions still in the works. Thanks to Joe Mistachkin for pointing out the breakage. 2004-06-16 Don Porter * doc/library.n: Moved variables ::auto_oldpath and * library/auto.tcl: ::unknown_pending into ::tcl namespace. * library/init.tcl: [Bugs 808319, 948794] 2004-06-15 Donal K. Fellows * doc/binary.n: Added some notes to the documentation of the 'a' format to address the point raised in [RFE 768852]. 2004-06-15 Jeff Hobbs * unix/tclConfig.sh.in (TCL_EXTRA_CFLAGS): set to @CFLAGS@, which is the configure-time CFLAGS. Addendum to m4 change on 2004-05-26. 2004-06-14 Kevin Kenny * win/Makefile.in: Corrected compilation flags for tclPkgConfig.c so that it doesn't require Stubs. * generic/tclBasic.c (Tcl_CreateInterp): Removed comment stating that TclInitEmbeddedConfigurationInformation needs Stubs; with the change above, the comment is now erroneous. 2004-06-11 Don Porter * doc/Encoding.3: Removed bogus claims about tcl_libPath. * generic/tclInterp.c (Tcl_Init): Stopped setting the tcl_libPath variable. [tclInit] can get all its directories without it. * tests/unixInit.test: Modified test code that made use of tcl_libPath variable. * unix/tclUnixInit.c: Stopped setting the tclDefaultLibrary variable, execept on the Mac OS X platform with HAVE_CFBUNDLE. In that configuration we should seek some way to make use of the TIP 59 facilities and get rid of that usage of tclDefaultLibrary as well. * generic/tclInterp.c: Updated [tclInit] to make $env(TCL_LIBRARY) an absolute path, and to include the scriptdir,runtime configuration value on the search path for init.tcl. * unix/tclUnixInit.c: The routines Tcl_Init() and TclSourceRCFile() * win/tclWinInit.c: had identical implementations for both win and * generic/tclInterp.c: unix. Moved to a single generic implementation. * generic/tclMain.c: * library/init.tcl: * generic/tclInitScript.h (removed): * unix/Makefile.in: * win/tcl.dsp: * unix/configure.in: Updated TCL_PACKAGE_PATH value to handle * win/configure.in: --libdir configuration. * unix/configure.in: autoconf-2.57 * win/configure.in: * generic/tclBasic.c (Tcl_CreateInterp): Moved call to TclInitEmbeddedConfigurationInformation() earlier in Tcl_CreateInterp() so that other parts of interp creation and initialization may access and use the config values. 2004-06-11 Kevin Kenny * win/tclAppInit.c: Restored the 'setargv' procedure when compiling with mingw. Apparently, the command line parsing in mingw doesn't work as well as that in vc++, and the result was (1) that winPipe-8.19 failed, and (2) that 'make test' would work at all only with TESTFLAGS='-singleproc 1'. [Bug 967195] 2004-06-10 Zoran Vasiljevic * generic/tclIOUtil.c: removed forceful setting of the private cached current working directory rep from within the Tcl_FSChdir(). We delegate this task to the Tcl_FSGetCwd() which does this task anyway. The relevant code is still present but disabled temporarily until the change proves correct. The Tcl test suite passes all test with the given change so I suppose it is good enough. 2004-06-10 Don Porter * unix/tclUnixInit.c (TclpInitLibraryPath): Disabled addition of * win/tclWinInit.c (TclpInitLibraryPath): relative-to-executable directories to the library search path. A first step in reform of Tcl's startup process. ***POTENTIAL INCOMPATIBILITY*** Attempts to directly run ./tclsh or ./tcltest out of a build directory will either fail, or will make use of an installed script library in preference to the one in the source tree. Use `make shell` or `make runtest` instead. * tests/unixInit.test: Modified tests to suit above changes. * generic/tclPathObj.c: Corrected [file tail] results when operating on a path produced by TclNewFSPathObj(). [Bug 970529] 2004-06-09 Zoran Vasiljevic * generic/tclIOUtil.c: partially corrected [Bug 932314]. Also corrected return values of Tcl_FSChdir() to reflect those of the underlying platform-specific call. Originally, return codes were mixed with those of Tcl. 2004-06-08 Miguel Sofer * generic/tclCompile.c: * generic/tclExecute.c: handle warning [Bug 969066] 2004-06-08 Donal K. Fellows * generic/tclHash.c (RebuildTable): Move declaration of variable so it is only declared when it is used. [Bug 969068] 2004-06-07 Donal K. Fellows * doc/lsearch.n: Added correct option to example. [Bug 968219] 2004-06-05 Kevin B. Kenny * generic/tcl.h: Corrected Tcl_WideInt declarations so that the mingw build works again. * generic/tclDecls.h: Changes to the tests for clock * generic/tclInt.decls: frequency in Tcl_WinTime so * generic/tclIntDecls.h: that any clock frequency is * generic/tclIntPlatDecls.h: accepted provided that all * generic/tclPlatDecls.h: CPU's in the system share a * generic/tclStubInit.c: common chip, and hence, * tests/platform.test (platform-1.3): presumably, a common clock. * win/tclWin32Dll.c (TclWinCPUID): This change necessitated a * win/tclWinTest.c (TestwincpuidCmd) small burst of assembly code * win/tclWinTime.c (Tcl_GetTime): to read CPU ID information, which was added as TclWinCPUID in the internal Stubs. To test this code in the common case of a single-processor machine, a 'testwincpuid' command was added to tclWinTest.c, and a test case in platform.test. Thanks to Jeff Godfrey and Richard Suchenwirth for reporting this bug. [Bug 976722] 2004-06-04 Don Porter * generic/tcl.h: Restored #include to tcl.h, rejecting the "fix" for "Bug" 945570. Tcl_FSSeek() needs the values of SEEK_SET, etc. and too many extensions rely on tcl.h providing stdio.h for them. 2004-06-02 Jeff Hobbs * win/tclWinFile.c (TclpFindExecutable): when using GetModuleFileNameA (Win9x), convert from CP_ACP to WCHAR then convert back to utf-8. Adjunct to 2004-04-07 fix. 2004-06-02 David Gravereaux * tests/winPipe.test (winpipe-6.1): blocking set to 1 before closing to ensure we get an exitcode. The windows pipe channel driver doesn't differentiate between a blocking and non-blocking close just yet, but will soon. Part of [Bug 947693] 2004-06-02 Vince Darley * doc/file.n: fix to documentation of 'file volumes' (Bug 962435) 2004-06-01 David Gravereaux * win/makefile.vc: check for either MSDEVDIR or MSVCDIR being in the environment, for VC7. [Bug 942214] * generic/tclIO.c (Tcl_SetChannelOption): -buffersize wasn't understanding hexidecimal notation nor was reporting number conversion errors. The behavior to silently ignore settings outside the acceptable range of Tcl_SetChannelBufferSize (<10 or >1M) is unchanged. This silent ignoring behavior might be up for review soon. 2004-05-30 David Gravereaux * win/tclWinPipe.c: * win/tclWinPort.h: Reworked the win implementation of Tcl_WaitPid to support exitcodes in the 'signed short' range. Even though this range is non-portable, it is valid on windows. Detection of exception codes are now more accurate. Previously, an application that exited with ExitProcess((DWORD)-1); was improperly reported as exiting with SIGABRT. 2004-05-30 Donal K. Fellows * generic/tclInterp.c: Added comments describing the purposes of each function in the limit implementation and rewrote the names of some non-public functions for greater clarity of purpose. * doc/interp.n: Added note about what happens when a limited interpreter creates a slave interpreter. * doc/Limit.3: Added manual page for the resource limit subsystem's C API. [Bug 953903] 2004-05-29 Joe English * doc/global.n, doc/interp.n, doc/lrange.n: Fix minor markup errors. 2004-05-28 Donal K. Fellows * doc/*.n: Added examples to many (too many to list) more man pages. 2004-05-25 Miguel Sofer * generic/tclExecute.c: * generic/tclVar.c: using (ptrdiff_t) instead of (int) casting to correct compiler warnings [Bug 961657], reported by Bob Techentin. 2004-05-27 Kevin B. Kenny * tests/clock.test: Added a single test for the presence of %G in [clock format], and conditioned out the clock-10.x series if they're all going to fail because of a broken strftime() call. [Bug 961714] 2004-05-27 Donal K. Fellows * generic/tclHash.c (CompareStringKeys): Added #ifdef to allow people to instruct this function to use strcmp(). [FRQ 951168] * generic/tclVar.c: Moved declarations into #if guards so they only happen when required. * unix/tclUnixPort.h: Guard declaration of strtod() so it is only enabled when we don't have a declaration in stdlib.h * unix/tclUnixThrd.c (Tcl_CreateThread): Added declarations * unix/tclUnixTest.c (AlarmHandler): and casts so that * unix/tclUnixChan.c (TtyModemStatusStr): all functions are * generic/tclScan.c (Tcl_ScanObjCmd): defined before use * generic/tclDictObj.c (InvalidateDictChain): and no cross-type * generic/tclCmdMZ.c (Tcl_StringObjCmd): uses are performed. The overall effect is to make building with gcc with the additional flags -Wstrict-prototypes -Wmissing-prototypes produce no increase in the total number of warnings (except for main(), which is undeclared for traditional reasons.) 2004-05-26 Jeff Hobbs * unix/Makefile.in: Rework configure ordering to TCL_LINK_LIBS, * unix/tcl.m4: ENABLE_SHARED, CONFIG_CFLAGS, & ENABLE_SYMBOLS * unix/configure: before TCL_EARLY_FLAGS and TCL_64BIT_FLAGS * unix/configure.in: (about 400 lines earlier) in configure.in. This forces CFLAGS configuration to be done before many tests, which is needed for 64-bit builds and may affect other builds. Also make CONFIG_CFLAGS append to CFLAGS directly instead of using EXTRA_CFLAGS, and have LDFLAGS append to any existing value. [Bug 874058] * unix/dltest/Makefile.in: change EXTRA_CFLAGS to DEFS 2004-05-26 Don Porter * library/tcltest/tcltest.tcl: Correction to debug prints and testing * library/tcltest/pkgIndex.tcl: if TCLTEST_OPTIONS value. Corrected * tests/tcltest.test: double increment of numTestFiles in -singleproc 1 configurations. Updated tcltest-19.1 to tcltest 2.1 behavior. Corrected tcltest-25.3 to not falsely report a failure in tcltest.test. Bumped to tcltest 2.2.6. [Bugs 960560, 960926] 2004-05-25 Jeff Hobbs * doc/http.n (http::config): add -urlencoding option (default utf-8) * library/http/http.tcl: that specifies encoding conversion of * library/http/pkgIndex.tcl: args for http::formatQuery. Previously * tests/http.test: undefined, RFC 2718 says it should be utf-8. 'http::config -urlencoding {}' returns previous behavior, which will throw errors processing non-latin-1 chars. Bumped http package to 2.5.0. 2004-05-25 Donal K. Fellows * generic/tclInterp.c (DeleteScriptLimitCallback): Move all deletion of script callback hash table entries to happen here so the entries are correctly removed at the right time. [Bug 960410] 2004-05-25 Miguel Sofer * docs/global.n: added details for qualified variable names [Bug 959831] 2004-05-25 Miguel Sofer * generic/tclNamesp.c (Tcl_FindNamespaceVar): * tests/namespace.test (namespace-17.10-12): reverted commit of 2004-05-23 and removed the tests, as it interferes with the varname resolver and there are apps that break (AlphaTk). A fix will have to wait for Tcl9. * generic/tclVar.c: Caching of namespace variables disabled: no simple way was found to avoid interfering with the resolver's idea of variable existence. A cached varName may keep a variable's name in the namespace's hash table, which is the resolver's criterion for existence. * tests/namespace.c (namespace-17.10): testing for interference between varname caching and name resolver. 2004-05-25 Kevin Kenny * tests/winFCmd.test: Correct test for the presence of a CD-ROM so that it doesn't misdetect some other sort of filesystem with a write-protected root as being a CD-ROM drive. [Bug 918267] 2004-05-25 Don Porter * tests/winPipe.test: Protect against path being set * tests/unixInit.test: Unset path when done. * tests/unload.test (unload-3.1): Verify [pkgb_sub] does not exist. Delete interps when done. * tests/stringComp.test: stop re-use of string.test test names * tests/regexpComp.test: stop re-use of regexp.test test names * tests/namespace.test (namespace-46.3): Verify [p] does not exist. * tests/http.test: Clear away the custom [bgerror] when done. * tests/io.test: Take care to use namespace variables. * tests/autoMkindex.test (autoMkindex-5.2): Use variable "result" that gets cleaned up. * tests/exec.test: Clean up the "path" array. * tests/interp.test (interp-9.3): Initialize res, so prior values cannot make the test fail. * tests/execute.test (execute-8.1): Updated to remove the trace set on ::errorInfo. When left in place, that trace can cause later tests to fail. 2004-05-25 Donal K. Fellows * generic/tclBasic.c: Removed references to Tcl_RenameCommand from * generic/tcl.h: comments. [Bug 848440, second part] * tests/fCmd.test: Rewrote tests that failed consistently on NFS so they either succeed (through slightly more liberal matching of the results) or are constrained to not run. [Bug 931312] * doc/bgerror.n: Use idiomatic open flags for working with log files. [Bug 959602] 2004-05-24 Jeff Hobbs * generic/tclExecute.c (VerifyExprObjType): use GET_WIDE_OR_INT to properly have tclIntType used for smaller values. This corrects [TclX Bug 896727] and any other 3rd party extension that created math functions but was not yet WIDE_INT aware in them. 2004-05-24 Donal K. Fellows * generic/tclInterp.c (TclInitLimitSupport): Made limits work on platforms where sizeof(void*)!=sizeof(int). [Bug 959193] 2004-05-24 Miguel Sofer * doc/set.n: accurate description of name resolution process, referring to namespace.n for details [Bug 959180] 2004-05-23 Miguel Sofer * generic/tclNamesp.c (Tcl_FindNamespaceVar): [Bug 959052] fixed, insuring that no "zombie" variables are found. * generic/tclVar.c (TclLookupSimpleVar): comments re [Bug 736729] (predecessor of [Bug 959052]) removed. * tests/namespace.test: added tests 17.10-12 The patch modifies non-documented behaviour, and passes every test in the testsuite. However, scripts relying on the old behaviour may break. Note that the only behaviour change concerns the creative writing of unset variables. More precisely, which variable will be created when neither a namespace variable nor a global variable by that name exists, as defined by [info vars]. The new behaviour is that the namespace resolution process deems a variable to exist exactly when [info vars] finds it - ie, either it has value, or else it was "fixed" by a call to [variable]. Note: this patch was removed on 2002-05-25. 2004-05-22 Miguel Sofer * generic/tclVar.c (TclObjLookupVar, TclObjUnsetVar2): fix for new (in tcl8.4) exteriorisations of [Bug 736729] due to the use of tclNsVarNameType obj types. Reenabling the use of this objType ("VAR ref absolute" benchmark down to 66 ms, from 230). Added comments in TclLookupSimpleVar explaining my current understanding of [Bug 736729]. 2004-05-22 Miguel Sofer * generic/tclVar.c: fix for [Bug 735335]. The use of tclNsVarNameType objs is still disabled, pending resolution of [Bug 736729]. 2004-05-21 Miguel Sofer * tests/namespace.test (namespace-41.3): removed the {knownBug} constraint: [Bug 231259] is closed since nov 2001, and the fix of [Bug 729692] (INST_START_CMD) makes the test succeed. 2004-05-21 Donal K. Fellows * generic/tclExecute.c (TclExecuteByteCode): Move a few declarations a short distance so pre-C99 compilers can cope. Also fix so TCL_COMPILE_DEBUG path compiles... 2004-05-21 Miguel Sofer * generic/tclExecute.c (TclExecuteByteCode): reorganised TEBC automatic variables, defining them in tight blocks instead of at the function level. This has three purposes: - it simplifies the analysis of individual instructions - it is preliminary work to the non-recursive engine - it allows a better register allocation by the optimiser; under gcc3.3, this results in up to 10% runtime in some tests 2004-05-20 Donal K. Fellows * generic/tclInterp.c (TclLimitRemoveAllHandlers): * generic/tclBasic.c (DeleteInterpProc): * tests/interp.test (interp-34.7): Ensure that all limit callbacks are deleted when their interpreters are deleted. [Bug 956083] 2004-05-19 Kevin B. Kenny * win/tclWinFile.c (TclpMatchInDirectory): fix for an issue where there was a sneak path from Tcl_DStringFree to SetErrorCode(0). The result was that the error code could be reset between a call to FindFirstFileEx and the check of its status return, leading to a bizarre error return of {POSIX unknown {No error}}. (Found in unplanned test - no incident logged at SourceForge.) 2004-05-19 Donal K. Fellows * tests/interp.test (interp-34.3): Rewrite this test to see if a time limit can catch a tight bytecode loop, a maximally aggressive denial-of-service attack. * generic/tclInterp.c (Tcl_LimitCheck): Fix the sense of checks to see whether a time limit has been extended. * tests/*.test: Many minor fixes, including ensuring that every test is run (so constraints control whether the test is doing anything) and making sure that constraints are always set using the API instead of poking around inside tcltest's internal datastructures. Also got rid of all trailing whitespace lines from the test suite! 2004-05-19 Andreas Kupries * generic/tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem * generic/tclIO.h: as [SF Tcl Bug 462317], see ChangeLog entry 2001-09-26. The fix done at that time is incomplete. It is possible to get around it if the actual read operation is defered and not executed in the event handler itself. Instead of tracking if we are in an read caused by a synthesized fileevent we now track if the OS has delivered a true event = actual data and bypass the driver if a read finds that there is no actual data waiting. The flag is cleared by a short or full read. ***POTENTIAL INCOMPATIBILITY*** for channel drivers. 2004-05-17 Vince Darley * generic/tclPathObj.c: fix to (Bug 956063) in 'file dirname'. * tests/cmdAH.test: added test for this bug. * doc/FileSystem.3: better documentation of refCount requirements of some FS functions (Bug 956126) 2004-05-19 Donal K. Fellows * generic/tclTest.c (TestgetintCmd): Made the tests in get.test check * tests/get.test: Tcl_GetInt() since the core now avoids that function. 2004-05-18 Kevin B. Kenny * compat/strftime.c (_fmt, ISO8601Week): * doc/clock.n: * tests/clock.test: Major rework to the handling of ISO8601 week numbers. Now passes all the %G and %V test cases on Windows, Linux and Solaris [Bugs 500285, 500389, and 852944] 2004-05-18 Donal K. Fellows * doc/append.n, doc/upvar.n: Added example. 2004-05-18 David Gravereaux * win/makefile.vc: now generates a tclConfig.sh from Pat Thoyts [Patch 909911] 2004-05-18 Donal K. Fellows * doc/lsearch.n: Improve clarity (based on [Patch 955361] by Peter Spjuth) * tools/man2help2.tcl (macro,SHmacro): Added support for subsection (.SS) header macros. * doc/interp.n: Added user documentation for the TIP#143 resource limits and some examples. * generic/tclInterp.c (Tcl_LimitCheck, Tcl_LimitTypeReset): Reset the limit-exceeded flag when removing a limit. 2004-05-18 Miguel Sofer * generic/tclExecute.c (TclExecuteByteCode): added comments to classify the variables according to their use in TEBC. 2004-05-17 Donal K. Fellows * doc/global.n, doc/uplevel.n: Added an example. * tests/info.test (info-3.1): Corrected test result back to what it used to be in Tcl 7.* now that command counts are being correctly kept * generic/tclExecute.c (TEBC:INST_START_CMD): Make sure that the command-count is always advanced. Allows TIP#143 limits to tell that work is being done. * doc/list.n: Updated example to fit with the unified format. * doc/seek.n: Added some examples. 2004-05-17 Vince Darley * win/tclWinFile.c: * tests/cmdAH.test: fix to (Bug 954263) where 'file executable' was case-sensitive. 2004-05-17 Donal K. Fellows * doc/OpenFileChnl.3: Documented type of 'offset' argument to Tcl_Seek was wrong. [Bug 953374] 2004-05-16 Miguel Sofer * generic/tclExecute.c (TclExecuteByteCode): remove one level of indirection for compiledLocals addressing. 2004-05-16 Miguel Sofer * generic/tclExecute.c (INST_CALL_FUNC1): bugfix; restored (DE)CACHE_STACK_INFO pair around the call - the user defined math function could cause a recursive call to TEBC. 2004-05-16 Miguel Sofer * generic/tclBasic.c (Tcl_DeleteInterp): * generic/tclExecute.c (INST_START_CMD): interp deletion now modifies the compileEpoch, eliminating the need for the check for interp deletion in INST_START_CMD. 2004-05-16 Miguel Sofer * generic/tclCompile.h: * generic/tclCompile.c: * generic/tclExecute.c: changed implementation of {expand}, last chance while in alpha as ... ***POTENTIAL INCOMPATIBILITY*** Scripts precompiled with ProComp under previous tcl8.5a versions may malfunction due to changed instruction numbers for INST_LIST_INDEX_IMM, INST_LIST_RANGE_IMM and INST_START_CMD. 2004-05-14 Kevin B. Kenny * generic/tclInt.decls: Promoted TclpLocaltime and TclpGmtime * generic/tclIntDecls.h: from Unix-specific stubs to the generic * generic/tclIntPlatDecls.h: internal Stubs table. Reran 'genstubs' * generic/tclStubInit.c: * unix/tclUnixPort.h: * generic/tclClock.c: Changed a buggy 'GMT' timezone specification to the correct 'GMT0'. [Bug 922848] * unix/tclUnixThrd.c: Moved TclpGmtime and TclpLocaltime to unix/tclUnixTime.c where they belong. * unix/tclUnixTime.c (TclpGmtime, TclpLocaltime, TclpGetTimeZone, ThreadSafeGMTime [removed], ThreadSafeLocalTime [removed], SetTZIfNecessary, CleanupMemory): Restructured to make sure that the same mutex protects all calls to localtime, gmtime, and tzset. Added a check in front of those calls to make sure that the TZ env var hasn't changed since the last call to tzset, and repeat tzset if necessary. [Bug 942078] Removed a buggy test of the Daylight Saving Time information in 'gettimeofday' in favor of applying 'localtime' to a known value. [Bug 922848] * tests/clock.test (clock-3.14): Added test to make sure that changes to $env(TZ) take effect immediately. * win/tclWinTime.c (TclpLocaltime, TclpGmtime): Added porting layer for 'localtime' and 'gmtime' calls. 2004-05-14 Miguel Sofer * generic/tclExecute.c: * generic/tclCompile.h: the math functions receive a pointer to top of the stack (tosPtr) instead of the execution environment (eePtr). First step towards a change in the execution stack management - it is now only used within TEBC. 2004-05-13 Donal K. Fellows TIP#143 IMPLEMENTATION * generic/tclExecute.c (TclCompEvalObj, TclExecuteByteCode): * generic/tclBasic.c (TclEvalObjvInternal): Enable limit checking. * generic/tclInterp.c (Tcl_Limit*): Public limit API. * generic/tcl.decls: * tests/interp.test: Basic tests of command limits. * doc/binary.n: TIP#129 IMPLEMENTATION [Patch 858211] * generic/tclBinary.c: Note that the test suite probably has many more * tests/binary.test: failures now due to alterations in constraints. 2004-05-12 Miguel Sofer Optimisations for INST_START_CMD [Bug 926164]. * generic/tclCompile.c (TclCompileScript): avoid emitting INST_START_CMD as the first instruction in a bytecoded Tcl_Obj. It is not needed, as the checks are done before calling TEBC. * generic/tclExecute.c (TclExecuteByteCode): runtime peephole optimisation: check at INST_POP if the next instruction is INST_START_CMD, in which case we fall through. 2004-05-11 Donal K. Fellows * doc/split.n, doc/join.n: Updated examples and added more. 2004-05-11 Vince Darley * doc/glob.n: documented behaviour of symbolic links with 'glob -types d' (Bug 951489) 2004-05-11 Donal K. Fellows * doc/scan.n: Updated the examples to be clearer about their relevance to the scan command. 2004-05-10 Donal K. Fellows * doc/scan.n: Added examples. 2004-05-10 David Gravereaux * win/tclWinPipe.c (BuildCommandLine): Moved non-obvious appending logic to outside the loop and added commentary for its purpose. Also use the existence of contents in the linePtr rather than the scratch DString post the append, as this more clear. (TclpCreateProcess): When under NT, with no console, and executing a DOS application, the path priming does not need an ending space as BuildCommandLine() will do this for us. 2004-05-08 Vince Darley * generic/tclFileName.c: * generic/tclIOUtil.c: remove some compiler warnings on MacOS X. 2004-05-07 Chengye Mao * win/tclWinPipe.c: refixed bug 789040 re-entered in rev 1.41. Let's be careful and don't re-enter previously fixed bugs. 2004-05-08 Donal K. Fellows * doc/format.n: Added examples. 2004-05-07 Miguel Sofer * doc/unset.n: added upvar.n to the "see also" list 2004-05-07 Reinhard Max * generic/tclEncoding.c: * tests/encoding.test: added support and tests for translating embedded null characters between real nullbytes and the internal representation on input/output [Bug 949905]. 2004-05-07 Vince Darley * generic/tclFileName.c: * generic/tclIOUtil.c: * generic/tclFileSystem.h: * tests/fileSystem.test: fix for [Bug 943995], in which vfs-registered root volumes were not handled correctly as glob patterns in all circumstances. 2004-05-06 Miguel Sofer * generic/tclInt.h: * generic/tclObj.c (TclFreeObj): made TclFreeObj use the new macro TclFreeObjMacro(), so that the allocation and freeing of Tcl_Obj is defined in a single spot (the macros in tclInt.h), with the exception of the TCL_MEM_DEBUG case. The #ifdef logic for the corresponding macros has been reformulated to make it clearer. 2004-05-05 Donal K. Fellows * doc/break.n, doc/continue.n, doc/for.n, doc/while.n: More examples. 2004-05-05 Don Porter * tests/unixInit.test (unixInit-2.10): Test correction for Mac OSX. Be sure to consistently compare normalized path names. Thanks to Steven Abner (tauvan). [Bug 948177] 2004-05-05 Donal K. Fellows * doc/CrtObjCmd.3: Remove reference to Tcl_RenameCommand; there is no such API. [Bug 848440] 2004-05-05 David Gravereaux * win/tclWinSock.c (SocketEventProc) : connect errors should fire both the readable and writable handlers because this is how it works on UNIX [Bug 794839] * generic/tclEncoding.c (TclFinalizeEncodingSubsystem): FreeEncoding(systemEncoding); moved to before the hash table iteration as it was causing a double free attempt under some conditions. * win/coffbase.txt: Added the tls extension to the list of preferred load addresses. 2004-05-04 Jeff Hobbs * tests/fileSystem.test (filesystem-1.39): replace 'file volumes' * tests/fileName.test (filename-12.9,10): lindex with direct C:/ hard-coded because A:/ was being used and that is empty for most. * tests/winFCmd.test (winFCmd-16.12): test volumerelative $HOME 2004-05-04 Don Porter * generic/tclAlloc.c: Make sure Tclp*Alloc* routines get * generic/tclInt.h: declared in the TCL_MEM_DEBUG and * generic/tclThreadAlloc.c: TCL_THREADS configuration. [Bug 947564] * tests/tcltest.test: Test corrections for Mac OSX. Thanks to Steven Abner (tauvan). [Bug 947440] 2004-05-04 Donal K. Fellows * generic/tclEvent.c (TclSetLibraryPath): Suppress a warning. 2004-05-03 Andreas Kupries * Applied [Patch 868853], fixing a mem leak in TtySetOptionProc. Report and Patch provided by Stuart Cassoff . 2004-05-03 Miguel Sofer * generic/tclProc.c (TclCreateProc): comments corrected. 2004-05-03 Miguel Sofer * generic/tclCompile.c (TclCompileScript): setting the compilation namespace outside of the loop. 2004-05-03 Miguel Sofer * generic/tclCompile.c: * generic/tclInt.h: reverted fix for [Bug 926445] of 2004-04-02, restoring TCL_ALIGN to the header file. Todd Helfter reported that the macro is required by tbcload. 2004-05-03 Kevin Kenny * win/tclWin32Dll.c (TclpCheckStackSpace): * tests/stack.test (stack-3.1): Fix for undetected stack overflow in TclReExec on Windows. [Bug 947070] 2004-05-03 Don Porter * library/init.tcl: Corrected unique prefix matching of interactive command completion in [unknown]. [Bug 946952] 2004-05-02 Miguel Sofer * generic/tclProc.c (TclObjInvokeProc): * tests/proc.test (proc-3.6): fix for bad quoting of multi-word proc names in error messages [Bug 942757] 2004-04-30 Donal K. Fellows * doc/glob.n, doc/incr.n, doc/set.n: More examples. * doc/if.n, doc/rename.n, doc/time.n: 2004-04-30 Don Porter * generic/tclInt.h: Replaced Kevin Kenny's temporary * generic/tclThreadAlloc.c: fix for Bug 945447 with a cleaner, more permanent replacement. 2004-04-30 Kevin B. Kenny * generic/tclThreadAlloc.c: Added a temporary (or so I hope!) inclusion of "tclWinInt.h" to avoid problems when compiling on Win32-VC++ with --enable-threads. [Bug 945447] 2004-04-30 Donal K. Fellows * doc/puts.n: Added a few examples. 2004-04-29 Don Porter * tests/execute.test (execute-8.2): Avoid crashes when there is limited system stack space (threads-enabled). 2004-04-28 Miguel Sofer * doc/global.n: * doc/upvar.n: * generic/tclVar.c (ObjMakeUpvar): * tests/upvar.test (upvar-8.11): * tests/var.test (var-3.11): Avoid creation of unusable variables: [Bug 600812] [TIP 184]. 2004-04-28 Donal K. Fellows * doc/lsearch.n: Fixed fault in documentation of -index option [943448] 2004-04-26 Don Porter * unix/tclUnixFCmd.c (TclpObjNormalizePath): Corrected improper positioning of returned checkpoint. [Bug 941108] 2004-04-26 Donal K. Fellows * doc/open.n, doc/close.n: Updated (thanks to David Welton) to be clearer about pipeline errors and added example to open(n) that shows simple pipeline use. [Patches 941377,941380] * doc/DictObj.3: Added warning about the use of Tcl_DictObjDone and an example of use of iteration. [Bug 940843] * doc/Thread.3: Reworked to remove references to testing interfaces and instead promote the use of the Thread package. [Patch 932527] Also reworked and reordered the page for better readability. 2004-04-25 Don Porter * generic/tcl.h: Removed obsolete declarations and #include's. * generic/tclInt.h: [Bugs 926459, 926486] 2004-04-24 David Gravereaux * win/tclWin32Dll.c (DllMain): Added DisableThreadLibraryCalls() for the DLL_PROCESS_ATTACH case. We're not interested in knowing about DLL_THREAD_ATTACH, so disable the notices. 2004-04-24 Daniel Steffen * generic/tclPort.h: * macosx/Makefile: * unix/Makefile.in: followup on tcl header reform [FR 922727]: removed use of relative #include paths in tclPort.h to allow installation of private headers outside of tcl source tree; added 'unix' dir to compiler header search path; add newly required tcl private headers to Tcl.framework on Mac OSX. 2004-04-23 Andreas Kupries * generic/tclIO.c (Tcl_SetChannelOption): Fixed [SF Tcl Bug 930851]. When changing the eofchar we have to zap the related flags to prevent them from prematurely aborting the next read. 2004-04-25 Vince Darley * generic/tclPathObj.c: fix to [Bug 940281]. Tcl_FSJoinPath will now always return a valid Tcl_Obj when the input is valid. * generic/tclIOUtil.c: fix to [Bug 931823] for a more consistent Tcl_FSPathSeparator() implementation which allows filesystems not to implement their Tcl_FSFilesystemSeparatorProc if they wish to use the default '/'. Also fixed associated memory leak seen with, e.g., tclvfs package. * doc/FileSystem.3: documented Tcl_FSJoinPath return values more clearly, and Tcl_FSFilesystemSeparatorProc requirements. 2004-04-23 David Gravereaux * win/tclWin32Dll.c: Removed my mistake from 4/19 of adding an exit handler to TclWinInit. TclWinEncodingsCleanup called from TclFinalizeFilesystem does the Tcl_FreeEncoding for us. * win/tclWinChan.c (Tcl_MakeFileChannel): Case for CloseHandle returning zero and not throwing a RaiseException(EXCEPTION_INVALID_HANDLE) now being done. 2004-04-22 David Gravereaux * generic/tclEvent.c: TclSetLibraryPath's use of caching the stringrep of the pathPtr object to TclGetLibraryPath called from another thread was ineffective if the original's stringrep had been invalidated as what happens when it gets muted to a list. * win/tclWinTime.c: If the Tcl_ExitProc (StopCalibration) is called from the stack frame of DllMain's PROCESS_DETACH, the wait operation should timeout and continue. * generic/tclInt.h: * generic/tclThread.c: * generic/tclEvent.c: * unix/tclUnixThrd.c: * win/tclWinThrd.c: Provisions made so masterLock, initLock, allocLock and joinLock mutexes can be recovered during Tcl_Finalize. 2004-04-22 Donal K. Fellows * doc/switch.n: Reworked the examples to be more systematically named and to cover some TIP#75 capabilities. * doc/cd.n: Documentation clarification from David Welton. * doc/exec.n: Added some examples, Windows ones from Arjen Markus and Unix ones by myself. 2004-04-21 Donal K. Fellows * doc/Hash.3: Added note to Tcl_{First,Next}HashEntry docs that deleting the element they return is supported (and is in fact the only safe update you can do to the structure of a hashtable while an iteration is going over it.) * doc/bgerror.n: Added example from David Welton. [Patch 939473] * doc/after.n: Added examples from David Welton. [Patch 938820] 2004-04-19 David Gravereaux * win/tclWin32Dll.c: Added an exit handler in TclWinInit() so tclWinTCharEncoding could be freed during Tcl_Finalize(). * generic/tclEncoding.c: Added FreeEncoding(systemEncoding) in TclFinalizeEncodingSubsystem because its ref count was incremented in TclInitEncodingSubsystem. 2004-04-19 Donal K. Fellows * doc/read.n: Added example from David Welton. [Patch 938056] 2004-04-19 Kevin B. Kenny * generic/tclObj.c (Tcl_GetDoubleFromObj) Corrected "short circuit" conversion of int to double. Reported by Jeff Hobbs on the Tcl'ers Chat. 2004-04-16 Donal K. Fellows * doc/lreplace.n, doc/lrange.n, doc/llength.n: More examples for * doc/linsert.n, doc/lappend.n: the documentation. 2004-04-16 Vince Darley * doc/FileSystem.3: Corrected documentation of Tcl_FSUtime, and the corresponding filesystem driver Tcl_FSUtimeProc. [Bug 935838] 2004-04-16 Donal K. Fellows * doc/socket.n: Added example from [Patch 936245]. * doc/gets.n: Added example based on [Patch 935911]. 2004-04-15 Donal K. Fellows * generic/tclClock.c (Tcl_ClockObjCmd): Minor fault in a [clock clicks] error message. 2004-04-07 Jeff Hobbs * win/tclWinInit.c (TclpSetInitialEncodings): note that WIN32_CE is also a unicode platform. * generic/tclEncoding.c (TclFindEncodings, Tcl_FindExecutable): * generic/tclInt.h: Correct handling of UTF * unix/tclUnixInit.c (TclpInitLibraryPath): data that is actually * win/tclWinFile.c (TclpFindExecutable): "clean", allowing the * win/tclWinInit.c (TclpInitLibraryPath): loading of Tcl from paths that contain multi-byte chars on Windows [Bug 920667] * win/configure: define TCL_LIB_FLAG, TCL_BUILD_LIB_SPEC, * win/configure.in: TCL_LIB_SPEC, TCL_PACKAGE_PATH in tclConfig.sh. 2004-04-06 Don Porter Patch 922727 committed. Implements three changes: * generic/tclInt.h: Reworked the Tcl header files into a clean * unix/tclUnixPort.h: hierarchy where tcl.h < tclPort.h < tclInt.h * win/tclWinInt.h: and every C source file should #include * win/tclWinPort.h: at most one of those files to satisfy its declaration needs. tclWinInt.h and tclWinPort.h also better organized so that tclWinPort.h includes the Windows implementation of cross-platform declarations, while tclWinInt.h makes declarations that are available on Windows only. * generic/tclBinary.c (TCL_NO_MATH): Deleted the generic/tclMath.h * generic/tclMath.h (removed): header file. The internal Tcl * macosx/Makefile (PRIVATE_HEADERS): header, tclInt.h, has a * win/tcl.dsp: #include directly, and file external to Tcl needing libm should do the same. * win/Makefile.in (WIN_OBJS): Deleted the win/tclWinMtherr.c file. * win/makefile.bc (TCLOBJS): It's a vestige from matherr() days * win/makefile.vc (TCLOBJS): gone by. * win/tcl.dsp: * win/tclWinMtherr.c (removed): End Patch 922727. * tests/unixInit.test (unixInit-3.1): Default encoding on Darwin systems is utf-8. Thanks to Steven Abner (tauvan). [Bug 928808] 2004-04-06 Donal K. Fellows * tests/cmdAH.test (cmdAH-18.2): Added constraint because access(...,X_OK) is defined to be permitted to be meaningless when running as root, and OSX exhibits this. [Bug 929892] 2004-04-02 Miguel Sofer * generic/tclCompile.c: * generic/tclInt.h: removed the macro TCL_ALIGN() from tclInt.h, replaced by the static macro ALIGN() in tclCompile.c [Bug 926445] 2004-04-02 Miguel Sofer * generic/tclCompile.h: removed redundant #ifdef _TCLINT [Bug 928415], reported by tauvan. 2004-04-02 Don Porter * tests/tcltest.test: Corrected constraint typos: "nonRoot" -> "notRoot". Thanks to Steven Abner (tauvan). [Bug 928353] 2004-04-01 Don Porter * generic/tclInt.h: Removed obsolete tclBlockTime* declarations. [Bug 926454] 2004-04-01 Vince Darley * generic/tclIOUtil.c: Fix to privately reported vfs bug with 'glob -type d -dir . *' across a vfs boundary. No tests for this are currently possible without effectively moving tclvfs into Tcl's test suite. 2004-03-31 Don Porter * doc/msgcat.n: Clarified message catalog file encodings. [Bug 811457] * library/msgcat/msgcat.tcl: Updated internals to make use of [dict]s to store message catalog data and to use [source -encoding utf-8] to access catalog files. Thanks to Michael Sclenker. [Patch 875055, RFE 811459] Corrected [mcset] to be able to successfully set a translation to the empty string. [mcset $loc $src {}] was incorrectly set the $loc translation of $src back to $src. Also changed [ConvertLocale] to minimally require a non-empty "language" part in the locale value. If not, an error raised prompts [Init] to keep looking for a valid locale value, or ultimately fall back on the "C" locale. [Bug 811461]. * library/msgcat/pkgIndex.tcl: Bump to msgcat 1.4.1. 2004-03-30 Donal K. Fellows * generic/tclHash.c (HashStringKey): Cleaned up. This function is not faster, but it is a little bit clearer. * generic/tclLiteral.c (HashString): Applied logic from HashObjKey. * generic/tclObj.c (HashObjKey): Rewrote to fix fault which hashed every single-character object to the same hash bucket. The new code is shorter, simpler, clearer, and (happily) faster. 2004-03-30 Miguel Sofer * generic/tclExecute.c (TEBC): reverting to the previous method for async tests in TEBC, as the new method turned out to be too costly. Async tests now run every 64 instructions. 2004-03-30 Miguel Sofer * generic/tclCompile.c: New instruction code INST_START_CMD that * generic/tclCompile.h: allows checking the bytecode's validity * generic/tclExecute.c: [Bug 729692] and the interp's readyness * tests/interp.test (18.9): [Bug 495830] before running the command. * tests/proc.test (7.1): It also changes the mechanics of the async * tests/rename.test (6.1): tests in TEBC, doing it now at command start instead of every 16 instructions. 2004-03-30 Vince Darley * generic/tclFileName.c: Fix to Windows glob where the pattern is a * generic/tclIOUtil.c: volume relative path or a network share [Bug * tests/fileName.test: 898238]. On windows 'glob' will now return * tests/fileSystem.test: the results of 'glob /foo/bar' and 'glob \\foo\\bar' as 'C:/foo/bar', i.e. a correct absolute path (rather than a volume relative path). Note that the test suite does not test commands like 'glob //Machine/Shared/*' (on a network share). 2004-03-30 Vince Darley * generic/tclPathObj.c: Fix to filename bugs recently * tests/fileName.test: introduced [Bug 918320]. 2004-03-29 Don Porter * generic/tclMain.c (Tcl_Main, StdinProc): Append newline only * tests/basic.test (basic-46.1): to incomplete scripts as part of multi-line script construction. Do not add an extra trailing newline to the complete script. [Bug 833150] 2004-03-28 Miguel Sofer * generic/tclCompile.c (TclCompileScript): corrected possible segfault when a compilation returns TCL_OUTLINE_COMPILE after having grown the compile environment [Bug 925121]. 2004-03-27 Miguel Sofer * doc/array.n: added documentation for trace-realted behaviour of 'array get' [Bug 449893] 2004-03-26 Don Porter * README: Bumped version number to 8.5a2 to distinguish * tools/tcl.wse.in: HEAD of CVS development from the recent 8.5a1 * unix/configure.in: release. * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf-2.57 * win/configure: 2004-03-26 Vince Darley * generic/tclPathObj.c: Fix to Windows-only volume relative path * tests/fileSystem.test: normalization. [Bug 923568]. Also fixed another volume relative bug found while testing. 2004-03-24 Donal K. Fellows * generic/tclNamesp.c (NsEnsembleImplementationCmd): Fix messed up handling of strncmp result which just happened to work in some libc implementations. [Bug 922752] 2004-03-23 Donal K. Fellows * doc/StringObj.3: Inverted the sense of the documentation of how the bytes parameter is documented to match behaviour. [Bug 921464] 2004-03-19 Kevin B. Kenny * compat/strtoll.c: * compat/strtoull.c: * generic/tclIntDecls.h: * generic/tclMain.c: * generic/tclObj.c: * win/tclWinDde.c: * win/tclWinReg.c: * win/tclWinTime.c: Made HEAD build on Windows VC++ again. 2004-03-19 Donal K. Fellows * generic/tclIntDecls.h: Made HEAD build on Solaris again by applying fix recommended by Don Porter. 2004-03-18 Reinhard Max * generic/tclIntDecls.h: Removed TclpTime_t. It wasn't really needed, * generic/tclInt.h: but caused warnings related to * generic/tclInt.decls: strict aliasing with GCC 3.3. * generic/tclClock.c: * generic/tclDate.c: * generic/tclGetDate.y: * win/tclWinTime.c: * unix/tclUnixTime.c: * generic/tclNamesp.c: Added temporary pointer variables to work * generic/tclStubLib.c: around warnings related to * unix/tclUnixChan.c: strict aliasing with GCC 3.3. * unix/tcl.m4: Removed -Wno-strict-aliasing. 2004-03-18 Daniel Steffen Removed support for Mac OS Classic platform [Patch 918142] * README: * compat/string.h: * doc/Encoding.3: * doc/FileSystem.3: * doc/Init.3: * doc/Macintosh.3 (removed): * doc/OpenFileChnl.3: * doc/OpenTcp.3: * doc/SourceRCFile.3: * doc/Thread.3: * doc/clock.n: * doc/exec.n: * doc/fconfigure.n: * doc/file.n: * doc/filename.n: * doc/glob.n: * doc/open.n: * doc/puts.n: * doc/resource.n (removed): * doc/safe.n: * doc/source.n: * doc/tclvars.n: * doc/unload.n: * generic/README: * generic/tcl.decls: * generic/tcl.h: * generic/tclAlloc.c: * generic/tclBasic.c: * generic/tclCmdAH.c: * generic/tclDate.c: * generic/tclDecls.h: * generic/tclFCmd.c: * generic/tclFileName.c: * generic/tclGetDate.y: * generic/tclIOCmd.c: * generic/tclIOUtil.c: * generic/tclInitScript.h: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclMain.c: * generic/tclMath.h: * generic/tclNotify.c: * generic/tclPathObj.c: * generic/tclPlatDecls.h: * generic/tclPort.h: * generic/tclStubInit.c: * generic/tclTest.c: * generic/tclThreadJoin.c: * library/auto.tcl: * library/init.tcl: * library/package.tcl: * library/safe.tcl: * library/tclIndex: * mac/AppleScript.html (removed): * mac/Background.doc (removed): * mac/MW_TclAppleScriptHeader.h (removed): * mac/MW_TclAppleScriptHeader.pch (removed): * mac/MW_TclBuildLibHeader.h (removed): * mac/MW_TclBuildLibHeader.pch (removed): * mac/MW_TclHeader.h (removed): * mac/MW_TclHeader.pch (removed): * mac/MW_TclHeaderCommon.h (removed): * mac/MW_TclStaticHeader.h (removed): * mac/MW_TclStaticHeader.pch (removed): * mac/MW_TclTestHeader.h (removed): * mac/MW_TclTestHeader.pch (removed): * mac/README (removed): * mac/bugs.doc (removed): * mac/libmoto.doc (removed): * mac/morefiles.doc (removed): * mac/porting.notes (removed): * mac/tclMac.h (removed): * mac/tclMacAETE.r (removed): * mac/tclMacAlloc.c (removed): * mac/tclMacAppInit.c (removed): * mac/tclMacApplication.r (removed): * mac/tclMacBOAAppInit.c (removed): * mac/tclMacBOAMain.c (removed): * mac/tclMacChan.c (removed): * mac/tclMacCommonPch.h (removed): * mac/tclMacDNR.c (removed): * mac/tclMacEnv.c (removed): * mac/tclMacExit.c (removed): * mac/tclMacFCmd.c (removed): * mac/tclMacFile.c (removed): * mac/tclMacInit.c (removed): * mac/tclMacInt.h (removed): * mac/tclMacInterupt.c (removed): * mac/tclMacLibrary.c (removed): * mac/tclMacLibrary.r (removed): * mac/tclMacLoad.c (removed): * mac/tclMacMath.h (removed): * mac/tclMacNotify.c (removed): * mac/tclMacOSA.c (removed): * mac/tclMacOSA.r (removed): * mac/tclMacPanic.c (removed): * mac/tclMacPkgConfig.c (removed): * mac/tclMacPort.h (removed): * mac/tclMacProjects.sea.hqx (removed): * mac/tclMacResource.c (removed): * mac/tclMacResource.r (removed): * mac/tclMacSock.c (removed): * mac/tclMacTclCode.r (removed): * mac/tclMacTest.c (removed): * mac/tclMacThrd.c (removed): * mac/tclMacThrd.h (removed): * mac/tclMacTime.c (removed): * mac/tclMacUnix.c (removed): * mac/tclMacUtil.c (removed): * mac/tcltkMacBuildSupport.sea.hqx (removed): * tests/all.tcl: * tests/binary.test: * tests/cmdAH.test: * tests/cmdMZ.test: * tests/fCmd.test: * tests/fileName.test: * tests/fileSystem.test: * tests/interp.test: * tests/io.test: * tests/ioCmd.test: * tests/load.test: * tests/macFCmd.test (removed): * tests/osa.test (removed): * tests/resource.test (removed): * tests/socket.test: * tests/source.test: * tests/unload.test: * tools/cvtEOL.tcl (removed): * tools/genStubs.tcl: * unix/Makefile.in: * unix/README: * unix/mkLinks: * unix/tcl.spec: * win/README.binary: * win/tcl.dsp: 2004-03-17 Donal K. Fellows * doc/lsearch.n: Improved examples on the advanced capabilities of lsearch (with the right options, set element removal can be done) following discussion on tkchat. 2004-03-16 Don Porter * doc/catch.n: Compiled [catch] no longer fails to catch syntax errors. Removed the claims in the documentation that it does. * doc/return.n: Updated example to use [dict merge]. 2004-03-16 Jeff Hobbs * unix/configure, unix/tcl.m4: add -Wno-strict-aliasing for GCC to suppress useless type puning warnings. 2004-03-16 Donal K. Fellows * doc/file.n: *roff formatting fix. [Bug 917171] 2004-03-15 David Gravereaux * win/tclWinNotify.c: Fixed a mistake where the return value of MsgWaitForMultipleObjectsEx for "a message is in the queue" wasn't accurate. I removed the check on the case result==(WAIT_OBJECT_0 + 1) This was having the error of falling into GetMessage and waiting there by accident, which wasn't alertable through Tcl_AlertNotifier. I'll do some more study on this and try to find-out why. 2004-03-12 Donal K. Fellows IMPLEMENTATION OF TIP#163 * generic/tclDictObj.c (DictMergeCmd): This is based on work by Joe * tests/dict.test (dict-20.*): English in Tcl [FRQ 745851] * doc/dict.n: but not exactly. 2004-03-10 Kevin B. Kenny * generic/tclGetDate.y (TclGetDate): Fix so that [clock scan -gmt true] uses the GMT base date instead of the local one. [Bug 913513] * tests/clock.test: Added test cases for wrong ISO8601 week number [Bug 500285] and wrong GMT base date [Bug 913513]. Several tests still fail on Windows, and these are actual faults in [clock scan]. Fix is still pending. * generic/tclDate.c: Regenerated. 2004-03-08 Vince Darley * generic/tclFileName.c: Fix to 'glob -path' near the root * tests/fileName.test: of the filesystem. [Bug 910525] 2004-03-08 Don Porter * generic/tclParse.c (TclParseInit): Modified TclParseInit so * generic/tclTest.c ([testexprparser]): that Tcl_Parse initialization conforms to documented promised about what fields will not be modified by what Tcl_Parse* routines. [Bug 910595] 2004-03-05 Mo DeJong * win/configure: Regen. * win/configure.in: Check for define of MWMO_ALERTABLE in winuser.h. * win/tclWinPort.h: If MWMO_ALERTABLE is not defined in winuser.h then define it. This is needed for Mingw. 2004-03-05 Kevin B. Kenny * generic/tclTest.c: Modified TesteventObjCmd to use a Tcl_QueuePosition in place of an 'int' for the enumerated queue position, to avoid a compiler warning on SGI. [Bug 771960] 2004-03-05 Kevin B. Kenny * tests/registry.test: Applied fix from [Patch 910174] to make the test for an English-language system include any country code, rather than just English-United States.1252. Thanks to Pat Thoyts for the changes. 2004-03-04 Pat Thoyts * tests/registry.test: Applied fixed from [Bug 766159] to skip two tests on Win98 that depend on a Unicode registry (NT specific). 2004-03-04 Don Porter * generic/tclInt.h (TclParseInit): Factored the common code * generic/tclParse.c (TclParseInit): for initializing a Tcl_Parse * generic/tclParseExpr.c: struct into one routine. 2004-03-04 Pat Thoyts * library/reg/pkgIndex.tcl: Added TIP #100 support to the * win/tclWinReg.c: registry package [patch 903831] This provides a Windows test of the TIP #100 mechanism and a sample to show how unloading an extension can be done. 2004-03-04 Donal K. Fellows * unix/dltest/pkgua.c: Fix minor syntax problems. [Bug 909288] 2004-03-03 Jeff Hobbs *** 8.5a1 TAGGED FOR RELEASE *** * changes: updated for 8.5a1 2004-03-03 David Gravereaux * win/makefile.vc: default environment variable for VC++ is %MSDevDir% not %MSVCDir%, although vcvars32.bat sets both. * win/tclWinNotify.c (Tcl_WaitForEvent) : Allows an idling notifier to service "Asynchronous Procedure Calls" from its wait state. Only useful for extension authors who decide they might want to try "completion routines" with WriteFileEx(), as an example. From experience, I recommend that "completion ports" should be used instead as the execution of the callbacks are more managable. 2004-03-01 Jeff Hobbs * README: update patchlevel to 8.5a1 * generic/tcl.h: * tools/tcl.wse.in, tools/tclSplash.bmp: * unix/configure, unix/configure.in, unix/tcl.spec: * win/README.binary, win/configure, win/configure.in: * unix/tcl.m4: update HP-11 build libs setup 2004-03-01 Don Porter * unix/tcl.m4 (SC_CONFIG_CFLAGS): Allow 64-bit enabling on IRIX64-6.5* systems. [Bug 218561] * unix/configure: autoconf-2.57 * generic/tclTrace.c (TclCheckInterpTraces): The TIP 62 * generic/tclTest.c (TestcmdtraceCmd): implementation introduced a * tests/trace.test (trace-29.10): bug by testing the CallFrame level instead of the iPtr->numLevels level when deciding what traces created by Tcl_Create(Obj)Trace to call. Added test to expose the error, and made fix. [FRQ 462580] 2004-02-28 Vince Darley * tests/fileSystem.test: fix to Tcl Bug 905163. * tests/fileName.test: fix to Tcl Bug 904705. * doc/{various}.n: removed 'the the' typos. 2004-02-26 Daniel Steffen * macosx/Makefile: fixed copyright year in Tcl.framework Info.plist 2004-02-25 Don Porter * tests/basic.test: Made several tests more robust to the * tests/cmdMZ.test: list-quoting of path names that might contain * tests/exec.test: Tcl-special chars like { or [. Should help us * tests/io.test: sort out [Bug 554068] * tests/pid.test: * tests/socket.test: * tests/source.test: * tests/unixInit.test: 2004-02-25 Donal K. Fellows * generic/tclLoad.c (Tcl_LoadObjCmd): Missing dereference caused segfault with non-loadable extension. [Bug 904307] * unix/tclUnixChan.c (TcpGetOptionProc): Stop memory leak with very long hostnames. [Bug 888777] 2004-02-25 Pat Thoyts * win/tclWinDde.c: Removed some gcc warnings - except for the -Wconversion warning for GetGlobalAtomName. gcc is just wrong about this. 2004-02-24 Donal K. Fellows IMPLEMENTATION OF TIP#100 FROM GEORGIOS PETASIS * generic/tclLoad.c (Tcl_UnloadObjCmd): Implementation. * tests/unload.test: Test suite. * unix/dltest/pkgua.c: Helper for test suite. * doc/unload.n: Documentation. Also assorted changes (mostly small) to several other files. 2004-02-23 Donal K. Fellows * generic/regc_locale.c (cclass): Buffer was having its size reset instead of being released => memleak. [Bug 902562] 2004-02-21 Donal K. Fellows * generic/tclLoad.c (Tcl_LoadObjCmd): Fixed memory leak due to an improper error exit route. 2004-02-20 David Gravereaux * win/tclWinSock.c (SocketThreadExitHandler): Don't call TerminateThread when WaitForSingleObject returns a timeout. Tcl_Finalize called from DllMain will pause all threads. Trust that the thread will get the close notice at a later time if it does ever wake up before being cleaned up by the system anyway. 2004-02-17 Don Porter * doc/tcltest.n: * library/tcltest/tcltest.tcl: Changed -verbose default value to {body error} so that detailed information on unexpected errors in tests is provided by default, even after the fix for [Bug 725253] 2004-02-17 Jeff Hobbs * tests/unixInit.test (unixInit-7.1): * unix/tclUnixInit.c (TclpInitPlatform): ensure the std fds exist to prevent crash condition [Bug 772288] 2004-02-17 Donal K. Fellows * generic/tclCompCmds.c (TclCompileSwitchCmd): Bozo mistake in memory releasing order when in an error case. [Bug 898910] 2004-02-16 Jeff Hobbs * generic/tclTrace.c (TclTraceExecutionObjCmd) (TclTraceCommandObjCmd): fix possible mem leak in trace info. 2004-02-12 Mo DeJong * win/tclWinInit.c (AppendEnvironment): Use the tail component of the passed in lib path instead of just blindly using lib+4. That worked when lib was "lib/..." but fails for other values. Thanks go to Patrick Samson for pointing this out. 2004-02-10 David Gravereaux * win/nmakehlp.c: better macro grepping logic. 2004-02-07 David Gravereaux * win/makefile.vc: * win/rules.vc: * win/tcl.rc: * win/tclsh.rc: Added an 'unchecked' option to the OPTS macro so a core built with symbols can be linked to the non-debug enabled C run-time. As per discussion with Kevin Kenny. Called like this: nmake -af makefile.vc OPTS=unchecked,symbols This clarifies the meaning of the 'g' naming suffix to mean only that the binary requires the debug enabled C run-time. Whether the binary contains symbols or not is a different condition. 2004-02-06 Don Porter * doc/clock.n: Removed reference to non-existent [file ctime]. 2004-02-05 David Gravereaux * docs/tclvars.n: Added clarification of the tcl_platform(debug) var that it only refers to the flavor of the C run-time, and not whether the core contains symbols. 2004-02-05 Don Porter * generic/tclFileName.c (SkipToChar): Corrected CONST and type-casting issues that caused compiler warnings. 2004-02-04 Don Porter * generic/tclCmdAH.c (StoreStatData): Removed improper refcount decrement of the varName parameter. This error was causing segfaults following test cmdAH-28.7. * library/tcltest/tcltest.tcl: Corrected references to non-existent $name variable in [cleanupTests]. [Bug 833637] 2004-02-03 Don Porter * library/tcltest/tcltest.tcl: Corrected parsing of single command line argument (option with missing value) [Bug 833910] * library/tcltest/pkgIndex.tcl: Bump to version 2.2.5. 2004-02-02 David Gravereaux * generic/tclIO.c (Tcl_Ungets): Fixes improper filling of the channel buffer. This is the buffer before the splice. [Bug 405995] 2004-02-01 David Gravereaux * tests/winPipe.test: more pass-thru commandline verifications. * win/tclWinPipe.c (BuildCommandLine): Special case quoting for '{' not required by the c-runtimes's parse_cmdline(). * win/tclAppInit.c: Removed our custom setargv() in favor of the work provided by the c-runtime. [Bug 672938] * win/nmakehlp.c: defensive techniques to avoid static buffer overflows and a couple envars upsetting invocations of cl.exe and link.exe. [Bug 885537] * tests/winPipe.test: Added proof that BuildCommandLine() is not doing the "N backslashes followed a quote -> insert N * 2 + 1 backslashes then a quote" rule needed for the crt's parse_cmdline(). * win/tclWinPipe.c: Fixed BuildCommandLine() to pass the new cases. 2004-01-30 David Gravereaux * win/makefile.vc: Use the -GZ compiler switch when building for symbols. This is supposed to emulate the release build better to avoid hiding problems that only show themselves in a release build. 2004-01-29 Vince Darley * generic/tclPathObj.c: fix to [Bug 883143] in file normalization 2004-01-29 Vince Darley * doc/file.n: * generic/tclFCmd.c * generic/tclTest.c * library/init.tcl * mac/tclMacFile.c * tests/fileSystem.test: fix to [Bug 886352] where 'file copy -force' had inconsistent behaviour wrt target files with insufficient permissions, particular from vfs->native fs. Behaviour of '-force' is now always consistent (and now consistent with behaviour of 'file delete -force'). Added new tests and documentation and cleaned up the 'simplefs' test filesystem. * generic/tclIOUtil.c * unix/tclUnixFCmd.c * unix/tclUnixFile.c * win/tclWinFile.c: made native filesystems more robust to C code which asks for mount lists. * generic/tclPathObj.c: fix to [Bug 886607] removing warning/error with some compilers. 2004-01-28 Donal K. Fellows * generic/tclObj.c (SetBooleanFromAny): Rewrite to do more efficient string->bool conversion. Many other minor whitespace/style fixes to this file too. 2004-01-27 David Gravereaux * win/nmakehlp.c: Use '.\nul' as the sourcefile name instead of 'nul' so VC 5.2 doesn't try searching the path for it and failing with a possible dialogbox popping up about having to add a CD to an empty drive. Also added a SetErrorMode() call to disable any dialogs that cl.exe or link.exe might create. [Bug 885537] 2004-01-22 Vince Darley * doc/file.n: clarified documentation of 'file system' [Bug 883825] * tests/fCmd.test: improved test result in failure case. 2004-01-22 Vince Darley * tests/fileSystem.test: 3 new tests * generic/tclPathObj.c: fix to [Bug 879555] in file normalization. * doc/filename.n: small clarification to Windows behaviour with filenames like '.....', 'a.....', '.....a'. * generic/tclIOUtil.c: slight improvement to native cwd caching on Windows. 2004-01-21 David Gravereaux * doc/Panic.3: Mentions of 'panic' and 'panicVA' removed from the documentation. 2004-01-21 Vince Darley * doc/FileSystem.3: * generic/tcl.decls: * generic/tclCmdAH.c * generic/tclDecls.h * generic/tclFCmd.c * generic/tclFileName.c * generic/tclFileSystem.h * generic/tclIOUtil.c * generic/tclInt.decls * generic/tclInt.h * generic/tclIntDecls.h * generic/tclPathObj.c * generic/tclStubInit.c * generic/tclTest.c * mac/tclMacFile.c * tests/fileName.test * tests/fileSystem.test * tests/winFCmd.test * unix/tclUnixFile.c * win/tclWin32Dll.c * win/tclWinFCmd.c * win/tclWinFile.c * win/tclWinInt.h Three main issues accomplished: (1) cleaned up variable names in the filesystem code so that 'pathPtr' is used throughout. (2) applied a round of filesystem optimisation with better handling and caching of relative and absolute paths, requiring fewer conversions. (3) clarifications to the documentation, particularly regarding the acceptable refCounts of objects. Some new tests added. Tcl benchmarks show a significant improvement over 8.4.5, and on Windows typically a small improvement over 8.3.5 (Unix still appears to require optimisation). TCL_FILESYSTEM_VERSION_2 introduced, but for internal use only. There should be no public incompatibilities from these changes. Thanks to dgp for extensive testing. 2004-01-19 David Gravereaux * win/tclWinPipe.c (Tcl_WaitPid): Fixed a thread-safety problem with the process list. The delayed cut operation after the wait was going stale by being outside the list lock. It now cuts within the lock and does a locked splice for when it needs to instead. [Bug 859820] 2004-01-18 Donal K. Fellows * generic/tclCompile.c, generic/tclCompile.h: Two new opcodes, INST_LIST_INDEX_IMM and INST_LIST_RANGE_IMM, that have operand(s) of new type OPERAND_IDX4 which represents indexes into things like lists (and perhaps other things eventually.) * generic/tclExecute.c (TclExecuteByteCode): Implementation of the new opcodes. INST_LIST_INDEX_IMM does a simple [lindex] with either front- or end-based simple indexing. INST_LIST_RANGE_IMM does an [lrange] with front- or end-based simple indexing for both the reference to the first and last items in the range. * generic/tclCompCmds.c (TclCompileLassignCmd): Generate bytecode for the [lassign] command. 2004-01-17 David Gravereaux * win/tclWinInit.c: added #pragma comment(lib, "advapi32.lib") when compiling under VC++ so we don't need to specify it when linking. 2004-01-17 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LassignObjCmd): Add more shimmering protection for when the list is also one of the variables. BASIC IMPLEMENTATION OF TIP#57 * generic/tclCmdIL.c (Tcl_LassignObjCmd): Implementation of the [lassign] command that takes full advantage of Tcl's object API. * doc/lassign.n: New file documenting the command. * tests/cmdIL.test (cmdIL-6.*): Test suite for the command. 2004-01-15 David Gravereaux * win/tclWinReg.c: Placed the requirement for advapi.lib into the object file itself with #pragma comment (lib, ...) when built with VC++. This will simplify linking for users of the static library. * win/rules.vc: Added new 'fullwarn' to the CHECKS commandline macro; sets $(FULLWARNINGS). * win/makefile.vc: Removed 'advapi.lib' from $(baselibs). Added new logic to crank-up the warning levels for both compile and link when $(FULLWARNINGS) is set. Some clean-up with how the resource files are built and how -DTCL_USE_STATIC_PACKAGES is sent when compiling the shells. * win/tclAppInit.c: Small change in how TCL_USE_STATIC_PACKAGES is used. * win/tcl.rc: * win/tclsh.rc: Some clean-up with how the resource files are built. Fixed 'OriginalFilename' problem that still thought a debug suffix was still 'd', now is 'g'. 2004-01-14 Donal K. Fellows * generic/tclDictObj.c (TraceDictPath, DictExistsCmd): Adjusted behaviour of [dict exists] so a failure to look up a dictionary along the path of dicts doesn't trigger an error. This is how it was documented to behave previously... [Bug 871387] * generic/tclDictObj.c: Assorted dict fixes from Peter Spjuth relating to [Bug 876170]. (SetDictFromAny): Make sure that lists retain their ordering even when converted to dictionaries and back. (TraceDictPath): Correct object reference count handling! (DictReplaceCmd, DictRemoveCmd): Stop object leak. (DictIncrCmd,DictLappendCmd,DictAppendCmd,DictSetCmd,DictUnsetCmd): Simpler handling of reference counts when assigning to variables. * tests/dict.test (dict-19.2): Memory leak stress test 2004-01-13 Don Porter * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Silence compiler warnings. Patch 876451: restores performance of [return]. Also allows forms such as [return -code error $msg] to be bytecompiled. * generic/tclInt.h: Factored Tcl_ReturnObjCmd() into two pieces: * generic/tclCmdMZ.c: TclMergeReturnOptions(), which can parse the options to [return], check their validity, and create the corresponding return options dictionary, and TclProcessReturn(), which takes that return options dictionary and performs the [return] operation. * generic/tclCompCmds.c: Rewrote TclCompileReturnCmd() to call TclMergeReturnOptions() at compile time so the return options dictionary is computed at compile time (when it is fully known). The dictionary is pushed on the stack along with the result, and the code and level values are included in the bytecode as operands. Also supports optimized compilation of un[catch]ed [return]s from procs with default options into the INST_DONE instruction. * generic/tclExecute.c: Rewrote INST_RETURN instruction to retrieve the code and level operands, pop the return options from the stack, and call TclProcessReturn() to perform the [return] operation. * generic/tclCompile.h: New utilities include TclEmitInt4 macro * generic/tclCompile.c: and TclWordKnownAtCompileTime(). End Patch 876451. * generic/tclFileName.c (Tcl_GlobObjCmd): Latest changes to management of the interp result by Tcl_GetIndexFromObj() exposed improper interp result management in the [glob] command procedure. Corrected by adopting the Tcl_SetObjResult(Tcl_NewStringObj) pattern. This stopped a segfault in test filename-11.36. [Bug 877677] 2004-01-13 Donal K. Fellows * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs): Create fresh objects instead of using the one currently in the interpreter, which isn't guaranteed to be fresh and unshared. The cost for the core will be minimal because of the object cache, and this fixes [Bug 875395]. 2004-01-12 Miguel Sofer * generic/tclCompExpr.c (CompileLandOrLorExpr): cosmetic changes. 2004-01-12 Miguel Sofer * generic/tclCompExpr.c (CompileLandOrLorExpr): new logic, fewer instructions. As a side effect, the instructions INST_LOR and INST_LAND are now never used. * generic/tclExecute.c (INST_JUMP*): small optimisation; fix a bug in debug code. 2004-01-11 David Gravereaux * win/tclWinThrd.c (Tcl_ConditionNotify): condPtr must be dereferenced to see if there are waiters else uninitialized datum is manipulated. [Bug 849007 789338 745068] 2004-01-09 David Gravereaux * generic/tcl.h: Renamed and deprecated #defines moved to within the #ifndef TCL_NO_DEPRECATED block. This allows us to build Tcl to check for deprecated functions in use, such as panic() and Tcl_Ckalloc(). By request from DKF. Extensions that build with -DTCL_NO_DEPRECATED now have these macros as restricted. ***POTENTIAL INCOMPATIBILITY*** * win/makefile.vc: * win/rules.vc: Added -DTCL_NO_DEPRECATED usage to makefile.vc. Called like this: nmake -af makefile.vc CHECKS=nodep 2004-01-09 Vince Darley * generic/tclIOUtil.c: fix to infinite loop in TclFinalizeFilesystem [Bug 873311] ****************************************************************** *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ****************************************************************** tcl8.6.14/ChangeLog.20050000644000175000017500000043450314554262142014012 0ustar sergeisergei2005-12-30 Kevin B. Kenny * generic/tclStubLib.c: Corrected a typo in "missing Stubs table pointer." 2005-12-27 Kevin B. Kenny * generic/tcl.decls: Destubbed TclTomMathInitializeStubs - it is in * generic/tcl.h: the stub library, not the main shared * generic/tclBasic.c: library. Exported Tcl_InitBignumFromDouble. * generic/tclExecute.c: * generic/tclInt.h: * generic/tclStrToD.c: * generic/tclDecls.h: * generic/tclStubLib.c: * generic/tclStubInit.c: Regenerated. * generic/clock.tcl: Reverted to using the time zone abbreviation and not its name to "stop the bleeding" on [Bug 1386377]. This is *not* a good long-term solution, but there may not be one. * libtommath/bn_mp_sqrt.c: Improved the initial approximation to the square root, roughly doubling the speed of the routine. (This is a local change that needs to be communicated to Tom.) * win/Makefile.in: Corrected a bug where tommath_class.h and tommath_superclass.h were not installed, making it impossible for client code to compile against the tommath stubs. * library/tzdata: Updated to Olson's tzdata2005r. (Latest changes to Daylight Saving Time in Canada, plus redefinition of the Posix-style zones [e.g., EST5EDT] to be locale-independent.) * libtommath: Updated to Tom St.Denis's release 0.37. 2005-12-20 Donal K. Fellows * generic/tclThreadAlloc.c (Tcl_GetMemoryInfo): Format values as longs and not ints, so they are less likely to wrap on 64-bit machines. 2005-12-19 Don Porter * generic/tclCmdMZ.c: Modified [string is double] to use * tests/string.test: TclParseNumber() to parse trailing whitespace. Ensures consistency, and makes it easier to cleanup after invalid internal reps left behind by parsing [Bugs 1360532 1382287]. * generic/tclParseExpr.c: Added TCL_PARSE_NO_WHITESPACE to * generic/tclScan.c: TclParseNumber() calls since [scan] and [expr] * tests/scan.test: parsing don't want spaces in parsed numbers. * generic/tclInt.h: Added TCL_PARSE_NO_WHITESPACE flag to the * generic/tclStrToD.c: TclParseNumber() interface. 2005-12-19 Donal K. Fellows * doc/Tcl.n: Clarify what is going on in variable substitution following thread on comp.lang.tcl. 2005-12-18 Donal K. Fellows * generic/tclCompCmds.c (TclCompileDictCmd): Ensure that we only do an 'endCatch' when there's a preceding 'beginCatch'. [Bug 1382528] Many thanks to Anton Kovalenko for finding this and pointing out that it was a catch stack handling problem! 2005-12-14 Daniel Steffen * generic/tclIOUtil.c: workaround gcc warning "comparison is always * generic/tclTest.c: false due to limited range of data type". * macosx/Tcl.xcode/project.pbxproj: * macosx/Tcl.xcodeproj/project.pbxproj: * unix/Makefile.in: add new tclTomMath* files. * generic/tclBasic.c: replace panic with Tcl_Panic. 2005-12-13 Kevin B. Kenny * generic/tcl.decls: Added changes to export an additional stubs * generic/tclBasic.c: table to represent the 'libtommath' routines * generic/tclDecls.h: that Tcl uses and export them to callers. * generic/tclInt.decls: Reran 'genstubs' * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: * generic/tclStubLib.c: * generic/tclTomMath.decls: * generic/tclTomMath.h: * generic/tclTomMathDecls.h: * generic/tclTomMathInterface.c: * generic/tommath.h: * tools/fix_tommath_h.tcl: * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: * generic/tclClock.c: Made changes to silence a number of compiler * generic/tclIO.c: warnings when building with mingw. * generic/tclIORChan.c: * generic/tclLink.c: * generic/tclListObj.c: * generic/tclObj.c: * generic/tclParseExpr.c: * generic/tclProc.c: * generic/tclTimer.c: * win/tclWinChan.c: * win/tclWinConsole.c: * win/tclWinDde.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclWinReg.c: * win/tclWinSock.c: 2005-12-13 Donal K. Fellows * generic/tclExecute.c (TEBC:DICT_FIRST,DICT_DONE): Only decrease the references to the dictionary once the iteration completes. Do this by storing the dict in the iterator context variable. [Bug 1379349] Thanks to Ulrich Ring and Tobias Hippler for finding this. 2005-12-12 Jeff Hobbs * unix/tcl.m4, unix/configure: Fix sh quoting error reported in bash-3.1+ [Bug 1377619] (schafer) 2005-12-12 Kevin B. Kenny * doc/mathfunc.n: Changed two examples from the incorrect 'tcl::math::' to 'tcl::mathfunc::' [Bug 1378818] 2005-12-09 Mo DeJong * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): Define MACHINE for gcc builds. The lack of a definition of this variable in the manifest file was causing a runtime error in wish built with gcc. 2005-12-09 Donal K. Fellows * tests/lsearch.test (lsearch-10.8..10): If the -start is off the end, * generic/tclCmdIL.c (Tcl_LsearchObjCmd): searching should find nothing at all. [Bug 1374778] 2005-12-08 Jeff Hobbs * win/Makefile.in, win/makefile.vc: Add Win x64 and CE build support * win/tcl.m4, win/configure: CE still requires C code fixes. * generic/tcl.h: use struct __stat64 (not _stat64) for MSC_VER >= 1400 (i.e. latest Platform SDK). 2005-12-07 Donal K. Fellows * doc/socket.n: Cross-referenced the socket documentation better to the fconfigure documentation on the topic of asynch sockets. * doc/fconfigure.n: Added keyword to documentation of -blocking option so that people looking for "asynch" can find it as well. 2005-12-05 Daniel Steffen * unix/tclUnixPort.h (Darwin): fix incorrect __DARWIN_UNIX03 configure overrides that were originally copied from Darwin CVS (rdar://3693001) 2005-12-05 Kevin B. Kenny * tools/tclZIC.tcl: Updated to reflect changes in calling sequence when GetJulianDateFromEraYearMonthDay moved to C. * library/tzdata: Regenerated from Olson's tzdata2005p.tar.gz - the 'systemv' changes appear not to affect Tcl's processing of the dates. 2005-12-05 Daniel Steffen * unix/configure.in: move check for fts API to configure.in and run it * unix/tcl.m4: on all platforms, since Linux glibc2 and *BSDs also have this; using fts is more efficient than a recursive opendir/readdir. * unix/tclUnixFCmd.c (TraverseUnixTree): add support to fts code for platforms with stat64. * unix/configure: * unix/tclConfig.h.in: regen. 2005-12-05 Jeff Hobbs * unix/configure: Use fts file API on Darwin if available. * unix/tcl.m4: Addresses file delete issues in readdir noted * unix/tclUnixFCmd.c: in [Bug 1034337]. (steffen) Remove redundant stat call for each file in DoCopyFile. (steffen) 2005-12-02 Kevin B. Kenny * generic/tclClock.c: Moved a tiny bit more of [clock format] from run * library/clock.tcl: time to compile time, and fixed a l10n bug in the process. [Bug 1371446]. Also, conditoned the call to SetupTimeZone to speed the common case where TZData($timezone) already exists, and achieved a puny speedup by making ::tcl::clock::getenv not throw errors. * unix/Makefile.in: Made some changes to support a 'make' command that is present on some antiquated versions of Solaris. 2005-12-01 Kevin B. Kenny * library/clock.tcl: Continued rationalizing the code, eliminating numerous redundant [mc] calls. Added another time boost by precompiling a [::format] command to do the bulk of the work of [clock format]. 2005-12-01 Donal K. Fellows * unix/Makefile.in: Add remaining dependency info. While automated maintenance of this information would be good, having it at all is much better than a poke in the eye with a sharp stick... 2005-12-01 Daniel Steffen * generic/tclClock.c: fix warning. * unix/tcl.m4 (Darwin): fix error when MACOSX_DEPLOYMENT_TARGET unset * unix/configure: regen. 2005-11-30 Donal K. Fellows * unix/Makefile.in: Add dependency information relating to tclCompile.h since when the list of opcodes changes it is usually useful to rebuild everything that depends on it (but which is nonetheless a small fraction of the total set of Tcl source files). ***POTENTIAL INCOMPATIBILITY*** for bytecode savers/loaders. See below * generic/tclCompCmds.c (TclCompileSwitchCmd): Arrange for very simple [switch] invocations to be compiled into hash lookups into jump tables; only a very specific kind of [switch] can be safely compiled this way, but that happens to be the most common kind. This makes around 5-10% difference to the speed of execution of clock.test. * generic/tclExecute.c (TEBC:INST_JUMP_TABLE): New instruction to allow for jumps to locations looked up in a hashtable. Requires a new AuxData type, tclJumptableInfoType (supported by the functions DupJumptableInfo and FreeJumptableInfo in tclCompCmds.c) so anything that saves bytecode containing this *must* be updated! 2005-11-30 Kevin Kenny * generic/tclClock.c: Fixed a bad refcount in previous commit that led to a corrupted heap. Also silenced a warning that some compilers gave about the excessively long constant for JULIAN_SEC_POSIX_EPOCH. Also fixed a bug where [clock format] would fail in the :localtime zone for times before the Posix Epoch. Thanks to Miguel Sofer for pointing out all of these. Also rationalized the code a little bit by moving parts of [clock scan] into C, eliminating some code that was duplicated in the C and Tcl layers. 2005-11-29 Kevin Kenny * generic/tclBasic.c: Moved a big part of [clock format] down * generic/tclClock.c: to the C level in order to make it go faster. * generic/tclInt.h: Preliminary measurements suggest that it * generic/clock.tcl: more than doubles in speed with this change. 2005-11-29 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Allow [lsearch -regexp] to process REs that contain backreferences. This expensive mode of operation is only used if the RE would otherwise cause a compilation failure. [Bug 1366683] 2005-11-28 Kevin Kenny * tools/tclZIC.tcl (convertTimeOfDay): Corrected a typo that caused wrong DST transitions in any time zone where the transition is specified as local Standard Time (as opposed to wall-clock or UTC). (Also updated the code to be bignum-safe.) * tests/clock.test (clock-51.1): Added regression test for the above. * library/tzdata: Updated to Olson's 'tzdata2005o' (changes for Cuba, Nicaragua, Jordan, and Georgia) and regenerated. Thanks to Paul Mackerras for reporting this problem. 2005-11-27 Daniel Steffen * unix/tcl.m4 (Darwin): add 64bit support, check for Tiger copyfile(), add CFLAGS to SHLIB_LD to support passing -isysroot in env(CFLAGS) to configure (flag can't be present twice, so can't be in both CFLAGS and LDFLAGS during configure), don't use -prebind when deploying on 10.4, define TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING (rdar://3171542). (SC_ENABLE_LANGINFO, SC_TIME_HANDLER): add/fix caching, fix obsolete autoconf macros. Sync with tk/unix/tcl.m4. * unix/configure.in: fix obsolete autoconf macros, sync gratuitous formatting/ordering differences with tk/unix/configure.in. * unix/Makefile.in: add CFLAGS to tclsh/tcltest link to make executable linking the same as during configure (needed to avoid losing any linker relevant flags in CFLAGS, in particular flags that cannot be in LDFLAGS). Avoid concurrent linking of tclsh and compiling of tclTestInit.o or xtTestInit.o during parallel make. (checkstubs, checkdoc, checkexports): dependency and Darwin fixes (dist): add new macosx files. * unix/tclLoadDyld.c (TclpDlopen): use NSADDIMAGE_OPTION_WITH_SEARCHING on second NSAddImage only. [Bug 1204237] (TclGuessPackageName): should not be MODULE_SCOPE. (TclpLoadMemory): ppc64 and endian (i386) fixes, add support for loading universal (fat) bundles from memory. * unix/tclUnixFCmd.c: * macosx/tclMacOSXFCmd.c: ppc64 and endian (i386) fixes. (TclMacOSXCopyFileAttributes): add support for new Tiger copyfile() API to enable copying of xattrs & ACLs by [file copy]. * generic/tcl.h: add Darwin specifc configure overrides for TCL_WIDE defines to support fat compiles of ppc and ppc64 at the same time, (replaces Darwin CVS fix by emoy, rdar://3693001). add/correct location of version numbers in macosx files. * generic/tclInt.h: clarify fat compile comment. * unix/tclUnixPort.h: add Darwin specifc configure overrides to support fat compiles, where configure runs only once for multiple architectures (replaces Darwin CVS fix by emoy, rdar://3693001). * macosx/tclMacOSXBundle.c: * macosx/tclMacOSXNotify.c: * unix/tclUnixNotfy.c: * unix/tclUnixPort.h: fix #include order to support compile time override of HAVE_COREFOUNDATION in tclUnixPort.h when building for ppc64 * macosx/Tcl.pbproj/default.pbxuser (new file): * macosx/Tcl.pbproj/jingham.pbxuser: * macosx/Tcl.pbproj/project.pbxproj: * macosx/Tcl.xcode/default.pbxuser (new file): * macosx/Tcl.xcode/project.pbxproj (new file): * macosx/Tcl.xcodeproj/default.pbxuser (new file): * macosx/Tcl.xcodeproj/project.pbxproj (new file): new/updated projects for Xcode 2.2 on 10.4, Xcode 1.5 on 10.3 & ProjectBuilder on 10.2, with native tcltest targets and support for universal (fat) compiles. * macosx/README: clarification/cleanup, document new Xcode projects and universal (fat) builds via CFLAGS (i.e. all of ppc ppc64 i386 at once). * unix/Makefile.in: * unix/aclocal.m4: * unix/configure.in: * unix/dltest/Makefile.in: * macosx/configure.ac (new file): add support for inclusion of unix/configure.in by macosx/configure.ac, allows generation of a config headers enabled configure script in macosx (required by Xcode projects). * macosx/GNUmakefile: rename from Makefile to avoid overwriting by configure run in tcl/macosx, add support for reusing configure cache, build target fixes, remove GENERIC_FLAGS override now handled by tcl.m4. * generic/tcl.decls: add Tcl_Main declaration as comment to avoid 'checkstubs' target complaining about it missing from stubs. * generic/regex.h: * generic/tclDate.c: * generic/tclEnv.c: * generic/tclGetDate.y: * generic/tclIOUtil.c: * generic/tclObj.c: * generic/tclStubInit.c: * generic/tclStubLib.c: * generic/tclPathObj.c: * generic/tclThreadAlloc.c: * generic/tclThreadStorage.c: * generic/tclTrace.c: * generic/tclVar.c: * generic/tommath.h: * tools/fix_tommath_h.tcl: * unix/tclUnixFCmd.c: ensure externally visible symbols not contained in stubs table are declared as MODULE_SCOPE (or as static if not used outside of own source file). These changes allow 'make checkstubs' to complete without error on Darwin with gcc 4. * generic/rege_dfa.c (getvacant): * generic/regexec.c (cfind): * generic/tclCompExpr.c (CompileSubExpr): * generic/tclNamesp.c (NamespaceEnsembleCmd): * unix/tclUnixChan.c (TclUnixWaitForFile): initialise variables to silence gcc 4 warnings. * generic/tclExecute.c (TclExecuteByteCode): fix unused variable warning when NO_WIDE_TYPE is defined. * generic/regguts.h: only #define NDEBUG if not already #defined. * unix/tclUnixNotfy.c: * macosx/tclMacOSXNotify.c: sync whitespace & comments. * unix/tclUnixPort.h: * win/tclWinPort.h: remove declaration of obsolete&unused TclpMutex API. * unix/configure: * unix/tclConfig.h.in: regen. 2005-11-21 Andreas Kupries * unix/Makefile.in (install-libraries): Updated Makefile to new * win/Makefile.in (install-libraries): version of the http package. This fixes the ifneeded/provide mismatch reported when trying to require http. Should we maybe try to automatically extract the version number from the http code to prevent future breakage ? This follows the update of the version number by dgp on Nov 15 (No entry found in the ChangeLog). 2005-11-20 Joe English * generic/tclStubLib.c: Don't set tclStubsPtr to 0 when Tcl_PkgRequireEx() fails [Fix for [Bug 1091431] "Tcl_InitStubs failure crashes wish"] 2005-11-18 Miguel Sofer * tests/trace.test (trace-34.5): [Bug 1047286], added a second test illustrating the role of "ns in callStack" in the ns's visibility during deletion traces. 2005-11-18 Kevin B. Kenny * doc/clock.n: Restored several missing lines near the %w format group so that %w and %W are documented with their actual behaviour. [Bug 1359183] 2005-11-18 Jeff Hobbs * generic/tclIO.c (TclFinalizeIOSubsystem): preserve statePtr until we retrieve the next statePtr from it. 2005-11-18 Miguel Sofer * generic/tclObj.c (GetBignumFromObj): replace NULL with tclEmptyStringRep to stop memcpy from complaining in a debug build (the corresponding branch is eliminated by the optimiser otherwise). 2005-11-18 Andreas Kupries * generic/tclIO.c (TclFinalizeIOSubsystem): Applied Pat Thoyts' patch for [Bug 1359094]. This moves the retrieval of the next channel state to the end of the loop, as the called closeproc may close other channels, i.e. modify the list we are iterating, invalidating any pointer retrieved earlier. 2005-11-18 Don Porter * generic/tclListObj.c: Restored the SetListFromAny routine to the * generic/tclObj.c: "list" Tcl_ObjType, and restored the Tcl_RegisterObjType() call for "list". This addresses the needs of some "bridge" extensions to examine whether the Tcl_ObjType of a Tcl_Obj is that of the "list" Tcl_ObjType. 2005-11-18 Donal K. Fellows * library/http/http.tcl (http::geturl): Improved syntactic validation of URLs, and better error messages in some cases. [Bug 1358369] 2005-11-17 Miguel Sofer * tests/namespace.test: fix comment 2005-11-14 Don Porter * generic/tclStrToD.c: More data in the "can't happen" Tcl_Panic to aid debugging. * generic/tclBasic.c (CallCommandTraces): Save/restore the interp result during traces to fix [Bug 1355342]. 2005-11-13 Miguel Sofer * generic/tclInt.h: * generic/tclNamesp.c: * tests/namespace.test: fix for [Bug 1354540] and [Bug 1355942]. The new tests 7.3-6 and the modified 51.13 fail due to the unrelated [Bug 1355342] * tests/trace.test: added tests 20.13-16 for [Bug 1355342] 2005-11-12 Miguel Sofer * generic/tclBasic.c (Tcl_DeleteCommandFromToken): * generic/tclObj.c (Tcl_GetCommandFromObj): more partial fixes for [Bug 1354540] - making sure that cached references to a command being deleted cannot be made reusable by a delete trace. 2005-11-12 Donal K. Fellows * generic/tclNamesp.c (Tcl_FindCommand): Do not find commands in dead namespaces on the path. Partial fix for [Bug 1354540]. 2005-11-11 Don Porter * generic/tclInt.h: Revised TclParseNumber interface to enable * generic/tclScan.c: revision to the [scan] command implementation * generic/tclStrToD.c: to permit tests scan-4.44,55 to pass again. [Bug 1348067]. 2005-11-11 Miguel Sofer * generic/tclBasic.c (Tcl_DeleteCommandFromToken): * generic/tclObj.c (Tcl_GetCommandFromObj): bump the cmd epoch early to insure that cached references to this command are invalidated. Partial fix for [Bug 1352734] - at least insures that namespace-51.13 does not cause a panic. The test is still marked as knownbug, pending resolution of what is actually the correct return value ([Bug 1354540]) 2005-11-09 Kevin B. Kenny * generic/tclTimer.c: Changed [after] so that it behaves correctly * tests/timer.test: with negative arguments [Bug 1350293] and arguments that overflow a 32-bit word. [Bug 1350291] 2005-11-08 Don Porter * tests/compile.test: Updated tests with changed behavior * tests/execute.test: due to addition of bignums. * tests/expr-old.test: * tests/expr.test: * tests/parseExpr.test: * tests/platform.test: * tests/string.test: 2005-11-08 Jeff Hobbs * unix/tclUnixFCmd.c (MAX_READDIR_UNLINK_THRESHOLD): reduce to 130 based on errors seen on OS X 10.3 with lots of links in a dir. [Bug 1034337 followup] 2005-11-09 Donal K. Fellows * unix/Makefile.in (gdb-test): Added a new target to make it easier to run the test suite inside a debugger. 2005-11-08 Don Porter * tests/compExpr-old.test: Updated tests with changed behavior due to addition of bignums. * tests/expr.test: Portable tests expr-46.13-18 [Bug 1341368] * generic/tclPkg.c: Corrected inconsistencies in the value returned * tests/pkg.test: by Tcl_PkgRequire(Ex) so that the returned values will always agree with what is stored in the package database. This way repeated calls to Tcl_PkgRequire(Ex) have the same results. Thanks to Hemang Lavana. [Bug 1162286]. 2005-11-08 Donal K. Fellows * generic/tclTrace.c (TraceVarEx): Factor out heart of Tcl_TraceVar2 (TclTraceVariableObjCmd,TraceVarProc): Use the new internal API to arrange for the clientData to be cleaned up at the same time as the rest of the main trace record. This simplifies the code a bit at the same time. 2005-11-07 Miguel Sofer * tests/trace.test (trace-13.2-4): added tests to detect leak, see [Bug 1348775]. The recently added trace-8.9 test is now 13.4. 2005-11-07 Donal K. Fellows * tests/dict.test (dict-19.2): arrange for the stress testing code to only stress test the dict code and not the trace code as well. [Bug 1342858] 2005-11-05 Miguel Sofer * tests/trace.test (trace-8.9): added test to detect leak, see [Bug 1348775]. 2005-11-04 Pat Thoyts * win/tclWinPort.h: Applied [Patch 1267871] by Matt Newman for * win/tclWinPipe.c: extended error code support on Windows. * tests/exec.test: Tests for extended error codes. * generic/tclPipe.c: Permit long codes (platform macros permitting). 2005-11-04 Miguel Sofer * generic/tclBinary.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclDictObj.c: * generic/tclExecute.c: * generic/tclIOCmd.c: * generic/tclLink.c: * generic/tclTest.c: * generic/tclVar.c: fix for [Bug 1334947]. The functions TclPtrSetVar, Tcl_ObjSetVar2 and Tcl_SetVar2Ex now always consume the newValuePtr argument - i.e., they will free a 0-refCount object if they failed to set the variable. Fixed all callers in the core. 2005-11-04 Kevin Kenny * generic/tclGetDate.y: Added abbreviations for the Korean * library/clock.tcl: timezone. [Patch 1298737] * generic/tclDate.c: Regenerated. * tools/findBadExternals.tcl: Added this script, which locates external symbols that do not begin with 'Tcl' or 'tcl' and hence might be in conflict with other link libraries. Thanks to George Peter Staplin for the idea and the initial version of the script. [Bug 1263012] * unix/Makefile.in: Trimmed a bunch of fat out of the tommath/ directory in 'make dist'. [RFE 1333318] * unix/tcl.m4: Added code to enable [load] on LynxOS. Thanks to heidibr@users.sf.net for the patch. [Bug 1163896]. Removed the last vestiges of GNU dld from the Unix build [RFE 1071992]. * unix/tclLoadDld.c: Removed. * unix/configure: Regenerated. 2005-11-04 Miguel Sofer * generic/tclInt.h: * generic/tclNamesp.c: * generic/tclVar.c: * tests/trace.test: fix for [Bugs 1338280/1337229]; changed to use the same approach as the 8.4 patch in the ticket (i.e., removed the patch committed on 2005-31-10). 2005-11-03 Pat Thoyts * win/tclWin32Dll.c: Applied [Patch 1256872] to provide unicode * win/tclWinConsole.c: support in the console on suitable systems. * win/tclWinInt.h: Patch by Anton Kovalenko 2005-11-02 Pat Thoyts Applied [Patch 1096916] to support building with MSVC 8. * generic/regerror.c: Avoid use of reserved word. * generic/tcl.h: Select the right Tcl_Stat structure * generic/tclDate.c: Casts to handle 64 bit time_t case. * tests/env.test: Include essential envvar on Win32 * win/nmakehlp.c: Handle new return codes. * win/makefile.vc: Use the selected options. * win/rules.vc: Check options are applicable * win/tclWinPort.h: Disable deprecated function warnings * win/tclWinSock.c: Provide default value to avoid warning. * win/tclWinTime.c: Add casts to handle 64bit time_t type. 2005-11-01 Don Porter * generic/tclTrace.c (TclCheckExecutionTraces): Corrected mistaken assumption that all command traces are set at the script level. Report/fix from Jacques H. de Villiers. [Bug 1337941] * tests/unixNotfy.test (1.1,2): Update error message whitespace to match changes in code. * tests/expr-old.test (expr-32.52): Use int(.) to restrict result of left shift to the C long range. * expr.test (expr-46.13): Added test that illustrates shortcoming of [Patch 1340260]. 2005-10-31 Miguel Sofer * generic/tclNamesp.c: fix for [Bugs 1338280/1337229]. Thanks Don. * tests/trace.test: fix duplicate test numbers 2005-10-31 Donal K. Fellows * win/tclWinSerial.c (SerialSetOptionProc): Cleaned up option parsing to produce more informative error messages and separate error and non-error code paths better. * tests/ioCmd.test (iocmd-8-19): Updated. 2005-10-29 Miguel Sofer * generic/tclTrace.c (TraceVarProc): [Bug 1337229], partial fix. Ensure that a second call with TCL_TRACE_DESTROYED does not lead to a second call to Tcl_EventuallyFree(). It is still true that that second call should not happen, so the bug is not completely fixed. * tests/trace.test (test-18.3-4): added tests for [Bug 1337229] and [Bug 1338280]. 2005-10-23 Vince Darley * generic/tclFileName.c: fix to memory leak in glob [Bug 1335006] Obj leak detection and patch by Eric Melbardis. * tests/fCmd.test: * win/tclWinFile.c: where appropriate windows API is available, try to set 'nlink' and 'ino' stat fields (previously they were always 0). [Bug 1325803] 2005-10-22 Miguel Sofer * tests/foreach.test (foreach-8.1): added test for [Bug 1189274] 2005-10-22 Miguel Sofer * generic/tclExecute.c (INST_INCR_*): fixed [Bug 1334570]. Obj leak detection and patch by Eric Melbardis. 2005-10-21 Kevin B. Kenny * generic/tclStrToD.c (RefineApproximation): Plugged a memory leak where two intermediate results were not freed on one return path. [Bug 1334461]. Thanks to Eric Melbardis for the patch. 2005-10-21 Donal K. Fellows * doc/binary.n: Clarify that virtually all code that uses the 'h' format in [binary scan] should be using the 'H' format instead. It is nearly always a bug to use the other! 2005-10-20 Miguel Sofer * generic/tclListObj.c (TclLsetFlat): * tests/lset.test (lset-10.3): fixed handling of unshared lists with shared sublists, [Bug 1333036] reported by neuronstorm. 2005-10-19 Donal K. Fellows * generic/tclIORChan.c (PassReceivedError,PassReceivedErrorInterp): Fix crash caused by passing -1 as the length to TclNewStringObj(). Only Tcl_NewStringObj (the function call, not the macro) handles that sort of thing correctly. This makes ioCmd.test pass again. 2005-10-19 Don Porter * generic/tclClock.c: Removed some dead code. * generic/tclCmdIL.c: * generic/tclCompCmds.c: * generic/tclDictObj.c: * generic/tclExecute.c: * generic/tclLiteral.c: * generic/tclParseExpr.c: * generic/tclScan.c: * generic/tclUtil.c: * generic/tclVar.c: 2005-10-19 Donal K. Fellows * generic/tclIORChan.c: General cleanup, removing checks that are unnecessary due to the general contracts of other functions in the core, converting to using ANSI declarations, etc. Note that nearly the whole file has changed, but it is often just cosmetic. 2005-10-19 Miguel Sofer * generic/tclExecute.c (INST_DICT_APPEND, INST_DICT_LAPPEND): fixed faulty peephole optimisation that can cause crashes, [Bug 1331475] reported by Aric Bills. 2005-10-18 Don Porter * generic/tclExecute.c: Added optimization for I32L64 systems to avoid using bignums to perform int multiplies. The improvement shows up most dramatically in tclbench's matrix.bench. 2005-10-15 Don Porter * generic/tclExecute.c: Restored some optimizations of the INST_INCR_SCALAR1_IMM opcode. 2005-10-14 Zoran Vasiljevic * generic/tclIO.c (Tcl_ClearChannelHandlers): removed change dated 2005-10-04 (see below). Look into [Bug 1323992] for detailed discussion. * generic/tcl.h: Fixed bad definition of CRTEXPORT which should have been CRTIMPORT rather. This broke compilation of generic/tclMain.c and was probably introduced by mistake while applying the fix for [Bug 1256937] below. 2005-10-14 Kevin Kenny * generic/tclExecute.c (TclIncrObj, TclExecuteByteCode): Tidied up a couple of infelicitous do {...} while(0) constructs. 2005-10-14 Pat Thoyts * generic/tcl.h: Fix for [Bug 1256937] - correctly decorate * generic/tclMain.c: imported functions from msvcrt in static builds. 2005-10-13 Donal K. Fellows * tests/format.test: "Forward"-port of test updates relating to [Bug 1284178]. The bug itself was fixed by TIP#237. 2005-10-13 Zoran Vasiljevic * generic/tclIO.c (Tcl_ClearChannelHandlers): temporary ifdef TCL_THREADS changes done to de-activate pending event processing when channel is being closed/cutted. 2005-10-13 Don Porter * generic/tclExecute.c: Removed obsolete use of NO_ERRNO_H. * tools/man2tcl.c: * unix/tcl.m4: * unix/tclConfig.h.in: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: * compat/tclErrno.h: Removed obsolete file. * generic/tclStrToD.c (TclParseNumber): Missing goto caused crash when parsing "Na". [Bug 1325833] 2005-10-12 Don Porter * generic/tclExecute.c (GetNumberFromObj): Restored some lost optimizations for empty string values. We avoid cost of a call to TclParseNumber just to tell us an empty string isn't a number. 2005-10-12 Donal K. Fellows * generic/tclPathObj.c (SetFsPathFromAny): TclGetString macro must not be combined with post-increment arguments. [Bug 1325099] 2005-10-12 Kevin Kenny * generic/tclExecute.c (Tcl_ExecuteByteCode, TclIncrObj): Several common cases inlined in hopes of gaining a little performance in [incr] 2005-10-10 Miguel Sofer * generic/tclCompCmds.c: New convenience macro CompileTokens(). 2005-10-10 Don Porter * generic/tclExecute.c: Corrections to the NO_WIDE_TYPE build. Also added missing "break" to a switch that broke wide XOR operations. 2005-10-10 Donal K. Fellows * generic/tclInterp.c (DeleteScriptLimitCallback) (SetScriptLimitCallback): Improve the interlocking between the script limit callback record and the hash table of current such records, to prevent crashes in callbacks that create callbacks. (Tcl_LimitSetTime): Reset the correct flag. Problem reported by Nicolas Castagne on comp.lang.tcl 2005-10-10 Miguel Sofer * generic/tclExecute.c: Fixing errors in last commit. (Two commits, the second removes wrong comment). 2005-10-09 Miguel Sofer * generic/tclBasic.c: * generic/tclExecute.c: * generic/tclStrToD.c: * generic/tclStringObj.c: Initialise variables to avoid compiler warnings ([Bug 1320818] among others). 2005-10-08 Don Porter TIP#237 IMPLEMENTATION [kennykb-numerics-branch] Resynchronized with the HEAD; at this checkpoint [-rkennykb-numerics-branch-20051008], the HEAD and kennykb-numerics-branch contain identical code. [kennykb-numerics-branch] Merge updates from HEAD * generic/tclExecute.c: More performance macros and special handling of the wide integer type for performance on 32-bit systems. 2005-10-07 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Macro GetNumberFromObj() is version of TclGetNumberFromObj() that saves a function call for common uses. * generic/tclInt.h: Made #undef NO_WIDE_TYPE the default on 32-bit systems. Being able to use 64-bit values without leaping to mp_int should help with performance. * generic/tclObj.c: Bug fixes in the #undef NO_WIDE_TYPE * generic/tclExecute.c: configuration. * generic/tclExecute.c: Improved performance of comparison opcodes and bitwise operations and removed yet more dead code. 2005-10-07 Jeff Hobbs * unix/tclUnixFCmd.c (TraverseUnixTree): Adjust 2004-11-11 change to * tests/fCmd.test (fCmd-20.2): account for NFS special files with a readdir rewind threshold. [Bug 1034337] 2005-10-06 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Improved performance of INST_RSHIFT and INST_LSHIFT. 2005-10-05 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Improved performance of INST_MULT, INST_DIV, INST_ADD, and INST_SUB and replaced a "goto... label" with a "break from loop" in TclIncrObj() and removed some dead code. 2005-10-05 Andreas Kupries * generic/tclPipe.c (TclCreatePipeline): Fixed [Bug 1109294]. Applied the patch provided by David Gravereaux. * doc/CrtChannel.3: Fixed [Bug 1104682], by application of David Welton's patch for it, and added a note about wideSeekProc. * generic/tclIORChan.c (RcClose): Removed unreachable panic/return statements. This fixes the remainder of [Bug 1286256]. 2005-10-05 Jeff Hobbs * tests/env.test (env-6.1): * win/tclWinPort.h: define USE_PUTENV_FOR_UNSET 1 * generic/tclEnv.c (TclSetEnv, TclUnsetEnv): add USE_PUTENV_FOR_UNSET to existing USE_PUTENV define to account for various systems that have putenv(), but can't unset env vars with it. Note difference between Windows and Linux for actually unsetting the env var (use of '='). Correct the resizing of the environ array. We assume that we are in full ownership, but that's not correct.[Bug 979640] 2005-10-04 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Updated TclIncrObj() to more efficiently add native long integers. Also updated IllegalExprOperandType and the INST_UMINUS, INST_UPLUS, INST_BITNOT, and INST_TRY_CVT_TO_NUMERIC sections for performance. * generic/tclBasic.c: Updated more callers to make use of TclGetNumberFromObj. Removed some dead code. 2005-10-04 Jeff Hobbs * win/tclWinSerial.c (SerialSetOptionProc): free argv [Bug 1067708] * tests/http.test: do not URI encode -._~ according * library/http/http.tcl (init): to RFC3986. [Bug 1182373] (aho) * unix/tclLoadShl.c (TclpDlopen): use DYNAMIC_PATH on second shl_load only. [Bug 1204237] * doc/scan.n: scan %[] requires "one or more chars" [Bug 1277503] * tests/winFile.test (getuser): allow valid Windows usernames. [Bug 1311285] * generic/tclParse.c (Tcl_ParseCommand): add code that recognizes {} in addition to {expand} for word expansion (make with -DALLOW_EMPTY_EXPAND). 2005-10-04 Zoran Vasiljevic * generic/tclIO.c (Tcl_ClearChannelHandlers): now deletes any outstanding timer for the channel. Also, prevents events still in the event queue from triggering on the current channel. * generic/tclTimer.c (Tcl_DeleteTimerHandler): bail out early if passed NULL argument. 2005-10-03 Don Porter [kennykb-numerics-branch] * generic/tclBasic.c: Re-implemented ExprRoundFunc and ExprEntierFunc to use TclGetNumberFromObj. * generic/tclInt.h: Added new routine TclGetNumberFromObj to * generic/tclObj.c: provide efficient access to the actual internal rep of a numeric Tcl_Obj without conversions. 2005-10-03 Kevin Kenny * tools/loadICU.tcl: Changed the file names of message catalogs to lowercase. * tools/makeTestCases.tcl: * library/tzdata/*: Olson's tzdata2005n.tar.gz. Includes new DST rules for USA and a number of changes to other locales. * tests/clock.test: Regenerated for new US DST rules. 2005-09-30 Don Porter * generic/tclMain.c: Separate encoding conversion of command line arguments from list formatting. [Bug 1306162]. 2005-09-30 Don Porter [kennykb-numerics-branch] * generic/tclStringObj.c: Bug fix: Missing cast to large enough integral size before << operations led to broken [format %llx] results. Thanks to Robert Henry for reporting the bug. 2005-09-29 Jeff Hobbs * doc/mathfunc.n: implementation for TIP #255, expr min/max * library/init.tcl: * tests/info.test, tests/expr-old.test: 2005-09-27 Don Porter [kennykb-numerics-branch] * generic/tcl.h: Changed name of the new Tcl_Obj intrep field * generic/tclObj.c: from "bignumValue" to "ptrAndLongRep" as * generic/tclProc.c: described in TIP 237, and more suitable for other more general uses. 2005-09-27 Donal K. Fellows * tests/binary.test (binary-14.18): Added test for [Bug 1116542] though the bug itself was already fixed by unrelated changes. 2005-09-26 Kevin Kenny [kennykb-numerics-branch] Merge updates from HEAD. 2005-09-26 Kevin Kenny * libtommath/: Updated to release 0.36. * generic/tommath.h: Regenerated. * generic/tclTomMathInterface.h: Added ten missing aliases for mp_* functions to avoid namespace pollution in Tcl's exported symbols. [Bug 1263012] 2005-09-23 Don Porter [kennykb-numerics-branch] * unix/Makefile.in: Added -DMP_PREC=4 switch to all compiles so * win/Makefile.in: that minimum memory requirements of mp_int's * win/makefile.vc: will not be quite so large. [Bug 1299153]. * generic/tclStrToD.c: Fixed memory leak. [Bug 1299803]. * generic/tclObj.c: 2005-09-20 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Revise TclIncrObj() to call Tcl_GetBignumAndClearObj. * generic/tcl.decls: Add Tcl_GetBignumAndClearObj. * generic/tclObj.c: * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: 2005-09-16 Don Porter [kennykb-numerics-branch] * generic/tclInt.h: Added TclBNInitBigNumFromWideInt() so * generic/tclTomMathInterface.c: that every caller isn't required to duplicate the sign logic to use the unsigned interface. * generic/tclBasic.c: Reduce the number of places where Tcl intrudes * generic/tclExecute.c: into the internal format details of the mp_int * generic/tclObj.c: struct. * generic/tclStrToD.c: * generic/tcLStringObj.c: * generic/tclTomMath.h: Added mp_cmp_d to routines from libtommath * unix/Makefile.in: used by Tcl. * win/Makefile.in: * win/makefile.vc: * libtommath/bn_mp_add_d.c: Bug fix. For mp_add_d(&a, d, &c), when &a has the value -d, then the value &c computed should be zero, but mp_add_d was producing an inconsistent zero value with a sign field of MP_NEG, something like a value of -0, which other routines in libtommath can't handle. * generic/tclExecute.c: Dropped all creation of "bigOne" values and just use tommath routines that accept the value "1" directly. 2005-09-15 Miguel Sofer * doc/ParseCmd.3: copy/paste fix [Bug 1292427] 2005-09-15 Don Porter [kennykb-numerics-branch] Merge updates from HEAD. * generic/tclStringObj.c (TclAppendFormattedObjs): Revision to eliminate one round of string copying. * generic/tclBasic.c: More callers of TclObjPrintf and * generic/tclCkalloc.c: TclFormatToErrorInfo. * generic/tclCmdMZ.c: * generic/tclExecute.c: * generic/tclIORChan.c: * generic/tclMain.c: * generic/tclProc.c: * generic/tclTimer.c: * generic/tclUtil.c: * unix/tclUnixFCmd.c * unix/configure: autoconf-2.59 2005-09-15 Donal K. Fellows * unix/tcl.m4 (SC_TCL_EARLY_FLAGS): Added extra hack to allow Tcl to transparently open large files on RHEL 3. [Bug 1287638] 2005-09-14 Don Porter * generic/tclStringObj.c: Bug fixes: ObjPrintfVA needed to support "*" fields and needed to interpret precision limits on %s conversions as a maximum number of bytes, not Tcl_UniChars, to take from the (char *) argument. * generic/tclBasic.c: Updated several callers to use * generic/tclCkalloc.c: TclFormatToErrorInfo() and/or * generic/tclCmdAH.c: TclObjPrintf(). * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclDictObj.c: * generic/tclExecute.c: * generic/tclIORChan.c: * generic/tclIOUtil.c: * generic/tclNamesp.c: * generic/tclProc.c: * library/init.tcl: Keep [unknown] in sync with errorInfo formatting rules. 2005-09-13 Don Porter * generic/tclBasic.c: First caller of TclFormatToErrorInfo. * generic/tclInt.h: Using stdarg.h conventions, add more * generic/tclStringObj.c: fixed arguments to TclFormatObj() and TclObjPrintf(). Added new routine TclFormatToErrorInfo(). * generic/tcl.h: Explicitly standardized on the use of stdarg.h * generic/tclBasic.c: conventions for functions with variable number * generic/tclInt.h: of arguments. Support for varargs.h has been * generic/tclPanic.c: implicitly gone for some time now. All * generic/tclResult.c: TCL_VARARGS* macros purged from Tcl sources, * generic/tclStringObj.c: leaving only some deprecated #define's * tools/genStubs.tcl: in tcl.h for the sake of older extensions. * generic/tclDecls.h: make genstubs * doc/AddErrInfo.3: Replaced all documented requirement for use of * doc/Eval.3: TCL_VARARGS_START() with requirement for use of * doc/Panic.3: va_start(). * doc/SetResult.3: * doc/StringObj.3: 2005-09-12 Don Porter [kennykb-numerics-branch] Merge updates from HEAD. * generic/tclCmdAH.c: Added support for the "ll" width * generic/tclStringObj.c: specifier to [format]. * generic/tclStringObj.c (TclAppendFormattedObjs): Bug fix: make sure %ld formats force the collection of a wide value, when the value could be a different long. 2005-09-09 Andreas Kupries * generic/tclIORChan.c (RcDecodeEventMask): Added missing type declaration for the parameter 'mask'. This fixes the [Bug 1286256]. The other warning can be removed only by removing the panic/return code. 2005-09-09 Don Porter [kennykb-numerics-branch] Merge updates from HEAD. 2005-09-09 Kevin Kenny * generic/tclStringObj.c: Added two missing casts to silence messages from MSVC6. 2005-09-09 Don Porter * generic/tclInt.h: New internal routine TclObjPrintf() * generic/tclStringObj.c: is similar to TclFormatObj() but accepts arguments in non-Tcl_Obj format. * generic/tclInt.h: New internal routines TclFormatObj() * generic/tclStringObj.c: and TclAppendFormattedObjs() to offer sprintf()-like means to append to Tcl_Obj. Work in progress toward [RFE 572392]. * generic/tclCmdAH.c: Compiler directive NEW_FORMAT when #define'd directs the [format] command to be implemented in terms of the new TclAppendFormattedObjs() routine. 2005-09-08 Donal K. Fellows TIP#254 IMPLEMENTATION * generic/tclLink.c (LinkTraceProc,ObjValue): Added many new of C var * generic/tcl.h: to link to, making it * doc/LinkVar.3: easier to seamlessly * generic/tclTest.c (TestlinkCmd): couple C code and Tcl * tests/link.test: scripts in an application. [Patch 1242844] 2005-09-07 Don Porter * generic/tclUtf.c (Tcl_UniCharToUtf): Corrected handling of negative * tests/utf.test (utf-1.5): Tcl_UniChar input value. Incorrect handling was producing byte sequences outside of Tcl's legal internal encoding. [Bug 1283976]. 2005-09-06 Donal K. Fellows * generic/tclInt.h (List): Added flag to keep track of whether a list * generic/tclListObj.c: with a string rep is provably canonical. * generic/tclUtil.c (Tcl_ConcatObj): Do efficient concatenation and * generic/tclBasic.c (Tcl_EvalObjEx): evaluation when the list is canonical, and not just when the list is pure. This should make the "pure list" hacking introduced in 8.3 much more robust. 2005-09-05 Donal K. Fellows * generic/tclObj.c (pendingObjDataKey): Added missing 'static' to stop symbol from leaking outside the Tcl library. [Bug 1263012] 2005-09-02 Don Porter [kennykb-numerics-branch] * generic/tclScan.c: Bug fix: The %o, %x, %i formats of [scan] must not accept any 0b or 0o prefixes. [scan $s %o] must continue to work even with KILL_OCTAL enabled. * generic/tclInt.h: Added TCL_PARSE_SCAN_PREFIXES to the flags * generic/tclStrToD.c: accepted by TclParseNumber. 2005-09-01 Andreas Kupries * unix/tclUnixSock.c (InitializeHostName): Synchronized use of static modifier in declaration and definition of function. * unix/tclUnixChan.c (FileTruncateProc): Synchronized use of static modifier in declaration and definition of function. * generic/tclResult.c (ReleaseKeys): Synchronized use of static modifier in declaration and definition of function. * generic/tclListObj.c (NewListIntRep): Synchronized use of static modifier in declaration and definition of function. * generic/tclEncoding.c (InitializeEncodingSearchPath): Synchronized use of static modifier in declaration and definition of function. * generic/tclEncoding.c (FillEncodingFileMap): Synchronized use of static modifier in declaration and definition of function. * generic/tclIORChan.c (RcNewHandle): Synchronized use of static modifier in declaration and definition of function. 2005-09-01 Don Porter [kennykb-numerics-branch] * generic/tclObj.c: TclParseNumber calls meant to parse an integer value now pass the TCL_PARSE_INTEGER_ONLY flag. * generic/tclScan.c: Extended [scan] to accept the %lld, %llo, %llx, and %lli formats. Numeric scanning is now done via TclParseNumber calls * generic/tclInt.h: Extended TclParseNumber to accept new flag * generic/tclStrToD.c: values TCL_PARSE_INTEGER_ONLY, TCL_PARSE_OCTAL_ONLY, and TCL_PARSE_HEXIDECIMAL_ONLY, to give caller more control over the parsing rules. 2005-08-31 Vince Darley * doc/FileSystem.3: * unix/tclUnixFile.c: * windows/tclWinFile.c: clarify that Tcl_FSMatchInDirectory may be called with a NULL interpreter, and fix the code so this is allowed. Tcl's core itself (tclEncoding.c:FillEncodingFileMap()) calls this with a NULL interpreter. 2005-08-30 Don Porter [kennykb-numerics-branch] * generic/tclObj.c: Extended bignum support to include bignums so large they will not pack into a Tcl_Obj. When they outgrow Tcl's string rep length limits, a panic will result. * generic/tclTomMath.h: Added mp_sqrt to routines from * unix/Makefile.in: libtommath used by Tcl. * win/Makefile.in: * win/makefile.vc: * generic/tclBasic.c: Extended sqrt(.) so that range covers the entire double range, accepting as many bignums in the domain as that will allow. 2005-08-29 Andreas Kupries * library/tm.tcl (::tcl::tm::roots): Accepted Don Porter's patch for [Bug 1189657]. Syncs the implementation to the specification (TIP #189) 2005-08-29 Don Porter [kennykb-numerics-branch] Merge updates from HEAD. * generic/tclBasic.c: Restored round(.) to the Tcl 8.4 rules. 2005-08-29 Kevin Kenny * generic/tclBasic.c (ExprMathFunc): Restored "round away from zero" * tests/expr.test (expr-46.*): behaviour to the "round" function. Added test cases for the behavior, including the awkward case of a number whose fractional part is 1/2-1/2ulp. [Bug 1275043] 2005-08-26 Andreas Kupries * generic/tclIO.c: Moved Tcl_{Cut,Splice}Channel to {Cut,Splice}Channel for internal use, and created new public functions for Tcl_{Cut,Splice}Channel which walk the whole stack of transformations and invoke the necessary thread actions. Added code to Tcl_(Un)StackChannel to properly invoke the thread actions when pushing and popping transformations on/from a channel. 2005-08-26 Donal K. Fellows * generic/tclNamesp.c (NamespaceEnsembleCmd): Reset the result after creating an ensemble to clear any result object sharing (potentially caused by delete traces) so that we can safely return the name of the ensemble. Previously, this caused crashes in Snit's test suite. 2005-08-25 Donal K. Fellows * generic/tclListObj.c (UpdateStringOfList): Stop uncontrolled and unsafe crashes from happening when working with very large string representations. [Bug 1267380] * generic/tclExecute.c (TEBC:INST_DICT_LAPPEND): Stop dropping a duplicated object on the floor, which was a memory leak (and a wrong result too). Thanks to Andreas Kupries for reporting this. 2005-08-25 Don Porter [kennykb-numerics-branch] Merge updates from HEAD * generic/tclExecute.c: Bug fix. INST_RSHIFT: shift of negative values produced incorrect results. * generic/tclExecute.c: Bug fix. INST_*SHIFT opcodes stack management. [expr 0<<6] should be 0, not 6. * generic/tclBasic.c: Extended the domain of round(.) to all non-Inf, non-NaN doubles, using bignums for the result as needed. 2005-08-24 Andreas Kupries TIP#219 IMPLEMENTATION * doc/SetChanErr.3: ** New File **. Documentation of the new channel API functions. * generic/tcl.decls: Stub declarations of the new channel API. * generic/tclDecls.h: Regenerated * generic/tclStubInit.c: * tclIORChan.c: ** New File **. Implementation of the reflected channel. * generic/tclInt.h: Integration of reflected channel and new error * generic/tclIO.c: propagation into the generic I/O core. * generic/tclIOCmd.c: * generic/tclIO.h: * library/init.tcl: * tests/io.test: Extended testsuite. * tests/ioCmd.test: * tests/chan.test: * generic/tclTest.c: * generic/tclThreadTest.c: * unix/Makefile.in: Integration into the build machinery. * win/Makefile.in: * win/Makefile.vc: 2005-08-24 Kevin Kenny * generic/tclStrToD.c (Tcl_DoubleDigits): Fixed the corner cases of * tests/binary.test (binary-65.*) formatting floating point numbers with the largest and smallest possible significands, and added test cases for them. 2005-08-24 Kevin Kenny [kennykb-numerics-branch] * generic/tclExecute.c: Corrected some TRACE bugs that prevented compilation with --enable-symbols=all. * generic/tclStrToD.c: Revised commentary to prepare for a renaming of the file, removed some dead code, and fixed a bug where TclBignumToDouble failed on huge negative numbers. * tests/binary.test (binary-65.*): Added missing 'ieeeFloatingPoint' to large/small significand tests. * tests/expr.test (expr-45.*) Added missing braces around expressions. 2005-08-24 Don Porter [kennykb-numerics-branch] * generic/tclBasic.c: Revised implementation of the ceil(.) and * generic/tclInt.h: floor(.) math functions in light of the * generic/tclStrToD.c: revised comparison operators, so that it is always true that ($x <= ceil($x)) and ($x >= floor($x)). The simple approach of "convert to double and call ceil() or floor()" could not guarantee that. * generic/tclExecute.c: Bug fix: TclBignumToDouble return -Inf when appropriate. Removed declarations of removed routines. * generic/tclExecute.c: Revised the type promotion rules of the comparison operators so that they form proper equivalence classes over the set of numeric strings. 2005-08-23 Mo DeJong * unix/configure.in: * win/configure: Regen. * win/configure.in: Update minimum autoconf version to 2.59. 2005-08-23 Kevin Kenny [kennykb-numerics-branch] * generic/tclCmdMZ.c (Tcl_StringObjCmd): * generic/tclInt.h: * generic/tclObj.c (Tcl_GetBooleanFromObj, SetDoubleFromAny, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_GetBignumFromObj): * generic/tclParseExpr.c (GetLexeme): * generic/tclScan.c (Tcl_ScanObjCmd): * generic/tclStrToD.c (TclParseNumber): * tests/binary.test (binary-62.1-65.7): * tests/expr.test (expr-40.1-42.1): * scan.test (scan-14.1,14.2): Modified Tcl_ParseNumber to accept an argument to force interpretation as decimal, and modified [scan] to use it. Corrected a bug where Not a Number with hexadecimal information bits returned consistently incorrect values. #ifdef-ed out some code that is needed only for IBM hexadecimal floating point. Fixed bugs in code to handle the corner cases of smallest and largest significands. Added test cases to improve test coverage in generic/tclStrToD.c. Added test cases for 0b notation (TIP #114). Removed TclStrToD, and the static functions that it calls, which are now dead code (TclParseNumber now does all input floating-point conversions.) 2005-08-23 Don Porter [kennykb-numerics-branch] * generic/tclStrToD.c: Bug fix: set shift magnitude properly whether we're expanding to mp_int type or not. * generic/tclExecute.c: Bug fix: ACCEPT_NAN under INST_UMINUS. * generic/tclStrToD.c: New macros TIP_114_FORMATS and KILL_OCTAL to configure acceptance of 0o and 0b numbers and rejection of "leading zero as octal". * generic/tclBasic.c: Re-used the guts of int(.) and wide(.) math functions to perform conversions in OldMathFuncProc. * generic/tclBasic.c: Support for ACCEPT_NAN. * generic/tclExecute.c: * generic/tclInt.decls: Restored TclExprFloatError to internal stubs * generic/tclBasic.c: table, and moved definition back to * generic/tclExecute.c: tclExecute.c from tclBasic.c to handle #undef ACCEPT_NAN. * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclInt.h: New internal macros TclIsNaN and TclIsInfinite * generic/tclBasic.c: replace the IS_NAN and IS_INF macros scattered * generic/tclExecute.c: here and there. * generic/tclObj.c: * generic/tclStrToD.c: * generic/tclUtil.c: 2005-08-22 Daniel Steffen * unix/tclConfig.h.in: autoheader-2.59. 2005-08-22 Don Porter [kennykb-numerics-branch] * generic/tclInt.h: New ACCEPT_NAN macro to mark code that * generic/tclCmdAH.c: supports or disables accepting of the NaN * generic/tclExecute.c: value at various points. * generic/tclLink.c: * generic/tclStrToD.c: Bug fix. Parsing of +/- Infinity was reversed. * generic/tclTestObj.c: Disabled unused [testconvertobj] command. * generic/tclBasic: Added [expr {entier(.)}]. Rewrote int(.) and wide(.) to use the same guts, accepting all non-Inf doubles as arguments. * generic/tclInt.h: New routine TclInitBignumFromDouble. * generic/tclStrToD.c: Modified to return code and write error message. * generic/tclInt.h: TCL_WIDE_INT_IS_LONG implies NO_WIDE_TYPE. * generic/tclObj.c: Removed now unnecessary tests of the * generic/tclStrToD.c: TCL_WIDE_INT_IS_LONG definition. * generic/tclInt.h: New internal routine TclSetBignumIntRep * generic/tclObj.c: consolidates packing of bignum value into a * generic/tclStrToD.c: Tcl_Obj within one source code file. * tests/expr.test: Corrected the wideIs64bit constraint. * tests/format.test: * tests/scan.test: 2005-08-21 Don Porter [kennykb-numerics-branch] * generic/tclInt.h: Moved TclParseInteger to tclUtil.c and * generic/tclParseExpr.c: made it static. * generic/tclUtil.c: * generic/tclInt.decls: Moved TclExprFloatError to tclBasic.c and made * generic/tclBasic.c: it static. * generic/tclExecute.c: * generitc/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclExecute.c: errno, IS_NAN, IS_INF, LLD no longer called in this file; dropped/disabled support for them. * generic/tclCompExpr.c: errno no longer used in these files; * generic/tclParseExpr.c: dropped support "hack" for it. * generic/tclStrToD.c: Disabled out of date support "hack" for errno. * generic/tclBasic.c: Eliminated VerifyExprObjType. Initialize errno to zero in OldMathFuncProc. 2005-08-19 Don Porter [kennykb-numerics-branch] * generic/tclBasic.c: Updated OldMathFuncProc and ExprAbsFunc to do less invasion into numeric Tcl_Obj internals. Made ExprDoubleFunc, ExprIntFunc, ExprWideFunc, and ExprRoundFunc bignum-aware. Revised ExprSrandFunc error message. * generic/tclProc.c: Wrapped a few tclWideIntType uses in * generic/tclCmdMZ.c: #ifndef NO_WIDE_TYPE. * generic/tclInt.h: #define'd NO_WIDE_TYPE. * generic/tclVar.c: Replaced TclPtrIncrVar and TclPtrIncrWideVar * generic/tclInt.h: with TclPtrIncrObjVar and replaced TclIncrVar2 * generic/tclInt.decls: and TclIncrWideVar2 with TclIncrObjVar2. New routines call on TclIncrObj to do the work. * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclCmdIL.c: Rework Tcl_IncrObjCmd and the INST_*INCR* * generic/tclExecute.c: opcodes to use the new routines. 2005-08-18 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Fixed string rep invalidation bug in * tests/dict.test (dict-11.17): INST_DICT_INCR_IMM rewrite. * generic/tclDictObj.c: DictIncrCmd rewrite to use TclIncrObj. * generic/tclInt.h: TclIncrObj static -> internal * generic/tclExecute.c: 2005-08-17 George Peter Staplin * generic/tclBasic.c: eliminate a namespace clash caused by BuiltinFuncTable not being static. * generic/tclObj.c: fix a namespace clash caused by a missing static for pendingObjData. 2005-08-17 Kevin Kenny * generic/tclEvent.c (Tcl_Finalize): Removed a copy-and-paste accident that caused a (mostly harmless) double finalize of the load and filesystem subsystems. * tests/clock.test: Eliminated the bad test clock-43.1, and split clock-50.1 into two tests, with a more permissive check on the error message for an out-of-range value. 2005-08-17 Kevin Kenny [kennykb-numerics-branch] * generic/tclBasic.c (Tcl_Expr{Long,Double}{,Obj}): Updated to * generic/tclTest.c: deal with * tests/expr-old.test: bignums (well, * tests/expr.test: mostly). Added a missing "errno=0;" in ExprUnaryFunc so that spurious error returns aren't detected. Added test cases for Tcl_Expr* and Tcl_Expr*Obj because there was very poor test coverage in those areas. * generic/tclParseExpr.c: Reworked parsing of numbers to call TclParseNumber rather than trying to do things locally. * generic/tclStrToD.c: Corrected a comment. Changed so that *endPtrPtr does not include any trailing whitespace. 2005-08-17 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: New routine TclIncrObj to centralize the increment operation needed in many places. Updated INST_DICT_INCR_IMM to make use of it. 2005-08-16 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Made bit shifting opcodes and INST_MOD bignum-aware. * tests/scan.test: Making << bignum-aware means that repeated * tests/string.test: left shifting cannot turn a positive into a negative. Revised [int_range] and [largest_int] utility commands in the test suite that relied on that happening. Without revision they became infinite loops. * generic/tclExecute.c: Made binary bitwise opcodes bignum-aware. * generic/tclTomMath.h: Added mp_or and mp_xor to routines from * unix/Makefile.in: libtommath used by Tcl. * win/Makefile.in: * win/makefile.vc: 2005-08-15 Don Porter [kennykb-numerics-branch] Updates from HEAD. * generic/tclExecute.c: More revisions to IllegalExprOperandType. Merged INST_BITNOT with INST_UMINUS and make it bignum-aware according to the rule: ~a = -a - 1. Disabled unused code and noted more TODOs. * generic/tclInt.decls: Disabled TclLooksLikeInt() and all callers. * generic/tclUtil.c: * generic/tclCompCmds.c: * generic/tclBasic.c: Rewrite of VerifyExprObjType(). * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclExecute.c: Updated execution of comparison bytecodes to be bignum-aware, routing string compares through INST_STR_CMP. 2005-08-14 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Updated execution of arithmetic bytecodes to be bignum-aware, and to allow calculations on NaN to produce a NaN result. INST_UMINUS updated to call mp_neg. * generic/tclTomMath.h: Added mp_and, mp_expt_d, and mp_neg to * unix/Makefile.in: routines from libtommath used by Tcl. * win/Makefile.in: * win/makefile.vc: 2005-08-13 Don Porter [kennykb-numerics-branch] * generic/tclObj.c: Extended Bignum auto-narrowing to auto-narrow to tclWideIntType when appropriate; this helps keep things working as the bytecode execution code is migrated to supporting bignums. * generic/tclExecute.c: Major overhaul of IllegalExprOperandType. Changed several TclNewFooObj() calls to more logically appropriate ones. Added several TODO comments marking opportunies for future work. Made more use of the eePtr->constants. Made INST_UMINUS bignum aware. 2005-08-12 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Simplify doCondJump. Use eePtr->constants as result of INST_DICT_NEXT, INST_LAND, and INST_LOR. Separate INST_LNOT from INST_UMINUS and simplify. 2005-08-12 Kevin Kenny * generic/tclClock.c (MktimeObjCmd): * library/clock.tcl (GetSystemTimeZone, LoadZoneinfoFile) (ReadZoneinfoFile): * tests/clock.test (clock-50.1): Added functionality to read /etc/localtime if it exists, so that Tcl's time can track system time on Linux even if TZ is not set. Changed ::tcl::clock::Mktime to check for failure, and added a test case that mimics failure but is really success. 2005-08-11 Don Porter [kennykb-numerics-branch] * generic/tclExecute.c: Rewrite of INST_LAND/INST_LOR to take advantage of loss of "pure double" issues. Merged INST_UPLUS with INST_TRY_CVT_TO_NUMERIC and updated to use improved rules for impure "double"s as well. * generic/tclStrToD.c: Restored conditional generation of tclWideIntType values by TclParseNumber so that Tcl's not completely broken while bignum calculation support is incomplete. The NO_WIDE_TYPE macro can be used to disable this. * generic/tclBasic.c (ExprAbsFunc): First pass making [expr abs(.)] bignum-aware. 2005-08-11 Kevin Kenny * generic/tclEvent.c: Eliminated the USE_THREAD_STORAGE option * generic/tclInt.h: (which is on in every build generated by * generic/tclThread.c: by the standard configurator). * generic/tclThreadStorage.c: Eliminated the code for thread specific * unix/configure: data without USE_THREAD_STORAGE and * unix/tcl.m4: radically refactored the code for * unix/tclConfig.h.in: USE_THREAD_STORAGE so that it has fewer * unix/tclUnixThrd.c: dependencies on the order of * win/configure: finalization. (Also, made 'make * win/Makefile.in: distclean' on Windows clean just a little * win/rules.vc: bit cleaner.) * win/tcl.m4: * win/tclWinThrd.c: 2005-08-10 Don Porter [kennykb-numerics-branch] * generic/tclTomMath.h: Added mp_shrink, mp_to_unsigned_bin, * unix/Makefile.in: mp_to_unsigned_bin_n, and mp_unsigned_bin_size * win/Makefile.in: to routines from libtommath used by Tcl. * win/makefile.vc: * generic/tommath.h: make gentommath_h * generic/tclObj.c: Substantial rewrite to make all number parsing flow through TclParseNumber(). Also established the NO_WIDE_TYPE and BIGNUM_AUTO_NARROW #ifdef's to help track the assumptions of different portions of the code. * generic/tclInt.h: Added NO_WIDE_TYPE #ifdefs 2005-08-10 Kevin Kenny * generic/tclEvent.c (Tcl_Finalize): Pushed Tcl_FinalizeLoad and Tcl_ResetFilesystem down after Tcl_FinalizeThreadAlloc because we can't unload DLL's until after their TSD keys are finalized. (Note that we'll still see aborts if an unloaded DLL has TSD - that still needs to be fixed. * tests/compExpr-old.test (compExpr-3.8): Made tests conditional on * tests/expr.test (expr-3.8): 'unix' because they get stack overflows on Win32 threaded builds, 2005-08-09 Vince Darley * generic/tclPathObj.c: fix to [file rootname] bug in optimized code path reported on comp.lang.tcl. 2005-08-08 Don Porter [kennykb-numerics-branch] * generic/tclObj.c: Replaced some goto's with loops and started use of BIGNUM_AUTO_NARROW and NO_WIDE_TYPE. 2005-08-06 Donal K. Fellows * generic/tclThreadStorage.c: Stop exposing the guts of the thread storage system through the internal stubs table. Client code should always use the standard API. 2005-08-05 Don Porter [kennykb-numerics-branch] * generic/tclObj.c: Rewrote Tcl_GetDoubleFromObj(). 2005-08-05 Donal K. Fellows * unix/tclUnixInit.c (localeTable): Solaris uses a non-standard name for the cp1251 charset. Thanks to Victor Wagner for reporting this. [Bug 1252475] 2005-08-05 Kevin Kenny * win/makefile.vc: Removed unused file ldAout.tcl. * win/makefile.bc: [Bug 1244361] * tests/binary.test: Cleaned up testing for scanning of NaN. [Bug 1246264] * generic/tclBasic.c (ExprAbsFunc): Added code to handle the corner * tests/expr.test (expr-38.1): case of applying 'abs' to the smallest 32-bit integer. [Bug 1241572] 2005-08-04 Andreas Kupries * generic/tclIO.c (CloseChannel): Fixed comment nit, added apparently missing word to complete a sentence. * generic/tclObj.c (Tcl_DbDecrRefCount): Fixed whitespace nit in panic message. 2005-08-04 Don Porter [kennykb-numerics-branch] Updated from HEAD * generic/tclObj.c: Rewrote Tcl_GetBooleanFromObj() and supporting routines to make use of TclParseNumber. This reduces the potential number of times a string value must be scanned. * generic/tclObj.c: Simplified routines that manage the typeTable. Deleted the UpdateStringOfBoolean() routine, that can never be called. 2005-08-03 Don Porter * generic/tclCompExpr.c: Untangled some dependencies in the * generic/tclEvent.c: order of finalization routines. * generic/tclInt.h: [Bug 1251399] * generic/tclObj.c: 2005-08-02 Don Porter [kennykb-numerics-branch] Updated from HEAD 2005-07-30 Daniel Steffen * unix/tclLoadDyld.c (TclpDlopen, TclpLoadMemory): workarounds for bugs/changes in behaviour in Mac OS X 10.4 Tiger. 2005-07-29 Donal K. Fellows * generic/tclCmdIL.c (InfoGlobalsCmd): Even in high-speed mode, still have to take care with non-existant variables. [Bug 1247135] 2005-07-28 Mo DeJong * win/README: Update link to msys_mingw8.zip. 2005-07-28 Don Porter * tests/compExpr-old.test: Still more conversion of "nonPortable" * tests/error.test: tests into tests with constraints that * tests/expr-old.test: describe the limits of their * tests/expr.test: portability. Also more consolidation * tests/fileName.test: of constraint synonyms. * tests/format.test: wideis64bit, 64bitInts => wideIs64bit * tests/get.test: wideIntegerUnparsed => wideIs32bit * tests/load.test: wideIntExpressions => wideBiggerThanInt * tests/obj.test: * tests/parseExpr.test: Dropped "roundOffBug" constraint that * tests/string.test: protected from buggy sprintf. 2005-07-28 Donal K. Fellows * generic/tclPipe.c (TclCreatePipeline): Arrange for POSIX systems to * unix/tclUnixPipe.c (TclpOpenFile): use the O_APPEND flag for * tests/exec.test (exec-19.1): files opened in a pipeline like ">>this". Note that Windows cannot support such access; there is no equivalent flag on the handle that can be set at the kernel-call level. The test is unix-specific in every way. [Bug 1245953] 2005-07-27 Don Porter * generic/tclUtil.c: Converted the $::tcl_precision value to be kept per-thread to prevent different threads from stomping on each others' formatting prescriptions. ***POTENTIAL INCOMPATIBILITY*** Multi-threaded programs that set the value of ::tcl_precision will now have to set it in each thread. * tests/expr.test: Consolidated equivalent constraints into * tests/fileName.test: single definitions and (more precise) names: * tests/get.test: longis32bit, 32bit, !intsAre64bit => longIs32bit * tests/listObj.test: empty => emptyTest; winOnly => win * tests/obj.test: intsAre64bit => longIs64bit Also updated some "nonPortable" tests to use constraints that mark precisely what about them isn't portable, so the tests can run where they work. * library/init.tcl ([unknown]): Corrected return code handling in the portions of [unknown] that expand incomplete commands during interactive operations. [Bug 1214462]. 2005-07-26 Mo DeJong * unix/configure: Regen. * unix/configure.in: Check for a $prefix/share directory and add it the the package if found. This will check for Tcl packages in /usr/local/share when Tcl is configured with the default dist install. [Patch 1231015] 2005-07-26 Don Porter * generic/tclBasic.c (Tcl_CallWhenDeleted): Converted to use per-thread counter, rather than a process global one that required mutex protection. [RFE 1077194] * generic/tclNamesp.c (TclTeardownNamespace): Re-ordering so that * tests/trace.test (trace-34.4): command delete traces fire while the command still exists. [Bug 1047286] 2005-07-24 Mo DeJong * unix/configure: Regen. * unix/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): * win/configure: Regen. * win/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): Split confused search for tclsh on PATH and build and install locations into two macros. SC_PROG_TCLSH searches just the PATH. SC_BUILD_TCLSH determines the name of the tclsh executable in the Tcl build directory. [Bug 1160114] [Patch 1244153] 2005-07-23 Don Porter * library/auto.tcl: Updates to the Tcl script library to make use * library/history.tcl: of Tcl 8.4 features. Forward port of * library/init.tcl: appropriate portions of [Patch 1237755]. * library/package.tcl: * library/safe.tcl: * library/word.tcl: 2005-07-23 Mo DeJong * tests/string.test: Add string is tests for functionality that was not tested. * win/README: Update msys + mingw URL. Remove old Cygwin + mingw info. 2005-07-23 Miguel Sofer * generic/tclExecute.c (INST_DICT_*): stop 2 compiler warnings for uninitialised variables. 2005-07-23 Donal K. Fellows * generic/tclExecute.c (TEBC:INST_DICT_INCR_IMM): Fix the incrementor to work correctly with wide values. 2005-07-21 Donal K. Fellows * generic/tclCompCmds.c (TclCompileDictCmd): First run at a compiler * generic/tclExecute.c (TclExecuteByteCode): for dictionaries. Also added an instruction to support 'finally'-like clauses, exposed more of the dict guts to the rest of the core, and defined a few tests to exercise more obscure parts of the compiler's operation that were bugs during development. 2005-07-21 Kevin B. Kenny * library/ldAout.tcl (***REMOVED***): Removed support for ancient * unix/configure: BSD's, IRIX 4, RISCos and * unix/Makefile.in: Ultrix. Removed two files whose * unix/tcl.m4: code is used only on those * unix/tclLoadAout.c (***REMOVED***): antique platforms. ***POTENTIAL INCOMPATIBILITY*** if anyone actually uses those platforms; it is to be noted though, that an error in the installer has actually not caused a necessary file to be installed on those platforms in several releases, and nobody's complained. 2005-07-16 Kevin B. Kenny * generic/tclStrToD.c (RefineResult): Plugged a stupid memory leak in RefineResult (called from Tcl_StrToD). [Tk Bug 1227781] 2005-07-15 Kevin B. Kenny * generic/tclClock.c (TclClockLocaltimeObjCmd,ThreadSafeLocalTime): * library/clock.tcl (GuessWindowsTimeZone, ClearCaches): * tests/clock.test (clock-49.1, clock-49.2): Handle correctly the case where localtime() returns NULL to report a conversion error. Also handle the case where the Windows registry contains timezone values that can be mapped to a tzdata file name but the corresponding file does not exist or is corrupted, by falling back on a Posix timezone string instead; this last case will avoid calls to localtime() in starpacks on Windows. [Bug 1237907] 2005-07-14 Donal K. Fellows * generic/tclCompile.c: Update to follow style guidelines. (TclPrintInstruction): Reorganize to do better printing out of bytecode with far fewer "special hacks" for particular opcodes. * generic/tclCompile.h: Requires two new opcode types. 2005-07-13 Don Porter * unix/tclUnixSock.c: Use a ProcessGlobalValue to store the value * win/tclWinSock.c: returned by Tcl_GetHostName() ([info hostname]). Also re-order initialization of the value on Windows to favor GetComputerName() over gethostname() as a source of the information. 2005-07-12 Kevin Kenny [kennykb-numerics-branch] Updated from HEAD * generic/tclCmdMZ.c (Tcl_StringObjCmd): * generic/tclInt.h: * generic/tclObj.c (Tcl_GetDoubleFromObj, SetDoubleFromAny) (Tcl_GetIntFromObj, SetIntOrWideFromAny): * generic/tclStrToD.c (TclParseNumber, etc.): * tclTomMathInterface.c (TclBNInitBignumFromWideUInt): * tests/obj.test (obj-1.1, obj-2.2, obj-3.1, obj-3.2): Initial attempt at an implementation of TIP #249, comprising a unified parser and modifications to the Tcl_Get*FromObj routines to use it. Further integration of the parser is necessary and planned. 2005-07-12 Donal K. Fellows * doc/lsearch.n: Clarify documentation of -exact option; wording was open to misinterpretation by non-English speakers. 2005-07-11 Donal K. Fellows * generic/tclExecute.c: General style cleanup. 2005-07-08 Mo DeJong * generic/tclExecute.c (TclExecuteByteCode): Reimplement long and wide type integer division and modulus operations so that the smallest and largest integer values are handled properly. The divide operation is more efficient since it no longer does a modulus or negation and only checks for a remainder when the quotient will be a negative number. The modulus operation is now a bit more complex because of a number of special cases dealing with the smallest and largest integers. * tests/expr.test: Add test cases for division and modulus operations on the smallest and largest integer values for 32 and 64 bit types. [Patch 1230205] 2005-07-06 Don Porter * generic/tclLink.c: Simplified LinkTraceProc [Bug 1208108]. 2005-07-05 Don Porter * unix/Makefile.in: Purged use of TCLTESTARGS [RFE 1161550]. * generic/tclUtil.c: Converted TclFormatInt() into a macro. * generic/tclInt.decls: [RFE 1194015] * generic/tclInt.h: * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclNamesp.c: Allow for [namespace import] of a command * tests/namespace.test: over a previous [namespace import] of itself without throwing an error. [RFE 1230597] 2005-07-04 Donal K. Fellows * generic/tclDictObj.c (DictForCmd, DictFilterCmd): Interlocking of dictionary internal representations is now done in the core of the dict iterator. Purge the last attempts at doing it at a higher level as they didn't work and were no longer needed. 2005-07-01 Zoran Vasiljevic * unix/tclUnixNotfy.c: protect against spurious wake-ups while waiting on the condition variable when tearing down the notifier thread [Bug 1222872]. 2005-06-28 Mo DeJong * generic/tclExecute.c (TclExecuteByteCode): When parsing an integer operand for a unary minus expression operator, check for a wide integer that is actually LONG_MIN. If found, convert back to a long int type. * tests/expr.test: Add constraint for 32bit long int type and 64bit wide int type. Add tests that parse the smallest/largest long int and wide int values. 2005-06-24 Kevin Kenny * generic/tclEvent.c (Tcl_Finalize): * generic/tclInt.h: * generic/tclPreserve.c (TclFinalizePreserve): Changed the finalization logic so that Tcl_Preserve finalizes after exit handlers run; a lot of code called from Tk's exit handlers presumes that Tcl_Preserve will still work even from an exit handler. 2005-06-24 Don Porter * library/auto.tcl: Make file safe to re-[source] without destroying registered auto_mkindex_parser hooks. 2005-06-23 Kevin Kenny * win/tclWinChan.c: More rewriting of __asm__ blocks that implement * win/tclWinFCmd.c: SEH in GCC, because mingw's gcc 3.4.2 is not as forgiving of violations committed by the old code and caused panics. [Bug 1225957] 2005-06-23 Daniel Steffen * tools/tcltk-man2html.tcl: fixed useversion glob pattern to accept multi-digit patchlevels. 2005-06-22 Don Porter * win/tclWinFile.c: Potential buffer overflow. [Bug 1225571] Thanks to Pat Thoyts for discovery and fix. 2005-06-22 Kevin Kenny * generic/tclInt.h: Changed the finalization * generic/tclEvent.c (Tcl_Finalize): logic to defer the * generic/tclIO.c (TclFinalizeIOSubsystem): shutdown of the pipe * unix/tclUnixPipe.c (TclFinalizePipes): management until after all * win/tclWinPipe.c (TclFinalizePipes): channels have been closed, in order to avoid a situation where the Windows PipeCloseProc2 would re-establish the exit handler after exit handlers had already run, corrupting the heap. [Bug 1225727] Also corrected a potential read of uninitialized memory in PipeClose2Proc [Bug 1225044] 2005-06-21 Andreas Kupries * generic/tclInt.h: Followup to change made on 2005-06-18 by Daniel Steffen. There are compilers (*) who error out on the redefinition of WORDS_BIGENDIAN. We have to undef the previous definition (on the command line) first to make this acceptable. (*): AIX native. 2005-06-21 Kevin B. Kenny * generic/tclFileName.c: Changed [file split] and [file join] to treat Windows drive letters similarly to ~ syntax and make sure that they appear with "./" in front when they are in intermediate components of the path. [Bug 1194458] * tests/fileName.test: Added test for the above bug. 2005-06-21 Don Porter * generic/tclBasic.c: Added missing walk of the list of active * generic/tclTrace.c: traces to cleanup references to traces being * generic/tclInt.h: deleted. [Bug 1201035] Made the walk of the * tests/trace.test (trace-34.*): active trace list aware of the direction of trace scanning, so the proper correction can be made. [Bug 1224585] 2005-06-21 Donal K. Fellows * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Only enable the 'compile' special debugging feature when requested in configure.in; removes irrelevant junk from the configure files of extensions that use Tcl's tcl.m4. 2005-06-20 Donal K. Fellows * generic/tclCompile.h (INST_PUSH_RETURN_OPTIONS): New opcode to allow * generic/tclCompCmds.c (TclCompileCatchCmd): compilation of * generic/tclCompile.c: TIP#90 catch [Bug * generic/tclExecute.c (TclExecuteByteCode): 1219112] * generic/tclCompCmds.c (TclCompileSwitchCmd): Ensure we spill to the command form in all cases where it generates an error. 2005-06-20 Mo DeJong * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Generate an error if a mode argument like -exact is passed more than once to the switch command. The previous implementation silently accepted invalid switch invocations like [switch -exact -glob $str ...]. * tests/for.test: Check some error cases when invoking continue and break inside a for loop next script. * tests/switch.test: Add checks for shortened version of a mode argument like -exact. Add test for more than one mode argument. Add test for odd case of passing a variable as a body script. 2005-06-18 Daniel Steffen * generic/tclInt.h: ensure WORDS_BIGENDIAN is defined correctly with fat compiles on Darwin (i.e. ppc and i386 at the same time), the configure AC_C_BIGENDIAN check is not sufficient in this case because a single run of the compiler builds for two architectures with different endianness. * unix/tcl.m4 (Darwin): add -headerpad_max_install_names to LDFLAGS to ensure we can always relocate binaries with install_name_tool. * unix/configure: autoconf-2.59 2005-06-18 Donal K. Fellows * generic/tclCmdAH.c (Tcl_FormatObjCmd): Fix for [Bug 1154163]; only * tests/format.test: insert 'l' modifier when it is needed. 2005-06-17 Donal K. Fellows * generic/tclTimer.c (AfterDelay): Split out the code to manage synchronous-delay [after] commands. * tests/interp.test (interp-34.10): Time limits and synch-delay [after] did not mix well... [Bug 1221395] 2005-06-14 Donal K. Fellows * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Only delete a * tests/namespace.test (namespace-49.2): command from the hashtable on reentrant processing if it has not been already deleted; at least three deletes of the same command are possible. [Bug 1220058] * generic/tclTrace.c (TraceCommandProc): Remove bogus error message creation when traces trigger in situations where the command has already been deleted. 2005-06-13 Vince Darley * generic/tclFCmd.c: correct fix to file mkdir 2005-06-09 [Bug 1219176] 2005-06-12 Donal K. Fellows * generic/tclCompCmds.c: Factor out some common idioms into named forms for greater clarity. 2005-06-10 Donal K. Fellows * doc/chan.n: Fold in the descriptive parts of the documentation for all the commands that [chan] builds on top of. 2005-06-09 Vince Darley * generic/tclFCmd.c: fix to race condition in file mkdir [Bug 1217375] * doc/glob.n: improve glob documentation [Bug 1190891] 2005-06-09 Donal K. Fellows * doc/expr.n, doc/mathfunc.n: Fix minor typos [Bug 1211078] and add mention of distinctly-relevant [namespace path] subcommand. 2005-06-07 Don Porter * generic/tclInt.h: Reduced the Tcl_ObjTypes "index", * generic/tclIndexObj.c: "ensembleCmd", "localVarName", and * generic/tclNamesp.c: "levelReference" to file static scope. * generic/tclProc.c: * generic/tclVar.c: * generic/tclObj.c: Restored registration of the "procbody" Tcl_ObjType, as required by the tclcompiler application. * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: 2005-06-07 Donal K. Fellows * generic/tclIO.c (Tcl_ChannelTruncateProc): Stop proliferation of * generic/tcl.h: channel type versions * doc/CrtChannel.3: following advice from AKu Bump patchlevel to a4 to distinguish from a3 release. * generic/tclInt.h (INTERP_TRACE_IN_PROGRESS): Add flag so the error * generic/tclIndexObj.c (Tcl_WrongNumArgs): messages from ensembles * generic/tclIOCmd.c (Tcl_ReadObjCmd): can be correct. TIP#208 IMPLEMENTATION * library/init.tcl: Create the chan ensemble. * tests/chan.test: Rudimentary test suite. * doc/chan.n: General documentation. TRUNCATION API (part of TIP#208) * generic/tcl.h, generic/tcl.decls: Declaration of the API. * doc/CrtChannel.3, doc/OpenFileChnl.3: Documentation of the API. * generic/tclBasic.c (Tcl_CreateInterp): Create the mapping into Tcl. * generic/tclIOCmd.c (TclChanTruncateObjCmd): Implementation of Tcl-level truncation API. * generic/tclIO.c (Tcl_TruncateChannel): Generic C-level truncation API implementation. * unix/tclUnixChan.c (FileTruncateProc): Basic implementation of truncating driver. * win/tclWinChan.c (FileTruncateProc): Added implementation of file truncation for Windows. * tests/chan.test (chan-15.2): Added real test of truncation. 2005-06-06 Kevin B. Kenny * win/tclWin32Dll.c: Corrected another buglet in the assembly code for stack probing on Win32/gcc. [Bug 1213678] * generic/tclObj,c: Added missing 'static' on definition of UpdateStringOfBignum, and removed a 'switch' on a 'long long' operand (which HP-UX native 'cc' seems unable to handle). [Bug 1215775] 2005-06-04 Jeff Hobbs *** 8.5a3 TAGGED FOR RELEASE *** * unix/Makefile.in (dist): add libtommath 2005-06-03 Donal K. Fellows * library/parray.tcl (parray): Only generate the sorted list of element names once. Thanks to Andreas Leitgeb for spotting this. 2005-06-03 Daniel Steffen * macosx/Makefile: fixed 'embedded' target. 2005-06-02 Jeff Hobbs * unix/Makefile.in (html): add BUILD_HTML_FLAGS optional var * tools/tcltk-man2html.tcl: add a --useversion to prevent confusion when multiple Tcl source dirs exist. 2005-06-01 Don Porter * generic/tclBasic.c: For compatibility with earlier Tcl releases, * generic/tclResult.c: when a command procedure simply does a * generic/tclTest.c: "return TCL_RETURN;" we must interpret that * tests/result.test: the same as "return Tcl_SetReturnOptions(interp, Tcl_NewObj());" [Bug 1209759]. 2005-06-01 Donal K. Fellows * generic/tclCompCmds.c (TclCompileSwitchCmd): Allow compilation of -nocase -glob [switch]es (only one we know how to compile). TIP#241 IMPLEMENTATION from Joe Mistachkin * generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd): * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Implementation of -nocase option for [lsearch], [lsort] and [switch] commands. * win/tclWinPort.h: Win uses nonstandard function names... * tests/cmdIL.test, tests/lsearch.test, tests/switch.test: Tests * doc/lsearch.n, doc/lsort.n, doc/switch.n: Docs * generic/tclCompCmds.c (TclCompileLindexCmd): Compile the most common case of [lindex] more efficiently. * unix/tclUnixNotfy.c (Tcl_FinalizeNotifier): Pass the correct number of arguments to Tcl_JoinThread. 2005-05-31 Donal K. Fellows * unix/configure.in, unix/tcl.m4: Standardize generation of help messages to always use AC_HELP_STRING and always (except for --with-tcl and --with-tk, where the default is complex) say what the default is. 2005-05-31 Zoran Vasiljevic * unix/tclUnixNotfy.c: the notifier thread is now created as joinable thread and it is properly joined in Tcl_FinalizeNotifier. This is an attempt to fix the [Bug 1082283]. 2005-05-30 Zoran Vasiljevic * win/tclWinThrd.c: Fixed [Bug 1204064] 2005-05-30 Donal K. Fellows TIP #229 IMPLEMENTATION * generic/tclNamesp.c (Tcl_FindCommand, TclResetShadowedCmdRefs) (NamespacePathCmd, SetNsPath, UnlinkNsPath, TclInvalidateNsPath): Implementation of the [namespace path] command and the command name resolution engine. * doc/info.n, doc/namespace.n: Doc updates. * tests/namespace.test (namespace-51.*): Test updates. * generic/tclResolve.c (BumpCmdRefEpochs, Tcl_SetNamespaceResolvers): * generic/tclBasic.c (Tcl_CreateCommand, Tcl_CreateObjCommand): Ensure that people don't see stale paths. * generic/tclInt.h (Namespace, NamespacePathEntry): Structure defs. * generic/tclCmdIL.c (InfoCommandsCmd): Updates to [info commands]. 2005-05-26 Daniel Steffen * macosx/Makefile: moved & corrected EMBEDDED_BUILD check. * unix/configure.in: corrected framework finalization to softlink stub library to Versions/8.x subdir instead of Versions/Current. * unix/configure: autoconf-2.59 2005-05-25 Jeff Hobbs * generic/tclCmdMZ.c (Tcl_TimeObjCmd): add necessary cast 2005-05-25 Don Porter TIP#182 IMPLEMENTATION [Patch 1165062] * doc/mathfunc.n: New built-in math function bool(). * generic/tclBasic.c: * tests/expr.test: * tests/info.test: 2005-05-24 Don Porter * library/init.tcl: Updated [unknown] to be sure the [return] * tests/init.test: options from an auto-loaded command are seen correctly by the caller. 2005-05-24 Daniel Steffen * tests/env.test: added DYLD_FRAMEWORK_PATH to the list of env vars that need to be handled specially. * macosx/Makefile: * macosx/README: * macosx/Tcl-Info.plist.in (new file): * unix/Makefile.in: * unix/configure.in: * unix/tcl.m4: * unix/tclUnixInit.c: moved all Darwin framework build support from macosx/Makefile into the standard unix configure/make buildsystem, the macosx/Makefile is no longer required to build Tcl.framework (but its functionality is still available for backwards compatibility). * unix/configure: autoconf-2.59 * generic/tclIOUtil.c (TclLoadFile): * generic/tclInt.h: * unix/tcl.m4: * unix/tclLoadDyld.c: added support for [load]ing .bundle binaries in addition to .dylib's: .bundle's can be [unload]ed (unlike .dylib's), and can be [load]ed from memory, e.g. directly from VFS without needing to be written out to a temporary location first. [Bug 1202209] * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 * generic/tclCmdMZ.c (Tcl_TimeObjCmd): change [time] called with a count > 1 to return a string with a float value instead of a rounded off integer. [Bug 1202178] * doc/expr.n: * doc/string.n: fixed roff syntax complaints from 'make html'. 2005-05-20 Don Porter * generic/tclParseExpr.c: Corrected parser to recognize all boolean literals accepted by Tcl_GetBoolean, including prefixes like "y" and "f", and to allow "eq" and "ne" as function names in the proper context. [Bug 1201589]. 2005-05-19 Donal K. Fellows * generic/tclBasic.c (TclEvalObjvInternal): Rewrite for greater clarity; although 'goto' is Bad, the contortions you have to go through to avoid it can be worse... 2005-05-19 Daniel Steffen * macosx/tclMacOSXNotify.c (Tcl_InitNotifier): fixed crashing CFRelease of runLoopSource in Tcl_InitNotifier (reported by Zoran): CFRunLoopAddSource doesn't CFRetain, so can only CFRelease the runLoopSource in Tcl_FinalizeNotifier. 2005-05-18 Don Porter * generic/tclBasic.c (Tcl_ExprBoolean): Rewrite as wrapper around Tcl_ExprBooleanObj. * generic/tclCmdMZ.c ([string is boolean/true/false]): Rewrite dropping string-based Tcl_GetBoolean call, so that internal reps are kept for subsequent quick boolean operations. * generic/tclExecute.c: Dropped most special handling of the "boolean" Tcl_ObjType, since that type should now be rarely encountered. * doc/BoolObj.3: Rewrite of documentation dropping many details about the internals of Tcl_Objs. Shorter documentation focuses on the function and use of the routines. * generic/tclInt.h: Revision to the "boolean" Tcl_ObjType, so that * generic/tclObj.c: only string values like "yes" and "false" are * tests/obj.test: kept as the "boolean" Tcl_ObjType. The string values "0" and "1" are kept as "int" Tcl_ObjType, which also produce quick calls to Tcl_GetBooleanFromObj(). Since this internal change means a Tcl_ConvertToType to a "boolean" Tcl_ObjType might not produce a Tcl_Obj of type "boolean", the registration of the "boolean" type is also removed. ***POTENTIAL INCOMPATIBILITY*** For callers of Tcl_GetObjType on the type name "boolean". 2005-05-17 Don Porter * generic/tclObj.c (TclInitObjSubsystem): Removed the * tests/listObj.test: registration of the Tcl_ObjType's "list", * tests/obj.test: "procbody", "index", "ensembleCommand", "localVarName", and "levelReference". The only reason to register a Tcl_ObjType is to have it returned by Tcl_GetObjType, and the only reason for that is to retrieve a (Tcl_ObjType *) to pass to Tcl_ConvertToType(). None of the types above can support a Tcl_ConvertToType() call; they panic. Better not to offer something than to lead users into a panic. ***POTENTIAL INCOMPATIBILITY*** For callers of Tcl_GetObjType on the type names listed above. 2005-05-15 Kevin Kenny * win/tclWin32Dll.c: conditioned definition of EXCEPTION_REGISTRATION structures on HAVE_NO_SEH, to fix a bug in buildability on MSVC. 2005-05-14 Daniel Steffen * generic/tclInt.decls: * generic/tclTest.c: * generic/tclUtil.c: * win/tclWin32Dll.c: fixed link error due to direct access by tclTest.c to the MODULE_SCOPE tclPlatform global: renamed existing TclWinGetPlatform() accessor to TclGetPlatform() and moved it to generic code so that it can be used by on all platforms where MODULE_SCOPE is enforced. * macosx/tclMacOSXBundle.c: * unix/tclUnixInit.c: * unix/tcl.m4 (Darwin): made use of CoreFoundation API configurable and added test of CoreFoundation availablility to allow building on ppc64, replaced HAVE_CFBUNDLE by HAVE_COREFOUNDATION; test for availability of Tiger or later OSSpinLockLock API. * unix/tclUnixNotfy.c: * unix/Makefile.in: * macosx/tclMacOSXNotify.c (new file): when CoreFoundation is available, use new CFRunLoop based notifier: allows easy integration with other event loops on Mac OS X, in particular the TkAqua Carbon event loop is now integrated via a standard tcl event source (instead of TkAqua upon loading having to finalize the exsting notifier and replace it with its custom version). [Patch 1202052] * tests/unixNotfy.test: don't run unthreaded tests on Darwin since notifier may be using threads even in unthreaded core. * unix/tclUnixPort.h: * unix/tcl.m4 (Darwin): test for thread-unsafe realpath during configure, as Darwin 7 and later realpath is threadsafe. * macosx/Makefile: enable configure caching. * unix/configure.in: wrap tclConfig.h header in #ifndef _TCLCONFIG so that it can be included more than once without warnings from gcc4.0 (as happens e.g. when including both tclInt.h and tclPort.h) * macosx/tclMacOSXBundle.c: * unix/tclUnixChan.c: * unix/tclLoadDyld.c: * unix/tclUnixInit.c: fixed gcc 4.0 warnings. * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: make genstubs 2005-05-13 Kevin Kenny * win/tclWin32Dll.c: Further rework of the SEH logic. All EXCEPTION_REGISTRATION records are now in the activation record rather than pushed on the stack. 2005-05-13 Don Porter * generic/tclBasic.c: Dropped the TCL_NO_MATH configuration. It's * generic/tclBinary.c: believed this has not been working in a long * generic/tclExecute.c: time. Tcl needs math.h. [RFE 1200680] * unix/Makefile.in: 2005-05-12 Kevin Kenny * doc/mathfunc.n: Changed NAME line to match the name of the page. 2005-05-11 Kevin Kenny [kennykb-numerics-branch] Resynchronized with the HEAD; at this checkpoint [-rkennykb-numerics-branch-20050511], the HEAD and kennykb-numerics-branch contain identical code. 2005-05-11 Kevin Kenny * generic/tclStrToD.c (TclStrToD, RefineResult, ParseNaN): Changed the code to cast 'char' to UCHAR explicitly when using ctype macros, to silence complaints from the Solaris compiler. 2005-05-10 Jeff Hobbs * unix/tclUnixFCmd.c: add lint attr to enum to satisfy strictly compliant compilers that don't like trailing ,s. * tests/string.test: string-10.[21-30] * generic/tclCmdMZ.c (Tcl_StringObjCmd): add extra checks to prevent possible UMR in unichar cmp function for string map. 2005-05-10 Kevin Kenny * generic/tclBinary.c (FormatNumber): Fixed a bug where NaN's resulted in reads of uninitialized memory when using 'd', 'q', or 'Q' format. * generic/tclStrToD.c (ParseNaN, TclFormatNaN): Added code to handle the peculiarities of HP's PA_RISC, which uses a different 'quiet' bit in NaN from everyone else. * libtommath/tommath_superclass.h: Corrected C++-style comment. 2005-05-10 Kevin Kenny Merged all changes on kennykb-numerics-branch back into the HEAD. TIP's 132 and 232 are now Final. 2005-05-10 Kevin Kenny [kennykb-numerics-branch] Merged changes from HEAD. 2005-05-10 Miguel Sofer * generic/tclExecute.c (ExponLong, ExponWide): * tests/expr.test (expr-23.34/35): fixed special case 'i**0' for i>0 [Bug 1198892] 2005-05-09 Kevin B. Kenny [kennykb-numerics-branch] * win/tclWin32Dll.c (TclpCheckStackSpace, TclWinCPUID): Reworked structured event handling to function even with -fomit-frame-pointers. 2005-05-08 Kevin B. Kenny [kennykb-numerics-branch] * generic/tclStrToD.c: Made code more portable by finding a workaround for MSVC's 'volatile' issue that does not require conditional compilation. * win/tclWin32Dll.c (TclWinCPUID): Removed structured event handling from the GCC code since (a) bad code is generated by the instruction scheduling with -O2, and (b) it's not needed on any reasonably modern CPU. 2005-05-07 Kevin B. Kenny [kennykb-numerics-branch] * generic/tclEvent.c: Moved initialization of tclStrToD.c's * generic/tclInt.h: static constants into a procedure called * generic/tclStrToD.c: from TclInitSubsystems to avoid double checked locking protocol. Cleaned up an issue where MSVC ignored the 'volatile' specifier, causing incorrect comparison of an underflowed number against zero. 2005-05-06 Jeff Hobbs * unix/tcl.m4, unix/configure: correct Solaris 10 (5.10) check and add support for x86_64 Solaris cc builds. 2005-05-05 Kevin B. Kenny [kennykb-numerics-branch] Merged with HEAD. 2005-05-05 Kevin B. Kenny * win/tclWinThrd.c: Corrected a compilation error on the --enable-threads configuration. 2005-05-05 Don Porter * generic/tclInt.decls: Converted TclMatchIsTrivial to a macro. * generic/tclInt.h: * generic/tclUtil.c: * generic/tclIntDecls.h: `make genstubs` * generic/tclStubInit.c: * generic/tclBasic.c: Added callers of TclMatchIsTrivial where a * generic/tclCmdIL.c: search can be done more efficiently when it is * generic/tclCompCmds.c:recognized that a pattern match is really an * generic/tclDictObj.c: exact match. [Patch 1076088] * generic/tclIO.c: * generic/tclNamesp.c: * generic/tclVar.c: * generic/tclCompCmds.c: Factored common efficiency trick into a macro named CompileWord. * generic/tclCompCmds.c: Replaced all instance of * generic/tclCompile.c: TCL_OUT_LINE_COMPILE with TCL_ERROR. * generic/tclInt.h: Now that we've eradicated the mistaken * tests/appendComp.test: notion of a "compile-time error", we can use the TCL_ERROR return code to signal any failure to produce bytecode. 2005-05-03 Don Porter * doc/DString.3: Eliminated use of identifier "string" in Tcl's * doc/Environment.3: public C API to avoid conflict/confusion with * doc/Eval.3: the std::string of C++. * doc/ExprLong.3, doc/ExprLongObj.3, doc/GetInt.3, doc/GetOpnFl.3: * doc/ParseCmd.3, doc/RegExp.3, doc/SetResult.3, doc/StrMatch.3: * doc/Utf.3, generic/tcl.decls, generic/tclBasic.c, generic/tclEnv.c: * generic/tclGet.c, generic/tclParse.c, generic/tclParseExpr.c: * generic/tclRegexp.c, generic/tclResult.c, generic/tclUtf.c: * generic/tclUtil.c, unix/tclUnixChan.c: * generic/tclDecls.h: `make genstubs` 2005-05-02 Don Porter * generic/tcl.decls: * generic/tclBasic.c: Simplified implementation of Tcl_ExprString. * tests/expr-old.test: * generic/tclDecls.h: `make genstubs` 2005-04-30 Daniel Steffen * unix/tclUnixNotfy.c: applied dkf's tkMacOSXNotify.c cleanup changes. 2005-04-29 Don Porter TIP#176 IMPLEMENTATION [Patch 1165695] * generic/tclUtil.c: Extended TclGetIntForIndex to recognize index formats including end+integer and integer+/-integer. * generic/tclCmdMZ.c: Extended the -start switch of [regexp] and [regsub] to accept all index formats known by TclGetIntForIndex. * doc/lindex.n: Updated docs to note new index formats. * doc/linsert.n, doc/lrange.n, doc/lreplace.n, doc/lsearch.n: * doc/lset.n, doc/lsort.n, doc/regexp.n, doc/regsub.n, doc/string.n: * tests/cmdIL.test: Updated tests. * tests/compile.test, tests/lindex.test, tests/linsert.test: * tests/lrange.test, tests/lreplace.test, tests/lsearch.test: * tests/lset.test, tests/regexp.test, tests/regexpComp.test: * tests/string.test, tests/stringComp.test, tests/util.test: 2005-04-28 Don Porter * tests/unixInit.test (7.1): Alternative fix for the 2004-11-11 commit. 2005-04-27 Don Porter * library/init.tcl: Corrected flaw in interactive command * tests/main.test: auto-completion. [Bug 1191409]. TIP#183 IMPLEMENTATION [Patch 577093] * generic/tclIOUtil.c (TclGetOpenModeEx): New routine. * generic/tclInt.h: * generic/tclIO.c (Tcl_OpenObjCmd): Support for "b" and * doc/open.n: "BINARY" in "access" argument to [open]. * tests/ioCmd.test: 2005-04-26 Kevin B. Kenny * generic/tclBinary.c (FormatNumber): Dredge the NaN out of the internal representation if Tcl_GetDoubleFromObj returns TCL_ERROR on a NaN. * generic/tclObj.c (Tcl_GetDoubleFromObj): Restored silent overflow/underflow behaviour that the merge of 2004-04-25 messed up. Thanks to Don Porter for calling attention to this bug. Also removed an uninitialised memory reference in this function that valgrind caught. Also changed to return TCL_ERROR on a pure NaN. * generic/tclStrToD.c (RefineResult): Added a test for the initial approximation being HUGE_VAL; this test avoids EDOM being returned from ldexp on some platforms on input values exceeding the floating point range. * tests/expr.test (expr-29.*, expr-30.*): Added further tests of overflow/underflow on input conversions. 2005-04-25 Kevin B. Kenny [kennykb-numerics-branch] Merged with HEAD. * doc/CrtMathFunc.n: Revised documentation for TIP 232 2005-04-25 Daniel Steffen * compat/string.h: fixed memchr() protoype for __APPLE__ so that we build on Mac OS X 10.1 again. * generic/tclNotify.c (TclFinalizeNotifier): fixed notifier not being finalized in unthreaded core (was testing for notifier initialization in current thread by checking thread id != 0 but thread id is always 0 in untreaded core). * win/tclWinNotify.c (Tcl_WaitForEvent): * unix/tclUnixNotfy.c (Tcl_WaitForEvent): don't call ScaleTimeProc for zero wait times (as specified in TIP 233). * unix/Makefile.in: added @PLAT_SRCS@ to SRCS and split out NOTIFY_SRCS from UNIX_SRCS for parity with UNIX_OBJS & NOTIFY_OBJS. * unix/tcl.m4 (Darwin): added configure checks for recently added linker flags -single_module and -search_paths_first to allow building with older tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD and not just T{CL,K}_SHLIB_LD_EXTRAS, added unexporting from Tk of symbols from libtclstub to avoid duplicate symbol warnings, added PLAT_SRCS definition for Mac OS X, defined MODULE_SCOPE to __private_extern__. (SC_MISSING_POSIX_HEADERS): added caching of dirent.h check. * unix/configure: autoconf-2.59 2005-04-25 Kevin B. Kenny * library/tzdata/America/Boise: * library/tzdata/America/Chicago: * library/tzdata/America/Denver * library/tzdata/America/Indianapolis: * library/tzdata/America/Los_Angeles: * library/tzdata/America/Louisville: * library/tzdata/America/Managua: * library/tzdata/America/New_York: * library/tzdata/America/Phoenix: * library/tzdata/America/Port-au-Prince: * library/tzdata/America/Indiana/Knox: * library/tzdata/America/Indiana/Marengo: * library/tzdata/America/Indiana/Vevay: * library/tzdata/America/Kentucky/Monticello: * library/tzdata/America/North_Dakota/Center: * library/tzdata/Asia/Tehran: Olson's tzdata2005i. Corrects exact time at which Standard Time was adopted in the US (generally, noon, Standard Time, rather than noon, Local Mean Time). Adopts new civil rules for Nicaragua and Iran. 2005-04-25 Don Porter * library/init.tcl: Use "ni" and "in" operators. 2005-04-25 Miguel Sofer * generic/tclExecute.c: fix for [Bug 1189274]. 2005-04-24 Don Porter * generic/tclLiteral.c: Silence compiler warnings. * generic/tclObj.c: [Bug 1188863]. 2005-04-22 Don Porter The 2005-04-21 changes to Tcl_GetBooleanFromObj were done to bring it into agreement with its docs. Further investigation reveals it was the docs that were incorrect. * doc/BoolObj.3: Corrections to the documentation of Tcl_GetBooleanFromObj to bring it into agreement with what this public interface has always done, including noting the difference in function between Tcl_GetBooleanFromObj and Tcl_GetBoolean. * generic/tclGet.c: Revised Tcl_GetBoolean to no longer be a wrapper around Tcl_GetBooleanFromObj (different function!). * generic/tclObj.c: Removed TclGetTruthValueFromObj routine that was added yesterday. Revisions so that only Tcl_GetBoolean-approved values get the "boolean" Tcl_ObjType. This retains the fix for [Bug 1187123]. * tests/string.test: Test string-23.0 for Bug 1187123. * generic/tclInt.h: Revert most recent change. * generic/tclBasic.c: * generic/tclCompCmds.c: * generic/tclDictObj.c: * generic/tclExecute.c: * tests/obj.test: 2005-04-21 Don Porter * doc/GetInt.3: Convert argument "string" to "str" to agree with code. Also clarified a few details on int and double formats. * generic/tclGet.c: Radical code simplification. Converted Tcl_GetFoo() routines into wrappers around Tcl_GetFooFromObj(). Reduces code duplication, and the resulting potential for inconsistency. * generic/tclObj.c: Several changes: - Re-ordered error detection code so all values with trailing garbage receive a "not an integer" message instead of an "integer too large" message. - Removed inactive code meant to deal with strtoul* routines that fail to parse leading signs. All of them do, and if any are detected that do not, the correct fix is replacement with compat/strtoul*.c, not a lot of special care by the callers. - Tcl_GetDoubleFromObj now avoids shimmering away a "wideInt" intrep. - Fixed Tcl_GetBooleanFromObj to agree with its documentation and with Tcl_GetBoolean, accepting only "0" and "1" and not other numeric strings. [Bug 1187123] - Added new private routine TclGetTruthValueFromObj to perform the more permissive conversion of numeric values to boolean that is needed by the [expr] machinery. * generic/tclInt.h (TclGetTruthValueFromObj): New routine. * generic/tclExecute.c: Updated callers to call new routine. * generic/tclBasic.c: Updated callers to call new routine. * generic/tclCompCmds.c: Updated callers to call new routine. * generic/tclDictObj.c: Updated callers to call new routine. * tests/obj.test: Corrected bad tests that actually expected values like "47" and "0xAC" to be accepted as booleans. * generic/tclLiteral.c: Disabled the code that forces some literals into the "int" Tcl_ObjType during registration. We can re-enable it if this change causes trouble, but it seems more sensible to let Tcl's "on-demand" shimmering rule, and not try to pre-guess things. 2005-04-20 Kevin B. Kenny [kennykb-numerics-branch] * doc/expr.n: * doc/mathfunc.n (new file): Revised documentation for TIP 232 2005-04-20 Don Porter * generic/tclGet.c (Tcl_GetInt): Corrected error that did not * generic/tclObj.c (Tcl_GetIntFromObj): permit 0x80000000 to be recognized as an integer on TCL_WIDE_INT_IS_LONG systems [Bug 1090869]. 2005-04-20 Kevin B. Kenny * generic/tclFileName.c: Silenced a compiler warning about '/*' within a comment. 2005-04-19 Don Porter * generic/tclBasic.c: Added unsupported command * generic/tclCmdAH.c: [::tcl::unsupported::EncodingDirs] to permit * generic/tclInt.h: query/set of the encoding search path at * generic/tclInterp.c: the script level. Updated init.tcl to make * library/init.tcl: use of the new command. Also updated several coding practices in init.tcl ("eq" for [string equal], etc.) 2005-04-19 Kevin B. Kenny * library/clock.tcl (Initialize): Put initialization code into a proc to avoid inadvertently clobbering global variables. [Bug 1185933] * tests/clock.test (clock-48.1): Added regression test for the above bug. Thanks to Ulrich Ring for reporting this bug. 2005-04-16 Miguel Sofer * generic/Var.c (Tcl_ArrayObjCmd - ARRAY_NAMES): fix Tcl_Obj leak. [Bug 1084111] 2005-04-16 Zoran Vasiljevic * generic/tclIOUtil.c: force clenaup of the interp result in TclLoadFile(). Some implementations of TclpFindSymbol() will seed the interp result with error message when unable to find the requested symbol (this is not considered to be an error). Set of changes correcting huge memory waste (not a leak) when a thread exits. This has been introduced in 8.4.7 within an attempt to correctly cleanup after ourselves when Tcl library is being unloaded with the Tcl_Finalize() call. This fixes the [Bug 1178445] * generic/tclInt.h: added prototypes for TclpFreeAllocCache() and TclFreeAllocCache() * generic/tclThreadAlloc.c: modified TclFinalizeThreadAlloc() to explicitly call TclpFreeAllocCache with the NULL-ptr as argument signalling cleanup of private tsd key used only by the threading allocator. * unix/tclUnixThrd.c: fixed TclpFreeAllocCache() to recognize when being called with NULL argument. This is a signal for it to clean up the tsd key associated with the threading allocator. * win/tclWinThrd.c: renamed TclWinFreeAllocCache to TclpFreeAllocCache and fixed to recognize when being called with NULL argument. This is a signal for it to clean up the tsd key associated with the threading allocator. 2005-04-13 Don Porter * tests/unixInit.test: Disabled obsolete tests and removed code * tests/encoding.test: that supported them. * generic/tclInterp.c: * library/init.tcl: Use auto-loading to bring in Tcl Module support * library/tclIndex: as needed. This reduces startup time by * library/tm.tcl: delaying this initialization to a later time. 2005-04-15 Miguel Sofer * generic/tclExecute.c: missing semicolons caused failure to compile with TCL_COMPILE_DEBUG. 2005-04-13 David Gravereaux * generic/tclIO.c (Tcl_SetChannelBufferSize): Lowest size limit * tests/io.test: changed from ten bytes to one byte. Need for * tests/iogt.test: this change was proven by Ross Cartlidge where [read stdin 1] was grabbing 10 bytes followed by starting a child process that was intended to continue reading from stdin. Even with -buffersize set to one, nine chars were getting lost by the buffersize over reading for the native read() caused by [read]. 2005-04-13 Don Porter * unix/tclUnixInit.c (TclpGetEncodingNameFromEnvironment): Reversed order of verifying candidate [encoding system] value, checking against a table in memory first before calling Tcl_GetEncoding and potentially scanning through the filesystem. Also ordered the table so that a binary search could be used within it. Improves startup time a bit more on some systems. 2005-04-13 Kevin B. Kenny * library/clock.n: Added a missing '--' on several [switch] commands to improve performance of [clock format] and related operations. [FRQ 1182459] 2005-04-13 Donal K. Fellows * doc/fcopy.n: Improved documentation on copying binary files, added an example and mentioned the use of [file copy]. * doc/fconfigure.n: Improved documentation of -encoding binary option. This is all following comments from Steve Manning on comp.lang.tcl that the current documentation was not clear. 2005-04-13 Miguel Sofer * generic/tclCompile.c:Commented out the functions TclPrintInstruction(), TclPrintObject() and TclPrintSource() when not debugging the compiler, as they are never called in that case. 2005-04-12 Don Porter * generic/tclInterp.c: Corrected bad syntax of Tcl_Panic() call. * generic/tclUtil.c (TclGetProcessGlobalValue): More robust handling of bad TclInitProcessGlobalValueProc behavior; an immediate panic rather than a mysterious crash later. * generic/tclEncoding.c: Several changes to the way the encodingFileMap cache is maintained. Previously, it was attempted to keep the file map filled and up to date with changes in the encoding search path. This contributed to slow startup times since it required an expensive "glob" operation to fill the cache. Now the validity of items in the cache are checked at the time they are used, so the cache is permitted to fall out of sync with the encoding search path. Only [encoding names] and Tcl_GetEncodingNames() now pay the full expense. [Bug 1177363] 2005-04-12 Kevin B. Kenny * compat/strstr.c: Added default definition of NULL to accommodate building on systems with badly broken headers. [Bug 1175161] 2005-04-11 Donal K. Fellows * tools/tclZIC.tcl: Rewrote to take advantage of more features of Tcl 8.5 (on which it was dependent anyway). Also added a [package require] line to formalize the relationship. 2005-04-11 Kevin Kenny [kennykb-numerics-branch] Merged with HEAD. Updated to libtommath 0.35. * generic/tclBasic.c: Attempted to repeat changes that applied to tclExecute.c in Miguel Sofer's commit of 2005-04-01, together with (possibly) a few more uses of his new object creation macros. Also plugged a memory leak in TclObjInvoke. [Bug 1180368] 2005-04-10 Kevin Kenny * library/tzdata/America/Montevideo: * library/tzdata/Asia/Almaty: * library/tzdata/Asia/Aqtau: * library/tzdata/Asia/Aqtobe: * library/tzdata/Asia/Baku: * library/tzdata/Asia/Jerusalem: * library/tzdata/Asia/Oral: * library/tzdata/Asia/Qyzylorda: * library/tzdata/Indian/Chagos: * library/tzdata/Indian/Cocos: Olson's tzdata2005h 2005-04-10 Don Porter * generic/tclBasic.c (TclObjInvoke): Plug memory leak. [Bug 1180368] 2005-04-09 Miguel Sofer * generic/tclExecute.c: fix possible leak of expansion Tcl_Objs 2005-04-09 Daniel Steffen * macosx/README: updated requirements for OS & developer tool versions and other small fixes/cleanup. * generic/tclListObj.c (Tcl_ListObjIndex): added missing NULL return when getting index from an empty list. * unix/tcl.m4 (Darwin): added -single_module linker flag to TCL_SHLIB_LD_EXTRAS and TK_SHLIB_LD_EXTRAS. * unix/configure: autoconf-2.59 2005-04-08 Don Porter * generic/tclInt.h (TclGetEncodingFromObj): New function to * generic/tclEncoding.c (TclGetEncodingFromObj): retrieve a Tcl_Encoding value, as well as cache it in the internal rep of a new "encoding" Tcl_ObjType. * generic/tclCmdAH.c (Tcl_EncodingObjCmd): Updated to call new function so that Tcl_Encoding's used by [encoding convert*] routines are not freed too quickly. [Bug 1077262] 2005-04-08 Donal K. Fellows * generic/tclCompCmds.c (TclCompileSwitchCmd): Rewritten to be able to handle the other form of [switch] and generate slightly simpler (but longer) code. 2005-04-06 Donal K. Fellows * doc/upvar.n, doc/unset.n, doc/tell.n, doc/tclvars.n, doc/subst.n: * doc/seek.n, doc/scan.n, doc/regsub.n, doc/registry.n, doc/regexp.n: * doc/read.n, doc/puts.n, doc/pkgMkIndex.n, doc/open.n, doc/lreplace.n: * doc/lrange.n, doc/load.n, doc/llength.n, doc/linsert.n, doc/lindex.n: * doc/lappend.n, doc/info.n, doc/gets.n, doc/format.n, doc/flush.n: * doc/fileevent.n, doc/file.n, doc/fblocked.n, doc/close.n: * doc/array.n, doc/Utf.3, doc/TraceVar.3, doc/StrMatch.3, doc/RegExp.3: * doc/PrintDbl.3, doc/OpenTcp.3, doc/OpenFileChnl.3, doc/Object.3: * doc/Notifier.3, doc/LinkVar.3, doc/IntObj.3, doc/Interp.3: * doc/GetOpnFl.3, doc/GetIndex.3, doc/Eval.3, doc/CrtMathFnc.3: * doc/CrtFileHdlr.3, doc/CrtCommand.3, doc/CrtChannel.3: * doc/Backslash.3: Purge old .VS/.VE macro instances. * tools/man2html2.tcl (IPmacro): Rewrote to understand what .IP really is (.IP and .TP are really just two ways of doing the same thing). Change below made this relevant. * doc/re_syntax.n: Change some uses of .TP to .IP to work around bugs in various *roff implementations. Also reworded the atom descriptions slightly. 2005-04-05 Don Porter * generic/tclExecute.c (ExprSrandFunc): Replaced incursions into the * generic/tclUtil.c (TclGetIntForIndex): intreps of numeric types with simpler calls of Tcl_GetIntFromObj and Tcl_GetLongFromObj, now that those routines are better behaved wrt shimmering. [Patch 1177219] 2005-04-05 Miguel Sofer * generic/tclInt.h: * generic/tclObj.c: Change in TclDecrRefCount and TclFreeObj, to speed up the freeing of simple Tcl_Obj [Patch 1174551] 2005-04-04 Miguel Sofer * generic/tclExecute.c: small opts in obj handling 2005-04-02 Miguel Sofer * generic/tclVar.c: converted a few function calls to macros. 2005-04-01 Miguel Sofer * doc/ListObj.3: * generic/tclBasic.c: * generic/tclCmdIL.c: * generic/tclConfig.c: * generic/tclExecute.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclListObj.c: * generic/tclStubInit.c: * generic/tclVar.c: Changed the internal representation of lists to (a) reduce the malloc/free calls at list creation (from 2 to 1), (b) reduce the cost of handling empty lists (we now never create a list internal rep for them), (c) allow refcounting of the list internal rep. The latter permits insuring that the pointers returned by Tcl_ListObjGetElements remain valid even if the object shimmers away from its original list type. This is [Patch 1158008] * generic/tclExecute.c: * generic/tclInt.h: * generic/tclObj.c: * generic/tclStringObj.c: (1) defined new internal macros for creating and setting frequently used obj types (int,long, wideInt, double, string). Changed TEBC to use eg 'TclNewIntObj(objPtr, i)' to avoid the function call in 'objPtr = Tcl_NewIntObj(i)' (2) ExecEnv now stores two Tcl_Obj* pointing to the constants "0" and "1", for use by TEBC. (3) slight reduction in cost of INST_START_CMD 2005-03-31 Miguel Sofer * generic/tclExecute.c (INST_JUMP_TRUE/FALSE): replaced "test and branch" with "compute index into table" 2005-03-30 Donal K. Fellows * doc/FileSystem.3: Defined loadHandle argument. [Bug 1172401] 2005-03-29 Jeff Hobbs * win/tcl.m4, win/configure: do not require cygpath in macros to allow msys alone as an alternative. 2005-03-24 Don Porter * generic/tclCompile.h: Move the TclInterpReady() declaration from * generic/tclInt.h: tclCompile.h to tclInt.h. Should have been done as part of the 1115904 bug fix on 2005-03-18. * generic/tclThreadTest.c: Stop providing the phony package "Thread 1.0" when the [::testthread] command is defined. It's never used by anything, and conflicts with loading the real "Thread" package. 2005-03-18 Don Porter * generic/tclCompCmds.c (TclCompileIncrCmd): Corrected checks for immediate operand usage to permit leading space and sign characters. Restores more efficient bytecode for [incr x -1] that got lost in the CONST string reforms of Tcl 8.4. [Bug 1165671] * generic/tclBasic.c (Tcl_EvalEx): Restored recursion limit * generic/tclParse.c (TclSubstTokens): testing in nested command * tests/basic.test (basic-46.4): substitutions within direct * tests/parse.test (parse-19.*): script evaluation (Tcl_EvalEx) that got lost in the parser reforms of Tcl 8.1. Added tests for correct behavior. [Bug 1115904] 2005-03-15 Vince Darley * generic/tclFileName.c: * win/tclWinFile.c: * tests/winFCMd.test: fix to 'file pathtype' and 'file norm' failures on reserved filenames like 'COM1:', etc. 2005-03-15 Pat Thoyts * unix/tcl.m4: Updated the OpenBSD configuration and regenerated * unix/configure: the configure script. 2005-03-15 Kevin B. Kenny [kennykb-numerics-branch] Merged with HEAD. * generic/tclBasic.c (many): * generic/tclCompExpr.c (CompileMathFuncCall): * generic/tclCompile.h: * generic/tclExecute.c (many): * generic/tclParseExpr.c (ParsePrimaryExpr): * tests/compExpr-old.test: * tests/compExpr.test: * tests/compile.test: * tests/expr-old.test: * tests/expr.test: * tests/for.test: * tests/parseExpr.test: Initial implementation of TIP #232. * generic/tclObj.c (Tcl_DbNewBignumObj): Fixed typo that broke --enable-symbols=mem build * tests/binary.test (binary-40.3, binary-40.6): Corrected tests to allow NaN(7ffffffffffff). 2005-03-14 Miguel Sofer * generic/tclExecute.c: fixed INST_PUSH1's debugging code (wrong obj ref passed to TRACE_WITH_OBJ). 2005-03-14 Miguel Sofer * generic/tclCompile.c: fixed INST_RETURN's stack effect in tclInstructionTable (-1 instead of -2) 2005-03-10 Miguel Sofer * generic/tclCompCmds.c: removed debugging line 2005-03-10 Don Porter * generic/tclTrace.c (TclCheckInterpTraces): Corrected mistaken cast of ClientData to (TraceCommandInfo *) when not warranted. Thanks to Yuri Victorovich for the report. [Bug 1153871] * generic/tcl.h: Moved flag values TCL_TRACE_ENTER_EXEC and * generic/tclInt.h: TCL_TRACE_LEAVE_EXEC from public interface into private. Should be used only by internal workings of execution traces. 2005-03-09 Kevin B. Kenny [kennykb-numerics-branch] Merged from HEAD. * doc/PrintDbl.3: * doc/tclVars.n: Documented new semantics for tcl_precision. * generic/tclExecute.c (Tcl_ExecuteByteCode): Removed the check for division-by-zero on IEEE-754 machines. * generic/tclUtil.c (Tcl_PrintDouble): Corrected bug where numbers in the range [1e-4 .. 1.) were printed incorrectly. * tests/compExpr-old.test (compExpr-old-11.13): Revised test case for division by zero. * tests/expr-old.test (expr-34.11, expr-34.12): Revised test cases for overflow in pow() to deal with infinities. * tests/expr.test (expr-11.13, expr-29.1, expr-29.2): Revised test case for division by zero and for underflow on input conversions. * tests/parseExpr.test (parseExpr-16.11): Revised test case for overflow on input conversion. * tests/string.test (string-6.38 deleted): Removed test case for underflow on input conversion, which is no longer an error. * tests/util.test (util-10.*): Added test case for the bug in tclUtil.c 2005-03-08 Jeff Hobbs * win/makefile.vc: clarify necessary defined vars that can come from MSVC or the Platform SDK. 2005-03-07 Donal K. Fellows * doc/string.n: Minor typo. [Bug 1158247] 2005-03-07 Miguel Sofer * generic/tclExecute.c: new peephole optimisation for INST_PUSH1; fixed the peephole opt in INST_POP so that it is not used when TCL_COMPILE_DEBUG is defined. 2005-03-04 Kevin B. Kenny [kennykb-numerics-branch] * generic/tclCmdMZ.c: Changed [scan] to treat out-of-range floating point values as infinities and zeroes. * generic/tclExecute.c: Changed [expr] to be permissive about infinities, allowing them to propagate. * generic/tclGet.c: Changed Tcl_GetDouble to be permissive about over/underflow. * generic/tclObj.c: Changed SetDoubleFromAny to be permissive about over/underflow. * generic/tclParseExpr.c: Made [expr] permissive about input numbers out of range. 2005-03-03 Kevin B. Kenny [kennykb-numerics-branch] * generic/tclInt.h: * generic/tclStrToD.c (Tcl_DoubleDigits, TclFormatNaN): * generic/tclUtil.c (Tcl_PrintDouble): Changed the signature of TclDoubleDigits so that it accepts a pointer to the signum of the argument, and returns the signum via that pointer. Added very hacky code to handle IEEE signed zeroes in Tcl_DoubleDigits. (It can't be done other than as a hack until C9x; C89 simply doesn't deal with the concept of -0.0). Added output conversion of tagged NaN values. * generic/tclBinary.c (FormatNumber): Changed to allow [binary format] to handle NaN. * tests/binary.test (binary-60.1): Added a quick-n-dirty test to make sure that NaN's can be scanned and formatted. * generic/tclParseExpr.c (GetLexeme, ParseMaxDoubleLength): Modified so that tagged NaN (e.g., NaN(DEADBEEF)) can be recognized. 2005-03-02 Kevin B. Kenny [kennykb-numerics-branch] Merged with HEAD as of 2005-02-23. * generic/tclExecute.c: Broadened test for NaN to work on Windows. * generic/tclInt.h: * generic/tclStrToD.c (Tcl_DoubleDigits): * generic/tclUtil.c (Tcl_PrintDouble, TclPrecTraceProc): Added Tcl_DoubleDigits to format 'double' numbers with the minimum number of significant digits to yield correct rounding. Modified tcl_precision to accept 0 as a precision (meaning "minimum digits"), and made 0 the default. [TIP #132] * generic/tclObj.c: Made NaN's throw an error in Tcl_GetDoubleFromObj. * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: Added libtommath/bn_mp_init_set.c to the build. * libtommath/tommath.h (mp_iseven): Fixed a bug that caused zero to test 'odd'. * generic/tommath.h: Regenerated. * tests/binary.test: * tests/expr-old.test: * tests/expr.test: * tests/scan.test: Corrected a number of tests that depended on tcl_precision, and removed the {eformat} condition from tests that no longer require it. * tests/util.test: Corrected a number of tests that depended on tcl_precision, and removed the {eformat} condition from tests that no longer require it. Added a series of tests for correct rounding in Tcl_PrintDouble. [TIP #132]. 2005-03-01 David N. Welton * doc/CrtSlave.3: Changed to Tcl_Object to Tcl_Obj in the man page. 2005-02-24 Don Porter * library/tcltest/tcltest.tcl: Better use of [glob -types] to avoid * tests/tcltest.test: failed attempts to [source] a directory, and similar matters. Thanks to "mpettigr". [Bug 1119798] * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.8 * unix/Makefile.in: * win/Makefile.in: 2005-02-23 Donal K. Fellows * doc/CrtChannel.3 (THREADACTIONPROC): Formatting fix. [Bug 1149605] 2005-02-17 Jeff Hobbs * win/tclWinFCmd.c (TraverseWinTree): use wcslen on wchar, not Tcl_UniCharLen. 2005-02-16 Miguel Sofer * doc/variable.n: fix for [Bug 1124160], variables are detected by [info vars] but not by [info locals]. 2005-02-11 Jeff Hobbs * unix/Makefile.in: remove SHLIB_LD_FLAGS (only for AIX, inlined into * unix/tcl.m4: SHLIB_LD). Combine AIX-* and AIX-5 branches in * unix/configure: SC_CONFIG_CFLAGS. Correct gcc builds for AIX-4+ and HP-UX-11. autoconf-2.59 gen'd. 2005-02-11 Miguel Sofer * tests/basic.test (basic-26.3): new test 2005-02-10 Miguel Sofer * generic/tclBasic.c (Tcl_EvalObjEx): * tests/basic.test (basic-26.2): preserve the arguments passed to TEOV in the pure-list branch, in case the list shimmers away. Fix for [Bug 1119369], reported by Peter MacDonald. 2005-02-10 Vince Darley * generic/tclFileName.c: fix for test failures introduced on 2005-01-17 [Bug 1119092] 2005-02-10 Donal K. Fellows * doc/binary.n: Made the documentation of sign bit masking and [binary scan] consistent. [Bug 1117017] 2005-02-08 David N. Welton * doc/CrtChannel.3: Typo: return->returns. 2005-02-06 Kevin B. Kenny [kennykb-numerics-branch] * generic/tclStrToD.c (TclStrToD, SafeLdExp): Added code to manage the FPU precision on gcc+x86. Enabled fast conversion of floats with small exponents now that precision is correct. * tests/expr.test: Corrected test for the smallest representible value to the right IEEE values. 2005-02-06 David N. Welton * doc/Thread.3: One-word grammar fix. 2005-02-05 David N. Welton * doc/Thread.3: Fixed sentence describing flags for Tcl_CreateThread. * doc/FileSystem.3: Cleaned up typo in Tcl_FSNewNativePath documentation. * generic/tclPathObj.c: Cleaned up typo in comment. 2005-02-03 Kevin B. Kenny [kennykb-numerics-branch] * generic/tclStrToD.c (TclStrToD, RefineResult, SafeLdExp): Added code to ensure that 'ldexp' is never called with a value that will underflow * tests/expr.test: Added tests for the smallest representible value, and rounding between it and zero. (The tests reflect current behaviour; plan is to change the specification of Tcl so that input conversion of doubles underflows silently.) 2005-02-02 Mo DeJong * generic/tclProc.c (TclInitCompiledLocals): Add check for type of the framePtr->procPtr->bodyPtr passed to TclInitCompiledLocals and panic if it is not the correct type. If the body of the proc is not of the compiled byte code type then the code will crash. This was discovered while tracking down a crash in Itcl, that crash is fixed by Itcl patch 1115085. 2005-02-01 Kevin B. Kenny [kennykb-numerics-branch] Merged with HEAD as of today. * generic/tclInt.decls: Changed numbers of new stubs to resolve a conflict. * generic/tclInt.h: Added new TclStrToD routine that replaces the native 'strtod' throughout Tcl. * generic/tclCmdMZ (Tcl_StringObjCmd): * generic/tclGet.c (Tcl_GetDouble): * generic/tclObj.c (SetBooleanFromAny, SetDoubleFromAny): * generic/tclParseExpr.c (GetLexeme): * generic/tclScan.c (Tcl_ScanObjCmd): Replaced all uses of the native 'strtod' with a TclStrToD routine that performs correct rounding and handles denormals. * generic/tclStrToD.c: (new file) New scanning function for extracting 'double' from a string that rounds correctly, and handles denormals and infinities. * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: Added tclStrToD.c and the tommath routines that support it. These changes represent a partial implementation of TIP #132. Output conversion of floating point numbers, and proper handling of infinities within expressions, still need to be addressed. 2005-02-01 Don Porter * generic/tclExecute.c (TclCompEvalObj): Removed stray statement left behind in prior code reorganization. 2005-01-31 Don Porter * unix/configure: autoconf-2.57 2005-01-30 Joe English * unix/configure.in: Restored two double-evals that were removed in the DBGX purge; these are still needed on some platforms to account for TCL_TRIM_DOTS. [Bug 1112654] * unix/configure: NOT REGENERATED: only have autoconf 2.59 here, need to find someone with autoconf 2.57. 2005-01-28 Jeff Hobbs * unix/configure, unix/tcl.m4: add solaris 64-bit gcc build support. [Bug 1021871] 2005-01-28 Donal K. Fellows * tests/expr-old.test (expr-old-37.2): Added test for [Bug 1109484] 2005-01-27 Jeff Hobbs * generic/tclBasic.c (Tcl_ExprBoolean, Tcl_ExprDouble) (Tcl_ExprLong): Fix to recognize Tcl_WideInt type. [Bug 1109484] 2005-01-26 Andreas Kupries TIP#218 IMPLEMENTATION * generic/tclDecls.h: Regenerated from tcl.decls. * generic/tclStubInit.c: * doc/CrtChannel.3: Documentation of extended API, * generic/tcl.decls: extended testsuite, and * generic/tcl.h: implementation. Removal of old * generic/tclIO.c: driver-specific TclpCut/Splice * generic/tclInt.h: functions. Replaced with generic * tests/io.test: thread-action calls through the * unix/tclUnixChan.c: new hooks. Update of all builtin * unix/tclUnixPipe.c: channel drivers to version 4. * unix/tclUnixSock.c: Windows drivers extended to * win/tclWinChan.c: manage thread state in a thread * win/tclWinConsole.c: action handler. * win/tclWinPipe.c: * win/tclWinSerial.c: * win/tclWinSock.c: 2005-01-25 Don Porter * library/auto.tcl: Updated [auto_reset] to clear auto-loaded commands in namespaces other than :: and to clear auto-loaded commands that do not happen to be procs. [Bug 1101670] ***POTENTIAL INCOMPATIBILITY*** 2005-01-25 Daniel Steffen * unix/tcl.m4 (Darwin): fixed bug with static build linking to dynamic library in /usr/lib etc instead of linking to static library earlier in search path. [Bug 956908] Removed obsolete references to Rhapsody. * unix/configure: autoconf-2.57 2005-01-21 Andreas Kupries * generic/tclStubInit.c: Regenerated the stubs support code from the * generic/tclDecls.h: modified tcl.decls (TIP #233, see below). * doc/GetTime.3: Implemented TIP #233, i.e. the * generic/tcl.decls: 'Virtualization of Tcl's Sense of Time'. * generic/tcl.h: Declared, implemented, and documented the * generic/tclInt.h: specified new API functions. Moved the * unix/tclUnixEvent.c: native (OS) access to time information * unix/tclUnixNotfy.c: into standard handler functions. Inserted * unix/tclUnixTime.c: hooks calling on the handlers where native * win/tclWinNotify.c: access was done before, and where scaling * win/tclWinTime.c: between domains (real/virtual) is required. 2005-01-21 Andreas Kupries * generic/tclThread.c: Typo police. Fixed some nits * generic/tclCmdAH.c: in header comments of functions. * generic/tclBasic.c: (Missing --). * generic/tclFileName.c: 2005-01-21 Donal K. Fellows * doc/FileSystem.3: Add missing ARGUMENTS section definitions for arguments to Tcl_FSLink. [Bug 1106272] 2005-01-21 Kevin B. Kenny [kennykb-numerics-branch] * unix/Makefile.in: Updated Makefile to build libtommath on Unix as well as Windows. [Bug 1106865] * generic/tclTestObj.c (TestbignumobjCmd): Silenced a compiler warning about a mismatched 'const'. 2005-01-20 Kevin B. Kenny [kennykb-numerics-branch] Development checkpoint. * compat/strtoll.c: Reverted to HEAD. * compat/strtoull.c: * doc/Ensemble.3: * generic/tclBasic.c: * generic/tclCmdIL.c: * generic/tclNamesp.c: * generic/tclPathObj.c: * generic/tclPort.h: * unix/configure: * unix/configure.in: * unix/tcl.m4: * win/configure: * win/configure.in: * win/rules.vc: * win/tcl.m4: * generic/tcl.h: Added declarations for bignum types, and for a 'bignumValue' in the Tcl_Obj structure. * generic/tclInt.h: Added declarations of interface procedures for memory allocation in libtommath. * generic/tcl.decls: Added new interface to bignum objects. * generic/tclInt.decls: Added internal stubs for bignum routines used by the test code in tclTestObj.c. * generic/tclDecls/h: Regen. * generic/tclIntDecls.h: * generic/tclStubInit.h: * tools/fix_tommath_h.tcl: (New file) Script to edit libtommath/tommath.h and produce generic/tommath.h so that storage classes, allocation routines, and data types conform to Tcl's conventions. * generic/tommath.h: (New file) Generated by the above. * generic/tclTomMath.h: (New file) Additional declarations to be included in tommath.h when building Tcl. * generic/tclTomMathInterface.c: (New file) Small 'glue' routines adapting tommath's API to Tcl. * libtommath/bn_fast_s_mp_mul_digs.c: * libtommath/bn_mp_mul_d.c: * libtommath/bn_mp_read_radix.c: * libtommath/tommath.h: Applied suggested changes from Tom St Denis that correct an off-by-one error in single-digit multiplication (leading to a pointer smash if uncorrected) and change the string argument to 'mp_read_radix' from 'char*' to 'const char*'. * libtommath/bn_mp_radix_size.c: Local patch to ensure that sufficient memory is requested even if the number has a single digit. * libtommath/bn_mp_read_radix.c: Local patch to return MP_VAL if the input string contains an invalid character. * generic/tclObj.c: Added accessor functions for bignums. * generic/tclTestObj.c: Added a 'testbignumobj' command to exercise the accessor functions for bignums. * win/Makefile.in: Added rules for making libtommath. 2005-01-19 Donal K. Fellows TIP#235 IMPLEMENTATION * doc/Ensemble.3: Documentation for the new public API. * generic/tclNamesp.c (Tcl_CreateEnsemble,...): Rename of * generic/tcl.decls: existing API into TIPped form. 2005-01-19 Mo DeJong * win/tclWinChan.c (FileCloseProc): Invoke TclpCutFileChannel() to remove a FileInfo from the thread local list before deallocating it. This should have been done via an earlier call to Tcl_CutChannel, but I was running into a crash in the next call to Tcl_CutChannel during the I/O finalization stage. 2005-01-18 Kevin Kenny * library/tzdata/GMT+0: * library/tzdata/GMT-0: * library/tzdata/GMT0: * library/tzdata/Greenwich: * library/tzdata/Navajo: * library/tzdata/Universal: * library/tzdata/Zulu: * library/tzdata/America/Asuncion: * library/tzdata/America/Rosario: * library/tzdata/Asia/Jerusalem: * library/tzdata/Brazil/Acre: Routine update per Olson's tzdata2005c. Removed links to links (Greenwich in several aliases; Navajo; Acre). Updated Paraguayan DST rules and "best guess" at this year's Israeli rules. 2005-01-17 Vince Darley * generic/tclFileName.c: fix for glob failure on Windows shares [Bug 1100542]. * doc/pkgMkIndex.n: added documentation that 'pkg_mkIndex -lazy' is not a good idea. [Bug 1101678] 2005-01-14 Donal K. Fellows * tests/compile.test (compile-17.1): Document known issue with binding time of compiled command interpretations in [expr]. * generic/tclIOUtil.c (TclFSFileAttrIndex): New helper function so that we don't need to hard-code attribute indexes. [Bug 1100671] 2005-01-13 Donal K. Fellows * doc/string.n: Removed the term 'set' from the documentation of the [string trim] commands, as it caused confusion. 2005-01-12 Donal K. Fellows * unix/tcl.m4 (SC_PATH_{TCL,TK}CONFIG): Added code to detect the case when the --with-tcl/--with-tk arguments point to the config scripts themselves and not their directory. If this is the case, they now complain but keep working. [FRQ 951247] * unix/configure: autoconf-2.57 2005-01-10 Joe English * unix/Makefile.in, unix/configure.in, unix/tcl.m4, * unix/tclConfig.sh.in, unix/dltest/Makefile.in: Remove ${DBGX}, ${TCL_DBGX} from Tcl build system [Patch 1081595]. * unix/configure: regenerated 2005-01-10 Donal K. Fellows * unix/tclUnixFCmd.c (TclUnixCopyFile): Convert u_int to unsigned to make clashes with types in standard C headers less of a problem. [Bug 1098829] 2005-01-09 Joe English * unix/tclUnixThrd.c, unix/tclUnixPort.h: Remove readdir_r() and related #ifdeffery (see [Bug 1095909]). * unix/tcl.m4, unix/tclConfig.h.in: Don't check for HAVE_READDIR_R. * unix/configure: Regenerated. 2005-01-06 Donal K. Fellows * library/http/http.tcl (http::mapReply): Significant performance enhancement by using [string map] instead of [regsub]/[subst], and update version requirement to Tcl8.4. [Bug 1020491] 2005-01-05 Donal K. Fellows * doc/lsearch.n, doc/re_syntax.n: Convert to other form of emacs mode control comment to prevent problems with old versions of man. [Bug 1085127] 2005-01-05 Pat Thoyts * tests/winDde.test: Fixed broken test result. 2005-01-05 Donal K. Fellows * generic/tclInt.h, generic/tclPort.h: Move the #include of tclConfig.h *first* before any reference to tcl.h so that the build configuration is loaded before the first reference to any system headers. Issue reported by Art Haas on tcl-core. 2005-01-04 Don Porter * tests/fCmd.test (fCmd-18.10): Added notNetworkFilesystem constraint. [Bug 456665] ****************************************************************** *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" *** *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ****************************************************************** tcl8.6.14/ChangeLog.20070000644000175000017500000067232614554262142014023 0ustar sergeisergei2007-12-31 Donal K. Fellows * doc/dict.n: Clarified meaning of dictionary values following discussion on comp.lang.tcl. 2007-12-26 Miguel Sofer * generic/tclCmdIL.c: More [lsort] data handling streamlines. The function MergeSort is gone, essentially inlined into Tcl_LsortObjCmd. It is not a straight inlining, two loops over all lists elements where merged in the process: the linked list elements are now built and merged into the temporary sublists in the same pass. 2007-12-25 Miguel Sofer * generic/tclCmdIL.c: More [lsort] data handling streamlines. Extra mem reqs of latest patches removed, restored to previous mem profile. Improved -unique handling, now eliminating repeated elems immediately instead of marking them to avoid reinsertion at the end. 2007-12-23 Jeff Hobbs * generic/tclCompCmds.c (TclCompileRegexpCmd): TCL_REG_NOSUB cannot * tests/regexp.test (regexp-22.2): be used because it * tests/regexpComp.test: [Bug 1857126] disallows backrefs. 2007-12-21 Miguel Sofer * generic/tclCmdIL.c: Speed patch for lsort. [Patch 1856994] 2007-12-21 Miguel Sofer * generic/tclCmdIL.c (Tcl_LsortObjCmd, Tcl_LsearchObjCmd): Avoid calling SelectObjFromSublist when there are no sublists. 2007-12-21 Miguel Sofer * generic/tclCmdIL.c (Tcl_LsortObjCmd): Preallocate a listObj of sufficient length for the sorted list instead of growing it. Second commit replaces calls to Tcl_ListObjAppenElement with direct access to the internal rep. 2007-12-19 Don Porter *** 8.5.0 TAGGED FOR RELEASE *** * changes: Updated for 8.5.0 release. 2007-12-19 Jeff Hobbs * generic/tclCompCmds.c (TclCompileSwitchCmd): update switch -regexp * tests/switch.test-14.*: compilation to pass the cflags to INST_REGEXP (changed on 12-07). Added tests for switch -regexp compilation (need more). [Bug 1854399] 2007-12-18 Don Porter * changes: Updated for 8.5.0 release. 2007-12-18 Donal K. Fellows * generic/regguts.h, generic/regc_color.c, generic/regc_nfa.c: Fixes for problems created when processing regular expressions that generate very large automata. An enormous number of thanks to Will Drewry , Tavis Ormandy , and Tom Lane from the Postgresql crowd for their help in tracking these problems down. [Bug 1810264] 2007-12-17 Don Porter * changes: Updated for 8.5.0 release. 2007-12-17 Miguel Sofer * generic/tclAlloc.c: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclThreadAlloc.c: Fix alignment for memory returned by TclStackAlloc; insure that all memory allocators align to 16-byte boundaries on 64 bit platforms [Bug 1851832, 1851524] 2007-12-14 Jeff Hobbs * generic/tclIOUtil.c (FsAddMountsToGlobResult): fix the tail conversion of vfs mounts. [Bug 1602539] * win/README: updated notes 2007-12-14 Pat Thoyts * tests/winFile.test: Fixed tests for win2k with long machine name 2007-12-14 Pat Thoyts * win/nmakehlp.c: Support compilation with MSVC9 for AMD64. * win/makefile.vc: 2007-12-13 Donal K. Fellows * doc/trace.n: Clarified documentation of enterstep and leavestep traces, including adding example. [Bug 614282, 1701540, 1755984] 2007-12-12 Don Porter * doc/IntObj.3: Update docs for the Tcl_GetBignumAndClearObj() -> Tcl_TakeBignumFromObj() revision [TIP 298]. Added docs for the Tcl_InitBignumFromDouble() routine. [Bug 1446971] * changes: Updated for 8.5.0 release. 2007-12-10 Jeff Hobbs * generic/tclUtil.c (TclReToGlob): reduce escapes in conversion when not necessary * generic/tclInt.decls: move TclByteArrayMatch and TclReToGlob * generic/tclIntDecls.h: to tclInt.h from stubs. * generic/tclStubInit.c: Add flags var to TclByteArrayMatch for * generic/tclInt.h: future extensibility * generic/tcl.h: define TCL_MATCH_EXACT doc for Tcl_StringCaseMatch. * doc/StrMatch.3: It is compatible with existing usage. * generic/tclExecute.c (INST_STR_MATCH): flag for TclByteArrayMatch * generic/tclUtil.c (TclByteArrayMatch, TclStringMatchObj): * generic/tclRegexp.c (Tcl_RegExpExecObj): * generic/tclCmdMZ.c (StringMatchCmd): Use TclStringMatchObj * tests/string.test (11.9.* 11.10.*): more tests 2007-12-10 Joe English * doc/string.n, doc/UniCharIsAlpha.3: Fix markup errors. * doc/CrtCommand.3, doc/CrtMathFnc.3, doc/FileSystem.3, * doc/GetStdChan.3, doc/OpenFileChnl.3, doc/SetChanErr.3, * doc/eval.n, doc/filename.n: Consistency: Move "KEYWORDS" section after "SEE ALSO". 2007-12-10 Daniel Steffen * tools/genStubs.tcl: fix numerous issues handling 'macosx', 'aqua' or 'x11' entries interleaved with 'unix' entries [Bug 1834288]; add genStubs::export command [Tk FR 1716117]; cleanup formatting. * generic/tcl.decls: use new genstubs 'export' command to * generic/tclInt.decls: mark exported symbols not in stubs * generic/tclTomMath.decls: table [Tk FR 1716117]; cleanup formatting. * generic/tclDecls.h: regen with new genStubs.tcl. * generic/tclIntDecls.h: [Bug 1834288] * generic/tclIntPlatDecls.h: * generic/tclPlatDecls.h: * generic/tclStubInit.c: 2007-12-09 Jeff Hobbs * tests/io.test, tests/chanio.test (io-73.1): Make sure to invalidate * generic/tclIO.c (SetChannelFromAny): internal rep only after validating channel rep. [Bug 1847044] 2007-12-08 Donal K. Fellows * doc/expr.n, doc/mathop.n: Improved the documentation of the operators. [Bug 1823622] * generic/tclBasic.c (builtInCmds): Corrected list of hidden and * doc/interp.n (SAFE INTERPRETERS): exposed commands so that the documentation and reality now match. [Bug 1662436] 2007-12-07 Jeff Hobbs * generic/tclExecute.c (TclExecuteByteCode INST_REGEXP): * generic/tclCompCmds.c (TclCompileRegexpCmd): Pass correct RE compile flags at compile time, and use TCL_REG_NOSUB. * generic/tclIOCmd.c (FinalizeIOCmdTSD, Tcl_PutsObjCmd): cache stdout channel object for [puts $str] calls. 2007-12-06 Don Porter * README: Remove mention of dead comp.lang.tcl.announce newsgroup. [Bug 1846433] * unix/README: Mention the stub library created by `make` and warn about the effect of embedded paths in the installed binaries. Thanks to Larry Virden. [Bug 1794084] * doc/AddErrInfo.3: Documentation for the new routines in TIP 270. * doc/Interp.3: * doc/StringObj.3: 2007-12-06 Don Porter * doc/namespace.n: Documentation for zero-argument form of [namespace import] (TIP 261) [Bug 1596416] 2007-12-06 Jeff Hobbs * generic/tclInt.h: add TclGetChannelFromObj decl (TclMatchIsTrivial): simplify TclMatchIsTrivial to remove ] check. 2007-12-06 Donal K. Fellows * generic/tclBasic.c (Tcl_CreateInterp): Simplify the setting up of * generic/tclIOCmd.c (TclInitChanCmd): the [chan] ensemble. This * library/init.tcl: gets rid of quite a bit of code and makes it possible to understand the whole with less effort. * generic/tclCompCmds.c (TclCompileEnsemble): Ensure that the right number of tokens are copied. [Bug 1845320] * generic/tclNamesp.c (TclMakeEnsemble): Added missing release of a DString. [Bug 1845397] 2007-12-05 Jeff Hobbs * generic/tclIO.h: Create Tcl_Obj for Tcl channels to reduce * generic/tclIO.c: overhead in lookup by Tcl_GetChannel. New * generic/tclIOCmd.c: TclGetChannelFromObj for internal use. * generic/tclIO.c (WriteBytes, WriteChars): add opt check to avoid EOL translation when not linebuffered or using lf. [Bug 1845092] 2007-12-05 Miguel Sofer * tests/stack.test: made the tests for stack overflow not care about which mechanism caused the error (interp's recursion limit or C-stack depth detector). 2007-12-05 Jeff Hobbs * win/configure, win/tcl.m4 (LIBS_GUI): mingw needs -lole32 -loleaut32 but not msvc for Tk's [send]. [Bug 1844749] 2007-12-05 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Prevent shimmering crash when -exact and -integer/-real are mixed. [Bug 1844789] 2007-12-03 Donal K. Fellows * unix/tclUnixChan.c (CreateSocketAddress): Add extra #ifdef-fery to make code compile on BSD 5. [Bug 1618235, again] 2007-12-03 Don Porter * library/tcltest/tcltest.tcl: Bump tcltest to version 2.3.0 so that * library/tcltest/pkgIndex.tcl: we release a stable tcltest with a * unix/Makefile.in: stable Tcl. * win/Makefile.in: 2007-12-03 Jeff Hobbs * win/configure, win/tcl.m4 (LIBS_GUI): remove ole32.lib oleaut32.lib 2007-12-03 Donal K. Fellows * generic/tclCompCmds.c (TclCompileSwitchCmd): Adjusted the [switch] * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): command so that when passed two arguments, no check for options are performed. This is OK since in the two-arg case, detecting an option would definitely lead to a syntax error. [Patch 1836519] 2007-11-29 Jeff Hobbs * win/makefile.vc: add ws2_32.lib to baselibs * win/configure, win/tcl.m4: add ws2_32.lib / -lws2_32 to build. * win/tclWinSock.c: remove dyn loading of winsock, assume that it is always available now. 2007-11-29 Don Porter * generic/tclWinSock.c (InitializeHostName): Correct error in buffer length tracking. After gethostname() writes into a buffer, convert only the written string to internal encoding, not the whole buffer. 2007-11-28 Don Porter * generic/tclConfig.c: Corrected failure of the [::foo::pkgconfig] command to clean up registered configuration data when the query command is deleted from the interp. [Bug 983501] * generic/tclNamesp.c (Tcl_SetEnsembleMappingDict): Added checks that the dict value passed in is in the format required to make the internals of ensembles work. [Bug 1436096] * generic/tclIO.c: Simplify test and improve accuracy of error message in latest changes. 2007-11-28 Pat Thoyts * generic/tclIO.c: -eofchar must support no eofchar. 2007-11-27 Miguel Sofer * generic/tclBasic.c: remove unneeded call in Tcl_CreateInterp, add comments. 2007-11-27 Don Porter * win/tclWinSock.c: Add mising encoding conversion of the [info hostname] value from the system encoding to Tcl's internal encoding. * doc/chan.n: "Fix" the limitation on channel -eofchar * doc/fconfigure.n: values to single byte characters by * generic/tclIO.c: documenting it and making it fail loudly. * tests/chan.test: Thanks to Stuart Cassoff for contributing the fix. [Bug 800753] 2007-11-26 Miguel Sofer * generic/tclBasic.c: * generic/tclInt.h: * unix/tclUnixInit.c: * unix/tclUnixThrd.c: Fix stack checking via workaround for bug in glibc's pthread_attr_get_np, patch from [Bug 1815573]. Many thanks to Sergei Golovan (aka Teo) for detecting the bug and helping diagnose and develop the fix. 2007-11-24 Donal K. Fellows * generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix bug in [dict append] compiler which caused strange stack corruption. [Bug 1837392] 2007-11-23 Andreas Kupries * generic/tclIORChan.c: Fixed a problem with reflected channels. 'chan postevent' is defined to work only from within the interpreter containing the handler command. Sensible, we want only handler commands to use it. It identifies the channel by handle. The channel moves to a different interpreter or thread. The interpreter containing the handler command doesn't know the channel any longer. 'chan postevent' fails, not finding the channel any longer. Uhm. Fixed by creating a second per-interpreter channel table, just for reflected channels, where each interpreter remembers for which reflected channels it has the handler command. This info does not move with the channel itself. The table is updated by 'chan create', and used by 'chan postevent'. * tests/ioCmd.test: Updated the testsuite. 2007-11-23 Jeff Hobbs * generic/tclVar.c (Tcl_ArrayObjCmd): handle the right data for * tests/var.test (var-14.2): [array names $var -glob $ptn] 2007-11-23 Donal K. Fellows * generic/tclCmdMZ.c (String*Cmd, TclInitStringCmd): Rebuilt [string] * generic/tclCompCmds.c (TclCompileString*Cmd): as an ensemble. 2007-11-22 Donal K. Fellows * generic/tclDictObj.c (Dict*Cmd,TclInitDictCmd): Rebuilt the [dict] * generic/tclCompCmds.c (TclCompileDict*Cmd): command as an ensemble. 2007-11-22 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_StringObjCmd): Rewrote the [string] and * generic/tclDictObj.c (Tcl_DictObjCmd): [dict] implementations to be ready for conversion to ensembles. * tests/string.test (string-12.22): Flag shimmering bug found in [string range]. 2007-11-21 Donal K. Fellows * generic/tclCompCmds.c (TclCompileEnsemble): Rewrote the ensemble compiler to remove many of the limitations. Can now compile scripts that use unique prefixes of subcommands, and which have mappings of a command to multiple words (provided the first is a compilable command of course). 2007-11-21 Donal K. Fellows * generic/tclNamesp.c (TclMakeEnsemble): Factor out the code to set up a core ensemble from a table of information about subcommands, ready for reuse within the core. * generic/various: Start to return more useful Error codes, currently mainly on assorted lookup failures. 2007-11-20 Donal K. Fellows * generic/tclDictObj.c: Changed the underlying implementation of the hash table used in dictionaries to additionally keep all entries in the hash table in a linked list, which is only ever added to at the end. This makes iteration over all entries in the dictionary in key insertion order a trivial operation, and so cleans up a great deal of complexity relating to dictionary representation and stability of iteration order. ***POTENTIAL INCOMPATIBILITY*** For any code that depended on the (strange) old iteration order. * generic/tclConfig.c (QueryConfigObjCmd): Correct usage of Tcl_WrongNumArgs. 2007-11-19 Don Porter *** 8.5b3 TAGGED FOR RELEASE *** * README: Bump version number to 8.5b3. * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf (2.59) * win/configure: * changes: Updated for 8.5b3 release. 2007-11-19 Kevin Kenny * library/tzdata/Africa/Cairo: * library/tzdata/America/Campo_Grande: * library/tzdata/America/Caracas: * library/tzdata/America/Cuiaba: * library/tzdata/America/Havana: * library/tzdata/America/Sao_Paulo: * library/tzdata/Asia/Damascus: * library/tzdata/Asia/Gaza: * library/tzdata/Asia/Tehran: Olson's tzdata2007i imported. 2007-11-18 Daniel Steffen * generic/tclExecute.c (TclExecuteByteCode:INST_EXIST_*): Fix read traces not firing on non-existent array elements. [Bug 1833522] 2007-11-16 Donal K. Fellows * generic/tclCmdIL.c (TclInitInfoCmd): Rename the implementation commands for [info] to be something more "expected". * generic/tclCompCmds.c (TclCompileInfoExistsCmd): Compiler for the [info exists] subcommand. (TclCompileEnsemble): Cleaned up version of ensemble compiler that was in TclCompileInfoCmd, but which is now much more generally applicable. * generic/tclInt.h (ENSEMBLE_COMPILE): Added flag to allow for cleaner turning on and off of ensemble bytecode compilation. * generic/tclCompile.c (TclCompileScript): Add the cmdPtr to the list of arguments passed to command compilers. 2007-11-15 Don Porter * generic/regc_nfa.c: Fixed infinite loop in the regexp compiler. [Bug 1810038] * generic/regc_nfa.c: Corrected looping logic in fixempties() to avoid wasting time walking a list of dead states. [Bug 1832612] 2007-11-15 Donal K. Fellows * generic/tclNamesp.c (NamespaceEnsembleCmd): Must pass a non-NULL interp to Tcl_SetEnsemble* functions. * doc/re_syntax.n: Try to make this easier to read. It's still a very difficult manual page! * unix/tcl.m4 (SC_CONFIG_CFLAGS): Allow people to turn off the -rpath option to their linker if they so desire. This is a configuration only recommended for (some) vendors. Relates to [Patch 1231022]. 2007-11-15 Pat Thoyts * win/tclWin32Dll.c: Prefer UINT_PTR to DWORD_PTR when casting pointers to integer types for greater portability. [Bug 1831253] 2007-11-15 Daniel Steffen * macosx/Tcl.xcodeproj/project.pbxproj: add new chanio.test. * macosx/Tcl.xcode/project.pbxproj: 2007-11-14 Donal K. Fellows * generic/tclCompile.c (TclCompileScript): Ensure that we get our count in our INST_START_CMD calls right, even when there's a failure to compile a command directly. * generic/tclNamesp.c (Tcl_SetEnsembleSubcommandList) (Tcl_SetEnsembleMappingDict): Special code to make sure that * generic/tclCmdIL.c (TclInitInfoCmd): [info exists] is compiled right while not allowing changes to the ensemble to cause havok. * generic/tclCompCmds.c (TclCompileInfoCmd): Simple compiler for the [info] command that only handles [info exists]. * generic/tclExecute.c (TclExecuteByteCode:INST_EXIST_*): New instructions to allow the testing of whether a variable exists. 2007-11-14 Andreas Kupries * tests/chanio.test: New file. This is essentially a duplicate of 'io.test', with all channel commands converted to their 'chan xxx' notation. * tests/io.test: Fixed typo in test description. 2007-11-14 Donal K. Fellows * generic/regc*.c: Eliminate multi-char collating element code completely. Simplifies the code quite a bit. If people still want the full code, it will remain on the 8.4 branch. [Bug 1831425] 2007-11-13 Jeff Hobbs * generic/tclCompCmds.c (TclCompileRegexpCmd): clean up comments, only free dstring on OK from TclReToGlob. (TclCompileSwitchCmd): simplify TclReToGlob usage. 2007-11-14 Donal K. Fellows * generic/regc*.c: #ifdef/comment out the code that deals with multi-character collating elements, which have never been supported. Cuts the memory consumption of the RE compiler. [Bug 1831425] 2007-11-13 Donal K. Fellows * generic/tclCompCmds.c (TclCompileSwitchCmd, TclCompileRegexpCmd): Extend [switch] compiler to handle regular expressions as long as things are not too complex. Fix [regexp] compiler so that non-trivial literal regexps get fed to INST_REGEXP. * doc/mathop.n: Clarify definitions of some operations. 2007-11-13 Miguel Sofer * unix/tclUnixInit.c: the TCL_NO_STACK_CHECK was being incorrectly undefined here; this should be set (or not) in the compile options, it is used elsewhere and needs to be consistent. 2007-11-13 Pat Thoyts * unix/tcl.m4: Added autoconf goo to detect and make use of * unix/configure.in: getaddrinfo and friends. * unix/configure: (regenerated) 2007-11-13 Donal K. Fellows * unix/tclUnixCompat.c (TclpGetHostByName): The six-argument form of getaddressbyname_r() uses the fifth argument to indicate whether the lookup succeeded or not on at least one platform. [Bug 1618235] 2007-11-13 Don Porter * generic/regcomp.c: Convert optst() from expensive no-op to a cheap no-op. 2007-11-13 Donal K. Fellows * unix/tclUnixChan.c (CreateSocketAddress): Rewrote to use the thread-safe version of gethostbyname() by forward-porting the code used in 8.4, and added rudimentary support for getaddrinfo() (not enabled by default, as no autoconf-ery written). Part of fix for [Bug 1618235]. 2007-11-12 Jeff Hobbs * generic/tclGet.c (Tcl_Get, Tcl_GetInt): revert use of TclGet* macros due to compiler warning. These cases won't save time either. * generic/tclUtil.c (TclReToGlob): add more comments, set interp result if specified on error. 2007-11-12 Miguel Sofer * generic/tclBasic.c: New macro TclResetResult, new iPtr * generic/tclExecute.c: flag bit INTERP_RESULT_UNCLEAN: * generic/tclInt.h: shortcut for Tcl_ResetResult for the * generic/tclProc.c: "normal" case: TCL_OK, no return * generic/tclResult.c: options, no errorCode nor errorInfo, * generic/tclStubLib.c: return at normal level. [Patch * generic/tclUtil.c: 1830184] THIS PATCH WAS REVERTED: initial (mis)measurements overstated the perfomance wins, which turn out to be tiny. Not worth the complication. 2007-11-11 Jeff Hobbs * generic/tclCompCmds.c, generic/tclCompile.c, generic/tclCompile.h: * generic/tclExecute.c, generic/tclInt.decls, generic/tclIntDecls.h: * generic/tclRegexp.c, generic/tclRegexp.h: Add INST_REGEXP and fully * generic/tclStubInit.c, generic/tclUtil.c: compiled [regexp] for the * tests/regexpComp.test: [Bug 1830166] simple cases. Also added TclReToGlob function to convert RE to glob patterns and use these in the possible cases. 2007-11-11 Miguel Sofer * generic/tclResult.c (ResetObjResult): clarify the logic. * generic/tclBasic.c: Increased usage of macros to detect * generic/tclBinary.c: and take advantage of objTypes. Added * generic/tclClock.c: macros TclGet(Int|Long)FromObj, * generic/tclCmdAH.c: TclGetIntForIndexM & TclListObjLength, * generic/tclCmdIL.c: modified TclListObjGetElements. * generic/tclCmdMZ.c: * generic/tclCompCmds.c: The TclGetInt* macros are only a * generic/tclCompExpr.c: shortcut on platforms where 'long' is * generic/tclCompile.c: 'int'; it may be worthwhile to extend * generic/tclDictObj.c: their functionality to other cases. * generic/tclExecute.c: * generic/tclGet.c: As this patch touches many files it * generic/tclIO.c: has been recorded as [Patch 1830038] * generic/tclIOCmd.c: in order to facilitate reviewing. * generic/tclIOGT.c: * generic/tclIndexObj.c: * generic/tclInt.h: * generic/tclInterp.c: * generic/tclListObj.c: * generic/tclLiteral.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclParse.c: * generic/tclProc.c: * generic/tclRegexp.c: * generic/tclResult.c: * generic/tclScan.c: * generic/tclStringObj.c: * generic/tclUtil.c: * generic/tclVar.c: 2007-11-11 Daniel Steffen * unix/tclUnixTime.c (TclpWideClicksToNanoseconds): Fix issues with * generic/tclInt.h: int64_t overflow. * generic/tclBasic.c: Fix stack check failure case if stack grows up * unix/tclUnixInit.c: Simplify non-crosscompiled case. * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2007-11-10 Miguel Sofer * generic/tclExecute.c: Fast path for INST_LIST_INDEX when the index is not a list. * generic/tclBasic.c: * unix/configure.in: * unix/tclUnixInit.c: Detect stack grwoth direction at compile time, only fall to runtime detection when crosscompiling. * unix/configure: autoconf 2.61 * generic/tclBasic.c: * generic/tclInt.h: * tests/interp.test: * unix/tclUnixInit.c: * win/tclWin32Dll.c: Restore simpler behaviour for stack checking, not adaptive to stack size changes after a thread is launched. Consensus is that "nobody does that", and so it is not worth the cost. Improved failure comments (mistachkin). 2007-11-10 Kevin Kenny * win/tclWin32Dll.c: Rewrote the Windows stack checking algorithm to use information from VirtualQuery to determine the bound of the stack. This change fixes a bug where the guard page of the stack was never restored after an overflow. It also eliminates a nasty piece of assembly code for structured exception handling on mingw. It introduces an assumption that the stack is a single memory arena returned from VirtualAlloc, but the code in MSVCRT makes the same assumption, so it should be fairly safe. 2007-11-10 Miguel Sofer * generic/tclBasic.c: * generic/tclInt.h: * unix/tclUnixInit.c: * unix/tclUnixPort.h: * win/tclWin32Dll.c: Modify the stack checking algorithm to recheck in case of failure. The working assumptions are now that (a) a thread's stack is never moved, and (b) a thread's stack can grow but not shrink. Port to windows - could be more efficient, but is already cheaper than it was. 2007-11-09 Miguel Sofer * generic/tclResult.c (ResetObjResult): new shortcut. * generic/tclAsync.c: * generic/tclBasic.c: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclUnixInit.c: * generic/tclUnixPort.h: New fields in interp (ekeko!) to cache TSD data that is accessed at each command invocation, access macros to replace Tcl_AsyncReady and TclpCheckStackSpace by much faster variants [Patch 1829248] 2007-11-09 Jeff Hobbs * generic/tclInt.decls, generic/tclIntDecls.h: Use unsigned char for * generic/tclExecute.c, generic/tclUtil.c: TclByteArrayMatch and don't allow a nocase option. [Bug 1828296] For INST_STR_MATCH, ignore pattern type for TclByteArrayMatch case. * generic/tclBinary.c (Tcl_GetByteArrayFromObj): check type before func jump (perf). 2007-11-07 Jeff Hobbs * generic/tclStubInit.c: Added TclByteArrayMatch * generic/tclInt.decls: for efficient glob * generic/tclIntDecls.h: matching of ByteArray * generic/tclUtil.c (TclByteArrayMatch): Tcl_Objs, used in * generic/tclExecute.c (TclExecuteByteCode): INST_STR_MATCH. [Bug 1827996] * generic/tclIO.c (TclGetsObjBinary): Add an efficient binary path for [gets]. (DoWriteChars): Special case for 1-byte channel write. 2007-11-06 Miguel Sofer * generic/tclEncoding.c: Version of the embedded iso8859-1 encoding handler that is faster (functions to do the encoding know exactly what they're doing instead of pulling it from a table, though the table itself has to be retained for use by shift encodings that depend on iso8859-1). [Patch 1826906], committing for dkf. 2007-11-05 Andreas Kupries * generic/tclConfig.c (Tcl_RegisterConfig): Modified to not extend the config database if the encoding provided by the user is not found (venc == NULL). Scripts expecting the data will error out, however we neither crash nor provide bogus information. See [Bug 983509] for more discussion. * unix/tclUnixChan.c (TtyGetOptionProc): Accepted [Patch 1823576] provided by Stuart Cassof . The patch adds the necessary utf/external conversions to the handling of the arguments of option -xchar which will allow the use of \0 and similar characters. 2007-11-03 Miguel Sofer * generic/tclTest.c (TestSetCmd2): * generic/tclVar.c (TclObjLookupVarEx): * tests/set.test (set-5.1): Fix error branch when array name looks like array element (code not normally exercised). 2007-11-01 Donal K. Fellows * tools/tcltk-man2html.tcl (output-directive): Convert .DS/.DE pairs into tables since that is now all that they are used for. * doc/RegExp.3: Clarified documentation of RE flags. [Bug 1167840] * doc/refchan.n: Adjust internal name to be consistent with the file name for reduced user confusion. After comment by Dan Steffen. * generic/tclCmdMZ.c (Tcl_StringObjCmd, UniCharIsAscii): Remember, the NUL character is in ASCII too. [Bug 1808258] * doc/file.n: Clarified use of [file normalize]. [Bug 1185154] 2007-10-30 Don Porter * generic/tcl.h: Bump version number to 8.5b2.1 to distinguish * library/init.tcl: CVS development snapshots from the 8.5b2 * unix/configure.in: release. * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf (2.59) * win/configure: 2007-10-30 Donal K. Fellows * doc/expr.n, doc/mathfunc.n: Improve documentation to try to make clearer what is going on. * doc/interp.n: Shorten the basic descriptive text for some interp subcommands so Solaris nroff doesn't truncate them. [Bug 1822268] 2007-10-30 Donal K. Fellows * tools/tcltk-man2html.tcl (output-widget-options): Enhance the HTML generator so that it can produce multi-line option descriptions. 2007-10-28 Miguel Sofer * generic/tclUtil.c (Tcl_ConcatObj): optimise for some of the concatenees being empty objs. [Bug 1447328] 2007-10-28 Donal K. Fellows * generic/tclEncoding.c (TclInitEncodingSubsystem): Hard code the iso8859-1 encoding, as it's needed for more than just text (especially binary encodings...) Note that other encodings rely on the encoding being a table encoding (!) so we can't use more efficient encoding mapping functions. 2007-10-27 Donal K. Fellows * generic/regc_lex.c (lexescape): Close off one of the problems mentioned in [Bug 1810264]. 2007-10-27 Miguel Sofer * generic/tclNamesp.c (Tcl_FindCommand): insure that FQ command names are searched from the global namespace, ie, bypassing resolvers of the current namespace. [Bug 1114355] * doc/apply.n: fixed example [Bug 1811791] * doc/namespace.n: improved example [Bug 1788984] * doc/AddErrInfo.3: typo [Bug 1715087] * doc/CrtMathFnc.3: fixed Tcl_ListMathFuncs entry [Bug 1672219] * generic/tclCompile.h: * generic/tclInt.h: moved declaration of TclSetCmdNameObj from tclCompile.h to tclInt.h, reverting linker [Bug 1821159] caused by commit of 2007-10-11 (both I and gcc missed one dep). * generic/tclVar.c: try to preserve Tcl_Objs when doing variable lookups by name, partially addressing [Bug 1793601]. 2007-10-27 Donal K. Fellows * tools/tcltk-man2html.tcl (make-man-pages, htmlize-text) (process-text): Make the man->HTML scraper work better. 2007-10-26 Don Porter *** 8.5b2 TAGGED FOR RELEASE *** * changes: Updated for 8.5b2 release. * doc/*.1: Revert doc changes that broke * doc/*.3: `make html` so we can get the release * doc/*.n: out the door. * README: Bump version number to 8.5b2. * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf (2.59) * win/configure: 2007-10-26 Donal K. Fellows * tools/man2help2.tcl, tools/man2tcl.c: Made some of the tooling code to do man->other formats work better with current manpage set. Long way still to go. 2007-10-25 Zoran Vasiljevic * generic/tclThread.c: Added TclpMasterLock/Unlock arround calls to ForgetSyncObject in Tcl_MutexFinalize and Tcl_ConditionFinalize to prevent from garbling the internal lists that track sync objects. [Bug 1726873] 2007-10-24 Donal K. Fellows * tools/man2html2.tcl (macro): Added support for converting the new macros into HTML. * doc/man.macros (QW,PQ,QR,MT): New macros that hide the ugly mess needed to get proper GOOBE quoting in the manual pages. * doc/*.n, doc/*.3, doc/*.1: Lots of changes to take advantage of the new macros. 2007-10-20 Miguel Sofer * generic/tclCompile.c: Fix comments. * generic/tclExecute.c: 2007-10-18 David Gravereaux * tools/mkdepend.tcl: sort the dep list for a more humanly readable output. 2007-10-18 Don Porter * generic/tclResult.c (TclMergeReturnOptions): Make sure any -code values get pulled out of the dictionary, even if they are integer valued. * generic/tclCompCmds.c (TclCompileReturnCmd): Added code to more optimally compile [return -level 0 $x] to "push $x". [RFE 1794073] * compat/tmpnam.c (removed): The routine tmpnam() is no longer * unix/Makefile.in: called by Tcl source code. Remove autogoo the * unix/configure.in: supplied a replacement version on systems * win/tcl.dsp: where the routine was not available. [RFE 1811848] * unix/configure: autoconf-2.59 * generic/tcl.h: Remove TCL_LL_MODIFIER_SIZE. [RFE 1811837] 2007-10-17 David Gravereaux * tools/mkdepend.tcl: Improved defense from malformed object list infile. 2007-10-17 Donal K. Fellows * tools/man2html2.tcl: Convert .DS/.DE into HTML tables, not preformatted text. 2007-10-17 Kevin B. Kenny * generic/tclCompExpr.c: Moved a misplaced declaration that blocked compilation on VC++. * generic/tclExecute.c: Silenced several VC++ compiler warnings about converting 'long' to 'unsigned short'. 2007-10-16 David Gravereaux * win/makefile.vc: removed old dependency cruft that is no longer needed. 2007-10-15 Don Porter * generic/tclIOCmd.c: Revise [open] so that it interprets leading zero strings passed as the "permissions" argument as octal numbers, even if Tcl itself no longer parses integers in that way. * unix/tclUnixFCmd.c: Revise the "-permissions" [file attribute] so that it interprets leading zero strings as octal numbers, even if Tcl itself no longer parses integers in that way. * generic/tclCompExpr.c: Corrections to code that produces * generic/tclUtil.c: extended "bad octal" error messages. * tests/cmdAH.test: Test revisions so that tests pass whether or * tests/cmdIL.test: not Tcl parses leading zero strings as octal. * tests/compExpr-old.test: * tests/compExpr.test: * tests/compile.test: * tests/expr-old.test: * tests/expr.test: * tests/incr.test: * tests/io.test: * tests/lindex.test: * tests/link.test: * tests/mathop.test: * tests/parseExpr.test: * tests/set.test: * tests/string.test: * tests/stringComp.test: 2007-10-15 David Gravereaux * tools/mkdepend.tcl: Produces usable output. Include path problem * win/makefile.vc: fixed. Never fight city hall when it comes to levels of quoting issues. 2007-10-15 Miguel Sofer * generic/tclParse.c (Tcl_ParseBraces): fix for possible read after the end of buffer. [Bug 1813528] (Joe Mistachkin) 2007-10-14 David Gravereaux * tools/mkdepend.tcl (new): Initial stab at generating automatic * win/makefile.vc: dependencies. 2007-10-12 Pat Thoyts * win/makefile.vc: Mine all version information from headers. * win/rules.vc: Sync tcl and tk and bring extension versions * win/nmakehlp.c: closer together. Try and avoid using tclsh to do substitutions as we may cross compile. * win/coffbase.txt: Added offsets for snack dlls. 2007-10-11 David Gravereaux * win/makefile.vc: Fixed my bad spelling mistakes from years back. Dedependency, duh! Rather funny. 2007-10-11 Don Porter * generic/tclCmdMZ.c: Correct [string is (wide)integer] failure * tests/string.test: to report correct failindex values for non-decimal integer strings. [Bug 1805887] * compat/strtoll.c (removed): The routines strtoll() and strtoull() * compat/strtoull.c (removed): are no longer called by the Tcl source * generic/tcl.h: code. (Their functionality has been replaced * unix/Makefile.in: by TclParseNumber().) Remove outdated comments * unix/configure.in: and mountains of configury autogoo that * unix/tclUnixPort.h: allegedly support the mythical systems where * win/Makefile.in: these routines might not have been available. * win/makefile.bc: * win/makefile.vc: * win/tclWinPort.h: * unix/configure: autoconf-2.59 2007-10-11 Miguel Sofer * generic/tclObj.c: remove superfluous #include of tclCompile.h 2007-10-08 George Peter Staplin * doc/Hash.3: Correct the valid usage of the flags member for the Tcl_HashKeyType. It should be 0 or more of the flags mentioned. 2007-10-02 Jeff Hobbs * generic/tcl.h (Tcl_DecrRefCount): Update change from 2006-05-29 to make macro more warning-robust in unbraced if code. 2007-10-02 Don Porter [core-stabilizer-branch] * README: Bump version number to 8.5.0 * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf (2.59) * win/configure: 2007-10-02 Andreas Kupries * library/tclIndex: Added 'tcl::tm::path' to the tclIndex. This fixes [Bug 1806422] reported by Don Porter. 2007-09-25 Donal K. Fellows * generic/tclProc.c (Tcl_DisassembleObjCmd): Define a command, ::tcl::unsupported::disassemble, which can disassemble procedures, lambdas and general scripts. * generic/tclCompile.c (TclDisassembleByteCodeObj): Split apart the code to print disassemblies of bytecode so that there is reusable code that spits it out in a Tcl_Obj and then that code is used when doing tracing. 2007-09-20 Don Porter *** 8.5b1 TAGGED FOR RELEASE *** * changes: updates for 8.5b1 release. 2007-09-19 Don Porter * README: Bump version number to 8.5b1 * generic/tcl.h: Merge from core-stabilizer-branch. * library/init.tcl: Stabilizing toward 8.5b1 release now done on * tools/tcl.wse.in: the HEAD. core-stabilizer-branch is now * unix/configure.in: suspended. * unix/tcl.spec: * win/configure.in: 2007-09-19 Pat Thoyts * generic/tclStubLib.: Replaced isdigit with internal implementation. 2007-09-18 Don Porter * generic/tclStubLib.c: Remove C library calls from Tcl_InitStubs() so * win/makefile.vc: that we don't need the C library linked in to libtclStub. 2007-09-17 Pat Thoyts * win/makefile.vc: Add crt flags for tclStubLib now it uses C-library functions. 2007-09-17 Joe English * tcl.m4: use '${CC} -shared' instead of 'ld -Bshareable' to build shared libraries on current NetBSDs. [Bug 1749251] * unix/configure: regenerated (autoconf-2.59). 2007-09-17 Don Porter * unix/Makefile.in: Update `make dist` so that tclDTrace.d is included in the source code distribution. * generic/tcl.h: Revised Tcl_InitStubs() to restore Tcl 8.4 * generic/tclPkg.c: source compatibility with callers of * generic/tclStubLib.c: Tcl_InitStubs(interp, TCL_VERSION, 1). [Bug 1578344] 2007-09-17 Donal K. Fellows * generic/tclTrace.c (Tcl_TraceObjCmd, TraceExecutionObjCmd) (TraceCommandObjCmd, TraceVariableObjCmd): Generate literal values * generic/tclNamesp.c (NamespaceCodeCmd): more efficiently using * generic/tclFCmd.c (CopyRenameOneFile): TclNewLiteralStringObj * generic/tclEvent.c (TclSetBgErrorHandler): macro. 2007-09-15 Daniel Steffen * unix/tcl.m4: replace all direct references to compiler by ${CC} to enable CC overriding at configure & make time; run check for visibility "hidden" with all compilers; quoting fixes from TEA tcl.m4. (SunOS-5.1x): replace direct use of '/usr/ccs/bin/ld' in SHLIB_LD by 'cc' compiler driver. * unix/configure: autoconf-2.59 2007-09-14 Donal K. Fellows * generic/tclBasic.c (Tcl_CreateObjCommand): Only invalidate along the namespace path once; that is enough. [Bug 1519940] 2007-09-14 Daniel Steffen * generic/tclDTrace.d (new file): Add DTrace provider for Tcl; allows * generic/tclCompile.h: tracing of proc and command entry & * generic/tclBasic.c: return, bytecode execution, object * generic/tclExecute.c: allocation and more; with * generic/tclInt.h: essentially zero cost when tracing * generic/tclObj.c: is inactive; enable with * generic/tclProc.c: --enable-dtrace configure arg * unix/Makefile.in: (disabled by default, will only * unix/configure.in: enable if DTrace is present). [Patch 1793984] * macosx/GNUmakefile: Enable DTrace support. * macosx/Tcl-Common.xcconfig: * macosx/Tcl.xcodeproj/project.pbxproj: * generic/tclCmdIL.c: Factor out core of InfoFrameCmd() into internal TclInfoFrame() for use by DTrace probes. * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2007-09-12 Don Porter * unix/Makefile.in: Perform missing updates of the tcltest Tcl * win/Makefile.in: Module installed filename that should have been part of the bump to tcltest 2.3b1. Thanks Larry Virden. 2007-09-12 Pat Thoyts * win/makefile.vc, win/rules.vc, win/nmakehlp.c: Use nmakehlp to substitute values for tclConfig.sh (helps cross-compiling). 2007-09-11 Don Porter * library/tcltest/tcltest.tcl: Accept underscores and colons in * library/tcltest/pkgIndex.tcl: constraint names. Properly handle constraint expressions that return non-numeric boolean results like "false". Bump to tcltest 2.3b1. [Bug 1772989; RFE 1071322] * tests/info.test: Disable fragile tests. * doc/package.n: Restored the functioning of [package require * generic/tclPkg.c: -exact] to be compatible with Tcl 8.4. [Bug * tests/pkg.test: 1578344] 2007-09-11 Miguel Sofer * generic/tclCompCmds.c (TclCompileDictCmd-update): * generic/tclCompile.c (tclInstructionTable): * generic/tclExecute.c (INST_DICT_UPDATE_END): fix stack management in compiled [dict update]. [Bug 1786481] ***POTENTIAL INCOMPATIBILITY*** Scripts that were precompiled on earlier versions of 8.5 and use [dict update] will crash. Workaround: recompile. 2007-09-11 Kevin B. Kenny * generic/tclExecute.c: Corrected an off-by-one error in the setting of MaxBaseWide for certain powers. [Bug 1767293 - problem reported in comments when bug was reopened] 2007-09-10 Jeff Hobbs * generic/tclLink.c (Tcl_UpdateLinkedVar): guard against var being unlinked. [Bug 1740631] (maros) 2007-09-10 Miguel Sofer * generic/tclCompile.c: fix tclInstructionTable entry for dictUpdateEnd * generic/tclExecute.c: remove unneeded setting of 'cleanup' variable before jumping to checkForCatch. 2007-09-10 Don Porter * doc/package.n: Restored the document parallel syntax of the * generic/tclPkg.c: [package present] and [package require] * tests/pkg.test: commands. [Bug 1723675] 2007-09-09 Don Porter * generic/tclInt.h: Removed the "nsName" Tcl_ObjType from the * generic/tclNamesp.c: registered set. Revised the management of the * generic/tclObj.c: intrep of that Tcl_ObjType. Revised the * tests/obj.test: TclGetNamespaceFromObj() routine to return TCL_ERROR and write a consistent error message when a namespace is not found. [Bug 1588842. Patch 1686862] ***POTENTIAL INCOMPATIBILITY*** For callers of Tcl_GetObjType() on the name "nsName". * generic/tclExecute.c: Update TclGetNamespaceFromObj() callers. * generic/tclProc.c: * tests/apply.test: Updated tests to expect new consistent * tests/namespace-old.test: error message when a namespace is not * tests/namespace.test: found. * tests/upvar.test: * generic/tclCompCmds.c: Use the new INST_REVERSE instruction * tests/mathop.test: to correct the compiled versions of math operator commands. [Bug 1724437] * generic/tclCompile.c: New bytecode instruction INST_REVERSE to * generic/tclCompile.h: reverse the order of N items at the top of * generic/tclExecute.c: stack. * generic/tclCompCmds.c (TclCompilePowOpCmd): Make a separate routine to compile ** to account for its different associativity. 2007-09-08 Miguel Sofer * generic/tclVar.c (Tcl_SetVar2, TclPtrSetVar): [Bug 1710710] fixed correctly, reverted fix of 2007-05-01. 2007-09-08 Donal K. Fellows * generic/tclDictObj.c (DictUpdateCmd, DictWithCmd): Plug a hole that * generic/tclExecute.c (TEBC,INST_DICT_UPDATE_END): allowed a careful * tests/dict.test (dict-21.16,21.17,22.11): attacker to craft a dict containing a recursive link to itself, violating one of Tcl's fundamental datatype assumptions and causing a stack crash when the dict was converted to a string. [Bug 1786481] 2007-09-07 Don Porter * generic/tclEvent.c ([::tcl::Bgerror]): Corrections to Tcl's * tests/event.test: default [interp bgerror] handler so that when it falls back to a hidden [bgerror] in a safe interp, it gets the right error context data. [Bug 1790274] 2007-09-07 Miguel Sofer * generic/tclProc.c (TclInitCompiledLocals): the refCount of resolved variables was being managed without checking if they were Var or VarInHash: itcl [Bug 1790184] 2007-09-06 Don Porter * generic/tclResult.c (Tcl_GetReturnOptions): Take care that a * tests/init.test: non-TCL_ERROR code doesn't cause existing -errorinfo, -errorcode, and -errorline entries to be omitted. * generic/tclEvent.c: With -errorInfo no longer lost, generate more complete ::errorInfo when calling [bgerror] after a non-TCL_ERROR background exception. 2007-09-06 Don Porter * generic/tclInterp.c (Tcl_Init): Removed constraint on ability to define a custom [tclInit] before calling Tcl_Init(). Until now the custom command had to be a proc. Now it can be any command. * generic/tclInt.decls: New internal routine TclBackgroundException() * generic/tclEvent.c: that for the first time permits non-TCL_ERROR exceptions to trigger [interp bgerror] handling. Closes a gap in TIP 221. When falling back to [bgerror] (which is designed only to handle TCL_ERROR), convert exceptions into errors complaining about the exception. * generic/tclInterp.c: Convert Tcl_BackgroundError() callers to call * generic/tclIO.c: TclBackgroundException(). * generic/tclIOCmd.c: * generic/tclTimer.c: * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: 2007-09-06 Daniel Steffen * macosx/Tcl.xcode/project.pbxproj: discontinue unmaintained support * macosx/Tcl.xcode/default.pbxuser: for Xcode 1.5; replace by Xcode2 project for use on Tiger (with Tcl.xcodeproj to be used on Leopard). * macosx/Tcl.xcodeproj/project.pbxproj: updates for Xcode 2.5 and 3.0. * macosx/Tcl.xcodeproj/default.pbxuser: * macosx/Tcl.xcode/project.pbxproj: * macosx/Tcl.xcode/default.pbxuser: * macosx/Tcl-Common.xcconfig: * macosx/README: document project changes. 2007-09-05 Don Porter * generic/tclBasic.c: Removed support for the unmaintained * generic/tclExecute.c: -DTCL_GENERIC_ONLY configuration. [Bug * unix/Makefile.in: 1264623] 2007-09-04 Don Porter * unix/Makefile.in: It's unreliable to count on the release manager to remember to `make genstubs` before `make dist`. Let the Makefile remember the dependency for us. * unix/Makefile.in: Corrections to `make dist` dependencies to be sure that macosx/configure gets generated whenever it does not exist. 2007-09-03 Kevin B, Kenny * library/tzdata/Africa/Cairo: * library/tzdata/America/Grand_Turk: * library/tzdata/America/Port-au-Prince: * library/tzdata/America/Indiana/Petersburg: * library/tzdata/America/Indiana/Tell_City: * library/tzdata/America/Indiana/Vincennes: * library/tzdata/Antarctica/McMurdo: * library/tzdata/Australia/Adelaide: * library/tzdata/Australia/Broken_Hill: * library/tzdata/Australia/Currie: * library/tzdata/Australia/Hobart: * library/tzdata/Australia/Lord_Howe: * library/tzdata/Australia/Melbourne: * library/tzdata/Australia/Sydney: * library/tzdata/Pacific/Auckland: * library/tzdata/Pacific/Chatham: Olson's tzdata2007g. * generic/tclListObj.c (TclLindexFlat): * tests/lindex.test (lindex-17.[01]): Added code to detect the error when a script does [lindex {} end foo]; an overaggressive optimisation caused this call to return an empty object rather than an error. 2007-09-03 Daniel Steffen * generic/tclObj.c (TclInitObjSubsystem): restore registration of the "wideInt" Tcl_ObjType for compatibility with 8.4 extensions that access the tclWideIntType Tcl_ObjType; add setFromAnyProc for tclWideIntType. 2007-09-02 Donal K. Fellows * doc/lsearch.n: Added note that order of results with the -all option is that of the input list. It always was, but this makes it crystal. 2007-08-30 Don Porter * generic/tclCompile.c: Added fflush() calls following all callers of * generic/tclExecute.c: TclPrintByteCodeObj() so that tcl_traceCompile output is less likely to get mangled when writes to stdout interleave with other code. 2007-08-28 Don Porter * generic/tclCompExpr.c: Use a table lookup in ParseLexeme() to determine lexemes with single-byte representations. * generic/tclBasic.c: Used unions to better clarify overloading of * generic/tclCompExpr.c: the fields of the OpCmdInfo and * generic/tclCompile.h: TclOpCmdClientData structs. 2007-08-27 Don Porter * generic/tclCompExpr.c: Call TclCompileSyntaxError() when expression syntax errors are found when compiling expressions. With this in place, convert TclCompileExpr to return void, since there's no longer any need to report TCL_ERROR. * generic/tclCompile.c: Update callers. * generic/tclExecute.c: * generic/tclCompCmds.c: New routine TclCompileSyntaxError() * generic/tclCompile.h: to directly compile bytecodes that report a * generic/tclCompile.c: syntax error, rather than (ab)use a call to TclCompileReturnCmd. Also, undo the most recent commit that papered over some issues with that (ab)use. New routine produces a new opcode INST_SYNTAX, which is a minor variation of INST_RETURN_IMM. Also a bit of constification. * generic/tclCompile.c: Move the deallocation of local LiteralTable * generic/tclCompExpr.c: entries into TclFreeCompileEnv(). * generic/tclExecute.c: Update callers. * generic/tclCompExpr.c: Force numeric and boolean literals in expressions to register with their intreps intact, even if that means overwriting existing intreps in already registered literals. 2007-08-25 Kevin B. Kenny * generic/tclExecute.c (TclExecuteByteCode): Added code to handle * tests/expr.test (expr-23.48-53) integer exponentiation that results in 32- and 64-bit integer results, avoiding calls to wide integer exponentiation routines in this common case. [Bug 1767293] * library/clock.tcl (ParseClockScanFormat): Modified code to allow * tests/clock.test (clock-60.*): case-insensitive matching of time zone and month names. [Bug 1781282] 2007-08-24 Don Porter * generic/tclCompExpr.c: Register literals found in expressions * tests/compExpr.test: to restore literal sharing. Preserve numeric intreps when literals are created for the first time. Correct memleak in ExecConstantExprTree() and add test for the leak. 2007-08-24 Miguel Sofer * generic/tclCompile.c: replaced copy loop that tripped some compilers with memmove. [Bug 1780870] 2007-08-23 Don Porter * library/init.tcl ([auto_load_index]): Delete stray "]" that created an expr syntax error (masked by a [catch]). * generic/tclCompCmds.c (TclCompileReturnCmd): Added crash protection to handle callers other than TclCompileScript() failing to meet the initialization assumptions of the TIP 280 code in CompileWord(). * generic/tclCompExpr.c: Suppress the attempt to convert to numeric when precompiling a constant expression indicates an error. 2007-08-22 Miguel Sofer * generic/tclExecute.c (TEBC): disable the new shortcut to frequent INSTs for debug builds. REVERTED (collision with alternative fix) 2007-08-21 Don Porter * generic/tclMain.c: Corrected the logic of dropping the last * tests/main.test: newline from an interactively typed command. [Bug 1775878] 2007-08-21 Pat Thoyts * tests/thread.test: thread-4.4: clear ::errorInfo in the thread as a message is left here from init.tcl on windows due to no tcl_pkgPath. 2007-08-20 Miguel Sofer * generic/tclExecute.c (INST_SUB): fix usage of the new macro for overflow detection in sums, adapt to subtraction. Lengthy comment added. 2007-08-19 Donal K. Fellows * generic/tclExecute.c (Overflowing, TclIncrObj, TclExecuteByteCode): Encapsulate Miguel's last change in a more mnemonic macro. 2007-08-19 Miguel Sofer * generic/tclExecute.c: changed the check for overflow in sums, reducing objsize, number of branches and cache misses (according to cachegrind). Non-overflow for s=a+b: previous ((a >= 0 || b >= 0 || s < 0) && (s >= 0 || b < 0 || a < 0)) now (((a^s) >= 0) || ((a^b) < 0)) This expresses: "a and s have the same sign or else a and b have different sign". 2007-08-19 Donal K. Fellows * doc/interp.n (RESOURCE LIMITS): Added text to better explain why time limits are described using absolute times. [Bug 1752148] 2007-08-16 Miguel Sofer * generic/tclVar.c: improved localVarNameType caching to leverage the new availability of Tcl_Obj in variable names, avoiding string comparisons to verify that the cached value is usable. * generic/tclExecute.c: check the two most frequent instructions before the switch. Reduces both runtime and obj size a tiny bit. 2007-08-16 Don Porter * generic/tclCompExpr.c: Added a "constant" field to the OpNode struct (again "free" due to alignment requirements) to mark those subexpressions that are completely known at compile time. Enhanced CompileExprTree() and its callers to precompute these constant subexpressions at compile time. This resolves the issue raised in [Bug 1564517]. 2007-08-15 Donal K. Fellows * generic/tclIOUtil.c (TclGetOpenModeEx): Only set the O_APPEND flag * tests/ioUtil.test (ioUtil-4.1): on a channel for the 'a' mode and not for 'a+'. [Bug 1773127] 2007-08-14 Miguel Sofer * generic/tclExecute.c (INST_INVOKE*): peephole opt, do not get the interp's result if it will be pushed/popped. 2007-08-14 Don Porter * generic/tclBasic.c: Use fully qualified variable names for * tests/thread.test: ::errorInfo and ::errorCode so that string * tests/trace.test: reported to variable traces are fully qualified in agreement with Tcl 8.4 operations. 2007-08-14 Daniel Steffen * unix/tclLoadDyld.c: use dlfcn API on Mac OS X 10.4 and later; fix issues with loading from memory on intel and 64bit; add debug messages * tests/load.test: add test load-10.1 for loading from vfs. * unix/dltest/pkga.c: whitespace & comment cleanup, remove * unix/dltest/pkgb.c: unused pkgf.c. * unix/dltest/pkgc.c: * unix/dltest/pkge.c: * unix/dltest/pkgf.c (removed): * unix/dltest/pkgua.c: * macosx/Tcl.xcodeproj/project.pbxproj: 2007-08-13 Don Porter * generic/tclExecute.c: Provide DECACHE/CACHE protection to the * tests/trace.test: Tcl_LogCommandInfo() call. [Bug 1773040] 2007-08-12 Miguel Sofer * generic/tclCmdMZ.c (Tcl_SplitObjCmd): use TclNewStringObj macro instead of calling the function. * generic/tcl_Obj.c (TclAllocateFreeObjects): remove unneeded memset to 0 of all allocated objects. 2007-08-10 Miguel Sofer * generic/tclInt.h: remove redundant ops in TclNewStringObj macro. 2007-08-10 Miguel Sofer * generic/tclInt.h: fix the TclSetVarNamespaceVar macro, was causing a leak. 2007-08-10 Don Porter * generic/tclCompExpr.c: Revise CompileExprTree() to use the OpNode mark field scheme of tree traversal. This eliminates the need to use magic values in the left and right fields for that purpose. Also stop abusing the left field within ParseExpr() to store the number of arguments in a parsed function call. CompileExprTree() now determines that for itself at compile time. Then reorder code to eliminate duplication. 2007-08-09 Miguel Sofer * generic/tclProc.c (TclCreateProc): better comments on the required varflag values when loading precompiled procs. * generic/tclExecute.c (INST_STORE_ARRAY): * tests/trace.test (trace-2.6): whole array write traces on compiled local variables were not firing. [Bug 1770591] 2007-08-08 Jeff Hobbs * generic/tclProc.c (InitLocalCache): reference firstLocalPtr via procPtr. codePtr->procPtr == NULL exposed by tbcload. 2007-08-08 Don Porter * generic/tclExecute.c: Corrected failure to compile/link in the -DNO_WIDE_TYPE configuration. * generic/tclExecute.c: Corrected improper use of bignum arguments to * tests/expr.test: *SHIFT operations. [Bug 1770224] 2007-08-07 Miguel Sofer * generic/tclInt.h: remove comments refering to VAR_SCALAR, as that flag bit does not exist any longer. * generic/tclProc.c (InitCompiledLocals): removed optimisation for non-resolved case, as the function is never called in that case. Renamed the function to InitResolvedLocals to calrify the point. * generic/tclInt.decls: Exporting via stubs to help xotcl adapt to * generic/tclInt.h: VarReform. * generic/tclIntDecls.h: * generic/tclStubInit.c: 2007-08-07 Daniel Steffen * generic/tclEnv.c: improve environ handling on Mac OS X (adapted * unix/tclUnixPort.h: from Apple changes in Darwin tcl-64). * unix/Makefile.in: add support for compile flags specific to object files linked directly into executables. * unix/configure.in (Darwin): only use -seg1addr flag when prebinding; use -mdynamic-no-pic flag for object files linked directly into exes; support overriding TCL_PACKAGE_PATH/TCL_MODULE_PATH in environment. * unix/configure: autoconf-2.59 2007-08-06 Don Porter * tests/parseExpr.test: Update source file name of expr parser code. * generic/tclCompExpr.c: Added a "mark" field to the OpNode struct, which is used to guide tree traversal. This field costs nothing since alignement requirements used the memory already. Rewrote ConvertTreeToTokens() to use the new field, which permitted consolidation of utility routines CopyTokens() and GenerateTokensForLiteral(). 2007-08-06 Kevin B. Kenny * generic/tclGetDate.y: Added a cast to the definition of YYFREE to silence compiler warnings. * generic/tclDate.c: Regenerated * win/tclWinTest.c: Added a cast to GetSecurityDescriptorDacl call to silence compiler warnings. 2007-08-04 Miguel Sofer * generic/tclInt.decls: Exporting via stubs to help itcl adapt to * generic/tclInt.h: VarReform. Added localCache initialization * generic/tclIntDecls.h: to TclInitCompiledLocals (which only exists * generic/tclProc.c: for itcl). * generic/tclStubInit.c: * generic/tclVar.c: 2007-08-01 Donal K. Fellows * library/word.tcl: Rewrote for greater efficiency. [Bug 1764318] 2007-08-01 Pat Thoyts * generic/tclInt.h: Added a TclOffset macro ala Tk_Offset to * generic/tclVar.c: abstract out 'offsetof' which may not be * generic/tclExceute.c: defined (eg: msvc6). 2007-08-01 Miguel Sofer * generic/tclVar.c (TclCleanupVar): fix [Bug 1765225], thx Larry Virden. 2007-07-31 Miguel Sofer * doc/Hash.3: * generic/tclHash.c: * generic/tclObj.c: * generic/tclThreadStorage.c: (changes part of the patch below) Stop Tcl_CreateHashVar from resetting hPtr->clientData to NULL after calling the allocEntryProc for a custom table. * generic/tcl.h: * generic/tclBasic.c: * generic/tclCmdIL.c: * generic/tclCompCmds.c: * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclHash.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclLiteral.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclProc.c: * generic/tclThreadStorage.c: * generic/tclTrace.c: * generic/tclVar.c: VarReform [Patch 1750051] *** POTENTIAL INCOMPATIBILITY *** (tclInt.h and tclCompile.h) Extensions that access internals defined in tclInt.h and/or tclCompile.h may lose both binary and source compatibility. The relevant changes are: 1. 'struct Var' is completely changed, all acceses to its internals (either direct or via the TclSetVar* and TclIsVar* macros) will malfunction. Var flag values and semantics changed too. 2. 'struct Bytecode' has an additional field that has to be initialised to NULL 3. 'struct Namespace' is larger, as the varTable is now one pointer larger than a Tcl_HashTable. Direct access to its fields will malfunction. 4. 'struct CallFrame' grew one more field (the second such growth with respect to Tcl8.4). 5. API change for the functions TclFindCompiledLocal, TclDeleteVars and many internal functions in tclVar.c Additionally, direct access to variable hash tables via the standard Tcl_Hash* interface is to be considered as deprecated. It still works in the present version, but will be broken by further specialisation of these hash tables. This concerns especially the table of array elements in an array, as well as the varTable field in the Namespace struct. 2007-07-31 Miguel Sofer * unix/configure.in: allow use of 'inline' in Tcl sources. [Patch * win/configure.in: 1754128] * win/makefile.vc: Regen with autoconf 2.61 2007-07-31 Donal K. Fellows * unix/tclUnixInit.c (TclpSetVariables): Use the thread-safe getpwuid replacement to fill the tcl_platform(user) field as it is not subject to spoofing. [Bug 681877] * unix/tclUnixCompat.c: Simplify the #ifdef logic. * unix/tclUnixChan.c (FileWatchProc): Fix test failures. 2007-07-30 Donal K. Fellows * unix/tclUnixChan.c (SET_BITS, CLEAR_BITS): Added macros to make this file clearer. 2007-07-24 Miguel Sofer * generic/tclBasic.c (TEOvI, GetCommandSource): * generic/tclExecute.c (TEBC, TclGetSrcInfoForCmd): * generic/tclInt.h: * generic/tclTrace.c (TclCheck(Interp|Execution)Traces): Removed the need for TEBC to inspect the command before calling TEOvI, leveraging the TIP 280 infrastructure. Moved the generation of a correct nul-terminated command string away from the trace code, back into TEOvI/GetCommandSource. 2007-07-20 Andreas Kupries * library/platform/platform.tcl: Fixed bug in 'platform::patterns' * library/platform/pkgIndex.tcl: where identifiers not matching * unix/Makefile.in: the special linux and solaris forms would not * win/Makefile.in: get 'tcl' as an acceptable platform added to * doc/platform.n: the result. Bumped package to version 1.0.3 and * doc/platform_shell.n: updated documentation and Makefiles. Also fixed bad version info in the documentation of platform::shell. 2007-07-19 Don Porter * generic/tclParse.c: In contexts where interp and parsePtr->interp might be different, be sure to use the latter for error reporting. Also pulled the interp argument back out of ParseTokens() since we already had a parsePtr->interp to work with. 2007-07-18 Don Porter * generic/tclCompExpr.c: Removed unused arguments and variables 2007-07-17 Don Porter * generic/tclCompExpr.c (ParseExpr): While adding comments to explain the operations of ParseExpr(), made significant revisions to the code so it would be easier to explain, and in the process made the code simpler and clearer as well. 2007-07-15 Don Porter * generic/tclCompExpr.c: More commentary. * tests/parseExpr.test: Several tests of syntax error messages to check that when expression substrings are truncated they leave visible the context relevant to the reported error. 2007-07-12 Don Porter * generic/tclCompExpr.c: Factored out, corrected, and commented common code for reporting syntax errors in LEAF elements. 2007-07-11 Miguel Sofer * generic/tclCompCmds.c (TclCompileWhileCmd): * generic/tclCompile.c (TclCompileScript): Corrected faulty avoidance of INST_START_CMD when the first opcode in a script is within a loop (as produced by 'while 1'), so that the corresponding command is properly counted. [Bug 1752146] 2007-07-11 Don Porter * generic/tclCompExpr.c: Added a "parseOnly" flag argument to ParseExpr() to indicate whether the caller is Tcl_ParseExpr(), with an end goal of filling a Tcl_Parse with Tcl_Tokens representing the parsed expression, or TclCompileExpr() with the goal of compiling and executing the expression. In the latter case, more aggressive conversion of QUOTED and BRACED lexeme to literals is done. In the former case, all such conversion is avoided, since Tcl_Token production would revert it anyway. This enables simplifications to the GenerateTokensForLiteral() routine as well. 2007-07-10 Don Porter * generic/tclCompExpr.c: Added a field for operator precedence to be stored directly in the parse tree. There's no memory cost to this addition, since that memory would have been lost to alignment issues anyway. Also, converted precedence definitions and lookup tables to use symbolic constants instead of raw number for improved readability, and continued extending/improving/correcting comments. Removed some unused counter variables. Renamed some variables for clarity and replaced some cryptic logic with more readable macros. 2007-07-09 Don Porter * generic/tclCompExpr.c: Revision so that the END lexeme never gets inserted into the parse tree. Later tree traversal never reaches it since its location in the tree is not variable. Starting and stopping with the START lexeme (node 0) is sufficient. Also finished lexeme code commentary. * generic/tclCompExpr.c: Added missing creation and return of the Tcl_Parse fields that indicate error conditions. [Bug 1749987] 2007-07-05 Don Porter * library/init.tcl (unknown): Corrected inconsistent error message in interactive [unknown] when empty command is invoked. [Bug 1743676] 2007-07-05 Miguel Sofer * generic/tclNamesp.c (SetNsNameFromAny): * generic/tclObj.c (SetCmdNameFromAny): Avoid unnecessary ckfree/ckalloc when the old structs can be reused. 2007-07-04 Miguel Sofer * generic/tclNamesp.c: Fix case where a FQ cmd or ns was being cached * generic/tclObj.c: in a different interp, tkcon. [Bug 1747512] 2007-07-03 Don Porter * generic/tclCompExpr.c: Revised #define values so that there is now more expansion room to define more BINARY operators. 2007-07-02 Donal K. Fellows * generic/tclHash.c (CompareStringKeys): Always use the strcmp() version; the operation is functionally equivalent, the speed is identical (up to measurement limitations), and yet the code is simpler. [FRQ 951168] 2007-07-02 Don Porter * generic/tcl.h: Removed TCL_PRESERVE_BINARY_COMPATIBILITY and * generic/tclHash.c: any code enabled when it is set to 0. We will * generic/tclStubInit.c: always want to preserve binary compat of the structs that appear in the interface through the 8.* series of releases, so it's pointless to drag around this never-enabled alternative. * generic/tclIO.c: Removed dead code. * unix/tclUnixChan.c: * generic/tclCompExpr.c: Removed dead code, old implementations * generic/tclEvent.c: of expr parsing and compiling, including the * generic/tclInt.h: routine TclFinalizeCompilation(). 2007-06-30 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsortObjCmd): Plug a memory leak caused by a missing Tcl_DecrRefCount on an error path. [Bug 1717186] 2007-06-30 Zoran Vasiljevic * generic/tclThread.c: Prevent RemeberSyncObj() from growing the sync object lists by reusing already free'd slots, if possible. See discussion on Bug 1726873 for more information. 2007-06-29 Donal K. Fellows * doc/DictObj.3 (Tcl_DictObjDone): Improved documentation of this function to make it clearer how to use it. [Bug 1710795] 2007-06-29 Daniel Steffen * generic/tclAlloc.c: on Darwin, ensure memory allocated by * generic/tclThreadAlloc.c: the custom TclpAlloc()s is aligned to 16 byte boundaries (as is the case with the Darwin system malloc). * generic/tclGetDate.y: use ckalloc/ckfree instead of malloc/free. * generic/tclDate.c: bison 1.875e * generic/tclBasic.c (TclEvalEx): fix warnings. * macosx/Tcl.xcodeproj/project.pbxproj: better support for renamed tcl * macosx/Tcl.xcodeproj/default.pbxuser: source dir; add 10.5 SDK build * macosx/Tcl-Common.xcconfig: config; remove tclMathOp.c. * macosx/README: document Tcl.xcodeproj changes. 2007-06-28 Don Porter * generic/tclBasic.c: Removed dead code, including the * generic/tclExecute.c: entire file tclMathOp.c. * generic/tclInt.h: * generic/tclMathOp.c (removed): * generic/tclTestObj.c: * win/tclWinFile.c: * unix/Makefile.in: Updated to reflect deletion of tclMathOp.c. * win/Makefile.in: * win/makefile.bc: * win/makefile.vc: 2007-06-28 Pat Thoyts * generic/tclBasic.c: Silence constness warnings for TclStackFree * generic/tclCompCmds.c: when building with msvc. * generic/tclFCmd.c: * generic/tclIOCmd.c: * generic/tclTrace.c: 2007-06-28 Miguel Sofer * generic/tclVar.c (UnsetVarStruct): fix possible segfault. 2007-06-27 Don Porter * generic/tclTrace.c: Corrected broken trace reversal logic in * generic/tclTest.c: TclCheckInterpTraces that led to infinite loop * tests/trace.test: when multiple Tcl_CreateTrace traces were set and one of them did not fire due to level restrictions. [Bug 1743931] 2007-06-26 Don Porter * generic/tclBasic.c (TclEvalEx): Moved some arrays from the C stack to the Tcl stack. 2007-06-26 Miguel Sofer * generic/tclVar.c (UnsetVarStruct): more streamlining. 2007-06-25 Don Porter * generic/tclExecute.c: Safety checks to avoid crashes in the TclStack* routines when called with an incompletely initialized interp. [Bug 1743302] 2007-06-25 Miguel Sofer * generic/tclVar.c (UnsetVarStruct): fixing incomplete change, more streamlining. 2007-06-24 Miguel Sofer * generic/tclVar.c (TclDeleteCompiledLocalVars): removed inlining that ended up not really optimising (limited benchmarks). Now calling UnsetVarStruct (streamlined old code is #ifdef'ed out, in case better benchmarks do show a difference). * generic/tclVar.c (UnsetVarStruct): fixed a leak introduced in last commit. 2007-06-23 Miguel Sofer * generic/tclVar.c (UnsetVarStruct, TclDeleteVars): made the logic slightly clearer, eliminated some duplicated code. *** POTENTIAL INCOMPATIBILITY *** (tclInt.h and Var struct users) The core never builds VAR_LINK variable to have traces. Such a "monster", should one exist, will now have its unset traces called *before* it is unlinked. 2007-06-23 Daniel Steffen * macosx/tclMacOSXNotify.c (AtForkChild): don't call CoreFoundation APIs after fork() on systems where that would lead to an abort(). 2007-06-22 Don Porter * generic/tclExecute.c: Revised TclStackRealloc() signature to better * generic/tclInt.h: parallel (and fall back on) Tcl_Realloc. * generic/tclNamesp.c (TclResetShadowesCmdRefs): Replaced ckrealloc based allocations with TclStackRealloc allocations. * generic/tclCmdIL.c: More conversions to use TclStackAlloc. * generic/tclScan.c: 2007-06-21 Don Porter * generic/tclBasic.c: Move most instances of the Tcl_Parse struct * generic/tclCompExpr.c: off the C stack and onto the Tcl stack. This * generic/tclCompile.c: is a rather large struct (> 3kB). * generic/tclParse.c: 2007-06-21 Miguel Sofer * generic/tclBasic.c (TEOvI): Made sure that leave traces * generic/tclExecute.c (INST_INVOKE): that were created during * tests/trace.test (trace-36.2): execution of an originally untraced command do not fire [Bug 1740962], partial fix. 2007-06-21 Donal K. Fellows * generic/tcl.h, generic/tclCompile.h, generic/tclCompile.c: Remove references in comments to obsolete {expand} notation. [Bug 1740859] 2007-06-20 Miguel Sofer * generic/tclVar.c: streamline namespace vars deletion: only compute the variable's full name if the variable is traced. 2007-06-20 Don Porter * generic/tclInt.decls: Revised the interfaces of the routines * generic/tclExecute.c: TclStackAlloc and TclStackFree to make them easier for callers to use (or more precisely, harder to misuse). TclStackFree now takes a (void *) argument which is the pointer intended to be freed. TclStackFree will panic if that's not actually the memory the call will free. TSA/TSF also now tolerate receiving (interp == NULL), in which case they simply fall back to be calls to Tcl_Alloc/Tcl_Free. * generic/tclIntDecls.h: make genstubs * generic/tclBasic.c: Updated callers * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCompCmds.c: * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclFCmd.c: * generic/tclFileName.c: * generic/tclIOCmd.c: * generic/tclIndexObj.c: * generic/tclInterp.c: * generic/tclNamesp.c: * generic/tclProc.c: * generic/tclTrace.c: * unix/tclUnixPipe.c: 2007-06-20 Jeff Hobbs * tools/tcltk-man2html.tcl: revamp of html doc output to use CSS, standardized headers, subheaders, dictionary sorting of names. 2007-06-18 Jeff Hobbs * tools/tcltk-man2html.tcl: clean up copyright merging and output. clean up coding constructs. 2007-06-18 Miguel Sofer * generic/tclCmdIL.c (InfoFrameCmd): * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): * generic/tclCompile.c (TclInitCompileEnv): * generic/tclProc.c (Tcl_ProcObjCmd, SetLambdaFromAny): Moved the CmdFrame off the C stack and onto the Tcl stack. * generic/tclExecute.c (TEBC): Moved the CmdFrame off the C stack and onto the Tcl stack, between the catch and the execution stacks 2007-06-18 Don Porter * generic/tclBasic.c (TclEvalEx,TclEvalObjEx): Moved the CmdFrame off the C stack and onto the Tcl stack. 2007-06-17 Donal K. Fellows * generic/tclProc.c (TclObjInterpProcCore): Minor fixes to make * generic/tclExecute.c (TclExecuteByteCode): compilation debugging builds work again. [Bug 1738542] 2007-06-16 Donal K. Fellows * generic/tclProc.c (TclObjInterpProcCore): Use switch instead of a chain of if's for a modest performance gain and a little more clarity. 2007-06-15 Miguel Sofer * generic/tclCompCmds.c: Simplified [variable] compiler and executor. * generic/tclExecute.c: Missed updates to "there is always a valid frame". * generic/tclCompile.c: reverted TclEvalObjvInternal and INST_INVOKE * generic/tclExecute.c: to essentially what they were previous to the * generic/tclBasic.c: commit of 2007-04-03 [Patch 1693802] and the subsequent optimisations, as they break the new trace tests described below. * generic/trace.test: added tests 36 to 38 for dynamic trace creation and addition. These tests expose a change in dynamics due to a recent round of optimisations. The "correct" behaviour is not described in docs nor TIP 62. 2007-06-14 Miguel Sofer * generic/tclInt.decls: Modif to the internals of TclObjInterpProc * generic/tclInt.h: to reduce stack consumption and improve task * generic/tclIntDecls.h: separation. Changes the interface of * generic/tclProc.c: TclObjInterpProcCore (patching TclOO simultaneously). * generic/tclProc.c (TclObjInterpProcCore): simplified obj management in wrongNumArgs calls. 2007-06-14 Don Porter * generic/tclCompile.c: SetByteCodeFromAny() can no longer return any * generic/tclExecute.c: code other than TCL_OK, so remove code that * generic/tclProc.c: formerly handled exceptional codes. 2007-06-13 Miguel Sofer * generic/tclExecute.c (TclCompEvalObj): missed update to "there is always a valid frame". * generic/tclProc.c (TclObjInterpProcCore): call TEBC directly instead of going through TclCompEvalObj - no need to check the compilation's freshness, this has already been done. This improves speed and should also provide some relief to [Bug 1066755]. 2007-06-12 Donal K. Fellows * generic/tclBasic.c (Tcl_CreateInterp): Turn the [info] command into * generic/tclCmdIL.c (TclInitInfoCmd): an ensemble, making it easier for third-party code to plug into. * generic/tclIndexObj.c (Tcl_WrongNumArgs): * generic/tclNamesp.c, generic/tclInt.h (tclEnsembleCmdType): Make Tcl_WrongNumArgs do replacement correctly with ensembles and other sorts of complex replacement strategies. 2007-06-11 Miguel Sofer * generic/tclExecute.c: comments added to explain iPtr->numLevels management. * generic/tclNamesp.c: tweaks to Tcl_GetCommandFromObj and * generic/tclObj.c: TclGetNamespaceFromObj; modified the usage of structs ResolvedCmdName and ResolvedNsname so that the field refNsPtr is NULL for fully qualified names. 2007-06-10 Miguel Sofer * generic/tclBasic.c: Further TEOvI split, creating a new * generic/tclCompile.h: TclEvalObjvKnownCommand() function to handle * generic/tclExecute.c: commands that are already known and are not traced. INST_INVOKE now calls into this function instead of inlining parts of TEOvI. Same perf, better isolation. ***POTENTIAL INCOMPAT*** There is a subtle issue with the timing of execution traces that is changed here - first change appeared in my commit of 2007-04-03 [Patch 1693802], which caused some divergence between compiled and non-compiled code. ***THIS CHANGE IS UNDER REVIEW*** 2007-06-10 Jeff Hobbs * README: updated links. [Bug 1715081] * generic/tclExecute.c (TclExecuteByteCode): restore support for INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 bytecodes to support 8.4- precompiled sources (math functions). [Bug 1720895] 2007-06-10 Miguel Sofer * generic/tclInt.h: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclvar.c: new macros TclGetCurrentNamespace() and TclGetGlobalNamespace(); Tcl_GetCommandFromObj and TclGetNamespaceFromObj rewritten to make the logic clearer; slightly faster too. 2007-06-09 Miguel Sofer * generic/tclExecute.c (INST_INVOKE): isolated two vars to the small block where they are actually used. * generic/tclObj.c (Tcl_GetCommandFromObj): rewritten to make the logic clearer; slightly faster too. * generic/tclBasic.c: Split TEOv in two, by separating a processor for non-TCL_OK returns. Also split TEOvI in a full version that handles non-existing and traced commands, and a separate shorter version for the regular case. * generic/tclBasic.c: Moved the generation of command strings for * generic/tclTrace.c: traces: previously in Tcl_EvalObjv(), now in TclCheck[Interp|Execution]Traces(). Also insured that the strings are properly NUL terminated at the correct length. [Bug 1693986] ***POTENTIAL INCOMPATIBILITY in internal API*** The functions TclCheckInterpTraces() and TclCheckExecutionTraces() (in internal stubs) used to be noops if the command string was NULL, this is not true anymore: if the command string is NULL, they generate an appropriate string from (objc,objv) and use it to call the traces. The caller might as well not call them with a NULL string if he was expecting a noop. * generic/tclBasic.c: Extend usage of TclLimitReady() and * generic/tclExecute.c: (new) TclLimitExceeded() macros. * generic/tclInt.h: * generic/tclInterp.c: * generic/tclInt.h: New TclCleanupCommandMacro for core usage. * generic/tclBasic.c: * generic/tclExecute.c: * generic/tclObj.c: 2007-06-09 Daniel Steffen * macosx/Tcl.xcodeproj/project.pbxproj: add new Tclsh-Info.plist.in. 2007-06-08 Donal K. Fellows * generic/tclCmdMZ.c (Tcl_StringObjCmd): Changed [string first] and * doc/string.n: [string last] so that they have clearer descriptions for those people who know the adage about needles and haystacks. This follows suggestions on comp.lang.tcl... 2007-06-06 Miguel Sofer * generic/tclParse.c: fix for uninit read. [Bug 1732414] 2007-06-06 Daniel Steffen * macosx/Tcl.xcodeproj/project.pbxproj: add settings for Fix&Continue. * unix/configure.in (Darwin): add plist for tclsh; link the * unix/Makefile.in (Darwin): Tcl and tclsh plists into * macosx/Tclsh-Info.plist.in (new): their binaries in all cases. * macosx/Tcl-Common.xcconfig: * unix/tcl.m4 (Darwin): fix CF checks in fat 32&64bit builds. * unix/configure: autoconf-2.59 2007-06-05 Don Porter * generic/tclBasic.c: Added interp flag value ERR_LEGACY_COPY to * generic/tclInt.h: control the timing with which the global * generic/tclNamesp.c: variables ::errorCode and ::errorInfo get * generic/tclProc.c: updated after an error. This keeps more * generic/tclResult.c: precise compatibility with Tcl 8.4. * tests/result.test (result-6.2): [Bug 1649062] 2007-06-05 Miguel Sofer * generic/tclInt.h: * generic/tclExecute.c: Tcl-stack reform, [Patch 1701202] 2007-06-03 Daniel Steffen * unix/Makefile.in: add datarootdir to silence autoconf-2.6x warning. 2007-05-30 Don Porter * generic/tclBasic.c: Removed code that dealt with * generic/tclCompile.c: TCL_TOKEN_EXPAND_WORD tokens representing * generic/tclCompile.h: expanded literal words. These sections were mostly in place to enable [info frame] to discover line information in expanded literals. Since the parser now generates a token for each post-expansion word referring to the right location in the original script string, [info frame] gets all the data it needs. * generic/tclInt.h: Revised the parser so that it never produces * generic/tclParse.c: TCL_TOKEN_EXPAND_WORD tokens when parsing an * tests/parse.test: expanded literal word; that is, something like {*}{x y z}. Instead, generate the series of TCL_TOKEN_SIMPLE_WORD tokens to represent the words that expansion of the literal string produces. [RFE 1725186] 2007-05-29 Jeff Hobbs * unix/tclUnixThrd.c (Tcl_JoinThread): fix for 64-bit handling of pthread_join exit return code storage. [Bug 1712723] 2007-05-22 Don Porter [core-stabilizer-branch] * unix/configure: autoconf-2.59 (FC6 fork) * win/configure: * README: Bump version number to 8.5b1 * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: 2007-05-18 Don Porter * unix/configure: autoconf-2.59 (FC6 fork) * win/configure: * README: Bump version number to 8.5a7 * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * generic/tclParse.c: Disable and remove the ALLOW_EXPAND sections * tests/info.test: that continued to support the deprecated * tests/mathop.test: {expand} syntax. Updated the few remaining users of that syntax in the test suite. 2007-05-17 Donal K. Fellows * generic/tclExecute.c (TclLimitReady): Created a macro version of Tcl_LimitReady just for TEBC, to reduce the amount of times that the bytecode engine calls out to external functions on the critical path. * generic/tclInterp.c (Tcl_LimitReady): Added note to remind anyone doing maintenance that there is a macro version to update. 2007-05-17 Daniel Steffen * generic/tcl.decls: workaround 'make checkstubs' failures from tclStubLib.c MODULE_SCOPE revert. [Bug 1716117] 2007-05-16 Joe English * generic/tclStubLib.c: Change Tcl_InitStubs(), tclStubsPtr, and the auxilliary stubs table pointers back to public visibility. These symbols need to be exported so that stub-enabled extensions may be statically linked into an extended tclsh or Big Wish with a dynamically-linked libtcl. [Bug 1716117] 2007-05-15 Don Porter * win/configure: autoconf-2.59 (FC6 fork) * library/reg/pkgIndex.tcl: Bump to registry 1.2.1 to account for * win/configure.in: [Bug 1682211] fix. * win/makefile.bc: * win/tclWinReg.c: 2007-05-11 Pat Thoyts * generic/tclInt.h: Removed TclEvalObjEx and TclGetSrcInfoForPc from tclInt.h now they are in the internal stubs table. 2007-05-09 Don Porter * generic/tclInt.h: TclFinalizeThreadAlloc() is always defined, so make sure it is also always declared (with MODULE_SCOPE). 2007-05-09 Daniel Steffen * generic/tclInt.h: fix warning when building threaded with -DPURIFY. * macosx/Tcl.xcodeproj/project.pbxproj: add 'DebugUnthreaded' & * macosx/Tcl.xcodeproj/default.pbxuser: 'DebugLeaks' configs and env var settings needed to run the 'leaks' tool. 2007-05-07 Don Porter [Tcl Bug 1706140] * generic/tclLink.c (LinkTraceProc): Update Tcl_VarTraceProcs so * generic/tclNamesp.c (Error*Read): they call Tcl_InterpDeleted() * generic/tclTrace.c (Trace*Proc): for themselves, and do not * generic/tclUtil.c (TclPrecTraceProc): rely on (frequently buggy) setting of the TCL_INTERP_DESTROYED flag by the trace core. * generic/tclVar.c: Update callers of TclCallVarTraces to not pass in the TCL_INTERP_DESTROYED flag. Also apply filters so that public routines only pass documented flag values down to lower level routines * generic/tclTrace.c (TclCallVarTraces): The setting of the TCL_INTERP_DESTROYED flag is now done entirely within the TclCallVarTraces routine, the only place it can be done right. 2007-05-06 Donal K. Fellows * generic/tclInt.h (ExtraFrameInfo): Create a new mechanism for * generic/tclCmdIL.c (InfoFrameCmd): conveying what information needs to be added to the results of [info frame] to replace the hack that was there before. * generic/tclProc.c (Tcl_ApplyObjCmd): Use the new mechanism for the [apply] command, the only part of Tcl itself that needs it (so far). * generic/tclInt.decls (TclEvalObjEx, TclGetSrcInfoForPc): Expose these two functions through the internal stubs table, necessary for extensions that need to integrate deeply with TIP#280. 2007-05-05 Donal K. Fellows * win/tclWinFile.c (TclpGetUserHome): Squelch type-pun warnings in * win/tclWinInit.c (TclpSetVariables): Win-specific code not found * win/tclWinReg.c (AppendSystemError): during earlier work on Unix. 2007-05-04 Kevin B. Kenny * generic/tclIO.c (TclFinalizeIOSubsystem): Added an initializer to silence a spurious gcc warning about use of an uninitialized variable. * tests/encoding.test: Modified so that encoding tests happen in a private namespace, to avoid polluting the global one. This problem was discovered when running the test suite '-singleproc 1 -skip exec.test' because the 'path' variable in encoding.test conflicted with the one in io.test. * tests/io.test: Made more of the working variables private to the namespace. 2007-05-02 Kevin B. Kenny * generic/tclTest.c (SimpleMatchInDirectory): Corrected a refcount imbalance that affected the filesystem-[147]* tests in the test suite. Thanks to Don Porter for the patch. [Bug 1710707] * generic/tclPathObj.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath): Corrected several memory leaks that caused refcount imbalances resulting in memory leaks on Windows. Thanks to Joe Mistachkin for the patch. 2007-05-01 Miguel Sofer * generic/tclVar.c (TclPtrSetVar): fixed leak whenever newvaluePtr had refCount 0 and was used for appending (but not lappending). Thanks to mistachkin and kbk. [Bug 1710710] 2007-05-01 Kevin B. Kenny * generic/tclIO.c (DeleteChannelTable): Made changes so that DeleteChannelTable tries to close all open channels, not just the first. [Bug 1710285] * generic/tclThread.c (TclFinalizeSynchronization): Make sure that TSD blocks get freed on non-threaded builds. [Bug 1710825] * tests/utf.test (utf-25.1--utf-25.4): Modified tests to clean up after the 'testobj' extension to avoid spurious reports of memory leaks. 2007-05-01 Don Porter * generic/tclCmdMZ.c (STR_MAP): When [string map] has a pure dict map, a missing Tcl_DictObjDone() call led to a memleak. [Bug 1710709] 2007-04-30 Daniel Steffen * unix/Makefile.in: add 'tclsh' dependency to install targets that rely on tclsh, fixes parallel 'make install' from empty build dir. 2007-04-30 Andreas Kupries * generic/tclIO.c (FixLevelCode): Corrected reference count mismanagement of newlevel, newcode. Changed to allocate the Tcl_Obj's as late as possible, and only when actually needed. [Bug 1705778, leak K29] 2007-04-30 Kevin B. Kenny * generic/tclProc.c (Tcl_ProcObjCmd, SetLambdaFromAny): Corrected reference count mismanagement on the name of the source file in the TIP 280 code. [Bug 1705778, leak K02 among other manifestations] 2007-04-25 Donal K. Fellows *** 8.5a6 TAGGED FOR RELEASE *** * generic/tclProc.c (TclObjInterpProcCore): Only allocate objects for error message generation when associated with argument names that are really used. [Bug 1705778, leak K15] 2007-04-25 Kevin B. Kenny * generic/tclIOUtil.c (Tcl_FSChdir): Changed the memory management so that the path returned from Tcl_FSGetNativePath is not duplicated before being stored as the current directory, to avoid a memory leak. [Bug 1705778, leak K01 among other manifestations] 2007-04-25 Don Porter * generic/tclCompExpr.c (ParseExpr): Revised to be sure that an error return doesn't prevent all literals getting placed on the litList to be returned to the caller for freeing. Corrects some memleaks. [Bug 1705778, leak K23] 2007-04-25 Daniel Steffen * unix/Makefile.in (dist): add macosx/*.xcconfig files to src dist; copy license.terms to dist macosx dir; fix autoheader bits. 2007-04-24 Miguel Sofer * generic/tclListObj.c: reverting [Patch 738900] (committed on 2007-04-20). Causes some Tk test breakage of unknown importance, but the impact of the patch itself is likely to be so small that it does not warrant investigation at this time. 2007-04-24 Donal K. Fellows * generic/tclDictObj.c (DictKeysCmd): Rewrote so that the lock on the internal representation of a dict is only set when necessary. [Bug 1705778, leak K04] (DictFilterCmd): Added code to drop the lock in the trivial match case. [Bug 1705778, leak K05] 2007-04-24 Kevin B. Kenny * generic/tclBinary.c: Addressed several code paths where the error return from the 'binary format' command leaked the result buffer. * generic/tclListObj.c (TclLsetFlat): Fixed a bug where the new list under construction was leaked in the error case. [Bug 1705778, leaks K13 and K14] 2007-04-24 Jeff Hobbs * unix/Makefile.in (dist): add platform library package to src dist 2007-04-24 Don Porter * generic/tclCompExpr.c (ParseExpr): Memory leak in error case; the literal Tcl_Obj was not getting freed. [Bug 1705778, leak #1 (new)] * generic/tclNamesp.c (Tcl_DeleteNamespace): Corrected flaw in the flag marking scheme to be sure that global namespaces are freed when their interp is deleted. [Bug 1705778] 2007-04-24 Kevin B. Kenny * generic/tclExecute.c (TclExecuteByteCode): Plugged six memory leaks in bignum arithmetic. * generic/tclIOCmd.c (Tcl_ReadObjCmd): Plugged a leak of the buffer object if the physical read returned an error and the bypass area had no message. * generic/tclIORChan.c (TclChanCreateObjCmd): Plugged a leak of the return value from the "initialize" method of a channel handler. (All of the above under [Bug 1705778]) 2007-04-23 Daniel Steffen * generic/tclCkalloc.c: fix warnings from gcc build configured with * generic/tclCompile.c: --enable-64bit --enable-symbols=all. * generic/tclExecute.c: * unix/tclUnixFCmd.c: add workaround for crashing bug in fts_open() * unix/tclUnixInit.c: without FTS_NOSTAT on 64bit Darwin 8 or earlier. * unix/tclLoadDyld.c (TclpLoadMemory): fix (void*) arithmetic. * macosx/Tcl-Common.xcconfig: enable more warnings. * macosx/Tcl.xcodeproj/project.pbxproj: add 'DebugMemCompile' build configuration that calls configure with --enable-symbols=all; override configure check for __attribute__((__visibility__("hidden"))) in Debug configuration to restore availability of ZeroLink. * macosx/tclMacOSXNotify.c: fix warnings. * macosx/tclMacOSXFCmd.c: const fixes. * macosx/Tcl-Common.xcconfig: fix whitespace. * macosx/Tcl-Debug.xcconfig: * macosx/Tcl-Release.xcconfig: * macosx/README: * macosx/GNUmakefile: fix/add copyright and license refs. * macosx/tclMacOSXBundle.c: * macosx/Tcl-Info.plist.in: * macosx/Tcl.xcode/project.pbxproj: * macosx/Tcl.xcodeproj/project.pbxproj: * unix/configure.in: install license.terms into Tcl.framework. * unix/configure: autoconf-2.59 2007-04-23 Don Porter * generic/tclVar.c (UnsetVarStruct): Make sure the TCL_INTERP_DESTROYED flags gets passed to unset trace routines so they can respond appropriately. [Bug 1705778, leak #9] 2007-04-23 Miguel Sofer * generic/tclCompile.c (TclFreeCompileEnv): Tip 280's new field extCmdMapPtr was not being freed. [Bug 1705778, leak #1] 2007-04-23 Kevin B. Kenny * generic/tclCompCmds.c (TclCompileUpvarCmd): Plugged a memory leak in 'upvar' when compiling (a) upvar outside a proc, (b) upvar with a syntax error, or (c) upvar where the frame index is not known at compile time. * generic/tclCompExpr.c (ParseExpr): Plugged a memory leak when parsing expressions that contain syntax errors. * generic/tclEnv.c (ReplaceString): Clear memory correctly when growing the cache to avoid reads of uninitialised data. * generic/tclIORChan.c (TclChanCreateObjCmd, FreeReflectedChannel): Plugged two memory leaks. * generic/tclStrToD.c (AccumulateDecimalDigit): Fixed a mistake where we'd run beyond the end of the 'pow10_wide' array if a number begins with a string of more than 'maxpow10_wide' zeroes. * generic/tclTest.c (Testregexpobjcmd): Removed an invalid access beyond the end of 'objv' in 'testregexp -about'. All of these issues reported under [Bug 1705778] - detected with the existing test suite, no new regression tests required. 2007-04-22 Miguel Sofer * generic/tclVar.c (TclDeleteNamespaceVars): fixed access to freed memory detected by valgrind: Tcl_GetCurrentNamespace was being called after freeing root CallFrame (on interp deletion). 2007-04-20 Miguel Sofer * generic/tclListObj.c (SetListFromAny): avoid discarding internal reps of objects converted to singleton lists. [Patch 738900] 2007-04-20 Kevin B. Kenny * doc/clock.n: Corrected a silly error (transposed 'uppercase' and 'lowercase' in clock.n. [Bug 1656002] Clarified that [clock scan] does not recognize a locale's alternative calendar. Deleted an entirely superfluous (and also incorrect) remark about the effect of Daylight Saving Time on relative times in [clock scan]. [Bug 1582951] * library/clock.tcl: Corrected an error in skipping over the %Ey field on input. * library/msgs/ja.msg: * tools/loadICU.tcl: Corrected several localisation faults in the Japanese locale (most notably, incorrect dates for the Emperors' eras). Many thanks to SourceForge user 'nyademo' for pointing this out and developing a fix. [Bug 1637471] * generic/tclPathObj.c: Corrected a 'const'ness fault that caused bitter complaints from MSVC. * tests/clock.test (clock-40.1, clock-58.1, clock-59.1): Corrected a test case that depended on ":localtime" being able to handle dates prior to the Posix epoch. [Bug 1618445] Added a test case for the dates of the Japanese emperors. [Bug 1637471] Added a regression test for military time zone input conversion. [Bug 1586828] * generic/tclGetDate.y (MilitaryTable): Fixed an ancient bug where the military NZA time zones had the signs reversed. [Bug 1586828] * generic/tclDate.c: Regenerated. * doc/Notifier.3: Documented Tcl_SetNotifier and Tcl_ServiceModeHook. Quite against my better judgment. [Bug 414933] * generic/tclBasic.c, generic/tclCkalloc.c, generic/tclClock.c: * generic/tclCmdIL.c, generic/tclCmdMZ.c, generic/tclFCmd.c: * generic/tclFileName.c, generic/tclInterp.c, generic/tclIO.c: * generic/tclIOUtil.c, generic/tclNamesp.c, generic/tclObj.c: * generic/tclPathObj.c, generic/tclPipe.c, generic/tclPkg.c: * generic/tclResult.c, generic/tclTest.c, generic/tclTestObj.c: * generic/tclVar.c, unix/tclUnixChan.c, unix/tclUnixTest.c: * win/tclWinLoad.c, win/tclWinSerial.c: Replaced commas in varargs with string concatenation where possible. [Patch 1515234] * library/tzdata/America/Tegucigalpa: * library/tzdata/Asia/Damascus: Olson's tzdata 2007e. 2007-04-19 Donal K. Fellows * generic/regcomp.c, generic/regc_cvec.c, generic/regc_lex.c, * generic/regc_locale.c: Improve the const-correctness of the RE compiler. 2007-04-18 Miguel Sofer * generic/tclExecute.c (INST_LSHIFT): fixed a mistake introduced in version 1.266 ('=' became '=='), which effectively turned the block that handles native shifts into dead code. This explains why the testsuite did not pick this mistake. Rewrote to make the intention clear. * generic/tclInt.h (TclDecrRefCount): change the order of the branches, use empty 'if ; else' to handle use in unbraced outer if/else conditions (as already done in tcl.h) * generic/tclExecute.c: slight changes in Tcl_Obj management. 2007-04-17 Kevin B. Kenny * library/clock.tcl: Fixed the naming of ::tcl::clock::ReadZoneinfoFile because (yoicks!) it was in the global namespace. * doc/clock.n: Clarified the cases in which legacy time zone is recognized. [Bug 1656002] 2007-04-17 Miguel Sofer * generic/tclExecute.c: fixed checkInterp logic [Bug 1702212] 2007-04-16 Donal K. Fellows * various (including generic/tclTest.c): Complete the purge of K&R function definitions from manually-written code. 2007-04-15 Kevin B. Kenny * generic/tclCompCmds.c: added a cast to silence a compiler error on VC2005. * library/clock.tcl: Restored unique-prefix matching of keywords on the [clock] command. [Bug 1690041] * tests/clock.test: Added rudimentary test cases for unique-prefix matching of keywords. 2007-04-14 Miguel Sofer * generic/tclExecute.c: removed some code at INST_EXPAND_SKTOP that duplicates functionality already present at checkForCatch. 2007-04-12 Miguel Sofer * generic/tclExecute.c: new macros OBJ_AT_TOS, OBJ_UNDER_TOS, OBJ_AT_DEPTH(n) and CURR_DEPTH that remove all direct references to tosPtr from TEBC (after initialisation and the code at the label cleanupV_pushObjResultPtr). 2007-04-11 Miguel Sofer * generic/tclCompCmds.c: moved all exceptDepth management to the macros - the decreasing half was managed by hand. 2007-04-10 Donal K. Fellows * generic/tclInt.h (TclNewLiteralStringObj): New macro to make allocating literal string objects (i.e. objects whose value is a constant string) easier and more efficient, by allowing the omission of the length argument. Based on [Patch 1529526] (afredd) * generic/*.c: Make use of this (in many files). 2007-04-08 Miguel Sofer * generic/tclCompile (tclInstructionTable): Fixed bugs in description of dict instructions. 2007-04-07 Miguel Sofer * generic/tclCompile (tclInstructionTable): Fixed bug in description of INST_START_COMMAND. * generic/tclExecute.c (TEBC): Small code reduction. 2007-04-06 Miguel Sofer * generic/tclExecute.c (TEBC): * generic/tclNamespace.c (NsEnsembleImplementationCmd): * generic/tclProc.c (InitCompiledLocals, ObjInterpProcEx) (TclObjInterpProcCore, ProcCompileProc): Code reordering to reduce branching and improve branch prediction (assume that forward branches are typically not taken). 2007-04-03 Miguel Sofer * generic/tclExecute.c: INST_INVOKE optimisation. [Patch 1693802] 2007-04-03 Don Porter * generic/tclNamesp.c: Revised ErrorCodeRead and ErrorInfoRead trace routines so they guarantee the ::errorCode and ::errorInfo variable always appear to exist. [Bug 1693252] 2007-04-03 Miguel Sofer * generic/tclInt.decls: Moved TclGetNamespaceFromObj() to the * generic/tclInt.h: internal stubs table; regen. * generic/tclIntDecls.h: * generic/tclStubInit.c: 2007-04-02 Miguel Sofer * generic/tclBasic.c: Added bytecode compilers for the variable * generic/tclCompCmds.c: linking commands: 'global', 'variable', * generic/tclCompile.h: 'upvar', 'namespace upvar' [Patch 1688593] * generic/tclExecute.c: * generic/tclInt.h: * generic/tclVar.c: 2007-04-02 Don Porter * generic/tclBasic.c: Replace arrays on the C stack and ckalloc * generic/tclExecute.c: calls with TclStackAlloc calls to use memory * generic/tclFCmd.c: on Tcl's evaluation stack. * generic/tclFileName.c: * generic/tclIOCmd.c: * generic/tclIndexObj.c: * generic/tclInterp.c: * generic/tclNamesp.c: * generic/tclTrace.c: * unix/tclUnixPipe.c: 2007-04-01 Donal K. Fellows * generic/tclCompile.c (TclCompileScript, TclPrintInstruction): * generic/tclExecute.c (TclExecuteByteCode): Changed the definition of INST_START_CMD so that it knows how many commands start at the current location. This makes the interpreter command counter correct without requiring a large number of instructions to be issued. (See my change from 2007-01-19 for what triggered this.) 2007-03-30 Don Porter * generic/tclCompile.c: * generic/tclCompExpr.c: * generic/tclCompCmds.c: Replace arrays on the C stack and ckalloc calls with TclStackAlloc calls to use memory on Tcl's evaluation stack. * generic/tclCmdMZ.c: Revised [string to* $s $first $last] implementation to reduce number of allocs/copies. * tests/string.test: More [string reverse] tests. 2007-03-30 Miguel Sofer * generic/tclExecute.c: optimise the lookup of elements of indexed arrays. 2007-03-29 Miguel Sofer * generic/tclProc.c (Tcl_ApplyObjCmd): * tests/apply.test (9.3): Fixed Tcl_Obj leak on error return; an unneeded ref to lambdaPtr was being set and not released on an error return path. 2007-03-28 Don Porter * generic/tclCmdMZ.c (STR_REVERSE): Implement the actual [string reverse] command in terms of the new TclStringObjReverse() routine. * generic/tclInt.h (TclStringObjReverse): New internal routine * generic/tclStringObj.c (TclStringObjReverse): that implements the [string reverse] operation, making use of knowledge/surgery of the String intrep to minimize the number of allocs and copies needed to do the job. 2007-03-27 Don Porter * generic/tclCmdMZ.c (STR_MAP): Replace ckalloc calls with TclStackAlloc calls. 2007-03-24 Zoran Vasiljevic * win/tclWinThrd.c: Thread exit handler marks the current thread as uninitialized. This allows exit handlers that are registered later to reinitialize this subsystem in case they need to use some sync primitives (cond variables) from this file again. 2007-03-23 Miguel Sofer * generic/tclBasic.c (DeleteInterpProc): pop the root frame pointer before deleting the global namespace [Bug 1658572] 2007-03-23 Kevin B. Kenny * win/Makefile.in: Added code to keep a Cygwin path name from leaking into LIBRARY_DIR when doing 'make test' or 'make runtest'. 2007-03-22 Don Porter * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Replaced arrays on the C stack and ckalloc calls with TclStackAlloc calls to use memory on Tcl's evaluation stack. * generic/tclExecute.c: Revised GrowEvaluationStack to take an argument specifying the growth required by the caller, so that a single reallocation / copy is the most that will ever be needed even when required growth is large. 2007-03-21 Don Porter * generic/tclExecute.c: More ckalloc -> ckrealloc conversions. * generic/tclLiteral.c: * generic/tclNamesp.c: * generic/tclParse.c: * generic/tclPreserve.c: * generic/tclStringObj.c: * generic/tclUtil.c: 2007-03-20 Don Porter * generic/tclEnv.c: Some more ckalloc -> ckrealloc replacements. * generic/tclLink.c: 2007-03-20 Kevin B. Kenny * generic/tclDate.c: Rebuilt, despite Donal Fellows's comment when committing it that no rebuild was required. * generic/tclGetDate.y: According to Donal Fellows, "Introduce modern formatting standards; no need for rebuild of tclDate.c." * library/tzdata/America/Cambridge_Bay: * library/tzdata/America/Havana: * library/tzdata/America/Inuvik: * library/tzdata/America/Iqaluit: * library/tzdata/America/Pangnirtung: * library/tzdata/America/Rankin_Inlet: * library/tzdata/America/Resolute: * library/tzdata/America/Yellowknife: * library/tzdata/Asia/Choibalsan: * library/tzdata/Asia/Dili: * library/tzdata/Asia/Hovd: * library/tzdata/Asia/Jakarta: * library/tzdata/Asia/Jayapura: * library/tzdata/Asia/Makassar: * library/tzdata/Asia/Pontianak: * library/tzdata/Asia/Ulaanbaatar: * library/tzdata/Europe/Istanbul: Upgraded to Olson's tzdata2007d. * generic/tclListObj.c (TclLsetList, TclLsetFlat): * tests/lset.test: Changes to deal with shared internal representation for lists passed to the [lset] command. Thanks to Don Porter for fixing this issue. [Bug 1677512] 2007-03-19 Don Porter * generic/tclCompile.c: Revise the various expansion routines for CompileEnv fields to use ckrealloc() where appropriate. * generic/tclBinary.c (Tcl_SetByteArrayLength): Replaced ckalloc() / memcpy() sequence with ckrealloc() call. * generic/tclBasic.c (Tcl_CreateMathFunc): Replaced some calls to * generic/tclEvent.c (Tcl_CreateThread): Tcl_Alloc() with calls * generic/tclObj.c (UpdateStringOfBignum): to ckalloc(), which * unix/tclUnixTime.c (SetTZIfNecessary): better supports memory * win/tclAppInit.c (setargv): debugging. 2007-03-19 Donal K. Fellows * doc/regsub.n: Corrected example so that it doesn't recommend potentially unsafe practice. Many thanks to Konstantin Kushnir for reporting this. 2007-03-17 Kevin B. Kenny * win/tclWinReg.c (GetKeyNames): Size the buffer for enumerating key names correctly, so that Unicode names exceeding 127 chars can be retrieved without crashing. [Bug 1682211] * tests/registry.test (registry-4.9): Added test case for the above bug. 2007-03-15 Mo DeJong * generic/tclIOUtil.c (Tcl_Stat): Reimplement workaround to avoid gcc warning by using local variables. When the macro argument is of type long long instead of long, the incorrect warning is not generated. 2007-03-15 Mo DeJong * win/Makefile.in: Fully qualify LIBRARY_DIR so that `make test` does not depend on working dir. 2007-03-15 Mo DeJong * tests/parse.test: Add two backslash newline parse tests. 2007-03-12 Don Porter * generic/tclExecute.c (INST_FOREACH_STEP4): Make private copy of * tests/foreach.test (foreach-10.1): value list to be assigned to variables so that shimmering of that list doesn't lead to invalid pointers. [Bug 1671087] * generic/tclEvent.c (HandleBgErrors): Make efficient private copy * tests/event.test (event-5.3): of the command prefix for the interp's background error handling command to avoid panics due to pointers to memory invalid after shimmering. [Bug 1670155] * generic/tclNamesp.c (NsEnsembleImplementationCmd): Make efficient * tests/namespace.test (namespace-42.8): private copy of the command prefix as we invoke the command appropriate to a particular subcommand of a particular ensemble to avoid panic due to shimmering of the List intrep. [Bug 1670091] * generic/tclVar.c (TclArraySet): Make efficient private copy of * tests/var.test (var-17.1): the "list" argument to [array set] to avoid crash due to shimmering invalidating pointers. [Bug 1669489] 2007-03-12 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix problems with declaration positioning and memory leaks. [Bug 1679072] 2007-03-11 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LreverseObjCmd): Ensure that a list is correctly reversed even if its internal representation is shared without the object itself being shared. [Bug 1675044] 2007-03-10 Miguel Sofer * generic/tclCmdIL (Tcl_LsortObjCmd): changed fix to [Bug 1675116] to use the cheaper TclListObjCopy() instead of Tcl_DuplicateObj(). 2007-03-09 Andreas Kupries * library/platform/shell.tcl: Made more robust if an older platform * library/platform/pkgIndex.tcl: package is present in the inspected * unix/Makefile.in: shell. Package forget it to prevent errors. Bumped * win/Makefile.in: package version to 1.1.3, and updated the Makefiles installing it as Tcl Module. 2007-03-09 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LsortObjCmd): Handle tricky case with loss * tests/cmdIL.test (cmdIL-1.29): of list rep during sorting due to shimmering. [Bug 1675116] 2007-03-09 Kevin B. Kenny * library/clock.tcl (ReadZoneinfoFile): Added Y2038 compliance to the code for version-2 'zoneinfo' files. * tests/clock.test (clock-56.3): Added a test case for Y2038 and 'zoneinfo'. Modified test initialisation to use the 'loadTestedCommands' function of tcltest to bring in the correct path for the registry library. 2007-03-08 Don Porter * generic/tclListObj.c (TclLsetList): Rewrite so that the routine itself does not do any direct intrep surgery. Better isolates those things into the implementation of the "list" Tcl_ObjType. 2007-03-08 Donal K. Fellows * generic/tclListObj.c (TclLindexList, TclLindexFlat): Moved these functions to tclListObj.c from tclCmdIL.c to mirror the way that the equivalent functions for [lset]'s guts are arranged. 2007-03-08 Kevin B. Kenny * library/clock.tcl: Further tweaks to the Windows time zone table (restoring missing Mexican time zones). Added rudimentary handling of version-2 'zoneinfo' files. Update US DST rules so that zones such as 'EST5EDT' get the correct transition dates. * tests/clock.test: Added rudimentary test cases for 'zoneinfo' parsing. Adjusted several tests that depended on obsolete US DST transition rules. 2007-03-07 Daniel Steffen * macosx/tclMacOSXNotify.c: add spinlock debugging and sanity checks. * macosx/Tcl.xcodeproj/project.pbxproj: ensure gcc version used by * macosx/Tcl.xcodeproj/default.pbxuser: Xcode and configure/make are * macosx/Tcl-Common.xcconfig: consistent and independent of gcc_select default and CC env var; fixes for Xcode 3.0. * unix/tcl.m4 (Darwin): s/CFLAGS/CPPFLAGS/ in macosx-version-min check * unix/configure: autoconf-2.59 2007-03-07 Don Porter * generic/tclCmdIL.c (TclLindex*): Rewrites to make efficient private copies of the list and indexlist arguments, so we can operate on the list elements directly with no fear of shimmering effects. Replaces defensive coding schemes that are otherwise required. End result is that TclLindexList is entirely a wrapper around TclLindexFlat, which is now the core engine of all [lindex] operations. * generic/tclObj.c (Tcl_AppendAllObjTypes): Converted to simpler list validity test. 2007-03-07 Donal K. Fellows * generic/tclRegexp.c (TclRegAbout): Generate information about a regexp as a Tcl_Obj instead of as a string, which is more efficient. 2007-03-07 Kevin B. Kenny * library/clock.tcl: Adjusted Windows time zone table to handle new US DST rules by locale rather than as Posix time zone spec. * tests/clock.test (clock-39.6, clock-49.2, testclock::registry): Adjusted tests to simulate new US rules. * library/tzdata/America/Indiana/Winamac: * library/tzdata/Europe/Istanbul: * library/tzdata/Pacific/Easter: Olson's tzdata2007c. 2007-03-05 Andreas Kupries * library/platform/shell.tcl (::platform::shell::RUN): In the case of * library/platform/pkgIndex.tcl: a failure put the captured stderr * unix/Makefile.in: into the error message to aid in debugging. Bumped * win/Makefile.in: package version to 1.1.2, and updated the makefiles installing it as Tcl Module. 2007-03-03 Donal K. Fellows * generic/tclLink.c (LinkedVar): Added macro to conceal at least some of the pointer hackery. 2007-03-02 Don Porter * generic/tclCmdIL.c (Tcl_LreverseObjCmd): Added missing TclInvalidateStringRep() call when we directly manipulate the intrep of an unshared "list" Tcl_Obj. [Bug 1672585] * generic/tclCmdIL.c (Tcl_JoinObjCmd): Revised [join] implementation to append Tcl_Obj's instead of strings. [RFE 1669420] * generic/tclCmdIL.c (Info*Cmd): Code simplifications and optimizations. 2007-03-02 Donal K. Fellows * generic/tclCompile.c (TclPrintInstruction): Added a scheme to allow * generic/tclCompile.h (AuxDataPrintProc): aux-data to be printed * generic/tclCompCmds.c (Print*Info): out for debugging. For this to work, immediate operands referring to aux-data must be identified as such in the instruction descriptor table using OPERAND_AUX4 (all are always 4 bytes). * generic/tclExecute.c (TclExecuteByteCode): Rewrote the compiled * generic/tclCompCmds.c (TclCompileDictCmd): [dict update] so that it * generic/tclCompile.h (DictUpdateInfo): stores critical * tests/dict.test (dict-21.{14,15}): non-varying data in an aux-data value instead of a (shimmerable) literal. [Bug 1671001] 2007-03-01 Don Porter * generic/tclCmdIL.c (Tcl_LinsertObjCmd): Code simplifications and optimizations. * generic/tclCmdIL.c (Tcl_LreplaceObjCmd): Code simplifications and optimizations. * generic/tclCmdIL.c (Tcl_LrangeObjCmd): Rewrite in the same spirit; avoid shimmer effects rather than react to them. * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stop throwing away * tests/foreach.test (foreach-1.14): useful error information when loop variable sets fail. * generic/tclCmdIL.c (Tcl_LassignObjCmd): Rewrite to make an efficient private copy of the list argument, so we can operate on the list elements directly with no fear of shimmering effects. Replaces defensive coding schemes that are otherwise required. * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Rewrite to make efficient private copies of the variable and value lists, so we can operate on them without any special shimmer defense coding schemes. 2007-03-01 Donal K. Fellows * generic/tclCompCmds.c (TclCompileForeachCmd): Prevent an unexpected * tests/foreach.test (foreach-9.1): infinite loop when the variable list is empty and the foreach is compiled. [Bug 1671138] 2007-02-26 Andreas Kupries * generic/tclIORChan.c (FreeReflectedChannel): Added the missing refcount release between NewRC and FreeRC for the channel handle object, spotted by Don Porter. [Bug 1667990] 2007-02-26 Don Porter * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Removed surplus copying of the objv array that used to be a workaround for [Bug 404865]. That bug is long fixed. 2007-02-24 Don Porter * generic/tclBasic.c: Use new interface in Tcl_EvalObjEx so that the recounting logic of the List internal rep need not be repeated there. Better encapsulation of internal details. * generic/tclInt.h: New internal routine TclListObjCopy() used * generic/tclListObj.c: to efficiently do the equivalent of [lrange $list 0 end]. After some experience with this, might be a good candidate for exposure as a public interface. It's useful for callers of Tcl_ListObjGetElements() who want to control the ongoing validity of the returned objv pointer. 2007-02-22 Andreas Kupries * tests/pkg.test: Added tests for the case of an alpha package satisfying a require for the regular package, demonstrating a corner case specified in TIP#280. More notes in the comments to the test. 2007-02-20 Jan Nijtmans * generic/tclInt.decls: Added "const" specifiers in TclSockGetPort * generic/tclIntDecls.h: regenerated * generic/*.c: * unix/tclUnixChan.c * unix/tclUnixPipe.c * win/tclWinPipe.c * win/tclWinSock.c: Added many "const" specifiers in implementation. 2007-02-20 Don Porter * doc/tcltest.n: Typo fix. [Bug 1663539] 2007-02-20 Pat Thoyts * generic/tclFileName.c: Handle extended paths on Windows NT and * generic/tclPathObj.c: above. These have a \\?\ prefix. [Bug * win/tclWinFile.c: 1479814] * tests/winFCmd.test: Tests for extended path handling. 2007-02-19 Jeff Hobbs * unix/tcl.m4: use SHLIB_SUFFIX=".so" on HP-UX ia64 arch. * unix/configure: autoconf-2.59 * generic/tclIOUtil.c (Tcl_FSEvalFileEx): safe incr of objPtr ref. 2007-02-18 Donal K. Fellows * doc/chan.n, doc/clock.n, doc/eval.n, doc/exit.n, doc/expr.n: * doc/interp.n, doc/open.n, doc/platform_shell.n, doc/pwd.n: * doc/refchan.n, doc/regsub.n, doc/scan.n, doc/tclvars.n, doc/tm.n: * doc/unload.n: Apply [Bug 1610310] to fix typos. Thanks to Larry Virden for spotting them. * doc/interp.n: Partial fix of [Bug 1662436]; rest requires some policy decisions on what should and shouldn't be safe commands from the "new in 8.5" set. 2007-02-13 Kevin B. Kenny * tools/fix_tommath_h.tcl: Further tweaking for the x86-64. The change is to make 'mp_digit' be an 'unsigned int' on that platform; since we're using only 32 bits of it, there's no reason to make it a 64-bit 'unsigned long.' * generic/tclTomMath.h: Regenerated. 2007-02-13 Donal K. Fellows * doc/re_syntax.n: Corrected description of 'print' class [Bug 1614687] and enhanced description of 'graph' class. 2007-02-12 Kevin B. Kenny * tools/fix_tommath_h.tcl: Added code to patch out a check for __x86_64__ that caused Tommath to use __attributes(TI)__ for the mp_word type. Tetra-int's simply fail on too many gcc-glibc-OS combinations to be ready for shipment today, even if they work for some of us. This change allows reversion of das's change of 2006-08-18 that accomplised the same thing on Darwin. [Bugs 1601380, 1603737, 1609936, 1656265] * generic/tclTomMath.h: Regenerated. * library/tzdata/Africa/Asmara: * library/tzdata/Africa/Asmera: * library/tzdata/America/Nassau: * library/tzdata/Atlantic/Faeroe: * library/tzdata/Atlantic/Faroe: * library/tzdata/Australia/Eucla: * library/tzdata/Pacific/Easter: Rebuilt from Olson's tzdata2007b. 2007-02-09 Joe Mistachkin * win/nmakehlp.c: Properly cleanup after nmakehlp, including the * win/makefile.vc: vcX0.pch file. 2007-02-08 Jeff Hobbs * unix/tclUnixInit.c (TclpCheckStackSpace): do stack size checks with unsigned size_t to correctly validate stackSize in the 2^31+ range. [Bug 1654104] 2007-02-08 Don Porter * generic/tclNamesp.c: Corrected broken logic in Tcl_DeleteNamespace * tests/namespace.test: introduced in Patch 1577278 that caused [namespace delete ::] to be effective only at level #0. New test namespace-7.7 should prevent similar error in the future [Bug 1655305] 2007-02-06 Don Porter * generic/tclNamesp.c: Corrected broken implementation of the * tests/namespace.test: TclMatchIsTrivial optimization on [namespace children $namespace $pattern]. 2007-02-04 Daniel Steffen * unix/tcl.m4: use gcc4's __attribute__((__visibility__("hidden"))) if available to define MODULE_SCOPE effective on all platforms. * unix/configure.in: add caching to -pipe and zoneinfo checks. * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2007-02-03 Joe Mistachkin * win/rules.vc: Fix platform specific file copy macros for downlevel Windows. 2007-01-29 Don Porter * generic/tclResult.c: Added optimization case to TclTransferResult to cover common case where there's big savings over the fully general path. Thanks to Peter MacDonald. [Bug 1626518] * generic/tclLink.c: Broken linked float logic corrected. Thanks to Andy Goth. [Bug 1602538] * doc/fcopy.n: Typo fix. [Bug 1630627] 2007-01-28 Daniel Steffen * macosx/Tcl.xcodeproj/project.pbxproj: extract build settings that * macosx/Tcl.xcodeproj/default.pbxuser: were common to multiple * macosx/Tcl-Common.xcconfig (new file): configurations into external * macosx/Tcl-Debug.xcconfig (new file): xcconfig files; add extra * macosx/Tcl-Release.xcconfig (new file): configurations for building with SDKs and 64bit; convert legacy jam-based 'Tcl' target to native target with single script phase; correct syntax of build setting references to use $() throughout. * macosx/README: document new Tcl.xcodeproj configurations; other minor updates/corrections. * generic/tcl.h: update location of version numbers in macosx files. * macosx/Tcl.xcode/project.pbxproj: restore 'tcltest' target to * macosx/Tcl.xcode/default.pbxuser: working order by replicating applicable changes to Tcl.xcodeproj since 2006-07-20. 2007-01-25 Daniel Steffen * unix/tcl.m4: integrate CPPFLAGS into CFLAGS as late as possible and move (rather than duplicate) -isysroot flags from CFLAGS to CPPFLAGS to avoid errors about multiple -isysroot flags from some older gcc builds. * unix/configure: autoconf-2.59 2007-01-22 Donal K. Fellows * compat/memcmp.c (memcmp): Reworked so that arithmetic is never performed upon void pointers, since that is illegal. [Bug 1631017] 2007-01-19 Donal K. Fellows * generic/tclCompile.c (TclCompileScript): Reduce the frequency with which we issue INST_START_CMD, making bytecode both more compact and somewhat faster. The optimized case is where we would otherwise be issuing a sequence of those instructions; in those cases, it is only ever the first one encountered that could possibly trigger. 2007-01-19 Joe Mistachkin * tools/man2tcl.c: Include stdlib.h for exit() and improve comment detection. * win/nmakehlp.c: Update usage. * win/makefile.vc: Properly build man2tcl.c for MSVC8. 2007-01-19 Daniel Steffen * macosx/tclMacOSXFCmd.c (TclMacOSXSetFileAttribute): on some versions of Mac OS X, truncate() fails on resource forks, in that case use open() with O_TRUNC instead. * macosx/tclMacOSXNotify.c: accommodate changes to prototypes of OSSpinLock(Un)Lock API. * macosx/Tcl.xcodeproj/project.pbxproj: ensure HOME and USER env vars * macosx/Tcl.xcodeproj/default.pbxuser: are defined when running testsuite from Xcode. * tests/env.test: add extra system env vars that need to be preserved on some Mac OS X versions for testsuite to work. * unix/Makefile.in: Move libtommath defines into configure.in to * unix/configure.in: avoid replicating them across multiple * macosx/Tcl.xcodeproj/project.pbxproj: buildsystems. * unix/tcl.m4: ensure CPPFLAGS env var is used when set. [Bug 1586861] (Darwin): add -isysroot and -mmacosx-version-min flags to CPPFLAGS when present in CFLAGS to avoid discrepancies between what headers configure sees during preprocessing tests and compiling tests. * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2007-01-18 Donal K. Fellows * generic/tclCompile.c (TclCompileScript): Make sure that when parsing an expanded literal fails, a correct bytecode sequence is still issued. [Bug 1638414]. Also make sure that the start of the expansion bytecode sequence falls inside the span of bytecodes for a command. * tests/compile.test (compile-16.24): Added test for [Bug 1638414] 2007-01-17 Donal K. Fellows * generic/tclIO.c: Added macros to make usage of ChannelBuffers clearer. 2007-01-11 Joe English * win/tcl.m4(CFLAGS_WARNING): Remove "-Wconversion". This was removed from unix/tcl.m4 2004-07-16 but not from here. * win/configure: Regenerated. 2007-01-11 Pat Thoyts * win/makefile.vc: Fixes to work better on Win98. Read version numbers * win/nmakehlp.c: from package index file to avoid keeping numbers in * win/rules.vc: the makefile where they may become de-synchronized. 2007-01-10 Donal K. Fellows * generic/regcomp.c (compile, freev): Define a strategy for * generic/regexec.c (exec): managing the internal * generic/regguts.h (AllocVars, FreeVars): vars of the RE engine to * generic/regcustom.h (AllocVars, FreeVars): reduce C stack usage. This will make Tcl as a whole much less likely to run out of stack space... 2007-01-09 Donal K. Fellows * generic/tclCompCmds.c (TclCompileLindexCmd): * tests/lindex.test (lindex-9.2): Fix silly bug that ended up sometimes compiling list arguments in the wrong order. [Bug 1631364] 2007-01-03 Kevin B. Kenny * generic/tclDate.c: Regenerated to recover a lost fix from patthoyts. [Bug 1618523] 2006-12-26 Mo DeJong * generic/tclIO.c (Tcl_GetsObj): Avoid checking for for the LF in a possible CRLF sequence when EOF has already been found. 2006-12-26 Mo DeJong * generic/tclEncoding.c (EscapeFromUtfProc): Clear the TCL_ENCODING_END flag when end bytes are written. This fix keep this method from writing escape bytes for an encoding like iso2022-jp multiple times when the escape byte overlap with the end of the IO buffer. * tests/io.test: Add test for escape byte overlap issue. 2006-12-19 Donal K. Fellows * unix/tclUnixThrd.c (Tcl_GetAllocMutex, TclpNewAllocMutex): Add intermediate variables to shut up unwanted warnings. [Bug 1618838] 2006-12-19 Daniel Steffen * unix/tclUnixThrd.c (TclpInetNtoa): fix for 64 bit. * unix/tcl.m4 (Darwin): --enable-64bit: verify linking with 64bit -arch flag succeeds before enabling 64bit build. * unix/configure: autoconf-2.59 2006-12-17 Daniel Steffen * tests/macOSXLoad.test (new file): add testing of .bundle loading and * tests/load.test: unloading on Darwin (in addition * tests/unload.test: to existing tests of .dylib loading). * macosx/Tcl.xcodeproj/project.pbxproj: add building of dltest binaries so that testsuite run from Xcode can use them; fix testsuite run script * unix/configure.in: add support for building dltest binaries as * unix/dltest/Makefile.in: .bundle (in addition to .dylib) on Darwin. * unix/Makefile.in: add stub lib dependency to dltest target. * unix/configure: autoconf-2.59 * tests/append.test: fix cleanup failure when all tests are skipped. * tests/chan.test (chan-16.9): cleanup chan event handler to avoid causing error in event.test when running testsuite with -singleproc 1. * tests/info.test: add !singleTestInterp constraint to tests that fail when running testsuite with -singleproc 1. [Bug 1605269] 2006-12-14 Donal K. Fellows * doc/string.n: Fix example. [Bug 1615277] 2006-12-12 Don Porter * generic/tclCompExpr.c: Now that the new internal structs are in use to support operator commands, might as well make them the default for [expr] as well and avoid passing every parsed expression through the inefficient Tcl_Token array format. This addresses most issues in [RFE 1517602]. Assuming no performance disasters result from this, much dead code supporting the other implementation might now be removed. * generic/tclBasic.c: Final step routing all direct evaluation forms * generic/tclCompExpr.c: of the operator commands through TEBC, * generic/tclCompile.h: dropping all the routines in tclMathOp.c. * generic/tclMathOp.c: Still needs Engineering Manual attention. 2006-12-11 Don Porter * generic/tclBasic.c: Another step with all sorting operator * generic/tclCompExpr.c: commands now routing through TEBC via * generic/tclCompile.h: TclSortingOpCmd(). 2006-12-08 Don Porter * generic/tclBasic.c: Another step down the path of re-using * generic/tclCompExpr.c: TclExecuteByteCode to implement the TIP 174 * generic/tclCompile.h: commands instead of using a mass of code * generic/tclMathOp.c: duplication. Now all operator commands that * tests/mathop.test: demand exactly one operation are implemented via TclSingleOpCmd and a call to TEBC. * generic/tclCompExpr.c: Revised implementation of TclInvertOpCmd to * generic/tclMathOp.c: perform a bytecode compile / execute sequence. This demonstrates a path toward avoiding mountains of code duplication in tclMathOp.c and tclExecute.c. * generic/tclCompile.h: Change TclExecuteByteCode() from static to * generic/tclExecute.c: MODULE_SCOPE so all files including tclCompile.h may call it. * generic/tclMathOp.c: More revisions to make tests pass. * tests/mathop.test: 2006-12-08 Donal K. Fellows * generic/tclNamesp.c (TclTeardownNamespace): Ensure that dying namespaces unstitch themselves from their referents. [Bug 1571056] (NsEnsembleImplementationCmd): Silence GCC warning. * tests/mathop.test: Full tests for & | and ^ operators 2006-12-08 Daniel Steffen * library/tcltest/tcltest.tcl: use [info frame] for "-verbose line". 2006-12-07 Don Porter * generic/tclCompCmds.c: Additional commits correct most * generic/tclExecute.c: failing tests illustrating bugs * generic/tclMathOp.c: uncovered in [Patch 1578137]. * generic/tclBasic.c: Biggest source of TIP 174 failures was that the commands were not [namespace export]ed from the ::tcl::mathop namespace. More bits from [Patch 1578137] correct that. * tests/mathop.test: Commmitted several new tests from Peter Spjuth found in [Patch 1578137]. Many failures now demonstrate issues to fix in the TIP 174 implementation. 2006-12-07 Donal K. Fellows * tests/mathop.test: Added tests for ! ~ eq operators. * generic/tclMathOp.c (TclInvertOpCmd): Add in check for non-integral numeric values. * generic/tclCompCmds.c (CompileCompareOpCmd): Factor out the code generation for the chained comparison operators. 2006-12-07 Pat Thoyts * tests/exec.test: Fixed line endings (caused win32 problems). 2006-12-06 Don Porter * generic/tclCompCmds.c: Revised and consolidated into utility * tests/mathop.test: routines some of routines that compile the new TIP 174 commands. This corrects some known bugs. More to come. 2006-12-06 Kevin B. Kenny * tests/expr.test (expr-47.12): Improved error reporting in hopes of having more information to pursue [Bug 1609936]. 2006-12-05 Andreas Kupries TIP#291 IMPLEMENTATION * generic/tclBasic.c: Define tcl_platform element for pointerSize. * doc/tclvars.n: * win/Makefile.in: Added installation instructions for the platform * win/makefile.vc: package. Added the platform package. * win/makefile.bc: * unix/Makefile.in: * tests/platform.test: * tests/safe.test: * library/platform/platform.tcl: * library/platform/shell.tcl: * library/platform/pkgIndex.tcl: * doc/platform.n: * doc/platform_shell.n: 2006-12-05 Don Porter * generic/tclPkg.c: When no requirements are supplied to a * tests/pkg.test: [package require $pkg] and [package unknown] is invoked to find a satisfying package, pass the requirement argument "0-" (which means all versions are acceptable). This permits a registered [package unknown] command to call [package vsatisfies $testVersion {*}$args] without any special handling of the empty $args case. This fixes/avoids a bug in [::tcl::tm::UnknownHandler] that was causing old TM versions to be provided in preference to newer TM versions. Thanks to Julian Noble for discovering the issue. 2006-12-04 Donal K. Fellows TIP#267 IMPLEMENTATION * generic/tclIOCmd.c (Tcl_ExecObjCmd): Added -ignorestderr option, * tests/exec.test, doc/exec.n: loosely from [Patch 1476191] 2006-12-04 Don Porter * generic/tclCompExpr.c: Added implementation for the CompileExprTree() routine that can produce expression bytecode directly from internal structures with no need to pass through the Tcl_Token array representation. Still disabled by default. #undef USE_EXPR_TOKENS to try it out. 2006-12-03 Don Porter * generic/tclCompExpr.c: Added expr parsing routines that produce a different set of internal structures representing the parsed expression, as well as routines that go on to convert those structures into the traditional Tcl_Token array format. Use of these routines is currently disabled. #undef PARSE_DIRECT_EXPR_TOKENS to enable them. These routines will only become really useful when more routines that compile directly from the new internal structures are completed. 2006-12-02 Donal K. Fellows * doc/file.n: Clarification of [file pathtype] docs. [Bug 1606454] 2006-12-01 Kevin B. Kenny * libtommath/bn_mp_add.c: Corrected the effects of a * libtommath/bn_mp_div.c: bollixed 'cvs merge' operation * libtommath/bncore.c: that inadvertently committed some * libtommath/tommath_class.h: half-developed code. TIP#299 IMPLEMENTATION * doc/mathfunc.n: Added isqrt() function to docs * generic/tclBasic.c: Added isqrt() math function (ExprIsqrtFunc) * tests/expr.test (expr-47.*): Added tests for isqrt() * tests/info.test (info-20.2): Added isqrt() to expected math funcs. 2006-12-01 Don Porter * tests/chan.test: Correct timing sensitivity in new test. [Bug 1606860] TIP#287 IMPLEMENTATION * doc/chan.n: New subcommand [chan pending]. * generic/tclBasic.c: Thanks to Michael Cleverly for proposal * generic/tclInt.h: and implementation. * generic/tclIOCmd.c: * library/init.tcl: * tests/chan.test: * tests/ioCmd.test: TIP#298 IMPLEMENTATION * generic/tcl.decls: Tcl_GetBignumAndClearObj -> Tcl_TakeBignumFromObj * generic/tclObj.c: * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclExecute.c: Update callers. * generic/tclMathOp.c: 2006-11-30 Kevin B. Kenny * library/tzdata: Olson's tzdata2006p. * libtommath/bn_mp_sqrt.c: Fixed a bug where the initial approximation to the square root could be on the wrong side, causing failure of convergence. 2006-11-29 Don Porter * generic/tclBasic.c (Tcl_AppendObjToErrorInfo): Added Tcl_DecrRefCount() on the objPtr argument to plug memory leaks. This makes the routine a consumer, which makes it easiest to use. 2006-11-28 Andreas Kupries * generic/tclBasic.c: TIP #280 implementation. * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclCompCmds.c: * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclIOUtil.c: * generic/tclInt.h: * generic/tclInterp.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclProc.c: * tests/compile.test: * tests/info.test: * tests/platform.test: * tests/safe.test: 2006-11-27 Kevin B. Kenny * unix/tclUnixChan.c (TclUnixWaitForFile): * tests/event.test (event-14.*): Corrected a bug where TclUnixWaitForFile would present select() with the wrong mask on an LP64 machine if a fd number exceeds 32. Thanks to Jean-Luc Fontaine for reporting and diagnosing. [Bug 1602208] 2006-11-27 Don Porter * generic/tclExecute.c (TclIncrObj): Correct failure to detect floating-point increment values. Thanks to William Coleda [Bug 1602991] 2006-11-26 Donal K. Fellows * tests/mathop.test, doc/mathop.n: More bits and pieces of the TIP#174 implementation. Note that the test suite is not yet complete. 2006-11-26 Daniel Steffen * unix/tcl.m4 (Linux): --enable-64bit support. [Patch 1597389] * unix/configure: autoconf-2.59 [Bug 1230558] 2006-11-25 Donal K. Fellows TIP#174 IMPLEMENTATION * generic/tclMathOp.c (new file): Completed the implementation of the interpreted versions of all the tcl::mathop commands. Moved to a new file to make tclCompCmds.c more focused in purpose. 2006-11-23 Donal K. Fellows * generic/tclCompCmds.c (Tcl*OpCmd, TclCompile*OpCmd): * generic/tclBasic.c (Tcl_CreateInterp): Partial implementation of TIP#174; the commands are compiled, but (mostly) not interpreted yet. 2006-11-22 Donal K. Fellows TIP#269 IMPLEMENTATION * generic/tclCmdMZ.c (Tcl_StringObjCmd): Implementation of the [string * tests/string.test (string-25.*): is list] command, based on * doc/string.n: work by Joe Mistachkin, with enhancements by Donal Fellows for better failindex behaviour. 2006-11-22 Don Porter * tools/genWinImage.tcl (removed): Removed two files used in * win/README.binary (removed): production of binary distributions for Windows, a task we no longer perform. [Bug 1476980] * generic/tcl.h: Remove mention of win/README.binary in comment * generic/tcl.h: Moved TCL_REG_BOSONLY #define from tcl.h to * generic/tclInt.h: tclInt.h. Only know user is Expect, which already #include's tclInt.h. No need to continue greater exposure. [Bug 926500] 2006-11-20 Donal K. Fellows * generic/tclBasic.c (Tcl_CreateInterp, TclHideUnsafeCommands): * library/init.tcl: Refactored the [chan] command's guts so that it does not use aliases to global commands, making the code more robust. 2006-11-17 Don Porter * generic/tclExecute.c (INST_EXPON): Corrected crash on [expr 2**(1<<63)]. Was operating on cleared bignum Tcl_Obj. 2006-11-16 Donal K. Fellows * doc/apply.n, doc/chan.n: Added examples. 2006-11-15 Don Porter TIP#270 IMPLEMENTATION * generic/tcl.decls: New public routines Tcl_ObjPrintf, * generic/tclStringObj.c: Tcl_AppendObjToErrorInfo, Tcl_Format, * generic/tclInt.h: Tcl_AppendLimitedToObj, Tcl_AppendFormatToObj and Tcl_AppendPrintfToObj. Former internal versions removed. * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclBasic.c: Updated callers. * generic/tclCkalloc.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclDictObj.c: * generic/tclExecute.c: * generic/tclIORChan.c: * generic/tclIOUtil.c: * generic/tclMain.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclPkg.c: * generic/tclProc.c: * generic/tclStrToD.c: * generic/tclTimer.c: * generic/tclUtil.c: * unix/tclUnixFCmd.c: * tools/genStubs.tcl: Updated script to no longer produce the _ANSI_ARGS_ wrapper in generated declarations. Also revised to accept variadic prototypes with more than one fixed argument. (This is possible since TCL_VARARGS and its limitations are no longer in use). * generic/tcl.h: Some reordering so that macro definitions do not interfere with the now _ANSI_ARGS_-less stub declarations. * generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclPlatDecls.h: * generic/tclTomMathDecls.h: 2006-11-15 Donal K. Fellows * doc/ChnlStack.3, doc/CrtObjCmd.3, doc/GetIndex.3, doc/OpenTcp.3: * doc/chan.n, doc/fconfigure.n, doc/fcopy.n, doc/foreach.n: * doc/history.n, doc/http.n, doc/library.n, doc/lindex.n: * doc/lrepeat.n, doc/lreverse.n, doc/pkgMkIndex.n, doc/re_syntax.n: Convert \fP to \fR so that man-page scrapers have an easier time. 2006-11-14 Don Porter TIP#261 IMPLEMENTATION * generic/tclNamesp.c: [namespace import] with 0 arguments introspects the list of imported commands. 2006-11-13 Kevin B. Kenny * generic/tclThreadStorage.c (Tcl_InitThreadStorage): (Tcl_FinalizeThreadStorage): Silence a compiler warning about presenting a volatile pointer to 'memset'. 2006-11-13 Don Porter * generic/tclIO.c: When [gets] on a binary channel needs to use the "iso8859-1" encoding, save a copy of that encoding per-thread to avoid repeated freeing and re-loading of it from the file system. This replaces the cached copy of this encoding that the platform initialization code used to keep in pre-8.5 releases. 2006-11-13 Daniel Steffen * generic/tclCompExpr.c: Fix gcc warnings about 'cast to/from * generic/tclEncoding.c: pointer from/to integer of different * generic/tclEvent.c: size' on 64-bit platforms by casting * generic/tclExecute.c: to intermediate types * generic/tclHash.c: intptr_t/uintptr_t via new PTR2INT(), * generic/tclIO.c: INT2PTR(), PTR2UINT() and UINT2PTR() * generic/tclInt.h: macros. [Patch 1592791] * generic/tclProc.c: * generic/tclTest.c: * generic/tclThreadStorage.c: * generic/tclTimer.c: * generic/tclUtil.c: * unix/configure.in: * unix/tclUnixChan.c: * unix/tclUnixPipe.c: * unix/tclUnixPort.h: * unix/tclUnixTest.c: * unix/tclUnixThrd.c: * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2006-11-12 Donal K. Fellows * generic/tclInt.h, generic/tclInt.decls: Transfer TclPtrMakeUpvar and TclObjLookupVar to the internal stubs table. 2006-11-10 Daniel Steffen * tests/fCmd.test (fCmd-6.26): fix failure when env(HOME) path contains symlinks. * macosx/Tcl.xcodeproj/project.pbxproj: remove tclParseExpr.c; when running testsuite from inside Xcdoe, skip stack-3.1 (it only fails under those circumstances). * unix/tcl.m4 (Darwin): suppress linker arch warnings when building universal for both 32 & 64 bit and no 64bit CoreFoundation is available; sync with tk tcl.m4 change. * unix/configure.in: whitespace. * unix/configure: autoconf-2.59 2006-11-09 Don Porter * generic/tclParseExpr.c (removed): Moved all the code of * generic/tclCompExpr.c: tclParseExpr.c into tclCompExpr.c. * unix/Makefile.in: This sets the stage for expr compiling to work * win/Makefile.in: directly with the full parse tree structures, * win/makefile.bc: and not have to pass through the information * win/makefile.vc: lossy format of an array of Tcl_Tokens. * win/tcl.dsp: 2006-11-09 Donal K. Fellows TIP#272 IMPLEMENTATION * generic/tclCmdMZ.c (Tcl_StringObjCmd): Implementation of the * tests/string.test, tests/stringComp.test: [string reverse] command * doc/string.n: from TIP#272. * generic/tclCmdIL.c (Tcl_LreverseObjCmd): Implementation of the * generic/tclBasic.c, generic/tclInt.h: [lreverse] command from * tests/cmdIL.test (cmdIL-7.*): TIP#272. * doc/lreverse.n: 2006-11-08 Donal K. Fellows * generic/tclIO.c, generic/tclPkg.c: Style & clarity rewrites. 2006-11-07 Andreas Kupries * unix/tclUnixFCmd.c (CopyFile): Added code to fall back to a hardwired default block size should the filesystem report a bogus value. [Bug 1586470] 2006-11-04 Don Porter * generic/tclStringObj.c: Changed Tcl_ObjPrintf() response to an invalid format specifier string. No longer panics; now produces an error message as output. TIP#274 IMPLEMENTATION * generic/tclParseExpr.c: Exponentiation operator is now right * tests/expr.test: associative. [Patch 1556802] 2006-11-03 Miguel Sofer * generic/tclBasic.c (TEOVI): fix por possible leak of a Command in the presence of execution traces that delete it. * generic/tclBasic.c (TEOVI): * tests/trace.test (trace-21.11): fix for [Bug 1590232], execution traces may cause a second command resolution in the wrong namespace. 2006-11-03 Donal K. Fellows * tests/event.test (event-11.5): Rewrote tests to stop Tcl from * tests/io.test (multiple tests): opening sockets that are * tests/ioCmd.test (iocmd-15.1,16,17): reachable from outside hosts * tests/iogt.test (__echo_srv__.tcl): where not necessary. This is * tests/socket.test (multiple tests): noticably annoying on some * tests/unixInit.test (unixInit-1.2): systems (e.g., Windows). 2006-11-02 Daniel Steffen * macosx/Tcl.xcodeproj/project.pbxproj: check autoconf/autoheader exit status and stop build if they fail. 2006-11-02 Jeff Hobbs * doc/ParseCmd.3, doc/Tcl.n, doc/eval.n, doc/exec.n: * doc/fconfigure.n, doc/interp.n, doc/unknown.n: * library/auto.tcl, library/init.tcl, library/package.tcl: * library/safe.tcl, library/tm.tcl, library/msgcat/msgcat.tcl: * tests/all.tcl, tests/basic.test, tests/cmdInfo.test: * tests/compile.test, tests/encoding.test, tests/execute.test: * tests/fCmd.test, tests/http.test, tests/init.test: * tests/interp.test, tests/io.test, tests/ioUtil.test: * tests/iogt.test, tests/namespace-old.test, tests/namespace.test: * tests/parse.test, tests/pkg.test, tests/pkgMkIndex.test: * tests/proc.test, tests/reg.test, tests/trace.test: * tests/upvar.test, tests/winConsole.test, tests/winFCmd.test: * tools/tclZIC.tcl: * generic/tclParse.c (Tcl_ParseCommand): Replace {expand} with {*} officially (TIP #293). Leave -DALLOW_EXPAND=0|1 option to keep {expand} syntax for transition users. [Bug 1589629] 2006-11-02 Donal K. Fellows * generic/tclBasic.c, generic/tclInterp.c, generic/tclProc.c: Silence warnings from gcc over signed/unsigned and TclStackAlloc(). * generic/tclCmdMZ.c: Update to more compact and clearer coding style. 2006-11-02 Don Porter * generic/tclCmdAH.c: Further revisions to produce the routines * generic/tclInt.h: TclFormat() and TclAppendFormatToObj() that * generic/tclNamesp.c: accept (objc, objv) arguments rather than * generic/tclStringObj.c: any varargs stuff. * generic/tclBasic.c: Further revised TclAppendPrintToObj() and * generic/tclCkalloc.c: TclObjPrintf() routines to panic when unable * generic/tclCmdAH.c: to complete their formatting operations, * generic/tclCmdIL.c: rather than report an error message. This * generic/tclCmdMZ.c: means an interp argument for error message * generic/tclDictObj.c: recording is no longer needed, further * generic/tclExecute.c: simplifying the interface for callers. * generic/tclIORChan.c: * generic/tclIOUtil.c: * generic/tclInt.h: * generic/tclMain.c: * generic/tclNamesp.c: * generic/tclParseExpr.c: * generic/tclPkg.c: * generic/tclProc.c: * generic/tclStringObj.c: * generic/tclTimer.c: * generic/tclUtil.c: * unix/tclUnixFCmd.c: 2006-11-02 Donal K. Fellows * tests/winPipe.test (winpipe-4.[2345]): Made robust when run in directory with spaces in its name. * generic/tclCmdAH.c: Clean up uses of cast NULLs. * generic/tclInterp.c (AliasObjCmd): Added more explanatory comments. * generic/tclBasic.c (TclEvalObjvInternal): Rewrote so that comments are relevant and informative once more. Also made the unknown handler processing use the Tcl execution stack for working space, and not the general heap. 2006-11-01 Daniel Steffen * unix/tclUnixPort.h: ensure MODULE_SCOPE is defined before use, so that tclPort.h can once again be included without tclInt.h. * generic/tclEnv.c (Darwin): mark _environ symbol as unexported even when MODULE_SCOPE != __private_extern__. 2006-10-31 Don Porter * generic/tclBasic.c: Refactored and renamed the routines * generic/tclCkalloc.c: TclObjPrintf, TclFormatObj, and * generic/tclCmdAH.c: TclFormatToErrorInfo to a new set of routines * generic/tclCmdIL.c: TclAppendPrintfToObj, TclAppendFormatToObj, * generic/tclCmdMZ.c: TclObjPrintf, and TclObjFormat, with the * generic/tclDictObj.c: intent of making the latter list, plus * generic/tclExecute.c: TclAppendLimitedToObj and * generic/tclIORChan.c: TclAppendObjToErrorInfo, public via a revised * generic/tclIOUtil.c: TIP 270. * generic/tclInt.h: * generic/tclMain.c: * generic/tclNamesp.c: * generic/tclParseExpr.c: * generic/tclPkg.c: * generic/tclProc.c: * generic/tclStringObj.c: * generic/tclTimer.c: * generic/tclUtil.c: * unix/tclUnixFCmd.c: 2006-10-31 Miguel Sofer * generic/tclBasic.c, generic/tcl.h, generic/tclInterp.c: * generic/tclNamesp.c: removing the flag bit TCL_EVAL_NOREWRITE, the last remnant of the callObjc/v fiasco. It is not needed, as it is now always set and checked or'ed with TCL_EVAL_INVOKE. 2006-10-31 Pat Thoyts * win/rules.vc: Fix for [Bug 1582769] - options conflict with VC2003. 2006-10-31 Donal K. Fellows * generic/tclBasic.c, generic/tclNamesp.c, generic/tclProc.c: * generic/tclInt.h: Removed the callObjc and callObjv fields from the Interp structure. They did not function correctly and made other parts of the core amazingly complex, resulting in a substantive change to [info level] behaviour. [Bug 1587618] * library/clock.tcl: Removed use of [info level 0] for calculating the command name as used by the user and replace with a literal. What's there now is sucky, but at least appears to be right to most users. * tests/namespace.test (namespace-42.7,namespace-47.1): Reverted changes to these tests. * tests/info.test (info-9.11,info-9.12): Added knownBug constraint since these tests require a different behaviour of [info level] than is possible because of other dependencies. 2006-10-30 Jeff Hobbs * tools/tcltk-man2html.tcl (option-toc): handle any kind of options defined toc section (needed for ttk docs) 2006-10-30 Miguel Sofer * generic/tclBasic.c (TEOVI): insured that the interp's callObjc/v fields are restored after traces run, as they be spoiled. This was causing a segfault in tcllib's profiler tests. 2006-10-30 Don Porter * generic/tclExecute.c (INST_MOD): Corrected improper testing of the * tests/expr.test: sign of bignums when applying Tcl's division rules. Thanks to Peter Spjuth. [Bug 1585704] 2006-10-29 Miguel Sofer * generic/tclNamesp.c (EnsembleImplementationCmd): * tests/namespace.test (47.7-8): reverted a wrong "optimisation" that completely broke snit; added two tests. 2006-10-28 Donal K. Fellows * generic/tclProc.c (ObjInterpProcEx, TclObjInterpProcCore): Split the core of procedures to make it easier to build procedure-like code without going through horrible contortions. This is the last critical component to make advanced OO systems workable as simple loadable extensions. TOIPC is now in the internal stub table. (MakeProcError, MakeLambdaError): Refactored ProcessProcResultCode to be simpler, some of which goes to TclObjInterpProcCore, and the rest of which is now in these far simpler routines which just do errorInfo stack generation for different types of procedure-like entity. * tests/apply.test (apply-5.1): Updated to expect the more informative form of message. 2006-10-27 Donal K. Fellows * generic/tclVar.c (HasLocalVars): New macro to make various bits and pieces cleaner. * generic/tclNamesp.c (TclSetNsPath): Expose SetNsPath() through internal stubs table with semi-external name. * generic/tclInt.h (CallFrame): Add a field for handling context data for extensions (like object systems) that should be tied to a call frame (and not a command or interpreter). * generic/tclBasic.c (TclRenameCommand): Change to take CONST args; they were only ever used in a constant way anyway, so this appears to be a spot that was missed during TIP#27 work. 2006-10-26 Miguel Sofer * generic/tclProc.c (SetLambdaFromAny): minor change, eliminate redundant call to Tcl_GetString (thanks aku). * generic/tclInterp.c (ApplyObjCmd): * generic/tclNamesp.c (EnsembleImplementationCmd): replaced ckalloc (heap) with TclStackAlloc (execution stack). 2006-10-24 Miguel Sofer * tests/info.test (info-9.11-12): tests for [Bug 1577492] * tests/apply.test (apply-4.3-5): tests for [Bug 1574835] * generic/tclProc.c (ObjInterpProcEx): disable itcl hacks for calls from ApplyObjCmd (islambda==1), as they mess apply's error messages [Bug 1583266] 2006-10-23 Miguel Sofer * generic/tclProc.c (ApplyObjCmd): fix wrong#args for apply by using the ensemble rewrite engine. [Bug 1574835] * generic/tclInterp.c (AliasObjCmd): previous commit missed usage of TCL_EVAL_NOREWRITE for aliases. * generic/tclBasic.c (TclEvalObjvInternal): removed redundant check for ensembles. [Bug 1577628] * library/clock.tcl (format, scan): corrected wrong # args messages to * tests/clock.test (3.1, 34.1): make use of the new rewrite capabilities of [info level] * generic/tcl.h: Lets TEOV update the iPtr->callObj[cv] new * generic/tclBasic.c: fields, except when the flag bit * generic/tclInt.h: TCL_EVAL_NOREWRITE is present. These values * generic/tclNamesp.c: are used by Tcl_PushCallFrame to initialise * generic/tclProc.c: the frame's obj[cv] fields, and allows * tests/namespace.test: [info level] to know and use ensemble rewrites. [Bug 1577492] ***POTENTIAL INCOMPATIBILITY*** The return value from [info level 0] on interp alias calls is changed: previously returned the target command (including curried values), now returns the source - what was actually called. 2006-10-23 Miguel Sofer * generic/tcl.h: Modified the Tcl call stack so there is * generic/tclBasic.c: always a valid CallFrame, even at level 0 * generic/tclCmdIL.c: [Patch 1577278]. Most of the changes * generic/tclInt.h: involve removing tests for a NULL * generic/tclNamesp.c: iPtr->(var)framePtr. There is now a * generic/tclObj.c: CallFrame pushed at interp creation with a * generic/tclProc.c: pointer to it stored in iPtr->rootFramePtr. * generic/tclTrace.c: A second unused field in Interp is * generic/tclVar.c: hijacked to enable further functionality, currently unused (but with several FRQs depending on it). ***POTENTIAL INCOMPATIBILITY*** Any user that includes tclInt.h and needs to determine if it is running at level 0 should change (iPtr->varFramePtr == NULL) to (iPtr->varFramePtr == iPtr->rootFramePtr). 2006-10-23 Don Porter * README: Bump version number to 8.5a6 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: 2006-10-21 Miguel Sofer * generic/tcl.h, generic/tclHash.c: Tcl_FindHashEntry now calls Tcl_CreateHashEntry with a newPtr set to NULL: this would have caused a segfault previously and eliminates duplicated code. A macro has been added to tcl.h (only used when TCL_PRESERVE_BINARY_COMPATABALITY is not set - i.e., not by default). 2006-10-20 Reinhard Max * unix/configure.in: Added autodetection for OS-supplied timezone * unix/Makefile.in: files and configure switches to override the * unix/configure: detected default. 2006-10-20 Daniel Steffen *** 8.5a5 TAGGED FOR RELEASE *** * tools/tcltk-man2html.tcl: add support for alpha & beta versions to useversion glob pattern. [Bug 1579941] 2006-10-18 Don Porter * changes: 8.5a5 release date set * doc/Encoding.3: Missing doc updates (mostly Table of * doc/Ensemble.3: Contents) exposed by `make checkdoc` * doc/FileSystem.3: * doc/GetTime.3: * doc/PkgRequire.3: 2006-10-17 Miguel Sofer * generic/tclInterp.c (ApplyObjCmd): fixed bad error in 2006-10-12 commit: interp released too early. Spotted by mistachkin. 2006-10-16 Miguel Sofer * tclProc.c (SetLambdaFromAny): * tests/apply.test (9.1-9.2): plugged intrep leak [Bug 1578454], found by mjanssen. 2006-10-16 Andreas Kupries * generic/tclBasic.c: Moved TIP#219 cleanup to DeleteInterpProc. 2006-10-16 Daniel Steffen * changes: updates for 8.5a5 release. * unix/tclUnixThrd.c (TclpThreadGetStackSize): Darwin: fix for main thread, where pthread_get_stacksize_np() returns incorrect info. * macosx/GNUmakefile: don't redo prebinding of non-prebound binaires. 2006-10-16 Don Porter * generic/tclPkg.c (ExactRequirement): Plugged memory leak. Also changed Tcl_Alloc()/Tcl_Free() calls to ckalloc()/ckfree() for easier memory debugging in the future. [Bug 1568373] * library/tcltest/tcltest.tcl: Revise tcltest bump to 2.3a1. * library/tcltest/pkgIndex.tcl: This permits more features to be * unix/Makefile.in: added to tcltest before we reach version 2.3.0 * win/Makefile.in: best timed to match the release of Tcl 8.5.0. * win/makefile.vc: This also serves as a demo of TIP 268 features 2006-10-13 Colin McCormack * win/tclWinFile.c: corrected erroneous attempt to protect against NULL return from Tcl_FSGetNormalizedPath per [Bug 1548263] causing [Bug 1575837]. * win/tclWinFile.c: alfredd supplied patch to fix [Bug 1575837] 2006-10-13 Daniel Steffen * unix/tclUnixThrd.c (TclpThreadGetStackSize): on Darwin, use * unix/tcl.m4: pthread_get_stacksize_np() API to get thread stack size * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2006-10-12 Miguel Sofer * generic/tclInterp.c (ApplyObjCmd): * tests/interp.test (interp-14.5-10): made [interp alias] use the ensemble rewrite machinery to produce better error messages [Bug 1576006] 2006-10-12 David Gravereaux * win/nmakehlp.c: Replaced all wnsprintf() calls with snprintf(). wnsprintf was not in my shwlapi header file (VC++6) 2006-10-11 Don Porter * generic/tclPkg.c (Tcl_PackageRequireEx): Corrected crash when argument version=NULL passed in. 2006-10-10 Don Porter * changes: Updates for 8.5a5 release. * generic/tclNamespace.c (TclTeardownNamespace): After the commandPathSourceList of a namespace is cleared, set the commandPathSourceList to NULL so we don't try to walk the list a second time, possibly after it is freed. [Bug 1566526] * tests/namespace.test (namespace-51.16): Added test. 2006-10-09 Miguel Sofer * doc/UpVar.3: brough the docs in accordance to the code. Ever since 8.0, Tcl_UpVar(2)? accepts TCL_NAMESPACE_ONLY as a flag value, and var-3.4 tests for proper behaviour. The docs only allowed 0 and TCL_GLOBAL_ONLY. [Bug 1574099] 2006-10-09 Miguel Sofer * tests/*.test: updated all tests to refer explicitly to the global variables ::errorInfo, ::errorCode, ::env and ::tcl_platform: many were relying on the alternative lookup in the global namespace, that feature is tested specifically in namespace and variable tests. The modified testfiles are: apply.test, basic.test, case.test, cmdIL.test, cmdMZ.test, compExpr-old.test, error.test, eval.test, event.test, expr.test, fileSystem.test, for.test, http.test, if.test, incr-old.test, incr.test, interp.test, io.test, ioCmd.test, load.test, misc.test, namespace.test, parse.test, parseOld.test, pkg.test, proc-old.test, set.test, switch.test, tcltest.test, thread.test, var.test, while-old.test, while.test. 2006-10-06 Pat Thoyts * win/rules.vc: [Bug 1571954] avoid /RTCc flag with MSVC8 2006-10-06 Pat Thoyts * doc/binary.n: TIP #275: Support unsigned values in binary * generic/tclBinary.c: command. Tests and documentation updated. * tests/binary.test: 2006-10-05 Andreas Kupries * library/tm.tcl: Fixed bug in TIP #189 implementation, now allowing '_' in module names. 2006-10-05 Jeff Hobbs * library/http/http.tcl (http::geturl): only do geturl url rfc 3986 validity checking if $::http::strict is true (default true for 8.5). [Bug 1560506] * generic/tcl.h: note limitation on changing Tcl_UniChar size * generic/tclEncoding.c (UtfToUnicodeProc, UnicodeToUtfProc): * tests/encoding.test (encoding-16.1): fix alignment issues in unicode <> utf conversion procs. [Bug 1122671] 2006-10-05 Miguel Sofer * generic/tclVar.c (Tcl_LappendObjCmd): * tests/append.test(4.21-22): fix for longstanding [Bug 1570718], lappending nothing to non-list. Reported by lvirden 2006-10-04 Kevin B. Kenny * tzdata/: Olson's tzdata2006m. 2006-10-01 Kevin B. Kenny * tests/clock.test (clock-49.2): Removed a locale dependency that caused a spurious failure in the German locale. [Bug 1567956] 2006-10-01 Miguel Sofer * doc/Eval.3 (TclEvalObjv): added note on refCount management for the elements of objv. [Bug 730244] 2006-10-01 Pat Thoyts * win/tclWinFile.c: Handle possible missing define. * win/tclWinFile.c (TclpUtime): [Bug 1420432] file mtime fails for * tests/cmdAH.test: directories on windows * tests/winFile.test: Handle Msys environment a little differently in getuser function. [Bug 1567956] 2006-09-30 Miguel Sofer * generic/tclUtil.c (Tcl_SplitList): optimisation, [Patch 1344747] by dgp. * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclObj.c: * generic/tclStubInit.c: added an internal function TclObjBeingDeleted to provide info as to the reason for the loss of an internal rep. [FR 1512138] * generic/tclCompile.c: * generic/tclHistory.c: * generic/tclInt.h: * generic/tclProc.c: made Tcl_RecordAndEvalObj not call "history" if it has been redefined to an empty proc, in order to reduce the noise when debugging [FR 1190441]. Moved TclCompileNoOp from tclProc.c to tclCompile.c 2006-09-28 Andreas Kupries * generic/tclPkg.c (CompareVersions): Bugfix. Check string lengths * tests/pkg.test: before comparison. The shorter string is the smaller number. Added testcases as well. Interestingly all existing test cases for vcompare compared numbers of the same length with each other. [Bug 1563836] 2006-09-28 Miguel Sofer * generic/tclIO.c (Tcl_GetsObj): added two test'n'panic guards for possible NULL derefs, [Bug 1566382] and coverity #33. 2006-09-27 Don Porter * generic/tclExecute.c: Corrected error in INST_LSHIFT in the * tests/expr.test: calculation done to determine whether a shift in the (long int) type is possible. The calculation had literal value "1" where it needed a value "1L" to compute the correct result. Error detected via testing with the math::bigfloat package [Bug 1567222] * generic/tclPkg.c (CompareVersion): Flatten strcmp() results to {-1, 0, 1} to match expectations of CompareVersion() callers. 2006-09-27 Miguel Sofer * generic/regc_color.c (singleton): * generic/regc_cvec.c (addmcce): * generic/regcomp.c (compile, dovec): the static function addmcce does nothing when called with two NULL pointers; the only call is by compile with two NULL pointers (regcomp.c #includes regc_cvec.c). Large parts (all?) the code for mcce (multi character collating element) that we do not use is ifdef'ed out with the macro REGEXP_MCCE_ENABLE. This silences coverity bugs 7, 16, 80 * generic/regc_color.c (uncolorchain): * generic/regc_nfa.c (freearc): changed tests and asserts to equivalent formulation, designed to avoid an explicit comparison to NULL and satisfy coverity that 6 and 9 are not bugs. 2006-09-27 Andreas Kupries * tests/pkg.test: Added test for version comparison at the 32bit boundary. [Bug 1563836] * generic/tclPkg.c: Rewrote CompareVersion to perform string comparison instead of numeric. This breaks through the 32bit limit on version numbers. See code for details (handling of leading zeros, signs, etc.). un-CONSTed some arguments of CompareVersions, RequirementSatisfied, and AllRequirementsSatisfied. The new compare modifies the string (temporary string terminators). All callers use heap-allocated ver-intreps, so we are good with that. [Bug 1563836] 2006-09-27 Miguel Sofer * generic/tclFileName.c (TclGlob): added a panic for a call with TCL_GLOBMODE_TAILS and pathPrefix==NULL. This would cause a segfault, as found by coverity #26. 2006-09-26 Kevin B. Kenny * doc/Encoding.3: Added covariant 'const' qualifier for the * generic/tcl.decls: Tcl_EncodingType argument to * generic/tclEncoding.c: Tcl_CreateEncoding. [Further TIP#27 work.] * generic/tclDecls.h: Reran 'make genstubs'. 2006-09-26 Pat Thoyts * win/makefile.vc: Additional compiler flags and amd64 support. * win/nmakehlp.c: * win/rules.vc: 2006-09-26 Don Porter * generic/tcl.h: As 2006-09-22 commit from Donal K. Fellows demonstrates, "#define NULL 0" is just wrong, and as a quotable chat figure observed, "If NULL isn't defined, we're not using a C compiler" Improper fallback definition of NULL removed. 2006-09-25 Pat Thoyts * generic/tcl.h: More fixing which struct stat to refer to. * generic/tclGetDate.y: Some casts from time_t to int required. * generic/tclTimer.c: Tcl_Time structure members are longs. * win/makefile.vc: Support for varying compiler options * win/rules.vc: and build to platform-specific subdirs. 2006-09-25 Andreas Kupries * generic/tclIO.c (Tcl_StackChannel): Fixed [Bug 1564642], aka coverity #51. Extended loop condition, added checking for NULL to prevent seg.fault. 2006-09-25 Andreas Kupries * doc/package.n: Fixed nits reported by Daniel Steffen in the TIP#268 changes. 2006-09-25 Kevin B. Kenny * generic/tclNotify.c (Tcl_DeleteEvents): Simplified the code in hopes of making the invariants clearer and proving to Coverity that the event queue memory is managed correctly. 2006-09-25 Donal K. Fellows * generic/tclNotify.c (Tcl_DeleteEvents): Make it clear what happens when the event queue is mismanaged. [Bug 1564677], coverity bug #10. 2006-09-24 Miguel Sofer * generic/tclParse.c (Tcl_ParseCommand): also return an error if start==NULL and numBytes<0. This is coverity's bug #20 * generic/tclStringObj.c (STRING_SIZE): fix allocation for 0-length strings. This is coverity's bugs #54-5 2006-09-22 Andreas Kupries * generic/tclInt.h: Moved TIP#268's field 'packagePrefer' to the end of the structure, for better backward compatibility. 2006-09-22 Andreas Kupries TIP#268 IMPLEMENTATION * generic/tclDecls.h: Regenerated from tcl.decls. * generic/tclStubInit.c: * doc/PkgRequire.3: Documentation of extended API, extended testsuite. * doc/package.n: * tests/pkg.test: * generic/tcl.decls: Implementation. * generic/tclBasic.c: * generic/tclConfig.c: * generic/tclInt.h: * generic/tclPkg.c: * generic/tclTest.c: * generic/tclTomMathInterface.c: * library/init.tcl: * library/package.tcl: * library/tm.tcl: 2006-09-22 Donal K. Fellows * generic/tclThreadTest.c (TclCreateThread): Use NULL instead of 0 as end-of-strings marker to Tcl_AppendResult; the difference matters on 64-bit machines. [Bug 1562528] 2006-09-21 Don Porter * generic/tclUtil.c: Dropped ParseInteger() routine. TclParseNumber covers the task just fine. 2006-09-19 Donal K. Fellows * generic/tclEvent.c (Tcl_VwaitObjCmd): Rewrite so that an exceeded limit trapped in a vwait cannot cause a dangerous dangling trace. 2006-09-19 Don Porter * generic/tclExecute.c (INST_EXPON): Native type overflow detection * tests/expr.test: was completely broken. Falling back on use of bignums for all non-trivial ** calculations until native-type-constrained special cases can be done carefully and correctly. [Bug 1561260] 2006-09-15 Jeff Hobbs * library/http/http.tcl: Change " " -> "+" url encoding mapping * library/http/pkgIndex.tcl: to " " -> "%20" as per RFC 3986. * tests/http.test (http-5.1): bump http to 2.5.3 * unix/Makefile.in: * win/Makefile.in: 2006-09-12 Andreas Kupries * unix/configure.in (HAVE_MTSAFE_GETHOST*): Modified to recognize HP-UX 11.00 and beyond as having mt-safe implementations of the gethost functions. * unix/configure: Regenerated, using autoconf 2.59 * unix/tclUnixCompat.c (PadBuffer): Fixed bug in calculation of the increment needed to align the pointer, and added documentation explaining why the macro is implemented as it is. 2006-09-11 Pat Thoyts * win/rules.vc: Updated to install http, tcltest and msgcat as * win/makefile.vc: Tcl Modules (as per Makefile.in). * win/makefile.vc: Added tommath_(super)class headers. 2006-09-11 Andreas Kupries * unix/Makefile.in (install-libraries): Fixed typo tcltest 2.3.9 -> 2.3.0. 2006-09-11 Daniel Steffen * unix/tclUnixCompat.c: make compatLock static and only declare it when it will actually be used; #ifdef parts of TSD that are not always needed; adjust #ifdefs to cover all possible cases; fix whitespace. 2006-09-11 Andreas Kupries * tests/msgcat.test: Bumped version in auxiliary files as well. * doc/msgcat.n: 2006-09-11 Kevin B. Kenny * unix/Makefile.in: Bumped msgcat version to 1.4.2 to be * win/Makefile.in: consistent with dgp's commits of 2006-09-10. 2006-09-11 Don Porter * library/msgcat/msgcat.tcl: Removed some unneeded [uplevel]s. 2006-09-10 Don Porter * generic/tclExecute.c: Corrected INST_EXPON flaw that treated * tests/expr.test: $x**1 as $x**3. [Bug 1555371] * doc/tcltest.n: Bump to version tcltest 2.3.0 to * library/tcltest/pkgIndex.tcl: account for new "-verbose line" * library/tcltest/tcltest.tcl: feature. * unix/Makefile.in: * win/Makefile.in: * win/makefile.bc: * win/makefile.vc: * library/msgcat/msgcat.tcl: Bump to version msgcat 1.4.2 to * library/msgcat/pkgIndex.tcl: account for modifications. 2006-09-10 Daniel Steffen * library/msgcat/msgcat.tcl (msgcat::Init): on Darwin, add fallback of * tests/msgcat.test: default msgcat locale to * unix/tclUnixInit.c (TclpSetVariables): current CFLocale identifier if available (via private ::tcl::mac::locale global, set at interp init when on Mac OS X 10.3 or later with CoreFoundation). * library/tcltest/tcltest.tcl: add 'line' verbose level: prints source * doc/tcltest.n: file line information of failing tests. * macosx/Tcl.xcodeproj/project.pbxproj: add new tclUnixCompat.c file; revise tests target to use new tcltest 'line' verbose level. * unix/configure.in: add descriptions to new AC_DEFINEs for MT-safe. * unix/tcl.m4: add caching to new SC_TCL_* macros for MT-safe wrappers * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2006-09-08 Zoran Vasiljevic * unix/tclUnixCompat.c: Added fallback to gethostbyname() and gethostbyaddr() if the implementation is known to be MT-safe (currently for Darwin 6 or later only). * unix/configure.in: Assume gethostbyname() and gethostbyaddr() are MT-safe starting with Darwin 6 (Mac OSX 10.2). * unix/configure: Regenerated with autoconf V2.59 2006-09-08 Andreas Kupries * unix/tclUnixCompat.c: Fixed conditions for CopyArray/CopyString, and CopyHostent. Also fixed bad var names in TclpGetHostByName. 2006-09-07 Zoran Vasiljevic * unix/tclUnixCompat.c: Added fallback to MT-unsafe library calls if TCL_THREADS is not defined. Fixed alignment of arrays copied by CopyArray() to be on the sizeof(char *) boundary. 2006-09-07 Zoran Vasiljevic * unix/tclUnixChan.c: Rewritten MT-safe wrappers to return ptrs to * unix/tclUnixCompat.c: TSD storage making them all look like their * unix/tclUnixFCmd.c: MT-unsafe pendants API-wise. * unix/tclUnixPort.h: * unix/tclUnixSock.c: 2006-09-06 Zoran Vasiljevic * unix/tclUnixChan.c: Added TCL_THREADS ifdef'ed usage of MT-safe * unix/tclUnixFCmd.c: calls like: getpwuid, getpwnam, getgrgid, * unix/tclUnixSock.c: getgrnam, gethostbyname and gethostbyaddr. * unix/tclUnixPort.h: See [Bug 999544] * unix/Makefile.in: * unix/configure.in: * unix/tcl.m4: * unix/configure: Regenerated. * unix/tclUnixCompat.c: New file containing MT-safe implementation of some library calls. 2006-09-04 Don Porter * generic/tclCompExpr.c: Removed much complexity that is no longer needed. * tests/main.text (Tcl_Main-4.4): Test corrected to not be timing sensitive to the Bug 1481986 fix. [Bug 1550858] 2006-09-04 Jeff Hobbs * doc/package.n: correct package example 2006-08-31 Don Porter * generic/tclCompExpr.c: Corrected flawed logic for disabling the INST_TRY_CVT_TO_NUMERIC instruction at the end of an expression when function arguments contain operators. [Bug 1541274] * tests/expr-old.test: The remaining failing tests reported in * tests/expr.test: [Bug 1381715] are all new in Tcl 8.5, so there's really no issue of compatibility with Tcl 8.4 result to deal with. Fixed by updating tests to expect 8.5 results. 2006-08-29 Don Porter * generic/tclParseExpr.c: Dropped the old expr parser. 2006-08-30 Jeff Hobbs * generic/tclBasic.c (Tcl_CreateInterp): init iPtr->threadId * win/tclWinChan.c [Bug 819667] Improve logic for identifying COM ports. * generic/tclIOGT.c (ExecuteCallback): * generic/tclPkg.c (Tcl_PkgRequireEx): replace Tcl_GlobalEval(Obj) with more efficient Tcl_Eval(Obj)Ex * unix/Makefile.in (valgrindshell): add valgrindshell target and update default VALGRINDARGS. User can override, or add to it with VALGRIND_OPTS env var. * generic/tclFileName.c (DoGlob): match incrs with decrs. 2006-08-29 Don Porter * generic/tclParseExpr.c: Use the "parent" field of orphan ExprNodes to store the closure of left pointers. This lets us avoid repeated re-scanning leftward for the left boundary of subexpressions, which in worst case led to near O(N^2) runtime. 2006-08-29 Joe Mistachkin * unix/tclUnixInit.c: Fixed the issue (typo) that was causing * unix/tclUnixThrd.c (TclpThreadGetStackSize): stack.test to fail on FreeBSD (and possibly other Unix platforms). 2006-08-29 Colin McCormack * generic/tclIOUtil.c: Added test for NULL return from * generic/tclPathObj.c: Tcl_FSGetNormalizedPath which was causing * unix/tclUnixFile.c: segv's per [Bug 1548263] * win/tclWinFCmd.c: * win/tclWinFile.c: 2006-08-28 Kevin B. Kenny * library/tzdata/America/Havana: Regenerated from Olson's * library/tzdata/America/Tegucigalpa: tzdata2006k. * library/tzdata/Asia/Gaza: 2006-08-28 Don Porter * generic/tclStringObj.c: Revised ObjPrintfVA to take care to * generic/tclParseExpr.c: copy only whole characters when doing %s formatting. This relieves callers of TclObjPrintf() and TclFormatToErrorInfo() from needing to fix arguments to character boundaries. Tcl_ParseExpr() simplified by taking advantage. [Bug 1547786] * generic/tclStringObj.c: Corrected TclFormatObj's failure to count up the number of arguments required by examining the format string. [Bug 1547681] 2006-08-27 Joe Mistachkin * generic/tclClock.c (ClockClicksObjCmd): Fix nested macro breakage with TCL_MEM_DEBUG enabled. [Bug 1547662] 2006-08-26 Miguel Sofer * doc/namespace.n: * generic/tclNamesp.c: * tests/upvar.test: bugfix, docs clarification and new tests for [namespace upvar] as follow up to [Bug 1546833], reported by Will Duquette. 2006-08-24 Kevin B. Kenny * library/tzdata: Regenerated, including several new files, from Olson's tzdata2006j. * library/clock.tcl: * tests/clock.test: Removed an early testing hack that allowed loading 'registry' from the build tree rather than an installed one. This is a workaround for [Bug 15232730], which remains open because it's a symptom of a deeper underlying problem. 2006-08-23 Don Porter * generic/tclParseExpr.c: Minimal collection of new tests * tests/parseExpr.test: testing the error messages of the new expr parser. Several bug fixes and code simplifications that appeared during that effort. 2006-08-21 Don Porter * generic/tclIOUtil.c: Revisions to complete the thread finalization of the cwdPathPtr. [Bug 1536142] * generic/tclParseExpr.c: Revised mistaken call to TclCheckBadOctal(), so both [expr 08] and [expr 08z] have same additional info in error message. * tests/compExpr-old.test: Update existing tests to not fail with * tests/compExpr.test: the new expr parser. * tests/compile.test: * tests/expr-old.test: * tests/expr.test: * tests/for.test: * tests/if.test: * tests/parseExpr.test: * tests/while.test: 2006-08-21 Donal K. Fellows * win/Makefile.in (gdb): Make this target work so that debugging an msys build is possible. 2006-08-21 Daniel Steffen * macosx/tclMacOSXNotify.c (Tcl_WaitForEvent): if the run loop is already running (e.g. if Tcl_WaitForEvent was called recursively), re-run it in a custom run loop mode containing only the source for the notifier thread, otherwise wakeups from other sources added to the common run loop modes might get lost. * unix/tclUnixNotfy.c (Tcl_WaitForEvent): on 64-bit Darwin, pthread_cond_timedwait() appears to have a bug that causes it to wait forever when passed an absolute time which has already been exceeded by the system time; as a workaround, when given a very brief timeout, just do a poll on that platform. [Bug 1457797] * generic/tclClock.c (ClockClicksObjCmd): add support for Darwin * generic/tclCmdMZ.c (Tcl_TimeObjCmd): nanosecond resolution timer * generic/tclInt.h: to [clock clicks] and [time] * unix/configure.in (Darwin): when TCL_WIDE_CLICKS defined * unix/tclUnixTime.c (TclpGetWideClicks, TclpWideClicksToNanoseconds): * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 * unix/tclUnixPort.h (Darwin): override potentially faulty configure detection of termios availability in all cases, since termios is known to be present on all Mac OS X releases since 10.0. [Bug 497147] 2006-08-18 Daniel Steffen * unix/tcl.m4 (Darwin): add support for --enable-64bit on x86_64, for universal builds including x86_64, for 64-bit CoreFoundation on Leopard and for use of -mmacosx-version-min instead of MACOSX_DEPLOYMENT_TARGET * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 * generic/tcl.h: add fixes for building on Leopard and * unix/tclUnixPort.h: support for 64-bit CoreFoundation on Leopard * macosx/tclMacOSXFCmd.c: * unix/tclUnixPort.h: on Darwin x86_64, disable use of vfork as it causes execve to fail intermittently. (rdar://4685553) * generic/tclTomMath.h: on Darwin 64-bit, for now disable use of 128-bit arithmetic through __attribute__ ((mode(TI))), as it leads to link errors due to missing fallbacks. (rdar://4685527) * macosx/Tcl.xcodeproj/project.pbxproj: add x86_64 to universal build, switch native release targets to use DWARF with dSYM, Xcode 3.0 changes * macosx/README: updates for x86_64 and Xcode 2.4. * macosx/Tcl.xcodeproj/default.pbxuser: add test suite target that * macosx/Tcl.xcodeproj/project.pbxproj: runs the tcl test suite at build time and shows clickable test suite errors in the GUI build window. * tests/macOSXFCmd.test: fix use of deprecated resource fork paths. * unix/tclUnixInit.c (TclpInitLibraryPath): move code that is only needed when TCL_LIBRARY is defined to run only in that case. * generic/tclLink.c (LinkTraceProc): fix 64-bit signed-with-unsigned comparison warning from gcc4 -Wextra. * unix/tclUnixChan.c (TclUnixWaitForFile): with timeout < 0, if select() returns early (e.g. due to a signal), call it again instead of returning a timeout result. Fixes intermittent event-13.8 failures. 2006-08-17 Don Porter * generic/tclCompile.c: Revised the new set of expression * generic/tclParseExpr.c: parse error messages. 2006-08-16 Don Porter * generic/tclParseExpr.c: Replace PrecedenceOf() function with prec[] static array. 2006-08-14 Donal K. Fellows * library/clock.tcl (::tcl::clock::add): Added missing braces to clockval validation code. Pointed out on comp.lang.tcl. 2006-08-11 Donal K. Fellows * generic/tclNamesp.c: Improvements in buffer management to make namespace creation faster. Plus selected other minor improvements to code quality. [Patch 1352382] 2006-08-10 Donal K. Fellows Misc patches to make code more efficient. [Bug 1530474] (afredd) * generic/*.c, macosx/tclMacOSXNotify.c, unix/tclUnixNotfy.c, * win/tclWinThrd.c: Tidy up invocations of Tcl_Panic() to promote string constant sharing and consistent style. * generic/tclBasic.c (Tcl_CreateInterp): More efficient handling of * generic/tclClock.c (TclClockInit): registration of commands not in global namespace. * generic/tclVar.c (Tcl_UnsetObjCmd): Remove unreachable clause. 2006-08-09 Don Porter * generic/tclEncoding.c: Replace buffer copy in for loop with call to memcpy(). Thanks to afredd. [Patch 1530262] 2006-08-09 Donal K. Fellows * generic/tclCmdIL.c (Tcl_LassignObjCmd): Make the wrong#args message a bit more consistent with those used elsewhere. [Bug 1534628] * generic/tclDictObj.c (DictForCmd): Stop crash when attempting to iterate over an invalid dictionary. [Bug 1531184] * doc/ParseCmd.3, doc/expr.n, doc/set.n, doc/subst.n, doc/switch.n: * doc/tclvars.n: Ensure that uses of [expr] in documentation examples are also good style (with braces) unless otherwise necessary. [Bug 1526581] 2006-08-03 Daniel Steffen * unix/tclUnixPipe.c (TclpCreateProcess): for USE_VFORK: ensure standard channels are initialized before vfork() so that the child doesn't potentially corrupt global state in the parent's address space * tests/compExpr-old.test: add 'oldExprParser' constraint to all tests * tests/compExpr.test: that depend on the exact format of the * tests/compile.test: error messages of the pre-2006-07-05 * tests/expr-old.test: expression parser. The constraint is on by * tests/expr.test: default (i.e those tests still fail), but * tests/for.test: can be turned off by passing '-constraints * tests/if.test: newExprParser' to tcltest, which will skip * tests/parseExpr.test: the 196 failing tests in the testsuite that * tests/while.test: are caused by the new expression parser error messages. 2006-07-31 Kevin B. Kenny * generic/tclClock.c (ConvertLocalToUTCUsingC): Corrected a regression that caused dates before 1969 to be one day off in the :localtime time zone if TZ is not set. [Bug 1531530] 2006-07-30 Kevin B. Kenny * generic/tclClock.c (GetJulianDayFromEraYearMonthDay): Corrected several errors in converting dates before the Common Era [Bug 1426279] * library/clock.tcl: Corrected syntax errors in generated code for %EC %Ey, and %W format groups [Bug 1505383]. Corrected a bug in cache management for format strings containing [glob] metacharacters [Bug 1494664]. Corrected several errors in formatting/scanning of years prior to the Common Era, and added the missing %EE format group to indicate the era. * tools/makeTestCases.tcl: Added code to make sure that %U and %V format groups are included in the tests. (The code depends on %U and %V formatting working correctly when 'makeTestCases.tcl' is run, rather than making a completely independent check.) Added tests for [glob] metacharacters in strings. Added tests for years prior to the Common Era. * tests/clock.test: Rebuilt with new test cases for all the above. 2006-07-30 Joe English * doc/AppInit.3: Fix typo [Bug 1496886] 2006-07-26 Don Porter * generic/tclExecute.c: Corrected flawed overflow detection in * tests/expr.test: INST_EXPON that caused [expr 2**64] to return 0 instead of the same value as [expr 1<<64]. 2006-07-24 Don Porter * win/tclWinSock.c: Correct uninitialized Tcl_DString. Thanks to afredd. [Bug 1518166] 2006-07-21 Miguel Sofer * generic/tclExecute.c: * tests/execute.test (execute-9.1): dgp's fix for [Bug 1522803]. 2006-07-20 Daniel Steffen * macosx/tclMacOSXNotify.c (Tcl_InitNotifier, Tcl_WaitForEvent): create notifier thread lazily upon first call to Tcl_WaitForEvent() rather than in Tcl_InitNotifier(). Allows calling exeve() in processes where the event loop has not yet been run (Darwin's execve() fails in processes with more than one thread), in particular allows embedders to call fork() followed by execve(), previously the pthread_atfork() child handler's call to Tcl_InitNotifier() would immediately recreate the notifier thread in the child after a fork. * macosx/tclMacOSXFCmd.c (TclMacOSXCopyFileAttributes): add support * macosx/tclMacOSXNotify.c (Tcl_InitNotifier): for weakly * unix/tclUnixInit.c (Tcl_GetEncodingNameFromEnvironment): importing symbols not available on OSX 10.2 or 10.3, enables binaires built on later OSX versions to run on earlier ones. * macosx/Tcl.xcodeproj/project.pbxproj: enable weak-linking; turn on extra warnings. * macosx/README: document how to enable weak-linking; cleanup. * unix/tclUnixPort.h: add support for weak-linking; conditionalize AvailabilityMacros.h inclusion; only disable realpath on 10.2 or earlier when threads are enabled. * unix/tclLoadDyld.c (TclpLoadMemoryGetBuffer): change runtime Darwin * unix/tclUnixInit.c (TclpInitPlatform): release check to use global initialized once * unix/tclUnixFCmd.c (DoRenameFile, TclpObjNormalizePath): add runtime Darwin release check to determine if realpath is threadsafe. * unix/configure.in: add check on Darwin for compiler support of weak * unix/tcl.m4: import and for AvailabilityMacros.h header; move Darwin specific checks & defines that are only relevant to the tcl build out of tcl.m4; restrict framework option to Darwin; clean up quoting and help messages. * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 * generic/regc_locale.c (cclass): * generic/tclExecute.c (TclExecuteByteCode): * generic/tclIOCmd.c (Tcl_ExecObjCmd): * generic/tclListObj.c (NewListIntRep): * generic/tclObj.c (Tcl_GetLongFromObj, Tcl_GetWideIntFromObj) (FreeBignum, Tcl_SetBignumObj): * generic/tclParseExpr.c (Tcl_ParseExpr): * generic/tclStrToD.c (TclParseNumber): * generic/tclStringObj.c (TclAppendFormattedObjs): * unix/tclLoadDyld.c (TclpLoadMemory): * unix/tclUnixPipe.c (TclpCreateProcess): fix signed-with-unsigned comparison and other warnings from gcc4 -Wextra. 2006-07-13 Andreas Kupries * unix/tclUnixPort.h: Added the inclusion of . The missing header caused the upcoming #if conditions to wrongly exclude realpath, causing file normalize to ignore symbolic links in the path. 2006-07-11 Zoran Vasiljevic * generic/tclAsync.c: Made Tcl_AsyncDelete() more tolerant when called after all thread TSD has been garbage-collected. 2006-07-05 Don Porter * generic/tclParseExpr.c: Completely new expression parser that builds a parse tree instead of operating with deep recursion. This corrects reports of stack-blowing crashes parsing long expressions [Bug 906201] and replaces a fundamentally O(N^2) algorithm with an O(N) one [RFE 903765]. The new parser is better able to generate error messages that clearly report both the nature and context of the syntax error [Bugs 1029267, 1381715]. For now, the code for the old parser is still present and can be activated with a "#define OLD_EXPR_PARSER 1". This is for the sake of a clean implementation patch, and for ease of benchmarking. The new parser is non-recursive, so much lighter in stack consumption, but it does use more heap, so there may be cases where parsing of long expressions that succeeded with the old parser will lead to out of memory panics with the new one. There are still more improvements possible on that point, though significant progress may require changes to the Tcl_Token specifications documented for the public Tcl_Parse*() routines. ***POTENTIAL INCOMPATIBILITY*** for any callers that rely on the exact (usually terrible) error messages generated by the old parser. This includes a large number of tests in the test suite. * generic/tclInt.h: Replaced TclParseWhiteSpace() with * generic/tclParse.c: TclParseAllWhiteSpace() which is what * generic/tclParseExpr.c: all the callers really needed. Breaking whitespace runs at newlines is useful only to the command parsing function, and it can call the file scoped routine ParseWhiteSpace() to do that. * tests/expr-old.test: Removed knownBug constraints that masked * tests/expr.test: failures due to revised error messages. * tests/parseExpr.test: 2006-06-20 Don Porter * generic/tclIOUtil.c: Changed default configuration to * generic/tclInt.decls: #undef USE_OBSOLETE_FS_HOOKS which disables * generic/tclTest.c: access to the Tcl 8.3 internal routines for hooking into filesystem operations. Everyone ought to have migrated to Tcl_Filesystems by now. ***POTENTIAL INCOMPATIBILITY*** for any code still stuck in the pre-Tcl_Filesystem era. * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclStrToD.c: Removed dead code that permitted disabling of recognition of the new 0b and 0o numeric formats. * generic/tclExecute.c: Removed dead code that implemented alternative * generic/tclObj.c: design where numeric values did not automatically narrow to the smallest Tcl_ObjType required to hold them * generic/tclCmdAH.c: Removed dead code that was old implementation of [format]. 2006-06-14 Daniel Steffen * unix/tclUnixPort.h (Darwin): support MAC_OS_X_VERSION_MAX_ALLOWED define from AvailabilityMacros.h: override configure detection and only use API available in the indicated OS version or earlier. 2006-06-14 Donal K. Fellows * doc/format.n, doc/scan.n: Added examples for converting between characters and their numeric interpretations following user prompting. 2006-06-13 Donal K. Fellows * unix/tclLoadDl.c (TclpDlopen): Workaround for a compiler bug in Sun Forte 6. [Bug 1503729] 2006-06-06 Don Porter * doc/GetStdChan.3: Added recommendation that each call to Tcl_SetStdChannel() be accompanied by a call to Tcl_RegisterChannel(). 2006-06-05 Donal K. Fellows * doc/Alloc.3: Added documentation of promise that Tcl_Realloc(NULL,x) is the same as Tcl_Alloc(x), as discussed in comp.lang.tcl. Also fixed nonsense sentence to say something meaningful. 2006-05-29 Jeff Hobbs * generic/tcl.h (Tcl_DecrRefCount): use if/else construct to allow placement in unbraced outer if/else conditions. (jcw) 2006-05-27 Daniel Steffen * macosx/tclMacOSXNotify.c: implemented pthread_atfork() handler that * unix/tcl.m4 (Darwin): recreates CoreFoundation state and notifier thread in the child after a fork(). Note that pthread_atfork is available starting with Tiger only. Because vfork() is used by the core on Darwin, [exec]/[open] are not affected by this fix, only extensions or embedders that call fork() directly (such as TclX). However, this only makes fork() safe from corefoundation tcl with --disable-threads; as on all platforms, forked children may deadlock in threaded tcl due to the potential for stale locked mutexes in the child. [Patch 923072] * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2006-05-24 Donal K. Fellows * unix/tcl.m4 (SC_CONFIG_SYSTEM): Fixed quoting of command script to awk; it was a rarely used branch, but it was wrong. [Bug 1494160] 2006-05-23 Donal K. Fellows * doc/chan.n, doc/refchan.n: Tighten up the documentation to follow a slightly more consistent style with regard to argument capitalization. 2006-05-13 Don Porter * generic/tclProc.c (ProcCompileProc): When a bump of the compile epoch forces the re-compile of a proc body, take care not to overwrite any Proc struct that may be referred to on the active call stack. Note that the fix will not be effective for code that calls the private routine TclProcCompileProc() directly. [Bug 1482718] 2006-05-13 Daniel Steffen * generic/tclEvent.c (HandleBgErrors): fix leak. [Coverity issue 86] 2006-05-05 Don Porter * generic/tclMain.c (Tcl_Main): Corrected flaw that required * tests/main.test: (Tcl_Main-4.5): processing of one interactive command before passing control to the loop routine registered with Tcl_SetMainLoop(). [Bug 1481986] 2006-05-04 Don Porter * README: Bump version number to 8.5a5 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: * generic/tclBasic.c (ExprSrandFunc): Restore acceptance of wide/big * doc/mathfunc.n: integer values by srand(). [Bug 1480509] 2006-04-26 Don Porter *** 8.5a4 TAGGED FOR RELEASE *** * changes: Updates for another RC. * generic/tclBinary.c: Revised the handling of the Q and q format * generic/tclInt.h: specifiers for [binary] to account for the * generic/tclStrToD.c: "middle endian" floating point format used in Nokia N770. 2006-04-25 Don Porter * doc/DoubleObj.3: More doc updates for TIP 237. * doc/expr.n: * doc/format.n: * doc/mathfunc.n: * doc/scan.n: * doc/string.n: * generic/tclScan.c: [scan $s %u] is documented to accept only * tests/scan.test: decimal formatted integers. Fixed to match. 2006-04-19 Kevin B. Kenny * generic/tclStrToD.c: Added code to support the "middle endian" floating point format used in the Nokia N770's software-based floating point. Thanks to Bruce Johnson for reporting this bug, originally on https://wiki.tcl-lang.org/page/Nokia+770. * library/clock.tcl: Fixed a bug with Daylight Saving Time and Posix time zone specifiers reported by Martin Lemburg in http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/9a8b15a4dfc0b7a0 (and not at SourceForge). * tests/clock.test: Added test case for the above bug. 2006-04-18 Donal K. Fellows * doc/IntObj.3: Minor review fixes, including better documentation of the behaviour of Tcl_GetBignumAndClearObj. 2006-04-17 Don Porter * doc/IntObj.3: Documentation changes to account for TIP 237 changes. * doc/Object.3: [Bug 1446971] 2006-04-12 Donal K. Fellows * generic/regc_locale.c (cclass): Redefined the meaning of [:print:] to be exactly UNICODE letters, numbers, punctuation, symbols and spaces (*not* whitespace). [Bug 1376892] 2006-04-11 Don Porter * generic/tclTrace.c: Stop some interference between enter traces * tests/trace.test: and enterstep traces. [Bug 1458266] 2006-04-07 Don Porter * generic/tclPathObj.c: Yet another revised fix for the [Bug 1379287] * tests/fileSystem.test: family of path normalization bugs. 2006-04-06 Jeff Hobbs * generic/tclRegexp.c (FinalizeRegexp): full reset data to indicate readiness for reinitialization. 2006-04-06 Don Porter * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): It seems there * tests/indexObj.test: are extensions that rely on the prior behavior * doc/GetIndex.3: that the empty string cannot succeed as a unique prefix matcher, so I'm restoring Donal Fellows's solution. Added mention of this detail to the documentation. [Bug 1464039] * tests/compExpr-old.test: Updated testmathfunctions constraint * tests/compExpr.test: to post-TIP-232 world. * tests/expr-old.test: * tests/expr.test: * tests/info.test: * tests/indexObj.test: Corrected other test errors revealed by * tests/upvar.test: testing outside the tcltest application. * generic/tclPathObj.c: Revised fix for the [Bug 1379287] family of path normalization bugs. 2006-04-06 Daniel Steffen * unix/tcl.m4: removed TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING define on Darwin. [Bug 1457515] * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2006-04-05 Don Porter * win/tclWinInit.c: More careful calls to Tcl_DStringSetLength() * win/tclWinSock.c: to avoid creating invalid DString states. Bump * win/tclWinDde.c: to version 1.3.2. [RFE 1366195] * library/dde/pkgIndex.tcl: * library/reg/pkgIndex.tcl: Bump to registry 1.2 because * win/tclWinReg.c: Registry_Unload() is a new public routine * win/Makefile.in: compared to the 1.1.* releases. * win/configure.in: Bump package version numbers. * win/configure: autoconf 2.59 2006-04-05 Donal K. Fellows * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Allow empty strings to be matched by the Tcl_GetIndexFromObj machinery, in the same manner as any other key. [Bug 1464039] 2006-04-03 Andreas Kupries * generic/tclIO.c (ReadChars): Added check, panic and commentary to a piece of code which relies on BUFFER_PADDING to create enough space at the beginning of each buffer for the insertion of partial multibyte data at the beginning of a buffer. Commentary explains why this code is OK, and the panic is as a precaution if someone twiddled the BUFFER_PADDING into uselessness. * generic/tclIO.c (ReadChars): Temporarily suppress the use of TCL_ENCODING_END set when EOF was reached while the buffer we are converting is not truly the last buffer in the queue. Together with the Utf bug below it was possible to completely wreck the buffer data structures, eventually crashing Tcl. [Bug 1462248] * generic/tclEncoding.c (UtfToUtfProc): Stop accessing memory beyond the end of the input buffer when TCL_ENCODING_END is set and the last bytes of the buffer start a multi-byte sequence. This bug contributed to [Bug 1462248]. 2006-03-30 Miguel Sofer * generic/tclExecute.c: remove unused var and silence gcc warning 2006-03-29 Jeff Hobbs * win/Makefile.in: convert _NATIVE paths to use / to avoid ".\" path-as-escape issue. 2006-03-29 Don Porter * changes: Updates for another RC. * generic/tclPathObj.c: More fixes for path normalization when /../ * tests/fileSystem.test: tries to go beyond root.[Bug 1379287] * generic/tclExecute.c: Revised INST_MOD implementation to do calculations in native types as much as possible, moving to mp_ints only when necessary. 2006-03-28 Jeff Hobbs * win/tclWinPipe.c (TclpCreateProcess): change panics to Tcl errors and do proper refcounting of noe objPtr. [Bug 1194429] * unix/tcl.m4, win/tcl.m4: []-quote AC_DEFUN functions. 2006-03-28 Daniel Steffen * macosx/Tcl.xcode/default.pbxuser: add '-singleproc 1' cli arg to * macosx/Tcl.xcodeproj/default.pbxuser: tcltest to ease test debugging * macosx/Tcl.xcode/project.pbxproj: removed $prefix/share from * macosx/Tcl.xcodeproj/project.pbxproj: TCL_PACKAGE_PATH as per change to unix/configure.in of 2006-03-13. * unix/tclUnixFCmd.c (TclpObjNormalizePath): deal with *BSD/Darwin realpath() converting relative paths into absolute paths [Bug 1064247] 2006-03-28 Vince Darley * generic/tclIOUtil.c: fix to nativeFilesystemRecord comparisons (lesser part of [Bug 1064247]) 2006-03-27 Pat Thoyts * win/tclWinTest.c: Fixes for [Bug 1456373] (mingw-gcc issue) 2006-03-27 Andreas Kupries * doc/CrtChannel.3: Added TCL_CHANNEL_VERSION_5, made it the * generic/tcl.h: version where the "truncateProc" is defined at, * generic/tclIO.c: and moved all channel drivers of Tcl to v5. * generic/tclIOGT.c, generic/tclIORChan.c, unix/tclUnixChan.c: * unix/tclUnixPipe.c, win/tclWinChan.c, win/tclWinConsole.c: * win/tclWinPipe.c, win/tclWinSerial.c, win/tclWinSock.c: 2006-03-27 Don Porter * generic/tclExecute.c: Merge INST_MOD computation in with the INST_?SHIFT instructions, which also operate only on two integral values. Also corrected flaw that made INST_BITNOT of wide values require mp_int calculations. Also corrected type that missed optimized handling of the tclBooleanType by the TclGetBooleanFromObj macro. * changes: Updates for another RC. 2006-03-25 Don Porter * generic/tclExecute.c: Corrections to INST_EXPON detection of overflow to use mp_int calculations. 2006-03-24 Kevin B. Kenny * generic/tclExecute.c (TclExecuteByteCode): Added a couple of missing casts to 'int' that were affecting compilablity on VC6. 2006-03-24 Don Porter * generic/tclEncoding.c: Reverted latest change [Bug 506653] since it reportedly killed test performance on Windows. * generic/tclExecute.c: Revised INST_EXPON implementation to do calculations in native types as much as possible, moving to mp_ints only when necessary. 2006-03-23 Don Porter * generic/tclExecute.c: Merged INST_EXPON handling in with the other binary operators that operate on all number types (INST_ADD, etc.). * tests/env.test: With case preserved (see 2006-03-21 commit) be sure to do case-insensitive filtering. [Bug 1457065] 2006-03-23 Reinhard Max * unix/tcl.spec: Cleaned up and completed the spec file. An RPM can now be built from the tcl source distribution with "rpmbuild -tb " 2006-03-22 Reinhard Max * tests/stack.test: Run the stack tests in subshells, so that they are reported as failed tests rather than bugs in the test suite if the recursion causes a segfault. 2006-03-21 Don Porter * changes: Updates for another RC. * generic/tclStrToD.c: One of the branches of AccumulateDecimalDigit * tests/parseExpr.test: did not. [Bug 1451233] * tests/env.test: Preserve case of saved env vars. [Bug 1409272] 2006-03-21 Daniel Steffen * generic/tclInt.decls: implement globbing for HFS creator & type * macosx/tclMacOSXFCmd.c:codes and 'hidden' flag, as documented in * tests/macOSXFCmd.test: glob.n; objectified OSType handling in [glob] * unix/tclUnixFile.c: and [file attributes]; fix globbing for hidden files with pattern==NULL arg. [Bug 823329] * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: make genstubs 2006-03-20 Andreas Kupries * win/Makefile.in (install-libraries): Generate tcl8/8.4 directory under Windows as well (cygwin Makefile). Related entry: 2006-03-07, dgp. This moved the installation of http from 8.2 to 8.4, partially. A fix of the required directory creation was done for unix on Mar 10, without entry in the Changelog. This entry is for the fix of the directory creation under Windows. * unix/installManPage: There is always one even more broken "sed". Moved the # comment starting character in the sed script to the beginning of their respective lines. The AIX sed will not recognize them as comments otherwise :( The actual text stays indented for better association with the commands they belong to. 2006-03-20 Donal K. Fellows * tests/cmdAH.test, tests/fCmd.test, tests/unixFCmd.test: * tests/winFCmd.test: Cleanup of some test constraint handling, and a few other minor issues. 2006-03-18 Vince Darley * generic/tclFileName.c: * doc/FileSystem.3: * tests/fileName.test: Fix to [Bug 1084705] so that 'glob -nocomplain' finally agrees with its documentation and doesn't swallow genuine errors. ***POTENTIAL INCOMPATIBILITY*** for scripts that assumed '-nocomplain' removes the need for 'catch' to deal with non-understood path names. Small optimisation to implementation of pattern==NULL case of TclGlob, and clarification to the documentation. [Tclvfs bug 1405317] 2006-03-18 Vince Darley * tests/fCmd.test: added knownBug test case for [Bug 1394972] * tests/winFCmd.test: * tests/tcltest.test: corrected tests to better account for behaviour of writable/non-writable directories on Windows 2000/XP. This, with the previous patches, closes [Bug 1193497] 2006-03-17 Andreas Kupries * doc/chan.n: Updated with documentation for the commands 'chan create' and 'chan postevent' (TIP #219). * doc/refchan.n: New file. Documentation of the command handler API for reflected channels (TIP #219). 2006-03-17 Joe Mistachkin * unix/tclUnixPort.h: Include pthread.h prior to pthread_np.h [Bug 1444692] * win/tclWinTest.c: Corrected typo of 'initializeMutex' that prevented successful compilation. 2006-03-16 Andreas Kupries * doc/open.n: Documented the changed behaviour of 'a'ppend mode. * tests/io.test (io-43.1 io-44.[1234]): Rewritten to be self-contained with regard to setup and cleanup. [Bug 681793] * generic/tclIOUtil.c (TclGetOpenMode): Added the flag O_APPEND to the list of POSIX modes used when opening a file for 'a'ppend. This enables the proper automatic seek-to-end-on-write by the OS. See [Bug 680143] for longer discussion. * tests/ioCmd.test (iocmd-13.7.*): Extended the testsuite to check the new handling of 'a'. 2006-03-15 Andreas Kupries * tests/socket.test: Extended the timeout in socket-11.11 from 10 to 40 seconds to allow for really slow machines. Also extended actual/expected results with value of variable 'done' to make it clearer when a test fails due to a timeout. [Bug 792159] 2006-03-15 Vince Darley * win/fCmd.test: add proper test constraints so the new tests don't run on Unix. 2006-03-14 Andreas Kupries * generic/tclPipe.c (TclCreatePipeline): Modified the processing of pipebars to fail if the last bar is followed only by redirections. [Bug 768659] 2006-03-14 Andreas Kupries * doc/fconfigure.n: Clarified that -translation is binary is reported as lf when queried, because it is identical to lf, except for the special additional behaviour when setting it. [Bug 666770] 2006-03-14 Andreas Kupries * doc/clock.n: Removed double-quotes around section title NAME; not needed. * unix/installManpage: Reverted part to handle double-quotes in section NAME, chokes older sed installations. 2006-03-14 Andreas Kupries * library/tm.tcl (::tcl::tm::Defaults): Fixed handling of environment variable TCLX.y_TM_PATH, bad variable reference. Thanks to Julian Noble. [Bug 1448251] 2006-03-14 Vince Darley * win/tclWinFile.c: updated patch to deal with 'file writable' issues on Windows XP/2000. * generic/tclTest.c: * unix/tclUnixTest.c: * win/tclWinTest.c: * tests/fCmd.test: updated test suite to deal with correct permissions setting and differences between XP/2000 and 95/98 3 tests still fail; to be dealt with shortly 2006-03-13 Don Porter * generic/tclEncoding.c: Report error when an escape encoding is missing one of its sub-encodings. [Bug 506653] * unix/configure.in: Revert change from 2005-07-26 that sometimes * unix/configure: added $prefix/share to the tcl_pkgPath. See [Patch 1231015]. autoconf-2.59. 2006-03-10 Miguel Sofer * generic/tclProc.c (ObjInterpProcEx): * tests/apply.test (apply-5.1): Fix [apply] error messages so that they quote the lambda expression. [Bug 1447355] 2006-03-10 Zoran Vasiljevic -- Summary of changes fixing [Bug 1437595] -- * generic/tclEvent.c: Cosmetic touches and identation * generic/tclInt.h: Added TclpFinalizeSockets() call. * generic/tclIO.c: Calls TclpFinalizeSockets() as part of the TclFinalizeIOSubsystem(). * unix/tclUnixSock.c: Added no-op TclpFinalizeSockets(). * win/tclWinPipe.c, win/tclWinSock.c: Finalization of sockets/pipes is now solely done in TclpFinalizeSockets() and TclpFinalizePipes() and not over the thread-exit handler, because the order of actions the Tcl generic core will impose may result in cores/hangs if the thread exit handler tears down corresponding subsystem(s) too early. 2006-03-10 Vince Darley * win/tclWinFile.c: previous patch breaks tests, so removed. 2006-03-09 Vince Darley * win/tclWinFile.c: fix to 'file writable' in certain XP directories. Thanks to fvogel and jfg. [Patch 1344540] Modified patch to make use of existing use of getSecurityProc. 2006-03-08 Don Porter * generic/tclExecute.c: Complete missing bit of TIP 215 implementation * tests/incr.test: 2006-03-07 Joe English * unix/tcl.m4: Set SHLIB_LD_FLAGS='${LIBS}' on NetBSD, as per the other *BSD variants. [Bug 1334613] * unix/configure: Regenerated. 2006-03-07 Don Porter * changes: Update in prep. for 8.5a4 release. * unix/Makefile.in: Package http 2.5.2 requires Tcl 8.4, so the * win/Makefile.in: *.tm installation has to be placed in an "8.4" directory, not an "8.2" directory. 2006-03-06 Don Porter * generic/tclBasic.c: Revised handling of TCL_EVAL_* flags to * tests/parse.test: simplify TclEvalObjvInternal and to correct the auto-loading of alias targets (parse-8.12). [Bug 1444291] 2006-03-03 Don Porter * generic/tclPathObj.c: Revised yesterday's fix for [Bug 1379287] to work on Windows. * generic/tclObj.c: Compatibility support for existing code that calls Tcl_GetObjType("boolean"). 2006-03-02 Don Porter * generic/tclPathObj.c: Fix for failed normalization of paths * tests/fileSystem.test: with /../ that lead back to the root of the filesystem, like /foo/.. [Bug 1379287] 2006-03-01 Reinhard Max * unix/installManPage: Fix the script for manpages that have quotes around the .SH arguments, as doctools produces them. [Bug 1292145] Some minor cleanups and improvements. 2006-02-28 Don Porter * generic/tclBasic.c: Corrections to be sure that TCL_EVAL_GLOBAL * tests/namespace.test: evaluations act the same as [uplevel #0] * tests/parse.test: evaluations, even when execution traces or * tests/trace.test: invocations of [::unknown] are present. [Bug 1439836] 2006-02-22 Don Porter * generic/tclBasic.c: Corrected a few bugs in how [namespace * tests/namespace.test: unknown] interacts with TCL_EVAL_* flags. [Patch 958222] 2006-02-17 Don Porter * generic/tclIORChan.c: Revised error message generation and handling * tests/ioCmd.test: of exceptional return codes in the channel reflection layer. [Bug 1372348] 2006-02-16 Don Porter * generic/tclIndexObj.c: Disallow the "ambiguous" error message * tests/indexObj.test: when TCL_EXACT matching is requested. * tests/ioCmd.test: 2006-02-15 Don Porter * generic/tclIO.c: Made several routines tolerant of * generic/tclIORChan.c: interp == NULL arguments. [Bug 1380662] * generic/tclIOUtil.c: 2006-02-09 Don Porter TIP#215 IMPLEMENTATION * doc/incr.n: Revised [incr] to auto-initialize when varName * generic/tclExecute.c: argument is unset. [Patch 1413115] * generic/tclVar.c: * tests/compile.test: * tests/incr-old.test: * tests/incr.test: * tests/set.test: * tests/main.test (Tcl_Main-6.7): Improved robustness of command auto-completion test. [Bug 1422736] 2006-02-08 Donal K. Fellows * doc/Encoding.3, doc/encoding.n: Updates due to review at request of Don Porter. Mostly minor changes. 2006-02-08 Don Porter TIP#258 IMPLEMENTATION * doc/Encoding.3: New subcommand [encoding dirs]. * doc/encoding.n: New routine Tcl_GetEncodingNameFromEnvironment * generic/tcl.decls: Made public: * generic/tclBasic.c: TclGetEncodingFromObj * generic/tclCmdAH.c: -> Tcl_GetEncodingFromObj * generic/tclEncoding.c:TclGetEncodingSearchPath * generic/tclInt.decls: -> Tcl_GetEncodingSearchPath * generic/tclInt.h: TclSetEncodingSearchPath * generic/tclTest.c: -> Tcl_SetEncodingSearchPath * library/init.tcl: Removed commands: * tests/cmdAH.test: [tcl::unsupported::EncodingDirs] * tests/encoding.test: [testencoding path] (Tcltest) * unix/tclUnixInit.c: [Patch 1413934] * win/tclWinInit.c: * generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclStubInit.c: 2006-02-01 Miguel Sofer * generic/tclProc.c: minor improvements to [apply] * tests/apply.test: new tests; apply-5.1 currently fails to indicate missing work in error reporting 2006-02-01 Don Porter TIP#194 IMPLEMENTATION * doc/apply.n: (New file) New command [apply]. [Patch 944803] * doc/uplevel.n: * generic/tclBasic.c: * generic/tclInt.h: * generic/tclProc.c: * tests/apply.test: (New file) * tests/proc-old.test: * tests/proc.test: TIP#181 IMPLEMENTATION * doc/Namespace.3: New command [namespace unknown]. New public C * doc/namespace.n: routines Tcl_(Get|Set)NamespaceUnknownHandler. * doc/unknown.n: [Patch 958222] * generic/tcl.decls: * generic/tclBasic.c: * generic/tclInt.h: * generic/tclNamesp.c: * tests/namespace.test: * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: TIP#250 IMPLEMENTATION * doc/namespace.n: New command [namespace upvar]. [Patch 1275435] * generic/tclInt.h: * generic/tclNamesp.c: * generic/tclVar.c: * tests/namespace.test: * tests/upvar.test: 2006-01-26 Donal K. Fellows * doc/dict.n: Fixed silly bug in example. Thanks to Heiner Marxen for catching this! [Bug 1415725] 2006-01-26 Donal K. Fellows * unix/tclUnixChan.c (TclpOpenFileChannel): Tidy up and comment the mess to do with setting up serial channels. This (deliberately) breaks a broken FreeBSD port, indicates what we're really doing, and reduces the amount of conditional compilation sections for better maintenance. 2006-01-25 Donal K. Fellows * unix/tclUnixInit.c (TclpInitPlatform): Improved conditions on when to update the FP rounding mode on FreeBSD, taken from FreeBSD port. 2006-01-23 Donal K. Fellows * tests/string.test (string-12.21): Added test for [Bug 1410553] based on original bug report. 2006-01-23 Miguel Sofer * generic/tclStringObj.c: fixed incorrect handling of internal rep in Tcl_GetRange. Thanks to twylite and Peter Spjuth. [Bug 1410553] * generic/tclProc.c: fixed args handling for precompiled bodies [Bug 1412695]; thanks to Uwe Traum. 2006-01-16 Reinhard Max * generic/tclPipe.c (FileForRedirect): Prevent nameString from being freed without having been initialized. * tests/exec.test: Added a test for the above. 2006-01-12 Zoran Vasiljevic * generic/tclPathObj.c (Tcl_FSGetInternalRep): backported patch from core-8-4-branch. A freed pointer has been overwritten causing all sorts of coredumps. 2006-01-12 Vince Darley * win/tclWinFile.c: fix to sharing violation [Bug 1366227] 2006-01-11 Don Porter * generic/tclBasic.c: Moved Tcl_LogCommandInfo from tclBasic.c to * generic/tclNamesp.c: tclNamesp.c to get access to identifier with * tests/error.test (error-7.0): file scope. Added check for traces on ::errorInfo, and when present fall back to contruction of the stack trace in the variable so that write trace notification timings are compatible with earlier Tcl releases. This reduces, but does not completely eliminate the ***POTENTIAL INCOMPATIBILITY*** created by the 2004-10-15 commit. [Bug 1397843] 2006-01-10 Daniel Steffen * unix/configure: add caching, use AC_CACHE_CHECK instead of * unix/configure.in: AC_CACHE_VAL where possible, consistent message * unix/tcl.m4: quoting, sync relevant tclconfig/tcl.m4 changes and gratuitous formatting differences, fix SC_CONFIG_MANPAGES with default argument, Darwin improvements to SC_LOAD_*CONFIG. 2006-01-09 Don Porter * generic/tclNamesp.c (NamespaceInscopeCmd): [namespace inscope] * tests/namespace.test: commands were not reported by [info level]. [Bug 1400572] 2006-01-09 Donal K. Fellows * generic/tclTrace.c: Stop exporting the guts of the trace command; nothing outside this file needs to see it. [Bug 971336] 2006-01-05 Donal K. Fellows * unix/tcl.m4 (TCL_CONFIG_SYSTEM): Factor out the code to determine the operating system version number, as it was replicated in several places. 2006-01-04 David Gravereaux * win/tclAppInit.c: WIN32 native console signal handler removed. This was found to be interfering with TWAPI extension one. IMO, special services such as signal handlers should best be done with extensions to the core after discussions on c.l.t. about Roy Terry's tclsh children of a real windows service shell. ****************************************************************** *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" *** *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" *** *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ****************************************************************** tcl8.6.14/ChangeLog.20080000644000175000017500000042176114554262142014017 0ustar sergeisergei2008-12-31 Don Porter * unix/Makefile.in: Set TCLLIBPATH in SHELL_ENV so that targets like `make shell` have access to builds of bundled packages. 2008-12-28 Donal K. Fellows * generic/tclZlib.c (Tcl_ZlibStreamPut): Plug a memory leak. 2008-12-27 Donal K. Fellows * generic/tclZlib.c (ZlibStreamCmd): Fix compilation consistency. [Bug * generic/tcl.decls: 2470237] * generic/tclZlib.c (Tcl_ZlibStreamGet): Corrected the semantics of this function to be useful to the PNG implementation. If the argument object is empty, this gives the previous semantics. (Tcl_ZlibStreamChecksum): Corrected name to be less misleading; it only produced Adler-32 checksums when the stream was processing the right type of compressed data format. (Tcl_ZlibAdler32, Tcl_ZlibCRC32): Corrected types so that they work naturally with the results of Tcl_GetByteArrayFromObj(). *** POTENTIAL INCOMPATIBILITY *** for all above changes, but very unlikely to be difficult for anyone to deal with. 2008-12-26 Donal K. Fellows * generic/tcl.decls: Tidy up the commenting style, adding markers for each of the big release points under TCT stewardship and noting the general purpose of each TIP that added C API. Overall effect is to make this file much more informative to read without having to spend effort correlating with TIPs and ChangeLogs. 2008-12-23 Jan Nijtmans * win/Makefile.in: Fix build of zlib objects with msvc * win/tcl.m4: * win/configure: autoconf-2.59 2008-12-23 Donal K. Fellows * win/Makefile.in: Handle file extensions correctly. [Bug 2459725] 2008-12-22 Pat Thoyts *** 8.6b1 TAGGED FOR RELEASE *** * win/makefile.vc: Ensure pkgs directories are suitable and quote the paths. [Bug 2458395] 2008-12-22 Joe Mistachkin * tools/man2help2.tcl: Added support for "\(mi" nroff macro. [Bug 2330040] 2008-12-22 Pat Thoyts * win/makefile.vc: Support the pkgs tree in the NMAKE builds. 2008-12-21 Daniel Steffen * unix/Makefile.in: Fix broken build of bundled packages when path to build dir contains spaces by switching to relative paths to toplevel build dir. * unix/configure.in: Preserve configure environment variables for sub-configures of bundled packages; reuse configure cache file for sub-configures. * unix/configure: autoconf-2.59 2008-12-21 Donal K. Fellows * doc/TclZlib.3: Fix minor typo. [Bug 2455165] 2008-12-20 Kevin B. Kenny * win/Makefile.in: Renamed the static library libtcl86s.a to * win/configure.in: have a name distinct from the import library libtcl86.a. This renaming dodges an ancient bug in the Makefile revealed by the last commit where the $(TCL_LIB_FILE) rule can fire to try to build the static library in a --enable-shared build (and create a static library that subsequently fails to link). Revised the zlib objects so that they are built directly into the build dir, without building an intermediate static library. *** POTENTIAL INCOMPATIBILITY *** for embedders who link to the static library, but I couldn't figure out how to sort this out any other way. * win/configure: Autoconf 2.59 2008-12-20 Donal K. Fellows * win/Makefile.in: Minor updates to make building work better with msys on Windows. (Apparently the gcc used doesn't like a / at the end of a -I argument...) 2008-12-20 Don Porter * changes: Updates for 8.6b1 release. 2008-12-20 Daniel Steffen * unix/Makefile.in: Make package install directory of bundled * unix/configure.in: packages configurable via PACKAGE_DIR makefile variable (set to platform-specific default). * unix/Makefile.in (*-packages): Ensure toplevel targets fail if sub-make/configure fails; fix quoting when builddir path contains spaces. * macosx/GNUmakefile: Add install-packages to install targets. * unix/configure: autoconf-2.59 2008-12-19 Don Porter * doc/NRE.3: Formatting errors found by `make html` * doc/Tcl_Main.3: * doc/zlib.n: * tests/chanio.test: Add missing [removeFile] cleanups. * tests/io.test: Add missing [close $f] to io-73.2. * unix/Makefile.in: Update `make dist' target to include the files from the compat/zlib directory as well as all the bundled packages found under the pkgs directory, according to their individual `make dist' targets. Change includes breaking a `configure-packages' target out of the `packages` target. * README: Bump version number to 8.6b1 * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: 2008-12-19 Jan Nijtmans * generic/tclInt.decls: CONSTify TclGetLoadedPackages second param * generic/tclLoad.c * generic/tclIntDecls.h (regenerated) 2008-12-19 Kevin Kenny * generic/tclExecute.c: Fix compile warnings when --enable-symbols=all * win/configure.in: * win/Makefile.in: Added build of packages in the 'pkgs/' directory. * win/configure: Autoconf 2.59 2008-12-19 Pat Thoyts * win/makefile.vc: Added build of compat/zlib 2008-12-18 Andreas Kupries * generic/tclIO.c (Tcl_CloseEx, CloseWrite, CloseChannelPart) (ChanCloseHalf): Rewrite the half-close to properly flush the channel, like is done for a full close, going through FlushChannel, and using the flag BG_FLUSH_SCHEDULED (async flush during close). New functions CloseWrite, CloseChannelPart, new flag CHANNEL_CLOSEDWRITE. * tests/chanio.test (chanio-28.[67]): Reactivated these tests. Replaced tclsh -> [interpreter] to get correct executable for the pipe process, and added after cancel to kill the fail timers when we are done. Removed the explicits calls to [flush], now that [close] handles this correctly. 2008-12-18 Don Porter * tests/chanio.test: Replaced [chan event] handlers that returned TCL_RETURN return code, with more conventional ones that return TCL_OK to suppress otherwise strange writes of outdated $::errorInfo values to stderr. [Bug 2444274] * generic/tclExecute.c: Disabled apparently faulty assertion. [Bug 2415422] 2008-12-18 Donal K. Fellows * unix/configure.in, unix/Makefile.in: Autoconf wizardry. * compat/zlib/*: Import of zlib 1.2.3. The license is directly compatible with Tcl's. This import omits the obsolete and contributed parts (i.e. selected directories) and the supplied examples. * generic/tclZlib.c: First implementation of the compressing and * doc/zlib.n: decompressing channel transformations. * tests/zlib.test (zlib-8.*): 2008-12-18 Jan Nijtmans * generic/tcl.decls: VOID -> void * generic/tclInt.decls: * compat/dlfcn.h: * generic/tclDecls.h: (regenerated) * generic/tclIntDecls.h: 2008-12-18 Alexandre Ferrieux TIP #332 IMPLEMENTATION - Half-Close for Bidirectional Channels * doc/close.n, generic/tclIO.c, generic/tclIOCmd.c: * unix/tclUnixChan.c, unix/tclUnixPipe.c, win/tclWinSock.c: * generic/tcl.decls, generic/tclDecls.h, generic/tclStubInit.c: * tests/chan.test, tests/chanio.test, tests/ioCmd.test: 2008-12-17 Donal K. Fellows * doc/SetChanErr.3: General improvements in nroff rendering and some corrections to language issues. 2008-12-17 Jan Nijtmans * generic/tclResult.c: Move variable "length" inside if() * generic/tclStringObj.c: Don't use ckfree((void *)...) but * generic/tclVar.c: ckfree((char *)...) * generic/tclZlib.c * generic/tclBasic.c 2008-12-17 Donal K. Fellows * tests/namespace.test (namespace-28.1): Make tests not * tests/namespace-old.test (namespace-old-9.5): dependent on the global namespace's particular imports. [Bug 2433936] 2008-12-17 Don Porter * unix/Makefile.in: Modify the distclean-packages target so that empty build directories are deleted. * unix/Makefile.in: Add build support for collections of TEA * unix/configure.in: packages found under the pkgs directory. [Patch 1163406]. Still needs porting to Windows. * unix/configure: autoconf-2.59 2008-12-17 Donal K. Fellows * generic/tcl.h, generic/tclZlib.c: Removed undocumented flag. 2008-12-16 Jan Nijtmans * generic/tclThreadTest.c: Eliminate -Wwrite-strings warnings in --enable-threads build. * generic/tclExecute.c: Use TclNewLiteralStringObj() * unix/tclUnixFCmd.c: Use TclNewLiteralStringObj() * win/tclWinFCmd.c: Use TclNewLiteralStringObj() 2008-12-16 Donal K. Fellows TIP #329 IMPLEMENTATION * tests/error.test: Tests for the new commands. * doc/throw.n, doc/try.n: Documentation of the new commands. * library/init.tcl (throw, try): Implementation of commands documented in TIP. This implementation is in Tcl and is a stop-gap until higher-performance ones can be written. 2008-12-16 Don Porter * generic/tcl.h: Add TIP 338 routines to stub table. * generic/tcl.decls: [Bug 2431338] * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: 2008-12-15 Donal K. Fellows * generic/tclExecute.c (TEBC:INST_DICT_GET): Make sure that the result is empty when generating an error message. [Bug 2431847] 2008-12-15 Alexandre Ferrieux * generic/tclBinary.c: Redefine non-strict decoding to ignore only * doc/binary.n: whitespace. [Bug 2380293] * tests/binary.test: 2008-12-15 Don Porter * doc/AddErrInfo.3: Documented Tcl_(Set|Get)ErrorLine (TIP 336). * doc/CrtCommand.3: Various other documentation updates to * doc/CrtInterp.3: reflect the lack of access to Tcl_Interp * doc/Interp.3: fields by default. * doc/SetResult.3: * doc/tcl.decls: TIP #338 IMPLEMENTATION * doc/AppInit.c: Made routines Tcl_SetStartupScript and * doc/Tcl_Main.3: Tcl_GetStartupScript public. Removed all * generic/tcl.h: internal stub access to Tcl*Startup* routines, * generic/tclInt.decls: and removed their implementations. Their * generic/tclMain.c: function can now be completely performed with the new public interface. *** POTENTIAL INCOMPATIBILITY for callers of the internal Tcl*Startup* routines. *** * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclDecls.h: 2008-12-14 Donal K. Fellows * tests/zlib.test: Added constraint so that tests don't fail where they cannot work due to zlib support being missing. * unix/configure.in, win/configure.in: Improve the autodetection code. * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove the assumption of the presence of zlib library on Windows. * win/makefile.vc, win/makefile.bc: Add support for building tclZlib.o but only in stubbed-out mode for now. 2008-12-13 Donal K. Fellows * doc/TclZlib.3: Basic documentation of the C-level API. * doc/zlib.n: Substantially improve documentation of Tcl-level API. * generic/tclZlib.c (ZlibCmd): Flesh out the argument parsing for the command to integrate with channels. 2008-12-12 Jan Nijtmans * generic/tclZlib.c (Tcl_ZlibInflate): Change PATH_MAX to MAXPATHLEN, since MSVC doesn't have PATH_MAX. * doc/clock.n: Document new DST fallback rules. * library/clock.tcl (ProcessPosixTimeZone): Fix time change in Eastern Europe (not 3:00 but 4:00 local time). [Bug 2207436] 2008-12-12 Donal K. Fellows * generic/tclZlib.c, unix/configure.in: Added stubs to use when the version of zlib is not capable enough, and automagic to detect when that is the case. [Bug 2421265] 2008-12-12 Alexandre Ferrieux * unix/tclUnixNotfy.c: Fix missing CLOEXEC on internal pipes [2417695] * unix/tclUnixPipe.c: Fix missing CLOEXEC on [chan pipe] fds. 2008-12-12 Donal K. Fellows * generic/tclZlib.c (Tcl_ZlibDeflate): Add a bit of extra space for the gzip header. [Bug 2419061] (Tcl_ZlibInflate): Ensure that gzip header extraction is done correctly. 2008-12-12 Kevin Kenny TIP #322 IMPLEMENTATION * doc/NRE.3 (new file): Added documentation of the published API for Non-Recursive Evaluation (NRE). 2008-12-11 Jan Nijtmans * generic/tclZlib.c: Eliminate warning: different 'const' qualifiers with msvc compiler. A few more 'const' optimizations. * win/tcl.m4: Fix Windows build (msvc) for TIP #234 implementation * win/Makefile.in: * win/configure: 2008-12-11 Andreas Kupries * generic/tclIO.c (SetChannelFromAny and related): Modified the * tests/io.test: internal representation of the tclChannelType to contain not only the ChannelState pointer, but also a reference to the interpreter it was made in. Invalidate and recompute the internal representation when it is used in a different interpreter, like cmdName intrep's. Added testcase. [Bug 2407783] 2008-12-11 Donal K. Fellows * generic/tclZlib.c (ConvertError): Factor out code to turn zlib errors into Tcl errors. * doc/zlib.n: Added a start at the documentation. Still very rough. 2008-12-11 Jan Nijtmans * win/Makefile.in: Fix Windows build (mingw) for TIP #234 implementation (additionally, first make sure that zlib is available, and rename the standard zdll.lib to libz.a, but at least this works so far). 2008-12-11 Donal K. Fellows * tests/zlib.test: Start of test suite for zlib command. 2008-12-11 Jan Nijtmans * library/clock.tcl (ProcessPosixTimeZone): Fallback to European time zone DST rules, when the timezone is between 0 and -12. [Bug 2207436] * tests/clock.test (clock-52.[23]): Test cases for [Bug 2207436] 2008-12-11 Donal K. Fellows TIP #234 IMPLEMENTATION * generic/tclZlib.c: A very preliminary hack at an interface to the zlib library, based on code from Pascal Scheffers. WARNING! The C API may be subect to change without much warning! USE AT YOUR OWN RISK! 2008-12-10 Kevin B. Kenny * library/tzdata/*: Update from Olson's tzdata2008i. 2008-12-10 Alexandre Ferrieux TIP #343 IMPLEMENTATION - A Binary Specifier for [format/scan] * doc/format.n * doc/scan.n * generic/tclInt.h * generic/tclScan.c * generic/tclStrToD.c * generic/tclStringObj.c * tests/format.test * tests/scan.test 2008-12-10 Donal K. Fellows TIP #341 IMPLEMENTATION * generic/tclDictObj.c (DictFilterCmd): Made key and value filtering * tests/dict.test, doc/dict.n: accept arbitrary numbers of glob arguments. 2008-12-09 Jan Nijtmans * generic/tclInt.decls: Restore source and binary compatibility for TIP #337 implementation. (When it is _that_ simple, there is no excuse not to do it! :-)) * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: 2008-12-09 Don Porter TIP #337 IMPLEMENTATION * doc/BackgdErr.3: Converted internal routine * doc/interp.n: TclBackgroundException() into public routine * generic/tcl.decls: Tcl_BackgroundException(). * generic/tclEvent.c: * generic/tclInt.decls: * generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclIO.c: Update callers. * generic/tclIOCmd.c: * generic/tclInterp.c: * generic/tclTimer.c: *** POTENTIAL INCOMPATIBILITY only for extensions using the converted internal routine *** 2008-12-09 Donal K. Fellows * generic/tclIO.c (ChanClose,ChanRead,...): Factored out some of the code to connect to channel drivers that was common in multiple locations so as to make code more readable. 2008-12-06 Donal K. Fellows * generic/tclCmdAH.c (FileTempfileCmd): Force temporary files to be created in the native filesystem. Attempting to provide a template that puts it elsewhere will result in the directory part of the template being ignored. Partial address of [Bug 2388866] concerns. 2008-12-05 Donal K. Fellows TIP #335 IMPLEMENTATION * generic/tclBasic.c (Tcl_InterpActive): Added function for working * doc/CrtInterp.3: out if an interp is in use. TIP #307 IMPLEMENTATION * generic/tclResult.c (Tcl_TransferResult): Renamed function from * generic/tcl.decls: TclTransferResult. Added * doc/SetResult.3: to public stubs table. 2008-12-04 Don Porter * generic/tclPathObj.c (Tcl_FSGetNormalizedPath): Added another flag value TCLPATH_NEEDNORM to mark those intreps which need more complete normalization attention for correct results. [Bug 2385549] 2008-12-03 Donal K. Fellows * win/tclWinPipe.c (TclpOpenTemporaryFile): Avoid an infinite loop due to GetTempFileName/CreateFile interaction. [Bug 2380318] 2008-12-03 Don Porter * generic/tclFileName.c (DoGlob): One of the Tcl_FSMatchInDirectory calls did not have its return code checked. This caused error messages returned by some Tcl_Filesystem drivers to be swallowed. 2008-12-02 Don Porter TIP #336 IMPLEMENTATION * generic/tcl.decls: New routines Tcl_(Get|Set)ErrorLine. * generic/tcl.h: Dropped default access to interp->errorLine. * generic/tclCmdAH.c: Restore it with -DUSE_INTERP_ERRORLINE. * generic/tclCmdMZ.c: Updated callers. * generic/tclDictObj.c: * generic/tclIOUtil.c: * generic/tclNamesp.c: * generic/tclOOBasic.c: * generic/tclOODefinedCmds.c: * generic/tclOOMethod.c: * generic/tclProc.c: * generic/tclResult.c: *** POTENTIAL INCOMPATIBILITY for C code directly using the interp->errorLine field *** * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: 2008-12-02 Andreas Kupries * generic/tclIO.c (TclFinalizeIOSubsystem): Replaced Alexandre Ferrieux's first patch for [Bug 2270477] with a gentler version, also supplied by him. 2008-12-01 Don Porter * generic/tclParse.c: Coding standards fixups. 2008-12-01 Donal K. Fellows * tests/cmdAH.test (cmdAH-32.6): Test was not portable; depended on a C API function not universally available. [Bug 2371623] 2008-11-30 Kevin B. Kenny * library/clock.tcl (format, ParseClockScanFormat): Added a [string map] to get rid of namespace delimiters before caching a scan or format procedure. [Bug 2362156] * tests/clock.test (clock-64.[12]): Added test cases for the bug that was tickled by a namespace delimiter inside a format string. 2008-11-29 Donal K. Fellows TIP #210 IMPLEMENTATION * generic/tclCmdAH.c (FileTempfileCmd): * unix/tclUnixFCmd.c (TclpOpenTemporaryFile, DefaultTempDir): * win/tclWinPipe.c (TclpOpenTemporaryFile): * doc/file.n, tests/cmdAH.test: Implementation of [file tempfile]. I do not claim that this is a brilliant implementation, especially on Windows, but it covers the main points. * generic/tclThreadStorage.c: General revisions to make code clearer and more like the style used in the rest of the core. Includes adding more comments and explanation of what is going on. Reduce the amount of locking required. 2008-11-27 Alexandre Ferrieux * generic/tcl.h: Alternate fix for [Bug 2251175]: missing * generic/tclCompile.c: backslash substitution on expanded literals. * generic/tclParse.c: * generic/tclTest.c: * tests/parse.test: 2008-11-26 Jan Nijtmans * generic/tclIndexObj.c: Eliminate warning: unused variable * generic/tclTest.c: A few more (harmless) Tcl_SetResult eliminations. 2008-11-26 Kevin B. Kenny * library/tclIndex: Removed reference to no-longer-extant procedure 'tclLdAout'. * doc/library.n: Corrected mention of 'auto_exec' to 'auto_execok'. [Patch 2114900] thanks to Stuart Cassoff 2008-11-25 Jan Nijtmans * generic/tclIndexObj.c: Eliminate 3 calls to Tcl_SetResult, as * generic/tclIO.c: examples how it should have been done. * generic/tclTestObj.c: purpose: contribute in the TIP #340 discussion. 2008-11-25 Andreas Kupries * generic/tclIO.c (TclFinalizeIOSubsystem): Applied Alexandre Ferrieux's patch for [Bug 2270477] to prevent infinite looping during finalization of channels not bound to interpreters. 2008-11-25 Jan Nijtmans * generic/tclTest.c: Don't assume that Tcl_SetResult sets interp->result, especially not in a DString test, in preparation for TIP #340 2008-11-24 Donal K. Fellows * tools/tcltk-man2html.tcl: Improvements to tackle tricky aspects of cross references and new entities to map. [Bug 2330040] 2008-11-19 Jan Nijtmans * generic/tclThreadTest.c: Convert Tcl_SetResult(......, TCL_DYNAMIC) to Tcl_SetResult(......, TCL_VOLATILE), in preparation for TIP #340 2008-11-17 Jan Nijtmans * generic/tcl.decls: Fix signature and implementation of * generic/tclDecls.h: Tcl_HashStats, such that it conforms to the * generic/tclHash.c: documentation. [Bug 2308236] * generic/tclVar.c: * doc/Hash.3: * generic/tclDictObj.c: Convert Tcl_SetResult call to Tcl_SetObjResult. 2008-11-17 Alexandre Ferrieux * tests/for.test: Check for uncompiled-for-continue [Bug 2186888] fixed earlier. * generic/tcl.h: Fix [Bug 2251175]: missing backslash * generic/tclCompCmds.c: substitution on expanded literals. * generic/tclCompile.c * generic/tclParse.c * generic/tclTest.c * tests/compile.test * tests/parse.test 2008-11-16 Jan Nijtmans * generic/tclTest.c: Replace two times Tcl_SetResult with Tcl_SetObjResult, a little simplification in preparation for the TIP #340 patch. 2008-11-13 Jan Nijtmans * generic/tclInt.h: Rename static function FSUnloadTempFile to * generic/tclIOUtil.c: TclFSUnloadTempFile, needed in tclLoad.c * generic/tclLoad.c: Fixed [Bug 2269431]: Load of shared objects leaves temporary files on windows. 2008-11-12 Pat Thoyts * tests/registry.test: Use HKCU to avoid requiring admin access for registry testing on Vista/Server2008 2008-11-11 Jan Nijtmans * generic/tclNamesp.c: Eliminate warning: passing arg 4 of Tcl_SplitList from incompatible pointer type. * win/tcl.m4: Reverted change from 2008-11-06 (was under the impression that "-Wno-implicit-int" added an extra warning) * win/configure: (regenerated) * unix/tcl.m4: Use -O2 as gcc optimization compiler flag, and get rid of -Wno-implicit-int for UNIX. * unix/configure: (regenerated) 2008-11-10 Andreas Kupries * doc/platform_shell.n: Fixed [Bug 2255235], reported by Ulrich * library/platform/pkgIndex.tcl: Ring . * library/platform/shell.tcl: Updated the LOCATE command in the * library/tm.tcl: package 'platform::shell' to handle the new form * unix/Makefile.in: of 'provide' commands generated by tm.tcl. Bumped * win/Makefile.in: package to version 1.1.4. Added cross-references to the relevant parts of the code to avoid future desynchronization. 2008-11-07 Pat Thoyts * generic/tclInt.h: Applied [Patch 2215022] from Duoas to clean up * generic/tclBinary.c: the binary ensemble initiailization code. * generic/tclNamesp.c: Extends the TclMakeEnsemble to do * doc/ByteArrObj.3: sub-ensembles from tables. 2008-11-06 Jan Nijtmans * win/tcl.m4: Add "-Wno-implicit-int" flag for gcc, as on UNIX * win/configure: (regenerated) * generic/tclIO.c: Eliminate an 'array index out of bounds' warning on HP-UX. 2008-11-04 Jeff Hobbs * generic/tclPort.h: Remove the ../win/ header dir as the build system already has it, and it confuses builds when used with private headers installed. 2008-11-01 Donal K. Fellows * generic/tclOO.h (TCLOO_VERSION): Bump version of TclOO. 2008-10-31 Donal K. Fellows * generic/tclOOBasic.c (TclOONRUpcatch): Reworked the code that does * generic/tclOO.c (InitFoundation): class constructor handling so that it is more robust and runs the constructor call in the context of the caller of the class's constructor method. Needed because the previously used code did not work at all after applying the fix below; no Tcl existing command could reliably do what was needed any more. * generic/tclOODefineCmds.c (GetClassInOuterContext): Rework and factor out the code to resolve class names in definitions so that classes are resolved from the perspective of the caller of the [oo::define] command, rather than from the oo::define namespace! This makes much code simpler by reducing how often fully-qualified names are required (previously always in practice, so no back-compat issues exist). [Bug 2200824] 2008-10-28 Jan Nijtmans * generic/tclCompile.h: CONSTify TclDTraceInfo * generic/tclBasic.c: * generic/tclProc.c: * generic/tclEnv.c: Eliminate some -Wwrite-strings warnings * generic/tclLink.c: 2008-10-27 Don Porter * generic/tclEncoding.c: Use "iso8859-1" and not "identity" as the default and original [encoding system] value. Since "iso8859-1" is built in to the C source code for Tcl now, there's no availability issue, and it has the good feature of "identity" that we must have ("bytes in" == "bytes out") without the bad feature of "identity" ("broken as designed") that makes us want to abandon it. [RFE 2008609] *** POTENTIAL INCOMPATIBILITY for older releases of Tclkit and any other code expecting a particular value for Tcl's default system encoding *** 2008-10-24 Pat Thoyts * library/http/http.tcl: Fixed a failure to read SHOUTcast streams with the new 2.7 package. Introduced a new intial state as the first response may not be HTTP*. 2008-10-23 Miguel Sofer * generic/tclCmdAH.c (ForNextCallback): handle TCL_CONTINUE in the for body. [Bug 2186888] 2008-10-22 Jan Nijtmans * generic/tcl.h: CONST -> const and white-spacing * generic/tclCompile.h: * generic/tclEncoding.c: * generic/tclStubInit.c: * generic/tclStubLib.c: * generic/tcl.decls * generic/tclInt.decls * generic/tclTomMath.decls * generic/tclDecls.h: (regenerated) * generic/tclIntDecls.h: (regenerated) * generic/tclIntPlatDecls.h: (regenerated) * generic/tclOODecls.h: (regenerated) * generic/tclOOIntDecls.h: (regenerated) * generic/tclPlatDecls.h: (regenerated) * generic/tclTomMathDecls.h: (regenerated) * generic/tclIntDecls.h: (regenerated) * tools/genStubs.tcl: CONST -> const and white-spacing 2008-10-19 Don Porter * generic/tclProc.c: Reset -level and -code values to defaults after they are used. [Bug 2152286] 2008-10-19 Donal K. Fellows * generic/tclBasic.c (TclInfoCoroutineCmd): Added code to make this check for being invoked in a syntactically correct way. * doc/info.n: Added documentation of [info coroutine]. * doc/prefix.n: Improved the documentation by fixing formatting, adding good-practice recommendations and cross-references, etc. 2008-10-17 Jan Nijtmans * generic/tclOO.decls: CONST -> const. * generic/tclOODecls.h: (regenerated) * generic/tclOOIntDecls.h: (regenerated) 2008-10-17 Andreas Kupries * generic/tclIORTrans.c (DeleteReflectedTransformMap): Removed debug output in C++ comment. 2008-10-17 Don Porter * generic/tclCompile.h: Declare the internal tclInstructionTable to * generic/tclExecute.c: simply be "const", not CONST86. * generic/tclCmdAH.c: whitespace. * generic/tclCmdIL.c: Uninitialized variable warning. * generic/tclTest.c: const correctness warning. 2008-10-17 Donal K. Fellows * doc/*: Many very small formatting fixes. * doc/{glob,http,if}.n: More substantial reformatting for clarity. * doc/split.n: Remove mention of defunct c.l.t.announce 2008-10-16 Jan Nijtmans * generic/regc_locale.c: Add "const" to many internal const tables. * generic/tclClock.c: No functional or API change. * generic/tclCmdIL.c * generic/tclConfig.c * generic/tclDate.c * generic/tclEncoding.c * generic/tclEvent.c * generic/tclExecute.c * generic/tclFileName.c * generic/tclGetDate.y * generic/tclInterp.c * generic/tclIO.c * generic/tclIOCmd.c * generic/tclIORChan.c * generic/tclIORTrans.c * generic/tclLoad.c * generic/tclObj.c * generic/tclOOBasic.c * generic/tclOOCall.c * generic/tclOOInfo.c * generic/tclPathObj.c * generic/tclPkg.c * generic/tclResult.c * generic/tclStringObj.c * generic/tclTest.c * generic/tclTestObj.c * generic/tclThreadTest.c * generic/tclTimer.c * generic/tclTrace.c * macosx/tclMacOSXFCmd.c * win/cat.c * win/tclWinInit.c * win/tclWinTest.c 2008-10-16 Don Porter * library/init.tcl: Revised [unknown] so that it carefully preserves the state of the ::errorInfo and ::errorCode variables at the start of auto-loading and restores that state before the autoloaded command is evaluated. [Bug 2140628] 2008-10-15 Jan Nijtmans * generic/tclInt.h: Add "const" to many internal const tables, so * generic/tclBinary.c: those will be put by the C-compiler in the * generic/tclCompile.c: TEXT segment in stead of the DATA segment. * generic/tclDictObj.c: This makes those tables sharable in shared * generic/tclHash.c: libraries. * generic/tclListObj.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclProc.c: * generic/tclRegexp.c: * generic/tclStringObj.c: * generic/tclUtil.c: * generic/tclVar.c: 2008-10-14 Jan Nijtmans * generic/tclCmdAH.c: Fix minor compiler warnings when compiling * generic/tclCmdMZ.c: with -Wwrite-strings. * generic/tclIndexObj.c: * generic/tclProc.c: * generic/tclStubLib.c: * generic/tclUtil.c: * win/tclWinChan.c: * win/tclWinDde.c: * win/tclWinInit.c: * win/tclWinReg.c: * win/tclWinSerial.c: 2008-10-14 Donal K. Fellows * doc/binary.n: Formatting fix. 2008-10-14 Don Porter * README: Bump version number to 8.6a4 * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: * generic/tclExecute.c: Fix compile warnings when --enable-symbols=all * generic/tclCmdIL.c: Fix write to unallocated memory whenever [lrepeat] returns an empty list. 2008-10-14 Donal K. Fellows * doc/chan.n, doc/fconfigure.n: Added even more emphatic text to direct people to the correct manual pages for specific channel types, suitable for the hard-of-reading. Following discussion on tcl-core. 2008-10-13 Pat Thoyts * win/tclWinThrd.c (TclpThreadCreate): We need to initialize the thread id variable to 0 as on 64 bit windows this is a pointer sized field while windows only fills it with a 32 bit value. The result is an inability to join the threads as the ids cannot be matched. * generic/tclTest.c (TestNRELevels): Set array to the right size. 2008-10-13 Donal K. Fellows * generic/tclOOInfo.c (InfoClassDestrCmd): Handle error case. * generic/tclOOInt.h: Added macro magic to make things work with Objective C. [Bug 2163447] 2008-10-12 Miguel Sofer * generic/tclCompile.c: Fix bug in srcDelta encoding within ByteCodes. The bug can only be triggered under conditions that cannot happen in Tcl, but were met during development of L. Thanks go to Robert Netzer for diagnosis and fix. 2008-10-10 Don Porter *** 8.6a3 TAGGED FOR RELEASE *** * changes: Updates for 8.6a3 release. 2008-10-10 Donal K. Fellows * generic/tclOODefineCmds.c (TclOODefineUnexportObjCmd) (TclOODefineExportObjCmd): Corrected export/unexport record synthesis. [Bug 2155658] 2008-10-08 Jan Nijtmans * unix/tclUnixChan.c: Fix minor compiler warning. * unix/tcl.m4: Fix for [Bug 2073255] * unix/configure: Regenerated 2008-10-08 Miguel Sofer * generic/tclBasic (TclInfoCoroutineCmd): * tests/unsupported.test: Arrange for [info coroutine] to return {} when a coroutine is running but the resume command has been deleted. [Bug 2153080] 2008-10-08 Don Porter * generic/tclTrace.c: Corrected handling of errors returned by variable traces so that the errorInfo value contains the original error message. [Bug 2151707] * generic/tclVar.c: Revised implementation of TclObjVarErrMsg so that error message construction does not disturb an existing iPtr->errorInfo that may be in progress. 2008-10-07 Donal K. Fellows * doc/binary.n: Added better documentation of the [binary encode] and [binary decode] subcommands. 2008-10-07 Miguel Sofer TIP #327,#328 IMPLEMENTATIONS * generic/tclBasic.c: Move [tailcall], [coroutine] and * generic/tclCmdIL.c: [yield] out of ::tcl::unsupported * tclInt.h: * tests/info.test: and into global scope: TIPs #327 * tests/unsupported.test: and #328 2008-10-07 Donal K. Fellows * doc/chan.n, doc/transchan.n: Documented the channel transformation API of TIP #230. 2008-10-06 Pat Thoyts * tests/winFCmd.test: Fixed some erroneous tests on Vista+. * generic/tclFCmd.c: Fix constness for msvc of last commit 2008-10-06 Joe Mistachkin * tools/man2tcl.c: Added missing line from patch by Harald Oehlmann. [Bug 1934200] 2008-10-05 Jan Nijtmans * doc/FileSystem.3: CONSTified Tcl_FSFileAttrStringsProc * generic/tclFCmd.c: and tclpFileAttrStrings. This allows * generic/tclIOUtil.c: FileSystems to report their attributes * generic/tclTest.c: as const strings, without worrying that * unix/tclUnixFCmd.c: Tcl modifies them (which Tcl should not * win/tclWinFCmd.c: do anyway, but the API didn't indicate that) * generic/tcl.decls * generic/tclDecls.h: regenerated * generic/tcl.h: Make sure that if CONST84 is defined as empty, CONST86 should be defined as empty as well (unless overridden). This change complies with TIP #27 *** POTENTIAL INCOMPATIBILITY *** 2008-10-05 Kevin B, Kenny * libtommath/bn_mp_sqrt.c (bn_mp_sqrt): Handle the case where a * tests/expr.test (expr-47.13): number's square root is between n< * generic/tclInt.decls: CONSTified the AuxDataType argument * generic/tclCompCmds.c: of TclCreateAuxData and * generic/tclCompile.c: TclRegisterAuxDataType and the return * generic/tclCompile.h: values of TclGetAuxDataType and * generic/tclExecute.c: TclGetInstructionTable * generic/tclIntDecls.h: regenerated This change complies with TIP #27 (even though it only involves internal function, so this is not even necessary). 2008-10-05 Donal K. Fellows * generic/tclIndexObj.c (TclInitPrefixCmd): Make the [tcl::prefix] into an exported command. [Bug 2144595] 2008-10-04 Donal K. Fellows * generic/tclCmdIL.c (InfoFrameCmd): Improved hygiene of result * generic/tclRegexp.c (TclRegAbout): handling. 2008-10-04 Jan Nijtmans * generic/tclLoad.c: Make sure that any library which doesn't have an unloadproc is only really unloaded when no library code is executed yet. [Bug 2059262] 2008-10-04 Donal K. Fellows * generic/tclOOInfo.c (GetClassFromObj): Factor out the code to parse a Tcl_Obj and get a class. Also make result handling hygienic. * generic/tclOOBasic.c (TclOOSelfObjCmd): Better hygiene of results, and stop allocating quite so much memory by sharing special "method" names. 2008-10-04 Jan Nijtmans * doc/ChnlStack.3: CONSTified the typePtr argument * doc/CrtChannel.3: of Tcl_CreateChannel and Tcl_StackChannel * generic/tcl.decls: and the return value of Tcl_GetChannelType * generic/tcl.h * generic/tclIO.h * generic/tclIO.c * generic/tclDecls.h: regenerated This change complies with TIP #27. * doc/Hash.3: CONSTified the typePtr argument * generic/tcl.decls: of Tcl_InitCustomHashTable. * generic/tcl.h * generic/tclHash.c * generic/tclDecls.h: regenerated This change complies with TIP #27. * doc/RegConfig.3: CONSTified the configuration argument * generic/tcl.decls: of Tcl_RegisterConfig. * generic/tcl.h * generic/tclConfig.c * generic/tclPkgConfig.c * generic/tclDecls.h: regenerated This change complies with TIP #27. * doc/GetIndex.3: CONSTified the tablePtr argument * generic/tcl.decls: of Tcl_GetIndexFromObj. * generic/tclIndexObj.c * generic/tclDecls.h: regenerated This change complies with TIP #27. 2008-10-03 Miguel Sofer * tests/stack.test: * unix/tclUnixTest.c: Removed test command teststacklimit and the corresponding constraint: it is not needed with NRE 2008-10-03 Donal K. Fellows TIP #195 IMPLEMENTATION * generic/tclIndexObj.c (TclGetIndexFromObjList, PrefixMatchObjCmd) * doc/prefix.n, tests/string.test: Added [tcl::prefix] command for working with prefixes of strings at the Tcl level. [Patch 1040206] TIP #265 IMPLEMENTATION * generic/tclIndexObj.c (Tcl_ParseArgsObjv, PrintUsage): * generic/tcl.h (Tcl_ArgvInfo): Added function for simple parsing of * doc/ParseArgs.3 (new file): optional arguments to commands. Still needs tests and the like. [FRQ 1446696] Note that some of the type signatures are changed a bit from the proposed implementation so that they better reflect codified good practice for argument order. 2008-10-02 Andreas Kupries * tests/info.test (info-23.3): Updated output of the test to handle the NRE-enabled eval and the proper propagation of location information through it. [Bug 2017632] * doc/info.n: Rephrased the documentation of 'info frame' for positive numbers as level argument. [Bug 2134049] * tests/info.test (info-22.8): Made pattern for file containing tcltest less specific to accept both .tcl and .tm variants of the file during matching. [Bug 2129828] 2008-10-02 Don Porter TIP #330 IMPLEMENTATION * generic/tcl.h: Remove the "result" and "freeProc" fields * generic/tclBasic.c: from the default public declaration of the * generic/tclResult.c: Tcl_Interp struct. Code should no longer * generic/tclStubLib.c: be accessing these fields. Access can be * generic/tclTest.c: restored by defining USE_INTERP_RESULT, but * generic/tclUtil.c: that should only be a temporary migration aid. *** POTENTIAL INCOMPATIBILITY *** 2008-10-02 Joe Mistachkin * doc/info.n: Fix unmatched font change. * doc/tclvars.n: Fix unmatched font change. * doc/variable.n: Fix unmatched font change. * tools/man2help2.tcl: Integrated patch from Harald Oehlmann. [Bug 1934272] * tools/man2tcl.c: Increase MAX_LINE_SIZE to fix "Too long line" error. * win/buildall.vc.bat: Prefer the HtmlHelp target over the WinHelp target. [Bug 2072891] * win/makefile.vc: Fix the HtmlHelp and WinHelp targets to not be mutually exclusive. 2008-09-29 Don Porter TIP #323 IMPLEMENTATION (partial) * doc/glob.n: Revise [glob] to accept zero patterns. * generic/tclFileName.c: * tests fileName.test: * doc/linsert.n: Revise [linsert] to accept zero elements. * generic/tclCmdIL.c: * tests/linsert.test: 2008-09-29 Donal K. Fellows TIP #326 IMPLEMENTATION * generic/tclCmdIL.c (Tcl_LsortObjCmd): Added -stride option to carry * doc/lsort.n, tests/cmdIL.test: out sorting of lists where the elements are grouped. Adapted from [Patch 2082681] TIP #313 IMPLEMENTATION * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Added -bisect option to * doc/lsearch.n, tests/lsearch.test: allow the finding of the place to insert an element in a sorted list when that element is not already there. [Patch 1894241] TIP #318 IMPLEMENTATION * generic/tclCmdMZ.c (StringTrimCmd,StringTrimLCmd,StringTrimRCmd): Update the default set of trimmed characters to include some from the larger UNICODE space. Factor out the default trim set into a macro so that it is easier to keep them in synch. 2008-09-28 Donal K. Fellows TIP #314 IMPLEMENTATION * generic/tclCompCmds.c (TclCompileEnsemble) * generic/tclNamesp.c (NamespaceEnsembleCmd) (Tcl_SetEnsembleParameterList, Tcl_GetEnsembleParameterList) (NsEnsembleImplementationCmdNR): * generic/tcl.decls, doc/Ensemble.3, doc/namespace.n * tests/namespace.test: Allow the handling of a (fixed) number of formal parameters between an ensemble's command and subcommand at invocation time. [Patch 1901783] 2008-09-28 Miguel Sofer * generic/tclBasic.c: Fix the numLevels computations on * generic/tclInt.h: coroutine yield/resume * tests/unsupported.test: 2008-09-27 Donal K. Fellows * generic/tclFileName.c (Tcl_GetBlock*FromStat): Made this work acceptably when working with OSes that don't support reporting the block size from the stat() call. [Bug 2130726] * generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Improve the handling of the case where the combination of number of elements and repeat count causes the resulting list to be too large. [Bug 2130992] 2008-09-26 Don Porter TIP #323 IMPLEMENTATION (partial) * doc/lrepeat.n: Revise [lrepeat] to accept both zero * generic/tclCmdIL.c: repetitions and zero elements to be repeated. * tests/lrepeat.test: * doc/object.n: Revise standard oo method [my variable] to * generic/tclOOBasic.c: accept zero variable names. * tests/oo.test: * doc/tm.n: Revise [tcl::tm::path add] and * library/tm.tcl: [tcl::tm::path remove] to accept zero paths. * tests/tm.test: * doc/namespace.n: Revise [namespace upvar] to accept zero * generic/tclNamesp.c: variable names. * tests/upvar.test: * doc/lassign.n: Revise [lassign] to accept zero variable names. * generic/tclCmdIL.c: * tests/cmdIL.test: 2008-09-26 Donal K. Fellows * generic/tclOO.h (TCLOO_VERSION): Bump the version. 2008-09-25 Don Porter TIP #323 IMPLEMENTATION (partial) * doc/global.n: Revise [global] to accept zero variable names. * doc/variable.n: Revise [variable] likewise. * generic/tclVar.c: * tests/proc-old.test: * tests/var.test: * doc/global.n: Correct false claim about [info locals]. 2008-09-25 Donal K. Fellows TIP #315 IMPLEMENTATION * tests/platform.test: Update tests to expect revised results * tests/safe.test: corresponding to the TIP 315 change. * unix/tclUnixInit.c, win/tclWinInit.c (TclpSetVariables): * doc/tclvars.n (tcl_platform): Define what character is used for separating PATH-like lists. Forms part of the tcl_platform array. * generic/tclOOCall.c (InitCallChain, IsStillValid): * tests/oo.test (oo-25.2): Revise call chain cache management so that it takes into account class-wide caching correctly. [Bug 2120903] 2008-09-24 Don Porter TIP #323 IMPLEMENTATION (partial) * doc/file.n: Revise [file delete] and [file mkdir] to * generic/tclCmdAH.c: accept zero "pathname" arguments (the * generic/tclFCmd.c: no-op case). * tests/cmdAH.test: * tests/fCmd.test: 2008-09-24 Donal K. Fellows * generic/tclOOMethod.c (DBPRINT): Remove obsolete debugging macro. [Bug 2124814] TIP #316 IMPLEMENTATION * generic/tcl.decls, generic/tclFileName.c (Tcl_GetSizeFromStat, etc): * doc/FileSystem.3: Added reader functions for Tcl_StatBuf. 2008-09-23 Donal K. Fellows * doc/Method.3: Corrected documentation. [Patch 2082450] * doc/lreverse.n, mathop.n, regexp.n, regsub.n: Make sure that the initial line of the manpage includes nothing that chokes old versions of man. [Bug 2118123] 2008-09-22 Donal K. Fellows TIP #320 IMPLEMENTATION * generic/tclOODefineCmds.c (TclOODefineVariablesObjCmd): * generic/tclOOInfo.c (InfoObjectVariablesCmd, InfoClassVariablesCmd): * generic/tclOOMethod.c (TclOOSetupVariableResolver, etc): * doc/define.n, doc/ooInfo.n, benchmarks/cps.tcl: * tests/oo.test (oo-26.*): Allow the declaration of the common variables used in methods of a class or object. These are then mapped in using a variable resolver. This makes many class declarations much simpler overall, encourages good usage of variable names, and also boosts speed a bit. * generic/tclOOMethod.c (TclOOGetMethodBody): Factor out the code to get the body of a procedure-like method. Reduces the amount of "poking inside the abstraction" that is done by the introspection code. 2008-09-22 Alexandre Ferrieux * doc/chan.n: Clean up paragraph order. 2008-09-18 Miguel Sofer * generic/tclExecute.c (NEXT_INST_F): * generic/tclInt.h (TCL_CT_ASSERT): New compile-time assertions, adapted from www.pixelbeat.org/programming/gcc/static_assert.html 2008-09-17 Don Porter * generic/tclInt.h: Correct the TclGetLongFromObj, TclGetIntFromObj, and TclGetIntForIndexM macros so that they retrieve the longValue field from the internalRep instead of casting the otherValuePtr field to type long. 2008-09-17 Miguel Sofer * library/init.tcl: Export min and max commands from the mathfunc namespace. [Bug 2116053] 2008-09-16 Joe Mistachkin * generic/tclParse.c: Move TclResetCancellation to be called on returning to level 0, as opposed to it being called on starting a substitution at level 0. 2008-09-16 Miguel Sofer * generic/tclBasic.c: Move TclResetCancellation to be called on returning to level 0, as opposed to it being called on starting a command at level 0. Add a call on returning via Tcl_EvalObjEx to fix [Bug 2114165]. 2008-09-10 Donal K. Fellows * doc/binary.n: Added partial documentation of [binary encode] and [binary decode]. * tests/binary.test,cmdAH.test,cmdIL.test,cmdMZ.test,fileSystem.test: More use of tcltest2 to simplify the tests as exposed to people. * tests/compile.test (compile-18.*): Added *some* tests of the disassmbler, though not of its output format. 2008-09-10 Miguel Sofer * tests/nre.test: Add missing constraints; enable test of foreach recursion. * generic/tclBasic.c: * generic/tclCompile.h: * generic/tclExecute.c (INST_EVAL_STK): Wrong numLevels when evaling a canonical list. [Bug 2102930] 2008-09-10 Donal K. Fellows * generic/tclListObj.c (Tcl_ListObjGetElements): Make this list->dict transformation - encountered when using [foreach] with dicts - not as expensive as it was before. Spotted by Kieran Elby and reported on tcl-core. 2008-09-08 Donal K. Fellows * tests/append.test, appendComp.test, cmdAH.test: Use the powers of tcltest2 to make these files simpler. 2008-09-07 Miguel Sofer * generic/tclCompile.c (TclCompileTokens): * generic/tclExecute.c (CompileExprObj): Fix a perf bug (found by Alex Ferrieux) where some variables in the LVT where not being accessed by index. Fix missing localCache management in compiled expressions found while analyzing the bug. 2008-09-07 Miguel Sofer * doc/namespace.n: Fix [Bug 2098441] 2008-09-04 Miguel Sofer * generic/tclTrace.test (TraceVarProc): * generic/unsupported.test: Insure that unset traces are run even when the coroutine is unwinding. [Bug 2093947] * generic/tclExecute.c (CACHE_STACK_INFO): * tests/unsupported.test: Restore execEnv's bottomPtr. [Bug 2093188] 2008-09-02 Don Porter * generic/tcl.h: Stripped "callers" of the _ANSI_ARGS_ macro * compat/dirent2.h: to support a TCL_NO_DEPRECATED build. * compat/dlfcn.h: * unix/tclUnixPort.h: * generic/tcl.h: Removed the conditional #define of _ANSI_ARGS_ that would support pre-prototype C compilers. Since _ANSI_ARGS_ is no longer used in tclDecls.h, it's clear no one compiling against Tcl 8.5 headers is making use of a -DNO_PROTOTYPES configuration. 2008-09-02 Donal K. Fellows * tests/socket.test: Rewrote so as to use tcltest2 better. 2008-09-01 Miguel Sofer * generic/tclCmdAH.c: NRE-enabling [eval]; eval scripts are now * generic/tclOOBasic.c: bytecompiled. Adapted recursion limit tests * tests/interp.test: that were relying on eval not being * tests/nre.test: compiled. Part of the [Bug 2017632] project. * tests/unsupported.test: 2008-09-01 Donal K. Fellows * generic/tclOOMethod.c (InvokeProcedureMethod): * generic/tclOO.c (ObjectRenamedTrace): Arrange for only methods that involve callbacks into the Tcl interpreter to be skipped when the interpreter is being torn down. Allows the semantics of destructors in a dying interpreter to be more useful when they're implemented in C. 2008-08-29 Donal K. Fellows * unix/Makefile.in: Ensure that all TclOO headers get installed. * win/Makefile.in: [Bug 2082299] * win/makefile.bc: * win/makefile.vc: 2008-08-28 Don Porter * README: Bump version number to 8.6a3 * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: 2008-08-27 Donal K. Fellows * doc/tclvars.n, doc/library.n: Ensured that these two manual pages properly cross-reference each other. Issue reported on Tcler's Chat. 2008-08-26 Miguel Sofer * generic/tclBasic.c (InfoCoroutine): * tests/unsupported.test: New command that returns the FQN of the currently executing coroutine. Lives as infoCoroutine under unsupported, but is designed to become a subcommand of [info] 2008-08-23 Miguel Sofer * generic/tclBasic.c (NRInterpCoroutine): Store the caller's eePtr, stop assuming the coroutine is invoked from the same execEnv where it was created. 2008-08-24 Donal K. Fellows * generic/tclCmdAH.c (TclNRForeachCmd): Converted the [foreach] command to have an NRE-aware non-compiled implementation. Part of the [Bug 2017632] project. Also restructured the code so as to manage its temporary memory more efficiently. 2008-08-23 Miguel Sofer * generic/tclBasic.c: Removed unused var; fixed function pointer * generic/tclOOInt.h: declarations (why did gcc start complaining * generic/tclOOMethod.c: all of a sudden?) * generic/tclProc.c: 2008-08-23 Donal K. Fellows * generic/tclInt.h (EnsembleImplMap): Added extra field to make it * generic/tclNamesp.c (TclMakeEnsemble): easier to build non-recursive ensembles in the core. * generic/tclDictObj.c (DictForNRCmd): Converted the [dict for] command to have an NRE-aware non-compiled implementation. Part of the [Bug 2017632] project. 2008-08-22 Miguel Sofer * generic/tclBasic.c: * generic/tclExecute.c: Set special errocodes: COROUTINE_BUSY, COROUTINE_CANT_YIELD, COROUTINE_ILLEGAL_YIELD. 2008-08-22 Don Porter *** 8.6a2 TAGGED FOR RELEASE *** * changes: Updates for 8.6a2 release. * generic/tcl.h: Drop use of USE_COMPAT85_CONST. That added indirection without value. Use -DCONST86="" to engage source compat support for code written for 8.5 headers. * generic/tclUtil.c (TclReToGlob): Added missing set of the *exactPtr value to really fix [Bug 2065115]. Also avoid possible DString overflow. * tests/regexpComp.test: Correct duplicate test names. 2008-08-21 Miguel Sofer * generic/tclBasic.c: Previous fix, now done right. * generic/tclCmdIL.c: * generic/tclInt.h: * tests/unsupported.test: 2008-08-21 Jeff Hobbs * tests/regexp.test, tests/regexpComp.test: Correct re2glob ***= * generic/tclUtil.c (TclReToGlob): translation from exact to anywhere-in-string match. [Bug 2065115] 2008-08-21 Don Porter * generic/tcl.h: Reduced the use of CONST86 and eliminated * generic/tcl.decls: the use of CONST86_RETURN to support source code compatibility with Tcl 8.5 on those public routines passing (Tcl_Filesystem *), (Tcl_Timer *), and (Tcl_Objtype *) values which have been const-ified. What remains is the minimum configurability needed to support code written for pre-8.6 headers via the new -DUSE_COMPAT85_CONST compiler directive. *** POTENTIAL INCOMPATIBILITY *** * generic/tclDecls.h: make genstubs 2008-08-21 Miguel Sofer * generic/tclBasic.c: Fix the cmdFrame level count in * generic/tclCmdIL.c: coroutines. Fix small bug on coroutine * generic/tclInt.h: rewind. 2008-08-21 Donal K. Fellows * generic/tclProc.c (Tcl_DisassembleObjCmd): Added ability to disassemble TclOO methods. The code to do this is very ugly. 2008-08-21 Pat Thoyts * generic/tclOOMethod.c: Added casts to make MSVC happy * generic/tclBasic.c: 2008-08-20 Donal K. Fellows * generic/tclOO.c (AllocObject): Suppress compilation of commands in the namespace allocated for each object. * generic/tclOOMethod.c (PushMethodCallFrame): Restore some of the hackery that makes calling methods of classes fast. Fixes performance problem introduced by the fix of [Bug 2037727]. * generic/tclCompile.c (TclCompileScript): Allow the suppression of * generic/tclInt.h (NS_SUPPRESS_COMPILATION): compilation of commands * generic/tclNamesp.c (Tcl_CreateNamespace): from a namespace or its children. 2008-08-20 Daniel Steffen * generic/tclTest.c (TestconcatobjCmd): Fix use of internal-only TclInvalidateStringRep macro. [Bug 2057479] 2008-08-17 Miguel Sofer * generic/tclBasic.c: Implementation of [coroutine] and [yield] * generic/tclCmdAH.c: commands (in tcl::unsupported). * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclInt.h: * tests/unsupported.test: * generic/tclTest.c (TestconcatobjCmd): * generic/tclUtil.c (Tcl_ConcatObj): * tests/util.test (util-4.7): Fix [Bug 1447328]; the original "fix" turned Tcl_ConcatObj() into a hairy monster. This was exposed by [Bug 2055782]. Additionally, Tcl_ConcatObj could corrupt its input under certain conditions! *** NASTY BUG FIXED *** 2008-08-16 Miguel Sofer * generic/tclExecute.c: Better cmdFrame management 2008-08-14 Don Porter * tests/fileName.test: Revise new tests for portability to case insensitive filesystems. 2008-08-14 Daniel Steffen * generic/tclBasic.c (TclNREvalObjv, Tcl_NRCallObjProc): * generic/tclProc.c (TclNRInterpProcCore, InterpProcNR2): DTrace probes for NRE. [Bug 2017160] * generic/tclBasic.c (TclDTraceInfo): Add two extra arguments to * generic/tclCompile.h: DTrace 'info' probes for tclOO * generic/tclDTrace.d: method & class/object info. * generic/tclCompile.h: Add support for debug logging of DTrace * generic/tclBasic.c: 'proc', 'cmd' and 'inst' probes (does _not_ require a platform with DTrace). * generic/tclCmdIL.c (TclInfoFrame): Check fPtr->line before dereferencing as line info may not exists when TclInfoFrame() is called from a DTrace probe. * tests/fCmd.test (fCmd-6.23): Made result matching robust when test workdir and /tmp are not on same FS. * unix/tclUnixThrd.c: Remove unused TclpThreadGetStackSize() * generic/tclInt.h: and related ifdefs and autoconf tests. * unix/tclUnixPort.h: [Bug 2017264] (jenglish) * unix/tcl.m4: * unix/Makefile.in: Ensure Makefile shell is /bin/bash for * unix/configure.in (SunOS): DTrace-enabled build on Solaris. (followup to 2008-06-12) [Bug 2016584] * unix/tcl.m4 (SC_PATH_X): Check for libX11.dylib in addition to libX11.so et al. * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 2008-08-13 Miguel Sofer * tests/nre.test: Added test for large {*}-expansion effects 2008-08-13 Don Porter * generic/tclFileName.c: Fix for errors handling -types {} * tests/fileName.test: option to [glob]. [Bug 1750300] Thanks to Matthias Kraft and George Peter Staplin. 2008-08-12 Jeff Hobbs * generic/tclOOInfo.c (InfoObjectDefnCmd, InfoObjectMixinsCmd): Fix # args displayed. [Bug 2048676] 2008-08-08 Don Porter * generic/tclOOMethod.c (PushMethodCallFrame): Added missing check for bytecode validity. [Bug 2037727] * generic/tclProc.c (TclProcCompileProc): On recompile of a proc, clear away any entries on the CompiledLocal list from the previous compile. This will prevent compile of temporary variables in the proc body from growing the localCache arbitrarily large. * README: Bump version number to 8.6a2 * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: * changes: Updates for 8.6a2 release. 2008-08-11 Pat Thoyts * library/http/http.tcl: Remove 8.5 requirement. * library/http/pkgIndex.tcl: * unix/Makefile.in: * win/Makefile.in: * win/makefile.vc: 2008-08-11 Andreas Kupries * library/tm.tcl: Added a 'package provide' command to the generated ifneeded scripts of Tcl Modules, for early detection of conflicts between the version specified through the file name and a 'provide' command in the module implementation, if any. Note that this change also now allows Tcl Modules to not provide a 'provide' command at all, and declaring their version only through their filename. * generic/tclProc.c (Tcl_ProcObjCmd): Fixed memory leak triggered by * tests/proc.test: procbody::test::proc. See [Bug 2043636]. Added a test case demonstrating the leak before the fix. Fixed a few spelling errors in test descriptions as well. 2008-08-11 Don Porter * library/http/http.tcl: Bump http version to 2.7.1 to account * library/http/pkgIndex.tcl: for [Bug 2046486] bug fix. This * unix/Makefile.in: release of http now requires a * win/Makefile.in: dependency on Tcl 8.5 to be able to * win/makefile.bc: use the unsigned formats in the * win/makefile.vc: [binary scan] command. 2008-08-11 Pat Thoyts * library/http/http.tcl: CRC field from zlib data should be treated as unsigned for 64bit support. [Bug 2046846] 2008-08-10 Miguel Sofer * generic/tclProc.c: Completely removed ProcCompileProc, which was a fix for [Bug 1482718]. This is not needed at least since varReform, where the local variable data at runtime is read from the CallFrame and/or the LocalCache. 2008-08-09 Miguel Sofer * generic/tclBasic.c: Slight cleanup * generic/tclCompile.h: * generic/tclExecute.c: 2008-08-09 Daniel Steffen * generic/tclExecute.c: Fix warnings. * generic/tclOOMethod.c (PushMethodCallFrame): Fix uninitialized efi name field. * tests/lrange.test (lrange-1.17): Add test cleanup; whitespace. 2008-08-08 Don Porter * changes: Updates for 8.6a2 release. 2008-08-08 Kevin Kenny * library/tzdata/CET: * library/tzdata/MET: * library/tzdata/Africa/Casablanca: * library/tzdata/America/Eirunepe: * library/tzdata/America/Rio_Branco: * library/tzdata/America/Santarem: * library/tzdata/America/Argentina/San_Luis: * library/tzdata/Asia/Karachi: * library/tzdata/Europe/Belgrade: * library/tzdata/Europe/Berlin: * library/tzdata/Europe/Budapest: * library/tzdata/Europe/Sofia: * library/tzdata/Indian/Mauritius: Olson's tzdata2008e. 2008-08-07 Miguel Sofer * generic/tclBasic.c: Fix tailcalls falling out of tebc into * generic/tclExecute.c: Tcl_EvalEx. [Bug 2017946] * generic/tclInt.h: 2008-08-06 Don Porter * generic/tclOO.c: Revised TclOO's check for an interp being deleted during handling of object command deletion. The old code was relying on documented features of command delete traces that do not in fact work. [Bug 2039178] * tests/oo.test (oo-26.*): Added tests that demonstrate failure of TclOO to check for various kinds of invalid bytecode during method dispatch. [Bug 2037727] 2008-08-06 Miguel Sofer * generic/tclVar.c (TclLookupSimpleVar): Fix bug that the core could not trigger before TclOO: the number of locals was being read from the Proc, which can under some circumstance be out of sync with the localCache's. Found by dgp while investigating [Bug 2037727]. * library/init.tcl (::unknown): Removed the [namespace inscope] hack that was maintained for Itcl *** POTENTIAL INCOMPATIBILITY *** for Itcl Itcl users will need a new release with Itcl's [Patch 2040295], or else load the tiny script in that patch by themselves (rewrite ::unknown). Note that it is a script-only patch. 2008-08-05 Joe English * unix/tclUnixChan.c: Streamline async connect logic [Patch 1994512] 2008-08-05 Miguel Sofer * generic/tclExecute.c: Fix for [Bug 2038069] by dgp. * tests/execute.test: 2008-08-04 Miguel Sofer * tests/nre.test: Added tests for [if], [while] and [for]. A test for [foreach] has been added and marked as knownbug, awaiting for it to be NR-enabled. * generic/tclBasic.c: Made atProcExit commands run * generic/tclCompile.h: unconditionally, streamlined * generic/tclExecute.c: atProcExit/tailcall processing in TEBC. * generic/tclProc.c: * tests/unsupported.test: 2008-08-04 Don Porter * generic/tclExecute.c: Stopped faulty double-logging of errors to * tests/execute.test: stack trace when a compile epoch bump triggers fallback to direct evaluation of commands in a compiled script. [Bug 2037338] 2008-08-03 Miguel Sofer * generic/tclBasic.c: New unsupported command atProcExit that * generic/tclCompile.h: shares the implementation with tailcall. * generic/tclExecute.c: Fixed a segfault in tailcalls. Tests added. * generic/tclInt.h: * generic/tclInterp.c: * generic/tclNamesp.c: * tests/unsupported.test: 2008-08-02 Miguel Sofer * tests/NRE.test (removed): Migrated tests to standard locations, * tests/nre.test (new): separating core functionality from the * tests/unsupported.test (new): experimental commands. 2008-08-01 Jeff Hobbs * doc/Exit.3: Do not call Tcl_Finalize implicitly * generic/tclEvent.c: on DLL_PROCESS_DETACH as it may lead * win/tclWin32Dll.c (DllMain): to issues and the user should be explicitly calling Tcl_Finalize before unloading regardless. Clarify the docs to note the explicit need in embedded use. 2008-08-01 Don Porter * generic/tclBasic.c: Revised timing of the CmdFrame stack * tests/info.test: management in TclEvalEx so that the CmdFrame will still be on the stack at the time Tcl_LogCommandInfo is called to append another level of -errorinfo information. Sets the stage to add file and line data to the stack trace. Added test to check that [info frame] functioning remains unchanged by the revision. 2008-07-31 Miguel Sofer * tests/NRE.test: Replaced all deep-recursing tests by shallower tests that actually measure the C-stack depth. This makes them bearable again (even under memdebug) and avoid crashing on failure. * generic/tclBasic.c: NR-enabling [catch], [if] and [for] and * generic/tclCmdAH.c: [while] (the script, not the tests) * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclInt.h: * tests/NRE.test: * generic/tclBasic.c: Moved the few remaining defs from tclNRE.h to * generic/tclDictObj.c: tclInt.h, eliminated inclusion of tclNRE.h * generic/tclExecute.c: everywhere. * generic/tclInt.h: * generic/tclInterp.c: * generic/tclNRE.h (removed): * generic/tclNamesp.c: * generic/tclOOBasic.c: * generic/tclOOInt.h: * generic/tclProc.c: * generic/tclTest.c: * unix/Makefile.in: 2008-07-30 Miguel Sofer * generic/tclBasic.c: Improved tailcalls. * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclTest.c: * tests/NRE.test: * generic/tclBasic.c (TclNREvalObjEx): New comments and code reorg to clarify what is happening. * generic/tclBasic.c: Guard against the value of iPtr->evalFlags changing between the times where TEOV and TEOV_exception run. Thanks dgp for catching this. 2008-07-29 Miguel Sofer * tests/NRE.test: New tests that went MIA in the NRE revamping * generic/tclBasic.c: Clean up * generic/tclNRE.h: * generic/tclExecute.c: * generic/tclBasic.c: Made use of the thread's alloc cache stored in * generic/tclInt.h: the ekeko at interp creation to avoid hitting * generic/tclNRE.h: the TSD each time an NRE callback is pushed or * generic/tclThreadAlloc.c: pulled; the approach is suitably general to extend to every other obj allocation where an interp is know; this is left for some other time, requires a lot of grunt work. * generic/tclExecute.c: Fix [Bug 2030670] that cause TclStackRealloc to panic on rare corner cases. Thx ajpasadyn for diagnose and patch. * generic/tcl.decls: Completely revamped NRE implementation, with * generic/tclBasic.c: (almost) unchanged API. * generic/tclCompile.h: * generic/tclExecute.c: TEBC will require a bit of a facelift, but * generic/tclInt.decls: TEOV at least looks great now. There are new * generic/tclInt.h: tests (incomplete!) to verify that execution * generic/tclInterp.c: is indeed in the same TEBC instance, at the * generic/tclNRE.h: same level in all stacks involved. Tailcalls * generic/tclNamesp.c: are still a bit leaky, still deserving to be * generic/tclOOBasic.c: in tcl::unsupported. * generic/tclOOMethod.c: * generic/tclProc.c: Uninit'd var warnings in TEBC with -O2, no * generic/tclTest.c: warnings otherwise. 2008-07-28 Jan Nijtmans * doc/FileSystem.3: CONSTified many functions using * generic/tcl.decls: Tcl_FileSystem which all are supposed * generic/tclDecls.h: to be a constant, but this was not * generic/tclFileSystem.h: reflected in the API: Tcl_FSData, * generic/tclIOUtil.c: Tcl_FSGetInternalRep, Tcl_FSRegister, * generic/tclPathObj.c: Tcl_FSNewNativePath, Tcl_FSUnregister, * generic/tclTest.c: Tcl_FSGetFileSystemForPath ... This change complies with TIP #27. ***POTENTIAL INCOMPATIBILITY*** 2008-07-28 Andreas Kupries * generic/tclBasic.c: Added missing ref count when creating an empty string as path (TclEvalEx). In 8.4 the missing code caused panics in the testsuite. It doesn't in 8.5. I am guessing that the code path with the missing the incr-refcount is not invoked any longer. Because the bug in itself is certainly the same. 2008-07-27 Donal K. Fellows * generic/tclOOMethod.c (PushMethodCallFrame): Remove hack that should have gone when this code was merged into Tcl. 2008-07-27 Jan Nijtmans * doc/Object.3: CONSTified 3 functions using Tcl_ObjType * doc/ObjectType.3: which all are supposed to be a constant, but * generic/tcl.decls: this was not reflected in the API: * generic/tcl.h: Tcl_RegisterObjType, Tcl_ConvertToType, * generic/tclDecls.h: Tcl_GetObjType * generic/tclObj.c: Introduced a CONST86_RETURN, so extensions * generic/tclCompCmds.c: which use Tcl_ObjType directly can be * generic/tclOOMethod.c: modified to compile against both Tcl 8.5 and * generic/tclTestobj.c: Tcl 8.6. tclDecls.h regenerated This change complies with TIP #27. ***POTENTIAL INCOMPATIBILITY*** 2008-07-25 Andreas Kupries * test/info.test: More work on singleTestInterp usability. [1605269] * tests/info.test: Tests 38.* added, exactly testing the tracking of location for uplevel scripts. Resolved merge conflict on info-37.0, switched !singleTestInterp constraint to glob matching instead. Ditto info-22.8, removed constraint, more glob matching, and reduced the depth of the stack we check. More is coming, right now I want to commit the bug fixes. * tests/oo.test: Updated oo-22.1 for expanded location tracking. * generic/tclCompile.c (TclInitCompileEnv): Reorganized the initialization of the #280 location information to match the flow in TclEvalObjEx to get more absolute contexts. * generic/tclBasic.c (TclEvalObjEx): Added missing cleanup of extended location information. 2008-07-25 Daniel Steffen * tests/info.test (info-37.0): Add !singleTestInterp constraint; (info-22.8, info-23.0): switch to glob matching to avoid sensitivity to tcltest.tcl line number changes, remove knownBug constraint, fix expected result. [Bug 1605269] 2008-07-24 Jan Nijtmans * doc/Notifier.3: CONSTified 4 functions in the Notifier which * doc/Thread.3: all have a Tcl_Time* in it which is supposed * generic/tcl.decls: to be a constant, but this was not reflected * generic/tcl.h: reflected in the API: * generic/tclDecls.h: Tcl_SetTimer, Tcl_WaitForEvent, * generic/tclNotify.c: Tcl_ConditionWait, Tcl_SetMaxBlockTime * macosx/tclMacOSXNotify.c: * generic/tclThread.c: Introduced a CONST86, so extensions which have * unix/tclUnixNotfy.c: have their own Notifier (are there any?) can * unix/tclUnixThrd.c: can be modified to compile against both Tcl * win/tclWinNotify.c: Tcl 8.5 and Tcl 8.6 * win/tclWinThrd.c: Regenerated tclDecls.h with "make stubs". This change complies with TIP #27 ***POTENTIAL INCOMPATIBILITY*** 2008-07-23 Alexandre Ferrieux * tests/lrange.test: Added relative speed test to check for lrange in-place optimization committed 2008-06-30. * tests/binary.test: Added relative speed test to check for pure byte array CONCAT1 optimization committed 2008-06-30. 2008-07-23 Andreas Kupries * tests/info.test: Reordered the tests to have monotonously increasing numbers. * generic/tclBasic.c: Modified TclArgumentGet to reject pure lists * generic/tclCmdIL.c: immediately, without search. Reworked setup of * generic/tclCompile.c: eoFramePtr, doesn't need the line information, * tests/info.test: more sensible to have everything on line 1 when eval'ing a pure list. Updated the users of the line information to special case this based on the frame type (i.e. TCL_LOCATION_EVAL_LIST). Added a testcase demonstrating the new behaviour. 2008-07-23 Miguel Sofer * generic/tclBasic.c (GetCommandSource): Added comment with explanation and warning for waintainers. 2008-07-22 Andreas Kupries * generic/tclCompile.c: Made the new TclEnterCmdWordIndex static, and * generic/tclCompile.h: ansified. * generic/tclBasic.c: Ansified the new functions. Added missing function comments. * generic/tclBasic.c: Reworked the handling of bytecode literals for * generic/tclCompile.c: #280 to fix the abysmal performance for deep * generic/tclCompile.h: recursion, replaced the linear search through * generic/tclExecute.c: the whole stack with another hashtable and * generic/tclInt.h: simplified the data structure used by the compiler by using an array instead of a hashtable. Incidentially this also fixes the memory leak reported via [Bug 2024937]. 2008-07-22 Miguel Sofer * generic/tclBasic.c: Added numLevels field to CommandFrame, let * generic/tclExecute.c: GetCommandSource use it. This solves [Bug * generic/tclInt.h: 2017146]. Thx dgp for the analysis. 2008-07-21 Andreas Kupries * generic/tclBasic.c: Extended the existing TIP #280 system (info * generic/tclCmdAH.c: frame), added the ability to track the absolute * generic/tclCompCmds.c: location of literal procedure arguments, and * generic/tclCompile.c: making this information available to uplevel * generic/tclCompile.h: eval, and siblings. This allows proper * generic/tclInterp.c: tracking of absolute location through custom * generic/tclInt.h: (Tcl-coded) control structures based on uplevel, * generic/tclNamesp.c: etc. * generic/tclProc.c: * tests/info.test: 2008-07-21 Jan Nijtmans * generic/*.c: Fix [2021443] inconsistant "wrong # args" messages * win/tclWinReg.c * win/tclWinTest.c * tests/*.test 2008-07-21 Alexandre Ferrieux TIP #304 IMPLEMENTATION * generic/tcl.decls: Public API * generic/tclIOCmds.c: Generic part * unix/tclUnixPipe.c: OS part * win/tclWinPipe.c: OS part * tests/chan.test: [chan pipe] tests * tests/ioCmd.test: Modernized checks * tests/ioTrans.test: 2008-07-21 Pat Thoyts * generic/tclFCmd.c: Inodes on windows are unreliable. [Bug 2015723] * tests/winFCmd.test: test rename with inode collision 2008-07-21 Miguel Sofer * generic/tcl.decls: Changed the implementation of * generic/tclBasic.c: [namespace import]; removed * generic/tclDecls.h: Tcl_NRObjProc, replaced with * generic/tclExecute.c: Tcl_NRCmdSwap (proposed public * generic/tclInt.h: NRE API). This should fix * generic/tclNRE.h: [Bug 582506]. * generic/tclNamesp.c: * generic/tclStubInit.c: * generic/tclBasic.c: NRE: enabled calling NR commands * generic/tclExecute.c: from the callbacks. Completely * generic/tclInt.h: redone tailcall implementation * generic/tclNRE.h: using the new feature. [Bug 2021489] * generic/tclProc.c: * tests/NRE.test: 2008-07-20 Kevin B. Kenny * tests/fileName.test: Repaired the failing test fileName-15.7 from dkf's commit earlier today. 2008-07-20 Donal K. Fellows * generic/tclDictObj.c (SetDictFromAny): Make the list->dict transformation a bit more efficient; modern dicts are ordered and so we can round-trip through lists without needing the string rep at all. * generic/tclListObj.c (SetListFromAny): Make the dict->list transformation not lossy of internal representations and hence more efficient. [Bug 2008248] (ajpasadyn) but using a more efficient patch. * tests/fileName.test: Revise to reduce the obscurity of tests. In particular, all tests should now produce informative messages on failure and the quantity of [catch]-based obscurity is now greatly reduced; non-erroring is now checked for directly. 2008-07-19 Donal K. Fellows * tests/env.test: Add LANG to the list of variables that are not touched by the environment variable tests, so that subprocesses can get their system encoding correct. * tests/exec.test, tests/env.test: Rewrite so that non-ASCII characters are not used in the final comparison. Part of fixing [Bug 1513659]. 2008-07-18 Miguel Sofer * generic/tclBasic.c: Optimization: replace calls to * generic/tclDictObj.c: Tcl_NRAddCallback with the macro * generic/tclExecute.c: TclNRAddCallback. * generic/tclInterp.c: * generic/tclNRE.h: * generic/tclNamesp.c: * generic/tclOO.c: * generic/tclOOBasic.c: * generic/tclOOCall.c: * generic/tclOOInt.h: * generic/tclOOMethod.c: * generic/tclProc.c: 2008-07-18 Donal K. Fellows * generic/tclOO.c (TclNRNewObjectInstance, FinalizeAlloc): * generic/tclOOBasic.c (TclOO_Class_Create, TclOO_Class_CreateNs) (TclOO_Class_New, FinalizeConstruction, AddConstructionFinalizer): NRE-enablement of the class construction methods. 2008-07-18 Miguel Sofer * tests/NRE.test: Added basic tests for deep TclOO calls * generic/tcl.decls: Change the public api prefix from * generic/tcl.h: TclNR_foo to Tcl_NRfoo * generic/tclBasic.c: * generic/tclDecls.h: * generic/tclDictObj.c: * generic/tclExecute.c: * generic/tclInterp.c: * generic/tclNRE.h: * generic/tclNamesp.c: * generic/tclOO.c: * generic/tclOOBasic.c: * generic/tclOOCall.c: * generic/tclOOMethod.c: * generic/tclProc.c: * generic/tclStubInit.c: 2008-07-18 Donal K. Fellows * generic/tclOOBasic.c (TclOO_Object_Eval, FinalizeEval): NRE-enable the oo::object.eval method. 2008-07-18 Miguel Sofer * generic/tclDictObj.c (DictWithCmd, DictUpdateCmd): Fix refcounting bugs that caused crashes [Bug 2017857]. * generic/tclBasic.c (TclNREvalObjEx): Streamline the management of the command frame (opt). 2008-07-17 Donal K. Fellows * generic/tclDictObj.c (DictWithCmd, FinalizeDictWith): Split the implementation of [dict with] so that it works with NRE. (DictUpdateCmd, FinalizeDictUpdate): Similarly for the non-compiled version of [dict update]. 2008-07-16 George Peter Staplin * win/tclWinThrd.c: Test for TLS_OUT_OF_INDEXES to make certain that thread key creation is successful. 2008-07-16 Donal K. Fellows * generic/tclOO.c, generic/tclOOInt.h, generic/tclOOBasic.c: * generic/tclOOCall.c, generic/tclOOMethod.c: NRE-enable the TclOO implementation in Tcl. No change to public APIs, except that method implementations can now be NRE-aware if they choose (which normal methods and forwards are). On the other hand, callers of TclOOInvokeObject (which is only in the internal stub table) will need to deal with the fact that it's only safe to call inside an NRE-aware context. ***POTENTIAL INCOMPATIBILITY*** 2008-07-15 Miguel Sofer * tests/NRE.test: Better constraint for testing the existence of * tests/stack.test: teststacklimit, to insure that the test suite runs under tclsh. * generic/tclParse.c: Fixing incomplete reversion of "fix" for [Bug 2017583], missing TclResetCancellation call. 2008-07-15 Donal K. Fellows * generic/tclBasic.c (Tcl_CancelEval): Fix blunder. [Bug 2018603] * doc/DictObj.3: Fix error in example. [Bug 2016740] * generic/tclNamesp.c (EnsembleUnknownCallback): Factor out some of the more complex parts of the ensemble code to make it easier to understand and hence to permit tighter compilation of code on the critical path. 2008-07-14 Miguel Sofer * generic/tclParse.c: Reverting the "fix" for [Bug 2017583], numLevel * tests/parse.test: management and TclInterpReady check seems to be necessary after all. 2008-07-14 Donal K. Fellows * generic/tclProc.c (TclNRApplyObjCmd, TclObjInterpProcCore): * generic/tclBasic.c (TclNR_AddCallback, TclEvalObjv_NR2): * generic/tclNRE.h (TEOV_callback): Change the callback storage type to use an array, so guaranteeing correct inter-member spacing and memory layout. 2008-07-14 Miguel Sofer * generic/tclExecute.c: Remove unneeded TclInterpReady calls * generic/tclParse.c: * generic/tclBasic.c.: Embedded Tcl_Canceled() calls into * generic/tclExecute.c: TclInterpReady(). * generic/tclParse.c: * generic/tclVar.c: Fix error message * generic/tclParse.c: Remove unnecessary numLevel management * tests/parse.test: [Bug 2017583] * generic/tclBasic.c.: NRE left too many calls to * generic/tclExecute.c: TclResetCancellation lying around: it * generic/tclProc.c: only needs to be called prior to any iPtr->numLevels++. Thanks mistachkin. * generic/tclBasic.c: TclResetCancellation() calls were misplaced (merge mishap); stray //. Thanks patthoyts. * generic/tclInt.h: The new macros TclSmallAlloc and TclSmallFree were badly defined under mem debugging [Bug 2017240] (thx das) 2008-07-13 Miguel Sofer NRE implementation [Patch 2017110] * generic/tcl.decls: The NRE infrastructure * generic/tcl.h: * generic/tclBasic.c: * generic/tclCmdAH.c: * generic/tclCompile.h: * generic/tclDecls.h: * generic/tclExecute.c: * generic/tclHistory.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclNRE.h: * generic/tclStubInit.c: * unix/Makefile.in: * generic/tclInterp.c: NRE-enabling: procs, lambdas, uplevel, * generic/tclNamesp.c: same-interp aliases, ensembles, imports * generic/tclProc.c: and namespace_eval. * generic/tclTestProcBodyObj.c: New NRE specific tests (few, but * tests/NRE.test: note that the thing is actually tested by the whole testsuite. * tests/interp.test: Fixed numLevel counting. * tests/parse.test: * tests/stack.test: * unix/configure: Removing support for the hacky nonportable * unix/configure.in: stack check: it is not needed anymore, Tcl * unix/tclConfig.h.in: is very thrifty on the C stack. * unix/tclUnixInit.c: * unix/tclUnixTest.c: * win/tclWin32Dll.c: 2008-07-08 Don Porter * generic/tclGet.c: Corrected out of date comments and removed * generic/tclInt.decls: internal routine TclGetLong() that's no longer used. If an extension is using this from the internal stubs table, it can shift to the public routine Tcl_GetLongFromObj() or can request addition of a public Tcl_GetLong(). ***POTENTIAL INCOMPATIBILITY*** * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: 2008-07-08 Donal K. Fellows * doc/CrtInterp.3: Tighten up the descriptions of behaviour to make this page easier to read for a "Tcl 8.6" audience. 2008-07-07 Andreas Kupries * generic/tclCmdIL.c (InfoFrameCmd): Fixed unsafe idiom of setting the interp result found by Don Porter. 2008-07-07 Donal K. Fellows * doc/regexp.n, doc/regsub.n: Correct examples. [Bug 1982642] 2008-07-06 Donal K. Fellows * doc/lindex.n: Improve examples. 2008-07-03 Andreas Kupries * generic/tclIORChan.c (InvokeTclMethod): Fixed the memory leak reported in [Bug 1987821]. Thanks to Miguel for the report and Don Porter for tracking the cause down. 2008-07-03 Don Porter * library/package.tcl: Removed [file readable] testing from [tclPkgUnknown] and friends. We find out soon enough whether a file is readable when we try to [source] it, and not testing before allows us to workaround the bugs on some common filesystems where [file readable] lies to us. [Patch 1969717] 2008-07-01 Donal K. Fellows * generic/regc_nfa.c (duptraverse): Impose a maximum stack depth on the single most recursive part of the RE engine. The actual maximum may need tuning, but that needs a system with a small stack to carry out. [Bug 1905562] * tests/string.test: Eliminate non-ASCII characters from the actual test script. [Bug 2006884] 2008-06-30 Donal K. Fellows * doc/ObjectType.3: Clean up typedef formatting. 2008-06-30 Don Porter * doc/ObjectType.3: Updated documentation of the Tcl_ObjType struct to match expectations of Tcl 8.5. [Bug 1917650] 2008-06-30 Alexandre Ferrieux * generic/tclCmdIL.c: Lrange cleanup and in-place optimization. [Patch 1890831] * generic/tclExecute.c: Avoid useless String conversion for CONCAT1 of pure byte arrays. [Patch 1953758] 2008-06-29 Donal K. Fellows * doc/*.1, doc/*.3, doc/*.n: Many small updates, purging out of date change bars and cleaning up the formatting of typedefs. Added a few missing bits of documentation in the process. 2008-06-29 Don Porter * generic/tclPathObj.c: Plug memory leak in [Bug 1999176] fix. Thanks to Rolf Ade for detecting. 2008-06-29 Donal K. Fellows * doc/interp.n: Corrected order of subcommands. [Bug 2004256] Removed obsolete (i.e. 8.5) .VS/.VE pairs. * doc/object.n (EXAMPLES): Fix incorrect usage of oo::define to be done with oo::objdefine instead. [Bug 2004480] 2008-06-28 Don Porter * generic/tclPathObj.c: Plug memory leak in [Bug 1972879] fix. Thanks to Rolf Ade for detecting and Dan Steffen for the fix. [Bug 2004654] 2008-06-26 Andreas Kupries * unix/Makefile.in: Followup to my change of 2008-06-25, make code generated by the Makefile and put into the installed tm.tcl conditional on interpreter safeness as well. Thanks to Daniel Steffen for reminding me of that code. 2008-06-25 Don Porter *** 8.6a1 TAGGED FOR RELEASE *** * changes: Updates for 8.6a1 release. * generic/tclOO.h: Bump to TclOO 0.5. 2008-06-25 Andreas Kupries * library/tm.tcl: Modified the handling of Tcl Modules and of the * library/safe.tcl: Safe Base to interact nicely with each other, * library/init.tcl: enabling requiring Tcl Modules in safe * tests/safe.test: interpreters. [Bug 1999119] 2008-06-25 Pat Thoyts * win/rules.vc: Fix versions of dde and registry dlls * win/makefile.vc: Fix problem building with staticpkg option 2008-06-24 Don Porter * generic/tclPathObj.c: Fixed some internals management in the "path" Tcl_ObjType for the empty string value. Problem led to a crash in the command [glob -dir {} a]. [Bug 1999176] 2008-06-24 Pat Thoyts * doc/fileevent.n: Fix examples and comment on eof use. [Bug 1995063] 2008-06-23 Don Porter * generic/tclPathObj.c: Fixed bug in Tcl_GetTranslatedPath() when operating on the "Special path" variant of the "path" Tcl_ObjType intrep. A full normalization was getting done, in particular, coercing relative paths to absolute, contrary to what the function of producing the "translated path" is supposed to do. [Bug 1972879] 2008-06-20 Don Porter * changes: Updates for 8.6a1 release. * generic/tclInterp.c: Fixed completely boneheaded mistake that * tests/interp.test: [interp bgerror $slave] and [$slave bgerror] would always act like [interp bgerror {}]. [Bug 1999035] * tests/chanio.test: Corrected flawed tests revealed by a -debug 1 * tests/cmdAH.test: -singleproc 1 test suite run. * tests/event.test: * tests/interp.test: * tests/io.test: * tests/ioTrans.test: * tests/namespace.test: * tests/encoding.test: Make failing tests pass again. [Bug 1972867] 2008-06-19 Donal K. Fellows * generic/tclOO.c (Tcl_ObjectContextInvokeNext): Corrected 'next' (at * tests/oo.test (oo-7.8): end of a call chain) to make it * doc/next.n: consistent with the TIP. [Bug 1998244] * generic/tclOOCall.c (AddSimpleClassChainToCallContext): Make sure * tests/oo.test (oo-14.8): that class mixins are processed in the documented order. [Bug 1998221] 2008-06-19 Don Porter * changes: Updates for 8.6a1 release. * README: Bump version number to 8.6a1 * generic/tcl.h: * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: 2008-06-17 Andreas Kupries * generic/tclClock.c (ClockConvertlocaltoutcObjCmd): Removed left over debug output. 2008-06-17 Andreas Kupries * doc/tm.n: Followup to changelog entry 2008-03-18 regarding ::tcl::tm::Defaults. Updated the documentation to not only mention the new (underscored) form of environment variable names, but make it the encouraged form as well. [Bug 1914604] 2008-06-17 Kevin Kenny * generic/tclClock.c (ConvertLocalToUTC): * tests/clock.test (clock-63.1): Fixed a bug where the internal ConvertLocalToUTC command segfaulted if passed a dictionary without the 'localSeconds' key. To the best of my knowledge, the bug was not observable in the [clock] command itself. 2008-06-16 Andreas Kupries * generic/tclCmdIL.c (TclInfoFrame): Moved the code looking up the * tests/info.test: information for key 'proc' out of the TCL_LOCATION_BC branch to after the switch, this is common to all frame types. Updated the testsuite to match. This was exposed by the 2008-06-08 commit (Miguel), switching uplevel from direct eval to compilation. [Bug 1987851] 2008-06-16 Andreas Kupries * tests/ioTrans.test (iortrans-11.*): Fixed same issue as for iortrans.tf-11.*, cleanup of temp file, making this a followup to the entry on 2008-06-10 by myself. 2008-06-13 David Gravereaux * win/rules.vc: SYMBOLS macro is now being set to zero when $(OPTS) is not available. * win/makefile.vc: The Stubs source files (tclStubLib.c and tclOOStubLib.c) should not be compiled with the -GL flag. 2008-06-13 Joe Mistachkin TIP #285 IMPLEMENTATION * doc/Eval.3: Added documentation for the Tcl_CancelEval and Tcl_Canceled functions and the TCL_CANCEL_UNWIND flag bit. * doc/after.n: Corrected the spelling of 'canceled' in the documentation. * doc/interp.n: Added documentation for [interp cancel]. * generic/tcl.decls: Added the Tcl_CancelEval and Tcl_Canceled functions to the stubs table. * generic/tcl.h: Added the TCL_CANCEL_UNWIND flag bit. * generic/tclBasic.c: The bulk of the script cancellation functionality is defined here. Added code to initialize and manage the script cancellation hash table in a thread-safe manner. Reset script cancellation flags prior to increasing the nesting level (if the nesting level is currently zero) and always cooperatively check for script cancellation near the start of TclEvalObjvInternal and after invoking async handlers. * generic/tclDecls.h: Regenerated. * generic/tclEvent.c: Call TclFinalizeEvaluation during finalization to cleanup the script cancellation hash table. During [vwait], always cooperatively check for script cancellation. Corrected the spelling of 'canceled' in comments to be consistent with the documentation. * generic/tclExecute.c: Reset script cancellation flags prior to increasing the nesting level (if the nesting level is currently zero) and always cooperatively check for script cancellation after invoking async handlers. Prevent [catch] from catching script cancellation when the TCL_CANCEL_UNWIND flag is set (similar to the manner used by TIP 143 when a limit has been exceeded). * generic/tclInt.decls: Added TclResetCancellation to the internal stubs table. * generic/tclInt.h: Added asyncCancel and asyncCancelMsg fields to the private Interp structure. Added private interp flag value CANCELED to help control script cancellation. * generic/tclIntDecls.h: Regenerated. * generic/tclInterp.c (Tcl_InterpObjCmd): Added [interp cancel] subcommand. * generic/tclNotify.c (Tcl_DeleteEventSource): Corrected the spelling of 'canceled' in comments to be consistent with the documentation. * generic/tclParse.c: Reset script cancellation flags prior to * generic/tclProc.c: increasing the nesting level (if the nesting level is currently zero) and cooperatively check for script cancellation prior to evaluating commands. * generic/tclStubInit.c: Regenerated. * generic/tclThreadTest.c (Tcl_ThreadObjCmd): Added script cancellation support ([testthread cancel]). Modified [testthread id] to allow querying of the 'main' thread ID. Corrected comments to reflect the actual command syntax. Made [testthread wait] cooperatively check for script cancellation. Added [testthread event] to allow for processing one pending event without blocking. * generic/tclTimer.c: Delay for a maximum of 500 milliseconds prior to checking for async handlers and script cancellation. * tests/cmdAH.test: Changed [interp c] to [interp create]. * tests/interp.test: Added and fixed tests for [interp cancel]. * tests/thread.test: Added tests for script cancellation via [testthread cancel]. * tools/man2help2.tcl: Fixed problems with WinHelp target (see * tools/man2tcl.c: [Bug 1934200], [Bug 1934265], and [Bug 1934272]). * win/makefile.vc: Added 'pdbs' option for Windows build rules to * win/rules.vc: allow for non-debug builds with full symbols. * win/tcl.hpj.in: Corrected version for WinHelp target. * win/tclWinNotify.c: Used SleepEx and WaitForSingleObjectEx on * win/tclWinThrd.c: Windows because they are alertable. 2008-06-12 Daniel Steffen * unix/Makefile.in: Add complete deps on tclDTrace.h. * generic/tclOO.c: Use TclOOStubs hooks field to retrieve * generic/tclOODecls.h: TclOOIntStubs pointer. [Bug 1980953] * generic/tclOOIntDecls.h: * generic/tclOOStubInit.c: * generic/tclOOStubLib.c: * generic/tclIORTrans.c: Fix signed <-> unsigned cast warnings. * unix/Makefile.in: Clean generated tclDTrace.h file. * unix/configure.in (SunOS): Fix static DTrace-enabled build. * unix/tcl.m4 (SunOS-5.11): Fix 64bit amd64 support with gcc & Sun cc. * unix/configure: autoconf-2.59 * macosx/Tcl.xcodeproj/project.pbxproj: Add tclIORTrans.c; updates and cleanup for Xcode 3.1/Leopard. * macosx/Tcl.xcode/project.pbxproj: Sync Tcl.xcodeproj changes. * macosx/README: Document new build configs. 2008-06-10 Joe English * generic/tclEncoding.c(UtfToUtfProc): Avoid unwanted sign extension when converting incomplete UTF-8 sequences. See [Bug 1908443] for details. 2008-06-10 Andreas Kupries * tests/ioTrans.test (iortrans.tf-6.1): Fixed the [Bug 1988552], reported by Kevin. Have to close the channel before removal of the file. Fixed same bug in test 'iortrans.tf-11.0', after fixing missing cleanup of the file in 'iortrans.tf-11.*'. Lastly fixed the names of the threaded tests 'iortrans-8.*' to the correct 'iortrans.tf-8.*'. 2008-06-09 Andreas Kupries * generic/tclIORTrans.c (ReflectInput): Fixed a bug triggered by Pat Thoyts . Reset the EOF flag after draining the Tcl level into the result buffer, to make sure that the result buffer will be drained as well by repeated calls to ReflectInput should it contain more than one buffer-full of data. Without that reset the higher I/O system will not call on ReflectInput anymore due to the assumed EOF, thus losing the data which did not fit in the buffer of the call which caused the eof and drain. 2008-06-09 Donal K. Fellows * generic/tclOOCall.c (TclOOGetSortedMethodList): Plug memory leak that occurred when all methods were hidden. [Bug 1987817] 2008-06-08 Miguel Sofer * generic/tclBasic.c: Compilation of uplevel scripts, allow * generic/tclCompCmds.c: non-body compiled scripts to access the * generic/tclCompile.c: LVT (but not to extend it) and enable the * generic/tclCompile.h: canonical list opt to sidestep the * generic/tclExecute.c: compiler. [Patch 1973096] * generic/tclProc.c: * tests/uplevel.test: 2008-06-06 Andreas Kupries TIP #230 IMPLEMENTATION * generic/tclIOCmd.c: Integration of transform commands into 'chan' ensemble. * generic/tclInt.h: Definitions of the transform commands. * generic/tclIORTrans.c: Implementation of the reflection transforms. * tests/chan.test: Tests updated for new sub-commands of 'chan'. * tests/ioCmd.test: Tests updated for new sub-commands of 'chan'. * tests/ioTrans.test: Whole new set of tests for the reflection transform. * unix/Makefile.in: Integration of new files into build rules. * win/Makefile.in: Integration of new files into build rules. * win/makefile.vc: Integration of new files into build rules. NOTE: The file 'tclIORTrans.c' has a lot of code in common with the file 'tclIORChan.c', as that made it much easier to develop the reference implementation as a separate module. Now that the transforms have been committed the one thing left to do is to go over both modules and see which of the common parts we can factor out and share. 2008-06-04 Pat Thoyts * generic/tclBinary.c: TIP #317 implementation * tests/binary.test: 2008-06-02 Kevin B. Kenny * generic/tclOO.c (ReleaseClassContents): Fix the one remaining valgrind complaint about oo.test, caused by failing to protect the Object as well as the Class corresponding to a subclass being deleted and hence getting a freed-memory read when attempting to delete the class command. [Bug 1981001] 2008-06-01 Donal K. Fellows * generic/tclOOMethod.c (Tcl_NewMethod): Complete the fix of [Bug 1981001], previous fix was incomplete though helpful in telling me where to look. 2008-06-01 Joe Mistachkin * win/Makefile.in: Add tclOO genstubs to Windows makefiles and remove * win/makefile.vc: -DBUILD_tcloo because it is no longer required. 2008-06-01 Kevin B. Kenny * generic/tclOODecls.h: Added the swizzling of DLLEXPORT and * generic/tclOOIntDecls.h: DLLIMPORT needed to make EXTERN work. * generic/tclDictObj.c: Added missing initializers to the ensemble map to silence a compiler warning. Thanks to George Peter Staplin for the report. * generic/tclOOMethod.c: Fix a bug where the refcount of a method was reset if the method was redefined while there was an active invocation. [Bug 1981001] 2008-06-01 Donal K. Fellows * generic/tclOO.decls, unix/Makefile.in (genstubs): Make generation of stub tables correct. * generic/tclOO{Decls.h,IntDecls.h,StubInit.c,StubLib.c}: Fixes to make the generation work correctly, removing subtle differences between output of different versions of stub generator. 2008-06-01 Daniel Steffen * generic/tclOOStubLib.c: Ensure use of tcl stubs; include in * unix/Makefile.in: stub lib; disable broken tclOO genstubs * generic/tclOO.c: Make tclOO stubs tables 'static const' * generic/tclOODecls.h: and stub table pointers MODULE_SCOPE * generic/tclOOIntDecls.h: (change generated files manually * generic/tclOOStubInit.c: pending genstubs support for tclOO). * generic/tclOOStubLib.c: * generic/tclOO.c: Fix warnings for 'int<->ptr * generic/tclOOCall.c: conversion' and 'signed vs unsigned * generic/tclOOMethod.c: comparison'. * tests/msgcat.test: Fix for ::tcl::mac::locale with @modifier. * tools/tsdPerf.tcl: Use [info sharedlibextension] * unix/tclConfig.h.in: autoheader-2.59 * macosx/Tcl.xcodeproj/project.pbxproj: Add new tclOO files; add debug * macosx/README: configs with corefoundation disabled and with gcov; update to Xcode 3.1. 2008-05-31 Donal K. Fellows * generic/tclOO.c (InitFoundation): Correct reference counting for strings used when creating the constructor for classes. * generic/tclOOMethod.c (TclOODelMethodRef): Correct fencepost error in reference counting of method implementation structures. * tests/oo.test (oo-0.5): Added a test to detect a memory leak problem relating to disposal of the core object system. TIP#257 IMPLEMENTATION * generic/tclBasic.c, generic/tclOOInt.h: Correct declarations. * win/Makefile.in, win/makefile.bc, win/makefile.vc: Build support for Win32, from Joe Mistachkin. [Patch 1980861] * generic/tclOO*, doc/*, tests/oo.test: Port of implementation of TclOO to sit directly inside Tcl. Note that this is incomplete (e.g. no build support yet for Windows). 2008-05-26 Jeff Hobbs * tests/io.test (io-53.9): Need to close chan before removing file. 2008-05-26 Donal K. Fellows * win/makefile.bc: Remove deprecated winhelp target. * win/Makefile.in, win/makefile.vc: It didn't work correctly anyway. 2008-05-23 Andreas Kupries * win/tclWinChan.c (FileWideSeekProc): Accepted a patch by Alexandre Ferrieux to fix the [Bug 1965787]. 'tell' now works for locations > 2 GB as well instead of going negative. * generic/tclIO.c (Tcl_SetChannelBufferSize): Accepted a patch by * tests/io.test: Alexandre Ferrieux * tests/chanio.test: to fix the [Bug 1969953]. Buffersize outside of the supported range are now clipped to nearest boundary instead of ignored. 2008-05-22 Don Porter * generic/tclNamesp.c (Tcl_LogCommandInfo): Restored ability to handle the argument value length = -1. Thanks to Chris Darroch for discovering the bug and providing the fix. [Bug 1968245] 2008-05-21 Don Porter * generic/tclParse.c (ParseComment): The new TclParseAllWhiteSpace * tests/parse.test (parse-15.60): routine has no mechanism to return the "incomplete" status of "\\\n" so calling this routine anywhere that can be reached within a Tcl_ParseCommand() call is a mistake. In particular, ParseComment() must not use it. [Bug 1968882] 2008-05-20 Donal K. Fellows * generic/tclNamesp.c (Tcl_SetNamespaceUnknownHandler): Corrected odd logic for handling installation of namespace unknown handlers which could lead too very strange things happening in the error case. 2008-05-16 Miguel Sofer * generic/tclCompile.c: Fix crash with tcl_traceExec. Found and fixed by Alexander Pasadyn. [Bug 1964803] 2008-05-15 Pat Thoyts * win/makefile.vc: We should use the thread allocator for threaded * win/rules.vc: builds. Added 'tclalloc' option to disable. 2008-05-09 George Peter Staplin * tools/tsdPerf.c: A loadable Tcl extension for testing TSD performance. * tools/tsdPerf.tcl: A simplistic tool that uses the thread extension and tsdPerf.so to get some performance metrics by, simulating, simple TSD contention. 2008-05-09 George Peter Staplin * generic/tcl.h: Make Tcl_ThreadDataKey a void *. * generic/tclInt.h: Change around some function names and add some new per-platform declarations for thread-specific data functions. * generic/tclThread.c: Make use of of the new function names that no longer have a Tclp prefix. * generic/tclThreadStorage.c: Replace the core thread-specific data (TSD) mechanism with an array offset solution that eliminates the hash tables, and only uses one slot of native TSD. Many thanks to Kevin B. Kenny for his help with this. * unix/tclUnixThrd.c: Add platform-specific TSD functions for use by * win/tclWinThrd.c: tclThreadStorage.c. 2008-05-09 Kevin B. Kenny * tests/dict.test (dict-19.2): Corrected a bug where the test was changed to use [apply] instead of a temporary proc, but the cleanup script still attempted to delete the temporary proc. 2008-05-07 Donal K. Fellows * generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix silly off-by one error that caused a crash every time a compiled 'dict append' with more than one argument was used. Found by Colin McCormack. 2008-05-02 Pat Thoyts * generic/tclBasic.c: Converted the [binary] command into an * generic/tclBinary.c: ensemble. * generic/tclInt.h: * test/binary.test: Updated the error tests for ensemble errors. * generic/tclFileName.c: Reverted accidental commit of TIP 316 APIs. 2008-04-27 Donal K. Fellows * */*.c: A large tranche of getting rid of pre-C89-isms; if your compiler doesn't support things like proper function declarations, 'void' and 'const', borrow a proper one when building Tcl. (The header files allow building things that link against Tcl with really ancient compilers still; the requirement is just when building Tcl itself.) 2008-04-26 Zoran Vasiljevic * generic/tclAsync.c: Tcl_AsyncDelete(): panic if attempt to locate handler token fails. Happens when some other thread attempts to delete somebody else's token. Also, panic early if we find out the wrong thread attempting to delete the async handler (common trap). As, only the one that created the handler is allowed to delete it. 2008-04-24 Andreas Kupries * tests/ioCmd.test: Extended testsuite for reflected channel implementation. Added test cases about how it handles if the rug is pulled out from under a channel (= killing threads, interpreters containing the tcl command for a channel, and channel sitting in a different interpreter/thread.) * generic/tclIORChan.c: Fixed the bugs exposed by the new testcases, redone most of the cleanup and exit handling. 2008-04-21 Don Porter * generic/tclIOUtil.c: Removed all code delimited by * generic/tclTest.c: USE_OBSOLETE_FS_HOOKS, completing * tests/ioCmd.test: the deprecation path for these * tests/ioUtil.test (removed): obsolete interfaces. (Code was active in Tcl 8.4, present but enabled only by customized compile switch in Tcl 8.5, and now completely gone for Tcl 8.6). Also removed all tests relevant only to the removed interfaces. 2008-04-19 George Peter Staplin * doc/Ensemble.3: Fix a typo: s/defiend/defined/ Thanks to hat0 for spotting this. 2008-04-16 Daniel Steffen * generic/tclInt.h: Make stubs tables 'static const' and * generic/tclStubInit.c: export only module-scope pointers to * generic/tclStubLib.c: the main stubs tables (for package * tools/genStubs.tcl: initialization). [Patch 1938497] * generic/tclBasic.c (Tcl_CreateInterp): * generic/tclTomMathInterface.c (TclTommath_Init): * generic/tclInt.h: Revise Tcl_SetNotifier() to use a * generic/tclNotify.c: module-scope hooks table instead of * generic/tclStubInit.c: runtime stubs-table modification; * macosx/tclMacOSXNotify.c: ensure all hookable notifier functions * win/tclWinNotify.c: check for hooks; remove hook checks in * unix/tclUnixNotfy.c: notifier API callers. [Patch 1938497] 2008-04-15 Andreas Kupries * generic/tclIO.c (CopyData): Applied another patch by Alexandre * io.test (io-53.8a): Ferrieux , * chanio.test (chan-io-53.8a): to shift EOF handling to the async part of the command if a callback is specified, should the channel be at EOF already when fcopy is called. Testcase by myself. 2008-04-15 Daniel Steffen * unix/Makefile.in: Adjust tclDTrace.h dependencies for removal of tclStubLib.o from TCL_OBJS. [Bug 1942795] 2008-04-14 Kevin B. Kenny * unix/tclUnixTime.c (NativeGetTime): Removed obsolete use of 'struct timezone' in the call to 'gettimeofday'. [Bug 1942197] * tests/clock.test (clock-33.5, clock-33.5a, clock-33.8, clock-33.8a): Added comments to the test that it can fail on a heavily loaded system. 2008-04-10 Andreas Kupries * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Keeping check for negative values, changed to not be an error, but behave like the special value -1 (copy all, default). * tests/iocmd.test (iocmd-15.{12,13}): Removed. * tests/io.test (io-52.5{,a,b}): Reverted last change, added * tests/chanio.test (chan-io-52.5{,a,b}): comment regarding the meaning of -1, added two more testcases for other negative values, and input wrapped to negative. 2008-04-09 Donal K. Fellows * tests/{fCmd,unixFCmd,winFCmd,winFile}.test: Tidying up of the test suite to make better use of tcltest2 and be clearer about what is being tested. * win/Makefile.in (html): Added target for doing convenient documentation builds, mirroring the one from unix/Makefile. 2008-04-09 Andreas Kupries * tests/chanio.test (chan-io-52.5): Removed '-size -1' from test, * tests/io.test (io-52.5): does not seem to have any bearing, and was an illegal value. Test case is not affected by the value of -size, test flag restoration and that evrything was properly copied. * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Added checking of -size value * tests/ioCmd.test (iocmd-15.{13,14}): to reject negative values, and values overflowing 32-bit signed. Basic patch by Alexandre Ferrieux , with modifications from me to separate overflow from true negative value. Extended testsuite. [Bug 1557855] 2008-04-09 Daniel Steffen * tests/chanio.test (chan-io-53.8,53.9,53.10): Fix typo & quoting for * tests/io.test (io-53.8,53.9,53.10): spaces in builddir path 2008-04-08 Miguel Sofer * generic/tclExecute.c: Added comments to the alignment macros used in GrowEvaluationStack() and friends. 2008-04-08 Daniel Steffen * tools/genStubs.tcl: Revert erroneous 2008-04-02 change marking *StubsPtr as EXTERN instead of extern. * generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclPlatDecls.h: * generic/tclTomMathDecls.h: 2008-04-07 Andreas Kupries * tests/io.test (io-53.10): Testcase for bi-directional fcopy. * tests/chanio.test: * generic/tclIO.c: Additional changes to data structures for fcopy and * generic/tclIO.h: channels to perform proper cleanup in case of a channel having two background copy operations running as is now possible. * generic/tclIO.c (BUSY_STATE, CheckChannelErrors, TclCopyChannel): New macro, and the places using it. This change allows for bi-directional fcopy on channels. Thanks to Alexandre Ferrieux for the patch. [Bug 1350564] 2008-04-07 Reinhard Max * generic/tclStringObj.c (Tcl_AppendFormatToObj): Fix [format {% d}] so that it behaves the same way as in 8.4 and as C's printf(). * tests/format.test: Add a test for '% d' and '%+d'. 2008-04-05 Kevin B. Kenny * win/tclWinFile.c: (WinSymLinkDirectory): Fixed a problem that Tcl was creating an NTFS junction point (IO_REPARSE_TAG_MOUNT_POINT) but filling in the union member for a Vista symbolic link. We had gotten away with this error because the union member (SymbolicLinkReparseBuffer) was misdefined in this file and in the 'winnt.h' in early versions of MinGW. MinGW 3.4.2 has the correct definition of SymbolicLinkReparseBuffer, exposing the mismatch, and making tests cmdAH-19.4.1, fCmd-28.*, and filename-11.* fail. * tests/chanio.test (chan-io-53.9): * tests/io.test (io-53.9): Made test cleanup robust against the possibility of slow process shutdown on Windows. * win/tcl.m4: Added -D_CRT_SECURE_NO_DEPRECATE and -DCRT_NONSTDC_NO_DEPRECATE to the MSVC compilation flags so that the compilation doesn't barf on perfectly reasonable Posix system calls. * win/configure: Manually patched (don't have the right autoconf to hand). 2008-04-04 Andreas Kupries * tests/io.test (io-53.9): Added testcase for [Bug 780533], based * tests/chanio.test: on Alexandre's test script. Also fixed problem with timer in preceding test, was not canceled properly in the ok case 2008-04-04 Andreas Kupries * generic/tclIORChan.c (ReflectOutput): Allow zero return from write when input was zero-length anyway. Otherwise keept it an error, and separate the message from 'written too much'. * tests/ioCmd.test (iocmd-24.6): Testcase updated for changed message. * generic/tclIORChan.c (ReflectClose): Added missing removal of the now closed channel from the reflection map. Before we could crash the system by invoking 'chan postevent' on a closed reflected channel, dereferencing the dangling pointer in the map. * tests/ioCmd.test (iocmd-31.8): Testcase for the above. 2008-04-03 Andreas Kupries * generic/tclIO.c (CopyData): Applied patch [Bug 1932639] to * tests/io.test: prevent fcopy from calling -command synchronously * tests/chanio.test: the first time. Thanks to Alexandre Ferrieux for report and patch. 2008-04-02 Daniel Steffen * generic/tcl.decls: Remove 'export' declarations of symbols now only in libtclstub and no longer in libtcl. * generic/tclStubLib.c: Make symbols in libtclstub.a MODULE_SCOPE to * tools/genStubs.tcl: avoid exporting them from libraries that link with -ltclstub; constify tcl*StubsPtr and stub table hook pointers. [Bug 1819422] * generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclPlatDecls.h: * generic/tclStubInit.c: * generic/tclTomMathDecls.h: 2008-04-02 Andreas Kupries * generic/tclIO.c (CopyData): Applied patch for fcopy problem [Bug 780533], with many thanks to Alexandre Ferrieux for tracking it down and providing a solution. Still have to convert his test script into a proper test case. 2008-04-01 Andreas Kupries * generic/tclStrToD.c: Applied patch for [Bug 1839067] (fp rounding * unix/tcl.m4: setup on solaris x86, native cc), provided by Michael Schlenker. 2008-04-01 Don Porter * generic/tclStubLib.c: Removed needless #ifdef complexity. * generic/tclStubLib.c (Tcl_InitStubs): Added missing error message. * generic/tclPkg.c (Tcl_PkgInitStubsCheck): * README: Bump version number to 8.6a0 * generic/tcl.h: * library/init.tcl: * macosx/Tcl-Common.xcconfig: * macosx/Tcl.pbproj/default.pbxuser: * macosx/Tcl.pbproj/project.pbxproj: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README: * win/configure.in: * win/makefile.bc: * win/tcl.m4: * unix/configure: autoconf-2.59 * win/configure: * generic/tclBasic.c: Revised stubs-generation tool and interp * tools/genStubs.tcl: creation so that "tclStubsPtr" is not present * unix/Makefile.in: in libtcl.so, but is present only in * win/Makefile.in: libtclstub.a. This tightens up the rules for * win/makefile.bc: users of the stubs interfaces. [Bug 1819422] * win/makefile.vc: * generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: * generic/tclPlatDecls.h: * generic/tclTomMathDecls.h: 2008-03-30 Kevin Kenny * generic/tclInt.h (TclIsNaN): * unix/configure.in: Added code to the configurator to check for a standard isnan() macro and use it if one is found. This change avoids bugs where the test of ((d) != (d)) is optimized away by an overaggressive compiler. [Bug 1783544] * generic/tclObj.c: Added missing #include needed to locate isnan() after the above change. * unix/configure: autoconf-2.61 * tests/mathop.test (mathop-25.9, mathop-25.14): Modified tests to deal with (slightly buggy) math libraries in which pow() returns an incorrectly rounded result. [Bug 1808174] 2008-03-26 Don Porter *** 8.5.2 TAGGED FOR RELEASE *** * generic/tcl.h: Bump to 8.5.2 for release. * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: * changes: Updated for 8.5.2 release. 2008-03-28 Donal K. Fellows * tests/fCmd.test: Substantial rewrite to use many more tcltest features. Great reduction in quantity of [catch] gymnastics. Several buggy tests fixed, including one where the result of the previous test was being checked! 2008-03-27 Kevin B. Kenny * library/tzdata/America/Marigot: * library/tztata/America/St_Barthelemy: * library/tzdata/America/Argentina/San_Luis: * library/tzdata/Asia/Ho_Chi_Minh: * library/tzdata/Asia/Kolkata: (new files) * library/tzdata/America/Caracas: * library/tzdata/America/Havana: * library/tzdata/America/Santiago: * library/tzdata/America/Argentina/Buenos_Aires: * library/tzdata/America/Argentina/Catamarca: * library/tzdata/America/Argentina/Cordoba: * library/tzdata/America/Argentina/Jujuy: * library/tzdata/America/Argentina/La_Rioja: * library/tzdata/America/Argentina/Mendoza: * library/tzdata/America/Argentina/Rio_Gallegos: * library/tzdata/America/Argentina/San_Juan: * library/tzdata/America/Argentina/Tucuman: * library/tzdata/America/Argentina/Ushuaia: * library/tzdata/Asia/Baghdad: * library/tzdata/Asia/Calcutta: * library/tzdata/Asia/Damascus: * library/tzdata/Asia/Saigon: * library/tzdata/Pacific/Easter: Changes up to and including Olson's tzdata2008b. 2008-03-27 Daniel Steffen * unix/tcl.m4 (SunOS-5.1x): Fix 64bit support for Sun cc. [Bug 1921166] * unix/configure: autoconf-2.59 2008-03-26 Don Porter * changes: Updated for 8.5.2 release. 2008-03-24 Pat Thoyts * generic/tclBinary.c: [Bug 1923966] - crash in binary format * tests/binary.test: Added tests for the above crash condition. 2008-03-21 Donal K. Fellows * doc/switch.n: Clarified documentation in respect of two-argument invocation. [Bug 1899962] * tests/switch.test: Added more tests of regexp-mode compilation of the [switch] command. [Bug 1854435] 2008-03-20 Donal K. Fellows * generic/tcl.h, generic/tclThreadAlloc.c: Tidied up the declarations of Tcl_GetMemoryInfo so that it is always defined. Will panic when called against a Tcl that was previously built without it at all, which is OK because that also indicates a serious mismatch between memory configuration options. 2008-03-19 Donal K. Fellows * generic/tcl.h, generic/tclThreadAlloc.c (Tcl_GetMemoryInfo): Make sure this function is available when direct linking. [Bug 1868171] * tests/reg.test (reg-33.14): Marked nonPortable because some environments have small default stack sizes. [Bug 1905562] 2008-03-18 Andreas Kupries * library/tm.tcl (::tcl::tm::UnknownHandler): Changed 'source' to 'source -encoding utf-8'. This fixes a portability problem of Tcl Modules pointed out by Don Porter. By using plain 'source' we were at the mercy of 'encoding system', making modules less portable than they could be. The exact scenario: A writes a TM in some weird encoding which is A's system encoding, distributes it, and somewhere else it cannot be read/used because the system encoding is different. Forcing the use of utf-8 makes the module portable. ***INCOMPATIBILITY*** for all Tcl Modules already written in non-utf-8 compatible encodings. 2008-03-18 Don Porter * generic/tclExecute.c: Patch from Miguel Sofer to correct the alignment of memory allocated by GrowEvaluationStack(). [Bug 1914503] 2008-03-18 Andreas Kupries * library/tm.tcl (::tcl::tm::Defaults): Modified handling of environment variables. Solution slightly different than proposed in the report. Using the underscored form TCLX_y_TM_PATH even if TCLX.y_TM_PATH exists. Also using a loop to cut prevent code replication. [Bug 1914604] 2008-03-16 Donal K. Fellows * generic/tclCompCmds.c (TclCompileDictForCmd): Correct the handling of stack space calculation (the jump pattern used was confusing the simple-minded code doing the calculations). [Bug 1903325] * doc/lreplace.n: Clarified documentation of what happens with negative indices. [Bug 1905809] Added example, tidied up formatting. 2008-03-14 Don Porter * generic/tclBasic.c (OldMathFuncProc): Same workaround protection from bad TclStackAlloc() alignment. Thanks George Peter Staplin. * generic/tclCmdIL.c (Tcl_LsortObjCmd): Use ckalloc() to allocate SortElement arrays instead of TclStackAlloc() which isn't getting alignment right. Workaround for [Bug 1914503]. 2008-03-14 Reinhard Max * generic/tclTest.c: Ignore the return value of write() when we are * unix/tclUnixPipe.c: about to exit anyways. 2008-03-13 Daniel Steffen * unix/configure.in: Use backslash-quoting instead of double-quoting * unix/tcl.m4: for lib paths in tclConfig.sh. [Bug 1913622] * unix/configure: autoconf-2.59 2008-03-13 Don Porter * changes: Updated for 8.5.2 release. * generic/tclStrToD.c: Resolve identifier conflict over "pow10" with libm in Cygwin and DJGPP. Thanks to Gordon Schumacher and Philip Moore. [Patch 1800636] 2008-03-12 Daniel Steffen * macosx/Tcl.xcodeproj/project.pbxproj: Add support for Xcode 3.1 * macosx/Tcl.xcodeproj/default.pbxuser: CODE_SIGN_IDENTITY and * macosx/Tcl-Common.xcconfig: 'xcodebuild install'. 2008-03-12 Andreas Kupries * doc/info.n: Replaced {expand} with {*}. 2008-03-12 Jeff Hobbs * unix/Makefile.in (install-libraries): Bump http to 2.7 * win/Makefile.in (install-libraries): Added -myaddr option to allow * library/http/http.tcl (http::geturl): control of selected socket * library/http/pkgIndex.tcl: interface. [Bug 559898] * doc/http.n, tests/http.test: Added -keepalive and -protocol 1.1 with chunked transfer encoding support. [Bug 1063703, 1470377, 219225] (default keepalive is 0) Added ability to override Host in -headers. [Bug 928154] Added -strict option to control URL validation on per-call basis. [Bug 1560506] 2008-03-11 Jeff Hobbs * library/http/http.tcl (http::geturl): Add -method option to support * tests/http.test (http-3.1): http PUT and DELETE requests. * doc/http.n: [Bug 1599901, 862554] * library/http/http.tcl: Whitespace changes, code cleanup. Allow http to be re-sourced without overwriting http state. 2008-03-11 Daniel Steffen * generic/tclEncoding.c (LoadEscapeEncoding): Avoid leaking escape sub-encodings, fixes encoding-11.1 failing after iso2022-jp loaded. [Bug 1893053] * macosx/tclMacOSXNotify.c: Avoid using CoreFoundation after fork() on Darwin 9 even when TclpCreateProcess() uses vfork(). * macosx/Tcl.xcodeproj/project.pbxproj: Add support for Xcode 3.1 and * macosx/Tcl.xcodeproj/default.pbxuser: configs for building with * macosx/Tcl-Common.xcconfig: gcc-4.2 and llvm-gcc-4.2. * unix/tclUnixPort.h: Workaround vfork() problems in llvm-gcc-4.2.1 -O4 build. * unix/tclUnixPort.h: Move MODULE_SCOPE compat define to top. [Bug 1911102] * macosx/GNUmakefile: Fix quoting to allow paths * macosx/Tcl-Common.xcconfig: to ${builddir} and * unix/Makefile.in: ${INSTALL_ROOT} to contain * unix/configure.in: spaces. * unix/install-sh: * unix/tcl.m4: * tests/ioCmd.test: * unix/configure: autoconf-2.59 * unix/Makefile.in (install-strip): Strip non-global symbols from dynamic library. * unix/tclUnixNotfy.c: Fix warning. * tests/exec.test (exec-9.7): Reduce timing sensitivity * tests/socket.test (socket-2.11): (esp. on multi-proc machines). * tests/fCmd.test (fCmd-9.4): Skip on Darwin 9 (xfail). 2008-03-11 Miguel Sofer * generic/tclVar.c (TclDeleteNamespaceVars): * tests/var.test (var-8.2): Unset traces on vars should be called with a FQ named during namespace deletion. This was causing infinite loops when unset traces recreated the var, as reported by Julian Noble. [Bug 1911919] 2008-03-10 Don Porter * changes: Updated for 8.5.2 release. * doc/http.n: Revised to indicate that [package require http 2.5.5] is needed to get all the documented commands ([http::meta]). * generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd): Added error * tests/event.test (event-5.*): checking to protect against callers passing invalid return options dictionaries. [Bug 1901113] * generic/tclBasic.c (ExprAbsFunc): Revised so that the abs() * tests/expr.test: function and the [::tcl::mathfunc::abs] command do not return the value of -0, or equivalent values with more alarming string reps like -1e-350. [Bug 1893815] 2008-03-07 Andreas Kupries * generic/tclResult.c (ReleaseKeys): Workaround for [Bug 1904907]. Reset the return option keys to NULL to allow full re-initialization by GetKeys(). This introduces a memory leak for the key objects, but gets us around a crash in the finalization of reflected channels when handling returns, either at compile- or runtime. In both cases we access the keys after they have been released by their thread exit handler. A proper fix is entangled with the untangling of the finalization ordering and attendant issues. For now we choose the lesser evil. 2008-03-07 Don Porter * generic/tclExecute.c (Tcl_ExprObj): Revised expression bytecode compiling so that bytecodes invalid due to changing context or due to the difference between expressions and scripts are not reused. [Bug 1899164] * generic/tclCmdAH.c: Revised direct evaluation implementation of [expr] so that [expr $e] caches compiled bytecodes for the expression as the intrep of $e. * tests/execute.test (execute-6.*): More tests checking that script bytecode is invalidated in the right situations. 2008-03-07 Donal K. Fellows * win/configure.in: Add AC_HEADER_STDC to support msys/win64. 2008-03-06 Donal K. Fellows * doc/namespace.n: Minor tidying up. [Bug 1909019] 2008-03-04 Don Porter * tests/execute.test (6.3,4): Added tests for [Bug 1899164]. 2008-03-03 Reinhard Max * unix/tclUnixChan.c: Fix mark and space parity on Linux, which uses CMSPAR instead of PAREXT. 2008-03-02 Miguel Sofer * generic/tclNamesp.c (GetNamespaceFromObj): * tests/interp.test (interp-28.2): Spoil the intrep of an nsNameType obj when the reference crosses interpreter boundaries. 2008-02-29 Don Porter * generic/tclResult.c (Tcl_SetReturnOptions): Revised the refcount management of Tcl_SetReturnOptions to become that of a conventional Consumer routine. Thanks to Peter Spjuth for pointing out the difficulties calling Tcl_SetReturnOptions with non-0-count value for options. * generic/tclExecute.c (INST_RETURN_STK): Revised the one caller within Tcl itself which passes a non-0-count value to Tcl_SetReturnOptions(). * generic/tclBasic.c (Tcl_AppendObjToErrorInfo): Revised the refcount management of Tcl_AppendObjToErrorInfo to become that of a conventional Consumer routine. This preserves the ease of use for the overwhelming common callers who pass in a 0-count value, but makes the proper call with a non-0-count value less surprising. * generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd): Revised the one caller within Tcl itself which passes a non-0-count value to Tcl_AppendObjToErrorInfo(). 2008-02-28 Joe English * unix/tclPort.h, unix/tclCompat.h, unix/tclUnixChan.h: Reduce scope of and #includes. [Patch 1903339] 2008-02-28 Joe English * unix/tclUnixChan.c, unix/tclUnixNotfy.c, unix/tclUnixPipe.c: Consolidate all code conditionalized on -DUSE_FIONBIO into one place. * unix/tclUnixPort.h, unix/tclUnixCompat.c: New routine TclUnixSetBlockingMode(). [Patch 1903339] 2008-02-28 Don Porter * generic/tclBasic.c (TclEvalObjvInternal): Plug memory leak when an enter trace deletes or changes the command, prompting a reparsing. Don't let the second pass lose commandPtr value allocated during the first pass. * generic/tclCompExpr.c (ParseExpr): Plug memory leak in error message generation. * generic/tclStringObj.c (Tcl_AppendFormatToObj): [format %llx $big] leaked an mp_int. * generic/tclCompCmds.c (TclCompileReturnCmd): The 2007-10-18 commit to optimize compiled [return -level 0 $x] [RFE 1794073] introduced a memory leak of the return options dictionary. Fixing that. 2008-02-27 Pat Thoyts * library/http/http.tcl: [Bug 705956] - fix inverted logic when cleaning up socket error in geturl. 2008-02-27 Kevin B. Kenny * doc/clock.n: Corrected minor indentation gaffe in the penultimate paragraph. [Bug 1898025] * generic/tclClock.c (ParseClockFormatArgs): Changed to check that the clock value is in the range of a 64-bit integer. [Bug 1862555] * library/clock.tcl (::tcl::clock::format, ::tcl::clock::scan, (::tcl::clock::add, ::tcl::clock::LocalizeFormat): Fixed bugs in caching of localized strings that caused weird results when localized date/time formats were used. [Bug 1902423] * tests/clock.test (clock-61.*, clock-62.1): Regression tests for [Bug 1862555] and [Bug 1902423]. 2008-02-26 Joe English * generic/tclIOUtil.c, unix/tclUnixPort.h, unix/tclUnixChan.c: Remove dead/unused portability-related #defines and unused conditional code. See [Patch 1901828] for discussion. 2008-02-26 Joe English * generic/tclIORChan.c (enum MethodName), * generic/tclCompExpr.c (enum Marks): More stray trailing ","s 2008-02-26 Joe English * unix/configure.in(socklen_t test): Define socklen_t as "int" if missing, not "unsigned". Use AC_TRY_COMPILE instead of AC_EGREP_HEADER. * unix/configure: regenerated. 2008-02-26 Joe English * generic/tclCompile.h: Remove stray trailing "," from enum InstOperandType definition (C99ism). 2008-02-26 Jeff Hobbs * generic/tclUtil.c (TclReToGlob): Fix the handling of the last star * tests/regexpComp.test: possibly being escaped in determining right anchor. [Bug 1902436] 2008-02-26 Pat Thoyts * library/http/pkgIndex.tcl: Set version 2.5.5 * library/http/http.tcl: It is better to do the [eof] check after trying to read from the socket. No clashes found in testing. Added http::meta command to access the http headers. [Bug 1868845] 2008-02-22 Pat Thoyts * library/http/pkgIndex.tcl: Set version 2.5.4 * library/http/http.tcl: Always check that the state array exists in the http::status command. [Bug 1818565] 2008-02-13 Don Porter * generic/tcl.h: Bump version number to 8.5.2b1 to distinguish * library/init.tcl: CVS development snapshots from the 8.5.1 and * unix/configure.in: 8.5.2 releases. * unix/tcl.spec: * win/configure.in: * README * unix/configure: autoconf (2.59) * win/configure: 2008-02-12 Donal K. Fellows * generic/tclCompCmds.c (TclCompileSwitchCmd): Corrected logic for * tests/switch.test (switch-10.15): handling -nocase compilation; the -exact -nocase option cannot be compiled currently. [Bug 1891827] * unix/README: Documented missing configure flags. [Bug 1799011] 2008-02-06 Kevin B. Kenny * doc/clock.n (%N): Corrected an error in the explanation of the %N format group. * generic/tclClock.c (ClockParseformatargsObjCmd): * library/clock.tcl (::tcl::clock::format): * tests/clock.test (clock-1.0, clock-1.4): Performance enhancements in [clock format] (moving the analysis of $args into C code, holding on to Tcl_Objs with resolved command names, [lassign] in place of [foreach], avoiding [namespace which] for command resolution). 2008-02-04 Don Porter *** 8.5.1 TAGGED FOR RELEASE *** * changes: Updated for 8.5.1 release. * generic/tcl.h: Bump to 8.5.1 for release. * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf-2.59 * win/configure: 2008-02-04 Miguel Sofer * generic/tclExecute.c (INST_CONCAT1): Fix optimisation for in-place concatenation (was going over String type) 2008-02-02 Daniel Steffen * unix/configure.in (Darwin): Correct Info.plist year substitution in non-framework builds. * unix/configure: autoconf-2.59 2008-01-30 Miguel Sofer * generic/tclInterp.c (Tcl_GetAlias): Fix for [Bug 1882373], thanks go to an00na. 2008-01-30 Donal K. Fellows * tools/tcltk-man2html.tcl: Reworked manual page scraper to do a proper job of handling references to Ttk options. [Tk Bug 1876493] 2008-01-29 Donal K. Fellows * doc/man.macros (SO, SE): Adjusted macros so that it is possible for Ttk to have its "standard options" on a manual page that is not called "options". [Tk Bug 1876493] 2008-01-25 Don Porter * changes: Updated for 8.5.1 release. 2008-01-23 Don Porter * generic/tclInt.h: New macro TclGrowParseTokenArray() to * generic/tclCompCmds.c: simplify code that might need to grow * generic/tclCompExpr.c: an array of Tcl_Tokens in the parsePtr * generic/tclParse.c: field of a Tcl_Parse. Replaces the TclExpandTokenArray() routine via replacing: int needed = parsePtr->numTokens + growth; while (needed > parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } with: TclGrowParseTokenArray(parsePtr, growth); This revision merged over from dgp-refactor branch. * generic/tclCompile.h: Demote TclCompEvalObj() from internal stubs to * generic/tclInt.decls: a MODULE_SCOPE routine declared in tclCompile.h. * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: 2008-01-22 Don Porter * generic/tclTimer.c (AfterProc): Replace Tcl_EvalEx() with Tcl_EvalObjEx() to evaluate [after] callbacks. Part of trend to favor compiled execution over direct evaluation. 2008-01-22 Miguel Sofer * generic/tclCmdIl.c (Tcl_LreverseObjCmd): * tests/cmdIL.test (cmdIL-7.7): Fix crash on reversing an empty list. [Bug 1876793] 2008-01-20 Jeff Hobbs * unix/README: Minor typo fixes [Bug 1853072] * generic/tclIO.c (TclGetsObjBinary): Operate on topmost channel. [Bug 1869405] (Ficicchia) 2008-01-17 Don Porter * generic/tclCompExpr.c: Revision to preserve parsed intreps of numeric and boolean literals when compiling expressions with (optimize == 1). 2008-01-15 Miguel Sofer * generic/tclCompExpr.c: Add an 'optimize' argument to * generic/tclCompile.c: TclCompileExpr() to profit from better * generic/tclCompile.h: literal management according to usage. * generic/tclExecute.c: * generic/tclCompExpr.c: Fix literal leak in exprs [Bug 1869989] (dgp) * generic/tclExecute.c: * tests/compExpr.test: * doc/proc.n: Changed wording for access to non-local variables; added mention to [namespace upvar]. Lame attempt at dealing with documentation. [Bug 1872708] 2008-01-15 Miguel Sofer * generic/tclBasic.c: Replacing 'operator' by 'op' in the def of * generic/tclCompExpr.c: struct TclOpCmdClientData to accommodate C++ * generic/tclCompile.h: compilers. [Bug 1855644] 2008-01-13 Jeff Hobbs * win/tclWinSerial.c (SerialCloseProc, TclWinOpenSerialChannel): Use critical section for read & write side. [Bug 1353846] (newman) 2008-01-11 Miguel Sofer * unix/tclUnixThrd.c (TclpThreadGetStackSize): Restore stack checking functionality in freebsd. [Bug 1850424] * unix/tclUnixThrd.c (TclpThreadGetStackSize): Fix for crash in freebsd. [Bug 1860425] 2008-01-10 Don Porter * generic/tclStringObj.c (Tcl_AppendFormatToObj): Correct failure to * tests/format.test: account for big.used == 0 corner case in the %ll(idox) format directives. [Bug 1867855] 2008-01-09 George Peter Staplin * doc/vwait.n: Add a missing be to fix a typo. 2008-01-04 Jeff Hobbs * tools/tcltk-man2html.tcl (make-man-pages): Make man page title use more specific info on lhs to improve tabbed browser view titles. 2008-01-02 Donal K. Fellows * doc/binary.n: Fixed documentation bug reported on tcl-core, and reordered documentation to discourage people from using the hex formatter that is hardly ever useful. 2008-01-02 Don Porter * generic/tcl.h: Bump version number to 8.5.1b1 to distinguish * library/init.tcl: CVS development snapshots from the 8.5.0 and * unix/configure.in: 8.5.1 releases. * unix/tcl.spec: * win/configure.in: * README * unix/configure: autoconf (2.59) * win/configure: ****************************************************************** *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" *** *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" *** *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" *** *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ****************************************************************** tcl8.6.14/license.terms0000644000175000017500000000431714554262142014345 0ustar sergeisergeiThis software is copyrighted by the Regents of the University of California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState Corporation and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7014 (b) (3) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license. tcl8.6.14/library/0000755000175000017500000000000014566153412013310 5ustar sergeisergeitcl8.6.14/library/license.terms0000644000175000017500000000431714554262142016011 0ustar sergeisergeiThis software is copyrighted by the Regents of the University of California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState Corporation and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7014 (b) (3) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license. tcl8.6.14/library/auto.tcl0000644000175000017500000005055514560736524015003 0ustar sergeisergei# auto.tcl -- # # utility procs formerly in init.tcl dealing with auto execution of commands # and can be auto loaded themselves. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # auto_reset -- # # Destroy all cached information for auto-loading and auto-execution, so that # the information gets recomputed the next time it's needed. Also delete any # commands that are listed in the auto-load index. # # Arguments: # None. proc auto_reset {} { global auto_execs auto_index auto_path if {[array exists auto_index]} { foreach cmdName [array names auto_index] { set fqcn [namespace which $cmdName] if {$fqcn eq ""} { continue } rename $fqcn {} } } unset -nocomplain auto_execs auto_index ::tcl::auto_oldpath if {[catch {llength $auto_path}]} { set auto_path [list [info library]] } elseif {[info library] ni $auto_path} { lappend auto_path [info library] } } # tcl_findLibrary -- # # This is a utility for extensions that searches for a library directory # using a canonical searching algorithm. A side effect is to source the # initialization script and set a global library variable. # # Arguments: # basename Prefix of the directory name, (e.g., "tk") # version Version number of the package, (e.g., "8.0") # patch Patchlevel of the package, (e.g., "8.0.3") # initScript Initialization script to source (e.g., tk.tcl) # enVarName environment variable to honor (e.g., TK_LIBRARY) # varName Global variable to set when done (e.g., tk_library) proc tcl_findLibrary {basename version patch initScript enVarName varName} { upvar #0 $varName the_library global auto_path env tcl_platform set dirs {} set errors {} # The C application may have hardwired a path, which we honor if {[info exists the_library] && $the_library ne ""} { lappend dirs $the_library } else { # Do the canonical search # 1. From an environment variable, if it exists. Placing this first # gives the end-user ultimate control to work-around any bugs, or # to customize. if {[info exists env($enVarName)]} { lappend dirs $env($enVarName) } # 2. In the package script directory registered within the # configuration of the package itself. catch { lappend dirs [::${basename}::pkgconfig get scriptdir,runtime] } # 3. Relative to auto_path directories. This checks relative to the # Tcl library as well as allowing loading of libraries added to the # auto_path that is not relative to the core library or binary paths. foreach d $auto_path { lappend dirs [file join $d $basename$version] if {$tcl_platform(platform) eq "unix" && $tcl_platform(os) eq "Darwin"} { # 4. On MacOSX, check the Resources/Scripts subdir too lappend dirs [file join $d $basename$version Resources Scripts] } } # 3. Various locations relative to the executable # ../lib/foo1.0 (From bin directory in install hierarchy) # ../../lib/foo1.0 (From bin/arch directory in install hierarchy) # ../library (From unix directory in build hierarchy) # # Remaining locations are out of date (when relevant, they ought to be # covered by the $::auto_path seach above) and disabled. # # ../../library (From unix/arch directory in build hierarchy) # ../../foo1.0.1/library # (From unix directory in parallel build hierarchy) # ../../../foo1.0.1/library # (From unix/arch directory in parallel build hierarchy) set parentDir [file dirname [file dirname [info nameofexecutable]]] set grandParentDir [file dirname $parentDir] lappend dirs [file join $parentDir lib $basename$version] lappend dirs [file join $grandParentDir lib $basename$version] lappend dirs [file join $parentDir library] if {0} { lappend dirs [file join $grandParentDir library] lappend dirs [file join $grandParentDir $basename$patch library] lappend dirs [file join [file dirname $grandParentDir] \ $basename$patch library] } } # make $dirs unique, preserving order array set seen {} foreach i $dirs { # Make sure $i is unique under normalization. Avoid repeated [source]. if {[interp issafe]} { # Safe interps have no [file normalize]. set norm $i } else { set norm [file normalize $i] } if {[info exists seen($norm)]} { continue } set seen($norm) {} set the_library $i set file [file join $i $initScript] # source everything when in a safe interpreter because we have a # source command, but no file exists command if {[interp issafe] || [file exists $file]} { if {![catch {uplevel #0 [list source $file]} msg opts]} { return } append errors "$file: $msg\n" append errors [dict get $opts -errorinfo]\n } } unset -nocomplain the_library set msg "Can't find a usable $initScript in the following directories: \n" append msg " $dirs\n\n" append msg "$errors\n\n" append msg "This probably means that $basename wasn't installed properly.\n" error $msg } # ---------------------------------------------------------------------- # auto_mkindex # ---------------------------------------------------------------------- # The following procedures are used to generate the tclIndex file from Tcl # source files. They use a special safe interpreter to parse Tcl source # files, writing out index entries as "proc" commands are encountered. This # implementation won't work in a safe interpreter, since a safe interpreter # can't create the special parser and mess with its commands. if {[interp issafe]} { return ;# Stop sourcing the file here } # auto_mkindex -- # Regenerate a tclIndex file from Tcl source files. Takes as argument the # name of the directory in which the tclIndex file is to be placed, followed # by any number of glob patterns to use in that directory to locate all of the # relevant files. # # Arguments: # dir - Name of the directory in which to create an index. # args - Any number of additional arguments giving the names of files # within dir. If no additional are given auto_mkindex will look # for *.tcl. proc auto_mkindex {dir args} { if {[interp issafe]} { error "can't generate index within safe interpreter" } set oldDir [pwd] cd $dir append index "# Tcl autoload index file, version 2.0\n" append index "# This file is generated by the \"auto_mkindex\" command\n" append index "# and sourced to set up indexing information for one or\n" append index "# more commands. Typically each line is a command that\n" append index "# sets an element in the auto_index array, where the\n" append index "# element name is the name of a command and the value is\n" append index "# a script that loads the command.\n\n" if {![llength $args]} { set args *.tcl } auto_mkindex_parser::init foreach file [lsort [glob -- {*}$args]] { try { append index [auto_mkindex_parser::mkindex $file] } on error {msg opts} { cd $oldDir return -options $opts $msg } } auto_mkindex_parser::cleanup set fid [open "tclIndex" w] puts -nonewline $fid $index close $fid cd $oldDir } # Original version of auto_mkindex that just searches the source code for # "proc" at the beginning of the line. proc auto_mkindex_old {dir args} { set oldDir [pwd] cd $dir set dir [pwd] append index "# Tcl autoload index file, version 2.0\n" append index "# This file is generated by the \"auto_mkindex\" command\n" append index "# and sourced to set up indexing information for one or\n" append index "# more commands. Typically each line is a command that\n" append index "# sets an element in the auto_index array, where the\n" append index "# element name is the name of a command and the value is\n" append index "# a script that loads the command.\n\n" if {![llength $args]} { set args *.tcl } foreach file [lsort [glob -- {*}$args]] { set f "" set error [catch { set f [open $file] fconfigure $f -eofchar "\x1A {}" while {[gets $f line] >= 0} { if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { set procName [lindex [auto_qualify $procName "::"] 0] append index "set [list auto_index($procName)]" append index " \[list source \[file join \$dir [list $file]\]\]\n" } } close $f } msg opts] if {$error} { catch {close $f} cd $oldDir return -options $opts $msg } } set f "" set error [catch { set f [open tclIndex w] puts -nonewline $f $index close $f cd $oldDir } msg opts] if {$error} { catch {close $f} cd $oldDir error $msg $info $code return -options $opts $msg } } # Create a safe interpreter that can be used to parse Tcl source files # generate a tclIndex file for autoloading. This interp contains commands for # things that need index entries. Each time a command is executed, it writes # an entry out to the index file. namespace eval auto_mkindex_parser { variable parser "" ;# parser used to build index variable index "" ;# maintains index as it is built variable scriptFile "" ;# name of file being processed variable contextStack "" ;# stack of namespace scopes variable imports "" ;# keeps track of all imported cmds variable initCommands ;# list of commands that create aliases if {![info exists initCommands]} { set initCommands [list] } proc init {} { variable parser variable initCommands if {![interp issafe]} { set parser [interp create -safe] $parser hide info $parser hide rename $parser hide proc $parser hide namespace $parser hide eval $parser hide puts foreach ns [$parser invokehidden namespace children ::] { # MUST NOT DELETE "::tcl" OR BAD THINGS HAPPEN! if {$ns eq "::tcl"} continue $parser invokehidden namespace delete $ns } foreach cmd [$parser invokehidden info commands ::*] { $parser invokehidden rename $cmd {} } $parser invokehidden proc unknown {args} {} # We'll need access to the "namespace" command within the # interp. Put it back, but move it out of the way. $parser expose namespace $parser invokehidden rename namespace _%@namespace $parser expose eval $parser invokehidden rename eval _%@eval # Install all the registered pseudo-command implementations foreach cmd $initCommands { eval $cmd } } } proc cleanup {} { variable parser interp delete $parser unset parser } } # auto_mkindex_parser::mkindex -- # # Used by the "auto_mkindex" command to create a "tclIndex" file for the given # Tcl source file. Executes the commands in the file, and handles things like # the "proc" command by adding an entry for the index file. Returns a string # that represents the index file. # # Arguments: # file Name of Tcl source file to be indexed. proc auto_mkindex_parser::mkindex {file} { variable parser variable index variable scriptFile variable contextStack variable imports set scriptFile $file set fid [open $file] fconfigure $fid -eofchar "\x1A {}" set contents [read $fid] close $fid # There is one problem with sourcing files into the safe interpreter: # references like "$x" will fail since code is not really being executed # and variables do not really exist. To avoid this, we replace all $ with # \0 (literally, the null char) later, when getting proc names we will # have to reverse this replacement, in case there were any $ in the proc # name. This will cause a problem if somebody actually tries to have a \0 # in their proc name. Too bad for them. set contents [string map [list \$ \0] $contents] set index "" set contextStack "" set imports "" $parser eval $contents foreach name $imports { catch {$parser eval [list _%@namespace forget $name]} } return $index } # auto_mkindex_parser::hook command # # Registers a Tcl command to evaluate when initializing the child interpreter # used by the mkindex parser. The command is evaluated in the parent # interpreter, and can use the variable auto_mkindex_parser::parser to get to # the child proc auto_mkindex_parser::hook {cmd} { variable initCommands lappend initCommands $cmd } # auto_mkindex_parser::slavehook command # # Registers a Tcl command to evaluate when initializing the child interpreter # used by the mkindex parser. The command is evaluated in the child # interpreter. proc auto_mkindex_parser::slavehook {cmd} { variable initCommands # The $parser variable is defined to be the name of the child interpreter # when this command is used later. lappend initCommands "\$parser eval [list $cmd]" } # auto_mkindex_parser::command -- # # Registers a new command with the "auto_mkindex_parser" interpreter that # parses Tcl files. These commands are fake versions of things like the # "proc" command. When you execute them, they simply write out an entry to a # "tclIndex" file for auto-loading. # # This procedure allows extensions to register their own commands with the # auto_mkindex facility. For example, a package like [incr Tcl] might # register a "class" command so that class definitions could be added to a # "tclIndex" file for auto-loading. # # Arguments: # name Name of command recognized in Tcl files. # arglist Argument list for command. # body Implementation of command to handle indexing. proc auto_mkindex_parser::command {name arglist body} { hook [list auto_mkindex_parser::commandInit $name $arglist $body] } # auto_mkindex_parser::commandInit -- # # This does the actual work set up by auto_mkindex_parser::command. This is # called when the interpreter used by the parser is created. # # Arguments: # name Name of command recognized in Tcl files. # arglist Argument list for command. # body Implementation of command to handle indexing. proc auto_mkindex_parser::commandInit {name arglist body} { variable parser set ns [namespace qualifiers $name] set tail [namespace tail $name] if {$ns eq ""} { set fakeName [namespace current]::_%@fake_$tail } else { set fakeName [namespace current]::[string map {:: _} _%@fake_$name] } proc $fakeName $arglist $body # YUK! Tcl won't let us alias fully qualified command names, so we can't # handle names like "::itcl::class". Instead, we have to build procs with # the fully qualified names, and have the procs point to the aliases. if {[string match *::* $name]} { set exportCmd [list _%@namespace export [namespace tail $name]] $parser eval [list _%@namespace eval $ns $exportCmd] # The following proc definition does not work if you want to tolerate # space or something else diabolical in the procedure name, (i.e., # space in $alias). The following does not work: # "_%@eval {$alias} \$args" # because $alias gets concat'ed to $args. The following does not work # because $cmd is somehow undefined # "set cmd {$alias} \; _%@eval {\$cmd} \$args" # A gold star to someone that can make test autoMkindex-3.3 work # properly set alias [namespace tail $fakeName] $parser invokehidden proc $name {args} "_%@eval {$alias} \$args" $parser alias $alias $fakeName } else { $parser alias $name $fakeName } return } # auto_mkindex_parser::fullname -- # # Used by commands like "proc" within the auto_mkindex parser. Returns the # qualified namespace name for the "name" argument. If the "name" does not # start with "::", elements are added from the current namespace stack to # produce a qualified name. Then, the name is examined to see whether or not # it should really be qualified. If the name has more than the leading "::", # it is returned as a fully qualified name. Otherwise, it is returned as a # simple name. That way, the Tcl autoloader will recognize it properly. # # Arguments: # name - Name that is being added to index. proc auto_mkindex_parser::fullname {name} { variable contextStack if {![string match ::* $name]} { foreach ns $contextStack { set name "${ns}::$name" if {[string match ::* $name]} { break } } } if {[namespace qualifiers $name] eq ""} { set name [namespace tail $name] } elseif {![string match ::* $name]} { set name "::$name" } # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse that # replacement. return [string map [list \0 \$] $name] } # auto_mkindex_parser::indexEntry -- # # Used by commands like "proc" within the auto_mkindex parser to add a # correctly-quoted entry to the index. This is shared code so it is done # *right*, in one place. # # Arguments: # name - Name that is being added to index. proc auto_mkindex_parser::indexEntry {name} { variable index variable scriptFile # We convert all metacharacters to their backslashed form, and pre-split # the file name that we know about (which will be a proper list, and so # correctly quoted). set name [string range [list \}[fullname $name]] 2 end] set filenameParts [file split $scriptFile] append index [format \ {set auto_index(%s) [list source [file join $dir %s]]%s} \ $name $filenameParts \n] return } if {[llength $::auto_mkindex_parser::initCommands]} { return } # Register all of the procedures for the auto_mkindex parser that will build # the "tclIndex" file. # AUTO MKINDEX: proc name arglist body # Adds an entry to the auto index list for the given procedure name. auto_mkindex_parser::command proc {name args} { indexEntry $name } # Conditionally add support for Tcl byte code files. There are some tricky # details here. First, we need to get the tbcload library initialized in the # current interpreter. We cannot load tbcload into the child until we have # done so because it needs access to the tcl_patchLevel variable. Second, # because the package index file may defer loading the library until we invoke # a command, we need to explicitly invoke auto_load to force it to be loaded. # This should be a noop if the package has already been loaded auto_mkindex_parser::hook { try { package require tbcload } on error {} { # OK, don't have it so do nothing } on ok {} { if {[namespace which -command tbcload::bcproc] eq ""} { auto_load tbcload::bcproc } load {} tbcload $auto_mkindex_parser::parser # AUTO MKINDEX: tbcload::bcproc name arglist body # Adds an entry to the auto index list for the given precompiled # procedure name. auto_mkindex_parser::commandInit tbcload::bcproc {name args} { indexEntry $name } } } # AUTO MKINDEX: namespace eval name command ?arg arg...? # Adds the namespace name onto the context stack and evaluates the associated # body of commands. # # AUTO MKINDEX: namespace import ?-force? pattern ?pattern...? # Performs the "import" action in the parser interpreter. This is important # for any commands contained in a namespace that affect the index. For # example, a script may say "itcl::class ...", or it may import "itcl::*" and # then say "class ...". This procedure does the import operation, but keeps # track of imported patterns so we can remove the imports later. auto_mkindex_parser::command namespace {op args} { switch -- $op { eval { variable parser variable contextStack set name [lindex $args 0] set args [lrange $args 1 end] set contextStack [linsert $contextStack 0 $name] $parser eval [list _%@namespace eval $name] $args set contextStack [lrange $contextStack 1 end] } import { variable parser variable imports foreach pattern $args { if {$pattern ne "-force"} { lappend imports $pattern } } catch {$parser eval "_%@namespace import $args"} } ensemble { variable parser variable contextStack if {[lindex $args 0] eq "create"} { set name ::[join [lreverse $contextStack] ::] catch { set name [dict get [lrange $args 1 end] -command] if {![string match ::* $name]} { set name ::[join [lreverse $contextStack] ::]$name } regsub -all ::+ $name :: name } # create artificial proc to force an entry in the tclIndex $parser eval [list ::proc $name {} {}] } } } } # AUTO MKINDEX: oo::class create name ?definition? # Adds an entry to the auto index list for the given class name. auto_mkindex_parser::command oo::class {op name {body ""}} { if {$op eq "create"} { indexEntry $name } } auto_mkindex_parser::command class {op name {body ""}} { if {$op eq "create"} { indexEntry $name } } return tcl8.6.14/library/clock.tcl0000644000175000017500000037267214554262142015126 0ustar sergeisergei#---------------------------------------------------------------------- # # clock.tcl -- # # This file implements the portions of the [clock] ensemble that are # coded in Tcl. Refer to the users' manual to see the description of # the [clock] command and its subcommands. # # #---------------------------------------------------------------------- # # Copyright (c) 2004-2007 Kevin B. Kenny # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # #---------------------------------------------------------------------- # We must have message catalogs that support the root locale, and we need # access to the Registry on Windows systems. uplevel \#0 { package require msgcat 1.6 if { $::tcl_platform(platform) eq {windows} } { if { [catch { package require registry 1.1 }] } { namespace eval ::tcl::clock [list variable NoRegistry {}] } } } # Put the library directory into the namespace for the ensemble so that the # library code can find message catalogs and time zone definition files. namespace eval ::tcl::clock \ [list variable LibDir [file dirname [info script]]] #---------------------------------------------------------------------- # # clock -- # # Manipulate times. # # The 'clock' command manipulates time. Refer to the user documentation for # the available subcommands and what they do. # #---------------------------------------------------------------------- namespace eval ::tcl::clock { # Export the subcommands namespace export format namespace export clicks namespace export microseconds namespace export milliseconds namespace export scan namespace export seconds namespace export add # Import the message catalog commands that we use. namespace import ::msgcat::mcload namespace import ::msgcat::mclocale namespace import ::msgcat::mc namespace import ::msgcat::mcpackagelocale } #---------------------------------------------------------------------- # # ::tcl::clock::Initialize -- # # Finish initializing the 'clock' subsystem # # Results: # None. # # Side effects: # Namespace variable in the 'clock' subsystem are initialized. # # The '::tcl::clock::Initialize' procedure initializes the namespace variables # and root locale message catalog for the 'clock' subsystem. It is broken # into a procedure rather than simply evaluated as a script so that it will be # able to use local variables, avoiding the dangers of 'creative writing' as # in Bug 1185933. # #---------------------------------------------------------------------- proc ::tcl::clock::Initialize {} { rename ::tcl::clock::Initialize {} variable LibDir # Define the Greenwich time zone proc InitTZData {} { variable TZData array unset TZData set TZData(:Etc/GMT) { {-9223372036854775808 0 0 GMT} } set TZData(:GMT) $TZData(:Etc/GMT) set TZData(:Etc/UTC) { {-9223372036854775808 0 0 UTC} } set TZData(:UTC) $TZData(:Etc/UTC) set TZData(:localtime) {} } InitTZData mcpackagelocale set {} ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs] ::msgcat::mcpackageconfig set unknowncmd "" ::msgcat::mcpackageconfig set changecmd ChangeCurrentLocale # Define the message catalog for the root locale. ::msgcat::mcmset {} { AM {am} BCE {B.C.E.} CE {C.E.} DATE_FORMAT {%m/%d/%Y} DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y} DAYS_OF_WEEK_ABBREV { Sun Mon Tue Wed Thu Fri Sat } DAYS_OF_WEEK_FULL { Sunday Monday Tuesday Wednesday Thursday Friday Saturday } GREGORIAN_CHANGE_DATE 2299161 LOCALE_DATE_FORMAT {%m/%d/%Y} LOCALE_DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y} LOCALE_ERAS {} LOCALE_NUMERALS { 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 } LOCALE_TIME_FORMAT {%H:%M:%S} LOCALE_YEAR_FORMAT {%EC%Ey} MONTHS_ABBREV { Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec } MONTHS_FULL { January February March April May June July August September October November December } PM {pm} TIME_FORMAT {%H:%M:%S} TIME_FORMAT_12 {%I:%M:%S %P} TIME_FORMAT_24 {%H:%M} TIME_FORMAT_24_SECS {%H:%M:%S} } # Define a few Gregorian change dates for other locales. In most cases # the change date follows a language, because a nation's colonies changed # at the same time as the nation itself. In many cases, different # national boundaries existed; the dominating rule is to follow the # nation's capital. # Italy, Spain, Portugal, Poland ::msgcat::mcset it GREGORIAN_CHANGE_DATE 2299161 ::msgcat::mcset es GREGORIAN_CHANGE_DATE 2299161 ::msgcat::mcset pt GREGORIAN_CHANGE_DATE 2299161 ::msgcat::mcset pl GREGORIAN_CHANGE_DATE 2299161 # France, Austria ::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227 # For Belgium, we follow Southern Netherlands; Liege Diocese changed # several weeks later. ::msgcat::mcset fr_BE GREGORIAN_CHANGE_DATE 2299238 ::msgcat::mcset nl_BE GREGORIAN_CHANGE_DATE 2299238 # Austria ::msgcat::mcset de_AT GREGORIAN_CHANGE_DATE 2299527 # Hungary ::msgcat::mcset hu GREGORIAN_CHANGE_DATE 2301004 # Germany, Norway, Denmark (Catholic Germany changed earlier) ::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032 ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032 ::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032 ::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032 ::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032 # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed at # various times) ::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165 # Protestant Switzerland (Catholic cantons changed earlier) ::msgcat::mcset fr_CH GREGORIAN_CHANGE_DATE 2361342 ::msgcat::mcset it_CH GREGORIAN_CHANGE_DATE 2361342 ::msgcat::mcset de_CH GREGORIAN_CHANGE_DATE 2361342 # English speaking countries ::msgcat::mcset en GREGORIAN_CHANGE_DATE 2361222 # Sweden (had several changes onto and off of the Gregorian calendar) ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390 # Russia ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639 # Romania (Transylvania changed earlier - perhaps de_RO should show the # earlier date?) ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063 # Greece ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480 #------------------------------------------------------------------ # # CONSTANTS # #------------------------------------------------------------------ # Paths at which binary time zone data for the Olson libraries are known # to reside on various operating systems variable ZoneinfoPaths {} foreach path { /usr/share/zoneinfo /usr/share/lib/zoneinfo /usr/lib/zoneinfo /usr/local/etc/zoneinfo } { if { [file isdirectory $path] } { lappend ZoneinfoPaths $path } } # Define the directories for time zone data and message catalogs. variable DataDir [file join $LibDir tzdata] # Number of days in the months, in common years and leap years. variable DaysInRomanMonthInCommonYear \ { 31 28 31 30 31 30 31 31 30 31 30 31 } variable DaysInRomanMonthInLeapYear \ { 31 29 31 30 31 30 31 31 30 31 30 31 } variable DaysInPriorMonthsInCommonYear [list 0] variable DaysInPriorMonthsInLeapYear [list 0] set i 0 foreach j $DaysInRomanMonthInCommonYear { lappend DaysInPriorMonthsInCommonYear [incr i $j] } set i 0 foreach j $DaysInRomanMonthInLeapYear { lappend DaysInPriorMonthsInLeapYear [incr i $j] } # Another epoch (Hi, Jeff!) variable Roddenberry 1946 # Integer ranges variable MINWIDE -9223372036854775808 variable MAXWIDE 9223372036854775807 # Day before Leap Day variable FEB_28 58 # Translation table to map Windows TZI onto cities, so that the Olson # rules can apply. In some cases the mapping is ambiguous, so it's wise # to specify $::env(TCL_TZ) rather than simply depending on the system # time zone. # The keys are long lists of values obtained from the time zone # information in the Registry. In order, the list elements are: # Bias StandardBias DaylightBias # StandardDate.wYear StandardDate.wMonth StandardDate.wDayOfWeek # StandardDate.wDay StandardDate.wHour StandardDate.wMinute # StandardDate.wSecond StandardDate.wMilliseconds # DaylightDate.wYear DaylightDate.wMonth DaylightDate.wDayOfWeek # DaylightDate.wDay DaylightDate.wHour DaylightDate.wMinute # DaylightDate.wSecond DaylightDate.wMilliseconds # The values are the names of time zones where those rules apply. There # is considerable ambiguity in certain zones; an attempt has been made to # make a reasonable guess, but this table needs to be taken with a grain # of salt. variable WinZoneInfo [dict create {*}{ {-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Kwajalein {-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Midway {-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Honolulu {-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage {-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles {-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana {-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver {-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua {-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Phoenix {-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Regina {-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago {-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York {-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Indianapolis {-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Caracas {-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999} :America/Santiago {-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus {-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax {-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo {-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha {-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores {-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Atlantic/Cape_Verde {0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :UTC {0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0} :Europe/London {3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Kinshasa {3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :CET {7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Harare {7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0} :Africa/Cairo {7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0} :Europe/Helsinki {7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0} :Asia/Jerusalem {7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0} :Europe/Bucharest {7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Athens {7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0} :Asia/Amman {7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0} :Asia/Beirut {7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0} :Africa/Windhoek {10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Riyadh {10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0} :Asia/Baghdad {10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Moscow {12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0} :Asia/Tehran {14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0} :Asia/Baku {14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Muscat {14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Tbilisi {16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Kabul {18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Karachi {18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yekaterinburg {19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Calcutta {20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Katmandu {21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Dhaka {21600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Novosibirsk {23400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Rangoon {25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Bangkok {25200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Krasnoyarsk {28800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Chongqing {28800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Irkutsk {32400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Tokyo {32400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yakutsk {34200 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Adelaide {34200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Darwin {36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Brisbane {36000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Vladivostok {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 1 2 0 0 0} :Australia/Hobart {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Sydney {39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Noumea {43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0} :Pacific/Auckland {43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Fiji {46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu }] # Groups of fields that specify the date, priorities, and code bursts that # determine Julian Day Number given those groups. The code in [clock # scan] will choose the highest priority (lowest numbered) set of fields # that determines the date. variable DateParseActions { { seconds } 0 {} { julianDay } 1 {} { era century yearOfCentury month dayOfMonth } 2 { dict set date year [expr { 100 * [dict get $date century] + [dict get $date yearOfCentury] }] set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ $changeover] } { era century yearOfCentury dayOfYear } 2 { dict set date year [expr { 100 * [dict get $date century] + [dict get $date yearOfCentury] }] set date [GetJulianDayFromEraYearDay $date[set date {}] \ $changeover] } { century yearOfCentury month dayOfMonth } 3 { dict set date era CE dict set date year [expr { 100 * [dict get $date century] + [dict get $date yearOfCentury] }] set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ $changeover] } { century yearOfCentury dayOfYear } 3 { dict set date era CE dict set date year [expr { 100 * [dict get $date century] + [dict get $date yearOfCentury] }] set date [GetJulianDayFromEraYearDay $date[set date {}] \ $changeover] } { iso8601Century iso8601YearOfCentury iso8601Week dayOfWeek } 3 { dict set date era CE dict set date iso8601Year \ [expr { 100 * [dict get $date iso8601Century] + [dict get $date iso8601YearOfCentury] }] set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ $changeover] } { yearOfCentury month dayOfMonth } 4 { set date [InterpretTwoDigitYear $date[set date {}] $baseTime] dict set date era CE set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ $changeover] } { yearOfCentury dayOfYear } 4 { set date [InterpretTwoDigitYear $date[set date {}] $baseTime] dict set date era CE set date [GetJulianDayFromEraYearDay $date[set date {}] \ $changeover] } { iso8601YearOfCentury iso8601Week dayOfWeek } 4 { set date [InterpretTwoDigitYear \ $date[set date {}] $baseTime \ iso8601YearOfCentury iso8601Year] dict set date era CE set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ $changeover] } { month dayOfMonth } 5 { set date [AssignBaseYear $date[set date {}] \ $baseTime $timeZone $changeover] set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ $changeover] } { dayOfYear } 5 { set date [AssignBaseYear $date[set date {}] \ $baseTime $timeZone $changeover] set date [GetJulianDayFromEraYearDay $date[set date {}] \ $changeover] } { iso8601Week dayOfWeek } 5 { set date [AssignBaseIso8601Year $date[set date {}] \ $baseTime $timeZone $changeover] set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ $changeover] } { dayOfMonth } 6 { set date [AssignBaseMonth $date[set date {}] \ $baseTime $timeZone $changeover] set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ $changeover] } { dayOfWeek } 7 { set date [AssignBaseWeek $date[set date {}] \ $baseTime $timeZone $changeover] set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ $changeover] } {} 8 { set date [AssignBaseJulianDay $date[set date {}] \ $baseTime $timeZone $changeover] } } # Groups of fields that specify time of day, priorities, and code that # processes them variable TimeParseActions { seconds 1 {} { hourAMPM minute second amPmIndicator } 2 { dict set date secondOfDay [InterpretHMSP $date] } { hour minute second } 2 { dict set date secondOfDay [InterpretHMS $date] } { hourAMPM minute amPmIndicator } 3 { dict set date second 0 dict set date secondOfDay [InterpretHMSP $date] } { hour minute } 3 { dict set date second 0 dict set date secondOfDay [InterpretHMS $date] } { hourAMPM amPmIndicator } 4 { dict set date minute 0 dict set date second 0 dict set date secondOfDay [InterpretHMSP $date] } { hour } 4 { dict set date minute 0 dict set date second 0 dict set date secondOfDay [InterpretHMS $date] } { } 5 { dict set date secondOfDay 0 } } # Legacy time zones, used primarily for parsing RFC822 dates. variable LegacyTimeZone [dict create \ gmt +0000 \ ut +0000 \ utc +0000 \ bst +0100 \ wet +0000 \ wat -0100 \ at -0200 \ nft -0330 \ nst -0330 \ ndt -0230 \ ast -0400 \ adt -0300 \ est -0500 \ edt -0400 \ cst -0600 \ cdt -0500 \ mst -0700 \ mdt -0600 \ pst -0800 \ pdt -0700 \ yst -0900 \ ydt -0800 \ hst -1000 \ hdt -0900 \ cat -1000 \ ahst -1000 \ nt -1100 \ idlw -1200 \ cet +0100 \ cest +0200 \ met +0100 \ mewt +0100 \ mest +0200 \ swt +0100 \ sst +0200 \ fwt +0100 \ fst +0200 \ eet +0200 \ eest +0300 \ bt +0300 \ it +0330 \ zp4 +0400 \ zp5 +0500 \ ist +0530 \ zp6 +0600 \ wast +0700 \ wadt +0800 \ jt +0730 \ cct +0800 \ jst +0900 \ kst +0900 \ cast +0930 \ jdt +1000 \ kdt +1000 \ cadt +1030 \ east +1000 \ eadt +1030 \ gst +1000 \ nzt +1200 \ nzst +1200 \ nzdt +1300 \ idle +1200 \ a +0100 \ b +0200 \ c +0300 \ d +0400 \ e +0500 \ f +0600 \ g +0700 \ h +0800 \ i +0900 \ k +1000 \ l +1100 \ m +1200 \ n -0100 \ o -0200 \ p -0300 \ q -0400 \ r -0500 \ s -0600 \ t -0700 \ u -0800 \ v -0900 \ w -1000 \ x -1100 \ y -1200 \ z +0000 \ ] # Caches variable LocaleNumeralCache {}; # Dictionary whose keys are locale # names and whose values are pairs # comprising regexes matching numerals # in the given locales and dictionaries # mapping the numerals to their numeric # values. # variable CachedSystemTimeZone; # If 'CachedSystemTimeZone' exists, # it contains the value of the # system time zone, as determined from # the environment. variable TimeZoneBad {}; # Dictionary whose keys are time zone # names and whose values are 1 if # the time zone is unknown and 0 # if it is known. variable TZData; # Array whose keys are time zone names # and whose values are lists of quads # comprising start time, UTC offset, # Daylight Saving Time indicator, and # time zone abbreviation. variable FormatProc; # Array mapping format group # and locale to the name of a procedure # that renders the given format } ::tcl::clock::Initialize #---------------------------------------------------------------------- # # clock format -- # # Formats a count of seconds since the Posix Epoch as a time of day. # # The 'clock format' command formats times of day for output. Refer to the # user documentation to see what it does. # #---------------------------------------------------------------------- proc ::tcl::clock::format { args } { variable FormatProc variable TZData lassign [ParseFormatArgs {*}$args] format locale timezone set locale [string tolower $locale] set clockval [lindex $args 0] # Get the data for time changes in the given zone if {$timezone eq ""} { set timezone [GetSystemTimeZone] } if {![info exists TZData($timezone)]} { if {[catch {SetupTimeZone $timezone} retval opts]} { dict unset opts -errorinfo return -options $opts $retval } } # Build a procedure to format the result. Cache the built procedure's name # in the 'FormatProc' array to avoid losing its internal representation, # which contains the name resolution. set procName formatproc'$format'$locale set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName] if {[info exists FormatProc($procName)]} { set procName $FormatProc($procName) } else { set FormatProc($procName) \ [ParseClockFormatFormat $procName $format $locale] } return [$procName $clockval $timezone] } #---------------------------------------------------------------------- # # ParseClockFormatFormat -- # # Builds and caches a procedure that formats a time value. # # Parameters: # format -- Format string to use # locale -- Locale in which the format string is to be interpreted # # Results: # Returns the name of the newly-built procedure. # #---------------------------------------------------------------------- proc ::tcl::clock::ParseClockFormatFormat {procName format locale} { if {[namespace which $procName] ne {}} { return $procName } # Map away the locale-dependent composite format groups EnterLocale $locale # Change locale if a fresh locale has been given on the command line. try { return [ParseClockFormatFormat2 $format $locale $procName] } trap CLOCK {result opts} { dict unset opts -errorinfo return -options $opts $result } } proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { set didLocaleEra 0 set didLocaleNumerals 0 set preFormatCode \ [string map [list @GREGORIAN_CHANGE_DATE@ \ [mc GREGORIAN_CHANGE_DATE]] \ { variable TZData set date [GetDateFields $clockval \ $TZData($timezone) \ @GREGORIAN_CHANGE_DATE@] }] set formatString {} set substituents {} set state {} set format [LocalizeFormat $locale $format] foreach char [split $format {}] { switch -exact -- $state { {} { if { [string equal % $char] } { set state percent } else { append formatString $char } } percent { # Character following a '%' character set state {} switch -exact -- $char { % { # A literal character, '%' append formatString %% } a { # Day of week, abbreviated append formatString %s append substituents \ [string map \ [list @DAYS_OF_WEEK_ABBREV@ \ [list [mc DAYS_OF_WEEK_ABBREV]]] \ { [lindex @DAYS_OF_WEEK_ABBREV@ \ [expr {[dict get $date dayOfWeek] \ % 7}]]}] } A { # Day of week, spelt out. append formatString %s append substituents \ [string map \ [list @DAYS_OF_WEEK_FULL@ \ [list [mc DAYS_OF_WEEK_FULL]]] \ { [lindex @DAYS_OF_WEEK_FULL@ \ [expr {[dict get $date dayOfWeek] \ % 7}]]}] } b - h { # Name of month, abbreviated. append formatString %s append substituents \ [string map \ [list @MONTHS_ABBREV@ \ [list [mc MONTHS_ABBREV]]] \ { [lindex @MONTHS_ABBREV@ \ [expr {[dict get $date month]-1}]]}] } B { # Name of month, spelt out append formatString %s append substituents \ [string map \ [list @MONTHS_FULL@ \ [list [mc MONTHS_FULL]]] \ { [lindex @MONTHS_FULL@ \ [expr {[dict get $date month]-1}]]}] } C { # Century number append formatString %02d append substituents \ { [expr {[dict get $date year] / 100}]} } d { # Day of month, with leading zero append formatString %02d append substituents { [dict get $date dayOfMonth]} } e { # Day of month, without leading zero append formatString %2d append substituents { [dict get $date dayOfMonth]} } E { # Format group in a locale-dependent # alternative era set state percentE if {!$didLocaleEra} { append preFormatCode \ [string map \ [list @LOCALE_ERAS@ \ [list [mc LOCALE_ERAS]]] \ { set date [GetLocaleEra \ $date[set date {}] \ @LOCALE_ERAS@]}] \n set didLocaleEra 1 } if {!$didLocaleNumerals} { append preFormatCode \ [list set localeNumerals \ [mc LOCALE_NUMERALS]] \n set didLocaleNumerals 1 } } g { # Two-digit year relative to ISO8601 # week number append formatString %02d append substituents \ { [expr { [dict get $date iso8601Year] % 100 }]} } G { # Four-digit year relative to ISO8601 # week number append formatString %02d append substituents { [dict get $date iso8601Year]} } H { # Hour in the 24-hour day, leading zero append formatString %02d append substituents \ { [expr { [dict get $date localSeconds] \ / 3600 % 24}]} } I { # Hour AM/PM, with leading zero append formatString %02d append substituents \ { [expr { ( ( ( [dict get $date localSeconds] \ % 86400 ) \ + 86400 \ - 3600 ) \ / 3600 ) \ % 12 + 1 }] } } j { # Day of year (001-366) append formatString %03d append substituents { [dict get $date dayOfYear]} } J { # Julian Day Number append formatString %07ld append substituents { [dict get $date julianDay]} } k { # Hour (0-23), no leading zero append formatString %2d append substituents \ { [expr { [dict get $date localSeconds] / 3600 % 24 }]} } l { # Hour (12-11), no leading zero append formatString %2d append substituents \ { [expr { ( ( ( [dict get $date localSeconds] % 86400 ) + 86400 - 3600 ) / 3600 ) % 12 + 1 }]} } m { # Month number, leading zero append formatString %02d append substituents { [dict get $date month]} } M { # Minute of the hour, leading zero append formatString %02d append substituents \ { [expr { [dict get $date localSeconds] / 60 % 60 }]} } n { # A literal newline append formatString \n } N { # Month number, no leading zero append formatString %2d append substituents { [dict get $date month]} } O { # A format group in the locale's # alternative numerals set state percentO if {!$didLocaleNumerals} { append preFormatCode \ [list set localeNumerals \ [mc LOCALE_NUMERALS]] \n set didLocaleNumerals 1 } } p { # Localized 'AM' or 'PM' indicator # converted to uppercase append formatString %s append preFormatCode \ [list set AM [string toupper [mc AM]]] \n \ [list set PM [string toupper [mc PM]]] \n append substituents \ { [expr {(([dict get $date localSeconds] % 86400) < 43200) ? $AM : $PM}]} } P { # Localized 'AM' or 'PM' indicator append formatString %s append preFormatCode \ [list set am [mc AM]] \n \ [list set pm [mc PM]] \n append substituents \ { [expr {(([dict get $date localSeconds] % 86400) < 43200) ? $am : $pm}]} } Q { # Hi, Jeff! append formatString %s append substituents { [FormatStarDate $date]} } s { # Seconds from the Posix Epoch append formatString %s append substituents { [dict get $date seconds]} } S { # Second of the minute, with # leading zero append formatString %02d append substituents \ { [expr { [dict get $date localSeconds] % 60 }]} } t { # A literal tab character append formatString \t } u { # Day of the week (1-Monday, 7-Sunday) append formatString %1d append substituents { [dict get $date dayOfWeek]} } U { # Week of the year (00-53). The # first Sunday of the year is the # first day of week 01 append formatString %02d append preFormatCode { set dow [dict get $date dayOfWeek] if { $dow == 7 } { set dow 0 } incr dow set UweekNumber \ [expr { ( [dict get $date dayOfYear] - $dow + 7 ) / 7 }] } append substituents { $UweekNumber} } V { # The ISO8601 week number append formatString %02d append substituents { [dict get $date iso8601Week]} } w { # Day of the week (0-Sunday, # 6-Saturday) append formatString %1d append substituents \ { [expr { [dict get $date dayOfWeek] % 7 }]} } W { # Week of the year (00-53). The first # Monday of the year is the first day # of week 01. append preFormatCode { set WweekNumber \ [expr { ( [dict get $date dayOfYear] - [dict get $date dayOfWeek] + 7 ) / 7 }] } append formatString %02d append substituents { $WweekNumber} } y { # The two-digit year of the century append formatString %02d append substituents \ { [expr { [dict get $date year] % 100 }]} } Y { # The four-digit year append formatString %04d append substituents { [dict get $date year]} } z { # The time zone as hours and minutes # east (+) or west (-) of Greenwich append formatString %s append substituents { [FormatNumericTimeZone \ [dict get $date tzOffset]]} } Z { # The name of the time zone append formatString %s append substituents { [dict get $date tzName]} } % { # A literal percent character append formatString %% } default { # An unknown escape sequence append formatString %% $char } } } percentE { # Character following %E set state {} switch -exact -- $char { E { append formatString %s append substituents { } \ [string map \ [list @BCE@ [list [mc BCE]] \ @CE@ [list [mc CE]]] \ {[dict get {BCE @BCE@ CE @CE@} \ [dict get $date era]]}] } C { # Locale-dependent era append formatString %s append substituents { [dict get $date localeEra]} } y { # Locale-dependent year of the era append preFormatCode { set y [dict get $date localeYear] if { $y >= 0 && $y < 100 } { set Eyear [lindex $localeNumerals $y] } else { set Eyear $y } } append formatString %s append substituents { $Eyear} } default { # Unknown %E format group append formatString %%E $char } } } percentO { # Character following %O set state {} switch -exact -- $char { d - e { # Day of the month in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ [dict get $date dayOfMonth]]} } H - k { # Hour of the day in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ [expr { [dict get $date localSeconds] / 3600 % 24 }]]} } I - l { # Hour (12-11) AM/PM in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ [expr { ( ( ( [dict get $date localSeconds] % 86400 ) + 86400 - 3600 ) / 3600 ) % 12 + 1 }]]} } m { # Month number in alternative numerals append formatString %s append substituents \ { [lindex $localeNumerals [dict get $date month]]} } M { # Minute of the hour in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ [expr { [dict get $date localSeconds] / 60 % 60 }]]} } S { # Second of the minute in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ [expr { [dict get $date localSeconds] % 60 }]]} } u { # Day of the week (Monday=1,Sunday=7) # in alternative numerals append formatString %s append substituents \ { [lindex $localeNumerals \ [dict get $date dayOfWeek]]} } w { # Day of the week (Sunday=0,Saturday=6) # in alternative numerals append formatString %s append substituents \ { [lindex $localeNumerals \ [expr { [dict get $date dayOfWeek] % 7 }]]} } y { # Year of the century in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ [expr { [dict get $date year] % 100 }]]} } default { # Unknown format group append formatString %%O $char } } } } } # Clean up any improperly terminated groups switch -exact -- $state { percent { append formatString %% } percentE { append retval %%E } percentO { append retval %%O } } proc $procName {clockval timezone} " $preFormatCode return \[::format [list $formatString] $substituents\] " # puts [list $procName [info args $procName] [info body $procName]] return $procName } #---------------------------------------------------------------------- # # clock scan -- # # Inputs a count of seconds since the Posix Epoch as a time of day. # # The 'clock scan' command scans times of day on input. Refer to the user # documentation to see what it does. # #---------------------------------------------------------------------- proc ::tcl::clock::scan { args } { set format {} # Check the count of args if { [llength $args] < 1 || [llength $args] % 2 != 1 } { set cmdName "clock scan" return -code error \ -errorcode [list CLOCK wrongNumArgs] \ "wrong \# args: should be\ \"$cmdName string\ ?-base seconds?\ ?-format string? ?-gmt boolean?\ ?-locale LOCALE? ?-timezone ZONE?\"" } # Set defaults set base [clock seconds] set string [lindex $args 0] set format {} set gmt 0 set locale c set timezone [GetSystemTimeZone] # Pick up command line options. foreach { flag value } [lreplace $args 0 0] { switch -exact -- $flag { -b - -ba - -bas - -base { set base $value } -f - -fo - -for - -form - -forma - -format { set saw(-format) {} set format $value } -g - -gm - -gmt { set saw(-gmt) {} set gmt $value } -l - -lo - -loc - -loca - -local - -locale { set saw(-locale) {} set locale [string tolower $value] } -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone { set saw(-timezone) {} set timezone $value } default { return -code error \ -errorcode [list CLOCK badOption $flag] \ "bad option \"$flag\",\ must be -base, -format, -gmt, -locale or -timezone" } } } # Check options for validity if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } { return -code error \ -errorcode [list CLOCK gmtWithTimezone] \ "cannot use -gmt and -timezone in same call" } if { [catch { expr { wide($base) } } result] } { return -code error "expected integer but got \"$base\"" } if { ![string is boolean -strict $gmt] } { return -code error "expected boolean value but got \"$gmt\"" } elseif { $gmt } { set timezone :GMT } if { ![info exists saw(-format)] } { # Perhaps someday we'll localize the legacy code. Right now, it's not # localized. if { [info exists saw(-locale)] } { return -code error \ -errorcode [list CLOCK flagWithLegacyFormat] \ "legacy \[clock scan\] does not support -locale" } return [FreeScan $string $base $timezone $locale] } # Change locale if a fresh locale has been given on the command line. EnterLocale $locale try { # Map away the locale-dependent composite format groups set scanner [ParseClockScanFormat $format $locale] return [$scanner $string $base $timezone] } trap CLOCK {result opts} { # Conceal location of generation of expected errors dict unset opts -errorinfo return -options $opts $result } } #---------------------------------------------------------------------- # # FreeScan -- # # Scans a time in free format # # Parameters: # string - String containing the time to scan # base - Base time, expressed in seconds from the Epoch # timezone - Default time zone in which the time will be expressed # locale - (Unused) Name of the locale where the time will be scanned. # # Results: # Returns the date and time extracted from the string in seconds from # the epoch # #---------------------------------------------------------------------- proc ::tcl::clock::FreeScan { string base timezone locale } { variable TZData # Get the data for time changes in the given zone try { SetupTimeZone $timezone } on error {retval opts} { dict unset opts -errorinfo return -options $opts $retval } # Extract year, month and day from the base time for the parser to use as # defaults set date [GetDateFields $base $TZData($timezone) 2361222] dict set date secondOfDay [expr { [dict get $date localSeconds] % 86400 }] # Parse the date. The parser will return a list comprising date, time, # time zone, relative month/day/seconds, relative weekday, ordinal month. try { set scanned [Oldscan $string \ [dict get $date year] \ [dict get $date month] \ [dict get $date dayOfMonth]] lassign $scanned \ parseDate parseTime parseZone parseRel \ parseWeekday parseOrdinalMonth } on error message { return -code error \ "unable to convert date-time string \"$string\": $message" } # If the caller supplied a date in the string, update the 'date' dict with # the value. If the caller didn't specify a time with the date, default to # midnight. if { [llength $parseDate] > 0 } { lassign $parseDate y m d if { $y < 100 } { if { $y >= 39 } { incr y 1900 } else { incr y 2000 } } dict set date era CE dict set date year $y dict set date month $m dict set date dayOfMonth $d if { $parseTime eq {} } { set parseTime 0 } } # If the caller supplied a time zone in the string, it comes back as a # two-element list; the first element is the number of minutes east of # Greenwich, and the second is a Daylight Saving Time indicator (1 == yes, # 0 == no, -1 == unknown). We make it into a time zone indicator of # +-hhmm. if { [llength $parseZone] > 0 } { lassign $parseZone minEast dstFlag set timezone [FormatNumericTimeZone \ [expr { 60 * $minEast + 3600 * $dstFlag }]] SetupTimeZone $timezone } dict set date tzName $timezone # Assemble date, time, zone into seconds-from-epoch set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2361222] if { $parseTime ne {} } { dict set date secondOfDay $parseTime } elseif { [llength $parseWeekday] != 0 || [llength $parseOrdinalMonth] != 0 || ( [llength $parseRel] != 0 && ( [lindex $parseRel 0] != 0 || [lindex $parseRel 1] != 0 ) ) } { dict set date secondOfDay 0 } dict set date localSeconds [expr { -210866803200 + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] dict set date tzName $timezone set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222] set seconds [dict get $date seconds] # Do relative times if { [llength $parseRel] > 0 } { lassign $parseRel relMonth relDay relSecond set seconds [add $seconds \ $relMonth months $relDay days $relSecond seconds \ -timezone $timezone -locale $locale] } # Do relative weekday if { [llength $parseWeekday] > 0 } { lassign $parseWeekday dayOrdinal dayOfWeek set date2 [GetDateFields $seconds $TZData($timezone) 2361222] dict set date2 era CE set jdwkday [WeekdayOnOrBefore $dayOfWeek [expr { [dict get $date2 julianDay] + 6 }]] incr jdwkday [expr { 7 * $dayOrdinal }] if { $dayOrdinal > 0 } { incr jdwkday -7 } dict set date2 secondOfDay \ [expr { [dict get $date2 localSeconds] % 86400 }] dict set date2 julianDay $jdwkday dict set date2 localSeconds [expr { -210866803200 + ( 86400 * wide([dict get $date2 julianDay]) ) + [dict get $date secondOfDay] }] dict set date2 tzName $timezone set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \ 2361222] set seconds [dict get $date2 seconds] } # Do relative month if { [llength $parseOrdinalMonth] > 0 } { lassign $parseOrdinalMonth monthOrdinal monthNumber if { $monthOrdinal > 0 } { set monthDiff [expr { $monthNumber - [dict get $date month] }] if { $monthDiff <= 0 } { incr monthDiff 12 } incr monthOrdinal -1 } else { set monthDiff [expr { [dict get $date month] - $monthNumber }] if { $monthDiff >= 0 } { incr monthDiff -12 } incr monthOrdinal } set seconds [add $seconds $monthOrdinal years $monthDiff months \ -timezone $timezone -locale $locale] } return $seconds } #---------------------------------------------------------------------- # # ParseClockScanFormat -- # # Parses a format string given to [clock scan -format] # # Parameters: # formatString - The format being parsed # locale - The current locale # # Results: # Constructs and returns a procedure that accepts the string being # scanned, the base time, and the time zone. The procedure will either # return the scanned time or else throw an error that should be rethrown # to the caller of [clock scan] # # Side effects: # The given procedure is defined in the ::tcl::clock namespace. Scan # procedures are not deleted once installed. # # Why do we parse dates by defining a procedure to parse them? The reason is # that by doing so, we have one convenient place to cache all the information: # the regular expressions that match the patterns (which will be compiled), # the code that assembles the date information, everything lands in one place. # In this way, when a given format is reused at run time, all the information # of how to apply it is available in a single place. # #---------------------------------------------------------------------- proc ::tcl::clock::ParseClockScanFormat {formatString locale} { # Check whether the format has been parsed previously, and return the # existing recognizer if it has. set procName scanproc'$formatString'$locale set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName] if { [namespace which $procName] != {} } { return $procName } variable DateParseActions variable TimeParseActions # Localize the %x, %X, etc. groups set formatString [LocalizeFormat $locale $formatString] # Condense whitespace regsub -all {[[:space:]]+} $formatString { } formatString # Walk through the groups of the format string. In this loop, we # accumulate: # - a regular expression that matches the string, # - the count of capturing brackets in the regexp # - a set of code that post-processes the fields captured by the regexp, # - a dictionary whose keys are the names of fields that are present # in the format string. set re {^[[:space:]]*} set captureCount 0 set postcode {} set fieldSet [dict create] set fieldCount 0 set postSep {} set state {} foreach c [split $formatString {}] { switch -exact -- $state { {} { if { $c eq "%" } { set state % } elseif { $c eq " " } { append re {[[:space:]]+} } else { if { ! [string is alnum $c] } { append re "\\" } append re $c } } % { set state {} switch -exact -- $c { % { append re % } { } { append re "\[\[:space:\]\]*" } a - A { # Day of week, in words set l {} foreach \ i {7 1 2 3 4 5 6} \ abr [mc DAYS_OF_WEEK_ABBREV] \ full [mc DAYS_OF_WEEK_FULL] { dict set l [string tolower $abr] $i dict set l [string tolower $full] $i incr i } lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet dayOfWeek [incr fieldCount] append postcode "dict set date dayOfWeek \[" \ "dict get " [list $lookup] " " \ \[ {string tolower $field} [incr captureCount] \] \ "\]\n" } b - B - h { # Name of month set i 0 set l {} foreach \ abr [mc MONTHS_ABBREV] \ full [mc MONTHS_FULL] { incr i dict set l [string tolower $abr] $i dict set l [string tolower $full] $i } lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ "dict get " [list $lookup] \ " " \[ {string tolower $field} \ [incr captureCount] \] \ "\]\n" } C { # Gregorian century append re \\s*(\\d\\d?) dict set fieldSet century [incr fieldCount] append postcode "dict set date century \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } d - e { # Day of month append re \\s*(\\d\\d?) dict set fieldSet dayOfMonth [incr fieldCount] append postcode "dict set date dayOfMonth \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } E { # Prefix for locale-specific codes set state %E } g { # ISO8601 2-digit year append re \\s*(\\d\\d) dict set fieldSet iso8601YearOfCentury \ [incr fieldCount] append postcode \ "dict set date iso8601YearOfCentury \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } G { # ISO8601 4-digit year append re \\s*(\\d\\d)(\\d\\d) dict set fieldSet iso8601Century [incr fieldCount] dict set fieldSet iso8601YearOfCentury \ [incr fieldCount] append postcode \ "dict set date iso8601Century \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" \ "dict set date iso8601YearOfCentury \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } H - k { # Hour of day append re \\s*(\\d\\d?) dict set fieldSet hour [incr fieldCount] append postcode "dict set date hour \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } I - l { # Hour, AM/PM append re \\s*(\\d\\d?) dict set fieldSet hourAMPM [incr fieldCount] append postcode "dict set date hourAMPM \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } j { # Day of year append re \\s*(\\d\\d?\\d?) dict set fieldSet dayOfYear [incr fieldCount] append postcode "dict set date dayOfYear \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } J { # Julian Day Number append re \\s*(\\d+) dict set fieldSet julianDay [incr fieldCount] append postcode "dict set date julianDay \[" \ "::scan \$field" [incr captureCount] " %ld" \ "\]\n" } m - N { # Month number append re \\s*(\\d\\d?) dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } M { # Minute append re \\s*(\\d\\d?) dict set fieldSet minute [incr fieldCount] append postcode "dict set date minute \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } n { # Literal newline append re \\n } O { # Prefix for locale numerics set state %O } p - P { # AM/PM indicator set l [list [string tolower [mc AM]] 0 \ [string tolower [mc PM]] 1] lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet amPmIndicator [incr fieldCount] append postcode "dict set date amPmIndicator \[" \ "dict get " [list $lookup] " \[string tolower " \ "\$field" \ [incr captureCount] \ "\]\]\n" } Q { # Hi, Jeff! append re {Stardate\s+([-+]?\d+)(\d\d\d)[.](\d)} incr captureCount dict set fieldSet seconds [incr fieldCount] append postcode {dict set date seconds } \[ \ {ParseStarDate $field} [incr captureCount] \ { $field} [incr captureCount] \ { $field} [incr captureCount] \ \] \n } s { # Seconds from Posix Epoch # This next case is insanely difficult, because it's # problematic to determine whether the field is # actually within the range of a wide integer. append re {\s*([-+]?\d+)} dict set fieldSet seconds [incr fieldCount] append postcode {dict set date seconds } \[ \ {ScanWide $field} [incr captureCount] \] \n } S { # Second append re \\s*(\\d\\d?) dict set fieldSet second [incr fieldCount] append postcode "dict set date second \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } t { # Literal tab character append re \\t } u - w { # Day number within week, 0 or 7 == Sun # 1=Mon, 6=Sat append re \\s*(\\d) dict set fieldSet dayOfWeek [incr fieldCount] append postcode {::scan $field} [incr captureCount] \ { %d dow} \n \ { if { $dow == 0 } { set dow 7 } elseif { $dow > 7 } { return -code error \ -errorcode [list CLOCK badDayOfWeek] \ "day of week is greater than 7" } dict set date dayOfWeek $dow } } U { # Week of year. The first Sunday of # the year is the first day of week # 01. No scan rule uses this group. append re \\s*\\d\\d? } V { # Week of ISO8601 year append re \\s*(\\d\\d?) dict set fieldSet iso8601Week [incr fieldCount] append postcode "dict set date iso8601Week \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } W { # Week of the year (00-53). The first # Monday of the year is the first day # of week 01. No scan rule uses this # group. append re \\s*\\d\\d? } y { # Two-digit Gregorian year append re \\s*(\\d\\d?) dict set fieldSet yearOfCentury [incr fieldCount] append postcode "dict set date yearOfCentury \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } Y { # 4-digit Gregorian year append re \\s*(\\d\\d)(\\d\\d) dict set fieldSet century [incr fieldCount] dict set fieldSet yearOfCentury [incr fieldCount] append postcode \ "dict set date century \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" \ "dict set date yearOfCentury \[" \ "::scan \$field" [incr captureCount] " %d" \ "\]\n" } z - Z { # Time zone name append re {(?:([-+]\d\d(?::?\d\d(?::?\d\d)?)?)|([[:alnum:]]{1,4}))} dict set fieldSet tzName [incr fieldCount] append postcode \ {if } \{ { $field} [incr captureCount] \ { ne "" } \} { } \{ \n \ {dict set date tzName $field} \ $captureCount \n \ \} { else } \{ \n \ {dict set date tzName } \[ \ {ConvertLegacyTimeZone $field} \ [incr captureCount] \] \n \ \} \n \ } % { # Literal percent character append re % } default { append re % if { ! [string is alnum $c] } { append re \\ } append re $c } } } %E { switch -exact -- $c { C { # Locale-dependent era set d {} foreach triple [mc LOCALE_ERAS] { lassign $triple t symbol year dict set d [string tolower $symbol] $year } lassign [UniquePrefixRegexp $d] regex lookup append re (?: $regex ) } E { set l {} dict set l [string tolower [mc BCE]] BCE dict set l [string tolower [mc CE]] CE dict set l b.c.e. BCE dict set l c.e. CE dict set l b.c. BCE dict set l a.d. CE lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet era [incr fieldCount] append postcode "dict set date era \["\ "dict get " [list $lookup] \ { } \[ {string tolower $field} \ [incr captureCount] \] \ "\]\n" } y { # Locale-dependent year of the era lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex incr captureCount } default { append re %E if { ! [string is alnum $c] } { append re \\ } append re $c } } set state {} } %O { switch -exact -- $c { d - e { lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet dayOfMonth [incr fieldCount] append postcode "dict set date dayOfMonth \[" \ "dict get " [list $lookup] " \$field" \ [incr captureCount] \ "\]\n" } H - k { lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet hour [incr fieldCount] append postcode "dict set date hour \[" \ "dict get " [list $lookup] " \$field" \ [incr captureCount] \ "\]\n" } I - l { lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet hourAMPM [incr fieldCount] append postcode "dict set date hourAMPM \[" \ "dict get " [list $lookup] " \$field" \ [incr captureCount] \ "\]\n" } m { lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ "dict get " [list $lookup] " \$field" \ [incr captureCount] \ "\]\n" } M { lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet minute [incr fieldCount] append postcode "dict set date minute \[" \ "dict get " [list $lookup] " \$field" \ [incr captureCount] \ "\]\n" } S { lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet second [incr fieldCount] append postcode "dict set date second \[" \ "dict get " [list $lookup] " \$field" \ [incr captureCount] \ "\]\n" } u - w { lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet dayOfWeek [incr fieldCount] append postcode "set dow \[dict get " [list $lookup] \ { $field} [incr captureCount] \] \n \ { if { $dow == 0 } { set dow 7 } elseif { $dow > 7 } { return -code error \ -errorcode [list CLOCK badDayOfWeek] \ "day of week is greater than 7" } dict set date dayOfWeek $dow } } y { lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet yearOfCentury [incr fieldCount] append postcode {dict set date yearOfCentury } \[ \ {dict get } [list $lookup] { $field} \ [incr captureCount] \] \n } default { append re %O if { ! [string is alnum $c] } { append re \\ } append re $c } } set state {} } } } # Clean up any unfinished format groups append re $state \\s*\$ # Build the procedure set procBody {} append procBody "variable ::tcl::clock::TZData" \n append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->" for { set i 1 } { $i <= $captureCount } { incr i } { append procBody " " field $i } append procBody "\] \} \{" \n append procBody { return -code error -errorcode [list CLOCK badInputString] \ {input string does not match supplied format} } append procBody \}\n append procBody "set date \[dict create\]" \n append procBody {dict set date tzName $timeZone} \n append procBody $postcode append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n # Set up the time zone before doing anything with a default base date # that might need a timezone to interpret it. if { ![dict exists $fieldSet seconds] && ![dict exists $fieldSet starDate] } { if { [dict exists $fieldSet tzName] } { append procBody { set timeZone [dict get $date tzName] } } append procBody { ::tcl::clock::SetupTimeZone $timeZone } } # Add code that gets Julian Day Number from the fields. append procBody [MakeParseCodeFromFields $fieldSet $DateParseActions] # Get time of day append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions] # Assemble seconds from the Julian day and second of the day. # Convert to local time unless epoch seconds or stardate are # being processed - they're always absolute if { ![dict exists $fieldSet seconds] && ![dict exists $fieldSet starDate] } { append procBody { if { [dict get $date julianDay] > 5373484 } { return -code error -errorcode [list CLOCK dateTooLarge] \ "requested date too large to represent" } dict set date localSeconds [expr { -210866803200 + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] } # Finally, convert the date to local time append procBody { set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \ $TZData($timeZone) $changeover] } } # Return result append procBody {return [dict get $date seconds]} \n proc $procName { string baseTime timeZone } $procBody # puts [list proc $procName [list string baseTime timeZone] $procBody] return $procName } #---------------------------------------------------------------------- # # LocaleNumeralMatcher -- # # Composes a regexp that captures the numerals in the given locale, and # a dictionary to map them to conventional numerals. # # Parameters: # locale - Name of the current locale # # Results: # Returns a two-element list comprising the regexp and the dictionary. # # Side effects: # Caches the result. # #---------------------------------------------------------------------- proc ::tcl::clock::LocaleNumeralMatcher {l} { variable LocaleNumeralCache if { ![dict exists $LocaleNumeralCache $l] } { set d {} set i 0 set sep \( foreach n [mc LOCALE_NUMERALS] { dict set d $n $i regsub -all {[^[:alnum:]]} $n \\\\& subex append re $sep $subex set sep | incr i } append re \) dict set LocaleNumeralCache $l [list $re $d] } return [dict get $LocaleNumeralCache $l] } #---------------------------------------------------------------------- # # UniquePrefixRegexp -- # # Composes a regexp that performs unique-prefix matching. The RE # matches one of a supplied set of strings, or any unique prefix # thereof. # # Parameters: # data - List of alternating match-strings and values. # Match-strings with distinct values are considered # distinct. # # Results: # Returns a two-element list. The first is a regexp that matches any # unique prefix of any of the strings. The second is a dictionary whose # keys are match values from the regexp and whose values are the # corresponding values from 'data'. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::UniquePrefixRegexp { data } { # The 'successors' dictionary will contain, for each string that is a # prefix of any key, all characters that may follow that prefix. The # 'prefixMapping' dictionary will have keys that are prefixes of keys and # values that correspond to the keys. set prefixMapping [dict create] set successors [dict create {} {}] # Walk the key-value pairs foreach { key value } $data { # Construct all prefixes of the key; set prefix {} foreach char [split $key {}] { set oldPrefix $prefix dict set successors $oldPrefix $char {} append prefix $char # Put the prefixes in the 'prefixMapping' and 'successors' # dictionaries dict lappend prefixMapping $prefix $value if { ![dict exists $successors $prefix] } { dict set successors $prefix {} } } } # Identify those prefixes that designate unique values, and those that are # the full keys set uniquePrefixMapping {} dict for { key valueList } $prefixMapping { if { [llength $valueList] == 1 } { dict set uniquePrefixMapping $key [lindex $valueList 0] } } foreach { key value } $data { dict set uniquePrefixMapping $key $value } # Construct the re. return [list \ [MakeUniquePrefixRegexp $successors $uniquePrefixMapping {}] \ $uniquePrefixMapping] } #---------------------------------------------------------------------- # # MakeUniquePrefixRegexp -- # # Service procedure for 'UniquePrefixRegexp' that constructs a regular # expresison that matches the unique prefixes. # # Parameters: # successors - Dictionary whose keys are all prefixes # of keys passed to 'UniquePrefixRegexp' and whose # values are dictionaries whose keys are the characters # that may follow those prefixes. # uniquePrefixMapping - Dictionary whose keys are the unique # prefixes and whose values are not examined. # prefixString - Current prefix being processed. # # Results: # Returns a constructed regular expression that matches the set of # unique prefixes beginning with the 'prefixString'. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::MakeUniquePrefixRegexp { successors uniquePrefixMapping prefixString } { # Get the characters that may follow the current prefix string set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]] if { [llength $schars] == 0 } { return {} } # If there is more than one successor character, or if the current prefix # is a unique prefix, surround the generated re with non-capturing # parentheses. set re {} if { [dict exists $uniquePrefixMapping $prefixString] || [llength $schars] > 1 } then { append re "(?:" } # Generate a regexp that matches the successors. set sep "" foreach { c } $schars { set nextPrefix $prefixString$c regsub -all {[^[:alnum:]]} $c \\\\& rechar append re $sep $rechar \ [MakeUniquePrefixRegexp \ $successors $uniquePrefixMapping $nextPrefix] set sep | } # If the current prefix is a unique prefix, make all following text # optional. Otherwise, if there is more than one successor character, # close the non-capturing parentheses. if { [dict exists $uniquePrefixMapping $prefixString] } { append re ")?" } elseif { [llength $schars] > 1 } { append re ")" } return $re } #---------------------------------------------------------------------- # # MakeParseCodeFromFields -- # # Composes Tcl code to extract the Julian Day Number from a dictionary # containing date fields. # # Parameters: # dateFields -- Dictionary whose keys are fields of the date, # and whose values are the rightmost positions # at which those fields appear. # parseActions -- List of triples: field set, priority, and # code to emit. Smaller priorities are better, and # the list must be in ascending order by priority # # Results: # Returns a burst of code that extracts the day number from the given # date. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } { set currPrio 999 set currFieldPos [list] set currCodeBurst { error "in ::tcl::clock::MakeParseCodeFromFields: can't happen" } foreach { fieldSet prio parseAction } $parseActions { # If we've found an answer that's better than any that follow, quit # now. if { $prio > $currPrio } { break } # Accumulate the field positions that are used in the current field # grouping. set fieldPos [list] set ok true foreach field $fieldSet { if { ! [dict exists $dateFields $field] } { set ok 0 break } lappend fieldPos [dict get $dateFields $field] } # Quit if we don't have a complete set of fields if { !$ok } { continue } # Determine whether the current answer is better than the last. set fPos [lsort -integer -decreasing $fieldPos] if { $prio == $currPrio } { foreach currPos $currFieldPos newPos $fPos { if { ![string is integer $newPos] || ![string is integer $currPos] || $newPos > $currPos } then { break } if { $newPos < $currPos } { set ok 0 break } } } if { !$ok } { continue } # Remember the best possibility for extracting date information set currPrio $prio set currFieldPos $fPos set currCodeBurst $parseAction } return $currCodeBurst } #---------------------------------------------------------------------- # # EnterLocale -- # # Switch [mclocale] to a given locale if necessary # # Parameters: # locale -- Desired locale # # Results: # Returns the locale that was previously current. # # Side effects: # Does [mclocale]. If necessary, loads the designated locale's files. # #---------------------------------------------------------------------- proc ::tcl::clock::EnterLocale { locale } { if { $locale eq {system} } { if { $::tcl_platform(platform) ne {windows} } { # On a non-windows platform, the 'system' locale is the same as # the 'current' locale set locale current } else { # On a windows platform, the 'system' locale is adapted from the # 'current' locale by applying the date and time formats from the # Control Panel. First, load the 'current' locale if it's not yet # loaded mcpackagelocale set [mclocale] # Make a new locale string for the system locale, and get the # Control Panel information set locale [mclocale]_windows if { ! [mcpackagelocale present $locale] } { LoadWindowsDateTimeFormats $locale } } } if { $locale eq {current}} { set locale [mclocale] } # Eventually load the locale mcpackagelocale set $locale } #---------------------------------------------------------------------- # # LoadWindowsDateTimeFormats -- # # Load the date/time formats from the Control Panel in Windows and # convert them so that they're usable by Tcl. # # Parameters: # locale - Name of the locale in whose message catalog # the converted formats are to be stored. # # Results: # None. # # Side effects: # Updates the given message catalog with the locale strings. # # Presumes that on entry, [mclocale] is set to the current locale, so that # default strings can be obtained if the Registry query fails. # #---------------------------------------------------------------------- proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { # Bail out if we can't find the Registry variable NoRegistry if { [info exists NoRegistry] } return if { ![catch { registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ sShortDate } string] } { set quote {} set datefmt {} foreach { unquoted quoted } [split $string '] { append datefmt $quote [string map { dddd %A ddd %a dd %d d %e MMMM %B MMM %b MM %m M %N yyyy %Y yy %y y %y gg {} } $unquoted] if { $quoted eq {} } { set quote ' } else { set quote $quoted } } ::msgcat::mcset $locale DATE_FORMAT $datefmt } if { ![catch { registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ sLongDate } string] } { set quote {} set ldatefmt {} foreach { unquoted quoted } [split $string '] { append ldatefmt $quote [string map { dddd %A ddd %a dd %d d %e MMMM %B MMM %b MM %m M %N yyyy %Y yy %y y %y gg {} } $unquoted] if { $quoted eq {} } { set quote ' } else { set quote $quoted } } ::msgcat::mcset $locale LOCALE_DATE_FORMAT $ldatefmt } if { ![catch { registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ sTimeFormat } string] } { set quote {} set timefmt {} foreach { unquoted quoted } [split $string '] { append timefmt $quote [string map { HH %H H %k hh %I h %l mm %M m %M ss %S s %S tt %p t %p } $unquoted] if { $quoted eq {} } { set quote ' } else { set quote $quoted } } ::msgcat::mcset $locale TIME_FORMAT $timefmt } catch { ::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt" } catch { ::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt" } return } #---------------------------------------------------------------------- # # LocalizeFormat -- # # Map away locale-dependent format groups in a clock format. # # Parameters: # locale -- Current [mclocale] locale, supplied to avoid # an extra call # format -- Format supplied to [clock scan] or [clock format] # # Results: # Returns the string with locale-dependent composite format groups # substituted out. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::LocalizeFormat { locale format } { # message catalog key to cache this format set key FORMAT_$format if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } { return [mc $key] } # Handle locale-dependent format groups by mapping them out of the format # string. Note that the order of the [string map] operations is # significant because later formats can refer to later ones; for example # %c can refer to %X, which in turn can refer to %T. set list { %% %% %D %m/%d/%Y %+ {%a %b %e %H:%M:%S %Z %Y} } lappend list %EY [string map $list [mc LOCALE_YEAR_FORMAT]] lappend list %T [string map $list [mc TIME_FORMAT_24_SECS]] lappend list %R [string map $list [mc TIME_FORMAT_24]] lappend list %r [string map $list [mc TIME_FORMAT_12]] lappend list %X [string map $list [mc TIME_FORMAT]] lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]] lappend list %x [string map $list [mc DATE_FORMAT]] lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]] lappend list %c [string map $list [mc DATE_TIME_FORMAT]] lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]] set format [string map $list $format] ::msgcat::mcset $locale $key $format return $format } #---------------------------------------------------------------------- # # FormatNumericTimeZone -- # # Formats a time zone as +hhmmss # # Parameters: # z - Time zone in seconds east of Greenwich # # Results: # Returns the time zone formatted in a numeric form # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::FormatNumericTimeZone { z } { if { $z < 0 } { set z [expr { - $z }] set retval - } else { set retval + } append retval [::format %02d [expr { $z / 3600 }]] set z [expr { $z % 3600 }] append retval [::format %02d [expr { $z / 60 }]] set z [expr { $z % 60 }] if { $z != 0 } { append retval [::format %02d $z] } return $retval } #---------------------------------------------------------------------- # # FormatStarDate -- # # Formats a date as a StarDate. # # Parameters: # date - Dictionary containing 'year', 'dayOfYear', and # 'localSeconds' fields. # # Results: # Returns the given date formatted as a StarDate. # # Side effects: # None. # # Jeff Hobbs put this in to support an atrocious pun about Tcl being # "Enterprise ready." Now we're stuck with it. # #---------------------------------------------------------------------- proc ::tcl::clock::FormatStarDate { date } { variable Roddenberry # Get day of year, zero based set doy [expr { [dict get $date dayOfYear] - 1 }] # Determine whether the year is a leap year set lp [IsGregorianLeapYear $date] # Convert day of year to a fractional year if { $lp } { set fractYear [expr { 1000 * $doy / 366 }] } else { set fractYear [expr { 1000 * $doy / 365 }] } # Put together the StarDate return [::format "Stardate %02d%03d.%1d" \ [expr { [dict get $date year] - $Roddenberry }] \ $fractYear \ [expr { [dict get $date localSeconds] % 86400 / ( 86400 / 10 ) }]] } #---------------------------------------------------------------------- # # ParseStarDate -- # # Parses a StarDate # # Parameters: # year - Year from the Roddenberry epoch # fractYear - Fraction of a year specifying the day of year. # fractDay - Fraction of a day # # Results: # Returns a count of seconds from the Posix epoch. # # Side effects: # None. # # Jeff Hobbs put this in to support an atrocious pun about Tcl being # "Enterprise ready." Now we're stuck with it. # #---------------------------------------------------------------------- proc ::tcl::clock::ParseStarDate { year fractYear fractDay } { variable Roddenberry # Build a tentative date from year and fraction. set date [dict create \ gregorian 1 \ era CE \ year [expr { $year + $Roddenberry }] \ dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]] set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]] # Determine whether the given year is a leap year set lp [IsGregorianLeapYear $date] # Reconvert the fractional year according to whether the given year is a # leap year if { $lp } { dict set date dayOfYear \ [expr { $fractYear * 366 / 1000 + 1 }] } else { dict set date dayOfYear \ [expr { $fractYear * 365 / 1000 + 1 }] } dict unset date julianDay dict unset date gregorian set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]] return [expr { 86400 * [dict get $date julianDay] - 210866803200 + ( 86400 / 10 ) * $fractDay }] } #---------------------------------------------------------------------- # # ScanWide -- # # Scans a wide integer from an input # # Parameters: # str - String containing a decimal wide integer # # Results: # Returns the string as a pure wide integer. Throws an error if the # string is misformatted or out of range. # #---------------------------------------------------------------------- proc ::tcl::clock::ScanWide { str } { set count [::scan $str {%ld %c} result junk] if { $count != 1 } { return -code error -errorcode [list CLOCK notAnInteger $str] \ "\"$str\" is not an integer" } if { [incr result 0] != $str } { return -code error -errorcode [list CLOCK integervalueTooLarge] \ "integer value too large to represent" } return $result } #---------------------------------------------------------------------- # # InterpretTwoDigitYear -- # # Given a date that contains only the year of the century, determines # the target value of a two-digit year. # # Parameters: # date - Dictionary containing fields of the date. # baseTime - Base time relative to which the date is expressed. # twoDigitField - Name of the field that stores the two-digit year. # Default is 'yearOfCentury' # fourDigitField - Name of the field that will receive the four-digit # year. Default is 'year' # # Results: # Returns the dictionary augmented with the four-digit year, stored in # the given key. # # Side effects: # None. # # The current rule for interpreting a two-digit year is that the year shall be # between 1937 and 2037, thus staying within the range of a 32-bit signed # value for time. This rule may change to a sliding window in future # versions, so the 'baseTime' parameter (which is currently ignored) is # provided in the procedure signature. # #---------------------------------------------------------------------- proc ::tcl::clock::InterpretTwoDigitYear { date baseTime { twoDigitField yearOfCentury } { fourDigitField year } } { set yr [dict get $date $twoDigitField] if { $yr <= 37 } { dict set date $fourDigitField [expr { $yr + 2000 }] } else { dict set date $fourDigitField [expr { $yr + 1900 }] } return $date } #---------------------------------------------------------------------- # # AssignBaseYear -- # # Places the number of the current year into a dictionary. # # Parameters: # date - Dictionary value to update # baseTime - Base time from which to extract the year, expressed # in seconds from the Posix epoch # timezone - the time zone in which the date is being scanned # changeover - the Julian Day on which the Gregorian calendar # was adopted in the target locale. # # Results: # Returns the dictionary with the current year assigned. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } { variable TZData # Find the Julian Day Number corresponding to the base time, and # find the Gregorian year corresponding to that Julian Day. set date2 [GetDateFields $baseTime $TZData($timezone) $changeover] # Store the converted year dict set date era [dict get $date2 era] dict set date year [dict get $date2 year] return $date } #---------------------------------------------------------------------- # # AssignBaseIso8601Year -- # # Determines the base year in the ISO8601 fiscal calendar. # # Parameters: # date - Dictionary containing the fields of the date that # is to be augmented with the base year. # baseTime - Base time expressed in seconds from the Posix epoch. # timeZone - Target time zone # changeover - Julian Day of adoption of the Gregorian calendar in # the target locale. # # Results: # Returns the given date with "iso8601Year" set to the # base year. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} { variable TZData # Find the Julian Day Number corresponding to the base time set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover] # Calculate the ISO8601 date and transfer the year dict set date era CE dict set date iso8601Year [dict get $date2 iso8601Year] return $date } #---------------------------------------------------------------------- # # AssignBaseMonth -- # # Places the number of the current year and month into a # dictionary. # # Parameters: # date - Dictionary value to update # baseTime - Time from which the year and month are to be # obtained, expressed in seconds from the Posix epoch. # timezone - Name of the desired time zone # changeover - Julian Day on which the Gregorian calendar was adopted. # # Results: # Returns the dictionary with the base year and month assigned. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} { variable TZData # Find the year and month corresponding to the base time set date2 [GetDateFields $baseTime $TZData($timezone) $changeover] dict set date era [dict get $date2 era] dict set date year [dict get $date2 year] dict set date month [dict get $date2 month] return $date } #---------------------------------------------------------------------- # # AssignBaseWeek -- # # Determines the base year and week in the ISO8601 fiscal calendar. # # Parameters: # date - Dictionary containing the fields of the date that # is to be augmented with the base year and week. # baseTime - Base time expressed in seconds from the Posix epoch. # changeover - Julian Day on which the Gregorian calendar was adopted # in the target locale. # # Results: # Returns the given date with "iso8601Year" set to the # base year and "iso8601Week" to the week number. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} { variable TZData # Find the Julian Day Number corresponding to the base time set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover] # Calculate the ISO8601 date and transfer the year dict set date era CE dict set date iso8601Year [dict get $date2 iso8601Year] dict set date iso8601Week [dict get $date2 iso8601Week] return $date } #---------------------------------------------------------------------- # # AssignBaseJulianDay -- # # Determines the base day for a time-of-day conversion. # # Parameters: # date - Dictionary that is to get the base day # baseTime - Base time expressed in seconds from the Posix epoch # changeover - Julian day on which the Gregorian calendar was # adpoted in the target locale. # # Results: # Returns the given dictionary augmented with a 'julianDay' field # that contains the base day. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } { variable TZData # Find the Julian Day Number corresponding to the base time set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover] dict set date julianDay [dict get $date2 julianDay] return $date } #---------------------------------------------------------------------- # # InterpretHMSP -- # # Interprets a time in the form "hh:mm:ss am". # # Parameters: # date -- Dictionary containing "hourAMPM", "minute", "second" # and "amPmIndicator" fields. # # Results: # Returns the number of seconds from local midnight. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::InterpretHMSP { date } { set hr [dict get $date hourAMPM] if { $hr == 12 } { set hr 0 } if { [dict get $date amPmIndicator] } { incr hr 12 } dict set date hour $hr return [InterpretHMS $date[set date {}]] } #---------------------------------------------------------------------- # # InterpretHMS -- # # Interprets a 24-hour time "hh:mm:ss" # # Parameters: # date -- Dictionary containing the "hour", "minute" and "second" # fields. # # Results: # Returns the given dictionary augmented with a "secondOfDay" # field containing the number of seconds from local midnight. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::InterpretHMS { date } { return [expr { ( [dict get $date hour] * 60 + [dict get $date minute] ) * 60 + [dict get $date second] }] } #---------------------------------------------------------------------- # # GetSystemTimeZone -- # # Determines the system time zone, which is the default for the # 'clock' command if no other zone is supplied. # # Parameters: # None. # # Results: # Returns the system time zone. # # Side effects: # Stores the system time zone in the 'CachedSystemTimeZone' # variable, since determining it may be an expensive process. # #---------------------------------------------------------------------- proc ::tcl::clock::GetSystemTimeZone {} { variable CachedSystemTimeZone variable TimeZoneBad if {[set result [getenv TCL_TZ]] ne {}} { set timezone $result } elseif {[set result [getenv TZ]] ne {}} { set timezone $result } else { # Cache the time zone only if it was detected by one of the # expensive methods. if { [info exists CachedSystemTimeZone] } { set timezone $CachedSystemTimeZone } elseif { $::tcl_platform(platform) eq {windows} } { set timezone [GuessWindowsTimeZone] } elseif { [file exists /etc/localtime] && ![catch {ReadZoneinfoFile \ Tcl/Localtime /etc/localtime}] } { set timezone :Tcl/Localtime } else { set timezone :localtime } set CachedSystemTimeZone $timezone } if { ![dict exists $TimeZoneBad $timezone] } { dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}] } if { [dict get $TimeZoneBad $timezone] } { return :localtime } else { return $timezone } } #---------------------------------------------------------------------- # # ConvertLegacyTimeZone -- # # Given an alphanumeric time zone identifier and the system time zone, # convert the alphanumeric identifier to an unambiguous time zone. # # Parameters: # tzname - Name of the time zone to convert # # Results: # Returns a time zone name corresponding to tzname, but in an # unambiguous form, generally +hhmm. # # This procedure is implemented primarily to allow the parsing of RFC822 # date/time strings. Processing a time zone name on input is not recommended # practice, because there is considerable room for ambiguity; for instance, is # BST Brazilian Standard Time, or British Summer Time? # #---------------------------------------------------------------------- proc ::tcl::clock::ConvertLegacyTimeZone { tzname } { variable LegacyTimeZone set tzname [string tolower $tzname] if { ![dict exists $LegacyTimeZone $tzname] } { return -code error -errorcode [list CLOCK badTZName $tzname] \ "time zone \"$tzname\" not found" } return [dict get $LegacyTimeZone $tzname] } #---------------------------------------------------------------------- # # SetupTimeZone -- # # Given the name or specification of a time zone, sets up its in-memory # data. # # Parameters: # tzname - Name of a time zone # # Results: # Unless the time zone is ':localtime', sets the TZData array to contain # the lookup table for local<->UTC conversion. Returns an error if the # time zone cannot be parsed. # #---------------------------------------------------------------------- proc ::tcl::clock::SetupTimeZone { timezone } { variable TZData if {! [info exists TZData($timezone)] } { variable MINWIDE if { $timezone eq {:localtime} } { # Nothing to do, we'll convert using the localtime function } elseif { [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \ -> s hh mm ss] } then { # Make a fixed offset ::scan $hh %d hh if { $mm eq {} } { set mm 0 } else { ::scan $mm %d mm } if { $ss eq {} } { set ss 0 } else { ::scan $ss %d ss } set offset [expr { ( $hh * 60 + $mm ) * 60 + $ss }] if { $s eq {-} } { set offset [expr { - $offset }] } set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]] } elseif { [string index $timezone 0] eq {:} } { # Convert using a time zone file if { [catch { LoadTimeZoneFile [string range $timezone 1 end] }] && [catch { LoadZoneinfoFile [string range $timezone 1 end] }] } then { return -code error \ -errorcode [list CLOCK badTimeZone $timezone] \ "time zone \"$timezone\" not found" } } elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } { # This looks like a POSIX time zone - try to process it if { [catch {ProcessPosixTimeZone $tzfields} data opts] } { if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } { dict unset opts -errorinfo } return -options $opts $data } else { set TZData($timezone) $data } } else { # We couldn't parse this as a POSIX time zone. Try again with a # time zone file - this time without a colon if { [catch { LoadTimeZoneFile $timezone }] && [catch { LoadZoneinfoFile $timezone } - opts] } { dict unset opts -errorinfo return -options $opts "time zone $timezone not found" } set TZData($timezone) $TZData(:$timezone) } } return } #---------------------------------------------------------------------- # # GuessWindowsTimeZone -- # # Determines the system time zone on windows. # # Parameters: # None. # # Results: # Returns a time zone specifier that corresponds to the system time zone # information found in the Registry. # # Bugs: # Fixed dates for DST change are unimplemented at present, because no # time zone information supplied with Windows actually uses them! # # On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is specified, # GuessWindowsTimeZone looks in the Registry for the system time zone # information. It then attempts to find an entry in WinZoneInfo for a time # zone that uses the same rules. If it finds one, it returns it; otherwise, # it constructs a Posix-style time zone string and returns that. # #---------------------------------------------------------------------- proc ::tcl::clock::GuessWindowsTimeZone {} { variable WinZoneInfo variable NoRegistry variable TimeZoneBad if { [info exists NoRegistry] } { return :localtime } # Dredge time zone information out of the registry if { [catch { set rpath HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation set data [list \ [expr { -60 * [registry get $rpath Bias] }] \ [expr { -60 * [registry get $rpath StandardBias] }] \ [expr { -60 \ * [registry get $rpath DaylightBias] }]] set stdtzi [registry get $rpath StandardStart] foreach ind {0 2 14 4 6 8 10 12} { binary scan $stdtzi @${ind}s val lappend data $val } set daytzi [registry get $rpath DaylightStart] foreach ind {0 2 14 4 6 8 10 12} { binary scan $daytzi @${ind}s val lappend data $val } }] } { # Missing values in the Registry - bail out return :localtime } # Make up a Posix time zone specifier if we can't find one. Check here # that the tzdata file exists, in case we're running in an environment # (e.g. starpack) where tzdata is incomplete. (Bug 1237907) if { [dict exists $WinZoneInfo $data] } { set tzname [dict get $WinZoneInfo $data] if { ! [dict exists $TimeZoneBad $tzname] } { dict set TimeZoneBad $tzname [catch {SetupTimeZone $tzname}] } } else { set tzname {} } if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } { lassign $data \ bias stdBias dstBias \ stdYear stdMonth stdDayOfWeek stdDayOfMonth \ stdHour stdMinute stdSecond stdMillisec \ dstYear dstMonth dstDayOfWeek dstDayOfMonth \ dstHour dstMinute dstSecond dstMillisec set stdDelta [expr { $bias + $stdBias }] set dstDelta [expr { $bias + $dstBias }] if { $stdDelta <= 0 } { set stdSignum + set stdDelta [expr { - $stdDelta }] set dispStdSignum - } else { set stdSignum - set dispStdSignum + } set hh [::format %02d [expr { $stdDelta / 3600 }]] set mm [::format %02d [expr { ($stdDelta / 60 ) % 60 }]] set ss [::format %02d [expr { $stdDelta % 60 }]] set tzname {} append tzname < $dispStdSignum $hh $mm > $stdSignum $hh : $mm : $ss if { $stdMonth >= 0 } { if { $dstDelta <= 0 } { set dstSignum + set dstDelta [expr { - $dstDelta }] set dispDstSignum - } else { set dstSignum - set dispDstSignum + } set hh [::format %02d [expr { $dstDelta / 3600 }]] set mm [::format %02d [expr { ($dstDelta / 60 ) % 60 }]] set ss [::format %02d [expr { $dstDelta % 60 }]] append tzname < $dispDstSignum $hh $mm > $dstSignum $hh : $mm : $ss if { $dstYear == 0 } { append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek } else { # I have not been able to find any locale on which Windows # converts time zone on a fixed day of the year, hence don't # know how to interpret the fields. If someone can inform me, # I'd be glad to code it up. For right now, we bail out in # such a case. return :localtime } append tzname / [::format %02d $dstHour] \ : [::format %02d $dstMinute] \ : [::format %02d $dstSecond] if { $stdYear == 0 } { append tzname ,M $stdMonth . $stdDayOfMonth . $stdDayOfWeek } else { # I have not been able to find any locale on which Windows # converts time zone on a fixed day of the year, hence don't # know how to interpret the fields. If someone can inform me, # I'd be glad to code it up. For right now, we bail out in # such a case. return :localtime } append tzname / [::format %02d $stdHour] \ : [::format %02d $stdMinute] \ : [::format %02d $stdSecond] } dict set WinZoneInfo $data $tzname } return [dict get $WinZoneInfo $data] } #---------------------------------------------------------------------- # # LoadTimeZoneFile -- # # Load the data file that specifies the conversion between a # given time zone and Greenwich. # # Parameters: # fileName -- Name of the file to load # # Results: # None. # # Side effects: # TZData(:fileName) contains the time zone data # #---------------------------------------------------------------------- proc ::tcl::clock::LoadTimeZoneFile { fileName } { variable DataDir variable TZData if { [info exists TZData($fileName)] } { return } # Since an unsafe interp uses the [clock] command in the parent, this code # is security sensitive. Make sure that the path name cannot escape the # given directory. if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } { return -code error \ -errorcode [list CLOCK badTimeZone $:fileName] \ "time zone \":$fileName\" not valid" } try { source -encoding utf-8 [file join $DataDir $fileName] } on error {} { return -code error \ -errorcode [list CLOCK badTimeZone :$fileName] \ "time zone \":$fileName\" not found" } return } #---------------------------------------------------------------------- # # LoadZoneinfoFile -- # # Loads a binary time zone information file in Olson format. # # Parameters: # fileName - Relative path name of the file to load. # # Results: # Returns an empty result normally; returns an error if no Olson file # was found or the file was malformed in some way. # # Side effects: # TZData(:fileName) contains the time zone data # #---------------------------------------------------------------------- proc ::tcl::clock::LoadZoneinfoFile { fileName } { variable ZoneinfoPaths # Since an unsafe interp uses the [clock] command in the parent, this code # is security sensitive. Make sure that the path name cannot escape the # given directory. if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } { return -code error \ -errorcode [list CLOCK badTimeZone $:fileName] \ "time zone \":$fileName\" not valid" } foreach d $ZoneinfoPaths { set fname [file join $d $fileName] if { [file readable $fname] && [file isfile $fname] } { break } unset fname } ReadZoneinfoFile $fileName $fname } #---------------------------------------------------------------------- # # ReadZoneinfoFile -- # # Loads a binary time zone information file in Olson format. # # Parameters: # fileName - Name of the time zone (relative path name of the # file). # fname - Absolute path name of the file. # # Results: # Returns an empty result normally; returns an error if no Olson file # was found or the file was malformed in some way. # # Side effects: # TZData(:fileName) contains the time zone data # #---------------------------------------------------------------------- proc ::tcl::clock::ReadZoneinfoFile {fileName fname} { variable MINWIDE variable TZData if { ![file exists $fname] } { return -code error "$fileName not found" } if { [file size $fname] > 262144 } { return -code error "$fileName too big" } # Suck in all the data from the file set f [open $fname r] fconfigure $f -translation binary set d [read $f] close $f # The file begins with a magic number, sixteen reserved bytes, and then # six 4-byte integers giving counts of fields in the file. binary scan $d a4a1x15IIIIII \ magic version nIsGMT nIsStd nLeap nTime nType nChar set seek 44 set ilen 4 set iformat I if { $magic != {TZif} } { return -code error "$fileName not a time zone information file" } if { $nType > 255 } { return -code error "$fileName contains too many time types" } # Accept only Posix-style zoneinfo. Sorry, 'leaps' bigots. if { $nLeap != 0 } { return -code error "$fileName contains leap seconds" } # In a version 2 file, we use the second part of the file, which contains # 64-bit transition times. if {$version eq "2"} { set seek [expr { 44 + 5 * $nTime + 6 * $nType + 4 * $nLeap + $nIsStd + $nIsGMT + $nChar }] binary scan $d @${seek}a4a1x15IIIIII \ magic version nIsGMT nIsStd nLeap nTime nType nChar if {$magic ne {TZif}} { return -code error "seek address $seek miscomputed, magic = $magic" } set iformat W set ilen 8 incr seek 44 } # Next come ${nTime} transition times, followed by ${nTime} time type # codes. The type codes are unsigned 1-byte quantities. We insert an # arbitrary start time in front of the transitions. binary scan $d @${seek}${iformat}${nTime}c${nTime} times tempCodes incr seek [expr { ($ilen + 1) * $nTime }] set times [linsert $times 0 $MINWIDE] set codes {} foreach c $tempCodes { lappend codes [expr { $c & 0xFF }] } set codes [linsert $codes 0 0] # Next come ${nType} time type descriptions, each of which has an offset # (seconds east of GMT), a DST indicator, and an index into the # abbreviation text. for { set i 0 } { $i < $nType } { incr i } { binary scan $d @${seek}Icc gmtOff isDst abbrInd lappend types [list $gmtOff $isDst $abbrInd] incr seek 6 } # Next come $nChar characters of time zone name abbreviations, which are # null-terminated. # We build them up into a dictionary indexed by character index, because # that's what's in the indices above. binary scan $d @${seek}a${nChar} abbrs incr seek ${nChar} set abbrList [split $abbrs \0] set i 0 set abbrevs {} foreach a $abbrList { for {set j 0} {$j <= [string length $a]} {incr j} { dict set abbrevs $i [string range $a $j end] incr i } } # Package up a list of tuples, each of which contains transition time, # seconds east of Greenwich, DST flag and time zone abbreviation. set r {} set lastTime $MINWIDE foreach t $times c $codes { if { $t < $lastTime } { return -code error "$fileName has times out of order" } set lastTime $t lassign [lindex $types $c] gmtoff isDst abbrInd set abbrev [dict get $abbrevs $abbrInd] lappend r [list $t $gmtoff $isDst $abbrev] } # In a version 2 file, there is also a POSIX-style time zone description # at the very end of the file. To get to it, skip over nLeap leap second # values (8 bytes each), # nIsStd standard/DST indicators and nIsGMT UTC/local indicators. if {$version eq {2}} { set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}] set last [string first \n $d $seek] set posix [string range $d $seek [expr {$last-1}]] if {[llength $posix] > 0} { set posixFields [ParsePosixTimeZone $posix] foreach tuple [ProcessPosixTimeZone $posixFields] { lassign $tuple t gmtoff isDst abbrev if {$t > $lastTime} { lappend r $tuple } } } } set TZData(:$fileName) $r return } #---------------------------------------------------------------------- # # ParsePosixTimeZone -- # # Parses the TZ environment variable in Posix form # # Parameters: # tz Time zone specifier to be interpreted # # Results: # Returns a dictionary whose values contain the various pieces of the # time zone specification. # # Side effects: # None. # # Errors: # Throws an error if the syntax of the time zone is incorrect. # # The following keys are present in the dictionary: # stdName - Name of the time zone when Daylight Saving Time # is not in effect. # stdSignum - Sign (+, -, or empty) of the offset from Greenwich # to the given (non-DST) time zone. + and the empty # string denote zones west of Greenwich, - denotes east # of Greenwich; this is contrary to the ISO convention # but follows Posix. # stdHours - Hours part of the offset from Greenwich to the given # (non-DST) time zone. # stdMinutes - Minutes part of the offset from Greenwich to the # given (non-DST) time zone. Empty denotes zero. # stdSeconds - Seconds part of the offset from Greenwich to the # given (non-DST) time zone. Empty denotes zero. # dstName - Name of the time zone when DST is in effect, or the # empty string if the time zone does not observe Daylight # Saving Time. # dstSignum, dstHours, dstMinutes, dstSeconds - # Fields corresponding to stdSignum, stdHours, stdMinutes, # stdSeconds for the Daylight Saving Time version of the # time zone. If dstHours is empty, it is presumed to be 1. # startDayOfYear - The ordinal number of the day of the year on which # Daylight Saving Time begins. If this field is # empty, then DST begins on a given month-week-day, # as below. # startJ - The letter J, or an empty string. If a J is present in # this field, then startDayOfYear does not count February 29 # even in leap years. # startMonth - The number of the month in which Daylight Saving Time # begins, supplied if startDayOfYear is empty. If both # startDayOfYear and startMonth are empty, then US rules # are presumed. # startWeekOfMonth - The number of the week in the month in which # Daylight Saving Time begins, in the range 1-5. # 5 denotes the last week of the month even in a # 4-week month. # startDayOfWeek - The number of the day of the week (Sunday=0, # Saturday=6) on which Daylight Saving Time begins. # startHours - The hours part of the time of day at which Daylight # Saving Time begins. An empty string is presumed to be 2. # startMinutes - The minutes part of the time of day at which DST begins. # An empty string is presumed zero. # startSeconds - The seconds part of the time of day at which DST begins. # An empty string is presumed zero. # endDayOfYear, endJ, endMonth, endWeekOfMonth, endDayOfWeek, # endHours, endMinutes, endSeconds - # Specify the end of DST in the same way that the start* fields # specify the beginning of DST. # # This procedure serves only to break the time specifier into fields. No # attempt is made to canonicalize the fields or supply default values. # #---------------------------------------------------------------------- proc ::tcl::clock::ParsePosixTimeZone { tz } { if {[regexp -expanded -nocase -- { ^ # 1 - Standard time zone name ([[:alpha:]]+ | <[-+[:alnum:]]+>) # 2 - Standard time zone offset, signum ([-+]?) # 3 - Standard time zone offset, hours ([[:digit:]]{1,2}) (?: # 4 - Standard time zone offset, minutes : ([[:digit:]]{1,2}) (?: # 5 - Standard time zone offset, seconds : ([[:digit:]]{1,2} ) )? )? (?: # 6 - DST time zone name ([[:alpha:]]+ | <[-+[:alnum:]]+>) (?: (?: # 7 - DST time zone offset, signum ([-+]?) # 8 - DST time zone offset, hours ([[:digit:]]{1,2}) (?: # 9 - DST time zone offset, minutes : ([[:digit:]]{1,2}) (?: # 10 - DST time zone offset, seconds : ([[:digit:]]{1,2}) )? )? )? (?: , (?: # 11 - Optional J in n and Jn form 12 - Day of year ( J ? ) ( [[:digit:]]+ ) | M # 13 - Month number 14 - Week of month 15 - Day of week ( [[:digit:]] + ) [.] ( [[:digit:]] + ) [.] ( [[:digit:]] + ) ) (?: # 16 - Start time of DST - hours / ( [[:digit:]]{1,2} ) (?: # 17 - Start time of DST - minutes : ( [[:digit:]]{1,2} ) (?: # 18 - Start time of DST - seconds : ( [[:digit:]]{1,2} ) )? )? )? , (?: # 19 - Optional J in n and Jn form 20 - Day of year ( J ? ) ( [[:digit:]]+ ) | M # 21 - Month number 22 - Week of month 23 - Day of week ( [[:digit:]] + ) [.] ( [[:digit:]] + ) [.] ( [[:digit:]] + ) ) (?: # 24 - End time of DST - hours / ( [[:digit:]]{1,2} ) (?: # 25 - End time of DST - minutes : ( [[:digit:]]{1,2} ) (?: # 26 - End time of DST - seconds : ( [[:digit:]]{1,2} ) )? )? )? )? )? )? $ } $tz -> x(stdName) x(stdSignum) x(stdHours) x(stdMinutes) x(stdSeconds) \ x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \ x(startJ) x(startDayOfYear) \ x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \ x(startHours) x(startMinutes) x(startSeconds) \ x(endJ) x(endDayOfYear) \ x(endMonth) x(endWeekOfMonth) x(endDayOfWeek) \ x(endHours) x(endMinutes) x(endSeconds)] } { # it's a good timezone return [array get x] } return -code error\ -errorcode [list CLOCK badTimeZone $tz] \ "unable to parse time zone specification \"$tz\"" } #---------------------------------------------------------------------- # # ProcessPosixTimeZone -- # # Handle a Posix time zone after it's been broken out into fields. # # Parameters: # z - Dictionary returned from 'ParsePosixTimeZone' # # Results: # Returns time zone information for the 'TZData' array. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::ProcessPosixTimeZone { z } { variable MINWIDE variable TZData # Determine the standard time zone name and seconds east of Greenwich set stdName [dict get $z stdName] if { [string index $stdName 0] eq {<} } { set stdName [string range $stdName 1 end-1] } if { [dict get $z stdSignum] eq {-} } { set stdSignum +1 } else { set stdSignum -1 } set stdHours [lindex [::scan [dict get $z stdHours] %d] 0] if { [dict get $z stdMinutes] ne {} } { set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0] } else { set stdMinutes 0 } if { [dict get $z stdSeconds] ne {} } { set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0] } else { set stdSeconds 0 } set stdOffset [expr { (($stdHours * 60 + $stdMinutes) * 60 + $stdSeconds) * $stdSignum }] set data [list [list $MINWIDE $stdOffset 0 $stdName]] # If there's no daylight zone, we're done set dstName [dict get $z dstName] if { $dstName eq {} } { return $data } if { [string index $dstName 0] eq {<} } { set dstName [string range $dstName 1 end-1] } # Determine the daylight name if { [dict get $z dstSignum] eq {-} } { set dstSignum +1 } else { set dstSignum -1 } if { [dict get $z dstHours] eq {} } { set dstOffset [expr { 3600 + $stdOffset }] } else { set dstHours [lindex [::scan [dict get $z dstHours] %d] 0] if { [dict get $z dstMinutes] ne {} } { set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0] } else { set dstMinutes 0 } if { [dict get $z dstSeconds] ne {} } { set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0] } else { set dstSeconds 0 } set dstOffset [expr { (($dstHours*60 + $dstMinutes) * 60 + $dstSeconds) * $dstSignum }] } # Fill in defaults for European or US DST rules # US start time is the second Sunday in March # EU start time is the last Sunday in March # US end time is the first Sunday in November. # EU end time is the last Sunday in October if { [dict get $z startDayOfYear] eq {} && [dict get $z startMonth] eq {} } then { if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} { # EU dict set z startWeekOfMonth 5 if {$stdHours>2} { dict set z startHours 2 } else { dict set z startHours [expr {$stdHours+1}] } } else { # US dict set z startWeekOfMonth 2 dict set z startHours 2 } dict set z startMonth 3 dict set z startDayOfWeek 0 dict set z startMinutes 0 dict set z startSeconds 0 } if { [dict get $z endDayOfYear] eq {} && [dict get $z endMonth] eq {} } then { if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} { # EU dict set z endMonth 10 dict set z endWeekOfMonth 5 if {$stdHours>2} { dict set z endHours 3 } else { dict set z endHours [expr {$stdHours+2}] } } else { # US dict set z endMonth 11 dict set z endWeekOfMonth 1 dict set z endHours 2 } dict set z endDayOfWeek 0 dict set z endMinutes 0 dict set z endSeconds 0 } # Put DST in effect in all years from 1916 to 2099. for { set y 1916 } { $y < 2100 } { incr y } { set startTime [DeterminePosixDSTTime $z start $y] incr startTime [expr { - wide($stdOffset) }] set endTime [DeterminePosixDSTTime $z end $y] incr endTime [expr { - wide($dstOffset) }] if { $startTime < $endTime } { lappend data \ [list $startTime $dstOffset 1 $dstName] \ [list $endTime $stdOffset 0 $stdName] } else { lappend data \ [list $endTime $stdOffset 0 $stdName] \ [list $startTime $dstOffset 1 $dstName] } } return $data } #---------------------------------------------------------------------- # # DeterminePosixDSTTime -- # # Determines the time that Daylight Saving Time starts or ends from a # Posix time zone specification. # # Parameters: # z - Time zone data returned from ParsePosixTimeZone. # Missing fields are expected to be filled in with # default values. # bound - The word 'start' or 'end' # y - The year for which the transition time is to be determined. # # Results: # Returns the transition time as a count of seconds from the epoch. The # time is relative to the wall clock, not UTC. # #---------------------------------------------------------------------- proc ::tcl::clock::DeterminePosixDSTTime { z bound y } { variable FEB_28 # Determine the start or end day of DST set date [dict create era CE year $y] set doy [dict get $z ${bound}DayOfYear] if { $doy ne {} } { # Time was specified as a day of the year if { [dict get $z ${bound}J] ne {} && [IsGregorianLeapYear $y] && ( $doy > $FEB_28 ) } { incr doy } dict set date dayOfYear $doy set date [GetJulianDayFromEraYearDay $date[set date {}] 2361222] } else { # Time was specified as a day of the week within a month dict set date month [dict get $z ${bound}Month] dict set date dayOfWeek [dict get $z ${bound}DayOfWeek] set dowim [dict get $z ${bound}WeekOfMonth] if { $dowim >= 5 } { set dowim -1 } dict set date dayOfWeekInMonth $dowim set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222] } set jd [dict get $date julianDay] set seconds [expr { wide($jd) * wide(86400) - wide(210866803200) }] set h [dict get $z ${bound}Hours] if { $h eq {} } { set h 2 } else { set h [lindex [::scan $h %d] 0] } set m [dict get $z ${bound}Minutes] if { $m eq {} } { set m 0 } else { set m [lindex [::scan $m %d] 0] } set s [dict get $z ${bound}Seconds] if { $s eq {} } { set s 0 } else { set s [lindex [::scan $s %d] 0] } set tod [expr { ( $h * 60 + $m ) * 60 + $s }] return [expr { $seconds + $tod }] } #---------------------------------------------------------------------- # # GetLocaleEra -- # # Given local time expressed in seconds from the Posix epoch, # determine localized era and year within the era. # # Parameters: # date - Dictionary that must contain the keys, 'localSeconds', # whose value is expressed as the appropriate local time; # and 'year', whose value is the Gregorian year. # etable - Value of the LOCALE_ERAS key in the message catalogue # for the target locale. # # Results: # Returns the dictionary, augmented with the keys, 'localeEra' and # 'localeYear'. # #---------------------------------------------------------------------- proc ::tcl::clock::GetLocaleEra { date etable } { set index [BSearch $etable [dict get $date localSeconds]] if { $index < 0} { dict set date localeEra \ [::format %02d [expr { [dict get $date year] / 100 }]] dict set date localeYear [expr { [dict get $date year] % 100 }] } else { dict set date localeEra [lindex $etable $index 1] dict set date localeYear [expr { [dict get $date year] - [lindex $etable $index 2] }] } return $date } #---------------------------------------------------------------------- # # GetJulianDayFromEraYearDay -- # # Given a year, month and day on the Gregorian calendar, determines # the Julian Day Number beginning at noon on that date. # # Parameters: # date -- A dictionary in which the 'era', 'year', and # 'dayOfYear' slots are populated. The calendar in use # is determined by the date itself relative to: # changeover -- Julian day on which the Gregorian calendar was # adopted in the current locale. # # Results: # Returns the given dictionary augmented with a 'julianDay' key whose # value is the desired Julian Day Number, and a 'gregorian' key that # specifies whether the calendar is Gregorian (1) or Julian (0). # # Side effects: # None. # # Bugs: # This code needs to be moved to the C layer. # #---------------------------------------------------------------------- proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} { # Get absolute year number from the civil year switch -exact -- [dict get $date era] { BCE { set year [expr { 1 - [dict get $date year] }] } CE { set year [dict get $date year] } } set ym1 [expr { $year - 1 }] # Try the Gregorian calendar first. dict set date gregorian 1 set jd [expr { 1721425 + [dict get $date dayOfYear] + ( 365 * $ym1 ) + ( $ym1 / 4 ) - ( $ym1 / 100 ) + ( $ym1 / 400 ) }] # If the date is before the Gregorian change, use the Julian calendar. if { $jd < $changeover } { dict set date gregorian 0 set jd [expr { 1721423 + [dict get $date dayOfYear] + ( 365 * $ym1 ) + ( $ym1 / 4 ) }] } dict set date julianDay $jd return $date } #---------------------------------------------------------------------- # # GetJulianDayFromEraYearMonthWeekDay -- # # Determines the Julian Day number corresponding to the nth given # day-of-the-week in a given month. # # Parameters: # date - Dictionary containing the keys, 'era', 'year', 'month' # 'weekOfMonth', 'dayOfWeek', and 'dayOfWeekInMonth'. # changeover - Julian Day of adoption of the Gregorian calendar # # Results: # Returns the given dictionary, augmented with a 'julianDay' key. # # Side effects: # None. # # Bugs: # This code needs to be moved to the C layer. # #---------------------------------------------------------------------- proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} { # Come up with a reference day; either the zeroeth day of the given month # (dayOfWeekInMonth >= 0) or the seventh day of the following month # (dayOfWeekInMonth < 0) set date2 $date set week [dict get $date dayOfWeekInMonth] if { $week >= 0 } { dict set date2 dayOfMonth 0 } else { dict incr date2 month dict set date2 dayOfMonth 7 } set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \ $changeover] set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \ [dict get $date2 julianDay]] dict set date julianDay [expr { $wd0 + 7 * $week }] return $date } #---------------------------------------------------------------------- # # IsGregorianLeapYear -- # # Determines whether a given date represents a leap year in the # Gregorian calendar. # # Parameters: # date -- The date to test. The fields, 'era', 'year' and 'gregorian' # must be set. # # Results: # Returns 1 if the year is a leap year, 0 otherwise. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::IsGregorianLeapYear { date } { switch -exact -- [dict get $date era] { BCE { set year [expr { 1 - [dict get $date year]}] } CE { set year [dict get $date year] } } if { $year % 4 != 0 } { return 0 } elseif { ![dict get $date gregorian] } { return 1 } elseif { $year % 400 == 0 } { return 1 } elseif { $year % 100 == 0 } { return 0 } else { return 1 } } #---------------------------------------------------------------------- # # WeekdayOnOrBefore -- # # Determine the nearest day of week (given by the 'weekday' parameter, # Sunday==0) on or before a given Julian Day. # # Parameters: # weekday -- Day of the week # j -- Julian Day number # # Results: # Returns the Julian Day Number of the desired date. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::WeekdayOnOrBefore { weekday j } { set k [expr { ( $weekday + 6 ) % 7 }] return [expr { $j - ( $j - $k ) % 7 }] } #---------------------------------------------------------------------- # # BSearch -- # # Service procedure that does binary search in several places inside the # 'clock' command. # # Parameters: # list - List of lists, sorted in ascending order by the # first elements # key - Value to search for # # Results: # Returns the index of the greatest element in $list that is less than # or equal to $key. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::BSearch { list key } { if {[llength $list] == 0} { return -1 } if { $key < [lindex $list 0 0] } { return -1 } set l 0 set u [expr { [llength $list] - 1 }] while { $l < $u } { # At this point, we know that # $k >= [lindex $list $l 0] # Either $u == [llength $list] or else $k < [lindex $list $u+1 0] # We find the midpoint of the interval {l,u} rounded UP, compare # against it, and set l or u to maintain the invariant. Note that the # interval shrinks at each step, guaranteeing convergence. set m [expr { ( $l + $u + 1 ) / 2 }] if { $key >= [lindex $list $m 0] } { set l $m } else { set u [expr { $m - 1 }] } } return $l } #---------------------------------------------------------------------- # # clock add -- # # Adds an offset to a given time. # # Syntax: # clock add clockval ?count unit?... ?-option value? # # Parameters: # clockval -- Starting time value # count -- Amount of a unit of time to add # unit -- Unit of time to add, must be one of: # years year months month weeks week # days day hours hour minutes minute # seconds second # # Options: # -gmt BOOLEAN # (Deprecated) Flag synonymous with '-timezone :GMT' # -timezone ZONE # Name of the time zone in which calculations are to be done. # -locale NAME # Name of the locale in which calculations are to be done. # Used to determine the Gregorian change date. # # Results: # Returns the given time adjusted by the given offset(s) in # order. # # Notes: # It is possible that adding a number of months or years will adjust the # day of the month as well. For instance, the time at one month after # 31 January is either 28 or 29 February, because February has fewer # than 31 days. # #---------------------------------------------------------------------- proc ::tcl::clock::add { clockval args } { if { [llength $args] % 2 != 0 } { set cmdName "clock add" return -code error \ -errorcode [list CLOCK wrongNumArgs] \ "wrong \# args: should be\ \"$cmdName clockval ?number units?...\ ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\"" } if { [catch { expr {wide($clockval)} } result] } { return -code error $result } set offsets {} set gmt 0 set locale c set timezone [GetSystemTimeZone] foreach { a b } $args { if { [string is integer -strict $a] } { lappend offsets $a $b } else { switch -exact -- $a { -g - -gm - -gmt { set saw(-gmt) {} set gmt $b } -l - -lo - -loc - -loca - -local - -locale { set locale [string tolower $b] } -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone { set saw(-timezone) {} set timezone $b } default { throw [list CLOCK badOption $a] \ "bad option \"$a\",\ must be -gmt, -locale or -timezone" } } } } # Check options for validity if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } { return -code error \ -errorcode [list CLOCK gmtWithTimezone] \ "cannot use -gmt and -timezone in same call" } if { [catch { expr { wide($clockval) } } result] } { return -code error "expected integer but got \"$clockval\"" } if { ![string is boolean -strict $gmt] } { return -code error "expected boolean value but got \"$gmt\"" } elseif { $gmt } { set timezone :GMT } EnterLocale $locale set changeover [mc GREGORIAN_CHANGE_DATE] if {[catch {SetupTimeZone $timezone} retval opts]} { dict unset opts -errorinfo return -options $opts $retval } try { foreach { quantity unit } $offsets { switch -exact -- $unit { years - year { set clockval [AddMonths [expr { 12 * $quantity }] \ $clockval $timezone $changeover] } months - month { set clockval [AddMonths $quantity $clockval $timezone \ $changeover] } weeks - week { set clockval [AddDays [expr { 7 * $quantity }] \ $clockval $timezone $changeover] } days - day { set clockval [AddDays $quantity $clockval $timezone \ $changeover] } hours - hour { set clockval [expr { 3600 * $quantity + $clockval }] } minutes - minute { set clockval [expr { 60 * $quantity + $clockval }] } seconds - second { set clockval [expr { $quantity + $clockval }] } default { throw [list CLOCK badUnit $unit] \ "unknown unit \"$unit\", must be \ years, months, weeks, days, hours, minutes or seconds" } } } return $clockval } trap CLOCK {result opts} { # Conceal the innards of [clock] when it's an expected error dict unset opts -errorinfo return -options $opts $result } } #---------------------------------------------------------------------- # # AddMonths -- # # Add a given number of months to a given clock value in a given # time zone. # # Parameters: # months - Number of months to add (may be negative) # clockval - Seconds since the epoch before the operation # timezone - Time zone in which the operation is to be performed # # Results: # Returns the new clock value as a number of seconds since # the epoch. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::AddMonths { months clockval timezone changeover } { variable DaysInRomanMonthInCommonYear variable DaysInRomanMonthInLeapYear variable TZData # Convert the time to year, month, day, and fraction of day. set date [GetDateFields $clockval $TZData($timezone) $changeover] dict set date secondOfDay [expr { [dict get $date localSeconds] % 86400 }] dict set date tzName $timezone # Add the requisite number of months set m [dict get $date month] incr m $months incr m -1 set delta [expr { $m / 12 }] set mm [expr { $m % 12 }] dict set date month [expr { $mm + 1 }] dict incr date year $delta # If the date doesn't exist in the current month, repair it if { [IsGregorianLeapYear $date] } { set hath [lindex $DaysInRomanMonthInLeapYear $mm] } else { set hath [lindex $DaysInRomanMonthInCommonYear $mm] } if { [dict get $date dayOfMonth] > $hath } { dict set date dayOfMonth $hath } # Reconvert to a number of seconds set date [GetJulianDayFromEraYearMonthDay \ $date[set date {}]\ $changeover] dict set date localSeconds [expr { -210866803200 + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \ $changeover] return [dict get $date seconds] } #---------------------------------------------------------------------- # # AddDays -- # # Add a given number of days to a given clock value in a given time # zone. # # Parameters: # days - Number of days to add (may be negative) # clockval - Seconds since the epoch before the operation # timezone - Time zone in which the operation is to be performed # changeover - Julian Day on which the Gregorian calendar was adopted # in the target locale. # # Results: # Returns the new clock value as a number of seconds since the epoch. # # Side effects: # None. # #---------------------------------------------------------------------- proc ::tcl::clock::AddDays { days clockval timezone changeover } { variable TZData # Convert the time to Julian Day set date [GetDateFields $clockval $TZData($timezone) $changeover] dict set date secondOfDay [expr { [dict get $date localSeconds] % 86400 }] dict set date tzName $timezone # Add the requisite number of days dict incr date julianDay $days # Reconvert to a number of seconds dict set date localSeconds [expr { -210866803200 + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \ $changeover] return [dict get $date seconds] } #---------------------------------------------------------------------- # # ChangeCurrentLocale -- # # The global locale was changed within msgcat. # Clears the buffered parse functions of the current locale. # # Parameters: # loclist (ignored) # # Results: # None. # # Side effects: # Buffered parse functions are cleared. # #---------------------------------------------------------------------- proc ::tcl::clock::ChangeCurrentLocale {args} { variable FormatProc variable LocaleNumeralCache variable CachedSystemTimeZone variable TimeZoneBad foreach p [info procs [namespace current]::scanproc'*'current] { rename $p {} } foreach p [info procs [namespace current]::formatproc'*'current] { rename $p {} } catch {array unset FormatProc *'current} set LocaleNumeralCache {} } #---------------------------------------------------------------------- # # ClearCaches -- # # Clears all caches to reclaim the memory used in [clock] # # Parameters: # None. # # Results: # None. # # Side effects: # Caches are cleared. # #---------------------------------------------------------------------- proc ::tcl::clock::ClearCaches {} { variable FormatProc variable LocaleNumeralCache variable CachedSystemTimeZone variable TimeZoneBad foreach p [info procs [namespace current]::scanproc'*] { rename $p {} } foreach p [info procs [namespace current]::formatproc'*] { rename $p {} } catch {unset FormatProc} set LocaleNumeralCache {} catch {unset CachedSystemTimeZone} set TimeZoneBad {} InitTZData } tcl8.6.14/library/history.tcl0000644000175000017500000001734414560736524015533 0ustar sergeisergei# history.tcl -- # # Implementation of the history command. # # Copyright (c) 1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # The tcl::history array holds the history list and some additional # bookkeeping variables. # # nextid the index used for the next history list item. # keep the max size of the history list # oldest the index of the oldest item in the history. namespace eval ::tcl { variable history if {![info exists history]} { array set history { nextid 0 keep 20 oldest -20 } } namespace ensemble create -command ::tcl::history -map { add ::tcl::HistAdd change ::tcl::HistChange clear ::tcl::HistClear event ::tcl::HistEvent info ::tcl::HistInfo keep ::tcl::HistKeep nextid ::tcl::HistNextID redo ::tcl::HistRedo } } # history -- # # This is the main history command. See the man page for its interface. # This does some argument checking and calls the helper ensemble in the # tcl namespace. proc ::history {args} { # If no command given, we're doing 'history info'. Can't be done with an # ensemble unknown handler, as those don't fire when no subcommand is # given at all. if {![llength $args]} { set args info } # Tricky stuff needed to make stack and errors come out right! tailcall apply {arglist {tailcall ::tcl::history {*}$arglist} ::tcl} $args } # (unnamed) -- # # Callback when [::history] is destroyed. Destroys the implementation. # # Parameters: # oldName what the command was called. # newName what the command is now called (an empty string). # op the operation (= delete). # # Results: # none # # Side Effects: # The implementation of the [::history] command ceases to exist. trace add command ::history delete [list apply {{oldName newName op} { variable history unset -nocomplain history foreach c [info procs ::tcl::Hist*] { rename $c {} } rename ::tcl::history {} } ::tcl}] # tcl::HistAdd -- # # Add an item to the history, and optionally eval it at the global scope # # Parameters: # event the command to add # exec (optional) a substring of "exec" causes the command to # be evaled. # Results: # If executing, then the results of the command are returned # # Side Effects: # Adds to the history list proc ::tcl::HistAdd {event {exec {}}} { variable history if { [prefix longest {exec {}} $exec] eq "" && [llength [info level 0]] == 3 } then { return -code error "bad argument \"$exec\": should be \"exec\"" } # Do not add empty commands to the history if {[string trim $event] eq ""} { return "" } # Maintain the history set history([incr history(nextid)]) $event unset -nocomplain history([incr history(oldest)]) # Only execute if 'exec' (or non-empty prefix of it) given if {$exec eq ""} { return "" } tailcall eval $event } # tcl::HistKeep -- # # Set or query the limit on the length of the history list # # Parameters: # limit (optional) the length of the history list # # Results: # If no limit is specified, the current limit is returned # # Side Effects: # Updates history(keep) if a limit is specified proc ::tcl::HistKeep {{count {}}} { variable history if {[llength [info level 0]] == 1} { return $history(keep) } if {![string is integer -strict $count] || ($count < 0)} { return -code error "illegal keep count \"$count\"" } set oldold $history(oldest) set history(oldest) [expr {$history(nextid) - $count}] for {} {$oldold <= $history(oldest)} {incr oldold} { unset -nocomplain history($oldold) } set history(keep) $count } # tcl::HistClear -- # # Erase the history list # # Parameters: # none # # Results: # none # # Side Effects: # Resets the history array, except for the keep limit proc ::tcl::HistClear {} { variable history set keep $history(keep) unset history array set history [list \ nextid 0 \ keep $keep \ oldest -$keep \ ] } # tcl::HistInfo -- # # Return a pretty-printed version of the history list # # Parameters: # num (optional) the length of the history list to return # # Results: # A formatted history list proc ::tcl::HistInfo {{count {}}} { variable history if {[llength [info level 0]] == 1} { set count [expr {$history(keep) + 1}] } elseif {![string is integer -strict $count]} { return -code error "bad integer \"$count\"" } set result {} set newline "" for {set i [expr {$history(nextid) - $count + 1}]} \ {$i <= $history(nextid)} {incr i} { if {![info exists history($i)]} { continue } set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]] append result $newline[format "%6d %s" $i $cmd] set newline \n } return $result } # tcl::HistRedo -- # # Fetch the previous or specified event, execute it, and then replace # the current history item with that event. # # Parameters: # event (optional) index of history item to redo. Defaults to -1, # which means the previous event. # # Results: # Those of the command being redone. # # Side Effects: # Replaces the current history list item with the one being redone. proc ::tcl::HistRedo {{event -1}} { variable history set i [HistIndex $event] if {$i == $history(nextid)} { return -code error "cannot redo the current event" } set cmd $history($i) HistChange $cmd 0 tailcall eval $cmd } # tcl::HistIndex -- # # Map from an event specifier to an index in the history list. # # Parameters: # event index of history item to redo. # If this is a positive number, it is used directly. # If it is a negative number, then it counts back to a previous # event, where -1 is the most recent event. # A string can be matched, either by being the prefix of a # command or by matching a command with string match. # # Results: # The index into history, or an error if the index didn't match. proc ::tcl::HistIndex {event} { variable history if {![string is integer -strict $event]} { for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \ {incr i -1} { if {[string match $event* $history($i)]} { return $i } if {[string match $event $history($i)]} { return $i } } return -code error "no event matches \"$event\"" } elseif {$event <= 0} { set i [expr {$history(nextid) + $event}] } else { set i $event } if {$i <= $history(oldest)} { return -code error "event \"$event\" is too far in the past" } if {$i > $history(nextid)} { return -code error "event \"$event\" hasn't occurred yet" } return $i } # tcl::HistEvent -- # # Map from an event specifier to the value in the history list. # # Parameters: # event index of history item to redo. See index for a description of # possible event patterns. # # Results: # The value from the history list. proc ::tcl::HistEvent {{event -1}} { variable history set i [HistIndex $event] if {![info exists history($i)]} { return "" } return [string trimright $history($i) \ \n] } # tcl::HistChange -- # # Replace a value in the history list. # # Parameters: # newValue The new value to put into the history list. # event (optional) index of history item to redo. See index for a # description of possible event patterns. This defaults to 0, # which specifies the current event. # # Side Effects: # Changes the history list. proc ::tcl::HistChange {newValue {event 0}} { variable history set i [HistIndex $event] set history($i) $newValue } # tcl::HistNextID -- # # Returns the number of the next history event. # # Parameters: # None. # # Side Effects: # None. proc ::tcl::HistNextID {} { variable history return [expr {$history(nextid) + 1}] } return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/library/init.tcl0000644000175000017500000006037214560736524014774 0ustar sergeisergei# init.tcl -- # # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # Copyright (c) 2004 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # This test intentionally written in pre-7.5 Tcl if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } package require -exact Tcl 8.6.14 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: # # The environment variable TCLLIBPATH # # tcl_library, which is the directory containing this init.tcl script. # [tclInit] (Tcl_Init()) searches around for the directory containing this # init.tcl and defines tcl_library to that location before sourcing it. # # The parent directory of tcl_library. Adding the parent # means that packages in peer directories will be found automatically. # # Also add the directory ../lib relative to the directory where the # executable is located. This is meant to find binary packages for the # same architecture as the current executable. # # tcl_pkgPath, which is set by the platform-specific initialization routines # On UNIX it is compiled in # On Windows, it is not used # # (Ticket 41c9857bdd) In a safe interpreter, this file does not set # ::auto_path (other than to {} if it is undefined). The caller, typically # a Safe Base command, is responsible for setting ::auto_path. if {![info exists auto_path]} { if {[info exists env(TCLLIBPATH)] && (![interp issafe])} { set auto_path $env(TCLLIBPATH) } else { set auto_path "" } } namespace eval tcl { if {![interp issafe]} { variable Dir foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } } set Dir [file join [file dirname [file dirname \ [info nameofexecutable]]] lib] if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } if {[info exists ::tcl_pkgPath]} { catch { foreach Dir $::tcl_pkgPath { if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } } }} variable Path [encoding dirs] set Dir [file join $::tcl_library encoding] if {$Dir ni $Path} { lappend Path $Dir encoding dirs $Path } unset Dir Path } # TIP #255 min and max functions namespace eval mathfunc { proc min {args} { if {![llength $args]} { return -code error \ "not enough arguments to math function \"min\"" } set val Inf foreach arg $args { # This will handle forcing the numeric value without # ruining the internal type of a numeric object if {[catch {expr {double($arg)}} err]} { return -code error $err } if {$arg < $val} {set val $arg} } return $val } proc max {args} { if {![llength $args]} { return -code error \ "not enough arguments to math function \"max\"" } set val -Inf foreach arg $args { # This will handle forcing the numeric value without # ruining the internal type of a numeric object if {[catch {expr {double($arg)}} err]} { return -code error $err } if {$arg > $val} {set val $arg} } return $val } namespace export min max } } # Windows specific end of initialization if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { namespace eval tcl { proc EnvTraceProc {lo n1 n2 op} { global env set x $env($n2) set env($lo) $x set env([string toupper $lo]) $x } proc InitWinEnv {} { global env tcl_platform foreach p [array names env] { set u [string toupper $p] if {$u ne $p} { switch -- $u { COMSPEC - PATH { set temp $env($p) unset env($p) set env($u) $temp trace add variable env($p) write \ [namespace code [list EnvTraceProc $p]] trace add variable env($u) write \ [namespace code [list EnvTraceProc $p]] } } } } if {![info exists env(COMSPEC)]} { set env(COMSPEC) cmd.exe } } InitWinEnv } } # Setup the unknown package handler if {[interp issafe]} { package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown} } else { # Set up search for Tcl Modules (TIP #189). # and setup platform specific unknown package handlers if {$tcl_platform(os) eq "Darwin" && $tcl_platform(platform) eq "unix"} { package unknown {::tcl::tm::UnknownHandler \ {::tcl::MacOSXPkgUnknown ::tclPkgUnknown}} } else { package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown} } # Set up the 'clock' ensemble namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library] proc ::tcl::initClock {} { # Auto-loading stubs for 'clock.tcl' foreach cmd {add format scan} { proc ::tcl::clock::$cmd args { variable TclLibDir source -encoding utf-8 [file join $TclLibDir clock.tcl] return [uplevel 1 [info level 0]] } } rename ::tcl::initClock {} } ::tcl::initClock } # Conditionalize for presence of exec. if {[namespace which -command exec] eq ""} { # Some machines do not have exec. Also, on all # platforms, safe interpreters do not have exec. set auto_noexec 1 } # Define a log command (which can be overwritten to log errors # differently, specially when stderr is not available) if {[namespace which -command tclLog] eq ""} { proc tclLog {string} { catch {puts stderr $string} } } # unknown -- # This procedure is called when a Tcl command is invoked that doesn't # exist in the interpreter. It takes the following steps to make the # command available: # # 1. See if the autoload facility can locate the command in a # Tcl script file. If so, load it and execute it. # 2. If the command was invoked interactively at top-level: # (a) see if the command exists as an executable UNIX program. # If so, "exec" the command. # (b) see if the command requests csh-like history substitution # in one of the common forms !!, !, or ^old^new. If # so, emulate csh's history substitution. # (c) see if the command is a unique abbreviation for another # command. If so, invoke the command. # # Arguments: # args - A list whose elements are the words of the original # command, including the command name. proc unknown args { variable ::tcl::UnknownPending global auto_noexec auto_noload env tcl_interactive errorInfo errorCode if {[info exists errorInfo]} { set savedErrorInfo $errorInfo } if {[info exists errorCode]} { set savedErrorCode $errorCode } set name [lindex $args 0] if {![info exists auto_noload]} { # # Make sure we're not trying to load the same proc twice. # if {[info exists UnknownPending($name)]} { return -code error "self-referential recursion\ in \"unknown\" for command \"$name\"" } set UnknownPending($name) pending set ret [catch { auto_load $name [uplevel 1 {::namespace current}] } msg opts] unset UnknownPending($name) if {$ret != 0} { dict append opts -errorinfo "\n (autoloading \"$name\")" return -options $opts $msg } if {![array size UnknownPending]} { unset UnknownPending } if {$msg} { if {[info exists savedErrorCode]} { set ::errorCode $savedErrorCode } else { unset -nocomplain ::errorCode } if {[info exists savedErrorInfo]} { set errorInfo $savedErrorInfo } else { unset -nocomplain errorInfo } set code [catch {uplevel 1 $args} msg opts] if {$code == 1} { # # Compute stack trace contribution from the [uplevel]. # Note the dependence on how Tcl_AddErrorInfo, etc. # construct the stack trace. # set errInfo [dict get $opts -errorinfo] set errCode [dict get $opts -errorcode] set cinfo $args if {[string bytelength $cinfo] > 150} { set cinfo [string range $cinfo 0 150] while {[string bytelength $cinfo] > 150} { set cinfo [string range $cinfo 0 end-1] } append cinfo ... } set tail "\n (\"uplevel\" body line 1)\n invoked\ from within\n\"uplevel 1 \$args\"" set expect "$msg\n while executing\n\"$cinfo\"$tail" if {$errInfo eq $expect} { # # The stack has only the eval from the expanded command # Do not generate any stack trace here. # dict unset opts -errorinfo dict incr opts -level return -options $opts $msg } # # Stack trace is nested, trim off just the contribution # from the extra "eval" of $args due to the "catch" above. # set last [string last $tail $errInfo] if {$last + [string length $tail] != [string length $errInfo]} { # Very likely cannot happen return -options $opts $msg } set errInfo [string range $errInfo 0 $last-1] set tail "\"$cinfo\"" set last [string last $tail $errInfo] if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} { return -code error -errorcode $errCode \ -errorinfo $errInfo $msg } set errInfo [string range $errInfo 0 $last-1] set tail "\n invoked from within\n" set last [string last $tail $errInfo] if {$last + [string length $tail] == [string length $errInfo]} { return -code error -errorcode $errCode \ -errorinfo [string range $errInfo 0 $last-1] $msg } set tail "\n while executing\n" set last [string last $tail $errInfo] if {$last + [string length $tail] == [string length $errInfo]} { return -code error -errorcode $errCode \ -errorinfo [string range $errInfo 0 $last-1] $msg } return -options $opts $msg } else { dict incr opts -level return -options $opts $msg } } } if {([info level] == 1) && ([info script] eq "") && [info exists tcl_interactive] && $tcl_interactive} { if {![info exists auto_noexec]} { set new [auto_execok $name] if {$new ne ""} { set redir "" if {[namespace which -command console] eq ""} { set redir ">&@stdout <@stdin" } uplevel 1 [list ::catch \ [concat exec $redir $new [lrange $args 1 end]] \ ::tcl::UnknownResult ::tcl::UnknownOptions] dict incr ::tcl::UnknownOptions -level return -options $::tcl::UnknownOptions $::tcl::UnknownResult } } if {$name eq "!!"} { set newcmd [history event] } elseif {[regexp {^!(.+)$} $name -> event]} { set newcmd [history event $event] } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} { set newcmd [history event -1] catch {regsub -all -- $old $newcmd $new newcmd} } if {[info exists newcmd]} { tclLog $newcmd history change $newcmd 0 uplevel 1 [list ::catch $newcmd \ ::tcl::UnknownResult ::tcl::UnknownOptions] dict incr ::tcl::UnknownOptions -level return -options $::tcl::UnknownOptions $::tcl::UnknownResult } set ret [catch [list uplevel 1 [list info commands $name*]] candidates] if {$name eq "::"} { set name "" } if {$ret != 0} { dict append opts -errorinfo \ "\n (expanding command prefix \"$name\" in unknown)" return -options $opts $candidates } # Filter out bogus matches when $name contained # a glob-special char [Bug 946952] if {$name eq ""} { # Handle empty $name separately due to strangeness # in [string first] (See RFE 1243354) set cmds $candidates } else { set cmds [list] foreach x $candidates { if {[string first $name $x] == 0} { lappend cmds $x } } } if {[llength $cmds] == 1} { uplevel 1 [list ::catch [lreplace $args 0 0 [lindex $cmds 0]] \ ::tcl::UnknownResult ::tcl::UnknownOptions] dict incr ::tcl::UnknownOptions -level return -options $::tcl::UnknownOptions $::tcl::UnknownResult } if {[llength $cmds]} { return -code error "ambiguous command name \"$name\": [lsort $cmds]" } } return -code error -errorcode [list TCL LOOKUP COMMAND $name] \ "invalid command name \"$name\"" } # auto_load -- # Checks a collection of library directories to see if a procedure # is defined in one of them. If so, it sources the appropriate # library file to create the procedure. Returns 1 if it successfully # loaded the procedure, 0 otherwise. # # Arguments: # cmd - Name of the command to find and load. # namespace (optional) The namespace where the command is being used - must be # a canonical namespace as returned [namespace current] # for instance. If not given, namespace current is used. proc auto_load {cmd {namespace {}}} { global auto_index auto_path if {$namespace eq ""} { set namespace [uplevel 1 [list ::namespace current]] } set nameList [auto_qualify $cmd $namespace] # workaround non canonical auto_index entries that might be around # from older auto_mkindex versions lappend nameList $cmd foreach name $nameList { if {[info exists auto_index($name)]} { namespace eval :: $auto_index($name) # There's a couple of ways to look for a command of a given # name. One is to use # info commands $name # Unfortunately, if the name has glob-magic chars in it like * # or [], it may not match. For our purposes here, a better # route is to use # namespace which -command $name if {[namespace which -command $name] ne ""} { return 1 } } } if {![info exists auto_path]} { return 0 } if {![auto_load_index]} { return 0 } foreach name $nameList { if {[info exists auto_index($name)]} { namespace eval :: $auto_index($name) if {[namespace which -command $name] ne ""} { return 1 } } } return 0 } # auto_load_index -- # Loads the contents of tclIndex files on the auto_path directory # list. This is usually invoked within auto_load to load the index # of available commands. Returns 1 if the index is loaded, and 0 if # the index is already loaded and up to date. # # Arguments: # None. proc auto_load_index {} { variable ::tcl::auto_oldpath global auto_index auto_path if {[info exists auto_oldpath] && ($auto_oldpath eq $auto_path)} { return 0 } set auto_oldpath $auto_path # Check if we are a safe interpreter. In that case, we support only # newer format tclIndex files. set issafe [interp issafe] for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} { set dir [lindex $auto_path $i] set f "" if {$issafe} { catch {source [file join $dir tclIndex]} } elseif {[catch {set f [open [file join $dir tclIndex]]}]} { continue } else { set error [catch { fconfigure $f -eofchar "\x1A {}" set id [gets $f] if {$id eq "# Tcl autoload index file, version 2.0"} { eval [read $f] } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} { while {[gets $f line] >= 0} { if {([string index $line 0] eq "#") \ || ([llength $line] != 2)} { continue } set name [lindex $line 0] set auto_index($name) \ "source [file join $dir [lindex $line 1]]" } } else { error "[file join $dir tclIndex] isn't a proper Tcl index file" } } msg opts] if {$f ne ""} { close $f } if {$error} { return -options $opts $msg } } } return 1 } # auto_qualify -- # # Compute a fully qualified names list for use in the auto_index array. # For historical reasons, commands in the global namespace do not have leading # :: in the index key. The list has two elements when the command name is # relative (no leading ::) and the namespace is not the global one. Otherwise # only one name is returned (and searched in the auto_index). # # Arguments - # cmd The command name. Can be any name accepted for command # invocations (Like "foo::::bar"). # namespace The namespace where the command is being used - must be # a canonical namespace as returned by [namespace current] # for instance. proc auto_qualify {cmd namespace} { # count separators and clean them up # (making sure that foo:::::bar will be treated as foo::bar) set n [regsub -all {::+} $cmd :: cmd] # Ignore namespace if the name starts with :: # Handle special case of only leading :: # Before each return case we give an example of which category it is # with the following form : # (inputCmd, inputNameSpace) -> output if {[string match ::* $cmd]} { if {$n > 1} { # (::foo::bar , *) -> ::foo::bar return [list $cmd] } else { # (::global , *) -> global return [list [string range $cmd 2 end]] } } # Potentially returning 2 elements to try : # (if the current namespace is not the global one) if {$n == 0} { if {$namespace eq "::"} { # (nocolons , ::) -> nocolons return [list $cmd] } else { # (nocolons , ::sub) -> ::sub::nocolons nocolons return [list ${namespace}::$cmd $cmd] } } elseif {$namespace eq "::"} { # (foo::bar , ::) -> ::foo::bar return [list ::$cmd] } else { # (foo::bar , ::sub) -> ::sub::foo::bar ::foo::bar return [list ${namespace}::$cmd ::$cmd] } } # auto_import -- # # Invoked during "namespace import" to make see if the imported commands # reside in an autoloaded library. If so, the commands are loaded so # that they will be available for the import links. If not, then this # procedure does nothing. # # Arguments - # pattern The pattern of commands being imported (like "foo::*") # a canonical namespace as returned by [namespace current] proc auto_import {pattern} { global auto_index # If no namespace is specified, this will be an error case if {![string match *::* $pattern]} { return } set ns [uplevel 1 [list ::namespace current]] set patternList [auto_qualify $pattern $ns] auto_load_index foreach pattern $patternList { foreach name [array names auto_index $pattern] { if {([namespace which -command $name] eq "") && ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} { namespace eval :: $auto_index($name) } } } } # auto_execok -- # # Returns string that indicates name of program to execute if # name corresponds to a shell builtin or an executable in the # Windows search path, or "" otherwise. Builds an associative # array auto_execs that caches information about previous checks, # for speed. # # Arguments: # name - Name of a command. if {$tcl_platform(platform) eq "windows"} { # Windows version. # # Note that file executable doesn't work under Windows, so we have to # look for files with .exe, .com, or .bat extensions. Also, the path # may be in the Path or PATH environment variables, and path # components are separated with semicolons, not colons as under Unix. # proc auto_execok name { global auto_execs env tcl_platform if {[info exists auto_execs($name)]} { return $auto_execs($name) } set auto_execs($name) "" set shellBuiltins [list assoc cls copy date del dir echo erase exit ftype \ md mkdir mklink move rd ren rename rmdir start time type ver vol] if {[info exists env(PATHEXT)]} { # Add an initial ; to have the {} extension check first. set execExtensions [split ";$env(PATHEXT)" ";"] } else { set execExtensions [list {} .com .exe .bat .cmd] } if {[string tolower $name] in $shellBuiltins} { # When this is command.com for some reason on Win2K, Tcl won't # exec it unless the case is right, which this corrects. COMSPEC # may not point to a real file, so do the check. set cmd $env(COMSPEC) if {[file exists $cmd]} { set cmd [file attributes $cmd -shortname] } return [set auto_execs($name) [list $cmd /c $name]] } if {[llength [file split $name]] != 1} { foreach ext $execExtensions { set file ${name}${ext} if {[file exists $file] && ![file isdirectory $file]} { return [set auto_execs($name) [list $file]] } } return "" } set path "[file dirname [info nameof]];.;" if {[info exists env(SystemRoot)]} { set windir $env(SystemRoot) } elseif {[info exists env(WINDIR)]} { set windir $env(WINDIR) } if {[info exists windir]} { if {$tcl_platform(os) eq "Windows NT"} { append path "$windir/system32;" } append path "$windir/system;$windir;" } foreach var {PATH Path path} { if {[info exists env($var)]} { append path ";$env($var)" } } foreach ext $execExtensions { unset -nocomplain checked foreach dir [split $path {;}] { # Skip already checked directories if {[info exists checked($dir)] || ($dir eq "")} { continue } set checked($dir) {} set file [file join $dir ${name}${ext}] if {[file exists $file] && ![file isdirectory $file]} { return [set auto_execs($name) [list $file]] } } } return "" } } else { # Unix version. # proc auto_execok name { global auto_execs env if {[info exists auto_execs($name)]} { return $auto_execs($name) } set auto_execs($name) "" if {[llength [file split $name]] != 1} { if {[file executable $name] && ![file isdirectory $name]} { set auto_execs($name) [list $name] } return $auto_execs($name) } foreach dir [split $env(PATH) :] { if {$dir eq ""} { set dir . } set file [file join $dir $name] if {[file executable $file] && ![file isdirectory $file]} { set auto_execs($name) [list $file] return $auto_execs($name) } } return "" } } # ::tcl::CopyDirectory -- # # This procedure is called by Tcl's core when attempts to call the # filesystem's copydirectory function fail. The semantics of the call # are that 'dest' does not yet exist, i.e. dest should become the exact # image of src. If dest does exist, we throw an error. # # Note that making changes to this procedure can change the results # of running Tcl's tests. # # Arguments: # action - "renaming" or "copying" # src - source directory # dest - destination directory proc tcl::CopyDirectory {action src dest} { set nsrc [file normalize $src] set ndest [file normalize $dest] if {$action eq "renaming"} { # Can't rename volumes. We could give a more precise # error message here, but that would break the test suite. if {$nsrc in [file volumes]} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ into itself" } } if {[file exists $dest]} { if {$nsrc eq $ndest} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ into itself" } if {$action eq "copying"} { # We used to throw an error here, but, looking more closely # at the core copy code in tclFCmd.c, if the destination # exists, then we should only call this function if -force # is true, which means we just want to over-write. So, # the following code is now commented out. # # return -code error "error $action \"$src\" to\ # \"$dest\": file already exists" } else { # Depending on the platform, and on the current # working directory, the directories '.', '..' # can be returned in various combinations. Anyway, # if any other file is returned, we must signal an error. set existing [glob -nocomplain -directory $dest * .*] lappend existing {*}[glob -nocomplain -directory $dest \ -type hidden * .*] foreach s $existing { if {[file tail $s] ni {. ..}} { return -code error "error $action \"$src\" to\ \"$dest\": file already exists" } } } } else { if {[string first $nsrc $ndest] >= 0} { set srclen [expr {[llength [file split $nsrc]] - 1}] set ndest [lindex [file split $ndest] $srclen] if {$ndest eq [file tail $nsrc]} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ into itself" } } file mkdir $dest } # Have to be careful to capture both visible and hidden files. # We will also be more generous to the file system and not # assume the hidden and non-hidden lists are non-overlapping. # # On Unix 'hidden' files begin with '.'. On other platforms # or filesystems hidden files may have other interpretations. set filelist [concat [glob -nocomplain -directory $src *] \ [glob -nocomplain -directory $src -types hidden *]] foreach s [lsort -unique $filelist] { if {[file tail $s] ni {. ..}} { file copy -force -- $s [file join $dest [file tail $s]] } } return } tcl8.6.14/library/package.tcl0000644000175000017500000005531514554262142015416 0ustar sergeisergei# package.tcl -- # # utility procs formerly in init.tcl which can be loaded on demand # for package management. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # namespace eval tcl::Pkg {} # ::tcl::Pkg::CompareExtension -- # # Used internally by pkg_mkIndex to compare the extension of a file to a given # extension. On Windows, it uses a case-insensitive comparison because the # file system can be file insensitive. # # Arguments: # fileName name of a file whose extension is compared # ext (optional) The extension to compare against; you must # provide the starting dot. # Defaults to [info sharedlibextension] # # Results: # Returns 1 if the extension matches, 0 otherwise proc tcl::Pkg::CompareExtension {fileName {ext {}}} { global tcl_platform if {$ext eq ""} {set ext [info sharedlibextension]} if {$tcl_platform(platform) eq "windows"} { return [string equal -nocase [file extension $fileName] $ext] } else { # Some unices add trailing numbers after the .so, so # we could have something like '.so.1.2'. set root $fileName while {1} { set currExt [file extension $root] if {$currExt eq $ext} { return 1 } # The current extension does not match; if it is not a numeric # value, quit, as we are only looking to ignore version number # extensions. Otherwise we might return 1 in this case: # tcl::Pkg::CompareExtension foo.so.bar .so # which should not match. if {![string is integer -strict [string range $currExt 1 end]]} { return 0 } set root [file rootname $root] } } } # pkg_mkIndex -- # This procedure creates a package index in a given directory. The package # index consists of a "pkgIndex.tcl" file whose contents are a Tcl script that # sets up package information with "package require" commands. The commands # describe all of the packages defined by the files given as arguments. # # Arguments: # -direct (optional) If this flag is present, the generated # code in pkgMkIndex.tcl will cause the package to be # loaded when "package require" is executed, rather # than lazily when the first reference to an exported # procedure in the package is made. # -verbose (optional) Verbose output; the name of each file that # was successfully processed is printed out. Additionally, # if processing of a file failed a message is printed. # -load pat (optional) Preload any packages whose names match # the pattern. Used to handle DLLs that depend on # other packages during their Init procedure. # dir - Name of the directory in which to create the index. # args - Any number of additional arguments, each giving # a glob pattern that matches the names of one or # more shared libraries or Tcl script files in # dir. proc pkg_mkIndex {args} { set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"} set argCount [llength $args] if {$argCount < 1} { return -code error "wrong # args: should be\n$usage" } set more "" set direct 1 set doVerbose 0 set loadPat "" for {set idx 0} {$idx < $argCount} {incr idx} { set flag [lindex $args $idx] switch -glob -- $flag { -- { # done with the flags incr idx break } -verbose { set doVerbose 1 } -lazy { set direct 0 append more " -lazy" } -direct { append more " -direct" } -load { incr idx set loadPat [lindex $args $idx] append more " -load $loadPat" } -* { return -code error "unknown flag $flag: should be\n$usage" } default { # done with the flags break } } } set dir [lindex $args $idx] set patternList [lrange $args [expr {$idx + 1}] end] if {![llength $patternList]} { set patternList [list "*.tcl" "*[info sharedlibextension]"] } try { set fileList [glob -directory $dir -tails -types {r f} -- \ {*}$patternList] } on error {msg opt} { return -options $opt $msg } foreach file $fileList { # For each file, figure out what commands and packages it provides. # To do this, create a child interpreter, load the file into the # interpreter, and get a list of the new commands and packages that # are defined. if {$file eq "pkgIndex.tcl"} { continue } set c [interp create] # Load into the child any packages currently loaded in the parent # interpreter that match the -load pattern. if {$loadPat ne ""} { if {$doVerbose} { tclLog "currently loaded packages: '[info loaded]'" tclLog "trying to load all packages matching $loadPat" } if {![llength [info loaded]]} { tclLog "warning: no packages are currently loaded, nothing" tclLog "can possibly match '$loadPat'" } } foreach pkg [info loaded] { if {![string match -nocase $loadPat [lindex $pkg 1]]} { continue } if {$doVerbose} { tclLog "package [lindex $pkg 1] matches '$loadPat'" } try { load [lindex $pkg 0] [lindex $pkg 1] $c } on error err { if {$doVerbose} { tclLog "warning: load [lindex $pkg 0]\ [lindex $pkg 1]\nfailed with: $err" } } on ok {} { if {$doVerbose} { tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]" } } if {[lindex $pkg 1] eq "Tk"} { # Withdraw . if Tk was loaded, to avoid showing a window. $c eval [list wm withdraw .] } } $c eval { # Stub out the package command so packages can require other # packages. rename package __package_orig proc package {what args} { switch -- $what { require { return; # Ignore transitive requires } default { __package_orig $what {*}$args } } } proc tclPkgUnknown args {} package unknown tclPkgUnknown # Stub out the unknown command so package can call into each other # during their initialization. proc unknown {args} {} # Stub out the auto_import mechanism proc auto_import {args} {} # reserve the ::tcl namespace for support procs and temporary # variables. This might make it awkward to generate a # pkgIndex.tcl file for the ::tcl namespace. namespace eval ::tcl { variable dir ;# Current directory being processed variable file ;# Current file being processed variable direct ;# -direct flag value variable x ;# Loop variable variable debug ;# For debugging variable type ;# "load" or "source", for -direct variable namespaces ;# Existing namespaces (e.g., ::tcl) variable packages ;# Existing packages (e.g., Tcl) variable origCmds ;# Existing commands variable newCmds ;# Newly created commands variable newPkgs {} ;# Newly created packages } } $c eval [list set ::tcl::dir $dir] $c eval [list set ::tcl::file $file] $c eval [list set ::tcl::direct $direct] # Download needed procedures into the child because we've just deleted # the unknown procedure. This doesn't handle procedures with default # arguments. foreach p {::tcl::Pkg::CompareExtension} { $c eval [list namespace eval [namespace qualifiers $p] {}] $c eval [list proc $p [info args $p] [info body $p]] } try { $c eval { set ::tcl::debug "loading or sourcing" # we need to track command defined by each package even in the # -direct case, because they are needed internally by the # "partial pkgIndex.tcl" step above. proc ::tcl::GetAllNamespaces {{root ::}} { set list $root foreach ns [namespace children $root] { lappend list {*}[::tcl::GetAllNamespaces $ns] } return $list } # init the list of existing namespaces, packages, commands foreach ::tcl::x [::tcl::GetAllNamespaces] { set ::tcl::namespaces($::tcl::x) 1 } foreach ::tcl::x [package names] { if {[package provide $::tcl::x] ne ""} { set ::tcl::packages($::tcl::x) 1 } } set ::tcl::origCmds [info commands] # Try to load the file if it has the shared library extension, # otherwise source it. It's important not to try to load # files that aren't shared libraries, because on some systems # (like SunOS) the loader will abort the whole application # when it gets an error. if {[::tcl::Pkg::CompareExtension $::tcl::file [info sharedlibextension]]} { # The "file join ." command below is necessary. Without # it, if the file name has no \'s and we're on UNIX, the # load command will invoke the LD_LIBRARY_PATH search # mechanism, which could cause the wrong file to be used. set ::tcl::debug loading load [file join $::tcl::dir $::tcl::file] set ::tcl::type load } else { set ::tcl::debug sourcing source [file join $::tcl::dir $::tcl::file] set ::tcl::type source } # As a performance optimization, if we are creating direct # load packages, don't bother figuring out the set of commands # created by the new packages. We only need that list for # setting up the autoloading used in the non-direct case. if {!$::tcl::direct} { # See what new namespaces appeared, and import commands # from them. Only exported commands go into the index. foreach ::tcl::x [::tcl::GetAllNamespaces] { if {![info exists ::tcl::namespaces($::tcl::x)]} { namespace import -force ${::tcl::x}::* } # Figure out what commands appeared foreach ::tcl::x [info commands] { set ::tcl::newCmds($::tcl::x) 1 } foreach ::tcl::x $::tcl::origCmds { unset -nocomplain ::tcl::newCmds($::tcl::x) } foreach ::tcl::x [array names ::tcl::newCmds] { # determine which namespace a command comes from set ::tcl::abs [namespace origin $::tcl::x] # special case so that global names have no # leading ::, this is required by the unknown # command set ::tcl::abs \ [lindex [auto_qualify $::tcl::abs ::] 0] if {$::tcl::x ne $::tcl::abs} { # Name changed during qualification set ::tcl::newCmds($::tcl::abs) 1 unset ::tcl::newCmds($::tcl::x) } } } } # Look through the packages that appeared, and if there is a # version provided, then record it foreach ::tcl::x [package names] { if {[package provide $::tcl::x] ne "" && ![info exists ::tcl::packages($::tcl::x)]} { lappend ::tcl::newPkgs \ [list $::tcl::x [package provide $::tcl::x]] } } } } on error msg { set what [$c eval set ::tcl::debug] if {$doVerbose} { tclLog "warning: error while $what $file: $msg" } } on ok {} { set what [$c eval set ::tcl::debug] if {$doVerbose} { tclLog "successful $what of $file" } set type [$c eval set ::tcl::type] set cmds [lsort [$c eval array names ::tcl::newCmds]] set pkgs [$c eval set ::tcl::newPkgs] if {$doVerbose} { if {!$direct} { tclLog "commands provided were $cmds" } tclLog "packages provided were $pkgs" } if {[llength $pkgs] > 1} { tclLog "warning: \"$file\" provides more than one package ($pkgs)" } foreach pkg $pkgs { # cmds is empty/not used in the direct case lappend files($pkg) [list $file $type $cmds] } if {$doVerbose} { tclLog "processed $file" } } interp delete $c } append index "# Tcl package index file, version 1.1\n" append index "# This file is generated by the \"pkg_mkIndex$more\" command\n" append index "# and sourced either when an application starts up or\n" append index "# by a \"package unknown\" script. It invokes the\n" append index "# \"package ifneeded\" command to set up package-related\n" append index "# information so that packages will be loaded automatically\n" append index "# in response to \"package require\" commands. When this\n" append index "# script is sourced, the variable \$dir must contain the\n" append index "# full path name of this file's directory.\n" foreach pkg [lsort [array names files]] { set cmd {} lassign $pkg name version lappend cmd ::tcl::Pkg::Create -name $name -version $version foreach spec [lsort -index 0 $files($pkg)] { foreach {file type procs} $spec { if {$direct} { set procs {} } lappend cmd "-$type" [list $file $procs] } } append index "\n[eval $cmd]" } set f [open [file join $dir pkgIndex.tcl] w] puts $f $index close $f } # tclPkgSetup -- # This is a utility procedure use by pkgIndex.tcl files. It is invoked as # part of a "package ifneeded" script. It calls "package provide" to indicate # that a package is available, then sets entries in the auto_index array so # that the package's files will be auto-loaded when the commands are used. # # Arguments: # dir - Directory containing all the files for this package. # pkg - Name of the package (no version number). # version - Version number for the package, such as 2.1.3. # files - List of files that constitute the package. Each # element is a sub-list with three elements. The first # is the name of a file relative to $dir, the second is # "load" or "source", indicating whether the file is a # loadable binary or a script to source, and the third # is a list of commands defined by this file. proc tclPkgSetup {dir pkg version files} { global auto_index package provide $pkg $version foreach fileInfo $files { set f [lindex $fileInfo 0] set type [lindex $fileInfo 1] foreach cmd [lindex $fileInfo 2] { if {$type eq "load"} { set auto_index($cmd) [list load [file join $dir $f] $pkg] } else { set auto_index($cmd) [list source [file join $dir $f]] } } } } # tclPkgUnknown -- # This procedure provides the default for the "package unknown" function. It # is invoked when a package that's needed can't be found. It scans the # auto_path directories and their immediate children looking for pkgIndex.tcl # files and sources any such files that are found to setup the package # database. As it searches, it will recognize changes to the auto_path and # scan any new directories. # # Arguments: # name - Name of desired package. Not used. # version - Version of desired package. Not used. # exact - Either "-exact" or omitted. Not used. proc tclPkgUnknown {name args} { global auto_path env if {![info exists auto_path]} { return } # Cache the auto_path, because it may change while we run through the # first set of pkgIndex.tcl files set old_path [set use_path $auto_path] while {[llength $use_path]} { set dir [lindex $use_path end] # Make sure we only scan each directory one time. if {[info exists tclSeenPath($dir)]} { set use_path [lrange $use_path 0 end-1] continue } set tclSeenPath($dir) 1 # Get the pkgIndex.tcl files in subdirectories of auto_path directories. # - Safe Base interpreters have a restricted "glob" command that # works in this case. # - The "catch" was essential when there was no safe glob and every # call in a safe interp failed; it is retained only for corner # cases in which the eventual call to glob returns an error. catch { foreach file [glob -directory $dir -join -nocomplain \ * pkgIndex.tcl] { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue } on error msg { tclLog "error reading package index file $file: $msg" } on ok {} { set procdDirs($dir) 1 } } } } set dir [lindex $use_path end] if {![info exists procdDirs($dir)]} { set file [file join $dir pkgIndex.tcl] # safe interps usually don't have "file exists", if {([interp issafe] || [file exists $file])} { try { source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue } on error msg { tclLog "error reading package index file $file: $msg" } on ok {} { set procdDirs($dir) 1 } } } set use_path [lrange $use_path 0 end-1] # Check whether any of the index scripts we [source]d above set a new # value for $::auto_path. If so, then find any new directories on the # $::auto_path, and lappend them to the $use_path we are working from. # This gives index scripts the (arguably unwise) power to expand the # index script search path while the search is in progress. set index 0 if {[llength $old_path] == [llength $auto_path]} { foreach dir $auto_path old $old_path { if {$dir ne $old} { # This entry in $::auto_path has changed. break } incr index } } # $index now points to the first element of $auto_path that has # changed, or the beginning if $auto_path has changed length Scan the # new elements of $auto_path for directories to add to $use_path. # Don't add directories we've already seen, or ones already on the # $use_path. foreach dir [lrange $auto_path $index end] { if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} { lappend use_path $dir } } set old_path $auto_path } } # tcl::MacOSXPkgUnknown -- # This procedure extends the "package unknown" function for MacOSX. It scans # the Resources/Scripts directories of the immediate children of the auto_path # directories for pkgIndex files. # # Arguments: # original - original [package unknown] procedure # name - Name of desired package. Not used. # version - Version of desired package. Not used. # exact - Either "-exact" or omitted. Not used. proc tcl::MacOSXPkgUnknown {original name args} { # First do the cross-platform default search uplevel 1 $original [linsert $args 0 $name] # Now do MacOSX specific searching global auto_path if {![info exists auto_path]} { return } # Cache the auto_path, because it may change while we run through the # first set of pkgIndex.tcl files set old_path [set use_path $auto_path] while {[llength $use_path]} { set dir [lindex $use_path end] # Make sure we only scan each directory one time. if {[info exists tclSeenPath($dir)]} { set use_path [lrange $use_path 0 end-1] continue } set tclSeenPath($dir) 1 # get the pkgIndex files out of the subdirectories # Safe interpreters do not use tcl::MacOSXPkgUnknown - see init.tcl. foreach file [glob -directory $dir -join -nocomplain \ * Resources Scripts pkgIndex.tcl] { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue } on error msg { tclLog "error reading package index file $file: $msg" } on ok {} { set procdDirs($dir) 1 } } } set use_path [lrange $use_path 0 end-1] # Check whether any of the index scripts we [source]d above set a new # value for $::auto_path. If so, then find any new directories on the # $::auto_path, and lappend them to the $use_path we are working from. # This gives index scripts the (arguably unwise) power to expand the # index script search path while the search is in progress. set index 0 if {[llength $old_path] == [llength $auto_path]} { foreach dir $auto_path old $old_path { if {$dir ne $old} { # This entry in $::auto_path has changed. break } incr index } } # $index now points to the first element of $auto_path that has # changed, or the beginning if $auto_path has changed length Scan the # new elements of $auto_path for directories to add to $use_path. # Don't add directories we've already seen, or ones already on the # $use_path. foreach dir [lrange $auto_path $index end] { if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} { lappend use_path $dir } } set old_path $auto_path } } # ::tcl::Pkg::Create -- # # Given a package specification generate a "package ifneeded" statement # for the package, suitable for inclusion in a pkgIndex.tcl file. # # Arguments: # args arguments used by the Create function: # -name packageName # -version packageVersion # -load {filename ?{procs}?} # ... # -source {filename ?{procs}?} # ... # # Any number of -load and -source parameters may be # specified, so long as there is at least one -load or # -source parameter. If the procs component of a module # specifier is left off, that module will be set up for # direct loading; otherwise, it will be set up for lazy # loading. If both -source and -load are specified, the # -load'ed files will be loaded first, followed by the # -source'd files. # # Results: # An appropriate "package ifneeded" statement for the package. proc ::tcl::Pkg::Create {args} { append err(usage) "[lindex [info level 0] 0] " append err(usage) "-name packageName -version packageVersion" append err(usage) "?-load {filename ?{procs}?}? ... " append err(usage) "?-source {filename ?{procs}?}? ..." set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\"" set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\"" set err(unknownOpt) "unknown option \"%s\": should be \"$err(usage)\"" set err(noLoadOrSource) "at least one of -load and -source must be given" # process arguments set len [llength $args] if {$len < 6} { error $err(wrongNumArgs) } # Initialize parameters array set opts {-name {} -version {} -source {} -load {}} # process parameters for {set i 0} {$i < $len} {incr i} { set flag [lindex $args $i] incr i switch -glob -- $flag { "-name" - "-version" { if {$i >= $len} { error [format $err(valueMissing) $flag] } set opts($flag) [lindex $args $i] } "-source" - "-load" { if {$i >= $len} { error [format $err(valueMissing) $flag] } lappend opts($flag) [lindex $args $i] } default { error [format $err(unknownOpt) [lindex $args $i]] } } } # Validate the parameters if {![llength $opts(-name)]} { error [format $err(valueMissing) "-name"] } if {![llength $opts(-version)]} { error [format $err(valueMissing) "-version"] } if {!([llength $opts(-source)] || [llength $opts(-load)])} { error $err(noLoadOrSource) } # OK, now everything is good. Generate the package ifneeded statement. set cmdline "package ifneeded $opts(-name) $opts(-version) " set cmdList {} set lazyFileList {} # Handle -load and -source specs foreach key {load source} { foreach filespec $opts(-$key) { lassign $filespec filename proclist if { [llength $proclist] == 0 } { set cmd "\[list $key \[file join \$dir [list $filename]\]\]" lappend cmdList $cmd } else { lappend lazyFileList [list $filename $key $proclist] } } } if {[llength $lazyFileList]} { lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\ $opts(-version) [list $lazyFileList]\]" } append cmdline [join $cmdList "\\n"] return $cmdline } interp alias {} ::pkg::create {} ::tcl::Pkg::Create tcl8.6.14/library/parray.tcl0000644000175000017500000000146014554262142015311 0ustar sergeisergei# parray: # Print the contents of a global array on stdout. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # proc parray {a {pattern *}} { upvar 1 $a array if {![array exists array]} { return -code error "\"$a\" isn't an array" } set maxl 0 set names [lsort [array names array $pattern]] foreach name $names { if {[string length $name] > $maxl} { set maxl [string length $name] } } set maxl [expr {$maxl + [string length $a] + 2}] foreach name $names { set nameString [format %s(%s) $a $name] puts stdout [format "%-*s = %s" $maxl $nameString $array($name)] } } tcl8.6.14/library/safe.tcl0000644000175000017500000011775014560736524014752 0ustar sergeisergei# safe.tcl -- # # This file provide a safe loading/sourcing mechanism for safe interpreters. # It implements a virtual path mechanism to hide the real pathnames from the # child. It runs in a parent interpreter and sets up data structure and # aliases that will be invoked when used from a child interpreter. # # See the safe.n man page for details. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # The implementation is based on namespaces. These naming conventions are # followed: # Private procs starts with uppercase. # Public procs are exported and starts with lowercase # # Needed utilities package package require opt 0.4.8 # Create the safe namespace namespace eval ::safe { # Exported API: namespace export interpCreate interpInit interpConfigure interpDelete \ interpAddToAccessPath interpFindInAccessPath setLogCmd } # Helper function to resolve the dual way of specifying staticsok (either # by -noStatics or -statics 0) proc ::safe::InterpStatics {} { foreach v {Args statics noStatics} { upvar $v $v } set flag [::tcl::OptProcArgGiven -noStatics] if {$flag && (!$noStatics == !$statics) && ([::tcl::OptProcArgGiven -statics])} { return -code error\ "conflicting values given for -statics and -noStatics" } if {$flag} { return [expr {!$noStatics}] } else { return $statics } } # Helper function to resolve the dual way of specifying nested loading # (either by -nestedLoadOk or -nested 1) proc ::safe::InterpNested {} { foreach v {Args nested nestedLoadOk} { upvar $v $v } set flag [::tcl::OptProcArgGiven -nestedLoadOk] # note that the test here is the opposite of the "InterpStatics" one # (it is not -noNested... because of the wanted default value) if {$flag && (!$nestedLoadOk != !$nested) && ([::tcl::OptProcArgGiven -nested])} { return -code error\ "conflicting values given for -nested and -nestedLoadOk" } if {$flag} { # another difference with "InterpStatics" return $nestedLoadOk } else { return $nested } } #### # # API entry points that needs argument parsing : # #### # Interface/entry point function and front end for "Create" proc ::safe::interpCreate {args} { set Args [::tcl::OptKeyParse ::safe::interpCreate $args] RejectExcessColons $slave InterpCreate $slave $accessPath \ [InterpStatics] [InterpNested] $deleteHook } proc ::safe::interpInit {args} { set Args [::tcl::OptKeyParse ::safe::interpIC $args] if {![::interp exists $slave]} { return -code error "\"$slave\" is not an interpreter" } RejectExcessColons $slave InterpInit $slave $accessPath \ [InterpStatics] [InterpNested] $deleteHook } # Check that the given child is "one of us" proc ::safe::CheckInterp {child} { namespace upvar ::safe [VarName $child] state if {![info exists state] || ![::interp exists $child]} { return -code error \ "\"$child\" is not an interpreter managed by ::safe::" } } # Interface/entry point function and front end for "Configure". This code # is awfully pedestrian because it would need more coupling and support # between the way we store the configuration values in safe::interp's and # the Opt package. Obviously we would like an OptConfigure to avoid # duplicating all this code everywhere. # -> TODO (the app should share or access easily the program/value stored # by opt) # This is even more complicated by the boolean flags with no values that # we had the bad idea to support for the sake of user simplicity in # create/init but which makes life hard in configure... # So this will be hopefully written and some integrated with opt1.0 # (hopefully for tcl8.1 ?) proc ::safe::interpConfigure {args} { switch [llength $args] { 1 { # If we have exactly 1 argument the semantic is to return all # the current configuration. We still call OptKeyParse though # we know that "child" is our given argument because it also # checks for the "-help" option. set Args [::tcl::OptKeyParse ::safe::interpIC $args] CheckInterp $slave namespace upvar ::safe [VarName $slave] state return [join [list \ [list -accessPath $state(access_path)] \ [list -statics $state(staticsok)] \ [list -nested $state(nestedok)] \ [list -deleteHook $state(cleanupHook)]]] } 2 { # If we have exactly 2 arguments the semantic is a "configure # get" lassign $args slave arg # get the flag sub program (we 'know' about Opt's internal # representation of data) set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2] set hits [::tcl::OptHits desc $arg] if {$hits > 1} { return -code error [::tcl::OptAmbigous $desc $arg] } elseif {$hits == 0} { return -code error [::tcl::OptFlagUsage $desc $arg] } CheckInterp $slave namespace upvar ::safe [VarName $slave] state set item [::tcl::OptCurDesc $desc] set name [::tcl::OptName $item] switch -exact -- $name { -accessPath { return [list -accessPath $state(access_path)] } -statics { return [list -statics $state(staticsok)] } -nested { return [list -nested $state(nestedok)] } -deleteHook { return [list -deleteHook $state(cleanupHook)] } -noStatics { # it is most probably a set in fact but we would need # then to jump to the set part and it is not *sure* # that it is a set action that the user want, so force # it to use the unambiguous -statics ?value? instead: return -code error\ "ambigous query (get or set -noStatics ?)\ use -statics instead" } -nestedLoadOk { return -code error\ "ambigous query (get or set -nestedLoadOk ?)\ use -nested instead" } default { return -code error "unknown flag $name (bug)" } } } default { # Otherwise we want to parse the arguments like init and # create did set Args [::tcl::OptKeyParse ::safe::interpIC $args] CheckInterp $slave namespace upvar ::safe [VarName $slave] state # Get the current (and not the default) values of whatever has # not been given: if {![::tcl::OptProcArgGiven -accessPath]} { set doreset 0 set accessPath $state(access_path) } else { set doreset 1 } if { ![::tcl::OptProcArgGiven -statics] && ![::tcl::OptProcArgGiven -noStatics] } then { set statics $state(staticsok) } else { set statics [InterpStatics] } if { [::tcl::OptProcArgGiven -nested] || [::tcl::OptProcArgGiven -nestedLoadOk] } then { set nested [InterpNested] } else { set nested $state(nestedok) } if {![::tcl::OptProcArgGiven -deleteHook]} { set deleteHook $state(cleanupHook) } # we can now reconfigure : InterpSetConfig $slave $accessPath $statics $nested $deleteHook # auto_reset the child (to completely synch the new access_path) if {$doreset} { if {[catch {::interp eval $slave {auto_reset}} msg]} { Log $slave "auto_reset failed: $msg" } else { Log $slave "successful auto_reset" NOTICE } # Sync the paths used to search for Tcl modules. ::interp eval $slave {tcl::tm::path remove {*}[tcl::tm::list]} if {[llength $state(tm_path_slave)] > 0} { ::interp eval $slave [list \ ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] } # Remove stale "package ifneeded" data for non-loaded packages. # - Not for loaded packages, because "package forget" erases # data from "package provide" as well as "package ifneeded". # - This is OK because the script cannot reload any version of # the package unless it first does "package forget". foreach pkg [::interp eval $slave {package names}] { if {[::interp eval $slave [list package provide $pkg]] eq ""} { ::interp eval $slave [list package forget $pkg] } } } return } } } #### # # Functions that actually implements the exported APIs # #### # # safe::InterpCreate : doing the real job # # This procedure creates a safe interpreter and initializes it with the safe # base aliases. # NB: child name must be simple alphanumeric string, no spaces, no (), no # {},... {because the state array is stored as part of the name} # # Returns the child name. # # Optional Arguments : # + child name : if empty, generated name will be used # + access_path: path list controlling where load/source can occur, # if empty: the parent auto_path will be used. # + staticsok : flag, if 0 :no static package can be loaded (load {} Xxx) # if 1 :static packages are ok. # + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub) # if 1 : multiple levels are ok. # use the full name and no indent so auto_mkIndex can find us proc ::safe::InterpCreate { child access_path staticsok nestedok deletehook } { # Create the child. # If evaluated in ::safe, the interpreter command for foo is ::foo; # but for foo::bar is safe::foo::bar. So evaluate in :: instead. if {$child ne ""} { namespace eval :: [list ::interp create -safe $child] } else { # empty argument: generate child name set child [::interp create -safe] } Log $child "Created" NOTICE # Initialize it. (returns child name) InterpInit $child $access_path $staticsok $nestedok $deletehook } # # InterpSetConfig (was setAccessPath) : # Sets up child virtual auto_path and corresponding structure within # the parent. Also sets the tcl_library in the child to be the first # directory in the path. # NB: If you change the path after the child has been initialized you # probably need to call "auto_reset" in the child in order that it gets # the right auto_index() array values. proc ::safe::InterpSetConfig {child access_path staticsok nestedok deletehook} { global auto_path # determine and store the access path if empty if {$access_path eq ""} { set access_path $auto_path # Make sure that tcl_library is in auto_path and at the first # position (needed by setAccessPath) set where [lsearch -exact $access_path [info library]] if {$where < 0} { # not found, add it. set access_path [linsert $access_path 0 [info library]] Log $child "tcl_library was not in auto_path,\ added it to slave's access_path" NOTICE } elseif {$where != 0} { # not first, move it first set access_path [linsert \ [lreplace $access_path $where $where] \ 0 [info library]] Log $child "tcl_libray was not in first in auto_path,\ moved it to front of slave's access_path" NOTICE } # Add 1st level subdirs (will searched by auto loading from tcl # code in the child using glob and thus fail, so we add them here # so by default it works the same). set access_path [AddSubDirs $access_path] } Log $child "Setting accessPath=($access_path) staticsok=$staticsok\ nestedok=$nestedok deletehook=($deletehook)" NOTICE namespace upvar ::safe [VarName $child] state # clear old autopath if it existed # build new one # Extend the access list with the paths used to look for Tcl Modules. # We save the virtual form separately as well, as syncing it with the # child has to be deferred until the necessary commands are present for # setup. set norm_access_path {} set slave_access_path {} set map_access_path {} set remap_access_path {} set slave_tm_path {} set i 0 foreach dir $access_path { set token [PathToken $i] lappend slave_access_path $token lappend map_access_path $token $dir lappend remap_access_path $dir $token lappend norm_access_path [file normalize $dir] incr i } set morepaths [::tcl::tm::list] set firstpass 1 while {[llength $morepaths]} { set addpaths $morepaths set morepaths {} foreach dir $addpaths { # Prevent the addition of dirs on the tm list to the # result if they are already known. if {[dict exists $remap_access_path $dir]} { if {$firstpass} { # $dir is in [::tcl::tm::list] and belongs in the slave_tm_path. # Later passes handle subdirectories, which belong in the # access path but not in the module path. lappend slave_tm_path [dict get $remap_access_path $dir] } continue } set token [PathToken $i] lappend access_path $dir lappend slave_access_path $token lappend map_access_path $token $dir lappend remap_access_path $dir $token lappend norm_access_path [file normalize $dir] if {$firstpass} { # $dir is in [::tcl::tm::list] and belongs in the slave_tm_path. # Later passes handle subdirectories, which belong in the # access path but not in the module path. lappend slave_tm_path $token } incr i # [Bug 2854929] # Recursively find deeper paths which may contain # modules. Required to handle modules with names like # 'platform::shell', which translate into # 'platform/shell-X.tm', i.e arbitrarily deep # subdirectories. lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] } set firstpass 0 } set state(access_path) $access_path set state(access_path,map) $map_access_path set state(access_path,remap) $remap_access_path set state(access_path,norm) $norm_access_path set state(access_path,slave) $slave_access_path set state(tm_path_slave) $slave_tm_path set state(staticsok) $staticsok set state(nestedok) $nestedok set state(cleanupHook) $deletehook SyncAccessPath $child return } # # # FindInAccessPath: # Search for a real directory and returns its virtual Id (including the # "$") proc ::safe::interpFindInAccessPath {child path} { CheckInterp $child namespace upvar ::safe [VarName $child] state if {![dict exists $state(access_path,remap) $path]} { return -code error "$path not found in access path" } return [dict get $state(access_path,remap) $path] } # # addToAccessPath: # add (if needed) a real directory to access path and return its # virtual token (including the "$"). proc ::safe::interpAddToAccessPath {child path} { # first check if the directory is already in there # (inlined interpFindInAccessPath). CheckInterp $child namespace upvar ::safe [VarName $child] state if {[dict exists $state(access_path,remap) $path]} { return [dict get $state(access_path,remap) $path] } # new one, add it: set token [PathToken [llength $state(access_path)]] lappend state(access_path) $path lappend state(access_path,slave) $token lappend state(access_path,map) $token $path lappend state(access_path,remap) $path $token lappend state(access_path,norm) [file normalize $path] SyncAccessPath $child return $token } # This procedure applies the initializations to an already existing # interpreter. It is useful when you want to install the safe base aliases # into a preexisting safe interpreter. proc ::safe::InterpInit { child access_path staticsok nestedok deletehook } { # Configure will generate an access_path when access_path is empty. InterpSetConfig $child $access_path $staticsok $nestedok $deletehook # NB we need to add [namespace current], aliases are always absolute # paths. # These aliases let the child load files to define new commands # This alias lets the child use the encoding names, convertfrom, # convertto, and system, but not "encoding system " to set the # system encoding. # Handling Tcl Modules, we need a restricted form of Glob. # This alias interposes on the 'exit' command and cleanly terminates # the child. foreach {command alias} { source AliasSource load AliasLoad encoding AliasEncoding exit interpDelete glob AliasGlob } { ::interp alias $child $command {} [namespace current]::$alias $child } # This alias lets the child have access to a subset of the 'file' # command functionality. ::interp expose $child file foreach subcommand {dirname extension rootname tail} { ::interp alias $child ::tcl::file::$subcommand {} \ ::safe::AliasFileSubcommand $child $subcommand } foreach subcommand { atime attributes copy delete executable exists isdirectory isfile link lstat mtime mkdir nativename normalize owned readable readlink rename size stat tempfile type volumes writable } { ::interp alias $child ::tcl::file::$subcommand {} \ ::safe::BadSubcommand $child file $subcommand } # Subcommands of info foreach {subcommand alias} { nameofexecutable AliasExeName } { ::interp alias $child ::tcl::info::$subcommand \ {} [namespace current]::$alias $child } # The allowed child variables already have been set by Tcl_MakeSafe(3) # Source init.tcl and tm.tcl into the child, to get auto_load and # other procedures defined: if {[catch {::interp eval $child { source [file join $tcl_library init.tcl] }} msg opt]} { Log $child "can't source init.tcl ($msg)" return -options $opt "can't source init.tcl into slave $child ($msg)" } if {[catch {::interp eval $child { source [file join $tcl_library tm.tcl] }} msg opt]} { Log $child "can't source tm.tcl ($msg)" return -options $opt "can't source tm.tcl into slave $child ($msg)" } # Sync the paths used to search for Tcl modules. This can be done only # now, after tm.tcl was loaded. namespace upvar ::safe [VarName $child] state if {[llength $state(tm_path_slave)] > 0} { ::interp eval $child [list \ ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] } return $child } # Add (only if needed, avoid duplicates) 1 level of sub directories to an # existing path list. Also removes non directories from the returned # list. proc ::safe::AddSubDirs {pathList} { set res {} foreach dir $pathList { if {[file isdirectory $dir]} { # check that we don't have it yet as a children of a previous # dir if {$dir ni $res} { lappend res $dir } foreach sub [glob -directory $dir -nocomplain *] { if {[file isdirectory $sub] && ($sub ni $res)} { # new sub dir, add it ! lappend res $sub } } } } return $res } # This procedure deletes a safe interpreter managed by Safe Tcl and cleans up # associated state. # - The command will also delete non-Safe-Base interpreters. # - This is regrettable, but to avoid breaking existing code this should be # amended at the next major revision by uncommenting "CheckInterp". proc ::safe::interpDelete {child} { Log $child "About to delete" NOTICE # CheckInterp $child namespace upvar ::safe [VarName $child] state # When an interpreter is deleted with [interp delete], any sub-interpreters # are deleted automatically, but this leaves behind their data in the Safe # Base. To clean up properly, we call safe::interpDelete recursively on each # Safe Base sub-interpreter, so each one is deleted cleanly and not by # the automatic mechanism built into [interp delete]. foreach sub [interp children $child] { if {[info exists ::safe::[VarName [list $child $sub]]]} { ::safe::interpDelete [list $child $sub] } } # If the child has a cleanup hook registered, call it. Check the # existence because we might be called to delete an interp which has # not been registered with us at all if {[info exists state(cleanupHook)]} { set hook $state(cleanupHook) if {[llength $hook]} { # remove the hook now, otherwise if the hook calls us somehow, # we'll loop unset state(cleanupHook) try { {*}$hook $child } on error err { Log $child "Delete hook error ($err)" } } } # Discard the global array of state associated with the child, and # delete the interpreter. if {[info exists state]} { unset state } # if we have been called twice, the interp might have been deleted # already if {[::interp exists $child]} { ::interp delete $child Log $child "Deleted" NOTICE } return } # Set (or get) the logging mechanism proc ::safe::setLogCmd {args} { variable Log set la [llength $args] if {$la == 0} { return $Log } elseif {$la == 1} { set Log [lindex $args 0] } else { set Log $args } if {$Log eq ""} { # Disable logging completely. Calls to it will be compiled out # of all users. proc ::safe::Log {args} {} } else { # Activate logging, define proper command. proc ::safe::Log {child msg {type ERROR}} { variable Log {*}$Log "$type for slave $child : $msg" return } } } # ------------------- END OF PUBLIC METHODS ------------ # # Sets the child auto_path to the parent recorded value. Also sets # tcl_library to the first token of the virtual path. # proc ::safe::SyncAccessPath {child} { namespace upvar ::safe [VarName $child] state set slave_access_path $state(access_path,slave) ::interp eval $child [list set auto_path $slave_access_path] Log $child "auto_path in $child has been set to $slave_access_path"\ NOTICE # This code assumes that info library is the first element in the # list of auto_path's. See -> InterpSetConfig for the code which # ensures this condition. ::interp eval $child [list \ set tcl_library [lindex $slave_access_path 0]] } # Returns the virtual token for directory number N. proc ::safe::PathToken {n} { # We need to have a ":" in the token string so [file join] on the # mac won't turn it into a relative path. return "\$p(:$n:)" ;# Form tested by case 7.2 } # # translate virtual path into real path # proc ::safe::TranslatePath {child path} { namespace upvar ::safe [VarName $child] state # somehow strip the namespaces 'functionality' out (the danger is that # we would strip valid macintosh "../" queries... : if {[string match "*::*" $path] || [string match "*..*" $path]} { return -code error "invalid characters in path $path" } # Use a cached map instead of computed local vars and subst. return [string map $state(access_path,map) $path] } # file name control (limit access to files/resources that should be a # valid tcl source file) proc ::safe::CheckFileName {child file} { # This used to limit what can be sourced to ".tcl" and forbid files # with more than 1 dot and longer than 14 chars, but I changed that # for 8.4 as a safe interp has enough internal protection already to # allow sourcing anything. - hobbs if {![file exists $file]} { # don't tell the file path return -code error "no such file or directory" } if {![file readable $file]} { # don't tell the file path return -code error "not readable" } } # AliasFileSubcommand handles selected subcommands of [file] in safe # interpreters that are *almost* safe. In particular, it just acts to # prevent discovery of what home directories exist. proc ::safe::AliasFileSubcommand {child subcommand name} { if {[string match ~* $name]} { set name ./$name } tailcall ::interp invokehidden $child tcl:file:$subcommand $name } # AliasGlob is the target of the "glob" alias in safe interpreters. proc ::safe::AliasGlob {child args} { Log $child "GLOB ! $args" NOTICE set cmd {} set at 0 array set got { -directory 0 -nocomplain 0 -join 0 -tails 0 -- 0 } if {$::tcl_platform(platform) eq "windows"} { set dirPartRE {^(.*)[\\/]([^\\/]*)$} } else { set dirPartRE {^(.*)/([^/]*)$} } set dir {} set virtualdir {} while {$at < [llength $args]} { switch -glob -- [set opt [lindex $args $at]] { -nocomplain - -- - -tails { lappend cmd $opt set got($opt) 1 incr at } -join { set got($opt) 1 incr at } -types - -type { lappend cmd -types [lindex $args [incr at]] incr at } -directory { if {$got($opt)} { return -code error \ {"-directory" cannot be used with "-path"} } set got($opt) 1 set virtualdir [lindex $args [incr at]] incr at } -* { Log $child "Safe base rejecting glob option '$opt'" return -code error "Safe base rejecting glob option '$opt'" } default { break } } if {$got(--)} break } # Get the real path from the virtual one and check that the path is in the # access path of that child. Done after basic argument processing so that # we know if -nocomplain is set. if {$got(-directory)} { try { set dir [TranslatePath $child $virtualdir] DirInAccessPath $child $dir } on error msg { Log $child $msg if {$got(-nocomplain)} return return -code error "permission denied" } if {$got(--)} { set cmd [linsert $cmd end-1 -directory $dir] } else { lappend cmd -directory $dir } } else { # The code after this "if ... else" block would conspire to return with # no results in this case, if it were allowed to proceed. Instead, # return now and reduce the number of cases to be considered later. Log $child {option -directory must be supplied} if {$got(-nocomplain)} return return -code error "permission denied" } # Apply the -join semantics ourselves. if {$got(-join)} { set args [lreplace $args $at end [join [lrange $args $at end] "/"]] } # Process the pattern arguments. If we've done a join there is only one # pattern argument. set firstPattern [llength $cmd] foreach opt [lrange $args $at end] { if {![regexp $dirPartRE $opt -> thedir thefile]} { set thedir . # The *.tm search comes here. } # "Special" treatment for (joined) argument {*/pkgIndex.tcl}. # Do the expansion of "*" here, and filter out any directories that are # not in the access path. The outcome is to lappend to cmd a path of # the form $virtualdir/subdir/pkgIndex.tcl for each subdirectory subdir, # after removing any subdir that are not in the access path. if {($thedir eq "*") && ($thefile eq "pkgIndex.tcl")} { set mapped 0 foreach d [glob -directory [TranslatePath $child $virtualdir] \ -types d -tails *] { catch { DirInAccessPath $child \ [TranslatePath $child [file join $virtualdir $d]] lappend cmd [file join $d $thefile] set mapped 1 } } if {$mapped} continue # Don't [continue] if */pkgIndex.tcl has no matches in the access # path. The pattern will now receive the same treatment as a # "non-special" pattern (and will fail because it includes a "*" in # the directory name). } # Any directory pattern that is not an exact (i.e. non-glob) match to a # directory in the access path will be rejected here. # - Rejections include any directory pattern that has glob matching # patterns "*", "?", backslashes, braces or square brackets, (UNLESS # it corresponds to a genuine directory name AND that directory is in # the access path). # - The only "special matching characters" that remain in patterns for # processing by glob are in the filename tail. # - [file join $anything ~${foo}] is ~${foo}, which is not an exact # match to any directory in the access path. Hence directory patterns # that begin with "~" are rejected here. Tests safe-16.[5-8] check # that "file join" remains as required and does not expand ~${foo}. # - Bug [3529949] relates to unwanted expansion of ~${foo} and this is # how the present code avoids the bug. All tests safe-16.* relate. try { DirInAccessPath $child [TranslatePath $child \ [file join $virtualdir $thedir]] } on error msg { Log $child $msg if {$got(-nocomplain)} continue return -code error "permission denied" } lappend cmd $opt } Log $child "GLOB = $cmd" NOTICE if {$got(-nocomplain) && [llength $cmd] eq $firstPattern} { return } try { # >>>>>>>>>> HERE'S THE CALL TO SAFE INTERP GLOB <<<<<<<<<< # - Pattern arguments added to cmd have NOT been translated from tokens. # Only the virtualdir is translated (to dir). # - In the pkgIndex.tcl case, there is no "*" in the pattern arguments, # which are a list of names each with tail pkgIndex.tcl. The purpose # of the call to glob is to remove the names for which the file does # not exist. set entries [::interp invokehidden $child glob {*}$cmd] } on error msg { # This is the only place that a call with -nocomplain and no invalid # "dash-options" can return an error. Log $child $msg return -code error "script error" } Log $child "GLOB < $entries" NOTICE # Translate path back to what the child should see. set res {} set l [string length $dir] foreach p $entries { if {[string equal -length $l $dir $p]} { set p [string replace $p 0 [expr {$l-1}] $virtualdir] } lappend res $p } Log $child "GLOB > $res" NOTICE return $res } # AliasSource is the target of the "source" alias in safe interpreters. proc ::safe::AliasSource {child args} { set argc [llength $args] # Extended for handling of Tcl Modules to allow not only "source # filename", but "source -encoding E filename" as well. if {[lindex $args 0] eq "-encoding"} { incr argc -2 set encoding [lindex $args 1] set at 2 if {$encoding eq "identity"} { Log $child "attempt to use the identity encoding" return -code error "permission denied" } } else { set at 0 set encoding {} } if {$argc != 1} { set msg "wrong # args: should be \"source ?-encoding E? fileName\"" Log $child "$msg ($args)" return -code error $msg } set file [lindex $args $at] # get the real path from the virtual one. if {[catch { set realfile [TranslatePath $child $file] } msg]} { Log $child $msg return -code error "permission denied" } # check that the path is in the access path of that child if {[catch { FileInAccessPath $child $realfile } msg]} { Log $child $msg return -code error "permission denied" } # Check that the filename exists and is readable. If it is not, deliver # this -errorcode so that caller in tclPkgUnknown does not write a message # to tclLog. Has no effect on other callers of ::source, which are in # "package ifneeded" scripts. if {[catch { CheckFileName $child $realfile } msg]} { Log $child "$realfile:$msg" return -code error -errorcode {POSIX EACCES} $msg } # Passed all the tests, lets source it. Note that we do this all manually # because we want to control [info script] in the child so information # doesn't leak so much. [Bug 2913625] set old [::interp eval $child {info script}] set replacementMsg "script error" set code [catch { set f [open $realfile] fconfigure $f -eofchar "\x1A {}" if {$encoding ne ""} { fconfigure $f -encoding $encoding } set contents [read $f] close $f ::interp eval $child [list info script $file] } msg opt] if {$code == 0} { set code [catch {::interp eval $child $contents} msg opt] set replacementMsg $msg } catch {interp eval $child [list info script $old]} # Note that all non-errors are fine result codes from [source], so we must # take a little care to do it properly. [Bug 2923613] if {$code == 1} { Log $child $msg return -code error $replacementMsg } return -code $code -options $opt $msg } # AliasLoad is the target of the "load" alias in safe interpreters. proc ::safe::AliasLoad {child file args} { set argc [llength $args] if {$argc > 2} { set msg "load error: too many arguments" Log $child "$msg ($argc) {$file $args}" return -code error $msg } # package name (can be empty if file is not). set package [lindex $args 0] namespace upvar ::safe [VarName $child] state # Determine where to load. load use a relative interp path and {} # means self, so we can directly and safely use passed arg. set target [lindex $args 1] if {$target ne ""} { # we will try to load into a sub sub interp; check that we want to # authorize that. if {!$state(nestedok)} { Log $child "loading to a sub interp (nestedok)\ disabled (trying to load $package to $target)" return -code error "permission denied (nested load)" } } # Determine what kind of load is requested if {$file eq ""} { # static package loading if {$package eq ""} { set msg "load error: empty filename and no package name" Log $child $msg return -code error $msg } if {!$state(staticsok)} { Log $child "static packages loading disabled\ (trying to load $package to $target)" return -code error "permission denied (static package)" } } else { # file loading # get the real path from the virtual one. try { set file [TranslatePath $child $file] } on error msg { Log $child $msg return -code error "permission denied" } # check the translated path try { FileInAccessPath $child $file } on error msg { Log $child $msg return -code error "permission denied (path)" } } try { return [::interp invokehidden $child load $file $package $target] } on error msg { # Some packages return no error message. set msg0 "load of binary library for package $package failed" if {$msg eq {}} { set msg $msg0 } else { set msg "$msg0: $msg" } Log $child $msg return -code error $msg } } # FileInAccessPath raises an error if the file is not found in the list of # directories contained in the (parent side recorded) child's access path. # the security here relies on "file dirname" answering the proper # result... needs checking ? proc ::safe::FileInAccessPath {child file} { namespace upvar ::safe [VarName $child] state set access_path $state(access_path) if {[file isdirectory $file]} { return -code error "\"$file\": is a directory" } set parent [file dirname $file] # Normalize paths for comparison since lsearch knows nothing of # potential pathname anomalies. set norm_parent [file normalize $parent] namespace upvar ::safe [VarName $child] state if {$norm_parent ni $state(access_path,norm)} { return -code error "\"$file\": not in access_path" } } proc ::safe::DirInAccessPath {child dir} { namespace upvar ::safe [VarName $child] state set access_path $state(access_path) if {[file isfile $dir]} { return -code error "\"$dir\": is a file" } # Normalize paths for comparison since lsearch knows nothing of # potential pathname anomalies. set norm_dir [file normalize $dir] namespace upvar ::safe [VarName $child] state if {$norm_dir ni $state(access_path,norm)} { return -code error "\"$dir\": not in access_path" } } # This procedure is used to report an attempt to use an unsafe member of an # ensemble command. proc ::safe::BadSubcommand {child command subcommand args} { set msg "not allowed to invoke subcommand $subcommand of $command" Log $child $msg return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg } # AliasEncoding is the target of the "encoding" alias in safe interpreters. proc ::safe::AliasEncoding {child option args} { # Note that [encoding dirs] is not supported in safe children at all set subcommands {convertfrom convertto names system} try { set option [tcl::prefix match -error [list -level 1 -errorcode \ [list TCL LOOKUP INDEX option $option]] $subcommands $option] # Special case: [encoding system] ok, but [encoding system foo] not if {$option eq "system" && [llength $args]} { return -code error -errorcode {TCL WRONGARGS} \ "wrong # args: should be \"encoding system\"" } } on error {msg options} { Log $child $msg return -options $options $msg } tailcall ::interp invokehidden $child encoding $option {*}$args } # Various minor hiding of platform features. [Bug 2913625] proc ::safe::AliasExeName {child} { return "" } # ------------------------------------------------------------------------------ # Using Interpreter Names with Namespace Qualifiers # ------------------------------------------------------------------------------ # (1) We wish to preserve compatibility with existing code, in which Safe Base # interpreter names have no namespace qualifiers. # (2) safe::interpCreate and the rest of the Safe Base previously could not # accept namespace qualifiers in an interpreter name. # (3) The interp command will accept namespace qualifiers in an interpreter # name, but accepts distinct interpreters that will have the same command # name (e.g. foo, ::foo, and :::foo) (bug 66c2e8c974). # (4) To satisfy these constraints, Safe Base interpreter names will be fully # qualified namespace names with no excess colons and with the leading "::" # omitted. # (5) Trailing "::" implies a namespace tail {}, which interp reads as {{}}. # Reject such names. # (6) We could: # (a) EITHER reject usable but non-compliant names (e.g. excess colons) in # interpCreate, interpInit; # (b) OR accept such names and then translate to a compliant name in every # command. # The problem with (b) is that the user will expect to use the name with the # interp command and will find that it is not recognised. # E.g "interpCreate ::foo" creates interpreter "foo", and the user's name # "::foo" works with all the Safe Base commands, but "interp eval ::foo" # fails. # So we choose (a). # (7) The command # namespace upvar ::safe S$child state # becomes # namespace upvar ::safe [VarName $child] state # ------------------------------------------------------------------------------ proc ::safe::RejectExcessColons {child} { set stripped [regsub -all -- {:::*} $child ::] if {[string range $stripped end-1 end] eq {::}} { return -code error {interpreter name must not end in "::"} } if {$stripped ne $child} { set msg {interpreter name has excess colons in namespace separators} return -code error $msg } if {[string range $stripped 0 1] eq {::}} { return -code error {interpreter name must not begin "::"} } return } proc ::safe::VarName {child} { # return S$child return S[string map {:: @N @ @A} $child] } proc ::safe::Setup {} { #### # # Setup the arguments parsing # #### # Share the descriptions set temp [::tcl::OptKeyRegister { {-accessPath -list {} "access path for the slave"} {-noStatics "prevent loading of statically linked pkgs"} {-statics true "loading of statically linked pkgs"} {-nestedLoadOk "allow nested loading"} {-nested false "nested loading"} {-deleteHook -script {} "delete hook"} }] # create case (slave is optional) ::tcl::OptKeyRegister { {?slave? -name {} "name of the slave (optional)"} } ::safe::interpCreate # adding the flags sub programs to the command program (relying on Opt's # internal implementation details) lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp) # init and configure (slave is needed) ::tcl::OptKeyRegister { {slave -name {} "name of the slave"} } ::safe::interpIC # adding the flags sub programs to the command program (relying on Opt's # internal implementation details) lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp) # temp not needed anymore ::tcl::OptKeyDelete $temp #### # # Default: No logging. # #### setLogCmd {} # Log eventually. # To enable error logging, set Log to {puts stderr} for instance, # via setLogCmd. return } namespace eval ::safe { # internal variables # Log command, set via 'setLogCmd'. Logging is disabled when empty. variable Log {} # The package maintains a state array per child interp under its # control. The name of this array is S. This array is # brought into scope where needed, using 'namespace upvar'. The S # prefix is used to avoid that a child interp called "Log" smashes # the "Log" variable. # # The array's elements are: # # access_path : List of paths accessible to the child. # access_path,norm : Ditto, in normalized form. # access_path,slave : Ditto, as the path tokens as seen by the child. # access_path,map : dict ( token -> path ) # access_path,remap : dict ( path -> token ) # tm_path_slave : List of TM root directories, as tokens seen by the child. # staticsok : Value of option -statics # nestedok : Value of option -nested # cleanupHook : Value of option -deleteHook } ::safe::Setup tcl8.6.14/library/tm.tcl0000644000175000017500000002706314554262142014442 0ustar sergeisergei# -*- tcl -*- # # Searching for Tcl Modules. Defines a procedure, declares it as the primary # command for finding packages, however also uses the former 'package unknown' # command as a fallback. # # Locates all possible packages in a directory via a less restricted glob. The # targeted directory is derived from the name of the requested package, i.e. # the TM scan will look only at directories which can contain the requested # package. It will register all packages it found in the directory so that # future requests have a higher chance of being fulfilled by the ifneeded # database without having to come to us again. # # We do not remember where we have been and simply rescan targeted directories # when invoked again. The reasoning is this: # # - The only way we get back to the same directory is if someone is trying to # [package require] something that wasn't there on the first scan. # # Either # 1) It is there now: If we rescan, you get it; if not you don't. # # This covers the possibility that the application asked for a package # late, and the package was actually added to the installation after the # application was started. It should still be able to find it. # # 2) It still is not there: Either way, you don't get it, but the rescan # takes time. This is however an error case and we don't care that much # about it # # 3) It was there the first time; but for some reason a "package forget" has # been run, and "package" doesn't know about it anymore. # # This can be an indication that the application wishes to reload some # functionality. And should work as well. # # Note that this also strikes a balance between doing a glob targeting a # single package, and thus most likely requiring multiple globs of the same # directory when the application is asking for many packages, and trying to # glob for _everything_ in all subdirectories when looking for a package, # which comes with a heavy startup cost. # # We scan for regular packages only if no satisfying module was found. namespace eval ::tcl::tm { # Default paths. None yet. variable paths {} # The regex pattern a file name has to match to make it a Tcl Module. set pkgpattern {^([_[:alpha:]][:_[:alnum:]]*)-([[:digit:]].*)[.]tm$} # Export the public API namespace export path namespace ensemble create -command path -subcommands {add remove list} } # ::tcl::tm::path implementations -- # # Public API to the module path. See specification. # # Arguments # cmd - The subcommand to execute # args - The paths to add/remove. Must not appear querying the # path with 'list'. # # Results # No result for subcommands 'add' and 'remove'. A list of paths for # 'list'. # # Side effects # The subcommands 'add' and 'remove' manipulate the list of paths to # search for Tcl Modules. The subcommand 'list' has no side effects. proc ::tcl::tm::add {args} { # PART OF THE ::tcl::tm::path ENSEMBLE # # The path is added at the head to the list of module paths. # # The command enforces the restriction that no path may be an ancestor # directory of any other path on the list. If the new path violates this # restriction an error will be raised. # # If the path is already present as is no error will be raised and no # action will be taken. variable paths # We use a copy of the path as source during validation, and extend it as # well. Because we not only have to detect if the new paths are bogus with # respect to the existing paths, but also between themselves. Otherwise we # can still add bogus paths, by specifying them in a single call. This # makes the use of the new paths simpler as well, a trivial assignment of # the collected paths to the official state var. set newpaths $paths foreach p $args { if {$p in $newpaths} { # Ignore a path already on the list. continue } # Search for paths which are subdirectories of the new one. If there # are any then the new path violates the restriction about ancestors. set pos [lsearch -glob $newpaths ${p}/*] # Cannot use "in", we need the position for the message. if {$pos >= 0} { return -code error \ "$p is ancestor of existing module path [lindex $newpaths $pos]." } # Now look for existing paths which are ancestors of the new one. This # reverse question forces us to loop over the existing paths, as each # element is the pattern, not the new path :( foreach ep $newpaths { if {[string match ${ep}/* $p]} { return -code error \ "$p is subdirectory of existing module path $ep." } } set newpaths [linsert $newpaths 0 $p] } # The validation of the input is complete and successful, and everything # in newpaths is either an old path, or added. We can now extend the # official list of paths, a simple assignment is sufficient. set paths $newpaths return } proc ::tcl::tm::remove {args} { # PART OF THE ::tcl::tm::path ENSEMBLE # # Removes the path from the list of module paths. The command is silently # ignored if the path is not on the list. variable paths foreach p $args { set pos [lsearch -exact $paths $p] if {$pos >= 0} { set paths [lreplace $paths $pos $pos] } } } proc ::tcl::tm::list {} { # PART OF THE ::tcl::tm::path ENSEMBLE variable paths return $paths } # ::tcl::tm::UnknownHandler -- # # Unknown handler for Tcl Modules, i.e. packages in module form. # # Arguments # original - Original [package unknown] procedure. # name - Name of desired package. # version - Version of desired package. Can be the # empty string. # exact - Either -exact or omitted. # # Name, version, and exact are used to determine satisfaction. The # original is called iff no satisfaction was achieved. The name is also # used to compute the directory to target in the search. # # Results # None. # # Side effects # May populate the package ifneeded database with additional provide # scripts. proc ::tcl::tm::UnknownHandler {original name args} { # Import the list of paths to search for packages in module form. # Import the pattern used to check package names in detail. variable paths variable pkgpattern # Without paths to search we can do nothing. (Except falling back to the # regular search). if {[llength $paths]} { set pkgpath [string map {:: /} $name] set pkgroot [file dirname $pkgpath] if {$pkgroot eq "."} { set pkgroot "" } # We don't remember a copy of the paths while looping. Tcl Modules are # unable to change the list while we are searching for them. This also # simplifies the loop, as we cannot get additional directories while # iterating over the list. A simple foreach is sufficient. set satisfied 0 foreach path $paths { if {![interp issafe] && ![file exists $path]} { continue } set currentsearchpath [file join $path $pkgroot] if {![interp issafe] && ![file exists $currentsearchpath]} { continue } set strip [llength [file split $path]] # Get the module files out of the subdirectories. # - Safe Base interpreters have a restricted "glob" command that # works in this case. # - The "catch" was essential when there was no safe glob and every # call in a safe interp failed; it is retained only for corner # cases in which the eventual call to glob returns an error. catch { # We always look for _all_ possible modules in the current # path, to get the max result out of the glob. foreach file [glob -nocomplain -directory $currentsearchpath *.tm] { set pkgfilename [join [lrange [file split $file] $strip end] ::] if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} { # Ignore everything not matching our pattern for # package names. continue } try { package vcompare $pkgversion 0 } on error {} { # Ignore everything where the version part is not # acceptable to "package vcompare". continue } if {([package ifneeded $pkgname $pkgversion] ne {}) && (![interp issafe]) } { # There's already a provide script registered for # this version of this package. Since all units of # code claiming to be the same version of the same # package ought to be identical, just stick with # the one we already have. # This does not apply to Safe Base interpreters because # the token-to-directory mapping may have changed. continue } # We have found a candidate, generate a "provide script" # for it, and remember it. Note that we are using ::list # to do this; locally [list] means something else without # the namespace specifier. # NOTE. When making changes to the format of the provide # command generated below CHECK that the 'LOCATE' # procedure in core file 'platform/shell.tcl' still # understands it, or, if not, update its implementation # appropriately. # # Right now LOCATE's implementation assumes that the path # of the package file is the last element in the list. package ifneeded $pkgname $pkgversion \ "[::list package provide $pkgname $pkgversion];[::list source -encoding utf-8 $file]" # We abort in this unknown handler only if we got a # satisfying candidate for the requested package. # Otherwise we still have to fallback to the regular # package search to complete the processing. if {($pkgname eq $name) && [package vsatisfies $pkgversion {*}$args]} { set satisfied 1 # We do not abort the loop, and keep adding provide # scripts for every candidate in the directory, just # remember to not fall back to the regular search # anymore. } } } } if {$satisfied} { return } } # Fallback to previous command, if existing. See comment above about # ::list... if {[llength $original]} { uplevel 1 $original [::linsert $args 0 $name] } } # ::tcl::tm::Defaults -- # # Determines the default search paths. # # Arguments # None # # Results # None. # # Side effects # May add paths to the list of defaults. proc ::tcl::tm::Defaults {} { global env tcl_platform regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor set exe [file normalize [info nameofexecutable]] # Note that we're using [::list], not [list] because [list] means # something other than [::list] in this namespace. roots [::list \ [file dirname [info library]] \ [file join [file dirname [file dirname $exe]] lib] \ ] if {$tcl_platform(platform) eq "windows"} { set sep ";" } else { set sep ":" } for {set n $minor} {$n >= 0} {incr n -1} { foreach ev [::list \ TCL${major}.${n}_TM_PATH \ TCL${major}_${n}_TM_PATH \ ] { if {![info exists env($ev)]} continue foreach p [split $env($ev) $sep] { path add $p } } } return } # ::tcl::tm::roots -- # # Public API to the module path. See specification. # # Arguments # paths - List of 'root' paths to derive search paths from. # # Results # No result. # # Side effects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { set px [file join $p ${major}.${n}] if {![interp issafe]} {set px [file normalize $px]} path add $px } set px [file join $p site-tcl] if {![interp issafe]} {set px [file normalize $px]} path add $px } return } # Initialization. Set up the default paths, then insert the new handler into # the chain. if {![interp issafe]} {::tcl::tm::Defaults} tcl8.6.14/library/word.tcl0000644000175000017500000001144114560736524014775 0ustar sergeisergei# word.tcl -- # # This file defines various procedures for computing word boundaries in # strings. This file is primarily needed so Tk text and entry widgets behave # properly for different platforms. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # The following variables are used to determine which characters are # interpreted as white space. if {$::tcl_platform(platform) eq "windows"} { # Windows style - any but a Unicode space char if {![info exists ::tcl_wordchars]} { set ::tcl_wordchars {\S} } if {![info exists ::tcl_nonwordchars]} { set ::tcl_nonwordchars {\s} } } else { # Motif style - any Unicode word char (number, letter, or underscore) if {![info exists ::tcl_wordchars]} { set ::tcl_wordchars {\w} } if {![info exists ::tcl_nonwordchars]} { set ::tcl_nonwordchars {\W} } } # Arrange for caches of the real matcher REs to be kept, which enables the REs # themselves to be cached for greater performance (and somewhat greater # clarity too). namespace eval ::tcl { variable WordBreakRE array set WordBreakRE {} proc UpdateWordBreakREs args { # Ignores the arguments global tcl_wordchars tcl_nonwordchars variable WordBreakRE # To keep the RE strings short... set letter $tcl_wordchars set space $tcl_nonwordchars set WordBreakRE(after) "$letter$space|$space$letter" set WordBreakRE(before) "^.*($letter$space|$space$letter)" set WordBreakRE(end) "$space*$letter+$space" set WordBreakRE(next) "$letter*$space+$letter" set WordBreakRE(previous) "$space*($letter+)$space*\$" } # Initialize the cache UpdateWordBreakREs trace add variable ::tcl_wordchars write ::tcl::UpdateWordBreakREs trace add variable ::tcl_nonwordchars write ::tcl::UpdateWordBreakREs } # tcl_wordBreakAfter -- # # This procedure returns the index of the first word boundary after the # starting point in the given string, or -1 if there are no more boundaries in # the given string. The index returned refers to the first character of the # pair that comprises a boundary. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_wordBreakAfter {str start} { variable ::tcl::WordBreakRE set result {-1 -1} regexp -indices -start $start -- $WordBreakRE(after) $str result return [lindex $result 1] } # tcl_wordBreakBefore -- # # This procedure returns the index of the first word boundary before the # starting point in the given string, or -1 if there are no more boundaries in # the given string. The index returned refers to the second character of the # pair that comprises a boundary. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_wordBreakBefore {str start} { variable ::tcl::WordBreakRE set result {-1 -1} regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result return [lindex $result 1] } # tcl_endOfWord -- # # This procedure returns the index of the first end-of-word location after a # starting index in the given string. An end-of-word location is defined to be # the first whitespace character following the first non-whitespace character # after the starting point. Returns -1 if there are no more words after the # starting point. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_endOfWord {str start} { variable ::tcl::WordBreakRE set result {-1 -1} regexp -indices -start $start -- $WordBreakRE(end) $str result return [lindex $result 1] } # tcl_startOfNextWord -- # # This procedure returns the index of the first start-of-word location after a # starting index in the given string. A start-of-word location is defined to # be a non-whitespace character following a whitespace character. Returns -1 # if there are no more start-of-word locations after the starting point. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_startOfNextWord {str start} { variable ::tcl::WordBreakRE set result {-1 -1} regexp -indices -start $start -- $WordBreakRE(next) $str result return [lindex $result 1] } # tcl_startOfPreviousWord -- # # This procedure returns the index of the first start-of-word location before # a starting index in the given string. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_startOfPreviousWord {str start} { variable ::tcl::WordBreakRE set word {-1 -1} if {$start > 0} { regexp -indices -- $WordBreakRE(previous) [string range [string range $str 0 $start] 0 end-1] \ result word } return [lindex $word 0] } tcl8.6.14/library/tclIndex0000644000175000017500000001275514560736524015024 0ustar sergeisergei# Tcl autoload index file, version 2.0 # -*- tcl -*- # This file is generated by the "auto_mkindex" command # and sourced to set up indexing information for one or # more commands. Typically each line is a command that # sets an element in the auto_index array, where the # element name is the name of a command and the value is # a script that loads the command. set auto_index(auto_reset) [list source [file join $dir auto.tcl]] set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]] set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]] set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]] set auto_index(history) [list source [file join $dir history.tcl]] set auto_index(::tcl::history) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]] set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]] set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]] set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]] set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]] set auto_index(::pkg::create) [list source [file join $dir package.tcl]] set auto_index(parray) [list source [file join $dir parray.tcl]] set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]] set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]] set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]] set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]] set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]] set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]] set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]] set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]] set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]] set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]] set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]] set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]] set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]] set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]] set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]] set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]] set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]] set auto_index(::safe::Log) [list source [file join $dir safe.tcl]] set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]] set auto_index(::safe::AliasGlob) [list source [file join $dir safe.tcl]] set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]] set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]] set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]] set auto_index(::safe::DirInAccessPath) [list source [file join $dir safe.tcl]] set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]] set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]] set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]] set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]] set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]] set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]] set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]] set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]] set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]] if {[namespace exists ::tcl::unsupported]} { set auto_index(timerate) {namespace import ::tcl::unsupported::timerate} } tcl8.6.14/library/http1.0/0000755000175000017500000000000014566153412014506 5ustar sergeisergeitcl8.6.14/library/http1.0/http.tcl0000644000175000017500000002273114554262142016174 0ustar sergeisergei# http.tcl # Client-side HTTP for GET, POST, and HEAD commands. # These routines can be used in untrusted code that uses the Safesock # security policy. # These procedures use a callback interface to avoid using vwait, # which is not defined in the safe base. # # See the http.n man page for documentation package provide http 1.0 array set http { -accept */* -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0} -proxyfilter httpProxyRequired } proc http_config {args} { global http set options [lsort [array names http -*]] set usage [join $options ", "] if {[llength $args] == 0} { set result {} foreach name $options { lappend result $name $http($name) } return $result } regsub -all -- - $options {} options set pat ^-([join $options |])$ if {[llength $args] == 1} { set flag [lindex $args 0] if {[regexp -- $pat $flag]} { return $http($flag) } else { return -code error "Unknown option $flag, must be: $usage" } } else { foreach {flag value} $args { if {[regexp -- $pat $flag]} { set http($flag) $value } else { return -code error "Unknown option $flag, must be: $usage" } } } } proc httpFinish { token {errormsg ""} } { upvar #0 $token state global errorInfo errorCode if {[string length $errormsg] != 0} { set state(error) [list $errormsg $errorInfo $errorCode] set state(status) error } catch {close $state(sock)} catch {after cancel $state(after)} if {[info exists state(-command)]} { if {[catch {eval $state(-command) {$token}} err]} { if {[string length $errormsg] == 0} { set state(error) [list $err $errorInfo $errorCode] set state(status) error } } unset state(-command) } } proc http_reset { token {why reset} } { upvar #0 $token state set state(status) $why catch {fileevent $state(sock) readable {}} httpFinish $token if {[info exists state(error)]} { set errorlist $state(error) unset state(error) eval error $errorlist } } proc http_get { url args } { global http if {![info exists http(uid)]} { set http(uid) 0 } set token http#[incr http(uid)] upvar #0 $token state http_reset $token array set state { -blocksize 8192 -validate 0 -headers {} -timeout 0 state header meta {} currentsize 0 totalsize 0 type text/html body {} status "" } set options {-blocksize -channel -command -handler -headers \ -progress -query -validate -timeout} set usage [join $options ", "] regsub -all -- - $options {} options set pat ^-([join $options |])$ foreach {flag value} $args { if {[regexp $pat $flag]} { # Validate numbers if {[info exists state($flag)] && \ [regexp {^[0-9]+$} $state($flag)] && \ ![regexp {^[0-9]+$} $value]} { return -code error "Bad value for $flag ($value), must be integer" } set state($flag) $value } else { return -code error "Unknown option $flag, can be: $usage" } } if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \ x proto host y port srvurl]} { error "Unsupported URL: $url" } if {[string length $port] == 0} { set port 80 } if {[string length $srvurl] == 0} { set srvurl / } if {[string length $proto] == 0} { set url http://$url } set state(url) $url if {![catch {$http(-proxyfilter) $host} proxy]} { set phost [lindex $proxy 0] set pport [lindex $proxy 1] } if {$state(-timeout) > 0} { set state(after) [after $state(-timeout) [list http_reset $token timeout]] } if {[info exists phost] && [string length $phost]} { set srvurl $url set s [socket $phost $pport] } else { set s [socket $host $port] } set state(sock) $s # Send data in cr-lf format, but accept any line terminators fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize) # The following is disallowed in safe interpreters, but the socket # is already in non-blocking mode in that case. catch {fconfigure $s -blocking off} set len 0 set how GET if {[info exists state(-query)]} { set len [string length $state(-query)] if {$len > 0} { set how POST } } elseif {$state(-validate)} { set how HEAD } puts $s "$how $srvurl HTTP/1.0" puts $s "Accept: $http(-accept)" puts $s "Host: $host" puts $s "User-Agent: $http(-useragent)" foreach {key value} $state(-headers) { regsub -all \[\n\r\] $value {} value set key [string trim $key] if {[string length $key]} { puts $s "$key: $value" } } if {$len > 0} { puts $s "Content-Length: $len" puts $s "Content-Type: application/x-www-form-urlencoded" puts $s "" fconfigure $s -translation {auto binary} puts -nonewline $s $state(-query) } else { puts $s "" } flush $s fileevent $s readable [list httpEvent $token] if {! [info exists state(-command)]} { http_wait $token } return $token } proc http_data {token} { upvar #0 $token state return $state(body) } proc http_status {token} { upvar #0 $token state return $state(status) } proc http_code {token} { upvar #0 $token state return $state(http) } proc http_size {token} { upvar #0 $token state return $state(currentsize) } proc httpEvent {token} { upvar #0 $token state set s $state(sock) if {[eof $s]} { httpEof $token return } if {$state(state) == "header"} { set n [gets $s line] if {$n == 0} { set state(state) body if {![regexp -nocase ^text $state(type)]} { # Turn off conversions for non-text data fconfigure $s -translation binary if {[info exists state(-channel)]} { fconfigure $state(-channel) -translation binary } } if {[info exists state(-channel)] && ![info exists state(-handler)]} { # Initiate a sequence of background fcopies fileevent $s readable {} httpCopyStart $s $token } } elseif {$n > 0} { if {[regexp -nocase {^content-type:(.+)$} $line x type]} { set state(type) [string trim $type] } if {[regexp -nocase {^content-length:(.+)$} $line x length]} { set state(totalsize) [string trim $length] } if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} { lappend state(meta) $key $value } elseif {[regexp ^HTTP $line]} { set state(http) $line } } } else { if {[catch { if {[info exists state(-handler)]} { set n [eval $state(-handler) {$s $token}] } else { set block [read $s $state(-blocksize)] set n [string length $block] if {$n >= 0} { append state(body) $block } } if {$n >= 0} { incr state(currentsize) $n } } err]} { httpFinish $token $err } else { if {[info exists state(-progress)]} { eval $state(-progress) {$token $state(totalsize) $state(currentsize)} } } } } proc httpCopyStart {s token} { upvar #0 $token state if {[catch { fcopy $s $state(-channel) -size $state(-blocksize) -command \ [list httpCopyDone $token] } err]} { httpFinish $token $err } } proc httpCopyDone {token count {error {}}} { upvar #0 $token state set s $state(sock) incr state(currentsize) $count if {[info exists state(-progress)]} { eval $state(-progress) {$token $state(totalsize) $state(currentsize)} } if {([string length $error] != 0)} { httpFinish $token $error } elseif {[eof $s]} { httpEof $token } else { httpCopyStart $s $token } } proc httpEof {token} { upvar #0 $token state if {$state(state) == "header"} { # Premature eof set state(status) eof } else { set state(status) ok } set state(state) eof httpFinish $token } proc http_wait {token} { upvar #0 $token state if {![info exists state(status)] || [string length $state(status)] == 0} { vwait $token\(status) } if {[info exists state(error)]} { set errorlist $state(error) unset state(error) eval error $errorlist } return $state(status) } # Call http_formatQuery with an even number of arguments, where the first is # a name, the second is a value, the third is another name, and so on. proc http_formatQuery {args} { set result "" set sep "" foreach i $args { append result $sep [httpMapReply $i] if {$sep != "="} { set sep = } else { set sep & } } return $result } # do x-www-urlencoded character mapping # The spec says: "non-alphanumeric characters are replaced by '%HH'" # 1 leave alphanumerics characters alone # 2 Convert every other character to an array lookup # 3 Escape constructs that are "special" to the tcl parser # 4 "subst" the result, doing all the array substitutions proc httpMapReply {string} { global httpFormMap set alphanumeric a-zA-Z0-9 if {![info exists httpFormMap]} { for {set i 1} {$i <= 256} {incr i} { set c [format %c $i] if {![string match \[$alphanumeric\] $c]} { set httpFormMap($c) %[format %.2x $i] } } # These are handled specially array set httpFormMap { " " + \n %0d%0a } } regsub -all \[^$alphanumeric\] $string {$httpFormMap(&)} string regsub -all \n $string {\\n} string regsub -all \t $string {\\t} string regsub -all {[][{})\\]\)} $string {\\&} string return [subst $string] } # Default proxy filter. proc httpProxyRequired {host} { global http if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} { if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} { set http(-proxyport) 8080 } return [list $http(-proxyhost) $http(-proxyport)] } else { return {} } } tcl8.6.14/library/http1.0/pkgIndex.tcl0000644000175000017500000000133714554262142016765 0ustar sergeisergei# Tcl package index file, version 1.0 # This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. package ifneeded http 1.0 [list tclPkgSetup $dir http 1.0 {{http.tcl source {httpCopyDone httpCopyStart httpEof httpEvent httpFinish httpMapReply httpProxyRequired http_code http_config http_data http_formatQuery http_get http_reset http_size http_status http_wait}}}] tcl8.6.14/library/http/0000755000175000017500000000000014566153412014267 5ustar sergeisergeitcl8.6.14/library/http/http.tcl0000644000175000017500000034020214554262142015751 0ustar sergeisergei# http.tcl -- # # Client-side HTTP for GET, POST, and HEAD commands. These routines can # be used in untrusted code that uses the Safesock security policy. # These procedures use a callback interface to avoid using vwait, which # is not defined in the safe base. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.9.8 namespace eval http { # Allow resourcing to not clobber existing data variable http if {![info exists http]} { array set http { -accept */* -pipeline 1 -postfresh 0 -proxyhost {} -proxyport {} -proxyfilter http::ProxyRequired -repost 0 -urlencoding utf-8 -zip 1 } # We need a useragent string of this style or various servers will # refuse to send us compressed content even when we ask for it. This # follows the de-facto layout of user-agent strings in current browsers. # Safe interpreters do not have ::tcl_platform(os) or # ::tcl_platform(osVersion). if {[interp issafe]} { set http(-useragent) "Mozilla/5.0\ (Windows; U;\ Windows NT 10.0)\ http/[package provide http] Tcl/[package provide Tcl]" } else { set http(-useragent) "Mozilla/5.0\ ([string totitle $::tcl_platform(platform)]; U;\ $::tcl_platform(os) $::tcl_platform(osVersion))\ http/[package provide http] Tcl/[package provide Tcl]" } } proc init {} { # Set up the map for quoting chars. RFC3986 Section 2.3 say percent # encode all except: "... percent-encoded octets in the ranges of # ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period # (%2E), underscore (%5F), or tilde (%7E) should not be created by URI # producers ..." for {set i 0} {$i <= 256} {incr i} { set c [format %c $i] if {![string match {[-._~a-zA-Z0-9]} $c]} { set map($c) %[format %.2X $i] } } # These are handled specially set map(\n) %0D%0A variable formMap [array get map] # Create a map for HTTP/1.1 open sockets variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd if {[info exists socketMapping]} { # Close open sockets on re-init. Do not permit retries. foreach {url sock} [array get socketMapping] { unset -nocomplain socketClosing($url) unset -nocomplain socketPlayCmd($url) CloseSocket $sock } } # CloseSocket should have unset the socket* arrays, one element at # a time. Now unset anything that was overlooked. # Traces on "unset socketRdState(*)" will call CancelReadPipeline and # cancel any queued responses. # Traces on "unset socketWrState(*)" will call CancelWritePipeline and # cancel any queued requests. array unset socketMapping array unset socketRdState array unset socketWrState array unset socketRdQueue array unset socketWrQueue array unset socketClosing array unset socketPlayCmd array set socketMapping {} array set socketRdState {} array set socketWrState {} array set socketRdQueue {} array set socketWrQueue {} array set socketClosing {} array set socketPlayCmd {} } init variable urlTypes if {![info exists urlTypes]} { set urlTypes(http) [list 80 ::socket] } variable encodings [string tolower [encoding names]] # This can be changed, but iso8859-1 is the RFC standard. variable defaultCharset if {![info exists defaultCharset]} { set defaultCharset "iso8859-1" } # Force RFC 3986 strictness in geturl url verification? variable strict if {![info exists strict]} { set strict 1 } # Let user control default keepalive for compatibility variable defaultKeepalive if {![info exists defaultKeepalive]} { set defaultKeepalive 0 } namespace export geturl config reset wait formatQuery quoteString namespace export register unregister registerError # - Useful, but not exported: data, size, status, code, cleanup, error, # meta, ncode, mapReply, init. Comments suggest that "init" can be used # for re-initialisation, although the command is undocumented. # - Not exported, probably should be upper-case initial letter as part # of the internals: getTextLine, make-transformation-chunked. } # http::Log -- # # Debugging output -- define this to observe HTTP/1.1 socket usage. # Should echo any args received. # # Arguments: # msg Message to output # if {[info command http::Log] eq {}} {proc http::Log {args} {}} # http::register -- # # See documentation for details. # # Arguments: # proto URL protocol prefix, e.g. https # port Default port for protocol # command Command to use to create socket # Results: # list of port and command that was registered. proc http::register {proto port command} { variable urlTypes set urlTypes([string tolower $proto]) [list $port $command] } # http::unregister -- # # Unregisters URL protocol handler # # Arguments: # proto URL protocol prefix, e.g. https # Results: # list of port and command that was unregistered. proc http::unregister {proto} { variable urlTypes set lower [string tolower $proto] if {![info exists urlTypes($lower)]} { return -code error "unsupported url type \"$proto\"" } set old $urlTypes($lower) unset urlTypes($lower) return $old } # http::config -- # # See documentation for details. # # Arguments: # args Options parsed by the procedure. # Results: # TODO proc http::config {args} { variable http set options [lsort [array names http -*]] set usage [join $options ", "] if {[llength $args] == 0} { set result {} foreach name $options { lappend result $name $http($name) } return $result } set options [string map {- ""} $options] set pat ^-(?:[join $options |])$ if {[llength $args] == 1} { set flag [lindex $args 0] if {![regexp -- $pat $flag]} { return -code error "Unknown option $flag, must be: $usage" } return $http($flag) } else { foreach {flag value} $args { if {![regexp -- $pat $flag]} { return -code error "Unknown option $flag, must be: $usage" } set http($flag) $value } } } # http::Finish -- # # Clean up the socket and eval close time callbacks # # Arguments: # token Connection token. # errormsg (optional) If set, forces status to error. # skipCB (optional) If set, don't call the -command callback. This # is useful when geturl wants to throw an exception instead # of calling the callback. That way, the same error isn't # reported to two places. # # Side Effects: # May close the socket. proc http::Finish {token {errormsg ""} {skipCB 0}} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0 $token state global errorInfo errorCode set closeQueue 0 if {$errormsg ne ""} { set state(error) [list $errormsg $errorInfo $errorCode] set state(status) "error" } if {[info commands ${token}EventCoroutine] ne {}} { rename ${token}EventCoroutine {} } # Is this an upgrade request/response? set upgradeResponse \ [expr { [info exists state(upgradeRequest)] && $state(upgradeRequest) && [info exists state(http)] && [ncode $token] eq {101} && [info exists state(connection)] && "upgrade" in $state(connection) && [info exists state(upgrade)] && "" ne $state(upgrade)}] if { ($state(status) eq "timeout") || ($state(status) eq "error") || ($state(status) eq "eof") } { set closeQueue 1 set connId $state(socketinfo) set sock $state(sock) CloseSocket $state(sock) $token } elseif {$upgradeResponse} { # Special handling for an upgrade request/response. # - geturl ensures that this is not a "persistent" socket used for # multiple HTTP requests, so a call to KeepSocket is not needed. # - Leave socket open, so a call to CloseSocket is not needed either. # - Remove fileevent bindings. The caller will set its own bindings. # - THE CALLER MUST PROCESS THE UPGRADED SOCKET IN THE CALLBACK COMMAND # PASSED TO http::geturl AS -command callback. catch {fileevent $state(sock) readable {}} catch {fileevent $state(sock) writable {}} } elseif { ([info exists state(-keepalive)] && !$state(-keepalive)) || ([info exists state(connection)] && ("close" in $state(connection))) } { set closeQueue 1 set connId $state(socketinfo) set sock $state(sock) CloseSocket $state(sock) $token } elseif { ([info exists state(-keepalive)] && $state(-keepalive)) && ([info exists state(connection)] && ("close" ni $state(connection))) } { KeepSocket $token } if {[info exists state(after)]} { after cancel $state(after) unset state(after) } if {[info exists state(-command)] && (!$skipCB) && (![info exists state(done-command-cb)])} { set state(done-command-cb) yes if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} { set state(error) [list $err $errorInfo $errorCode] set state(status) error } } if { $closeQueue && [info exists socketMapping($connId)] && ($socketMapping($connId) eq $sock) } { http::CloseQueuedQueries $connId $token } } # http::KeepSocket - # # Keep a socket in the persistent sockets table and connect it to its next # queued task if possible. Otherwise leave it idle and ready for its next # use. # # If $socketClosing(*), then ("close" in $state(connection)) and therefore # this command will not be called by Finish. # # Arguments: # token Connection token. proc http::KeepSocket {token} { variable http variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0 $token state set tk [namespace tail $token] # Keep this socket open for another request ("Keep-Alive"). # React if the server half-closes the socket. # Discussion is in http::geturl. catch {fileevent $state(sock) readable [list http::CheckEof $state(sock)]} # The line below should not be changed in production code. # It is edited by the test suite. set TEST_EOF 0 if {$TEST_EOF} { # ONLY for testing reaction to server eof. # No server timeouts will be caught. catch {fileevent $state(sock) readable {}} } if { [info exists state(socketinfo)] && [info exists socketMapping($state(socketinfo))] } { set connId $state(socketinfo) # The value "Rready" is set only here. set socketRdState($connId) Rready if { $state(-pipeline) && [info exists socketRdQueue($connId)] && [llength $socketRdQueue($connId)] } { # The usual case for pipelined responses - if another response is # queued, arrange to read it. set token3 [lindex $socketRdQueue($connId) 0] set socketRdQueue($connId) [lrange $socketRdQueue($connId) 1 end] variable $token3 upvar 0 $token3 state3 set tk2 [namespace tail $token3] #Log pipelined, GRANT read access to $token3 in KeepSocket set socketRdState($connId) $token3 ReceiveResponse $token3 # Other pipelined cases. # - The test above ensures that, for the pipelined cases in the two # tests below, the read queue is empty. # - In those two tests, check whether the next write will be # nonpipeline. } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "peNding") && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && (![set token3 [lindex $socketWrQueue($connId) 0] set ${token3}(-pipeline) ] ) } { # This case: # - Now it the time to run the "pending" request. # - The next token in the write queue is nonpipeline, and # socketWrState has been marked "pending" (in # http::NextPipelinedWrite or http::geturl) so a new pipelined # request cannot jump the queue. # # Tests: # - In this case the read queue (tested above) is empty and this # "pending" write token is in front of the rest of the write # queue. # - The write state is not Wready and therefore appears to be busy, # but because it is "pending" we know that it is reserved for the # first item in the write queue, a non-pipelined request that is # waiting for the read queue to empty. That has now happened: so # give that request read and write access. variable $token3 set conn [set ${token3}(tmpConnArgs)] #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket set socketRdState($connId) $token3 set socketWrState($connId) $token3 set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent $state(sock) writable [list http::Connect $token3 {*}$conn] #Log ---- $state(sock) << conn to $token3 for HTTP request (c) } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "peNding") } { # Should not come here. The second block in the previous "elseif" # test should be tautologous (but was needed in an earlier # implementation) and will be removed after testing. # If we get here, the value "pending" was assigned in error. # This error would block the queue for ever. Log ^X$tk <<<<< Error in queueing of requests >>>>> - token $token } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "Wready") && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && (![set token3 [lindex $socketWrQueue($connId) 0] set ${token3}(-pipeline) ] ) } { # This case: # - The next token in the write queue is nonpipeline, and # socketWrState is Wready. Get the next event from socketWrQueue. # Tests: # - In this case the read state (tested above) is Rready and the # write state (tested here) is Wready - there is no "pending" # request. # Code: # - The code is the same as the code below for the nonpipelined # case with a queued request. variable $token3 set conn [set ${token3}(tmpConnArgs)] #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket set socketRdState($connId) $token3 set socketWrState($connId) $token3 set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent $state(sock) writable [list http::Connect $token3 {*}$conn] #Log ---- $state(sock) << conn to $token3 for HTTP request (c) } elseif { (!$state(-pipeline)) && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && ("close" ni $state(connection)) } { # If not pipelined, (socketRdState eq Rready) tells us that we are # ready for the next write - there is no need to check # socketWrState. Write the next request, if one is waiting. # If the next request is pipelined, it receives premature read # access to the socket. This is not a problem. set token3 [lindex $socketWrQueue($connId) 0] variable $token3 set conn [set ${token3}(tmpConnArgs)] #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket set socketRdState($connId) $token3 set socketWrState($connId) $token3 set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent $state(sock) writable [list http::Connect $token3 {*}$conn] #Log ---- $state(sock) << conn to $token3 for HTTP request (d) } elseif {(!$state(-pipeline))} { set socketWrState($connId) Wready # Rready and Wready and idle: nothing to do. } } else { CloseSocket $state(sock) $token # There is no socketMapping($state(socketinfo)), so it does not matter # that CloseQueuedQueries is not called. } } # http::CheckEof - # # Read from a socket and close it if eof. # The command is bound to "fileevent readable" on an idle socket, and # "eof" is the only event that should trigger the binding, occurring when # the server times out and half-closes the socket. # # A read is necessary so that [eof] gives a meaningful result. # Any bytes sent are junk (or a bug). proc http::CheckEof {sock} { set junk [read $sock] set n [string length $junk] if {$n} { Log "WARNING: $n bytes received but no HTTP request sent" } if {[catch {eof $sock} res] || $res} { # The server has half-closed the socket. # If a new write has started, its transaction will fail and # will then be error-handled. CloseSocket $sock } } # http::CloseSocket - # # Close a socket and remove it from the persistent sockets table. If # possible an http token is included here but when we are called from a # fileevent on remote closure we need to find the correct entry - hence # the "else" block of the first "if" command. proc http::CloseSocket {s {token {}}} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd set tk [namespace tail $token] catch {fileevent $s readable {}} set connId {} if {$token ne ""} { variable $token upvar 0 $token state if {[info exists state(socketinfo)]} { set connId $state(socketinfo) } } else { set map [array get socketMapping] set ndx [lsearch -exact $map $s] if {$ndx >= 0} { incr ndx -1 set connId [lindex $map $ndx] } } if { ($connId ne {}) && [info exists socketMapping($connId)] && ($socketMapping($connId) eq $s) } { Log "Closing connection $connId (sock $socketMapping($connId))" if {[catch {close $socketMapping($connId)} err]} { Log "Error closing connection: $err" } if {$token eq {}} { # Cases with a non-empty token are handled by Finish, so the tokens # are finished in connection order. http::CloseQueuedQueries $connId } } else { Log "Closing socket $s (no connection info)" if {[catch {close $s} err]} { Log "Error closing socket: $err" } } } # http::CloseQueuedQueries # # connId - identifier "domain:port" for the connection # token - (optional) used only for logging # # Called from http::CloseSocket and http::Finish, after a connection is closed, # to clear the read and write queues if this has not already been done. proc http::CloseQueuedQueries {connId {token {}}} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd if {![info exists socketMapping($connId)]} { # Command has already been called. # Don't come here again - especially recursively. return } # Used only for logging. if {$token eq {}} { set tk {} } else { set tk [namespace tail $token] } if { [info exists socketPlayCmd($connId)] && ($socketPlayCmd($connId) ne {ReplayIfClose Wready {} {}}) } { # Before unsetting, there is some unfinished business. # - If the server sent "Connection: close", we have stored the command # for retrying any queued requests in socketPlayCmd, so copy that # value for execution below. socketClosing(*) was also set. # - Also clear the queues to prevent calls to Finish that would set the # state for the requests that will be retried to "finished with error # status". set unfinished $socketPlayCmd($connId) set socketRdQueue($connId) {} set socketWrQueue($connId) {} } else { set unfinished {} } Unset $connId if {$unfinished ne {}} { Log ^R$tk Any unfinished transactions (excluding $token) failed \ - token $token {*}$unfinished } } # http::Unset # # The trace on "unset socketRdState(*)" will call CancelReadPipeline # and cancel any queued responses. # The trace on "unset socketWrState(*)" will call CancelWritePipeline # and cancel any queued requests. proc http::Unset {connId} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd unset socketMapping($connId) unset socketRdState($connId) unset socketWrState($connId) unset -nocomplain socketRdQueue($connId) unset -nocomplain socketWrQueue($connId) unset -nocomplain socketClosing($connId) unset -nocomplain socketPlayCmd($connId) } # http::reset -- # # See documentation for details. # # Arguments: # token Connection token. # why Status info. # # Side Effects: # See Finish proc http::reset {token {why reset}} { variable $token upvar 0 $token state set state(status) $why catch {fileevent $state(sock) readable {}} catch {fileevent $state(sock) writable {}} Finish $token if {[info exists state(error)]} { set errorlist $state(error) unset state eval ::error $errorlist } } # http::geturl -- # # Establishes a connection to a remote url via http. # # Arguments: # url The http URL to goget. # args Option value pairs. Valid options include: # -blocksize, -validate, -headers, -timeout # Results: # Returns a token for this connection. This token is the name of an # array that the caller should unset to garbage collect the state. proc http::geturl {url args} { variable http variable urlTypes variable defaultCharset variable defaultKeepalive variable strict # Initialize the state variable, an array. We'll return the name of this # array as the token for the transaction. if {![info exists http(uid)]} { set http(uid) 0 } set token [namespace current]::[incr http(uid)] ##Log Starting http::geturl - token $token variable $token upvar 0 $token state set tk [namespace tail $token] reset $token Log ^A$tk URL $url - token $token # Process command options. array set state { -binary false -blocksize 8192 -queryblocksize 8192 -validate 0 -headers {} -timeout 0 -type application/x-www-form-urlencoded -queryprogress {} -protocol 1.1 binary 0 state created meta {} method {} coding {} currentsize 0 totalsize 0 querylength 0 queryoffset 0 type text/html body {} status "" http "" connection keep-alive } set state(-keepalive) $defaultKeepalive set state(-strict) $strict # These flags have their types verified [Bug 811170] array set type { -binary boolean -blocksize integer -queryblocksize integer -strict boolean -timeout integer -validate boolean -headers list } set state(charset) $defaultCharset set options { -binary -blocksize -channel -command -handler -headers -keepalive -method -myaddr -progress -protocol -query -queryblocksize -querychannel -queryprogress -strict -timeout -type -validate } set usage [join [lsort $options] ", "] set options [string map {- ""} $options] set pat ^-(?:[join $options |])$ foreach {flag value} $args { if {[regexp -- $pat $flag]} { # Validate numbers if { [info exists type($flag)] && (![string is $type($flag) -strict $value]) } { unset $token return -code error \ "Bad value for $flag ($value), must be $type($flag)" } if {($flag eq "-headers") && ([llength $value] % 2 != 0)} { unset $token return -code error \ "Bad value for $flag ($value), number of list elements must be even" } set state($flag) $value } else { unset $token return -code error "Unknown option $flag, can be: $usage" } } # Make sure -query and -querychannel aren't both specified set isQueryChannel [info exists state(-querychannel)] set isQuery [info exists state(-query)] if {$isQuery && $isQueryChannel} { unset $token return -code error "Can't combine -query and -querychannel options!" } # Validate URL, determine the server host and port, and check proxy case # Recognize user:pass@host URLs also, although we do not do anything with # that info yet. # URLs have basically four parts. # First, before the colon, is the protocol scheme (e.g. http) # Second, for HTTP-like protocols, is the authority # The authority is preceded by // and lasts up to (but not including) # the following / or ? and it identifies up to four parts, of which # only one, the host, is required (if an authority is present at all). # All other parts of the authority (user name, password, port number) # are optional. # Third is the resource name, which is split into two parts at a ? # The first part (from the single "/" up to "?") is the path, and the # second part (from that "?" up to "#") is the query. *HOWEVER*, we do # not need to separate them; we send the whole lot to the server. # Both, path and query are allowed to be missing, including their # delimiting character. # Fourth is the fragment identifier, which is everything after the first # "#" in the URL. The fragment identifier MUST NOT be sent to the server # and indeed, we don't bother to validate it (it could be an error to # pass it in here, but it's cheap to strip). # # An example of a URL that has all the parts: # # http://jschmoe:xyzzy@www.bogus.net:8000/foo/bar.tml?q=foo#changes # # The "http" is the protocol, the user is "jschmoe", the password is # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes". # # Note that the RE actually combines the user and password parts, as # recommended in RFC 3986. Indeed, that RFC states that putting passwords # in URLs is a Really Bad Idea, something with which I would agree utterly. # # From a validation perspective, we need to ensure that the parts of the # URL that are going to the server are correctly encoded. This is only # done if $state(-strict) is true (inherited from $::http::strict). set URLmatcher {(?x) # this is _expanded_ syntax ^ (?: (\w+) : ) ? # (?: // (?: ( [^@/\#?]+ # ) @ )? ( # [^/:\#?]+ | # host name or IPv4 address \[ [^/\#?]+ \] # IPv6 address in square brackets ) (?: : (\d+) )? # )? ( [/\?] [^\#]*)? # (including query) (?: \# (.*) )? # $ } # Phase one: parse if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} { unset $token return -code error "Unsupported URL: $url" } # Phase two: validate set host [string trim $host {[]}]; # strip square brackets from IPv6 address if {$host eq ""} { # Caller has to provide a host name; we do not have a "default host" # that would enable us to handle relative URLs. unset $token return -code error "Missing host part: $url" # Note that we don't check the hostname for validity here; if it's # invalid, we'll simply fail to resolve it later on. } if {$port ne "" && $port > 65535} { unset $token return -code error "Invalid port number: $port" } # The user identification and resource identification parts of the URL can # have encoded characters in them; take care! if {$user ne ""} { # Check for validity according to RFC 3986, Appendix A set validityRE {(?xi) ^ (?: [-\w.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+ $ } if {$state(-strict) && ![regexp -- $validityRE $user]} { unset $token # Provide a better error message in this error case if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $user bad]} { return -code error \ "Illegal encoding character usage \"$bad\" in URL user" } return -code error "Illegal characters in URL user" } } if {$srvurl ne ""} { # RFC 3986 allows empty paths (not even a /), but servers # return 400 if the path in the HTTP request doesn't start # with / , so add it here if needed. if {[string index $srvurl 0] ne "/"} { set srvurl /$srvurl } # Check for validity according to RFC 3986, Appendix A set validityRE {(?xi) ^ # Path part (already must start with / character) (?: [-\w.~!$&'()*+,;=:@/] | %[0-9a-f][0-9a-f] )* # Query part (optional, permits ? characters) (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )? $ } if {$state(-strict) && ![regexp -- $validityRE $srvurl]} { unset $token # Provide a better error message in this error case if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} { return -code error \ "Illegal encoding character usage \"$bad\" in URL path" } return -code error "Illegal characters in URL path" } if {![regexp {^[^?#]+} $srvurl state(path)]} { set state(path) / } } else { set srvurl / set state(path) / } if {$proto eq ""} { set proto http } set lower [string tolower $proto] if {![info exists urlTypes($lower)]} { unset $token return -code error "Unsupported URL type \"$proto\"" } set defport [lindex $urlTypes($lower) 0] set defcmd [lindex $urlTypes($lower) 1] if {$port eq ""} { set port $defport } if {![catch {$http(-proxyfilter) $host} proxy]} { set phost [lindex $proxy 0] set pport [lindex $proxy 1] } # OK, now reassemble into a full URL set url ${proto}:// if {$user ne ""} { append url $user append url @ } append url $host if {$port != $defport} { append url : $port } append url $srvurl # Don't append the fragment! set state(url) $url set sockopts [list -async] # If we are using the proxy, we must pass in the full URL that includes # the server name. if {[info exists phost] && ($phost ne "")} { set srvurl $url set targetAddr [list $phost $pport] } else { set targetAddr [list $host $port] } # Proxy connections aren't shared among different hosts. set state(socketinfo) $host:$port # Save the accept types at this point to prevent a race condition. [Bug # c11a51c482] set state(accept-types) $http(-accept) # Check whether this is an Upgrade request. set connectionValues [SplitCommaSeparatedFieldValue \ [GetFieldValue $state(-headers) Connection]] set connectionValues [string tolower $connectionValues] set upgradeValues [SplitCommaSeparatedFieldValue \ [GetFieldValue $state(-headers) Upgrade]] set state(upgradeRequest) [expr { "upgrade" in $connectionValues && [llength $upgradeValues] >= 1}] if {$isQuery || $isQueryChannel} { # It's a POST. # A client wishing to send a non-idempotent request SHOULD wait to send # that request until it has received the response status for the # previous request. if {$http(-postfresh)} { # Override -keepalive for a POST. Use a new connection, and thus # avoid the small risk of a race against server timeout. set state(-keepalive) 0 } else { # Allow -keepalive but do not -pipeline - wait for the previous # transaction to finish. # There is a small risk of a race against server timeout. set state(-pipeline) 0 } } elseif {$state(upgradeRequest)} { # It's an upgrade request. Method must be GET (untested). # Force -keepalive to 0 so the connection is not made over a persistent # socket, i.e. one used for multiple HTTP requests. set state(-keepalive) 0 } else { # It's a non-upgrade GET or HEAD. set state(-pipeline) $http(-pipeline) } # We cannot handle chunked encodings with -handler, so force HTTP/1.0 # until we can manage this. if {[info exists state(-handler)]} { set state(-protocol) 1.0 } # RFC 7320 A.1 - HTTP/1.0 Keep-Alive is problematic. We do not support it. if {$state(-protocol) eq "1.0"} { set state(connection) close set state(-keepalive) 0 } # See if we are supposed to use a previously opened channel. # - In principle, ANY call to http::geturl could use a previously opened # channel if it is available - the "Connection: keep-alive" header is a # request to leave the channel open AFTER completion of this call. # - In fact, we try to use an existing channel only if -keepalive 1 -- this # means that at most one channel is left open for each value of # $state(socketinfo). This property simplifies the mapping of open # channels. set reusing 0 set alreadyQueued 0 if {$state(-keepalive)} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd if {[info exists socketMapping($state(socketinfo))]} { # - If the connection is idle, it has a "fileevent readable" binding # to http::CheckEof, in case the server times out and half-closes # the socket (http::CheckEof closes the other half). # - We leave this binding in place until just before the last # puts+flush in http::Connected (GET/HEAD) or http::Write (POST), # after which the HTTP response might be generated. if { [info exists socketClosing($state(socketinfo))] && $socketClosing($state(socketinfo)) } { # socketClosing(*) is set because the server has sent a # "Connection: close" header. # Do not use the persistent socket again. # Since we have only one persistent socket per server, and the # old socket is not yet dead, add the request to the write queue # of the dying socket, which will be replayed by ReplayIfClose. # Also add it to socketWrQueue(*) which is used only if an error # causes a call to Finish. set reusing 1 set sock $socketMapping($state(socketinfo)) Log "reusing socket $sock for $state(socketinfo) - token $token" set alreadyQueued 1 lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3 lappend com3 $token set socketPlayCmd($state(socketinfo)) [list $com0 $com1 $com2 $com3] lappend socketWrQueue($state(socketinfo)) $token } elseif {[catch {fconfigure $socketMapping($state(socketinfo))}]} { # FIXME Is it still possible for this code to be executed? If # so, this could be another place to call TestForReplay, # rather than discarding the queued transactions. Log "WARNING: socket for $state(socketinfo) was closed\ - token $token" Log "WARNING - if testing, pay special attention to this\ case (GH) which is seldom executed - token $token" # This will call CancelReadPipeline, CancelWritePipeline, and # cancel any queued requests, responses. Unset $state(socketinfo) } else { # Use the persistent socket. # The socket may not be ready to write: an earlier request might # still be still writing (in the pipelined case) or # writing/reading (in the nonpipeline case). This possibility # is handled by socketWrQueue later in this command. set reusing 1 set sock $socketMapping($state(socketinfo)) Log "reusing socket $sock for $state(socketinfo) - token $token" } # Do not automatically close the connection socket. set state(connection) keep-alive } } if {$reusing} { # Define state(tmpState) and state(tmpOpenCmd) for use # by http::ReplayIfDead if the persistent connection has died. set state(tmpState) [array get state] # Pass -myaddr directly to the socket command if {[info exists state(-myaddr)]} { lappend sockopts -myaddr $state(-myaddr) } set state(tmpOpenCmd) [list {*}$defcmd {*}$sockopts {*}$targetAddr] } set state(reusing) $reusing # Excluding ReplayIfDead and the decision whether to call it, there are four # places outside http::geturl where state(reusing) is used: # - Connected - if reusing and not pipelined, start the state(-timeout) # timeout (when writing). # - DoneRequest - if reusing and pipelined, send the next pipelined write # - Event - if reusing and pipelined, start the state(-timeout) # timeout (when reading). # - Event - if (not reusing) and pipelined, send the next pipelined # write # See comments above re the start of this timeout in other cases. if {(!$state(reusing)) && ($state(-timeout) > 0)} { set state(after) [after $state(-timeout) \ [list http::reset $token timeout]] } if {![info exists sock]} { # Pass -myaddr directly to the socket command if {[info exists state(-myaddr)]} { lappend sockopts -myaddr $state(-myaddr) } set pre [clock milliseconds] ##Log pre socket opened, - token $token ##Log [concat $defcmd $sockopts $targetAddr] - token $token if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} { # Something went wrong while trying to establish the connection. # Clean up after events and such, but DON'T call the command # callback (if available) because we're going to throw an # exception from here instead. set state(sock) NONE Finish $token $sock 1 cleanup $token dict unset errdict -level return -options $errdict $sock } else { # Initialisation of a new socket. ##Log post socket opened, - token $token ##Log socket opened, now fconfigure - token $token set delay [expr {[clock milliseconds] - $pre}] if {$delay > 3000} { Log socket delay $delay - token $token } fconfigure $sock -translation {auto crlf} \ -buffersize $state(-blocksize) ##Log socket opened, DONE fconfigure - token $token } } # Command [socket] is called with -async, but takes 5s to 5.1s to return, # with probability of order 1 in 10,000. This may be a bizarre scheduling # issue with my (KJN's) system (Fedora Linux). # This does not cause a problem (unless the request times out when this # command returns). set state(sock) $sock Log "Using $sock for $state(socketinfo) - token $token" \ [expr {$state(-keepalive)?"keepalive":""}] if { $state(-keepalive) && (![info exists socketMapping($state(socketinfo))]) } { # Freshly-opened socket that we would like to become persistent. set socketMapping($state(socketinfo)) $sock if {![info exists socketRdState($state(socketinfo))]} { set socketRdState($state(socketinfo)) {} set varName ::http::socketRdState($state(socketinfo)) trace add variable $varName unset ::http::CancelReadPipeline } if {![info exists socketWrState($state(socketinfo))]} { set socketWrState($state(socketinfo)) {} set varName ::http::socketWrState($state(socketinfo)) trace add variable $varName unset ::http::CancelWritePipeline } if {$state(-pipeline)} { #Log new, init for pipelined, GRANT write access to $token in geturl # Also grant premature read access to the socket. This is OK. set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token } else { # socketWrState is not used by this non-pipelined transaction. # We cannot leave it as "Wready" because the next call to # http::geturl with a pipelined transaction would conclude that the # socket is available for writing. #Log new, init for nonpipeline, GRANT r/w access to $token in geturl set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token } set socketRdQueue($state(socketinfo)) {} set socketWrQueue($state(socketinfo)) {} set socketClosing($state(socketinfo)) 0 set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}} } if {![info exists phost]} { set phost "" } if {$reusing} { # For use by http::ReplayIfDead if the persistent connection has died. # Also used by NextPipelinedWrite. set state(tmpConnArgs) [list $proto $phost $srvurl] } # The element socketWrState($connId) has a value which is either the name of # the token that is permitted to write to the socket, or "Wready" if no # token is permitted to write. # # The code that sets the value to Wready immediately calls # http::NextPipelinedWrite, which examines socketWrQueue($connId) and # processes the next request in the queue, if there is one. The value # Wready is not found when the interpreter is in the event loop unless the # socket is idle. # # The element socketRdState($connId) has a value which is either the name of # the token that is permitted to read from the socket, or "Rready" if no # token is permitted to read. # # The code that sets the value to Rready then examines # socketRdQueue($connId) and processes the next request in the queue, if # there is one. The value Rready is not found when the interpreter is in # the event loop unless the socket is idle. if {$alreadyQueued} { # A write may or may not be in progress. There is no need to set # socketWrState to prevent another call stealing write access - all # subsequent calls on this socket will come here because the socket # will close after the current read, and its # socketClosing($connId) is 1. ##Log "HTTP request for token $token is queued" } elseif { $reusing && $state(-pipeline) && ($socketWrState($state(socketinfo)) ne "Wready") } { ##Log "HTTP request for token $token is queued for pipelined use" lappend socketWrQueue($state(socketinfo)) $token } elseif { $reusing && (!$state(-pipeline)) && ($socketWrState($state(socketinfo)) ne "Wready") } { # A write is queued or in progress. Lappend to the write queue. ##Log "HTTP request for token $token is queued for nonpipeline use" lappend socketWrQueue($state(socketinfo)) $token } elseif { $reusing && (!$state(-pipeline)) && ($socketWrState($state(socketinfo)) eq "Wready") && ($socketRdState($state(socketinfo)) ne "Rready") } { # A read is queued or in progress, but not a write. Cannot start the # nonpipeline transaction, but must set socketWrState to prevent a # pipelined request jumping the queue. ##Log "HTTP request for token $token is queued for nonpipeline use" #Log re-use nonpipeline, GRANT delayed write access to $token in geturl set socketWrState($state(socketinfo)) peNding lappend socketWrQueue($state(socketinfo)) $token } else { if {$reusing && $state(-pipeline)} { #Log re-use pipelined, GRANT write access to $token in geturl set socketWrState($state(socketinfo)) $token } elseif {$reusing} { # Cf tests above - both are ready. #Log re-use nonpipeline, GRANT r/w access to $token in geturl set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token } # All (!$reusing) cases come here, and also some $reusing cases if the # connection is ready. #Log ---- $state(socketinfo) << conn to $token for HTTP request (a) # Connect does its own fconfigure. fileevent $sock writable \ [list http::Connect $token $proto $phost $srvurl] } # Wait for the connection to complete. if {![info exists state(-command)]} { # geturl does EVERYTHING asynchronously, so if the user # calls it synchronously, we just do a wait here. http::wait $token if {![info exists state]} { # If we timed out then Finish has been called and the users # command callback may have cleaned up the token. If so we end up # here with nothing left to do. return $token } elseif {$state(status) eq "error"} { # Something went wrong while trying to establish the connection. # Clean up after events and such, but DON'T call the command # callback (if available) because we're going to throw an # exception from here instead. set err [lindex $state(error) 0] cleanup $token return -code error $err } } ##Log Leaving http::geturl - token $token return $token } # http::Connected -- # # Callback used when the connection to the HTTP server is actually # established. # # Arguments: # token State token. # proto What protocol (http, https, etc.) was used to connect. # phost Are we using keep-alive? Non-empty if yes. # srvurl Service-local URL that we're requesting # Results: # None. proc http::Connected {token proto phost srvurl} { variable http variable urlTypes variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0 $token state set tk [namespace tail $token] if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} { set state(after) [after $state(-timeout) \ [list http::reset $token timeout]] } # Set back the variables needed here. set sock $state(sock) set isQueryChannel [info exists state(-querychannel)] set isQuery [info exists state(-query)] regexp {^(.+):([^:]+)$} $state(socketinfo) {} host port set lower [string tolower $proto] set defport [lindex $urlTypes($lower) 0] # Send data in cr-lf format, but accept any line terminators. # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest. # We are concerned here with the request (write) not the response (read). lassign [fconfigure $sock -translation] trRead trWrite fconfigure $sock -translation [list $trRead crlf] \ -buffersize $state(-blocksize) # The following is disallowed in safe interpreters, but the socket is # already in non-blocking mode in that case. catch {fconfigure $sock -blocking off} set how GET if {$isQuery} { set state(querylength) [string length $state(-query)] if {$state(querylength) > 0} { set how POST set contDone 0 } else { # There's no query data. unset state(-query) set isQuery 0 } } elseif {$state(-validate)} { set how HEAD } elseif {$isQueryChannel} { set how POST # The query channel must be blocking for the async Write to # work properly. fconfigure $state(-querychannel) -blocking 1 -translation binary set contDone 0 } if {[info exists state(-method)] && ($state(-method) ne "")} { set how $state(-method) } set accept_types_seen 0 Log ^B$tk begin sending request - token $token if {[catch { set state(method) $how puts $sock "$how $srvurl HTTP/$state(-protocol)" set hostValue [GetFieldValue $state(-headers) Host] if {$hostValue ne {}} { # Allow Host spoofing. [Bug 928154] regexp {^[^:]+} $hostValue state(host) puts $sock "Host: $hostValue" } elseif {$port == $defport} { # Don't add port in this case, to handle broken servers. [Bug # #504508] set state(host) $host puts $sock "Host: $host" } else { set state(host) $host puts $sock "Host: $host:$port" } puts $sock "User-Agent: $http(-useragent)" if {($state(-protocol) > 1.0) && $state(-keepalive)} { # Send this header, because a 1.1 server is not compelled to treat # this as the default. puts $sock "Connection: keep-alive" } if {($state(-protocol) > 1.0) && !$state(-keepalive)} { puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1 } if {($state(-protocol) < 1.1)} { # RFC7230 A.1 # Some server implementations of HTTP/1.0 have a faulty # implementation of RFC 2068 Keep-Alive. # Don't leave this to chance. # For HTTP/1.0 we have already "set state(connection) close" # and "state(-keepalive) 0". puts $sock "Connection: close" } # RFC7230 A.1 - "clients are encouraged not to send the # Proxy-Connection header field in any requests" set accept_encoding_seen 0 set content_type_seen 0 foreach {key value} $state(-headers) { set value [string map [list \n "" \r ""] $value] set key [string map {" " -} [string trim $key]] if {[string equal -nocase $key "host"]} { continue } if {[string equal -nocase $key "accept-encoding"]} { set accept_encoding_seen 1 } if {[string equal -nocase $key "accept"]} { set accept_types_seen 1 } if {[string equal -nocase $key "content-type"]} { set content_type_seen 1 } if {[string equal -nocase $key "content-length"]} { set contDone 1 set state(querylength) $value } if {[string length $key]} { puts $sock "$key: $value" } } # Allow overriding the Accept header on a per-connection basis. Useful # for working with REST services. [Bug c11a51c482] if {!$accept_types_seen} { puts $sock "Accept: $state(accept-types)" } if { (!$accept_encoding_seen) && (![info exists state(-handler)]) && $http(-zip) } { puts $sock "Accept-Encoding: gzip,deflate,compress" } if {$isQueryChannel && ($state(querylength) == 0)} { # Try to determine size of data in channel. If we cannot seek, the # surrounding catch will trap us set start [tell $state(-querychannel)] seek $state(-querychannel) 0 end set state(querylength) \ [expr {[tell $state(-querychannel)] - $start}] seek $state(-querychannel) $start } # Flush the request header and set up the fileevent that will either # push the POST data or read the response. # # fileevent note: # # It is possible to have both the read and write fileevents active at # this point. The only scenario it seems to affect is a server that # closes the connection without reading the POST data. (e.g., early # versions TclHttpd in various error cases). Depending on the # platform, the client may or may not be able to get the response from # the server because of the error it will get trying to write the post # data. Having both fileevents active changes the timing and the # behavior, but no two platforms (among Solaris, Linux, and NT) behave # the same, and none behave all that well in any case. Servers should # always read their POST data if they expect the client to read their # response. if {$isQuery || $isQueryChannel} { # POST method. if {!$content_type_seen} { puts $sock "Content-Type: $state(-type)" } if {!$contDone} { puts $sock "Content-Length: $state(querylength)" } puts $sock "" flush $sock # Flush flushes the error in the https case with a bad handshake: # else the socket never becomes writable again, and hangs until # timeout (if any). lassign [fconfigure $sock -translation] trRead trWrite fconfigure $sock -translation [list $trRead binary] fileevent $sock writable [list http::Write $token] # The http::Write command decides when to make the socket readable, # using the same test as the GET/HEAD case below. } else { # GET or HEAD method. if { (![catch {fileevent $sock readable} binding]) && ($binding eq [list http::CheckEof $sock]) } { # Remove the "fileevent readable" binding of an idle persistent # socket to http::CheckEof. We can no longer treat bytes # received as junk. The server might still time out and # half-close the socket if it has not yet received the first # "puts". fileevent $sock readable {} } puts $sock "" flush $sock Log ^C$tk end sending request - token $token # End of writing (GET/HEAD methods). The request has been sent. DoneRequest $token } } err]} { # The socket probably was never connected, OR the connection dropped # later, OR https handshake error, which may be discovered as late as # the "flush" command above... Log "WARNING - if testing, pay special attention to this\ case (GI) which is seldom executed - token $token" if {[info exists state(reusing)] && $state(reusing)} { # The socket was closed at the server end, and closed at # this end by http::CheckEof. if {[TestForReplay $token write $err a]} { return } else { Finish $token {failed to re-use socket} } # else: # This is NOT a persistent socket that has been closed since its # last use. # If any other requests are in flight or pipelined/queued, they will # be discarded. } elseif {$state(status) eq ""} { # ...https handshake errors come here. set msg [registerError $sock] registerError $sock {} if {$msg eq {}} { set msg {failed to use socket} } Finish $token $msg } elseif {$state(status) ne "error"} { Finish $token $err } } } # http::registerError # # Called (for example when processing TclTLS activity) to register # an error for a connection on a specific socket. This helps # http::Connected to deliver meaningful error messages, e.g. when a TLS # certificate fails verification. # # Usage: http::registerError socket ?newValue? # # "set" semantics, except that a "get" (a call without a new value) for a # non-existent socket returns {}, not an error. proc http::registerError {sock args} { variable registeredErrors if { ([llength $args] == 0) && (![info exists registeredErrors($sock)]) } { return } elseif { ([llength $args] == 1) && ([lindex $args 0] eq {}) } { unset -nocomplain registeredErrors($sock) return } set registeredErrors($sock) {*}$args } # http::DoneRequest -- # # Command called when a request has been sent. It will arrange the # next request and/or response as appropriate. # # If this command is called when $socketClosing(*), the request $token # that calls it must be pipelined and destined to fail. proc http::DoneRequest {token} { variable http variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0 $token state set tk [namespace tail $token] set sock $state(sock) # If pipelined, connect the next HTTP request to the socket. if {$state(reusing) && $state(-pipeline)} { # Enable next token (if any) to write. # The value "Wready" is set only here, and # in http::Event after reading the response-headers of a # non-reusing transaction. # Previous value is $token. It cannot be pending. set socketWrState($state(socketinfo)) Wready # Now ready to write the next pipelined request (if any). http::NextPipelinedWrite $token } else { # If pipelined, this is the first transaction on this socket. We wait # for the response headers to discover whether the connection is # persistent. (If this is not done and the connection is not # persistent, we SHOULD retry and then MUST NOT pipeline before knowing # that we have a persistent connection # (rfc2616 8.1.2.2)). } # Connect to receive the response, unless the socket is pipelined # and another response is being sent. # This code block is separate from the code below because there are # cases where socketRdState already has the value $token. if { $state(-keepalive) && $state(-pipeline) && [info exists socketRdState($state(socketinfo))] && ($socketRdState($state(socketinfo)) eq "Rready") } { #Log pipelined, GRANT read access to $token in Connected set socketRdState($state(socketinfo)) $token } if { $state(-keepalive) && $state(-pipeline) && [info exists socketRdState($state(socketinfo))] && ($socketRdState($state(socketinfo)) ne $token) } { # Do not read from the socket until it is ready. ##Log "HTTP response for token $token is queued for pipelined use" # If $socketClosing(*), then the caller will be a pipelined write and # execution will come here. # This token has already been recorded as "in flight" for writing. # When the socket is closed, the read queue will be cleared in # CloseQueuedQueries and so the "lappend" here has no effect. lappend socketRdQueue($state(socketinfo)) $token } else { # In the pipelined case, connection for reading depends on the # value of socketRdState. # In the nonpipeline case, connection for reading always occurs. ReceiveResponse $token } } # http::ReceiveResponse # # Connects token to its socket for reading. proc http::ReceiveResponse {token} { variable $token upvar 0 $token state set tk [namespace tail $token] set sock $state(sock) #Log ---- $state(socketinfo) >> conn to $token for HTTP response lassign [fconfigure $sock -translation] trRead trWrite fconfigure $sock -translation [list auto $trWrite] \ -buffersize $state(-blocksize) Log ^D$tk begin receiving response - token $token coroutine ${token}EventCoroutine http::Event $sock $token if {[info exists state(-handler)] || [info exists state(-progress)]} { fileevent $sock readable [list http::EventGateway $sock $token] } else { fileevent $sock readable ${token}EventCoroutine } return } # http::EventGateway # # Bug [c2dc1da315]. # - Recursive launch of the coroutine can occur if a -handler or -progress # callback is used, and the callback command enters the event loop. # - To prevent this, the fileevent "binding" is disabled while the # coroutine is in flight. # - If a recursive call occurs despite these precautions, it is not # trapped and discarded here, because it is better to report it as a # bug. # - Although this solution is believed to be sufficiently general, it is # used only if -handler or -progress is specified. In other cases, # the coroutine is called directly. proc http::EventGateway {sock token} { variable $token upvar 0 $token state fileevent $sock readable {} catch {${token}EventCoroutine} res opts if {[info commands ${token}EventCoroutine] ne {}} { # The coroutine can be deleted by completion (a non-yield return), by # http::Finish (when there is a premature end to the transaction), by # http::reset or http::cleanup, or if the caller set option -channel # but not option -handler: in the last case reading from the socket is # now managed by commands ::http::Copy*, http::ReceiveChunked, and # http::make-transformation-chunked. # # Catch in case the coroutine has closed the socket. catch {fileevent $sock readable [list http::EventGateway $sock $token]} } # If there was an error, re-throw it. return -options $opts $res } # http::NextPipelinedWrite # # - Connecting a socket to a token for writing is done by this command and by # command KeepSocket. # - If another request has a pipelined write scheduled for $token's socket, # and if the socket is ready to accept it, connect the write and update # the queue accordingly. # - This command is called from http::DoneRequest and http::Event, # IF $state(-pipeline) AND (the current transfer has reached the point at # which the socket is ready for the next request to be written). # - This command is called when a token has write access and is pipelined and # keep-alive, and sets socketWrState to Wready. # - The command need not consider the case where socketWrState is set to a token # that does not yet have write access. Such a token is waiting for Rready, # and the assignment of the connection to the token will be done elsewhere (in # http::KeepSocket). # - This command cannot be called after socketWrState has been set to a # "pending" token value (that is then overwritten by the caller), because that # value is set by this command when it is called by an earlier token when it # relinquishes its write access, and the pending token is always the next in # line to write. proc http::NextPipelinedWrite {token} { variable http variable socketRdState variable socketWrState variable socketWrQueue variable socketClosing variable $token upvar 0 $token state set connId $state(socketinfo) if { [info exists socketClosing($connId)] && $socketClosing($connId) } { # socketClosing(*) is set because the server has sent a # "Connection: close" header. # Behave as if the queues are empty - so do nothing. } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "Wready") && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && ([set token2 [lindex $socketWrQueue($connId) 0] set ${token2}(-pipeline) ] ) } { # - The usual case for a pipelined connection, ready for a new request. #Log pipelined, GRANT write access to $token2 in NextPipelinedWrite set conn [set ${token2}(tmpConnArgs)] set socketWrState($connId) $token2 set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent $state(sock) writable [list http::Connect $token2 {*}$conn] #Log ---- $connId << conn to $token2 for HTTP request (b) # In the tests below, the next request will be nonpipeline. } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "Wready") && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && (![ set token3 [lindex $socketWrQueue($connId) 0] set ${token3}(-pipeline) ] ) && [info exists socketRdState($connId)] && ($socketRdState($connId) eq "Rready") } { # The case in which the next request will be non-pipelined, and the read # and write queues is ready: which is the condition for a non-pipelined # write. variable $token3 upvar 0 $token3 state3 set conn [set ${token3}(tmpConnArgs)] #Log nonpipeline, GRANT r/w access to $token3 in NextPipelinedWrite set socketRdState($connId) $token3 set socketWrState($connId) $token3 set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent $state(sock) writable [list http::Connect $token3 {*}$conn] #Log ---- $state(sock) << conn to $token3 for HTTP request (c) } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "Wready") && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && (![set token2 [lindex $socketWrQueue($connId) 0] set ${token2}(-pipeline) ] ) } { # - The case in which the next request will be non-pipelined, but the # read queue is NOT ready. # - A read is queued or in progress, but not a write. Cannot start the # nonpipeline transaction, but must set socketWrState to prevent a new # pipelined request (in http::geturl) jumping the queue. # - Because socketWrState($connId) is not set to Wready, the assignment # of the connection to $token2 will be done elsewhere - by command # http::KeepSocket when $socketRdState($connId) is set to "Rready". #Log re-use nonpipeline, GRANT delayed write access to $token in NextP.. set socketWrState($connId) peNding } } # http::CancelReadPipeline # # Cancel pipelined responses on a closing "Keep-Alive" socket. # # - Called by a variable trace on "unset socketRdState($connId)". # - The variable relates to a Keep-Alive socket, which has been closed. # - Cancels all pipelined responses. The requests have been sent, # the responses have not yet been received. # - This is a hard cancel that ends each transaction with error status, # and closes the connection. Do not use it if you want to replay failed # transactions. # - N.B. Always delete ::http::socketRdState($connId) before deleting # ::http::socketRdQueue($connId), or this command will do nothing. # # Arguments # As for a trace command on a variable. proc http::CancelReadPipeline {name1 connId op} { variable socketRdQueue ##Log CancelReadPipeline $name1 $connId $op if {[info exists socketRdQueue($connId)]} { set msg {the connection was closed by CancelReadPipeline} foreach token $socketRdQueue($connId) { set tk [namespace tail $token] Log ^X$tk end of response "($msg)" - token $token set ${token}(status) eof Finish $token ;#$msg } set socketRdQueue($connId) {} } } # http::CancelWritePipeline # # Cancel queued events on a closing "Keep-Alive" socket. # # - Called by a variable trace on "unset socketWrState($connId)". # - The variable relates to a Keep-Alive socket, which has been closed. # - In pipelined or nonpipeline case: cancels all queued requests. The # requests have not yet been sent, the responses are not due. # - This is a hard cancel that ends each transaction with error status, # and closes the connection. Do not use it if you want to replay failed # transactions. # - N.B. Always delete ::http::socketWrState($connId) before deleting # ::http::socketWrQueue($connId), or this command will do nothing. # # Arguments # As for a trace command on a variable. proc http::CancelWritePipeline {name1 connId op} { variable socketWrQueue ##Log CancelWritePipeline $name1 $connId $op if {[info exists socketWrQueue($connId)]} { set msg {the connection was closed by CancelWritePipeline} foreach token $socketWrQueue($connId) { set tk [namespace tail $token] Log ^X$tk end of response "($msg)" - token $token set ${token}(status) eof Finish $token ;#$msg } set socketWrQueue($connId) {} } } # http::ReplayIfDead -- # # - A query on a re-used persistent socket failed at the earliest opportunity, # because the socket had been closed by the server. Keep the token, tidy up, # and try to connect on a fresh socket. # - The connection is monitored for eof by the command http::CheckEof. Thus # http::ReplayIfDead is needed only when a server event (half-closing an # apparently idle connection), and a client event (sending a request) occur at # almost the same time, and neither client nor server detects the other's # action before performing its own (an "asynchronous close event"). # - To simplify testing of http::ReplayIfDead, set TEST_EOF 1 in # http::KeepSocket, and then http::ReplayIfDead will be called if http::geturl # is called at any time after the server timeout. # # Arguments: # token Connection token. # # Side Effects: # Use the same token, but try to open a new socket. proc http::ReplayIfDead {tokenArg doing} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $tokenArg upvar 0 $tokenArg stateArg Log running http::ReplayIfDead for $tokenArg $doing # 1. Merge the tokens for transactions in flight, the read (response) queue, # and the write (request) queue. set InFlightR {} set InFlightW {} # Obtain the tokens for transactions in flight. if {$stateArg(-pipeline)} { # Two transactions may be in flight. The "read" transaction was first. # It is unlikely that the server would close the socket if a response # was pending; however, an earlier request (as well as the present # request) may have been sent and ignored if the socket was half-closed # by the server. if { [info exists socketRdState($stateArg(socketinfo))] && ($socketRdState($stateArg(socketinfo)) ne "Rready") } { lappend InFlightR $socketRdState($stateArg(socketinfo)) } elseif {($doing eq "read")} { lappend InFlightR $tokenArg } if { [info exists socketWrState($stateArg(socketinfo))] && $socketWrState($stateArg(socketinfo)) ni {Wready peNding} } { lappend InFlightW $socketWrState($stateArg(socketinfo)) } elseif {($doing eq "write")} { lappend InFlightW $tokenArg } # Report any inconsistency of $tokenArg with socket*state. if { ($doing eq "read") && [info exists socketRdState($stateArg(socketinfo))] && ($tokenArg ne $socketRdState($stateArg(socketinfo))) } { Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \ ne socketRdState($stateArg(socketinfo)) \ $socketRdState($stateArg(socketinfo)) } elseif { ($doing eq "write") && [info exists socketWrState($stateArg(socketinfo))] && ($tokenArg ne $socketWrState($stateArg(socketinfo))) } { Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \ ne socketWrState($stateArg(socketinfo)) \ $socketWrState($stateArg(socketinfo)) } } else { # One transaction should be in flight. # socketRdState, socketWrQueue are used. # socketRdQueue should be empty. # Report any inconsistency of $tokenArg with socket*state. if {$tokenArg ne $socketRdState($stateArg(socketinfo))} { Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \ ne socketRdState($stateArg(socketinfo)) \ $socketRdState($stateArg(socketinfo)) } # Report the inconsistency that socketRdQueue is non-empty. if { [info exists socketRdQueue($stateArg(socketinfo))] && ($socketRdQueue($stateArg(socketinfo)) ne {}) } { Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \ has read queue socketRdQueue($stateArg(socketinfo)) \ $socketRdQueue($stateArg(socketinfo)) ne {} } lappend InFlightW $socketRdState($stateArg(socketinfo)) set socketRdQueue($stateArg(socketinfo)) {} } set newQueue {} lappend newQueue {*}$InFlightR lappend newQueue {*}$socketRdQueue($stateArg(socketinfo)) lappend newQueue {*}$InFlightW lappend newQueue {*}$socketWrQueue($stateArg(socketinfo)) # 2. Tidy up tokenArg. This is a cut-down form of Finish/CloseSocket. # Do not change state(status). # No need to after cancel stateArg(after) - either this is done in # ReplayCore/ReInit, or Finish is called. catch {close $stateArg(sock)} # 2a. Tidy the tokens in the queues - this is done in ReplayCore/ReInit. # - Transactions, if any, that are awaiting responses cannot be completed. # They are listed for re-sending in newQueue. # - All tokens are preserved for re-use by ReplayCore, and their variables # will be re-initialised by calls to ReInit. # - The relevant element of socketMapping, socketRdState, socketWrState, # socketRdQueue, socketWrQueue, socketClosing, socketPlayCmd will be set # to new values in ReplayCore. ReplayCore $newQueue } # http::ReplayIfClose -- # # A request on a socket that was previously "Connection: keep-alive" has # received a "Connection: close" response header. The server supplies # that response correctly, but any later requests already queued on this # connection will be lost when the socket closes. # # This command takes arguments that represent the socketWrState, # socketRdQueue and socketWrQueue for this connection. The socketRdState # is not needed because the server responds in full to the request that # received the "Connection: close" response header. # # Existing request tokens $token (::http::$n) are preserved. The caller # will be unaware that the request was processed this way. proc http::ReplayIfClose {Wstate Rqueue Wqueue} { Log running http::ReplayIfClose for $Wstate $Rqueue $Wqueue if {$Wstate in $Rqueue || $Wstate in $Wqueue} { Log WARNING duplicate token in http::ReplayIfClose - token $Wstate set Wstate Wready } # 1. Create newQueue set InFlightW {} if {$Wstate ni {Wready peNding}} { lappend InFlightW $Wstate } set newQueue {} lappend newQueue {*}$Rqueue lappend newQueue {*}$InFlightW lappend newQueue {*}$Wqueue # 2. Cleanup - none needed, done by the caller. ReplayCore $newQueue } # http::ReInit -- # # Command to restore a token's state to a condition that # makes it ready to replay a request. # # Command http::geturl stores extra state in state(tmp*) so # we don't need to do the argument processing again. # # The caller must: # - Set state(reusing) and state(sock) to their new values after calling # this command. # - Unset state(tmpState), state(tmpOpenCmd) if future calls to ReplayCore # or ReInit are inappropriate for this token. Typically only one retry # is allowed. # The caller may also unset state(tmpConnArgs) if this value (and the # token) will be used immediately. The value is needed by tokens that # will be stored in a queue. # # Arguments: # token Connection token. # # Return Value: (boolean) true iff the re-initialisation was successful. proc http::ReInit {token} { variable $token upvar 0 $token state if {!( [info exists state(tmpState)] && [info exists state(tmpOpenCmd)] && [info exists state(tmpConnArgs)] ) } { Log FAILED in http::ReInit via ReplayCore - NO tmp vars for $token return 0 } if {[info exists state(after)]} { after cancel $state(after) unset state(after) } # Don't alter state(status) - this would trigger http::wait if it is in use. set tmpState $state(tmpState) set tmpOpenCmd $state(tmpOpenCmd) set tmpConnArgs $state(tmpConnArgs) foreach name [array names state] { if {$name ne "status"} { unset state($name) } } # Don't alter state(status). # Restore state(tmp*) - the caller may decide to unset them. # Restore state(tmpConnArgs) which is needed for connection. # state(tmpState), state(tmpOpenCmd) are needed only for retries. dict unset tmpState status array set state $tmpState set state(tmpState) $tmpState set state(tmpOpenCmd) $tmpOpenCmd set state(tmpConnArgs) $tmpConnArgs return 1 } # http::ReplayCore -- # # Command to replay a list of requests, using existing connection tokens. # # Abstracted from http::geturl which stores extra state in state(tmp*) so # we don't need to do the argument processing again. # # Arguments: # newQueue List of connection tokens. # # Side Effects: # Use existing tokens, but try to open a new socket. proc http::ReplayCore {newQueue} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd if {[llength $newQueue] == 0} { # Nothing to do. return } ##Log running ReplayCore for {*}$newQueue set newToken [lindex $newQueue 0] set newQueue [lrange $newQueue 1 end] # 3. Use newToken, and restore its values of state(*). Do not restore # elements tmp* - we try again only once. set token $newToken variable $token upvar 0 $token state if {![ReInit $token]} { Log FAILED in http::ReplayCore - NO tmp vars Finish $token {cannot send this request again} return } set tmpState $state(tmpState) set tmpOpenCmd $state(tmpOpenCmd) set tmpConnArgs $state(tmpConnArgs) unset state(tmpState) unset state(tmpOpenCmd) unset state(tmpConnArgs) set state(reusing) 0 if {$state(-timeout) > 0} { set resetCmd [list http::reset $token timeout] set state(after) [after $state(-timeout) $resetCmd] } set pre [clock milliseconds] ##Log pre socket opened, - token $token ##Log $tmpOpenCmd - token $token # 4. Open a socket. if {[catch {eval $tmpOpenCmd} sock]} { # Something went wrong while trying to establish the connection. Log FAILED - $sock set state(sock) NONE Finish $token $sock return } ##Log post socket opened, - token $token set delay [expr {[clock milliseconds] - $pre}] if {$delay > 3000} { Log socket delay $delay - token $token } # Command [socket] is called with -async, but takes 5s to 5.1s to return, # with probability of order 1 in 10,000. This may be a bizarre scheduling # issue with my (KJN's) system (Fedora Linux). # This does not cause a problem (unless the request times out when this # command returns). # 5. Configure the persistent socket data. if {$state(-keepalive)} { set socketMapping($state(socketinfo)) $sock if {![info exists socketRdState($state(socketinfo))]} { set socketRdState($state(socketinfo)) {} set varName ::http::socketRdState($state(socketinfo)) trace add variable $varName unset ::http::CancelReadPipeline } if {![info exists socketWrState($state(socketinfo))]} { set socketWrState($state(socketinfo)) {} set varName ::http::socketWrState($state(socketinfo)) trace add variable $varName unset ::http::CancelWritePipeline } if {$state(-pipeline)} { #Log new, init for pipelined, GRANT write acc to $token ReplayCore set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token } else { #Log new, init for nonpipeline, GRANT r/w acc to $token ReplayCore set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token } set socketRdQueue($state(socketinfo)) {} set socketWrQueue($state(socketinfo)) $newQueue set socketClosing($state(socketinfo)) 0 set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}} } ##Log pre newQueue ReInit, - token $token # 6. Configure sockets in the queue. foreach tok $newQueue { if {[ReInit $tok]} { set ${tok}(reusing) 1 set ${tok}(sock) $sock } else { set ${tok}(reusing) 1 set ${tok}(sock) NONE Finish $token {cannot send this request again} } } # 7. Configure the socket for newToken to send a request. set state(sock) $sock Log "Using $sock for $state(socketinfo) - token $token" \ [expr {$state(-keepalive)?"keepalive":""}] # Initialisation of a new socket. ##Log socket opened, now fconfigure - token $token fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize) ##Log socket opened, DONE fconfigure - token $token # Connect does its own fconfigure. fileevent $sock writable [list http::Connect $token {*}$tmpConnArgs] #Log ---- $sock << conn to $token for HTTP request (e) } # Data access functions: # Data - the URL data # Status - the transaction status: ok, reset, eof, timeout, error # Code - the HTTP transaction code, e.g., 200 # Size - the size of the URL data proc http::data {token} { variable $token upvar 0 $token state return $state(body) } proc http::status {token} { if {![info exists $token]} { return "error" } variable $token upvar 0 $token state return $state(status) } proc http::code {token} { variable $token upvar 0 $token state return $state(http) } proc http::ncode {token} { variable $token upvar 0 $token state if {[regexp {[0-9]{3}} $state(http) numeric_code]} { return $numeric_code } else { return $state(http) } } proc http::size {token} { variable $token upvar 0 $token state return $state(currentsize) } proc http::meta {token} { variable $token upvar 0 $token state return $state(meta) } proc http::error {token} { variable $token upvar 0 $token state if {[info exists state(error)]} { return $state(error) } return "" } # http::cleanup # # Garbage collect the state associated with a transaction # # Arguments # token The token returned from http::geturl # # Side Effects # Unsets the state array. proc http::cleanup {token} { variable $token upvar 0 $token state if {[info commands ${token}EventCoroutine] ne {}} { rename ${token}EventCoroutine {} } if {[info exists state(after)]} { after cancel $state(after) unset state(after) } if {[info exists state]} { unset state } } # http::Connect # # This callback is made when an asynchronous connection completes. # # Arguments # token The token returned from http::geturl # # Side Effects # Sets the status of the connection, which unblocks # the waiting geturl call proc http::Connect {token proto phost srvurl} { variable $token upvar 0 $token state set tk [namespace tail $token] set err "due to unexpected EOF" if { [eof $state(sock)] || [set err [fconfigure $state(sock) -error]] ne "" } { Log "WARNING - if testing, pay special attention to this\ case (GJ) which is seldom executed - token $token" if {[info exists state(reusing)] && $state(reusing)} { # The socket was closed at the server end, and closed at # this end by http::CheckEof. if {[TestForReplay $token write $err b]} { return } # else: # This is NOT a persistent socket that has been closed since its # last use. # If any other requests are in flight or pipelined/queued, they will # be discarded. } Finish $token "connect failed $err" } else { set state(state) connecting fileevent $state(sock) writable {} ::http::Connected $token $proto $phost $srvurl } } # http::Write # # Write POST query data to the socket # # Arguments # token The token for the connection # # Side Effects # Write the socket and handle callbacks. proc http::Write {token} { variable http variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0 $token state set tk [namespace tail $token] set sock $state(sock) # Output a block. Tcl will buffer this if the socket blocks set done 0 if {[catch { # Catch I/O errors on dead sockets if {[info exists state(-query)]} { # Chop up large query strings so queryprogress callback can give # smooth feedback. if { $state(queryoffset) + $state(-queryblocksize) >= $state(querylength) } { # This will be the last puts for the request-body. if { (![catch {fileevent $sock readable} binding]) && ($binding eq [list http::CheckEof $sock]) } { # Remove the "fileevent readable" binding of an idle # persistent socket to http::CheckEof. We can no longer # treat bytes received as junk. The server might still time # out and half-close the socket if it has not yet received # the first "puts". fileevent $sock readable {} } } puts -nonewline $sock \ [string range $state(-query) $state(queryoffset) \ [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]] incr state(queryoffset) $state(-queryblocksize) if {$state(queryoffset) >= $state(querylength)} { set state(queryoffset) $state(querylength) set done 1 } } else { # Copy blocks from the query channel set outStr [read $state(-querychannel) $state(-queryblocksize)] if {[eof $state(-querychannel)]} { # This will be the last puts for the request-body. if { (![catch {fileevent $sock readable} binding]) && ($binding eq [list http::CheckEof $sock]) } { # Remove the "fileevent readable" binding of an idle # persistent socket to http::CheckEof. We can no longer # treat bytes received as junk. The server might still time # out and half-close the socket if it has not yet received # the first "puts". fileevent $sock readable {} } } puts -nonewline $sock $outStr incr state(queryoffset) [string length $outStr] if {[eof $state(-querychannel)]} { set done 1 } } } err]} { # Do not call Finish here, but instead let the read half of the socket # process whatever server reply there is to get. set state(posterror) $err set done 1 } if {$done} { catch {flush $sock} fileevent $sock writable {} Log ^C$tk end sending request - token $token # End of writing (POST method). The request has been sent. DoneRequest $token } # Callback to the client after we've completely handled everything. if {[string length $state(-queryprogress)]} { eval $state(-queryprogress) \ [list $token $state(querylength) $state(queryoffset)] } } # http::Event # # Handle input on the socket. This command is the core of # the coroutine commands ${token}EventCoroutine that are # bound to "fileevent $sock readable" and process input. # # Arguments # sock The socket receiving input. # token The token returned from http::geturl # # Side Effects # Read the socket and handle callbacks. proc http::Event {sock token} { variable http variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0 $token state set tk [namespace tail $token] while 1 { yield ##Log Event call - token $token if {![info exists state]} { Log "Event $sock with invalid token '$token' - remote close?" if {![eof $sock]} { if {[set d [read $sock]] ne ""} { Log "WARNING: additional data left on closed socket\ - token $token" } } Log ^X$tk end of response (token error) - token $token CloseSocket $sock return } if {$state(state) eq "connecting"} { ##Log - connecting - token $token if { $state(reusing) && $state(-pipeline) && ($state(-timeout) > 0) && (![info exists state(after)]) } { set state(after) [after $state(-timeout) \ [list http::reset $token timeout]] } if {[catch {gets $sock state(http)} nsl]} { Log "WARNING - if testing, pay special attention to this\ case (GK) which is seldom executed - token $token" if {[info exists state(reusing)] && $state(reusing)} { # The socket was closed at the server end, and closed at # this end by http::CheckEof. if {[TestForReplay $token read $nsl c]} { return } # else: # This is NOT a persistent socket that has been closed since # its last use. # If any other requests are in flight or pipelined/queued, # they will be discarded. } else { Log ^X$tk end of response (error) - token $token Finish $token $nsl return } } elseif {$nsl >= 0} { ##Log - connecting 1 - token $token set state(state) "header" } elseif { [eof $sock] && [info exists state(reusing)] && $state(reusing) } { # The socket was closed at the server end, and we didn't notice. # This is the first read - where the closure is usually first # detected. if {[TestForReplay $token read {} d]} { return } # else: # This is NOT a persistent socket that has been closed since its # last use. # If any other requests are in flight or pipelined/queued, they # will be discarded. } } elseif {$state(state) eq "header"} { if {[catch {gets $sock line} nhl]} { ##Log header failed - token $token Log ^X$tk end of response (error) - token $token Finish $token $nhl return } elseif {$nhl == 0} { ##Log header done - token $token Log ^E$tk end of response headers - token $token # We have now read all headers # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3 if { ($state(http) == "") || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100) } { set state(state) "connecting" continue # This was a "return" in the pre-coroutine code. } if { ([info exists state(connection)]) && ([info exists socketMapping($state(socketinfo))]) && ("keep-alive" in $state(connection)) && ($state(-keepalive)) && (!$state(reusing)) && ($state(-pipeline)) } { # Response headers received for first request on a # persistent socket. Now ready for pipelined writes (if # any). # Previous value is $token. It cannot be "pending". set socketWrState($state(socketinfo)) Wready http::NextPipelinedWrite $token } # Once a "close" has been signaled, the client MUST NOT send any # more requests on that connection. # # If either the client or the server sends the "close" token in # the Connection header, that request becomes the last one for # the connection. if { ([info exists state(connection)]) && ([info exists socketMapping($state(socketinfo))]) && ("close" in $state(connection)) && ($state(-keepalive)) } { # The server warns that it will close the socket after this # response. ##Log WARNING - socket will close after response for $token # Prepare data for a call to ReplayIfClose. if { ($socketRdQueue($state(socketinfo)) ne {}) || ($socketWrQueue($state(socketinfo)) ne {}) || ($socketWrState($state(socketinfo)) ni [list Wready peNding $token]) } { set InFlightW $socketWrState($state(socketinfo)) if {$InFlightW in [list Wready peNding $token]} { set InFlightW Wready } else { set msg "token ${InFlightW} is InFlightW" ##Log $msg - token $token } set socketPlayCmd($state(socketinfo)) \ [list ReplayIfClose $InFlightW \ $socketRdQueue($state(socketinfo)) \ $socketWrQueue($state(socketinfo))] # - All tokens are preserved for re-use by ReplayCore. # - Queues are preserved in case of Finish with error, # but are not used for anything else because # socketClosing(*) is set below. # - Cancel the state(after) timeout events. foreach tokenVal $socketRdQueue($state(socketinfo)) { if {[info exists ${tokenVal}(after)]} { after cancel [set ${tokenVal}(after)] unset ${tokenVal}(after) } } } else { set socketPlayCmd($state(socketinfo)) \ {ReplayIfClose Wready {} {}} } # Do not allow further connections on this socket. set socketClosing($state(socketinfo)) 1 } set state(state) body # According to # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection # any comma-separated "Connection:" list implies keep-alive, but I # don't see this in the RFC so we'll play safe and # scan any list for "close". # Done here to support combining duplicate header field's values. if { [info exists state(connection)] && ("close" ni $state(connection)) && ("keep-alive" ni $state(connection)) } { lappend state(connection) "keep-alive" } # If doing a HEAD, then we won't get any body if {$state(-validate)} { Log ^F$tk end of response for HEAD request - token $token set state(state) complete Eot $token return } # - For non-chunked transfer we may have no body - in this case # we may get no further file event if the connection doesn't # close and no more data is sent. We can tell and must finish # up now - not later - the alternative would be to wait until # the server times out. # - In this case, the server has NOT told the client it will # close the connection, AND it has NOT indicated the resource # length EITHER by setting the Content-Length (totalsize) OR # by using chunked Transfer-Encoding. # - Do not worry here about the case (Connection: close) because # the server should close the connection. # - IF (NOT Connection: close) AND (NOT chunked encoding) AND # (totalsize == 0). if { (!( [info exists state(connection)] && ("close" in $state(connection)) ) ) && (![info exists state(transfer)]) && ($state(totalsize) == 0) } { set msg {body size is 0 and no events likely - complete} Log "$msg - token $token" set msg {(length unknown, set to 0)} Log ^F$tk end of response body {*}$msg - token $token set state(state) complete Eot $token return } # We have to use binary translation to count bytes properly. lassign [fconfigure $sock -translation] trRead trWrite fconfigure $sock -translation [list binary $trWrite] if { $state(-binary) || [IsBinaryContentType $state(type)] } { # Turn off conversions for non-text data. set state(binary) 1 } if {[info exists state(-channel)]} { if {$state(binary) || [llength [ContentEncoding $token]]} { fconfigure $state(-channel) -translation binary } if {![info exists state(-handler)]} { # Initiate a sequence of background fcopies. fileevent $sock readable {} rename ${token}EventCoroutine {} CopyStart $sock $token return } } } elseif {$nhl > 0} { # Process header lines. ##Log header - token $token - $line if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} { switch -- [string tolower $key] { content-type { set state(type) [string trim [string tolower $value]] # Grab the optional charset information. if {[regexp -nocase \ {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \ $state(type) -> cs]} { set state(charset) [string map {{\"} \"} $cs] } else { regexp -nocase {charset\s*=\s*(\S+?);?} \ $state(type) -> state(charset) } } content-length { set state(totalsize) [string trim $value] } content-encoding { set state(coding) [string trim $value] } transfer-encoding { set state(transfer) \ [string trim [string tolower $value]] } proxy-connection - connection { # RFC 7230 Section 6.1 states that a comma-separated # list is an acceptable value. foreach el [SplitCommaSeparatedFieldValue $value] { lappend state(connection) [string tolower $el] } } upgrade { set state(upgrade) [string trim $value] } } lappend state(meta) $key [string trim $value] } } } else { # Now reading body ##Log body - token $token if {[catch { if {[info exists state(-handler)]} { set n [eval $state(-handler) [list $sock $token]] ##Log handler $n - token $token # N.B. the protocol has been set to 1.0 because the -handler # logic is not expected to handle chunked encoding. # FIXME Allow -handler with 1.1 on dechunked stacked chan. if {$state(totalsize) == 0} { # We know the transfer is complete only when the server # closes the connection - i.e. eof is not an error. set state(state) complete } if {![string is integer -strict $n]} { if 1 { # Do not tolerate bad -handler - fail with error # status. set msg {the -handler command for http::geturl must\ return an integer (the number of bytes\ read)} Log ^X$tk end of response (handler error) -\ token $token Eot $token $msg } else { # Tolerate the bad -handler, and continue. The # penalty: # (a) Because the handler returns nonsense, we know # the transfer is complete only when the server # closes the connection - i.e. eof is not an # error. # (b) http::size will not be accurate. # (c) The transaction is already downgraded to 1.0 # to avoid chunked transfer encoding. It MUST # also be forced to "Connection: close" or the # HTTP/1.0 equivalent; or it MUST fail (as # above) if the server sends # "Connection: keep-alive" or the HTTP/1.0 # equivalent. set n 0 set state(state) complete } } } elseif {[info exists state(transfer_final)]} { # This code forgives EOF in place of the final CRLF. set line [getTextLine $sock] set n [string length $line] set state(state) complete if {$n > 0} { # - HTTP trailers (late response headers) are permitted # by Chunked Transfer-Encoding, and can be safely # ignored. # - Do not count these bytes in the total received for # the response body. Log "trailer of $n bytes after final chunk -\ token $token" append state(transfer_final) $line set n 0 } else { Log ^F$tk end of response body (chunked) - token $token Log "final chunk part - token $token" Eot $token } } elseif { [info exists state(transfer)] && ($state(transfer) eq "chunked") } { ##Log chunked - token $token set size 0 set hexLenChunk [getTextLine $sock] #set ntl [string length $hexLenChunk] if {[string trim $hexLenChunk] ne ""} { scan $hexLenChunk %x size if {$size != 0} { ##Log chunk-measure $size - token $token set chunk [BlockingRead $sock $size] set n [string length $chunk] if {$n >= 0} { append state(body) $chunk incr state(log_size) [string length $chunk] ##Log chunk $n cumul $state(log_size) -\ token $token } if {$size != [string length $chunk]} { Log "WARNING: mis-sized chunk:\ was [string length $chunk], should be\ $size - token $token" set n 0 set state(connection) close Log ^X$tk end of response (chunk error) \ - token $token set msg {error in chunked encoding - fetch\ terminated} Eot $token $msg } # CRLF that follows chunk. # If eof, this is handled at the end of this proc. getTextLine $sock } else { set n 0 set state(transfer_final) {} } } else { # Line expected to hold chunk length is empty, or eof. ##Log bad-chunk-measure - token $token set n 0 set state(connection) close Log ^X$tk end of response (chunk error) - token $token Eot $token {error in chunked encoding -\ fetch terminated} } } else { ##Log unchunked - token $token if {$state(totalsize) == 0} { # We know the transfer is complete only when the server # closes the connection. set state(state) complete set reqSize $state(-blocksize) } else { # Ask for the whole of the unserved response-body. # This works around a problem with a tls::socket - for # https in keep-alive mode, and a request for # $state(-blocksize) bytes, the last part of the # resource does not get read until the server times out. set reqSize [expr { $state(totalsize) - $state(currentsize)}] # The workaround fails if reqSize is # capped at $state(-blocksize). # set reqSize [expr {min($reqSize, $state(-blocksize))}] } set c $state(currentsize) set t $state(totalsize) ##Log non-chunk currentsize $c of totalsize $t -\ token $token set block [read $sock $reqSize] set n [string length $block] if {$n >= 0} { append state(body) $block ##Log non-chunk [string length $state(body)] -\ token $token } } # This calculation uses n from the -handler, chunked, or # unchunked case as appropriate. if {[info exists state]} { if {$n >= 0} { incr state(currentsize) $n set c $state(currentsize) set t $state(totalsize) ##Log another $n currentsize $c totalsize $t -\ token $token } # If Content-Length - check for end of data. if { ($state(totalsize) > 0) && ($state(currentsize) >= $state(totalsize)) } { Log ^F$tk end of response body (unchunked) -\ token $token set state(state) complete Eot $token } } } err]} { Log ^X$tk end of response (error ${err}) - token $token Finish $token $err return } else { if {[info exists state(-progress)]} { eval $state(-progress) \ [list $token $state(totalsize) $state(currentsize)] } } } # catch as an Eot above may have closed the socket already # $state(state) may be connecting, header, body, or complete if {![set cc [catch {eof $sock} eof]] && $eof} { ##Log eof - token $token if {[info exists $token]} { set state(connection) close if {$state(state) eq "complete"} { # This includes all cases in which the transaction # can be completed by eof. # The value "complete" is set only in http::Event, and it is # used only in the test above. Log ^F$tk end of response body (unchunked, eof) -\ token $token Eot $token } else { # Premature eof. Log ^X$tk end of response (unexpected eof) - token $token Eot $token eof } } else { # open connection closed on a token that has been cleaned up. Log ^X$tk end of response (token error) - token $token CloseSocket $sock } } elseif {$cc} { return } } } # http::TestForReplay # # Command called if eof is discovered when a socket is first used for a # new transaction. Typically this occurs if a persistent socket is used # after a period of idleness and the server has half-closed the socket. # # token - the connection token returned by http::geturl # doing - "read" or "write" # err - error message, if any # caller - code to identify the caller - used only in logging # # Return Value: boolean, true iff the command calls http::ReplayIfDead. proc http::TestForReplay {token doing err caller} { variable http variable $token upvar 0 $token state set tk [namespace tail $token] if {$doing eq "read"} { set code Q set action response set ing reading } else { set code P set action request set ing writing } if {$err eq {}} { set err "detect eof when $ing (server timed out?)" } if {$state(method) eq "POST" && !$http(-repost)} { # No Replay. # The present transaction will end when Finish is called. # That call to Finish will abort any other transactions # currently in the write queue. # For calls from http::Event this occurs when execution # reaches the code block at the end of that proc. set msg {no retry for POST with http::config -repost 0} Log reusing socket failed "($caller)" - $msg - token $token Log error - $err - token $token Log ^X$tk end of $action (error) - token $token return 0 } else { # Replay. set msg {try a new socket} Log reusing socket failed "($caller)" - $msg - token $token Log error - $err - token $token Log ^$code$tk Any unfinished (incl this one) failed - token $token ReplayIfDead $token $doing return 1 } } # http::IsBinaryContentType -- # # Determine if the content-type means that we should definitely transfer # the data as binary. [Bug 838e99a76d] # # Arguments # type The content-type of the data. # # Results: # Boolean, true if we definitely should be binary. proc http::IsBinaryContentType {type} { lassign [split [string tolower $type] "/;"] major minor if {$major eq "text"} { return false } # There's a bunch of XML-as-application-format things about. See RFC 3023 # and so on. if {$major eq "application"} { set minor [string trimright $minor] if {$minor in {"json" "xml" "xml-external-parsed-entity" "xml-dtd"}} { return false } } # Not just application/foobar+xml but also image/svg+xml, so let us not # restrict things for now... if {[string match "*+xml" $minor]} { return false } return true } # http::getTextLine -- # # Get one line with the stream in crlf mode. # Used if Transfer-Encoding is chunked. # Empty line is not distinguished from eof. The caller must # be able to handle this. # # Arguments # sock The socket receiving input. # # Results: # The line of text, without trailing newline proc http::getTextLine {sock} { set tr [fconfigure $sock -translation] lassign $tr trRead trWrite fconfigure $sock -translation [list crlf $trWrite] set r [BlockingGets $sock] fconfigure $sock -translation $tr return $r } # http::BlockingRead # # Replacement for a blocking read. # The caller must be a coroutine. proc http::BlockingRead {sock size} { if {$size < 1} { return } set result {} while 1 { set need [expr {$size - [string length $result]}] set block [read $sock $need] set eof [eof $sock] append result $block if {[string length $result] >= $size || $eof} { return $result } else { yield } } } # http::BlockingGets # # Replacement for a blocking gets. # The caller must be a coroutine. # Empty line is not distinguished from eof. The caller must # be able to handle this. proc http::BlockingGets {sock} { while 1 { set count [gets $sock line] set eof [eof $sock] if {$count >= 0 || $eof} { return $line } else { yield } } } # http::CopyStart # # Error handling wrapper around fcopy # # Arguments # sock The socket to copy from # token The token returned from http::geturl # # Side Effects # This closes the connection upon error proc http::CopyStart {sock token {initial 1}} { upvar #0 $token state if {[info exists state(transfer)] && $state(transfer) eq "chunked"} { foreach coding [ContentEncoding $token] { lappend state(zlib) [zlib stream $coding] } make-transformation-chunked $sock [namespace code [list CopyChunk $token]] } else { if {$initial} { foreach coding [ContentEncoding $token] { zlib push $coding $sock } } if {[catch { # FIXME Keep-Alive on https tls::socket with unchunked transfer # hangs until the server times out. A workaround is possible, as for # the case without -channel, but it does not use the neat "fcopy" # solution. fcopy $sock $state(-channel) -size $state(-blocksize) -command \ [list http::CopyDone $token] } err]} { Finish $token $err } } } proc http::CopyChunk {token chunk} { upvar 0 $token state if {[set count [string length $chunk]]} { incr state(currentsize) $count if {[info exists state(zlib)]} { foreach stream $state(zlib) { set chunk [$stream add $chunk] } } puts -nonewline $state(-channel) $chunk if {[info exists state(-progress)]} { eval [linsert $state(-progress) end \ $token $state(totalsize) $state(currentsize)] } } else { Log "CopyChunk Finish - token $token" if {[info exists state(zlib)]} { set excess "" foreach stream $state(zlib) { catch {set excess [$stream add -finalize $excess]} } puts -nonewline $state(-channel) $excess foreach stream $state(zlib) { $stream close } unset state(zlib) } Eot $token ;# FIX ME: pipelining. } } # http::CopyDone # # fcopy completion callback # # Arguments # token The token returned from http::geturl # count The amount transferred # # Side Effects # Invokes callbacks proc http::CopyDone {token count {error {}}} { variable $token upvar 0 $token state set sock $state(sock) incr state(currentsize) $count if {[info exists state(-progress)]} { eval $state(-progress) \ [list $token $state(totalsize) $state(currentsize)] } # At this point the token may have been reset. if {[string length $error]} { Finish $token $error } elseif {[catch {eof $sock} iseof] || $iseof} { Eot $token } else { CopyStart $sock $token 0 } } # http::Eot # # Called when either: # a. An eof condition is detected on the socket. # b. The client decides that the response is complete. # c. The client detects an inconsistency and aborts the transaction. # # Does: # 1. Set state(status) # 2. Reverse any Content-Encoding # 3. Convert charset encoding and line ends if necessary # 4. Call http::Finish # # Arguments # token The token returned from http::geturl # force (previously) optional, has no effect # reason - "eof" means premature EOF (not EOF as the natural end of # the response) # - "" means completion of response, with or without EOF # - anything else describes an error condition other than # premature EOF. # # Side Effects # Clean up the socket proc http::Eot {token {reason {}}} { variable $token upvar 0 $token state if {$reason eq "eof"} { # Premature eof. set state(status) eof set reason {} } elseif {$reason ne ""} { # Abort the transaction. set state(status) $reason } else { # The response is complete. set state(status) ok } if {[string length $state(body)] > 0} { if {[catch { foreach coding [ContentEncoding $token] { set state(body) [zlib $coding $state(body)] } } err]} { Log "error doing decompression for token $token: $err" Finish $token $err return } if {!$state(binary)} { # If we are getting text, set the incoming channel's encoding # correctly. iso8859-1 is the RFC default, but this could be any # IANA charset. However, we only know how to convert what we have # encodings for. set enc [CharsetToEncoding $state(charset)] if {$enc ne "binary"} { set state(body) [encoding convertfrom $enc $state(body)] } # Translate text line endings. set state(body) [string map {\r\n \n \r \n} $state(body)] } } Finish $token $reason } # http::wait -- # # See documentation for details. # # Arguments: # token Connection token. # # Results: # The status after the wait. proc http::wait {token} { variable $token upvar 0 $token state if {![info exists state(status)] || $state(status) eq ""} { # We must wait on the original variable name, not the upvar alias vwait ${token}(status) } return [status $token] } # http::formatQuery -- # # See documentation for details. Call http::formatQuery with an even # number of arguments, where the first is a name, the second is a value, # the third is another name, and so on. # # Arguments: # args A list of name-value pairs. # # Results: # TODO proc http::formatQuery {args} { if {[llength $args] % 2} { return \ -code error \ -errorcode [list HTTP BADARGCNT $args] \ {Incorrect number of arguments, must be an even number.} } set result "" set sep "" foreach i $args { append result $sep [mapReply $i] if {$sep eq "="} { set sep & } else { set sep = } } return $result } # http::mapReply -- # # Do x-www-urlencoded character mapping # # Arguments: # string The string the needs to be encoded # # Results: # The encoded string proc http::mapReply {string} { variable http variable formMap # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use # a pre-computed map and [string map] to do the conversion (much faster # than [regsub]/[subst]). [Bug 1020491] if {$http(-urlencoding) ne ""} { set string [encoding convertto $http(-urlencoding) $string] return [string map $formMap $string] } set converted [string map $formMap $string] if {[string match "*\[\u0100-\uffff\]*" $converted]} { regexp "\[\u0100-\uffff\]" $converted badChar # Return this error message for maximum compatibility... :^/ return -code error \ "can't read \"formMap($badChar)\": no such element in array" } return $converted } interp alias {} http::quoteString {} http::mapReply # http::ProxyRequired -- # Default proxy filter. # # Arguments: # host The destination host # # Results: # The current proxy settings proc http::ProxyRequired {host} { variable http if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} { if { ![info exists http(-proxyport)] || ![string length $http(-proxyport)] } { set http(-proxyport) 8080 } return [list $http(-proxyhost) $http(-proxyport)] } } # http::CharsetToEncoding -- # # Tries to map a given IANA charset to a tcl encoding. If no encoding # can be found, returns binary. # proc http::CharsetToEncoding {charset} { variable encodings set charset [string tolower $charset] if {[regexp {iso-?8859-([0-9]+)} $charset -> num]} { set encoding "iso8859-$num" } elseif {[regexp {iso-?2022-(jp|kr)} $charset -> ext]} { set encoding "iso2022-$ext" } elseif {[regexp {shift[-_]?jis} $charset]} { set encoding "shiftjis" } elseif {[regexp {(?:windows|cp)-?([0-9]+)} $charset -> num]} { set encoding "cp$num" } elseif {$charset eq "us-ascii"} { set encoding "ascii" } elseif {[regexp {(?:iso-?)?lat(?:in)?-?([0-9]+)} $charset -> num]} { switch -- $num { 5 {set encoding "iso8859-9"} 1 - 2 - 3 { set encoding "iso8859-$num" } default { set encoding "binary" } } } else { # other charset, like euc-xx, utf-8,... may directly map to encoding set encoding $charset } set idx [lsearch -exact $encodings $encoding] if {$idx >= 0} { return $encoding } else { return "binary" } } # Return the list of content-encoding transformations we need to do in order. proc http::ContentEncoding {token} { upvar 0 $token state set r {} if {[info exists state(coding)]} { foreach coding [split $state(coding) ,] { switch -exact -- $coding { deflate { lappend r inflate } gzip - x-gzip { lappend r gunzip } compress - x-compress { lappend r decompress } identity {} br { return -code error\ "content-encoding \"br\" not implemented" } default { Log "unknown content-encoding \"$coding\" ignored" } } } } return $r } proc http::ReceiveChunked {chan command} { set data "" set size -1 yield while {1} { chan configure $chan -translation {crlf binary} while {[gets $chan line] < 1} { yield } chan configure $chan -translation {binary binary} if {[scan $line %x size] != 1} { return -code error "invalid size: \"$line\"" } set chunk "" while {$size && ![chan eof $chan]} { set part [chan read $chan $size] incr size -[string length $part] append chunk $part } if {[catch { uplevel #0 [linsert $command end $chunk] }]} { http::Log "Error in callback: $::errorInfo" } if {[string length $chunk] == 0} { # channel might have been closed in the callback catch {chan event $chan readable {}} return } } } # http::SplitCommaSeparatedFieldValue -- # Return the individual values of a comma-separated field value. # # Arguments: # fieldValue Comma-separated header field value. # # Results: # List of values. proc http::SplitCommaSeparatedFieldValue {fieldValue} { set r {} foreach el [split $fieldValue ,] { lappend r [string trim $el] } return $r } # http::GetFieldValue -- # Return the value of a header field. # # Arguments: # headers Headers key-value list # fieldName Name of header field whose value to return. # # Results: # The value of the fieldName header field # # Field names are matched case-insensitively (RFC 7230 Section 3.2). # # If the field is present multiple times, it is assumed that the field is # defined as a comma-separated list and the values are combined (by separating # them with commas, see RFC 7230 Section 3.2.2) and returned at once. proc http::GetFieldValue {headers fieldName} { set r {} foreach {field value} $headers { if {[string equal -nocase $fieldName $field]} { if {$r eq {}} { set r $value } else { append r ", $value" } } } return $r } proc http::make-transformation-chunked {chan command} { coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command chan event $chan readable [namespace current]::dechunk$chan } # Local variables: # indent-tabs-mode: t # End: tcl8.6.14/library/http/pkgIndex.tcl0000644000175000017500000000042614554262142016544 0ustar sergeisergeiif {![package vsatisfies [package provide Tcl] 8.6-]} {return} package ifneeded http 2.9.8 [list tclPkgSetup $dir http 2.9.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] tcl8.6.14/library/opt/0000755000175000017500000000000014566153412014112 5ustar sergeisergeitcl8.6.14/library/opt/optparse.tcl0000644000175000017500000007771414563206224016470 0ustar sergeisergei# optparse.tcl -- # # (private) Option parsing package # Primarily used internally by the safe:: code. # # WARNING: This code will go away in a future release # of Tcl. It is NOT supported and you should not rely # on it. If your code does rely on this package you # may directly incorporate this code into your application. package require Tcl 8.5- # When this version number changes, update the pkgIndex.tcl file # and the install directory in the Makefiles. package provide opt 0.4.9 namespace eval ::tcl { # Exported APIs namespace export OptKeyRegister OptKeyDelete OptKeyError OptKeyParse \ OptProc OptProcArgGiven OptParse \ Lempty Lget \ Lassign Lvarpop Lvarpop1 Lvarset Lvarincr \ SetMax SetMin ################# Example of use / 'user documentation' ################### proc OptCreateTestProc {} { # Defines ::tcl::OptParseTest as a test proc with parsed arguments # (can't be defined before the code below is loaded (before "OptProc")) # Every OptProc give usage information on "procname -help". # Try "tcl::OptParseTest -help" and "tcl::OptParseTest -a" and # then other arguments. # # example of 'valid' call: # ::tcl::OptParseTest save -4 -pr 23 -libsok SybTcl\ # -nostatics false ch1 OptProc OptParseTest { {subcommand -choice {save print} "sub command"} {arg1 3 "some number"} {-aflag} {-intflag 7} {-weirdflag "help string"} {-noStatics "Not ok to load static packages"} {-nestedloading1 true "OK to load into nested children"} {-nestedloading2 -boolean true "OK to load into nested children"} {-libsOK -choice {Tk SybTcl} "List of packages that can be loaded"} {-precision -int 12 "Number of digits of precision"} {-intval 7 "An integer"} {-scale -float 1.0 "Scale factor"} {-zoom 1.0 "Zoom factor"} {-arbitrary foobar "Arbitrary string"} {-random -string 12 "Random string"} {-listval -list {} "List value"} {-blahflag -blah abc "Funny type"} {arg2 -boolean "a boolean"} {arg3 -choice "ch1 ch2"} {?optarg? -list {} "optional argument"} } { foreach v [info locals] { puts stderr [format "%14s : %s" $v [set $v]] } } } ################### No User serviceable part below ! ############### # Array storing the parsed descriptions variable OptDesc array set OptDesc {} # Next potentially free key id (numeric) variable OptDescN 0 # Inside algorithm/mechanism description: # (not for the faint-hearted ;-) # # The argument description is parsed into a "program tree" # It is called a "program" because it is the program used by # the state machine interpreter that use that program to # actually parse the arguments at run time. # # The general structure of a "program" is # notation (pseudo bnf like) # name :== definition defines "name" as being "definition" # { x y z } means list of x, y, and z # x* means x repeated 0 or more time # x+ means "x x*" # x? means optionally x # x | y means x or y # "cccc" means the literal string # # program :== { programCounter programStep* } # # programStep :== program | singleStep # # programCounter :== {"P" integer+ } # # singleStep :== { instruction parameters* } # # instruction :== single element list # # (the difference between singleStep and program is that \ # llength [lindex $program 0] >= 2 # while # llength [lindex $singleStep 0] == 1 # ) # # And for this application: # # singleStep :== { instruction varname {hasBeenSet currentValue} type # typeArgs help } # instruction :== "flags" | "value" # type :== knowType | anyword # knowType :== "string" | "int" | "boolean" | "boolflag" | "float" # | "choice" # # for type "choice" typeArgs is a list of possible choices, the first one # is the default value. for all other types the typeArgs is the default value # # a "boolflag" is the type for a flag whose presence or absence, without # additional arguments means respectively true or false (default flag type). # # programCounter is the index in the list of the currently processed # programStep (thus starting at 1 (0 is {"P" prgCounterValue}). # If it is a list it points toward each currently selected programStep. # (like for "flags", as they are optional, form a set and programStep). # Performance/Implementation issues # --------------------------------- # We use tcl lists instead of arrays because with tcl8.0 # they should start to be much faster. # But this code use a lot of helper procs (like Lvarset) # which are quite slow and would be helpfully optimized # for instance by being written in C. Also our structure # is complex and there is maybe some places where the # string rep might be calculated at great expense. to be checked. # # Parse a given description and saves it here under the given key # generate a unused keyid if not given # proc ::tcl::OptKeyRegister {desc {key ""}} { variable OptDesc variable OptDescN if {[string equal $key ""]} { # in case a key given to us as a parameter was a number while {[info exists OptDesc($OptDescN)]} {incr OptDescN} set key $OptDescN incr OptDescN } # program counter set program [list [list "P" 1]] # are we processing flags (which makes a single program step) set inflags 0 set state {} # flag used to detect that we just have a single (flags set) subprogram. set empty 1 foreach item $desc { if {$state == "args"} { # more items after 'args'... return -code error "'args' special argument must be the last one" } set res [OptNormalizeOne $item] set state [lindex $res 0] if {$inflags} { if {$state == "flags"} { # add to 'subprogram' lappend flagsprg $res } else { # put in the flags # structure for flag programs items is a list of # {subprgcounter {prg flag 1} {prg flag 2} {...}} lappend program $flagsprg # put the other regular stuff lappend program $res set inflags 0 set empty 0 } } else { if {$state == "flags"} { set inflags 1 # sub program counter + first sub program set flagsprg [list [list "P" 1] $res] } else { lappend program $res set empty 0 } } } if {$inflags} { if {$empty} { # We just have the subprogram, optimize and remove # unneeded level: set program $flagsprg } else { lappend program $flagsprg } } set OptDesc($key) $program return $key } # # Free the storage for that given key # proc ::tcl::OptKeyDelete {key} { variable OptDesc unset OptDesc($key) } # Get the parsed description stored under the given key. proc OptKeyGetDesc {descKey} { variable OptDesc if {![info exists OptDesc($descKey)]} { return -code error "Unknown option description key \"$descKey\"" } set OptDesc($descKey) } # Parse entry point for people who don't want to register with a key, # for instance because the description changes dynamically. # (otherwise one should really use OptKeyRegister once + OptKeyParse # as it is way faster or simply OptProc which does it all) # Assign a temporary key, call OptKeyParse and then free the storage proc ::tcl::OptParse {desc arglist} { set tempkey [OptKeyRegister $desc] set ret [catch {uplevel 1 [list ::tcl::OptKeyParse $tempkey $arglist]} res] OptKeyDelete $tempkey return -code $ret $res } # Helper function, replacement for proc that both # register the description under a key which is the name of the proc # (and thus unique to that code) # and add a first line to the code to call the OptKeyParse proc # Stores the list of variables that have been actually given by the user # (the other will be sets to their default value) # into local variable named "Args". proc ::tcl::OptProc {name desc body} { set namespace [uplevel 1 [list ::namespace current]] if {[string match "::*" $name] || [string equal $namespace "::"]} { # absolute name or global namespace, name is the key set key $name } else { # we are relative to some non top level namespace: set key "${namespace}::${name}" } OptKeyRegister $desc $key uplevel 1 [list ::proc $name args "set Args \[::tcl::OptKeyParse $key \$args\]\n$body"] return $key } # Check that a argument has been given # assumes that "OptProc" has been used as it will check in "Args" list proc ::tcl::OptProcArgGiven {argname} { upvar Args alist expr {[lsearch $alist $argname] >=0} } ####### # Programs/Descriptions manipulation # Return the instruction word/list of a given step/(sub)program proc OptInstr {lst} { lindex $lst 0 } # Is a (sub) program or a plain instruction ? proc OptIsPrg {lst} { expr {[llength [OptInstr $lst]]>=2} } # Is this instruction a program counter or a real instr proc OptIsCounter {item} { expr {[lindex $item 0]=="P"} } # Current program counter (2nd word of first word) proc OptGetPrgCounter {lst} { Lget $lst {0 1} } # Current program counter (2nd word of first word) proc OptSetPrgCounter {lstName newValue} { upvar $lstName lst set lst [lreplace $lst 0 0 [concat "P" $newValue]] } # returns a list of currently selected items. proc OptSelection {lst} { set res {} foreach idx [lrange [lindex $lst 0] 1 end] { lappend res [Lget $lst $idx] } return $res } # Advance to next description proc OptNextDesc {descName} { uplevel 1 [list Lvarincr $descName {0 1}] } # Get the current description, eventually descend proc OptCurDesc {descriptions} { lindex $descriptions [OptGetPrgCounter $descriptions] } # get the current description, eventually descend # through sub programs as needed. proc OptCurDescFinal {descriptions} { set item [OptCurDesc $descriptions] # Descend untill we get the actual item and not a sub program while {[OptIsPrg $item]} { set item [OptCurDesc $item] } return $item } # Current final instruction adress proc OptCurAddr {descriptions {start {}}} { set adress [OptGetPrgCounter $descriptions] lappend start $adress set item [lindex $descriptions $adress] if {[OptIsPrg $item]} { return [OptCurAddr $item $start] } else { return $start } } # Set the value field of the current instruction. proc OptCurSetValue {descriptionsName value} { upvar $descriptionsName descriptions # Get the current item full address. set adress [OptCurAddr $descriptions] # Use the 3rd field of the item (see OptValue / OptNewInst). lappend adress 2 Lvarset descriptions $adress [list 1 $value] # ^hasBeenSet flag } # Empty state means done/paste the end of the program. proc OptState {item} { lindex $item 0 } # current state proc OptCurState {descriptions} { OptState [OptCurDesc $descriptions] } ####### # Arguments manipulation # Returns the argument that has to be processed now. proc OptCurrentArg {lst} { lindex $lst 0 } # Advance to next argument. proc OptNextArg {argsName} { uplevel 1 [list Lvarpop1 $argsName] } ####### # Loop over all descriptions, calling OptDoOne which will # eventually eat all the arguments. proc OptDoAll {descriptionsName argumentsName} { upvar $descriptionsName descriptions upvar $argumentsName arguments # puts "entered DoAll" # Nb: the places where "state" can be set are tricky to figure # because DoOne sets the state to flagsValue and return -continue # when needed... set state [OptCurState $descriptions] # We'll exit the loop in "OptDoOne" or when state is empty. while 1 { set curitem [OptCurDesc $descriptions] # Do subprograms if needed, call ourselves on the sub branch while {[OptIsPrg $curitem]} { OptDoAll curitem arguments # puts "done DoAll sub" # Insert back the results in current tree Lvarset1nc descriptions [OptGetPrgCounter $descriptions]\ $curitem OptNextDesc descriptions set curitem [OptCurDesc $descriptions] set state [OptCurState $descriptions] } # puts "state = \"$state\" - arguments=($arguments)" if {[Lempty $state]} { # Nothing left to do, we are done in this branch: break } # The following statement can make us terminate/continue # as it use return -code {break, continue, return and error} # codes OptDoOne descriptions state arguments # If we are here, no special return code where issued, # we'll step to next instruction : # puts "new state = \"$state\"" OptNextDesc descriptions set state [OptCurState $descriptions] } } # Process one step for the state machine, # eventually consuming the current argument. proc OptDoOne {descriptionsName stateName argumentsName} { upvar $argumentsName arguments upvar $descriptionsName descriptions upvar $stateName state # the special state/instruction "args" eats all # the remaining args (if any) if {($state == "args")} { if {![Lempty $arguments]} { # If there is no additional arguments, leave the default value # in. OptCurSetValue descriptions $arguments set arguments {} } # puts "breaking out ('args' state: consuming every reminding args)" return -code break } if {[Lempty $arguments]} { if {$state == "flags"} { # no argument and no flags : we're done # puts "returning to previous (sub)prg (no more args)" return -code return } elseif {$state == "optValue"} { set state next; # not used, for debug only # go to next state return } else { return -code error [OptMissingValue $descriptions] } } else { set arg [OptCurrentArg $arguments] } switch $state { flags { # A non-dash argument terminates the options, as does -- # Still a flag ? if {![OptIsFlag $arg]} { # don't consume the argument, return to previous prg return -code return } # consume the flag OptNextArg arguments if {[string equal "--" $arg]} { # return from 'flags' state return -code return } set hits [OptHits descriptions $arg] if {$hits > 1} { return -code error [OptAmbigous $descriptions $arg] } elseif {$hits == 0} { return -code error [OptFlagUsage $descriptions $arg] } set item [OptCurDesc $descriptions] if {[OptNeedValue $item]} { # we need a value, next state is set state flagValue } else { OptCurSetValue descriptions 1 } # continue return -code continue } flagValue - value { set item [OptCurDesc $descriptions] # Test the values against their required type if {[catch {OptCheckType $arg\ [OptType $item] [OptTypeArgs $item]} val]} { return -code error [OptBadValue $item $arg $val] } # consume the value OptNextArg arguments # set the value OptCurSetValue descriptions $val # go to next state if {$state == "flagValue"} { set state flags return -code continue } else { set state next; # not used, for debug only return ; # will go on next step } } optValue { set item [OptCurDesc $descriptions] # Test the values against their required type if {![catch {OptCheckType $arg\ [OptType $item] [OptTypeArgs $item]} val]} { # right type, so : # consume the value OptNextArg arguments # set the value OptCurSetValue descriptions $val } # go to next state set state next; # not used, for debug only return ; # will go on next step } } # If we reach this point: an unknown # state as been entered ! return -code error "Bug! unknown state in DoOne \"$state\"\ (prg counter [OptGetPrgCounter $descriptions]:\ [OptCurDesc $descriptions])" } # Parse the options given the key to previously registered description # and arguments list proc ::tcl::OptKeyParse {descKey arglist} { set desc [OptKeyGetDesc $descKey] # make sure -help always give usage if {[string equal -nocase "-help" $arglist]} { return -code error [OptError "Usage information:" $desc 1] } OptDoAll desc arglist if {![Lempty $arglist]} { return -code error [OptTooManyArgs $desc $arglist] } # Analyse the result # Walk through the tree: OptTreeVars $desc "#[expr {[info level]-1}]" } # determine string length for nice tabulated output proc OptTreeVars {desc level {vnamesLst {}}} { foreach item $desc { if {[OptIsCounter $item]} continue if {[OptIsPrg $item]} { set vnamesLst [OptTreeVars $item $level $vnamesLst] } else { set vname [OptVarName $item] upvar $level $vname var if {[OptHasBeenSet $item]} { # puts "adding $vname" # lets use the input name for the returned list # it is more useful, for instance you can check that # no flags at all was given with expr # {![string match "*-*" $Args]} lappend vnamesLst [OptName $item] set var [OptValue $item] } else { set var [OptDefaultValue $item] } } } return $vnamesLst } # Check the type of a value # and emit an error if arg is not of the correct type # otherwise returns the canonical value of that arg (ie 0/1 for booleans) proc ::tcl::OptCheckType {arg type {typeArgs ""}} { # puts "checking '$arg' against '$type' ($typeArgs)" # only types "any", "choice", and numbers can have leading "-" switch -exact -- $type { int { if {![string is integer -strict $arg]} { error "not an integer" } return $arg } float { return [expr {double($arg)}] } script - list { # if llength fail : malformed list if {[llength $arg]==0 && [OptIsFlag $arg]} { error "no values with leading -" } return $arg } boolean { if {![string is boolean -strict $arg]} { error "non canonic boolean" } # convert true/false because expr/if is broken with "!,... return [expr {$arg ? 1 : 0}] } choice { if {$arg ni $typeArgs} { error "invalid choice" } return $arg } any { return $arg } string - default { if {[OptIsFlag $arg]} { error "no values with leading -" } return $arg } } return neverReached } # internal utilities # returns the number of flags matching the given arg # sets the (local) prg counter to the list of matches proc OptHits {descName arg} { upvar $descName desc set hits 0 set hitems {} set i 1 set larg [string tolower $arg] set len [string length $larg] set last [expr {$len-1}] foreach item [lrange $desc 1 end] { set flag [OptName $item] # lets try to match case insensitively # (string length ought to be cheap) set lflag [string tolower $flag] if {$len == [string length $lflag]} { if {[string equal $larg $lflag]} { # Exact match case OptSetPrgCounter desc $i return 1 } } elseif {[string equal $larg [string range $lflag 0 $last]]} { lappend hitems $i incr hits } incr i } if {$hits} { OptSetPrgCounter desc $hitems } return $hits } # Extract fields from the list structure: proc OptName {item} { lindex $item 1 } proc OptHasBeenSet {item} { Lget $item {2 0} } proc OptValue {item} { Lget $item {2 1} } proc OptIsFlag {name} { string match "-*" $name } proc OptIsOpt {name} { string match {\?*} $name } proc OptVarName {item} { set name [OptName $item] if {[OptIsFlag $name]} { return [string range $name 1 end] } elseif {[OptIsOpt $name]} { return [string trim $name "?"] } else { return $name } } proc OptType {item} { lindex $item 3 } proc OptTypeArgs {item} { lindex $item 4 } proc OptHelp {item} { lindex $item 5 } proc OptNeedValue {item} { expr {![string equal [OptType $item] boolflag]} } proc OptDefaultValue {item} { set val [OptTypeArgs $item] switch -exact -- [OptType $item] { choice {return [lindex $val 0]} boolean - boolflag { # convert back false/true to 0/1 because expr !$bool # is broken.. if {$val} { return 1 } else { return 0 } } } return $val } # Description format error helper proc OptOptUsage {item {what ""}} { return -code error "invalid description format$what: $item\n\ should be a list of {varname|-flagname ?-type? ?defaultvalue?\ ?helpstring?}" } # Generate a canonical form single instruction proc OptNewInst {state varname type typeArgs help} { list $state $varname [list 0 {}] $type $typeArgs $help # ^ ^ # | | # hasBeenSet=+ +=currentValue } # Translate one item to canonical form proc OptNormalizeOne {item} { set lg [Lassign $item varname arg1 arg2 arg3] # puts "called optnormalizeone '$item' v=($varname), lg=$lg" set isflag [OptIsFlag $varname] set isopt [OptIsOpt $varname] if {$isflag} { set state "flags" } elseif {$isopt} { set state "optValue" } elseif {![string equal $varname "args"]} { set state "value" } else { set state "args" } # apply 'smart' 'fuzzy' logic to try to make # description writer's life easy, and our's difficult : # let's guess the missing arguments :-) switch $lg { 1 { if {$isflag} { return [OptNewInst $state $varname boolflag false ""] } else { return [OptNewInst $state $varname any "" ""] } } 2 { # varname default # varname help set type [OptGuessType $arg1] if {[string equal $type "string"]} { if {$isflag} { set type boolflag set def false } else { set type any set def "" } set help $arg1 } else { set help "" set def $arg1 } return [OptNewInst $state $varname $type $def $help] } 3 { # varname type value # varname value comment if {[regexp {^-(.+)$} $arg1 x type]} { # flags/optValue as they are optional, need a "value", # on the contrary, for a variable (non optional), # default value is pointless, 'cept for choices : if {$isflag || $isopt || ($type == "choice")} { return [OptNewInst $state $varname $type $arg2 ""] } else { return [OptNewInst $state $varname $type "" $arg2] } } else { return [OptNewInst $state $varname\ [OptGuessType $arg1] $arg1 $arg2] } } 4 { if {[regexp {^-(.+)$} $arg1 x type]} { return [OptNewInst $state $varname $type $arg2 $arg3] } else { return -code error [OptOptUsage $item] } } default { return -code error [OptOptUsage $item] } } } # Auto magic lazy type determination proc OptGuessType {arg} { if { $arg == "true" || $arg == "false" } { return boolean } if {[string is integer -strict $arg]} { return int } if {[string is double -strict $arg]} { return float } return string } # Error messages front ends proc OptAmbigous {desc arg} { OptError "ambigous option \"$arg\", choose from:" [OptSelection $desc] } proc OptFlagUsage {desc arg} { OptError "bad flag \"$arg\", must be one of" $desc } proc OptTooManyArgs {desc arguments} { OptError "too many arguments (unexpected argument(s): $arguments),\ usage:"\ $desc 1 } proc OptParamType {item} { if {[OptIsFlag $item]} { return "flag" } else { return "parameter" } } proc OptBadValue {item arg {err {}}} { # puts "bad val err = \"$err\"" OptError "bad value \"$arg\" for [OptParamType $item]"\ [list $item] } proc OptMissingValue {descriptions} { # set item [OptCurDescFinal $descriptions] set item [OptCurDesc $descriptions] OptError "no value given for [OptParamType $item] \"[OptName $item]\"\ (use -help for full usage) :"\ [list $item] } proc ::tcl::OptKeyError {prefix descKey {header 0}} { OptError $prefix [OptKeyGetDesc $descKey] $header } # determine string length for nice tabulated output proc OptLengths {desc nlName tlName dlName} { upvar $nlName nl upvar $tlName tl upvar $dlName dl foreach item $desc { if {[OptIsCounter $item]} continue if {[OptIsPrg $item]} { OptLengths $item nl tl dl } else { SetMax nl [string length [OptName $item]] SetMax tl [string length [OptType $item]] set dv [OptTypeArgs $item] if {[OptState $item] != "header"} { set dv "($dv)" } set l [string length $dv] # limit the space allocated to potentially big "choices" if {([OptType $item] != "choice") || ($l<=12)} { SetMax dl $l } else { if {![info exists dl]} { set dl 0 } } } } } # output the tree proc OptTree {desc nl tl dl} { set res "" foreach item $desc { if {[OptIsCounter $item]} continue if {[OptIsPrg $item]} { append res [OptTree $item $nl $tl $dl] } else { set dv [OptTypeArgs $item] if {[OptState $item] != "header"} { set dv "($dv)" } append res [string trimright [format "\n %-*s %-*s %-*s %s" \ $nl [OptName $item] $tl [OptType $item] \ $dl $dv [OptHelp $item]]] } } return $res } # Give nice usage string proc ::tcl::OptError {prefix desc {header 0}} { # determine length if {$header} { # add faked instruction set h [list [OptNewInst header Var/FlagName Type Value Help]] lappend h [OptNewInst header ------------ ---- ----- ----] lappend h [OptNewInst header {(-help} "" "" {gives this help)}] set desc [concat $h $desc] } OptLengths $desc nl tl dl # actually output return "$prefix[OptTree $desc $nl $tl $dl]" } ################ General Utility functions ####################### # # List utility functions # Naming convention: # "Lvarxxx" take the list VARiable name as argument # "Lxxxx" take the list value as argument # (which is not costly with Tcl8 objects system # as it's still a reference and not a copy of the values) # # Is that list empty ? proc ::tcl::Lempty {list} { expr {[llength $list]==0} } # Gets the value of one leaf of a lists tree proc ::tcl::Lget {list indexLst} { if {[llength $indexLst] <= 1} { return [lindex $list $indexLst] } Lget [lindex $list [lindex $indexLst 0]] [lrange $indexLst 1 end] } # Sets the value of one leaf of a lists tree # (we use the version that does not create the elements because # it would be even slower... needs to be written in C !) # (nb: there is a non trivial recursive problem with indexes 0, # which appear because there is no difference between a list # of 1 element and 1 element alone : [list "a"] == "a" while # it should be {a} and [listp a] should be 0 while [listp {a b}] would be 1 # and [listp "a b"] maybe 0. listp does not exist either...) proc ::tcl::Lvarset {listName indexLst newValue} { upvar $listName list if {[llength $indexLst] <= 1} { Lvarset1nc list $indexLst $newValue } else { set idx [lindex $indexLst 0] set targetList [lindex $list $idx] # reduce refcount on targetList (not really usefull now, # could be with optimizing compiler) # Lvarset1 list $idx {} # recursively replace in targetList Lvarset targetList [lrange $indexLst 1 end] $newValue # put updated sub list back in the tree Lvarset1nc list $idx $targetList } } # Set one cell to a value, eventually create all the needed elements # (on level-1 of lists) variable emptyList {} proc ::tcl::Lvarset1 {listName index newValue} { upvar $listName list if {$index < 0} {return -code error "invalid negative index"} set lg [llength $list] if {$index >= $lg} { variable emptyList for {set i $lg} {$i<$index} {incr i} { lappend list $emptyList } lappend list $newValue } else { set list [lreplace $list $index $index $newValue] } } # same as Lvarset1 but no bound checking / creation proc ::tcl::Lvarset1nc {listName index newValue} { upvar $listName list set list [lreplace $list $index $index $newValue] } # Increments the value of one leaf of a lists tree # (which must exists) proc ::tcl::Lvarincr {listName indexLst {howMuch 1}} { upvar $listName list if {[llength $indexLst] <= 1} { Lvarincr1 list $indexLst $howMuch } else { set idx [lindex $indexLst 0] set targetList [lindex $list $idx] # reduce refcount on targetList Lvarset1nc list $idx {} # recursively replace in targetList Lvarincr targetList [lrange $indexLst 1 end] $howMuch # put updated sub list back in the tree Lvarset1nc list $idx $targetList } } # Increments the value of one cell of a list proc ::tcl::Lvarincr1 {listName index {howMuch 1}} { upvar $listName list set newValue [expr {[lindex $list $index]+$howMuch}] set list [lreplace $list $index $index $newValue] return $newValue } # Removes the first element of a list # and returns the new list value proc ::tcl::Lvarpop1 {listName} { upvar $listName list set list [lrange $list 1 end] } # Same but returns the removed element # (Like the tclX version) proc ::tcl::Lvarpop {listName} { upvar $listName list set el [lindex $list 0] set list [lrange $list 1 end] return $el } # Assign list elements to variables and return the length of the list proc ::tcl::Lassign {list args} { # faster than direct blown foreach (which does not byte compile) set i 0 set lg [llength $list] foreach vname $args { if {$i>=$lg} break uplevel 1 [list ::set $vname [lindex $list $i]] incr i } return $lg } # Misc utilities # Set the varname to value if value is greater than varname's current value # or if varname is undefined proc ::tcl::SetMax {varname value} { upvar 1 $varname var if {![info exists var] || $value > $var} { set var $value } } # Set the varname to value if value is smaller than varname's current value # or if varname is undefined proc ::tcl::SetMin {varname value} { upvar 1 $varname var if {![info exists var] || $value < $var} { set var $value } } # everything loaded fine, lets create the test proc: # OptCreateTestProc # Don't need the create temp proc anymore: # rename OptCreateTestProc {} } tcl8.6.14/library/opt/pkgIndex.tcl0000644000175000017500000000114014563206224016360 0ustar sergeisergei# Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded opt 0.4.9 [list source [file join $dir optparse.tcl]] tcl8.6.14/library/msgcat/0000755000175000017500000000000014566153412014566 5ustar sergeisergeitcl8.6.14/library/msgcat/msgcat.tcl0000644000175000017500000010221314554262142016545 0ustar sergeisergei# msgcat.tcl -- # # This file defines various procedures which implement a # message catalog facility for Tcl programs. It should be # loaded with the command "package require msgcat". # # Copyright (c) 2010-2015 Harald Oehlmann. # Copyright (c) 1998-2000 Ajuba Solutions. # Copyright (c) 1998 Mark Harrison. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.5- # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. package provide msgcat 1.6.1 namespace eval msgcat { namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\ mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\ mcpackageconfig mcpackagelocale # Records the list of locales to search variable Loclist {} # List of currently loaded locales variable LoadedLocales {} # Records the locale of the currently sourced message catalogue file variable FileLocale # Configuration values per Package (e.g. client namespace). # The dict key is of the form "> stream xœ•YлrлШ}зWЬл‚)q„СЛ/ы‹ьи%лZ‰•TbmЅ@pH"Ыє7$Ÿ’ЬщЙ %йх’KВˆAOOїщгЇGŸ™ЫsщЫќЬwg.лœ}>ъSf~ф;і|qvqг‹ѕ™^,Xьq/JS[ьЮœ^Нy>[ќ+SГвѓИK+№ЫъL.ЖИ?sюџnЦЎŠeCы ЙЁ^4їьšЌaѕ4тщ`УЅGW}•wE]Еь]VЭRžІ^”8}VЮў\МxъСпXў‘{к)Z0wЙ'RЖШБTЌхiHЫчAђ8as?R/МFЋ]Z(BІО1єюRo#|ЛюЦl.<ѕќ[Y,йџX^яіl[œуb%'П1тЅлФ)_1O’а3 р1рC˜1cEЫ2Ж‘•lВ’эћf_З’­В.cO„9д&ђ3O<vgО3Œp@sи1P;n%LЎ$эиm™­X›­х9ЫкЖпеŸfОЉЮН(VэЙГPcНэВj•5+ыBmоЗrХВF›oћ|‹=иNюj,ЯЪВЮ3z5uп•l9mш‚G~lіТTзЯ›Žэ›zдК" /ВЪŠjЎЭ)$ЬэЛƒГAЄоvІ!„льЛƒчч0˜—§Š‚PT €ч{\иМ’ХDћГiŠюРђ­Ь?ЕЌ^SМьГхŽЯцa\ €AМП(?E’pTПХГlfЈ6зMgЎЯx‚ риœC€j"trзlfуоіћ}нtpЂ*ј&Г“нЖ^Б;g%џЋЂ SШєR‡Цк VєЋaМAz65NИн!aй-%ЫV+ЙваЏк(ыx”Y‡зюёŠђЎЭvјж!џ;Ъf=CХЙ"ˆœ,—\ЧAUмЂ*„оўХФѓ<ЋhлЈ@кX‹Д”dTюYЁcАœ§‚К‹A‰§§šБїе])k8™‘4шŠœЈe‰ЩёA„Щ+њ.*ќБЉYпfGv!ўŠЖэЅа`ъШ{йшЖ‘oЙОљUzїхиShиБыыхђ—у7bшиЁŒкЗгVŒ>0 §Цш ndѓYh)RЯR˜8=ЅТщTa‚ЅI+  L‚cжHя>сz?ЧяєвCnп!}•Ъял Šя…+ш%f.ЋMQI+*юFН)‡м\^И™љ4B9‹7я_Гkќ…B†x~uљюіTпtЇ†8uЮчњZЁ‘tW n шŽGи3ˆ[Од8ће$cџЛ  ‚dТC‚2Ош‰Сѕ NŠѕAЯџ‡КЧ~<ч=XО л_`ezЕš j8ššЌш" ФettšX§PPФЄъОW!I гпцyтєf‡&ћ‚юъe—Ун’ё$анЫ*zд~+ЅНD3СgmНТДЌїBьmДМвoРWєТ–Гk•"u]сSCO&}гQbыaоˆOЏЦoTРёќzдпц( }ѕђъћc=ъЪЋТЊgщњ§ђЏѕ№Ч—ьГв-бѕ+Ys–ЕŸЉФR[Yющ^U0нJDSѕ*5і7rКe№hзпеpYыыG7NœЭ9н;Žмќw=xDлГеЊжlтсЈМя[іђъ Y%­†EкŸИH>СJЋ/си O…—IЪ•žV№ЄCš(Blᆂ}‹Э1џ0ŒСlюЙШ‘#д‹—‹Г?№ѕнВzшendstream endobj 6 0 obj 2889 endobj 19 0 obj <> stream xœ…Wлrл6}зWр-дŒ…рНy‰уЄ­]ЧMЅгЉнš„$&М( iUљ†єŸ{ )YIІу;финsйЭ'цrС\њ~gеЬeыйЇ™0Oй№+ЋиЫхь‡лˆ,W3,X$Й “„EОЯ–еЬљыњђх|љ‘Щ)%w)џШgТwЙГхnцм;о§œ]šтrДcLЊйоМ y2свЋ;чЇОЮКЂЉ[і&­ч OЦNŸ–ѓП—WG™J$р 'џ_z6) XИ< $2„ XžО№ƒ€G1[xЁљрќ=EЛ(ДТ‹†“–ПќvћŽпМbз—ЏoоН6Ї ŽУьЁо˜€Ы#/єиBHѓсъp"’3з-je‚{\и“ЬЛ:гћ;чЂйЮёаu#ЯйыbНщиНs‹$ в•>ЛRiН(›~Ы~N‹ВмГДЮб=§‘чЅвІqіРыс$ ЫMбВЖYuЛљГ™/yŒч„xŒT+†Ј­nцТчI,чБШUЮžЅэЂhŸБ]бmšОУ•ц‰ Ядш…<˜№йfEо№ќŸ­VmЫЭŠj[8xG1šрŽиЅZЇugјиЬВ™Œxx@—_вЫУешІУЫ;ЇЎч2‰Й'F™С˜SќŒЇ<rLИŒ“и^дЊ,KжmK{”Ћ[і`‚ž№PЦ#Ш†ТЮF•9+‹єЁTl…ва“žЙ3Œаш$ћ’ї%SNЋt­Z–ъЂ-ъ5[щІ2Зї­bЭ NШ —0тЖ.ДЭЃГ'іИ$/‹ф[ЅЋЂ5dУЧkj)Кн5”ю ?tіM­ш]st‡Сеѕ у‰ I8 љИDћЁбмРMB1Й=iCьѓ^o›VБЂЮЪ>ЇBГІЊ”ЮŠДdщ|ШRуgІз2y(Т'НFЋj[Eй)Ј3дз*/кNs9ЇяН\iЅЪ§@дРŠ[pwдіY;%”ќўсƒЪ:Кˆ`X5eйЬЅOо9;Ъ4Ц…жИ~ДhˆцРp7žL*ƒ<Ќ*”]д'р": ЙЛт№I8ѕНълŽеM.2@ЋiIЌЯйОщяГ2-ˆ?igžяtг)S‡НЮJэo§jJN*Фdв’“7pvЙ2gž0ftmc5KЩ@ђ>ыЮKГЕэ^јЮЎTљКBкHI Ё,oВžž 0ЫB/ŠјШЊІ/sЋСr•'Д@OР ­Р%тљУ\$-XвЄЖhѕЉ/@>Тu•<*ŠmпЯ‰f8Џmz)іHQPt Є8„F6eЌНЕ8 Ÿ-`ЈaЮŒйt_98+EзњlsfЈћ}P)юAза%›ђxѓгвGTПЦт•о9Ÿ/ЂРЕу7ЈЋJїcZUЭSз„Еђ |bšƒ˜žиц“eЌSѓН‘И|{hІБЗ'& ЅO“у IђѕЩ:QЇрkЅЃщCЁ’2ЧХžNЪ9Јы:ЇГRвЄt>Pр‹ѕчbЫ)mn=оdрыjJЯ‹€§(U'Ѕг^Єe_еЯШžВ WyoЕ†AF’:2ъa3"/ШеП -љjЩBZряоn7@`иг0.ТСŽЯ%`—›г-Dа tЧР]:ЪЁŸСс]›7:žP‘Пд&іvS”ьзДћ Ъ`‹ТаŽ‡эf€/:IѓЛщЕ[шѕЫ`њlrРЌŠЎSЕКєxьшЮЅmдОgзœНU4^ЉОkбkЄ‰т)ІѕЧжN ;ХЗЊйb8я6 јНm4Щ Оƒ]ЕF†mПЦІЧр0˜•€ŠІoiQб'ŠјИ<} 33d^јnLћтшДE} ЎЫу“ž Т8nЯУнžяОБH ыъж4зVУQ5^d л(rгмЌpФтМПЙќNPcѕf[ь#Ф€[tљ(с&I#Oјщdш№л#Э{мѓŽd›ЏсŒgь=ЧйСаџRНЇјг;+А‰м;кПЈЫŠзХ†Џ›iWyМŸѓmуЪb2-|?ƒс о€5бЊLzGˆ#ЭЇЏ—Гпёѓt–‰#endstream endobj 20 0 obj 1600 endobj 4 0 obj <> /Contents 5 0 R >> endobj 18 0 obj <> /Contents 19 0 R >> endobj 3 0 obj << /Type /Pages /Kids [ 4 0 R 18 0 R ] /Count 2 >> endobj 1 0 obj <> endobj 17 0 obj <> endobj 21 0 obj <> endobj 7 0 obj <> endobj 15 0 obj <> endobj 13 0 obj <> endobj 27 0 obj <> endobj 11 0 obj <> endobj 9 0 obj <> endobj 8 0 obj <> endobj 22 0 obj <>stream xœcd`ab`ddђHЭ)K-ЩLNдѕOЪЩ,,M‰jќfќ!УєC–ЙЛћgђЯ\жr< н<Ьн<,ѓ~T}oќ^ЫџН\€…‘бм3dŠFhPИІЖЖŽs~AeQfzF‰‚‘Ё‰BRЅTFС%Е83=OA Ш(KЭЩ/ШMЭ+ёЫЬM*-VNЬ+V№,IЬЩLFAEžс ,NQž> Ъ ж Z К ЌŒŒ,[ЯМњОŠяЇ~їня§wПзмњqхuаkqсЗФОпcЛл}zљўcлv/<к}ІћDС:з•—Wя:<у<‡№‹О™=3чHuolX^Д,s}т,ЗnŽп{и–§>'Кї{ ыwЖ‡ вjг‹ фsГSj=К9„?ќюџ§Pєрї~жяel6фјЇ4d–фЪч$ЇVws№§јо}їЧЩЛŒ?KцŠўYШVeЩњC‹эЯў?Ч+ЭY`›s—ѕл?ŽГђ}_е=џЇы|Цяjuй~ыџЭe}ЩЦїу@їнŸь@сЛсQ ПџАё•,њБ`жї щй3йюp=сОйЧУУРиUдН endstream endobj 16 0 obj <> endobj 23 0 obj <>stream xœVkPSg>!&[E+%еЭЁ3жктЅ^жV­xЋJDё -„kBB.$ф~Я—0@ТUP•Kim­c[ЙДюЂuНlл™ЖЮиярqwіаюЬіїЮ™3ѓЭwЮyПї}ŸїyžCAц…! eaR.—-\{ ш '7cnу-|9_†џ™KЄЯ&Эю сЌX@ цљVМ|t Мђ t,‚тХШ< хИу•Ћ9ёfLЬšнќbAnvNQєЦЗ7lŽN/Žўя“ш=lan6/zЙГ9|.›WŸЫM ЃpЯ№Ђ?ў[џ іџ…Gd)Џ`7_ ,:#M?˜!cgчфrИkж­Gф0ВIDŽ"IШ1dr йЌEі ЩШћШ~ф‡Bт‘…Ш"d1ВŒь2Љ@žRNR~ ;v‡К“:1ЯDЃб’i—шбtmxRјшGhї|ЯќыѓяЭИYлЯіуєЁ%АkТzwYd'žч3ŽэSЉхеъЫмхЮкŠlІг"›\gїеN~Cцу‰M+Y_@žй~\-2m–3хсCVH€СjАбШœт)m‚о7Кы.п<4и а*ЗКXeШгqАTb+-вЅPœ&—І\VnєДЙКІЕY((т—№ БєДŒDy†";ъфšэЛ”ZЫ.S^чtкЪZчб+яУЖН42Ов_РздK§K хыОЩe‘ЖИŠ!!6бЊщnŸгY *AЩOG__eі-ŸП>yQм“2†Бћх- „ЖќчЏ6g§Е‚UM\с‡MAз* І ZЛдE~Y.PиeЫwІЄэЯЄ]:†]<щЫ<єC.'ѕ(Зћ{9+ЖЈрѓV РcлщЁЇ6; /fЉХa0˜­:+ѓдЁ“љZNoj`›НCпM„,ZЋЩЌcjђє AХyc_[шЩ –ВьєAЙ\˜ZC™Ч€Э‰=€їi3є9 ’§јкК%Оxђыe‘Нx& cфчЋЕZРдJЫќ—`l?м9*lvЛ[яˆŠз›Эъd]'/FЮ“XKФ›і^HџьvO\ќoЕш€”ђЮЊB] Е&XФvјЃнR'9р“ФKћvЂ‘Н|aЎŒЗ<[ъщќљђ ЌkЌЏЕ{щУъ1јh„‚Џ‚T†Nk4hUE\•F@ыб‡Ь•Рnu~QїЊощѓ=5 ИЭnуY}™Х PПЗ*P'ЋІfeGяХдУŠ[j?0‹@Оюи`Рhq–D]Ќ(ГU€s TыMh"Em%ц‹Йвb5`€ЦЁ)U–iZ€J%’ТZyKЫYїј жиVзм=мL,ˆђœ№”Д‚ и0і№7Кду‹(xд=* ›]ЦЗИЬ@ДЕОШbАш­фEЌxaЁ™Т‹&ЙЃ0nƒЛрЦлЇїя=‘N„эa С„ђP/мitEдђŒЛД(Ь$ŒЫСМуNE'ТВиibR8%•ѕуЭ?\šР.Oѕ^ИBJ~ tрџєS№7f_cA9§†СЋIiЮn~~Њˆ™#K7lhЌ +ЉtтЦ д­­іx\е€­Ъ~о ЇMйаСЫ]u ЏXЂPJumЉ sь`FЕjƒ\ rwчБRGЅžDь?FUс"œ6WD/ўЇzJЫwPz“ ŸC cїaŽ< GГ:†ЋьођV,ф„ožM‚ћЬKмр)b%Бx—ˆйv§шє—Sн_|Ь"xp=Ѓ§wІ†№–9вlЫЪaџE<=‘^рё‹оК%хУmг0f<я›e‘џЦ9ј›ŒxКэКR~M^›дdъ†їжžpЧ БУХ ЪrU­buЙў}џцG?У%3w#Ѕ'&ШJ­,ЌUhU}аcЗЋƒхЖTZ+љЫу'wЇ}fŸЁЄG>'ІˆG Щ ’ж sЕёзм>юXbЦ{лS.|жPъЋЎeykК[Iб‹|WуЫЕТ”lUš4ЅsDЙe‹B§GП§ћЃŸvу˜ž“іœŸюWЉ~ѓгђŠЪъO}WБІ'ЕркХoЬŒлGЌZЧ‚ №$Ѓ+A‘iHд“^Делjд „ FЁ–gŘF1Љ ФђnвUЛр:O{з'WПЙѕщyвU=*ЅЩЌ4ЩБ$"Cyš03вSш“‡Я7~7ў›*іупћ)T(€t† Я гhdВ ISЎЌМТQ]VƒЙjlvš=ќœ0л_—JЭ™f2“ыVЗ™tuYf&{Ѓф  Yе’цўŽц™Q–ПТрKDœќZqSАО>дTфcsGњ)нST(…‹qяъt"€jŒЅgЫW fs’^fCэс0Ÿœ+›§{йWќ™‰$М#X/Ю™5V-а3Г|вжЋэЁ?gEЬf§ж_ке%№з)И…•ойНdƒMFЃбdIДjЋU$дшdY&WЅгщ+mРnAЇЭeЏeЬAcžDЂ/ВNчЇ'ПO„ЇНУ э(jШп{€x}=k ВЭіcjБiЫм/MŸЗбeqъЈ„ыsˆWHD;LrхIt‚~nЌКа~uєўЧУэѕ”iхJ.ёRёІу™ЪгшRoћ‡†nмМLRБв­%щЎ1JАDBІЩ4Ы€†DŠы•ћ/ЗнЙЦr•б" УE0їњ{GРк%hЩу‰$…вRM­ŒUЅpщ€№Eќу9(љЂR)J§лO Ў@Я;'Еš[ ƒм9Š§ГQЄчпœ]ЧxёЏXкзt> endobj 24 0 obj <>stream xœygxSзЖэB{oеF aH’а еД`РwРм{—-Щ’lIЖД$Y–eй–mЙї^А1НїB'‡œ’p’ј$7kћ,ŸїН%У}ЙяоѓНяГик{ЯНжœcŽ1ц‹?Ž`БX“іGЦ†&/ёˆ ŽГџџ!уФbцŒcцВЗЁИЎqс0‚I˜Ф“ЦWЭ–90>гсљЉ0m1žХZГлЇј}/Ÿ-ZМ5>!#)2<"eоЪх+VЭ Щ˜їцЪ<—афШ№Иy №iЁ1ё БЁq){#cCR“чНwžGhxjLpв§ьЏhџё ‚јlsœя–ј­ .‰л’Ж'яHй™К+эГєрнЂзŒУ{2ь s w№ˆєŒкэуыуќЩК…яЗА)@ЗXpЩвРeЫWЌќhеъykтbсLМKИяюФ|ТƒX@x ‰§Фћ„ёсM|Hј‹_b Б˜№#ЖKТ…XJлˆeФvbБ‚иIЌ$vŸЋˆнФjТ•ј˜иCЌ!іk‰й„1‡ ‰ D1‘x›XOФ“‰8b1…˜Jl"Іг Т‘˜Ap‰™‹рЛq‰ёD(ё?Юq\рИЛlіЙё+Ц7pЦsb9’2ђ&Е‘ЊЇ†шэДqТ‚ W'КO|ёжЖЗŒ“ІOŠœєtђЬЩцЩNёšв3ѕнЉLSM.šўЙCВУпЏЬpž‘2у&W<“œ™<Гmж„Y[fхЮ*™ѕЏ“їŒŸЬяэ5;{Жevџь+ГŸ;mt;ну7ЇhюдЙs7@У”‘0P }ћ˜З+Y#о6ю!ƒЂ(тв37yщ$:2*лШФОњлЈ€єтІbCЉБD8'p •ь[Tœ`JR>HЪЬёжв"XHfС".Є`#ЄQ#g “*юyж—Cаeˆ]1FXI?ƒИtвА:qЌКИ а'kcv Q(ЅљL&іЯЃ%№ˆ•ђ7Ъ‹Е'i˜A§xaѓС˜Ьн;O)ЅоG)ї‘№3)“СЌГКб,ё"Ѕu“gљхбc;‡Зу:ђ!e‹Шsš2%HEFl8т /јђоЩGA5TZ лt:ž Q7ѓ*$GBШBЋxhђZљЖ:з7я\jЃмђ3 A АZыКс[№}оOh^Лoy4№A†XЉЭr­Ьž€S6ЪЛ@Rt э‡ <И~vѓIeё|ў”‘e ‹Ўt€œaЈўRГ_–ЬтЉ- н&zдвnЪ’9чс пPСНЊЎіЮжЪcрШьnŠmH(ўЌьLIUQmэј[]ЕЕѓшl8~Х%ДI€кHшОхОƒЊN эјђbJCШžйР+эШс”шŒœ]€і—š[…Аw<ЬЄtељхКЯё7Ш6мє]9Ќї ^ЄЅqЕЬЪFVгwАє;640A\4kХ"$@s^.„асч? ђ–§ˆfГтЙC—ЁЙˆ<Дsг‘Ако4aќё]№§грЕ{М_щѓ^{„`|Ий0•“FЊвФВt $‰бПмЏ№pkcіьпЖ't@уhљh €œ_Ÿ]dTlqйЛ№]gePїў“1п8ž†Л^BЮПx&эHЏ 5кoћЬОz c­Ь”+‡`ъ‹YŽ%FЫ…ъ r“NVЄНAУ”Ѓ(ЊГFqд Оѕ=чУiлО§а30y №1Ѕв{ЅEdэЯф‹)ГЎКнЄ8  €З\сІЂСЅL ЗљBчрƒ“бЃ/чПiыЮf{]Ьз]Ќп‡Виe3a i№GлЕ 7/w} ^ятžxžпё9buЂЙ€F5"ђЉВ0чMљЗШd›д4є`np[Š ~sCyB№ФЋo5@@Cж|rР7Ю]Ж а‡eȘіj]eІ7Вj_@ёŽ2ŸrеЧšуР‹ЭGгo­ќёвљњB„у{fˆЗхв™P^Jy+Mš~šљ‘’ы8[аs.HЮЭRdЇfDЩb@ H(JЗE7ЇнЗi8ёь§ЏЏЕDэLa &‹+}амЭњe˜Эќ?хЦ“oJBяjщђ]ƒVzhрRjHS"+qІk $…”}"•­баh)L"uЭљљ€†N8/šJiйJКŽЬƒяrFEф}uq–~Ћ=š­Yв­ЙДˆщЂІР˜@жVВ Б3ЁвJюд‹K5—i˜JЕ=еX`V+,ЋЄX]шZkyc[Zedp|ъV?с”Zя™.ѕЬРх,ХlQ ш:Г8Pˆ ”ЦGЅr•cШœ§ПЖ” Х\МdJО>SъŒ—<lЩCЃŽ†sўKоFi?VШ7ЊqяЖйЈiЉі> ур|ъ+m™Дјќ"ОЂZVЩЌЎq8} :п…tоццТЙ9ЉЮQчЉ€ (єrcJaŠ1аы=|ЖzЖў:@x)Њ#Н<Ф№Ѓу}ЗGtЇФhy i*Ъзу9њZ@БІЦMUC}nЅг“ы—юžJnлз)DФјrI-hрїЕ4 ^lŽZQcЧЈД—љГ—е Ifо+іˆќ“‹ 3Ш'ъТ§F}LEяKи‚ж,„$мћcуї'§'Џ7мР)Qwxs\Ybн^К†ЬсœTR•ž‘•@lШ0В(<„Б€оE Qа ›.И om ЧoœжблAУ@JеR|1Ÿž[g˜I­ЌЛК…Œ7wЄЩ"A-p_—)WЊь)Щгi њ,:GЎiК|ВЛіL› Ы’š(ЮNќ0IУu!ьљz­c'`g%ыЯaxa˜m› [lфІYБі Cрфƒk”-џд^Ѓѕц уFщю=6б6д"ЂЋŠКЭ4ђF їПЛ2VщБ(іюЛФ8TВО‚л‡0tNqеЄП^YЈ=NУŸбЪLъZ^БјбHFxЕT*OH‘ХњHtћQ!|ŠHЉуšRЉ.€FFj§ пћ]=e ‚ў~ЮZ*_sЊВгrК”?ЛœAjиЎžЇlЄГ^ZЊy`_ЙўaIёs^п)ѕѕ_*ВQ&_“g_ŸД’Y_Щbqr‘PBЖцY@EЎт}TЬ›ЭЊвМR`цƒ ‹ЉУ@[‘Џ„ъж˜ƒяСIЈ—ЇW”†ќЃ4ЈѕЙљ(Іkœ№šю˜š v`KЛ™џ…ш‚ћ‡ДknЏˆ|ІВŒeы0uH––(Uж)ŠqY" RS‚ћb/Aтъ=8]ШxfѓГЛrПY№М` еЎ,R‚L Q%ЫV $о˜’9(сƒj‹щИ /7PBuхЫ*НRsRAцrР{–цiŠ@TY ;ђё];%TІPQэ аOМт˜ТЌ`…ХХ ˜џ•Мя‘мЊW›пŒцВ^(€П№*ŽŒ•јдЦMqбуУЋuИ№Оџ 7.Гї7S*SKЂ,B œQ7IjS;ƒln€^Вйп5Х–^[[UYЏ5jMBY[LtCkuяЩ†8/С^ -й›‘šš.QИ‡]ЏєUЙ*p,ё6VЄї9ЕƒЊтŽn| -УьЋ–ЇЩ’Є 9i€ŽˆoяцSК+нpBп_ŽNУXХ•МТ\ RSbїћЂmh5SК‡Eі$лPЦВк"гoyeљыŽшАQŒ2‹і їQѕUџёЮу gЗƒd>dЉтДj cюц’ђбI‹–ПBRhрAшvчfYс#п†ьЉВ{НЌ,и2Д’1 Н,fЭ€ОМчp’­ЁЩкІч[бJ еЌ)R)ЩR“bд*YFVzN1OR“]ЂЩЕ(ЫАюZK šuИv‡%fЊ”eЕјНЧC$rŽ Q(Ѓђј8пJХЩ%І‚’в*сS8ѕ{4/_ЅW%ЖdЪм(ЭX‡Ж2o]g}>гџЦ†KF>хЊѕ!в„ь€,~\GLш  аНць`сh3ѕ ђ†с8ј.œЖёхТНю~щяё=Ч;Я4ж)DU‚ж˜ъ`+иЛ}UзibѓkЅ]=рq;њ;ў­uP'рNyр DФЭЅw’є9m'ЭФRњћ%%OђЧьKмs7@МНcpЧ–e‹sЕЊ<Ѕ№Cд„(X *Э-ЕCЛТjъзує„HЉњмrya&$‘–Wœ г~ea@Ф){3c$Ii")fбl,,ІŒ|1 “EЂЄЈ–Єў;ƒчсќѓBlg—ДZŠj |;дя1œ&Vнc6ѓ\Ю иžьшeЎ_BъїѓwŸu–(B‹„Љ…q™е€__eЋЙАэјпє№Ё_`ќАŽFмЇK!ћXoYKЇ ЁЦжи|™žђЯЩoЪ`*†й#Плѓ@ЂФQ=3zђ‘_хZфzЬ_RšЗГ2э˜”aLцKЊ4џ ™…Ь=Ю)%Ё™ЙЫѕюњ7rЛ5?ЋT3Fхњ{Х%ї8“n ™™нЬb>†NмŒќŒ%RйЂ<>Аšљ€cEПRyh"Ї‚,ќЂдzMOC‰lЃp$Ьd;ˆБ,Эnd5М€щ˜жe—ИYZШХm—m27АЉ8 Ž”яВ{ФB˜нeV„бr*Д5Сb7_дRіtЩDф—ъ’LУл4њŽх2"к("ћAiNяztЯПЭкЪNV8oхL iјНЄќЉЩžХч0ЎR,f1\Ы иЗx€ ІИ‹нЪVЭ5^%sn*š’Zc;Vљ?p #4ђ@H‚ pІ‘роjH§є№2$Ž аȘkyвоu\Её%ЋшзvэVмШњіkv$OХЪ~йжм]]ЂˆЋ”%+ЪБWЋЈЈщ Ќпчъ“p(Q˜x('\ЛŽvŽў н&5›rћXbЅœ r xHУлp ѕк­UѕТS]Ќ_‡ЁиnБ1н=Ш1gыоа™2{Ѓђ5*жc™ДгйgTНІ\[ž‚ГE§ЕWZ;Џ‚[рЈД;Ёщ№РЊЦ%И\хишИpLІшtэР{Кљ!*]ЊгЇЦZђ"М^ЃzŒЌЦЛPќИЁ‘ЭD1й Ъ@e[GCagžMЃ] зкважhэЇ@“КFкJ#хшlnЛђ‰ъ4 ПkЫ wпxqVz4 䘭Н'„Fј’{ЙБcАЅ>3ЖL`‹А‡iЯјˆƒ{Bnўlw#3:Yэићm€${Ф}ФEЄaнР'м)щ,ь}pЋћ{й4<ˆgАї'ў™ƒоC4;_о-ш nMџ"љј~оupr0\, щш}7r‰лE1чZФяЧЭ?|0,Ф'e?хa­>ЧЃp"xеєЊoАoрxе%@ПжŒ™чXї‡р^мnb+зЫЌ6iП aѕGШ9gЗрф}№"Ѕ6DШ’rі‹љ vцЮзщБЁћ s‚„Ѓб˜gе9JŒ˜+хnЬБh№ѓ*ъш`sy/ Oж…o"Jу’-їPу›"(ћ0^Щ wБ†‡a†бШB7д^зŽB`:ж;~§Y]‰MЁ}kъ—b˜4‰Ш9EџiйŠM*ŒДц1с,Жл}?ъ‚fЃЋИš `^p-…НpњЅ %~iСс"ССФе"нјтw_vx2ќёа,ЧЯё”ЈА’ЛŒJГ=Єr hй~Ž“KБОXWјЕc3‹„вlЮVьШЃП†уG–sRRтуЊS›ЋЋ›šRЊу№8xVк™ZЩ ОШJ‡/^@щoГ3ž#kЙiЄуœд\Й,гI2ѓ3 iЧЖвААТ(Ї`˜“ |РКO8оэо‘3‡ыBЭYЦ4Dяђ;ИeХžѓpŠŸ …lFœjвбеІ+.Е:Y@yЎM‰#IКћrzœ §ЗЇПЕџтнОs1xœЇЯэКvьЈ(МCа]šXц†Ч&Мuз]ЧЖџУиі_B/ц Wmи“šхiчTЃЮЊЗкЗ]cЮФЕJyIђt•Bš#ХВІ0eVeдHЭXЩR22SЃ{RЮє–ж5;[Ћя€ЇДуoО#џ]r№ьЪМ:Ъ‚&l’|m\чќЌbLLс9 uU™еˆEз’*И3z•TЁ œZВВЊЪ!ЅЇЯц‘кейŠ5v~=іЦч,­d}5Ф6Э„YV2]lРцЉ‹])8эЫWд†<~ЁТ j:;[%ˆ$0ЮJblСЇбшЭkj€гсј†Вь‰‚ЄTж’ В@vv–4 ЭESxЬZ*WD—э!сЧк1_Ђ3ыь'цЌсhЅѕЮЫs‘йц†Љd§> џ5РёВЋ…DD>V[гѕябЈ†;TЁ™Б Лc6р_›p<ЃUйЎг№ўиˆѓЅ}ФщQOп ?7)Дљ™3мY;юєjšСc–Rњ?,ЅЯЬЏЬњћЛj&”[IWƒМH{С~”Ћї‡Щ]p (‹ЎX‡­Uk‘є€p4‘вzIЅ{rщ1}™\Щйc_fАˆ<Ÿ[Ёё@ЌLХЂ…ЃlZПzS Ќ|PYjnеEWЂУKД‰Ј“x`ъ_ ЕЃƒ<+ “˜KmO-–иКŒиpIxgX/† Ћ§з~і’d%}ub‹Ж—†а™Lu5§х€ЈŽРŒKi<rOЛаЄX)O -гм Ё‘jюo­8ш‹ k…(œвИЉ”ю*|SМ•JдGхVаУ‡!œxфЪwпDw/AЦХШ/p$d­нM?Є”zoQЄмл~HYќњВо,ЂJу™%нYяŸ.Џг№ЯЕі4`ћsZ]! ]• ˆGгб<Фƒ?*+ђ 5љќь*• 3mmMб9{*EдEmQvћК6gо<доc&)+rЫЯEЅЇѓё-uZmЭшZНFлэ™ZЪЌƒЋFзqЌф h5UA6Vˆајџё~PU)ўj!л?)ы™хИѓOє6їѓіў+р }:ЂћPxJjЄР1/ЊZдe2щtЧНQtN…Њœшј0Џ0a7ѓ„ы˜№W№КІ7С_0ŸџЮ‚;zиџСlуоn;vЧ<бs("9%2КZдm*А4ъак/*>ЧУŽМWЩ:ё‚ O`šнь›vаeUФB€&4ЃыУПЭя ЈO=]\Ц[w=О3сAђmљC№јЃфyУеЦkЭї.с\… ЗXL LроеэЂоD…/инhїСЩцКЎС/ОщјР Ю{ѕбpШ‰ФjŸV™˜їЅkCDуІк–M`x'Ы9aoТž˜А­юaKЄ=pb[t?l€s[ ='СLюх84тrŸћi„oжNЌjбd8n}йљгХKТ“'o5<4\gЂЉшƒЎ‹v%fY[LКQxš8лIEhjŸФјA BщуIe3эИаЕЧџфРё†cэЧЁР‚ЎИNП|KЭ…Юш]8эAшcД љ §pzЙ{Вdр•}Ъ8s5жЭ_І{вкqMxz\j‚SXJыйsЇкЛ…­•Еvй|–з˜ыX{Ф†gFІsыPјП.У№КеTЄNjХГдШ*JзjБДщ^Ÿы1oЗС#uЌ_†рО!v Гš{="5ЛВ§ZмЭ Ихёр€… ~ѕ‚z і‚”vЛ*gњ?oP”hoваJb`ейtgxЙ†УЪшМРG+њImW~БЌЄПЗљhВК[B‰нмVYЫjњ§6ltOєЦ†ШУTышэXџ v;РхРAЯ1€џиŽUб8шПјѕЖАЛž§@гр№лtУ њЌ•љ˜ћ9КEj6(ћў“ЭŒвbћAда }Ci§$b_ћ•h+х•Џ0ƒГ4ѓ 2йEžLХw\œ-’Јsœд@aiЧ–јИ‚$Їƒр`rќ‘и Х‘мhў8Й‘к3кпjЮ~5(ЮЉH cтm%й5N…Р 3ќ—*СOБлб,n ЙŒТ“^PэкR‰.œўз*J-—Giэ7CяыЌЈeїР"Ў+д^Чш7`Š`нЕгУє_џ';и-9я‹ЩE<юЉQ•~ EZ9"Р г‹{p'‰2ўЕs‡Де8дГj†%?ГЁ _м‚ХaсюžЁˆыаqmˆ>юйx:љ8 њЫ;;.я†4€“iМОf ђЙCЧ№4ŠBч­^ј'<#Сq/„c.`d~o$юџ‰3a“•м2-кімцшбЮхЌъжZžЋЬ’h![5Ў™вcпГ€GLЭќў›‰‡sЙYЦ0wЙђ€–rHИК|ћВчxТџѕ“ЧяюїI=&ˆŽ”DgКTЉyНяhН шЏ/xЌYpйš•BДЙsdЬlЛ/‘v2п_q€_< Н‡%\Ÿs/ƒMMіѕ”nOАўиsїцјtSm˜№ІLьЁ$вДˆўдЛžжїяЋЛnƒ3тСј–ДjQq ЛЭ;ЧыКЮЭўЪѕќRПРЬшpAlМ$)mŸ5—зћрXыu@пк.‰HJЦтK;’_{zИ№ѓ)žb=й№Л<&ŠЙѓї@нuчь†эhхјлcИn˜D;op‘’„JјГ§ћBisё) 2wйpѓ%њ’х[†Тюoyй&IzЖ*7_(‰XHЁе-а№UљšТжeжQЄТЮь щEћ6­O›ЊcбЕЉц@ЧKeIЁƒЩžпk8}ZxьXеE№м њŸ №ЈAЋ0 јх9•Ь§,ЦnЂFIв -,ЯщЛm+Й уУXљОфм$aФШ;œ)вRЦЛ*%Л'>Ћл0iвгќI“ т—ьi endstream endobj 12 0 obj <> endobj 25 0 obj <>stream xœUyTSWwoDKš jŽу‚UF;uдб*‚ VpС#KиI $˜„EЖфY QxИдЂ@]ŠsІеКU-HэœЮŒЕЇж9у­ЖѓНxѓЧМ`g:Ю™ѓўxЫ}яћ}пoЙeМН–e}6ЇgЋѓBТЕYЩžл9ТTV˜ц%М%!њ—!ЎЕRAсЫ_ ёѕюš†ЏњƒѓuЈœЙ“o–]Мvsc№–˜msцЮЗJ›cаЅЇІэ њѕ‚w%‚~Z ŠPчЅЇj‚f‰ъ,mNЖZГ7:=;1?/(F›  ђ`џїƒŸK§Х†‘……o_ЙfэћQЂ7nŠ‰нМ%ˆaІ3Пd–23˜™Ь,&˜™УМЭ„0Пbц3 ˜w˜w™…Ьo˜E ЫМ!ђТx3ЉЬwl<{г+ФЋM2Mв Йу=Хлъ§X*=Щ-рЎЁ7P1*ƒ~Ўт€Ш„ежЩЫUЄФО^ЇyBW€–Ѓ:ї:ЄиДГ,P*mЌЭo&=Єѕ`їс?Дѕ@>ч|Џ%ф“|sYšЅвjЖšЌXї‘ЛJфƒЊgДJъчšON /ћП€…А~KАrВьгі7aŒƒхр=вѕ§i'”iЧгл"лАь`чРй/І<Ÿџ1}OAЏщИЯЊ;Ж­и­G–mFsD†ј\~œ“=~~i ѕz;qћRUQЧ RЈё>eoэWШžн=Й'dz†–NЌVŽшšф`с,’И6К–ШiŽŽЛ]йОŸhHЁ93w•а дŒеuV›Ѕ.адUеBZ№сЖ†Г ОFЪгotШiщб;вa=}@g#ЫЪ’вeхтЌOyДь`i“e C‚XИбжейьЌ Qѕ\ЏѕВ!Rтš ѓф›6dцэаkŠ3*Дф}еЇж\6}NžaHК^р{ўœA=ЈPwЇ9WbЬ9œ1ЕЌД€”Sm~SLїŽцг]t Ё 4 fб™ шvHžй'МpВO`4AИФў&мс f€’ ‘*EQJњ‰ŽЛ^йiЌй…нЅH•“Ћ‹№'y—Ѓхƒ‘KЋћGЖйУЩ"RИ0swzќЮНыоmnRzTѓš§ЂcОхQФACЋѕ# EPA‹%ЎШсёвcф'ўфUЉ(pМ<ЌЖаnН<xљpћˆM,ћ\‡юVњ7љqcxЅјёs4.‘Kъ`№4ы…r —БМ0+-31%жАœрhBВнЗЗ>№Tњ^‡n‰2жŒWВn3•Dˆ cШяeФЋ6~8'…љ’—!М<ДQtљ(Ђ‘эžн>R+~^‡ш.wн%dIiНŽЉь0Б”YЃЭХ+<™yДДNяАоУB‚:ї#щъ„Ѕюzd‰1‡‰Жbч)‡ХƒшџbPX58Y'n…<к`шДŽ`a’ БюГвЃТзљИе~ГQФЯдЁбrG‰РєDПТЄ4UЧ9H‡ёB vkuг>Г8бмд'КщŸb…З\kф4…гйT-&i6-fD<‹G2ьЁС0—юVZ3фрuƒN Щ41šВSДXPAжuР№šвO‘$Ж}*њc)Ќ”ˆ-?фЙхћ-ї0D#˜ZуЌьјъФрUђ%<я]І cž­ЧnД­Тюhdн`Ъп]UMJ-% VсKyWGKя_zU”‰*VчюUфf”GќjѓrВР‰`ы!TтRёr1з•кi<œ ИвЩЗэ9vЄНŸ ‰PСзшњqЈ‘*ЛЩцВ„••Ў№јяD-›-#тŽ HЂЗЄРЙз OфЄОЖэ@}}S{O№wЇїL_oLЮ,PцЅ—‡ZБŸpYфqЪ НУP$Ђ|&Ы–zA+‡ьlД?ЇЂм ІЌј@СA,ЛпŸYŸ<•N[В‚ЪGOŒђГЬoКsЩжРе;T+6эр/Њ9ЇMНEwБ†’c\}OCC;i Эе‡Ы/.$‚Ÿ>џБнcыN*щьбЅ§љ<Йxэм™лCчє)ЇЮДvcіџUjъ=Љiтх‹jKš-їБа`bеp|ѕСЧ8 ФKнOИj/=Цu€Я№‡0ЉЛЛ‘%ДЄtБЧ‰.ѕ]œƒ§М cƒзя~њ]мЏ> endobj 26 0 obj <>stream xœTkPSg>Ч“œsJ1@т1р%Щ@(rЋP+ЌхRl„*ˆnAЎB‚B Ћ8 њl"БЊ‚дА-ВЫiзŽ К”% зШŠngЁЛяЩ|awшьўппэ}Пчyоч}IBД‚ Iвn{F^q†.ч`ъвЮ“_KђыV№ы(„ЕжJЋFЬЏЗ'=…ьEы˜h)мp‚ЃpР‘ H2(Ќд#1~ЯF//я№ќУњ‚œЌlЪпз/P•ІWНМQEdцdiUюТЂ8#/џА&CЋ‹ЭбЄЊvЇj џјџЅ"ТY›_№NЁЎHš­?““чБбзЯ? PE;‰]Фnb‘@$я^DNМN$„Ё&bˆW;Т‰2bС$с"hBˆ„ыГD/ё„Œ'љ`Гтг ”G]Ё~ @ДR!:&§,Nї‹џE“а"сЛ‘‘Ъ6JGB'сќ„\vsЏчlѕ“аЮШњўй;8нп~0Zџ=СЋ˜uЏЛBц‚’4ћУX #ФыFxяВuКg(ИЪЗrи#РGрH‹lЧЯaЈпј{++BЙЇНЁx5vŒ нф?2}32Ї”РДтЈёŒQ: €ЫОx‰р*SвЛНР”ГSŒЬЗвpЊтфкD”–Л/„•эz&|Ш}у`'gч(иS,Œу0№Њq›aQ3GKјђ;g t†теМ„;їKдЗx%bБdkДч›эщрЈQš~kh,F™.IЩ‡Тd\j(VЏ=]{І  Ћ№Ъ‡qАБр<йЗ`ўнmЗЋЪЗ>‹КЌm@m.Іл7~пЊMЈTH E7Ф{>$Ї&(И px^ ЦЏED§`Sб‰­кО†+•ПoR 2•Ÿ8W‚иЌ“еmJРгЫ2%-i э›€Њ‰mУrйQОx5_ŒЛйTЛ#пM§ъ‚g‚mL`пюŸВˆdКn`Ә%ŠfЋЋ‘Ќ{GІ­ЮVЭ Иг‡J єљ9%™ˆLяœRvzя`Аy8ltЄ ОуХпМяй>—&(ў WzЖ AЌіXэ5%|ЧЬEua.4Ж(=KQxјЄцьv’О№ч[ЭfФўѕыќ$es.K<Њл}Ј/Ы={$o?ŠbНћwўкпниѓ'ХЧ‰зt=ш КXйtХюХЁќS%КœМДcЩˆUgДtпkmšНЄ|\SWеt‰]BdN0ђ1f5J{&рюŒ\–в#Zд ЯШLБ_uk‡ж‚bФЁ›ŸceјоУЛв•аЬ€;ЎчцюoСNје˜-ОўёcрпŒ=V.y}мЪЩ1AЂЗ…l>‹>iл–,‚ЕужUF’wЊ†cѓЦkxoБ? ‘ЖЦм`CІо\ шЃJ}ЛЉ+­+k@зQѓ' —Џ}VлpЙ V‰ѓж"и,ИВ;'n~аœeŠnМцъ‹E8 ‡ЬЊРœF‡aUЕ2ˆ6НŸиM Урђѓп;вТЊ•ыШh4’Уў‚…тГWC*bXЌЬ18{бчYФXаФТ m –@Сr#Э?—іO ­<žŸ`[§-[АjDAЎ“єђЃЅЬ')№dZд,N[“Œфа# NgА<ЋіCиџVЯc9{ЗdиŠ A€ B,рЪО ƒ№GдЮццAўдќјGƒzШйк‚нLx+Т$уьЪО№м3y{кf)hВfqяЂšЬф§;t^ЏaqљцР<ЧƒRP=MщWdvэjоŽибГNOМЇэїкш“2ћ`_чOЯ–ы+@ЉБPPУзpЖ‹5+ŽЩУдтuzvЧ’г+Іљо’s–тЯЯpЖWшOюqkІ{ОзљїюќˆЃћ…НЉ_Іокse;ђCлsгc 2N8+Œ:њМщуцšЯ;ўxНБcїуBт%Eg)7%bЭяGТў.|Нl]о2"х•ГяЬЪepІЙ‹t§ї;}|=SLПžV #%Ў:Ѓ.З-r ћ'aЌИ?ЕРњ'й]›o(eS§зov ­Ч-Уx-vћэ[јѕr……ЎшЈКzБСјuЧчїkюL йЋЯK/QžЬ-‹=Ч.“‡MЃ$Œ ќЧ œУс>ъЪчЈ>stream 2024-01-22T10:31:53-08:00 2024-01-22T10:31:53-08:00 groff version 1.23.0 Untitled endstream endobj 2 0 obj <>endobj xref 0 29 0000000000 65535 f 0000005206 00000 n 0000024632 00000 n 0000005140 00000 n 0000004854 00000 n 0000000182 00000 n 0000003141 00000 n 0000005415 00000 n 0000007376 00000 n 0000006994 00000 n 0000021248 00000 n 0000006685 00000 n 0000018921 00000 n 0000005993 00000 n 0000011202 00000 n 0000005633 00000 n 0000008126 00000 n 0000005271 00000 n 0000004996 00000 n 0000003161 00000 n 0000004833 00000 n 0000005343 00000 n 0000007602 00000 n 0000008415 00000 n 0000011688 00000 n 0000019179 00000 n 0000021558 00000 n 0000006573 00000 n 0000023370 00000 n trailer << /Size 29 /Root 1 0 R /Info 2 0 R /ID [<9E00CA1DB017CC7EF21493301F7644BA><9E00CA1DB017CC7EF21493301F7644BA>] >> startxref 24789 %%EOF tcl8.6.14/compat/zlib/zlib.map0000644000175000017500000000265514560736524015543 0ustar sergeisergeiZLIB_1.2.0 { global: compressBound; deflateBound; inflateBack; inflateBackEnd; inflateBackInit_; inflateCopy; local: deflate_copyright; inflate_copyright; inflate_fast; inflate_table; zcalloc; zcfree; z_errmsg; gz_error; gz_intmax; _*; }; ZLIB_1.2.0.2 { gzclearerr; gzungetc; zlibCompileFlags; } ZLIB_1.2.0; ZLIB_1.2.0.8 { deflatePrime; } ZLIB_1.2.0.2; ZLIB_1.2.2 { adler32_combine; crc32_combine; deflateSetHeader; inflateGetHeader; } ZLIB_1.2.0.8; ZLIB_1.2.2.3 { deflateTune; gzdirect; } ZLIB_1.2.2; ZLIB_1.2.2.4 { inflatePrime; } ZLIB_1.2.2.3; ZLIB_1.2.3.3 { adler32_combine64; crc32_combine64; gzopen64; gzseek64; gztell64; inflateUndermine; } ZLIB_1.2.2.4; ZLIB_1.2.3.4 { inflateReset2; inflateMark; } ZLIB_1.2.3.3; ZLIB_1.2.3.5 { gzbuffer; gzoffset; gzoffset64; gzclose_r; gzclose_w; } ZLIB_1.2.3.4; ZLIB_1.2.5.1 { deflatePending; } ZLIB_1.2.3.5; ZLIB_1.2.5.2 { deflateResetKeep; gzgetc_; inflateResetKeep; } ZLIB_1.2.5.1; ZLIB_1.2.7.1 { inflateGetDictionary; gzvprintf; } ZLIB_1.2.5.2; ZLIB_1.2.9 { inflateCodesUsed; inflateValidate; uncompress2; gzfread; gzfwrite; deflateGetDictionary; adler32_z; crc32_z; } ZLIB_1.2.7.1; ZLIB_1.2.12 { crc32_combine_gen; crc32_combine_gen64; crc32_combine_op; } ZLIB_1.2.9; tcl8.6.14/compat/zlib/inftrees.c0000644000175000017500000003134014560736524016060 0ustar sergeisergei/* inftrees.c -- generate Huffman trees for efficient decoding * Copyright (C) 1995-2024 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ #include "zutil.h" #include "inftrees.h" #define MAXBITS 15 const char inflate_copyright[] = " inflate 1.3.1 Copyright 1995-2024 Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot include such an acknowledgment, I would appreciate that you keep this copyright string in the executable of your product. */ /* Build a set of tables to decode the provided canonical Huffman code. The code lengths are lens[0..codes-1]. The result starts at *table, whose indices are 0..2^bits-1. work is a writable array of at least lens shorts, which is used as a work area. type is the type of code to be generated, CODES, LENS, or DISTS. On return, zero is success, -1 is an invalid code, and +1 means that ENOUGH isn't enough. table on return points to the next available entry's address. bits is the requested root table index bits, and on return it is the actual root table index bits. It will differ if the request is greater than the longest code or if it is less than the shortest code. */ int ZLIB_INTERNAL inflate_table(codetype type, unsigned short FAR *lens, unsigned codes, code FAR * FAR *table, unsigned FAR *bits, unsigned short FAR *work) { unsigned len; /* a code's length in bits */ unsigned sym; /* index of code symbols */ unsigned min, max; /* minimum and maximum code lengths */ unsigned root; /* number of index bits for root table */ unsigned curr; /* number of index bits for current table */ unsigned drop; /* code bits to drop for sub-table */ int left; /* number of prefix codes available */ unsigned used; /* code entries in table used */ unsigned huff; /* Huffman code */ unsigned incr; /* for incrementing code, index */ unsigned fill; /* index for replicating entries */ unsigned low; /* low bits for current root entry */ unsigned mask; /* mask for low root bits */ code here; /* table entry for duplication */ code FAR *next; /* next available space in table */ const unsigned short FAR *base; /* base value table to use */ const unsigned short FAR *extra; /* extra bits table to use */ unsigned match; /* use base and extra for symbol >= match */ unsigned short count[MAXBITS+1]; /* number of codes of each length */ unsigned short offs[MAXBITS+1]; /* offsets in table for each length */ static const unsigned short lbase[31] = { /* Length codes 257..285 base */ 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; static const unsigned short lext[31] = { /* Length codes 257..285 extra */ 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 203, 77}; static const unsigned short dbase[32] = { /* Distance codes 0..29 base */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289, 16385, 24577, 0, 0}; static const unsigned short dext[32] = { /* Distance codes 0..29 extra */ 16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, 28, 28, 29, 29, 64, 64}; /* Process a set of code lengths to create a canonical Huffman code. The code lengths are lens[0..codes-1]. Each length corresponds to the symbols 0..codes-1. The Huffman code is generated by first sorting the symbols by length from short to long, and retaining the symbol order for codes with equal lengths. Then the code starts with all zero bits for the first code of the shortest length, and the codes are integer increments for the same length, and zeros are appended as the length increases. For the deflate format, these bits are stored backwards from their more natural integer increment ordering, and so when the decoding tables are built in the large loop below, the integer codes are incremented backwards. This routine assumes, but does not check, that all of the entries in lens[] are in the range 0..MAXBITS. The caller must assure this. 1..MAXBITS is interpreted as that code length. zero means that that symbol does not occur in this code. The codes are sorted by computing a count of codes for each length, creating from that a table of starting indices for each length in the sorted table, and then entering the symbols in order in the sorted table. The sorted table is work[], with that space being provided by the caller. The length counts are used for other purposes as well, i.e. finding the minimum and maximum length codes, determining if there are any codes at all, checking for a valid set of lengths, and looking ahead at length counts to determine sub-table sizes when building the decoding tables. */ /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */ for (len = 0; len <= MAXBITS; len++) count[len] = 0; for (sym = 0; sym < codes; sym++) count[lens[sym]]++; /* bound code lengths, force root to be within code lengths */ root = *bits; for (max = MAXBITS; max >= 1; max--) if (count[max] != 0) break; if (root > max) root = max; if (max == 0) { /* no symbols to code at all */ here.op = (unsigned char)64; /* invalid code marker */ here.bits = (unsigned char)1; here.val = (unsigned short)0; *(*table)++ = here; /* make a table to force an error */ *(*table)++ = here; *bits = 1; return 0; /* no symbols, but wait for decoding to report error */ } for (min = 1; min < max; min++) if (count[min] != 0) break; if (root < min) root = min; /* check for an over-subscribed or incomplete set of lengths */ left = 1; for (len = 1; len <= MAXBITS; len++) { left <<= 1; left -= count[len]; if (left < 0) return -1; /* over-subscribed */ } if (left > 0 && (type == CODES || max != 1)) return -1; /* incomplete set */ /* generate offsets into symbol table for each length for sorting */ offs[1] = 0; for (len = 1; len < MAXBITS; len++) offs[len + 1] = offs[len] + count[len]; /* sort symbols by length, by symbol order within each length */ for (sym = 0; sym < codes; sym++) if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym; /* Create and fill in decoding tables. In this loop, the table being filled is at next and has curr index bits. The code being used is huff with length len. That code is converted to an index by dropping drop bits off of the bottom. For codes where len is less than drop + curr, those top drop + curr - len bits are incremented through all values to fill the table with replicated entries. root is the number of index bits for the root table. When len exceeds root, sub-tables are created pointed to by the root entry with an index of the low root bits of huff. This is saved in low to check for when a new sub-table should be started. drop is zero when the root table is being filled, and drop is root when sub-tables are being filled. When a new sub-table is needed, it is necessary to look ahead in the code lengths to determine what size sub-table is needed. The length counts are used for this, and so count[] is decremented as codes are entered in the tables. used keeps track of how many table entries have been allocated from the provided *table space. It is checked for LENS and DIST tables against the constants ENOUGH_LENS and ENOUGH_DISTS to guard against changes in the initial root table size constants. See the comments in inftrees.h for more information. sym increments through all symbols, and the loop terminates when all codes of length max, i.e. all codes, have been processed. This routine permits incomplete codes, so another loop after this one fills in the rest of the decoding tables with invalid code markers. */ /* set up for code type */ switch (type) { case CODES: base = extra = work; /* dummy value--not used */ match = 20; break; case LENS: base = lbase; extra = lext; match = 257; break; default: /* DISTS */ base = dbase; extra = dext; match = 0; } /* initialize state for loop */ huff = 0; /* starting code */ sym = 0; /* starting code symbol */ len = min; /* starting code length */ next = *table; /* current table to fill in */ curr = root; /* current table index bits */ drop = 0; /* current bits to drop from code for index */ low = (unsigned)(-1); /* trigger new sub-table when len > root */ used = 1U << root; /* use root table entries */ mask = used - 1; /* mask for comparing low */ /* check available table space */ if ((type == LENS && used > ENOUGH_LENS) || (type == DISTS && used > ENOUGH_DISTS)) return 1; /* process all codes and make table entries */ for (;;) { /* create table entry */ here.bits = (unsigned char)(len - drop); if (work[sym] + 1U < match) { here.op = (unsigned char)0; here.val = work[sym]; } else if (work[sym] >= match) { here.op = (unsigned char)(extra[work[sym] - match]); here.val = base[work[sym] - match]; } else { here.op = (unsigned char)(32 + 64); /* end of block */ here.val = 0; } /* replicate for those indices with low len bits equal to huff */ incr = 1U << (len - drop); fill = 1U << curr; min = fill; /* save offset to next table */ do { fill -= incr; next[(huff >> drop) + fill] = here; } while (fill != 0); /* backwards increment the len-bit code huff */ incr = 1U << (len - 1); while (huff & incr) incr >>= 1; if (incr != 0) { huff &= incr - 1; huff += incr; } else huff = 0; /* go to next symbol, update count, len */ sym++; if (--(count[len]) == 0) { if (len == max) break; len = lens[work[sym]]; } /* create new sub-table if needed */ if (len > root && (huff & mask) != low) { /* if first time, transition to sub-tables */ if (drop == 0) drop = root; /* increment past last table */ next += min; /* here min is 1 << curr */ /* determine length of next table */ curr = len - drop; left = (int)(1 << curr); while (curr + drop < max) { left -= count[curr + drop]; if (left <= 0) break; curr++; left <<= 1; } /* check for enough space */ used += 1U << curr; if ((type == LENS && used > ENOUGH_LENS) || (type == DISTS && used > ENOUGH_DISTS)) return 1; /* point entry in root table to sub-table */ low = huff & mask; (*table)[low].op = (unsigned char)curr; (*table)[low].bits = (unsigned char)root; (*table)[low].val = (unsigned short)(next - *table); } } /* fill in remaining table entry if code is incomplete (guaranteed to have at most one remaining entry, since if the code is incomplete, the maximum code length that was allowed to get this far is one bit) */ if (huff != 0) { here.op = (unsigned char)64; /* invalid code marker */ here.bits = (unsigned char)(len - drop); here.val = (unsigned short)0; next[huff] = here; } /* set return parameters */ *table += used; *bits = root; return 0; } tcl8.6.14/compat/zlib/doc/0000755000175000017500000000000014566153412014634 5ustar sergeisergeitcl8.6.14/compat/zlib/doc/rfc1951.txt0000644000175000017500000011012014560736524016467 0ustar sergeisergei Network Working Group P. Deutsch Request for Comments: 1951 Aladdin Enterprises Category: Informational May 1996 DEFLATE Compressed Data Format Specification version 1.3 Status of This Memo This memo provides information for the Internet community. This memo does not specify an Internet standard of any kind. Distribution of this memo is unlimited. IESG Note: The IESG takes no position on the validity of any Intellectual Property Rights statements contained in this document. Notices Copyright (c) 1996 L. Peter Deutsch Permission is granted to copy and distribute this document for any purpose and without charge, including translations into other languages and incorporation into compilations, provided that the copyright notice and this notice are preserved, and that any substantive changes or deletions from the original are clearly marked. A pointer to the latest version of this and related documentation in HTML format can be found at the URL . Abstract This specification defines a lossless compressed data format that compresses data using a combination of the LZ77 algorithm and Huffman coding, with efficiency comparable to the best currently available general-purpose compression methods. The data can be produced or consumed, even for an arbitrarily long sequentially presented input data stream, using only an a priori bounded amount of intermediate storage. The format can be implemented readily in a manner not covered by patents. Deutsch Informational [Page 1] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 Table of Contents 1. Introduction ................................................... 2 1.1. Purpose ................................................... 2 1.2. Intended audience ......................................... 3 1.3. Scope ..................................................... 3 1.4. Compliance ................................................ 3 1.5. Definitions of terms and conventions used ................ 3 1.6. Changes from previous versions ............................ 4 2. Compressed representation overview ............................. 4 3. Detailed specification ......................................... 5 3.1. Overall conventions ....................................... 5 3.1.1. Packing into bytes .................................. 5 3.2. Compressed block format ................................... 6 3.2.1. Synopsis of prefix and Huffman coding ............... 6 3.2.2. Use of Huffman coding in the "deflate" format ....... 7 3.2.3. Details of block format ............................. 9 3.2.4. Non-compressed blocks (BTYPE=00) ................... 11 3.2.5. Compressed blocks (length and distance codes) ...... 11 3.2.6. Compression with fixed Huffman codes (BTYPE=01) .... 12 3.2.7. Compression with dynamic Huffman codes (BTYPE=10) .. 13 3.3. Compliance ............................................... 14 4. Compression algorithm details ................................. 14 5. References .................................................... 16 6. Security Considerations ....................................... 16 7. Source code ................................................... 16 8. Acknowledgements .............................................. 16 9. Author's Address .............................................. 17 1. Introduction 1.1. Purpose The purpose of this specification is to define a lossless compressed data format that: * Is independent of CPU type, operating system, file system, and character set, and hence can be used for interchange; * Can be produced or consumed, even for an arbitrarily long sequentially presented input data stream, using only an a priori bounded amount of intermediate storage, and hence can be used in data communications or similar structures such as Unix filters; * Compresses data with efficiency comparable to the best currently available general-purpose compression methods, and in particular considerably better than the "compress" program; * Can be implemented readily in a manner not covered by patents, and hence can be practiced freely; Deutsch Informational [Page 2] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 * Is compatible with the file format produced by the current widely used gzip utility, in that conforming decompressors will be able to read data produced by the existing gzip compressor. The data format defined by this specification does not attempt to: * Allow random access to compressed data; * Compress specialized data (e.g., raster graphics) as well as the best currently available specialized algorithms. A simple counting argument shows that no lossless compression algorithm can compress every possible input data set. For the format defined here, the worst case expansion is 5 bytes per 32K- byte block, i.e., a size increase of 0.015% for large data sets. English text usually compresses by a factor of 2.5 to 3; executable files usually compress somewhat less; graphical data such as raster images may compress much more. 1.2. Intended audience This specification is intended for use by implementors of software to compress data into "deflate" format and/or decompress data from "deflate" format. The text of the specification assumes a basic background in programming at the level of bits and other primitive data representations. Familiarity with the technique of Huffman coding is helpful but not required. 1.3. Scope The specification specifies a method for representing a sequence of bytes as a (usually shorter) sequence of bits, and a method for packing the latter bit sequence into bytes. 1.4. Compliance Unless otherwise indicated below, a compliant decompressor must be able to accept and decompress any data set that conforms to all the specifications presented here; a compliant compressor must produce data sets that conform to all the specifications presented here. 1.5. Definitions of terms and conventions used Byte: 8 bits stored or transmitted as a unit (same as an octet). For this specification, a byte is exactly 8 bits, even on machines Deutsch Informational [Page 3] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 which store a character on a number of bits different from eight. See below, for the numbering of bits within a byte. String: a sequence of arbitrary bytes. 1.6. Changes from previous versions There have been no technical changes to the deflate format since version 1.1 of this specification. In version 1.2, some terminology was changed. Version 1.3 is a conversion of the specification to RFC style. 2. Compressed representation overview A compressed data set consists of a series of blocks, corresponding to successive blocks of input data. The block sizes are arbitrary, except that non-compressible blocks are limited to 65,535 bytes. Each block is compressed using a combination of the LZ77 algorithm and Huffman coding. The Huffman trees for each block are independent of those for previous or subsequent blocks; the LZ77 algorithm may use a reference to a duplicated string occurring in a previous block, up to 32K input bytes before. Each block consists of two parts: a pair of Huffman code trees that describe the representation of the compressed data part, and a compressed data part. (The Huffman trees themselves are compressed using Huffman encoding.) The compressed data consists of a series of elements of two types: literal bytes (of strings that have not been detected as duplicated within the previous 32K input bytes), and pointers to duplicated strings, where a pointer is represented as a pair . The representation used in the "deflate" format limits distances to 32K bytes and lengths to 258 bytes, but does not limit the size of a block, except for uncompressible blocks, which are limited as noted above. Each type of value (literals, distances, and lengths) in the compressed data is represented using a Huffman code, using one code tree for literals and lengths and a separate code tree for distances. The code trees for each block appear in a compact form just before the compressed data for that block. Deutsch Informational [Page 4] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 3. Detailed specification 3.1. Overall conventions In the diagrams below, a box like this: +---+ | | <-- the vertical bars might be missing +---+ represents one byte; a box like this: +==============+ | | +==============+ represents a variable number of bytes. Bytes stored within a computer do not have a "bit order", since they are always treated as a unit. However, a byte considered as an integer between 0 and 255 does have a most- and least- significant bit, and since we write numbers with the most- significant digit on the left, we also write bytes with the most- significant bit on the left. In the diagrams below, we number the bits of a byte so that bit 0 is the least-significant bit, i.e., the bits are numbered: +--------+ |76543210| +--------+ Within a computer, a number may occupy multiple bytes. All multi-byte numbers in the format described here are stored with the least-significant byte first (at the lower memory address). For example, the decimal number 520 is stored as: 0 1 +--------+--------+ |00001000|00000010| +--------+--------+ ^ ^ | | | + more significant byte = 2 x 256 + less significant byte = 8 3.1.1. Packing into bytes This document does not address the issue of the order in which bits of a byte are transmitted on a bit-sequential medium, since the final data format described here is byte- rather than Deutsch Informational [Page 5] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 bit-oriented. However, we describe the compressed block format in below, as a sequence of data elements of various bit lengths, not a sequence of bytes. We must therefore specify how to pack these data elements into bytes to form the final compressed byte sequence: * Data elements are packed into bytes in order of increasing bit number within the byte, i.e., starting with the least-significant bit of the byte. * Data elements other than Huffman codes are packed starting with the least-significant bit of the data element. * Huffman codes are packed starting with the most- significant bit of the code. In other words, if one were to print out the compressed data as a sequence of bytes, starting with the first byte at the *right* margin and proceeding to the *left*, with the most- significant bit of each byte on the left as usual, one would be able to parse the result from right to left, with fixed-width elements in the correct MSB-to-LSB order and Huffman codes in bit-reversed order (i.e., with the first bit of the code in the relative LSB position). 3.2. Compressed block format 3.2.1. Synopsis of prefix and Huffman coding Prefix coding represents symbols from an a priori known alphabet by bit sequences (codes), one code for each symbol, in a manner such that different symbols may be represented by bit sequences of different lengths, but a parser can always parse an encoded string unambiguously symbol-by-symbol. We define a prefix code in terms of a binary tree in which the two edges descending from each non-leaf node are labeled 0 and 1 and in which the leaf nodes correspond one-for-one with (are labeled with) the symbols of the alphabet; then the code for a symbol is the sequence of 0's and 1's on the edges leading from the root to the leaf labeled with that symbol. For example: Deutsch Informational [Page 6] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 /\ Symbol Code 0 1 ------ ---- / \ A 00 /\ B B 1 0 1 C 011 / \ D 010 A /\ 0 1 / \ D C A parser can decode the next symbol from an encoded input stream by walking down the tree from the root, at each step choosing the edge corresponding to the next input bit. Given an alphabet with known symbol frequencies, the Huffman algorithm allows the construction of an optimal prefix code (one which represents strings with those symbol frequencies using the fewest bits of any possible prefix codes for that alphabet). Such a code is called a Huffman code. (See reference [1] in Chapter 5, references for additional information on Huffman codes.) Note that in the "deflate" format, the Huffman codes for the various alphabets must not exceed certain maximum code lengths. This constraint complicates the algorithm for computing code lengths from symbol frequencies. Again, see Chapter 5, references for details. 3.2.2. Use of Huffman coding in the "deflate" format The Huffman codes used for each alphabet in the "deflate" format have two additional rules: * All codes of a given bit length have lexicographically consecutive values, in the same order as the symbols they represent; * Shorter codes lexicographically precede longer codes. Deutsch Informational [Page 7] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 We could recode the example above to follow this rule as follows, assuming that the order of the alphabet is ABCD: Symbol Code ------ ---- A 10 B 0 C 110 D 111 I.e., 0 precedes 10 which precedes 11x, and 110 and 111 are lexicographically consecutive. Given this rule, we can define the Huffman code for an alphabet just by giving the bit lengths of the codes for each symbol of the alphabet in order; this is sufficient to determine the actual codes. In our example, the code is completely defined by the sequence of bit lengths (2, 1, 3, 3). The following algorithm generates the codes as integers, intended to be read from most- to least-significant bit. The code lengths are initially in tree[I].Len; the codes are produced in tree[I].Code. 1) Count the number of codes for each code length. Let bl_count[N] be the number of codes of length N, N >= 1. 2) Find the numerical value of the smallest code for each code length: code = 0; bl_count[0] = 0; for (bits = 1; bits <= MAX_BITS; bits++) { code = (code + bl_count[bits-1]) << 1; next_code[bits] = code; } 3) Assign numerical values to all codes, using consecutive values for all codes of the same length with the base values determined at step 2. Codes that are never used (which have a bit length of zero) must not be assigned a value. for (n = 0; n <= max_code; n++) { len = tree[n].Len; if (len != 0) { tree[n].Code = next_code[len]; next_code[len]++; } Deutsch Informational [Page 8] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 } Example: Consider the alphabet ABCDEFGH, with bit lengths (3, 3, 3, 3, 3, 2, 4, 4). After step 1, we have: N bl_count[N] - ----------- 2 1 3 5 4 2 Step 2 computes the following next_code values: N next_code[N] - ------------ 1 0 2 0 3 2 4 14 Step 3 produces the following code values: Symbol Length Code ------ ------ ---- A 3 010 B 3 011 C 3 100 D 3 101 E 3 110 F 2 00 G 4 1110 H 4 1111 3.2.3. Details of block format Each block of compressed data begins with 3 header bits containing the following data: first bit BFINAL next 2 bits BTYPE Note that the header bits do not necessarily begin on a byte boundary, since a block does not necessarily occupy an integral number of bytes. Deutsch Informational [Page 9] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 BFINAL is set if and only if this is the last block of the data set. BTYPE specifies how the data are compressed, as follows: 00 - no compression 01 - compressed with fixed Huffman codes 10 - compressed with dynamic Huffman codes 11 - reserved (error) The only difference between the two compressed cases is how the Huffman codes for the literal/length and distance alphabets are defined. In all cases, the decoding algorithm for the actual data is as follows: do read block header from input stream. if stored with no compression skip any remaining bits in current partially processed byte read LEN and NLEN (see next section) copy LEN bytes of data to output otherwise if compressed with dynamic Huffman codes read representation of code trees (see subsection below) loop (until end of block code recognized) decode literal/length value from input stream if value < 256 copy value (literal byte) to output stream otherwise if value = end of block (256) break from loop otherwise (value = 257..285) decode distance from input stream move backwards distance bytes in the output stream, and copy length bytes from this position to the output stream. end loop while not last block Note that a duplicated string reference may refer to a string in a previous block; i.e., the backward distance may cross one or more block boundaries. However a distance cannot refer past the beginning of the output stream. (An application using a Deutsch Informational [Page 10] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 preset dictionary might discard part of the output stream; a distance can refer to that part of the output stream anyway) Note also that the referenced string may overlap the current position; for example, if the last 2 bytes decoded have values X and Y, a string reference with adds X,Y,X,Y,X to the output stream. We now specify each compression method in turn. 3.2.4. Non-compressed blocks (BTYPE=00) Any bits of input up to the next byte boundary are ignored. The rest of the block consists of the following information: 0 1 2 3 4... +---+---+---+---+================================+ | LEN | NLEN |... LEN bytes of literal data...| +---+---+---+---+================================+ LEN is the number of data bytes in the block. NLEN is the one's complement of LEN. 3.2.5. Compressed blocks (length and distance codes) As noted above, encoded data blocks in the "deflate" format consist of sequences of symbols drawn from three conceptually distinct alphabets: either literal bytes, from the alphabet of byte values (0..255), or pairs, where the length is drawn from (3..258) and the distance is drawn from (1..32,768). In fact, the literal and length alphabets are merged into a single alphabet (0..285), where values 0..255 represent literal bytes, the value 256 indicates end-of-block, and values 257..285 represent length codes (possibly in conjunction with extra bits following the symbol code) as follows: Deutsch Informational [Page 11] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 Extra Extra Extra Code Bits Length(s) Code Bits Lengths Code Bits Length(s) ---- ---- ------ ---- ---- ------- ---- ---- ------- 257 0 3 267 1 15,16 277 4 67-82 258 0 4 268 1 17,18 278 4 83-98 259 0 5 269 2 19-22 279 4 99-114 260 0 6 270 2 23-26 280 4 115-130 261 0 7 271 2 27-30 281 5 131-162 262 0 8 272 2 31-34 282 5 163-194 263 0 9 273 3 35-42 283 5 195-226 264 0 10 274 3 43-50 284 5 227-257 265 1 11,12 275 3 51-58 285 0 258 266 1 13,14 276 3 59-66 The extra bits should be interpreted as a machine integer stored with the most-significant bit first, e.g., bits 1110 represent the value 14. Extra Extra Extra Code Bits Dist Code Bits Dist Code Bits Distance ---- ---- ---- ---- ---- ------ ---- ---- -------- 0 0 1 10 4 33-48 20 9 1025-1536 1 0 2 11 4 49-64 21 9 1537-2048 2 0 3 12 5 65-96 22 10 2049-3072 3 0 4 13 5 97-128 23 10 3073-4096 4 1 5,6 14 6 129-192 24 11 4097-6144 5 1 7,8 15 6 193-256 25 11 6145-8192 6 2 9-12 16 7 257-384 26 12 8193-12288 7 2 13-16 17 7 385-512 27 12 12289-16384 8 3 17-24 18 8 513-768 28 13 16385-24576 9 3 25-32 19 8 769-1024 29 13 24577-32768 3.2.6. Compression with fixed Huffman codes (BTYPE=01) The Huffman codes for the two alphabets are fixed, and are not represented explicitly in the data. The Huffman code lengths for the literal/length alphabet are: Lit Value Bits Codes --------- ---- ----- 0 - 143 8 00110000 through 10111111 144 - 255 9 110010000 through 111111111 256 - 279 7 0000000 through 0010111 280 - 287 8 11000000 through 11000111 Deutsch Informational [Page 12] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 The code lengths are sufficient to generate the actual codes, as described above; we show the codes in the table for added clarity. Literal/length values 286-287 will never actually occur in the compressed data, but participate in the code construction. Distance codes 0-31 are represented by (fixed-length) 5-bit codes, with possible additional bits as shown in the table shown in Paragraph 3.2.5, above. Note that distance codes 30- 31 will never actually occur in the compressed data. 3.2.7. Compression with dynamic Huffman codes (BTYPE=10) The Huffman codes for the two alphabets appear in the block immediately after the header bits and before the actual compressed data, first the literal/length code and then the distance code. Each code is defined by a sequence of code lengths, as discussed in Paragraph 3.2.2, above. For even greater compactness, the code length sequences themselves are compressed using a Huffman code. The alphabet for code lengths is as follows: 0 - 15: Represent code lengths of 0 - 15 16: Copy the previous code length 3 - 6 times. The next 2 bits indicate repeat length (0 = 3, ... , 3 = 6) Example: Codes 8, 16 (+2 bits 11), 16 (+2 bits 10) will expand to 12 code lengths of 8 (1 + 6 + 5) 17: Repeat a code length of 0 for 3 - 10 times. (3 bits of length) 18: Repeat a code length of 0 for 11 - 138 times (7 bits of length) A code length of 0 indicates that the corresponding symbol in the literal/length or distance alphabet will not occur in the block, and should not participate in the Huffman code construction algorithm given earlier. If only one distance code is used, it is encoded using one bit, not zero bits; in this case there is a single code length of one, with one unused code. One distance code of zero bits means that there are no distance codes used at all (the data is all literals). We can now define the format of the block: 5 Bits: HLIT, # of Literal/Length codes - 257 (257 - 286) 5 Bits: HDIST, # of Distance codes - 1 (1 - 32) 4 Bits: HCLEN, # of Code Length codes - 4 (4 - 19) Deutsch Informational [Page 13] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 (HCLEN + 4) x 3 bits: code lengths for the code length alphabet given just above, in the order: 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15 These code lengths are interpreted as 3-bit integers (0-7); as above, a code length of 0 means the corresponding symbol (literal/length or distance code length) is not used. HLIT + 257 code lengths for the literal/length alphabet, encoded using the code length Huffman code HDIST + 1 code lengths for the distance alphabet, encoded using the code length Huffman code The actual compressed data of the block, encoded using the literal/length and distance Huffman codes The literal/length symbol 256 (end of data), encoded using the literal/length Huffman code The code length repeat codes can cross from HLIT + 257 to the HDIST + 1 code lengths. In other words, all code lengths form a single sequence of HLIT + HDIST + 258 values. 3.3. Compliance A compressor may limit further the ranges of values specified in the previous section and still be compliant; for example, it may limit the range of backward pointers to some value smaller than 32K. Similarly, a compressor may limit the size of blocks so that a compressible block fits in memory. A compliant decompressor must accept the full range of possible values defined in the previous section, and must accept blocks of arbitrary size. 4. Compression algorithm details While it is the intent of this document to define the "deflate" compressed data format without reference to any particular compression algorithm, the format is related to the compressed formats produced by LZ77 (Lempel-Ziv 1977, see reference [2] below); since many variations of LZ77 are patented, it is strongly recommended that the implementor of a compressor follow the general algorithm presented here, which is known not to be patented per se. The material in this section is not part of the definition of the Deutsch Informational [Page 14] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 specification per se, and a compressor need not follow it in order to be compliant. The compressor terminates a block when it determines that starting a new block with fresh trees would be useful, or when the block size fills up the compressor's block buffer. The compressor uses a chained hash table to find duplicated strings, using a hash function that operates on 3-byte sequences. At any given point during compression, let XYZ be the next 3 input bytes to be examined (not necessarily all different, of course). First, the compressor examines the hash chain for XYZ. If the chain is empty, the compressor simply writes out X as a literal byte and advances one byte in the input. If the hash chain is not empty, indicating that the sequence XYZ (or, if we are unlucky, some other 3 bytes with the same hash function value) has occurred recently, the compressor compares all strings on the XYZ hash chain with the actual input data sequence starting at the current point, and selects the longest match. The compressor searches the hash chains starting with the most recent strings, to favor small distances and thus take advantage of the Huffman encoding. The hash chains are singly linked. There are no deletions from the hash chains; the algorithm simply discards matches that are too old. To avoid a worst-case situation, very long hash chains are arbitrarily truncated at a certain length, determined by a run-time parameter. To improve overall compression, the compressor optionally defers the selection of matches ("lazy matching"): after a match of length N has been found, the compressor searches for a longer match starting at the next input byte. If it finds a longer match, it truncates the previous match to a length of one (thus producing a single literal byte) and then emits the longer match. Otherwise, it emits the original match, and, as described above, advances N bytes before continuing. Run-time parameters also control this "lazy match" procedure. If compression ratio is most important, the compressor attempts a complete second search regardless of the length of the first match. In the normal case, if the current match is "long enough", the compressor reduces the search for a longer match, thus speeding up the process. If speed is most important, the compressor inserts new strings in the hash table only when no match was found, or when the match is not "too long". This degrades the compression ratio but saves time since there are both fewer insertions and fewer searches. Deutsch Informational [Page 15] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 5. References [1] Huffman, D. A., "A Method for the Construction of Minimum Redundancy Codes", Proceedings of the Institute of Radio Engineers, September 1952, Volume 40, Number 9, pp. 1098-1101. [2] Ziv J., Lempel A., "A Universal Algorithm for Sequential Data Compression", IEEE Transactions on Information Theory, Vol. 23, No. 3, pp. 337-343. [3] Gailly, J.-L., and Adler, M., ZLIB documentation and sources, available in ftp://ftp.uu.net/pub/archiving/zip/doc/ [4] Gailly, J.-L., and Adler, M., GZIP documentation and sources, available as gzip-*.tar in ftp://prep.ai.mit.edu/pub/gnu/ [5] Schwartz, E. S., and Kallick, B. "Generating a canonical prefix encoding." Comm. ACM, 7,3 (Mar. 1964), pp. 166-169. [6] Hirschberg and Lelewer, "Efficient decoding of prefix codes," Comm. ACM, 33,4, April 1990, pp. 449-459. 6. Security Considerations Any data compression method involves the reduction of redundancy in the data. Consequently, any corruption of the data is likely to have severe effects and be difficult to correct. Uncompressed text, on the other hand, will probably still be readable despite the presence of some corrupted bytes. It is recommended that systems using this data format provide some means of validating the integrity of the compressed data. See reference [3], for example. 7. Source code Source code for a C language implementation of a "deflate" compliant compressor and decompressor is available within the zlib package at ftp://ftp.uu.net/pub/archiving/zip/zlib/. 8. Acknowledgements Trademarks cited in this document are the property of their respective owners. Phil Katz designed the deflate format. Jean-Loup Gailly and Mark Adler wrote the related software described in this specification. Glenn Randers-Pehrson converted this document to RFC and HTML format. Deutsch Informational [Page 16] RFC 1951 DEFLATE Compressed Data Format Specification May 1996 9. Author's Address L. Peter Deutsch Aladdin Enterprises 203 Santa Margarita Ave. Menlo Park, CA 94025 Phone: (415) 322-0103 (AM only) FAX: (415) 322-1734 EMail: Questions about the technical content of this specification can be sent by email to: Jean-Loup Gailly and Mark Adler Editorial comments on this specification can be sent by email to: L. Peter Deutsch and Glenn Randers-Pehrson Deutsch Informational [Page 17] tcl8.6.14/compat/zlib/doc/rfc1952.txt0000644000175000017500000006071514560736524016506 0ustar sergeisergei Network Working Group P. Deutsch Request for Comments: 1952 Aladdin Enterprises Category: Informational May 1996 GZIP file format specification version 4.3 Status of This Memo This memo provides information for the Internet community. This memo does not specify an Internet standard of any kind. Distribution of this memo is unlimited. IESG Note: The IESG takes no position on the validity of any Intellectual Property Rights statements contained in this document. Notices Copyright (c) 1996 L. Peter Deutsch Permission is granted to copy and distribute this document for any purpose and without charge, including translations into other languages and incorporation into compilations, provided that the copyright notice and this notice are preserved, and that any substantive changes or deletions from the original are clearly marked. A pointer to the latest version of this and related documentation in HTML format can be found at the URL . Abstract This specification defines a lossless compressed data format that is compatible with the widely used GZIP utility. The format includes a cyclic redundancy check value for detecting data corruption. The format presently uses the DEFLATE method of compression but can be easily extended to use other compression methods. The format can be implemented readily in a manner not covered by patents. Deutsch Informational [Page 1] RFC 1952 GZIP File Format Specification May 1996 Table of Contents 1. Introduction ................................................... 2 1.1. Purpose ................................................... 2 1.2. Intended audience ......................................... 3 1.3. Scope ..................................................... 3 1.4. Compliance ................................................ 3 1.5. Definitions of terms and conventions used ................. 3 1.6. Changes from previous versions ............................ 3 2. Detailed specification ......................................... 4 2.1. Overall conventions ....................................... 4 2.2. File format ............................................... 5 2.3. Member format ............................................. 5 2.3.1. Member header and trailer ........................... 6 2.3.1.1. Extra field ................................... 8 2.3.1.2. Compliance .................................... 9 3. References .................................................. 9 4. Security Considerations .................................... 10 5. Acknowledgements ........................................... 10 6. Author's Address ........................................... 10 7. Appendix: Jean-Loup Gailly's gzip utility .................. 11 8. Appendix: Sample CRC Code .................................. 11 1. Introduction 1.1. Purpose The purpose of this specification is to define a lossless compressed data format that: * Is independent of CPU type, operating system, file system, and character set, and hence can be used for interchange; * Can compress or decompress a data stream (as opposed to a randomly accessible file) to produce another data stream, using only an a priori bounded amount of intermediate storage, and hence can be used in data communications or similar structures such as Unix filters; * Compresses data with efficiency comparable to the best currently available general-purpose compression methods, and in particular considerably better than the "compress" program; * Can be implemented readily in a manner not covered by patents, and hence can be practiced freely; * Is compatible with the file format produced by the current widely used gzip utility, in that conforming decompressors will be able to read data produced by the existing gzip compressor. Deutsch Informational [Page 2] RFC 1952 GZIP File Format Specification May 1996 The data format defined by this specification does not attempt to: * Provide random access to compressed data; * Compress specialized data (e.g., raster graphics) as well as the best currently available specialized algorithms. 1.2. Intended audience This specification is intended for use by implementors of software to compress data into gzip format and/or decompress data from gzip format. The text of the specification assumes a basic background in programming at the level of bits and other primitive data representations. 1.3. Scope The specification specifies a compression method and a file format (the latter assuming only that a file can store a sequence of arbitrary bytes). It does not specify any particular interface to a file system or anything about character sets or encodings (except for file names and comments, which are optional). 1.4. Compliance Unless otherwise indicated below, a compliant decompressor must be able to accept and decompress any file that conforms to all the specifications presented here; a compliant compressor must produce files that conform to all the specifications presented here. The material in the appendices is not part of the specification per se and is not relevant to compliance. 1.5. Definitions of terms and conventions used byte: 8 bits stored or transmitted as a unit (same as an octet). (For this specification, a byte is exactly 8 bits, even on machines which store a character on a number of bits different from 8.) See below for the numbering of bits within a byte. 1.6. Changes from previous versions There have been no technical changes to the gzip format since version 4.1 of this specification. In version 4.2, some terminology was changed, and the sample CRC code was rewritten for clarity and to eliminate the requirement for the caller to do pre- and post-conditioning. Version 4.3 is a conversion of the specification to RFC style. Deutsch Informational [Page 3] RFC 1952 GZIP File Format Specification May 1996 2. Detailed specification 2.1. Overall conventions In the diagrams below, a box like this: +---+ | | <-- the vertical bars might be missing +---+ represents one byte; a box like this: +==============+ | | +==============+ represents a variable number of bytes. Bytes stored within a computer do not have a "bit order", since they are always treated as a unit. However, a byte considered as an integer between 0 and 255 does have a most- and least- significant bit, and since we write numbers with the most- significant digit on the left, we also write bytes with the most- significant bit on the left. In the diagrams below, we number the bits of a byte so that bit 0 is the least-significant bit, i.e., the bits are numbered: +--------+ |76543210| +--------+ This document does not address the issue of the order in which bits of a byte are transmitted on a bit-sequential medium, since the data format described here is byte- rather than bit-oriented. Within a computer, a number may occupy multiple bytes. All multi-byte numbers in the format described here are stored with the least-significant byte first (at the lower memory address). For example, the decimal number 520 is stored as: 0 1 +--------+--------+ |00001000|00000010| +--------+--------+ ^ ^ | | | + more significant byte = 2 x 256 + less significant byte = 8 Deutsch Informational [Page 4] RFC 1952 GZIP File Format Specification May 1996 2.2. File format A gzip file consists of a series of "members" (compressed data sets). The format of each member is specified in the following section. The members simply appear one after another in the file, with no additional information before, between, or after them. 2.3. Member format Each member has the following structure: +---+---+---+---+---+---+---+---+---+---+ |ID1|ID2|CM |FLG| MTIME |XFL|OS | (more-->) +---+---+---+---+---+---+---+---+---+---+ (if FLG.FEXTRA set) +---+---+=================================+ | XLEN |...XLEN bytes of "extra field"...| (more-->) +---+---+=================================+ (if FLG.FNAME set) +=========================================+ |...original file name, zero-terminated...| (more-->) +=========================================+ (if FLG.FCOMMENT set) +===================================+ |...file comment, zero-terminated...| (more-->) +===================================+ (if FLG.FHCRC set) +---+---+ | CRC16 | +---+---+ +=======================+ |...compressed blocks...| (more-->) +=======================+ 0 1 2 3 4 5 6 7 +---+---+---+---+---+---+---+---+ | CRC32 | ISIZE | +---+---+---+---+---+---+---+---+ Deutsch Informational [Page 5] RFC 1952 GZIP File Format Specification May 1996 2.3.1. Member header and trailer ID1 (IDentification 1) ID2 (IDentification 2) These have the fixed values ID1 = 31 (0x1f, \037), ID2 = 139 (0x8b, \213), to identify the file as being in gzip format. CM (Compression Method) This identifies the compression method used in the file. CM = 0-7 are reserved. CM = 8 denotes the "deflate" compression method, which is the one customarily used by gzip and which is documented elsewhere. FLG (FLaGs) This flag byte is divided into individual bits as follows: bit 0 FTEXT bit 1 FHCRC bit 2 FEXTRA bit 3 FNAME bit 4 FCOMMENT bit 5 reserved bit 6 reserved bit 7 reserved If FTEXT is set, the file is probably ASCII text. This is an optional indication, which the compressor may set by checking a small amount of the input data to see whether any non-ASCII characters are present. In case of doubt, FTEXT is cleared, indicating binary data. For systems which have different file formats for ascii text and binary data, the decompressor can use FTEXT to choose the appropriate format. We deliberately do not specify the algorithm used to set this bit, since a compressor always has the option of leaving it cleared and a decompressor always has the option of ignoring it and letting some other program handle issues of data conversion. If FHCRC is set, a CRC16 for the gzip header is present, immediately before the compressed data. The CRC16 consists of the two least significant bytes of the CRC32 for all bytes of the gzip header up to and not including the CRC16. [The FHCRC bit was never set by versions of gzip up to 1.2.4, even though it was documented with a different meaning in gzip 1.2.4.] If FEXTRA is set, optional extra fields are present, as described in a following section. Deutsch Informational [Page 6] RFC 1952 GZIP File Format Specification May 1996 If FNAME is set, an original file name is present, terminated by a zero byte. The name must consist of ISO 8859-1 (LATIN-1) characters; on operating systems using EBCDIC or any other character set for file names, the name must be translated to the ISO LATIN-1 character set. This is the original name of the file being compressed, with any directory components removed, and, if the file being compressed is on a file system with case insensitive names, forced to lower case. There is no original file name if the data was compressed from a source other than a named file; for example, if the source was stdin on a Unix system, there is no file name. If FCOMMENT is set, a zero-terminated file comment is present. This comment is not interpreted; it is only intended for human consumption. The comment must consist of ISO 8859-1 (LATIN-1) characters. Line breaks should be denoted by a single line feed character (10 decimal). Reserved FLG bits must be zero. MTIME (Modification TIME) This gives the most recent modification time of the original file being compressed. The time is in Unix format, i.e., seconds since 00:00:00 GMT, Jan. 1, 1970. (Note that this may cause problems for MS-DOS and other systems that use local rather than Universal time.) If the compressed data did not come from a file, MTIME is set to the time at which compression started. MTIME = 0 means no time stamp is available. XFL (eXtra FLags) These flags are available for use by specific compression methods. The "deflate" method (CM = 8) sets these flags as follows: XFL = 2 - compressor used maximum compression, slowest algorithm XFL = 4 - compressor used fastest algorithm OS (Operating System) This identifies the type of file system on which compression took place. This may be useful in determining end-of-line convention for text files. The currently defined values are as follows: Deutsch Informational [Page 7] RFC 1952 GZIP File Format Specification May 1996 0 - FAT filesystem (MS-DOS, OS/2, NT/Win32) 1 - Amiga 2 - VMS (or OpenVMS) 3 - Unix 4 - VM/CMS 5 - Atari TOS 6 - HPFS filesystem (OS/2, NT) 7 - Macintosh 8 - Z-System 9 - CP/M 10 - TOPS-20 11 - NTFS filesystem (NT) 12 - QDOS 13 - Acorn RISCOS 255 - unknown XLEN (eXtra LENgth) If FLG.FEXTRA is set, this gives the length of the optional extra field. See below for details. CRC32 (CRC-32) This contains a Cyclic Redundancy Check value of the uncompressed data computed according to CRC-32 algorithm used in the ISO 3309 standard and in section 8.1.1.6.2 of ITU-T recommendation V.42. (See http://www.iso.ch for ordering ISO documents. See gopher://info.itu.ch for an online version of ITU-T V.42.) ISIZE (Input SIZE) This contains the size of the original (uncompressed) input data modulo 2^32. 2.3.1.1. Extra field If the FLG.FEXTRA bit is set, an "extra field" is present in the header, with total length XLEN bytes. It consists of a series of subfields, each of the form: +---+---+---+---+==================================+ |SI1|SI2| LEN |... LEN bytes of subfield data ...| +---+---+---+---+==================================+ SI1 and SI2 provide a subfield ID, typically two ASCII letters with some mnemonic value. Jean-Loup Gailly is maintaining a registry of subfield IDs; please send him any subfield ID you wish to use. Subfield IDs with SI2 = 0 are reserved for future use. The following IDs are currently defined: Deutsch Informational [Page 8] RFC 1952 GZIP File Format Specification May 1996 SI1 SI2 Data ---------- ---------- ---- 0x41 ('A') 0x70 ('P') Apollo file type information LEN gives the length of the subfield data, excluding the 4 initial bytes. 2.3.1.2. Compliance A compliant compressor must produce files with correct ID1, ID2, CM, CRC32, and ISIZE, but may set all the other fields in the fixed-length part of the header to default values (255 for OS, 0 for all others). The compressor must set all reserved bits to zero. A compliant decompressor must check ID1, ID2, and CM, and provide an error indication if any of these have incorrect values. It must examine FEXTRA/XLEN, FNAME, FCOMMENT and FHCRC at least so it can skip over the optional fields if they are present. It need not examine any other part of the header or trailer; in particular, a decompressor may ignore FTEXT and OS and always produce binary output, and still be compliant. A compliant decompressor must give an error indication if any reserved bit is non-zero, since such a bit could indicate the presence of a new field that would cause subsequent data to be interpreted incorrectly. 3. References [1] "Information Processing - 8-bit single-byte coded graphic character sets - Part 1: Latin alphabet No.1" (ISO 8859-1:1987). The ISO 8859-1 (Latin-1) character set is a superset of 7-bit ASCII. Files defining this character set are available as iso_8859-1.* in ftp://ftp.uu.net/graphics/png/documents/ [2] ISO 3309 [3] ITU-T recommendation V.42 [4] Deutsch, L.P.,"DEFLATE Compressed Data Format Specification", available in ftp://ftp.uu.net/pub/archiving/zip/doc/ [5] Gailly, J.-L., GZIP documentation, available as gzip-*.tar in ftp://prep.ai.mit.edu/pub/gnu/ [6] Sarwate, D.V., "Computation of Cyclic Redundancy Checks via Table Look-Up", Communications of the ACM, 31(8), pp.1008-1013. Deutsch Informational [Page 9] RFC 1952 GZIP File Format Specification May 1996 [7] Schwaderer, W.D., "CRC Calculation", April 85 PC Tech Journal, pp.118-133. [8] ftp://ftp.adelaide.edu.au/pub/rocksoft/papers/crc_v3.txt, describing the CRC concept. 4. Security Considerations Any data compression method involves the reduction of redundancy in the data. Consequently, any corruption of the data is likely to have severe effects and be difficult to correct. Uncompressed text, on the other hand, will probably still be readable despite the presence of some corrupted bytes. It is recommended that systems using this data format provide some means of validating the integrity of the compressed data, such as by setting and checking the CRC-32 check value. 5. Acknowledgements Trademarks cited in this document are the property of their respective owners. Jean-Loup Gailly designed the gzip format and wrote, with Mark Adler, the related software described in this specification. Glenn Randers-Pehrson converted this document to RFC and HTML format. 6. Author's Address L. Peter Deutsch Aladdin Enterprises 203 Santa Margarita Ave. Menlo Park, CA 94025 Phone: (415) 322-0103 (AM only) FAX: (415) 322-1734 EMail: Questions about the technical content of this specification can be sent by email to: Jean-Loup Gailly and Mark Adler Editorial comments on this specification can be sent by email to: L. Peter Deutsch and Glenn Randers-Pehrson Deutsch Informational [Page 10] RFC 1952 GZIP File Format Specification May 1996 7. Appendix: Jean-Loup Gailly's gzip utility The most widely used implementation of gzip compression, and the original documentation on which this specification is based, were created by Jean-Loup Gailly . Since this implementation is a de facto standard, we mention some more of its features here. Again, the material in this section is not part of the specification per se, and implementations need not follow it to be compliant. When compressing or decompressing a file, gzip preserves the protection, ownership, and modification time attributes on the local file system, since there is no provision for representing protection attributes in the gzip file format itself. Since the file format includes a modification time, the gzip decompressor provides a command line switch that assigns the modification time from the file, rather than the local modification time of the compressed input, to the decompressed output. 8. Appendix: Sample CRC Code The following sample code represents a practical implementation of the CRC (Cyclic Redundancy Check). (See also ISO 3309 and ITU-T V.42 for a formal specification.) The sample code is in the ANSI C programming language. Non C users may find it easier to read with these hints: & Bitwise AND operator. ^ Bitwise exclusive-OR operator. >> Bitwise right shift operator. When applied to an unsigned quantity, as here, right shift inserts zero bit(s) at the left. ! Logical NOT operator. ++ "n++" increments the variable n. 0xNNN 0x introduces a hexadecimal (base 16) constant. Suffix L indicates a long value (at least 32 bits). /* Table of CRCs of all 8-bit messages. */ unsigned long crc_table[256]; /* Flag: has the table been computed? Initially false. */ int crc_table_computed = 0; /* Make the table for a fast CRC. */ void make_crc_table(void) { unsigned long c; Deutsch Informational [Page 11] RFC 1952 GZIP File Format Specification May 1996 int n, k; for (n = 0; n < 256; n++) { c = (unsigned long) n; for (k = 0; k < 8; k++) { if (c & 1) { c = 0xedb88320L ^ (c >> 1); } else { c = c >> 1; } } crc_table[n] = c; } crc_table_computed = 1; } /* Update a running crc with the bytes buf[0..len-1] and return the updated crc. The crc should be initialized to zero. Pre- and post-conditioning (one's complement) is performed within this function so it shouldn't be done by the caller. Usage example: unsigned long crc = 0L; while (read_buffer(buffer, length) != EOF) { crc = update_crc(crc, buffer, length); } if (crc != original_crc) error(); */ unsigned long update_crc(unsigned long crc, unsigned char *buf, int len) { unsigned long c = crc ^ 0xffffffffL; int n; if (!crc_table_computed) make_crc_table(); for (n = 0; n < len; n++) { c = crc_table[(c ^ buf[n]) & 0xff] ^ (c >> 8); } return c ^ 0xffffffffL; } /* Return the CRC of the bytes buf[0..len-1]. */ unsigned long crc(unsigned char *buf, int len) { return update_crc(0L, buf, len); } Deutsch Informational [Page 12] tcl8.6.14/compat/zlib/doc/rfc1950.txt0000644000175000017500000005002614560736524016476 0ustar sergeisergei Network Working Group P. Deutsch Request for Comments: 1950 Aladdin Enterprises Category: Informational J-L. Gailly Info-ZIP May 1996 ZLIB Compressed Data Format Specification version 3.3 Status of This Memo This memo provides information for the Internet community. This memo does not specify an Internet standard of any kind. Distribution of this memo is unlimited. IESG Note: The IESG takes no position on the validity of any Intellectual Property Rights statements contained in this document. Notices Copyright (c) 1996 L. Peter Deutsch and Jean-Loup Gailly Permission is granted to copy and distribute this document for any purpose and without charge, including translations into other languages and incorporation into compilations, provided that the copyright notice and this notice are preserved, and that any substantive changes or deletions from the original are clearly marked. A pointer to the latest version of this and related documentation in HTML format can be found at the URL . Abstract This specification defines a lossless compressed data format. The data can be produced or consumed, even for an arbitrarily long sequentially presented input data stream, using only an a priori bounded amount of intermediate storage. The format presently uses the DEFLATE compression method but can be easily extended to use other compression methods. It can be implemented readily in a manner not covered by patents. This specification also defines the ADLER-32 checksum (an extension and improvement of the Fletcher checksum), used for detection of data corruption, and provides an algorithm for computing it. Deutsch & Gailly Informational [Page 1] RFC 1950 ZLIB Compressed Data Format Specification May 1996 Table of Contents 1. Introduction ................................................... 2 1.1. Purpose ................................................... 2 1.2. Intended audience ......................................... 3 1.3. Scope ..................................................... 3 1.4. Compliance ................................................ 3 1.5. Definitions of terms and conventions used ................ 3 1.6. Changes from previous versions ............................ 3 2. Detailed specification ......................................... 3 2.1. Overall conventions ....................................... 3 2.2. Data format ............................................... 4 2.3. Compliance ................................................ 7 3. References ..................................................... 7 4. Source code .................................................... 8 5. Security Considerations ........................................ 8 6. Acknowledgements ............................................... 8 7. Authors' Addresses ............................................. 8 8. Appendix: Rationale ............................................ 9 9. Appendix: Sample code ..........................................10 1. Introduction 1.1. Purpose The purpose of this specification is to define a lossless compressed data format that: * Is independent of CPU type, operating system, file system, and character set, and hence can be used for interchange; * Can be produced or consumed, even for an arbitrarily long sequentially presented input data stream, using only an a priori bounded amount of intermediate storage, and hence can be used in data communications or similar structures such as Unix filters; * Can use a number of different compression methods; * Can be implemented readily in a manner not covered by patents, and hence can be practiced freely. The data format defined by this specification does not attempt to allow random access to compressed data. Deutsch & Gailly Informational [Page 2] RFC 1950 ZLIB Compressed Data Format Specification May 1996 1.2. Intended audience This specification is intended for use by implementors of software to compress data into zlib format and/or decompress data from zlib format. The text of the specification assumes a basic background in programming at the level of bits and other primitive data representations. 1.3. Scope The specification specifies a compressed data format that can be used for in-memory compression of a sequence of arbitrary bytes. 1.4. Compliance Unless otherwise indicated below, a compliant decompressor must be able to accept and decompress any data set that conforms to all the specifications presented here; a compliant compressor must produce data sets that conform to all the specifications presented here. 1.5. Definitions of terms and conventions used byte: 8 bits stored or transmitted as a unit (same as an octet). (For this specification, a byte is exactly 8 bits, even on machines which store a character on a number of bits different from 8.) See below, for the numbering of bits within a byte. 1.6. Changes from previous versions Version 3.1 was the first public release of this specification. In version 3.2, some terminology was changed and the Adler-32 sample code was rewritten for clarity. In version 3.3, the support for a preset dictionary was introduced, and the specification was converted to RFC style. 2. Detailed specification 2.1. Overall conventions In the diagrams below, a box like this: +---+ | | <-- the vertical bars might be missing +---+ Deutsch & Gailly Informational [Page 3] RFC 1950 ZLIB Compressed Data Format Specification May 1996 represents one byte; a box like this: +==============+ | | +==============+ represents a variable number of bytes. Bytes stored within a computer do not have a "bit order", since they are always treated as a unit. However, a byte considered as an integer between 0 and 255 does have a most- and least- significant bit, and since we write numbers with the most- significant digit on the left, we also write bytes with the most- significant bit on the left. In the diagrams below, we number the bits of a byte so that bit 0 is the least-significant bit, i.e., the bits are numbered: +--------+ |76543210| +--------+ Within a computer, a number may occupy multiple bytes. All multi-byte numbers in the format described here are stored with the MOST-significant byte first (at the lower memory address). For example, the decimal number 520 is stored as: 0 1 +--------+--------+ |00000010|00001000| +--------+--------+ ^ ^ | | | + less significant byte = 8 + more significant byte = 2 x 256 2.2. Data format A zlib stream has the following structure: 0 1 +---+---+ |CMF|FLG| (more-->) +---+---+ Deutsch & Gailly Informational [Page 4] RFC 1950 ZLIB Compressed Data Format Specification May 1996 (if FLG.FDICT set) 0 1 2 3 +---+---+---+---+ | DICTID | (more-->) +---+---+---+---+ +=====================+---+---+---+---+ |...compressed data...| ADLER32 | +=====================+---+---+---+---+ Any data which may appear after ADLER32 are not part of the zlib stream. CMF (Compression Method and flags) This byte is divided into a 4-bit compression method and a 4- bit information field depending on the compression method. bits 0 to 3 CM Compression method bits 4 to 7 CINFO Compression info CM (Compression method) This identifies the compression method used in the file. CM = 8 denotes the "deflate" compression method with a window size up to 32K. This is the method used by gzip and PNG (see references [1] and [2] in Chapter 3, below, for the reference documents). CM = 15 is reserved. It might be used in a future version of this specification to indicate the presence of an extra field before the compressed data. CINFO (Compression info) For CM = 8, CINFO is the base-2 logarithm of the LZ77 window size, minus eight (CINFO=7 indicates a 32K window size). Values of CINFO above 7 are not allowed in this version of the specification. CINFO is not defined in this specification for CM not equal to 8. FLG (FLaGs) This flag byte is divided as follows: bits 0 to 4 FCHECK (check bits for CMF and FLG) bit 5 FDICT (preset dictionary) bits 6 to 7 FLEVEL (compression level) The FCHECK value must be such that CMF and FLG, when viewed as a 16-bit unsigned integer stored in MSB order (CMF*256 + FLG), is a multiple of 31. Deutsch & Gailly Informational [Page 5] RFC 1950 ZLIB Compressed Data Format Specification May 1996 FDICT (Preset dictionary) If FDICT is set, a DICT dictionary identifier is present immediately after the FLG byte. The dictionary is a sequence of bytes which are initially fed to the compressor without producing any compressed output. DICT is the Adler-32 checksum of this sequence of bytes (see the definition of ADLER32 below). The decompressor can use this identifier to determine which dictionary has been used by the compressor. FLEVEL (Compression level) These flags are available for use by specific compression methods. The "deflate" method (CM = 8) sets these flags as follows: 0 - compressor used fastest algorithm 1 - compressor used fast algorithm 2 - compressor used default algorithm 3 - compressor used maximum compression, slowest algorithm The information in FLEVEL is not needed for decompression; it is there to indicate if recompression might be worthwhile. compressed data For compression method 8, the compressed data is stored in the deflate compressed data format as described in the document "DEFLATE Compressed Data Format Specification" by L. Peter Deutsch. (See reference [3] in Chapter 3, below) Other compressed data formats are not specified in this version of the zlib specification. ADLER32 (Adler-32 checksum) This contains a checksum value of the uncompressed data (excluding any dictionary data) computed according to Adler-32 algorithm. This algorithm is a 32-bit extension and improvement of the Fletcher algorithm, used in the ITU-T X.224 / ISO 8073 standard. See references [4] and [5] in Chapter 3, below) Adler-32 is composed of two sums accumulated per byte: s1 is the sum of all bytes, s2 is the sum of all s1 values. Both sums are done modulo 65521. s1 is initialized to 1, s2 to zero. The Adler-32 checksum is stored as s2*65536 + s1 in most- significant-byte first (network) order. Deutsch & Gailly Informational [Page 6] RFC 1950 ZLIB Compressed Data Format Specification May 1996 2.3. Compliance A compliant compressor must produce streams with correct CMF, FLG and ADLER32, but need not support preset dictionaries. When the zlib data format is used as part of another standard data format, the compressor may use only preset dictionaries that are specified by this other data format. If this other format does not use the preset dictionary feature, the compressor must not set the FDICT flag. A compliant decompressor must check CMF, FLG, and ADLER32, and provide an error indication if any of these have incorrect values. A compliant decompressor must give an error indication if CM is not one of the values defined in this specification (only the value 8 is permitted in this version), since another value could indicate the presence of new features that would cause subsequent data to be interpreted incorrectly. A compliant decompressor must give an error indication if FDICT is set and DICTID is not the identifier of a known preset dictionary. A decompressor may ignore FLEVEL and still be compliant. When the zlib data format is being used as a part of another standard format, a compliant decompressor must support all the preset dictionaries specified by the other format. When the other format does not use the preset dictionary feature, a compliant decompressor must reject any stream in which the FDICT flag is set. 3. References [1] Deutsch, L.P.,"GZIP Compressed Data Format Specification", available in ftp://ftp.uu.net/pub/archiving/zip/doc/ [2] Thomas Boutell, "PNG (Portable Network Graphics) specification", available in ftp://ftp.uu.net/graphics/png/documents/ [3] Deutsch, L.P.,"DEFLATE Compressed Data Format Specification", available in ftp://ftp.uu.net/pub/archiving/zip/doc/ [4] Fletcher, J. G., "An Arithmetic Checksum for Serial Transmissions," IEEE Transactions on Communications, Vol. COM-30, No. 1, January 1982, pp. 247-252. [5] ITU-T Recommendation X.224, Annex D, "Checksum Algorithms," November, 1993, pp. 144, 145. (Available from gopher://info.itu.ch). ITU-T X.244 is also the same as ISO 8073. Deutsch & Gailly Informational [Page 7] RFC 1950 ZLIB Compressed Data Format Specification May 1996 4. Source code Source code for a C language implementation of a "zlib" compliant library is available at ftp://ftp.uu.net/pub/archiving/zip/zlib/. 5. Security Considerations A decoder that fails to check the ADLER32 checksum value may be subject to undetected data corruption. 6. Acknowledgements Trademarks cited in this document are the property of their respective owners. Jean-Loup Gailly and Mark Adler designed the zlib format and wrote the related software described in this specification. Glenn Randers-Pehrson converted this document to RFC and HTML format. 7. Authors' Addresses L. Peter Deutsch Aladdin Enterprises 203 Santa Margarita Ave. Menlo Park, CA 94025 Phone: (415) 322-0103 (AM only) FAX: (415) 322-1734 EMail: Jean-Loup Gailly EMail: Questions about the technical content of this specification can be sent by email to Jean-Loup Gailly and Mark Adler Editorial comments on this specification can be sent by email to L. Peter Deutsch and Glenn Randers-Pehrson Deutsch & Gailly Informational [Page 8] RFC 1950 ZLIB Compressed Data Format Specification May 1996 8. Appendix: Rationale 8.1. Preset dictionaries A preset dictionary is specially useful to compress short input sequences. The compressor can take advantage of the dictionary context to encode the input in a more compact manner. The decompressor can be initialized with the appropriate context by virtually decompressing a compressed version of the dictionary without producing any output. However for certain compression algorithms such as the deflate algorithm this operation can be achieved without actually performing any decompression. The compressor and the decompressor must use exactly the same dictionary. The dictionary may be fixed or may be chosen among a certain number of predefined dictionaries, according to the kind of input data. The decompressor can determine which dictionary has been chosen by the compressor by checking the dictionary identifier. This document does not specify the contents of predefined dictionaries, since the optimal dictionaries are application specific. Standard data formats using this feature of the zlib specification must precisely define the allowed dictionaries. 8.2. The Adler-32 algorithm The Adler-32 algorithm is much faster than the CRC32 algorithm yet still provides an extremely low probability of undetected errors. The modulo on unsigned long accumulators can be delayed for 5552 bytes, so the modulo operation time is negligible. If the bytes are a, b, c, the second sum is 3a + 2b + c + 3, and so is position and order sensitive, unlike the first sum, which is just a checksum. That 65521 is prime is important to avoid a possible large class of two-byte errors that leave the check unchanged. (The Fletcher checksum uses 255, which is not prime and which also makes the Fletcher check insensitive to single byte changes 0 <-> 255.) The sum s1 is initialized to 1 instead of zero to make the length of the sequence part of s2, so that the length does not have to be checked separately. (Any sequence of zeroes has a Fletcher checksum of zero.) Deutsch & Gailly Informational [Page 9] RFC 1950 ZLIB Compressed Data Format Specification May 1996 9. Appendix: Sample code The following C code computes the Adler-32 checksum of a data buffer. It is written for clarity, not for speed. The sample code is in the ANSI C programming language. Non C users may find it easier to read with these hints: & Bitwise AND operator. >> Bitwise right shift operator. When applied to an unsigned quantity, as here, right shift inserts zero bit(s) at the left. << Bitwise left shift operator. Left shift inserts zero bit(s) at the right. ++ "n++" increments the variable n. % modulo operator: a % b is the remainder of a divided by b. #define BASE 65521 /* largest prime smaller than 65536 */ /* Update a running Adler-32 checksum with the bytes buf[0..len-1] and return the updated checksum. The Adler-32 checksum should be initialized to 1. Usage example: unsigned long adler = 1L; while (read_buffer(buffer, length) != EOF) { adler = update_adler32(adler, buffer, length); } if (adler != original_adler) error(); */ unsigned long update_adler32(unsigned long adler, unsigned char *buf, int len) { unsigned long s1 = adler & 0xffff; unsigned long s2 = (adler >> 16) & 0xffff; int n; for (n = 0; n < len; n++) { s1 = (s1 + buf[n]) % BASE; s2 = (s2 + s1) % BASE; } return (s2 << 16) + s1; } /* Return the adler32 of the bytes buf[0..len-1] */ Deutsch & Gailly Informational [Page 10] RFC 1950 ZLIB Compressed Data Format Specification May 1996 unsigned long adler32(unsigned char *buf, int len) { return update_adler32(1L, buf, len); } Deutsch & Gailly Informational [Page 11] tcl8.6.14/compat/zlib/doc/algorithm.txt0000644000175000017500000002216614560736524017377 0ustar sergeisergei1. Compression algorithm (deflate) The deflation algorithm used by gzip (also zip and zlib) is a variation of LZ77 (Lempel-Ziv 1977, see reference below). It finds duplicated strings in the input data. The second occurrence of a string is replaced by a pointer to the previous string, in the form of a pair (distance, length). Distances are limited to 32K bytes, and lengths are limited to 258 bytes. When a string does not occur anywhere in the previous 32K bytes, it is emitted as a sequence of literal bytes. (In this description, `string' must be taken as an arbitrary sequence of bytes, and is not restricted to printable characters.) Literals or match lengths are compressed with one Huffman tree, and match distances are compressed with another tree. The trees are stored in a compact form at the start of each block. The blocks can have any size (except that the compressed data for one block must fit in available memory). A block is terminated when deflate() determines that it would be useful to start another block with fresh trees. (This is somewhat similar to the behavior of LZW-based _compress_.) Duplicated strings are found using a hash table. All input strings of length 3 are inserted in the hash table. A hash index is computed for the next 3 bytes. If the hash chain for this index is not empty, all strings in the chain are compared with the current input string, and the longest match is selected. The hash chains are searched starting with the most recent strings, to favor small distances and thus take advantage of the Huffman encoding. The hash chains are singly linked. There are no deletions from the hash chains, the algorithm simply discards matches that are too old. To avoid a worst-case situation, very long hash chains are arbitrarily truncated at a certain length, determined by a runtime option (level parameter of deflateInit). So deflate() does not always find the longest possible match but generally finds a match which is long enough. deflate() also defers the selection of matches with a lazy evaluation mechanism. After a match of length N has been found, deflate() searches for a longer match at the next input byte. If a longer match is found, the previous match is truncated to a length of one (thus producing a single literal byte) and the process of lazy evaluation begins again. Otherwise, the original match is kept, and the next match search is attempted only N steps later. The lazy match evaluation is also subject to a runtime parameter. If the current match is long enough, deflate() reduces the search for a longer match, thus speeding up the whole process. If compression ratio is more important than speed, deflate() attempts a complete second search even if the first match is already long enough. The lazy match evaluation is not performed for the fastest compression modes (level parameter 1 to 3). For these fast modes, new strings are inserted in the hash table only when no match was found, or when the match is not too long. This degrades the compression ratio but saves time since there are both fewer insertions and fewer searches. 2. Decompression algorithm (inflate) 2.1 Introduction The key question is how to represent a Huffman code (or any prefix code) so that you can decode fast. The most important characteristic is that shorter codes are much more common than longer codes, so pay attention to decoding the short codes fast, and let the long codes take longer to decode. inflate() sets up a first level table that covers some number of bits of input less than the length of longest code. It gets that many bits from the stream, and looks it up in the table. The table will tell if the next code is that many bits or less and how many, and if it is, it will tell the value, else it will point to the next level table for which inflate() grabs more bits and tries to decode a longer code. How many bits to make the first lookup is a tradeoff between the time it takes to decode and the time it takes to build the table. If building the table took no time (and if you had infinite memory), then there would only be a first level table to cover all the way to the longest code. However, building the table ends up taking a lot longer for more bits since short codes are replicated many times in such a table. What inflate() does is simply to make the number of bits in the first table a variable, and then to set that variable for the maximum speed. For inflate, which has 286 possible codes for the literal/length tree, the size of the first table is nine bits. Also the distance trees have 30 possible values, and the size of the first table is six bits. Note that for each of those cases, the table ended up one bit longer than the ``average'' code length, i.e. the code length of an approximately flat code which would be a little more than eight bits for 286 symbols and a little less than five bits for 30 symbols. 2.2 More details on the inflate table lookup Ok, you want to know what this cleverly obfuscated inflate tree actually looks like. You are correct that it's not a Huffman tree. It is simply a lookup table for the first, let's say, nine bits of a Huffman symbol. The symbol could be as short as one bit or as long as 15 bits. If a particular symbol is shorter than nine bits, then that symbol's translation is duplicated in all those entries that start with that symbol's bits. For example, if the symbol is four bits, then it's duplicated 32 times in a nine-bit table. If a symbol is nine bits long, it appears in the table once. If the symbol is longer than nine bits, then that entry in the table points to another similar table for the remaining bits. Again, there are duplicated entries as needed. The idea is that most of the time the symbol will be short and there will only be one table look up. (That's whole idea behind data compression in the first place.) For the less frequent long symbols, there will be two lookups. If you had a compression method with really long symbols, you could have as many levels of lookups as is efficient. For inflate, two is enough. So a table entry either points to another table (in which case nine bits in the above example are gobbled), or it contains the translation for the symbol and the number of bits to gobble. Then you start again with the next ungobbled bit. You may wonder: why not just have one lookup table for how ever many bits the longest symbol is? The reason is that if you do that, you end up spending more time filling in duplicate symbol entries than you do actually decoding. At least for deflate's output that generates new trees every several 10's of kbytes. You can imagine that filling in a 2^15 entry table for a 15-bit code would take too long if you're only decoding several thousand symbols. At the other extreme, you could make a new table for every bit in the code. In fact, that's essentially a Huffman tree. But then you spend too much time traversing the tree while decoding, even for short symbols. So the number of bits for the first lookup table is a trade of the time to fill out the table vs. the time spent looking at the second level and above of the table. Here is an example, scaled down: The code being decoded, with 10 symbols, from 1 to 6 bits long: A: 0 B: 10 C: 1100 D: 11010 E: 11011 F: 11100 G: 11101 H: 11110 I: 111110 J: 111111 Let's make the first table three bits long (eight entries): 000: A,1 001: A,1 010: A,1 011: A,1 100: B,2 101: B,2 110: -> table X (gobble 3 bits) 111: -> table Y (gobble 3 bits) Each entry is what the bits decode as and how many bits that is, i.e. how many bits to gobble. Or the entry points to another table, with the number of bits to gobble implicit in the size of the table. Table X is two bits long since the longest code starting with 110 is five bits long: 00: C,1 01: C,1 10: D,2 11: E,2 Table Y is three bits long since the longest code starting with 111 is six bits long: 000: F,2 001: F,2 010: G,2 011: G,2 100: H,2 101: H,2 110: I,3 111: J,3 So what we have here are three tables with a total of 20 entries that had to be constructed. That's compared to 64 entries for a single table. Or compared to 16 entries for a Huffman tree (six two entry tables and one four entry table). Assuming that the code ideally represents the probability of the symbols, it takes on the average 1.25 lookups per symbol. That's compared to one lookup for the single table, or 1.66 lookups per symbol for the Huffman tree. There, I think that gives you a picture of what's going on. For inflate, the meaning of a particular symbol is often more than just a letter. It can be a byte (a "literal"), or it can be either a length or a distance which indicates a base value and a number of bits to fetch after the code that is added to the base value. Or it might be the special end-of-block code. The data structures created in inftrees.c try to encode all that information compactly in the tables. Jean-loup Gailly Mark Adler jloup@gzip.org madler@alumni.caltech.edu References: [LZ77] Ziv J., Lempel A., ``A Universal Algorithm for Sequential Data Compression,'' IEEE Transactions on Information Theory, Vol. 23, No. 3, pp. 337-343. ``DEFLATE Compressed Data Format Specification'' available in http://tools.ietf.org/html/rfc1951 tcl8.6.14/compat/zlib/doc/txtvsbin.txt0000644000175000017500000001211114560736524017257 0ustar sergeisergeiA Fast Method for Identifying Plain Text Files ============================================== Introduction ------------ Given a file coming from an unknown source, it is sometimes desirable to find out whether the format of that file is plain text. Although this may appear like a simple task, a fully accurate detection of the file type requires heavy-duty semantic analysis on the file contents. It is, however, possible to obtain satisfactory results by employing various heuristics. Previous versions of PKZip and other zip-compatible compression tools were using a crude detection scheme: if more than 80% (4/5) of the bytes found in a certain buffer are within the range [7..127], the file is labeled as plain text, otherwise it is labeled as binary. A prominent limitation of this scheme is the restriction to Latin-based alphabets. Other alphabets, like Greek, Cyrillic or Asian, make extensive use of the bytes within the range [128..255], and texts using these alphabets are most often misidentified by this scheme; in other words, the rate of false negatives is sometimes too high, which means that the recall is low. Another weakness of this scheme is a reduced precision, due to the false positives that may occur when binary files containing large amounts of textual characters are misidentified as plain text. In this article we propose a new, simple detection scheme that features a much increased precision and a near-100% recall. This scheme is designed to work on ASCII, Unicode and other ASCII-derived alphabets, and it handles single-byte encodings (ISO-8859, MacRoman, KOI8, etc.) and variable-sized encodings (ISO-2022, UTF-8, etc.). Wider encodings (UCS-2/UTF-16 and UCS-4/UTF-32) are not handled, however. The Algorithm ------------- The algorithm works by dividing the set of bytecodes [0..255] into three categories: - The allow list of textual bytecodes: 9 (TAB), 10 (LF), 13 (CR), 32 (SPACE) to 255. - The gray list of tolerated bytecodes: 7 (BEL), 8 (BS), 11 (VT), 12 (FF), 26 (SUB), 27 (ESC). - The block list of undesired, non-textual bytecodes: 0 (NUL) to 6, 14 to 31. If a file contains at least one byte that belongs to the allow list and no byte that belongs to the block list, then the file is categorized as plain text; otherwise, it is categorized as binary. (The boundary case, when the file is empty, automatically falls into the latter category.) Rationale --------- The idea behind this algorithm relies on two observations. The first observation is that, although the full range of 7-bit codes [0..127] is properly specified by the ASCII standard, most control characters in the range [0..31] are not used in practice. The only widely-used, almost universally-portable control codes are 9 (TAB), 10 (LF) and 13 (CR). There are a few more control codes that are recognized on a reduced range of platforms and text viewers/editors: 7 (BEL), 8 (BS), 11 (VT), 12 (FF), 26 (SUB) and 27 (ESC); but these codes are rarely (if ever) used alone, without being accompanied by some printable text. Even the newer, portable text formats such as XML avoid using control characters outside the list mentioned here. The second observation is that most of the binary files tend to contain control characters, especially 0 (NUL). Even though the older text detection schemes observe the presence of non-ASCII codes from the range [128..255], the precision rarely has to suffer if this upper range is labeled as textual, because the files that are genuinely binary tend to contain both control characters and codes from the upper range. On the other hand, the upper range needs to be labeled as textual, because it is used by virtually all ASCII extensions. In particular, this range is used for encoding non-Latin scripts. Since there is no counting involved, other than simply observing the presence or the absence of some byte values, the algorithm produces consistent results, regardless what alphabet encoding is being used. (If counting were involved, it could be possible to obtain different results on a text encoded, say, using ISO-8859-16 versus UTF-8.) There is an extra category of plain text files that are "polluted" with one or more block-listed codes, either by mistake or by peculiar design considerations. In such cases, a scheme that tolerates a small fraction of block-listed codes would provide an increased recall (i.e. more true positives). This, however, incurs a reduced precision overall, since false positives are more likely to appear in binary files that contain large chunks of textual data. Furthermore, "polluted" plain text should be regarded as binary by general-purpose text detection schemes, because general-purpose text processing algorithms might not be applicable. Under this premise, it is safe to say that our detection method provides a near-100% recall. Experiments have been run on many files coming from various platforms and applications. We tried plain text files, system logs, source code, formatted office documents, compiled object code, etc. The results confirm the optimistic assumptions about the capabilities of this algorithm. -- Cosmin Truta Last updated: 2006-May-28 tcl8.6.14/compat/zlib/doc/crc-doc.1.0.pdf0000644000175000017500000275371614560736524017170 0ustar sergeisergei%PDF-1.4 %адХи 3 0 obj << /Length 1611 /Filter /FlateDecode >> stream xкХXKл6ОчW=Щ@Хˆ/‘:&›ДHŠEВ=5=аНV–\IЮж§ѕсPЖœhгЂHв“ЩсѓњјqфчЗOžўРѕŠ&ИVЋлэŠЋœiУW9зLbu[­~K^~X‹<ё§iмеэн:•™H‚ˆЦїm‡ГœёФmжЉ0Iwi~ѓoHuCR‘ИmяъŠЦcЗў§іѕŠЫ‚q[ЌRСYС-йоv§q\ЭW–Дшjj$уЦ€КeЖрЄўЌ­zŽ€ЩŸ\хЦr Оьт~Г2Ќ0Чэж0.ѓ•bRFS|ЩŠeЙTЋtІцкŠЮоmp`’зОНЏлaЩˆfкЮmˆiЪy:|—lr}бМbF 2_кЅїЎёфЦЋЖd Іai‘Џв‚хY1ГўбЩ7uйwCЗЩРMзШfяЦКkCƒ]’У6IлољУшї˜oB€яiПќžв$ж<ЩxF>ˆR[фy@Ш™еNаATЩЭ0іЎŒЅvІщЬЂг€в,СнюъёT$0фах‚|Qх‡Є}Н!qдtјcФЏMхАваJнтlє}уŽ> †Џ0Ў“ƒы]гјІўЫЛM(œђ€*]_ЅмpJЇy,ЙdVHјЭ ѓбeМ^ %uRvћУqЄ kюКОw{š>ьъOмЭе='ГYŠx‘1ШЪШаЯ YДP9=)Є›zЄsЏ|zŸщlсtА\_.љмО`юfдxŸ Ер€4ЃRЎР'ЛdЉШ Sц:iћ.”А‚Ш}ЉЪмЊVƒSIWЯоМ СЁЇ]Ѕ†ЎHXЗєЫ™ СЭ/Пв <•Z сŒj;z‚т“=И‡#~врtvэ.1ІВЩЕѕ4ьЖј яЂРѕc\Й`­'ЩJ"Њ,Ё*ЬiU ЊžFФТ\MB;•s жS0Nњэ‚Ућг)P*ŠFЪЦѓ50zйИa0† Й5њ ѕгœVЯh ћцЧб<5Q“дN‹‰ќФ+%а&y"•г…‘Š„ ;%A^МР V=h0Wб0J.‘‡X|•fїж~toУyћCуОХ_єТѕž;d€HнœHаЦzєQEХ6vЎ#xУяБ­|рi+і8“Dђу9PгŒљ`ŽЬwE{ ЛјЯM ™@Р4CE=Рч‰F>`Вkˆ#+R› !„хс1šzё,•ГУМ§I9D(!—ьЩ‰ƒ;š9JЧрџXЇ<9†„—>юпвoыЦ#03iBaњ™‹{OЧ uНЪЂЪІ,кxэsHвасЈПїCЌє@G*e/Bщцш.cВm T˜МчR=љ§№ ЧiЯ%3HЗTўёŠяЇ}DєоП&„с•xW!ЅБGЪч№дЋœz(ЁX‘™а,XлН8Or`Sњ™ž—|=KьЫb“fІж%-„N^РЕфЊ­)вЦКX…9s Єа2vAйuЇ'шЗОžЌhџnыњ{иЈMfЙДQвЦГ мr г{ФЪ@2КcИX@$>кё]ВГр ?…Rиe`m iђLlЗzТ`=@MЪKqRЂM$#€шФvVg Czћ?И†рељ2^…'bx7€Ћ;zГ$о@(&ЉЎƒќАжиЁЌЙЖ_Р9U_4RѕQЄљЉœ"экжЦ a„Ў—rHЌбпІ6џ5ќЉ^ЎЉ:C6=4.p%ЙЇˆЊЦЫZ>}.!n€žЩнСюТ~]h>†ŽaМЁž‰NšѓFtиmЧ№њС uX0ићРіпќтх <šN\3ч3E|іъ“—5В04Ф\сЃ H9№"5vъ@Ђb,(зZšФќ;vSgv{у‡sŽЁ‚o0яB[y /1ШБG /y+НПЋH:(цџЊi4K Qgўzsl€о›њь№ бw/ŸхЁ(˜(Юп?/>M”…ЯчЫїQлѕ{зФ†MвW6DЇЖлCBркц_ќ’‡лmb†ŸмзqЫЯЧЊslџС{œ}5кšХРЕbJp€{СЌџэђфхэ“Пmmњ endstream endobj 2 0 obj << /Type /Page /Contents 3 0 R /Resources 1 0 R /MediaBox [0 0 612 792] /Parent 15 0 R >> endobj 1 0 obj << /Font << /F15 4 0 R /F16 5 0 R /F17 6 0 R /F29 7 0 R /F28 8 0 R /F30 9 0 R /F31 10 0 R /F35 11 0 R /F36 12 0 R /F8 13 0 R /F11 14 0 R >> /ProcSet [ /PDF /Text ] >> endobj 18 0 obj << /Length 2263 /Filter /FlateDecode >> stream xкеZYsлF~їЏр#X1'sNх!QЌдn•SЎD[ЕоˆIˆA€AЫк_П=38‰ЁH):МOИ†ўzКП>РŸ/о|ЎgIхьтjFИFŠа™ Q&fЋйПŽј|A0ЅЩYЙоьъЌИž/уЩfО *)чT'Зs8Геж=`Iy5џЯХ?П?'d(›Ф0›с ѕkX2zЛ@\Њvš/ЦЏqрЦ[B„ц‰vf Т8R ŽбйL46ћ#[oђь&мЎ‚uЮ~wЦ:YФ|kИ|№†0оxп2ц6,Iƒї83hgwяв™фЎЖн•NюіŸPЃ^кƒёЊяяežwh IZЈFр燹D†Р`Bт–а­%lКъшbэŒАЫыl“іЙЖлА ­Т’:[У:ЉЩknЗGIG(e‹вœюпžЫj5ѕяў‰цƒ<†ДлO‚a §X•‡:YкэЖУ[”ХЂt(О8XЖЪгЭІ{x™7ПpЯ>7љ!+š’Vižл|Оаš>ѕІБPH€ђТiTƒК6э•_u›ЂнІ,ћ,кыžР§Ю*,ПіhЅGK)2„O!#-9O>:8бГџіеЛ*O–о›г:›“Є„‚НLB‰lЂD›Cq™ўYБЪОdЋ]š№8o“цѕШQ„Т”їPШef]ŠюєяЖ ,К‚Ъя …]`хЌJбПЉ3Kˆ e“ƒКlСвBЯpp@}cЈHо…*Q{`ыbgЕз dUvЛЫД”Ѓ„‘SЉњ€HљžЯ чАž[/ц Щn{v]лњІЬЫk OЭиџSЦк™FSŠp>оЅ”,ЗU’i•mН;hіњœѓРH бД"\Д7eЖДkpuŸ#ќЌ?C‡žх6АЕs4ЩПёй€Х а6VCцМ*ЋuZь[bФЮi~]VY}Го~+qhCИpf\RЯmh3HKМёqиˆуыzЂ"kHN‰€Ž€—Р;a ьHS$н-ѓl PиvЕ+V`ЛЛp}vc—Юa>‡ЫOXрЦŒpJТЭlŽi8м—ЪŸ _Эмс~m}эrSdэlsыЦ•ЊўЗyњпmћФЦvКВЫl“йŽу;ДмW‹pЙ†Š*НЖсЂЎвx~ыШsеЕ/K`mй‚N|ЪЈFŠ2ло…;AсД(|„8exАВ€ІQрі˜д62шнkЎw“nлђеUtжmЖЊЊн”D^DŒЯ‚•А8­‘гзHB–iкџ‘LСДЬэ‚c3 +dЛbVЈ™DF1эhЄ8$2‚ИiTУ1jfƒEя@qЉТAЖWx‚ђЁУŒŒ^№[ГŒ –)„{ЄŸ0ЦSM%ЂД›…Љ1Š utIr„їАut#4ТМњ[ФТФ'њ= ѓƒў3ђŠT?ФљЁн1дB н ИЬ\ѕрЙŽНŽ!` Н-э‰лs5к’Я­­kЈnщф*ZААЮ c*Ahв.јa*€#NѕожŽt ИŽ 0šіюу­ Џ4є–~2ХˆF\šq,6бbїKfoћЦ‡'6k8СѕБлQ?ыЩkЗ†Boйќv.р.Ы„JиD„mQќўž8мpї‡#qСю(s<ЂфОй‡eЎї~ :ƒyMXіЏˆF яђЉˆƒ_ jј6иф>д~ŒЙ `nk4{„їю9ІcяJ ^хњgАуPƒ3:•1Rf$$‚Ь †a€œ $hЃq9rMоNŠ6оЅЫќЎ(зYлЖхSуОn^бЮРs%ДСYz™яеZ+{]йfе!Т!PІSВЧЂc†ƒ\db!@wж У‰тщЛР%%’Ц•PI)Ч‘уT2 „˜ц BRм3ўU#ZqJ…ˆP/•њДЈд/•|œSH4,љШш#QСъ'„х# †IX’ТRн–a"Цa ЅdЫ@ў’Ћs3?œ›с•RэHуЕŸЦнЫ~=~_’” ƒ„6нббb‡ъЁШЋ#‰јUJHЏМ{ž+FЙЖ$ J}Џhkп'Сƒ2PЅ­ќpiлм,Ттeекf*К•m+ШЖ_ЛЂd\RДB]џкŽPзAиjчРюu])ЩљЦВ™lиЏщz“лЗaz‰sХѓpЬєгjх[ФwюЧќГqƒ“{дІю 265%0-„ќbАшЛШЋFМ}Ъ›шSОiм˜о9ПkSк$ъяЬbŒŠьg‡AРа` ВЯHyŠІЯАнўхQr MэглыaoЭ7#Щ‚@ыO}єUкыЬ‘zpф­Ё|„wё{е”)/AТaƒ‘>ђbv‚kђGбцB2|‰’№gRgЂЭБ „.ЮЕ aђ‚лOsўгšЦўГ’?Љь:+VnВьЎЎЊrЮмџ6Жў  ЛъОYŒШХ MЭ#\џЅЗr\Щ`=œзcГУ“!л-F 2JЊžьЁ,o{ёј6D54Юeї™`ŸP!tŒљћ|њ "ї0сў“х§`ућ„Ѕ}ыў#ЋќZИЛ.л„"ˆЙб0№+ajФоМПxѓ?г€Й endstream endobj 17 0 obj << /Type /Page /Contents 18 0 R /Resources 16 0 R /MediaBox [0 0 612 792] /Parent 15 0 R >> endobj 16 0 obj << /Font << /F8 13 0 R /F11 14 0 R /F36 12 0 R /F35 11 0 R /F7 19 0 R /F10 20 0 R /F13 21 0 R /F14 22 0 R /F1 23 0 R >> /ProcSet [ /PDF /Text ] >> endobj 26 0 obj << /Length 2608 /Filter /FlateDecode >> stream xкНY[“лЖ~їЏає‰šZ @€˜LМN“ЦnЇg;щЬzИv՘"^v-їЯї\@Š’ИёvЦй'‡РСЙ~‡МИ|ёЭv‘†i%‹Ыл…T*4‰]$Б #/.з‹Ћ ЏЗЛв}ZЎ”RСmнl—‘ њ2cBбђГoнњлхѕх›Eš8YЌ"ЊXёЏп/#МЦхo~”XRЃ,žЩPkЛXС#еЬм{Ж‰\q ”3N<Я!„g›ђiр€Ѓm( ѓ§“™Žю(@Оh!†тЙThx>o‡IЊ'{Ш/эёнr%мŸo•†‰Œџ$qЮЖ8h4(Я72ЁRzЊРяЯwЦ2YHŠ86‹Hl$СєajгџЯPїs—’жќIŠбž$жxfхХ‘xњЙsŒPЯcФxжˆ'72vЊм лБR+O’jœ,‘Ѕєaїл\‡ L)Žтэh*=:јosї(юф˜П~Щ…Е|‚ тЏь.OжЌј#Эў0—Д–OвKє<3ўщх$'Ь$i нOЗѕrеa=#T{АњЛЙ|eьѓЇђГ=V ^+-иlGћ‡фЋ( …єљАqƒњщ`GJЈЫ}Uo‹ЌœТŠPŠјЙ•AТеЗјŒƒЕЛkœ›sј4Œв1YЯ83мФ#CV­Ÿzk#Т$1Яюрsз&Zщк–Љн&Ћц‘–  p.miьQVFŽ@ъƒњ“[‡ф62‰жЧœ—рŒLŒ‹('>;^бAUWЋЯЎЉ™|ПŒу +ћїЙдRQЯŸHHЂЛ>k@—р sэp—Ќ;ЙеkРPG’“{ы уiы~я]•;8™ЄŒіXwdб$ Мrl€Ч!`ЌСК§+ˆJ‡o›z{x/\ЎтX2Пœ•eм~ЏЕы\оuХ[gUыO†щуЂW–Xђ„%g-Є*ИaцЛЂЊŠъŽiЄˆ4"EРt‹[Щ Эюќ;oШаИ]™хn‹Ыу;№ю&ЈЛ Oѓк›_˜уFиЩKЛЖЧЧNЏтPtОgРЖР 1q^šx/ <(.LЊзZ—јк~Wф љ§върхc SIЈ ђљ§кŽрyZљЅ el2 ѕа§0šТE3 дБDб˜gJ2ъ<С4ƒpм2лf$Z ЈХX˜И#ОчЧщP‹ёŽпЯi ю”&1ІњдЊЇ`utи)‚ƒЯѕэLQ‰вSуE“Š+Њ)C0eЮœ;a08rж*J№х ИСžщ;HM[шfжХь<:Ц#=Lђѕk2Хњ$ы  E•7nыƒJ)1Нг%LrМ4ѓ=мЎЫ8бел!c*RїQАЖ>ЅтА,*ЪvЬp0зB–[ХXВ”H ’Cм+№ эSXчK(œя]™u$э‡ЅЁšчїф’6ђІ{НЯЫЎУянКЏжY•яq•aуr”ђcЫыЈiŸ\ZжR…ОГC#з€Д(RogЯќяˆLптEq•ђ(.]4ƒVfђлеЛ‹D^УѕbЏ/(П2M$a‚W/9Ј4I^* АuйMщVыІИЇГ=g[пvtоˆnŸeFƒ{k§ajЦ O—­л91щ2ZZЏ RDщ‹’зY—ёˆ•‚Eр0УБ9Y!gУыЎЭ›ТWЋѕШn†Wџ^”%s^СаЄзLF…!QІ&} Ceбэіy^йlUЋЎб›cк J5l`ж p/ѕq№A*—Yлљ_˜kИРŠE[.„Ћ“№AuW7P•ЖМvz?Є gCt`Ќu*vЖœы0сиa›њ‚ИыoЪЂнPl(5jя—Ќaѕv'^ХкkџЮ‡'\к>Ž&н*рJщрJ№‘WЎ`žЊkžLЄСiЦH†›Ёc##5БЋбpp5qЭR7†щк­|і™јDУšнŸcўС‰-FљwXu“Р',r‹{vИl”€y:џrGО‡CќИйw:aЦ Kл‰сѕдЩГql+Ѓl]S2›qVFЈАиэЩ@Ўљ‚Э яˆ„h3иџЂЩzOх†СЏK *з”7ъ;W2љътWЉЧ7M)'оѓДюЛВЈœ?уGЫљах ^ёyXфЂ)ц,• ЩdШb–qЙВД)NGe"НЩyн—k&Ђу№ЈЈРМЮ.„Ф1lЌ2Pт‚ЎцUђЈР)8ќЇђЎиA"(§"хјжя7э7 щ^dhљп~LOb5Эˆ?ЈѓTŒCF<й5“tя8wY<ƒЪв•!чˆŸ+цŒPlЁƒ7“|caƒЗžЪ"ѓЛ\Нy+ЂыУipи}БЮ‚ўDј.+Jb1ЦЇзr3ёUYЙo‹–ЩмюMPЙЌ)ї<†ѓ|Ќх„‡€дLЇpxЗ( .ИеСЅКьё4Пяfхlю!ЭПDp›ЌYsŽЦKч%Ž5:тЈPiŒQ›рmнsœUx5мƒ“Дkš=гЎо^ˆјzNЈЕл‚№]УаJC[œ—  ю(6\ƒПo2l‘‰ъ}ЂТД Б)C"*TLы…Ї”Цs7‚œ=l†ІWzЖМCБ]Э•О‰JHRСх Ÿ CZm%аjПте;Дѓ’Р–‘lд’ dб ;PВx_Ц№gљ•3|яе|жž`]Ш}'ы_њfз-єхC_ бbƒоЛ!f|!‚ЋŸ~њзy%є|€›§š~яЕG_ŸЉё{уШ$b!НЧђx“QФM(Uнёщ­#X $]‡YуWНVшЫ. д3 ћЁD6TбI_O/%дCЉD#Єѓ'E“4&EЙЃЗфЄZРdЬќ ГOђжјa\‡N ГŸиbXЩЊ‘“МЎР8шgіD 8x…Е”чёй“OЖј.ЅівS^§упОй№ыцxs6jg)‚—m[^тЏ.TЙJ‚ŒwtЛщсјIoNањp‘ІogЕ(=x­G–ЄzŠ\_ыыKІ‚еЇЁp@”Gžч—bЦћ}`c˜b žˆT2щ3њЌЯби8a,ц;$xdiN VЫДТsьNGMэђ(АœQ5~S+GХšѓЗ1^СKxžЉŽЕзБ>ш‡ћџфZЭЄЏk=бѕŒ™ёCHШНч+tfХPЭ0TcJžўHˆƒ{97й п…žЯРH%‰|HЊ бЋ›Ђѓ\#@1тh№НЇ3№ЂŠи!’4TIМ`&Цїь —^ќэђХџˆаO endstream endobj 25 0 obj << /Type /Page /Contents 26 0 R /Resources 24 0 R /MediaBox [0 0 612 792] /Parent 15 0 R >> endobj 24 0 obj << /Font << /F8 13 0 R /F10 20 0 R /F1 23 0 R /F11 14 0 R /F14 22 0 R /F13 21 0 R /F7 19 0 R /F35 11 0 R >> /ProcSet [ /PDF /Text ] >> endobj 29 0 obj << /Length 2580 /Filter /FlateDecode >> stream xкэZK“лИОћWшH•G\тMlЪ‡dW9UЎJЅц”ѕ8ЦУ]‰œˆд8ГП>нh№%QekЦЉд^$юЏ_ўrћц‡їщЬЦVs=ЛНŸ1!bЃг™V&цBЭnWГŸЃr;_Ў#-wyMэЯЎpлЌЮ‹Ядœ/x•ычЂмфйКЂб/sЬB'п<ЎнfО`‘+pМv+zp‡НgjзŽйЎ~(ЗЭЋ§ПŸЇ"rwл]Ж}^ЬЙ§ћ,™-‹­ Ќ~ЬЖKЄі0_Hc"ž$†ZYБЂАd%L^§0iыЊнКFдM*ъUлЧЋ–ј…ЩЃЦЧоQїtяfmB­`а#lџЫyРе ъшgЕЩ/'q$Йт< ББE(?ю(шHюНŽw–фЛЈЫды’Ѓm„й‚fѓЈp_ЈŸy ЁърЅž“ЙQАа}?Рmтe„џ­РŽˆљ ЖRТyНcЃйk…'ќяm”ЇYЧбЅэTxжg іэŠlJС№[[в Ў+ъ=d>TД†к!^le„ѓAFкЫ(МџYЙЋif]юШžЙ&ЎЃн.ы WYнŒ1{рdƒpE_ИТ W€peЂ‚sѕЁ'@яPzЯд.‹0гKЃб 6КФЃЗ(sˆРG8ю->”‚ €ўqwЗЮЋ‡|x)€IHЭ1л‚ДЄШšq/gСHЮ Ъ-D3шўжјН"Из:Ќ:Ђž•†(qЪD Г@іCБмz™ЕšT@kёf-BХOЙŸт†гXи~Ъ`} …43-ъg[№лЌ‰,0вNыРdгLД,c§”4ЕБЖжї ?rІb–ъцљЇD%#T@"F5sў3FC[йЃСТf|&YcE§О„ќэ:ѕ1ЈЗ+я6x"c)Э(yЃD&Ц”RGЅlєсžМБh]R5"аАMв†п‡ћaIl› yЁP$‹оj)–\э1df:ЖFЄ8”Јˆ"–@вOb‡ ‚МДѕц\M›DCіцh0Уž€6ВŽђEаp0ЌnWДˆ5 ъ§5LJz“x,До†НZoЄї3+ (Ibkƒ'р#KСžSаx7щзБ} ССЉtќМгUsІ/вM]y№IГЁJКmpkœ˜—вБс{цхэQВŒ]рF Љ1гD ŽТеФЦВYo:чyлЖpf1=XьЄМУœ›ѓзЁBш<*ю?k‚tB ЅЙАІbxЬнв5F(аі‡}сБЬаг{Сk№-€2L…(гѓ{ћрgСvŒяТДЁЁ%њJЗ`JЦР$aH*mOћ>~uпw†ЦŸmкŒХ'ыЭёeи9 бMчд† ­Dј5œžаЁгbšUƒŠO OFНЊUоj•^`€SlтЪёт„ВЧxсmDўюіpБ/ћŽЂCц>ЦЇ`сi$х3q ЃіdНЃKNШЬ$тtOeЬšmjв8 ’bйLЭ“ЮНeой0я)—%ЖхЙЯрSJнgњЏc‹_I&ЌИ/bv тIaL PБiОЄЎ ‘v‹ўc4ePВЭп…Я>*5lАVЇ{Яі€ /Уc`ХLУБљ?ƒБќЖк'ЅкЧ bг‘кЧ –2ЧVz;BDЇћѓЕuš9]Їй^иІl^pЮA‚QaОІКоЫіJЖWT+П@­чDu№зЌh'[FrJ„G|%Лl_ЇœЅ™ц+Э ЙJ.L@ л8сіœЋєЉ’ !‹d[ИбЫэMOqЃњеээ"4՘и@•œи^{:sф{оv^T!гОщйЋ)„мWˆљZ}Œ'‚пьлі\ХˆwKcУL(П^*ф"ѕм K9!МДІ9SЭЅSЊЙєвњ§’G,W]њѕыuKІЗIq›TlRMБЩџтL^Tœё‹‹3ЫcхKГЮЇ|Ц”S>НЅ/їщmŠŠ_тытОќ|?_1э+ї№м#ФJрO`f™6ЧсМ9eШŠЯэu‡юlкьР?ЭЕшM‰7љ*пJ{аjЇ#PMD љу,фJNжE b> ]5VхЦQЫcЮ"QˆЎ*ЈЃWѓ”ЙЊ`Ў*я­шПН …—O…№ЦЎДІ}nъVU~З{ЌУe9Ю€ЖР“HАД"\!œт-sкмqЊц7:W3кь• ­ЦЁ=ШшМпCц0’јёи`•л›єВF ЮAkЮ”НЪ?%LИ­k.рт`wk.1Їяэˆnі+№aV‡wЮ LПŒРќк{kим[#“аIЌЕ4œЅwЮРwЫћБУ!sЩЮ]еЙК‹ўБЙƒфяzрЙ’M.:8’вљmG0ј“#б/,›OoRџˆ ўќѕHРiPчйІ—оmСŠЁoєhŒѓ6яO…Ќ\лиgВ}Fл“G;]ЧlбŒH№Щ ъаќPќGПœё тры~9;8GSћЧШЅ‡iŸJ^ї+DЏцСy#gЦ Љ в%й3ЭМS\@шЕ"ˆ@тГ7Л}ѓ_ю^ y endstream endobj 28 0 obj << /Type /Page /Contents 29 0 R /Resources 27 0 R /MediaBox [0 0 612 792] /Parent 15 0 R >> endobj 27 0 obj << /Font << /F8 13 0 R /F35 11 0 R /F11 14 0 R /F7 19 0 R /F14 22 0 R /F13 21 0 R /F10 20 0 R /F6 30 0 R /F1 23 0 R >> /ProcSet [ /PDF /Text ] >> endobj 33 0 obj << /Length 2598 /Filter /FlateDecode >> stream xкэ\Ms#ЗНяЏрqXa4ОБ[>ь*qеІ*UЎD9Х>аЕKG"ЗHЪы§їnC˜С ‡ф’ž4˜Кћсuа‡л7пџh–XХдрі~Т l Є&ŒЫСэнр?ХOЫХpФLБИ;ќхіяIЕƒ"Ѕ Unў9Ф 7юѓї?(b57ЎEDƒЕ‰А"T~ ет~%aд Ђ:?SIЫж ЊЧ‰бr@C G’я†#PКјНЌЭЃОСƒƒ l–жЛfD[9E•АoРkSќP6Я&€Ѓ6„ъMmšiUЉд`Wkи (7IРшЬАOuIЦ@sнљЇMwY=hКЧЯУ‘џШŠЌP‘0Пхь‚pœ ­&ы­ТХVеПхDЅк$cўЎaР<2 v+s,(4S §зz—ы@Ї.Ћs •9цЉAН/M8Б='МЫєˆ>fv]ўTo (‘ш„eoеш‘ §s|А„2}ЋX<ўд€Pi7"3ZBѓFЌБџо0bŒЁв§Ÿ†1рlZ&Ћƒ‰jЃFу•&RСРЈŒ›ж2geIO5Э\њH‡ЎјGЦЅнвъVТЈтЩN­+NЭ@ƒКФbСМXЇЎј…q!W­тъoЎn}uыЋ[_љшkуЃŠИбэjэAVT з—erЧ kclйdGМ‹щCэ(Фсъ ЙuєaЈУFюŒК†:>4nŽј9xetˆјmЧˆ_ФППЪЉЙ ј34 Ž” 'ВHYдСfZяЅ/}˜ќ… SЕBЇт)ŽjЪЌ;Zл†u UГoC-.нЯ­”ЬU1Щбќ1g–WЁ*'Э˜,nѓЩx=зГХ|8тZ‹ћ№„CqГЊ™њќп,ХёBъbьўЈтqКZ?M32+J˜А•ЩЎ8В–бВЛпTџШ*ФVиД0|K8*ъ`В"Žto‰R2€A‰gуB0=Ы]w0ъˆ–ф-Уь_8Q [\(a ЖхЭTZ„VJЌ-MŠeКТ”eW)ы>ПŽ"yr4Р†=šR‰Іи%5хэЖ 0ХIъZюЫЂє”вEV™ОG` tо‘їbеeФЂб6бKQйQёќЎ!–дAt˜оВЮ_pДH]Ÿ#nХfй]…NF"Є)s$y—дЉ ™žˆьд!ЛљU"0Y<~yZOЫA­?‡Їетqžfѓйz6~pŽЫŸ”Хјс)k Б*Ke,Ї †йЂьЁ[],?7Г#ЮЕЃкС‚e›фќ`›ъбe‘[-ЇЋ/~БžNжГпuNОэ>—г№№пљbШtёuюLZˆ <Э0HЈ1H‹сj;QЊДЇЌšђˆеЇq’г­Ћ4ВS Ю$NMš}Ё†’­ˆБSнЗ з_ƒђCaчЗЎфќvёД.ƒ ІУ$&Н^]ЯАЖ лi1s|pV–чг‰khљ-Мvцс^/Їй№х8Мћ2^–?і|гLwв]ўYA7Ш9bрШбі/ј€q›СИМ…таПsУЊŠ(8KA Фжhє‘ˆћѓm^и+Ю+'ФЎхІXэBRшcrіE[<'лU“™z€Ќ‡oC#Ж Ђ(ЖЋвipЩ`n|ŒйЂwi0н62І)“]ъьжи*ѕ§Gk6Р”œ’DЃ[ppіIXIгЙ/^a;сГyŽтяrйяsЬЦ…)Д-ЅwQо‡\фJЅк5А5ЩŒ )ПQVНЩЩb8яддˆ3J,ЋЄ?dїEЈд™А.s<5ЊдŸїrŒбН*Ghњ^lЬЭМй†—у‹ејБ|z˜Ю?љД~gѕЋѕ {дЃћ%Ї&Ж№‘ hЙзЮй"Аєr@—#Д ЉZp@ ьd!'нОmTщ‡|jR–МfНЯй7`‹ЬfzM]Џ6іŒћa_.lІ•”#W;zŽ…ˆž#њњш§АјЄЛ‘ga`љЕ'!]$ЄG?ЮяІгЛln8&ПvF'№/—дl'…К+žїœеLЗјŸЄ{NШйнnX?[п9PШpmeы[75№]Ж€ъоyѓ>уMЖ…hхючрвЅАќхшЖibyПЛxє<БŽїЎЄЇ…W.жЧQoЙ–ѕEј0ЄУM~ХЄгь–ПxLъЫuјa˜”!и=ZЅxVp!\ Нvюю ‰ю ›УЈтZž>€‹ѕ%lы ФмMТі§ыvK?№ІуЅ,Щ)дsю‚WF”ž€~yфъчˆcmПЋЯЮˆa,FЄБFћЫщ§bщcMlˆБЃЎћЪжЃЦнGнЈsім(ф!y&fw№!к}г^DеKЂGЏр†vХЋ'АЋu…MOъ^сћuРЗ~Nћ>ОYПЗ@КхUє–Gнйа"№тї<7ЦкMМУu„KХY{ ЗсжVУ­ЮЎ~Хw9/ЕйёFmѓхƒ.йе†мпZ :ЌъJхOqЉ3\юЪгї&[hSВЅзK Ч@^/њщvЇКЧлк­§gРЗЦХУ)ЫьОы†{‚­зyNž–>ї9y~ь]hП"§"ж‰Ю1ƒМЎџcыDz-–1}–{хьtф•GЇ™TDблѕы ЃgИaд9ћ SЏьћŠЊ'ГokХIџКРдўuСГВ№nџ!!йCА8IЉАТЩ,'AКjoўvћцOоШ)ь endstream endobj 32 0 obj << /Type /Page /Contents 33 0 R /Resources 31 0 R /MediaBox [0 0 612 792] /Parent 15 0 R >> endobj 31 0 obj << /Font << /F8 13 0 R /F10 20 0 R /F11 14 0 R /F13 21 0 R /F1 23 0 R /F14 22 0 R /F35 11 0 R /F7 19 0 R /F6 30 0 R >> /ProcSet [ /PDF /Text ] >> endobj 36 0 obj << /Length 2401 /Filter /FlateDecode >> stream xкэ[YsуЦ~п_СGАжЯ}8•{зыJЊ\ŽmUх!›TA$$ТІ™uјзЇч€УSЅѕюAsІбч7нƒя.о|§A 2’ЪСХе€pЁ)ЂL .Цƒџ$џЈ†)c,)і—'yЖxє#UщсIђ< NВjјп‹$CšВAJ 2DљЙо§2Є:ygŸ§рDF1m—*Юѕ …^ВƒQl’{šу@жІу@ЁЉFXOј] b­5сБ@K`д…Љк"ЁH?i‹ш#Б%сm•`OѓА>‘@вАњ9ЬAvЭё7ЊTЩнњTIТ[SЫАг›‚Z2aзdМE'‘вYЏ”вхкШF; AэcfOC1ChsцэрyфЙ.аO@Нэ™ЇяH№яЮНSЂ`IрB".HыYw‚‘ в.ЄіT•кюВъ”.ЫbзјБж+šш›u,ƒ§Љ=ЮOЄpЕцЮ[ѕ№ёRП\KФяЃ4m=м@ТЗGVЗз+!§+f‡J?“ŒЖјшкЮ2pэѓšі„‹вљ„Sљtэщј #]Pлї_TрЊV%|џсŸkLTћ…DUGН”*НEеŒИ№ЬЊжнЈk5П(0ЂРБЊЗ ?Jbp`С‘]ЄLBX Йэ~’ЯsїœqФэгЖŸЛ?;3ˆф@ ZHпаS{EыzmКг!%ёIПGZŸxб ЫǘпYёђqVp.Иђщщ6ь5)2zхйБзYwэ‡ˆ‡­Ћпb:GL6–w‘Y$Ј›жПEп—бƒ }:4;iІљЦ0aƒЊ‚:pЦАbІ)L!ЦCЈH~­Ъy1ЛІL ыRŒ€ємЭнPВ$›.s›]Uљм_V“0v“/йuОЮ;­jФТюш'јы,&EƒˆlD№sLŠZЩ“лqЪ5БјФўl"œ" "мŸV}9>9E9aMхQDьФ'`*˜Дhko\ˆф6ѓБПО/Њ‰Пњ3Ÿ—іJ&—E(—3ЋыЊ˜њ[gХіb–gѓ|Q…-МˆiэЂј_ывўёБВVЏMRЮ§я§*ИћЛK‹t’r9gѓG?”ЭТ3W'48ЉцCЃЎ8xSTUžg‹№ыљЫ|6Њ—ЛŠЙŽЖJ9џŽXGRššРKСNЗA‘д toОNŠ† Йny#‘iˆMНM`|Ы”‚ŠОA@”biІКbŸзЇ2Ы9i"Ц!СX'u9С€WMѓF›ќžкРб0\›\LœвХ{ћ ™Г ЁfЩWжшъ Њ9ФЪЖО’—Єв/b“bqђМуиђЏуEяUЊRФtU6*gЃ Ђ}VхЬWПЃіЋЌrд.хgxрШњeЬЅ\Œ>{6В]•гiiMФХg 0ъУŽo1lXO2ФV Fн–!Œх!хИНМж1шЃ,0™/ОђlњзДFXЁ,›6Н‘ѕ•SТм№юЮё|Іноv|M!"дйЃЧхдxвhк[gCq’oЮQЅ:UЎЗl…žРMФ™фBŽ‘Ko‹/Єˆxюn/V‘љ},тьї›X)еЂtйЋ—~;Ь№(2x Ђ\%sbхюЧ1uїЌŽй  š§оќН№0ЈєO2˜л#хГЌnš•§шHѕ‰РњЁ*Lд ‰-АѓѓУЖ›&M‚\+,VѓE2У+кЭ‰З.D–гЧYySи`Ш ƒDщчGLфЈШgчp1tž{šЋyy{sNу [?|ˆИ20Nл­ULk+@ќЮтЯЭ6?гЦчlЁ§ЏQ—еHjЙЖяуШМБрZTYл|ю†Аыqћvo’УFМ‡Ќя'ХШўeтГіИt›—<g˜•с|У8їЖ›зYНЦtН2ЗМ[:№Ђ|юi c ІнxРЖ2@-ЯЏЂkєiXь‹жrwД‚œ!*уд“ƒ05‡t‰і F„"!XП•АЉрhЮŒѓЯ ьŽ0r€щЂУ`N”Э'щJ…mр bЧœuјвСлЋЮ.]нєыьнЂˆъš}}`ХPDДwJЦŸС'З_ЖЧo)‚ЉFDС‘сз|\Рл#иц"$ НыUЌyb|Ч)і<їŠ,якx/cы(ЬЯˆŽ8љФЧіЊ]АЯЎvСž!а№Žи8я_8‘*Ѓgфz‹НнUАмр ь\НЋ^к‘ѕЋщ.Г ЅPЛiДEйюўыА0МГгџЅ=1E $X?€E›Ќ˜yВBФˆCїAžм™’b GљtЈ?щŠ)сƒ8[хˆ‰€ƒОІœx?WJу4ЙЮgљМљсE9]њў”}ф *0j+Ђі~Q…‘$‹6ь&ФlыМСЪЗвЫЂђГMK[‚ЕKЌJ4ю646“0жъZ4$kЫn gБЌK8 _Ж…ЋPtБC5‚wЃЖ$ущђ@жю;к'MЦ>uBСPšq(§PцooчљиV/љЌž SxъI wyџ%fO’гgшЎцfЋl‰ћёЖeгщc,@АžFiчуЯ]їƒCћ˜3•\LbR qКwŸЮ[žhFдGyHДлHZнFВБлhр’™­нFŠ$6;уЁђРn#ЉЛ–НpšД>­ВDЌя"“r9mšЉЎ’>ЯВ>>хHч}.}щѕeZдрОhaжИиfъ­вџb]T`eeЌgŽ4GaЮ\;бFr3J1Oо,Њ3Gˆ|_ѓвјјјяkиЖКЪ>Л™hŒZяsЗІZУmguёyйЦŽгУ‡V5_#žЕMa™ЩžpHбћrb§L,уІПYXїцZ>‡њAЏ"h(pеšЩŸёвѕс4•мXLАœVХэSUм C"ŽРЬa0zиЫёСТьоЕX‰зx4ы№ћъ>žs2h7WA†љCБЈ‚`‹ gс&/№_џиЅlu˜ƒИ60g4wХтršћс€зyа rЊЗ0‰Џ"‹kлщo2‡Э§MгьRWіЄЫвг­*Џа–>Јђ™? Уп/Gгbœg3џ0›^—ѓЂšмјO•лјЇТж˜УLв>yѓ§Х›џ-‘Гђ endstream endobj 35 0 obj << /Type /Page /Contents 36 0 R /Resources 34 0 R /MediaBox [0 0 612 792] /Parent 15 0 R >> endobj 34 0 obj << /Font << /F8 13 0 R /F10 20 0 R /F1 23 0 R /F11 14 0 R /F13 21 0 R /F14 22 0 R /F35 11 0 R >> /ProcSet [ /PDF /Text ] >> endobj 39 0 obj << /Length 2593 /Filter /FlateDecode >> stream xкнZнмЖї_БZ4bФ‰”‹>ДqмЄ€бд9 тwyЗvЅГДыЛkџљЮpЈoюоХ8;i_N$5чѓ7мћЫе‹Џ_›UЮђLdЋЋы—’щЬЌВT3!гееvѕsєѓwE›№_^ЎЙњлJ&…YХB1Ѓш§7oзТDпрыЏ_ѓd•Б\KƒьgJщU м3;yВбІ)IОт‚ЅЉ$Ђw‰Hˆn,\ЦВ\3Ю’дсП<З1Л8aZ‰UB–ћфIК2,бнnIрЃXšeЋx ћЧR$ЭŒЮК­о%iˆебм/yЄp,5тС—#‹™Фќ)пlBл)ЦЙWіOžHŽˆ pJ™z§ŒeLнбМ ˆ.ƒxДез1Я4ИJЌyєv^3њLhІeі іyГд-_Hљ ”~‚Юйѓу’UЮ2Ў>“8 i–ўтu&Xnђ>вјr У47>в<сŸмї17АНRџœхмtяbЁЭ…< 8S”дХ<`~eШџЗђРgВыя?шP(Ќ/ѕe2ЊZ]ш|$шp$Јu ‹ Ѕ<›oхŽ‚BYŒ'сxжѕoXŠд$њc.С'i.ЯdGs эЃљ›–Эщ‰Д+їlTх†Я:QjQџцLh žъ=sLa=ўп ѕ4“№Яi“чЩrjb+,‹ЃžMфW!ЁŸyQи}Ф#aј;ЫЕ3дqЈ!8LД iз Їћ!фбк<ћсаё@!G‰ 3"ŸV€@ №|о†DЭЄђЬ†8 A^ty\1Љ@—šRDW,$TЅЎTPЎЙHЃoп%<л”ЖZKзБдiджзGœо­ЅˆŠЦвjyИнлƒ',Že] ›AЙLSЗY:‘:Tоь7zSмо–е ёz_лcc‹CKѓcMЯ]бlяpƒ~зЦо”эб6эR;‰Г’єFzН62Њ›uЌ„ˆіхёИЗБ­ЖeQс’ŒХЁьЎЌlK+h”ЂmOЛЅ…ыІ>аїUДwД\WЈњЏ`Ђ@вЅеЦЖЇ§‘ШыkZлзХжб}vM/‹€б ГГйђ—шЭƒО@BƒH WнlqfЂы5œЬ89иCн<YY!г*ЬHЋА@Z…AЇUz(ŽЄд .ИCт“GЗ.fэ† пОDeGчТ†Єœ)‰; ’2rТуРižЄCt4*zћ?§њ{П[}pЖ }BцллЂѕЬлђІ*С™е,Žg иО,@ЏN<ХЬ(›КгСыŠь*ёу:„‡Ё–№y' @BЏ˜.RТЄ­rˆzV“фЄhiРjњ\]уCЇдHH ƒ@ŒL™'А”MUбЧ–ЖїfˆЁЉR€ЛKA^Š$­§pВеЦв ЕŽOE„Љ[ZMююyСPИaŠC9Ќ*"E•с,‘ЖyйYŽEꉛ‘Иw;ШRЮVн\l№І G'5ЬТDЪ>LШ•fp NбвjЧ”тоkіU}(‹}ЈƒаLjьxЅƒEП ъuЏQ;&y№ц$“ŽЛЖG!ЦSітЫэХг/И—њr{ЅЁN@e9$„<Н ˜)мGўёr)6tД†eю’–j$ќѓv[КBн „DЕЅA{zlŠЭ№ЦEp>rыC][ЗДzWbJЦб† э1цaOхŠkђiХй'ДПОЈ”%&­Ѕ№И и–ž}_ŠdЂX–ЬŠЦ8єВХœ$ѓшŸ8§ћ[œ:<Gйаpƒ…Џva>; ƒЪСEєŠyЛ/7…W0эјє˜'ЗHй/Є“3eа 8ыхЮ{mPЌ] 5кыШпn=šЭЁ”jІ ’ –i љёNАЧI5хЭЮЅHzзюЪk?Фƒсs€~SSFЕєh‰f`ŸEм/•GаZЪ“ш{ЯЈ˜m‘E5хTлx}тkg„тGkqdлюуPЕ.?Јoќѓqэx}5KЫ„й|%W‘OуƒЈ ДDМЕ7Е!K‡ }ѕcиЭ—UžTХўn,єыБƒрОŠ“Всщї‡1рYлњЗЧ]Q…к•05єЏ‚ЗЙш›‰Л]нZтИ ZoLе jŒ5TJavjI‡0ДїБ?`MЩi%†$В:{ И]\’V@їЮŽэ†]•&0Z’Зг+юр {žа˜*Щ{ŽпјƒС">ё‹;єДr>З'*EiБВЗСЮ5$%ц'‚офЂїЩ ЬЦ•žzEU7‡b_ўлЎSоЕЩcн(,#jц_ал%rЪч'€A–4„›u(Оnлђ§оввшN…{ЙёЉђюуƒїˆIы_л{L{%vТaП6бSЏ†еЛrП Ж>'y%S”о‚‘§Ц#є@н†ёT<5у^Б[кшц^}š3-gњћБtН œЫЏ8О­b–r}ЬчY$œ€=}љ^CчЯў[ƒЏЄє‰CCT„`щ G8,гМТ•Ъ™ШљŒш >утrrРлS-|чтјnъ.`7Їљ,ЫЬRvъ‰ˆЌ7pZ_Ц[šVЕ[7іŠ~8j LоA‰…СHIўdgЃЖТ Н6”Р RШwўj§нg/АёPЗўлiS‹Ѕ™B(Ь7ЏыСхцT4ž‘э‚€zхBPS*WИЅG„88XPh2 VМ*;^nBЉFvю~яЅuw?$КћЁ ТЫpX2D>fџач|žk'лLO” G>0†˜•|œЃ–€™+І)н1uПх,PŸёЈЯ Ўћћ™PC€сћI™ ї˜•Њ–vь­‚$Н§pRl65кЂнu:X†cїлВ+뉈R<ƒЫx8‡‡€Чє1К4"*шЩp‹С=тbЛ%КвLдƒHYѓшjчS ђD[ћсT)ЋКѕјко`n.0џА^щ…2ИЋoцnlуіtз]лNwЮv2КщќAйн@ЬіW>ќiЎ,/ЛВ{žЊG|ёБ{ЮWЇЦЩ…рПЌ }C^}в53yџЫ=u6|п1ИK @я!—pm‰iœTv hˆ3.,n` 5зѓлP…т&шуОYЋg58|‘2љшgUп~ яЊŸџGЉoTюќІgыjš4V3ЭL~iТŸЋzеe!H.ќС— щбэdпЁ9Щ†  ѓiЈJ/`5v~ап}ЄЗНзсюзљCЩ™˜]> endobj 37 0 obj << /Font << /F8 13 0 R /F10 20 0 R /F1 23 0 R /F11 14 0 R /F13 21 0 R /F14 22 0 R /F35 11 0 R /F7 19 0 R /F39 40 0 R /F19 41 0 R >> /ProcSet [ /PDF /Text ] >> endobj 45 0 obj << /Length 3180 /Filter /FlateDecode >> stream xке[kлЦ§ю_ЁєCAСбxоЛЮ‡& ДNRtQЄp@охю жJŽЄЕыќњž;3”ШхcХ2RЫЩбхмзЙчх_žˆЧ?1Š3щХЬZСœГЫЛ'Џп№йn~;у,;ћЇосOБрЭl=ћЧ“П?љх$BцМ‚У$7C"’оЁsжŸ%BcЊBДsLЛ0eкcžЕ“ЌQдH&˜ЖКcEќљтЩГЏ…›9Г‹ы™'!Ъ0дьтjіКѓ…PRЯц —ŽVРEn‹epцД 3У‹M<^ЅKtЧoу1~vХvО№ЎИЌяуё=ŽЖј4_Xх‹Џ0WКb љЮe–iиЇс@Яц2žz_Ќвp“† ЎКxн˜r™†emІ'i!HZЉА6ЮД.>ТЦ*Ќ‰Эп\|ћф/]юг’Й0Щ{#% 8OfeHЮ“ф§HёaŠзА—&ˆІ7!=Д_ує ˆ,†ЗєЭJ†#6Ща$CТця⹆νЃAЉ‚Xб":Та;Іœ­Т№'ЮUšеT–3Ўu5щпr SК!„о#-АРU5љЉ*R–ФДЙ›K q@ДРТPЙ?„f N› cE „‚pL*“є2@л>ЏЁВРk"јёСEЏЁŒРkЦЦ:"‚LЎYPr’юcE шЮsN$н-tЗЈpTŒ,Щu‘б™тQцвcT,KF x(Œu46М {їRрёЦ4ѓт{ъŽ^эŽ3ОŠљ‰жЋтщ\ фžЮQ@пЅGѕРЕяБњ Д6СР`nŠ[F‹шw‹ ž)nгЊŠЛw5zуvп)ф*яyƒь$#нТqŠЎсИ'f#Шg::V ъ€Щ™аuXсŽБЬћуœ_#љŠУ. x,+В)$ŽRtUƒ‰СђL[х™›4…ˆжQ9Фс”Г`0)Fр™чВ†gR-шoMŠБ""Ф{цЕL‹ї#ФŸЙюUuєр>ЙІ NWIuV—Р™WПѓтœЩМQAСAЬн$VЬ%]D4qL 6GІnEз‘врlЮ№=Ѕэ6Ю2ЃќЄ +b \ Ш4&PV‹иCH‘Ap,{књж'Šw dк‰s‰3l&: ;аУN€Mъ„m0-N~'‘†˜R;@<3тqА9etыБ|SХgxH,?.„"+‘я‚LѕГZŸX­ЋБZ'\ёѓН庘!‰кAИ‹,pƒ"0ю&5бЃEt…2Ў4Y'Њ&š,л8fљЄюqДˆЁeƒшм> бТ>›IIюZР‹wёѓћјљ>~>ФЯ+нyє\pтдˆx„Ї-‚х<ЊNљЭЯB№ЂрUЋ›рбЎІe§щЉxвЪEЅАlВa•LtЏ М*Џ рˆё!ˆд);Љя-b X іLС"[Žpˆ20ЖUЫА)jpгсиХЊsv P˜V[FJА˜ГЩєB(WЦEзL6ђ˜ЉК"bnвйЎq‘ъ0мPhž˜kEDмc­6BјdћЎvXDHЧXj$#ЈD>бPUF'‡~Љ§9­9"4&BЩ)>oм(hшЄюvДˆG*ЩИЩн­а-O*•|—˜МUїнётџвwЌOg›рУF=B& ХЫуЃ€eŽw€рШюujБЪД§КOg{ъ†eьz ŽЫxмаЖА‰mЊ„Gp7g&mƒ1R2rџ/ 5 Ъџv5Б'ієHl4v Ќб=bч‘t~бC:ЅЉц‰џ;ќ™Жі|UМ†•K?m`ЌˆяХ„ЬлТvН LИ#юнtYFАЧŽЭOэNH=ЧХЖ\Љ™цюœšХ)Ѕ&mg1`0Ў˜ЕUйrПM8юЦ#\#Š VмYQlUЈGqмDы5О‚)3‰1Œбo|4!wЃТŸ­=ŠЁžћ0iЏeДˆХМfNU}RшJ—РИpч(ц$гrR'5ZФ€bЮ0 Θ^ФХэ]“КdА‚2 ‡4мЇ!плал3?юe‘t~0–­„z“Zуб",c ѓ<З В“жп0чИмx|iв/4ˆsS~‰pŽˆG‰0aGЕFє‘Ї§AK•†TБ4‰ни^g…КXaEмŠh6us,Њ)ш˜Њžџ§ѕ EкUнSШh4ћ2кgŸn)&с/ MSё]3Щž4}uHWљ ›ђВ$кVь—ЛOщвa›ЦЫЈgйсg@<3V=аA№™E**Ÿї”‚FоY‘ё][QФЃ.jГюЖбПW]Eљ==ѓ‡Ж8ЧNФО'IѓN˜>­њ$C$K\ow)ФАм˜Ић@V’ѕ(ТжЫнM™тъУмиbЙО/їщж1 ъKђ ~|цw]ЩУqї›щттv•eо-щщŸвпІфH'KЊ”б‰іл —V›.ьPр‰цјяѓ”†m=2јhУz Й$/jѓж[jџu/jYцД:Wћг†XлЉЭЕ‰Ў№№hЂъk;ЌюJ–БУ‚I"Q“csƒє%вjuUю’х€ЩфoW›х.[€Д+їHLи§а, ]ЪZfЮзіy‡ˆj”ВPC"„шO-$‹9fУЫŽрж„€i“YЩ_лІЅдiY€U8єc‡Ќp%iЯЬWoVт4W›Eр1а_vFƒ@4Иˆ–>ГуM'ЖOЁв‡5#1 жцШAД3&Kі ЂЧЬ„†2ЬШ<ёуmЙыDFИгцј˜Х7*5вAкX}ЄЛзžІŸ­cІЫЊIЫ<сE—ЉДєЇБНš†€›N[ћ6B•нHƒ11|mѕуБОђЁЂgдpљ@pжfНь$Fѕ—‚љaЪЕjЈ™жтвXˆ3q є7J4М’ў*[BRнF:И’DjZІC’yєХШ"­lУxфИYmЪ9Du-в}2.л2,Гњи/>M?пЇNсŽ\ашxїщFт6PT#ЄМirІVплш’Н.хrПЏ˜еВЛV’ƒyаб>d9ЇVъ§.Жz@й2й}‡P.7gђё…Ђм%6ƒRхЬёХVSl?Жз С}Žž•пw]=‡9Ѓk1gK‰*t–BЄу‰іЄПЊЂСвdЯ.MПЛЖюЯЛи*d}%Жghd8H!z™џsюе1оBOS€$Њ§@ђџ,аH+Тj;аPя@ƒЊa5­х0ђf—ы<џ~ŸіQШ:›јЕ.р‰6vФ4мЄџy”Ї˜wIџk|Са endstream endobj 44 0 obj << /Type /Page /Contents 45 0 R /Resources 43 0 R /MediaBox [0 0 612 792] /Parent 42 0 R >> endobj 43 0 obj << /Font << /F17 6 0 R /F23 46 0 R /F20 47 0 R /F8 13 0 R /F11 14 0 R /F14 22 0 R /F35 11 0 R /F19 41 0 R /F10 20 0 R /F1 23 0 R /F7 19 0 R /F37 48 0 R /F9 49 0 R >> /ProcSet [ /PDF /Text ] >> endobj 52 0 obj << /Length 2831 /Filter /FlateDecode >> stream xкэ[ko[Й§ю_!ь‡т‰О†dЗštюжХЖ›Ђ6[@ЖeWЛВ”ЕЅ<ізїМO‰К’*йq€ ˆ(ъRУс™сЬRўэD 8ў‰PœI'Цf…\мœќє3\тсwЮМ7ƒїqш ў+ц ІƒOў~ђ[#Bzf‚b’SŸˆ$€Џ‹PŠYуvЁ1TˆŒm-гжЂ‡vgЬAhT€’d’tПЯДб›ЕиWФŸ^Ÿ<ћVиeоr1x}5Т3ВЂˆqЏЏ/?тt(”ХГгЁMЏF_Н(осU†їNёbŽqšMЃ|БLНЗЉ™ЄЧЉwОEYS\теFQЦS РgудŒRs—šцt.ѕt”hUqzГд\ЕžщЈ šQkˆŠRЌ+ЮбУ|aЄ‰ЂCЂ•В;§љѕw'~Г––ЬњƒŒЕЇ„[ibFњd+™Зоп„—Џтѓd†‹ŽС–щУ–Ѕа4–2žЏ OnЕŽр\Ц.Ќ4IЭujіЮV^u†\ЄfдщЂ•р`чЩ<“džEъE+Й^+!L(I™i_=vR† Œ‹vRlAХKЋ‹[МR@Р Qœ]4šij"Ќ>"€олж3_|LНІfжj|Д4zЗЉЙIŽ:ЂK™ПЇgудУn”’o8ё`WЅFQ+]иќRЪт)lddCi{Qм^Žл(†Ч![Џ‘7%Y„ Гˆ`ХgпJеNjЧ”і8BvеchЉ˜3т Cя+ЂЧав0›tжX?aуЌš€оІp7Uбl™šiњp6Б-О ›OСФ‹=0Э>†}EєР ,“Š ќт=зљoj&Љ ЫEX`\хs*Є„фМ%нxЦЎ|тiDw~ŽД^x,АЩУ„aŠvr0Ў™Wђ dїбƒ,ЗЬZ‘Д6ƒЮЌE‹ЈНЌ*n}9<Šœ ˜œ(ў€я8YуюыwЎ ўцШTЈ}}*Hр5cbЖзoˆ€Ј†ОсœчфIЦumиРJO‡њїl ђ`э!цл[Фfѓ‘G\у&-УЛЈLз‘uEшm|]8ПЩуН jŒЋЩМѕ‚т у\ЪО"z@qŽ9-г\Eъ:Ј lpbNщНБ†‘rВЏˆ@ЌgЪ–yФ@l‹жђХПOu k:dyэZёюo dL.:%“qш-Ss›>œЅ^ррH.х–ЧNўлžJ€bR t‰oжбwРЂЖ4"Eˆ?АчќTЊР п§j‚Мі!M_юg ЎvЖъЃxd,уі Вio9›CХQ;Б*›А0хmй|œrћ]ъ­gzЇ‹џœ"~L˜h ˆќ25гд,Rѓf*Њšg Rе–„iCј1ќЫўEј‚T:26дkэxn‘›ЁJЁ&Г†wбзЮht'ŸЃЁкФ”5vп%Ы ?Јьк[DŸБA4tYw‰,WѕFИюY˜Ўа*{‹шYс{Ў,T„ ЬЭћЃ{1яё1еŠ ЙФ(”fм‹(ˆE!›И„Тя^ec†в6 "@ыФr™м:љЎсТ^0вЕŠxДюѕhх˜9,уь)ЁЧьZ0*АP‘ЏЇТцЇf‘šejЪgH$^SO=CЩ?R@вІl)Њ`ібƒˆуЄВ‚:ч4 -DЛьpI(†Ф!чЅA„•ўѓв]Dl=/=@ЦF{Ђmф`6т:–„вP9H[zэ_'w‹Щь:œ ЉB>эƒ_ž-Ї‹ЩлщфbĘЬgщйќ*ЕЫйl~{3šN~_ІOB†tХ|њq6П™ŒІС ƒ!aСˆ6CЈЬю7ѓ8ВdЈЌЅ›gІ9Жј!h+ъЭubвК Х\SУ~XAЬxн’!къoSoВпЦU?ЯЬ@’—lLfЕЎtѕпќ§њ„’ƒщз‹’(с\’ЭЉL\Д—ЭЫicЖжY$‚_дK}‘,n,LPIФ‘”—§ЪяcБ_ГFѕѓ'щшLДШˆ”LpЙтv`~Pcд^ ™КГ4ŸŒЁ’^о МђЊт,u31ŽjžђDЌ+в[buCЫ„мъџR0gфсўO[ќ_u§ПFjТ\rХ=rЃp&aў€[3(!мБ.G2eЬŠџ­IfŒдE-xќюPк›ЂСŠT+Њ№_‡ЄŠ“ЏЩœ2Ф<ЄЕy7tcЧУHе(%rгyDљ!(‚ЁЮ|] %ˆФаХv ГY„ГйnvC ЋЛЫ=Т8 ‡йЈ›: =KxWлI4gšэy\<$]A(яFД‹™czбё7џ%AL"žBq5…%ТYp7Щ_К3aŽvQІ§8Йq{У…Žє …ФЫœЂЈ|ЙЎСОкАY”(оЂZ]BˆЙ˜ŒgЁ4-.цщсy踘бљtм~ЌŠ‹yИ5ГBЛЧ]Š  5gТ–SB3ˆ~™ §‚iэ г•ёx.цhубЇъ‚АU€vЧ‘‰žРЫ“СГLВцЬ’|h ПH—ГяrЛХК'uжD4Ш4™Иыќ0sР#GЗw9н…3GкыЫ0юм:йLв?dШL“DЫBч—rпDgЮ2R\ћ,х—мr8bаА5Э“ŒВ0ЛЩбХcF–ї!ћjнѓшe кЌц зЩ-VиЎп=>ОgИX“ЁVЛцД•$доЁРCсуeWs7™]”!й3Ї\Зšэ„фЎџЎЧфхК1ТЯТм—˜ќIbrфЄsЊ12lЯЉі˜цПGњЬЇ?AрулЂє27хъБИš ЁЎeы'їИ ћŽ—Cщ(dѕu_‚очєBВkЅЅіХЭјюnt=Юa.z ‘qѕЭяЖx­‡V`dЈу$9Р ‰iyž0ž~™YіЮrN(СmКNј}жqДh КЗ—ƒФ›Š-tPŸНEav™Р!Ип”uоh:§˜иƒфЮ“Џ.t–wѕ]Aи46—h€8EІЕ–hVј“o+;™н-ЦЃЫі]ƒюй˜ЦЦеf6І[л˜ЬГоЫWXаЛЬЊ˜“>ЭGГgkШ=Ўњ&p :лмc!ЅvШz~‡Ќ'e’@LГG7РBК^аёЛ–шj(kИlЛнБ§` гsЬp:цщ‰Э$­,ы№Aaй+Л­(.Щця”цРŠgŽ7л TЁІљхца ?]*эЗkŽ- Ўq@0оŽ5Ђн;*яВеяГРP;8=\бQЇ?ќ‡Л"ЅVТџ–€ѕ}Nsч;дсЩчН7œ‘‡пщpE€єX§Y3хљЫШ~‘БўВЃ}L;чс§ЧХИюЩРЃ:O6ЇЛъ<§*‹Ёё[]ZоУяИ ћў`˜iВў•зЈёШсљd‘ЄН;%@7]ŽS7ЈК„№c8єŸ„?LТSМ›tЊxšУ‚3щ}пд`цІѕƒфА \Гžб,АХ№3уыLM†… й ƒ;еd|Нр^;љљ:Aѓ*ƒ ™Љ#фг№{湇aЉ*^ŽУMбlRўЬ`Ў!J)S†DЄБrŸ{кyа—rљ1нлИ]яmмч{oг{Л B‚IkП\Лє\ЛаЎз.юѓМvyž#Цв0ХAЌкЊ‚ђеoYџџ<Ѕ endstream endobj 51 0 obj << /Type /Page /Contents 52 0 R /Resources 50 0 R /MediaBox [0 0 612 792] /Parent 42 0 R >> endobj 50 0 obj << /Font << /F17 6 0 R /F23 46 0 R /F20 47 0 R /F8 13 0 R /F11 14 0 R /F7 19 0 R /F9 49 0 R /F6 30 0 R /F13 21 0 R /F1 23 0 R /F14 22 0 R /F35 11 0 R /F10 20 0 R >> /ProcSet [ /PDF /Text ] >> endobj 55 0 obj << /Length 2525 /Filter /FlateDecode >> stream xкэ\Ksу6ОћW№HULяGВЙLfS[ЉMUvЧUIеdДФБXЋ‡#ЩіL~}IёЩ”,Ъ’W'‰$д_нКѕюцълŸt`‘T7ŸТ5R„R(D™nFСЧ№Зq2|КљљлŸЉДЅaЁьНЯ[№Њ4‚ЈЁE‹?0х1#Adбш7зBз(УŠзЖAqŠ˜’AD)т0ˆьбџPўш$Ј@"Ѓ˜ЮFJч*ˆрУфя„ѓ‘TњсˆKзBђbР{ЬЁгCѓЌс/ўA В~uс“ФVМhѓЅ-D ixEй CmОDDЊ№Б-Ъ IxOУiІЂа!iKRˆ1VSсmY90DȘa€oрСДFе†Об­zв@єa­зm0ёBШhвш‡р b]GТ6лX—в` ыVпxњЪО}НЉт$ѓО  .š™?%l< ДLЇъА™ЮPШШЧviYВаЏ>L+eЎЦІиŒTС\F0Cє>†“› 5›gINж,є LŠюcRpЙnЄсЕEЅ'ь$^ВсіъTЫ9щd–ьfйc7цРrПнY0нnСњЬvѓи-”#*ЋBА.$c8SpD2”К6OуthCŸё b‚‡гx@Uје]мZ {!Тљэ€„Ћ8%#їє1н“e:Л›$юцdž§fўП‡{w#YЋЙЛК_$УљєўaUYХЗ№SТЕFх{мј!ЮЪѓЯNк2§+ѕ ‡†‰J`ИMžДФ‘ф€W"PФ5\>”Jb0шqМђС—–д–A4qi§}o”,Єm ёѕKЊ|ƒФє2ЛTƒQЕЕGz^4]™пїо9€/QЅб3мІКЃъ Q€>ИЊАЬZш0qи%wžх‹DRЫnˆ‘ез}ŽНЭ}9іJO{Члє8Ž{СOH§М ‡8Jђа*€Ÿс2ФEaЃ1ю|ВbЃ*a:h9бlΘЦр}ыP  ј˜e2ГtНŠWщ|цL\„gџ<ЂZ л€fй‡Qва1ХpјpŸ&Kx%в˜lСшIГR№$‰—+'y™оЭв?0сУищСЉР:№tЕtё,WXКtбDMHhVWђчC<vRZоЦ‰A‰ƒё†<ЏЅ$Ыт‰ѓ†jюƒЕЂYŽИлќF”д,ёЩюЛeѓі˜&O™HЦ>Ќ)€’f7въVx­:ƒш@7Д!риЕ,рF Р#DдсЖМЅ +”34rІУЯа™oЬ VВЊћ˜oг•“›ЮFЩ':u#Ю;Šѓ~Ø4ЛcK{ЫNр4IЕA@&UZхjZ€йЃAЄ„ oЦЩ"зLЎЁ;ЩУфЫ§$ІЋТ2Ф…ЄЎЊЉ•ё0YЅЖхs<ЇЂkŠ:šёхЌ§ъ‡0ЃЏfe Єыy*]ЅЙ>3№eЊŽ]Е^TeЯгœOgѓ•{^`х8Z-a.Н).Д)оQуШЃХx™з а ;жE&юЂЦ1Юнs?› 30Œ0eЧіье%YmV, š:­”# l’4ф‡џіѕh$*m8rJНAiЖš$Лќ_Ое€Хq#я}˘з-’е˜EQГ ћјЖlшХЊ…оикƒ/џ.ƒБлiр!˜йqRФў†аДРG˜Џ7˜ЅwHоtƒ_сhцъŸ7W^Y„р€ІFƒŸсB"РУpzѕёF№ьч–-FOYЫisiOAq0 >\§чъ=&­г|!Ъј…Лй @ ƒ7лЈї`УcPaс#fхœ(яŠ+fЊГчй…„pƒ­­ТЛу@˜(нcъ$ Ю:ю‹?П|fох3xИяѓиCPРEvXЭЈюЄбС{ˆWѕ{}„žЌ=žm›q6bБзYУAЌЏЎ`Щj‡>›таЂ;к”мѓ€Ў_DЪЊž9Ej'фvх‹ЈaB…oљАёМ-ГЮя|^м.Ђsт8яљƒлxЅАЦѓoМ‚я`bџ ”S лЪхЅ™џD‹ЏщaЇ-к†ёl—„яХИО%Ёх]в\$еРС/gч‡Іk†‰9ГЩ“ЧšшЛBСљэќs’. WoжвІёЇЬЭ)‘2CuDmНeОBpQ;ѕ7=žМЉ endstream endobj 54 0 obj << /Type /Page /Contents 55 0 R /Resources 53 0 R /MediaBox [0 0 612 792] /Parent 42 0 R >> endobj 53 0 obj << /Font << /F8 13 0 R /F11 14 0 R /F14 22 0 R /F7 19 0 R /F1 23 0 R /F10 20 0 R /F13 21 0 R >> /ProcSet [ /PDF /Text ] >> endobj 58 0 obj << /Length 3387 /Filter /FlateDecode >> stream xкЭ[ыoлFџžПBїMBЂэОЭЕРХНєЎhŠ^ъЂк лLLTWЂьИ§Эь,ERZб’хі‚Ђк—ГГѓќЭвљ§™pјO „тLz1АV0'Трrіь—w|pПp‚мХЅ3ј_БрЭ`:јсйž§о9Џ€„a’›>D€я’PŠ9ы"ЁaЉ"к9І]8…эaЕ'IЃЈ‘LнO"0mѕ~.Ž%ёъќйgЏ…8ƒѓї!3N)УxPƒѓЋС/C1 %Ь№l4ЖzИ„_3М 8х,NСoœОŠ§ћј[Х™^ї~ј+7{*.сq K.ёŠoсЙTУ 5SjждРЉ RЃwчп|іZЊ6пЪ2cQE‘уїИфй?Яsrж’Йp’˜Єа#em˜•x–p@k< Ь;J šŠš55щй„Іѕ№ЭH:x"-ˆJЂф% z?cя{ ќЙУсW№Њ6У_`— ’Д2bјVJ?|й#J№B%ЭIВ<–D0СЌ‹ТT9б ькB>єK*ц­8щXЧ’ш9–ДЬЯzZЇЂкш‡№ћ*ўоЧп*ў‚^­ыЬgззјЊŒО*ZОЪaIЮ§г^зТ§•ѓЄ€Ю‘ S\дkЎРх „ЉЏ”ОƒUУі7бд…бqЗ8’\сяT<ДiЩЌѕVю]`Щ‘l_ 6FРšЈѓ#9–D‘Ч :зd`п6Џ6BЅЂЁ€мП hњ†џE…ы(Ї`zНŸk” АЪчЃ1ФfиZТдлдœљЦХzLг"sЇ(цhћc‚ЗЗФЕї6‹$ВИњ Тpб`EˆК„=\ {Фx3 Šg>д:7œ< јш€;ацНУ†!јж€}0$Lš#Q? Ьщн†І ‰'1о2†'щтX=К№žy-I˜$ƒŽDvMм@ŽV› јхOџeЮЮ+БС`Щƒ|эAћeфЛ)’ŒŽ%б##˜r)у†=2ј…‘žвЛC­Wjз+ ыw'еG“ШIЕr@*€>ы€gBr^}Rу˜х'ЁюЃIєŒ3­ьт(мэ)@я&u5єj*X Ўы^ХkЯŸ$ŸcIєШЧР{>!i!s8 тˆ1‡(^yfOsэ#)єK fR№*т@*„@Y ы—4Bl ћoЌ‡LLи2fgLе^QsOMš,Ј9ЇfBЭН7н,‘Nзл№НHT&HК/”т$$z4‰!+ЩИIHTшПˆA4вЁˆI&7 D ˆ–ББд *ƒЪКAeіTЎ"ќ!Zюœ9ЉЈ<šD–Єd&$Д,@Ъ^оŒ ˆ­GаІи{…Н{ь§ŒНяБЗРоў|E!1BЃЈ,DHяЄ7<Ф@Ш}th*š,itгzЂ7СшGjц­&DлсЅЁ™Q3Ёg‰tЂљM4КТŠpclвEVCˆeІOЄд8СAСЦnFЊё №ѓІ‰љxniыЈ.ѕё]`{$?–Dі…b`пIћіЄФЮЁ*‘'G“ш9WЬк:ФЛS—–yхNЙпжСW'нoBтСћэјЈutД4ЂŽ<Ј "Й%—BЁНaоy’џЗхЊ*ч№оG ечnЁ >[ЬnжЭєй[„йg8аKЁ_єˆF[O@Ѓ€фLI7CЭьъ0їЯ7шЇУbYѓЫcЛЎЎјтнŠ†еѕЄЂоeУ7\р сЂхž”‰ъrR]ЫДс”6Єбd~ѕ‚8š­Ё,дщѓЊHЯЏHsŒД!^–!6Ы)ЧЃN9цЉ{5ЉвкUљGёЛb'П!ХŠžЄ t[aЪ0n}ыJ/Um­BLтNеk2Нb–ЩЂe:ё›ЖRrјжŠzз“QМЧEkЁ™ізгЊМ™І™|KЋс9Шр*­›DЋЂAёБИ\WiНkъ”ѓUЕ\_V%jjћP‰Ч–Ѕ6fc†ўЭvŸVnЫЋтŠVFaугЮ&ёб58цtѓ”мкЁ[Ѓт]ЎJžkFaR\"Yђ.‹џZlЌQN’жœ[‡&ŽЉ3о8„йŽdТйСЄœЏhf1ŸозНєё…Н†/†gbјzШxбmЖX/rМ’щЉxН)†И€CаHž­W(]Kf–Х tN“я—‹ЭІЧTPм–‹ѕŠF-‘c„ќ6>ћ|H/.:Ь%оФU5™NWu*‰кСк~8Y‰Uђ1\ИxOэ†=xсГИ™|˜ I™Х4ђ=i№Гз€I,Ф<8d(щ˜ї)jцАўљv1RШw5Ђ>лZxHt>нd|]’ZElŒ 1_бЙЧv^>љPЌВ1ЊdОЉ’оЄ%|`D)K€,{3’’лeƒжš/r›сыM|žeіђЬi—лЋC?ўЪіfŸcЅщЈБѕ(G !ЎDnзZЅс0›Ћїч2–‰&Я|—Јж@?&“L]‡”'ѕБ+Q€ЎJЗyѓвЎ4z#’ЊXƒP›Зї›dw`gнць?eA‚ @™"Zц}Œь1о.ІЋ|0`Л~ŠР&sNQ^WъSvУZ„c/ю…ўˆQ›†—Ќ€xц ќ/&—,ЏщйМјXQ/љ j:‹ Œ›5Ё‹”|АП,f1Lо~L{.W‰Z<ИKqf1ЅsтЗa+E<'dќ›.ФЙyqGдX„ОиуЬBmью,c JСdџњ@ћyIђ@нQuКйнXСA­юьМо%Œšулtc!О{RU…90hѕŸSmŸГ+QЮŒЗm†^RpЙЭ9­oтёžє5›ЄŠAz^'4…ы(ыaяЗ9eнy†!@”ЪЛЎсЅш6ЫрЫ6ЏFuˆУjдRc‡ &WyИ’LWIJиTJA'ЅЖГ†J)˜ХіЫоЧыЫжš|д<-‚дn'ЇДэАЮвк%bGџ> endobj 56 0 obj << /Font << /F17 6 0 R /F23 46 0 R /F20 47 0 R /F8 13 0 R /F14 22 0 R /F11 14 0 R /F35 11 0 R /F10 20 0 R /F7 19 0 R /F13 21 0 R /F1 23 0 R >> /ProcSet [ /PDF /Text ] >> endobj 61 0 obj << /Length 2875 /Filter /FlateDecode >> stream xкн[YsлF~зЏрЫVQs2ї œxdЏ“кьЎН^Ѕь*л Y(ѓPаВvџќvO@€JєЅ(yPqŽFЯLOїз “гЃяŸњQЦ2+эшє|$”bЮњ‘5ŽIeFЇГбыёеEQЧoOџў§S!њФœI—&’3ы"эгHз#s ˆ<уŽ(оpЮЬ43жŽ&КЧ‘ˆ,ЫœђФJH1šІ3MTя‰Ъ8e\Žz4oИI­Ј˜wzФ‰цу.УlжЭqŽ'ТКё"БqЁ˜p6ЕsзЃвLsеrћ.СЦ2!lK№Џн-;fŒћ†Gпa1ИV‘кRКЋv98•Œ›Ќe&Sл6,3 Ус>%Йo:bЖx 6LL4м­"Ђ—Л СЁЅsЃIъЛФZЁеЎ•RDЯœіx=МЧЭт}’Т()ƒДэ40ЁЮ =с†ИXOЄЯ;“‚yлЩёy ћщ2Еdx@’ O?ЅЖх•њ ьќЄ›пЖ qрХ™?€DШ,ѓйF„{Ԙ1Ёd­Љƒ яzћšZ­{4–qя74{і›mдkZЧmЬјлz“МШ›•єf[е-ИLwIDє †QпŒˆлB;BКM w6тLн*Ё;рофaˆЅї:„ŒqЋЇџBMњ<Зq/ЏƒdјdзЯYцdі ~ЎЏŠВ!.EїaОћиa7QNiр„—№l Ь!VŸ(ЅЦ—ѓj~Н\-Ъ|^гшъѕxVМЋŠH9/ъšF›‹|™Šє h‘ьєњIъhFv%XL„Ю˜х>?3цkјžЎ—ыІ˜бT‘зхќšf>”9 ЦŸК\О›ЧЇцЄЗЋїыK(—к&?kIƒЦСL\Д"„ŠŠYaіbЊ&Г€ 3ёDХOдTeuЗ\ЮŠс вgtмн+№МыЂв˜АЮєt$qКqC%$œ7х dЄЅE‰ьnЬiъNЧю,ў„#о—<кЄvюієчц/іРЃ›ЛБgі‘Вg-нЦžQЙЪХхМXDы@s@ŠМІЩYQOЋ2вЧЙrIЊ+ІЮД8PжФзС~‚H˜пж•П<žЎЦн=5ФIžw тUо ўс2о’ф`dЕœьxbaх_— …fНЬ›мЁWушФ@8ao@\Ц‡›‹‚.ѓц"ђ9ЇпxфЂКІ^•_–ГyьЬЪh]}1‰ѕкрРішц…€г7ыjIm4dќЅU:хџ†–ЄUћSџ\ЯOЎŸЃœWСаžФљhа,—Sm48\•p‚D j3цl‡—)нЫКPЕјCЯe4ˆ>IˆбIJF№рИO‘ Z-”РL/ЋgšЯБkb,[TulРмd]РЕh бGCtx)ј[|l*A”6vіЪŠŽ]T+\ЄXжыЊЛШ›Ж‡@~“ДФn Uo„Њ5 лB…q†Ц?=5ЭЇШфЂ{єWNЌўхХ"ZСcЁd`ВY)и]ԘkЪЇS цЛžƒ*/Їзфъ‹МК в˜щiЮг%@KM45?џ•HЇзгyK‡Л vwрфТP84<"ЬЗ)9u#ЋјИLэtРŒTF@0ЂѕамOQlFЁ™@Нљ:vб ]пЩѕ+BЈ^УUЂ№'$ФЪ}F\uЧХЁO20Щt €ТщBьl<$іЪІЈђ`_^ѓHПЎa3сЌ№З/,Рд‹Š|iчjuX.њ‰iОЎƒcЉ ‚y7|ДЙДэРB ЏѕŸ№ЮіV;хN~яj”щЊ_цХчTч‡Њœez№юуKЪ&GљЏ.PoЗ~киf'/QžY>Ь^јЎЊ@іb3шk>­ВGь‡5_7KеGd'єф™QMn3Рj=Ќа‡2Ќh7…1ёЄM0‹PЂ- ІC@тЂщ‰шBZœя ;Н”zћА Ž< ЄыyˆХ`0Иmвdн-‰уY;NЯ‚šŸЯU€Ф8ољБШ7Y&иђ•/ѕ,бX/с Yd+бг2eЖ’Рз'ѓеЛD?цяpЃо?ІЮЖіЬњЙџ`rvkЖJ"в)“G% š9у`NЦЬлt …ГЉ›CЇ_VPС;ј^ЁFzQБЫ9П€ф†cˆ.$шˆЄѕЮцЄА ї ПXіКOЕ0l„иmЬdуŸb.MБеtяx—ч  рЋ]оЗŠ/КМa i1~Ф Г)пQЂкЈнƒ3Ш ЕЛѓ(;м[Oщ|_щ+/.7ХнX<ЬxЉ} Xї@Jhm…Џ-†жыEџ­`тaТokШ,Нк’Ь ІG(ГпяѕЁіzŠ№uS᧓6amј–ЧfкDKxЯПџ ощвіœюGЪhN’Ÿ_зiСУф_/щUš‚SŠьЎ-‰2ВD9п1a<жыЕ‰щф/‰@ЈМК§­Алz+<”~оП?Š_yНJьhюд„СДі‡Неz”ОƒиWѕъ ѕќ§>ци.$dŸQHp7}яблoџ№*јзПw5X$s"ёЭ пЧфЖ0{‚л>L'м“ЄѓЦ ОJ$чЉз ?‡Ќ“ ыoўъ[т+ЋlK‚[ŸЊfК—Ж%>’TА’y\П^№28ЅG' NFv(’Хнm63pцgУЧ4їеlx6м~€3Эx oИДщЪ ЬsџХ!н'§бпN~;BХр#jФ™і0K0 л™.Ž^ПхЃLBVЧ й]вХHC:№a>њЯбПN№ŸЖT2ђ‚:nnС ›їw‚і6Œ`„Н#єЁЖ1b№i­wюКS—ќТ џйЃЏgWaї~UАїс—рзУ~9ЮМ@јЪ˜j)![ћ?ЪѕЦ endstream endobj 60 0 obj << /Type /Page /Contents 61 0 R /Resources 59 0 R /MediaBox [0 0 612 792] /Parent 42 0 R >> endobj 59 0 obj << /Font << /F8 13 0 R /F11 14 0 R /F1 23 0 R /F10 20 0 R /F7 19 0 R /F14 22 0 R /F13 21 0 R /F35 11 0 R >> /ProcSet [ /PDF /Text ] >> endobj 64 0 obj << /Length 2969 /Filter /FlateDecode >> stream xкнZYsмЦ~чЏиф Ќh!Ь `G!хPЩQ"Кф*Iр.HЂ„V8Hгљѓщc ь%ЪІЄи/œСLЯбззнГ<9;zќ4]da–ШdqvБ: ‹$6ЁTётlНxœ6uWМŠњXІA_нЇ*xtќіьŸ …iš-–R„™0L§|ЈNnм/ИС7п!эуЇbrN"УXЋEFIЦЫоDQdщІ„:ŒГXNЏ™jzы8iВˆмFБo#І&v4?љіH2=йC^За{w‡;™P)=ЛђЯ}@tБ/§™RІєTa*Œі9кгB–ŠНsDK3Ѓвєt(„bЂя/= YNˆ6 YЩкs"XTšHwф Ÿ”Mњр*_J“ВЖЫL€ mЧp’™+ђPТ„‘JмV:ђШШ€Џф?N-џЯ,•šQ‰tЂ2чfB’„RŽ–сБгЅ@wQKP›5С=ZFa“ѓjm|wxšu4^ш‰OЮB…Ь Ouœ]{Žгa*AžpZЯNKч–ЩХ„цКеПРї-?Н‡хЫНsЬ‡ rп)ѓŠ(Ђ‡зЛš’yИЧь"ГMюPЗOpw2sтAї0г…ѓ“V*№ˆАтŠTaЄ…ЛЗєI:.№vиня€Фў$ю@ц3аќЂ*sš?y/!vЩзƒ`…њ0V˜ьKхЇS/wё$Ј˜т›ЙЛŒ˜ž ИF˜“оrє‡MJ~мЄЬCNњi“~8•zцV`lKмBчcN 6ОU€љh“PЕ0"хR‰р[8'1^:4БaгїР1§YpЬW™ ™+х,нЗž[ЇaІфдU„t‡‚UбRAЭлtсцЊh —RAE "‹“ Џ†Ђуяц‚K š•ЖTMНjяЇYѓ[вЌ_Л^:ѓjwПшUSfя]ѓоЂF_Ћ:ўš5‚љ!Zн#DыџЏ§вy#Ѓ˜кЁ˜Ь` Оab+Ќ orD›луЅVIpN|јЭyŸ—uБцЉЁ+ыKЏkвДйГžНаяЬkлЋfГzЗqŸŸєU‚`/M,‚П•зxЋЂц›єWyЯФытв“Ў'  ~дћD`ќUH  &ШePЫŠ)o‰щдyРєP…;/{d#œŽТLkN{b[љ еpХё Uй˜з]5CЕцўЊсчYАІ“О#р~БЉ0ёЬ5гНТœ’Р•}ћmЫlƒSEVЊ—йMџЬBєэђЭяˆ§ЛЛ>яЫІцqЫд^4эч†*яx„ќ•№ОSіЕїЭY @АЏз“•ьi|ЖнёrbЧ8\[єЁЌЋВыбУHІš%y—ЯН+яaмž S9ке.яSо›.MЎ6іHЭ>цsoEЩКнъ•ч,=мВГ›ѓЎVТ}ЙuІƒтЧ6uъ4Сc…aгЋгvхђЃ“[шiЪ” мФT-ЃЙ$ГР3X Ж)—М•§•Њ%Dѕ!NШ’=Ё& *РUPІ}иkъъ–{јAѕ п( N_ќРЃЋлUUtЯ vћТ-b*Š$&X/­px?DМЙWЖ@,<{y^ім‡э;юЁ-6CЫ>' qKм5›т†аП.ђЎ/ьJА‡кѕŸ ю7ЕэЌ‹nе–6^j@0Гk2ˆр5Ќ~F)nП%AˆиЄƒєLв5ћ OфRjСЂЬй№(Љ†зyŸѓXОZqрА+СИ1Mпp Вю'œ…шб…%ШЋ mмtўлw};ЌXbМЯ5R•НYоТxэцdFY~хюђ›rНЎlПСK^и›9‚ЁnиcЭы6Й“XХщDГЕkэ:pŠ],}—k ђЌ‹Ёя=–'*8Х+Мсџ`]г~œAг™ЋЂыюђ\gБ– Д8IА?ћ эя\ајXЯ-ъ Bа!CЬаЋСšgfи<ЁHЌ*;ДстЈh/ŠUЯ‹ўЫSФ"vЌ9^–uMИ†c(=lWЄиф>zьсkщAe }QЏ‘_tŽІхNЮ b3‰†мhhWЖOъBa#ЕЩХa[R ѕР,”v:T(А,ЎCс сM'ГФ%jŒEїФ O/xdw1NПXœBИаё\g.Њ3џ:VЬ?vrnџи4€р5Yu/–3 yЁcЁeеu№,В їАœ„q<х@А1xŠЦ?ДРЏНXJKЧЖца'лbщ˜†Œ$™3§~([2oАіc=B%ХJkSиюљH†~]X;…ž;i­9 K‘oь1фEм’ИлЊШww_лsђКю<žп5Œv0~sUt›™ЊП/xb‡уt-z‰и:*Эls„[œƒEŸ3\Ig_6ђ№Ш(ДzсГ7B8@ЧœЄa§бЛI]„Ќ~/˜^ЂРjiшgZ iG[ /№0@Hд'4&jpьцFЏё6пnЧЩѓЪЎРЙw’. uˆvhƒШ@*w…—}›——Wр7ШzŽ •WА-­ lЫŠHЪ‰xЄ"Є2TсУfйe1*щЯ'фнЖ*СС@Ч—<РвЊВл€ћќвчj*‚ОЋачо„бФт3ўЌНЗ†c(хм žІxY˜$ёьЇ“ШWAњљ~9™џрЋQ﹋5‰ћzю) ЕЬt:cу{я3KgŸўKШХR“ЕJ5Оь9 E2Jц{oі,Г‘рм&9dњя:п8ИоГй™Tmу‹ўЌFЁjZ:?•›М/АРaђSь@eъzхЯдCд;vШHeŒв§ Œ№Э •Щрє?xР)p ’гОцbх11ƒV?дHjАОLVР іƒ;@Ю=Уt›0Йђay]Ў‡МВЩуžОg)ф˜ЃBаЄв Ц‚žlAO[n№д-=Qw^ж‰­>Љю6TwѓeИеиён Ћ=МъbэЮ>ЌЃl5ыЩl№Ч нЋЫHJp О‚‹+Јї8пYC]G”„'wŠSРf\Ѓ:eаyžж+Џјr0{єзГЃїG˜AD БРw “Єр\&ЬDВXmŽ^Пk˜„}B•Ѕ‹"нЉЪs“jёђшпG'јŸЁ"ХџЌ0Ц>0щJ#ЁE(žџР` ff&Œєzd˜Кwљ3B_сOs•"`•0И…\Прz‹†!d[ЎKЕР:џ1Ње€L‰ьк&\€™ˆtМ6Џ™рPVwе+pЉ?2Щюё$ јh1§њйIПucриZ-–YЈЫљKїФ™ђы!"О›И ц3~zDRjГт цfн0‚ЯИ5+мНжі<ЊАг ч=_№jл—›ђчЩб–уCонšЬf"n[ќ‡–yц>>Цв\Яэ ЎpƒЭPлЕєОэ9п?V0O‚(к%!>њр+Ю5ŽКВb†IBY-ўК й›Е.хLњkЅЛZ endstream endobj 63 0 obj << /Type /Page /Contents 64 0 R /Resources 62 0 R /MediaBox [0 0 612 792] /Parent 66 0 R >> endobj 62 0 obj << /Font << /F8 13 0 R /F1 23 0 R /F11 14 0 R /F14 22 0 R /F10 20 0 R /F13 21 0 R /F7 19 0 R /F35 11 0 R /F18 65 0 R /F17 6 0 R >> /ProcSet [ /PDF /Text ] >> endobj 69 0 obj << /Length 2366 /Filter /FlateDecode >> stream xкхZYoфЦ~珘GbѕvWѕ™УЋФ@ь8€2А–ЕЕv„шВv7‹ѕЏЯW]фЬHCі УР/ VwГYУКц/'neёчVŽ­ЁьV!XуlY§x{ђъвЎЎpѓѓ•5ЅФе‡КѕџlJЋ›е?NО:љe‹‚ŠI™‚MРў E`їQ0›ѓQ(<Ж:7‚ФЇd|*KоУgь‹q7†zkЂmХјшЇпb.Š—ч'/>si•LIж­ЮZ9WLHTl|іЋѓЋеЋЮ­OЛа­OЃяq ныгDu‰X–pХQwQЧї;ыWђxшОГСЎOKФрК—ЫукEЙ|ьў]иќZС‚ї оžŠС­/Я?ёёю;s4!Šxълў$[Nўr>ЦcvЦхE,ž‰ЁСaіЦКЂяL 0ћœУ9%™Иф….…ю­Юо+ИбХwр KнŸ№XсLvСvhАL".тУ\ F7!eWFФю…$зЬЉћFД tw м+Ий€Т,œp1uџЛkg…”Yфє9;€ќBЬuцЌ .lыЮ\ЕNpŸEŽ’>—К[Y—йЕ‚oYVѕѕWsЪuc.‚’ЃэLCDŽ ЗHDsQ4Dф‚БНЊzH(ц3s•бUЮjудѓ>p•Y№Bp†jў€™хюЃ–%aW„§яhЏ/а^<`ЇP`wпдУƒјЃnxJ ™ђАCЬ(Ћм~Uо*aаGЅ ^+x-,VtšёnЂЊоvy0ОгЎќnэ(тJ=щє„ѕkЎсзœБ\Žёk–Qг"m™‹ЂЁ-6˜HQп:@еKђъЦ‚К1Џn,ŒИБьЛяз0,hC€’}Й&йU­Ѓ нЫшQ.W2})Ѓ2њVF›-фђgQЇдНЃёCЛъD;B`§ЅD/н‰пя"~Y=IЖОЁќB/ћD‡BRьЙх”}aУDKd8ХД }‰v­2Œ"CавІsп(#ђ*Kƒў~Кзїщ˜mтіѕŽ Ž`šc™M‹Тљl ŽхhbIJC1g„Й”7мјЙAWђ† /Ђk.Š]Ш’‰Yп:‹sЙZ3k„ьЃ.Ћ&0їю$l†#гFhI:zSЈ,тШ\ ŽФT‹Ъ‘2цИ=ќп1‚ЁўрВцЂ# Ё“PeУvHљэDЮo“,UЙжqЪЇOНЎIО#NSœђш]чв~TUхіX H57a№;kyФ‡€ы†=W’z‰ŸЪеgы˜™КOЄс‘фФF™ТС'тгЙвvk,юˆ&7D5€И чBї‹яY7„эГЩмЇtЮM”оеД—{ƒ/2‹рfЮ5ю%фопK„TЃ.ЁiЦRЈёЂw6Š ИN}нсшПLkK$YьeА%мIVсHЌ/Эtе›x7АмчMVy їŠŸІ!й7oMЮўˆвS26-*7fЃhH† ‚^0Ј9ЧбцУѓV‰с?oJ„XЋ guзЖ]С;8hЌ]jпrЏєЈД x]Џя†1IђHіU5ЄвЛдКOSFYhY‰K&кeNb.Š–,ЌŸЃТ@ёч­Ћu,Й"ЦRт6Y.OъЊЌuUкЏЋи&хRz.XYкQчЇv“M№Љe7^m7“LШьчО”†ЅИ)іjд*Н_‡žLl™ŒO|ŒЙйlœ_–ыЯEбБфпyА7lрЭ&ŒЧž+ОЅш\В‰iQе:Eƒ ж™рњќнХё"^ИTžфuћ^лХaCMyГ&Йj)oЪЄg…ЗщЕс\ ЙE…Сlг CIhl žaiBmFЊBdЯЌ УьЊS1Щ/Њ gЃh0 >!фОVpyЪЖ№k›ОGdoЂУЬfXш—Бb&Š+G}!щЪq6AXDbуеƒГQ4‹lb:љvЬТ‘яЙt aAђОEђl Т‚7PБž07ЋіЯš•жЪЊТkыžѓn хД 8ю ™mkДw&/“ћL юxGж3‡Ц W”X!#uFт@‹2Ой(tЁо† {ТИжДОіўjЉрk.Ѕy(ьўЊд;mЋ^?iq_(ИW№Ј[ЎtvЎрЕ‚ОC~ГщЪ x+њCCЖьtЏмšШљ˜ JŽ-*ufЃh0›Бк>їЂџёй ыйJX|ЖRjЭ§џzКТŽ/ЫђдЙ(у"`_‘Џd=)эЯKiа0ъ‹КЌхnš‘g4nл}уŽ‡‘јMšїЏЖѕ Ѓ4јМЁmƒя%ъамї@Ђђ-QЉяtЭ№рI†оьџf€R$ l_kДПbм6пŸ@’ oKжЉЈ†žТAИр2'•*УJ"|єs|H˜PN?@J›Аћ rH_€6‚ЯуO(‡qnЫх<ЪпВ&Пбцoђ­гvЖО`Q=>EУТm49ѕ…ХёўW@1y ™ТмEДEŽ?слфr/—rљ{}hШУFЅџЌй‘џІП’ŸИћЇ§•<цюŸїWвdWХЯyžŒ`KуoЅљh{ЏнлFТKХ›UГГQLk&•T[Њ™IŽ…‡“–9IпТШAhsъF’Ж’|} jY"yƒпэŸЧ§sљЊя˜œ’2œД]д˜™Ђ!ЅŒ5?T&bЋ…|J!g4№72КбНŒ†O)фдг2њVF›-SŸRŒd\ЬnјиAZрЅд8И~Й‘8Ў_Ъў\K?ЋпpaіNСЕ‚‡'ї>*јFяtжƒ{zяVgЏмшbѓWoд–Š4•Њ2xkы!!жхЌДcqяJsЄЩ&И^TЄЮFбP†”O}Šu]`ЬиЙЈ4EƒА(M•О9С‹К.ЂYvј5Cƒ,ЩK}пLbЗЄ­€ТЉ~Xђ‰6†Sх%Ÿhƒтр'к оc+Ђ™мЈ2Ъ[ЉГAŸ)ЏyBь+АП]П}w}їГ8>юќясAPoŸнп>Мп.Ÿ}-­н3™T_ —ѕxЅЗ~йЧgw бU†Ё œ!fBЎлœПѕвўzI8 endstream endobj 68 0 obj << /Type /Page /Contents 69 0 R /Resources 67 0 R /MediaBox [0 0 612 792] /Parent 66 0 R >> endobj 67 0 obj << /Font << /F17 6 0 R /F23 46 0 R /F20 47 0 R /F8 13 0 R >> /ProcSet [ /PDF /Text ] >> endobj 72 0 obj << /Length 2846 /Filter /FlateDecode >> stream xкеkoЗёЛ~Х})К‚#šœсГЎ§Сn4hƒ4vыŽ Шжйr–.’У§ѕЧю=|{д­щ8q–<ю93œч~>r3KnцаШn2Р0{ѕішХЉг‡пЬЌ)%ЮоЫдЗєІф0[Ьž§ѓшч5 (&e$б$€ E`wQ šѓA(IвfŸКяhалюZСO)н+эЭЕwЃНэЭWНXrї-сТ,Ÿeлн*ИVpЁ`Љ`Ў€f–ф‹ЫkZD†ю)ѕЌ—зmз \(X*˜ы”ч[Ÿ+шпћ‘эог’ф RfTє|.ЯєЭй#*Б;Ѓ6ё>Љ§ёјєй7G}6ЦЪш киФЫЉ(*ЬŒЩ8”›№17‘•і„‹О№оЉхНCщ^RЧuИ#ЂЮ•Дзвв,ОћŠшA,fъв;—LАТЄ N:>ЫG!sЯ…"„*AОСbc0ѓлмћekц9# н[Y!Э№‚б—ОыZЌЉp'x“НkтЮTю„dbюЯ2w\шžа1ёМ•Xк’—!BwЯCєќ\кЋе82Ј},э‡цј‘9‹ Šѓ'iљ\†и§`ƒБ~LkКтцњиEBAДНџ5рцvЂЃgІ“lфkQgmm:f03sQ€>#KSN^H ‡:Ъ~d–€§bїŽЩ'ыvcKДЮx У^W$ФгBuёT ёй€‹КjO4ˆХЪЁэпl€(чDiТ€Ј ЄЦ”‹L:&Sї" мE$eМKЋLЁХдЙщ,­Я“žniеkUМ#к8licПЋС%e!-гw-і!w\ЧqЎџ”8е=Ј0yаФФЉ(*LФlR%U`НIчj­„I†џEмIЬЩ ŒŒtкФLQj›МRpІ`СЖHŽ†‹ЈR* ^ОTАP0WРvе+›\*ИQРё:“zg ˆ[м–!Ž2гYцГЂ‡sэ@зB‡іZ{§ )'(ОЊЄ!яsїІЂЈp–лB–іo|be‡С…‚л­о™‚џЇ€Ћо' йY‹Pє‘(L:Лћ^ZQїъЌхhЁр‚ЙЪцkmб(žJ&Q›‹ЯЖэПЋnjRaOЊЖ’žKЄw‘VS“V› QЊ‰gSQдxf †Ќ<Ыl0"ЊhЊЗEЪЂIІ€Dг‘;Юj•(rЪž†c]ШЛўE]Рџ2ЏНИ„šмњ’ О…“QTh`­!О+ г€є”H†нŒBЧSэ бHНTT/U$ЂєІ5ЉyJ~K>дЌ%‘­фВи(:ш/‘7§€_wcЏ‡ёRћkЗмЉ`Шњ ЖѕЯ{Ќ/†aЦЗЂdшKcЦюžиЬ{тoЪїо-]ЛM{и›Г M>УsЩЉТDrBž”>>e/ІєсчЖђЅу§‚ЯЎшє юМH8ЩЛeyG•№ юЋžŠqšh0E…™<юи‡uЮэИ(1ЩСћ5бѓRžпЩГј‡"М$Їk§зњ1чЄБjЬІf<рpR–:ШЙ"d1вWwЇjHцc116…d“QT(›Р t…OVb§zi‹EЩвy| іюbьа“юВОT=kнчwЙSме2hhOџр(˜ PњBa /Ф ^Ч…ю/#К&eГЂфЃq*RЌмЯЉЄwP‰S.Ћ!Эš#РЧЊ”!9žv“у<ИOлјўёюЧuю5knm_Nл›”R_ЗmёлTЎкhР\љЬЇzЬГІаsэЋ>:vєuЦi_мŠAй Ž+Бк:ШdСnpвў^dЋ л”-1ц{Х†kS|SШ;Х~Б!7‡ФНOъ€!‚/§joЦ(рŒ‹УІ~Ъš`я‰<ЎЗ=‰~>рœaІ™MЦs*† Йr2ићр>Зщ mї“%c]S8E…0)™†q8LŽіl,BSцb2ŠЪЦb6XњАpdcXШ*‡l,DcsSФ3Eec! ‰ћљOŒxrбk0+7P nШ}CиqrБc/РxTŠ‰%н‘ОљЕ Т EZcEЏk :]†x pv6„pŸ‡AA‹ХC\ в &BS†`2ŠŠФxž7hПРŽ#ЦпSŒ\ЌqЙ§ vqgŒ|ёCšкЌпT ]WJŸ%јйэ_v:BЎХв‰TBSв`2ŠAX`њX 'ў­ыўq |љ\g\*Ќa€%8‡FOљщ7џсюr5х§БD]$юr—ЩяU1єх|ъL S dЎFJVЪЬП‘њВ?4[pcЉ TЖ…Л\ицQВ’‚XѕW(`h —&ЃЈ0HЧ> YŒL%Щ —X§UиlRlJ1LFQЁ.…бQEiёЩV›Іг>AeS )ИОЌаЖx‚‹ЩифЛOFБcPШ‡JНяŽcц Х щ YƒЩЕml"ŠЪЦИ„|Ј…ы\:Q\ }ю[i_ЪШ…<_JЫзRДљ)ё]YУ­‹(‡еЪ,HД?лLFQЁзМћ>0@ќ­ =>нЭ‹t2BљM =>еЭƒшŒїMŽўd ˆ^VЅрїƒїПЏм)’5}Тf4kšжŸ[-X'ї№іц žърэжЬы­С‹БзџНё‚омRян 5€SнOїР5жMюѕdКs Мынk œІ‡јзz%r[ХП,А‘)ОК”Й–ч i—22я#уѕјЙŒпe,HЇћ+­ dђ‹…œѓHMœ—ћ2АФ18U Ž(Іj}x0СЕйџЉ(*ќс єЁтc“ЁD”Т”–MEQйCмы7Ц5Љ1єЇеЪЈqja(т№џEƒ Й.В•šШЄJ"Ы!IЪF†U§y]MШMNюdЂq1єPЧ‹y,б“%'z€4p‰e)-ПќО>)Љх—‡ Иѓ— ыXёh*5„G™иF^CTТГ"%ЂPHћ0фя7З—oєЮ6ќ‰ПКяЎЕ$щ ywsГšpyuyru,ПЁf~Н8[.WО\№[,одќtУƒЄt/ѕУхйѕйb1_0ЗEVˆ9'\‡ƒ‹эТ џF3Я endstream endobj 71 0 obj << /Type /Page /Contents 72 0 R /Resources 70 0 R /MediaBox [0 0 612 792] /Parent 66 0 R >> endobj 70 0 obj << /Font << /F17 6 0 R /F23 46 0 R /F20 47 0 R /F8 13 0 R >> /ProcSet [ /PDF /Text ] >> endobj 75 0 obj << /Length 2534 /Filter /FlateDecode >> stream xкеZн“лЖї_ЁGjj!Фаž<дn2у&N=эe’™Ж<ŠwЧБD^IъЮNџљюbA ”p:Хwiк'тc,ЛП§€о\Мјъ[ЛШYЎ…^\\-ИВЬpБа™aBf‹‹ѕтяЩХMЕ\ЉL&ыЎX ›м_%~?і4м^сW$УMэGŠллЎ%Ђš+:ПF{‰ЃwuЛы_-WкЪЄќъKžДЫЬV~™ІшзїKa’Жћ8ѕ€fГ!ЂћzИYўѓтЯ‹W,W Оœх™чНпH(ЕNъцv7єдў7~ p\QПlћZxќО]ЎxђWмщэHв”ХP584Cн64~I,—эЖъiе"œh‡aS5 ь%Ь5ю^4kЯйрЮYп:aЉмb&ЉЈгяњВКъЫЩавїЊиєžІєтї%Їн€ˆ7uМї#еЎЏжDrlw№ыMнјe‹M]єusЭЧ1‰ПЛBV9ЩVсe‹C­Ÿz;Ъ•ІIЎ^Є8я.ИшЉу” ъƒfСЙЗ/QК3FiВъћ]ч{eЛлЌщЧЃќT”m=дзРвч–ДЪЕшаиѕОсŽп;дЪЊћLНІшКж™ѕћЁЋoН:3PU)ШpЎ$=_ћnнаї_ЛЊG) šЄ™“: !Я)AqfJЂ‰mЇЎю†р—Э5]RFcї7ѕh‚{итШЅПO9^…W‡qЕКYзwѕzWlЈžхЅ'ЊЎьŽlqT›v 6L#Ї&gJ‚”…`RqbЗьJœћъ[Га,7в:аЬdЮХTюo#%ЊšSfќ#Э<ч™dж(’ЃљtМLЦt>ЭУУ&_гgтЇƒ~ЮГƒc цЉј8"љƒ_*DkЭ`zњ‚ќ<НHcKц™г›‰юW^WСjšlЯšђШAA –4мŽЊч’hlDіZb\фoЧGГ,ТUАЪжW„#С™еr\эУёj†ˆўyЎяшоh‰ƒkуЧK­Df™fЦХQ^Е]„)@4УѕИыט˜„žNц•=vg<ƒk5#сk€ pTЏ№ЃщcЦЯkќ!Ђ ,оф{ЄiŒ!›O ЁŠлЋъЊ˜ШAЯеФдЧ‹(э~CєЋ‘“СŽ2?ЁIW{Msё ђD№ чјwŸ…M87>#НЏзЮ{˜œ|E8BЉїF˜ЇЗЯ зСyЊ2Yˆ–а•(•Мqƒ AŽ|QЇЋР!Эѕшо ЪšYхœ Щъ$ы|аœ0™ьK0љИa<3ШŸЪдLРќїdL+Ђ€с5Bя№ШHё:l&@Tc9‘§сh•Т^@b э/м D•NGќ:`9Gџ&$h:ЪUюБоя6?!дЗІФo0lџќѓЧ”Ы/ў‘…ФхАRђtˆЪЭ9ZиDAШ>C›§7sОиЇ–Ѕ{­>gПXPšкёЯ…Ž™АуП ПUмљр1c—`-–c|BL"МЖоƒ!:_иW ЦвƒO§Ђж.YЖпJ6%eФЁ„3 ЅЄс%AЌAƒЭ#‰˜`Vˆп'UдчЄŠќЬTёKМСЁaи/0ŒcŸмЫCpЬ‡у”q8г*XЬWњ–tЫЉ›ƒN Б*7.XЭ­zŽ ‚WГп#\•џїсъЬЊ%њ-tjVžkиA’ў agFЯcDБlЅхУЦspЉ№3`RПк $ЮУЎ)—G)R:хkжлf5kЊuЖc™lН/Lcзе$БqSmngZWP%эд МwЪ1№рНeiJй›Ъ!j(!MынВ™Oq|[m[Ќ+bћЊѕuфлЮDьju0OюVИ[ƒa‚›ŸЪКИVQm7§>Ђњ‡hЃOЄкЙх“•SМ€Œ4ѓч/MщŠыjЌВЋЄмљPq*вx_џт[T}WЇС\0ЏT+ ~є‰HH@уЃ0ЗaѕЉЌЊuРАcŒ.bŸбq+ђф{NпАj]„)VZ}їQт%у4еcнЛƒШЇЕІЋ‡vQ–UпћŸЕ~>lЛy7„Хu@ЁDSs&ryЊœ%€`œП[fVкЙыТ+  ўШ жѓЌ?j м—Њ=Э>}™-К •|Д$d˜ž—„ /JЏі<ЉмЋ—р€РД4ИЌќ AК о'Œ{‚›bLw‰ŒЖ†<†~&|ЎъВ(Pˆ8}№‡N.Œ‹,yз,%pRu›ЊX‚ЎоaзщœЩ’{ьоЌ.Бёy5іiј@ћ№ЛърФ)Aќшsq;ц6Œ§€?*:а0˜_H‰еЦХ 3;дБ8§т~э?і§n‹‚1r ЪЄwMl PЫыhŽЂQ“вНцЩJOaг|3к›‘‡ЯtИ[дƒ№T2ЃІuО‹jЗЕS:pнЕЛл>цŠФSрzбuHь1р9­ъћWЕ6Aьєј ЇЈ<yeЬ-FрђKы€6ЫžЬ"Ќ"фЬћQпч2't;цУf,хйPVJ‰фЇу„dbж­.kХ@œу_нЫ+(}џ*В @#„…6,Пј&уЯžЬžБэЌ"ќ„:чc!vю’уѓClћФr№0Ц~>3xц*У—dœтб`P] ј'H‘>џН?G}ћСыwx˜ .XёдŒf|A@Ш2/>НџйР}Е3ƒ4;џŸUšГЌљ‘„й~СЋХC Г=iЭвe“2Ÿ|VЂœпo.Вгц ~c#ЮДK†БJ.ИЯУk)Џ›ˆЉЁгNѕ™Џ&тзМšœАЗУаѕYnцIііи}œco1CЫЉЈˆ%Vpаxu*ˆXИз$Ў‘№Х7/ў|[” endstream endobj 74 0 obj << /Type /Page /Contents 75 0 R /Resources 73 0 R /MediaBox [0 0 612 792] /Parent 66 0 R >> endobj 73 0 obj << /Font << /F8 13 0 R /F7 19 0 R /F11 14 0 R /F10 20 0 R /F1 23 0 R /F14 22 0 R /F13 21 0 R /F35 11 0 R /F36 12 0 R >> /ProcSet [ /PDF /Text ] >> endobj 78 0 obj << /Length 1853 /Filter /FlateDecode >> stream xкэ[Mo7НчWЈ7 Ш2ќўˆ‘C4@$‡Т€ Д=(ђкjK†ЄФM}†Ы•–мЅviyЅHIOВ$jIЮЬ{ѓ8Cџ|ўьХ[=0ШH*чWТ5R„ЄPˆ218Пќ9ќuvџi5ЪcУЛ|Й_чЃПЯ{ё–я—R iєЛŸМw#‚GcЄ]ј y CZёѕ˜›Б“pяЄ\жxD幋{ѓq”Q=Ьн›E~ПШ—љl­ђKћ!Ž—‘Љ3r1‚Єфэћ §яƒ*=|U> $2Šщb>…ˆаBЬ§р]9ŒyУ`”fеqЙ*х ‘ˆRЕBЪgј "EF7ьШŠ2ŒАEчЪ ћЇ9GoЖј*f$Т1t`gехЮЎ#гё"n2˜Эˆ`6п  ЊЦєцї ю‡:ТZ{І&‘y`=šжцё­уцсˆжXЏПyVŒРOіЛЌћ“E›Я<ЄЫнžсЖnцУ(#X /"гHCќežu `ие€MјŠ иЖїU3 "fјЩcІ j&fНnѓ—*kCБЦж‡ЈА0;DOЭкДл bM€M9n3ЁЂ6(`иВ†dЅoя"гACЌСзіЮ(žЭ"ˆ&ж№jр n5I‚5O‡uŸŽЉУš$Рzп]юHѕE3B X!Ÿ‚л -CёЇ˜0"тђfъ№^ш“ žф…-МРМРЩU;rхЙRЌ*ЙU™4rэ §trнP‹оЕ4˜…BŽQфж>3s#Л№lВ‹N‹ЂэŠŒŠьФЙѕ;Fuр8‰%Žci"ЧЪƒyƒwe:}holaўoФШјŠ ЗІЪ6нЋl{™Ю€ОСao;ЄqPЇuиc‰‡Н+"Ыр˜gэBјњjы1€ \FоУMОˆUŸŒBЦ&@№J‹.ž]М3КD5uИOЂЂ I’‚’‚§X’bK†44 №љВхНlХ'РT ЕЎ2fЬpОК[Š%У…§Dl!vОИ\>ЬЈ Hd­„ќxќФр[oЬtщV3™Я&уU>ЏІѓ™[Юќ*В JVЃПйUЅ;ƒ-FmЇкИƒиЬ}œЎ6жQж:юнеb~ЋДkАЧ†xЎcAА)˜–РЭ%hФ™ё­t5ПН[я.Ъ/KЦ‰ТцрQІлvФР',r 9Ѓ1YOe5)*q$мCOzЇ#/šgAдЩ6S3Єф&9џ—/цnн`sˆAиŸЎnђYЬЮмўљˆ0(žЛpїn› Ђo&Й4чW.t;-{#-оѓЊкЗЛФЮю*C‰š0$ѓе=w-Ÿ|v9]ЛNЯЇ{їйУ4 S8Ќ87ХХХУ*”ТЛТХХ_Зуeй&Л^Ьaц*`ЩЌ’“но{m!ь˜№ …ЂђЄBвVvљж}}яšjЅiAД„’aІ5”(ТRЗ‡’%Шъ<Б3іЂ•^vСd—nƒЩ§ЕšЧЖšпЈФ<$Zђ-ДycОLѓлЫXыбЪжЊЅј>тяВщШ$" єPДСMƒы`§Jwш[š’ѕнУфвlєmАAlзјd‹імЇ§.oT^ ­МS^zNлѓЙ/ЪОaсы6іЕœ‰$ш§  Гs7г‰Э'7ŽRmЏ]G{эŸЇЙK1 Ѓn~/ž w*IГХо]Žќ~яžЄR@{YB†aћџх.‡t•%ЮJщЪpс€ŒJФАIђjДиЄCЕZдЏ’Ъ{aб]ЪeкСОй”/›’ц ПяsWDйо;Œ1 e)–Бˆ‚ƒ‹НцЉgяtQьэ*т^ЛS,­;•дœтЧиœB9”v9х+K!V1јб^ђ`Ю;$’ъ ВЏл0I—avХDЄ2сQ_зEѕr`щ‚K€Žй:Сц#™Њ“эŽ2™ё№l@UxCьnCKпћщд" rSR‹xд-цcИУ{Фд’R Ё'O--!{?ъšкЯ—БЦ E џŸC„wœ…‹џŽЁ№ZRјыЩdОpjЄ-ІУЋ*~ЫьOЃ=^!ДБ№чјщЌшюT ън(3ёЃ G‚яЇPTŠртхЭяЖЌљІщ€`‰CEЙVZtZLбF­{2&$X#ЌNНаЋ38нKЕvО 6*jOМЪcqЁвfѕУЦЦ*ЇUx$ˆё}ЛЉЂ[Ри*КВesћf2ПЛџДrЭ[9œЮ&‹> endobj 76 0 obj << /Font << /F8 13 0 R /F11 14 0 R /F10 20 0 R /F13 21 0 R /F7 19 0 R /F1 23 0 R /F14 22 0 R >> /ProcSet [ /PDF /Text ] >> endobj 81 0 obj << /Length 2340 /Filter /FlateDecode >> stream xкэ[KлFОћWhobuњнM>ьz`w'X 6{рHœТ9!Љqцпoѕƒ›jНlкr‚œHБ‹неѕјЊКŠњлЭ‹oПзГЅ’ЪйЭнŒ0†”д3)ЂLЬnVГџ&ыМšStYY>ПšџяцŸп~OШ№ЅI-f JPJ”{чЩгс™DЉbкаqЄi:[ФS?ѓ{GЅ"Žљ ЛёoHd‚жЊ'y]9’с.R: жљ aœ!­Жk§Ж?@2нŽУdО J'oмхэПTоюoi$Б 6кЏ>˜6*Sј-$яР1&9PРda З„wqй*=’э‚ђЈxE$ЅgЪG\$Ÿ2~=_ЉЂЦ‘"*д%`ŸEС{jrS Єj"1“cŒZzcˆ`C<ŠеР^‰ьЧNXx’dNќ˜Љ‹ Шћц:"~WС‚g‰ŸВ§Аˆјљ€F‚ГЇ;LЂ;L5­3ЇS3G„ьѓ;Š-?я<(„ХМП–D˜ђ$dА)ЮЃЗ‚љ9ВЃьє?`љ<з™VwSЙŽ:ЯsTш8’!Ь€0шаЉТU №+BЌnќB4Ж%.CТQъњв{‚>Ушh`w{Ў№ь ЋоƒЭiаŒŒ№›ЈЉЈТW€–k t -ьLhсЇ EŸ†uД№1Д w іO• д:™1§}п=•ХCx‡oC5  бЁsЎk0Ќ"œAІЉх–ЕŸтр@ћ“& 91Є>щеЂгчAЇ,эля!XЂЇ`I_"I:QЦ3•$ЩЎЉтЎ0Єsк№ѕБЉаrœˆŒM‡yи)TbWB%H“”ДГйoа‰j”RЪ3з4<}4ЫŸчš'uГzЗoђ2NТьэы;]№ NЇтВгщѕСтЌћИ’^Хи<р}ЕГ$fн_†яцЁhч ЦX’=>6uЖœS•<Ь‰›h‘’Ъf№)ѕCа|!0ыЫГ.ocЬ‚А™yџHРzч§EЕЪ­Oцpч*UРј*ы2wї &Ђ6#кWА<уЩВ^?nКЌ+ъЪ‘дwБЪ–J‘оЩфЂ€C$ЕЄИ+™Šа`&oЏЬEК‹ъ/ЏнУKne4ДХ ”€ б‹А4–НQІ†œЏ3#эgo:’ @RсЭржiЬOšxѕ5wuГЮWюYзlЪgw[Tž,kВВЬKА ._ој ВўІtfƒz!x{-ЗŽ іseŽЎ-ЊћвПkЭХ0ŒCVлzг, €•юКЪлЎЈЖц#’Вx?ї‚_нCнno§Э3XЛИ5NђМшЛбОdŒŒг,З8ѓeЄvй^+ч†NT,iѓ%иl|бm™'œ§рќ№VnрˆšzќЙœ–…>KНЯўЃЖŒ№Йї-.EbР<Щ–ЫМmЭœцi›џКщ…oъЦsЭ˜E3хєЊЮ_iЊœ„Ь;e­м\†es]zDЩнЯvsыфаѓ8двsлхk ƒ…ВЪЬЃir—•Fцйp*YжeYДЮ.ь+Ї[UБЮŒщ”Џf ›XфiАЭ6ЋР@"Іу”Sw]™W ИяёрЦЪ~‹›pгŽ€iPЋQ!СoХГ$/‹ЕБФ|…œ_tюМЅњ *NНй˜lQА"‡ыѕœбфЖ]нУ”ЂOХj“•ц73Ж oл}ПЧ6Б`к'?z1Œѓ"РvCYPњ§з|‘Т‘$^!˜qvхъΘВКЏ‚Кё1ŒЦH ;’dДфPŒРжЁсЁ|€Ўbлц”Э(№ЧОHzu јЏŽжўу‡‚TбыД}>О+ uЈн­п:Œя!ИэВІsc š}ОaЬ j˜‚=ХZh#w:$MВSЭо$1)GйJИЕ>ф‹АјЉ~„ЎŠšhyЦ‘hт.” t\#) ’ѓcвu-O‹3[ 1˜šи– 8iЊFŽSХŠypRо Юя"ОђN 'ы2ЏїgXPLmNXо­KёЌ§Ў\\$&гцќ(|ђcF­ю 1ˆ|6Њ@<Ž,С&%БюзШлƒdй}3q“—6ujŠGїФže„aсЅSНТАš0‡$ЅWЧAР‡=ѓбщuТfмQ…ДЧзьЭъ ”& џLьLб.šЂ—*\Шe#§ъG FбAšMXžкgШф‘ZPs†Nћќъ?Б Э­gт4 Ђ~ˆb&›їЫН‰bœЊЭё\‚ёЉж№ŽЇ"BЉЋЅ"“TUйёњ%Žm?Pnk№pЇРЯсяе€ё2ЏГПDСI “ўШЖ[ŒЈщи2›YСшлХ‹Џа‰єeNЄћаёАЂЯ?GˆŠ+‡|—№]х|WNтЛтыђ]6ЁяВщЮ6dЊГЭЧ|rГ7Х9q˜јlƒmA€œ‡ќwJЇ@>сЗ‚j’ЎІŒрт‹ј$wЭ&Nˆ‚ц Я3z=Ÿ3‰ ь8сBQјнfSЅгт’oЂ]эѓS ŸќkabP2A S[˜циf‡}šїн“элTЎб=д›ћ‡ўоЕ6DвvІУh:§“qЧЪ<Ћ+гАrwЫ|GЇ€ЮЗJњў‰HжyлfїЎЂ“Ђы*ЪвЛЋJэ„&џuS4ЙсЪCкчQ9nŸŽПKщО;kFjєѕ„]ДЊЋEзO…i˜kл )ЛтБ,–™яДйкю}Е)ы˜BЅFœ‘OџXтВdЧэ!ПFо­ЪрYf[bK[ƒu­kaš–4lИЙVгћЭxъš‹fД]geщѕ*‡Ї^хІJжЂљBIœќЕlы—ЮВЦj_мДVЯІк/:ѕ“) EћN…эМЙ6ЖЩxМУЭ9bђŒ/‰LыA bРБYџЁL\џL u\љ*ќФыŠы…џLСЕл›ЙяЫUuчћjПmз:Щ}xШЋ(ФЇУ?Ћ|Йm˜zзБяLaћXН\oЇѓО нЗ™‚ЪDuŠ0ЅД|ёнЭ‹џЙšv endstream endobj 80 0 obj << /Type /Page /Contents 81 0 R /Resources 79 0 R /MediaBox [0 0 612 792] /Parent 66 0 R >> endobj 79 0 obj << /Font << /F8 13 0 R /F11 14 0 R /F10 20 0 R /F7 19 0 R /F1 23 0 R /F14 22 0 R /F13 21 0 R /F36 12 0 R >> /ProcSet [ /PDF /Text ] >> endobj 84 0 obj << /Length 2481 /Filter /FlateDecode >> stream xкэ\Y“лЦ~зЏ`оРвr<їaYŽжN•ЈRЉ­RЊтYЏВљŒєвёфћхr=Э;[}ЎњџНћщ›+ЭŠ+EŒQ=цѓаЄ2oJŒbEƒ_ЈЂ‘nБFm>6;QD;YъƒUз|?ŸLцИŽпњм$щ;ш Иc„ л0FœЪ%і›§?2™Яњ,IУu.6!’‡Х|§™ЃU„;^Lт!oA{š8Ѓ@ +х0‘0YпъчцR б–ѕJmN%м4)Q%fa§Œт„ жЯlhљц_(€7Ё?Sš<4’вVf_LЋ4Њ$R;јЎєfі46{ -to` 5ћ5ƒŸ\3BВдFjэЖ eб ;ЫjуT67 $ cљЪп‚iQ“М‹,Ь!`ѕЅЦ/#CњЋыеЇ}ll§Ќ_›фЉй•#šЩ3эkc6[люlU>`дeM|[‡tDhЏ#”лтй€ЛлHX’aKT‹‘0N”ХдxL pЩУUЖ“Јj .­>`§|coћЧt“e7Р1~›Ёљ…}бГ1”B4…Ѕф0Эћ6OxФ†y˜ЊЂVЄ1TT}Ьыц@ђŠщ^Й‡­MиН&ёUЎWŽжиŠ?нйŠNЮVg+і;[ббй~>”=†Е№6AŠВ o›Л ёїv%е 0ƒПДЩ80bЗџgL”Цž>*@яCј{иRn‰6Кš  КшKЦцcˆЕ(RЫƒ•Ч1Аg ЕКЅ.Œ—1­V§ДпЕМIФfqЃ,jt нџ™э€ЋDЇ.o7kšЦ7€є:&р;i#КOŸЂvfЙЋййР%ЏfгL–ЂЃЙЉЯ$ˆ}[_r6tзцЭbЈ-(я„jќ ѕік‡šмЎƒЎ]ѕЕщ ЉЈр42 Y7\FEtGЈ йЏ*ІТЗ Їп~QФжьc)ДlzIp;ѓЎЉ‡сћхp<—Ъ_ЂмN+Y…ї6Ч?нСЉЃœ`Š(м[І і9œ,‰м“c/ђ1w9XБ—…йЩГЩюА"/B$O+ђгaхfs-АRйEFИ1ђ|т дbЭIЗ™г)™ЂН0S”ћнДНR{:&03бИЌнžфsБ'йСžd‹›СMѓ§nZ]мMЌ4р–1[ьLм?—хR8hNЄњ‚ТBRзумЋ{ЧTИ{ž.і$Йš&­:кхlЦњ3`ыŽЄ—<&щU™%LЫЊb^…:EdЦ;@О>?…Bh,ыѓЕЦ\xК.}ЏЬmAžkN(b’љn/ЎуэaoїГЙNE]ŽlдaE-HWIієYђЉљžSђШј!Oe Žpu-љЊNчяёC!ѓe%ЖЎ >Х•Тg‹о™†#•ipZ"еоkМrFюl2цU^м™фН—GždгЧI:ЭЫсвqИЙ,XbЁ\† №nоЯSlЕž У ќЂФl*Щ№й2]­ВйCLц’Ц7BŠ0ˆѓбЌ ‰Іжр•[Uї гcDЅž…оє‚ЪPљ‡ѓ]a‘˜_,32kpkŽ0СЋЕsГшЁ мьU1Z,фW€HІ†uпт‡ІјxnО ‰р=dгьь.цЫBEпh>}\яи,џa€.AТrџ.щ2}Ѓ;|*BЕ&ژn–џ’Ec\enЄg;!­EjФ`{Už"Е<6ЋT‰tѓЧЛЕН‹mLŽееI.:JщPЪЧy4Аb`€л#BTжtжек”ЛаsF˜Ђ-Т4{ф ЋRХBеJˆyЂžІоС]ЏoУЄšŠй РтЏdм[юkŽЉі=F!иоœC‹ =FЯљЌЅPD]lіp<йЛ_ŽбЭeЕДяћЩ*]Ь†Ћь ѕ*ќоЗ"Ava _ЏUВ\ЅсjУФ№Ы†‰с—Ч№e< ‰о[/бIћK`(сb’.ѓ^§ћ хwАY:Т’џXЩŸ§КN‹к^0nY%/уt9ZdљЦdГ№ЙL§kјъCИ2'A$B—dBAŠX—ЇQхˆ€Ÿ2E“6ГмЯЮЪœx ѓ~ARѓћ№™ЭЦйS6^'Ё!˜)ќъЭВЙ д›Е(<япrСЧŒ†[ˆћkšTUJєМ'Nuпг‡І>‚ЌЈЌEˆ‡№†ГOў ˜–э+*џ.РэmsPЮ}™y>*2№8"L=_[Їйцдоу,[wЦЩ‹Гn]„ № КIмфоŒ ЭнФ›Хш"с|1~ёЂ8с …i/T€,Л ЋЫ˜ЅьєЊ‡lМъБЛнw"U‡%}І”Щ_aшП8Œў_ЪцOQлвЁHrWа [Я‹Dчѓ"~Љ„чAg ;’‘а•Я?йŸыayЮЇ˜jСTЅb[ІŠ_9CМY%Ѓ“ќwыU6Щў№$Пzы/ІZ ЉШQ—с^њЁfсs™z2ъљ Ї€%"+‰ОйАд›№іjxЅзпrљ{ я>DI"Ѓ€kлзXocб8+Пш z.Ѓ§xнЃ ”˜­љцЮ“Gк^ЭЖ}už_чsržgЩ}Юѓ4ХЇvžђљ9Oљ ŠЯ9яу{ёѓ+dDЬњ2‡Š/ocŽГ]W‚:МQMОдЪЋ=` j``vщФЫЈBА-љŠ*„sђКСЄ•553впфЌѓі@}Еєо„TГ,Їše‰Р›@рёц&з,ЗЙц幧$Œ›$kшЗžЌВЧ Œ0W\фtсёp> fш0›Х|Ѕ’РШ$§8JWскџЯN~…5 F%sL•›$]„у{x„yv|’(ј™ЅљГМ,!–dPЃэNГTˆp Nѓмv‚‡BЅ%gГх*цВœпЧа" aлыOKоFK5ИЉŒŒqWЩпГџѕѓzмщќП|…нд#[drФЄAF>аЊrŒ }…ћбEa`Ц k9=8Нчѕ3кЉВœ’­KкэaKB<—‡У1М,kЪ2Ь~6ЯОH]g oњ№ рe”Цм0%лœђmЬ ЋmqШ`6_L‡“ьт?­ž?Y,7(дљ[ЬсУ?мНј?ЙY endstream endobj 83 0 obj << /Type /Page /Contents 84 0 R /Resources 82 0 R /MediaBox [0 0 612 792] /Parent 85 0 R >> endobj 82 0 obj << /Font << /F8 13 0 R /F11 14 0 R /F10 20 0 R /F7 19 0 R /F1 23 0 R /F14 22 0 R /F13 21 0 R /F36 12 0 R >> /ProcSet [ /PDF /Text ] >> endobj 88 0 obj << /Length 2794 /Filter /FlateDecode >> stream xкэ\K“л6ОЯЏр‘ЊБМыѕaуЌk+IЙ’Эlљф ‘hЫzŒѕ№ићыЗ%R‚$jF’gВs’(BишўњыFƒп_]|їЦfŽ8Эuvѕ>cBЃmІ•!\Јьj§žO‹лi1+Цnѓyo^NЦЎ”4ŸМяќyѕуwoЋѕ`,б<ЃсŸŸCƒњŠ0kЊћPE}bЌк|IѕЁЌѕС^Р„ДЩ?—ХNВ„ іfё31†6DUuђnsF‰qЂjаOІЃоАќoеїІPт$Ъ8hёiбтW–Я'qЕюЛЬ0bЅШК№ДVUЯBSђDi“u-ЁfЇ\u ЙЊ=ruЙЦ>d]n„ZЗjCYrОЮВЕq…П:#ьjбL7фЯD­‘…ЇVЕ‘hЂ#M8_jг›R-†/’H%зglw ˜`›Ќ+ 1аЂЫq*ЎбfхјCЇ+„Шч7~‘љЌ7*тOE5тf\~ZФ›Ј…xЋ‡Яї InђE‡хУ^hƒ цЂ&Ч6 Йrъˆ„_{оњђРLЙу+Љq•шT[1НKї%aliaУbžшЄЫ™"ЅУ БN54ГБH’Xю@ˆDV­ўЕ9Є!J™ЌжцXиаљйќеІn0C˜ВјЌTšЅМtJ^Œ(iГЎ!‚кѓ"6ЙјчеХЇ 4(šБŒs'†І†РJїGПџIГмћ1ЃD8›нљ–Ѓ жХ0д…aілХЏп#и7ѕ)vЅиšгћь•УфmSѕDУ З‡иыЛФšPТ•ЫX"Ы51)?CЄс TЕе{™а*Tб%\ Š‰! ДЁкЕDсЊсƒ”]ЗTіћіFЭЇcIyю4žюяСrо!žН xˆDЅ‚/мЫЕ"№ўœšНг2ЋЕ9Щ'lžžйњљŒ&№iѓA иСўЈкя1–Х ,А>Xa ŠP*aWвКи–veіš•N›гъгБЌЪД4*гАЉ”чцрЙUŠя4ЧiБZНЪ2›ѓ-гФ щЭдёˆыГIEZz)wФп2{nт~ ЅюAк:q|ZСy~™š9PdХ›љ‰}„lAъэёHНк QЎDэbЇЁj#ŒГd~uS@ц=“ ф"ЅЧ"ky=эПыX‘OІƒЗ›6-СhИК`6Їh‰‘цn$Еp[еіeЇЫ0 NIL3yЂщlЬ&…Šv e]~Џт’Q@@ w,pE.^%9"F/@ЪЉZržz$0~хƒЗeУx|y;RрЂГ­Сˆб˜рСcЋЫ}Ўф*,Я„=ќ ЙlЭРфPyjB–0-›jsРr™]ГЊ‰Б>{QЖп&PгРTФЮlуuЌ&kкьЧЪ]q?оРЊГ‹ЕBыUЎя—”Ѕ{BЦ€ёИR‚(dDЂdн#фЉп‚“ШœD>%N’Р…cp’ѕЈ ЩSzcЦЭЇ“шю žСГ#xv8Ч‰’т!Ž -w|Lx.д< \6АхT9 лпШЗž0МNъ,h вšG‹Дт\HЋі!эA@+О)а*CДа™qŸ•ЗžфУs2ЇE…'g~f[‘Сe’јГеVљЉдšƒ'~дDi‹NЌй&K—5tSuN‰fWG­юџ/vŸ+–йwŠгЦ'ГoЗпОѕQм+ћ йчz"]гBџ–АD0VŸ7_Ъ3ы џwtща]Uuё[9юшнlzwWRBЅ>7Г?‘g,эТБ@Яœип{[ЅеfsТ*@Я]šп h']ЈfУџƒ29ЭУХl1ѕЦМ0XёщмН‘Ц$'ТшчДSяЄmШяEЂЮ”kc`ЂX*eЅ|\ќЉFшџП\ќTОњщsёЃXz;_ПFЦ“Ѕ?•ЕsI„ŠЮ|дУJЁЏЎа:ПFЏсЂ?н.цXг.ДЪБДn„вfјmоЛнСДќь+ыЧсі/Уyy;,ћёH€oНVў MХЌ?-Џ§:T•c>ДYYBf"˜2V*_њХэ<HћЊЅzб58ŸлачдЛ'_a= ыГ+тНы ‚TQ5%f/‰ТГmщr‹Ѕ9Аї(X18h+%4хx6/zQXЩ“RУЬ}*€ьFJАYМSј–Xцš*ёкыgЅ`afA:,_Vп§IЅKК‚7BcQЇ+№Зcс@}™в-‹€uЃLі™ГЌs–ЭJcЛS‚IжBсКb-ъСЌхА’эГž0{ ъУЧиЕжЧЪЮ‹'”>hC?Кьќ.Faл2 ЛƒQHОM5гe<г4›ŒŠЛшše>,fЋГNx.nQЮ#opЊЊ4cj›m)wDZu/0>‹yŸ'лШ8Vѕјž#)Xf*‚/~Мc†ŒчYqо2Mб"s{XЕь#ЎУHžЏ;zŠ№YO’ƒ…эАš“`Ў †^лЗ tйаZ˜Ћ0.jaЂПЕj6Л)пЯэYў!•xИрœяЉ;mvnФiRПЕчIк“Qfї9Yi–$уКœЯРЧ)%ѓ` 1(1nСCр^К›!sЌaХИЧ4уž­SbHь^ŠU ЏУьžR3і_EEљЯ{}TМa9ЛAеУ_Ўёрєзxw0РtХ&юРЊ(#+№<48D+Жx„/†;$Rп nZ-<иJF—)“EЌЅђ*f<„"&Ф†РК­њ ƒЇœ(ЬЦŸ[@тbZЄКгФЎ"Ёqл@km] “з I•teј]ЁxN‘,‡p"гp"аЅІ~Ф••H№п?%Ъ‘ВVе ЌЫЫy|Dt-ўлЪ‹рKж}†oАЭg ТšV.C?ђЭƒžзІІw>єwcW{Ю?Ѕz`FЎgФšYКеmСЙGЬQpDДХ‘ƒ ђjсќк Г‚хё˜S№–ЧзтaьŠФ#”ёs‘Е3э,е|‹AД> endobj 86 0 obj << /Font << /F8 13 0 R /F11 14 0 R /F1 23 0 R /F14 22 0 R /F10 20 0 R /F13 21 0 R /F7 19 0 R /F12 89 0 R >> /ProcSet [ /PDF /Text ] >> endobj 92 0 obj << /Length 3421 /Filter /FlateDecode >> stream xкх\moЗўю_qЭЇбœс{гфƒpЄmъТ%%"YŽ$[U~}g†м{бэђŽ"м- /ЙЛмЙхЬpц™сЌ~} Mџ`F+ŒА№д:Ч^Ов‹КљеBЋ”ќтV†^аЃRt‹ѓХп§эбЏ+˜Tˆ†HXЅ­­‘Шє6 cT№q/–†LБ!(RЯ{иHуМятЦШPЅ“Љ“HЪz;џ­$ž<єјK‹ RаАxўг )Hбл\98Lо gФЛ>8Д4’ЈФ`Зє#Kgјсы–gБСФLСЃ2СŽгјЉ"Y Мэ’l+‰ŠdЕS$–ќж†xр’О?ћhAИi"_“јЬ7_ћqј–ЅџБ 9ОЂЃŽУgSlвY'зйДЅ—є?яЂ№щМ$\BхSъ‘D3‰yIИф”3)ПЕ%IxRїуЬяЋЬ}fЛ ЬvH‘xCM`nаg‡.Ђ)LУд€MЎЪƒhзХƒVDЏ4­"сcDOJr^ЫВіРЌр%/ж“y4a<ђEž?1Х'#œВ‰иp˜\Ђ{YЇєЦ XaЙ|џ4ЁU@ŽгИqФЗSжNЙнЖWcd6ˆ#лТŒф{™›у|ё—|v=ёƒ&Њ`ќкOъЉїFС zх!3ћЈG L![K ѓба22uФ6k Э‘дmЮр‘iwїАw.Ќ ] жHЁЂ_С+љ•§œ; 1Лв^@.Š ŽMbРgWЬž•{Х^$VœЗфя|?ZITтƒы2GM(ѓт‘ЃsУзЄ ЬŸCRг#9 ‡‚,8Т m†х†–ŸЇEJм№ЄКЗ НћЗBy–q№Ћœf:ф†УёO–:‚xd-x+A^–ЏЂ–56›E+bЁ‹чљЌŒМ­ˆРбbЗа%‚VИ |,Jя‹€СыЂbшШонф3тaВQ.Z+ТАb§И!Dу†XO]”йпћˆ‡fA9aЛ_C§Vd=Ј -ЗЮ…нJЂТE‚Я\LФХDjиъ9Шˆ:{ЗIAHY€™‰ХШaYЯМ)ЬOЫ&PKˆn nЩ\ЂРmЬ`иoЅџNњ7вЇЕDц"У—”сKЬ€ЎФ&yбSsОqё(|Пq‘nЄKЗœ(@ЩТd>А vDœУЧх˜зlw†Л b$Aov’B\.у[СЇ—‚OЏЄТIOL Уwrф‚ ~ОуkЙr&§7rdмqТC?пкгKйІ%QЫŒе?‰љѕ“МЗ}š›ВяЭ№žШпmм;ЩXящszƒ0›zцmШЦжFYнuЕ’ЈˆOSaKи…–1ЖI{Š!’Љ#GsR%еїСїмЂŸWЩvE Э$цЙC‡ БФкшfЙ“aЬf2ЖD( ЃЈЌ6щhU_–Д•BeЪ1ЈБd§„ТЄє*}TБS†b ]ˆД™De^!ЈшJЈ€AЊ9ќк^­ыПr9LЙц<ŸчГг|vЯЎѓц“ ІФ†‡›S–Н@=2єbqBNјЩ@ZBМї!зф X#Ьи ѓf!5Lš–ЭjџOчТЉ\™ЫŽс…_ѓўŸфцЃдj К№-.й яј@=йSфЃb”ŒwЪЙЎ Ў™DEVž0O*xуkжiїЊ*ыПжЧЃ.ИлLЂ"UТж!:VCœмAсъ VIРсВ‰Э>"%С2нЃЏTё„ьjb‹Ћ#ŠНvЇŒѕЪcWйLЂТ[ЫуŠх5š”пЎжDЉЌD#iPУ7ШfœHџщђŠдFёF>ЙcdХШюjј‹єeЋщIo–1bpРšх^ь‹b.ЎŠЁфЈvь'кМŸ(х†Ip2,ы†ёP• ŠтЈ.йЕ’ЈШŽР{J% 4PY3;‹d№аФџЁНХћщEK8*эcя0(пW@нLЂ&W6іc(Юn1MЌ†mG$І> ŽЗ’Л™bZщ`vWИ§ўд&™u­й–v…KЭ$* СХљcБЗ1- 1њАŒF(‚НoЧM.,КoЧйЅејЃЃ }%гЭ$*ќсКz]&Гчцф-Екb?Эјљ|MŸN­ €tиУТvЋ.ћвH Т,.UЋškRІБЌйћ}ёР=ҘT4]бZ3‰yж зŽ‡­п“.Cz; ob$*у‚№й˜а^c 7а]‘A3‰ЪМИй–ШРHШцŠ—œZоˆЄц]nЪ=.з‰+ЌЉї bЬ…ќ.гsЫ бК–{PжvAўfІ‘УФБМеЄ)м%iБ‡68 ‡К№p3‰ЪФИ Ж9ЬVдX!Йž)Fр­1šŠDЭ() nnrГyЏ\<ЭЭUОwОqё(7яWKPCg/rsЙёxЙї|уёзЙ9ЯC щkў(Fu%g>7)Фй*-дžЄКЯїPhQ9шѓV­$*Rх’фБ^еТCг2ЖƒЂшЕєЬџA=#)Ћi%QбуйцЂ#8Хp9ƒiQK|CРфћ’ѕл)aЂУ-О•‡ЖТf3ŸЎ›‹@ЙU№IО‰3ПѓЗvђ[%t%w…1^­ЄѓЁУ* єьЎїЁ;­Эq› y’рws*ЈQсŸ‰;?фђЋЏŸцъ –К_жЬМ~Ѓ!ёu8Э$*њЭхшc=В5ЌI{аgx\НАУВсђ :dП…ќЅ 7>Ѓ-ЖMve›јѓЅГ,нsZэѕ%E.ЊяУŠV qљЙПЕœ~6АG9Ž+Ѕ6ПЏrwM_rZQОFф ъВˆy^$к’ЃыкJm&QŠЪŽeЫжёoЄпф­3†№:Gљ:ŽлjgљьэЦНЛ|яљьЭZ“1ЮA‡УЭQОW/4[юиёYљžk…щ˜ХdЌљГzvˆ–Я<-š Z:ћХrApџ›IЬѓИ}Д[]5DЇve šITцХшc‘АэŠЈ!x…ОЫˆ5“ЈLŒ Љu mь !c]ц…I„рzўЬЫ>$vў™—ŽїXЩЈ‘"ЃHb#Зэ3уЙк‚fцA(`їыГы›Г7?ГЩ6ƒџ#k fžНсMЫ›гЋѓгЃљKt8=љ„Gq!]^фg^ѓйндЇпёщг|ыјђтэЛ›Ѓ›ГKйР&}!(J*Gю€МžY/cmј7ЋЖ"с endstream endobj 91 0 obj << /Type /Page /Contents 92 0 R /Resources 90 0 R /MediaBox [0 0 612 792] /Parent 85 0 R >> endobj 90 0 obj << /Font << /F17 6 0 R /F23 46 0 R /F20 47 0 R /F8 13 0 R >> /ProcSet [ /PDF /Text ] >> endobj 95 0 obj << /Length 2439 /Filter /FlateDecode >> stream xк}XKsлFОћWшВАJ„С`@ццШV’]ЛтФккT%9€рPœ p@d9~ћ5 A.U‰==Џž~|няю^НОЭђЋTЧ™6ъъюp•fY\˜Э•Щ‹XСднўъЗ(_­гTхбЛЯче:K#ынЩ6+ њВN‘GоvCнwЋ?юўљњvsЕЗF<0ЙZЋ4оЈ”К;Zи ‹ЈЗ,вD+Е‰€F~•F27!зZВ{^8tЎЙчщмдлš‡?УЦ­A9Ѓ„зfqђ§_xіцуПЏ™ћіэ/jНIцŸьЉѕ(3Š™Іё6—?ИўkВ,вkќKŽtдЛˆpЭSeГ‚'OmД~‚Q[њ=s/G• џNe‡uЮќ йGwюlГ"б6$• Њ,тЭf#V‰SБЫнjЋ#а'kЌqВ§Б­лћЧE{Є›8лђojBmGs љЬjЛ!ssрB1’tбž˜vЭyш™м—}ЩT‹‡ўЕЂ3˜ѓз*7Qщ];ШНЛК%›“ўd^чОи.^­5Ј]gСTяк[Ж0ШЦ-ыš9nЪa8”}pЄВОo=ихдёZzr)ƒЃ-IXW?ђъіŒfџbї(ШFƒК7Yм7шЫЫ§OќvAрЖС%›HН‡eэюR-"ŠЈi›ѕl&hHб.Ќъ[циІPЄћcйѓь mщР–pOьфФvIрІ• ЋвCИ9ѕ‡ВЉь…‹R”uJyDEЁвд6Кљ97"[ЙЋ­мyQп3-АІŠHхfНCпyь-svtQ;4ћвЫ-(8йVыЙєSkВV!ж2 (ƒ+8`ˆVњXнИ‚џЩ‚‚žXрqРOќvЕЮгŒ] жwGŠƒ‡†зИ†Є^/‰§лПОKђ?if 58АГЗ§й;FцЗўНˆ@рЬZFњoў)eXЗ\ёШдяIЊхXЙЃхбћ”Ћ’‘ЪЮŽvrzЫд‰ ПЇdŒ;С/Ф§)JѓZОТЛна3SЫ…Yxv63zлЫжўИš-Dб—№ЦСЩ–${Й†IŠс„џwrNdЄY\9„‰ъБbпZЂ€Б’–яШя{Й8l!QG{>pЄo_Ж|y>—оВZjrюkФѕL РЭY@ќ U{‚Ыоa!­ƒП:8ЈцPЄ§т Ј@ ЩY)€pc@ЃРядQ`X7U…`>ЃІЎ Aћља]N€Ъr͘ћ1fFEЛRB vђjœ>јіФT№zXzі-щЛ"Рщ:К-ƒлl_Х№Ж‡E"А {1žxkyЭOеЬIс‹§а,I\R*0P—о™‚дƒХг˜рЏ™mQ#P=ёHЎЮЬЄЖТEŸm5p#‚[hмЙЖВ  zUВ,22KЮ'@=._,п/w^  ел‘Ÿ”a…иЂШcєOrŽфI>’:Ј(ЙDFІЗШ€ъ;WХа:/'љзЗЉžTсYЂcц 7Щћ{’˜чЅzz–ЄџXь  SqjДДла(i n Иš<њL ˜]лМи„#оЬQzcYƒIС­(„щѕм Р†CшЎї%њ z8`е^а]s*ФurШДЬтќ{ЧXбёŒоЮЪЉmlŸЯš3iŒŒ— †Ÿ0AjНоэ€N1Эь3$-D7LСi\хлЎ=є<{ѓž7TЃ–‘‹‚В‡јŽ00г™@W%Р]`ёА‘фF‚бЃ 7ЫЪ’ђЬ„У>“dЁ™:R–uв7я_F‹џ-:Дt„ЉТачtЬCL8=‰fHƒKШЕ€Ч•№№ћщг;Хk\шŠ *ž< M *мѓ•о1`Y–o–!9СВЬ„Д ќЉЩђЂрpT аl Ш‡ТnС+њ\bh.Рz}ЈnЫ БнОєЖj&№gJ'JЇ(L-,CНšXЛ rЧГI~†2ЋЌЄщ -4uœц‹…!pžР‚,aЪCŽМt€`F}lк4}їH‹ш‡IƒЋ$1PˆE“ЏЌI4ЩsЈ„_Ž] іN„рo2@`aчEsu!РДP(ъхСТkиеHK(–{Б„u˜šЅ^КХЧА’”d мцЁЊj›kfŸН]—€сќ!Ш п'и€AОœсЦ<Ьщ 7…tБV>Ь"эшИ6—сY6ў ldzфŒпžщC/€…xP@ЇlDеЏ•t™’а„Д(„‰~нљUгзЄPБ5l ^ЧЂЁSsFЄЏ8qЉwёыдŽЊiŒ№–ƒќ<Пр‹(2UЋтђыд’к ЎЌнŸСзi,ЉJ6Ќp6N@f•ЯSЁ§†zЯ3фжШ›~/fˆEnW•рU}€Ѕ_ј6БXШЌ3hГННGАђW…kОјь›.$н”Фж}ЂтS$lдOH}ј№+sј&Ÿ0&о a]ФI*_№•ТЙWяю^§—ВЏ endstream endobj 94 0 obj << /Type /Page /Contents 95 0 R /Resources 93 0 R /MediaBox [0 0 612 792] /Parent 85 0 R >> endobj 93 0 obj << /Font << /F35 11 0 R /F8 13 0 R /F14 22 0 R >> /ProcSet [ /PDF /Text ] >> endobj 98 0 obj << /Length 2544 /Filter /FlateDecode >> stream xк…Yнsл6Я_сЩ5g1~ш1qšєЎu›iмЙЬ4}`$кцEЊ$ŸяЏП§э.HJІнqБX ьзаЛ›Wo>ф›p“кєтціТФq˜ЅљEšdЁ“‹›нХСэБйUлєЋЕ‹врaeѓ аЦЗеšZх0”2Žƒ§PеЕMЋmЅЫТьtp6 ѓ|#‚IЏhЄM‚ЋћЖкbYДЗђ­šUl2x] ОЏbЈL]~ЋЌe•ЙkС8yћ5~9ž™дІŽ—РwW Ј„МЈ+‹}/lи тл’Ј\Y є0ќиьЪюHU§Џ˜ІЇS[аSO I‚ЂЊ‹o5ћ}М§љїk&ййšqœ“Jw&}Ј$rке–Ьа—вюuЎКlю†{aВwO;1Ю‚ХtƒtP| Жэћ%нЋ†њŽz‚Ю ’Цъ(изЮE2:ї…*э …^q„žрї‡švP5wв СюЪЛŠbЕыu@Ы{H]ЅŒС ыТч ІЂрз(‰*7їЖ,dŸИ*O ІъЭcц)зФaгOЧиаыМї’ДфиcPД}э+с~Н’ал.)aѓаD/jaТ8JМР?hsж–ц323ђЊ юЊ• zP8`єJъ\л$ “(=5ѓ[ŽkKgЯю 2ЦЧ Npš=Чn*^…Žі0TћЂa6ђHЦy$г­ўSR™ЗД™ о^ПЮеЇп{ЁИ€№ŠнБЦ$\PСЛп—CЕUбJП%ёK‹ЌŸФЩ6­Ћџ№жъGсiRв`Р šхq1MpŒ'ЈЛѓЇќoБ0#Б|>ФЌыԘрG.ЂœIK­Ч—ЈDКUŒјќљ+дЩcJL\є0щѕћд 9–НЅЬЫЉХF“ Бш,u+_qЧŽ“-ЯFПвo*cЌ#љR1Ц^Б#ŸР‰й№ПŽе zmлЃwИЕж"ъЌєLвхПcЭиh#јЧаМкоI){i †2XЄыJ:ЅRј20(>HŒ'rŠ˜4b)ЈFЅ!JиZв,>>h4š з‚UКЌV4[…WZI†Ў\єњ‘ѓжQz›вƒЎЁUyЪQЧЎ|--ХŽœФ‡šLWБэњбKюб‹Sєђ‰БШ\ГŒЁ‚OНWв(ъЛ–НГџ[рђV§МИCdхЩТ€Ы)ˆОъ“HРhJAю*=žўTx!љЄэ~Я›[a*њS'XДFkvKЎ[Ež‰U™˜1кzс?-ZФ4?НЛiЋ” ШKLšЩ'ѕ­K‰`s§N„Њ†0T/C+]сNƒЁё"ђхАˆИКD3DОMЃЧОѕёE‰Šр  ‹ƒO]+§m_ъШЪupАP(VОМ {‚шаСћˆЮзЋFaЖЖaД їR‹cЙРŠzЧю}uо)žE7ёј~ррVР вЅFCч Й‰]_W[2гычo'R` ”ћJ. р0NЅЏž<г™|Є€‘rёЭЮN.ѓАZ„^BеёUЧчxљй‚ЪК‘гLšРаа‡nQнБЈ>Ž_ZеV8лЧ-mэш5”:˜ы*ЫчBЈ‘@ЮФ]tЪ†FЬО]gk!ЉjR.Њrr5.ЭŠА‰&лStГљ36?ёМљ3­`™QѓcЦN…NнЛ-Чo˜яJ&™мvСCQєцЎ4сЙѓЫ xш]№ЧOяЂфЯчнюWΘXd(œц7фo˜i‰Šz}ђAоˆt“™gLj.ЄW<^ˆ!2?h'Eќžѕ8‚~ ЈЯ4Dјє кG h6ЈЂ\Ђˆѓ4ЇƒЛ іГMHzgoТh3іOL™HUx:wB>vgSwŠсѓ$ї_#ыp>сt“y™дё§4ШхMШЋэБ.КKіinhGЇ‰oЬ*FВJфГŠмB›тЅшЎzИЩ]’СmO$ц‡?•"& пŒ•mЖЪd=шйЉ>œHЂ‘ѕ—nŸ;ЭЧеЖЈˆU(–ЕЕЦЁр9 uљQЩE–чvс›VкИ4ѓ–шAyЗSm;aЉ‚„!ex;!q/}Ћт‡'/8OEЫxL4љл‡,“|cСйЧЄСѕѕe4ђМшˆ)ˆLAФьсЪФдr“ѓ‘ЩДКПdшdSМ%s<АЏrѕO7у аФ Ї„ WzbМiрњbћ8Oйdчœђћ/ўОХњў'­щйmСgЪЏ‘IЗеI!їOrѓч8НШЉJREђяшЋWgКff№яЎ—ŠŠ[?ЂЎЦЗQжн\‹~| и=oєѓх!NќГ b~"иќєѕїЗІН^с2НТeгŽ–юєєЊп„щљBЯо>IfЊPд№я7Яš[Ћ\хmŽ]‰ацPШХЗз+ц BЪ„Сжцa\ЁqМѓ*$ЃM’дBBЙсAч›a>тЃ\іeщ—ЦЭi!7ziДyФк€ЅL/k lHжо-ˆ…ˆ'(Ь…т–fГgЯьE–NGођГІ>(ЦЮЬЖщЦЧ№sНљ#~UY937Ѕaа_pЮœœYєч1-- G‚ьqєUsіму–ž/8сЛŒ_О‰Hх•[x’|ђ)љ€)8ƒ}фUˆI#Й PЧшЉhLж‰{)pаyгQЯdКLРц‚Ў“/p˜JьQ ;@WАФYq'8Э#ВZЏ:П=X2~ ˆЫъШЯ'ƒгнЬeО ;‚“зяaœЫLбСN3цЫpB‘t‹СчЮ І$rњ™FўˆoзцљD0_Я`‘t…yѕ…Œ#ЬУєўa<єцЋ€›nw*Zp7fќуЪDўIХЬѓ€l'KБcЫ_$nfч azœХуЭё ‘Ц6• чy5Mš†yF-ЋXfА1њ^§pѓъџд,& endstream endobj 97 0 obj << /Type /Page /Contents 98 0 R /Resources 96 0 R /MediaBox [0 0 612 792] /Parent 85 0 R >> endobj 96 0 obj << /Font << /F8 13 0 R /F35 11 0 R /F11 14 0 R /F14 22 0 R >> /ProcSet [ /PDF /Text ] >> endobj 101 0 obj << /Length 2167 /Filter /FlateDecode >> stream xк…X[SуИ~Ÿ_‘ЗUъE[–ч 2 ,50KеЮNŽHМ8ЖЫиЬќљэ–ф„pЮБЄжЅе§}н-Nю>L?ЫxФ#*#%Fw#.%M”Љ8ЁDwѓбwrcmcЫЬЖуwгЯz”вT … иh"8е‚ћЉпO “Ъу‰`"&7y6š,M3OЄJШЩxТIaмшOт("ŸЧZгv~Цьf,рW пЭKџmЋЧН д4–zM"ЖЅŠнuJN•eзеЇг——š43+j2Зl4сZR™*hpšЦс–§гДБ­5MЖœЖЭbњPєіЁЊžІ‚OГ&У?КьVХ[–RСхp№Ј,%сi*Уy"NЉJ9œ‹D<˜ъžqАO’˜|.Њ&7pй4IЩIcња4хм7Ў@/[јіНГX1F‹T [€%…TzЫ”8-/ГЦЎl‰Г:уєХŒF‰оН8š\“йxЂ%#} {i27xлй2џщ›—І1OЭS}Y€‚=rNoSЇnЈ„ЌZе}gТ}Г€ЅŽ^"б$Пнžћ1З]—е*GЂр`пж}3ƒAв­,лЎщ3мД’qLЮ=щmс'м/ѓЮњЅз(игImS9-#RШˆХЫ„ |hzгЌНX0ЮрА„{ф‚ПCŽDSЎд9цеKYTfNѓВУHц!Іюи ь9л6_”S˜ытtmj ћдыњ'ДІ"{œџа$йЃФгњˆЌЄWx; ёС}cBƒцM eўХИЪr ­ щќМрmяXЈ§ТZМ/КМіЄї!ЪЫrчЇ!haФХQ„Ф{С:kжuW-S/ hР›uН 'ЈlЌбџЮ2н‰1dНtАФёЭљнЬЎ‚ќЦјGX˜0rнŒc@9Щ№Чn~€Ѓ‹жOЧ›I%IЗД~€Чн28.œБЃѓљщщ)оL“лѕЊЦЭЊ6яD+?ъ-€v&Dbяx,iђnЙВ\ѕ­cSFcСЗВn R›кЊTђщrHGAбАz‡Ÿf!wЛ=v­hШ8шЏ­WEБwыCрС•(k<.РlуС˜хE’b‰$˜"е UфЅ< ЬРœЇ XСt[0iѓDQBlщЅ€€ІђUе2ЬЏќ7[g…У Д;я!•й:Ш\$ЕО{pІШњb@з[TХ=єІіЙ=?›}Н‚J@Є<˜‰n:ЋО ЋgzРЋPxђxлЋ’mњ‹™€ў1bПsУ JЌ$­"ШGbЯд—L8Kѓ”|An@ФОŠRŒŽ8p‘ћЏ‹§и8Е&ˆ.СЙЃ}ЪфVЌGY iЁ(†M : Л (х:pвrѕКя{жЭWuёZЃ…Ќ€СУ}cЬmТ—BNДш—Л4‘aMmлЖj\Jт‡Щѕ8“M<ŸЭ…JЪ^уУ‘?Ц™EПВ^#щ2%7t\уЄ .ŒЊdR\sљ ~’Р,_n дџ‹'—',^;NSQJNЉџ^V}i\Э[?тмˆ чЎЦ”OиефїАтФ6Mр(„+ЈŽНМХЋЌЧм7:Л2vќ–ѕф]n3/†А…ЬУя9s—ББЗЬN>фvл@_-V2)л~рh|рLLkчAИ)+pЋ…-–Ж1]еД‡^FБ  МЗ#Ÿs1БbiYVEЕXOЁЛjЇXЁ”ѕiиaчР!sOg7Гџ‚Vƒ‡гpФс”юН‘ёђSoЄ!%є|П>Q˜‘Чщ=ЦG_Ф€ !ЗШ9М“Аё‰о…I'Р4(В7ж`ФЕc o>"2 •/V1ёЪЁУ@dhЮсœPZНУйVа(оФХѓ›S aCи[уHN9S{Жй&в%JƒS\($є/ e\GB‘цž ŠѓІerПрЙі…‡vAŽAKrE‚ШўФЈЩcrВюьф%o­o‰џ—"рmJ“Wќ…< ™Xъ7&РщdчI !\Ђ хbv4s)хRю:…CV:]dнšFkwoС Шkџјƒњ/Ш§?:ытjвй&H'ЎТяdБшпNВNцBƒі>Е~ь97ОсГњ{А*<:ЋЇI_2+мZЫ Ѓ6љUЦЁvš]xЛЅP я#M",™vvхŒщ_œqъ0ЃŠџХрrCкUŠЯ?Ў?Ž˜цЕІu‘^˜у\ыљьŠTЌ5+HЖ p…‚ЄЊУЋ{Xѓќ&эК… <Ќ %sUšpD­їƒДЏСЫP%ЉЈ_єюпNюšPњї#WPСS> 6ўЪ>œо}ј ш8 endstream endobj 100 0 obj << /Type /Page /Contents 101 0 R /Resources 99 0 R /MediaBox [0 0 612 792] /Parent 85 0 R >> endobj 99 0 obj << /Font << /F35 11 0 R /F8 13 0 R /F40 102 0 R /F7 19 0 R /F39 40 0 R >> /ProcSet [ /PDF /Text ] >> endobj 109 0 obj << /Length 2282 /Filter /FlateDecode >> stream xкн[Yл6~п_!фIFb†ї‘"Эі@вnzmбM[I јиЪNƒќћEIЋƒтЪKЕ‚+й”љЭ чћШ!•gзПг‰AFR™\ПM(–žHЪ*Й^'Ѕз ЭвьЭ6_,c)yВXrЮгЫ_TЅ—юЫ›Х’ъ4/оŠ]Ж_хмз__}#yѕФ6;йжХыып^_ќ}A џHBДFFiХˆ3žЌvНЦЩ_$1Ѓ“хЃЛ„RАUйn“п.~щtbQ*‘рв2д <ЮUЯњ1 F & ~ІЈ‹СU~z(}\ œ Ъй и”+ФiњЗэfЕйПГАП!L—k@# C’Hї(ёиІ%в|ŽИPУІ§И|иž6—CБšШт„ЕMЄC7ы9ТЧ„@pзБ№љюІ8XџБђd1Iїіў44…ˆЉ8пO2C"мХнЩ, E"ŸЬТ€90xeH,suzЙdt<—уЁЉ€„шBS—#„ДфШh _>№Ф=ащ)ЂЊыa–йG;IЦЦyяУ ),Л~‘{њЅыv"§~бЖ_МBС­‡мбК—Џ<*˜”uЛgп QaIzAЪŒђьlLE”A\ЯB њFu("y€"ба Eкаё1!ŠˆЛ)эWC‘Ж_џ1EФџ@‘јРдщ&H‘s1=‘АЈ›g‘IкЃЁ:Р‘hь†#mьhŽ2#<Р‘hПŽД§ŠцˆдџGd€#ёЉ9в Rlœ#чb—kB Є™9gЙ6ЬTТ‡ XФ+Ш$_ёDЯ(žўдђЮвЩ`$СsС9\яЙи„>Дэƒс2гbdB!L@&‡ъQOЊœ€м˜Э€MЫќыBOЉœD rвH`5‡mFGїу2Йrу•“РHq>ƒ‰L4%]Ѕго&­ЏlВ•;9п O"CJгШL& ЦцШdpЌ.$УUS•ЧбШT№rШлШ4vVєО+ТŠбn1 +˜~лn‘иIœN^шz&;2uВSоХЧEIˆщЦZЧ9v.Є‡Ађzz`…ЈšR1UєˆFnшбBfБє :’бn5єhЙѕа#>.5=ZqЁHˆqzœ 9Є‡+ oCOЄ7 i:ЉZrќˆ‡Ўљб†цб…ЗšАчЦЧљяVЭЖ[б5 СSнŠс‡чЧ qЉјбŽ Lz”gC—hЖ ЬDTЉ3X™`\ЕЂZn~э–™EіŠ%*ДлЅџАГпT%’k8МЕWЈŸ~ўннЌьІўЇе6?КЯ7­Чќ–­ŸNyеVИrd•Ж:({$?<{фšiuЇSJщ.ЊОи6ESrѕЬ=Дйп|8‘ 8ИЛ$ЄмЌ(§љЃ,§ l+‹ИuvЪЊТюЃЕЇi8йъаѕаM#шN#жн`†ѕ6ŠPf’,[jўŠ0^U=†й*#ŒЈsГЛйК5НNOGk OOяЋ:5лО;›гћкјќИ*6е Ќнw›НћЭ1_6‡Нћшёd ЯДlћCНўи*iйbŸѕЧJ‡b!HК~ь!Н>b^Лѕвг1”†ІnїФЅДj,*Д к†rС U0рz JA; +б‚Є„Иж~ъ }ЁB 3Aз™ЖБ6цHч;ЙfГЫРёTфйЎЯM5,7Y‘mЗљЖ;rчe^lѓьЖЬ[ЛЦ]ЖпчХ]iЩ†ГђjГ*ЧУл“ƒПќб!0фVАP)V‡нЭf›Mьр/ЂмгЏ0й;_rU€ЗFё)F}yYЇ,ис0МАеЇщˆIQioxѓкŠ*Є$€Э,§д&ЄNyeќћlП^~„Д=хћzиЗ›}ю<ЭŽЧм ыж;ШK"ЯYл)љ’•S—N3V•ŸiЎЎўЌ™Зн€. GЃšЗюpФэvm1єђNŠsdНчˆіС2VОнOVэ~>wI>сaщЮЖu6Ч[@?Љ˜j?TћŠ7—si=• Фeo•V[9.\Л]ATjЙЉ GOlь&=‘Іœо,ˆУЌEЅFœ7Ў‡Е—іэ[AЖhБ‹wW˜s+ A’tыrпоБDФЬJ1-чmдŸGЗЌэ+.іTj\˜ј™`м—O}ЛsЪ c3ЄШкƒєl 0BЁ>$Гg„ї ЙяF@`х‚@`ћ^њFШ #s@jXФвƒєmƒЈcФ\сDк3“.Ђg7ƒsы”9ˆТЙAЄGЯ—O}ХšHШ{dG—  Ёyœ.С&\ёMд%ЦPъл0ьNvАФЕyеZX˜q‹ЖЎАЖyюеХqљŠGЕ#cL• АxP­ ўW}P’А{2йг0iuЂ‹JT@ХЂ]ƒјъA|e@ЧтAa‚ Ќ—щaPВhPNвJєA… ˆY<ЈАoы’>Јї˜О–ГsA=RDШšœAŠAXљ7g{Zм#з№мЦЁ_ŒЂэkФЈmр]bZ‹QђVФ(ДЃ6(ŒˆQ4(#p/LTЩ€ХƒжZдХ-КhWvэЂ PeHŒЂ]mФЈчЊˆQ> endobj 107 0 obj << /Font << /F8 13 0 R /F7 19 0 R /F11 14 0 R /F10 20 0 R /F39 40 0 R /F36 12 0 R >> /ProcSet [ /PDF /Text ] >> endobj 113 0 obj << /Length 1871 /Filter /FlateDecode >> stream xк­š[oл6€пѓ+„>ЩшЬ№~й[ыЅCЛf[з {hћ иJgР—дvZdП~‡ЂШHВЬШ P –LŠE~”NќњцтђЮ 2’Ъьц.#š e&Œ@Ъаьf‘}Ъo&šхХэЊœLc9џy2хœчГэњ~Й*wі[žЯсЌи-їлM]|§А:,LЈЮЗЛХ%wЕ$Ÿо.Ўй_Жp6љrѓютъцтлЩ0ќ#сi# шЬ|}ёщ ЮPј.Уˆ§ЈЊЎ3†5"LСё*ћxёЁйˆРž Ѕ*жTgPЇnтѕб˜‰Ј"™аaЮм˜Мнм?дqь—џ•ЧAPBcd>Ѕа’ІmОф=H wРйFR!{˜Š".G ІЁКЭ$П#ІHа1Тd†Е‘МЩiЦˆ’1”ьF)ћ˜’")F SjЄыN >&Ќ8EG‰ггшЃдхTСЈ œЕx'PrнƒЪШЙШIATшDIIŽ$6cH ю5nUЁџ:›]Ю^ОŒШ)™K‰† CЕЙа8Žш)ЪЊhJpФOщPИб’щ.ѓˆЁ’Ёvъ(ЬŽ ,тЈtЈwдЈ—T:дKЊK%C9&АЕš!а`Љt(cШp~UO эQŒ€НNŒЂССВВ~šНш%™євdТJ7НЄCН^šP‚$ш%ъѕв†rбK24шЅ•НЄCН^:PбK:дыeды%єђќ№НЄCН^@Н^Ю…іш…AџЩvсQSw;*—TbpK“HЗ$3НZкLj"jIfzГД™DGЬ’Ъ bщ0ED,ЩLя•SEМ’ЬєZ0Ж^+ЉЬ`•ч™С*ЩL/•L/•3™=NЁQ9†S`4WO/EЏ>^GФ’Š bibсљ!&–dІK›Ic)›dІK›йЛрМXR™A,fL,ЩL/–SFФ’Ьєb0Ж^,ЉЬ –ч™A,ЩL/–L/–3™=9hKrNЮци-Ъ L -,kєeЪХSІ|2%љ§„фƒцве"T٘ 0…еwPAрбРР ˜ї&ЃЂ0Иж п$яJRUчЌЇщрŒ9Gˆј”BKJЖљ§sЈhЦ ‚~a2Д€'ђх1J0мѓГ?_ŽС#Ђюмжўt9ѕA2&эq'Шўt9Fу Ѕ‚ЕЄК“Ї7[Ž‘!Ѓ0 0 =š?НйrсF$ZЉ—uэЯ–K7"ч"Х58мЈDA)иИCPЪn)<іВY;)I‰„кFТ6ЄO[)ЩeЕKǘілˆ—вЁJŒvЁ’Ÿ6S2“aYMЋ.“Fм”ѕnjC…9-ЇtІ—гІЗS:д$4 vJ†rxz'Ь ЙЅСOчB{д7J™Qд"9l–"š%Џн’Ь ni2с‚ˆ[в™о-M&L qK:дЛЅ ЅтД[’™С-mfŸИƒ[вЁо-(=э–tІwK‡‰#nI‡zЗ< nI†ЗВљaљнЖPЎ'šч62ЦHhhUюЖЛѕO“)УТѕu2ЄѕveБилfИШџБMЛЕЫў-ŠCё“ЋT%CСС&сšžfЏ—ѓнvПНƒЦ… џН§T9‰+j\С<ќ|зžЙцїюфa_.мU?–‡нwŸ уг?ш‹њ Q|…>ЪTўvcЏ>”+WX?э†Žљ?ЛR5Ј6 {ыЊXьц~XŒ !Z;‡ъ<ЊыOѕ}е{•ы{сОї§ЉзXX0Ѕ5ЬnŠ Т№Ыул†c_к*ЭуЊа_9хvѕpˆ€ƒa[€вЫЗk’§В…ЕѓсЉžGLŒjiŽзбАNIцЖ!ИЄяv7$_\кў_О!ЄqЅ`Аз2`ЙхшjДкЌ!ОТ WAЗЪaщћђхњ~UЎKwУіvQšМX}ню``зюtQючvКяlКК^ј WДмИЯН]лњ„CDpDaЅюЖе™—ћ§rѓЕ'*)rун Їй[{sс-ДчŽ]uюјЫeНw“РіЧ~y_ьŠеЪЮ?{цО­JЋiЙ[•…=њ>ЉCБ…ыbГ)wn лАйTл_Нћ_…ьэџјфўe endstream endobj 112 0 obj << /Type /Page /Contents 113 0 R /Resources 111 0 R /MediaBox [0 0 612 792] /Parent 110 0 R >> endobj 103 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (F:/Drivers/GCC/msys/home/Andrew/crc/new13/doc/CompilerComparison.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 114 0 R /BBox [0 0 792 612] /Resources << /Font << /F1 115 0 R>> /ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ] >> /Length 53023 /Filter /FlateDecode >> stream xœь]I]Лqо аИЫФ‹kЮ`xс!A HвШ"ШJˆньMў~Xѕ}UфЙjѕ“Ќ^%ТžКШbХšXфН§ђŸnПње/џёЗџ№Л[јѕЏoПљнooёіЇjМХ<яЅмк їTn9чл_ўуу‡?ўту‡1ю3нR їžn5%ЉOЅогp”poЗџ‘jЊЗПџјaQ§Џ›4MQћэху‡у=|ўhЕc‘-G5`ЏЯqЁ]OxззpŸG{ТЛ~дћ<ліњ’т=Є]OxззvэЈМъŸ>~А1ЌЉiŠsic8щ5Тђt™Ѕsвv­ЯвeжМ~ЯвeжvНЯвeжvНЯвeжМ~ЯвeжvНЯвЋ3№0K\iŸ/Яd …81І{K‚lŒмюyœ,и-мc91XА1FОЯАзЇаяѕЄ`#Ч{>яњZeflŒО†~Žд #‡tЏчH­`cЄvO' +иeЪ ,и= ,иs ўDьѕТ%щЋlŒR.ѓMxзЗ!,и3нЫ9R+pŒл=ž#Е‚БDпЧЬdѓ†№™ГyYfrГѕQІ%gnІ•F:x4‡ИКЙ9rУ`7ѓиьцѕdІ +яивС;ЛфŒ]@FN‡“ђ-h`ч:KФ#•Ъ‚1QkџYж&ЧЕ*uQ9oљжЖЌў/‰!щe}t•\пh§рЧVwу˜ЦšВ}eхпќ•#М#ЋжЂАŠ0гтMБ3 “ЫŠ0юБЂ`ЉŽМищw tЅРў +'еguЬIЙhё6FхуCЇѕУ{јДЎ4иЧЕЛdoфЕїБ!WћeJ-ы>Їэ?ХPюв‚Е5ус}|ZWьук№kЄK0М‹я@ыJƒ}P†Ёз%(!ќRrž@ЗЃ`мs?0Мя@ыJƒ}\:Ѓ7-K–Ou‰=MЋєІГ?1vVёР№>О­+ єQkЕRLўŠа2[ЭщРc\яЃюzыпївЙДgзDЁ.›cЁЄF_ЂFЌЎp…“ŠPв‚ •LялїК`яh_JY†Сйю њНє‹АШF-Xb5ЇУ;јДЎ4иG19’–СлЩ=€m#х1„nноaј†їёh]iАЫ *эћ,`[0іиKїёк4~?Љ+ єP Гƒ{Ъ’іубp;ИЇЄ‘њР†пKчвž]Œ™ Ž(›]­ЦсV$ф;ІМ”qkоНw uЅС>Šн щ"|žzЯri{E’Kсž m СЛј§ЄЎ$иCКX›ь˜їаЯVfjйY!k?ысї“К’@еВ‡фn>_VS_‘ˆ!6гMœ*p СzјЄЎ$иCq5”y—1Џ.чR•Ў‡r–§OЃ– ЁkоСяІtЁРю-ЃБAФWŒКЉлЁžЛF ІRЂм r У;јДЎ4иGqЦ у[„гНќзŒV* #ŠГ*№ И†р]ќ~RWшЁz‡Q0‡›8Šp(!ђ c§ƒИХ‰kжХї uЅёќWEњreљФљ\гчa‡%bR:уKЦСЖgи![РТL<Уo"БЯАУњ˜ь№gІ oБГaОŽ…ЪъVв’^ЫВЫn˜H}dГ†ИёІqЫ_eLkСŒ*0„Е Вк0#TУМT“OЋрv8 nz‚сЅaЦŸE“СbхћХТ}y|ХYcGмAуЫi^‹ЃОЂўoGю_[а7=бs_+]t?Їљ&‚:эY•LRу•еэhўхњ'zМ№!ћЋџr§RВдTЊз/Љі ОЂ,лTn}хУo!<Й#ЧU}­§OpВКВіbизšЙў‰юјv?FўF§Мй7}bhгіхъ':kZzGЧкCПпЈЂeŸДЖП:ko!<бъѕќъДН…№D“Инљк пЈџ+дp[N"Л— ќ\ зyЇNІTM GъD;[jŠЧаТЪ‡юзиПŒzЦў“ЈЮ3іŸжЮъgь?Е KРд№R• эS 7ыЄщсжaѕS /M Џ‚ЫIв†Љ†w ЊсUž.чBЭB{І†— „ГQЊсюЧTУ^@5мэаУдp ƒЁyaЕy џЗФˆХпзьuѕЊЮuаЃ§Џ-ѕЗ“Л6xОDїГЧфr_žt‡EЦ Н<†ѓПЁщЕЩѓ%~ПѓЬѕ0ю3‚[ƒї‚Чh§зЗМДx>Cѓi6q:_ёwћqtшАэЦмЎ7Хц` МНО8ZsuPО™ЙзЊй‡ЩЖ(OO’IšŸlА)ЄQ0cЏЮћp!єЋђ­”=VPMсY“ƒˆnА[ЂЪ4ƒБMŠ/Wш“а ’ЇгА‰г M'A‹Б%ъDГ)лДФX “jерdзq­СІаЌWЄЋr#Ръмѕfvј'ЌРПСN‚=${g‚fЉ%;™!3/Џ`И‰чшоў8Ы^љ}Х.§aїќА{~и=?ьžvЯЛч‡нѓУюљПeї<}ќpћ§?ўіv;-‹|ДьЯэЩВкі“eIžиAНпќєёУ/џnЁЭ{Ќщіг—VН…ѕ_М- (y)Јfљi}=Ш3hAо.ћЗП ћяЗŸў№ёУяв˜гgНHям‹$5хБёgz‘пЙ]#БНH?г‹ђОНѓЗT?ыEў™^дwюEЉђ‚Яc/ЪЯєЂНs/†*ОЧ^дŸщEп^”eА—ђY/кЯєbМs/j<жЧ^єŸщХм͘И<‘–vgОМ<с2oQnЉ•пХ:KЗИЬM<PѕЈшYЫWЯš†hŸ–Р,Š]дА7мPsV '…zThMЧ'Х•;#RЛTЗŒъЈШ†jЈEPЃєJЁ HПвRShLЇ;QPѕГЃB'di$)Z‘ћМ‚,WfTыїЉqv-И ЛmT'Њ–KŠЦu-  ё€ŠtR ћRсeІкgЛМЕвnDЇVзXBJ  EZEї)§ї5“ФЊаZKБэ;ъ0пRP^ѓ,qГЖA‰Ъ"З‰‚)е@­РЭ€ІбM жЂщW" fгЕіВ8ЫЮŒВv†A_Nђ”еъєcVAВ`іќЦ2gEСšIS($РЈCЊŒ"1jAQмЮъЂШmъDnyZС‚jЯ Ѕ@Е0Р- И-Ku^MZУZаrзауDфхЪjv"ц@ПІж4}ръp$cBўNЈŒкп л$ŸtЏЮбPАЊд‡BВžjQ(а7iAAэ)Œ4DдеЬ>Lm=d†m ЊєtHиQ ЊP€хWя=Т•`€въЉмКHYЁ‰+ЊЇRJ:РЉVљФфŽ_rЃ[ ЂдъжщzСЫ%@ЪD­Ќ]вFˆPб–НniDUПyЏZ=ОRЕ?sD@`ЕHy `ѕqAЄ (&""cl*ѕеА TnК„ЩОњI_ ЅЊТM! ўј†iОSЎ.IjK€@YЁк њЄИ3tЉž-:В,ž‚x ОЋ,w&Y[&;qРІ•9A^Џqž‚џ“j…хЬL№rеJ§Q2ъЁo3 Gb>MўюЫ ъŽYГaКжі’ЫфœЪХ‰ФюдсJAъZАDЩ”;XEШR\ jPŒЄœЕК‰Ц“>ЊДiвt(WШ>€4е$~l“МЦ+ЛЛ1 ”#6љTNZОУЄєZюuЃDШХ‰КЎуm­E41$ЛъE <ьIЫ(иŸkо$чEDЈ№P(шОб4#jБ~idок“ТБ+TљDх”і$]YхGXžДUз9Щ’омАщз•0PХЎ_k;"p˜Ъ•[гЖ <4Ё"a*‡‰ $+š)EђиФBХS Т"‹ћ…7* NмкЊZ+KўTiЛtХе,У0Т]hhоП~FО+"Hћ ь%ГХўс™ЭЎУ!TuЈJЗŠИЦDTсYІ$Е=…жxфZ3Ё<9УQLII2Х9U…šnл*ЛT2VlлЪ o$lъhъвMа™™ы3HMн|I?гБфCџZжЁhEžŽSrГЦŸhІ 45Š№e˜S˜хfмИ &Л9Ь2@й­ євeKOјPзЯіŽ>wЕщt ШdыЮРЙвNLR^ќll>œuХiхL7­žјN FN•И1aЂЃ’Š §Ш„lГХ€a‘ё˜‹ ”ƒlqс3-ч sш№ЇьtАкВŠцуЮlр*žЂ ‡^њЖИd$v˜ЮŽKАЎDлФ“2JVБZU -ігiНFцЉЄ‹ЊœнPЛtSaС@ЄЅw{фТ„Ј \ћз:ьD“A„’lн2I—=ЊмЩбu‡s&‰€‚ЕГFІm1…СДџTа•У+)›&а={ЄNш|A˜$lЁ€ъЂMgŽiцoАЌ›2DMаѕ(Њ+йŠ`’ѕъЂЌэDѕ’"Т MЧ UОLŽpN ZR$}С,*‚™0­ВЭ;WOфˆ@rЪЅuшХ€1`,ƒЛjЊfrЁюЪЕТцkіjєѕЙhfjkБз(˜'ЪЊ˜ќ"fЛЊЛŠЩ’Пc@ёЁOG•ЊвыšЭFд0997ˆл1двЄ0FiмбtУкСy–ЛѕўйЁ'tЊ6L ЈХюъЫЄКђ{УˆВ:йFW^ЅНА”ЎМ<2 ьf+пЈМŠŠ0уП›'9˜Э‰ŠR™jБЂЁ\І GЈиЁу‰j’wQ\h56 ъ№6йœТEjш=.™У%Ÿ3Ї86$X"ЊЩ!§:œ3ЉsžbceЂ’ё™Њ ж3ŒЃоЭЂ1ЕілSMє_Y*Уkk‘Ј5Тš˜jfеџ!iУЊ ѕT‰Ш…гІМZz6ы~hФxьђU3&Д6dlъ5QW_џёѕ H ;*s—kЛ;(R“ xEbв7 vP$jBћŠ\(|YмgЮXœ8›• ьНUžхy …d(Y;ЃКВ2)˜(;$ЧЛ™і„ЊBЙ9ТгKwкN1žz8—=o4XЁЛ@z,>U›T2R вdˆ*J’’.NМј? Шˆ@oФЄЯСi@`Nš2Џ‘ƒІPB4’'ІfQ *@i•T)+e"ЋUЋбƒ…Е ŒXТЄ! scвCWƒtYіHєTЪї‰ЈC$х|з­№a}EX Ѕ6cRqKпL‘гб'qЩD‡J>E]˜ЎŠE ЩђЩКЅˆ•зЗВвшDІ=!ŒЦ„:кЎйњ58'%ЎЎш$Ё&+ІШАь‡ю(ВПљˆэЄї1eѓхl=.иЌ2ьЄa3•x]KИG›‹кLz дБ[ХDLњˆŒzuйf93ўЪйЬ]tlt)€‘ .@ЪP1њТ\LдунšTEЉЩB* eˆKТкbЎ‡еШЗ@ot­­ $ŽCв'ЊЮlёшŸNџ€‹› ьњ@q'єvЋжR@Uyюatqv3oŒуez›mкUКIеOU(BФaCf@eВšJ{)вЪ*ŽŒжмiг$АBрЮEІњФШ'b" ГнбЎљœ!pSЋOА@X6TпЬŒЎˆ(Kњ Ю“љЮ0ЭБ™<Ъ`3D˜.2xаŒи?eЙcвкК‘ ^DN„dnщN5Š#УЏи Žzх‚иЃїЂC#DШŸЙ ѓЦЈPтј4о}у™Ѕъч6ƒб~а„€йЬ ъє$ ьЦ |w0іˆMWШ—ˆšДhмS1kК ‹ЇёUтSnuSгЈ;ЉcьMY%uшЦц”зЊaŠ*Ђ s%CGMˆРXL…eŒ@—vš8•|ба0„Р@ќ7шП H“ЁєT@бЃ9T јŠ x†ЂsЇCB„74C&ŸD(=j•OvEq Ё^-BЩ2Б+д1я ИХеeЉоcœєtKля™б+нЊ|ƒеVЁŸяиmьцтЋA‡qщЩ~!n6БшЂюd…3Дc˜dŒsЋьŽƒEЎКИQe‘ N­#ND€Ц.`ЊуFw‚[Б аmŠ#ь™I“ЖЮ‹щ:уЈЋHЇйKЇЊnюА™tlАРФ‚‚ЭрмW94дVž_U@˜•д&…юУ Y‘ю2V&jЂAЁ•Ћ*іы…ЩдЙпщЙђ}к<Д ќ^"TŠЬLж_!QцЫšЃEЕwTW@T> ”Л i>џ0`“иыtZ@Ÿƒр•‰Щz>ЄPЖ/Г@Tђn)юHиЪнФXр•Ў>Ьuз5шЦ 'q pЃVfњ7€'DОtР0ЊЄЖп9–хМBNqє#Й[P‡0вбuЈœЦУ$-иrlA4х*(WШУZ ЙLk­а…rёЏ*r…Ю|2:Rfњ-ЄТа#Sž )„К4ЭЗАР3\ЦЦ 5Ѓi2ФkжЪЪЏb”=;н КR.Ђь]т еѕ*`М[&дМЁЊœž#8Ўњ‚еz]гmТИC‹@уT  ЅjЋЃ Й:ЩФэIWˆkQЙобЈ \ЩyGи/@d Jw]šА‡ЋыyьѕQ!}рbЬbšАVысЁUа*•1C*;@ЭLGAЇіCгiвјMГ‘&@#МDŽu/ШЭ„\†љ+ё‰ьЎЮ(ъЊЯїD˜Жrq@ЋЙ[;l s„XВЪиw;yеJvЁЁжžЂ–-‘ ёЊУˆTЪ&Ы“mћ0JfдєјuwЋцэ*IMК ЏЖnŽО:ћїљИс:_?ŒЙРм™ЧoЗ|!dq$~EИvЬBўJхŒYHњіъ_ќe—XЊŠыжја•ЦчQ QNŠž‘я-pз‚ ЏЇўр PG…+оАxуB2сгpU;цf‘qseе†ђ‰Œ39-((`uTЈЮнjВRRхУ‘Я`I№xSЎi0ЕZФ'‚ бBг`›D­nDV VЋ"nЙрjЮCДщк"Яэu  №нˆ.)VScАYhV @ЋbиДdє2…@Ін)Јж,‹zсь€f1\1[фZ-fP|RЙНъsп’iI)HZ0П„r?‘‹#Яa]хЄ ­s„Hn)Xƒ€Ф—Й[{r‰БLƒ+з*l2-Х{21lrA0*Афl&i#вшуBEH28Юп#з‘єˆіš.Žkz4Ѕд`TwN{fдM\yvьЬFт ЉК›’VG|wъЖфr&ибf˜Ÿе€8С=EŽІŠф—ЎУ#C`*Њу& >'&F—’Џ†}‚$(ЈЈцˆъjP„ ВMƒ(ŒхŠV7Є‰~ШЂwФ­,ЈZ[GьРe$А;сRЮjЦў:>“Yч]Nh=Д6№.ІЁ Њt `Ж…QЇБУ 1Ў‹[ 8ТTuк­ A.s{Ѓ;Ы:№cзп%еHІ’­Z@6м uз0- Є(XлД $rrщЦM ЙЌTЛ„v~;€Q’4ІіСOœŒ!вGОЁ^шњvЉr’г˜…УКФу”aИ”з.чФ"zЖи5”Ш‘lIѕ#‹Iz:ŠлРУМ*žŠT&ц17“=ЎА†ђ†­IŸpїU$vљл${ F•РCLnd†*‡—!ѓ`іЪF‹AФm§ЌnlЩp›CЎlЭiŸе…`ВЋ.шUЧіЯЌц)и‰АФM­VZb,уЅаDŒГЩŽЦЄвdћ4g'ъшьvштЦ8_‚шнтt›t0вР q"г%—Ќf#eœЅAЪЬSч \MЏEІ†BЉiHџN6ИЬЪК…трДєvсЕlžyfЉ™žc†Ћ*2у*НТДTДЄЗ_Ё€Dь_Ї~РёЯдяэСŒ›юв22r‚ХegЏ†ЬєЧ€­д‹яQЖД” †JtКрр3`V<ŽaNы2ЖE@˜ЉХ m@Њ˜ (їiA{§?6Sї2Г—“л‘Л1-Y—Šqg‰tС\шрФ#VАN“‹ƒZГХэГiЅцB”‚­sЂЁkЁшщŠQ›v;УТяј3aЭ*f˜кЉУ“ *b“P‰x”Nйл /kє;E›TгЃиy’Д‘„Af-#Л/ѓГ3`ksŠGВTf–%OSQdц „ЎчШд2оƒоd@&УС<‘ЦЙЈЎЋžуRyрœ–\Qмcp|а>У2B @œbžHЪђДйTбЅ n›`Řѓ”ЙхЊwfкœ 1ы9ѕнђж˜>ЎIЫn­1O™РLёЃЁЇœфо™y@a№3оЏ7У”ЂЃZ sQ+F›Щƒй&Ѓ2 Ї!мŒ)›ˆЗn“8VБv&џ!жaхŒц*g3Уgtр;B) Žч—Шъ’—Њ5uВ›Ьвpxw‹ Ч§ЛКА)Х ™Єpъ$y0П€ЙЭнй-=l˜ І* ѓУq™В<Ш7f3odЈ“Aj&ZL LЫgуЈђ™yяЩЬЬ—A23qЙ šШ p ѓЂ™В“c1ћr }оЉбVcшкџ €Ёn):M2эk,ЬeжeBq‘31V†…yœ‹Љбsad7œШ.燓MPЫ™юјg’‘/€lfM3tдФм/IЄХgф_ƒ|Xэ­ MigO›ЊіДŒхceА3аСѓCЩ1є*.rtЌ>}бЎD3”ёC:РЂђ+{†G4=A•`”kЦ‡Эмžб€д7яs Ўdк“скцfцw/хеЮЦBоМr$џс†'9Ѓ‹PюAžI‘™г— ЋoђŽ§a)ї< Џ>6нUœѓлИБ`ЯiЦ_4ЛŸчСxcЦЮ^GB—›oё6;WEhh;F<жm!Щ@…/ оNЇЩйMЛŽ‚э‚hТ€г‡Pб(І7*L Њы2}ТxЗ3Od^hЈf.=КПйјг›‡Чћ )'§ѕ™}Xњw5p˜Ђ^Eјщ™8Щ2Їx~$№йI`JюaѓСЃдюМ2ИфЄBp—}•,I=˜O@цзфЙ”D+A3_Ђу`И<)gх$ !їащъ;H‰ ZгКбSдhбPОоЂХЙфWjФ~гL …RТ‚iрЈЕМ^“B БЕъ_jљ$\Л}W!‹­З ƒ ФЋхВђzƒvеyA|ЂМbа'ЦmЪq ƒ‹п ?-­Б-4e ЂD +’ЗO6TNмтУ#Љ2oЧg8oьЬњ”В…Иу"ј,ъ|=™ZEѓўфAšи,"ЕDŠBд +Б™зšЫћйKђІX=БKqPŠ…№™\bš52)ЄР‚Ч]Ћщ­a)tcь‡И…AWЂЗ<№™ьЮ1‘™Ым? ЧщL дј‘е„к Ѕј€œXMg Н Wц“ю|]g’—iЭg]=яЁћ,тdv‹Bhй›! ­ЕЌrЌfEе4T^•™ЈЅв  лЁД‚€жxaгVвcЗџ3чІSKfдFц+@A\’ЁІijQ К€ЩRP@X~№2vSЅK‰)дьЃКpћБ@СФŸЇ‘D“7Ї’Ÿ3ЉhhŒмЕa’/В‚1ХзЎh7CцyFƒLЭеј УxЕneŒPkП.љvеPMђЌнœЖЄњЮxF.W ТњУ2бFDЦY-П`Й сц§ё)ТW"`\ 4Рwœэ\,щMђ[r1л{‰!ЈЊЩLЙаЪŸ •xYЁˆКю„ƒGRЦa Ž}ЂgС­’3фŠдњ:l ]c5UШШcедkТ‰‘Љ –˜нѓ ‘=rpЉzЉ$аiЫФхRaЦpŠс"D-IZгТЂHUУхbђ+с8 Ц1ђ=†B†ЧBm”`ЇŠ“r3m››'ф*—з/taG4 кщ6MWЃjљf7†^RѓбŸшjŸuї€7­?сяRoёrТШ0Tж;В %8Bfщ#<ˆ3)0d…J3ы™И•ИCЋЭИсЦ(c7фц­"хЂPЯќЈ 2КЫу”‚DЁрЦЫѓў'„\`ЈХmAЦW`§1Юб› ЯбœзšEL…чїо‘uЦЬt[jI•pBZЃќ\Є#ТOŽЊёе jO@лtлJФщМH5baC Cфjф€n3U ЬfьАsЛ…Я6rТwUи#zш mтНќ„ ‘ёY](АЁџ(Фб9с‚с%|”bv 1š˜]?ј№ЌJмhъ›аЄтdx&]/ёЂœ;Хв#еГRˆWy€МеЯловёN\Т=рУ[šˆ5moI­ЬY_Šш,]кю,uцЉˆш~LcГёзaЇ€AˆƒРд=ŸЪYЭwx{DŽ<Іu-'*8ƒJХ р1ЩЫvNiФЯ€nВ}„q;Z6х‘asdьN­ЭЬ( YŽуђБpфЂ6е?qVІDŒ˜Pxј†g‹>ЉіjHт)iаЁ%Ф6†щеƒ‰ЇФ?}Й) 1)*.?9х‰M; |тЖ;o‹р”?чьVР$Ммpв/‚ЧвI3KЄ ВOзxB…‡ћн™ў&Ё5Л+o6˜ѓИKd^~ xЦ8р?тљSІрh7э„ЫŒъ >\ŠФ5Ў˜хŒъСЃBH РcЂL>ЃжnИб.xžЕ|dЖђrN6мŠE xф–Ы№ўkх’qt<эІCђ‡§њ4ЋёsМ1šEЪЦтe7zG {Ќj2нўД/‚Шпœюц„Йvї;ZБHxсЏѓРж&RЁŽ9Ж‹˜˜џ*>KƒЖбчdЮЉ?ЁЄ0O'1Щ!P>ЫиВЭЂМYЂ0цxжГ%й0YЬЛцЏку>žћ>cёZFф›уМ\‡§IO6љіLж8Сс)тE–вчhемHОYнЊХсS=wRД`Ђ ѓGП…ЬрЩДЛ.ftЯХbŽ№\х‹{.ƒ9№\vuУoгК/M\>m F™@б—‘Ь}Іу2’љо „ЩŽП/KoŠŽЫрMsўlЏуРsбо Ц :.~А!i№Оћ-ƒЙСА!FĘ Ё0NЧ…їЗчвЛЅХ ‡Ї{.Ну0žKяvщ•žKїЌД–Od§u8OщЃы‚.™ывЛ…i €tК.9kЗЫ›Ън$К.Н[‚рD5]ˆožљt]ь ЎKo–ЉЅуkМzKи›%5ЊѓYЂqЋ;.<шнdy§зЄr—ЗуТьk8.P цИ4ЦЈнqй*pyр]}žЫаk№ žrІЗ№$rŒЇув№d%—†Ѓz.mšЛAЯЅёю<—ЦѓYx.P!‡чТ'†=ЭгЄŽЯЬ|z.ЇА№\zАСŽп!ѓє\:NсЙ0‰ž‹ZлqщЬъwЧELЂq:.4ЁшЛьъ:мњкюKЧnИ/LRІћЂЯPžў -щП0 “ s4Згq5žŒpt4зBЗУ;сt`˜H†йmл‘mVмщА№щРtОрN ЖГy0иэцС0ш‚мЛ{0И{NЦMм‘‚сL/`]x0|5c{0Н˜Я•№нйн…abпіa˜Rы>Ьˆ–иі+l'Fфіt'f$?E+ЎмЌ ИsбCoћ0Ч+г9Љhм>L.|иЫ|љ™‘qХо–з_ф›–~§ќHу3?&ЧТ+RП(‹e‚Џm/%–7@И cV ю-іSШMѕиЃ2MG pеgБЩQ]ЧйRџ МS?ЬЋ>ь!F›фJГW5Ѕ@пЕбЛV @IЁŒ ˆkAЕ…N БЅi_тR(йw  ƒ8ГќZтФ—JзпNœ@^–@МАй ]юјЁХŽ /x Уmh(*цЋ>Yz’љЖ<’ВнТ•X-€_Ы DўŽ†Ъ CЕЙ[ђЗBјˆЁ&Т]+э)фЊ5 'П &”рЄ7!˜5о†!3йЛyащ` лD5їёvuCѓ‚ЈlЅ§9vЗ’9ШЩЃ;“пU:(Р,р ˆYейлт,ЁЉЉ˜цзjИ|)Ж )аiEѕ(№@‚нЇ–0%ЬmKwќЪŸ‡нpy\1ЛV„7IЌv-C&-Vш Еdвmчњ Ф^2VˆАaщщт†fKЯАV‘ѕу}Нy'SрЩSЩо)i]ƒlт\/L…˜їoъ6к§— dЖ(‡о.™.їyЦоЕ’7)~QžзGŒ§˜Џq‡єpY‘‘у3 ЗТCэcŸQзVћ@ЙX‡“Iыx˜сдu&hД!—_ 2C/MЋ™#5шžЋL\ц9ХІ+РќЪ„ѕШФdпЗL,ЭЗЕdжac2kМ:ђєл Ка~AЁiЙ"–Г:Юкзˆl7`ЁЫ4Ќ˜kjМioЁефFr™тИіVЬ;>†І; XњZrѓЕ л=УеX~l6fz@п€ˆyŽУ‰ђа€ЁŽююT8Cfn/КЫVхХ570љJY-ІЃіЂЛOѓ’їќjn. 3lнn|ЏLхtмL‰Ѓ`{ш^y‰‰щ`–ˆ№QO„j3І,"RўЦБВжˆPіМ/гДп/б:„рІoЂˆ]СW3ћё‘ФЛLж…Ъ TQkЁHkнЯЬK’>VdЛцЦ‹ Кc iчъ?зШWЭє№CwdKЎљќКЇэ ё$Б'аrF[ДЬh$В"t™q"ў—ЖoйЙ$GЮл0яp–#*%яфж[Ар•е;СЋ†сMїFПОN|—Ш<]UнЊ‘… Lf2Œ{Œj‚нre’_bMJПІќjšнT&O9ЭvєD Ш)}ŠяeъМ}”vЕђfR<ЫЅэ{Н3Џѓ–Л/f_жлA˜GВлўЂдєЕ№Ў“УSЧЇБЫ4c9 mЃГчъс7qнOо}Ть§є&OІsœњШNoЫЦRZгWuщыІз]:ЙЪkєтіJєД nх‰%вMюО”l$Fƒ+бrїЛј5’ЦkžzcJUFa3EŒdVЩаKaYzИŠGйвк§л.‹%ƒ$Cм)3mL\С—"іЕdGvq!ˆ_“ьТЙ1JјФ!OKќRа_/Щ БaЊ*MfРrjюVQњєhhњuфБйеQPvц2uтЊzNЬ)*оЙу7wuюз' Ћ•Ё–j”_е MЪћ (mНцЩиз.[…BъИЛeю‰tмЏŠУ[• aЃАlњюK˜ЏtЇ_pŸ hЊ,?aёtѕ6њ*еїћщо9­"у{ыvк @сцb˜МШŠgn4Е@г–МЄTВфФИБЎ|‰№ЭЛє{†/М:7|ЖЫЉipf“ЮњМ'jLшнеПмДKйRWЗ”_3 їbЗ$РфšђЂє#UДк{@ФП ЋсЂ'ћєрТС‹sЩ( ш’'б№р;ѓ^Sк LлœНY+ЯЧ] ђ:эsД?€ю‡эWDл—еѓ˜ЊyП…Кь‹RЩ ЊЛ№цrЬY^\[љЮMU7ијiК%в ЊбНVІ•ѓеqkЩAАh"X#яjпQНО“~щ‹7Їв R‡­LЛQТY6hц•oЮхЇъС{ђл†иМђp.dЯ"MІдdБ[Е8Œ ‡%г”пшІMН2ОCёk…•зbŽjБ’Н№+:ЁЪї ж~aдuГWZўС/оЧКy=л:іЈ†{Щgh*|T?Жк ‚бь5vC|щ*Ќx=œўjgЉрЋ•HwлЌ ъљСn9ё“zњNi,?БёЕВ.ОЂG~ЎВ2/ъkЦЙ”ц;“”‹лЋй.ŒЧWdўˆшKЅЏћ"яžпWг?Ъ06–“|ЈщтxRMпq›пjњ&Ј[Mџ1ЧзjњqЌ(мфѕ&}8™ЊЂ9OвkЄДєрˆ†Х†@ЩHеУwATF1B вЬЃќ=ELZ­џmN“vl№Ю›ЭТЮиŒМ€АаЌУ`*вY-С цаdRВ€Ÿ,.iКљ cZEZAПО O6T;ЋдЁє*@а€ 5сС™J35’ƒ2“g*Dе2Г™щЪ]вљb)ŽIа,Vbpe:Ѕ№№hC+ˆThJYЧу?,‚4Aybмc3Ю$–•фуr*™P F—Э#ŸВhPЂЁС™НЁт—sсŽœW\oиј$§С'(Шgљ{ЋИТСŸЃ„ Ё{V„QБƒ‹&Лx‡FuN˜Е<іАс`§KK^ ŸќGёfЇ(*)'Шы RМ[JЭy•CЃ12•Gл€Ъ“Qнв”z%Ш,9Ц*ŸA№Šƒ64ОЃeЗь…OьЮх\‰– Н/љ#}I`:€ф(јџhX%ЙЄб­œн3> нщб\јѓЄ'Ÿ9Џ6cЈ[ПXR[Я‰ѕtчG(Џ‰"@ЫC' сLњњЪ—…€CžXTќ{›зEЎуWNL„8PoЄ”ТЁ>2­јщ-“œ№\ЫŠbœtqRЂlбСЈ€№Т’_PRуA—зcс9йщ$:ŽтL|šŠŠчEЈЪn–_ЁZЄ‹пИIАhќќiЇ‚hЈ-яAuц\>*JЧдч(Ш —‰/сЌВуЯš­aЕх1b0ŽЏЉ™gУ.[ИЬ€{pхƒQй+Wˆа[c Љ‡†œ&w€ўXsrлѓдJЬЧY– qSБЁэџРcсіLOН=Щ„.R5Ј`™ŠN”€Є}$ ’7еХїш.„Ж<ѕИKNеффоІ2є&˜j MЕНp2л;ТюіЪ6ўhhЏЧ“з&4Эмhp'9œXЌQьb@/йл4VщUCY0ГЄихЭ /sёъ{еXѓє‰KЇЌтLœ_ФŒqЧ€* .bцБв<9SIКЕ5%†dlЎЫqŸ3)Б—ц­љNŒЭlЫtnLлЩ$Н‚EG uzˆа—ž-rŠџ™ƒщU\МЕ'дeВ­Ќ‡;z•і5$6ЇS>ЖиEњeyF ЗШМЪORЕЋf‘EЙУжj9ЮB€8жІДЈpSlNx УьМœлUќщМœС5єѓz(m!ёћN NЪйДl^і‚/”Вфяћ§и—}ђ$ dЃћЃ3ДуЄ—ћ§ЌМI+”kх№QU№БŒЦЌ<ЉMf˜мзe-ЩŒЫ7ъфЃК#•ЉB„q^Žе]Ne2лм9л‹кЭЫЉrЎ•Ы!CЂ’Юf".oЪ_ЮЛV{ЪЕлЙVБљхй}зXjJ"".{*j,љ/<5-3ЅgэIСƒФsЄЪžŽ‰[љ4Г,9эѕIRMf/[ћ˜’нЂw4<ЯнТЏGC–naФ}ЬВD&RnoiъбзВs{м|k S 2Hіgwh€жrPЗИ‹ћUƒ3ЫShœGїяZіЁlœX8Y9XК}н’KЉ!оhЃœ"вЃЏщв"ХЮ2I=Кв„P9ю_ж}-ХСSЕ5“C•Bl%…—л;ешЋк;]jєUsџо[ПЊЭ]јфjћЅдшwоœƒCаыЁEgdЗЕшЋкцŠ@'wLсд ј H_5t щђХ'3ЩвѓЊVhЅUЁš[“Ўф…вЄ+БЁTоЋиѕJšє;Mхт\w>йІЌРЗ&‚’5щЋX…Џ™Л>Cла2з•щ33 с›Э~№›@{*г ч9WK#аѕ@ЖRкєI–Sкt…Ѕ6}vyŠS6Y~ŽКєй3GЭђPЉМЛg†штф><Юо%uщ“тВ4оJ^ывЉTВі|Џ yъћЧБ.„tщsиo3ЯœZїЊй6“пO]КИ(щвГwіфПR•>ЗыL/Бj#Uщ“ўЈЗ*"‹Uщє В*}nz•Є*}n{Š~ФiЉJWvї[•N–РКtG*P—>ЕивЅ+Ўtщ“кfщвЇjЎ˜ž0mЛЕчЬйўњS•NЙвЊєЉм@TЅO%šKUzp ЉIwЬ4щ”šєyЌћo|э9ЉJ_Wъб—2СЅ]yVo=К 2ѕшk™'ИxI0.‰~MvТ‘7фи>юžпзЃЯ[оS~ыбЛ &нzєMU~‡?*О—њІ ЧФ_~;ЧWzє~‘* ˜wUУfІќѓ (6Œ  эќ?sp м€оадљhp“УiFаpаа4Xаs,ѕhl`o№>АlthзЃя6B8]j„* ЮСЫw€q‡7у@^ž€ъtŸЦVТН…PЈЂ—PЇˆБd™ЈТ hѓ‹‚>№ЇЮEpаМ PŸP:рплC;CC{I™>  AcийцРU ›н|?ŽUB†sЂбпў`AЇнƒг3ч0Ц2і+>\Ъ‚ЃсЙe8 Œ|‘ŒњБVўœкѓƒX7$ ‹ПЛPY+(щCЧ6о1Mj–fUVxЈmЂ&Ёрoб‘ЄqUZыfЛжКYЯ яјг\ј'Œ8ЇКіLажOдщLD[СБzopУG)џЛХФCО@КЃк‹"сЎл!ч\VЙ„Bщ\OЉЌ9Д†4;цK#BU~(VамPЇIЎы‡2Ш„E2 Цl|ДбЌtO,ЋSоУ4,H-3р Ё…ЈЪ™ЪcфХYС6I8kСтїЦ2l(Љf06Cх&ЌЄ€јѕ!ЗюcŒKЛ™?zBх H†ЏH+!uвVш ЂьтЬFБ+?ЃqЭ ПВЩ‚ЦGеa5gnмКЊююэz<клofжьвМmBЧŠ6џ@ўРI}_у7FŽ=<=B !uбОm[Ђ…”Œ (ВЉвИb§Єѓ‡ГдE@‡ЊЗХ#а_*ZЅ"Э[СQƒ~ƒVО“еJшkчиюќъ == ’$ѕ”ўп‘ЪРFJЛxJЅ•8г:е`MЮЄЅ‡ЗЦQъf(ўЃaMЄ—N.UTМ”'cBЮтqЎVA:*žъ,юнЉЯrЕž‘Ÿ€лзuЮњ?uЊ “5(q=гV9‘з!.е‹}5/ы‹OWоЯeИ; 3—Т 0 ў›Ё Јщ5PЉ”ŽЦvŽН8я {qШмМЙЄ~M—ЋƒќЩВНфŠGЭМƒ o.}йrј8’эjZя-@ŸЂц†яeв‹™ ѕ H'№фЬWЩјЪIr…™UгЄjkњЅВ&МNšнЏH5бHaњХMЊ4:cШЈ*  + юxЌТэbнщq€Эx93TdЏ€ЁjŽ, ІЅ)g*œЗёI  `­|ИrтšЏ Ј№ыЩН A\а})(‘ƒUя­k!T гa„щ(+2СFƒŠиO­Ў`З6!іэсСZђŠоСЏ8‡6Ї{ьржq^у9Жœ›ёƒ€xЖ+ПпЁ„9xNпpј~A,WvМpзє}—k_"lпўРЖ&krьYОюКЭв­Ѓ+˜Œ7pWёДђ еX<ˆђ‹ˆ+Fхк@љ‹fЅІ­НлBАШI=[ѕрNhvvћ˜ъQз=ТЬl˜ƒ/ХчG-оmф7гP‹™гЗч+Oк–'J4L’–Тю–Vм€.й™ёeѕ­\f™&‹0; †оlй 'ЖWvцAв{|Н‰Bъ‘дЪсeRЄRб*€Ыє­ntнw€J%žсБ\енбы†М ЊМn“ хMчnЉрЭ•’*}јyз)2ŒгЪ'wЇА,Ž)љ€p@a™-?Aю'•Ы1DWЊЫ"IжМЋu/‹m•й З=^Щ№ВvЦмќ9 фЋDИžAРРLž™h]d‰#ЄыHй—FЇFZ8Or#аQT*Є7цЅюŠsЋ@Pї‘Ѕ™NR>]I0lh›ЏOўA<…‚›],EYГш§|Q‘ипЉЕ§™ƒЕ1Н*нКб;†C4а˜њЦу€TYЇj<%їФ%-]јFКzрбn“QЉ8”ќ§лPMЕ@Т’qлZїRНkСЉ”њ%Ѓ6{)тnњ†тРђжб-ЪїпWVfг'\6Qbб.Ч‘юи‚cЇ‘ЂГ'#НPуxs‚лху|хЊ.]”N—FŠА U“з _ы ]ёt(Rћ"ШZ;ю‹ƒ B )њЛpЊ=§б0хб6ˆ€2s№fl<ЅСДgmNUтЄЁ €Z9oЇБИ:2No‘э'ЏХЂи ўš^ љ^ъ!яe`чтš))зоЩШюыСo6€МmjЩq`эщ tлќи;К]іЉRЌш˜Ќ™9•*7Ьš{žХЇаАна•9тьbжЋЂ`ƒ ‚@щШЌЉЌDe\kї7—@шDЬЮ‰z~…ъ 4ЮЌФbўзaЊKЊŠU.(Фb­bIŒgU х†UтцУ_'gьѓЪ@МеMhё‹ЗBuѓ‹ИЩ/VL%Рq…–™чN^рƒsн5ќcзMFYЁёpЇгЎ…Q].cќ]*8ЄR …/_єћ@7iЦ+ŽhО$В)Ш(Ѕ0šaЫN4_\ х ZЖбuи­аЮWі iб@hƒю$Ъ7)A'Няќ‚Ў=k1bХЖЃ_ЎэІ@O­‚2іъЈШs~œЄеxo›,/B2ЃеЖЫѓu’Ш“сF8 GL„gА&QЅ3›а’ы0LД•=vЂ\И –д~Mй‡]†‰+ю‹T-]aЖЗщiх :yХДЌRЦлI•№.]r+ЦeйяАдр0ž7Г/ы,pћ~ХЏlАѓсuЇиŠя’џеє‡нuНpїyс№ƒј јуŒЦRhs?JБХXwƒƒясъ "@т}ЅВ*З?їrОўЋнGНЅdz’Eфyф;‰ˆ’Ёе{пWˆѓЊ˜NbЭ“Р( qMЕщiИKэ%Щc ЪIWїќm— "@ од­bфba)ŸE2СlМЦЋ_дIффЈВФ>fDhьБ&.dpКŒЉЮцWШi„ЧЅRС$‡эŒк hqьЬСЫpb ОSи7}Eu™:/ЦнГG‹˜Щхƒ№< §$ЇˆŸНСдыQ#Vc•0~pbqсЏзыŽшюх8™1ˆс1}Њж#P#рЩkЇœ/‰.(t[ь‚у’ЯЮqЕpг“С›Уƒ‹мJ8—ЫР RŸhеvaPСmŒЦЬЬ—ИЌЦŽѓьT№XьЂZP•bˆЊ‰VRо„$ —тšY›V.($#Ъ(vОˆA'VRіТKЫž'o-yrтE‰;Jšи“ф+Mb]qšв€рбŒ™JСФˆОKЖЇкХ%Ч:Ъ“З’>YЄoЬ‡з 4? @ѓ к~Їp^%QgхЊГlнžђШъЊГuQ'4)ЬТЛgцoNˆп”Yш7љЅфqЛшšТЪZиНIg™%}DWѕ” §€ЁЪw(ЊБх/R–ФЮСr|ЩGцУhP&ЧЩnЙu@]р)TXwŒg/™N>T,пЧакэа(G;гьežК,gФ/џКЮ'UЊБхФЪпјZyб”uCЎйU>eƒ-ћ…TV‰VXВ6Љ2Ž1(6й§Ћ>щЙЮMэRŸИ n&ќуіљљwRжУ!…ЉB)›UNэв;НЧЏŽ†VyAзЬЯ)ОіG‘/ѕЌПЊAЊї–% м vч_ŠЗ‹†FuяAoЃ5hѓЩFьКЧвЎqwЧ…}?ЊMП'~c" —Њ_с#ІЕЙлmŽeЂПюшiбђл zЖRЧ\ФрНzCEц‹єlCя%w‰ј-54ЖIЕ?иЛ96Ž‘у—šoТбЈШу3d9‚=9 С‰Фж–жхЮnЊ§љф{Т=phжn`=‡ЖќMдд­шrCWyЎ>†sЭ]4uіc_Ы"МмЮЦтOб0™ћ#іЄo‡„1ІoћЃKыл:ьЪСb@ƒЃялEtѕЉій-eVхЬ•ƒkVŒD\P};!I0ј2b фsz@ЗМюъ/NД9T‘`Ёъ[!й8ГWyчЎіmUCбФБкгПMЎРܘ›3& rFA9ћv52!lпЎЌ38˜Bдрšn9 7нС8•jM,ю–…5§„уДNX›#C@ w?–е„м§HБфЖеr.|NеЇНэЧхЖуšыT-8n’ТаcёcЁ@ hэsшІH\љђЋ_Њпˆc@­\!@wЖйFТMаЈжŒRŸЮъv]ЈŽЦЮ@М hiтюС ќ ~иS”3ЦvPŸќЧЖн GћdОз'ѕ— ДŠ2ЫУkПSrC>јї—И,;b/ЪћР^жШˆйdтЈ }КЬGC—œТ™{M9e)`^KV!оЋЈo і*ЎЖ)*cЇTu= M(4\ыrIVыrСЌPbЏKГт4ЎЫп/ƒхЂЃж‚Ѓ“–= хжwБ.Њ 8k{ЮZѓ…1p*‰Ÿƒ;аА_ЊЗ†х#Tw6HЪyЯxCA‘х~њBїKЎњœЮ7*ffжљрYцtЖвяˆИЛ(4…”ЉЂ#’ПчД"eф`Йзє6Х`ѓIeЧi9VjНЦю’Z@/хuгиKq'ё{†sр`U†ŒTs8і[ƒeу ]тTMјœy Ыю‹WмцюшКмgЕeюlа}ѓWQљЩПŸБxЯ†ђк9жЅ‡NYp9Ћ‰ЁЛpVч--наEЈв $—јXифчЂ)Б…ф˜[Ÿђ‘<ќaХЦІ @6Hяtq§•СЉdg4D%”h=kє4 M\хKЭЊQйТђbЧ–Шš’ё‰`іLЫеЌ§СШЧ|%ЄЮо\“rDСЉQ[_osТ !‘іГB;ЎшяЋќРš4№їЁ9Ѓп2Щ€?ЫJыЁŽъсi4XЉ> Лe8KRКе9\Ѕ{Б†ХжYiдщ_›!~Sх=ЋыЁoЂ$ŒEN!"Ьй(Дrэ9Вп86а@iЃ=H$$п3QBз j rt„щ”нnЂй†%iЭjai`№w' фIлЯʘAAї’XXэfHƒOНї—J"tUќйŽfŽ†Вѓ TиЩjЉј}ёoптп`ђН[ќM5ёRў;IoљoYЊ)ў}Nё•ј7ЎAђ "і+ŸћFыas*юЖ€ ,ЌрођшН4E vŽэ5 Œ4ОЮ%QА‚ѕљЊCё№п љn}6 vЫŸ•€bќЛЧ*латФЪfНј™‹ѓЬ<А>б=фџГјхЕ<ИёН•н•Pсg(ж~Гбpё3№ћК‰№ћКshгd аЧOєmКХžhi–т‘Ћћб!їХœuц1Ж9“уЇћ‘tяc5њ'ПQј0œ—‰ Ки%Mч9vA рˆЩМ!Š—вЃL7МоћJƒЮQ­nЋЬQтhP‚,:№gЇп”˜ЗГŒ hцЁн“~ўЩЩJ>>‡ТрDpE@…нƒ/‘ч5ГЃŽ:ЄU‡‚тўuTIЃxvІƒˆu“,)зЁTIYƒЇKO‰6п ј’к„(!ЩЊy&•жPЂœщŒ;XЧ™UЌ–ЧJЦ …д™–tтЪ8bѕ†№3ОѓbC0OGieс5п&лй;б9yЕр“dСЕkлY–Ї‚fх`ќ"‰пvЧ.аЮyq‡pэbхАЙМѕѓйлЫѓIидІб^U‰ƒЁв}gКŒ>„pœAЫдVљMњušљjц_:ИwУ№.ЩЉoюl˜Ъ†B*{cxЯUфс§§€R,дoБ АЅВЎaЉl\ЧeŠИ•cŸКRбНЋЅВ€цyHeCNЫ† A2З[пЬ™›eЄ$рMe>34X.tCх!— љП№с!п#Ъe€bйИŠЭиЫЂAЩˆ[,FqЎ0TХIVѓг#uRЙГk’TSєY*кhС,–хВЁ8[ыZ]Yы:Цв,PT—3_)˜EУЬRЫZэœGƒO:І UЁ`fЎ7Г!Я‹ЬаА‚Ylœќ$˜AІ3@е‚pх<34,KfF%ˆfxђ!™ 9ЇQ2Д,šсњC4r{Ѓhf|Іhфoб,v}ˆfƒ< %]{>Jq э-:S\5;№ЁАD$…Б€ZyˆfУVюЌкwћљ ž#П‚aж”Ю†<‘ў=вйyHg‰ЩвйVн?KgCEЇ{WСФИ}9Щнў˜уkёЌO­\Мљ;эЕŒЅ ˆqCoŒРИ!mZg9№аШv3FgђIEїфиУh ёz}<Єь1o№>Щй# хљю…aйKyДаай№оГЅ№7тщ–ЩfgКсA&ЁуwЉPб“‹ nЄ ( Н  (ПЉslcoуиЮ'€Q<ЖВaЂГpшфў DhŒн`Ццt1€јё'Ч"šЬЬšї`WЫЙ Бј5[k†op6Цбщž7Ž$КбШШC6,п§ЎB]h`\QlHS g№Ї€sD4iг‰т.Оhx fЋб3b&пв†L !ИЖс0ё ЮMСŸнЂic€;ѓгЂDMЂ2§О/!пb!ЅчHЉBha/•$Ђ˜“жЪ#ЂrUС.v:—ТЯcШЩqyyFУвтаt*IюWЕ‘Ъ>Fѕ яŠIТ’Э фКі?\z€ЬРШŠЁeсў"С”№9nŒн€‚јИž}eжмхЦхЧq\ŽФ~3,уЎˆаѓЫ •Fё6;)aё†я.‹К§и#nГћZ7Њlч§ѕ-БПЄ–’[„UпщIчUO=z@ƒ\ХЉyь‰>Мн:%^j˜їўсђ№оSqxЩ*/Б?ruJDQпЦnБД$Ттvw6V‘ЪйjJў>šњДЪ^…H/qА† иOЌrЉq2$ЪeCNц"/@8l&эAБЊ’Ч•Ё =u'GФ†A†IN–!}Ј–ХLЙRј3љђPzџ ЯC@\IƒЂ4]Р№hK>0џArюЃ˜‰Ўь•ЫЦx}тА№zЮ UAТ4H!јўА9yL6цЇь)Лар^иT1•Л`Y94u!УZˆ*ћPв* ыФђрF;СDЏfтvž™eU ;Сk|0Ћ;LьBV&(’Еэ)ј}У?@3ѓ“Ёsщ“cѓ'™˜хMbт3=<ІJBцФuП&’Ё$—`ЇQa*ОgЕ˜}І9Rўѓ'д? ~Ju„~\ 3 sЦъЇQgДщ˜™Г[X\ЌЗp”ї№X…iХбІf 'цэ(abfv‡@=&фfhо ВIЦ UQЕЦn•пˆЋrf1a1MГи› kD|ЮхBga4<{e iкsЮq}ЩшБ_>`‚+oЛцy‡НЇЫЮвРв{˜AeШvыс:6Ј‹R: žКr9ѓ ЕЫ|ЌtЋЮС2„т†ŸЇ ) ИщBJє›нNёІ-RŒIrtјћf&2„>Єбщдхa^гЩЪ Щ%Ќz№(~: ‘ЊрЏ  ŠFзŒяџEЌ€"№HД/…ђ•—…ЦL@§ 9ьЈЖ‡6ХboОЂЕЅt—#хЏі&S!g~ZљЊ˜й"fJХ ,[‰Г 1cpqшНПЋ8М^ ŒЊC——/„}љІœ—Š.–ъ{­ЁLЇ@ˆEУФн88СЁxdмD‚шрPlар\vkѓ9Ип˜&cёO.N\iв[L-.lœX!>!йфƒ3ш3АЇ Hc3ІМч™(јра“ЯNš‚!Д}oк™ULƒ}|њ=јИвпщ€ŠЬ дђ'(-0•2“ёcп7Lды6LLFМ톉Yy№oУФFV’л.1)ˆЅ]тsŠЏэЇZѕIѕгЉжзМOхЁ!ŽI1ЧQ~Їк‰eЈ :rZjЩ!štхЊЃ Ѓъ7”Mˆз„ c^91Џ0§?>‘%Ы3\ "5ч1–Ж}ЂG@HgЛ}ŽN”еѓ›1Ѕƒ,ЫІvЄЛХ>ВйиLд0РядRБєeˆїО{MHlPхGˆЄвьUB‹ВIY0! а­ŽcЮgЫХэтKЅ,G Ž€.-!xw”‚ ьNЖZ нVON [aLиь€Ѓ–‚Ей-3d.iшЂ/dљЭїгЙЦЎ.љз;К7™ы8г;ЕŒтжvЕя\ˆ7;U’СкюЦ;`™уиЊ•з0ќ$B‹ПV7ЃЂAŽЮ˜kЄYМЊКyК—Й[н6@Ћ|7nВŒїеЙ)4/Ф-cУx ‡іaKхтб wЅатl ЭaЩктѓп3ЫДА{Ю'Дr VzЏJД‘ XˆRЛ=EwЦЁFšXрЊБ$w/;§—|ŽЦ9EUˆэ;ŒИ?„яѓЦb‘$2{eСРAH^чЫЁ3 р@ЮкfЮЊФHќZ™€ќЫ>Ћв2“;^/уљ;Ѕч$qЗ…C‹;сX}‘q$ЗMr*а%m?‹пЭ™Ч™ZH…{xЎFL“ѕЇфqVyЌ~Sњн,X7ЇЕ|›Щ˜ЉьмноЋ Юг,#кV %… ј&@UџJњ‘ пн)r#•N ЁаяЬ>-wК-еSЭsCrёHmBu=OбD> Ќ“оЃ5Є)r/Бь€мG;j;ЄѕЏ‰ыД ,вс‹а!Ф• БљЧ• њ-A83ˆиgF[\$T8шJ„ SAм)—М…Ћ/)'.оAЪ…}pyЩq•N б0јоŽоSsož7Г$єS\щСvЈЯИ€&ПŸ%‚РLщчMtЫЄѓQ{ЁVeли€ЃŠ]Шп€™Ы“њ№LиЊ№QмєЪSpЃ1Q{^щЃЗр^ ­XЩ ˆwм{бвХŠdn%§>z/BЌ[ЦЯRмЛѓDїЁ‘ŽNohzŽo‚њ˜'4ќb7vK+9_9ѓ!›JЙЩš€dIфW*`ц`СНœwшЧ+”ЁzЈѓМrЌ’МОŽ—•Ё |ёi§М‹YиЇЯqє…ќПKКw{Bы˜ЪiА"0‚цЅŽ0П‹!ўѓlЇZМ(О•є/7 @wбP9Цюwi.ОфщAЙC%“ Щ2m!D‰Њƒo9M)м%нШК,ЫфiNї’п‘vЈ7Їн-) ёТЈѓ–„ „”$_SlR„%!]C|KсЗ86ђ0ЗЬ6лй­­­БtхљŒe4аZ6D7ик™S2˜V )‘ )Г/1™‰O$h G˜5ˆnR7ІС‘юrJЈ .ЏЦъLmІˆеQфЁ‰:еvСEyRAтNЅD+SmjНJ.ъšVоJ6]:ЬН&‰^&h+‰$Š.м ЮаŽэѓcтЌ)GєC‰s„Ћ{PШа_4’№;m љЄ@\oкцЕœreˆ ^_ТTЄ‰ цЖPГPyиŒ<Д< 69И>lSAzаЛM `*b/m@кfš6 ўxиІj‡Є`* ˜ њ$ЌЁНŸ—јm$ˆ†2­їЈv jэa$ˆ†^žƒ‡mSЩЇm#Xыј"-щƒџаHPd$€uїџ§љOAУЧЄП‚тДзџњЧїcхѕOЏ?ЭоXTќl\лtŠUУ{aў9žс7…yo`фP+Џ§Пяс$ŠњЖЩњauj?ч~OVDє€јџ%&ŸёЏ Ÿѓє9?ўыхЉЪ`жРоjСВXж§_џm!џѕЇ?џщўћ{ C'X_?Н—§Няo$ЄЗzT1cШOПЪprНbџў}ЂЎ§ўаŸ~ў—Пќѕўнџ~§єOўгћ ЛіџухЛВBќ7^ў/љћџ„їZ~ћЧљОcтЇ–К?п§ѕДЏ0tНoЌРг@бњ>а_Ѓhs9xЃhsu\ шzS№@䘠Н8*ќiя‚ ќПіkдћўиobQџэф ^0 §UЄМћэFў?DПсTч„:Ућh ќцћ~uЦWЈѓО…ƒ.е@ їО:Ьё@6uоœcФyž'yCфхЏ7ЁЙ”–еиbјwˆйПwŠч№я‘Ўљ]ЄлЩ•ќ вQ!і[јЧПkљы_џ~ќЅ‡•щО§в?ФЛ~пb‘ЊoОяёn}…w=.еЖљц›'ћ эъ‚ЧУvj0к7• Ц<ўŸoa“h$Љ ‚ы}жЈЛ№РšЧ=сп@Уџш”пDХ§}њ‡D5эЧ№А.;ў6<ќС7 ПѓЦ?&~?є2aр7_іФРйџЯз\н ’7п,c(ˆПСже9ѕl0ђК˜f№РРп]ТєІSMУиt?Џ §ќwє?эпТпv}— ,9*ђpџ wфшўёћћox#яяяМёYПяяoОя‡АИ•Gd5ьV жУЦЯ7ѓе>YŠАfЭ9uЯПoјїћтЙjј1я!џЖН­ИЕoОйlkSСѓяп?YJї§ъф Ыї’ZDuA„Џ6ю›wєчжuЌ њ}h>C)+ј—?ч€4Н~ инЇ•пZhЛъ=@№c@kт5и№бюJn€юpл~ТїU§Ъ‚оЬsЌрЧ€‹а=`8З№??V2J`ачSuж7Љс=Hr?>7шћёЙAї€мЯ Ъї~|nа=РћёБ?wЗїуcююмЯ Ъї~|nа= їуsƒюџЦоЛdщ‘ђаЂSqѓvNЎр У8+‡рnzўнк{KŸГ\хПмq7ьќBСS/Фx|кеп ˆ&ftѕF-_w˜2Ж# %lŒŠ­яC c`чРPТЦX8Œv`(!0rТ№l OиМрРPТЦР.ф@xчO„JŒrісЗ€w~СщјA w„w>_к:”ѕuЬъы˜еŒу)†6Цы˜ез1ЋЏcV_ЧЌ.ФаJŒі:fэuЬкы˜Ез1УѕJиЏЃж^G­ПŒZЕwШ阜цxn|~*зўдЎ™цU дИ[$m.–cѓЬ%Sљg/<t,2‹ NџвДmЎЩ^ъвм.еї9— Юч\О…;ЙV‘TYЯ™ZЪ№7J1 &еМГНЋс|а14Ћ6 MЂRІnлVГМš k:МŽйPЌгч1ј…ЧmїXяI;œ[ќp§СДkszж:084ЯoЂЊ-ыЂЗtХ§Аu„ у]о.š;_BpŒp|6њПф OlцOХk?‰"+уЋм]B;ТвЎUЪтиЊјЏ ѕ$ЁVь6тM№D€:МжbЪл{+œпMЏмxvдяпzPэl~)ЏFГУ•…х–b§нp…щ!ЊїЏ)=(Јz 7š––§—=]­ъNŒРР%2HР§#*ј h=iАŽЦ€†-<\}ё‹АуHc8‹2Œ–єРDЮˆ'л^Ч_AыICuЌ8aYJзљн\ьРxфжnЛ“0v`7Bд№_SzRP§x[*вЄРБІ‚‰g’%]о6Г1Ђ†П€ж“†ъ8?7ЉІІ4w ‘,ЉrР!ƒЮRяьЈнПЂr”fЅLv]Э№">B i–]К]$КЄЈс˜ФЦ№Њ§ ZOЊcС“.іЇJѓЛ(мСюƒjL@0K D џ5Ѕ'е‡‘–Јxкѓ7цЭхП!рю*ƒћEaюQПMщIAѕ›x1бвhљ•MWш)’ŒљЛHfЮ+ЧˆўZOЌ#žД?Žgрлб0!xУёцj§Є џ5ЁU.#ФyOшВg…#ФДŒЯпOРOщIAѕуk0–6hqрРЗ)‹МEз*юАЛМш@ˆњ§kJ ЊоР+sр;МИуlЊ­z.rЧЈйтбИЙщQС_@ыICu\=шšpg)alКkЙ№RЧ_@ыIƒu„Nжиxю0сpt|]w„ZДЎZЮ4DСkјя)=(Јzч­аХЛ Щ oџњ80мЁ„ЛYђќДž4TЧŽЧ–,MЗVv„хZ)ŠFЛќІc\DЗЂŠџžд“„j8qН:вtЪЛO /ИќиэŠ(TнQХ_@ыIƒu„eH§GA­”ЧR{œ ЦвуЈЛZћсuќДž4>ўGЏCoЖq™љŸx2тkЖзЁ,п6’зЁLзынэа›BымэPŠzк§YЮMw;ф$OЃмvЅw•юa‡“ЋыJї|K—д9ї;\сˆ псZњЄћТ[ЗvИpiDh3Иљ‰ f]ˆЌv>5Q †Йуa'Ј]Љ{З<)\оА.n#ЯCzёeљdXXь]–ћнЊ…­3 sДNѓйяДЊй аNљ,ћ—йялцэшВя[ѓC„wZЄ6/Љ3Аbтџ.[бf ојфы?BxKЮ.“џДє_fПгЦВх‘№№Уї5џAў;Э с§ГOџuўћ6Sјчћ!ћAў;M[рјYсПЬ~—zЯИ›™?ЋјоЅ|3ЇіЯ>ўзљяR3rЫЇу§#„wщЎЄž?­§оЅ\ў№ћ?@x—ъзбЕѕѓяџсj™­†Ћ“ МЮЙфПKgъ;їЛЏџс] Иљ˜_ОКПЮ~—ЊaЋї |_ѓфПS  Н>­ї_fПK:WPNŸŽйў'БмРжkAф'Rйл8…2пЯ<„rЫО+щ•›дnЪvр”Щ\n‡PО’Jh_kщ„яb-m&hгjљfƒяQ-з Д'ЕвS$чЅэ пpZ—K`э/ё€єЩG‚v‚„іŠL“;$ВС”йОД†'hпgM—йо,OаЖЮš;P "Йl`3рžшЭ€œф?sG|j:/ъв7ТїџЩ`џ/єžE>NOП ^*УђОЛG…рЎ№Х­џЫ=ё?N~iн]яє­›Nлщ)І/~'МxэІшГШЧщЇЯИc№лvžчЌPБJ‡_МђџИмџусƒчБЂoл+~%)єюH„W—ћO}љxxиy ъліy_8љБнф‘№ъPџ‰ЂЯ"џ9YЙДm9q€ЈmјеYў‹шЗј•eЃЪQWг2ђmя„W/јO}љЇЗUaљЃ3ЯЦ~„џz'œnюŸ)wрœŽэlA '€ЇйИ$YšдЙ№тЦў‰’ЇЯ‚Ёвг GВ Œ,Я2\Я;сХI§3EŸE>NЏДЅ5,]љŠѓђсаЙМс/єO”|–ј8НЮ™бП…иJq?VЎу№тdў™ЂЯ"‡Oй’.Й‚;|‡vCфо O'ђЯ”|”ј8НЦІ ,RЁйe…шѓw'МИ‰ІшГШЧщ>ШРY{Ђ{ї“ ќtЩg‰гё›yлРЗpХfоgєол№тч§™ЂЯ"Ї[звњЂ+ŽжЌїBщ˜єтП§g…žШ‡Ѓжc†д’їджkг›@№Зю„ЇcіgJ>J|<БЗLЬ™‘?0РА<ѕь ЄуNxѕЛўDбg‘‡›ѕТ;цпмѓ‰N’Ц _щNxѕЊўѓ’Я'ъ•Д $ЗІ•вЄє„ю„WŸщO}љxИH/мё-œ–Vjъвј9wТЋGє'Š>‹|ќ–VХqЦ‚C‘­•яM-ЦLІVёƒУnjхˆВ’Љ•<ЊЪM-Лz КšGЁЯЗЕвѕАЕLrO7с%ПсіІгиВ„и -ЇTюЯ[lUРђ~ЌFьmЪ2оТљ™ŸAWсЁ пчzѕ}њ~wј>=С}ŸkябУвЊ•ЧАЬ>Вk{iiqяrGЄШaгfФX+acЈH`фХР1?FшЮMО"ѕБ й&ьлѕEцЗЩв‡і|Чї|эа%п ЋТЭdOи*В1жbЯ^,яMН€7‚Jš§„›OqrрачјБ6†Šl mB]Cлуює,NС;_6BŸюГjеЃOДprшн§‰С"c%š$О_!џч^{ђ‡FО ‚:кОСГOeЛuкЁ*ІДтЉzЄжJё HwŒnŒЁЎBПиЮЁxtw†&7яh`ЈШЦА 0O9D“яž‡‡40X"<> м)z`ШKК1XdcфFZQBёЉч(БДb6‚–дЦp_i`ЈШЦа’‰ш|wІ&vўвР№…Z3з”mт>вCNгЁeцЭзМёОћЬzЌаqњ‰рЫЬ|б4M>9KoД:Ъ™-ќШїгХ м_šнSд1нЯБbЃДfпДњ^е 5љ*О™p_йЗэ[ !ОдРP‘Р зь3С§G8ќ„Ус№G8ќ?+ўЗГ7Rdке§qсˆ§5 ІŽ+0Mпѓp‘ф'&uіЬЎе=ŒР<Л{skjnŽ‡§Ж™_Ю‘ЭЌрtэИЭ$;гwмf’+T;nwыq ,|Ыm'hЫm'hЫm'hЫm'hЯmfпRѓ†•gŒепŸЈсІoйІрN№уЎsŸЅњПћ€ ЏїшГ?LСИАШ…ћИBкsј˜№m'Ф%A^ф AЂ›† їђЂД+єЮ &œ“Ф9wЈхEcи46s!=Яx)сл1ёъSЇ ЎSyЙСy(МУыœКеOУњ6Ћя‰ЊШAУyhа wЫ| |Ћ™з\žыЁИъЂ„x>м‹4H4hHЯАЉFY)M$OŒUц'{ѓž:тцE‚† rЮKьF›OМЈў\КCЇƒ#!ќ9*œd ЭCWУH™ЩSЌн™AЃJра‘7ЧоЅI-J“ЧZўеЗт“љ^СЩ[\4xK„jtPЩ !šЧдєїНЂИyвљU“ј<<тЮ l "Й)@:Ј+eyкрR)О „ј‚JQмФAэ@œ‹O(!>ЁAСwi‚‚ИеXNaѓГTЂГ‹ѕx‹l­ёЄ|5ZЃaјihёГˆ1нŠ†t6% –ѕ"›†ГР сќЊJnкOOwЏОBПJ;Q‰MСЗW‚ФfZW?ДЯ#zЧƒu’+АЎHxмSлlгiшІБљжuшЇ‚ХG6oдG‚y^ЇЛIєЭЗЪЁРц•_bŠВФgЮX§v—ї]/ЏгТŸшЋДЁ?каmш6єGњЃ §б†ўhCџ/hCџ“Гoв“„ ЌsъŸ8ћтІ.).Й<}}ѓиЮрzhысы5ФЊ&™nЁv‘hoЛ­_ŸНрv Ољ}Аію:ˆ8Џгs>iЩ=јмNк jеNPЋњє›yДћ’ТсKg'ЈYі*Ь9Ev9Z!v?пФ™Е›ўЊЙЇŸoп ж§zf{ЭЩNк№>a{”HcHшЋ!уQѕШІ‚ыEО0пNPЩТ7}r2ПыйЊ“Š5ўzФњ6љўэ{пj<зЫЁзg„ЉЅŒ“Р Е&щ'dŸЫМеУГi"xIAEЯvF^РѓЂ™Wш‹2! уЛžЋ*ЉфYуЏчˆџBSоУюЫњv$TпйЉМ6яUIчz№ЯХєШvlљ“)Й;хЏлJе‹Л*Ъћ+C€e~иГUK=ы|ŽЫЄ1ялЖІ?Œэ›Ж=bКTˆs{LJqа„ьƒ gjќѕ<‰љ_hЪ{И”Ля8мy— лаykš5˜нпŸчЮІЋкЫ šZК‘€їНшр…NюіфОѓX;ЊzŽХoн„їэww‘0dWix=GbЭI.ёŠн!\w.зИ—$ ў~Ш//Iйц[.љќЋЪѕ–<ы{ФяпŽїиЃш№Pю=‹ŽћRэBВ]мю//^ѓaЗ›fdkѓC%šz0іFьL˜—МЋЙ6aB†ЫЯz.wePюЌь9Пy#оїNNД!P•JЧ—ЊўSoEЅл,ВЙKфE/з КЕ‰dЕё’Ќgь7y+ќЛž­ ,–Gу?б”їНЅЪ§˜cеjs“—K5ѕЭ›hˆ|dЪ–џLEхЏЧnЎНЪх%Э-t€ЌœzЬlЮЌћ—guЯљ§лёОЗžmяымŠОе_{ƒCЮ.гѕОј= ь[є’)/Л%ƒbй­жп]k8(ЎrУ^‡tš€)я3хRSБЃІч8ќЮ-xплђ^џ€Q‘ц>5ЋclTЊўЭ=jЬlnИX9‡є­ˆ@MМ *‘j’™ю>cЙГЎЧќцmxп ит=x#Iлў­dPИПЈ”7ЙЦ,O.3PЉ7;ˆЭ|–СIУ 7ЄŒЧч”­ЊЈмQбs~уМяŽЈОУЌЧviYЗЧKеп1d+nNE“Ч0А Г2^’uТбџЎВU'=j|ФЁ%я;ЦR1O%6їk%+€ь{rŠ)—a†*HdПFрЭ@T’c-h4ТПЩlЏK>Њ{ŽЧяпŽї-Ф“#|Ш*гПtїhЁžŽтшю cЎGdВЄCU˜‘€нњ(:pQВiёYхЊJ,љЈё1 џІМіg9оMў(iМУ™MЙћgoыоКZК'С…hДзWPЏП{ŠДўЂjtЛЩ6д–]иє}5ўOўџокпUІ§т>iИ(яЕ2щяЊбqŸŒiWH}_д'узіIЙ№ˆэkeђпUcўк>Б‹№ЧјЄџЈOж/ю“лњ,љЛЪ”ПЉFН~qŸмd~п'хѕIMПЖOЬЯѕ§4љЛ—kўЕ]R3. §ОџЈK~1‹­іVѓїoЅџm5›Ўj!8љКtЯjВPЙ/ЩNМуˆќoзВ€ЎІїЯž/ДŸЅgŠO /z&къДІ]ШhшМОи` ХГ„/fSVЛЇЛA“ИмQДkЎokЧвАьT™,Ws\‹Ф3_ЮBv+„№™dЖ?А‚№bBУw-Xlр?.[L€‘ы[6флЎу…{vЩч] _ ЈРmГt1ЋОJ…мЯ™К qЋЄAќRЙы„o dџь ‹§4ШqљеЛяяпнЂ‚:.D]і,œœТЋ–5-2б€мнƒiз„ЯH§]ьš[ƒ Ш”;J!’ŽИy-&Ќ/дк‰мМВEпэЈnБщOпjСЂFѕj7rA@O"н gНlД†bџэіЩTЬЦ'јьЮ‚^pїЄAЉ2 є  aЂXBNŒ„nVvrО !sš!СTсЩЯ4‰tЈыкuД…Иw]nhЖшnж Ю*Э,фО:–хіЪрМ5] QqWЎН?ь–xћ]˜y AXŒЭnC%jЕ4№ЈЖAs*(ŠІ4ХЮHЈ$|‘TEZf^+ъˆ†ž™КgcаpЫхE]г”ЕМ№<‰КHiЂЧ{)€VnяЬ^ 4а@Œд@ЦвŠŸFЎ"!Yю\@u5ГіЖТюнPЎ5моМZ„К &гВkmђ"пm2ьlY‹ˆм*?uOuƒєBНy й‘ABGЖjйЊA=ŽЏк2шїј/˜ЕыЅ љuXB'М—Ўсfфх=G ънЁЏ@Ўi0ЁZvщ@nЙ;!"ЗЩјаЛk–­Z}И4."свэШœ…ћnђƒїгђ0ia§5“н#ћMт##СЇ w“ьX"Уэ'€Ф№T{H„=ftCН™›ЏIз‹#ЗŠ„Dф bми\h€R"Ў-УtЋ;ЦљoРиг Ё`БEi+ еšUC6з‰ё‚+Ѓ-ў рfkІ•Aт.Ѓ ц Е.16У,!@ШK5Ж‹XШ$ СцфкЮw-3Ќv‹FцjќVAѓюaД‰€ЁяŠY0ї О'й2Ё6йQ€ 8оP/Л›ЋўfЫN'АУя6ЏЎ 8]цкїІЏС›ЩO;Н0№˜еIhЪ7\н ИvчŒM‘›Ы-у|„†pЏб Б$PКlMLМAjИ&œэ$­Юж5vЁw§‚ЯиwЋM0Ћ„uЕнЏ+мeШNU ДGPC[­_ь4++qkIЦЃэ\ЖŽЪo>qПв UAe йž˜А„фY˜нБ/[ІvТизmhЊ‰-jAX–ри7ДЕыC ‹oр+ƒC>ё“h-AЦКgйTeсЏRд&:Д"c№Qoы‚’OБ‹ wL8˜›iБšгqsaі€V—Ї ЈuХXu†ЯнšдWЈEla]1ЯgЬ]уЪD.@юЧЄШ$œp/ьшRНАўЉYWЙ'&\Јr[† ”›ЩU› Ў\Vу–ЁБ(йфLГЮA›Ћž…аРвœ$|і"ЬyввŠщxO хUgрxwТн›bгѕюK›~ш6<—РљhZі„†d3{0їцЊіЄРХд}7tŒіeІŒеfмТђИ=4уJv9–Ь0%|т-АŽŽЎžИз &ўeтЮіЁЉiДV‰ш&фUŠ ЌB\$щЂдИœЃe1“Ь5”˜]QДb-иЋ/.љ(&Ye%Ћ!Ћ\˜BЩžyрр]‹-Њ˜єП;~7ЌiмM.v}UuНf‚Ф§`Ц12,мlЋм Щl[Eуџ'a‘„a.LЁє„,6Јr8Њ . –uэW”ч)–]T—ЗЂ~[~GЙД‰]“u@bр:rс’zЃ‡3j'Hиsh‘&BОЦyR˜]ВЯƒ.іkюо“ЃmЪА:ѕaƒ’Ф†3XXЌђВcYмКWќ%бъдМСВ-Ms Ќ,Ыц›}’јЊ ь0Sы‘^z9'EЂ|Y‚БJš+И#…,9щ€V>LvxћnшЊовК3кg7M§H5ІяfhŸx:ЪˆДœЈP)Ш1Џ Ь;G!;хЦi– *ѕЉ+#сx“њD•!4-5hQе’UaКЏAДZ duчГєхФC’Гj;>Kz0[ ћвQݘЪrчџ…sфpљ&{іd{Fz{УrwзH*ь‡pЄ4п2rљF6я#Щž Ѕb™ИМь=w)„w3m’њŸq’*-ЖжжЪвkІт-k(№‚h ”сШ™о[x7tбљaГвЎ~сё-Ї\Аi~ФГ_(‰{ Ђ˜Б[б~Љ№Џ˜%o#S—+ћ‚‰‡fRН0KЬа1ЋЊІ ЬQж‰+ЗГЈ"Є‚ы<с@И;Ќр" ƒ!›ьн-СdY76сЎjєŽ@ 5gф.c@юр5dпХ—A&УхPR—ЦЕ•0љ mт1H“NййудcgгНШм(шЎb*  2a№%„FP,Ь€ hв1Pе8­МЦ~Ілh™ z.G^d4ж*џvѕP ЎDёŽ;AКНЩ™зјн$;ŒKЭygтвх (ŠїБ/ЭŽlˆFhшŠ­ё‚кƒŸ7Œ—йŒМУЃ'гqјP‹ВБЁT -‡„,~ЁlЉІйгёе ЙST фVйв ЂXєй9оцYЧIJИ’8-*Б$ЎЛЄЈ4Ld)1ŒСВvMAfъЎсјœЗ.юŽš™mC\ц ],)Х ВвЌ–В%ɘ 9ьЌЬвZj3јo™o‚ЃD}ЉУu"Г`ЏбRƒЂЫ(\5ЪтыšфnЌg~ЦжchЙЯK9іZцїбюN:“SДГгмпsvrў?/ШЎтžЏA#sэd8|™’rчI`К4)Ќ\ё,кщ1ŒJ,ЪƒDю“Щ&аeЊБNUѓpЂЗФТ!Ki&€ёXDЦcиg—ОBHžUŸfƒЦгZшm9^Й,фЇŒe1ф…р‚[„Њ&%%Rю„ЁЎ)рщYЪJ&Пч.Р™йШКЕžhБЧEљ–3…оШ™D9 ылV"дСй;ЁБ6Ж74щU1ŽіаRŠ+n<БИxCDMl4јЖЩ<њ{Ё"5ЛшєЕИ+>Ѓџа(9tКЗYS%1лТ4фhв№/˜…\ т`ЯЫ)UC^іъ5.“.5˜{Бо‹;А ю ЦфсЊп/oœ*‹ИСМ&'ЈFŸ3№J{ІИۘћ>]ЌY[Bф‘T^ЖФ†›:wrpФˆЗ-ЮLл<ЂФЎœUКMBучSЊP—YвFdŒЦјŠщФэыљЩLgjЁХYxƒ*Еы5›iRЛbъ 5Œйƒ„iк5SvgзЧkІL%‘šЩ*ьU4цЈdG­R(™9JF§1{5Ѓ[z“U›y‘CB НYvМжЁHrо5кlwGv#$БS98эrімЅsЕљ;H ЛБѓc“*‰ ЫPќЫ„MŽя‚Ич!шŠ‰ЕФi‚чђ ’}’YK)p;q2› .BфђСZЩh&sё5і*Y”penЁiч oЙЁ)™бНЃf ж.зуЌ.этЌщкЯВ„>Н4 vRюёUЬ эŒ`Gї(5ŠхfЫЪ(“ ў“пp Ж›–‹й™v‡6”I;Эг‘E ™C_!дЛWBЈђБW,bЪ}ле7\HЩж‡B ^ ƒШ45bЕвёpr@ьKfGAši•ЉjбpЉrИ2ХТ’D ‹i…Ц6’ф ycž8іu~“ы№"Л ЫЮDєJРk•›GЫКбЃ‡ўЃБю?p ТфƒИM"ŽPЮ˜0$ѓшЄ šс›ѕfЪ7›hЖцUƒ:ХЮм ІАљfKє§ЖшXцЕшiС’ъaЪЮшОJvф™ЅŸхфТ•6]ЉЦ•—Жш”kвчeТоn<ЅJ g+Š˜-ЩЂТXОђ`­/ъZ-3лJnлOzUХъ|™ ›t\™ђ!эЇhџТEq„ƒйїŒо^Šœ№@№сЅ`DV>пHntгtИo>^i|яЈ˜”=ž€žlLЧIƒ€Ф•Х,‰й KО“…іуг4P'Xwo8†•Yћp“ГЈУžјdƒAmэj4g’м{N=щЩZэT#с‹vЕ HђЬWŒРИeg­„*dХГ„[ИYИм›„3"iЗої&;ЅmЃБJ…Ц"!Љm2?zЂДЇЖeaдœFƒШв4-йCюЗhвŽщќŽюLт†^ъђRYыљMЯ@œ)4­Г;}Н‘Uurј–.ёЅЯЏуд! ПTŠлЩ›ЕKw(As§Llm'TЃ SІй жGJјuє#FYr”˜тп“^ВФЙ;:e)uЙU‡њПЛKMrШЄH„ A1iв‚P4’|/Cf`ry)X КйPЌ’†’в/Q`†'ЏQ-_$ST ВсЁйWh\ь–ТAЛ\Ы`ѕCfFf\TщH4П˜К‚к)/т€оЮўV@‚IŸОbНфpСQ“oєзMЊќuИГNШ•йвoхЪSXXsHИ%й™SdШ`P^T9Б4›wЩ5Iм‹ЎI •nƒЉ‚O:ЏкУ‘ ‘0—ЂДw"g*їъ Пі*НЩaЪAcVвmtDйFВŠњhєЛjЪб‰й7.GчЫё{œХД=ДЉЊeЬЄЊгVв>ЬPDЗЇF лŠuXВert/`ЭЭчІA\N@И TЙфЏ1КƒwРqЮј{BVжЕpоWw{HГЄаЈVZ:[ДЌXž™‹ QЇ“ЗЄR9“s]згсf№EодYпAVДXпšƒ‰ГО‰LВO'љП‚хШгљ‚WйЌHюR8œWZ…єye-3:Жђ№№;!“*№i‚г.Є \УQ1§aЉPH›zуSї@…zЇ„Oъ">)ЏЙˆGpoЇœ…k”МsвеЛGхм Xю Е™АQ;ИY(fсn'Ў‚8H‰uи*‰tЎ^Х§”Йм%{94–Й.ŽОЎEЛ(ИЧКш. +2 9OЎ˜5”ЫХy†н|‘KFќx’Ip=ІIя9ЙС”j0}Tц Ю6щђ4с—UBВ7ю„D–ЉPIJEƒtF˜.ubЇB2\OŠ0e СŠиU SѓъTh#ЂM ЪђГMd;ЛЊ(э–Њ8иъШUqАvK|識>\{™'`)[A љ*фDЪ2ЅјнХPžЅрзP0…DЂ6>Щі3ЕбЩ<З“’ИSЃ›ДX;žЧDфкЈvЈЈЋ ˜'Њl№Y}tЛшJфЇФухд’j йHc\€НІмцЦ eЦЎ>&[уЄY KрІLИJЈј 5фжфм’›pж™xщ>5W@ц<^”7&ПІv.зlціх1[bœs4Gюњ—’.АЌЛdDP№ 3№яЩ•&GЅъ$‡иє*+ШƒЮ38GЕаЖы”!MtбУв@HЪйbИяe›+И).G_1ЮЄХЩU)gщE™з–ГХЁ­_rиЦі$šAК~sMЩƒБ‹ВЊ1eбIšђ;yŸ"5‹E+;YвifюeњВ3M…]R§BHЪХUТќЂ]#‚N7ЦFїбФ}іаЮщЙ’ѓюЂ|еfŠц^Ѓт’L{„]ю№ž1(D“іЭ$цфН”yYДЩ—ЙhяŽЂЋ’VcQmbжБ1GkЄ\XЇЁ§ЯА˜=E–,e8ч~њњ‘ƒJK‘і0C“QNют†'pаb!CЎ^ жжrfƒ|л™5Юкж˜!ХщGjgѓdgljЉšКѓЕ‘Ы˜98?m'чKдШш.ЪœŠЦ•9мсŠоРD–pбВђu0}ЋM‚ј‹мOНAКФъЂдшђА№4Р зЖVљМ; NHVуŠнK›ЦЊЦН№L ј юЂџ!з­ѕщЗУbnaЙ›эƒKЛxŒпYŒгЭЧjЖlьl5їЇšь\ЭнЂвхW}гЙЋљbЌтPV ьkiЕїd бŽohKЫT'R‘Y™,ЛЁзф3€ћw%ЎлцъљJЎУ› ^сJ7ЩОТ^C“;vRCЛфЮЏЭЎ>\Ў‚)јът`_єФH" B+„Lе9EССѕFЙЗPRˆ:ХPnt:5БfЗ†)ј’~іьQdщmувчmЩwю-ŽŽ’ДƒА…mрГєtAЄг…ЫщШЙ>˜PщXjVŒ/uш_:А8`H /ЩТИK–е.л,д󜹋 ЭпMX.)ЛoАdzLќи\.”єє~"ВнŒWїV‡ТБ-aапЕ Вх;К .џжrdљyiuyДX”о,Вƒvƒы†ъZkЭюl>>вЪYЊђЙШ„Гp(Т&sкх.ЫSяleEYWОУа§Xф=' ъ4/X“мнд,ФmЬЕylьИŠ‰Л *tРв•c'9ЎМ7їr7HШ[ЄЈ=FLиВZ2‰Œ”т›сЉ3h.З……,ЯЮ"ђдŽ_"єe‡ќЌЭУФм!Ѓ­ŸPNЌe+ŽGЕ }Eщх}>ѕВ`quЖwjœ™Z>ŸђЫwQ8АЯeРŽюШKЕw.YчД†?ЪЁnОAΘ›Иon4§%jYxcј)`4|xєyIŽмeУ1[{+•KжьИrЉTfЯuBK%‹#ЫSYЩЕмTЬyКѓEO€9є’ЌЫŠlА‰=Ю6Л­аї•ЩКћсКжЊіб=uV[я-”N_[цЋг3лиŠGЗцЌTШ”uЏG-_МŸЩžТаyъv4N*›ј7ФёНЙŽ.u$h†Эїю >П>>d|Зr_a€"ѕsеQ А5<зAшц=%"kеJgЬРнЎ•‹4(€ф8аLі4x Њ rh€ŠМ е‘ujЋ“r.'”"ЬбЈљ<ƒ ІСŒАj‡ЩЋа™—GHмSm ИœЈ&xЊЖnЋтЌƒЫеЫуЭ+“yZ8Вт ˜+VjЌЈЪЊёЗ,юіХ\ЦLVс$йGe•ёЈiSЮšV—gб>Pі0чТ‰N?ч‰уЖ( шAXGlЦpq}б\‘ *ВЂ3Д šƒ’pб!a•0K`NIљђEnTџБЁLјq]ўgafz‚ГєиG…ŽBwЎ$UЩс$­Є Z€З[šОujРт†њDžr?€сNdЋЪаТ ?wЪW^ЈД(NААЯŠЛG0/iТѓф|t5yн3PЎ6DіжшУ№6uwЯ rJz?†˜hsGpuN}ŠoЪ дƒošГ('K&}Kч@#s„+IЏп”~МDНSажXчж -ОС1вб"hƒu:{№фAdH&ЎпЮмЩяvъЭSйЌгвGЇ#/y&й ЕЎђхЄ‹]QтэЄ‹”ѓ`6+™ !ŽокШCо =N~…јізЪЩя. -[фиU‘еzЅTYфў,|y‹ JЧѕpіŠёЛ0”ьQxА–ЁЄ0JSnJпJ3…Ш—Ъs(Œ мiA€ДP.М—рlvч&BК.фnђувЌgіS‡Йz‚`зёу锧УJИјп UuБhчО-ЗuГ|@–€\Ќe‹0!сV†Бt.„‹ъj'юŒЁХ4 Г/AіјАЂуќVKаQеŒмС€54Qќ—П6‰HЇ<ЯИЇ,Wи№#ˆ™ю$•6ШУ!}“ќ—‡н\†ЉCя)Зж‘а"˜Ь)ioŠ;[pР`$юШU$€ йUєB#!{aƒšО’щ–Џ„kђ§§LЋ@zeАUGNŒ!+ЬО]IЪ‘5bC1иfФьЮЫK'‹J€kGЉ/опЫM"&ЮКЇ/9 Г6œT†ьqиЄ1SЙ!ЫЋGjа а\7ѕТ2Mˆ[c/ •хШMбYЄEїhв…Е|‚šš–ЧˆиЪŽSlбђ о˜[Xдє…Ё#СK.чьAЛkšЛŽНWу–$Œ †Ј#1чŒuŠYт‡q9;u3ЫqУ'ШNХгVEйвШБбЋП›Ќqхтmк ЬБB›—Цњ%ёХE Uж^шљ|ЊŽц8ZЌ;NщtД-С.‡И6^D?m˜ЅАZк0+љ~раь§4b–бˆйй&Ш7!Y1ё%Sг–K#FLлˆ‘Ї–6Œ<Е4aЏЬи&ЬRh/MmШ„Y—Ÿ{+^<П,f]+nbi]Y-Нjбх,Ѓe]œJЇ Ѓ8‹mҘ:pX0ГћZORWp fC2afїPЯўШ6ѕO{rл†бЃlэЩᆙнэ1к­tщкeт$О{ЇsВaДя&#†W7ЙcлiуДblЫl†3{XSЎц0aД_&ЃХУr{ЧqG џteћ8 ›к$й“= 7` haУађВЉ† 3txœfŒBЖЃЛ9„щБ!ќˆтdЦ …ЦбŒё-vš1\%‡Ѓѓ2ctУ‡Ь*ƒ‡ЃCлzNjНЅАbtШЖbxчŸ[1 „•cŒ9ŸVŒ%ŒАbЦђавJ FŒnуйFŒєЇmФH…’s@RЏЪiФphdФLзЫˆб]>лˆ™<”,#ЦF&…3ux+ŒwЂЃШ]1“ТˆБЁYaФ0W6Œ,… 3‹‡ћ5f6ЬдN`и%–0Т†™:ћEFёLђЖ`Я$ Fqoл‚™еАЦW-S fђ:”mСXТ fђ  ,‡Т‚Б„|X0ОŒB dС(\@ЬццZ1+љ]KЌ†sЪŸ0Ч•вЅ@ѕ; ˜Іx 7`JКx4qъnШМZ„aуAу;Іd*т‘ п”Р0я[ƒ4(ы0O'4QЕ(˜p;Њ€‹eDњм: ЛEGQВћƒђ=/P-X’к’(э7fZBсёЋ›( ЏЪ„ЁфЅQ@щ„ЯW•јT: ›]Ця–Фг=љуž ЂБУЌ0:0NJЄs[ф –­л<€ˆ<4вQЇ'њI:6е.6мeB№=МАNд\•”В>Kф’w%ВжYIŒxюиџрѓЄ=,I$Ф–Ѕ%ш6ŸR№МЉЬЛ;щŒЬдБW$0;YЇ‡s'ЧеyЁФlи'жё ьИКŒ(ф^ ѕЖЎЄVХЋ‰Оru‘RЋШ•зЁ/)ž 3xФЁЄџŸА7ЩбGкХцМ‡\СБ 6+0рЁЗPгЊБЗяŒЇ )oСџœ“AR|)ŠŒО4фА  ќГ=VкљїR8@Ма§ŽƒыŠM­Н?pх$ˆнІЅ`Œяіo\3@дђKHё:ЃžІцcr0Eнрпђш ••!8“Ђb7[nЦ~*GщЁьаќ›?rЖ‡rфнш%7…7Їёakф‰{W)Gн%Ѓа`Х ѕюѓ леЛЧNмYх—гrЕroкЦц,иѓrЛ{s|Ыье И•пUvgИк†ўХСKннkяс‰4xCЯnхц—эЭБ–4р suтб‡ƒ_љ/ю'UЪrKЖЩKzРј’ 3IBН8ы„&7‰\X6,m№FЗNUV,ючoj 4ШрЯСТ} ж –ТЈ‹6№2рбэx)ђџЃ3чЯ‚,Ÿ-€ŒiХС иУЯЄ”Œо+jdh№dф бEЇkf>šФo8bCЅSЁРhШсwzАкNехџг88”UAƒЮ?Ыr-ж MРє‚ЖНпGš­xЈWЁп~6tvч\§БПяАЄV{Т ‘мё‡:˜Ю"–qдеeя\uБŒhИЈ” БšxuоUA“пМв‘тЂЎO9рЊYўѕВlˆuwDнŽјЊЎE4­ЉFwУ„є*5VI6'Й;9.т№wчMыХн-ЙЌЁW‰вкЈг~оC,{еƒО#•_эШѕКfuь'ДЙм#MZ­WOoЎW'`s ќрЋјЫRЫaЙ Ёр"ф?W;&чmЏ<ˆNхƒ№b[NЄГ"„&Є/YЂ№ИЄ žхРм<ОGZЅх#9ŽЕCuК7KСпJшW7YA6‡нŠЋIŒсОд‚:L^{'фяHѕ^…Т?ž†^Yi#ођIЪ†6_Z бjјž т“UhMЙ‹Ю*jIн)p бK?_ШO_ЃT2ёn№Щлъы§H§ш/ ­8N€ТSКvЏ­IHљv@*Ї#THЛO;тІ‡sШФ4ЙубLdєHЮбIœ”ђьбкŽ`СЇЗЂОЮтl‚Нv%РйХЉ7’;љQM,L)СŒ9*:э wдос•јф-тЇпnи}!œ%um‡ПЩСNЊАžœAgеA4ЎwћXIќ”Ÿ€ИФ^ќнтНUX81вфиё~zЙЦ‰o~Хњˆ1-њFЎ™kb}@|ДђsЂш•ф3ої{,єaƒFŠ=}: ХЛ‹ŒвїгШrФЫ9 KcОЮЯпSЌ“=*Hъ"kШ”Э˜Тсь‘Ш/1œuаЕG†аeЪяШ<4C‘Y.ёљрДJ№ЗDњБ­эœwъ+ЄщБЌp‚ЎFЗЁУ(pщhжeї$Ќv•6€ТЗ‡ЎrNђ‚ЈЁЪYц#}miš—Њ aфxV5шšўžc9{аї…є>УФ?]нЩ’Œс€Yъьа@˜?ќ™Ф§ЃЛР…PщшVѕVУъ… ЉєДЄ?˜aDh”`xYGk5œš—Gъp^бŸDЋщŠ#х§ђX9 q&[Bќ“wc(tЩC>МžЕ9СІ>l/ƒ-ЁPЙЊ:ЙPџ/ Sя2PEЛс~ЧтЦN†8њjбŠ%RЯ“n)*ДVф WўІт8%юH? ]>,Њц’$%VРйˆ˜k ып)@Д0—|8е_€ єЫUf'ˆ8•ѕI+ѕ„9РK)ёЪй2ХЦK}{ДjPt…Ю[њy@ёS1]€—ѕѓ€фS” ЙŽ’Г*єr{p—Б…Ј5@ђ8Кu3ЉЕcxНЩ—ЊЯ.њxщъДЩ9б5Žњ„NЙiА|™WqЅЯ§XЭ.\ЂHc Œ„d20DCРnмЅЭПшvьэ&TЁ,ЧЈ`Зо/”ёAcЇ|јЛrЂjќ Е^[o*?€НVƒ*8=Ффтљ FЮђmО"%?вфџ%;џЃЎ>>u-й]§eњ„WWЪ‰g]§˜‚веџ™уПuѕ‹‰Ш™Qщ?lАŠѕwя33—жXt­^[й мy$зіo‡  вПy№ЄЦ=а‹ПёвlЬšўхдцhYрЦ–M K;KЎ*zЈONЎa)3FЗГ:Юќcc1 >2“%АЈрж ˜!ˆ c)Dф„в-Є.х†ъм0:,HЎƒŠћЖJ#ЙXšjЖ%е,"‹ЎАk˜нˆKяXЇB&,$ЄD<кн`V„м’Ÿ‚ЊФФ+СœнkЩЗd„ђСС<ЁЭШ–TMXŽ 0IxXKлiАR•Нƒ>ey/ufXсЊ,`ССtК‰šW‰ЃвЦР_Aў)Ќ€žgт`ƒйп6œС№6„RЄˆѓI`Ё}ЇїLђbš‡‚keјЦ–ВсЂWYбђ,Ч­„йќpCз‰,i~!4!Х†диPC№#Oѓ&ўф/ЇВGЌЈ[|Ь&PѓhЌќ’U\ЬЃЫпЄ%щ\Жwrіƒi^хјPŠгJыЦjцЩpј›ƒYп?V‰й—ƒ‡МVwИ.iь,Пƒ„Фœoђ^ЈyХ­‡КѕярYЫ {rR ШVWN<мрTвЯОЊ4ћГЎЇЬќЪжаsЛпJ њ€yZЩѕ(осs)Пф‹ЧЕЪZwZ}tєЧ{Ж)ЦQў6п6Љ5Љј‹у‚wDiw$0Цqq ЭФ;Н Йrg-B…E7—8 хŽiѕЫйpFQнšЕЕЄо-і№Тt<ђВДљ„=v@ьЃЎШpЈ>_u%T,4Ѕ[}аDI:ŽrN ^{n`rљ5ІZX~?– V нИBЏФн@\wл3OћБ‚ИLч*zH—]"ї1й’Ѕ!HbvЇtђ‡Kh]JЦД•ѓ3шw.|Lс…•4лД4Ѕ6L­вšv1э~tћч-Л“Кљœ,кЋVЩИЋWьоDї˜6lŒUYMRЉІі’шGeЃ.;Ю†oЌи оиЮ';‘Hгy{Џ, N‡ШVЖЊEшєЏ™k=Ж{uafц‡‡r‘ЂОДКб] ѓh-PпНпз›т•Е‹‹^6‹bЂЗб~\йScР‰Xј<<€ио5mЧ7`Ц›œјт`Сю<­XсULє.Ў8uхС]Ю~0”7w1a|RоU'ZЮuђrЅХ/Wуe!sUrЗЦnЦІТџЯQжёогЅ м15‹вОюв цўьYyјxїДЖ15Ÿow#$§D‡Нs‡|мK^"_С4nхgВ†нН€Œу/<аЉ2HПfFлŠ0‰tL…‹,k›^HYSQА•лцЄ„+Ы ееJH‹$4ИqУKc{+|FbЈz„Я оy‡ѓ~ŠѓмeЂЇуяXЬлЦlМn šћl/Š—yŸЄ:RиG[/Ÿ”э•ЭЎхhЃІ3Х“o{ГФЇн)(ЫK 7F\6ЌmЪ‡JhŠ5-{VЫm'Нxvэ…LˆкдЪЖ%™”•амиљdЖ4ЇИzCнБОНЛCЫ;uЄ{ИкM›е@ƒYђT§5zЭуОi№ЉЫ9ќєиRў#Жт/.5ћPсвЬЙn‰;ОWnУЫiЮYЫ0ћœхTy=iЮхB)ЭyBУ‡ea—вœЫУRЪѓЗ;?яDb,оŸ ЮќШnљ +кEx•сNкѓЃBwдžŸaOyбЧ3џ‹ОAxž›3d{jZЙЦoNћ”N\е3K}Ў4@RŸ[ёPЧ!P№Йдчr*~ечћжЬom>Ы5яk3—дчJС"ѕљ;8ћкЋFъs†–XЎDОвŸяЪ[7j№ЃиВп^хВІў|3ћбЋ@Wn Юћиw*эVЮѕR oљu5к’ZЈzнЧЦ5iаЁaЅ9нд_Ркі№иVqЙƒAŸ‰Ѕ|7‘-ŸW)бIR­DЇ–BJє0ыс^Jє§8џ%ої‘nм#Wщаi&Г}?V“зŠNщаїуь‡ фЭбЕвЁ+уГtшЛйKŸН•_КЧЮV:є­Nк–VzёцСJw8•,huшЬЂbњnŽжФЇ~Tч^YжЫhнЏ§гА>о)TвухМzЉаp&:ыk}Tш P“ ]ЙђЅBЯлИО:tЅ§–V|ыаw8КV:єЭ"'вЁЋш—tшŠzuш{й•|SЊI‡ЎД‹ЅCпLЭ&­9вœ~љUЁгyР*tЅ0’ }/iКM9їВ иУ*є­8щRЁ+џ‘Tш{9аИнф‘ыЋA?е6 ЛXо&—ЧЪ „С…ї{qЮUKŽэљљŸ5шэе ЯЮиІв ЯYyШxю.mNОЈX.Д7 О1џў_gј/§љ|BHФі6ф+\`цЃjOpФ>RКl`я/`š|2Яu8П6† њŽЅ:т3UџyфwЬg MгВьX€рќ› Љ ФL"аlŽн~vqшя€!>г}<5ј [35(І5Х§fъiAJ(ПQР‰$Ё< сŒЃŒ47ѓЁЦюъвЧ  #ач2pчm@єЏAУdУa7'ЦЛбK)œЃ \Хб\„юxлgЊHw~uo8мGŸјЎ№ІEj@Œ ˆј>ЛzН.m\TcуЛЂ‰7Ё MeѓЭЁ›Еƒ4Ж-б AџЭУИєоZS‘‹й€$RЈ›Pаьа(<ЃзиF“OjТяaH/v<ЁХ№ yЦgѕGg\Ц•)<уЊ^seƒ”5)іпэпMŽјnкІЅФЛЌћHt{™1bСма`_ЋСвРЄ>щRT‘ЊцJK2ь›wЅ ƒ ~Žфˆ/ЅЅUŽыТэG ,ZЃŸ Zо‰?‘7lsц ЁS!œiœЯаёЧvI‡ј•Л—zP`BЎHlЦURјЮs # [wњф‰ГНЪ­7 nDи4ЏI›tЫ4—ъ;m{8ёЂnLjю;щLMЋKЙџЎдkцХзен§ЙQw&еб;ГоOЫР!бš‡НЯ”жxб*rЇ/…>Я#Ы\}щNѕ о?tЎ›О;r =<ШщCu—ЫT]Mjж!рƒŒ(›<чЪЬЭ; џОNJзpT_ћFйкuшЏггёKIz‰љTОc\•#uЈƒB…ЕЈ™"чХ]—4СЗФ€бЂ*~'q™OЗQ‰Ў5ЫŒj6t]ФŽюСі‹Бё >сСo( рзл‰ŠЇЧц%з3KrŽ8€GuйГ—ъ/@ Po€ћКЋ f@љ’аьюty,Ў<д -§Ь$ФБЯѕрЭзx8ё!‰Пыч/KBVi6ХмAћ8ѕЫ$…/RЮ6l}hŒі\р<ВПЄ} Њ –V:Љ_ыЖaџОњT`ЭвЩeУО”S‘?ЋsfХduœ&…|тЖйшЮL}BСА9т˜lш hУ™ИDмHL˜аf(мдn^ЂдЦƒIA–Т>iжŠ :Qь-Э8КЖ uCЛ8>)hЃJ(ЖцбирЂ:'VaИ„јvцdH*aŠMРБˆЋ2qГylзлr?“€U‹x8VьЊЂї!ФЗ;ХdЊˆм%—yєШНњыЬЬЩ‰ %=ќЌэжXQ42ЗЂ,}КІv|Їi\Н@ч]g:‰ЌоO> “ЇhХЙјѕт{мж7]p*Т/!бчГ}„dђy:Žc#ы<ЊA:н‡Sfœ”’т.8 ЬбI8иЛиЛtЗјр"?5Кo…ЧNtяёогцHЃеЬФу+јЛ„4ѓCr1ЂVќЃм + 5№Ъ]Ÿ‡@Š>*Ч.AXЁšГ$l:tрQE„j№АБ­_nKиa]я“JBОŽ.ЗAБФѕ6*TиЙ…іЉ#}VRЇUЧz–#ЙТіЮ‹њЏдИРJД8эћ4}d ]i*ѓjrш!NR|`тvЧ,;SЁИ‘%†Зъ_юСХuЙц‡Š^™Sа™ž.G 9; Wж> F}:ЮкW@t№Ђбp*ZŽѕ›№ш" Ітьh-еФгжЎ™иХ][чxšH;аќlGдy5бttУиэo>eЛ(eR\‡ї oГ1ы-Rœ9ЦБЁE„=0rзэLд•аУPщjЫCщhДIJIЪ,+ŠлX/1Y:™™ОчЉИXБaSAn•А{xŽ–^ТЁ ЮEТ!W,ЋібїO†Лг… GPБ$‹Ўд]d1х‰E ZтіTŠ|зМ,ЙЪуњЈ€ћ&)k2YTЊuНŽ|yВˆWьХ1шNŠYYк_ЖИБЁ‘k2.@Њл4Š-fаффч8Tš&жв$Бќ‘еАјt@ќ)yкtЈхш§3tz UЄerР^%ќQ@ шœuЮкgyŽeMВQNfЩ V$црЬ УфйŸ.6СшсlИЭЖQ@ќс$ :юч1Ih•ќ4”ѓ>ЉBS:^'Eƒ>•КдЩ{ЄrиЛ.žNf Щyуђ№Ыyуš'n мфЛKyмя]ЦРёЬьЭ&$ЙИUЙрEFIеНЁСqСщ^‡OШƒНЊ­™Та›BBXЛUХљp*zсЋ_m~j]м;ЛХž'ŸџчыX+~ˆўHџQƒ”~ѓц) ЈwЂAб§лЧцˆЉ>?• Вё8KDО•bžђX™1ѓ›іыаpЄзNS:+§:‘bвИЎ Т› тJШcЛЂ89•SС_@§N–S{С@_р| Ј}'nѕЃТЊЉJЕsSВqЊДлr Ќ}О$тІjйTМКEЁ/ЄЫ# єлx8ѓІЇI#SŠwiткrіDpйлЉ%і4іЭТўJ=Qдю ђІЊY8|<›ЊОрvеЭпYt&ЉБЏЋ 0Q|]Xарg!ЕiZAѕ“:їЪФЗhњюЭЮ"tЯњ4SA8ЪЊ&ИъЦ5—HФБЃх#=Q Evж•ŠьшfМ"џЄЇХѓ^NК’ЄЁМоЁSI+Ю6ЅTЎж„œН;{bъŽpфJ8с‘^S №ш:2•црИђхTТјЈLчp  ѓПŒђnTž/€4И{№’ЪBЗ+AѓбЅзЋ™•а~№‡ЖкИ(ЅХМя`Ъ[HьZškн ЪЊќ\ˆёHш“ЈkѓЂќ+№2фшаПўGп”ўёMa„еЧ7EEЫ9e†м рШ cйšžšчјoяšQЅn§”ЊюW"JHA“uО ЛCƒb?б+•/ŸŠЊЁƒЖЦ<owRю5ЈІЈOўЮ›Ф5оZDЗN7+Ўi eќCƒЬИП[‡?•Ё_гqŽC„8ŽMљЩOФБNоPљGhА"3“І~XH-H | оŽD vo™ŽљЈ„‘1иѕQљёt4U.рQ(4Pџ„яЂ|zHPHŠUž—О‰–ашŽdKў>$Б:О элн_ _ЈЪSFЁПшUмEђQ5$)GщзёнЌQпј[б^{yЈjб]вІBХ.kА”’WнŠ ѓg0|:1ЪяЊ|ЏЅЇѓЎOeќ6№}з+ђFwѕ3Ÿкюзр`WєсЖ*џ‘tKб {qЎSL^BЮШ}G иJ=s`y&о(ЙЄ_@ЙЖы)фVА'! >ћ;X ›’™Y*_ц`чЙTџ‚ЋP} (s&ЈЏДџГT8^Љ0:TЏTƒZЏW*МЎѓ%•ЖPјwŠџ уйv$YАмgУ%іј%ыёœ*œu‰нЦQCƒ№PcЗOBл˜…;ё0]§•‘Уэ†кЋA „јcAQёї7 2­§6ЛхпѓSћЛ Ё§Шm5ЁY oœgерС<Пш$ЁЎЌчЁG о‘?л7оXNFэўxg+љ5(FєЪ oЗЏ›жd4$ŒЎ)/`N:Й^Чlѕ$ љUЅ(^Фхч9Иу+†aФ rVўI@Ю§{bзжЧWq8B/$!rOžrш]шžšысUhАBnG7ї‚b/ZїРGy ђS>С#чdМ‹›В"…ЦЪчыv—Ÿ fб91Ф9™ЦЭїVм_,ёv'YМ–)‹чНe(kьцЃi@Й*­тНTOУ —аЄ;Eв jPЮврХ†dЁnЅь|Їщ‰о˜’їFђлц–ŽGВѓмк –БгІюЈћЌ Г:КELl\(’g{Cvж‡Gщ‰ї9Ѕ3ZЦ8O™аўЭлBlvWС”ЉŸћвёіРдUїБ’6рђrо?Q(q;^\VЪAДZi Œьšг‘„ютДбю !ъшЭхŽ!™KfсМХЬBI§K2ћ6Œw0pTЈ@‰fйзЂ  cU(б,˜’œ’Y8е2№TBЪDJЩ,ьЮЩ,Љ‘ъŠЕшœd– ћZNд,C…НЛ,š…НЪ Œš dЮЧЮYчŸY%„’ГЙ”dђЗ(Щ,кЖУ$%Гёƒ’ 2Pњ(™}u7Kf Щ‘’YДђJLDиЪйё—3 ћH2 йk(™…l9”ЬBЄ’ЬBхV ™ЋЖP0K@iЛF •м6и-Й-ql[6dѕэСЏ‹eBO‰b€т#˜…bЖ12œѕДЁёV ќж­JХKЊеXчЊdВPˆdКDВ@‘,\Є"Yи"ц=ЏHvƒH.‘ а7Jи{ 2YB’иBc|„Вlp&fvЗrULHžK3П™ЋrЭ KP–№žУТ>т/Ё ~8\0"MМЁц’fх‹пF_В{Œ$|•тLдДо~ZƒoCїАH*Ё["Y~mI`ЩВaL‹d Щ—э!ДЦG$ љgS” љ№B$3u(‘,Tц Гл.| аЌy4иВЛ]9sўˆг-‰,Яs;‰,zџHd8ы•Ш‚Хj(…іŸ9ў[$›лЁ&ЉўTђ"˜,jŒгљХ[€кФ6ц‚ЋžPЏ @Œк‰Ќp јіЮј>I›иgтМрГB‡†VСyxП'Э|Б•[ ‹ ПmвА—€мžиFœ“ЙОƒ<ТŒ№F7 ?‰БсгW–ёќ €фїc{M$Ю€ЩчgцБyжгX‡^§}LОˆЄ Щ€Тиќ( Ф%%0Иє[cѓЌ„ъ/ДоС.:цЉ8SПrўщяœЄ1&=QтZŒЧ&;ž8е†_SХЛаРаЂќc[8KR5ЈŠ^Ў`š ‹~8X6зdДЦv№ЅX–БmgMyu(I,\ZRlьSƒ ПW&oЮеЂ ЃАZ^fЅЊgє -/ ЩЂ"ыCюрiˆР мЙДЩЂс•sG…„Ÿўк5˜ —‹дЃи Б 9-c›iЄщэЯ‡@Ё„ Е t™iєьЊР@нw]QнcešœiЫpФMWBlц{U’.Oїнћјt]sdдLЈJD4ŽsuњгWЂбфЌЧБKbђђCIˆЏ ѓ8|]фДПаў_ЦŠ‹yИШ­юEшњGqШ,5ўM|Z!ё†$˜—i;B8ЗyъьЛ !дНае#Ч№иХ8РЮЭАЦќИs;ДxЉЏвyНЗ#шS(јC$PЦ07y‘і3еѕ;AМU?: ћЂ§6‚ЌояmLH'k тЙcИфБ1б=щ б)Ьм3kР№У,яJл@B‚нљг$ОL uопЙ" ђМЮ<ЅЁ‚v№YHHx$яM0‚ˆˆƒ)г sФѓ‰ЩђDЫY"ГapцмЙЩќRLЭЃˆќЇˆ^Ї:G_ёHOtxЈщЉЯпИ7јйхXј @ILЕЧГbЧR„žЌЯLэrBRсNhЙщфœ“1Џ‡ŒŒ•)0І\ &КЫ­ъrоmмшmАб ЙД“ЮNГY5Б‚хжO§ ВL%Є@S.eИ„3^‡цˆdя'эMф|Ен˜k•3ћ${џmМ[){ІJxCцЬэф&?§=\ŽїQ†\^s…ЭКц*Ц4y'bщЂЂ{№эпюЋю†єдDџz™З0JxиU>™ЧE fБc{™пъœftŠ6рМƒньидЦŸ79ёУСР%uоЋX`ъњTх _My _VS.›н‚'ІzoеrѕppŠRОщтgŽКuROj›ІЄЇўОЉГП`gИdsЂ?ђ СЇaз‹u7Їj:ї=™лбЋŸћL <о~UXžTŸ^ёЗж[јV1ЕBЮЪ@ОŠ“М›”tpвMуиm~5кѕєj2Сu!š’RНT ЇQЇд&/ГЩŽ<ьц‡QЯЉE+і^к;Фk%$уb?Хq‰ ЃЛжюсYT†ЉЧc(mў$Џе˜І%ѕНQОМ=‚R4РB^xbѓЃW@w­BLtgЗђЇ’ш{„uЊзЖSLC™XUг,ЙРХДLЛљ…xЄжVјЩU/ѕя)NyтmЭакіф:œиљTЊŠGYл~] НЊV–dYщ—ЗS6,ЄБЊ|ZrM‹FЂэƒЪrВRЄђцr‰x9)нЗeхЕМрфPœ˜ЖUгйлпШю@x:ьHT3ЏŸiDЕ˜щЋJя5'!)М’|№š„шЦщ_8щГd1‚&шэM…†Ъ€8\ї,QТжџыо0šrЏ’їXNЌКlУТФъЎœou—џLЮiUюYƒU›qА[e?’LЪ“e>4X‘ІНJ-‹}щ‹†Ці?нэ|žдыЂііЇ€џi |Šт 6!ддЯХЕGDБjўш"№ђЎ§+ђHЋФ„и8NЫžˆ/˜—ˆз ?nЎ%ђШ‰ЫM*nмPI'ЛeЙ аЫyLc›OЎB\^ю”CB[хЖH CЩdGДюСgјщА“=‚]qЂ]ЄVгN[k0KEЗY-т§ЩСbIоС—Є3Œ `беJœ\TаoЁtи=S‚SдоUŸУOпзоЌЪ”Ž+XhXІ Ђшˆярѕu. љkŸЧ\Œ#ыI(X/LЈw€+ФПе@Ў9ТgаљmшhH~PхdтсбL ŒЈђ3'ј–Ч~ЎЉO КтœPЈ8hleo№ЩЭ‰9TŒqPet|э#}шL.yЪї&.ЃШ–HЊ]sPІ+쇂Aš ЧТ=„~ЗR•Ÿ­Ьік[fЉН!оСƒю`wšў •O[Ў€ѕƒ=”жуе–GСџŸm"^лФjРˆЏmbѕэфдВM˜•^гФ*UMЇјoгФЅ= iљўCXЊдпKyпB'П/t‡ChфsRдG.dаylЧƒeOрXЅнKЁєŠyyjbšЂyoАDBx”iЏТE"ВaP­žcщ)ЪcЧЗшВ2‘єчкžŸўаŸ&Ълт\$жЅ чPaI_д„Ќкч•8єЊЫп§эЅж'?ЁЮEЅв№еR“r˜0>ЁFЅПи^ ЅL~c8u =кBn0яЎВШ%4Йп@уЇ‘ЫУ+cRЬRr8LKўFCeƒв3^vmœм–nП "J—/Ÿ,Б6ЃС`њN‰e;ЌмЬВѕ;№KH…eФwœс,K)ещb ›o+зeЦ@dƒ\o0W8QP’йS5’eљ>!~xsь*кxЪYZЄѓDUНлќ`ђ˜€К4ЖЧz6‹^јж&йq–Гїє:r6PїZ_hз<ЌџЮcуЬaؘ“ајcRЙЉ‚BAќjя№JВ ё2АВ[f^‘Bš_L Ю'к[љZnŽzŽЂЊ?{x ЛV]xзФЕЧСkЫƒб€Fpиюћнi_K]Ю‘YaЉ8$ВїіЄ‘OјPyY/!(Њšѕ_Œ7o,KG1ИєBѓЋ98\Agž^ЂцкиA21ђуJvcАY‘ЭюD|—<)ЫGњH‘1@Їчн83 mЮZvˆй­Oл)b‰€е§TaEVшAƒтХ…7иЪ™лœэsћaЅ  ZŠ'SXњ-„еT‚aљ;…†_‹}€%dX!iьЖ"#v›SuЛэ›ђЄBУ%:мюˆя;k/і"jтІВ‚З\ мхNПѓжJЊня6‡7~ YЄ9vЎ?WE_љЁ;‚(\ AЫ €[ЩxŸЩОnзЯтsъл~ўтRГгпЎ}•—–ВYWFРћyѓHmАкА—6ЋUEŸпЗD5ляъ)АHк Жk0ЌЋ}Mј*бON;ўћQ:œ…вХ’Ї)L Ш€№{Њ ЮCy33_1!еˆћхГRxwЋUДm}}BЯЕ*тЭw/љЩЙК—ќ @Ж(„Ÿz:Ё§™Й Ь5awКЦ—• ћc%XЯeП­hрЇэIДЎ“ѓхk~њ8}С-а;yбŠ1зиYaц I;!*њOxАѓcqMЁ œYuИ—ИJаСLаЁ‚~B?Џ•`) ?­ -щя' AŒюС*4>а;Ы.hќМV‚lPЕ:u;H‚@ћЬ›wYЮђВмcєёWjс;шE0фь!ЃьŠ/аќЩUЪ5ze%Ю3§„нТfxАtƒѓ>Мњ#—] Œœ60ƒKš6!фБ{І ПTtdƒ< Лэ-рч5$,io6­ РЋM;јKKoe@BЯўЉO_OЎhx%ѕЕЩTЭ/"У\™юrVе4\EлгD "AЏ‰рв6G СЅXI С]ЮжjтЖA@‚+O#ZЎТ‹i!Ид О‚KяnY.Ћ9Hщ/ёZюqцоЮЙd{арѓ'жс2# ,*ЭD ИоВЌ‡MЫB ‚ƒ0•e Ш†ul 4l д>>аXм?4L\АŠЏ…‡vиBрM Ž~|,йpцЧBА+§|!ждоЏGюЖdC[жћ'ЄdpР|Ыщо(гfУlпСa€ѓкV”жАlГиœW ўп –ŒH№ћџўŸџG^ђјIщ(џ]ϘтџљП~Ÿk?џїЯџWнйѓЖ ax7џ б)T:ŠДДжh‹нЊ-шВфџН{я(г!Y•r3 ˆљŠєУуЧQф!ŒЈFNп1”v[—ЦZ—Ьw$Р%.уЈ№нЫ/ОыpL5"Žs<S#кяг`єИФxƒdсЄф)ЛЯskЂiњєy/ŠWПВCяJM$iђ—ŸбђaЙ;МџФЂЬ RЗpСsq№‡1ды8чЗ[žЭsвwRР\Ѕњ‰ё[žчoї?Кхынсу‚Пэ_hOЄЃчкЧ‡7ƒЕ,fUʘмФHFšЎЅѓђŸ2@СпLYшˆ“y@5 ‚ I'!œиќPƒGжчuXŒ/ЩlЮ]§о"Bs Ё [CayB#Ц”ЏџЧ/›рьPдљёŠт9;єдXдkC'є:ž`еИqФ\[NaЪ5!G"9оСЈСД9Ж!‰i#gVШŒЬ`›€EXтѕ йп&‘о^1[aЈ2ЇK:flIиФм€6ѓ5Ÿянё|оТ ]TЯАЋˆnbзЌwъёBQЏ;ЪАДˆŽФbyю=fмб<иLМqg‘ЛФВС‘И‹ЄмšрщЙД4лмWМОм`1т oMВШЂЋлПЮоЎh‘&ЏЙФFEЅАЂИmќšФ СЂXŠ`ЗѓN{<“ѕ#T PwLд€ЕS‡^!b@И"PT$И`Вv5TzљМ^ъэ M—ј–`Œ_єЭ‹ќњjPYs№B6!ьqќX{ћНCQляŠтfЯЏ]OляЂ^ХљаdR{8ѕœbчdА”PЌ‘т F?H5*‘R|‰3’’Sџ‘Ѕ2 ѓкСБ_ /‹ЏœЙззйg)оф˜ЌНМjъoі8+}иЇZwт?ЯQБVbК™з ЧД5еBТlмM#Бт:+ŠoWШ=zŠ•3лT!ЇdГј‘МљA#tЮЙk!охТЅуЭzo–iVЩ GФ|”s№Ѓи№)*џ‰ endstream endobj 114 0 obj << /Author (Andrew) /CreationDate (D:20100902223238) /ModDate (D:20100902223238) /Producer /Creator >> endobj 115 0 obj << /Type /Font /Subtype /TrueType /Name /F1 /BaseFont /ABCDEE+Calibri /Encoding /WinAnsiEncoding /FontDescriptor 116 0 R /FirstChar 45 /LastChar 76 /Widths 117 0 R >> endobj 116 0 obj << /Type /FontDescriptor /FontName /ABCDEE+Calibri /Flags 32 /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 750 /AvgWidth 503 /MaxWidth 1690 /FontWeight 400 /XHeight 250 /StemV 50 /FontBBox [ -476 -250 1214 750] /FontFile2 118 0 R >> endobj 117 0 obj [ 306 252 0 507 507 507 507 507 507 507 507 507 0 0 0 0 0 0 0 0 0 0 533 0 0 0 631 0 252 0 0 420] endobj 118 0 obj << /Metadata 119 0 R /Filter /FlateDecode /Length 54023 /Length1 101840 >> stream xœь| |SUоі9їfOг$mвІMл$MWK[(Z(4tƒRЖвкBЁЅ-ћf ШŠ VPХ}_PAMƒHqEuХmuTаЧQСнqц}nў9lЏњОяМѓ}ѓЭяѓІЯ}žѓ?Ы=ч–ћЖ2ЮГуІb+ъЊG=М%‘ёЮŒ9*Ы*ъЪп0ЖЃ„1M|eйиђ}oЫfьіG“7ŒЊЈЌbЊY(п€VRFMœP7ђ€ЗžБћ€]яЊѓ—}љВБ‡ёІ"Цю uљ цtі2Цџˆђ-m [—tюXœЦXьXЦЄ+л–/u?АmяїŒ•ыSf-™Н№лoЧEЁƒ‡г'ЮnэZТ’˜Яп…њ–й VЮ*ѕut26кЦиШФ9­эяgкKбў4фžƒщ~ЃŒє•HЇЭYИtХ “?УГаkЬќŽЮEƒ[‹юgьђЏ1žu ЗЕž{№ <џтўŒщ,l]Б$ѓЛДQ}fюE­ ;2кk2vеRЦЂу–,юZrВ бŸЭJў’ЮŽ%Ё?D_SŽсqFІј–Ћ]З}ЃŸa.љ†%`XИљdЭ ?™9Кђи€О.§Cк›д3‰б…zжЧјУxфoж?nщ”K•ЅXT­l*SГILFM ЫgŒyсчr&ЋД|+ruъkебd Бќ2ЛPb:&™е’$ЉdIu “>ѓ1їjбіИ:З›С№ЃŠњ НIЪp3vГ’'яUG+#EыбьŸrЉ*Xы?ЇЅ“—: ~љ…KRБ]џhлrѓ?^їзыєK~ž-ќgЗЉ:-јЅ|ў)Лѕm[:єз§ѕњѕњѕњѕњѕњѕњѕњѕњѕњџу’Ўч†ŸЭkaG~6OЭЎў?гЃ3žгХ*ќпxжПуЅК’Эžg^љS6ЈUљYЊќx0['Y!И-\.šю:й€шцmРЄpЙr6[кТфsй4Й‹5ЪЛX†<‡ЕЪ{й"ЙšхЫ{XЭџЊYџэўѕџЉўЩ6šЧМR€еHїБ‘вл,]К kф=6UКœH‡Оџ›КвЌˆУH“X‰TЭrЅ1Ь&UЁN-ы/БTi KџŸ”ћ]rI‘БЙ)NЋ˜ђoD)ЬK4ѓА"•?“?—ПП”П’ПўЩТ1ЮђУjФёє_Џџцхе>czѓДЉM ўњКIЕ'Œ7ЖfLѕшQU•хe#}Ѕ#†— Z\4dpa~^nПЌŒє4oЊЫaГZЬ&ЃAЏгjд*YтЌ_ЅЗЊХШh Ј2МЃGч*io+ ­ЇZn˜ЊN/pЗ„‹ЙO/щCЩYg”єQIп‰’мт.a%Й§м•^wр`…знЫ›j ЗTxн#a=.ЌUс„ 5м•Ž9юoqWЊ–ЯщЎlЉ@{=FCЙЗМУлѕŒFЈ@–wIЯСУBЪЊк#1Iyl@NЏlmLЌmЈЌpz<a+За”ДсЖмs•>ГKм=§іwoюЕА™-9Qэоіжi Й•КхЪюю‹жœ@ЖЗ"НъЯ Й#аЯ[QШёЂБšI'Ръt‹зн§ CчНG>=нвБhв-п0E*C<с&ф Эа7єуѓx”О\выc3‘lЈm Д›Эt™/?Ї1 Е(9ћEŽнЏфl9'ЊЗx=ЪTUЖD~–Яq6ЬtчіƒїУ?щјAО; gДЬl›ЃpkGЗЗЂ‚ќVп№U@јZ#c­ьщŸђ­-Ф\Х Е |я’€Э[F`p+s0ЗЎ!\%R-`+А–ЖH­@~e…в/wewKuPiЫ[лА ъфvюШБFЅИrLJFewCћЌ€ЋХйŽѕ9Ынрє|p_ЃЗЁЃQ™%Џ%}ѓ„ŸЎ…БQZVFЎMзЙ$ЇмЈЬ ю*мМe%ША`КТIeFЫJм мЩD1<%RBQЇЕƒ„œ^>ZЩ’•ЊхЃžF]Па%gЄOъє€ю”Ж,0œш=чgЛFЅ•eЛ+;*NщрiЊ#ŒДіг§”_DŒ:e:G‹,9;6 Э„MЪ,:м6бнрэ№6zБ†|”Б)ОЯoMЗІЖЉ!<л‘URZŠђ‹(`d‹„TŽ5X•угN ЇO$GŸ‘]-Внн:oM]ЗвИ7в scaаšŒъжKŠbakVсtѓVЕzёТЎъnэ m˜йнуѓu/Љl™3TiУ[ноэ­k(q†ћ:Љa­s•ђЈVУkъЫrћсь)ыёђMЕ=>ОЉЎЉaŸ…1їІњ† ФЅђ–ВЦž4ф5ьsуp[%ХЊ•„[I(-MBB.ямчclC8W6„гmНœ…m:aуЌ­W"›Eи$иTdѓ…mЪ…IrЬ‹qмVКл•щYг8ЇЛЅQй\,S‰ро, yGєpI0x;ЪFo™b/UьЅdз(v-уpŽr&uЗxqNaA50'ЇЅ(+MК{CЁњЯAч‘F–к4 Љ! ЯСйЏNƒrЃДР<*АЁ­Uщѓ7(uЕщеmXЖЂAЉшб‚>вJT…ы(Ы•к07˜Рp§ H64s”‡6Ьm /gK€іХДS›ъ хAљн1о‚№оФV0Є_Є}cu dq"‰‡5’“ДQшy›Ym-nx[ХкъАдщ,58Щв#Q•б†СЩdЪАфtЃЩачЁAќ(꘯lIuКЖБ‘:N])€g[Fє(уWF*Р;ШЊVњ‚Ÿ‹аUЅш“J3ЕНl’wNЅгс–ДШ˜вЋ[qјS}#,о"QYЇœЦHШЊUFПЫщѕНЁо•žSЎм~^хх ,Lцм‡…ЭЛЯ4Іцфігi5…Энн:гOW щL'X1К+ёж`,Ј—нНвљъ| ФF!Ют\!6Б^ˆuBЌbЋ…X%ФJ!VqŽЫ…X&ФR!К„8[ˆ%B,b‘ …X Ф|!ц 1Wˆ9BЬb–BД б&ФL!Z…hb†г…hbšS…hЂQˆ!І1YПѕBд 1IˆZ!& 1AˆёBŒbЌ5BŒЂZˆбBŒЂJˆJ!*„(ЂLˆ‘Bј„(b„У…(b˜C…(ЂHˆ!B ЂPˆAB Ђ@ˆBє"_ˆтc!ў&ФGBќUˆ…ј‹т!отА‡„xOˆw…xGˆ? ёЖo ёІт !^тBМ&Фя…xUˆW„xYˆ—„xQˆƒBМ ФѓBќNˆч„ј­Я ёŒO q@ˆпё”O Б_ˆ'„x\ˆЧ„xTˆG„xXˆ}Bє БWˆ‡„и#ФƒBь"(D!т~!юb—;…ИWˆ{„И[ˆBм%ФBм!ФэBм&Ф­Bм"ФЭBм$ФBм ФѕB\'ФЕB\#ФеBlт*!Ўb›WqЙ[…ИLˆK…и"Фf!.Ђ[ˆ‹…и$ФEB\(ФBˆА‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡‹А‡w !т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.т.Т.Т.Т.Ђ.Ђ.Ђ.Ђ.Ђ.Ђ.Ђ.Ђ.Ђ^О[ˆšƒ)#\ˆ™ƒ)vаy”:7˜2ДRы‰жSЂ@k)Е†h5б*Ђ•Сф‘ Сфrа9DЫ‰–QоRJuu’ёь`rh бbЂETd!бЂљСЄJа<ЂЙDsˆfЭ &U€:(еNдF4“Ј•Ј…hбtЊзLЉiDS‰šˆ‰ˆІM&ђееM"Њ%šH4h<б8ЂБD5Dc‚ЮjP5бш s hQUаYЊ :Ч‚*ˆЪ‰Ъ(o$еѓ•RНDУ‰JЈф0ЂЁT͘Јˆhб`ЂBjlб@jЅ€hQj,Ÿ(ъхѕ#Ъ!:‹(›(‹(“šЮ JЇ6гˆМDЉдД‡ШMѕ\D)DЩDIDNЂФ`тxP‘#˜8OGF;‘ŒБD1DVЪГ™ЩMd"ŠЂ<#‘HOy:"-‘&˜0Є&д‚TD2%Jq"&"ъ сЧ)uŒшGЂ(я{J}GєwЂo‰О :ъA_u Џ(ѕ%бDŸSоg”:Jt„шSЪћ„шc2ўш#ЂП}HEўBЉ?SъJНOt˜шхНGє.п!њблDoQ‘7)ѕGЂ7‚ёS@Џу'ƒў@єOє*б+D/S‘—ˆ^$уAЂˆž'њyŽшЗd|–шЂЇ‰§†J>EЉ'‰і=Ay=FЦG‰!z˜hQ/•мKЉ‡ˆі=HД;W уІ‚zˆDнOtб.ЂDїуp^ѓ{Ј•Л‰vPо]DwнAt;бmDЗнBt35vЕr#б ”w=бuDз]CЎІдvЂЋˆЎЄМmдЪD—SоVЂЫˆ.%кBД™J^BЉnЂ‹‰6]Dtaао К hŸ :Ÿhcа> tбЙAЛД!hЧaЬзэƒAыˆжRѕ5To5бЊ НД’ЊЏ :‡h9б2ЂЅD]дt'U?›hIаоZL-Ђ’ ‰Э'šG4—ъЭ!šM=›Eе;ˆкЉdбLЂVЂЂDгiаЭдГiDSiаMдt#=Јh uw2=ШO­деM"Њ к| ‰A›ђ„ A›ВМЧmAу‚Ж\аX*RC4&hC\РЋ)5šhЋ‚Жu Ъ э"PEаЖTДm•cЊ@#‰|DЅD#‚1xПѓс”* ZAУˆ†­Ъв(&* ZG†­  СAkЈђ Zћ Јф€ UXџ Uй›љDyT=—žа(‡;‹(›Ы"Ъ$Ъ JZ/ЅyЉЭTjгCЙЉQ еK&J"r%%-Э Gа2ДЬХй‰lDБD1TСJ,d4E™ˆЂЈЄ‘JШЈ'вi‰4TRM%Ud”‰$"NФ|!ѓL—‚>s›ыИЙнu њGрр{иОƒэяРЗР7РзА|‰М/ўј 8 §Sрф}Œєп€€ПFЯv§%zŽыЯРРћРaипооAњOрЗЗ€7?šцЛо0 pНўƒiы5S†ыїРЋаЏ˜r\///"џ l/˜Кž‡ўєsаП5Эs=kšыzЦ4ЧѕДiЖыъўэ=< јBћqxx,ъlзЃQЎGЂК\G-uэzНА?ьAоƒШл [шРЦ•ЎћЋ\їзИvзКvзЙюююvwws]w€onC[СЗчЛn†О њFршыбжuhыZДu lWлЋ€+mРЈw9клjяКЬ0СuЉaЖk‹сNзfУзrКы|ЙШЕ‘ЙЮѓo№ŸЛsƒН­нЮЕ~уZn\ы\[Гvѕкkп^ыЇ1ЌёЏђЏоЙЪПвŽХЮsќЫw.ѓЋ–й–-]&НŒя\Ц+–ёўЫИФ–Y–Й—ЩQK§ўЎ~ж9БsCg S5,аyЈSbмакПЛг™Rі­щ4YЊЮі/і/йЙиПhжBџk—6чч€ѕР:`-АX ЌV+€s€хР2`)аœ ,‹€…Р`>0˜ ЬfГ€ hf­@ 0˜4г€Љ@а4S€Щ€Јъ€I@-0˜ŒЦc` P ŒFU@%P”eРHР”#€с@ 0  EР`0P Р ?фЙ@? 8 ШВ€L Hв/ x7рR€d p‰@рт8Ри€X АР D& 0@ш- д€jdw0жЮaу}Рqр№#№№=№№wр[ррkр+рKр рsр3р(pјјјј№№WрCр/РŸ€їУР!р=р]ррOРлР[Р›Р7€з?ЏП^^^^^/ЯПž~ < << ~<< ьžіНР^р!`№ А=@xИИиьюююvwwwЗЗЗЗ7777ззззWлЋ€+mРРхРVр2рR` АИш.6Аі‘8і?ЧўчиџћŸcџsьŽ§ЯБџ9і?ЧўчиџћŸcџsьŽ§ЯБџ9і?ЧўчЮŽ3€у р88ЮŽ3€у р88ЮŽ3€у р88ЮŽ3€у р88ЮŽ3€у р88ЮŽ3€у р88ЮŽ3€у р88ЮŽ3€у р88і?Чўчиџ{Ÿcяsь}ŽНЯБї9і>Чочић{ŸcяџЋЯсѓЋё_нѓЫ1c:cLљ0єm;э—Ї'ВyЌ‹mРчBЖ…mcOАЗйLЖъZv Л‹нУьIі{уŸљл}+е Y”М—iX,cЁBGњюzебЇXЖ!ЋrŸД„,ЁЃgиŽіm Yњz51ЬЎk’^…ѕ+~<є^АH‡+iщ"hsИЦк›њшлq†jY›ЪІБfжТZ1ўv6‡Э…gцГl![N-Bоlмg!5Ѕp˜„ѕЩR‹й “-eЫиr|–@wERJойсє2v>+иJЖŠ­fkикШ§œАe rV…г+€ul=fц\v^X &ЫFv>ЛГvлФ.ўХдХ'T7Л„mЦ<_Ъ.ћYНхДдV|.gW`=\ЩЎbлй5XзГЮА^Ж_Чnb7cЭ(yWСrsX)ЙВgиv?{€=іeМF~™ісј` FИё”“џЮ9с­uЛ2ЖюШHWР~о)5–GќЈ”мˆ’д ЭƒвЪк3<Бc }rD”К*<ў“жSНђKVсNёЬѕс”ЂЮДўœоЮnФМwХЋŠК šдЭa}Њ§Іeo ЇogwА;1;ТJ0Yю‚оСюЦоО—эdЛ№9ЉOUФїГћТ3`=,ШvГ1“БНЌ7lџЅМŸВяŽиƒ',ћиУьЌЧй~œ4Oс#,СіDФz lЃєSь7H+Ѕ(ѕ {'дяиѓьі{ЉУїп"ѕ2{•§žНСMPЏАПс~PОmГО.љUœ2гВb6ŽgSe&МпуиPОgНЂB—Ћ}яn‰ЙёізсыyЙЯЌ’L{KН{ 5[dku/Я}АTЛqmщёwП˜ќн#1ХљGxў;‡п=lљтEkqўРУЏаŸ[=ж0lб’VkгxSѓЄТЬŒСŒ exSЃЅАmар!#ф)’l–’’цђЋЧšф Ч5в:oщфъ”DГЭЄQKIŽ˜м’tKндє’Мd­ЌеШj6kHYjЭ‚ЪдЗДжd{\rŒN“gOЖjП­ŽўсKuєхЊ?^)k†M+M“Џ1ш$•Fг›тH8k˜ЇzВ9жЂ2ЦZЌq:mŒ5*Ћbкё эIJIv;Еu|уЌ5єЙ*JяЭмФ†хє†>кmсуРŸя6‡љгнІ0нцvСуЫL4s№|цaМ_0ЖNѕ?‹Вў<ЏG?Ў|эˆž8ќђВМ~`@џt[Дцwhьї(ŽГлR$ХŠ›TQ’ZgѓЭX]НюљЫЦеme}бМІ*ЇN-ЋtF]tС„Г'Lов>ЄАmыдq]ЕƒЬZƒFоkqФDлВ3ѕw|qу­Ч˜fwŸхŒŽMŒБ%Хъ3ѓ3+/|rЭъЧжЬШЯаXS0ђЉЁЃЊj7+eЗљ’“’ЬЦэА˜•Fь0D) cuєJVŸ‰=‘Щн™ОЬ–L9гё’9т%sФKцˆ—Ь/™•пnЬФ9zЙсСддтќpж­g‹ыlНМ_O>|і”•]3љыЕццЄ`ЦвћOž<ФъIЭ{в—й­Жhе)ОUЉVЈtQкЈЂщ›цпЛМДrе=%Ћ ћ^ГZUњ(=Поcˆ:mfћ€эŸо>Йљž#[ЧœзQ™hPMMŽеeфeŒя~|ёš§чW$'ѓ•ЉiБNЋNgIŠщ‹MЬHNuD5яњќЪы~Д&zГSсЭ]ЁxƒкЦьlтовј ёФЫ,т%ёR˜MaўVё‹x‰=Œ/Є†аўНv>Ю`™ЄіГвRžŸCЃаП9]l"kdйyƒЮцIpЄкtzЛ'>Сcг%bЌjЕ6JЇzK(хoџv1&з W‰lє>fЇюи#нБGКctЧщŽ]љMKІ7OВїђœMН2=<џ шNИ7ŠчOєЦЊј_ЎQщMњутГuЖT‡в%ў2 Њ›3VяЪTн/Кѕу­zk’вЗ…ЁЯхЊўи2У‚–й+№Ђт~ЬO.M–’S{yŒЯh%}ча€4 _//ьбЮUЖUѓ‘№ ы5кRЇMћЯm)yЃ.qPuѓСѕUЃ6ь^?eЬАDНJkа3J›}U]Е§ђ'ŸS=|Ъ№,“эšdOЂ')vдХЯwю —ŽБ$yНž˜DЋЮ•–2dііц™ллІxS44–ЁЃђQUѓБвн))f‡ђ, ЫПШg(є~“ ЦЇПAљO,CgaеЧєєŸЋИчlq~О…ЦrињГ §Ф=qXшmД|ъ˜хЃj­^e0vсиЩн­ƒ†Д]\›зšљЉжЈUЉpу3тмЋgb§фьѕЯmЎžАѕЙехў!6ƒМ9жiб%Ї'—ЬЛЊqцій…qvžЂЕ$ФФ$˜ЕЩЎО6[В6&1ж8vѓ3ЋжПИu‚нхŠuaДЗb­зЈ2Ажcї1&й4X:дsТЋіpdœО\kt6w‚kBos;м6]Мш›ќ•†”FiН‰vЪŸФЂ]І5uР]б=Њйb*эk~b§IoZЬ}.[6Fј |БВ*г<ЩљёŒcчj­N<„Bпђ?ЉЇcй,z:н9ЮR…ўПѓтЩ (”3"эЧžљ{LЋМD’bДVЎГ{“œ^Л.ZŸхre;єzGЖЫ•• чЫtx>Ž ќpTL”ZeњБи“у49On‚б˜‹зђ‘аў€jFИ'юGYœдЮмЬ.?dДœ…~a™МѓЂх€В@Ÿь[І<шчњv•жьДЧ9-nеФІ%9ScЕz}\ZrRFМ^Ÿ‘”œЇч…XіВŒ›ŠВдjЃ9ъ˜;9гa4:2““Г †хџ\wuшя|;ФŒ,О‡izCћТ1ЁбЫcYщAPOв\(‡№рq|Qўˆ’< GхчUЪЮЈфJyвp|s‰ЦtЈ˜rШTЦBгˆКсљЫ‹БіMСХoг™єjў}fŠ+#,1b•RZ9(iхNФ=[сЗЁ#ЊBе@|‡Ъd™O„џИœБм ,ЧЭгМН<ЎG=#МЭЮpŸp–vащч„ЊАdѕ#ыЮлЛ|ˆТчі.LЛЂn\з„ЌДБчд[:!KŠ]јь5M“Ж=ЛlТW<Л~ЪеK|%ѓЏ˜2eћйрmژͼцІQe!2pѕФ{ЅФнЬeьхeЛ“Іbб•–‡ћ^;\pъ^бj4сЗйt ь’Ц`wЧЧЙэЦbуЃеВЦЈчgЉЂЌŽ˜WŒ6AЅLЁб 7^iT™Rжk”ц I ‹^ЬФй1<4‚•эУКšћаРt|XБђЇ4FЗЛийЫ‹}њ"kœЌЩ›f)юхC{4ЭpWAiL|ёF№кС№љtјФЉOОSКXё]ФŸšp—УqaјmpБк`ж/6ХEыTzГ‰лG5 Œu Ј8Ђ}LЃЦЈS!ТГ›вYц?j~bEWУ'вй уŒбk­)Л;!VџqIЫФJOІ//бщжX’тЂу,&KZЊ#sьтЊA3ч.ЏzBыT|^лз'ЏФh›иф}l Tэ3MєgM,Ыš81ЋLŽNю•цюeбБУc‡;ŠzЙУgЈёч…RSе5гš$єЈ[•uЂ Х ƒV&~ШЯЯG\b9yЌiФтЁ˜N8БЂNX~Ъ-іY^9ЌѓоХ•]SŠ№*”UНЦ8hвтЪВЖŠд~u+ЧЎŠ2ыUjйИЄlnufbсФТa3Ч4z­JRщьУќ K›65хКGLZКЈ.]э%sJт\.ЃЩž›`жx2мЉ#&мPšЊЕ$кc,oiурьъС.oЖWmqЦ™уЌбЖto|^§ВЊсs'!Ъ,˜ДHљЄ† ЊœМgБкЈЖХі•xFЇ-ОmюР=ѓo_\dЖ;l™K‚EяHŠwWЬ­.m‘"ЋU‰щ’ХэжХ&ХІeѕ]Ѕ’ЗnТL­ ‘пBд^РЊиаžьсЪ_8E%&F ь•*їВЈМPQ‘: ƒ Ц6–ѕrЛ8OлЙрФQЈ RufиЄЅщЇЃ6r:Ъo.кqіЄ5ЭЅжиќ +яZ”9vdОUЧ5QzCFёјг/œœ#'–oш?яŠЉ™GQSYњиQЅ‰п пШ–)ќџ+ЊГЦ,шОczнН7]2ЛDcMNŒIДшЂ-бу6м§ь} xеЕfнZzЉоЊzпЛднjuЋе­–д­]VkГЕXоWйВн–кВlm–dŒYl–„l0x@’$_Ш@ŒƒЭђ^H2!$ /я{y/УШђТ‹mIsю­вц УЫћоЬїE…OнКuя­{Я9їўчžS]l5љІšќv4loѓ эI”­Ъƒt33VМUШ,@nEЉ.л М4dъ/DэЏq0І2F›IЭ№&=rvі” ЙО†ОЎrЇгrМНБgЂqѓЭ›K\­“=аi@ЋѓЛ1ЗjiИЛGŠhDЏХ]`‡\бЎЁцЊќžyДДОЦЖ Ѓuн™5ЌXY‘ЌXЩ2FXГїZз‰uЂН’ uЧк’Iт:Жк?1ZW~JАОcЩфУ{›іmЊ5iTŒб ЭЌmmюo ЦзьОЦ­VщŒк}ЊгЋ3ЕЙхх<оЯ0œкXЛnЂЅчs[Њ{ъZFW%nкtћ@• і…FЋЯі"р’ѕ•›ч:˜н\kЏ ЈMЛш0ысАgЈеще{БVС_+8]-уДCСiєЏ€г|С–"Oцк“,jX+>=L3ПЖšяаX№~ЪЌњ‰ьKF­UЃXЋ”ЄІ;ћєhК§№<˜і;Ќ~ЗгР,‡<†е5чn•adŸœО›рtлs’ЊœљУ“&-Џ< Н-ЯœPr2Г9щйœєlNіЩ‰ЈЛBёбuрM7V—”š-C&AI(9ocЯ]ъX.kTР™Q—Qвмž Y7ЖM€ЃЈлJЖRЊI™ъ3?Ык|ЈЛšTT2qХъЇщŠšy§VИy|ў˜U9 ЪYіm>џ$іi6CчВbI•d{ы—vНщЋ^›[Њ>?TlhmмоИљІnDЫзни“,^suЗbK­оZйz`иR#лжuHФ–к^мšrakЊО&>4ѕЭdWSCA` БІ№*?КєЋ…жTБІЊˆ5e|ТД+„}bмр'ВІ~U›Ясo ejЧУчЧЂЫvжЖц[‚EЫvжс3э<ђгл—7нєђќєЖхй›~rчфзwDkїмНЮБК=wу9чš9ƒ~ХЭљ6,Ч ˆoЃщ˜WіN§OЖKј6”А §Š‡эŸ#`гќ“`гУf˜з|ЄГ83ылHПТЎJюТŽЬуЊйБQѓ1ŽЊЫ;6ь№PA3ѕ9ЃЭ тxГсЕжMVGЂ%YБЎ1ЎUёjЖъbхŠ\fУѕkbюІЩ-пAП2‹KEЗYЋ`Зљ]УЋ­Ѓ=Ы ‚u%NOа­НVƒU4~Ÿ­ЄЋП&н?qыЦoС7ƒiЖ‘Њ/А‘ВYћЌ‘єHџ HЛьЩzqYы§›­ЃТкЁћrUл:ЪLАрыuКтцо†кЭѕ~иП.Ч†.Ы4CщAKqsiХІЖ„ZvpGЈюЌ8А:цЯ,OдяhЃтіЋж$‡лЄЗxЌ’ @е]к-nKКTF—еь2rюT[LЊŠ9нA7gtYL6С`ђ{­Ё–KЪзЗ$x†+nоŒб62sŽЙ™ ƒљЂjžH˜№7Š8Ž*=ЪšьEžд)6Q |AžЧк l2з`iЁ„>о@ђгФBКйlњКкАƒ…Є™.“™У<КUe Ф§СЄп№uPcеє§єє=hЊ+О3ыy}‡|NГзщ0вЋuFžшћдЕрЂWMНMт’Пgœ€mЭTі$UƒœГ’je+ЉњВњ’%џ R/щw.њКЈЙаŸg‚ЈnmїmHmhIT,™v|QЭЊŠцйРoqGCСauЛбћƒ–ХёДщ}‡лgоz{_mиxѓжRhхuЂл"8Œjб.Jе+;zŽqаIЏGCv@эєћˆA(Оr d72ѓ;f7ЬщrЊ•jxЙЊ=pеdЛJЊћ:у…Э[ЋуЭu^o§в•шwнЖТtР_^RтJl™"еe)ЗЏ*іJеQ‡З$3s˜BХžЅl4ўj€.}‚тнјGQІЕa8=ЮmP€љХwJ/‚ЬЖ У‡žЛўКуWU7zі№ѕp~ЂxхdчІЋ; bЋ&К6^нU@ЙыУGЖoxшд7ю9utћ†‡O= П§Ѕ#uнЗ>ЗO9ЯХ8`Гї$U@‹Y­Cдщu^9ЄŒ}ЏTМѓ:шЕьв;uŒоя0“ LkФЊtjj6ъ<"Л;;Нe™oxJ'VзШрœ$рМƒsT1Яѓe=–+<`FѕlрсЬІС*б гДvG{)нчh•VЌн0Вdл—z“іe7 ПB—b/FЇйkбЊПнъw8 ˆпzЧе;уёюк`АЈ@#њlF‡h УюЬжkк–\wћcћ~Ё5{ˆзљц ŒWёdЄ/@щžž ёdќ ѕZ;\*ЊђяŒеkі}w_гиЦQУ1Ѓ.НjdщlасрЌ'ct.шыЌ0(XmЩlmкrы|аэY§љ:Ћ_2Ќ~{Ш8?ц`RГ›ЊpЬ!+P™мVƒУl2„=Ѕы&—5 ЎЎбб\љ:%цp†e9+ёeдЫО УЌ/уь1;ёcУи8ы5ќњЫТЕ8Їд—;АVѓKr|иЌ™њЭ\ис%ЮZє‡ЪЦ—,vи‚ОƒŽDгџ†(Ы0Ѓ•рsX^Hџ+@žyјŸє/ІКиУЋ[0VПxМ8]œЦX]>‡е%YmrЩŸ‚A.ЙкЙX№Wз—Š?(pMт{V–ТœС>к’_v™„ 8ОЕї[Ѓ5‚УЁг[МVС%h^gАeOч’m –„!L’жLќwг4B™ŸЃfff#ДŠyžЂˆ‡ў sИ xшз+њ іаУn>Qт‘бЅpКˆf$яуНё^сојќ6Xої*йВ а‡e~\:ќН#з|gW<5єНЎ…ѓїŒžx}wj§žЛП)п^НО!ъдвŸПыЯч6>tъ;O‘ѓ#ЙћЎZ_хZѕХg‡ўгЫ7д†[Жп<ыm JRџœ ‡§(ьCa/ yPиТ.qЂˆХяЭ’€}0Rfw Q˜ЕTLym*І04ІМЇS чгиqУЏЅ§N\ЩЉУT'*о 8o…Јx'ф?› ыЁЦ"- œЧBkbТ Єž#Ё—y%ўbМт$љCХХ€zчўўCЬ›wёrˆ@Р@ЫВПЧrі6"˜ДН3kˆUЂИХ|(тGйГŽЦ,Вc-ЖŽГЩj8Ы2ЏkžІS:™9:`VVgТьМRИЦnБgн0Нш|ц\xŸ8ЛqАЦьЭЌJ7ф:Ъєј•!šг8ы6я­“Сћ–бWшŠЫƒw4Ј1ћm&Л`Д…CNозоvtœ€7ŽCРšpFoФЄz€e^ЬВTІІ”с‰_FјV†љV‹Y–Ч№ОТiAнРтwГ(‘€Ь!>ЎщС5=ЄІзє(* ц@т8ЅбЩм'ёќ6*ЊiTДнˆg1ыВpY—Х”ж!ЂКŠ Ы~ЕO`TрE"ŽХ„НhŠи fЦьЂёo76>eи„Vi,ЕыGГ У&h|ѓmЛЊlО€‘ФMМR!ыЫЋ6e›ЋЂј‡(‰›˜РHГ€œ“ыі+Ц†:Г {дR€M?WlГйкТ$Š$PQ ЁpzQФƒBd*tЂBŠиQФ†"VИ"s(ЬЂИ‘еЪ,ЏV ЛvМˆй!тѓS ;Л7™NЬœЫњ „€ЇŸ€5BРяе Dќ^­№ -Тn‹•з*O?O?nГlЊєђFЦ,Т eй/+^!чљxоп•šJЬЯqшПД'YдSящиЭМНЦYќ%ў‚2Пp‡h›ў†l*DІџ бсЗнt$ЈПェ\ŒП§ЦНtюG!њџLеЪбŸ˜ЛСJXBН5UЁЂJŒО†ЌXп—Ќ*eUЊТОbЈz~C6 ЌBnЯ‹ЈqeљhљсrІм‡йыУьѕ‘ чУЮї4]AQаŠ‚ЅЧБЫ:kдSи ЃLи&г—д~(3g–ѕЪvY ПPfЬ‹НЏЫ“Gf.цюЅ-ЕIф =Аћ›ЃЕЂЫiд‹nГˆCO>Зд:0zš7бфаи?Jф ьŸ—(9Zr†9JьГ_žЄDXЛxБ-пUЕфZЦЩгD'СR‘pbЖ–€k J-AЉEnыtzД|П€'Ž чCх‚YЩ с‚7I˜РІ ђќЫЧr›p~ћ8д!NEІЃ ЩD `уНWNё‹Хv”зУ/мсxЃVяЬ[“&­bMFСhЖhekR‰я7BaыЗ~‘~‹ћпДšхƒП 9!њeДŸћ'ШQ)9]єЋє)ЃVrš жf’ЃQr щ—щум?BŽVЩiƒ2ыИЗ ‡WrЖ@Ю}Є–NЩ)‡Z;H§мГ^Єя!e 8‡иЛ1њ-z9‰"ŸЅЌшŽ" 'Рu§Рt0єюК…„Т аo­Й~УњkWEЂЋёyeбWмЅ­%хmХOЊ5^о7?ЛѕЮ=5™ЛЖїмЕЇЖrрЎќкб_Qћю&8{#эЛeE эЇ;pќр$U€{’И(N Ы1яемЕЪЛ‘ФMС].~А_cіX­`(нe4ѓЭiеO3:€yЋЫРžPk9­šž\ЅІyќв›чFK#†UsИ]3•є№І’*9 œљ№xЂ Q@Uœ ›ГМжёfє >§цљ•ŠYoщ’ъМXС%пІАгzуtБ{н4ўођ† Ÿ­+ЌKHVЋbTцтКіhуі%CrcЧДBoКЭчgѕvQА[DннЉйJgiНеnU™‚нcvйŒRѕŠDЈm§южМЁ фЛЦАЧшЕЌaiGxiuxщвp5ct@ЪК)cgqжюn/>њ3џл~кячR/4Дџ"zВаХk>ўэ‰Ъѓ­€Ъф9@…-zs|хФввхUі!№z•Tо[ОЦYжžjз№x?ЭЋлжnЊo7–€љK3œОЄЎ=ВЄЗСЗЂ;к–ікЊ7еKzQTыLГнkЖŠѕUОRIPСŒГъUЭuЩJ‹УтєЬ­оa5zгЫтэ§ЭјЪВxЇW8“Ђг­ оfDпѕ,|GœЩDНšПіRn…+{M‚Љ ы WiЂŽЊщGёЫЫ4ЇV!!ьђF]њЋtЦщпаgЮ9мо{U |ьNП—…ž›\6+žRЉ!O ЫSTB_ЦЛЈ6э:КP2ƒп‘82ы§GЏfM”1јЗјMЦ_&8_˜фХоaМ"dВЩШDЏKЌXjЪDє,ЫР8Е+жXZд”tZуЫ*"iЗйdБЃ 0XЃaњя-IчвнmСВьЮ–Ц(ђТ`ЉєюУџ.ў.cЁђСtх"—ПJmЗ/|‘qQєОчў/7яэŠnоTXБ[Z[ћ§Ы;жї>МЄ1ЛФTP^8щВ5D 3AЁЃ{yк;ь(ы,_жcЅе%]ПЛЌ­И1ŽхPKВ$Г‡$ПP=§œЋ(ДXЄp‘#]VŠз‰ъ™?вyњn!Гf+хчr5РXrŸёС№@у^x§…БгљрвНэЛ›­{;VюЭКП(T†в‚%” F+ДЌћацђфЦыWu\з“ЎмrMGѕЦZŸЗzmuы–ŒЭ_ЗєЅlц К‘Ов‡ђh–'yЮ{˜;В/_ПQ#zlH№‘EАр<Уj 6Сц2q"\б ё*tz…šбZEШчйD#DГСЧz`8SIUb||§ћ йЌ Шq4zи€Iz”ЙsЉœАiЁлў ЅлРOїщСтЅU:нЭ…х~Ce2˜)rƒ•Ф1œБ(гyФXGеvф32^ ЅХd3›Дз„вЩWQЙ`Сј Z­‚еЌї”ЗЦ [КЋR&@ЮŒf5Е #хБЌЁН;м^noз2z@Ъ7ВЅЯdbB Ѕn ФPьПL&k РЕX‘ѕЛŠ*œ(>иџЭzm/‚›ьeЖЯ•‹91ПyфЂэЛ–г…&•VЋёз‡Ъ&sб’’f5Џbё/š–uІk|щ˜OХМ"†уУ•-‘ъ5UKЈТmˆйO&:г>­Q\nй$W6Џг[&‹Ž­H„J‹‰е[Œ:“^У[Dƒ+оPш+љ4Ќ;Šу\ж™3t§%‚Ÿ 2~о2‹Ÿ‡Гf{‘'DЩ‡=Ф™‡а}W†Ё–Ъ` mаыКд€Ёиї5§kьwGЌZѕ>ct„œо"пХоЇќпOИНћpl‚Ве;-‚н,№hЋ&ЈЪMO:Pлєkdе§#mЁ?KUSM'Љ2tјxИ$\Ђїœщ;)=жмя€5$€ ‹]А#ћУsгУЬОџE@d˜кaЉ%ж5˜-nJza’q*•жЉMв{{GВЦ!š,VДNgаыЇ?В” ѕНMСWгkkZƒw8CUz“ор)і•Ї5&+r[DЇЯчљBЎT;ёeќ‘N€6уѕЛщёТ lм№v;Тљ.ŒЧJќ`4Ъ ’ОKY5Њ~шbcЛA/ј§ф‚Fh"иМНОuGƒЯпqЭk<тгуPЖ§bюВ–b ЌH4ЌЉp|ЁД>аф5љ^_мc|#БЖБ0ОjВЃћц5œZЇƒЇUЯЊе*К-bЖ2e™‹ЉМГдa–т С hЁ $шЃт7Ўрц/ВzЪЦ fd~ЬyНЋ(нyиЩШП\‡Жh wŠбY№[ЩЭ"nњЧ:ƒA‡Žk j†^kАŠf~ZGVЋз ЗЯяdt6Œš…Рѓrрyˆ*ЃZЈеЯRХш&ЪJ…бM86^ ЧЦЫŸAпдЌGdЭ|ЂŠŠPбЗ]‡MЈщСИ8R^"<О+эŽ%ЬЂиx%].5їЗ6чВ’-RђЇ‚fOнЖ–І-еюіњЖЕ_Kжз–eъ­…A‚AG4 jНхбцЬ#бЖrЏ=ž-іІŠ#‚)P”єS>gМ6”^с ЌAlЈ8 $\МЭх™~ЩтwЛzЇ'`§cv›еєеtžѓСnг HёYШ)Ѓ 9фи”œzњГД›”Б+9 Ј%‡’cЅа œrœJN9”Бp CжЅфЄ 'AjЙ•œ д2‘2%ЇЪ”“2^œCОˆђ?џŠ.>O.wlћџтxёJІюМcрВЧзўzќѕјыёзуЏЧyЧ; ЖtбБњS“ьѕџO/sFюfUXu‹ъ#ѕ~ѕsšV8юаќNЛU{šяс_еж§Pџ[§o 5†ы П3~Юјi—щ!":5ѓ6ѓgVгЌвЇ чїЬ)Hџž9ЭќyцаГ3Їž›љшдЬO™г,‡ѓYчГ:œхЪ|w_e>‚єЋЬц ЅzvfшдЬЬV‹s ф@™7˜Гаў4аSаТYшЯћ@?"щГаўYxт9 ИюYx"”dUј.єJВ’цqIш”$mžcNQшiшџ9hmшй™ S3я2чXО -Р]hюB pъОЫLA~ єzzця~4ч57@э†{ф*ч<”О h?”lzCPf'ф B‰AR.џ†Ё­~RvЎ& o„м“ыB$ј—ƒrƒаТAИ:ЉIx–DОсЙвCPV"}оЕћЩ7BH+ЃJЋ“PbXy&.!СGЩ3ѓф[ x,dЌЛ 'GОQ9NF!‘sŽŒ?WGм)!-“œ!вbx$чЯ>eк"Sz99УфЉr›xœ“ z€Ÿ8FЦ2ћ S™лrпё“FљzчсТ љ^'ўъ$ЙТ#žœ“‡Ь3љ)щћˆ2ЎQТлЄф|ŽsэjROѕ^ИN}X(Э"вк0iс сУ~Eђ љ%&?OњЧ/Ыeœh>ЫOФВ– БЙбШ}PЪLРе5Jы“0 YBWЭI)Gt$ЙУ‹Ц5ЋЭ}а“y~Ÿђќ$би"+|чТ9P{СЈkчfM†к hб Ђoeј; pїтZŸWєWMNщџЙ+ї'Џp їБŸh.юе^"Гй:ПЛыЭрym‘eГЎI№ѓзmŸ\$ЧRЅЃ FаЇЬЛI2Ъ<бххгGE‰ŒcPІŸДПŒєJЎ; ЧpБŽфH’9ОИчIвњ0”™нТ§ #ƒB.–р.2їžЬЯбЪxw_тЙђ5.лZДŸ№АNчћЩ§1ЂБшљщˆЂщr[yBёЬ=мјОМBDЁVŒhч0Œ+?7g/ьеШ-_9ц[Ÿ]Ѕ%e•ЕЇoбzwсичѕuqПъpD‹МъЯj§ј‚є“5t„ЌЅЙKŽTцsnOѓŠіŸ?0WБцэ'5ћЩz„G“Ÿk—"kкх$є—šѓsЂ”єЯ‰’DVcдеIхЉTЅд=и7>:1КkRjЯMŽŽ$ЅІЁ!iЭрРюЩ iM~"?~UО?й’м9>( NH9ixД??>"MфF&$И?ИKк•:(œм-Mьп99”—ЦGїєŽ LHЃPt2? 5GњЅОбё‘ќјDRъ˜”vхs“ћЧѓвx>7$ NТ3њ&JЄ‰сє /7i\exџафр49В8?%'ђ“Є il|њЛ ­ vCЧЅСсБ\пЄ48"Mтq@Я Š448Ян%э ЫšЬ_= •їц“’2ЬЂ i87rPълƒ—ћ=ЙžŸ? ч`,уƒ0lЈ˜–ісЧ@‹31x Ÿ…]…‡”“фЦ‡хga6їэЮCЧђуЩ5љ§CЙё9 дЮ>К‹&ГXƒ’Ъ’ЉђЌЯс19h`ї#Яѕч‡sу{ЅQ|gСхЎ‹ ˜АFГ~dpъЏЬMЪc,…FЩњ@v“уƒљ‰фђ§}бмDLъЯKЫЦGсюџхэ\РЊЊђўП6/ЉS6ocЬх-ЉF™ЦŠQ34+#SГМuo€Šђ" ’@3ВpDдRЛШХ1QДфP!xDф*#шœƒ;Ж8Zц~?ћpбzžšџѓќйЯG8œ#ыЌЕпЯo-uІ€ПБЃGŽђэљсЃЌ№АЦo…—ПЇŸїšб ЏXАВћЅкз‹=™РRэuѓVЌbiз8­ZЙˆ7С”ДЇ<Й“‹ќ}}Д74ѕэ=7kъDžѕЗ>р>/\еuGН}xпё{љьГ|СВU ЕЕXсДаgЅп2ажмЯп‡,рU‹–Œrъ{Хr bЄГг"пљкoК§Ѓ–їМјЎяШњr­ЄYў•,Я‚ЎКынКЎн?kœѕ ŒєaJ_[z- W._ЖТѓЮAyЯž]я”…яН+Vј­ `йWћ,XЄНЦ{б2ПŸLш—м ыНpбbOB4ЪsЅ_PяyPЈУХfqЗ‰WpЂCE_UƒКЯ’кџqСШюѓtзпзѓ1Фі!GG‰зH§вз`}§е_њњAƒДзлМіK_?xАѕѕ9ПєѕїмЃН^їР/}§аЁМ~ˆю†аN•ЖжзkЇъЁB;O?,ртпjтЅsctsХDПxA'‹—uпˆзu­ТKЇˆнUЊk[uзDДю_"Uз.ВuтKнuQФO.ч'еўdŒ†ŸccLaŒiŒёcx3Ц*ЦcŒП3F cЄ1ЦQЦјŠ1Юё“ЋЌ?ѓGcH_о1Ц@Цx€1a WЦx1І1ЦkŒ1Ÿ1ќc=c|Ф{#•1Ž2F>c\`ŒKќфЏљIW<†Mцc bŒŒёgЦЯSуU֘ЧоŒШ›c'c$3Fc|ЩЅŒQЯ2?љ:яліЧcшŽо1Ц`Цx”1Ц1ЦKŒё&c,` ЦXУ0ЦnЦHcŒуŒa`Œ‹ŒaaŒКы’ю†tcќюЧcи–н1Цяc,cМФo2ЦrЦXХя2ЦGŒБ—12†ž1.1Ц7ŒqKз. вuJNŒёcИ2Цd-іv’}П№>Т§ьћHііЎ“CBb6MvЕ—${лю{[ЩоЎћыЋw<#B$>t!’Nикжлл э‡Y?ќЌ<тДынЯилvrы}рgoп§2—3Ж]<ињрК6DЯ3Ўn!W{кuћСƒœммzЦб†ђГЕі:З<77[АЗ­wrЋяњТЭ)O›O_m>!!Ьч—MЎŸ$ѕыyцЇГуЇнžnЯЮњLЯьКtЯŽЗgЧƒлГго[яьДgzgз5Žuvv6ТС:;7;pАЭуѕн_qѕы+ѕГ?Щњf'зѕгm уб щg'ѕыгѓрКƒdу`з;Щы?p aš’­]НіЪži†ћYuЯгщzїsік;uЛ§Ш:е~}x4|фШ)SТoкл[ŸыšЋ}їOaВ]ГЕОђІ­іS˜pяx=ѓэoл5_[бпЎžqЎvх1ИоС^rш7abзŸ8A{ш`}јїаPJ’Уэ‡8є‘њі>Кй_Вщп3чџ3iэЕіA›К?‚ьlьzЇн§Ќ­­ѕпь}dkkЫ‹Е‡У{gn}И– мёьxІž“o§ЩкУоЙЛѕŽk;ЈЏN8кvлзV82kэUW{Оі<ИОПНдПпO7ы<м&ЛZЛЬи6Иыу–ѕqа&эџМЦЩэіcжХЦfSѕ:іЇЩ“7ЉЌ…ѕљЎ…ББ>Џ=юZ™л?џ–mЯтєŽ?ЙыgРэХ‘єщ]œЎЏЕХqь'9:<(ќBжvПZћЦМ›ЗGTљщ}аХЅї=-ЖОБХу)Єv~‡\Джm`ŸzО№ШЛкѓЕ‡‹K}зЎФГ^Оа-XуПL ѓђ_ДTИ,ѓ X.ЦѓŒєъЬINb˜ѕяcгЕ‹с+‰ЏЕНIзз:zЁЭЬщ/;‰сЏЭ|Щ‰siзїmЛ?лuю#њ.№[щ'[ЪбOЙwЪоѕ{?й{aЏћHьмиэqŽqттву>3ЦнŒŸ"aLТь„„= *Ь‰CпLм•x5iH☪ч“f$љ'­MŠMЊO’М0y}ђ'Щ’›інЛЯe_№О#ћ:RмR‚SЄДьћŸмџкўФ§ѕЉЅЄfІšгЖˆ1DmCaќю…ћрa Ю№< cХ}bМЄZФTxІСt˜ЏРLxfУПУgЕM—+žеТVmvањ‚=єшŽ0ТеL…™Љ0ГіŸ^ЂТЬT˜™ 3Saf*ЬL…™Љ03•UOeеSYѕTV=•UOeеSYѕTV=•UOeеSYѕтmUя€xТ|XдЁ‘Tсvˆ‚АvA ь‡THƒt8ЃšЈ UaЂ*LT…‰Њ0Q&ЊТDU˜Ј UaЂ*LT…IдЊзХeЈƒzh#4ђ\4У5Е† 0RF*РHЉЃИЮs7д Њ ‚*Ј  *Ј‚ ЩFН,щРь є{шаР`ЕIК†РPП{с>їУoUЃ4B§Їє 8Сяс№Gјќ7<УH5Or†GрQx ў Ѓ`4ИР_рqј+Œ'рIx \сo0ЦСxx&Р3рa< “с9x^€)№"ИУK0^†i0f1—й0цТ.’‹фЃ…|ДђбB>Ў+фу љИB>Ў+фу љИB>Ў+т8+}Тšvq‹.ЄЊ’Iэ`vн\’ў:3}CшИЧ 3д‰+Ь0‚F0УfС #˜a3Œ`†Ь0‚F0Уf˜@omЅЗЖв[[щ­­єжVzkынkEb5Ђ~U­М­6вcщБєиFzl#=Ж‘еjaeОeeОeeОeeОee’Y™dV&™•Ife’Y™dV&™•Ife’Y™dБMНIнІюNSwЇЉЛгднiъюДј˜ч>hˆН q I ћ …пЗR! в!ƒя€ƒ№)‚У YpВс(ƒ8ЎІqЧвФg|§9œ„\аC| _A>œ‚(„г`€3Њ\Ш…\Ш…\Ш…\Ш…\Ш…\D%ПЇ Њљњ"ŸkрŸp jYћЫPѕаFhTыАnж­#S2™’Щ”LІd2%“)™LЩdJ&S2™’Щ”ŒЁ1t†nТаMК C7QЇ1Д C›0Д C›0Д‰Š=OХžЇbЯSБчйииииииииии~Х~Df?bd?bd?bd?bd?bd?bd?bd?bd?bd?bЄпЫє{™~/гяeњН,yˆЁ’Ї˜)ЭїK ФяЅ…тi)ЌуgЏ‡ ЁaМ›с}‡љYлдZ)ЖCь€А >VkIьћŒ5­$UЗLе gи[:pKnщР-ИЅЗtт–Nмв‰[:ёŠЏёŠЏёŠ‘;y“;y“;y“Лѓwч{юЮїмяЙ;пswОчЮќРљ;ѓwцюЬєŒFv-ь$ZиIДА“ha'бBЙF1вGŒє#}ФHС•Ќ“#ыtыфШ:9X­ƒqФ§иІлдb›ZlS‹mjБM-ЖЉХ6ЕиІлдb›Zцj"ѕкў@&х2)—IЙLЪeR.“r™”ЫЄ\&хZџjfХZЅ8*GeтЈL•‰Ѓ2qT&Ž:„ЃсЈC8ъŽ:„›тpSnŠУMqИ)7ХсІ8쇛тpSnŠУM­ИЉ7ЕтІVмдŠ›Z9e6rЪlф”йШ)Г‘Sf#ЇЬFN™œ29e6rЪlф”йШнКЬнКЬнКЬнКЬнКŒ›rqS.nЪХMЙИ)7хт™“xц$ž9‰gNт™“єФaєФad?—ьч’§\ВŸKіsЩ~.йЯ%ћЙd?—ьч’§\ВŸKцsЩј2~…Œ_!уWШј2~…Ъ8CeœЁ2Юё2^BЦKШx /!у%dМ„Œ—ё2^BЦKЈЂSw=ev1NQIЇЈЄSTв)*щдЏH§ ipўсS8‡!Врdѓ^ŽТ1Шуp>ƒЯс$ф‚ђдhЌ•€ЕАVжJРZ +ce`Ќ Œ•Б28џ\gиё>c§_ї …a№Июƒ‡еRЬQŠ9J1G)ц(e'|?;сћ1H)У eЄ ƒ”a2 R†AЪ0H)У eИ{ ю^‚Л—`rЌQŽ5ЪБF9ж(ЧхXЃk”crЌQŽ5ЪёМ/ци‚9Ж`Ž-˜c ци‚ччсљyx~žŸ‡ччq’Л_l‚ї`3Мс№lс#ˆdАЂ`ь„]ћ!в Ž wЌуŽuŠАNж)Т:EXЇыa"ЌS„uŠАNж)Т:EXЇЛ$a—$ь’„]БK#viФ.иЅЛ4b—Fьвˆ]БK#viФ.`—ѓих‡ЊЯЁъsЈњУT§aЊў0U˜Њ?Ќ›%юЁ3гНЁњвЧщосѓZЮ ыдcК\1VзЈ~Ќk.КfёИЮ$еYдR]‹АOгХ-tq ]мBЗаХ-tq ]мBЗаХ-tq ]мBoфаЬ9 ™ъ7P§Њпа§Ї-Tt нBEЗPб-tќ<Њк@UЈjUm Њ ь§kићзАїЏaя_УЎ@aW А+Pи(ь v Л…]ТЎ@aW АЧ–йcЫє$™=ІТSaЉАЧTиСДKg9!ƒb8o=)•А‹0В2­ьНY™Vі_ŽтГіaж>Ьк‡Yћ0kfэУЌ}˜ЕГіaж>Ьк‡Y0ыfРЌ;™u'ГюДюзжАЗ цєђ.Ќ…uА6АR! aАQd†‘Ь0’F2УHfЩ #™a$3Œd†‘Ь0ŸцгнКЛBwWшю н]ЁЛ+Ђ‘s^4УЏ8г­ЫщжхtыrКu9нКœn]NЗ.Ї[—г­ЫщжхtыrКuнК‚n]AЗЎ [Wа­+шжtы КuнК‚n}™n]EЗЎЂ[Wб­ЋшжUtы*КuнКŠn]EЗЎ’FВ{t†GрQx ў Ѓ`4ИР_рqј+Œ'рIx \сo0ЦСxx&Р3рa< “с9x^€)№"ИУK0^†i0f1—й0цТцЙO b`/ФBФC$B$У>Haўћ!в 2јў8ŸТ!8 ™G ŽТ1Шуъњјё_'!є_ТWЇ  с4р їЂЮТ9(†ѓPЅpЪ * ’пSе|}‘Я5№OИЕTвeЈƒzh#˜д(œ…ЂpBNˆТ Q8! 'Dс„(œ…ЂЈкЃTm6U›MеfSЕйTm6U{„Њ­ЃjыЈк:ЊЖŽЊ­cwVЫюЌ–нY-ЛГZіь?<иxАџ№`џсСўУƒ§‡ћіь?<иxАџ˜Юўc:ћщь?ІГџ˜Юўc:ћщь?ІГџ˜Юўc:ћ_ќуŽмё;ўqЧ?юјЧџИуwќуŽмЅЊє Ь„Wс5˜ХяŸ s`.ЬƒЗХCœа'rBу„ў*'єљœа_ф„Ъ нz('єPNшЁœаC9Ё‡rBх„Šумqœ;ŽsЧqю8ЮЧЙу8wчŽумqœ;ŽsЧqюœаCй3јrBх„Ъ =”z({/і^ь!МиCxБ‡№bсХТ‹=„'чPNЮЁœœC99‡rrхфЪЩ9”“s('чPNЮЁœœCБG2іHЧщи#{ЄctvЫ)$ ƒ$a$ ’„A’иAћГƒіgэЯкŸ=У(нluЋnŽЬNњ іїvяюэо;ьФ2К\5EзШй‚}ЉюkЮё†јц)УЩџ ’Ar0H>ЩЧ љ$ƒУ Ч0Ш1 r ƒУ Ч0Ш1 r ƒфc| ’Aђ1H>ЩЧ љ$ƒфc| ’ЯюGћ7REXЄ‹a‘",R„5Fb…уqŒ1c ФЉ"™д’њBR_Hъ I}!Љ/$ѕzRЏ'ѕzRЏ'ѕк™ЇД’іBв^Hк I{!i/$э…ЄНД’іТћЏ #йCo‡(и;aЄР~H…4H‡л[˜M:ВIG6щШ&йЄ#›td“Žlв‘M:ВIG6щШ&йЄ@&2)IL dR s25p25p25ˆs$т‰8G"Ю‘ˆs$т‰8G"Ю‘ˆs$т‰8G" $ЂŒD”‘ˆ2QF"ЪHУYвp–4œ% gIУYв ’•4ЈЄAЅrЫЉм‹TюE*ї"•{‘ЪНHх^Єr/RЙЉм‹TюE*З“ЪэЄr;ЉмN*З“Ъ-ЇrЫЉмr*ЗœЪ-ЇњjЈОЊЏ†ъЋЁњjЈОЊЏ†ъЋЁњjЈОЊЏ†ъЋЁђЪЅ=jƒ 1 q I ћ іC*ЄA:dРј„Oс†LШ‚#m§Г|ћ№ѓьУЯГ?Я>ќ<ћ№ѓTgеYAuVPTg…ѕпuzџTZLпђІoyгЗМщ[оє-oњ–7}Ы›ОхMпђІoyгЗМщ[3Јр“T№I*ј$|’ >IŸЄ‚ORС'Љр“T№I*ј$}k}k•œK%чRЩЙTr.•œK%чRЩЙTr.•œK%чRЩЙBћЛџwР,€ŸўЛйœР7С{Ао‡pјЖР‡№l#I‘Њ)№#~ЄРј‘?z˜žІЇ‡щщazz˜žІЇ‡щщazz˜žІЇ‡щщazz˜žф’œ@’HrIN =LOггУєє0==LOггУєє0==LOггУєє0==LOћ„і =LOггУєє0==LOггУєє0==LOггУєє0==LOг“в@RHJIi ) $ЅЄ4”’в@RHJIi =LOг“ж@z˜žІЇ‡щщazвGzуHoщ#НqЄ7Žє–“оrв[NzKIo)щ-%НЅЄЗ”є–’оRв[JzKIo)щ-%Н'HяAв{є$НIяAњY< .%СЅ$И”—’рRќс§ŒF‚?ЃŸгЯ‚щgСєГ`њY0§,˜~L? ІŸгЯ‚щgСє3Oњ™'§Ь“~цI?ѓЄŸyвЯ<щgžє3Oњ™'VX‡|Б‚/V№Х ОXС+јb_Ќр‹|Б‚Џ4R§Rr†GрQx ў Ѓ`4ИР_рqј+Œ'рIx \сo0ЦСxx&Р3рa< “с9x^€)№"ИУK0^†i0fpz~fТЋ№Ьb~ГaЬ…y№–ZOЯ)НЃž яŽІяОCпCп}•Оћ }7QђСKyn_Џ†@‚5 kaъ…§МАŸіѓТ~^иЯ ћya?/ьч…§МАŸіѓЂї&bРuєоDzo"Н7‘о›Hя їFа{#шНєоzoН7‚о!}BПоƒ9Ѓ!b!т!! ’aЄР~H…4H‡ 8№ПЬн{|œu™6№'3!”ЁEEпХŠ‹ˆrP+.*КœyQW§Аk]]A+"а"V+.ˆ'ЂРB‹PЌЅK)аєІ%M›C3mBžЩ$“Щк4ѓ$mЁЯћщРБuuџиЯћЧE’цљюыКюћw?“gxцС|x~У#АЕŸ?РBј#,‚Ч`1ќ<Kр XЪ“Oт§)x–A ,ЧЋœTaŸPaŸPaŸPaŸpq—ЛˆЛмEмх.т.§@Ѓ~рjw_аМZO№z=СынE|WО%Цую$Z“Й8ыnтшd>.Э*sEeЎЈЬ•ЙЂ2WTцŠЪ\Q™+*sEeЎЈЬUyXUV•‡UхaUyXUоЫЛrЊqN5ЮЉЦ9е8ЇчTуœjœSsЊqN5Ў>‹К=И Ў†kры№я№Mј\ зСэq— лЅТvЉА]*l— лЅZvЉ–]Њe—jйЅZvщ3NвgœЄ‚uЉ`]*X— жЅ‚uЉ`]*X— жЅ‚uЉ`]*X— жЅruЉH;UЄ*вN)Џ"хUЄМŠ”W‘ђ*R^EЪЋHy)Џ"хUЄМŠєЌŠ”S‘r*RNEЪЉH9е(ЇхTЃœj”SrЊOЄњDЊOЄњDЊOЄњDЊOЄњDЊOЄњDЊOЄњŒЋ>уЊЯИъ3ЎњŒЋ>уЊЯИъ3ЎњŒЋ>уЊOIѕP}TŸеg@ѕP}TŸеg@ѕP}drI&—drЉЁњŒкEpi№*|” О\ПKHПYц);3В3#;3В3#;3В3#;3В3#;3В3#;3В3#3KНžЃ{9К—Ѓ{9К—ЃЋяЙIssš›гмœцц4ЗУ­Чpъњр Jg(Ёt†вJg(ЁєЅ‡(=Dщ!JQњ8JGщЅs”ЮQ:GщЅs”ЮQ:GщЅs”ЮQ:Gщœ3i—3i—3i—3i—3i—3ЉњЗŽ;9рNИ“вц€4Є9 ЭiHs@šвц€4Ьч€љ0ŸцsР|˜_}ž› nц‚›Йрf.И™ nNžуŽџМ`џњ;>Ўkz,yI|qђгqKђR?ЋЉЩЫќќ?_?œЊ#ЩщHr:’œŽ$Ї#ЩщHr:’œŽ$Ї#ЩщHrЬa0‡СsЬa0‡С<ѓЬc0Сќџшoq›ыƒ~x Ќх@уЧР8Ц10^{|ЛŽjь„чрyxљsсŸіM~Њя9щЏ}вR“"˜СЄ&E0)‚ILŠ`R“"˜СЄ&E0)‚XБbФ"ˆEг~5эWг~Еhв{ЙgnЭjбЌЭjбЌЭjбDSMA4е'@3tЂiѕyгЁdЕп<&˜эўчіИ>}єщЃO}њшгЗG}qјAЂЬ‹2/ЪМ(ѓЂЬ‹2/ЪМ(ѓЂЬ‹2/ЪМ(ѓЂЬ™  BЦ8{2оhч;э|ЇяДѓvОѓ%я6И$yIЄУДњЛ.I^цчЯг‚#щ‘ЁG†zdш‘ЁG†zdш‘ЁG&˜MНEVЌКwOƒ…нrOя’YcWэjЃ]mДЋvЕŸ9|ц№™УgЮ.[ыяШсtЇ9œ'?‡ЩЯХap–ЮЕУЙv8зчкс\;œk‡sэpЎЮЕУЙvј i0HƒA в`ƒ4(а @ƒ 4(МјqЋШVCЌЕ№ ДУ:ш€ѕА:Ёіі”ыXМ§ишЧF?6њБб_{§v;‡ю€№<Лт1lŒac cи8gбm?КEЗ}щ6nћбэ(КUsi:vЮЦЮй:eЩg‚З‹ОњžР]Ђп%њ]Ђп%њ]ЂЏжО Н*єЊд_3кS6їящ5ЃВ7HјnŠяІдў šІHš"iŠЄ)’ІHš"iŠЄ)’ІHкžіў>ТнЯJНќ$KEŸЖв>VкG”™dѕ}g[1ДbhХаŠЁC+†V ­Z1ДbѕЙ…f 4c ЭhЦ@3§›щпLџfњ7гПYN•ƒSщпLџfњ7гП™ўЭєoІ3§›щпLџfњ7гП™ўЭЂ*ŠЊ(ЊЂЈŠЂ*ŠЊшdpВ 8Yœ,N–'Ы€“eРЩ2рdpВ 8Y(‘ЅD/%z)бK‰^JєжO–>JєQЂ}”шу‰}xтžHaш4žи‡'Žр‰ЖNS_{ƒ ОЬ„яС№}И ~7У-p+Ьо­ЕиZ‹­ЕиZ‹­ЕиZЛ—юы…39­4ЖвиJc+­4ЖвиJc+­4ЖвиJc+Эїѓп§ќwџпx?јk нЁЛ1t7†юЦаниЙ ;7aч&ьм„›œЙSдгЗWЉ#Ч8oПІ–œюМНJ=9ЦyћЕфЗтЧ“зЦ&лƒЗ%з—\МUDпхв™№=ИО7СрfИn…йеКMГЧjљПЗ.cЙH—‹tЙнл}оюѓvŸЗћМнчщЛќЏ&Ёыѕ“щcђ№yx‹,в‡EњАHщ|‘Ющ|‘Ющќ—<ХКPЄ EКPЄ EКPЄ EКPЄ EКPЄ EКPЄ EКpoн ˆо(Ђ}DєEбМQ4еОі‹Ђј]№QЬХ,QЬХ,QЬХ,QЬХ,QЬХ,š}~Џя,ўmМB$+DВB$+DВ‚fЯаь‘ДŠЄU$­"iIЋHZEв*’V‘ДŠЄU$­"iIЋHvˆd‡Hvˆd‡HvˆdЧŸUяѓtVчЧkщзEПSыНщ9Ђ=DД7з{гsD|ˆˆoІпЭєЛ™{ њ‡ИїмлЪНЧ'`b c˜УФ&Ц01†‰1LŒab еЊп…n,tcЁ нXшоKП:…žSАа…n,tcЁ нXшЦB7КБа…n,tcЁ нЊљ„j>ЁšOЈцЊљФž^щёёЂ=YЄЧ‹ђd‘m >оp$Žо GСлрэp4ЧТqp<МN€с$x'М N†Sрнp*Мо ЇСщ№>x?|>џ‚3рУp&œgУGрсј(| ў#.6м wСн№ ј%ќ ~ П{ ~ Пƒ{с>Иў€aЬ‡‡рї№0<  њWю'нз>OУ2hх~З"юmX Ћ VЋсŸrчwЉњўO,aА„СK,aА„СK,aА„СK,aА„СK,aА„СK,aА„СK,aА„СK,aА„СK,aА„СK,aА„СЋяEЌ`А‚С +Ќ`А‚С +Ќ`А‚С +Ќ`А‚С +Ќ`А‚С +Ќ`А‚С +Ќ`А‚Сƒ# FŒ0apƒл0И ƒл0И ƒлкм9ЌЕ№ŒВzчP}?ё%-cДŒб2FЫ-cДŒб2FЫ-cДŒб2FЫ-cДŒб2FЫ-cДŒб2FЫ-cДŒб2FЫ-cДŒб2FЫ-cДŒб2FЫ-cДŒб2FЫ-cДŒб2FЫ ?еэ№#˜?†ŸР\ј)ќG<ё ŒO`|уŸРјЦ'0>ё ŒO`|уŸРјЦ'0>ё ŒO`|уŸРјЦ'0>ё‰ПРx7Ц#ŒG0a<Тј Ц1>ˆёСZowiѕ‰Ќ†„Ј’аћ@ь S`?HСў0 Ў…ырлp=мпч\ƒsЎС9зрœkpЮ5TЯЙTУСa Ÿ‚/С ј7ј |Ў€ЏAѕnџfћшБћшБћшБћшБћшБћшixeМОсUp М^Џ…ƒрup0ЏW7ќ]МІс0x#L‡7Сс№fј{8оџП*ЮЧуe чТ'р“№OpžјЮ‡ рBИЎ;iдIЃNuвЈ“F4ъЄQ':iдIЃNu6мbЬу,WgЙ:ЫеYЎЮru–ЋГ\mXLkx2hjx ž†eа+(МVA+Ќ†—чіyюi/ŒП^яНgд{юЮ UЕї§2x]rqpRђIwŸapx2|29˜ЬЏOћ9М&9тЮћЗбрЄр“œ2Ь)Уœ2Ь)Уœ2Ь)Уœ2Ь)Уœ2Ь)Уœ2Ь)Уœ2Ь)Уœ2Ь)Уœ2Ь)Уœ2Ь)Уœ2Ь)#œ’ч”<Їф9%Я)yNЩsJžSђœ’ч”<жGА>‚ѕЌ`}ыЌА^РzыЌА^РzыЌА^РzыеїСfдŠŒZ‘Q+2jEF­ШЈЕ"ЃVdдŠŒZ‘Q+2jEF­ШЈЕ"ЃVdдŠŒZ‘Q+2jEF­ШЈЕ"ЃVdдŠ цїЧќ‡1П?ц?Œљ'1~PrI№ІрlіbГ›НиьХf/6{Бй‹Э^lіbГ›НУ_‹и,cГŒЭ26Ыи,cГŒЭ26Ыи,cГм№ёре чТ'р“№OpžёчУp!\з:‘ЏƒoУѕp|єdУ№†Ч0<†с1 џЗžPJžЧУЛпјЩњЛ?™ќRpV№/ечќ §~JэОщвк{юЮ ^Ё6NUЇЊSеЦЉjуTЕqЊк8UmœЊ6NUЇљ#?aф[ŒќDmфЁFjфЁFjфЁFjфЁFjфЁFjфkŒќВ‘Џ1ђЫЕ‘гŒœfф4#Ї9ЭШiFN3rš‘гŒœfфЕЎёR_uгnЈНЦЕ{ф‰5ŽЊўM 8Ÿз6ѓкf^лЬk›ym3ЏmцЕЭМЖ™з6ѓкf^лЬkэМжЮkэМжЮkэМжЮkэМжЮkэМжЮk+ym Џ-сЕ%МЖ„з–№к^[ТkKxm Џ-сЋ•|Е’ЏVђеJОZЩW‹љj1_-цЋХ|ŘЏѓеbОZЬW‹љj1_-цЋХ|ЕRН,Њ—EѕВЈ^еЫЂzYT/‹ъeеwпE|ё]ФwпE|ё]ФwпE|ё]ФwпE|ё]ФwпE|ё]ФwпE|ё]ФwпE ЦCВљ‘рUњ §РЄ~`R?0Љ˜дLъzє§@E?PбTєU:ЋJgUщЌ*UЅгС>r1%Sr1%Sr1œKЕ.ЊuQ­‹j]TыЂZеКЈжEЕ.ЊuQ­‹j!еBЊ…T ЉR-ЄZHЕj!еBЊ R-KЕ,еВTЫR-KЕ,еВTЫR-KЕЌ“oаЩ7шфtђ :љ)9HЩAJRr’ƒ”ьЇd?%ћ)йOЩ~JіSВŸ’§”ьЇd?%ћ)йOЩСџю“‡œ|ЏvђэяфлпЩЗП“o'пў{:љpјёкБŸ оРѓЫ€7№§ХZVЛW(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂЈП(ъ/Šњ‹ЂўЂъйžсйžсйžсйžсйžсйžсйžсйžсйžсйžсйžсйžсйžсдНtЎљ==СЉ%N-qj‰SK:зlВњ.тѓ0b4ФhˆбЃ!FCŒ† 1b4ФhˆбЃ!FCŒ† 1b4ФhˆбЃ!FCŒ† 1b4ФhˆбЃ!FCŒ† 1b4ФhˆбЃ!FCŒ†­~КeˆбЃ!FCŒ† 1b4ФhˆбЃ!FCŒ† 1b4ФhˆбЃ!FCŒ† 1b4ФhˆбP(c5муѓ.Ы§ћž‘ХъV‡А:„е!ЌЖcЕ=јЉle{(лCйЪіPЖ‡В=”эЁle{(лУПЁЛЊОгЙ л ВН л ВН л ВН л ВН л GЪЎЗТQ№6x; ЧРБpя€рD8 о я‚“сx7œ яїТip:Мо€Т?Р‡р ј0œ gСй№јG8> ƒ=WЃ?џ|Дkхдu№mИn€яРwa&|n„яУMАћsа&TЃ еhB5šP&TЃ еhB5šhј•цNИ ю†_Р/сW№kј мЭ№[јм їС§№Ÿ№<ѓ`><П‡‡сXKхOТS№4,ƒ–=*ТŸ9щМј3Њр…ѕПuНЇўwЎїЈ‚ыjюсЎюсЎюсЎюсЎюсЎюсЎwИЋР]ю*pWЛ мUрЎwъЯž•ИЋФ]%ю*qW‰ЛJмUтЎw•ИЋФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]MмеФ]%ю*qW‰ЛJмUкуѓrЛЛJџ§'WмеШ]меШ]меШ]меШ]меШ]меШ]меШ]меШ]меШ]меШ]меШ]меШ]меXwзюšТ]SИk wMй‹ЛЪмUцЎ2w•ыgьЕ{pWgp!wЅЙ+Э]iюJsWšЛвм•цЎ4wЅЙ+Э]iюърЎюърЎюърЎюърЎюърЎŽњЛ-ZЙЋ•ЛZЙЋ•ЛZЙЋ•ЛZЙЋ•ЛZЙЋu/яЌXEЉU”ZEЉU”ZEЉU”ZEЉU”ZEЉU”ZEЉUЕwVќа=дэ№#˜?†ŸР\јiѕ•QNЙю‚Лс№Kјќ~ї@3ќ~їТ}p?ќ'<Т<˜СясaxРЃеЯCNР№ ~Њ–ПР№†0<€с `xУР№†‡0<„с! axУCТ№†‡0<„с†‡1<Œсa cxУУЦ№0†‡1<,Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%Sђ7%‡фяќ’ПCђwˆ+r\‘уŠWфИ"Ч9ЎШqEŽ+r\‘уŠWфИ"Ч9ЎШqEŽ+r\‘ћяя:ўWO‡=хяž^ zyў~Yў~ЃžПЇеѓїДкГЗW§Ÿ‰јзОиС]меС]меС]меС]меС]меЁЃŒt”‘Ž2вQF:ЪHGщ(#eЄЃŒt”‘Ž2вQF:ЪHGщ(#eЄЃŒt”‘Ž2вQF:ЪHGщ(#eЄЃŒt”‘Ž2вQF:ЪHGщ(#eЄЃŒt”‘Ž2вQF:ЪHGщ(#eФ]eю*sW™ЛЪмUцЎюърЎюърЎюZЯ]ыЙk=w­чЎѕмЕžЛжsзzюZЯ]ыЙk=w­чЎюЪsWžЛђм•чЎ#7Е)x…Ћ Ў.И:В^Пkі'ЮѕѕBџvБяџfРтtтц8mс edХШŠQYЃ*Fe]1рŠ1-†Ѓ]ЙКЖЦ+‡ЌбэЪ!;jГЃ5vД&Q‹'^Y§…њчJOЋЎєД`ŠЙя5яНv1Я.цйХZяц-ѕg"ŽЊ"Х ѕOЄ8Ёў‰Џ4гWЭєU{7лJГ}еl+Эє3}СLSЭtЛ™Ў6гf9Ь ‡™с:3\ьkд2#–бeD—+tХ~;'8лАБ-qyќЛФПФ?Nќ+| fФл^цoђЧујќ&u„пv№шЙўѕТxЃйкЬжfЖ6ГЕ™эЩ—щњŠКЎЏЈЭм/ŽsуGŒ 0і9cŸ3і9cћbьўXNеоgpЉЏеїьўћђђкшякзJћZ™ИW­wе@bnМеОgЦcі4aЧWФ“V™ДТ+TЃраˆC#WDf™4ЫЄ_m—ејЎ5і:ЛœЉ мшпnЃімИМо\KЬЕФŽsЎ\iЮŒ93‰їѓЕёˆQc"(ˆ  ‚‚ ж{оzKЌЗФz[Гу"щIЗHКEв“6М/З—N{щ ЕRжJY+mГЏЇЌVЖBЏF­PВBЩ %+”ьsЊ}>l•‚U н?Іsі§ •rVЪY)gЅœ•ŠVк*žЧ­жoЕў`?ЋEV‹jбяžmмl[ЭЖеL‘™ЦешЏгљ0г7bіWоъЪкОŸ w№ХЯъъцЬ™3Њ`TСЎѓvЗыМ]чkыМАcѓџйNяpЭЯфrUЫ-ЕW,›ЬY0gAQd]SpMЁІ]хOїgЦ[j;ФЉW?гœ7ZїппЪЗqзм ЅњНРРUдКЎ qѕsvИХЗИzRœ[Ј7nд1vйСј‹юЉzАъБ­vАеШ/цЮxЌ§n&м(3АVЋЕZ]]tuбZеьъЕГ}Ќ7lНсЗЗљљЧrу'œu‡ћ™,YЫзнN'&цб№бр Фуё3‰%№$W>eoOЧз'–ХПJДР gбъј[‰ЕёЬD‡k:}э‚2–ЗР6sTтлQќXbЖЫЛчуŸ'uЇ1Ю%їѕu Lѓ§Aq%љ:8Ž„ЗТбёxђX'љёё’ф;р8QЭ=йЉ{jМ щœ}ёџtt~№ЪфСдњћŽSщRaSщR“rNЎ{Ф6žТўгёQŒ‹b\л+}]э<_ЋšmeЇЏ]ус*Vф_Ф§А#о*‚gэўYЛ6yˆ {lœБЫmvЙЭ.З%usvзWэХпЄUЛ­ZДjбЊЯYuаЊ=VэЖъ6Ћv[Елj‘еЦЌ6fЅ1+YiЬ*л­RБJХ*+ƒГТїЧпДЪdтбјЁФуk‹рqua < OЉž+тп&VsO‡Ÿ7Шіžјѓ‰ё%z! ›`3єХ_LєћК./L њ> У ЎJŒФПHф}? …јъDбз”u [`ЋяЧ`[|~b\ЅˆD8лугpЗ<Бгяžƒчу?$vљSАŒ—qЦeЩ}|пЯNІєћћ~Њ~Zм™< ўjђ•№*8^Oчœ9чDЮ9‘—'_-yЈпН Оœюы›р№ј”ф›ся§ў?ПŽŒчДУ“GљўэptќІф1ё0§L_ƒщk0} зAг;“яtЭЛрфјжф)ООNKОЧзїТiz–гэу}О|q§ЉЧ~gш/Ёџт~ЃгїЩЫk§Ч“СлЈ4@Ѕ* №ЧРKќБ™7†xЃ‡bМбУ=XТђv‡јЄЛ›БЛЛYŒfјЅƒC<гЧ3}XСа mСаoё‘ne(ЪŒ(3ЂЬˆВ,В’ˆ6‹Bm N•Wя•O}rЉ/x ŸEќ•уЏœwкyЇЏГѓjЕенмeЧѕ<ъВы.Ољ;;яЕѓ^;яАлUv;dЇНv8HЧЌ]vиe‡]vаmz бkШŽ{ьИЧŽ7дѓlЃoДуvМЁšgvлiGkьh­ВЃ!;њC=Ћ3vДЦn2v“Б›WлЭЈнŒкЭћё8„ЧЁzъСcЗнтБн8YЏSЛЬиeЦ.Їк]Цю2vзnw}vЗЮюжйн:Л{Ÿ›ьp…fœlїШђъЮ–ЩеX)ЫWлСZ•`ƒЎгзЎxP–цtˆ‡Uџ?ЋЦŒс}яо#cv№е&~Ъъ‹юСќ§0^ИтщјŠkєJ=ЦъјЎj}Ёу=tМGПqї~ŒЬуœљміЈ=§бЯ‹рi ,УH ЌФоjЇгкј‰Ф:ЕoЗІOиуъGY­ШЋeyZІс:šѕвЌзўКэЏ;8мJЗYщz+eўЄ:=э4[цk•~З:Ž­2^ЏƒуVЗТ<+<ЂтД[eЙU–[хѓЂСсё•VМRVв"ЄEH‹Сї8—…еgGŽЗ›уqљ$.W`$ч%ˆŸЇюѓд}гяrжWЙ|Z„ЫDмЙ ‰ž[щЙ•ž[kЕібЬЩR‘ќH$?тКvЎk7їŠФ2'f Ќˆ#Ђ\з.Ђ!‘\Е—Zћ§z­§/ЕvщЫjэ "ф%Еіњ—дк+ЙїЪ—дкЫекі—дкѓекЕ/ЉЕяЅж^YЏЕПСюѕѕZ;Ѓ^kgЈЕ3дкjэ ЬŸŠљ31&цЯTkoTkЏQkgЈЕ3px‘Z;C­A•3ЈrU.QkgЈЕ3ЈsuЮPkgЈЕ3ЈєAЕі3ВцA,п€хА|хЮQkgЉЕ3дк2ш;jэ Еv†LњЖZ;C­Ёж~šТgЊЕ3Ј\§ŒФѓыOщ?Hэkдкƒекƒекgдк‚/RяѓдЛ‚zПЇо•дЛ’zЈЗЁVХž’‰+тЪRnх†)ї5ЪЕQЎrm”kЃ\хnЃ\еž ZекЈжFЕOSэQЊЕQ­jwP­jmTћеў@Е6ЊЕQm>еVЉ?Š=AБ Хк(жF­6jЕQЋZmдZG­?PЋZ­дКƒZmдzœZыЉЕˆZ‹ЈЕˆZ‹Јѕ!jнF­лЈuЕž ж j-Ђж"j]J­EдZD­‹Љu1ЕцSkЕQыдњЕQkЕfQЋ…ZУдкD­MдкD­ŸPk=ЕQkQ­7;ХзwУ{рНpšОэt{xŸяп7Sъc”ZJЉъћпIg‚#ЈsuP):дЄ­TZKЅћЈteJ2ѓ™й%3ЛTŒЅT*ЊЊKEJЈЊRьъДШЉJЌЅР2 їШPn„X–ћАX–џфџl.Уиƒ˜xкeѕ ŸЈžйСпѓШ:YЧ#mќёG+ђЧ:Z€І›hК‰–Ћ­ђЌUк­вNЯ…‰ъЛwвxкзз)0UšцT;gЏƒƒсАрэИŸРy/Ю{qНЯY<ЏСѓ<ЏСs'n7Ъ€\ЎзЏчœ>еsђФј9НџМZљЏКCw`ш)ћМ лэыЗіѕˆ}="њ|НO˜gOѓьiž;‚ЇуYF.3r™'Œœmду/vюЛOФОК #ЪъєиfОJ|П+—ЛrЙИћ\§€Ћяї6#ю5т^}tшъŠ.%ЂЫьаa"kŠѓЎZуЊ5NШP.TтЎЪК*ыЊœљЊ}pЛ+Ч]йюЪv'x_єAЪ<БЖЙ й;Tђчжq—Q›ш{=q]7зUЯІ…Е'ЉЊOQUнї*3Œ›aм уѕ~ пњ§fЫз:•€kkы[ИўNЗcнoМУЙкщ\эЌБ’7Kо,Яše“Y f)˜хYГ”Эђ˜YЊё>f–ЧАRіл-АЛŸлYхЏжѓ7:Зъ}?u{ќЖЪ_й[`ї.Ч^вЕФмedкШbоjtкшtiѕuЙмKі8е цйaцTМ-xХ‹Їx(У 5-з™ЕЯЌ}ЎJ›qк3^ч~$ЋџиъШ#џhф˜‘9єТ]KЕ’Нд/F<†џsёў9їЄеїаэgќVcЖ3jЬh§ОЊlЅуЪЦ•k‘/ЖЪr+Ќ|IЎmёƒFDЕмJе^­њ^]нVЙМіz\uєCЕZPpWUV'ЖР6U}{ЭEkUyш6њ+ѕзКž1њЂкп4КЯш…"\ЃЮw™х ;žџ’\ZXЯŒŸуЈZQЊ}їЯэќчf}ҍǘm^MхДЕгЕоЗ"ПЖЧOUД‡ДE#ŠмгƒЙп+ђ7rNLРѕ pвюfхFWоШoŸхЗЯвГbG‘9'РЏ_9Dwx,OЏwР pRМ]xъˆЕ^шбŽХїётœ№џ˜;№ЊЊtяПk­ž„ Dj(J•СD "DА!в $„`Aƒ3€"ш8XFQЌЃ *$ REаƒ-Ё%rHrP ЁЦ`Ё—ьћл+G‡;у\ЫЬНпїфљП+{яезћЫЩ9'рRћYНо7H$Е+Ј}’кдЎ ц jž ц‰`v{+љ­4PкнЄ p@a D€Hb?š 6Ю}ыwыwыw˜–0Т,`№ № p?vm–ю0ЃTА“ЏБ“Џйwџzяќѕ8[ ;zдФССxVUдI№ІИДЁЇvhR{аtфоЅ‹ѕrч2zџ5H;VОƒ•яРІЦ=&E6Fo›€ІіUˆ“џ”п`nƒнУьU4ЕуйЙк ј{NpШŽy9ЕSиењ>b_/hLœвДуI{а\ЪоџЙ ЇЦїСз=6ѓt3O7G|‚Ÿ0žVќЗіNуG+ф’OЧeЃь8?†Ѕo>eЂ˜н1Љibј-Ю}™љW0џ ц_AЛхД[ЮЪw"пА–УЌЃ‚ё>љ6'ђ6'Rƒё^‹їЫєєЮ?œэ:zZGO?агQz:JO'щщ‡рйžЂЇЯщщѓ{В'А›љяЇѕNZяЄѕё`цwОN—БŽгєpŒ‹'кЏ ъ€$а\Lо]•|mї$@њ апњ+ ПэєЗўЖЃ‡ь{L›!вXЎ‘4ї9 FIю+2…}П<ВСTАз+Ѕ  |oПГmŽœgРYpЮЃ’м-Њh Zж€\Q]к€Ж h:€ŽрRа ќt—dp9шК‚n \ЎнСU И\Ўзžрzа мzƒ> Œ‘кjНћња]Ё6€р#№1ифЎUŸ€OСgрs,LЉсцKM€–I-jƒц Д-A+а мzƒ> мњ‚~р&p+ИЄЙ/Ау/Ау/АуS%Ы}Q&ƒЛС=р^0…Hт~№ШSA3y‚xрI№xќ<€7РB№&x |>_€<6ƒ-`+ c“э ?иы.уœ—qЮЫ‚пИљЉЗЫ1pœЇм%œ§Ю~ gП„Г_"™тШBA DhЊd‰—ЫAš{?ћp?ћp?ћ0™}Ы>ŒeЦВcй‡Бr=LqЧБуи‹qьХ8іbœL—X™ƒ™р0 Ь‚ЧРJi ЋР^w +›ТЪІАВЇYйBVЖ•-de YйB9ЩŒOЙйЌ.›еeГКlV—­žw е<№x М ^Џ‚ПзРы`>Xо С›р-№6XrРbА,я€e МыъЖјёvфд)SРuю§К'™[/а—ы1ффcн 2мŒрпГ‚Ю2YdK“ЩžЖHˆй*qfЛ\d ‰7ПФrя%:-Хž–I’йGЙпћV9ЪУи!m6S{/'т§ц}ЂЄЖуDЃ9бhN4šцDЃйŸhЮ#šЖ?1 ЈсС”"˜RSŠ`JL)‚)E0ЅІС”"˜RФщзфєkўІяЎNsGЃ)Ѓб”бr'1е0Єƒ 0Œ™`И L“м1hеДjZ5­š€VM@Ѓz Q=аЈhT4Њ‰FEЂQ‘hT$‰FEЂQ‘hT$‰FyџƒК–РС8XKр` ,ƒ%pА–РСД/эK€‹pБ.VРХ ИX+рb\Ќ€‹pБ.VРХ Иш§ямЛаиЛаиЛ~уwG?‹v/@Л н аюhї4ћ>4ћ>4ћ>4ћ>4ћ>lЖ›эЧfћБй~lЖ›эЧfћБй~lЖ›эЧfћБй~lЖ›эЧfћБй~lЖ›эЧfћБй~lЖ›эЧfћБй~lЖ›эЧfћБй~lЖ›эЧfћБй~lЖ›эЧfћБй~lЖ›эЧfћБй~uЃФЋО И м ўЏОrН›‹ЏXƒЏXƒЏXƒЏXƒЏXƒЏШХWфт+rёЙјŠ\ѕ…D*r:•6{я‘ Цm:ян)”UяшxFїб},Ѓя ›Ic`јyЬжуьg<ЛТюБАЛ+ьKмё3‰Œ}ЕЛСЌ“jцC,Рfb—­DлЅ6L?гйA,SХіиоФўїНCм?Œ5м Ž{Г„€PТAˆQ Ф€j жН—Рр\ƒK`p‰$ЃM—ƒпФ`ЙCF‚Q`’t–,˜4м юїzv^ZЩ§р І‚щюе2<3С#`˜ Чн.џУgщцRКЏЩ*№љЯчр ђСfАlлРvP ь•~R ЪРїв^~Р>ЧРqpœ’ІrœgС9iJўOўOўOўOўOўOўOўOўOўOўЏЊЛЏЊ @ PФZ дu@ЈыОІИoЊ† \Ц  h šцрFwБъ њ›РЭ€|Cн nфъv0XzЋЁr“&їЊсrЕ!]TšмІВнUj*xќќ LгС №xЬ€GщkŽЛU=žOЇС_С3рY2№Жю-К#HvwыЪЋ(Џ“ўКЇДвН@_З?,й Kіъ1rЋ+I:d€qм О/€иК;Бѕ•f•ЛРЌs{›=юЇјБ8SJПlт9йAЉgсЛЧU‚8•'%„‚0"@$ˆб TБ•л№qk№qk№qk№qk№qk№qk`H. Щ…!Й0$†фТЉ0d* Щ…!Й0$†фТ\’ CraH. Щ…!Й0$†ФТX b`B Lˆ 10!&рŸРCрa0<fйрQ№xМrЃЬqЗС†tивaC:lH‡ щђ,Яц‚yр№"x М ^Џ‚ПзРы`>X@$іXоoЗЙП,KРR№XrСЛр=АЌяƒ•юtX7]VѓћАЌ€ѕ`и>и>Ÿ‚Яїs№Шљ`3иЖ‚m`;(…рKкь~~пIYŠA И+dј | vƒ=р‘Юipœч$цІУмt˜›sгan:ЬM‡Йщ07цІУмt˜›s3`nЬЭ€Й07цfРм ˜›s3`nЬЭ„Й™07цfТмL˜› s3an&ЬЭ„Й™07цN‚Й“`ю$˜; цN‚Й™07цfТмL˜›Љ1зСв-ј?:СоVАЗьНBrЗЋ1hўdЪЛС=р^p˜йЬk*xќќ LгС №xЬ€YіН™ъ1Ъ?ƒЧС_Рw:ЌŸыЇУњщА~:ЌŸыЇУњщъ=ъ,+Рћ`%XVƒ5`-X>ын2ќp~И ?\†.У—)фч?ЉГ_х|Айн…‰ТТDaaVaaЂА0ЋА0БКoх ,Ыl,Ыl,K$жd6жфVЌЩ­X“dЌIWЌЩdГЦ]mж‚u•хfНћ~w‡йр~l6Кcef`aNš2rј}Д9€>ˆЏ=фО„•ёўУхt7жІРкX›kS`m ЌMЕ)А6жІРжЕАu-l] [зТжЕАu-Ь[ ѓVТМ•0o%Ь[ ‹6СЂMА!6фР†иr`ClШ 9А!6фР†и rањRДО­/EыKбњRДОдфЛЏ›-иH2CГЭaЖЛ+MЋћв-&ЂрЇЇW“р!№0˜ ГРl№(x Ьq}ЌІ/ЋщЫjњВšОЌІ/Ћщ‹эёa{|иЖЧ‡эёa{|иЖЧ‡эёa{|иЖЧ‡эёБ}и>ь@v ;алуУіјА=>lлуУіјА=>lлуУіјА=>lлуcзвиЕ4lлуУіјА=>lлуУіјА=>lлуУіјА=>lлуcЗSйэTv;•нNeЗSйэTv;•нNeЗSйэTv;•нNХіјА=>v=луУіјА=>lS˜Ц)LуІq г8…iœТ4bўхФќЫ‰љ—ЧЯ'ŽЯ!ŽЯ!ŽЯ!ŽЯ!ŽЯ ~ŸmБ|Б|Б|Б|TК/‹ыОЌ(їeNєvтУ|NѕYNѕ~Г­В’S}•SэIЌј'{'ћМ|KІ—@І—@І—@ф’€ЭK гK "K гK ПKРџ$щ%р›:т Ы№„exТ2_}2Оњd|ѕЩјъЫувоFяFЃwЃбЛбшнhєюё-зШњ: 1~4ЦЦјб?уGcќhŒёЃ1~4ЦЦјб?šтG† Cа€!d}ЛШњv‘ѕэ"ылEжЗ‹ЌoYп.ВО]d}ЛШњv‘ѕэB[zЁ-Ѓа–QhЫ(Дeк2JN’iŸr; -а–hKДЅƒвЊ p@a D€HbМЯXсUњ‚~р&@ж@–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–G–‡ѕЯЦњgc§ГБўйXџlЌ6– – – – –ЪЯda da’…%`§§da X?YXOВАЫШТ.гНЩЬњJ"žР'№“‰!K%K%KХ+јѕx1њ-Љ­‹жяSЎнсњ#w™ўlrчъЯнxНK.еЧШоŽзžчмA&NbMwОiч.2эAай]lжH4Y\МЩ;Аt“й‚зи&a0ѓ]ВИ˜Y‰w) “Л?˜Щ™ры6/ГпФУтўaїr)ЏBA DhЊXw5ёi1ёi1оi)оi)оi)оi)оi)оi)оi)оi)оi)оi)йеЦП1ю7~fЌ˜XЈ˜XЈ˜XЈ˜XЈ˜XЈ˜XЈ˜XЈ˜XЈ˜XЈ˜8Ј˜8Ј˜8Ј˜8Ј˜8Ј˜8Ј˜8Ј˜8Ј˜8Ј˜8Ј˜8(@  ˆƒФ,b–1K€˜%@Ь f ГˆYФ,b–1K€˜%@lВ“иd'БЩNb“Ф&;‰Mv›ь$6йIМА”xa)БТRВї‰ Šˆ ŠШ*nсDЪёїgёѕK9…r|}*ОўЌ9^yРœ 9щ†™S•'ЬщЪbsЦ 5g+ї›snŠЉфОы&8!•œPЗЛц†9с•'œˆЪb'в uЂ*ї;бnŠУ§j.Й >x)–њ)”KŒїџЏУ‚ЭУ‚ЭУ‚ЭУ‚ЭУ‚ЭƒйE0ЛfСь"˜]єџ§wlyŸ‰ёйџ,PƒЫap9 .‡СхАr.Ќœ ЗУРэ0pЛ~н=`пQѕЗђн0k7ŒђУœyfГ4ФП} kЭЩ,‚Гaм*ЙЬЌ–AцщhжKъЎ0Шў6Js“/}hзЧl…=лЄ›й.5LДЇЏ`^ 7{ИЛWZТЗ>№­™9 зая†рыЅ­щCїmъ?eЧ\ЪГБАrЕTуоЇ\mЖ6ѓŸОB‘NvГДуTЛ0Т шOOЦЋКгэ:СнюhзjДы§ŸУЂeЏдчЊ›}}Ж6u›2žїпOїЩХдИ„ЋЭ’Тjтxж€uyŸѕщяц™,IfЎœЎx@ЭOИњœкkнБьЎ\eH WЇЙњDj Є Є Є Є Є Є Є ЄаS б@ б@ŠЙEj™ФƒAkZMМБžјјClEИэw•{”ЛFмg>`‡зУЄнхDа‡™gѓ_EkЉХܘgŒдP[ЄБк*mYХ`ц|•@­Њя‡Ии~?D†ћЁїYsЗЛЧ<#ЬГђЦЉрšТвХЮeвоI–ЖЌьi@‹Œг‘Я’DFњЦпŽУeŒАЩ Єѕ ъЅF™ХЩoqw7•3ВчњЅ„г ŸI Џv<5уЉAЭ jaGіТTьоћЌїЉ,ЛџфZФbхœP,Ќоjћ+`З iEŸžЅЇЯ[моћiб ГЕ нЃФ[чї9Н Ц1ї,<Шfї;F?Т<+8§Zє}ŒVгo§žDоТѕYhy>;О™[˜ЭVv|s/Є‡ЊYœEoсnїИ§О~яЛњ'ђ$KhСŒBiyœ–giУX•оЊiyЦћћŠ\+Ѕ  œ’цdаЭЩ ›“A7'ƒnNЯЗгs[3’!f(х0Ъqф™ЯнюkцЮѕщЬyvaЧЖ0bВнлmю‹vДїKє;ŽШѕt№ŒлГЗ0‡ўьщ@0Шћ&}Ъa”YR—y{ь gО‘ЬuПй!еэЉЏЁХZ”вЂ.-JiQ—Љ]1їй“пцžaм“Д,Е­ ьwиW}Њ)1јЉІD3kБGa ŽРЧH,FуьРtЎjџ‹ЈeИs„}М…пњ[нДпtd&qъї`гі1яŒxа­Ањ№5эJiIясєЌyRФќгмяˆŽП#:ўŽˆї;jž§ёЉfkях”їБSћ™гAbўCєrи-GkлSоbП_wѓ &1уЩиЙ=ьё^NИэД+С`§н/МзЬьиgћ cŸ ЎЌќЧїLг‹І—–Œ_^NаK%НxпINЛ™ƒFOвф F)вCю€l0Uzаk,НЖ~яhпрїі…ѓoАSЫиЉЕшЩ&єЄ'zrƒyЫ}‚yŽ5lV5"іиё€[„Ž$Ѓ#ЩNWтъpz><;<;mїЫ[щAя“дXЬи ‚ЕтƒЕтЛ‚šэmІаћяв&Ѓr#Оў|ћзјђo№н_;I•eœwFewpчˆ“фvЃзŒЪ]ц8ћq†жgсз97п qOрїO:QюQjцSѓліCžnхЮVюDкЖц4уaeчмBbˆJ‡шœЖ•д*$VЈЄf мЮЈмЧ(•D!G™YЙ9Ey†QЯЂU-Я2j%бЧQf\ю„SF2‹(юWѕt–C;2ˆ[NˆЂ—#єRI/Ўёоaц*ŠжGh]Ik—–‚shсэSхцА‡жi]Lыу†,еЮў,њvЭЈФЏЙю9цВ‡ог[1Нw"мЛЊ(зяDKu"ЁCє|Ž9хxžФеєx’yLЅhZdь€УяIюE^ЪЭдиЯxоNQc?}zЛTDфИџx^œ~№œh§ чcыкsЁю/œkќ7Я›іїІџ‡ї5ў‹§ЖO~vŸЅš'N-цWG"КєV6ѕё›ђ{ž5фY#ž5сК)ЯšёЌ9vХqтЁO)›r&бNWЕм Ї6узe„zŒфѕе€ћ Йї›pП)їщ‡S№j{#з ж№FђњЊСМ4OЫœxюдuЄѓЋAЭ2њlРќ4ѓгД*sy~hФ§&дiЪНfќоœЕWЃ—sѕVЈцZWB‚Нx­Ьп[ЁvѓЌ ЯЊZkжjЁ{ёЬЙ§жe-ѕ8§њŒuЁЗ.ž7фy"ЯёМ їšђМЯ›Г>VСйдЂпxюжuм/™C%ЛГЧЉЯY^ШšPЇ!uy~hDЦдiBfдiŽwёЮ)кюk‰cоŽdqЬ#ŠyDлНmФuЛƒ'™CsˆђNEŒ]{нр>WЭол=cз]етHpжZbЏNРк іяєЖЗ‘˜пЊДj+aџJ?xкTjўЇt„оZГъпЉ'ДN’ ў]]Ё—ЫМ§gє…“јЬžуявыb~ЋоXЋžD^}K:‹SЋж›МњVэjђъCXŸ4ЌZ"V-™Мњ u(жЈ>V­7yѕЌкефе‡АLiXЕDЌZВWyœɘiСŽДpъpрЖfGЊ1ЋvьJ3vЅЉг€ћ Љ—H‹@#ЎSЏ ѕšRЏѕšЃ5d/бф)d™1d—5‰8уˆ6›Ut&Vј˜ˆ+ "ЋКXD’Щ›ZЪ•ќД•^r“Д“[х6юоN<дEю”Чфzy\IІ,–ќЖJжЩ\YЯЯ‹ВQО”—ФO„НLіЋZВ^еSѕфˆj .–oе ЊЗ•ЊnVZ PƒTИЂвTДУO •ЁЦЋšjВšЋтеѓќ$ЋјЙ\НФOѕІzKuUыеf•Ђлъі*UwдP§tВNVЗъn:EнІЏв=дэњ}КC_Ї{ЉКЗю­†ъОњ&5LпЊћЋ4}‡ОCжCєuЇNг#е=ZVщzŒЏ2єD}ЗšЈяе3е=z–ўГšЉџЂŸQщЙњ9ѕД~]ПЃžбЙњcѕКоЄПT+Д_яU›є}XmзGєЗj‡ў^ŸP;ѕ)}F}Ѕ]#jбЦЈRfbд>kjЈoLœ‰Sп™xSW}oš†ъ„ЙШ4R'MгT6ЭM uжД6+зД1mД2эL{­MGгI;&й\ЎУLWгMG˜+Ь:Ъt7нuДщazшглЄъjцfг__`˜šxЧŒг‰fЂЙG72˜t’™jІъцѓЌni›ХКЕyзМЋ/6+Ь }‰Yi6ъ6&пьаЩf9Ќ{˜уЦе}œЇšюяФ9IzИгещЊяASˆTЩЁŸ‰qпФ ‰=qdКŒЯ–5^ž'W7ѕыžHў#Ўkп]*ѕф"Вї–hVG4ъ*I•[шЃЇм!УdtА^ }}i$5ЅКwЉ\Nд}#:ЈаЛ2 thSUЗ>чBi,qвšq:ЁŸWK_ДUЃЙƒd„ŒСoы~ЉНЅЫЭ§z%ЪXлЎ&њAœ_GšH-tўвUЎkЄŸѓ о ƒЩЊъbхXICIІ/—Hщ,нрЦЕ0уvf’$НeйBzАgя„‰RWš‘ХД‘ЫрRwЙNnri!}d(,Ъq#кOЁчXљМ•Џ[ЙиЪї­м0bXF–ўТЪ+KЌ,ЕВмЪЃ#†MЉЯzвh+У­Ќfeœ•uGŒ7С$ZйЬЪжVЖЗВГ•нв2ЦŒ6=ЌМоЪгЦgŽ3ЗZ9аЪсVоiхx+ГFM6ТLБr†•[9зЪПYЙˆЮ†™хVЎБrCЦјЩуЬ'Vц[Y`e‘•_[Й/#sD†)Зђ{+O{вNtB­ŒЖВ†•uЌl`e“L ЇЅ•m­ьde+Л[y]цФДёN+oЖrРяўP+GY™aхD+яЕrъ$ім™aхl+ŸДrЎ•/YЙ`☸ЃœEV.Гђ}+зYљ‘•ŸM7b‚ГХЪ]V–[yк“!сVЦOš<|RH+[ZйжЪNVvБВћЄЩ&…\ge+oЖr€•C­•ХЬC2ЌœhхНVNЕr†•ГЁ“—ЕaФяљM{ŸŒ§ Ѕ‚ П,_!ыџ“ŒњEiАpњїќІА`џ(Ћџ Љэъ5=yW*h;=ў+dьЏuџIVћђ;/cKužєц{ўНш_”!иО8Ќi•Fќ{WёСЋ_3ЎТ2џВŒљйып3ы<^ю–Љђ0‘Э3Ф2 ˆr–сј$Ÿиf—ь“ 9.•*TU#Ni šЉKT'еM]ЃњTЋЊ,ыЫФ`й эїЪ.Uз:БъZЯ ^oЉ*MнЊћ&XпмМ?%X>,ѓЋJЂвЊ2јмy+XU•!ЋЪАзэЉЊˆ’ЊыШNСђŠЊq"Џ^Я–gЋЪшЄ*ЎE—T•БЁUїcя –ŸЫ‚`7і8уE‚ъЏ–УегШpV:Яу€:цхЊт˜ЋЭЕц:ггу‡ЎЁk |q:оЖ ЎЉце51шЈтt6ЇŠ;Фх­ОUпryŒО”:­N‹VЎrХш"ŽŽвQЂЋыъЊkщZІыjВнH7’Є“$вєdф(њЊЭъІyгVБђ ЊЋ.”?Њ$•$3ˆTЪCDЇуф•Љ2eЖКKeЩЃjЖš-!Z}Nц‘о(Oъ,=Yrѕ=ФFящ)zŠ,зйzЊЌа3є YЉgъ™ВJ?­Ÿ–ењY§ЌЌ!žм!kM kќŽшЎЃќ@,зCŽ2›жRSПln0Љf”mЦšt3ЩL6ї˜ћLЖyФЬ2ГЭЃц1ѓgѓЂЗ њ%§FЊ—щХNѕ1}D›43RŒЙгŒ‘bП‰fВL–„›ЛЭнфїš{Y9б D N';˜gцБГЦкŽПяqяєхк;›0нNЗуl:iєF_І/уIн…НюЁ{Аззыыйый‡PjзaлъKugZ_Ѕ{ъTнUїт~ФЏяEOггѕ)§z ХЫЩ8 Dч"Ї‘гиiт4ušйь]™Ud5bg_чМй7Дš“сеpМЌЗЊF§ѓj$žїL{cЂЖ8^ЖЈœ$'Щъ…7nœSЫ‰wj;uœЇЎSЯЉяe…?Ћ‰"cNMbфP'Ь w"œH'Ъ‰vbœjNЌSнЙ€:;§ S№кh"шndЃW:WТMмZЧ,0 Э"ГФ|d>6>ГЩ|b>5Ÿ™ЯЭ&Я”›oL…9bО5п™яЭцЈ9f_уšoцгуц цђЖy›s'žgоŽНџдћ|jНЭгUfЕYcжšuцГо|h6˜длkJM™йgі›ц 9D;ЏїfН/4 щ}‘YDяKЬzџШфб{9s№zП„\ђчz§™uи=лC; Жћ™‘џХZННЮГэI5u‹КMнЎњЋ[еj›žЌЇъGє_ЭѓцMГЬГ9ъFu3 ‹ўP6G$уs6Щ'ђЉ|&ŸЫ’‡к,[dЋl“эR …јЃфк;ЅHŠЅDxЇЏфkй-{dЏ”’ƒя“§r@Ъ!9,хђ žыˆ|+пЩїђVц~ьk=%ЇхŒœ•sR)Ўg˜Щ—ћщ›єЭњrцлt}Л@оЊщуњ„>I}ZŸбgѕ9]щхвFyЙДqLˆ %Ÿ7ІЏщgn"пh™Ёf˜gю23ЬCцa3гЙmОйlƘ­f›йn LЁљвьp.wК 5ЕЊьПЕфZЫќŠЙ‹Z@NнGО$›ОCќfА"EжN”˜ f‚`ѕŸd—yв<){Ќ6эЕЖДдrГЬjж>єђMйozР2є YnVШ!Ыгrч2'™“аjgјПЃwџ]ыўЗt.№бКжЛ5ячuяякчщпп5№Ћƒџ7ZјœЇ?JЋZXКФ qж5Ж‘C’ЌFJ+k:xЏtIG•N,q)БФщЌ :ъЁžS/Ъ`ѕžк,#єDьгT=K?'O[Я>пD›ВР{еHrLМi)‹MkгF6švD ›ЌжуЯ’ёМ5№€ ЄёCGц4ŸOтья‹эекреZЎќxяВkЅZ1їKд%DgеmМV]ЫR{Љ^туЬ%2ЏŠцѓCT ЉQС;ЫЯЛѓФE6‚ЈЧкЂŸюУnгЗсћш<ЄсћGъ‘јўtŽяПKпe#ˆFоwГўЗЂ/Zq;}ЅqоМиё7ФоШavфp;r„9вŽeGŽЖ#{;zZЎUлU*T_ЊЪЏvЊ"UЌJT@эR_ЉЏеnЕGэUЅЊLэSћеuPR‡UЙcЧ7'ЬIsЪœ6gЬYsЮTїпЙчАљŽ—7жEЛДNЋ{™Й…!їhРc/F AпX%њ6@Т8яіžІEЕfрНЈ5JMVw1gЋl<ш,5KbеЃъ1ЉЎцЈ9RУ{ХUjЂяЁНые‡шГOm’къ ѕ…$ииЅЎѕСѕ­ok#˜6‚Й†љ%3УпБgAоќ?\šгвЦ `Э/e€_`§XМRlлЗиБГЬ=œ<0Žy'’ ЖVэaO7еC]ЏZВŽ$VuБ-Р)ЏЄ.Гх`•lЫ!ъr[%+єЪaЊЋ-‡ЋnЖЁRl™іSyЅ-GЉЖЃЎБe<ѕЪLе&ЦТfЭUkё^gПФrГ rАj‹Ђк!‡ЊіШaЊrИТZ0жЅШ4ђT­FЊ? GЉюШ1ъ*dКК™UаŒrr‚"/ К9Qн€|žXЋyЊ7ђ2ЊЖвYЎыфFщ/CхN™ їЪёlУБчёX №NЫ№Fы№<ŸЉЗXСѓЬњm[R‹l9XхиrˆZlЫЁъ[SKl9\-ЕхЕЬ–i*з–#еЛЖЅ^В{ёВн…Wь.Мjwсovцл]xЭюТыvи]xУюТBЛ ozkГ6.Щ–}ˆЊI’Д—.іЕЁjhVМныкvъы;*сЇпюєvвО­žБ{eЅ—ЈъшОЈZјeu\[Э5іН(бъ;u\С„ъh}ŽзѕtcнТцЫџЩќKnsДПg|с^єSѕ?фA?eP^ƒuЦO6пѓоk4ёі)WЮPљё•; ОўѕгЋaѕКSЦUнЎ—мvZНNЁџU­•€CйН§йьd—Н!!ы3 Cі%i!ЦZYbŒub%™IЖ•†ЈDЖЈD ЁЂ”RѕЗVВ&ЄјžAх}Ћя§_пuНп{Нѓ\Гœћžsюћ9чў§Ю}ŸЙhгшY(ŒF‘EaP(Š `ad_‡ 3@FVyF(JСР š` (Ќ‘ˆfŠGŠ‚‹DПvC\!?ˆ7!O]њHЌ СЇпяJУeHmFН\wс\xгГЛ34 @зOE$+зЖj!jпIЌ‰бlЗ)ъ2РёнU(шљјВ“p#/lЏŠрЅ7˜yйэ№$МП/вШ…ˆGёD‚Џ;вШ_ЯЈЂT4АќиЛžEoЊЊЈЊiЊiюЌж8kc…Z№Џи_g‹ї'Xм}л}qJ(y`ѓŠ!ЩoŠeSHЋoЖЌ№ўA>€n”•\;+Pœх„€rV …ф5пИмвŠ,f=W8qг|ВЏ–ГкнЅ*ы€hWХ|ГjAgqЂлЋG=ГњЩшЁЉрœ?эъФbŽ;НЯ5Wa LufЪž;:‹Рв?+{‰_žЭJЭn„Н9В лПnџЈОhФmŽ^Н7ћbЊœC=QJ№2oю6ф#T‡bы!Д*•'…чvЏ‡rўPџНјrїKФИUЕЗѓ ЌжЮ—ŽqlцтзNzg]Ыъ[ЗXПЃч6wВdxЗЎЬёCЃщЈІЩ!IЁюК’mFЉТЮ4ёгN3cс“‡ \Ё 3flНm’ЖЙджЂи ЂБ;гfДZŸVILm ~Й ПаŒЬ`Ф200AAРв€дЗ6є ‘ˆ[”•§pDЅ pоРyWТљљ,ЧŽ/К„`С7аe[ @†ІЉDЋнqўош­М+kCХШ@ ќжrЄŠmBАЌпМ€3ышBNК-ˆFаCАЭ#ѓВАў[|Уyй­­ Р@гPD)ЊЉў p2ВУkў§=cQT\HŠ|R5Ѕк!КЋѕZМНoѓц,ЇЦцDоa–c|›Œ2Dук@SЂyъ3IWўY=ŒФn"*rђИFLЩШH2dёБM’Йдг<ѓаЂ[.гr†›:z*фщ–^*э|cЗtїf}ФЬcіД‰фEљv-Ќˆˆ†ЬЌоУK6МŠcŽЗђЯ^nŽTa`qJ Š§3Žџdќ G@c-эўKЃЪ€тŠQщП2Jзс§џ’7,dM{к=BЃн#ъЪгqвK:FУЙ5И6йtЪОšпF:ДГЮгDф>ииJИМяЈTѕz0о“…СŸId/ГwwSsfˆпКdоg™IF^*ŠuШdžцЧ$1Л Yѕ5lЈыАyKж+Хf)фCCЇ2ѓOЊ-І9z2ЄыxѕW'е,ЖьŸзfЂП'[њfЫM•ХsЩ~HxХH‹ЖH лСЬˆ5sЅyЭОЕ/BфщЇмI(дюЗђлйЎvЉдя€XI’B…ЮpШ{Ÿаy!щЋХу)VЗєЈх!љ‹ЯА›I†Ѓšт™žC{*Є<^B"Иb"НV!й ќ!Щў’0ЈЎ€Qdiв4ЉhЩп‘ ˆsY†ŸР2ќшCќ/dЌљЏˆў3щЋsˆиeŽ…"їНiЂu_o %UмЏjmmјИюхвМYЊ+Р]?CyvЖзљ"’їzјжЛ­G‡#зН"“шЮkВа\~ооrСrУё#Й~г""RJS„“о’ГЭдьЄрЮї)Ў1ЕЇчтHЁ ВЮ‡%_ŸMи|аL)PФд kЂ”iнLKІр_YЧOVА\шœчЖ‘NuQЙ Л}7ѓўqI…COд‚*Я8ЬпкХЯКБeрщ3Двv}~mЮ§ЁR йnуI‰яu‡?rDМzžtP{qї6@MтzfБАЋЖ|чЉ|9ІА—‚%aџЙ”эЗЈw  x@ јМBœZШqmэXю'КŸpЃ}њkg 2ёЖйx%ќˆ!ўwRЗ‰вдФ Э8П?7вШЯŸЈ„DWОЬџGŸџЪ^-lXY&СzЌŸ iHђ№ѓ'Bшє ‰P(РЌвƒ €RQE­6џўr+‡Uе‡ДІЬEdг“9я2ѓNnrž[ЄюЪКЕx)Љn™y!3aПŠзУ!c…AMж]Sя/F‹&ЄGЙ•д{…Кnьгюх„žIЊЋVtKMѕNiлЂPЭ^j/]k2ЬЊЋ‘Є'Ћ™;К§ЈagEЊЗK!%g^єѕJЈЩМXА%‰EVbwz?SБ“‡IлviпТe7VцœЇd[Лё2-'r0ЂыгнЂHътЕж#W„§Д›+'˜Г$ЦcM%Ш`оc}ЋМ‘ Гr&—P9 'Grэk#Žќг6ZF№н0;Еє0Уџџ§(уЫЌ@aЋ99,ЈіЁ*ѕ2˜{кaПJzлC]†3Б M[†$І&ьJiл]ЧПМhбвк›ЇnMX”ђбkjЩяeяAдIч"zV,ђь$д|i3ъчо‹м§Ю5Ќ8_ЈQГIё.>ƒ'~'.kжZt^ЂЉƒ[шkЄТє•В~nан›УђSе$іAеp№‰b‰Ѓn6{.ЫžŒ| ПЙяуѕžFЛ1ќіXыВ›pYžЅгЬ хЩѕ…амрў ЄЭSЏіЉzќkž\5OЯnЕ7ЯDЙ[{U5|ЭD9\oБfžhn­gв*j“Cьцй“˜~х) d…ћ`rPМšxВЅьЎˆpwеС2мdю|+Фў)JдС|Т б(4=)^E§%sў˜2№м+хЋK€˜ @;\Ы[Xl0aё|ќ||ѓŒѕwž§ю6U@Ѓ?нцF@bх6„зjр—“z6bБ\ f:“0/3Щ§фЩЪО%]‹Ба{ЯЄ6} z$Бд*gkо|ёх†Zˆ"Є.—љ9ЎщVіЇЗЕЕзO$e2}ц,Ѓ`SпSЊИъskЦМЂNY‰TX|>ЋxFё€ш2žсб0_РYОўЌs{sНЧДQы >zлGЏ"“™qЩ‡†Bт–eидіЌ6о!НƒŒ>ST cgУ5M)хЕш/™ЦCa7Ф”Ыsz?fє]р\ДGиhDлŒю йT0+ЇЬ­ЇqHз№ШIѕC;Юж2ЦnЫи—xЁЦ=ьЫB4ќ№Ї”ƒкђWмЮЗє)ўG&Ь‰6ХЯhѓOЦˆŠIc§ZРиƒgQ rр|Hџ*‡џ;ш…‡‘eЕчљ‡CЫ%Њи:„‚oгœќNЧFыЋƒŸhrыjч­Ш€аї.|0Л8+Ф –ыF€m9ёYЎ;LЮя пжрr™Цp§ЏЇЪЏНccC?Ё tу\З>gО2я‚oT‚ж05x\:%sДНПож*ЗTшQЫа$mоЖЬєм6ЉСМ ЏBŸ}хщž>-2ЪьXrьєэіЂ-дvъ9еgz—b/8эмnЁ)Н)bљrи?ёў+бS.XэAІnу!Ѓ ьpxЊрvZhўVŸtбb#OYCfKƒѓqтtswХ—щ^шvюЇш{,†ч'Ѕ ЁзkхЏ\sл]Уь•Ь[~M=Eœ!‹W#ЋІаН#ёШivх-Ж;98Ъ}ЧI›3™X{6жБ—СсСуŽМЮ7‡Я’YИщ›РЈjнIŽ› 0Ј‚T&ВBcЌ.&i—[№?Pќ[(уїiЂUбъєj цF`SоHЫ}ЌъсПбџeJдJNв(rШœЊэыm+ žьаОДсј}Чh%Ч‰ыў3…БžЅ]з%УиГwžq’ф};?ГёRщGп ЂёБЫкъjі8ш”ЈJчИ’]B2\?њЦRл|{Є?НlЩфr‡ЯHˆЛтHn3vьЖMгoўђ*HJЩ€ vЃr?ЗЫйЭжћ*ГУ*ХЛзœт™zжi—їˆrћО}NЮиЌХьŠЈ­'„јƒ2wЅцљGЬF _ox%|иl‰б8о`ВџœХљk=.Пшe9шNJ >!vЬ+љнАѓж–зC9žр ‰aЈѓЇиnђV•ДMіIŒхэwУщм_I‰(аГрŒœњЉvљAc^yV­ЛЧDЬ…ХГ.<>їѕ7Ь—G—nD3rZф/Y$ƒtљŸрПŸ“…+…Ÿ1`шгtiкб[ж~>пЦYЎќˆ^КT™шяw G PІ€џ`ьЋ,„ЛзTЂF€ їН…EЋЎŽќЋqёў?HњUMЈб9NеИрpžЯбк—аk.YhПgvUЙрˆ5G—JйœчЧ‚„pАnЖGшMjDМУ”Qнб јУБ–сО™Ѓ/2я:4УˆЄНзWbљВуjn dДd^:sPGЄЦb[:%нхЄКаБ)д)Е+gсу”pЁЩUгWg4xэYЖONЃb6T"NэуСУпВYЖeАЧЇTuжцЖ1ѓo’(-Г‹}В/Z-Лљk~ЬhFя–‘W?rrkeDблI›І•јЛVшЮІF‚ёЏХ’iХ…wF{cКЏВFЮьЉW<ВoЧ JؘфБГьŠ%ћющлл~hМз+bњЈh9j„tВл^:щ4й3Я%­Gьшт.О5ucйrЃOи.nyŒžƒХDMъKДКiТ†ЉЇŠF6ОuйNЁ|œі™Ге(кdя3аˆbЛЄUmНРм~ъС5+Йї3ъ;c^—WРгFЬХм+™УЊЊn:tŠЉ s_Ъ{зqfaN~IжVr\[кнэ•л{jqFъыЕ*ф‰ x endstream endobj 119 0 obj << /Type /Metadata /Subtype /XML /Length 1637 >> stream Calibri UnknownTrueUnknownUnknown endstream endobj 111 0 obj << /Font << /F8 13 0 R /F39 40 0 R /F11 14 0 R >> /XObject << /Im1 103 0 R >> /ProcSet [ /PDF /Text ] >> endobj 122 0 obj << /Length 1503 /Filter /FlateDecode >> stream xкЕšЫŽл6@їў Ё+ˆОIuЗ’6E“LбE’…ЦЃI„Ш–#+Є_пK“TЌчи ‚Y˜(ž{/щc‰šg7ЋЇПщ(EЉЄ2КЙ(ƒ6„&(…Я›Лшm|Гж,ЮnЫ|0Цbљѓ:сœЧ›зkЊтMТЈ=~X'TЧy}_еЛlПЭзяo^Ќ~НY}^‘У‰зHb Ѕ‘–$кюVoпушNОˆ0bЉŽN]w#a. ]FoVЏzƒh3ˆˆ:7tgБC<ычJGЉR0’F*MmВЯї‡/MшXќ7’%*$рS #ЅВЫ—|ЩZ$c  EКD*фRR-’ЅHqжe’п‡H†"|"#Vˆюљ‘)DБ\Щbšі’”cL LЕФd2gЙъ/Ÿ1fЊcKфЩ1C‚АСrF]I‚ЁК‹о|’—#HI]EЎDŽ( †Рh˜ЂALђ%e>БЉПЩъ‡5Ј6kцєЬІ”!Bi—-‘$г‚ g `j5`вC…C5CT UxкQСLg&Њg,ѕ–ъAеŒІТЁ^S=ЈœёT0”c‰0f—dкz*Ъ4"Ќ#1cЊkЁ#’х‘Б„d8AЛИŸ•йжHцгŒb‚Щ­bЮЩ*3­˜pІWL9wѕŠщAеДb‚™­bzЬ9Х„CНb.Hд+&ъѓј”ЖŠ †ЖŠy<гV1сPЏ˜.TАХ\ Q хPЬEC5Т№=Аї1eБ-іfЬmsЮЅˆˆiС„3Н`zL<#˜pЈLŠгiС3[С\Рє‚ ‡zСє zF0сP/˜  ^0СаV0C[С„CН`_М­`Ў…Ž†јю-"x(“˜њ{˜ъД'eodNЯLU}ї”Э'8ж8чPX‡гЦ gzуt™„Я'ъгƒŠiу3[ує˜lЦ8сPoœ  о8сPoœs(ќц‹уC[уtЁ,1N8дЇ%3ЦЙ:4‡Ђ )—0&Аш]м/П”MбŠ†O‹&œпŠцœOFŸ6h`zбt™4ЭP/š.”шIб„3[ẘrZ4 @Нhzа™gЇ ^4Tз‰&кŠцqЈЭP/š  N4WC‡Щf˜­k6’‡Њa )Љ#Ў4R0ЇШџќВ3žЙuoнж Ї4ЎюэчцЏПmcћm[цGл>tКоšЋП59Z'ŠриМХ#qrЛ&qбИAЬ‘зІлЦx‡ои Ѓ›ѓQЋђлОкY }Шћ‚PђфЦ‚ъBj 8;ТЦ~(ГЦМ&„ŽTЄОcB9‰›ьЖ„rУ>ЮуИЮГЛЃэjТЩПnѓƒ;eїХ•й7Q@bœАјeБ­ЋcuяЦпќa;+0ЌМњnЋнЁ(ѓйTў9Н­wіХр]жdOL“Чv#оŸ0СчGфTЛ`ў4LЅ1‘ЇїŸWqЭр щrо>єW&цеGЪ!6xрWьtщгч;§RСByѕНŸG$gŒг:bщШBЂЄЭнынw„qS:(лO&ђоЗž0N]‹нЁЬwљо$нmšюНpV~ЈъЂљш‹”Зuс–ч=Vьэ5Ч|лео„Ÿ}dЙXKюЬŠ еlL~ 4ЬДўС‘ъбHzЊлрЋ*E"•?8иtМЌ=Rзj-HМ§єPеІЯI#KГsOІ‡5лЏЏiŸХNљ0vsЬФn>лиЭuмVИїHХфœтдЭ)4ЮчысœB—гœТЙяs Ё.ФЖ5Tй=нцЧЃйFГ=\Ml,,ŒЕм?64`б[h…[/‡ЌЮЪ2/ЛKЊА фu™gІѕяК]w<оeћНQЄA˜­ Д ?~ю1ЉНwљGtp endstream endobj 121 0 obj << /Type /Page /Contents 122 0 R /Resources 120 0 R /MediaBox [0 0 612 792] /Parent 110 0 R >> endobj 104 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (F:/Drivers/GCC/msys/home/Andrew/crc/new13/doc/CRC32-full.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 123 0 R /BBox [0 0 792 612] /Resources << /Font << /F1 124 0 R>> /ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ] >> /Length 25668 /Filter /FlateDecode >> stream xœь}ЫŽeЙrнМў‡3”58wѓ$A]Щ†А• x`xTа•ad&ў}3b­rgeU#ЛjdшЪ ƒм|уMžЧŸўЫуoўцOџєчџќїыoџіёwџчGzќыЏПДєHe>k}ШМžЙ>J)џ—_љЫ_џњЫЯ™9]ЯžuеGЎэ™G`\Oyќ§ЇхіјOПўВ:§_m7ФPћуѓњFŸЯ>Пўъеcu[ЯzBIM‹7 6BЛžѓьaДчМѕ€‚@Ј9=Џ| А`#4y^r" `!Мќњ‹Яd-в­‘уфїpы‡ђmБЮЕлЕБVЗЕ‹њНTЗЅлѕБRЗ•лѕБPЗ…‹њНNЗuлѕБLяЎР›Uђ§Ž%јњRцЋ'ЅєLу@№‚QЪГ€w}kЯ‘OlŒ>žЉž,Œ|]Яzг 6FЮЧф>я‚Бі6€wНєg=ЧщcLнўƒQRж и^А1J}–sœ^А1ж&і№Ў_‹3ЯzРQ_ЏєЬч<М`cфЕCч<М`cЌЕЙ‘…l wК№‚БзI„ЃО­ЅЙб…lŒвюtсЃѕ;]xСЦИ§q c‚лtП*ЫMЯЁŒSžEŒчўЗП~ќяЕнЯЋ‚эцљXєЗŽђт‹qџ3X№?>тœЩ>-ЕєgЉћДдšŸљ<Gh_ ЦIћЕ X [wDђ&l…S=ЙжJfD2е‚V2е‚rЅТзAƒЕВ+аиЎ'IE$ c:шЇжЎГпфЂЈAсyCm•ЫР­жЬ’;{ИdЈ\ЈЕ‘џU7ЇЄЕ-m T™uzќћПbwыњ\nЯ~лєыйэыЎ/О 3?г<ўЇЫнwvўћ{Пw€ЉхЌљЎ­Й’‘веm‰””ZАf]фEкkƒгСQџОю}pŒ‹˜ЋRїšњ-з3PssrЏ ж†~‹НпЧјњКїС1ЎжчйoЫЯкЮVФи§ЖщG№Э@_ї>8F=ѓКиSO‡ РuvL`WHvРВ‘LЩП ŒушыоЦhl(O(вГ?Џaн€dc)9WAAyі~`јD_ї>8FeXьbћ“гвБС*k№N-дГr^г<0bˆппеН Žpеч]ІA IЯNю=›Цx6Ь|§U„сїwuя‚#\вЃt+ЋjPе=P^?\МТpyгaЈ8B №Л{КїРё-a&гЪr†&*[MК…šf”-yџ,b€ппеН ŒpIW+Ћ-зPEУDeЃ№ЕAЦj2”vTћрОЏ—Ѓ5Ѕ">ƒяzчЅ„k2Н‡€NkBAїo#†іњКїС1.­C*„њmEЎщ!Ё—FЇтВИЋ}иbˆппеН ŽPѕ †QCї^‡=aZ%%ш5ѓ\–Z9b€пнг­ ЯдВ~’ЭтЋ3tN9Uѕрє§§ˆОю}pŒЊ*›уУ І;іP&cЊbђœхРˆ1ў€Ою}pŒ‹/‚VF‚ѕ“Ÿ {‘šыЗгЄSХЬWџЙ1Тяющж‡З”ijпІзт—и№yGXНLВ'eX#Цї§]нКрUЙ'›4ЄŽnяj У1šѓЭК8ыFŒ№єuяc4‹ЃйФІ‰ЯЖlП d›$Zаyў[ћp`ј@Wї.8B5ФцU ЬпфF’и^ЦрљjKЋT­=0bˆ? Џ{ЃZek~КjэыŸ†VŽбЉя6ЙќЫэ>ЦазНŽqŠ(jєZŠЉЛj8y8Т §ДQміМгтїїtысѕ9њњЄЂjƒц5ћЗо‡2M3оо‡2'Эpz[І7‚о‡Kёзэ|X0ќнљpЕИRЛfpe§ЦkxЎ 1ъЮ‡c†ю|pї=,crчC РїАыс{и}Л€Ю‡e!Œг{ЅтЈнМWsџМ Ц$м§Аў&ъю‡”щ№uїУ*hО‘Кро‡Оњ twЪ•с~P@Y|k}]TУЕџmgў{;њF/aР—iћїeŸпDxЁq]&г‡WЫбќыѕ/4{Хjв{_џТ MRЅЫЁє^ћo МР\LV[п[аoеПа’Ыv*онo"МаЮЊж§|wіпBxЁ$ж}ygщП^§B e|ылп@xбпдпўzЕ™}ˆZyѓщoдП@/X”‘пk§ѕњЊЧrяћїWЋ_ЈИŽЏЗ§jѕ JуЪ/О\ЏЏWПPз{]НГUпЈЁ&–ѓОѓщЏзПPIз}ŸЦП…№ ЦјўаsјNћo!М@Н011•пkџ „Š~Ћ}ŸС|Ѓў…r9[ѕ{Ліѕъ?"Žл4OsV^–6їVчEX"zш 1ФБYDѕ<2ЖД"06* {†‡ЙvТZЃ@NykСѓ ‚GЈfоєофѕpћj‘ јbqS‘1яэ.ИЛy?вђжтѕtыjй@Ц \­y ФышнoмИizoђzњmЕl"eЧЉкˆžUј^wС/эZоZМž.釛4/Šю3Sй7ќЦћ–їЏЇУUЫАtj+zMwСџъGšо›МžюT-Cў$ќ›zRГ`*д)/xу<§@Ы[‹зУSКћ€їђhч;_џhУГСыГЛЊfт”Ў*Й,^ђ…є2;ц0ЛІgTбьZ˜\!8 Ь‡pЋЋЙг­.7дТъ’CЁРnг+ъfWЃ[д­Ўvѓ‚nи­Ўv:AГ4~F—xJ—]mRЃsЃKлнŒЎ]@ЃkД8€ЪщЭ‹pшМІЭ%Э6ЗЙv.БхyнVW[Ѓ^HSџ/‹сЊеЕ–ѕ[ЎHi5џцх  з:ЖW›aАLyF‹:ŽРAMl"Эqј8UYЊЄ‹ЫЩЖokFNŒ6aИђY::•– Ъ{С&cБ@= цОіќэs€lРzеюibI$ЯЄЧ6іњhрЊžл<3Г—щ№ у9р@№ŽPfщcЄЫSЩœC/иlЊ%CD GšŽOХ№Œ\†7 ŒЕ3щD€їѓ@№‚Р` GPuеІъp„ЃоB1=0р=1XА1и$0TgдЃ–"щзМЁyйJdЙcАI` K/T DшU g", oт ™(SР1Єs4‹‡9М 0МI`˜юЕ й/}ЄjёыQА1а"T{Ъ'‚yJOРЛ~:7$BOр†&‡<Ў ЦˆМ 0МI`ЬZt<№\ЯЏxA`xЧ05Ћn@Зi–тž.l 6йЊIяTРsЊн‹>nж ъЉ ьzѓюz€ЛšјQOaо:\єžj§иТ=l№žН#ЏЪ„Ÿ2сЇLј)~Ъ„џяdТКuг5ђ"в5 гПМvЃ‘ЖvГј.~пкЮ9N“Oму&_kЯ]}X|-гcN‹Џ%ŠЗј" ЭMОUN“oС;іь‘6п†aѓ6_ИЭnѓEл|љvэFсћ%Ќѕщ{ ­ЙeыFпЦ бз„LЦ>фЏˆmR_r~}ўТ‰ ‰ŽѓфІz"Ёћ>њUІžЁѕVhШЛБзЊ'<9%TœƒѕиKшб‡+ б%ўZKјv\'XЌѓМдEјsРhp(Gшrї@ Х(Ј3oXХVФn§’qє€.ЃЈ …CЧhѓ~ѓŒŸЇžh}АЯа"ЈV,о;5$| qЌ„ сж`ы)ооћлPщЈiгЎ•ДpМј9m”g^`-=&z`Л*%z+сTcKьчСЏlаАgЗFoбšъJuO­+4ЭcпСH*7в Њ{jНЩюƒю> бlЊ< ЁоЎВЂрѓ.иa“нњŒ.\щY,Ї–ДцyЫŸwZl=jїР.wTŠ|Г\kŠЭ &ълэОноbї€wд™JеЖ_ ўnўv{*T@k#ЯЧЧˆэй_Дwm+\лў/ˆOА…ї*_єm,ъ][лѕ”DёјМХюAіœѕ.ъЉЭэzJЖј тhАлЯcЪ‡іW'јgшzј!)„ џа ЃНЋ†оžj^дЛш.уэnЅŽ 8њ'~ДwЕбл‡к˜1РPчџ- >™wlН…їр=Fд*нТ -вsl\7 9pІљ vƒђЁндЮтЯ?PЯŒИВs№‚тЫРбƒw]ИjЎŠzжU(0ѓЭCћ#о$њ№NН^~G!§ЉђќTy~ЊЛпЛxЕt4LРЦ4–кfиеxП‚]P№а›&ЅPВA=Д–у“съХ-H]ЋЅ :€nЏцЈUQ“ŽЪ ШО"Y 3њ(hійQaК5 ъ†Ќ,Z‘—.ŒЋЋ@НыV№P td(д&Њ–5ŠЦmm КвUЄиУ @.ушИфьŸ]аШ€7aPkш ,&ЅаL ]U[C\*ŽoшеR3hэх‚FGж[ ЊСk nБ–уВNu“лЧDСдъ 5р@гћMbkгь+ :fгЕїК9KЌ&н;Oo[Іп˜К[‘ŽUp]Кa•ЩыН2b{аЌ ч‡BJŽ 5ƒ*lП  єДFК ”‹A375TOы)лЇ§йє“'~шѕn-HZkGGыеж~ъы@mЌ]мF7ˆPЕ–]аo"fпдЬaн“ŒЏ4Я dmR(Xc\{”2‘‘17уњІXЊлТь_§dO‹^ЕТУ3z/ƒ§ёqгђ$#]CвЄ– qƒš8єЩpчеQPЕzJ dнМшьёър№нx)Ј3ыо*4м‰›ŠU– ~Нцy2ўO&–Ѕ?•Суjжgˆѕ*X›Š<œЄзsєяО^’˜U0ЫЕŽзд€ (ЄOЉгІЋЙ[Сb%žеШ\ ’ (%і\ЌZTтщлˆ6FzРM|u“ВцЋЇЇ1)Tљ4JвœzrнЁОvЁ<,uнцЇ7qJr†Б *Ј+”Ш№pJF[жЮчZ7ЭVVЊ4TКь\Јг%#jБy›о:“JЉT3щФј”(ЉщaќУžдЗnсu.ђPЗ§:ЃšMдpъзоŽD.r—бЪуЛŽр‚ŠБ„iІЁyнщ,.” {“jр]%‘E§J P'n“fкЪт? 5ъ.нpU4ы4МуЎЄwfыУ>ЃпUdcPђветxЋR‰ЎfЗщj6UыЗ)ЛЦB4ЅЄелЫjаšЯ‚&Ё2ЙТIUžUАƒ•м ;ЖMOЉfЙљБеv›гu4mы&њ™…ћœ КšvјВ}ІcЫ‡§ ДbSБŠ2ЇёЦŸЈІ ˆ)Eј2д)ЌВ85Ў‚ЩaзЬpЅMQoщъійо1цn:] 'нyq­l“=/zv2AКjДrЅХЊ'ОSH чFм”БаЩКJуO Ш„ќАЅ J ЪуБ—ѕ|щWZpеr‡Mъ™QШ&k-ЭФ“) **ž* ѕlлdm?ZАй4б­€c_3ШqЩжеф‡x q6B)ЦV›1ДE~Жl*зHМЪ•lSВЕ ЩT•IЖPХЭRЎUL бъp;\Ъ”єши‘ЩЖэЩјІrŽn'œ+БКИPАNж(д-І˜ŸКqz5—vfсŒД rх8A`&GшBuЕІГBЦˆлЌщцVsй~дб•}GАШI-0нл‰ъХE”*2šŽAj6}]Ѕœ €JIхєЋX)fЦВъ1ям=х# i€Ыъ0Š%b@ X w$&frЅь*j•ЬзъЕћs“Ь”жЊЏ‘1OЦШšЊќЪfЛ‰Л†ХвПг€ьУ|їЩИЊŽZ.ёЕг‘Ё—LмKЭŽaš8…Š№L$— ы—нё:V%>;ь%fЮЬОтpэх~лљ}р/*ˆz:ЩЦvоИ}З|CуX Fё Џj,Ьщ/CчI@Оœ–LAЎLБ(€Ј(зЬ"vи|’Љф]EgЗ€ЫЩф2ƒз^bU*2…@ЉЩ湂/…KœšˆIrpПуLы‚ІииˆЈ|ІѕхЈwз‡ЈL­ѓfiЬП‘Tе&‰Ј-A›˜ІfЕћ![Уf ‡ъТDЎ\6Ѓек‹kїкq=v§Њ+V{ъЕPw]џх}ЇHКЖW$•jWsЗWDу‚љ№ŠЄдu)ЗW$]іД№v‹мћјТ-Вф–й^§ŒЗз2-ЈCхгйdU%Є*€N#enR1U$л*šOШ€в—оБк‹v…XЧК'WєлЁ^ўYГл'ZZ,T!Ш-агЙ Tхі№ш?й I3ђ'е~5Ÿ€vlJА9Ф ї@х(TЙё…„ю„dPІ/ШU0џ.›ˆš€TН7—=fмEЇ #V%Я шТZ$vЌњЂиwБ$ RBHѓ9Х­3EN&Ьm$VэЎЊaа…‘ dГšuїTъ-Ш6Θ’Е c……аЁk•єЂЎYе€ћЃb~Ћ У.АAн0C6`LЧ5„ЙUт+`м *0ЫKёA№8jOЧЊA­ЉбX†їF zrоЉаВючZТ l7_aчУbеuИ us-`іJЁй35й JЈ“юЭžu49/Тя†иЖ7‡ˆмЮкжмњ0(њ!Ў€НtЋZЌУ ф” bиcnю@7-Ц0XmЕTZ*!ŒЁ Їј §аxvЧ)^—X7ЃкЮЈEp Bг ?ЩŒŽ3З‹е€ЮR†Х=j Ѓ5kЋѓ`ƒGЅTр’_ ж{ЂЅФBавb…Тf ЊЦq.шЩxYВЙ“2ѓ…:ЯуŒйм/є5РкЎ'§"NЦ@—@Љ<Л\ЖУ-љЉƒ3Ж›ёdPq‰iŽфЖdšчd0Ю/48ї( 8PgАuуŠ~›ѓ3—H‰уd[Ц О"s‡Љл3ЫЖVќз’gФY‚(j3Ю’:5А#УубсЌЬ8wP%mТ)ЩЩBАnЖ#хI=DнMЙ@пКbUH\дwВ‰Œ†je šXrяйќ3ЖеdQ‡ƒGGЎi7P~ЊKБŠ9™‹ГTиMHC}аош$О•ц\э86лv],@™nœиWЏђХlю.ŸЭ €јŒI) roі ] ‚RbаCd•Wј–вL~„Р”n6иЭр‹_шСВ-Ћ ;И О‡s+ѕyЧЖC„qлI{Wк4тюEуПтеТБ‚Iј‰ИŽ!gьkВmё™Y!CbW”@žcM& +шЉ@›™PHšЮuйZ_ОgЖ*VОБз -5-"Œъ’M,™7|AjWpbЈю X5@X“м™‘Б DЭр gЧ,T&@ъиOнс’˜K{Кi–‘hЄNЋWЁ qЂЫRєY} 9…‹ М]лPьTlЭв†ЩœyЁГ=a Ш†УGkДeiХ<&џ0 ”vS%e…’Ћ5DІГ чЃ*c˜‚яЄ@ntyZm… s*рOp{йСdЊ˜ŒіЯuтќgіUьœ*{а%‹H’ємЋTзт”Ѓ” ВЦГЌ zkƒЮŽ[|гp3dэр;ЭЫ †`nЪYpA™ў?ЩБ’Z“nцщ†ХDu†й1Ц ‚&š‡#S2Ћ~†PђQЗЁу ‹…Nxcцла\TgШhјЗУjЖІjњ€irЯВНљfЖ–ыЂe„}pѕД? Ш0СТL6ˆ"% ЇIyEф‡ЋjƒnCsЯaХк(&ъLЉSˆЎЛщM›qКм‡Жˆк§vЬp‰N6… ў2Qа1Й M,Q3ЁХчYш9…иТБЊ{`Ћ#w ?Ц:РkK„:jnЦэfЫ6_А[Д#p<щНE]Щg3:СЉW—‚ъ+2ЂщYM|k{Со'=+ЅbM“ !n“9ии1‚We>юœдUЫ№Ж BwŸAЙЗЮпуаzE<ёѕ›ўŠ#ы‹1ЦУ_19№Whіьк)§>iўд$цЪy}лЧ—ў БSАўт1И[AfyБtзBHФ…­рXHƒ]’XЉ’w‹[СА‚NdBхDF@Ю * X jsЃ9Џ”dtŠ^Q`‰Щц–ьаI‚гУb’>ѕ–ъD~"QLWhгЈ"nПсЊєЉbюfћf 7|аА‚Х… :Ђђ&іЫjZаPб—ЭЊŽ$з6хТv$ŒцzЂхРg.|fVЧUњ•lТNЬ}І`nЖ#€J?‘k gl /љтс"Ѓ<Ю™-F!ДВю&ЉРE€Ь’„W‘ЬуФљв!Uoу2UЏ! hgКЧШ 4н+йьŒ%МЉPEж‰ryНW@=Г;ђmMчи†+ЅК m@нM.‘к€ReopЧ%3хZwПН0Ћ #нHЩI“Nёнi€ћэАM c’…&ўYeU ”З‘ ќ”fI^X +™кJм/vЊ5XxXЬэWdн‘ гТАфŸЙ Fѓа4˜6MЁYhм\„;ю>E дЊ o–+cp•ё"rЏgЕА/|FXзЙЁѕАк†Žp+М–гQ PU:53’ФrN ёбЃаЊЛGЕМСJWhtСѕHYи*hVŸ`ЕHЙ€7{к–x0Tў…šA eуЂЯў8~6§MПœиK)хlП’БЙрА4TчvЎ Шђ фл%cyIа kF’9ЈІ >%5и†*ЕЕёЬ„Ѓaи9bо`‹fPџ„iC5Пuр‚3йнП!8є…ФIХћмJF€Џd?љt\рOЬЃщ`GЅЙэJы5=ьчзф ж… šВBЛЬH,ЈhчБ:nу!„Єа–yЗ5‚yxФэH+. ”зNйrТ3(W’˜нlМЙAњˆџpЂ OioьBЁЫ: 'ЫV ЇШH{VЧЕгn>›Ch”п-Л”П€\ёљDХсqгKЈvсеM:G>ЃРѓњІ›ецх@Вщ†rфgT#›йЎHfjЬŽыIZєZ`G [О_Ю‘U@Ф‘ДуRјОпК0Шо:хјР^LДаі bDДМќЦygМпКdц(у1H_ѕxЬƒЙЌФe*0L^ECіK—›@Ÿїj˜Cs^ љKg yЋV AЊФгAу=”HHA@l7щlѓ`oФmœ-T fХb`Ь:Ѕ{M:д ЪрћœqЦŒiъ dБ WV˜ЯZЬнq^CБ|4{лЦ‰L›\њ“iЖœWТiЦC57—k6ўцBM'ŽПЃWйС8_юA{ЩIk˜ePЪ1MжTœд(ђ*HЙЂ%љбХб{ˆPšБ1qнсДѕр*7=ИeBљФrsВ›Ѕ юТQbюcн-=Ÿ"Žcё№žй?œєoњсОН ”ƒА?eл*sЙPaшє#|ЅgˆКfђ`F2Я„}ЂЧ&ЃlўXpК Їk›Ющо+4Ї0Гп!Јќм7gkŒ|ѓ3i>І,8™Щ(Z[G$IЏЃa}]6AыˆK}2ЕДЊ…3ђєdnAи_Ь?„xJ‰ŽЗЦКј>Т3w[˜ltЭбXъЩЂ6НъЉ‡\ГмR[Šq9. ^…w)V<-Ш щеЖЌ 4Іc)Тzв"Š‡ІЃЈБa ZVFІШЖ„а\›ЙDрNЛш3(9O)Ќ`†д ™ПBaЭ IБрʏ™k““HQP@щ4мЊ+РЉ7h…g„ТоSѓ1ъ _нж: §ЬРKОпХCIИ–@яЎ†sKY1Фj:љб2…ХטИ3ŒŠb˜ НPjЗцркфЉњ|рљ@тYBкЊюшAbГ№ОП~ y'ж""Ижal{‰Aeйк’йЖh2с№fЧ}њzМъgХГ№сˆЅма0><ЄI6“–ўИZЉЭЋgK0АФƒЁ$zГC†,OІЮ7,ЬHŽХ{cљ\р*sЅд ыyЭЩ`“н1rCFr‰Кb–рЩcžФdИ8ѓ—ЧVa Œ‹‚5Aн›8ёLЅя{ѓA  Ѕ РТ4Pg *PI˜}ЪЋyœ T-иЧ%|bР њKm1; Ћs% „6cТT§˜гCХŸбрNЛЇ.2h­wК— Ћ тЋјМї IЯpяиŠдЊ cьŸŠYЇDШ4ƒ‰О IdДфЦJаk'ЁbС„ъxvdІPT3Ѕ-7њf4№x}!kтP:ЂЙРSбР|a-ё›+i&ЯVХoЏп;ј"˜г [чм]iP(ƒЎBƒPwйnj?ІЏуxЂЉљЪ нИ№Ќ•?jѕ‡утО=б>ŒŽеjŸev !є#Ф-pљVZРkмњћ@ "J,сDЁ wvЬ `ПшoЫ(фЕ а›дтKз8;ОВ7'0JёuZ0І{Т2^QЁa”ёЧцЪiŽ,ВўЦRЪс–K5И‘|е#/:ЁЏфŒІ№є€›(\щыЊЊj­б-:Њѓq|ЄБлсў$CЎюљI|нIХ?žЏў  azQєС›Ћ?ƒї)рЮыћъžvW€J>Y йqK(”Л >ƒаmrмnЖд…ШЋѕW.œЋЬЂа‚лИ7ЋІ’ЈЯФ,ШmЃщШЬœ@fтЖnŸB ЈАРЂKЈuHN(Ї7Ш™еЬДс(˜i3|~4ъЙц6€ @KоiРw:зЬxкЮ qффaЕ@Xё)фЇŸ@…МжЯ‡АužDv GfRВО'tАЏХ о/Щ‘daAЕ@єUhYГуRVTїqBšШџЕt\1Hъ%e4“дN“Qуъд=’ПJ˜HНі:ДBЁа'рuZ­Ш‰ЫœAЧЅKPіNгџп…Д5ЧЅ Ж|Е–ЧћC&щKvЕњŽђi;šжJћ?нќж™ ‹юе6ЎЃŽкЕG7Иn|H9oІSЬи‘A тШЙКŒцk{tЏиOc™””#уPпPг”^џQ jг• "WњNІUBЭ  dž-pXtƒxщтиЂц„f’8Й{x neK ›ОЗ"qффќєVЋЂ'Ї`­ХqiЇVtм:йkЦѕˆЭ?3•]KOVˆмTЙQNюK$ыb2Ййд9уO}_>‡Љ28€ЫG›йхJІЭ ,`яYТвTЈЩ bGŽЫы5Ъ™ђ ŠŽkђR M˜0”A‰цh6­"ЛуІзBж/cBўбТЄЈ‡3CrТЯJСАл@MƒRs "б#De„V,t^qЇМRХ­Љš4Bг 3ШЪЁѕNз’ƒ~&|ЦІэЌ€И:ъC6U |ŒНŠД) 4$р‡Ј ќЈs0$уd№=y}OљqB`r•Љ€еЛЋƒnc—єаH0ЯсъПР%6Ш=Q=l—y:нeV0­@epb.ЃЊ Цс‡*Ў‰šhGS>+ ­ЖŽ­ #СбБGУЗEQˆо0iŽL‡˜‰†со0*Й§ nЧwЪsg5Ц„ЏДсИj˜ЯРT+ZNЮ.:ЦГіуЁЩuТo$єЂZ;*^С y-чёЎ*XоQС‹8sœ,Ї& $М ){†§G9…аЗЅу‘ИŒdЄУXQЦRЛ, ФXгйЖв­§—Ж’Рбd ќ3`КјTXˆГVўMg8N†D0"зГ:Ђ]}љbк ukЩPUoз яАŸ„Ё\™іУя‚ ПуQV6e˜U™[ЏY Œ’xф"‚\˜nќ\!г//#}MNyаЇM\&СдІ(ЅGЌЊП’Мlr ^˜CХY"яЩ~xЄн ж_S&Эё&Ўv­BњуЗMЗЅЕ#‘Ь ˜уQьљЮ mр9вЬœ4Шж<€ІtBCѓићV§КьРSЛ“пС‹ЖL™У‘{їhіФ9KиГg|!Ж›=WЮ^mЩž+7§­мъ)Ф-(hxŒб СWЁќоЉt|=˜…Џі2žB+Р.]x˜ЛЋПmЮЄ;фx2я” '>и‘D5~у…юFЪ­† <=…G!оœг‘Љч_шkТкH|5ДЛ%bШХ-—ТпГASUЖфскщШ`‘OвQ6Г ~р~Ю ў!_™фd[тЧ~?Щ`Ц&БШ.аФз™‹CОя€БЦМ›тЙшГcd*іЪ2= &'YМр*ЏНe'ЇoѓUŒЙк[Y~Џь3SІCМёRZўЭС—У3г,ћ`ŠЗЛ~ЙFзш8*ћїлѕ'‰Ў~0=бџІіKЇ#і 3іЖЃ5 ˜]­<њЁу‰+0`<ЏLПќv ˜~ЙQ хЂ= ˜Žь„mРєЫm’‰ОJ ІG0ЙGЯ)ь—~…ё",0Œцєа^бѓкNHЦiНHvћ›ж я„ѕ"тЈ ‰œ=З^„В>Ќ^) љВ‘э'ЭФ“dhОˆјеŠžгtѓE"іEћ…Щ„.Ww€K b6э&1в€aЦ#mц‘l†i'ДaЄљU<›BнaТHУˆaДHѓT‡ъaТHЃЅŒД~ЂлЋœŒ>УпO ІuП вёH ІE †Ь.0fШƒП Ї гЈ>Sj˜0Ьiп&LЃю ІQw† гpЩj›0mИё GЄ!!&Lƒw›0 Љ 0a<>4aќъл„iУ­!:HбЂ гp!m›0 ™—4aкKЉtZ0ТДЯА`—xЖC ŠЬЎцЏѓёu)?rљЩЧЊКеІŒdЅ;Сe2ЋСћД`Ф<4‡ЃW2RX0з-,ЩАЙЃ?(aСHЦk>А`$ЛТO † EД`Є`јА`„СџАJщлД`aСHqлh#—&Œ Ц FРЗM-aТCЮ0aIсл„FHaТ(дУ„СЯћ&Œ”xТHС_Ђм?—йУ„QЎ=У„ёtФ0aЈqLВџіЫM}л~9ž—.Щђ'Ж§R2ВRЗ§2ЬaWїЏ{ПЄ%ќIМГ‹/M˜9ІАрІ§мЏйXЎ—AЬйƒRіDИO@NШЙ[šПAМЭ…ІІј5&шh/к9jз~д=wяоёЂJƒžV9  ч‰XЋјcšV=qа~чeŠпŒ1(yыфАМfPѕKa…_ТSоq5 ŽяdЬ“wX,I!ЎFŠ&UёYMЊтf3)ФŒIќЦLХ7i=ЬъЗЦ&КВCDм&"ќ`BŽ\­@Љџ€ц‰œczь+уУіŒuу0ВŸВ‰)ќНG§%HІЫ_ёуŒЅ=ћM[оЭЩј…[&pу2Ќ№й фТjќ .ZтBž0;Ёš)йќщ\кSи–ЧƒФ"—јq_&л+€$&иOц2г?Б+Јў-3Н‡#cИќ9^Fш№ЃИ-ВЕ‰кая|œ@лаМ!к ‚ –0ЯфюОŒ”r.ЗфƒxgŠ”ЖffoВxОLѓmŽЛп+0ˆQ ,ї`\"іq жаQЭ{јщPОœDSwт˜лгЦVЁќшьчŠНув%‚JzЎ/змrр2I5”ЩЄ‹ ЁiЮŽмЁeЋЅЇšПuЪлBT}&”$БРо+И)яЭђW& зДƒРl'L^qЉœ>оЃE&ИB-ИMМ"ѓzŽ†mцєЛ9КЛЗ!ХЏjkС@_еШі#ZЇ€d*Г‚ѕMОЩ`…r‰ЧMѕeћK|g Ši}єk-"eѕaP‹[:ŽŒX~2/WfСwшaj@ІЮочАQТcaMyqв(WХ ™MЏPЦэкДјmDЙDЕф E;цu0ЗмД€ЮŸвЌš— kВуеŒЦ!'ПА#dГИ3G!?Уѕ”гwqј§?Ї~Йщ2чЎѕжЬИI41Б"“Ађ%&ЂРІ™*Рƒ^œЂSкGPќv…™јэŠщ ЦэћСwкя аƒ/M—O3 єФЛ&fХ_XŽ›™:0ё$JLёЈuŽŽчMЯю™є 3ˆхJŠ…@uЧO3О< р*дsјѓ_ И.•Œн№7Ктшf^?иУимИ­р'—Wpќј8ЅВЯ9§х0й'wžеГо шˆфУlEhI|uе,оdhЁ`СягrhcШ?42d6b ѓЅ˜ 5Џ.§#я=aдO`‰уЛЉСЇb-АЧeuWи„ђШDЊН2ˆ?аЁŽё2QОЧxйКcМ BIЧ˜ЕЊf ЗлфПŠ…@РПю%F–Сœ‘ [Gп^о м)‚ ћ{їvœщ€,Fmž[ж К•ФI“Щf G˜nЕ|'39zшЌxf7k B‚ёю/|б~™Œз5юЩЯ'Ф!F™ ўЩЩќ‹wx˜)J“7ЈJœђ—HфUвЉNdxu“1ДPЙъ§љ$г&ннzЉ#yNбоарЦOKwж8­&фoRСсе‹ORЌШI*ЈЃrБЙel –GЊСуЕдЖl,eпўй€Š\Д'(y~хх•Ѓ•ФQљ ь•——ЬœШk#ЃGФЄHрVž(oA‡ЫKОѕдћЈTхтЭр6@/UВСу›Ѕ=б#в’аеюЯЛ$(€CмиzШсh ЩЯœх%^di6Й’‹ЭР€ђбЩГM€yИ-ц“E­*ЅЧ˜Э2мсЄЫЗ(Ÿ:8+}ЙЎBf5V‡љ…ВГГ$ WГјќxKXJp8йѕ>Х:йeи%э—u”Wк{Їквъ7Bвъѓ–a Oш&юц86ї@" їO Ž,?%ќ=9 Хќx ЄЯу*Гqeg%ZW–ЕбvбWhЧ КqјжАSZœ. yапъ92* sKфЛДtПWЌCхаe Йg>•ЩЄСљcџЅo)Nvˆпeль(gІ`Y*я№@Ž•Ќv&?Ъ ЁEŽAЮG2пb3­OйH^мWці‹Э’CgQS™ЏЮ%ѕљYЯГП^Oљхи#jЌу(CRоw^<дBŽ4ѕБyAЛzUЧ>0:ш9Д&@•‚ўшљђK™у­ИВŠшjй‘*ь‹ђIЃЎЛpuъиsF}+sP.СG.E=ёсБ’ЦQ[пЎvыЬЉЄo—45­‹H*џxKГн$I­@jkI єvEsџЙчЏJДVђTЊuњъ,С`s•;tЄRпЪЏkќнЪŸ)ќH +{RцXƒhkЄЋpѓљ_ФрVъ“6PвH\џRиБсФц7ХљmЅ§Ѓc0л>”іK6+эЃ`ќLjэ›Мwo­§Чпhэ[ЏVFnry]Б K)ЈсН‘)U9т’qФьЭП=QФHm< ю} Zyќх9hБ:8цЗ Pю7 ;­“œX…€Ј“†Ё—L7ЦпI˜ž, шз"sYk”ИІЃOтСш~а3сДгГ›Яj1Е1џќDzŸ€.*Лƒ'mєœжLЦ)ЛCŒmд9аJєLЭЌFЃўbvў№`иТ ХCtЖ™D‘H%Щwt~є3‰в.†Xл˜х‰щJZkќ>‡›ФщЯб(]{шZВŽзrзJЇœС‘*9ж ­93ўШqЕЃОє+Сr Tх‰mђэAx1>G wСB\$ЋД'4'\Х‘iik[Qг…Е§Ж9)l3БмWK. ЭЬwрЭ3Лкщn’р‘]dp“Л9“жж“IiЫYћйц”к‹@ЂОrWБ1ї іЁ\v„Р™†СК€8PЩYєtDО ‡9ў“‘џ(P^’;jЫZя=ѓИ#ЄZ}Wњ6$ЦœŸч(рw+|PЭ>јhы9Аоюœ„X'мў–WЮХJгЏ\qЧЩі\З4ф"7/ЬХ6wх]с Јї‘TЌB}^dЪ2јєщь`Ке|ГљD6}XKLМЧђЗЬkЁd…“­“Ю†…—D‰$.6 сЕЧ‘Ј>ЪмвАц$јЖ8EЅVТ’qігоё Д$!цЬ„P#д—љ˜АJ \уЈRwћ˜Mз ­-яCЪpHЃf^ щЦCОmЬrе*ŽзABhл.G‚Ни–ŒУ,-LЯє>"“њ№ИF§ЪxгЏ SIЪєЧщРIš”д‹qЛAЪ”ƒ26ЖW#вO>hВdж^œ%Š9bусИ…Н8YSА~§rвЎ–“1tJ§В фїВYsљ‹]hu`A”чф8п•IУіЖуив”й& ЦЮWвЩ2rЪ=ЬахыŽƒёИГLї‰ х›•hDqЏўФuszї+Ё9юЃbs.q#-n&eМx"iъM­•ЭІr,впЕюЯы–плfF2hq’hy‰M&8ЛuХƒMNfˆ“УS6Шˆѕэt)ŽЗ+ік#“ЭщфžЄш,­ѓB+’š3€}pђ V}[ЧчЂ…ДB]‰›PЬCбђп+ЯаД„П+$РY(&5”ў'YЇ{(ЭИ–Џ| <яЕ)кЧђ ХуwYœё`›і=š Ё%З=юR?ІPtxoЃиЦе&’?œЭ!шf4”f(q№rї‹ovа4sЃЮ˜фp\БFБ‰Уnщ;ћЪy94Ѓи•>єHїsй_“3V’PуЪЩ]œЩPдёйP”гХЯSоЁK§Иьјl\žqсРJжF/‹x +GrF7Aљ›иƒ )Ѓєt/ПZ> & yYCю=§ФиwJ%ЎЕ'дˆљNugЕvДЪ”"[Я<­W|Щы­В JBG6bЫ,2БЖs BpмФОкБо\EbRФšlfпAнЋдоьЋjŒоˆG?Ў9ЏоIЩЉ‹сžlЩєLe'пЋНŠ'o‚‚dжыб*Š^э+Ня7щЌЖ‰)Ў“roЯ>б\фЇДФ1ЬqЊGЈ%ŽщrxЄL$rбьeЌXm“]м+Э|!9Q]цwПVЎ…l‰]N€NЧхa­$ЫИYV-еnч\ХЮ—gѓžЯWхKП}№wJ _ˆ\Ич:К#0.—Yа=rQяДљm\f…ƒЗз'F5A?ЩЕ•œнЂwNfщhn‚діКѕчуP`Ѓ:kђŠьКнf%†w9qъЯ‡ђ.Іў|ŒмРићaл$ц<ю+њ§?C§8†"H‰>†EзС•!cЄ#FvЖРŠVчœ,€ŠHkq_Ѕ=9`єL“еЩџCŠЭбэЧdєŒм=„>ќ€FwфютXЃ<ЁЎЖсЮ=#„›uп#7MCф`fp.ѕш}:‘PŸ*`@о™ЉсжЃ?œg_ir›{JХš>М-щ]j\+в;ЕИ”O;ЕИTЃїeЗvЉбЛrQdюЫžьБэ9uS•огл>јњžЎіБ,iАoUz_žяцPš/ …БІ*НГ& Tщ}ЇЪў*ѕЉJ OU:™Њ[“.6Jšєšф„К}оЭ€еTЅтп-fэŠ=лЅLђдЇ2}5–2}Шй>•щƒЖY)гGЕz0шƒє/ЕщЃ:А7џ‚\ ?•щ `“2}TЧ%‡;шxv+гGu`/[ѕuœјs\…07ўЌb~ хЄ*}T'Я’*}Є‹TщFЪTЅЯє€ЙH(X&0MžbfЬCд~гŸпжЅЯ[—оiПuщН(НWъвUуЋcбП“РУ?јхчc|ЋKпˆcFlнT0j дTSнЂ€ќ2*РAНбЃпlХmъ\еyЃ9є., ˆ@іE‰ $ mtЃAЩ€(Pзpbвx€Тp'hЬо„ OvЅУАИР@ы дљ#Ј0ьiCožB2н˜™v ~k' '2ФƒЭbJаiwчєЪYLєлЮgќ(кйœѓ…Ћ›ђшбѓпЏЪЂСOД…pN#кsBN95*ПЛRk‘ыwQвєъish€;/ ЬњAДО­ю г€"<$o@ЧŽЄСёЋЭЙџБкЭuш0пuщ  хzTа†ВŠN''jK^Дƒ3Ўўн`Š•Нtv ‹‹єG‘UR‰S™[дљВy&KЪ. }‰jн'„к|)г3 ?FьЭqчN“R˜Ъ”'vТЅО)лјЌ‘›š+š+GnКueЯЪЪxєЄеЊeO•ю ЂфГŒ§j3эab4”с|ТЛЗЙОM\ŠяœvxjSха~ЗЉєвk8Bj%ч†Gž@ДŽ]ЙSяuх4:5c…ГьдšНњR‰ ѕmмЛЪVAђMЉюѕ}ЪЙ8#žrГ ЋЌLšGЌPуŒ7/ЯШО‡їG'HЧКpзun[ eZЁП5pM ячTФ@SjПh‹:ЮХ  Š]gј~(]\СUkЗ­o5^ш•'О[—Я+ЌР ŸюJ+бЇjz%RЏкˆk7ЏЌT*žЧ.`џэ;м–ъuŒФ‰Њ эŸ29!ЩЌъЂAžЏ – 0T+#жЪЎХцє фЦдЃу(`ББ„c j–>k›AzѓR1w< В.$в*7UIп/Же$йˆƒ& ъжЖГІWvml ]ГˆЊJW@“ЋК™С–Её+ƒ›#‘@™ŽX№•:Е`Ё5кЫuaТGo/Ÿ‘‡­‚“|ЩЮ О‘ДиЪDНm/“ŽPшях (ЕЃMmƒœАтэЫ–hmƒ†ЫPП‡Ћž ЛlњЦM( лІ› ЋфD@nЛЛъ[œЩ­:L?Ђ tdмђ{(рЉš Г…ЌА›†•2i7Gнa/щ‡а!д5ŒњВkхА5Д1г7 эО*ыЖЈн\”ЎБѓХWХФoкHЪЇЊ з”Ww[a!ъЊPл呇Ёu@h8Т‡ЛN~ъЉhœAxюъmщю;ИgжРxt•&y+Eeх=Ёs0c–УеОJLВ†Щ в—NSU/YI"ЇХFœv­}Вfоjž†jPћpъинŽ›1Rх­Є<ђпTьаЫ‡™ќHX 6k=ЬдПl!JВ+[u щНm*NiЫ  e ћjъMз?ŠэЖ’эiъr4'Rйїpљ и:ѕу•„ŸдY•šJ~Ьы•KЈШeNXѕЛfjљ"\DXrUhћЦјЧŠ[жvPтЮєG›зlВяNЉК‚8|C@ъУІ+Ÿџщч•˜B5Й›YqКгq_Tsœсc‚џЙЫТT@Зъі'v–{N№хgИЧD_Y \ёaгHЕа+ЁžFRuVЙ‹Р5GЅ _э.ЂСƒtк#пU@VТ8ƒ‡˜g{нOѕЎorЊыiЅ=ХAр’еNq‚х4Nq€yЬј@/ єНь\uЛ\-,$Ц}ь­#еЬfхQŽу š8ƒ[U?LmЗmЭ[ш\kЂdЕФ{eвk…U_: ъМЉрpЈBе "; lƒgF‰MЊи3bJецXqMъЫЈЇ•гbƒѓЊ_ЁЋвЮЃQ“&жДkющјНТГ-SeЎ„Bє—mаМЖb_ї•|p– ~лŠŒCНЗsh™~*у є†Љpа–rЦИЪjbіyфi>чITgгЙф: уэІuЉРл‹q–СФžтТS2fWІOќ›xЈE\ЛS :Lhћ‚ааЙšЊ’€‘ œSNЗo@lЋ’Њ,ЊH?(ДЉ6§ЋСX}%,ЫnpzЇeћŠ‰)DszbЖ7oR@ЏОˆ/ŠC>дИ.GэNSTФKфсdиW0Я‡ЅMJє4хфшIUЏєХf_efЛк}е[ЪЅYŠwъТЪS˜g@ЖуzoЛC "ЩB^$ё‹т‰$TJВ…њ3нДš$•]=xЏšvй r” /=ЅB<ХО@'’ ;o2"•Э›'KђУЩГ$OЁ…эеР… ŽœР$ŸцYLђJNнJ>Њpў5^уЧБUnn!)+P,ФЬОd'bё DS1|Кы]9 зjц‰tUЗљњ8Н<а§ъЮзА‘ZЄ;D—ќP !љЁ`сё@~(ѕйќо—Ч@Ьі№јЉї}эkEž‡€”}БЛЏB@[EЋ‰ОW/ ˜сA‰є9Iй*і$o’эЎ ѓ\1k‘бз$ еœ™ъм2уFГX$CЏлkхLбЈ.чeМИЛшюa!/gP\ыв]ІѓЃyVB/yqЊЏтЕvэБШq:IЧЕ™ TрЪjюЪXO4)—РaGЙŠˆg8ЧЮўИB,%Ч‘sьњ/Ћо‘o8НpаABŠ А,r\NˆpћdcdцК^ЉТ>rUЈЬXС”!:§Jж~B‰гьS‘ˆю+‡ј1™еnp'Ћ]YAš…”KЩЅˆ;Х#•#3€вbЧщIКT~0ДЦ"s›A7GЁЉЭ‘Їв<"'[‹S‰™}ЧЇy2ЌTp–ЇлЪЁz/аИ„œЈБћмrX“Ію3]ŽP.Y*яJЭ?ƒ­>4Fя™_УЈЁ=љ5г7ŽИѓЎ:ЛГNFhђ/:‰\їЅЄwGHgкIЄђЌйђKфљбйY шcЫ§$gЋRlM†BuќЈTE‡цИЃ ˆЫP"œхЫЛo=щШrж#E# uЎюЌг‰жNЈѓMеyl9А66ўюHЗЎ X(B]ђ;*Y ф јšФмфєЏњФу'юQЇ~ђпŸДчЇпєAY” ѓсƒЦэ‚в+svаЃ>vvІGцчпИ tЧл@ў§ЊT:МйД€lъщ„Јфb˜]П#rZU$}ѓM…`ЌЛ/5Ая™=šп№ё*7ќ1№ћтwiTšEЊrбЙX›Юlё`(JђНіљSц€ўжЋВЗƒFY™ЩэЁчяд ОD3oŸ€izO*#4ИиwЦ›—ѕ§"‚ ДQJћq@‹?JІh2Ц–\6“ёMй–Ынp­ЏАž][ЮaбГЁЉYA!хžCW}ЎоЄсюТ9œfОŠцШЈƒю›ZЅи“:œїу}8ZдGQУEАѓ”2ћ*†дyŒgsOЅ vЎйYAЅяН H…ƒ‡ЈrPuЄМTЂ7qЙ+€з]~ nЁ5fбQx› Ј˜9vgТlнŠiаv_=(˜Р!Р`и:=йS,‘y Ф ёSU?1˜а:\cLЧЕŽLхяП“1ЎSѓŸЮАЬa.llqцажvgѓ‚ ЭNдЦ‘94lеhЃ €тjс›ЎMvмwQГP;šUКrN›ЏцŒnœЃ<ц‘ н}—S/еƒVЪэqe*#Уј“ИЌш п КQ‡О6сŒЂыŠЄLаxфГŠ]WXч„ы: lHС—ЃЛГДШƒИєRЌ#‘ЅŠ:єФЅ жФЭža!’ОБПФЄО••ЮњIеbWњІœ€ЈЫ„’t†ДБV' I$›]сщJЌˆхШѓP:sŒЎ$" шЊ<& ЪЈ>…oWŽ|*1•%Я5ђrЅиїЦ"ашhЋŒ“Э‡šѕ )лЙ <Рлl{Žкѓб‘!XлAxА_ЊЗнзЈю| ЭUŒ˜P`†ФгrП}ЉљЅЌV]!LЋ™‰щнЙj‚mщнЁђ!!їž%ЏйЗё^!X; UСŠогn5ё‘]Q1В@iQ;п”ŽЅeпЮI467Ю1ЎЄL0›:Kю LаЙєЦ…iўъ"тСuž• ЎrRWyŽмšcBЉ\k.шКtУГlћмљ@жг ЮGЈ~ђяgоѓAytэьkZщЎVњpд›Zњ ‡э8&ЇT4BЁNЫнЉюмlѕ  к@Ё>hцИ @ЦЇmЋ–&€Н–G<)r Yбm†ј›Ц|лС|рѕЖŸg!”?j†Mшi™з#zr#OЖЖЙ.}Ђџю{ й;9—ђ… ;›fqш_ЌЯ>шT|ФЭhехJ.BЖіП­АЎЁх$:6Wо­ХgLљd*›{qs@wužЧж€”БŒ ”aGzеЎ€\jxП№Да§јАBія?фi†*(@ац‘„€ць!:9{№ ДgЯ~ŸБƒчЊ˜|vЎaNJЧ•N.]СєМ N:ХЗoЊ№кКёf•,Ртпs(ээw7Хю8 §ЪђbѕŠtн’ЮB-ю O<жFшŠкпŽdŽmчŠkЮ-ŽЋљNSл_їC<Ј}u уšTІЄШФм)PЅn)№cŒoЅРu~H4і•АpШћRєuЬППЌ/%sƒОХЉМ›/BŠ\ЅWNЇŽTЙbfћrбc‰мЊK?Q<;  н7і†!EŠ5З…LЮЈ}ЫЏб EБЇ+etfт…ŸъФ'Шѕц}TR>k:tк KвtІr-,ЃeЭќж};U]\ШF7ЂјЖESТœ2у:ЃM% GU†]EVŒаЋ}ЧжkXзTрС.‰Ќ#CЇћ"-ІЧБPŒI*ƒеЗKО‰]:ЮОфžџЮŒ)HЩˆVwgЕNД u]г“@пj?шИ‘0АDђЇјK~ТbпVu’Ј@™Ћ:L x…%ЯР‘›EыщєUi№7фGWl< ыі€щыXЗЇп!ЛИsSўЄЭfОˆ‹Щ;%-ЃГ]Њ„™]кЃs"n r€Ь\#пЅфGwЅћV1нЏЖОЗ(?P\UШ ŒBгеШУIФЕбW‘,жиw“ѕ•sЂѕP[м™ЗІRjк'—b ЮˆkКьєy)-2дзvCојђl^ѓљ*оє‰_фІXWЅгФЃЬ ~pKсKЪїт 7ЏZЭЄ })?0т<>ЈdЉUЈ˜%N:kй+НФѓВ!{/ЬGхbъ~šЃл(“йвK™ьd”v\џУyЫdэюL™ьД,чUГsŠd‡5a%’qж)’zЧJ$;ЭцІЩ.ь-‘Jq€йЉЎ№йЉ.ƒЌ+}ЊЅЅ…ж^Sv:Jі›йBT"ибъоPy dЇJ,D[љѕ:O‰lѓ0’ШшТz d{;a—Влs nЯ и;3ŒˆРфƒKЭ-%2ЛuЄDЖЗ§пЪs‹™JЄ@f' d›.Š”ЧТ т)Ž…Ÿ„ЅБЭмˆ’ЦіЖЬдВЋЄЄЦ6S4Jл+]&Еr*ШNk;Wх›2ГKл+ы]АЏЫa B§9№ZYTQ—і~@КЕЛ5ЦЖДљЦ6г€PЛIcЛ[N ilwМ;;їѓЧvwžŒЦq{JcЛл‘Nвиюж0†4&'LIc›vѓ[лЌХ1šА,э–щЙŽ;ЯžђCК%эЬњснnЎА98TЪ$%ql7{w§aXЙХБMŒp‹ckZD–8Ж† !-)})‘<фБЛs№е‹і4 dkкћIТЯšіЩ:оџkЄ<ЖжщnЇ?ХБЕ\b!Є•ЅHwHdЂЗDЖ–rp„@ЖН"ŒRlmg )l–ЃЧv6 d;е’"ћіLlwКыY лL!#lSн(l7dHlгТ/‰ь†ёЩЖЊnS$SА‚dВM?Ё[&лдI&г–LЖЛЅsЊ”мJЬYЛх!уU e{8:_BйСѓ   eœнC(лŒƒН;я–RйІъћ–ЪіЬ)LзХ ‘lOOїwEВs‹dЃБЦо-’ ‰vЩ†JгєЎr‰!)H“›§9Ц7"й(;Cб@є‡ъ}3zгоŸPcФї ІsиЬЮ“Џ*ž'ћvAGcЯїh{ ћў @iІБ/}ЄЧRт,<ш|P^€ряX›Б„5ё №СFsЭf@zQ]Cд ˜#…(4`mФОšK А%mіэ•€QмЁј‘`.€ЩжЙ qю”‚№0і‚lы@  Жь'e ўх ЭЛГЫ‹хX8 ў™§CНчр ŒЃаUh‰qуbэШУ€•шЗЋJаћq‘ќNpІ€(Ћ‘лŽ ƒОиYчоМ@@2Ђ’eСТ­ ™О8А„Т+ћ zotHsj€.Ю‚ž CyЕbЭћ!ЄPксЮ›cMv^ ŒZ„$›Vw–СsЉ™aъЛ~@+;+ŠННЏb1˜Ъ{9%c™щІ_ЫЧFр>RHгЄшП+ЃPcWХ 4Ўњfп^нYК;G:ќйŸА3,CŸАяБЙ8лњЂ8пJЭŒŽъЌ†їяЄ”О‡Џ:ЛкvgkxšЉmZd=H˜уЙ‹RаКЧДжї1Й8ЩУЮqs.yЩTlC5&$k`ВŒдƒС Мїi9ъ§-Ы!†51ЊqУ3єEД}“ЇQ›ыmЄѕЕ;ХшuдRљdIкnу˜ШїvЄг5НюА$єЅгХб4eы$DЭе=n‘І+~ЖёФОЉА$›nGeњ^Ї€”ђ=V@Šgd"Q‹œb“jf_ˆ›SYA‚И}/kВyTfdј(Чa“]›Dнœ (Ма‹Лр+œ›$нO%йЛЈм›GEqzЙћ ”Фя*ќ<” ŒжИLЮ"tœY%С<ŠШuŸшVѓ–ŒзŠ3ІH{'ŒS:кŽfЩAЋRmAЩ,SdЈъЊЄЕ]5кfŽл)асДvWe›ќ9˜x Лo~ U=зРB”ф|ЕВM`(;Ќ `’m>Х}їБЊ'–ћ"Tx+=тkїntЊ/уЄJ€o:t!/9G rR˜nvС {> щH”gkQk!kцa~КЗч)@дju5hђБмvтяfЦж4ЗехTЏЉrмСцJflhU’Щ›вБ3АШ}иГW<иRиёWСБљiєе№™’i–š MŽМЉPœ9aН=8‡ЭˆЎСOeп‘WnЅЪ1g?ШЊщSа+С)‹•fSыbЏ’ЛЬБŠСКЯхrЊЛЧeІІŸПьrЌSъr2нSYбЏuŸёЦХіс­y;c›§о+/ЫЂrзЄfš№ѕ{ОŒChё4ЪIфдЂ5П€ Lѕe'E(тЮŽo‹U—i"р-I&\,Єьа3Љ <­pŽHЃД#ЄX+/H#Ж:ЄzƒСмj­D;FлUKS€ЗБ{‘%_С Ує`2:ЃƒvЖ†dS™лm9д?†€адŒK ‰b@%Я hЪБЌdmNъЬР}6ЭЎŽЫихjѕЧeЌ,ЬЮшь˜ШцъєœйЄ. ПVЈПХтсЃј*хмјd9$ФозЫQрqP* kы2•Ј—ЕeXHnўvZп$•dР­Дђч‰№НэV'соО‚j|Х„ИOir{п+ж%оGNyH.њЅ66‹Ÿ­7SЕŸєš&DѕU™йSђыhмгзЙB­бK†ЌŸŒ:yЂ›й‘ЪfnŒrёаѕ yјђФ&ЫD.‡Њ;9"Naa’Щn“™*iещ“}ДГЙ)ЫA#Фe‘№Q›МЊгБoŽќdмk5]y*O<ЦыѓыXЗэЈ—‚М0x 0ТїЬкvнљ86ˆ‡Ъ N”Žc9ђ’bh(ї;э€ш–ѕ&ЩKLJ< ]bЂU^gAšлВЉA —ЎЯ6\Ы*‹€jZ)дЙЄЁGЦїIЙ,0ЋRЫ‚хzИЄь Ce –wЉЉи-^TяЇ-'кџvQ)~ŠЄ‹а&д6-1_^$Ьvў„:ЁGО†д )ь+|‹p‘юО]v‰Эц—Œ4’>нvA “€ŠЂ[8А\В$LДър—8y­* C0OсVЃиМьЋ*йЭ2!™lе…;Ф0Еърž†VЙ~=!uэЯV9 ё=}›F­ь ›т—˜`VˆXЭ„ЮCЧйAЛ!ЯšцFwє M‹}­ŠF”^@™„ хUсEWвF"E& hЇ‰4 сpc†єТкl–u€В ЌИЩ,qа,†пЗх`fБ‘Н4.Єьщ†djЈюЌ|ъ—‘UpWuйЭ”Э1uЕrбщФьЯРыŠо#Ъ2KœфиљlвŒ]7}РФХетђ^вКUVS`КiРNBЏ"ЩБЋуяЋ˜ŽЬ `Й8с‚e˜znЯЮЎ]’EQЖ•4~. œ’P`БЃѕрZ)œb Ѕ5ХyYт~8иРJо|УЯ-ЅТƒ•ъ =јЦјж01/k]Љ€šХz–їЕœЏ‰/Ђѕс4\œYЌ <2‹8№еЄЩ,ІљS9šр–‚WЅЯ[ќ™ шlsLQmё*г&зƒ9G0ЇФІ ШнUЉеy;1Ѓєƒ,ь г2(ZЛZ Z№ :ГjжЫlлђб`жЅјсW ‡ъ™_NCК}ДщЫоwb ц)5NбятOіИd=enММОЃйИјdPІ™Pj&т”Ї!РъШЇ`m† 9ђ)la›ЁOXЄтдŒ!ШqЩŽўЪКM,@RІUvІЃчШ“Ю2!нјwРДaTWŠчђШ‚†Ÿ$щ‚_[Ijї$3cЌfф ДЃY-=ЛWYЄ)l#3ХЁнєPДst‡+]ьl_ЩH.рт0‡ТЪ!zфЊ(ƒ;_ž$|d№’š[љ€цS†‹4Х„ ZUЦЅ№HЩoТ'sићЁpC Ф'dW)эŽЁ„S8ўJ6|„эЦА;Уц@вю б‰ŸїAR"/0fжО„ф@ю‹ЄэРК!м›–—NятPЬwѕ3ѓXq82ы?Ls/уё™RtЊƒlZм‰DуS#Хё ы$Ўkњќu}љ,rhovЎŒФЈ™)ЫcцEd—пЁj<76˜Ќ‘>БцЩŒЈМї1жбžВR@ЌўЪhƒEЁ!Тq#DВХ-)‡ttЗъ™JВuБч2aЂПntVfS:МЩфоH#=HЏЎpUBУПыхх7‘_!ЧFbS…й:ІВžC™?цyф'Ug…ФœЧСƒЏК aЭЏWCхїОTнаЋЪ№…ŸИЊ‹>/]J№yлБзrgљ2_ЋяЈЧЉsїЫcJщ/4уNtevgЈАф5E–ч˜&$ІыЦЌіЭи:gUіфPDM:бмАиvзQ§n@ВSCДЉŽ{89.q^ˆ}Гкф}qB.0Амї"Šйнbђ" јš2“Т(БuP ZфХ˜N•rЄzz*yшрзб>ђ&—Д[wŠjкYО9EНђv*‚”Ew†kБtN$›C53я?љ2j‹}ЉžмЄ`J§)Ььв`УШe žЕыйьЗd”6(ђ,Ћ3єЁВ5OЎ ЂтW†DЩ SfЁ{QrPИ€t5ПВѓІэі’ќ  ”fзН€*‰G‰I/‡Ху.ѓЯ=юbы%чѓИ…ћЋјрЭыBћяNЇ-пƒЅ5эbГ*ўžђњФЁЦЋХeХЪБx/“ЈЬОmˆЯЧƒ‘n;RŒ­`4 lifiиеIЎт˜&ќЖ ІŒэЎ4 (ƒјmPюovuдx э0Щ[œА lYјhи HЛРFхS™Є…ЙЊьм6'ІM`— п€ц œчєФД lUЖЂM@YљoЃР.6MйLуtЌ"sb!i’~˜BыaXлезdXлЙтЩЕYvG‡Я—CўYл…Ц bйжvjЋиПЕ3§Z™ЩŠЩ*z6 Ќ,в,аЪкрRЫo[†ХъeВ Ќe ~ЯЮJееи,Ѕ}PћS…Яэ”‚-Ї™Ћœв•съ{ЕЛyf :ѓ9ю\YSweЦ9юASЎmйжW/o]>> žбћAVГЙ=t,л3‰й6АZt6@vЪЮJь‘"eX. §Ѓ7ЌўXЭ}ж“hрj!ŸWm;ЦчUDѕnW;.„ @б^74еVнyцл€^Ж ,"…Д ЬсЂ‘В LzЈЫ60•šЖ)ЅKкXййЖ9œ˜}‘-.SЩOв8РЈQX‰ХЦIuрm˜ѓ‡ ”м­ю…Иms9uoш2&%‰Лѓxšцr6a0Пt^Єi@мюm`Žв‡m@UИnл“/>l Вq`)МЦE„оЦnЈё@зѕ4№ЪЩ8РЋlуРRм|theXЭ‘ЁлРъŽ:X‰;ЧLНМQ+l*huшd}ПЊ_Щ8АXю60ЕMvІzOЦЦ]оЦu‡J ДКс&tў}Ц"увэ§лџс3|Kњ+АN{§Яџў~­Мўўѕ‡YPЬЂQР~Sэ‰Њ Пцтѕ7A|Ѓ˜їgDвДђњЫ?НћUжћkябы~1;§сЋmeј‚џУߘфыТ|ўуУ~ С/јv‰ъm?‰ўqмW6МчjƒЏј_ўбfПћёјлџіоажзяЅЏЩћПђš ™…ѕПЪfrНо‹ќПОћ‡?§хћПп§лїЅїЇяK§ю_уŸќўП~ќћ?ўсПўј+[иОйТѕЦъБ‘Б‡ѕ}тПнУцТшкУц2БиУѕ&œБ“ё~{/6QЋ‹iŽС?ёйпюЬЏї§ХюПЖТЬjVщЋўW­pErђŸЏ№п}љгOџќ{ы9ОYЯqpœkЌъ{ф_XЯ СНž„НžѓНйМMx>.Хutzu6/%эєў­№яуЃџЏїљk›ЁvFм§U›qЁѓ7Ч§ЫŸњѓџ§ЇплŽѕЭvєРPmХžЬ7 јf7ъ‚zю†`яЦxŸшрsтпљ–ЉЙXЙК–шF&52ж?–ђбAoИУ/lЮtШ_мž§kлSТ]o@`ўk6Ї.Htпо”љщŸп˜Ј}ї/‰џЯпjjПЗYч[rВтжЬ7;~…П@Oj‡GШН[„Н[ФbЃЌРГнъ  Ѕ*ЛƒNјы ѓ…Чкп#hH№ЋлљŸј›ПДпэњЭ§ЎћўЊ§юp‰њљ~џџї§пдяОќыŸПo$@ЯmяПГэ­<\ М!gд3cМ{’‘ZrЮ)мњЦЊяФ{'ФŒјИї‹рT]НD7ќЫџ"dАQ endstream endobj 123 0 obj << /Author (Andrew) /CreationDate (D:20100901002025) /ModDate (D:20100901002025) /Producer /Creator >> endobj 124 0 obj << /Type /Font /Subtype /TrueType /Name /F1 /BaseFont /ABCDEE+Calibri /Encoding /WinAnsiEncoding /FontDescriptor 125 0 R /FirstChar 47 /LastChar 119 /Widths 126 0 R >> endobj 125 0 obj << /Type /FontDescriptor /FontName /ABCDEE+Calibri /Flags 32 /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 750 /AvgWidth 503 /MaxWidth 1690 /FontWeight 400 /XHeight 250 /StemV 50 /FontBBox [ -476 -250 1214 750] /FontFile2 127 0 R >> endobj 126 0 obj [ 386 507 507 507 507 507 507 507 507 0 0 0 0 0 0 0 0 0 0 544 0 0 0 0 0 0 0 0 0 0 855 0 0 0 0 0 459 0 0 0 0 0 0 0 0 0 0 0 0 0 479 0 423 525 498 0 471 0 230 0 455 230 0 525 527 0 0 349 0 335 525 0 715] endobj 127 0 obj << /Metadata 128 0 R /Filter /FlateDecode /Length 61862 /Length1 114308 >> stream xœь|\TWкў9їNc†˜f†ЄЉ`eЄŠиFС ‚БЗhŒ-1б„hЪІїdг6б$УЈ &йФ$ІзMВ›žh’MйDSMUј?їОsMт~й§~Лпў{сЙЯsоSюЉя}AЦcvм4lby]uенЩ[П)›1gCEiy}гЭЗ–0іђ>ЦŒщЅcЫЄ)вŒНа€ чT•WT2ŸfЪGЂ•”Њ‰ъFэѕж3іŽБэяUеJПzбдХxчgŒ9мъr цw,эfŒП†ђM- š_џаД;‘1щл–S—ЛяОјо+[ܘж8gqћ‚oП‡ЖуF3‘иоМl1Kb^<ifiŸкœЇп]ВБбk;euG[sы{vДЧЇ#p цЛLZЄ/A:­cСђUЏщГŠё,Р7ЏmщТї2іПУи§рy“ц/ji~ыьCx~ш{Ц {4ЏZœёCњ@дGŸ™{aѓ‚6_kэAЦЖ0ЗxбВхНNЖ §ЩTђ/m[мћЗ1WЎV<ЮФ”ЙхZз#ПuчЌшс‡XІз§ŸЎyVс‡3FWЮяYqў:$#˜ФшB=ыa|Џq<ђЗDмЃЖдчвєW,šfЖžiй*&ЃІ…хВ6ЦМpТ ”?—ПП”П’ПцžШSј|ОˆŸЪзђЋј.ОOЃеш4zAЁ1jLšHІУgiхњђФŸ^!-…ж%Б“_сšђ˜“LїЯzї‹Х~іЉ^НЪћш™'щњIcO№T=юПZb €yР§с“ ш?хвdў§2}/UыЌ™3ІO›киЈЏ›T;qТјqckЦTЎЊЌ(/+х/9bјАЁCŠ‹Ъ“щKOѓІК6Ћ%кl2Fє:­F–8ЫЎ№V6ЙƒОІ Цч=:GI{›ahюch КaЊ<ОLанЄs_в’sN(щЇ’ўЃ%ЙХ=œ ЯЩvWxнСчЪНюn>ЕЖzkЙЗб< ъqЊжјд„ 5мŽŽrw7Й+‚•ЇvtV4•ЃН.“БЬ[жfЬЩf]FЄ *˜щ]мХ3GrUH™CЛ$f0+ ЪщЭ­С‰Е хNЇQЕБ2Е­ Ў,ЈWлrЯUњЬЮsweящмвmaГ›В"[Н­Эг‚r3*uЪ›ƒжЌ`?oyАпъr[0л[^ЬђЂБšIGРƒкt‹знyˆЁѓоŸoi[tщ–CL‘ЪNђ…fшzˆёyнрnœrЃВZ0И+qѓ–G†ЫЅ&•-юnрN&Šс)сŠ:Ў$фєВбJ–ЌT-эє4zш:I—œс>iгƒ†>mY`8к'zЮЏvJ+ъчЎh+ягСуе†;nэ—ћ))s~0j”х-Вфtœ\и$4Ѓš”UtИƒlЂЛСлцmєbљ'6(cSцZ]пš:oMэдuЕУЛЄўИхS*Ш<Ш Љ {А2Ы)–UMWЉщЃЩб'dW‹lwЇС[SзЉ4ю 7Шм8AДЮWн|^qЬ@ЭJx7oeГзmqWv6wїn˜нйхїw.ЎhъЊДс­nэєж5 wЊ}дАжЙZyT Ћс5ѕЅ9й№=Ѕ]^~Nm—ŸŸS7ЕaЗ…1ї9ѕ !‰KeMЅ]iШkиэ†sW­’bUŒJТ­$”–&!aPЫ;wћл цjTƒšnщцLЕ„Г–n‰la“`гЭЏк” ‹фшРУнVИ[•хYгибйдЈ.‡ЅФ7rяH”М#ЛИЄ‹ НmЅA“ЗTБ—(іВыЛƒЧqLŽт“:›М№SиP ЬЩi+ЪJ“ююооњЯsЮlЕщРд†`D|П6} ЪU)h‚Й*ИЁЅYщ 4(uѕще-иЖЂAЉF …ˆp (QЉжQЖ#*Е`mА€j§ H74Г”‡6ЬmTЗГ%ШF{‡bйЉM­OyPncgŒЗ@=›8 ЦєЭ E oЌЎ,N$ёАFš$}$zотEVK“Г­a-uиъфKNВДС%j|m*ŒЮp&S†%Ї›ЬЦ`Ф4ˆoE›(GR›ЎolЄЮЋЉЭсxЖ%hB|}І2\ГƒЌjЅ/јоŒЎ*EVšЉэf“МЋрY”NЋ-щ‘4ЇW7УљS},оbQй јSИНdе+#ФМЫщѕнНЗyOѓєЙrВНЪЫAй˜ЬЙ›5vžhNЫЪЩ6œh5ЋцЮNƒљ—+а|ЬGY1К+№ж`,!ЛЛЅГvF8јˆBœ)ФBlbНы„X+Ф!NbЕЇ БJˆ•Bœ*Ф !– БLˆ%B,b‘ …X Ф|!ц qŠs…шЂ]ˆ9BД б*D‹Г…hЂIˆYBЬb†г…˜&ФT!…hbŠ“…Q/D“„ЈbЂ„/Ф8!Ц Q#Ф!Њ…-D••BTQ.D™ЅBŒТ/D‰#…!Фp!† 1Tˆ!B Q$Ф`! 1PˆB! „Ш"Oˆ\!‘#DЖYBєЂŸ™Bdс"]ˆ4!МBЄ сТ-„Kˆ!’…HТ)DЂ B8„ˆ"NЛ6!b…ˆТ*„Eˆh!Ђ„0 )„IЃB„а ЁB+„FYI. о+DG„8,ФOBќ(ФB|/ФwB|+Ф!!Отk!ОтK!Отs! q@ˆЯ„јTˆП ё‰ ё‘ ёW!>т}!оbПћ„xWˆw„x[ˆЗ„xSˆ7„x]ˆз„xUˆПёg!^тe!^тOBМ(Ф BQ5–K4€ъхeeѕ'ъG”I”AMћˆвЉЭ4"/Q*5э!rS=Q Q2Q‘“(1”8”@ф%NХХ‘бNd#c,Q ‘•ђ,DбdŒ"2ERž‰ШHAy"=‘.”0Є %д‚4D2%Jq"Ія%ъQ‹№#”:Lєб”їЅО'њŽш[ЂC!G=ш›Ѓє5ЅО"њ’ш ЪћœR‰}FyŸ§ŒŸ}Lєб‡TфЏ”њ€RяSъ=Ђ§Dћ(я]ЂwШј6б[DoНAE^ЇдkDЏ†тЇ€ўŠŸ њ3б+d|™ш%Ђ?НHE^ zžŒЯ=Kє бгTф)Ђ'ЩјбуDэ%z”J>BЉ‡‰і=Dy§‘ŒнOtбnЂn*y/Ѕю!кEД“hG(Ў ХMu‰ю&К‹шNЂэDлˆюХС_ѓлЉ•?нFyЗнBt3бMDП'К‘шЂыЉБыЈ•k‰ЎЁМЋ‰Ў"К’ш Њp9Ѕ.#К”шЪ˘ZљбE”w!бDчm%кB%ЯЃT'бЙDчm&кВ7ƒЮйgƒЮ"кВЯItFШmйсŒљњ}0hбZЊО†ъNД:doFеW­$:•hбrЂeдєRЊО„hqШоZD-Є’ ˆцЭ#:…h.еы jЇžЭЁъmD­TВ…h6Q3Qб,Ђ™4шдГщDгhаSЉщFzPбъюdzP€ZЉ'Њ#šDTВљAC6х B6e{й6‚Ц…l9 БTЄ†hLШ†И€WSj4Q+CЖu Šm3ЈЂєU™Ѕ4"/Е™JmzЈ17Ет"JЁzЩDIDNЂDЂ„eШВЬХ‡,Г@qDv"Q,Q UАR Ѓ‰ЂˆЬD‘TвD%dŒ 2щ‰tTRK%5d”‰$"NФќНбГ] zЂ[\GЂ[]‡Ё~~€э{иООпРў5№ђОDњ рsр pіЯ€O‘ї7Є?>>>Œjw§5ЊУѕ№>№АЖ}рww€З‘~ ќ&№№:№šyžыUsОы/р?›чЛ^1ћ\//AџЩœхzxxљЯСіЌyышЇЁŸ‚~в|Šы ѓ\зуцзcцvз^д}э=< ј{їрў№ №ЧШ%Ў"—Кю\цК/rЙk7а м ћ=Р.фэDоиB@ю6цКЫДкuЇikЛi­k›iырvрРmР­Р-ІзЭр›€пЃЮрLѓ\зC_}-p єеhы*Дu%кКЖЫЫ€KK€‹пЁоEhяBуxзЦ ЎѓэЎ­Ц[\[ŒЗЙЮ–г]gЩХЎМиuf`CрŒmыkыЖ­ ˜жrгZчкšЕЇЏнЖіЭЕўq:уšРъРщлVN Ќ ЌкЖ2pъЖЭ лŠх+фoV№m+xљ žЗ‚Kl…e…{…Й<А4Аlлв[:qщ†ЅСЅšaСЅћ–Jl)7vїюйБд™R іЏYjЖT. , ,оЖ(АpЮ‚Р)шжмті@ЧЖіРœтж@лЖж@Kёь@sqS`VёŒРЬm3г‹ЇІm›h,nLAљЩХѕРЖњ@]qm`вЖкР„тёёА+Ў ŒнVS<:PНmt ЊИ2P!Г$K’;IЖ(Ÿ„ž0'/Эsњћœ_85ЬtюqЪ1б‰ЎDЉ_t/›Р%ЌOИ AŽvМрќŽ~й•бё/ФПџyМ&жпo@%‹ГФЙуdЛ2ЖИqѕ•*—”чRЧ:.ЮыЋŒЖѓhЛЫ.UИьœYїYПАЪі‡,/XЄшhн-љЃQ<:Ъ%)Зо(й•_Tmv™%хжk–уќfX”3"'жWF›\&)Pbš`’ќІ’ВJП)'Џ’ЩмЭЙђыр]ррmр-рMр рuр5рUр/РŸW€——€?//ЯЯЯЯOOOO{GG€‡=РCРƒР€ћћ€н@7p/pА и ьB@юююЖл€;€л?ЗЗЗ77ПnnЎЎЎЎЎЎЎЎ.....~\\\œlЖчРЙР9Рf`p6kЕуќsœŽѓЯqў9Ю?Чљч8џчŸуќsœŽѓЯqў9Ю?Чљч8џчŸуќsœО€р№>€УpјРс8|‡р№>€УpјРс8|‡р№>€УpјРс8|‡р№>€УpјРс8|Чљч8џчŸуьsœ}ŽГЯqі9Ю>Чйч8ћgŸуьsœ§ЗўПџнјПГ”_1WўЏ‡ž‹ћхщ‰ьЖŒmРз&Ж•]ЬboВйl#д•ьv+ЛйУь)іъ?№‹мПzѕœІ]Р"х{™ŽХ2жћcяž[nmTЫХHХjмЧ,Н–оƒ'иі\мkщщжХ0ЃZз,НызќHяxС"н;XIK›ЁЃе_ъЏыЙЛчЖц –Meгиt6ƒ5БfŒП•uАɘ™yl>[РЊЉ…ШkЧ}RГдП…hUѕБR‹иbѕЏ(–ГьT|-†^N)yKдДђ7+й*v[ЭNgkик№}ЅjYƒœеjzАŽ­ЧЪœСЮT•`ВldgБГБj›й9ьм“ІЮ=Њ:йyl жљ|vСЏъ­ЧЅ.ФзEьwи—АKйeь ь‹Ћй5'X/WэWБыиѕи3JоЅА\Џ*%їі8лХюbwГ{дЙlСЌбŒˆy™ЃЮсbЬСŒpcŸгќ­<:[ы0velс‘Ў‚§Ь>5N ЯЃRr#JR+ДJ+kO˜‰ 1вЧFDЉKеёГі•“YХ|\гgfЎVSŠ:бњkњ2v-NрИ+ГЊЈпC“К^е}эз-{ƒšО‰нЬnСZмІ*СdЙњ6іœэ;и6Ж_Чt_E|ЛS]Й ыb!ЖƒэФJоУюeнЊ§dyПdпЖ‡ŽZvГћи§и!В=№4рKXўлCaы^еFщGиЃH+Ѕ(ѕ8{ъiі {–НРCъyѕў$R/В—иЫьUn†њћї#€ђi›ѕ,“_‚з™ž aуиx6эfЦћ=Ž хЛvйЫЫ 9њёю–˜o>ž—љЃ5’љоФФяНƒt[eku7ЯйYЂпŠИЖфШ;GžЯ=ђЮ˜!ЙxюлћпйoљђyымТ§ЏьЯЯуVU…-Jвыm:oъiP†opaaСHiа@Ÿ75JRm” R$й&,#%%Эх—O•'бIыМ%“ Е)‰б6ГN+%9br†Ї[ъІЅЌ—ѕ:Ykаg•ІжЬЏH}CoMЖЧ%Ч 1ЩqіdЋўШ›кЈПвF§TІ™џг%Вnиє’4љ ЃAвшtн)Ž„ўУ<е“Ѓc-SЌХgаЧX#3ЫЇйdORкHВлЉ­#у0oлгpЬ` ЫbХьIЂЫaсу\–hхfЦЭ‰›л„[З4РŸ™hї#пюGОнnЪV g+…Г•ТйJсlЅpі}ј Уzїь‚fОТюоw $ј‹бa6ЋќэŽH•?оaRXВјЭ7˜і˜$SbЦ7љљњ4ѕЇЌЕЛЙЉK_ЯJ”Јk3„чЮиЏО ^Щ"sVжвX*[”ЦыIѕ В\шСЬл•5K‘љР’зkU,і˜дpWё„–%е=wХїыЯ}Ы/i)ˆЫеаєŠЬž#‰ХSЧ„і–Mœ0>Нj^эѓ?k(ѓёe#к'ьowehЮЬpeзЏ7 ОЊ8Ц8hвB‰чŽ”д3У;lТ‘З‡6 wѕ'Mbœmя§Q—…ЙЮЖћ-M#”ЬyyёЙЙЦGbxŠУS”žЂФ№%†Ї(Б[ВњSвђ##Ъм•Й7*so4Ђ”б"Цћ№sяOP&?mp­ЩoЮuфаЙ2k]˜€6РJpХФБ–№\1ƒжBЫQe2"ЗАаZ˜Ÿ7#]lbЋ—GЩŠЪр^ыQу@eџЇHёМcг+вЎЫ2и\ ёžXƒдS(›ьЩ6{ŠЭ$ѕTqƒЭрpЧъГюМ4G_Љх›L‰._Т‚hgldЂ!RЏеъ# šіŸ.бѕВFoдa“_yд~kџДШФLчс)ђ­)§LБЩvЬlUяЙEыaеьЃнlTяЧ;Ѓ-|ьЈ№Њl sЄЪъTŽъ–В§YўX[рЗђqii‘N‡RзЉLЉгbQnЈтTцеy>Иc^w81­ЪТl#О'кŠO‘ючЌˆЙЯoВК‹x‘пЩЧZ•Ÿ*Ud-ВЦ яц‘ЛF9Е§ътКyП.эdekЧ rР:dH.6ђ ЫЫeip‰§­fєйрЪќk„g!4@NыьсѕQ|’н–Ђ“[ЪVо8cдЂ)УтMCЄ!Њpт’1Х3Ъв &Э]и1Љpим‹ъГІŒЋгHВЮЄ7х–Я:xтРФ‚КSžRWШчM;‡ТъHwСщS3Н)E ‹ЦЫ/YПdBэњЩ9б ЎX“е“‘фMNЮ+M<~xAсˆК%Ъџ0жћЃќЦЧвX&ЋйхˆЯˆє™Л%юˆїЙa3љŒнв0П…љв“ћg|“мгЁэPЖЊrф­1CxBЎу•§˜Ё˜!‰–ЗIфчЅЧХщTWœ‘сб+ћгч\ФUџЋ‰з{eќ†^Жј<žt›AžвуŸЄ1ЦІ%%{Ѓ$ŸЋ‰tdЄ$x1&ƒМVК›ЗKŒвШКШˆŸFDdmT’]~ЬЅ—9\rЄaCQљым•џ1,yЭ]ОТћ%™™˜KŠлЁИХniFі|Xњ‡–жТCњіОоы•§ћ-ћ ~нUЩПшЊф›’ +-ЃzЕЅЅйxцЌu“Гcг{ГЦ I§мžS1ќі]CFeк‡9‹ъЪ|gPya2/8ЙЂ е’ь‘oі$Ї–ЗŒЪ(šeш_жРЏђЭŒыyШ™3МЇ&Ћt€ЃчцИЌ‘8O zП7jђи 6,ф`нвHП12юЇмф’d)9Е›Ч`kЯ‘ОwччхKљйн|P—~.оžЏЬ8 оxюўWіbe”‘{ћiNи“ъžUп’ ‰ЋgЭ­ЏЌкАc~ю”1У#pєѕ&_Щ хВкьмЩ+ЋGL‘iжДђЩžDORlеЙOyЦГчБ$yНž˜DЋС•–Rд~йŒй—ЕІxStж$х/„•Е:ŒЕŠa.–њ‹•† tH”lўˆЧQ­ЮДД2JЇї‡–ЗЯrшћLўсъЮ'ЗўЄЮМЕѓсхСЬРцљ]8gScЖфкђьІQ4Щg=Дnв–іЁ‡цЗ]ЎќВв‡(є!›хw%b:m~[„;жЫ"Пѓљt п›[3Озл!<ї9хИЋћCuП'юЏЧz‚Dћz“юШGJчЄНIЏAZпгФлѕилВњJ~NЖІSЅЇŽъ-ޘ˜„hCЯГzKbЌ5СЂяЙEoI@чї”j ˜Ÿ•ьHI‰v(П3Ф2ЃЛЅbПqїP‚_yFхM‡ЮБaCtхЭ ї^щ7эœамЃžЊЯЊ.Внž‚8ЛеІгг‹Eьљ VЁ‰ЮЛ`ьфЮцE-чжhЮјLŒŠЯŠs[Ќž‰ѕ“ћ­jKѕ„ Ÿ:Нli Шf”ЗФ:-†фєфсЇ\к8ћВіAqvž‚)ƒд'ЛzZlЩњ˜ФXги-Џ^џќ…ь.WЌKYŸоy |“ХюЦžБэ4ZкTзƒq„W€оuДaэМF}‘yl†›л‘рЖтEпфЏuЄtННЬŠvЇkЯ–|ˆ˜гI>+ЃЇЩ[ёДbцпЭМRгЮœœИтТЅ,•™$‚WЃдт7ГИЬЖT“5ЉЭzд Q^зˆI іч*ўуXз2ИѕgД’$Т9<ЪVCЌ7!)-оЌэY'`Аyд№EКш8З#156ў?Ђч6ОRgаЩ}Є^#уЭ+Y|nјй{ёЇa•ЋЮe5ѕ,ы‰0D™с]/НŽq:”?uŠХЌ2НЙ ›%ЊKЃnuьruК№і§VЖГєК%КЧeK;ж=хэ_‘цСЦ}V<§№zЋ3<Ѓк6œЏbVЕ3лž“сшцНўˆTsЎ1''u QIYYъ жœ8“œьkMюА„ЇT ‚д9-ˆAРƒ Ц‘У{Ѕяš{yјѕrВ 'ЮЎmгЧКум1zЉч<7Сv„мsЅЄq'$Иbє>Ч|WЖO? /ˆL№єKš“vlзЌ<|VdЄЌ‹аЩkŸ{дњDЊ[‰vŽ ”žLщŸhrЇ†wЯ˜еal@—'FљеЎ$M^7&ip›ЉМЛ5ОCnяЛa ТŽDЇ8Ж юѓexmЪDџl8Бqqё…фck!‘šИЬхГє|œ9!ƒs‰ы­IqŽde8kЌN›еа“ш'q\ʘЄxGВUWšъvy$SЭUcSЧдŒI=ђ`пСЂ–žДк'e“3љ!МQ5J4Ђјщ9Н5х№8Б,ƒeќ?ЮОО­ъЬїюWWї^нMћО/–%йZlЫ›ф}Зу8‹уФйˆ Il“@ „ЅЄДЖ@™2Ci;”ђ^ьNЁПп ЅoкєЕ}”™v€_™щ+-ŒлвYZh"ПsЎЎlgЃtЂXч^I–ЯљЖџџћЮwЅW#ж\Ц юѕˆ Ž лsЈpŒмqEА^–_ЉБzКmŸzщР3З7Зпљв›O,їѕп:>~л@Р;Цƒ>Ь}јџ<8мљ™Иїаљ†;я§Ю_?МЋЙ8§№шњGw7ЕЯU1Шќ `_[Юї4ЌуR6š†›$аg\њeS“%џ_PўeыЊ §;iˆїљ7–;l$‰.5ЈeиoБ˜ЭЫ№Bg 9>“_#kкВзWМ‘}ѓЇззИrƒЕŽDШ'ЎггџfЊ(§BыpкІаР pЦРўОЊ3e/,ът{>WИћњ6Ш DжWSŒўкnУо4ЧmЅчlЉ"єЉО…п`€>ГH;&Ÿ gУYƒ vЬ"`p|‘ЩЗ~шъ улƒIЇНJ‚)РѓxUI*‹Ојњ|™ю\XвѕIy+vЁiћЦ2›s"MbР26бНЅ91Xя‰wOLNєTe7ь­ZйQkPŸgh&жВ2)V[Ћ{&6NєTЃ‘ў}#еВУ)ВЂI4КŒŒ+р2ЧšТБ–TЈ*гЕЅ­ИЃ?&šmрЎЂh„нe7…2Ўxk2MwnВp§З§{Я1„ъ>aDВŽmzЈъљ4š:їСЋp} š-ЉеЗ„sЂ[CщFійьЃЎєN˜Б_AНрџђ]8МЈЁC: `ГCЂaˆC‘'U<О| ёb № 3f<ЅO‰SŽ%Ч(\юKQUs‰eО§›–=ЛuггРšЌv­К6хѓ;}:Хkuy§ы}эhШL§6S‰ЙŸи2ещ4r›Ў<цWr[ЬЏYSdRziЎЉсвsшяŠњfЮbхCчŸУЬEЩЪеOUMеX|9УaИPцїrо–‚Ьо*–ep В–zтМ’„Ђ_W[Ѕ u•#аФ/ оuћуVџ9ў:`њQ7nчˆв?бЈіК} џіoИNіЙœ~™Цџˆў+ЎSќ.—Я€QnжЕ#rиGIN€Чеьр!ъ/<‹Б<|”g.ќђ1apX`ДиВбўjДxЁшк=эЉvœe,Yф’Y˜ZfaB™aЊ™CџP4 ‘ˆ€ ѓyЄQЫTaІЪk#[едЖqг’хU$+fБІogQ$‹fГЩЖЊ9дQ~шG§~Тѕ^ВПхMnˆ@RЏœ„YTjrvЃJбa"y.Оq2Ÿ*Ї§i х л‡pчreиS­7“гЋіЁ]vR3dtxAt:ьCгƒЃ={G­ћžйqа\;œoйвWЫщ8РцэkЖgЗмЗ*ќЕЯwnkїЌ[б6нbх8ŠтИ‰BwЈ{{лрLЈ;Л"чЊm‚ЭeИ”ъе‡VГ$ БюБіN`i@К^ќƒмфШ1Їš‹jў§s()J–="Z=%ЂеSРј(вˆ&J0ОqЖШЇ ЈСіЎЇЈч{=С9;ЉєуязТц†я… uŒ‚1->Џо-–ŸЮAЙЉQZ†C ŠQх F]’чx1’Ж5ŒЇЖ<:•k›}|]|Д3ge(Lц…HѓъЦ§Ÿђ'›ѓk q?О"й$оrЩХлOмќщW4‰vПе XхˆЧѕynэнуё`< S\HY.д)ђVd?rп‰5УХu№ъIOИhоїїX™B8єC@,ЗcЛNߘСmXџ"6 ‚H-XОgxŠ%oьГЯoь)ФFbXMSБ ‹5Хšъ’ПђѕжхŸъ’ЩAд ™r•brВ\ГPCN™їCjњsёэзA–.чЏЮNУa-ДW’щQš-РЫBХ—Z №YруЇhЃЯсX TщЪОZж68ќ)UЌ|(?šПљ.UЌЋ UЊXЁšжЊJ(юњТАЉZБkЗџѕŽXWŸGWгВЭoЕљMzƒPњ:ЭщэІр4Я П/ё:Rpїc ѓдѕЦVЇ ’]ŠxмAOY%U%&upЖSUо=/пšЇigGuћMЋjIš5№оBoбѓ Žг,УRє­RH2•ЕHОBN#‡;O"ћwŒрPНѕ#ЌйLKfміУаpЭћ +GVb5лŠлА•лVnлДінўƒН›€ТŠЬMCыМЁЅз9‡ЇCѓКn•:ѕЅ—+QMеTѕСњ_ZќH0ЮI@{шЂш1“I“;Є,цeЊ"4Žь_'>Б~БzГ1Йў№ии+уП„qBYпm :M:ЄДСI;zЎ+Кї 2С№є~[Ђ=mOкм5 ‰ЩjЭ_ц7ЫН (xФЧO::уэг+“Щ5w­оHKv%ш-Йg71z†4XeЗŸчY:4Аw+њ‘7(нпМЖосLwW5ŒІ ВmЙzЫg\ю›@Н Œќ›Alz‚м„‘Иiфю"mє€tLfžюИЃГ0^o3eзДљZŠн›Žƒ\€гэZ3tїБ­ћ^МЇЇЋcinyњbзикц­‹‡ЇZфЊŽZ(­I ­ЧNЦ‘,ђ\Б*UWЈ›ЎУ/†т"P_5ЌОVCi•7TФёјУSёЏХБ8в)№Ъx–а€атМzЮЊc2 (?ŸЏњЕ;‰ьлњC%gъЭpПѕНЭ†f`оsiФUEЫй›*0™~+^јъ.ЈJѓЎiер=Лћё­еЂЏж[›J‡<Сь†Лc=T”ЄRijВІ'e™Z_л›ВŒm§Е7feюЙe`Њея x‚kSУЗŽUЛЬrвHbzЬзВЎЉufumЈИ.ыkmШиlƒе-›УЁЩіЁЋŒЮWњ`Уѕо†ОшКэžњо‹ ˜Ю–ˆEMmЎšV5’Э>|ЃYєOЛWРЯI@ Єк1u!+њв­+мD  ^_шУЉР ѕ}В,№r42`Уч ЧK/!ђЅщWю’тfЩ];*дяzjWэucuFŽC1‰ОХ-эоXOOЄ(b=]=1 ˆD_*BЛп\ЭЪ&^œМBБ)і–ЉСЉX>( н§ќжНпКЛG 5Хv3х‰)§A …ЎУлšхђщ…аQ2…˜ђЙ3…РH`:€›5Оlж6ЭдsEUЃ6k`жbЊљElq"Іђ>‘Iћ-“і,Ї†гњЧгzмѓ„кœД‰}jР}c>ЎХ-жЦ/й-ЋHQ8X'кЊ“Ы;`Д ‡ВNЉnjŒУ[…YрїахВж4VХђрђЛЧAzœБђh‘+дЁБZДЖ(ЃC€ІўPf­k!ЕхдQ Е/шG8m5œЖ-ЦiЫхДхr`•EЛ9‘@рB‘"x 1ћY2кчьЎpП2нЄигj`ќyeн“ŸЌYfnјAgйs sЛL"ш*ЦР2А=<{UF6TЪG~|52U–к dfBŠg –ЫДGДх#кђmљHEлќ Ни­ЎXгяUѕzЅ.mWN­ЂЙ/_N#YLw…,ZЅh{“Šf™Š6;E›ЂЭNЪqИYШ Xˆ„,ŒС,d,DG<ІЌ3ЗщŸ>б_e ій4ХСш‹‚8[ЖSm›2$_Ж2•­бWъЯTNДMј—С’еЅZ“}5­;+€е?ГKЄšИ}аЗ(Lки_}ёў%ыуРЕїЏiй~d3Œv0Ї{Hжўž): 14*Ѓ1 ѓh˜CУ:4LЃU8УPЗF“мšРмšбЛ5мwksУ0щNщQНю“ЁИŒYe№*#”™ё[˜ючžЁ &М2Kш€ќя9Є•'5‘U>hщкП?W|ФпnмћЭ›ІџnO]~яџм Цњч­;G@Рє9 ;GzwvzбџЗчьНэ‡NоЦ~0ь;М5ŸнtxЈџ№–|vусВѕ`_WЋ зœЩЁaA3 A[ЉP1\AГкŠŒшХИƒЫFьњ94Tdт§aСфэ3AЋ€хсyеЫ‹ЬЋФfЉўv5CP§˜ТОŽQŒNgqMЖš\cрr3Е5ц]М/штХЗšнУ0:crАўт WТнuзщѕŒA­цћ~‹э&О‰4"NЦ)аtа˜а$аl!ЁI"ЮYјФ| зХЯ[zk;>F—Uy.5ЃqтѓчвЫЖ'—Ї/—я`ЛuЂ7–Дto+К 2ЉуuwT\џ]˜ЛШТЛѕ= w1ъH†$жЛќЂЁ@Z1ŒЪiХ4xСpр œƒш'ЕYX€ыЦKІА0њ lєФBќ^/Uј›@mHЫёT›уSмэŽ 0#ф№\М­WŒЯ7хz0 1хdр9Ц€ ‹–mCНƒ­НЕНёИЗЁІkAѓЁ^*СTVBE…ВџA{T9ПЊh”Ÿд }Ы7џМ!ЃSЫ-Uђ\УR—ЄuИ,риfёщRj™–tŠ'—ђЧxїr\л–Нў#Аv€ПXТCEрlт|B|D+–jюет%њсщrlїh1бЃХD0ўQExpBmлгрA}Ѕња+Ѓ$њ",iы ЮЁфRЁМaЈ‘йJ_иU —э+де/•ž e—Щт’ЈЁGU2@ЫЖЄzkZoяЂ€2ГШіЏnОўШVЬ_Сƒ‹џ1ВЉ#4ОЛЙђДЮмТGф=@>]Шлg‘ЖHh€‰nЌ­‡c(‰†}h苆=hи†]hФ‰F 4†ЃMhS#к”@›сgu›а!QK рXдŠ^№Ђ = Ч"С>,ДѕЉЏƒE‰‚8"N‹Ÿ Б(›{ХL_ЈЏёjД>W “fQ1ї^_НПыZеhќ“ЩЩx|ђ\Ёp>>†„ЂЬ&•I,r №t…$ЙВлЁ—mw,fhŠЅ~qЧcёМ‡ KРyKдэЉВqјЫі<ЮлcnOœ•>– ЂИгТѓO1ь5Œ‘"<ВћG }cŸнъ’hќIк(\јм§ t=іy†ЙИЗr†ЏŒ4Увфтэ ƒ§’сiі\ДVЮ0rКNьUЌH:РёуДЉ~\ й9t]б%„ŽzНгƒо$Z“,&БdRя8­XПпЋUГ` f^Rћa–RXДœN]c{bЉdЙ|wмйgM6VдyЂЛ:VёžL8дœpыxйаД­Ѕs2oПweД),ЇЋЋ Aь_9ŽхkB1suЁ*й•0UN^6IЇbt[]uCЉ;9Гз‰#а6сZ­Є ЉAЂЧ­Hh§lQа›sљП(ЬтWGŸ їСТм<Ј4GЉm_‹г]ЖяI•чЌnЬŠДЂщоЯЦnh5ЦЃa Kс8ЅЇi}ДрышЗ…Yš“хe^oѕ=њљ‘НAŠ•$НA6АFYOј,›Зl^я 0’шЅЬѕ%!A$‡Є3Жм‹ш8џ єHQ”<Лm }С<›ўЗLљђОтЂј?i%Hў€Э'™*ЕЅЙ}}оюmлTЈ]ЅЛбhЉћЂ=б`ж#pюt8и—Ф~СёАЊа–ЊMьhюо;‡б$ r?`~di,™єf;Сюœ/žƒ6жжВиXI"эЧ’ќ(9‡$9ТsшкЂq( LђA/,ѕYcyg™Ѓж}•.ЋйХ6я2Cв6oЋzfг%*ZЊщa{ьJщA9ж^.Є}zНЮрзж{єпий pт3DWg T0Бл"-UfVрЛгfрђЁЃнГУUбюuRї€%šuУ:^њl иO32ˆЌGŽМ‚ŒЂH‘б•HщBЧЮдЦС-фh=B#C/ЂkВ ]SŒ†ˆGђгббGŠІ&Ьдћ Єё:Д8Ю[|АnжЛ]ћ`б‹zсf–Žэѕо‚т“ѓГe (žcr>Џ5TМў&мЗ)oфМѓж;ŸЄWwE§ ќаWжп(J;УІxf@6јZзф< Вž{NfОщоэmюъˆгА›mўжЕgЪtše_nЌwФ|cжw№Щ\ъ3ы@gМ1 џl3+qkВ7mч9НE”­…™Т ўhGжeчМб67ŸВš,ц|<е›qPЄѕЩšzЩ1жdEWАДг (›#bxЋXгь{(FўI­)^AЬшЯрcQыj?igHшoWКO”+вЃњeЅžџ$Л 9%к&Л@ђўšЄЯŸЌёaП6N@CЧЌ”ŽТ0pwІЪэŽUyр„ ЛАяa[(Щ"Mm,R‹оћТР4ЬH=тЉƒнaА63ум-эUgЅеf€еўАЅ€~•zL§R=†VЬfl -;ЭfЇФ?&ХВoRх‘8'ч/mцМRfхІkєGДH+˜$8ГЙЂI[ `БV…ŠСgІADўБd5а$EВжЈЋєЬЅBыёD-:BG,`–ьUєyђ)РŒЋO OЮRTж3yЬЦ>ІLЧЇЫ’;Џ6žћреŸ,CXIsЩKВ{ѓRюІ*}žв›н>aѓЊa–eЙ!JCЈћС{ПЗЪІŠФpбleuБa#ЖКœж;H рюЋгe-§І6-ЌЌJіUьiИ”8ЦЪы‚v)<6c™ёОАА‹›шWзe<л| ЭЦйВ…'kІ2MЃЕfJt6‘ЊЯћzc“]ФгДj‚ш єиdXњnO_*юЊœC[ЈЦОџ/0уdѕЏЏжœJsш}Eжg”›Œ:КЅХX€ЬMЂu3Љ#юˆЮ8іђ{‘™ЅFЪХЕiЇвСSюгGСЌAИСЏdЖ€2\“ит‡€hœјЎес31и›Т#<3ъёЏ8HqЇDcЗaи-(-кL&›ТяФА›Pф  Б‚ЁdIмOаЁSWњвтйя "ЋК…‚йФqшSeБшЈв$ЋСošТЯЈ;,Т!Fи%<{’bpЎ)М}MНГHLЫu~tДRз/=OœзЪјЅc№}/:@~zщ}іЋяГэя3PoЈŠчтЅSdЈ>ЋoяsСP§ТЁo’AD!№œcHьšxыЫ"^мƒИьBД—ix!˜SІ%Tg 8“ЮРиЂO №xkЬу‰кєцJџ's$ХIмŸђОИƒeqŸ/acY[Ќh~a}žиЄЮФћbЦЖ!^Ф„хOГb˜зLJю§ОГр§Ќ^‰РбпЌтя-сфГz^‡SМФ‘#№ˆВлД0OфˆЬRзkЗкѕк­vНš sЈљЙщ/ъzЭ5пўтЁУgnЉ‡у]sЗдо:6Дw$м?6Дo$Š)Л_ћтФЪ‡_ЛyzэSk›)6пјакЕЮ‚ёa alШsЬТЮaіˆФБshћ чz`x…ТХѓjwёђnišЂЪTА>ЄQ Œв›МГзФ~ЄX $l.GЋNВЪА-кЦ@/ЄY=Ою–рнVЩ&qд+‰ЁPЙ`[чjEкЯлкq:7$ПƒѕzѓŽ94_d$3N%7ˆљ9Дё5 Ф•†! f@jке‹Sh[Ч`Š—5ЖQ‹ ѓДкБy„д ЬХ~ЅA„ ФFž1ЧEпњЄ№Ы)qRП™˜TћйвРRђЊ‘РњdЅQ~1ХЩ-šKeS‚9€њˆД"іЮZ} }qŽ•y K§#iє%<ZЗсћ‚ЙtVJ ?щё‡о 9IдyX€Хшq:EМЁ@'0>РCJа|'сіоrЉGџёT4MsјЩчC‘dќlЧъ ѓ’вЕdvЉг:tѕ+ы$K-чАcЙLwё]w|ѓњќібœQOТЋCэS§…Gў[зxR‘ тДz\˜›1АЄQ)5ћzƒг_й‘9uуWЇ“её‰6‘Б:-оЮ}…ЩV7Nі&zН:ХЉЃЅЃ^Зх> ЉC ѓјЯH/рtнHуБX ќІЮnч2sXз„K.44AАиуЪКі9дT‰€K‹Ќdь‹‹$.ПФŒжтБЖfКВ-їГмžЏЯЎ<8YKJjфЖЇїDлR’Ѕ8FЮg6оЛ&Žлл‡Чkv>Д>ђ‚ЕaЂ=4иSАћŠ›Šm›[нш—WџЭ­}бў]Ÿ§кЦБgџіўы›ƒ,ЙьВ]дDУаЯlмV!?uџц–Mэот‘я|ngЂvХ”ZХду‡€v=Hь,"b7œ (‹4‡ѕŸ@,Є4‡6ŸАOА›Е†rЕ0ЁХћrEPНДБleхс‡pА–ZЪ` 8|aЅа_]<Ъ i”БпL,…П!ЛьvУŸЮCЗЄ OєыЇ QВVƒ€^[Ž?]*ўtЉјc)ух/ФќЕк]пЈТW4`/сд$аљХœС$аИ^рPkџD­ИхК–ыв<Щ2Єо\˜и[XїщuеЖЮ}ѓXФчЫ1ЊАeEwphТѕщ$Їbї™ƒ[t`W{§дЮ%|КргC`mуŸjБў"?<.†‡‡УEмЂдN€OMR“dЎSёЉoЌzСы%ћ6˜џb|ЊћoТгC­ћžНБmvМQаQИgrcгэл:§ёБл†nы†Њ1Г*8eGs[гzxСNв†ЦU{;&ю[РiЂЉczEтžёЎЏ7Йн‚0К Уіј[Wgъж-A“ПИЎ>ж[чёhfЩ"s†`аБMtvєFјёРяџECІ†22Y4dBџ “оЗ>тH_;I@h ѓп&ќ_ŒђC _R[5/~ŸŒ Ї'Œо„ЧWуЭЅ/ЃЅfєеЫ€Щm1КэVС’ПюТ‘20нOdzTEІЎ%d‚œЄїр$ŠЕюEД ЉFQф $е—QБLЦЎ@Ј+ЉˆŸК&@=к}чБ]ЭЛVхD˜ыXZ_еГЃЗcf4=ИІe<ЌT Є`FЙф єеL?=?~УSгВЭЪѓ’]’’ЮцЖyкoшoнT№p—‰хЖ|r‰Ad| TщE?‹є/|ЛhАЁЭ§hќцКН€vаl аТжQ4rN'w ‡юЬЁ9Д1‡Цs(№јŽг3ъТƒKBЙнш xЄ†CЙЙ…ŠzpТ5.ддс2мu^wёЩзуёЩЩwд"љд#`“ёЫњ$јrvзгГЃ7Д„D99Вџщ=ЁСbЕа3”f6\7”™Мwu ЗЗ ­ЉнёРК№s–:§]  Х­.єЋЋŸМэRd–ƒ ‚’a№Юoh xdsуІі СЛžл‘Ј‚–t№†ч%Й–PаP№њˆ‰”! Z? †A№y“Є` к§a Ѓаї.>Ќ( ŒУ*=_єќцrЌWА^E@CљКCУ_xн!ўfPфн_н•kœyvŽЯE{Ж6vNuј#=[›рˆYяњСƒmї|яsw§рЏ‹ї|џ‘}Г9кИѓб `Œ5э|ЪЩЖ№њ&YЬР”>5k;с,_Ÿ|ё;P@зШР*E^єM= ЉIї бФЪЎз}Ш*‡lѕHДU-ƒ@oп|—у]Щ"qФ—hІ\Ги№,NЄ‘fЄёlЫRvИ’eOgЬTr;LПrЧд йгкЧY|LњUџёщ—ќQЏЛxŸСФSЄ^цм9ž1ZЩЬЊBœЁ`Ї?Ё“ъ†ЗфжмБ2foлЗўыш›Вд-йe†СифЖYјuNO њќMеV‡п›кyЃФ‹n—Љz`[>Лmя‘ЕџŸН/ЃИѓэъcІЇчъ94]Ѓж=’ЌбXжeYВЧЖlф  K#yА.K#[„cˆ“Хa! Ю'‰I6d!сHР‰ lVŽ‰“G ›ƒ9pvr<&,|hоЗЊ{Є‘mŒ“MіН?ЖKњMuѕЏЊОѕћUзЏъ7]=Ÿ+C7Ђ”0ЛжNэZуv-ёЅ л{0jџIZЗя=Н_\‑џВE+iъ=mИ~йl'nR›еZБhsKгЦцfйK‡шфDTьroэ†…žŠEеsЎYReІ{З!ЕвЙrчUхК•UЭ‹ŠIEлŽ5UjfЖгцЩёjYГЋ+–„ВLŽ,Џ;Ы!e‡—”k хўьТlЩ‘хqfЈvg з[ДxЫќšѕ‹ЋAЊXД‘о9ЅЩГТэb1†ќ0V[с'§И2IтЊ‡"N_YNј”XU ЊJAŒэ’„˜мsЉ]K7jфƒZ€gVэvЗѓгfoО>З19 г‰ЮКШGLоќЪ@a(`џ4КБiђГќф}фF2Џ №W)бЏ$5ЯяЮѕg:јЋЌEџТzЇYЭтлЯ€іЃЩ7?ЦЃEtGў\ђр”ekв-жкjФ6kўo ѕY]ў4­_`д.ОСЕєТU{sƒёš(џ’сƒW‡Џ^\egЏ_Aп.›л>gQG$џЮ;ВƒEљjІ7;›М.лйѓ%–ЩэіЬь<їu:ыШеnПЎкъђ*VWЖGЭt˜]>—жИКЊc“ ў|ђTnŽЬf­ЫфыD Єrѕ tзŸќЃАїt зЪЕ|Ѕ|§хAc§хx8[§kЁGЪЯŸђtGо5†?ДеѕW-СJg ­5w]ЗlћкІ"еUЙ4~з …M•ЊЬ›Y)˜НЈтЪ+ŠјŒ†ХЫЫЎЙuMйУбžМ–yЕ†ЋjkЏЌё“u+їнаPА`грЫЏј‡НƒkУfЋSЭђSїЗbSšЂЗДк|.ЅzMЂ§К‹ЫчшМ§ЊТТyWBЯеЩгь=†нYhиjwАšЈ{Тпeнz ЛS;гю8“,MŽˆ_QVA™K"_8wЪхrЋќ›Ы* ЏИsГ2mgБ2wŸjтЅХХдƒ‘ђћIœ— rхЯp|5ЌN>_§UNЩІ?0р\‹еЏbМˆ>ЄљЋъ‹иŒ ] nљз=ЛяhlЙх™[їрѓЋЋЫЏ]^Pо>МbУшŠўЖ{пљђ W?tъћN=vУеŸ:d;№мmѓV}ф_ЗŸSО?)–'ї)Ў€wE,™.ЋЭšЛ†Н<ŠЎЖ^˜ѓЋПуЯf—оclL7sќЁгбd5s)ЯdФц›>ўкiЛ3іuЋЋqЎnzBЬєЌЅІ'јгКtгsЩ5•ч2œtQе˜rўО&орЪE'lъhЋV_тMWге§ѓЏџјцяŠ}}/№еt]ЕœОЩЌ|о@fІ(зн=КЅВrUSaa–VyŽL—C-)ЮЎЛюІ%ѓwxtћKwѓќМ!ьB{ЕUэ6hSккЪЪжVoS3Dп!ez‡дпеэšЛ§Kлn˜ы’%СюАжЖї/M9ўvЅжVSŽПшђ9vУyъ6 ,Мі#гŽ?rуUэ™ч hЛ7р+Ттъ<ПŸг\ЙІњ§ Ы шїqіLЗг]PœSН.qEKќЊЙV^ЊYgј§N‹ЂфeЋЋf}ueO­ЎЮ<сc++LЌdЦhВў’ЦшТэћКўDЏћ9§н$nљмkSЎПч$oA(P4;пёœЧC]з’/’л‚љ“ЏІіЧ‘“š—щЩЯЭqёЦ€Ў{џўwџвЙFИQrР-І–шйУЕь­ 5S–hVФšџ6VXЁЋќ3™Цш§|€†1b>Р7ЎЎЦ’@ ^@%И8vХ%М€Ў|­ФO§€фѓл>?0WЭЬДк<Й^5K•3s§…‹o\>џњ–|‘ЙšХЭVZŸфyBъЖьЇO>о@о$ŒsЦГ~Т-‚с%[oxЩъЈ— ыƒЊ'ВЏВЎџ[zЩФgнy9YŽ3пЗЉєKКDА`AXZšц%Ущс*Й?DВЮлœP’кœPEŸџ+Ё‹Ф*’ЖэРGЗач8Нєеˆ^њ’Dяг|ZЊщАkЦюšБ)]3цФчяО†Яbњќ_Б(ІZNP!bЁЛD•е 5хи™Ђв•%{г(œR5+GЗ&%iжФх&њЫф*7WnЦb2}OнрPy‰bšЕ…яTї=~лM_ьЎ ї>>v3>wфT6Џ ЏПБХXkk\пє[јоћюWЂ:uшžSьѓЫбƒ;ж7dЕпљLя'О7жTМјњЁлSў>иœї›Hqq€ч‘т\R”CŠГIq)ѕ“вLRЮdяж Ж0лЃHХ&-Wnь(7Zn<[nДмx(ЖœОEб№гL~+ЅV—Б@Чч‹O L—ёfДєqZ„‹‰9ЙˆЫƒЮИр‰Ђ5хъbNњ­˜.гЪ*Ÿ­œУ6JU~›I–Ћœ~жsѓпйI)М|ЏЂ;)UjXE‘аwuœЙ‹:)S^Jf]я‰иЫыIe€”чбчf#GRЎŽёб^ьSmvВвGХфC7œ2УКЌч~ƒП•ГъТБвЇd­tgвe›gКїФАаFяуиѓАЉБ>ЯzfC|Ў;ЗЎН–Н€‚ОU…—dџМлцщЦњŽј9—6жСBйШpњTGFq‘Ÿы›яzlˆkъ ՘p7ЕжDzŠл‘хR‘m"Гee6Нёg3ЙЭІr›С+ЂPs~ЅпCVAФП‹”‚Ѕ”>6Йј+ЗМIі4­ˆЄ;nЩаЦЛК2ђђЬs›Ћ•`rБОІсšHкфbcC~Љdž['&eш9ДnԘ\˜ыкЉч6 [єccnq&вD2Џ"eГHq).%%ЙЄ4‡БЊФOJ2IЉ”fR/Š‹%R,’ЪТF+З>ZUљќˆј4еи›ЊяI=ёuКg57R$ЯFђРЁвлOЅ=BЅ›TjDTК@}šwqeœЈU" @jг{DЁЛоХpѕЅ'=дP;Ђш+__Јд_f’КЯ;.wj$ќ˜:ŸїМžћƒMЕcžŒeњ$O`V `v@Нл•1љ€>5,(<™к@T“№{ЈзFpгЇN$њrуEќяЯ5щўч7„ObV0Ÿ;Б—5ВzЖ5P`#жзєЋС•шЖ+Кz}nЂ"5Hя‹ cuЭ@Э­5BMooЛсђш —ї ~ЧЁУ–fЛa=GшFA•ЌЄ~n:ГЭjzGЃяй‘f7 лЌЯУ*‰њ’qЧ<ЛљE§цб…KЅћў3Гі}з;џп79ДѕsMЎ,ПУцЪvЛЈѓ;/[kэ™r~OOЩtч7цc†яѓБч8н_{ZxŒЭЧ~њчТиЅИ ШJ—ЊлЧпƒ 3Еь\З“Ќ/&0SrѕH*—Њъл.X.еШХ.[щыqGTzу˜ŒЭ*)ЭДW§МЬ^ё“aXфД§кЌL|ž8Œ*/ц]NНЖы}мЫ’тАшцщйЃгbЬƒ˜${,˜=BšmќГќ+вoyГ(Сц~ )EќїШˆєkЄ˜Œ”ќљЦc6R"зF–")%ќїјУвЋHБ)KРГNz)Š‘r-RВ\V#ЅЙ:ІАйl9џ П’yМйsЈOАчPПJŸC=цмUtLкюь.љg7џJйš=WЏПЙН4x§\]ійе­Гj–TxrТ­•5­•юgЎЛчЦЙu=їоАщо›ъ{ю­XœWжЖu!>sKлЖъ‡0с—Q_їS\yєIцp8BЭй9eрMдОѓ+W/­^й Q€b3i5‹ЫWЎёЯn ЗЩ ]+ц%kЏin)^0Л“[^lГцЕ•Юпм’wхЊр’кмŒЦkš5›ЫeЖ:3нО\ЗземW­Љ&&i^›iбМPН'гуЯГЛэ[Із‘[{Ee[—Ъ yГ#дOP’ ѓ‡љжДчƒШ—R~‚Ндcэ5ьхЈrѓћ9 .яkXaиfп!ЋЌ;š&1C4›H”Pœ•ЬВэА:&_уOŸЭЬЮН?ѕ,ю§";Г2М љКЩŒ43Ÿ F>5IзHK лuќиР:њьm)O5љaФЩ9 ПIŸ њiеNџбiE^ьЉ ЫВ;Ц3№ќКЊЕУK‹ж•кD‘О\I2g•/Ј.[ђ{+Џ˜SZ›эvz|dF^tи'ц љ—n]R8;Вeq‘ьp) цфЭNЗУYXдТљйэ#Ћ2НВ#г‘Ї=Щ“ќyыЁkбЖƒшЗ!њжсЏ”5!?Љј§JѕђX$ЫYњВЛ“ЕЄібŠ ЉpмЕЋљпвZЙy{КW:mаКа+­ЗЫlМю 5Œ,^олЖЎ?’c дЎ\‘Y]Ёйd:ZШYХсМЦеsќDл4oщ Эйw9ДквЊUOqCIY]Ё3дpУС†Ю§эсXt§ТIЖй|Ў Л$Ыц’…f{ѓŠ#[ ыŠ<~я’Mѕ™>,Ÿ ЫєЦш2Ÿ+{ŠSЩŸto4y'bс2їOГwZoО _ДaЅјAХЩ}€5Ws $4љqЛM0)&ђ&,•Ф‹Ž ЗлzюŸd‹ УЂ]цљЙeЩЮоZи˜|‹ёŸд­BФэхŠšEВsоš_DŠ“іBвлёGЊОxєƒПхc…KЗЕ-лК(П uлВел"йwЊѕ%EЕЊЇЈЎ08'пNЎXuЫЦšа†=эЫvoЊ­ПіІešђrз6Ж^[—˜З2šФп ЋG­Тc…™…ГЙЗJЗЅл„K~џљ!й•“сЩq1› мdO‹{†š‘х”\tЯOwoL\i,^вБŸ№„№ЂФlB3Ф“ Щдsѕд&Мј5jЊЈQ#ЊEЭ$™oЕчЃc>&ŒQ)е01Ѕ;žџыmW&;m˜Уё&Ћѕі’š€Н>TXW–y€$HŽВК…EPŽЋ|YУ $ЯaЏЫЭ‚u№83мNЫMEЕЁYYe5Њ‡Ž‰.ЏWѕКm95­х ЏЊjgжЁ zVбšЋИыЉux"bo[UмжTмжVм$и`~б8[]]Й&с‡ч—“ђЩw:Нљљвт[ѓНФћ%Ѓ+АББZ}c;ўR~Ч‹и ё Тњ™’˜^ТZЈСЖюљ… jKœ&‹EЮ­hЎ(šяt—ЭŸЕˆў(лзpХђкЙyЕхy&&…’R\ПИДqMCŽЇhN иRю{ЊjymžХсRГВsмN—CЭ*pag—l^‡гcчTUЋЇhѓ8ЌN›Ќx\іЌЪ–’Мšђ/ДŸЎ џ.§ЛIL 7™^›цкK†Gѕ зІ…#|ћтСВт’сєћхŽє`лк^еƒ}ья}SсмЬрмqЉ ъЧксзщС5tЩ№о?И{ІТ№сїžO!|ёќрэіО{ёё§ОV„ƒ™\fWf—П aТO0­%YВБ№vжлйЋВЬ~0ЇўџQи”sЫџ„џ ƒp,=фКўЊ077њџmx,їOyё€И1№‹ќљА№ІЖB{Њ`}Сз C…?/*daАш‰т’т+).љtЉПtѓћ†GJп,ы ŠСx№зСзЫkYјmХg*чЯЊ™uЊъЫUO†жВp](ъэ …>К;єЉѓТkехе ћУЛТП}УьЯ oеЬЉ98ЇfЮ=˜eд>ЭТГЕ/дОTћjэяjпЊ=]'Аађп˜gŸ“шsq'њАч"“Џsз“ЃЩ7Б>˜|єhђOD%?Ъ?юS№[Vё…}Ї=єДvFу<чD#.paСmФХ4‰ѓ ‹ŒИ)-нЬ6q™Ћ~`Ф-œ&Ў3т hŠпЪ]-&ŒИЋŸ3тvў>ё#юрzЭwR[РŽѓ„'œYЎ0т”еХxћq6ŒД~vMЯ џQ№ХQТ.œэD,К4іЛї[яЏЦ0 wЎї -eР(5Ž>ЃNЪЁЁЌNZЫ0kЫ2жжnЄDйяКБVhь3ЪZIыелб‰+ГXЩ},Ѕ—•…ŒєєT-}(Ї—Ilа@й”>VЋ^&mg" ­qЕE—wJк:vZг$ Б_МяaRˆГпИЂў;Ѓ-NLщC—™^‹ЦАїэ`ВнТ8ЇЇЗˆJm”хг[Н ч!жвЕYЦJыc%ьbr14Ÿ.oЊ1Н§1†ŸЖ_зЫы єSЏ‘ъZCƒS­б1і<У8ЛЩ(=Vшк1ЅЅ(ы#QЄіЭhWЊ7wI”епiдb=Ж‡щŠ^Й№hК еMSwMwЕб‹тF›MwˆуъХ{}ЬшПzkЂўvUЧ3$F1vБžKQmc:KхЙјеюПшžю-Кnжу,Ю0ањзВоž˜ЁЧjС@Z :ћ.СZc}y%R:Й гq9xКXљW0TzоТ ЄXА“…ЛЧg"БвћР“@пЂј{X QТ.ЄR vГЖа;gfЉЉt:zши6UоF†YяЕЛXofьОfу€ž[cm їdŒѕЈ8ЋC—а–7%Н%пJŒˆzоЁД+њ§мХd2}юduuВ{јbѕъч”ЗНh„ЩАkЊЯwБыƒЌЧюJычƒЌЅ§FOзЫŠ1JямѓлMЏы#DЙЪYяьCЛbSїь…Јњ/(љђe4]zj”жŒqVя=3ЦЛ л>н_gтš—&кН-њЈŸъѕCSЄ‹Ё§l,ОoKu9GgШ4fєўѓя*UкѓFXЮ.6бжФІЪЁœНlLЛ”†ўVїХє=QЭаа{@ЗD!ІЋAnє!­&ЎзVХ;‡†КктЁСЁh">авііjkт=[УкšиplhGЌ+Д8кп2зтУZTышŠ ѕkУбўa зунZwД/оЛKлOlе†GЖ$zcкаРHWМПgXk"ж‡œ§]ZчРPlh8Є-KhнБhbd(6Ќ ХЂНZ<::‡giУ}Q шŒ"NГєє&тƒ(ВЄ/6ЮсX‚0Ќ  7…в{{vj[\‹ї F;ZМ_KаvВhНё~д5а­m‰їА‚ѕŠБб2ЧЗХBšбЬВa­/кПKыAуuм‰­Ј?ЖSŠЂ-Cq4Ѓ}кШ ­%і e8~иhакЄЈЖ3:дЇзEХмЙ5:`БЁаšXЯHothJMЉЊ›ЈjъЎ†ˆа(mv(\“&њф‹jЂ(П'NqФl(кы‹mгш•Дгю‹+˜‰­YпO џкD4ЁЗБ А :ЁЛФP<6Z9вŒ—k]1эŠЁ\M$›ЊЋwюмъKъшЋNьшŠnнUн™шшO Ќ4оEЖQО#э.md8hНЌEЁЩиP_Kr“УмзШQюЈАœћ‘аЫН*МЮН)МСўH,Т›Ф'œ$EТ[$,ќ‰Дo“хТ)ВA˜ Т{$ШC3ё є™x Їxš€g №Ќžыg№ŒЯШq№|xžУРѓ-рyx~ <ЏЯYс `љ#АМ ,'х-`љАМ ,ЇH№єzй;?‘†Ч<%Р3xЯ рй<нР3<žЛчрyxžžoЯчUрљ“аKˆ№:ёO№TO №ЌžРг<#Рѓ!рљ8№ќ№<0x'№ЇxЯjрЙxЖЯMРГxюžž'gxžžW€ч5рyx,Р“<Р3xк€g№tЯ№ьžžЯЯ—€чы3ё˜кг№ЈРS <ѓ€Ї xжO7№ Я‡€чnрљ<№< Ё}Bћ(Т>&EЊ‰•)I•И› AWS’еDш&Д‹kЩŒј-TИcЛїюн=SKV‰XЉ–RjВbMSгп^OVТ[SzКИЂX‡гЋЁ5)ЏШк”ЊŒЋ,‡9;u:ŠЦƒ™žњЇДХNwUкеfTСЄŸNщ+b8›hдƒ‘иEбф“Љx‡ЊžАš‰•ЉЭа›еNЌЮqџИџP№P№@л6кЙn—o—їЪL%ЃћЦЦ"a™V.›ˆЌЋ‚Ё'цЦV*ƒжF›™и,<ŽІЅ(sяв&ЦкиJЕзкˆ*хiѕэн­пH)§йLФ&Ї)pfбЖt ŽЩ(РrфйНь`'­4ккШFaC‰ь~5E"L‹‘FЦЈч +'лhw\YIiвFx›iЊr˜9›™чSЪЄКdђвЋc5Вѓpћу)­Iv>КmЇПЦ™>‡>y~пЈUЦЙЭы-nmн—„йu]Ё<ЛNЯuN—?i@шд>­Sb7MщTSкdbSЮ?~ќйГЧ;vќЌЭAlъ‰мЙ'›0ыхо—{ПЛђљчŸНѓ;wГГ1e5wŸЭu˜LЯZЬФbй}мdКхјёяя g2НŒЃЛй.Л"р˜зsŒ=ѓ,2И›ЛŸпвlЃgЗЂъуЛЧoСѕ[ь<Б‹уу7ž:ьfbЗаШёч_>yђхчŸ?n№ЄДPхчЏгvжмЭтнЭlˆzљ„СIowSGЧD‡~42^#Р98‹ƒ6Вгпs_з}Е7Ÿєwј;ь%угФ™;‡ЙYлbC§\ ЃŒЮgД•бхŒЖO­$ ћМхй7€њ`NИўдDIЋШэХМ8ЬЗsЗђџЬџ”;$|Zј4ї"GzœтфGХг цА9Ќмm;4ьъ^9?8іЛыЇТЯоuПыЙЮs]цн4d?s~0‡sОјnўнz(и7 ?CC™џЂс*џ9ЊŸЋЙюџђr/аU—gОЧџщжЉuДкŽ­ГfЌНŒЊгzaдzkЕšЊX[QЌАV.ŠуЁ(AxЁX8"HB Hˆ\”lm!D1! ‰$dяФ}сovУ ŠВЯ' Ї==:ыиГжYџѕmP {ПяћќОЯѓцтGЯљНGž ~ћ>_X|бЌяњѓsёЗŽ<§ПѓзЯХ›/ ?z.Нюž›/нzщжЫzњŸџ§w~pъЧ=џ yХ WЌ9ђ\ЙтЯЯ^ьЎ*љичOWЇ?zr›~<џЃчšЅGžkќИчКuз­ЛўиŸLќ‹ЇЙџп§ѕsУQз{§Б7еџw~vfџsуФž#џOƒ›w юНщь›FнДјІжСЭ7%ћŸП~Н!—мгџЎ?vШ”!ѓ<Зtќљщ­[ЯыџпŽъчЖпо‘ўшЙѓЊ_”|єм}Ь‘gxы№ж_Цхž‰#ŠGьёытХ#?3ђš‘Г?M#{GіŽ:gдэžЛF=6jU>ъ§{.шF=vЯ§їLѕМxЯЫїМzЯлїМ}я1їорЙыоћю}ўУgУшo~vєКбoпwЖч‚ћ~vпƒїЭКЏсУ'yпОџ ўѓbЯ5їŸ|џЌћ{ћŸ1k~ugџ36Лhь> §ŸžїБч№?ѕ4џЁŠ‡КњŸ‰M|ь№ГfbѓЄЏNњ†k&уЙoввI+&е?|‚чњ‡чјs=ќкУЏM:ЧџюыџеУЏ=rд#'?rЭ#~ўєш•‡Ÿё.šєUџ;ўб-ІнтOœœwLо™yчф=цй’їо#ђgЗљЧўљб-]ўи5“яž|рёgŸМўЩ[žМkъг~8ЃфйБ}œuнЌыžџ‡b/єЬ=qю)soŸћшмЉsgЭ]4їеЙ5sџ4їНќЃђOШ?%џМќKѓЏЫП5П8K~ыМгц7яЊyЯ{~о›ѓТљЇЯПyўГЧ\\0Ж Єре‚XСћ .^0~С†…ч,М№б…sОИАaarб ‹n]4{бŸ O(<Ї№ЪТы ЧN,œ_Иgё ‹яZќ№тчПЙИЃшФЂГ‹&­)ъ-ОДxBё‹Хщ%С’ѓ–ќlЩЂ%{–žКtьвеK“ЫІг‚ВнС—№eќ#NФW№mœ†8gр‚р+С…јq6\ƒkqсzќ7рЇŒ!И+;4ј%юЦˆьž`$Fсм‹бИџ‰ћёп0ПЪ. ЦfWрAŒУxLШŽ ТDLТӘ‘­ žХLЬТs˜b,СR,C жыАеЏЋёЖЁлБЕxuЈЧN4!žt  ћ‘D iьEˆwа… ў„nьЫЮўGvSаƒ§шEоЭцяс оЧйќœ9й7rц"ѓQ€XˆE(ФbЁKАЫP‚хxПЧ ЌФ*М„е(ХМ–mЮЉЬ6цlAЖЂ:лЙ6ћjфЦр ‘›ƒу"Зdљyvuфvя№qLЖ;Rœ4GeгСбј;|Чрs8уp<>ВI–TaI–TaI–TaI–TaI–TaI•ЕGeэQY{Tж•ЕGeэQY{Tж•ЕGeэQY{‚лГap†bюФ/№HЖ7xyx 3Tс؉YxГQŒ%XŠe(СжlBU$TEBU$TEBU$TEBU$TEBU$TEBU$TE"и=ДЂ {аŽт~Џи—mV1S1SБр€п{7ЛSьT;UСNUА3ч3йжœŽТбј;|Чрs8уёйŽœ/т| _Ц?тD|_ХIјЇlЌџ{_sО†S№u|пФЗ№Џ8пЦiйзrрtœУwp&ЮТйјw|пУ98чс| Фр\ˆ‹№}\ŒKp).Ухј~ˆ+p%~„Ћp5rёc\ƒkqсFkŒ›p3†`’ї§0СЃШУc˜ŒЧёžФS˜‚Ї§9йЄД%Ѕ-)mIiKJ[Rк’в–”ЖЄД%Ѕ-)mIiKJ[Rк’в–”ЖЄД%Ѕ-)mIiKJ[Rк’в–”ЖЄД%ЅmGЮыЮъј#*А •ў§Ta+ЊГ;ЄЌ3˜,aЁ„…JX(aЁ„…JX(aЁ„…rьŽнСБ;x3С›IоLђf’7“М™ ~­чЮJюЌфЮJюЌфЮJi Ѕ%”–PZТ`rv№8žР“x S№LХгј-тйенЃК{TwLuwЉю.енЅКЛTw—ъŽЉюFенЈКUwЃъnT]Ёъ UWЈКBеЊЎPu…Њ+T]Ёъ UWЈКBеЊЎPu…Њ+T]Ёъ UWЈКBеЊЎPu…Њ+T]Ёъ UWЈКBеЊЎPu…Њ+T]Ёъ UWЈКBеЊЎPu…Њ+ьџ>zUЊŠPU„Њ"TЁЊUEЈ*BUЊŠPU„Њ"TЁЊUEЈ*BUЊŠPU„Њ"TЁЊUEЈ*BUЊŠ0gsЖ[„Њ TЁ*UAЙ1лСПмл\|Сэылvє4 Рщ8ЧщШЧёfovёfovёfovёfovёfovёfWp—;б/q7f№в؉YxГQœmтЦ&nlтЦ&nlв9ПЂs~…#›9В™#›9В™#›9В™#›9В™#›9В™#›9В™#›uЫŒn™б-3КeFЗЬш–н2Ѓ[ftЫŒn™б-3Aџw€п˜э‹мЂ§<ЙнЧ;‚!С@™ˆЩDL&b2“‰˜LФd"&1™ˆЩDL&bСЄшнчBмХьПФнј•,ŒЭю“}ђБO>іЩЧ>љh—]ђБK>vЩЧ.љи%iљHЫGZ>вђБW>іЪЧ^љи+{хcЏ|ь•НђБW>іыэє†Уш щBйloN€œlЏеUEn–є[ЌєчAФgЌ0ьЕТiV8Э ЇYс4+œf…гЌpšNГТiV8Э ЇYсBНЕKoэв[Лєж.НЕKoэњјZЩЮД3?U­мžыБq=6ЎЧЦѕиИЗ[i;ГпЮьЗ3ћэЬ~;ГиЮ,Ж3‹эЬb;ГиЮ,Ж3‹эЬb;ГиЮ,žЩОЏюЖЈЛ-ъn‹КлЂюЖЈЛ-Сяќоѓ˜‹|ЬУ|`b БE(ії–`)–ЁЫ§ћБ+Б /a5JБexkБыГЫœиВрП~QŽ(^У№GT`6Ѓ[P…­й*ЙЈ’‹*ЙЈ’‹*ЙЈ’‹*ЙЈ’‹*ЙЈ’‹*ЙЈ ќF4љѕ.›б‚ЗАлоЗЂ {аŽтй6жmcн6™ e*”ЉPІB™ e*”ЉPІB™ e*”ЉЁу нСа нСа нЁ:З0t‚Ё `шC'TьvЛ]ХnWБлЭ#Uц‘*ѓH•yЄЪдяC§>дяУœЁС—r†7фмœ”ѓ‹ры9w_ЬЙ“ќ?ŒG№(ђ№&уq<'ёІрiџ_ЯdwчЬР؉YxГёЛьn‰=Gb/9œVIм›$А—[zЙЅ—[zЙЅ—[њИЅ[њИЅ[њx%Ц+1^‰ёJŒWbNђ}'љО“|пщМчt:ƒNч г9шt:™œЬNц'ѓ“љ@Яˆ›$в&‰ДI"m’H›$вњШ>}$ІФє‘˜>гGИв>gŸОhŸŽГOЧЖу'БЭnЖйЭ6Лйf7льf›нlГ›mvГЭnЖйЭ6Л­5!ѕ§ѓA(хЁ”‡RJy(хЁ”‡RJy(х§§ЋгŽuхЯQЋ9j5G­цЈеЕšЃVsд*ŽZХQЋ8jG­тІn*рІn*рІn*рІn*рІn*рІnътІ.nътІ.nътІ.ЗЬИ[fм-3ю–wЫŒЛeЦн2уn™qЗЬИ[fм-3юДZVЋгjuZ­NЋ•›ЪЙЉœ›ЪЙЉœ›ЪЙЉœg6ђЬFžйШ3yfЃžјe=ёЫВ_.ћхВ_.ћхВ_.ћхВ_.ћхВ_.ћхВ_.ћх2_.у{e|ЏŒя•ёН2ОWЦїЊŒ­*cЋЪи*у;d|‡Œяё2ОCЦwШјп!у;d|‡ŒяPE›>і–yфŽБI%mRI›Tв&•ДщSо1šdКIІ›dКIІ›dКIІ›dКIІ›dКIІл>Х#a L˜ІР„)0a L˜ІР„)0a L˜ІР„)0a L˜ІР„)0a L˜ІР„)0a L˜ІР„)0a L˜ІР„)0a L˜ІР„)0a L˜ІР„)0a L˜ІРчДqNчДqNчДхмќГ<}Sžn”Ї‘ЇoђЮПцмнУ=_ЯyРЧ1уёkLРD|кћЩoќЇћ.вЧi˜ŽџŽgЄjžХLЬТs˜пaŽ›§\фc> А Б…XŒ"c –bJА/тїX•X…—АЅXƒ2яхeЌХ:ЌЧМ‚WБхˆтЕь\жZШZ Yk!k-d­…ŒЕœБ–3жrЦZЮXЫнZƒ­&оK˜#ЭiцH3Gš9вЬ‘fŽZцЈeŽZцЈeŽZ“№I&с“ЄŽAъЄŽAъЄŽAъЄŽAъЄŽAъЄŽЛGqї(юХѕЌQЯѕЌQЯѕЌQЯѕЌQЯѕЌQЯѕШe\жЉfjжЉfjжЉfjжЉfjжЉfjжЉfjжЉf—Bv)d—Bv‰ГKœ]тьg—8ЛФй%Ю.qv‰ГKœ]тьђvйЮ.лйe;Лlg—эЬ2†YЦ0ЫfУ,c$;%й)ЩNIvJВS’’ь”dЇ$;%й)ЩNIvJВS’’ь”dЇ$;%й)ЩNIvJВS’’ь”dЇ$;%й)ЩNIvJВS’’ь”dЇ$;%й)ЩNIvJВS’’ь”dЇўП%фЕьjUПNеЏSѕыT§:UПNеПЄъ_Rѕ/Љњ—T§K‘ƒ/ъЬF~ž­;_ЙУЧ‰ю “Вk#хС‘xіw‘ŽрьHg№нH"8#’ЪжFвСg‚яыт)]<Ѕ‹Їtё”.žвХSКxJOщт)]<Ѕ‹ЇtёИ{@Ї{@ЇъЏR§UЊПъУЯЄUtZEЇUtZEЇuќзTu•ЊЎRеUЊКJUW™§›ЭўЭfџfГГЉ c*ؘ 2І‚ŒЉ c*ؘ 2І‚ŒЉ c*ؘБC3vЈ'…fЬŒ3cЦܘ13&˜žœ7мЖЁлп”v˜"bvІЫьuœщ2lВъ‘V=вЊGZѕHЋiе#­zЄUДъ‘V=вЊGZѕXЋkеc­КЯЊћЌКя№МіkГЭЗ—‡0“№0БS"arv†ЮАТV8У gXс +œa…3Ќp†ЮАТ +Ќан3К{FwЯшюн=ЃЛg‚И{^:ё)nХКuНn]Џ[зыжѕКuНn]Џ[зыжѕКuНn]Џ[зыж;uыКѕNнzЇnНSЗоЉ[яд­wъж;uыКuЋnнЈ[7ъжКuЃnнЈ[7ъжКuЃnнЈ[7цœfz€гqў пС™8 gупё]|чр\œ‡ѓ1џ p!.Тїq1.СЅИ —уј!ЎР•јЎТеШХq ЎХu„­e0nТЭ‚IоїУx"a2ЧxOa žіwžб­fрYЬФ,<‡йјцx­ЙШЧ|`b БE(Ц,Х2”`9^ФяБ+Б /a5JБ•и‚*lEЕъП1ћ™ШЭ‡Fn Ž—†Г#Зћx‡їfgщš ОЋkцъ„tТ*НVЅзЊєкѓн#п=ђн#п=ђнќZ–&dпT§oЊў7Uџ›ЊџM]k€Ў5@з k аЕшZt­Кж]k€Ў5@'К\'К<8рз‡ фШСѕС…9?С ј)~†‘С œЭСзиnddpp‘UcЧDю ІD NŽфЇD&'џ‹ЯlМЃїПЃїПЃїПЃїПЃч‡z~Јч‡z~Јч‡z~Јч‡z~Јч‡z~Јч‡n n n n n n §6 эVhЗBЛеaЗКьV—нъВ[]vЋыcяqjEпоЃoябЗїшл{єэ=њvЛОнЎoЗылэњvЛнŠи­ˆОнЎoЗылэњvЛОнЎoЗылэњvЛОнЎoЗылэњvЛОнЮ}\бЧ}\бЧ}\бЧ}\бЧ}\бЧ}zuЧЧ~>і]k{ё>>8|Kўп’џЗфџ-љKўп’џЗфџ-љKўп’ЅYjЅYjЅYjЅYjЅYjЅYjаћожћкєО6НЏMяkгћкєО6НЏMяkгћкєОЖШЭСБС•ŒоЭшнŒоЭшнŒоЭшнŒоЭшнŒоЭшнŒоЭшя3zЃї9Й}NnŸ“лчфі9Йn'зэфК\З“ыfљџсєBЇ:Нащ…NЏџ6{ˆеБњ!V?Фъ‡X§ЋbѕCЌ~ˆе™ššLMMІІ&ЛЛУю6йн&Ллdw›ьn“žжl‡7ис vxƒо`‡7и‰дсџ&Ы№GT`*н1Ж  [QMшsЁ `Ÿ>šіIu_ЮЩvfЈjg†к™ЁvfЈjg†кї{Яу йСВг ; Вг ; Вг ; ВГIv6ЩЮ&йй$;›ьbд.FehГ m–ЁЭ2ДY†6Ыаfк,C›ehГ m–ЁЭ2д+CН2д+CН2д+CНС]С?ПФн˜œhgкйvv hgкйvv hgЯdKeш6КM†n“Ёлdш6К-јп{s‘y˜,РB,B!ЃХжПKБ %XюпПˆX‰Ux ЋQŠ5(УЫX‹uXŸЅЯ ^ёыWБхˆт5ќD6a3*БUиъ,ЊёЖЁлБЕxuЈЧN4ј;hђы]>6ЃoaЗJjEі 1$В39a&'Ьф„™œ0“frТLN˜Щ 39a&'ЬTЕ/Ћк2U[ІjЫTm™Њ-SЕkTm›ЊmSЕmЊЖMеЖ™Юv›Юv›Юv›Юv›?†š?†š?†š?†š?†š?†š?†š?†š?†š?†š?†š?™?™?™?™?™?™?™?™?™?™?FѓO.џфђO.џфђO.џфђO.џфђO.џфц\Ÿ™ѓм€ŸтgИбпŒ›p3†рірT7єЫмаsCџЉњnшWЛЁчЙЁ_ъ†žч†žч†žч†žч†žч†žч†žЧqЙ—ЫqЙ—ЫqЙ—ЫqЙ—ЫqЙ—ЫqЙ—ы†žgfэ†žч†žч†žч†žg†n†n†n†n†n†n†n†юцœчцœчцœчцœчцœчцœчцœчцœчцœчцœчцœЧ‹йЃ„=JиЃ„=JиЃФД\Ь … RШ … RШ …&ш1&ш1&ш1&ш1f†3#ƒГг#7e'˜ЄЯ5;œјсьpт‡ГУs,34Rž-ŽФн-ЬЅ‘Зн;RСЯƒaž:цЉcž:цЉcž:цЉcž:цЉcž:цЉcž:цie“&6i’ўnщя–ўnщя–ўnщя–ўnщя–ўnщяў‹ћРћ‡ПтuГNsДW]рUxе^uW]рUxе^еД…уёy|!{я1+$ј.Сw ОskТйUоaџg;љЎ“я:љЎ“я:љЎ“я:љЎ“я:љЎ“я:љЎ‡яzјЎ‡яzјЎ‡яz‚_ŸГвёV:оJЧ[щx+oЅу­tМ•ŽЗвёV:ўУЏzЬчЙљ<7Ÿчцѓм|ž›џ7~еcЯЭуЙy<7чц§_ѕиф6§?|еc9Я-чЙх<Зœч–ѓмrž[ЮsЫyn9Я-чЙх<Зќ/ОъБќcОъё:ЯНЮsЏѓмы<ї:ЯНЮs<зШs<зШs<зШs<зШs<зШs*ЉŽЛохЎwЙы]юz—ЛІsзtюšЮ]гЙk:wMчЎщм5ЛІsзtюšЮ]/pз мѕwНР]/pз мѕwНР]/pз мЕŒЛцpзюšУ]sИkwЭсЎ9м5‡ЛцpзюЪчЎ|юЪчЎ|юЪчЎeмЕŒЛ–qз2юZЦ]g§…ЛЎтЎЙы юЊсЎѓЙЋ†ЛjИЋ†ЛjИЋ†ЛjИЋ†ЛJИЋ„ЛJИЋ„ЛJИЋ„ЛJИЋ„ЛJИЋ„ЛJИЋ„ЛjИkwеpW wеpW wsW1wsW1wsW1wsW1wеpW wеpW wеpW wеpW wеpW wе№гn~кЭOЛљi7?эцЇќД‚ŸV№г ЉП…ŸfёгZщџ7ЫKчђвl^šЫEЏrбрœЯБB!+ВB!+ВB!+ВB!+Иwсx|_Ш>ё_|і0Э iVHГBšвЌА”–ВBšвЌf…4+ЄY!Э iVHГBšвЌўФ)ЈжœœТ SXa +La…)Ќ0…ІАТV˜Т SX!У ЅЌPЪ ЅЌPЪ ЅЌPЪ VШАB†2Ќa… +dX!У VШАB†2Ќa…RV(e…RV(e…RVШАB†2Ќa… +dX!У VШАB†2Ќa…ўЯгМЬ /ГB†2Ќa… +dX!У VШАB†2Ќa… +dX!У ЅЌPЪ ЅЌPЪ ЅЌPЪ ЅЌPЪ ЅЌPЪ ЅЌPЪ VШАB)+dX!У VШАBŒbЌc…+ФX!і)Пў™1§$L? гOТє“0§$иЂњОўйС  вС  ВžAж3ШzYЯ ыd=ƒЌgѕ ВžAж3ШzYЭ Ћd5ƒЌfе ВšAV3ШjYЭ Ћdƒ”1Hƒ”1Hƒ”1Hƒ”1Hƒ”1Hƒle­ В•AЖ2ШVYЧ ыdƒЌcu ђ ђmЙAЮbГф Љ`o3HƒT0HƒT0HƒT0HХп` YЧ  RС  RС kd-ƒЌeЕ В–Aж2ШZYЫ  RС  RС  RС  RС  RС ІŸўя‘Њf‘jЉf‘jЉfгXу.Цј.c|ž1>ЯKƒХR_)ѕ•R_)ѕ•R_)ѕ•R•њЈдGЅ>*ѕ§wžJiЏ”іJiЏ”іJiЏ”іJiЏ”іJiЏ”іЪOќnУfшg1Г№fЃKАЫP‚?ЕАL:ЪЄЃL:ЪЄЃL:ЪЄЃL:ЪЄЃL:ЪЄЃL:ЪЄЂL B)Ѕ ”‚P B)нLЋмLЋмLЋ$b›Dl“ˆmБM"ЖIФ6‰и&л$b›Dl“ˆmQ%uQ'uQ'u⹆4М! oHУ⹆4dЅ!+ YiШЊмz•ЛKхюRЙЛTю.•ЛKхюRЙЛTю.•ЛKхюRЙ}*ЗOхіЉм>•лЇrыUnНЪ­WЙѕ*З^ѕ5ЋОfезЌњšU_ГъkV}ЭЊЏYѕ5ЋОfезЌњšU^§сџ6щ\фc> А Б…XŒ"c –bJА/тїX•X…—АЅXƒВУŸЫЏ2‡o7‡o7‡o7‡o7‡oW;UчNеЙSuюT;прмоWцм­oаЗFш[#є­њж}k„О5BпЁoаЗFш[#є­ыU№FМQoTСU№FМQoTСU№FМQoдЗžбЗžQЩх*Й\%—Ћфr•\Ў’ЫUrЙJ.WЩх*Й\%—§_ћПC1 wтјыя›ьў8žР“x S№LХгј-ž‘ЄйћЅр~)И_ ю—‚ћЅр~=,Њ‡EѕАЈеУЂzXT‹ъaQ=,Њ‡EѕАЈеУЂ’3NrЦIЮ8Щ'9уєАЈеУЂzXT‹ъaQ=,Њ‡EѕАЈеУЂzXT‹ъaЯыaЯыaQ=,Њ‡EѕАЈеУЂzXT‹ъaQ=,Њ‡EѕАЈеУЂR:NJЧIщ8)'ЅуЄtœ”Ž“вqR:NJЧIщ8)Ї‡EѕАЈДŽгУЂzXT‹ъaQщ-ощ-ощ-ощ­—оzщ­—оZщ­•оZщ­•оZщ­•оZщ­•оZщ­•оZщн Н+Єw…єЎовЛB?[ СЕ\+СЕ\+СЕќŠ№О"СЏH№+њй§l‚~6A?› ŸMаЯ&шgєГ њй§l‚~6A?ІŸ гЯ†щgУєГaњй0§l˜~6L?ІŸ c…IЌ0šFГТhVЭ ЃYa4+Œf…бЌ0šFчœ–§CЮœŽ3№oјЮФY8џŽят{8чт<œј\€ qО‹q .ХeИ?РqЎФpЎF.~Œkp-ЎУ \яіќм€ŸтgИбњу&мŒ!И-Л'ЇџП|qGvƒО{–О{‡О{ŽОћS}ї}wQЮH–ИЧя=рзbЦуз˜€‰˜”Ю~Уйo8ћ gПсь7œ§†ГпpіЮ~Уйo8ћ з{1р$Нw‘оЛHя]Єї.в{ЇщНгєоizя4Нwšо;MяІїNЫy^ПžУœs‘љ(Р,Ф"b1ŠPŒ%XŠe(СrМˆпcVb^Тj”b ЪМŸ—БыА№ ^ХF”#Šздфыі§ј#*А ›эЋL2l”aЃ eиЈ[DО[DО[DО[DОyр(ѓРƒnw› Оd&ј'3С?ЙELfсЇ#Бl›ФжH2лщ6ёH:л1ѓ~fоЯЬћ™y?3яgц§ЬМŸ™ї3ѓ~fоЯЬћY9СЪ VNАr‚•Ќœј„ŸbHВq’“lœdу$'й8ЩЦI6NВq’ћПѕнр<ˆq x1 cFЖaЖaЖaиВ-иВ-иВСœqЎ9у\k`Аk`Аk`Аk`Аk`Аk`Ацj`ЄƒŒt‘2Rš‘вŒ”fЄ4#Ѕ)ЭHiFJ3Rš‘вŒ”fЄ=Œ”dЄ$#%)ЩHI6JВQ’’l”dЃ$ћєВO/ћєВO/ћєВO/ћєВO/ћєВO/ћєўЏ“'рKј2ў'т+ј*NBџќdНњk8_Ч7№M| џŠSёmмшЯЦMшџЕ!И=јЂŸ.С#%ј| ОB‚П%ЙЇIg\:ув—ЮИtЦЅ3.qщŒKg\:ув—ЮИdvЉш:нЌЂ›UtГŠnVб§?sгЂš[Ts‹jnQЭ-ЊѕLеzІJ­ Ўtвq'wвq'wвq'wвo;щЗєлNњm'§Ж“>лIŸэЄ“N:щЄ“N:щЄ“N:щЄ“N:щЄ“N:щЄ“N:щЄ“zв!=щžtHO:Є'в“њПж1WЬUsU@‹ hQ-* EДЈ€аЂZT@‹ hQ-*`Ѕ XЉVЊ€•*`Ѕ Xйџ§мЊ`Њ*˜Њ ІЊ‚ЉЊ`jфZ7ўƒПџ№'Ў75mˆмš§yфЖьІШэў™S#C§ѓ0џ<&ћApЁ‰$i"IšH’&’Є‰$i"IšH’&’Є‰$i"IкСЄLкСЄLкСЄLкСДLлСДLлСєпєЕИнў^+кАэˆЮ@кєи;аczь@ЯсязDѕт}|€ПўО№л‚ЯF†Ёџ'@Ю§П§NK+8`Ќр€А‚VpР XС+8`Ќр€А‚VЕ‚Ќd­ kY+Ш:ћjg_эьЋ­ІхюЬ;ЌІкjЊ­ІкjЊ­ІкjBЋ ­&Дšўя;зЗiџї›ОщŸ7Я ІЛџЬШЖ:ŸVчгъ|ZOЋѓi§иѓYœЈТOДЪДUІ­2m•iЋL[eк*гV™ЖЪДUІ­2m•iЋLёри иЇВdwyчНѓƒољAяќ w~№/~кржШ­AФ9џсOмъŸ‡ЧЇ9Иѓˆ;Иѓˆ;Иѓˆ;Иѓˆ;ИѓˆгоzЏОЁџИ=u G љq?%ГЭЛкх]эђЎvyWЛМЋ]і3i?“і3i?“охжj iOі4iO‘;ГБШ/ВБрjяpЖw8л;œэЮіg{‡ГНУйосlяpЖw8л;ќН3шpЮ Уt8ƒgас Bg:ƒа„Ю ќ_Ÿ#оjeеxлPƒэиZМ‰:дc'š№IпхК/ЛлnДй6Лбf7кьFлсЯпОЋBпУAМp(ЛЯnьГћьЦ>Л‘k7ЎvnŸsnЇ;ЗЯ:ЗЏ;ЗЯ9Зг[–ОnwrэNЎI "В=8#јЊеїџLр!Ћ?dѕ‡ЌўеВњ~їэw^ћзў?gєqinћИЯ}”ор3~uŒ_sјЋ -NЄХ‰Д8‘'втDZœH‹iq"-NЄХ{њфŸ#<ђНR§$ЏY}‹W:к+m•ёHџЯeфz՘WŒy՘WŒy՘WŒy՘WŒy՘WьџО…";PdŠь@‘(ВEЮПШљ9џ"ч_фќ‹d№8<Юљ9џ"ч_фќ‹œ‘ѓ/rўEЮПШљ9џ"ч_фќ‹œ‘UНcUяXе;VѕŽUНcUяш,э:KЛЮвЎГДы,э:KЛЮвЎГДы,э:KЛЮвю$:DГ“hvЭNЂйI4иYZDЋ“hu­NЂUM­&NUЧкЁ‹еФбjтT5qЌнʘ_›ƒk‚ЩСз‚ЧёžФS˜‚п`*žЦo1=ИЬnеи­ЛUcЗjьVнЊљ„щыЃžмbЗZьV‹нjБ[-vЋХnЕи­ЛеbЗZьV‹нjБ[-ъЏD§•ЈП’Oy\d‡цлЁљvhОšo‡цл)vgŠн™bwІи)zю1r‰~ћœЉпŽх’KєлјфL§vldbvcdRЖ,В#јŸЬнy|”ѕЙїё;3!РZAjŸ*тn­"иКлZkЕV­ZЕЧггcыƒ5­ЛU‹+bЋ‚ jѕдV[7Д PŠUD ,!l1ВЭ $™@э}о3Œ>ДХsъљуМžW_Ÿ&&їoЙОзїКюп„YЎО]*ЂЛЙt,юС8м‹_тWИїуL(єm9{ГXџŸvژ/вљ"oї›ьОЭюльОЭюльОM~чџ“wšЊaCщY‚НDЕЄєLС^"ZЂ:šЂ…чјЊc‚&ˆ`‚&ˆ`‚&ˆ`‚&ˆ`‚&ˆрrž–ѓДœЇх<-чi9Oяњ.Ѕ‡П‰juК5X‚ЅX†хXZЌФ*д!ŽЕzЪ:ЌЧћиW(”ЁP†B uRh+…ЖRh+…ЖRЈажPЈ‹B]ъЂP…К(”ЄP’BI %)Д7…О 2vЇаUб[UьNЁ*Ђ7…ŽЃаqКф]ЊЃОpЗ †ЈŽ!ЊcˆъЂ:†ЈŽ!ЊcˆъЂ:†ЈŽ!Њу+Ч№7ЭшTЗ]Кh7ВШ!­A;nВу&;nВу&;nтЪГЂ#эцyќ~И^ў6ШнњшеэПуЊ`lєі`пшИ;и'8Y.›фВI.›фВI.›фВI.›фВI.›фВIлхБ]лхБ]лхБ]лхБ]лхБ]лхЏ]ўкхЏ]ўкхЏ]ўкхЏ]ўкхЏ]ўкхЏ]ўкхЏ§ПјЫl+5ZЉбZz§еЎž‘• D‚ J$(‘ЛnЙы–ЛnЙы–ЏоХ3дПњZ8C"ђ”ШS"O‰<%ђ”ШS"O‰<%ђ”ШS\м)њ6бЗ‰ОMєmЂo}›шГЂЯŠ>+њЌшГ\М•‹ЗR!K…,ВTШR!K…,ВTШR!K…,ВTШR!ћ_дyŠ )*ЄЈА… TшЄB':ЉаЩХяяђŽzIиІKmх…6нi+gvЃŸ(њ‰ЂŸ(њ‰ЂŸ(њ‰ЂŸ(њ‰ЂŸ(њ‰ЂПGєГE?[єГE?[єГE?[єГD?KєГD?KєГDПJєЋD_%њ*бW‰ОJєUЂЏ}•шЋD_%њ*бW‰ОJєUЂџPєŠўCб(њE_xNУб‘œ|‘о:Ъї—ƒхѓЂвщ\58X^/*н™ЮU‡їЋУћесѓЂ}Р‰х›бкpjtUјзh]№У`б7ŠОQєЂo}ЃшEп(њFб7ŠОQєk>~v…]4X=nіГ7kgКYІ›eКYІ›eКYІ›eКYІ›eКYІ›х6ЎЅсZЎЅсZЎЅсZ6аА† 4l aƒџbХПќOŠа№~@Уhј ЇѓвА–†+Eё5іЄс™4м†? aOžIУнiјQ>$Ъ‡h8† hјmЎЂпХХЧ“E>Yф“E>Yф“E>Yф“E>Yф“E>ЙtFўДGтЛxnЇЛ№›јŸНƒФ.нЃ. чм‹D_'њUЂџv)њcEп[єз–Ђ?VєНE­шŸ§“ХчћЇŸ—џp8UЄSE:UЄSE:UЄSE:EЄSD:EЄSD:eЇgБЮщ ‘Ющ ‘Ющ ‘Ющ ‘Ющ ‘Ющ ‘ЮјДг ˆіQ]!š§DS8з^!ŠƒSE1^уE1^уE1^уE1^уE1^ухьGŸњЪтТ"Y ’"Y ’rЖLЮ–‰ЄZ$е"ЉIЕHЊER-’j‘T‹ЄZ$е"ЉIЕHЊEВ]$лEВ]$лEВ]$лџЁ{_шd52\*Ћхя„вйєlбэ}ЅГщй",тћфя>љЛ{%њзИїTю­цоЃ‚с”шЄD'%:)бI‰NJtRЂ“”шЄDЁызSЁž ѕTЈЇB=ъ?хМкK>{QЁž ѕTЈЇB=ъЉPO…z*дSЁž ѕTЈЇB=ъuѓМnžзЭѓКy^7Яяъ/"&кcE:L”ЧŠьНрЛe‡ашP†Уё%/уH…a8У1Чр+ј*ŽХq8'рDœ„“q О†ЏуT|Їс›8пТ8пЦYјЮЦ98…O1ќ žТя№4žСяё<‹ч№<^Р‹˜„—№2ўˆW№*&c ^УŸ0г0…х.|VтЬХтіЗИ}Фэ#nqћˆлGм>ті/ћ\ИВlєЧž€Н0ƒА7уѓстВ/†KЪіХ~‚§1р@„ƒёџћЛт|7œWvЮЧј.пH\„QИcТ:9Њ“Ѓ:9Њ“Ѓ:9Њ“Ѓ:9Њ“Ѓ:9Њ“Ѓ:9Њ+Лп˜‡Т&Ўnтъ&Ўnтъ&Ўnтъ&Ўn*›є+{7Ј(›ƒЙ˜‡*,с…X„j,Цпзі…гŽ ^:{W–Юм•юA‹ŠЏ9z&§KpLє]>Саh2И К1шm >нфП[‚бVwс6?kŽ .(~Bmхш єD/єF }а…ЯБн§Б'`/ Ф ьС(|вmсsnїХ~‚§1р@„ƒqЁkGт"ŒТХ(|:юmИwрNм…Л1ї`юХ/qёuАIН"ЉW$ѕŠЄ^‘д+’zERЏHъIН"ЉW$ѕŠЄ^‘д+’zERЏHъIН"ЉW$ѕŠЄ^‘д+’zERЏHъIН"Iљ>”џхћPў[”—тЃГ‚§ƒ‹ŠŸBE9z =б НCєУ?џЏЉтgя‹§0ћc(Р8>я8иГь<œ №=\hќH\„QИ…ЯCО Зум‰ЛрLFсN wRИ“ТюЄpъыJб yxЧЋ/(Н*№‚Тg6?)<Я`PюїНŠ›.+ОцюЬ`7НБЏоиWoьЋ7іећъ}ѕЦОzc_НБЏоизШƒ<пШƒ<П8r#ї1r#ї1r#ї1r#ї1r#ї1r€‘?5r€‘?-Žьgd?#ћйЯШ~Fі3ВŸ‘§Œьgd?#*ž/ѓеЉё3эі тпИvŒQдрАТП #‹Ÿ`E9z =б НCєCсsЎї@ь‰и 1{c0 Ÿ„]јь}Б†` Х8с`\шк‘ИЃp1 Ÿž}nЧИwсnŒХ=‡{ёKмoЬCМѕ0СD<ŠЧ№8~]є]Žяr|—уЛпхј.Чw9ОЫё]Žяr|—уЛпхј.Чw9ОЫё]Žяr|—уЛпхј.Чw9ОЫё]Žяr…OћVЭг‚=œђХOњžƒЙ˜‡*ЬwЗ\р„Ж‹PХЈбе—`)–ўўч<лC-ЦдbL-ЦдbL-Ц‚ѓŠŸE9z =б НCєCсЦї@ь‰и 1{c0 ŸA^јђ}Б†` Х8с`>Ѓќ<œ №=\ˆ‘ИЃp1 Ÿb~nЧИwсnŒХ=‡{ёKмoЬѓЮCю|{?}цbЊА‹; П[|Fь%СxўR№ОПT†ц+Єœ/RЮ)ч‹”ѓEЪљ"х|‘rОH9_Єœ/RЮ)ч‹”ѓEЪљ"х|‘rОH9_Єœ/RЮ)ч‹”ѓEЪљ"х|‘rОH9_Єœ/RЮ)ч‹”ѓEЪљ"х|‘rОH9_Єœ/RЮ)ч‹”ѓEЪљ"х|‘rО(xЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[yЖ•g[9uУЇœ\лvѕь NMsjšSгœšvrmŠ^E|!EMP4AбEMP4AбEMP4AбEMP4AбEMP4AбEMP4AбEMP4AбEMP4AбEMP4AбEMP4AбТЛ[&(š h‚Ђ Š&(š h‚Ђ Š&(š h‚Ђ Š&(š h‚Ђ Š&(š h‚Ђ Š&(š h‚Ђ Š&(šа2TMьђљ.ѓ§|Я‘Ѕj3U›ЉкLеfЊ.ЇъђрзЊ=ЁкЊ=ЁкЊ=ЁкЊ=ЁкЊ=ЁкЊ=ёNW…W:wЈіеоЁк;T{‡jяPэЊНCЕwЈіŽВCTзЁ8 ‡уK8_Ц‘8 Уp4†cŽСW№U‹уpу{"ўГЌхЎZюЊхЎZюЊхЎZюЊхЎZюЊхЎZюЊuЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™уЎ weИ+У]юЪpW-wеrW-wеrW-w­фЎ•мЕ’ЛVrзJюZЩ]+Йk%w­фЎ•мЕ’ЛVrW-wЕqWwЕqWwЕqWwЕqW›^sЪLяђнOјљB,B5Ÿ Txєѓ… _фј0љЮП93М:rVxuєьpnєB™FпЕ№9SJŸs0…RAŸШQa[dОŠSpFИТшХF/ŽœЎтЄuF6еьцъWwИ:gНѕFtXs}ф<_GљйЅОП•јUИ&r_ИЦ:›‚˜‘Y#ГF5•5ЊЩ\БA GˆсW..ЎбьЪfkдЛВйŽjьh‰-‰у оAЁєОв§Jя+н/шeюIцd“эbВ]LЖЦlkЬ.>ЎПЙG›{ДЙ“цmюМЙЛЭнmюТžуЎŽG/ќkwtд_ГЅП6Yњkг‘ЅgЭ+Ює3§Рš‹Ьєы.Šœќ3œc†sJЏнМПєœˆУJяH1МєŽУKяHqq№93]cІkьЉлl ЭvйšщЧfњБ™њšщa3нhІўfйз ћšс63мє4jžѓŒXmФjWєwEПьN.jtEF‡/FЎ ќWЁ2ьњ;мЪoгѓVўxлшny;'Fa4_\Щ?СUјЉu. пџФeЎoГ—ѓфіRЙН•C^ZќћдA~[ЫЃчљщЈ№=Г嘭Цl5fЋ1лЛ—знJyн­8ѓzqœN36alои§аи]ol/cћP9V|СeО^kАуп—чGпm_ эkadt№{[hдПSvesF5zPщЏqƒŠџ†{UјыТПNї}ЕЛ?™aЧшc^VzMџщХ‘;FM4Ъ§неK\НФеKќv/ПнЫoудьћЦp[ф&ўєˆŒг‘Чдаa*ђЄКŒјэіШи0”љџmђp“ъњЙШoЦиА.2Ю,їšхА%ђИ>~`ф~z­ЙЎУ fИ‰ЯЧ„›ЬП1ђh˜‰xtУЛзRќ:мрЇ?wхЭИ=\Йwт.Œ іŠŒ ЇDtнCсћ‘‡ё&т‰pІЕfхvЙЮU+]Е!ђxИХОЧ†і”ЗуkУ­Vйj…эV(DГCsšsEЮ,[ЭВеŽoДЫB|cŒНЭ.ЧъуќьAй~<ЬŸ7з,sЭВуW.4gвœЩШ-ў{LиjTЇ:Dа!‚tXя#ыЭВо,ыm‰LˆЄ^$ѕ"ЉI=Mjш>п^ъьЅ.иЧJMVjВR—}ЭБZЦ VhЗBк i+Є­ЖЯОі9е*Vщˆ8§SКХО_ЕR‹•ZЌдbЅ+ЅЌДE,œ=У1BЯ=ж]ї„pzд}і“O:|.zQаЗє:ЄЃtњзtиЃtњзєЄwЎчФ6sЈ?7\%ŠnQt‹b[dЁЏ‹нЯ—ъfЋDYчыjД№pЋ,fе_ŽћѓиnСћvџОнПЌУ&эВЫ.ЛьВ+ъ4g‡‰`явЊ єлjеzЋІЌšВъ‡VнhеИUы­кeеzЋж[-gЕNЋuZЉгJVъДЪ6Ћd­’ЕJж ЉрgVјqфх№VЋlМОљs8&2oы Г№.цшž Т"‹ЙЇжЏRэё№G‘їТЗ" XƒFЌХК№ŠШz_ЎK†3"}п„Mh nˆД†OGк|пŽŽ№ЦHЪз42N ›БХїш GFКuŠœѓиžLЛљ‘ќюC|ОљЋЏЁ –!‚h83~эсћŠpB4цLаЧї}їћ…uбнУkЂŸУшсЮС9#8g„\ŒŽ~>М>Кп}ћ?Žёu ‹€§ў џ}0 ‡rкашaОџŽї~9<•вЯRњ&JпDщ›Июt9§Mє+Ўљ*Ž ˆчыё8!|3zЂЏ'сdg–SьуkОџzxiщYынCŸqНвx?wп§ЂЃ‹чwƒУeiƒ,mЅ ќБa'ЌхfоˆЫиоˆѓFœЪЭTnІn3ŸЌЃюZъЎЅnE“ќВŽ‚Э<ГŽgжQ­•B›)Д™B›EМYФ›EКY” Q&E™eR”‘ЅEДVzcp‚К:I=­SKы‚ƒљ,Ч_-ќеbчuv^gч+ьМPG5%7ЏЖуКR­Жые|ѓE;oАѓ;ЏЕлEvлlЇ vИQ›ьВж.kэВVоњШWГ|5лqмŽуvМЊTgяйё{vќžЏ*д™нж‡иб;ZbG‹ьЈйŽо(UuвŽ–иMвn’vГЇнДлMЛнl уz:6гБЙдЃтtЌЗЛv:жгБžЗ–њTв.“v™ДЫОv—ДЛЄн-ЗЛuvЗТюVин Л{ŸžvИР“юlЯЉђТЮцЉе*,Tх‹э`ЉNАЪЎЮзесFUкт„ИoсsVщЄћVКчшž3f;_5ђS“sбs”“ёёsУk?щб 1‡Oњ‹<>'Я9o<ч„ћ2E&sЮn{нžўьПgb.цQЄ ЉЗинiiјNd…оЗ#Їяиу;њGFЏhг2ъ4#‡+фЌAЮьЏоўъƒЁVzаJwX)љ7нiЎЛй<їБ*,єЛХah•юRьЖBЗ&[ašŽГм*ѓ­2п*?њ› ЏГтuЊК].r‘‹EэiЎ Яf7Уhљ.-PЄХ#” ќHv?’н(§Uїњ‚–sE8OФUh *фs‹|n‘Я-Х^{ЇhЩl‘<"’GИn9з-7ї‚ШKн;JНЖВдk+ѕкJНЖRЏ­Єќ ”?ƒђgPў Нvœ^{“^[ЉзVв№bНЖRЏ­”•гeхtYљО^[ЉзVЪЮщВsК^[ЉзVЪв7єкS5ЏRљN*пIх;eюlНvМ^[ЉзVЊ ЛєкJНЖR%нЎзVъЕ•zэПШ№zmЅ,о#qdщYњЏЪіMzэоzэоzэ2Ні•р йћ‘ь]+{’Ныdя:й[%{ЋŠ]lŽJ\VЩ\ЛЬ­’ЙM2wНЬеШ\ЬеШ\ЬеШмƒ2W#kяШZЌеШZЌ§‹ЌН.k5ВV#kOШZЌеШкВі†ЌеШZЌM‘ЕEњOVЦо‘БЄŒеШXlеШVlеШVl­­7dЋFЖЊeы йЊ‘­ЗekЅlЭ”­™В5SЖfЪж7eыAйzPЖ”­wdklЭ”­™Вu™lЭ”­™ВuЉl]*[SdkІlЭ”­_ЩжЏdkІlЭ”­ёВU%[›dЋQЖeЋQЖ“­•В5SЖfЯfЧљz/SчЪдl™*Мўё+ВГ,8Hv^’WtŠZ=i‹,-•Ѕ—dщ%™IЋЬWTцj•ЙZט-K)уu})%S­КЦыКЦы2іœьTЉЉV™X*ѓ(W Е‘ ђ&ЕПŠŠѕПJ§ЏЂц<ŠНJ‰W)ёЊ]^Бp~сžШ#+xdд№ЧŸ­М‘?VШѕЉrк(ЇrЙи*я[eЙU–ЫчŒHсUŒGвхtъщk/єеЇњЙЋ Єй ь}ƒ/б>Oѓš7ањ=:7бy —аy ыhћž ˆгrЅѓz‹ЛOс>9"ќайrё|љ =AЁ'(4Ч>я Т6ћzСОІйз4бЗ•Ю “эiВ=Mіˆ`n8оШyFЮaоШ FН§ЩЩ}ЧqнЧЇ #2њєft™/ОьЪљЎœ/юuЎ~Хе“ФнeФ$#&9G'\uJЩЩKл0‘U„mЎZтЊ%ю Е пsU“Ћš\еbОТ9xЙ+Л]Йм•ЫнСу|БШ№ФftyВ лuђм­ЫУеF5ЪяKђ9“ыъЙЎpošQ|&UсYTїэa†n3t›ЁЛtXo§ѕfk+žTЎ)/ЎПЩњ›JЏt;вуЃнWымWыŠЊД™ЅЭ,я›Ѕб,fщ0Ыћf٘хMГт}г,oR%уЗ›Бу<їAAПт™Пм}Ћtю—нИпєЫИb3vьВsЇSK‡˜WЙЦШФМХш5FЏ ""-ќ]nИЧ’qwЕѓl7s,ь vћф.žPaХ\Ў0ы:ГЎsе3Nз{КKкO7уєhсѓa #ЋŒќГ‘FОidѓЧZ lgПё&§ЯЃћП{LZx ]oуЗГ՘vcкKЋ2Vj5.c\Іљ_Ќ2п wЊЕU"~еˆ\БЖbХПVнSЪю{V]ќ{\aєkХ^асQUFŸиŒ.]}[б)ktЈ7њъвпК–}qёпњНЮш"\ЂЯЏ6Ы;v‘Чv§ pЇнЁЪ8WŽуЗђлх3kG9sцсяМ2ищ№H “ЏЃ1Ч„лє‰Кџ`k}|F;’оУФ4†у˜тkѕZ яHФ\vѕVWЇ]veо•yWцKnлtЩЭСЫ"с‚В(Ъбш‰^шњ Ÿѕћz; |Jїkз§кuПv+LБТ0­Жъ€­:р&}­YЇkЗJš’ЯRђйтГ Яќ-дь^њhwt€(ЊAи‡Ј›CqŽ4г0N:У1ТЯŽ vзG ›ЬžRЧN С0‘з‹М^Oрє8и)r(…ињя/БЗЫТvZѕuѕ@Ъ Тој кŠkžръSЈклм™тп †:Ї€a~s4†уk>чВ—+:KїXцЗЫќvYiХ‡­јpагoг“сB6>юB…U–š#k•zЋдя|†5Oa?MA™нeƒ=Ѓ§|7 |кўгіŸЖџДqoї†ШГ;e$%–vqЄeЄ№šШ?ЪШeЄПŒўі0гŸў.ЗГЬ4ЫL]fъ6SЗ™ЖšЉЋ”лmfZlІХЯTЬРћпdє{FПgtЎєШogO7‰cЛВшД?{уŠ#<юоё(р§Ђ&kЭЗж|kЭ—1п*ѓ­4пJѓ­ф‰ЖтsL‡Fџ5œ\>ќ?Цuс3С-tППРм†dјDАMш,ОgлCСv|€ёQјPй!сђВCqЧ—рБbй—q$ŽТ0сc№|Чт8p"NТЩ8_Узq*Ог№MœŽoс œ‰oу,|gуœ‹бС Вйс;eя†3Ъц`.цЁ ТЗЫbЊБX‡9 ш. і—{a с`‚CqЧYјЮЦ98пХy8`$.ЦхсSŠтOQќЖрњ№ЗС И7счИХIтVќcp vxё(Ууx/b^ТЫЈЦbд` –b–cœ€ЫУ[щp+nЅУ tИ’WвсJ:\I‡+ƒ›ЭpKXI‹JZT‒•СнСюСXмƒqИПФЏpюЧ˜|1xЩ№‘н"В[DіЈШ&‰l’Ш&‰l’Ш&[эx[8FtcD7FtcD7Іь?ТКВпр)ќOуќРГxЯуМˆIx /уxЏb2Ір5ќ S1 гУКШQюуУ<Ісы)8#М5rІGngс<џ=кcђ+УЋ"?СUсUЅООєяРзGЏїhщž–=Ђ+‚б•Сhѓцj;щtКQ?m ‰6ћКЉ№ЎrОЖыC‘ш2W'eЄ№]с%ƒ‚ЌŒі•бО2кWFћЪh_њє•О2кЗјП~и §У•в RTJƒJiP) *ЅAЅ4Ј”•в RdOйпѓ3НwѕхсœrЇ\ќ_gЊбИ?СUЈФOё3\kp-Ў Gsее\u5W]ЭUWsееuGЦQЇqдiuGХ8*ЦQ1ŽŠqTŒЃbуЈGХ8Њ№дjАQ 6ЊСF5иЈе`ЃlTƒjАQ 6rп`юЌгj1­гj1­гj1­гj1­гj1­гj1­ Ÿ{ Ч^УБз|ЦїŽў5wПРн/pї м§wПРй7sіЭœ}3gпЬй7ыйq=;ЎgЧѕьИžзГуzv\ЯŽыйq=;ЎgЧѕьИžзГуzv\ЯŽыйq=;ЎgЧѕьИžзГуzv\ЯŽыйq=;ЎgЧѕьИžзГуzv\ЯŽыйq=;ЎgЧѕьИžзГуzv\ЯŽ—}7XvЮЧјўЗоrv8ЭНт-їŠЗм+оrЏxЫНт-їŠiюгм+ІЙWLsЏ˜VVФЪ<І+[Še…чH8уУžЭqŠЏ;žбqЛŠ>GEŸSЌшK=šЙЃUјN•Љ,ОЦѓ$е}Ѕъ>Iu_щмё`є:иџЮ‰Ю v‹ОЋ,svYс4Б2ЄвлTz4Zя,ГЃк{ЈіŠŸОзцчэКсœ <ќ^аш‰^шњ /њa7ьž ‚UpЃ nTС*И18ž›NРgЊррврGј1Ў Ž ЎWI7рFм„Ÿњ|pxp+~1И w‡п ЦтŒУНџЩмyРGUЅaџ”›JB $†zŸ" šŠ…„*ˆДZL H" J‘ja-TФˆF@:ŠŠ$Д€HЈ‘ЂвaюїП'ЃЫКюZvїћ>цїМ'їогЯлž!3SС40ЬЯьцџцГєПё7)эХbиџљьY ьЛРnАь9`ШЧDgQ СЂјџјИ.ЫрЊЈ*ЎырИ)ЊТВс鹇lјC6ќ!ў Ш†?dУВс鹇lYЪ~CоJƒ2 ”a (ТA{БŒВп•A4Јb@ePTе@uаб^!;Ю  ш рђ!аР;фУ ш ћ‰.2QŒ–§Хн2I4—Dw9ж^'ЧЇС3`<˜&‚IрY0LSС њšiя–/—С+рU0 Ь†ЛьnЊhfQq”m)л‹ъ>Q[=:й=А’cXЩ1•,RŠ*Є‚Ёмѓў^ЙurыжzНToВ;шЃіWФБP]@6qNvJDшгФЧ3і%.,Яс|A рќAA ”!ž=ФИ ФИ ФИ ФИ ФИ ФИ XH&’‰…db!™XH&2 ‡…db!™XH&’‰…db!™XH&’‰…db!™XH&‚…„`!!XB0–Œ%c СXB0–@|Я‚Щ` ˜ Іщ`xМрй*fк{А†Ќ!kHСRА†Ќ!EЬцй0М^ РBАМо‹С№XJ&і6xМ ояsX>+С‡р# >ЋРjА|жкБК‰b=?oС&АlŸ­рs№pƒmрK№иЮИ_ƒ dƒ`и і€Н ьћiѓ Шхч”AјфлkФ!p|Ž€Ѓр*™Ю5pм7…–›‚хІ`Й)Xn –›‚хІ`Й)Xn –›‚хІ`Й)Xn*–›ŠхІbЙЉXn*–›ŠхІbЙЉXn*–›ŠхІaЙiXn–›†хІaЙiXn–›†хІaЙiXn–›ŽхІcЙщXn:–›ŽхІaЙiXn–›†хІЩоЬЕhщ§› БокXomЌЗ•dя•ЩhўHЪQрq0<Ц€ЇРXц5< žуС0LЯ‚Щ` ˜ І™п…L“ЯQ>^/‚™іDЌ~"V?ЋŸˆеOФъ'bѕБњ‰ruVƒ5рАЌыСАl›СЛ8\H.$‡ ‰У…вљэOъœY ьДOрaё0x˜ux˜@<Ь:лrљrљrљrљсБ л^(іBNєaђУlNu6ЇњЄоуёpЊopЊї‘+Ўтdчdч‰ѓ0Нp˜^8L/œЬ%Ÿг '# ‡щ…УяТ‰?с0НpbS#"a!‘АHXH$,$ ‰„АKPдЕA3л‹ ю#ю#ю#ю#ю#ю#ю#ю#ю#ю#юƒэЕ†эЕ†эЕ†эхУіђa{љАН|и^>l/Ж—лЫ‡эхУіђa{љАНжАНСАНСАНСАНСАНСоП[ЦWЦWЦWЦWЦ у‹„ёEТј"a|‘0ОH_$Œ/Ц у‹/ˆњhє4њ}>‚FAЃќ‹oЙnыkˆЦфЂ1ЙhL.“‹ЦфЂ1ЙhL.“‹ЦфЂ1ЙhL.“‹ІфЂ}б€Оh@_Xп!Xп!Xп!Xп!Xп!Xп!Xп!Xп!Xп!Xп!Xп!ДхДeк2m„Ж B[‰+0эЋvCДЅ!квmiˆЖ4”JјJ ,р|A рќAСЮgЌˆ*@gаР`aYАА,XX,, – Ы‚…eСТВ`aYАА,XX,, – Ы‚…eСТВ`aYАА,XX,, – Ы‚…eСТВ`aYАА,МџXМџXМџXМџXМџXМџX<џ<џ<џ<џ<џ˜п`aсААлaaсxџ\XX8о?v,Ќ),ЌЉъ3ы$Ђ‰ЙD‚\˜X2L,&–K *фЊaBЋїD9ЕB(ѕ хZАеюЏ>З?R_€mіѕЕІ‰;дEил%ђкЫрІн[‡Š]п~KЧкЫtа4БWш "WŸhђ!VКMя"jь%АЬaq>XІ‡ш’“{вЫфДї}M”9ЁOaNsџŒ§=\Ъ"*ј_PјA%AˆНžќ4ќ4шД’шД’шД’шД’шД’шД’шД’шД’шД’шДvЕѕчoŒћ“ŸЫ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ#Ъ'Ъ'Ъ'Ъ'Ъ'gЩ'gЩ'gЩ'gЩ'gЩ'gЩ'gЩ'gЩ'gЩ'gЩ'gЩ'gЩ'79@nr€мфЙЩr“ф&ШM› _XIОА’\a%ьуr‚ƒфaн8‘"т§ b§JNЁˆXŸ@ЌПЁ/yNъЫ0+v }еsY_ѓфщыЖЏОс9ЁoкqкУ}лЗ|<'-_ЛUТ.aљy.[ўž<+РіЕ='Ќ ;Ю ц~InB ^‰Ї>­ї‰zкљћƒэё`ѓё`ѓё`ѓё`ѓё`ѓБьƒXіA,ћ –}Ы>јџ§wl9Ÿ‰q›П,P„aСEXp\„UЮС*ч`{БРНXр^ЕФ>i~#ЂјџЪ`YGАЈ\,gОо)*пОУjžŠ“Y†]LЧтж‰ІzНш­7‹Fz‹(Oн5њ3ипVQ]g‹xкХынXЯбRяЅuŽh@‡БМ(сЇrї˜Ј…НХcoеєIq§~ц}ПД6#}jПO§—Э˜+yі(VЙ^”фоW\э4>ѓŸОB&‹8NvЇˆхT›3ТƒшЯ}ŒW|'эКЬн6hзzДыДљŸ3B2Ъ1ЩUKѓўl9ъVe<чЏŸuЉQЋ"Žе„ђ,Šu9Ÿѕщagщ бŒЙ~fЕ *ю|Щездоhч“Ыžу*ŸЋTЬе5ЎОЅЩтШтШтШтШтШтШтШтш)Žl Žl NweuOr‰> •5­'пиB~ќ)ОТЯєЛЮў‰ЛљŒx\of‡З`IŸкЋЩ Я0Я цПŽ>6R‹™1Я`QZю•хnсb}˜s[н“ZХпQз|?DЊ§ЉѓY=Ъ>Њg‰ЦzЖИ“qЮrUБвVSбРj&\ЌьE‹(ЦiФЮgˆhFњопŒЬ…ŒАMїЂuoъїЃLЄЬрфwйШ›ŠШ™Ўšsн/ќhEЬЄ…S;ŒšaдєЇцYjœcGŽaЉјЂї чSYfџсZфbEœPVНлє—УnяЃ}:žž>Лй'пsЄE-4Д„ЉНЯў‰|ыж>{Ёї§РPцžAйi_`єsЬѓ,Ї_–О/въ њ Єп+ШnьQ–gГу;ЉБ‹йьfЧї0ї}єP<‹шo7юіА/™яыwОЋO2D8-§™‘/-/бђ-ƒЫуЌš–зџ_їŠPЎŠъ0шъ0шъ0шъ0шъєќ0=Лt/ЌАЗшЋћQ&R…wŒ`>ЃьХњ)Юu–hТy6gЧv1b3ГЗ{ьзЭh9і~є;”ЬѕšїŒАн˜CіДшэ|“>e"e†ЈРМыђcОЬѕ„ўF”2ЇОŸбЂ€hQ@‹ ДhBэRŒyмœќћ:у^Ёei•cОУОјSMбоO5Eы‘x‹Ѓ"Op{ Рc„у1nУl@чŠїџ Е4wЮБнјЉ‡бMѓMG:SŸvœyŸdФSіYЃпбЎ€vєюGЯŠ'™џћйёВу dМЈyучoXЄv SћЇ|œ:СœN‘ѓŸІ—3vњ[Юœђ.ѓ§К=™WЮŒGтчŽВЧЧ8сДгЌt’ѕŸВw8я™™БЏ3іuЦОю]YбЯП3M/Š^j1~)zЙL/zqО“ЬŽ0…ž Š`#к‰'СS`,'кбkНжё~яh'яїvТцпfЇ>bЇ6Ђ'ла“ћа“ѕ{іп˜їзxУjХ#тOкб‘fшH3ЋyЕ=_ђžђž2ћхЌє”ѓЩFjЌ`ьЅоZaоZaŒ}–š г?хќuiъйJЌџžиўБќ{bїwV O!чъ9Ынsм9gеА[вkЊчОФ~\Їѕ ьыІmљи—‰ћWЌ@ћ'jfSѓгіSžюцЮnю˜Жgѕ5ЦЛЮЪnкћШ!<й9m=дкGЎрЁfЖъ9Ю(ВŸ˜Y‘ОJyQo Х-o0Њ‡ьу'f\dљQ0‹@юїtƒ\D;RЩ[. I/чшХC/Жv~УЬлWHZŸЃЕ‡ж6-OzчPгй'ЯLцp”ж•iGыK–jf}Л‰fxˆkЖ}“ЙЅЗЪє–Go—,;ЧЌ*аЮЕ‚D)2Ёгє|“9-w"‰­шё ѓШзЁhu…Бѓ­`~ЎaWrjxvRуу9;u'шгйЅƒєЧ§ѕyqњоsЂѕяœЉkЮ…КПsЌё?<|кŸм,§ПМяЌё_ьЗyђ›ћ,JZЁТп*ЫќЪ‹ЋНEа&’Иy;?GёЌ"ЯbxV…ыЊ<ЋЦГъјЫ c„žFSVхL‚ЌPЎЪкg­rŒ_"Щщ+ŠћЙ_‰ћUИ_•ћєУ)8Е‘#М5œ‘œОJ3/ХгB+Œ;х@yХќJSГ>Ѓ˜Ÿb~ŠV…V4Я+юWЁNUюUучъЌН$Нф3Wg…Ъ gЎ„ЗЇu>ѓwVЈЌЪ<ЋТГтжŠѕ†‚Вш^s.OПXKЇЩXЗ;ытyEžGѓ<†чUИW•чеx^ѕБ ЮІ,§†qЗ(oяgvчЈЩYоЮšЃЈS‘:б<ЏbЈS™:UЈS:е‰.Ю9™}-/B™‡ГcW˜G(ѓdAfocИЎbv№ seЮЉmж^СЛЯХГwvO›uЗ8чЕ!U'АкГьпЏєkЏ/‚џЌnаЪ%Jќ+§рiUQцПЅ#єV‡UџE=Ёu qлЊ+євдYбG_8‰эцџ’Ю˜иќgѕЦxѕ№ъSxв~xœHМZxѕ9Мкн№ъгxŸxЕhМZ3xѕ)L>д\ Я‰ћХ b™H+Ф~Z'6‰9b ЏзХVБ_,Йdи‰ВЌи"#d„8'Ѓd]q^>(;H!dWЉdOй[њЩОr€ ’ЩМJЫT9L–‘#х&чёj&_уu—\РЋЙ|WО'[Ш-rЇŒS.е@&ЈFъNйY5SЭфCЊЅŠ“нU[еN>ЌюQїШGT{ѕ€ьЅ:ЈВŸъЄКШDѕъ!ЈGд#rАъЋњЪ!j€(“е`5XІЈd5LІЊj”ЁFЋ)ђq5M=/ЇЈе,љœšЃцЪWдѕЁœЅ2еr‰кІіЫ5*W“лдIuFюUчдyљњA]–дUu]VЖђЈVZЫ]BЫу:D—–пыP*/ш0]Aў +ъŠђВЎЄcф]EW•зtu]Sоаut]iыњКО’:V7PJ7в•Ѕ›щЛT нBЗTўК•nЅuнFщvК жt‚*ЉЛъъ6нS')ђ=TEыњqЃŸвOЉzœЇjъYzЖЊЅWшЊŽўXЌъъ5zЊЇзъ­ЊОЮжпЈfњЈ>ЃкщKкVё–URѕАB­ЊПеТjЁGS$Э|З єФˆT:xФР1,51c˜˜—]:З‰†џл6П]ч+"D%и{-4ЋеV$ˆnєqŸxD$ŠСоzС0њH#Ъˆкшот.ВюŽш Dяz‰ўh E›тК%‰9З‹Ъ"TдaœЦшчнЂкЊамо"I$ЗUч„бЂyзЮD‹GMЛ2шЛ?y~yQE”Eчя-D+qш,рТR*PјЈRЊ”№UeUYQBUPАЃb„ПЊЁjˆ}#вW9V7С™Ж OЫ ђvёŒЌ!kˆIdЊНФГdЇCХT™&гФtљ˜Ь3фt9]МHЖ:WЬ$#э(^RjЄШT“­RcдБZUуФ5IMkе5EЌSЏЈWФz5[ЭШ'Пu0kМ@vзHќH.зNќФlъˆ2jЁ~P'шAzА~TЇшt=R?ЎŸаcѕT=MOз3єsњy§КГ jZ€“z@?РNХыxЁє=Ph=D' rПЂ„ЮаТOвЃрЃѕhVN6(Щ'ТцыљьЌ6Оуя{хœ‚КK9gSBХЊXЮІБBoTSе”'ЭUsіКjЧ^пЏюgЏ;ВОд.ЯўКдЊ ­лЊћT‚jЁрОџяEMPѕeѕ2z „УЩЂЌŠVДUЩŠБ*[UЌЊV5УоЅ^Ћfіхo™}EЃ9ЉN ЫaНХ5"oЉ}Ы3хќЕ…хАEiеАjНpЦ ЕЪZaV9ЋМnUА"ЌH‡ў2Ў"‹ БJ[eШ‘}­–ŸхoXVl•ДBЌRжmдБищЇ™‚гF‘AЗ„ЖЖZcŠМЕМ^ЊпбЫєњs§…vыmњK§•оЎПж;t–.впыГњœ>Џ/шєњ'}бМЧѕ–~‹пжo3—їѕћœ;љ<ыpЦАœь§—опЂжћ<]Їзы zЃоЄ7ы-њS§™оJНcК@ъуњ„>ЉOщгДsz_Њ—вћ;њz_І—бћњzџ\gб{spzЏ—ќ­^cfЯŽвNxл§ЦШџb­Ю^g™v1ЂЄь&ЛЫ‡eљ"їЈ‘jœšЊ^еѓєЛњ#ЧчШŽВ+r—м….eЈ tiЌы|vшoь0@ЯбsАgƒє‡њC"’—Ф1QLЯІˆЉbš˜.fРzŸ'"М(fŠП‰—ФЫтё*ёa6Ьw.\gОx іЛ@,‹ФтMБX,o;ояˆwХ{т}јђr"ЩbЅјnœ)>Ћˆ+kФ'b- zНи 6e6УЂ?ŸСЃ?_sЖ‰/ХWbЛјZьYD b—и-іˆН"Gь#}з> Š<ё­Ш':п‰#тЈ8& ррЧХ qRœЇХQ$О'rчХёƒј/s‘8v™Е^зФuqCмa;ŽОмYuQ]U78swеC=ЌzТ›{ЉоЊЬЙŸJT§U’Уžе иѓИѓЃ*EЅЊЁj˜JSУеc№тъ ЪSпЊ|uHVпЉ#ъЈ:І TЁ:ЎNИOЉгъŒ*въ{uV:ьY]€=џЈ~Rе%uY]E_Sзе uSy.­ЅУЅЕЅ}Д/|кOћыNКГюпэЅ{ы~:QещIњY=YOб/ыЙњ5Н’s§HgТq?лfыz—о­їшН:Gягћѕ7ж]VsДІlБџ7žќiу™щћёЈ9pъxБ6§ˆШе}t_qај‰oѕp=\фcеуХ!§’~I5кtЬјвc›…FГŽЃ—яŠЦBO =ЅWы5тДБг"ЋЉеŒ“PrgјПбЛдКџ•ЮхџWДюŸѕюgЭћmнћЛі9њїw \dt№џŽЮuєG*YЏSœ!дx Ъ&sЈ!ћШЂЖёF wКD#™B.qЙФбD>EvдNЮ•Џ‹>r•м)’дќг85MЭЏ˜Шў–вЅХRч]#Б\‡щZb…ЎЃы‹­:–la›бК<тY3"oi"`”ЈFўаˆ9НХЫ‘Фѓѓ sЕб{Е‘Ћ|^Юoйе–Е™{=Yƒh"› їЪ{Yъђa‘уЬ!3/ЮцV№"+Нх яеЗмљuQЩdНдЃ&ƒшЌ:caнUwbOе“'НUobџ@5иŸЂRˆ§ЉЧLу|7ы?dаŠ‡щkч=мЩџD.сŒ\ТŒьgFі7#˜‘ЭШAfdчџŽ^їЪН2Gю“ћх72WežќVцЫCђАќN‘Gх1Y хqyBž”ЇфiyFYкВє%}Y_бWѕ5}]па7ЕGлџЩ=‹ЭЗоXэR&;-х0 И…†{DёиЩQ}а7V‰Оѕ%8ч7ьMѓ'kM%:Yk )G‘1•c‰ гф4"gШчD)9SЮЅw\E4pкЛE~Š>Лх6QNю;DИЩ]*˜i"ИЫd0эLsѓkЦ џТžyэцџсЪаœZ&gш‰еќмЬХурлЮуЧn0w?x`(ѓŽ† ж‘ Аž–ВМ_жb5XU]SіФІœВЗljЪ>В™)ћЪЛLйVш”‰В…)ћЫ–ІL’qІ№Kйк”ƒd;S&Ы{L™Š:ešЌ‰%†`ЭŠЋ:ТyŸНžБЭњШ>в…ь+c‘§ddЂlˆь/ёŒurˆœVrОь€| FхMD+б^t=D?1D ЃХ3DЖАБyDЌЅDЇˆF›ˆ<лх{Ќ`Г~п”Нх2Sі‘ЫMйWЎ0e?љЁ)хІь/Wš2I~dЪ2г”хЧІ$˜НXhva‘й…7Ь.Мivс-Г ‹Э.,1ЛАдьТлfо1Л№ЎГ6ууj˜2ž\ЁЄЈ!ˆццНЁ’hV˜йыrfЪ{ы[2ќ—Ÿ†8;iо ’ГЬ^щ0Y нВ,ёCWFsЕљ]” yA^’зqО*HнІТT„ЊЌjОќпфПxrУбўЮјќє ‡њ7<шхєбGЅўтѓрМGfžreѕ?Пs'Мя§ђnXDЪатлЭ\"ћњзšм~ђх`YB-šQ[••”Б._Ÿк%ЕЊр#\‰ОЕ}Ѕ%'мЉЄЕЈ‹Ћ“ЋЮ-w"пŒz&’Cr^ ЂПHi"U  ЅѓrUКЅ3+ДеБЁc%НQЅflnЩљЏ<ѕUЮІ‹уM({и5Aъ.в8+UъоЭсЏ~Оѓ=m/ч mЛФќЫTЅ“?УLRwГ|ЫЈž­cЫКЪ8~e‚КLЯ8bXtлФсcC]Ѕл%ЪЖ9ЂтАQЩЉЉcCшЛe|ЛI|>›ў\­­3*MДqbюi#77Џк”олK•mОpвщЎŸ ћмѓХ§љkKм6;цЉМ–еwG.Zће…у1сyŸgолv^…О‹ЂfєЙxіЉ cпя/_Ми!№аЎ˜‡оy5kХдQ+ЮЎ ўБ УEз‡,ZzWц”Oз+т/ŸчŸыjфы‡Цњј”œЋšЋЪЯз.9ЙќŒŒсЭъзOKJ^oћžЮОзKJjtчі2Rк–ŸЫ—BIсjэмЋh5s5q5^дhQƒЩ.oѓЄЉџаК~БЎмЊ*m[зЃ–бдлЋZAЎ€ŸgЁ§\%›!ЮXрЫ ЙОЭB3—„ЛЪ§ЌпКLPз.­QД&ucыоб№WVЁЧїЇ\=нуГv‘Бгž˜[{жц ЫфўШГVNя1ьА_ЭХ}Омўr™VчрsїVЏ/šЌ,јъхјy91§Ы^ŽЛГRТ№иg.Ьh2%ѓфЩйТГГлЌј*{о­?fХšФж?жЪ>ёе>љыk?лrеыЋщnoњј‹qw-8?лS{я]#"šTПw?6lЛ&Ј^;>Uћ|NnЭЉхјјї™7jъЏэјbџlŽЎ&Зšcї?8h}WнтAЋ§о ЮГ#~з$?ъXЃ}ўо!c&•o7hdяqŸВ0ЉšнЂэkOнжЄTеnщFVOОП6Кзо€Ћ‹"j}пэЁJ‰ЙQyІl;—ПјЮ/DМДКKTЏЇнбзgњнžQё‡Л<ѓцјшзWLэѕІпхBзеГ1w>и& ћАЛтчћЛЗЊѓт:яЩ1?Мљоѓwxя§ЈЯТ)Ч6ЯктйбяjЋ%Е;3ОгАЗj§АzzЉпПј­яЂЩч=yП_АыіэЅЄ\>еc…ѕnЋЙе8љbиВцЧКЄ=АїŽзWЅ И=sVѕ-NПЙ6|жЦП‰­ГВм?•ЬЕЏvивАПыЖ/.fDфМtЈяkбe>|ъюMГ&žxІмФЗЋП<ИЬ=зЗ2ЇЕо1Пг#>3ž~'эЧˆŽUъ§ќ|jЬхѕлУ^§>(cЫЧœ™лЪЇщ3ЏLЫSљ§Хsžœ§схk>жЁоШˆі­ž_нuџу‹fOHJОщПsњљ‘ы§чИz[ЗjѓlЃV>9yг›[gФдНћŽQ^JяuuэёЫTоQА'ЇQНћZ•mвoLї[ƒЮЭк9ќLЫџS­™ЧCЙ§q|0жскeoЦ–HžaћNКe_ЫОŒ5 Ёd&й*’ІЂТ]–d)Ф!J‰В”њY“Kжё{,•ћЋ^їЏћЛЏћЯЬœsц9Я9Яљžїїѓ93у LƒOOdћ{’Џфe™%МЮ*’} Дс/ЙЫmУџs#лoM%ю@€ВјМ…frVE%–ѕЉк’ЫдЦЮ' €§КЗaьBк~иаOw\мe/ЉЈˆ†xКјњЙсрк~и§HA€ыЫœnё иЪе`їж2qo7ѕѓУС5ƒp~žИа <(Ђ$алx2ВШэт?0ЂПLх”udь˜ђœ!Ÿxњ•уіРdfўyQ‡х5тсЌЊЕ™pЕ&™з2eМŸjЙ†NЗ™їЯНПЭŸ˜хVоьц,м+ ђš™ттФхІz)ЗдTБ”.Ѕ}ѕŒжbdНq5…ЫћђХѓІžжŽbЎI=fсTD8Ar” 9ќ.хŽЋrЊ1?’N„#=8УюŽЫєтˆеGOtЭ!6ZЫu›•›n t9Я№–V3•Ъі\јhџв§тHтZiчЉо\о[•ікtYB@9Э™Жrxћ™ЁmnфјlŸЙБ/) јT%’ХІ ;у&lСqл a§)рџП~„ПˆёM*'` ччЏpЫ§QM!ђ2„uожQ&= іH:)6БMi 1їС*y_EЦVч™еЪЪGѓхЭ=зD|дл: ^SŸx…<ЏšЮ‚ѕЊYc3тіlXэвf= 7št/)рi•D‹JнЧитE™]В>šѓBДѕrЮ›љjЫа~!ьZu?ЦdВT7kњАnМ X…#щcˆ{y z(Гg#пPнБY({еj59јадМђ•8лњ…оt‰еWš бћFТFђB†ƒ3 ]^ъфgђёo4йђфМјМфо>ч‡ŽфщB[Ъ*ј№39W1džыю1WзыфЗШСА)Х$Ѕч>ЫЉ№%лТР –bд(dэoЂ$ЙэЙїе$ќSHфAН€BЂQ($jCРƒˆ—‘џŠ|ЮŸ%;РКe7Ќœ=@)€яУВ™B@ГAkŠqѕёѓu§:2†_ьWг”oњУ4…Фж4xwЖИb6ХЧ†1о4№IТДAКM’<ш€ŸЏZW3žk|."КќБо)aiи~НŠp[.T в”GзувV•НєŽLю-;w9“і3s%С4ѕ=ЁЅŽЅ9Џaк;*СŒЏЦјГ+E™ы9СЂq\g‘MСpХХфЭgеЛЃшВ!Zae дяbНХ=‚BДxM*MSЛГКи[xд§i|цˆ­?кR\сеdдjІЮXјmщъœз ЄЁkц5kЄІ…BD‰ѕјШд‘PбТвЌъ ЧеДNхzŒDyьћ§bгqг$ЃЈИфk юс“є+бT'—RќU$sнЎv I§G’’—ЅYTa+™с3ѕыc*‹@!>БŸщpЊ^иhшЗ 8'ШJ**tгЂ ќх‚rˆ.KВk 0П5К”!Б‹k…ќЩ №|Л„ƒЪ(Ш1ƒv]Ђ Р6…ЯІяа˜П ,j€ |лБ/71ц2ќfžККtC=% етœu{шr?9aZїS}Vаз|R1ЗчtїpГЅY^ЯуŽБйŒO–•њ—ˆŒця {ОФЦ60oŠЮЎќЬ…ЛчЌkј;ˆнФKВ IЏзcЏй:hЌ(Іч3GЏžДхL~0ШŸ№СЩTe”іЗ™аЉФЧV."їСŒА!LеXёZ+[eKfG‹УYь|ћ@!С—vУs7o)К‘^ыъЌX‘gXY2ЗдmwvI їіъRљAъ,v…Ќ†"@этгюЬЦ_bu~t6ŒѕžН #z6™|1жz”кіс“оќОЗ'“ŽяYЙу›H#k]f/СЪ ЈeA”ёmaŒСI/эбцq ц‡Š 2ОГO%‹’пpKhPEЙ"€ћ[цБнNѕ‹іП”DјЫ ХЖ™sфЁз]…ФѓН*7vŸ}`НпюCYРbaQЌWE™P8ЌЕ5ћP’НћЛO‹Т7*|ƒ‹gІoЊY^жљ“НI+Ы’ыт–B3*bюnƒnя‰%]h‘/ЅuШcђц endstream endobj 128 0 obj << /Type /Metadata /Subtype /XML /Length 1637 >> stream Calibri UnknownTrueUnknownUnknown endstream endobj 120 0 obj << /Font << /F8 13 0 R /F39 40 0 R >> /XObject << /Im2 104 0 R >> /ProcSet [ /PDF /Text ] >> endobj 131 0 obj << /Length 1512 /Filter /FlateDecode >> stream xкЕšMoл6€яўТN1т7Ел’u@ЛeXз ;Д=(Жв •,Wv—uП~/MRЕ>cƒ*r0-R|^ОЄKbnюWзПЈ EЉ "И …2 ИТ(…ЯћM№6М Г‡2bJi(ŒbЦXxћgDdx fŽяЂ˜Ј0oыІЪЖы 6Pљ*HMU№tlZ3”0х2xГzныDщNG“ЙN 9Eа‰щтІ?VЬJЅ„ž’ijћrЛћr0кџ ‚`т № žRбхC6‡H&б"#&0b.q—HИAJ@ЪEFЉ8’Œv™јз!’&aЖ‘b+Du‰lŒH%"‰XЩ(ЂŠє)֘˜r‰ЩЄj™ь/Ÿ1f*ЅKŒ“%qL hЪ(Б)ё†2hЮ{ѓ‰яF‚иŒ\ˆQt‘Р@§Х1Ђ‚-Ё(§ЩБњ›ЌyŠ@ЕйaNOоlB(Т„tй <-(&І’&™1”?TQDј` 2™v”7“B-ХУЊKљCЅzP9Ѓ)ЈгTЪg<х e‰@IBP1у)(UˆѓtАŽјŒЉ.…ŽH–GŠљ’aёФЦ}Sfk-™O3Šё&ЗŠ9%sШЬДbќ™N1=цмM?д)І•гŠёfЖŠ9ƒщуuŠ9ъуuŠ9ъу mѓ<ДUŒ?д)І хtF1—BGC\‹(†(”Рu`юcЪb]l?ЬЦ›л ц”Kг‚ёg:Сt™‰šŒ?д ІMЇуЭlгKn2#ЈЬѓйmуu‚9ъу mѓ<ДŒ?д цљuд цRшˆ`0†koСРC™HˆЛ‡ЉяЄЬЬё™Љn6зtЦ8оДЦ9 „Р:œ6Ž?гЇЫФlЦ8ўPgœ”OЧ›йЇЧЄ3Цё‡:уœuЦё‡:уœBс7?1Ž7Д5NЪ№ŒqќЁЮ8](ЛЅЙ:4ƒЄq!–0N‚aблИяО”‡Ђ ›?ПЭ)>mZб,РtЂщ2I:-š N4](V“ЂёgЖЂщ1љДh€:бє 3ЯN @hЮШЎ?ДЭѓP'š N4g@­h.†_$ы.`Ж.y‘ѕж„Ÿ~dИXcCюL“UПœќ4(Ј˜*ѕ#UЃ‘Zє Tћ’c,ЋnчФw6OЋAфЕŽ8зŸžъFрYi$pЁ_ЄуЉРaMAр €м”Ob'lЛ>ІcзŸmьњ<І_$?СйІDmЛCSиџ6иЏфи†ddЉ]Ј“€љ•ТdЧ ooЊr§Ž[†Ч’” гcюю\jиXjрў#х“sšЄvNЁp:Ї‰Ю)49Ю)д}›S8yСІДkДpЭnОпыWiІ…Э‰‰Ѕ3 m-ћЯ АheZaзЫ.kВВЬЫю’*ЬђІЬ3]њ'jз ЋlЛеŠдH г ЄF‚Hса>*Е?Аџ_­v- endstream endobj 130 0 obj << /Type /Page /Contents 131 0 R /Resources 129 0 R /MediaBox [0 0 612 792] /Parent 110 0 R >> endobj 105 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (F:/Drivers/GCC/msys/home/Andrew/crc/new13/doc/CRC64-small.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 132 0 R /BBox [0 0 792 612] /Resources << /Font << /F1 133 0 R>> /ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ] >> /Length 24029 /Filter /FlateDecode >> stream xœЌ}[Ы%ЩrнћРќ‡§( М•ї =шbcРr№ƒёг`٘o в‹џО3жZUенгчє™f`њ‹ЬШЌЌЬШИЌŒЌ§њЋџњњыПўЋњЛџђїЏє7ѓњлПџЛW~§ыЯ?ѕќЪuПћxоЅНj­Џџ_?џє/љѓO9еwkЏ’г{–W›у]жЋДўnС’оуѕџьŸ^њы?џќгщѕџМаАжžп}Н~=™ћ=Ѓручрихня  Џњ3šw+7м8f{зvч`СХбrч;‡ n}МгИsАрp|њљЇы™†Ўg3qэљU&&1Фœ<'щb№)yLQT_3ђœЂ‹!&ф9CСpЭЧs‚.†˜ŽЏОшгсkoњ­I+Љ‰+—ѓи;щЋОїМз“ОъЧВП1Јрт8"*Ž’ѓ{м9Мрт8г[лCGoя§рPСХqvЮљыЦЁ‚‹cЏwypЈ 8jоя}ŸO/И8щЦЁ‚‹cœЁпH_ѕы ќ^O:ъ[GЏzбW}9ƒОЯІ\mПзƒCЧ<ƒОЯІ\ЛšИо8T=ЗїКЯІ\uМлƒCG_&ѓ7\БПэƒр8ћрпn‚j=[ьєrdљќcZєПџхыџžѕ~ЇFEZі+Нл‘ŸЃt.ўoTЊџјКvы№§ SЗ§?іK]У„якuхw^ЗэPW‡„§тl[AН‰ЖŘ7AЎЋиH.ЙЕдA’ЪЋK ЁuБЪ%„ЦnBwбЊk’ЁEЦ "cЃкы&!uUЮŒ–Пžт}[§К›^CkkхОЖVА|)џйVЇцГ.§№žiљѕяџЊѕg]*е&ЋtY2ЋоœУ|оoцУџvKњ••џнпкѓ-LhLі™=šЁ‚ПLŒRsН ŽѕЎ›чЏyуаˆH_Я>4Ц#ЩжЭYП>ЉњЯ[TЪvqYЧƒЮЌёХЛdл9bŒ? Џgуй]жЭйЯ‹k3ŽяћvЧ‘яЮWœрˆ1ў€Оž}hŒkЃ›Sж7њ=Џ4кms9ЧщЗp}ЖfЧ9bŒ? Џg#tPCй„лSв’~ШЁЃzmзммјЛ;zv бU(ЋSД3њ,ч Јя(+b8ŽBњЬJП1Ф№~wO4<гЯe4 цLŽŒ);4ј@ЗмoЅsVœ!ЦїћЛzvЁšХ8НЬeКЎOЕї ЉaSь9]  LЭŒsФ@_Я>4F3bгЪшy5ліА=lмФ{cjвФфЇџн§мкs`0Іх&вѕшѕО.‘u†щZ4#ŸmŽппгГOЖ§”1$Љu!†4a>Ќ{геІYqŽсшый‡ЦxмТ]= џk?юƒŽpH Ce7#ц&=lЩшый‡ЦxизОї{и{ПЗЧеявь|1ЦазГŽnYПщџv<‹Л3щ Ёў[вф|nJ~@WЯ.4Bso/о НОx-1Ф{ЗњйЬФwO4УЖcОŽ?tGpјУXD? џŠm>ˆЯ€В+TКљ l"ЂЙgCтИ7лђЊeАкё Б[ЈNєPSgŒgлЭќŽ?”Љ!9qКN!ZщQ " €˜НО †АѕЉЇŠa‚ЉІ‰Ю,н0њЏ-ъЗZ}b(?Х х`№.ПQ§I!ЖU›xѕќh§ ФжГqФ ”Џ=ќЗы?)0ЅIхЋOџУ'ХKш;ПцђЗk?)Іc]_{ђЗ>1ф‚Є^ћZћo0|b<ФˆЗE ОQ§Iс ƒ‘Џ>љ7Ћ?1˜ŽXПœБпЌ§$'ПќіПQџ‰юЗi‡:MП”“oд’clЕ§7Єє[ ŸфЕкž-_њ7ъ?]>Ѕ!u_}њЗ>бхkЌЮэЋэПС№IўиЅмП>ѓпЈџDOi~ЋѕoзЂcЖйОœИпЎў$п•уЋ[ьѕŸhѕMw{ѕўэњO2Щх[џУŸeћв\L}з }х4 ѓtАќє“цјј§4ЅnŽкwkl@Рнч$џТqš2AnŒSžЄ&,Хmёa(г€cQŸЇЇO>DЖ8MЙ2ЦAЫ_ДЌёU k| жјЈщўАЦQрж8Oди(ћqpЪУчАc<вX–ЇэчqРђc\AђљНxNу ОФРзVћЯшябтуŽњ›ГЦPчŽУSxљбО‰g„АSƒоQ№9<ўЇЗ|Жјx с6S<>ВЃў‚ДЃрs№ћ;š>›|<Аnг†<у }ўYœ6сжQ№9М§MŸM> і™"Ž4Ÿ™[„ž…MGСч(іw4}6љxРжG2j;|D‡иЖcЯQ№9J§MŸM> tЦбЩЏL|Zћrd9 >Ч ПЃщГЩЧrОКY1nЕnќхОПщГЩЧPŽnфV‚…ПРїЗ|ЖјИУХW'ѕГAЛўхѓПЛхЃХЧЮ8Мј5куL%96ФtЃрsєїOoљlёё{’о?П†ѓцˆm|Žэ~Gгg“”{u#pѕj%<іЫ|гg“P[Юж$p)шє˜Ќ),•`|ŽЫ~Gгg“ {Ъ*ѓ ŒžVЃг;˜фŸЃЎпбєйфуВžВЛтАgіРС‘в(јS§ŽІЯ&wѕ1‰ФqЭгHўИа(ј 2§Ž–|ќыўщя^Џ[~lV~ьП}#;–qкпўсчŸўъ?ž§ЮGњў№/ЧщzЅѓ_~Эўойђк,(ћУ[Вlлd)Вџу/вјŸЏ?ќуЯ?§УG|1‚ђ#F`k‘\~хљџБќХЛџ‘Qд9–KѓХ8ђAћѓ`qя‘С/‡№ЇLEџSQnœ_ЪDљ#C?p.Ь^ŽЏ сO™‹љчЂ€­з/RџШж5„|ŒмВмЯЄА$gлсyЎљNGсчо Юbщљ8Ы V=PЛpќвё`їy…гЊУв}l-Оsп*ЈЃQZd>^щ/‡љМy^,АкмX›б2wЧF‹Е“5‘З[ПЧZMPu*бяFСZxьnЄ8ˆ‘I‘ЙН‹1љžLD7`­Гр фPчХAePIujœN4Aкˆœ8:е†hŸcчWЗ‡ЊХŸzЈ9Ј3Adц3ze:ЏqЈо­сВ“@ВЖњ<лˆвImЃъš 4сежБ7z:ё8Ј†–5ГпцМeoœчнЉugўrUЯq5счVЦ(иєXzcю‡йV/)?р8#gЯ‚i#Б‚ѓ”lKйcAg6‚tДї)<дQ :dХ Jf˜‹Њл•Ф,омЖшCЄХЇtє‹х4jƒї,@%яYЌC­>9Єfдвъb›еЛZѕhgТNЬc&ыЖл99ћСи+kЯ…ниM}З™YЊлZ *†€7щ–KъМxІEVжUbWC/Ќ:ц4tLЫ$…ш,РФєВI-PЌт2z’&ыfO г=jЕ›xЧ`ѕFOяЗM˜BнжІ_і„†‚ŒъЕEЁчMоТ7А]оQptС2ђкЛІЙIm1зСчvTЗJц#@FAЅ# оојЄ#ыFщ1ЄFoѓ“]mTkg‚ ѓЧЄуЁЖ,ъъPEМ^rdГRЉ^МYpіыТЙ&Јj Ї~sЫ“гЊOPqcюexGdюЋА X5ЅГиђj&2Я*цЩŽjWЅ">ЏќPџПР8˜САљZpv•)(0;.ŸэuK‹Ќ LЗ*cлXЯі@uчtкЋEСУ™{CA&sƒБhže•y 9Я( І …†ѕ­кM]§B„Иk_-TsЏиь'ЬЖѕ&o1ZЊЪ(Љ—iчїЄ™zЛќЎЭu†!г›Ь Ф яж€ЯР­ž`Фжтю.АxЃ›ЂrѓШj­рЎxН3е& X|8ћ\ЯDњˆй>г24ЊBчMMё‘б=ЙѓO›m'œ№ГH{H—л]ЛЕ|5Пlv'N eЏЗЧO#аLYv"x‹-эlW6)I щЪЗЅ ЋdлтPМfŸ-ЖёŽ‹ЭЭа‰Чиs›‰ƒ b.PУ;о&AЫт{яjѓЂЭuм$SвЧOЗn,—Ј:/sЈ&Њ1ѓzP•mчЌи‰ЩDљPгЗmiО‰эiRЛл(gxа ЖоФSІщN,љrŠЬЋЗ[ѕNwцm2ЫŽ~‘зЖјЈ ЩДНQ““ЈцВ–TнQ[CЎVођrоR9oЈ-‹МGњUЭп[8Š ЏнУРДamrкz _!УІRЩ\С<Sс;ŽТž‹ї<*'Н ЏQ9ўМШ,Ъ‡<В №мЭ1ё7ЭЭЊфŽf3Эq$fЃЋf›Ч(ŒЂ i7CЈyУЛћЁ•дФ]ьчRЙ‰šŽ!Q0”ЈЎЙ2‡щГФЁyГMh"=АН1qШtЄpfю€ŽМ&kPŠ­юВžЙЧLFо†ŽlЛ…Эв+Зd­Юlъlк…н3Б№йT(ДШФfз\˜ЖaAГ1вз@:Ц/cНФЛku“€ DŠ;&'кфК­H­nЈЬъ†І ["™fЄ)ZTšJ‡JsC†,+ƒ‹—6пЇC,*еEћ;лvтNЭgЦЈЮY3§g*RuMЗиХХЖ|цбЈcRЌ…Љa%,MЅ…UЦUdЎFЋnТДX6ЧохсkѓДаnЕq^fsQуњ,ѕ5bэlЂ*ЈСЉIйЧ…э•M•‹f/$1 и)% ЕЕИ•8­мЖ6YГ_§т„@5*Ы|ИB@М…o;гуЪ2 х†OђmЃ.I Ж-дўJEaМbTZ1nZ _ЅѓуюЉЋбUeЉ e'ЉLгйKЈFšZЊб їЙљўv‡JгЇЂгfOVУ №јmщЬдсs 't˜1…KТjѓ>Ѕв˜}э`б— xЧ"VH­p‹шSY lG8ФМОСpЗє>›ў–Т ыа( }3gjQ–х5cйЋmєЫwЧsщFOVkO[—)ІdџЫзA’}Iк2vIF}C‘;J’ЋщЉ $ЩКї†’<Кј%Щ ‚їЦнеp+ЎпyаЁ6уNлG–yYаљтМ7n“SаP+˜dƒЈ Zp.D‹Е…Р‡1йCŒ7EЗ ^(Уp б"xьУ­l`cЫЦX ц)АБе 7И`Q?ќBцeŽР‚S^'t›! T'R@хcyyAЎШmEгЊ V3\Z<иа5иKT"eЛoxH˜ѕ>І~+<>МЉ2ёцYнRzZп№„э;%№ Ќ 2ФЏкз`e…K3ЈьjfxUZ3—œ›шP RqоТаГ+„h`’"(аєfщ­аCL|Ь€PV­ѓWŽжу%t%ž3ЙЮ8xВ'нQљ^Жо(гWОёb*ЖыM›'ЗФ”ЧuУgИ-їџnўuбЏ4! ГХЂ^я *ЋІГЊ[х Џ&ѓЦжМ9%цБяеГyj{Gb^20еkъЙFlйЦхМpРbŒ[.ЅR‰”]э>Q&eЕЛƒєїЗћ+й™ {ЎdЎй—w›уэЬеиЃ.AТъWШЈшYіVЕ(ŽЙ1ь^1цІPŽУh54pэдA[ h'ћ*LfМЎQ5fƒŠжz >сЄOжЙи7 'š,ŒЮі–yлв^ПВЋхВкhoЦvцЄmP(шa™БХiѕ|…JvRы*gšLЏnИkс\uИ=Е8АйTXТ(1 Z…Ь}O„{Хп š 3ьoѕ=D^LcЅЏЖ@З5qтŽЙвcHЊ—ЙЦ!cX˜sV/- СЪлd‰0­R ’LŠž q9Ї`iv”{ЅOcЏYG`н,:1иS“o?Аџ фˆ~i-Ќ-Ћ…~4šЊBu˜Ї[ВСWи0НрыiЃхWOГљ_x –КтIЌ5пЌ. U Во‚ЁMW›Œ™УћиўЖ“Ьк<.1м=LХ№%БїЌУзorЮ;ЛyэTшЭ5ˆpє<Џ]_ЬВущЬ+ДEщ-“ЗKOƒVЈ{%Љ]rт€#tЏ`CVZЪF…йeECƒРAЬdЪ—1)ў‚IG%№@7ЪдЄ%/œs(…Ѓ}–;НšMПdбC€]\ъ$ыЙи8sЉеёЂџ#‡ЁКPULzO:cВзЈ›~VЖн цЅзcѕІCБйГеш˜о , ЕХТo˜3›џрэђ0X]Й^ьіd wЃ7nёSgюn(6JУІЇб{уwJ~!s/noе] QчФЗщЊzTњЫ ”ŽК=XАНош\•IQ§ђЈт^P^ЗІfБZœ"iˆ[ пѓ<Б‚mQ\{ŠYсŒЈЖ(ЎCi:ёp /H…ГX­˜Ъd^г U%о1OілП "рaQ'%Ѓн27(0яˆ‹:œI „ЄфЏШˆ–'30ть$…I\љЊ-ѓuцР(ЎЇ…Я›eљоеZнЮP-Щ„•0=ъx‹Dœ“дЋэ•гъa№ЙпWw$4б^Дв LЊ‚}u*ŽMцСp3 zє@0 ˜DeaCšЧ7aW)ХFbСš"‚tœеˆ%D6Кнфm#&ƒx.Іu=цМ\ ЪОF(—”ЏќИWї|oк…O—ќžн9џрЖбYCЏ^0эЛщŸЉтђђ€ёу[FN7 c#žМ0Œ’up`ƒ~‚ЉAЊ€NXaМѓёy_bv4СЎяkM$ЋЁ_žЪБГLhЇАŠJ` w7{0zдžУqrtˆ™дwц=[H4њ[XR%:ЬЅЂЛТД@м „ёƒHчШдvИZoTІЭнd–ZрY* x ;ХЬІ@"В7šХ~0w1г ‚’uЊЏl№С•ƒЊгНЂ<ЌE‚ЬBAguf_: NdžбsbЕ@ 3ˆƒ№Q|ЮІl[ ЃаўМRѕйќQм\ЭКEЂнeњm€\ПЭЯG ,9В SхТ4™F0оIWысi'x›MМGљ>ЄZŒБ@ю$&б ч~ž)І‘:dcž4‚NВП2Џ @@hР‡їщ zпЮ[#НофŒ9aєiJРІжЕ›^„!оQєЪЗВ ЉёVƒbO ЬдR“в7І}‹YE>ђ` ШфЅТiQž“mgЙГ&вР№†/@хf7Co!їЫр ъ fT%r7bѕ‰у‰yВкŒљ@œgyGwJМzkUwЮШфc”zДœW"žŽуBPReФwufd1QUa—!Š‹ošЃлФU*n2Л^уDШZхTzŽSиЈЉƒ(АvмWшРБ‰^ve…; XьAO ˆGЛ}яu&V)Ќщ—N~>3ш!™tp…s‰АЦІ‡2™‚Y 7ДЄЙk•‚М›Ъ-3я­P/VІЖuЦ5#‡ќЮK!уj&dqhіmԘЕߘ ХЌ3y6cэй „tJљАЮ§]Ја|cwБubѕ–оWЮ"‡мzшpщc*тБ}ћТrhjм%mOаѕвDB}’rі0:НЃНNс*з;ћ™^гЙєж+vЉQX%g„ЈV]ПЫМk‹­UЂ`ЧцГ Š{|0HjЊ“2..C]іъЬЏќ€Ю<Й‡€ш—oщ9];єюМ›М№№Wcs9#rЕVePœфW,bьˆT‰ЊYL‡ŒS$sР/{Aтj›ЮU*ЉьQЬRе•О\цњсPБКц—.ЖЯ"њ^DšJ]АфˆЦTZ__Рв*†”ТŽХcуСь‘ьF2)`Ї"ч‰?<_IёюІ4T2—Шn34нЄ?AЄdL.еіž…ЛмюеSMu€ЪчŒщЬ“;_Чћ#,`@†JЬŠa^x0гcGvЌ˜{о:œ…ЦЧŸ…H0›а:dЅ•б6ЁЮЌS+шx,ЧЗgМ‘9‘йнwaв№чШw6…сV ФYѕЩcДЩЇАzbV–­оЅ„!›0. ЂcЅ/2Яь–M‰!f‰вТЇёˆ\–ЭO;шŠHЮdч”1 6їS-эпDС/”пB3г™ бtіиœYњ1ГZюЉ’Є-чrцM›2э !b:уY:ЄŠмЎmЎ1КЉЗSžЂ8eыU€BС[lЙ+щ@˜Ј‡9ГЙB\ЩБп)ЪPЦRБ.d]j6Сњ›TЅ‰„ Х7ЋŸAHгgž№ Z›кSJm ыЂ…ъдсI*N<=%‹SюXgйmв`€ЅEЎ-uіQђ„ЕЫ„Aј‘IЧˆЏf[РеƒЭс :9Ѓ&œ6Маdфxлъ)+nСt*'„0Žш41дŒnРд–OшУЋ1­B:›3|ќфЃјА"‚>‹3ЏHA‚=cЯ•ЇЌ:ЌОИк…YсыЅƒM^вИјъюхQ0r–бЎКвks‘wn 6@ьƒжйГ2R”цЎw zѓЭSЋЉК9ьtŒсљˆDUH:)Ѕt ar-4ИRKžУs„’€З0€Тш˜NЄ7ЬЬЊq:юJУДƒуx‚ŽOЇAŽФЮž-Х{дV <ЄгќЪeГПRл~ЧЃЖќ?Л]мДиэ;<˜‹šЬКajhЫuœо1ЇxЖQ0Їg'ЧIe8ј­feўл‡„Йo/~m.Ў чEяCy)kЙ$ИТ^Œх5#‡e€Т“oPcыp›hЖ `ƒ 9љф†;J*ˆ…jaГАP!рсzM!я“^м ЭЖxМ9§Ъ r€Й!2—КoъЬNЄvX™ЉD#&Ю‘XЬР+дђ5Ь—’и ЧffšdqЩe У!ЎШlвШMeфQ$sH’-“ц-1[ГаšесиЁ[Qe/ОЉСЗRЫtйbњmЎ„жіpaзИЙУРвYюЬ‚EX&RzcIPФГИd( нP+DЋwPC-уAубqr–IeGеФмšУ_FUalZи3ЕQ |‹ƒЬ„~• KљœWЯ>(bX…M/*€ЊѓuЃZН3ЗxСhѓэ9š9 ƒN})чWI˜)yћ…ЬЂпьц'с(нэwЭ–ƒ"m‘dBaЩЫ3%+™“ћхЋЩ3І3 +Xл @ё9ј6FяжssfПMŽZ>ЅoфœЮи4OіSйlБюyђЈЄЩЋ№,qИ~Яs;Џ.wfU+”кwЊФpН@еJЖс( “`hПbЪ—ОсHГXІk7P„(Д‘В0†ѕцŒW*ОйHБхмЮл”nЫЎdLзВГnЧZіс‘˜QКšиГrЮsМТЂ-е8ёіWч–†ЬН”. ‚кйЄ;oIZwоBHЖMT ]qJM‡37!б е­yфjјSБ†Щ П$ZтpKПnW$ОРDA ДЫ rvJЊOL“šБф;ГОБЙъ`ЊбЏnSk ьЫ™;ћъЌж‘Л§№лУ а@й'їіeХ7lёC Дъ$ИЦєLP ‘Щw^ћнП:=MDМё SУ•к„^*žЛ|Ж+b3l#”R@ш;’%eŽb9Œ(ФГьЇ№ъ R5]ЂЋRWрш•к=—p,P‚jДUjwРеІНіл9Ј›ГEqAƒ=ж•‹ІЊВ‚т˜ )AJ*Iocм™Эљэ”цЦЭž4]гUžЫRУ•*ДR^ьВ+TгI•Ё„Ќmg<ЩмЌюЂ2ЈF@{ gЎДj Я*ёzйёzž YA&яdWК'%JР8C$DытЗbдsђдхАА 8dŠJLZBKLZЩg7[ОрRн˜7-{SдFД3&M5М ’p дцеd,*уНHU꧹%˜uiІвWсaчТЙQ н)jŒ**пЏНЩkSSћ.П;`ёЪЈжˆ;жДœwDcЃШŠikОЮ№їВнђ] „bСK—ш§ЯA%'иe„3Ј{ђru|R™ВKI[aЮoиC_Оtын•чšЬА3л™.Ы#Н"э(а3оf0`ndžЄњхОЎЫUT5Й:<dxmqЋЁ)н x'0-о$б?у-|ь`Е ЖбHЉŸьЬ]a‚ЗП^cгЦЙЈбscЯЕ j9^e_ю`Ubј”cЪ'mИ hM-*а…?ž”‚Ђњж~ЉB’aЂ пdО аЗЃІл7уЪд/•FдД+(ЂІСЈьŠšZћЗUє“Еї>ОŒšfœђ ­@XЙ­ЬTиˆя ЂўфNЖSвPЕWe&%ч”kЈФ ^ ТИ”УПŠЇФ6hR€m…б<•AЯHJ^ЫЮœВŸљ—AлСL=Ѓ”qЦУ]+˜ЪGdѕPіZ'ЅєДтЬJЛ"ogэрc[Ъ|ZеЛХ ШŒ—E:в †3W.ХЃЦТRZН_іуGй’[$(Г#{оёŠЦT*&ЛCЈpj™ЖfљIІЅапD„"тl|Œ`сD#:URЧdЕюП/ЮifЈAьЙ0g ‰:šтФљšгјœV„Ъ8s’•ѓC^нСѕIд™BvPыоr•GЧ~šШŠgЗvзђC7™pЅ{FwІŸїиšн[cутФђѕдЄ </3ЉќWШЯ Јќ>пƒгPOЊ/‹к!ЂнБUєВ’.шeЅxѓНк јеЯХС‹Ўю*xYЩГхМXA/+Eшт $К(СGБ ?0цБ cк[ь2Ь2vбaДb—АŒМ)e=)Z™њЬкEх{№тYеНрѓrЗрХўМL]фc№2Л'(xсзшЁЮЖЛиPч=v™КдˆиХˆ0fѓYЌUю”nъЩ5V ’B—щЉŠъИxИ„}8ќ{žє'+ІъF6Я;ЅШe  3rУЯЉaQ˜Р{E.ƒŽš"%w3rБг~\#xE.ƒЈЛ"—1=Qф2”ЇУШE7ЙzНE.CwuЙрS›ЙxJcD.ЪƒUф2ц-?гЈ}\”qЌШeЌˆ[†Ђ‹kq2г–"n‘лtХ-ђœК\дWUябЫф'сН№’ЈG/“wкЎ№Х3фОLІЅ0|QоѕОLFс _fцROwзМ‡/КKЁ№E™vŒ^tпфŠ^fё@iАК^б гЩn!‰вЂО№C _ŒŸёŽˆ^ˆRyєЂы4WєBФЫЃeИ)za6р-zб]F/ќМЂ‡/NEјТO"оТ—Й=@‘a[Щ?Yh(ќ–4љП,<бXЩ-з–нјгТ—лЧІkˆ\сK­ƒ"сЫ&Vе–О#YПТŒыЯћј"|Б_ RvжOY№3>Ÿ5Ј‰7 №ѓ&мЃ+5‹П*„C‚n bT&Qœ7ГП“tQљо’oуKіI.Š‚bг&f‘шЫš лKWЊ*?m5№M*#teŠ 1 TЭ_0йQ JuzPс§ uwТШ;yŒГ ђvдvнттrА†JСh]›ф­ф]њMО‹O9ѓЦ3KŠ)™Ј*/.Ќ KэFсGЃИЏ‡_УПѕUѕг-$њ5ˆЂ-fПІ^Bфf§ОKйМЂЭяќx’кЯFДOOВкŒДQЌухW+(ЌЮdV№sіžQЪчх;8m„NЕ,лЬrK—ц­@_'ЎЈ]Ъ_ ”uЯМ+аMЄЮЎКRН)жЩйqi’YŸi^|ŽцBG|;Ў)mUsШ{]дж%м{ЊUхvѕМп1oMYНуО   „ђPљuЬБу^N#Џ>га9щйЛ:>игs‚Л:Šрr*xЦАtnЬуі*3уŽl_NнлГ_єHК[…K Fщо^uнž/aФˆЄ Ѓt`шfЗѓмЋтsќƒCќYC}ldWЗ ЛjuиДЈЬ„l>}Аѓ‡qšЃВ)г|Vє›‚VўjOржЈAЊDЧ[‡дќ)FЅХѓеВ њс~мфЕ)‹Пв&ˆe8ыp,?сІ,=ЪџnО™xLг5ъ6wЄОЈ2œW$їœВЪg,іJсФЕUы‹iЂЖwѓЫхЌёоЈИЌO‰о­ d\Уo4­w\^ЁW оЌДGњvТЁ ї+RЄУЙЋ‚—*…;€)ѕuI/Џ3/|˜BП‡І‹ ”3=w`‹nЃSГЎиЬГZO§ЪЅnЊ‘ <„‡ЉЋ]ƒ=щ“5МJфя5цBчЖ\ч­фNЙ"†z-ДR(3„rњ:мгвЄKп@рЯ„v}ЛTъ›.х&пlkТ856rc2нfuc‚дEїŸи3L˜ЎmА+ж&>FпЊє™ёiЁЦC%бз5ўЊь$lЗк;Гњ&]u •ІыБk‡•ФбцP ?9LŸNTŠяЅй\Uъђеn!ђТћЕВ~эђ™шн™wLЉяЦЋL0“‘eШќќ˜"я.tўžиЂZА!Ъ‚dоЊ ^­jДVКUiœu “T­`2c?­.HЋѓАЫnЋu/ ЉoПВ@чљјЅ;}vЇйЫЅпБўШ:тяqeЋѓЧmsђІ;ЌŸОЪ“Xэ™MќUСMмЭwюжК ŽйяцХЯ@‡ЋЁtЏЈpпъР,ЭkЫзw№ЪЕ“U­М,жЉKє Гz­Ом5ўzЏ_4—п#Џ4Tщ”“+MуXIЩУЭЁ?ВnyS’†тŸqН_RtЯ@ЧZЌцщYЎз$&Ÿ`џr)&qЫХ‘Pбeи!T%§œмK_9…Lа?hсqcЃvВкФ<3Њў%f8Sz5њYњ@ШтЏ—%нЬю”)ЉS–umвTоЬ\Нc9ЯЕєЋg~=…X‚]xfA4EПpЉя:кЏЫђc"9‘ІYп ŒИ˜MhJUЂlСѕ іЄЯ٘D•ъПBЁИ^9“Пћ[tn…Гќ'™хд•ъ_B6KW49#ZЬ*Zъќž“.Jšlи‹Sbmёх^™ѕ‰!‰un~ТдѕCдЫuфк^ $$S1њrZЃПд”rZnDЕљ&Y™Л~{дD=Гж @Vfq uКќа?хЛ\OA‡-џ~nnЮ\k˜ЁЁсц(2ФŽžRњO]ЫAЛNПlъБЫє/к2фщпapJuЫ™žЗПЧЃпСAhu3БBо;ћPсјЩ_ЭЬх^ѕAЭh­ЫњYђъh=ЈсPНЧ(ЄЉCŠаzўшЇRJ№ъљл™І5ДžБzчœlzY;"ѕаSqšщЅ›9А(ФЅLЅ:LР<“Цъ‡F<ІJ;ЊыЃу•д/њZЬЛД§ВќJ4zн FДгQzu6Гѕ тcКб4Bмє 8ƒЋг<’ЊoOw‘2#.\Н1"‹и  Бv=Л'ѕ4V k7—5ї€зЃубo7j ŠЯЄ8&?нЦ„|ƒкwjšŸЭ™7 РИ ?ˆъ >xuЫlОљЃђz=гЌ™I—<„ЏrŸЬрцсЅм)—ёЁяDѓїЕMгълеyxAЅжЫдт/}т!TК#lај ЉќхSЛ_ш똧эчы€,н0ћЉџ9f_+ЯhГЗŸJїВубЧ—˜}л.њ| qŒ>Xa”>ЦtжЦ~ >щbeЃЧw@L&{ђgwQрsf}„­ѓWх бЎŠЧр[VЭ;npљ aэш™5}ОЉzшЃЯмŒ­!е б.ŽтсLcІ;?HVГ€љ­2Ѓ„qk Œ“XP[ч‡ЂpЌeђNŠЧ­­ѓdЁpкЈ {Ѓ*GСэзјх›…Fp#>вtiЃъАЕ64>ЗэСеЃ1/SjЂДЊЯђ[QUŸNфчќРœт“ZgЕѓЅьЬuƒт5љ5-Н77B7< Јл]K*-}ЅvрЇЬ@i3RљE‘™&jќь;б~Ѓєћ‹!тьœS ѓтЫВшЂe7˜:Uh9>k]1Kњ№ƒЕтуђљUАЩ;.w [фwЖтЁ‰щ’V§ƒиІe[е] E ­њE:ZѕHГхXѓЫgiRQэ™}ј;КЋRhЬol5ЎЅyЩѕ)!jїъ+д†ЖяЂ1]CЮ (х PКюЯћџVPrxJэJ/и!яГ:зš'kc‹"[ЭўЭnFє+ФWœ$:З‘Вz XЛnсgœQџПД+щЙхHЊ{K§ювFТT™Йm и€wˆ•A­Я Е@§їЙчœЈК~ин-dщљ‹ЪЌМY9Ф<д|)аa(ŒМЪœH 0Є œCŒwYЩRАо,ЧPGЫТРhїБDТˆўМЩ  ,<ЂЌЄ7†N№CfшstР!"ЮДп‡ГЄКИ':яjѓ#љ‘•><yr$h^er=ђ˜”ёe1г_.Z—a`Wч5Š№ц8ˆюЬш]_ УKЦтЇыъ˜јbNКDˆ-Ы‹K™зЭ M.d^nЋgЮэ<tWм:є_\‰ЮнOЁzјv’єr ШгђЪ-‰шx)iQ’˜ЅМyС10е+\IМрђ‰нJщВЪiІ$;Зђр!˜Kˆy —  }ГŒ’œ˜’bz~ХЉеЫoЂ]cш“™ђpЁ™IЎђ ˜r2Š<˜іХА˜,;А№,у"В:IЬСŒ]Ле…ЧйаЕE3ЩjУЋист‰Ляm{1dž@h•эLVЏNєŒу|Qвw 3‚Yщ8X ШћўК)Љ~Иžд7ЦAš ц~/ЂœЛтA]“kLf\ЮЩЭk`ШџND†УЩ6 Rмм0UOi цж$&8ІќЖ=ђФСCтЊ#ИёqЭ~Ž‘7XjŠ˜џ)“ƒ)1їI{м%kЮ­№е†цІ"ЬЯƒЬГm‹v;н3VеЫрaУDPeBЄ—8‚Fѕx’žGsDмF‡Йt}pwLеŠ\SљšЋИёLPTSbСХйЊАэѕxЬр7?ј€6Нт1=`ˆ]}zЈ l)%ec[RПбcK&š;Ё—жSйgІДcђFЯr|я%qо˜; XЬМ Іˆ ЛњЎz9!{МžžїУш:йщ< в92зъ0sЪMužТOХš†їZOЩ*Ё~C—œ6ŽIN Ьc @ўЙ\S`GzЏ7ˆ*hэX ‚Єк*^и[%…ЧvФюЛф% xGsGѓТЏ<“ц& УѓЦliех—‘ш\%ˆ1nњТїpo^Н3ь‰шМшфў…ї1 ш‚NЫ-IїЛ”k{!і\А‘нrй–-Д‚Iч‰WІžћ7кT ( ы R~@1Neœь бЦ*фvTsЉеB “ЁVT)И(nлK…Ј:VхЃШ!кЅJlІ–ЏТќIЖкL^:”ЄцЪЅеV=€Б(ШОЙьfМ?Ќu сюYРbЕ/}`P1 Яжfњu‰кШїИn.ЪSJP„мЧ0NќPt_я№Jрж ;1KiаНŒ“аюцањму—И)†rE`—ьБЎTшNФКЧB…ŽdА:“8S…юЎЬqnмU8qзШ\жsЪ•И$.ˆ2Ь—вЫAцЉDї2ЁВГ1ЙqаVР8•шЮ*ЅDїŠИ Йня8оˆJs~ейлŸCљшL-Кw Ќ†‘•с$t•€š›J…н›T§qFсaјPЃ;jюPnі&7і@ДЮšuЅF‡ ЅдшHЋ/uЗГЊFЉбНЩwkaЌіhњЅЊжY№.еш~=еѓ~ЉЖ•Јl…иRnwИn аQ‰BЧДъэ^jtЋPо$,ШМ|Ћб aТPЃ“OAnC~щНњЎвЂл:K-К щЦљSЮђqѓ™‰ jt›Ъ`ХjLˆMКЭЇТл&&_štƒg•ч65_BўдЄ[eдŠГjд}зРыC“n•?—št2MЗ&§~pГTдЄл~ъб­ЂysГ`—Ёнр|ыбm+щQnЯ. №LHЉ–Фг)ќЕgыМѕшЖ•}ˆztлЪp5бМЪу= §ЁGЗ-}2rGъњ`Ъ єяжЃыcCsnIР|Њб щŠЉFЗƒ­N5КђВ_ъ;JnGiєR!‹јŸ[nw4/~–ЁМН?ЁЋ&lO5:So—]9ОS‹юЎŒЬ< ,KXџ€0Щ0ќM…~]nЗ}Т—щVЃЯŽzЕЗф5ŠЊЇOF-щќ—ŸёЕ™+-й (’т* М" аЕn0тV.Dо_щ†пЇ%Ÿ3KЭ”pd`62! HКњRqдбЪ_ еа= EЬjlIvО№AЯБЬOi)Н˜ЩІ,SЧƒl hi( ШиW]][ЖNŽ; MaLB}@ЯЦќXј”0ЏЊ)%i<,`™gDŽЛP~;JхšъKХƒ g–щš …еЪЂгЭF!CŒyB"–л& NŠ7tќю\:‹Ъ;^n( CЎ Хc4‰|;9П^ћŽ/оД“ŒчМх УDrž…•jЃ”6‹=†\TŒœžЎkƒ)‹гђ“@ўM“ЦBКOуei@Т‹ЮА‰{Ș!žът„К і0U 5ЧГѓ`›Ћ3SsdфЧФœiъла7ЯRЖвШХH/'Јxp @0Г m@АžQ­ФIOѓJBаn]xAжЊ/Р™­Y;OЈзИŽЮЭK›ѕшLR œWsШТ ЙЄСC9 Оютю4мЏюАfцЧ#НВMХО2"Љ:Sхиe9-|'“Е52РtыuK"рrЌrд?[—ЉСV›ї2?э},РаъŽЮЛ#’bBNKL@_сQеє@3uЎDBUpzasмйрT62ќр&8v{ ЦУ;ш ІNт#ж‚*–uЃ<=ЂкТЙ !awъ%6B mЕa§sxZяъsØПz_ƒ-`оSПXб}0ЏЇ.l0ЋЎg№^Bl#REm5OEЬ`ТN4”І˜RР%œpЫVшlГшб%žlp<И0№Г—щƒ3ЁRрЈdˆe {РŒX эб2ћ„зо‘2|ќиjвГ6џќГгњМеГЁнqp'BPЦС‡s‡ЁjА39zPБCvзŽфr"6;HЮJ§ЙT.hх\ q‹ƒpPО0$еи*Є’ѕ&ƒЭJ Ї\4Ѓљ˜ьмЫБqo…ї%sС€ŒP РЛК.Œ”ЙUп­ЃЏw УЮ яЫ3Зsќl@_'†д1†LКю ЭVД™yц EсFцxд‚ ˆQŽДСFКvє]јBч vTЕрŠЧdНЛp…нK5н.АНмнiFСст!Ѕ3еЪїлy]VUŽЫПЇœ&qDеjў§{LПбU~§E&š ПLђјоЇmГzK ѕ#&дѕЭ:—М8bъ5|Ш;<Ž-:І>аpxF)$лMг‰˜oN+ѓ ^] %ŒVŠєџ  ­›wГиЉ№б`]ZЧJ!ў> ѓЁх№ j Šђ &ОѕмjнБ-цЄE"бМf€rŒŠТˆUЛІc/XЬ­ё@ƒ^1К@1<ЬŒHIE g?оR $ўФз. iдДЊЛяBiШ–4.)JЁV[v6йЫB!‚ьШP ІšGй4іНЫЕФš”)Ϙ*_vбš‹њўSђз‹%ѕRќšВРPЛM;ЛЩ>V RЮ0%M“ y},ѕЭIдBЕїAЃхŒ Гцƒ*ЅIТЦD‡ѕe*ŽМо,е5БЙЎŒTЂЪ.т…ЁТн;RђЖЫЁ‡т2D([C'8K\~бв—tтDПтг!3ж€fv›rЏЎ•ЂЏ>HО ќxšЙыƒ †Љ…ЄoХ$MfpсE•’Fф_Гн8џHƒЛЗJюМNгtb„€ŽT”‡ўw™8: …ЇГHхc*tЁFЇ•ньМ>˜№ѓК‡зRлx,ж+/7Ѓ€ш>ѕМ*Ст™дтKЖСS}ac}O>†:_lЈ—йЙ“ЛЪ)Тђэ9*ІFщЂУЦx6xO(ЮVH9§`“5YђŽ *{–J RJ{D…Ч@ЎтZa†?ўpПШЮ#1nќ­аэX.“Њ™M*Хa‚Џ‚0Tиž4іŒ*Y:Р”1Єsц^юŠ‹%уЅ‚ ;›™”†ГЌHC>ѓX4•˜ši!аЉŒгsе#Еsю;ы>ЋОгЦ)XїЩЊrѕИЯLcйЏ‘ЗJц%™a§30ЄЌu!ьУЌті=qщ<ЏOК,YŸžЩJ§„~ћF­иЬЗ ФТыУuЊtWјJŸХHL2ЦgщŒ\ wЙ?X'њqpmЩЦ%Є#ВcЭНм›ЕцїtM>aЁщаUFucгЗјLВ< Ы0њЩ!І0/,мqЯИI—uуLЅ@74гЭw?vМњ ж`ZВГacстЎЏЛО/†>Yƒ •@ ‚PуTЅЬЁь5т<(6шDsЩыž ЪУж+7•Ѓ‚ЙСяS>ШuяВУв(6ЇъЛњЊT3šЌCШAчT>ˆЃЮєonрП›%7ќаМе:я=ZЩ–wџq|Щ~*в5}~ТКŸМ/#гV*eb[r‰эЊ іl]Џ{$zШŸq!з„рЈђў Щ˜ЛЕщв˜˜~г[Х“EНлЕyBтУоФ- ƒѓЩI@({Ј/41=Oz^)M]ЏЁѓкХк цb­яЊЂiс4aЦНъoщ{!ЏJЅИ0˜“_T зГЋ[BJЙxд—Ю™†qU6ЏRре™ђшhйЌˆ‹‘]VПi*ЄєŠц)ЩуXBЌ№}дWq•3[M˜ МnЗ’€(Žg ˆmЎЮC/Р“M`шyљяЄ‹_ј€‘œX•g,nR Оœg_&І4М св‘фТРN t‹~%дЛHЇ;“-œЅЈK <)…ѓщXbЛhъž%†ЂџGSgУлљysЭTŠ0Эћ.ТУ'O‡XZј$tž+L§„ЗтР)лщyъYeУ ‡МЉ:мБђB6 ЉrШ x–шЦU’ЦЕВ™IїФpЮњiFszЖвЙтB_V,ЌqNmg+“vќЪ†зЦЈobZј‘zx'yˆ~$Ю‘ЛМGЭх,’@…cВ/§CжШf–Y\3!?ыlK-Й|]`0ЇЉЏгSцd3CJ o2уфЌЃ9ёЛLвиа•чю ‘c‡IrЭєр€йО@+.4_ ”2pm&тŸ‘Ь6тУ?iаПъŠтW8;?\Q:ыvE™ЌЏb кP 8јg~Žё•+Ъœ—ТFz2|ё€ СпИs2Д/гY$P~юЄ@оІ€ ѓнx‹ЎќееЈ‹Яж7ЩЮa >цvпуОaBи8ƒ.5nt`Б}0п_>€%і§ZBFгёх НћћѕСh8ы—:Чђln У<€0а=­ ?Gv Ѕ'ЂKˆјрщіЩ€Ошt@ н8ъМ`кŒДJ'MK–уVЦ€а­наGпQГрPœDљ8$D#pШpйЎƒUП”ЕЋё\Х, T>ГћвbІ†‚O1іЅБН}в№І8йФЮŒq`ѓЄтўLuцэlэT}­„XNТq<`9ЯЁР‡П—Ž…5Њ№@>РЋqјUU.ЏdBKL2;3эЩХfBў„ ‘=А™њИЈ‚N~|ЌљdРч|.ыщтьGЉoxdћЉ”Kш|(кaU%sс#ЦЅрЯ@пуRіžрqЦUЕž›:ЫeйГ™еƒђ|_UУьЈѓ„HwTтŸ†W)|sяrCРc"!ИТLJВљPчSŠФ„ь:с+w—„иРжf_фђ€Dо†ЃœV|H™›а’Ž< ZгЩ№Ž#х?њ2x.IХзлRпУPКDЌјh“%љfaU†ТS- Ь}SЪLжЋІu–Щt‡ЯУКт!,(HPжLшХњэ5ЊќцѓEŒЪ™!ЏS]АЎŒѓA Ќ’ЯФйЖЎtѓЃfб ћtŒLџќгhЊЋEЫš’šЁ•%чуF Јkб`™аїBgNY<ћЩ`ГxƒmГІZї™ЂnЩœШЄ­8|0_ЌЛЖr VhB Ђ{Cэv8*lІоm‚EVfnIеСН0bёкsо‰lpWцЫЦГ™r”Ѓ3х(r”sЉ˜ŒѕlІыџФЋ,л5Ћ3sж43oреЙЋfб*.;! мёІbЖ]љEшќЂRqЮЪ7tЗ~BJw?УСРQ$нвкScьJъу ‘ШЬQtrЂ$'И ы_тWцmrФШE5ЇЭ‹,*g@2Љ“qчi“˜Š’VБxа]ЖП€šЩ­Kфмg—M1?ЏгŒ˜_зСШœкь.3b`:Х|Ф 9тНЩЬе|_WЈГЯ„Ќ~TЌ5зbћЈ}™Хœ-"MnP]GпƒЮЃ"бrмвЎ“еa ЧЭ_b`PЎ^@Ъ) ˆеNZзлЬЈйN6{aСyј‰Ќж›мкЊд–3!ЋийM‘€ЩЖ:јЄУSцЊп9qŠЇЋh'хи‰Ъ8{ŠdMTПй №ШVЪсy\V"&тDЦся\vІm .(Ѓ‚RЯьЬjы†у5№ЊуеzMœеDuŸ0­ПtЄSРJŒTШг$Xw2$dkЁжд1Ф4JЇ^VтЄ™ЭC'ъ›Š*б]1•зЮЮа0ЁTB@Н~‡"ў4‰єС&Mу”]Tї—$ТѕC§эbеэ#oашэWсsˆЏхСнUЂjСXПiНIN, –Hz—„ШЈу mц”ФЉМ›/BР:X–-GЦ…/x™й (}ofWЮиƒ„рhgќu§4Ћ„јН{9єŒW\НSчюђC]˜чТ@^“_ƒŽgCs‘+љНpŸъ:№ГјеЮœ§Ѕ…­tзёрТЛљuˆЇ@ёƒ„0#˜q&}x<ШzбS6€ХdS}щЫ8i793q`ЏЭЮ—b O=pмљ бљ§г ЩД2ŸСDюаt6Уў/…€Гџ\єˆЙ!XV№ѓСЩжХ_щ€4іuЦ XЖќиb1вІЮ^V9“iЇŸџ\тћ%—ѕФњЩZ3€ПЂR]YТ1a‡рЧ1чУжШ/Ќ˜ђїvќY‰#Влш—YˆtљhšИFе.кѕ6xК8И‹$Й„C–БњЅUИЙШ[ф'tКФЌь<%ўtЬšІКр;-ЄŠЛ˜8‚&4їхœІ$42‹ЋLІ1ЙЫ0),щ’ј\4ИуьBюKыпЗ mЛ=›?оd"bDЗЬЬЄMгй\Њ ЮбzКЏО›ŒWМC‹2ћЈЫЙєі$ЯЖїы™RДB ќщ~т‚№}мЗЬя›ŽB§ЏMŒ=)вšЬЂаŽ+N:PKЕ№Ž ‚€v*t9ŽъAŽН[B;ІмЁqI2єQB;йьеyнкЉШцаŽI6Ђ„vLђOЧШЃ—„vLт\Ћ‘Y)­з-GбjEмwІц}Jа‡xJ:;ѓ)їк$э­yIgt*ОЅГ№=пOщьДrpŒлm—~4Q8{<`ѓ-œ4žТнo)œ&“R№fчъЌiЬЂ•/d@ђŒфШVТ§x)œRёЭъьЇ„3љaA8;—|3†њZ‰[чЊ"xБv}•{e'ФЏЋkЬњy”ЮіmЏнк& mѕРJ:“‹'ЄГЂtЦˆHJgr…t&Gв’Юф щL^Ї)m—зЅ3њЈB8лN#ћР?„ГэeЙGѓ,GХIџк[8лЎ\ЭљuЎŒ!ŽIД’Џи™)Џ cбЁ8! “[:“c3ЄГmЊ{вYј8Hgk—_0sэЇtЖ6нь‚›BЎ†‡pЖЖъЇєu+сlБd gaŽžOс,,uЗpЖ`IЇpqш!œэKNc!Жlия)œ@мВМл$›mTШЅlЦа[6л—фМф‚Ыvа—‹ЂйІ9ПDГMw‰f›–лЭ 3H4CфE3КпЂOEГ8vžЂЎ)š1ŠˆЂЃˆnб Ї’Žsf{)вО№ц.“'япО%3ЁUHfzІ[2лw(ўЬц~Kf;Kкп‚5юОs•`ЖŠѓџ№˜в,p\)˜э­)џIЩlп’™…৔܍Ѓњ$3ЛšyNVQœЇ+э'vњcˆЏ$3kvБtќџ  бAя%Ш9єо‡„эƒэЪјyЃŠ€fфx•EФЌ:/D0НмЃљ§ћWa{Œ<ёЛ˜гр,0дъж&BЃSiхЧƒxмЂЅ"$ Лlkцƒ-›уЌ? z•'GЖlžvа=­Ž_hЦH/6@6е7уЦSi уЌ˜AцOhЃ'Иj[иЄDjЏ„0љS3Т<ЏР:wg•Ы‘Ѓ5fcб8 Ѕe4fUЖCy.T”4Яаƒ‹ёЈ^ ЦІ\[сЊoђ‘Є6Анё`CЎЛа™Bн›Y hmAьМ ЧНБD@Лт…‘ПS FШ7U6wёdЇRФљRgFЭNŒеёЊсw(С‚ЎыЊxъ…ŒУ)ўцZР8kЊЌЂБŽЇ ѓ€j%c†”ЙЌ4xq G™ШњЌEgДSЬуАИмРпeЎсЛ VŸСЎ i 1ˆРд—щ ДЂЅпе•ёVŽж вТА*ЅЙ!JяSбŒ1х!а{Ј€€Ipћj)6ЈwЁŽИ-Ќ=мЉ?Вш Яp№€иљRBŠ\7ЄgƒZ* нлкЂE}RюЩ`є}At<Ў3ТŒЁёЃmУФ’\TœЦ .pCеCxЙдЌxтИlМ“д uзxѕУќЮТѕ”а˜4хэHZ@iШZаjшј!wЈЧЋ ŒА5fђЯtФьЫ yTMfГихц2ё‹^Й@НуƒЈ{кљБдYзZ88bЧZ0ЃнnЙŒ,№~ІV9}8RЯ”>qІѓ:эєё %XoВЋЎvђBлмкglИ|ƒјЅББГМѕбЬњMŽˆŽўњ>Аm+УJ“EТятЦг‘ђ№§œфТPwсЭQ“и˜уРИкАFь ­‡Чhƒ@ž§RaЈ7нз™ЏB]ё€њ?мˆї‡7ОLˆкОЃО;ДаLШё*ін­ЦХЫŽI4кЄ t&пещdbZЉƒYLЌјЦЋаMфтPcщЕЦІ…™t"Љ№”DgэшуЏ]t`Эч­ІлѓФyЃzЇЏ•o2OВђосœ—ъ%Џ8CYf(D ,4'bя@lkдЪх8 \‘ЃЫЦЋFrЋYA Ђ‹ЃVрGw“„ЖerхmЁZТ>.“ЇГJЎƒk4sŸ6iNp{аъм­]зƒйЫ/\М Јуdbfз™p.ЬLФž[—щщ}‘ˆ}ХEъЬтŸ>ЊБ0Ќ†…%ИbюѕžŒ%Ž‰€%бm8сS(5X›<‹^нB‚SЁ ЗEжR‡tOœUWœ6(žзВ™ъ2]”oуќ€тб#-ШBгЉЅ!Ы5ФY2Ќ7‰GQJыї|+ym0}§NO[XƒЬёТ‚}›ФN/цШ}ЪG›Ю`шны„јІІјЂЬЖW<ХŸтpoz J}ћЅ"Иgъы`жуJ4кыpšвgќГ\o%АžЉяШаМpЖРРћ-ЬH,Žб6gW&БCx`р–L†!nt„Й”тёёц­b9 њэюъ+їЏфТЌXћŽxУ›[яSЬѓ@3S л~}œ`j•YЩ-ўФPс8ŽЉЖ'@Оќё€ЭаШ‡5АГ0MЈ3lw(ьп"I@І ѕeŽжгGХКI[ ZЉТЬL:DŸЏр™ЦfE4еБх—–_ЗU-nФ@,јZŽЧжŒ/ еЫФLмЃAџЎ|;Ё‘ыGГ/ƒ’‘ўТpш Іj QЊSо ASn(?rЊЕ'їƒ єPFшLB/Z'иW1œ-[4іЦTk^1UVqcFзБ™Ъ{И:ЋЪ"fAS†сwZЙŽБѓUоc6XЏ$Гw%Џ32Kƒ~W#Йц1”@"—fШвЏс|№бьћљ*?p”œВ* ьЫчш[Ц%’З\ˆVC77 jFнтYНDп­Ž ъу ћЂ›™иYё{ 1zає”ЎЮЌ‚ОЄ>yњ.ЙB Eая4йЪ€Xc„кЈ*шT$ї\Й6 ў!—8|fѓlOˆц1Ge:Mс­$ХGNmaKšјbИџЪˆ Ъ3рx -ђV"Srї ‰Ќw0ŒFWYЙ ˆ ЇЦ­•?О@ц;]Й1N_ВіP0~'ѓAŸА[@VŒ|bc ELЭќЌH{К—%5сPELі…OЈ˜~RЭбх+mXЌAцӘђ4ФUт~аa•XЙњU5Ai‘E|›№"ЭЗс# и8šZэ>l05$*‡ыљ†€1’#м&Юx ->ЌU:в;uyтсЫе\HДбQHДгWЏДЮHшШтл+•MЦРЂ–вќЊзКЛmš7k~ЕћЧѓДюtPJ-^ђ—Lчa’@д‡MтРЕрЖI,Ue“АaPі–MтcŒЏ~IћЛвСМЩ}(Аc&c.Ь˜Ч ‡Ь›ВёІ_\хM)гHћaх`Т5CzБTчсG<7Ј†eМƒAх—)q[BЊtю"ђоХƒ8\#Šev4cюdлКBЬвLЕМ!нŽw1јPSУl§”кXvУ’э шъRпggXкK: ‘@( B­єЎ–тq|NˆъfLс|‹JGк`tJ˜Пšя=)‚ыл\ZоїхƒkйœКk(‚Œ^Мо ё€ЊШрш{яљN@з3ЪŒ[юРšbBŠЇћМ+)€бaўX БŽЫlMEwfL [9њH3Г€+!йƒпЂgРu~•зјZв @SВ‡Ќ’­tK6@вЃж"SКsћMmJ*#еДЉ\;hUйЈ•а]@…ћL’њ3y-„§ЪLKНEїgѓh?…83њ>…”cVёR8ms?wГј0 ЃJgРU}НœЬb†‹D\gЬŠ–rDBЛt <ђ^ЧиЪс|цэИz‰#Ц„К‡‰1ђ~)а сbбУaдНулy(Мd3U)ьїР‡t|9gпіуKЉь4ƒгj}=MЙONOm5э<0gмЧr*0ˆъfкGєOž5Œ5бљТЋН.43ЖOfЃ cѕ„(ežКа^Ё‰sЪ[6ёFWF;Ё6ЈПnЕїŽ Z‰ЁЌбaP2и)‘|ЗІЏЄё€ЖнvNРŒч= ƒeТ,tekкџ<АЬK=АД R‰k&sуТYgфФЬгdоGgжЊЋЌx&у5˜‘яDЖё`гѕw%Ё`тнВAї\Jv†< p5$ЪїМ(й/Жљ_YС3 [Е7”™ЂКE“<щ‰е’оСўКOЛ­Р.ъGkюœ9qЋѕЫЂщ†}_2ЏВ@•ЩRОlб‡Ѕ]™ИолѕЃЅЙhjЭ‡п“ЭJМuЊ.КŠ=ц†сФ`у™ЫМaуЙsoќx1Qgоиўbжъ:%eЮ3zwaФ4З4’G‰Uh#е0 iEKзГњ6ХІц!eіUШАcЙ† єоДЁЦEacс #жCm%;uВЩjG<GЦ&3U№U}рDхчЅC\ђN˜? ХƒЩЯЃЭђя‰uЁх—’ŒЧ88q$U5d8ЮѕŸъЬЄщ‰4ъп†є§q„yЌЁ(Є@§+ГSљж6с”‚MќШoЏ?[уХ­2gЛ.‘&јъєсYbP0Tr ПЄ"ЙйЬ@uЯуС|щЭŒ^Јa]X мыgФ,кш;ЬWѕЅж0nИz›a~К@ыЧмљС/9дЊ"|сGЌъП•_ЗUв3Пn+AlS_Cп CЭ§Ma8v&zЬЦAыё4„9ГЋ_‡Ця2єв™ХЋr2џ§{ ЂРИр ёœuEєlѕљ„ˆТіP_ыzйœq‚ ѓQOY%Ё.јЭŽИ€ гi€Књ1† Ÿ[Ъb З[‰K@яЩjЃйX`›Щ•zЅG”ц 1|ZSкЃОN.{AHc„оd‘ЦVW“й_QƒЧќRљ)=ZД†$ёМш™(qР‹љƒ@ qВ#бВƒЕ ž@АцѕB-А 42Ўё,Љ1ј­Жe,qG3(8(1x“cІ–…в‰%dš JгЪАЂє{4 ,„ПнІV]вЏуИв6‡Ј?Ч6а/кв…єПљ&OC#ч+2з?§§ћЕіњ‡з7оPg vр7біH‘#јН"џЏПжЛМ?"ЊСЖз~їюз3ћњHыHМзR6Н_Ќ›фЩ;jUј‚ПŠс=&љКr>џџa?†Р|НDэ6ŸDџ8|#§ѕVjњ•$ыџ.+ШoјЭ7ѓwян‘АП~x/§{MоџЕ—Ь”1zКЄќ№M&зыНШџђэ?љ§ПџЯп}їЏЏўс7пќэПАe§Ћ-[o”{жпЇѓы=ЛRqwя`эйz“ЩиЙxМ‰OnW3тНRЬт3По‰_юћЎшјЅm§zБфу_ДžWFм§|=ћхП~ќ?~зЦЗџѕ‡јїпўцЛПЖoЧŸZпљењкЩумc•п{їѕњvд‡Ћѕ%Ќѕѕ7Цm ћy^ŠžiбЊГй3Нш—Zџ‚хќйc|єџЅуnПК9ЈNў—lN_™Šђч›ѓџѓн_їoПќїяПпОїh~ьбќS{єШˆh–72vТOVPуѓF†›Лs3плјžС7Yлн№qу§fr6cdЊ~ž\§єџ@ЭЎ endstream endobj 132 0 obj << /Author (Andrew) /CreationDate (D:20100901002203) /ModDate (D:20100901002203) /Producer /Creator >> endobj 133 0 obj << /Type /Font /Subtype /TrueType /Name /F1 /BaseFont /ABCDEE+Calibri /Encoding /WinAnsiEncoding /FontDescriptor 134 0 R /FirstChar 46 /LastChar 119 /Widths 135 0 R >> endobj 134 0 obj << /Type /FontDescriptor /FontName /ABCDEE+Calibri /Flags 32 /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 750 /AvgWidth 503 /MaxWidth 1690 /FontWeight 400 /XHeight 250 /StemV 50 /FontBBox [ -476 -250 1214 750] /FontFile2 136 0 R >> endobj 135 0 obj [ 252 386 507 507 507 507 507 507 0 0 0 0 0 0 0 0 0 0 0 0 544 0 0 0 0 0 0 0 0 0 0 855 0 0 0 0 0 459 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 423 525 0 0 471 0 230 0 455 230 0 525 527 0 0 349 0 335 525 0 715] endobj 136 0 obj << /Metadata 137 0 R /Filter /FlateDecode /Length 58973 /Length1 109280 >> stream xœь||TUњі9їNЫL’™If’I&ЩЬdв Н™tBh!LЈ IHPšt‘&(hХЕwYл*Š“4и kяыZWu]ньЎ’яЙї…­џ-Пooђмч9я)їœїœѓо“0q֘7 ›TйP[sWтжxЦ/<—1gSUyeуыЫs[{Є‰Б0SUљИŠ7ЧЈbь*јj*ЋЊYšfЪwЁ•ЄšIЪіy{КБ;оЋi№—ёЂЉ‡ёcsИ'6фЬыZмЫх[кцЗ.кнqщfЦЂ'1&}иЖ|ЉћЎ‹яљŽБŠЦДЦ9‹:чѓЭјpЦbŠёќјЮж%‹XѓтљдЗtЮ;cЮmПџ;ЦЦЬclъ+]­эяЅлKбўtфэ‚!bЇI‹є%HЇtЭ_КВћд”5xкГЦœжБxСЬ‹І…Оj`{zоТЖVѓUЉmŒншcЬАo~ыЪEщпЅЁ>њЬм ZчwЄЕзblч‹ŒEЦ,ZИdiП“mbьў”ќE‹;ѕџёУ§ŒЙрƒS|ЫЕЎ•ё1/Э2—|Эт”n3vпŸV?Ћ№#щcЊчї- Л[’aLbtЁžŽѕ1ОЯ8љ[ТюV[pi+M+[ЧДl%“QгТrYc^ž+!Wжшљ6фДWj бdБќ"л$1“ЬZI’4ВЄЙIŸњ˜ћLбіјЗ›С№ƒ†њ ПNJs3vН’'пЃTFŠж#й?|iІВ;ўёVў3.нkџšБШwВšХsўЏ/†m—Ÿaѓ6ЏƒmџЛлнРц,ŸrђЖ‘o=о&?EuЄ§?_WЇcл5§|žцv6чdЯ;й%ќq›ђDVћГхš>s+эжПівfУўіо§c—<›M=Qžюm6UЧ)_SФZўeњ^ђ>6фxл_+•ѓw?яFvх€vЎmjs“ПБar§Є‰ЦЋ[;ІІКЊВЂМЬW:zTЩШУ‹‡ ’›“•‘–šтMv9lV‹9Тd 3шuZ,q–Uх­nqвZš4я˜1йJкл CыCKР SѕЫм-j1їKњPrЮq%}TвwД$ЗИKXIv–ЛЪыбsNи5*­thЛЊЃr@дЈ6дСPk?пOIёEшСЈaPІsŒШ’SБsa“аŒjRfбсАIю&o‡Зй‹5ф›дЄŒMёЕ:Пu оКњЉMъl‡VIуR”_LЉѓ [$Є ЌСъLЇ˜V5]ЃІ&Ч—]+Вннo]CЗвИ7д scaаКДкжѓ‹ЃŠА5ЋнМе­^ЗХ]ннклП~vwЯзНЈЊЅk„в†ЗЖНллаTтTћ:Йis•ђЈ(VЧыЫГГ{Ъ{Мќмњ?Зajг^ cюs›‚—*ZЪ›{RзДзрЎZ%ХЊ•„[I(-MFТ –wюѕ1Ж^ЭеЈ5нжЫ™j3gmНй,Т&СІ!›OЕ)&Щб#мVЙл•щYнменвЌl.ƒЉФ7pяhМЃ{ИЄ Нх“З\Б—*іRВыЛ ƒЧp8G‰Iн-^Ф),Ј&цфДeЅIwoc“ч9чСf–кt`jS ,Б_›:хjДР\XпжЊєƒљ›”КњдкЖf,[б ŠдТаBXЈ”ЈVы(Ы•к07˜@Еўz$ы›Э™ЪC›ц6ЋЫй`cМ#0эдІ6MyPnsw”З@н›и ЦдЭ …ЁoЌЁ‰,N$ёАfr’>=oѓ"Ћ­Х okX[–:ХRЃ“,‰šДFg(“)У’SMЦ@XФЗЂM9Ъ–дІъ››ЉѓjjsЈžm ˜аЃДЎ U€wUЋєп›бUЅш#J3ѕНlВw%"‹вiЕ%=ВЉЕ­ўTп‹ЗXT6(1ТjcYѕЪШУсw9ЕБЗџVяžWv–Wy9( “9їbaГцюу i™йY†у­ЊЙЛлёѓШ_†ˆЃЌнUxk0 “нНвйЛУ|,ФF!6q–ы…X'ФZ!жБZˆ3…X%ФBЌb…Ы…X&ФR!–qК‹„X(Ф!ц 1Oˆг„8UˆЙBt б)Ф!:„hЂMˆйBД б"Ф,!f 1CˆщBLbЊЭB4 qŠS„№ б(Dƒ“…Јb’…˜ Фx!Ц Q'ФX!j…#DеBT Q)D…хB” сЂTˆбBŒЂDˆ‘BŒbИХB bЈC„(ЂPˆ!ђ…Ш"Wˆ!В…Ш"SˆСB "Cˆt!в„H"EЏЩBx„p с"IˆD!„p /Dœ!b…ˆТ.„Mˆh!Ђ„А aТ,DЄB„ aТ(D˜!єBш„а ЁBB‚ СB‚ї б'Ф! ёƒп ёп ёg!Отk!ОтK!Отs!>тS! qPˆO„ј“тc!>тB|(Фя…ј@ˆї…xOˆBьт]!отm!~'Ф[BМ)ФBМ.ФkBМ*Фo…xEˆпёВ/ ёЂ/ёМЯ ёЌЯёДO ёЄOёИПbŸ ёЈёА ё qПї qЏ{…шт!юbЛ…и%DPˆ!Bм%ФN!ют!vqЛЗ ё+!nт!nт&!nт—Blт!Ўт:!Ўт!Ўт*!Ўт !.т2!.т!.тB\$Ф6!.т!Ж БEˆѓ…штЄ"ПЇд”zŸRя кOyяНCЦЗ‰~Gєб›Tф JНNєZ0іаЋСи) пНBЦпНLєб‹TфЂчЩјбГDЯ=MEž"z’ŒO=NєkЂ}DQЩG)ѕбУDQоƒDё~Ђћˆю%кKдK%яЁднD{ˆvэ Ц”‚‚С˜i Ђб]D;‰ю$КƒhбэСФk~Еђ+Ђ[)яЂ›‰n"К‘ш—Dл‰n КžЛŽZЙ–шЪЛšш*Ђ+‰Ў  —Sъ2ЂK‰.ЁМ‹Љ•_]Dyлˆ.$К€h+б*y>ЅК‰Ю#:—h3бІ НtNа>t6бЦ }hбYAЛД>hG0цы‚іЁ ЕDkЈњjЊw&бЊ НtU_IД‚h9б2ЂЅDKЈщХT§tЂEA{h!5Ж€JЮ'šGtбЉDsЉ^Q'ѕlUя jЇ’mDГ‰Z‰ZˆfЭЄAЯ žM'šFƒžJM7гƒšˆNЁюNЁљЉ•FЂЂЩDѕA›4)hSž01hS–ї„ m#h|а– GEъˆЦm8№ZJ!Њ!cuаЖTДmUmы@AлzPy0ЊTFф#*%ŒТћЂTIак I4"hU–ЦpЂт Е4,hm ZЇ‚†P^Qaаš* ’љAЋ2АМ Uй›ЙD9T=›žE”I &DeЅЅЅ­Š—RˆМдf2ЕщЁЦмдŠ‹(‰ъ%%9‰т‰т‚– Gа2ДЬХй‰lDбDQTСJ,d4EE…SI•4’1ŒШ@Є'вQI-•дQ&’ˆ8ѓѕ›gЛє™л\GЬэЎУа?ппСі-lООО‚§Kр ф}ŽєgРЇР!р ьŸBо‘ўјј№adЇыї‘]Ў€її€АэП ММєяРoooЏGœцz-"пѕ*јЗѓ\ЏDЄЙ~М §RDІыEррyф?лГѓ]Я@? §є“ЇКžˆ˜ыz<ЂЫѕыˆNз>д} э= <јњЦ§!рAр№г]ї‡/vнОФuoјRз^ ИіЛ=ШлМ]А мe:УЕгДЪuЇiЕыгзгZзэРmРЏ€[[€›MйЎ›Р7ПDэрLЇЙЎ‡ОњZршЋбжUhыJДul————П@Н‹ао6уз…Ц‰Ў ŒЎ­Ц›][ŒЗКЮ‘S]gЫХЎМиЕСПожŽѕўuў5ўЕ;жјMkИisMнš3зьXѓжпxqЕ•џЬЋќgјWјWюXс_Оc™_ГЬЖlщ2љЋe|Ч2^ЙŒч-у[fYц^&‡/ѕ/і/йБиЯOZМ~q`Бfd`ёўХ[ЬН§яZьLЊћV/ŽАTŸю_ш_ДcЁСœљўSб­ЙХўЎў9ХэўŽэўЖтйўжтџЌтў™;fјЇOѕOл1еп\мф?хЇ7њ§;§ ХѕўЩ;ъ§‹'ј'Р>ОИЮ?nGlёэŽ1ўšтj†Ь, юйЂt`BzТœМ<Ящsюw~цд0gРљАSŽ2ЧЛтЅAц8^11Ž/Œ[waœlvМр|ŽAYециbп§4Vэ‹”SЭb,1юйЎŒ-f|cЕЪЅ•ФљCдБŽёІU›эмlwйЅ*—3ы~ыgVйўх‹d6sГЙп,љЬ(nŽtEJЪ­?RіEцЋ6GИ"$хж!Чј"`QZLŸдXm6ЙL’Пд4б$љLЅе>Sv^5“Й›sху№pиМ ММ ќx xxxx xј-№ №рeр%рEррyр9рYррiр)рIр рqрзР>р1рQррaр!рAрр~р>р^`/а мм ьvЛ€ а€Л€РРРрvр6рWР­Р-РЭРMРР/эР РѕРuРЕР5РеРUР•РРхРeРЅР%РХР/€‹€mР…РРV` p>а œœ l6чАіВѕћŸcџsьŽ§ЯБџ9і?ЧўчиџћŸcџsьŽ§ЯБџ9і?ЧўчиџћŸcџѓХbG рˆ1€#pФŽР8bG рˆ1€#pФŽР8bG рˆ1€#pФŽР8bG рˆ1€#pФŽР8і?Чўчиџ{Ÿcяsь}ŽНЯБї9і>Чочић{ŸcяџЛу№љеќяюРљх˜Ѕ|Ф\љПњ.ўб‡Ї'БSйЖ_›иVv1{ˆНХfГPWВи-ь6`АЇиkЧЙOxѕЁЯТх{˜ŽE3жџ}џСО[€^mфЫХHEkмЧ,§–ўCЧйѕ]мoщыеE1ЃZ7Bzж/љ‘ўяё‚EКЈ’–6C›еŸыЏыЛЋяжу|PЯІВil:›СZX+ЦпЮКи\xц46Эg ддфuт>ЉY(…`ЂъcЅВEъпM,eЫиr|-‚^J)yЇЋiхЏ*VА•ь ЖŠЩVГ5Ёћ еВ9ЋдєJ`-[‡™9‹mP•`ВldgГs0k›йЙьМ“ІЮ;ЊКйљl цљvс ѕжЅЖсы"і Ќ‡KиЅь2vжХеьšуЌ—ЋіЋиuьzЌ%яRXЎW•’{?{œэa;й]ьnе—m№yDјeŽъУE№СjŒp󈓟VѕжZŒ][whЄ+aп0 Цђ•’Q’ZЁyPZYsœ'Жa ЄˆR—Њу?fш•“Y…?Ўр™Ће”ЂŽЗžH_ЦЎХмŽЛтUE§šдѕЊhПюhйдєь&v3цтVU &Ы-аЗВ_aoпЮvА;№uLTФ;йъЬX В]l7fђnvыUэ'Ыћ9ћЎ=xдВ—нЫюУ y=ŒHѓ(О„хи YїЉ6J?ЪCZ)EЉЧйˆPOГgиГьіkЄžWяO"ѕ"{™§†НЦ# ^bу~P~кf}Kф—5dІgУйx6MЛŸEр§УF№={ь••†l§ƒxwKЬЗП?žWјЬ)тžјјRя=Ct[ekm/Яо]ЊпŠsmщ‘wŽ<Ÿ{фƒQУsђмЗМsРђљѓжсЙ…^9ŸЧ­Ћ [ЄЄзлtофiHzкаТТ‚бвЂ4orЄЄкŠ†-$IВMXFKJšЫ/ž*O<Ђ“жzKЇj“тЭЖVJpDe—ЄZІЅ–ф$ъeНNжєУЪ“ыцU%ПЉЗ&кcЃ †ЈФ{ЂUф-mфї_h#ЈаЬћсY7rziŠ|…б itКо$Gмр‘žк)цh‹ЦmБЦєQж№ŒЪщG6й”6ьvjыШxјэЦ4Lb™Ќ˜=щ‹w9,|МЫbVnИ9Тqs›pы•r|ёvђэ>флэІ,Ѕp–R8K)œЅЮR gн‹tXџУ{ YZaoџGЛPќй.sˆ#TўfWИЪэ2),Y|7˜6IІјєЏђѓѕ)ъoYы‹zЙЉGпШJ–Њs3œчЮ8 О ^Щ$sfцpв˜*[ЄЦыINb-ZшчэЪœ%ЩМ(Gђz­Ъ„E“ю*žиvzmпЮиAƒbyквKк b2Ы™^•бw$ОxъирОŠЩCу&ЄжœVџќї#›*вј’Q“GЖЛв5в]YЋЦч4жG‡L^ ёмqCњfxGN<ђіˆІW_qТАЩŒГ;њПзeТз%ьŸЅeєЂбRD^^lnЎ1ЧсˆЙ(>фЂј‹тC.ŠЙ(ОWВњ’RђУУŠяŠяŠяF”2:PФx/~Рƒя}qŠѓS†ж›БЙŽќ+Ѓохђk§ЌWTьpka)Я,АZŽ*ы№QЙ……жТќМЉb[Н>Ѕ Ѕ мщPъ:—:-х†*NХЏЮ{ёƒ;ќКЫ З*П~Œ БјnГ?I„чмЧгй0fфi>“е=Œѓ™Тљ8Ћђ[EЃЂ†Y‡YcJzyјž2ЇvPCL/дЃЂ,эЈсУZ‡ЯХBža9h9ЈL .БОеŒ \ёПFD A9КPZgЭ“ьЖ$мVБbћŒВ…ЇŒŒ5i с†ШТIЇ-žQ‘R0yю‚ЎЩ…#ч^д˜yЪј’hF’u&Н)ЗrЦˆЁ“Šт N]pjC!?mкиюdGЊ БHŸœсM6Љpи„‘љ…ЃOŸXПnJЖ9ЮmВ:ЂЃЂУМ‰‰yхЉC'”Žj8‘fЛђПЦрмG‘fTOZс}’ЬLЬ%ХьRBIЏ4ЪgaиїяaпЇ~hi/ќZп9pЧПrт€х@С‰ЗЗќГл[О1ЁАЪпV濘-%ХЦ3f­’2д›9~xђЇіьЊ’лі /ЫАtkЈ|№!•…‰МАhJUAВ%б#пфILЎl+KЏ‘i\бФЏђŽШˆщ{Ш™]вW—YžушЛ)&s4жрќўЯфš<6„ :XzЏ4кg љ!7Б4QJLюхQXsЄoнљyљR~V/вЃŸ‹7Ю+3Њ7ž{р•}љyЉЪШŽН14ЧЭЃ:Яъ›eЃ!ОЈvЦАyСuе5ыwЭЫ=eьШј0lН)­t†ЏzI}Vю”ЕЃN•Ё3hх+=ёž„шšѓžкpжГŒЕ$xтНžЈxЋС•’4ЌѓВГ/k/Lђ&щЌ Ъ_е*susХ\,љ~- Чы6^ВљТТпEЖ;ПгвЬ(>ZŒогЁрќУЕнOn§AѕМЕћ‘• џцym›ГЉ9KrmyvS9Йъь‡жNов9т№ЁќŽЫ•ПмзH>Є)`>VК+)ЩьP>ЕТ2ЬНRБЯ8Фћuœ_yFхŸэFЬБСН=ysCЋХBў<€wїбН2Р‡C‡Y:йScЗкtz mТяђ!­>LcЮ7м”южЂamчечДІЂ7щ5мјЌЗХъ™д8eаКЇЖдNмід™‹§УlFyKДгbHLM,9ѕвцй—u‰Бѓ$Н%.**ЮЌOtѕЕйѕQёбІq[_Еюљmэ.WД Ѓноџ=ЏгЄ1;‹о‹Аэ6Z:Д]ˆг‡К*DДЅщЗѓ:5”zl†0›лчЖbEпф/uЄt§§ЬŠvЇkЯ‘вpfcL'ЅY=MоŠЇ3п^ц•ZvggЧ>(bЩЬ$йp|2JmО“б‘lВ&tXЛдО(JyaрTTp WйЧК–Ю­?щЄ•г1Hнœcn5D{уRb#Д}kХ 6:ОPgŽq;т“ЃУТњnх+tьа‡ы52bПd=ђЉс'cьТŸ†UVЌ:SЄедЗЄ/ЬaTЧ WОq:”?Ж‰†W™>Ђ‹%ВGЃ.`žћœ:](˜ˆ~+kXzУbюsйRŽuOyџTЅxА^ŸO?|–оъ yTлSЬjvgйГгНМп–‘kЬЮN.2*)+Kвžc’гкЛ,!—*ЏaеЇQxхТСpx œs/зщўтk7ЦЎэаGЛcумQzЉя|7ЧН0ЙяJIхŽ‹sEщгѓ\YМsixAxœgPТœИ”cЋfХсГУУe]˜N^}јМЃж'’нЪћіH‘єdврx“;9Дz>ƒWGВœO”ђсЂM^/ &ah‡ipЌЛ=ЖKюИ` дА­8a"ЇЅЅ{mŠЃ2œш˜˜иТљи\ШŸ%Ч/qЅYњ>ژ˜ЮЙФѕж„GЂ2œеVЇЭjшЫє’8.]TBЌ#бЊ+OvЛ<’ЉюЊqЩcыЦ&ypр` f‡Ѕ/Ѕ~ћф ПJџЏBђ>TЂоœўCšJDœh–Ювb6i$ЖLюFЧЭAѓo/7їhчў$є 8сЋ‘o@ЌжT–­ЛеЊ{Ю,)_џЊe{Vћ‚žБ+›šЮЈѓКыРЋЦyЄЄ /\4Ёrѓг›ж>ЗmBхІЧ/lКx^‰oсХѕг.›?В|бЅjD†ЯЏСњ*D<ЕлгО;п’i-R>ъ˜6вк‹иlNШД~8rdь№oџгъяЮЪлsјЋ7lzŽь§ё‚№&‰№6•Џ1иSœЛQžbNЩ++ъЛa=Охœiy‰CЦх;ГS=–fЃў{^яв FO(ˆ‹жcAЩa‘І/WцЦїM<:ЯxгЊ;Ы”їЌХфЩѓe|'Ну-ЩŒыл—ыSіTmџ!щ0цЃŽеэeхRдžДЂДЂШDх3›, .Т6|єw‰кЬ9и`жЛнбyбR4v^„:IъЋƒ>ђЪA:<рН№џhћј6Њ3п9ѓаh4if$ояЗeIЖeY–_’пђ+Žэ8vœ8‰C $$Бѓ€№ B/)tK)вв Д{лТЖ…Мˆy-НПJoлєзіRЖнЅ\ВлЖдmйv—Bљž3йЪ‹BїnыЬш1>чћОѓџўпwО3^б˜ъЃ2'ќlѓ•3–к4˜цi ЧiVЭЦ{fZтƒwЌgjzЊЗЊ~УЭ…ЊбЮZќ>C3бжбT8_mЉюк8е[ Т§ћ†ЋEЛƒgyotЇп)E›CбжdА*е=гžпжх%ЋВ'оВЭi3SЮX["Љыкeс€њoƒњї`ю# е}Lв“KгŽЮъŽ=kj)šеqgЎгp Aа,Ѓ…nћЙbP0•ДHНDЭaАлŽcћЗ H…ЬАBџћy6еš†§Ца2\intxЏйšпŠnнКiт­ў› › ТђЬžЁ”eQзZp,ђD|ЈsQн#;wЈОКJ%ЪС„Ќ>”#ЉуП )№)j,‹7™Й#Ї*UЈŠTXœЏєбTz…"|4§т٘Xћии-ЃБ_ЉЕ )№ПЪє˜“š‚™ж9Тuіо+ђЎ§z‘d8zП5оt$ЌЎ†ТE-lЩ^0o*gT№А)FЗwХ:цF‰ЕЧ7в‚Э№]Л71†вYD—уX:8Аw јР€NŠюo™Шиu=U#u:бZЉовŒ3VЮMЈоFb2›!6=BэФBXЛ;яЮ5жžEщ–,Ъ`eQЮ%‹ВZY”sЩ>Ї$†%KШ•T+ЉVRЩш$РJ.рšМЦрэaГa;ЉЋBe˜–ўzЈмcК!yfЂјPцл%hzUЩwe+г\iеy“kХ[-OKYQтHE(Љкћ№њ+ю™ˆдmљЬІс;ђДб ‘љJч-]ЙЩŒеTПЖнлšя [еZф­Дъ§Ck‡ю8Вeпѓ‡zЛ;q–цPr‹ЃЯuMДlЙ9пuћlЋXеY‹юћ•.~–8L|kУVa›АцMbМIЇW Чныс `А7•[Xњ’CN‘ lп|Н•Ѓ‡сažг‹`pиNъkˆM#7€[(#ХСƒxŠЖлщTœD"_<У$њ“~mВ*˜gaдзаDcџ?jЧо6™67џкRЈђtќЌБ§Я<УJр[п| Щ$cЉгќЭpж Ь•_фOЧрџXљЉDVќ’Tт\ЁА NЩl†8VAЋ3hŽ5dЪ3M2Уˆд+КJЙžP8Ќ#”3тАAаяЈ›ОmUц ЛhnoxЇs~4QЭWvя|xK5я­ѕд&ы‚ю@§†ƒƒб^7рЁXœЎщMšgзз’цБM#џъ‰Z˜Cз ЬЖй‰}~w`"ЙъњБjЇ$&\ўЎСН­ыšлцЧkƒљuѕоЖЦ”е:XнК9œюКqMœQ{‹яnИЪгиYwЅ;S8ЗБ)‡Ћ­ёhФдощЌi“чдь#ФwБVl5жДЮЕэ„Цt:ЌY1qbЃ}umЋ]ЄПUЧћ`sТ?hy‡* МdЫB*ЭљTz–Кr>НMŸ—мРЭщЫлtfЧу;jЏk0Њ œ„б ялж•Ÿщ№Dћ{{Уe3іvїFе"2ОШаƒ;о\ЭŠ&NЯЕFј ƒе`kœfњЁ;žкВїЙ;z…`st'S" Lё=йєsнЗomЃаєqьЮЅР•ФL˜ЛчdЮ?ьŸѓšщ $%-.ŸфV6jI™’‚вѓјnЬ™J™`“ђ-“ђ.l/ЇŠM рOЯhмhU•вЗђ}2\МЖS BAŠиyљ№В Х‘‘BыmjБ”у†б8ТЕЁКЙ)†~ЌeПHЂKa' jšЊЂYјƒиЩУупLэЦъБђк\ˆж‚кМ† ЩњЁмЭZ…Се"bІ•л7б8jŸ‡єХ‡i•бh•ФЗVЎVЎŽ2o“тq ЫУЗ0ЩЧR‘>GO™Й”Ш Єlаžо•БёЭђИЇ?ZЊЇФ;ˆ›!ЕAоЁGМу‰€5j…?0тЛ8і’ќj,‡чg|)*P’hƒ23aљ“9ѓАyЮL`Ъ№1eј˜2|ЌЌm нj@УїШ#Vє{IН^ЌKыХ]+kю18—ыАћѓz‘‡ПЬ€žrѕ Ъ Ќ>Ы4(Н3(Н3(Н3 хи],ђ,r‡,Т`љDyBОВЄ3Ш‹&о_e єYХ!єgKvЊ,ф П†Хb#“Й}БўLЅ@ЦD<‡,е’шЋiЛЙЋ,”]‘œ<=јаадMƒоeAрњЁ]ЩёswЏX7œа0цgећЧ‡[Џ<МЁŠHо€BЙ•ЏхЙ(ˆˆ *€BZRƒ ЊХKqђ.E`.Хш]JtтRцB0щJj€ЦˆVТŒH\Fќ Q„Ÿ2"™ŸУ5hХцЄš‡jВЂНњ~?Œ^ŽPCJgZY9\A–ЎќћKЩтІНпи3ї?v5dї~}/l3пДЗm†€щЕчЖЖwyР/w=ћ‰ŽЧїРЖЖ7їнО%[ПщіЁўлgВѕo/YўU(›vХёљ4щга+#е— WЏиŽйŠˆх h № Гi@0ЯФњCz“ЇЯ„ЌЅпхщ\$В‡ЪlјЅ AžЧ*ќЋИŠQЋЭЮ€ЩZ“nђ_hСіІЌ“ѓœZ’ФЩ%0 Ѓ6&3чžОиюhш ы ЕFУшфlЉwщwјNђXЖсxќqEзqe€qEqХтŠ$тhрZ3_єœмЂЙP ЙнКЄЪгhЈ)…б>UWБ˜RIО?Œ­у;еМ'š0їlЭ;шEJЭЉo)O§Зѓѕoez!ѓ6Њ)†"з;}МŽQARМ з•Hёk4ќЩhсA‰AkІ--ЁqПЃ’x| •rсA§ЅYФыPэXыбd;№)цrХє(žбщX{-6Ї FDeƒCL‰Ъž†A Hж§­‹AчV:фЕŒхдЯ_ŠCЪЂ Оц’ЪБa1Y1РЫKƒ8iЗ}hYгІ•qŠNЏpYЁ”ЦJўˆќ) З7УБъа~оиЊI4R7зС9рKЧж`Ћ э…цfOЁІ€&uБХtADлЉ‚C*Tž[ЌЋ;5M"?•LUDhВ8Vє(T—…wХЃ]Ъ@ШЉW4)ѕnЭЙŠэ’Т ZяŠ\ZVр%”Ю‚ГG-GoЂю­†^)ш0б*5В!/Џг(тЊЂ`8ŽЛœ(Џˆ—.4Д’ЉЦd;;^В3 /л™ЊЪ~;Ж§ЈЛmX6ЏэuлuлЇЇЗыћ*ДЧКЃљЧЃAћtоМuЈ0иVЈ-ФbžЦšFМqГ/ $R‚ЉЄ„В rЅљ‡ьQцќВ"Q~T3єV.РќeCГ•–*И/cЉ+вЧ;fxl5{Œt1YЁƒ‰JCўй]Љ€ЫЯ„Š @щп"_тШюƒqo=`УШЯ‡‘‹ЋQОG цхдxџ™ЖЛLt+˜л?Що“ sї R~ъ•1ФћТ,eэ Р(x%ќ--Ш(dЖ\љqЩ№ї‚МmCf%~„&ГSP =(“кXА9YЈiЛЉРаWˆЬ2Gи?ОЊхЊУ[p_йœћу№ІЮрф8~mљdщЅЈCP>ниЯbН0:m….ЁКбFAm0B^ђ€„\ фaˆ J€Іfамšу нз†x%$@m^Ш{рxНђ2jѓZфLбЫњі>љs=ѓУќ+OђyQ*№ЉО`_гНе НW‚fо ЎЊо_wУWЭƒ2џdz:›>•ЫŽMЧ „Ё(Б LfЫœОˆ$—ГЩaК"МЁЬ™хŒђђ!uˆЄŠяœ9тrWYЕФ‹8ўСйЂ.wžп‡– Qмсƒ№ќ3gDЈЗЈЦџЏсŒСkГ8šx”6ъЯ>ВЫЄZЇС?Х0чі–Яˆ Н‘fXG\ќœa№_1M ѕзs–ђЎ–WWЛ№—q eХjАШQ \ŸЬы5І‡œОЯщwWGЁїЁ|0J—ЫфТ _штЕ•М—H(nСIк7еќ‰OЦЎn3Ц"!3Ћ"•†І5‘œЗwp ?жbiЂn='r‹їСO яЈXAашDk5ЄзМyfѓzЇŸ,`_oT XKcuGkњy0 !1чyСНгЪ‘ЇЅнu_аю#і*yЂвLyUŽЊRэї‘rC ќFЋWєЊфLKЧњЌЭгО)W;Ёѕ6ЃбЦЋюŠєFѕnНжU є%№_h9iЗ'k“УлZzіЧB! `<UBЧ O}Ї?а“іЦв('TоУgЁм[АAl=vј%ltaLЃX ыc'kc№ДЗЂъ46є<˜РьиА6 ’їgч"#їчMЋMИЉ№}‚&раj=љЯ4ьіL€‰Яф=РƒвњjЖрЙЫХІwЫыˆЛ!Ќ/О6͘U?_}eАK)э3??ѓQ’9 хrр}q.GЅRЮ№YŽuоЖЕiwЃЈсBžЯ&ыўОЙТ•эЎъАУуЗIV_лDЪ‘4=УВ/6eьQ;зTяˆйЙD:љпќ–ЎX“_Oў“U2Ф,‰BгjЬМhСUИ)дш‹tж;ЅPкiwqI›Пй,ecЩBЪЎЂ,жdgиXSЯ;Хэ.шўэaЩяб[<аЂf№яœњГœŸ№П„IрбŸMƒЂж`n`;nхч)dIo”WŠ QэLEкрп)НЭ„ŒCХлŒ&›žт|5 Џ/QуХmƒD‚[TjŽУЇ“U.WДЪэ’ыd№яс3*V5ЗГX-ИеpРnH˜œРт˜, JчЯ;v {х^)q>TЂ\ЫБВ\&.лgVb{к Iј -:$Щ!0д)ОdгЊRK'5"€]Єнп~†‡ЫНётџ) ­•ТЇЂяg*Š@ƒRХЇ‹яˆњв˜А?Р1•ЊaРŒжwЪ§–Ћa.–ф.ьЦЪЏ]љUŠЌnЂьX5?аМp@YMцu˜CїtxwРь™7+*ХгPK0Ftfд_" .ЭЦoРёыЭ[M&ЋNEм†у{€ZАSFˆEЌ^WдA‚rгj0ЋеПА|іo:žUCн"СlвjСу%БЈUХiV9C—„8)gЏYL‹QEпюу*†аАмЇARq–Ы9c0RЮŸ"O+)стtвЈ;WЎГ_ОЮжЫ\g :лXЫ6ЦŠ'Ј`&Э4ТыœТp Yњ№:Е"jгСїьC|дФЯPDh9Ÿ}СЖ…iДmР!вP›ќЛпЄж1жˆл…œаuЛ#V\[ЮˆЯiE-Ѕв к?gН1;Ыкc^oмЪВж8бтв"xŠм$їФѓ&с[1fТГЯА|ьз6 vŠ?uЊ…‰њЫѕэZo7Iv^•!рАћ 4УHЇ#dfsШс H HЃ5O>сKZ^CQЌ^{жу [Xжv:#VЦV§ав{`і&”ЖљІB5н06€ђ† J;і?K%lЫто•lkI ŸНЩD7ќA3п"4дпУёЉ№–„АЙdК%GNфŒN“е+’*|šф . TIъ]NЏ&iЮРЉnтє ЄмF^ЯНT#ђaзћСТыY<I€п“ЌСЏ-д“NMЈ8AK Ѓ# jЪгв"™&S+Un=r•[\х&еo№/щЕщcUЙЅ[nzўРэ'ЏЫ ірТu™ЃСыЧ†іGƒћЧ†і GpУЮW>75њйWЎнкћ^ЙuтЁљ|Ы5їML<ИЖŸEВѓ/}€ЋШdTю#fvЗУ-Л:Ž9жCуЭхЮ–Ћ +Ћ#i•ЊD'3A…Ір*Щc–<&іƒYGЁbRPEj‹ˆЪ ­ šЩ4Ћ!жнЯ’œЫ"X­ъ%œТ2и‹-pі†jУ:ž…іЙэ™T>А,К ;ыёdэ ›g‰P%6№йаtD5 ХU‡`mQШ&ЁдN—ˆБвбrъbyљ_‘ЇjЙ@––+ДS=s.ЫI:5Щш9`ъJ,ЕЉЖ­§5Ќ FдЅš'іtŒZŸДuэ|ЏUы5TAД‹ -И,&еРќКeѓъno8ŸАyТяtЯёŸ%<8зSПeлu=/19;R,7РбNakŸХRx_ž[=YнYН:вA jЛm'1Ёеаji\–Мf`<БфѓQ, Рz„š)э\H.fљRЕ„\kWJ‰YўЬeV$хвТВE-Пr)Б˜\qCѓž'чКїN4jiŠ@>Š­ыюИЂЫW=vУрZ=НЊžяижЖЅWЇ›ЗєзiT IЕЉy|gnъЎЉИЇm}SnзXђРШнWЗHn7Ы™\’СЊWyC_лкTУdЮGѓ6“:Fn]CДЏСэњ)о.щ%Ag њЭ‰5зіДnmдтTнш.ДЎс[вudЋ‚О;{4схбMДУ$‰ХpъЄуНыvШAЬ'јiЭfrZЎЊƒ–’•хЫЪ…БЫaRzй\Ъ‹jB?№’uёћЈVЮт5ачX‘SAРeРŸ(Ѓ7юізКtпзKХЋёbќЄз| Fэ=зkаЬFЗУСэ ‚Еž9{Ÿž-" XТˆэЄк{ыГXќУ‰H]ЄNkGЗфФДž€kjЂанФЊЇЄЅ+ЛфV*+ƒ—о“ЂЈЕrГЊP,Qfb{ї-пИ*{хHкЈЁаО“`ЧlюšсИoрњЕюd8`pXмNмХшXЪh(Жx Й/mKИцЫsz“ХіђVžБ8ЬžЎm}Йщ6A‘Ж Ю{6.6ќ•Аx_лО'Џiп=йЄWЋЧЄЧцК:Жvљbc7 нЧ6D0ЛePЌI7Э жiPa/AбКІ5{;ЇюZAqЊЙsnuќафНWeL.—^™DРюЙ}mуЉ†u+шЫЏЫD n„DН]ЬЂVиW ‘ЎЙmД]вџЌ bc Э "‚‡ˆЈёЎлpЎ'$B@L§ѕ€HќГQМr}ЙръмїYшЩ šЁС"iєФноЗў>^*>Š-рх бe6КlŽ„ЏЁдЇњьс BнЯBD|PFФюDDОАpњBƒЅсyаŒUcM;]aѕдЎ/‘€‹ёbшS]ьЙэШŽ–kв<Š$е,­ЉънVшœI„Gn^л:’БЙ~ЃXtњћjцО2—=zѕуsMЂеТq‚Mэ‚къВК;Ўюoл”skЯF OЯ|љАЋ 2О^‰Œ322ъJћtsпёzКь_о‘nšrЕпŒєniъšэє…{З4ЃЗќСНƒэ‡ОwЯС|z0шћїяћтцHгі7Р6кМ§AЄ ыврu2МЬ ЧМ2#l?ц(э:їmДQћ2ŒАœИЏk г4ЛMъ_№&-ЄѕћЌСl-nЖШЁВ‚Э58ч4 fAK~fJAъХˆs1ВkСrчfVсэeFXџLJR%ЎDt0}DuU‰fџЬ|8”р/UsъswщLœŠвˆмЛ&SFsМ3‘Z“‹1*TЧIЊ…†U3щЕЗŒFmэћжМ. =‚MdTp’š\V3їЃЎЙЉAЏЏЙкbїйPЩ"g8ох4UlЭжoн{xтKa8Цuа ‚2о­FxзxохѓR№о‡`ї/ьЎ”о/йХ‡"јO#]АiЧчg2ћjѕгiYЖЊcКЕi]‹ z§ž=Шi‘0ТйQ?‘ѓЊ:’ЉЩю8іŽAщ№(UћGЂЎє`МesGTЎѓf›^kА=V8AlЩŽHUwТЊвYЂUGйjКЃžLдbѓй(е 7ёœох0њ;ЗДеwЦ5UеБЭœавYтN2Ё ВПЏ§ ”0ЃД№D^/…э5я‘q/ЯkМГђ. (&1‹№ЎьР_;ч"ДЛSд‘6К%ДЎYЌ†юBоVн1—/стОЭXU|/~lЭ^п™rм{†тбa1ы№VЇ)-шьЇy+Оњм›Pћ3KП#,ё:аŽР,јЪ2т5•r>Џ­nћ%дzѕVK…ж/ЛKoА ]ЬбL”%XКї~~mЭкЮ8'o@†ЖЮЎNulЮЛяљ„-тwѓfЃЭ~ЃцфѕWІИ›3лœт†{ЏHƒЕwnHВ‚QУ 6oжб‚$x‡у›ЇŠАИСГЛZf3Іј@ž/ЧС”3b,њfТ“ѕмxђ(ІБЁ[МъЧАQЖfЃ"š3ЩKрžщтP8wрХ[n>q]cыnНЖGЋ†їѕO^пяЎо;0q§€?јРПОiэя=ўЙїžкДіЩїгоћнƒЭC‡_м­ДЫБ0e†ШчxѓтBž1 Ќ–uŒЪлї <:ѓџ!ж2dЯ§,Ёu™E9†B$dтX9†2’§ „Џ_СНлNВBcЖ} њЦєEŽЈжTBп‡r=УG†йk,УLnЫŽЬH}гцBRЛOс*FhZЛЋmуЇІRяЁЇё$т{§h :ЭЛ$ЃЫlц€fУ}зo‰Х†š|О0Є|N“Ю,шј`Р–оpcwлЭї~sїkŒh—#ЁEт8^…ѓе_„Sœ•9п Ђ]ќьђ.ўџR$М!ЛћяvЗЯOd5Ep:Ж~ѕЎžr |C™ѓЭ-Т3§)NABCzbЎ}§с•@lљфUЭF—GЧ]’’О т`=эЫOfPь‹zQŽ›3‹zбА'зьы…qN–…q№%ў€$)ЃЬњZJЌ+ГО?“dЦFЦd0еŒ(^М}этP˜4Šп-эЭеч~Е †Т —Пж­ћЎС€BсѕрЋр`Ф]ќПхъ{рUёNГСэА јПC@)EУ?ѓтЏPl`;ЅƒHи‰№д‰Њњ*yзaн2Vч™Dл ѓKŒXЮWќGУЫХФ Ъ1qnћpRG“ŠŠ5‘Юйо‰ŠЗ'hAq1ј2 ŒГМйЬj # еf‡ХзЙНПmcЋ›”CcНзУˆ2|ЧHoЙ +GЧађ X ћuоzAqfА\œGѕA=>Д9*Ъ.%Tv‰ъXŒшц/FtуѓxЊЇTРчQ ќ<Ъ–2RЬлЗQŽ5€жœёxžбx +Эc„~!Я =ša Ž-,§P>г№№wcђН4агФЋэ%ДV Е ‚вэ2bгБiўЬteM,*№Œ}H…'Yц$ёJrчгoќъ•БšOпvlŸжйc-C5ул[%WћlЁqМ5ba№O>№Gf&žxяБћп“лЏЯ|ўКёŒuѕ=/ьјЬїnk tnмsg9Ю‡˜žР~™\ р№лAРVВ€Deй‹(Жyw РhБЈRUUЊƒЂŠ@ЃJQPн'FчВ /YXєЬ Јђ~ЖЏƒз”}Џ ]BEПё˜ƒИrЧќЃQ~аepGYи’LcЇcЇb)ЙP<іВ,Y,ЖRы2§_œœ ~њ€І”œр‘у"I€і‚ўљг(9QЮNШоыў<m1ˆ:QнP‰еŒФšВb‰зr`PBb’ .ЛЙ’ЌГЯсЗblI8,ЊbQeіGvЈіVё€Šѕar=аЧu†d>ў<Б-+:вЋы[gњjЕhз.NЉ-ЭыЎi.9УOЬЦSю #>Еш2щ%^g ј-В3МщгOэ‘!Ъ€@LИyC@=‹MA‘9ШІ@­ ЅMќZYnЕHnЕ x:ЏAюr•Х† ˆпЮ‡рGBЈljйƒЊх;ъшхлъРoкб7эŠЩBї?ЉYe‡*šп:Х4uŠЕыт P КfД…Ёp &›lКŠ ч5шХсЄcrIVRЎ‡+пlGій1Дi)Ы—їФўѓЮћЏLир*ЕЁi|._™А{ж}њЪŒЩщжЩ‡'їx]f2_сМзeў{_Х•я{NWѕJ74‹l–4*‹‘С­U4И†бИeВˆа@+[ Q4ЂHLb2њž1š›ЈqптdЏ13fcpЬqr'NnУDCР ­ ёФ%дћžSХЂ1ЦЙŸyѓоЗ~|OŸЊ:uЮїќЮяї;ЇЊ›n{ˆэрOlќАш Ф8Чп_ЎMоЦ!™ь‰MЂrMјOmюОюLcВ‹Ѓ1ƒhПк/šі б=i_ њ‡вў!4:˜Fї бA4кN1Ф§єДŸHіЄœХФ„;/*иР†PћD8ћRЋџЈў+r‡оВнэвCјOіаIћ&ЋЮYэ6ЌCqі‘>0jPTяСQіuў=кЗЋK’обэ;>Iэ{Th Л+и;ЅzіЯлЧњъОљ!M}ює­№<ж#ЩЇ-f(Iсџ!№ˆѕ;5` еЂвPіБO˜њPі}_ЈоЃцпћ’Š“–' I‘LН‘LН‘мс"™УEОЅЛ‡дЂЭЅo№џ <ЬўQТN'Гч[lc”vYъCйЎ[–9ЉыœдўЉц1я=єБъ<Њr™vzхѓѓЯМRќў‘g^t[ўŽт4џАP_Ћx€?{ш.Ѕчu>єъZђЈН…dшогеы›uFQYbŽєе§™–ыЯтˆA;2IїW]/cдŽŒЦUsј“vЄПюЯК7є_тˆY;2eюззуˆ…сkЋX]Нn2ОЦ?Щѓ:џ$ЯAіIžЃ~‹ће/эўh­џЯaђP‰нџYЌ)ilьфiЁƒ33Lv/d1Ž›>{јˆ~ЃїЦRK'ш­ƒ†eD|hDфд)ŽqЩ=Rg—ЌўўFП€рˆ€ џсC#$ЛСK† ЋaЬАј”РРаH[€Эl ђHОw`FŽ]'DvВЛŠўJЂю ]zЗwGщo:ю ЋйѓБај#ZєЎА<іSЗ„wїf€pю ЋmЁЩЮЭбаў[„VиЃб@#1§Т"aж…>Оэ_ыЎн xБугL/Š`юж#ШBo0т˜бlhwHtS;[БУиоЏ…ˆ<„НАЂуЙ§ЋгјіЉaяŒ~З(єHз@ою=бЛŠ‚кЇuїЧM/пwєhЋ(ВдзУbG%ФŒŽ xя=бЩс~СД SŽшkkџ[`|шјќq};чэkђѕЗXАBДкŒ~О~}RRb/_S@0dђ ё”щhЏa30:ЉЪw:—юy5.9‚H”ХFУ^ѓ[оЋ/эћšО=z4сШЧG~ў‘ПЮеgќ‚Œ љczѕN_0сОЮ№еіо)§ћ&їЖівЧqO/НwЪВ9IёГ*3',} 9хWK&ЄЮJ‹ŒHžšўЋ!=Ђ†M‡Ц+зшуКuˆK‘,.НцД№Рt#bЙ~EїЈtЧч§›ќ{іьщЯЃ’H1Ьo‹f[{0?Н?ћм Ž}ГmЊQ0љуИE,ЂИж‰z•†УxУЁ™’ТЂвЧПcQ)Ž…%бi7лChШkŽхЖ^Щ4љ5ЁŠi)‰ЋЉћƒЎ >…л,эйVЬi:ƒЯ§“Ђl)ё}†Ф„c–б zп˜!ЃћBC=§c' }„Fњк†D„!>њѕ№3/щ›?(,&ЩШМв?(Ш`э™”л{ди)q™<>ХaœэшЭ/ЩУ,>НюДeLщ—‘ж/#Ѓ_š`E|њФ)ы!БіDšИlЏXЛЏ—Ÿ_PЏ^њБЫ{б пhІРН3СўэЃјыxЮq›h%оaœrГ&К–ЧˆWvGFюШ>Ѓ’ћћЬfSФ€сњюх3rаі5 ќГ‰їNLўEdrlЄADPЃ‚ов/eltъДЁ=ћохќfмФфHГЏП=,Мg€ŸПЏ=ЌЗHПp›офыш#оз7Сш'Z}}ќЌ&K П-lрˆў‘IБ‘&1м1~Є\га­сQk„ЕžьˆZЫС1={Хгј§ZрZfYбИНЛШи-r ,rАњL2"rБЛліFіЄ ЗВY№ щf™dБЩКїы‡G<ЪžцБ>*ZCэСv /y,гЗ{BшИі0цIѓ@нS$•Œ~“ ІЫпш7Јп +юV_w†+Гм͘ƒьУWc+{гр§юЮBиЃ?џЙŽш›BX№M,0v’л9`t|œL[њшДИ^ЩбСттяDяїБY­эWьУнчЏЩггz™m6KH(ћј›еЯjы9 2)йфDУ§C##{ўšвАФ ЌЏRu:—>ыЋ xщS82XЗ‚>ЎУ‘к‘сКЇtсМLАv$Wйљ‘эHn…n„>GBЕ#I(Ј‡-ŠaьЁЪ$х ЁH?„}VёMЈдђГb eі§IьзŸоРњкФ?–‡;ШЖўх_$ЂNOь{ њш}ƒ"‚‚{њ&aЅоЗGЯ=zZ“Щl6bEhе›M>ьk\‚|и7йoџ9ЁГўЂџђщџ}Ц Џt“–;‰шКEžНE6wˆозMо6Фt“ђ;ЪUŒхнфwЊ˜ ?!ЋџЛbНIЎ[ъ-ѕ>ўыФњpЇДм,ЖМ;‰/х’~“|в]ќВя(_ќДиgwJЮЄо5ф…[%`V@ѓэ%№w'A=‚cвc$Є"‡BŠ‚Я$ФЩ y7фна)џфба џ#џ#џЉя.aŽ›dт]JiиЦџoХ>0|GЯб=wFwJNDmd|ф‰ЈAQ;;хЛ^ЩНіHNiwяЈ;JQя}}ўдw@пнвovПўЏEяŒЩwDvJД#С‘ъэ˜ш˜~йтј*vlьЩƒlНœ8hрsƒZ3шZ‡Ф qжИqQq1q‰2џ_-ќ›ˆюR­"šJќщFE&г#ЪjЇ•H3Љ]ЙŒ4\љi& DZЉ\BКQљŠf d-@™“HУ•уH+•З‘nTZ‘ОЁ|M"џ-в#ИЊi]ђHУ•ГH3yZЉ|‰єёЁЋ…йJнˆ2ЭHУ•oV*2вJ=‚у2вpЅi&O+QџК‘ˆH=‚*…й`ŒtЃђ1в#Ъ;уљ7Є™ЪiёD*ДЖ{‘^QЦ mSŒHЏЖ_Az­%…ыŠA(ѕЌŒh`eD#+#šXбЬЪˆ”i к"mSОZQ†ЅŽіП (ео"\ЪHЁ љ3H[•+HЏ+mB›ЈgyдРђeМpeŽW‘ЗзјЕз„kФ€єКв.\Э,ђ,яPF зQцkЄ­8rНИŒДM‘‘^хљыЈџ:ZСY№ЧpУYбФѓ~жбўНЈgЬE=c.CЄ`(CЄ`(šЄ`"šЄ`"ZXыHб:RДŽє*ЯЃuбТZGj`GXыHM<жEєџ в+Ъ\ЄmJвЋЪЄзк/ НЎŒа?Ъ ”A (ƒPњGд3ŽџВTœЎaџuЭЖž мТ}љЫыˆЏ jy$ Z^ьVFOB…1ZоаэИ‘\ађ&2@8ЉхЭDязђнЖЮђ>dІшбђV2@<ЁхmКФЫZо—W3ф[’БMЫSb4 ађ:b4/бђ 5ЏађbЗ2zb5ПЈх нŽIЅyЗ–7‘ц-o&vK-oЁ™х}Ш@K’–З’–‡ДМNЖ”jy_’тS&”=GзzЫђЊžеМЊg5ЏъYЭ‹нЪЈzVѓ†nЧU=ЋyUЯj^еГšWѕЌцU=ЋyUЯj^еГšWѕќ2‘HI„Є 7…џ2V))&e@.ёриXў‹bъяŠeсˆЙ"3ЃID"гp,фу\пsсе…в ‘ц фX\W€2ѓpЬn^. (D]9МlіЪpЌˆŸSЏwƒdЁœ5,Цо"фVьЬ} эGНNыєš!dІfEnЭоГџƒСйл[НKГ_Е7Yџ<~Vхув4Ц8цpЫeЌ№1ыИціgsџ!юВulf`ЯЭ9АіЇskїм4Ž ƒтn=ШжќЮУ{щтЖ<GВ‰ƒq,Ъф№њяхЌдk=h1ВˆK<їё›™Чѓк QЦлbќѓxJPУbe#˜ЫћТ<чцZ;Žчђ_S,хілQпЮYЕкХмкЪ8CїЋ2дЋ%оц“.nQnо†ЊЁyќкэƒў&#"Њз–v;ЃњsзI—.в~…0џ'кUїYйlXQ9зaNЇЭч№ѓ%мbwГѓог"ЭвеК\ˆKюТ’Ќlф.’<Ќ`†KЄwк*Ю•цЙѓxХjCW…ЛИт%­›1eRaVбb)ЛWy{ђбОk‘Tš…О”Кбm\˜U(•—АfPcŽ”Й— ИЇZШК”%-Ъ*-TлbjЮЮЯ*1Wiќ4W^yAViчЄu4Ц†fШLЈ’Ч'&uSН њE3YЈ?ЯЭxИ@Ќ4+ЧU˜UК@*fgКэцо~€ЙZа›EnЎŸюЩђЈ}L@ХМlŒЇдэ*‹Ÿ\žэШ*‹•r\вНЅХ8ыё”Є%$,ZД(ОАЃђјьтТЯт’тМвЌ’ќХ йžмт"O™V”хsГаЌмœтrЈvБT^ц t‰–В0’ЎвBЗ‡šЗ˜г7cђhœ-х;чœruDхЛГѓЛ]‹WwQvAyгEБ”у.+)@Lч%ЅnШF)W‘'^ъhЛИсpЧJЎТyьЂЎЊŠ: п–/ЮLъ/ƒzВUЛыlыUЋk'рpЃ˜>S})sœтEEХYнч,•)п9Ххž’rдОаэbeђ]%ЗtшnЦ‚DBŽ+7 NŸUVRбy?H”Pђ$ЙнFQw$…јБoђрwQ„:№КR}Fr‡Э_tX­eш+w[оfcхu‰w[оЯ—?tЗхэvV^HНлђўўМќ;w[>0х§і}џ&мгБђьЎК'ёGšNlфaNэ$††“$šIFб‡ШdZ@цPФtК”бJВŒЎ&Oгd=}ƒlЃGШo„‰фa6Љ Ш‡‚LОО%ВаBЎ ЈAИH…яЈ$\ЁqBMЎвQ ™q3:љ}Р!вР!f€УzъУпЁyJ}КiўŸЏzЊѓщP§uЯЭGm5hбы,&ЉSћкY~…фМбЙ[~Ѓ0л эОЛфдГFXE­&Ф;+4F;ђsэі#ѕсу  „њје†ж†nslsЌЭX›С,т гІjзwХЪЊ*gЂ‰Uo2РУRгYџвS­Fj5ыАЅG5еугPБЉk4Њ—ЊІо1UVЕšКЧJЌ­нЄЪ„ Ь‡пЋцпIMgйєTхД1сep:лј 8SyAѕšёi&bВ2+šшœшь+еY ­tŒЏ‘X:]ЧиАЁсЪQ[х ѓ§ФЬЕvukчћ+бkі…ѓЮЎ} NЗВТЧ„}kPPПєє• †„ŸWЧGЧЮc€l]Dm†ЮRѓl€Ќ&jЕм8vьи{7Ž=zєи Ћ/Ек"".?9шTСЉ‚у“?јрНеяЏ>j=jхУ0<ЗЖЖЁ"Тз`ј ТlDlcАхЗ™ЈЭ"`–w”myУPНйМе[ZЛ G–йtд&жжRлБйŒдff™cœКxёдгЪtлЬЈЦђХзGея Яхљмс<,œjаJ2G4Ьл6WнRyYэКМaf_bіeЩЭ{!ч…фУ/†Ю kгщl†ЎжР™šОЖжпH|ƒеj MФ†*kkЙЮДі9~ ЕтTЈЖ)ќРвcа.MœлuР0м€ЃЧ–ZЭ8рKЂH0I!б$—Œ'ЧˆRe LxщeŒџRЕ4\ЪW_r€1HФшљ—к‹љЙ‰‰ ъ„…‘їˆНИД€х•КФ‚,OŽ3tњД1 "ьдяНg9Š<ЛŸPѓжКiїM‘Hш§г&БпеT‹кЋ^{5cvIY ДРUZD’xšЪг‘#л„—„—ШЧ„О|€ёдUˆзn'ЦDcЂeu[—иіЈТЮм*ОЋR:х Hk@kрƒ†ЌcўЮ­bLьy0ъxЏuЊє^й%}Ж0‰ Н­ќЏЛ:$сDвƒ2ДU•Де?–a{†эО~Фќ.йOvцVyl”м!ЮЉ?!Г'œ'F_frѓ™БбЗ“a{ЦzЧŒ;ЄЪјWЛфоW˜dьП­\œpЎC&žšДЅC&яSeЪТлЩдУSgZ~ЙД›дГcЗЪ41г’i™&Вkюg2ci‡Ј5ЭЌŸyvfыЌФYѓgэšuff§,/“[л›3цvТ8dZцЌšГE•Юv kыС–NZ§ШЙ™—‘НПCrMЊфЩ;“Œ,Эп“п€ќžќ=n{Вћy.Їм­южљЩѓ†фЬЏžЈž_3џЦ‚4&ѓЋ”,xђЪ‚п-xgСз О.0LƒфМ Щ[…§ з.ќК(’VtбТЂѕEŸjт-КTLŠGB&—D•Ќ/ieRzЈlёь№| ЩЇьб1^/ѓНЫхЪx>(_ПАЯBчТyR…ДИfЩьвCjiМ^VK-iaх–мx,эБ‚ЧЖ<іоc-L–_ZЭхавњЪаЪ>x=T™ )ЊмWљjхЧЫ ™Ы6Ђм№eЕЫj+“‘^bЙeЕЫХхQЫ'/_Шхbеx.U;*C‘VTЏ:Wu%ЂV˜VФЏH^Q 9Откђ‹({\=SQuМzLѕфЧso[ЙюЩЬ'x2ч™Д5щЯю_чщx]?u§дь/6ОxyS№&iгУ›Њ6=Гi§І›ойє—M7]л,nи,mNйьмОљЬKŽ—R^ЪxiйK/МєбKђ–[foYЗеКuфVЯж§[пйкИѕЦЖ‘л*ЖНЕ=yћЬэUл7neћЇлН;v<ИуљwьLо9~gцЮвKwnййА+`WЮЎeЛ^иѕбЎГЛƒw'ю^Вћаюж=Ю=KіМВчм^В7eя§{wьmиНЯГяр>яЫЯ5$@љŽA@ b i$„ &)пЩР`*p ќ˜Lfs€e.qЙ@Ов@мР|`PE@1P< ”eЪ^тQr`!АЈ–(ѓЩcРR X<Ћќ•Ќžж€ч=Р^`№2АxГС[Р фџ |ќ№рCр$№Wр#р?O€S@“Вˆœў4C^ррpoрpјИЄl!џЅќ‰\ОZ+РUe3Й\n?(›щFхК и lЖл€эР`'А и ьіћ€—§Рo€W€пЏЏ€Џ‡€ZЅžОЏ|FuР рЯЪgТхaёfЋ№€2Iј•rPxЏрЕTљNЈ!CЩ)"*чˆ0FР˜ рXр (^X˜ц……yaa^X˜ц……yaa^X˜ц…e5РВ`Y АЌXV,Ћ–еЫj€e5РВ`Y фaE&s,` ,WZIАЈž…Ўžж€ч=Р^`№2А8Ё4У*šaЭАŠfXE3ЌЂVб Ћh†U4У*šaЭАŠfXE39­Д‘3Р—@№а4смYряР%Ѕа h„4ТaЄ чЎ*ŸР >|+јV№ е)gЈˆ€0FР˜ риЛr–њ@ є‚ Т•FЅќі$ 7аш єњб@ рPji,0 т€x HIР=@20H†ЉР/€4`0ŒFN`40 Єу€ёРН@0˜L&S€ЉР}Р єe&0 ˜ Ь*С{АЈVеРуРJр рIр)`№k\ГQёТлМ№6/МЭ oѓТлМ№6/МЭ oѓТлМ№6/МЭ oѓТлМ№6/МЭ oѓТлМ№6/МЭ oѓТлМ№6/МЭ oѓТлМ№Ж“єЦъРQр=рOРћ8~ЈNVNТЫўN‡‡Щ№0&УУdx˜ “сa2bчћ№о"У[dx‹LWО'+'€'Ї€UРгР3РЏе@“rж}ж}жныnuЗРК[`н-АюXw#Ќћ3XїgАюЯ`нŸСК?ƒuЩА.ж%УКdX— ы’a]2ЌK†uЩА.ж%УКdX— ы’a]2ЌK†uЩА.ж%УКdX— ы’a]2ЌK†uЩА.ж%УКdX— ы’a]2ЌK†uЩА.ж%УКdX— ы’a]2ЌKfŸ­…UША V!У*dX… Ћa2ЌB†UША V!У*dX… Ћa2ЌB†UША V!У*dX… Ћa2ЌB†UША ™SОƒШАV У dX,ЬPЮ"ўžEь=KF?м}Х@Ѓ  вˆ3ВqГqГqГqГqГqГqГqГqГqГqГ…фрžШфЯ".­žж€ч=Ъ)ФЦSˆЇO!6žТЬ‚™31В1В1В1В1В1В1В1В1В1В1В1В1ВГхЬ–0[^РlyГхЬ–0[^РlyГхЬ–0[^€е\@яЏ`њ™#<ŒзGШ’ Ÿh„O4Т'с№‰FјD#|Ђ>бŸh„O4Т'‰М( ГЯ0 ‘нфe№r ўq ўq ўq ўq ўёќуsјЧч№ЯсŸУ?>‡œƒœƒœƒœƒœ‡œ‡œ‡œ‡œ‡œ‡œ‡œ‡œ‡œ'oBгoqИLк1 )J+%UZбЛ:a6<§єєWDР_@r=\ƒЎAз ‡kаУ5шсєp zИ=\ƒЎAз ‡л1ЗЖ`nmСмк‚ЙЕsk цж–ллŠђДём?d++M˜c›0Ч6aŽmТл„9Ж к:Э|Э|Э|Э|Эь‚fvA3Л ™]аЬ.hf4Г šйЭь‚fv‘ЕЪ инqинqинqинqинqинqђo8їА и МlЖл€эР`'А и ьСu{}РЫР~р78ў №*№pјwр №:pxј№{р0№Іђ2Fьeђ6ђяя5Р€ZрРQр=рOР1р}р8PœPърu№‹:јEќЂ~QПЈƒ_дС/ърu№‹:јEљз|œBўsМжОNCїg€/р+ hRОDд§QїKј” Ÿ’сS2|J†OЩ№)>%УЇdј” Ÿ’сS2"t"єYDшГˆаgЁЯ"BŸ…uG„nF„nF„nF„nF„n†Х~‹§ћ!,іCЌGъАЉУzЄы‘:ЌGъАЉУzЄы‘:ЌGъАЉУzЄюXШX4b=вˆѕH#ж#X4b=вˆѕH#ж#X4b=вˆљ^Ц|/cО—1пۘяe:—в,2Ю#a4›єІ9ФŸ.*Qї2`9PЌЊЧ•РР“РSР*рзЈk­rš> Ќžж€чSNУc“сБЃИЗТS…х$иŠивŠивŠивŠивŠиrБх bЫФ–+ˆ-WWWWWW1’70’70’70:з0:з1:з1:з1:з1:з12?`d~РШќ€‘љ#ѓцŒ&Ќ$Юa%q+‰sXIœУJтц‘K˜G14biФ<вˆyБzВBOўа“zВ№ЈƒˆCТmN#кœFД9hsбц4ЂЭiD›гˆ6ЇmN#кœFД9О6Уыйњ@†—Ы№r^.УЫexЙ /—сх2М\†—ГљыяаX Е!FDŒ:ˆu1ъ bдAФЈƒˆQЃ F@Œ:€uБi+bгVФІ­ˆM[›Ж"6mElкŠиДБi+bгVФІ­ˆM-ˆM-ˆM-ˆM-ˆM-ˆM-ИЫlТ]fю2›p—й„ЛЬ&мe6с.Г w™MИЫlТ]fю2›0Zg0Zg0Zg0Zg0Zg›j›j›j›j›j›jgоEœyqц]Ф™wgоХœ„91О_пЏязРїkрћ5№§ј~ |ПО_пЏязРїkрѓ5№ёѓ№ёѓ№ёѓ№ёѓ№ёѓ№ёѓАŒАŒАŒ№ёџУмНЧG]пљŸtж­ZЈыЅVkWK/ZДUлjKk[[w{1Нр [-tw‹ь){<œЖPж[Ф BЩ‘FiEŠ%Д „”‹%ƒšI$“LBBˆЩчBf~DfХ2ћœ”=ЇЇzжžЧcчз# ў2ПЯћѓљМ?Ÿof&Г[яжуЛѕјn=О[яжуЛѕјn=О[яжуЛUQ§1O™8cдЋЄz•TЏ’ъUR§л?™ЯOцѓ“љќd>?йIюьаНИїуЬУƒ˜јй~Ž <ŒGАЋ№žЦjTasЈ”ы”r&ЎгФušИNзiт:M\Ї‰ы4q&ЎгФušИNзiт.+ЙЫJюВ’ЛФИKŒЛФИKŒЛФИKŒЛФИKŒЛФИKŒЛФИЫƒмewйХ]vq—]мeg™ЩYfr–™œe&g™ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;ЉГ“:;љŸж!л ыU§&UПIеoRѕ›T§&UџЌЊVе?ЋъŸUѕЯ†'„N5™ЏЇ0УtО"ќ=_owNИЃА1\њ\8VјExшв№@ш“сxшЂpВаN…оњ‚)ž4Х“ІxвOšтIS‰Oс2\ŽOу3‡ЯтsИŸЧ№E\‰/сЫИ ‡ПЧW№U| _Че(Х7№M| пЦxLЫDLТ˜Œ;мїИ wЃ ї`.юХ}И`Иц!гj~Ž <ŒGАПРѕ–bЧr<X‰'Q‰Ux Oc5ЊАПЦoАы№ žХzTc№v MЊBссп­. птыї|§aсaSѓХа'MЭR“pЌI8VЅЗЈє•оrДПъяƒњћ ў>ЈП†~Њ—ц^Q§ЏЈўWTџ+ЊџSkЌЉ5ждkj5ЕЦšZcM­БІжXSkЌЉ5ж$КЪ$К*tШŸ [B Ў ]Qr-ЎУѕИгCуKЖ‡ЮуvгУCŸХ‰"81ќУаМ№]ЁsУeЁ„ч†Ю нўg~В‘6ћгfкьO›§i3аЬ4ѓЭќA3аЬ4ѓЭќA3аЬ4ѓœœœœœŠn8H­Aj Rk?Е2дЪP+C­ Е2Ч<ЧЉsћUsћUsћUsћUsћUsЛЯмю3ЗћЬэ>sЛZaj…Ээ>sЛЯмю3ЗћЬэ>sЛЯмю3ЗћЬэ>sЛЯмю3ЗћЬэ>^‘чy^‘чy^‘чy^‘чy^‘чy^‘7ЋїѓчБoˆэMЦ[ј§Ш |ЏўпЋџїъџНњЏўпЋџїъџНњЏўпЋ—Ђz)Њ—Ђz)Њ—Ђz)Њ—Ђz)Њ—Ђz)Њ—Ђz)jіНfіѕš}Нf_Џйзkіѕš}Нf_Џйзkіѕš}НсC'‡ОЪб‡8њGтшC}ˆЃqє!Ž>Фб‡8њGтшoqєзСч:ј\Ÿырs|ЎƒЯu№Й>зСч:ј\‡Jjх]o№Ў7xзМы оUЮЛЪyW9я*ч]хМЋœw•ѓЎrоUЮЛЪyW9яz”w=ЪЛх]ђЎGyзЃМыQоѕ(яz”w=ЪЛVѓЎ%Мk яZТЛ–№Ў%Мk яZТЛ–№Ў%Мk яZЪЛ–ђЎЅМk)яZЪЛVѓЎеМk5яZЭЛVѓЎKўШЛОЮЛ~ТЛОТЛšyзgxW3яjц]ЭМЋ™w5ѓЎfоеЬЛЊxWяЊт]UМЋŠwUёЎ*оUХЛЊxWяЊт]UМЋ™w­ц]ЭМЋ™w5ѓЎfоЕŠw­т]Ћxз*оЕŠw­т]Ћxз*оеЬЛšyW3яjц]ЭМЋ™w5ѓЎfоеЬЛšyW3ъсO=ќЉ‡?ѕ№ЇўД–?­хOkљгZ]z˜?mд§ŸтM—ѓЅЫљвbОє/њ/šXrWXЩVr…•\a%WXЩVr…•\СЙ ЃёnœRИяЯќє0ХR\!ХR\!Хžц Os…WHq…WHq…WHq…WHq…WHq…дqЗ тЎ9З0+Ьу ѓИТ<Ў0+Ьу ѓИТ<Ў0+Ьу WЈц е\Ёš+Ts…jЎPЭЎp…€+\!р WИBРЎp…€+\!р е\Ёš+Ts…jЎPЭЎp…€+\!р WИBРЎp…€+\Ёјsšпr…пr…€+\!р WИBРЎp…€+\!р WИBРЊЙB5WЈц е\Ёš+Ts…jЎPЭЊЙB5WЈц е\!р WЈц WИBРЎаЯњЙB?Wшч §\Ёџm>џи~тЖŸИэ'nћ‰л~тмЂщ8Яюч ћ9Ш~ВŸƒlц ›9ШfВ™ƒlц ›9ШfВ™ƒlц ›9ШfВžƒЌч ы9ШzВžƒЌч ы9ШzВžƒЌч ›8H Љс 5Є†ƒдpRУAj8H Љс Є‘ƒ4rFвШA6qMdйФA6qПс pс —pK8ШEЄŽƒ\РAъ8HЉу uЄŽƒдqКПРAъ8Ш&RЧAъ8HЉу 9ШFВ‘ƒlф 9ШFВ‘ƒlф uЄŽƒдq:RЧAъ8HЉу uЄŽƒдй~ŠЏ‘jт"M\Є‰‹4q‘&ЎёQЎёХп@Ч1оЭ1оЭ-ž=Љыt}ƒЎoаѕ КОAз7шњˆЎшњˆЎшњт™ЇAЗ7шіно лt{ƒnoаэ КНAЗ7ші†уОкp‘њчЈРУx‹Б OсiЌFўзГ…5КЃFwдшŽнQЃ;jtGюЈб5КЃFwдшŽ]QЃ uС .дƒК`P :™юp2нсdКCGьд;uФNБSGьд;uФNБSGьд;uФNБCGДъˆVбЊ#ZuDЋnxY7МЌ^ж /ы†—uCA7tCA7Tn›ЪнЃrїЈм=*wЪнЃrїЈм=*wЪнЃrїЈмМЪЭЋмМЪЭЋмМЪmSЙm*ЗMхЖЉм6езЅњКT_—ъыR}]ЊЏKѕuЉО.езЅњКT_—ъыRym#Пй№1,Х2<Žхx+АOЂЋ№žЦjTa ~п`-жс<‹ѕЈЦдŒќ,‡=|—=|—=|—=|—=|—ъlWэЊГ]uЖЋЮі‘ќNяыJ~`nнjnнjnнjnнjnнjnнjnнjnнjnнjnнjnнjn]Ѓ‚ЗЊр­*xЋ оЊ‚ЗЊр­*xЋ оЊ‚ЗЊр­*xЋЙѕЙѕJЎUЩЕ*ЙV%зЊфZ•\Ћ’kUr­JЎUЩЕ*Й6T|юџ{˜‚Љј>ўњКйЙNрїт>м0b>рgxH'-*мІ nгЗщ‚лtСmКр63,b†EЬАˆ1У"fXФ ‹˜a3,b†EЬАˆ1У":g–Ю™ЅsfщœY:g–1У"fXФ ‹˜a3,b†EЬАˆ1У"fXФ ‹˜a3ь—fи/ЭАˆ1У"fXФ ‹˜a3,b†EЬАˆ1У"fXФ ‹˜a]:K—ЮвЅГtщ,]:K—ЮвЅГtщ,]:K—ЮвЅГtщ,3,b†Etы,3,b†EЬАˆбНыоЧuяуКїqнћИю}\їЖщо6нлІ{[to‹юmбН-КЗEїЖшонлЂ{[to‹юmбН[tяZнЛVїЎеНkuяZѓlЙnбС-:ИEЗшрќœц}N?ЇƒŸ3Яц˜gsЬГ9цйѓlŽy6Ч<›cžЭ1Яц˜gsЬГ9цйTѓlЊy6е<›jžM5ЯІšgSЭГЉцйTѓl*WИƒ+Ьр 3ИТ Ў0ƒ+Ьр 3ИТ Ў0ƒ+Ьр 3J>ZxЁd,.ФEј>Ž‹q .Х'№I| —сr|ŸС8|ŸУј<О€/тJ| _ЦUј;ќ=О‚Џтkј:ЎF)Оoт[ј6ЦуЇчkqЎЧ ˜ О‰˜„17^-)ўц†яЖ˜Л—˜Лп3w/3wЏ7wЏ4wW”LчџХП§иŸ‚Y˜ŸbnЧ…iмoї›Ц§ІqПiмoї›Ц§ІqПiмoї›Ц§І™Н+8рfя Гw…йЛТь]aі.4{šН Эо…fяBГwЁйЛаь]XђKѓz ч| KБ c9žР ЌФ“ЈФ*<…ЇБUXƒ_у7X‹uxЯb=ЊБ5ючЗиˆMиŒ-xПУVд"‚mjђyКП€Q‡zlЇЋžфАсАqŠXъБд)bЉSФRћР_й~тё;Сщv‚їй оч1— /ї:I4†…Ї‰‡S…LЈ’3g9s–3g9s–3g9s–3g9s–3g9s–3gЙrœ+ЧЙrœ+ЧЙrœ+Чѓ.†7Npу7Npу7Npу7Npу7NpутkQп§?С,ЬЦќ+nЧИ‹ QхАQхАQх–Qnх–Qnх–Q{ЦхіŒЫ9X”ƒE9X”ƒE9X”ƒE9X”ƒE9X”ƒE9X”ƒE9W”#цH‡9вaŽ”тH)Ž”тH)Ž”тH)Ž”тH)Ž”тH)Ž”тHЏrЄGJpЄGJpЄ7JpЃ7JpЃ7JpŸїЩqŸїЩqŸїЩqŸїЩqŸїЩqŸмШo5>ЇсtœїрLМgсlЯ№ЙfѕyјЦрƒј>Œр|\€ ўп‰˜„тkд&у–аЉ:јB<]FEXч~TwЦtgLwЦtgLwЦtgLwЦtgLwЦtgLwЦtgLgfTtЋŠюRб]*КKEwЉшт{nКUsЗjюVЭнЊЙ[Е^ЌZ/VЉ­ЁЏЪtLІc2“щ˜LЧd:&гЏЩєk2§šLП&гЏЩєЅ2}ЉL'd:!г ™NШtBІ2щ„L'd:!г ™NШtТL:b&1“Ž˜IGЬЄ#fRёЙŽЧTРc*р1а­КU@З шVн* [tЋ€nа­КU@З XЇжЉ€u*` XЇж_Я­ цЋ‚љЊ`О*˜Џ ц‡ПхФ?!єЎЃя4КЦжД%ќнТwТ7ъУЗј;O OёїЉў>Г№ћа6’„$a#IиH6’„$a#IиH6’„$AСLP0AСLQ0EСSL§EЯХѕИnzё*ња?в) ЄРA ЄРA y ј6Њ7qoсїјгз…пzgx*ŠяЙќ?њJKС!С!С!С!С!С!AADPAAЙo’ћ&ЙoMїqЮЬЛEг$š&б4‰ІI4MЂЭ hES|hL^_“гтыM_ їЭ‹CхЮ?‹ ћфgŸќь“Ÿ}ђГO~і3?›CgЊ№3E™eJ”)QІD™eJ”)QІD™eJ”)QІD™ ХB'‡іcУ*ћPa;?ьЮЛѓУюќА;?ќGя6јnјЛЁА<Œ>њЎƒя†ЇјћдашаGх#&1љˆЩGL>bђ“˜|Фф#&БPЙьmіш[ŠwрєДјƒCы]2;неwЕЧ]эqW{меz&ш™ g‚ž wйxє] šЦiš i<ќ§Bј §ЁЋнсbwИи.v‡‹нсbwИи.v‡‹нсbwИиўFіЫС~9и/ћх`Пь—ƒA9”ƒA9”ƒСџљ3тF‘5сeьD3va7Z№ Zб†vtтxЏr.єPЃ—НдшЅF/5zG~~ћ† }‡ё~#…aj Sc˜Уд(ЅЦеђv’М](oя”З1ђv’М](oХ^CRъ”къТЛB…Ю}ё=GDDєGDDєGD_єОЌ|eх+{єgFЧъцоc§ЬшпЛ7є:бŸNyД[FКeЄ[FКeЄ[FКeЄ[FКeЄ[FКнгёпGј‡зJ§щ;HЖ‰Ол#р‘Ne,\|_FЉGьїˆ§Бп#і{Ф~ияћ=bПGьїˆХз-TR ’•ЈЄ@%*хПRў+хПRў+хПRŽвƒЃфПRў+хПRў+хПRў+хПRў+хПRў+хПRў+хПRTiQЅE•UZTiQЅM–>“ЅЯdщ3YњL–>“ЅЯdщ3YњL–>“ЅЯdщ“‰™ш’‰.™ш’‰.™ш::YіЩФ>™и'ћdbŸš8AMœЏ&NІаеФ jт|5q2ЕОШ_ЛBп Э Кїс~<€yxѓБ?CyшЫдjІV3ЕšЉеL­fj5gћњї™мM­njuSЋ›ZндъІV7ЕКЉеM­njuSЋ›ZнъЏJ§UЉПЊЗy\AЁeZFЁeZFЁeд™Gyд™Gyд™gцžШCЎ4oЬG.6oФKЎ4oЬO.6oОНА5|GЁ&М;tQИ%tnИ54VDsUщНИїуЬУƒ˜јЪ‹О-g[Fњџx[Цv‘nщvwwї)wŸrї)wŸrї)љнўœ4-КЁяшЋOеЮЃЏ%њ”шSЂO‰>%њЌшГЂЯŠ>+њЌ*>ЄŠQ!K…,ВTШR!K…,ВTШR!K…,ВTШR!ћgњ\ +Eћ3ЫWТЏж‡л GТэЁя‡N§^бя§^бя§^бя§^бя§^бя}їППКТ]tyєNпНЫwящ ОЫпeƒяВСwйрЛl№]6ј.|— ОЫпхNіаА‡†=4ьЁa {hиEУ.vбА‹†]ё9јм_И)ІсaІсaІaq;џ> _ЁaЋ(ОDУwв№jžBУ)4|' ЏІс)4œ"Ъ‡Dљ Ыiи@УRЖбoђШr­ШзŠ|­ШзŠ|­ШзŠ|­ШзŠ|­Шзн‘w?Цk;Mс-јЫ~ƒФ1ЋG_їмIЂo}›шKF?Nє'‰~цбшЧ‰ў$бЯ§ЃЂtфѕРŸјП.QaНHз‹tНHз‹tНHз‹tHз‰tHз‰tнНŠuЃH7ŠtЃH7ŠtЃH7ŠtЃH7ŠtЃH7ŠtЃH7ŠtуёЖA}@D'ˆhšh> šт^;MO…ЎХBQ,ХBQ,ХBQ,ХBQ,ХBQ,”Г:ю;‹WDв ’‘4ˆЄAЮvЩй.‘4ŠЄQ$"iIЃHEв(’F‘4ŠЄQ$"iIЃHоЩ›"yS$oŠфM‘МљИї›еФBГќEхяŠЃЛщЗD{ЖhчнMП%тГE<_ўцЫп|ећ шŸQНWЉоFе{iшS”ІФ0%†)1L‰aJ Sb˜У”ІDбѕ;ЈаA…*tPЁƒ ЧйWO”ЯЉаA…*tPЁƒ Tш B:ЈаA…*tPЁƒ м<ЯЭѓм<ЯЭѓм<ЌŸtˆјЂ'вOˆrœШі„Ў)љ(ЦтB\„суИ—рR|ŸФЇp.ЧЇёŒУgё9\Яу ј"ЎФ—№e\…ПУпу+ј*О†Џуj”тј&О…oc<ŠŸ‡і–bЧr<X‰'Q‰Ux Oc5ЊАПЦoАы№ žХzTcŠЯr?uэМˆ:дcЛk(t•М„hDПЩЩяў~3ЬP0CС 3ЬP0CС 3ЬP0CС 3ЬP0CС 3ЬP0CС 3ЬP0CС 3ЬP0CС 3ЬP0CС 3ЬP0CС 3ЬP0CСт{ГЬR0KС,ГЬR0KС,ГЬR0KС,ГЬR0KС,ГЬR0KС,ГЬR0KС,ГЬR0GСsЬQ0GСћ(ј:_Їры|‚Џ—МьфАЭиeBOХї—ЂEŠ (P4 h@б€ЂEŠ (P4 h@б€ЂEŠ (P4 h@б€ЂEŠ (P4 h@б€ЂEŠ (P4 h@б ф!Q-ТЯQ‡ёуXRШS:нGЇћшtюЃг}tКNїбщ>:нGgЩпZKNХi8gр=8яХY8я+4•œ[иYr>€1ј >„у#8рџїпŠsMЁЎфZ\‡ыq&ˆo"&сFLЦ…v9j—Ѓv9j—Ѓv9j—Ѓv9j—Ѓv9j—Ѓv9j/Yрš‡ Њz@UЈъU= ЊTѕ€Њ(й]ђ|шЏK^Р‹ЈC=dј%ь@#š№ЇН=С™іЦТьЃЛїŒЃ;ї 3hЧШ{Ž–‡о~.tyјyЇЯўа‡ТБаѕс§ЁгТЁї…уўžNšТ)џэ@шђаѕ*%ЎRт*%ЎRт*%ЎRт*%ЎRт*%ЎRт*%>ђщ˜Їт4œŽ3№œ‰їт,œтчgž[HЉ””JIЉ””JIЉ””JIЉ””JIЉ”е“TOR=Iѕ$е“#ŸМy'юТн(У=˜‹{qюЧ˜‡#яƒёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠЏˆёŠхпEљЏQў]”џхŸЇј™скаC“ЈйEЭ.jvQГ‹š]дьЂf5ЛЈйEЭ.jvНgгд ЈP3 f@Э€š5jд ЈŒ|VъЕИзуLp§DLТ˜ŒтЇЉо‰Лp7ЪpьdІ№0…‡)ђiЫ/рEдЁט|4МfфБ7…оЏцПЃоЏюП#Cu#g…Д§"mПHл/ві‹Д§"mПHл/ві‹Д§"mПHл/ві‹Д§"mПHл/ві‹Д§"mПHл/ві‹Д§"mПHл/ві‹Д§"mПHл/ві‹Д§"mПHл/ві‹Д§"mПHл/ві‹Д§"mПHл/Š5›TГI5›TГI5›TГI5›TГI5›TГI5›TГI5›TГI5›TГI5›TГI5›TГI5›TГI5›ќ7цю<>ъњоїј/31рRQAZŽкZыVЋЖюЉжZ=V8ДGЋЕ­еЫ’Ђ‚{Б*ˆk]ъFZk]ŠK[Y†- †lš Y!aI&€Шя>gНДЕї\џ9ћ№ёr’Щw§|оŸЯїѓ 3šн@ГhvЅ6ќ“ЪЕэ‹^AЉ”кAЉ”кЁrmŠІпE|‹&Y4ЩЂIMВh’E“,šdб$‹&Y4ЩЂIMВh’E“,šdб$‹&Y4ЩЂIMВh’E“,šdб$‹&Y4ЩЂIMВh’E“,šdб$‹&Y4ЩЂIMВh’E“,šdбєЇ[&Y4ЩЂIMВh’E“,šdб$‹&Y4ЩЂIMВh’E“,šdб$‹&Y4ЩЂIMВh’E“,šdб$‹&Y4) tВjђ _яїќМF–U›YЕ™U›YЕ™UWБъЊр)бžэIбžэIбžэIбžэIбžэIбžќеUњЮэЂН]ДЗ‹іvбо.клE{ЛhoээЂН=ч(бu4ŽСБј6ŽУwpТžо'ыН2ћžўs3=їєzL/чЛжЅZ—j]ъЇљщA~ђЅо`н7†;"7бї”`ŸШяУŽШbhZИ)ђGqёг‘)a*Шёџќp“шКйЮoС”А*2е(їхСА5ђЄN ?бѓЯ^oЌ ИС7бљЄАХјы#‡ЗкНžХ'рЯоЌх-ј]И*rюФ]˜™ЮŒ<Ќн#сЧ‘Gё<†iaБЙŠƒ\ЋЌзЊBЋ†Ш“сыžnЕІ+О>мn–эfиi†єn(4EЁ)-RFйn”эV|ЃUІї7Iпл­rŠ,0еsѓі“ag№UcЭ3ж<+nеrЉ1йЙеї“Т zmЕƒv;hЗƒv;h7пЇц›gОyцлy(\b'kэd­ЌЕ“ЕlRТюqkЉВ–Њрkfj2S“™ЖYзГušЁк Эаa†3t˜ЁУ:ћZч›fi7K{DѕЯв­ж]hІV3ЕšЉеL­fкdІ-і3зl™эЃ`_ГЅЬ–Ъь~Яh]FлbД-FJЉKŽО™ŸoСsLeйД|PЫL _?‰itёЧЌw[йЊWЛ^эVнfеmVнfеm™y>[БёџaЅгДљЃXNћrsц7–yЦl7fЛ]ДлE“6экДg|з§Зы3т™•Їь5%#мЈџcN5яО~ІЎ'ƒ˜ьї™nр­IИ=Ќѕ.+мl…›ЕоnŸ›yЏKЏяXAЪ К>WOZƒimБ‚-z.љ}:њ]mО‡“УЃЇx<Ї…ГЃЇ{<gЊYђ­ућО>+М,ћЊЧœЁv†Žqцє=,::S|ЫK МдРK єбА—>ъhЃ™6<ж@ кHАr3+7Гn3дГnыжБn‹6вK= 6гL=ЭдГккЬB›YhГoЖуЭvКй.“vйh—vйh—vжaGuv!7Ї‰Ћ3ФSНXЊŽЄГ}ЕвWЋ•WYy••ЏЖђt•dеМЦŠЋВqДЦЊзаЭ!V^mхеV^nЕЫЌЖйJЋ­p=?6YeЙU–[e9ПѕсЏfўjЖт„'ЌИ2gыЌxЏГтЪtœYmyp”•ZQЉ-ГЂf+z'еVTj5Vгh5XЭFЋйh5 ьј;6Гcs6G%иq­еmdЧЕьИ–ЗgѓTЃU6ZeЃUіЕКFЋkДКUVWouЋ­nЕе­ЖКйГж —XaЃ“эEQž^й"БКKEљ +(“ *pUз„ыEiЋ ёаєпYеg+ЛogїЛЇєйIWЕєдЄ.z‘х_Х |жbax§ч9zЉcEјL:П№у‹ќјЂzуEюЋ,2ƒrfRллжєžя‹ББШb,eНNЇВ№ƒШjЙoO?АЦфNЙЂMшЇ|ИšЯЊљЌкњжZпкрp3=lІ;Ьдј7йiЁгl‘sl1–њйŠ04KW6v™ЁЫ 3ЬP$уЌ2Kм,qГќњo|px8СŒDѕFОHђE’/жglЯцЂ0§к‘ЁV3”-?dЫ%,въ†„ŸђюЇМћ)KЯYŸЖхB;\dЧ‹бфёчўмТŸ[2ЙіNЛyвNцлЩьфTЗŠъV{Id‘s1–„/иб'TЗЪŽšэф†’kяЩцк9rэќПЫЕwкyб^ЙіŽНrэъАWЎ-зЎк+з^,з–э•kчў“\;!›k_`н;ВЙЖ ›k фкЙЖ@Ў-`љгXў<–?хЯ“kЇЪЕ7ЩЕrm^*зШЕМr.ЏœЫ+?“k фко9—wЮ•k фк^њ\ћ QSШЪwВђЌ|'Я](зў^Ў-k Dа]rm\[ ’~'зШЕrэх<|ž\[РЫщЯHМ8ћ*§BоОIЎ=XЎ=XЎ])зО\У{ПцНыyя о›Р{xЏ’ї*3YlH\.цЙо3ѓzњXЭзgѓi-Ÿжђх Г|l–UfYХŸяFвяb мЄsйЉ—Чош+OѕsЊ dГA8‡пfћ6ЏfѓjЖ^ЧЮMь\ЪЮЅь\ЪЮUlЛN$иВBНоъєIŸ“УУ]jџ™њr, McЁi,ДР:я`…жѕВuYW‘нЗeы„ж4УšfИ, Џч"=йažщ5їѓЪ}Я‰XџYUЁGЇ<НлŒзОЊe\ЫИ}зk§Кжгэ{›㾘ЎŽNjн­JIёKvЊ0;Ы лД*еЊд ™ нс:­šДjвЊеxщ:x•–]ZЎвr•Iл/Sѓч:ЗВu?я&ќ4mПN-6cЯ*ЗюUЕДлѓ=kєќФžЗш]ЃwMБгєях†ЙK&œjэЦйiфXИ-ияѓS<)Тк3О\mдzЃжkUcФЗфžЎЌэп2т[бєп‡Mї\Ќч{znеsЖžЭŸнZв™loНш1›§GБћЏмIгяЁлWџ-њlбgЃ>ГїЊN3mаЏSПЮЬЮп7Kм KїŠЕJ;.д#•‰­XцЗUwgНЛЮ,Ѓ3ПKїž•ЩэnUђФfl“еwdДБЩ\i;ЌећкьяКVъ}iцпш]ЏїЛvX*ЯЏ1ЪVЫBщYЪŒбm–ЕfYЛw kœєzš‚Ћыˆіѓесsжпa§жпЁп;њНcчн{yd“НlДIП'ђ5yG№Hњwё‰`#НёwОgЄyFкfЄ.#uiЛ‘Жe}ЛУH+ŒДтГ‘2hАўНзщНNяTіцЗЗІ›ьcЇКYl jЦQ8ЧЙwяЙ|œБIёъŒWgМNуUЏТxЦЋ ‰ЖЬkLў<8<87И*ќc№k\ сŸƒ[й§6ќ“p;УiСz4akц3л vтьТЇс#9G…ЋrŽЦ18п†ЛbЮwp&‹qсИьПOЬў;№ФшDЗЅмžVћDWF+‚ЏGЋд›kdюFещzљД)8*кьБ%§Љr7ЪC‘шJ­y$§Uњ%ƒ‚nэЫЃ}yД/іхбОьг—?њђhпЬ§А„е"ЅZЄT‹”j‘R-RЊEJЕHЉ)е"ЅZЄTѓўМР—њьъЋТk(хJЙ&ј_jЊбƒБ‡ќуq-ЎУѕ˜ŽІЊkЉъZЊК–ЊЎЅЊk)ъŠ:‡ЂЮЁЈs(ъŠŠQTŒЂbЃЈEХ(*FQ1ŠŠQTњoPзŠСZ1X+kХ`­ЌƒЕbАV жŠСZ1XK}ƒЉoАXь‹bБC,vˆХБи!;Фb‡Xь‹bБC,vˆХєпЮНŽbЏЃиыОфgG?Eн/SїЫд§2uПLн/Sі-”} eпBйЗPі-rvBЮNШй 9;!g'фь„œГrvBЮNШй 9;!g'фь„œГrvBЮNШй 9;!g'фь„œГrvBЮNШй 9;!g'фь„œГrvBЮNШй 9;!g'фь„œГ9џ Ь…ŸрЇјwќO}фќАШY1ЧY1ЧY1ЧY1ЧY1ЧYQфЌ(rV9+ŠœE9%A,Ч.Ї +гЏ‘PуХpЄ_Э‘яqЯ+:~'ЂGˆш™ˆОЬmц*Œс{EvЄ ѓЯ3Dїб}†шЃюx8:С§§pAt^А_єC`ЅкeЕjЂ"$влDz4КV-Г'кїэпЬќѕН6Яo” ЙсПћ Наћ"†>ш‹~и§УгDp­ЎСЕ"ИVзЇRгiјR\ќWcBpr0Q$н€qnNчљрир6ќ“p;&‡? ІрnLХ=Иїс~<€ёPxњџхНє_№7)У‚йXюўГ%(EVbVЃЈDh ~ЌGЖ'лфЧ.t#…ьŽvтьТЇСюeюeюeюeюeюeюeюeюeюeюe9_ ŸЯйpФAˆA8ƒёе№…œCТWrХaј:ОУёMoсHќ[8#g~‚ŸтпсО‘s1ўю9—тŠрТœ+ƒŸцќ"И9ч—Сs~œžsU№9“Тй9ЗуwИwт.LЦмЉИїтc=ЎЮyРcxOрI<х~BxQd8N "љрёМр’ШљСБ‘ 0*МD”4Š’ЦШшртؘрЈШXŒCчВЏ P[Ÿ­Ж>+:;|9:/М0š —9ЧŒЎWХ7ЛMДК“mОms>n S9ƒƒмнлƒ}‡^ш}CєE?ь‡ўЛЫqsœqsœqsœqsœqsœqsDH‘)!E"ЄH„‰лEШэ"ЄH„‰"R$BŠDH‘)!E"ЄH„‰"в_„є!§EB?‘аO$є §DB?‘р|Тн˜Š{p/юУ§xтЁн ƒGТrб0V4Œ cEУXб0V4Œ žђГixЯрYќ ЯсЯxС x/сe•и_1ЏрUМцљз131 oрMс-Мw№.оCq8YдMоїѕЬХ<|€љX€…X„Хˆc –b–›wJPŠ2ЌФ*ЌF9*P‰*Ќбg-О^чБ5ЈE]јnP№1Ф•ЮN|‚]ј4ш-rЧŠмБ"wЌШ+rЧŠмБ"wЌШ+rЧŠмБ"wЌШ'rЧ‰мq"wœШ'rЧ‰мq"wœШ'rЧ‰мё"wМШ/rЧ‹мё"wМШ/rЧ‹мё"wМШ/r'ˆм "w‚Ш r'ˆмё"wМШ/rЧ‹мё9—[ыС™йПЉ№]б{Ќш=Vє~?чъА"g4хпрёFм„›q nХo1ЩКnЧяpюФ]˜Œ)ИSqюХ}™зBŽЯyауяёЦ#сdQ?YдOѕ“E§dQ?YдOѕ“sожцМ‹їPŒйxs0ѓ№ц‡MЮс&чp“sИЩ9мфnЪ‰Ы _ќN–œR”aeи"Ує‘aњШ0Гe˜>2ЬlІdдю™х~™х~™%&›м/›\,›\,›œ*›œ!›мО‹yЛлЃѓУЗЛkЃ ТХб…сCВЬf{ДЩОYŸVgєgm[ј'Y&§.'‡љЂ6_дц‹к|Q›/jѓEmОЈЭЕљЂ6_ДЮ­sEы\б:WДЮ­sE^БШ+yХ"ЏXф‹Ђ%Ђh‰h( …ЂЁP4Š†BбP( ECЁh( …ЂЁP4Š‚BЊ_OѕыЉ~=еЏЇњѕTП>ZО]%GКFЫУ_E+ТтhЅн­ kTuЮщЩЛЛƒ)ИSqюХ}ИрA<Цэf”нŒВ›Qv3ЪnFйЭ(Й'.їФхžИм—{тrO\ю‰Ы=qЙ'.їФхžИм—{т,0‚FАРС#фžИм—{тrO\ю‰Ы=qЙ'.їФхžИм—{тrO\ю‰ГкUЌv•м—{тrO\ю‰Ы=qЙ'.їФхžИм—{тrO\ю‰Ы=qЙ'Юк#Y{$kdэ‘Ќ=’ЕGВіHжЩк#Y{$kdэ‘rO\ю‰ГњHЙ'.їФхžИмч…Лxс.^И‹ют…Лxс.5џ;jўwдќяЈу_RЧЊу её…ъјBu|aіѓl+еђ•jљJЕ|ЅZО2и>„сs9rТчxєRѕaЏ>ХЋЗEЫwяцечyѕ|Етл<{ЯўWАйMoА›о`7НС*—Сrо`7НС*ВСnzƒня;Лщ v6 w69 ›œ„MNТ&'a““АЩIшv‰Ѓq ŽХЉСзміОц$ЌrV9 Ћœ„UNТ*'a•“АЪIXх$ЌrV9 ЋміЮrл;Ыmя,ЗН:ЗН:ЗН:ЗН:ЗН:ЗН:ЗН:ЗН:ЗН:ЗН:ЗН:ЗНГміЎqлЛЦmяЗНkміЎЩўеиЃнјŽvу;кяh7ОЃнј†Иё qутЦ7Фoˆп7О!n|Cмј†Иё  ŽЇшŠn шŠn шŠnј'Ÿr=Ь­oХ$(&A1 ŠIPL‚b“ ˜Х$(&A1 ŠIPJ‚~N?Ї€ŸЛѕеЛѕеЛѕеЛѕеЛѕеЛѕеЛѕеЛѕеЛѕеЛѕеЛѕеSЫдr5Е\M-WSЫедruАнM{G8ŒZ†QЫ0jF-Уr"A^NЙиyш…ои1єAПє{Ќœ*Ѓ№ќn naЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅnaЅВџ$й’ь?IіŸ$ћO’§'ЩќЗЪќЗЪќЗЪќЗЪќЗ~С-lА[иПИ… –§naƒeџ„[иљnaЇИ…ЙаЭlTp˜“ с$HИ‰vщ&6вMlЄS!љMМ ŠЬ"‘ї<caјЫШЂ№ЭШb, ЇEV„#ѕСI‘nЗЗ”КЖŸ†—G њG_Š _žˆa89œєu‹;оiђ†(]]хд(z‰ЬЗмті™Л.•nrЗeorбьяmЂN™–ш'L›ч7†›мЅr ћ Наћ"†>ш‹~и§УїеЇ5ъгЇг,Їг,Їг,Їг,Їг,Їг,Їг,Їг,Їг,Їг,ЗЋ…Ÿ}bм—|ЯXZЈF-TЃЊQ еЈ…jдB5jЁЕPZЈFTЃЊQеЈƒjдA5ъ uP:ЈFTЃЊQеЉƒъдAuъ :uPšЅNЭRЇfЉSГдЉYъд,uj–:5KšЅNЭRЇfЉSГдЉMжЉMжЉMжЉMжЉMжЉMжЉMжЉMжЉfЉfЉfЙ}МЇ&ЈVTЛU\Ф#эЮћ]ЮњYМаюЌщЌпMэnіИl{Ewью‰юм]§$Ь‹юкн§4Ьюі|Юнgwkn^xvnЏАWnян=ЙћюЎЩ…yЙ}vЗфі ѓsћy~ПанФƒГ4C|wfцїГƒД=Т|щП~кЇХw|З2ШЗ›§ьћJПзч’А4:18еZфžсŒxfЉяVh=7ЌSЫvњЎЮwу‚~ОлщЛЅСе@Оj _5ЏШW фЋђUљЊ|#хЋђUљб‹‚ƒЂџЉ–Иуьщ}ѕЦ|ѕё‡rEяЬИГУ.Яж™Б9њ ЯI†яЈ 7ZчDыŸmŒЙZY™uі фЌ ЯYœ`WXѓЂџЉеžЯ‡8.ѓљуТгя‰о&ЃOп>|Я<œЬŸЇГи*3žšБmyјlfЖЪp }Јrн™ѕё‰lp‘5\ТІ?УхщOвїј ƒЏZw:Кz[oЬZ[ЂkƒЏdМ>GzЌзуЋzЌзуЋzœЌѕWЬйœё|yј‰yЗыЙ>гЋ2ѓі{оеtXі]M‡Eo-’С7d‚Nё“1ЫћЫshn§ЋЕŠўoъЎ.Њ$щwxфE’""ЂМDФfET Y(AцŒ &1‹9GЬ˜3ŠКŠ`@*Ъ|ѕzFewнsoяюЛпнќоПЇSuuuUuеs–ƒ–jујцЫt“§Ѕ#šЇž >­ј~ +>“T1}xѓЪ`ž2PWЪzJ€џI DЧ5з@Ф[#?§ ‹0Z~ Ї\’ЊžžAЬџЈМT‚ў6bЇ|™§}н!Р—?< РqјЙG уЧpТe l'рžТўŸIŠ…wflэ:XЛжЎ“эЌђыoІ *жАО&PЉ*ѕ@Eј›dŠ@сWр€ž„ >(ž0xR;Яxx&Р“ŠмЊPЕ‘§нбўВП7кl~=Hj'HъшЩYа“ž '}ш&Щ𞹆–вС +>•”€Ž8ƒŽ8s ЎVЪяegGdgG˜М„>ўЫFQkЏ“в—в‡ЕЋ`ЄЫєŸ џяв4Њў$мѕ/сnwљKИЛrVѕOрМЃъЋ ЕZЊ9+‰+PЊПOпƒ<ъ`іgАЏ/’‹œœЄю§œŠф-ŒМ#ЛБЙ…а{ZЎ@‹2›[E?СzuАГ/’CдsУмzub…zйl;ЊОVЉ‡(ф-pVI?BYЋ~эЮќ ЋжCєё8ЎфЁT.T ]Jщ3ьрhGФ-Е•j RT$Tј…™АЖ<Т0ЛfзУl Ь|*уЁ… ЇњљРУ#˜нfп…йя)dЉŒћЯ o_@3ъс^“HО/€ZS vЈНч”$зйЎT$З9UЄ ‘аs ќxк*м$?ЅД˜ѕж.хдрЛ•ФLQ FTРz‚ЄJ`DаЄT4 Ч§§yСщЫЮ fџф|иXv.0і'ч{ќЯ|к?)АєГмa"oжѓC9#uN)qzРŸRц šЬ1†{гО›B_ш3‡> Ј7ƒ>Kшk~…уєa#шAй ЮD•г…šžЄŠkыТ FА’@Ык›@ЛД[@{3h:p Тhae#йa%–6№E ї Ї-р1@ІРŸ6Œ|4M?ќ˜ѕ„AП<цаncšA›%|o{W*ЅРЋАCТ5^ ‘œŒŠ0ЛјvHИІаg}вйіЋ шž>№lt a/FpњЦА–‰А/шo§"ш7‡~ hk§–апіЛ€ГбКњакЩMрЁЄѓˆ3†Г4=›Т˜&0F§f№˜У˜І0ЦЦXҘцpЛчЄЪфj€tAb€]рCјPeВ5‡К“ррAxPNQЖwC™œЅм вЃlпве2Ў вјЛ:V[ђћ^€Ел"ЕV7`ўL? ЗвљwщPГ]џM=йVHы_е вNибПG_р$Šи9ў-awƒк?Ћ7ЬЋ[A^§ И/FИіСС~XЧ!XGРGGсЌƒ“№2ЌГсуŒWРЇ=^МoТ№q| w$<БУ§ˆqФ^Ф™8уФ•tФƒˆqЧƒI7в %=Ho<Œє%}qщOМq H|qJ†тd8ŽУI Хd#I‰СQ$žŒЦёd ЩРЩd™ƒ3Ш<ВЯ&ЫH^Lж’x йENуЕф,Й‰ї‘лф1>Kž’јЉ&Џ№-ђšдт;ф#ЉУˆ„"ќˆJqU jИœjPmќ’ъR]\CѕЉ!~M›а&И–šQsќZаfјmN[рЯд†ЖТjKm ІbjGu m Gi{Ђ@;PWЂD;бND…vЁ]ˆ*uЇюDіЅ§ˆ:ѕЁОD‹ЁСтMD4ž&s:žŽ'V4•І’t ]JЌi- 6t7нMZб}tiMа“Ф–^ЄЗˆ3}D_wњžJˆ'ЧЉ_N—Г"A\ЎIMС№(cgљ"DƒЧЦG!нёЁ‘(&*01eC.ŽННКˆ џA ћu<2BfН[ƒf9€FЙЁ~hаш‰†Ђ@4B6N 2zcdŽtPKаН6Ј=Dнž ƒєn  ф`ŽtЌ:м9&Ј)вE6АN[аЯЎЈ?h+ЭѕCС(юmтеЏЏЙјxѕЁ‘lžшЛФљШщЮ;ЂЈъ†Мф< іAўHЧ‚—ƒ4AQ3ЄZ#{ф„\С6Кƒe NЌP_4В…Heс—„"dˆ,!‹БEэР–К ШAЎ€Z V…Ђƒэ‚Щ|†й з2,`ИŸс‰рРЈDRЬ№:У{ ЫV2|˜J> H CE†ъ uGЧQCK†6 э:1t ‰ŠAніbшM2Ц0ˆa8У†‰aёС4…с†s.c˜Ыp  Є{fx"*&)šžcx‘сu†% 2,Š ŽЂ• _3ќ$ ‡ 3ž“gЈЪP›ЁCS†БPpж y†mК0ьТАGl|H чСа‡с8Ё=€aУ(†ё Ч0LM™sSЮdИс2†ЋЎKˆˆ уЖ0мЩp?УЃ O1,JˆŽу.3МЯА’с'хъ'$%ШY0ДfШ3lЫа…a—„ЄИЙ =њ0Т0€aX"p.Х0žс†Љ Ї0œ цDС.EќoDј/cџ‰ƒ-ќЙП€Ц@•Ÿ"ŸЁ6§wОa№`ПGЭП€„эž%Ё†eОS@ХП€ џ€ъЕ_”•И ќ6lS§)Ъягo*еˆ­І/Ћ§•u1xцŸЃкOаМПм1ўрcаh”ŠІAdГb™uхь…ч КБЭ}TŽЊа{TхБ:Ф)ІиЗЦmБ+ю†=ЄчŠ5eЅЁЌЩЪЖ §Bщ"­‘ДNцЫъ—Ѕ%5”ЖSйxъ)kO‘•KdхEi QЉД”ѕs›de‰Д”s– kйЉbЅ{вКr[YйIКŽr/Y}ІЌќ,-U­ЄЖІzOZjШKл5Тee‘ЌМ.+eыjМ‡ѕ”с Ц™Ь‚№b@EищrС№;!WEэJЛгДЇ`D›hƒђщ}6ЦRua,UХp:|Žдv .GЊј~еw@ уOј"X‚%ˆ9"‡8ЂBTб$šHžш=Є@ d)Фœ˜#%bEЌ2э +Ћ­FАЛtmЌ&bCl‚&a+l…І@Є: M…ш4MЧБ8ЭФЃp"š…gт™hDЋYh>DЄžh!I$IhI†иhI!)h/™@Rб>2…LAHЩ@ЩbВ"KЩRtтЩ[шUƒ=ж@tч€о@,чŽо76H‡ЌІ}h?FGа‘4’&а$šLЧв t:AgвYt6CW R ЋШ*pRНio”ѕ@„†аPDi8@rћХ#šH‘"MGC>0†ŽC4ˆT œ йСrК$K™яј.cSсH{"œ1œM[zCк‘vауB\@жюФdн‹єY{‚фaДШ—'mˆЬv#=I?вє†vЅПN…Є“tXuYz@“™rM8gЦ™sM9 ЎgЩВwLBVƒї ИoТ4'JС YЏt„qƒЂ}Dј7&8![ФœgХєBXW—гуєЙFœз˜3фŒ8c!+ќЖ.(Rƒгцt F–ч8EN‰SцT8UNSч48MN Цp щ‰Р‚0‡@э йhgЎ3XИе€ЎЃшКžЂЇщz–žЃчi§…г Д’ОЄUДšОЂ5є5}CпвwьW>ЭŠыщzрe3н чё<ьCXƒЂїoдѓaдfш=HбУє=JбуДž 'aмcZFŸаrZAŸвgє9ЬЈЏЃы€њКЈoЁ[€њ6К ЈŸЂ€z%№ Po ЙфЈў`Lf`’ЭћСЪВWAжи{b8рx’У—ёeаЅD’К4LўŽиЁГCeКŒ.$ЈJwаpќ}@“б4ю€ 4Э@3б,ШzчР0ЭG аBД-F™p?,…Ь7 rхhdПЋаj”ƒж \”‡жЂ|И;жЃ h#к„6CОМn’mh;кЙё.Дэ{eк@}FGр–9Yt!:yє)tюœГш:Šа/Ј]€шКŒЎ ЋшКŽnР}t rэ;ЈнEїP)мNаCє+z„Ѓ2ШСЫQzŠžЁчшЊD/сцЊFЏP zо€—yїX-ьѕ#њ„ъаgєе#‰р˜!_і"оФ‡ €œyё%ƒЩШ›‡?т™s $A$XШžIdЯс;$‘$ŠD“KтШ(Ш‹яr—м#Ѕф>y@’_Щ#ђ˜”‘'ЄœT@ЦќŒ<'/H%U&/IUВgRйѓђ–М#яI-љYє'RG>“/Є^ШЅ)riЪQ9*љД"UЂ§Љѕ†|wѕЃ4FгQt JЇб Кˆfбt;œыNК rм§л^Є—шez…^ЅзшuzƒоЄЗИіœ hžдџ3O>‘yцк <ъuШЉ=аMШІ‡ЂлдŸG%ЬOмЃq4•‚UЇЁћt!]ˆ1mzЬ|iГЭ'LГЪA/7Ђ fЁO™…>Ѓ{щ>єœйi%зŽs†“ ј(œсFя~Ћuџ)+§ЗhнѕюЋц§XїОkŸ п50‡щрџf њƒ жЏc1ƒ.ѓ@MYф`…§q(jЩМ‘Н№І 9рHˆ%к@,‘‚œ№xˆŽмq^‰ќё| “x№OЉdЩB‹йЭžOUЉ6Z'М5B[Љ>ЕFд†кЂ“T бТYІuwс>s†›Wn@Sd ёƒ№”сN`п XэˆЌvjЅ№~eзЗо[ужpNи ДБ;ю[э{#bœe™KЃЙј@T€§p˜Ќeoƒ–пGf,‚FFВТ‹x… "ƒрюB†@ёƒЛ?”„ТнI"сюEFБТ\јлЌП‰ њƒV Z!pоqBьјOФТЪ leEЖВ[Y™­ЌТVVe+ џvДuЧз№u|пФЗ№m|—рЛј.ХїёќџŠсЧИ ?СхИ?ХЯ№sќWr”уш{ZK?ає­ЃŸщZO%џJТч„МбД‹АшTSШ, З {˜BЗЃЪОС.Aп† 8сі‚І)AдїЁЕЊр$<"ц xм 3№ ЄgсйHЯЧѓ‘Ж№Цщ€юэ=Ž AŸЯрГЈ.ЦХЈ1‹] йlЬnpžE0ю,‚щќ9‡Cf2Лљ/ю 4ЧšХ CРj~–ƒМ Џ |л+№cŸwEШuod‚6иЌЧЛу^иіaЛjХЪ!`SBщ‡лБв;Гr8nЯЪШ …2w`evee0юШЪoegV†awVFрnЌŒ;ЪXм,QЌ™@Э яй[3лДєЧ<рp, Рv€и0ƒЗ€Ек†@žJp(v У]#А`$ю ^Р*=у0ф ѕŒЧ}Г!&x9ю И2*9ЁNЈђDО(…Ѓ84M‚›m.иX6мXырvк ЗбQИyŠ№&иA6pН™•~x +§ёVVЧЌ Р;XˆЗБ2oge0оЩЪМ‹•Ёx7+У№*&‹еL 9L k˜r™ђ™ђ˜ж2)ЌcRXЯЄАIaЃА7цуЌXщБ‚:ВBvШ…НRЭвgВnФdd ЯсЦпО… ’doРTё&+†Bf€5Aїжƒћ3'Ls)ћ-Š*ЎСяq8yЂJДˆ>1"MI –/џ;ѓ_№ф,Gћžё) YаЗъфAп2(†?‰њцѓ…@xGЃЯzЁЦ Џoюь§зЗЗaF] д•69ѓщFmх•ЌЇѕ˜VЋ†HNКQshjJ0Ћ№Jђr-е)1”C| МrKyЬсtG‚ЙoО?oг Х8зt’1’№щ‡‚PŠEQ(%Ту*|xГФ8нNЃSr‚зXДпV_ОxќљыGпЅцЄы=ргщ)xZхPpVDГћБЦ™цxusЋНнCMМ–WћЦ*–Івf1&щN^‡ щ,жуu„ŠЂŽъ а„Фај‘[`\ЈX—зštTм“тƒcFGDE…Š5€Д*ыШћ„&'†ŠMx#ЁAEGWк r OŒ‹LŒˆ7сM„nЊЃ/ыі‰ˆ†UЃу"bFˆм:ѓІдx{БяРГџ iЄ&ЊіvіmкЕi7„їnРьoq#^OКОњРајяˆ16Ђž1С­Х-љв…ЬПvАЅDо_зђš ,šŽЭJЫ!šŽ5Д+“tŒбЦЂk‹/ˆЖ)O˜Б%#щеnš…ЧFЩ 1.9єБШ~ѓ~†oъьЛ‘ЅmWiЛR9цuђКдX—c‹ЖЉ ЕИшˆWЋЭ=:Мл{УoИY§Щ6вtmm^і:Уsфз‰}МЋTv2N= vПуйн2Ž O)nMГвt6t]'Ј juaŒƒ}Іv–іћсЖ›ЪŸ˜9лњф,ГŒА#“}Х&sйd™сWЄЉчВzЪsŸBх˜SѕЇ{•PаZj>ўЎkѓ+Іc*W‹Яз”›7О{jWwЗlУс9ІѓЫќпUЏ™А9Я{зWхўeѓ2/L]PuPэMYп;9uс9Кэwe"?/э.Ÿv›wW•“SР`pМ%oёЕЮуiс‰‰qЮЖЖБС q­Gƒм@ю­ƒcЃ™ю˜ш`,сyy(F|gЁ­ чЬ;ёmsrьІёВщСёQП™m+商ЊтжЙ5ŒbšjвŒSх•ПrAyuЁQCX‹ ЁЎХfЎmЬ7њЊпTGеЧЛ3(šS+qЋ6іПГ š–†zE~|ю{ТнXTШьXэYЫWзoǘn`'ЇфŸ=zњяэј?b4GоЉЁ9њ‹‹кђ­Є‹ZўlQЁ/4ўЇ&ЙггЊGщЕ№”)юaI~ЉЇіЏЖ”tp[1^ЫIГ鈄;IЭ#Оx ЛІќ1ЧШњх€fЗMя–Ж<[]šч:зh‘ъ^oгaуУк —›йЕ~ДЧяIЙiЂ•г‡х*ж>с?V™;іщЂ|ёС™&Їnx–жqWžЭ&œђ:wгœ6ѕЋЫ§FЪ­юљји’уѕХ;U(фИПHы“o§zяLMЋ—ѓюЩчLѓЬзKQ7)в\YћЬЗ€ли)kЇегyњ[\{ЧіОжfхžи“]KluЈћ":хЃ~ЙхжmеYоћ:йdюЛЉўКзц‰Љ]*л™цŽд/|Ш"ќ6šфІ™1)Rf’E|кйПi’ЊпL’№ˆЗ—Ѓ oЭ[хXцXL3џ3cLLHhШЬOŸ™Ÿ@тX ќёПdПЗ@с”3ЦФ•xxaба‡cЯЇѓЇОhМфШtђШ… gоЊп–|ь{м>ˆз:§.бшњТћУWˆtvŒяzдѓТфŠI&ЏoОh„NЗКЂ§Ы:гтх§‡ЪЭšИ!і‘Ї‘EызsЂЬkщgОTM<ž|чEVPFaТќ3SšnЮ[6nщŽкy-FѕmdдЃsЩЋ=j"Ÿ›Щ9Kгƒ#О(]šљ*щвђ;ЕXfкM!лЧM;š{r–Йݘ+mF^˜0ьуђ>zЪM‹ЫЎ^whнГ“ž‹F@ŠХ™ќАъ%—т^ИVМUKНwe|ошQ…+њuчл˜эШнfфвђЮмMж уnь6юбЪќиz—[љtN\Р'Љ а@…h–‹Ыt­+Ўяƒ+tj(1<@мWлVб1w‹1"6!6,QфзZlЪKы§Ж'6^zW›ёMЄЧd№Нп+66Qд9)1<6>"qЌрк9ђb1Я;Ъмƒ/ЖГЫЊџŽ~z•“#…qхэ_{Y­^:ЦŸžЛqNГсъ3ћфэЋ_™+rп?wyюМЛШ+]BЦVm}оЇфѕ‹гŒч­žЖыtdJPг›&.ї5№ТЇKNk–n™uййц˜ъ_ЫТnЪЎNKl6ZЕлPйsr—ЧS4eG м’>~M@Ћф>ЯВv‡ДЯі4+ZшЎоXБ ЅAy‡eСКОrЁЋMН2jзW/&gŒЎаuзŒIЧœ+}{|YŸшБЭ x‰’•4? ТёPom—’ЁukУ”з]M8Јzo{§ДdЎф§б‚I™ѕл/LМЙо0~˜KбсWŠyцќ.љЉчw‰’uІ>љ |Z>Ÿ–+и%цвВљДЅ“4‡^ŽЋŽˆ_еДЊюЮОs%ПЌ‰џџ?ПєŸш8ѓ ™OUŽЯyГд ЭЫ§итvВж›avЋWЉќт*З`њМѓЮхfЏ_ ZdГ'ЇћЙ ъЯЗŠлЗВБ­ODНEtЧѓХ›юЫ/ЯщАZ3nфЁzэ~Ч?_v{Ќ5DдяyаИm›ŸkщиЌеба5к3›iчењ4;Sяз–7;…/щ><Ѕжџ§‘ЏГG*NёŸEbЅщ&™- ћо0!љ5“внCпю(=7Ј*ДчY/ŸНЛЉ•ЖdўЭWŠѓRї/=НйбІ,ЅlCђуб9шђШŽ…WлЮ|иY{C›‘F#яЖљѕК1WЖЁ+wnˆНSL_cЕ }ЪЙГЏн№щиэ‚ё€uqwЕ3%­^5МТIЖЩƒ‘*Y§Ž#“ЭZ%ЇШšАцП& &џ-—РЗ…xСAьшр vxpёvmПК„ДuП tx-iКЁ<(0!BDXG“]!l(x…†DЧЦ„|хLљЯ8ћГmкСЂиfSоLК У†=!Ё,јЂO–ˆўшIдOЂШ<ЩЩbбœУ$ЎžU)'Ў[4{?њЂ™ф‚ѕ@ЂћвwЖл к x#јќОќїЯ oю˜Н$Wс“ЦоtЏьщgŽhžоpМ*rЪ\oЃCžŸB№ŒB§ыщсЈгїwкNuС§~ъpр‰уŽС Mлъфа§mdAЗwЭLЭщвиДџ^Џьky—uЮ4ю8J>њuІ™ћ№./ŸЯ э/tјœы^>nЇ‰эўuїпЎyАмLЃоWмy€Sъ6пŠВЪСc›mЎЕЖеъш4ЦЕЫФѕсeЉцсЪ{-<5ЦнЋћš~Sf,Z~|ФИчJuгш„їYЃ\ZЎ[Vќ еЃ–ФPУЁGш;эm5Ц&–^БХ {4/[ƒ<,‡гџ їЂ-Џ$KРѕРПJЧRTuNŸгmіЁeoПsё>[ŸМЯБnЄ_Wјб;oќmŠ.сTM•‘7J‚tн uцUXрУђŽnМЦЗKŽЇP4АKцЦ‚?|#Зћs‡+щbзA]o(ЎџzЎ5§фдЃѓЅ=Џ›OОіјє@я {_,.ЏЩљ8poХн-žllr/хњ{§эЛoцU*њэš:џРlпCЦХ™з2лП]p_2}Йяžžэ,EF>ŽŸ' г[tђžёмW^.O^†U­œwqPphІAЯœ”ЁћXдŸго{&ЗјЬ№YqoŠюnNQИкјР†їгN(uYVcЙ%"eGaЫѕлУšфoЫPŒ\ЊГ{л,SЙ<ЇМу[xзƒfЗјuEAкЦлЭyR“ЂuапEеБfQсТщмЙag/нмxчз Ц4Џл“?Oооw‡ПЕ–Ÿ.gЎЬHъЦ”Л­њ…Нn §УŠџ—ёнїЕsАwh+dKŽAЕPхџ#ћѕг?щџiHt!m‰SСАмз…ю_оœ9чІЫЪ&ГNњMkэїjGќЛЭ[ІмSВУ|œЪЙsљНј›ы<ћјЎщЪ=ocFTW­u9{ъјрa7яJАЗ\”8vMал˜щ™—cJЯЎОКЖПжшРƒq3Cз,бŸБо/эВ{и“ЛWu*њ|oДEkw=Й9a\Іж _“МЇ§TЮOП—{г;+Њ(И(kdіBџ>}Еžк^:дИW^BЋќCSКЊЭnЌ7њХ’ьuqzOћVF|ёл9яe‹ўŽNГЮtыЉЗиsйіЗсkoнW5"qUђl“Љ‘KŸW яZќА|”к•`Дhœxй\•н:Gv]ЎЊy`VЕ1 АЪб­УIiH”Ž‚Dцў!wљю ЊюDnLђОаЏЪШЃБМiоŠЭ—љЯЗQhmЪЅ­сгVMњЁY“ИіПсџў,є–&~ю|ОSŽkŽЫ4ч‰_єW:,ѓ‹‹ŒZmутcC’‚lєtпŽ%„§dЂn|gОуЗL”LГ—бMNNўнај?LќQNшtЇ:гiљАeК~>1ШЙŠ]uзNєнjЛyЂZ‰но#ЫеъЬ “]ѓУSvgІЮікэдфхЁІ{іŸЎћnrТ­мЃУŠHмEЫЈF‡НtѓgпWЖІxMвЪЃ:ˆюљ0ХВФпОюfГџь’uuo_w6м2 лжї8щј*ѕЌy#Юhr˜›;T;”>SщyъЬЌ#w 7\VдkfЖgя ЦW†Nk“_єeSFхFЧŽћм"‹jКN-xV3`чš‡Cz;м9џT>˜“у)щqhљsЗ!wЗ*Oz7јДM铉C{=Б>uЁjЋ]žCЯœшфыЛљъ…ЧЖ…*ЃW;ŽЇsчСmž&ѓi{ўgœуoќїзи9iхМюЗ е ‹ЈћсЉpЭЪŽ^‰ŠUО9жПзTФъ|У^=Ощї‰œьЖП+ѕъsЌcЊYЇЖЖэїv›А§M(з`ŠЊ8ˆШi;Щю№@…"р6Ёn(Х D”пЂPhM€vЁM„ФЈ5т‘нЫIЊй‰cуbGФЦ…§},ЩЅcДnMгжіМ–чЩmC†ЗJ“ оћсжЙ™л†_ИЖЛnрш0Ы~ НмьNe6ЯhБЏ‹ž†g“Ўљ‹&'•Э[“мэДзЈоЙц7Ÿ™?ўЯfЫ#&ŽајјыћЦzмЛYЗzЫЉ–“TМ ќn|Xч3уF'ŸьЭš…J;—МоіЫІѓQ“Ч?ШŸ;1уОQ‹}вІ> stream Calibri UnknownTrueUnknownUnknown endstream endobj 129 0 obj << /Font << /F8 13 0 R /F39 40 0 R >> /XObject << /Im3 105 0 R >> /ProcSet [ /PDF /Text ] >> endobj 140 0 obj << /Length 2070 /Filter /FlateDecode >> stream xк­›Moл6€яљТN2PгќўиmЫВ!лZlk†Ж\[mШvf;-К_П—&Љ‰2ЭФ ƒ%‹тУ—"QЏœonпыЪ #ЉЌоW+„•Њ$|RnЊ‡uѕg§0гЌ^Оыšйœ1VыЏgsЮy}ћлŒЊњvNЈvgsЊыfџ~Зп,ЗЋЦ—{лЕЋvћС–q'щњvіїУ7w7џм УЉˆР3dŽ‘еjsѓчпИZУС+Œ˜бечSбMХADлЛъэЭЏЃJ(c•0qЉr•@q†И№U|;ю"$т*т юњс~ћјttЁк›ѓ(H)№”BM’Ч|ЩH•ž)"ЬФH*d‚Љ’|’05Gp5c&љщЩА@ O&#€T2Fђ’RM%у1 RІR Э&‰RQ„‰Ÿгd0Ÿ€Щ10ѕйјI09УЎCŠ‘L#CG“МN%ё§q%ђ\PЖ *uЁ ”D’˜ ЅЁB,]фЗ?/оОНЃ1c)%Hš }O3f*g ‚”1”!M2j*‡j‚4= ”dмTЬДуFkq;•CНb&a=•3ƒžFPёS1”УЪB(2†R|YPхLІЁъŒЩ3ŠКšА‹„[љЋ)aтљVп?o—RlЫ хqF.ХШр–˜™К@Н[Š™^-1RЈŒZJ‘НYFL“1K1г‹%FJK12x%f*šёJ)ГзЪˆ).kЅЌ#S7Фо*W2Rс:rЉРsУЪ5њ‡ллХяїo2R)ХЉ БЖ|F*ХШ •˜™•J1гK%F2™‘J)В—ЪЈkuF*ХL/•)IF*ХШ •“gЄRЪьЅ2bЊЫR)FЉФШ”;{Љ\ЩLH…ID!ЮrЋ0ƒДXх™ЅJ17heШЅЩ дkЅœМCSЎїJ9д‹e(ЫˆЅ˜й›%†ЊмrЅъе3ЪЈЅœм2‚šŒ[ŠЁН\ž‡Й”3ƒ]†L†0ЫихZh"WUр|у\ЭЙ`ŒFJBo]$’)qseJќѕSwl?лLјnП~.1њР& сHЫЌm8‰РЄOф АG%0AќWт[‚8…БƒHП4/N1т†O@Ї0—Cz2+з_3PhЗC^:%Яї’Š)€к j"b2!N№щіSЬcФ rРKІ‰9vЗžr —ША8Рd2\сг}ЇЈhTтЦоЉhќXЙ`—eTŽІTТ‚Фhx g—…4жЛŠЩ14™їRšЊ%вј,RЬ/ŠЉœЩ0хy фВœ&€z9ЁјЂŸ&`z?ELXŽщЫŠ*‡rl`@вAНЄ&€rŠж/щн ЊЋЁ Ч(Pcў/uŒRH`Нl[ˆŒbŠЩНb†dŽАЮ(І3„R”[їL Š‰Ёœ]VL1ГWLЬЄ"Ѓ˜rhPЬšQL93(&f“QL1ДWЬšSL94(цљоэs-4ЁiV0‰bЄ}пЫтWnYЧЃ{Ч б šqL948fЅˆБŒcЪЁС11”fSЬь3qЮ1хар˜4у˜rfpЬIвYЅр˜bhя˜@ƒcЪЁС1Ѓо%Ч\ M8†УCх4Ы˜ХГ8WОЧЃ{Ч бАмФЧ”Cƒc†P9Ч”CƒcbЈ—SЬь3“ЏНƒcЪЁС11TŠЫŽ)gЧŒ˜,у˜bhя˜@ƒcЪЁС1/€Ч\ =ЯщpИІ:џ3qNчм2Œ!%ЁхTУZЯgњпЅ/џЙлœf№Ѕ-2м> gТ(‚™Р!:neЇ71‹ћ ЏОлС<јѕџr10Nг„™Ф<Бя—ˆі?тљ‹0юџ_т+лђ‘р!ми–ЪЖ›ЧЎй4Ўы|З-ЛЛ}{ќ†XsXэ[?ыж}_ЛW5ЭъиюЖю<Ž rМЈsOŒ.ЈmЃ{ЕлЯЉз w&!ƒ3…MGГад7‰К Т†„‰` b˜\Š•3ŒеюкXэ\ГгoВ=dCЖŸ}ШvЧў›‰Яј4ж`зЋцpŸчбP &TŽТЖжі"Ќ HмUvŠCеBз‡уОYnnЧЖЧ~>.їЫЎkКјл0і]ГДsягЬ‡bn–лmГG.„‡ћvїxl7K_ -ЗѓЁuЇлžёѕ‡ cЇGjТК™п=љљ–>яЗЭ3§A(тЄП|Н(l…O‡fэфFˆBLWs+С№36к/нџу2Y endstream endobj 139 0 obj << /Type /Page /Contents 140 0 R /Resources 138 0 R /MediaBox [0 0 612 792] /Parent 110 0 R >> endobj 106 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (F:/Drivers/GCC/msys/home/Andrew/crc/new13/doc/CRC128-full.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 141 0 R /BBox [0 0 792 612] /Resources << /Font << /F1 142 0 R>> /ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ] >> /Length 28589 /Filter /FlateDecode >> stream xœь}ЫЎe9Žн<ќ‡3Д{pRяPЈAUЕn €vŸ<0ztб]†qУ€{тпЗШЕHiпWfdФР‘(TфЅDqsK_тжЙ§єOЗ?ќсЇПўљўr ќуэOљѓ-оўіу5мЧИХTя­мк їTnЙ…{OЗџзјЗПћё‡1ю cЖѕo эЦ-ѕ|!млэџЪjЊЗџњу‹ђџКщАvK5оKЛ}њё‡2Ы}$kxў‘YHžlи‹›vA@ƒ#”XящD`УFhѓ>Ч‰€†…№јё"щ *•Ы УIї^^с–iџ~йЫЫ{џ~зЫЛя~еЫЋ{џ~гЫ›я~б7псХ{r2іKМ?q ЦЂПpbшї”opŒ%K§D ь§Ѕму8ЌС1Z’з>0ЌС1FМЧs=МС1цМзАѕЇиej6‚78FnВx†58F-їyrс ŽБ6J>{џŒї~сТ #Ч KМ1МС1вИЪІ78FyБfор­оыЩ‡78Ц("Њ†5F щ^O>МС1RМ‡“opŒ|]5ƒНПі2l Žбл=_ИАЧИˆ§Й cэƒџГ%ПоЇъНЙtW/ЂўDя§їПЛ§яЕ\їP њR­Зp/Yўm5оўz№oОЧZљН_JVQё§Rb“цН?J˜м–”ўЪТлТ_Bцц‡l‹2hщэ’Е%ЗЌі>Щ•љ?UFфS0KZ“wˆaYМ‚K ™4ЬSШіHPI*ˆSж@pEљ(iRЩQЄani(yPIrБЅ!k-0 PНЏq!q%џ›ЎNВ:ЅыъдлПџ ы[Dgг™Už&ы”ЬvHЄ>гZ—q`ќO3o-ўW Ѕ€зёY •уНR§цћЌЇh :ыœ,c,№ZЙVr§(](=f‘ХДX‡і_BUМуpqŒЕЖїЕм'‚ѓїхЄЎ$Шск^)ъŽ^+Ѕц'ЈTЩ~ЋЖ#.'gЂЁпз o gё+аКв ЖуЃH‚а­SўаЎ:яIѕ€>чю‹Ј\G“/б<ё–ЇlP!и—BщаDл.ѓe@smzб<ŽсЬ}9Љ 2(šАы‚']Z>eшЦэЦрžJK Эx`8‡_ж•xL ]Дм’к@ЯcЭ9е5д7 МвАєbюС8ќrJW фOŒХ"Вh•Пg oVы1’›“Ёж#вОLјн†с~ZWфQьWж™/єМ–šJfИЌoёцuЉББœУ/ІtЅ@ўФœNHF…уФUPыіv*еFмю=oчя‹)])ПeоˆLе­iйšЊЦ; ГџƒЖЋАќ 8 g№ЫI]I€Cu8А Кљ$Tы$ШvŒЇКuЂ!Ћyr у№+К ƒтUeКвэЎw:Dю U}mвШЫ[œСйћRBWфNМБcQrЩj˜|Ю С%з vщењ~9Ѕ ВЗœC1.iщ+ЌЩВ69ъw#ЋТв†yt;w_JшJ€м-K#І'ЉœjЌд8‰€$ѓec…žGП—z`8ƒ_ж•xTч™Ыа•ю25‰ынН–Oмї%TЕNŽa<~ ZWфбќљ&~ОDZKЉЋ}š’tzоЫ*$Иєkr;0œЧЏ@ыJƒ<.sГТqj{FШйдBIдЁ/b%о‹.G) Q†a8_ж•y\qX˜е6&ЂоЂБ•Иц ЦЂ gЉД(ыА1œЧЏ@ыJƒSюв№ Cш6#uО^$йѕИ+ўѓ%­ОtLGІЉюм5’уПLЂџъзЯgЮ<,ч'ЯbgЩ#B!ёН^ЄШ?gшuШѓ™­„ˆŠijб1лЛсE ќs†^‡<Ÿ9яŒњ—Ož…6+Т$ЎwУ‹їч Нy>3кЂg#ђМH3Ы6с!.гЛсE ћs†^‡<Ÿ9kеу™fM$ › м4ѓь№‹ѕЏx№|fЄХF МВФтJѓ`@ѓЪ~‘€ўŒ‘зЯgОYы,4œU›ЋCкx7МШ/ЮаычKB9X ѓМТ7Oа51Мс—ф_?ђ:тљLMO~ђ<ЎњФЭOЖ†)тЯyё|I ‹7ŠDs›* 1=ђКЛсeјзŽЛт?_ОAS‡Ÿ<ЋnS Ъъnx™п§ŒЁз!Я—tnАФ ЌВGpњЮœьnx™Н§ŒЁз!Я—dэDњTd9$\~™™§еЏž/iXЩР хЧФЈTШБ4ЙTox™u§ŒЁз!Я—$kLЯ;Ущ /sЁП~фeФѓo‹ИJ–jžœ$_Vk~rIH/щЯš.Х‰yIШ4OPL…фKіs)аt‰ЙrРi*CЎ,ФbЬU(ZШUІ!0фЊ™A"Ўjšп".oАˆЋžЩ[ФЕ\ЩKЉ•`ФKФ%uЛg­•(ПK­Un™q7anљ!ц’и2š€ЊгЏPiшОШёKФU4:ЪE"ЅкЂF\bјжВш›Z%TVЋќьu—P™OЦ7LmжF—–№FрGHZмх§МŽHоЄиfД†C6†Ф‚‘YiaЮ5„~­5l qŒжtЦг`œШа§$RиŽIИЃ”вХQ2Й6mь;УеГ}ЄyјRЄA_ЪIlg*])ЧА,ž?ФTО?dЛ[щъn9 sЗУм-Г]žєњ}Г#ўsШ6aТ8Џ™ЛlєШ 5І›ЂBЅk qјl›6#AЬЕ™;iдfnнЈ vuhœ‚yuF€.Zцo™W­Pзьe5Wˆ rј}›†љ}Ncћ}ёъїхЫ'Ю„?9мЌ|і№ уе/t л/„m9ќТ|–ЏВсгnРЋчHлs$ zŽŽА=GC ЛрaУ~ˆљ–›†љ–љъ[vџ›ОЅћЏц‚*FПЂS1КїЙi Ћh ~Ѓћ†?љнiљюД|wZО;-п–яNЫwЇхЛгђџ‘гђ[Rfi™ i™лы”Yм-~ MЛдEˆУ}зД^a…сfwг4пv21ЃeF-%3Д@r[Чi>Ђ]яBх-QgŠ8кС‹)Эн@ ›ЅŽЉvЧnр&_м]Жш‚ыљ‘Ј4ЬSізІсЗbЫе0O‘‚r=–?йх\–6њ…Wт‚Š;ъ•{a6) šRŸo"ѕыyz џ~Z’БfI>#fЇV˜cџVŠO~ыLЁБAMЭ2(тя…hCСА“ЧЇЃў-yћF_шБнvь‰У—Я\Ч-.W; §М8 Ф Єа“ьЈЊJH)?эAОVНйШ"_q]OEЇ1ЄУ.ь>Eйпў{Wхwё*}К ™ДѓД!ТЧŠ †L]1KК%јЪ9Шg|ьУЁG’O~ С­9H§ #H]щOC'СА“ЭcО]і~шлДaђЭvwpЋў3г› ЩГ–0ЦюЦqGd6арM ѓTœЊН пМŒл…ЫsъПUюћ$j3o рЁL0№gЉdgПThYvу˜Ы†rі­aм|>$Ucпž‰3ц`fђЪъ9џпі;<іIн~k­У—‹­BЗљД O+Y]@>†ђ7АœяК‡цTэ ь™ш$;уveѕ\…oћћ,SЯAŽГЭЈWоЪДДUВйьЬ$3E+—ЙНzJjtd1 \,ДG-зAя$M@ŠŠGZw78ˆdїЧїпіK<ќРСЩ>ŽŸА—;$cџzд пеЃСŽ’1в!ЅћДOš‘мЕЁ‹ЯЙ)RЪњ\ыGxА{ЌФЗџ}0ŽЃПуЄ<ъЏiвŒVмџ’AђДE:6яцЉ;‡д5k˜w”ŸЩH sŒЎ…@іTv’!vaї\Œoџ=Л„ЏGMюЙ–ћi3&‡<ЄL]•Ь”{™у-Ц„”№гЎ^Ре>TS–FИSwћcбk,aф…уsA~ЏђиrінЮ Œ”ѕ6РЊпз ЋrХŠмq‘ ’jMžї2 Ц‘ž›Фeƒ^e#ѕb;ЇЋтђБш6–0ђТёЙ&П‹Wyx}ŠјЫщЈWIrnщуŽ”•\Иb… ‰iщњ“ оТ$P7zƒVјјШЁ9сСˆдЫ^№УГчj|у/ёи%эn2[}oxиUž]П7lrНЬŸŸќ›џЮ!~"ьг†эЎp^НЩЅCнOЖпQГћX‹‡}eЋUСП˜ХцМNрхкуЦхO[ьЇиь6спёѓ6зв2Œ k№[^YHy:j^ XЇс МqЯn(v€]?№J"эWъ Ж[йэ"{œП”aшс]7їНёЭб/uѓЏЅо~+У‚п[Ш“3ь‹уlюеF‰ЖЈОslQyфlMэьцежŠС/ р^ѓ[ry‚с—Ўђ8теfœ\ƒэJ|Імƒ§ЈЅЮ_я^џY"k№_ьcŠ8АЖи2НЏіћАЏ§­!к%€HqЋЖtхk с$ЌСI0KЗi ёіZЇ8 k№_;a– JцHhНVCNУœs$›“Џ5nЬaЛћ1~h/JН_iК5‰oW}F‘iА…cОR1XДщJЛРС‚)(Я#n{ЅMлЕLuиPЗG ёZџкС’7иfцЎFћ ШќЮз*ЛП(ЂŽћW8сhA‡oюЕ’wжАІТ&ACя4x%ѓvћЛYјnО›…яfсЛYјh~K№7ТИ™)yыFQљ-Жxк‚ю?Ю Э^+П/15Šпєы›УtЈэz(Ф4‡ih7nм­Лв з/eЋїCЏЄa?фN­ љќMЅ4ЮŸ , їѓКihчo* и{%]RANУОЌЩ“EуќnFцљ-VšfmИив/‘пjД№Џі|~RЮ~г„еі§›Jo­шƒ—Ѕ•х‘дш…ц‡- EїџУпя\фFаУ?@x\Ф,Н=ў„Ч!•*ІЏgєC„Ч–bљi /хќaЅїК‡ФП7u!<іК)пџТуВŸідžм„№8Зпл‚ѓAџуиЌКБоўТуВЗѓ[У?ш\4СляўТуЂ8о–л=ѓЮјЕпœН‡SЋќzј§Cч5е(ЏGПпџ85d|kцпя~\Дi~Sш>BxЪїнё <]­ПїжјжјлпџѕЯЗлOџtћУ~њыŸџс/ЗјЧ?оўє—?п–э^žž|m†_4nј• Н !ЦћO?џјУOџ%офЬБІлЯџЖtа-ЌџХ›8&SŒ”%џy™эpћ›ќГlРџјOс?џЫэчќё‡ПџY­Ы+FвWg$•zљ#ёЩ_‘Д.с%#щ)_Ÿё—^ё‘њељћSњы•)ПРHћњŒрк—Œд_`ЄoF№ш(š†ЧUОšiv РrНЫЬЗX"†JЎ5ШQП™Šъ ](<ыA иWŽ$Ў_ц+ЎЖi.@ІТK?Ъя•ЎPЉ ЊО*ђ}UFƒєж%…$Y+шFЧ]…6$t…BЧа(;aН„ЉЯ•‘­вcЄ>ѕƒрX3§феP'р| &@QЁ0 ТрвЄЗФШЪbцG–ђ}гфи"н)w@] РyŠЁ A{C‹„&]~БН+ѕmWУozVУ2Љ7Ып}&ЈНЕ(ЅžІB5*ЄмYi" 7а2hLtcЂуБНЄF9Д(MТч$SгјkOђ3Г"EraЌ ќк]œњu~ЃЫт |ЎЗx‘щGїcЙMЂуSОІВ" ЉЂ!IwГnb&T‰МГЌХP@Щ–*ЈЙЕ+nj Ubs~ƒtG]2љ­ІPŒ B ,ЧœU– ” M…тP…QвP;‡ЌoS@ЁhuЬЎ UЛgдHрЁйлM˜"Ь%H€ѕmЇ|DжєЗЊ€(Ў"І k2–˜Zђ.|3ОЖ€X КњC/]~ѕныё‰ЕЪmпEІбД[ЗмQ"@u"@'naяšlЙ3ƒММH-зIфо@И)ЫƒL6хiLPю‘ШГ‚хХЙ@ЄМx•ыlѓЙњћuщ€ьљжЂйCe'D9р]„kЮ—tfшР­ЁC Ў•]PPЎk”@а­S_ˆЂ†\кN ^­{ШњEЃф9ј$UЇКw™-ќ‘ІM#™шк› ГоїЊџqЮ.ё”а–kЉ4&&$Ёa­ъ‚ŠŠЉў˜\Ч ІrAIЇdŠщФJ­з[афd&@Ђњ–dѕNф)šwяLјЂFКBj#ф”ГvыЯОШз_ЏЁђуК{Š]Sюи-EяhмВ‹–ќ’fТ& *Lc9ед"ВLђЕ+UC(RуPћI>zeim$ctd pГcЏHžЅRU Йђ"‰Б–ЭЏ 1›[Н†юЁV/NМэ’ЙcЋR–wЁ ђрЅ’tЗgqЦхgРХДЬi^ y`GЏі!?,ЫБ+ эл9QІ ї№вюCвшA[/Біyв UJšЄјеk”Ѕm†ќR т’œ>е{.Ÿ3dЩЙЪsєї4мt‘єr}}ЮzЅЎQЏ~]œ‚ѕZ jЌхNуЈЏ$ltUŽRк+цU~;:r6ŠЈўе Т–Б˜ ­WZааO“X2Ьs`Cг=+WМдuWйБн>&”эЊ6ˆЇ"bМцІыЇAВcEzъ\ю ЮТ—,wrTg*‰ ю™хнвP‡5ШЎ 'В(0аyЂ ЧСъ.‰цЧcъш еd.fч‘^К‰љщЩ”NЛЊАtЖ™ъ”uQ@нŠс‡xœ6EШ-Йрw-vђьhX")ЌЮВж$ІЯ)fнн,%н_ъg dл/$6шcљ:В l`зя|ШŸєнGФJяІCЃXDN[‡Мб%ЭьжЅM$П фъWєБќФ’JаLХeS,BRШЗuUPо} [Ggв!AЈQA:фКНЊ› Љр&bљ•zє™kѓ л S§ AУЋв>J1\US]Э”ўЂžЂGeЂnwN„Ќ(юSXЛWОђМkЁ€џгfЏ†L+™(т‚ŠfбЭR#ХН— Y2ŒЅЌЄ2ДSˆ”žТyQI› М’*}НЮbˆѓ›0Ф№Џщ•mдБpušZЂit} 8‹МQžzй‘ZШaсфюyt‹„ЏјЅcё .†šЦ[ќјІ3гHљ••€™ыjљч) "45‡ќЎ,{‰к‚ЊЊў.?ѕ+/…gПйibpUЫз㓆 бК™‰ц+Ђ|>6щ=P,бОVшr0М<..ЌФЃВнГЩеЬDCдMл+ф Rа2мМ­Т’aэMњ м мd:4ZE(gИ-xМeлэ–с= ЎxŒ]oЭxЛЊP4§5%–{Г ’њIVP&QŸ“Фђb=B‡с—ш,ъ3ВVp …*tТпЩOiъяД мiО‘ši§щд!Б+М…ЂnUх№AЭj(Dаю"jПЉЭˆqЂih№чdDй`ŽГIƒŽŠШMkŽ…p8 ж<Њ”2Ь"жЗS%cЇJф$™ž+)jёwВDЎЋ*GЎdJŽ\Щ•ФЋdIŒSŒŽњoЌ™ђтєў"ю H,y bœ…8TЅ4d4TэхЃХш„Є‹cjœ = йй2)hдЭЛZжѓ4DапVц$ЫЗДК!жjїEеaв КDОc­Я‹ƒ)чаШРTHCЖЧ%2+в\(ГF№в \0Ў…€@mИHт9*нšНгW€а‡ЈA5X†xуЉЙКАЗ-ПХюЄJ@.ЭTЁB@ŽN™г&ёачBћч<КXЄ\Јq€L4Ced€LD їьsСЌШмS\Х ъz т.K ZXчм]0еЉеО“ё i—/i•’ўY˜8№=ЯUСжэЩ,Аnk4у@ГmjяаГйF…fwC.Ш$tBІ aф`1;аџтќ,H5АFЌЦНу%Cцmfм:РmиUаИnЄ 2'ѓ„Ч`~СCО`uzкћ(˜ЊьH‚ФттŽм$%1Њ”Kф#zЕUгІFдwІsRЁыщ`D3‰ЩXŠN/G- 35М`RЎe…Џва=‘ЩЈ0NЬъt3] U ŸІKћэjŽс&zD>&Ђј1vМqаYZPGjGˆЦnZмT‡žjЋтЮА}>{њJміQNz#КеТVьˆшЛVМЇ[Ёb4Ь0,‡MћfЦДiXчл=0qёy­:мЕ?ьі@qлk –Бї(€БК H:б•hCЊВЃ›‡7•КйЦьК#р€Іƒх —%5=ёZЂMEЕVWEМs2&\5oжP#)рŠ єЊцгdЄ@б…Jцw‡ DКCeŠўСv‡ёŽяж!хxсЊq qп ”&NМ†NLK‰†<сPtˆђ€УЇЋ>юœ§lИ•zех›№$O)Іd'Р2~!-uhЕЎЖGЪr‰таb( ѓіЁ чбл8жЇЗ™ŠЖ[Є™“„ю ШƒрK Aѓ"8ђэ*ožіr6M–:vBV “єЗд5Ѕ9xNvфЮьpжюF _ьVѕЃŠ!38šшЮP8зЕ&„`У)3 ы`yW}ПЋЃY-ЮеЎш“дЬ•#4†i9"bЃсЄ@яІ=ŸPvqDƒrТ-Њ:Ysиl@ с I Ш>.)T˜4DэаNР щ‚ЬDˆыВ q<&Ј%\dCfкНjxЂЮБdДК0їн=* 5†G@ š LыbKюLxKZ([Єˆч$O§9ТRe№\[EЬ:wД4асnшЦšь„С7ЉМ‘ќ~:~EDЁ‹дшЧ\ $Эты–я№>Ђ†Ёšлcˆ†МŸЋЄJ šcЗ#Ў Ь(F ќ"v2E1?jzqъnы d*IфS#n!д\k7dцH97I\N+њls{pЧтЂTMбjЕdRЊƒ%ъ–Ѓ†yйxмhCЙѓˆГ'& оЩVЬ#[бД€эШVєygiGЬCќє,Ч‘xN†эIќ Ь …зЩŠЊЧщ‚^№ ЧjPгF/[Й&гЖ5бђVљљIeЎjАkкњЁZ.\ђэ€$8лШcЮкай mЂ)зЂё†|“љЃŸUЋ4HЛњTEsŠ?DЌPЗСИЂ œ02ы#r"rею`(eЧ•i(§ŽŸ'˜РKОб\К! boKзЅ(ХоGоН СRКEхEKёЅAŒHб$K$Y‘ў2xrЄ EФw(+ЄяІ— D%TД:DР/zєсKСЊ$ЙRрС ЮE-Ѓђ91]FYdp"_Pэ'Wї „тЎE…Д Їг(aVХЮ.NVWЌd$’:o‘.p.4с#@ r“uОЄ„Ј ю'<буе? ђqЬУ”t‡ŸЇwуМН5<‚žs‘EЁІ@|ІЬF5ѕlTAКЈRH3x˜и4§ahтxБB^ОcЂћ[ваВђцы7РbžR@^JЪO+RЭp‹Њ_@AЉЯФ@]–bОЛ4 s8€œ!" JЬ#:с”ЌA 8Nфˆ>g8`Аh‡Œ( Ъ cX­EВ…Q{e‹U­8QbХŒB†НЎzгYФo№jїTBŽ[™6Эк]@X–H <Imс†ч2Ск9„КSfУИtЯ=В]Ј6ОšE4uГлУ^ лЄсеzі &{дЋO0d]_}BЖ —ВІХЗ‹М ŠIX V§JeЖЧDaІюFDИЙшЏQBаd{cЂ8QїcВрUе"ќэjWZлnЖw+“чизбRЎІ!H™Fd9ЬМЙ–*ѕЊЗБЈ1РлУN`ЗšFD†Ћvи‡ŠЉ ЊАtЭ’жqЊЌђдˆ”МтЯ(k5HJЉТЈ&вхШ^ыы\(sўЃ<nZUoъf5РšwиіKпaл#ћм`G{єІdН Сi@хˆ4d’‚э/$еPв Љїt ИnСіFшhI$_-Kђ …ѕ{хŽЬM„оЃш0M"њТрgб“%џЉА1ƒ2эмQ € Ј*г#ЖЄna?IQЕB›DœePУЁЮRџ(ГRs2O]PЌJ[Щ‚г :™ЁKё‹їИзl>к`]*ЙрjdЌ}КГlЕc)X§Ъд›,hб,—Ё,iЕХGІ$q4~(…FŠ9Bєъ?аЇD4“=ШzДbљž„|jЦ2uTБАвˆIe&ыТрpqрx2B­ ы$№—’LЬдЪуъ_Ъ%[нЪнУ šОСдЗhGниA,њз­І@і\h‹цд7[`А…K ЁКФ'кpГУЄц j‚W.6ЯЕъєT2•5Ш3ESЧFXH …Рš•~9"”*b"šgЖŸЁ?Е…%ŠxžXЬш1}1“дА0a›ЌИШ§цбЋюдjт‡}Lп­Zy z Ш7‹еxŒƒ К2ЅƒTd^PsЩЇє`!ђь–D$У iфФЈP‡XГt66›ŠŒќhцСsЖˆE: Гu№t™Z­8zэЩЊ^2’П<B–ЄCEуGЃBш8PCьЈJGб'9M_w@‹Т№Тг‰šœ QDЋ•­А™V …Ь&mqsˆXЙг BАlЖVы'ѕMVЬ(OчXЦlžыАœ8ПИшLs—јО…Ћп“y6г —љ1†BNxf+-чЧ _ыs\ N;t(Йа‹•ЧiIўƒF@ш2 :,ѓтžрhqBaC‰TО9]Y§‘B9ž№­ŒbфТ4CГƒ•@ ŒО•Е„>XдЙ3dЕyИ€{ЪВ)Cї›yЎYЁт{hА^—Ц #Џ‡$? %5n[Žj ІižќњG=ълВ^*љІ[dИ);•ŠЬаP§Ч2ЅlИcSЖ…щЪ+Џ5­Б:OWЂ˜шb&˜Ў,„`ОhтхfЪ^ХІ@-ѕДCРˆ%ˆ(ЅPƒ8YcЎŠ]ИрсVƒ‡˜њrУТqзˆЊФoAyРю6ЪfЈqЈдT6x‹5єС1›А>…ШTјьЧ6vЌйx­жИКэуДWИ§-ЙœаsoнŒƒ8яХ)уо^>X=wА<нTІъ<3&Ћя›нKXљѕ•JЖ,нGŠBЅРЕSбЕj‹Ÿёcмw1ЙЭˆ!РRRTќ‘6NХи˜Q‡K^ч~Йlg"•^eТьБіES Й–ь˜Оз0кб-ы‰X№\ЖLбГСшIvRфA}sožT‚ГdѕhƒЧ`H?,КW!~ЁЎЭCЫVьЦтрeT ФzЊF0јNAЂ`%€KёгGg1ьУП0]~ј—bЕo0xј7`еŠ<ЫV‚=šИVьBуѕёпtрўšХ|4™zY/SЂ§L˜œщщQ™‡YiUDЖgЕ,[pмШ#”ОЛq Т‘ž 0КќCЬ=мŒY-;ЭЬг –сш8dСJb•'s‚Y=–,?ЦИuт—Ч`ВtCЪŸІd~O ъHІˆ+6Іe К#лчтшЖ/Э1Д2Ѓ; ™‡)"ДУS"ирI ~Pр)&аJє8 zœŽœб_єtHЖіFЎЮi5tчѓкlpоЃеVg”™ zжКƒДЁXŽv8Œœˆв+†ˆž–Ёš<*G1РР9Ÿ@U!ЋTХќŽuw(lБqйЌјн”6И^йr8 Иќ~|jcўНФйJVB2\ ‘‡vГ€EdQ к›iШeGN4OˆЧШGЛё`}зŒЌSД MК.кѓЅAДц`Y jъŽV§#[m`‹^ктb$Р)aљ€”4ф&GБ:ђрЫйЁ8Кљ=wФzБ”зœЪч!Ѓš–езЏ0žЛЪ\c№%И@#mщ+оWЯ–bїФЁЭ[Жбqx Љ;gyњPн Z}gЈPЦ0НY“iЂ4&3дњAЋ@9YёфМ# љј$_ i„ˆЬћ3$™…>…ЬџфУ0›>Б.ј†[џЇ]W+ћ”ЫђѕOl@fcY…Иц )/ѓhH'ђbSЁbRљtyTхб“ЋŸB†ЛTј›!ЃўEѕ‰\Ъы 2 цkјѓЉ!СЉаТS R Г+D;> 7С% ХЋ*:FВ>'ЕђуИњN_g†-kщѓЮ[*яќЃлќ–дaЕй"УѓЮэС™œУЋЎИw‹юšўcзfсШЕ SГ1ЛScеюSЊЂ•f‡L…MDЌ;ŸнвлВ2Г[ўšОйьц9Зт|NL\жi1іьVп:@ŠŸBщNA OЕUЕЁиh….”#Й0ыжQ6E{„в†)Дз ЧсšnGЂ˜ cЈкGхCГьј†г„и4fїš~„шp“;ceњ'H Щœа“i^—=Yл85-1™’ЦkM?|OфŠбN3œ04џŠ`cy‚Y&4Р"ƒ™Щœ5V“yD'<ыmMЌъъЦŒѕЁ‘…ВІMўc_’mKЊ#;•;‚Xˆj<Џ1џю?ВBю'cхћйлœэU&Э?j“зѕј`Хб0m%cM1б]њРЅDDМ:юƒЖЅч}mK—gн&[пЬ<0d“›v'9NЏL(#щ”–ІU’ь.‘ёвџ–yj(@wЮ›ZрхЩЕG=Вцfн_‚ц-3}žd›ЮсЫ3jгU{yМэa[ўхIЖ)жощ‡›œyщсjf^ЬgлМУОПдSїЛЉр0‘ ˜/L<oЦОЭХакЫеmšг/U ”КuzдIєпЕЇO"Й>6wsiOSJЂЕЇЌЎ ЖДЇў]§Ѕ=§šу_кS { 'џ‡ rцI0žВ% RфЂЊ>­]‰цOoECћЅ;ўJоюЃбUО%ogC“щ6ы\SєDДл‡шњу 6Ыхя•m‘"сЁУжNЋиВЫ{МДЁ‘dУ‘еЌЃ{SGи|јE;4Ѓ№„Šоc7У›’љЕNЇЩ†Ўš@З0МВбЎGІš ЧfтЫQсp?ŸяQ>Eа0|uRчzт~#Qѕу~,Хм{иўиš§ю™tВЧЧGŸ”lјŒ5Aƒbл.К•hЫ<с)ўЯЅНњ+ИS:оЦ{Р~ІKjW_Rr;<9UpАb-''vрк№`о‡*ˆ —y~а3=Д+ЮАЃ[1xДсЈЭgз`~Ё,Yм‡У;/mќ^C'WV(ˆ Q’хл%ЉЛмюŠMё№rЌс=J„›Bъfƒ“|щнHЦЂu+%лm Ž‹nYўонCЅJіR“Р u;ЗiUЭЇhнє›ЁCЊs9кы 7лљ–…ж|Цціњ№ѓлЭЉЫnЕМъЩТS–лТIЬК6mТоBЄИ…„бdC>y\Œ]-—bћѓ›—JщВУћ^ ?Ё’ъї ок”›бIА_cїчПT™xЌbЄ*  *Ѓ€кW•‰чЏ^šЬ;6з[RѓЋЩМџД8ёГK“‰чЃЦ ‰~TcЦ§јˆ“к_-&CoGi1N{K‹Q8mi1ƒЁвbЦ-иU^yJiЋ<ЅЗltŸіМЧЋХ$яёбbњюm- њ€@lk1 ЮG‹љ4рŸk№юЄтЃХ AJLў6€~€.jЈє–qа§tk1}Ф__%&iy>і*ѓ`Š#JgY<ЅNфo%e8”рМдaа`& EьœFъЃС$нъZPПц}Ќ6a#.š$ЄС$=Џ5PЧ Ј§б`О ћ З ƒ†i&Љ- Іf ІЋ &Љж`r'>ѓЃСt#ц С$еЗ5lлѕб`КБxxWнРDОšNВ4˜lа_ЮЕѓЃР Aњ zЯЏyЅ љћ4ЛTЈСX–* Цв5˜……L9Ћ44,k0 Ў4˜$њјh0hиж`p#У ітGН­Р$%`Pњ[їЃРdУщж`’КнLНєЭмэВ‡Gˆ7U˜ЄњјЈ0hИвZ’PB1чЃТdƒ42ьF›R…u?*L6ЬА j[…Ij}4а]* ˆaT|T4”чѕo2Я5П*Œљ2U˜qеxNШпЃщ‚‚ЇŠ `ЬЏшПk0Ÿ дYГт—“ж„ѕU`‚ЎƒJ$ жЄРlŽјNёo§EVч‰ЈЊи0ߘт#бžŠЫХ№_ZНГ!YЅю`+ 6;ЁŸ/ Ћ+Ni"ЛйЇћч.еЊЋ‰SmZ vД К:%ЅЯ%xзdu 2К€“ЗSЛ5AхТ {qЛBКГ!а=ю/J—жш ЈЦџm (иŸЛz8xБћiЦwuхЇ {БВс№ђЌœ ї в$˜CдЛА#?_WЄ!^Iх^ЃАƒ.иIРжїЁRЪxК ЭьжџФњо†ій%fяВ5ЕH4Г‡sTєЉи)Pє[›о%‰Їй@‡*†:™л*фFУјv+›PчФŠ5x(ННBя“jг7ЌБќaь~ч›ћ:fLђL0ЇaK Ю5@)R§>ЇУИ†)х})щ!Ÿuѓв|кИRўЄMсЦŽ.ћ#$ŒЏ+М”ž§n€хЉћ8Њ7ЗYRЧО‚ќИ Ђ+ гžPђJlP бвжŸЬŠТˆ(PrP( O^окэpЌ’Z ЈХБє@cЭ)6њЂћPzМЇ#5 <јR,KIХсѕЖ—Љ 'ЧшucXq5ЈcыKRЭŠБТ5WьY/ЂeVƒaѓФZ\мynс7{6жmŽCЌ+ѓ{ЛВ‡M‡№u9#'@иЮH!9њв'1bЛ+мeтмэЪ?2ЁЉў>Єy-СЃ›ЊguЄI„Ÿзo;!ђѕ9јЈФБЕ4$КЕВЎ(.Мhlx%zХFФќe`Zђ ]n‘Ыџ‚0ЌŸp v…Шƒ.?п„ГЏi8=Кbtщ OJLd‚xИ{Хљж(,IŽ†BЄбФИ} ^PМ…^ ~KcKЯ<кW&НVСl} „НЌК(ыKoнТНfН х šл/X(;„PtBд•ЗЅBљЛ‚%Е§ŽД•\_Г|@ЯЈрШœ™„‡(ХkѕЭ]ёПœЪ9yЉГжФŠёХ9T <.юHQK>ГЮ'шC›ЭhxT'Їš~Jl•‹@Uћ”ЄчМЂ]о,ZEбokqA? A›Љ№p(эт‹\ў’eEOŒBgLК щŸпЌc™теаiaљ 5б^б†ю`Зe +(щЎыСВ­Wc@"(N4ы6яrrцХю <ЖѕfJаТapŸes’§zз1aЬ)зEг`з_Zж,мE_QмY’Ф7оЅБыЪ‚ьž (ЮяхџWJВЭпДЎѓ>g@•џŠyjыOП”ЮО—пЪСdнЕ,n’ZФЛ™БЙдфeчЮVŒ†WАЂ2Цx8€юнq…ЃV† 3.-ЉУˆЩЩтм‚Їг2GbAџcўA/†ю‚4dNЪ —яЌ№I:Ђ—лЏ^ƒœЛк( Cнїз>z|FТ§-Єˆž:#д#ѕРyзљh}$мЪ?OWЦюЌЁІзXшЅp)œu‘Э“eЭцS@ш l pи#v=ˆЋзФгљbpМаŸGиK7ˆФ‰хђ$у]ai3Š5ŠпCйѕ4ЬGeCзД *e—Ѕ }К‚2Э1ТШйSWBђ№дSЂ zмЋ0`sЮqжA­И:ж№СДН’с-PSСZзя\Б_ИлюрЎјМЫŸкЋЛьjKёцз‹`ёЈŠњюZ‡ќаZw(‰ЃХ8=ПФ’y$9ЧОЇєbђзОыйшўвГЩA–КшŠdЯН‘дЂ(#ЧЭюh”.ё,]ё[sеВžf—pу™)м=kА§tXBђ§=Є:@!žpBќƒЂїяRФ2bАер(%a JСоЗk=MAє—ьr:ejZE-a-ыНm>ЁcuяŠ^ўЙboлнѓѕь]ж|ОјН+ѓўvчТёDьњŸ’Хця‡ѓцmAB!dhјЃTЊIА3eбMhр /”Н]з8“"‹SілЋДжМMЖvЮЅhјфh[ёФУ6ЩMk’’xdJ№(­э7Bœ&.IА7oбjШ7йЫ„пПдбCuŸчWwЪ#‚-ƒ;“эЫŒJ1žTуDГ?”.“'*39Тж §x1?ОOŸнЄ™,{Kry,5ьв&ёt0›2 bN‰шЁCgъ§K)˜HЦn•Д™Нпi•n@vмEчИЭпЄe‰‡&"Gм!Џ|Љу‹Цѓг ѓŸШоŠя.кВgV”OЧІ|дрЃ`Ѓ†юK€4ЮГЬ™š‚‹о“юR$eі‚з`Ош'TЧG пЬ >јѕЊ_сћНœXї+ўЇдјЗnbзе1ЊяФђAXM<)KћІdЁšŒєQ ЭшЗ/ЕI cс4lўјbЧщЭp#„ЌгJяџž62'5šQk]јР=ьи[Mш••{№oT$ъЁ6­т НњЭ?Йf„ЁЬ’CУ|RM†јJ7|jАќ ЉA­ыАЄ4E*0m;yC6„/ю‚_бТПn™№З‡:HЉЁ[AJ‹Wк„_ѓN9)јЗ‹—ŽўЅZ –npФУЄZSHgАfrНt•яeЉПэ—Љ—mя Lт№ЪтпCшП[э?хГю<Ђ­mЖщOу–w™v•Џй^ЙџЪlџ{Žлэя*МЈ*С/ISКПZMGХн…‚рп­м"VрˆK:АюІ;н€m4Ќ?Ъ‘TЇн>OЕЫW9сГA8ќKюbњ4Кћ.2JФ61щ Е…J™Ш"d5K§цгФБ6Ѕ`?YЎ/b^˜Ш %FУЦ2N"hсИˆА G“ˆА…c)РЌ (ЕлAЅn~™J3Ъ4yqh"3 r# –rRƒeФ82њвѕlЬTПЄZY 1˜žїйXmі8)IZYD–<Ž%:pв‡xhw™Ќ1М)е<њ\ЛLJэм‘GYmІBЬЮ’-wИ”йЃБИ‚ІVM+LNr5џ ђ&&EQbэЁљ†аZ< вG%ЬЅžzЇ„њs}”&[6^Хч5ŠJќ‘=Њ;dAГxљTzМ&i€ё%ЅВ‚Т9AТc5qк7юc‘"§<ЗBіf­ E Ј{_TMЄС*\2‡ЗœЪш5фо+ѓq‘ˆСЛPђчСuЊАљKnЃYьс*oЛнIIЅZ,0Yмm VH _K~ж*О–˜‡FEcƒти]ѓ*FQcљЕoX]ЋnXO юЅ\ІGIЪc‡t;NЅ˜ярM(bBі@х~вW–Кѓmѓ~ъѕ*OXг˜Е,oх.“:qЎѓ7Ў4:;WštЂЈ}/WЩУЭЛK[<ФTfиЅWћрОкьl ƒiYш д`%ƒм9NwУKхLлuф‡7Ќ\љЦЎ>+Ь@.eк8“Ё OŸCИ,oЃЩh€kwљжzсжМxUћh†йЅ<~Вt*\сWт5LdX| ЗЛ4*ђх$ToгIM~?+,юGŽВœЕ”ює№оpЦ0)Пjе–”Ъ…4Pil>ПоI‰›Ђlіїx–B{ч_U4іў™*І<,nЏдPi"МaD 9у†ГТё~yx&y6ъќг{?ь–[Чlw 2oкюЯ‚™+ЛJ№НпхгCя}Ÿї–esЁѕбО„а+3Ы№б* цр†Г/З›((‡Kjпw­t;f/гGЯnж8y6QИєЫ™p))Ѕ˜ћ<œ‘XFf(5lJ+—/МQ‘|,F.]ж ђ=ъJQaL—МИ|џсмCЉЯщњ8šJКДБТў(o[’WїиУ ‰рT—Фц•|%ЯЌБ”ъзЊ2Гс›OчЌКлƒ'ЗugЗ’НAАќ,bЎыё„ЦVfƒ#џЦŸЄTѓg}ƒвq‰ѕ— ЖŽoї %№їђx†й4ƒ?s„*>3ёдxІГ/Œќ7eG0яK5N'D3та@б љЃ3 œ В›ё9ићsI‡З[c7yЮйш^Є~–˜мŠNB<3™ЮdЗrcLН‚т5ЖU\|Rrћ V ;5ќ|[Wƒѓ†$:mя{К/NJ‘ћc‘šт ЋlЯЧСї8ќ[Ё‚–1(=р‡+h:ШYH3…Г_:ј˜ФЕ wі,ч1еГЛ}HЭq†зэСJЪ=a›_ƒЙяOr9 Ю5й-оЮ‰‡ЈуБџ”&mЃашЊ5 M)vЁ|ё]\оqгYEeЋ•зƒyxЁS_2н6Јaд.]їўЗф я`wк,„њY>Мщ бэТіPОг`нWQS \_Хhb}ѓ “чM^їЛœSiђ^wqАЫ:VЉ7œ Ќ3A—_R‡JО‰Ль*ьѕ:ж"’5ИPњ$Œ РїЃзqьвpзћ&Љ5Нн•чЅrŒšgtWVaЎёмrаєэ†EџЭЯЂСц5Йя8игЉЌT# Rщ(D‰ўfЌ"”шLUzПLдф€Еї–ьуi€`ЪЁ%aЈlZYзб єе{hсАѕŸ›ЊкRжѕOCВЗw№Яї.‡eЃў*ЭыУUД`јKJ5yЃAа^VБІŸя5\АШіlv7Ю%ИqrdŒВ=TQфф\*…Џ1TbЉ ьйАЗ’RFBSТіN"B /A4А•… њŽљUхГ…МћЁhaGƒЯ_н{“ЂкЗ›K]œY)*чѕ”оЪСя1Ыђ3ДА'ЕuЬŠСW+lнЖЉoPQQђь‚4 нЃlсIuЭkl€—SЩ†.Jбючx№cћ<ˆЯМлС[WR„2žZєrЉУШJxоё‹:ОZ‘ц8ЭЅў_>яѓWEТћŸ„юхФ2Сї jбоњ})/˘"„ЏтьЖБз“K „РН:?ўFіјйi)ўйз0Ц&t*HAЋb JИЮкHПчј—‘}$ЪdcќгhЧЇp^ЂLaFC(“˜ў2B™0ŸmRЙїuJAqiAЊZР~ЉёL+ХgЎСn§OчЅЪБ+•ЉѓМ їўЭ I%8 ФУRjОxpьЯFEПћp†Ж_CЭ;I5ўЅ3 +x"&ђ’ ь'@ЅюN^š Z‡нT…‡gG–ва`”*i|‘ДIFтџ0Лrѓtђбър<:zSIрфЂ"&є­Fц)гlАЫЋЃ(џЗNЪИ€яХ88ё4ttl>lа§аъў•›yrтО:)•фёk|lяˆќпG9§SpшЪЃ_BHW}у {­РФwŒлЦжОі]ф+Я*RklPJxMгM6<ьЮ}рТws–ФфпH`a…Ч‰”„ўЖЇ'Ї‚kмgƒ’eчђkЪ•ˆГ:)хйю чCј“илЖœЄ”9;ЖЧN6tvы@L^і&Yp€ІaPtiЭЊ @q<ИЫ5йM‚cл2ЅБ­}Лuѓožіё•%пЛьЮyЇ\exдфђўvv]Ѓlq]Хh~ы№П,;CРзX–WћцБ„ќЗƒ58“јѓ[ ‘љut;ЭЏЃ ЉЁŒсеBьЎeРgУ’gУ8Y“Ž ‡.&хЧћQмё‡ЄФŒ“юp3ц Ўт‚“’у`l#иœm4%Kn+Hl™БЧx œЫu0Јn%Œn€Rх6КГЁ ˜ЏN™^6eЊKІПKІbќ +Ц%Ѕšpƒ—jfm:“!ОнМ',*ьU  нэјA aX 4Iѕ`‰7A>Б-ЭwFpчЃї№–’нuцЭ7ГuxрѕkЎ8й§С>щЁдШЛДїћ2_ rqеhЛь/|ЎKк…lЯ ЅйИ9–у|0Љцp+ЃЫыЫНOЛ-ЭЩYрwЎвМhћoRЖфc)=Œ~i–ьънЩШ7ж§2ЧІ$ћ{ІЅyяЮ3†ŠјНаПцCьЕіm›Ё4K…ё›яm›un)GчЅJвъ{Щyз8—в><,|qKYVЪР-%VБ#Z fн…Jќ GhLRше”o-К_м—Eo…0М—”т=?%і!.рŸ‰ЋyђžѕлХНBЩњБѓiіbќФ[›-бSuЙЇњOJŽ*Y+ЧcŸX*ЯЃUХРuHљGHв`Њ„єн?ПхЩСфМ ь-e‰Јњ ?o'šуЙsчП5ћЄ!GЁsгВЭРBФ 0€ єЕvЋКхрп(œCкhЪ лю‘K{up žьt ЅЪ!*{Мх"%ЪЛ2"вџ%ѕ&Kc{-˜_nуЬѓHФ0—ђK8–j–у7:Ёц12ЋьЄŽiзb )#œй+е”ЁZЈЫg­SЩР4‘L ORєNы z@&ЌCљБU›БѓмPMŠU‡ŒЋJa№wСzтЎmuЮЩР3УYKЙdzpц“KS) zC˜Я^Ї‘0Ÿъoш­‚†-ЃЛцy2%Y4€ e~ŸЖгŽaфЁЌдќiъ—KHЬGЬ%*&пЗ ”pŽѕ5T"hrЌj­ЩO'tхѕ`MœrЧˆЊbЕъЋWЊ\OМнгхDЕšHƒ•,Ж1Sн$tOлcЛn+ўxэ-dџNШДЌAщ bXсТЌ-ЎўiЗhнНБƒїАф›Zђы]Х4:ЌEg-њ№щToУ NР€љRэ<Э(ЦT2ЕЃ‰хlОЄќœuЧъцT /о„р˜fЂJј?љЅЇы*LўrОxе‡MпZ4ћ]›JПэ,)yсЙh„=:\ШЊЕJ„hPCSBbmo!?kCУ6ЯэБ6œ<TkщЉНДЩђ'EF!"љТшј=  Nє1ўЊјNпњМЪ;2оLVяж™з;EY|їЏ4icž-ЪиG‚~zЈ чЋНлшёo_">” Ÿ\‡ЪЩZ•‚~†9vЏ“пYJEbѕЈАЅƒ@…*АеПМФCх ќзs„ќф д…ќфщ„ЇsЇq€HчС&n:yЬНГџKŸ'jИўУŸЯƒ‡_ЄЮ6v™k'&M)wƒfˆ1 O|[аЯЗ1љšqРR$Z­6ьђ7СФJYіэ-ЫˆfЁЫыAЃчЖjЏsUxЧJр ЂИјщ?ѕщ%r^v>QЋd{л”"ŽсМXR чХSs~Y"#нq‡"ц‡ШRЯІ*Fi:їУЦ–t/ dTSj ƒY&ЭcLщѓ.(Ц„IРiB~ry)‰ъ|Ѕ!ў-tМK­rmЎ)gѕъcфmСz@ЎvPФvŽ+ф'ЋŠ}хGЧŽ{ЉAУq0ЬkwєЎa­ыЗ тЯџЃї)ЯЧ!$y"ЈxІ3|Ѕ­aюЦOojкЪxCаГ“Уr^•эЫ5i]akЫ|xŒ!3ШPЭbŠ$CѕWXЊ›Н/0СсъŠ№sе\^УЅ2-zƒCШ:’г+1Mi№RhJCЗх$žТ~jцю“jби +Ђrt˜жf§Yj*DНрŒeц/ћџЇЁ}ЧІPЂBдэkь#6Эy…НHЈjиKI“>|U !ІБ}xЌBQЛ?:e8…ЄG Ь‰'3Иј­zБж[І“ћNЃТфiŠp ‰uЧЁ“-B ; Oз‡T™Ÿёo6И2ŒЁ0В„!фчђеCA)э|y<БИиUhh?Љš(Єѓєš~і_ЧМ(c;Ф#wЃ’!Юb§JшыёЉ)ЪOJ›ъ‚~’‹ "J!ЋъА ,*gЏH“q*j…3ЯъѓiЅЋЩзЏ™Wј_Еъ›%НПЉ>Њ`оъе@ДчЂђЉюєzEsЕ=oИцb|‡Кщі3—•“%њ?њš@‹ƒ”€Ÿ­Ж&ЇЂн1аpЛ“9ъ˜ Ї8œЋў‹0ЁЛц=Ч"IнŠ‰сдŽ~Дa”hšbTЬŠЈѕ`‰ЁтŒи§УХSЖŽсёеЦ.v+ќ&k C`gMЮN BРOўrDЖКcio‡–.Wт…ЂЃ†ХЏпШг%ѕ7žЪюЂщоК у::ъњЯJ™ŸЈ”Ѓ 1ŽJ‰‡INоЈ ŠmР№†хИNJlтзџŽJйŒ˜ЇЩѕ5аRёsќ$ЅRц?+”@9xфўГѕv”ѕ‹WnYcпСВ–Эoїљ^Љoю‰ˆД…fЁзi‡‹aЩо@žЂХ*ь6 fХ5 $Ф№Х‹Іј'fїЪ8œq пyƒVњ”ЉmгDЇj,{{;ЉЭ+…ъ`JшlxŽ– фЫ[:6јѓ5.•Ы†0ШяUoЩ2sи=!§ПDj яP)y gdёщЯŸЬјо‚”љ§и›LИІу)Л–eaЁX9*pž† ЦеBšЭз1 е›œЮЯU†ЉД(OЮ KX'Ш3^Y 5HŠƒ‰‚ЪРЪ Cе"™тsЈZп‹ЄШ ЛœЊЫŒШПс ^lœшrЈ <МaЇ“—b WD`ЏЄцЖПTЏћuЛFс-ЈžLtЋъ–1MрXQeу^Й„ГБƒсЉ=TeаKы$ЄumuP1ЇRЂŽxVЁuДыWjЛь–кќpцIU№ЉgP" ‹оЭБWЊ>Е†“Ћѕ gUMЮБІ#пЅС-姂51Љў‹жф5VЅБS„\SЪl№wї_btу—:ЃЕїpт?EkэсЊЭЉэсDžЩЖжНmцЩйœlюйяX~Оз&Мƒ8@л“RюбE~)М wиq6йm8`ќљ}Hi:NLгЉ3e]чч!'А„О?јYжЈђр;ЫкVЪgёЌ@њГXј vЇГЊаеЕi’к5V‘ѓЙDЯВВ2yip 9J‰А˜{–3› оEу`)XgЙО'ПвhpІu)…ШпИї@ё~Sw>•9GђРQE\ ъ;ёђтћЈюrЁ>6э<Л9<іtoЃhе wкЯbљP§K)fчН:-Їл№v@(oЛ2јрћ9ыJяйІе™Є ЏЯ7^ Q%JžіСт'ЕЅФ/R<>f ^T›‚н“Ў мЧЉИТC…"OoЯ)А7оJsН/эзгl,TwŸпKUя‹oŽЅ§єo5Шpќ‘=ЇU]K).џP<|2ždŸ:Џ?Йт36ѓ>uV}мЫyw—дЏqЫЁ ШrRЎ~Н@-\ВзnšŽшќлFЉЅnВ‰r" MC; I›7!$žNЉ ЪЙЦpхН\Jђл2шNœЌђЎBж[є-aѓ€вŸžзdЖЖЈGю3K “f]зЊ|…,a’(cЉBcn‚u+јќZР ZкЏћSй=ѓM=ЎЊмH]К6dXиЭpВ|7MŽž4ў*KдЊА/e”bВГЄTЩ[ƒUЩлwЅЂ2њДн~ˆц YЫvжѓИNЈ8ШcKЋE›Eјdj|№MHу†TC+фЪЩчљѓўŽё9п5ЦюХuЕ@lЮŠЌDM‚”VыцпЊЮZфDsПмBwМќ’jїхfЛ$ ЊˆВ)яkpEКI6eqщйћKЁБ] Œ48 ЁПй;Я{T,6р`IщŽЗ!ќџ›И^0:уu^PЖšвџ.rgОъŸ Љ–њї{†Љё\Šірaљ­ъ_§,ŽЄHќ,dC sCУ2Ћљt7RТs=ц?ЩWћjˆЈkЃ9џЕ[ИIQ$фг№Уp?—ўАIPŒ›сwAъ—3+{ісmNFЌю<…fчЬŠZ|@†чLmМ6аљ0*шgНдku l4nш= 7Ъ‡{”2ЃЫmŒвНК]SМ;nУl˜лƒвФ‡дŸ7~(žmY”РъxТ hСEЕЩ›&љ4-И иuє=%й"ЬеЩŸеЦx/EыrЎѕыo ”˜š С8рgЂл‘ПJ!б}zpgе`wSЮЌАSUаџЬЗгљ‰ЎЃЖЖ^}—ŒЕNъp0ЖѓбЦ…ОъЇГ[_„О˜žЎ9’‰• аpЌ‹}КwЅвЎћјj‰v‡ƒ•[шvP0t6œRЕњфђУ’kvгzy2*5›ЄЎд'ОЈ:HєАдˆі@gАѓЈЩi("f”~/_щбjшUзгУ+LІќеПНŠᕧќšј8Ю…UXr_tjеЯuУ sЊ-le)еюT4‘ЇSHтцSЈŒ;pгПЙ)Й<^СД0ў$Я_ЛЎЫX’ѕ!ЏlG<;z9№Љ“Ё!Є“XжЩОзBч^ЅNjZ'е?:Y6T†tУ:YRв[v]VЩBџЈ’%5ЮG%Ы•ь–6xЯљЈdylн+ DГђŠю/­,іЕц*Ќ•%ЕЊOƒW] ъзЬѓМjY4ИJ+KzпV$•V††АVjZ+ћєiгНWїСюfЕ,)yпuп­`пљ ›Ёкќ9>jY6<ЫjYДSŠиuюG-Ы)bk {[+KBIg•—<и­ˆНшЄ>кSвJ‡:z_Н T…\jpџіЊ†™ЎTфGдfў(e! x)eбh*Ѕ,$…ьœz:ЇIВЎVIЉ’}т;8Ws +]So9>٘“RЅЯhЄњG'Ы)!(…k—цЂkсТЅдЩВ!š•ВЄЌ‡PRТNЭьиOо†вруЃ’EТd‡UВЄTј%wЎрЖVЩ@ћк$іВFj|4ВxTќMYвбЄ’…рЦTЩ@•;§?ŸБаЩ‚€bЊdIЌёQЩ’)*нЧц’ТчŽјЁ#зH9ђnјъЛЅ’aб”šхѓЁtВPъdI9g;эz№БJ–„ы№4h,šž@Yвб?–ТњhdX зЈi дјhd^7PЩ>DˆŠN††e џлЌ”:ЏRцхКyдЯўв*_ЏR–Ц ЯЫ.‡ѕ!0гf­ д§heй`5-ЗHрСэ–SЮ>’МзGMKJї”2FљбЪB Kп˜дЪ’в-џЕВ§бЪ&љњЋ•mІY*Е,:‹'ŒGeDНO џћЮёoН,cIRЊ„bЇ‰^EHбЯS&%8ПXАЊ`й JР&^йxхЎБї$г{Љdzя•є}&жLD ясхи!@ъPv-446ќ\=h„  Н@ RнWc:Šƒ1ьEv%ЅПbњwЯЌђgјуPD(}НМ98идАШG–дфЬt‹ tђг!\*$1P|НuU И?CеKЎQPƒдЉС )†МXS—$ћLѕУsъo‚/NwсhцP GLх‹ ZЅrŒ†ЧњV,7„М„y/Њё4Љ!№ЇxЎ?МoiФ(лŠФVƒлv(ЊˆЫЩй%Ѓ^#ЪФЃЄЦфС§EP2ЈAцgы4Е0qp§№ј\язPбЭСSКi#ж[=XКЉК…Ю]/х№ФoƒК‰юi§Й)R9\Ё<”шЌ>œ3 ˆ„т‹UEяІЊSЛш(š|яKрхСЪўИаЛхтkпькzјЏ›НJ›‰NЗTјЁˆa МоeщЃЙмDcЏrЁuЊ .Ћ„Ъ‹В]R‚Ў˜Ђ1XЧИЊ“”2ВЅ8 ™Š! lб“Љіi\ ˆM‰6ИЖ‰ЉuM§‡ƒэљЂ;юw№œžHƒ SBB”Иќ$й€оГŒ€ќ} HŸŒ%hэuБlюO +ЖН ЙyЃlј2n…Э§§ WKjѓJU4ыЇЦвЗЙ9X\$wgўЌfz\йє{jFИEn\:mhoI#VC_чnлy]p1>*_— БЭЊ’т^LОУˆo) ЧіЅjЌг:$2К0ј8ЗqxтMкd‹г˜%~й„W€Œ>лђ‘=09ѓЕеёzкNа’ыTлЕЦHgю8.‡}З-ЉчТ‚‰9‹l(t&кЄ:Ѓ!вX4ˆЗ›ЛŽЭ­x‚УЉTtGьvюЉ‰]‰щЂ[вЉuŒэъJгcy2у8–zŸ•–ЅЅнЯШ—е8гЕы=™яИŽ~Тƒ>hЌ T;№aєћЈЏЁ|ˆ'мЭФ-`Лвž4koЏ ДЧŽ5ыЋWљ%4œoїПЈoФОхЖC(šЊ$_=КЉUЋMї5JTR ?Nэ|ќ 7ј7X§Lqœ”Ч_NчMLШМтзЛŠл_МєсаEcпх=,ћJЮ\ЋŒŠ.vнЎЎнšWЊЫlИJЮœъFo№&яA1ВJDs0‡ЄPоCp‡Ў6­xё^VОУ*ˆZ™ЁФэN.ВŒpfЌ6йe(еОšлKSvЏqY\Tї~окuJLK Ј?Ъї]]лІ8ХІЮMYѕPЧкџ#ЏŒџœg@*@уVхЧUїЇЂЧЊŽхgзЬщM"cТzїЮЎѓ‘.А?2iТё8кjж"ШЛ‚Wо^ бKZƒCБLZ‘| 2ЕDЇUcs їЌrќy y(}:vљpљкДїGИNзь>\6Ё8\ Щ1@рйœ*"BXьЕЭєkњ*Ÿѓи'єtэа+нmкЇж;O9ОȘ –ЮяслeC*zsx"^zыа[|sЛё6~*†рњъ{`VЦѓO“rрbїМїлr'Эsq§H.ŒшИџ-G“ЛМsьx?ЛD4NќP2Н’u$‰ŽbГ…‰Е”4ЉіD Е­8Fg8щфЬr.І]ЩЯз­DЗгoАћЪ…жоwи‚ њPy(й€у?tЋe­аT~eЯЪееIEЩ@К…ЕбНщФ W5Г2†Чb  rŸcљ5Pи”Ыт\#BK кl0З‹њ˜UћЙљ.$2Л%‰C”ќЎb­ьЅ˜ghЂџАA)VSо\OЙ$к—’<О “_Ÿ Нс…иЄь’аXE]Nь:dдЈЅЫnŸjњ~™‚јђЖœЖ0жуjiСюFj№.„ІaŽ‚`NPљ%’02їХT‰W{ ( С—АбЋ[%Ч‰”СЉjБЊЫ,ф&žѕЇЬєёсLЋqCжЄeч+uЧ|Сq9cQ)~(юДїъЮю~Ы-1—ѓ2es9mln—Й7šЬaК(Ÿ<ЙsUвеМ •P†Ы,ц4РEЪ‰jТO CbNчpXМ”WЮ;х›`ЏЪЏT ˜$%ђсљbN~ ^Њ 6mL:н>ƒяЩХ‚Cє3qpь‚+рo5ьo]ФЪ>рёсœОй_˜Ђ‚ŠESYдwT.hц ‘_т?šRAœRЙиѓT›ŠГЋ)Ю;јl.э˜ћu6cХfѓIєА[YЪ/яЂOйœv]ЯѕШIЯѕ8ќЫ_њqБъє(ЬЧpESŠјšМЏп™ї7H-™Е квЖŒXAжI(Щ‚лceЂЎСљ™!KlЭБB‚XkЃИ;ЌіС у> _m„шVЎУŽ‚A†/LўИЅ FЬЉЬЄеЁЌьхЙˆщИДQЧ} >жђ‰9ѕдџVУЕLЎЕЊАuн(C>d‘Lшс‚УЁЯF‡•Ж“wьЊ•&џФжT|xщЄЋBBБVэ†TŒиhŒФЬ№Iы\aыПYЇмиrF<Ѕ•v2ЎcыBГOЙ>ВщXžpђnЎ„Ч^e ЮУmJщћН –iмŒObЦ"x(,Qўo>‰ѓёI\†8—Ob6ћ.ŸDЎЧз!1›“рЩ!ёk‚;$T7” 'ј<–mПЩ(Г>)a4iЅиЋ 7xоЭ ё@j­P…<Ім …ŠІcƒ+GЉдR€м ФC„ъђХzg…%і%мр…+'u.ѕ шЙФv0q„ЄЭVб6c2UlU„C4ER№ќNЄ“ ] хWпЪм|cдб{БU ЎЬ­ 8%О4)$‚Ѓй‡IГ‘+˜" ЯФд&Џ >dЌJоІзЋ"‘LЊN№—ЦкЮшЉ…ЕV-M9‹іЄ04)–ЄЕHgoSˆРьvA- Юr€Ј53ЛХ=Э"ДЋ™ЫmъџAИIоFЮьјžUА(OРХєЦL>WB­м%‹YфRžрЛтqЩёд)UЏYg\юSтЛЄsёњ9;ЇŒкБЎAіiы0іeƒц@ЖD$xŠ“t ўьYCRNѕŠ=H­ЪIEмСнwˆœ'ѓаK4Ђ3=йX R˜/ MR‚N•“RБLй„KЬeLЄ ј№=Џ Хк ‰R)CJ&ŒЇиЙ2ЃДcёЂЉФмБqVБЖ‡‡ь­тп–Šл TФвФ™мЄ(l §oФ9†–Ш•щтВmЄ№у? ЋI№™ЗˆФyеоб8Ы‘!a OlЋТо-сbQ3ь5$VZПЪWXBT,ƒpЇњrXF!МFе<Тю&œФЯiщрРЕтр™wpV/чЋSЎeh@І72ђ”ЉЂY’{`)u$Йо•(КЬ„gыг€Žt^‹$Œ|ЖИIђќ„q”щћ‰Ÿ*є^ˆk‰ъЁу<ЌNgW5!v—q;аŠў ZрЩMгAЌТЪŠо 5мёл>F‚KBу@C”ŒiЊ''k№3‰DзHкзEЧ2эыЂЛ$аtCт’3бJ\12лzгTМЏ•Т:n&Юk]ЋуМ<^KXТp}РЌ!тtdЏ€Фє 4}Ј>7ŸsХ;лT’ЅчŒ“хдХЃфujѓІЯ,её8™u§Я^ggВo„аQŒRаK—HAУ\$R0KD Z4x)авБB­КnНadЯЈ&VЂ*]FудTРdѕ„ Zu^;[ѕМo #Q+ >­*hУ•]їџf!\ЉаoХ]‚7-2АVќY"–A1ѓЌ†@ lЄЧИiudOL&=БНs Ztэ=‚=КƒNЅYв]a)aYœНœ №ŽФ Zє€К*Жш1М'hщ?‚E‚аЅŒЩs'Pа+{œщС€Ў™ЎфЃ1§У3GК’Ѓы№2gлРŠhO @OКY(hС3ЬБ1CVšЈ‡Т‘'0 adAd…И#‘w)PЭŒШ7(qŸobKХвTeZФсЂ2ўe KXиЮтБРyqpmЉ1А­[<65"ЎСSмЉоСБ1ь>М’Tз иЗUПo“лR ь12{‰8CіЦДд§HЊ›rфrт;св,;э+œі‰є0+`[ƒ dwм  i+T HЅ4ЁЦ, T f<щЪ,y*Ц+†‡ILUї#єЫsœРC5р8/ЎH№pТўJСН%Ђ=•4€|'Pа7Ът€ЉИ'P тŽ  6_  ‚єО(€м'…дж–eŠX0ўъ@ оH% Д%qЬр œч%64№sн CA$ї Њš ьа ј—6]ѕ`фЇн§|ФЩўє'ПшknЛНа—{2>сŒHaŸ@ŠЖзi€­%лkBЇТЇ9 ђэг‹ЛЧяњ а;kиž:щ;EњпБeРцХЗЇDOі­гјЧћ—y|ћ№чxџс§CКїў—Ÿ{Ён?jе[{№ъ!lOo^мНzКЬбpœqДєЕ]љjџ;_>ч(#ŠLŽВТ9ZŠђ2T•ˆач 8ŠФŽЊ5иьŠ`џ” иtЕэEr‡ыф6›Њ`šn!x4Mгчєўўы<ž<›<}ЗY{Fяdy{zЃТщЃЭ›AБѓa™AYG>IЖЇdйЫџeОќяƒœvИ6=вU~u‘ ЈЙ‰[ЩтM~ЮЎз/_*ЛТ%v§№§пžžуS>у“К0ш5F'Fюч3F!5сТЈр^1ЦЈdюдвў}2F‘Є-№Єъ)Н’x—[Бўee^Ы85‰нј“ ђЧYF‡Щeщ#\уяџѓ7/Š€\А'XIX*л[D ˆя/‰Р_џm эoя;Г8в§ЏŸŽxџЯ.Г7WE|NЮ,VюЪЪаOpgЂPЬщTИ(ˆmљPQRБZEaщЪ Cќr4ъјЁ;KPzЇ5?ѓё ђЎ,оЯF…*vНЇАЧИVА–јU<єВn'ЏћюЪњџЧџІKЂЏŸЯSќ™ЛрMЂŒhŽh*Щщš$ћŠжзЛа—ЛЧќŒ0ЧѓгZЮsїЏэ‚0ЧHУqfTŒгCЕ­шж$§6Бœ‚zЎKHмзйЕŒ кБЏ&ОdЬ‹ЬМ~њk0LEnс›˜ьŠyщќїuЙy~”]6чщЅ#Fи3]И›ЈKSиœЅЙЦfю†оAЗЋ„ЙrіОој"љЏцИ-4Л#пB§Ѓ™ѕЫЭЛТr:x,ЯQ~ ‹­ОНtїЂк‰-УLцK+:QJ™ЇѕўFwЊ*уscя‰ФsШ&BrљOџuxZA endstream endobj 141 0 obj << /Author (Andrew) /CreationDate (D:20100902223214) /ModDate (D:20100902223214) /Producer /Creator >> endobj 142 0 obj << /Type /Font /Subtype /TrueType /Name /F1 /BaseFont /ABCDEE+Calibri /Encoding /WinAnsiEncoding /FontDescriptor 143 0 R /FirstChar 47 /LastChar 119 /Widths 144 0 R >> endobj 143 0 obj << /Type /FontDescriptor /FontName /ABCDEE+Calibri /Flags 32 /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 750 /AvgWidth 503 /MaxWidth 1690 /FontWeight 400 /XHeight 250 /StemV 50 /FontBBox [ -476 -250 1214 750] /FontFile2 145 0 R >> endobj 144 0 obj [ 386 507 507 507 507 507 507 507 0 0 0 0 0 0 0 0 0 0 0 0 533 0 488 0 631 0 252 0 0 420 855 646 0 0 0 0 459 487 642 0 0 0 0 0 0 0 0 0 0 0 0 0 423 525 0 0 471 0 230 0 0 230 0 525 527 0 0 349 0 335 525 0 715] endobj 145 0 obj << /Metadata 146 0 R /Filter /FlateDecode /Length 60404 /Length1 112044 >> stream xœь| \Tзйў9їЮЦ УЬР 0# ‚"р‚Kd”E7„QPQPŒkмw‰&&!š˜Цьћо„,ӘDЬjR“fпš&mв&šЄYкhі4‹Тџ9їуЕщз~эзџЏžyžѓžхОчНчœћB0Œ3Ц\јаБ‰%UхЃюKй–ФјееŒyjJG–TП4ЃЧjЦžН’1ЫЅ#ЧПћMўЦі>ƒЏŒ*)-c™КйhпЃЄŽš8ЁjФ^?њўЖcwП7Њ*8ђЫW,Œor2ціMЈЪЭŸпВЄ“1ў;ДЏo\аАјЪ‚нѓ‹›Ш˜jj\БЬwпЅЛОgЌИ•1Нyіт9 О§v\4cё5ŒE%ЭiXʘ%3?ю1˜}ЮќеГћ}­ŒБб[kШoinhz/ЫU„ёЇЃ~` ж{-z”w мЃeСВUaGЯS sФЯk^В№ЅЪW0>ї?4Qcƒ§ж^aЦюФM{4ЌZœѕ}цЦХ§| 4g6UdьAјПxбвeнЖў\)ъ/i^м§чї1ц]†лY˜ˆ-з{зЖwп9г6ь–hbтzј/ы^ќDжшвCy]KЃ4^bS]шg`]Œя5G§жЈЕ‘ŽЙtН…EзР62=[ХTєДГ\жЬ˜пћ*ЈUuFОЕ&§Uњ ™JЌОТЖ(ЬФ›^QЊшndЪgц[+ЧWхѓ1~д‘Цы•Lc7ˆ:u—>FЬЃЧАЪЅ+a ?Їњ1ЛћчŽЉfгNWЏш~ўX?ёЃюф} oВЛѕНџчуўьћпУFдў!Г[жЇГЛўЗ}љG/ѕyЖрdv]3ЛщИv­Ч—Owщ6БљЇЋчŸž~,д;NUЇь;y_ƒнЄЛффuКЛиьгняt—zр„8L`х'mW‹Sёи{nЃнњs/Уp6шяїюЛдYlъщъ œъu§Y§ПФЁёЅюeNД§­Йђ7иЙџŒ{cœЋNUN]WxњgvКKyюдуžЖпН,э'~,џЉэdmєqдЮ№ћПн^ДСмwќ=Ощ;њ џ‘KЯJ”?БбGЪWАо‚yубw$ŸAч›ђ!›”БKvў>ѓ+ŸV?c9џLџўЏ_XзŒПєяітПзЏџ^џНшRЎсцSжеГџ*?дЦ•w™ї_uПџ_.н6SyžљеOй, Rdщъ›рlУqэbиhр^` 0№ЭРМукГ9Ъ6–ЈžЭІЋKY­z7ЫT[XƒК‹-ќЇјзѓgћзяdўЉil4џ9DˆU(їАЪл,CЙ•bэœіgъДЏr+фпАЪцTЪXОRЩњ§кutWќ­{ў/]jЩє[žŒзЪ:Эа—љ˜ŽХ 'ШŠ‘СТOuуY5Б9l.2ЗEl [ЮVВlЗЏФЗиЗТЗЅЛ§вXю‘іcYkŒД_ˆіЫа>iПЬЗБЛ[эХXїЫнovяыў0тз'ьkПx0F-S‡ПџСћ[опТДп7“)цУЏ!=0‚ЃкЉѓеOеъAѕ3ѕsѕ ѕK6œ•РЏ˜A Зѓ$О‚ЏчWѓј>^gаu&]”ЮЌГр‡КOЕ1О8ёїY(+‘п~)ьєWЄЇ:ц4рDџNuХ2І§фœфjš‰МДЦЛˆ%x"PЇЉEfЏщ­Ђ€Я'ўЦœў#.œ,Че4sFнєiSkk‚еU“*'N?nl՘ђбЃЪJKŠGŽ ?cиа!ƒ  лЗONЯЬŒўtЏлщАлЌs”ЩhаыT…ГœRYН/”YвeњGю#ЪўŽ1д‡|0•п&фЋзšљŽo@Ый'Д PЫР‘–мюЦ†ѕЩё•њ}ЁKќОN>ЕВz[‰Пж: щqšжej+ iiшс+uЗ”јBМоW*[бвVZ_‚ё:,цbqГЙOы0[ -PЁžўХМчpЎ Ѕgщ…™ЌтЖ!5ЃДЁ)4БВІДФ“–VЋйXБ6VШP2jcљц Ÿй…ОŽœ=m[;эlV}vt“ПЉazMHm@Ї6ЕД­эМ#;дЫ_ъЕц7ІмЪё—”†В§Ќbв‘№>УюїЕ}УрМџРЇЧ["C†§&Є˜т‘0Ё^jпр!ц—–&|ЙА3РfЁj­ЌЁВЭђ„Y 7Л6Єд‹š=ВЦ5­ВцHїzšxTЅѕ‘я-юPы,_ŸD_ћЮР7ъ}!5Г~Vc‹р†ц6I Х­К&(4DцZкб/эъ1‰Й" •5Ё\џтг?’РрЯ`nUж%в-ф,БњЦHЏPni‰№ЫWкV_BŠБќ•5ЛYAїОŽў>ЯЮжŸе ?BёХx(™Ѕm5MГCоzOжчl_'-ЈEјj§5ЭЕт)љэЁ^ћpЛ4эŽZ/Ьэ„жВБ˜Й1УфЋQЛЏЌ­ЁГЛuV[G аЖИДОeˆУ_одцЏЊцб|TГоГFм*–U№Šъ‘}rpіŒь№ѓѓ+;ќќЊЉ5ЛэŒљЮЏЎ +\)ЎYлбu5Л}8м5Ћ"ЌТ( >Q#MBСЄЕїь0жЊеъ4ƒVnьфLГ™ЄГЦN…lviS`г‘- йФ…‡фnAˆqм–њšФуYWлвV_+6‹ЧЃФ7qџpRќУ;Иbˆ™§Э#CџHa/і"В„нˆ…Су9‚#ЮЄЖz?Ю),ЈцсДU1ЄЏГЛЛК&эEЯк4,ЕщРдšPT6Ю~}ЦД%PѓЈPkcƒ№ƒkD_cFyc-–­MЪCQ!*2Z”i}ФrDЇF<<@­+ ЁжкPmЖИiЭмZm9лClД;ЉЯ7Ъ­m‹ѕчk{[Сœqž (јЦЊjШтA7ЋЅ ЃсyЃUѕ>D[ЧЋАдщ,5{ШвŒ#Q—йЌСь‰T21-5Уb5‡Ђњb@| mщ+ЖЄ>УX[KЮkЅѓ" po{Ш2 eЄЂƒЊrс ОЯƒЋЂщb˜ЪN6ЩП '‹pZЩˆъ5ЃМ‡?ѕЗРт/”MтŒАDЦиKVЃ˜y4тЎfTwvпс_vЬе'Ч/^ba2Яn,lVлvЂ!4-ЛOŽщDЋU3ЗЕ™Ќ'я@ё2YА0њJёж`,Ѕњ:•sюrѓ1›Ѕи$ХйRДJБQŠ RЌ—bkЅX#Хj)VIБRŠR,—b™KЅ8KŠХR,’bЁ Є˜/Х<)Ю”bЎ-RЬ‘bЖЭR4Iб(Х,)ЄЈ—bІ3ЄЈ“bК㪘*E­5RL‘bВA)ЊЅЈ’b’•RL”b‚уЅ'ХX)*Є#EЙЃЅ%E™ЅR”HQ,ХH)FHЂHŠсRœ!Х0)†J1DŠСRJ1HŠR ЂПRфK‘'E?)rЅш+E)rЄШ–ЂЗНЄш)E–™RdHбC ПщRЄIс“Т+EЊ)R$Kс‘"IŠD)мR$H/…K ЇqRФJсТ.…MŠ)ЌRDKa‘Т,E”&)ŒRЄаKЁ“B•B‘‚KС"‚wKб%Хa)IёЃ?HёНпIёW)О•т)О–т+)О”т )>—т3)Jq@ŠOЅј‹–т)>–т#)>”тOR| ХћRМ'Х~)іIёЎяHёG)ў ХлRМ%ХяЅјoJё†П•тu)~#ХkRМ*Х+RМ,ХKRМ(Х R)ю•т)ю–Ђ]ŠЛЄИSŠ_Jq‡ЗKq›ЗJq‹7Kq“7JqƒзKqзJqWKq•WJq…—Kq™;ЄИTŠ_Hq‰лЅИXŠ‹Єи&ХV).”ЂMŠ Є8_ŠѓЄи"ХЙRШД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡ЫД‡/‘Bц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\ц?\І=\І=\І=\f;\f;\f;\f;\f;\f;\f;\f;\f;МxЇШšУЉУНШ™УЉ.а&*NjЅвFЂ сдhаz*­#ZKД†hu8ehU8ЅД’hбrЊ[FЅЅDKШxV8e$h1б"Ђ…дdб|ЂyсфRа™Ds‰ZˆцЭ'—€šЉдDдH4‹ЈЈžh&б ъWGЅщDгˆІееM!šL$Њ&Њ"šDTI4‘hбxЂqDc‰*ˆЦ„=х rЂбaЯа(ЂВАЇTіŒ•ЄКд/@TD§†A4ŒZ%Bн "H4€ыOT@ЃфхѕЃСr‰њRП>D9DйDН‰zѕ$ЪЂЁ3‰2hЬD~Ђt:ШG§МDЉD)DЩDЂЄpвxP"‘;œ4”@OF‘“ŒqDБDЊГйШCd%ŠІ: ‘™(ŠъLDF"C8q"HNЌщˆT2*TтDL#оMдЅ5с‡ЉtˆшGЂЈю{*}GєWЂo‰О ЛЋA_‡нU ЏЈє%бDŸSнgT:Ht€шSЊћ бŸЩј бЧD}HMўDЅЈє>•о#кOДъо%z‡Œ$њблDoQ“пSщwDo†І€о'L§–шu2ў†ш5ЂW‰^Ё&/НDЦ‰^ zžш9jђ,б3dќ5бгDOэ%њЕ|’JOэ!zœъ#z”Œ=LєбnЂNjЙ‹J=@t?бЮp|(ŽŸъ нGt/б=DwЕнŽЧyЭяЄQ~ItенNtб­DЗнLtбD7а`зг(з]Kuз]Mtб•дс *]NtбЊЛ”Fљб%TЗшbЂ‹ˆЖmЅ–RЉшЂѓ‰Ю#кv5€Ю ЛfЮ!кvЭm":;ь ‚ZУ.Ц|cи5Дh=u_G§ж­ Лš@ЋЉћ*Ђ•D+ˆ–-#ZJC/Ёюg-ЛA‹hА…дrб|ЂyDgЭЅ~-DsШГйдН™Ј‰Z6Э"j Њ'šI4ƒ&]GžM'šF“žJCзвjˆІЛ“щFAЅšЈŠhQeиM ;Х&„by;7ƒЦ…}@cЉIб˜Аy/ЇвhЂQd, ;7€JУЮѓ@%aчFPqий Ž-  Чт§ЮЯ вААЃ4”hHи!–Ц`ЂТАchPиQvL  КўDaG(ŸZц…bb§ТБ7s‰њRї>t‡ЂlЌ7Q/Ќ'QQ&QFи!ЂдƒШOcІг˜i4˜FёЅRПЂd"QQbи^r‡э3@ aћLP<‘‹ШIGKдСNFQ ‘•(šZZЈЅ™ŒQD&"#‘ZъЉЅŽŒ*‘BФ‰X л6Ы+аekєЖ5yAџќ|лwА§јјјіЏ€/QїЪŸŸА ќuFљрcр#рӘ9о?ХДx?ооіУЖќ.№№G”џ~x ј=№;ы<я›ж<ярпZч{_ЗfzМ§Њ5лћ №2№ъ_„эыяѓаЯA? §ŒѕLяЏ­sНO[[МOYчxїЂяЏ0о“Р@ {>>ЫћHєяУбKНE/ѓю:]А?<€КћQЗЖ0а„€ћ,ЋНїZжxяБЌѓоmYяmЗl№ом ќИИИЭвЧ{+јрfєЙ |ЃežїшыЁЏЎ…Оc]БЎТXWТvp9pАИјњ]‚ёЖ›Ч{/6O№^džунfОЭЛе|‡ї\5У{ŽZшнЬ Н›‚­СГл[ƒƒыƒкз-ыЙeНg}ХњЕылзПН>0Ю`^\\лО&И:И2ИЊ}epEћђ nЙsљВхъзЫyћr^Вœї[ЮЖмОмЗ\^\\кО$Ш–L\вК$ДD74Дdп…-сцЮю=;—xRЫРuKЌіВГ‚‹‚‹лЮ^<nЭ-œliŸœ]иlno 6Ю 6жgжgДзЇN NkŸЌ-Ќ NAћЩ…еС`{uАЊА28ЉН28Ёp|p<ьу +‚cл+‚c GЫлGG–K1e–lOі%ЋvсРјdxТ<|d?OРГЯѓЙGЧр]ррР€ЗЗ€пПоо~ Мќx xxxx xxxxxxј5№4№Ај№$№Аxx xxxxи tЛ€€ћ@шBР}РНР=Рн@;pp'№Kррvр6рVррfр&рFррzр:рZррjр*рJр рrр2`p)№ р`;p1pА и \Дчч[€sYгˆVŽ§ЯБџ9і?ЧўчиџћŸcџsьŽ§ЯБџ9і?ЧўчиџћŸcџsьŽ§ЯБџљgЧРqpœgЧРqpœgЧРqpœgЧРqpœgЧРqpœgЧРqpœgЧРqpœgЧРqpœћŸcџsьŽНЯБї9і>Чочић{Ÿcяsь}ŽНЯБїџнч№јUћяvр?ќrЯœСџя‡ЎKћущ‰ьLЖ”Етk лЦ.eГЗй,Жъ*v#ЛнЩBь і,{ѓє‡мЇИКVыАhu3А8ЦКш>аu;аЉ9Цr)Jq:пQKЗНћр Жƒ]—vлЛ: БЬЌѕЕ*ЏСњ?м§^А(weхIdEE<7›fŸзЏ.CŽШщст5&gZЂ;нiŠrЅ%$І9MI˜Ћ^oŒ6що’ŠEжvМJbЃw3ЙуŠИуŠИуŠИуŠИуaЪЂl“\<;Вxyю‹вcVkФZXQ‡ї&є29гнТ%ў К Ї'. kё^щж7E9’EЬ}7ŒнАз_<\Біы—›kюыv'EB—ё5)тkRФзЄˆЏIbiІіШ‹Ž6‹еkЋз,VЏYЌ^ГMЬ"КЌ{O Q„КЧРJ‹;СšыЮыk№іЌєcƒZМ‹Šb; 0бз#Яwи(Чр3r Ч= ?Q…Ът~ЧбG$оЉJ/р8њЕјВMNobBZœIщ*P-ЎЇ+еiQКFq“г—шіХs<-О~=мQ|ЅžoБ$y3иЎG~ќh[єѕˆ…шБлХКxD=)yb5юєhћЯЮФ;‰Д9јXнїažХс˜Ь XОA|PРЭЧ:Ф‘0 5Ш1Ш? /—FxєНЊт;yЏНvтнrР!о/ййuііbAу’GЉV!ЗrфPеЩЌ„в—О†SМ– jcёЪ›ъF,š24С‚УеS0ёЌ1…uХ=ђ'Э]и2Љ`шмKЊГЇŒgа)ЊСbДф–д 8БR~е™ ЯЌ*рѓІ]д˜яKwgx‘Чг{њSM,4~h^С№ъГ&TnœмЧ–шГ8мqБx['ћSRњЬ8~X~СUgсйКPпФ™‘ЮšwЙт-хQЛ_œЊ†Ш27DЮ Cфб"g†!ђШ т@ptяyuCl'яЙ3Ѕ2Zђqь~ЁчЉlћ^ЁДЃЋ5MО`Д#яMэЅЛCžХP‘—ВzŽіJо—ь0§x§‘н:ЫфHŽ‹ЃЄKЌИЛКшVуtЮfWRъћpŸиv>q†љФвё‰3Ь'Vј[џ€ƒ№‚`8ё•Цт#ŽL8>2сјШ„у#ŽHБ‹їЫNё~K( C˜3'й'yŽЎёЦ‰,ŒзГ.‘:ў“—#’ ГUW—Жv.ŸкP‚-ЩgЪЉZ^^БМ2[ MZ\gХюж‘УW?ИRѕЫpњrъ–к>95›ІЈ ЧОГtЎnжѕC 94ьfHД†Ьбё?цІЅ()щ<[bЖђ/Џ_ž’—гЩtчŠ4Гю€іDѓuJ1KN•bЊ›MI§ЫыЭo,еКs~ю”1C“Ђpа-™EuВЅ•9Й“W–Ÿ1хŒžVЯ+Sв’в’уF]№ьІГ_ИhŒ=9-ЩŸ›ф0y{ЄšsyнЌЫ› R§ЉёŽSФџ‡O=ЄѓБXцeщА8e0~\IRœHнпЧ4yОзЯбrCсєўШrѓ“ ћУcПC8Ћ*o{fлЮ=œмбіФц’PЯрyѓ/й>{KmŽтнњТ–)iъ­i)Ѕч<Оaвж9CЬkОBФSјrXžШoqsgвж8•єW‘Љ~gmЪњЮ0GцЈ№хEЪOџŽд4FgД$œSbЃecW=ŸcĘTе}П'‚ЎЁ2’ЃFЛ'66бfъzСhOŠs$"5НЭhO„ЧѓЛЊuљ,РŠvІІкмтяYO$“…ѓџ7‰z|ѕ3‹?д29dlGПЙя…пДі;N™6њnbё&2щ5.WŠzPoŒвйђЦ.;Й­Ёџ Ц *ћ6d}*gХgЦћьŽД‰е“{m|vkљ„эЯЎ-^ф4Ћ[уЇ)AњІў?кО<ŽъJЗnUWUWWwзвћОojuЗд‹Z­­[ћ.Y–dYВфEоА- Ьb 6†С! a ‰3„dfxУr€!пїLШ#8яe>Т Т‹g2ЭY& Б[яоъnЉН’їž…ЛЊZІњоsЮ§џѓŸ{oѕяЈТЕД!ю#0IоћЁJЧ0 ї ХhРп†ŸfDл5№г0Z5 Ј>*лRЪєаЇRWЩё№Зy.яаzсЈ–>Ь!TkїК Cп(}ђ…tA_Р~‘Г0юjБЮ•КHj€ЅуVХ‘ˆ;Љ@WцNmŠшYТцпdлЪo•КН’KФE˜vAЇТP„”Vn  Ј?›zщuф,­qLN‘ЦѓїЩџгр`Рф‡ЌzЃ ugŸ`бBБ^ТќC‰Vƒб&P-nЇУ…ГН_ьsїєіИ/ўcygфœ‘Я{‡žЎ^=€Ф.CьŽ№k3дˆmp$jАxгтѕ0”ь№U™wŒльYмQrл VVы0Ќ uemЭwМtы­ЇnkhЙѓЅ[o<Й/wЬеsѓјј-Нg/<окчТэџччкўцѕ{іŸН эžonќС ЙЙ‡ж>ВГОeўa [ЁЭРјJ@œh<)pн‰j>,$бЂoН€€ŽГ†…їъы ™?"ћЂKТИ lkќЭsаo•Б@ Jx. Јаб0=5шѕD‘ы|V‹KЇ F9oUsrKiXB€6ЯмНЖЪ–ъЋЖD|.~‚ўЅЎЊ7ї№g›т& Š`дьVДХЬљСe_|зeѓwliNŽЖЧyжU• ўЬlТпѕ4„MљgMБSнKПТ/@єbНЇБ\<щOњ“jZНŽЉaРЉrLІщC[+о ˜№‚SSЅС5pфЉ$'I$ ;-еcЄюЧb+Ѓ>iˆ_Јпќй‘Фt_ŠЇI‡ЯF:ж7DњвŽpЧФдDgErr_WХpkЕZњ=C3ЁЦсD WiЌьœX7бY ={+E‹•gyЏЕi›ЧІећC1_EЂ}}sn[Oˆз›8˜ ђHЏf›YчKиТMб@0оЖкТ §п§яФG1tїq='у!’ЗlRl-Іsg~ћ*ъuэ$Ў‰SчЯ1ЂЫdvРю\‰А№Ÿ"Пџъs]8ИьЁ§rr–E Фьq‰Їќ0ѓО„9q z\{RсŸхg-+#{љРј˜TŠјUуЎПн0}dЎF“б 5ЃЇ}:“Yзц’kœF›CCƒ/юyt[mbіс;№љц^<В~ЖЭэnл8ŽЯ•оƒэKC…MУі5`Ѓ9&ІPb UUЪј"јMNб 4U>Gщ^Фѕ9СЈLЯVЬVyXBДЭŠХ‘‚`8 L1#ŠS,“3FОp.ТsШELxˆ’іћkj А•аjŸЅ3Н6ц=™ЪДЛУF–ј1ёІLi :œaГR–џˆ~ЇнЅЁ‰пуП$фЂЫfu‹4ё'№я„\уЖй\jœВГjф^‰t‘Trш\­$^е[T2‚V*.„ЏKЅL­(‹ŸLy‘,E•пА‚s~yN&ŽР$F‹&&:[ЛёгcСј†ЯOо•ЃЕ˜jŠЬ“­ЗЗeЧг&]rДйе˜ы˜ d„8Ї”яээПыш†=/ъloХйRЕчbћШXУ†}ЙЖƒГbEk5zЖ^*џ q˜јж„ `гиџЪщФH'ВNЇіЛгЩk@_g"ЛИє'd‡lб.№јуаЏВє <ЭЉ8є Zd\‘ i ЈРƒdЕ žDДХB'"2-Й$Т”qєуNўoуО >ЎŠ&j{~ЈљЉN7SKќЌЁЋТйђvmЯкЗƒE)“-ФпB6†кЖЁ’wU;ЋcqŸУ›œ<аъt^ђљйЉЊЮ˜avmuWЬ02=є3gШШКЉwЖЩBьё8МcБ›G*mz1jїDqюj\Sп4ПКк—[“t5е&LІОЪЦПoЊЅџжы"Œм•џэфgmwpЭfGКытКК,.7EBA]sЋ­ЊIаГGˆзБFlжs,n_…ž&€ЉеXŠbUа† зvЧ›VйežfД ?вг '=}Ц_ƒbYH$`8ŸЩ ѕЛ"8.MŒR—ШEмКvLЇw<БЃzуHVNр2Ј#˜HїЖЖмњgЈЇГ3P ѓPg{gH.Ђ№ш+нЗѓБ™JVдЉ8^ЋдТЁ1iЬГ}ГЁŒ—ыПыЙ ЛПyWЇрЋэd Љ “џ@ §lћСM b†>Žн Ерƒг…}њTж3ш™ѓњbј’z‘F:ўјВКRЁŽє"О€Y1нЕІ –~#•Lu‹рO/(9јЂэ('L|ЗoЁЂˆWŸла GA Ѓ4ЩХB…ъ8„rMe}]§5ЩY$S`—бСBƒЊКŠPўEМіьqЙ{œ“цcцЄљ˜ЋЯП”ZŽЁGO(јЉЙХЖ^}ўхŠv-7‡Ќ]бOR+ˆЏРИŒcх8MІiаK6 *4ХŠВІheMБušbы4Хжi`Ѓr;‹АœEаЮ"ќ\14VІW‹Ыc‡CБ"–•ˆQЗ13”‚Оюёs:gЗE*BР.ž)Uz3e•^д‘Ћ‚”ЭSјзqŠ‘Ы 6ЏЮT•Њѓ\ОцКŒMхђк”2єvaЙ6к—Ојќ•pWM[€#ф Ѓ–jFЎЅ_у;eпРъАЩ!L№DŠОŽ;)Z RŒ…HбдqЅA9ящВЉЮКЊažr”.Иђ,ъjЂ˜œ=/+—'’—yт;хМ35tlЪйіs"Њёп^њяЃ,RфоOwТ,R+'RЖжцце М\]H№о*M5НUЬSХl[ZB§&~MЦp?x -эУ}8њf'ЩФ;аЭXуБX3№)lЗ‡9”›+‰TИЙ‹ŸЏOuiQZцыg iйY˜pƒXќGPЊ!"Cuаxљœ›ыЯхд%SOйѕrЉ‚І‘чceМЖ5ˆSѓ…G—=­[щЇhs з4JЁЏВяЫў›Хf`_еhwx`ѕдЁjQYс– _‡ t5wез;ЛЊК№Ўquј|ЊKDлы|§“e.‡к?~f*C0~&–(S’9Vќ™)ЈkšТЕ"кЏ ВяЫ{(Іям”Еч›Ы,…4g^нVр$ъсш‘KJDTП_гЉїYu4%G1фтеŠЂЙЪЌ(h•Ju-;PšJЩ/]h…8ЃFЄ8;Qˆ3/Хе mПл~Ьб4(…зіјvѕіЉЉэjТ2€імЗT#~<цГŒ@Cч ›њЛњšКЊЛТagmU-^;ˆYЮћКdШ К‚J.ШЦŠG)•‚ђ“†ЁЋМ §чЬ–GЊрИFЄЎXoЕрЙЩрдвљX™V|JDЫљcFwЙЎ=Ъn­џRqФK0KxjИ$`ˆчˆтrTuрШxЉ>|Ё€эŽ"&:Š˜’и Pt”шAњ—ваЏŒ&в`ISЗ*К)W(KГвˆЋJЙЫЊW5щQw„m:ƒM њ‘’Z[0А!жUеt[;s+Df9GиЛz aЫс ИЛФ?8нъ_пXzEgjщ#ђДO;іюiЌ*­FH ЕHД…jA}QрwПјРo~XAPBЈЋѕu >аг™u Ÿ/ІЗш˜S@ђNxž+ОŽ9%"Sє6зм-§;'R‚ќ ?ЧпСЫјœЈятнОюКћ+A%њ]%€МFпЕЅro%оп5єIhќƒЉЉpxъL6{6<–&YУБB6I™ФrN† Ž.-*!tYQmYmh щхКкђ)yHFц? T† нQaR/ујs„ЪВ;№*џ!ŒdˆтV7„чЗqќ5œЁ#ЂџgМ…3—йhhтqZЫ]xеиdrЕџ У\м]К"Ц8-ЭА4Ф3sбЬ0ј{ŒŠ&шЅ+\Ў@ўjУ_ХЄ ЋТ‚ЧŒ˜o|*Ч)tкм_рˆЧ*ƒGш=хыбt-FЏџЪŠ3% бBŠqэžЈПчSсо­Mкpаo`)‚ 4­f]}Н=сf?Kгu“*QЅ0КљЬрю^/Х ‚B-ЊY­ЈЙ 3ыgжк<Œ`„љglы­”€yБ?֘R/‚q‰p8Ч Ž&†>Џ_ˆIЙ‡и]ЌyFЪ›’BХеŸŸЈЮQ“Цo5Й=GХж7čݘЭгйъс Э™ЕZ3Oнь z“NiћНнQќ'JRЭБъирЖ†ŽнƒaПDIЙŒ€.!ѓ#бЈ3йъёvЄ\сЊoT€№YhїЌ[‹~mXС0ЦкСШЉъ0ќёYбƒ hЌџE0†YАыРh.ш“=”™ =”г­всКЎЯsQšЈ@Љtц>_ГрcŸЯ97хl—ѓ&,ž:П ЭІ,@X?џждљLq шЭwЮ Х%ŽќЙћ$…‰š+ъ№/}e]‚ЂŠWјЌŠщеЎІб”ЃVTЈќЮЃ}IЋЇ{ЎЗksГН2`uzЬz“Лi,aщ^`й—ыв–EU—Д†-Њh*і7co[ИЮУЩўеЄз„бЎИYЅTxбˆSИЮ_ыЖ&mzЪlЖЋbfOНAŸ ЧКŠ4>^•lmU’Зyѓлэў-НЧЩ0Ђжуп8љ_’жіМ‚щСб—@S+00C9УљЃA-:Ќ&>hŽњvvЖЮ U†zwv;SvkВГВЂ#i[Wє ј>lQѓw›1˜Щх”fХ™Р‚›гйчuЛWдйoЯˆ™K—0\i3 џeрћI9ЫщООфI“Чc0Vј=ЕKOЫ€ьŸЃš&)’5mљЇ.5ZЇ#hЫф”к[щС_Я‘OРŒЄђ8цqP+y Ч:цšиG5sсЧш‚хЮJKЮќіе”ЁИP пKT•~%g– žЃzЛ‹›Йn€eYe?UDСћр{ŸГТьЇd‰МоШЪ)йф:р7кЌЦлI˜˜ЩрЫэFЋЭ˜џUuœ“БЂdйWё§Є‹ТИd<ЗЁИ< š7Ь;Ÿ_qdbЩчW№ВќFIzƒя7yDƒŠЌšMдUы)оЂеšx*qu…J!ЛŒйq)A=h Aў;нБиQКFБP‰ПAќwитVlѕ)ЇЋZ‹iЁН7ЧКДbНVN76jГ‹`MN Е5ѓБF-a Ю[vЋvcѓ+Ы$–ЇчЄ)ЙвќšЋCЊЯŽУŒ‚И2Ѓ€ДtЭ„‚иН@ВП#ф01АИt О рГЃEWZёUЅ…ж`hќП аМIЇ3Љ)тNПШ Љ…`ФrъМ&УЈ&)ГJeўKЫWџЉцY9є-2ЬДR ž(˜ENхЇитњFт”TЕd1%ІEkcNP ЁьТВяžБ"Б,з СPЉ6˜NvЖX ЬEї‘9A/yїЪ}іJїйtћєVfj+Т™кpў$щK‡CщZxŸ3Kяы Ђ†05ќЅŸя€žјбїЪƒ№/з1/лђё2Ж\XEZrЧjёшфjЦt8B02†Ž ‰7–Њ‡Ф7•Ђ’Є”‚ђП2ЎА…e-a—+bbYSішќвy№œlZj‰ѓ%LoТœ˜ЯМРђА]л0и(ўЬeЈ ’зjлУ4gбщ-<JуЕZмšaє^›еo`ƒпjѓъBs]|С—”М‚$YNyСi YжАй‚&…Т„Q ђя ђaлфGy‹AЅg(„]~JІвкt&—(Ѓ№)™JcзAA&#Ћтф2ZЅQQЗЉ8І–ZМŸc)‰—§руюї-‚…ї3:~#c5Vxo ŸQЈфЅ”ф :#ЁEЁэІ—ЮЫRВФЪš–iMK‡ДІEŒ›є,§Qrњ/Zг’jИэХ§Oн”FЧ‹7Ѕyћnщп=єіэщп3Ф5;_ћТФ№ƒЏнИxэŽБGчs з?06іШ<>ˆСГєNЩ‚0sp5А‹Иљ8&(йEаrмК^6{ёЌДvЈ|-MQ…Д)э+˜C‡S г wъи45IP,*dJС(ЂEO&BšUkbe*ЛQ0 JъœФr.lХ8ђC 5a-Їalm{!сƒ?X=|žu:3–EЩ1Е‚ž Ђ“|fдЅІ Йт’Ю ™ДZq сђТтєlbiЪЖhO*QZbCKы1“ ŽЙ˜QщеrУЉ€Ўs"Ё1Vї&š6ѕTБTŽ)ъЧnhY}hmЬмЖ{ќxЕœS]ЂEdhСnд9Mцч 3Ћк]\дь 8)оЊWыyяu}sЩ лnъx…бH5ЧЁ|žИіv=%№юœjеърЊ–рЊUС­­йv Sk5ЦкE`Ь)zWG—мnВwвИLGЩѕ…UзБѓО0У-­Ќ):Ф юГHвBЂRD-Пs5ГшьqK§ ЯЬЕяЋUв$ј…MЯЕЗllsWŽмвwЋ’c #rь|ЫЖю€9Е*UПЁ'Ў („dr]§ъй‰{'"ЮІЕuй]#Б§Cїmmа;ЌJgзkLхђ;нMЃ‰šёЌ›цЭ: $5OvMMЈЛЦс yHоЂчє‚ZыѓЂзнибИmИV‰“ёс]Ј~я^RШт2?Vy7s,ътбУУ2YФЩSњ0яZЕРќСp’ŸRЬШІЄ%Xq))HP]ЈД nYЄ–УЅ8РQЭM<Р%‹kФ7аЪЃKC_\dEС’"ЕЎˆУSmWПСщѓ[ё|ќ гэ{ ЊS’„ЌѓŒƒжaЕђD3ƒ @Ю1>э!|ђ(–0bЛЬ уНё4–џ|2Ц•є(RLщ\иёК:В=E­rBПтєтjй•uTОЋЏЇ/КЕ|-ZTHw‰ээЗcKfѓPJЋ бšy_ЫlOіњСˆЛїцQG,реXngд,Љеф\]оЙЏnKœМўksЕœЮЈ ИxЯ­gлЖюьT“ efЮ;rUу ц–5ыя…žкПtžј!щ„9]Vw4дˆО@i6+‹xћ)L]Њ­%НАГЧ4kZЎ„€+,, .л4 Л|a5]ФуbŸщвtШSЛОО0Мo*ы4БС[žмшkŽ r@)…?3XwЯh˜0З ŒWm`mрycэD‹ЏЏ3kvхІsЭ3Mv№•е_ОЙ;иГуSЗnф™ПНoKЃ›Y4ѓr5ЏюПѓЉIЮnф2ГїЭ4NЗxT‡xчГл#еЋf‘Т‡§~­ял%Мo—№оPР{У_ˆїФkе;ОБџРг›BU;ПБџЮЇgCЯЗ ѕlmЖЄЃwё~чЗоgџјЃsйКэŽ{ž…HћИ,ЧNеi,„›sœ`Xјƒ5ЂgmHXкЖўBџ™R!ћ2\MИЎBRЁšxœRЈш‹“Д’Ѕ(њ@} 'ˆFбшЉŸУT„lгРМ­ХЭƒџB"ƒ`Xъ[%rИАЬАн7Рv6­У2ˆ!Ў!ц?X }wЋЁэ™у“|ЊŒЮrю#†ВГRp•ѓТ’МRы8šPpJ`ь™ЈцзolмиW‘,C*єй‰нй5wЏЉ4Еэ™8'!^Ю йѕЋ:М§Ю  эФ0Лє^)иЛЃ%=Л}…Ж@>xіmёA5о“S ŒјrўŽPCTиљ ^Јє5tT.9dїЄў/цƒšП’hкѓЬѕЭ уuœœ"д*&52зжВЉЭЙЅџ6иošbеЬ‚DЩЁTнњОИ-_$HZ]wнюж‰{зB2˜Јo[94~џ–ДЮnчд0ƒђZ~‡ЛiuЂfЭ ИskвЁЎ‡Rgб QЉіz-+T@'‡ЎGЋ—ФП™ ЖР†"€?@&PИж,Q8жNШ@"HќѕD@ќ›V|ъiqаХ7X˜С4Cƒѓ2­3тpU9Иx}ў+ п^НŒь­нlT}№=Tк”_8\ шћYШHLаОТ(ш: sБцEPUbu; S€Ъ‰ЫRОќ\СWRП›К&!<вqчб ;ЎKёH§ЪYZQбЙ­Ћu~(к7к8ю—ЁЅ сМœмёфТаОЩF/Fї>ЙЫз—ЋTУtа,УњkњSїЌццўбъmїЏё?kЈ”гг)'Л.›[зd_[§ј-—R'В*NЃ–HGPїнљt‘tЯдMЗxщxv[Єjhйv Дэ;хЌ“–X'-БŽКАr^§Ўœ'оЩР4pчзvЄъцŸ™GЧgƒъкf[нЮ ѕшˆ|яўОцCп§єя}Ў/wш‡і|y&XЗ§‘Ix еoEЙiщ#№Ž,АЌ24Ч]’Ъh>n-ь<ЙјmєаƒkЈŒт# tрLФ ќ'МN гR…ќCVcАˆF‡@%ЉFиЬЎВƒ ”}‰f ЂЕbrHXЧА,тѕ+*у`Ie$_HшЉшf$1RGЅ-JётЧ‘щ—zјЁr•ќтНjŠ"ЂъŸкЦZCЄ5šИ.f(ДžS&jжЇFo™›їЌ§:xG:ГШPuv“Aѕ§ЖЙ‰>—ЛОвhq›бвE•VPёv›ЎВwS&ЙiїсБЏ`зР(№I\В qIэ\’ЫщKdђ!$’GDВYџa!.>–EРџ5‹јъv|q}z]w5†’e+ZІыж4иa&йqJаѓv$ЧВnMEK,1оЁ)Ш7а:|Zg`яPШžъ‹4ЬДxAEзMУо`ц”‹жi‚рcŽЕ+кЃ&JmвŠ&5iЎj9г!Ѓйm&е& ЇуUœнЊѕДnhŠЏn(ВЂe 9ўЅ Фн2/„й*Ј(Њ\њ>Ё •џ"x:Чщ–ЊdЯ+\Гв:h&1ƒИЄœHРŸ';.1Щн"їeZыаЃ9с|%L-H”щ€У”жЖЛЃvе—aSљЧёќРvPяrŸ+еAЮ‘МЭ(Z5>ФЊ…ЩАН4oТW]ќБєL_FШ&-Xю4–O.ГI]M žфsЪЪІџ€^Џмd,ѓњDrѕ-ў+•…Д'Џјаcћю/ŽVЖFTв†\лЬЊDЫLЮёщ{ЬAƒ7hЭf№ЫТу#”L~Ae0лФЩћ7ІРшин“1Vа*XСЌс jZа ЮкСШЬAF8mЕШЅLQУф ТƒѓаwЛ–~El…c:ŽЕaGCѕш{ЌŠC›г`ЪšїЂQ щpфМh6чўX„?иWсЏ’ўK@k|уч&ЛFъ<МюиіЙi{s]˜—у”BЎpUЗT Ьuzp]КЕ'0~Чpр™ѕ[lѕI==”LФрКОCгiWvbўžžЮЯœЉЂYŽ7Q‰WЁTд­ппІд Šи№žU“[AЏоxїл]?PЊ(‘.L‹БаK˜G_ эРcЧ0…=$šКJQмh‹–]‹]эuW•Вћ_О}пЩ›jїПtЧэ№xЌbpOЯјЭ=ЎаЊнНc7їК№џўІGŸўр‰/|№мєш3|EyџыъћПМP<.W•HФ{ыiЬ…\bX%k-ўІqщdŠ!›bј=Х§‚@щ˜Eый\FmœIа‹}„„Ч_p$8I9юMaŒзЬNŸГ]N: &>цЭJ›x7xF5ђїьDё—э`ЯdЖgВцВ8н>GŒэIOv|л5зДkоng чD3и+й“+•l рЬтJЪ]WsaЏ™%~‡“vŸдWЌОSE{?‡АGИЎp„Ÿ0)ј??™џƒC‚‚ошЌ˜люЄ юn—šnчc‚)r6NцsKЦ^ч8™/ыfџrѓ1С(\9бЮEзvk'sӘZ6&шQЮˆПбЮхgНlšf!ЭIГriVЭNЁ9Щ4“wPй.š@sтiNЭ‰Ѕ9Š&Ювб,‰$Sо[ХЈНUaМ ‘xйЁ=ЉЄ>Ёtј_йL)EEŽ}Ъ9o*4ь№s0pАщДvqА9ДŽŸ б$—Hj_%сР?‰OХfIђ_њ"ƒXjЯАз]НЅНЫ/|žЗ\юЅˆј6ЌЉНьяЧ­ЎKq3њЎЮ™62mФЈ4ЧЦшИэъЅHЧˆœсЉДдЁwЄЙœllBŒaѓtь!шW2…Oў^ЁŽl~&оk‘ёdПз–;–ц–ё‡kDоc=ЏvXcЕ^i,›8lЋeЏJrУєnЄКйqсЖ_Uв^ВКD,IeцMeцMх\*;рR_FТ^3ІžKŸ‹тo,кЧЕqа™l•]ѓXGVœ”3(B=яВgЁzнS@hGЬ…яЉj\fнoОњіQеВЈя2ЊJЗ5яhЏˆNtй­бI1бlX55Ižм48Ќ:t ЄЋтњGUХѕЯы„]е„CКЃ‚AвсЌБ)™ТД[їRєZЪ сЁ‰ыД”jьЕ€ЇЕ”lс с9нŸbвRІ@чZн!Є˜Е”В™яea)ќъ+O8$Ьфу|м3|мOй И—Ѓ–gОЌ[9™§-CТЁм9НѓцоZ›уОš§^•ћЃЄтЩ#KІф;“=“ J&ФМtуІХWŒiКяцыя[\QжtŸџšіIЉЙ5ЭејMЩЉiVяH=Д[˜ЦF qGJŸz–пюЃЮgRztЗjѓјMЉюR#ньѕ–lЖв}іГNа™ /Šœtbmв>ƒI‡юЭd‚ЕСЬўm3ыкЉ$PQ2ш‹J™ал”‘‘/Р2'Ÿ+Q8‚Œо'LєšM нЫ­Ѕ/‹+д^…я=9%§yЃпјЋxЁЩjШЗD[tЂбf~Аd\†й[™]Y(у.T/ъcђ+kмnŸn+š?m1mК;5MВЦG;тб–ћ=ГНeЎтЊијX}T‚#>9&1Ю.—Я.Ьœ2ЗyВŸЯђЌFћ.@fГЦBњЎз6uZждђЌЉSГЪE{т>њŸо$bŸžяOЊЩњэДУiBZšЮГПzyќ/ДІч‡]СпўЊВѓЯIeCPƒ'$=; ЎъšZЮœKHJy0< №A ЬЃуbЭє_ѕЄLњЗLЗ Аkњ)hлk… шГЧАџF­ вwМQФžёs6+сЗ…Ы\ћ‡ђbѓ.ЋŸдfп з^г55ГzLŽU’и‹ t†ФМ ХЙеEЎи‚+Gч”&ХD9уiNJ’н6№{g‘kjѓ”ŒQоE“2іhГз6ЇЭcЪ(sЫžtЛ1&žЮJˆ5кьЉђГMЏœ‹жЙuл П-boљњIюXіЕmГЫe.оGŸі&ріЋдQ*œ(ЅЅOхчы2њЂ—W§{D-о9Vбi]8VЈжЫ =рюЦ6gMoЉЙЖЭ›lM+НЊcFBqОl5ВоҘ˜хI-ПjД‹ЪзWNНЙ*щnЛ\šS8+Э™56;wLFTби›Џt­__ыёћцVgыŒVk|\tœMg4ВЋчŠMЭђ.—1&гщŠr}YB<.їQпrхKС/мЏіУо˜X’fv$вФЇЃVЇgвЬЇukQЗ[№G‹їПЗџлџ$ј3І.Љ™ж<1}Фф%гЎZтMкрQ–Y:ТсЬ“сnЃWЮZЕ Єh~oэД•з—–нАbZљќŠд”ђkЪ'п0&.­ђxи(х НMиˆ~8•ѕУO{ЭМ#>—ВZЗ&ВОфџn3F'Ч9“Ѓy/,QИѕЯ$“-Ю—Ѕ‹fѓ‹6SЛЖA4ХF#н,ЕQRAвё^И цI‚eЪHы…п{žѕТ…Ќ–М“#&<э^mK‡+<-†˜•JИ™"‡ПCœd3д[q–єЫэй%iЖВЂŒ1ЙI8ЯъD=wLu&,”7mьЭ4еn“’ˆўиeZ‘YZ421ЗФсdНPtlЌ#6Цš\29oФ„IГ ky\ˆvv 6W“›XќŒзV3+ЋІ"ЋІ&ЋBДЂ?~п+ы˜1yѕ<1)=ц=–›žЎ›Д:=–ЦўXsо;>Лс‘ ‹єЮв%nЪ†[bш†§ГУ]г8>cBiv”оd2ІфWхgŽJŠЩ?r"{Щ,ŸУ|хєв+RKѓRѕ:q*ъЬYe“rЪчŒMvfŽNsЫ‹ЁpziЊЩэHLJŽ‰ŠЖ;GD'd%йtжX{”г".Ь,v8Ѓ$Ћгn‰ВЭЮh[bСИьд’МTЃ”фƒу"V9#Œ~Р{щqj/}GИ—^э‰ЯMN/ЂEOhѕ*ѓšЁŽњ–ЫыЉ=ЕШzъqVЫ zjvП?p„хсц^џЉhOШtЅф&šg˜mŸ Џўj_RЪ-lМ“MKОEВКœŽј‡™.– Мяж ш”wбц%hsЇp')'е/QtѕsY#ГFZqџўŒзEЌЬsїрœы@>•з›OуŸ<мYgvЫЗЯ!ЫжeЧыБy3оќъЂd:Но”SQ˜^š_3­шŠ„ш(g,НжbГZN;‹U Ћ3о)НІ"нdГ™\lЊ­5ЪjKЮO-)5FХв$gД+55љћ”&zjј§л—B!Мy$ŽвъŸdfЇPs|МѓcдЭЬœxЗл­sШTоƒЎЌœ–?~БК]аO_№NЮС~:'В›.ܘxsефКqЉiгVм[“jeУЯь #/iдЄ|'MŸ]8nЮш„яWЅWЇDЅІЄ$лп/МfBvAmpкЌл]Ё3X,бGЌU2єiЅSrbbгЧL5ц gTЩєт„ЙзЭхBрзЅтК9НбH%ЌЁЗщ‘ЇЅT w I\'^K)Ф^ž’ ЅФ k„qКXЄИД”ш8uЈŸ”ЈЅxRШїJb)„*3”?ˆmК1l6ї ФЉєё‡6йM{'•“}[№9мkљфgZЬžхс/­ЬЩ)S/DиЛЕ2tіи”ијd‹hзщьqЩqqЩVбh4™ ИіtZu&Ѓ…Нр(жЂ~)eћЗ MЛˆlΘечЩ†KЪЁ!я”2ОГœн š|ќЯ§ЬљЁ&G/&†›Ю“ЛЮ“ћ†ЩыCbєŸŒ3—SP“3CbЎдфћKє?, ыJыJєџmb'ƒrЯp‰2]†Ь&ŒЧ’KЪGп,бuƒвr‰ййvО8ov~qq‰}ѕђ$.5ю6&ёS!wqy>ўљkТ\.%<ц\7@ўуџ$F%Žўљљ'HЯ0yх’Я“тџП•†Є=ЩiЩџ–’žВ1еЎЩЉћвrв~‘ž•ОEžІЩџ’˜9туŒ2'\BюЮ|'kZжЧй3В_ЩўЕ*9krЫsКпЬЛ7jўlMцчзхђ;ѓoЭ_—џƒ ф`ArAяHѓШ%#WxѕВЕ№УЂ)E,žPќЄGж$ЯSтЉєLіЬђЬѓмЌЩƒџнТп\BФ~„{DB ф8‰!ЙЪчˆ™ЄхТ\оЄ|JRЈCљa’raЏђ{„›йVК_љїх Ъ)’‹јq2ћВ0WyaƒВaГђ§Cї+ћШMHџŠм„ј(/FљaЎђK„7!ŸH i@‰ьу’I ћЌe­Т>fЙTaŸЬьUиG&7№јs<мЏъРж/h-і=‰0Iљ a-q"ьUОBИYљ3­[Ш4КёЯюGz/Т~К{A˜Є|„А–‡НЪŸю'\Љ9”Ѓ“”Oі*ŸВk7х/t?в?E˜Є|ŽА–‡НШy?нL$„ћ‰QlЮяж*DиЫBёдР1„_+і+„ЇОFxfšтYE№мРQБEв1MIЯ4%г”ŒLS21MЩЬ4% 4O‰-/#ьW>OA“…юПŠај\ќZr+уХ~Ф?DxJљсYЅс9хЄи/щX rCŠdс)neЊxњћХгˆ›Х3<Ÿ3тЂGxVЯH&Ч^,юV&ˆgЁѓ1ТSH9‹кDиЏ|Š№4ŸE)gQт9ё,J„ъ…tА…Ždфq3гІуј›x-ЋGј5Ёћ•/žЦОиЎ(т9IЯв‘в‘в‘Kw+y’ŽYCв1kHVk„Ј5BдZ2АZ#4ГVkЩФj‡Е“LЌvQ;ЩЬj„5Bˆ!<ЭуЈBдH2Г!дГtV#„F73V#ЩТjЕ@ˆZ D-$ ЋBKgЕ@ˆZHnјЩ'ПVъі+)O+ГžјсYe ТsЧ%7ќš(šШšШš№h"7hТOŽГWt„Нѕ‚- <y`чk"Ÿ{b%-.ЃХЅq‰ЕИ>"н@Юˆзkq#Щпжт&"KзjqГАmPпBцIA-n%љвыZм&< дтvвbиРњ,О”њЕ8%cОˆСДB‹‹ФeZЃХЅБšдтњˆtщ5=ЊХ$ЮtX‹›ˆУœЁХЭДvPпB Ь%ZмJтЬ ЕИЮ4wjq;)ГќL(ћЏ“V[WэЌЦU;ЋqеЮj\ŠаQэЌЦѕщЊеИjg5ЎкYЋvVуЊеИjg5ЎкYЋv~œАgн<2Фfё/Uv’vв4’ в&ё/|Њпљє!%€X)Т–jв‘ЩЄ5‘flытk~ќњЁНa4'aПш,BZЎчZ‘WзmУZвкј6uџШ€zфАkЫ Ђ,™Wtт-а•9чnьнРП[кФsiзr BЃU+“iШЈc;/гЯПOЪъ2зЕ)>ўнЬN^ ™џњx-YЙj=ъБe$ЯЙ•ЇД№}А‘š.ЅљДp‹uh,лвЪKUѓdѕ F0`%v№К„ПЋЊZ[хЮJj‡dўEб&n…џ†(ћ6kЏБлCЕ™ZŠЬЙЗiѕjчЖ]Ф5‡GжˆY­‡яЇжz ж‹И?DЖf.Я­•чАœлЁ[kљH{ГSыячќY§еvщфоР~еY[ЫШЃcА6*Ч&MЇ k+ДмƒЈ…кBK[ЩЧ}Ф‡джaѕ {s=˜јxљѕZљEмc›x[Б-дКb№ЈCцi^аќm{N[/юѕ~Эекј4ўM|ЋЪЧЏYŒqlрžЫX-сmочт[Пг<ф-jлЬХZ€s`х_УН=8Ќ‹5э5ЈзŽЛ ЏЅŸћђLЄд7oу<ш4№ќЏфЌд}ƒXБВŒK?Ц‡3/тЙЗB'пbќ›x :УrЄВlфuaGЮ№\УщќыЦмУљ-рœUЏ]ЮН­‹3 ђуЊ‹їъо2Џ;&§мЃМ еB‹јОaыM§fЂGTїэŒиЂЯ м&CЧш2эЋРЭпPЎКЮtысEнм† ƒ>пРЗwp]счМІmšЇЋyљyШŽмѓыЭЖЋ=„{хqяlEНќƒЧь…Ќк.Шљђm4”{И—–Е~Vѕžњa§н…uђзсМ*#,РjЂжEэѕУ^п9xiр}hяK}пXSеЮОa6ѕkоў1РЌЪ<Џ›яйРћ#Vџ`>LГ…їi—jЁжq1tLs6ьPЯDEМ­:HЯуr‰ЧS&Я дwЖwЕ7хIээО` Н­HЎni‘чššƒ]ђ—ПsЉПЁh’Џ%АЈ3 КdŸмкоряl“Л|m]2ЖхF_k eЙМ,l–ЛК[ќrg{w[C ­ЉKn‡jапŠ=лфњіЮ6gW‘<-(7њ}СюN—мщїЕШ ЪЈя)wЕњР оз8лЅЕЛ%ш@–mн­ўNhvљƒ<ƒ.ЙЃГМmфоввОLnq9аксЋЪ69ШъfиEn ДЁЌіFyQ ‰gЌєїБs`‰ПHжЊ™л%Зњк–ЫѕнЈМЪ;иŒђ§ЫфNъв@ЕБЃЏUюю`Х Ч&ЄtV@=иŽ -eUђЩЫ|­jYЬЬѕЭОNѓwЭё7uЗј:[ "\tkš1ѓ`"TJUф)‰0НіE1>фп`<ќ жщk№Зњ:—ШэlKФjуХ˜›Е™лbџk‚О ZЧbdаЮ ЈGл;ўЎЂ™нѕn_Wžмр—ЏьlЧж`АЃЂИxйВeE­сЬ‹ъл[‹ƒЫ;к›:}ЭЫ‹ыƒэmС.M•Х}ЈРІЗ НІ].wwљAUb›eZвпй2B‹–szSцЮЌЦжNО‚vnшV[tYs О9b_ќкъ[К˜-кх†@WG `6яш @ЁZўЖ`‘.ЛН сфЩўжElЇЁЌкТЪeФе™KУќ]0OНъwƒЅsЛjyUrюJы3гwВЄЁ}Y[KЛ/ВPpіЉLaјСhяvtaіЅz?гiіЗtœWЁЫi оХ ўFЂ"_WGЯр§ Q\фrБ…BwФI ŠBЂилЁј]ЁnќnUЧ”.БФHnЋ•B‡И\}›щ u—ЋХѕЯ]ЎОУСєХ.W?:šщKЅ—ЋяtB?Fdп1тžŽщГЛъ„нOЇЎ”“ач’ёЄ”LЦ•Т2›мDn@н щІВ–&‘аZВ™.${h;y–.%ћi/y“n ПЅ›Щњљœю'ЇХщд,ЖаёSš+~FKХЯiЕј-ž 7ˆ_вfё+к-~MзŠ§єћтiК єЮnџnѓР­ми9ЅмюЗћРm'ИэЗЗ7Рэpћ3И} nЇщ~*[Иe‚лhpѓ‚л,pЛмšР-nkРэ‡ріИэ—'‡sgEpГƒU Ихƒ[9ИMЗ…рЖм–ƒлрvИmЗНріяріИ§мŽлIК™њЕГq;p+З*p› n7‚лbpыЗ;РmИэЗНрі"ИСwщЏ‡sг%Gp‹З4p+З*p›n рж…p-Ин nлРэIp{ моЗпл'рі7КRpГ[2Их‚[ИMЗСm И­ЗялрЖмžЗ_‚л;ріGpћd87CЄП9РMЗJp›n7€лRpЛмЖƒлOРэMpћИЗ3ДšшRšD{i.И•‚[5Ие‚лBpыЗлРэ~pл nЯƒл+ріИ} nЇФЏНи/€‘†у287SQЗTp+Зрv#ИЕ‚л]рЖмілЏРэcpcуКzК&€[ИU‚л4p›n~pыЗлРm3И= nПЗп€лGрі7ёј|)dŠ_ Ѕр6мЎЗ…р`§™QGњŽѕ!,ы;ŒVN„Bј 0ъЉбX>9кКnrЙ‘RЃвІІгт'ŒFj4ПќђЃX|яsрРЎ]›6mиРsЋЛ'ф•їдuФЈя—е…Ћ­S—НDѕК–W#c0{жcщСŠ^пsЯ=uЁŽѕ'дђ‰V~$=д {_cЛ№h‹uшEЊ—sјƒAђž№bёp І№@ГоDєІѕЁѕЁЙИeЩ€DфJB1щŒF‡lН^ЩшѓЌ‘9_ЉлЦЋвЏmЎь\щ055ЇЖіž~‡C­?З—ЖЅм:Сr“bН}^Џ$ЃtXіV#^ЙйЩРš Bќ#cЂFЫўаўаШ&Ћ№?кHzЕ‘L:jB#}k+™(5 ВњІfbmПЗOхJ{/Ѓ"ѓНXCСdC …•Ё†т[Т ЅЎh …•Ё†ТЪPCБаJ'3o(ЏN$fЉжb“šŒU9­‰UмH§!ЕЕњй6ліУЕkБm˜a˜І>Мвo2S“ЕЫvяvяF. ™їoп~яїОwћэЗёЬй1Ый› Фdph /j­КL.7шЈA=Кзw˜ѕдl”$)И К!ˆUƒa%ЋWЈ Ќ’вš.dІд/ЇыѕЅqcž 6ЕХD-–tRђд†м­ъ…ъBщф|SВ]‡кЛкЈ%ЊЯечкцоцОЇцžцЫЗo7Ў5ђ\ћBл ї@ж‡жAжBж№\Paт1В:Y ФсОkш‚ЅУNVЕš,SY_0ЕТb@>шkWЊ^і‹юSЌ‘Е Ёoкw@эJјJљdЕWсч Э7BЬmѕ^o?wo9WTї™ZaДЃ•ЙњtяtoиAЌTАvxЌ|ЛX ‚іц"рjбŠу%ђuOэ=š јzЯ:дŽ}]Ц;Д7ЕЊ566kђфu \ƒoW§DрлйКъ(j?)лЇP›~аSд8ѓЋ‰ZЭщЄ#TGњ"Є)щ„[{€uмчXа7`5SЋ5=дсUЕ_эS—КОŽОєU€ њ"ЖЛ1b}РjЇVЧс”У)'ЊоyАх`Ыk3п|ѓР†W7Мl}йЪѓ>мwЂяэОƒ7!Џ@~бїrп~ž•ЉЊБЏяpOŠ]ЏГЧj$V“тZјю}Y|Ё D=5ђѕЦ*›‘кЬ"–ЪІ—йвTiХ™ШДњ,+ћV!e•M 6ЉЏСlД”ˆ…ŸОў№ёЫъТзЊyМQ=S<ЌiZtдЂЏЋыЏS—rЎЋэзTiВ“Y оеє@УЅ{ЋNИъ\u6AАE˜LЂ Фnаы­V+ъыС‚М`e#ZP+˜—ЭЪ{†-Ѓ№„•Џ ТийхЉJаWщ‘њЪJюvмяФ“2’Cq'і QBzТ„kЏbФWjк,! Ѕї{…—ˆЎЧЎыиЫ(yр\v§aFЎяD8^чёVяВЭЄ b§ђЮлдщ_B<-О`юАЬ„^3gЂLbљƒъ7yXŒ"Юю}дИˆ{aЮUГdтКvЮ іхc5]в~uкЏžъ;К:ШШ%ўЮ6RТУrŽчсdNчaэрхП— ўŸ[u LpDqЗCС^GмШ‰q•pHPKV Л„п’mтCтCф=BпЫx =в™‹‰Сc№˜7ZЗ ‰mЗ*lЫљb_S6(€œŠ9хМбycТF&I//OђOг^KпЈЪˆuC’ё0“\зEх‡ЛТRќzЩa{J•Š JхюЪнU›Ц-’ёYЊА-чЫјW&|яьoыМЏ{_Џ>Щdј–I9“Ън“ŽM‰™ђЌ*SŸ’+ŸdRѓФEхФДуa™~pЦУa™љ˜*Г–^Lfя›НЏж|ѕЪ9ФвЮ—9R­Йжл[ iы}ЌїЉоїVХ@jWm†^еЊОU}НЅПbБU}ЋЅеiЋgЎ^ЪхDh*—žаŽ^ТžаkЁуЁз ‘ЖЦИІhMщšЕзжœY}КЏЉ[жІ„^[;qэЬлoы_ЗёŽк;ЎПЃсЎŠLОї‰С№яІй›f?рx№Шƒ'ЗФo‘ЗмД%ДхЎ-›Жьиђв–_o9БхЬVikЬVykйVяжй[oмК{ыk[?|Ш§PйC5­zш‡о}шг‡ѓОюсXџH№‘'yщ‘#œл6~[ЯЖЗ—nŸЗ=Д}ѓі'ЗА§иŽ˜7юИЧ‰1;KwNнYЛГsчЪя<М+fWУЎUЛиѕюЎдѓшŠGŸ}єдnяюЛŸм}|йSЖчк=;і~,чБрc?}ьиуw‘хKтb8 Hr7ф@I •Р х2˜ЬЎjЋ9Р5Р<`а д?а4+‡IX ,Z€V  h:€[€N KйC‚Ъ^в ,–=Р e1ЙX єЋ€{•wШFрGР&р>р~`7Аx xxxgƒзxx ј5№ПЗw€wпяяП(ЫШGР_ЃАЧ1рр8№РЇРgРчРР рKр+хaђŸЪ/ЩIрoР)рkрДВ•œЮч€П+[щfхMКи < <lЖ;€Р.рQ`7Аx xxј1№$№/РSРгР^р'РOg€g>х}Uљ-} ј№:№†ђ[q–ђ’8—D‰зЋxН2CМAљЉx~oЦoЇђЅјs2–$’rœш=`Œ€ 0Р и;РfК:X ˆ6їе фљ@0-?˜ЬЎjЋ9Р5Р<`РfЭо д>`PЌVN‘АX м /мќиммьіOЏ+GсGсGсGсGсGсGсGсGсGсGсGсGЩ•~ђ!№'р0№gр№lћј+№•rppppp„єcлiх}xСћ№‚їсяУ оЇ‚ђ! аzР`,€ p(бh pБ@$. HRŽа4хї4@ dй@ И•>šфРH (Š0 (FЅР   ”W@%PŒЦ/P L&“)РTрJ ˜Lf3YРlр*`.ъ2˜\,zС{Аk€ЕРmР:рvррN`=№}ьГY9†ЃэŽЖc8кŽсh;†ЃэŽЖcџХлн‡з]iџeЮz .Ш::8ЬЮЈнq # ‚VPQft$ъдQyU Хв;ЫVДЕ:БМ”bВд@•RњžBSLKвЖиœЂICšЖ$Mв“ІiЮi8/љѕœЋ!Ї)ДфьчФЮЎ;лz юuэїе"Cržћyюяѓќ’“ŒДЅЄ-%m)iKI[JкRв–’Ж”ДЅЄ-%m)iKI[JкRв–’Ж”ДЅЄ-%m)iлS|wЩЏшздL-дъ‰кЈ: {Єl8X aЁ„…JX(aЁ„…JX(aЁ„…bьŒнƒБ{p3‰›)мLсf 7SИ™ ~PшЦЮVьlХЮVьlХЮVi Ѕ%”–PZТ`A!мOаƒє-Є‡i=B?ЁDaЬt™ю1г7нYг5нYг5нYг7нНІЛзtїšю^гнkКBгšЎаt…І+4]Ёщ MWhКBгšЎаt…І+4]Ёщ MWhКBгšЎаt…І+4]Ёщ MWhКBгšЎаt…І+4]Ёщ MWhКBгšЎаt…І+4]Ёщ MWh*BSšŠаT„І"4ЁЉMEh*BSšŠаT„І"4ЁЉMEh*BSšŠаT„І"4ЁЉMEh*BSšŠАdgсЈ)MAh BSš‚0r]с0ўЦоУСч‚ѓ<}zрBšJбХtepŽ|nfq3‹›YмЬтf7ГИ™ХЭ,nfq3‹›йЩŸ?ИƒюЄХИєSЊЂЧшqZBы }ии‡}ии‡}6ч{mЮїbd #cУШFЦ02†‘1ŒŒad #cУШFЦlЫœm™Г-sЖeЮЖЬй–9л2g[цlЫœm™Г-sAё§чзЦ#7л@п nŠмъЯл‚›‚i2—‰ИLФe".q™ˆЫD\&т2—‰ИLФƒѓЄшJлч*њdПƒюЄяЪТ=…Qљ•Qљ•Qљ’§ђБ_>іЫЧ~љи/љШШGF>2ђ1"#ђ1"#ђ1"#ђ1"#ђ1"#СVNo›ЬРX0a  ЧJ*)S][фFIПYЅп "zœSa$Qa… +TXЁТ VЈАB…*ЌPa… +TXЁТUvkжnЭк­YЛ5kЗfэжьщgЅPХЊЗ4+ЗvlТŽMиБ ;6aЧ&И•сLž3yЮф9“чЬZЮЌхЬZЮЌхЬZЮЌхЬZЮЌхЬZЮЌ -œ4w/™Л—ЬнKцю%sї’Й{)ј™їsz’–бSДœVаJZEЋi ­ЅjZчП{šžЁѕTCќяЯR-mЄMєеQ=mІzži m-ЌзБѕС ўўKкNMЅє+њ55S эЄVz‰кЈНа&mrб&mrб&mrб&mrб&mrб&mAџІ—њќ}П?cдOh€їiбХ)QDнAд”ЉPІB™ e*”ЉPІB™ e*”ЉPІB™ :а‡њ0BFшУ}иtО„аI„N"tЁ“4БЛMьnЛлФюvДЙGкм#mю‘6їH›{ЄЭ=вцisДЙGкм#moс н#qїHм=wФн#qїHм=wФн#qїHмОэћаОэћаОKЪ‚w—ЬОVr{pAЩЗƒ)%џМЋфщ>ћ‡є#њ*ЇгКŸ щ!ZHјXJгOЉŠЃЧi §Ќ0 Б—Kье“i•дШw б`Њ›ќЙЌ;шNњ.нSЧ–qlЧ–qlЧ•8ЎФq%Ž+q\‰ыфI<Љ“'uч н9Ё;'tч„юœа:ѓІЮМЉ3oъЬ›:ѓІ‘(ў˜K"у’ШИ$2.‰Œ=2jФэ‘И=ЗGтіVђщ>Н‹Oч№щ“дAœрД@›Д@›Д@›Д@›Д@›ДPkRъ‹їA(хЁ”‡RJy(хЁ”‡RJy(хХ§5ЬБlЩЙU‡QuU‡QuU‡QuЕ Ѓ6aд&Œк„Q›Аi6­РІиД›V`г lZM+Аi6­РІи”ХІ,6eБ)‹MYlЪzЪLxЪLxЪLxЪLxЪLxЪLxЪLxЪLxЪLxЪLxЪLшжAн:Ј[uы nФІ&ljТІ&ljТІ&ljТ™э8ГgЖуЬvœйn'ОЧN|ь7Щ~“ь7Щ~“ь7Щ~“ь7Щ~“ь7Щ~“ь7Щ~“Ь7ЩјˆŒШјˆŒШјˆŒ˜Œv“бn2кe|Œя‘ё=2ОGЦїШјп#у{d|Œя‘ё=ІЈхДO™ПyЦh1I-&ЉХ$ŘЄ–ЗјŒб'г}2н'г}2н'г}2н'г}2н'г}2=јž1’ЎРЄ+0щ LК“ЎРЄ+0щ LК“ЎРЄ+0щ LК“ЎРЄ+0щ LК“ЎРЄ+0щ LК“ЎРЄ+0щ LК“ЎРЄ+0щ LК“ЎРЄ+0щ LК“ЎРЄ+0щ LК“ЎРЄ+0щ LbЮ ц bЮ ц bЮ`Щ­СŸЪгŸЫгuђєgђєчИѓ%waЯ”’яљѓћ4—цбh>нKoѕљфaџЭ#ХŸŽєgUвџ GЅj1§”Њш1zœ–аЯhЉ'ћ'i-ЇД’VбjZCkЉšжбгє ­Їк@Яв/Ј–6в&zŽъЈž6Sƒзђ<5вкJлшњ%mЇ&ŠвŽТ“ЈЕ ЕVЁж*дZ…ZЋkbm@Ќ ˆЕБ6xў9ДЛxЏžќ9зwг{шш|z/ђѕBšJбХt%ž]E_*t!H‚t!H‚t!H‚t!H‚t!H‚tMўььt'‚v§WњGњЭІЂџFwгЇ9єнТlфX„‹cr,BŽE8Юп„ѓ7сќM8“'Й ‚ћщzЂ…є0-ЂGш'Ди№SЊЂЧшqZBышiz†жS m JQЇu:PЇu:PЇu:PЇu:PЇu:PЇu:PЇu:аe КЌA—5ш’@—К$а%. tI K]ш’@—К$ахatй.Лбe7КьF—нШ2Yц Ыd™ƒ,s$;-йiЩNKvZВг’–ьДdЇ%;-йiЩNKvZВг’–ьДdЇ%;-йiЩNKvZВг’–ьДdЇ%;-йiЩNKvZВг’–ьДdЇ%;-йiЩNKvZВг’–ьДdЇџП%dGЁЎјгиІ~‹Љпbъǘњ-Іў9SџœЉЮд?gъŸ‹\МЫfО*ђЭТlлљЊШmўМзsТ}…ЦHSpe$QјYфppYd8јh$\IіF2СŸЖХгЖxкOлтi[лzŸmНЯЖоg[яГ­кжНЖuЏmнk[їкжНЖuЏmнk[їкжНЖuoЩ…ЎЧЉt]LEІKшRКŒ>BЅбхt}œ>Aгш“t%]EŸЂOгgшjњ,}ŽЎЁПІПЁЯгшoщ‹t-•в—шЫєњ;šNзЉхzКnЄ›ш>Џћ‡є#њ*ЇгКŸ щ!ZHјoЕ­гOЉŠЃЧi §Œ–њ\Oв2ZN+h%­ЂеД†жR5­ЃЇщZO5ДžЅ_P-mЄMєеQ=mІVz‰кЈ:Lџu…?ˆм8q"rspЎ4\ЙеŸЗљѓ;…ЧlЭ_Е5KmТЉ6сT“ОзЄя5щ{Oх{LОЧф{LОЧф{,ј,Э/Мbњ_1§Џ˜ўWLџ+ЖжT[kЊ­5ежšjkMЕЕІкZSm­ЉЖжT[kЊMtMtMpмп'ЈL- Ј„О\Uђїє5њ:}ƒfгKvяGЛY‘ыƒOЉт,œљNА0ђЃр}‘ђр‘Сћ‚{ЧW6Žи§Gьў#vџЛџˆкљЁкљЁкљЁкљЁкљЁzjід0ьЉaиSУАЇ†aO E†м Йrы0ЗВмЪr+Ы­,ЗВЇ}Ž3+іі!{ћН}Шо>doВЗ‡ьэ!{{ШоВЗ‡ИсVФоВЗ‡ьэ!{{ШоВЗ‡ьэ!{{ШоВЗ‡ьэ!{{ШоТŠqЌЧŠqЌЧŠqЌЧŠqЌЧŠqЌЧŠqЛњ№iПћКко t’оœ|? џфџ€ќџђ@ўШџљ? џdЉG–zdЉG–zdЉG–zdЉG–zdЉG–zdЉG–zьОWэОAЛoаюДћэОAЛoаюДћэОAЛo0rc№Žр ˆ~б"њQD?ŠшG§(ЂEєЃˆ~б"њQD?‰шуˆ>>љ›Nю ;щЛtџ=њ>ЭЅyєƒТkКъ^Ј{Ёю…КW|š@ѕ TŸ@ѕ TŸ@ѕ TŸ@ѕ TŸ@ѕ WSŸЋЉЯедЧн=мэуnwћИлЧн>;-ЦсmоЦсmоЦсmœH 'rœШq"Ч‰'’œHr"Щ‰$'’і\шЕчBРЈT—М3eœ)уLgЪ8SЦ™2Ю”qЦѓ=KяЄѓ зOўО—wг{шш|z/Ь…4•.Ђ‹щЪB”‹Qк)C;ehЇ э”Ё2ДS†vЪаNк)C;ehчфяЙЪhнNпžќН2мAwв‚Т4ЮNуь4ЮNуь4ЮNуь4ЮNуь4ЮN -дЫа-2t‹ н"CЗШа-2tK№3џючє$-ЃЇh9­ •ДŠVгZKеДN§Oг3Дžjhƒџ§YЊЅД‰žЃ:ЊЇЭд@ЯS#mЁ­…ЧьёЧ‚ќ§—Дš(J;шWєkjІкI­єЕQЛ^tаЫД‹:i7эЁНє uQ7эЃџM/ѕљћ~ЦЈŸа€I:Hƒtˆ†(NЩB&TaB&TaB&TaB&TaB&TaB•Љ}од6˜кSл`jLmƒЉнljMэ Љ4ЕƒІvаu6р:p ИЮмeю2їG™ћЃЬ§Qцў(s”Й?Ъмeю2їGYёї Й?ІЛ?ІЛ?ІЛ?ІЛ?ІЛ?ІЛ?ІЛ?ІЛ?Іѓў”тO)ў”тO)ў”тO)ў”тO)ў”тOiёї•ќ=}ОNп ыќїзг t#нDЗђ„ў9Oш?і„ўuOшЗ{BПжzЙ'єЯzB//ў–#OшхžаЫ=Ё—{B/ї„^^ќНGWŠqЅWŠqЅWŠqЅWŠqЅWŠqЅWъ НмЭ0Лј›’<Ё—{B/ї„^ю†˜щ†˜щ†˜щ†˜щ†˜щ†˜щ†˜щ†˜YќJžœЫ=9—{r.їф\юЩЙм“sЙ'чrOЮхžœЫ=9—ЃЧктo_BєЈAєЈq-ЏC5ВAж ШYу‚žу‚žу‚žу‚žуfИ$r}Ё2rCaОKњ ЗУљЇn‡ѓOнЃLYЄЉА.’№lс.МъЙ#|3ј3фщBž.фщBž.фщBž.фщBž.фщBž.фщBžƒhв‡&}вTњJџQщ?*§GЅџЈє•ўЃвTњўжѓРЩЩяxнhгМЭg]щГЎєYWњЌ+}ж•>ыJŸuЅЯъкЂsщt^с;ПуVHт]я’xчЉ‰Ў,lђ ‹_iЦЛaМЦЛaМЦЛaМЦЛaМЦЛaМЦЛ1МУЛ1МУЛ1М Оœ­вy*Ївy*Ївy*Ївy*Ївy*wъЛЫqn9Ю-ЧЙх8Зч–џžпѕx чžТЙЇpю)œ{ъїќЎG‹Дќ?|зcЮmРЙ 8Зч6рмœл€spnЮmРЙ 8ЗсЗОыБс4пѕxч^ФЙqюEœ{ч^ФЙ^œыХЙ^œыХЙ^œыХЙ^œыХЙ^œыХЙ^“д…]Џcзыиѕ:vНŽ]•иU‰]•иU‰]•иU‰]•иU‰]•иU‰]•иѕv=]O`зиѕv=]O`зиѕv=]ыБk)v-ХЎЅиЕЛ–bзRьZŠ]KБk)v-ХЎeиЕ Л–aз2ьZ†]ыБk=v­ЧЎѕиЕЛ.§-v}ЛО]ŸЧЎNьњvubW'vubW'vubW'vubW vе`W vе`W vе`W vе`W vе`W vе`W'v­ЧЎNьъФЎNьъФЎuиЕЛжaз:ьZ‡]ыАkv­УЎNьъФЎNьъФЎNьъФЎNьъФЎNьъФЎN|РЇ|РЇ|РЇZ|ЊХЇZ|Њ•њ›ёщ1|j”ўaгИt.-СЅ'Бш—Xt}ЩйЈАж ТTXƒ kPa *ЌAЯ]t.Н“Ю+<№;Оz˜A… *dP!ƒ TxžA… *dP!ƒ TШ B2ЈA… *dP!sЦ+Јxk.(,D……ЈАЂТBTXˆ Qa!*,D……ЈC…zTЈG…zTЈG…zTЈG…*фP!‡ 9TШЁBrЈC…*фP!‡ 9TШЁB=*дЃB=*дЃB=*фP!‡ 9TШЁBrЈC…*фP!‡ 9TШЁBёы4ЯЃТѓЈC…*фP!‡ 9TШЁBrЈC…*фP!‡ 9TШЁB=*дЃB=*дЃB=*дЃB=*дЃB=*дЃB=*дЃBrЈP 9TШЁBrЈG…8*ФQ!Ž qTˆПХяц\?IзOвѕ“t§$]?IДш8Уї?#Шa9Œ ‡d+‚lE­ВAЖ"ШVйŠ [d+‚lE­R‡ uR‡ uR‡ uR‡ uR‡ uВAЄAЄAЄAЄAЄAкЄAкЄAкd ‚lA-ВAЖ ШBПDBKфRЙAšф/ЄAšЄAšЄAšЄљї H3‚lAfiFfiFFiDFiDFiDFiDfiFfiFfiFfiFfiFfзOё=R(в"(в"Јq!jќb|1о‰яD‹g‚ЕRп*ѕ­Rп*ѕ­Rп*ѕ­R•њЈдGЅ>*ѕХgžVio•іVio•іVio•іVio•іVio•іж3ОлpБњЇTEбуД„жбгє ­Їњпп-lŽщhŽщhŽщhŽщhŽщhŽЉh‚P B)Ѕ ”‚P BOІmžLл<™ЖIФ.‰и%Л$b—Dь’ˆ]БK"vIФ.‰и%Л$ЂM"К$ЂK"К$ЂK"КЄсeixY^–†—Ѕсei(HCA вP0Йн&wПЩнorї›м§&wПЩнorї›м§&wПЩнorЧMюИЩ7Йу&wмфv›мn“лmrЛMnЗщ‹™О˜щ‹™О˜щ‹™О˜щ‹™О˜щ‹™О˜щ‹™О˜Щыžќ]ЃOв2ZN+h%­ЂеД†жR5­ЃЇщZO5ДžЅ_P-mЄMєеQ=mІ†ЩЏхЗЙУwЛУwЛУwЛУwЛУw›Ю}ІsŸщмg:ї™Ю}“O№ПyzпXrЇНu—Нu—Нu—Нu—Нu—Нu—Нu—Нu—Нu—Нu—Нu—НѕUМнo7СлM№vМнo7СлM№vМнo7Слэ­Gэ­GMr“In2ЩM&ЙЩ$7™ф&“мd’›Lr“In2ЩMAё{џЗQЭ лщлєoп7ЛРј§є=HбBz˜б#єzT’ю–‚ЛЅрn)И[ ю–‚ЛэАЈЕУЂvXд‹кaQ;,j‡EэАЈЕУЂvXд‹JЮ\Щ™+9s%gЎфЬЕУЂvXд‹кaQ;,j‡EэАЈЕУЂvXд‹кaQ;,j‡§мћЙЕУЂvXд‹кaQ;,j‡EэАЈЕУЂvXд‹кaQ;,*ЅsЅtЎ”Ю•вЙR:WJчJщ\)+ЅsЅtЎ”Ю•вЙvXд‹Jы\;,j‡EэАЈ•овЛBzWHя щ]!Н+ЄЗ[zЛЅЗ[zїJя^щн+Н{ЅwЏєю•оНвЛWzїJя^щн+НлЄЗVzkЅЗVzkЅЗж>[)С{%xЏя•рНМW‚_о$ј ~С>›oŸЭЗЯцлgѓэГљій|ћlО}6п>›oŸЭЗЯцлg3ьГій ћl†}6У>›aŸЭАЯfиg3ьГЈp*ЬF…йЈ0fЃТlT˜ ГQa6*ЬF…й%~U2•.Ђ‹щЏшУt ]J—бGшЃє1КœЎ г'h}’ЎЄЋшSєiњ ]MŸЅЯб5єзє7єyњ§-}‘ЎЅRњ}™ОBGгщЋžžџžОF_ЇoаuъЛžn щ&КЅpШЮНАфЖТ6{їR{ї6{їr{їыіюеіюъ’Y(ёўнїќ§ћ4—цбh>нKїfЂпLє›‰~3бo&њЭDП™ш7§fЂпLє›‰~3эоеxŸнЛкю]mїЎЖ{WлНvo…н[aїVиНvo…н[aїV”ќмО^ŠœOв2ZN+h%­ЂеД†жR5­ЃЇщZO5ДžЅ_P-mЄMєеQ=mІЏчyjЄ-Д•Жб єKкNMЅfђEОџŠ~MЭдB;љ*“Eи(ТF6ъ)b™Їˆež"–yŠXцјюя{ŠИгM№n7СŸИ ўФSФ~$/Œy’hЄ Уž&>ЩВA52ч‘9ЬydЮ#s™ѓШœGц<2ч‘9ЬyTNЂr•“ЈœDх$*'Я№S )4NЁq ShœBуЇа8…Ц)4NЁqёНЈЏпЃяг\šGѓщŸщ^К~H‹ =лƒА=лƒА=лƒ–=hйƒ–=hйƒ–=юŒ+мW X‚ѕ X‚ѕ X‚ѕ X‚ѕ X‚ѕ X‚ѕ W"@Єˆt‘2ˆ”AЄ "e)ƒHDЪ R‘2ˆ”AЄ "BЄ"Ѕ)…H)DJЁQ Rh”BЃЅачњCŸcшs }ŽЁЯ1є9†>ЧачњCŸc“Пgќ]є‡єnz§OяЅ?І ЈјлСпgWПŸ>@SшПаŸгщ/шCє—tџлыщ*ОGэ&К5x—_$СГ$јќy ў ф^( щLHgB:в™Ю„t&Є3! щLHgB:’™5б]&:fЂc&:fЂc&Кј37§ІЙп4ї›ц~гмoZ/1­—˜дЎр :ащ„N't:Ёг NшєЋ:§ЊNПЊгЏъєЋ:}™N_Іг)NщtJЇS:вщ”NЇt:Ѕг)NщtJЇS:В“&ьЄ ;iТNšА“&ьЄтї:ž4Oš€'M@П ш7§& пє›€~аoњM@П ш7§&`Ѓ иh6š€&`Ѓ иX|?З)Xd ™‚EІ`‘)XљŠ'ўы‚џxъ'ОъjкљVс›‘[ -‘[§3ІFЪќѓ џ<Ї№fp•‹$х"IЙHR.’”‹$х"IЙHR.’”‹$х"Iq0ХСSLq0ХС3Ьp0УС 3ПзїтќwiбХ'3сРЦ80Ц1ŒMОќuеt‚Nв›єoп~K№іШ *ўШџоwZЊрИ ŽЋрИ ŽЋрИ ŽЋрИ ŽЋрИ ŽЋрИ ŽЋрИ *(Ј  ‚‚ *(ш}‡оwш}‡jњЯ№ЬМG5ЊщPM‡j:TгЁšP5ЁjBепšазWѕДј~гW#Х{ѓ’ вѓЯтТA§9Ј?ѕч ўдŸƒЇэЯжр|~О*3ЊЬЈ2ЃЪŒ*3ЊЬЈ2ЃЪŒ*3ЊЬЈ2ЃЪŒ*3A"xGp˜†iдd/ьїЪOxх'Мђ^љ ЏќФo§ДСЗ"п "њpюЉŸ:јVЄЬ?ЯЮ .д„~$є#Ё §HшGB?њ‘а„~$‚JнлъГo+ОOO‡i˜~CШ㧔Ь.ЏjПWЕпЋкяUэїЊіѓ3ХЯ?SќLy•эЇ~j Хг$OScмgŒћŒqŸ1ю3Ц}ЦИЯїу>cмg,ОoЁšеЈц@5Њ9P­џењ_­џењ_­џе2xŽ žЃџењ_­џењ_­џењ_­џењ_­џењ_­џењ_­џеЊ:ЂЊ#Њ:ЂЊ#Њ:ЂЊ#6ЫЭ2dГ й,C6ЫЭ2dГ й,C6ЫЭ2dГ щФАNФt"І1ˆщDьдf9Јuт Nд‰ƒfтmfтCfтњŒ™x›™ј™xЗ>ƒЏБрЫС‚р§С§є=HбBz˜б#єЊ >Ч­NnurЋ“[мъфVчЎЏнЩ§мъчV?ЗњЙеЯ­~nѕsЋŸ[§мъчV?ЗњЙеoўjЬ_љЋy‹ЯƒЋ9ДœCЫ9ДœCЫ9Дœ; ЙГ; ЙГ; эмГ0фjћі{8r‰}{–\mп~O.Бoя‰м[иЙЏай\йМ/вLUбSz?=@вCДІEє§„*‹мжГm“љ?г•БSЅ;UКгЋOzѕЏ>уеgМњŒWŸбпџЮMГW†NНK№,Uэ:ѕNСГTДK:†#ХїјгQЉ‚JTЊ R•*ЈTAЅ *UPЉ‚JмЋчY=ЯъyVЯГzžеѓьщЗ†oЃv9э —iuвnкC{щъЂnкG}4€)iбy^сPŽC9х84ЪЁу:ЮЁу:ЮЁ"њ9є‡^уаkzCЏq(СЁ‡Jpш9єЇ’q‡.—ŠГЅт<].gsш“њ$JўX:z‹л.˜"SЄcŠtL‘Ž)в1E:ІHЧщ˜"SЄуу&ўƒ&ўƒџЧW3Fхі5Ѓ<Ѓq:ќЁW<ь{ХУ^ёАW"‡ШaЕjтbљ|ф•B]ЄЛ0ймМKѕT@ѕT@ѕT@ѕT@ѕT@ѕ§џњю Џ"цГїљш1=6™Э>ЪfeГВйGйьЃlіQ6ћ(›}”Э>Ъfх‡<рсx8РУ№0ЦУc<Œё0ц3Ор3О№{^Š'xx‚‡'xx‚‡'xXМЮoчс+<ьRХgyјv^ЫУѓxXЦУЗѓ№ZžЧУ2U>ЊЪGyXЩУV–ђА›7M>CжЊМVхЕ*ЏUy­ЪkU^ЋђZ•зЊМід|І'ёгМЗгоFПпo8эєШEёЮНAѕћTп­њвSеOS§йЊŸsЊњiЊ?[ѕsTџ„ъŸ˜|?№GўняЫ_\ЈSiJыTZЇв:•жЉtЃJ7ЊtЃJ7ЊtуoН‹ЕQЅ*mTiЃJUкЈвF•6ЊДQЅ*mTiЃJЯt Њш*z›ŠfЊцЊ)оЕ3Uёtp**TQЁŠ UTЈЂBЊЈPE…**TQЁgwœё'‹зZUвЊ’V•ДЊЄUЯvыйn•ДЋЄ]%э*iWIЛJкUвЎ’v•ДЋЄ]%э*iWIЛJоPЩ*yC%oЈф •Мёбћ:—еѕ…N§ыбПЋNнІ_QэЊ]tъ6§ŠŠ/Pё"§[Є‹LяУЊпdzЏ1НэІїВрcœхФ('F91Ъ‰QNŒrb”ЃœхD‘њН\шхB/zЙаЫ…о3мЋgщчY\шхB/zЙаЫ…^.єrЁ— Н\шхB/zЙаЫ…^4Gѓq4Gѓq4?нW:TќеNSщGT9MeћƒЏ–\ШЃЉt]LEІKшRКŒ>BЅбхt}œ>Aгш“t%]EŸЂOгgшjњ,}ŽЎЁПІПЁЯгшoщ‹t-•в—шЫєњ;šNХџџ…Oв2ZN+h%­ЂеД†жR5­ЃЇщZO5ДžЅ_P-mЄMєеQ=mІтwЙ‹џ_EПІfjЁў]k!VђЕQ;u`јЭžќnХїop0ЫС,ГЬr0ЫС,ГЬr0ЫС,ГЬr0ЫС,ГЬr0ЫС,ГЬr0ЫС,ГЬr0ЫС,ГЬr0ЫС,ГЬr0ЫС,ГЬr0ЫС,Г,ў,bžƒyц9˜ч`žƒyц9˜ч`žƒyц9˜ч`žƒyц9˜ч`žƒyц9˜ч`žƒyц9˜ч`žƒyур1ур1урБџЩмЧGYŸ{Пg&F­ˆ ЅOmыЎЕnиХкZЋЇG)ZЗу9>=Їж>)*юT@\ыОЕЕUЋЕh XувАЉ,УBHHC‚2CV2–0ЗћМg}hkЯyќчМž—Џ’ћЗ}Џяu§~w2 зSp+ЗRp+ЗRpkЄЦУ дbЅ2ч=ёПR4Kб,EГЭR4Kб,EГЭR4Kб,EГЭR4Kб,EГЭR4Kб,EГЭR4Kб,EГЭR4Kб,EГЭR4Kб,EГЭR4Kб,EГЭR4Kб,EГЭFюЗЊ№ ТУxт1ќ:ьЇx?Хћ)оOё~ŠїSМŸт§яЇx?Хћ)оOё~ŠїSМŸт§яЇx?Хћ)оOё~ŠїSМŸт§яЇxџЁјŠч(žЃxŽт9Šч(От(От gЛKђЯШŠD­*†ь†RьŽиq D9ђŸ=: 7умŠЩАЯEьsћ\Ф>БЯEђћ\<ВWАф_0+p%ЎТеШпэпeIѓHšGв<’ц‘4Єy$Э#iIѓHšG2ђЙА!В7a ЦО‚ЁиУ№љpyф‹сŠШўјОŒЏрˆƒp0СџяяŠѓУpad4ЮСЙјЮГОѓq.ФE˜6ŠQЃ5ŠQЃ5ŠQЃ5ŠQЃ5ŠQЃ5ŠQcфnmюлИКЋлИКЋлИКЋлИК-ђfPy+(ЬЧ,Ф",с%XŠeXŽПЭэѓмг^^_<{WЯмі Ѕ…з= ЭŽНхю3KчЦ6ƒbmСчcўн Žuй…Л}ocp|p.ЇtpJЇtpJЇtpJЇtpJЇtpJЇt>гvo Т>Œ}1CБ†!џЉЗ_ Л9Ѕ›SК9Ѕ›SК9Ѕ›SК9Ѕ›SК9Ѕ›ъ]TяЂzеЛЈоUјМмIИЗрVLЦLХm˜†лqю.М6­VЄеŠДZ‘V+вjEZ­HЋiЕ"­VЄеŠДZ‘V+вjEZ­HЋiЕ"­VЄеŠДZ‘V+вjEZ­HЋiЕ"­VЄ)?ђпЇќ@ЪŸђoQ|Hl^№•рj6SГ™šЭдlІf35›ЉйLЭfj6SГ™šЭŸсЏjfЉ™Ѕf–šYjfЉ™Ѕf–šYjfЉ™-|zёhœƒsё#œЇ§љИт"ф?пxnЦ-И“сLFс-оBс-оBс-ЮќO=C)vя|UрЙХWž›џ ц ъ;љчљ Jќ|@сОщ’ТkюЮ іTЫдЦ2ЕБLm,SЫдЦ2ЕБLm,SЫдЦ2-бђ-бђœBЫсZзrИ–УЕЎхp-‡k9\ЫсZзrА–?зrА–?/Д,зВ\Ыr-ЫЕ,зВ\Ыr-ЫЕ,зВ\Ыƒ ЇЦK<:5~Ій\јзЮ–# žџ›@p>ЏЕђZ+ЏЕђZ+ЏЕђZ+ЏЕђZ+ЏЕђZ+ЏЕђZЏеёZЏеёZЏеёZЏеёZЏеёк^›ЧkѓxmЏЭуЕyМ6зцёк<^›Чkѓјj _-сЋ%|Е„Џ–№еlОšЭWГљj6_ЭцЋй|5›ЏfѓеlОšЭWГљj6_-Q/3ъeFНЬЈ—ѕ2Ѓ^fдЫŒz™ї]Žяr|—уЛпхј.Чw9ОЫё]Žяr|—уЛпхј.Чw9ОЫё]Žяr|—уЛпхј.Чw9ОЫё]Žяr‘WУvй\ьэ<а_јŒяљX€…X„„нrБк,Х2,GЊОЕX™џ§Ÿѓьnr1.уr1.уr1ŒЕ&QkЕ&QkЕ&QkЕ&QkЕ&QkЕІТ'ŒяAиƒБ/†`(іУ0ф?ƒќ‹Цо_Т—ё€qЦ!ШRљhœƒsё#œ‡ѓq.ФEШ–љ$мŒ[p+&c Іт6LУэИwkѓпМѓoŸТЇЃЯЧ,Ф"|ЪЮGУžћ/Сxўb№ОПX„ю2Юч‹ŒѓEЦљ"у|‘qОШ8_dœ/2Юч‹ŒѓEЦљ"у|‘qОШ8_dœ/2Юч‹ŒѓEЦљ"у|‘qОШ8_dœ/2Юч‹ŒѓEЦљ"у|‘qОШ8_dœ/2Юч‹ŒѓEЦљ"у|‘qОШ8_ф=лХГ]<лХГ]<лХГ]<лХГ]<лХГ]<лХГ]<лХГ]<лХГ]<лХГ]<лХГ]<лХГ]<лХГ]<лХГ]œКўœ\Л?эйœкЫЉНœкЫЉНNЎmБќЋˆЯЃhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šЂhŠЂ)ŠІ(šwЫESMQ4EбESMQ4EбESMQ4EбESMQ4EбESMQ4EбESMQ4EбESЊ@–ЊЉO}ОKТї?х9ВTmЇj;UлЉкNе:ЊжЩі”lOЩі”lOЩі”lOЩі”lOЩі”lOЩідg8]х_щм#л{d{lя‘э=ВНGЖїШійо#л{"‡ЪЎУp8ŽРWq$О†Ѓp4ŽСБ8#p<ОŽoр›јNР‰8 'уŒФЗq*Оƒят4|Їућ8gтŸ№ќ3ЮТй…OЏFџўhхд$мŒ[p+&c Іт6LУэИ;п­_5ъWњUЃ~еЈ_5ъWњUЃўШЏUšпр ќOт)<пу<‹?р9ќгё<^РŸ№"*13ёўŒ—Q…W№ІНќ-ЬЧ,ФЂOW„ПsвyсПЋ‚џжuRёя\'Љ‚Ћ юътЎ.юътЎ.юътЎ.юътЎ.юътЎ.юътЎюъсЎюъсЎюъсЎюъсЎюъ)>їЌ—ЛzЙЋ—ЛzЙЋ—ЛzЙЋ—ЛzЙЋ—ЛzЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ”ЛJЙЋ—ЛzЙЋ—ЛzЙЋїSŸ/їйнећпПsUPТ]%мUТ]%мUТ]%мUТ]%мUТ]%мUТ]%мUТ]%мUТ]%мUТ]%мUТ]%мUТ]%мUТ]%мUТ]%Ew рЎм5€Лpз€рЎ,weЙ+Ы]йт;ёSме\Ш]kЙk-w­хЎЕмЕ–ЛжrзZюZЫ]kЙk-w­хЎzюЊчЎzюЊчЎzюЊчЎzюЊчЎzюЊ/Окbw-уЎeмЕŒЛ–qз2юZЦ]ЫИkw-ћЏЌX*RKEjЉH-ЉЅ"ЕTЄ–ŠдR‘Z*RKEjЉH--МВт~їPрA<„‡ёХcљпŒrЪo№~‡'ёžЦяё žХ№ўˆщx/рOx•˜™x ЦЫЈТ+x5џ~Сq>ŽТѓ љЛžТы)МžТы)МžТы)МžТы)МžТы)МžТэnЇp;…л)мNсv ЗSИТэnЇp'…;(мAс wPИƒТю p…;(м!уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.уђ7.лхoЛќm—ПэђЗ+:ЙЂ“+:ЙЂ“+:ЙЂ“+:ЙЂ“+:ЙЂ“+:ЙЂ“+:ЙЂ“+:ЙЂ“+:ЙЂѓППыјн>-?эЗA›П?—П7ѓї”bўžRxюэ5Ÿё=џ_XЯ]ѕмUЯ]ѕмUЯ]ѕмUЯ]ѕмUЯ]ѕмUяD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2чD™sЂЬ9Qцœ(sN”9'ЪœeЮ‰2Ч]YюЪrW–ЛВм•хЎzюЊчЎzюЊчЎzюjрЎюjрЎюjрЎюjрЎюjрЎюjрЎюЊчЎnюъцЎnюъцЎnюъцЎnюъV rN™НŸњюЇ‹} –b–ž ”ПћљBP=!LGП‹3Тž^§AxEьЌpAь<їLо5џ93‹Ÿs0“2СРшбawtО‘8#\Ѕѕr­—GЯ Wsв:-[Дj іtuЋ{\3о;ZєѓшhњоХООИ3\Н+\kœŽ Ўх6-ЗiеІе6­к\Боы­сHk8в•Ы cДЛВнk\йnF5fДТŒVD ы —фпAЁјОвхХї•.ш{К~Ї›Х Øa3ŒёІ1о,<nОЧш{ŒОгњЃя~}їщЛOпљ9']ŒїQ_ьТЖлtTёЗMGŸ9ДАагѕєcc.егЛ4zF№ПєpЖЮ.Оvѓютs"/О#ХqХwЄ8ЎјŽŸгг•zКвœњєЖDoWъm‰ž.ггez*ггzКVOƒєВПізУ$=\ьЎеB-jбЄE“+ЙbŸ>ьE­диў1zyјpt,ЦЁ"мњ7ўИ‰?цвѓ&ў˜ЋuŸИц‰ 1†/.ч‰Б‡ŸчМ№нOМq}ЗЙŒл‹ХіRTИ‡МИ№ћЉƒ§ДžGGћю…слzЋб[оjєVЃЗЗў&Ў{уКgЁчwЌctXЅmJл~m?аіm?аіmh;ЪёТы .ё˜­СЮП/' ­Ї˜зѓZ|См–hѕЪю lNыЉZ-ў6nhсoИуТЧђ.ЬћJcї}вУЮжпдzeё5§ЇZюlѕVіwWЏpѕ WЏ№г}§t_?y„SЏ1яkУбыј{jА[є—aoє9єx˜‰ўJ^F§єНшд0Dќ‡8\'ЛЎЗђ05lŒNгЫэzЙ'ьŒ>j†‡яkљОя^ЅЏ ИFзёљФАCџЂ‡йЈЛоНŠтpя^яЪpsXНЗb2ІћFЇ…3ЃїЙюў№ншxсёАкXеA‰YЎsUƒЋжG 7›їдp‹9ѕ›ёUсvЃl7Т{FШЏf=‡ц84чŠœ^ЖыeЛ_k–љѕMдv’YNUІљо}Ђ§h˜ >ЏЏyњšgЦЎ\ЂЯД>гб§{bиЅе+шБ‚+шБ‚у}hМyЦ›gМЭб{УХVВЦJжXЩ+YC“К'ЬЅб\ƒсFj3R›‘Жšз|Ѓeаl„Fш5BЏzаkžeцљВQzŒвuњЇtЇyWЉгHFъ4RЇ‘2Fкl=sіŽбо і0ZЮhЙТъwіжЇЗЭzлЌЇœžњдшыХљL5Ц4ЪоэЪ{\YИТзтqОјU1КњьдЊGЋГю6ыnГю6ыюТ8ЯXџ7гЧ]ѓ+ЙœхІТo,KѕйЃЯЋшБŠ6зєИІЇЛm=?=о]˜yЮZs*ТЕкOеч4уоэы{јр>юz4ˆЋ~+phMФЄ`˜Ћ?0УMfИЩел­s“шѕiѕ53Ш™Aп'юЩ{0яБЭfАYЫХŸфN_+ќl*ІЩŒНŒЕЬXЫ\quЦXљьj6ГнŒзaМŽ‚ЖїљїУrуЮzмї~e‹ђuч З#Ђ3Ф№е`HtnИ2:oqх|s[о]>]„ХіЂхс/ЂЕсдhНk=6!KхMиЊmс}б\8+кђюУ№ЗБ@н) ;cЛ{€r_ ЗХ†b?ŠУpdи;ЪN~L8/v,ŽУ5ї›vнУWbійO>щшќрsБ ‚ВтыŽVщ_RaVщ_R“:э\ЯZл ЬЇў‚pЕUєYEŸUьˆ.ёИм~^Ћš­ЖЪFMшфс.Qм&џrмпїТЭV№ЎйПkіяЦ†ЉАG…iГмj–[ЭrkЬiЮ SС~ХQ›щЗнЈkŒš1jЦЈuƒQ“F]cд­F]cд5FЫm‹бЖi‹‘Жi‹Qve›QЖe›2Сx#\}!МЩ(лЃЏ†/EџNŒVcЎК0oaОъЙ8|.Кœ{ъ§{ЕlO†?ОЮ‰6c-ZаŠuсЯЂяxLЙ.Онры6t 3И&к>эіѕFє„зF3{‘uJи„ЭОо‚­сљб>•"g…§иžBЛDє}?ћ†ЏE?ђŠ`QФТ…œёуиnО. яХ њКЬyП5МИјЌЧwьЁOйC/ЗЩюћЅи˜Тљу­рQZ/JыEi=ЌпХ­МбЮI[ЯIоHRЙЪэдmч“uдmЅn+uл(šц—ulч™u<ГŽj]кDЁMкdХ›Ќx“•nВЪ”UІ­2m•iЋЬZYЏЕZ…кœ(ЏN–OыфвКр>ЫёW'ušyЃ™7šљ*3ЯчQMбЭMfмXЬЃ&Гnт›/šyГ™7›yНй.5лv3m6У тиf–ѕfYo–ѕт6PМкХЋнŒ“fœ4уеХ<{лŒп6уЗЭxu>ЯЬЖ>8дŒV˜б 3ZjFэfєZ1ЋгfДТlвf“6›}ЬfЃйl4›ѕt|‡Žэtl/жЈ$з˜нF:ЎЁум^ЌSiГL›eк,ЫЬ.mviГЋ3ЛufЗЪьV™н*Г{—ž-fИи гvЖgey~f хъ",‘хЫЭ V%Xm‡kєиnЅNˆћч?gU›-tпNїнsкМЧW-ќдц\є,х_Р ||Х‚№ЊOjєgŒхсљњ"ŽЯŠуГЮЯ:сО@‘œ3“л^5ЇПјw5P`!Ea ѕ–лjУ7ЂЋдО1}УпP?ВjEЗ•ЇY1\%fЭbжl~kЬoMp€‘ю3в-FJџUuZ`7[h[„%~Ж< вWЌƒ}Fш3Т #TЉ8uFI%a”ŸўU 'q‚Ќо()БH‰Х†‚і4—…љчŽc6Чађ-Z.ІHЇ;” ќPt?н)§ {}^ЫVИаŠЁ3(ЯЭтЙY<7jэ­VѓЈ•Мi%ZЩƒ\WЧuuњ^]hЧ\„Хс3Vє>зеYQЛ•\ѓjээХZ;G­}ѓojэ­V^ЕK­Нe—Z;{'ьRkЧЈЕuЛдкѓекк]jэмPk'kэ3дНЅXk+ŠЕЖB­­Pk+дк ЪŸHљ3(хЯPkЇЉЕзЉЕjm /Rk+дк Q9]TN•Uk+дк б9]tNWk+дк QњЎZћяВІ’ЪЗRљV*п*rgЉЕПTk+дк 4Y­­Pk+dвЭjm…Z[Ёжў›ŸЁжVˆrў=Я/>KПRДЏSkїSkїSkWЊЕ/?НŸŠоUЂїgб› zDoЕш­.TБљ2qqИHф6Šмj‘ыЙЋEЎFфjDЎFфjDЎFфюЙQ{CдjD­FдjDэпDэUQЋЕQ{\дjD­Fд^ЕзD­FдjDmІЈ-UЖ‰и"–БЋ­бЊ­бЊ­UЂѕšhеˆж2бz\ДjDkЎh5ˆVЕhU‹VЕhU‹жїDы>бКOДю­7DkБhU‹VЕh]"ZеЂU-Z‹жХЂ5SДЊEЋZДю­;EЋZДЊEы—ЂЕHД:DЋEДZDЋEД­бЊ­ъТйь[OРI8Ї8З4‡oћњд№"5JЄоЉќыП.:+ƒƒEчyбyQЅЈW“6‹R­(=/JЯ‹LЏЬ|Qf6ЩЬ&уMQЪЈЏЊK‘ъR5^U5^БgEg‘œъ‰ZXHсЄмHЩ•;фўj*fхџjљПšš )VI‰JJTšeў чфїьр YХ#ЋxЄ†?ўbф ќБJЌП#І-bк"–ЫђЎQъŒR'žЏGѓЏb мI—аiwPІN•ле†аl(іУўСWiпOѓfš7гњm:ЗбyWаyiћЖ HвВСyНгю“п'G„8ћЯ(œ/ЧRшq =NЁљцy v˜зsцUe^UVп]<'Ь0Їц4УС‚№—Z.дrЁіkyЏVs?9Йямз}|Ња"ЋNoТV§m _peТ• ы^чъ]=нКЗj1]‹щЮб)WosJЩ‰K?оsТЌЌ4ьvе W­АCІфТЖ№mWЕЙЊЭUњЫŸƒы\йчЪ:WжйС“|Б=ШђФ&luВяЉфк­KТ&­ZФїyёЌцК5\—п›^/<“*џ,ЊМћіжCŸњєаW<Мcќwєж]8Љ\SRПУјХWКх~уXћjЃ}ЕБ JЗ^КѕђЎ^ZєвЃ—НМЋ—Ќ^fщ%ПоYz™E•ЌŸnТЮѓмћy§ gўћVём/КI?Эы—uХ&ьœх–]N-=жмЄхZ-пЗцЭZЏеzmЕвќяхŽs/™ДЋѕшч==ЧУ­СžŸьт)жSˆх*НЎгы:W­еу+jO_QћWєјJ,џљАљ–‹Дќ‹–[ДœЅeћЧw-љJЖЋ_ĘEџбtџ‰{вќkшіа~Г6›ЕйЈЭЦт}UжH]кeЕЫV>л( #,й%зV[qЅЙBnХ П­К­нЗ2І№ћИ|ы— Е Ч]UVи„­ЊњŽ‚72ЦЪыАFы+ŠПыZЉѕE…П# вzжЏ[с uОI/o˜ёЬ]rщѕbfќ–FљŠ’?wџжЬЋз7єzЗоfЂМжиk gпmђkGИ@ЋŒ9Ќе"ЃE†{’”Kёћ6љ›ГOєу=ѕ АгюTeš+Їёл№лˆч63ЪщГіxч•aN‡Gсё:Чсјp‡:1XѕfЌЯhGбћы?ЧсјТkѕ:ѓяHФ]ныъэЎюuuЏ+ћ]йяЪўтнmЗ*Й)јb$.ŽФP‚нPŠн1{ Ž(7~™;иСсЊпFеoЃъЗб30SьUЛTР.АC]kWщ6Ѕ—’ЯPђ™ТГѓЯќЭчьОъh_lАbUCБ•7‡сHЅЇc8щX‡Оw|А—:šПwnг{F;5ЧXљ+_ЃІvzцyпˆƒ П…иўwїїџbn—„iUцъ!”Š§№я К cžшъ‘TнCпйТя pN9ЧјЩБ8Ч#џ9—\БЅј{•~КвOWG|РˆЛћiя_E8ЋP~”Z}l3ЪЃЌйѕ ЋŸќ|к‚ˆйm і‰•ћjpјЄљїšЏљїjїšvЏYљЖ]"’Б–жб+"љзDўIDў$"ƒD$џЛјdАЗžўќ7БЇЇyzкЊЇ>=ѕщiЛžЖcЛCOЫѕДќуž XoўZП­ѕлZчŠw~ЛzКЭ:огУ6Š qкŠ§p(У‘юЛwоМ[аЄU­њkе_VЋѕз П§5№Dwс9ІФўwp@pzpiјЋрЇИ ТЇ‚щ~~‰˜„tјxАmиRxЯЖћƒї№>>Р‡с§‘CУКШa8GрЋpЏљŽТб8Чт8ŒРёј:Оoт[8'т$œŒS0пЦЉјО‹г№=œŽяу œ‰Т№Я8 gcЦC#o†oDо _ЬЧ,Ф",чF–`)–aЙ s`0(Ќ і—ћb†тŠУp8ŽР№Я8 gc~ˆб8чт|\„KУ'(ўХŸ јЄръ№ЗС5Изсzмш$q~‰˜„ƒƒœФCxрQ<‡?b:žЧ X†хЈС дb%ъА юи‚ЌF#’H‡/‹ѓЫтќrё7—ЮэС6фасLБŸ)і3Х~ІиЯ Ц%СоСn(Хю€=Ч@”Ё{т„`Hp". oЂУMtИ‰засr:\N‡Ыщp9.nаУa-*hQA‹ ZTS‚Н‚ЉИ гp;юРИ wуT_ f!оhe7ZйVіА•MЗВщV6нЪІ[йє`Ля'ZнDЋ›hu­nbфзacф7xПУ“x OуїxЯтxФt<№'МˆJЬРLМ„?уeTс•А1zД}ќїд#<ŽФсMб3нЙ§Ѓ§{Œ{ђЫУqбБŽ+ўјътпЏŽ]эnщwOuСnБUСрXC№хXЃѓf“Ъv:н žЖ‡Цк=vфпUЮуFu([щъДˆфПЪПЂdhАMDЫDДLDЫDДLDЫшS&e"ZVјЏ{bPи,SšeJГLi–)Э2ЅYІ4Ы”f™в,SšeJГшя#њћ|ІїЎО4ќЇќŒS~ќgЊ1Иc1ј9Цу \‰Ћ0!УUWpе\uW]СUWpдiuGЦQЇqдiчЈ8GХ9*ЮQqŽŠsTœЃтчЈќgPЗШС9и"[ф`‹l‘ƒ-rАEЖШС9иТ}УИo˜\ь•‹НrБW.іЪХ^Йи+{хbЏ\ь•‹НrБW.іЪХќgч^ЩБWrь•ŸёНЃуючИћ9ю~ŽЛŸуюч8ћЮОГoрь8ћ5;Љf'еьЄšTГ“jvRЭNЊйI5;Љf'еьЄšTГ“jvRЭNЊйI5;Љf'еьЄšTГ“jvRЭNЊйI5;Љf'еьЄšTГ“jvRЭNЊйI5;Љf'еьЄšTГ“jvRЭNЊйЩШƒ!‘б8чтGјŸz?Ш7У*{Х{Х{Х{Х{Х{E•НЂЪ^QeЏЈВWTEj‚xФ=]Є+ѓЯ‘pЦ=#6ЧH;ŸбqГŒ>[FŸ]Шш‹нЭ\Š12|—ЬŽV^уyВьО\vŸ,Л/wюИ/6Сћьp~l^Аgь-`ЅГЫ*Ї‰†`ЈLя–щБиg™йО›l?А№щ{нОПQ5œ”„? vC)vЧь8Ђ хи{…'Ърм"ƒ[dp‹ n NрІё™28И8ј).У„р›Се2щ\‹ыp}ОЮG7с˜ˆI˜~/˜Šл0 Зум‰Лp7юСНсIџХkщ?х3)Уg‚YXцўg9jАЕX‰:ЌB=АH"œl@ЖЧ[еЧ>lC§иМ‡їё> rџPыўЁж§C­ћ‡ZїЕюjн?дКЈuџPыўЁж§Cmфsсг‘Н1ћ`0іХ Х~†Я‡ЯDО>й_Т—ё€qЦ!јa8#2чр\ќю7"чуИяˆ\„K‚Г"?Юќ{p}ф?‚яE~œЙ4И 21œ™„›q nХdLСTм†iИwрn}нЎŠ<€ёЦ#xЙ?:/Рйњ;ЮжЇЦf…ЯХц…gХRсRћириЇјvwюЩК‚сБnћуЦ0”|Д=и ЅиАтˆ2”cOьѕQН=nŽ=nŽ=nŽ=nŽ=nŽ=nŽ Љ’!U2ЄJ†TЩ*2I†L’!U2ЄJ†TЩ*R%CЊdH• Љ’!U2ЄJ†TЩНdШ^2d/™P.ЪeBЙL(— х2Сў„л0 Зум‰Лp7юСН-юыeУXй0V6Œ• ceУXй06xЬЯЧo№~‹псI<…Їё{<ƒgё<ч$іGLЧѓxђ§13ёўŒ—Q…W№*^Уыј ЊУ)ВnJ0лзs0ѓ№оФ|,РB,B‹БKБЬИЫQƒЈХJдaъб€еhD“6kєѕл›Б-h _жсМ‹ѕHa‡“Ю{xрУ`€Ь+sЧЪмБ2wЌЬ+sЧЪмБ2wЌЬ+sЧЪмБ2wœЬ'sЧЩмq2wœЬ'sЧЩмq2wœЬ'sЧЫмё2wМЬ/sЧЫмё2wМЬ/sЧЫмё2wМЬ s'Шм 2w‚Ь sЧЫмё2wМЬ/sЧGўЭ\/ N)~ІТзeяВїйћэШeaCd ч_уёZ\‡ыqnФ/0бМ&сfм‚[1S0ЗanЧИГ№\Шё‘{<ўїт>мN‘ѕSd§Y?EжO‘ѕSd§Y?%ђЊk^Уыј Њ1 Г1s1oрЭАЭ>мfnГЗй‡льУm‘„ ђщЏдщˆЌ@-V†*Ь@f  3K…ЈТЬRaіŠŽўЈ_eЙKeЙKe‰Ћ&wЉ&чЋ&чЋ&'Ј&'Ћ&зФц„Гcs1яЃžи›сЋін5БљсЂи‚№^UfЊ Г=жцО]›N{t—НЖ;ќ*“џ„Ы)сHY;RжŽ”Е#eэHY;RжŽ”Е#eэHY;RЖЮ•­seы\й:WЖЮ•­se^ЕЬЋ–yе2ЏZцUЫЂХВhБlЈ” •ВЁR6TЪ†JйP)*eCЅlЈ” •ВЁR6TЪ‚JЎпРѕИ~зoрњ \П!V>ЋS#нЦъУŸФТъиjЋk з:QДкЇЇ|Д-˜Šл0 Зум‰Лp7юС§aТjF[ЭhЋm5Ѓ­fДеŒV{jOBэIЈ= Е'Ёі$дž„к“P{jOBэIЈ= Е'AГ)p6ЮІРй8[эIЈ= Е'Ёі$дž„к“P{jOBэIЈ= Е'Ёі$дžе.ЅкЅjOBэIЈ= Е'Ёі$дž„к“P{jOBэIЈ= Е'Ёі$дžЕGQ{ЕGQ{ЕGQ{ЕGQ{ЕGQ{ЕGQ{”к“P{TЅі$дž„к“P{Ђ0Y&‹ТdQ˜, “EaВ3џkЮќЏ9ѓПцџчјJчјJчјJчјJчјЪтћйЎv–_э,ПкY~ЕГќърЃ№Щ ŸŒˆ„OŠшEЮ‡ЕЂњ˜ЈоЋџш#Q}ZTЯtV|UdЏй_›мщ sЇ7Ьо0'—ajо0wzУœШ†Йгцўn˜§g˜;НaіІvТ6;a›АЭNиf'lГЖй н]т0Ž#pB0мноp;aЃАбNиh'lД6к э„vТF;aЃАбNишnяTw{ЇКл;ен^ЋЛНVw{­юіZнэЕКлkuЗзъnЏѕ?ЉћАЈЎuэU6НJq@DдЁЈˆbkЌtA`#j”kŒ&vM”и[{/и5bEƒ и,(b ЮмwЏ=ž”k’sЮ=џя<ы[ьеЫWоwdАНBАНBАНBАНж`{CСі†‚э л Ж7TћWcыƒёеуЋЦWŒЏ>ŸŸŸŸŸŸŸŸŸŸљ†4†Fп‚Fп‚Fп‚Fп‚Fп‚FпњƒoЙіыѓЦфAcђ 1yа˜ KЪVя‚~ˆuІb§{1ЦДТЪАNbA/Кє"QbƒБцЖМ?ZiОЂЁј~ˆxuЖќY>J}›/ MљBв ѓ<Ц дƒ•fJЭ‰ЗфO”ийтˆŽ˜Ч'ŸJ˜щ‘<ϘЩ3мХ 'љ@є„іaШУ‘Їтц/ЈЏ7•3Нїz•шЃb&zШ­mав- ађ1Z”уDюРRсНЋхOe‰ѓз+У ™СЊ/ŠёrqкWа cЪžcіVп“Я=< ЁzЂѕѕsр­ЧНCЕЇ"‚œWW`іrЌѓ1nпcП@ЏузуО„ь3ъ‡” -?‡?Аš‹8ёKXћŒ YE5єЗ7JћЉ+ХїѕЫпеŸŒšTR = А"]єЌDЯjє4С\*yзшљFўџвž#нEzEмР нР нР нР н0ђЇYЩТ ‘!< y8ђрЩXЯ(ѕJ>їК€јс>pb0ЃП8лKъФlЙъЋаo+ ззк;іЦєЦњсL" ’ПIy8ђTb‡uЫжЅѕb­Ѕќb.n}?zAbєАCbєАC?Д6Чœ%тц/Љп`о—шY,zхŠяАз|ЊIЁ§T“‚„ЗИMœс Ъa†№Ер1jРь‡ЮiЮ?­8JЪqŽНёS?Ё›т›Žx n}4|Z ж}3оW?њp§ŠбЯЃыcd†š|Ќ?J]t\t\Ф[–еяОa­ѕDы;ИхœT)жt˜џFyЈ.ƒўжЗ|A|ПnЌk0R V<~ю6ЮјnИк)vtћПЏ>+Пg&ц~ƒЙп`ю7к•НћiŒТ0Šц7Ч(UE…Qфя$гЧЗА=‰"]H4R R &Ÿ#C4cT3ŒъЉ§обкяэ›_‹“кŠ“:=9 =щ=щТ7ЈПХК†7tеЬ,ЯxOё‡ŽјK-Ћѕ1rЅію˜ію˜8/yЇїхO6ЂE&ц^ЃmeЃmeƒЙЃЅЗ`њїхП.ЭуUGы!ЖпD,„и}SrWнХ}ЧЋЃД%х’Л:ЃЦЋŠx%Юу zWУОоЊЯI:ъ*Ф§—’‘њ9ZžCЫvЂo6j/Ђф"J EпЧќ5ц{ƒНU_†PI@чшЋBЋ+Р *Д ‚mЧЋJ0‹ (ф9VVЦ_!ƒYЋЁšžе˜Uєё+.“є‘bF(зŒTМ€vФЗTŠQЪ1Š ЃЈЙќfђмК„Ђw9zЋа[žїДkЈ/Ÿ“jжpНыЂwzWrАTБњjшл[h† qM­~‹ЕмЦhu1ZFЋ” дЙbWFъ<٘˜ =РШoБІŸфHЂfё%жQШU„ЁзKЬ](™рgwЕ“мBu-J1Ÿ|RљhQŠ1хSЪЧрИПО/мОіžаћ#ї#кŠ{Aлміј/о|к_<XњПљмБЧ?8oQѓЛчLL%+b Yc}ЖФPВУhішу€ИY?;ЂЎъœQч‚чzЈsEќŠ$й`{д*зУKVxВV?–jb~;Ь`™фБQ^хN(wAy=”cм‚мZžй^лBžIЫыbЈН+й Є&’-qФњ,ађ.ЦtФњжЧаыЎЄ@Н’3Ъ]аІЪ\ёГіnŠQ БVy‡LЊ…Екэ(rяBЌ_о!“ъЂЮušо ћЕBВ†юй`ЭЖз{БЧэ;`ЎкђОP_ѕ д;ЃоeѕPяŠz7ьЛРнXc\”жDВU_ХT8л’юВ6іьˆ6uаFz'$gДЉ‹6.hуŠ6nˆ.ђ=‹sЕ%VX‡|b/Б+ЌУы0gыŒgq‚/Б+ЌСHОТХоэДчЌYН|z\ь[гЃ\ЛjFЬўЎNРjуќ~ЅАіЦФфЏъz)‰ощjыЫ—Ž`4Oьњoъ zЛ“џЊЎ`”цђŽў=њ‚›8#юёoщŒˆ &Uo„WwЏОOуЏжМК^э№ъ№>Q№j x5№ъћ№Јa№F№j]СЋЫсе>Џ~ЯЏІ€Wѓ—ЌT•8‘†8‘њ8‘њ’-žkЉ=q"ІX•NХЇROrDyДS ’3žыЂ кеC;WДsƒж€Нƒweš€]ZqZmКUј+т2ƒ ЋjHёoђ ­ёR’ЮЄ'ё"}H_”~ <@bЩзЄљ†l"‰$“ьТO{ЩAВˆЦыr”\%ЫHіVRJ­ЩajOэI9uЄ Щк…vЅ„vЃН(Ѓ§щ ЊO‡а(jLу№В ё4Zв‘tЕЁK№ђЇпуе‚.У+€ЎЇhKz˜žЇALЩМi7цЫšбPцЯќiШ‚h_ж–гOY;жŽ`Xg:ue]iыСzвpж‡ѕЃQl@‡В!leQ,šЦБЁl(ЮтXgЩlMfcиT:šMgГшT6›- _ГEl1ЧVБ-tлЦŽгUь$ЛJwБ !aАЂx2"в;%’Эr‰Ћ„ЬrЗG"УуSйY!s…М.dБeB> O‰fеВфLH}!M…Дв.2rDWщ*ЄЇоBњ 7” йIШюQ ‰#x! !dЌ BІЦ$‡Gђ4!' љ‹„\!ф& Юw Й_Ш#ё #G№SBž2WШ|!o YŸЯЫ„|*фkYJ•Щ’ЎЦBZi+ЄЃ.‰Ш$!•B62@Ш6BvHLŽJB„ь%dџ$Й+xSFќkO6кЇ?3/…gўИ4љˆt†їAŒ яœ@F‘ d Э`™5@9;pNsР6EЄ„<&•DEuЉ)pŠ#uЅhSHлбЭНRsmnЇЭкМ)Д_Ю4ЯLЁyfsДЯ49Зг”sm{о][žІЭhѓsšЈT“kыЅ к<_“ыјjrНUтVЉСuЭГaSmоJ3a'эѓ m^­Щн5Жf|]“›щjЪЭbЕљmžЋЭЕѓšUb>CЄH:_X@Љ.•m€ОЙ*‘ј'М=яР;ЪіС,˜”ЯŠйˆhЫMхЖм:Jq;>Gc;РхԘ>ЁO№јcQњšО&ŒЊЉšpІУtˆФŒ˜бaцЬœш2kfMє˜KaЮЬ™0wцN yGЬl„БjbwщђВЉљ‚кбкd"uЇюd2ъ@ђащ2&вD2ƒ~FSЩL:ƒЮ ГV“9@ЄнЩw,•$лиh`Ѓ,Ѕ‘l<›@vБЩl2йУІВЉd/›Чц‘}l![HіOўBpьБшЮ—<– &ЯБObЩ–ѓ.МсCљ0>œЇ№‘|4ЫЧѓi|:ŸСgђЏљ,ўƒ| l['е™wЦI…№Тx&œЧђ8Ђь—Lєx*O%њ|>0†СЮ‰ар—`KљRœ,Оуgь(пkСфЛбc^Ь wг”AoXsж5,gЬ‚qжX'œuwœƒ.Zлт|•Ќ ѓCяЖЌ#ыЦZВЮ(7јѓЃАt–ŽYчВЙаFdNц(е‘’“ф,е•\Єz’Ћ`я”яЋ!bѕЖЌОŽаœxЙ…$Г^M ‡Z(>Јcђџ1Ё5‘dЖH%wЩ]ш…<Џ•d-йH5%[Љ–d'йK2+|?/Š4“,$K`d]IOв— $CЩH2–L$SЩL2—j „“ўKћ0 ш@АбжRkXnЕхkј:О‰oцЧјq~‚ŸфЇјi~†џЬЯђ^ЦёЧМœ?сќ)ЦŸѓт=Ўе|5F\Ызb-љFм;№<і!Я!Щш§§шЋбj#jїђ}|??РђCќ0ЯцGјQДЛУ‹љ]^ТKљ=~Ÿ?@?yє5| F_ЧзaєM|FпЬ7cєc<Ѓ—a ђшР%oдпй‡8ГлшGД§~gц?иЋ|ж9ЂŸ31ЅНi_њ)эGћаXz‰dи46Ÿ/сыљVйчаюД.x(JtшzК”ЪRЁKуйxљ{Ь`‡Т љ"О6 Ÿ 1пТЗ 0ZI^’/ЩdђbРT2L'3ШLАоYˆГЩђ-љŽЬ%ѓШ|Ф‡…`О‹Сu–’яС~—‘х$ƒќHV•dYиБ–Ќ#ыЩВ|љ'D’Э$‹l7оFЖ“ˆ+ЛШnВ zйO Ъ‹Ю&GРЃ‘уˆ9'Щ)ršœ!?“Г$ш<Й@.’Kф2Щ%W~зОFђIЙN n›фЙMюbp№RJю‘ћфyHЪШ#DЎrђ„TЇфМЬ ФБ*ьѕyMоjђ–ЈˆZvЬрЫЁЌ'ыХzƒ3їe§иЇЌ?xѓ@6ˆ scс,‚EЪь™Х€=Ч‚;cУY<СX"KbŸ_cљЌ€]g…Ќˆн`7й-v›нaХь.+aЅ`Ьїйі•qCіˆ=цF2{f`ЯЯиsі‚UВ*і,њ5{УЊй[І’Й4Ї2—цзсКргњм€їрЁМ'јю@>ˆ‡ёp>‚Ц'ѓЏј>•Ях‹љї< їК•oЧн n{ŽŸчјE~‰_цЙќ ПЪ‘ZHаkџžќ с™3x'xд\pъrlzЩуƒљ’/ќФužФ“H!Ќz)тпёяШmЁMw„/-ЖyWhV єr=)zOXш}О“я"„–IЭ%мЃq‡џНћg­ћOщ\сПEы~Ћwя4яїuяк'ып?40Cшрџ.–ѕ‡2j ЏcЬ`%ТYўnжB= ŸbЌ(мw’Œџ–gж3ы‹™ ФЬ†bf#1ГБ˜YўПЃyЄ=НLsщz•ўBѓш5šO шuZH‹ш z“оЂЗщZLявZJябћє}HЫ$.IМ’Wё—ќЭп№jў–ЋИњ_)“pј’Ьэ ]L Ss™Y€[ppGTЫUњ†]Bпњ=мƒќіВІЕЦ#ЪЈеˆŽЄЃ€˜Чгёˆ гщtbFgвЏ‰9Cч љWb мэ=LГЁЯ'шIR“žЅgI-]ьD v\)LА@0эА>Ќ№oœ™жnў‹;ƒцxЬаVѓ1x^0ЏОэ ќX5жЎh…u+Р=Љ7Ќ'гNдћpЧЎŠМ?lJЮбц"L§E>„ЖyXЁœ‡г–" "ЄA"zŸЗy ym'ђxиЉœ'вњАD3X3У“'‘пgo$lГ1ф`Њ„BН УЈ7d8ѕŒ №˜Ћ dx*ЃбДd mGлBЇŸ@ЦУ+0Ьв2‰‚€ u‚LІ] —€3К”v…ќŒJIќH+вt'§H‰%Id ™ˆШі ll "жDЇ­ˆFyЮа иСЌzЃШбM"Lљš)ђ0КEфсtГШ#h–Ш#щV‘Gбm"ІлEC—‰ГX.N!CœТтVˆSX-NaЅ8…UтжˆSX+Na8…ѕђо„syА‚)q'о$@М7d ЭВg]Sœ‘­ЖНDkНџ)V>Iё˜1] ЮJH™Psш>ЁжˆTш8šЫХяЂг ZIпР ш2cVƒй0{V—е|љпЩсЩGћуг—Yа{ѕП№ ї Jc0‹яѓх ПGc#jё$…‘wямэћ_яп ГoƒмJSlяЏLЗoЊkр1ЅУ”*ЊЧ2вэнPT—QъeЄ4аеi`Ъ™Q†ы6аЅMoЦЈ”бSйCщљA‰У Ч‰И$љеD’HтI4IE ”_JЇ“ЌZн‘–љЃK}Џ<гЅѓЦЮ=јbBFКѕ e:?†д0ƒУY1ѓі‡jЭП1+Д]лЊ‚LМV)Mо/•ъ`Q“fŠEђо’Ў%ыпкЫZi)?ш[їNINNPД OŠіВRZШХz–FС#“#ТFХХЧG{™a4”ZъіŠ эU[i/YZi mЃ“Sуbт"УSуМъ(kЫемвF[н+nf ‘—0TбЖЕвБІ‰вЧЫ[щЋџњз4ё’}М}š4oвМПВч‹энгЋІвZ3ПiŸшфИžqC<"y5PжзLфќЎBLЅшљnЎžбЩЃт"ЃSфIгЉѓ‡ЇBuOЇfх†,RВўЬжUgs› ЧOп4uф“э!7ВЭ ?А2Ъ!пЋ3>'+Її›№uС№ТІЫЬ],ѓtєš ‰‡цn6йћ<~о™Ё 7vhљbч•ACьйђз‡;ЎЊZЙdн)vы‹.ЁwLУЪZ9LиcRtrћЉ†Є ѓjФOВ\з^qЮ+ХЄoУœ1О>ѓ-[ь)ŠmМЁфЮ‘_{щ45цР—§њ&Ž<АСuъ 3цжЫ'?ш•m˜pLuМSсН ЧК]tSЖмыtE‰s­‚cлкЗ]b7$УqNёрЧUŒпAgПшjTtСЙЯКљ9™гFe>оkђЌИыЕŒ7Б™V-ЖMЭоЧ8хЄхЄ<ЅЏЎ>4VGGТр”ЎJ—wЯJ:Х6655ЩПqуФШ”ЄFЃpю)8їF‘‰#„юдЖЄT-щ+u‘1J”­хВ:’ПвOй4У7У{ŠRл=29ўŸz7жшЪ‡ЊвЖu#ДšZЛždЌ4|З ЎЏ4• ЭфЙ$X€.Vˆч4sU-eЭwњЭ-{ѕl EѓkшеА‰ЯЏЌ‚OšD: ѕ п‘`Џщc7Xp(}Нъа%'kFП„њѕW>ufЎeЉjRоо­1ёЫ*>=7dIЎs„uUP3ЇnI^+fњMнvяоBЂ:п{AˆЫЅѕn!i™ЛТ[?ѓ8WzњкрТ} О мёУŽkЗњЊn?>сХyуeOЊ\njoячVд 6ЌVІГR­›мo№$7Џў4[oƒСKFMћЕџG,уЗцЈєћаћўЩI+j&u§иЄr]tђGMrkwї…—cг&лЧŒ4сиюх‘Ўъ–mПWУЯМ^я”k#нто†ьQ Мlј*УоуQя>NсyŽХћ}†Ÿ,/\й,њћЙЦ;{:гdˆЮŒOTЃBnєœИb’т‡ЬiWшWнUОzьмЌKУs7Nд9vЕї§IA;BWzn iOWl˜еDЕМdа0х-‡п9ДрАъlиЋVЅzС'ѕHXэёtч sїGГЏыfLщОфѓNњ&ЪкgЬ— ЏКп/SZпjёVї{Гm6мщ™иљr“v$FеоЖРs_ЫвБGЄНВ)q§isљтžЛZyЮп=vƒ*7tc§д mЪš;ЎfSђщ>—и<2Б­љд‰УЕ&yF9щфп4Iуї&Щ”DщЃ1FOЅ‡в=У5УeŠѓcjJJУШpa~6Тќф!ў д=ќЇ,аїз(пђд1Iљ!ЁT1рцигщЪcoїдZpр[rє@NЮ‰чІyъW]ћD(k‘jŸћ]бя–[Ц}rА{Ю—Ѕk~ЙжmюPЫvoЮь^дšŸ]кc€ЮЬ/ж%>ГяnявшiмЌxчЊ}glц?2N=;њкУХSГSцМœžšVwуЪEŸ/мR5Лўg]Дяа:џЩEЏЋЃ3ІGЦН58?уЩШ}KЏНЊблuIИїС4–ѕљ”ƒ+ŽЮtіsБЩЈ§пЅ |ЕЇЄ‹ЕaнГХ—r}ule`–цrbuLљ‚ѓIKŸ›LИ~qмЪQŸХeп­НВ‰г–›э"\ћfƒ‡очyЖл~~ћ‡е‰Њ€щ?)г% И€з`FВЩЬ€€i5.VF–нhѕс‰I№IяlлШвЙmbвифИЁБЉ їШњ ЏцЭ›)КЦE&'І$ЦЄ*к&&'5ђrT:h[џsMbВ&V;)ыhЎЩіѕЁ‰‰ЉŠж#Sc“уRЧЪюЁy3Ѕ——RйLыМ•^о>^кЧџТŠ>ЪйьЄ’OCьн—/3Xљ`ХњYѕ†МTЭяВr—ъ‡ŠРq=V,]1;Ь{јХ6QcouКWўг‡пOq˜Н|rЬЖуУг"ъ^­PdFПЛЗриЁ†1K–ФК.ОряyШxG?зьvЅ†~ <зЛ7_WжёЫ6w&›э[п;|SњИУŽюrёіЈKК;xщЛX-__њmл’–‹"­ТњщD/Џн,tjекђyь„§хCН?й6}т!џВ^ѓB2пЎM‘Вйіьw'вwNX\Г}-єњЈМYcЈПцвЄ>}ЫwЖl3iД”_y0sт|UVЮWзк% 8Гџ‰ўJgх6нЏNoSŒЖќъ†жoЌSNZ­œДBЖK*MZЂœДpЂљ€ IхqЩЫъі˜`ЕЕы7ъŸLўПППєшИ№ ѓяžѕlЁm“GЛЉKошЯ†y/_fєs ЮЗгfŸі/qzњЄя\ЯэOE”WџrЖE‹ўы›іŠSЙŒ:}vC‘ЮИBЏY-—›' лЇВшfwИњBл;5њ+К=ˆј|ѓ†ZЇ4Ћз№`є3ъ™EЎЌъх№ЪщєUыgЁ›кzыНMЏљђюаx“•*BO(=ІЌVxLЋ=ПО]з+ЕйъŠ‰7љіЯЗžъћ8КуЩа^;Зsw ѕœЋOєgOиН№јЦfžХiХыFп•A. ЪОдtЦЭжыš ГVафVЎƒTМющTП„Ў&Л W|}љJЏ v9Нз$XјO;rљкK№ G6kС0ЃХн“кkфc?ЦИэ}GjџЗ\‚В)№‚ЏW3__/_РУХ{7}ч&­љgШ`ЉЌЁЁ†}УSbR1Й! zЁбQ#Ђо­Ь№VіGлєЦЄПйf]Ѕ“fvжDE №!Ѓ‘ю‚(~ыILdOЂ/<ЩбГŠYћoЈЛ?N;’ыRЏrд9'uŽGŸ3пяJпкdlCrlў•ШгЛVWоЯЮОКхы+є^›эL]ђ0§Фѓуы?>љ›žіћКПŽЂгГmrгcIЋ1С/,ќBоDіИљКхžЛЭЖмˆдЋлтГVОэŸЯlїТ-Хбљч6Е{ь ]ryхЫЕ‚>гёtОS№6Ÿ^Ѕиэ[Н"Ифѓ­Ея^SєќЧKЬT§МZїі›АЙ_iqйЇcыmЌђh\#ШoL`›/жЦOpŽ­YвщЛcc‚CлџиmђєЙK§ќС›)||хтЯЌYtіFУл ˜™o‡ш›+І:дv M< ну+гЉЮУѕїp8џџУНXшh И5ќ уœH‚Ђж6•l$Ћz/tt*ЙзOw+3‡Гѓ/ЯŸчѓќл"ѕДЅƒ;wьоме_aпЋYѕјжs^wјцIxhР]НG1хcЫfŸы=пЖcFкш]7\3UЇ,vžXqіФ™IЯЮlLOаЛ]kЯКЪ)G к,Њpн—Ж%ЛСꍘ:Ћ7OеОаrwVгХŽ:+-§VоЄ мыє‹rЭ™ ‡Э}gн­HЋБwp€qГŠЙйпM ‘њыќЯbŽŸПЖђцУк‰ъПЗф-эg3ŽиЇ%ШoаФj ,ЪЄ!ХWЂлМгрс–TŒŠЁRd Ъ>Kc3PoЩи6rMA\ƒšј*ЯŒCž`“шlу4‹u1‹>МяТъЉНзlцЪwŽm㋧АБшыъ5Y[omTЊц>qbЉїФ8%с—?П*Янњ%ЏlнћwKlŽ9cПzsББкВЄЦФЪ…I_ђ:І^ШЛ{|ўЅ%‚e‰Л КRNы\лxС%эщэАyЇўм)Sбs1`xz­ЖzЊрейХ/ќЙOvмYt-xfЮЉфS3ГfMŠѓё|Ё9::.>hqБювн-ЎМ=’ЂeЇ9nЭZV њТїMцпиMй§o5Э-КЙyŠN ˜БсKЦ’ыї8 гKц•їШЖfOѕ<оѕЬƒg…М“&WЮшуо"Мwѓ…wя+О[™јЮмйі0ЄIдФ8 "}}Da№юfіЪврГўяЄ§$йфЯY}~Ъ_%пJЈ2KуBƒЦy XK‘…%KЂќУl,xC:~.N ьиДY!uќraц€{~й™ Q§‚Ђќ”вф’b}PЅ`к7w§‘zЂЮŽі№ž(S›1дмђђrlцІaX‚­Ohqѓ§T‹й13DbCђ2я3xОљїхCОkѕW燹о2кі#ыяoEЉrЛЅU[ІжuХ|r>в<;ЕЖ# АІIфksёѕEћbN1œSЫп$ВДѓРі' Я,,;БаVњ@Cиж-jЗтŒ_S­Š›ukйя/ŸЅж„К­ѕИ3бB8‚гѓуgУvљ=,}бBЉЬ/Й/,фщšЙїцС8DUЗn я”ЙнfКєдпUэoVšлowЮ~Ќ№бuOнК—C7-єи“К/ифцЩlЩ,lyџ=vЯ~хе~{-WУзШЃ:OžжG{=5Њ|Їд:‰Gws@єБCЋ/}Ќ№ь›мљц•†M,'ХцQ&FFƒЦ­CІpD)рУи ŸˆР+T FCvfV№ТSP5 zNfCф‘s гdYQe„FC`О=УјѕnЯ~ћ:E3}ыmnЕ>Ї iс1L2HX`ж`ЌУr2ЕyT`pcШgШc(a(ВУRЂХ@q˜ƒ!ƒƒƒбBЕœ)ЛЄВ ?Н(Б ЃН-ЩвФШАlЁЧQ-cС€УыЃту5џGnћq§DзњјГ—Зќ+KcьVјЉ;}MŠE‰{В_V§зМзЮ?&oЋэ+1(ИiЯДћЦЁ[b g|ŸmTД§5UQъ1ЇcчэKіЇ=ќZиDіЖ=k-q[• ’ІД6'у˜‰ј;ЙЇ l%­з9іЄaOРѓў‡?‚ЯжџИєjbщвŒЫCOЇ p/оoyW“ёоЭџwтDј дЛь\кєoјuо•њїBъXїЮ_Э/|ўѕЁХž‡mїЊdсrэPgС%w‹§L˜M&\_ЕGуѓГ­Вїˆ}ЗЕ;)'бuу”Уў'sv}3wнКW#яCŒЙSф-Ѕ›=" ‡>nvпОА и(jbќˆ/6У&Ц7@Ё ФN“!M,ЉчўГиёL5"їЩ CюЙжћC~s\ю;О!XыwњD3яі;v3Я{с[,!›О‡Ѓzяо-17eЅчЎ|umтякџ5Т”олЈЅЇнI{=u§s•Пі20щзc endstream endobj 146 0 obj << /Type /Metadata /Subtype /XML /Length 1637 >> stream Calibri UnknownTrueUnknownUnknown endstream endobj 138 0 obj << /Font << /F8 13 0 R /F39 40 0 R /F11 14 0 R >> /XObject << /Im4 106 0 R >> /ProcSet [ /PDF /Text ] >> endobj 147 0 obj [525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] endobj 148 0 obj [441] endobj 149 0 obj [611.1] endobj 150 0 obj [758.1] endobj 151 0 obj [1200.4] endobj 152 0 obj [826.4 531.3 826.4] endobj 153 0 obj [826.4 295.1 826.4 531.3 826.4 531.3 826.4 826.4 826.4 826.4 826.4 826.4 826.4 1062.5 531.3 531.3 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 1062.5 1062.5 826.4 826.4 1062.5 1062.5 531.3 531.3 1062.5 1062.5 1062.5 826.4 1062.5 1062.5 649.3 649.3 1062.5 1062.5 1062.5 826.4 288.2 1062.5 708.3 708.3 944.5 944.5 0 0 590.3 590.3 708.3 531.3 767.4 767.4 826.4 826.4 649.3 849.5 694.7 562.6 821.7 560.8 758.3 631 904.2 585.5 720.1 807.4 730.7 1264.5 869.1 841.6 743.3 867.7 906.9 643.4 586.3 662.8 656.2 1054.6 756.4 705.8 763.6 708.3 708.3 708.3 708.3 708.3 649.3 649.3 472.2 472.2 472.2 472.2 531.3 531.3] endobj 154 0 obj [813 724.8 633.8 772.4 811.3 431.9 541.2 833 666.2 947.3 784.1 748.3 631.1 775.5 745.3 602.2 573.9 665 570.8 924.4 812.6 568.1 670.2 380.8 380.8 380.8 979.2 979.2 410.9 514 416.3 421.4 508.8 453.8 482.6 468.9 563.7 334 405.1 509.3 291.7 856.5 584.5 470.7 491.4 434.1 441.3 461.2 353.6 557.3 473.4 699.9 556.4] endobj 155 0 obj [514.4 817.8 769.1 817.8 766.7 306.7 408.9 408.9 511.1 766.7 306.7 357.8 306.7 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 306.7 306.7 306.7 766.7 511.1 511.1 766.7 743.3 703.9 715.6 755 678.3 652.8 773.6 743.3 385.6 525 768.9 627.2 896.7 743.3 766.7 678.3 766.7 729.4 562.2 715.6 743.3 743.3 998.9 743.3 743.3 613.3 306.7 514.4 306.7 511.1 306.7 306.7 511.1 460 460 511.1 460 306.7 460 511.1 306.7 306.7 460 255.6 817.8 562.2 511.1 511.1 460 421.7 408.9 332.2 536.7 460 664.4 463.9 485.6 408.9] endobj 156 0 obj [1027.8 402.8 472.2 402.8 680.6 680.6 680.6 680.6] endobj 157 0 obj [458.3 458.3 416.7 416.7 472.2 472.2 472.2 472.2 583.3 583.3 472.2 472.2 333.3 555.6 577.8 577.8 597.2 597.2 736.1 736.1 527.8 527.8 583.3 583.3 583.3 583.3 750 750 750 750 1044.4 1044.4 791.7 791.7 583.3 583.3 638.9 638.9 638.9 638.9 805.6 805.6 805.6 805.6 1277.8 1277.8 811.1 811.1 875 875 666.7 666.7 666.7 666.7 666.7 666.7 888.9 888.9 888.9 888.9 888.9 888.9 888.9 666.7 875 875 875 875 611.1 611.1 833.3 1111.1 472.2 555.6 1111.1 1511.1 1111.1 1511.1 1111.1 1511.1 1055.6 944.5 472.2 833.3 833.3 833.3 833.3 833.3 1444.5 1277.8] endobj 158 0 obj [777.8 277.8 777.8 500 777.8 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 500 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 1000 777.8 777.8 1000 1000 500 500 1000 1000 1000 777.8 1000 1000 611.1 611.1 1000 1000 1000 777.8 275 1000 666.7 666.7 888.9 888.9 0 0 555.6 555.6 666.7 500 722.2 722.2 777.8 777.8 611.1 798.5 656.8 526.5 771.4 527.8 718.7 594.9 844.5 544.5 677.8 762 689.7 1200.9 820.5 796.1 695.6 816.7 847.5 605.6 544.6 625.8 612.8 987.8 713.3 668.3 724.7 666.7 666.7 666.7 666.7 666.7 611.1 611.1 444.4 444.4 444.4 444.4 500 500 388.9 388.9 277.8] endobj 159 0 obj [892.9 339.3 892.9 585.3 892.9 585.3 892.9 892.9 892.9 892.9 892.9 892.9 892.9 1138.9 585.3 585.3 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 1138.9 1138.9 892.9 892.9 1138.9 1138.9 585.3 585.3 1138.9 1138.9 1138.9 892.9 1138.9 1138.9 708.3 708.3 1138.9 1138.9 1138.9 892.9 329.4 1138.9 769.8 769.8 1015.9 1015.9 0 0 646.8 646.8 769.8 585.3 831.4 831.4 892.9 892.9 708.3 917.6 753.4 620.2 889.5 616.1 818.4 688.5 978.7 646.5 782.2 871.7 791.7 1342.7 935.6 905.8 809.2 935.9 981 702.2 647.8 717.8 719.9 1135.1 818.9 764.4 823.1 769.8 769.8 769.8 769.8 769.8 708.3 708.3 523.8 523.8 523.8 523.8 585.3 585.3 462.3 462.3 339.3] endobj 160 0 obj [339.3 892.9 585.3 892.9 585.3 610.1 859.1 863.2 819.4 934.1 838.7 724.5 889.4 935.6 506.3 632 959.9 783.7 1089.4 904.9 868.9 727.3 899.7 860.6 701.5 674.8 778.2 674.6 1074.4 936.9 671.5 778.4 462.3 462.3 462.3 1138.9 1138.9 478.2 619.7 502.4 510.5 594.7 542 557.1 557.3 668.8 404.2 472.7 607.3 361.3 1013.7 706.2 563.9 588.9 523.6 530.4 539.2 431.6 675.4] endobj 161 0 obj [323.4 569.5 938.5 569.5 938.5 877 323.4 446.4 446.4 569.5 877 323.4 384.9 323.4 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 323.4 323.4 323.4 877] endobj 162 0 obj [277.8 277.8 777.8 500 777.8 500 530.9 750 758.5 714.7 827.9 738.2 643.1 786.3 831.3 439.6 554.5 849.3 680.6 970.1 803.5 762.8 642 790.6 759.3 613.2 584.4 682.8 583.3 944.4 828.5 580.6 682.6 388.9 388.9 388.9 1000 1000 416.7 528.6 429.2 432.8 520.5 465.6 489.6 477 576.2 344.5 411.8 520.6 298.4 878 600.2 484.7 503.1 446.4 451.2 468.8 361.1 572.5 484.7 715.9 571.5 490.3] endobj 163 0 obj [833.3 777.8 694.4 666.7 750 722.2 777.8 722.2 777.8 722.2 583.3 555.6 555.6 833.3 833.3 277.8 305.6 500 500 500 500 500 750 444.4 500 722.2 777.8 500 902.8 1013.9 777.8 277.8 277.8 500 833.3 500 833.3 777.8 277.8 388.9 388.9 500 777.8 277.8 333.3 277.8 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 277.8 777.8 472.2 472.2 777.8 750 708.3 722.2 763.9 680.6 652.8 784.7 750 361.1 513.9 777.8 625 916.7 750 777.8 680.6 777.8 736.1 555.6 722.2 750 750 1027.8 750 750 611.1 277.8 500 277.8 500 277.8 277.8 500 555.6 444.4 555.6 444.4 305.6 500 555.6 277.8 305.6 527.8 277.8 833.3 555.6 500 555.6 527.8 391.7 394.4 388.9 555.6 527.8 722.2 527.8 527.8 444.4 500] endobj 164 0 obj [638.9 638.9 958.3 958.3 319.4 351.4 575 575 575 575 575 869.4 511.1 597.2 830.6 894.4 575 1041.7 1169.4 894.4 319.4 350 602.8 958.3 575 958.3 894.4 319.4 447.2 447.2 575 894.4 319.4 383.3 319.4 575 575 575 575 575 575 575 575 575 575 575 319.4 319.4 350 894.4 543.1 543.1 894.4 869.4 818.1 830.6 881.9 755.6 723.6 904.2 900 436.1 594.4 901.4 691.7 1091.7 900 863.9 786.1 863.9 862.5 638.9 800 884.7 869.4 1188.9 869.4 869.4 702.8 319.4 602.8 319.4 575 319.4 319.4 559 638.9 511.1 638.9 527.1 351.4 575 638.9 319.4 351.4 606.9 319.4 958.3 638.9 575 638.9 606.9 473.6 453.6 447.2 638.9 606.9 830.6 606.9 606.9 511.1] endobj 165 0 obj [625 625 937.5 937.5 312.5 343.7 562.5 562.5 562.5 562.5 562.5 849.5 500 574.1 812.5 875 562.5 1018.5 1143.5 875 312.5 342.6 581 937.5 562.5 937.5 875 312.5 437.5 437.5 562.5 875 312.5 375 312.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 312.5 312.5 342.6 875 531.2 531.2 875 849.5 799.8 812.5 862.3 738.4 707.2 884.3 879.6 419 581 880.8 675.9 1067.1 879.6 844.9 768.5 844.9 839.1 625 782.4 864.6 849.5 1162 849.5 849.5 687.5 312.5 581 312.5 562.5 312.5 312.5 546.9 625 500 625 513.3 343.7 562.5 625 312.5 343.7 593.7 312.5 937.5 625 562.5 625 593.7 459.5 443.8 437.5 625 593.7 812.5 593.7 593.7 500] endobj 166 0 obj [799.4] endobj 167 0 obj [821.6] endobj 168 0 obj [513.9 856.5 513.9 856.5 799.4 285.5 399.7 399.7 513.9 799.4 285.5 342.6 285.5 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 285.5 285.5 285.5 799.4 485.3 485.3 799.4 770.7 727.9 742.3 785 699.4 670.8 806.5 770.7 371 528.1 799.2 642.3 942 770.7 799.4 699.4 799.4 756.5 571 742.3 770.7 770.7 1056.2 770.7 770.7 628.1 285.5 513.9 285.5 513.9 285.5 285.5 513.9 571 456.8 571 457.2 314 513.9 571 285.5 314 542.4 285.5 856.5 571 513.9 571 542.4 402 405.4 399.7 571 542.4 742.3 542.4 542.4 456.8] endobj 169 0 obj [892.9 840.9 854.6 906.6 776.5 743.7 929.9 924.4 446.3 610.8 925.8 710.8 1121.6 924.4 888.9 808 888.9 886.7 657.4 823.1 908.6 892.9 1221.6 892.9 892.9 723.1 328.7 617.6 328.7 591.7 328.7 328.7 575.2 657.4 525.9 657.4 543 361.6 591.7 657.4 328.7 361.6 624.5 328.7 986.1 657.4 591.7 657.4 624.5 488.1 466.8 460.2] endobj 170 0 obj [295.1 531.3 885.4 531.3 885.4 826.4 295.1 413.2 413.2 531.3 826.4 295.1 354.2 295.1 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 295.1 295.1 295.1 826.4 501.7 501.7 826.4 795.8 752.1 767.4 811.1 722.6 693.1 833.5 795.8 382.6 545.5 825.4 663.6 972.9 795.8 826.4 722.6 826.4 781.6 590.3 767.4 795.8 795.8 1091 795.8 795.8 649.3 295.1 531.3 295.1 531.3 295.1 295.1 531.3 590.3 472.2 590.3 472.2 324.7 531.3 590.3 295.1 324.7 560.8 295.1 885.4 590.3 531.3 590.3 560.8 414.1 419.1 413.2 590.3 560.8 767.4 560.8 560.8 472.2] endobj 171 0 obj [272 326.4 272 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 272 272 272 761.6 462.4 462.4 761.6 734 693.4 707.2 747.8 666.2 639 768.3 734 353.2 503 761.2 611.8 897.2 734 761.6 666.2 761.6 720.6 544 707.2 734 734 1006 734 734 598.4 272 489.6 272 489.6 272 272 489.6 544 435.2 544 435.2 299.2 489.6 544 272 299.2 516.8 272 816 544 489.6 544 516.8 380.8 386.2 380.8 544 516.8 707.2] endobj 172 0 obj [667.6 706.6 628.2 602.1 726.3 693.3 327.6 471.5 719.4 576 850 693.3 719.8 628.2 719.8 680.5 510.9 667.6 693.3 693.3 954.5 693.3 693.3 563.1 249.6 458.6 249.6 458.6 249.6 249.6 458.6 510.9 406.4 510.9 406.4 275.8 458.6 510.9 249.6 275.8 484.7 249.6 772.1 510.9 458.6 510.9 484.7 354.1 359.4 354.1 510.9 484.7 667.6 484.7 484.7] endobj 173 0 obj << /Length1 1977 /Length2 14950 /Length3 0 /Length 16153 /Filter /FlateDecode >> stream xкјpЄыж ЧцФю‰mлЖ'VЧЖ1Б31&ЖэLьdbлцLЬ/чь}оџЏњОъЊючZОжНж§T5йgE:!;# И­3=#7@DNX“‰РШШBЯШШ GFІjсl ќŽLшшdagЫ§/ G Ёѓ‡LдаљУPЮЮ эb `b0Бs3qp32˜ЙўchчШ 5tЕ0ШбЄэlNpd"vіŽfцЮyўѓ 4І0qqqаўщВ:Zкф Э6 ­*vЦ@gџ AЩkюьlЯЭРрццFohуDoчhЦOE pГp6(€ŽЎ@Р”ђ†6РПЉбУ‘TЭ-œўRЈи™:Л:k c ­г‡‹‹­ ๑ "% PАкўe,ћ—-ряц˜ш™ўюoя?Yиўщlhllgcohыaak0ЕАФeщнi†Ж&Z;й}јКZX}ќYК!@\H `јС№o~NЦŽіЮNєNжpdј#ЬG›ХlMDьll€ЖЮNpд'jс4ўшЛУп‡kekчfыѕdjakbњ {5[  ”шп6"Иdf@g###;'шК›3ќ‘@еУјЇ’щё/{;{€щ  …)№уЮЫЩаpvtњx§[ёПŽ‰ `baь 0šYиТ§§C 4§ œПЃ…;@›ёcќ˜Œ|ўћЄћ1a&vЖжџ˜џyФ "_d5…EhўІќ_ЅАА;Р‹Ž@ЧЬЦ`bbgp|<јќoœџvр?ьџ”*Zќ]нП"JйšкИў"ёбНџq§{2(џ^*РџfЗћ˜g €ђŸёзadc4ўјbњџМКќџ›§?ЂќПŽџџ­HмХкњO=х_џ?zC kП->цйХљc7фь>6ФіџšjџZha;k“џЋ“r6ќи![3ыџЖбТIмТhЂhсllўз§ч>‚[[иэœ,ўИptLŒŒџGїБsЦV—ŠгЧY§Љ~ЌдџІГ5Ж3љcї˜?Юнаббаюуш?Р‹щcIM€юЮ6€ожЮљУ№AЮ`jчїЧ‰Вs|ŒгЂП'€AєФ`ћ/тd0(ўƒ˜ ЪџE\Q џAQŒўAQŒџ‹ўрШ`ђ/Ш`ў~P`јЋНџ|$2§В~ S‹№к Ыаѕ_џалЙ8ў+йП €с_с?ˆX§ ~0Бўќ bѓќи=лС*vџ…ЌЖяƒЉ?JБџG§Сдўcќэўе‹?Ш§ЋRІвœўaђКџIШіaюєqwќу№ѓŸЮ}ьƒГЙ#№_ЭјЈзйЭю_l]ў?иКў ~0pћWЇ?Мџ•ŒљƒŽч?t>\=ŽХўŸ5vqtќИМџМB>Ії?јЯ7ш4†[^А3ц ВЌ ъxЈТsЃлŸр›%лзHЅЂѓZvќсђ„DU§§ыІуPвH/ЪкЎх­р бЋзikth[‚RћГї‹ў7хщ§vИЅ)ЬСЩ‚SЁњX|:UСяWoѕ+№Vа.iВN$Х<ДЗ~ їњВеё…}Ѕƒjvј—ВКhЕ(€т9В\ЃЬylb(g:ъOWюШsЗwГŸВ'п‰ЄПбРљœEГzim1Ч<Ю{ЎWЈ2;uутha€п~Ÿ&ї>J–ЦZє*)Šкф[Ьт^ ъŸ—QЧ!іUФv *ЅуЫ№—эB#эЮv3ЮpДV7ž”SеУx“•H˜&T‘Œ”шgт[ј=О’ЈФk‚šаќш!ь>ЛPыЂіŽХцfŠ>œА!МуCлщЬєey„b(7œ–…L2й Y‘WРœљЉ’ы#І<тнPрЅ=№žK_tOg nъ]фlЃГСняЮ‰Ѕ8ёlЄиp”pyўZиg>ЂнXƒ~‹8…ЂпЩЖ;хЬќЦ’аФqD+ХŒ%Œt^žЩ9,КЩ8nу„ЏІ1ЅєdЂyіz@iі5ГѓМL`Uщтгы9P9R2^w6‚>ЭоOъ'ОРї€=Ю‹,nЛcюf5\—б-m›4=†aУЦйЕПж˜FыжсјyЬ}gY^_r"єр 7YC.ГOŠ0=цлJўщ9˜н–ЎUгTС—КNЕЪФЏSеCС$/qР‹n‚цЄЧWH-?EЩЋoŽтМїbвyuЯщўгНЪЖWФЄ‘DеЂхЦтAc‘скbŸ:P@Ц`e$+ЗeљянчиŒgЂы[rE‚`С(ўЩjџŠžгчЧЫвU[ЎqІД'Каћ§œgŒRm”x0аŠѓФ>„CgKx–ЙuЯЂ кm­ЋfСƒ'etEa ўп{SЇ…—gЋЎaътѓ:BцVЕvЉMU[(п9!ˆ Рв ./ЉЁК ТхЅp•\‹ЙXС<лпУYяmЖœTЂ™'›FКCЫYаяМ—?е(Эіo—7( ˜S"[_ АW=X wсЧnщАUеkМ:Њaє%/у"ѕBЕ;hжТC;;ˆ)1/ЌQђзС€НюЇ0ЬV~ў.>`v1‹RТ]:ЃЧєцy)vv Щ­4Œ€fs= Cч9ј“ѓ[еKt"QLпDЮRV rя‚ЗЖrњv-?[€T4ZPYІcѓ-‚;Šy•ЙЧч]+ѕ1•с*ŽP)јUѓaCе„[єuЛг‘€ћ Ъ* '5ЉОKнЇй49яYШєo&в:_Ъ”‘Ъ%<ќ‘›YM(Q6хcwё[Мˆ1­u"КVУUœъpi —WB—||“ŽЗѕ==П;ъ}ї[Jр}ў/>СбšЯo9}ТMYFœўS­гšˆ irЅ5?Ђ*?-я|В€ГйJЄrМ,EШён[gњпЛ›ЭЫуgB[­7Ы^ИošIЋиm?Qт}UeеЁЬйЦбxCШoжT шuеЯ”ŸЩУlЏ1џt”iP­-,кЙA+K6gЃ†џНу­AшпAMZCdkчОЭ"@Йэ§­NкЉЇнѕœjЊЦƒУњ]—…Ѓeйњ;ў)Јў[”Y{(‘YЪІнЦтg25\єюѓ№Тві5ЪЙLѓэQыbv}Wm`^1-`Лa+э‡ЖіTXќ„ОŽ@Œ†ѓяp0Ok4B#ё2~ЅЭzoUvUе])z†XŒŽуАBЯьtМ]bсˆЧюBј2•№xФ•NЇрŠYРqдЄД€ @ЬСa91ш†“UoaztЙkZ4Л п№…‹aЗ Ѕ{ЪЋrЄ8уSЙжч}:ЧыхXъЫvаЏиY{јЫmKЙЮВ" f3pмЖFвАaOВm§БИ‰CŽ‡–lz§\рeђЪъѕвШ‡•@Œ­_qЖudgл“5h_“\†ќ’ W!ТАX["wyˆ5œ…uxr…J u_ђѓ! ыnёLБGм<<М%бsНNBд|1y­ЛЦ пфЎ S@:§Q/œV[—ЖѕЇ;њŸ'цљХ'"ћS"\у•BG,‘ГпPqСтŸЊ2й1ШВŒ§СI †|урS"Ц С`3спB) —U˜вMCНт№.ˆNzФиЧ'С nqД‰ОА"W…ёО;ЪƒёДxЏ–Ф4ЫУ2VбˆJlXспGЅЫ,Ч^ФBЎTЉ.Ћ‘sˆЃCъљнŽз]ŸыЗНIБшYOЈgVс,Т&эAŒvtaЃЙ„ЪћЖДx]iЪFЁЊeEік“&hJV9Сbб“ё="щнEf–ГЩПvЉ•$љ,ыHэу†9eŽ>bI›с!dvosЌŠ `у–ŽтЁ)3~сЂіа'ŸАEk*#0Ќ>§(ё‚ц2ЈтмТ@Žмщ_џ$J.ћuм[ў~Є"'ое№dKe?…‡ClмŠ|WAXирТйЊРVЌwЙб_'LRq№'БxкЩЙ&JMЈїšЧфЅ‹яОЊyЙU—+Ћ:єlA(Цё'Ж‰LЮы’DП^Даgдљ//zKпшЮх—)}R |рчшгА(Ч0,˜ Туu ,Р/ЧѕџЎЮZИИhМ”GљЩяЮГ4Wьін˜!GђhВœ†0fœLицИ‰Žc 3K%љђ5„њz@,qШЮЇ+lО}’с5І§DЛAeсХЎЅЏYсзLiЎxxb?_ЪѕчUSi\VЖЩ~$9 #бДнCЂГ‹vУЌвЯёg1ЕЁЯјиc:DqNhnbяП*Њ—ЯилЪ5ЃсCа”8aЯыyШм­Щ№Šсn*Q.|…ЭwјЖФђ6‰™uZuiїќfk”%Hжт‡д_8^–ЃW– рkэUШZ,МЧ"НAДaю1xё8фјПЯp`9Lй6т~Biš.scfн@Y ю6a0КѕеІЊ~„6c-Юe9z]— aА—ь%CN"XцЉьpN8@MсТЖ?:A8Aьѕq“KЧ@eё‚-œЌ№ЯgЄ7*MйЕќЌЕ#ШYp€јѕюЭгcСzŽъ§•ИАzu+“‹6ЙиНЎfc7“vГЬ\b –тCхŸЙ{ш™АХУ‹Z{yЛ$ўH›cз{5ˆRšЕw$!‹ь1ЊКТё‹Wlѕrч­л!\УWЄ!ябц ЮoОCр.Н йТ#џ{Я&ZWls3щоЕоX?э—яєтЯk‰ щйd ‰}Xmш–Дф ˜jф*eŒШ'ixQхЉ*•?Э:uv[zŸ#вNзЇ!hЬ9щCб?7|{gѕЄЙЩMН4_ШхЙ;%”шяЌЩї/а"jˆЧЮ-­ПœA:ˆЕђ#ƒu)Ы–С~}ѓ—Y$ѕ^еЈL‹œНaP”Џ‡в›JbЁf”Йн 8ю]lІђ™Џ’>–3#ž!e{тМжя4+qbiф •ЩЬFžЯ€™hŸ˜ЄЪ9H cн@xBZc"эЕk+OnmЦТ"в4ЮTМ_ђ ofфУўњКЇW8РњŠ1ТN0›HeI PДbˆш7DдГѓxжЫ)Ÿ!чBлL П…9*'Ыытхuл)сГHœ_}ГЌPєЦЗКУєcЭ; qђЁж|э[’)В,NћmlЏыч›ЦЩл-Из“Ъв”oйКЯœњ•, ”‹C~тŠдг7NЏЗ'ŒпFЖOV~—ыо#ќДО'ф `ИH5IЄіB%J/№sdЋ#Гк”UљŽЙь2fZГЕuЦ„Y_йFkм…Ъa{Ы №„v‡t УbОЋrЖ™qЈˆБ…*::яEХ 3{ж“@ЖвЛЇЄЫ;gз?n:щЛ`šСч№§G3Кty…шg­еЮyQМ‘уžћЪ}оІћn u~ОDкx‡{„F…А+АŠrdoXМ A|6ьЄKžRНКЃћнъїyЏJƒьЅЧй†ў›хУXЊђbях.рзxы<Œ#CsyV†tЯšСю†L>-F\Џ:›Š$"‰L62–69ТbіСёBф/о “V"ˆОКЭAЁeŠc|NA%•S—QдЫФIMЯЗ,›уeїХ›p ™Яб•N.‘Sё&‘ѕЫ|Žи"ЕšП­;“Це§4L<жWйЄ‘уъЇЌжNOЇрUккЭUжeZїЂЉZ0 § §ŸЪpУ“­[ŒЖЎ№jоМ@OЙЅМ Ш*іoѓsu yЉпЊОl˜ƒѓs•оO§ Ќ9ў4§ШПˆсЖe‹DДТƒмš8z’M0‹щ…џцr’С RЧ‰BеЋZјvРЄћгzIЊВJыЄЬшOюS+жќпшk*0Щ>Ы<,МЩЋ'ЃМ')5=А‰ШX;ћ”†wSb6AЁHиМƒk#єP]ќЛNju…XBЙJч•Z•+3}}нЦЦрˆЊ:‰QЭљЯњ# яx˜\S§xG]1‰oЋ›†ЋпcЬтŠm`чuхlѓпS`\)kDыnVdЪQ§Ž#Mv.—•+yV%2 ЅћдU‘Зп<єŽV+п›Эђm|Зв ъĘЃŽЖЇТМ#!ЇМі„ЄS”” lM(7WП{Є§jОГ§i Z&- Бі[2дSйpэfh–@ёЅю51eё$|д}№Лˆ`ћ[T‚œ§Џvl4уЄ@Щ+pˆLKѕф&–&ИTY;ЯъСl`В8њ#p+б2И‹ИЬIЏжhсЊІssy–zїХчэЬёўlљкЛŠ›ЛER>NXЁGЭidMвшЪPЂZTЉњœ””еYЖЃЅZкДЎCъB^ [dсЛCЃ!НL*э`%ППHМœu E–iHЛYОмТaн[W(•=|vџЩфЄ_ZCЉУ<КЋЕзЉE?Л'!pПОƒpФЭŒjpijт–РW&ЌвB$"VўТqUЌёжО62{В0Xs~™ЖЫH#8Q?ЏК.Џ:$pƒUАz`и.]ююслЪ‰3ьbп˜чи&РvYƒѓNЊMхє*oТ›IS=ЕuЌV.7GЩ9…H˜f$жЅt*љi Х™О甧їl!ЗO }| a(›z?з}зo2[Сb1Ю й‘AЧиn2\…{œB4рžOPцNhŸ9ћSsб^ж1B%’™,ЄТrjyYŽŒb\N'.tЫ3‘]яPв4\вШJа”КХъ TIЏМГњт~‹:чg/•|?чђeшfЗй’nTƒтYџ"=&E7WsКfР蘳гб“Я6дЇ`?vјЯhhНЄќ#­Vz№N`7ЬP„ЄƒJ^ЩL”PБбz]0—:{(3х(ЁKС ђoOJ‚й§ѓŸ—Ъlл'SUf+ЌЎуG’Ь?r›к•E7х~+o}‚йУsHZР”@d-іЌПУG˜Šm›Qћ7џјlХlNтВi†Tb[9v… П—ы(s.y^!žЯqЂВŠњ:K5†1~ю=‹‰9РЇvеў/žŒ>‡ю`ѓХЅЊЯ‡vд”іХЄ=ЖМvЇŽеwjtr1њтkdeЅЪYMИД'З‰zrZOwp§Є!‹ў“”QдulQЬАтьЛоЉ|TЁЎлТШьЂљxйЌаЙџћыг :1ТЇ#ЉњѕЈ…еЋЄ&БД=љž} /эјБœ—G їшаŒи–ТдЩ”јuдХ1П­}ВЛЯбЋвŽvщ ђ0A=q;\i[Ш:}}Ббfжяo _ЏУeЯт-з !Ювi.N-EЫPw‰?ь]ZjзU™сЛюУЛ |мхmе*їo€#РлhЦ)—PeЬИEЉˆ”ДM\пG-ЊёК{…ш_™xъšV}0.Лн qТ„V= §Іs гкЃJk5l § ?VKG{` dKSPюќВНNќLz7KГ‹3ёЋ@)hпoˆ9 zІЈЫƒф4X6ЌдRЌЋ§Ищ§хЛпяxШ‡Лt^ч”(7ХаГШp ‚tЛтЭ|ж.Б.d‘ubНп‚рЏ\оеОЦОф*ѕИХ)цb‰їn'н“и†еЛ)Qёа=fn§3Gи>\ў*!ѕ†г,DЂНПaƒgЋmdRŒе_R5阚ƒi-­r/(Џѕы|іѓУX’ЉК~“Ыcp‘Е]nыЎшW{IjъзLDЧˆH”sПУ}‹i‘цЄ|KЋŽ‡єъх$Ž9 •ѓЈпбE]—uдЂЧЯ_ЩWAчІЭеi\52‡2)щЃЖџrДљNвЮ(œ’Љ‚iДЏбЩ™‘;5c!†§нnэDƒNёb\\фRхY>*цБёрJlY"ф`KaУxŸ>ШЈ˜LюбŸ8GZтСБ@yQžŠ}’yŸШЂж%‹EН‚Шhеz|СюЋюЊkьх]~џX˜АќnЭL—Ne}ЂбzвоŒ1$3mи4я5jб_4UЅИ8tɘ|ЃЗ KІпLŠБп:›яЦше§|њЭs*gˆ[‹ј;Ž‹uє§<Оd n‡НоУ}К!зйИkD вЉПйC}ЩЬ`…-ЈТоЕm_‰ЩчN‹ьиІ*ЫЇМdˆГ—ы]Шe­#Ћ7TОfCЂEяНyV–˜SпCХEbјwэСёЩяusœХ9м‡ŒG КЂЬ4хІБАsU$#зЃ]ŽiŠˆ|л‚їAƒRw:EHэЄ†eЦcDžRM”l ›чeЫма‚(F6Ы_hБ№88 ggMъ} LLeэЎЊ6žЁЄЌЬЛЩХЂЅм <"Џ ѕпм$j^Q”l™И_rш…7ZŸX‘­ѓ4ІЇHП’Љ^=ЩчФЭpЕSж((6œ$qoёˆ}цК9œЖ2ЩНC-аAКИs§ўŠbУбsщС#Н<п'Ё? ЊЕ+‡@Ÿ~Щып@‡аA:сŒВџЙ0”ф3эsGyЕ‚uсй-д#JFИ?йI(ћЉѓИVо.Р•Й,аЌB ы*њ4ы‘Жj˜ЁV}KщзZ]^jPдnGЖŒлщэ)Ў „%Q˜{т‰wG&шm се”lžѕЙвu#Ж{†цЫ+БХЏЅёK2ЩьIі.Э! bh\СуЛgЂLфа]t№$џЋпзУЋzрU?|yh.^•kЕPJWxrš7це†sМю44СЏ ”]MЪ §їЂ8^† ѓкПN$ї)Л5<•+*d ‹ЄбЛ9ЊWЕИx‡zDaXml’N:’cЛ ЦЩ—ВXfТр G001MyQ-Ы@ыЬžNђс?ўd•ЉwHc}ИP“ŸэШЇКG"…y|ƒ] ›e›\ЪЊфs>6нј~бЁЂњ1t~Зd..šА)ЁПCк;…<Же‡жEШhвMыу=№Ь%daDNіkdХн{+њ}в5Й§sXJЏЫtFќw›тOгŒгРyзЫё_Ћеv[LKhО#њF~lcЮwœ#=лЫС РGы…]г”[ОІ-\ѕЩИ›alXvLЊGЗИ‘‘pbЬ|ыDРW)(t8Nъ…ƒ4‡ЌўyŒ;ЄR-чQЖ•W{юLЬ н‰ŒМъ›ё №gE]“УƒтŒЕ—<ђЩsцX.ВYGг]ш ћвЪ dЬ_ЦЯ]%љ=5‹-+њ+ІЮюіX žпИѓЩ№Œјсї]x‰”hІБвBCвGsЋтэЫ0‹ЅџZg˜џV0_Aеœxo9‚ї#в†дяs.ызќ ‚ЇFЫ7ŒеИтžGhу ЪЄ UМщ3реэЃŒѕ8ОNx†ycc•€Ÿю/КидŸќ=ЯЭ3кS-ЋјЯМ+9F<#ЄжИЄ9эсgішJŽюdВ)jzBС6XМЦ\жАyрZ;N4нpіBоЅ3сеЮ |тиыqиp ;ц$№s‡ИXEL;L2i„vSUDС7Ш’іuL8ђщј™ Aˆ wxŒ_ ол ЌЮ БщОUЈYП!z\иРј^™s/€I*XWœbцNF/ђЭ{іWЙ‹жkБu`Ё^у—м2RЕЄ›итЪ—ШR”"ИM b‡љˆQmћ…’E•ЇЇƒє5<Ю$ы[ш}лAќyЧЊ Е;?ИŸЂ„mY|r0c#6˜ыЎ|qmа8~{8ЛоWг 1h 9D{№УЅ Д˜›‰sЅљŒ};šЕdŽ,1ЙgіЂl;WlюѕZ}G‡њВq&Ў&Ц-”њdА6бъ#ИЈX6V ў3T<ф7wdђ–r<œjQFЁУИvЃЫъAми}2†Y5ЦЖєКђJѓЬП2~івќ†††nчР †9еЋa€ HЌ‚ЏuУРbБЖІzЪbxыГкђВУTi…24™Z€oѓєWЯП$ЭХjЦ7”'Е№GЄ5d=іXZp…KBu_jж­ієƒЕ5ь`kм3­Фqъи(„ь_CJнWOзd',w3Y*ЩШЂ ŽлЗ™a4 ЭнјЙ П<ъ„ ?_чYOЇ)loфŒЕЕЖп3`; ]Ш~;ƒ!d– ёћШeќRкVZ"|TдяXgсUVы еугцup~|ˆЂ"й'1іjЩУпхS‹Ѕ_kДdБœ0ъ@bк G5‡.$M}эЬj<‚ž‹‘нў‘Ђ‚цY `ЏУŽёЭА В”зпючф%T4жо)ЦwpоЅШєюq.EFЈs—œZ‹PЛˆpSYЦ›oLЖF[е_!е'сљ”ИЧsэ–ŸЮ[m“—Fіd,Ѕ wkСи„г~Ї]ч!ђБЎЇuOežЁ[ЬЭ РяК'1œt­9=ЗeфуџщqѕžАpY7)y‰ŸгbФъзRх№жеva@ЃŽ‘jyУ}NiD/чеаХTБю*т;ЈЎыs"БN qИЋдJ@І ЕѕЙXIєў„="ИЎBŸ3ЭЩj.”CJš_Иљgы[еЛ{4ЧзХl|jЏ$:DŠ8гŽŽ1ј­ђpkiкЁК<)hLCД“7ЛW8QfŸ 5зwy1Б‡Љ~+<мн ‡Ў_JS|’Ёш‰ЗТŸ•/ІлŸ7brА8Б2)-XП’аXvBОм"1мО№SуxК€_4О’JD :…’ъ&њтL Iы=Л›Д$Бš#Cг™н'ЧЯф%ѓ6юS(ІљЉ3ЅЊ‰є/reбЂХ_­zЬфe”ѕhОЇœБMцsќŠё<`x0љbз‹.€ лПХkр…SSЮжi;VшЌГ/jИmƒ {ŸwHўж!…хГ#цB(щЦ<жKк)ї%#Rn@<)AйQIёРоy]-”'љ‹ц‚Ы5mL $DIЪWАНЂ—ЉЖŸшžЧ–Ošе/ІКiя@~#ыщ‹ЎTN/ИkеNtаЈоcHy0|сДр[Х6‚2$УІ2&л‡WВЅ#С‹Ua{<ЈфNLY‡њяvVJGавЪ)2,=сYEе|вёЙИŽЊю*iЧ„шпmё^2н?Н6k'NВ#”xо‹ уŸ7Sэ еьNСАЉ6”ы$HЁЏ}(—KІ&‡ЋќЋ ‘Ђ’]ГWеИАщ+Ž~Ы2ЂтBйјД|ŽZ*Мэш]Yкј4‰п ŒЩЗдЈN-J\}Вm5аV гpCsВжэ2џџёjF„}/ьдъzмgЪі-УZг‰ј”яR-\Ё…mЧxЇџРX$e ЕЎ]H`Ў€ЂЕOг№:GŸЉњ4ŸЃЉkж]о$]”+љmŽSЦ3 эX†lК“Nё‘2ЇэZсЈO0@^G_їрg§UаfжŽзŠъVбˆkљ~qZE#rИ45QќѓLлjй'О4м№й“˜І›яQ>_Уч™Ћ†kРьѕ› DN?iјфЩСЌN}cп!ф—› VXфЎ'SaЇЯAjV,ѕцšыФ ZшerЉЛЪvCgЂ]вЭ“ЗЂпBО?‚I?ž~юкE,љ|Тљ2ˆ>ПХ(>vоЭЧуЗѓ§ ;%ЕZTpьrƒ5"\$ьї6’—Yo”e"YьчжБп§лlВ‰.ЮЧ3ZeЂšR;lїQ3ъbЯŽь.ЃЫ—іŒ kЊ.Яl/ќKКдмRёЄuюЯы$ЇЅ93Ъй^:lЏ4ћ09ЗэEYл 'ОЄХ4жEт~)с“ЃбG{иCГ(HЮzŠЈс‹ч^чxоЧl‹zTR‘Г˜jљj№Йgе:&ЃдњYЇp іЫ_пSШr]Ыъ4ђЗByPЂqЈїЁу,РЁШ­bUЖ™  Rу­H,HdъМлчwƒІр;šкму0ГHѕЪЙ`№ E!ж†Ј•6МM чg%<щŸQ\О5|яУлD$}љaќk`/чхˆ"šŸбƒЮpZAjъ„ѓчС>(\,QќЏњyЦ3/„Й$вЋBд„чЇ)ъ™тПYеъ*ЎvъW,{б€гЅKэ] љиЉ1BЙђ‘у{!ВЯб№}Ќ ‹‰СX/vQnьLdKїw˜ж-™™Q™&K,XmfJях<+Kч„N'_UwQžo"кfˆpЄшOŒё92&‘nЦиEМхЭЙ‹„lHмЊUЮЯЃМqЅЎагISІмa_#z!‡1…87WiЏдЎЯ†ŸBЋ/!žlњ@иОШщ™Яб—ОХчrBжdУ5wцОр^wу˜›ѕKyЧ-Вг­HOЫkgiмДјтвKЦd”н"оŒД Aлы/{6dуЭ2ЌмЯЪы;њѓшYгЙNщ~Ъ7выmDќОў5ю*ў}|uеy›еЭSИ?7ћ}РВУ;AЖnng№“JBЊœ?о<`ЊяТ4$™$Щfd’н˜Dd2q•3ЊиŠb%Щ>Ёf7ЂaмŠtѕЧѓм(pdyqsЙ"ЙŒ?<ЖџB“/Ђ ƒЃн7пР_WFCТм‹гР‰кЯЏzбє#в‡—њQ чк’ “Ц!ож&FšюЮQ‹АPж—#*З‰фпх§ёщnPъорJО{žы@Іš­РаАбњKЌ3Gя‰2”4У№ \@РHЕoWd_еDчЫ#Из*eПS1аЫ'шб@Кђ(“БЭЁшъ9зэы џ`Д™_‘šЭ“ I›QYпЗŸЭЦїВГАl“вAиМxєHПŸм1шдкxœТЕФz’IфЇЋ@ˆ†i,„Ђo{f–щBс,Uіиr†&ТdPЌA†і}е›6ЯќБbo|Г`я”ѓ"F1i\*$№Љхя‰USВЭзвxƒE x БяЁ1ђ( ŸЭі7x=kП]ŽE Fєн—WT]ЖMЯ:7:Ёg>­gE“ѕ‡‹ќ І,ђ|&AјDc )кXіxЯњњоб+|кaА`D/}a…ќf'q%Фžо#ЗџnmHR/О4b"ЬБГЙOcюt.6њ˜њiuЃRQ­X`Wє7p_вxЩ‹зѕђŠ˜ЏЕЂЈiч~№ўйuќE;‡›лSжїИ€ц•PкAщtОўЋNZoŠh!mdMqу–fэзК n —ˆЧ Н|ЅAфF,wйћќq#%Ъžќ@АИ›xavуЙ“ђћЂчzБђG5K™&ЦХ mF7žтažC{хК'Eп;i–бСя;ql­6ЕУзƒЦBЃцwШќ ц’АoиGаЄ^ПЃСG.Њ'8LГ&~и š‚“Z\ћr ХШ0ШРМ30/6"K™zЮЕяђфWѕbo!б А›Љњ,ф:№cЗЎd‘І *у?БKг2ЛЧk6пFofПFй)†6АжІУіRVп@HЌжC 0S5t|qЁDЬŒm8Ы‚ћnЋRЩ8Ыš7ъ1Жњ2`e12FdMaА—Жbmq9пbдЖrЫP з oЏYю љC>ЇWSЄБ0ьДЁД№QIBЁ#]є5vњ yЖжŒC/фvgS6]9mэ—`O>>):їЛ‹‹'‚ ЉФs]Ѕ„ЊАКtzЩ"ЩЃщичфmЭШ—#ёwYcгўмSЎ]ус’Г‘K™hПCнФiАЄd}†p2оJ/rŠ[ЇЬ Иe5д'Ѕ„"МЮ0м#дZe…Y†L “B!›й:Є{•<ЦСQ-хнЖKzQ7™(ЉнЉ)ё„‰~bˆr’˜(УЙгИыMB€Т*e ЈЖК„'ƒrSќOђЌ1wјHУє@™ўлЂљ§ЏH№ВяеgmђМ˜ Ти.f= Ж­Гp5Р Kљ5ч”Џіиu§њ(иЧчdEcыжcШ‡$z§Eи]дрьЊ›-WЂZSШЂ@N"ѕтЯпXОУэиљрМ Їnќ…– СЃы/‚рЦk“ГЫ5?ь^дYз{+чш˜\~Ч’Og<ШXМђўBчІсР@ѓ­qcЭ}‡ja;ЏІ†р§eнїЉƒљ aƒ[>1“‘ЊЄ"QŸ+эy ї~–oїЉNчихX”cWU:йB/ъ‹D5ƒй‡sЈа"хRNиUЊJ  +„аˆЎ ПкDЪICŠvGwTетZтЕ|=ўоk‘5Ы$kšьЭЈiŠь’Š0BHРPBеLКІС›ЛushуЪ OйOќnZPіЅzђыС7ŽNЌ­К%”ЉW7uv%.љP я Q]2ёН‹TcŽGЁ зЪ Цfˆmg†Р_т€Уy кL‰иK щЊаОEžЛ: IqШя тУ9ЅєщJыy‘О JN ‘ѓО†[&ѓ‰.ятУ4њзœЭRR3œЇІŠ;йGюњžBН‚qшŒtа~ЄˆєаOъ=M€єUєIGн­оЗl2й–шЉЈ(Оў0ТEўЖoЛ-ыA­< ?n§вѓcч?Щt+ЙU“ Т‡С‹АxЄСUЬKg&xь$в>і"Vbі&yM,я“2и6+9sZЎЯB6№iю…щЗƒkzРшЌрдЁБ@#LфЧфУУ69’ЧоТЄf›ЁЛ%œљГ`žЂM-~(Ъž С@МbИ>—ДP@rŠ8Эћmф=Ј^cЃуbYћн‡нЃšє>Zёц<1x+2‰-:6yяPo5ёйXfлс„эOяQбzBFHэfшРџ>@“0я№жbЫС$ёвRьцm“U•шр 6aЛЄОЊнy~Ї) Щжi5ќZ6bbЈАX˜ЯєуЫ[H™Ž<Vt{]EвНѓн-4)тUћОŠ~Џ‚ћ3mЩ;Žгš9ёИ5БОЫeМЧіШ№gr$› †2БТЎ“œvішЖ*|WзВГq о9ѕSrSцRvC~Mx `)КxЈSОPœ“fу: >tЄюoШ\Я5хл&1b˜лЩ‡о5ZЏѓмчА…™ˆЄ$8ѓ§DВЩпХeёk7#_AУpЯg”ІЭи)ДшУ€БЂа“жыЃёˆ›iћ6X]Д~юЖw‹gЗym{F—Ъo˜[ЗІэMMZпС™/'яjIw№ѓІ“Ї•5ЙL=} ]ИŽF5DМ>е V<МЁFA§N‰э͘ЌфАšЦдШЂ:NЊYNыо€ЌИYqёЗl‹[ЅИ ‰qNŽEryа€Є№кЎ[ o›ѓюл€~тeZљvBКЛ4Ж2№ј%Ќ’№›d‚Д‡’Ќ;jaЬc_­RУ‰Тv)dJХ4рUђЩЌw“SAœwўСŒ0ч вћЦ†`(Й#Ие3~КL&CmќШЩш1X:є>X™ВМKХе“ХІp.„Раг”"ˆс7"бЪї9а;9АzС•ЌfжПцTV‘…YфЦ€џщe‚@‚Ф663изЧП ТqXB#?lЬт"Ÿ­FLлэо ztд!ќГsS’_ь%™l ЁDD№Н‚Vѕ3—пЅ№ѕ -в‹ Н7ЄUвјљ _A_ІЊ!ЁЄlЖ Щ—jZoЕHП$6вфк> Ž*Р\AŸБтM …<Ќ,%Ш\hK† г?Wж­v $žИhс† ЇР7g] Чb%2eђ­‹6ЊЙЦQuWšH•Ђй+GбЄ Ѓž§XТцdЕЮйМ†ДylЦ4…Ђ>>ЙТ] Й_IК“\ŒишгbВћN9oЪќ лф ЙёvEwŸЛ–Lz –ЌdЄд(фЕ6ў+БјJ§ŠЮуœV›Э вЯ—<=њ5T}Прљ§f|ЖngвH)•|<™UV'ѕ?Qˆ=wFw™‰#%b6ђћ ЁЏ%БndбіPјтqжЕC›яа…щё5AЅЎ#сЂ’jУŠЫРТmТ]KёЬфТlє`0IЖ"ЋmЩќ}0йџХмМв(ќŒ5Г+Уб:ѓ†ЪGACюYМ—™!u2‰ЊРs’ыOЕтОyoб>H†„pмAГзѓsON{ИA‹‰цкг> endobj 175 0 obj << /Length1 2099 /Length2 14237 /Length3 0 /Length 15491 /Filter /FlateDecode >> stream xкѕPкв уnССнрю јƒЛЛCp $xарююС-ИЛ;sЎфмяџЋо+Њ†Y-ЋїънН‡’TYQФФЮ$igыЬШЪФТSеbeААА3БАА!PRЊ[8[ƒўcG д9:Yийђ§#BЬt~З‰пьlВ.жVv++7 €……ї?vŽ|q Ћ… @ kg rB ГГїpД03w~ЏѓŸЏcZ+//7УпщЃ…1а t6йМW4ZдьŒ-@ЮџCAУoюьlЯЧЬьццЦДqbВs4ЄeИY8›TAN GW р/ЩE  шпв˜(ъцNџrЈй™:ЛA€wƒЕ…1Шжщ=ХХжфxЏP“‘(йƒlџ,џЏРП›`eb§/нПГџ"ВА§;hllgcДѕАА5˜ZXƒJ’ђLЮюЮ  ­Щ_@k'Лї| +аТhє№їбI№]сПѕ9;Zи;;19YXџЅ‘љ/šї6Kиšˆййи€lў:ŸИ…#ШјНяЬџО\+[;7[Џџ S [гПd˜Ии3ВЕppЩˆџ;цн„№ЧfrpВААpsё@ЛБ9ѓ_д=ьA;Yџ2Пk№ёВЗГ˜ОЫљX˜‚оџ!x9]AgGз?џ‹XY&ЦЮ#™…-Тіw3Шє_ј§ў-м:,яуЧ `љыяПпєо'ЬФЮжкуOјпWЬ,-'!іљ3§П%џз)*jч№bфd0ВqВXYйyмœ,ŸџхљoўЃўoЋ2атпЇcљУ(ckjр§—ˆїю§GˆыП'ƒцпkC јп Švяѓ аќ]NуїжџЯK№wЪџПйџ‹хџuќџя‰$]Ќ­џігќ+рџЧДБАіјwФћ<Л8Пя†‚нћ†иўпPMаПZдЮкфџњdœя"bkf§п6Z8IZИƒL”-œЭџ5DџЙ…wrk [В“Х_€‘•…хџјоwЮиъ§QqzПЋП] ї•њп’ЖЦv&э'шшє@`y06NN€ыћ’š€мџžm3“­ѓ{ р]œРдЮсЏхт0‹§eњт0‹џAМf‰џ"nvГЬєžЇ№_ФУ`VўƒиЬЊа{žкФ`Vџ/т}gўAяеў їъЦџEѕ†йфР њ/|—ЮќЏkљ№~г?№НЌЉЉХќ—ї|_™wшњТПќv.Žџр{1ћ|'4џ/фр|GіцяoшŸˆwл? ВМKЕњ|зj§ј.жцd}ћ‡Šѓ=еі}ўсWoїЇњ{ВнџИпOoџЧ§оћїMГћGћўъЧ?ФБОŸещOНПШѕb8пУоŸЉ? яœš§ОжЬЮцŽ єя]€Г›н?о5ИќОЫw§|WріЫyЯўG1ЖwzРwužдН3y‚џUъVУиХбё§gуяЧы}oўƒџўмAЦ‹svЦƒ-Ћƒ[я+EмwЦ~QюhІа2z-:ЖЙ<ЂР&бV|ќэx+’4дЖВ%As#МDђтuдT ћЅ9AЅхЩћй ^ujЇaaЛтЧ‘HMЧбьљ^кыl1ГžЋЅъlNxxкИD7шЃST^ЂћЩВ8ѓ^EБВЁ‘ІDњs ‚mЈ@Ž*вŽEў’‘‰мƒБд­ЉаXc•MJбЁkЕЌv\єьюТщVƒ<'•іНlЯШВ™яŽAB§VЮ'Ъl_R{ОZпаСДяйOžчZРЫэяуѕІЎ§њц'ПРf”уЌгхtG>i‡рОП№™˜В…ЫдЙVџ|"Ј> F8Df5'Эњcx’Љ9и_Žўf%NP=!g9Zѕ[ЖУх­G1ѓШ8HhIŸїA b}оA}Ч%xСЄD4“fЩ'лe 5"їAЮІ–[Љ“xд—!j„.4ZЊh\Э]QўHЯЅЦoќbv]xЇLФ7^;U<†x`R!jђе{JІdђ4DZп-LЕќчˆ\\ќŒ5у'ЛfB^g8гшфU‡,6з|љ Š:žТа1Y`А#. ^ЉbрVf2вfyК`ƒЖeз­yюP}ЪЇWЗŠЗ‹-„чZŠИэžЩMн ME&Б|iн3Хн]ТьЖюFі(а3"B—жhN]Х ЁЪ w%ˆэ1ІjEsFыЦz y]ˆьcњo•7у*]чhх\Ь‹cfЇХЧsšЛ”g"ѕ }pI ;;gЖ‹Ц=?б-Г—юљоnIчЛсyюЈ№AЬСЖ ЬmŒ1%NaЛ7—`чЙт~+СЇI DчзцрZHу”[žIЋџEяљќAЊ-‡œЖгЯёsiBп|цq.8Ж(rqЗŒЦlР ємNЖц[SКЊrнwо^hmэt"ocЛр/UqC2К6ЁŠ`ЁОЖЉ‰‡;'HЗйx,Кx/ІђHщŽP sPI­JНoОpKЋc'1щeЈрСƒi†Љ—vIОu™V!?3чk~ OxС+т~TэЇбE- nЧШ…ъ]œюH{ІА?ЧH $#ZЙт­‰Rpk_њ_‰гЃ?ђ…рjРъЄУуУид1Жг§оъ\ч(РЄXLдзfЌHю*Oб\’KЖЏЋ@:ЭmЌЯёUwЙЫ?ŸS:ЊaХŠ/%} єІSqsќкƒŽ:X™юшƒehІ)бФ1оeяcЏСрБъC4?6€>БnСкБ…‹ћ LлЉ lИUь@žщр;Я)дIЅЫ2с›Д0ЦšKЕ|{R`л6хt,—НтЫУнЎљ1јИ^ж>цЛўjœ>Џ`_ДŽAjЪk Ј|Xс'љЃјЖLza7#Љ>vŽ#Ё•ˆЧё Ž^їњЯъП ƒДoЙўЯA№O‚Оаз|iЁxq’ЅВ1 ‚щ'fОР|cЛoГIГи}Я`sЌJ*>Оюдўy:К&43ЦГЉЌ nГCnWОžJ+ уj&ˆO|р-p0—ш4аЂщїˆ UМOЅсХ/мУ1сœуЯ]гт(nсФ =GвK‡Љ” –Нљйо€ІЛ0ЃЇ•ƒ‰лœL\[žўМhMз83JРї™АŽQа~ˆћ6ЉQОљЉv`A;s@ЬЗfРњцсІ4НХ$•ѕЧsР#РŒ”sЁmХ':Eeœў–—]У аžЄm=w$U^WП‰Ь Fњ‘мУ~cїчђДlm’ŸШ4 ќЎы%Гуфьвї m"e4ZŽJг9z%{-ƒ0g_gВNЌЊ6ПyЖиš[JЩХ‡ВFЂ›ЙQ‡ŸєЛ…„Op`jОЭБч]’*ж=бЏgH‰l/Œ^{OUfЭ‡Fј–€"  єn]‚yB Шє’КЕбOЧ!НЁŽ)cNŒХ…№SюбqUЩЮ2ƒШМ#=G ХZОрtгђrА&DЋDx…3”СЃl[тЂбxо—М+m“иѓbѓ/Щqе‘БН‚юŠ'ХЙkі[БNMRђў‹Jљц‚WYПьЂЏeeрw‚-Щ~<—ЅзЕA'!”Х{тТюЖТУˆ™Г р%ƒQDŠOwщДіЭЙмМDPљжЪ]}вGQ•СФђУMгEx;‰Ь;6•ыЇП.c% (‹.LPГ}јбЗхKэg№.T(ГNзтœыAvЬтћАУHŠ,@Ў`к–цAЇіŽтsn!ЅСхlЧй АЉuхGѓдV!а—ŸнcQˆ2рйC\WЁіƒЏєТЙJtыl†ЃщЕTЁўГ.'ч—$ђ­EW,ЯЕДX{иrлjљњ„ЕОЖMЉe јZO o'Д”8ђ rІJlЈЋх›ыХ™кOqŒЕ З6GПЌЈK$еŸMQъVжи‚Эдыев'ПжxЇi:ž\Њ:]ш1­kMnЖ9ъ=‹хО$`пЋЫТш№A—КŽу?‡ьF i†+оG*`б5#W*B[œЪ›^™JЮ0 !ц&кЁЧHГW7Eѕn<uлpвЁKзU™S9~эa+<%cЯ‚ЅЯKКљ ž8Љcє.§jЕ;•ЧˆэСcцчы +„•у€СCЈуђ дŒ}ЦXJ"WюиЅ|ђеСёіЈг–rbm;Щѕ!bЇГчЈГгЁќзќW$ялн”ду*ФdSFTškЛ‚М`сŸкдзкЎйЪ5№тЫ~OЧ<]ЂњЕSŠ-™G].SЮ3l\ fэ~СПВ;ћЖD&1Q2ƒš hќЩ6.ŠVєiŒ›ZЖŠІўЌ…h }ъВܘUYf5nуŽЩ:[eмrH’в2ЋHЙѕДХгˆmЈМJгMоFЎ!ИЉР”l…™н7ЏЗтугm2w.3wW™Рˆуž*ЅФюКm2ЁЌh=ЁАэ.ј—ЫAЗy'ІЊ$oe–њ’WM.UЪ9Хя8?О‘kѓќЛЗ›X…7ЫЮ=иЂ,Є‚cЪ8IрЗЅ0ЉЭAз†@!C5Оѕ#>YНjџh§ъНп&oњOАЈь‘UўЯw:ЖƒпъЫЎж bŽр0­ЗoЬёRКт ж йзЏњVжbеgЈЭ+”„Џ$Д“”ЖѕšГ’п•˜С0аR=Ъќ†0gі|ЏДкNŠ—H,drC( ВФFдгщмƒJњєžJі’iЏI,ВРС9Дг“5РfєlvТ4~Х/)=%ј—пДвšYМ6!\R2BШ~ъЯж1­TзтžafТ1ў‚ї *ŒсЮœћŒG!—cтоsŸ—okДfУђеЦбѕ&]љ:†Y№k6œ‘ПћeЫ–С]KСˆ|OcoЂЧЯа’„ Ъы Nд)Uaf/г#Б ŸŸ&УpƒѓЗО [Ž5Є-/YSq7-QІЪyv 'ў ПшѕЉRPNЙ ˜—5НЬЦ†Ю†˜УЇвG-їjд|І_OdПx"N9…FЬжoGlЬYтР­ејzІЫ{9ˆш‚ЉN›SаFђy*ЊЩЪЏzZъgі&|%Њы'$ІVŸє”г†СzTfŽ „‘UЦіЅєхнЄъЩ_sэкд#ƒ ‚nЇmћЂХЙG `Љ8TD[Ј.ІŒf…оœs…a]1sкѓчрЊсОЧ>"}НЊSМ~щВЬнTт *jУ\l7Z}лљб юœ#yщqЙ[ГssAuцuхІЂCЏ!ћ5зЁОiCёlЫЦ–сЗЅ‚­„Љ ’ b‘ЊQХ'ЈВкЯ(<нiїŠ!8Eyorh|zН?DIKњp…ќeБ"ЮіЈчE˜n­:Нј•ЛП эP0хnQЋж„nиЖ’Bбm]Іх№bbђDЌ(ЂКЈgІБж#‘PвAƒ~(ъSКШxп<гПЭБз‘!ђ!‚Ч™рЈСž—§ьц*џфvЃD&1џфG4y~y$ лУпO’:ЅCтЮ‚ іaы1ѕFлЫ+0Кчz„)щ„gd€К^ОЖkЬHif‚ьлтgДЕ/Ї9ѓѓшSЖgш%јmnфАbFhю-ƒ `tjПa-XџМWЖaМ•к MЯl-š=х‹ щrЧИ›иЎ§] CгИХ1vу $'JШЏ[ƒСФ\—тcAЉ3ЁКj'%ІO—јБ_уЄ|–гgЏpёZrФћ q/`БЎхЧ л|4“с,ъБ19 Єdjћ„$р/тлБ8рЌs&((ЯУЯ@ ”ВŽ~УЁRhnnЪ…цд=+f6™zЋpъВB7H#ўQб$є[яŸ7уЫ;Ќ;%НJАnПяцѓ"`P3Yцi;8Wb‡уbŠEVž2 pс-y_~ТлЏжa(іКoнйѕК6Ј!ŒxnыŒVNš›”‰в­ИяTЕrЄL,ЮДЅљqhІч7Г3WмI01жSЖi n;ZќпН‡;юsЯзмpйШ[†љМG&[Йжrц9Є*ѓgЌ/|e‚С$bђmЎg.в\ЫТ+ŒКuвмK6б>‡7ЄЌ;Ъу4tR?’А№ц‹p‹ХњjбьІДЋ’Km‹hє:ыEˆЏ™ Зз’ТЯБјoвИќ†^іМ6кЦЉ LЉ$8њщјyъЄ Z1Ђ2Ћžђj Я ьrџ“•љXWм‚RћоеуњŒц8[•ўю}8ŠЇTХЩ3РB1{zќчЫ‹‡i›кйЂр“™с-О(—дТЫр‘hёѓ ‰жi\цML“–„Xеї“]&z‹С~–ЕЕJ1з Œ…]QpРWIўš8|і™дgmШзеMEJь5}Зqме ШЏt*‰В(О\+jјСEЁhQUƒŒw~B–яьRz…Љ\Б…•{> ідГЫІЎ€ј‹§qБЦзцФ A51пЏaЫБEКъШ)y)|щYЛpЇД„ JяЕK'—ŸДЫœvауnЊ#UbНЪО0Ќѓћ‹g?J3І№,шѓKaK2УОЩднЋ.Лш”“Š™…Ю§&|‰n0ЉYДi гкBan-l$ДHpиtMjЎY‘Ђ'ЉYц3D _1ЂвкMŸlф-(ЙD‘mОлlМі.фјx;ЬбrI•œ5ОHЕ(ь„es5Xьён%зІ—ДOy5рВbЈ]0љ1ЯЭШ§Њѕ;ˆє9И[“й&Љ{ИЃŸр›Фz+Ћѓ6ІŽЋ{ЄТь9Н>знТФyf_;i­šŸЬКМzcNр#›G Ѓ9lЩLS T˜žQЙЋуЧЖ Ю№ыЊЭfЯи8‚цЅэяuM6h­“GьY4єJDlˆEзQСЉѓзДGщz˜OсNШЩ‘œ)PрЈДђFжi њ:жXўc_Cz€лиэP$0yН>ЬЛЫZ8АCnж[ЬdЂсх>аˆ4‰ѕjЎЮЛI—}њ"6%ћРЪђ3НŠ&FF=ХAЬЙГњ8dM^{Г=љlЊ—вкАќ)џCУ<§,юOдbсі_Є|яЬ§иYG6~SЉzЃA~ьzлѕž"Й(t!щuР †е.ЃQ (œіФsЧŠ;ЂМ^|гж€а[‰ЬЬ!ЁаЪІLVˆ4 еeNУ§ZFWЃуBшbк€-ƒkсќљф,жG=“єk=­мМ2ђ ІЭбTŠЃ;T+юХfенCWАхљБ‹^(š}ѕ,”B]+gžЏ!ћЋ §ярQ™х“‰њјРa*е‚оzœЌЮрkхЊЮОП№@Й$ХМ>oz=BxАл,ˆ>‡БаКЁM4Чф{К+Ц™рЖh1l›§БіЎх<АП"ЅziфdєЪСƒQ&ˆz]f8?o—™‡>/Џ? O§ŠЈ4ЙЌ0лƒн‚UЙ’qвБОО ѓ #ё|žXsя]T.UвЦоR”јŒуђ`† #ђ ЕюќMpvŠш33‡лЗЋW?шаЈ­`К,! ^ХДр/’щœГLœRЖЋOЉmЋДїo]ч›:KyвM{(ў|sR…л7чв8‘љfЩН"ЎoƒSyL›иVkЕudАЇкэ>Yчhа)Tš!\њЁ‹&e2`Ћ#†Ё™д›†?Uр—ѕ‰лЄЙ H`ц.ЏЁ’vШЅŸа‹™д№ћ.~~Љ$(АтЙQLаЗч>Зъ!Њq~еaIЮ\ХЬwЏˆ’“ј6DЯњ\хf@й"9тћnKŒ щ|ЄЕEeјУы"тB=)ккЗƒгА‰1dBUQЋЎАм”Гc›oØлі*",Q;mЦФy][EY€ }Ю‘54L€Ћ‡ўŠЮ”lУГ:B‡3дy№,ъ‚“"k#/х с1t3w– SЫ[ЫlcF“ЁЭn7Ќпa= œŸЃUдІо1q?[!Ш+!АeибБHпE’y[љO*еzИ™e•$D4Ё?‡ —Ђ{ЕёЦ~уc/иz,ЛK§Y<(§–џ лЎ8С Oх ŒЗвЊv:›ˆqvЫcы(nЈУр)Ю#Ћ‘‚їњЅеЮšcоSŒ…ё2lљШLЗ—žЭИ[ѓfыj‡UЫъІоЂЌщs1&­їў ­›Ea@(ˆГ"АPWeo ЫЗTaeYofNS@U&.‘&DОQdН>КMn†Ћ!вEЪ 8Щп=FшбN‚K…ќxОІkќ­іƒyФ"dcёОијMъЮфжb#œEЪњdtЅY0;…bKu–3}6щ‡)SЁф,іnГбК•МЦЬп HъЌfСTд‚vŒѓwlљœB%j>0хУ&wFя!№ѕ!]HІєs§|vpџНї>ЧЌŽВВF$š*Ф>уьk Е?C„ф6.>Aі {Xї›яЂюЭUЅ'}ўuњ пї>,їкƒЩРoлТЫЦœ&“ЉРTИiiіgw]k†рR˜­5&ўЉ˜}ьщsHй )s_šћрTSЮ6мСЈщрдТІ;VеЋиўкЏЃХЫЮ‘FžяŽ‹ЪєЄхЖyDtэГЌU…МЫў"э8ˆЗѕHАцЮˆ#Tў ,ƒ<8Sƒ’yХўчІxˆЅгњX: 9ЂyШа`NszжХЦЙQыЛL„ГGš)œ(Љ)%‰Эgm$ Ѓ0.•_тgЋ˜œЮЭ‡?ђ-‘ЯЮ`( cЩКmcФѕсУщR‰ф9XІ’•ЉdЙ:ѓpƒн~Ѓ<+Ї vЗ4ќv„SОŸ!u-{;œіШ\KKёOhЗфSЈœШШвЯ%•ВВ`нпG ЬУф]:ЕrаКbЬ–Epa,(‚ПD‰9X~3ГќфlхeK›ёlшНIчBПэМNШјЛA…vД‹ƒhZa?бнч,ЗЋJYLmуиŒЋDЏ[G\9оАЄŠ о‚}х Б d YnП­СcУ‰№аdШНАq•дЛяќХУ1JсЮДŒгЏъХепшУГ,œoW/Ўєє№сoфЫMІœёvгqёфWTй#ѕР”ЉЊпѓќеbM}–ћ­v^УЗ3М:Sп‹ыА8жЏВ—.NЭ8ф‡™НтіLЖVˆЊ~њЂ"нCиZљ„ФвТ§№”@Гі^ЇŽН&іМiъfЖž mcKЩOЮ~і)cД†Ъž?іь'iиы!ЙhЩ=ЧeЈQ"+ж)ё›і6сhсоФм}R @KЧˆІ§‘QЏ‘ФŠCл ВИ’< OrŸ8YdVЬ*F0В(№ іH2\Џ)ьRS&vЧ›ђK2ГitЁ‡(1сЮ.ЏŒ†xюgИ#=?7ч3PkB!fћE‘DPpЉИЌW—ŸНЏ,| `Г-Sь.‚>ЧЩНж*ˆ‡ŒAй|й„ЎЯIЅP&ё•Зb––ьѓМbq=:DќЅ&j ЙсмŽПй яЬе96K#R‘FFDk"BеиBЂыˆXІJМ6SфРaO/Ъ`JёI8щvBЎyЂ2­‘Бічњ†зB3ЁУй{О—Ќ{[:š8ЛPMXэјd1Д$Х;DБ‰пЋ,і–жЬ‘П№ђи—ЎoС kЄФiѓЮ‰уqЏM‘cСŒnA;ьј#BјDД’Ze'л№ЬfŽ~к”и?нЄчxŒy.љїI{Ч дЊ}З8Ѕ*ИНPХз™PЇP›ЪЦеШ‚AD­‹Bиc;Lj VїдEˆрEo3m“DМC’pеЕ З3AЋ&а]y>pіЊЭJ,кР,Е_ѓ Є_§Х5,W2ІIЙtAПgщ5M­>kƒbыО†й&ф\жŠ%H$о=Х 1йZŠЅ_ц}ЎѕV$й:lЫADz†VєRБ/”[`6);-–бАй1;ˆ:Rє‹<ьвЭиSrѕхЛ!сRIHы9з%шчRЮDвvЗj†0 AБ,ЏuAќЪщwaіО_voM ўФђхœћЌEш< УШИ†y’fаЁтHo|чѓЈїЂ5знѕг5ЗL™žЅ.ЧžУ§б@№єb“Жщхь`Aš%Xzи~tcВЧт>bђQщбtnœЉЩ/oh A$|…8^ˆ1љ№ьРЏhБ+=‡ (˜(Ь#Ы(œE-ШАe›ž[ж—Œ1'‹IR1BТ ;^3jйВ†.ЛЕЫZ‚~\…НцЦћЖР<к2*УАъ”TQлyIк$’U—œ ТPf‚DŸLя fQ{Ђ…7яЏЛJЛрчUпnž‹>&B<ѕЙЧCНC3АСж&Š&"ЫD4ЛТšŒ"[ ЪЦ[шˆЬŠ•Lsњ<2Ђ9ьPЉџЛыу’AќБЕš ЛђЃЯ)aБ§с1Нi—А5џkЗъРГƒљО]5ЯfдDАсGЭ5&ЎНП4aџХ~ŒvЩаЧт‚О^щ‚іeќт[№­I-KЕЁ6х’42З Ia:-ЁМ/)o2ХwшeЖЃђaœїаЦŒЛx"~bе™ZCІ~Ј›\8ЎЦg_E0­Dx(IЅіЮ­њQнсЇƒ9EѓтлЫ^qNќŠado%h™29мПы5ђGбЇAЋ"6вЫ`patŽ,sPЪЗхЉсѓЎсУПъmlІ<Бћа†sŸTХ=ьў“ђ9EgPиЅŽш;~Bš 4ИL†tFћoљ9 ГŠщжсфћСOж„RсTfсгTœрТЭЅŠЌaЧЯоMtеФR8i.юаиeœ5NУLXX\т?ѓьЈ[xЅ\€u†^хБ7б,/0иˆnk9ІSŽМпbйлŸ3 xа3УтfЬkMГВ€!n­v:g-†ЁŸ-˜мyŒN]њjnїяgѓщ”qѓбЩ-лzSЯVПq. ^РЛ цтSлw™ІmXЅПё“. Ёs•:Џћц~;—ж„ˆaщи_”А.f‰]гPJЏрШДЙ]dЫg1 ЬЮ§хДqJпжuD­`дњТщK)ж7ш~ЧшX-Ўт†n0—ьт1xXё)щЃАLЙўšєјM>kТ>’2FЇxЪEXƒ ЗБћXЋё]ГGjљЊy_хDц.Сo>вэЭУфт ЕКЄЪ-Vј:BЪ™оKнRЫž,•AsГsлЯ[…Ю&?Ш0МЕЩ}‹ ђх›!}з‡гс‘ЃЛ˜f5ОУUкЋKЇэн?xMьму @їючТgъ›ч}<ЕЛ ъLC56zС&!s#"]Р47ˆ>ѕєд0 DnЮЧ’оЄ№ЧдсТ_йП[>ясИXNуŸ”ф:иИ(š#CЧ›ррГO E„џN(Юкчюi–бЂ7ўJRаБk#&зІ№EзХж5>P,–@NrЧЊнњrzД,ЊМ{—;ъХЬ"q(и€Ћ]щхЈѓp—Ђ‹…є#’vumx^…~?й*ѓ‹aˆеS˜пjDјЄ2Јœт_†УF`О‰QЛћ•_Ћ|Б$Ф Ю&`^€'/v.ѕШ{EЌGO&‘Лл>ЩmєўЛ{^kUfЬ*Шє! ‹вzхL1Žю1‡‹Ул5ЫmзЮfсй$эŽ˜HМЭ9ЧkЊ§~ЋЉ/oиїKУЖт--тОфpW [IћКШ’vЇ{iЉ0ќE‘ M\~žЗіЌošЂd‚щДАЕ)дЕЉлв›ˆbnxщіH)БšБ$tЉ–пŒ/уkа4’‹]“ЇG?ђьЁЯ”Phьk#Ѓ }о8eЏp‹Цтf­ёЮќљR8’DжззwЎWЉU;ьlO=ыќ –nяJЋOчGїпўИЌ‡†Е[жрT_ЧzУиЋуCˆО Р-RФКИC2“МЎю‡d„?з Ю’EѕPЄў”І—Ÿ„’Ы>HcЕу–6›aхux‚П˜к!аfGЙД/бњBS7“ЬZXВ…LСй˜Ле58Єќ![vQЉU-ЁїgrztПNеoТЂЁb{…oVюt—’TќсуMh"‰Лn<а@бЪ„8TшKFыAЎ“yyŠ~Ж€ ТЇRЦ1U^ТD=a $жЮj$вЫВЦЌ#qФ}%†Ov, љp§ЧЦ–Й3>‹јAПafсJ;Bе|дEvBn›Юj№ћ3ZВГf%т\&™QH/‚тћ‰VœЌЈчdˆ!WJpLп5k’B>ФоW9Ž’ДЯёWНЌMЖЦdНsфЋЫ§пддуЊXгOQ ЖЊZ0ЕЕЈ ~ QЛ8ЦЗы/bZсДЂh/GрћmГчe.ёŸ}сљ\'šŠE2ЙЇUqN>1ў@JкCѓњ`^“’Kѕоб ‹Ф9^%ЂЬ+бVВЃ[ц[%‘…€#h№Ѓц[СqоН) е/t†рХУh$†}y+Ќ2­-|;YЕ†Z№ёШs0ŽJ\7ЮOŸ(Iјђ~ё=Ѓ#aЗёЧ!Г‘ЌЪЯљ)%~wKAHS:Ц4РЎЕОТ€Њxt“’kє<&F:xфш'ЫЯ! 1Щa9pМBИzYŸЪЮДп”#н)?Ž1ЯNh›s­Ћщ6osAnяЧЎ|ueПGЉŠІЋЁFNoS ^љ„$kъŸƒЬLЂ™%fтЧщZЫоvwу]дE(‘Sе5ѕГђё`­8-КЊ`ехOЉ@p"W‡щvfЂyMЊфŸUнœЏЛ|cŸ›B"ЇS;žЦкћŠѓѕˆyœSэryМлЬ5џШг’,/LЅюЩ­ј6…Ље8PЊКdГ8c…7щОŸ˜(‹ Ш№ъ!xЗьXјкoМ[rcЈ “п-ЖУЖбъߘ€„˜п(С2Я2и/р№ЉNйg$Ч Ощ”…}‡ф •Вз bЃѕ&юцЃиьƒљы†6lWєSvN ЧЙhЁP9чЁт№ѕ1œКиё‹оœœ"o-Ш‰RЋЯ; Н|‘љ,IЁŽј€ћ{-‘Ч%шёр›ЋUЄ}ля ЛявГG”э=є3HтizЂжРЙД;Ъe–ЙШ,$w™fТ,W‹ƒ‡‹ощ&ѕшѓВ­šщŠд‹Ј?“гu У,‰Лс›+ЕёИўш^Ж€џDЙoз:Ўvіtмcц&†ЧNДнУ№8г…AЯЎƒ‘tІrѓPм@ŒлјtЯoЫF+. ‹яNU.Й#хВдыф~ZіБR@НukOоŠ}ђгСUк’%Ѕ>T=š€фcиЮІЉŽ61R!љн}9ezђ"„BŸЇЉ8Ц’ИД t&kЗI­R­?$WyпdcБ2Цзnф*р.юєм;-ЗьЁХq№№Э\фЏТчЬ^+жлЈ$тГ†ѕaЈ3gqyЕшK,S‚g)XlкЎEžV%:ђ2#ЈНы(ЦЮt’PvM]„MЁш3КЇо†ПХ0д і…o|ОўfзТ'pœГ`œъmfKщt˜Н^’+І)ГХ=?хXяyЪfiŽ №sZгЯмхlHˆ<”“јЭ Iаƒ k’EcЋMЅŒ†мШмyЎ1јіIя„pЬ>ЁoЩ6РhКxЫFВЩoя>мw3{kЎPzLХШЭJѓE"S5ТЭл­јєЛLќaX?ь?Ы†Гз€rtяoѕ‚аЪоХІ…j3іH{Йх‚п‚oCЇJ:„˜ŒaсЬ Ї2kЄНХQ)нžйм§qGOžwІЧ!л\h|HJRYuэцэК5НeFиŒэГYŒ`є4Н+ЄƒJ™мйЅФёœGoSЬШУz ~П ѕ,З Д‡.•ё–7\§ЉСЎЂчЊЈ‚Е"Q•ЏБ§ЅzЙ^>gцO!dРХELG0^ЎцгьlqGЦ_EИЅ„:†eуjК=ž—с„eюZ­іГŸ!t,‹щн mU:њ€ь.сЕ№Ш5fОz№Ы‘ђ]Є5Пb_&*фI2Оѓt$ЌœŸXЂѕTх$9ŒЫю• 45‡ХВЊh˜m-щ(8КЭ…pуВOkдзˆYЌЌ “nњж)ГЫršѓщАD:P/†ЫГПоC…ЪШе„љ&0Єўт VцЅхAюо#чШh>-Цxd’ŸоЛ^д)›ь7>ю]#Нь<7кЁiќ–ўЋuА:Rlюбёќю6гљђ#ѕXUr?3ЁИ4q%juЩERЇ` Ч*‹gk’НМVхў›Ў ћ~AПF*ё‹Їš’L‚lгNrwPMІfп­ŸdYOг&k8g“qцяO0!5TYЌёŽ[ў„˜ГоТŠпuФыЦєЏN[!ПBк8l.т=†ЭЖ:В№!Y3ЎїˆўRцёчgI<ЯjЎу•eš‡DлKЇ‚ јИXИ№‘ (яfŸР”_\§ѓP‹„l5ƒe$вТ„}žuф8 ЦШхэHЅ'šкх8=ƒЯ3AкXY­с№8ЄoЫЕ‰л;{їdqо,уйђrDЄѓ #БЏєшЋЋЯїjЦ–d”bєmмкЄt- x.ПтKг  vXb>й[ќXŒqЇи,4І)}nїŸеV—ž6„9Ъ_нžS‡кнН8О"XšѕxŽЇђ›О•%АrЮ#.…jэRЗ ЏмЎш“‹Ю HŒ4zДЄkС№N\/мGБЮ/LХЕмn: myЈ,Э2]‹х|Аѓм`—+\nщиС Ї І”J)Ѓ'W$ Њ<лVŒГњќ!Н AкypШœp7Ц†pжЎ\hlWЁчЏWчx˜ЩW//ЙоПЂЗ|'7лž9DG‰и2›lц5уЇ'Є‰ІИњЕХ+]Ћ%ч€k.­`1€(ФAЏ Ym†B*нЫ59%"‹žЯXu5ЅS•cИ/гЉ<%M ’Ъ\Tиnc•p)с7 qЗ/ёџn­ЯФb“жьЉƒМ*—y—ЗЃьm Угќ…`$ЧtВУ‰“EьˆMњЊ@iФDЭеА~IhA:`[.1Э_uЗѓKdjљгѕ— ЊЋeR„›Q!_еBФ‚hl˜їпKZУ+ЕЩ$q›@(sœjwPTжДщтЪёAЏМйKlЉєВ” ‡ќтІ4›?(G…oJћјКSЇМ’ŽbшьБГ$’aHi [ЙЎќЉию.!bЗ;=ђЁзЬЈ%6Ї+љl2цх‡8Хяf‹gœЭў…ь)pЫПg†жmƒУKœЋ@бЫфŽ—L/­ЄdљTG}0Кѕ™НƒЭЇpаОаOмy­iW ZъёŸќЭ”ю ю‰ жТ:) fцм5ЊіAЄ} 9Тљ™іuQыќ’і[Cšѕя(&ћДfе’ХШhНљ.мJЕмsёVЛ{ mgž/^zaщQѓbTю†Z‚Q'фіŸДB–хbŒкrMњ†а”9yс_%˜Џt…ˆLІ1?Kbг—кSќdVlЕещЫ i —5о„Ђ–3У†rYРВт5ЛU†9жћЧГ=mYRБљi•­8„™"јѓг›фђXЃt;i[}HОg)DKН]я3уЎ+%Ї Щю…”NЊ1ˆ=BдX}dє<сdp›|…їF[ŸSФЕVязђђ]цдЄяƒ–Иы[ Iќў…xVЧОЬф,АRШ]Бмf–…Жф2ЇNŠСH‹{јЁаѓЌ(4љгSЯ$ЛЮц(CБ<Z*Ќt§{Рm{“О;—Hу‚§hƒyчw*хbЧ4œчэƒs]ƒ? !чфнеTŠ‘Ј4`Э†+ЈY(LŸvBSK^ЭскmЂT3э6Пным@Ў€bкŸЃЉK))ВёŽ™ uі$ю>ЊзœТюlU „Ž{а)ѕqЫіj0’Є М‡™і7\уУwТЋE˜6є†ьЗ$•;> ѕhџЊсeSИŒ„=ЮЭ -FХк шwƒfNўм0ŠЫZЈ–uХfBЄd2л>у!рЁ~>Š r‰ЧшPЮмЋ&[CRœ‘N†СбЃ‰Юћшj0™гЋй7n$Йw„SЗ/!ё\ЙЋЩК’^‡ѓ§xНг4”3Пе€ГuQŒйyї“БМ?ђќ bэЮKѕВЁB )qF> ѕЅWФVq%…>`QАgjnИувuZр нWуD5 —їќ;ђˆСЛ`|€q,џтМЧЬлBщЦІ ЄžCiвЌ]rё,#фY,[П1QЖюм R‘цхгкш ЎДшŽKF–Э‚иЙиaŠп~)*Z€ЫГvхˆМ– /ŽЄылД6E!­ћn zRО6˜`ЩCЁшcЗ{ w—/ЩоОx}{_—”tЇлP|ŒЬАвaЂГ%ЪD’ЅLSе6JЗk.ќ‡I€EV ™эjwСЖј_ћлђ?(mЫFатiЫ”ЕVFmЁж‡Ÿ0ˆЯМRЙ7ЋISЃ№ѕ…Ѓ'?д Ё|{lx‰K[Х]бiЎљ сцДДPЕeW<ѕІsП4HG”TХ,™[FЄš0ЩќPwnЩфьLІ†U: YЎј ?-@УnХ8–ьNБEсуІ—…’—G`rНOЕГЧ‰ЁH oБл;2с_uc(—ЎО*–G у ŒѕabЃg™ЕYnЩиhУ $œ'”ѕыц žAWМйУ‹€MБ‡_ЈїгєЃЇŸ>tѕОМLђЁЉsн6ЪщСлЏv`лBG{JЪ/+ъ +qs+qж|0B]ЂєdфЬпndъВVŠХд3ёпDl•1'§вжт6њYqЉYы†wЌхЏ §6cИjсoщe*n„Hїъ1CdЮ™ѓ>тm4Щиї~‡•#œ Ќву М=&…—ЉЉsr‚;Х*ЈЧ §Fgрі˜— ђ5Mј6:xжМћw9*Жзѓ8,ђ/%ынВD *џ™ћ endstream endobj 176 0 obj << /Type /FontDescriptor /FontName /HKECYY+CMBX12 /Flags 4 /FontBBox [-53 -251 1139 750] /Ascent 694 /CapHeight 686 /Descent -194 /ItalicAngle 0 /StemV 109 /XHeight 444 /CharSet (/C/D/E/I/M/P/R/S/T/a/b/c/d/e/eight/f/ffi/fi/five/four/g/h/hyphen/i/k/l/m/n/nine/o/one/p/period/r/s/seven/six/t/three/two/u/v/w/x/y/z/zero) /FontFile 175 0 R >> endobj 177 0 obj << /Length1 1470 /Length2 6897 /Length3 0 /Length 7877 /Filter /FlateDecode >> stream xкw4\]л6б‚DЏбF”eFяНE] 3Ц ЃwЂЗб;бE'z zЂ†D ЂОIžі>яџЏѕ}ыЌ5g_wлћКЫ^gи˜Еѕxф H+Ј2сЪУЧ (hЪ‰@ ^ˆŸ€Mц ‡ў)&`{EЙРёџ0P@AСЎh™"иmЇ‰Dдмр>ŸА8Ÿˆ8рФў2DЂФŠ`w Щ PC" .l H'/ЬжЮНЭ_K‡5'€OLL„ћЗ;@ЮŠ‚YƒMАЋдНЃ5аCZУ Ў^џ С!iчъъ$zxx№‚]x‘([iNn€Ье  uЂмЁР/Т-А#єfМl};˜Ыr=ЄЋ p˜5с‚іpC@ (zs€žЊрБё‡БЦм€?sрухћ;мŸоПСПСжжHG'0Т †АиРрPРce ^WOWnљe†Л бў`w0 ЖBќ>9 ,ЇЃ ўIЯХsruсuСQў ƒЮВЂ€tt„"\]~O†‚ZЃгюќЃВЄТчO`C@l~‘€И9 0g7ЈЊтŸ&hС?2[Ј+@‰‹ ЮЈЇЕ№Wx}/'шo%п/1šŸв `ƒ&ѕƒй@б/А;рŠrƒњљќЇтпˆ€YЛЌ Ж0С?ббbЈЭ]|Ь` Bїєыљ{eŽn/їњЧќw}J†54Иў`ќЗN^щ №с№№ ||bBєТяпaўNР_фKЕСА?њ'Ђ*Т ћƒ:yёpџГ-8ўNРПwаBЂ{ рјЇѕЭ@B kєпџy~ЛќџњўW”џ­ѕџћ@Ъnpјo5Чo§џЃ;Тр^ [йЭ=šHєp ўлдњЧ(Ы#сџжЉК‚бУ!‡А…џD˜‹2Ь б†ЙZл§бAеC@Е‘.А_W €‡њ/zмЌаз‰ КRПUPє4§{K%„5ђkьј…„` ьE€.< |јаѓ zўnltEЛафќ6HСЏz €rПDП‘˜ў‰€Vџ 1ањoФЧ'ЂўЂуИќ]Ужк …BёяnBSљ џО1 POЈ5См вZ"ФўMШлГj9:ž/ЃR“l_ S9y|цPmnDx/9Ћ2ž-ЁNф^Оы&YXSт8–§ФєгgЛЙ/М%QЇѕвїъщ нё/­ГcT§ Жхjћ№щyєe7|:ћ> rРjЦьPcЫqv%вЮ#?ѓшUёЌэ+›љЂГQ%ЌNxU:СkcT<Х–k•9Ms畇сіCВ}OтЉу“IВь7Lj/Иќvb }L–љŸŸO{/–ыѓЛtвВвšа0`“ ГћШMVЃўшSRЇ]dУ`1г(нF vЌaю˜“,}џaх=ЭЗЇA ЅФkуaqж:ЋlђяОСѕВлiШrjEŠ'~ђ=Э'pбiпќIх]М'$]U(Cѕj^‡tу@"NTљН_+…NІ/zЗпЪ&žДЖ"С’АаЬUвНqK0—Љ™ај3gђ`eyщŒ™ZМW…ЕŸјШo:-$ъ˜?бaЮ–ЌЫg.В'жЯeџ4c№#щтf€ЂГ•Ѕ‘н€Щ†‡AХТнЭmCВ9aVЛ'lЎеƒіdKЋТ Utўuvдзч’БйB9Т>ї—|+ФЪсEоџЈќ1…†10F2OjЅЅH$+ТƒqaI=;PB2 !—fЛjцЌѕѓмSу=*МNљiBЏє™ж8zMџФЂ_JЭ>ЋfФђхa3с0'q<ЏБŒ>—МwќА…[CўЩяhсTРRWЦHv{О7UЏ1іЇ:/“фNxyЭОЗw‚aТBcaЛї§"К„ОвsљАGƒМ(ц‹"UУйj Rџ™SE^:§Rэ,щмOъH­шMяzТ$‡R…Р–yEе/oєЧ ] z"Х'оѓ…иaeEОХ ИVRT^і‘I'iЛ`ев}ЉН} -ve˜pђЊю>PŸ#ElэDрXŽ ~дI %фНѓnуЋх"S(‘вЮ]ЙХљu:FfƒDЄЗщrым=P"еЁUЯеЯmэЫ™#в‡§iН:wo жRR‡’ЭСГЗ&r4Х"ЭТсІYgMЛЕ&Dœn§Iњf ‡:hаYРW+е9‰) 5>ЩЊк љ‹LФй ц—е ‹)‡S[qњƒU=E Йђ‰лbwэ"іАe‹АH“Ш(Ј­†д ‚(„Н=№“Ÿ/ігл';ЉЩ2ћ@Yц”=0\d[P+ЉИЊЩzNЦШ#“ОѕхыBФйv™ќчB”ЊоSо#’Є7lЩ?їэ[š$]жV(Ф8їLeКї˜T>O‰%HрNз j0y †ѕ‚щœAA>йўЕїЦ˜-jЛ}aыK1ћ№'Љž KuOBД"ЫЮф~ПeйV`€YtуАЈq>.ђIЊЌвџIы=Ѓњќ!K‚,wbН›gЂtЩ4•žrWXјї8—™1­0&е ™іСйE•ќ*%,ЗƒIL>•q2МЊ%nL|dBњН•hHиЁzgЌGBРƒРю4Ж‰ЯшвВДр~Ъؘѕ–iŠVсUV‡џfГœHLУъМSуudЎБ•:}lNM(ћшљ$Љ‹J5mCТ8@1]аm‡G<Ыiюьул'|ŸМиЏ)%‡ДОЋN)aѓ"[‘_л>ГФНhаЈчcџ6ёƒя@i_Ж–SПЪR~щЬ†­‘}ђЁ8м‚Ђумca–фФN^м_D“ШsиAS‰‘Я_э8uУёI|Э TяДmR_rЈ$HTjЩ8Єнџъы= зЖCЅƒrОqd Є|іЈSFЙhTh8ŽВŠ0dyкeHФЇєHJњ@i\9э-‹.dАqiѓzЃO‹ЛHЉплFƒS`ˆвг–:Žџ‹'SЕ’1љ'Жf-ЃєЌЄ7r{gЙЭВ†::_ЩюvЖнмАЂюBDnE9цy`Њ su№жвЭЇzїŠ~фМ\#]ЎІЩуF4Š=Б*К •OјЬ)(z’ѓСћљ{iеьGŠaбеl#мЙp хцƒЁ–иЅ"Ђ(ьчGЖl2љAŸoMzЫ8CdЪWВxиљžЈзС щв‚еЗ8ЦїƒЈv&Џ…ЂqœК"И7pео,G-Ђ„-Ѓ’wЇвІЛF!c6ЇёbЏШ, ŸЬI”П–нК……eЮДВ0э(Y7мЮР02t_БђE [ХQ}7NQ?,Ў,›Ч'–’ђUЋчCЏ W2I9I=žр/Lc›OCЌuзkTѕѕLTђПА{!P‘ŒЎ–пЦ>І[Ђy-~ўDє„9|ъuљœ‡™"-n”jbОІž&ХЛ58!Ёп_кК6Чhєj—ьШБ‹Ѓгž*|aО‹AњqМЙLˆў<™7ЁC9жПCлмЂ1JDЉsщ.№Y<˜џVљж"*ѕ‘^4‘%s‚^у„P_ЃjVњ} f‹žЛ HBŠrЮ&0Ўhхпƒ|ЂЮŒЙs€ cWx€‹O/ЙџZ%‹`є 0БЏCКхАњ~хќiSњŠЉ§v!З’бi}/јы-їкн„ФЪи5ТМpЙ\ЛЄыўЇWЋtƒЅquКp[ЬЁу[vБiдрЩўјђšŽЖЗ06r|ъЋЮќfGЫ нб3Х­ЩpђЧ‚эсЄFЏяЦеG‘Ъі RЌжZї,к)|Я.т\WЖіUJсщРњyЖ&TrчБм=NнHРS†Мd-К2deŸ%)=ии%я›УУ‡%фВc{cђС˜ыХšЁФЧk к}ЗЗЃћщG_H2†Б&њmU‰=Х^пЇCyМыЃЖ#/гЅЉŠЂЪk\ђWЗ‹ЫднВкэlYq‰бЬІ˜Ixю0Ѓ1ЖћЕџ8К#5{}ŸŠЉŸŒmЮ§Бѓœ>W2%іV‹;IbЦuмъдЙvDэh6nы1Wœ6™#–лžзі4Y4–Е|ТсФя}]USJ{ŠEсvЈ& Ёнš(ЃSMn|жЁСэћфМ†8Зžˆг х dЌ…?Ж&ŒПЭB“žАHЪЖИaБƒT~ётЦ“\)НјувБœpˆq0Ињ•ф2‘А‡—]Š)kЋMїОл›Т,чр“ ЖЇ3 ˆ(BГ™ОСв+ЇŒe–Rї3ЭЬъщRэФ'~тљЛд}ЖїюаН~iЏ;gТэ™ба;†UеŽ‘фP>Вќмх7`иБ „l5* fR\SGЕ‡Oшш;{BkлlFюЏг–=@hФ(@qе„ФиНЂцC дщяЏ_згM]ЖЊЖ €ЬВ›–юYh—Д —QЉ/Ч]OЉ@~дЪђ•МЪ™ЙЪ%џSo6b ЁLBqутВЇЬќсŒyB2ЄпШ#ЂІWуx aя@;lШšœИJЅзR KыЯАзЈ ъЗГ$5§‚"июHМ Y)8fGAыыЄу93ˆЪЗ6 љРлЋњЏЦƒКІ\ЗE˜ Ÿ!ъTтx4Nˆт”тiЦж(?РЛО^ЗцyVЩk­2t§ИфГ`‰#MєF;э%'ыеЗliѓЅЏ>oЋ№ЯžЊЉ™њцW'Rл+Ut<kd—(žр[юуЮv&ЎЦ|‰Эl ѕ!ѓКЛr ЅКKSМX‘œNэлxщв#щw›м†йА;HИOЭ AQьSIНѓКз8иПBщѕЭ›šUkѕЩf\MŸjT‡xіyЫЗ6тŽvKкзЁ†о—oЃP%&sAѕх7]Ž}2ž:НобZпŠIЇ•$ г-eŽs ^НFБ›ЩМЈv?ДюЫWVыsф†п2W:ШH‘щю›GHfuђЏ­С^dнћє.Иј@f[н=*Ž_ђR.Q#ЂУS[ђ`=иАлД\ЎпеBю$y|SТШ•YdeЌ„4pŸz}ЧИšЩсPPa‹Ub !еVМІœЂŽИw"yї“+ўЇнЦJ• Є§фBј*оTжАXаЗ+Х›*;,сОЄvрФNV qпЌoХJ\ ‡зЇ\ЋI2‡‰#џž}z§TЪюЊцк{Њя˜Q‡шOђhŸ№њћ{FƒъЫ|еЖЩ /фњt5^ё“LŠќ•и •цz„ёк$*ЗЃ{\о+м1ћ(ТLеЦkzдкДqК\2МЩ™3О-Нkш0šgЋсВ|—h“ЩєрСияБДН­ŽMєјЅG|˜ ВЭ8ь:о›Zдv({Y”Ÿ/ѕ(ј(‚ФфьФИє–Бњ›a„eуRС5\{еї‡|;щŒLЫm:>(п]зЅŠнж–і™A?ЭЗJ&vЮ$і,;фGzчВOЩ„й//B{яћм=ЇЬ&фКЩи K"кі_XЕЧH>,JьЗлrнвV8б_BrixFЊ&%Шžг_c04ЭуD_Œ.!УЯiВo…6ётe‡ƒYv—„ЏRч™гYУižNœЯЇЭ^Zюо ZA] ‘dјФЛLљ˜Їрі.фнЯЯ’;qœ| Хі7o€бmфЄgЌ0!=щ$к‚{ѓЮ‹Z8S{CВ_ЕІгЛЇљфM%Tie†’еЯОЯН,= ѕ&˜UŒki“r[wf‚gUтќмR‰#w,яКCI@f2VCўUНц,‡и2UpЂжpNу.„гЫ$?€вoц8<#žГгЭ8фšГ'h€ŒМ{^pНЕ"90љŠzњISZ§ Ћ:иЅс‹s§jaТ?Њ4rUєˆkЫЬ4.ќччЌКvnmt1W/›LSdиВфжЇнўa„ЁЯрЙСУЃт` ЗzЇох[‚нQІEАБОя~Є -ѕ Іoi3€}šкvA&t*7 g-ЪУ\KЛ7JЄщЂKxХДphN^yУпmZ—‚R[wВБZі(ƒіMЅ˜‹яl(w&ˆозЉбLx@уЬ€IеЕ”\фЂ„&ПЈSaБыЁбšѓлЌeЄ]ЄenњІ•P`šbR =њ яЫZˆнМJoŒ”ЂЯацFŸЪ†YzыуWдцт)ЛƒZУ4ёdьт(zЗъВ*ЦбЭљ"xbНђ!MљЁЬЉ— † œ8екЮжZ$е“WЖШј‘­мЊoЋ\”JЫ§КS"№}87ЫЊ`•фуvЮO^мЃ$гRиУA‰v%­˜ŽЕЉ н!"щyь}ыœ–=ž(џz’zоцbзсщ—ReR{‚VќŽР’5ЗкД[вйxdўoV-Ц)X9ЛО+а. Іфх6Zоh іЩб§AНбwХœЮRЧ’!ч=f’К›R‘ЧbЃ[Ћr /ˆфt œЧКT`ЁS{оІšБгпšНЎсjt7њщc&ЬйУйrR7:АQŠ9Нд‹&ы`Њ|?V'ОŒcWуy^m`jЬHЖоЇжїАEP_у‹Д§QжП/V[xмю!Э,­ И&уШмцuf š]Šl‹Tїm"=вхc>–юeМЌЧdпHиХУohT?/r(џМќжџЪ.{y(Д?SЁ:НОі™рƒфlWФrOФљeј j”Ъ>n"ЁЇлЃщЬtјš~лN:Zђ–ХЮfЏи\Ю†BЈ3:–!nxŽЫ˜NУ^ч˜Ў•FN№ё“№Q™vд+6фМ<ЯwуIm{@6u8UіpП–В”ѓ=ЃРТзpё•>EагžmоjAŒ7Фсe3]9вю$q{Ы3‚ІрйЂ&VBМЖ™ œўЈ]И&ЇTЇзHХ!•v…эФfŠ.iс‡йWїз$­јX|Ft eNнЌюГ&жŸTiušdД‹%§P xА~­нИЃмugрєХ.yз хнїnї‘‡Ž%б^i/ЃžY­І‘ЎФљЋг”FЫОŒХLNŒі˜ЙСФЂцЩ+Ц|DВџЬв; —МЙњЧ0|НЯC'jRшЛ$й„VћNyїо .rxŠ.;§ УЉŒАщЁQдйлEЙYо%‰j.ПˆŠЬїЇ_ЎП(н•йаTО№[о*љžЋ G+^У60фB&РQ˜йсю uT‚я ’s ќ§ю0 ЋefЏT:šКlь •—ƒмW1„мО<…YpnЈQbTи<’оцяž_щЛШЕBнŒgНЬЬЦБ*s‰y я$Ќf.є№-пT„4=пД{нѓc‡?[<ћчЇ,›–[пТqŒїЭ0[ўХs;Цo#З#ѕІ|yВ{шЄпИ)4{гUhŽaAllT\$:0lзŸЅ=cœ?ГЇ_ј1 вf ;`уЩ.n:"хiJЉ№…ƒ пqЉ‹6ЎЏІо'ћШщF\ГуpівFy;ёmћBљИ*7Hк—Б$yЕ/_f žѕІP!К\œeА/ЙЈMOqІNoЇЇDЪТђ2юђСs\ЏЩљ~ЫUН_ўYK'xdq<ѕКЙЃh˜ g”2[ŠЙТS=–Зњ)‰ŽэішЮ3^ЧSРdН›ѕЂcœ0wщђn ТЙ7ЁТm#вnјДRю•ЋQ$™љС{Œх)сYС“ЯљEYbЃ,ЊЄ`еynѓ76$ЕtИГe ЛЗЌ*(‰—F"ƒ'’^КиЊ> endobj 179 0 obj << /Length1 1642 /Length2 7264 /Length3 0 /Length 8315 /Filter /FlateDecode >> stream xкЖT”ы6L—€Д€Фв9twJw# 00ЬР0tI7"RJЗЄ„ Д”вЁЄt в§Ёл}ЮочџзњО5kНѓ>їuЧsнЕ^f}n9;И XCryјФ šJ&@>Ÿ?3Г џ-Чc6#м!p˜ј?4`ђNІBо)jТa€ЧPPŠˆѓёјљјФўV„#ФŠ Oˆ@“№Лу1+Р]}Gф]œП_lЖь ˜˜зos€œ БСš Є#их.Ђ- а‡лBРHŸЙ`“tD"]ХyyНММx@.ю˜РД•5xоH.fїKu‡пйƒ1~aaи іЖuф§РРЧќўпq№s…Льяh€ ірЛ?њЛwюЁXюљЕsм@>ОџСюЦЮжљnЏИпUы7О›Њ‡T‚йТэ~П0„@€|№юŠwјяцдь§ЛНМ<08ђЮpG/`Gр§Њ)??€з ‡# `{Є ФСсќ"№љ]УA@aЏынJ§2’‡ќрџ7№_„я€Э?,€"€пQўхKр§љЇ7QБ;ЗѓАEкAм]Ё ŸџBЂ^w—пћ§ŸрПвiыИѓ‹ќнђwЙўћќ{ЕСо`[М™IИ­D˜SmXЫYЕмC/юе!Љ1цUуtvnПDЋЧ!v ћ›ЬФ‰\J_'бьВлБьWњkПэЦЗи‘M/t›/§Џž<зYmЦ›ІјјЅp[ЎЎ‡—†л@vЭџкЭп(иНЕ§1sЎ›‡(ЁN>щ™WЗŠw]OйЗЯ“ЋКko„ея]•rЧЦY—Œ3чйdMP2b!Йiq8HіНяŸŒ‘ф|ЙЅќœ/`'^ ШЯl‘?с|ТwЎТ€п§е#*3JZєc’Я#,~ђЉLљН.š/gHАwНU‘1?1F:{dВ Qhуы€?ЭyЊфћфSvфс|ЩƒŸр8ћ*С?НrЖW(hкЉcг GАX˜ј1yVИєZА”„DšTђ№9CЬ{ŠТ_‰Ф єdQˆГxhхYЪЏр>п+КёМьd#љ…&ђEPY›гйŒ]­и9ј…oљK‘"OЏWнq%3g,“Б†W{dœŠ•ЦrE=‹ уutЛД+Н:YоЬ–ˆ,bйТETьл„т<ь”ЊХЇЛЋіУЖEЇЯ§<“•5ђЯ‚ЮОПcЬЌXЧLкђzхYёНw<ђ†XП}гН­†‚‚яђиФ™з#lbГGHЎ˜5Oљб|Рю ]Жbл§!A>ъВ$i|­m2K„ћšТѕЉщ+@ж7 ЏМоЉ%йшЖiЅЌjф#ЛЩэ$љ>я‚kzич­=д ˆхRFАр;ЬиЧАдеgLЬW”ь:oЊј)Ђол”<йЁДLƒq_œ’в„Ж:™“ЋжŽз…k&9йˆ jM"ЭфW_Бm@–Šь3Й[‚ыЭupU й;žžIa<СћПшЋ7вЖЦкOя$'MhЁŒ5y4 ц{Њ^Zэѓ(-џџэУоoЇAQ "ьуo{KвЁОвдk­їХNЕF2=ЙПўє,XdП20(Pф mVгШipЃЉўўњ›ї”єщ ­a@kbЫІјаЖдr‚nчх\ќнЛЗ‘[…J/b+!пJvЭŸЩYЅ~Й>!ˆъ5OуНПЊЄ7(ёщ@o3^"™ёЃ0[OiњC†Ai GіЖ |Pу\1˜n)§мЩйkћYlЄє’_QЃт3њsFАLш|ˆ$уg)­БЃKusБНZ`ZV#tЌmишZU>Ћ]rGщзaаfЯр‡бУVж?ћћйвGйћxЦ ђU]vn[zjGЪЬХš‘|‰юзbRлЋbEЕ›ѕъЛь зЉBw}vxƒйdНе ЉмС`[саТЄBѕЕ/Ъџљ&NЎЅџЙЙЬѓ ѓўл€Д 1­oь=мШcіBЋr%56Ћй$Mѓћ €бжїліЏЭлЖлјЮmњхЮоC)LђWЕ›к~Wш)ьХ,ъЉ ЋD;З_Н~pю9Ћ4иs0w˜БВo г&+4ЎИNд& >чА^ёип˜~–~xrЎеž8•rFRQLъі8­Я30™ЯљЌ…яStфвi‰eУgЯьЊIlГгНЂм>ќŒ7є—R­ЦFŽІїYєnќ*јƒОЭЖlАnk!„iћjžйФч:> ЅќZ:ВŒГY}C‘ѓрC)ѕрв6ый(*рGђ%z?Т}MѕЙФЇON.ŸЬtЋ€ц кхаmPћcљЬ^Ыћ­циMЎЖbё?>I­Z‘ОˆшсDЉWˆФ-aЄO=KФ™~аa@$ёЉzcЇ’г\0Qў…&ЅЧM0PB$Зюю =мXMџД™eJ хѕШќЙЦъюyљЩОЋ_м•ЛбчЗyђ\@>3KZƒЫј ~2А„”ь˜Ш<ьт0ž?UЮён,—qpn§Eg3ѓ›У'„ђCM"lьї".УНЩе…_&_Йuvщ^я“BчФTсїYЛэŽћќ€ф>б.hУй$ћЎЉЮа.TЭцОEi/йЏФ‡гЌъ5oЖ-э№ЖЄ{PЋˆBHЏ+ЦА*!zOіыТKёЇ_*XЖИŸБ)†ђёНлНoяЌ@‹MfœS•:ыM7Ч*хбaЄњГє$ЯА$†„ќКТ+ђ<>О NЛАѕЉбVUT8$cќq„Ц"хиsR •п„Я\:š2 еЃ8^е4а|іІыGж}sиЄ{88{Щ’[q•'ѕgzІ-’хIЊBЯЃьх,5KХщєхeЌљЯТž§8QT‰дЧъж}4њдѕaйDX;ЖАфэњYu і>ЃтfЛУD6l‘>ŽСЫ)zXМ$=kšе‚Fm’ЩYѕexЋКђd4М-К­CмўAЙ БfЧьa^II +а;Ў{уШі5g™ЕЊэѓO2ЦLЮat†5‡хtZ(ЅГѓЦP#SHм+ЯFмїЬп4K;1ф’„'#Дќ‚Т?17ЅXЦS*^жZKЌIЋmЗд­|\uh`ШЬSа‡lLwЅУэ‡{Ф@)=ФсЙ>ЉД†ћsљSћ LŠ Ьж‹біхВK/=ЇПWФм˜]ПqКЇ%_kZDЖЯуѓrl,аu‰+фїщ# ЉФУЭ)г+Ыђы\№РяЊЖЦ,ЌvпџЅ"ЬHŸЫѓ№lЯwž^Ы#џefВщ‘бяЛьA эыЉуЮŒЯшЩ–сЕВz†S\ “ТQ+’™;qЌуМ?юwЃТХ•&‘пшќ4У„™Ф#г"Њ^Yz­Яgg(Ш•eЇА:YцI]^Њ Faбю)ЩuIж ‰hjƒ>Žr™є™/лpЭбК€f8c(“…ХвЬbЊ-ћ ›[ЂB§пXгѕ‘!ЃˆEz(oф{M!јй?гвGгMђЎp/Ѓk{жЁїwШњ•Ц†ˆ,›˜†oQЇF>ЂzFјЁќ`Р(№э“4C9†'№ mzхэ›ЈїuГћ;ѓЋ™G+єЂќ-№х!ъZЬћлД„х~OFYlfВэ’4+ДGAіz‰/zЛ/jПтХ`хeЗ‹№ю1б'Мoа|ЅЛз„ё5q˜Сз~ђњ qЛії5 рFЭьЉн7§o<50 юS‘ЄД[ЏIћє(ZŠ4нnїэл-эјН8ЏФЅZ6F’џ еt%Ш…| f#Э;хДрz@рjf)њЎН+ПБвЫњD‰zgњъУћЁЇ*hLЯЇЦЧj::HЖ*_IYšŠpd&L"Buo ЦКГcaˆžуВдE;M1Кc0jŽfZРл6šДЬХ›АђMљ&oŒћ`"ќY žЃЖцY8NјЙХiњ М­aК/EсЧ~'ИО~lLuJ&Бg“ф-nŠa N ™ыцgЅšћ+Хф<ЮAНj/Њm$'7›Ќ|“пj:7лЖhG“'Ї+r ЩB4DмЇR*Ш #ЗГ"эё*ыŒA›дПsфK`ѓуS2ЪєlсYZ?ЉЁ(5Pb‹ъаЁZlyЅgВг„Š1‹х?8ЬА гЇ2‰— ˆˆу\Южш3}§ј‹•,№МƒАЭцшgXK}5 ЎЅr)пхRцЕ[IЇЇeTЁ–щtТЯ4 9IхЧ[ƒтiП…кА)›ŠЊ_,дь Vѓє€ѕ qPj-_Kжд&‘йШњ}ю+”ЃGхб"шГ—Žƒ8б(ј˜'œЦ;ЗоžмеCЊ­Z–[*ŒФш=b"wк[Х{+rЏшƒp§}г•УVzžДˆЗ›2˜ohMЊЬјы‹Н­Вtф6‡&n+жЮВеГш1=IњЗЯ­ЭBUєЌщ RvT;—ВІXGРъzжeГСЮYœяЪчЉ–ц‰ˆќ—Efс‹ЭЊZ:Xn$б‰Ф†БGƒv7 ќЮужбДpАчџј:ЭГypˆ‰~Д8LЏ7?ё!ѕЌyЮЃ–ЅпТ™и+FDю4dјVУŽ3Њў…НGrЫ@Qw ‹n^=]—ЛЪцЭ0ћ–ž)џRЗt•П]ДЦћа!ЊfУћ)yрнэщЋŸ(ЂВ’2ѕ+k ЧЯyv|r,uhM—I?Л=эњБ†0%uиЋ­жLxЋзћ7–dЋяш‰IпєаJsл6ТƒUnСеLЪ9@mmŠ-э0ўiЂв"lї#ъДЭŒ(‰ §€ЂœLЙJy‹’||p‘iаx–пЗћуIdxЇ“U,їкЋ9ЌцCЎmV ЎНr3.c˜\T’и&р+ЁŒ-•a”$ђ>!Шр^VЬa…з2аhЏшВЦізh ШІу—Nѓ0zџ Мжs’2”*Rt[ЋQ/^HbЩілМФtЫR”_дП‰%^вАiхh9И Г]ЙСdўъmY>-QUйбŽПџ uДлЎч‘C№ЭьЋјD|єyBл‰U№9lЪ—ˆa€qeWŒ6QМ'ШоуЈ§.I[гЎ{Јq-)шf(xќ–зф2њ;Јš’qCЎ|ЛЂОїŒxЙдM@—зК“‹ШЭ™Ћ6]DјˆХ:ЦіШlй:ЮdЇ2\„блт‘™bЌЧ…kЧЕ~ЛА-$9ž pЛп&„™“–jбp‘Ъжф3С@ёьКиъћЬ6:›FIУ= РŒ“gЄя‘cЬ(ЭФІицЛфЊ˜ЕД‡"“ЄfЧ І'XЈЋёuO?kw,–‰s1МKК6$ WxФёеб\%И“U0~C;тЈ‰ГачEЊ0уАДž7Б8SŸ‰sЛi6y~bŸbД]y%—љ<жUEUUЄrОСVnap”У€‰mШpM{Ћx!\Ќ72ХТo/ЌrџЖХ‘йSь˜I=gH'OVєЖHЗ'…%єBљжЕgМшл8—ЈqьъvZУЩЖrухœрєИu •Œ[†•j}G„мГ™x АDz|as15т—ц8C›•ЦЩAй'˜OчЋ mк3-,•^{КcћwЩh8Уk ДЋ Чo НЪёб1о)ƒlЂбОРЅsrЛаЎ Q/l\ž,ъ}›ЇŒ™еЬъ8VЁ№.БџSKкЧы+hѓ\‘N=1]Я’г?E&ЧтuWRЋаƒ7ЂWytСL?Щpd@фšє6?•jј*;2аFБ eоX–lL ЧZЗ#OеB ]њгŽyHz­НЉ~rN“†Мрw3ЧpZЎ)оDkRЖVЋ—I|}ѓБX.п}‡ХэЪюіК)СШ SР ЉpNBy;><Іd%ы’ŠSbтшТ362ТoЭU[дбнІ|zД|.=ОСŸЄДqСэ$.t\­ОъoсбБЎ5цaх?Œр[›œEђМє‚ђX‚cЁ/‡C‚viЯчh{ЊLгв|3&ЎC•œѕ_6L ­rUОВv^bŽMWѓА]С,nєОFzPкQЭc Š#geоUя˜ы'\\цё›@)Д7ŸVYvјНvJФћPcŸ–ѕ$ке?yuKЪL;Ѓ—эgйЕѕЖ*.^“AрЋЬКH;GœOhэ“х–Fп€o'ЦУv2љѓ‰‡й†ŒЭЛxЩ*xЦ€dЖz‚пмѕ3Œ7“ёФef БДвG %Б ЦS Bх‰ЊЏ|ОљліК ZЙдъфйСY bлрf%Фr5О$bZп ƒ№%F)оь$ˆЫК.-К›8=BЌаbЇЁГŒt-ƒz-З1VЪ3hˆћ'ыІЂ2‘ƒ”ъгЅ6ЭЎWПЏФ3Iѕнb+Мс@Тя,ЯLUЯy{iшЪnbn>z(й)[юD=М_dN?иУ~O-ў‹ќ3n49›?yї<›˜ГѓЦ‘]~ЊYѓ>ќD-{%•_:fy&Я]лnQOО№ОшюLчЇ…<с*(tьt)+Хzі е=л{'мgD2Дu‚KБёV$РYОzS/тrt2уoЈ3џ2Иx4ш^~ДWŸ- В\Ж|'юќh?+Вй'Б…iBвСЦ™q%ВќХ&жT-4<зе6œ#іByМлvbр–”Е`9 “.ўЌЌыьnБЌ(Ћш­ыѓGЖФйГдBКЭ3˜((ыќЪ|”xЗ™dGчrˆс$—ъh`Й‡РХмCЪЦ—‘ocsЂš SшР=л[ю=™[*gТ%с—-AЂжєЗ_СК(ЬйŸоŸч­XO7їіЩ№шыюь7аG’ЂМ^KЎVЖ}%щБѕxт{Ѕ%тьйШЈЅущзЅф‚ЛŽР)мКфњОpСМР3TюеВV‚Г:zОжщўШyСЭi‹T@iŽ`E•zЁЇЊD&Ѓ,нп?ЇєњФqp––—д9А"ёpkХ­2žIG~І рзF2Ч<~жм…лEщ1‚rB8Я#~up”ѕ-4”р–ММъNчўFЉ№уЊшs ЧЫ­ ЯdŽ"gKЁХKсЕx™ я5EПoЬя†п(ОЎ‡н~ШНuњ8іњMcIВNA(–ЗљЋ“{?†KaGAФ:S_ДLЦиУžErЂѓэТyvО/оgiь Uіl„tЎВМИxВZŸ194c•‡Чн +‹Я|иCпМї •7:•бhЏІ№љО‚1tмГvmv0№…ЉЬŠм$ЯIиlњnЙЖІšЪ–Ч7 ѓХј‰]Щя ?ъO/‘dˆIиmX^ь•J–X ЅдДЭв–[™3YЈМTбўp0˜`„Qв$EŒть)=+]оO”Ђ`ђэxx>Ÿ"јSы‰д›беЯИд~“/ЇtoЩŒ-VUПо‹•ЊNяJb6{ЬЗa­рџЁъИЂСЕ–tЅж[Oыў&›N f§“1ЈзгymЩTїwЪх;“9}уф>Ÿњ†Pъ†ёит:іA)‹SП4ѕОЈtрМЩBšоgЈ5|=њЁ^єЊjQЙЈ> N9\3ˆбЩЃ™ЬВєЉв(юХн78ХсRt†ІaОzЦY8ЩЭŸ ччСдŽёlKК)щЎђьgДЦIЕн+Б[4†J6Šќ5к!ъядj‰т–№.Ъx>t2WcЃž/(д‹wвŽЋЭ€ХNІ9Оqu{ёвй(Ћ ­P…’ s?QŸНŠИ№–ж§6Ѓ< §§bѓй–\ЦсЁўа­чЩ5EŠk%VWxC7K™”еКШ|‡ййH™шfіe‘†,Я,1#ѕм\‘ (ЄEVByPo&„—y§рН)Ъ"QЊ€/мdє3E‘в|@"912п4Ф–cВОŠ0>h •эЪSйЫ7~фzƒ=–}Ъ}єZ’ч"ДСЂ‹„ѕu4ВtБOуxюA6iцƒБЈŽdжъIk=зEё#M3Ѕнh­цjEЫ,!аК‹хЇћiф‚яb:E›УIтŒЏЫЃфѓѕeц‡ vf!XqђT`ь†~m:•ёn/*Ејї8вˆD8ъ‰ЛB‰S‘†\ЏXwЧА‘зіЧЉаУ§YšяђйŒ€%}‹гБн™‹ѕч7Ќ$ѓƒшŸ›Ђ–KЋЩѓWЎ$a&І ЂS^Чы)ф!b_^`ћУ ЋМЪ&сrkщTЯ+_е-JiOЧэњѕ8ЭQЌМЄФ№љdбфj•ŒЋMХLђНБЋ ƒЃЬГ;D}Ы\еjMЩУtяa™NлЮ+] џЩ1ј–й1GјљЁОЋИ,Мњ§ЁgѕмѕНЈQ ;ˆ›нТ‚N9р”Й”з Œ ъŽh3є1ня|hннн^вkК5нтO@)D1UЦYїЈT  `9ЭSE­дšхЄЛЙэЪУž‡њЯ-L$ЮэЖз'і”ъѕ~§LSѕXјRЂ”Ќ“ƒБР~`ˆФО"ƒœƒЛ1ЙyЪjkЎ‚ŠЊЁЂiкЄOE†FHёJGЙŸ­F™mAЄS5‹ˆ.Ўœ;§ 7Є’@W‰V§4гШpBЧ"ЋСLП#їGшј;шЗ4sъЪ˜/P-‰t.р…MtЫ^YЩMe@и0+ПѕWc4’ђУтZ†яG…й  ]зYЬщѕ6ЮТЖЫњУ§ГлDПIлхЇ8єЏОx~JdЅщЌъюско_ЛzЃJѓЄZ…­т>ъw?zŒoAR‰Ц1Ї5ЭЉ=-mжPiщСш8є+9э г +Яѕ%Жzz'Ћ',ЇAУљбЖы­СсЬгBЃ/їЕS”SE<зcоўšцNВxў\@ЌЬT$rІєQвТ 'Хjœ.>Г|ТДc‡Rмˆл7.m“1Х~ ‘VЇБЊЫю8^`Зuіш_\ІPyќјŠ…ќч:ра€ХW_”м6pqzжwКІ†m/E`b&Щu> endobj 181 0 obj << /Length1 1398 /Length2 5918 /Length3 0 /Length 6866 /Filter /FlateDecode >> stream xкTTTkЛ&$•nЄa†ю””’n&`f`:ЅЅ” I‘юIIIAЄ‘сŽqЮЙчПw­{зЌЕgo~Яћ>Яцdг7P‚Ђьaj($F$”ЈшЈšI€@A P˜”“гq†§1“ršРаюRњПЈ a` жvŒСЦщ -gH—IHa PъЏ@Zpь‰€tZ($Ь”SхъƒF88bАmўzpCx )) ў_щ%#:`Œ#ЬлvЂ Цч_%Иe1Wi!!///AА‹Л э ЯУ№B`0wкќ аЛР~#$х9"мл QpŒ ` Ю щŽЭ№@BahЖ9РPS ч CўжўРј3HєwЙ?й? !П’СЪХŒєA p„3  ЇІ-ˆёЦ№РHшЯ@АГ; ›і#œСіи€_7д”юРX€рЙCаWŒЛ ;Тљ'DЁŸeАSVEBUP..0$Цєч§ю а0vь>BП7ы„Dy!§ўр$ўдУUШ‰pѓ€iољ‚5‘ўcs€ab@)a qЬ ѓ†8 §,oфу ћх§4cјЙЂ\p,XУў‘њЙƒ=a крїпџ>‘‚@(‚иУHвЊcЭ0јя3vљh„7РˆхќљћћЭK/( щьѓOјЏ§ Љjн521цћјoŸВ2Ър'K‰Аl–HHџЎѓїўBџЫЊFќЙ№Ÿ’šH8 ѕvzёќУ ю?šсќЛƒ. Kf€ћю[Х€ьєџVРЏ”џј?Ћќ_мџЯ Љy8;џrsџђџ7исьѓ'Ыe V:(Ќ:џj ћ­eссђŸ^M Ћ%ЄƒѓпcDИЋ!МaP}тј›Dm[о„щЃм?П6ј>Ќт Nи/Š;vWП\0Ќ ўнR AA*OXLFЃС>Є@,С„ХФ~ ЌDЁ0я_м "Ql /GЁInTrїpqљѕСУРМ1?нЄџjё@ЃБтћElџПЮП”ƒyУ Є&Q™АћЏУšO^)1y Ќ ‹’їьG›~Re№\ПЂ"{z ’3­д>ОsКHљEИшВЮЩŒшdГрŸ#MћЁК™nПТя?B)wіХ]лCxэn[›…ъ@ЛSoаыuЈ8ЦCЧяЖЗ:‘ЙЁ.{ЛОќИЬq‡ˆЋvK o(.†ˆ^RR„ /ЌE)ГЅ\ЙRilМU“У}_qшk‹кЦiњ›wТbЫ=3%ќИˆЅtІЭMrзЛ‡™›ђiŸ;ХякЦ8?uЊ’.–jкЁ4Fы=rмž||ЗЭhПс*иYSфз_МхйŒкз„|(Зд№z‰ЎŽpЛ”зЬнZм~ БЈ@*4(ˆxЫ`eо7JйЭт”э^Бѕ„ђЩЛ™Xsфaо а7њoЅ &њ†WЇ0рMЃ;RОy{3[Т›аеМм/ђ4К,хљ9§ІsЅяYmЂжM„п2КЮMЦх9yЫRUdlњм%tt8тІhiяvЏЪŠ^S›DїЙІHЪ“Ш9Юїmc2їsнqжы ѓjwVЪм6[ї*­Vz Мœ?уuЧ;иЖЊ&ю ,mОЙќtY™Юhц 0Є ™Бgўjs‹ќЖсдчш‰ЎљyЏЙ–:i+№R=с‹њРЃ‚ЗT% S’П‚к ЧхƒF­1FХW)Bˆ…Ё)Њз№еЫxЏПS$ xюЪЭ ѕŠ™іQL1Яg ыыТC^dX‡4}VЙ™:• #шc,ћ<Ž$БљњŠYя:l*ћЛ|lЩкiQѓ§nЎOЊbсz/гс5ГžъХ’ЯG—žyоHЖWЮ4/І+!ј2{‹ЙŒkђщn—wУСˆ–„‚ШЪz’œvѕгиС#6ж‘Г№ž™=кƒс’€дз;:<ˆnzђLT ЊГЎъaЊ…HŠ5cšЯКМ"Њ]‰иќƒ$ДХћZg •5ѓ&ЗxOЈ,KЊЈoЏuНКšв„:ћм№лў<’ВцL)xЋъK€Ј—^пЋ—ж#лЦAW]јЭжДmтУя?()‹ 84~ƒ=pУЃ7~‹HsФMЄ‰ШПјџэ^.UкАоЌ№lcяЙ${Їj‚žj–|;Wжl—u'œzDfюйфv.9еGЁ’яŽЃъХa Я-h-(ЭЩ0лwLЂщ?Žgvћ^ФХX)ЌfC`я!)J”эЋp!fi|g* ‡mЧЩОШЖ i?}YПћ’эe4\›=бъm•Зъ@ƒŸMŸѕjёЭ$у/Ёшf‹ЦFаЧ^%Њз—Ќв|=œeSЗ”+RъфН—|“Ђ [јžЯрхOГЦюЪЪ;nv–ЦѓО #NеuChЮŒ–3+эHс~TšxЛеJS›:]пЗдX–ŠзЧМяњLTЃ1ЇЛС§imŠ2ћњYє]lO6?#ЉNЋз%ъ\ыTEc!Ÿ„КћІ wУ…­Юм:rЊзe‚8ђ~2_РкЭ?UфцiнЃ џљк­ј’ЕuкЙ3ВШ›Œ1ЏyvEІˆ&/ВVМDТЅŠ3 =HЇъGV"ьеђжОЭєЫ&ƒЋt ­…yŠ_šf;о*ƒfОр6g-ZYŒЏДіЈqЁOшГCcбЇќЖягkyі”ЗїoЋ ‰<)hуpк™шя7žЃц ZгwГŠІEќюJ_к!cолФ…<4 їwRЏvC…sфа‘ ˜mЇГ›\[О§p,­А;МR^~Џщ^і‚gЪфЕіzгћЙsЯžˆщЌ{Š`wьљ:ђЮD4ЎпЮ6!%И()efчЃ^ЛъщЉзFYпЧISVšѓк>тмЏ ZДќђ*HFMoуŠL`w= ]|КT ЃxY‘ЖrŠ3bŸзњФзoштј4~eгьXiќЏF„зxyН0жF<ОН7AЖП–VДаР2LИЪС/0Д~ъ§•ˆў›OяXё;y9ўCГ5пЉЏ,Њ-GKщЏ№гЗ`ЙcюžŽŽv;Ђ„ПdHP*g Р[ЭSœєхХ§(1ЙGЄ˜e^nžЂМGa:Њ…XйOђ’эo54мьЃ oœXuХWїѓ[|5žk[<НxИДВ'ЋЂ^Јгє‰ЯŠQ2ЙYЪЌ›ЪbИkє<Гэ.ЮwЪŽŸуˆЛЮ ‹€‚,Ћц]У Ъ§LJЪ"›ї3…мпg@mžй:ИfчгJїГ™\9u“льЙažГ…`§рuёЮŸЎˆўY„ЇJEŒ>ЬwEэJх|м†ZшВ‘[{щ…oOЮлЎЉЫ™ыЂ1>ъзЙG;/Ш‹wЖGГ—љі/_Cщuк&ћП„X\0ћ*чЏ…*жY+нќиzКЈЮƒyЇЌ2й+<^—gЂy‚{йGdоОГ9IїpУЈРAЙкљ е‡8)уj›Z ь”–ЎжWgњ]‡cЇ;žЕ'эEуIO$љцЌЯЗjG(TŸс%бKГо‘)?:Ы1Нф0K;КТ1)Mgп'хКR­f}Њ<Ф:ЉeР+n)`ФћU”-3nдЧЧŽKЇц7ўе2тŠЏ§:TЅњJЗzр СFьpцXі+ Ауд ГТл‰­нЊoП\Е.жоŒшЦПBЖЇрШ#y{€FH|њ-%‰ЎUГ‹ЙQЇ#ћ&п ˆылZрч Љ јўРTvtБ,!ОўƒЃUД†ћЊК А^ЌНЪя9”cфqя3ЊAњуОм^KjѕЛ"юУўwƒ@СЄЖŠxа<ЯUшwк˜а[§š„ƒ2MСњжt”-}5{ ДИmOЮ??iдФчOfяUШx–єрлŠНrі№Pяљ”ЄџмЌњpжќЧ+™F 2RdЯ!D8jЁТћІй!ѕs›‚є"ЭECЪъ ZЬ-жЎEZЮ†бу'aб†m0KпЇйАAœ№@џ‚#Oъй-2ќћgсФaн[zaтžGОљэCIbо МЋ!=эаГ”ЗбэыЬфз4З6 )1<šiА•Ї ~@2м4„таЏšsl‡лёфw–vгOIDгnЗ=ЁАОzb@i=ЂІYnффН›qпС>K# J,Ш-MкБМSšЩ,;‚—Ъ™яъжVr(OєRоfУз›ЦЯ&qbЮXG•зEд4хєЮПФh$ЭЉќž<б“q[~`-yЪAэS_Ї…вF“ћЩСлk_rpдNо№…ržђЦ\Ѓ<+9У@нsi3Tpu}!ЕMO П‡ˆЉMwжgС›Т1,уаRfJмшk{w_ЎЖ^щеaАЉRuIКМ(=щМ19-VЃ§ГВ$(\Щ"ѓЅ:Zd=еШАпyЅРƒыЭ'gФY˜Ыїњч[٘nšмB-яЊ'’SНcЬГK‚tV~§v/-iЂ˜nжrn4ˆtD=:—шДš@#C"tЕnжl^Ф яЇџxЎVцєђѕе*‚§VНћmЉ-Œх 3k|еDІ0Ц‰їb “дž’“Д”ƒŽEЂ­=s“Нw’е[э Ž„а[Zк Z*ъ^*і7і…ї:Ў1яД6Р!u#cйшъ–ŠЋВЮq;Љ bцw‡хЎюY’*Fхл‰MhИ/†|?šЃщйк_nŒp2aўшБц№)(љGNЬфі.Qч'#ЩЋŠЇmЖzš  УB~mЎјњ@бƒєофpІœ–›g”Z Ѓ“{'aScэЧе†ЯŠWИВ™|§ОизМƒ8щлі<Р™&цTvv њ2­hŽ•Б…‘…жЧ”pŒёП` )кzўY'kљСmе4BЩŽЊєЗч:$^ЦЧ™[ЂЉг3нќ™‹ˆ‚HsЛ…^иДЕ9_œлЁNB>oнГРFІvпЙFйyŸЦk*#ŠЉцyLйwЌп-Иx<‹џ ЗС *hd_cA1бј”ТV$к$Зz›с9a5“ЈСћ#кќз#5›ЛKзЎ‘Ѓ"ДRуM;nЗб4ј›ZpŸ†mŽhh“є)ЎEI@ѕКђжњУмLc"Р ћ setYвюtœDžЌМь:В„Ќi>SЫїЅt5­вzФт'>^АJŠ>§ЄЭj?NгС_с ‡ф’Єщ;я-)+gЃcTр’aЙб"W"2ћƒИР=чuцЂБ—п$Nйs†ьƒо+ІАпcJіrКŸA“4сh:Ў’с:*!ЈЖ)pЛ.;ЬНstж!Іо~5 &yУі1xШц*гM[h*ŸsЉЛ+Bќ•­'кDo–67‚ї1œ0e=;ЄФ1tСA(нЛ)ч•юшзž1ca…}•mъ{JЉoЙ’˜kнЕ 9}Хп:vЌ”Жc ?p“Hп !{lj„Лš”џ˜|ё‹]fH/*QПчЉѓРЃoF~МV@ЃЋƒЌœНЪ3ЋЯuŸ“НV &ЇК2\~Нао­N6ЋЎ$Ÿ™?Н“ ж%\•? D7‹N%M(2œB[KR;’з=+ФЈЋ№63Х`4нwр|u9}оЅ{щЌY‚$ЫХгё—˜рЇГ2Њeк›нж™ўe†IЏ*#ыЗŽzлˆк wOоБTЎЎПjoъЙ^тМ~эш5гiњ  їИh?ЬPќэiєк.,ЛЃM7˜XймШсFкТТЪZЃ#pкPTHTvщ0œ&cм!Л iќbзЌР–“ ЪцQšМцЗPtВГ zѕ<ЁДШWŸїоЛтTУ)ƒU(яЭugнЏtгьЉюїESуyЕxиО)ФЇg.а‹МАmsщ’УњМtoяАЪ~ИœKКЧЅIЂ{%ЗiYЁЪэ~Щ^:iќ—ЇcЏљВjs”(пŽВŒ s—›ŠХokŒ$ЋHMК  ќЛ$аЏ)дO9Ѕ#їЕаЕВѓмЅъ6неUоњ„6Сw—чЧш:ЭЯЬУяМKb?ЉOц V€зIАІЮ<] hH4{ї ѕ9j]ф<“k™Я(ц/q˜э}"Ѕжš8IиŸxBэA:А“–ŒX!vФ!•вХP0А$†K…4y kюƒŸД‚НH!ўЕд*Н–ЃЌˆш)иnшеїьЧ8п_/ЖіШ0Šј+%јЊ-™‹~3%š6dжшOгZ*Ькр МЄцЬ,ДЗlЃаSшк{#C“mрЙа№VЕL,O=Ыtе?XfЂ\S|;/й Ы §љющЁ{€p,ƒп=%/F­M ‘йb< BФ#ж€RЯ(УM,СоŸ5№ЫYЂь†№їv {Ѕ€№йщŒ/ДЭЦѕФзП нрТГ“О9<Оз‚WнVPФкˆKГ'щЋ‰ЫqЄЮџфr@ЧЮ'@}Г “Ў_’8G0ђєRbщюU6Iхў–xgм>С92<ды0mЭ„G”'щнК0C…A …l KѓОŽMJoir'™\ж, †н%З |ЛXЬGТv­uQжEНС3ЮЧ(%_XЭЮ к(јjUzЉYKfшNбЇЌiT;1юЙOљіЙ&ч&‰A““Ї3‡тx шцКлBzЯgZб8ЛU•ющЛЗžё&tѕaOє‘]блXБ§qZЃBЉ Wи{—†•Ќ“wi–фmnS`ŒЮЊŠЪaюУђф#р{vєS&їŒ!C•ђ5<ЙЮї>§dп-ЧПлШВ €8^‰i'ЯыPPh Ш_аN$knу€"ЁЗ2)ЕЄЖoЇk>ТПU ~уПP сmRІРх+*Ѓ™S3EB#t† Ь=вэѕёыBЪ<ŸЎCltœФ,PнЈдŸ˜‹ВЋBпУŸGрв-|Uя”?ŸЎљ2ХŸ}уљЫДЇ>km жєMОы€ŒžWј}*••Э№м:žЋ_ №<Œ”=Л:ˆГ—в;’їGjM8O_ѓ€=г>S›оŸЦсГ1R2™cВА6MЁяœ|?.ŸїqˆŸEqtS?_9БЮ”—ХBЅЏ'#Z/kг№A0Щ`еF№ј]cШаd{#сЊaXЅиа“c‰‡!Фу=Д:2xщъ5UЪљz"”ЂгЬqcw №фS%ž.Ы—пЙЊFsЇоzі9шоqѓІОgWnEdЖ%Бќu›д;FŒЎŸcОY4ImВєi€˜вК%4—ƒH‹s№]b| §ŠcЉг q_k\­"9ж4OЯ#1Vќ‡j6ГoNк“ЉьЗЉк?вЃ„Кю\d… яљ&:yєљ_ѕ›;њpžЫШ&биAычЮтЁDЊЬ—:TЙг–ЬбќzXQЮGWїP7Ћ6Џ‚в2+щС“ьYЙОvХJЭјРŠU cсWјіДџюгАр WкМ,бQОhЯБщ ЩЁХXwh<у—” s‹ќQb4G.^—ГVL›?pы6ЪŽзEФžЭ{рVzj$ьЏ=CD[tмжщ›ндиЕq"ОIйBЬЌЗušL{єdFEхCыВOeаV|фтšњДii нљв НV>ќМчбф†Ьhtу-й; ‰Jr/ЕЁs|Чъ ЎЏ{c5†SOr_щтрВ8ƒЛщdёбJ№€ФgЌяJ уЅ’PzTj–зOrЃ[XДпУЮЙЋфѓ7WЄqŠ§1^e endstream endobj 182 0 obj << /Type /FontDescriptor /FontName /EJKTVU+CMEX7 /Flags 4 /FontBBox [-12 -2951 1627 770] /Ascent 49 /CapHeight 0 /Descent -600 /ItalicAngle 0 /StemV 80 /XHeight 431 /CharSet (/summationtext) /FontFile 181 0 R >> endobj 183 0 obj << /Length1 2045 /Length2 14795 /Length3 0 /Length 16037 /Filter /FlateDecode >> stream xкіP]л∋тюœ…ЛЛЛЛCpwмннн!wїр<С-ИЛsйћHіљпЋКЗЈZЬЏЛGЫнcNrb%UzaS Б™ао…ž™‰ *//ЭЬ`bbe`bb#'WГrБ5ћŽ\УЬЩй hЯѓ Q'3#—™˜‘Ы‡Ё<а ѓХРЬ `црaцфabА01qџЧшФ3rЕ2Ш3d€іfЮpфЂ@'+ K—8џyP™P˜ЙЙ9щў^Ж3sВ21ВШЙXšй}D41ВЈMЌЬ\<ўЧŸЅ‹‹#Ѓ››ƒ‘3аЩB€šрfхb P1s6sr53ќU2@СШЮьпЅ1Р‘д,­œџЅPšЛИ9™>ЖV&fіЮKОи›š9>ЂTЅхŠfіџ2–ћ—рп›`f`ўЏЛЏўЫ‘•§п‹LL€vFіVіs+[3€Ђ„ƒ‹Л РШоє/C#[gрЧz#W#+[#уƒПS7H+Œ>*ќw}Ю&NV.Ю ЮVЖеШј—›mЗ7кй™йЛ8У§•Ÿ˜•“™ЩЧО{0ўћpmьnі^џ!s+{SѓПЪ0§тРЈnoхјХLZьп6"И?2 3;'+;РЬ`цnbЩјW5ГП•Ь‰?j№ёr:Ь?Ъ0ѓБ27ћјчхlфjpqњbцуѕOХџ33РдЪФ`lfaeїЧћ‡иЬќ_ќqўNVюІіc0§ѕїп'Н3клzќ1џћˆЅ%dх4Єhџ]ђ•""@w€=+ €ž… РЬФЦрќx№љ_?џнџTџЗTЩШъпй§УЃДН9№WˆПЊјиОџTтњяж њїмPў7„№ЃЁЭTњ_—‰Щфу‡љџѓќНфџ_ѓџххџЕџџoF_lmџжS§ЫрџGodgeыёo‹†ўтђ1ђРБџПІšfџšhy3SЋ/vџW+эbє1$ТіNЯЬЦРФі/Й•Г„•Л™Љ’•‹‰хПšщ?ЇёУжЪоL шlѕзХѓБŠ‰щџш>fЯФцуrqў8ГЉŒœ?бхяу§‹Э>FэѓЗ7šў5“,ь#''#И–ј v€ѓЧ№ššЙџнѓF{ ЫЧРGЭ>s м_ЭС`ўKє/т0Šќ!NЃшт0Š§—8™ŒˆР(љ‡>|ЪўЁ/ђшУ‹Тт0*ў—И>|*§ЁŸЪˆРЈђ‡XŒЊˆ РЈі‡>тiў—И?Шш}Ф3љ/БџEwЮ§_'ТhњќШСьј‘„љ?№# ‹?ћѓЁДјы]ёбPL>ЖТъј‘Э?№c3lџ8јˆmћзйџб$hї?”бўј‘№јпсOmЎ>Іјj>^nŒŽџРmћGЊЬЉў‰ЭёсмйжШйђЭсђќЈхЫ?№# ы?№#uЗ?Шђ‘Кћ?№УЛЧпј?ЭlђХЩщЃлџО…>:§?ќїлЦЬЬнЬюз"а„7иК>ИѓЁVЯўїфyњƒ §TБ>ŒЫwёYƒ­Dеœьeй ‰_ƒЬњж= "ŽЙыKз^Л DlwєDDЦё‹яw ѓI^їј$‹Ш­ šЉ"„Mф]1ЎцЁ`э”ЕЉЈЛтДXйдG>цA…CdЖ9ЋwT!ѓš,:\щ–jЅЋмСэўZЈЌЌˆЎVщеъHŒMћУа%кw^žlo…знн"ЫŽ5Qі1hбž› Ћо™ХOчЬŒЃ&uбЂžnv[wо5ю[zrУvРŸ*ЯN;ігЭ%диh €(їыQOdp 6C{IеЪЮ`ј-a%XМ)HЙBўЗЇ›ЌЩ!`'+œky@єгБчы1X&@ЮЁбВB “WcЖЧ‚cИ№;<˜Р/КїKі4E6;aІ‰WжцХ6ŒЏnкBЌі]4nд­Ћ/ПЇх“w…-}шбWЈb1”G‚уЂ;…7oкђЂЈчъ№цO:Ыљ`ИПюgпАZрс^gѓ#щtНП 0/D№5Š7ž†ЧЁ›Џ4IˆNqРv›sВњ7ЎŸ%œЈƒ“‹ЩЯMYЎкмЂ:ЊцЄnХ|n/`VrОkЇ už6ж1[ЎВ(G‚ъa6юnЫ–Љ0ђ6ьЖŒ)3іЃюsг:7бЁ`ВNОЈзсєxА€COЗФQm )Є€єѓAsxЃŸ=2_д=/Р}ЧГeѓд8М>АWЙоь!0ˆ1Њi ѓєNMHбДbhсž ŽЮШ UнpfŽ‹ГЩЇг6NЬМ№oƒ1‚a3к9B‡D[}šzb>ЇYFE>бlЊgsf‹=g‹яv3_’jxв!вSПыГЮT‰єeЄ}†пнХ:dІЃЌйrэzj­&:дпфeхHkмЏ˜67ћѓšВЉ• џbчЁлyrХ 5‘ЃY]фЅѕœЦ„жŠЎAѓDД|*Vžлpћ.`ф8dЬё›9FњЉmJ…"DаьЧТ}ј‘y[3п…ЕьKь™MЋэн:ЙС™Jї§`PўяO6Frу~ИЋщjгJЬ^?аq1ьѓ#br%–НŒеК&:ЭЁBЗOѓЋМ"фf)Т{{сЦДrИwЦJ7ŸюЯš6а—wеђŽЯTм2чЖxрТГЬкЮсЏ`#к№ћАБ<žO[‘|‚ѓУ\і–Е ƒкI8§Џ]‚7ЭŸ|zбіf’ЉkCЙ TUцДR<>Ёёe;7ВXЇ(ъwnЕЃї"ФЉчД‡lz ЬЧ0цWж|Еnќfš"Џє)pXљdКяe‰Х&‰ ­я&Vz!dІ|cŠ4~ddeЊ=ЃП)дг$у€`ХЪ‹_ ђНM˜Рьљ™pјц|†ЄJжфpЯюFрeєE 8У_Lƒо::ўфQьџ‹дŠ,C} пЈдПо?‡]™х3+vN оŸЖфŒѓУЛ‰†4N-8•“<ЩC„KˆЉПаZ…Тq(‹ž‰•бжлѕ;џ9СЄSF‡ЋЧJЅ>MŸ”ьЏ:oн›ŸкnшMИђЧEЌt4Mƒ‘Ўь> %мЅŸjѓH8Œ:Q‘ЬД3}тС9ОВјШ1hдbMuDCЏL0–qєњŽG0]йˆ$†Нйž И%ЎkёmKiЧдAИЛЂuЁћјяJа“e‘dcS5yкˆ)ЋЛ№6 #ZЗциРя*рмБUЭAБ=fмl4ЌО[ гdZЬ†)WдеУR•юѓŽд*#Њ‹:L ё> ˆ‚p›RHшPEСО„<Ц?– NaЧ8DžІwЖмT‡@ЃЮš+ТhЎџл)Я+џђШДvŸcӘXMQУ~‹0:[ўиД№6 Ž~CN[уs…ё ›VЎЮг— k,ёy›zџzb­яНrёнЭУ ъiЕwY;љ0л'5)ќћй7ЌA3ѕЁЁїчaˆеьH`+б”З F/cwЯГ-`MЁš"7YrAYЈ)”‘ŒwxFєhZТ3™ЌДл_§'Ѓ,Иэ’9‡Луf>Ќ\Н›O] ”c љгŠqŠMRЭ‹vа§GГuѕYš{QНjW:ИЎGЕ§'Сі\ƒ@™fТG(ZЂ<Ѓ|,Яе ѓє:ДД%siš5s~0y4,ж9jђЮЫЏе(IŽеЭŠT=КєŸ‰ЃqseрЄЈё”ят›”йяŠќдАх|ІиmаNАяљ•н п8Би_ТIёxR–ш е Аф”š†Ч>)ˆVяЉЪп-X/ . Є ЁMп‡џFј}ЩJГdMЊ9#vФuEv5ч}•Kм"Й16йњ†{И,—ФkрgЊœ*#Mжмž: =BѕЫNХё§ОHF;бз|œ›.ѕGУі'цЇЂ9_7|ЧёW|U:HAц8С јыEсљяЖT;r mг.љDрчъёhg'АН8пь„fiАžуе0ИуWФлРJ4-ш—SћЂ‘kЅіА‘ŒЄ I`t=‹_ћQgчƒХ­5 Нr˜#Ў™'‚дъR4ф^gй=4eН=§gЏwв.М—›] ‹­ELC4јЋ=Б.їЊ-Ъјvющдw7Н-АОКцП9и;Љ#ШkhVdн1ьЃkгЛdЄжVеГxц,\&—€„СёЉrИ07йЎvgюE‚фЕƒHcЭPч|ЮИž70CGRuA,Q7a?™нŠ ~gGv—›ьNlі{§ЎPJ№C ušm>фОЧ"F•8aŸ_П̘НbЕS1=ѓ5кqрWgLаіƒг:L-8сЕИЮWz№Ъз–“[Єƒ ђЯЎдпqNеШG›Гd%"№r`Œ‘ёћ<­"XЗ€Хѕ% IМмй)ц/LzЮ†p‰7)о™эITuXlyeT‡"ѕЏєЈ6mЙCЉ6%[7ЯВ„еvQkBыХТ”{KНŸлчzб`шШTЬ`эцХtРЋbzc|Ч/Њ/"рЁДV“„_Йь„=нюgC˜v+№’ьfјbCЭ$–w;ltоЅaЖтˆJ–"љ')ќШЋм№цШBŸq є oмЯюv[ѓ0Тƒ}љмчџўІ^JNѓФЇћѓКYdo+i9oьшЗR4™Иu•яаЁл€K­UљКUuБLХ|nЫЫ< KНфћј…ѓv{ŽuˆO!œnП‹”шєљи#a#œижo@ЧЌ—•йрBx%_A ^їбєЋw?ƒWšIm˜эSlQ8UжВŸ(L:эй$~+ўЏЯ­odŠKЃ2фF2ёŠD Љ;ъOыХЌ•.*П­Вl٘Шнmˆ_E3xќЙї Іш;|l|хf„іO+ћЧ%љѕПYў<ЂЖЉЩjГ‚х2žKxrжџєр.љЮ ƒ|Œ­xšљ9ъЬКfGCmЕѓ"™бyЎЪJэ“ГyrcQёO];f`эžLиФо„ŸјQ˜ёyhЕуѕEшЋњБtQжа|:„S—юJsршћіГŠаа5qЋнЩє“ƒрЩє|uMЖљ‚ш&TнзХ6MШ;‡аљkЈТ Љс|"Њ_zђЛ8KЈША(wЋёњU3 Š)uЖkг?<јёoЪѕ=йХЃp<ЩоЧMNз™ЦmT#тК„/Р,ЫœœсCКТ !e&“оlЂ:л&$Х-ч)1ƒBEш›еx†)9;BмQФщ@]!Й$#Е4=јdЯžJ\šО{uоPzёмп!IР5уэЕінš–ž—.–фno'ВюŽЌ%›Ѓ.eUY‡ё?Мg4—ШУ™Š&јїФ„jк“ЮYє7JxђЈЄ*Э–•&жцykю/ћиifв_6Щo Oy::ћФчFџzpnТ0HrюdKЫн‘я FVLяџ–f{ЕnЉ+ih zgDШUœйBFЕ~5ЂЏЮŠ^у˜й8{Оs- IђэнЕ'Њѕжњ $F0=яiu\˜`ЎeЁм™Ї[oWŠЅ:ЄЋ^аЖЇБоmї DЉфў†и Іhхˆо…9і'#.уp‚1_hJвъЋЭ3уoЏ ЈУ™d`жT>zpмфјЮI —$9j„УTчшёP‹ќ%Я\Ъ“§k?™‰Њџ1;qEbn;SJфіВPqjГяЎь)/‚_СUућЕ3AžўQ-П…шEaBcРšруСё’'4oŒ^RЇ“Џ™9@*Љ&‚бх~рњ€Cє+ЇЄEl[њу(ђЃ?7й-єх№16YM GТэгˆЅђ-q,‘Y%яС8’џЌцw†rSп{Щ7&ёє­)Xтu!цнц’wЋкH G„„‰жšoЩU(‹ћХ  nz‹КйЋЮ,Žvgo‚Й ?Kd›ŸюxНnoекиQB{ѓњуЪ ЯчQ6ЁКmŽ7M7нћЄ-Хљ‡ƒЪТKєѕœj‰Н>ˆэgвЯЇY,k8еЄˆ%aoGпu`kгрMОМzДЉЋиl‚Ч|‘4Eр}› ш іюдRšЯзшњNuшЙ>sdчхк; рB“7q™i‚"–Q7›oРыb3ПNŸ•sФF@^Vж )Qўxžƒ№АvZ .Ќ˜GUъ„В‡?e5д‚HПqсnEчІ8ˆѓtЛхфЮ`‰› С'х T№KпF”Щ ^Œ&kQЋИŸЏ'ЦƒКУВЯ0,[–“ТД‹Iсх§b3iђэkУ’)Aи m=(сq„РБє]k|“рхг~Яћђт;р}ѕ­ev§FбЉчЕ”Јц\xајЈsИЈёyзЖ’мжѓ†)гШзy?ILITMVЗyэjOPœєRХ~і>…фhЫ†t-я&QH5џЩ[žњ§FJ У‡.yжU]PŒк<ѕ\Џ8ыЕј,Ѕу"Бr{§PђЧ0j_$HKІйДќн–GH&Ѓ<wmKiП!ю$d‚ "њ—ЭЁUсŸёcJv^(мNv8-!/?b„фŠŸŸ' ЇЊ“Eh=Y„ЭэюЄаLSiz”‘Мxъ' вБz3ячєуšmТ xЙ0Ў™:ІДБpящЙЃnEBъ ЧПQ$R\`SѓРŠјныKкПCF-#ў,5ићЮџž„ђJ›V3ЋШ§;TиgЛ@~ЫC™Žпн Кя›:dG\яF‡"L˜ЕШђ—`ˆ`№ўo1ШŽ|иБф_=аvšЅЄ‰ЦQFяЉоnдЈв†›ШUVFFоFCЮ]є 29j$Ќ#ТB{B]ЇXлsŒPP!`НЉ@ЦЛ8—\xwј”ы[к ,ЮцsЉiƒeОlfWgEџЖ 5а†›і4S-чЇTЉиК SMЮпŽ*Г|У„[ю№ќ7єйЎс/’г>Екmgž&ѓ75гєдV`—v‹T•r™Љ;šQ_AпœІјы{(˜%д|Фѕ.;Y 6ЪTЩё)ф[=bŠДE‹“awZKcha…н0e‹рюЛјU йАEтЛЖšNa|PloђcИzjсО”щЎ5Я‚Ъpж›!?r‹З’§њргНщkMфP ‚oе PѓЮ<}GPQСВпёфžpC9чKЊ$i?їŽч‰DзmDіёЗТаPLЈq~уђѕ ‹'MŸнъБMщч"Тl&Њџоеj)ѓмRк—_Heѓnќ›‹пл%Юd6‰ э;“mЫymуЄ3ŸFЛHх0ѓlђ} QœNаU}љРJУ#ЊŸ'=hЄdѕ[ƒi%8ŠИ_вѓХFрOЈЁВт?Й6AІЦ5њ…eUCQ@NG3ЕЬbЌ2>уx—њ–ѕйZ5MEУPќй 6Ew2їDї}дЫи­VœќЪq .YI ƒ3Іт€EрgЉfаХФИЯ0”f'эDšlCgЯЫЂ„лўWgЧ0ЕЪnЫ@ЇхЃ+Й$ MэШСЮŒРŽEEq“œЉ@tD˜,tЂа3ы‚ю™ЊWAЅФaщŒКр:ѕюМŠ1љЬѓ20КХ?§@ ’qgpи—:V1юлзa-7іIF’ё-o›Œr*32Fьu™oн’№­›I„УЗ}ЙјLђЗ@RK‡ЕCђСЋп є*љT%4SOАГх'#,ьс–чэов ь_њ ••ŠюЉ /ПІ)+7RН@пГ%БcЇ4ш—­bШoдУ `и%i 'U$фЫ7ќп&,vbzЭ—7РьСп@Кй‡˜‘M+‹лNeбtфр`”ЩT2Ы”Е†-o)У<„э•єєUб ŽCЙSњѕїчД(эl>Ї€^хћыfa FлќОяЖMмDaрnјџ `В.езЮ7uwСќ‚ЙXЭюМљj=азыIIЈoЬ† ОШ]8 к“+KУ_WŠђlФјM€k$ІŒІ,ƒЃЎ2)яХкПюЩ$4ш• Р Д—РU'ЖжYЕ ХЂоƒСг<фz№ёЈ8CJ9„i“ЏCjзltЮ ЈL‹fЧPЩF‚y(:ŸžОј.М#v!'Бь‹GнqK!ФјАйPXОTL'ƒИ…DRјмэˆ$ŠЊdߘроMhБTщЉš:|Ÿ IЈшж&щРх??3гdЩjињ•;“$5Šjžu-<“Ÿ"&Ъ gќ@ e‘ПИEB™IОёѓmq=GgU•?*т7вГ>вДT’cЄYrЇ ЋЛtƒcЁаЃVZЃ%es%ЁКёЅJђWbWЫГрўdДЃ8ўH#Ъ%гкаuбх˜ЋŽг—ЩФѕ1ŒјD2ыКЃ нN‘пЄ~Юљм1МБgW^АœoH'qŸз>З}ІžћtwЯšЏh№ТПє™EnѕЖцs5Mф-џЭ #KIwВ­…Y|МvъЛhэГ­‚š2фlМcй{УB“Ja@VŽ‡Щ',xГїWg НvgI)Ф6{SYœvФI'†uЩ шёTіЭчСA š/Ќ–IЅgjтуў1Цk]ŽБ5ЗпЈFUяйш(Ну‘#o”Еъƒ NŠЈјодЁyfфЁoЪ€ŸpZъЌVёzПЄy9Lщ$ѕ€№™˜JoбJю27ю}b(d\Ђ…|™€}іOєњцў ќ*œF(Uёл]#иŸY­іЁлH1!™ЏК ‘˜э9icфмаCбlCtъ@nЃзhu#мb}!є4CЏˆkW7ЃљK)F`YY˜+œъBА ћЌ2(пnнP//lŠм$#яЯнЎмЛwѓc"љg€}ІЉZЃRаuЄіВ>щj%e-2œеН/ЁcwЬ$б=ЭнЪ‘mcvТ_*vы_пЙ1ˆЋ0ОцЭсBHТмВДЭo[тKЈОФDI|AВ>6e8f„etэ]…w}™цТщ€ƒДПi“Віyd –RъID>aKDЛаіyРЧКhюѕЕ=%~*]p0СјtHјЮУ ]@Еˆt#юk^хnщ%zъx„vзiБ˜IЧ+С&6^оўШY0цDяє†ѕКTК1яЗ8†Jа›ФпЄПйЈњ*BWХр Ÿ8ЈN+TЉ(і[сдўXŒДРДvЧ§K<ƒх…,Н7мy€gр7=F(o­­…/шћЬн‘Нйл„–њЩƒЦžІш@]j2 аУ\ЁХГЪ ЏJ—Бм%0C2Ј4'Sкџїz`VЗћєщШ Ѓ3s‘p ‰Кс;MШNО•нЯе№G^82И9ЈšЦќ/ШйOз`ЃmŸ"з^oD•ј6ШчSŸ’;Не­ЫЮЦєнkLС‹Qžњ[3Ћ@џBQŒ,чЊф맂рї†ђБи(gСMїКlв&і ъЎу>„™У~џuЩШѓU•шHuŸX#žhУs˜ѕxіѓ6fа‚]б~уUМ%|Ў–цœВоѕэ€LКj€p{Wп.еo-ŠъќЇžѕЂšќ2A,ДЈћ„чЧ~ƒgОKМЇ§2лqрМnъt"CTœфзЬф7ощбіЗb‚A[P KЬ!Ч,Ў"ИЊLwM+xпВеу{чїŒУэlŠЋъ™(фJ|hO§:Тc2к јaЪщМeј8сOuгy#$]ШjD%хŸмЉ>A`C›пƒfоO`<ТєjаЎВк!0ве ИˆгпџP;C0\:ёvjwйLЪШ0уПnжшЬс,В{тE‰\їжжѕј§sDІЪœ-н&ЭЖЗ%шЇ8}КѓуdiGQP€,Ž<Яd›ЦYяŠјхeT™jLљб…a+чqlч+q@ћѕёaЦБmащ§i6СсНaJэKЬJ‰Ђ=A'sЧеwФбo@ъ~qЈЪ:Yy­ФУСќ=LІЙбЂЏ*.IxbемМFm43ў<sDЇ.PЦ?M х€ТˆтВn=є:rV0Э'іЭХѕќЋAIЯRУИžђ0p6ПќbСЪ}к—JЏ|ШђЈXНЫФЌа7XSЅJ!ћŽПFVaМф‚Г ъ‡нтˆбтсНпRdmU4ўф+ ЩїD&TТЇz0лсч™,ч6№m‰жМуё­"$ŽФWSнЯўЙ%gRніъhя:ођэН_n‡ХIЋФ%ЧлaQ=vРЁИЪ~к]M_ѓeоЃtЎfсРБЭ…Xmсe2t~єЄˆž ФSю…|IРI–\ЪЯ4у.Э]ЯЩIѕpщБќ2ŒgЛ\ГжЪдЈчEX <ВAЌˆSAэЕ<иЪT$E;qРЇ9БЈŽq*дDZ`B7ѓя™ЛЈуОНГТ—ъ–M/x‘GoўŒpiн ‘МŒV˜пхЛˆу йиЋА ЏQѕ]є*мЮ-АUн_йiWІ=Н яХWVммŸpYSСЮ‡‹S5?IхEI€ФCЉ{лБov‡mQМ|СŒо‘V*‚ŒŸТ5јTaжбљтN?+;QкepNoyJИpџЉЩBiщ%jF4œФgзщBxФ$Нќ}нЩ$~?ч;f'v]k œtЃЬ• ИŽ„nr›Чsпќz@plшcЫfЗ”s ,щбqCєgл\lЛщУМ ЛЎv6§4Ч2eU]о9ЛnWF–Gz0Гсса№љ>йЬ лzц—v Ј7OН§К~)vЙіwЄ­Уї dбd.ГЎ_[ІeИдтг.Ь’ O8у@[Чз|7ШеFQз‡/}6еi–0:Ž?ѓb…ЮAмеА5н;27с6Qу1їd/Q™ТФK mhр:ЧэKЯ ё‡нŠ4BŠЅСыц2њ‰сaqяМ–ЉWн›p"z"&jЩ†T ›R(ЏжЏQ;Ж/яУpЎxЅкћЗHŠ4фщ~F ўo—–Dы[йЗЯ_Nyиџ%т]AЈ—Д-ДвS .УНX‰SbЬФўє–Aџс*’$ќ O mа‚Aщ+]БГWєЇtcw)A„Ђ7ГнТ)vGМŽЕт&’М:™АgхкAЪ_™УZ•хЕљЌSKЩ:ŒNmi;5j*ЃЂpНxћхi~BЭБТH§Y<гKG”uš 9ЧMt•Ѓ•\б˜+з&Ш“ўI<Ѓ•—?$еЌžЙyијЈе(i]гЮHдtI‰‰PoI3сK‰оюХьЎзЫu< њЎІ,&Ќ…xЧgwЇS‘фіIХlkZтЅкиf/,Щa8’R.нќ›-EМГ Pb)Щ"iМ€ЛwЊ2U›л+Йќ<НЈT›Р ЯqОф=DiчˆT–ё†ЙЈ#sLUіммчЊіЄд‹УEe  ўŸVШЙаTВ3шКњOhж& h!ч+w%эзНQ;CѕЩb_ˆЫS…љШ wЙ|vœт“‡["хд +*“v 13?k8лћBЈ8z=q~FY‘Шъ“№XЩqМyЩNA.$ЫQI˜,eŽ2PАaЌк~NЉиovA"R3Ё†h=Nƒ#YyКы.mDыиš]SЮ~—“јВ8э4—ЃЗiюбђ}<9ьlxояc0љЦ1SP–П@†ъЪЏ{llђЩЋvdGF*Ў,џƒ,§Ы‹bJЌUM 7р 3aЙ„gQŸ$5уrк„Е2w rT>„ŸЄ OTЩл.кїћ9ё86T*Ž1Rvчv9о”ЛёХЕU[+)”ŠsLшДаКu=<'Џ€\џОтE‡TБnдВ№hД7џYВёрСє2єJ8kЇ8E„S3рTИф gš„W МDбЎќBI™Њ*ŽФ†ЦзГolєВ 0LQX™]—Юle шяьуйџ[эЪЮж—еџиžБЏ=ѓЧОя нЙN(ЌmмИѓ&ŒснРF3Эu“Sцƒ™.ѓ>wПм{ CЩД#{ћ›BP`V{$л—кШXHБyЛB3'ЖяyВdБAJ+H8ИЭвž&_ћ~Э-x@†F?\…№Ќ:Ќ^м.Lе5)‘ )ЧђO>В7aѓ*>A>Wiкиƒ0|sљ)э{хџrP ПЏ‹њI‚­ъœkqђ7q%ЌRљЎТЮ–юuлЏRT=@Hdз>Sи<КВџhё%вЖH7†}чт KлjeBЋЖЇрbgиH*о‰ЇbЋr\њДъ0"ЉГ”„ЅŸИR$фWQIо:@Цч"Yќri–E">'ƒїgп—9„eВƒzНЃ•UkŸ;Ѕ’09сЛяТ6э–Ž,н й—as”ПуЙbŠ&ТCl•;Ї)‰њˆGIЛ6‡‚c;"ЎОФрmI##^y.‰•нрмTЛЅA1Ё—UQ%Эb4ЉађJрUжЯ КПcн?Щщ“ѓT—ЊфнDЊЗ_.ЛЃ…ЃЫœИ’M\ьёЖDf{Cњ|г@8yRсЖ”_кzFЛHj sѕ‘А^№щ€Q‘?жLє<ї§(ЈћЊJ*Zš@йžфѓч_xh'-мt4hk,ї•ЛчкЛёи2k!ыЁœ} ?3ЁОPЎШAw“uЦ ЈЛГФv:e>ЉDMЄ‰d‹Ы*ЭаЧ0\oŸWJ. ьўY#Qц%’ƒ"Ž•я‘ИZ=­ТАW§Š„7гшug|L.сшъдUyГОmвїoК5щF›№КяŠD5ž{VHw}@ŽрЫ8.оь}=є›й”жДсМ8WЫћвW”Ÿ]К$§#ьй*’LлЖaЪћМ sщЌ=т“ЃdJЊ7цЛВ02ћi†Ющн'SŠПX4KЂ№6c&ІПЯђИ`^ЈћНaЈЧЂ!TЁ!.ыћ‰ЄЧПяEђ‡в—]7}зБ#ЖCмољЊ–Щƒб`)ЏA5bŸИЖ{щBcІџt5Š#œ ^uTlˆ‘§F86ŸгDe6UЋЯѕ­кёtdъё…tЗѓЄ:Н4ЅJ-љZ]ИПјtVЬвь№ВIцОkg@mFPд]ѓŸSœ…^ЯВС*[ Ѓн~ёУФ2‡”i”mДїЙ'ЇЗс#ыф€ыВwGХwыR­‘EЉx~PДХШhDœP…?G{ЫiЕчxŽЉ)э€™œлщ“S…2o‘АЂ ып^”Вu,$йЩ]ЩЦОс‰™ #p5цЙ|‡џЦВI1,(…ы–—IщФ-МWЊDџ,ЕеЩp kZЁъЁрzМЯGNідљУ„м?JUѓjЏЗКUЋџ{­"lR­м~Žѓ'vаЂЯ`ќN}М..FОЏ› ,Zуњ&д$хЩ ДЇм+ЬˆФfžjИтгX7њ;ќ‚ч8юEeоcИФА{NŽ •KšЧ}Ьubє_Л„яlЖ№#В$•Ш5iЩdъщЯE єЧ-Hq8јГ|ЉьiЅ kб‡н[!bЬёлp`бьq9žiНn53ЈFGЗз‹‘ZіWг'УтЄььЋ)>koƒА0ŸrљzѕьF HCgWuјšPXОЭ“еwlЎ”*€рВњ&<БYЫXЖбёе,Я=|оbPXD|АЂh§Z~дИmp›”ЫM–з4`Ћџй;|šg'Џyё—зљ~э“ЄВ‰$ъ№AЬputг$rоЁ­СЇ$*ті6нуА гћZ'ƒыSя2а‹Чя…3Œ йЃї&|&жЮHqи–pH‘ХqВкАємкAJ62œиnx”es+`H№\ГБмЁагРбНЬХ~sp“CчЦ?Щ[^™›Н^Cѓ okћЄnчlrїЋ/Ћѓ—`ЇГ’0ђ§‚^(ОэEсћJ(ZY$рЯЋЮе 3‘}цмR  Ц†˜vGŠЏ‚Ь#Ќ.ЙtЪZДk ёІœ02пС*њ„kкФЄь'hFьzRыч J›ќ197є…˜9 wе1=V‹ћН­=k‡3 0НнЋšИњЙ9Рћx‡•єt ^с†’ЋAыњSЦUDД„u9ЋPuВ%=QЅ”ў‘ћdщ8PЭ№ВрRнЦЩˆЄ\N5œ †d‹3fЩ­!G Јa4;їШzЙІ†йжCEE(tЕЭФ‚U:NЋт5№л:rȘeе WўIр”;g!тWЩ~ГКˆGхмѓОюѕм (uї•Ь;G''Ё/јрŽ/YэЂ“I(Еђд3{jIК8­ m[<Ш-ОŒseЊ–*QKлM‹›\%›кЫ2йЅš,mПŠЊ`wTЖŸедyСDZ䆉&GЙЭ—x8ќЄ93Ы•JщбVј,7(BsЏХ8[Зž{5КkќYnЧ–9q}С! ™Ќ)СtQzOБб^ $!˜EkюО!Aeu‰і@zЕ„„v$Эх<ЎбиW@ш­њ†?§0tг–J“2xџќЉ0кчњ60яАl!Њэ(”4њr‚ОLe!9!сbЯЉ’ƒоjш‚ѓ`сa нh№3fјšчg }Юъ–)лцТ…ƒдЋ^bLv=…ѓщпHAбЛЙсРГФ+]Ё;иBИ*r}  _№чa :ђСгЩ§ЉЎ‘ѓxА•№wЄ Œы$—ПКš{АPб§єи?|ЭgЉ6GЉЛѓZGIiф?Хь7”аю іЛыаIА еЄBГ'дDЉOч'шЬь ВБ­3ЯOOЯ}пAšЄы˜Р~ѓ2Щ9šEђЧ•kічGЮћФ9pЬ"0lAіоeР8FCУЗCБђ3rМА?лoВt;O6ŽCEГu~ёє8йЯрLбПЬuХЁNrНKЉє~iЃ_Ѓ>Žhі\щ№ЋeЎкx+2 XoЊю*b‚!ЯХf•3№KЦЃŠ—ŠgjнМ>.P“ЃG_t™СXtзiruпЏf)tŒМLPЩЫю{"*Ікї”Ёi|лœY:б4УTЧlˆўh™їЁМ7ЪDЙЛyoe@ёЫЎžЧЫ ŠЩчFу1XЬуŸh J$оPZ#yЃоЋ 6пЫTRє>g{7њoLиgЩL—!Й5o;ц›№ Э‡сФН~О!ћƒ%Хʘ+ВSерŸ}ГЏы.АооМ1wƒЅЗZЖ+ЪхŒќйЈШg§Пќ‚gђvX>ўЂ§|ГТcЭ‚žœіF>ж6тЦW—U)БAэіУOг[§л;KыЗч;1ц_юbыз ђ$1‡Л Mi +vMTA`–э‹Oуањ`ЕZLҘhУоBY ­еКхІэ•ЦепУ№мfŸєщ’}!zАƒгœуѓ@9С”]˜њl3AЂ40O aтеПфЂа)/Н"ŠЮи#К#–“cИиŸf|"яyŸ2t’ŸЄUО„Ь.Ѓ§ѕШ(ЄЩS,sƒ§.—AрЇБaŸбЁЗТСV!‹Y(:ё:Зnp—њ™€Ж~лrbaгыgT]7iqљ[˜ыF–@oКљ 7 *W­ˆ{uP#ƒˆ’-/‘дє˜O=мњЌƒm<‚~SљВ)Е‡нОМ+јЫv)7К]*ŽФиcч _`?Ч4њk24V­СlŠф)PтE$yз2к)R[‰2ЭмўЉ {ь'ЉЂзiX$rЅ іO>tV?шŽКэR–дНnзef{“*œЩtџ(ќ%fЏ—ЕРXШžq‚wПЎВ8bХB •y-ћТз7с;ˆ7ImЈщйДВъєС.іr“›QЈ\й˜Д“š^х'`$Ќ3гИ`љЖё ЕO F\yђmn{№љXvЙЅРчцžЗ%i2ЃЋшTŽLУ!ткPѓi lѕKІѕ0upz Xfт#^$Ђm(вё]phњёљ†…Йпис9$т„‰‘яЎ–пхŽhьЮb1хДЁpЏ1ьgЇО žЖЖ&…Vк9Щ€`дЌЧIЯъЫ‘q:Fя†ВЃZ2Ђя:g;Ћ™S†„Ÿє­a Оo=;Ҙ=F$4пЉк`2w˜ ~Ъ%АцC—ЊцбAˆ/*m† ™зћwdAHІAœИ ф ЮЧGКIГ№ъUЕѓ† 8ёzИы,œClƒ™ ŸљЉ†HoMYmщсЩц.rHZoq бжўOnŸ$CiЈЕУ/вO VX3l0TжЙТBђO§’эї%˜Џ}Ж}йpXUš3ДКА˜ƒ$e.І­Ы ЖkфЖТI)|PКd„LUАѓ”Q4aiдЂb'…gўЈтry}№sv0ятˆјИeІ_щ:§i &ЈPxвгpeІћСcЅл:Ќ@\ЏъbKњ'ЏЧ9‹`2лЛ|LиirДXВ$ƒ09’ѓpн}­Кz'В.ЎЂNЧ~‹Ж*VyПy#—/Ѓ ,GMъ№>дУDЦЯwіїHЋЮttiшTКPgBєjЗЙdІ‡ЮИiй6Т‡лBУчŸ ДўнJфSв~ы]iPъ˜п=1$еф7јАСxЮЈ№B$ЂИёK™ Б™їЩ™_3Пф)ЛћE 1чЩyЛЯГk‚`ЗцŒЪhcсbaZum.кy ЏЛШ!…ШжdъgА“ИУs_“ѕ!#зЉžŠVХ\щ:Œ-ЎЎаЮцбЂ;ћ•БSГ–Џћю}ђu ‰tН)ŠžЉ§оOђsЩЁн“Ђ‚тD|ˆќOЈїшЗLUЃя rлЬ~Й•!“ТъшНУKHУGѕqVФУц ёŒэљcЛфƒ c?Ь‡”№ цЙЩŠJ"„ 'пœeђFЩ8mЃ“œ}WdЊ‹ОЈе9oрЂ&Qћ&SџоWѓVб?1к‚OFE†y˜ђЖŽqСNЂG6CВ&˜4aО€тXœ–Ч5špЇa8cъ8Ѓy7eСŠ‹-эR'KCТИДSРжЊG•iJГф0bTђЙ 7дјфoLŠ;А&$:ИR яbџњ/ъ“tѓgb#:Љm&1јЊŸ№\ЩŠ­ГъДЮ]ъСcЌ#цf„‹\‘јГ]ЂхдЮюК1tVлЈЧm>ЙЉs$q_uг™x“A*ˆ­/Ч…—LyФћŸ.Њю0d@Мo—рCЄš#Оп$_4&VЛjQа$RT –и-]’ж }EћюЩ"1'"яС#I8ЬМ~і~љ•nъХ —УЉл‰vˆЌќVЇiВ‹АpйЩ”љЩFŸ—!ЩЉdюЇ$П/аД}яЧѓ•Zи8яЊК…Ы) ф“?}ў–NЗjQŽbОчї›`ўZb7GЇі.Š@е'ўeжC|KN4АiххŽеl›ќщц9ЉUсУЩ†mџОЈ’CFЪsТц,­U" ч o“џWE_АёYёрэЂр9› 0ТOвК:HYQслœ4&GмЏƒѓMЭЪ}е=С§цw–‚ДŒТлтJb)VxОФг…5D^Ђю›їRоbyюЈ:-П;ЭЖnОЭ1‡mДж;ШYї”еџЄœZw x&LEР€h‚”мЎк]оЉџБ 0уIНЮАеЮеЎv§^уHsˆ№<ж“” ™ђІЇ•‰vDЈT^ь„б.мыЌmаБє‚ыЂdИкжQ—ўс•џ0 ›еy”0$3о•5)ЛїУœьјиИDдЁ#Ž•O${2­AЇБ~ПшИAЗ№овЗЈЃnklплZЭџ*zж~>ј3jѓ' xЕЋнџЄ%<Ч endstream endobj 184 0 obj << /Type /FontDescriptor /FontName /IFKLVH+CMMI10 /Flags 4 /FontBBox [-32 -250 1048 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 72 /XHeight 431 /CharSet (/A/B/C/D/F/G/K/M/N/O/P/Q/R/S/T/W/a/c/comma/d/e/f/g/greater/i/k/l/less/m/n/o/p/period/q/r/s/slash/t/u/v/w/x/y) /FontFile 183 0 R >> endobj 185 0 obj << /Length1 1430 /Length2 6225 /Length3 0 /Length 7193 /Filter /FlateDecode >> stream xкu4lћЗU%­­іˆекФ^ЕjдоЅvD%!‰MmE‹кд^ЁF­вRЋдlЉQjS{oUЃќг>}очџМпwЮїœ“мзО~їѕЛюpБщ (й#ь j8Z$(,МЇЃЃ ‹ ‹ИИŒahшпzз(CРeў—Ч=$ŒЦъTРhЌЃдєp‚D ЄŒА0PDXXњoGRЈі„йuš8рК‡pѓAТаи:м HZZ’џw8PЩŠ„AРp эuХV„€]€F ŠіљW n9'4кMFHШЫЫKьŠD хyј^0ДаŠ‚"=ЁіР_К`Wшh‚. Б ѕ—Сс€і#Ё@ЌТТQиИ= ФVihѕм №ПœЕџrрўЙ HєŸtЂ%‚Сƒ!„Ћюƒ;`.P žšЖ кЭУэ9‚]Pl<и sлa~ЗЊ)СX„№Ё H˜%ˆ‚ЙќТ(є+ іšUсіїЎЎP8јеŸ …`янGшЯpС^pПП%мос {7!8ЬнЊЁђЧЋќЃs„ЂтТR’ЂR@Ј;ъ qњUРиЧ њлњЅЦb№sCИА0 0(ір‡{BhЄ4Ряў-@  = ‚кAapР?йБjЈУ_2vўH˜7аBK?Pјзч?'+,УьpŸмXШXћЊю=О?џcTVFx§DA@qa HXD(‰=ќ;ЯnрoєПЕњ`иŸю„џЩЈw@`ѓќ…{}#ёќC ю?{Уќw ]–аP ї?ќЗ†`П@џп[№;фџFў_YўŸќџяŽд<\\~лЙџrј?ь`W˜‹Я,Ё=аихаA`WўпЎІаП6Zjѓp§oЋŒ]%И#–ш 1AaБПє0”ЬjЏCCœў"гпгРжpСЁњьзУƒў/vї А ;ГПL`vбПЧћK†bWэп}ЈТ!ћ_;)".#‘`–XIшТ.Џ=дћ7чB‚pФb: €_ƒ– ЉќR§–@"Т@!яптПЊ@<HlПщmсoљї3…zC!€‰1D6ЬЙ&ЌщG•Ѓ—Рђ€мЕнДf"…жDшNеa›o FY™“ZЅj@jжЮ­КЪю?ВgПњ-еВОіћ.РЊЖцШjї|ьъ;ю—DП&і1ВЗ8yІ)Ъ,2ХШN}цЇфmФ іŽF\dўwj:ЦНnS—ЈIj†7щЖДU•djг0I?иZ0D7иѕ/‹бнЩYp ]|f•Њћ‚]KЎхрUI>пнз3Mёљ§г`MЯх=Ю4…Њl“ŠиѕЪгљЄ9Хž›/(§ьдЉюбщфБвzюх'5ьвY^p\7sЮŒrJlв‘5чПX-rBЅžŠŠЗ‡JЅц|aтэg/7Ѓfдв№ѕIп0эЩФЕљО%—mƒяИ39ќЪKT2zъœі b. hš ЃЪћ@ЩыОqв J•ѓЮю,Аx`ЄElh Ct0€ЫkK`?рˆVЇЫy~Им9ыш˜%Mt*2:$Efњ&ЩЮUg€_*“ЋR0Ь':hvHЁЪw”EУIб.gv/ac:єШdRˆд5mQЇ,аЏhЌrr?mяfЯŠ ,ЉтЙdИ,™ŒLЏВ$(Нnlўђ0aqm‘1чМх"Йщі$ТО^оsДLБь.§ИЎLЧ6Чžьмuфѕёiћ‰Иtэ э9Єв„ZЎС§Ф^ъ‹є[Ц_ˆK^0яЉюЈ2і1T№MЋg ЯяfМ№“VЩвJџ—еi}ажо.Ъkbхї–˜рўzьQ7\??XыЫЈQЙ9Љєг9ћЌoˆ…dПр83-н4о|"ТZy$*цЗУЬєtП4 АкЩž—KBiЊС&Њ СХSaЎ>L›1]u/ёУІѓт€Г2C†ыЦT0пљ(ї""ŠJU6Bж&ˆ†TГ&nŒ ВЉф‰’&?г9>zDЄл"~_пbIИпд- ЭT~=hйpШыŠOТюэn;Sgе~`ovПEЙ@/WНе]ЇСтцЯZlU˜Vћ’ЇэiFsІЕюWJ5ЂOЉhUЖ‰>ТŠ‡.TО“ющя‹ЛсDШШЮіFЕ Zш쉹 EgŸы\Ф2]H*ГžnšЪ2ЬlпвЕP”ЩYUЅcœeї—\ ЛFвВcещt`†5xЎ-Џ|UТЅ|Ў"с˜5mішн‹uЇ"оFc˜^Єѓјшt|ю‡,]ЈlЭB)%mZ ŽЭ@MDiт,ЯѓŒъ•“ЧV”MѕЇїѓУжєі–ЦеФ6ЪИ0„?цЎСu“1e'–ѕ%FNн-№дђ§Вї‹’Ž!?їЛl"ЖVъ=)Aї—j2сЙWu[љЬ\3ataќУсШA_lGUqжЇф3+л&}NпЩн4Fт“‰’нВЭцДьЄ+ŠыыЊ>Њгм" Р эs$s_ИЎјрƒ]жBД‚‡џ[•ЦbЖпёCEyжђ`Џ'щ№зЌЋЯу!ЅlюЦkмс™uLињ>“jо`йжє НоЫЄжХжйǘBH@K?5!Ё)U8T{Dя5šьJЯ<Ѕ‰V№ѕщŸRШ‡цl\ŽеKГ/ќpЛљ„у‡ъ‚Ё/ЋсзvЩ9кDЦуŸў$1šхvта.SБнСIч—њ оцYq‚LŸN•оTЕЙЖпCvтЬ™Џ?9ачEQ0Юš4ЅэŸ)в`(г_ЊЙ|:rMЙI­M">ETзЪе1€IМ%w4ПщЌžrЅ­Ѕ]sъy4ѕ0 цSmP…кЙ*}џиУ‡ЃФ‡№ћУ.—FBК'AЙA `ˆg9'ў'яа]ї•Сm[ж*˜“Дѓ•pђFBюГP sї"џEmLwBCEжл;~˜0уЇIZ?ИЩєМH"%юfxѓЎœMmЙ +v-(кk1VЙЄ7Ў„{™|СшsŒЈuФ•йЋPнuЋšWEEoѓoJіВи4ђМžp™єd7‰НБ!9iJ.x,ѓјG@ЧОyЖњ№оБxјoЬњ6Ј~ЙP…Ъ‡Vћ|„&~PФK žc9GŒЮлaгJ<І ЫZ-Ьсчj)нƒНжbт‰ћyЩŸЇЈmVT1ђь1џ\њlЈ‹э–:ŠeЗБcЬ@БК)R квжЗ@f%|‘гѓ§5`ХWптНЬ$У^ГаЂ‰Љ}wЕx\IXGvЅŒ˜Ўšu‡ъУqЊ/Јa˜$НѕRьЈI!‹U f'шЫ3к"uuFю]qќkšуКF+к­—6UЈь.Д Хsf9‡гВ!%ТkєђЧNЙx-ЙЈаVі†<ФГfЖ‹еЫDЬf0•>НфkѕьСЦ… п1%xfз  пЛxисjм”$Пли{нoЯужЩЄбё€elф=—~ћX@EЄжшЦ `FwКХh`ъЮY“є=Mњc’1’>­Ÿош_JДщVp{оУ:5f=ВН t†ЊМНЬќєlB|яuУмd9MF ЕвW5uћgg_ЩŸѕ3мфєќ)&.r]+рнпqRиВwIn_пЄвyжB!сјб&Щ™@їЇiˆ‡aGУ'-с>њ5†Piчhщ> xв†оMе‡˜jP7|mHФuRјшднђŠ’цўПйЗiѓдtЂƒ ќ^чЛUц оgxTвk§?pkT“'P€ юЬИc6’nСп Ѓ0ѓнНВp&DѕЋНš{Ёс1^ЉE7лЊgОyѕiDё›/бЕЗ.Ѓб0сЛДpГСЕ2v;+­lзЪУѓ“QЛC*gЫео№Яуk;n–u! !<ЉЃе Ф–р٘[8Л.^(_ёœw9Б`пВ{ћšї(sкВдwГUѕ;Љt€аюndIЯSdА!,<ЉŠРуУЦeuУ>VšжЁЏEtЏiЗЪ‘A—ЮCЛЧŸ~ѕл2ŸŒХYѓ%Œe –Й3M˜9Љ˜(svcє'§“ЯЈШdТA.§АЃћЅЏю,рMi€(єг%ѕDP˜уі)*ЦVЪљvћь>‹yўгPУ‡НфWYз8ЊbїПЏѓя ЩЊ%Б:ЁЏŽl”Еžї!ЗЄ<–^“I(]o?иХp~ъ P=ŒMрDЎэžU/|JK+>и5йъо‚ЭП:чFvХьфш\ФLЌО-ц\жЅђБ'.Й:IОZ‰ =лЗоa+ТЙg2м@\ns­=qэ!фeЗ,ЉёmжљГ8opПWпDwЏKr“љ€jоQЇw'˜сЮ‹ЪСк[mШRICАЉл\@)ЙuЋRуз‘рГНьЕzCљ4тmz“Ѕв6BЫ[§жСчЫKхЂТАn"ЅѕeЉчЂJь)ŽЮI­NAєŽ&S НѓСOЄрЄ[E3с’e.СЁЏіЎžr Р„ОйPи#вsн=‹Ы[Ў‚ЊsўСё‰НTFaоNuтяŒ/ћ›ˆšh/Х2‡хОщЧеоИuЫЩ›эrЈ"кћБТOv}ujН,UпчZƒЪйч)лœЉБFуѓ~˜­ƒNщˆлЅѓQХђosOxЎжѕЯІВ7w Ѓ”xB”9Ц™&п“"Ц"яZџœcЮкƒHvЩ0ъ+!™iхфwvHgЂ5)`Хі(њ4RGЛW /ћМ˜N)фїаB п%dЃzMŒqЂђ\M&њЙё‡\ЎПа0DdG†gПзЉ}ШиU0м cЦэвxЗr|cTЩВ™dШ-ЕјшvZЃ џ с)Ь.348ц“'ВЭAЄЙЏOsОŒу*k="‰М$'arм‚L:ї2ЋЛSmЖЎо“ВLЉ2ЊЇVжЕћW‰dЩЉЙG@Eeоƒ 8Ы„ ІVЅ7­+іж5‚ŠWqKЖ>UOгЎћ2‚Qд%7\‡Ѓк+$Ж™qєœФклЉГ][AуZЕѕГ=ЂЛ ЭЅ$mƒл€‚к—ђэrзžxoN˜ |}ВЩСUUЎЕŽЉ Џ,#.ОЛуЙklиЃьчїЇXпэбWХ№G$g&-ћr{žљпwё}ЮvаЯbГЗ|Ч^^М-РТ—6ХEіE]Ц“Л=ХžУvC˜—?™чаN4 b 9Œе8Њь:іТьОxwл6|R"уЌ‹6 ђЉДŠQnТR]ѕшйГu“Ю‡xMН ѓxК8™ї3Ь§Ке›U_RєЏЮЎ4>хgЃrFы№iкЭ16oJЮ;ŽЊ9r-9ИxЄЊ\,}Н'˜N:к‚ѓb<(ђ]4$—ЧыDцЅ­F§ МˆkДY€EVЬ`Уd№І$qг"Ѕ€ОхЩх\Ч` jѕыQйo#/`еЅЋШQœŸ'ЁalЭ‡„ф1ѓ8пП–l7сOэ–J,>&zЂH5тBёŒžлЪ™`ЦНˆЂc‹с ЌJЇиŽЇ ща–0ВjзЕŸLsХХG™•[9O§"чЩ„j$є ЎЉPь‹™Ё-сак ЉьюZО”ббЩљтњž)~Г:Ѕ› -ЌA •CМ|vP•щ сoQ5лž_ЪЏФї§оQЪN˜Z0.5f@aМXphЦM€ЯкыЁтЊ)і#U?йЄCš?›в+>ŠHЉvћШГ•ЖТН№˜й‡}dЙhœ!sЯП ев^PTЪoњКeЩ4щšyЬЕХwN.œ’ мњŽиТА%}ыъ’аЇ“f–|Ъwrс^]ьŠrAtА@ўвхWоЏ•RіDЛэy”Іе кђ [#Э;+І­:S­šы/ќ*­”>FxхфЩ•Ѕ.ЈB№)&Њ.F@VЗ0тЂ )жW+я@й”ѓWІ[ЩkУС‘JEыЪзАиMgюטѕЎЦ”Ў=П’Й\8^eш€_šюЉwМэQQ|FozEZ WIШ?mЪЫ0Xi“§ЊZ7 NЪМ‹ЌЦ}œђIйѓтсБdмЭ/&ьФVPЦ$DПkˆfЋу”BУЊJЪ]’ѓ„=Љk‹­&љъГУ†‚І™/!‚‹" щ8 ыYЕfлЉШжЂдWщ„xѕЅоY­]мй›да +ŒТ,ИЎтsбЖ&­RАћЈ\к8|ЙфѓYg~]шС|З>їrmяјn‹Y@й‰v”}єќ˜_š_›Л|WУgƒВ•!.Ћ`‹M~WKдJЖGЈЏ{€ї˜Ф` gW 9G‹6{2h—9кЧЁB›ЬвW4ŽFПžKїЭltжuјHд <ЎZ4еŽ­Чтbмьj;'w+)Єy‡юЃ NМЁн+7onоЎћlNІƒэыйъƒdэХr 0“ц\A}/“юў„И—ЬLIъfПэ™Й"CЯОgИГУНuЯнЪЈ8}ЩFšK‘ЂXЛЗёшБE?м$фVWg:е[ŠЦџѕ~yЫCЁєг–-ЁƒЗ66wiј?ЯчlЌб•Ёмм{ЃUЙzё„дГљєлЅQп,Нгс”ќ+OLKC~ђRJ—kЪфmlˆю†/>™=ЙЩѓНьcѓщтлњФ™х*lFLЁБщzТУd‘„Фі|љ3ŒtcГСяЦунsЅBdJƒ"Џdв$Дэче.у5~žЭгф лйГ|Ж„ы?{:РVз[‘wЗ:sБo’ВІЊ“ЭŸ9VHЫBЧМ-mяыЕш.6‰Oф˜7?d”vрэњъф }›^=ˆFЏŒНyшЉдaЙЄлi~ЩYŠ+ўХР“ђu)йКЙ"wѓћЋpŠзxP"џК§У3йю†ѕ,uœіmbWЄ#‘qЙWжž PуЯкСВн}йЅт^ `GK/йБџpфNО›QЕxxˆ„РQ::qюпxзv/‘фГєxМB­(?4>Э4ЙрёFЅNи&вХ2sЎ@WЂх­­­вЖMї-ќhє4Z83Y•ѓN†KdžПјиД†K"Дю=Si pkЇ2аЉдVрKœН[DLYŽ rО‹“Гб ^@ЬZŠЮЊ“пYІ5) ЃRИєUxЏ&ўLkR*]§ѕ}ЙЧЁЏш„oЬPg)Qй.lщ=ЇR]ˆ˜Ѓ' TrСиoЬъ] ідњо8‡ѓеh2М=J–љQyЙvїЖХ~/Ѓі}3aСЃЈЙ7‰•{­„žС4Кє„ОV/ZLУЛ4мз/VЩZšйs=U:jfXюnn‡}ќ”Ѓа]…л№ љ?†Ž‰XПќdф‹r e‹U\ слŽ{D:!’йAŠ›ЮCЮdоŽг§ zВѕyЧшЖо}юCs~r”†œк;ћLtC§*eйгь‹фѓ?№іЊ< dЪЩDљe№~шнd’yГчA8‹1Щгˆe…xпlзœAш_ѓнŽ{Ќ~sЌѕР6wћžm1ПЭFewіЩ’ћйЮF™bZсUuФъzIXz|ƒЕ}цѕ`•P“8=SЋiїєВLа[WТѓ][QCtБVKЏ74АdM –„южS@м Ў†о'чєв}о)‡ЗФХ–УvK@ђM3G7ŠzT‡šх=g”zЁ“љЃЛВж Zђсg•Яo–њЕЪЭvиHДЭ~rЂAvTeБжОrЛ .“AќМДЬЩ,Ќ 'ГшІДMЃGD|љ{SёНp›"їCјЄNф>=ОiРБщі‰Њ|Or7v!кюМЉЏ endstream endobj 186 0 obj << /Type /FontDescriptor /FontName /TLVENC+CMMI12 /Flags 4 /FontBBox [-31 -250 1026 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 65 /XHeight 431 /CharSet (/D/x) /FontFile 185 0 R >> endobj 187 0 obj << /Length1 1407 /Length2 6115 /Length3 0 /Length 7068 /Filter /FlateDecode >> stream xкtT”kл.нЉ€lrщКЛЛARf€˜!†NщN EEZiA@TIщю.‰!„Œ§эчЌuЮšЕоyя~ЎчОЎ—•IпˆW ЗƒЈТa^> $@IGGC ё‚ЌЌЦP„ ф›€етс …У$џW‚’„@љ”ATžаєrD%Ф$@€ (ёw"мC  ђ†‚:|M8 тIРЊwѓѓ€::!Pcў~pиs$$Фx~•\!P{  B8A\QэA.#И=‚№ћW i'ТM’ŸпЧЧ‡фъЩїp”хфј@NCˆ'ФУќ аЙB~#у#`;A=ћр€rИ@э!0OT… ё †Œ4Дznияdэп <€?wрјOЛ?е?AaПŠAііpW7Ь s8@] =Um>„/‚‚&‚\<сЈz7ъВC%ќ:9 Њ`ЁўчiяuCxђyB]~BфџйuЫ*0АмеCxќ<Ÿ2дbКv?ўп›u†С}` ( ь№иЫпuї‚h(џIAЙўё9B И˜8q@|эјЖ7іsƒќ ќtЃИСн( ЈѕGр ђ†^ €џјЗE Cэ;ˆ#F№Ow”т№лF-пъ АЂИ'ўќ§чЭE/0цтїOњЏ§ђ›kšhЋpџFќŸ˜Ђ"м $рЂш*,CН§ЛЫ№џ§—W§s6р? 5`p€№7дх§Ућ-8ўH†№яКp—!ŽЈoкЃџпјUђу§Я.џ/ъџїTН\\~…9~Хџ0Шътї'Ee/J:p”8`џjљ-eъхњпQ %˜#ŠтМТ|@сп~ЈЇ*дж‡"ь~щя] fИ@a}И'єчUўW Ѕ:{gдWХЕБп!'J‚ˆ_Ы§iCP"ћї9T`іp№O5 Šˆ@ ?!P– @%[0Фїпќ|08U@a8Р=~ЎY(рwўщ#јW_{/др_t@ §лў%yФbO0=З—ŠxTёYЅ@ыУЛ6(}| Ш;Xhƒ‡шTyИ”fєтљŒжещU›GŸtн‘/ч'ПЌж2жљ Ÿё2Њn:2кЅLмžЁЅœг1OОGЫ3ЫTd,ёшDгЇ'ћŒ/vь4b% dЏiŸJїaЃx­*ІљAїучЊзЯЕЉш$Lw— v=Цk"'дьЙЫЎЩс+ VБYКߘŪ?^ЄљT’-vїіЬ’wаЗЦ?жє[;М… W‘ъЁSЦ­4Э'ЙЮ-ёоyv'РNэЎќИГl3YЃ{ьДzМcЭФхоёВКoЗH[--јY^Rošќ@jеїTЋ‰ђhи<…ЏРр'9X?г№Ш•АљКFАaыЗ‘„5сƒѓж1ЏМГВЩу}Щ7Іscѓ8БI azj7Ў}фЩИOk_ Vœ“ЧeЙGaЧFCvЗ6отyЬ”­ИšЩЌ˜=ъ”I+>БнйNД ,yRд…ќWжоўN!Уƒ–ѓЫЂиеUрˆ›•™”R от[ џwРЌOn ўм„сŽpГУB9СйЊ•ј˜h…ЎаYœыioмёК~я s…7Vћ˜!™i?RЈbcВœ 6_с'ђБ–ЕWAvЉГ;Хл)ўТ-8iє.iќ0Š-ct’ ђХФh\ЈцЇ!izєaфгjVIќБ%С–КK­y š–V'^qкчTчм{X–ldћƒюlРљЯц'*ƒUjЧнjёzGЉяњjф…"W\eђ#,юЉ>Ѕо~ёјХ`XbэГр^ЖАAі Yяж[еD ˜ТŽОŽб­š#тBгЌарџ­ІxлЋЄSВB^"}ПёрѓУзЩgЦƒДs’ІI%IЈОЊьЙа MVід&i X;ЙŸIсЭ“њ;xZŒЇРиЛ]‚!Ѓ7ИЗЗнтўX Д›n…§Ÿ™T6Ј—7Џ9№MьцэTžоCЎЌ ™ЦSы }ЄЅŠЁz”і B•uџф†O;Ц~ЫпЌш„Œѓ+О_<ŽЭљD6ТœPf„ФTЮŸœX5e ГЙэЎВ>В=BЅB[МЁEћˆŠCХ№ж6БC,‚`domЎьЁvM­­ ПiЫ;HЇ+EŒџр+_BЏЃ]WлЕH„…ћШ|”3GжЧЅєЪ%jї$ЂЈўыћNЧЄЧя№GАe‘-„\Oу4[˜мWoЩ є+CѓlпolЅлD)i _/ЯД mPƒDо0bё№5ЬwH5§ Н_”Ђ4гй~йЖ_0хefэЮЇŠюXЬjjЙ„ЦФƒоSЭњ‚ЪикЁ DРYFЖrS4B(У+љ0ЉњЄl[%MAё™ŸƒЃчА|ZIЋх›!4ЌD5~cй@ѕ2ЈтrO’нЁњВLјGX3EдkqЂЪ)LJ‡]ДVмЉе‚:3ЯŒ—ѕвv ^vзmwбN,ЛX•,ЄbЗ‹оGћ„тDђМ’vХЮЫщ…ышІhдMœ1ѕ Э= Krїо^ХSНђ“  >лмTжЅ>9ЖИPЖЇK*у_mМе›1Хєь,ЬчЉ{kћd Ьћ“XЇŽŒмxtI‹:Ÿћј–žK=фyс4žЧrі†ЅЧlO yvГ^ы}t=ШОи4ч9ёЮЃ-МЙtђ–їцшТ6ѕMD`/k5u -хіБ\bЌ‰CnЮ1>žД– Ц.uЉ‹Єциzœ‹€ЗтœєkUЏЇ…Œ0b•‹D№5ЪІкЖЛ7WЂmѓя=яяюZьЅХуж 3AфЫ`'е’šFУcЙВ™фУПФZЊEЅс™ЃЎU˜ X—сšљg! Jzф˜‚] IптЙЪћЗbсјn GЅ&ГCЭЮuБ8§iИЗЯЦйžоЭŠy`GЂлжлjƒ,§њ<49­ЖЙЖМwТmŽЉЭŽ…я“qudЯ)‘zЧ8šващР0>? wнЖўБ§‡ёЭщфЎ}9w№@›№Ео­žаI@ћ=§:u[џoЯЖјKivšw‰ВI &ƒuЌ{Иф–їWIjr^Dр)nwЅжІ"иMРˆКH:Ибœ‡FЖYU7ОDDё{ѕ =qЗ9?•”uѕжц8'аšќѕХЄeЖ–>ўЛ~oЂœnŠmђsv фŽ„nB1№ѕk’иЎКždƒ…яЉ2D­Wjn=}лsZQЂиŸы;œТ{Mžx)“з_ 1œКNŒЈ]ЎђeBТлв$^#э„9mЋ}ВЕœ3‚=eъFМаMSЇ)”šЋЅyKmГђГ„j"‘Я#KJ”„^Œ6wьeЌQЩТh>šЅ–ЁUg7жа1-_ђзUn\4ѓŠпБЭяЧўd ™ЗI2‘›аЙgСЄlyHиv‘Uk:­y$&к5Z’­?Ш,ŽМЉїp я€Аїк{qSpМwјЫФNљТp[–TХŸЬH[RФ”3lОЈ„RЉc%[ћ‹kХВ#gИWlй чєЁN0Х с џй.ђІдЗZўbLвЖC<)Fц_p3X0•ЏЅѕѓЙЧДLjАдвєsѕOлІ/Жэп~-{К ’bвл\pЋŽїЮrѕ?њЩ.Љ4о>їМїb]ўšk№]($5aПСN{ŠСС’ЯX<,Ќzр’юœ)}гС4ХcI‹fИ}iOL іyТm@”рЙбRI4•щb’ф—"Uь‘1;—zяе"“…MњЬЭŽ_к‰Њ|{зiЊOc_З"•}MГ ЙZƒОбqEО1:U(LзцбфРЏ5*Z—j јо0KЙэF8нж"зУ!XеЌšqrz€s=4шК‘оVНOЖЎ‚iиъУFљ™и„№žљ’EMыxf’aбHшж щ~’аЖƒјOгЖшљl7{žфuѕ!ŠZ&ўбž~y–НЦОЄD#§ЏАаk_dг9›p§`ХЎЅО|Ж>E!=љW\DXŸ‚Ы ]cšpˆPО…МЏЛTKъš‘хxвЁCЫтy›ŽцhnТюфDЯн,S'mЬЂx!Ф`зƒQtл uћ‚єИXкwЯ?b4ЋавждЏЧегяD^иHЇфФ;,ТBЉшиsЩЮёЅgЩŒЦнћ ,ТГєдžЩж\&ž›KЗ#мSdaq …!aд­|Y}]јiA§мЁ|…Џ&wЬьякHс˜c_xeMQчwіУуF,†‹HєжХВ ˆ Є…!uк•GіГВE.^’›˜т3џЖ\ыФ…Н7'‰liчёмѓb%eЛ UAЕš@хcХD&я>ПYcŸЇПщхsЎœMРяжёTžs—Jу№c ї WЮЊњњ“АhЧo–rјУeц1Х/ЧKc`I"Ќя­GгСe˜ЛкФ#ж­~§Хв. ЎDošu‡ N ;Іf,‘2D7dКдА$ /Щ-'›ь=J+бяf%ЪI]ЮЪДcЮˆ RLЮ<Ў‰ЖШv чКu]BrЊЏyƒЇ;ЪЗT#ŠШXžHj€ЫLЭ&Ш$БЦ††wŠ#юЫRтKg:њдyпЋЗ5оЧш`МщАjmк|kZE,(зGЯЎ|КЄZeG+ќUmЊ‹еФ„ŸЉ—‹QР–PЖЊ?ьPbЪЁalЊIеQю<-_Xœ|№-Ъ‚юњт&aќЂНцi‚Љjђ8/rпЖ+нB†™ЁЂл]W xзН{юU•ф}*–dnЕІбќN КзS:ЈХE”–КTэ ЁˆЭžБёЛжWSyяћFMлєРгяlЈк‰аяBО0`†zIь}ŽŠŽ?%L7њЪ0ИєQєi<ѓgЏœ чUeE§ЙЯї6Іх}ˆъпg`nБжZЁѕэrxŽЬjrтБ\љ‹нЋДзTбуЇ‘ЮЮБ™Гп[JПR™sшжјИ™@`в#ž№†›2е*{=фUFsvfEеleЉŸ.ЩЇnЇ)ьШђŽЉЂЖњ}ў7gќW)ЇPЄ&>цSзУжq!‡бUМdYюЦКЌXl.ї!+”„Yњ™ПДЎb)&W&Ч&Й(I'nЇ€В/жJ§нпуНo9ЎP… |ВізTFо6/з™ц3-ŸsХ›#o^2ЦЁYXNKхj ЭЪєr;тcйž ВгЙ›ЕДZЖ!rЧэЎ9œИ@ ‡ыН|"$_Ж= ZоЁJŽжРjKЕЬ2втеЩE”šIња чє˜lž?БЃ={ЋFл/Ь{z8mУ_‘дўФ№кb;Z9­ФSqNшє№ЛМи„mУн/xОЎ)ЬиДa†lЦи И†ЋЌ!:ѕы# КЭJ|ЁЗŒЄCнš@Z…ЇGЖэQоLeљsGƒѕ&ЕЛ‚l‹еЬYАэЇЩў† ‡vkšУ {lj_ž)Н$и2ІФNѕ‹ œ“#=7јNqџ„­ИЛ-BhѕLуУјLБ‚ЯьŽŒ§€Оў‡ŸШt*E‰кмяFA,й.F5ІЂїkЙцЭ LIЧг4яЉфѓ=BџіœУцH%sч–ѓ;ЌfБЄ=JяёЫѓЊH&N^ u~ЌG&ю7˜‡|E1NрщЉ]цтМ—З‡2{рˆЉv…(d§iЫ‹оТ%Iрз>їХ”­ЁЦ2žЪЏ?%”$ХWчр$мђ|€І,\НђРжнЎUs[X<}oуYnў,pRљеГuЃѕжсфwЌSКбG­WЮќ‚!ۘl<vў7Ѓi5т Е–јКНAќ™Ѕ.ЫЪжьс:kХ YЊцАб‡a /5p‚3]ж”І%'Nˆ<Рelї/6М зФ_kI—М\Q КŒd“›Џ?m‚ЊЇzKЅ„&?ДWЉuя_n]У/”щЇ[ж}оz|vn~Ц„‰ѕ2†Нї№иљ@шЬД8…ХzП‹Ѕпрйeи<зМ1з—trŠ“И0ЧVѓ@єчjE‰qlа+ЧH’С;UsšэБ†уъВЫцжKЬЙdљœћЉ4я? СN^ЏRВIћцЦтШКN%nУTSMmИfи‰œ<)­ХƒОа\—Xa^ј6^šЕS™эЋыk‹XmІпH›"КОu щY[F?ям=fŒ q=4Оуц8EKhžзH:ѓaaЄ(Š?Гџу$Oд3“‰ЌЫ`Znя[‚ЋwбГ=№жУрЏŠќСЫ‰ф“Ьeк‰{л…їЖійЇ“Бˆg‡3&(MqчтY$ aLЅк†-z$хЃkВЕ™Rщ{lp*hя\Б>С}iГТDЧ~а{ эЧєаTnhОТіСљоЅ‚ŸnОеFV‹>‡ЊߘЅQИ–цAќaуFзю|љnLptJЁњ™S)ОЭУ<ђGwxH,ЫЬ.шЎЁЉPП{aX,3В­ѓo0Hі9ˆ”ѓ ёїљхZ}œМ€ лЃ‘юŸbr9‚Uždб„лк*@Чђe7R YЂяcыЮLcŸњQ_vщehiЯц”Мє–fўтsR­&fЛЩk*i:О{ч<‘ŠЕ$щ>/Bи§л&љИ†Је’э"+$‘Fв яи ГW<|^Я9_єЏ8Ф:Й.vЬЎАihˆъ7§Ѕi‡зЙ]яVэ&Чуі‰фpх#UIк§[нСчZёWœ(™FiZ~Um–UС1<˜”yѕАœЦŽšЧќBвЌž­р=Й†­врЄgEєFGŒя3УsГ*цb„?IWaаl1Nmй№!_=С—<5mДЯе“ЇTЌrbК}БTЂrѓЌГwР&‰Ь(•BёšВзHШ‹цгrзНбфМY!ю›Э5шЌ=]њЎёexqЦiAZ”Пйi‚сzdіІЏгšЁшXР§ЫТжо№ЖЊйm)іkЄхx|іSкэ У{V9xЎŠ§ы‚33~ ЉбЉ‹TUs;ЊMш!=ћ"*BŽUс­1‚кЦC[CkПZ}сС‚є.њxфPжЬ\ЧЮŽjд"щБЉКLиvЌШV-т"'ЉіEЎžе џŒ}Лі6ЭтžtpкrёЬSZШдЗ §˜цЭЇОBj˜OЕиР УЋЫ/ИАўžЧј—лђс‡;ЖёХn7с,7]S/вђє'Wь<ќYzŒу X Ї’qЕ5ž^Кƒb;Ž%u\|%хЁП:ˆ1ЊiжЭяИ)‡$ ’эB™DђuЌkvАzl+†Xš-ЄN]ћЧ7јWыч873ЁдN%ѓ €З8хfrІxя•sФ7ш^эXЭШ=ЙЖэчщ@ю†ЄяI4žГL”SE -”˜‘П<уRызПЬЋOi_\Т|e3*б3I(• k`y“БѕЃPЦИы‘уУWˆХЂї>AвИ‘јx!Ђ‘мFп­у;цЎ ЌŽŸЏЬ“Ч!ЫuіD#Bјx\n№вб=xŸˆСёУ2BGтвђ™†g_^фnŠ33x}`шK/;Ћ"U 25јІщP&B:s/Жr*,ЊRЊOБ1<ъќ…Цќћ'Ф€тZ~"EхэњiB)8zєўёхэѓ*”0SЭ'МДбG%ЮФ:Nш~<Н+h9ЧFNЕДЦер-RЗYцЊВЇId ŸРh–\Ibюfрх…FF—&Ё1}ѓЂЇмdOІС5пДŽУSNiЎBРoDХуЩю‚eВE№qcдZ*№6рEŸd%=лYёeњ)’Є1кциОшXШя†уэVёŸЯaэ’aчПšEŒ­EШ~зиф8ЫЕу'BŒЯдюЙ|ЙpУ+D|Ž*Т|’x@Sљр:~зMzдv]єЈлЛКO`˜_xр}>аŠQIР‡x{sсІŸ?“˜xлTДQВgKнМСО6ц+qd†ЋuПU6Q§qїBмьнWSY*щ XЇˆ)Z31З=AYСЇjхBnнУу№єяѓ?Ь†яйёЅ8гм/zк™єќ§іV~8kбœУ7QХkœл:Њ+ члЁЕЩД.§ыЩaфžџ^7Œэ/к;Ш581/оƒ‘јнзК–!ќ” =ЫB’pпђзXЁ™T•‹Аq7щ†*KЊЬъO_Ѓ3Бъ*‡T[$bdЙF*z7FВ„7Ећ_$М+оЛуЋaПВhѓ$ЫŠЬ"хШв‡Yœx­вB)UиRЌžT g'ŸU”Л6чИ  ФВivŸ6ylЭzWкwВт]ЋqвздYzaJDr*А(N€vb€žќpn‰OЇњpчUЂfоB№ыЭ§”bЯŠЋћ#YFс’чw8 1RсГ>4ZА'@lЛЮЬЛєСЏаœ:/ЫєwM,VƒžŸtніYБД™z _-H/=х4юcU}m•`@Bаѓѕы%†nD8_3УЪˆХ“іЇеdхZ ІпђќˆфŠƒ‡aГk)ЙЬ!ПЄСљяюї<4"~РI Ь^є]О‚z{o}cорзІx…1•6†bvМDО!dЁоwчyнЂЭрIFѕЇVы'Љ}mzвФHgLхѕзЧв’јŠZЩДм7 WuлеЏZŠy:йrщ'S<М]Н’3ˆкџiЦ( endstream endobj 188 0 obj << /Type /FontDescriptor /FontName /YJUITE+CMMI5 /Flags 4 /FontBBox [37 -250 1349 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 90 /XHeight 431 /CharSet (/k) /FontFile 187 0 R >> endobj 189 0 obj << /Length1 1595 /Length2 9208 /Length3 0 /Length 10263 /Filter /FlateDecode >> stream xкДTдkз6N)‚"]2tЧа ]в’У0Р3Фа%н!HI)внн в)%!%)zЮsЮћМџџZпЗXkј]Люћкћк7•š&›„9м " ‡!и€ьœB)eey~''7;''&a љлŒIЇqt‚ТaBџ#@ЪB<иЄAˆ‡8e8  рl r€|B@~!NN'ЇрсŽBi д ЬP€У N˜tRp{wGЈЅтс˜џ|СL   ?ыŸt€„Ф СЪ „ФюсD0Ш  C!їџ*С(l…@и qpИККВƒьœисŽ–ЂLЌW(Т  q‚8К@ЬП T@vП˜БcвДЌ Nй5сW#№`А…‚!0Ї‡ g˜9Ф№p8@S^  j§ЌєW+ряо€ьРЪ§§Лі'УэьA0w(Ь`Е…Te•иnVfў;dыШЙ€ Ж Г‡€?7d%д ‚гs;BэNьNPлп9~—yшВ Ь\ ng!œ0пOъ?ДнуЏЩкРрЎ0ЯПfnё›„ЙГ=‡6 ър ‘—ў;фС„љЏЭ‚№r №s p ˆиŠуwy-w{Ш'№ЗљЗЇ=м`ё@т Е€<ќУєtЙ@GgˆЗчџtќ7ТцP0`Б„Т0џ­ў`†Xќ…†яup>hрќ§їЯ—бƒМЬс0[їУџЬ—уŠЂ”Њ4Ы_ŒџёIJТнžl@/'фј>МџЛЪ?ќџУ§U §ћnœџ”‡YР@ЮП8<4я?<\ў–уп+Ујя#TрZ†џ•О!'/'јсјџМRўџtџЛЪџMњџћBВЮЖЖмŒќџ7ШjыўwРƒ”kЁ Xиџе…ќЕЪЪsЈГнџіЪ#@ы!Г|8‡“ч/;дIъ1Wƒ"РV щ?Гx8У ƒЈС П_œ‡,NЮџх{и:АЭУЋтє0БП\ Ї‡Dќюo yXВџО‡ 7џН\М|Ѓ#ШѓAˆр |X[sˆлН8иapФC рГ7Рюˆљ{Ь||ЩпІП?€Cъ_$рўёs8фўEМХбCЅбCхбC•7€Cѓ_єЉћтp<xџРџъ ийбёЁiЄќаАџр?ЯтcЮMУСЏ­+›.Ъ$Ш\й6F„$_шqБd?AtЫŒ›ЌЦiІЇЭ+ШЮue­[U$.2–fN<з+)ЋмyЮи(eXRšХNпŸ!OЦ{ž“SOуд!}вM”|)”чиЄFёМ CЬмВ[“Ч‹ЁЂs6о•џ‹,ПBP“JK[й—4%BrAН5 DНYŸжя)1Cцš]LРїHУА$•дŠТ-—˜qЎЅЯWzњqЛ(к#ќ\ќ7iƒИ2ЏњШЅyаKuГАo2ѓ\v?М№4{')Чd0Юџ%v#Е[wЭ7ЄtРn3jгљѓЋŽЗжЛ7iпЋ(јpьгLе‡z6~V–Ÿј-*œRоЃњ=nŠ)с>ЯxЙ—},зФI^jлUˆ а^#бМ‚…N?`ЬPzhsESЭ ”bn еSє"чьсђ-аяыQ™П7(№‰шДŒџV6~™ždЙћцNЫœHЌЪ›™8LђЦfтKшл1ЉApа[ЈD–ВђlCЖРc“(ќzAAЕGщЕ”Om,>—Гšљccн.Ыhw“нv™ŒљX|ЃLпeОВ>Ч/О|‡ѕ1ЬЧДбц“јЦ'bѕхj~фW‡Жxnч‹Ж9MЮ~ЩЮЌ\:MRgxOз‘mљt4П:ŒЁјХЊC†ЦЄв/ЩwtAeшЁа#][‚ƒцWЌ=йJТ]j&ТIœ№—ЅСУ—œ‚аЏюќэzќ”jйB ]x{ТЫaq"‰­иВfGиЋE<™ORUz=хЏ‘РТŸ†Яxˆє#Kф#XЪёНА–Œ@Щu zxQ] ЏyQaJ@ѕВЇt“љsж8 уй/‹f•Ќу&ЦlџЯƒ‚O6Qo˜Ьt=Јnоœ–іёЧвŸЋЃзвЃмmŽК_мp˜ФsЁx^“sЯПЭпќVŒЫЮаiЦ иoН7d>Z}юUР},&ФГІs]жщJЛрЎ–щЎэиоNЩЫЄ“љRhIЎъѕгƒЫё…њєњ„d'јЪ2y\$#юžDќЛс‹hKcР§Й Я вkAтMЎѓШЫTѓgUљD$~mdW^+ђAmS•eвыќЃXс—žГы=—oѓЂ§і9CЩ_ Хт'(^пю tЙьЬRЯїhКУ`IэM˜*nєЭ2РCКСMѓъЗ{%МЌЬ1?m zЗw€ЗJУLвuЊъ_ЄО/ЊРaВNў4ЎоДu“?щZ§сЄ>,тU%њЌЌ>Ÿ\…2z”ны7zї‚ъ.(цw[ќRљ<}iКFдYfёР№4АЪMИќ-лЯ ђeЄkQьЪњTњСГšІ†4ƒсјkTЅМ д*§сў6ЊV%іl™UˆI–TFŸ#јDžzž†зо6˜ЛiН=„FїІ“0dїіtІЛ$K‡4ݘэœ•QьхmЈrЇљ(}™Ћ<`НњMЅ‰[JjVѕФХkИNќ*tFРУ4_И7И)Os…Јїа“бz”]QC?ђWы s№Я„њŽяяs“`#SгяCЛ” 5nЛ­S[™wO?=зЅ$kцRщxКXgGx№\ ачrмВ—еl+ЕШ{†rž5ЩˆWњ…зŒ'шWƒ7э9q.&Њ!ё„)вд#*7ЖEДх${УюљœћЈшЋ Џ‡|}S6uh82хQКЋѓЛ(y РЗНSи%,хUЏїГuЎXXrЁhѕcђЏ†TтCзhтІU~›л{UE/vвЙ$Кс>vыѓ 9(ZСэс'Q[ЫŸєwsЎeЙЁA“^СМRКdLY‘Iў9~WЧЁУ3|).оЇјЙ<\’ЁЂи(н_Ц‡NŠшŽ|О Л ѓ˜HР;G>й–Ж&hЬЊ<žI'"љQн)wЫBиNЧ–œдxІ“>юˆ‘џI—й –H›*^н$%–ЖЎP І6я:о/|a•ЇРОВуц+74!?I(ЅVаLЩUБЪZН)Хъ1Ÿы§€’tжЇ'ХЦA‹CIyhCмќlTP–wЄ‹ŽLbЃmХ)Єе—?ЏЁeВЖм{Cќгjaтў)Ыdt^tXЁOы іwcЌFVЂфъ@šdUuѓЏœA-љ)Zцrlў[Ч ЪСzвZB>т lё:oх;Nс]ŠU€"dƒ!Zьq@Њ@С­ІšЈš!Щ 'Hяйб5sИgсХvћ†тЎM8ч$*ПЌЪŽbVS&IeЎLайЌЈ8ƒњ‰ЊJcњв0ы9л™р.aъ+Š |ф^uLзzџP%:ыRсU дq;)kђЬ+ђCI5‘мзC“<œKИaмђoRДёPЇ.Фі^/šЙ Ю3Ж‘›M:†М­ИЊ2ŽТ МЈƒј+я1…вм­ФПшXŸ<оa)Дsк*и Dсќ ­M„кмDЮ^юЕ aм# Bц…UОьr ”-ыїФbКqn Ѓ*fuяб+"С№MjnЫђчЃз›ˆќ):jEіЛь(Uц4‹б…ъt wN …уСЏт€ТЇ•“?^C$q7ѓ!?EL˜Ўдои0‹kš‰дЁФf­хќР%ЫiМГaeШzA9б;0ўlЋЪеDЊі‰JŒајІОO9‰Aђ чьy№ќFА2€ярЄфBpHЃlB,moЪХСљ)О—DэLНGCЏЪІt>/™1ў—ыГaљz”з?lЭCњ‰ŸtV­˜&–Ю$Її@яУ§…r(N›<јPУy[пoFц?.јZ+|‚bƒ•9Ѓгw(ДпџЄ`-R4’>+…k7Ffž:$ЇіdВЦЋs~Ћў§ШџЙjХкхј‘жДА,Ќ%РД=œXˆ\zц$њq$О§ь‹˜фтp‡ѕуйH%M]ю‡z‰)йт”D}ЛŒ уЇ{т‘ьxЙГNг БЂdTFфГ3 ИЧ'ЄžПО-s&nиžR'Œw—Ši*бuš#ќŽеYЖFVс'ЏE†+;ќVaП2x‚ѓ#Šž­BЋѓqд†ŽЈЃk‘p?бХ–цŒя(ѕiDЅРE|–мr‹„џ,ъgЃ2шL(.7DџЩМлрањF(‡;‰…б!цŽшВƒё†iмБпUEюІCeК7Њщ їZћіё$уц:АpzвЇcлcRУZТѕТЙ$@ƒP(sјt№h ;Я?›і9ђRBў;MеДЏЊY;тяŠ[#ЊЩжнq)<ћВн…Cш‰LсЦВŠ~oНи/ОŠS №xр,Я[о—цІEБ!aѕу<Ь%hO­–M  }*$ П,%'lЏіMнБZЊZ”в7kcф щCIŸ€Zr›ёоАVMKза›ЁЛgч9 w^*г#="|РXџ эЙ“MVіјz• UрХЌО[рXвšLѕћъчХ­Шkqgu Ђє+дa’ўGФšр3сЇ$/М}yЅ§6ьЄЕ›Ќ&З}ЪL6=‡ГO˜дЮžаБqитz!vе%п›Џ‰|уWЕž™XЕ-[•#Eй'…Д6-ОЃЈ щ—Њ.ЗœЎ€ hє6 œЭЩеI{ЯbЪ\єCс6‚єГмg•ј%М\ГzНŽ7УОлF|[@f"”DдЯ!z6Яо-єš?6esв§^ѕЮtЭp<‚Ёчn{pП™jMЖjj,ХЂ\@Вnкb.Јk1‘ ЉВ4…Z=j…ЮlLœИл%ЮX­–OтыК3eA—ї Z šаkFДGжѓrЬ о jSљI“ЬjvwУkЄSђДм'ЛžЪЫ”вЬЌыtl…w%ИгKгО&ЃYjнъC6Ыh'•™t€у-ТsЌ C[՘Ь(”b?бњnVС 7• i5kDˆzЕDY ЎжœР$ш0єУШЌIb™щњ  pЩ#шчЉ\.*/zle—RЕ)ъжнН6d>ŸсЭq“нP”ыЫТ?švй;a†c…%а5іox,HcЕ№!‡dOѕ'я­МƒвfшYбА+ЭfЏк/=жєЭ;хЋ"љ}Ÿ:НіГьѕО>ТЧЯъЇ^Йg'|ОэƒzШ*%ЛгН?нŠT:ИД,Q™OoЬ!К†="&@ЫmV$>Ѓйi)М<6iТ Х~m\ЮєhMї…@_гРšќ* +ІђaвУiЂ’MУЯєqѓ‰š. gwtdŠIъ;сk €ЭЯОхшЗЄ<‚QДЭSQrOЄћ9ѕн­˜Ж^МJќ’\_6v3‰ЛхЮ*ГrtЙ2Ѕsн§ЕOС7 {јМћ§j]•m‘JoћёŠˆЁ­Й Т #ўD8ЩъНyT!Мre0КNыNб›9ŸЯСФїШЭSёзКпvзэтиL3Ђ8ь#"5>6З‰њ9"Cй/ОxњХ kуќЏKLH??‹9Й.ЅOж/3FОбоPБ9АЩˆuжІбBГЮ”•[–?уIЏqA$ЅЉчАXюНdЋі5њ :§ЇфЧ‹Їg“ws‚r]к\Ч—lлHР$pюл&ѓCщšЇй$RmМ.Š›2WP%ЊЋК­ЫњЊђW 8q/qžl"boTщјu=тO’і­}Ъ;Д-ѕš7іЗbЂ5лЩЋ–u‡ё…-ІЖ ЊMCћЂ9zŠбJ\днЂ‚ЅДaщBп‹_}ї}œ0ЕС”сХ’-kG&'–ДЖMХѕ’і›Й.pЎjQœ'; йЃЙA`aч&Кml0žХeпхљzNdšFВљ^Ъ#Юg,lэ1iјфEбwЊ'm?žvƒЯѕ—шЦ;Эp№AяH НЉ],ЦЈVХљыЃ­УШ1‘сŽ/…^HЅg­Yc]oЎШЎYVеyъ\кVCІ]8\—эЛƒ=ŽьšŽ6z7І&ѓpWSЪЖWtr3NЂБ‚OтЩфЉG Х2?‹€ХƒЋЬ{dШНSЃдТд™5˜ig&СE7эѓsXИђ!ГЯиbЛRпюŸЈ Q?BPЗ Яd&(дЛ'lѕА+'c^š.”žNŠЧ,Б@ЭВ+I#,lмJ%{fNzх8Ÿ8ƒLВхŽњXЂ_Ц?KљR‹гKG БфuѕвСж5'3јўсБ3+н№зЬG„Жdдъp&?жЊГ6ЊЂЂœŸŸ‘в0pŸнЪ}ˆЌ?QњмŸAџьчєЯZщ%ркšЂP7:‹Ш ущlшN ољsЌТЊrюяГl†P^jлмВ.аLN$”СCЙ#UlџЩЅMЗ!Ї“ђ / ˜kФмрЄŒ˜иEЕ€gL*ѓЗ Юp=ЌŠє\ќЄї›Є@жe…ŽуќPе+ЊЂ“ЈкœІ"Ю\мЏBЧфиФЧBи-Ійл­‘uИПЊбЗ;ЂqІЉW2]ЌUEЮ“(=…aR KимЋ №эзфЋ 7и€U."ЉУ§Шђш™фчwтФуŠ>Fц`к1Š|1рсqЈѕuxѓвy`ƒSЭ„ун\оЎи<Еs|§~PMsі+ёШ*@щШдьffxbЕЃJєНЗЙ=єŒl•”Ž™ŽЗџ3+ћЦ–oФ—A8ИХY˜§UvћзŸuсOЩA—Ѕіt}[ОЖ_>о/`0;S+Y]ђ%ГЎпф’…сѓu/хЈ‹Z[œjрц§"еjџЉДЕп7]…7щљФ ›В%Я:‰Б}3П0žЈ†‹nћ€ГлŸф)МвSХщŒrшl‰Wѓƒ0&^’aшЪŒ*I810„JМYp•=Чš„‰УЦ{%Œ^ъшси–АeBШHпg…ќжuјHxеRbёgoqџ‚@Ѓ‰|с„y‡цєш\эаОиŒM.о$вЯэxАЊх_Р?є•&е№јuЩа,3dcQ„† {ЋФП“‰kюuзЃэ:,CP:рѓљААЩ‚i(Ижi-&$сУuњXnљЋWgxё^мwjьжoЋ6Яž?oф3Иgбі4фё8`QЈк‚*šОR"ЎБ}Є$Лшё–Єлx•И;+Я 3s“š>FСZzJIпл‘3ї5ЫY-бТг к ƒтФzёžвРmСЁ˜b‰Ы- |аѓ.kІaмz)-хn› „КŸ‡ЮSjзхФВЛ@И:§ъ…ж'ejav9mйфйјЃбаЎЎа„EN•%лњпеїŠZє№g0+R]OЧ†uw]Лn дЅˆS;}Ф|пSпНПеN'рmџ H<Ю+­uw‚ MJv&uЄ Ж•eЕ>.ѕе#VЗp“њо” 'єє$nТіmBЃУ`нмниьгѓxLВ–КVаБАyk—ёшž-: NC‰Awtr2‚з“+$ТКh:§ЌsoWsvнŸЈоєОеСC9і7/юЯЁ zОytфћ4˜ыŒpВ0VKЏјsNгШРхГ—™h01ЅDtuбрgoBл4•ЗзZA?/.КЩЛЉmR,Ѕ”&c0'fЏЉПŒЦŒy9j‹O“Ж“….H/љVйКYЯЏЭw‡{МxОЌяl&CврkЊЕыєХ Кox>ѓ+љ“ •вхЉ$ˆѕЛєСЮyXOЙTеG@$™Їж`Эdsš/U—pЃ}ъіУ]яИjПЮw„vƒ˜ї ёЋн9Бv[Н&яю?ОЫ—6b}ШlњО’d,#ДЏlЇЇЩOо‹„ЄM_BŽЗё6/uЏкj§ЂУ" 6ьВ™TмЎЛвbPж‰єeз+Ем?ќИѕу‹КмИ žNгžњUk$HkРLyCЙЎXСлžТоЗїyу. yt[sНUгњJ\p:Х№›%ў џB’Bшеш4бQ2”р7Xзƒ щифƒйђъЩhqYДT‡IЎЏГ—х‘‰­“I‚ž:ч6э\Іlg•іНнО%}лYzЂНmѕђ(­УгZ“t j Ь‘ё_‡RѕЧŠ щ‚т+DnЊюFIТs:Ђ0:Wчю4ѓЊ'ЅУ*ЂЂTкмъНИЃTЪ“АHŸ9иhˆПШ'њ–wЖЄ7§к1Ї5-Љr eМЁi|Шј{дЯфrьr5e(*ЎžKЃђ%Zфљ‡WФКy]VюŒВmШ=ИŒœIЖ h›т&3} б•оajШ‡‚4&6|м•І€KxSЗ„КО ˆM{‹р)§ЛынWСє SžsЮХJ:Ўч„з|2.BЅпЃнWЌњ>IЮёАbYѓ+(nŒЙ-LZJbFbDрIМЊЬcгџРаіsк#д]tЫђ—ЮЩ‰тЊKJA›<Л*l;(wЕ&ф+з ыЋXё6ЭЭм[Бњe IЮmВќb’…і ‚,-€‘кШц:‰Пъ&щэЯ сW$ŒЙШmZФjGЃztTWяЙœW~‚„"v‡\їПhЩрY­ъOІ2Їwšу9F Тr1НР}ЊuЇ;кчСіSveEe1Ls‚ќYЇ$,kT†liмƒMzЂU0˜?Rнx$Ыƒa ™›…щІњГУЂ%eэclŸmЏM˜)ДŸВј2жтFyёз~4в—б>2PўЂc=?Qоz\Ј]б*т/М+юк/ХъЫщeЬmМDL­С`›лЂ)Жјro“ъЈъЩн Ж;а[ЋрuдШЫ!/Tоэњось?!йЮяЎ|УЛЊ`šЬЯ›†Ц”™%пбUЪшwB˜ž“зя†2H<кЦЮг}SscUї ™йo‰ѕ ?#эMЃ_~{Vl | #lŽŒЇeм^—ќ›ўщ+cбIЛБЌжСЃРgYиŠхwK‘щyЕ2iІ2:ъ„ZНи–|м/U8u'CCј>ІТбY"YЈr€Ыїg>м8эфхЬпРjaц>WbХ—{?В#Зyы‘t%Lж+;9jЦЧ%˜ХЌйљ?<­БcО^`оГS2J%ˆdŒpvgЅ @ЋСMшbїЊ/0*’ЌsHXXфШшGpЏНОFR(T&`$к’зzЗяl8qС‡цSЌ^:тnџ`н§ЎУyё;JОšr{ЁПУbˆ8лŠœЪёHщcўOЬg;ЁАyт[оЕ‘‚^&Fp‚S†$Е"Гцj(@Р*ј\qБІ6-`ыБ€Bеj†UСfЫaв.—ж5бЙRЪGЩ; Јˆiƒ№1КS>[H,…Ђ6К%JHП_(­XЈE‹BI‰“M7і‰щKIoї&Ozч8'aкJ‡єЁžZl3Њe{щ,“8ƒ\ї‰О\U_8‰R^1Dу2§ъЭчЉ)G+Ў’вПЙИе;xn\Ы‰Я…?аyПsGшЧ,ёx…o+ќО/b(`*“(ЅиТ(ЏrEПб. іM™#Œ?b\цй”ПЩ=Ϙ-XŽШ ЄЬЯ‚Цп Ж2˜@3]"”хЁЂU}i?)Е•”fdlx’эйИuнœЇ ВТЭіэ’-њ‚ѕYіdЙИю‘тЮП†мTдMžA”а ђШqП†#‡њв­2€ГœЦШUёœНˆO–уэWkйХvЖћѓ`ЎЂс„„5 ыФ›>УТЏуДіEaєљ{ŽДЈћ—Sъяћ~2ЁЮxN<Ч№WAі f -RЅеN{'WєGЕ’YПžю\F•ЯЯZYБh9ƒчРho 3нН”љЕЮŠѓЕ#\GdЊ^ЦАSЗ9ћ Б  P„юѕМŸ ы%БBЮcŽ+:уž[ч<…;Vє•йпя>…; аXтАŽu=Б)№№ŠѕНРвUШ; Z;Ь[@—БЉџ?lŽЪIuеLtЗ6*JЁGp“eш:ЧZoљрСв†>скhтЫ}.D’nяЙEќо=Х7о`жmїГŒS"GoˆœЋш-СN‡узXФЛоЈV'ю#ЩсчЊhНlІdз2XО‹Joо сSф№oрЎŽ’?wБ–œ< 9РАН”Уya•ЄцйАџ-ВВ еH“zі€:цKArџUpыї4йг!М.ІЏŒЊ™[ж i,yx Ћ6 ЂЮE~й‘Д ќzћоzŠРЗЭъ}јы€цмьёw7ЪТsыЈ ЇР+iйЄ,ЏnмoLнxИЅ9…ы_ЊeМ™ш|Щ€гўІэ% ОŒeЄhаŽžЃ&/АN§EPyy/нTv~ЪЉˆычRfЃЗ™ц9г>йЇрOС|єЁG8ЂУфоєд]Ѓ§6\КRЃпфйIˆŽбLЖwЮ6ŸYё?ƒЯ9›xНkЙоˆч+i’оl ]1KЬyдЭ2Цјьc›У@V­ю№OёbОєt пО‘g+Ц-$žя­l_т>6Ҙ’=4юdP‹Dћи зањt№Л,Нџ@?Ў*+*­ЛUїЋŽМu冈R&А KкuiеJ6JМ‰ђЧ~qЊ77Ÿ$ЌIe&I]юМkщЄ.ЎTЮ}ўйЄ И[[ƒ>ЄhuЙѕLЌЭПB§ Dжo о‹MLс (W‘в‰ы<Ћq{vhзkяŽxћfbjђœžЩrSЌЩжћщч2ЋpuЋШ1^і~†ъдЌPяmfcорЩЏ™ЂІбІБж <бУіыХЬю’у Œ›пъЖV~XNc0ы Є<œ[3ннoТйшSќй‚9W{l,!cX%•::_QЪѕЋˆќ”D/ПŒЌ[@ŽŽо#Т ŒъчєЫL&іF^}\€+ТIЊЩmwGЦxZšИкю5 %™џС†Ыж—GЏЩМд#сРЏѓLZh6—_дЄВjр>ѓƒХq]ђZ1Ч—]@ЂoсЗL ЮсP‚uл55ˆЧEсK/|^cкЏъЧЃ/\ГJЙЌІЬ }КМЫ)2hЫ1F_(пбГ%"#јVVcЋj+ŒвЅог@Уў;бPб}‘ џ›€3DsЌќЄXДј|•U   рЯ&=”хИ“Ќ{‚rhšї&gъж&Џ˜"ЯЯЂGwћEžk(фи cФ€ўДmЬя>qШлЏ§шŽМтунЪu8ь:ЧЛs.&цƒфFЮ[„!зwќOoПкn- џ0т<ўмшwдOVSы.жЇ ?– їпutуMїЅ›.Ќ­К­fИHпђЙ˜ъьгј“џDиšѓцƒ§м ”И>џ’/=‰гjЃ„aˆЭrїє*2+ПюО‘•Оь2П1Qчœan$йˆyd—rТЊйsž5 …lХŸdц E—гc7h74лњ) {ž@СЪѓѕ P.шћА…Хцг2єЏйЭR‘Щ№“nъDжcљ1­ж…™)™.ЩГd1чЗž˜RЏA лћ’’ѓuкiо2uЧ—|ЎЗHk^…]йJINЗUЇ@ЖœЏБНa'=‹ZЧAЋУНJ$L•ЅZЈ ц?ї+ŠNfžи?nЖZюžFыАгwІгл!2ЌQЦЂВd Z,ИgжŠ•k•7Х^дЄбьЧ–~JLН Ž–пl(5(Ѓ)ЪvVСљОœ№БцJfj|мIбИЯBЌњ$€хЗ']tl. Ыœšx{C СX дd|Ъ5эюАˆ‰$fS/оЁ"HУœ)s2˜o%1\7 Y!ЁPЊв}NCб2ёDАч Д•Ÿ\~hЎ)?A†ЏsчТ4eэN›}„`ŽязO  qv—ЅВ7ВрљщЫpЯ§с•л‹цЪЅђнj•ўH ьUЄМЅтaТœ‚qвЁnюКЛХ9УДчП8Ф@й)I“~7‘‡И%ƒЊй_n8_гъИД 2a Ш71F —Кzъ§L^и– endstream endobj 190 0 obj << /Type /FontDescriptor /FontName /ZNKCOD+CMMI7 /Flags 4 /FontBBox [-1 -250 1171 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 81 /XHeight 431 /CharSet (/B/C/D/H/K/L/M/N/S/W/comma/k/n/u) /FontFile 189 0 R >> endobj 191 0 obj << /Length1 1430 /Length2 6052 /Length3 0 /Length 7024 /Filter /FlateDecode >> stream xкtT”kл.‚H(RJƒ/ 3”t‡tw9РУ 0Cw#! ”€t **HI‡t HˆtƒќЃю§эчЌuЮšЕоyюОЏчОю‡Yз€Oоe SA!1|~А ЈЅЅ&€СBќ`А 1›!ƒ€§Ѕ&f3†y с(ЄФџrPє€A1XƒѕгB!uO ЂЛ`0 ‹џэˆђ” ^p{@‹PG!ahb6E”›Џмб ƒ-ѓїрДу ттwy‡ђЎ0И hA1N0WlE;(0@йСaпЅр”rТ`м$МННљЁЎh~”‡Ѓ /р Ч8њ04ЬУ fќ hC]aёГ†NpєНЪу ѕ€XnCЂБžH{˜€-Јi:n0фgЭ?МР_w@ј!џIїWєЏDpфя`ЈЪе Šє…#8шЈhђc|0МiџЫŠ@ЃАёP/(ЕХ:ќю ЈШыP,РПрЁэ<рn4?ŽјQрWь-+#эQЎЎ0$MќЋ?%ИЬ{эО&ы‚Dy#§џрH{‡_ ь=нŒpwO˜šв_.Xё?:G‹н`юЬЧЮIрWzC_7иo#ф—‹ ап х8`AРс0ьБ?ъ0žА@џџmјЗD іp; ` s„#‰џЩŽUУўШис{Р} 0–{ќыїŸ“–^і($Тїїпѓ0зз4Rгчљƒј?6”рЯ'( № Š€юbџNѓŸ јќo­.ўWsр2Њ!P6Ыoилћˆз_МрќkgИ€—аFaЩ 8џсО%Xl‡§@ўП7рwШџјПВќПИџп Љx"ПЭœПэџ‡ъ Gјўх€хВ'ЛZ(ьv џлеіg—Е`іpOзџЖЊa и§G:b9Юц џбУб*p˜Н.cчє‡IЯ[GТtQhјЏ'џ— Лvv.иgинAЬясў’aи-ћwЪH;”§Џu P_b,!А’рСю­=Ьч7с~$ ƒ А˜”ёЏ1‹ ŽПо6ь5` t`@ёЋ‰_ŠUГѓє№РЖѓ›$иVў–П0˜ЬŽxze'с\бx\%OяЭЗќQ +уиTяc‘5!ІCyФfс‘Сгьr•щvˆŠЕsГЖ‚ћqЮчЩ=џЅš;ЕОТ‡|wTVяи&M\^{ьФР2Aњ'п$MIЂдЃG—1ŽЌ…HжоБУ€4€ЃњУдcoі[e*wе#Е›ZЊЪВ5ЉФП/ъcокv.‹ьгpф.К&†З|ЎЩЂ!еtBќШЛ’lОЋЗ{–МБ5.Tн+ly›5 CЎ,йЭ $LPi<[pѓ<Здk#“ТпV•R‘Ъ@+ŸYŸ†И[Б хэх9ˆРд9ћгcт вї™пŠP!щ'B"mсbщЙc,бŽБўіRs*њ!Mo'Ѓ{GЈІёч{—з[†8ГANЯЫvƒƒњф тœ3^к™ѓё›фС&(ѓл)ИНэРзоЊBвЅ|r:Šv3š"%Œœ€#1iН3QЭє]пћLо eзIљш=е\VШхНr[< трQљЂКe „ЦNq ЗПFя—S0=˜јJ+СЎ<Щ1!ЯY-6Sц_Љ›дqcŒррг-ё;ш›вїrьн§mхю|Ѕ0 ЩХщyРц+&пaхіCŽѓ=џа0хСG†•ШhOF>]}€ŽсјЪŽo*ЖзРˆCNГў ЗЊњPш]~FњццћЏЩ“„юю#XzCfж’OlёЫЧЉЕaКŒr Цv9њbJNbтхgyn~_ѓ25ЗВTž[/e46КZа›цЏžŒзZ}H9іcmvŒяOЊA6е—.ІЫKИЅкнr§НdnX24Ј6Ї[Џ­eЫ(DʁыF% Ÿ[bдсМ/gЮ`я VUљЎ ˆтЅ0hU|qМN!(Нz{І+‘U{f+—ƒы Тс8ІўК7ы0Xї‚Жt ТЬЕ ЇЁLЃS—Шођf%ћЬxZ|КВВўэ&[@QШ~Ю№ы'ухl—$Y:d,•пННЋСъO~>Е$Д™ЉRn\ ЏћсАбIЊKNДъеУИЗд{ЪиyX{эr%6Ч…A§Bњ7`M^‡ЎО‘šЅК9uђn#еe…ЬџАЭgŽ››яъющбЎFс:7цŽƒ‡цFiпŠЛцhgОE5Іэ№’Q)QЖЎ™dvвЊр|фјт4В*Ћ4№~хvизь*'VъЬжЬDУ{|RmTL§$\—ŽњЮšA‰Oi%ъƒˆЅ-Ы”—F+lЛ№I 6ІЫМiчjњюх_А =aіw( хєІ3 дъŒ='ЄTИѓŒ;SАЙбёЙŠНеЇUЅVЦёЦЁ~юsяЁ ›€l§Ф‡8;‘Ћ=>ЛъЇxУjC†’A)’ьф–ЇЩœDZзќf] 8cЎœМ‰U/†X9/йЎТТEУy*%dпь‘Tv Б_.ёm+П7нАhМ(єjЭђЋ—гиiŠw­7\ьЯђ U’$ћСezЙ•–4ЭГцdйєЬ§ŠAЋТlG!ŸО\’1ЬЋ]žЉО&г>\Ї3Š }$І–4І№-„QDtєѕьљgљgvŽЈУ™Ъ@ђШVЧчпОн ]ЈiXМ‡ЧИi0>БЙ9FяЫ]аЉ HЕє u3pнщ@Ј.˜Nє,UюжцђЖ јгY%M h^жQ—’ГPБъy)ŒПg˜я4Ы•ылlУ§ШРУ&~2zaDоЅэќђљRЫŽшУb{CФ{ˆѕEхIђ1ћ 3šŽ№Ч'сRчћfфЙTЪd:ERђ|ЌWЋ“8zцт[Щt,ЉЪNšдЏ.…WxЧ‹-дeЖфэщЫН’уWШ ,ЛZ/Z&и[hЁSжё“>ŒЖ~‡Фjх‘Бv—ќЛкXП >dяlъzТЬœ\Y AŸB.-ЫфwХG6aйдŽysžŠс]&LюuФ>зфп\d3Дѓb@w[(fЊщїгдЧжіrL˜Nй}Щ‘fН+‡›|˜Ќ?птi<щкЭ–ёu{7‘Х>эРчнЕм­ИќЄlІ}BпМ(—“КІЫ1Ÿ{#w…lт6ІŒПЖч›‡% ВЭЅЭTHЇ;_ѓ151SЪ.X%`Ž9x#Хz›pњ š№ №ЕS}^нЄBн™СmкшМAѕ§лœЬk4ЗИЋf+™^dМIС|шЕўF0usg“E’ЬMпK| ЃZsFмtIЈS7#M x4s‡ј]…ˆ†x\D"уж8ХьЮЎk6йшГЎ~ф-@ЅћH†O–ЋŽЅЛєZНИqJз5†Qю’og’1Ъ>ЧуО™TкДxTЖцr+›YЎЙVпE+ ARœS›єІџFCчЗ rpћш}~ќ­œеFf]цІADьЏвŠYч0]/ЪInјІлЎЌ…7)6ВАŒ9˜ш‹с<ЧЩеКуb^v(#цsжzОpuюмFœj‰нЗ0н‹ыMтŽYФ•ѓqс•У №iYšШ‹˜эM›фв™’lЃ%7н77ŽП*…АrnFшЛPœ’њ„К'хYЎ]!x&УuшOeURЬZpЁ&?юЙ†?]ЯЏЖDфLн•Б{Ц}ІS.f r8ЏЪЛЂъuS”в?"zшfЋ‘иЫћіЇCLЎƒ`ш*јТщ,QОоAБ{œ7{Ћ Idў{_—AjэƒvSš7Х€uœKvЃхU’3)а=я|/б.тО.‚ъwЕ$š0єzќVc‚ъѕиh lƒPЛгfгŸќsЬЖRДŸІƒщТd—$ЇЩ6RуУэь%—Šг§№}Ptфk тГ+˜“…ў­•љћ5SGLЇ”ш‡uЅќ*кпьžї]– ї”EЬ…AЌчB-%ѕ/кЕ>6–Eэт:Žк=Эа[-Ћ]Гр_H’рgЁ}бPSьCЬыbоДџj~Š ‡вFХMНTWКяm7Ђ‚4z6t~ƒcІ“ж>™œч‹EMdщEyИ„фNGŸЌЮ;?‘•[Gd:C\ш{47є†мЈ–Џ§Д>jЏG~дЌaЦ)ЮЗЇiѕcJКгіpЪюnјvг7Ж›ФŠvІ+ДJDЛqg‚wЇиŸГјŠ8ПвьЋћцFeuЊ?ѓj&_Uѓѓ+ў8Б!WѓЧл6бђѕ|~ГЛ$‰3і[’’>и•т–оЕ+ MdH ~gk^Œђ№сŸj/с™3 ­И,ћ^2у/п‰#L{ф—Р•k— -Žвœй$осёFлЫ–с ј&3№е=w|ХXЬм‘,—„_†Žыщ•†&RДєЦo6F_vв8ѓ?L;Э>”ЫNMдлўйХуšЋrG|\i<ПяйіЫ%"’~A3ѓГ™e3ƒš‹(Є6^ёRXќЪbтЭЪ/ZЋц“EŽзo{'Є_ЂOЉgj8т™tу:ЧЅецї(;Т nC—`С/˜ѕЊX[@АѓНˆ"пdи4˜7YdиЄ”фˆПoяФЈџщibvДT‚хЭ сеŽЕн[WŒ-тU˜ЦR_юˆ1З %ДЕН(ŒWєdk вља]ЧЉЗЪтЧ|ъАpИXќ–ЌдЂжD;ђН/Nн /Ÿю5/@+лп>Н=ёЭЅћЌ5єЕщ1Иd§cž "—dО•~Ы:эI?~ђzў q81чSВбз(~аЃЉШ…БЕ]S}ЋЮ<—Ѓ…зr”АrЃшf)ѕ|щ'ЧЛЎхgW–qЭjјз<{ ЕшМЭуKО;єГkŸЭіFЈжћтрЪ­ЭЪ*э>ЅeCUК§HІFї~~2Њ—vК<$чедЧъЦ<і‚к L u:’ЪV+( §т<Ъ7Б€$с”ђ$ѓ2@Y/ЌбWШЎєЭ3фгу"A*.­AЌй<й<Љ“џdNф [ѓЎOВUИW2ЗT ЬHб]Ў#ž}эЋ"џвЄ(œnзXЦ’њ сачФ4ЧвўДђ9ѓвwЈчТ’Ђ5?ЎЭ)ЂŸ&и˜ШƒкW_чп…ыЄ55їš–NЯЇ`и§ Blс# fHуVїЋoТњѓц™MУi-P›W НЯm~,rѓKУ”VУЄyъТyбы#ЪЏn№рМф}MN^’ІdђSЅš%*Zёr@>Лb1–N$‡З$šBwшƒёJЪ)чЅt0Њa%ЙnэгюяК†Ss?ъaьщаjЈљЇeо НГŸњеy/gъЎv’<‰!} њ‘В^%vˆінhЎуи3З"“їЉщѕ6ŸXwІW}ЃЃжu7Ж„З_dЕrјьKѓЋ6ЉЙ6Дšх§ћђjС„ЏTјRяmр~ЅdАНџ|a2|*Іh*оaћЄї6Ск-kАГн3 m•Rc œ%PCO=шйЌHАVГ'Ьw-ў–yˆћЖл§с—Д…лЁБЅ—ѓ)#OРТ|њоГЌрT‰ ŠЉѕЖл#?Aƒ~л­БМ4Њšš„„оч#љ™жкC/ЫmwRЙц›Wѕ2PЉН"ећ_‚Ÿо [љzIжУ=(ЏZ&мёHr}ИvIВ9-}шSИšдЗё iЮ>Б‚cЯ1ЯВян5YЄь›’|КXѕХч IЁœл ?E№ЌЙЛГяmœХBpLdUоИ5ї ъВ9–ЫбCŸs Gюy5њ)Џ|hœБцJ}чvu$qt/{ЛŒ‹ѕ4НІƒ‘zЭм+_EсцMеt1/СŠfTФ”јл`—№LDЮОјБНvœP–ЅИ &'1ГrТPѓˆ+ЪЊ+yЃ’Џ’u:2єEw›юЇЏ+ Ђ$ eсiй(јЁW„Zљ,ќvнlьгk К–—ПИ@пы>DqљAЃd‚gОEdИЈnM)eˆ4яˆŒЁdpхЌфеš\mFъ?'кjџСPYTЎ^T†њk}Еч‘k§`*Ў)NЪm‹ TнDюэЫ~ЖŽєЙЙд-OУЈЅйб„zќƒјь eюки7Ы/…‘Ы1zݘіїS:*ч2 Qr]#љ+,ІгыYoњЯbfЌOZ9ёуSхn"YAБ#Єд[їZ?Я­Ѕ€ Пж68ДNx№N,йу0-$ьіЯВМŠииrЬ“>—НŽ,*Ѓxп}ЂєˆQЕ8кbЮДдщ-HЛѕёtцl'†иЁW T”\ч№а7%yјAИсз~ёŒ€„3+ ќЎћ)Ю/жІk d<1б™&ЗУ9ьKД3ПNрŒ/E|щ€”ПTш™QЂБЖZ(lє#мхiеЎ‚ЄGPш=1Ђp'Žg*?ИЅšљX†Љё’dіББwЭ’œ–›BСчЎтФааГ~Ю tg+н`2ЩСуІ–ЅнОѓzыDжО—л\ИБы‹Д=0PŸА2?.е{ьЇš6ЏxNвЦ<ќL’§шыгЎŠЮШs^…вЛ?HU#^щŒ+u‘*Ы]š>іYжєыDv—юšбЦЫ;!3R%ИwJWjcхєd3SУ_ы*г(…ьYVЦ>[цІђ–r‹Ћ"*khNї"їДœєєчŽјh І?QђšВZ‹oШ›<<}9RRБ ^Ю§жpБ4ЫВ7тє‰>rrnb#Bйћ$•ŽЊ1`XVNЗЧ: ŠЦ‰~ЫПўэLпОn†Хw§ђA7iаaзdдNE™И†щtfїCDЊЭ›ЪбbВB;ОМ™ЏK І ­т>нњё—CцОG›€)c&йkcЮM<4Њ/R5ЂMП'rЇ…pЦQлЖxšWФ›“с.њ&qJ1іsXїЧћЖў›ьЉwœм~™M[yјXљБЗYСбVыдr[Ч\IЫBТhAIоfЮорђЈ-HŠШe7MЖЅЬэ’бCЇ*а dXЅ?С2чОќ ‚.Yч7їгІ$x n(еKXём+6ьЁОечp;йв8QТВзёХИ{ыхГE EmЄHќЁЅєС…t})У3жCХдЎ4u!6{*ђ%0БПfР+ЗU`ЩпzhšїyЎ{]bmP’"&Гnрњч@‘_КЄНЌєъš‡ЉiVAЇЎgЎГэщЮЅ™Pж„ŒЪМvБ™‚Iў]|+ѕZо‘~LЖОѓs!aєfeФuШ|ф““Ћо‹™усцŽВXƒvЭЇ-CфšqjбziнZ™„N/(Ÿ—%Ї›вfG q НDULFХ‚{ ?%j)к}GYLѕ`†мь‡tzAВуkС)š`ЪЗisj&šс\FqŸ‡Эіƒd9œИ‰vn–{§.iЌ…]љ™яN:ѓЇ‹Ue(s-‡є4і!нуєsхM/”ї>œБ(Ё.г|‚I(ЦƒЌQ7hcЈлР0™сєаwфъJЗtѓZ`А†NОTКNМЄpЏ7^mШN™їьeхЩе#ЗfЂp ћПOfЂ›-hфЫŸГlœІ0Wцг|5ЬŸЎьy$ћЭ}§Њ}Ѕ–єс:™ъае<•mŽc’§ь:Cсoщ0зsт=*{№К_ЦnъB’p$%2%оx)рœЌHДVЁ%уaу<'\•  цH)л„BжХІ[3iAкт[ГУ…ЁІЬГ$ zyЉэ‹Ÿ4]xЅЗоЖТUЗЅ1–gVЉЬ7&ˆЯ‰,œхŠОю~–9]ЈLЏŽyT“WЭpЬё?Ќ— Ю endstream endobj 192 0 obj << /Type /FontDescriptor /FontName /ZRLUIR+CMMI8 /Flags 4 /FontBBox [-24 -250 1110 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 78 /XHeight 431 /CharSet (/greater/less) /FontFile 191 0 R >> endobj 193 0 obj << /Length1 1407 /Length2 6064 /Length3 0 /Length 7018 /Filter /FlateDecode >> stream xкTTTkЛІ%‡Є†’ю Iab&iE@RщTPJКЛA$ЄЅkЄT:ючœ{ў{зКwЭZ{ілпѓНЯГ9Yѕ љьрЖU8 Х/$”(щшhH€@ P˜”“гŠrќq“rš@H(&ѕп” ыSЁАy:p@эн•—Т@ ф_‰p„@фЕш4с0’”S юц€:8ЂАcўzpƒyB’’т|ПЪ Ў ‚t@(Gˆ+v"ф0„ƒЁ”їПZpK;ЂPnR‚‚žžž WЄс ЫУ№„Ђї!HТbј   r…ќF&@Ъ 0r„"ћ сі(OР:\ ` ‰­@Уь v8РPC ч§NжўРјs7!ЁПл§Љўй ћU ƒсЎn ˜7цА‡К@zЊк(/Гћ™rAТБѕ дd‹Mјur@UСТќ F@нPH$дх'DСŸmАЗЌГS‚ЛКB`($щЯѓ)C0ікНoжї„љќ1ьЁ0;ћŸ ьаn‚Ц0Ј;ЂЁќ'ы"§ЧчAФ€т"Ђˆ;тvќйоШл ђ+(єгEрчуwиcA@ќ іьЉф hˆŸЯќл"иAС(€-Ф #§Ї;ж Бџmc—€z,€Xю €?ПYaщe‡Йxџ“ўkП‚Цš&ZšМПџST„{|ј…%ќТb@€P\ Ž}ёћw›П/р/№ПМњ шŸУџщЈГ‡cћќННП€xќсїЭ№ў=BŽ%3Р§ї-b@0і!єџVРЏ’џј?Лќ_мџЯЉЂ]\~…ЙХџGф uёў“€х2…е…ЋиІ>€ќжВФŠv§ЯЈ „е‡ЬЫq~!QрŸл…"UЁ^;}( ьј›Iэ;У ƒшУ‘аŸŸlј1ЌьРЮиЯ ЛБп!ЋAдЏхўД!X•§ћ*00мюЇ…Хю@Ш›KЌ%№Тъжтѕ‹№A…-`1ћьсвŸk—ъўt‘ўЋ-@`чўbvц_і/ЩC ^0щд|/ФЉ<ЄёЈTсІ'џъ 4сNв‘Љ0џ`ЮCbT—ЪˆѕRœazкДVъTЇъCЇ]EїЃŒљЩo>˜Š[•оЂќЗTзnйЦL\рŽХћ2БMPжтd?HPd‘z‹шТбgŽИжJ"gчаeШIщ{ЛМуSМ'MžЊИfhЃnski^š6“ЄЩжђ}TmЏбЊиwњл™ЫЎбС+‘–ЯuSиДЄ›IуПЁM’CФЃЏ№…дпЖШžh,џ† Žоў>&ёNўbѕdа)Ё(Џ2ьы{f:ј!b& rпчУчЅ@с8пЎђs‘’RЂjˆЏ‰–Ђ\ЛYT7UЮ_З•=‹Ш"кІ@V<ш 2™fŒy\Р“s–90Ёѕ7X…&VГТЯњЁЄыLмTz5ЖБ‘žИ­Бt гš#9ЂЩпгPТ‚Љ№ѕ[ЊЏdјїYDТ5nЮМy;уY*]O“Ў•FSЦ,@о_БЬPє Л„ŒЌ")ИoЈЊw^нЉ}Ќ›*}сѕiZ5уІU‚ЧўrQЁшц†ќzЧѕ;oЪлЧеКфrђœ:цuщЩщД7чћ­ЩЇ‹pzИќ5nиЋ–šщЇŒJђИэЄЎщШ­3јBЬ>мžxœџ%2ƒ М юуІ E”_NlЅбx€2™CМЁ#ћФ>‘ъ§ŽКœњd™qгnNё …Ћ“н…|?Ц‚ѕЗЕ РШЈНтм˜~G)њ"ГŠу›aжŸЗGѓЎяƒж=Ў3ін љ|™вѕtумѓшР§тIп@TПОн‰уG^ЖeмАыЌКЯ!ЂёsЕхе_х'" ћЫіSЃEeЌЧљЊЫVГТЌlгvWСЩJМТ2Š˜Ї…Еђ&ŒuЗ‡:"lЖжŽь№n‘“оos~ѓ ћТmхШ5FunН‰’Ѓр9d>єЕ4WdмжN:фоXHЩgќz\oЃ u}гыnЉёСќ]‰<@bG BAсн8cыђЊ1Ў'dч~*тЭ;0Ц5мXмйЄ`)јж^ЮЕ8“јЭ4К‰+‰BK/0ž~юUюЗ]нf=Е{šn4ўу§‚7Х(ЁJ=ЗJWсхМы у“fоѕаʖ6N1яP— bіЊn жщV”&ЕaЈўЈQу—юХђн жAљUVКнќg|(Ѓ,Х“9OК H>%ѕ§<ЊAYгŒAд %YYў'`ˆљr2+ЎИЩ ­ЈЁї=5ћћˆ…бЁѓБЄєжœ гйz74э3‘Ч†шn'Їm‡й9•~чyйŒlДz‘ГS.&ЉЬ5бјАЗ‹ыu .tЫ{љŠvЯLž[TцѓЁеUYBoXiЕ:€6l]ДтвПЁg•њPтT@ЦšќФoк/GKутmІ[&+O›Zр•^;ѓ6…ї„Йlп@hџmеZ'Г@ѓ… xšСSБЪY2VGІюЦЯ)ѕ“ №ž™Є[Н&к (Y-_sZƒ Э–yлŒЅi,§P/љ№єsЁєЦšЉ~ПЇЫЛиЅДчмЙњ•c?рК[Мё мv…Rї№ЎТљхѕpŸЬ =Щ@ЅАREЬєЕ љтЁіЦи†sЅ{WЏф№;њdжіиуг~Ш#9ylW/šОТй\ќ"Мљ !—uW›fЧЫдкС;уЋЄ„_юКРђHц“У|юP*›[’\Є{ю™$5rд$S8СAщьЫдЋRЛіœ‹ Њ‰ѓриИIЅТ0Ъ]|’ МС+юIѓbЪy˜iХP-‡ќx…у щ˜Ж[gўь›6\ ЎC$1  KˆЭќ&:,ц;У}ХLљхІїœŠ)ˆюўй|Эж UО|­ЧЗ] f›Ќ“ƒ‹'й~CУ“Ч"‡ХRQїђЅ4ощПј*‡ЈNлђлјњНыŒ™ЗPфЊ~Ї6ЁFЌRyщЙЊcЅ Пt€%Iw-XєЕy@s`fшЇy‡•ђ Ъб‚зс8D!W*-ВљjчMНj<[J™_˜ WŽ я r$г)ђS’нч7p ;мžщ№и& zŠул!pыЦ'>Œ\ъ>[О }V` ЎvŠ]љ~t3cВЉфЧ•<ваCљњТ’^xССPOE’Tъ-*:Ѓ ЂMгЏ§Йвš|ѕ’ЊћŽd™FЮFСI\Л._ЌzнЎ~—GЌIо—тЕцэ`ŒЩМ"Ефƒв’)И[‰(&љРeЃo5-­DЇМёEИ,МЩк—­jw ‡8ЩЋэjr6/4OpYЮ_)jNaIpХВблК)Ё‡wС[ЉёЮЂюбЭфqa’€…^ У_щ щљЁ+лFŒQoš№Ч@Є•BВп‡gгx^ !ŸЎ#d\7^б\НŒх]jЛ€дDе(Ёcм(ЅШЭŸ}хтщЈ›ЂНЫ;љѕ[§­Ь-Š{щ,чБ€L\љуї2"РФќaс/5sБясє%Iжх"Š–@e€Бl8пŸ}дš–Ÿіy@Х›+HдЃ™ћќДL€n-о‡ 'э(JШТќHKъЪ}Sсэ,'<“ˆ=†#Њќ Ї.кСќnJkыAеXоф-Б‰8Cъњ€•aящ—N Эн9ъ9dпoq [tuЧGхо№ЄЦIЩє3а–ЬSЛk=?Ё3ьиЇRTюЇ0,уЙјъЊFЈПЪЧ8]Цˆюш.gЎнЫАЖ&šП>>t|<&П"u‚оћў\3Ь}0ZJW=ўеWе~Ю0ЧмкШЛ ъц=]єwЌHœeЯ’š9ьеZWвпЕвDГГ…JK}Ъ=бюWЈ?Л1уFЫT*Ps 6†i3идmе?ЦI )~Šm(ˆ8ѓ76:я Зї9ЈГд˜~U!pMа6M3Pˆ#@RТ*MЖMэЁB;ћі‰nгЊеUчйўж DМiTЁ“ёаS‘ь„0[ю§ššДУ§Ц‚N•5#ј2†6еŸПfС(UКІ-ы8[•ЩьўЕЫЕWœ9Оœ’ѓЉЙe$eCFož;%n”EЕГ2%,=Mљd"dyHтOЛ}‰Б[P‰MнА#ЌW.Аѕѕ‰Ѓe˜Ÿ™{ AW…V Gо-$ж&}Эцќщ#€KжnЇБЁ6,Эqr2зk‚d+ђ$`Щ“2АЬf•"ь2qЅЩя/ч)l $?у<ўєSеЄfєЕX[Dљt!ФкШшŽѕ"‡ЁрЈЌ$лћ5I_Ь/ŽAФxыa0LХЦг•l|Ssп+Ез7[<-SŠsж™a5”т„vоЧ@ЉЦ)8Н" д ч`6чкJmN­ЪBьv4 %8–ЖSˆГй|с{I=j—VЄœ+]"я–eКф|KпћЎј‡ОД‘†ёаф›GšOSnvй†л;bN‡ёЫh”†ь“I\ідuШтиюYПnЂU*И%Ц?гй~дб“ иў*”žчˆљЄaЭZ+X"‚Чд“•Ї˜˜€Q{ˆЏ‹–)7шИ—Raшќр,ANМJ[ХЕED#ѕЙ7Žё г}DfЂЪ\  Ьqц?S9Ћљ№CЙёEuЎˆ‚љQў›BЛеmG’vэ7_AŠ‚ЄnU'Е5Ћ’ Џ›`R^МВѓЩ3ИкАI+WOГtў” )9`A_Ж+T’O§™Žџс78Ќ%Y„†@|tДV9Ф\.гMе}O˜UJцю9cWЦY лАƒ†СчЭqž8ПЪЕЯеђљimW0Zš9{х<Ёmf*QаFа|'>ёyн‰f~ўtтHЋV– eђь?,^tб˜EЛzD СZV]гUržZ5Л›:Э?Рѓ^ъ_ O™ЕЗUТТг55“Žž„šмaн;іm‹K~иэъЫхOd= ЇrЛв5p%џHцм%^Хак$T7~џ"џBЄ{Вy zс”†у9ДрВƒаHŸЩйtB ŸаТј&з6W“sеЫ-yчэЩЗыљ•[RТ+JE”фx}ЖЖWЬйFУ'Ч…=‘Y ˆ†>ЕѓРъЦјіѓ‰ЩєФ’ 1љ­щPхDiв;pБя7 UƒЩ!ЏіŠЉXЊщ“шТ1 ŸdHхЫ…уй+Иѓ"д–[r)Ш!ЃsMšѓ(Š†ЗЯйЬХ(ћRoœh‚СР™E’sWЃюЙ5№љMзн:‚мрŠГ*‡#?к"SI ‡/nOxLфzy‘{с…ѓ!‰ЩДUPKhКДYw7nЦ eџ>#с)йЌіBиecЧLт­ЦЦVіл+СпMRYœ:ѓ{RLZ@5д5О“їцРш`nІ{днzoД>ѕ(Ло}фЫ$v 7ГЅURV9VЩY:ИS~W?Ы6П4ў–Јhˆ‡м“–GбцЎ_0ЅЅ+’№сэVЛ§жjЮЯ'DЗš(/1_зˆud‘kOН љмїCйгЇ2Н=ЋA;`œІжg1MRрsЙЂIeїА^$—№RH:.3UеSн,S)ХтЮYhqыЩ‰Œ‡„KQхЇЎ[zьѕй}йщ‰ОKAqђcWвSЎЩSU74ЗG™А7^ПП Ь9ВхM>ѓЮЃЩtт­z1ЖRш~§šЅ6Ыгwї'wзjЖˆ9|B6к_fо– +V|9<яQ,LјiгйЂiтSЇЗ†ЌVёЈ­№(Rs6ЎC5Рњš:NЉЉ6оН+ЬжўрДeWбвлМo H€сSiю_ѕBuF}VхоЋF’ЊЗѕmMfЗл^cpjtJЕQ[ік#Rh$я2)ОLЃMЙwцд`мтю„ЉNЫF/еbdѓЃм^вЇїЫфЏћQбйлiЌчS№фкйћноў™ŽзћЖwкRІЈ6ƒ"XO-,дkoоOК5>і>ћ…tPuHц3ђž3A6Р‹~ю\щІDuЊbЙЫ"Ў[hМB УœзГЁвwїкmюy]ŒЛ)KАЧg‘ЛШWRЁ$O EЦllв-!9ч`њHyt+ЎУ CjFё)_e1к~4 ўpЉсЌr@ЛZўщuwKjМ‘elЪ ьє}b[ˆM1дЫAр)ъ“xЎ(уEэ˜ŒiŠЯХяом <јтњъН Шž~Њ/YуtcИyЇтI+ТБ˜OЁ›~ZыЁ›„ш)P`ГоьPšPœ‹Ю [эЩЙЈбКУ|Б єNеЊжxPиБжWЇМЛšхОAнfŒЅRдwч^!јњПЦэ–мшЄЕ$PdЃщvяБгH*ыWTmрЕ№ьwп8E,M_bЖ:ъеиsћ\5СqW[x О<Н6грЂБh“zЅnŸф} !РеЕizŸlЗшёвmГДЯ"аЃ$Kж}ž‹ьљXу!qvе€Ђ€­‡-оS–Ќ%шƒйКѓ-‡z!X‚ZaйqvЭУРAЮ97&DеЭЧПЫ0Жг-^R)vл3ЉљкЌмlХ zœкМ6_эZЋА‘fеfxE‡f ‡ƒуДgЊДф?~˜ ЬXЫ•hW1Иќ/ ЗЄ endstream endobj 194 0 obj << /Type /FontDescriptor /FontName /UJQVKJ+CMMI9 /Flags 4 /FontBBox [-29 -250 1075 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 74 /XHeight 431 /CharSet (/N) /FontFile 193 0 R >> endobj 195 0 obj << /Length1 2736 /Length2 23525 /Length3 0 /Length 25054 /Filter /FlateDecode >> stream xкŒїP\‰кŠBр‡`Л;wwwiмннн‚Np юn Снн]oЯЬ9'™џНЊ{‹*шѕщњlя†ŒHA™NаФЮ(fgыLЧDЯШ –Ubb02Ва322У‘‘ЉX8[џ#†#S::Yийrџa ь4tЩD AvВvЖ)k €‰›‰ƒ›‘РЬШШѕ_C;Gn€ˆЁЋ… @– eg t‚#ЖГїpД03wЅљяGЅ1€‰‹‹ƒіow€  абТиа kшlДe46Д(л[=ў‚ђ“ЙГГ=7ƒ››НЁНЃ-РЭТй t:КM 3ДўS=@ХмТщЙВЉГ›Ё#X[m@.Ж&@G(9@YR oД§ЧXцZРz`Ђgњ_ИџxџШТіogCcc;{C[ [3€Љ…5 /&CяьюL 0Д5љЫаакЩфoшjhamh2ј›Й!@LP`*№?х9;Zи;;б;YXџU"У_a@]Е5ЖГБк:;С§ХOФТh jЛУ?“ЕВЕsГѕњ0ЕА51§Ћ{U[  ЄШL@"Ип23 3€‘‘‘ƒ‹tнЭў Џтaќ[Щє—T—Н=РTаЧТњчхdш 8;К}МўTќС11L,ŒF@3 [ИпбAb щ?4|G w€6#hї˜Œ§ќя“.hНLьl­=~›џ=_)!i%Yš*ўŸNHШЮрEЧЪ cfc0§Еd >џѓПќЗјПЅ †џ!їGDI[S;з?5€šїп:\џГ”џ9*РП3Шйv ќНњ:ŒlŒЦ _LџŸрo—џ{џW”џЗеџП„Ф\Ќ­џVSў­џџQкXX{ќЧДЪ.Ю ГЕ‡эџ5UўsЪВ@ ›џЋ•t6‡ ­™ѕџкhс$fс4QАp66џg‡ў;Pxk [ ‚“Х_h`џG:8c+аХ 4ЋПU@а=§;ЅЈ­БЩ_‡ЧЬЦ0tt4є€„и^L  5КџНкz[;g TžРдЮюЏ‰ВГџ§ƒи BП€Aј7т0ˆќ1акй№Зš Р њ?ФС`ћ@жтП3€Aт7b0HўFЌ хў@фЄ#9™пDNі7‘“ћ@\фџ‡8A\~#ХпФEщ7qQў@\T~#епФEэ7qQџ@\4ў‡И@йЕ~#хяžq,~#3#GCc+ шѕdъќ[Юђ?љ?Чє?ЈLупDзиТбиХЦд4ѓџŠй@9ŒэЌAћѕ_ ы_† чщo-ƒЩФј;ЈVрП31ƒ(VбаЩќїќџђqp№я0 цšў† г? ы_ат˜ ќВБќ]Г`њK№;8л_цv.Žd˜§AёГcMЯмУоhћ‡HіG~FP™–@аЄЌў€ 6ўYЈѕ6”ъпяШl W[аѕўЁеnї› Шйю_jP1іПе `і WЕэПЖ€•щ?вя (—=аєJўУ”§o™…ня‘В‚šcoэтєGNФсїђ€8Ии9MŒЌџ•–…ѕЗтџdцњцпbІПћЧX˜@]ў– ффДБјїFВ§et§c8l  NПǘTІ“ѕŸћЦФЊђwZа›…СймјЧк‚кшьfї‡(†Ы4Qз? ˆ™ллђvџ‚Т{ќAэђќMЩшјOЊ=]Asўћ§ К—џтПП#ю@cИ…Y;cž`ЫяСmїе‚Иnt;cМгd;ъiTt^ Žэ.Hя?SUeЎ9о ~юљАМ%Jy#АHјтuд\ї>Ќ%IБѕЩћY?AirЇn~s`МрHАЖNE`зћХС[-Р ЂМSŠ,ЧС…I!эо­OмНЖПti$tvGqЗŠ]ўЙtŠ.F5Z'рл YЎQж/lbhg:|jдswф™›лiдьё7BЉ8Ÿу–B/­uци‡_ž+х*ЬN]8Є8Zиј7Ј#“ф^Bћ)RXs^Х…ЫѓюЭŸ ГiS—щ>ая3gTY(Eй6іжИŽ,t0mч|Sр m'е”4Ђы;ЫcTЕъGЁ9зАXёї;L…VкnеКM-SёЙІjп3ˆšцGўMн^Ou+У?шюBS[ю‡luћЈуячЧ3scЂ5зŽ\^тЮРO…*u}зЅ”Dџ@Лшњ™ѓЪ0ф“Wр…ауGІЭFF-NЈ^№МSЖя‹XŸŠњsЙŽѕ”9k7Tн З vЙ7ЃЮдѓѓsQƒЬPЪм бюˆме8 EžяРњ™ R†ѓѕ Lz‘B™ФMЖљ‹AвBVIёоЙЪсH@ЫЎ|њSЕ ежxЖ|EЂэу(Кб§њ€!Ё >Ў[“§ЭлВ2!=Œ;Е‡ѓ ЗpЁси Žрмˆ%џь.'љtqСЈwEw[ПzaHNT„\‰lуеUxЗFЛŠžнhK%EШ( dћЅ>…y/шЮ‹ітTћ `Fм4њ3o—ПЇCШќАK–ЙЛAЂп>мЈvёњQWYх>ФsЌwnjt‹шчфЉ—u…Ю7жО&[t:„u9бм–џ—Ћ5^ЪшШWгШІUU7СКEМšŒ™ркёаЄЩћvFtОБc @A EцЊL! њлlвWЫMЯ,GТИ&оJ'яЋш7ŸBЪxuК4СIзDјУUa'vŸй?gOЙ‹ч*к–с~‰ФйЖЈ"›MўJ47 'У †UЃ§ѕ ЪѕVЁQДiˆF Œё>J ижЇ_шCпуR.”аXDs‰‚щИkP(Pж_'‘ЄЋшЁњО KI9—‚‘їzq@ЧГзР‘ЈMєNt§š•ј…›tХPђIlЮЬXŒ-9ЮэB9œдЛъ-РNёгиоX*<ќЄoУЇ,&Цo˜єЗO­6guѓ™ЋУцчЋ9Сkў0ѕѕееќУ8ќW)G˜№њ#9PкŸ;Ў8н>Б2§ТПтuП—[DFфaOonђq”va:`yњЂ* eёГNТЙтћфДЯ­6СьЋЏ1™ЮšУ™ПNKЫ.Ћ<Ћ+‘v†ўdK^ѕYmе3ЦРЎqдGЦ5ќВKYЉйlMЦђ‘8W/і5ьфYћ^Р;Чl‡с/Ф,8МwЩY*SšвєЫви‡УTнДXт?ЄН У…Е„ФПЖУр{,Q"EJS„і2Ы3NЋЅVВK*’Z?<–7б%a­kwaЭG‡Ѓю?ТрHЬ‘3“™%Uy†нIрЄгКиљЪ–3їa{ЎК$Іч„ЭАSiЅ.BьяA,›|уъ+^уяЫ—NЦ4ІТў9~ЗЁsn–э\AЮ_В;оw§d ­rфжžДлFšc"Ї#м”Q0Ж(;;.PЈЮьNИЯщ@$c2UЙ…kwфЛЭЄЦ=$Ф+Ps§xBФ˜и­™kчљ@zђ0q7шOжWб99ŒсЖБКСЌkWкЛЈдс—4џ‰ьВŸ+ds*Х]Я„3ŸbS2фС~иЕИ РC,Ц–БeSОt#/Ё;šЎЎњ*юy_ЬuˆЭ;D‘ИM9ђв&љl.їX7ыЕ- @Jc‚q5ўeƒeQ_дE>D,{|hг'аЈў+ДЛ ТfйˆŒq! ŠњбрЫбћОмЄЕ$г›о,ыv2Qц\n5A*e!†нOЅ˜ЇlhЅТ_ѓзюВЌy*Н~vСS’ДЬk@йŠA'УDЅsz)Эл%ЂtїЉ`QnыЋŸП3|ѕ“іЖ“…зG›NUGY{ХKhGєи–нcї/ЫЉбkП3tўJ# Яt”Ы&vA˜мРтA@’ОeŒ,+;7!оЏѕВЂ aSўжт9-ц ‹j]њPFм#ХW „œWŠSТѓйSЃŠ‡\VZВРЁЭ= X§vІ„Šй„Yио*3QкЎEПп.9щя~Y„­Џ=ІЁŽ‚5xu­˜S…ЈЂ№vу”ѓќA›hџКј1ШбЯ<щБ)Щѓ">8к€Цкы#ЬPёn6^_Р‹хЃФš‚ЁыЄ'Žъ(†~uі(њ€Vuщі` jUœ,Э ‘Н(зJщl@…" цОšЯ|nлhј4"jЅ<Нќзu к6NЮВY‚ уоаГl^оubБѕGiБ{•\ЃЇД„Е€XkJkГЪюЌEЃЉŠ˜ЂІ§в_)П~ъlМ<В*2aUјЪИ6д ›ОєЌNђœLb3l‘<КaоWфяpЯтЩ|ѕФбE9/u„,Ь+ r•щˆ’чр"•”Бx%Oœ7УнАЕfї“‚“ЏПќ$ ЛsЄ0Z +(ˆ§У54ЩouЪ:|Џў^sgЎŽba L}qb'ˆМ+1@№Šƒё…СжbaЪжшыЧa8ЮС>OA‰Т_й,рpє—к9юЭ›+ЮL‚.ЅYі‚уєкЌљЪѓЬFnЩ4Цч’‚S9рGls<‘‘я+№§ФщDОлe<4і:nю8Јš›тpz+lЂ•ЃЫћIЈxйњЫЭ)тѕwчў”‚жh“ЇLЫœ.єW.4Ї[ ФW|<чД~žУu“dpv­Uk9юCŒiN(ГC8ЈъLbюуЇ3ћЉkГW›„˜zw5›њE”Щ,b]O_ьдoіЎ—нˆYјЁ щЗѓ§ХєŽB\ЄЖMšТТL}ЮЅ&$wХœ`Vra3Qвер9г<љ]‡3Iжb”а№ѓбrW‘Eр<ы…&Џх=O'р‰žзЈл"? х~оъG F+…pъ*тњT/‡(,jЂvgОо>мG†Ё˜4&VhЇаоЗ9‰фGZпN<ЩТвvЇР5ЧuЌуФNaАUA€xьИЈўР-—\x<ф4}3˜мH(m„Љ‡ЏОBЮЬъ†Zbэ ПK:УЌ~†інm%dрXžЫш-‡XО(эЧЈz/ЕЊю C‘GiДb lјpВŽтч\1ъвe Ь‹˜}=9Р­‰~ОЌAPAЈ2™J­\‹4G\ RњьБЖcaЦѓцM?к‰ІаЇ­fЁ0ъn^3LсёnL \U4яјъ5њ|Z:ЈыВD4Хїz>p-E1dЩ…ugВќэЗ”Ь.эb*Ž>ђŽчѓ1л,„œMŠ™%Уž•о GП™Еt[}лЯR2ɘ№0”)pпїr~N|ЋЈ—Уї’Ћ_[:зГЪ0ZэБ=єХ<1ЉЪз…Y2,PЭoюїzGuн<“Y[nйЭcMКfJ#ѕCsД|;uњŒо3puiЋЕAоЪ[rїУщцм.нHР+Сc†HX˜0Ъ Ы†^нOЋсјŒ`—Ы~нШ>ФЬI!Э„”nRчЖjl&ƒ\ц“}'$jВ5‚wГoFчў#§p_Jщи ЇGБkс†ўw!ЯЪaйЁзЬќЎ3m0аяЏкnцТz5Р ѓ‰8q~иРЅ,…a›Й-Н‡ƒЙчиƒе№PжѕНЩ~—^ё`m'4{PžK˜’хJФјАп)–ˆАВіxZ"КfЈhzЏрЮъ/’ƒс}ј^§ЙŽgIœ`§ƒ&1‹а5лТеѓю§†„ёt™6є=SЪXњ‰1›м=WЉ=3‡TЋаЫUНФidƒхu‰;†"-’3Ÿvх&чh’ИSS7Ё)—.;:yјЃG%•E=NЄы№eЯ­zq”LŸ’О’Ёuч‘{­~Юœfїw6йoUkЛЇKшg‘ябb[+ыq§ŠŸ, Bжћr‰|V ’ODШеёќ‡JЗg5šIЁ%жОэ!8KTДСњ §Ђ_аФЛ˜ЗХ(sLљ }lЛаƒи!џМх,(E'ƒh›•ЪЅПŠЉЇВd†žXяћs Ž'Ц€ zтЄXZ(lѕœизаНLX•аЧ—МoнЉhŸњБ,ЯošЊ+Д!ыЁО№’!†чН2‚^ѓ їЖ3ЄTЅР!К{Ym(%ЃјžБŒ%E‡wБ%ƒЩV*Эч_?№|§я€k;Пэрl-#Ь”Єб`§˜ ч0зч0UРП5сЩ$ЌLг…—ЏРдыK~ЇЬ< ЯR&•"Лј#јГ5хХt=) A pXq‡СЦ^ŽMš\§щMеЛ4Пj)‘RБЎе<]ХъЃъгйпЗз{] Ў ˜$њ™Ђљљјьh\fFsЇx:GšlпИPДЊщ˜р)ƒWhaDRз_šщ@r5н‚bŽ4Ђ­*c^ЊIЗшЋьјъaШUа/љ5СCРƒЇ Y2‰Ѕ †"РцŸИВ6Iљю>3>Ћ7ЈqXDТ2,яУ–†#F ћr м.}птФlUUюИUjхЂuyJЩЇНХ/е—Рx*гЩm1Я ƒЦСFўМ-Ic0e ђ”OoPm‰Ї@W[0NД€,Б@<-ЕšR–ў+У A"Ж-ю‹iєЏЦDљючP)FуВЏГ І>,k)G?‹ЗˆХKRP*і(Le&пЯjЈЋОј<пж76iіеЧшСћЯЬ‘YŽItœEЩKМС Цъ?4Dёь‡}ЛєKи”jrЭEњ ЛLGК№Оy‰Bиœ?€-§SА2і ~ыЩЯъю Є ь,и/†хuўtшщ‚~Ц‘ЁжvърuВ”—qаŽ`пH– ц&l5Н,— XМ­пЙтWДPHZчМј­зэд=чоL+єќ8іJЮƒ­J;уГ7мзƒ˜7?’З‚0Шj<ЭиВПDЈрtёX&uМLYЙњьgъcьаKУжэсKєВЂћ+ыїОыI•ЖМУ9‡jз‚[т2ЇC>Єo‰ВR(p€/Іжёъ0ЩWюВПоG'ЮОqбчє5$CBK‡,NѕФuО ŒqТsK{§ЇPŒ™ПœЪfS /vЅЦб:› КTт=&н4K№ОХжœ„Рr|€щxа‹U“§QЦЭ‹+…џ  =*ХЈђVHыШ‚ЕЧ3!6Gf‚цЭЌpmEПЭAН^C•И ›ОxЦћћњІЂ'dg†шјзѕ˜‘ЭsИuжˆІ лp§'>{hš]гR3.sRќЧт~p]3йƒyНЉfqщ[Ж2шЗСЃVШmIG‡3СbSСР5M —rџž•эоЫіЩГу)TMЧј"7Змq1‹&я• !VI‚Ю(GtЅёДшT›-†ЅУ-ц›у\к3п\о`”їАЙЄq‚QњTЄK 5HЗнЬ†“фƒД7пЙGс: х{@JRІМЕY~`“љV*йe\яуmNаEšр)В‰І:ояжЊCгўRЎХ=vЖз7^аŸЩдyYoэЗьТ7pЙxїбВќ˜cv9|ПюЫ€о";ю)УWЩ'Уѓ\дЂ!ФHэЊБШS#Ђ_ѓ{м>vCр"фzюZ\ЪcЁњXўЈоxЪмёщїsGо=So€zŸОcц›ЦhKф…TeЭЏUтyѕљj_гч Ё=Ь$љPўФ™ДР Ў˜ЌЧ %яtЅsиЉ”ПХѕgы€žЮsu"Ць‹тb9#гšЅЖŽерЏvФА1 пTaл<'ЏЬЭF Зcу]ъФr&г?ѕЂiОмщЭ$Aр„€чI‡эђ>Tˆшє"JИЬАП)іПLЄQd)В ёИ“4ХВ\*p—ZЁœ,‘59K%Мgрћ‘+џvš‰яЈЖаƒуЎ[н нЦGЕy–н]ЏыoѕСfзёA{/wBŒч­y1šEIЄNœbЗфЅФЬшѕaП ї‰РМижžмќ{eюЦšOхT­цыъГаэЌІЭb"цqKєѓЕ*яЈє”Ё&щBlн|^hсУЕфšD1&„СЏЋюр5сc” €ѕž=3Зч,mS:p ѓЮ'ЏЏšlqXbОњюн1AЊ_НЃ(4ыУ‚ХUg?АKТыІя-пђ=sЋщ?НцћUФE-Щшƒ9]ЏCь5sЦЂКш9p1ьВ-–i 1ВPrЃАVќƒJ4>œ9№YЕ0ѓбЊђм -ђ'†У їК‰%Iasе2FИљ{‡AјТЬ6';DКfD8iqŽИ-т oХ‰АwЛЅ;­KO'я@Ÿќ>™_uЪh‘…мўІЅПlкОѕВœХЭž+У3їёт$Ьjзš4Ю'=Keъ,зbTр]b/bћ?? {CџtюАdšШмs|ФЈьšЌ|Х‘rэЁ•&є‡НЌ џЌЖŸ —іœЁ\ЇНМњIЕ[ƒ2pq‰п˜ц–lНіDЎuYH™+є>ЈЛ<Іє+qяl_f­йОЪAлЪЖžQ‰z? єхwjR@Дtљ§>FdtвVˆК‘cEЏІgсЇТPr,ЧTAIa\†№8:K8ЛЇЮOыKф‘—ШLiждЃвt8s+ъ…Ъ; QЃ•‚ЅтA}˜}ЫXЕS#ЂgЬѓ нXU'šлъУtпХ†QEeцtП Elf“Ђ‚щ^0“}Rlонєн…0зл и:9ЎіЫ$Yє2)Вw› ЦГxД8$ДƒсrLUѕВѕќщУЎЌ{ХЋ Пu‚QЏhSTБW,”Sвўy'oW№Ђ.Я^Jo2АQёQ€ho.u_Pяc%жž4|хВp#™ѓђШlH+дЎ2M“z7ЂvZ.ёСjLBˆФhšŽаWќ^”'Ж”`(R.uJЌ ЃыzлФюўСМ_dо\ИQ‚EбvsnФ›vЩ\S˜ЖЁ?Ь"лћѕѕ xPчМAТJERОAPОY:+Ѓš)еš МŸMŠ'ay–w~ZџkdђyzБ:7JeKРВЉ€ЮРZ1ZSНZpа5К1эV-ѕH{{}sjѕ)ZхРžА& rђ7KЋѕѕštAНžм …2А1@ :Ёm IЊёЦЃC@:Я–Ж3+‡|йs =в’xwћS2КН"$dюУwдЌЧE‚јYe<Ћs$ЅCЧ%mv}вpƒЙWY•ч]#ИЯ [pЪфЗˆ_tЉу=™YKŒяneXI/˜—Фj ЫŽм>ЭlЏsP!•—щї. 0ц KN\ЭkЕZ›6ЇU­Аuœ­ыьŸ8ŸњЊё"ўh#_ЦЫEпќЮЂ–ё†1Ћљ.jЫUt—Ыј€У}э єЭіlЯ#ёУBŸЯзОF`{t{_ХљьВэљc=АеЋeяф!$џЃцфtЪ!фбнќЗЈv‹|vъй\3сNЕ7KN&У_Ш=тУке иkŠ(Њ€ ЧЙMu \пZ~ŽeiљV@Р-hДŠ=|ЧХФЩКШMs&@(Йэ‡ФИ‹бЏйЬж‚KLƒѕ­`ќ‚ЈИQœ$`2Ё›|t ФeЈ"Ф#yQЙЕo<Ыaъ>њєLSŒiбGёšТˆdЋMєђ№NєŸ"=:EаёЉZ11}іО4=кh#ў( Зз{wИADћB-:^\WЃЋЃЉоІc…“ш.дK{"Љˆј}Lы˜Ir}%Y‘7нNхkkА!j›ьФFЬБZр­ь'ыЋ;?3‰eЖtbВG §akЭ :тщ’qbЅФњPЁ’Й,лТАъdєbЫ^„Й„]ОhЊђ#CћŸ2оˆ#§Їь|ы.:ФЄU”ъBm+——‚eфо †прeЇh8шѓІš­nLЪЗЈNДЪМЉŸєљпLЕyдЗcЎађНТєЈЕРЌYИ•=6мМ W:wоЂnД9}ЄŽ”&м^лŠяLО\–НЁђ? )F­”РєЁNкЭФЁa`Nіlн)ЄVяФе ŒzѕМ2№$a>ѓ›НіЋ KД@Dт^еСьА~jиkцq’С+т7R–&яJ†‚œ" “f$5Џ9c›Му€Ъ|_CYюŸˆ жš[}з™ЂVЩZrВ'(HwM(CЁрJў3g9И žJ|ѕ=%љ!"AU4д+з‚ъЋ`q’k™\ЌКЖ y1У|?Хбšj“љк$'PчЈP&ћА^JqоэЅЮ-z4eфКsŸ‹ъ9 ќ{f. vшгНП>/лЕНЎJО‹хеф>ЪвїЌaQ“x§œˆ-,Ч\o}>ђДXоАМѓXвсO№9!нDбХќОэЫ;ЄоЬгРі:sМіЊ“==жd4˜“cAed„u{§*П&ƒ‡йМ„'Зц‡Јœн:ЏГSфиЂlХyЉђMњэ’o њХШX~.MШŠN є|щ ЕР2;А ЩWЄt! к3Ђ›j|!hSАёœ9`ЋМYT!Б1†|џrіY-U+–ЅАіM‘;O~rbўsЎOчтЉI!>•DЮŒжxЙАЈлВsšg†?ЌЯvЁ!v$єкЏC›MГЕš€*<Ѕ7‚o ШйhЋѓЖeqИJЈђUзНMsbtzJЖnŸ€ќ|Ч,'knЮГ/Vн’ЋјИЏуzU}Ўeqh—1Mh'>ћOБН›<ўˆяžЭ—ЩŒ Џ^ек‹ћRКМ‰3CРPеAЗHещ‡˜Ќ?(>P§T|‘ž6‰з ws>р\)ЦТ/(Хѓ•m}ЏХдNbЖJкZe„ёоЎч{яE[ 1MI”•%џАLЅ…vуD,ГCЙ:Тдьи/Цс%Бј‚ЪLђƒW2oлиt3Аi]Є?НH›d&|žŠС~цƒз‚,™Цt{>ЉOцћПрОu?*~WeM. фЅ[оSН,Ў+5pHтn”ёЏпАиjэЄтИц—Ў)"жќ АXоАзaUП%ќzђК\Cnв+ВlV$†у”‰|w‘Б|e\ф^mтћvЦ,ХХ‚;ЌКь&Ѕmй­™ШI[ёџдŠtЁц—іT(9І<§KЕЙk–љEX7 ŸѓЏbc|'Цђs'ьшŒ/œyЪƒВLИ *В^љ—œ‰ы”чH#Ф ДуЂ1фИмЄюCд%мr\ј.Œ5Œжu,д’MЛэСeшjж‰3ЭС~Тк}дуoАUrzŠjtЌњ aо:eЇа3a qЕЬпмдkpДo њвю%К \GљЕtЮ8%Ќ]Šd ~ŽЪ™`9№‚<—ѕF$VбђdЈЉёb1I;ћЯ}ЙDЅ–ŠSDјр=1Тˆ9ogn—Xwuя;kв-цј<Ё‰Љ‹†ЄЦжщОŽ\дEZ\н‡МІ osVШXїпžynB~ЭŸ:ђ‡оTч?k;А[‚м+ŠЭќ9ШzX – ыТ@jЦ”adtgтР"vљМЈЎ—heкМe\тЦnwƒ4щЏaˆќю&Ћяј];ЎНg(‘„џТHRе>чГБЫэуoŸЌog]3ЉGЌK5Ѓ\ж•ч<ч;НИп€OžгЮvtT.щ#T›—žЙЁТ…›ыYNьЃ['[хаrІH,ђUмќъ Ž+TШЄчmШ]ЦЙпk’x`™†h,н‰жЅ’ЫфD<Ъb,т#њkкЄИ—к^sm4—Я„79пŠaPZYs e>ВЉЅ7*JПмZ2ъуиŠ~НШфЗ ’C,c*Щ'‚еGУ™*tЂэнp]œзЋTмЁФ)кRЫˆх)Gђршѓ\їpзŠЯ'>UЕь€tЛdС@ќ qќМ)(М*žЗыЋ%_ %)мv№Rрё*u6PЊЙЉг=ххKPCi‘ч†С’ц•3hњг­ю~<}%І:їN’‡ЌпФlы з*ƒXDаŸцк ЯюгДi‚—ŠњбЋ&bм8!%†кЧdжB^MР,iФ‰j ЯЬgŽБШъь8V‘b Я„jN 4P-XПф€ X8ЙrхbbжРЛпmАї/ЯwWЈEФ•СеŸы#д6% Ї8ytxЇж™šЂІaqх2‘ž љ31 =%c.юW”Сё˜а№;згЄ%œ9В4%ъ‰oшрBЇ‰о;ЛАmЋgœDБVdћ…ЩЂю§?F/“1СвCз™T]‚рLЌР<ПьдNЬG%ƒˆ˜qЇ6ј)xLеЌє Št”‡JŒ=†Uїƒ˜п:`г=NH(p7NˆGPЮЧАYBь4RЉэдеw‹ЭпDі3AЅcявїхah›уIЧ ’Ціј‚Ћš Ћ)юŒmЁ{IвѕИВЙ“]л‰c P^ойE;ДW‹WN5onшРhj с0ШрХ0ѕilнЇ§БѕG——УсЃ?ъdЅjjы_56.ДЬЦ*љМ [ŸЧувR;Пq+`2$ъЗйбŠржЯ№тИ!гWrЌА—‹јXЎhМ5ЂЎЃћЪЊр"ЯЯьіƒ™~ЙС/2њхlЦўc}H уН.Э/TaI,˜х.ELŠыРУ|pNŸЁ—a- кс ev—мЎG+hbRŸ}ПА‰ОйвЄZмQЭMg$еl кЗЕЗ ЈЉЙЧR›•A€SчЂœБСsр;VUЉя_1‰њњШЂЛтŒщ}Щ^/Eяз\№ YнVя”t eЋ .AџЋтиъF[Ё“g{ќМЮR,‹ъІYUL„ˆAZˆН73љ Uъє\' fИ•œSNI –ЈО8ŽpoŒхссk{ЋтV™9Rрй›љљЌ{Tр†(BЫІ\Ь‰бX§ьнГ\Ѓ-CšOБ„kwЩšУrФ8v8•KлљtћAнœJ!iчіqq УЦ{оЦюˆ3уcnћЮЬœZkuн›дќ в:ƒк‹QфpVЄ€ЉъŸMoЖs,7•гОхz k4=пяєDшGк‡Е,”ˆВ*•Ьњ``[Ъg|;mˆaнв^mo~ѕГ4QU*хEы !d.œBDДвWSЃ_T .‰!K…iУк†Ч šБиoыЩв™И;š—~u#пПŽˆ)Žп—ƒCЫіgФЈьцŽWГюkrЫЅчpГЅгЕdЎ0Р’х)&цf—‰|Ї{і_—Œ–Ю>Žэ‹NаdФ мУ|$иГШRПЦЃ№|о}L]jLХ­ В<+Њ!Ъ`@Мты~щ`Vh›Ђ;?ŸьSQћЩNШ' ‘І.tЃ|МШ„“шva2 )Лaсђ,“–$GE\sЊўAЊŒnLІ+ЬšссиvхГzк wњŠЊє№,К TЌ=i&)њЮ‹РЗœF< !щmfјЭђ›gбXЊ  *AХРгэŠ4{ФвЊ'\wђ0е›вL‰6ƒц’юч“Ьj }^/Fг›y„КyП]F^cЂл ЗЁ+?Іё №r€љгбœСtš‘3 ’_Х$•†жшЂѓ|N3Rэklў4j#OњО"Йщ2gЛјБŒe p0A‹~==$>ž• ‡bGзЁ!пŠсLХд Бd™|иz0§тIŒYn]^ЧЋВ?—“RпжwEYъйЎl9ЩјЭL9[O_ъЙV˜NCм—Ф†шСЂMаЖ3ёtБRўЭ6ьYУ1ТмѓОЇЄq§#аб@х‡6 Œ.=.БЋН‹9РЦпА‚BЊK˜?ESЩ„ЅMТ…‰B#А5hщ$Е‡ЛIў\ Іa ›Ю‹Ўлu9яNЉМџЋ˜pŸжbgVѕањrяЉYљ§O+и­Vд­s"ЙP%ЎˆѓСLHusa.{˜ШZдѓќф|ПЋupї>ЦŒ)…,=Ѓ/;x zяуPЯ;/†ЇRі5ОиwвутМl`i pтŸbЫуrсHSЂb‡Јbф,vк[0RkВIёјФ!Ъ"чйV†ыњ@К"Б—‰rцсhнИZzШ[Hк#ЈП^Œєg9§jЬїT—Z=љ4 &x|”oжћЭољУr z<ƒ0‰Ч%ѕЃф5gэьxбюч5Оя2Г6еjŸ№эЫЌЗ:ЗvЄ+5ŽвyЋЉШ5Ыk4ЛV["HXXr§PгЇЉzП)ЁmЈћ9Ÿ%‚SЫЬ ioшсЋŸ(KТ[L~"lhqG8@ЁlQ}nшЄЮЃ#ѓф8 ~ƒПФі€dЭЯЉvOQнxоШыLЎ­gDECZ•wа+6‹mџUЗaž_2Ї лйQžЬ^TѕЪ?лjсХqQю‚Іљ]ОGG8р8ШŒŒF"nш:Лњф€ю0ой~ Еіѓ‡Јд`Орє ЪkТ­ЫаСЎФBŠкь$ІкЗ…к€{$ЏŽ~эР>ЭR9тFу‰Щ*RBёPЭR$*'\#Тя#пљЏgЌІњЕ$/.’Œиn3жP Ъ4‚ё7Xщьн5šШѓ\ЎЊаіЙ‚_3V‹—Qa-~TЉŒ^&ўH•ru$g`–šпЦЯэЌ{KѓХRЩэfх;џхіYнjх›B\ОНћ9ѕ.ўа=ITнГџ ћє“л#Tc._H.БrЁ;MэŠYЋzXЉВ`№c-5бЇАВM§ƒНЪЄф]•9ЧŸ:ёFќД‡ё{i`ИиПЪ9тŽх№яRЖфž‰q#H$мФЄŽKjG=є—‡яp U’гВЋ8Ј\лЃд’}ŒсƒЛБ{Б=ŠъцIрMˆVвЖЁJТњТА]ё]!Џк^7Iљї8 Bрˆтy К<Дh>ЅЦ%щ-EЄ=ќ\g(O: XИoлрœpрІРнTAХQЪгPафЮЕќPMŸњЊSє= ^阧ОšœТŠИv!iJYфЛрJЈR{кƒqђЇъiП‡‰F  ьхtbоuЉшЕ‡OХшаXDќйЌYОМUљЯсмp.Њ]УgБ\Џв5ьˆ[ иУў^FСуiБ=пh.9пЊЇГ3Z­EйRs/QЗо5AGxвUIФJXёД•ЮёD,МгE"ЂžђŸ>I†wтТЎєу$žЏzl ЎЌДЮb`Кv@Ѓy<хХgd]ЦуВ2KWЕйЇ}+щјІAЕ–PSQ>TЕ4aйkF3ўѓ rŒ&[ ќШХ`Јaѓnп‘^иgˆЈgш‡CшЖ<–зMЇтX‡ВI-УЭбЉTœя‘SдТї+c\н1І2ЙЋ’VЏљ?+ШюАєy|5Е`(бУїІЛBТUщмЅЭж Ц gbx„vŒRTІ9№уblš"wšœ jє э([ЊЇItc­(ЫМ]укЫ‡ hf]`нЖ<)%сзRЇТЏ5лђS[kд*!ђЌS~–s ьГ&y?њ8jЫ (Г_еСљšDd(;ЖжьыћЦЙ_)ж>œЮlН7ї‚ИЮiћA§єЮ&wщЬ/…А ‰ЋЦŠС#Кc2ёмЩЪьtl4Хяvх RPŠ:т Ў–ЈˆЫ} dHмeнЯ#˜6YvўM9ЗЄkRфiŸ‰1J*8`-~QgЙ.ЗVІDзU9јŸЎ‰,ь{ ѓщ№еЏUŸV9pœIЇޘѕtJ*Ÿv5а;­œАD‘исЕНЕ-эgžZЩЖћ,јzйецŠqЫŒdЋLanJиїЛU->FVр2T | eN=B з‚Žњ‘i?1ТС/œ0wфтуš+їˆЌрšHIVП~pє\4Ж—Ф†+‹–YХі—Ю6JoЋ!ZI+kУШР­ИФ]ЇнЧшJxt‘иG8б*т~–œZƒЦHЧУœИуШ‚E1БgЯГІкŸ й€Ид#zc‹m ЖB.pYeЫаЌіѓЯѓиЛЗЮ}Яє,9{ƒЏз1Р%ѓ„В#ўM5Pљ’q$Ђ8ЪЭквЈŸдЯДŠ ХjŽАcжА˜-ŒLe‰W5K_G!A4јфлР›RRН|­ѓЧ3ћЧ•v#†ж_VIЙC( Ї3гѓо•n?GВ6xМˆwjРн1(P шфзo(гсŽ’ŠkO_џ4˜КОIЖ1@>†Z˜ЌЖPпЩ ыY=АЦLхiA8ѓЊ‚kbйfУШЄО/jI9I_-.TIEЉккRЩсО?i)ыщž>n`”ЛsbВЩя$гŽ{O$ФsбЮyѕў94N%ј0лdИЅe8Ђщka.z эѓRвq' `CŒ`>},Ш2Ciљ'7ычѕгус4Jй“ЛRaІjV]Њš[ к~ym‰‚ЏL aчЕКIVV^sК@BйdW!ь# UhЁ$‰qF‡ ЈЧфИЎцA.тр7cbы:Цњ ^а'OѕОышNЁbх‡Цњ ь!ЗJ+•„П—юЅ"AЊђ’Љ=ЭWїaбUW6 ЫпсFix(у§є‹ЏpчЅАъ8š'Д ~ЬОйFрйAƒзџT(Ымєz˜”\ы‹%fЕL3З ѕRВЛ+‡/ђ•g,юQ ЏŠГЅЬ[tWИц„мšЪѕ+‘ЪzZвAуHRОЂбМlKщ|сCIЗl„#јVжМbk “j-мP„Ђ\.рNдъЊКУioqоsJ9‡йA§-Љ?Ъ§=v†–ˆBC j*?Q‹щ‚šƒЄг™PjŽ ь9?Јhљљ;ЈЕЛуУš=D ф4[ rњcицю<ЋyAбЮ ж‰#‰Ѓ­#Їѓ хё4Ѕjiƒё­ќтœ,З юKс4r o’х/ябх‘ХЗz(І>t‹­Т?;A—іnО^}Ј№ш>K‘‘ЌTљŒаЇAKЛS—Рƒ ЧLcLuŒыXйŠ}0ŠjeGŸХwє]Zvи^Rvс§Цюrхˆљ`І UдВCь91ЅLЉRя2КЏУ1иЩ^uЈWюЏњUџ} bаФV”Н^*њ$ёЯmсšъƒ#/Ѓ=А9ŽщБ0>9и[Kїрв­eњXеcc€žФ’ЮA‡ѓx'E]qCŸйї…K7§ЯF_ѕАЊЛхЋ§qwЌрš‰Ž,ъчhЖлЬ–*Ѓ<ЭЧкyљaЛGЦ†ž‹etH5>ЫL2ЦЦвЧнЗќЬOв%­ЛLЦœЭ‘ƒъS;ЊСх(KЄє­;ќИ…уŽІйккьяrpД—ЧїMMЙ~Ѓ,8”Э\шжЏЄCn|ЧVGтМо‰>У<щШвZ ЈHf  1ЖњюСмr7ўŒЭD'PО~Г‘Ы•Оt SЙ„M;здI_q6>HŒW[ж}/л(™АќPЦЖ5ќуКЊ§vцmqHг{mжњъ6˜TlkgŸŽNы4’zж…yдя њЇ€ЭЗЙгя0NДUяа1Ў5w5§s˜$Џд-’7Цfр™Лy=‘Т^ к2 .^Цъ9Цoy'žњœkП…(z‡YвэmЕ0сПЖЪгfа f˜yЌВRі*S’п•6x5†.іЇ…щ^>”_фхЉ]ЩДБЌел\ХЬtЗџ”˜Оmwєz1>љшєЁJЫшќ€$~ŒZ#”6иSъеі{W@ с6 rб`M1q:bкВk€БeЖЖГѓGD+IО”Цќ‹7ѕ‰˜".ВпWЬ“ЗFmAСРUЖр!LіЪМ4ŠХ=d|wGLx Šeлё‰ЊJџvЇ•Я6ЯH‘Јў#ЇНЕTЧ$oгЄ*ГvФн3ŠJ…D#­#ЕMJ(­і+ья>’йУœЖйђсў$’VF:6э?Ÿ"aF Ж4ь1XUq!Й…ŸhќeЏН“љˆЕca‘€Ч+Љх 0]š$ЕŽВ@ˆЪЃcœh(Ѓq„Љ†эЄ9ИJЁюі^Т!еВ#ˆEЇX@<іCнœf 0ЈжѓЫYbX,А‚пЎ~Йш8I^ИŽŽ ЃуЅ~м˜Е+ѕ@FPЛ)SЇ"$ƒgC`Fв…ОmЯч#ŒiYЇ+“.mж9ЇƒфPRjПA.‰*fЫч~И„ŠА5—4їYЌО7d „Є•Н"lЂFoяцг Я™ˆ!ЏTмX! #ЎШЋЉбЊzЇ=ж†dJй0Š-$пф#hE4Ф~КJ€ыЦє>эŒХє˜N]ў”oЂєtNяЁuAпcz€vЗI8‡ВŸОХ]‰—ED0šdсPЉЅ№ь№%xDў‚>ўег37]=ЛЪЇгqv „­QwљЌH8Ђor Ф:убмjАа;mёИ•ШВщ> (љvбЮ3Ћ0Zˆ‚‹ЈЭљЃШx'vСжJ…†Ўbi&Ы-‹ЏŽЭl€ž$їŽJ"g,$Эле}зfYНŒМ4ОБ”-ш‰Ют:"Š e_х=ц•()DХkqЖ8О†лjŠ]#Ъ_OTcЬ§"Д ~Ђц\jр$Ž—ž_Э~TcЛl™CЖU№Z›ЦZыE6х\в8LлЅЈ“ш” г!жYІђОТнzўL"рнb| ’v6ЋkNЋ"<‚˜Ќ|+ђ1E~)=хч@х Њ7ŸїО|vPcђ;нi˜Оh…з/бTыр\š05ˆ‹ ТћNaŒ“уHr˜UˆQW?Qq8гяb_І\ЌбјSаяVіNФјЎKј? ЭQєG4(ОsšљВrбсГќ7гdЉщP,ИЦsУѓF{ѓ“<)WаvbqyВЮž†K,cŽYАkЁQˆ_~b_vйІk%ХpJtЋiH`лƒ\Ќ щЬAŠJbŽ—2џo7‘Ќ˜ї‰зБМљ Ќ–t^ч˜Ћ}ZуIaэљcзuі7нёЎcУQ$’жBIˆћ~”ЫLOоУ"ёЖ_„ъl@СЊЎgСлlŠPˆ У6YНGвNaЎлкЋ 6AЎ ѕ’і„`šQe ˜>d3uTЧ#АЎŒЇцЈ$№isћw*У’ЙxЙГсV]7Ёг№ыЯxZM_z“ЯрЃ•4|[мnZїхBAћЄЭ]qэУlэLGšƒˆlTSёЮяtmЋ–и.Ы$E—ЉжчO`ŸќгCž\ј†v™—&іœ…Т2EЎо,УО.юоЛBg=.ЂˆЄvn‰B{ТЉШ7Žљa]_Ќx0@wміЭ=\…ЯЧ­rЭ…s4wYžєXЊB‡6I]ˆрc\2гЦLЯМа/o)\§оЂЏœq—nЧПДщœиЏмЦЗ3шЉТ5&О.~сОфВЈЅ ї~МфЉž"8…HNгJЧн\ђ„kы *СцЇ)gо]Я Я’61"–с%9ољŠjQS–HЊjMјЌІщЎьG'Љ Х‚ѓЖк%нђ–б”уїEŠњ\рW]Ќ‰ ’BЄЂИг™„A,ЌийY5ќ‚ю*››ЩuЭ | ‚ЄkИмљЕј… 9…шpM@сbЏnГиФy5˜œxа=МšŸvЙЊБ Љ+јф.‚Д!ииfiB)xЧќћ‚0FЃ'ќЧє[;G`Œ‘u:ќтОuЬ}Ўќљр’Ћ_ŠO‘“лэveїрњ_cz“ '‘]Ё€ї6Oъ]:Ўш*)euRLђў7U †•Н%ь-№ћшў…Rq8>5ZGлuО>`weПЕQzћЌжР='E&dЫБŸfVsGws ДMи ђОtвcOZжЏЛq"сЮ2 [.)0ЦЯўЯ4я ”ƒЦ.І“НœЋMi G9кЖ­Ы2|>ќЈ4Ђ5gQЬ.ЩiJCХKяП\ю31TяŸ t’ ™щyь|ля“џВ!? ЖZзšgŸг,x3 mc-ЧЌвлƒКx„мЧ№ЦTвЖО Йђй жqœ„=?›Піф­ё™Т_:OW˜иєБ"ФImP"ŒО”2Г•j(лџТjЅ/y…оMІёG•лR‹кdЬЉSџR>ДcKNЮ”јЩ!Ёc™ўцŽЃИђЄЋqž С:Ыq˜YrФ9mє"дX„ідgFh2к<ЏXBЎTfjdQ№ЕТ[уКЏF,ZќkюAОих“о9Оь‘ЋАoЧя˜Z| qкќz~ЩЁ нrЉu”_Лd@6'Ёг˜ЭТс=љ‚)amТa*IasЂ<1ИєЂЯ$(џwˆџL™рVйŸ——КШя’nŠ\Ћ›Х`8ѕHЦШŒ$YŸZ{{НШЇњИ†:BNOBX>qlЪђPЈ,”9J ўP1YMЪKY‡EР>š0ЉЊ4Ь–CLЩeFwžR˜u{Пѓъ3–ЮОНЩкi™SDО(Ђ9GLч\[“ž/j>Ќ|дЛЃ/Ь`˜ЉМЎпЮёš†К•Y_иœељ‘LЌ;ЦqК2ЛХІ…грGpuMДОЌсЬэ)…Р6/пЗЩg!й эKѓщ)п(ŽМї\n˜ЬЈЉФжПzœже›GжИ‘ƒnы$ƒoъˆuPCАєw'їdзшЭus)Џч›nјэпAn мпЗы+EЎЭNРЭCф‘ч;Айд;6šЛ+ ЪфпвєЭтЫоžЎ38ZJ†*tшЬ 8};УTzЪЬъ›Зa–СЁŠ…5ЇФ2Ћ—УЫбНрЯUŒХ[Г_ƒхU MЈ@Уfƒ ЄЬ7ЁќKЯХnhšIYlРЫ.ИЧ(Gj^CШТt:ayхЛ(nєlђіfТмH<^>#[ЦяэN/АР{…ё“Л5%€МƒYvЩФ0Bц-ўœад'nФS_@пЯЂ8S\h~ĘьMm8’*WСщ•„Ѓ 1к0Н РOеx}ЅХ3Ўeп*89ЎCvНЙkœЌцq> W 1ŒГтХPq’nЅ›‚ЦrЃ>Јaс Z5œ№OuD/iсŸŒqwРŸгѓѕU О'І*у`pвxn\ЧгBуsœ4RЬЄрЉ  iˆк _r&Ќщйn2bl‚\šyПbЕЯКъy`­˜Г‹ ”“ђ|H™ ыSкї3eсoЁX>[š­љ!ЏP…МФOŸЗФї eШrq„cгР,япdAъкPгмТЏЌyЬЋw~оєEx­<ŠlŸр*ќЭЈЦR Ѓ§ЃŠx5Л‹лЂЈ@AЭ"днГ‘RХŸYЅ-˜8уG•hЙќІ}Œ;фPlSиі Ё4XzУmЙМшѕцОYЂџфьДJe&ˆ рПІ‹яШдёоexOhЅ>ѕпbˆббЖKЖ…’чс  !}$"пS&Ь6sQ`›NКэ&ы6K4.Ж9(~^§цїџ\qІ[1%,ћyfл dƒЎБ žЗфЮЋ3{F У>#d‚КЌІЙOŒRь\ЏБцЖw ї5X‰ lОлwЖЦhcщFЮ=рLЁечИ•юœ pМ * к@бˆ‘uZQIэU)вфoдZЗoЁ•ѕ4Ѕ&Ь A:С™ўq ц““SnМмЦфлcb\Э#H&ORwМљ^iМKоюЏd“љѓєДаН“3дКИkŠoЙџBѓѓН—јs7vєD ѕ,&нУ+жkа(OЎ#rAїЊ'Ш‹ЗЕј 4ГА ;aр€;Ё№3:шъ%UИœа7S0”рок3КR‹,цоГ'ao=eŽ Ю$њ ˜LЖ+їЫŠЌЪd€5ŒdТ-<›uwу …"сдw’sq3”BŒш1šHЋ)ёлgэгжЭўДa–НP‰ЦГrпС"я*љQ#ОFЊЉBН‚z‘Oƒ…QžХ™„ЇИы“[I–SbъXЋе*kŠоЈCШН8п0€оFXmеKхІИ=Дф§АЕы}фvЭъЙKиаФg˜?єœјруЁёTєNёoTC2"1qкРMLHAеH\ПН4ДZИэЬgщЈњLw/._WG€Ш—€ѕ3і‘ДБ0W"ЛЈХњ ѓ~шЬ 8†ј \]†‡ЯєEqѕњсй’#Љт'?—њ=ЄQыЄ˜гА›ћЈћы†g„љ;†Я/еП №м~&GЏ#ŸMPЄўIЇT-nНЬЂЮMDНч™_ x}p#fќя1aЉqљгйШVD‡>х?Л?‡ЏjŒ(Н;мЌте‹~П3˜яHbk'†Ш@ВкіЮ%7Š‰M‹RtХoEЋwўщŠЂ§_ixpУКbœRџ`r,62œнкъeтбP†>#zзЗВŠM§m№І-ШLœ@'kђЭЈКw—ФмжћеќБŸIzKЗЧ–fФЖ"ЁpMG9+‚ъS5рE˜ТПћбЋў+Рљ7ЂЈК4к5v rљ8(ЪДCџƒНIмU.їкCХ}Iˆ7%ZыAyx +AodO{ѕќўкГk(Эœ ЁьJі>4ЎT2/ьДћJg Л\ю|ŠgEљ ФЄк-ь­ятО‹є‘ІЩ–H ‚› ШЪn (Нy1—фs˜ЄЩ)—ŒНэт>ѓЁyс ›5y—žх^їyѕŠЁ‘PсЄ ŽBm&ъіКИз‰ЫЃн,*oЯe%2їѓ=СŸ­Љљ…‡—ДЁSбуіvџ­•”ˆFFУ(ЧяБжbо§ Д$z]1gЌ+uZю€zшх„’Ќj”RЕп|PŸъІОшn'sљКєьф& w ьђœМ?-ŒaщЅpgщпfQ&W#D‚]GmлyэЬПБ_ГШrmЃЎн_й$аwh5Zыkу6"AЗ\рХШI“)*RаР ЗХС§šm BщСПNй•Cњ# 9Lгk+€ѓо+исЯЃŒУmЂŸ'­ШэRA;­ЄЕž”2bђцяВпЁКuš§#-’ѓvšџ2JЊїШ’bxыЙ­СЕIstuAЙžбйgzO…ŽЋЈqАдGЯjk1ZО'NЭЦйLGЃ‘Šшыцџ"Cќ 1мJYц™5iѕ~‡™}Њ7}ЃЌІ‡ћГє*‹ы5є~u6'ѕ^[Ъf ,oмЬцkЉд^QH,уqа-Ь@9žPЄЫД9Ёќўt_Ђeњ ;YBˆQœWМЩžітю 3qˆrCЎf\Дp^аtЯЕО$Т…н€ нIљ+рЎaŽЫХѕЈ<ЉЁZVЋёшOŸ†PD0w€|gђ0ИЯЪЁшyZЦ)š­БЧ€*™< бј,ЯЦк<ж5іPН MўfЗањК 5‡:9ўŠТпЉyg~ЁQn6щЇЂтў>mjІxL3yŸŒMrN(Х .ю ^џБр хџwŠE+ГТc БЌŸтяьє0R{оо^i‰$l'DVЇYr?4иlксч§l‹KРevКIŠЫоAEcди17•=кђl63yaуўД‡Zp†fuгЮМgrУ‰jг:9ТЎш55о­Фœ)ы§:ј}sW5Š6•еїDњyЂ˜ОcOб{*/C {0(Мt­cfq ОЯTCжšŒн›n9Юo o c(]БЈ‚„d8^—иpXp=кzLWR*?еŸчЪ Re6~ЬЉчФ‰‘ЄˆЄK(О•ЏlћxHe‰зOIюћ8нwp–riX;iVэ#Ўњ?люzжц…Ю_(T}ЏйPЈs6Ј|K$kИM~гkБB—œ/aьД—Кb]r@цйsr%N$2QxbщљVЇaт{АРоv˜Hпђлю?ЗˆLi4а*Є‘ЯЅЛŽ Y!cрj“›ЭmБ/чRш™7ŒQš6ј%tœAj’е?0“pUНx6ЖRs:ŽЈэњ4QwPХ6егqС–ШS* рЭмdPЅЇŠ€.)еыЎzѓEѕИEќњrз§ДУАOƒЮ\lЕсOъ2й7џЖЏIz€№Ы„%4іA6d|‰'4+EЛІŸ)щUjqУ“vМY•Њ:!У“ У єб‹9“Ўa”iOwŽ*[Gс“јпљ˜З zўkяVn[ЩЉ•ŒE[щА ї.—јМf‰РЂьЭz`A иqЙ;КqыFMy*т&V–Wр[ЈДи)g‚§В'WџBФеф{!ТŒшƒ~IУдoPХі§зwЊž§eЙ‚КЈIQ Єbs#хŒЅ‡Мжњ9­ ы‘ЂЦ$DАш‘ьќОH[ы9еЪЕаЅJв†ДOчюNЗЃ–|ЕZж№о“кЗ';O“тŽPЮјnф­)кPоrЊv}А5ЖэёHšwfіЋ&`Wь :р0З}{њѕ!TпVжeŸЬ ƒIDj]Ло†!шїaHI!!lжъњŠXл‹ёј†ћ1*vбВњ4м‘|ŒлвЯHу’цD VT'‰’кРм?ЈЪфћ1•“ЂЁ т}ј”Z­WMc[лNQJzИЇž/aDОAММŒльБ,жŸ^q‘ьЈ$ТЭљ(qc8ЂhqлWaœ/ "Э7г*цMБlЇkСЦФ\Ыг ;c )ЏЂL|2;сЕ)SГсoЄщsBѓ1АН4PбHчЩžчё>ьHІ3N.КГЖРЅaœ§рeЭ*З„ђ^} a! ЁˆЬя@)ы:џщ_NЂKК)РЇпЙ‰тщ.‹”Нт7A%P‹`жsўWзѓSlЁ‘šЙt,˜Њ;ЦяњnpиЮт†срГK}ЖУŒpзЄеБ kДйe<Я‹1&‰Ћо€…йЩћ|кђаЭ цЅбП>ГБ~_ЋкЌ”ZБбјa@ч~ЏпBJn6[УР‰N2Œп‘Ј }7=ЃkCbžќ_ТЄ'R}ЖЧё'Œ`иX…ьчЊHKšИдАBNхпw‡4!Я 3зo`ЎўwјSUBxдбћ AЭшЖвŠїИPvљ1—A›:,d—Ра^TЬЊGs%я’‹sмгОМŽT@ š?‚ПŸфtПвЃюWЃКA›ш4сЪХVœ иy—ЁЖоTєЅЯњ@рOp)‰\@“rЇ&yQZї…с{Х(x*Q&НЦ+ЋWа ўн‡uў™:ЭsЖўхmkј†>х.йтѕ‹lгЅюe8”нb%Ю§4ž‚~їИu7оLсUCЯ-ДxZЯјэ5i8Nuœ;ПAФ@ItrР–чоV’”,ъ‚I‡Ї hЁщxщOъЬh№›HІSихћf—ЮЇ*_z=^Фе%д–Ы„УŒXЉMDчкП…BYG_;MЇcцсЃ“qc'rЙЋnпФŸgвњ`q?Ш‹ЏDШlщ.Šcфar€ЕDŒюQСкd!ЫŽРјh“7цЯДТH;ћ'm’ф‹SОl!%Шя)Ќ‰ШЖ*gСЗBТЎ`‹с•ЖpW БЖ ф-žSi УоT‚ЌŸШЄA]АЎ5%ЪˆВŠcf„`SJёlСёѕxU_HJОyмw+рЧЈ†€ѕЉфРŽђšU Ёlї†ю~– ;XсŒќфБ%Чцу‚ЊХїR ЈP7$=дГВРРе›ЦŒ@ТnљŠФˆ[t”&ŸћБЃYpѕœ§КК–ѓ|WTHOY X/ГŠ2pјfИТPвЙЧ5“NЈLФмСЎЉˆVІёюШОВеOиЃт,ЛЭЬ98Э…ЬШjуEЫVYeеБj”9V­ёиПчЏ95ЧЯЦ\ћф{§а4ХЬћz„’ ThС9^Їс/ЧнPыXlW6$m&~nPЧR —zш EIМпtZѕЋв[žЇVW6Р‘ѕэнOпrЉтё+чЈh{=K‰Tамˆи=%\Їi‰O— х5кќ№ф%dя8шЇЩрeCА•ќћ#О]ЊU‰{iД ћьxтвШЫэ)нМЅВ57ф-Ц{Оѕ>Јуз+зОH;ЪыQў‚–5 e+Ъ]bщAEёВїЮЄRЩЙ7а2—зЯž^ћ9MœhЌЪ>ЯЃ_ы~C$gбMVйЊМаnиžvЪ•ћ•\ЊЄЛyВНО5!f@п;…ж˜nPgjл!ёXвg‰х U Њнp“УZЁбЕй”їУM„w_8„“щI;­Бmэf{ї$ъfКЉSѕsеD’VЌШРЂбЦ:w<М}žЅј rbyшqЏkУАKYaР63D™IVmІыфЙ&4-џЪn№ЈI$‚aмэсž5H}ˆі›џk'E9Бlэ”йgЇYо"5(YlфС|KЕвГŒ{Эs–гЇЄ:ˆ_,ГlмњŠиЁХІ•Х€ЅJQтnžъЁ˜"ДћaЖ/впЖ™2{…З=>и$аiњž%>вY"айП\Д%5Ш]i B-!Еьa0ћ‰M$йнфхЪ)ћ Уч,ѕHБФJМшЁFуЭtƒѕФВœьФЗРœ—egрcUЉ-–X“|RžќSи(ГУЉhќ—*їШž#§рЫ5!Е ћ1}ќєYџQаV"ƒ…Л3jН яsШКzƒtсз{КthјWŸ'CтXdMћnуVКo|€ѓЭ}ЊФ0юšџЅM…gоj([Ъѓ“PA„lыbбtсRLM(ћf\`Оќ ѓЭЩˆ‚ Gсš%œeкЌ8‡*Aљё7(ЩГ0Cy™Ш‹4"ЏІў!ћ;(DжXE‰K&zић-M\ЧйYљоЂЩxжеє]ФчЬ$A‰Y/,ўAppIІЄ4]Ћ?н”Ъteф(іЋѓИ2;A3ОЃFжD~‡Ž9TЧЂ],šшfф9#GРбћ(ЪM mвЪxb У6:ўŽb›И8кТYКЅшч_ЖœC”З9yзK^Nє€˜ŠАќћ€ЌvƒV\‘П8аemT˜W~žоRЏяŸW“ЏG'пАžXЌ8 —GP%PВƒ$sяЖљ/}L…їn%9 jU(Ћƒ—јјr™ілƒО|qŸœ*Й+šмёь„18ˆ•NЕzLПОШЩžЗЁž˜œ\pŠЛ}т4`Ѓї ђћnо;ўзАšљƒЅЬнrёЭ‘z4ЮnЌЙdS)ЊдЫ_ЗL'ъМЅrФ oIƒТavMф фifьiМ‹{кфяљцHщ7•ЅѕUўо(vпvнС Uœšh#ј`x6 ЌъЈе.УКсњЋЂЁзПю№юхаjˆ'œVEGиU:)Х)„гul7Ј?КEў7ЫЦr zJмЭX‚х\љ‹мћкt`ЭkВ RНчЕОЈлC‰’ЎљЄyЖюq!ДЧeчWо|%Ћкf\oBee^ЊеьC&ц_7ввg3PІa’ьШЙ c'}щл#bД”‘5џ@ЛБ›’љ9лФEЏuŠг` $Œ‹iјO U7_щ+ŽЏYрSaPIчў3jх9c4™"ЬЕŽїиWJV”hКуvНЃр\2 A˜wжЄ.ЬНПHkœoBТ‰iЉšд#*нq1аCŽ@o+!Ю]‡0љѕ Qє~Š–mЌ‚Н Љ(bжш§DјщЈбZ†ЪЬ:WбvV‚bВ(›M\‘]oa,’SС]Е>›п7зПTYkРЌ ы Ѓ0Ѕе~Вм‹*ы‡vђtЎ˜ŒѕИLЄ1и› ЂŽщ_Ž48њИ№S+Ÿcv|XœфвяЭЛъжP+Цќc;SŠ7/i9§ЏfЦB˜Э‡_Щ ЭGaЉуq-LЙЙЁЕh,кГ™мкtп[щ'нїjЋHРRcжqъTб>[ Н.Iќ+‹Еи>ЁfVр л<"еwяЛ\Ѕ^ћъ№ЎК—Єѕза…DфE&ЪЃЈЧzœQy/››јд//x.}Г|§ЫuГМBœцжWGС4Rf23ЎŸќї“(M,Еe7pŸ„–џђ:шТЈиLТ ]=Хл>MLqЏЩ:СаДV`2-Ф‹Фѕ]ЕŽœќf k 6G™VžХУYХй—Ясыw 8t~ЩяъJ s"Х l~&Я ѓ>{ђO4љЖЬš5zWЁjƒјZuSТгЁЃ.џЙљT лмuГ8уhЙQ™р9Ф~fЄч`=аˆŒДœlНх€”`Јгw?УA1№=V4ŒћC"qЈГm9Э>сaзx˜(Тe|n4јœв\S4Ўї&+ЄЋD}d=4VvТ•сV)B endstream endobj 196 0 obj << /Type /FontDescriptor /FontName /JBDKRM+CMR10 /Flags 4 /FontBBox [-40 -250 1009 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 69 /XHeight 431 /CharSet (/A/B/C/D/Delta/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Z/a/b/bracketleft/bracketright/c/circumflex/colon/comma/d/e/eight/endash/equal/f/ff/ffi/fi/five/fl/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/parenleft/parenright/percent/period/plus/q/quotedblleft/quotedblright/quoteright/r/s/semicolon/seven/six/slash/t/three/two/u/v/w/x/y/z/zero) /FontFile 195 0 R >> endobj 197 0 obj << /Length1 1882 /Length2 12166 /Length3 0 /Length 13338 /Filter /FlateDecode >> stream xкѕTкж уwЗPŠЛЛkёB‘‚ююХнŠЛK‹K)Rм] E‹C)<Žм{Ю§ўŒїFЦ ™Kчм{­ Е†ЋЄ…ƒHЮтТЪЩЦ!VеффpppГqppЁвбiƒ]ь@›QщtAPgАDш_вPахХ&ty‰Su€”\эœмN>!N~!‡р B и ЪPr€€œQщЄ=Ё`+k——6џљ `4gp ђПљ3 i‚‚Э€*аХdџвбhаr0ƒ\<џЇЃˆЕ‹‹Ѓ;ЛЛЛ;ао™Эj%ЦєрvБh‚œAP7рС5 =ш/elЈtmkАѓ_v-Kw x1иЭAч— Wˆ xiаRTЈ;‚ Ћќ№№їй8й8џ[юяь? !&ЭЭьO0Ф ` ЖдхTи\<\?vЮ/љ@7 иhі№'s @Nђ-ј"№oyЮцPАЃ‹3›3ию‰ь”y9eYˆ…ДƒН=ттŒњ?0dўrьžьнЌ-ФСт§7АC,,џaсъШЎ;Й‚eўy1ЁўcГЙx988јy 'ШУмš§ђкžŽ ?œ˜_јz;:8,_D€|С– —/Tog рuљzџлёП•“`6w˜ЌРдЊП˜A–с—Ы‡‚=†/ГЧ рјуѓп_F/уeсБѓќ'ќЯћeзUд’U4`љKё}RRoVn+/'@P@РЯЫ№§п*џеџэZ5€рПЙqќSPbщќKТЫй§G†лпSСјїЦ0ўЗƒšУЫ(ƒŒџLў{^ѓ—?œџŸчџЯ”џcџG•џЗЩџП„ф\эьўt3ўщџџqэСvžМLВЋЫЫVЈ:Мьфџ†ъўкdUиеўџz]€/л! БВћя1‚хР А‹Йѕ_#єŸ[x)o†€4œСМ5VNŽџу{й7sл—їФљхЎўt^жщ[ЪBЬ,ўи;.^> zЂrМŒ//Р›ѓeA-@N6€ трђ’x‘ч Аt€ЂўqЃ|МvЩ?L!>Лд?ˆР.§_ФЯ `—џqиџA<vЅаKMхаKеџ"—<­џ"С№$`7ћ иЭџ‹x^:М<2іџDџqZьџ‚/ќ@џ‚\vЫС—ОVџ‚/хЌџ_ƒџ_hйў О№Вћ|!fџф|Ёљ|Ёс№э—и—џrПаrќЧ§rоŽ/Kр№/œ/д џ‚/дœџ_2\ў _і‰нХ њЇСЫœАЛИ;ќ+с…ћ? _Єx љџgЬ]Ёа—іЯU™Вџр?_sШdŽК4я`.bгвuW'IцЮК7!:CЗЇ—ЮФъН§фњ€‰œТT›ДН‘Lљв‡НК#Ыx-БLѕлћЈН 9М#љmч/ŸG“DЭЉНNдХo„C“ХG’ƒ(фЌкћ>П|tmслaЛ•шђ\05 ёюмф=+VЦТцїоюзђ)Ѓ=VLГЦъФМ,Ѕ+0Ы™#~фТJёŠїмkіњf7oђ™J)‘еї8–ЛФл`“+ю~Юk­J›ЫЙ‡„–Ф€˜ўwlŠо[ъ U‰hСЛЌd:–6Gјi|ЫўЇнЃзžšцє№Т˜žnRˆ‘„˜_1:fЃC!ЩО”: ‰'ч|UiУCё‚ПнЬљzјYнŽП‘WMpЏї!Џбы™‘ AŸ9\гš Ѕ‘ вЯN›зHQДg5ќKДў~и|mt ПЙMгT–Ђ§SРЖUvƒ{рсš6ѕ—UХйŸJ^гn‡;ЬvјчWцYCнћуЮі$ЦА)tЭЭAЂu)y2h,dб„9Ў7‚эdˆЄБ4)й™љэмЭhУ&F {GhLYЕƒюЈwƒ?v№+t*ž%kЋѓВqŠQуую[сТЗЦ] хПm ЩЌу†o)EФ=1†^ъUї]ŽО<3*bхaЋАв’ТBWГћ€gЋž r6SЧKf,идџ$TЊмСŒшs*‡ђьн XЈ˜—}ГA’ћЫЉ ŽHь“ ‡qšЧQjУлС'§ўУџУаШ.0 њaOƒ/з.m;…p„bЯѕ‹ЋŽп)9Еtы`}у‡…>іЌW/-8ЌМ§§Eь‘цИмOЦђRТB­x‡ќрƒRGЮ`PяƒЩЩхƒЌbќ&O.g™DИЕІˆ1B-К+с”њaц‰T(˜ЃЏЛщШBwDм8ѓ/еdмŠZbrБГйфšД ]gЇХI„^3YПиrДЂ“UЏЈ˜ТVDОДЦœК§ж˜Б сTЄQ7йs^+ю‘ЛЕr­ып9!4лДYaqA Л{NN*8џ…‘gЏQЩфС№АOЯХчmъh9oIt;љˆ Fјmѕ“BЕrђ}Їrе%цOЪzqнЬВi"щ,}аЉ9™#јуЈ2zoжaџjŸјлtzТ,ИƒYІДЇbвHћЗ x‚|[‹ŠќH…@=™lИЉзTњE?Gл2яY~LZЌIІтOcˆ'Y•=[Ю$?6LяЖV˜"Х_ fђВ‚SX‚c>+!zдЂ ѕэЏNžНѓеќ>i5М'шWћэахаNчР‹КТˆ!*ўKœй’jуЮ'aюfŠБPіJОwЈ[Бb›хчu:YŽ,RПы_пQЪi”ЬcЪHЏ 7@AъЌТЯЄа‰ь§шyKЬ{MрјсМM3OчЖэ~˜ЃЋЃ /!ˆ!•u3ЋМA/eЪEёYвƒyЌˆv‹zеŠJžX!@ †МRXГWцDg3рXœкюcЌъRе—žњС ~Јі2ёC‹ћdВ?“x;|‰єЋќT]3|~уmлЌмђk%с*s TЕžЬ—KБђф=‹7—|В’fћ)#tŠŸЭЧk6 0П”йЭњo%ѓM[gђ!Ђp-m4ЫK Є2иtгЙЪмЖыв№ЁcвnУД?яXЈЬЁРХЅяЂ~Џ"МRŠыwN1Ё(kHЪ@єŒѓ_"ѕёж *ŒхhЪM“J‹чЗQМ%E$ IчJ#§нФ|,ЅCN—рчA“x†!јСӘDоХ& { Ї2ЭЖfpЌšоaёHqзї kУ‘ŸчЦ‘ЁJ 2n‰o.˜ЩK`ІoчљщИніˆ}мтСSцЧeйJќд2‹лЃ’Ж36Fѓ]nau”ш˜к=ЏЃHдw>}DЮoѕ‰rW‚&›у nh0юцŠи t"з ЇT№+А'ЕђЄi.+wђ~Ўž @šпгi&Xx#Gю3ЮМWЄкsŒФ$VгBџfHM_ˆ—@О7Hыя3wkO'І§iвЖnые!д5Дю„*$ЊеuBЯ”Nœы­Х•Л<ЗEР“pšE RлЊнЈЪ8i;зoєd­ЫkзОэtщљh:вСwкз šW1УЄ6г0yѓœЊ_•Їx˜ѓd!ѕЇfі1г[‰ря3y3q{0_xктš*•P1CЄаЃЧFh+пчъP$§­8п~ ЙYFJћхц#rТ‡<+ПД+сыЄ#Жѕ%оQ‘ЈšЎŽ‘RџЪ-etŸп—ГIжЎRВVyЙ&–ŠЏчUjЊQr/6KцУfН]т• С%C*Щб7юUS[fmєЦšrЃм~,>^ЭEVУ^FйъcI%jng!DГdсеЂ1tDƒЇŠYч&ЕЉћ&ѓo?йиVюХаУћ"f.ВХоv‡гЗ“Ѕ{дьЕ{Aв1Л#ТlЅЫъ,єX—R~ѓ9E: 3Ї;ВАнXйифC)­]Шт'ФЙ…ИJ\–~.yв“ЩePЛ‹м8QažдuЪБЉЮ`z—o gJr@Ь’jФн№оЉMА(Ѕ эдт ђбчгg§JAѓФ§Aуˆu;Y! ОВЉcгоMAƒЙ'> ЏФ и›ЭѓЊЬ‘wˆь›}mLT} ‰]Œчюc@m<ˆѕй]И`Y?}њЅlџœЫУCЦnVЃі|Ь@šqЏМвЧНї ччХa}`ЅКѕЄ’фpFfc—˜q)Ў [оL‚'32ƒЂНKлL…ЭYZPб•В} ІG~?uшЃѕ'M4иYў™ЭЬ?ѓ‘Лwїѓ‰Дje,№lћI“Ьhыt‡UЛЄђјZѓ‚зд"  еŠ%oд[‘љ6KHЖ&qь ЉТВPCžУдд/гxaPFеЕs_щюБv2ЖR+5З|ідп@љTFmTыЕА*БРжP~O€Ю{ 3ЩŸ,ЃвФk]Rи;ЌvВ *­eЇ„~/ Т>АЏе KŽіTYќшNэёШŸ•ќm~4˜>к1YPјјЮb1„Y(їЮ!жТ4ЂАPRѕAУ,$&ŒRœ~Xы‚dDг\9dgEџeT–VujЦk7ХЌ.‹Т›€QЏЃm§@Вfчж-иIfТ{?K2Fы(•9tDЭ2ЦиІ‡2зЕЌёK7:IнБ`tиХ\кДc.›#+n ! F€Зъ$у УaRЇR&:i-о‡бQˆИЌc\ма Ї0ъ}э§ІЏ&яЙ|ъџйFсHDФA0Р‡™аUТХITц7P‘y ,JЙВмWф,#ŸЕqщgј" ФЮЃ˜+_ЗŒŒ3кЬ5Œ@žŽ!ЬRаPНмe{ф.к~hђЏэьоѓъWќL№qЈŠ’WыжWs”ŒLхAвq62ЖJ„ЅŒeUњsЫNPЕ\3цˆ\L}…%Дѓгу~јУХШЎi"’nOЪOzYYИМ@ёslbЬљ;|tщ•Дс ~ўVгс%Z„кjUЗ ф?}Cщb&аkјєЉЌh “с†Щю8Л!Ц‹ЅИ4‡YЊлR“ау\˜;"k(pѕфУНXp”сЊ ŠнЦЈŸЎЊ i-dДЬcпЃOїл Дn%ƒ}дйОЫ К›iСu8J!{%lЭgŽ4Q7grYУЯ?тѓ•aoЎŒ›!›CгЉк/VѕH91§%_o@є Ч~r6Уvђ„B•)zеЅY е$ЫЗD‰ЌxEOєŒ=ЦЧ=›ž—se§)ыz—]ˆА}еђЎцуdFC>$ЅGvWf–PuS&[G xmф л"‡п=и“И$ЋЧ5bЏ Aљихr  RSZn'  vFieгыxы’ЭУд ­˜_dУF~Я№Ў№f(юЪ (*/–"2bоgW9ћг цК%”kЋ%рm—Є• Тљwя„н0 ю9БarP€КІ+Ј”шQlO~`­Ф цЁжFуkэНя5—k\љ›œ0Ž;яlьэPУЂ2ЙѓЈWЯIЁI!GЄБ`”ClSзъ^ZвFs„В{ŒGѕQa?п•2Ќ6œ; БЈвWЃ˜cЉїTVŸ‘aэtмJ~GхБр4О~Kч%:@[Іы*вJ ФЇ)Ÿv3кД:юfПОлHDw}пп™з8oT%Њ!эђИjТЕ:˜kНЎИ<-рŸB Ѓ#/Фѓˆšч)с>јкzP>RШkы7'єє)GЦнёuЅАЭЯ:I„‡j” S-Эї-я0ыйІне6‰~Kз'кюyтUњ­Л*а2 `NЊё7мА6и‰(бЌ„’9T-IН“~ЩqS $ЧkЙ+@}eъ9NŽЎ<Џw–ХСeй’мтВ7qlšиyR˜Аˆ{iˆц“:>ъe,э:ДMа)бЅ№Ш„2HТяІяМІc)Eo6ЗиgЯЁТМтЄ‚Ѓ‹чXboГеф РШСUЗй‰ViaŽЂоa3&X#Г уbŒ_›\ѕ>Э”xљdi5эш*ЊюдZ2o…№ѕ ™ЏY6IЫжфwcuЏaоSХZŒИПLх в-ќˆп- R’В Э'Щ9Ђаќ‡ іоU iтБFc …Э'ГєыBјЬ:З№#єг8ОФЃяqёcф>Ёv6’6šjZvˆFu}щ™уlDЉWŒїCVv„zфKfъW"‘S—…$AЕЬЅоБ ;EŠќ5чœ~б3gVниіб1ЇвDE9sьB]wЙŠaFы@Ќ3ГЙеЕФЂŸН­Ѕ[™ДРкш0^H† ЖЃDМ1N№и|iH>˜пБЕ’Ћ%%ш­Je#CБcF+Ё…Фw&MЃоgkёeCћPGqšcЂ4Ž7юћт^Y­ЋЏЗ]еЄАŽaЯуˆuѕ*bЈѕљfA™њ—ьўОЮwžу9™'Œ+О‚œ‘'Ÿ8zv—в#n]#їЏˆОз9ЩcxFМ/&’ОP‚Щg ЄпшБWЄ#CиЩыFЮ| йнћmь‚пQК*ПHЅЗDIЊуњч:KгяОШў™O88ЎХMc› OОіqgOƒ˜ЋСвˆ.^н%а?О}o‡иЮВKвyЛWьЫ|^шV3•o‹D„ЩdkУЮ3bљЅ>§ї2&Dšћ‰…€Кܘљ_,DД_ИіС&хR9^ngІфFв‡УFц,S1!MˆЬСЃїЭ5{Њdэ]aЗ яЧGž†ЈV.у.э;tQЫп”hv]"-ЭCЮЁqЫŸ—Z'DYђй]LšЇп0|ьг`ZОќVš ežСйтб u\ ЭG#зёІ`i)› ’Š$ЛфХ„‘:-чgЂMеЧ|œv"-в жЗ&ИIсgњ;hЗ~А_њLЋj>ДВšЦmжЂ— ѓэЋ>ј цѕ[љ]мОИVжл]0:t-=#ЭZ‘fиЩbЛ'ЗЖѕЮ‡АФј;^Y,7ълсЧЫшЛRсцЪЃЕSšqЉТЊ1і"™A w`Э}vЩƒ4YˆnЪ{M‚Є|Я4й™-ЌРЌ>јŒО`2›ЩGmANт3фRhmЫв•‘ЖЯР”+G†зІžj”жwбК„dјKьi№Дmж}жг@ь+аlь›ƒиЙ;*ЩЂyЙœEл&vГїз; nŠkЗћ_рZбр отЎу^цРЪдЯўИќe{чœZh-ж’iš˜Œ-зЈcєГЁгЈ kљ"†…к,Џg—Ђ8%—‘Ол|~џёa-БœО7Ъкѕ†ўЅ$l-vLPь,нCœ љ{ єзђŒЏзбЗ+ю_7‡m#~щщХO™Ц†ё E ЩKcyМ@ж†Пм\ЁЛ­•‘tНLвЫ)ПœwЋрЕ§ЋыPЛa|Кђ ЌskПЃV ReЏtcCО“jМ  ШЩHsЦлKК>МCмSНCkžmŸeS›Цєбєѕ" eШ61л–K2Klž<иИaэ€DгkJд'ђ0•щЮЪFr-™С#мLJУBЄvЇФx:юЭ 5Vлмž§"šub=ГHM=ЛVмHœЈъ˜ Џ>…сŠ&їжƒ$‹ZАХбыm79>йы$У36Ќ‚‰5Е 2ŠОяTжФ1E>TИчЪпХxЇЃйx•ЗfФXУ‚Yx:=ч$ЪжsтОIЭОЃjыњpREСjњˆ“љ!ёчx"uI)ЋOљЕІЎ*”Х‚Ч&іЖвНDšзQ{ТHЧfЪvsсв“ŒjJќsФ?"їрІ)ТЙg Р‚xM­€4s6h їіЛјыъupOKaФю}юъЎЬjУw˜Ж0цQ9ЯКEГН‚U }Nu\_Š'qИN\\,јЯe]Гje"БŒIаc}ŠJ|?0eд“cІЗQ@]ЈЖ^тИDь?хHВŒяВ‹_ƒtЮ ЪЪФЂ79"HC…~ж]RрьЭПХF-к…I<РпЫбk&ƒ'№ІLД—жYln}ыђDЖ“cXeАQ‹c3”йфѓў-еШОДhrё”ШawяA&д%H3ћРЬбVщsЃцN.…|№O2тHŽ1ЇSRГзDhndqSп‰Ђ‰ H„tІм-ї А2лъܞȘŸ’мТОмЅћlаC7Ьnр[]ЕЭ[ЯО6YУ’Ѕ=},оiŸ‰ЩДоцу+0i{Г‰ФqэžД|1+šqxdžbŸ_Gv” м.уя—D|D›?A1Ез’бЛŠЫЊJKЏz…†&’_w{ З№[тэ‰/ИIХБЪrRєЇЏШ}ДшбМјЁUд(IхѓИсЛЂ€1‰IљŽО-ЪdрЮЊъХін№c•ЎJnO&Ї§…оФ{ђ­^ukсb?ЫЖd†sлЯњіК‘‰Е=§^в*ЧХТЯЅЮYх пКћW›.›Є^Q…QB ХLфgв™Щеб’5!Ш\ Зг+mм YТ1КБУб‰П˜#˜э `’’sVH›RvрлПb4…щгy gцб/ЗS?И КjŽиІј?Ћщю~> žOeВ1c+Мƒe7ЛыьЯŸы€Ќ+ШЬt–Ѓчƒqс”щcя%ѓвВХ„ц=y~јїHg‰НЅlєŒЊНфtТ#ьDщк…§L›ЎY РˆМВƒЄŽWЭn—ѓЎ u"З}ќ^“hїvT›р5ЊЁ iЭ/…д“B7ПФ41мS Ф њЈˆм Хт/ЎІшЖРHTxnYЊ}н’~ГЁзž–d0 ?sЖз /тHAi,*:Vлu@їтQЮТ#>юkT}Фњ:nљz~yд^ЧM*џˆЁ–'шМœщ•YВЁЃ?Z\YsА25Б;'ЙNJqvd2A ^'ј0ЩFѕ, ёй@ЫZџ\@Ж%F2йM1tŠwєй8Jрœ†j>Щх!щѕпQ/ їБuЌvРc№#IИЎЫЯ~ јжNя шдяk:юијcЭщmЄ‡o-2zА§їъv˜Џ|Xпš7.Л_5и;Ш2П1>‘§ъђвu§МX kDO™eЉжк! fПАЕ~zXreфнsGѕъЪ0ћ. ХL\eKwЩYsЅіTEYЄ$рощ1oФнЈ4bшх^‘ЖTрWйb5‡m'Х}ЦЬ кя&ЌГШ‘UЗћЙэZчœZ”V“k№тWЙcqTЕЕ=%8ЁHS NSГДHWЅtё њ*B$^С?ьђ ШlГћ.)ž{ЏŽ]рА ИИrV,OMЫŒЫ›BvKЄ9еSЬнŠќHmqбц•ZЦ‡Ю„BQЕDце­šeЬLЯћq9tŠцЯ.еŒЬ“бJ%QОБ—BI•ІЕE’ќуzяZx–ј{ПП##ь_D0ZџzLяЁxAщЦо5,-ѕ2N>сTšіКг9EўзA nPqЇЌЈO­ ›ЮЬх ;О†ИН iЭ€с^—Ўјє8X23-sМG?‡џЂcр""Отxe€ќйrCsO}7”эЈбІљЧыдG­йЋзђzw?0ІЅ‹гиг )yBl› [вsћž­ˆjШш‚ЭЪ№ „Œ…V ЎАђ lЙЬ…ЅŠc0ŠRСљeж_№'фa’ш€ЦbwЇCH@кf˜sBMнМlХіњЌKI—žўPђ9LеШЏšЩSг@У–Фэ”ЛиAЄїв­АdGrѕяф TЈЃрт‡щ#х’ОЉСщ ЃлЭЎєSHХ:Ћ†Nr‹куE4ГєъŽЈК@8л[—<С`мВ›xАў”ДбgІ˜B@яЉfm шJПBэœyЪ…“„˜л,ќИ;\\Э‡г-ЅQт/ў;мxRWM4ДˆЎЏјл ЌнŒ ІтQZлцcЉz)]М\ЄS*$љ§щеЏlœAнЃВ№†н}aqћнЖД0}—IаярOT:ѕЫщƒ‡фЩ…Т—F/.mRљг4Њх4œш< І`џ!Ђ>Мўј ztёЋ§ї4FеoГ;jќ˜#н„8tрe8И№tЉ”Ё)A’)} ЇМЁђfюїФЄдТћХ&‡УTSrлШЛvB‘Yпw ОYq47я ‘|@ŸъЏт…ŠqЅЖяЌRЄŸ‹ѕ>…LІ /8‹ШFj>ЭИТ‹жПђЋK~т†­ЮЄPФчNмC}o h„K•˜€73ŒЗЪГ<С+ъbј@э/ЄЎУ_О"b4p*њђОП-‚X&єП\ёgєOGгтЃv™E›У лy>…@#B>ы Ђіr~]Ў<§Ь"bX‹^I(x.7+2xK&ь‰П#ІHЮ’TЇ= Й$Љ!Оък|’ћє­п`Х`hLѓš2JЛ›YбŽД3?pЩћ2|\”1њЮƒ*зТШхMŠ‡kЄ‰9k,ЖРcєА|љсјч›С…pЊvчa*qqЛЉ/;эЖS†ЊЃX‘ŽВ‰Х\ЄЫ‚a›ПтKE€}'ˆ.NЭТЏ uфќ˜уyЧЁЋНГЃў†#aФoŸ№†ЋiЋпk9тЮьЯЋяU5ь­;фM ‹I‹R")&|cT+Ћ2†џM"—ŠЕa№[Оˆ\†уmпbbјА.X%Ш*—ЗЊƒ#R!NFjkbЁAаЬŠЪš—йiТХ=ьГ—т§СдП~р\`g˜Ьљ”pqѓюƒшя$4EёhŒИьOѕЂьmљbgB7Б‚ j§ №=AУœђžtхM›jђеqНsЋ~nРћBdЁR[a“dМ›Ёб“‡Э#љїZЊ Џ МЮЫ BdЏопеFzпRБ2†jГQ‰4cwЃIvб‰ЫЏ+mыЂ]йTC“7qюНBBFЩˆ8=ЛГ o* я+-šiЗЩ`dYO1]ПyoйэDКзLt“QЊŒ“Іј™Н…ДtQ ИƒЌ?Ÿ]ecБњaъUFЩЩ<ц>МKt›}д’А\йГњВAЎ›ф(Уйђ8N„Z…ЎƒЋ]­+ус{пV\l“*ЮOxgŠ•мєМuє–ИyмŸВѓ{кВЛ†ље){†ТњИ%юЊO§ЋPЗ.-Ћ]›iѓЅŠЉ‰ˆонйX0Pлg5ьЃ- lЌ№Oс›шОо„ХзUѕobЎ;Q*ііFk?и„лjюiџўpО"?Ю}ld/{сoћaCfXQБIЦЏuяыiЗіjюз­йФ ЌhШЋmЏБr8k•‹DŒPљл=ЪZыr›ђиv…Pсї”DуЊ™ §7fй\$жёъ“‹~1срвJШDK%ЎiV N џ6р&\nœШєЧ„ЮGeДФ™С—ggEоЭї\…‹в{ю ы#=^П!A„rOJюо”•SЃЫЁA=W'p€зОк‹ЇИVЃё^кlЪќE]њ7хNж cŸMПюlCфdgаоОVt šљh—ь]ЪъШ™†aЏ!(v–y‘qЃHж™4:›ВG№m *сЪаkЃї_Ч€ЗРN’L—œeЦ‘§ŒиLхї0дo™’~а‹ТЪћ8ЁВл Ь^Ц~Ь\Џ­Ыonр}ЦЋВŽ6HМІu5eB4ГB]~1ч(іЉ6эЫФ ‡и JVE ЁМіzЬbЉ ќ}4VcмКь’в­ююЎZњёVœФѓІr ЦP,CŠЬа%юјєi ŒOR?ЬAk’ЎбЊЂI–Йўмшєя'…hњЖьImu<—Эe3Ѕƒ’‰Мз2ЙQО$8э—дl<ЃlB„Ÿ)—иЅХд§Ю?ЭeуФИv7s1ь fRе = щЊЫ`вОрБќ•ПвZяR~р*wЌЦЌШчk`Ђ„ ёЛд…_ бЉk;AЖЊЊXх_с9ѓEўœЇ€|џ†›Кўљлхœт#ЯЏЧѕЙ асCпsЮO%Ўš‚Ѓ§wСJЅjы=RС"ешtU§}нZb)‘ц#—mѕ№§-ƒЄsДNЛЈG_sIkK„5Ч9?НcЕ‰t,Id ZѕОсЮJbєGУм)іЛjЎfйЪФЁЂМЩhЃq}ЅnxЯqž'jMЗb( ЁЯЋn\Tzвw„rm­дqu‰р#TњІb3юWu 6Ћ-Б?uzБ]ЌwFшZК–Є]ЁХEИ}ƒТ<•хkшšЦЯјЋ„ ГŒШє~ўtуbsfФlћ€цКQѕЌ+А]HdЪ-ЦLС4^|“сГ‘cэц`.Tфb8ГЅ…Ј#<~+ХeХЏ)›† ”Ќ­F‹щУmD*&JZ[HёHRЂЙХўмў†3д6QА FDњыКаЛHRеLm”й!Fc2XэвNxPє‹БkћїдaиВС$­ПУЩвjšУЁШќkАŽЖІшjпйШ›E2ыjдтрŒЊ$ХИGэШ,‘…іˆuЭ Юу{і{ЪЕЈ}ЋuŒФЕт;е6<_MяЌЧ‹YЭнCb!A^БюQ‘’ 2vIXПEЯCLьІрTBUШ+ЈlЁЧšœ :}tИЂдBЯNbC…IxЪ‹ ЎUдhcuШХвHџѕeGoЯt^O&‰`SоqX ЫсўQqБЛщrЭ–Š\Sh#Ф<ЁЂ]’L˜xє–LєИЪУYs7ъc#Cиъ^qѕNќ!‰јhy>fо”мbо|ЈмX}-Хђмил{ч?ЅХіuя?| 9љњЬ=ч#Pz‰у“—лѕH9ЯOgk2"ћбСўћuŸоT.kC3=fБи+Џ рЮgЭ=‚y[Мў[ан^лqŽўqЩDењ”о{бР›ЏўN Oи Ю[H0tK‚ЛЏXЈхЩЅоUbfkŽbъниŠyѕ6ЭU}л/gЅЩ_э2i}ЫnХ€ІЌє!Ђэ Ќ%‹cOЛ0СmЂп—{XЈ:ІF­f&ˆZг‚ v ёXVћ6}|ЌЄЪхœ{љьW6†ф—о]ЁeзЖП ЏJпЇd_OШЏЄh’љ]ЬєfВ@xyўЇŒž(Ў“%TЈjЅГЊFљЕЉ§•ŽЊїAq”W=F…ŠA4ЊВ~bbўѕќщk:™V•ГшЏ  Я@“ЅH<–„і\тѓзRfzy8enѓ&8ЂRЎOvrZ‘<№§|YпдАOН™чњŠbЅy‡‚yвmссržЬЉMˆџqfБмǘы%7Ј?јЪK3Ѓ…I=їС%Bбе лŠ?Й№†OЛЭР`Цё”"a {vimЎ9ёќhКЇ­џЃšУŸкЏГY†У.Яјwљ8vО хdУВg':ЖH4ожъhG…weсƒўђn•ѕЇM•­@Г™ъ№aќЌуgЪ‰Йг6|еWМaЉщ\2“|З$gB‹=`эЦ]ŽоJ9.ƒЄgEЭ y–ŠpGч>Ёіў:д§\Uі+Иd?ŒЖƒ:џ—!§Hї‘ZL[›ВжuBo}c~.CнgмIц‹ю3„PЖњ“Ќj?tИЕЉАГЕ&є{Ь#щ8ytРЈ8K|чѕˆ-dљ>XЫœёёїQГ=їАЂЩЩ…Ыu:кCBЋК№бk УŒхЃЇС:…šЉс мД?Ы,њЄ4bП:бx+˜˜Ж*‘f_)/MћWіs„§ў­б>Ÿ‹Щёу0ЫЯ%ЫЉ+П7VfYœVcEкъ~Л7і“ф{ї‘:љмWFbЧКgБњњnе5GђКЋЯ’ЕGёћщгГ}HЉZ…WЬsТˆ jkЉW$гЄ>ŸТŒŠШ8w8^jyQ#ГTЫС;н :жБ˜P~ЬЌј›†Бцх”жзn 0хХш™bе—snuЫМ<Šя:vПъэ›4n№‘њ‘0kФ]j ^Ќ<ЇЦЦЮу™ROlž5ŠQL'йЪN‰њЫ}јНaWGl…Amђqя’"-щйzїŽЁЎZїs‡в§шрfіj %˜ŸЎpХж2ТЮ€!MYH—Шб/[І}Пs†ПaUыл}ЈЅЄ'$ЖДб’sF”~Ž*ъB/&*Ѓ;ЊВWdЋ gь‹ lЭ“шо^mПѓР‡ѓhV~їЛGѕЕoy Южењ/yrШ“Ÿ‘ПVsЉђ›ЦјњГFШfbu!+к/Ќš’њЭЊLМˆЖЩ1‚RŠ}Rяc0yжŒ<‹,б`t;[^ќ<н й5zљrm­-“0Ы™ЂеД;:пЯm˜™zŠоvџХн}у‡ћnsЏЯjмсМљиy3щ0е_ ŽНАзжtЏуђ-†–п1Ў Y"Њ селqЬDжNL­щЯXІШ`у7žтЕ •СЊRƒq$2D “qЋЈ БцЫњ6joЯЁjpЛйX—ЄЕN$†љэ6}ЎL›•Ѓн’Ж†N<яcТ1—ULО”`~P%\ы|vњœC§u6љбЅBх} иŸ{ЦŽІх\ѓ­тIП­KZЁйЎ[‚“ˆiЅfp Мq‚1нrY^oќ^ЖхEЌ] Е їК<|ћ0хмтЗОщWч”ЏЪрFЉѓ‹cАШ§џ§Я85HNILIП_ђЇічќy[ІЫs|ЖыBЭztr*$:ЏкГХЕ/0l $‡4?кы.9žћ]“љNml0_нЭ) (—іbDTЕVКX5wUзтSuї ЕXS5жqЩ6ЛsТ#Чǘ­&Шљє#rг•`тkVТSЌ|"‰|r’+‰%ЕpЂА@ЕГѕ$D.Ќ˜Ы‚-2#‡Iзић*Аv/чпЂxѕ[зЮE sЬЂLPУf…ЦDИљ­ђ†,Ю•у2 аќЊ~”ёQIїЙъОШB|KАєљгэ›†Ž’”яЂіžcАØяSFCЧд1ЌЅXШУQtо]І#ћц”­eљK)8›=еQИ—б БŘъDп—ќzTгІУTдfЈ‰:смgЋє7˜oаьЈ‘™пŽоГзЎE=;xМ“ы˜мз6љd ЁйЃж№ЛХШћигбxА8ЖЩ Ѕ{$Є|D7Џо–•Ж@E;ч GI;dЫБІiL,Fо1эcJœžзсЂR‡…Щх2чy„Ёё}ˆ?pћщЮЪŠи‘Џ ЋO#mѕЗ`КSЙ_Ъёˆ(yGЩl$VХ ѓŽ<ФLЦіLкнЗЮЄATЅ…1”Пc–Вq§sq#5ПЗmѓ#Эо „зї]GхќиЙHСыНь\ј€x%5Ы,Ne9[Ђыdр &јБTЃЬл-Ќ{}ё…йa‡†M’€ъНк|ClЦanRЪВŠbЂЫЗos FžЈЭК)&ЎЮ™bЕIО8yкŸ’њ6‰ЁчˆЈСіЯ,>ъ‰Г%:;wљЫБ|ЂЇ jшDHS››SЅ7ˆЯ7Wэ.§›о9}Й,.ŽZЋ+\<,КLhnOъг}ђsњžюд…љњє:жIа.Шkфё}Ћ‘улWf }9ЏЭšмHНhbъ#їXœE Гž:$Т>#O-lŽРe~IьЕmєGg<йУУ‘м†vД}~жь1аB†VuyЁв)— џ!К&`<$ђ бЩT~ђHЯ–<бjкtЌtЄX)зfЇю]›е›Ц/,0'Йd’ŒZЙ‡w АПн<ЏЫ]]бpƒАЕ{%ЇОžDЋѕБщщpшІЗ:uhpjц%ЖћеАЧ?ЧЛ›ъL,oѓСбў m;ѕg^G"0ч˜$uюк\ЄUDђыНЧVvЇ'mњym‰FшŠšл˜(Х(FјЅ|хц4-ЃдˆЪя!„ЭŸ; вЋ,ЁLЗDЮћЩїЗ§фPя[~.(О2ЕDЯS!<Ї7ЗdšЂ[ђОЁFЭїˆкdIџ •vl^Dы‡Ё8J§‚1‘ш‘†ЏѓrJ„ˆ›†’т|Nє!CфЉЌDіЏЯСЭa:ЮЂ ЙЅЁвdCж[ГиVy(цПXdЩZРH!GбЭ9QЁ{Т‹3] ЧЂЧХw“ZАQЩЕИMyїъЖДЏ]Ж‚q˜‡;fn6§%ЫЊЪŒŒЙШMl‹?  6\0)тљ5фnŸў?kњш endstream endobj 198 0 obj << /Type /FontDescriptor /FontName /VISEIZ+CMR12 /Flags 4 /FontBBox [-34 -251 988 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 65 /XHeight 431 /CharSet (/A/B/C/G/I/J/K/M/S/a/b/c/comma/d/e/f/g/h/i/k/l/m/n/o/one/p/period/r/s/t/three/two/w/zero) /FontFile 197 0 R >> endobj 199 0 obj << /Length1 1665 /Length2 9553 /Length3 0 /Length 10615 /Filter /FlateDecode >> stream xкЖP\й.ŒЛ;С ююююю 4вKpзw‡м С‚Kp !hpdfюЬмћџUяUW>п’oэoяЕvZJu- kˆ%Pvgс`eHЉhr№ийЙXйй9QhiЕAюŽРПЬ(ДК@W7,јЏ)W …ћ‹MкТ§%N(z88ИМ‚|‚ььNvvџB\вž k€ +@КЁаJAœ}\AЖvю/eўѓ  Зbp№1џ‘pК‚Ќ,Р w; гKE+ G€Ф tїљ/ za;wwgA66///V '7VˆЋ­(3Р фnаК]=ж€п‚ЊNР?•БЂаДэ@nкЕ 6ю^Ў@Р‹СdЛНdx€­Ў€—т-e€š3ќgАђŸЬ€ПіРСЪё7н_йП‰@р?’-ЌЌ NЮ`и`rдd•YнНн™`ыпŽn—| O Ѓ…хKР+ЗШJh,^ў%ЯЭЪфьюЦъrќ-‘э7ЭЫ.Ы€­Ѕ NN@АЛЪяѕIƒ\V/люУічЩ:€!^`пП€ lmѓ[„Е‡3›фтTў+фХ„ђЭшрaggчр]@o+;Жпєк>ЮР?œПЭ/ ќ}!Ю›@ №хХзЭТpwѕњћўлёп…ƒ` ВrXmA`”и_Ь@›?ёЫсЛ‚МFь/НЧ`џ§ћћЭфЅНЌ!`GŸТџ8_6M eiE]І?џэ“”„x|YИИ,œ<ьnЗРџПYўжџэXе-@­§BА  №Ї„—Нћ ЯПК‚ўЏ‰aќwUШK+єџtО1;ЛеЫƒуџЙџџHљџkћп,џЗЮџпЩz8:ўсІџУџџq[8}ў xщdї—ЉPМЬјCѕ€NВ афсєП^w‹—щл:ўН 7Y7аZфneїg §ч^шA` :Ф єћЎАpАГџяeоЌ^юЗ—ГњУ|Їџ.)Ж‚Xџž;N^€…ЋЋ… ћK{qђ№|9^дш§GgиXСї—Р‹<€ Фхї‰ђђиЄ~›ўD6™П?чKЃ§^"-ўAќ6ЫПбя•ГYџ rи€џ‚/D6џ‚\6лAn›нП € є/јRжсШёRќ/јRђ/јBхњ/Ш `sџ|Ёђј|‘рљ/јЂныШљТьѓќЏ§Жђpu}Й‡ў˜ˆ—УјўувНV(Kѓ+Ё0ћКАŽ› /–н ‘к]Н п%зN; ФT†ъœuз+‰д‘>Ќ•mњKёeŠGпŸ­ ˆ‘mЩэї~f‰šSЛэ(‹_ 'пџ”Ј C&eбпѓ{tёг v€m…юVЄ-pёрЧP/ТНёъ—ѓЎ(џ61ПЋБWЭЋ„њP>ЭђV'Ю8Иt–Жа2wŽˆ С… ‰чдsіђj'ђ™B1‘ Хџ№-з_У ЮwЗsoV+Е9нzˆiˆ ‰Ш`/qЦІш|%їг |ЫJbБZXG9‹sMЃQ)щMwƒ>ћкO(ѕ"J^mФаy#:GїЎƒќNпШvH5 Хющ…ШyїŠД9iBRFАY­`А ЏК§nц<ŽЇJГ@–Aшcь]k­1я№]гёPшu ѓЪќ™=МЕпїvкЩ DЛ~цo”4Р6Р8XWŸK•[.*Р‚џІžЩз…ЙšнЛ—.jk†єЋЃч­†Sˆ№MмМЌЖЪж§Єю‡2y˜Mъ…)CЙЮЋГ8Jэ§Эєk[\yТCt‚ФKпЊG6 пЈб›Э№Ѓ[МД>КmНЙƒKюр§+Fя-ЛщŽuюШF2Џ4gє/IТyвќѓЇ\К„ћžYCSŸШYТ _WЃtъLTd?71?Ќ ЕщuХ…ž1kзЯQX!™ЏБ~бЖA сНУІЗО#Uа€f(Ÿ(~b#эбŠKОj`ЪЗŘXж<ІJ>u’ Ъe$йЌЧ|Uйg&…ˆ;р]-"3f•Б=ќ5нpќ=ћKДКлw!X'лкъŽœСуeo­јЬ”‹џ"лq›VU№"Fі–E  •й /‡R Eлaк;AЃАх_;\ ѓ‰ ЏІуfЯі;yЇњ!Фm2Ж% јWŒШ›&UАЋsŽч‰ЦƒЈ’}cф†ЏПФмbŠx.БˆŽ  рс =рˆЗ ЦZaešŒ›(ОZ'}зй ‚ЬRpЖш:] —G/НЬт$PэДИ”БЖ9‰Œ)r#Ъ“^CТХšdёѕ1MеhУKйv"ХЄђJУ м@ьмЯEё{%иcК‚)ћЦLСЋрЫЂMј§оFP`е­pzМ^ЕlЇI„BЭфХЩ-/іTь„›хdŠ<ŽЃ€Ъ—i*˜кBOIмИЫO›Ђ 6Ѕi`ыЉјhЩхњW ЇNp>WЪ<ЎМНPJœЛЉ„j˜–?ўNxрЧ""гїаэ8ОќщД“•fJ5fK\H№ХвB9&лІoћЃEŠощдћ‰\М/„˜Х­zМysB‰ИиIŒБ•'˜и2v˜`NJ†ЭY"Єў нЬ•}&юч.џjšєЋЛ žCЏŽx^Ÿ —ГБŠє1ЦЄ …бГCfy-‹с„гO)yqY5QTдsэз&ЕЭЧгьiЃЫЫšѓИh[f НБ‰srWЧ˜‰ХFкSЫМJѕ ДћжCЗƒŽн)љЭNи 3!22O=. `ълљ№TZqб~РЖЫ:"YуГgVѓž‰lО\ЩаіˆjYюRњЌЁ‘ъџњ\_AчTМsazPв|jяЧЧСщ6Hћ•ѓЪ$‰ЪAАgЪ=И|epюP/2вКУ… že6Ўr™p гУ'l(Л2p4љK3yx\™B йquŸЌƒкЕ&ЯќВ|хОБ_Тюёњ€ъѓPа.cб`Ј^ЛвЈt„vfj§r˜мзбѓэЙа“є‡О…ЯГ,…%O=АOj6й’ ЕА:SR62ќЌѕш zьОk[CrГ%Чс)ћШИ’Ез1ус’ИšФЮдvэЋин[Jfы‘—н*WK~:в1k™sБŒуGŒKЇНгъоN]y5Ўфј›Бќ“lњ_Д‰ёљ:5У$й<№аМnє9ƒЏєОшЦжкBMЏэЄAПzЛ9кBeFћХ]фsл ]Jp58ЮjюсжB,лu/aGgAš›'ƒOХЃc;АqЯдЏIŒK›?цa,Ѓ:OT&*ђ№Tд иОхKЖ•“ЏŠš”Ђ~З4sПмЮЪR(/МAŒ4NŒЭп.­ИЖdhЙX(7ыMЈFз~ >2`0И-В=јА q€юƒиB ќІk*ыД-R|F|wwƒWšх0ЦzurП+]BЯ^FДЪ-Ў/4ХeѕЋ§y•ПnДaЩЊяЦVvО н зыM'KЫsЊёkиbЦФ (]"(Эю-Ўћ‚KУз?<роjь`D<+ЉдчXЃXŽevі дBЗx$GЛi<и)o’;…›XЏі BуЦУС­њzY~+ђTмz•чбЊ?!Ђ 9Ÿ5/EќО–ћIїvюеs\6б7M–|KyЏэП+#0Gг€v!ћмїSл}]ЌЫ3cœяФѕЊŠ_ЋъTl‡г }‰9_N gb‘a(gdPO_2*Жql`œзZ…:ПђъШ1H"Hrда›ѕa|2ВЁ8AїйЪАцgЪŠїЦ){%ЛЃе€ЬЖœщ„ 'Bч/ВsъцЊƒ K5p•СиL‡AХhƒžЁPl“*щ-€L"S6•EёЉ§y) $EgyQ˜bЮjч№}у­>Y'›№MЇwг.ІўГTV~‹ЪqЄОђ6UшЧŒеBX6YаиpЂŠ™СTˆЫћ”NŠ[+сZwИНe›цTћЄyAzе„П QvRXŒїћ­зKœ>љ'xЇ tБ§рeЮ]ї{ј _ЅZѓGG gД'ŠЕRГŸW)ј+їФGkuUнй)e­я'—qг+ї“ЇTХІуцГ–VRђБч;ІлыNFЕMзю™НПєЊђ~ўІ›с§sЕ%%!|>xиuUГжт'едж˜I1 ™Оеdї7ZхЫž)$ Ќо4nm№–іЇž{qMilъlrЪсТЭŽ+|ЇPsЙ4M]ЊZ1GНҘЪr|•“ЩїзŒSEDN)ЦяыТk–іёЅђcQЈЭZˆ;?6ђ)ˆвоžiЇЙ›ЎMИ6Џы•ЦO”EіО‹(M‘Я _yЪZuœ9wЪЎ=уиnєгc"~d*xj$gтА™6~gэaшH1ЖUЯy_™в|цУpиˆEˆмФˆ%fдeлMћ5љ[,Uє/РrZŒуФЗЊ7ЪИ‚їnЅV'2Лщ">(~P†ЯjФLŸЦvЅ€EYfдyЂўp+v›42pђ^ю№HpЕІЏ &љœЕћжЭ‹>Žћqaыx>|СlтзвbŒЏщ“Ц:f~ <"лtуwlьFњ'ЙШ’nхCФы.qvžЦg>y~г‰TТ 9Z!LП}Bѕaнэ…СšЕyЅ[<ї ЁeƒЃ68Єh‰v“<_/б9 Ч—нХzŽF<‹ъ у€Z<ћEрrYrsH_ЏjЎ‰УFХA„~>Rcл•XюFйшR—JљБ'ЫіВiЕ№У4 "lpsʘXƒ.к[Ч 9#Њмq)!šžРТ2„rwјCњFщ8(IгB”ьP> Cz+˜š-o1gyАbЏCЭЎццЛЖ8SEЧCO—qxыsГw.Ы`А}ЧBиУ/лsMшъ‰гRtУ*'І{ ЌWˆUхSšƒ=б3Зд9аSћNб$u•2J@ГКвЉJРч|–jzЈРз’+kяА!Й†oг<Јчљмм•>3СЇп2Ш1Т“пЇх‰/Х`yз„ЅвfŒ x9Œ“}ЏУФџИŽ“R™bїЉЊ сIЂAД.EП(4+`X 3>BJЋ]ЅЇЖэђЛ@и2Ц><МЂ<^:о№”№+95n{ыЊŽzkўiв]cѕMPosз–`КzSњАj!_њ5 ЇmEљ@•fO­ЃKкЋ6ŠўЫИ“0БЙй…йM_Шє&љж’`ыŠS$ђbFјWƒOш”ЮfbyНVžњAЬШуіб ЕŠCТ%QѓИЬ„dЃ&g:~™Ђ’UЁXGZ2Ё^ы!"прiьŸзtŽ_Гћ<эHУ.t|‹`o^hBF€Ёя­н„2ж~эја §l( К"јBЏ*B?э•у Ч1saQbPъЁЊ р9HUN ёыНхКпJѓYПюŒ/œ{№4L–QƒEh‹Бн„V њiїу\Šsы›‹@“CУFн!„окЋ–QLУ*ЂBК%ШтѕљV/šz!ћ…jNй‚”Xcы†jZ0Н YlЃЕЌА№ JтцўЅ_*ŸЖЧKНВkЋэвчр˜вЃo1‡шъ-Ќ)_fЏЋWхЄ њ ‹Sј4Z™йUt#PЂеGЩ ББш3ю№мŽ)Wй бЖzB5”ЯЧр­Є[yb•Цъ№+Iоп`№tBсЙ яT авЁrвЮќt%Јс*@Ÿ3S_ЬХ(knА•”FЂи'ВЎ6ž„нЭЃ:ЮŽї^пђЎаzыф…9aTЖMШ<‡eзиIщѕin01МС*c3o`5}DУw•PщCЎ] €{аpРG PNyи“x—п,>zЅшyЩ xюЉŸІ1›ѓn}Їѕ†mp‡Цk ]цmy žС&†ЃдрЯ›ЂЬє€-ЛЗTБп“ъКu?)…Эщш]–Ћѓr oЗЧ{~пјвЬ‚HбхLхЁDЖѓ b]fсZ*™ŸJQ ‹mпф‹цІсlk]—ѓМ.#˜8Эє5Pфfщfq­€3fjЦЯlЭ/ьн*Ž'ьvHh•е4мˆ5 PЏ2ОрHsпoxк"ЈskІЈPгlQџˆE‚љЉvzR,љёГсЋЖwYІC=FЈцы rЩхФ+ШЩ6_L(Й6yй`вz<ЫА кр4Т=sƒЅХЬыKbЂИ:ў.№ЈS,^l[3уШѓэjЇ5bђЫЛDxЫ‡Ьn­ŸЌй;o žйDвкM-\п4Н7ЧH#ф-ЈрM$KєЏї˜ѕЅ 2‘ж‹\k6>":vфo`е'qФ,Ћ*-?…ЮјчЇ€лe#тмїD<*kаЪАЖрQНyu)‚UUЯѕмїŽю>а’‚DЊаётŽщрвacl%џЈ_…‹чLaозез`”Ж7ЦўyлёEjF; ПdПЬЯЕъ1єq7 ‹ХяЏШOFЈ'щ|dЖb`п‰bЪЦŒ^П .Ь РпЈЮќ% йѕ–6opб№В)sNы”-џжr[NMЏјVќ5Ќџз>‘cIrJѓ‡3†Ѓт.›ч`56ˆS‰gє9І}tCX№+№Gо‡ЇхуЊ&3ЎА™ш`Љьъ ŸнX1ŠA-jŒЉfф -СИтаЯїђі“КoШ щы~н9ЪFR0ѕщ:>ŒГ№eЕЄєфСАI^™ еEe7п˜;m–yŠX8gю\ •Ъ жƒj…TЏк $iєbрЉQT,qЕТ$ŽЏce‰јYoVуш8ЌФ"ЈГ )cV$Ej/žЗ–L"ПРЫёƒяЄ]RЖ~"<Ју–Яj*ZbMd}2еЮžiDћloѓы+pЭ€цВДѓ5ЧБ25РЊЈ9л1EЂМŽхj&zcцЯнybњљ9UЌеноMкY_ˆЏ•_ \_BfQЕЅАщЂ в? ЦE” „%ўlђЭмŽ•ш@аrвЋпK2сЁŠ}t•ё\кЂОЃ']Ж;+ЬщзюqдЦRдojШь$SŒHПу–Œ:sўШ”суPlC<МЬrWэBЉтюТЂооуq†zЉИъ3~P4 `Ю<œa§xќВј\>#-ђs)7dЎЬЏ§‰пGОwќю “ЦyеЎmаЃ8™њtЅ3Ы—•Z„хЈ2ЛiВ$Ÿ@гъ8ш"]Г‚:˜'…ˆЬоьр5х/~+Mt+MбьЌєž0§#0КAЇ ЂQ#[†8І†xtђеˆцЮЮz+усДN н7иЄ=esЧ\`ИIт‚BYœЄ‚šu"ьЩт ­(ЧŠВКЎ№”Н|6н›?‘ 7ƒмљќ!I…ъшVKз…ш—SŠ^MFŽ8ѕдbт“aјu<‰r$ИˆќнA“І€@Ÿh HЫEЬ і€ъйЗюч1‹^u‹ &ТЕ“бљ[S”ЙёЈiк‡aM“RJyё#7ХЩюqЉўЋnŠ.8юпž’= oef=.ІШч—ё)”"žPN"Ž&’*P#к FУњоƒxа“.”ЧмПMГЉ|m0РzЮкує)гсFZ№fЛ pўёY™J WC`Мg Ф|o„"уњ]жјaППІRžю@Vz1u#ЭМV•b Š5ўYЊ'fхЪ0Y4еT љbЃ_+O)GˆXЙ|њБdKuЌOЅ_T/VУЩЋЃtFяŽ:4ЄH<ž3jЏщt2KjG7ВЇ"k 5–Њ1K? …™]K+Šzк3”цvђгТžЭВfvъН9ГŸљгжГюs€Е}/гЩH№(O"›ŽgЦseСZoj*пчёT›ее@OyдR„ЪНСpѓqa€€,}QZneт™СyНшM oЖVГпщј}ђВLdMЧЩ•\ њ„#@іuXиЯ Qžњюwlь,#0ŸJУrя= яBОFюнј8žм §ЂЫW*Ÿ= vеТˆуюЇ…4йr9М*bZЋЮ5юR,K2КЃ*rsы@цзi<@a#xШЖоА˜aТtY95я›<&БƒЌ’ŠЩx‰t<ˆ37fЧ7&‰ =ІBUr„цfљ˜‘№g­{д7ЇMПK•{ЛX8Г{эД­ВPњyїЦOфчSdвui’7› ]ŒмЁіЋ0~ыš6Чи+ЙЉsгЪJЏХtXЩ=ыњKEјbЅЅІБHЏђЏъBeг0аbнžШ#mТшEagŠЅДвЛ коЁQ1|Бюi$сжпEз@8ЭТv5ЕЕќ8Ж_i }"ё€%т­:Pu›ЃŠљИAж0RІYЬ]Тo|fЭ@_МИ:=6/‰RЯФ:B–ŠZцЁбH§kU7ц—ЬV v"›увAnкlVэ~ўhhљіOdЗB"2S§<оаЄЉE.зŒgЄ&В ДiЗЖ*MБ‹CтЧcKе i7ѕж)ЛVНВ&ьыrк\œчхwљТ)HЪШжЄ^ЯG!ŽпоP&ї+%6j.–`фТфK—{˜^ˆ•™ЋђЁЅbј‰ЮaŠœЕxмЈЕЄРX wу—oˆ ’q6ž0œ№ф…Ldїvхs\šFVЃ–DН0vЯ”ЫВYt[оВп”q“Ю>WZяGБ?ЏŽ9ЂvЭ'ЮБ >Сtyп`WЅИїа цф-0ЦсНпc%dљ §Н5сYžemйдk5ЪQЙHA]a’Й™!|ЦхyM­Ф Ÿ8а7zA­Mї`бЭё Ѕ%89ИЛ:ЭtїDериnLN ќ-ё[Ё…БШ›]љК›+|Nо›…В|U*йшEŠ=gŠ№єU!єЫј6Ѓ•т=ЉYЏa, ЧR‡ћЬДщ>cЬ-51œёЗДT@цmgWЁ‚№ЦС‘їQЅN^J›e§Џœ9P§цwтЎw[іа іо‹о8 -YpПŸѕ#ДYМ; aъQ[ЇЏлpЋћїcй%ээЧиCPЬ'ˆ.іŠЬД*0iШЁлšЯяqьk’(<#рŽчŸќˆ]‚“аэ ]љЯБUм…”cанiч„5lWнбКёi*јЫ­%˜\PEА№'y‰yяжя+с‚ ЅKќЌ(СKPЏX~і'%Ž9ч:difG@ѕеzeœ-ѕ ЏQ.B—$bRЂ•uzs6П%m<ЛзѕЏ§с˜|†z'b`OкШ•ЫО]ёэ2КЬєіїпч=Кj­ЮРC“Єл}ѓiВg6LjUAыщpл5dдxг%і"…Ы3їяbрVјUіяеjиҘVi‰)3ИггЁБ%КO<iѕЌ>уWШњх+E™ОјЂ:<еЕжкhšb4Э2pА ЎКQ+мV;Ј'OyAЫЂ?ngvpЩ†гКГ-а8ЇJХ#–ЌЫŸt rЗГJ'ORoФ5фйР~ZZˆЦ­`Ќx,*ђZТ|В6&Љ ы%TeЫЄСмЙЗАь‰ьВe™.@z“Щb7г|T{™ˆ ЖE" <4w6 ‡|пW 9L@ќxfЊэ{Š˜Ђ‚‡Žžш")ѓдˆ™=V-qн?юL­ ?ѓP-Œ[Tš*&щ AСH-€>uKPZ+оR“P$ ‹‡^†e(pх>ьЈК2;Ш%Ш{…”<v&ЁЫЦкBрЕшƒ/šяppРЋ@P%dr Mд WзЃ”ьЇCо$Њ‰™?$dЧъyd—Qb€цЕ‚YQ“sАNнЊіMВи\#й’I'фэf3|tЧ` њёЖ~ &вP"R.)-Муў f9N|@-мZ™Џ>є)f'хў[„Іды$9ўЛ+žгР˜}”TЄ*"МЎМmіз•П–;:a"вJЎ+їПZ~^С+ъЎЈЌ#цЂ2:KІo.’M_џЮrWЈЦЎ:Aзп2$ь(Џmо€ГеrPЇМЈ(‘–‘‘oЋDмІЮpMДП;n 2 ЪћЫЧeјЪkќ.V\CхoJдlф‹šŸрЂLs@ТИ†]m[ЋЛЃw(‡Ї›ЦŽŒwъхЄ+ ЏЛјJс™RА*5GЪЧД*вн6МpХ‡ž—‡Kл73ПЊ‚œИŠћхЪЕЪD˜l\˜СZЩЬБt)Cњ‚€съљБў]tgY 9LиRmжЭ&AfwЊо   шН/Шым‚ОUAЫXТЄлFGфЄh Щ)Dм3)~kі$ЏБJ§ђgЏЋ ,рћo"‘eЧћиЏ‡IТO§ЮЬ„ѓЎЊЇЌu )TМв$(Œc —UœЗЮZ9ЋТl9уYШМSДxУГГwч}-gмIQ0зС§ѕZО#к(nn+yэ§’„$_"@Ў“‹ц3uf-тBёzOZАе—йqЉ-vсc“'іˆКD2zЯЙŠV=ѕ.ИеЖвDdЕN} fhАV"ўm9:Шо&тЫfƒЇаa+‹ITtЙ Hь ƒ&/пБ*зtљ>hHЖЫ?Ј‹SЭ.№Wёt]–#ШL#sн3‹f$кБ”gКЫK†t ќ>uМЊNB§zoЁ%Rў ЮzY DђчѕfkвeЭЈxўВq сШьJ;T›ђšКzЯ)!*н‡Шъшyз4ёѕ•-l†ЪЅєY;тдO5i3w~9И>ТњЉњ;ј‹Е­§ƒ‹ЈјыцЋеаНŒ2нпВ} ыMВФжntћєђn<щ#tъGЙФёEя м†фгЁsшЅсО!@KnƒŽЗб|ђŒžW@Ы {I—Zбsv“oGff?Zl‘ѓЏz\ 2h>вГ­Ј_w/VXвddTјє>֘”kя>оЧqpоd{pk`Д}ДˆЏYœч$ЗЁ›ъ•!Р*OS‘­@­*кMані–)ђЙem„žЃJоЊkпве2g›чєј‰‹‘œ§\=69л ДкЬо˜гЬЃПжх"їшkуEЃЎF™їЮц{3ћэP[ГJ4^рLЖŸ$\кkл€Р@yѕЁŸ@b$› >бј`4(•гэk‰Х&Я†нa ŽF|[ЛЦс­+Й Лр!’ЬzI5УVlљpКы§PшэŒлPБ б и#флМя­чК)‰Ќs]}Иq);mgШЈЉКž=ќ†M3ХЕ4€л ypiŸrU*[›Я‡ІIызЌ],пŽ_"8ї~{и29Mхз‰й)€чш9їŽЩпсZўи%4ыAАB_мƒhгˆ7h(\€ Оь*+;)C:'ŠORжеЏ]ИKЯ:ящCбйVЫ/ръє\6”•с qтЮЪѕ?ђ•‘?Щ'4h ћ@ЃneŒIS.ў{ [ы™ТVbŽL ?(o ƒšК0Шд­л剑[Ѓo*„,`Цз ЗIђЙ  ьrkSFЁeё}8кшsх.Ћ:Фњїx† 6PCЂз^Х/ЉZ’3Ѓc]ъФх‚ќkѕ-'J-ф#йЭ~|TО2 ЉчЈl­3Ђs ­PVч#kХіF№›cёШитšЇЈRїŠЪмо<ХЗG}^pYИˆ|ЈGх%rОmВg…#ОX{b‡пp+B"=m%З9„н4)ЄЩLEyПtпьZTыЏ‹(„Ѕ~в‡ЯQr8gЗoѓn(СjXЧ0­ §%эBux‰‘щџP?ТƒZƒ|RИvбЇˆs\Ы“Mгў(ks‰2вЩ=U@; ЉЅп/рЙL-{[‰Vр"ˆтЋэуv Д“4?d:зпK\т@šбюлЭ\аиЕ‘•pПIЫc/?‰TЦюfˆ }х%bqќе›3h§ЩHЋ~ћuttŽЧИКŽЈкКcqДI=Ф~Б=ъp;#рŽtњ}ъ:жdхMт'k}~˜уШМ&ІНєЬŽАe&дЃД’тsWўŸЂЦ‡E%xY_oeЩ0xOћрJ{5Єk.еSэЎпLEЌ=ъA›Гд7uѕ +є[”ЊЪЇO[“ŠГЃъqг*˜њИ‘туъž’э"ˆœH)HуXпœ/3&МMV$’--ЪщblSeэШј–Ъьд8Ѕ”ЯдX6 эQЭ9#еЅўW‡л_4оъ­к;‡Ž\Й~КаТЯdФ)ы ЬУбАК|tУ{\FфеЖЧ&эe&hЫ0ј„ Ў)и›kѕzэ‹ћЮЩс'0W‡"ЌЄ$7ПфЕхfMr*8Їl\8гRфc1KUHК Ќ пЙQan›:ˆŠюЯ–xСЧ<ŽЦЕІjEz„8Њвў:љyл–c”њгзэmsїзЫ•XХQ~‡KJŸ8alZ6П~ђRrйоo›ю`r/rЉšsьѕы‹ь>ЭBn‡-‹hH‹TнЈtPКЯJр*‡QAU™сЩє> endobj 201 0 obj << /Length1 1412 /Length2 6209 /Length3 0 /Length 7173 /Filter /FlateDecode >> stream xкvTjз.нвР!5tˆв!’00CЬCƒЄŠ4H#]’вЄ4 Ђ4 џЈчœя?пНkнЛf­™wї~о§ьw MGŸ_оa QFР‘ќB iРC-=1$" 0Єф–hqs‡!рвџЫўа FЂuŠ`$кM Ј{8„DBтвBв @’њлс& P{ТlZuтN|ˆpёqƒйC‘ш*м6<!)) ОпсygˆЬ h‘Pˆ3КЂ и  АA>џJС-E"]ЄНММРЮю7ћ<|/ аƒИCмџœ,амВEР|ўуў{И‚jzЊ*š МПџcRP@xќј…@~a1šЋ Q€њ№я,џрџћo­іWo џdTƒл!R  яюožq‚ћЏuсќЛТ#šЧїhoй П„ўПЩџ;фџЦљ_YўДџя~”=œœ~[Й™џ+ицфѓ—Эb$z#ДшН€џЗЋ1фЯkAlaЮџmUC‚б›!ЗwњчaюЪ0oˆ­ i§C Пg€NяƒCtюА_Я =6айаЛfуˆ~Jмб“њm‚ Wщп%•р6л_;',&ЛЙ}ˆаƒGKb?!єrкBМѓ (G б!4М€ТшзГЅћЙR\ƒјgщ$ДсKѓрЂ)рыЬizv<$?3С]ЪоdS'Ї)ГЧnXеуx‰ОF‹ј™Ў Пʘі].7vяdИУ`JЯŒ}B9<СщЇАЌN7ыW\Ад7чн$SРš}‹/e‰Ÿ\`[8НІїо№ОкsxО]шSN Œ‹ЉъSBuIЕ•Л6Me‹е *dЕˆ#„yЛнNaж\o†M ў$Ћ`ЏlА HЋзћR№UРїXgСчйЙђ‹АWЅ"г‹єЛўEЮо™Оi†z3яшу e$=ыіs+цV[Р6юЧMЯКђW:”ђЪ'ч=@T1aI>ЮЦЧЃЃЫQOпCќБQŠZ„6–П•tѓ{АTшE1Ѓ]Gхœ~О>ЖЫ'“3 ЈЈ6ќ‰ђ^hю†И?ƒіrм,ГИИc2ЂІдхчЋ*‹ЃYЃО/Œ’ЄQФ‰Gьutьб%§ФФZ хКwnLтVСЁ`ЬзUИК™ˆРЭЬК]х~Л{QЩ[ѕ4­Œ[ H`,ёђЉНЉЗWjсT|€М`U< эŠ‘ЬSё`? *zoэтмоY;_iиуфlІ8*4cœ"Чk|~ѕXЊќЈЧД#vТhHžnFQЂuuѕЎЈ%>TуŒ л˜A2Ц 7іЉuIžРЃсCqвД‘€%JЩ9*%џ7R“ьOїfќр'ёўћЎOjh;ю—5Щы2ž?ŽR4‰ОЛv>Њ™л,Єprў œя]ГWŸцЩ™`ž4A?S"#DцшСеeЫНžA {‹ПЗWУъїљуа6_Йƒ‡ŠXцЕ ТОuѓ(•дФбh"ыОто5†…єаДЮа=AсxЫiќEхc+Œ +ЧšћЧJ_~фY{”/Њз=єф оЄ2їден?Уи!(%е;"SўAц˜ѕ ЃИйкј##DёС’хЗ)ћR2ŸlћJьќБЈ‡L1цЕЁ"Qdš#'МkјsМ\иCm*ЗD Yгљ ЏcJ;ZЛ%ЃIœyчuЗ:OћVкђŠoі?мыž]]Ё\Q{PЙ*yИНjв•ykЮ2рNƒ…дsў}hзpНчч‚§пЈF‡f^юzЕmтЗz ю;'rœЁ4ѕюаibЉ'‚Љt|ЭЃZ~JЃxgn1lш$СуQE?ayў#bм#ўVeфў S4Pњт&Ќ•B1Ѕчьмпјциѕ•^ХПЪуUМУјьQ‰љЈ=XUn1О•бЪ>п§а§тe•™ГЪЦвP ХЄ3Ф%оЈO ?А.ƒžьэ!{Žјр­рэкшхыSІŒ4ч6м||щСНМўAчу{…–ŠЁ< вэЭј­pŸ–ˆPgn Е= –1-rлќwPŽEУ~g­K•хЊфЂФF‘“@ьEэЁ=4/iKЅу,™ќm‹Ьѕ4J~џ–+~‡”"с(RннxNЂчшв7п32џеФH'fMj§п(YрТ>Пы‰ъk‚Ьиš6ќ"Tј5Ы&TЉлуюvья›sO’х˜.в+o}‹,рWzЭLsŽчVбŽЂФЦ3я02q‡Є rOK–!~hєиљШЮbХ‚†#Щ‹Т.w?дЁ.оз›й~gUИ™;ЫћcюOWЯЭ-šЉaнMqE–2 /k=­™нXF]яwРjё#ЩŒБBР[˜Yёг`п–Е ЩЋŠт\3wипў`ŽГМчвдТ ^І ŒЦЦНx‚р?дЮ8)зxш–nœ+ˆћмVЅЩmc$8Ў=tdEbЄцђ‰еauRD0=kRQНFЛп”I0Ty/_]­—SЌъ‚pvƒ9—жr˜T7ц’—r™ФŸчЁЩX мf$–уx@Q_‰q [VиChk+.Л0ФК1œзlАМvnЎmєеzNSћь„NМ€ѓИ$Ы;ь~шЫ#‰$ОFOЪ"ЈW]‚ іЇ0_Т%šГ4'iSжНђ>Z‹z‡ЪMejƒх=ђ8}C -”фѕO2Uсёcд#ЏИ‹ђЇвЗ?В1^7‰Н$/4c+fqC:_ЈГеFŒМ\8y9#‘ЉУОѓКkвmєЁкл&Rr› CЪЧ№ŸCѕŠ”ю#˜д­dвуc5БмхЗ{64[k vcZћgЪъг›}XИnzџZВОЊ {jFв{‚ пV0ШЦ8Мѓіn]P›—’юЎі‹і%Psщ~rюџ~ЫХ'ьVOb'sЅх‰e~YУN%mјЯђžWAъЄkyr ;\яOю<Щ чG vЦ;<№5cѓЪЗZЃJ1{ТЪ9—P9~„ ЕмУ•к?epCпЃЏ#x…B(ея~эсб<šKaЉ(lLОї„‚‹6BЄ‡fzGэЖt˜ЈџPw ЬўxиХћŽЃz“†Гт@'Лй{– rr fu6шi(qцKвьNbяЗѕ!ОcЯЂЌэЉЃГ œ\iYЭрЛю_и):*§n}гŒух4™ѕК<Ё8OЁQї”ЦЊh’ Щ#;Tњ{%š7Ж0VњHхEИUgИ™ЗjОL"$Ж_tЁЙFŠ0ˆ‘нОœ‡ЖbXЊіі™ОЁhАN-g™'AkГ`fy8к{Юy*G|ПЖj”LЫѕI‘‘PМяІйПЁwйзŠЯЩ<6Ьzi#8љM|№‡гОЦuŒызŸsуj}'LUЫ Ю/ј_ЫœmяХH™мYМФ‹œRЕžy]FJ Ё/фр8Џq}Щdˆ_wОžуМјI|œ+ђbeудяљ§Іnqr™ЎT)ЯыжIТTд3L#‡ Š;пћ_Њ}HТ*ќH$($?JСs~/њЛk4Г3%БЫЂ€нЃЕƒЗ6ї[ ЙћŒMO5хКЖMггa&ŸЖНпHЌЖєкнеxмРаЂ Ям•ШЦ{iГ-ынi §8$(r[шƒLžj>А|ŸєCyЎsII‚4Ъpе(‘Њ=IЇ…ШР”woЯBPeсгЂQ“Ћ­з_н6Узпжщ~|ё€о“/$[GYљОЯ XWЁт?AЂѕqЙщбЩŠ—ьМ`збЌР]ёз2#ЎЛžmОЌE6'(ЊUGЂ гr›XеEjЛ мѕњлŽ’c—‹,*&е8ЪqјјюёгXžОкnТ љКс“nx s&ФЈyržЫˆќ5yЭ”A›*ˆИosHyйд7уъr‘ЛХХ"Ш3Гг1ЛчЊvTО?Z5НTBд.ŠoЦ`t‚xн…ЎР‹OpyžB'НщьŠ+ЫѕХЫ ъЪЩŽЧ‚‹Ж#ВШЈHдwХ‚WТЎн§ŠX‹љm]и}впЩо“ш”Уь,k—q}ЊЛє-k>˜з{Eѓu„‘цЕЎипъ8d™М^!ВщйаeГy5КаŠЧM]˜Z?їщf ЉЕцОl*ЯІo2ё‚ЯэолдMёъ&HўUќ]цwБ#Ж„šSaђй€7О6З[…фЮžL/гeТ#,mзјЬуOi…€rwГќ ш–IЊ›tЭг&кyOф Ÿ:7ŠМіџaябœuе„t9i6}с3БЂ6$ТэЁ шйH[7KКЄyЖА›{пвЊyЫn}I С~[яŸЬ‹2+ФЧЛеSNЪEє@їћn$…Kџ.WљЬEЋg,vaпъ$oIзУпŸpƒ§pU!Ÿaыъх• X yЅ[ПXih>ныРU$ћфгЎ|QcŸ-Ш^Џфcчй‹ЪfhЌcтЏј:O ~0N+SАŒ~}Рƒœ…AVƒЃЂfVfћц„з7^›§‡Lь^Pmя7Ь~šfRВб|нњН… X_Mg*HеЏИБeњїОЊзDOюFцП.W3Ік?іўЄf/‘-=ЬDPк=Г]6А ;ВŸІСЗˆcќВSHœ,Лр!ŒЄ№3< хvxЩфн–(GNКoо5 эQ/&–RпЉKЌЂсУА­ЏЈMt›fЉФю"ŒЂzКЄŸCзoS7nзvЋ9ˆф<Љt— yllК‘Й&ЫџС.M7юЦp Цxл|t‡Ьk–зЮ@ОhЙUSŠrсzЁ€`vrБ(T‡C'‘wЭ АПрФФmц1ЄLЌЛЬСEЖ{B€pzоиИ@ОЏЊŸBЧ=bн‹ЌЁ—& _Фщ}цMИрID…1\Ї™$š:K]>jїЭљц<1еzљѓ;Iз”ОМщЧДЎВњ‚эpY >Яu€м[нyN2xo лgёИ‚BG-‚рŠ0“\§†‚І3 ўNЧчZr\F>‘РЇ6:ВgNё–пє ™pQыП=п&ЩЮѕ[­qиаMlšv‚з‘[w~ЖЊV!Gvn9aійКсНЇo<їm&‡фfЉёSѕпІVЅaTЭhпu‡њащNYЇlчФ|­PіzŸ Й4йhЯ3GдЧэ.ь•љD“=+ˆ•кq:G~p(ўh`™–Њ$ZOћV<ёFžя“Š'%šГЗsв -ыЌЬ2ќ6ЕФІ:јїЇЄЅЋѓ“:ъіљД.ЧWыiењЙ\ŽrшŠК,“х ;C#Љ“йЫ0>аq;уuпГ:>ль%хєўpЌo,žf“йmD\?“вЌ-/SЋдJјЋZяё“œžYЎr†+ЈŸvмJF‡WEЭЯoъЗН˜щžт|щ@5Ћ{ћИЊvrтM)Я"ЭЭ,&(ОVЙКžЗхГ.ЈШ+НСоьжœвџPЬџ”Бкlѕ‘ДмХаCб;2ШIВ?uK†rrО1њёBТRЈp˜пщЦ№VƒчЊ;КoыaЁ‰2$ЅICе~в~юВДрнUр ірЪ6‚Ц…j 6Ž†O­={‘†Щb№~№з ™WбУž†ZЃ[~и$vућ{Њ/БхГOыRКЧ9ЅJПХ„еwІGмГСgzЯ№- wvш`H&НщSбaЪz_—(юn&@пЧ}кєNщ–ы@ђШ‡{гь‡В’}"-K˜oеB8%њA\nг ‘з#u^е^Y›Э.ЁnЅнљš,іо§ХD<; љ3‘r~GЎœ”аж$cЉЕQЧ’Ё^/Фф=юќшЇтј”ЕkЕ•Ё iO O@Д3 у:ё<§XДЁoмc5DЬNnmе|SддЪYяcs…-јОЕх] ьxEgёц2”Н]ДхэТћ=i  ƒнPК8‘у2п0ћЅы+‰BљЃ3 ПnЉЏs]ї№О/dшо NЂ§pмЎЦ~џnТ’‰{1>чн(йѓЄѕШЗп’jОј}ш,pйŒƒo˜zпъљ6ўTHMѕffL n”з|dш˜yРЊ@'х)Пѕ$Щ щ™ X^wя№е6щ†ѕлySсlпЛ‰gз†РЮ偘|ЊŽе.gG›”L0ЊЎ.ъжdrpUT\]ЪЦsVrNпФHЁfврпk{AэVэzŽoэHЊ МŸхЏУ}CмЧЉхд’[§“ў†еИl‹г7ђFКивАyVV›J•љт;Зє,шЖЙь UВ2Ўлˆ’ФZОф—,ѕ–uЦ|ZlйсePЂ]Ъ ўњZьXп8/xSЉГKBpœіjЅИQ>МЏОЙEdЦў~{GIїg№UjСйjVЁйƒю~фГGЧ­G.C[ТРћИ/ЪžEЅ,о™мРˆЕeЮHі&TњќўŒZ}я~`BџsЯtвp{љ2ЕД4[ъЛ7›Ќ Н­3|Bш'ЛчRм0Ўдdєj§ДюнѓЅ<#Ss]LпhКьWВ5~ŽŽ„xЏ ŸЖяЖКЬ’жжЩ–,pCтГwё.r,;Йзys ЦЋЏЅѕdЂњaŒ>0Чњ|Ь‰iМШbxљз.7qўЧЙc‚Ўy3ѕ\ˆЪvх)=ƒнЌб)РA^­зKядЮъізэКЕэ)фœ„EQAУmы.|oOЂ4МВЉаљS|Ї@ŽцЯЂШ† Ц/Ё>CИ:OBSЧ€”§} 1œ,ŠP?н4YlќМЬz‰ЎT;-ійbo5Ѓ|Ј\a/ђYEYdˆѓшˆРнБђy *[” Із1Ж7ЯСб>‚>Чq=Пх4‡К4Т–лїС|tаŽКјh’ы› ƒƒ^ \ЮлbLGo*?JšМžж3ЎК“Н9-ЦФ —sQн§Ќ ЁHмЋyнОдљ!Э/тъ#^UP}й_BРЫX­6ЕѓlRdEйшгpOФR †щ|“{ЂXиl^ю$]ЛУуDh‰ЁЦ“вH…Ю ћТ•кзžЪrг“B/fъoЕl;Ї† ЈR!м­)ї-Й]HЦТ ˆі\Ч“"рцkм8‰§И’SюФЕЪЪдНKРИЩф^З—qУ‹ѕќl#m™К]ыХ€ЉіwXы8Б‚naкK‹DAК””у,уЈsЅ6%\ь‹їЁšt(…(ђgbяmCš Њ< ‡Сi/d|%ЇЦэDCC›\‡УWд›Њ.гЋHŽњžл0ЕF†ЇінюCЬmX•?§ў0ЋЇіАѕ˜ДU§|;mT4ЗFŒ‡`m:Ž/ЬНвћз(Ж1№ЧfюpoФ‘пjіnŽфЇ1lBй@cpР‘їžђHчc§&ЯЉ“aПоЏлJаyНvˆЉЮh`fƒкЪхГ`CCђч ,аНТKП#эйхŸX‰КxєZЉуй(\ ”HљыЩДž9‘dк7]оt‚N№p6cDМ^FбQ4…žбѓS3б[uc‹Kf„)хоLг}ё!Jйr msЎЗл~к9?tt"qб9`ФhД,h L0—ь~1{ЊЁр+КWЪ}{ЛЬ Ѕ*Z+§‘иch‹OHe‹Јм‡aTkŸ,+yŒj$:Lš12mё‹ъќdЦuߘUЋœаE^Cj-#ЮЋяьЇTЫаћЉŸЯ>Ѕ•™ J>дПќђяЭ1AЋп}В™'#HМѕЃЛ­уŠc‘~8ДANRЄ\ѓKmРˆmMf•:[нДDОЫ)ЊФdјMQ›MХ.›zЛетТD/пwэnКяЧ‡u€гfoрџЫ м endstream endobj 202 0 obj << /Type /FontDescriptor /FontName /IRHGLB+CMR5 /Flags 4 /FontBBox [-10 -250 1304 750] /Ascent 694 /CapHeight 680 /Descent -194 /ItalicAngle 0 /StemV 89 /XHeight 431 /CharSet (/one/plus/two) /FontFile 201 0 R >> endobj 203 0 obj << /Length1 1379 /Length2 5945 /Length3 0 /Length 6881 /Filter /FlateDecode >> stream xкWTьЛЇS@ЄQaФшишFКЛ”Ц0 Ц€nAB@B–‘ ƒщ–4шP@тNПКпџоsю=;g{пЇЯѓ{оsф06VqB:Т4‘Д0X$P30•€@т" hGЛУўR-a(o8!їпєj(“ЉCа83$ ыу‹РRr`i9 ЩўeˆDЩд!Оp'€@‰€ySеžXмХЫђзРх€eeЅ…~ЛT<`(8‚@аЎ0\F(Ф`†„ТahьПB№)ИЂбžrЂЂ~~~"o$ЪE‰_рGЛLaо0”/Ь № .Ртћ L„0w…{џ!6C:Ѓ§ ('p‡CaoœƒТ †рrЬtєFž0ФЦњўl ,ў;мŸоПСП!P(вУ‚РТ.gИ; `ЄЉ/‚Ц …„г/CˆЛ7чё…Рн!Ž8ƒп…Cš*&пŸшМЁ(И'к[Фюў ЁшЏ0И&k œд0к›тW}ъp Šы:VєїXнH?DРgg8ТЩљ'OQ мЫІЃўЇNDёЬ†H‚@ iYЬ У@]E7ЧzТ~+СПФИњƒ<‘žgXм†ћЁ№†јТh”,(рП+ў}ЃƒNp(рs#(ў‰ŽУœџИу&‚c6 ёРаЏЯп';Зœwь?цП‡+jЅcЊЎІ/ј№п*UU$ ,‹I‚`АЌ8@wњw”Пёџ…§ЗдџГ6а?uЮH€ьpНћ †яŸœрћs]јџЮ`ˆФёрћ‡іЖ Iїў“џЗЫџЦљ_Qўкџg=š>ююПЕ|ПдџC ё€ЛcџдуXьƒЦm„Зˆџ4Е‚§БФ0'ИЧjuамfЈ \мџn"м[Ž9УбPз?єз pснс˜1вўы™ƒA џасv ъ†{JМq“њ­‚сVщп)5PЄгЏ“”@P(–7xмMЦ-Ї ѓ›зQsррœ‘(Š_ѓ”ˆтЋ_BŠ†њ PИeћ=x\жПюП7УР 3“HЈ|фНњШЖуZ•ы~ТЫƒŠcРeЋЧќТ3ЈW>ЇдЄiќ5йс‹Јя*i}ЏЏЮ}бр;Кѕ‘§<`ГЅє~ы#“—?Яь“MG–_RL3vmЊ<w“ќ†Аљ­•РsЏ@Ы07Тќ]`О— Еq!нБп[-ЬѓwхГЂ'—MVjЄє(ЯЪG…,тmУJЧŽ9Ьœ$hс›dзі04уGпЧЎх ]Вы& Rm%ˆX/‰%žLјЯWš‹ywВpГX3п$<Кіa„'@u-]—i*рYё"ъCЦуЋOЉ`ї5>џeCгcдњЗЛ<Р!9>fQBzИјХVэRŽ‰œН9нEŒЮ7щGo!ЃјЅ‘Лt=QхX ЧŠ#§ЦЛ›‹+# ƒТJдтЅhy-вx…eyї}Й7фЧХFfiW ?™ )П‘mЫZœљД”qX{-я8ž}ф†№Х}тŸe$Ч~Ќ Г žОїєdГF*Ѕ—v­'ЈHЉџ>uЯ2ХšзвЦьƒ–TЏЄкhzђJZku;щї­-FnТZіѓЖŸЭњщjБZйGњЙ‡чЉYбI†Ќ2Ї.OЖФLH‚фжп]] тѓ4K/е‰Щh&дzЪ$й^d.{шGXАИ1{hW\бєš5w~oЭНvИW5˜9Зв,іуўБкшОЯІ=ХEkM4ŸDn‹ЧВЧ­лЇaВВ‹=[]ˆИ<W*ѓФђ~eqy>/2{6ЦкSr›Ј_6јС—СGЅЯJŽЃМfЙ ŸБц‚Р)zu3` Vё"кСaf~јqnmЙќYLєї•ЊgIкBбЋi‡Ѓє„{k…}:—œ}ыŽѓЭk хa$‹yy!!yс^i1ЂС$їxm4Рѓфзћќ\„zѕЊBSЉ‘“J2 ђЕЈ2РЕлє„7й’ю[вК1аЛL ‹FVn˜оeŸ tпwФS mђЏе+`Г'*Џ&€ ёN‚‡Lі3Ѕя>oеh9+пн ‰Л)ЫMиi§nТ kчŽfKD]ЭЇUЬcЮЪzЏOGЏ ќ0 Й ~eЛУ‡ІљТ(ЂСцџаŠ/†+мР№CrЃдЧ`) љЩŽЫaЕn–ТШ]№Ќdщ|Џk ж™ЂЮ›іъG™АЁZЩъN(œV‹[ВпДЋgю~Aшy6ukFЩŽхвљѓ ешjфЌДЩC-ЫЭдЅJDберў8ЗИ“ƒyoбщ0ЮЏ*НSbbЧъ№"ЙŒЈлРc˜фуQзЇл~ыr{+ЯMхЃбUYгЬйэ\’k7шЌЧщћЂ.ЈЮ‘о~хжL,ТјГ›dтЊ{!>Ћм…єј*aКоіk‡Зй#оЯу…eЦБьВ_Ю…Ф™ЁГоkх<ЎМ2ЊзЦ,#жюœSЅ–; i1x€}”У#˜&$byвэ6W?>ЎqИд ѓєи #mЖИVCукœ?VŸзХТэWl[ЃыD*#иi–ЏЁXкy;ібдo™ ›U­™Ьгzo#џF}ˆv{є!IrаF„BТ ў- чe’:а х6‚ќy›‡$ЙНЇJє€!IсюxЋQ„МІaQA“ЉZцЊоЉ0ѓбНЖЃŒ9џAв—M#Уls€ьЭ­3з/ёо‚KX,„ГkиilпžѓншRTЗqтПuЖ$B‡Ѕѓs=›I‰5˜ЩPQ<‘4ф~Ц 6ЩpЋЂq­Xy{-№FMШ+~ы^шюУT[œbPRкTч]‚~EМ0Ÿqgbэ*OŒШa')Ї7ЧЩЄй3Ящz_C<Во ЌLZ№w`Vю§ЈaFzћmqu™žцдzmпsз8?+ћЎ/RЏmS)-{ьnмЉhSЖQTЕОлр ЊgšкSм™ .',ˆuФЗМl™­EОO—l}%žю№шУЌ(Ѕ_™xм`”sJЫPлЩv›УцKјЬt>QЂУIŸ/‘ѓЗР OІЇIфœqŒ$СќД$> лОW5И-*2лmу^XЩoЦчВŽъЊЎHНфž,.]‰KЊ2vS~7€}‰НŒ‘ˆjЅS ў>ПАзŸтЅЈІХ иcJoОх4гUGм|аЇ6‘ W\Œu;јWенУ4$ЅЯ–œYл^-щAэ–]Щўкун‘ЩљТqƒЩЮ›™™ЩƒъU]uеЯ2›рпЈє—2XQќœAwСЩлbdД–~бы?y€˜`їеБУ Z…ЉЅ—)по[9|Џ?CоЎWфнKЪšœw-{ѓ-Т­ћсЬІšГFv˜фЉІнƒс8l:Т5№Ц'2&R’aQОŽ`ž‹еNукbUйj—˜аxYŠ“… ђ‡@цO?„dѓHёi‡ŒШєЖЦЖѕ™Яљо зŠЇWMŒ:ŒП!$еJР)Јон|€rеWА#U”Zб}­ћBvuyЖ#i‡!DьЧ=QwБŠЇЏПntHВvЇеuК\ZтЇє3- г/dЫшфъ AmГЗŒиЯrJЃЧ’‚‚Ьг7~0ЬџЄ“ЭЙЁ>ЪЗо%“н-xь ›b‰Ъёл6Н/#=ЯQ?X‹LіNiavDЇ^ V-4,2f?юкгОэв;@ЪЅњ8ШР–,s]”џœ—к’КuxцRРoOўиТљѓђmТЎ-]оR 0@јXАрдЁBfўг-љ7Nж!ћЌНlзЎcђЌx™—і\T№“—И };Н†toUPŒБєі~ЅУыЅэЁ*[<ЛЄВGЖ.Јѕ вЯ=’ ИЮ)L)Ђжя< ihЫЎсЮпЊ н>$КоX"е’ШОœ™дћPы!НNF“У[g7Џы [шfbkžофзŠ_ЩФ‹#Ч‰tJ]nXфJ’EРBЋzЛЯЫT^ерЭК&tVњ•QЮBж нsЕ–sяXЏ ПЂ ™%=N$*(sPгa[Айe)ђ<ћ!вжэv) П-џM5‘рЕЇнЌR~ХЊpЕ.OЃ'”uзh4пwebдэђи˜^ ’пБMc3oіnнЗБž O-§еžщЉ||ри$%›ІњCѓ™ГVЂ4d‡ЉЫ’фЮф\ЪЯMє Њз„1п B|ЁJbŒV\ЯФ+AЋ›(ю*љ%•Ѓ‡я“сoЇFэœЯ„(ш"фјђj›­ Лe№І[ЛЖG96u$‡sG БшДб%ХЕ ƒ}„Њ=CЏXК=aѕ-„Яce§Q!u+ њёу˜f<EŸ 4.Ц4Љ›cЊ›˜ЛФ&ж?єф7c˜†L4ЁІкф6wА­ exOтH|~нXКЌ;йыщЫцVjўёУ”ЙЉ №4оЮ{§GlнGfчуM€‹жТ^Žqgœ˜В.АбXћхт<ЃpЫн-ЇФЌaєўŽЎюЎ.ёeQŠuтЃђѕKUmaМ`lл(‹чФ‡Ѓ•ј_ђ#c–&kœЖЉh§E7ŠNХ‹–ю1$ tђндХ7~ђŽ›ЗІЈJхЋљqcгѕўr gуЛCЧЧСvЗЉ'ZWRкм|,[-kЎ№j<я§Н ТЇQНyВŒ6:O•"X#$ЉM} <|;хŒпЧ@sхО9Дѕћљyђ{ытчЂ —і@‘v"Ч<˜UўmyЁЬ ГЅŽ.УіДт:r+sэSРьЫЮѕІЕь 2’?„•ё^>}Еџ‚єјlљIAгt”хРэ§/Š”ЖЃ>%­ЊiЄяЖ,јд|Л §”ЕЇШяЁ/ƒёдѓŠ˜1шэгБˆжгЦ)6НМŠ1б„њШБІpўъСЅ†ІLš<ъ‘їu}˜ЈIM?ЪЈ“ЄtД]j‘“Мї ЇѕŽ+зпкКW}аOq…lž9ŠR—ыЙmXf],Ј“ћфSKq ЮЎ3Ы"I‰+w^РŸ3^уsСJК›ХэпoўаоCJi§jн$–*О ”ѓТщШ3ЮЪEX?ЩБ8ЯѓЧOЌэЌ? Ÿ‹iЉйlЗgАГR/сХ…S‰ЂЌ…и|щЪЇЦч-jЕч%lIк”ŸЛž‰(о“Dšf›}‚TЏњњчИ{[щX([\хgШ‡u№ ‚IУг‹ТхиъЧНЏЊ˜5*N4›БHyаЧ‹а›{Ъ ГЃГЦУJЌœ§\=iнЇЕTє‰ц’КЌЧ!ЫL'fLЗJ VЄЙdx&З„KJOђБaˆгЗВOOJ6еjEж™/LŒїEZ†^ЃјQ‘Б-h…WgfУjДс!ЮlьсЛ.D[!˜j:Ьмu^КoОUэvŒ=КjЊРMЩ0№u>”ќ“и%„Œgє{3c^иДbБкxўїнкO†ƒTВŒв\хѕŸƒпwФeЯ™зu*7Јњ3|›2hЩ/4ЁЏїЏ(›ВЛFчWnОЙw8f|Ы82“š;елxcЊk˜Пd|ѓ5}бY< дwГТsТщу KŽ,‡жъfs‹†TzUЉмy^пъуyэ§:"К5к^О•4ГВ‰ўзŸ}йysŽмv›ШŒџN8#›Э9Ћ2‘уњˆс^ I`чИёŒGwаыNбŸš%.iN‹Š7ќ‘цЖSж˜Mm*2)6{;oфm?DєФwџU˜КИ›EкЁMчш” ЋаfE§ф6ffЁ~B2#Ъm рт}nb:mоГwuj$ДЂз.у’‰ЎФŸvM њ*Жь­GgГЋХ”ggcЄюP 4Џ>$|„Zш”!в % Љр•V#Г}еF'R2ЉЭ*;+ K'tй<џ[іB^c™бЅ’AŒXWЫ]У{!;д]6†ЗвђЌ_|ПЙ"Яхъ:Ї'НЪ%&_Ѓ6пXўГNŒЪOэкУšФdЮ1іn›Ќz…nЏз€cШыXыШKi†vёБоWљмИФсTlПohšЌ”П'97Gђл бg'/dк)|Ц…XгЎк ГЇд4 ь'є,rДJ†Л`m‚с+|jсЯ}Tj_{Б ЛЏ™C}lв)гюM*>дШ"йŸШc;V“і4„Tж2ˆ :ЁLvZG щEхЛ’ѓ“>&ŸЉ§ўz+$№’љЎc7ќSЇ—р†QP+ОфЇЊp”§Ѓк}wЕ‘™'Ћ4ЁЌ}Ф S†4\%=I‰Я%ЈS•|… іСЋžžБі_jЗЊ@{pуа‹ДДнј№ЖЪ§ћIЭ.Хэжр˜‡rЁQС+pОїј_нМЊ!5•{"`šЏйг Мrђќ“ vь{B›RL>шЊўŒJ$bц.GйЁ>5^}l gОc.ћ“Я}йСŠХCjУт‘6эАЬ9ўм=“SsЃi* “ˆKімTь_Бƒ@чOЅŽJоХћ‹’1TlЎT!‘–ЁѓBkGО(qѓ›‰цc‹—ЏФŒкgЯwsь6#ЧдЗЩK/ё\XcыХйшо‡г)|Z†‹lьљiГЪеŽ rЗ‘‰Љѓ…5—(VTэTŒБщ!+sмИszЏ•vШЧ<pYiRђаГ–§р§љ|–™P":Јаe­мЧдЧuРн?ЪПЖ?є„НАL Y^I‰їќч‘uшŸќbKЏžYvŒvž1[іs:ё ЬаmЯ ЛRЛџˆюЬЉі:tїLd‚N‚уqЧM†srКМ5zЂSM!Zw_!Г^УИ\€}j‘gХпuх)MS–z›nЬ<ƒHвїїPVѕы§Я‘-—ж№Ћƒu?НsЭњ™oЃРfо ЋD~L0чф #Vйx5§ l% ЕˆІДмЖeГЫ{š–ƒп^Ќќ2ЧрЦ$цъ лБЯђ#ŸЈjйX–љ_ззЯ*О]ЌЩŒlшѓ&웧>[ИsбMєDЉШгь<фЊ%зЃ.9ЅWЮCдœіЊ9HD*‡Ÿa{хVTMђщЪQљ#оCщŸƒЗž* FYJЦMА m^ŸЎЎ* P’j}џ}yчЭОWШлЛU’Љжž€&”аœj гнЯr„†яt‰ш;_‚ЄU†,–Ђ’'Jƒ4$ђћќUЊжЈ­Ђ>|:LjЯxZЗў№Tь ШC†Мщ Xхт-?zюc@Л–h^ЗєэMк;"›p—€7Nњ*†)н!фAŽ„7`[бЂšЪT*ЭvŽ>9“О}]aE^ѓ’lФ†$ TЭ‹)Іх˜)Ј™БЛДљ) qПњ‰Yg3о Яя­ ЎЧ#ЇM9ѓшЛ 0ЙуєыЮцІ@ž[ЋрŒЪ3Š3Юђ”sш!ыV” #эPЇ[†№эећ/-LвžuU\Aчjiq_Ѕ!Г`zTљbjpBК\В/aчt80nЯ>МBЋ„šкAyIDѓ „AРЫ—ѓ|Д„1&ЋЊ&Мh‘.їЪIВЕ˜I]вH“B €‚^Bдѕ„KržНжXЁэˆШ™ˆMLhљМЂщg0/L|А›ЂX1nЎЈaюЩm§0.ѕёœXSўšVЇz5эЩл* uЌвG‘ѕ+[w{šfиoў–г?П endstream endobj 204 0 obj << /Type /FontDescriptor /FontName /WIRDCL+CMR6 /Flags 4 /FontBBox [-20 -250 1193 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 83 /XHeight 431 /CharSet (/one) /FontFile 203 0 R >> endobj 205 0 obj << /Length1 1632 /Length2 8181 /Length3 0 /Length 9252 /Filter /FlateDecode >> stream xкvTьл>%1К&!Э6ЄЛ[ ЉlЃ$”$Є”V@$ЄЛAЄQRJoњжя§§џч|пй9лѓ\w^wPИ+д­№;q(PUСEѓћ“ЇмЭЫSаюњ‹!ш—t‘UіJ(†єђќЪOюГCWнєЛ­.H”/2№Гiя№‹‚НЗшюю гPўS ўСa^@Q0,. Тм0?;'а/чЦўnАпBШ/p Ъ ш€І †;Ра?€@OЈ шхс ќOСПohЗѓкТсHР?об0Ьс;Кѓp?р0z№ @№ЏЯп'KєlйЃЎўџЈџn.H]OеLA“я7сПEŠŠ(?` €8P@H „@„„€тшC№ПНќЭџ/юПQ}(ќЯмРџxд@: €’P@зю/>ЮїŸыТќw]zŽa@юЦо, ЖCAўЯУџлфџ7ѓПМќ/cџпљЈzЛКў–rџџ?R(юъџЇ=Хо^шаAЁїљпЊ&А?–XfїFќЗTУ Šо ЄЃыпE„{ЊТ§`іњp/;Ї?шЏ нЛТ‘0}”'ќз3€€Сџ%Cяš њ)ёDwъЗ†^Ѕ‡TAкЁьэœЈъсѕ О‰!шхД‡љ§žk H‰ђB›бє‚(РЏ~Ђ@PBУП1qїFїс/DXјйЙBCЂhШŽžџП!4€ђіј‚h "’@ъ?я` Ш §!]aџDќ‰zќ+)t<7WoЯм‹Až0єcѕ7"‚FаkєїэЩЫЩі9Ђ#zљЂўq*Р<ўўUU;ot ^ПЇ]ђПюПŸ5Ьf˜›Fйн}ф\§шУy•ЃЏРЦˆЬч†I@рœGГїМTžЪь№e3…дўВOk*мЇђѓЌз; я№Ђ“ š.ƒЎЌ“ Ч7šГc4=ЃЏvjК™ ˜Œх7ƒЎнƒю‡Й`7`ЖjrцЙ{KшPžћvЉљеt—- ENolVŠi^•}ˆПgV<Щ™oћbŠŽ зK€Ÿ—таtђєl‚"wє†U3‰М/\hўY(сb*`ёЕБg=Н93і)Хај@Хэ4Mк™Р’ТЅ—“оE1ТŸк0,еBІW ФЅ§сIoхњАoo:Ў|пm%ЌDђЋEWЬЇНкМц/Xс†%КЙu>Ээ{HЖ8Э\FQWЭжzѕJ\щќнsъUБ˜PMіл 22Ї\)Ќ‡Oц}XeчYеNшг*nG‚ˆY ˆUItо…t;€,ŒМљ№'м9lЗсЅэЙ­PQJYЂю—WіЩќšVхЕщqјG-У­ [ДД y ŽjљЂ]œJ'Аœѕ|З›?ЙяbКмсOоД– }>єГ?кŽ…-)wV42eЬ““œ6ѕ„•Вa„Лˆ оЅ3m36еf/оќЭћ”NаЩS# bТ4оaЙдZм‡vAxы)&нŽЈ–Є§Єы)†ŠjлvИ„ЬѓМЅЪ€ўуQЃj~вЅO§РYfЈ>᧧šйФ67ИKRНѓСдсКM[VmЛJљ=ўўзZ“CBgE]‡'э mѕњ§ЦqГИEЁж_Шої{+лSEЮ 'рŸЅ+в›9ј{‹mч”јu|.j\YзНў™™eќИšoКт’*N;Ё‘е ЫЩxЕ<ё0ЫЕАaќќ†Ї4„šCƒsфЦ§ѓ3} іŠфбэћ~.#$~нЛђK&В)Э—5ХœBоЌЮЫ8)ЬW- сJ‘ЕВ'ЂlЇ}—ЈРА‹kжвќ=ЬŽќnfprџі­S;§JХ€Рn† ™хѓ:{HьзEЕLЎРNШL›М§ˆrˆПЉGKЊr…žyb‰JПрhт'™dnNЋ’fа§ЖzZžњ†_?vїЎs/ю!щщёnQ0&щl–bоk#N@˜gы” кЯ˜Т‰Дfu˜oY‡ пf^Э№Y}ЉŸіQЈљ@Љ ўTѓc-ѓaкн3}ЏсЇ€еlђ.ї^п)YПyЅŽВжбqœˆ”“ƒлОљV_’‰.ЈfЛ g}RИБOЦEј^†У:О}˜hz‰/2ŒYлM—KPЎq‡ЙЗЇuПˆ/gТЏШЯ+СїSйлrœ~ЪˆЇI,рF}XЉШ7›фђщ ўИЎ э–Žц’Щ {пЋЁyЩд pАŠRbѓtC†Wх …C…ШЈ\Э;Wь`‰œNšы0*OЕBx}Ух~bžаМкоgO{—‰#YЦpї№GсOІО? Ёxt№'ЋZ„7Ѓъ~іlЏаиќ”зU~!Б\щћVZЎиЌ#їŸњЏxХІR(AЊFvžПйНоѕОЋE1кЙ™dыClЇQ†MЂ…)УMц%_ЁeДл”K_Щ9e^ OЦ4у ЗН,Ћ›KЭ8 !ЭйaRпtœqИ"эф“)#ї?И ѓкЪЖLўђ“№љНр1дeО|СёЕEKП—}Ђ’е™uСpЗbш оeоyл@+pžвО›€мк2g–X`œjНр0ТФ`=r˜T$vЇЭT€сРc-цэHъЙьz9)ЋШ|Еn9B‹ БЌ’ч}к<0пŽ"КЄOŠ|“Š‰v[ 9yТл}YщŸoП{-єІзАtŒ)Ар-8К ›X)b”rНXфОІЄ3+ФшsB‚ЇMК ЗŸ­ШaxS\`Ьw]cэІ›wГVеЅF?…'!п­M ШЬ5зЯчѕf№ь$жzVЪl#,ТУТS[НЩ]­дœtћXgqх/w>s3Ѕ'zћс4§ЃNžcz‹cћC'*Œ‹‚ї+~vYQЗи†мњЦВU!Џ!0;Їъ9+гsHt`–ЪYєЎрДЁBW„Обey“› У—2ЋСUЌsAV†нšЛАЙbЁ‚K_уИйЦzЗŒџќдэzoиkЯ‘€aЕG*{Р ,ў ЕNЏ|otжж^x ќМ\0mпk\ƒ<ƒNeЂys0Ц2,оЁћЧж§ЏSЩхKЮтїЁжаўЖуS6@іН‰=кЭbFАд€3Љ-&[Нє…пxШїеп|Р›T0ХšWйiJщК)ў~Я1WкЅжНC›ОГFБ|sz€зљѕD#ЙЩДFЧ­љy)„ `$Ш=ГЬЭЈ b$ЖpјВс­iЧ’оLЂ•Лq˜щ”яуg‰РJ%клтeѓи?O{пwзBт@д;dу+ŸšRЈдIЕ*›.`l‚ссN”y‚>]СKоh4hїl4БР'SUvП‹Rз$OьГ№Qа%Vžт9˜­ЉАхžНјVнL }пƒћІ9Љ‚E^Э•Њ-СSuў f!y/пб9Ьз6MqRїEœАž>Vгљl2)“ ?x <ъŠБ~ЂMnьжkжуІЙvFDmmЗd№BjУ9љЫZЩВддрHyN^ йі …Ј”ЄщНq s,–aжВ#Лх–‰{mіy}IвZShfћ rb"O ћХі?[N ўNЕ3;_яjoŸХѓщРфс”‡ўЉ[eЉ–cЭЄzчE О*Аgnјї//ƒ€•AW–ціЏЗВСЕЕЈ–MћћšђAOXš#iуyП–0Дdљћв\“‘iх’Žо>*˜"WlяŸcЛћрЄ ЊVX3›*ЄхЋŸ=5QєЗТ" Ž3‘œ аKuпФ).~ш^ё2Ž‘-јјЇ‡FHџ'VŽbYЯMМЅНг—ИЗРUfђ%}%Ђ?JЗЩоj4'ЬbЩRљпк ЏF)Н[м`U’iSМлљЁЭ0šМ аюhнЯRwљн]P%ˆD І‹н…Ы™Цк‰D,ž{}‡хД§ФІУšœПyЏ= йЙ“Ќmo>|"irœE.И#Rœ!ИпdХ9Ь[8Ц\C3Ј<t`.WГїHќQ‚ фѓ /БВДўdайђ"ц3a€f хyjо"юзgВЬпЈ”rхє­oМЦPљУЧZБЉ‰кБ\veБЇя™1N—>1-Gх=AаQсЪRЕ Мˆ›eJJ Кћpdѕ!{cОрIЊЭ  V^U7‚Ž~_ђ;<ЛQзЃU6œqzЄ}‰Е@ОZZ*Pхџz&П№>1ГЗгU`•г„ВжфГїV6V›qz^ZД84oXА1Nпї3ЦVfu>ž@S_bŸ§ иєа7sЏ{ЯLйсРH;+|V”c цќ Я›l?цv-qR‘зУ 3m~v•Џ?}"ЇЏы%фBIхЧЄПп фJ:eЎvд_OДšэЇгЖ‰OYнGѕ~гБi™3хŸы?Cae-шZF–ќќt‰KЂdtXрf;=8бкwcб7}бM'ФY~i|Gг№@ЩћС5H9žН ж2’4xЬЂyљшЫъ„ъ]V€оˆ™qš’х&|ВєЃчы%P‹оЊЖ(ЪкЇФЯŒУН‹ЙђЊ”я‘Mqдо]€|‰втрw—!3ѕЯd)‰j;šs]Ї“ЩщzЕВZ|aФL|Њ Ч‚„œZŸі nfLцIIцП,™˜п"JѕЖc2 +Иœ2L *Jм2~ЩЉ}\”=№иŽ8ЫJл‹ЛЋ:ЦЂ6]ќыК…YЊКЛєЅ=ѕ.iд(2HуУЉхpЩK?wа?ъЊб^ЄЫaы–њбэНє=лS0{RЉКъЮсE Wя'L3кЇ•}cќХƒљ/ЛhТ;Œ‹И$šњнR_љ=S‹Aa’]2И з8’ј“\гJЖц <ЩЂŸ1Ш;.нхЪ%Яёј­фШ?žYr7Њ:шдm‹Н6ж1ЇЬ†“сt#*ьEj1Зљ‚N ŽRЕuСOq$jŒFРD8№бMкJiLwћДя™рXœgw‡сŠ@sД?ЄmЌjiбAzGФЇиО„5qЉЕ]7n.}ї№Соa‹ЭрГ№”OлyмнˆРД]FКЖч;№ЩяsvK;Уtъ.Ž+пd@ƒ+ЪФ(л@ Ž;žVМж л5 'N ‹4Дˆ;цNКaxwёjъип)Ј‰)ЪеБvї‚(n`VЗЉюa_№ХX—юŽІ“Ь)4cЖЋЕя?$=’uЉжи…7ІVИчн(IXт%п{ёCKэŠ§ёfŸЅMН.˜wі]\Б’_Ю ‹ny­ †чw]ЗМя•иyQХv €КE= ™„љгFоЊйЭnN2Ђ>tzбаG^‹*Œc0=  уЋт[ЊPѕ%CњА?ŸШ))кжRј™rA`CbЋ…Ё’к[љЗ\ЁњЊ6Ъ –бxС9дЋцп“Њy^?•p /zEтћЅ~˜—Лœ­щСrяЉ~^ь™оћУБ2%ЕlJŠHOЧ)ЦГG‡йУŽчЃШъв2•€yiлъ‘r(сБР\д*#E5њ?ЮMРш‹ЩЊHrті~ЄLƒиkдл’зДGЏІH*˜&‡­“ЭvкСІъЅœ"U|: ъи^О{tРБИі'SјмСЎЁЧ]ѓ !Š/Џ­ќь’„‘|%ЖЃЧЉрЮ’Ь hфS JШКsбš ЖSСНqg‚BuЬСЎвЇ)ксгWёљN<лuGFJhжЪДd СЕ^EжkФМ6zХјRЂctvs2з‚“‚Ю7Ьu›юѕ~OиЙЭОLl№Б™TЉ*-GЃаВ‰bќN ЪС‰]ха‚P"{ƒќ$ГЃїІ$_­рBѕkmoбjб‚ШуИtќрЇrW’n%‰DБВ{#}tŽX_Щ2Здь ЖIž„В2(hnQsŠH/Œ…”ИNLSZ юЅ˜д:—5йышuЖВЎcФn- `ЅŒlЭЫ„Ѓ2Ь2ЩфXЛc‡~л ЧQrЫDЉu3f\љЖ,ЫЌгwєњBN… “pгo> ­Щf€ў+ьЃ9ОЖфЛH­ьeЩzэАvЪИ ^Њr›FxQ(п[ьіЃєЌК чюБЁѕЃc/‹Ияћ=cGjmšЎєЛ-; ЯNdЁЂЪJdЅb ЋЎŽ‰-зЉuМ" |^Ъ І5ЯŒхE?Ћіx5Щ%р8ицДЋ8њщЊ"š˜›qпW8ктЫs гœ5…ОжЌ‡"Y6C–•{iAЩ>‘kѓBVžЇ„9зsэ›ХpХU]”6AŸ1 ГšЂіY›tАlЕЮЗ1?"мУ+вBYW0|Т—л–st{GЗƒф-š9Б{№"aJжЛВ”ІЇvŠGѕ\D…ЙШ\–jsнУšЇШмЂ`УцDШžbёц—чДжcйq3™[[Єј*/O]œ7Gw>!.lЯgD‹Я@Bq!ЏзlŸ<=UЉx,yЭоЎš†0[(н вUv{“nЬd,fЮљэrLРŽьЊлЫЙь(@87{о‚Ш›BV72J2?Шъ)юœ}Жћ"27]Ж—„ЁЕtUiUѓpEиі€S‘AžЃLЧОn—C‚{Ч3љ‰ў€‰]‘йЭЁ”PъИю#wrœсO"Ї‰љ€’ћf>5=ъuИ ДFРpz5B>ЙЇхЅb§ыВЋž‡wоW”Ъ›­_VГЏћQЈЋѓ)sЦљ˜‡˜шХЫнЧюЦж%T}<–-9†‰—xРFФжTыx ЫŽNпЩ œќ)ЌЭЪ ўtЫ1ћEoMњ‡C-‰ЗЌч‡ћѓЉЁ`ЇгМЗРPщŠ ЊќЧФўГ=ЩшA‹њЫЛЪ‘ Voz!кKЁG90ШЊ”ZTmŽ]u 0тYWѓ5*1Њ$ъ|ˆЪцF>cqЮчъ…M(п†CЋ^К`FЫзцІlXюЏFИЕhв G–є›=О†x-цvрдђ˜i7*ъ[?W7СQЄш2ptикЖ0…0’—$ь>№ZР~ ТСђw[$љфС ыeГш§(f{7МЧнЌКZфŸГ{ћŽI‹Ќй’ёпB№—ЙНщxЌ›ифp’Ї-я ›їй‘$_йЦž­Л6‚‚ЎфЕсъљ,ƒЇGЃˆ(}œ‘@ч=Њ~2ZkПLЌЯ76CЊь$Ы­‰#OЅя-•м+є„=фeCНеъ_(€NRьMMЬащдo'ЊЮіbaХdћЛVZ›ž1.>.зВ>š…WзД]бƒлcЅйЇћыЄ>iГјAѓm{xў`аPЯ$ьт;3Ѕ~‘Гr –e їц]ЃFф—Bй+%LЭ(шqƒч‰E4.ўGЋg9l=9XДЯ“ЉЗ2ŽхH-%F”вГќІж?Y|W‘БО’Фц$EѓZ~*ыЙƒЋ9зrЋ сї0о€т6G •7бљм+Ьžм9Ђ§s­xїЄbŸювGC™дЪ~хx’УйsЏЗ:“ьЖж7—'fŸr-C 8sЛВVІп~Г‚*ЅЩкДE„Ъ–ZЪ> Р` Š?ѓ=&­W~A0]єQmЬЁ"{bиемС`е|r‚›8ЛžЉQŠ€3`M13[Ž6Ьєн:-`Ke]з&{Bэхi4kКKQИмтУђ)5Л^БЊ2П6'ј5N ‰ЧW#F0~A™тўžЕјЎ0='ЊH;cСЊgЯэЎoо­э…‚TK…ХЊs-S‰кЇeєЦЁA5ЊU†qOOg–”pгo’ј=€гЂсdДHjи˜SY†5з”Ѓq­M@~ы­зэ0,эvzФ+§йzЋЛЬљQUЈњe/h„ž­pьŸ|kФАФjѕ^›Dј­"ум”№хЧ8•рŒ \:бEТ›%l\щдŠvдŒР‹k,Ёч_/­х)жыW2•RЕТNУК4’т‹L­ЌІlќvO/6‡яl~—™qГSp.zХšO-Џ!ЏФrМšЕQwXнfКœ?м№twPнсRЅ›ЙИ6АUѕо?FдJ(cяъaЏЅ8i>л1dhXKђё5‡UђШ Р~ Ÿz>dƒMТѕєg5dз<Бїху{ФК:цУ­mч о5'ох™­wzH@›-n*Ё[rŸLеН >ЩїщнЁсн ˆ2Љ^иtЧьM—UuлГТ)wрiі™ЮB,т{ЉИ1tљМeœ—|›’*Фр&s#ЈрDіoўŠЇNNn‰GМжР…A {ЈƒЁJZ ƒЪG1:яд'akЬZ[ —ЫЈXЮxЈ[*ла‰ѓЅrWJЉ”5#ФHeї"ЮXГD&ѓoSвS`K {ˆ6Ѓ"—ЕсќNЫOЂŸђ&ЕcL€qПuв М“тqцœxц"Й[њ“jеŠЖKяcлˆМšЈbЪ‡ЛyAЬe!wїУЭžŽ#gЅЧѓЁћwУˆ Ÿг+yћ/ љGmОЇyтлђM0JšH"cIЧwмє=ulњ+сђ6шѕ7хУѓƒ[О…mѓѓ@ХМLуfзЖFX$лvIъœ[ипab*ГоІ\7пrќЉsђvYѕь[2™tж|ш DBЪ!ЏиT˜TГњ•$Пд ;;щсIф\9ійІ‰ћjiЬ•§˜"пoCYyовв}a%ŸжT†ї‚#урu3яxхІ G&ЩАЗ]?‘4д-[ЌWбЂ”ЂуNTлђафИz;ŸЦЕg јшы,]ž_uНq-f~ И Чнrшѕt'e~џcЪkŸЕrэН‡wЧq@qдЛСОт œ ЅЏќtTњ—[ъ‘ІˆT}ќ›QЕ7w*’h/?pц‘M‹KжШY[Fуh&<Ю4vЖa§щ(Ђќt™хіёт ;a*%Tr@5›ˆGћ)sŠ”Д єкєŽ R№yЕŒ‰˜AЪы›|ЂЭ~•VМ‹%oОгс7Ђt3 D†‹йaLNA>­ЎЯёr’q ]Зюдычќю:в­нч7W70:Хј1… ž*•ьT5П!bЛхЕDh{љгЋ0oЃ0йђšњД=Œ67П/р"юЫMа ИBќ‘YЄr{ыУwvИь†˜RІxјмФ Міо[н Ю0ѕЧŠл8ї+MмйFБHјŒуЕo­/В:p\JВXФ^™DxбEњ?~щПc&ЫфY.П[ѕь-\NHЏ #НШ•ъ~И3ЕЅƒЃ•№L—Ф 6PІV}мw@„•4Х‰`PВД#ЙЉagЫ•ШљWWп`пKEG–љ‰Гян\]КCA –&е)Й4ЙX†хi>ш G…Šц‘х6шфrК ъ Ÿž^_цњЏc‹ЎГМ:}hв+ю1W::zјЁРYо( Џж9ЛYлЮБn‹]у`о­ь–—йYљ.зФц4њЬю9Ÿ”Iз[тф?яі~iџnЬњHјuЫeYLO&9‚]u+Р@ВЬЕ&Хr$MЕОU‰Wb…hЏит%УpВtЎЉЎЉщј"/УНЪ‹єфђtNДуBо"Бs?rЄo0/gыОŠ‹.{;0sžu„XњIљгx—ТІ[pϘtжTY'cx&­эzЭт6ьмБ†ЄЭЊЦUКƒGVуSU‚rфЊЬВЏSНwšї%UƒОuœ0nу3}ЬЁЪŸТDNy/ AюWœPLKO№X 9E4~UяŸГ]зœџКјБAЬtЎ•Шl—zO}ммЬšX3Йю~HžьqЌш†хЕ ў-:ToгЛВ:w3ЬMž{"ЪAŒ,гЯAЙz?@”˜4=яц&JE и‡­6'_пЩiH„АИ%ѓDйКёНй|ёЭћGдњуњr~ЬЊX›§cŽёvІ˜aц!ŸЙ‘LЬ›…˜мАТ)< #,OoЉSѓljiKЭgMд—пW;-uИ—зvMнnцЃ‹СєИzђ`=јњ]ыг Ў№ќўы=Цё[SSсЇzА ‘” ђS†ˆЄЯ}Ts.ЁДјŠ}аі!-hl4o `ьAтлБхцAжUяв$Ф‘4mЎtмЯ#АHT>o<Ј?ЖOљtŒ‡ žBјWоЕAЧBisAцЬјбL›уў4wЇФгёз2R‡ 3К. eлВу*ЄŽь]€ћЩ…ис9Tц6ДЭoЧRDєч1Y}Пћ* #Ш‡"ЭеŽTo“VПФй7yжФWѕ3W7—"vГЬ™IЙuio1:В]\БгЖ ЋcЬпdЏбфпЁ<,1,уI’Ž`ѕMIИ™yм)™!_{ЩвcЩxJ' ZёЌLѓ1xн!ZмФGq$„‚QfЪЩЖy–жG„2™‘œ>Гаvю™9: Ќ^уъВцвѓ[LЏ ŠЎИsЫёLBпўХKŽж3ЂWlJҘыQ~gГg™w” ъб>Xе+›ИqЂˆ•w2 њ“qј~]–№џmjжИ endstream endobj 206 0 obj << /Type /FontDescriptor /FontName /HOFYAJ+CMR7 /Flags 4 /FontBBox [-27 -250 1122 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 79 /XHeight 431 /CharSet (/eight/equal/exclam/five/four/nine/one/parenleft/parenright/plus/seven/six/three/two/zero) /FontFile 205 0 R >> endobj 207 0 obj << /Length1 2511 /Length2 17824 /Length3 0 /Length 19277 /Filter /FlateDecode >> stream xкŒїtык ЧilЃ3Ж­ЦЖsЦЖйиЖе˜mMлM6Hew‘†MR(Фt№qS_ЏН“„СˆбHщM21нFвЗ<'ЏnНjП‰ЗФ7Bо%;чЗ nюKаи№њПеВэ„O€F"’w{€ќL!ЉpеН2„C?_кХфg8qOšu)ЏШЪЦНo ˆfа“– 2йя2ук_ (ќЩК2…ŸАVфЋ@~=F*К†ЃєРТ$ТоjDчЖ€џ„ЕъmnдФAИ%0ВфNх% иv#‡kbў Д[ъ–РS/1‘хѕˆETё€і шѓЎ˜ЦД`|\‹ж§ѕщєTЎ2Pi7QП­u0”{1ЌƒŸFОК7$:tџ„эTЬgОЩЃдТD”j_ES=mеiЬ#b[Ѕ`Г)іКХvЂt_љˆ,ЅвБcsжйѓ˜Щ]‰лщ“Lфя›…Hi`-О?ЃН›ЫјuаА9,eЕ*>L-q@ЂŒDзю& ?ПлdсHќЮОэз† {Ќ AXО–2sQŠRЬ "ж7g+С6нt^ў‰ънљ/М№юЂЖнЯЈ3t*Ћў’/Йžb8„R3nош&rиP…ї,юЧ§нѓшјƒXp­'ђ цдЊр‘Л€0СEЈѓvAОN!yŒЩЂ …­*ЩюЗqb–(ЇіHvˆHJ5ЋЊ§ЊП‰AыXŸнEЧ™ш\Кdї \cдЋыу &\Э™БFЖцNќрКП‹ №ИP;шВmэК5Д*1Гn"wхm…QЉР\ ‰Д?RoGэX*˜FЭу?ямm^bдзЂЌOџJoПIРуќЁщзФ@GwBћ|-ЗUЗžєТЗб4 ћŽ…чЪиLE;n‚Ÿ*цdЉ|bЉЙГЈЌ д2tСз>Ћs}я$Г“ЪŽ—.ВЯ0З­yж–ƒ1Џž…јh/Ÿ™FyшшŒймлx4уИ |sVNПб.ЮМ–vŠк[K^ЇЪёе=_д{]VžZc#~<ЇАВ>2тœwўœv„MГЈ˜ ›Д\‰&пlднОvp"wчHўЌ‹2с`žЎeЧтZь`Њs9qacнMbЃrОяі3 Š=кР#Нѓи€˜FCчћL’”іKюНlэ““ЎћmAgЂП+ХЅACІ’>B;Є@б>XТ1fЪbЮhЈhЈYW:УЪЗ–žF•Л‘Ъг(.B7#ƒќmaЂNMЯИл—^E‡ћIbs!щдw@пкS^мwт3`‚т!нЗциˆhз}kЧDЦwЬЄ!ГuŽjŠрzr0Кн№˜Т“YsU0ѓƒђSIЗђБ)!і•яѓ<фкЛЃ"ц§\Чˆѕ‚; ццжŽР1yfЧ*„Zˆ3 ЂF˜ьР‡sЅЩ t зЕшЅB#бKК‡Єз>АfЎ"вœх?З—зрє”4 љyEyDsі”њл&…`У~М“аˆLОWє }„З’А-§dAƒїqЌ В€pi6,ŠЛ9x„(jэ$е{Яv)*ФЄˆі€яѓPpЭј`kЬFЃъеч~MЈxpŽ­аъLиl—чKЗЦГёMA#:7„кг7г+\v’Юіє}`У­SЄЖлЂ6=PЃt>J^bуBsHВц—лл7›& П“Ысе№:'Й0_ЧwjWnЖVЂЫ•ЦђƒшМцЙ;}awpƒŠg˜–г‡GIk(Феd>sžЖї ьS є?ВЬB$ю<4‘cК*ЛОФ88З~$‰сtdˆћ$Bu‰ёR0ЗЖEЪ22Lнюь1іEZЕ( *k0ћ]уTџТŠы€-[|мM&#ƒЊPMџRіŽЁаZ0њЧиїЬ…DЦ>SošЅ‡w"8яшиЋŽу\есh*!vxm“Jјј‰(œƒъIрKvЧИ?fMб9PВпYe`эу5п)ъwВд—Ј9ИХˆ…шЇХcТОЮќ†tуAžўх‚ЮЬцfп#1ЏрЋЏV`E•ѓС•жЃ8V<шсvч7WБ*§G*СН-И+ #іУ1lпуm4b]'5ЮЛЎ_ IЋЪтЎf§ЧдЖЄяРСEЈЕё\СѕІ+ЅˆЬGVСp‹Иђ“ ЋyыV•…БLС;/B—–ДR~~WЖІіСšэ7ИїW-bИч6Jвј5JAeПцFЊЮKRu^fMdСЁ,w]PAs™bN)S@~љО -`q‚~{ф›•Њх8ЫЙ„уь$эш)эЗБ™ДБq–6a?UЭ’1вМЕ сjЉ …FЖMЁьlˆZН_HeХn Сп†2с–й]ОЉiХЁр№dО}єeЗ*#кєp %ЃiЊ–w3•›ДгЮb€• їщВё),x7СМgЛ(x†тИ­кя•Ћэ[ бр`DшЮёu—нy"Т.q кWЭ€ЄЅRyШEрэs‘7№ Tд`РНФ XE}Щ”HјБKФGЋзѓiГ/?Uв>x/Л"F/L~˜ЙN_ќuzЭРо.Jџ@&r№;щžuоїљЕ3-јL†єЖи•–ЙчЈ‡ЊлЛЮ,`iђlЎЇ6у‹Еw—ђАaЮ \dr*БG2њ`enr ’­]GE<Шш*ъЪYЄЮхŒЮŒЧхbЩ™?‚o†4пзщб(Ч ­X™йСЦM8XЂИTg№MыЦЏGпqѓžв{‡74М@Ъ ˆГъhжˆЕ{‹ q­wёєнPЩlцоЯ<‘БмЬАXЅёЮйбнBKвЏ ЭаЇ``јл8ПВunIHПЉImЧI†&‚нeКewЇœ•P,0z‚Ы†ЦET{Ъ‹ќВ#щRuЕіt#хЈџ&цП\ЖN@ХŽ?vП5 іIй‰rљsћhяBKЛ Ў ›5хBчЊL~>"Лэ4вЕЮз^ЄQ Ÿi=Ђl Ž§­Ix™цб˜6тблЅхxцjфЅН<ѓŸћx}№„юv;=о'ЪТ-аveхm’цIвRЉбzАтHПъЏь§‡4rоZ:йyЉУоMшюЉkН‡uцяiЬoнNPhм†—ЯEМ@:ЁЊ7hfШTЃ„Веusи!zЈрhЎЭ0XЦ“FB{ctV˜РщcЏ™sz>.qЭ,<4дкZФэ~л ИЖ+tмЉъЋ‘œќ^Ь5C_eлБ'^vкЪЩѓ!eсљ3—T(ОpкnpюІк{oЖ&?FPcaBЁˆоAщN-iгf:СЬ<—OњЕkЋ/EА4у›ШТђ‚˜чlЂмЙќxё њ!v“вх>Ÿx|пфpdшЧЃ:Ьц),cйKжчKˆЮШ'§ƒK}Э{(ua Ўe? йЅИЬЄИ kЂUжцrгЂ„ЪbІ4%–ЉO{ шB3жkWјLЃ XГFЛЭ<ќŠЩП‚љ)Љ* =Pх8Чк‚ИЩ&И7œщз НŒQLр_—3ЇъяЋ‘ЭE—ј„ќxш6ѓŽ{?lУzgНќЩhnој…Џ@€KћЇo0њHvгIЎžIjщЩВ•_EŒ /%&ЊёЧтєVЧKё(6H л—щИ_OкœKЅт7\…ЂtМВ ‹ЇIѕ;П6ќ$LЁЬ+XоINЗRмA&‚M­~Nўrўmfsш[0‹чn#ЮцL%fјd {—Ј єХaEU}юЄ#‹DŸВY> діPGT nЪїSЁўЮЌЃїkдCс„Эњб™„тDPГ/­ѕдˆf2^“{њФYMT) я ЎZTMЌSqЁFŸ:БG‚ /Еа‘—CЕ[ n^Д ƒцЬCLрдy˜і| n4fКд аБ7(ёЩ ВЊАCX2žМ0І%W$wєфъох"ЋЊО/B–ГПВ>f| œSШ%ˆЁ2GWЭŒцЙMм6ЅўЈ ›‰ТNkN1ЩЮђпАьЪEБCМ‰яяюК$%ЂН}§ щ…I­@;=№T™ax™IгQ1o•њA42…Vt,ѓѓ–4zNќ;Lc—'Ї0+“4MЧю{—AiЫїќŽІ; EZю—wЈ™MMыX,УСtBћС†ОЅѓvtжƒmpч ВYHГtЯЮэЮtдOрте)Ѓ,tЁђI~uTі•q“ŒоУ*‰HДѓbеxєгнъЇћшЋJУ}aЅV0ЩМ“ёfјPp:жпН ƒ5'žWк8(gЂpАOЬ\^нH%А•ИПћ`&вAzљ)vЃёЧFЛw7ЛНџРёДѓЭIДUщ/М–)-EчЭ lг@nСїн–ЌZЙ•˜уНЉ)3О+]ХћeQ“РŠ[эфЙЈE–‘A=ОC”ц|$ЕpтКі9пюЈРЮгkoк›јМfXE§1Ž$Ов^Ю­сХAщ‰„ш [†aЁkˆ…oуqЮѓ:=Ќ`pб „qЂЋЦЉщtE–‡ўY…tcб•kvhЎОл9yб5Wб—V6˜ЩЩb_Ц sпљFЌЖ­гВDВ юђ”9qЬ_е&ёЋz~б5Vг<ЗTъжюUтєŠmQЭŸ—: <ЖŒкъ*fОёЈё‰WЛФ[ ›§НЊkŒЌ{˜лт/a>щЭљUцOј@ЩЯО+ƒпр‚WЯцхRg(б‚'\хї_ВaЊг }6f>HЛ;"ф9`4zайшPЧ=е:е]ЧіuЧKъCGСE п#ЖXйЧHПKoЪfWЫН‰гŠœи–ЎЛ#n˜аеYачё“™uxPМвoЩqАчЇx>єЈ€Н‹!‹MЛVun Ё›…НБЊ шнY~Z9pr<Ш“ЉЫ ь‰oЊCщ мGПЧ;€Н—:OЋ 4\‡ASѕIЙЅ2Т"свЙ[жІ `q“х fїі›ЊЅOЦБйП+нкј%ТƒШiоiЇŠBщ{1)!—ХсФтћё8ЇCoFjЄv‹HI‘VœТ`a *Pй3ƒHЧв|5юЛxЫ75­Ћšn#+.T5N3TЌLКЛПy}AЁ!v]Qлž…:ицyAЮЧŒ]feШXўО%х”њOУњюГ)IY23_\\*“ј`дѕ2Gћ]гXНХН0^ 4•o•ЭІDЅцš6>vяф–р~ьIФ‰KЭgщњйPМ!ЯJœРlлљё}њ оѕiSНX:єь)Y#вmзз/+?‘ѓЌHє Мyо€Ю XL8аДАWс№ќ$И‘с–?иЊ§*DеtIзkы™ЮБ/DЬы;5tuђЮБCнаs žuћ]СЋЅаT“‚ _ptўыƒфtТUмк­§Y_]…ь№ЗЌРИH‰!—ЏAІ/ыџ_z^єЙ6\'ўЧЇ)шƒрТ?GОА:КpњjKInwА8F`WНкcј„5гi*+І`’џОvпŸ“y8€Ќƒ’3щЖ‘gЋfrсѕvj}яЃdЂњ›j­F0Oy.U&ЅD4й•њЬŽFєMWŸд/ ЭІKYцјЧŠЉIд›м0o"у˜лCЛFЂœ…сэфЩ–oя}№vDЉ_єgdЎ1Ш+Z^vyУYЃа|эБ‹АœNBЧ€/и%ƒlЇсэ9dК_іСёрѕXЪfЋžЇД%РЉl­“ZxgЗщWWт‡ЧjЗb:О#nЮW&п \мшЯ moЬy™~‰uˆюmecб Aњ*тO>QЭЁгВlkd\sрЬzАЫ,*/Œ•JЮ>рI‰Z,ЭЃG>MЈРfърійЊј1bЮ§—`@аdŽЪRmB.ИЋI#оь+ыў6Ћф„Э1 jO# q6Av—#;eњ—eATW~s}cN9 l3™1BџуOл;цJ0^с3KњюУќѓ™сЮ­еbю>0њP 39ОpaM§&i?fmяѕјВќnЎгЧі+fXk<šЮЛ[КъЎя9s“<ЇлJ–m;ч7x!œO‡эШ­~TvЬsБтž{oИvг8Ы2k@шЎgзx+љР“L |њСь–уКŒё6СОцЖЙЄQ˜LЖu…‹XП ЇЁ2збЮm˜;:хqйT|Ћ—о™žнћXё€XЩЋЮN,г2u›IДХЈсЗIИ ЯŠу!Г И!ЦЦ4% _c’С{7ЉF“чн]Dџй‚†tкУЎОX)ЬЕ<ЦJищВ_Ьjк…СE…MИЭbЏ'D˜&іЅх4D Ћnъ‹ Ђ[Ћы›ˆXЏ\ЁПЄЬД&6S^ъ4ЦiLьqi—їчcЕцFSђqEl €­№ЮО_А-v^ЧKфћќ%=иBa7:3`иНD‘3Lo|“ЮЮ—,2"нЭЋRF*Ь%Р‘ќ_Ne-дЮјК№Ы8ФzЙ=jтq,3džuVхux;bQцќg]wg‚‘s[8Ў&$ОкфЃєbА‹O\БmЊy:chЩЃЙp\М…›€ іФ.šl-а№bR6‡NШхЂЈЗ*П–ь2њ7il™­ђВ‘Є№†šцAЧ`n­ю˜LЭЫOцsšѕuЮmЄєЇuлуѕUЄИSПВНT€зЛ `“§*_ЭўюЄчИЃ`+Й’—Y+tіeйе?fќ€lМcПа[D|kXDXЦ”ЫGŠE21ЇvАEм!Ћ–ЙЋЃkа†ф`щ”І2хЉQeлIƒЃi3Ш }‰у™ЏТB№ ёЖˆ ПЙYЙА:9Л“‘Q I!ПhЭqёы шЁЩ>—˜ –ЧкY™МП:С cаМWD E–|ЯБуp•1ѕ‚44OЄ­з,ћ$#QwвM Р'}qrн– ­њжЪ]гчРž­—Џ:Fќй›a›Ќ nЬ+ˆЕVя‡эЊAP&Р‹–ИyTm Ыuwю.йХ›&&Ы sІ2L(‘элŠџGD(д ‚и’§ђ]яc№>3vh~шz]†ТШхр$ь%Д†Ц^UЯІ yIББr7јeнV?І”Б 7 *7јЧд6?ІКћOё …*ъЈФelƒAŽAмYz‹rШу№ылн§И}kйЛ)С–:ІыТ:Т ШЈ’МћК-›;йЌўмн3BDЋ­Ѓ™ЉLH ˆ*œЄлƒ<Чш3u…u №ОјWгDД› iЧjЛЅ}ŠoЖЖmgМбZюihЩHšƒСnA –Ќ›ХЅtєн*цoу Ц@*Ї`zОpї™CЦZƒti“Д‹ЉС1fб{L4ЧФвeЛЬˆ#е5р›†ˆТЖ6U!и!/Й+ŸШпЌ TQIПЛšяz:№UпJњЄН[*zљЄTм :›bИыIŸШŠjОГЫэГtL9iЩЅЯцK`=gл9QюP'z%$;оЏHфЗGE`Э•~#œZ1uЃ„aчABƒЌgiєя)ќ–(5„‚NЁ€iтщrƒ*ѓQќ|й]у}ЧQJсIвњ ЩљЙ|‰с™§§ГЭЇЄТЊ‰›X\ЕpyКSчd›Фќ~<ЃWY›"зUOо‹Bqœй§'ягэТж‚‚МyX1|”0соХ^(CT+С0ƒ>-ЯаirOВMYАtХяЪ…"2А:#6KšРѕУYcxEд0ЭЁ‘–№˜ЖW*Іяa54#ЃД4Ž Я ж№pєUЖj'Bmу‡ZmЪpаъЄлФЅŒH›†Qe†ВnЌ'іDШcВ-?•rpЕ.вE)Ѕd–іzФhx–Н›:Ѓћ}фЮъдo/д„Е&zb 7‡ Ї§!пежЃЂo“#рёЗ]ХЋ иf.RZМ%ћ5C1bєF_№ЅЄНpc!ІЈйщ+*Œ'ыЛуi#EžhDЄJ?дilёlё†•%а—є‘tˆ&ЭвIfЅENН_$uџšы^д_lvьљD+в"“зг513Sv zСyєѕЄ U­ч‚Pf05HohFМhњѓ*8Уl хѕтZн@T . п6уjс$„h .MЧцМkцЬMŽЉfЄo ЉПWЯцъ}`Яpse8мЂЗДрGжI‡_ п{9л]йХЪd˜IтeАyi–:Clф`Šѓќ4{UЗ`hk*СџQЫˆЌЊ%Œ$\ў3;€9О‹•GFШ^Ty‹VF’fчŒО<( ѕР'ЛY"hЯefYЪЩ’7g6: З!s,T’3зt)ъP‘ШёDGЄюцб‡W4ћЃЙrŽ[C3Щ!ЅПЬ,ћfSлЇрžHQJ|k!KЦЬ9щgaв;џ3RNDOб< +ŸtД~пЙŒT‡л9эŠ{™S")ОЃѓЮ…–Aтq[ƒfт$Ÿ–њŽ йОдPI#сmгЈЂJЬ>§Зjƒ—Гюt$Ѕк}HкињоhШСtЯNs0Y$к :ъ`}‹€Q]8тjƒсJЎYŒ-осНњќ#Ч\Ѕšп—‚\тСmŽ8АгЅмQ]СЋ4/:,г/ўП\>0ьU%ѓг§PгcwФ=>цгИОГxњ Хы–[дwЗ’‘SЙ!ЏЯ[„;ЃжмгЕpЬwUЙ;IOЗњ8FџЊКщФВxБЁЌГ ѓŠџ8ХЛŸ?'nКСcž•F‹йГаy/йН‹ЦЗ~і#LРWк‰ПQ)FчŽЬ!€5В!sŽЬ;  um€=W=IcФf9hexvЕЧцОј}фч Џб/Q0’€ГАLП›Н*„~+…‘ зSŸЭъiжžЪUђфО@kыŠІџЌ 7гЦЏэкё#ъ9Щ+ œ,9оmСљhКч5qЯm!ЩUd/бoyкjмЧ“хŽŠќќ=iIYnтњљ—RЅ—b™‰ЩG~zУIšЌджS{yДюЏ=Ї ЛaУ‘†cYЮotкђ“•DМ5[+ШЇF-ˆсNзјpLъyш-ЃкЗФз#ŠZОI$\ГШм%Ut_7х9ѓ† q‰‚№рећС ŒПЄЊm‚0оŽДнЦ&*ьЎт)„OМЯь§ТъЛЉ:№XввV|ЃэcКшQŸ4ящˆгИŠ;dЯыэџœЙ‚Ї?PJa }8ЇПвуvю%отxІюдяЩьK~mFїГХ9OОX§UЅz„fQь2.bђБо›nŸЄсЧ3А€EMВО2§š:`Тk“‚ыЪЁЏn;ГrА'з †sЭ ћњ дJкГNЙГWж a 3єТ\ЧOю‡ык'€ж`UИЛЯАNbE§вЇ}ШFŒФrAљў&0тБJБнŸC­ЅиЉтkYп$W>ˆeЖ—\лфБ-IM † $ŠујbЈ УЧТ!I~Ј‡*Oј:ћ–pЌф?Ьy5НD4‚wtGBн2ъ7‰’ыЁЁiі‹šlєИTBb—ЂєЋ€ЮТ˜ŠЊSз.ЭЧAбУPD|Sзc%Ž|Ьћ[уwl™ЁpК]1>† ДjхН’‰FаљЬjцŠн‹юИ‰_rymHїGю”—>˜Пй†F^юP9ZЄgŒЫ“ЋwlkЙ…H)єfКq}w“[gIrЎ‡c~•вŽ}(H­! eт;$ЂoЋ‘ёH\Mk ш]Кпоkю№ќfo(„—йQђqЯйцзNaёuЇE2s]!&И=ђ 'XrПг„#Ё{$}:‰ŸxВ3TЬ@ћf•ЫЇб­b‡–Rp(5))%’E1iЬЩ Б!:™8 хХ{Н‡5’ёN[…zмё ‘"MЌЎчЌIOxŸtЄDНы>ы'щзО(EBР`?шayS^ЛЛЫУКtQ†“t@`ХuшSВйщё@H_6бХ–Ѕу˜Ј0šў!raŒ џр-дЁЦР7ліM|v ƒ3ЩјаЖ'/пКy†MЯ’WЂns˜:х“љЦ Мјv_Ѕ/q“јФќЯ1зЅ4zыђ-]юGСЭЌѕЊТf<{ъ%?"W%Л+ОюI:–)Ь{ыЊ5м+LЗ5И†kНЋшКЙz;юї§ќТЃ` SЇЪЗцLМF‰`ЋеyЎЕРЉѕ %АЏkкЫŽE-Юџ‹aКK•Њ•ШAŸC}Ћa ўжоeˆрFё#KП8—Ї•Ў‚аЩ,_а”aЧMхjЫУˆœГ}@I >pzФ‰ъЭб<ЉћˆшZrЈфu}7HћIюХYЈП ˜Рьf§EПЊ ^ЙЋЋŠ–К!>‘ \-W?їзЄ{pтѓW ЊBэ.xTЊJЪUjвŠ>ЬhШ…ћ1G˜)_gF urЭzњQь‰Нˆ Кє‰p§‡ыG}пЯoF9{4ы—@z'џjБ}Џдњ]цaсЖ?]@thqк J씧 фІaкЛŠІ&|sЗ\cŒ‰MitуSЊD”XБJ‚;й@;л)OХ€ЈNфqЕޘГВМ>вгй=Ййл/с‡дPk2<О ЕЇ?ђЄЃХЧ2ƒšV,‚HтЙДпiрFы&NWdkсЁtЂр™чѓ™ЕUс6ТЏ№ŒббUќlчŠ"OЏ‚VЇ:ɘAд^чКАꔉшџ\Ь’ ЁЛмŽ.4zЭщœяВYYЮrЮ­}\ь."ф˜ž›Ц{d?нœЏлO‹ы– sŠ jю)ћ"FЖТ KчœКKTё ЈaІ№ЩћdлўюћK€†ЋѓŠ‚†hммWЁояжOdН]вUщЃўљm˜”IЪЮ+ЃЉюВЬІэыЎ'Нрž6Њ.ѓ5Ж•2•kf–ŠЉ“ЙЄј][й[d ыZЎsз`+ОЎ|ТZJ&ЧуУ@ЉжxL^7ќ,cˆrƒ^€PђФ u„Rz ; МuБђGl<љТg'FТaъg•/"НХЊФmњ9бw—œUQiЫ|LПЉ‘ЈЪbЫtWЇGИ9ЏкёЏ м< ‹/о.iŽŸќ­)ёОŒч>LЗQсHŽР[@ТTЧйЛYMђРГЈЕukй „ћq5ђ)ён0buѓ…OŽЮ–ИPьLDЕЦLecxR‹щ§ЦЂCSЊгцvЫСIhдvUЫїM.Ђh–œ1g№YƒIСE*V'2 ŽС-+tхЫ“ФRŠПf“лЏЌЉœШƒ8УAюPфрŠЫGi+ЏКћNрјЇяї2л|ЛDшЇз`ёKВЯvKБАJœŽЎћоrл €-u6‹)#И$˜kдсiє§r6lЌ%х%ŠEЙD[-Ћњs$іZb™5ђ/њTЖИhНjщ‚/0Ў§‰ˆ§-FП$ЉLfКۘђlЁb`ZŸm "я=Ї—„dф$-Ы^ЛŒ3ЊQш7БдIK^7e"oSe SЧ7Žњ/ŸлДœ,FБ8ЦЁн_=Н\V™иО˜Yт 1OA№рн@’ јCKМ$шg‚ДhЅ:9—+iрЅ™ŠJ*џЛЪТщBяЉ„hH*/.y|cq­ŸЂИRlUЁњ”ЄзЗkžJoЗЦЧ2ЛйД[BAЮЫх>/Za0 'Ы]Щ}ЖX#Цђ­Иэ”:vщ§u-X=є)•‹9EVѕ•QO"д"Ÿж‚naј Сˆ2ѕЮ§ЮNНнчГvчRcЖЇ”Г$…5,“ь&мyOЏц`M–‡ИQtћ/ЗК7Ўљ&V[ШѓkCNР’Mо–иqjIяЛJ„№ш2g˜і‰ьУkNЌлU`;zWцŽ'{СŒњЊНCё'lƒ3a7ЏZАsњъв˜ћXtўF˜МKuVWhšЅЌО˜ХчFяЃ1l`чі›;‰^% Q­лТlyЇНLcYtлУф‹,Jо зйБŠіх™ Ciee}IMжБZЉЦљцНХуMmђ‰wКŒіU>Юџ†ц—mOZб3ѓv}Ц­р-ч:Мо&нќ]A†T№Х{Ÿщ?њSх^˜ee"™‘є@гЈ4ЩюЉОl“Hx‰@њuчi‰cЋŒ эFcсђCвHЧ:rO$оі|ШcЙЅœо—ЄF.ŽкVМOl#Ў„Х­э &DX­.:мx*<0”(vњ–№ЛгжD№юБД,ƒ:$гњ)"Фyr71mѕbFЈIЩŽ’ЂїKј‚пєzі иZ3X"s7'єэьЯ„­B˜YоыаЃВрYa6@“јim_RёФљ;”ѕ›яH@‰"f ?љеBbюݘс d"GЏПFВМЩVцx-єэЋSюФCfс\uЁвЙYН•@yХ="tGƒђ)ЯМЛХ™фЫХPB0Ы‰„a™Ё!­!ЦЁЌжXzj:KDsЩЮўо͘Џ˜ШВ‡"@шФ№}S>"tDдЯ!кЈo]мЖ7иdЗЫ%o_†№5`ОгХ T“gr%bЊ jBЋћZš-Н'dЗоЈŠ{ќžWЖ>цQоЂъќ’ЪЧ iр 3%5%ŠB Ž.Дз‡К”\F ‹іz„,ыPыГП?”k+œ.ћ\еO_Ђz—С=Bы/“љsІОЊfŒЉ3їƒўtВіЊэ}‚ДaюоИЏІёОЫ@жЋїЂt;#7ЂR•RЎ`GіиЗƒАiуT›О|ь\Ч 7‚bѕјє}Š)J9aRДњГ№ЎJ[+TЙѓњЊŠGЂmЩŒВ’у" LшЛЅPelšяiуr'?ПД[Ёй3ъ|бЬХBь,2/іјcє!ъ˜нќHАВ§С'<АlSЙИл!JЏ—…ЁпaёсИѓЬ 0а”(фёїЋ9^фбgѓ$zз XЧ[Э^,g ШcЊЊKРp—9фп“сЎbš­T^м ЎЖfшћН›С}Ќ}* bя„иЅднrцщусвуујqzЈХщNЇо":ЈЕњv#’ъпуЇSfъНZќ [~jyЖвŸPЩF}_сЯщš$јUkР}jF5hIЅ=' щ6§‡г%.ЧЏŸ_ƒвТЅф­šичРфši§Bnз‚*OаВGЫ_ uњqЭБu.гћЪ?Д„дЧ)њљˆ`fqјkЭмт?їC"}7Ѓ}IЬТRъŽѕkј9ћЙПЙђCUXP л ѓББ3‡)ѓw˜+о>…œY*R‚oŒYm7ЩКpЗЎbцНФЈ‹DвЯЕлL˜‹{ŒŸfOT ЫQ&ЭWлia˜­ёѓєОeт‘Я+)К>јЂЇ;кl#—–укжфПˆР)гє5˜mMюAc'iQЧ{‘plцЯCЬЛТЯшкŒ)Џ ј€9`УЫIwяьiOдЭb‡o‘vc рЌїЈfВЃїЅхРдЇXJЋёe†Ы/ЩгgіЈѕЭТsЬфѓ0”ї5XШЂ7иV'P№Ц їИ‹!ьБћБ]ЩЈ ІIZVr_ё… ‡(ОТДPIНЦAЮSхы„Фўp'6щ7 еkNwM$AйшkГWює{Џ—\)ЂЇ5%6{чФёО}„О:„€Ю"Єѓ"Rвф{gЕoO}r˜YRЧ)~ЎђBм8>ѓ№ˆŸфЋVrcrСА5XИž й† ,„ШК{Э‹YmQъ‡4‹›OВD\оВЛЬ•Іx~Цў t3ЎЩ§Š6œ…WіАгƒѕUш#‡eС !ёнЖЭ‡”О[GЗОЖaиBч‚F№ Д4fѕЋ6­lЃєœХуЭЭEОо[ЫŠ8—P)W4к‘й&каЃ њ‹нIlЎз;Tђыш—o3#л?gs m˜r[S4ЂІщCП.ŒдœПl^Cf—Џ.…-ьL>",РАЄxъ;$xy]oS6дЄ Ю>ЈNлDH†˜Э{ЎІ™ыYф5ЯПзіj&Ў­Р7UIШ‰ге\ Ь§)ЩєJJЊвPП†яВЎNu…n!ŒvцлtЭ—<•1`ЯŽ-Юіu%ьУ$etоžFAх‘.‰<™ЉР aфH›‰€п28Ц~•ЧьNаЖг1pШ)Зћ œЛ‰иХ†RUМn„_2sl§р`“*]щПЦDGO‡n#Щ#ч:ˆ& k6ƒmвЦЕ”„ЄlНЕЊЄ;ЃvЪ2ЪŸ/3 ?UIоЃ7ЇЦQРНндЙ™YШmA]ѓ6M&я{‚ЊsЬк‹%Qў™ј|FWг“кМ |Кk“E,змтшƒHу]M+l=–ЦР Єх пŸlЦvЪэЪаЭ~ $ЖŠв3;C`ќќuƒЛšOCТ[pJ…{сb_ZЙ0]r…i-ёѓ|“Ъmlv3†оV<ЇяХЛ'Ю–ЗvЉЩЦљ+ ішпжї ИŸCvЅЪп ЄHщй‹R)яuидC˜фХ4щ?б9N—‰Р‡'нє5 ў &МГЕgлч :НcikŒ6/ЯZw" p§>a=u>”—ž]фIx]Е ОFW3№5С—E™™Ф–›дTЩЮDю')e+[оЇн2YЕB?Ne>Ыъ}х‚cс@>ŠЊ,%6ЄШ/4YšзšN—nIБ@Ž“zхЦЂЛgџŒяп:[ќCЕЫf$ѓKw‡ч=ЬІ ктhYэз—іI…eMИ/!ЌIsЧ'qyccљ.Бъ-ЗтША,bzв@с:Г6s.;qžу)iвОђп.)—>ђГgЅИnЁ‰™jЇl“ЁьaК,гЭъж6CqѓйxJ[Gяљ+ŒОœф)^ц№УNmwMШЩ!pY,eНчёG {”УJ…lO‹sжkгТ;`‡ёЦ1є pцЕŒх2ЕбLВŽ@Mp лЕ=Ÿ• jюк)„ŒžФ|_qќ •^s@hœƒЫр[QЅ,"Кќи:шєи|FЬ1Yy)зwф—”зђ@C–Zсц‰&§ТЎСіР^HNQ—Dgj$ˆішПs’љ”h`ЉKžтIžз“3fќTn†9В’л=Y‡ ‘[ААnЇю Ќъlšœѕ™Ж*T,LяГHYтЪЇУ7ژFVŠ.x‡Л)7Л‘_РV\ПдrUІrвїrZjѓиНѓ 9*Ж м(рЮ=wЁфoŠ5ˆяŒх9bŽЙЈ)8’šhџШ)CЌ$$чˆЙЬƒ ‡Ю{тъџ“СЃР&9wpё9О)Тwš5СN_\ѓƒБКзѓ —…O рP+сžў.‡\ь)xp0ГNP§WZŒZвE1Š`AœcKЏм+r†Н”ЈЫеyОŠЋШXЛy#—]•ЊСzйнl?,і@Л…~E/•Lz[!§ЌвR l,ЅЙюJzdГбŸьБifц XЪЌQо)Y:fхХ6KKnтŒѕ™”‡?OиE Чь9?qS•^M†—cl75}gЦХrЈobrwЊ\M <@иm`аi$уКЃУ•,ІЯф-e9XрEєLі`Lœ`ЈФO|вФRьњ€№•f Ч8Zѓ—qюšlЄђP‰%eLрЪъіж АЭ„ъœЎкеаЮQЗ€УА6nуSЯpЗ8G_-И`ФйFХŽ.A3v§ˆ‰zlйе~ž&„л[gLёГGіRЂжљ†Вb№ ž:ЕђшdНдBељвЬАn+…Б/­xT8>nГ2§Х[ў3…ЮyCvТ€WѓотgrіL uВO+МG,"NU>—]зёъmпс h1QŒЈт3\и0?х4_vŸ•ЃkљD#EaIb5’•)GP2u Тw~А*1‚b–T wZZtƒЌXtЈƒ“2Ќ/ЛДЁ~w{(KЧ—™_зАe:ЌKl§ёe˜?|шRšТ$hў‰(ДцXЊЙ‰4u%у ”ЧЕ ЩЩŠˆБ}VђЛакSёAxMМЕ6’Бt›цЇzмЫ ŠuOV(@і-|мђY“P†/M…X…Nы˜УЄ[‹Ч}†о“є=pv"‘@zћє8fЇЄ ™>7|Y§IХSIлW/бIщЮ‡šEЫBˆкЋ&•ш+EƒE36qŽЃвТQ В=ŽeљсАь№m!•ћы[ТŠK№g <$Uчg/ђ -ЩСЎur›ГІ™hЂPЇРб@Už<у%„хG„œ#eТ˜.їЮ|zьъ^ТЏ:зe№ЋkТз4Mžе!щ›1w—P\—M8ЫЛѓІ™­qyлГ{‰[?ˆнdа|%TЎ*АЦ.iЉ" ќ=—!ёЗoј3ќжјƒш~ .›@BdQЉУЮв…фW‹Šr:cЕЌ˜Ыюœ„Ж4ЉНд%“H”24б‹ѕWgЊљи‡E`ШUОВO˜8ѓФЂe0ж–ф|Э—0s<к№Нр/D}пДs3yV‰щ§{%мщ,О|9vˆЄ„x„ˆ‡JцuДUРђJЧ^ŠŽbЫ>3YdѓжZвЈ1j\€Б]еВЄ~—н1чbBвСŠ:сJ!\ШђЙ!ˆЯЯzXЭ3ля~xЂЌШП|˜і=Ићd •щ'ъ5œгАeNћdeШЛ//§-еZЄ'‰{ŒBŠЮЖбHБBх{\*2Я>йюЭO”їY€™€ ГъJk›ёлV,GХ9ZВЁ„F9IBVSFўи/№E,FС?}U“Ж3„2qо”ŠQЌЂЋшЇЗўŸŠ uі7™№уч+їЙіРŠ’Г(Mlдv ЗQтэрt)­Г9_Бј‡uGълKљїрl)Ga йЭБ ƒ №зВT§НŽГьЬЕZ*лщ EKєЧУR0Šщl Пбр6Pƒ(:F>Юб—ъ7 н<єк\ЩУхсыл8GВЮЩ‡'ЃСэщЖ&й‰–КBкљЄ|тІё–АrŠqF ZykЁ…‘Aе№<љRш/•hP†Ё€•{ыs0ыюпйЮtЈ*›K;~эЧёs œбёˆ…*ћНL„МЋ"EЭШУŠ"Ђ0АPтўй‘™jхЮзт тљvSV=кГвZЄ№ І,Ўœџ9Z‘`=киДžіЃ ~—doй•Ї’ЪТ›ЪПєь;Ь™LCrьN”gь‡QЅYџƒ=]ё|™ЗkYћšGБн ”=иšевš˜FГ‰6U”ŠDЅюƒХ&Cnн§aГ•ЬQ~ЩxИюAтЉчєЉеЪШж:•ч˜ "w\‡?Ѓїƒый€‹№gpH=T5ьћS[ФBжyМШ“ŸpZќ[с!кѕІŸ|yA%Й*Фр‘њx=sТkjнžjаіРbф еи˜Ы<ђЬхCщT]с3=qюkgoƒG ј›ДƒGЦrэе3RГ“#ўС7єZZ(3ВcePщ9?Зё 7$|Њ+}Fš!gЌ–ІЁ6LдOЯяeђJJЗ zШwvвЦg “вЛ ююЂм ’C‡Š—иL˜ЭўlHш,YгCžѕП•— ˆnBц> ЅˆИ5§›0"КО3}НIњё,RTї€ўнv:gЧQbе#†gаr Ё("ЖцКk>ВгM­ ‰5гQЦXcGGй’PЏцХL=уы,6эХћдCз‰Œƒ „ЩЪZѕZТ„у”›оQІS˜лN$э† Є/šПH§iв(RРл"ЦЙSй F—.~iтmЗЪ#.e›Ž@3v–§bЎ­Uъ’pІ0<ŠСЖI;RЊ„Д‚нАІ~і6.§rTJј•Š_б SхU‚Іџ №aКя‘­§Е№"9ѕНЧ GжоH(•нwЌЖеГ™оџrodhJдЉНjЛCwЫhьёз%!fDPfўFъBшц(Е)nйвѓ^З/њзПЁІ˜НаЄJ К–жžžЗg@Ќђ]жfпЩfш( L<_#ф$5Ц І=шНЫ—ЉNлБ=U5”ыѓ‘ЙЄУy“нRгвЋјX§јTnЃ>J6˜ОщPаŒ‡и тП я\œ1жrz+lHpо:TщCї‚Їђв 2СnВkœ•ц -ФП‘& ьаЛ‡TyеЫG/n ,xVЮяЪДaўƒRџ †г‹%(‘fЌ6ъŸK‘ыyи'8FcgcХˆIЂѕVз‘И_е7@yЋfWг+›ћН‹ктЁШ\ЕР–Є•zьZdИ:t7šQ8_ОюŸ OИA)ZџC=•бйќ3:бмg№гїѕђuљЕ}+џЂcYЅАpKj::-у53>0ЩГ~х-ѓј:ьKќiІFвќ‹nЁ8)а–WqѕвЃСыN/ѓюœ‹АJP'"5kЉѕ˜§ыв‘ПГYˆ‘і)EkїВ Œ ћX,йшO{ О$L–Зѓў А ЫНФ`НAк]ЕpІЗэz$”3xGDн€MзGѕЛ›MEПXЛыЛ_ˆKaЅКPˆ_‡W&ЃgљT# xН#НS/ŠШq@О xZh1Д–[дЩЦ  oSl 2АЃмž%љэNХ2L/ќ9ыЖFЯЉжхЛP}ШњщЇЏ-рюm5Э‡фSѕЖtщ<­-[’хX†Е9 eZејMдAлэъЙhжW'>+Y•сKc[CіЈ№ПTz Ќ“г0‰є$6њ\;фYЛГRКzЮJБЎ пжЃ–В1bЮ—ђм^gcHOJ|*`жwyƒДЂО€эіпдйqјЙЕ]МaфoГзL“GЭёак“W‹3уЋI {ЏЮЛвkпIх/E8ЭРб­риsZ@ СzМl:=Й—+—ušV–ZгхУ"д6%ЎšIС љ`\Н?ѕ§*ЯdЅ<ЫW)[Ž#ёч{ўѕЪдЂЃHeМ;ї‡Ф…dёL“ W#naѕЗшЭ№эx MЎ‰ї>ЮД`…­x[эUqŽgepЖpŸєNђ;(Ёяcsч„L™-eђBŽЮ=ЕК›ўE†){nѓя›яEOі~…-ЅoЪ ѓжпБ,hаЯИВPЎЃ .™ƒрˆїџA/ГДЩp*]Йrv‘RU3œїс“Вœ-5QБ}š>d%7фЈbНжœ…>š<ЛDХЋtл–ѕ%к;џьKд' Sк!хВƒЮн і##арЎЁVѓ*‡IЕПt8(бЊcAи7ЕYЯл-б tl0рЂ‘Cпї Јš45LгўwЄ]гВЅO‡UŽig‡OхДv•ЌЏ_Жя1ќ˜‰НDrщ"/ђм˜pXйяbžКGnАЅSіјsб'я˜РгD)ђ§’DѕuXпоояКечОЌѕJЇbЏ[гRъ h)rj ЬHцcДE9,K˜ГІ|–Mчї!јkў ;ЄыОoјХTЯ„Ж„ТвЂCЁљИ0 @5v†ЌтnƒшIтуJ?ЗЭ-Cкn3йZќ*ЎŒр šЬ№.I\5,Ѕп_Š}—д>‹BфTмaїeЎŸŽxє%•Е{рпDб™OJšЮЯД—0ЦО(AуУа-xаžъф3АЏjXЈB к­ЋšJA 0ДIЬ`ж CЪЈFДI§†ЩpЯi›э™Ѓ•%шьBbwdяSСЈZ—~вEАХxЋ#^(эЙЃЙiWУ­xЛgй,V,zа Tзд03wу%^hЫWˆТАPщЁМ]=ЊЅї—ъЂг_ЅПЌљAоF™žЦ˜)._і:ј\gЉ™ЯPі§\Дjш8і$LwсdЅ~t_ХВњс?є | )aubs,‚ˆQ$o›)-GуоК§э—GРYBЃœ“‹э/{р§ёї endstream endobj 208 0 obj << /Type /FontDescriptor /FontName /LZZFWX+CMR8 /Flags 4 /FontBBox [-36 -250 1070 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 76 /XHeight 431 /CharSet (/B/C/D/I/K/L/M/N/O/P/R/S/T/U/V/W/X/a/ampersand/b/bracketleft/bracketright/c/circumflex/comma/d/e/eight/equal/exclam/f/five/four/g/h/hyphen/i/k/l/m/n/nine/o/one/p/parenleft/parenright/percent/period/plus/quotedblleft/quotedblright/quoteright/r/s/semicolon/seven/six/slash/t/three/two/u/v/w/x/y/z/zero) /FontFile 207 0 R >> endobj 209 0 obj << /Length1 2150 /Length2 15561 /Length3 0 /Length 16864 /Filter /FlateDecode >> stream xкŒіTœkЯ CqwЗСнннннмн)RŠS(Vœ-юююююююrић•юїћџЕЮYГжЬs%Й“\Й“.Цю@€ЋГаЯчŸŠџEАЬЬ3+SW€ аТЪії1аќ_јуц­<КLЧ `њыѓп'§о2sАЗѕњcўїх2ЪщЈШЈHвўMјП*O€=+7€ž… РЬФЪрќx№ћ_/џхџюK•Œ­ўгвіцюQјЈнhИџЛ'Јў=.д€џ р№бЧ@еŸЖзcbg2§јbўџмќљџзѓyљiћџ›„›­эпZЊПдџ?Zc;+[Џы?КиЭѕc"ф>цТўџšjџ5Фђ@3+7ЛџЋ•v5ў˜ a{ лџбЪEТЪhІdхjjљЏњЯ|ИЗЕВ*9ИX§ЕfєЬLLџGї1kІ6ЋФхуІўV?FщCŠл›:˜§5s,ьcggc/и‹џ@ьцс4zўнзF{з#€z~sgиПю“ƒР(ќ—ш_ˆР(њqХў‹8YŒва‡Ѕќ€Qщb0ЊќAlFЕ?ш#žњї‡у?ш#žЩФ `4§/bћ№ђБ`ьўXџU-FГ@f#№П№ЃŒџКЊ?i™џ1ј 9И9џCџAат№#ЂхŸјy[z9Z~lЧ?2ЋР26џ€llџ?ши§ЬЩџУеЧ–`tјьУіу ђѕGВŽдg?жИН-аќ?6цKџ‡6лG!?ІЬсЅњx‡1:§)є‡s'7W ™‰эџxdeћЃј_ЇЬЬЊ”ŽљЃ.JћКџЃTьц.+юПI}”ЪХжиХђ.>ђќрcM0КZ:џqЁЄ]=ўqрУ‡л?рGЙнџ?JшёВ|œіќќpяѕјQяПсџЬ–Љ›ѓG9]џо}ƒїќїЫ єšТ.Ю9˜ђ†XW…ДZ=J/№ї yŽIЦ,6 Є+=4 ъ…'вЬэн4jжј;‘L-ЌпI4kОЮKЬуЌїj‰‹KŽ6и-ъШ$…ШA’ жМOAўJп‚g#_>Q]ђ =2УKZЙ•JЄ}}wЅћШbѓNv" „Џmч{ea=КЁ3‰"FyГa$šk%Ћ р Э\dЕхNЃгм:‰{Њњ0ЫIќН!3мctU‹Їž5'+OЦу|4я4.EZгzѓйGѓыUї„СЦ]txDгp•Н2њЗХВІЮmВцт‹џŠ>Б,‰ч@wџBјЄГл‰ЬL~” ФшЧёЃL–S8ˆXоЅˆAюЄ9"%K[œIмN<Оj)Є7fИcЃЭњžqыж`›R)‰ѕeW`ќ Жы†Ÿ.ъ)FВЎу^мЎ!’!дщхO4ЁCmЈгEє;тСЦg— ”1"7џ•ypЦ0.y ‘( ­Oмœ'6MЭ‰oўѓJЈ uF}…игIџ <ЋшTDB„zR+>Є˜Ч№уХсwЦo퉓ё%Йœ`n Њ,я7юЭЋc'№ўa{^ЎwУВf$CЛцФ:у_ŽъњћѓЯFnеьjŠМкюIнЄg‹Ћы†шHU)пxQ­Mb­jЅvє ЮnЬѓ'd“Uœ/ЦЭаДb#EђЏ‹МKіnЋЙ`ќ.Y4хyzU?@ƒЫ3ё!ЏЭŸз$Еdwк n`ЉшyШИУŒЋ8оU\юRљ‡žlxрrТЂе‘ŽLѕU[А†ШYёЪD’20ЪLћ&ј™$šKИВ;4&ЊmMі евАІBsfХioДk…JГ№Ш*Д—- Т%жp­-Ѓ˜Є„ёhа„n{rГrћР;5ѓxwЏM#ЈЫ"зЖіg™ЫАBВРкzмSTB­Є'W“Є…й?ƒ"љЛ–ŸW‚цяп?›]Г!ИЭЁ-,^ язЖЁ\цaVe ьbсќ Жk аgb1 {ФЯ;Тъ эЌ”ЇБ‡2хо вг_NaУЏ Р}ЉС’Y6№ˆiЂё(q#Ш"rсБч8ё?Эќt@AИвtFkg†jS№‘[фЁ­ш~ЭПІыMJКmрQОƒЂ>ЖМцћНъКДрџ)пš^9ГŒžеяGb.бŠ,КЊН>68ЭЊ‘]m•FнDѓ~6бњ/К%їšію"bк™9§_7TЇ$Zі_­КШЫƒ~kї_+№‹y5ВЩaЙAFАтЮ7П,5пFь—›.№А ЊЗfЯ(ЈКрFЈДБnuк5|##i9…'ƒќиŠ ъ>У>Џ6ТoTxЕ4Ђ-OБ>RP/lГ/(Њ;ІњкUчШT}ЄlЊœ КlЦЧm0Ѓ_‹ёКђ j kkжoъьшМј>Џе)ЏСM9"k*jб™бZnќВ%Š^Иb­TP(d,еiьЖтAЃЕ—ъај„Д˜ЫkC—MŠZ [њ)žЋЮІf8ЖgTхљж—їfЬ’V*m$ _O7@luЯ"2Тщ›Mfј#/Ћ*0žщq’žA>Ъ~б=NŽ:uŽt i|DUоЯ§~ѓ—ТЃ|бэєˆqIыѓМьўвЇРG№ѕ_зЪB›`uя‚ЈюJLzRk-і˜ў9gLЗYўUl”{SЋ’ цА љиlЏVмХ%Z–Х­ЉИуlJгUо3:Ь‹Zgлc€/LŸЋ=*њЛЂ‹Y> ߘtJ•ів~ЂSи3D<ўТь‹кёХЅЊ2h™‰Amp­“г CЉѕц*6,Щfпљ-7нjx/m:љ kžЌxбHдuдjРьжІž^б+Ъ€5'K!ШРAМОщЙPй`Щ“ѓ–5ЈUPŸ%DxЂ%Ъd(ЯЉŒw1ѓе6єЊЛнНŸH#ьkФNьkMС&Цї§бsvKєщi№l2mфЅуSе@ЩљOСеg\1Дќ2Ц`R™њ•(љ^Яtк^ŠMќ"3ЕЯ 9q–}16yоИ№Ћ=ДйАc‰АˆмPИь?›З|ƒT)4 п_љ EAO~ќ$L=*iI 8Љгˆ}^§Ufч1ѕ[2˜ Ѓ“SE;ўPŠ‚л"<ъЇРу"ѓˆс fyrЗД`_rHoѕР/МаЎФ m^Џщ ЬЧХпM•ЯЭŸЌУб­ієѓK5Ÿ•ЫКМ л9pdГ™ћ …0Є|Œ<ї‘c=Џ+` -Њ,єzЅы]УЯˆв*c"УиэzШГ€јїОLЇјрŒЌjVо'рС;ЇN~CIљ З{Пп6Њп@3ёЅ…’їќ”1ZЂŸ &ЧИ ЂŽЂєg_ŠЂ€ЛЩ?Јьht{$Йj*Ю:ML8Х!П|ђ+m+EWНЂЯ›•ёŸ @T1љт cdbPKsV‘X S/‰rLь B]•…†Ш‰AЏ|4ѓkьmнШ^ŠћБ,ќЗЅЯОDД З Ќsй§qЉ—•2Жdгљ }жRвЃOtŠ2ПИ|§7ЯHЂЮЧЯgћЛЋ,Јzš=ЖDз-Nš!йќ”pHЖ-иLёCї”ѕфкOcЭ '§ ‘!7Ж}Ћˆаж™ќМžчQo=Ѕ7iC]ЌHЛд‹Ф’зЎUЭ ц2њ8_Ј o‡X|VЈ­œ™ЃЙ“ЬвЕ{Д™…-јдчF,епќnЖъР шхmh#ЦVALЖЋ§m—у<ил+Й‘еZЁc…цЈѓŠЛ QГ‰л Э(ЙafЋ8Бє8пIљyФУЯЙО—VО є;5JЛЙ”ЭPВђvѕŸ~‹‹ЮTйSpЅВџ&‹DR„?‹Ћˆєоd„*œщ€тi2x.Žp3•šІH%ГкpSх:%™вoiljBou} ъQЃЪ=^ЇŸJ%HZп qL:ZrёТ9КŠ&6kIGGšŽ šдАY28ЂХП|…-eњ=ŠЈьЫмw6A'Hт“]Ю4JQ•qј*žPGB=ЊkgIJi№ЁZKжбрпхHЬ‰†С‹и9А_gлЇCn”У]Lм›a]ёТ&Л[zШМЮјщЗ|ї#JФк‰VЄDŠпšFы‡ЛvVwƒ ,&эцСU{А$ёХ;э9Ї{зNдзc"дП™/ЎўœoGDš№|-ЕЫoюn ]š1ќ ё[,OХјўaнЇsŒf–џсгЇ­rїѕФu–зј“ўƒл_ѓЎGЃћ@ЈНHш–u-пX7ыРћX MНЯїфKWЯњ$ŒЙЮ)лOп)4цђФНЪПЃ.НЋЎ1ˆЉxъІчЎ­ВSlwМш‘ !џЖјіB†Ъ>Ff <Ю;GdїYнГкїGяЎЪ/Gsm‰сD)4ДD\њ`X"š §Ж^~К26яу]D›› |wС05qoІu-C U’5ЕеvёЖ™яЃцЋ„/5)кЩpјЊ˜gFмщШЩKеy.Ÿ "пLљz‡ Х&gnєЫяRwavл1SпEњ%1ЋИHjH \ЇИХTБЉPЇzEvR"^$?ьХL‘ŽЕˆе.ЉзН)И ХБЭІлм‘KР›Х‚&Ф*ЎИ.‘ –*я uж“š„іzрXp'“–\”ZђкpЬIЬ=A7Б-‡#и8еУ7 Ж№ЉпЛc_НХЈюЙ€šЗпХIЇT&R мЇGyЈв c7б,NƒђБ™$a2˜ŽїxыеЈ-V#Б]rѓžмЧЬTpж!>žJBаЗѓч3SZЋЊ4јЇRZIї&]@ŠˆB№ќkKCХ‚н< eвЬ#оžœЂAPVd'ŽY­@eѓТЁ˜—ayфОЪЇ”—C$ЅГ‰Ы=d™Pќж X€е.–ЬР’Жƒ оз8Юю"dжЄyїRААзИ›†щјѕ!>з;EЙOН™"h‡Ÿ2ГЁуW›оъ>>‘Џ}ЂKqђFhoХєСLЛЛхБ8МFбvЕpР‘oОл"ДLБђˆј—zбQь&bЖКkš ШЭщж‡2Лn—TБ*+ЩН_ЛхŸЯвyƒе%*&Nзk š9L]{ЈЎ;† ;Њ!•э§Јэ,ašбjбšZ­ъ˜7VAэу?QЇ+gž„Ѓ,дДwTЕ{0&ј5_чХНlTb„IГђŽГХXlоИаUNьэ†cgtўш\>5SvпkБ #8љbЈJь _ёыЫЅ€Яо‘X>К,+X/=О7Ѕш—oЇatq&Фј…ˆRцкrТ“ўЏNСћsXLЇЫ цЉ1,іЗІt‘eЋьхЮƒЄЁ wО‡!vхLьkPУЛS27Ž=RQ—Ђ5ѕn>pЇЈyoJЬ~˜s0Vиj6?‰/lt€-#CіVLŸЏЙОл9 .иІ6G"Бlд\МХсїўжNCME jvђKЎЦ”+—WЅЁRр gЇэ[ІKУіИ}ЈJeуoс ‘їvЩд_–Ёж—ћžщE#mŸTž%jАЏL,нŠњ SY#>НттGФn”Nе ЊiЫвь7uфаМYо1h‘ЈфvD “K‰йђФ8Ў›,p{­Ќкdi‚xpa9€AдmMWPZˆУa’о“ъйцюю"xЌЖДл‰Ж–KЉ сs&AGћѕD,Ož$D™YљОhС™ŒEФ“НœЫŽˆ“іО5Nb­љ›ЖШ’ѓqLФiШэ•Uі№5{•ЃjdqЇhuUЖl7З'аR_eкЧ[Дьk“ —b“ъУэ†Љб‹ MMMA™Ђѓш<3}U‹Є12‰„–I KJЏЂ-`›@)жН_Z„Ъ8Hу]–$ПВY'~2g$њY(,lЕM‘'ЃjЧЙв fGўЗKќл—ЌI'ЁБј'эCф€i>iбK юYLЃаФo}ђ ‚_ŸёHe9#‰2fŽžTЌувmX„гv)№ƒ ЊVpTМ'љЭQТ“Ј,Ќ…WПSz~5Q2у+пЮ7˜ŠЁ›&FъЮqŸнЕ[€“!ŽЋЄс+ЋdT­њ4аѕ‰_~„лO‹@wY…uѓI˜…V!иь˜dЫD‚Fќ6^їœ)glZGA!H `ЛkŸШ#*з—ѕBv_€}*’Jvѓ cZ€*4˜–­йkVЈc "#fBdіLW›ЈЁ%сІ„€ош%*1ŒjL+#BД ђц™j8т6Ѕ…в‘—Ё0Xёh$Йу]Ÿ@; НЂЮGЕД‰ОgЎўŒшЇb—˜”]іАО0ўеRFїОC‡Ÿ"NХuqРЌ{тхщbE+ Vыiя…Й№:Ёњ:eќЂdL^а* Љ<Г{DБчкХ8з;fš1іѕ}зZ}3.šOяT›bњm‰тЇ\7;уу0cЫeХ†BќhЯxˆЫDc1Њmb‡xМ7V:Я\vю>Q–№pdч*œо=*[р/1ŽvG)ƒЛЦ=„­фыeЛђMг ЉЄК…Є“sгHbfZMBП“MTyїЕtСߘ g&|˜ЦЮ9їМў›КЫAТvцI%ЁтY4Ÿ@iЈZ ъТI{иоNгE„б]YvзИєžІ’<хѓg€ѕJBжž Spˆ<щпf№м–П}ЯвxФЄ-hn uа™‹П5†s{мяЋЩЛCїшйЭЖмNі•sAЂсL‰Юbв=5ќMAH|Ѕ:„ѕ]Й›†Н.ъ—h›pьЎWП ž?ўuŽ h1Э„dЂe†]чоY”…Ъ[лН‚С]q.ŽН€YGбЈф–Ущ!БF Fу)ђ>Bип–б]Іi р‹?Y^B§ŠрњЈbeЦQыџДеаЇXЄ7тЂŠcљМиеЩаfSkO…Ъœ4ЁŸІ-нђъяKк?U'SdU#~ї +`J8‹З™ Bв9зк';Ј™Шъ!n}‹sцЇќХУ”dЦž<~=/T‹Ќ•нОpљї7’vV єeЫ6%ЪfЙHфдЛPХч—ШжјБqкCЧНž•žŒ-ЬГфŒЏн5§і›Э–|x.”7–уЫфНѕлЙћ–NŠЏ‘Ox™рd6(,-жƒ™.KU”*‰?П=LХƒ/7м‚‹к4№œЧјTДЗEsСЖЩ­оМJЙ— [AїFsuЅŽŸшћYž№iБАЦК:BЯKU$Kњ=єuч5рнГж1аЯ=5ЃC˜™НIBRЦшцЮ3ёcьБцcooSїР=бщВjr/)Ž„Єѓ(ЪЩс^mЅ0…O3 цDK‚fМС„V{ВзL˜БNPсЩvЉп‡oв7žбOЮ … vq2Џ.?СТbьпчЋqmТФBИUГЬbeУNJ №ŽЇsЎ #ЏŒ 1%aq`мЂАіAЮж:тЎGžЎЋjЅІ8ГˆшБ9lBƒРш-- Ч_*mG ТЂ>"ЭbзяHtƒc Ё[ЁžЧYe{$Юћ=\5t{д%иФ'–о=А ѓŒЬS „o­л фТƒVƒqUМŽЭѓЯXPEљŸхg%З•EгžKo@3в$žвBtрБ8d­er…юЦІCЛN 7ТД–Ssd™ {bл’ЭQ@ТШТЧщMš ;’ž`65lтзuЭСWVh1Д‘UћІˆ%УŠ4е(^‰hфh8ьžШРФа[ЌЯ™‹Jѕ”Жnть—lфб„ЕƒŽ"GcхНlО…ЈЈ.0QЃџEќRPё‡пФxшR}ОЅШžОЧ[счјŸуљXнp•ЛQАйH`!‰Кк№^M†вГПt№rKЪ)]ЎОє…c//wбйъ*Uc* 3юКfрЪН‘oЈz5q=4UdтЇДЎВž4їœOP•Я?"+Ј†їЃяаКЄeОЎg‹Ы+s9ўК К c\Т€ќ™ДгїьўV-~>ѕ9н мƒЃ}П уїУ/ЗfzчЂЬlšYО|с›шЮqщƒl„Zu)ОЄš• ЉЁГ‚~ђо ј-эщрmщдNУI_зЯЉ6’­.§2ЯšЅюќЩЖD•”ž!КАњубЂНz—р€GсŸѕbnJ_SИџ8кШgїН^СИгЯШышЊЖJё9ї8ЅЇпLnlёќ&м›вј-= ЫNАИе4’H!дАfѕнЕŒJ›#јuпЃ‹яСQб(QђmNИ4 ’SиHщмтубАzLEЗХм~hМХ сb™a›vs>4ъmЂ8JЛ:Њ<эRкчџm{jnып8†6М 6+зŸˆ=ьŸ}xŠ€ ПnФЗŒё,.dŒuхYЉЏRu6Ушf„‡дхшёŒp€•[lO9sє˜ЈГњђЛВВифx-ˆОGL“ Uэ'є>ЅwAђŠrXяХЩmНK+Мў8яbeЈQя‘АF0i)‚#“p`Hgѓy Чb1kPвёљКёBB‘ ›Hтм|&вВMўŒЪаЏ`ъіА~‹›2ѕ‚9лPT?QМёэѓ‚F:™ #c@WVK| ^оjb!PЋp…!е‰KнфЋнъЮћФЈз\Ж‰! с=ОШПŽ!%!'ЃтVcНыQ–7 ЙNпЇ™Х9/™ш‡tЅ№‚|ПЉ5lх<зZ€xьЬіkЎ=E bЃв(х~щ›Њ ЕŠ,ЕоЧЧџэUЦ(дq™SЬъЃ›ЂœRЧ8uцОhДJя ш{йЛй^дсгwў@В\7шŽбп>юкё Sі g)ЏˆNђFbП(\тЉ^dњ&,ШЧЏ?Єѕ›yіHD{Ыд‰ŽтэuI”BЏ‹І№Ьцm•ь„УŽЧ‹PJ4~cEЇlœ…Я3gЙЧN§Р}"Љ ЋїSЃQзЛЃgЃ‚тpnWQ(<:6ЧŠЇxGў=4пNМЫсCЏ‚O+ф_}c&ЦЙsмЈO‚ыœЙ.™Luб•’Г3EД; РЯ?aѓёžcѓНЦб41ЁЩ™/WўєоМЩWЇNUІ]{‚у‰ƒћboАWнїв$ІIЕ6›‚›Ѕ/к4hСћЮ$ФߘЎфdй:C#РЈ0Ѕ Жи–т!ƒEВ$Ѓqб”q\%мЂьєК‚TGС ^ТюЅkGѕZо‘’$rfv`ŸЁ‘0rPKдСцPQеftГOFкo}5–AŒŒЪРЪŒWЉrƘ8мЄФth1ФJupКЛЧєЗœїЄЛupщИЫЩ ~Ž%пmQ_ј6Кл/ІUEыfще0Ф™„у!ЮСZЂh§DПЃЫ6SˆZ_@F•I§іƒш™.ЖЖšJKиПшL‰ћ•ШэЏ‰Ж†№3фз $g;GNsѓ8›і  „ЇЕВwИg'у ЙyEѓ4­†ћ9†ИjИmбћŠц!qИј,їw7f™|%}бcyЎЗтСТХ9ЃжіiуВэ>)С H{лžЧwС,~ЖAфЩёЭLNзчd‚~H4‰Ћ­ШыІэХІIhЫ|ЉoЈЛ l3_V; QDrCюcЇ(НW1лЬ%ƒZМ6АghSJR—-GеФЏи4ot”ї•яёNaЈ#—ЈШйZ“9вK@lТ!–LAуTУ-$ѓU‡ИCn€Љ6FˆD;+6y*b{OЕэ_№у*f6WбfРЖ`;ˆŠ)=YJ"ЇФЁxЁ?PН%хoƒсFЮlЅo”ќ]™€;b§]ыЗецжюѕŽуаљH+ЈkЉуќ9cѕЃЁ­6ЭоійњЄо†С–•5ŸuWEЄBїв|м4Юœˆє—шdЈ]ЄO7b#§fНœYб]ёЈрѓцIyтЦйŠЖ]ЬќB3!WVДјЃEфaх…Уf…bйr‰nN dЅК4aЅтДdФL@ЯƒЁЕŽySŒА2bpi„ЇЌЁФ№|g0БљС^sQgпXИaР5•ЪXsнэ`д‘RџоїЫr‡ћ›tmq7яЖЋе:я/ ŸIэхjВН{є(2ЮпŠŽёЇЊ–ш0˜}iСн˜;rŠžlўВН1QJХњ\ 1œнјб3VБс;g]CМ]пЉq%– вМњgE_w@^Ъ9Ž>4Н~!З=ш$c‰qJ4„š‹fЁр&у*ЇЃЭ&<шNЙin|Ы5иФъгМ-0•Ћ™я й1sљQ|­ЦЂ8YN7lЙНњЩнУwїŠ<џэ Е€jЯЏс5\dhЅ$5G‡9ШЦ3zŒ ш 0ХЦ{ HUHиЯ™ ЎЗЖ&X&SщKыF;еѓeрQWЯ>ђ+ЄaЇ\зѕO4JмЙR$хžъˆЫЂFфdUЎ_EZSІŠЙqЋФ++њGдŽЎœy ЂА3G*ййухЊZсxЈX э ‡{siJе_бoAxХыЧ;ЙYоIГf6Hq4У{Bщ* дkЪЉЇРЌї`ФУ‡јT/\ОЗ{UOЖkДC>#s ѓ–Кую_ВЈXу&,š>ухќ"{`mE4WIХр)]ZЅBЧP_Q8#W‘|Мш‡EиeиЂŽёКџI”G‚-…bќ5!+8k}bпШ<шМW§€їЅMnщфšѕwAЭsze{”JtПXјZнž?эШiЊіАТNOjw ё%Ÿ]FЌ+0aс§аШщY`8yЯЦќ.sє\yїNЗС,iкь”Bœ3tDDxМ/ЭЄ№Ш&:ї’a:BŸcШъ7л8Щ‹ѓКD5Kьз-/ї\гžЎISдЋFYЩМЏ%5ѓ.YМљ~3™ $ГВјХ#IЅ—5ЧОRЋЯŸzUЬ… I‚S–BкСA}уЗКW ЉКI}РWŠИn˜ЋеДQrƒй…qЋЧ№ncƒтТдІ•0№ќB'9oѕЕhjб>ђАЇ3ю2Y?4бžМnєICYўBuTњ~щ '˜ЋћPА,qѕЃКAAop|џГ‡YCЄфѕ(?Ѕк8шГJ' §kyНВlgч†_ ђЛhИLЩ*1ћЦ™КuIžъtЄЄ­OЇ%&,O(pШђЎЏМ#ѕ1њ†5Вi—^сѕ;№ьЪˆ„цИзˆYЯЫЦьь$№ }2žGТ љEлЅ46|mљ2ENO/џ™O­œх1х—и–EљsцLЩ4я_xЋ…†[( й‚iЄЪ‰ЛMШђЗИ’Њ]‘ ЃгіўP:f‚АфŽќ Zш'Rѓ„bЖWУЉc0ЄШw<,NВЏxЉўRь†Ÿ#–7Ф j#Чт:U|№ VєЧTЙAЇк `EьєjЮшoPztЦvcsMе$#зDю”МЎTв/o%й?% |%ІНŽœp€тХwЖlшx“гŸFѕД;]НЂ!7ŒDђя ŸWjƒТ4Жэ`Дел—ГЯ{ЛœоњѕШU‡Ч^Ѓ9šЅлkwП0›}6ЎE„CHћ53–УЙWгџ"zч&69Ї–Г м†2Z ЁT™ ~Щœ&ЮvЋtхm…фсiхЖѓv•M/ЫНЫl€‰ќufqтжžч„ЯкМ<5{9(ЦЃ.е“љЬ„сPїЁF.Š^XЯNlю#ў<[>> CPЪљЪ=hњ–}'ЉІ{;уYUм˜УбT’Л”жg?АН|вLUrЊ6: фЧ†cˆь4QшGhOь(BС ,SЃ›м‚DУwЏˆК= ј…5ЫlT/uльБОхзŸ˜тЈT)їP% N“~НЖC“(сљ^Е%†?ШhЯ™šD\ЂJ‰Нѕc”#ЈТ‘;x‹ѕsЗЕЯ%ŽЭYЯЊ,У Ф|2J™е…f|џeЈЁЉЉ+mдŒцЅ+T”DЮ4/q%5jЇдH ЊНO=чї‚ќ•С^^?)жn:vмхЇ#’Ћ\ n7‰Œ~ŒцURЗоч8ИЌЯјzW_‰ФбЕFэІвпДф.П—гX‡{OJХQГN#ЙAтdv Ѓ-д*иuмYЫю\ЖйSг—h~5O€Ч~v˜љ–ЖZмeЋoџ­Šч1Пщќ““‡НТе’ДПЩ”mBЁпР УД,Y7WкјldGgн ­ Ѕœ€ЦЯЄNsЁЪx) M0е yЇ{ ЁМ&њ6FIžŠ"ГhV‹Ќ•Џ( бХ)[3Y“ЅmTp*щRg„j|ЙŠA!=?њŠТ'‚š|'r={W§–…}јkoщРщ/жzё аœ>(G0sЗ/ 6МдM†H8я#E‹эPBъ5=ёG„!њЋ}—7^/іnгќ§чРЧ!Н(Ъl§]ŸрkЙШ™щ:2ЎЉFM XfаЩЄO‚шrс=яьч$Xий@Nвя™іŸ4hEФMЮЗl •ž_)=ЄрkБ~Ђ“ъ}З‚† \—’Q˜ ЋрZ \$l[ПЂйЄv3iНФМѓжлZ–Pkк7ћЎЯB2‡ўR Вle$XМыР†€‰АяТиУѓuaC“ЛG‘Г=nˆqХ/Гј1ŠЗCЁАд3%гэ‰ahтlAЭFpmэ_ЇЧ8яzьэ6Ј"M§6' o_xЇпЗшНіОIJdтЂМ6š/ >%щ_ TфП+-Б‹ёŠo@ ”j+%t2†\‡КTsвщЂ№Q,eBёnKC5Щ ]z1›ŸšQзДоC€Ш—ЂиЋ€ {cAš ˜OeћСd w5%В#а“Бл5v{ pиKAп@яTfѕф)S9гPž§:ЕБУiv˜тЙlв' kdяВ|Н.ФBѓ”œ^ѓюќњзСF,Њ=L1+Џл­b$щТ,йkDОulWТЌЋО{Ѓ”єs…УЇй*Ї8ІЮЁYjb,хїœjЈЌ8ЉrЄ9:АЏiЬщтlЌдТQ,ъ­.ея2Щ_{ЩB–ИyX42‹WC#јєьВ(‚Ш„ LНŸ+ыuD—Є1‘ MыR_є3еš Џp,Y.Д%бjњœлБoKK œћMv§YЗ§х №u tB!њ)6ЮЎ ‘КЭЖgттьќнЭ[aš ,<V|ѕzр9‹ŽscнќžXІ4Э№ i$%Еп…7W2„f—|Yф‡РLSЊ№XŸXХЩѕщ‘]Э"т@ХD(ЮLŽfєƒŠЉЪ;]№ЫшгH.єь/ждRГПЧхћќ‹ЎЄ‰™Мb\аЛЗŒU”`œћ`ю6тeњ ѓИХХaeCYЬ5…•y яHб9ЉюVпЮЪтОщŸэš@–nђ&sЋэѕе t•„ќ˜э,‹[O@  Iэ.љjЃ[Kѓ&ЇКК;nr‹KЫл6GБВ/Є§“Z]wл`3ЬZ9vM Щъ}žƒЙ{MŸ)Hну.s2S-њC.0ФЫЂЋЦй­(0ж›{f™є‰‹ФИMѕЛЃMу\южнfЪЬWaЛ”AuЧcyZМ™žЫnžW|+cР.ZIьhЪV•*lпф {‹š п)вЄ§N`S}BDg нPYт#E|'T=’I™њ5Ÿт[~Ір-|%оJюЈ{РzячЮvзCIЫф[шЫЌЮЇrnвMЮ)9ЈўxnНC\жх0О+У4ЦтPйЏxгі|чђіbm8Ѓ\F&МЗЂ<‚Аd™О^дяЋdтvЪћl Юj…Іjяж–єŸqф_jMt•ycUц!бЫB*š1]хЈ^#RЬ;о7ЕрАf Йq!\8g<.)kЕ‚EkчнЃ^`}Jѓe\ЙЉ.”ђч†œXї‹TE`™" SF}ўBA‰SъPЇ.dжœCиУ™ЏЯШюСэPНWMШцŠ)Ущmi‚ZMVY˜Ѓ rŽKз{EB}|’^§C"…]8РЭnYf,)ї‡џРЄЭУœmЃЂч2A]ў-Т§ kє%61Xo{”юWа]"zИЕgЃfYyє|‘њŸ“ЬљбyОзЖ§+=^BtHзм,ЫZнУXaР`"5 хЅдўоCь9‹Ћ;ZLЮћљ™v?4>ыЌdЁf0О Л&лио/6оЏrЉucK:†Ы@dZI-—lкoЩІ]jІЋ‚6’`ЅЯСЬК—HЪMШ>wС›sSXЂ-ЧDА•кŸЊЬ˜$5QлЦщ4:гƒ50ѓўAs„сRc˜у}”пcў>I3‘F'с:Тюc­ЇЪŒ<и–іп—~јюЖюцЅzsŸ†W[э/…Иp_їХЮŠԘ“ь\Ptќ&)bY †Kq-ЕЦїYЛDњn4бТ•!vY'VyjЧ]\ьxВgMVC-™4К5Ђ)>њіjQx=Ё“єgЁeRy™пk“ЧM#у“|еоѓ&чjзю™hV=ƒзсЭ!Щфў*ъЗMwцТЉЁш TХЯ}я)к бм%9ЪPЋђNЄ”ЃLЋ4ЊрЄ?ъ=ЄаШ1ьђ0д ѓxП> G<ЇЮэ?­Эу’эkq[АЃ[1VОsnЄЖ­sчU3сж'š8œХOЉъH бэуЌЪЖчCюˆt6cѕ9ПЌ<а›i1Ž њ–К!”€0ъ~E-|їъ;t8G2ќ:В('!БИXˆбˆa)4І,pNpКъ†2Gkv%сQž^ЗRОЭa|xЁшоDсКqХ[Ла}€‹%§‚ЇjЩqQЛѕХ&*)k ~ і‰ц6ŸсMMђЇПEЇЗm†.јoЬѕшЄ<1^јKж”|pauЄ‘—т1с/ЊЙЕL?њъ_йikљ3k-P+:Ћ5Їvš h%ѕaŽaІI7ХQТдє}ѓF^UѓнpЂ‘щЌС;Vћ§ѓЌр зX6ЗИP*Ygљ}уG_Т№)%ЪЮЫ ќ1'#с]xљl?Жш_НЖ@`№уд„eП"Ў4ю“В]ЧЮˆ+јЏž=gž№1ЄхOgрЎejHЗЕƒиаqЃ-сš• fAKнОЛ@ШНŸй<: ќ<чАА)ЅИЁє™WšЖЊчXhСK3эЗЬ“>i\>еЎQq3vб8F§zЂщ#И“RŸ‡—$_ ;{Ѕ&фћBОџgс•%в№Ън_Ir#/JŸ#вИŽбкќ ПsL Јвш‹ oVсy45Цжт‡ь- ŠY-,ŽБxф„Э„c&4Y7&?еіdњŸ7pі`И6cWж"Ё8Хп­Go]NcЇL[ЄoEoT6Nн<> СВЫЮДSтАц|КУрTG1 ‚ї?(ъmш$™АsSИЧlпЖp=Б`ѓњ7DbZЉЫw'?м,—SыЇюerBWЬЅˆдБјр†-˜Mк#xа&ї]uёž.ЯЪУО~nЃjэѓЯ*єtѓАBB"п%PЄйC'чET+YjВ.ЛX{џћўлѕднД"”иЫљ8 *Q; }№gь‡й!lx њ‘Yђ2’ПвrГ­bGЕ]ЫYэœ…Кw†Ž„ЦћОŽ_—Ъ~Ук#y] Уќ OЊ-6ОК7Ѓє№юBM Юe%?_,\ъЭ^dжŒьkPƒOЈ ˆ!Я’ŠЦЭRПё=Щfћ”биЪ-‹0ђšк*кОЃЙГЖ+ŸеЙ1‚žIеkEŽэIпbIИHn‡MЙФж=йт)яе†@з ёu_ЁгoЕАя~N'ХВ2Виёйчx”J'QUЦцђˆАЋВдЪ еlЦЖнЏћ/>„iNІxЃMл=жЏR"—ƒЋš> т5XэсD+ЈбA``”Ž?  Їm† @_#WC,IэЅbє„ЏІUŠ|Њ•2ЋтKљЭВПрž-ЪœNЇы‚ьфхUсъ‡”R!ХиЏіФбLПОЄJRЧœЉ~*‰йе В& qfђ<|ДWгxИ}КАiT—€\WєMrS‹ю`R”єШВмŒUњсЖРЮ рiВђё-пЄЦ’мCЎ5єb‰ОП3ŽёN’rУал}•dб­А^Ј’jŠХLрбїq'ш?јR™RБWђ†cЩ [жщiФеj­‰–(кС ѕ%сЪZv‹VЉЕКv­Sk2Yк-ІоЂБ'ZYБdƒ“т/П ЊвЄПучl#сувЯƒ}ёдoкиѕTЙцёeАˆЖ M%HчнљžЯ?щуBV}#‰ХpЧ "š1 §эuЧyayЊиl–Б_N …ЇЁЅ“ЕЙGЋЌњэ!;zОJœ€ХПіњГЈS)щћ††юъaѓКyTrЬe,ћХ#Ц=ћ^ЙЛцЮjуѓ7ŸеЇŠщУЬ#zўТ•дЊОеа'и`IэрHЋ”џ'UЊџ2]гл…˜sˆЭMбЪўk’,„`&ќIОы‹Щь­Ќš ТДB’Tmf‡8ЧwTз^ƒЭќ}F dХ"zАL06р†жO/,’ЦPQMBQэ ћe endstream endobj 210 0 obj << /Type /FontDescriptor /FontName /LZRJRG+CMR9 /Flags 4 /FontBBox [-39 -250 1036 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 74 /XHeight 431 /CharSet (/A/C/D/I/M/P/R/T/U/a/b/c/comma/d/e/eight/f/four/g/h/hyphen/i/k/l/m/n/o/one/p/parenleft/parenright/period/q/quotedblleft/quotedblright/r/s/seven/six/slash/t/three/two/u/v/w/x/y/z) /FontFile 209 0 R >> endobj 211 0 obj << /Length1 1701 /Length2 7533 /Length3 0 /Length 8634 /Filter /FlateDecode >> stream xкИT“л6Œ€€H‘щ=TщНщH !zяНї"JW)в‘.E:J‘о‹€єђEчм{юџЏѕ}+k%я~fц™§ь™йЩ Нж3.ikИXCrЙyEВъЯŒ€М^^~n^^>\&&] ўЧeвЛ p˜шyШК€-‘(LЮ‰rT‡У*ЎP ‹ђђјxyEўv„Лˆф,н жun€ Fр2ЩТ<] ЖvHTžПЌ 6PDD˜ѓw8@кьYТъ–H;А#*#Ш xAРHЯQА>ЕC"DyxмннЙ-мp[ 6N€;iа#Р.n`kР/Щ KG№iмИL];т/У3И внв @P C B\aж`*;р™В@г ћЫYэ/NРŸУЙџа§‰ўE§ЖрŽN–0OЬ`‚š jмH$'Рf§ЫбŠ€Ѓт-н,!PK+”Уя­[ЄЕ–(…є!@.'$‚ўвШѓ‹uЬђ0kYИЃ#†DрўкŸФ BЛ'ЯŸт:Ррю0яПW6˜ЕЭ/жЎNхєtЇѓЈvVН #ЁxшЅBŸ;дKAš˜ЃђЦ,#x"[ššР@QшЦ<a!<9^аг”иЫяZkЋ!x_гoАЮЕ.8%žл1HmО’­{ЮƒO^ŸiЧY™Ю(УTavвŸБ_СЭыФ|D РЊn§vЋ>/.95RCџZƒэЬoЖ6B~f›•ф3M‡>щ§ўJFH Jы4`c№ѕъi*€„’‰DKCƒо~бuр1'їЯWнrCКdиёF§ЇцўŽ№8у щX`‚aKжvзVтeС“ b}vy!d•ъx›9[|nќИПN^.ІVSЋЂ˜Б”ШєCМ>?aО.ё]ЕuД {FЂЁвуD${Ѕ4яОО|)T/žњ$€зялШС9эxЂЊхћкчwЭЌ\xјpЬTѓZэ,Š5XT Кэ„Ћ ЃБРсЉљ<™=s’Пчy6Б—q?зkїѓ ЅЋ#ŒЁ‘)mcўЫцЏiZŒ{тЈ3>ŽьtЖАЄЎ{(е^œ`Xѕ+Šі2„BЫытeчzH#ѕLz,еšыq\:mъŽЯё€&Їb+NfЕћN—eЮ2r€„,гЁ"ќЫoе˜EМ1ё"є§х№>y€o9RФ7уFГГЉУ]JЊ~}TАmТ]E\}ЁшtpвI=GвXEЭЃвы:Х( RxrщІХ?ћЧPSш“Ї4М­jЯo{ндР™J.HН+ТH`Ёј(ЌžИР(~rАРPKў@эšoйœЏсўл†RИRЊ7.ЬcŒтaпK[Г+…OџьфТ@ƒŽF'K>хАh7Г!~§ј’9e9JЇpћшЙП1КŽ№­BЎеЂЗУОсP|й3S@QсЗVœj7›Ix0‡Э0yŽњі.]Ея)T’Ф>САїжЬ_чЭši™cи бЄ8DЕLГo,Ž^љ~Ьћёї—ыф?uˆoЬ‘уb™mƒ?2z]ЅX—!й‹IЦяыНЬёіYўљSлз’UЁŠ‘кzєФѓ іы1d’’tIЧл%БjњЏњѓ#7јВ§ƒѕсещпмsw’$;ЊSшФRrЊФf%8Cz–‹Ы[Ÿ3”ŸзЅf‘ъьоuг‘M.ФЬб–ГУЅ —2чЬэ}4Cит№рQЌ• t]ZљLЫ НЌ:г}&‹ЄШZЙOЩЫtЪьq™@еИѓЌ_OKЙкЦ[uЈє3‚2oяГQEsў.ЯŽ[{ќАI~Ух4mН“fОдvІRpXђƒЇѓZ,q*ЏОљЛ%Nrі0ж0ищЋKWoK.&;БO…Л|!џІDј.+&KНжH4;рOд]­~bг єд. nаd ЉСУ+<О6ЦDz/DяѕE’Žз+’Ѓ#›Mя№3b9ЛйуЇ+о™™K2Љ[SО{fr|6,ВGžѓK•цНяЦпI™‚hŸ$WС(…Y‚)жюЈF\ 8hŠ“эо”KMщ’JfЁœsZpљшyВ5є‰Lvag “ЏєX;Ї†І7ЦŸУ›‚ЬО0~`ŽY=:4%~M_љ€h` iчIXZ2cЫЂз]э АФ?B_|Г73RНј(АхCОXќFъ•ЋкГH\iСУL!qтonАo™КЫ8o3󎆛BGOKILyА>sљћzGŒієIхЇqDSgAю\—‚,‡œ`}п–kЦПOz—сk”Ёэл1!ЮЫ6rh _5^? ZY}ЃџueЈ7ИЭВ4ЫєxCr’}їа ™MЮА#JМеŒpы0/ЦвйЌIx0УакЅзv:Нзž@uкр"tкм.VXmœЖбжГт6M+т€чIїЈV)ЩгIŒRЎяЫ2 йžb˜3"z bњf.лЪKQV’)ШЊЫeЫј‰эœЫёхШШ3ЕћsSa^і\sѕС˜k .ЉjlоњXзT,Ч9УU#'ЅШg%}Џ ­%чЊ I1IXƒ‚CЛN4 j>ю*L?нё­NлtЈўж‰Н ГЫњurиŒoš‰ˆ]њъzЧ1Є -fˆpъу џДS*@ЁНкHњ6$пѓ‰OrќW7Кћ~ ЏѓhЛRфkAqяg0’д{ЖП№М=ЁyДœХИRg…ЭhЩжlКiь­3( љтэряaчхšжѓЅЩ>ЦЄpјЌWВЎ4шOўXˆR,yRЕЁ2xш5я’gО+~ЉШрЭR&0fЈ(bm#яL­ лЇ№т™­Ў›ёSы4ёiˆ”ЛCл#РExОШ+ПыTEiќьЂўHКw1ќ NDѕЇEŠщzщ•”†і$ДЕjHщ:пM7а1Є^@ЊЩ^ѓ ./В)jEswјNN{ІdЦ)‰‡0ФŽtю1ђвLпж”wъKBк<ˆє:ZвгэгV(a}kяЉ›иYЋяиЛ–ОHс\мОBoWѕ„ФУ>П‘ћ'жч3+`хдћxЪйP9Е}mc ўРг:-.ќИљА…хщˆQЫ˜kШsF“'У./ј8н:ќЧkx\šЗЉl™у †Т=/[њ‘іW№FДёЛіQ\—ЛŸ ?П…>‰яVuзЖ‹uЪaš‘qOEEМъиЎТSгє;ўt{uцˆџj9„oЪєp‡›ЁШ"ЁЉдќіЕ?хŠгЧ“ю8к~llDК 'Зap<ѕичwl?жЈ tѓwбŠNЌЊyххƒQіsўх8T0^/В2Хw4‹tЮ‘тЗ-K Д7™МBЦЩUо7LОІ,шрG*{ђvЕОтЦйm’ќј5MАмcљ‰ $'Ї іђ’ŸUѓnћ.šужC0aи§зФc6"СьT;†Ђ?[з%z›ГDй?ЯЋби Ž%эIbЖLВу ё&mт ПЧ6ђU:ЩЖГR•}+аPЕ§›~‹зŒёб 4ЭWЖ{АН“сће“КЭ)Ф™ пд†TЖї7Эф %з&EЂˆЇ/fыљ:ш<œз П№ЩFK{Œu.ЈВm3ЊЕхЌш{z5ц#~“…њ=г!ЈщЃе‰ЕШљQLчЛВšЬŽKУaы$РYЩй.юc_Ю'H,л$œ§s/i?­Ђ6}ššШŸ{“GЁ„ŠЊЏa€З Љ“Ги…ЮЭ@эЦГЃЄh#а x ^™rt:мS ‡зHUV-ЅоšlIљѓ/i“nЖЩаъћ1ˆШ4>JАЧ6•”oМ№vП[aN(ШZЈАg;оV-№B&sc%{GКЄќСb‹ѓћсƒBК…ѓЃЕиQДсЏFі€яДlШ'юН9тœzж'tМм|—њЅЫыb“ФЙv7‹яxЭЕU—БdЧmўЇŠŒЗyT!…[УмОљ CїS>”ЭЗ*|ЮLUVe%‰“ПmЗЁ'ЛCЧ>аRЦХГюŽеЉѓЄ‘Ujf&:Ы Tп"еЉСЌь˜ž;їJТў“c*јGПдєС-Ә΍вЦй‹'d“‰wŸzžхhИт[І`o–ДtsѕьЃ#5j Л" |я‰ъЄ•MУйШдЯ§ыžЌнЅЭРj)ƒbБА2у'™KиЭтhzYЎ@Rh„KфWЬњ|ž. uПN?mЅЅм­|pЛ5SЦ‘"xPї4пЯ“Хqё4So3PФ‰оМНXЛљыЯ–"lХš§ХЛшн%Ÿ?к›ж<€ёJЈф{IЮШэˆkœ…оiБ‚сгФz;“YБJ0Ьh@Њ9HсHРѓ*юэС=“VВ‘ ИЦSћЧk87,Aы]ЭРЗ$гХ|щBŸЋћПMБŠNƒуЋ$OBУ–IŒ3hU#lУ1KЛ7^w”Ў’HХфшОILВXž00ѕЈњXhЋњ~/јД|ш*–“Iр{ФpнѕD„ћzЊИiнŠвMФс/пЦ!‰з'XС 96lа’йпSVX•ь@ІL'`=ггѕиѓЩ:š~/з–t0Иp(,(mA0Ќ` ~ПGSє(‡ДуЉ^ёћ/пžЈС­эП!О№…Kрe>ІЂќ‘6Šd1LЕ&сЎ:аXСТЩДŽyтнmzу蹂'œт~ЯЂмІ/qЄ…ж”nбFшaXFi'7tюp'’уЭLњLљ.­Т ’pђс.{-B‘ЅУЗ йэЖЩ2Q/b†КgДітŽХdЬДу5K“љЯлиeюѓWЛТš0?,(їlнц™kbo,&pщ2?.Xљr‰jѓtЎЊWƒr%Їл{ћЖЦ*kяаэи­`˜FYДнЛоlк*7пт{:zі9­‡“hIнQVi2œSAЁ’SЊ)ѕšI=Q9h~YT;э†6љœВЧjyДѓP]_ДŸW№vˆУAy•Я@DТ&ЭЗє€hфЌЋю˜^W~л˜o_VдщУP\ГvМ—0…›злgB:Ўe—‡gє€Дšm.(ь@Кp“ќ˜Щ[)щ9ч!ŸcDТcЗP)їЉ‚*ёђJјєнЯЛvХїŒ…FШCб9чGэžq?ˆ'РR!gљPyк/^В2ыЎБњЂкZ&ЩxІ)И Етоi>)ЯEЏ:Я92Р`Ж:znы|#Т[e#пУ*цФ ~гoњТэ ˆи”и\ŽКЇyўcлтA?NБSR†w§B‰В™lšъЕ,{х Ч‡ихГ§Я&пi_вŽЪЊ%ж?ђШpПїНЕˆ&TЁ~>ћ.3ОCШŠ|ВФч0Ÿ:1 LТn<ЗKІ3КЏК&Л ),г§ 0zƒbКЅ}ьB9VˆgдвЭcRдеZ;ё‘ЋБЇљУїКж ЩeЏЌ8жл5УLЇЁпY„м—… пЫЕЩЉвjbSД‡лdГкJЙ›кщgt˜lљћmЧЮ7iЭЅљномы]вЬvЋ ЎуЛу†‡ыuБЊ[?1Р;3їаъёIі“l/ЯсЄIFL0№Э7‡IСtkщ жюP)яёЛžm+‰ыžRkнЗ z‹8ПџRшTыyЇ<ѕ”Б.…в3{Ф7м•* ŸиOХсВЮЧќжтКВѕ­у3њC†џ)‹ы^П)НФ7ўKоšXВЮцWf“яRШй&3ЙМ?hЦ7TjN]№щ”tдz|киЦЁ‹аюЦ9v—БI\jО~vн”›Э№Ѕ šmupт%жP•Ёь9љ\ўЫні­H'—uМRXR`ц/љS3 §‘ШgЇk]L4ЛlЈ|}gп}H  єТvЃ@#šXђcт&QѕzЎё0?*d§jљє‘ќ6ч2XŸoŒX\ NТі+PдЋџ§ЕшЅо пhНD0тЫЇdТ6mƒЦ—Сšз?Gи5Н.ЙAѕGі ”r#цЋ…йщщa’ј-ёmс)Fф™5'gŸЖ8Ѕa§Ъ QЉ<9’WƒQ™‹јІ–ю žйЩ&t$йьЕRЈЂ Џ‡/˜ЦJ'§ѓyЮœЭ@оU—жях*ХДJ‰wб5о>o“4`йЫйА*эkІћШ"Њ:fсюж%I‹ЇŸ§f~‹wЂ”AUyе;–xtCуж§шЋяR›Ѓ1žђ=a~KИПМu!1O;ЗїCыŒDb6ЧXѓu1эЫЈdыFk…Щ6—‘Ё<уОЯ‰­ŠЖŽ хѓеŸ2 uЌМчпЈPaУ–В%{ЯЁлqYіqЏј ­9Ќ?жЖ@ИЌЖ“Ќ™йЎ‘"U+яЕЎфТXjЭъгxк^ЫŽх1‹„(ДbрaOFd72—Oн”Чx КшšTВбШžт‹#УžР-ЃIj0їљWгЋ­Ъ)яљa HUEеy`;<ŠПBИК(~—o1џўRŽђБ\E%“qтэ…љ‡р„ГUlй;œЙQDЗ эЗМ“ ,ЁЩR~ЋЙ#aQХкoїГКиУЭІоєdKrЕŸX˜bXяjиЎ‚‹ћˆяЅ,‰u‹‰K&KЛi69b(ь8›AЛMї”–;˜aЂ27щœ=Щ™бJ їЙ E‡ XH"ЮЦГЬњ.;ЙДхgTZ,ŽяX2’bŠžwз;?'y(Иa <ЭpЋ 5Е›?ЃZ;ќФўШЙэЅщ"œщV‹lN/бTdТK/[ЅCp9ЈaМG0муAш)yѕ2яžo’јaќЅфь&“є Q/'ѕ'aЃHЪЄ;МхиŠj ‹œq)—p;!єC В‘bїнˆ ЏЫžofЮНнœ^”DУ'хNћиЊfGOdР0ЧHкgf8ы˜—Iњ'рѓэннЎGЙН‡•дNpF:nRm*5“ с“ GўЙАIœ,љsжцbg"u€^ZЎЫ§сZќNVГФœ.EДqIАћЉКс'КадЃшRЖtзŘ*ƒe^‰цШTGŸlў…КoVc† №YЯƒ;тeпs‰dIд”HЂщЇsl•œyw‚"§ыHkŸо§щКв™‹Ќœ.ЮBяРЊ‰ЌЕЅq ПŠVYІцФЩŒђo•Л8ТDL –ји1жpЎ.p_Є”ы1жlЈ?ˆХН1Ѓ;Ц1Л1Рг‰Є54лс‚=SИ{r-fћ8œZєЎJ›_ыїн]ыˆ' Мo;lrcHdЋnz†НPЩ*—`dПьЎЌZц>ЄbЃзЯЦ/њ9˜$ћыfЧBŠЌі} 0ЂмЙЌ(g.Tt.YЗЦ pєCвh rюЛЦЂыVсрЕ -_œР]Sh‡.Й]Щ†Я1™н"ќV{јќW"t Ї^H˜ШIчVМ|Њnu;ž#-a{Ћc Дь= ™<Љr•^і|ўЩтXšц4<ф!™џЦрG iлE™єOг=дvyb­ХAЙ шУ…[KуФЃrS„&UГjє{ГД'єОJBЏ& БЕcНй™јёя)ЫЬШ­€хIМе@QŸ$юуЪЅKмТœ5]% П‚Ÿ‰MЭбo1І EяЏС9y:ЭZл*2EЕ ё ;щF.ФHJх‚jєяЈb^.ќTчгU)оgШe5‹N^‰onѕ6F'o[CЛы№ зŒ„Hъ=њхiеЇќКјёљлЭТЌ3ў.я/ѓE-w›Ы^bŠљU8ƒ?s~S2Ё(ХшtnoœП јZFаƒCќCЋЁпиDTb,™йМЬр\{ŠІYаХШъˆњ]еЧLKж Лj%{|іЯ9в5СДФvьХл*•2чЂЌ†ц‰ЕйЋ(їvЌъ}Џ^че_z~ŸЌ7Щˆœд1ж,TVуМЅšCЋ5ЩQqёћЮFyв=џхД™ПZѕhЛ™ћ|uЪПмKлt Уx~a$‹Ю•8кЉŸ2Ццр&:чžp~!Ў$єД[Еif(1•ВЁГ9$Ќ„{Їйв4nF ј\GргуЃ с•Ш„SЪUV# Š[аc8щŽ%гњžklф’ЖаEЬ™ј УуnP-Џ ќХGši “"ђ‘ЯtjЪ§ІНйЁ4ёв$KВ}‘ 6UЕ9мжwrР%ЏNЭЃлф+Ж1•4х#{w…`!љ|Ђ†(ИkŸђШ’]­YЈ3‰Ф "­ъсК†аѕОђѕВиЛХь б‡˜ѓqƒ›_т‚0jz\иRJЛШ/4kіmЁБM т)“t 9›~ўФEЄЏ†9^)лЧ6œ6kвB№0Дrф1"мІјgѓЕ›м“qsъэ˜о—wкЌТЮЅЖRlšo№lпЉyaэ‘#Vjdѓ?с(Хxђ˜я)убВМКxiШчў3тхk•˜iю-Єbѕcк\I‰hѓ Ч‡ХF2H,Њ8>”YЋЏхj^S~Ц*6.%^ьUmшZy”Цu+ЖŽ;_lЉcМ~>ДЧћ >:ЕˆыMъCкЮ–іф­Ј2'Ѓ> endobj 213 0 obj << /Length1 1393 /Length2 5926 /Length3 0 /Length 6879 /Filter /FlateDecode >> stream xкvTSkг.H ЄD6RŒ!є"JЉAщ%„Ё$”а{SšTЉ" HoЂє*EЄHW.E@ЄƒђG=ч;џљю]ыо•Еvі;ѓЬЬћМѓЬо›—K~]СkRХbpз…Ё0@I n,Р`ЂPLФЫk€Ц9Ёў2ƒxяЁммбXŒЬџ(ЙЁ8МMУуДА@УУ „%d„%e`0@“ўˆu“”žh@ h`1(wЏжХЧ mgУ—љћрG Твв’пс€‚3Ъ D`-ЮхŒЏˆD8p,Тљќ+ПЌ=ч"#$фххE8ЛCБnvЗ €gшЃмQnž(рa@сŒњУ т ьбюьpЌ-Ю с†№'4…qЧGx`lPnО8WПшИ 0Рwў Р_gC…џ“юЏш_‰а˜пС$ыь‚Рј 1v€-к шЈотМqБљD8ЙcёёOк aќо9PUаx‚бsGКЁ]pюPwДг/ŠBПврOYcЃ„uvFapю _ћSFЛЁјcїњгYG ж уїзТББ§EТЦУEш.эъRWў ‚7ўБйЁp€8LZBBL@Й(oЄНаЏє>.ЈпNс_f<ƒ?Ќ `‹' @лЂ№ ?w„' РЙy ќўЗуп+А0`ƒFтk”њ';оŒВ§ГЦ7п э ˜Т№к`П~џЙ3ЧЫЫ‹qђљўЛПB*FКъзў0ўOQы ј‰зЅХФa11)@RZјw–џ№џ›ћoЋ.§зо`џ$TЧиbщ?№gї7 ЯПTСџзФџЎ ХK№џЃ|3˜8 ‰ПџыџwШџMіПВќП”џпRѕprњэцџэџ?мgД“Я_М’=pјЉаТтgѓпPCдŸIжBй =œџлЋŽCрЇCc‡Wјua1(LьэЎŠіFйшЂqHћ?:њЛјNh JыŽўѕРСGС`џхУвџPqЧ7ьЗ …ŸЉзUС Б6П†OD\@ИЙ!|@0МЦDФХ?aќ”к МЫ‚bА8|€чиbн@ПкŠз‰‹Oo§+5вУЭ ?wП€ЏћїњїЃPо($шУ$y#мЁ&МљЈJныњЪ щќbkT‚qwЄ8Žo*зЯўYІкЈЋЂ•MљЅЗiКя‹яLњГ ~=ђ6ыШ ™KНƒ#Pщ^VмОўєЭёї;дe,›нАdZд2нЗD=0•)БщеdУЩГЩNбЕŠеg?ZнзLЄ7g №€–+•їP!ЛuѓBŒ1Я"ЎпиŒ6ŽоЭ4нУ@§ю№ 1шИCХцXжcŸeгИŒўййОЌžю4бн<ЭЎJ‰ђћ ЌŒО\йo“zY™Г4^Й№)Š(Ї$\a-pОЯ7Gd%9w:–зг”и+ъQgЇ­BЉ8№ву Н~Щ—˜ЮflМ*-HгЮЦOx#iIбМ—рЊ|v[”—UB)Зо тC+!Ќ}ІPR@а[IЃ"Rb|”œWNћ-Zъ›—!\e1wiDzT3ЦS‰їžRŽэ§§­W[z<рJ“Е˜и6‹з ўпшвМiЮГЇAЅ БЋ—ъYА^)јXyь8tzдЛГ%m%†DЏ;&FдЛFщfЖ‹3^uVЁrфYцj<жTщсƒHНЉъЕ\Šћ&—z&жoŸи_@(ЯfС;Œ|t6бx7г`2єЁn єђЌ™ <eJО<ЄлjEЂГTNeџdгєєчс.2ИРЛѕ6Y0=GЖ ЃЗ•hЎЛNBŸХVфaџ—пoLОзWЇZ•БHщGй6МŽh(Њ1ICnQшЙ//д_sœ˜ўŸ2ЉдЋ1ĘЅU74ЌNнš.wJачНщВќ˜ОIђХЬE$)MЯБЩСУМН”Йлн<чŽіDф‘&—’йу”йЩПЕыаЪržОDБjоЄд$жrВ‚ ЗNы 5л)Йх…Х&ХЧCЗ#мЦ)ТIоŽŸФ‰sў0kk7žђЩмV˜NP[ћ*/:^S­'-Њ›mыvуюŒЁž~м№ГЈ$8з_rьсзэяkМA}pfћhзхЫ3,…и=,='l€Ї˜LГЁšяDŸџЇпзZ{нz—h‹\нNрСЫYЬюоЪМЈZmьђ|"Ж~*бкћТ<Гˆњqш—СvКaRЭ–ЊŒ?eгdњН/šyŽ`П4D>ЛyнІыЊ­ЭлЫHжХp‘ћ Lde]ЙсЧып5‰ѓОИd&R.…ВјзcNTPЄЗ[­‡ƒ9=‚ !Ђ.„‰ЦЅ:Y‹Oвu2—S8јюЙjС`žjЂJwђTЏ О„Ўќ˜‰lЄЉ\МwгЪ_JЅгьёХ‘^kИmЎТH”ю“ѓVŽ>)­"+Jцr+dЁp„Ї­да6ф…П]•i#уŽЏ8чїдЪ–FQ‹YJ ?эээќ7?-ќ 0ЉшоцЌ уzн}М–џ>ВпYOѕ2‹юа[‰Jyuц­U1К“tOЃЊѕяK}ŒJfлЗEvљmаžхуk-_р‡ eˆклхФхŒ|$‹Ф*wКhќДЬ/–ПT9K_оќо4ЯO%X€zзуAŸ\ЗЉфѓоJ\Њ7Є™ч\!му0l•э!–~ha Ц^§ЄœёјШ>WsЄh§•TwЙ`€ЎЗНќnХŽ ›Fџм$ знžYЯuгў™лп;&7І]]з#ЙWЬшКw(zЖuйєЅšРёm…WћБЛw˜–&UмhAНaЈЃ‚_œ>рј —cМУDЮhь‰eА!D2ћWШuдFIФяtzLЗЩV|­6tЙђBЪšЬ›и#лшЉ?ѓсs€ЬЮ€{ВJЛ6пЯэЕеЙ;c ž‹Ј%ЙWд•mщ‹‹…Я­>тhЕ[Х‰й^ŸзˆЎІАьЎFїqЭZ?ЦCЎT›мЎT НбЋЁFур,йm‘z#ŽJ;3Ѓм.qєшˆ­mSлЉЙm˜[C§ ЋяlйЧа"…щъ(љјvаЁЙ˜HЭЎњƒЎ%!PŒP’S> m~ЉЈ?LЧъ’%{w‚н‹z„­NКzк@щЮ›fїH E'СL3N§Ч#/ємœц5Љшз2љћУœЇcх­ЄЉюTPЈЊ•9ѕ]Jz‘7fž§ˆцќ.сyУ№R!X€{Ц@œo|ZŽс1{ђ‚2т4 qќЕтН ЊчKu’ і№Aћ'uЩ"‚VwЃјD>$ЯХР† ЦRmТБЪŠ2Щп ‹њAFаТОЉЊnL†m™IFаЅ#ˆ„Џёѓjб€~сUщg›‚Юxю WЇRЅhX‹~к’4З§‡kя5{|˜Ї"й!"ZT)P‹cСm0љ^џ§ўœVr ћз„td Ls‡7$ђЯEMЌjTГЬ”хLЄЧdаѕжbЂCV\U8ќьэŸїV>I;^шял}~ЂXГЌŸнЩтНВqР8а§|}4$IсЙЭ,Iйц$”qФЦзХжггаŒС3OYŽKN<ЙЂ`XжсџИ[/ьуžУzщRДм"zњГйъM 2ъбЫ”ЮŠ§Эѕня С_ouU(юr1Lr^SO> "=J#x4;Џ`јЉMЅ††ЖTџЉBФTOpеa•ќ­…йfљм˜їѕtюЙЧЫЊ ЃГДHX&Ѕ•аѓNЪ№‹Ѓ\*ЛњVLР†\БЧ‹Sа‰3M‹еTАnрp{:яЎхO<ПўˆлчэеPТ}Х7.ls_НУpќъьбuя:ћVЈ2єШƒSИŽЯЙфЄžчВЪЦsb’Ц{Х{ЦїаЬLўЖвшЄ‡ŸчNЂи%@И— ЂК 1“5‘зп%[щЊ?Щж‹sЌ ŸŽ ‘гпЛgЂэ~’š…Ы[ БщЯzwЮО1їdча"vЮ!3=ѓЁн&џš‹ъАz˜љУ+‚та;ЁMгѓW4Е#яUf ЏlТ `‹€r+ВЇеЅyU”œ эDЙ }ŠЕ_Д ŠVфУЋQVУзЊ5цjД;пдЖаEИгіvDЄ‡А ЧGŸ^›SэяŒгже2иi\˜wфб#Ќ•tыt~ђъ„ЯŒiОгtМo"Йo7lŸ•єъйпЧsR‘ЪШeТqQ}[u3ЦЎњЬ‡„/“^„X^:f~l.Ђн№qv`TчhчR< &–ёхДяЃR0ёЮ2ЭаЂ@РQБ‰.№кИrMБъ^ЧЧŒWядщšШ—š‘Дœѓ˜мЛѕЊŠ,Я)жчI„уВ3BI†хN1}ђОšEZš;Гѕсˆ k!H=С1ZPbI.HSђ™Ж#в]ЯOГ“ ЮNѕљУэЏzcєХ/kд2MцŠ]–&GNCќ“ќР–OYђ&ЩЬЖ rя0."ъ›NEР-рuх‰ЮъС†ШЈЖТъзэ‰žjKMXуGя\>YС’Ті™‡МШ†ЮЫd №Ўž!џŒт Ѕзz–ŸУ…iѓ&ЫuLш(/йmzѕЮйkчaЦяђФЈsї]лнР=zіњаyHd[‡%ˆУ…rw7_НiHу<ј˜"ІBтFvРдvœЫгOgKЙbr=W,0^ёdkяw\k[c№ЖСŒМŸqsГэVѓд)Ы7ѕАCЕ1Bˆїw‚С•R;\юѕф 7й#њ’tя?iњЂЌlVrГЩGљ‡Vи58С~O[>‡cћФ DѓЖt2нji_гѓkЅУеОр|ѕ[Зќ_oљйZнПГћx SЕJqRXmEyнЭЮФыnЫшЎ_‰g4ри‹sШcПœ3 ЈнJDm-kЎ@tF&Ђ)-хХp3Љ!ŒЄV Mјј1юЕ‡j9чЕ™оЈЈ5ђ4­(у8№<6tм[p(4АО5!bљ8ШќŠ"z~щ•ЁRa9Ъ?DHЉ%*УfЈЈEКI/ЎІЕ]zO—<{LVЕ$e-ЄЩX\:™рќЌЏяиДCеJps‡rEePžИиViгь€Ъrу„JїK!жzюВkhтƒчtСЊдц™ˆњVLЕg o-л0rрm_ёІџQ§ЄЂџюtЅ§Ђ`щ‘• y$'мё~”ъЇёŸ:wИo­U\R=гК\™ъŽнxlиŠІNеRBЭЋ2<1єёєАlbД›[jmйН№пМШШ6› й}Ё 5цT,IpН<їѓКiВhєѓ":1ы+hBжЩ7Jчїг›'ђ­sŒХѓw3п­~П…z5DH—чjАQщL q Gшe˜’ЙГ:iшŽьіЃю‹z'RБjэrЙя‚вьн—z“<ЅЎХ&ЎР.HXBЃќУ&DШ‰3]КЭЮ>рI›в:…СbžХ{Б‹ƒуѕьУ єнАЧўнC› 2Kп>нyЇBFА8MгBЅkPяRЂR1h/a1ЩЯ`щ@_ЛоДЁwшЉБЦUЏдњ4ркњ™ыЂіХш™ѓˆ•Ÿь9$Јз=€F#эdБцК:mDgWхN/k”їМ™љgњќ+=SC`г–6чРкwnрСкЭo=<(=Nb$ХICщУцgЛgЄн+ о№о:NЦЇ”n+йО>-Vw†ЌЬfУМЯ#—ћU§FuJщШkŠХЈГK'<0,ЦЇЧЛяьэ4хЌJЧІ"ЃЬР0†ŸsЎRo^ФK“]o:˜м2у’up•1ЫŸ№з5Ї:НІщUf.ш‘w"ыДъЦЋИМКtЅНчЫъCЇКнDуф\&Гt!3…„юmфz--Пп§L~Yiдљ šŽГМЛр,“HгЂmЛЭW–бFRpЊаOбgФ­Гeˆ =Эђіэ’ЃМBu`њьб-ћ:YЕ–цvbЗђ%” vgч\|ѓЖŸСЈ Џа+?ьvuZ^ўЌtёфа:бЕd‚<гЎѓњhФOP)Нњ–АБу•NЩЉў2ћЪИšЭЙ[ƒт3Э1Ѓ;ецЖСЦћ>#зФŸ 3L*NФОгЄŠњфfДqдoд[Ё$tяуEЃlєfсрœVГ^№УгћU„] 1Kа'ЛWaЕЂ.с‘япМЋыR§2теК|Пl‚4Вr+фя0 аtŠЄh.š ТX\I =a’6zпФЭ—KOоЃŽ<rтрыQ`кЊ‹Єy{Ё9WњOЊ†5"žЭє:ру:4.НXБФІљfъzа‚сIrŽјг‹ŽК %ђЬњІ!Д мэЇ uщЧgžз}LuК*R<‡ЮЖЬŒŠmђo—НсджЧƒЯоМ`]‹UyЭэ)џ‘fxі%ИгЄЊ0Ј2ЌЄœвUї)‹5O=c2eў>xЇl}ЕЏёŒx‚0Ћ<Д›ІЂ:ž БQј)вМЪTG-кv!”‡v@ћ%‹ŸЅмsОєКi&ЋЁoF:Ž&НифПоЏ#9RЋцS яцІsW0Псђ›ŠУlнrЩ”K}O3§Ч/V{ЎФјPюкIKы Ќо-Kю.ла\…6н˜€ JфŒ’уХшЯGОO–{цЌЕ<TQМїxvАwЂ,9DІ ’u—ЇТ‡шЕТ4‰Ršž)аШ|ž˜8œi7+.ЮїT7P™Он<ьтjЪЦфIj„УГеђТ–њ іЌTsГ‹‘†ŸM|ЅюЌЯFkэчБ:7О6ЗЫX:щЮŒ[хе5ЦхzБЗ^ОьЩHв­тцLmМИЮ_:SдэЋЮЖ8P~эQђ+-'Ÿ—.q”oЏrЖеGxО)rшПхоє‘ЃˆмТJ4*’iЮЏйhœе…†CY+ЪŽЩЇыљ”ШіŠдMХj)kQR=Џ$nШІзŒ,ѓДЇА; xу|§ -ъяiЈЭИћ=C"Гt9Т‡@Н`JZО #ТCЩWЌ;лM…иe‡Ј1}ЯKck­5•nNЖм5Ё”mmі5н8Т.Иf|ЬЅ]vD͘–Птgй˜з'wЇ™'2Щ›є&}яWЮТЯŸj>эїЋšд‰-П‹ўNЈL"№LwxepЋХ/jfиЅ)šЃюёŽ=њУЋŽ6R;ЋљЛhЮЊJдlНUf0gQJ№9Џ§r‡|СŠ8ћб 4ƒ”ЁQЈoЊЧћ‰ˆиеHІКFЏИШЇИPzЭŽqб'cзЅЬь‹‚іYŸF> endobj 215 0 obj << /Length1 1454 /Length2 6125 /Length3 0 /Length 7116 /Filter /FlateDecode >> stream xкtT”kл.н(ЄƒТ0РRJw#-8  1УанH (]"Љв ˆt7Hвн€‚џЈ{яяпп9kГf­wочКыЙюћК_6m=>+Є%L‰@ѓјФrzЦЂ!~A}8кіLТaCЙР‘ёџх ‡‚AаL‚Цјi UWH‰Š ќэˆD‰ф!np+€?@‰€ЙpШ!L<ћп‡<ЬZ3ч“”ГбX +В‡|9Нч_[m`ЌVHF›aбфg+”ё:,7Ÿšт™о{a8ё3TДMhЃt=яВЩeУфСРPpFС–Ф„Ž‘ЩjкС‰2fc_Bї›QФRЁLS\ѕU_тDСcПЩ6D3œ{Ў˜ЦІіЭЭѕdtu& ПVk/) Ѓf ёReЫъOшf ЯP­uСт”ŸЩНIŒЛУяЦ9ыX9bffэ`p2лѕЫР#АPZ7U‡ЋыF9{$й~zyМтМб€вOд‚р@zDс%\а-ЯТОјІѕІЃgJеk “‰nC;cіЬHНюУ[§{m\rйѓFQЮ‡Ъ74Е."7ZSуœъЅрCOnы”‚хGLІѕfд+Щ|tDц`бyŸmПЎ›Щ1<ЇЂК%wЧсШh}2Mщhg;pBж@љ’yЧ0Пь–Т†щ’†Х…ВЦqDЛШ^(ѕ’хДS悉eТ'ЪfџLќƒ~sфЌ№jѕжPп+ВhЅrНEYГ+sрьзOЧŠLŒЏе3ќ@Т0 A&шGщQўѕ=YЫ&нhœ яљЕЗ и•Єz4ќешёќЉњц€1„юŽ™"”F$яжleMЧR…Пдкy5z9/ŽАоЇS!HЬЏщšЮЅѓк.ѓXК"ЦЖLсћЁЉќœŠў]пЄ№!ЅO~Хœ?жЯ‰"8NѕDт§Ћ{лхЎ)Чщз Йvr=ЉЈу?T-ŒйvC3]:gQУЗѕфЮ‘œhЧКЫeMњYЛb "UV˜ ђOor+їV}?u†$2Ѕ4ўЛУв~#7Љ‰њЬ4O ”ЈЖƒ•ђЈ{y‰ КщъЕэ§…’адaЯј.Ž›–ЏЯым—ОВ„њ“Ш РЙkЋЮŽwЕФUэц2У; Ї&Ÿ†ќkІOи…•Днr‰ј LЙ6!Ђнѓ`kX’њxЬLEН …‡Э4ЬМH§ГЯМБЈ,tЗ1”ГаqЯё<іжxPчgтRC’œ*$ РRMЛљЭŒuЋŒжlќS&š01!qlII`HGj›ёэЌѓЫFёJzМЊyФЉ"Zќ.~_XчƒКLЮ–lFйё^w2§мКHУи=Ц.ќ7ч„ `QѕEЛх4ЫбWц>+№‡ж#[/йJ@cЋпŒяЪчбнŽgx8О|Ѓќ^Ойѕ)Œ№ЧЕ —ƒNЄџ*ЁG­‘Е(bzQ)hјі Э *š1 Ј›ŠtЬ\hсŸ7ѕ•ќЖ"zI>]#OРЃ>/ъgч’]/ ЈxUо]ц0п—AіEўцГоНьГ |є7ІыеРюЗ;3DЁ[ЭЛlFDюInБ&nЗ9qrяЧЊ6Q ъЙг Г Uяю/ ~d~ǘU5„70\–lPЗ­šДц|?8іq‰I{ШœiКъчF5тш,ѕdБВхаЊБ\†G1хI=Д?ЎІgl}zЪ+žъ/­й$R?OLЩMЏŸŒщ ?,Йy{€5ГwЫУВѓiАqр#тwНYЄwжј]з*ф›л#x\EЈ={fU9œ_Š№žмЫЅxк {.739‰ЄяЎЇi ‰”( АQЦ+Ÿ€‰Ж8eЁМпљ™]@\+"ti›щ-ЈDШDте+гp‡{{оY­LЛ5{cЋцAJi}sњXб›бЭWA)›‡XcБњstд%.йxl‘ЮЬ™/ w—@hр“ньqW‰єИ$0ч–Л<,l‚WsТяАєRзюS{шi(ѕ[1хžЕђFL6мxљСŠ‘?F•ЎapKvкVЧыSŽ„шщњ–бУ.ю{KЅgн0aф…ЧщЁ+ћ“yМш{%А‰Ч!`2ЗwйpВЧˆPСДГvкђf)‘CЃрњЅ8Х=џiЋл›щUХŠlУ }}‹"шn2%{Zц…A йр^.Mjg]ВР2nmњЋzцžК .XЗкысВЫ”A–$#4ŸЏћІP­КgоДMСч1ЃмsмЦ1ZсЙ‰a”вКiдєСЪW?УЃОq2Fl!+ЩvŠвpљ\8=кЬ"Ќ<џк/Иј&;2~  vџFvAšП „+›№Р@pКA“,-ЂўнŠОп5MS4OмЃћЙ№•‘.№ѓ‚б<7;іІЪчфe>R$НI‚Н_&‡yМјA ЊG8ЋУlœЛй#eIЁ‰Bжbй[VС?5tгљЖю МQSrйqнo'Ар‰ЙЖ\e­2Т/u/‘’1v–О4“Эъ ЈŽ#чжvйџЖMмšTлєЮг>nу•бгBМЎфH#–†Ъ}Žg„ј–Хž 3AЉ›q›Хякœ‚у?1О{t2qk]&ЅаpлЩр6x–CЎТ0­Й§г# §7ˆˆъЏ<Юd‚Тѕъœ ОyЉ`ƒР%;ЈK }M ›•іФ|Чd<щўjuЁgœыЗ†„эЧgљуrŠђљkс7ъЁи>š^ФYъЛЌQvЌ|UэюЭвZOямыŒИуt.•MCНВZчщХіj,›LКyifЏ“4ул?xLKOрпK{Ы•RN$Х2БВnщіУ@Ы-Ш7lќpЇ eфЭ‹ЩЄ,l•O"OS*€?сuілЮm“ЏWѓ‡sі>4w8шЁŠ(‹R* JUjSрKЪдюLЊМгtœї3Ќ\ zm| Ѕ{‡E&Їєj§ 9]БйOФ\Н Œ’ѓИg“*bЇцЧ'3И|§eРзЈЃўГtя1ћzЬёЭ’™Ј p`ФУў‰MFUуd„LюCЂчМ`ONТъш%ƒ‡јeЇžюТГ\cœjMpяrИШю˜ХnSu"nq8Ъ”СIO4ЛУ;40BlрRі. #Џх[Щ&Агц<С;0™Ч˜д.ˆ.Киаb{ƒ*Сг dёNX]ей^ЧФшmЗ˜‹:4ЩJВ^P/ЗлЫЅЬБЋ^3Wl‘’mЊл0/jj]jl› V5d2/лАіѓJ&јv<\Бѓ) ’XЮађКЭмRmўвЖГkЙ%*5?~PшK=ЛHŠXЄЂŸЭC ZБГ я“SWл/ЃТёЫ>Э„ЌВsыс'K2№VЛc:bІ‘з5ƒЂd5‘6;њоЃрh'Пчіh%šїёъcA­wBФЧ љ›жЗŒоПз8]XјAЏ •‡]@[TE>­=ƒџт]P”2ЖЅФ=0ЫчУгВcд{уdр6ЋЛэ ŸpЪ>щaыйЖ-ЅфV&мЂъљфУЬ&ЙkUг5+п‡пj|Цc hxedqIQЉ2R™Џх”–nЩ‘‡Щюpt}yPє#їЩЖ л<э—i €лЅџЋ,JМђ@Е(amGBЫQœOt3ом,Ф.еЩЫЮuЪ/KNqЃr$‚э^КмъѕоџЖЛр=ГЩnЯЋЌEq€_Оpi8XpyЌ5 Ў$Hwр-]ъ\Ь…?7ј€Q˜”…ЫО _іыEЄy-Rwєlo~РшWС,ч/8GVyМ‰ЛЧaOЌQМш[уќыsHёgџ №#˜{m4ѓУs–†oщSZ>*%V›’ZКУ=gvЗA‡oЩ5“LЧЖFvA;Жю/ѕ5j–kлЬiY2SћЬЛП;Тp”_ЕЄрlbCBП]эGЕlЎЭЯkіИћfк'м№žР^фОПМdїњašвW*aј3Uœq^%љЖ_ŒИS\]Ъ•n_žx]eсT )Б"№ч–мэЎŒUЏщюцЭwЂУЧўбгэn+КŒІOыЊYЃ~›юфŽс­їЙxўС˜„&Њdr‰ѕЦњЙ’јшeх<3ю!‚?нšђB)Ж{л))˜*GН фЪГёгЇ3рЋ,уљ~nхL3TaКйn>L1AБк€œђЄЇяˆ'ŸЙЇŸP/—4.BЭЇ™žж0Ы‡Мйсэi;PёПјВђ"сYS4—жС;nЌL˜‘ЊАў†qњл;œќЬС,ЦоgЮЈ0ЛЦВЙщЛ(ЮfЦх…Ёе‘;*ХL ђ'@ w3О$иѓЇpEЏ8ЕжEszђbњФ­Ў#Ab&кN-•чЇ`љЦЉq€РA7‡<›D‰FЦ4E§фџvГ€•‹ЮЫ"=єжVщЂЦ*ёŸž ъ”№m˜Ъ{Ц9Хk'гФћ5p ЭЂЃ+шЋ4šу~&УЊjЕIж+ŠЃЦззл;JДP,›k|‘|п^ЃIВ ]Я quŠjыP7Ќ _ІОзХ"ж8 ЪkœbїТ Н\5nŽЧѕАuљН&ƒ*œк=ьрgYь(№НоњщТЊ5~&бё$EQ)Щ.ЅпzќщНlŸХкDM№ъ?В€ mТћcхР0ZžЉѓœ•и5" ™№кВKЊ XРh’іЃ!ЗсъvЋР<џ)ьаЭ…Œ•Ž}$Ѕ0šљњtю›,dfœПЫь'_V…вр™} .иbѓkЭЧЉfjЭМ<эN“J5ћŸцюИgP|рм’ь~-лХљэ<4™A2™f/ї@DЃ­фSuhы!( д‹П­э"ъщЉмEіU›†НЕЮŠ:K_uNщМ |пшƒ@`sь†Њ@ЫrHlям‘T]-eёЈZѓh;еœжHВfQћїјЄ0ƒ yЉ‰ѓТлфипкTњпњt…tPдіN†Шvјœ…ќб‰џ’тyћIAY2l[uvЃŽ—>s‡A4&Ш!Ю$Gcєkўt•ЈŒpЋў э ЇђŒ,Ё7u[Ъ“:Ќw#gxыу›ЂAk‰Эн<ѕюCя‚њ=o КOZпХ+Ќ у^"ѓеGЄ”fБЋ­tkћc7ПРЭЛ,рјф_$—›Ў',LЏ3vxюjъsCЯЮЌiVВ$сGf„Єi%>Vъю#rїcюБіРCdFѓ,eёt3їž2ЗдfЋїТї‘їйuO*јщћзs^MEPнЋŽ|ЊбММд—\”{ЇИGцD,@]oc‰oхq^C;ЩЮ38лjЫEЎvАgВ хОЫu‚+ЅюRKЄяхСљ5 :ю#УvСУЄИХц,„ЁЊЬ'2Є„єГm }шŒїt]щЉъЏ•|_ЊvŸО№Ј0џYЬ‰“њдщ€”™ї+рыŽŠeF;->Mpё9>ЖA…ЂRгJfcbѓюUab$ПкЬŽмpГnћUўђНSђ%‡<Ѓ*=шŠъъЙщŠС”§:œсХQlгз=FЅш’ŒгЦ#STšГn`…pЭTЇю(Љwю ЖлŸ8„Јцшјщƒ}H&љdћxCкчSЏW^ўш‚O_ВњЗћ}Ў“д}0жу№Вmo|XNШeЫE|Р7ЫЗБCh€лA№\џ­˜p=5nёЊŸPЇОEQaсM‡ГŒБ‚Шš:Жlо2’. чhNЪіZ- ›єСЮж‘-э№jт+f&"ВlVYƒтŒж‹v t7.^РEпьYХhвQВЋ‰&3’žееѕ[с‰Tв‰WЖƒџ}Еу žћg@лЊ*mЛѕ&яеЇŒСЄЭђr'юдЖє'€хNB0e J†Ьл^nјa›§н“>С}ZТ‰МuШ5`/д(MwhˆЦOaн§>"ѕ,H Џ‘dИ/єЈFц“OŽяМОlдVІюњсd0ЙжФ‘ЬŠь‡Жяu‡;дCG oЂ€•!ћОQF‹xиъеuœN˜fБЂNzРgьt’—ћI‡1<№ІЉ­ZœрYEБ]žЪšE)&GœАгТСœ'8ЂЕЪAСР­Б‚wЬА—%РФZhќ …Ž™0ZAz’VEА^lЎJŸмњЫФзpuвor/юŽиІ‘ИЫ~%КйљЮ*5ќХч{Еw&Vў8G9'иДзД“љPЛpУё)$k†ŸЏИxэ‰CeWsяq‰XЮЕp-Э•ф*ЮŸRсHЧ#/ЂцЃ†ЁўтУSѓ$4ыбr2ˆвфИККzqЧЕеКi3›ZЪm+Жcях.ЄЬ*Юзi›ЩdеeŒZ;јк#o%g4šNR­иЙ­ь5ј†&o‘h0w…0мџд:Ђ‚C[U‡Вx&˜љХsЖn“ьgчфŒŒ^Г2ŒЧ€$bїЏX7{I )eюцXoT˜­šKчAХлтѕNЦ‰ŠuqИЖЎŽ№іЖЂїЉиcбОG’Ќ$Ъј€ˆ‚!ЯZcikўЄУnŠ„Ѓ7КнЫЁХ4oлН!і}KЫKЇ]zdЇРŸPPU8ўншУЋт~15%‹}*ЖР ф‰Wa№Oс'm,Лo7А[ЋˆwІ„E^ 6эrъS6\ноJ;ЈКч3kk:gЎ)ЭЧИ ž_НмПv’˜‹ѓъ SЉВЭЯ“кUiQ­"e!™ћЊћ3Ѓ%cнŸžЗ†‰+Г”#†RБcBtтULB@4*п#ŽCПlSuь]n|ь+tM%}Б/r0ЗAFкЅ–|Јc{ъ@VјЅѓњEkІia}GУГЭl~ssЈ/-3ПKсЛ|–Eѓ‰ %щы‡п*Ўіћ UVN`'Є#IЃxбо<Ч;ˆ.кQЏ§"З–$њŠЁѕзТ=ž3яа:РХуkЇћЭіТЯ7pІВzнœе,–3[Ю%љKfь?x­фJ№эtрМБžЮbУf9mфb ›ˆzlОr5WЏJЏ,PHAX=9В@ž^WKБ8žЊжюšpФ$ˆћІ bHIввcхМCI9ь†ХЈіДУ‘5AYKгїєw•9Zя>ПођYЋУџьœƒ3mпdƒя*ЭК^ГЈ \py|ч HБšbэњ\nі:BГ@"\I[тђё‘^PЪ™˜оwZxч”Ѓ[fъeХ пѓа3НЦ. qKƒ€з^x?›йŽ­“]}  E—mt9ƒтБˆ„фв:СІŽ~BЗ{cмъЮnоWž ж‰o л1Дr…sЉ:ЈQы;sХЖЕШбє•^Њ>™?{4Бл$6]‰зzž™w›Рv/іfMt]hњN#$8s†у~oŒ#ЉіQФ>pиkN5УвŒЁ№wuьмі‡ф4nЬš%ъ"ЃсЬ‰”JЉЩAя)јОђЅzЋ^О ЯЩхII`яЩ}iН5T$ЂFѕ–иlБ‘–ьўЄмeЄ3ƒм}ДІ|+Ќы–5ЎeьФ`MiaR•EY єB,U]R‹ТџЁ|ЮŠ endstream endobj 216 0 obj << /Type /FontDescriptor /FontName /ZHWRQG+CMSY7 /Flags 4 /FontBBox [-15 -951 1251 782] /Ascent 750 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 49 /XHeight 431 /CharSet (/bar/minus/periodcentered/prime) /FontFile 215 0 R >> endobj 217 0 obj << /Length1 1464 /Length2 6511 /Length3 0 /Length 7501 /Filter /FlateDecode >> stream xкuXгmл>-N:%”вŒnЄ;ЄARЧ0bƒm4H7"]J(!"% в!)Ё ! нс7уyпїyџџујОcЧБ§юѓЪѓОЮыЗ{Ьz†| ЖЈ*Žц H•t Э$€Т !РН{F0Д3є ИgEЂ`Ид8(!Ё`4SЃ1~:8Pгн(( “— Hўэˆ@J•С0[ Ј‰€CQ€{JWo$Ьо)ѓї#Т””ч§Tp"a0ЈF;@]0!`g !ƒЂНџ‘‚SЦv•тчїєє]P в^–‹ш C;  ((вj ќIјь§Э И4r€Ё~у†;Д' bg Ga"мсЖP$ShЈЁ дu…Т;kџvрўЙ  H№_щўDџLƒџ C W0мЗкСœЁ@]Umк Э Уm:‚QL<и sл`~uЊ*шС‚шЁ H˜+BСœRфџ™sЫ*p[%„‹ ŽF~іЇ CB!˜kїцџ=Y'8Тюћч`ƒлк§$aыюЪo ‡ЙЙC5”џИ` РП1{((* )&&" „КЁ^ўŸщМ]ЁПŒ‚?a _W„+аCъГƒb~О(АˆFКC§}џг№Я@Ph ƒ 6P{№яьjїћŒ>цДРhO(№ѓѓЏ'+ŒМlpgяЛџš/ПЙ‘БЙ&ЯoЦџВ)*"М€О|Т@>IQQ   „(P\\шџЯ4џК€ПЩџBѕРА?Э ќ;Ѓм”ќЭsyѓ№ј# Ю?+Уќg…Œ–Ё@ЮKпR@T‚љќ?/РЏџŸюfљпЄџп ЉК;;џ2sўВџ?fА ЬйћFЪюhЬZш 0ЫџoWSшяUжкТм]ўлЊcжCn‘8Ÿ H@ф7CЉТМ Жz04ФсЗўІ†3 еC `?п8˜(џВaЖт„yЋ 0ћe‚b–ъŸuUр„эЯэ‚‘HА7@#2!Œ |1kj ѕњЅo ?Ž@cB€Žў@;№sЌТ@~0 У†rТLСсЇё.( фЗA‚!PgЈњ?`с?№ясў љ]`pwд/р Bм‘HЬњўвІћПЯПоPЈ˜™D@ЄCЋC›N+<љО,~n‰J0ыŠEГOНєuаО‘Ё6цІјиЖьvЊоtqјшЄїїг!/ЫЖЌ …ѕh,•ЎeХ]ОмОГƒ6{ш][Н§Аxjд2љЮ3§;Є-№,8ž›N^†‰З Џ•Џ\Е жЬ%7.РзЧdЬ) шЇ 9-›81fЬlŸбЬ,Щт(iюFЦУW81АИХІXК3яe‹ИєѓѓНYн]ЉТћyZbeс”tT>šЬ9§‰=tдЯВ4ыQXьŠЂЧJХЩ ,tЏ\ТйpС]3’ я7а`КЌOwžЊжЋ2уЩ3XДLiђйњльvUЯыоt ЂlкŽЬ…$žЯяhnpж|•ДˆХљѕ‰шФ5,‰и™0>“эQ"%$ЮЅ—žh№jls4hVАЗ”чc (‘zгWі).3ŠбGЁуФУЋъˆ€Д’2НІ~їђJ)Д~’“ќШЂ‚ЎЙ•<=Dй'ГЭйlИmЬdU '7сх 2їх „ь9$t [I7:дx]Ч3йЎ7?=sЩђ)Œtв"Ѓ/‘њœDK~,>.v" оQkІжŸˆЄКœС ’ЙpћЬиFЭwBљй% :аYм[Рž­ц[ДКq/шЬЙœћ^Š€ШOІ ‡ЂЇŽ„Н0‘•ѕу ЂЁTђРє„Ўъrlо!5GњzТLі—ЖШœа­НЛRb:?2ZoH†}Tъ4a PZ4ˆ9 o;jˆR"œ_ЄєRућIƒŸwКLdЌјхб–FŠoєК}НmЁу#ж':Ђ'p5Є–еЈ№-ш9нkП КНљƒЕFЕхnlŠр<ЭYђ*ЯЕ =ИdЗЃN ЯB†фіэN++є*7Wп§Ь7[гПф9с“\Šв™lцЂ5з7kЁ:%ЂЦƒюМXВQАl ћ cy‡Q(ШВa №Lы KПа@ yЫќS4ыeOџІOїЙQЧ!ГLЗ7•тtю[Џ‹~Ђ‡w›pниЬ[O™r ‡„s…EЕёŸ‹=nЊfrЧуД% П^E,„rЦЕn›6эjMІи&Ж4sй33{хн˜СЌЕН—›HОЅ5wd3љЃ№ЈЎкWGjHОі аъВ'А5ЋL›.ужa $чСx]ьБyPЯ‘ Х‰ДШJЋѕzнƒз‹7Ee )Чtдщ5Чгˆ…СЬђ‡‰gOj§ VеА№є“Лѕj7fЏ*;UD"[­уI›зFгb–юџ№Л7o>Юѕ8ZвUр—ІЙоЬѕШй3‚Э‚щыNЎЩ3#ђŠSБ;‘v”€w]ї?НШЦЛФ]^цŽџђ•цZІ­‚tШЏИ%y ›GvŸ&нB’œdА†4NQ”ž5 Ќ$а_йдъX}Нч{ЧžВЅ(ЭьнЧ№А№мLJгЌw§=‹ћЪ/‹ЇxйЋ˜ЛgBŠЃbЇGшЗн~XЋ№ uZФ ЫЏ№Ÿˆ›єOLtЅ(&{ѕсщ( ‰2^Ќа{W"впIх„ 1GФ’Г(/Ѕ)]Xї2к9АгM•Д–о(і;#Nўц% jЫ1Д ŽŸЮ‚VЖV–ТS Žƒ˜*ЪwпЙьВЧWWw[mFМ†›†пюфЏМeo"cЙњ1ѕlуXyЊќјBрѕЩєh•йо ЖющОЙђœ}eYЯƒЫ ž@ѓ№_9T_%:—лєPEsR\ЇБ,/UФХXпyЖй7=9ЭaѓŸЛд@1ЛtIНз эd#рJ\kсМОeЖ‹я)џЅЃEиСЂг8ЉЛЁљ&kxыaш1Q‚ $НРеТ ZКгHПўqд4ЌўёчhRШA_ЊТB{0ЎgЁмэя•Q4 Œ€|Жѓтв8ђ2нv‚:љ5ˆьX‚ŠЩмЄFІе[ƒ•žVžо„э4;Љ›y‚Ј› К-Ђ0S і|ю•Œ9iвy†j4K=œŽуXŸьЖЃЄeЛЇлд‹ѓф/FŽWŽн ž‰aŒЋрєXEа Хнe".ƒ6Сї9Ы"ŸЃ^”‡Н*O•jш~5ЖђІrѕ§;Ÿ:UЦЙFšWЃ&Т|п\a†'­|Мщ#зМ{5VЁС )‘ƒœЫxВ‚zwй…œ Ѓї]i„4hюh]х*rЬyЊ…tгG<ЎG&i$ЏRХX\|/9аvќШЙўн‡Р†ZžЂз>ъвЭЙSн˜* mЪЖBKd­2ГElDЖJ4~!Hќp9GбfЁa ]ї‘:л7.URїŠhЛпж€UвЋЉlІnUЁxЋO тIсогzє”г' щр‡K-њ)К/8яЦє_“цzЧ8ЕЙй2ш‹ŸA<іEЯh ­š|п%–ЩЌћнБ_Їлдz8rQфЖ=_0ёЩœёЅш0% ВzlPШœЌ™w(ау Ьƒd+všhсš0g•ЕЏ:‡t†™Н}MІC~щќі›7w”аЭёЗЃšAŸ сЖM›bJ# œ‰хц'чŸЕ%ЧЩ“г™ЙЩО  ѓъФЛУŸ“Мž—ЊћI"ЋЂф.‹lЦ—ѓУРвC;Оjн@Ъль:Дf™—lM/ЫkŽ˜rЖFфљПS0Gт<щv{ТZєА‹ЏХ]-ЛсщzёХlЗ ЦŽ…xX+ЙЧ–EY ы‡csЦЬoщ ‚& Јз}9Egі.mХ$Ж>ІZSрХKW ?ў‘UVЎ‰gОH%+]|&ІGО9sbh(ЂиЯЖHхМ}‹#v™;БдЪўqППќK=ќјРЃDЩeEі W8RРЃИ‘•КЩj>хyёМГБAœЊ-цo“ї[ЯtR#,зъѓ%ЁOщљлЎ›ьдŽІ–["Њrєsуˆ)тёЈЏ?љШ^іП UoMЬ(8Ж€sYЯМёг=с\bš‚?t’tнSЉОЏ [тЏѓх‘XЫг2ЕŽѓ(йU@}YЅŸIсгба[˜VЫ`реІч$џ]YъЩG-|ЦG@БэPшLдD<Љ>qЎЂO›vdБ›ПšqtЊ§2Мї№Йўb§hQХh[fЇпутОт јє!ВаŸ€ОЊ'CјзBњч“,wЙаљО.=ъcЋўѕз6™яЪ›сŸ#Пвоy7v„ЭА8ееUrHcЄш:О B М ФEщ”ЩGДt%ЮЫяmыXкt/Ќ7ЭvЕ№fдŸBзo1Л{МAЅј–PЂN˜RbЪgЬvЗѓЈ­bхл“;(ЇнЋЋQPХJ|.Фђ‘GрNUж­–ГPйє‚ЉSBƒЕRЯБІ~,=XWFлУ€ыЉ”.з7hUoЄОhlЈPgИœ<ЩЌyJЁЌќЉІKю]ZaэK6ІЦeмNк#‹Тщ•Eѕ1ГzKНс X}H"g}ђEpіDТИ)CœЊъaзж—EсТUЙO(Œ&С$жоЉRvocЯвЃЄёЋЏo…З!У‚-ЮгEЈO(бВТЮЏ<Ья<”žмzр˜убхD$fД<з_€Cђƒ&ZJпВзoŽx9rж8DИb O†эGОЄ™ЗЌЂбSЦYАoР sЕ’Sмлф?X§ЊLђJЮиџfэБlWŠ{юЃр&БwіМ7—tŒ]ЛњщљЊ@Г…a.љ.љезB’RряОуUЅ‡žУ;fъЙ•KaЕ‰С )Й ТЌЂкЁ*'cVгИaeusАМю36ф ‚OUй­}|ЌЎ;н[хЉš%T@Š5fТš žщ"fiГУ|"–жrиѓv)БФ'Ž„ЌЯ’=}“‹ѕ†)Mu>YЙ!ИйPі#љnо|b–іуЋ("2Šaф6€оі/ЄRЋё+]Rїž0џХаГ" іхfa P.ЛJwJeгѓы@У@PMаVCеЖ<@QlТK"ш~Ыenbтtр€ŸЄ„ˆЩ_ћкožF$И‘2…ЙŸ]д=2ИОь kœ“.]ШЗлŸr pwŽDвПоhЭ{uzul‰2Б1ў 5EЯG•Ў‰яЈLйќœЃ@џ„T /ёО!tHwB•lС-ŸЖRЪЕф_ыaэ›qпеоš“]џ<ъЕF* …š…mf…ћЖнг5Q9YOXw=тEаРХ"ћe[HvЩќёёоP[ИЕЛšМН2fЄPємŒыщ5TщЧFО'ќўЭQŽK.šЁйuШ…B u*/ЉСз]Чэ|йЩ–gT{ ЎІE;Бю’н;uQдБЅšI>—,ƒpЄšlHѓ§(›шI>уƒбШXЗЏйщЊїT/г'фПГш6\-2џЙI/w*БЭЅК/зyЩ ‚е’<•#eПGxš Eў§~хuЦ–ЫRSў@тїВАО>Б7тtЖ UьѕZрЌN‹.н{ЂысCс­“л<šR т9Ћ“јn[•’ЅШрокDarў,%ћc_њx9'єiщÚԘ‚ЏшЖУчMГlbяfOЬwb›%Э`S‚ЗД‡HPь“уяыЏZVЄ#М'>ФZ1вН7c чИ)~дЫGёоУUї†ў Рь§fvhЛЧj§Йbй@ЊДjдтђqeЫ_L?Fч‰XГm.м.fЉкЮ,SlR4`‡гІбA‚зfдмњsO<ђChoXM<Љщ|ЎЮ= HiЕъ!PŠъšЬуK§twЂи`ШбтуmЇ Ї'дЅЬIќ,ј‰Їи‚‘Ў DББW‡QйЛ}&їАїЩпЮІZщ ЌM Јs+?#ќRxј$FъУJ€rф™cцьѓ/‹ lbUoК№ˆ >№ёЋРЇЯЏTЯN6<М\У:УGwнљ0Ъ bцqžЮ2э§!ј$S7"є\@e},˜-Ÿ?N[–p2RzИe§фЈГЉ&їxыЄ Њ„DА­'G-kфоыНЬž,rМRшˆЭ0оMndЫg–чѕ7` "-їmЇіхuъгюjЌнб<6б1Т'Цж\QˆЗѓЛ#ѕZЃ“B‘z€ћі4ОZ ?—Nylž—Щђ h?HrJљe…E'%] ф-л{F|юГіIрЯnТG mwѓїиcуМЙcЪ=4%дY[M‘Ё2 €ЉЬКvќœииУзЙ#ЋэќVgK§~SњЈэzЎD’њJЎ.Я'O+ВzZЪ™[юЅ/‹jљѓ2ђA8цЅНѓл ŠУ;ЊƒЕ(4SСšТ?!MяЗ–$ЩЉгтЖ %ч˜ЅiП2йŸк‘ї‚t€Цоšh2x‘?2ЎЊЛ9аnќсй9CНшџ˜j;утуŽVк‡їДЇМч кF›Db7Ќ•ўъ;ф\ƒ†ѕЄлАЂ“q?ьnЫqИфq@бЮј*Тž]­кi1тТ!Жк­ZNю “8_Ј=іФ‹ЯЕ­Аkq“œ$ŸШБј7нcЈ`WK*€EАшFOqѓЇƒ§Ня_˜о/]rЇћёѕœрnољйЋ§Zж-{Ћ{6ЊШLп№TЩiј•bt—@iЙlю-гpп§#‰6ьJнG‘Љf^!уДЂIl…D‡iw…HўЫ йЂЎr0FЖж^0Я{pЈAV'[hн]И‘ЦIvM^EtФ‹яW№F–‹pЕmШЦЄ§Џкoкюj[Rэ‰о <YРф5eзGџЬ$,ŸКяMкЛїЏ ЃП{&ъЭяlмАQh:Ј+$РJП%ђА™с[U[§ўЂ[иPЯtiњHвФБ}žЬbIх1­†Д<,ёоьМуљгб[ЏoKPсеhЪьљЖŸпюЮНЛdtХ"К !›оUјFiGbZзyЅч—Xиf3O>’?ЎhЯEژЈ5 –вXЕв-—цљŠcЩg­,wкѕz#ѓіeнм”юЃймѓomkЗW?|ь)ињвѓ=ŠŽ›MP@їПЪу3E,y6БIгуёwЁoПЌю!UЅЭПJЈ—нѕА|“чЏёN/œаЫЏ7Яў эRнОбаеc`ќЩј}н{6сыŠъ‰\QsХчЗэpŽі‰›ћ"ІпъˆйXЕцmo*тИЦЦНЎЉ{„Іl™' E]“фИNAˆaФ7швђ]ЄiDЇртѕdOќшЃRѓЫщNч‡зюЪdдњЮиwŽš9MBіы†8>щ=' : UUзІёПАT 'uГ›@(#mЖЫ—yщУe[щ3VIXІFСхх5›ѓ,жиЂƒ—к;&h$ДœУЂљbХЅЋПaЎЗЪoёЁžJ„ЏM!BпK8ф}bЯМйБвгМЕ}Ђ§ћbF._\mЦSuдƒsНТ*§і5ЫžŽЏяcЗц”ЏсЏ[Tœ•ЙМa|b=VРМFП(Eќ@р№кбœl—џNя-Д)KW'Ўь•Хвˆо€aЙjгёk5 …Dнжз"?МиLc€:+ЊсЇі_JфШ:ІnpE7ЄФz—ш1QqsМn$œВ6h[жaѕЬRЛ{J•N`qДюы+t?Е7jй]lЉ`Є.їPуœ.Ÿ­7:ФзЖъћЮћbЕэЩЏ.~ˆV6свDЯ"ћЉyšЗХяП)§ЦSфЭЧЫ€a“Гv^ šГˆ„МЃ9Sђi?ЦкшQŸкМЭи#6vЫжU7+Л-чсТПь‹CЅмъшљDЊœФœcъВtВghMЧW]зЗE\аgB№Ыйљ…IcА2з A/ f­жГеа^žЎlЧЯb—їƒ GGЧп–5ш'WG[2‡‡”зз[ѓ(s6-oDˆмаЋQzтТf`hчТdFz„ъ`Jd~ˆЬё;rи‡э’7B#6БšC2І^ф"7nkс:шp#>4ю(Љ ЦЋQЁK*ЮU%XЙЋ*3&vЋUЃcЋmжI“T”/ШIМoЬП5І[мbИОЩ#Mxy4Ўn‡ЈJ ж6H_мз‚“’я*эЯGUрviЊ~‰[{Рщ“j9ЋSJмоžЋ№ClyЋЉБW,—ќ•С9-фТtѓэœЇ§ќК’ЧX•м'ЦЫѓ[(md€ ЧžіЮЛˆbЩAЕсфчŸnшу> mчг9пйfЪ№o ‡гыw4гnЊ‡AЊ,х}%ЁГЊ(Ÿ­ƒЋ#^:’l}Ђ3EbŸшmr?pњ‡—б9гтХc€`BЩwЅEIV 6/3`Ё ЖЙф2і]S\щ—„„2о§зЯ$Ё‹Нљш(91вБIЯзИзЏѕtІœZЬ‹о]г›AЏ f Бъ>ІБх}Ѕz^MЩЌљUўёbќ&ЩЌьЌqТZ‹`C—‰јžpJѓЅ^ХіoSLlЮ2VА†+уcљH†јƒсо&ИЂ O˜Щеэbюе gєљ™МЖdЎмЋЬ§#ЯkчЧ4ˆ^ыo1ъp+ьЦ"ђGoŠ-ВЗ/рХШ йвHрѓГЎДTi7ъ:с‰oiдPэо–.9i9йїс ME:yє{IfЙlS+э6™œс $šЉdбѕ"фѕ…Ž‡fзo=$rCд V1кЭIkШ}aџЦ^НЃёЂ™”’ѓS…Žc endstream endobj 218 0 obj << /Type /FontDescriptor /FontName /RZTUZJ+CMSY8 /Flags 4 /FontBBox [-30 -955 1185 779] /Ascent 750 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 46 /XHeight 431 /CharSet (/asteriskmath/braceleft/braceright/minus) /FontFile 217 0 R >> endobj 219 0 obj << /Length1 1398 /Length2 6195 /Length3 0 /Length 7146 /Filter /FlateDecode >> stream xкtTTmлЎЄ„HIз !*1t7‚ RЪ03Р0УЬ0Aƒ Št7Jw‡„HIˆ€єЋˆ(­tƒДўcМпћПп9kГіZ{ячЮчzюыzxЭDд!(GЈ6 ‰*4 ЬЌх@ Є((A% `У! ЬT–P †B*ќЏM „#иД@8Bœ аУ#т’qqY  ЪџˆТ(Д@0Р@ ‡BBБTš(Д7ць‚#Дљћ О———ў•Pwƒb```ТЙ@нС Р †Aqоџ*!Єф‚УЁФФ<==EAnXQЦYхК0Р†s˜BБPŒј `rƒўF&J%0waлЭPN8O 00‰%dр‘(@h0геЁЁШпСњП„Ю .*ўŸrВ‚!%ƒР`”„є†!N0`Є­/ŠѓТ @HШЯ@‹"фƒ<@0Ш‘№kч €ЖК DјŒЁqXQ, ёЂиЯ2„SО…„hЂмм H–ъчўД`(˜pьоbП' GЂ<‘ОN0$Фщ'-f„ЙуЁКZB&ЊlЮP@(/## @нP/А‹иЯђцоhш/ЇјO3П/…8@@§aNPТ‡Ъ ђ€p<дпї;ўНЂ@``Ръ CR§S`†:§^†ylю‰€?ŸџќйшA!оџ„џšЏ˜ЉЙЕžоЭпˆџуга@y|E$ф"ђвrqq)€ЌЌ,Рџпeўsƒџe5СўlјOE]Є џс№ўЦсё‡B$s№я†(—ЁЁЈo”‚ /ёџoќJљПёўg•џѕџ{Cкxт—[ш—џџpƒм`я?*уqY т@ўwЈєЗ”  оэПНК8AъHgХEФЅDRПэ0Ќ6Ь 1†сР.П‰єї(=0$д……§МqY@рљЊУ З №gVP‚ЈўнїŒ‚ќTŸ„Д „С€МЉ€’IHK|Х 2…@Н~ё &ŠDс)F€ CѕsЌ@€‚аъŽ' €рЂњWy0ƒ!ˆя Нџ^џR:ъSMОGЙж>j9ЊVч№љ2H>3зkн*œШіuбϘЎ3цЎсЉ`H1ўP2њоуЦцб—нЋЇAгЩЗГpnѕ,hl‹фєяНr†rCPьЮУВ)a є[q&\ДЖЄЖзЌоŸ=–э”\Њќšо†]В‘_И Пбё&sрЂд3лжˆ#Ќyљчp§жvtб лTМЙЎХ№9q,њPЃ%’эи{С6:­џѓч7O_їЄHюцощЊ’ЉadЛтЃЧ›9пЫЦїTЏ{APCњ›fIRьUЖЗСiйщгёмз/уz%ёѕЮ†šAдFo№uˆ№ Q”Z6ЋO#Iчxн5ФвdЧнЛLkБк"U?њ4gћэ0gД‹ёVЉl;ќiњYQз…ѓЂŒ?tˆ†Ь:‘Ž}ЫšЏ›Ux*Д8ЬЯQJmзЦЗf–O<шVИЭе.Ћ_ј‚$>™KЎбѕCбоцЉHз•OЁЌкбk‹qB;ЋЉь>ОђIЅЈЎ’’‰T‹г0Ч л[Ьє7xпЃ'ЊŠшьЁgš™lд^TГ(јVћ’Чш­:нюІ”Є[j’пЭЯ/{хФ]ŸysЫј=рl &ЊЎо-з™)ЁПЎŠMŠeЩЩппœъ_ХƒDЬn_:.-Ÿhпш5z№МЇеifПі"щmN0В:2™Z]ћиkЁgР­ж^еф›`уГdu!OАD‘ЪгЧ4гр0ъбH!Р‡-"ЅЫ'7IRљи9*ььј‹ŽwOћ.чціЖ ХьМ†˜aњОЯсСе$ОЌ:3оŒ‘д­b‡т ‚i"Њьž§LЮ§^;s3w8їМќ№A§;œ™IЌk#ЫХЩ3;|WвHFяАFƒTћKЮ+Z^:\Vхж‚ дЏ VХКF~КнЇпo3іcоЈž{bћЁўpЃc˜PкЉ6< ŽЙRњЉЂв:„дМ y>/" љс˜а4V`єѕ‚-їm;џ{:ckjўОb фхNћХ ў^УI–Nм Д‹“Ÿ|0ZbЋ›ЇyQэ‹#јаэK’€ќ7џПВIмjФ^› „фМUjв\vД\шЖ9›RoKИЅѓЄŸKИCЏПНШœЄЂ…Њ\й~ ОœpJ˜Ю}/;uџX/…Nˆ]О`2–_HПгт.[Б19яzxo•oЪФќDJУš-Џ*(т™E#ЌиДQК–—ИA8ОУРчЕчh2еdЙeq`з‡­Э~хИ№˜_цѓt•ї…§И­yBILуR7Г6йБА 9h4 ЬК4 ыЏѓ‘QK№MŒ1Vђ*{gі>Spњ1fLm‹”ЖoкЁШBiз mшмЫ{E,>ЁХђUžLщ€ЫHіяљ 6Б4zН •ПWNFЕЮ:њtођ~Я0АP|bўйžѓx4+ Ю&l-!PЯ Ђџ F>iFёo­ђч†~™ќтўЕ&-;Ђр бnћ№oS>€=PйзЄБ•ЙAS ‘/лn!Z`{#вhы–97ЛXщУ’ѕРћ0бП`ŒBб[к!зPё@юFхМёј,‡vWЌЗёУ>щцПЯ•\“$лХ}ю|_nuoа~Цпv1}ћ/г•цзьж+К(]šyŽн‚@ыщГ щяQЛтн™YПѕNTŠЄkЧ"ЗЙєЃЇћЂbZy§ІХӘЙuяЖж7QФ33WпMŸPе[шT[Гї4h…ёцицhїЛy^Оя'3-\ЉВўvїЁовђ›€ђЛwƒ-Ј54xН(l3ЖЂ<Кг Wl•іXњ6пОЎМsMяе Д\ё‡HŸ/ŒКУХћ{кMŽ&яЃ\&-єћЇƒЯRJДхЁ~KlŸq)!бАЂ[}=) 9ёK?SкQvЗp5ВhЉ4д^Её~НvщYѓ-†Я—ЊЊdї›гђоX{ы3;ŠBŸ‘=Ьг[ЛЎŒ0K-s<.T7‹`Jм“+[Ÿп†YV8Е3ЮЎ(?tEяШпэLLЛбЅ "v‚к0иOHіўЅ%ЏVOg|Фё*СДTЯЙуœшvЗ–ъъšybr7=}џЩЇgіkuJ^AєќFDЙСэz—2хЎCnOpIŠeP—Jы)&w2нЂуТо`j6ИНK;јB}IOфž4Гˆ?Uy™еLАЮAъ=Д3uЫг5wЂ™F[>$І=>€ Ю ˜9ˆэyJ&ОI“яЪте˜pпОЗИэu]gЧ‹˜№ЄЫй%УхnЇЯЁНDЎЁзzНш2Љ#˜Ž‰UŠ‡ьЎW№ЯИ(ю&$№љќМ&S™vž NюЊёЪs[N‹8`ів%іШQчД^kЈдЄЌђƒБy}њunRДКм‹Ѕ PлŽ–4>mzIГ jвЭaЉЦ“{˜bйш–@wцЙЋЦоЊп‡:šхЫР.*iЙк–‰йнСЗМФ75ІŒЯqcЧсЮ} Эf&œ7BhnТхdЉЄшвпИ*,ЊѓЭiSŽvwщ‡ќг›УїђiŽKН…BpдЖЃ-ƒо"Ѕ$.žсјa2ЯЇS|>я„CqCEv*‡eУŒ–й)Г‘№еbэ Фћі )ЁТћMюJІ’ў>Zѕj їё‰еKq с\Чќјц§ёš€:ž€ ‘мзkпrХ[.<яШN›^вЃР єWЖІB†B–™u5Ј4ЋЊЫ/0@к7Ь79ЮHНФ>в|мюгкхG‹JuП%Ю*О4rзТэ•^ЛSКхТ^[а€fЧЅеJ2–VДЬAш;sЭЕвЧ—vяјSЈ њцюЇqиТФ+еБ/И/~}r'da™Ч‰Ž‰ƒ_іи—ЧщY!фіещЛЎ*ўвбе{tздСuЩ['a Sщ„Cc}>пƒ FXђ`EвќЁˆ ЛУѓљ—sQeгG–fOЦѕ.eЉЧа 7јh)Ј^MпП›ѕ№ћŸ'ыš”"–‹mh\‹$F'фa_и‚wќ›ўG,і(IŠcбЇ†дЧЫЄч9Ÿеh]эЙ‘O§сиŠЯЊU9Aw€§Mk|= z6=2юR˜wkГЈъ+#Х%Uj єеgwтЧHŽфžp‡­ЫY…Yžye§7XeйЛЖии„?},БM7Э“5?_l2vL…ёИ~і(—šзЏ6ДRИxЯђ[kџ]NбE‹ŽЮjЙR6†hŸк/WН-јОнb9TЇrjbp%vxЉTЇТ“Œg1пйЕЉНBЫЙ?GЗіUИVю3ŒйAAјыSпvх=Щ­Д*$ЪБa0й0ёІZж[Џд12NёŸЕVвмЋ MU4hцt‰Мjs уџеывh К@‹)]/MN—˜дВˆўquœˆšžЊЋт`Д›uB,œЅE›Ўtљвœ‚`ЭНЫs2=Ї:щZƒБ§VА {iНŽMlПЁКежфgЅЇfЕР™=™[VKЇ­ЙM›ЯDœаmСУЉУлЇтA­ДBяыјњљU‡>§ЅЫ&BЙЧќЎДпњєХМvMЋч;> ˆру“є09tzxсмhЄr"юЦСYљpђw'…ХKЗАd3jкЈ>Ж? -(ь|x МшX;Џаэ^˜v"l”[ ‹aЉюЛИЃ:Ўї:kыe0зw№AЪ•ГЎ&8§,pыЅ2:ый'сЈицР’№]ЎђН'žТ6MЄШ—кf•XUqqšФ›)<Лэ”ћžxX™;д бКЦњђrўg г­1ГšngжЉнXl<Ъ"UiŠ^\gŠK_ЩqЖmZŽd={/ТўТаCоJˆkN М^+К}wў|uBэЭзxM:јЪxѕCоœЙВ‘‘ФrнаiCОžUZцњ$†БП[‘<щјЏ“AнwMŸGИрVWьЕОOвмўrrѓ]L‚ќыxJ*8ЋˆКд%вMЃфћЅЪc”јсZ&Mв›?о‚—‘­Ўw3‰Kъп~<ЃJвЅ†Ј­LћDЪbP<ЖоюЋZРpт`fM;]zW[щќŽh 22““…ЖО›|Ш!Р'yp<УYEђЎЙrъ.BŠ&T`WсМЃ­Wт‹ѓьNSЯh,Ыі‡ђ№=№Н РЙ“‹юMIЙж2ЯЂјј|5X[М`Рy.^>Bоg!џЈˆШ%щех№ЦХ9ИhR3нђЎqW\Т%ьj ŽzpЗXJSфэАM2wїЉАЙ™yD›JB+ ёa+Ž/ЪТМ"ч‰’Юќђшјh/|DшЎЉІЇe4ŽШЏјBN9&–%цофBчœОz+$Ѓњќћ:ЉќнЊaVžѕйK!и№…|9Ћi=ЅQ\сСзЏ‹0E.ЋРᘺRХ‘-|Ќ3h,*ў~ŽшxєБЙs~Ђzw‘$ЃкбTдFђdть~|fЁ_Ѓž&6lžъ`ŠьXг…$дФLёІ ї›kt+_Щ №2&|9A”Єœ}”љxЦЁs"СВƒѕ{О Ў БVyYЯ]:з–ЧЯО.ќU—6уXt‘ ХPsЭ^i^KФ Щ~—мпR]pСаŽ’|П6хйўAЦШМЪДх[w>ЧЪ,ј-Ќ7a)ЎmPУAіхvђYЭЭ}вЧ-ЊФВЯUгВ•ибѓXиeљ=jdњCЯ}ЛVQЗ(3[2б‘=ЈЮI…žh(ќV/ЃЫГї”КW'šiмшЊЏДНъЉEnЌЃУsЪлBяoEї_ ХЏњŸ=ЮˆЩJ,1ЊоŒˆЅЅ #Йxгt ЃaeNd‡Ÿ†9Il12;ѓ›бјкК|Єїюг!љPў4љ1ПьDх›zТ:PoѓI&iтыљRя•ЦлЈ|•ж оЋFкц…вЏx›•kћдю!ЏВ1—Я_Ž0XpѓіЩбЩ—Q“зZˆ%Џ—qЇы{Э@цѕяйъўдМюіО8TH}ѓтјЪбёs]К›ёy7dŒm.ž|Ї„Жw†XD™yynMв˜XІ-оЉŠРWКxTОэвшšˆ-?;cЗ5фП"ђФcŸЯ $œ %ЕЖ0оГœhб|aО#ѕњz7ђЖНсЪИIбЋ‚”єж[гР=a”'–БДв8[Чп eoРo{ –’’PЗЄnW1—Ѓ'Ї”mRКѓ>'SтsЦ`ФeЛЙ+VњшьбwыwQФ7"Fir./оiRMžиWѕ­ ћ˜}e.—UpЅтм…твЈѕ$Й)­Fў.jV.эPЄђ­,•Ъљƒ?дe Ха’{цšDgЄЌ˜Мvˆб<бГP‘Н яЃЇОм–”“yЗ+ _уXqнЮŸ†OCз43KZrYі™-p{.Ž7Šз‘ЄЖ0ЖБ+f9ѕЉŠžГnŽкЛЮ^—pV]YmЦlMLї†ЩPХ>kь}Kњ’Кћhl…њ­GМЎђ-ŸІx›CeљЋЛkWюYетWТ†К­зƒЈз#a\Џ8тх,Ъ0Ž№ŒЌvМЮ‰ЮЋ"?аЎ§ьѓj_4бˆU‹ц„эЪ‹эбчЗJ;Їh6дХЬЋ–#=СuФюŒ˜b„Ђќ™№БјА%Z.[ђ\чгyTщ3EtL›@*нТK[JЮ˜а_ѓo+ы /‚љ9_?‡_\ЊŽЄЌoмpBz[­6“йŠУю=§ ЊvЫŸ3Lo№Мр§TьЫ*GђжЋр9ял’єуvк­ъїIДЋ\t–о)нЂИрœFlЇЉ=т’ящМ$SqК–ІiЊъ…НЭˆвGx9ёѓ/Хtб–‘ЁЄ˜d­О- ]Ž$-ЙЛ†Ђ UŠМЛ’"­I*фЅ:.Й]Бl‡qя+e6’жлЗXХI€Eў|)Jыd@іC9.ЧѓT(*ЯЈG’CЋ{CbЉІH%˜n LЊЎжЄ?\НtњFЎ#шѓ˜ьУјсH•`‘ˆbйld­`ыЎbиMuыТа‰6 Okмрbй&Gd'En"VЄ,гОџ(Xєэ##[н"І0jaђ№й&ѕxІlS.Gdём h­‚§ёњ№Њ^gЬdкв1† їЌ0Зы,Јoƒ[E?":˜k[GЎYT˜gO”а ю†„Џm(вћп OZс.нwХ2"ђebnu3}<2jOcMOяИз,А™4lЭаm?ИЅЬжЗЋoJEun;КxШ‹ш^JAkќ8ЏфxPСпзя9Д~fс\Рьz•N—Ьсл/§*’ƒпиоїэQ €ёR№oјэєб]^К‹­v?мhс)рg‰јl蘿‘ХткзœтМg|$‹A™ ЙjLŸpJ‘_"П%‚+"5м^яСkБtw.Oѕ}xё0ћkнМb/ѓiœТoЯS"!ј‰ЖќФъцЬ””Љдс”'ьѕr#WJЪЖ|хƒKOƒ}7гˆвўЉWэZ€ёt]ru;0ѕ‡›(gљ€B{Б,ЃИ9’ЃЂќћаpщn Љп3Рц!UоЦГжXъбTљЏФ0§ьъйLм[fjФѕ„:мcЁ˜цЅЩek6ё) b@y„ћ,5чbўі'†(€t8#bі­Х—yšхŽЪ4–”–Žб^зш$В4НrŠоТНTUйъЉРірLз ШBЬ„+ƒ'щйЛ:чЋ^кEъH6vNЌ(љž(јьц­d.іЉYућYж=CќЯdBд+г‘иMЪг;YцЭѓ"•$Šч.gSЕ€фuчЅšнw3ф%VЏlМНўњк—ЙР>EэёŸ›tBВuBЌ;НJОГ Tэ6џЅ%MKiv>&и ПБЎbЁ& 9жД№Й”›вб=deŸf/Ё{Л4<ЈŒX])–ƒ˜o#Ў~;ИѓЉK— ™tА]A€§gM&meЇ›ёИБљ†ђвŒXFћAєЈкѓдfЭЅ[“†NŸIІѓŸSСi#Г§THХ&%Ž‘Яьяїѓ;ŽŽЎєЭp…ИzŠJGN—œцo1W$X=Њˆ}„69|WХ8Iьx:ъћ^‹KбЬѕЄ':к!OzZsFоњЈЈveоФЗшѕ#ˆƒРЉбtcѕ3xші‰Cj_аЪtDНЩѕВ=еъ,t•Я›ƒx8ОЯкSњгСфY.;Џlѓ+f_,^JуfЊјОІV{"KэАšВЗIчУ? @Ž|ш–ј\ИFЗџШ 7e~b2кšr$ZЬZP 7[f‚G,(Ÿ”Z;ж9ы$DnG%q% VlюiЂHjлvгр›S&г-ЖЄ Ё!бО?ЂŠЅ6S^„йЇ› \}bск@§жЦЗќ†rUGкk†&‚GйšИpоˆєлpЭOq-SЧаЛP˜xДkяП**Р Я–5‡&З%’Ь„ЗН6FK+зnис4Ж ЈвиAšлИšыцbЯЩlИМ€Ÿ%мM›Sc>…Sнd=їџojрС endstream endobj 220 0 obj << /Type /FontDescriptor /FontName /RZTYJJ+CMSY9 /Flags 4 /FontBBox [-29 -958 1146 777] /Ascent 750 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 43 /XHeight 431 /CharSet (/lessequal) /FontFile 219 0 R >> endobj 221 0 obj << /Length1 2172 /Length2 16488 /Length3 0 /Length 17793 /Filter /FlateDecode >> stream xкŒїPлыі ую‡мнннŠ N‚Л-ктюPмн)Хн‹ЛгтЎ—}Ю>ЇћќПoцоЩLђ{–X\Ќœ€џЌєЭЧѕ№­‰nџ€oiИџьoўžџ€ouy§‰ўцъtњwWџgЙЬ\окфђЏ[№mѓўƒџѕezЭчСfС6ЕСэwеbDюLЛуьœЈ§W:;Rnћj‚ї—љ‘ bнГ{‘їXЧьХЏMЖКИЌЖFы>Љ‘ќИ‹ѕэАІлŒ>“XBЧЮŠЎь{ ]]Œ9@ц–ИЇЭъƒюWЂ3txŒŽчЛs‡2‚дЭ•ЗVЇ№4П˜Q ЦЃ#сёyy9P ‚;Ф2:*ХkФff;х(/DЧЧ“HоЇіАsmѕ/•2BZoІЁ:(\e Їєp*OfЈvzЄ№Пв^ЕЂ5uеЁШ”л™МНи‰–SЗl–и€юK†–ијJ~Ж(–эaJГe$@п%YмБ˜ЈYшХСESкSV&ƒ-$ˆмЛ€(=ѕ+И–9SСGБfh*ЮHг91s&Еq$ЛQUувћ'л”тHdSŒ5ЃxЩЖПzDV4МЭOЛЋ.5Zэ?аe‘ЉШа#ЮпSjћpOœŒЪ№Yчт$>ВДгАД bХБCдœ ќ0ШЯГ]іїъŒD~”љм;дžUc‚тІHю`­ёФT\„ŸgЙпцыrбЖ)ъM@X2Љ7si.‡фГœчŒ9em1ѓмВM<fј\'ѕпыЉц—ѕkz’]ц™Nђk‰VЭЈElr™яDЎcД‘cˆhyЂїчКюПгu‘yЎкво:ЗkЪ„К+ы:rЪѓZ•(ЄМ4вlэEЕX‘cˆеvˆ‹ВrюRзШт‘qc_ЌZWПќкvˆ­їлљI|з]Л?j(Ц”„Šс-˜MБ.fЫЖ §лPeоЯ 4—ќкљ”;KЎ@šO„Еє]š 0‘K5PЎЃя<8SЫYўM§N W†“уыZЪёУ9]7Bz(чшcU˜—EP%Ђ•ю‹–a!sŸ )юР4”ЗМRЊзОl?r—ц&zтЕЭЗD‘МоG’Э48#Є9EЋŠЪor.ИО$Р)јэwдћŒbЊwшъзgП”=|J›л“ћjфf‚QёKы~ЪVTЌЇЦKa’Л a1Ž'чK X–ѓн†œт %ˆVїцежЇ=к‘Љ{ф ”Д\sh>Ь ъЗ'1Ц 2њe8 ФJ|Юд<јŽTєB?ЏЈтŸГбМтђх9ЄХЈŽEПкцФL“n\N›Г@•fY^і~ dЙј&h№NЕšаЁ zЧх*‡ЛN=Нfž/‡X`ЁSнюRf˜|oлyФСNz ezqX’Ће0Ѕс r]Rй€z@`ќ|hЕЁы,#F^ЗMЕл?–L>euв&јкЃЭУƒUiE‘“HA” Џ91‘ы‚Ѓ(љо2sЖU]§™#oйWЩЬзИч")ЖрљSЊLI•‹еШЩpоЃŽ2гЯЦ7vВђ>{Їu ыЦМdR{гАВБ$_ЏXјŒО(*Žs<jФژп’HЭ2­`поEy#iМ…ЂR’ўœr Д=kЫгг PЬЇQ …сэIў5SMЬ§Šх|ъ›u!у|rkZ>D#77ŒˆF†{г5d"f УЅсяЮОa7мђакЈѕу…оя/кB†(ZhxМ~Ѓу;›бяЫwœaфА\ћ$—И]-6 лђA/ w -рLВШ§в":Я8f#Al„ЉЃьзY#Ke;mўѓЃ`Yф•к‚wЄS6”Ь_яcБ%–ё†„ЇяЬv0ЛѕrНz8Ц$ ШIiWK=уJDJЋ–œЫ B%ƒё]*9пsУ+пнЭ>9šцiІ4ћЎ єЊ.ШбМЈKY­Д@?О'n €‘9œфћZЗuEй9ЪвФ G@Б?\Ѓ%u!д.‰ЉLиХГ—Њ (трPєлˆFвœЛIСy(ˆ­’.‡&; $уўЩќО‹|,J‹†Плрtэ,.ђ™ЄЧ}?єШblјЁj§‰ше,ь/М œУДнЖ’#Ѓфsmq}“!ЬyЏКfйж/Ў™;85“MЫр(=cxK:ЎwУЅ‡ќеVшйz N2d‰-žОš9ЇVf™ѕ& –^Ѕ•ы`‚‰JбЯ†МШyхйъћRWЊWѕч:VѕН c^†в8r Й]^Ыu{Šу>фRеюОт{}…‡•Ќ•д—n!œjќЎ )юW ‰Y?ЗЎ›y0DV] ВI#Њg Љ<>яI‡"РyЗіћйФDЎžљH7vP{lУ7!аАœ$э9JьŽpЗџс”}xфЂWЎ2згgD,ТДщKЦJvђпшя.-ќ‹ВЙsIЉшдЉ†MWymJr‚ИсуHэOqвFЄд˜$HQЧœ“šf_%?U\4” Љsр с<˜ “щ-ЧѓЕ)}VЋ…Odбž3ЏлЌ„DXэaxп_ТЉКз! ’;? \!–ЛvШЛ.ТЖЂo)ќ`д­ўq€ItqѓН SЫЖX‡}^†z7кХіƒ•Ж eЩGMЫ"Ху…Fзg˜+3/>‘SЃњЯЇZђ\іš•пGWЃL w~<x}†зŸЦŽœ*ŠЈеВъwІO‰)fYЬщю‰4zОДnЙKн;i ?œ~Ъ[Ёn~Іъж‰%Jc~‡jТІУ\яо8jmВ&[QіrxK!Эdl)Dˆ_iБJ‡Є_+%ъџ†L—s•z‘&ВDžсJ§юЬWћЅ,рjRFЯщG х|юр4ћRqЇЛяю]oМџБ ‰5b†фЎqЏ-1ѓн‰няЊt;LЬX”’:–ВЛ•4šTZvUCAФMаэLЭь’AЏФгBР~тfTгŒs gЮ<$p{DВ(ˆљ(>1VЫБ”ŒVј-8ёЎ—5+DкZрV!ќ…žЬ€ љфаШР5ъЗq:бх4D' /а’6ѕyCžНсhкг™эa‚˜EУКПaP|„ЅдсТOќх“eїzџ4ƒ}р‘SЧёYNШ]˜˜QU{ŒЬ^Ћp нЮK—~…)пpѓкНВz‰SpЋсЦщѓv{Ь/Sо^ЭМT яFUзп|Ш0TфH§щlXcН ­˜WF Z˜rЫ^-Хй‹;ї›ЕЮћИ]4%Љвжю2дьУІ…’‚К_аЏ'eЧoЛ нfg/…u“9C/№‰њfЉ7Щ] н:Е8.†s[zОm7>Ф™ОgПї?kБ—Е gѓu|n+ћЈЪŽыГjТћЋpШяѓШЈm­ъц 'јўлЧу§0Œ_Ф[BB˘8бˆ—Љ…nщГБa—б—eCыЫcМwZ\њ-gаŽПOб^с„ь‡7†љ_Ÿ›йfЃ1L› P%Пё=уљŽH‡AЯwUАоšэ7э€ђдW‚Кхn>;д{ZkˆŒzq9уы4Ь/^WжЏЈj™ђкм1›ЉТ`—'.jіѓѓу<міІ:”/]JjќЊэЃн'нуюпnкX.нDmš…Ц_7>*&Š†о–КџPžn† і•^1з@h‰Ž8qи;Їj5Q*6ћ‘уЬ’wB|njњо_'=нq­ЬТS-0&уЛ1, 9шр"њO0KD({є>2BЙНv^‚ImqaЦчppуљcФ& ZbКн ;]=5ћ'ˆaЁ>фЖгђ%?§3ђѓk№Q'Y­e=jХЧ:їЖp—Ÿ yц]nЏЉaЇ r) žщЖєRНRюћМ"'ЛЂaсїОUQБ‘%@ ф4Vз…ъ;ИN<ьЏLдиŠзЗžžЊБE%Тh‘2›P]7_еXП…FŽ)И`zЯuЁ[Šз=’Я­нžJZм‘mЌ љDЦ•Ј§D‚оц:ЇэBдјсW,ƒэьіоЦ?u8оЖLй’x›х ПNn§ђцыGC-ˆї9пНŽHуQ4O)ЕKІј0mЦN–?Ќ7\}yХ yѕЧцкъ\o*r žQs­ќН˜:-ck6~Гyт]‰шSЄоzѕЌ‰|€зoјЮMBЬъ€В–+з“O˜їXŒ—|„Ю6rW€V]:žЋ1Ќ2ˆ"ц&"™œГо6ЕнЋmы,dчfК6‘ Х;фS;јУ у#•їйtq05ЕБУ*ФLх ЄoJћЕЬѕгA&PШBбНР№›nŒ™i$e|гTкtИ"ч‡ЕCtТs`Ља^Чрм–+щ•Ую|о[ќвxФЩ№§аПГ3|—_X фя№ Щ2ПиL­ћ3;TИšЛЌУ(Њ"р^†ќr[2K}R]ъ5и>SД;qфœЛE€^Е3ђ8Л6йЙ—5ž3ІФKКсьХ|@GšˆмР’]”1Ъ`ЁqAаyеyž~кw%цЂ7эƒ†Чч{Rо‚ŽЎЇž­ђ]jЂШЄGXAšчyкcёyh(дeЯ˜бСэ&sKўEd;8DЃЉ$(Њ1]йaЋЪkAPж",RvpY2 ие„`P`iимяRш2@^'‰ІLž]ŠјЙ№ЛFQC•ЋGZh.МŸŒт'/$аgha,~жВ&юЃrхМT3іѕ ?anqflFќВ–иSW ЌЙ шGМсњеЪ3ЄMэ`ЅœЕq./—(%ћгЄыў—љЯ?j н­эПќP)ЪНй4ћІд4•c+'+W€.r&ўXUѓёёHя ‚ЅрнŠь•ь‚ExМЁџG,ђMШyЎЏ |R“гXьšН№ЃЭƒ{ѕg1*-њЁusи•3wЈг–їBa‚gЂuьŠœ§F]аsE (Ѓhоw!нge)[7п=›<ŽЭwŸ4›Тri=žЪ6Э‡ц›1w4Ћfp?}ТцаuГ~ЖЇŽUОџ Lъ‘оо K_рAR)„0ђлxx?iЊЉ)ђŸb/Ж]ˆ–!r ' бcуц;яdќzєЃ:ќеЬщХi†љ]DW*pГк ќ+ѕ‡§LЮxєБ:ј ќ=я}t哆ѕ={}ЯвљzmШL8ЗŸДIœц>YœиwGљ!˜ЊЅFа-QL{~юo‚RŸ§ў-œkrИК3<Z~зПУЊŸв _@­H•ЛЪічЩž*іO˜ПТ.4;тРРрж“ ЇKџVc†C№p>„Œ/‡х‰ЅиШš4)Э‡5eЏWќTЃБAXНЯ–”Т+N№bЧwт!^MжG+Щ!žзAАZ*ˆzsdD2эЁЇЪN^їžУйЉкW}Тl„;].u1zњїsЮуŽ9Aѓїy(Ї7dт)шšАS< !Ф@ЛКИг6>-RyТњАkыЗG ~nЁ Зѕ/…bп1JЏ.= -d?> (ЃyЪjХСВЌRгНŸ{ui†;e. (щ&›HЗvїШJ ёі?Bё”ИZE‘0ѕ‰œьФЏ@ЦhjKЈйNфСЖ§ŸPА“љЊpЌСvб‘В#oТзрЕЊгэœ?’0a.Y ‹ +ћ€•a`ОœgгщOЧсБBzІБ@tтј+Ј=TйЋП3X•уrАЦQёуžДе[цкId œъс{оjўйЯ:T_cЫ+Šі^5„rSЭˆц˜$6дП%yоrШЉ,^ъŠpбНэщ‚>щeшPо2X”@^“Ф,в37U5ЫВbЗЂoЗJБџŽ+\ня‹ŽЛ8YўUмэ#ШАŸ—AŽЫ]ЯPж {ЅЖC@‹| …є*h#J™џћ ,VЫчEzшФ*§*\яЕї‡Ь_Zм_Р ŠTcЋBЯеw€,ъЖ:ЗЁ LWп2GчъРюbFЕ­jщ*ѕN{“ иЎЛы Тн,OЯЇcг I -<ХЏ_t0еn DбCЕV˜И+Ы‡‹-­ rИu§‰.gd:ю§'MіbЪЃэŠ›Wл-аЯцєІ—UЮПмzЪ—ЋХгwЋBBГCP ъД[бH ЊМЏ†™$@Ы8!}­УщУM…ђwЧ~сœи&Zbƒі@Žя“a?—!Y‰sŸжйД.{DЭ›ŠжЪ•ЧЉ„p‚QжЎЖTф‹Яn nъ^іЃ’gg$ЁУљCxплЖМА‹„сkІТœ0>Ј}глG”ky< Ў—:„•яЄvjџ`Šˆ;\­Ђб/0ыч(Эg6Hqї­ЬЬ,™ u>Ег\q Р”Е?iЄ 32mЭЊяУЯГZѕ wђEaњY™Rdщ/‹ло4@;93]{&cЦBwо|*ѕVž”}ђ%ˆ&šY]fћuL,X[ 1аWpШžЊCтƒЄ \_2ЈD†іјZџHv“3€‚ŠЌ4&v:+PuЛ0с‹fњКЭк™ЧТОќхГ3vё ЬѕMIвZdŽzпТ5€vП/ЉПr€јKlѓЉ%'щT-ЇЫї>]uh†I9 г`я\ЋqЉмЯ†\Aњ Цt^УїU9ŒxэтsкCфєЪ…f›†’-ЊжшыEž–ПТgЊ†FH KЗe]\в)ЮII.aєЌLŸjhŒC€ ]TLУK вр5…XЏœЇњЎћКI#o]ЪD$ОеЉZHунЄ Ў0›ќNЂ• [X‡”4§~@<š'UтAИhCѕЛyJяw_ЯЉ‚ЮsлEzєZв~.‹ž­‹hg3Ÿ?зХНЛр52“™ДПЯKj /; D•ЋжЧ/ЃfХН?*(ЈшрeП_ ”ѓJиЫІ46pHЖ•чѕиЧПЂMа>ТЮJzї.е|Т7š‚иЩђЧF“9’ю4ы]R–Ф‘8[›‡В&=tŽŸ:лnLФЏ§ 5Qѕ‹WŒ;!Aсƒ’Q’Нд­ŒƒnжlЮЭvЮG6ТW<—д]ШэЕ•лЩ9™ТЏјщё/ЅюDІ†Т>ЦЏOФiЃCвЮћ2З’KГ™о;^“9Иэ‚_цˆјЯќЙ№ІРfF„QЄ+‘7[ 86Ъ(зЦІ[$Џ0§6Aч:{нъx0ТW/R9hІ!hCtоЦm š8}Ћў7Ÿhэ`ВрCВ&Т]‚ФqNDъŽФЛІs сŸlлОRМSJ-zП,ш qNпra0lN”c3œњ8шЗ‰‹žOРU_9&b0ў•r7—3z Ймmh[›h§.–›w!(ѕ(Чф*-ЊшƒCTеž:ž"\`Км“љXŒЦ›šsкp(їщ8Ю№…- :ѓЈлAЇ3њIhќД­ьa?Ѓ5Nqы}Къє›pЛЧ4Ni/`Z •ЩпUвsŒ;™€Ю W,эwŽн!1t}š:фцœфMYЖЕ7њEСjкOбƒq ~XкnьќЎ5­qџЂЏrѕЖЪЙ@lЙГЈ+ŸУз “Fh fяУj{“Ѓ‡ы"Џ)ЧњЯIvД8›Йы#њ„uЙ&б!ZmŸ‹NkB™Зк(^+Б}y^œxлниbтйв‰X{А‡їћьїАuйП7bЊх№ЩО2ўвМ„ЇпТЃыЊ2?ј,Šџ93&4Юv†lŸцt™јл7it}Жв b‚baUъл†ІЯŽ"Э{ŒxC\кн.>y РˆqљŠ”›‘БЧEdUAмпKќsХђур(5КЌPД.DЊFŠАeC*R—o\Лn‚ &г5П‹Е'”н*iдМвљЧOФ/1H%Гыъwrжš]ЦjtрљjrѓАЉ™•ф;:Io‘Лј’‰Л?‘NJё@ђ >'я&qѓ7ŸQšnR"#ыЛј­YƒО~rk'"$оG7KПNЎqщ:јНщKEG’ЄќЮъУXh~џ~­з­сЭО`­Qч ‘&1‡B`z2ЬЄ†ЮА^>TјžЇ…ѕИЉЄімhжн’џ3ж…Pq#r–5[‘яe{ШМІ*Џ}Z—VN]Ьл!”jђЅOЧЬЌІ˜­!…Н›u­†РрђнеxP<јrрDиР‘†Ъ§”ЉZG›їхFжˆI}>§И}|­bEПF™lЈD<ЉЧDfuОП]џФ*Su0БМ~wrƒ№9ѕeХBLuо.4эT)˜SR~ёn еSh6ъ>Ќ mФueПoн•Ш…тUтИ@gBwhwAБTrГ"тWљtЈ3:1ъ‰MnIuviТT ŒqTџ‡ГLwўђ№MAГГвфIŒ™8ΘoC Ь}y1Eh_ЅКYІЎЂЖОp“ћZиAъHљф оwщэ[#ž/З3=дc<ѓ Iжћz$йѕ>јЂEшŽвžъaЇalhMdxЛеwс;йБйБСXgЯЖ:щњЕ ЪХ{У!г;уa\ђD{:Т%ЧЉсœЈwгњM=џ&)єaќ(‹]'#а№lш\ЎБъжІqъЇ№АЯ&џц.ъFЯєПŽ‹КЉœЌ›‹­џН[TЗ]‡ъ Ж‰ИЛЉP–rwi7э‡ЄФ#Б4Kš­œšoш•Б(/zт.ъ‰-№В&Ј Nь3Q7X[8ŒnбFЋTбШ}œ[Т,ъЄЌfOќДэMi“ —|ЩшЯ>‡СoЩжгžБjПнRjмбVб2•эiТ[ХQЈ^P­Їч@O‰P џ9в94YР•ewRk‚-ЏЁ§jђЉ‹кєш3ЪsЖGїє€„Ў/†ƒю‹К@– ћk /.ы™CрЃ№ЏPŸЊiђКжv‹Ъ@€RЦкщнї„рЭПЃŒыы-ё(љяШœM“ Ѕс+(V:б[ЏiВеzB/АоJФ б%-рv3\Ш;kЧІЁ%мощ F™І\g)6)с0тГ LЌЊI C7Ы††p u‹%БSХј@kfЂgGM™ђ„Ц•я}“›‰ЌPЏыFЅ0СaeKjƒРыJБж$Ы rOё„кЗ+ЋœK)wJўTлtzsК–h Ь`sВ[!R…+$\јѕ =С L"фт™*†ЭvячЈл“§ВЉž“GlhшЄЌщИyяЃažшmžˆЛу\ˆŠžŸЦ1м’оїtJBciэ5B@?<ђсў"ЕФXiѕŽ}ж|BГPљцЉ-Щuž2^л:ЇўŒR‚ѕ3—јЕ™+боrLУg†еbГ5aa#$о>eиQр‘i7„CN­чwyтžgМ™=иšщVoЉ+кЪG™ЖЭm`њk_TЛ5ВBЫњ\uљ”"OiVљы•WBŽOcжN`IО&˜]§уžб№"W‹8џ2ТMф^LЯРЁuћ ­NЪœџb|%š>Ч‘LPnЊ<WA6€!Пѕл‘œ,н zўљ/&ФЯ•/ўЭ •ЃК eЬvЬСMтЊ1UТдьэсєJ~ƒƒ‹кЕ Žyrк"” тб СШ‘_вЋHЌ]гЭЉЕЕдvzmНž˜ю.№‰xWF^‚ь#”JŽXVGШ*ЃœК.єј3Kє~‰л&)mн@Џ|…‡6ЃЊЎnЮІкЪ(Ђ}8P#nз—M{ъХmц+O ЂЖЊ4РФыМeЊЇКх~$…yА’ЕЫ‡й"wЧn<[FвмЩ7€дU~ќx-ЉгfАЃŒТ“/6Х†іžƒЊіюl€DМЫЋЪNХЋюœeщАЬ—пœ5†цБ"Бƒq[ЄB„1жЩ&љvT6ёkџЖтќzіТ=г<ФќQћТяEL{јh‘(Q-(+|G:4J›,gm+Ъ ЈТRlІWO лЉ([ЈEТ!ЧшѓцЮлwˆŒФcЦБ15fйХZQЪNў-?ќ0сŸ:TИЃь_јuё›ИwОћ7'WO}‰ЪwЈ8Uс`QspMџTlгнДйхєgЈŠ \/бq_сХ№J›Из>ыoœйнJ№–Ы.ЊG'чЙ’Хшр-I! Ї|NьdБі#жŽ"2цж'$љ^‰J<@l[ŠђjЙ+2щ‡ИђпKпНЬœЩЖŸжРˆўTcež:ЦЋ…КБ{gЛdчžЙ,Vƒ&ьŠdа5~—?ул–ђіUЩXЊ(хђŽŸб)qеѕы‹г;ЊZЫKV˜кЫjfПZmЭЁŸW с.YŒ0ђFš—ЦьЗК@RHtвЊiDОzГeПќ3? л%XЋ hŽVОЏ‚ЊЃm=g~мХН~нЦПщ№AЛеzЊrЮ6 ѓщ!QŠ]<ёЪЅ/˜gдю$‚=!iuŒiПн_|іџ”ОEлщiIцDПъwХж БЮЪт ivфiЦ7P$Д§#rЖі0п3g8чHЎЋЂъу)ђ55ђY!КєЦ—Ё™и­-ЋЮu#Аь,ГњЃY5]ІˆD5xnт;$cЭrt’Ч0ѕЩy6\m3ўh}хuЦOР™Д0ЛьЌЖ`вЗEN{GƒŠš8m2 HОсJљOэ…§д•б-ЯxђЮ†ŒЩ0хRLшџ@]Жю$•)щ ’ЙoeNђу @FZ*A nя{ђЛœ/3<}ѕГ`Ќ|žЈщPƒЎ‹fAФ4ЕЁdœ)5ъMDЧаЊY+qгМ@Ш‡лЭBвEП аЩ3ŸєВVь;Ё .Ї zќ;Ен1Gнf†š ђФїwƒЧ§ѓ€VŸ'ЋTT›јФѓ­ 2žlh1И<ѕ^RьW”ПЅ%:жГkиЩЗ~AрТ:лїњ^dk6 mЎZicЕёвgіЏ[ и~ScиеA]§‘_ЂХ,ВRTВkАёѓЧљжћЇш'nСo'˜д_o[ХњфуhіЌцC8ПZѕЬ{ЕZБЁj}:aќѓœ aYЊ†ЭэBЮђœ..\Іцi˜кN9sЏъo0VјsнЌ0дiІ@‚Cщ>OЛpз(Їyб žГ)‰ЫЮЧ ,Вbƒт§mэфЬ+­Ыž­шдІ ы&лє‚tњ&˜ЈК‰р3хгGЂјХЖЄxВУЩ љˆѓЛrVПiQќсгЪcЇ;я2%nHŸ@‘n˜хIўфqЬŒяГПT*?+Jї4Sм‚г Ѕн*Ѕ6 [Й‹}žšПЗg&ЄAnuHМу†ˆхz§Ё$Щі SќЩ)шПднфВ`j0Ё'Хl§=Р‹ЅD:ˆљ…]‹k@М8‘І3™Ќу˜‡h3Š'œЌŒљ0Ц’ХГі#H\?П5…G№ъиЪ"hЎѓЉMЊі˜:џ _Е•ov.Г‡ыqЯвlН71ъхЌ[щGл Џ,~ ѕД<ъoн{х˜цт№сwс†\$ЎяwI“QЪ >{‡ЎeеК-ƒjщQе-аe„mмS"Щ-fCв‡дУх§ВЛ.иJ—b[Эs JТБ[y…ІŸ ЩaМLЪМŽ“Г3 eѕRЄ’Ч&ЗК[ѓ%ЕH8Ъ—йMŸ’7 §ЋЕ‡7M+ Sž­mX”ДГЩŸ5’fxяч7'`7я™LДБъБт˜*ы3‚›lэ ™pѓ|d№›:њ3Pk`ѓK”Фјк'^Л-„?™Ът`цcдТЉ-išŽП†[мKb-uН ИBКыšцў$N$ŸLяМ ž˜q`тУRЧ€ЄJЯ”-нЮ{rЕЇО~шш1'Г?Жm Ц.iR/Иб” џ’Р<‰/ЕБа•^ІУЊБr/Ен?~†ЇћКхjŸюH_с*‚^БдЫ8г'\ЊњdЈд/|ЃУэўѓИ]д„ИнЩЬВ;QѕМ|HДЊ впЪх+птїю<&,!ѕўEt‘ћ‡Z5nsбsлЁwъД#СЇ+bЌј:ѕЮm"h.КG ЬгВѓХъРC/xєZёi­Х а9VнjS||Е–;1тA['Лu]ц ˜GЇ ЄvЏyyтиєЖа†D.г2UВnfэє’ѕЏ ЂО.кhGъb9гœхгM§OB ‰г^`е"&шxОn—‡џў†б@іъ|-ƒNЭХOŽa%З‚—ИЕСO? „2sˆ•4-г˜“Ж§Šн„jЃЁE|Ј5ehжy]в-Нў^А™У„Ц.^ГNЭЭKєQ^$зI .иh„‘^Cѓ „=FЯ)Ѓjqэ=Ђ#х1ІmпхsЁКкAk)Сі– ж>ШХn;І§”нZYйRžкЋ(им@ўвКŠ ЧЅжŸрЕ!з фœ>КyёиЙ”LјацњюJЧsьЯhЄЉА9]З№~пГёЩŠ!юv\ЗъќyYm<% С $\уѕЖоъѕП˜g“Њ ˜yR_аЩJq(HІСK ье4ЃВ—ŠlUзDœZ%pЁ‚BКэDїШ\Щ9Л{ЂzНO7]аЅ™lЮЯДІ›•њIDХжr€Sєhї–ІSИObOBXm4ЪP‘>њŒ уXМrLe'rdї–ƒ1+рљ7ЫМУ–#;5 у3Шwj<,ИŸ О,я'›ПКSШ1™}Энєа…šJА7~§фOq5xp{Рh’ф]›%ч‘УХ9pBЌ-Шwcd*э І[ѕqŸ ќтёј:ИEЫpЕVЮp…НяБn2B™šЇ" цk•ыEQПeHg TСЅ‰УŽкЃуэXh-|M‘kАЂ+N{В‡9ИT†яШ§ўrБuKiкОT@?џТ&Ыдр 'd ;и…,МuЙТ:Šr‰_8aќљ} _ƒY7ЄєЃu‚шŽл>цjyЬ‘.zEРh|ŠžбЇ}бЈGх‡†C~СЇЅЋлtЮ-њ™/ЫЮœљїBCŸ-ЧЗI]іл–ГI]лР5хг{3Љz xЧ ™:%hћд PзšŽnН€R€АЇ-GО?-LоЬ 7ЂZkQGЃ@??}ѕcKйГшƒpj:Ћ1„Ye—peєfc‚ЩšТ5zLИ:D>EГдЃЦqќHкT[‘Т€Ѓ@яЗVіЁ:›,?ЃC@tЦg™9Zp[GSГ^Ч™DЃк№рa˜GТСспX_+џ№ЉЩ§8зоH™ѕ2C<B=B!vU–іžфot­Hд *ОmЛkфЛŠEjod[—b;J)—ј-јФЃ‡e№Чч‡ vЬ}Р’™*Жь8}ИŸіД‰ mЋъ š*иЇрilŠƒ™їћ”ЄћэўˆKЅРйNЪTjбЏЦp)Яfи66ѕ dШf_,пsа˜КѓNЋRнЮІєfпJJ9JзЏ0T~Џ7žдfкй—пѕqБќЅ;Qгќ=]оћ}ўЯ_‘ Ё‹ГЗ‰їRќЎџ•žZБф2ђющŽNŽ?Ѓš)вЕ‹9ЛxWЩbtG|ЩYѓЛКœƒŽзжЦŽŠo•’cЩїyЛd~їИ4XР‡aяrџO1vi3Ѕј‡8tќ•­ˆ`Щќ0Э§ p_*9нpЗчV~‚-ГСe&•у„usŽѓY{§–GŒ&ІAп ЌДР}ШCBЕсМЫ~Ѓ”:оВo•[(“N§ЂщЦйyяЧр‡žН_82†ЌїYGhIUššM :pА@K-CUЕuzžMо cЁЧKЌdƒ‘вФ uoх!T4Œ л3сЅВсG„yGЂ/эŒё'i‚Jця‚*~˜ G\"‡‚|e*БJыXІнŽ;*2ё4F‚Gф˜6ГЭіeо“ЅЧљ’/Zї1ІжЛЂј­Юdaі}aOpющКЃг~§-0 !‰&с0пcU•.+Бt6(>ЁЇˆНв)H­ы uŸyžОzМ6vЦаэ>ŸgCїФ`3ЗЮ Žбкx 2oЂ7оoqЇћўЮC {‚+fт—dуR&ъ'ЉshїВ П­=к(кgwіZ„Q!GœхTОэхm/@ђд&ЗџЊVѓLs:л lуWЛ‘тi FІ]Б= ехэdc>™Зyџ“0oСвx2ъP5“аI‘фЋ(f§ƒ„^{6ы^“ы‹q љчдІњ ж ф…AъЋ–ЦУ2MчШ„'ЛИф8Wъ}ЋЧTЇPux‚Ё‘kьО=њ<ќ˜P]"Ю•\F,cфБ‡ƒjіjЙn’%ГОiѓ{јlјЙВXO­iІБЈ|A“јGq$:y2gМ8HŠыEa2­ШмШmьaYмЋоЖ/Kљ4KйЪZdfпKкш~vˆ~,d’лy?’Яxѓ#Ќ \WЈ­ЄѕдЖ KЗ]ДЩаrШr”щ„›}ŽSх”ТwЅŒ ЈPНѕE3щeМb<Њ4ЁFЁi=њpф?Ці=OЯ>Љ)њШяG…М|РТS=$fЧчб<іиzц+Э?(УЙ=kjї Цє\лВУ8&pF2]Ѕљю§ЄСњ]цf/ЋЖˆYЏ'йoџІ5Q4:ХR•шєЛЪг=Sэ{щкa8•mn№DнТFaЗ%ќGЖм)ђŸњ* т…§z*GB”чžУХ)_)НЕF1ВUдѓ•]VˆЃ/=ХfєГУяГ1c аеo] Йе\i_Ђ>\u2Њхк&ПˆЬ|I жqˆo=&ЪІН№ђљ•тфT„кcCкЂ\,џ‰,Eб‘MЫл^{гЪО&$ гюuOfд5ЪЦ6( ЯѓЌж†~жАRB˜@ЛWкQ\zчЯ ЋЏџX›јОК—ЈŽгФjь7С–\ЉіfМшОA–yў‡њ@!vlуwLаŽч# qЕњ<Ђ4п~~xŽ–к§Ь…О~šTЭФzЙЏ6ь@Є“hБ0ЅЄˆŸGяOcЛˆX%ѕ4TьL„lгТ“`\^H4i  ]GPЖиіМюhєt˜Ю - 9|№:кт†m§lmЎ< š“ їjјщ…ŒšфcЯiЈvDфbГюl˜‡UЂ”ЃиCлFХ“ђћ“ЫьСшђxžCsЈЩцЪаъYЉ›”У–^…9/na|№Ь9-нD0ЂGkЫN)O‹cќUк7/“i:^ш”@IМkЗ„‚г‘f6ГmПCwI‚M —иЋё(-PХЧXЖ™4№gПP5АkkeЉOzrТbpqХат2ЗБKPЁЮ’{'†БсWЗˆчШo}0<гaТ&ЦёюЏ§#f‰qЮQ,ћёи+лЅ4НЙ;Ъnfb­p‰ŒO\ђќѕ"§ёH..$ЙЖSt u-їЗ•?GQcoЎ ‡ЪЬlfЩ.K)P[!ЋШyfЉ›nЁ90Š/ЬЧ%МB'+$1ЩПFHG§ФдXЎ­>^’ь€€ЄпШТ~Š#…{JWш DЃRFDжџrНљёќрАiM3яUЅйЪђдЈNД‰у“ђ‰Р~~ЉіўЦдxzYv…4dЪЮQ“пнmъPЯ2žх#ѓкЁи„XЦюх>ƒчДХѕWЄCKтѕHLХ‹bЊі9jїёЎ„‰х#Э‘і’чOv§HinxїњяЧћЂјЂЃnЭ9'РЋѕ]ІФи=‹ŒЌ*згЏAюЏ9ŸЂ%Љo2U D}ХgЗQЯлreYмлˆn гхьјтn-A7ˆђ‡ZбДЋ!mD№)(9xA†J-‘Я„ŽšљzФ–nљXš'ЧэЉА•# qЕЁю яОП#Ћ=ƒоЮœќ їСœ ›ЧЕ%–QЬH’SWЂXѕ!№t7ІЦ:1Ц]RSbк5їљtпZГ]m+œНуceчЕЌqjљзnZ‰хќ‚wЂЃЕщ1IX}ыЮ ' nnЕxЧ›˜Uƒ cjCX Ђ}Н-…€`]Sx=š*н%gaћ›ŽhLЈ.Ў’zsД_ШКlE§ІgcлЦhF4`9ЗБzЄIWщАУћ’|j2|шЦA(\ nBЈНF{cGШ%€^э™ђ :Ё[Ž[i`ˆЅ‘s§'/щ§.КzІvЪ^ЈКnxЩЭВВŒ[ †Ё—J,žl§Т/Q“ЪO<о;yміШ{М8 šG№!ћ"П†Š‘P IАоэЈZњ6ePр7шЉї*ЄEv пƒ8Щ* T1@ jчO3ؘ\М№нpнSГ@ЊАГ"Š•Ўo{š2Жˆќž‰9йvBHфЊяввQNЃ‹цжˆИ/ЕЖ+>z>.диУ}ЎybєаЋ%QŒxˆЧ#q'йƒLsЦS:џ ћуЮкUjЯьЧc jDаШqž-оЪЎдŠи” \eNЄ‘м3\|ъи@є,ЇФt(d‡DуьсНы0З^^пЇјШiƒ ~е™єџ>}щЩaяЈс4И ˜рє>Ае{‘й3œџjЛˆR(ŒљeЋВ@zmYіЃћ ШИЋІд1 Гт-сПФЭЮH%а№2Ўн’GbР№А/zъ˜I|aљdрvVёФŠ<Эœ … MХЌгСёМЧ I№e"м•SЫэ+aЩ– 'цaКГсх pІq0Cм“›ІNLН ЁЗХdЪPЮйћ —eŸЅЮCtЪU…Tbq[VФœп}3Ƙтf]ќgИІŠ›бrЅѕ:жŽЁvЈm§цДОљz=ЏK_?їѓђXЩžFЦ,’№yŽЮђ†ŸЧe,yУŸзи'ЋрџŠLљP офeTеј Ѓ%УОєpH7ќS›ГП^8ЮУ˜"ФГY4Šє’й]}bПh4/о•>A:4u˜~pAотВѕЇШ‰ $ЊPЯ=ьѓт'WЗфyqуŒ–ˆmk‹H—f‚Є")ЪїЮжM еX^Љ=bыљU’GхЌfеЯљ…х=B ЙD*Fv\Gз[?žЅП0x\5ЏЁeˆnšм—ДЋZи|ЁЛ>ЬЌЩ]йсš$caтO5 IрW†ЌыЉТЇNтЉ„ §т&Иќ=]шЮ•Xэ>’=6_Т(М’WWќМjŒзP‹+юЯ#р\80IЖ~u™‹ПТSM!uђŠRпкЕdIыV”(1jЮПль.эШхWЌл­ /џŽѓиs {і‰5qv3іЩКИтqћЙl|’al3шЬеоXћдž@”‚вЊjйм2]йoж,МZJ(Э‡цщЂрї5!gљї?V:P­nО!’ъё29„ёВѓ/p‹ѕ“џўкЄ–НŸКцt7x Иœт+WыЦPŠ‘x4‰Лв‰ERepЅžФ= 'LYU8ƒdЖЩ‹Йl=а ŸЫЙх d˜3ы@гЎѕ_–Я6ЫŽJп'=‡xxUvxxvFhЊ6’Pч"хїЉшOa„IFЭЎЁс;Lгй™L Kq ?мїј‹lЦнЈлЇж)Ј,—kK@3РТђЊŸЙH|_ч zдШN’;њUјхцž)ТцNj /нDЌ`РpЗ‘0fLЯ„Щ3В@„"JЂ ВЭУz>{o%ќєœBй“э}nЎћВb7b,q[ŠSBX809%ЂЩMаШ,И1’СгQe’іH‘ТфcД00=еxo/ЮйŽ%„@ђ%№&V1M‡p槓щю‡ŽСOыO•ZЌЙ№ќ§эхˆRЊCmƒœmЫр‰ўjс+БcЯг}”Є^5ефјМНb–‚ќоu&­m| ЉB„ХлM6Ъ?ЕЃ“SЂя§—} 2Ќ-Я'‰™IЈ}ѕˆ%Љф^нЩCœХёяюjсФП(tO:Н>нxN_\Ьё~ЏХBсЎ‹Љ?п|Š!-’GРњ Ѓў9`^1c&МћHETЯ>ВX$БЌXrэ'Y‚ 2$з™ІКlZы>ЧUН ПAеЌНэ&% 2№$Œ” eшЧеf=ЪЇF ЮЛд'Ёљ{сЙЖp_и>њWzі!^-,уwПh=V_aОRЊ‹Ž~ФG0‘pƒ3ЃmхЕŽєЫQ Ѕ ЅvcbfЃc‘Nxј9лгvкЧKK•§й— h јНЁŸ|žЃсBCБ(ЎЃЫŸœnЛьv<7BЩšкmh'E=”ятŸ'K‰~фhр%Eуl9Ж…8ШдєКЄ`_ тЊh|цk‚ЭЊQtЦЈ”œXђ—З+F–Кn-‹йёhs‚SMМoЉPDзWЦНж<†, єv >qvщ+~‚<ПФЦ‹šщz*Ьь‰uVtїМjы№`ЉPF{’Э\“Ю[š и–yГs3іY&n-ьJDCХї’ЮФ ;;еŸw?гНДкЋіТ­‚ДєxjвѓЏЇG‘v–vяЉиЂфЦќъ˜’А ]љџўќЗ[IKŽТЃгјРНУКи;ўГоCv%F™є)ПŸ д~›cЧьтEЯље*СзЕ+aiкў]ˆљ№кјVѓYVIyу­ќК Bf 0†HЅk ИUUCЄЪ3[iЫ`<О+@CУкdИЕЭpлY:Ѕ„Њ/тв‡NЖТЦўFокr­.Ю›Ÿ6Brћ нЄ}ѕл|кЏшЈ˜UГќЋ(kŽc+) ІХ` ці_MяЌf‰дЂіh u:фцyeНДx„жњžŸ„a|СЭ%Ч}tiŸF/ч"љдн/pЕ|є%х"2йlбРЕ–ѓЌ‡ ёў]ЛЭp–Миђ—ьЮїPŽ!Dм&ЛoіоlTЈipHО6R,иЌ.[,“ZЩ‹ѕч~№~с)*š…V"z TиБТr№MЁ ЩђџДТк5рb•nШ‰‰р!Ї‹ЄЏq @зš…чы Е4сˆ,ЮDОщ{‘а$2~ЉсСЭЂЭ'$]Ыћw9|ё~MJvоƒрэВe 8qfš˜BaOжџўЮRмэ’lvB ЪЉ—ьёѓ8*–мЭ ‡‡гсcHhP<ю›Ь?nЊнНh“<зћXа6ZМ­:,ЌИќ Џhм—wдVL~cY”OЎ5h Къ­ќР eе ˆз)˜^vzДВ^6йе C(^#-fNBќЁA>šѓK:XУС&;L’*_TхЖvЁ9EШ.9lеЧyGУнШxзњЮfьС‚п 4p.bЙЉЦ…!Жр"‹POœй2rсbцЛ0ф]˜ЁШZ^Wф)АЉ;1K Аg”9еF„лЫЩWГЉ№7ŸЦZ˜œЅхdЪ‹ 1пr1ЏЅI~Йь"zсДq>огеџїf–ЬЙщжІџЮЎž—fиQд6„аd4WХ&ŽTэD}Їиž"Œ?lХ@жƒЭёеії|эѕZБУ“IiWТвK:П ййиУŠ7:”мЋФDЖВ‹/˜ЏŠ<ќmMДШˆM%0>юмэ'iд|lCќ!•GЩ UIы‰e3эѓ Бl8…ˆК)^>b~„ДŸNд €бfб(эw^о#U‡яч`фjQ a1ˆј%ёtgТх‚—m:ХЁЇ@ oЯŠ  ЏЂфЖ:?к7тЭ šл(aKMЧЃtЮЛЮYtў$Œн1ьIщП.`Š`ЊоыОЗž­eЬIЮyы3iE}‹xS§>УIsД-Ч aw0|`ь28фжПШЩЧn ,g!y‚Ш‰@ Э6oЋHиGC9ФСohŠу‚ endstream endobj 222 0 obj << /Type /FontDescriptor /FontName /ULFRVF+CMTI10 /Flags 4 /FontBBox [-35 -250 1124 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 68 /XHeight 431 /CharSet (/A/B/C/E/G/H/I/M/O/P/R/S/T/a/c/colon/d/e/f/five/four/g/h/hyphen/i/k/l/m/n/o/one/p/parenleft/parenright/period/quotedblleft/quotedblright/quoteright/r/s/slash/t/three/u/v/w/y/z/zero) /FontFile 221 0 R >> endobj 223 0 obj << /Length1 1928 /Length2 12444 /Length3 0 /Length 13638 /Filter /FlateDecode >> stream xкДPh-Œ4ИCwwwwIpЇqhh4И;СнƒЛ .Сн%И;С!№˜ййй§џЊїЊЋКћ\?їЛїR’ЊЈ3ŠšL€R {gFV&>€ИЂ†+ €……‰…… ‘’RУЪйјo9"х' иЩ dЯї q0аиљM&aьќfЈВШЙиXйЌ\|Ќм|,,6о‚Р| cW+3€"@dtBЄ9|[YX:Пхљї_)-€•——›сOw€ЈlejlP4vЖкНe45ЖЈƒL­€ЮŸџ+€ЅГГ3Г››“Бl!DЫpГrЖЈ€`W рЪ%c;р_д˜)–VNџRЈƒЬнŒС@Р›РжЪhяєцтboоВдeЪ@ћ+ќЫ€№WsЌLЌџ ї—їЌьџt665й9лЖВǘ[йЪR LЮюЮ c{Г? m@oўЦЎЦVЖЦ&o–n UП1ќ‹Ÿ“)иЪСй‰ЩЩЪіŽЬ„ykГЄН™8ШЮhяь„јG}V` щ[п?3џѕИ6і 7{Я#s+{3ѓ?h˜Й80ДЗrtЪJќeѓ&Bќ[ftpВАА№АГ€Ž ЛЉ%ѓ 4>;џTВў!~урэщr˜Пбz[™п~=Œ]gА алѓŸŠџFˆЌЌ3+Sg€ аТЪёяшob љП№лћƒ­мК,oуЧ `љуѓŸњofВЗ§ќЗљŸOЬ,џжКOтєQўRL ф№dф0ВБГ8йЙ\М\яџŽђўџцўЇTХиъЏкўOжор§…З†ы_sAѓзваў;ƒшmššП‡_…“Хєэ‹ѕџyўtљџ›ќ?Ђќ_‡џ+’rБЕ§SOѓ/ƒџоиЮЪіѓ_oгьтќЖŠ З§Аџ_SMрПжYhfхbїПZYgуЗ ЕЗА§O#­œЄЌмf*VЮІ–NЬПŸс-К­•=PфdѕЧН0ВВАќюmхLmоnŠглc§ЉОmдg”Д7™§Бzlœ\c0иј3"Ыл|БqriїњўВ•бљ]еНj.yЄчВiЦшQzўХГ”y&YsxdpЮŒФяш0.мпЯомЮ`фLМ~‹ЃGє>‰f/єдй`ћђ0чБVЁСцд…OЏƒG }ƒ1:Eх)v,‡ЛрYRЕ.ИЭBЫБ>кџСkЄ“є”OWA—ХМФ+=JснVЯьЏе‹ŒЙЋnф@WчpŒК€Goюц&%§UЙЙЈЯ`o0с. LoІшЏєйsos цFћјFўјДnBзcXз| q {ЕIlMтwЈЃ7–"бѕO—WuF)E­gЏѕФ‰УŒћžЛzћ@Йф™ *"|ARк{4Ь‚єoм”Cq7ŘzеМm&zнДКCјЫRW˜/ї^8NѓFuRyфŸ<ммˆ?л&NЩrš`4}А6;еСЎ€BM‹`HрЮ)˜*“ЏхЛ'‘[1Ћ™j“:S нПы6,Ы{2C'З Џ{<l::Ž€™еЩ 5іmnJб$ŠPКСŠсдf^оаЉ(8(Ш эO€Ф!”+дЇЪ–Eъс8˜ЛЛE‰кK~gщ`cоІЄ[™I‰#і<4|U-е#lЁ–&_ZЏ>+ >Ѓамѕњ>ІЂP№ІlKw”Ј7aIП†м'uTgІ[gёѓАћ`uT]hэM* нИ™Cˆ *ŒЦнж9~2^ЂЖ`яяŽИѕЮо)у›yk&УпубЙЫ#2зьїЂ Žюмb†f›fшмэšчpіДЋRАF…NVQ˜Р˘Бцž,]^\"хћ9‡YќњGЬе–^“LїХjЂ0?‡jфgЁэ2mo VЉ4W§p#з~x’4}Нјm'еGАv^NœевIИ<—6Ф+%я#‹RШ-‚ЃС-КЊјЄЌ‚СФџe-6Jf˜о*DЋ6›пЛ.ў>kЯК_[ыFrСЅќУї|Юm+БbВп‹6ѓ"д8ЯЅЙмЊэб,І2iГs.К'(nкэНЩщйЛYlпu'Ї‡†“—ѓЃ2…-Џг"šM27_ш–ˆЁ(ќЭ "(*СШСс|ўhdЙ—ЅД_JН>N”G™уТ=”cJ48пЃЭšЅєч VddrŽ§њюKOј­рЬšЛ›ђиJф5g sr*lDƒbв1ŒруъЄдaэ]l kЂГфDРtгкW”ЉЏ~ИЌјНљuRjТЩŒYIYW=EŽ8A№™ЄOQPtЌnwћl]yЬEЙ9Эь"х[z5м+ЦGSЌD‡ДсMLiПќ#%нДЉ[ЫюŽ8УЄL}э­;иЖкчрцMБbнX‘ЃŸяGи§LrdѕC3#К?7зё}нA1ŸЯ+]=ŠLи=К,z*1З8ЁьtШ{АКќ LBCэY3W7‚ъVўЂОЇЬ ц‘xН™"мЊg›якѓ&Й“Њє›+ЭDЗЦbРvЇœщхР!/НR'ХV† B*{NIЅ†їofhњ?нO№sЎeЈи‰Ювч~ZіXЮЯ0ХљŠgФn Š˜ЃтŠHEPSГн}TЇЇІ–Q&^(cPЭљ›—ќZєt“^ј‡и1Хўък#‘ј:ОbMъ=шPˆБ~щ2d|FpќЈF^HвŽЖ•Ьћ 1›,ш’}*4пёrIВ —ЫЖ%эЧRЃs!є)#ˆšЄЪj8ЛДGb$yъїђ[3(дB9ш™’*J |ŠžъьвljЈ"\z9ТŒs8Zбд~+7ОR8LŽ–ЉНАwк„9WOЖЦe%nЃKJUЦŠ*+ЏЗвykсv Бф,ІMмHЗRGП;ѕљkL'BTJtA› ёi:’ъћZ фЙЕ%Н”ТРGQяіmXРѕ khФШ–лЫ„mwО}Eo‹Пњrз›k„Бv;ПэŸъwЛА .!q[GЅ„)зfmйЛ-Я§и9UQТ|ЂќЋHiDuBфDƒ'пЯЧ$~b5&ЯћЕг]ІŸгuKђy–Ун“$l7&wЉѕ9"Нс:ЛиlЫ–“кdФdЭ‘!Yц–  œPsРгП‰ ЄdЇг'} яш2FвєЃv^1ЊуКлтщpжŒŠ tъCззžŒБйкё~Иˆхp?вˆШzVч zя'qB“|ю)J0щЄИMl$ @GЮnёЦGѓТИЪФ€Р(1˜^.ІyZfэtЭQ„дz^ЕŽ%§ѓ+а†S№h€*C;яФŠdЩэWШˆn ^VˆЋxuЄ аc[ ІіgєЁ‘Tр–М2iWљ‹Ч@оо|I&Zž|бLg#њ”qабвQтЛЊJП@,Ѓ=RЏпJcКЊ1Г§HБ0№ДLЮВD–Žq /a$t,аЙŽg~­Е~еBћAJи?>"єГ|Œйр~пчЧЋьќM—н+њ‚Ь§ЋХa`ёхi‘~=I3•ШQBЁП§ћЯеSЃ:Ќ„A3ЗDBЏ… iЙWцІЬъŠ №%ˆДEХёžш‚/1:hЃa_ о pЏ{V+8ќDяНћDK‰‰Бy`3МЪt’І*xЗїцjвyжxЖqЛ?ъМђJ–хЬЯJWmКФq№. m№;֘ 6}QнЗ’cдƒН2Эy?,Twi]2Й ŠЙ›K›H>3Йiђ?ЇКp Хllф=сyЭпYX<3@кz•S}'є›ЦCU4ІЫŸЅИ 'юt%_§&tТ§ёФєаwЌї|9uVЈ}ГвћЩДqжЈє§"ЭŸх/№%KЏŸV‘KS•\ршy_—пspЃG~–~O3еѓВОŽRтвгAVщ1М… Rю1LєЊ0еy!ђ+и iвё§АжёА!bœtOо%4Žн"ЧN‚|‚зю >?ЫœЧ ?д(ВkА…С\Šц§ј[ъHЎZ˜ CзAПivиaм2jБ;wМ+Оф2ф#пФ\‚GоўЯ…сzПGЈмg>љHўЊ›Ч<ЭWЪQ­Ф ŠХP>\“!^‡э)ГtБq’y95H.]F КSвЬшЉЯкFдŠПi ‘*пUŸ+b–Ћˆ’˜Чљi™E‘СяR^ДŠЉте:њ$#щ—А)ј…єApС _ [вђPb3‹Ѓ™о&'тЖВ„5^8Ѓ5) єGBkБ@zДГЎSpQ`7y?љk ЌГZяZmqsэџІшрЈBж4діKv\Чѓ4\T@-|kW‚—оФ’ #%4лъУ#c,L е_Xв"™=сD’џ–…уoѓSбЧХhjМlСQƒь|Iz>Hj•…fH$ЮШJ№Пн6Ы™|^рёZ]‘žШўЙvЎЧп*ƒŒh?А gЪЖ^эўAk+—•T˜o{Н%y Ч™œЄwG˜Вeъ.Щ"(BНЈы‘žƒі Џ[вІП ъ;QтrНёp)ˆ1 DˆьGАro0X3Џ`PЛі‰PPeOŽр0b№c–[ …апљЃАЊЉ›С^CрэjSœбєTоLѕс-№СFрœu&Ёы#нЋaшOJЩViиИ_dX[˜dЫ$˜НcЂсCьо:/Я$bŠš„JЁ,ppь,ЛТё­28єpgXі4ˆ3еglqЊšB[nђV8Ы$hЌŠџžX$)ѓO:nљыѓз2њПџ~џј.лљuк[хљ$бЙћkБœ{}ЯТрŒбЪ&ЎžчА‘ЫкЋ.vс‡ЦтkЪУіюА˜ч`юН9А}@ˆ’м‡ЦЃ—Ш‰ЋДпЙR•6uHѕАWЪж)эUыЫ{є №š@‚ЙIЇRХЙO)‘ДeїЉЩПК7рЫф.Е?]Žd№4œtБvџ†3#—S`ХЦTlЦ$ыЯ0)UэF%:яh17mšœЩ7ДW# XињDŸЇФqjWЫOњЋя^ъ›!Š„јТsЮЩ8m<нЌb1_mЕFŽк|"ZsйГиёMќ9†цMЭa›4™И+ђPнiЈ,ЛоТŸ1Сьkуё™б <†чŽbN˜з>њсƒ[n}jўђ>haІыЎA=Ћt›:‡€аУПхиЄБpЦдFХфЯ€?Ф""K^mOя}б˜сЖьL%iŠF`sЄZХ C!I@Щ sюDСЩ–?•d*Ow}кgEЗw™')‹Ы} ™VEЁкFы-tРE}mњhЧkХИКІ,ŸVТ.еVŸŸ§?ю‰OŠ„Єhч‡цHшЗŽЌлЙd…Œs=y+тK2i˜4ъ ЯЕјЄЃВG|њкp†Ÿ з@ШЁvHCŒSP7йxtБ‰ŠŠR ‘KљЂйMе‰нтЅЉCѓt4)Ѓ€0$В:ЮmІм›П7фЈbw…_НZ‰›Эч„K яJBGІ(0 G’њљpaЫšWIV6u€3кrnэ=Ѓ^BФУŽ‰Щ,v7CЕ…В=5іаѓ`Ye).фl5?ёK0+ t;$sи—џ—БЮРvŸЈdІт–ћ,oмФOcZ$™L•0бЭaм:;aЮR‹ѕЎžŸњІdЖС ШёНРЭљ/пЧnNщ.Є šaЌёИсCГzлr 2O+ЎCW№'хœЏ!я cЭс’їsЪ,з-˜гмлђj”ІNf>В _YˆŸaЉњ—c‘; zkЫТЫы<є‡1tЬм‰ІžЋЉŒ~€WББИгд€мM(ˆEй86 sW‹WHЗЙе№Єгcб@#Ё[оЭUЪEЎ†eILqР=}QИhHдjЈEYўљ ‘hЌЗ+dьўЮБ0'‚џ`жQ–вИяZЭ‰UuдšЩ Фю“0WЃo2TБ‚zu*_бŠу!~IŸДГ‹єK_с—ЌЌV8ъгЯ”ёЊTOшЉЉ mп vТw_м7яюзtЕ М/ГнGНЉ#|Hл о•\ЉsЁтXїUНМЎw1ПоњŠxI-‹ ѓЕmKxгбКь2qјЫqњL}іЗею*‡p~ђ[?gёqЛ7ДЕƒ%FШю›)А„Э›ИIR–гзНб[тЕFv@aћьЯ™д[єС@/юŸї{^ЉŽјyИс@– тшyjЂеі;KD^%gt|тј`о€6+г=ЇБ9?7DSЏoнXАтƒКS$V Р‹@ЄiВ;ˆЇКŽ~v/б8ЉMmŽ[MјEu"™сTЙЭтьCZŸW,ЪЬbнNteсоЫ~~ь5Заѕ–’•œљТdйšЛ^~ќsUВ\gбP‰ZPдzfђзNоlQјžЊЂДnrGЮ№Z_А­и]Ђд0иЁ429уLМH|ŽуйžКИёMDНƒ§sв Дf•ЙіŸ˜бЈЁŒј>LЬ^ЖC5t6Ф•ДBb_ђXDЩBRмH3$НŽ*}і–>*ЪФІ5_…§љ+9§•{S‰”GlИ§‹-фг*2ш†dЇqЮ%ЬQО)H]xŒEG Œјћ•ЂA6Hjsў<E@+ЬЬ(bрѓcЃЩЕcCРNКХ5њГ ЏPq ыaбЉ^%pМBіВКњ˜ЌFSдмЌыЦ№ 1я‚Z›Ћ-…WЅен ‹ЃУE;ЂЊ;ФД-ѓЈVŸцъqЙŸбx [Кфˆ1*љ1 ,5ЙKm.џD]mь~M‚мCЗ9†ƒ№#ВЭ'RqW\ќњkxUт Ы48а)c\]МjJАgњѓ0ђ“юьгЌ)c+E ЇBтOEttYFЁœЙDй3жP3ђL 9о3Њ4йш`ђZРDПХ—ѕoІtmbшє%•иЋRšіf!Šоjк.i&*аM•ЎщћІТ†Š6œ: >ажQIN}рДynДюњЉtаьѓbуёXCZnEъЖ…Э>”$f“0tjЮЂ‘q˜Г‘\ёћ§ё­C66+ш’Gчfн>‘m/~ёЂu}c0зіœж Jf3дwёШeœлpе“pmЃ’}#9CБъ ЫтYЧЫCLdRў!ІЋ‰„t} Šw?Юї3L:‹хёSŒ=M@ђВ{іSƒ@Э„nsФWьёнsб^qjŽФТшхдЅяї ечAВѓŸєњрWє­ц5,#Ѓu зu OЌCˆЊђ_9 ЊKЈ•xмо+†QТгKђЙF!F “A7Я”—њn&Йу№Oh#1ЊЗCОЋF_Ÿ—’™8mX9 1єшиї–dАяѕD'Gi k-AOEип‚'jMЏ9/ЋАе9да[r|ІжeьEцlˆJё|ьттБќЪhУЎdО8ƒѕЂТМ‚ГЁЦё3xƒžXŠ#mпnЉМіь]ВŠ|ё 9Vr>щŽnа3}5 69*ЁpО-e=bњц=4џcІлtъЙкsЇ\@ УѕфnЕygдcў:Tрi т2yp2 ‚w їЏбŸ,г$Рљ[кp*ХчУЩВљМO'}ЭdМžљщYЁќЕmшlєп*bёMštФ:тCЪйGъў~Ч,ѕ‡~sЦ1И­уѓ]­pЛъAЕœуIwŒомсяfp–Л3шp›eХЋbЋ\/=›EЭш’@8ЃЗzLЙэ№OYB˜ђ&Wj!Ћѓœ`xfХЁЮeiWШqи`;Е\PS€щ3œг‡юqгбЎлQE*hŽЊЮЂl+p'аVж[мњ5љ‡,ќŠ‹ћFЦжѕ§е†&™ё›n ё} Ўт№m7Qѕ5]F*4ri#uL'{‹;VЁ€.pЖSsž‹lЛfцд:Ф—cЂшйЫ+™ап„5E5Ъ3Е&Жэ,АЌI~\ЏщД‚РянƒцПчЃ?Ё$њ{ЪДљд<ё‚ђe:­яЧ}[ЯŠпIиqяH=УbЇъќvTƒfoEdфHllЙI*.Ёs4*лy/T§hŒ… •P †ћ‰&'/ЅE “­<‡MyЗgѕj8XcDжhеЮмvъN@05Я†v“ЭTŽ„ƒџctjvЄпzаœjiрž"‰З ВDƒEЇїЅ”˜N‡/Яf Ъ—ќБ‘N›P%!Єf)_ѓpЩ}ŽЊРЬфНlQ‚i^ЦАј ›ƒ'4р„њ:ЇЃ’HJpœmэЦO…ћТ/†ХЬDX НжЊ|юљ?ѓгмy\ Q?Šх‡ќъWдћИХІљШ Э\Є‹.W%uЇъ5Б˜ф[Q1$Іui­eŽvЫžшћXъРЄЛsю‹жLHЌQY$І‘„ГзЗ'ќБAыSЭГ+е,“'АТcU ":I`’|ЯnЉќQ‰CОŒsdCЭДЧzFВфY5Ь‡’)ЊР”&vиœЃГшІIdМDп7vк}›X{…OZюВg–ЇVЁ<6P Щ3ЪѕЃЬрSŽDЖ>DшјЬrзСіЕ№i{к‚yп•Нле‡ќоёљ NK-mггVк +ѓОЏТТВЮаР:Z^ jр@ИW+КMu]Эq(<''Лх"Ў*ЫN„ "­')o2и–~Ў,Э…й­‚Y$D]<–д№дДTщY&tщc“з' XЛnW›аї­§~{јфj~Ў€u ыЏеCЈСМ–9u?wЉ/рjпнЬXqўr#{§ъ=VИv.ѓвfЙnћёE(=Tж~У™83—ЧЖњфвоLQlQŸdЌЩWЂщ@_ Т’1НъTВ|fЁ/Sc6_уЭЇЛD{лsэњ3E‚~($|2@Ђ ЛŽЪIЃ1"КУ\Wэ*_*KЙŠpdУy Нє Зы“‹ФMѓЫ9qŸC‹WКЈ@љH­ыбАД МM№ЮЫъG)ји!AVЙjU}ћ8єј\ЗВХЄл€ККШHЬbщsќLu@ЅэъА+Q\i4д‹~+ŸЖОp7чйА ђW!л\“ЉкbmЧ›Ji 1+p#Sб †E\ Б 2hьn)ЅіФћИЉ4‹Y…!Бn}Ыю/ЪvŸы9Œ cЂ§…фњьуЅО­ R\пo•џ"!пXЭГСb!$‰gjЭTЎAѕLсkw@1.№С›(бR ЦHŽlЖи#+џуs=c‘пnУ‚ивуХУЪkвŸsМКŸ'дџlКwч9№ВаЦ чp€Ц{зЕ.нz ‘<‚OžЅd„‚ЏЩЗ—нщc˜ЂСjІq?-tœ‡ŸVо_2§Ю"Xф†цШAŒМxl1MШЎЯDyЊ„яю™•NMГ6љЧ g Ще@‚Xp#КЦ—™mˆгуКЏЅp%qxЎё‰КНЇB‰Fƒ?ZЬуY>ЕпЇAНюŒАsЖœ_rVЛБ!gуЫ‡ix#:ќp$[˜bъЛјШw<А‡XuoЦ0уnѕ§нeT[_яjЭ НУ^лЧё„лWIчГЏЕОўT+ DЕЉј=Іс5Ÿw{ъЯ9­фЎy{эsG+xЏCВt-ŸЯФoмя„Й FR1ЁWmѓqНЃ–ZЕd<Вn&,ЅЖќЂ]ЪLwЉRAIнzЮKцз‡Јьы›ђ­ъjЊБ2 фЧхNы_СrЖŸ"Ђюvdј’№b­Ж2!‘.—њП0_IЖUZbћ2ZTыя-зкL~Тњщ=пЛJјЧЏПуОᇹут˜аtФюGŠ—^Y|,вѓAХKbтn˜KuЃЙќ1]їrџj.S=эЙf”€zщB–…–†C4иї…2|Mў ОЗMэМ{Ў†іeW*ожвЗQ„;ž Ž•u!#Ђ.&ВmH({Ўц0-ŽšлРВgмА ЊЋ!#н“€”)+дz‡‘ж-о бŽь,ЙQыRЊпн€йžїњŸЌвPЏ"Wо Ж›­ 7Я§ЄСiˆˆс0з™УУ рЌШЌVУќХ A_њBфCв5ч*їlѕ/иЖ*’юз0ЎИј|овСZЪЉЁѓ+С+aрi&Д.#lњ‰@ЙŠЄNrЋ*Эr‰UшqЯЃдn' !Wlшнi­g9IдšЎ"жГ^Я їЛX4‚ЫШVйЉfEхŒvО‘пNРТG№у5i№,&GDІ–{т$шUј~”U“/ЊpП r{ўr6ŽЖђЛ JXС„ѕї’GЖсї]?y“ krˆтЅЂ8gA‹ТEйѕDѓ-gЩяޘuw iк УMМЩ5ž§І]p!ЩKУgБЃg2гWo1їQj žd–ГNPxї~a€FxljWxrwЈъ)ўYуdYЇj'ЭщxPѕ‡‡ŒџЙ:ЯьО„vИUQDёwp^›%Ж&ЕЬУЙТ^ dђ*ЁЂР:-Юˆh-‘ћ2&д-"1бZLСД: 'ž r5‹ѕц3ЏЋ йBьoЃпЃUІЇќЊ§з}}ЁqŽЁ.€Яu\О[В*–јиdn ‚~=1Œ<вбР[(Июt=ZПтЈ[Б”—N]I_xУ7†pуpbдБёN;с)oZЗёGЖ~uУ)šњyЬƒЩчђ№‚pе5Тж_У›ѕaTЫFcЦЎж’yЁаья _Œ~бБ%“ Ё&с‘qпљ–FЌLфP “X…?Ьк{эЦj§€ЄK‡єtzєУZvWuШ…ч&’]Uс~щСRѕ‹lЕ]Fюй2ЉTјѕеcŸ-Зё9К4ZВGqюьЈяŠн+~‘†РЏП‡Цt$„дт:Лмќ3х“эaњГбaR`РЛ’'И~1uщЂо“Х#Ихд§hxђ6реЛh/7ущtеЗHb‘ЗU{Ш4Мg7А0_qи=—“dp9&Bкњz бvућ-Ю$Yп‘)Ы—>А}э”LЏкрbjNЈлѕDJІoЈ4^Ѕ^оУсBUщэb!OОј§Б–‹},:ж|јьfэшTБnMŒœ ѕўqžЬajЮоiƒAЖьl96>@№№xЧ?а–dКsˆїС;:єAгЯУ5№_ЄaГA„VьЂ&ulмpLD]ѕ +Ќ—QЙУЕЋQs~РeŸЊию0h€eŠ>хd9ЂЕ'lŸ+В-іХXh8Љѕ–б–ч|вt$џЌЧ2“нD3b>7mB—F9u>RžЭ†!~љ< #TхЙќхŒŽY1#Б ѓ.вдЈf“@ˆТн%KЪƒZЈЯhGQoQххŠ[c‹шћ–1ЏЊ CжЄјAфа?fЭЂБю%Ш^МК­kбžxб#юђTнЛо^Kid=СђыёмŸ3jпшРІт^Fuљ$ŠvњСаxЩs_дѕ Ј|:yБt[їе„м‚XГ$юЕžяЖ*Ў&3e;ЮмеrMЎЏїЙŽГSЩбgэяdXЋ_Ј*ї№кF_ЂюTSмВшс…ёg]Зэј‚Ч2кэ<Ф>ЅѕœцS ’ #Ю”z9љНќЩc_›Н":%хuaщzLР2‡":ИЖІ[S№ї@ўHуŒїЇЇдwв'iтФzx“ЯПœ…жbуетЬ.шĘф@‚„Gе ЗННв•WАЄi‰IЌпrW&š[фРЪ?0ЛњРv~Ќz5 YЉ5Y%•n§5Ы3В.ŒКЎŽь<— о_eŠ%eAbИIгАёдkЧ8%&фєbJ1.vЭМzздYлОˆС"Є­Т;;%Гyn=Лѕ5хu-M4 •СzmnЮТ{rоЁщя ‰Y (ЊхєR|йsУK ЇЙœcL3S,МGG­Wк[WиЯцЎnЂъŸbЕPкV‚ЊЎЮ\!‰A…МЩ§лтЇ л“%j№ЈЩ žmšСЊкіаCО0EП$<Сž‰Ёx\ ХA tAƒ§Z=):Ц uWчзxЙŽFЙLIьщgьЌј’žŠ|›ї'ћіієeqbbN0ч8“’I~ы^ДЇЎзЮtlщвBљ Шц [џ‚wE,ЂtЕЇ{бїГzя.оƒћЗвОсŽU>НŒ iЫ“^WЩЕєl€юŒHWч ‚ѕіŠќъШЄГK‘E„'riˆСZЈб›fгй›0оŒ†ы№В”eиюЊЅ…Ѓ‘”йж} Е[ ёЫќ}ћl}мйN~MakЕxžAё‡.ЂJ†Еэ\р""џŸ™кTr…‹<ч‘EL$tХJгФ!иѕe>иЕAЂx—вgЋV65љ ‹nJ1 ёh8;eїSТPг˜ОŽЩенАcEЋ&ŽуVћQ/_еG?„nemŽƒИ–ВхЙтсPёaГQy<š/эгНPфПd•ѕл_ Vpь Ш™В№ЏeТџЌUе•и”ЄїЕ1ZCˆmаv№LM&`ЩАЇ<[Ёэ;Џy?“Оy/’Б“|žбШЙЅпZЪІМ(Щ0h4`лиьььЇёЊђмOэЯ ГSЛЧˆюќЎŽкzo5}dp5žІ’пУЏЂщk“Ž‡Ч‡СGrOBbїM*;vЏн0<;c E@MнВгY1џ§JW‰IAђ„дEЧћ3йqvЏpA›ž™јІ{G]Ћ&‡кФWсžJќгЮЎ )•Чб„їш™јG~…PО‘O/тЏЧяуEМI… ­qЋvЈ]ЙvBНДгБFsJ_ьЫ…;Г…YлgЋЛ›І7‰с–УЋbХяоКЏ/Е^ПV™šэtVяYD—Ш’ёRОт…Я>-{Ћјg›Ђ ˜z jAЄ&С гH. e=lђK+ы”Єޘx#њmЌб’N&3е}0Х<)\YЖЃD§yOМ"FЖ-V3l`1ЉGƒ.Оsd7jDиf№k2aљЩWVџФB13+Њ`$“ЊQНOpgфэиќЂ.ŠГ3иLNынЃН]ыuнŸ”еYl§Ј•b]’ЈеVйo,П}ыофМ\Gф(šЫC @/шŽ‚n?;ї/ЭЗыРП’Љы>2ЛЃдЯ‘y2PДєзїдk'Д‘} j|$П‚NвЄЁђаU0ЋƒЪ8ЃZGТ№ъSУCНїBCДЙ‹IЂќыиўЮкqIAЛkXЩєJiQ(iАpЈПОИАRА˜yJAxП}МH€PRк8G•i oфuсхД=tOі яgšкњ0с)‹СfZŽ“ф7Cй" Я.э}xKђь%`ƒЌЭІniлНGZљВ=ч1|-ŠUЈ~ь/п++“БiVнтЏ[­Ÿ5wb“I|Л?†[ŠGЎГ_i’„"`!Аљ№nNeь @Ѕ ГГ‡ьъїD …U9бoѓР…еёэuАяЖЫ *`ЙОfњГ 4_hэщ#;o]cŠЦ5/зW4ЛѓўДseKє’ЋЏnЇ+ЕiJFЬ§ˆ`a’ј yKЦ~њђTјj†œы[ Ю&Ya?ЃЭ!ЈU‡ ьЫL…ыh№ЁвІ+QŸ4ф ž /чзK’1ђ/4$юн;T2олрщ.Бt‘%.вЩ옍m‰ZQ%_^–Ц•М+„^hR”Q‹Ё†к]ЇТMy •0‘ЉвБвтыŠ<—IЎ­(2ЧркХmа v‘Ё!A9šЮВkJBPЧжЉЩ;Зн<œP_яTWc‰ Зс jЦZ9Л1D~ьLoD;жъѕпо>‹€>Рг{‘Mлбб џЏѕўКЇ'+І> nOO„)Šћь‹=ЌпŠЇMx|_ьXM‰Щ_Sрсї7Ак­Ў'5ЫoБУц4!uэѓЬŒ‰ф~Йh[HЧœІУсЫЮFнЈ9жwЬlУ‚†ёuаHRЛ™.| …&ГЗ [B?Ц‡ŒF˜АeцџЎПuзпШУ@хIЂNшЪaЩ/м‡ЇЄN1jЫ%њ‘ш1 ц]Љї;=љAЪѕв5*цU5тVѓАsjГЌф/ƒmзаˆо&mЧeё=т€ гН–љёЪЛaМ• Ь:)—cTљх]D›kУ нащdЫЏ}Zwыю ЩШХЄ7Yјэ?ЯDКŽ>џl{LMС<™Г сc~еtІЮ~ЗјA0WH†тŠЮЛЗЄјЂœZUЁ‚њўшž9WХјeТŽЈЁЄПеЫБДovѓ|vІдї*Aiט0R’уЧЄРТ’(5f‹_аmAЋVЛ…ќjЂFP€AOВ‰ЋєњjКP‚7‘Єт %х5ЂЛE IЯ™4НFd Ч†” ŸйAЊь`­Ž‡ЂЋY4м'€ђŸ9iЧ ЃГЙ{йЃр.ЏкЩQГgќшьв]сявё ЃнŒ[:nвЇиЋЁFлuЌ…~дlYлЅ?~fћЄЃs€žЖdŠ юJbхWiEoˆN&kжEцB„ђiЦ —}ПIжTхЇPЕУ‹ќdZ§a<'п6\Ї‹,ђ~qDlџх"СЇ/Ђ^rГД’T3ЬџњЯ'њ\w–wdЈжƒKАыњіu5UPдj~2ЁчяоЖРбз_ža‡ё1ЦщЧ}ƒ0Ж#ырХFФРц01ЩoиТRпœЌt‹йцS6т"ЂFz†ю,9„АВйф™8ѕE§6ОоSЋpЎ6ХišhщБA.С№CІљS}“*ЖšАeE, ˆќХv;ХzqіRhОЄё‰E…JЗіУњЅYС4(Š 61іщLхVv9œkШ”*“ОгCЉš+бR)§$нЅS"Ћw8[Ћ„E3Пs§дMЗ$Фмщ§ЫцŒЄL„“щpЏœdг§Э јCњ,э B–†ЩТїду‘фя%~X[ŠИЧDВ2‚ќлб9 šI}Ѕ~ЇЦо‰ )L+ДВчСsАкШАпb…›qdМ]+6Јеšэќ%ЃЏдєA a;2јhH 'Џк+pЧvNyX>EЈI<ЗъАžйІоYЮvoyщ„їZк#’Т‘юЯнМЏ БћПІА^ЃCK†Вќ]г‰ qLг!кJ2fYЗ ђэ"ВGЫjY WЖСЏэЌ|YЕщ-HuыГ]t? ћ(3*Хз"Љ1|a`’ ПZѓlЙjЌ§NЃ№ш5‡МР9Ÿ`LЈ{Ž!§žыSsЊjK?xЦ[гOyFo­GЉC2НыА‡,МI@СŸ‚‘kLбњЙ{М endstream endobj 224 0 obj << /Type /FontDescriptor /FontName /KFAQVC+CMTT10 /Flags 4 /FontBBox [-4 -233 537 696] /Ascent 611 /CapHeight 611 /Descent -222 /ItalicAngle 0 /StemV 69 /XHeight 431 /CharSet (/C/P/R/a/b/c/colon/d/e/f/five/four/g/h/hyphen/i/k/l/m/n/o/one/p/period/r/s/slash/t/three/two/u/underscore/w/y/zero) /FontFile 223 0 R >> endobj 12 0 obj << /Type /Font /Subtype /Type1 /BaseFont /CYLXBC+CMBX10 /FontDescriptor 174 0 R /FirstChar 12 /LastChar 122 /Widths 164 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HKECYY+CMBX12 /FontDescriptor 176 0 R /FirstChar 12 /LastChar 122 /Widths 165 0 R >> endobj 7 0 obj << /Type /Font /Subtype /Type1 /BaseFont /EUWOLL+CMBX9 /FontDescriptor 178 0 R /FirstChar 65 /LastChar 116 /Widths 169 0 R >> endobj 23 0 obj << /Type /Font /Subtype /Type1 /BaseFont /APKYDZ+CMEX10 /FontDescriptor 180 0 R /FirstChar 0 /LastChar 89 /Widths 157 0 R >> endobj 48 0 obj << /Type /Font /Subtype /Type1 /BaseFont /EJKTVU+CMEX7 /FontDescriptor 182 0 R /FirstChar 80 /LastChar 80 /Widths 151 0 R >> endobj 14 0 obj << /Type /Font /Subtype /Type1 /BaseFont /IFKLVH+CMMI10 /FontDescriptor 184 0 R /FirstChar 58 /LastChar 121 /Widths 162 0 R >> endobj 41 0 obj << /Type /Font /Subtype /Type1 /BaseFont /TLVENC+CMMI12 /FontDescriptor 186 0 R /FirstChar 68 /LastChar 120 /Widths 154 0 R >> endobj 49 0 obj << /Type /Font /Subtype /Type1 /BaseFont /YJUITE+CMMI5 /FontDescriptor 188 0 R /FirstChar 107 /LastChar 107 /Widths 150 0 R >> endobj 20 0 obj << /Type /Font /Subtype /Type1 /BaseFont /ZNKCOD+CMMI7 /FontDescriptor 190 0 R /FirstChar 59 /LastChar 117 /Widths 160 0 R >> endobj 47 0 obj << /Type /Font /Subtype /Type1 /BaseFont /ZRLUIR+CMMI8 /FontDescriptor 192 0 R /FirstChar 60 /LastChar 62 /Widths 152 0 R >> endobj 9 0 obj << /Type /Font /Subtype /Type1 /BaseFont /UJQVKJ+CMMI9 /FontDescriptor 194 0 R /FirstChar 78 /LastChar 78 /Widths 167 0 R >> endobj 13 0 obj << /Type /Font /Subtype /Type1 /BaseFont /JBDKRM+CMR10 /FontDescriptor 196 0 R /FirstChar 1 /LastChar 123 /Widths 163 0 R >> endobj 5 0 obj << /Type /Font /Subtype /Type1 /BaseFont /VISEIZ+CMR12 /FontDescriptor 198 0 R /FirstChar 44 /LastChar 119 /Widths 171 0 R >> endobj 4 0 obj << /Type /Font /Subtype /Type1 /BaseFont /RALDJV+CMR17 /FontDescriptor 200 0 R /FirstChar 67 /LastChar 121 /Widths 172 0 R >> endobj 30 0 obj << /Type /Font /Subtype /Type1 /BaseFont /IRHGLB+CMR5 /FontDescriptor 202 0 R /FirstChar 43 /LastChar 50 /Widths 156 0 R >> endobj 65 0 obj << /Type /Font /Subtype /Type1 /BaseFont /WIRDCL+CMR6 /FontDescriptor 204 0 R /FirstChar 49 /LastChar 49 /Widths 149 0 R >> endobj 19 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HOFYAJ+CMR7 /FontDescriptor 206 0 R /FirstChar 33 /LastChar 61 /Widths 161 0 R >> endobj 6 0 obj << /Type /Font /Subtype /Type1 /BaseFont /LZZFWX+CMR8 /FontDescriptor 208 0 R /FirstChar 33 /LastChar 122 /Widths 170 0 R >> endobj 8 0 obj << /Type /Font /Subtype /Type1 /BaseFont /LZRJRG+CMR9 /FontDescriptor 210 0 R /FirstChar 34 /LastChar 122 /Widths 168 0 R >> endobj 22 0 obj << /Type /Font /Subtype /Type1 /BaseFont /KYHFQP+CMSY10 /FontDescriptor 212 0 R /FirstChar 0 /LastChar 106 /Widths 158 0 R >> endobj 89 0 obj << /Type /Font /Subtype /Type1 /BaseFont /EXPITJ+CMSY5 /FontDescriptor 214 0 R /FirstChar 48 /LastChar 48 /Widths 148 0 R >> endobj 21 0 obj << /Type /Font /Subtype /Type1 /BaseFont /ZHWRQG+CMSY7 /FontDescriptor 216 0 R /FirstChar 0 /LastChar 106 /Widths 159 0 R >> endobj 46 0 obj << /Type /Font /Subtype /Type1 /BaseFont /RZTUZJ+CMSY8 /FontDescriptor 218 0 R /FirstChar 0 /LastChar 103 /Widths 153 0 R >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /BaseFont /RZTYJJ+CMSY9 /FontDescriptor 220 0 R /FirstChar 20 /LastChar 20 /Widths 166 0 R >> endobj 40 0 obj << /Type /Font /Subtype /Type1 /BaseFont /ULFRVF+CMTI10 /FontDescriptor 222 0 R /FirstChar 34 /LastChar 122 /Widths 155 0 R >> endobj 102 0 obj << /Type /Font /Subtype /Type1 /BaseFont /KFAQVC+CMTT10 /FontDescriptor 224 0 R /FirstChar 45 /LastChar 121 /Widths 147 0 R >> endobj 15 0 obj << /Type /Pages /Count 6 /Parent 225 0 R /Kids [2 0 R 17 0 R 25 0 R 28 0 R 32 0 R 35 0 R] >> endobj 42 0 obj << /Type /Pages /Count 6 /Parent 225 0 R /Kids [38 0 R 44 0 R 51 0 R 54 0 R 57 0 R 60 0 R] >> endobj 66 0 obj << /Type /Pages /Count 6 /Parent 225 0 R /Kids [63 0 R 68 0 R 71 0 R 74 0 R 77 0 R 80 0 R] >> endobj 85 0 obj << /Type /Pages /Count 6 /Parent 225 0 R /Kids [83 0 R 87 0 R 91 0 R 94 0 R 97 0 R 100 0 R] >> endobj 110 0 obj << /Type /Pages /Count 5 /Parent 225 0 R /Kids [108 0 R 112 0 R 121 0 R 130 0 R 139 0 R] >> endobj 225 0 obj << /Type /Pages /Count 29 /Kids [15 0 R 42 0 R 66 0 R 85 0 R 110 0 R] >> endobj 226 0 obj << /Type /Catalog /Pages 225 0 R >> endobj 227 0 obj << /Producer (MiKTeX pdfTeX-1.40.10) /Creator (TeX) /CreationDate (D:20100903095016-07'00') /ModDate (D:20100903095016-07'00') /Trapped /False /PTEX.Fullbanner (This is MiKTeX-pdfTeX 2.8.3563 (1.40.10)) >> endobj xref 0 228 0000000000 65535 f 0000001810 00000 n 0000001705 00000 n 0000000015 00000 n 0000768671 00000 n 0000768530 00000 n 0000769232 00000 n 0000767114 00000 n 0000769372 00000 n 0000768249 00000 n 0000770077 00000 n 0000766971 00000 n 0000766828 00000 n 0000768389 00000 n 0000767537 00000 n 0000770505 00000 n 0000004443 00000 n 0000004335 00000 n 0000001992 00000 n 0000769092 00000 n 0000767966 00000 n 0000769795 00000 n 0000769512 00000 n 0000767255 00000 n 0000007402 00000 n 0000007294 00000 n 0000004606 00000 n 0000010321 00000 n 0000010213 00000 n 0000007553 00000 n 0000768812 00000 n 0000013269 00000 n 0000013161 00000 n 0000010483 00000 n 0000016020 00000 n 0000015912 00000 n 0000013431 00000 n 0000018941 00000 n 0000018833 00000 n 0000016160 00000 n 0000770218 00000 n 0000767680 00000 n 0000770614 00000 n 0000022484 00000 n 0000022376 00000 n 0000019116 00000 n 0000769936 00000 n 0000768108 00000 n 0000767396 00000 n 0000767823 00000 n 0000025712 00000 n 0000025604 00000 n 0000022693 00000 n 0000028633 00000 n 0000028525 00000 n 0000025920 00000 n 0000032347 00000 n 0000032239 00000 n 0000028772 00000 n 0000035596 00000 n 0000035488 00000 n 0000032533 00000 n 0000038904 00000 n 0000038796 00000 n 0000035747 00000 n 0000768952 00000 n 0000770724 00000 n 0000041632 00000 n 0000041524 00000 n 0000039078 00000 n 0000044770 00000 n 0000044662 00000 n 0000041736 00000 n 0000047596 00000 n 0000047488 00000 n 0000044874 00000 n 0000049800 00000 n 0000049692 00000 n 0000047759 00000 n 0000052467 00000 n 0000052359 00000 n 0000049939 00000 n 0000055287 00000 n 0000055179 00000 n 0000052618 00000 n 0000770834 00000 n 0000058420 00000 n 0000058312 00000 n 0000055438 00000 n 0000769654 00000 n 0000062180 00000 n 0000062072 00000 n 0000058571 00000 n 0000064911 00000 n 0000064803 00000 n 0000062284 00000 n 0000067736 00000 n 0000067628 00000 n 0000065004 00000 n 0000070199 00000 n 0000070089 00000 n 0000067841 00000 n 0000770361 00000 n 0000074984 00000 n 0000186953 00000 n 0000279500 00000 n 0000368074 00000 n 0000072791 00000 n 0000072679 00000 n 0000070316 00000 n 0000770945 00000 n 0000185135 00000 n 0000074872 00000 n 0000072920 00000 n 0000128361 00000 n 0000128727 00000 n 0000128911 00000 n 0000129167 00000 n 0000129281 00000 n 0000183414 00000 n 0000277685 00000 n 0000186841 00000 n 0000185257 00000 n 0000212967 00000 n 0000213333 00000 n 0000213518 00000 n 0000213774 00000 n 0000213992 00000 n 0000275964 00000 n 0000365701 00000 n 0000279388 00000 n 0000277795 00000 n 0000303876 00000 n 0000304242 00000 n 0000304427 00000 n 0000304683 00000 n 0000304897 00000 n 0000363980 00000 n 0000460276 00000 n 0000367962 00000 n 0000365811 00000 n 0000397010 00000 n 0000397376 00000 n 0000397561 00000 n 0000397817 00000 n 0000398041 00000 n 0000458555 00000 n 0000460398 00000 n 0000460725 00000 n 0000460748 00000 n 0000460773 00000 n 0000460798 00000 n 0000460824 00000 n 0000460861 00000 n 0000461510 00000 n 0000461837 00000 n 0000462372 00000 n 0000462440 00000 n 0000462993 00000 n 0000463611 00000 n 0000464280 00000 n 0000464654 00000 n 0000464841 00000 n 0000465230 00000 n 0000465915 00000 n 0000466548 00000 n 0000467189 00000 n 0000467214 00000 n 0000467239 00000 n 0000467767 00000 n 0000468096 00000 n 0000468654 00000 n 0000469072 00000 n 0000469417 00000 n 0000485691 00000 n 0000486023 00000 n 0000501635 00000 n 0000501991 00000 n 0000509988 00000 n 0000510220 00000 n 0000518655 00000 n 0000519015 00000 n 0000526001 00000 n 0000526230 00000 n 0000542388 00000 n 0000542716 00000 n 0000550029 00000 n 0000550253 00000 n 0000557441 00000 n 0000557661 00000 n 0000568044 00000 n 0000568294 00000 n 0000575438 00000 n 0000575670 00000 n 0000582808 00000 n 0000583029 00000 n 0000608204 00000 n 0000608755 00000 n 0000622214 00000 n 0000622518 00000 n 0000633253 00000 n 0000633509 00000 n 0000640802 00000 n 0000641031 00000 n 0000648032 00000 n 0000648252 00000 n 0000657624 00000 n 0000657929 00000 n 0000677327 00000 n 0000677842 00000 n 0000694827 00000 n 0000695220 00000 n 0000703974 00000 n 0000704341 00000 n 0000711340 00000 n 0000711564 00000 n 0000718800 00000 n 0000719050 00000 n 0000726671 00000 n 0000726930 00000 n 0000734196 00000 n 0000734425 00000 n 0000752339 00000 n 0000752739 00000 n 0000766498 00000 n 0000771054 00000 n 0000771144 00000 n 0000771197 00000 n trailer << /Size 228 /Root 226 0 R /Info 227 0 R /ID [ ] >> startxref 771420 %%EOF tcl8.6.14/compat/zlib/INDEX0000644000175000017500000000370414554262142014663 0ustar sergeisergeiCMakeLists.txt cmake build file ChangeLog history of changes FAQ Frequently Asked Questions about zlib INDEX this file Makefile dummy Makefile that tells you to ./configure Makefile.in template for Unix Makefile README guess what configure configure script for Unix make_vms.com makefile for VMS test/example.c zlib usages examples for build testing test/minigzip.c minimal gzip-like functionality for build testing test/infcover.c inf*.c code coverage for build coverage testing treebuild.xml XML description of source file dependencies zconf.h.cmakein zconf.h template for cmake zconf.h.in zconf.h template for configure zlib.3 Man page for zlib zlib.3.pdf Man page in PDF format zlib.map Linux symbol information zlib.pc.in Template for pkg-config descriptor zlib.pc.cmakein zlib.pc template for cmake zlib2ansi perl script to convert source files for C++ compilation amiga/ makefiles for Amiga SAS C as400/ makefiles for AS/400 doc/ documentation for formats and algorithms msdos/ makefiles for MSDOS nintendods/ makefile for Nintendo DS old/ makefiles for various architectures and zlib documentation files that have not yet been updated for zlib 1.2.x qnx/ makefiles for QNX watcom/ makefiles for OpenWatcom win32/ makefiles for Windows zlib public header files (required for library use): zconf.h zlib.h private source files used to build the zlib library: adler32.c compress.c crc32.c crc32.h deflate.c deflate.h gzclose.c gzguts.h gzlib.c gzread.c gzwrite.c infback.c inffast.c inffast.h inffixed.h inflate.c inflate.h inftrees.c inftrees.h trees.c trees.h uncompr.c zutil.c zutil.h source files for sample programs See examples/README.examples unsupported contributions by third parties See contrib/README.contrib tcl8.6.14/compat/zlib/zconf.h0000644000175000017500000004016414560736524015371 0ustar sergeisergei/* zconf.h -- configuration of the zlib compression library * Copyright (C) 1995-2024 Jean-loup Gailly, Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* @(#) $Id$ */ #ifndef ZCONF_H #define ZCONF_H /* * If you *really* need a unique prefix for all types and library functions, * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. * Even better than compiling with -DZ_PREFIX would be to use configure to set * this permanently in zconf.h using "./configure --zprefix". */ #ifdef Z_PREFIX /* may be set to #if 1 by ./configure */ # define Z_PREFIX_SET /* all linked symbols and init macros */ # define _dist_code z__dist_code # define _length_code z__length_code # define _tr_align z__tr_align # define _tr_flush_bits z__tr_flush_bits # define _tr_flush_block z__tr_flush_block # define _tr_init z__tr_init # define _tr_stored_block z__tr_stored_block # define _tr_tally z__tr_tally # define adler32 z_adler32 # define adler32_combine z_adler32_combine # define adler32_combine64 z_adler32_combine64 # define adler32_z z_adler32_z # ifndef Z_SOLO # define compress z_compress # define compress2 z_compress2 # define compressBound z_compressBound # endif # define crc32 z_crc32 # define crc32_combine z_crc32_combine # define crc32_combine64 z_crc32_combine64 # define crc32_combine_gen z_crc32_combine_gen # define crc32_combine_gen64 z_crc32_combine_gen64 # define crc32_combine_op z_crc32_combine_op # define crc32_z z_crc32_z # define deflate z_deflate # define deflateBound z_deflateBound # define deflateCopy z_deflateCopy # define deflateEnd z_deflateEnd # define deflateGetDictionary z_deflateGetDictionary # define deflateInit z_deflateInit # define deflateInit2 z_deflateInit2 # define deflateInit2_ z_deflateInit2_ # define deflateInit_ z_deflateInit_ # define deflateParams z_deflateParams # define deflatePending z_deflatePending # define deflatePrime z_deflatePrime # define deflateReset z_deflateReset # define deflateResetKeep z_deflateResetKeep # define deflateSetDictionary z_deflateSetDictionary # define deflateSetHeader z_deflateSetHeader # define deflateTune z_deflateTune # define deflate_copyright z_deflate_copyright # define get_crc_table z_get_crc_table # ifndef Z_SOLO # define gz_error z_gz_error # define gz_intmax z_gz_intmax # define gz_strwinerror z_gz_strwinerror # define gzbuffer z_gzbuffer # define gzclearerr z_gzclearerr # define gzclose z_gzclose # define gzclose_r z_gzclose_r # define gzclose_w z_gzclose_w # define gzdirect z_gzdirect # define gzdopen z_gzdopen # define gzeof z_gzeof # define gzerror z_gzerror # define gzflush z_gzflush # define gzfread z_gzfread # define gzfwrite z_gzfwrite # define gzgetc z_gzgetc # define gzgetc_ z_gzgetc_ # define gzgets z_gzgets # define gzoffset z_gzoffset # define gzoffset64 z_gzoffset64 # define gzopen z_gzopen # define gzopen64 z_gzopen64 # ifdef _WIN32 # define gzopen_w z_gzopen_w # endif # define gzprintf z_gzprintf # define gzputc z_gzputc # define gzputs z_gzputs # define gzread z_gzread # define gzrewind z_gzrewind # define gzseek z_gzseek # define gzseek64 z_gzseek64 # define gzsetparams z_gzsetparams # define gztell z_gztell # define gztell64 z_gztell64 # define gzungetc z_gzungetc # define gzvprintf z_gzvprintf # define gzwrite z_gzwrite # endif # define inflate z_inflate # define inflateBack z_inflateBack # define inflateBackEnd z_inflateBackEnd # define inflateBackInit z_inflateBackInit # define inflateBackInit_ z_inflateBackInit_ # define inflateCodesUsed z_inflateCodesUsed # define inflateCopy z_inflateCopy # define inflateEnd z_inflateEnd # define inflateGetDictionary z_inflateGetDictionary # define inflateGetHeader z_inflateGetHeader # define inflateInit z_inflateInit # define inflateInit2 z_inflateInit2 # define inflateInit2_ z_inflateInit2_ # define inflateInit_ z_inflateInit_ # define inflateMark z_inflateMark # define inflatePrime z_inflatePrime # define inflateReset z_inflateReset # define inflateReset2 z_inflateReset2 # define inflateResetKeep z_inflateResetKeep # define inflateSetDictionary z_inflateSetDictionary # define inflateSync z_inflateSync # define inflateSyncPoint z_inflateSyncPoint # define inflateUndermine z_inflateUndermine # define inflateValidate z_inflateValidate # define inflate_copyright z_inflate_copyright # define inflate_fast z_inflate_fast # define inflate_table z_inflate_table # ifndef Z_SOLO # define uncompress z_uncompress # define uncompress2 z_uncompress2 # endif # define zError z_zError # ifndef Z_SOLO # define zcalloc z_zcalloc # define zcfree z_zcfree # endif # define zlibCompileFlags z_zlibCompileFlags # define zlibVersion z_zlibVersion /* all zlib typedefs in zlib.h and zconf.h */ # define Byte z_Byte # define Bytef z_Bytef # define alloc_func z_alloc_func # define charf z_charf # define free_func z_free_func # ifndef Z_SOLO # define gzFile z_gzFile # endif # define gz_header z_gz_header # define gz_headerp z_gz_headerp # define in_func z_in_func # define intf z_intf # define out_func z_out_func # define uInt z_uInt # define uIntf z_uIntf # define uLong z_uLong # define uLongf z_uLongf # define voidp z_voidp # define voidpc z_voidpc # define voidpf z_voidpf /* all zlib structs in zlib.h and zconf.h */ # define gz_header_s z_gz_header_s # define internal_state z_internal_state #endif #if defined(__MSDOS__) && !defined(MSDOS) # define MSDOS #endif #if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) # define OS2 #endif #if defined(_WINDOWS) && !defined(WINDOWS) # define WINDOWS #endif #if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) # ifndef WIN32 # define WIN32 # endif #endif #if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) # if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) # ifndef SYS16BIT # define SYS16BIT # endif # endif #endif /* * Compile with -DMAXSEG_64K if the alloc function cannot allocate more * than 64k bytes at a time (needed on systems with 16-bit int). */ #ifdef SYS16BIT # define MAXSEG_64K #endif #ifdef MSDOS # define UNALIGNED_OK #endif #ifdef __STDC_VERSION__ # ifndef STDC # define STDC # endif # if __STDC_VERSION__ >= 199901L # ifndef STDC99 # define STDC99 # endif # endif #endif #if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) # define STDC #endif #if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) # define STDC #endif #if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) # define STDC #endif #if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) # define STDC #endif #if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ # define STDC #endif #ifndef STDC # ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ # define const /* note: need a more gentle solution here */ # endif #endif #if defined(ZLIB_CONST) && !defined(z_const) # define z_const const #else # define z_const #endif #ifdef Z_SOLO # ifdef _WIN64 typedef unsigned long long z_size_t; # else typedef unsigned long z_size_t; # endif #else # define z_longlong long long # if defined(NO_SIZE_T) typedef unsigned NO_SIZE_T z_size_t; # elif defined(STDC) # include typedef size_t z_size_t; # else typedef unsigned long z_size_t; # endif # undef z_longlong #endif /* Maximum value for memLevel in deflateInit2 */ #ifndef MAX_MEM_LEVEL # ifdef MAXSEG_64K # define MAX_MEM_LEVEL 8 # else # define MAX_MEM_LEVEL 9 # endif #endif /* Maximum value for windowBits in deflateInit2 and inflateInit2. * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files * created by gzip. (Files created by minigzip can still be extracted by * gzip.) */ #ifndef MAX_WBITS # define MAX_WBITS 15 /* 32K LZ77 window */ #endif /* The memory requirements for deflate are (in bytes): (1 << (windowBits+2)) + (1 << (memLevel+9)) that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) plus a few kilobytes for small objects. For example, if you want to reduce the default memory requirements from 256K to 128K, compile with make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" Of course this will generally degrade compression (there's no free lunch). The memory requirements for inflate are (in bytes) 1 << windowBits that is, 32K for windowBits=15 (default value) plus about 7 kilobytes for small objects. */ /* Type declarations */ #ifndef OF /* function prototypes */ # ifdef STDC # define OF(args) args # else # define OF(args) () # endif #endif /* The following definitions for FAR are needed only for MSDOS mixed * model programming (small or medium model with some far allocations). * This was tested only with MSC; for other MSDOS compilers you may have * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, * just define FAR to be empty. */ #ifdef SYS16BIT # if defined(M_I86SM) || defined(M_I86MM) /* MSC small or medium model */ # define SMALL_MEDIUM # ifdef _MSC_VER # define FAR _far # else # define FAR far # endif # endif # if (defined(__SMALL__) || defined(__MEDIUM__)) /* Turbo C small or medium model */ # define SMALL_MEDIUM # ifdef __BORLANDC__ # define FAR _far # else # define FAR far # endif # endif #endif #if defined(WINDOWS) || defined(WIN32) /* If building or using zlib as a DLL, define ZLIB_DLL. * This is not mandatory, but it offers a little performance increase. */ # ifdef ZLIB_DLL # if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) # ifdef ZLIB_INTERNAL # define ZEXTERN extern __declspec(dllexport) # else # define ZEXTERN extern __declspec(dllimport) # endif # endif # endif /* ZLIB_DLL */ /* If building or using zlib with the WINAPI/WINAPIV calling convention, * define ZLIB_WINAPI. * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. */ # ifdef ZLIB_WINAPI # ifdef FAR # undef FAR # endif # ifndef WIN32_LEAN_AND_MEAN # define WIN32_LEAN_AND_MEAN # endif # include /* No need for _export, use ZLIB.DEF instead. */ /* For complete Windows compatibility, use WINAPI, not __stdcall. */ # define ZEXPORT WINAPI # ifdef WIN32 # define ZEXPORTVA WINAPIV # else # define ZEXPORTVA FAR CDECL # endif # endif #endif #if defined (__BEOS__) # ifdef ZLIB_DLL # ifdef ZLIB_INTERNAL # define ZEXPORT __declspec(dllexport) # define ZEXPORTVA __declspec(dllexport) # else # define ZEXPORT __declspec(dllimport) # define ZEXPORTVA __declspec(dllimport) # endif # endif #endif #ifndef ZEXTERN # define ZEXTERN extern #endif #ifndef ZEXPORT # define ZEXPORT #endif #ifndef ZEXPORTVA # define ZEXPORTVA #endif #ifndef FAR # define FAR #endif #if !defined(__MACTYPES__) typedef unsigned char Byte; /* 8 bits */ #endif typedef unsigned int uInt; /* 16 bits or more */ typedef unsigned long uLong; /* 32 bits or more */ #ifdef SMALL_MEDIUM /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ # define Bytef Byte FAR #else typedef Byte FAR Bytef; #endif typedef char FAR charf; typedef int FAR intf; typedef uInt FAR uIntf; typedef uLong FAR uLongf; #ifdef STDC typedef void const *voidpc; typedef void FAR *voidpf; typedef void *voidp; #else typedef Byte const *voidpc; typedef Byte FAR *voidpf; typedef Byte *voidp; #endif #if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC) # include # if (UINT_MAX == 0xffffffffUL) # define Z_U4 unsigned # elif (ULONG_MAX == 0xffffffffUL) # define Z_U4 unsigned long # elif (USHRT_MAX == 0xffffffffUL) # define Z_U4 unsigned short # endif #endif #ifdef Z_U4 typedef Z_U4 z_crc_t; #else typedef unsigned long z_crc_t; #endif #ifdef HAVE_UNISTD_H /* may be set to #if 1 by ./configure */ # define Z_HAVE_UNISTD_H #endif #ifdef HAVE_STDARG_H /* may be set to #if 1 by ./configure */ # define Z_HAVE_STDARG_H #endif #ifdef STDC # ifndef Z_SOLO # include /* for off_t */ # endif #endif #if defined(STDC) || defined(Z_HAVE_STDARG_H) # ifndef Z_SOLO # include /* for va_list */ # endif #endif #ifdef _WIN32 # ifndef Z_SOLO # include /* for wchar_t */ # endif #endif /* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even * though the former does not conform to the LFS document), but considering * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as * equivalently requesting no 64-bit operations */ #if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1 # undef _LARGEFILE64_SOURCE #endif #ifndef Z_HAVE_UNISTD_H # ifdef __WATCOMC__ # define Z_HAVE_UNISTD_H # endif #endif #ifndef Z_HAVE_UNISTD_H # if defined(_LARGEFILE64_SOURCE) && !defined(_WIN32) # define Z_HAVE_UNISTD_H # endif #endif #ifndef Z_SOLO # if defined(Z_HAVE_UNISTD_H) # include /* for SEEK_*, off_t, and _LFS64_LARGEFILE */ # ifdef VMS # include /* for off_t */ # endif # ifndef z_off_t # define z_off_t off_t # endif # endif #endif #if defined(_LFS64_LARGEFILE) && _LFS64_LARGEFILE-0 # define Z_LFS64 #endif #if defined(_LARGEFILE64_SOURCE) && defined(Z_LFS64) # define Z_LARGE64 #endif #if defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS-0 == 64 && defined(Z_LFS64) # define Z_WANT64 #endif #if !defined(SEEK_SET) && !defined(Z_SOLO) # define SEEK_SET 0 /* Seek from beginning of file. */ # define SEEK_CUR 1 /* Seek from current position. */ # define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ #endif #ifndef z_off_t # define z_off_t long #endif #if !defined(_WIN32) && defined(Z_LARGE64) # define z_off64_t off64_t #else # if defined(_WIN32) && !defined(__GNUC__) # define z_off64_t __int64 # else # define z_off64_t z_off_t # endif #endif /* MVS linker does not support external names larger than 8 bytes */ #if defined(__MVS__) #pragma map(deflateInit_,"DEIN") #pragma map(deflateInit2_,"DEIN2") #pragma map(deflateEnd,"DEEND") #pragma map(deflateBound,"DEBND") #pragma map(inflateInit_,"ININ") #pragma map(inflateInit2_,"ININ2") #pragma map(inflateEnd,"INEND") #pragma map(inflateSync,"INSY") #pragma map(inflateSetDictionary,"INSEDI") #pragma map(compressBound,"CMBND") #pragma map(inflate_table,"INTABL") #pragma map(inflate_fast,"INFA") #pragma map(inflate_copyright,"INCOPY") #endif #endif /* ZCONF_H */ tcl8.6.14/compat/zlib/inflate.h0000644000175000017500000001503314554262142015662 0ustar sergeisergei/* inflate.h -- internal inflate state definition * Copyright (C) 1995-2019 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* WARNING: this file should *not* be used by applications. It is part of the implementation of the compression library and is subject to change. Applications should only use zlib.h. */ /* define NO_GZIP when compiling if you want to disable gzip header and trailer decoding by inflate(). NO_GZIP would be used to avoid linking in the crc code when it is not needed. For shared libraries, gzip decoding should be left enabled. */ #ifndef NO_GZIP # define GUNZIP #endif /* Possible inflate modes between inflate() calls */ typedef enum { HEAD = 16180, /* i: waiting for magic header */ FLAGS, /* i: waiting for method and flags (gzip) */ TIME, /* i: waiting for modification time (gzip) */ OS, /* i: waiting for extra flags and operating system (gzip) */ EXLEN, /* i: waiting for extra length (gzip) */ EXTRA, /* i: waiting for extra bytes (gzip) */ NAME, /* i: waiting for end of file name (gzip) */ COMMENT, /* i: waiting for end of comment (gzip) */ HCRC, /* i: waiting for header crc (gzip) */ DICTID, /* i: waiting for dictionary check value */ DICT, /* waiting for inflateSetDictionary() call */ TYPE, /* i: waiting for type bits, including last-flag bit */ TYPEDO, /* i: same, but skip check to exit inflate on new block */ STORED, /* i: waiting for stored size (length and complement) */ COPY_, /* i/o: same as COPY below, but only first time in */ COPY, /* i/o: waiting for input or output to copy stored block */ TABLE, /* i: waiting for dynamic block table lengths */ LENLENS, /* i: waiting for code length code lengths */ CODELENS, /* i: waiting for length/lit and distance code lengths */ LEN_, /* i: same as LEN below, but only first time in */ LEN, /* i: waiting for length/lit/eob code */ LENEXT, /* i: waiting for length extra bits */ DIST, /* i: waiting for distance code */ DISTEXT, /* i: waiting for distance extra bits */ MATCH, /* o: waiting for output space to copy string */ LIT, /* o: waiting for output space to write literal */ CHECK, /* i: waiting for 32-bit check value */ LENGTH, /* i: waiting for 32-bit length (gzip) */ DONE, /* finished check, done -- remain here until reset */ BAD, /* got a data error -- remain here until reset */ MEM, /* got an inflate() memory error -- remain here until reset */ SYNC /* looking for synchronization bytes to restart inflate() */ } inflate_mode; /* State transitions between above modes - (most modes can go to BAD or MEM on error -- not shown for clarity) Process header: HEAD -> (gzip) or (zlib) or (raw) (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME -> COMMENT -> HCRC -> TYPE (zlib) -> DICTID or TYPE DICTID -> DICT -> TYPE (raw) -> TYPEDO Read deflate blocks: TYPE -> TYPEDO -> STORED or TABLE or LEN_ or CHECK STORED -> COPY_ -> COPY -> TYPE TABLE -> LENLENS -> CODELENS -> LEN_ LEN_ -> LEN Read deflate codes in fixed or dynamic block: LEN -> LENEXT or LIT or TYPE LENEXT -> DIST -> DISTEXT -> MATCH -> LEN LIT -> LEN Process trailer: CHECK -> LENGTH -> DONE */ /* State maintained between inflate() calls -- approximately 7K bytes, not including the allocated sliding window, which is up to 32K bytes. */ struct inflate_state { z_streamp strm; /* pointer back to this zlib stream */ inflate_mode mode; /* current inflate mode */ int last; /* true if processing last block */ int wrap; /* bit 0 true for zlib, bit 1 true for gzip, bit 2 true to validate check value */ int havedict; /* true if dictionary provided */ int flags; /* gzip header method and flags, 0 if zlib, or -1 if raw or no header yet */ unsigned dmax; /* zlib header max distance (INFLATE_STRICT) */ unsigned long check; /* protected copy of check value */ unsigned long total; /* protected copy of output count */ gz_headerp head; /* where to save gzip header information */ /* sliding window */ unsigned wbits; /* log base 2 of requested window size */ unsigned wsize; /* window size or zero if not using window */ unsigned whave; /* valid bytes in the window */ unsigned wnext; /* window write index */ unsigned char FAR *window; /* allocated sliding window, if needed */ /* bit accumulator */ unsigned long hold; /* input bit accumulator */ unsigned bits; /* number of bits in "in" */ /* for string and stored block copying */ unsigned length; /* literal or length of data to copy */ unsigned offset; /* distance back to copy string from */ /* for table and code decoding */ unsigned extra; /* extra bits needed */ /* fixed and dynamic code tables */ code const FAR *lencode; /* starting table for length/literal codes */ code const FAR *distcode; /* starting table for distance codes */ unsigned lenbits; /* index bits for lencode */ unsigned distbits; /* index bits for distcode */ /* dynamic table building */ unsigned ncode; /* number of code length code lengths */ unsigned nlen; /* number of length code lengths */ unsigned ndist; /* number of distance code lengths */ unsigned have; /* number of code lengths in lens[] */ code FAR *next; /* next available space in codes[] */ unsigned short lens[320]; /* temporary storage for code lengths */ unsigned short work[288]; /* work area for code table building */ code codes[ENOUGH]; /* space for code tables */ int sane; /* if false, allow invalid distance too far */ int back; /* bits back of last unprocessed length/lit */ unsigned was; /* initial length of match */ }; tcl8.6.14/compat/zlib/Makefile.in0000644000175000017500000003276314560736523016153 0ustar sergeisergei# Makefile for zlib # Copyright (C) 1995-2024 Jean-loup Gailly, Mark Adler # For conditions of distribution and use, see copyright notice in zlib.h # To compile and test, type: # ./configure; make test # Normally configure builds both a static and a shared library. # If you want to build just a static library, use: ./configure --static # To install /usr/local/lib/libz.* and /usr/local/include/zlib.h, type: # make install # To install in $HOME instead of /usr/local, use: # make install prefix=$HOME CC=cc CFLAGS=-O #CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7 #CFLAGS=-g -DZLIB_DEBUG #CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \ # -Wstrict-prototypes -Wmissing-prototypes SFLAGS=-O LDFLAGS= TEST_LIBS=-L. libz.a LDSHARED=$(CC) CPP=$(CC) -E STATICLIB=libz.a SHAREDLIB=libz.so SHAREDLIBV=libz.so.1.3.1 SHAREDLIBM=libz.so.1 LIBS=$(STATICLIB) $(SHAREDLIBV) AR=ar ARFLAGS=rc RANLIB=ranlib LDCONFIG=ldconfig LDSHAREDLIBC=-lc TAR=tar SHELL=/bin/sh EXE= prefix = /usr/local exec_prefix = ${prefix} libdir = ${exec_prefix}/lib sharedlibdir = ${libdir} includedir = ${prefix}/include mandir = ${prefix}/share/man man3dir = ${mandir}/man3 pkgconfigdir = ${libdir}/pkgconfig SRCDIR= ZINC= ZINCOUT=-I. OBJZ = adler32.o crc32.o deflate.o infback.o inffast.o inflate.o inftrees.o trees.o zutil.o OBJG = compress.o uncompr.o gzclose.o gzlib.o gzread.o gzwrite.o OBJC = $(OBJZ) $(OBJG) PIC_OBJZ = adler32.lo crc32.lo deflate.lo infback.lo inffast.lo inflate.lo inftrees.lo trees.lo zutil.lo PIC_OBJG = compress.lo uncompr.lo gzclose.lo gzlib.lo gzread.lo gzwrite.lo PIC_OBJC = $(PIC_OBJZ) $(PIC_OBJG) # to use the asm code: make OBJA=match.o, PIC_OBJA=match.lo OBJA = PIC_OBJA = OBJS = $(OBJC) $(OBJA) PIC_OBJS = $(PIC_OBJC) $(PIC_OBJA) all: static shared static: example$(EXE) minigzip$(EXE) shared: examplesh$(EXE) minigzipsh$(EXE) all64: example64$(EXE) minigzip64$(EXE) check: test test: all teststatic testshared teststatic: static @TMPST=tmpst_$$; \ if echo hello world | ${QEMU_RUN} ./minigzip | ${QEMU_RUN} ./minigzip -d && ${QEMU_RUN} ./example $$TMPST ; then \ echo ' *** zlib test OK ***'; \ else \ echo ' *** zlib test FAILED ***'; false; \ fi @rm -f tmpst_$$ testshared: shared @LD_LIBRARY_PATH=`pwd`:$(LD_LIBRARY_PATH) ; export LD_LIBRARY_PATH; \ LD_LIBRARYN32_PATH=`pwd`:$(LD_LIBRARYN32_PATH) ; export LD_LIBRARYN32_PATH; \ DYLD_LIBRARY_PATH=`pwd`:$(DYLD_LIBRARY_PATH) ; export DYLD_LIBRARY_PATH; \ SHLIB_PATH=`pwd`:$(SHLIB_PATH) ; export SHLIB_PATH; \ TMPSH=tmpsh_$$; \ if echo hello world | ${QEMU_RUN} ./minigzipsh | ${QEMU_RUN} ./minigzipsh -d && ${QEMU_RUN} ./examplesh $$TMPSH; then \ echo ' *** zlib shared test OK ***'; \ else \ echo ' *** zlib shared test FAILED ***'; false; \ fi @rm -f tmpsh_$$ test64: all64 @TMP64=tmp64_$$; \ if echo hello world | ${QEMU_RUN} ./minigzip64 | ${QEMU_RUN} ./minigzip64 -d && ${QEMU_RUN} ./example64 $$TMP64; then \ echo ' *** zlib 64-bit test OK ***'; \ else \ echo ' *** zlib 64-bit test FAILED ***'; false; \ fi @rm -f tmp64_$$ infcover.o: $(SRCDIR)test/infcover.c $(SRCDIR)zlib.h zconf.h $(CC) $(CFLAGS) $(ZINCOUT) -c -o $@ $(SRCDIR)test/infcover.c infcover: infcover.o libz.a $(CC) $(CFLAGS) -o $@ infcover.o libz.a cover: infcover rm -f *.gcda ${QEMU_RUN} ./infcover gcov inf*.c libz.a: $(OBJS) $(AR) $(ARFLAGS) $@ $(OBJS) -@ ($(RANLIB) $@ || true) >/dev/null 2>&1 match.o: match.S $(CPP) match.S > _match.s $(CC) -c _match.s mv _match.o match.o rm -f _match.s match.lo: match.S $(CPP) match.S > _match.s $(CC) -c -fPIC _match.s mv _match.o match.lo rm -f _match.s example.o: $(SRCDIR)test/example.c $(SRCDIR)zlib.h zconf.h $(CC) $(CFLAGS) $(ZINCOUT) -c -o $@ $(SRCDIR)test/example.c minigzip.o: $(SRCDIR)test/minigzip.c $(SRCDIR)zlib.h zconf.h $(CC) $(CFLAGS) $(ZINCOUT) -c -o $@ $(SRCDIR)test/minigzip.c example64.o: $(SRCDIR)test/example.c $(SRCDIR)zlib.h zconf.h $(CC) $(CFLAGS) $(ZINCOUT) -D_FILE_OFFSET_BITS=64 -c -o $@ $(SRCDIR)test/example.c minigzip64.o: $(SRCDIR)test/minigzip.c $(SRCDIR)zlib.h zconf.h $(CC) $(CFLAGS) $(ZINCOUT) -D_FILE_OFFSET_BITS=64 -c -o $@ $(SRCDIR)test/minigzip.c adler32.o: $(SRCDIR)adler32.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)adler32.c crc32.o: $(SRCDIR)crc32.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)crc32.c deflate.o: $(SRCDIR)deflate.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)deflate.c infback.o: $(SRCDIR)infback.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)infback.c inffast.o: $(SRCDIR)inffast.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inffast.c inflate.o: $(SRCDIR)inflate.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inflate.c inftrees.o: $(SRCDIR)inftrees.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inftrees.c trees.o: $(SRCDIR)trees.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)trees.c zutil.o: $(SRCDIR)zutil.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)zutil.c compress.o: $(SRCDIR)compress.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)compress.c uncompr.o: $(SRCDIR)uncompr.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)uncompr.c gzclose.o: $(SRCDIR)gzclose.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzclose.c gzlib.o: $(SRCDIR)gzlib.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzlib.c gzread.o: $(SRCDIR)gzread.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzread.c gzwrite.o: $(SRCDIR)gzwrite.c $(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzwrite.c adler32.lo: $(SRCDIR)adler32.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/adler32.o $(SRCDIR)adler32.c -@mv objs/adler32.o $@ crc32.lo: $(SRCDIR)crc32.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/crc32.o $(SRCDIR)crc32.c -@mv objs/crc32.o $@ deflate.lo: $(SRCDIR)deflate.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/deflate.o $(SRCDIR)deflate.c -@mv objs/deflate.o $@ infback.lo: $(SRCDIR)infback.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/infback.o $(SRCDIR)infback.c -@mv objs/infback.o $@ inffast.lo: $(SRCDIR)inffast.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inffast.o $(SRCDIR)inffast.c -@mv objs/inffast.o $@ inflate.lo: $(SRCDIR)inflate.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inflate.o $(SRCDIR)inflate.c -@mv objs/inflate.o $@ inftrees.lo: $(SRCDIR)inftrees.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inftrees.o $(SRCDIR)inftrees.c -@mv objs/inftrees.o $@ trees.lo: $(SRCDIR)trees.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/trees.o $(SRCDIR)trees.c -@mv objs/trees.o $@ zutil.lo: $(SRCDIR)zutil.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/zutil.o $(SRCDIR)zutil.c -@mv objs/zutil.o $@ compress.lo: $(SRCDIR)compress.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/compress.o $(SRCDIR)compress.c -@mv objs/compress.o $@ uncompr.lo: $(SRCDIR)uncompr.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/uncompr.o $(SRCDIR)uncompr.c -@mv objs/uncompr.o $@ gzclose.lo: $(SRCDIR)gzclose.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzclose.o $(SRCDIR)gzclose.c -@mv objs/gzclose.o $@ gzlib.lo: $(SRCDIR)gzlib.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzlib.o $(SRCDIR)gzlib.c -@mv objs/gzlib.o $@ gzread.lo: $(SRCDIR)gzread.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzread.o $(SRCDIR)gzread.c -@mv objs/gzread.o $@ gzwrite.lo: $(SRCDIR)gzwrite.c -@mkdir objs 2>/dev/null || test -d objs $(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzwrite.o $(SRCDIR)gzwrite.c -@mv objs/gzwrite.o $@ placebo $(SHAREDLIBV): $(PIC_OBJS) libz.a $(LDSHARED) $(SFLAGS) -o $@ $(PIC_OBJS) $(LDSHAREDLIBC) $(LDFLAGS) rm -f $(SHAREDLIB) $(SHAREDLIBM) ln -s $@ $(SHAREDLIB) ln -s $@ $(SHAREDLIBM) -@rmdir objs example$(EXE): example.o $(STATICLIB) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ example.o $(TEST_LIBS) minigzip$(EXE): minigzip.o $(STATICLIB) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ minigzip.o $(TEST_LIBS) examplesh$(EXE): example.o $(SHAREDLIBV) $(CC) $(CFLAGS) -o $@ example.o $(LDFLAGS) -L. $(SHAREDLIBV) minigzipsh$(EXE): minigzip.o $(SHAREDLIBV) $(CC) $(CFLAGS) -o $@ minigzip.o $(LDFLAGS) -L. $(SHAREDLIBV) example64$(EXE): example64.o $(STATICLIB) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ example64.o $(TEST_LIBS) minigzip64$(EXE): minigzip64.o $(STATICLIB) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ minigzip64.o $(TEST_LIBS) install-libs: $(LIBS) -@if [ ! -d $(DESTDIR)$(exec_prefix) ]; then mkdir -p $(DESTDIR)$(exec_prefix); fi -@if [ ! -d $(DESTDIR)$(libdir) ]; then mkdir -p $(DESTDIR)$(libdir); fi -@if [ ! -d $(DESTDIR)$(sharedlibdir) ]; then mkdir -p $(DESTDIR)$(sharedlibdir); fi -@if [ ! -d $(DESTDIR)$(man3dir) ]; then mkdir -p $(DESTDIR)$(man3dir); fi -@if [ ! -d $(DESTDIR)$(pkgconfigdir) ]; then mkdir -p $(DESTDIR)$(pkgconfigdir); fi rm -f $(DESTDIR)$(libdir)/$(STATICLIB) cp $(STATICLIB) $(DESTDIR)$(libdir) chmod 644 $(DESTDIR)$(libdir)/$(STATICLIB) -@($(RANLIB) $(DESTDIR)$(libdir)/libz.a || true) >/dev/null 2>&1 -@if test -n "$(SHAREDLIBV)"; then \ rm -f $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV); \ cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir); \ echo "cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)"; \ chmod 755 $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV); \ echo "chmod 755 $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV)"; \ rm -f $(DESTDIR)$(sharedlibdir)/$(SHAREDLIB) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBM); \ ln -s $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIB); \ ln -s $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBM); \ ($(LDCONFIG) || true) >/dev/null 2>&1; \ fi rm -f $(DESTDIR)$(man3dir)/zlib.3 cp $(SRCDIR)zlib.3 $(DESTDIR)$(man3dir) chmod 644 $(DESTDIR)$(man3dir)/zlib.3 rm -f $(DESTDIR)$(pkgconfigdir)/zlib.pc cp zlib.pc $(DESTDIR)$(pkgconfigdir) chmod 644 $(DESTDIR)$(pkgconfigdir)/zlib.pc # The ranlib in install is needed on NeXTSTEP which checks file times # ldconfig is for Linux install: install-libs -@if [ ! -d $(DESTDIR)$(includedir) ]; then mkdir -p $(DESTDIR)$(includedir); fi rm -f $(DESTDIR)$(includedir)/zlib.h $(DESTDIR)$(includedir)/zconf.h cp $(SRCDIR)zlib.h zconf.h $(DESTDIR)$(includedir) chmod 644 $(DESTDIR)$(includedir)/zlib.h $(DESTDIR)$(includedir)/zconf.h uninstall: cd $(DESTDIR)$(includedir) && rm -f zlib.h zconf.h cd $(DESTDIR)$(libdir) && rm -f libz.a; \ if test -n "$(SHAREDLIBV)" -a -f $(SHAREDLIBV); then \ rm -f $(SHAREDLIBV) $(SHAREDLIB) $(SHAREDLIBM); \ fi cd $(DESTDIR)$(man3dir) && rm -f zlib.3 cd $(DESTDIR)$(pkgconfigdir) && rm -f zlib.pc docs: zlib.3.pdf zlib.3.pdf: $(SRCDIR)zlib.3 groff -mandoc -f H -T ps $(SRCDIR)zlib.3 | ps2pdf - $@ zconf.h.cmakein: $(SRCDIR)zconf.h.in -@ TEMPFILE=zconfh_$$; \ echo "/#define ZCONF_H/ a\\\\\n#cmakedefine Z_PREFIX\\\\\n#cmakedefine Z_HAVE_UNISTD_H\n" >> $$TEMPFILE &&\ sed -f $$TEMPFILE $(SRCDIR)zconf.h.in > $@ &&\ touch -r $(SRCDIR)zconf.h.in $@ &&\ rm $$TEMPFILE zconf: $(SRCDIR)zconf.h.in cp -p $(SRCDIR)zconf.h.in zconf.h minizip-test: static cd contrib/minizip && { CC="$(CC)" CFLAGS="$(CFLAGS)" $(MAKE) test ; cd ../.. ; } minizip-clean: cd contrib/minizip && { $(MAKE) clean ; cd ../.. ; } mostlyclean: clean clean: minizip-clean rm -f *.o *.lo *~ \ example$(EXE) minigzip$(EXE) examplesh$(EXE) minigzipsh$(EXE) \ example64$(EXE) minigzip64$(EXE) \ infcover \ libz.* foo.gz so_locations \ _match.s maketree contrib/infback9/*.o rm -rf objs rm -f *.gcda *.gcno *.gcov rm -f contrib/infback9/*.gcda contrib/infback9/*.gcno contrib/infback9/*.gcov maintainer-clean: distclean distclean: clean zconf zconf.h.cmakein rm -f Makefile zlib.pc configure.log -@rm -f .DS_Store @if [ -f Makefile.in ]; then \ printf 'all:\n\t-@echo "Please use ./configure first. Thank you."\n' > Makefile ; \ printf '\ndistclean:\n\tmake -f Makefile.in distclean\n' >> Makefile ; \ touch -r $(SRCDIR)Makefile.in Makefile ; fi tags: etags $(SRCDIR)*.[ch] adler32.o zutil.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h gzclose.o gzlib.o gzread.o gzwrite.o: $(SRCDIR)zlib.h zconf.h $(SRCDIR)gzguts.h compress.o example.o minigzip.o uncompr.o: $(SRCDIR)zlib.h zconf.h crc32.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)crc32.h deflate.o: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h infback.o inflate.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h $(SRCDIR)inffixed.h inffast.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h inftrees.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h trees.o: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)trees.h adler32.lo zutil.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h gzclose.lo gzlib.lo gzread.lo gzwrite.lo: $(SRCDIR)zlib.h zconf.h $(SRCDIR)gzguts.h compress.lo example.lo minigzip.lo uncompr.lo: $(SRCDIR)zlib.h zconf.h crc32.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)crc32.h deflate.lo: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h infback.lo inflate.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h $(SRCDIR)inffixed.h inffast.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h inftrees.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h trees.lo: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)trees.h tcl8.6.14/compat/zlib/zconf.h.in0000644000175000017500000004016414560736524015776 0ustar sergeisergei/* zconf.h -- configuration of the zlib compression library * Copyright (C) 1995-2024 Jean-loup Gailly, Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* @(#) $Id$ */ #ifndef ZCONF_H #define ZCONF_H /* * If you *really* need a unique prefix for all types and library functions, * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. * Even better than compiling with -DZ_PREFIX would be to use configure to set * this permanently in zconf.h using "./configure --zprefix". */ #ifdef Z_PREFIX /* may be set to #if 1 by ./configure */ # define Z_PREFIX_SET /* all linked symbols and init macros */ # define _dist_code z__dist_code # define _length_code z__length_code # define _tr_align z__tr_align # define _tr_flush_bits z__tr_flush_bits # define _tr_flush_block z__tr_flush_block # define _tr_init z__tr_init # define _tr_stored_block z__tr_stored_block # define _tr_tally z__tr_tally # define adler32 z_adler32 # define adler32_combine z_adler32_combine # define adler32_combine64 z_adler32_combine64 # define adler32_z z_adler32_z # ifndef Z_SOLO # define compress z_compress # define compress2 z_compress2 # define compressBound z_compressBound # endif # define crc32 z_crc32 # define crc32_combine z_crc32_combine # define crc32_combine64 z_crc32_combine64 # define crc32_combine_gen z_crc32_combine_gen # define crc32_combine_gen64 z_crc32_combine_gen64 # define crc32_combine_op z_crc32_combine_op # define crc32_z z_crc32_z # define deflate z_deflate # define deflateBound z_deflateBound # define deflateCopy z_deflateCopy # define deflateEnd z_deflateEnd # define deflateGetDictionary z_deflateGetDictionary # define deflateInit z_deflateInit # define deflateInit2 z_deflateInit2 # define deflateInit2_ z_deflateInit2_ # define deflateInit_ z_deflateInit_ # define deflateParams z_deflateParams # define deflatePending z_deflatePending # define deflatePrime z_deflatePrime # define deflateReset z_deflateReset # define deflateResetKeep z_deflateResetKeep # define deflateSetDictionary z_deflateSetDictionary # define deflateSetHeader z_deflateSetHeader # define deflateTune z_deflateTune # define deflate_copyright z_deflate_copyright # define get_crc_table z_get_crc_table # ifndef Z_SOLO # define gz_error z_gz_error # define gz_intmax z_gz_intmax # define gz_strwinerror z_gz_strwinerror # define gzbuffer z_gzbuffer # define gzclearerr z_gzclearerr # define gzclose z_gzclose # define gzclose_r z_gzclose_r # define gzclose_w z_gzclose_w # define gzdirect z_gzdirect # define gzdopen z_gzdopen # define gzeof z_gzeof # define gzerror z_gzerror # define gzflush z_gzflush # define gzfread z_gzfread # define gzfwrite z_gzfwrite # define gzgetc z_gzgetc # define gzgetc_ z_gzgetc_ # define gzgets z_gzgets # define gzoffset z_gzoffset # define gzoffset64 z_gzoffset64 # define gzopen z_gzopen # define gzopen64 z_gzopen64 # ifdef _WIN32 # define gzopen_w z_gzopen_w # endif # define gzprintf z_gzprintf # define gzputc z_gzputc # define gzputs z_gzputs # define gzread z_gzread # define gzrewind z_gzrewind # define gzseek z_gzseek # define gzseek64 z_gzseek64 # define gzsetparams z_gzsetparams # define gztell z_gztell # define gztell64 z_gztell64 # define gzungetc z_gzungetc # define gzvprintf z_gzvprintf # define gzwrite z_gzwrite # endif # define inflate z_inflate # define inflateBack z_inflateBack # define inflateBackEnd z_inflateBackEnd # define inflateBackInit z_inflateBackInit # define inflateBackInit_ z_inflateBackInit_ # define inflateCodesUsed z_inflateCodesUsed # define inflateCopy z_inflateCopy # define inflateEnd z_inflateEnd # define inflateGetDictionary z_inflateGetDictionary # define inflateGetHeader z_inflateGetHeader # define inflateInit z_inflateInit # define inflateInit2 z_inflateInit2 # define inflateInit2_ z_inflateInit2_ # define inflateInit_ z_inflateInit_ # define inflateMark z_inflateMark # define inflatePrime z_inflatePrime # define inflateReset z_inflateReset # define inflateReset2 z_inflateReset2 # define inflateResetKeep z_inflateResetKeep # define inflateSetDictionary z_inflateSetDictionary # define inflateSync z_inflateSync # define inflateSyncPoint z_inflateSyncPoint # define inflateUndermine z_inflateUndermine # define inflateValidate z_inflateValidate # define inflate_copyright z_inflate_copyright # define inflate_fast z_inflate_fast # define inflate_table z_inflate_table # ifndef Z_SOLO # define uncompress z_uncompress # define uncompress2 z_uncompress2 # endif # define zError z_zError # ifndef Z_SOLO # define zcalloc z_zcalloc # define zcfree z_zcfree # endif # define zlibCompileFlags z_zlibCompileFlags # define zlibVersion z_zlibVersion /* all zlib typedefs in zlib.h and zconf.h */ # define Byte z_Byte # define Bytef z_Bytef # define alloc_func z_alloc_func # define charf z_charf # define free_func z_free_func # ifndef Z_SOLO # define gzFile z_gzFile # endif # define gz_header z_gz_header # define gz_headerp z_gz_headerp # define in_func z_in_func # define intf z_intf # define out_func z_out_func # define uInt z_uInt # define uIntf z_uIntf # define uLong z_uLong # define uLongf z_uLongf # define voidp z_voidp # define voidpc z_voidpc # define voidpf z_voidpf /* all zlib structs in zlib.h and zconf.h */ # define gz_header_s z_gz_header_s # define internal_state z_internal_state #endif #if defined(__MSDOS__) && !defined(MSDOS) # define MSDOS #endif #if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) # define OS2 #endif #if defined(_WINDOWS) && !defined(WINDOWS) # define WINDOWS #endif #if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) # ifndef WIN32 # define WIN32 # endif #endif #if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) # if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) # ifndef SYS16BIT # define SYS16BIT # endif # endif #endif /* * Compile with -DMAXSEG_64K if the alloc function cannot allocate more * than 64k bytes at a time (needed on systems with 16-bit int). */ #ifdef SYS16BIT # define MAXSEG_64K #endif #ifdef MSDOS # define UNALIGNED_OK #endif #ifdef __STDC_VERSION__ # ifndef STDC # define STDC # endif # if __STDC_VERSION__ >= 199901L # ifndef STDC99 # define STDC99 # endif # endif #endif #if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) # define STDC #endif #if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) # define STDC #endif #if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) # define STDC #endif #if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) # define STDC #endif #if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ # define STDC #endif #ifndef STDC # ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ # define const /* note: need a more gentle solution here */ # endif #endif #if defined(ZLIB_CONST) && !defined(z_const) # define z_const const #else # define z_const #endif #ifdef Z_SOLO # ifdef _WIN64 typedef unsigned long long z_size_t; # else typedef unsigned long z_size_t; # endif #else # define z_longlong long long # if defined(NO_SIZE_T) typedef unsigned NO_SIZE_T z_size_t; # elif defined(STDC) # include typedef size_t z_size_t; # else typedef unsigned long z_size_t; # endif # undef z_longlong #endif /* Maximum value for memLevel in deflateInit2 */ #ifndef MAX_MEM_LEVEL # ifdef MAXSEG_64K # define MAX_MEM_LEVEL 8 # else # define MAX_MEM_LEVEL 9 # endif #endif /* Maximum value for windowBits in deflateInit2 and inflateInit2. * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files * created by gzip. (Files created by minigzip can still be extracted by * gzip.) */ #ifndef MAX_WBITS # define MAX_WBITS 15 /* 32K LZ77 window */ #endif /* The memory requirements for deflate are (in bytes): (1 << (windowBits+2)) + (1 << (memLevel+9)) that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) plus a few kilobytes for small objects. For example, if you want to reduce the default memory requirements from 256K to 128K, compile with make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" Of course this will generally degrade compression (there's no free lunch). The memory requirements for inflate are (in bytes) 1 << windowBits that is, 32K for windowBits=15 (default value) plus about 7 kilobytes for small objects. */ /* Type declarations */ #ifndef OF /* function prototypes */ # ifdef STDC # define OF(args) args # else # define OF(args) () # endif #endif /* The following definitions for FAR are needed only for MSDOS mixed * model programming (small or medium model with some far allocations). * This was tested only with MSC; for other MSDOS compilers you may have * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, * just define FAR to be empty. */ #ifdef SYS16BIT # if defined(M_I86SM) || defined(M_I86MM) /* MSC small or medium model */ # define SMALL_MEDIUM # ifdef _MSC_VER # define FAR _far # else # define FAR far # endif # endif # if (defined(__SMALL__) || defined(__MEDIUM__)) /* Turbo C small or medium model */ # define SMALL_MEDIUM # ifdef __BORLANDC__ # define FAR _far # else # define FAR far # endif # endif #endif #if defined(WINDOWS) || defined(WIN32) /* If building or using zlib as a DLL, define ZLIB_DLL. * This is not mandatory, but it offers a little performance increase. */ # ifdef ZLIB_DLL # if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) # ifdef ZLIB_INTERNAL # define ZEXTERN extern __declspec(dllexport) # else # define ZEXTERN extern __declspec(dllimport) # endif # endif # endif /* ZLIB_DLL */ /* If building or using zlib with the WINAPI/WINAPIV calling convention, * define ZLIB_WINAPI. * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. */ # ifdef ZLIB_WINAPI # ifdef FAR # undef FAR # endif # ifndef WIN32_LEAN_AND_MEAN # define WIN32_LEAN_AND_MEAN # endif # include /* No need for _export, use ZLIB.DEF instead. */ /* For complete Windows compatibility, use WINAPI, not __stdcall. */ # define ZEXPORT WINAPI # ifdef WIN32 # define ZEXPORTVA WINAPIV # else # define ZEXPORTVA FAR CDECL # endif # endif #endif #if defined (__BEOS__) # ifdef ZLIB_DLL # ifdef ZLIB_INTERNAL # define ZEXPORT __declspec(dllexport) # define ZEXPORTVA __declspec(dllexport) # else # define ZEXPORT __declspec(dllimport) # define ZEXPORTVA __declspec(dllimport) # endif # endif #endif #ifndef ZEXTERN # define ZEXTERN extern #endif #ifndef ZEXPORT # define ZEXPORT #endif #ifndef ZEXPORTVA # define ZEXPORTVA #endif #ifndef FAR # define FAR #endif #if !defined(__MACTYPES__) typedef unsigned char Byte; /* 8 bits */ #endif typedef unsigned int uInt; /* 16 bits or more */ typedef unsigned long uLong; /* 32 bits or more */ #ifdef SMALL_MEDIUM /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ # define Bytef Byte FAR #else typedef Byte FAR Bytef; #endif typedef char FAR charf; typedef int FAR intf; typedef uInt FAR uIntf; typedef uLong FAR uLongf; #ifdef STDC typedef void const *voidpc; typedef void FAR *voidpf; typedef void *voidp; #else typedef Byte const *voidpc; typedef Byte FAR *voidpf; typedef Byte *voidp; #endif #if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC) # include # if (UINT_MAX == 0xffffffffUL) # define Z_U4 unsigned # elif (ULONG_MAX == 0xffffffffUL) # define Z_U4 unsigned long # elif (USHRT_MAX == 0xffffffffUL) # define Z_U4 unsigned short # endif #endif #ifdef Z_U4 typedef Z_U4 z_crc_t; #else typedef unsigned long z_crc_t; #endif #ifdef HAVE_UNISTD_H /* may be set to #if 1 by ./configure */ # define Z_HAVE_UNISTD_H #endif #ifdef HAVE_STDARG_H /* may be set to #if 1 by ./configure */ # define Z_HAVE_STDARG_H #endif #ifdef STDC # ifndef Z_SOLO # include /* for off_t */ # endif #endif #if defined(STDC) || defined(Z_HAVE_STDARG_H) # ifndef Z_SOLO # include /* for va_list */ # endif #endif #ifdef _WIN32 # ifndef Z_SOLO # include /* for wchar_t */ # endif #endif /* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even * though the former does not conform to the LFS document), but considering * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as * equivalently requesting no 64-bit operations */ #if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1 # undef _LARGEFILE64_SOURCE #endif #ifndef Z_HAVE_UNISTD_H # ifdef __WATCOMC__ # define Z_HAVE_UNISTD_H # endif #endif #ifndef Z_HAVE_UNISTD_H # if defined(_LARGEFILE64_SOURCE) && !defined(_WIN32) # define Z_HAVE_UNISTD_H # endif #endif #ifndef Z_SOLO # if defined(Z_HAVE_UNISTD_H) # include /* for SEEK_*, off_t, and _LFS64_LARGEFILE */ # ifdef VMS # include /* for off_t */ # endif # ifndef z_off_t # define z_off_t off_t # endif # endif #endif #if defined(_LFS64_LARGEFILE) && _LFS64_LARGEFILE-0 # define Z_LFS64 #endif #if defined(_LARGEFILE64_SOURCE) && defined(Z_LFS64) # define Z_LARGE64 #endif #if defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS-0 == 64 && defined(Z_LFS64) # define Z_WANT64 #endif #if !defined(SEEK_SET) && !defined(Z_SOLO) # define SEEK_SET 0 /* Seek from beginning of file. */ # define SEEK_CUR 1 /* Seek from current position. */ # define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ #endif #ifndef z_off_t # define z_off_t long #endif #if !defined(_WIN32) && defined(Z_LARGE64) # define z_off64_t off64_t #else # if defined(_WIN32) && !defined(__GNUC__) # define z_off64_t __int64 # else # define z_off64_t z_off_t # endif #endif /* MVS linker does not support external names larger than 8 bytes */ #if defined(__MVS__) #pragma map(deflateInit_,"DEIN") #pragma map(deflateInit2_,"DEIN2") #pragma map(deflateEnd,"DEEND") #pragma map(deflateBound,"DEBND") #pragma map(inflateInit_,"ININ") #pragma map(inflateInit2_,"ININ2") #pragma map(inflateEnd,"INEND") #pragma map(inflateSync,"INSY") #pragma map(inflateSetDictionary,"INSEDI") #pragma map(compressBound,"CMBND") #pragma map(inflate_table,"INTABL") #pragma map(inflate_fast,"INFA") #pragma map(inflate_copyright,"INCOPY") #endif #endif /* ZCONF_H */ tcl8.6.14/compat/zlib/examples/0000755000175000017500000000000014566153412015705 5ustar sergeisergeitcl8.6.14/compat/zlib/examples/enough.c0000644000175000017500000006043014554262142017337 0ustar sergeisergei/* enough.c -- determine the maximum size of inflate's Huffman code tables over * all possible valid and complete prefix codes, subject to a length limit. * Copyright (C) 2007, 2008, 2012, 2018 Mark Adler * Version 1.5 5 August 2018 Mark Adler */ /* Version history: 1.0 3 Jan 2007 First version (derived from codecount.c version 1.4) 1.1 4 Jan 2007 Use faster incremental table usage computation Prune examine() search on previously visited states 1.2 5 Jan 2007 Comments clean up As inflate does, decrease root for short codes Refuse cases where inflate would increase root 1.3 17 Feb 2008 Add argument for initial root table size Fix bug for initial root table size == max - 1 Use a macro to compute the history index 1.4 18 Aug 2012 Avoid shifts more than bits in type (caused endless loop!) Clean up comparisons of different types Clean up code indentation 1.5 5 Aug 2018 Clean up code style, formatting, and comments Show all the codes for the maximum, and only the maximum */ /* Examine all possible prefix codes for a given number of symbols and a maximum code length in bits to determine the maximum table size for zlib's inflate. Only complete prefix codes are counted. Two codes are considered distinct if the vectors of the number of codes per length are not identical. So permutations of the symbol assignments result in the same code for the counting, as do permutations of the assignments of the bit values to the codes (i.e. only canonical codes are counted). We build a code from shorter to longer lengths, determining how many symbols are coded at each length. At each step, we have how many symbols remain to be coded, what the last code length used was, and how many bit patterns of that length remain unused. Then we add one to the code length and double the number of unused patterns to graduate to the next code length. We then assign all portions of the remaining symbols to that code length that preserve the properties of a correct and eventually complete code. Those properties are: we cannot use more bit patterns than are available; and when all the symbols are used, there are exactly zero possible bit patterns left unused. The inflate Huffman decoding algorithm uses two-level lookup tables for speed. There is a single first-level table to decode codes up to root bits in length (root == 9 for literal/length codes and root == 6 for distance codes, in the current inflate implementation). The base table has 1 << root entries and is indexed by the next root bits of input. Codes shorter than root bits have replicated table entries, so that the correct entry is pointed to regardless of the bits that follow the short code. If the code is longer than root bits, then the table entry points to a second-level table. The size of that table is determined by the longest code with that root-bit prefix. If that longest code has length len, then the table has size 1 << (len - root), to index the remaining bits in that set of codes. Each subsequent root-bit prefix then has its own sub-table. The total number of table entries required by the code is calculated incrementally as the number of codes at each bit length is populated. When all of the codes are shorter than root bits, then root is reduced to the longest code length, resulting in a single, smaller, one-level table. The inflate algorithm also provides for small values of root (relative to the log2 of the number of symbols), where the shortest code has more bits than root. In that case, root is increased to the length of the shortest code. This program, by design, does not handle that case, so it is verified that the number of symbols is less than 1 << (root + 1). In order to speed up the examination (by about ten orders of magnitude for the default arguments), the intermediate states in the build-up of a code are remembered and previously visited branches are pruned. The memory required for this will increase rapidly with the total number of symbols and the maximum code length in bits. However this is a very small price to pay for the vast speedup. First, all of the possible prefix codes are counted, and reachable intermediate states are noted by a non-zero count in a saved-results array. Second, the intermediate states that lead to (root + 1) bit or longer codes are used to look at all sub-codes from those junctures for their inflate memory usage. (The amount of memory used is not affected by the number of codes of root bits or less in length.) Third, the visited states in the construction of those sub-codes and the associated calculation of the table size is recalled in order to avoid recalculating from the same juncture. Beginning the code examination at (root + 1) bit codes, which is enabled by identifying the reachable nodes, accounts for about six of the orders of magnitude of improvement for the default arguments. About another four orders of magnitude come from not revisiting previous states. Out of approximately 2x10^16 possible prefix codes, only about 2x10^6 sub-codes need to be examined to cover all of the possible table memory usage cases for the default arguments of 286 symbols limited to 15-bit codes. Note that the uintmax_t type is used for counting. It is quite easy to exceed the capacity of an eight-byte integer with a large number of symbols and a large maximum code length, so multiple-precision arithmetic would need to replace the integer arithmetic in that case. This program will abort if an overflow occurs. The big_t type identifies where the counting takes place. The uintmax_t type is also used for calculating the number of possible codes remaining at the maximum length. This limits the maximum code length to the number of bits in a long long minus the number of bits needed to represent the symbols in a flat code. The code_t type identifies where the bit-pattern counting takes place. */ #include #include #include #include #include #include #define local static // Special data types. typedef uintmax_t big_t; // type for code counting #define PRIbig "ju" // printf format for big_t typedef uintmax_t code_t; // type for bit pattern counting struct tab { // type for been-here check size_t len; // allocated length of bit vector in octets char *vec; // allocated bit vector }; /* The array for saving results, num[], is indexed with this triplet: syms: number of symbols remaining to code left: number of available bit patterns at length len len: number of bits in the codes currently being assigned Those indices are constrained thusly when saving results: syms: 3..totsym (totsym == total symbols to code) left: 2..syms - 1, but only the evens (so syms == 8 -> 2, 4, 6) len: 1..max - 1 (max == maximum code length in bits) syms == 2 is not saved since that immediately leads to a single code. left must be even, since it represents the number of available bit patterns at the current length, which is double the number at the previous length. left ends at syms-1 since left == syms immediately results in a single code. (left > sym is not allowed since that would result in an incomplete code.) len is less than max, since the code completes immediately when len == max. The offset into the array is calculated for the three indices with the first one (syms) being outermost, and the last one (len) being innermost. We build the array with length max-1 lists for the len index, with syms-3 of those for each symbol. There are totsym-2 of those, with each one varying in length as a function of sym. See the calculation of index in map() for the index, and the calculation of size in main() for the size of the array. For the deflate example of 286 symbols limited to 15-bit codes, the array has 284,284 entries, taking up 2.17 MB for an 8-byte big_t. More than half of the space allocated for saved results is actually used -- not all possible triplets are reached in the generation of valid prefix codes. */ /* The array for tracking visited states, done[], is itself indexed identically to the num[] array as described above for the (syms, left, len) triplet. Each element in the array is further indexed by the (mem, rem) doublet, where mem is the amount of inflate table space used so far, and rem is the remaining unused entries in the current inflate sub-table. Each indexed element is simply one bit indicating whether the state has been visited or not. Since the ranges for mem and rem are not known a priori, each bit vector is of a variable size, and grows as needed to accommodate the visited states. mem and rem are used to calculate a single index in a triangular array. Since the range of mem is expected in the default case to be about ten times larger than the range of rem, the array is skewed to reduce the memory usage, with eight times the range for mem than for rem. See the calculations for offset and bit in been_here() for the details. For the deflate example of 286 symbols limited to 15-bit codes, the bit vectors grow to total 5.5 MB, in addition to the 4.3 MB done array itself. */ // Type for a variable-length, allocated string. typedef struct { char *str; // pointer to allocated string size_t size; // size of allocation size_t len; // length of string, not including terminating zero } string_t; // Clear a string_t. local void string_clear(string_t *s) { s->str[0] = 0; s->len = 0; } // Initialize a string_t. local void string_init(string_t *s) { s->size = 16; s->str = malloc(s->size); assert(s->str != NULL && "out of memory"); string_clear(s); } // Release the allocation of a string_t. local void string_free(string_t *s) { free(s->str); s->str = NULL; s->size = 0; s->len = 0; } // Save the results of printf with fmt and the subsequent argument list to s. // Each call appends to s. The allocated space for s is increased as needed. local void string_printf(string_t *s, char *fmt, ...) { va_list ap; va_start(ap, fmt); size_t len = s->len; int ret = vsnprintf(s->str + len, s->size - len, fmt, ap); assert(ret >= 0 && "out of memory"); s->len += ret; if (s->size < s->len + 1) { do { s->size <<= 1; assert(s->size != 0 && "overflow"); } while (s->size < s->len + 1); s->str = realloc(s->str, s->size); assert(s->str != NULL && "out of memory"); vsnprintf(s->str + len, s->size - len, fmt, ap); } va_end(ap); } // Globals to avoid propagating constants or constant pointers recursively. struct { int max; // maximum allowed bit length for the codes int root; // size of base code table in bits int large; // largest code table so far size_t size; // number of elements in num and done big_t tot; // total number of codes with maximum tables size string_t out; // display of subcodes for maximum tables size int *code; // number of symbols assigned to each bit length big_t *num; // saved results array for code counting struct tab *done; // states already evaluated array } g; // Index function for num[] and done[]. local inline size_t map(int syms, int left, int len) { return ((size_t)((syms - 1) >> 1) * ((syms - 2) >> 1) + (left >> 1) - 1) * (g.max - 1) + len - 1; } // Free allocated space in globals. local void cleanup(void) { if (g.done != NULL) { for (size_t n = 0; n < g.size; n++) if (g.done[n].len) free(g.done[n].vec); g.size = 0; free(g.done); g.done = NULL; } free(g.num); g.num = NULL; free(g.code); g.code = NULL; string_free(&g.out); } // Return the number of possible prefix codes using bit patterns of lengths len // through max inclusive, coding syms symbols, with left bit patterns of length // len unused -- return -1 if there is an overflow in the counting. Keep a // record of previous results in num to prevent repeating the same calculation. local big_t count(int syms, int left, int len) { // see if only one possible code if (syms == left) return 1; // note and verify the expected state assert(syms > left && left > 0 && len < g.max); // see if we've done this one already size_t index = map(syms, left, len); big_t got = g.num[index]; if (got) return got; // we have -- return the saved result // we need to use at least this many bit patterns so that the code won't be // incomplete at the next length (more bit patterns than symbols) int least = (left << 1) - syms; if (least < 0) least = 0; // we can use at most this many bit patterns, lest there not be enough // available for the remaining symbols at the maximum length (if there were // no limit to the code length, this would become: most = left - 1) int most = (((code_t)left << (g.max - len)) - syms) / (((code_t)1 << (g.max - len)) - 1); // count all possible codes from this juncture and add them up big_t sum = 0; for (int use = least; use <= most; use++) { got = count(syms - use, (left - use) << 1, len + 1); sum += got; if (got == (big_t)-1 || sum < got) // overflow return (big_t)-1; } // verify that all recursive calls are productive assert(sum != 0); // save the result and return it g.num[index] = sum; return sum; } // Return true if we've been here before, set to true if not. Set a bit in a // bit vector to indicate visiting this state. Each (syms,len,left) state has a // variable size bit vector indexed by (mem,rem). The bit vector is lengthened // as needed to allow setting the (mem,rem) bit. local int been_here(int syms, int left, int len, int mem, int rem) { // point to vector for (syms,left,len), bit in vector for (mem,rem) size_t index = map(syms, left, len); mem -= 1 << g.root; // mem always includes the root table mem >>= 1; // mem and rem are always even rem >>= 1; size_t offset = (mem >> 3) + rem; offset = ((offset * (offset + 1)) >> 1) + rem; int bit = 1 << (mem & 7); // see if we've been here size_t length = g.done[index].len; if (offset < length && (g.done[index].vec[offset] & bit) != 0) return 1; // done this! // we haven't been here before -- set the bit to show we have now // see if we need to lengthen the vector in order to set the bit if (length <= offset) { // if we have one already, enlarge it, zero out the appended space char *vector; if (length) { do { length <<= 1; } while (length <= offset); vector = realloc(g.done[index].vec, length); assert(vector != NULL && "out of memory"); memset(vector + g.done[index].len, 0, length - g.done[index].len); } // otherwise we need to make a new vector and zero it out else { length = 16; while (length <= offset) length <<= 1; vector = calloc(length, 1); assert(vector != NULL && "out of memory"); } // install the new vector g.done[index].len = length; g.done[index].vec = vector; } // set the bit g.done[index].vec[offset] |= bit; return 0; } // Examine all possible codes from the given node (syms, len, left). Compute // the amount of memory required to build inflate's decoding tables, where the // number of code structures used so far is mem, and the number remaining in // the current sub-table is rem. local void examine(int syms, int left, int len, int mem, int rem) { // see if we have a complete code if (syms == left) { // set the last code entry g.code[len] = left; // complete computation of memory used by this code while (rem < left) { left -= rem; rem = 1 << (len - g.root); mem += rem; } assert(rem == left); // if this is at the maximum, show the sub-code if (mem >= g.large) { // if this is a new maximum, update the maximum and clear out the // printed sub-codes from the previous maximum if (mem > g.large) { g.large = mem; string_clear(&g.out); } // compute the starting state for this sub-code syms = 0; left = 1 << g.max; for (int bits = g.max; bits > g.root; bits--) { syms += g.code[bits]; left -= g.code[bits]; assert((left & 1) == 0); left >>= 1; } // print the starting state and the resulting sub-code to g.out string_printf(&g.out, "<%u, %u, %u>:", syms, g.root + 1, ((1 << g.root) - left) << 1); for (int bits = g.root + 1; bits <= g.max; bits++) if (g.code[bits]) string_printf(&g.out, " %d[%d]", g.code[bits], bits); string_printf(&g.out, "\n"); } // remove entries as we drop back down in the recursion g.code[len] = 0; return; } // prune the tree if we can if (been_here(syms, left, len, mem, rem)) return; // we need to use at least this many bit patterns so that the code won't be // incomplete at the next length (more bit patterns than symbols) int least = (left << 1) - syms; if (least < 0) least = 0; // we can use at most this many bit patterns, lest there not be enough // available for the remaining symbols at the maximum length (if there were // no limit to the code length, this would become: most = left - 1) int most = (((code_t)left << (g.max - len)) - syms) / (((code_t)1 << (g.max - len)) - 1); // occupy least table spaces, creating new sub-tables as needed int use = least; while (rem < use) { use -= rem; rem = 1 << (len - g.root); mem += rem; } rem -= use; // examine codes from here, updating table space as we go for (use = least; use <= most; use++) { g.code[len] = use; examine(syms - use, (left - use) << 1, len + 1, mem + (rem ? 1 << (len - g.root) : 0), rem << 1); if (rem == 0) { rem = 1 << (len - g.root); mem += rem; } rem--; } // remove entries as we drop back down in the recursion g.code[len] = 0; } // Look at all sub-codes starting with root + 1 bits. Look at only the valid // intermediate code states (syms, left, len). For each completed code, // calculate the amount of memory required by inflate to build the decoding // tables. Find the maximum amount of memory required and show the codes that // require that maximum. local void enough(int syms) { // clear code for (int n = 0; n <= g.max; n++) g.code[n] = 0; // look at all (root + 1) bit and longer codes string_clear(&g.out); // empty saved results g.large = 1 << g.root; // base table if (g.root < g.max) // otherwise, there's only a base table for (int n = 3; n <= syms; n++) for (int left = 2; left < n; left += 2) { // look at all reachable (root + 1) bit nodes, and the // resulting codes (complete at root + 2 or more) size_t index = map(n, left, g.root + 1); if (g.root + 1 < g.max && g.num[index]) // reachable node examine(n, left, g.root + 1, 1 << g.root, 0); // also look at root bit codes with completions at root + 1 // bits (not saved in num, since complete), just in case if (g.num[index - 1] && n <= left << 1) examine((n - left) << 1, (n - left) << 1, g.root + 1, 1 << g.root, 0); } // done printf("maximum of %d table entries for root = %d\n", g.large, g.root); fputs(g.out.str, stdout); } // Examine and show the total number of possible prefix codes for a given // maximum number of symbols, initial root table size, and maximum code length // in bits -- those are the command arguments in that order. The default values // are 286, 9, and 15 respectively, for the deflate literal/length code. The // possible codes are counted for each number of coded symbols from two to the // maximum. The counts for each of those and the total number of codes are // shown. The maximum number of inflate table entries is then calculated across // all possible codes. Each new maximum number of table entries and the // associated sub-code (starting at root + 1 == 10 bits) is shown. // // To count and examine prefix codes that are not length-limited, provide a // maximum length equal to the number of symbols minus one. // // For the deflate literal/length code, use "enough". For the deflate distance // code, use "enough 30 6". int main(int argc, char **argv) { // set up globals for cleanup() g.code = NULL; g.num = NULL; g.done = NULL; string_init(&g.out); // get arguments -- default to the deflate literal/length code int syms = 286; g.root = 9; g.max = 15; if (argc > 1) { syms = atoi(argv[1]); if (argc > 2) { g.root = atoi(argv[2]); if (argc > 3) g.max = atoi(argv[3]); } } if (argc > 4 || syms < 2 || g.root < 1 || g.max < 1) { fputs("invalid arguments, need: [sym >= 2 [root >= 1 [max >= 1]]]\n", stderr); return 1; } // if not restricting the code length, the longest is syms - 1 if (g.max > syms - 1) g.max = syms - 1; // determine the number of bits in a code_t int bits = 0; for (code_t word = 1; word; word <<= 1) bits++; // make sure that the calculation of most will not overflow if (g.max > bits || (code_t)(syms - 2) >= ((code_t)-1 >> (g.max - 1))) { fputs("abort: code length too long for internal types\n", stderr); return 1; } // reject impossible code requests if ((code_t)(syms - 1) > ((code_t)1 << g.max) - 1) { fprintf(stderr, "%d symbols cannot be coded in %d bits\n", syms, g.max); return 1; } // allocate code vector g.code = calloc(g.max + 1, sizeof(int)); assert(g.code != NULL && "out of memory"); // determine size of saved results array, checking for overflows, // allocate and clear the array (set all to zero with calloc()) if (syms == 2) // iff max == 1 g.num = NULL; // won't be saving any results else { g.size = syms >> 1; int n = (syms - 1) >> 1; assert(g.size <= (size_t)-1 / n && "overflow"); g.size *= n; n = g.max - 1; assert(g.size <= (size_t)-1 / n && "overflow"); g.size *= n; g.num = calloc(g.size, sizeof(big_t)); assert(g.num != NULL && "out of memory"); } // count possible codes for all numbers of symbols, add up counts big_t sum = 0; for (int n = 2; n <= syms; n++) { big_t got = count(n, 2, 1); sum += got; assert(got != (big_t)-1 && sum >= got && "overflow"); } printf("%"PRIbig" total codes for 2 to %d symbols", sum, syms); if (g.max < syms - 1) printf(" (%d-bit length limit)\n", g.max); else puts(" (no length limit)"); // allocate and clear done array for been_here() if (syms == 2) g.done = NULL; else { g.done = calloc(g.size, sizeof(struct tab)); assert(g.done != NULL && "out of memory"); } // find and show maximum inflate table usage if (g.root > g.max) // reduce root to max length g.root = g.max; if ((code_t)syms < ((code_t)1 << (g.root + 1))) enough(syms); else fputs("cannot handle minimum code lengths > root", stderr); // done cleanup(); return 0; } tcl8.6.14/compat/zlib/examples/gzlog.c0000644000175000017500000012110114560736523017173 0ustar sergeisergei/* * gzlog.c * Copyright (C) 2004, 2008, 2012, 2016, 2019 Mark Adler, all rights reserved * For conditions of distribution and use, see copyright notice in gzlog.h * version 2.3, 25 May 2019 */ /* gzlog provides a mechanism for frequently appending short strings to a gzip file that is efficient both in execution time and compression ratio. The strategy is to write the short strings in an uncompressed form to the end of the gzip file, only compressing when the amount of uncompressed data has reached a given threshold. gzlog also provides protection against interruptions in the process due to system crashes. The status of the operation is recorded in an extra field in the gzip file, and is only updated once the gzip file is brought to a valid state. The last data to be appended or compressed is saved in an auxiliary file, so that if the operation is interrupted, it can be completed the next time an append operation is attempted. gzlog maintains another auxiliary file with the last 32K of data from the compressed portion, which is preloaded for the compression of the subsequent data. This minimizes the impact to the compression ratio of appending. */ /* Operations Concept: Files (log name "foo"): foo.gz -- gzip file with the complete log foo.add -- last message to append or last data to compress foo.dict -- dictionary of the last 32K of data for next compression foo.temp -- temporary dictionary file for compression after this one foo.lock -- lock file for reading and writing the other files foo.repairs -- log file for log file recovery operations (not compressed) gzip file structure: - fixed-length (no file name) header with extra field (see below) - compressed data ending initially with empty stored block - uncompressed data filling out originally empty stored block and subsequent stored blocks as needed (16K max each) - gzip trailer - no junk at end (no other gzip streams) When appending data, the information in the first three items above plus the foo.add file are sufficient to recover an interrupted append operation. The extra field has the necessary information to restore the start of the last stored block and determine where to append the data in the foo.add file, as well as the crc and length of the gzip data before the append operation. The foo.add file is created before the gzip file is marked for append, and deleted after the gzip file is marked as complete. So if the append operation is interrupted, the data to add will still be there. If due to some external force, the foo.add file gets deleted between when the append operation was interrupted and when recovery is attempted, the gzip file will still be restored, but without the appended data. When compressing data, the information in the first two items above plus the foo.add file are sufficient to recover an interrupted compress operation. The extra field has the necessary information to find the end of the compressed data, and contains both the crc and length of just the compressed data and of the complete set of data including the contents of the foo.add file. Again, the foo.add file is maintained during the compress operation in case of an interruption. If in the unlikely event the foo.add file with the data to be compressed is missing due to some external force, a gzip file with just the previous compressed data will be reconstructed. In this case, all of the data that was to be compressed is lost (approximately one megabyte). This will not occur if all that happened was an interruption of the compress operation. The third state that is marked is the replacement of the old dictionary with the new dictionary after a compress operation. Once compression is complete, the gzip file is marked as being in the replace state. This completes the gzip file, so an interrupt after being so marked does not result in recompression. Then the dictionary file is replaced, and the gzip file is marked as completed. This state prevents the possibility of restarting compression with the wrong dictionary file. All three operations are wrapped by a lock/unlock procedure. In order to gain exclusive access to the log files, first a foo.lock file must be exclusively created. When all operations are complete, the lock is released by deleting the foo.lock file. If when attempting to create the lock file, it already exists and the modify time of the lock file is more than five minutes old (set by the PATIENCE define below), then the old lock file is considered stale and deleted, and the exclusive creation of the lock file is retried. To assure that there are no false assessments of the staleness of the lock file, the operations periodically touch the lock file to update the modified date. Following is the definition of the extra field with all of the information required to enable the above append and compress operations and their recovery if interrupted. Multi-byte values are stored little endian (consistent with the gzip format). File pointers are eight bytes long. The crc's and lengths for the gzip trailer are four bytes long. (Note that the length at the end of a gzip file is used for error checking only, and for large files is actually the length modulo 2^32.) The stored block length is two bytes long. The gzip extra field two-byte identification is "ap" for append. It is assumed that writing the extra field to the file is an "atomic" operation. That is, either all of the extra field is written to the file, or none of it is, if the operation is interrupted right at the point of updating the extra field. This is a reasonable assumption, since the extra field is within the first 52 bytes of the file, which is smaller than any expected block size for a mass storage device (usually 512 bytes or larger). Extra field (35 bytes): - Pointer to first stored block length -- this points to the two-byte length of the first stored block, which is followed by the two-byte, one's complement of that length. The stored block length is preceded by the three-bit header of the stored block, which is the actual start of the stored block in the deflate format. See the bit offset field below. - Pointer to the last stored block length. This is the same as above, but for the last stored block of the uncompressed data in the gzip file. Initially this is the same as the first stored block length pointer. When the stored block gets to 16K (see the MAX_STORE define), then a new stored block as added, at which point the last stored block length pointer is different from the first stored block length pointer. When they are different, the first bit of the last stored block header is eight bits, or one byte back from the block length. - Compressed data crc and length. This is the crc and length of the data that is in the compressed portion of the deflate stream. These are used only in the event that the foo.add file containing the data to compress is lost after a compress operation is interrupted. - Total data crc and length. This is the crc and length of all of the data stored in the gzip file, compressed and uncompressed. It is used to reconstruct the gzip trailer when compressing, as well as when recovering interrupted operations. - Final stored block length. This is used to quickly find where to append, and allows the restoration of the original final stored block state when an append operation is interrupted. - First stored block start as the number of bits back from the final stored block first length byte. This value is in the range of 3..10, and is stored as the low three bits of the final byte of the extra field after subtracting three (0..7). This allows the last-block bit of the stored block header to be updated when a new stored block is added, for the case when the first stored block and the last stored block are the same. (When they are different, the numbers of bits back is known to be eight.) This also allows for new compressed data to be appended to the old compressed data in the compress operation, overwriting the previous first stored block, or for the compressed data to be terminated and a valid gzip file reconstructed on the off chance that a compression operation was interrupted and the data to compress in the foo.add file was deleted. - The operation in process. This is the next two bits in the last byte (the bits under the mask 0x18). The are interpreted as 0: nothing in process, 1: append in process, 2: compress in process, 3: replace in process. - The top three bits of the last byte in the extra field are reserved and are currently set to zero. Main procedure: - Exclusively create the foo.lock file using the O_CREAT and O_EXCL modes of the system open() call. If the modify time of an existing lock file is more than PATIENCE seconds old, then the lock file is deleted and the exclusive create is retried. - Load the extra field from the foo.gz file, and see if an operation was in progress but not completed. If so, apply the recovery procedure below. - Perform the append procedure with the provided data. - If the uncompressed data in the foo.gz file is 1MB or more, apply the compress procedure. - Delete the foo.lock file. Append procedure: - Put what to append in the foo.add file so that the operation can be restarted if this procedure is interrupted. - Mark the foo.gz extra field with the append operation in progress. + Restore the original last-block bit and stored block length of the last stored block from the information in the extra field, in case a previous append operation was interrupted. - Append the provided data to the last stored block, creating new stored blocks as needed and updating the stored blocks last-block bits and lengths. - Update the crc and length with the new data, and write the gzip trailer. - Write over the extra field (with a single write operation) with the new pointers, lengths, and crc's, and mark the gzip file as not in process. Though there is still a foo.add file, it will be ignored since nothing is in process. If a foo.add file is leftover from a previously completed operation, it is truncated when writing new data to it. - Delete the foo.add file. Compress and replace procedures: - Read all of the uncompressed data in the stored blocks in foo.gz and write it to foo.add. Also write foo.temp with the last 32K of that data to provide a dictionary for the next invocation of this procedure. - Rewrite the extra field marking foo.gz with a compression in process. * If there is no data provided to compress (due to a missing foo.add file when recovering), reconstruct and truncate the foo.gz file to contain only the previous compressed data and proceed to the step after the next one. Otherwise ... - Compress the data with the dictionary in foo.dict, and write to the foo.gz file starting at the bit immediately following the last previously compressed block. If there is no foo.dict, proceed anyway with the compression at slightly reduced efficiency. (For the foo.dict file to be missing requires some external failure beyond simply the interruption of a compress operation.) During this process, the foo.lock file is periodically touched to assure that that file is not considered stale by another process before we're done. The deflation is terminated with a non-last empty static block (10 bits long), that is then located and written over by a last-bit-set empty stored block. - Append the crc and length of the data in the gzip file (previously calculated during the append operations). - Write over the extra field with the updated stored block offsets, bits back, crc's, and lengths, and mark foo.gz as in process for a replacement of the dictionary. @ Delete the foo.add file. - Replace foo.dict with foo.temp. - Write over the extra field, marking foo.gz as complete. Recovery procedure: - If not a replace recovery, read in the foo.add file, and provide that data to the appropriate recovery below. If there is no foo.add file, provide a zero data length to the recovery. In that case, the append recovery restores the foo.gz to the previous compressed + uncompressed data state. For the compress recovery, a missing foo.add file results in foo.gz being restored to the previous compressed-only data state. - Append recovery: - Pick up append at + step above - Compress recovery: - Pick up compress at * step above - Replace recovery: - Pick up compress at @ step above - Log the repair with a date stamp in foo.repairs */ #include #include /* rename, fopen, fprintf, fclose */ #include /* malloc, free */ #include /* strlen, strrchr, strcpy, strncpy, strcmp */ #include /* open */ #include /* lseek, read, write, close, unlink, sleep, */ /* ftruncate, fsync */ #include /* errno */ #include /* time, ctime */ #include /* stat */ #include /* utimes */ #include "zlib.h" /* crc32 */ #include "gzlog.h" /* header for external access */ #define local static typedef unsigned int uint; typedef unsigned long ulong; /* Macro for debugging to deterministically force recovery operations */ #ifdef GZLOG_DEBUG #include /* longjmp */ jmp_buf gzlog_jump; /* where to go back to */ int gzlog_bail = 0; /* which point to bail at (1..8) */ int gzlog_count = -1; /* number of times through to wait */ # define BAIL(n) do { if (n == gzlog_bail && gzlog_count-- == 0) \ longjmp(gzlog_jump, gzlog_bail); } while (0) #else # define BAIL(n) #endif /* how old the lock file can be in seconds before considering it stale */ #define PATIENCE 300 /* maximum stored block size in Kbytes -- must be in 1..63 */ #define MAX_STORE 16 /* number of stored Kbytes to trigger compression (must be >= 32 to allow dictionary construction, and <= 204 * MAX_STORE, in order for >> 10 to discard the stored block headers contribution of five bytes each) */ #define TRIGGER 1024 /* size of a deflate dictionary (this cannot be changed) */ #define DICT 32768U /* values for the operation (2 bits) */ #define NO_OP 0 #define APPEND_OP 1 #define COMPRESS_OP 2 #define REPLACE_OP 3 /* macros to extract little-endian integers from an unsigned byte buffer */ #define PULL2(p) ((p)[0]+((uint)((p)[1])<<8)) #define PULL4(p) (PULL2(p)+((ulong)PULL2(p+2)<<16)) #define PULL8(p) (PULL4(p)+((off_t)PULL4(p+4)<<32)) /* macros to store integers into a byte buffer in little-endian order */ #define PUT2(p,a) do {(p)[0]=a;(p)[1]=(a)>>8;} while(0) #define PUT4(p,a) do {PUT2(p,a);PUT2(p+2,a>>16);} while(0) #define PUT8(p,a) do {PUT4(p,a);PUT4(p+4,a>>32);} while(0) /* internal structure for log information */ #define LOGID "\106\035\172" /* should be three non-zero characters */ struct log { char id[4]; /* contains LOGID to detect inadvertent overwrites */ int fd; /* file descriptor for .gz file, opened read/write */ char *path; /* allocated path, e.g. "/var/log/foo" or "foo" */ char *end; /* end of path, for appending suffices such as ".gz" */ off_t first; /* offset of first stored block first length byte */ int back; /* location of first block id in bits back from first */ uint stored; /* bytes currently in last stored block */ off_t last; /* offset of last stored block first length byte */ ulong ccrc; /* crc of compressed data */ ulong clen; /* length (modulo 2^32) of compressed data */ ulong tcrc; /* crc of total data */ ulong tlen; /* length (modulo 2^32) of total data */ time_t lock; /* last modify time of our lock file */ }; /* gzip header for gzlog */ local unsigned char log_gzhead[] = { 0x1f, 0x8b, /* magic gzip id */ 8, /* compression method is deflate */ 4, /* there is an extra field (no file name) */ 0, 0, 0, 0, /* no modification time provided */ 0, 0xff, /* no extra flags, no OS specified */ 39, 0, 'a', 'p', 35, 0 /* extra field with "ap" subfield */ /* 35 is EXTRA, 39 is EXTRA + 4 */ }; #define HEAD sizeof(log_gzhead) /* should be 16 */ /* initial gzip extra field content (52 == HEAD + EXTRA + 1) */ local unsigned char log_gzext[] = { 52, 0, 0, 0, 0, 0, 0, 0, /* offset of first stored block length */ 52, 0, 0, 0, 0, 0, 0, 0, /* offset of last stored block length */ 0, 0, 0, 0, 0, 0, 0, 0, /* compressed data crc and length */ 0, 0, 0, 0, 0, 0, 0, 0, /* total data crc and length */ 0, 0, /* final stored block data length */ 5 /* op is NO_OP, last bit 8 bits back */ }; #define EXTRA sizeof(log_gzext) /* should be 35 */ /* initial gzip data and trailer */ local unsigned char log_gzbody[] = { 1, 0, 0, 0xff, 0xff, /* empty stored block (last) */ 0, 0, 0, 0, /* crc */ 0, 0, 0, 0 /* uncompressed length */ }; #define BODY sizeof(log_gzbody) /* Exclusively create foo.lock in order to negotiate exclusive access to the foo.* files. If the modify time of an existing lock file is greater than PATIENCE seconds in the past, then consider the lock file to have been abandoned, delete it, and try the exclusive create again. Save the lock file modify time for verification of ownership. Return 0 on success, or -1 on failure, usually due to an access restriction or invalid path. Note that if stat() or unlink() fails, it may be due to another process noticing the abandoned lock file a smidge sooner and deleting it, so those are not flagged as an error. */ local int log_lock(struct log *log) { int fd; struct stat st; strcpy(log->end, ".lock"); while ((fd = open(log->path, O_CREAT | O_EXCL, 0644)) < 0) { if (errno != EEXIST) return -1; if (stat(log->path, &st) == 0 && time(NULL) - st.st_mtime > PATIENCE) { unlink(log->path); continue; } sleep(2); /* relinquish the CPU for two seconds while waiting */ } close(fd); if (stat(log->path, &st) == 0) log->lock = st.st_mtime; return 0; } /* Update the modify time of the lock file to now, in order to prevent another task from thinking that the lock is stale. Save the lock file modify time for verification of ownership. */ local void log_touch(struct log *log) { struct stat st; strcpy(log->end, ".lock"); utimes(log->path, NULL); if (stat(log->path, &st) == 0) log->lock = st.st_mtime; } /* Check the log file modify time against what is expected. Return true if this is not our lock. If it is our lock, touch it to keep it. */ local int log_check(struct log *log) { struct stat st; strcpy(log->end, ".lock"); if (stat(log->path, &st) || st.st_mtime != log->lock) return 1; log_touch(log); return 0; } /* Unlock a previously acquired lock, but only if it's ours. */ local void log_unlock(struct log *log) { if (log_check(log)) return; strcpy(log->end, ".lock"); unlink(log->path); log->lock = 0; } /* Check the gzip header and read in the extra field, filling in the values in the log structure. Return op on success or -1 if the gzip header was not as expected. op is the current operation in progress last written to the extra field. This assumes that the gzip file has already been opened, with the file descriptor log->fd. */ local int log_head(struct log *log) { int op; unsigned char buf[HEAD + EXTRA]; if (lseek(log->fd, 0, SEEK_SET) < 0 || read(log->fd, buf, HEAD + EXTRA) != HEAD + EXTRA || memcmp(buf, log_gzhead, HEAD)) { return -1; } log->first = PULL8(buf + HEAD); log->last = PULL8(buf + HEAD + 8); log->ccrc = PULL4(buf + HEAD + 16); log->clen = PULL4(buf + HEAD + 20); log->tcrc = PULL4(buf + HEAD + 24); log->tlen = PULL4(buf + HEAD + 28); log->stored = PULL2(buf + HEAD + 32); log->back = 3 + (buf[HEAD + 34] & 7); op = (buf[HEAD + 34] >> 3) & 3; return op; } /* Write over the extra field contents, marking the operation as op. Use fsync to assure that the device is written to, and in the requested order. This operation, and only this operation, is assumed to be atomic in order to assure that the log is recoverable in the event of an interruption at any point in the process. Return -1 if the write to foo.gz failed. */ local int log_mark(struct log *log, int op) { int ret; unsigned char ext[EXTRA]; PUT8(ext, log->first); PUT8(ext + 8, log->last); PUT4(ext + 16, log->ccrc); PUT4(ext + 20, log->clen); PUT4(ext + 24, log->tcrc); PUT4(ext + 28, log->tlen); PUT2(ext + 32, log->stored); ext[34] = log->back - 3 + (op << 3); fsync(log->fd); ret = lseek(log->fd, HEAD, SEEK_SET) < 0 || write(log->fd, ext, EXTRA) != EXTRA ? -1 : 0; fsync(log->fd); return ret; } /* Rewrite the last block header bits and subsequent zero bits to get to a byte boundary, setting the last block bit if last is true, and then write the remainder of the stored block header (length and one's complement). Leave the file pointer after the end of the last stored block data. Return -1 if there is a read or write failure on the foo.gz file */ local int log_last(struct log *log, int last) { int back, len, mask; unsigned char buf[6]; /* determine the locations of the bytes and bits to modify */ back = log->last == log->first ? log->back : 8; len = back > 8 ? 2 : 1; /* bytes back from log->last */ mask = 0x80 >> ((back - 1) & 7); /* mask for block last-bit */ /* get the byte to modify (one or two back) into buf[0] -- don't need to read the byte if the last-bit is eight bits back, since in that case the entire byte will be modified */ buf[0] = 0; if (back != 8 && (lseek(log->fd, log->last - len, SEEK_SET) < 0 || read(log->fd, buf, 1) != 1)) return -1; /* change the last-bit of the last stored block as requested -- note that all bits above the last-bit are set to zero, per the type bits of a stored block being 00 and per the convention that the bits to bring the stream to a byte boundary are also zeros */ buf[1] = 0; buf[2 - len] = (*buf & (mask - 1)) + (last ? mask : 0); /* write the modified stored block header and lengths, move the file pointer to after the last stored block data */ PUT2(buf + 2, log->stored); PUT2(buf + 4, log->stored ^ 0xffff); return lseek(log->fd, log->last - len, SEEK_SET) < 0 || write(log->fd, buf + 2 - len, len + 4) != len + 4 || lseek(log->fd, log->stored, SEEK_CUR) < 0 ? -1 : 0; } /* Append len bytes from data to the locked and open log file. len may be zero if recovering and no .add file was found. In that case, the previous state of the foo.gz file is restored. The data is appended uncompressed in deflate stored blocks. Return -1 if there was an error reading or writing the foo.gz file. */ local int log_append(struct log *log, unsigned char *data, size_t len) { uint put; off_t end; unsigned char buf[8]; /* set the last block last-bit and length, in case recovering an interrupted append, then position the file pointer to append to the block */ if (log_last(log, 1)) return -1; /* append, adding stored blocks and updating the offset of the last stored block as needed, and update the total crc and length */ while (len) { /* append as much as we can to the last block */ put = (MAX_STORE << 10) - log->stored; if (put > len) put = (uint)len; if (put) { if (write(log->fd, data, put) != put) return -1; BAIL(1); log->tcrc = crc32(log->tcrc, data, put); log->tlen += put; log->stored += put; data += put; len -= put; } /* if we need to, add a new empty stored block */ if (len) { /* mark current block as not last */ if (log_last(log, 0)) return -1; /* point to new, empty stored block */ log->last += 4 + log->stored + 1; log->stored = 0; } /* mark last block as last, update its length */ if (log_last(log, 1)) return -1; BAIL(2); } /* write the new crc and length trailer, and truncate just in case (could be recovering from partial append with a missing foo.add file) */ PUT4(buf, log->tcrc); PUT4(buf + 4, log->tlen); if (write(log->fd, buf, 8) != 8 || (end = lseek(log->fd, 0, SEEK_CUR)) < 0 || ftruncate(log->fd, end)) return -1; /* write the extra field, marking the log file as done, delete .add file */ if (log_mark(log, NO_OP)) return -1; strcpy(log->end, ".add"); unlink(log->path); /* ignore error, since may not exist */ return 0; } /* Replace the foo.dict file with the foo.temp file. Also delete the foo.add file, since the compress operation may have been interrupted before that was done. Returns 1 if memory could not be allocated, or -1 if reading or writing foo.gz fails, or if the rename fails for some reason other than foo.temp not existing. foo.temp not existing is a permitted error, since the replace operation may have been interrupted after the rename is done, but before foo.gz is marked as complete. */ local int log_replace(struct log *log) { int ret; char *dest; /* delete foo.add file */ strcpy(log->end, ".add"); unlink(log->path); /* ignore error, since may not exist */ BAIL(3); /* rename foo.name to foo.dict, replacing foo.dict if it exists */ strcpy(log->end, ".dict"); dest = malloc(strlen(log->path) + 1); if (dest == NULL) return -2; strcpy(dest, log->path); strcpy(log->end, ".temp"); ret = rename(log->path, dest); free(dest); if (ret && errno != ENOENT) return -1; BAIL(4); /* mark the foo.gz file as done */ return log_mark(log, NO_OP); } /* Compress the len bytes at data and append the compressed data to the foo.gz deflate data immediately after the previous compressed data. This overwrites the previous uncompressed data, which was stored in foo.add and is the data provided in data[0..len-1]. If this operation is interrupted, it picks up at the start of this routine, with the foo.add file read in again. If there is no data to compress (len == 0), then we simply terminate the foo.gz file after the previously compressed data, appending a final empty stored block and the gzip trailer. Return -1 if reading or writing the log.gz file failed, or -2 if there was a memory allocation failure. */ local int log_compress(struct log *log, unsigned char *data, size_t len) { int fd; uint got, max; ssize_t dict; off_t end; z_stream strm; unsigned char buf[DICT]; /* compress and append compressed data */ if (len) { /* set up for deflate, allocating memory */ strm.zalloc = Z_NULL; strm.zfree = Z_NULL; strm.opaque = Z_NULL; if (deflateInit2(&strm, Z_DEFAULT_COMPRESSION, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) != Z_OK) return -2; /* read in dictionary (last 32K of data that was compressed) */ strcpy(log->end, ".dict"); fd = open(log->path, O_RDONLY, 0); if (fd >= 0) { dict = read(fd, buf, DICT); close(fd); if (dict < 0) { deflateEnd(&strm); return -1; } if (dict) deflateSetDictionary(&strm, buf, (uint)dict); } log_touch(log); /* prime deflate with last bits of previous block, position write pointer to write those bits and overwrite what follows */ if (lseek(log->fd, log->first - (log->back > 8 ? 2 : 1), SEEK_SET) < 0 || read(log->fd, buf, 1) != 1 || lseek(log->fd, -1, SEEK_CUR) < 0) { deflateEnd(&strm); return -1; } deflatePrime(&strm, (8 - log->back) & 7, *buf); /* compress, finishing with a partial non-last empty static block */ strm.next_in = data; max = (((uint)0 - 1) >> 1) + 1; /* in case int smaller than size_t */ do { strm.avail_in = len > max ? max : (uint)len; len -= strm.avail_in; do { strm.avail_out = DICT; strm.next_out = buf; deflate(&strm, len ? Z_NO_FLUSH : Z_PARTIAL_FLUSH); got = DICT - strm.avail_out; if (got && write(log->fd, buf, got) != got) { deflateEnd(&strm); return -1; } log_touch(log); } while (strm.avail_out == 0); } while (len); deflateEnd(&strm); BAIL(5); /* find start of empty static block -- scanning backwards the first one bit is the second bit of the block, if the last byte is zero, then we know the byte before that has a one in the top bit, since an empty static block is ten bits long */ if ((log->first = lseek(log->fd, -1, SEEK_CUR)) < 0 || read(log->fd, buf, 1) != 1) return -1; log->first++; if (*buf) { log->back = 1; while ((*buf & ((uint)1 << (8 - log->back++))) == 0) ; /* guaranteed to terminate, since *buf != 0 */ } else log->back = 10; /* update compressed crc and length */ log->ccrc = log->tcrc; log->clen = log->tlen; } else { /* no data to compress -- fix up existing gzip stream */ log->tcrc = log->ccrc; log->tlen = log->clen; } /* complete and truncate gzip stream */ log->last = log->first; log->stored = 0; PUT4(buf, log->tcrc); PUT4(buf + 4, log->tlen); if (log_last(log, 1) || write(log->fd, buf, 8) != 8 || (end = lseek(log->fd, 0, SEEK_CUR)) < 0 || ftruncate(log->fd, end)) return -1; BAIL(6); /* mark as being in the replace operation */ if (log_mark(log, REPLACE_OP)) return -1; /* execute the replace operation and mark the file as done */ return log_replace(log); } /* log a repair record to the .repairs file */ local void log_log(struct log *log, int op, char *record) { time_t now; FILE *rec; now = time(NULL); strcpy(log->end, ".repairs"); rec = fopen(log->path, "a"); if (rec == NULL) return; fprintf(rec, "%.24s %s recovery: %s\n", ctime(&now), op == APPEND_OP ? "append" : (op == COMPRESS_OP ? "compress" : "replace"), record); fclose(rec); return; } /* Recover the interrupted operation op. First read foo.add for recovering an append or compress operation. Return -1 if there was an error reading or writing foo.gz or reading an existing foo.add, or -2 if there was a memory allocation failure. */ local int log_recover(struct log *log, int op) { int fd, ret = 0; unsigned char *data = NULL; size_t len = 0; struct stat st; /* log recovery */ log_log(log, op, "start"); /* load foo.add file if expected and present */ if (op == APPEND_OP || op == COMPRESS_OP) { strcpy(log->end, ".add"); if (stat(log->path, &st) == 0 && st.st_size) { len = (size_t)(st.st_size); if ((off_t)len != st.st_size || (data = malloc(st.st_size)) == NULL) { log_log(log, op, "allocation failure"); return -2; } if ((fd = open(log->path, O_RDONLY, 0)) < 0) { free(data); log_log(log, op, ".add file read failure"); return -1; } ret = (size_t)read(fd, data, len) != len; close(fd); if (ret) { free(data); log_log(log, op, ".add file read failure"); return -1; } log_log(log, op, "loaded .add file"); } else log_log(log, op, "missing .add file!"); } /* recover the interrupted operation */ switch (op) { case APPEND_OP: ret = log_append(log, data, len); break; case COMPRESS_OP: ret = log_compress(log, data, len); break; case REPLACE_OP: ret = log_replace(log); } /* log status */ log_log(log, op, ret ? "failure" : "complete"); /* clean up */ if (data != NULL) free(data); return ret; } /* Close the foo.gz file (if open) and release the lock. */ local void log_close(struct log *log) { if (log->fd >= 0) close(log->fd); log->fd = -1; log_unlock(log); } /* Open foo.gz, verify the header, and load the extra field contents, after first creating the foo.lock file to gain exclusive access to the foo.* files. If foo.gz does not exist or is empty, then write the initial header, extra, and body content of an empty foo.gz log file. If there is an error creating the lock file due to access restrictions, or an error reading or writing the foo.gz file, or if the foo.gz file is not a proper log file for this object (e.g. not a gzip file or does not contain the expected extra field), then return true. If there is an error, the lock is released. Otherwise, the lock is left in place. */ local int log_open(struct log *log) { int op; /* release open file resource if left over -- can occur if lock lost between gzlog_open() and gzlog_write() */ if (log->fd >= 0) close(log->fd); log->fd = -1; /* negotiate exclusive access */ if (log_lock(log) < 0) return -1; /* open the log file, foo.gz */ strcpy(log->end, ".gz"); log->fd = open(log->path, O_RDWR | O_CREAT, 0644); if (log->fd < 0) { log_close(log); return -1; } /* if new, initialize foo.gz with an empty log, delete old dictionary */ if (lseek(log->fd, 0, SEEK_END) == 0) { if (write(log->fd, log_gzhead, HEAD) != HEAD || write(log->fd, log_gzext, EXTRA) != EXTRA || write(log->fd, log_gzbody, BODY) != BODY) { log_close(log); return -1; } strcpy(log->end, ".dict"); unlink(log->path); } /* verify log file and load extra field information */ if ((op = log_head(log)) < 0) { log_close(log); return -1; } /* check for interrupted process and if so, recover */ if (op != NO_OP && log_recover(log, op)) { log_close(log); return -1; } /* touch the lock file to prevent another process from grabbing it */ log_touch(log); return 0; } /* See gzlog.h for the description of the external methods below */ gzlog *gzlog_open(char *path) { size_t n; struct log *log; /* check arguments */ if (path == NULL || *path == 0) return NULL; /* allocate and initialize log structure */ log = malloc(sizeof(struct log)); if (log == NULL) return NULL; strcpy(log->id, LOGID); log->fd = -1; /* save path and end of path for name construction */ n = strlen(path); log->path = malloc(n + 9); /* allow for ".repairs" */ if (log->path == NULL) { free(log); return NULL; } strcpy(log->path, path); log->end = log->path + n; /* gain exclusive access and verify log file -- may perform a recovery operation if needed */ if (log_open(log)) { free(log->path); free(log); return NULL; } /* return pointer to log structure */ return log; } /* gzlog_compress() return values: 0: all good -1: file i/o error (usually access issue) -2: memory allocation failure -3: invalid log pointer argument */ int gzlog_compress(gzlog *logd) { int fd, ret; uint block; size_t len, next; unsigned char *data, buf[5]; struct log *log = logd; /* check arguments */ if (log == NULL || strcmp(log->id, LOGID)) return -3; /* see if we lost the lock -- if so get it again and reload the extra field information (it probably changed), recover last operation if necessary */ if (log_check(log) && log_open(log)) return -1; /* create space for uncompressed data */ len = ((size_t)(log->last - log->first) & ~(((size_t)1 << 10) - 1)) + log->stored; if ((data = malloc(len)) == NULL) return -2; /* do statement here is just a cheap trick for error handling */ do { /* read in the uncompressed data */ if (lseek(log->fd, log->first - 1, SEEK_SET) < 0) break; next = 0; while (next < len) { if (read(log->fd, buf, 5) != 5) break; block = PULL2(buf + 1); if (next + block > len || read(log->fd, (char *)data + next, block) != block) break; next += block; } if (lseek(log->fd, 0, SEEK_CUR) != log->last + 4 + log->stored) break; log_touch(log); /* write the uncompressed data to the .add file */ strcpy(log->end, ".add"); fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644); if (fd < 0) break; ret = (size_t)write(fd, data, len) != len; if (ret | close(fd)) break; log_touch(log); /* write the dictionary for the next compress to the .temp file */ strcpy(log->end, ".temp"); fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644); if (fd < 0) break; next = DICT > len ? len : DICT; ret = (size_t)write(fd, (char *)data + len - next, next) != next; if (ret | close(fd)) break; log_touch(log); /* roll back to compressed data, mark the compress in progress */ log->last = log->first; log->stored = 0; if (log_mark(log, COMPRESS_OP)) break; BAIL(7); /* compress and append the data (clears mark) */ ret = log_compress(log, data, len); free(data); return ret; } while (0); /* broke out of do above on i/o error */ free(data); return -1; } /* gzlog_write() return values: 0: all good -1: file i/o error (usually access issue) -2: memory allocation failure -3: invalid log pointer argument */ int gzlog_write(gzlog *logd, void *data, size_t len) { int fd, ret; struct log *log = logd; /* check arguments */ if (log == NULL || strcmp(log->id, LOGID)) return -3; if (data == NULL || len <= 0) return 0; /* see if we lost the lock -- if so get it again and reload the extra field information (it probably changed), recover last operation if necessary */ if (log_check(log) && log_open(log)) return -1; /* create and write .add file */ strcpy(log->end, ".add"); fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644); if (fd < 0) return -1; ret = (size_t)write(fd, data, len) != len; if (ret | close(fd)) return -1; log_touch(log); /* mark log file with append in progress */ if (log_mark(log, APPEND_OP)) return -1; BAIL(8); /* append data (clears mark) */ if (log_append(log, data, len)) return -1; /* check to see if it's time to compress -- if not, then done */ if (((log->last - log->first) >> 10) + (log->stored >> 10) < TRIGGER) return 0; /* time to compress */ return gzlog_compress(log); } /* gzlog_close() return values: 0: ok -3: invalid log pointer argument */ int gzlog_close(gzlog *logd) { struct log *log = logd; /* check arguments */ if (log == NULL || strcmp(log->id, LOGID)) return -3; /* close the log file and release the lock */ log_close(log); /* free structure and return */ if (log->path != NULL) free(log->path); strcpy(log->id, "bad"); free(log); return 0; } tcl8.6.14/compat/zlib/examples/gzappend.c0000644000175000017500000004112214554262142017657 0ustar sergeisergei/* gzappend -- command to append to a gzip file Copyright (C) 2003, 2012 Mark Adler, all rights reserved version 1.2, 11 Oct 2012 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. Mark Adler madler@alumni.caltech.edu */ /* * Change history: * * 1.0 19 Oct 2003 - First version * 1.1 4 Nov 2003 - Expand and clarify some comments and notes * - Add version and copyright to help * - Send help to stdout instead of stderr * - Add some preemptive typecasts * - Add L to constants in lseek() calls * - Remove some debugging information in error messages * - Use new data_type definition for zlib 1.2.1 * - Simplify and unify file operations * - Finish off gzip file in gztack() * - Use deflatePrime() instead of adding empty blocks * - Keep gzip file clean on appended file read errors * - Use in-place rotate instead of auxiliary buffer * (Why you ask? Because it was fun to write!) * 1.2 11 Oct 2012 - Fix for proper z_const usage * - Check for input buffer malloc failure */ /* gzappend takes a gzip file and appends to it, compressing files from the command line or data from stdin. The gzip file is written to directly, to avoid copying that file, in case it's large. Note that this results in the unfriendly behavior that if gzappend fails, the gzip file is corrupted. This program was written to illustrate the use of the new Z_BLOCK option of zlib 1.2.x's inflate() function. This option returns from inflate() at each block boundary to facilitate locating and modifying the last block bit at the start of the final deflate block. Also whether using Z_BLOCK or not, another required feature of zlib 1.2.x is that inflate() now provides the number of unused bits in the last input byte used. gzappend will not work with versions of zlib earlier than 1.2.1. gzappend first decompresses the gzip file internally, discarding all but the last 32K of uncompressed data, and noting the location of the last block bit and the number of unused bits in the last byte of the compressed data. The gzip trailer containing the CRC-32 and length of the uncompressed data is verified. This trailer will be later overwritten. Then the last block bit is cleared by seeking back in the file and rewriting the byte that contains it. Seeking forward, the last byte of the compressed data is saved along with the number of unused bits to initialize deflate. A deflate process is initialized, using the last 32K of the uncompressed data from the gzip file to initialize the dictionary. If the total uncompressed data was less than 32K, then all of it is used to initialize the dictionary. The deflate output bit buffer is also initialized with the last bits from the original deflate stream. From here on, the data to append is simply compressed using deflate, and written to the gzip file. When that is complete, the new CRC-32 and uncompressed length are written as the trailer of the gzip file. */ #include #include #include #include #include #include "zlib.h" #define local static #define LGCHUNK 14 #define CHUNK (1U << LGCHUNK) #define DSIZE 32768U /* print an error message and terminate with extreme prejudice */ local void bye(char *msg1, char *msg2) { fprintf(stderr, "gzappend error: %s%s\n", msg1, msg2); exit(1); } /* return the greatest common divisor of a and b using Euclid's algorithm, modified to be fast when one argument much greater than the other, and coded to avoid unnecessary swapping */ local unsigned gcd(unsigned a, unsigned b) { unsigned c; while (a && b) if (a > b) { c = b; while (a - c >= c) c <<= 1; a -= c; } else { c = a; while (b - c >= c) c <<= 1; b -= c; } return a + b; } /* rotate list[0..len-1] left by rot positions, in place */ local void rotate(unsigned char *list, unsigned len, unsigned rot) { unsigned char tmp; unsigned cycles; unsigned char *start, *last, *to, *from; /* normalize rot and handle degenerate cases */ if (len < 2) return; if (rot >= len) rot %= len; if (rot == 0) return; /* pointer to last entry in list */ last = list + (len - 1); /* do simple left shift by one */ if (rot == 1) { tmp = *list; memmove(list, list + 1, len - 1); *last = tmp; return; } /* do simple right shift by one */ if (rot == len - 1) { tmp = *last; memmove(list + 1, list, len - 1); *list = tmp; return; } /* otherwise do rotate as a set of cycles in place */ cycles = gcd(len, rot); /* number of cycles */ do { start = from = list + cycles; /* start index is arbitrary */ tmp = *from; /* save entry to be overwritten */ for (;;) { to = from; /* next step in cycle */ from += rot; /* go right rot positions */ if (from > last) from -= len; /* (pointer better not wrap) */ if (from == start) break; /* all but one shifted */ *to = *from; /* shift left */ } *to = tmp; /* complete the circle */ } while (--cycles); } /* structure for gzip file read operations */ typedef struct { int fd; /* file descriptor */ int size; /* 1 << size is bytes in buf */ unsigned left; /* bytes available at next */ unsigned char *buf; /* buffer */ z_const unsigned char *next; /* next byte in buffer */ char *name; /* file name for error messages */ } file; /* reload buffer */ local int readin(file *in) { int len; len = read(in->fd, in->buf, 1 << in->size); if (len == -1) bye("error reading ", in->name); in->left = (unsigned)len; in->next = in->buf; return len; } /* read from file in, exit if end-of-file */ local int readmore(file *in) { if (readin(in) == 0) bye("unexpected end of ", in->name); return 0; } #define read1(in) (in->left == 0 ? readmore(in) : 0, \ in->left--, *(in->next)++) /* skip over n bytes of in */ local void skip(file *in, unsigned n) { unsigned bypass; if (n > in->left) { n -= in->left; bypass = n & ~((1U << in->size) - 1); if (bypass) { if (lseek(in->fd, (off_t)bypass, SEEK_CUR) == -1) bye("seeking ", in->name); n -= bypass; } readmore(in); if (n > in->left) bye("unexpected end of ", in->name); } in->left -= n; in->next += n; } /* read a four-byte unsigned integer, little-endian, from in */ unsigned long read4(file *in) { unsigned long val; val = read1(in); val += (unsigned)read1(in) << 8; val += (unsigned long)read1(in) << 16; val += (unsigned long)read1(in) << 24; return val; } /* skip over gzip header */ local void gzheader(file *in) { int flags; unsigned n; if (read1(in) != 31 || read1(in) != 139) bye(in->name, " not a gzip file"); if (read1(in) != 8) bye("unknown compression method in", in->name); flags = read1(in); if (flags & 0xe0) bye("unknown header flags set in", in->name); skip(in, 6); if (flags & 4) { n = read1(in); n += (unsigned)(read1(in)) << 8; skip(in, n); } if (flags & 8) while (read1(in) != 0) ; if (flags & 16) while (read1(in) != 0) ; if (flags & 2) skip(in, 2); } /* decompress gzip file "name", return strm with a deflate stream ready to continue compression of the data in the gzip file, and return a file descriptor pointing to where to write the compressed data -- the deflate stream is initialized to compress using level "level" */ local int gzscan(char *name, z_stream *strm, int level) { int ret, lastbit, left, full; unsigned have; unsigned long crc, tot; unsigned char *window; off_t lastoff, end; file gz; /* open gzip file */ gz.name = name; gz.fd = open(name, O_RDWR, 0); if (gz.fd == -1) bye("cannot open ", name); gz.buf = malloc(CHUNK); if (gz.buf == NULL) bye("out of memory", ""); gz.size = LGCHUNK; gz.left = 0; /* skip gzip header */ gzheader(&gz); /* prepare to decompress */ window = malloc(DSIZE); if (window == NULL) bye("out of memory", ""); strm->zalloc = Z_NULL; strm->zfree = Z_NULL; strm->opaque = Z_NULL; ret = inflateInit2(strm, -15); if (ret != Z_OK) bye("out of memory", " or library mismatch"); /* decompress the deflate stream, saving append information */ lastbit = 0; lastoff = lseek(gz.fd, 0L, SEEK_CUR) - gz.left; left = 0; strm->avail_in = gz.left; strm->next_in = gz.next; crc = crc32(0L, Z_NULL, 0); have = full = 0; do { /* if needed, get more input */ if (strm->avail_in == 0) { readmore(&gz); strm->avail_in = gz.left; strm->next_in = gz.next; } /* set up output to next available section of sliding window */ strm->avail_out = DSIZE - have; strm->next_out = window + have; /* inflate and check for errors */ ret = inflate(strm, Z_BLOCK); if (ret == Z_STREAM_ERROR) bye("internal stream error!", ""); if (ret == Z_MEM_ERROR) bye("out of memory", ""); if (ret == Z_DATA_ERROR) bye("invalid compressed data--format violated in", name); /* update crc and sliding window pointer */ crc = crc32(crc, window + have, DSIZE - have - strm->avail_out); if (strm->avail_out) have = DSIZE - strm->avail_out; else { have = 0; full = 1; } /* process end of block */ if (strm->data_type & 128) { if (strm->data_type & 64) left = strm->data_type & 0x1f; else { lastbit = strm->data_type & 0x1f; lastoff = lseek(gz.fd, 0L, SEEK_CUR) - strm->avail_in; } } } while (ret != Z_STREAM_END); inflateEnd(strm); gz.left = strm->avail_in; gz.next = strm->next_in; /* save the location of the end of the compressed data */ end = lseek(gz.fd, 0L, SEEK_CUR) - gz.left; /* check gzip trailer and save total for deflate */ if (crc != read4(&gz)) bye("invalid compressed data--crc mismatch in ", name); tot = strm->total_out; if ((tot & 0xffffffffUL) != read4(&gz)) bye("invalid compressed data--length mismatch in", name); /* if not at end of file, warn */ if (gz.left || readin(&gz)) fprintf(stderr, "gzappend warning: junk at end of gzip file overwritten\n"); /* clear last block bit */ lseek(gz.fd, lastoff - (lastbit != 0), SEEK_SET); if (read(gz.fd, gz.buf, 1) != 1) bye("reading after seek on ", name); *gz.buf = (unsigned char)(*gz.buf ^ (1 << ((8 - lastbit) & 7))); lseek(gz.fd, -1L, SEEK_CUR); if (write(gz.fd, gz.buf, 1) != 1) bye("writing after seek to ", name); /* if window wrapped, build dictionary from window by rotating */ if (full) { rotate(window, DSIZE, have); have = DSIZE; } /* set up deflate stream with window, crc, total_in, and leftover bits */ ret = deflateInit2(strm, level, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY); if (ret != Z_OK) bye("out of memory", ""); deflateSetDictionary(strm, window, have); strm->adler = crc; strm->total_in = tot; if (left) { lseek(gz.fd, --end, SEEK_SET); if (read(gz.fd, gz.buf, 1) != 1) bye("reading after seek on ", name); deflatePrime(strm, 8 - left, *gz.buf); } lseek(gz.fd, end, SEEK_SET); /* clean up and return */ free(window); free(gz.buf); return gz.fd; } /* append file "name" to gzip file gd using deflate stream strm -- if last is true, then finish off the deflate stream at the end */ local void gztack(char *name, int gd, z_stream *strm, int last) { int fd, len, ret; unsigned left; unsigned char *in, *out; /* open file to compress and append */ fd = 0; if (name != NULL) { fd = open(name, O_RDONLY, 0); if (fd == -1) fprintf(stderr, "gzappend warning: %s not found, skipping ...\n", name); } /* allocate buffers */ in = malloc(CHUNK); out = malloc(CHUNK); if (in == NULL || out == NULL) bye("out of memory", ""); /* compress input file and append to gzip file */ do { /* get more input */ len = read(fd, in, CHUNK); if (len == -1) { fprintf(stderr, "gzappend warning: error reading %s, skipping rest ...\n", name); len = 0; } strm->avail_in = (unsigned)len; strm->next_in = in; if (len) strm->adler = crc32(strm->adler, in, (unsigned)len); /* compress and write all available output */ do { strm->avail_out = CHUNK; strm->next_out = out; ret = deflate(strm, last && len == 0 ? Z_FINISH : Z_NO_FLUSH); left = CHUNK - strm->avail_out; while (left) { len = write(gd, out + CHUNK - strm->avail_out - left, left); if (len == -1) bye("writing gzip file", ""); left -= (unsigned)len; } } while (strm->avail_out == 0 && ret != Z_STREAM_END); } while (len != 0); /* write trailer after last entry */ if (last) { deflateEnd(strm); out[0] = (unsigned char)(strm->adler); out[1] = (unsigned char)(strm->adler >> 8); out[2] = (unsigned char)(strm->adler >> 16); out[3] = (unsigned char)(strm->adler >> 24); out[4] = (unsigned char)(strm->total_in); out[5] = (unsigned char)(strm->total_in >> 8); out[6] = (unsigned char)(strm->total_in >> 16); out[7] = (unsigned char)(strm->total_in >> 24); len = 8; do { ret = write(gd, out + 8 - len, len); if (ret == -1) bye("writing gzip file", ""); len -= ret; } while (len); close(gd); } /* clean up and return */ free(out); free(in); if (fd > 0) close(fd); } /* process the compression level option if present, scan the gzip file, and append the specified files, or append the data from stdin if no other file names are provided on the command line -- the gzip file must be writable and seekable */ int main(int argc, char **argv) { int gd, level; z_stream strm; /* ignore command name */ argc--; argv++; /* provide usage if no arguments */ if (*argv == NULL) { printf( "gzappend 1.2 (11 Oct 2012) Copyright (C) 2003, 2012 Mark Adler\n" ); printf( "usage: gzappend [-level] file.gz [ addthis [ andthis ... ]]\n"); return 0; } /* set compression level */ level = Z_DEFAULT_COMPRESSION; if (argv[0][0] == '-') { if (argv[0][1] < '0' || argv[0][1] > '9' || argv[0][2] != 0) bye("invalid compression level", ""); level = argv[0][1] - '0'; if (*++argv == NULL) bye("no gzip file name after options", ""); } /* prepare to append to gzip file */ gd = gzscan(*argv++, &strm, level); /* append files on command line, or from stdin if none */ if (*argv == NULL) gztack(NULL, gd, &strm, 1); else do { gztack(*argv, gd, &strm, argv[1] == NULL); } while (*++argv != NULL); return 0; } tcl8.6.14/compat/zlib/examples/zpipe.c0000644000175000017500000001426314554262142017204 0ustar sergeisergei/* zpipe.c: example of proper use of zlib's inflate() and deflate() Not copyrighted -- provided to the public domain Version 1.4 11 December 2005 Mark Adler */ /* Version history: 1.0 30 Oct 2004 First version 1.1 8 Nov 2004 Add void casting for unused return values Use switch statement for inflate() return values 1.2 9 Nov 2004 Add assertions to document zlib guarantees 1.3 6 Apr 2005 Remove incorrect assertion in inf() 1.4 11 Dec 2005 Add hack to avoid MSDOS end-of-line conversions Avoid some compiler warnings for input and output buffers */ #include #include #include #include "zlib.h" #if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__) # include # include # define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY) #else # define SET_BINARY_MODE(file) #endif #define CHUNK 16384 /* Compress from file source to file dest until EOF on source. def() returns Z_OK on success, Z_MEM_ERROR if memory could not be allocated for processing, Z_STREAM_ERROR if an invalid compression level is supplied, Z_VERSION_ERROR if the version of zlib.h and the version of the library linked do not match, or Z_ERRNO if there is an error reading or writing the files. */ int def(FILE *source, FILE *dest, int level) { int ret, flush; unsigned have; z_stream strm; unsigned char in[CHUNK]; unsigned char out[CHUNK]; /* allocate deflate state */ strm.zalloc = Z_NULL; strm.zfree = Z_NULL; strm.opaque = Z_NULL; ret = deflateInit(&strm, level); if (ret != Z_OK) return ret; /* compress until end of file */ do { strm.avail_in = fread(in, 1, CHUNK, source); if (ferror(source)) { (void)deflateEnd(&strm); return Z_ERRNO; } flush = feof(source) ? Z_FINISH : Z_NO_FLUSH; strm.next_in = in; /* run deflate() on input until output buffer not full, finish compression if all of source has been read in */ do { strm.avail_out = CHUNK; strm.next_out = out; ret = deflate(&strm, flush); /* no bad return value */ assert(ret != Z_STREAM_ERROR); /* state not clobbered */ have = CHUNK - strm.avail_out; if (fwrite(out, 1, have, dest) != have || ferror(dest)) { (void)deflateEnd(&strm); return Z_ERRNO; } } while (strm.avail_out == 0); assert(strm.avail_in == 0); /* all input will be used */ /* done when last data in file processed */ } while (flush != Z_FINISH); assert(ret == Z_STREAM_END); /* stream will be complete */ /* clean up and return */ (void)deflateEnd(&strm); return Z_OK; } /* Decompress from file source to file dest until stream ends or EOF. inf() returns Z_OK on success, Z_MEM_ERROR if memory could not be allocated for processing, Z_DATA_ERROR if the deflate data is invalid or incomplete, Z_VERSION_ERROR if the version of zlib.h and the version of the library linked do not match, or Z_ERRNO if there is an error reading or writing the files. */ int inf(FILE *source, FILE *dest) { int ret; unsigned have; z_stream strm; unsigned char in[CHUNK]; unsigned char out[CHUNK]; /* allocate inflate state */ strm.zalloc = Z_NULL; strm.zfree = Z_NULL; strm.opaque = Z_NULL; strm.avail_in = 0; strm.next_in = Z_NULL; ret = inflateInit(&strm); if (ret != Z_OK) return ret; /* decompress until deflate stream ends or end of file */ do { strm.avail_in = fread(in, 1, CHUNK, source); if (ferror(source)) { (void)inflateEnd(&strm); return Z_ERRNO; } if (strm.avail_in == 0) break; strm.next_in = in; /* run inflate() on input until output buffer not full */ do { strm.avail_out = CHUNK; strm.next_out = out; ret = inflate(&strm, Z_NO_FLUSH); assert(ret != Z_STREAM_ERROR); /* state not clobbered */ switch (ret) { case Z_NEED_DICT: ret = Z_DATA_ERROR; /* and fall through */ case Z_DATA_ERROR: case Z_MEM_ERROR: (void)inflateEnd(&strm); return ret; } have = CHUNK - strm.avail_out; if (fwrite(out, 1, have, dest) != have || ferror(dest)) { (void)inflateEnd(&strm); return Z_ERRNO; } } while (strm.avail_out == 0); /* done when inflate() says it's done */ } while (ret != Z_STREAM_END); /* clean up and return */ (void)inflateEnd(&strm); return ret == Z_STREAM_END ? Z_OK : Z_DATA_ERROR; } /* report a zlib or i/o error */ void zerr(int ret) { fputs("zpipe: ", stderr); switch (ret) { case Z_ERRNO: if (ferror(stdin)) fputs("error reading stdin\n", stderr); if (ferror(stdout)) fputs("error writing stdout\n", stderr); break; case Z_STREAM_ERROR: fputs("invalid compression level\n", stderr); break; case Z_DATA_ERROR: fputs("invalid or incomplete deflate data\n", stderr); break; case Z_MEM_ERROR: fputs("out of memory\n", stderr); break; case Z_VERSION_ERROR: fputs("zlib version mismatch!\n", stderr); } } /* compress or decompress from stdin to stdout */ int main(int argc, char **argv) { int ret; /* avoid end-of-line conversions */ SET_BINARY_MODE(stdin); SET_BINARY_MODE(stdout); /* do compression if no arguments */ if (argc == 1) { ret = def(stdin, stdout, Z_DEFAULT_COMPRESSION); if (ret != Z_OK) zerr(ret); return ret; } /* do decompression if -d specified */ else if (argc == 2 && strcmp(argv[1], "-d") == 0) { ret = inf(stdin, stdout); if (ret != Z_OK) zerr(ret); return ret; } /* otherwise, report usage */ else { fputs("zpipe usage: zpipe [-d] < source > dest\n", stderr); return 1; } } tcl8.6.14/compat/zlib/examples/gzlog.h0000644000175000017500000001071614554262142017203 0ustar sergeisergei/* gzlog.h Copyright (C) 2004, 2008, 2012 Mark Adler, all rights reserved version 2.2, 14 Aug 2012 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. Mark Adler madler@alumni.caltech.edu */ /* Version History: 1.0 26 Nov 2004 First version 2.0 25 Apr 2008 Complete redesign for recovery of interrupted operations Interface changed slightly in that now path is a prefix Compression now occurs as needed during gzlog_write() gzlog_write() now always leaves the log file as valid gzip 2.1 8 Jul 2012 Fix argument checks in gzlog_compress() and gzlog_write() 2.2 14 Aug 2012 Clean up signed comparisons */ /* The gzlog object allows writing short messages to a gzipped log file, opening the log file locked for small bursts, and then closing it. The log object works by appending stored (uncompressed) data to the gzip file until 1 MB has been accumulated. At that time, the stored data is compressed, and replaces the uncompressed data in the file. The log file is truncated to its new size at that time. After each write operation, the log file is a valid gzip file that can decompressed to recover what was written. The gzlog operations can be interrupted at any point due to an application or system crash, and the log file will be recovered the next time the log is opened with gzlog_open(). */ #ifndef GZLOG_H #define GZLOG_H /* gzlog object type */ typedef void gzlog; /* Open a gzlog object, creating the log file if it does not exist. Return NULL on error. Note that gzlog_open() could take a while to complete if it has to wait to verify that a lock is stale (possibly for five minutes), or if there is significant contention with other instantiations of this object when locking the resource. path is the prefix of the file names created by this object. If path is "foo", then the log file will be "foo.gz", and other auxiliary files will be created and destroyed during the process: "foo.dict" for a compression dictionary, "foo.temp" for a temporary (next) dictionary, "foo.add" for data being added or compressed, "foo.lock" for the lock file, and "foo.repairs" to log recovery operations performed due to interrupted gzlog operations. A gzlog_open() followed by a gzlog_close() will recover a previously interrupted operation, if any. */ gzlog *gzlog_open(char *path); /* Write to a gzlog object. Return zero on success, -1 if there is a file i/o error on any of the gzlog files (this should not happen if gzlog_open() succeeded, unless the device has run out of space or leftover auxiliary files have permissions or ownership that prevent their use), -2 if there is a memory allocation failure, or -3 if the log argument is invalid (e.g. if it was not created by gzlog_open()). This function will write data to the file uncompressed, until 1 MB has been accumulated, at which time that data will be compressed. The log file will be a valid gzip file upon successful return. */ int gzlog_write(gzlog *log, void *data, size_t len); /* Force compression of any uncompressed data in the log. This should be used sparingly, if at all. The main application would be when a log file will not be appended to again. If this is used to compress frequently while appending, it will both significantly increase the execution time and reduce the compression ratio. The return codes are the same as for gzlog_write(). */ int gzlog_compress(gzlog *log); /* Close a gzlog object. Return zero on success, -3 if the log argument is invalid. The log object is freed, and so cannot be referenced again. */ int gzlog_close(gzlog *log); #endif tcl8.6.14/compat/zlib/examples/zran.c0000644000175000017500000005164414560736523017041 0ustar sergeisergei/* zran.c -- example of deflate stream indexing and random access * Copyright (C) 2005, 2012, 2018, 2023 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h * Version 1.4 13 Apr 2023 Mark Adler */ /* Version History: 1.0 29 May 2005 First version 1.1 29 Sep 2012 Fix memory reallocation error 1.2 14 Oct 2018 Handle gzip streams with multiple members Add a header file to facilitate usage in applications 1.3 18 Feb 2023 Permit raw deflate streams as well as zlib and gzip Permit crossing gzip member boundaries when extracting Support a size_t size when extracting (was an int) Do a binary search over the index for an access point Expose the access point type to enable save and load 1.4 13 Apr 2023 Add a NOPRIME define to not use inflatePrime() */ // Illustrate the use of Z_BLOCK, inflatePrime(), and inflateSetDictionary() // for random access of a compressed file. A file containing a raw deflate // stream is provided on the command line. The compressed stream is decoded in // its entirety, and an index built with access points about every SPAN bytes // in the uncompressed output. The compressed file is left open, and can then // be read randomly, having to decompress on the average SPAN/2 uncompressed // bytes before getting to the desired block of data. // // An access point can be created at the start of any deflate block, by saving // the starting file offset and bit of that block, and the 32K bytes of // uncompressed data that precede that block. Also the uncompressed offset of // that block is saved to provide a reference for locating a desired starting // point in the uncompressed stream. deflate_index_build() decompresses the // input raw deflate stream a block at a time, and at the end of each block // decides if enough uncompressed data has gone by to justify the creation of a // new access point. If so, that point is saved in a data structure that grows // as needed to accommodate the points. // // To use the index, an offset in the uncompressed data is provided, for which // the latest access point at or preceding that offset is located in the index. // The input file is positioned to the specified location in the index, and if // necessary the first few bits of the compressed data is read from the file. // inflate is initialized with those bits and the 32K of uncompressed data, and // decompression then proceeds until the desired offset in the file is reached. // Then decompression continues to read the requested uncompressed data from // the file. // // There is some fair bit of overhead to starting inflation for the random // access, mainly copying the 32K byte dictionary. If small pieces of the file // are being accessed, it would make sense to implement a cache to hold some // lookahead to avoid many calls to deflate_index_extract() for small lengths. // // Another way to build an index would be to use inflateCopy(). That would not // be constrained to have access points at block boundaries, but would require // more memory per access point, and could not be saved to a file due to the // use of pointers in the state. The approach here allows for storage of the // index in a file. #include #include #include #include #include "zlib.h" #include "zran.h" #define WINSIZE 32768U // sliding window size #define CHUNK 16384 // file input buffer size // See comments in zran.h. void deflate_index_free(struct deflate_index *index) { if (index != NULL) { free(index->list); free(index); } } // Add an access point to the list. If out of memory, deallocate the existing // list and return NULL. index->mode is temporarily the allocated number of // access points, until it is time for deflate_index_build() to return. Then // index->mode is set to the mode of inflation. static struct deflate_index *add_point(struct deflate_index *index, int bits, off_t in, off_t out, unsigned left, unsigned char *window) { if (index == NULL) { // The list is empty. Create it, starting with eight access points. index = malloc(sizeof(struct deflate_index)); if (index == NULL) return NULL; index->have = 0; index->mode = 8; index->list = malloc(sizeof(point_t) * index->mode); if (index->list == NULL) { free(index); return NULL; } } else if (index->have == index->mode) { // The list is full. Make it bigger. index->mode <<= 1; point_t *next = realloc(index->list, sizeof(point_t) * index->mode); if (next == NULL) { deflate_index_free(index); return NULL; } index->list = next; } // Fill in the access point and increment how many we have. point_t *next = (point_t *)(index->list) + index->have++; if (index->have < 0) { // Overflowed the int! deflate_index_free(index); return NULL; } next->out = out; next->in = in; next->bits = bits; if (left) memcpy(next->window, window + WINSIZE - left, left); if (left < WINSIZE) memcpy(next->window + left, window, WINSIZE - left); // Return the index, which may have been newly allocated or destroyed. return index; } // Decompression modes. These are the inflateInit2() windowBits parameter. #define RAW -15 #define ZLIB 15 #define GZIP 31 // See comments in zran.h. int deflate_index_build(FILE *in, off_t span, struct deflate_index **built) { // Set up inflation state. z_stream strm = {0}; // inflate engine (gets fired up later) unsigned char buf[CHUNK]; // input buffer unsigned char win[WINSIZE] = {0}; // output sliding window off_t totin = 0; // total bytes read from input off_t totout = 0; // total bytes uncompressed int mode = 0; // mode: RAW, ZLIB, or GZIP (0 => not set yet) // Decompress from in, generating access points along the way. int ret; // the return value from zlib, or Z_ERRNO off_t last; // last access point uncompressed offset struct deflate_index *index = NULL; // list of access points do { // Assure available input, at least until reaching EOF. if (strm.avail_in == 0) { strm.avail_in = fread(buf, 1, sizeof(buf), in); totin += strm.avail_in; strm.next_in = buf; if (strm.avail_in < sizeof(buf) && ferror(in)) { ret = Z_ERRNO; break; } if (mode == 0) { // At the start of the input -- determine the type. Assume raw // if it is neither zlib nor gzip. This could in theory result // in a false positive for zlib, but in practice the fill bits // after a stored block are always zeros, so a raw stream won't // start with an 8 in the low nybble. mode = strm.avail_in == 0 ? RAW : // empty -- will fail (strm.next_in[0] & 0xf) == 8 ? ZLIB : strm.next_in[0] == 0x1f ? GZIP : /* else */ RAW; ret = inflateInit2(&strm, mode); if (ret != Z_OK) break; } } // Assure available output. This rotates the output through, for use as // a sliding window on the uncompressed data. if (strm.avail_out == 0) { strm.avail_out = sizeof(win); strm.next_out = win; } if (mode == RAW && index == NULL) // We skip the inflate() call at the start of raw deflate data in // order generate an access point there. Set data_type to imitate // the end of a header. strm.data_type = 0x80; else { // Inflate and update the number of uncompressed bytes. unsigned before = strm.avail_out; ret = inflate(&strm, Z_BLOCK); totout += before - strm.avail_out; } if ((strm.data_type & 0xc0) == 0x80 && (index == NULL || totout - last >= span)) { // We are at the end of a header or a non-last deflate block, so we // can add an access point here. Furthermore, we are either at the // very start for the first access point, or there has been span or // more uncompressed bytes since the last access point, so we want // to add an access point here. index = add_point(index, strm.data_type & 7, totin - strm.avail_in, totout, strm.avail_out, win); if (index == NULL) { ret = Z_MEM_ERROR; break; } last = totout; } if (ret == Z_STREAM_END && mode == GZIP && (strm.avail_in || ungetc(getc(in), in) != EOF)) // There is more input after the end of a gzip member. Reset the // inflate state to read another gzip member. On success, this will // set ret to Z_OK to continue decompressing. ret = inflateReset2(&strm, GZIP); // Keep going until Z_STREAM_END or error. If the compressed data ends // prematurely without a file read error, Z_BUF_ERROR is returned. } while (ret == Z_OK); inflateEnd(&strm); if (ret != Z_STREAM_END) { // An error was encountered. Discard the index and return a negative // error code. deflate_index_free(index); return ret == Z_NEED_DICT ? Z_DATA_ERROR : ret; } // Shrink the index to only the occupied access points and return it. index->mode = mode; index->length = totout; point_t *list = realloc(index->list, sizeof(point_t) * index->have); if (list == NULL) { // Seems like a realloc() to make something smaller should always work, // but just in case. deflate_index_free(index); return Z_MEM_ERROR; } index->list = list; *built = index; return index->have; } #ifdef NOPRIME // Support zlib versions before 1.2.3 (July 2005), or incomplete zlib clones // that do not have inflatePrime(). # define INFLATEPRIME inflatePreface // Append the low bits bits of value to in[] at bit position *have, updating // *have. value must be zero above its low bits bits. bits must be positive. // This assumes that any bits above the *have bits in the last byte are zeros. // That assumption is preserved on return, as any bits above *have + bits in // the last byte written will be set to zeros. static inline void append_bits(unsigned value, int bits, unsigned char *in, int *have) { in += *have >> 3; // where the first bits from value will go int k = *have & 7; // the number of bits already there *have += bits; if (k) *in |= value << k; // write value above the low k bits else *in = value; k = 8 - k; // the number of bits just appended while (bits > k) { value >>= k; // drop the bits appended bits -= k; k = 8; // now at a byte boundary *++in = value; } } // Insert enough bits in the form of empty deflate blocks in front of the // low bits bits of value, in order to bring the sequence to a byte boundary. // Then feed that to inflate(). This does what inflatePrime() does, except that // a negative value of bits is not supported. bits must be in 0..16. If the // arguments are invalid, Z_STREAM_ERROR is returned. Otherwise the return // value from inflate() is returned. static int inflatePreface(z_stream *strm, int bits, int value) { // Check input. if (strm == Z_NULL || bits < 0 || bits > 16) return Z_STREAM_ERROR; if (bits == 0) return Z_OK; value &= (2 << (bits - 1)) - 1; // An empty dynamic block with an odd number of bits (95). The high bit of // the last byte is unused. static const unsigned char dyn[] = { 4, 0xe0, 0x81, 8, 0, 0, 0, 0, 0x20, 0xa8, 0xab, 0x1f }; const int dynlen = 95; // number of bits in the block // Build an input buffer for inflate that is a multiple of eight bits in // length, and that ends with the low bits bits of value. unsigned char in[(dynlen + 3 * 10 + 16 + 7) / 8]; int have = 0; if (bits & 1) { // Insert an empty dynamic block to get to an odd number of bits, so // when bits bits from value are appended, we are at an even number of // bits. memcpy(in, dyn, sizeof(dyn)); have = dynlen; } while ((have + bits) & 7) // Insert empty fixed blocks until appending bits bits would put us on // a byte boundary. This will insert at most three fixed blocks. append_bits(2, 10, in, &have); // Append the bits bits from value, which takes us to a byte boundary. append_bits(value, bits, in, &have); // Deliver the input to inflate(). There is no output space provided, but // inflate() can't get stuck waiting on output not ingesting all of the // provided input. The reason is that there will be at most 16 bits of // input from value after the empty deflate blocks (which themselves // generate no output). At least ten bits are needed to generate the first // output byte from a fixed block. The last two bytes of the buffer have to // be ingested in order to get ten bits, which is the most that value can // occupy. strm->avail_in = have >> 3; strm->next_in = in; strm->avail_out = 0; strm->next_out = in; // not used, but can't be NULL return inflate(strm, Z_NO_FLUSH); } #else # define INFLATEPRIME inflatePrime #endif // See comments in zran.h. ptrdiff_t deflate_index_extract(FILE *in, struct deflate_index *index, off_t offset, unsigned char *buf, size_t len) { // Do a quick sanity check on the index. if (index == NULL || index->have < 1 || index->list[0].out != 0) return Z_STREAM_ERROR; // If nothing to extract, return zero bytes extracted. if (len == 0 || offset < 0 || offset >= index->length) return 0; // Find the access point closest to but not after offset. int lo = -1, hi = index->have; point_t *point = index->list; while (hi - lo > 1) { int mid = (lo + hi) >> 1; if (offset < point[mid].out) hi = mid; else lo = mid; } point += lo; // Initialize the input file and prime the inflate engine to start there. int ret = fseeko(in, point->in - (point->bits ? 1 : 0), SEEK_SET); if (ret == -1) return Z_ERRNO; int ch = 0; if (point->bits && (ch = getc(in)) == EOF) return ferror(in) ? Z_ERRNO : Z_BUF_ERROR; z_stream strm = {0}; ret = inflateInit2(&strm, RAW); if (ret != Z_OK) return ret; if (point->bits) INFLATEPRIME(&strm, point->bits, ch >> (8 - point->bits)); inflateSetDictionary(&strm, point->window, WINSIZE); // Skip uncompressed bytes until offset reached, then satisfy request. unsigned char input[CHUNK]; unsigned char discard[WINSIZE]; offset -= point->out; // number of bytes to skip to get to offset size_t left = len; // number of bytes left to read after offset do { if (offset) { // Discard up to offset uncompressed bytes. strm.avail_out = offset < WINSIZE ? (unsigned)offset : WINSIZE; strm.next_out = discard; } else { // Uncompress up to left bytes into buf. strm.avail_out = left < UINT_MAX ? (unsigned)left : UINT_MAX; strm.next_out = buf + len - left; } // Uncompress, setting got to the number of bytes uncompressed. if (strm.avail_in == 0) { // Assure available input. strm.avail_in = fread(input, 1, CHUNK, in); if (strm.avail_in < CHUNK && ferror(in)) { ret = Z_ERRNO; break; } strm.next_in = input; } unsigned got = strm.avail_out; ret = inflate(&strm, Z_NO_FLUSH); got -= strm.avail_out; // Update the appropriate count. if (offset) offset -= got; else left -= got; // If we're at the end of a gzip member and there's more to read, // continue to the next gzip member. if (ret == Z_STREAM_END && index->mode == GZIP) { // Discard the gzip trailer. unsigned drop = 8; // length of gzip trailer if (strm.avail_in >= drop) { strm.avail_in -= drop; strm.next_in += drop; } else { // Read and discard the remainder of the gzip trailer. drop -= strm.avail_in; strm.avail_in = 0; do { if (getc(in) == EOF) // The input does not have a complete trailer. return ferror(in) ? Z_ERRNO : Z_BUF_ERROR; } while (--drop); } if (strm.avail_in || ungetc(getc(in), in) != EOF) { // There's more after the gzip trailer. Use inflate to skip the // gzip header and resume the raw inflate there. inflateReset2(&strm, GZIP); do { if (strm.avail_in == 0) { strm.avail_in = fread(input, 1, CHUNK, in); if (strm.avail_in < CHUNK && ferror(in)) { ret = Z_ERRNO; break; } strm.next_in = input; } strm.avail_out = WINSIZE; strm.next_out = discard; ret = inflate(&strm, Z_BLOCK); // stop at end of header } while (ret == Z_OK && (strm.data_type & 0x80) == 0); if (ret != Z_OK) break; inflateReset2(&strm, RAW); } } // Continue until we have the requested data, the deflate data has // ended, or an error is encountered. } while (ret == Z_OK && left); inflateEnd(&strm); // Return the number of uncompressed bytes read into buf, or the error. return ret == Z_OK || ret == Z_STREAM_END ? len - left : ret; } #ifdef TEST #define SPAN 1048576L // desired distance between access points #define LEN 16384 // number of bytes to extract // Demonstrate the use of deflate_index_build() and deflate_index_extract() by // processing the file provided on the command line, and extracting LEN bytes // from 2/3rds of the way through the uncompressed output, writing that to // stdout. An offset can be provided as the second argument, in which case the // data is extracted from there instead. int main(int argc, char **argv) { // Open the input file. if (argc < 2 || argc > 3) { fprintf(stderr, "usage: zran file.raw [offset]\n"); return 1; } FILE *in = fopen(argv[1], "rb"); if (in == NULL) { fprintf(stderr, "zran: could not open %s for reading\n", argv[1]); return 1; } // Get optional offset. off_t offset = -1; if (argc == 3) { char *end; offset = strtoll(argv[2], &end, 10); if (*end || offset < 0) { fprintf(stderr, "zran: %s is not a valid offset\n", argv[2]); return 1; } } // Build index. struct deflate_index *index = NULL; int len = deflate_index_build(in, SPAN, &index); if (len < 0) { fclose(in); switch (len) { case Z_MEM_ERROR: fprintf(stderr, "zran: out of memory\n"); break; case Z_BUF_ERROR: fprintf(stderr, "zran: %s ended prematurely\n", argv[1]); break; case Z_DATA_ERROR: fprintf(stderr, "zran: compressed data error in %s\n", argv[1]); break; case Z_ERRNO: fprintf(stderr, "zran: read error on %s\n", argv[1]); break; default: fprintf(stderr, "zran: error %d while building index\n", len); } return 1; } fprintf(stderr, "zran: built index with %d access points\n", len); // Use index by reading some bytes from an arbitrary offset. unsigned char buf[LEN]; if (offset == -1) offset = ((index->length + 1) << 1) / 3; ptrdiff_t got = deflate_index_extract(in, index, offset, buf, LEN); if (got < 0) fprintf(stderr, "zran: extraction failed: %s error\n", got == Z_MEM_ERROR ? "out of memory" : "input corrupted"); else { fwrite(buf, 1, got, stdout); fprintf(stderr, "zran: extracted %ld bytes at %lld\n", got, offset); } // Clean up and exit. deflate_index_free(index); fclose(in); return 0; } #endif tcl8.6.14/compat/zlib/examples/zlib_how.html0000644000175000017500000007220314554262142020412 0ustar sergeisergei zlib Usage Example

zlib Usage Example

We often get questions about how the deflate() and inflate() functions should be used. Users wonder when they should provide more input, when they should use more output, what to do with a Z_BUF_ERROR, how to make sure the process terminates properly, and so on. So for those who have read zlib.h (a few times), and would like further edification, below is an annotated example in C of simple routines to compress and decompress from an input file to an output file using deflate() and inflate() respectively. The annotations are interspersed between lines of the code. So please read between the lines. We hope this helps explain some of the intricacies of zlib. 

/* zpipe.c: example of proper use of zlib's inflate() and deflate()
   Not copyrighted -- provided to the public domain
   Version 1.4  11 December 2005  Mark Adler */

/* Version history:
   1.0  30 Oct 2004  First version
   1.1   8 Nov 2004  Add void casting for unused return values
                     Use switch statement for inflate() return values
   1.2   9 Nov 2004  Add assertions to document zlib guarantees
   1.3   6 Apr 2005  Remove incorrect assertion in inf()
   1.4  11 Dec 2005  Add hack to avoid MSDOS end-of-line conversions
                     Avoid some compiler warnings for input and output buffers
 */
We now include the header files for the required definitions. From stdio.h we use fopen(), fread(), fwrite(), feof(), ferror(), and fclose() for file i/o, and fputs() for error messages. From string.h we use strcmp() for command line argument processing. From assert.h we use the assert() macro. From zlib.h we use the basic compression functions deflateInit(), deflate(), and deflateEnd(), and the basic decompression functions inflateInit(), inflate(), and inflateEnd(). 

#include <stdio.h>
#include <string.h>
#include <assert.h>
#include "zlib.h"
This is an ugly hack required to avoid corruption of the input and output data on Windows/MS-DOS systems. Without this, those systems would assume that the input and output files are text, and try to convert the end-of-line characters from one standard to another. That would corrupt binary data, and in particular would render the compressed data unusable. This sets the input and output to binary which suppresses the end-of-line conversions. SET_BINARY_MODE() will be used later on stdin and stdout, at the beginning of main(). 

#if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__)
#  include <fcntl.h>
#  include <io.h>
#  define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
#else
#  define SET_BINARY_MODE(file)
#endif
CHUNK is simply the buffer size for feeding data to and pulling data from the zlib routines. Larger buffer sizes would be more efficient, especially for inflate(). If the memory is available, buffers sizes on the order of 128K or 256K bytes should be used. 

#define CHUNK 16384
The def() routine compresses data from an input file to an output file. The output data will be in the zlib format, which is different from the gzip or zip formats. The zlib format has a very small header of only two bytes to identify it as a zlib stream and to provide decoding information, and a four-byte trailer with a fast check value to verify the integrity of the uncompressed data after decoding. 

/* Compress from file source to file dest until EOF on source.
   def() returns Z_OK on success, Z_MEM_ERROR if memory could not be
   allocated for processing, Z_STREAM_ERROR if an invalid compression
   level is supplied, Z_VERSION_ERROR if the version of zlib.h and the
   version of the library linked do not match, or Z_ERRNO if there is
   an error reading or writing the files. */
int def(FILE *source, FILE *dest, int level)
{
Here are the local variables for def(). ret will be used for zlib return codes. flush will keep track of the current flushing state for deflate(), which is either no flushing, or flush to completion after the end of the input file is reached. have is the amount of data returned from deflate(). The strm structure is used to pass information to and from the zlib routines, and to maintain the deflate() state. in and out are the input and output buffers for deflate(). 

    int ret, flush;
    unsigned have;
    z_stream strm;
    unsigned char in[CHUNK];
    unsigned char out[CHUNK];
The first thing we do is to initialize the zlib state for compression using deflateInit(). This must be done before the first use of deflate(). The zalloc, zfree, and opaque fields in the strm structure must be initialized before calling deflateInit(). Here they are set to the zlib constant Z_NULL to request that zlib use the default memory allocation routines. An application may also choose to provide custom memory allocation routines here. deflateInit() will allocate on the order of 256K bytes for the internal state. (See zlib Technical Details.)

deflateInit() is called with a pointer to the structure to be initialized and the compression level, which is an integer in the range of -1 to 9. Lower compression levels result in faster execution, but less compression. Higher levels result in greater compression, but slower execution. The zlib constant Z_DEFAULT_COMPRESSION, equal to -1, provides a good compromise between compression and speed and is equivalent to level 6. Level 0 actually does no compression at all, and in fact expands the data slightly to produce the zlib format (it is not a byte-for-byte copy of the input). More advanced applications of zlib may use deflateInit2() here instead. Such an application may want to reduce how much memory will be used, at some price in compression. Or it may need to request a gzip header and trailer instead of a zlib header and trailer, or raw encoding with no header or trailer at all.

We must check the return value of deflateInit() against the zlib constant Z_OK to make sure that it was able to allocate memory for the internal state, and that the provided arguments were valid. deflateInit() will also check that the version of zlib that the zlib.h file came from matches the version of zlib actually linked with the program. This is especially important for environments in which zlib is a shared library.

Note that an application can initialize multiple, independent zlib streams, which can operate in parallel. The state information maintained in the structure allows the zlib routines to be reentrant. 


    /* allocate deflate state */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    ret = deflateInit(&strm, level);
    if (ret != Z_OK)
        return ret;
With the pleasantries out of the way, now we can get down to business. The outer do-loop reads all of the input file and exits at the bottom of the loop once end-of-file is reached. This loop contains the only call of deflate(). So we must make sure that all of the input data has been processed and that all of the output data has been generated and consumed before we fall out of the loop at the bottom. 

    /* compress until end of file */
    do {
We start off by reading data from the input file. The number of bytes read is put directly into avail_in, and a pointer to those bytes is put into next_in. We also check to see if end-of-file on the input has been reached using feof(). If we are at the end of file, then flush is set to the zlib constant Z_FINISH, which is later passed to deflate() to indicate that this is the last chunk of input data to compress. If we are not yet at the end of the input, then the zlib constant Z_NO_FLUSH will be passed to deflate to indicate that we are still in the middle of the uncompressed data.

If there is an error in reading from the input file, the process is aborted with deflateEnd() being called to free the allocated zlib state before returning the error. We wouldn't want a memory leak, now would we? deflateEnd() can be called at any time after the state has been initialized. Once that's done, deflateInit() (or deflateInit2()) would have to be called to start a new compression process. There is no point here in checking the deflateEnd() return code. The deallocation can't fail. 


        strm.avail_in = fread(in, 1, CHUNK, source);
        if (ferror(source)) {
            (void)deflateEnd(&strm);
            return Z_ERRNO;
        }
        flush = feof(source) ? Z_FINISH : Z_NO_FLUSH;
        strm.next_in = in;
The inner do-loop passes our chunk of input data to deflate(), and then keeps calling deflate() until it is done producing output. Once there is no more new output, deflate() is guaranteed to have consumed all of the input, i.e., avail_in will be zero. 

        /* run deflate() on input until output buffer not full, finish
           compression if all of source has been read in */
        do {
Output space is provided to deflate() by setting avail_out to the number of available output bytes and next_out to a pointer to that space. 

            strm.avail_out = CHUNK;
            strm.next_out = out;
Now we call the compression engine itself, deflate(). It takes as many of the avail_in bytes at next_in as it can process, and writes as many as avail_out bytes to next_out. Those counters and pointers are then updated past the input data consumed and the output data written. It is the amount of output space available that may limit how much input is consumed. Hence the inner loop to make sure that all of the input is consumed by providing more output space each time. Since avail_in and next_in are updated by deflate(), we don't have to mess with those between deflate() calls until it's all used up.

The parameters to deflate() are a pointer to the strm structure containing the input and output information and the internal compression engine state, and a parameter indicating whether and how to flush data to the output. Normally deflate will consume several K bytes of input data before producing any output (except for the header), in order to accumulate statistics on the data for optimum compression. It will then put out a burst of compressed data, and proceed to consume more input before the next burst. Eventually, deflate() must be told to terminate the stream, complete the compression with provided input data, and write out the trailer check value. deflate() will continue to compress normally as long as the flush parameter is Z_NO_FLUSH. Once the Z_FINISH parameter is provided, deflate() will begin to complete the compressed output stream. However depending on how much output space is provided, deflate() may have to be called several times until it has provided the complete compressed stream, even after it has consumed all of the input. The flush parameter must continue to be Z_FINISH for those subsequent calls.

There are other values of the flush parameter that are used in more advanced applications. You can force deflate() to produce a burst of output that encodes all of the input data provided so far, even if it wouldn't have otherwise, for example to control data latency on a link with compressed data. You can also ask that deflate() do that as well as erase any history up to that point so that what follows can be decompressed independently, for example for random access applications. Both requests will degrade compression by an amount depending on how often such requests are made.

deflate() has a return value that can indicate errors, yet we do not check it here. Why not? Well, it turns out that deflate() can do no wrong here. Let's go through deflate()'s return values and dispense with them one by one. The possible values are Z_OK, Z_STREAM_END, Z_STREAM_ERROR, or Z_BUF_ERROR. Z_OK is, well, ok. Z_STREAM_END is also ok and will be returned for the last call of deflate(). This is already guaranteed by calling deflate() with Z_FINISH until it has no more output. Z_STREAM_ERROR is only possible if the stream is not initialized properly, but we did initialize it properly. There is no harm in checking for Z_STREAM_ERROR here, for example to check for the possibility that some other part of the application inadvertently clobbered the memory containing the zlib state. Z_BUF_ERROR will be explained further below, but suffice it to say that this is simply an indication that deflate() could not consume more input or produce more output. deflate() can be called again with more output space or more available input, which it will be in this code. 


            ret = deflate(&strm, flush);    /* no bad return value */
            assert(ret != Z_STREAM_ERROR);  /* state not clobbered */
Now we compute how much output deflate() provided on the last call, which is the difference between how much space was provided before the call, and how much output space is still available after the call. Then that data, if any, is written to the output file. We can then reuse the output buffer for the next call of deflate(). Again if there is a file i/o error, we call deflateEnd() before returning to avoid a memory leak. 

            have = CHUNK - strm.avail_out;
            if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
                (void)deflateEnd(&strm);
                return Z_ERRNO;
            }
The inner do-loop is repeated until the last deflate() call fails to fill the provided output buffer. Then we know that deflate() has done as much as it can with the provided input, and that all of that input has been consumed. We can then fall out of this loop and reuse the input buffer.

The way we tell that deflate() has no more output is by seeing that it did not fill the output buffer, leaving avail_out greater than zero. However suppose that deflate() has no more output, but just so happened to exactly fill the output buffer! avail_out is zero, and we can't tell that deflate() has done all it can. As far as we know, deflate() has more output for us. So we call it again. But now deflate() produces no output at all, and avail_out remains unchanged as CHUNK. That deflate() call wasn't able to do anything, either consume input or produce output, and so it returns Z_BUF_ERROR. (See, I told you I'd cover this later.) However this is not a problem at all. Now we finally have the desired indication that deflate() is really done, and so we drop out of the inner loop to provide more input to deflate().

With flush set to Z_FINISH, this final set of deflate() calls will complete the output stream. Once that is done, subsequent calls of deflate() would return Z_STREAM_ERROR if the flush parameter is not Z_FINISH, and do no more processing until the state is reinitialized.

Some applications of zlib have two loops that call deflate() instead of the single inner loop we have here. The first loop would call without flushing and feed all of the data to deflate(). The second loop would call deflate() with no more data and the Z_FINISH parameter to complete the process. As you can see from this example, that can be avoided by simply keeping track of the current flush state. 


        } while (strm.avail_out == 0);
        assert(strm.avail_in == 0);     /* all input will be used */
Now we check to see if we have already processed all of the input file. That information was saved in the flush variable, so we see if that was set to Z_FINISH. If so, then we're done and we fall out of the outer loop. We're guaranteed to get Z_STREAM_END from the last deflate() call, since we ran it until the last chunk of input was consumed and all of the output was generated. 

        /* done when last data in file processed */
    } while (flush != Z_FINISH);
    assert(ret == Z_STREAM_END);        /* stream will be complete */
The process is complete, but we still need to deallocate the state to avoid a memory leak (or rather more like a memory hemorrhage if you didn't do this). Then finally we can return with a happy return value. 

    /* clean up and return */
    (void)deflateEnd(&strm);
    return Z_OK;
}
Now we do the same thing for decompression in the inf() routine. inf() decompresses what is hopefully a valid zlib stream from the input file and writes the uncompressed data to the output file. Much of the discussion above for def() applies to inf() as well, so the discussion here will focus on the differences between the two. 

/* Decompress from file source to file dest until stream ends or EOF.
   inf() returns Z_OK on success, Z_MEM_ERROR if memory could not be
   allocated for processing, Z_DATA_ERROR if the deflate data is
   invalid or incomplete, Z_VERSION_ERROR if the version of zlib.h and
   the version of the library linked do not match, or Z_ERRNO if there
   is an error reading or writing the files. */
int inf(FILE *source, FILE *dest)
{
The local variables have the same functionality as they do for def(). The only difference is that there is no flush variable, since inflate() can tell from the zlib stream itself when the stream is complete. 

    int ret;
    unsigned have;
    z_stream strm;
    unsigned char in[CHUNK];
    unsigned char out[CHUNK];
The initialization of the state is the same, except that there is no compression level, of course, and two more elements of the structure are initialized. avail_in and next_in must be initialized before calling inflateInit(). This is because the application has the option to provide the start of the zlib stream in order for inflateInit() to have access to information about the compression method to aid in memory allocation. In the current implementation of zlib (up through versions 1.2.x), the method-dependent memory allocations are deferred to the first call of inflate() anyway. However those fields must be initialized since later versions of zlib that provide more compression methods may take advantage of this interface. In any case, no decompression is performed by inflateInit(), so the avail_out and next_out fields do not need to be initialized before calling.

Here avail_in is set to zero and next_in is set to Z_NULL to indicate that no input data is being provided. 


    /* allocate inflate state */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit(&strm);
    if (ret != Z_OK)
        return ret;
The outer do-loop decompresses input until inflate() indicates that it has reached the end of the compressed data and has produced all of the uncompressed output. This is in contrast to def() which processes all of the input file. If end-of-file is reached before the compressed data self-terminates, then the compressed data is incomplete and an error is returned. 

    /* decompress until deflate stream ends or end of file */
    do {
We read input data and set the strm structure accordingly. If we've reached the end of the input file, then we leave the outer loop and report an error, since the compressed data is incomplete. Note that we may read more data than is eventually consumed by inflate(), if the input file continues past the zlib stream. For applications where zlib streams are embedded in other data, this routine would need to be modified to return the unused data, or at least indicate how much of the input data was not used, so the application would know where to pick up after the zlib stream. 

        strm.avail_in = fread(in, 1, CHUNK, source);
        if (ferror(source)) {
            (void)inflateEnd(&strm);
            return Z_ERRNO;
        }
        if (strm.avail_in == 0)
            break;
        strm.next_in = in;
The inner do-loop has the same function it did in def(), which is to keep calling inflate() until has generated all of the output it can with the provided input. 

        /* run inflate() on input until output buffer not full */
        do {
Just like in def(), the same output space is provided for each call of inflate(). 

            strm.avail_out = CHUNK;
            strm.next_out = out;
Now we run the decompression engine itself. There is no need to adjust the flush parameter, since the zlib format is self-terminating. The main difference here is that there are return values that we need to pay attention to. Z_DATA_ERROR indicates that inflate() detected an error in the zlib compressed data format, which means that either the data is not a zlib stream to begin with, or that the data was corrupted somewhere along the way since it was compressed. The other error to be processed is Z_MEM_ERROR, which can occur since memory allocation is deferred until inflate() needs it, unlike deflate(), whose memory is allocated at the start by deflateInit().

Advanced applications may use deflateSetDictionary() to prime deflate() with a set of likely data to improve the first 32K or so of compression. This is noted in the zlib header, so inflate() requests that that dictionary be provided before it can start to decompress. Without the dictionary, correct decompression is not possible. For this routine, we have no idea what the dictionary is, so the Z_NEED_DICT indication is converted to a Z_DATA_ERROR.

inflate() can also return Z_STREAM_ERROR, which should not be possible here, but could be checked for as noted above for def(). Z_BUF_ERROR does not need to be checked for here, for the same reasons noted for def(). Z_STREAM_END will be checked for later. 


            ret = inflate(&strm, Z_NO_FLUSH);
            assert(ret != Z_STREAM_ERROR);  /* state not clobbered */
            switch (ret) {
            case Z_NEED_DICT:
                ret = Z_DATA_ERROR;     /* and fall through */
            case Z_DATA_ERROR:
            case Z_MEM_ERROR:
                (void)inflateEnd(&strm);
                return ret;
            }
The output of inflate() is handled identically to that of deflate(). 

            have = CHUNK - strm.avail_out;
            if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
                (void)inflateEnd(&strm);
                return Z_ERRNO;
            }
The inner do-loop ends when inflate() has no more output as indicated by not filling the output buffer, just as for deflate(). In this case, we cannot assert that strm.avail_in will be zero, since the deflate stream may end before the file does. 

        } while (strm.avail_out == 0);
The outer do-loop ends when inflate() reports that it has reached the end of the input zlib stream, has completed the decompression and integrity check, and has provided all of the output. This is indicated by the inflate() return value Z_STREAM_END. The inner loop is guaranteed to leave ret equal to Z_STREAM_END if the last chunk of the input file read contained the end of the zlib stream. So if the return value is not Z_STREAM_END, the loop continues to read more input. 

        /* done when inflate() says it's done */
    } while (ret != Z_STREAM_END);
At this point, decompression successfully completed, or we broke out of the loop due to no more data being available from the input file. If the last inflate() return value is not Z_STREAM_END, then the zlib stream was incomplete and a data error is returned. Otherwise, we return with a happy return value. Of course, inflateEnd() is called first to avoid a memory leak. 

    /* clean up and return */
    (void)inflateEnd(&strm);
    return ret == Z_STREAM_END ? Z_OK : Z_DATA_ERROR;
}
That ends the routines that directly use zlib. The following routines make this a command-line program by running data through the above routines from stdin to stdout, and handling any errors reported by def() or inf().

zerr() is used to interpret the possible error codes from def() and inf(), as detailed in their comments above, and print out an error message. Note that these are only a subset of the possible return values from deflate() and inflate(). 


/* report a zlib or i/o error */
void zerr(int ret)
{
    fputs("zpipe: ", stderr);
    switch (ret) {
    case Z_ERRNO:
        if (ferror(stdin))
            fputs("error reading stdin\n", stderr);
        if (ferror(stdout))
            fputs("error writing stdout\n", stderr);
        break;
    case Z_STREAM_ERROR:
        fputs("invalid compression level\n", stderr);
        break;
    case Z_DATA_ERROR:
        fputs("invalid or incomplete deflate data\n", stderr);
        break;
    case Z_MEM_ERROR:
        fputs("out of memory\n", stderr);
        break;
    case Z_VERSION_ERROR:
        fputs("zlib version mismatch!\n", stderr);
    }
}
Here is the main() routine used to test def() and inf(). The zpipe command is simply a compression pipe from stdin to stdout, if no arguments are given, or it is a decompression pipe if zpipe -d is used. If any other arguments are provided, no compression or decompression is performed. Instead a usage message is displayed. Examples are zpipe < foo.txt > foo.txt.z to compress, and zpipe -d < foo.txt.z > foo.txt to decompress. 

/* compress or decompress from stdin to stdout */
int main(int argc, char **argv)
{
    int ret;

    /* avoid end-of-line conversions */
    SET_BINARY_MODE(stdin);
    SET_BINARY_MODE(stdout);

    /* do compression if no arguments */
    if (argc == 1) {
        ret = def(stdin, stdout, Z_DEFAULT_COMPRESSION);
        if (ret != Z_OK)
            zerr(ret);
        return ret;
    }

    /* do decompression if -d specified */
    else if (argc == 2 && strcmp(argv[1], "-d") == 0) {
        ret = inf(stdin, stdout);
        if (ret != Z_OK)
            zerr(ret);
        return ret;
    }

    /* otherwise, report usage */
    else {
        fputs("zpipe usage: zpipe [-d] < source > dest\n", stderr);
        return 1;
    }
}
Last modified 24 January 2023
Copyright © 2004-2023 Mark Adler
Creative Commons License Creative Commons Attribution-NoDerivatives 4.0 International License. tcl8.6.14/compat/zlib/examples/fitblk.c0000644000175000017500000002062414554262142017326 0ustar sergeisergei/* fitblk.c: example of fitting compressed output to a specified size Not copyrighted -- provided to the public domain Version 1.1 25 November 2004 Mark Adler */ /* Version history: 1.0 24 Nov 2004 First version 1.1 25 Nov 2004 Change deflateInit2() to deflateInit() Use fixed-size, stack-allocated raw buffers Simplify code moving compression to subroutines Use assert() for internal errors Add detailed description of approach */ /* Approach to just fitting a requested compressed size: fitblk performs three compression passes on a portion of the input data in order to determine how much of that input will compress to nearly the requested output block size. The first pass generates enough deflate blocks to produce output to fill the requested output size plus a specified excess amount (see the EXCESS define below). The last deflate block may go quite a bit past that, but is discarded. The second pass decompresses and recompresses just the compressed data that fit in the requested plus excess sized buffer. The deflate process is terminated after that amount of input, which is less than the amount consumed on the first pass. The last deflate block of the result will be of a comparable size to the final product, so that the header for that deflate block and the compression ratio for that block will be about the same as in the final product. The third compression pass decompresses the result of the second step, but only the compressed data up to the requested size minus an amount to allow the compressed stream to complete (see the MARGIN define below). That will result in a final compressed stream whose length is less than or equal to the requested size. Assuming sufficient input and a requested size greater than a few hundred bytes, the shortfall will typically be less than ten bytes. If the input is short enough that the first compression completes before filling the requested output size, then that compressed stream is return with no recompression. EXCESS is chosen to be just greater than the shortfall seen in a two pass approach similar to the above. That shortfall is due to the last deflate block compressing more efficiently with a smaller header on the second pass. EXCESS is set to be large enough so that there is enough uncompressed data for the second pass to fill out the requested size, and small enough so that the final deflate block of the second pass will be close in size to the final deflate block of the third and final pass. MARGIN is chosen to be just large enough to assure that the final compression has enough room to complete in all cases. */ #include #include #include #include "zlib.h" #define local static /* print nastygram and leave */ local void quit(char *why) { fprintf(stderr, "fitblk abort: %s\n", why); exit(1); } #define RAWLEN 4096 /* intermediate uncompressed buffer size */ /* compress from file to def until provided buffer is full or end of input reached; return last deflate() return value, or Z_ERRNO if there was read error on the file */ local int partcompress(FILE *in, z_streamp def) { int ret, flush; unsigned char raw[RAWLEN]; flush = Z_NO_FLUSH; do { def->avail_in = fread(raw, 1, RAWLEN, in); if (ferror(in)) return Z_ERRNO; def->next_in = raw; if (feof(in)) flush = Z_FINISH; ret = deflate(def, flush); assert(ret != Z_STREAM_ERROR); } while (def->avail_out != 0 && flush == Z_NO_FLUSH); return ret; } /* recompress from inf's input to def's output; the input for inf and the output for def are set in those structures before calling; return last deflate() return value, or Z_MEM_ERROR if inflate() was not able to allocate enough memory when it needed to */ local int recompress(z_streamp inf, z_streamp def) { int ret, flush; unsigned char raw[RAWLEN]; flush = Z_NO_FLUSH; do { /* decompress */ inf->avail_out = RAWLEN; inf->next_out = raw; ret = inflate(inf, Z_NO_FLUSH); assert(ret != Z_STREAM_ERROR && ret != Z_DATA_ERROR && ret != Z_NEED_DICT); if (ret == Z_MEM_ERROR) return ret; /* compress what was decompressed until done or no room */ def->avail_in = RAWLEN - inf->avail_out; def->next_in = raw; if (inf->avail_out != 0) flush = Z_FINISH; ret = deflate(def, flush); assert(ret != Z_STREAM_ERROR); } while (ret != Z_STREAM_END && def->avail_out != 0); return ret; } #define EXCESS 256 /* empirically determined stream overage */ #define MARGIN 8 /* amount to back off for completion */ /* compress from stdin to fixed-size block on stdout */ int main(int argc, char **argv) { int ret; /* return code */ unsigned size; /* requested fixed output block size */ unsigned have; /* bytes written by deflate() call */ unsigned char *blk; /* intermediate and final stream */ unsigned char *tmp; /* close to desired size stream */ z_stream def, inf; /* zlib deflate and inflate states */ /* get requested output size */ if (argc != 2) quit("need one argument: size of output block"); ret = strtol(argv[1], argv + 1, 10); if (argv[1][0] != 0) quit("argument must be a number"); if (ret < 8) /* 8 is minimum zlib stream size */ quit("need positive size of 8 or greater"); size = (unsigned)ret; /* allocate memory for buffers and compression engine */ blk = malloc(size + EXCESS); def.zalloc = Z_NULL; def.zfree = Z_NULL; def.opaque = Z_NULL; ret = deflateInit(&def, Z_DEFAULT_COMPRESSION); if (ret != Z_OK || blk == NULL) quit("out of memory"); /* compress from stdin until output full, or no more input */ def.avail_out = size + EXCESS; def.next_out = blk; ret = partcompress(stdin, &def); if (ret == Z_ERRNO) quit("error reading input"); /* if it all fit, then size was undersubscribed -- done! */ if (ret == Z_STREAM_END && def.avail_out >= EXCESS) { /* write block to stdout */ have = size + EXCESS - def.avail_out; if (fwrite(blk, 1, have, stdout) != have || ferror(stdout)) quit("error writing output"); /* clean up and print results to stderr */ ret = deflateEnd(&def); assert(ret != Z_STREAM_ERROR); free(blk); fprintf(stderr, "%u bytes unused out of %u requested (all input)\n", size - have, size); return 0; } /* it didn't all fit -- set up for recompression */ inf.zalloc = Z_NULL; inf.zfree = Z_NULL; inf.opaque = Z_NULL; inf.avail_in = 0; inf.next_in = Z_NULL; ret = inflateInit(&inf); tmp = malloc(size + EXCESS); if (ret != Z_OK || tmp == NULL) quit("out of memory"); ret = deflateReset(&def); assert(ret != Z_STREAM_ERROR); /* do first recompression close to the right amount */ inf.avail_in = size + EXCESS; inf.next_in = blk; def.avail_out = size + EXCESS; def.next_out = tmp; ret = recompress(&inf, &def); if (ret == Z_MEM_ERROR) quit("out of memory"); /* set up for next recompression */ ret = inflateReset(&inf); assert(ret != Z_STREAM_ERROR); ret = deflateReset(&def); assert(ret != Z_STREAM_ERROR); /* do second and final recompression (third compression) */ inf.avail_in = size - MARGIN; /* assure stream will complete */ inf.next_in = tmp; def.avail_out = size; def.next_out = blk; ret = recompress(&inf, &def); if (ret == Z_MEM_ERROR) quit("out of memory"); assert(ret == Z_STREAM_END); /* otherwise MARGIN too small */ /* done -- write block to stdout */ have = size - def.avail_out; if (fwrite(blk, 1, have, stdout) != have || ferror(stdout)) quit("error writing output"); /* clean up and print results to stderr */ free(tmp); ret = inflateEnd(&inf); assert(ret != Z_STREAM_ERROR); ret = deflateEnd(&def); assert(ret != Z_STREAM_ERROR); free(blk); fprintf(stderr, "%u bytes unused out of %u requested (%lu input)\n", size - have, size, def.total_in); return 0; } tcl8.6.14/compat/zlib/examples/zran.h0000644000175000017500000000524214554262142017031 0ustar sergeisergei/* zran.h -- example of deflated stream indexing and random access * Copyright (C) 2005, 2012, 2018, 2023 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h * Version 1.3 18 Feb 2023 Mark Adler */ #include #include "zlib.h" // Access point. typedef struct point { off_t out; // offset in uncompressed data off_t in; // offset in compressed file of first full byte int bits; // 0, or number of bits (1-7) from byte at in-1 unsigned char window[32768]; // preceding 32K of uncompressed data } point_t; // Access point list. struct deflate_index { int have; // number of access points in list int mode; // -15 for raw, 15 for zlib, or 31 for gzip off_t length; // total length of uncompressed data point_t *list; // allocated list of access points }; // Make one pass through a zlib, gzip, or raw deflate compressed stream and // build an index, with access points about every span bytes of uncompressed // output. gzip files with multiple members are fully indexed. span should be // chosen to balance the speed of random access against the memory requirements // of the list, which is about 32K bytes per access point. The return value is // the number of access points on success (>= 1), Z_MEM_ERROR for out of // memory, Z_BUF_ERROR for a premature end of input, Z_DATA_ERROR for a format // or verification error in the input file, or Z_ERRNO for a file read error. // On success, *built points to the resulting index. int deflate_index_build(FILE *in, off_t span, struct deflate_index **built); // Use the index to read len bytes from offset into buf. Return the number of // bytes read or a negative error code. If data is requested past the end of // the uncompressed data, then deflate_index_extract() will return a value less // than len, indicating how much was actually read into buf. If given a valid // index, this function should not return an error unless the file was modified // somehow since the index was generated, given that deflate_index_build() had // validated all of the input. If nevertheless there is a failure, Z_BUF_ERROR // is returned if the compressed data ends prematurely, Z_DATA_ERROR if the // deflate compressed data is not valid, Z_MEM_ERROR if out of memory, // Z_STREAM_ERROR if the index is not valid, or Z_ERRNO if there is an error // reading or seeking on the input file. ptrdiff_t deflate_index_extract(FILE *in, struct deflate_index *index, off_t offset, unsigned char *buf, size_t len); // Deallocate an index built by deflate_index_build(). void deflate_index_free(struct deflate_index *index); tcl8.6.14/compat/zlib/examples/gun.c0000644000175000017500000006252614554262142016653 0ustar sergeisergei/* gun.c -- simple gunzip to give an example of the use of inflateBack() * Copyright (C) 2003, 2005, 2008, 2010, 2012 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h Version 1.7 12 August 2012 Mark Adler */ /* Version history: 1.0 16 Feb 2003 First version for testing of inflateBack() 1.1 21 Feb 2005 Decompress concatenated gzip streams Remove use of "this" variable (C++ keyword) Fix return value for in() Improve allocation failure checking Add typecasting for void * structures Add -h option for command version and usage Add a bunch of comments 1.2 20 Mar 2005 Add Unix compress (LZW) decompression Copy file attributes from input file to output file 1.3 12 Jun 2005 Add casts for error messages [Oberhumer] 1.4 8 Dec 2006 LZW decompression speed improvements 1.5 9 Feb 2008 Avoid warning in latest version of gcc 1.6 17 Jan 2010 Avoid signed/unsigned comparison warnings 1.7 12 Aug 2012 Update for z_const usage in zlib 1.2.8 */ /* gun [ -t ] [ name ... ] decompresses the data in the named gzip files. If no arguments are given, gun will decompress from stdin to stdout. The names must end in .gz, -gz, .z, -z, _z, or .Z. The uncompressed data will be written to a file name with the suffix stripped. On success, the original file is deleted. On failure, the output file is deleted. For most failures, the command will continue to process the remaining names on the command line. A memory allocation failure will abort the command. If -t is specified, then the listed files or stdin will be tested as gzip files for integrity (without checking for a proper suffix), no output will be written, and no files will be deleted. Like gzip, gun allows concatenated gzip streams and will decompress them, writing all of the uncompressed data to the output. Unlike gzip, gun allows an empty file on input, and will produce no error writing an empty output file. gun will also decompress files made by Unix compress, which uses LZW compression. These files are automatically detected by virtue of their magic header bytes. Since the end of Unix compress stream is marked by the end-of-file, they cannot be concatenated. If a Unix compress stream is encountered in an input file, it is the last stream in that file. Like gunzip and uncompress, the file attributes of the original compressed file are maintained in the final uncompressed file, to the extent that the user permissions allow it. On my Mac OS X PowerPC G4, gun is almost twice as fast as gunzip (version 1.2.4) is on the same file, when gun is linked with zlib 1.2.2. Also the LZW decompression provided by gun is about twice as fast as the standard Unix uncompress command. */ /* external functions and related types and constants */ #include /* fprintf() */ #include /* malloc(), free() */ #include /* strerror(), strcmp(), strlen(), memcpy() */ #include /* errno */ #include /* open() */ #include /* read(), write(), close(), chown(), unlink() */ #include #include /* stat(), chmod() */ #include /* utime() */ #include "zlib.h" /* inflateBackInit(), inflateBack(), */ /* inflateBackEnd(), crc32() */ /* function declaration */ #define local static /* buffer constants */ #define SIZE 32768U /* input and output buffer sizes */ #define PIECE 16384 /* limits i/o chunks for 16-bit int case */ /* structure for infback() to pass to input function in() -- it maintains the input file and a buffer of size SIZE */ struct ind { int infile; unsigned char *inbuf; }; /* Load input buffer, assumed to be empty, and return bytes loaded and a pointer to them. read() is called until the buffer is full, or until it returns end-of-file or error. Return 0 on error. */ local unsigned in(void *in_desc, z_const unsigned char **buf) { int ret; unsigned len; unsigned char *next; struct ind *me = (struct ind *)in_desc; next = me->inbuf; *buf = next; len = 0; do { ret = PIECE; if ((unsigned)ret > SIZE - len) ret = (int)(SIZE - len); ret = (int)read(me->infile, next, ret); if (ret == -1) { len = 0; break; } next += ret; len += ret; } while (ret != 0 && len < SIZE); return len; } /* structure for infback() to pass to output function out() -- it maintains the output file, a running CRC-32 check on the output and the total number of bytes output, both for checking against the gzip trailer. (The length in the gzip trailer is stored modulo 2^32, so it's ok if a long is 32 bits and the output is greater than 4 GB.) */ struct outd { int outfile; int check; /* true if checking crc and total */ unsigned long crc; unsigned long total; }; /* Write output buffer and update the CRC-32 and total bytes written. write() is called until all of the output is written or an error is encountered. On success out() returns 0. For a write failure, out() returns 1. If the output file descriptor is -1, then nothing is written. */ local int out(void *out_desc, unsigned char *buf, unsigned len) { int ret; struct outd *me = (struct outd *)out_desc; if (me->check) { me->crc = crc32(me->crc, buf, len); me->total += len; } if (me->outfile != -1) do { ret = PIECE; if ((unsigned)ret > len) ret = (int)len; ret = (int)write(me->outfile, buf, ret); if (ret == -1) return 1; buf += ret; len -= ret; } while (len != 0); return 0; } /* next input byte macro for use inside lunpipe() and gunpipe() */ #define NEXT() (have ? 0 : (have = in(indp, &next)), \ last = have ? (have--, (int)(*next++)) : -1) /* memory for gunpipe() and lunpipe() -- the first 256 entries of prefix[] and suffix[] are never used, could have offset the index, but it's faster to waste the memory */ unsigned char inbuf[SIZE]; /* input buffer */ unsigned char outbuf[SIZE]; /* output buffer */ unsigned short prefix[65536]; /* index to LZW prefix string */ unsigned char suffix[65536]; /* one-character LZW suffix */ unsigned char match[65280 + 2]; /* buffer for reversed match or gzip 32K sliding window */ /* throw out what's left in the current bits byte buffer (this is a vestigial aspect of the compressed data format derived from an implementation that made use of a special VAX machine instruction!) */ #define FLUSHCODE() \ do { \ left = 0; \ rem = 0; \ if (chunk > have) { \ chunk -= have; \ have = 0; \ if (NEXT() == -1) \ break; \ chunk--; \ if (chunk > have) { \ chunk = have = 0; \ break; \ } \ } \ have -= chunk; \ next += chunk; \ chunk = 0; \ } while (0) /* Decompress a compress (LZW) file from indp to outfile. The compress magic header (two bytes) has already been read and verified. There are have bytes of buffered input at next. strm is used for passing error information back to gunpipe(). lunpipe() will return Z_OK on success, Z_BUF_ERROR for an unexpected end of file, read error, or write error (a write error indicated by strm->next_in not equal to Z_NULL), or Z_DATA_ERROR for invalid input. */ local int lunpipe(unsigned have, z_const unsigned char *next, struct ind *indp, int outfile, z_stream *strm) { int last; /* last byte read by NEXT(), or -1 if EOF */ unsigned chunk; /* bytes left in current chunk */ int left; /* bits left in rem */ unsigned rem; /* unused bits from input */ int bits; /* current bits per code */ unsigned code; /* code, table traversal index */ unsigned mask; /* mask for current bits codes */ int max; /* maximum bits per code for this stream */ unsigned flags; /* compress flags, then block compress flag */ unsigned end; /* last valid entry in prefix/suffix tables */ unsigned temp; /* current code */ unsigned prev; /* previous code */ unsigned final; /* last character written for previous code */ unsigned stack; /* next position for reversed string */ unsigned outcnt; /* bytes in output buffer */ struct outd outd; /* output structure */ unsigned char *p; /* set up output */ outd.outfile = outfile; outd.check = 0; /* process remainder of compress header -- a flags byte */ flags = NEXT(); if (last == -1) return Z_BUF_ERROR; if (flags & 0x60) { strm->msg = (char *)"unknown lzw flags set"; return Z_DATA_ERROR; } max = flags & 0x1f; if (max < 9 || max > 16) { strm->msg = (char *)"lzw bits out of range"; return Z_DATA_ERROR; } if (max == 9) /* 9 doesn't really mean 9 */ max = 10; flags &= 0x80; /* true if block compress */ /* clear table */ bits = 9; mask = 0x1ff; end = flags ? 256 : 255; /* set up: get first 9-bit code, which is the first decompressed byte, but don't create a table entry until the next code */ if (NEXT() == -1) /* no compressed data is ok */ return Z_OK; final = prev = (unsigned)last; /* low 8 bits of code */ if (NEXT() == -1) /* missing a bit */ return Z_BUF_ERROR; if (last & 1) { /* code must be < 256 */ strm->msg = (char *)"invalid lzw code"; return Z_DATA_ERROR; } rem = (unsigned)last >> 1; /* remaining 7 bits */ left = 7; chunk = bits - 2; /* 7 bytes left in this chunk */ outbuf[0] = (unsigned char)final; /* write first decompressed byte */ outcnt = 1; /* decode codes */ stack = 0; for (;;) { /* if the table will be full after this, increment the code size */ if (end >= mask && bits < max) { FLUSHCODE(); bits++; mask <<= 1; mask++; } /* get a code of length bits */ if (chunk == 0) /* decrement chunk modulo bits */ chunk = bits; code = rem; /* low bits of code */ if (NEXT() == -1) { /* EOF is end of compressed data */ /* write remaining buffered output */ if (outcnt && out(&outd, outbuf, outcnt)) { strm->next_in = outbuf; /* signal write error */ return Z_BUF_ERROR; } return Z_OK; } code += (unsigned)last << left; /* middle (or high) bits of code */ left += 8; chunk--; if (bits > left) { /* need more bits */ if (NEXT() == -1) /* can't end in middle of code */ return Z_BUF_ERROR; code += (unsigned)last << left; /* high bits of code */ left += 8; chunk--; } code &= mask; /* mask to current code length */ left -= bits; /* number of unused bits */ rem = (unsigned)last >> (8 - left); /* unused bits from last byte */ /* process clear code (256) */ if (code == 256 && flags) { FLUSHCODE(); bits = 9; /* initialize bits and mask */ mask = 0x1ff; end = 255; /* empty table */ continue; /* get next code */ } /* special code to reuse last match */ temp = code; /* save the current code */ if (code > end) { /* Be picky on the allowed code here, and make sure that the code we drop through (prev) will be a valid index so that random input does not cause an exception. The code != end + 1 check is empirically derived, and not checked in the original uncompress code. If this ever causes a problem, that check could be safely removed. Leaving this check in greatly improves gun's ability to detect random or corrupted input after a compress header. In any case, the prev > end check must be retained. */ if (code != end + 1 || prev > end) { strm->msg = (char *)"invalid lzw code"; return Z_DATA_ERROR; } match[stack++] = (unsigned char)final; code = prev; } /* walk through linked list to generate output in reverse order */ p = match + stack; while (code >= 256) { *p++ = suffix[code]; code = prefix[code]; } stack = p - match; match[stack++] = (unsigned char)code; final = code; /* link new table entry */ if (end < mask) { end++; prefix[end] = (unsigned short)prev; suffix[end] = (unsigned char)final; } /* set previous code for next iteration */ prev = temp; /* write output in forward order */ while (stack > SIZE - outcnt) { while (outcnt < SIZE) outbuf[outcnt++] = match[--stack]; if (out(&outd, outbuf, outcnt)) { strm->next_in = outbuf; /* signal write error */ return Z_BUF_ERROR; } outcnt = 0; } p = match + stack; do { outbuf[outcnt++] = *--p; } while (p > match); stack = 0; /* loop for next code with final and prev as the last match, rem and left provide the first 0..7 bits of the next code, end is the last valid table entry */ } } /* Decompress a gzip file from infile to outfile. strm is assumed to have been successfully initialized with inflateBackInit(). The input file may consist of a series of gzip streams, in which case all of them will be decompressed to the output file. If outfile is -1, then the gzip stream(s) integrity is checked and nothing is written. The return value is a zlib error code: Z_MEM_ERROR if out of memory, Z_DATA_ERROR if the header or the compressed data is invalid, or if the trailer CRC-32 check or length doesn't match, Z_BUF_ERROR if the input ends prematurely or a write error occurs, or Z_ERRNO if junk (not a another gzip stream) follows a valid gzip stream. */ local int gunpipe(z_stream *strm, int infile, int outfile) { int ret, first, last; unsigned have, flags, len; z_const unsigned char *next = NULL; struct ind ind, *indp; struct outd outd; /* setup input buffer */ ind.infile = infile; ind.inbuf = inbuf; indp = &ind; /* decompress concatenated gzip streams */ have = 0; /* no input data read in yet */ first = 1; /* looking for first gzip header */ strm->next_in = Z_NULL; /* so Z_BUF_ERROR means EOF */ for (;;) { /* look for the two magic header bytes for a gzip stream */ if (NEXT() == -1) { ret = Z_OK; break; /* empty gzip stream is ok */ } if (last != 31 || (NEXT() != 139 && last != 157)) { strm->msg = (char *)"incorrect header check"; ret = first ? Z_DATA_ERROR : Z_ERRNO; break; /* not a gzip or compress header */ } first = 0; /* next non-header is junk */ /* process a compress (LZW) file -- can't be concatenated after this */ if (last == 157) { ret = lunpipe(have, next, indp, outfile, strm); break; } /* process remainder of gzip header */ ret = Z_BUF_ERROR; if (NEXT() != 8) { /* only deflate method allowed */ if (last == -1) break; strm->msg = (char *)"unknown compression method"; ret = Z_DATA_ERROR; break; } flags = NEXT(); /* header flags */ NEXT(); /* discard mod time, xflgs, os */ NEXT(); NEXT(); NEXT(); NEXT(); NEXT(); if (last == -1) break; if (flags & 0xe0) { strm->msg = (char *)"unknown header flags set"; ret = Z_DATA_ERROR; break; } if (flags & 4) { /* extra field */ len = NEXT(); len += (unsigned)(NEXT()) << 8; if (last == -1) break; while (len > have) { len -= have; have = 0; if (NEXT() == -1) break; len--; } if (last == -1) break; have -= len; next += len; } if (flags & 8) /* file name */ while (NEXT() != 0 && last != -1) ; if (flags & 16) /* comment */ while (NEXT() != 0 && last != -1) ; if (flags & 2) { /* header crc */ NEXT(); NEXT(); } if (last == -1) break; /* set up output */ outd.outfile = outfile; outd.check = 1; outd.crc = crc32(0L, Z_NULL, 0); outd.total = 0; /* decompress data to output */ strm->next_in = next; strm->avail_in = have; ret = inflateBack(strm, in, indp, out, &outd); if (ret != Z_STREAM_END) break; next = strm->next_in; have = strm->avail_in; strm->next_in = Z_NULL; /* so Z_BUF_ERROR means EOF */ /* check trailer */ ret = Z_BUF_ERROR; if (NEXT() != (int)(outd.crc & 0xff) || NEXT() != (int)((outd.crc >> 8) & 0xff) || NEXT() != (int)((outd.crc >> 16) & 0xff) || NEXT() != (int)((outd.crc >> 24) & 0xff)) { /* crc error */ if (last != -1) { strm->msg = (char *)"incorrect data check"; ret = Z_DATA_ERROR; } break; } if (NEXT() != (int)(outd.total & 0xff) || NEXT() != (int)((outd.total >> 8) & 0xff) || NEXT() != (int)((outd.total >> 16) & 0xff) || NEXT() != (int)((outd.total >> 24) & 0xff)) { /* length error */ if (last != -1) { strm->msg = (char *)"incorrect length check"; ret = Z_DATA_ERROR; } break; } /* go back and look for another gzip stream */ } /* clean up and return */ return ret; } /* Copy file attributes, from -> to, as best we can. This is best effort, so no errors are reported. The mode bits, including suid, sgid, and the sticky bit are copied (if allowed), the owner's user id and group id are copied (again if allowed), and the access and modify times are copied. */ local void copymeta(char *from, char *to) { struct stat was; struct utimbuf when; /* get all of from's Unix meta data, return if not a regular file */ if (stat(from, &was) != 0 || (was.st_mode & S_IFMT) != S_IFREG) return; /* set to's mode bits, ignore errors */ (void)chmod(to, was.st_mode & 07777); /* copy owner's user and group, ignore errors */ (void)chown(to, was.st_uid, was.st_gid); /* copy access and modify times, ignore errors */ when.actime = was.st_atime; when.modtime = was.st_mtime; (void)utime(to, &when); } /* Decompress the file inname to the file outnname, of if test is true, just decompress without writing and check the gzip trailer for integrity. If inname is NULL or an empty string, read from stdin. If outname is NULL or an empty string, write to stdout. strm is a pre-initialized inflateBack structure. When appropriate, copy the file attributes from inname to outname. gunzip() returns 1 if there is an out-of-memory error or an unexpected return code from gunpipe(). Otherwise it returns 0. */ local int gunzip(z_stream *strm, char *inname, char *outname, int test) { int ret; int infile, outfile; /* open files */ if (inname == NULL || *inname == 0) { inname = "-"; infile = 0; /* stdin */ } else { infile = open(inname, O_RDONLY, 0); if (infile == -1) { fprintf(stderr, "gun cannot open %s\n", inname); return 0; } } if (test) outfile = -1; else if (outname == NULL || *outname == 0) { outname = "-"; outfile = 1; /* stdout */ } else { outfile = open(outname, O_CREAT | O_TRUNC | O_WRONLY, 0666); if (outfile == -1) { close(infile); fprintf(stderr, "gun cannot create %s\n", outname); return 0; } } errno = 0; /* decompress */ ret = gunpipe(strm, infile, outfile); if (outfile > 2) close(outfile); if (infile > 2) close(infile); /* interpret result */ switch (ret) { case Z_OK: case Z_ERRNO: if (infile > 2 && outfile > 2) { copymeta(inname, outname); /* copy attributes */ unlink(inname); } if (ret == Z_ERRNO) fprintf(stderr, "gun warning: trailing garbage ignored in %s\n", inname); break; case Z_DATA_ERROR: if (outfile > 2) unlink(outname); fprintf(stderr, "gun data error on %s: %s\n", inname, strm->msg); break; case Z_MEM_ERROR: if (outfile > 2) unlink(outname); fprintf(stderr, "gun out of memory error--aborting\n"); return 1; case Z_BUF_ERROR: if (outfile > 2) unlink(outname); if (strm->next_in != Z_NULL) { fprintf(stderr, "gun write error on %s: %s\n", outname, strerror(errno)); } else if (errno) { fprintf(stderr, "gun read error on %s: %s\n", inname, strerror(errno)); } else { fprintf(stderr, "gun unexpected end of file on %s\n", inname); } break; default: if (outfile > 2) unlink(outname); fprintf(stderr, "gun internal error--aborting\n"); return 1; } return 0; } /* Process the gun command line arguments. See the command syntax near the beginning of this source file. */ int main(int argc, char **argv) { int ret, len, test; char *outname; unsigned char *window; z_stream strm; /* initialize inflateBack state for repeated use */ window = match; /* reuse LZW match buffer */ strm.zalloc = Z_NULL; strm.zfree = Z_NULL; strm.opaque = Z_NULL; ret = inflateBackInit(&strm, 15, window); if (ret != Z_OK) { fprintf(stderr, "gun out of memory error--aborting\n"); return 1; } /* decompress each file to the same name with the suffix removed */ argc--; argv++; test = 0; if (argc && strcmp(*argv, "-h") == 0) { fprintf(stderr, "gun 1.6 (17 Jan 2010)\n"); fprintf(stderr, "Copyright (C) 2003-2010 Mark Adler\n"); fprintf(stderr, "usage: gun [-t] [file1.gz [file2.Z ...]]\n"); return 0; } if (argc && strcmp(*argv, "-t") == 0) { test = 1; argc--; argv++; } if (argc) do { if (test) outname = NULL; else { len = (int)strlen(*argv); if (strcmp(*argv + len - 3, ".gz") == 0 || strcmp(*argv + len - 3, "-gz") == 0) len -= 3; else if (strcmp(*argv + len - 2, ".z") == 0 || strcmp(*argv + len - 2, "-z") == 0 || strcmp(*argv + len - 2, "_z") == 0 || strcmp(*argv + len - 2, ".Z") == 0) len -= 2; else { fprintf(stderr, "gun error: no gz type on %s--skipping\n", *argv); continue; } outname = malloc(len + 1); if (outname == NULL) { fprintf(stderr, "gun out of memory error--aborting\n"); ret = 1; break; } memcpy(outname, *argv, len); outname[len] = 0; } ret = gunzip(&strm, *argv, outname, test); if (outname != NULL) free(outname); if (ret) break; } while (argv++, --argc); else ret = gunzip(&strm, NULL, NULL, test); /* clean up */ inflateBackEnd(&strm); return ret; } tcl8.6.14/compat/zlib/examples/README.examples0000644000175000017500000000366214554262142020407 0ustar sergeisergeiThis directory contains examples of the use of zlib and other relevant programs and documentation. enough.c calculation and justification of ENOUGH parameter in inftrees.h - calculates the maximum table space used in inflate tree construction over all possible Huffman codes fitblk.c compress just enough input to nearly fill a requested output size - zlib isn't designed to do this, but fitblk does it anyway gun.c uncompress a gzip file - illustrates the use of inflateBack() for high speed file-to-file decompression using call-back functions - is approximately twice as fast as gzip -d - also provides Unix uncompress functionality, again twice as fast gzappend.c append to a gzip file - illustrates the use of the Z_BLOCK flush parameter for inflate() - illustrates the use of deflatePrime() to start at any bit gzjoin.c join gzip files without recalculating the crc or recompressing - illustrates the use of the Z_BLOCK flush parameter for inflate() - illustrates the use of crc32_combine() gzlog.c gzlog.h efficiently and robustly maintain a message log file in gzip format - illustrates use of raw deflate, Z_PARTIAL_FLUSH, deflatePrime(), and deflateSetDictionary() - illustrates use of a gzip header extra field gznorm.c normalize a gzip file by combining members into a single member - demonstrates how to concatenate deflate streams using Z_BLOCK zlib_how.html painfully comprehensive description of zpipe.c (see below) - describes in excruciating detail the use of deflate() and inflate() zpipe.c reads and writes zlib streams from stdin to stdout - illustrates the proper use of deflate() and inflate() - deeply commented in zlib_how.html (see above) zran.c zran.h index a zlib or gzip stream and randomly access it - illustrates the use of Z_BLOCK, inflatePrime(), and inflateSetDictionary() to provide random access tcl8.6.14/compat/zlib/examples/gznorm.c0000644000175000017500000005324614554262142017375 0ustar sergeisergei/* gznorm.c -- normalize a gzip stream * Copyright (C) 2018 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h * Version 1.0 7 Oct 2018 Mark Adler */ // gznorm takes a gzip stream, potentially containing multiple members, and // converts it to a gzip stream with a single member. In addition the gzip // header is normalized, removing the file name and time stamp, and setting the // other header contents (XFL, OS) to fixed values. gznorm does not recompress // the data, so it is fast, but no advantage is gained from the history that // could be available across member boundaries. #include // fread, fwrite, putc, fflush, ferror, fprintf, // vsnprintf, stdout, stderr, NULL, FILE #include // malloc, free #include // strerror #include // errno #include // va_list, va_start, va_end #include "zlib.h" // inflateInit2, inflate, inflateReset, inflateEnd, // z_stream, z_off_t, crc32_combine, Z_NULL, Z_BLOCK, // Z_OK, Z_STREAM_END, Z_BUF_ERROR, Z_DATA_ERROR, // Z_MEM_ERROR #if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__) # include # include # define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY) #else # define SET_BINARY_MODE(file) #endif #define local static // printf to an allocated string. Return the string, or NULL if the printf or // allocation fails. local char *aprintf(char *fmt, ...) { // Get the length of the result of the printf. va_list args; va_start(args, fmt); int len = vsnprintf(NULL, 0, fmt, args); va_end(args); if (len < 0) return NULL; // Allocate the required space and printf to it. char *str = malloc(len + 1); if (str == NULL) return NULL; va_start(args, fmt); vsnprintf(str, len + 1, fmt, args); va_end(args); return str; } // Return with an error, putting an allocated error message in *err. Doing an // inflateEnd() on an already ended state, or one with state set to Z_NULL, is // permitted. #define BYE(...) \ do { \ inflateEnd(&strm); \ *err = aprintf(__VA_ARGS__); \ return 1; \ } while (0) // Chunk size for buffered reads and for decompression. Twice this many bytes // will be allocated on the stack by gzip_normalize(). Must fit in an unsigned. #define CHUNK 16384 // Read a gzip stream from in and write an equivalent normalized gzip stream to // out. If given no input, an empty gzip stream will be written. If successful, // 0 is returned, and *err is set to NULL. On error, 1 is returned, where the // details of the error are returned in *err, a pointer to an allocated string. // // The input may be a stream with multiple gzip members, which is converted to // a single gzip member on the output. Each gzip member is decompressed at the // level of deflate blocks. This enables clearing the last-block bit, shifting // the compressed data to concatenate to the previous member's compressed data, // which can end at an arbitrary bit boundary, and identifying stored blocks in // order to resynchronize those to byte boundaries. The deflate compressed data // is terminated with a 10-bit empty fixed block. If any members on the input // end with a 10-bit empty fixed block, then that block is excised from the // stream. This avoids appending empty fixed blocks for every normalization, // and assures that gzip_normalize applied a second time will not change the // input. The pad bits after stored block headers and after the final deflate // block are all forced to zeros. local int gzip_normalize(FILE *in, FILE *out, char **err) { // initialize the inflate engine to process a gzip member z_stream strm; strm.zalloc = Z_NULL; strm.zfree = Z_NULL; strm.opaque = Z_NULL; strm.avail_in = 0; strm.next_in = Z_NULL; if (inflateInit2(&strm, 15 + 16) != Z_OK) BYE("out of memory"); // State while processing the input gzip stream. enum { // BETWEEN -> HEAD -> BLOCK -> TAIL -> BETWEEN -> ... BETWEEN, // between gzip members (must end in this state) HEAD, // reading a gzip header BLOCK, // reading deflate blocks TAIL // reading a gzip trailer } state = BETWEEN; // current component being processed unsigned long crc = 0; // accumulated CRC of uncompressed data unsigned long len = 0; // accumulated length of uncompressed data unsigned long buf = 0; // deflate stream bit buffer of num bits int num = 0; // number of bits in buf (at bottom) // Write a canonical gzip header (no mod time, file name, comment, extra // block, or extra flags, and OS is marked as unknown). fwrite("\x1f\x8b\x08\0\0\0\0\0\0\xff", 1, 10, out); // Process the gzip stream from in until reaching the end of the input, // encountering invalid input, or experiencing an i/o error. int more; // true if not at the end of the input do { // State inside this loop. unsigned char *put; // next input buffer location to process int prev; // number of bits from previous block in // the bit buffer, or -1 if not at the // start of a block unsigned long long memb; // uncompressed length of member size_t tail; // number of trailer bytes read (0..8) unsigned long part; // accumulated trailer component // Get the next chunk of input from in. unsigned char dat[CHUNK]; strm.avail_in = fread(dat, 1, CHUNK, in); if (strm.avail_in == 0) break; more = strm.avail_in == CHUNK; strm.next_in = put = dat; // Run that chunk of input through the inflate engine to exhaustion. do { // At this point it is assured that strm.avail_in > 0. // Inflate until the end of a gzip component (header, deflate // block, trailer) is reached, or until all of the chunk is // consumed. The resulting decompressed data is discarded, though // the total size of the decompressed data in each member is // tracked, for the calculation of the total CRC. do { // inflate and handle any errors unsigned char scrap[CHUNK]; strm.avail_out = CHUNK; strm.next_out = scrap; int ret = inflate(&strm, Z_BLOCK); if (ret == Z_MEM_ERROR) BYE("out of memory"); if (ret == Z_DATA_ERROR) BYE("input invalid: %s", strm.msg); if (ret != Z_OK && ret != Z_BUF_ERROR && ret != Z_STREAM_END) BYE("internal error"); // Update the number of uncompressed bytes generated in this // member. The actual count (not modulo 2^32) is required to // correctly compute the total CRC. unsigned got = CHUNK - strm.avail_out; memb += got; if (memb < got) BYE("overflow error"); // Continue to process this chunk until it is consumed, or // until the end of a component (header, deflate block, or // trailer) is reached. } while (strm.avail_out == 0 && (strm.data_type & 0x80) == 0); // Since strm.avail_in was > 0 for the inflate call, some input was // just consumed. It is therefore assured that put < strm.next_in. // Disposition the consumed component or part of a component. switch (state) { case BETWEEN: state = HEAD; // Fall through to HEAD when some or all of the header is // processed. case HEAD: // Discard the header. if (strm.data_type & 0x80) { // End of header reached -- deflate blocks follow. put = strm.next_in; prev = num; memb = 0; state = BLOCK; } break; case BLOCK: // Copy the deflate stream to the output, but with the // last-block-bit cleared. Re-synchronize stored block // headers to the output byte boundaries. The bytes at // put..strm.next_in-1 is the compressed data that has been // processed and is ready to be copied to the output. // At this point, it is assured that new compressed data is // available, i.e., put < strm.next_in. If prev is -1, then // that compressed data starts in the middle of a deflate // block. If prev is not -1, then the bits in the bit // buffer, possibly combined with the bits in *put, contain // the three-bit header of the new deflate block. In that // case, prev is the number of bits from the previous block // that remain in the bit buffer. Since num is the number // of bits in the bit buffer, we have that num - prev is // the number of bits from the new block currently in the // bit buffer. // If strm.data_type & 0xc0 is 0x80, then the last byte of // the available compressed data includes the last bits of // the end of a deflate block. In that case, that last byte // also has strm.data_type & 0x1f bits of the next deflate // block, in the range 0..7. If strm.data_type & 0xc0 is // 0xc0, then the last byte of the compressed data is the // end of the deflate stream, followed by strm.data_type & // 0x1f pad bits, also in the range 0..7. // Set bits to the number of bits not yet consumed from the // last byte. If we are at the end of the block, bits is // either the number of bits in the last byte belonging to // the next block, or the number of pad bits after the // final block. In either of those cases, bits is in the // range 0..7. ; // (required due to C syntax oddity) int bits = strm.data_type & 0x1f; if (prev != -1) { // We are at the start of a new block. Clear the last // block bit, and check for special cases. If it is a // stored block, then emit the header and pad to the // next byte boundary. If it is a final, empty fixed // block, then excise it. // Some or all of the three header bits for this block // may already be in the bit buffer. Load any remaining // header bits into the bit buffer. if (num - prev < 3) { buf += (unsigned long)*put++ << num; num += 8; } // Set last to have a 1 in the position of the last // block bit in the bit buffer. unsigned long last = (unsigned long)1 << prev; if (((buf >> prev) & 7) == 3) { // This is a final fixed block. Load at least ten // bits from this block, including the header, into // the bit buffer. We already have at least three, // so at most one more byte needs to be loaded. if (num - prev < 10) { if (put == strm.next_in) // Need to go get and process more input. // We'll end up back here to finish this. break; buf += (unsigned long)*put++ << num; num += 8; } if (((buf >> prev) & 0x3ff) == 3) { // That final fixed block is empty. Delete it // to avoid adding an empty block every time a // gzip stream is normalized. num = prev; buf &= last - 1; // zero the pad bits } } else if (((buf >> prev) & 6) == 0) { // This is a stored block. Flush to the next // byte boundary after the three-bit header. num = (prev + 10) & ~7; buf &= last - 1; // zero the pad bits } // Clear the last block bit. buf &= ~last; // Write out complete bytes in the bit buffer. while (num >= 8) { putc(buf, out); buf >>= 8; num -= 8; } // If no more bytes left to process, then we have // consumed the byte that had bits from the next block. if (put == strm.next_in) bits = 0; } // We are done handling the deflate block header. Now copy // all or almost all of the remaining compressed data that // has been processed so far. Don't copy one byte at the // end if it contains bits from the next deflate block or // pad bits at the end of a deflate block. // mix is 1 if we are at the end of a deflate block, and if // some of the bits in the last byte follow this block. mix // is 0 if we are in the middle of a deflate block, if the // deflate block ended on a byte boundary, or if all of the // compressed data processed so far has been consumed. int mix = (strm.data_type & 0x80) && bits; // Copy all of the processed compressed data to the output, // except for the last byte if it contains bits from the // next deflate block or pad bits at the end of the deflate // stream. Copy the data after shifting in num bits from // buf in front of it, leaving num bits from the end of the // compressed data in buf when done. unsigned char *end = strm.next_in - mix; if (put < end) { if (num) // Insert num bits from buf before the data being // copied. do { buf += (unsigned)(*put++) << num; putc(buf, out); buf >>= 8; } while (put < end); else { // No shifting needed -- write directly. fwrite(put, 1, end - put, out); put = end; } } // Process the last processed byte if it wasn't written. if (mix) { // Load the last byte into the bit buffer. buf += (unsigned)(*put++) << num; num += 8; if (strm.data_type & 0x40) { // We are at the end of the deflate stream and // there are bits pad bits. Discard the pad bits // and write a byte to the output, if available. // Leave the num bits left over in buf to prepend // to the next deflate stream. num -= bits; if (num >= 8) { putc(buf, out); num -= 8; buf >>= 8; } // Force the pad bits in the bit buffer to zeros. buf &= ((unsigned long)1 << num) - 1; // Don't need to set prev here since going to TAIL. } else // At the end of an internal deflate block. Leave // the last byte in the bit buffer to examine on // the next entry to BLOCK, when more bits from the // next block will be available. prev = num - bits; // number of bits in buffer // from current block } // Don't have a byte left over, so we are in the middle of // a deflate block, or the deflate block ended on a byte // boundary. Set prev appropriately for the next entry into // BLOCK. else if (strm.data_type & 0x80) // The block ended on a byte boundary, so no header // bits are in the bit buffer. prev = num; else // In the middle of a deflate block, so no header here. prev = -1; // Check for the end of the deflate stream. if ((strm.data_type & 0xc0) == 0xc0) { // That ends the deflate stream on the input side, the // pad bits were discarded, and any remaining bits from // the last block in the stream are saved in the bit // buffer to prepend to the next stream. Process the // gzip trailer next. tail = 0; part = 0; state = TAIL; } break; case TAIL: // Accumulate available trailer bytes to update the total // CRC and the total uncompressed length. do { part = (part >> 8) + ((unsigned long)(*put++) << 24); tail++; if (tail == 4) { // Update the total CRC. z_off_t len2 = memb; if (len2 < 0 || (unsigned long long)len2 != memb) BYE("overflow error"); crc = crc ? crc32_combine(crc, part, len2) : part; part = 0; } else if (tail == 8) { // Update the total uncompressed length. (It's ok // if this sum is done modulo 2^32.) len += part; // At the end of a member. Set up to inflate an // immediately following gzip member. (If we made // it this far, then the trailer was valid.) if (inflateReset(&strm) != Z_OK) BYE("internal error"); state = BETWEEN; break; } } while (put < strm.next_in); break; } // Process the input buffer until completely consumed. } while (strm.avail_in > 0); // Process input until end of file, invalid input, or i/o error. } while (more); // Done with the inflate engine. inflateEnd(&strm); // Verify the validity of the input. if (state != BETWEEN) BYE("input invalid: incomplete gzip stream"); // Write the remaining deflate stream bits, followed by a terminating // deflate fixed block. buf += (unsigned long)3 << num; putc(buf, out); putc(buf >> 8, out); if (num > 6) putc(0, out); // Write the gzip trailer, which is the CRC and the uncompressed length // modulo 2^32, both in little-endian order. putc(crc, out); putc(crc >> 8, out); putc(crc >> 16, out); putc(crc >> 24, out); putc(len, out); putc(len >> 8, out); putc(len >> 16, out); putc(len >> 24, out); fflush(out); // Check for any i/o errors. if (ferror(in) || ferror(out)) BYE("i/o error: %s", strerror(errno)); // All good! *err = NULL; return 0; } // Normalize the gzip stream on stdin, writing the result to stdout. int main(void) { // Avoid end-of-line conversions on evil operating systems. SET_BINARY_MODE(stdin); SET_BINARY_MODE(stdout); // Normalize from stdin to stdout, returning 1 on error, 0 if ok. char *err; int ret = gzip_normalize(stdin, stdout, &err); if (ret) fprintf(stderr, "gznorm error: %s\n", err); free(err); return ret; } tcl8.6.14/compat/zlib/examples/gzjoin.c0000644000175000017500000003346414554262142017361 0ustar sergeisergei/* gzjoin -- command to join gzip files into one gzip file Copyright (C) 2004, 2005, 2012 Mark Adler, all rights reserved version 1.2, 14 Aug 2012 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. Mark Adler madler@alumni.caltech.edu */ /* * Change history: * * 1.0 11 Dec 2004 - First version * 1.1 12 Jun 2005 - Changed ssize_t to long for portability * 1.2 14 Aug 2012 - Clean up for z_const usage */ /* gzjoin takes one or more gzip files on the command line and writes out a single gzip file that will uncompress to the concatenation of the uncompressed data from the individual gzip files. gzjoin does this without having to recompress any of the data and without having to calculate a new crc32 for the concatenated uncompressed data. gzjoin does however have to decompress all of the input data in order to find the bits in the compressed data that need to be modified to concatenate the streams. gzjoin does not do an integrity check on the input gzip files other than checking the gzip header and decompressing the compressed data. They are otherwise assumed to be complete and correct. Each joint between gzip files removes at least 18 bytes of previous trailer and subsequent header, and inserts an average of about three bytes to the compressed data in order to connect the streams. The output gzip file has a minimal ten-byte gzip header with no file name or modification time. This program was written to illustrate the use of the Z_BLOCK option of inflate() and the crc32_combine() function. gzjoin will not compile with versions of zlib earlier than 1.2.3. */ #include /* fputs(), fprintf(), fwrite(), putc() */ #include /* exit(), malloc(), free() */ #include /* open() */ #include /* close(), read(), lseek() */ #include "zlib.h" /* crc32(), crc32_combine(), inflateInit2(), inflate(), inflateEnd() */ #define local static /* exit with an error (return a value to allow use in an expression) */ local int bail(char *why1, char *why2) { fprintf(stderr, "gzjoin error: %s%s, output incomplete\n", why1, why2); exit(1); return 0; } /* -- simple buffered file input with access to the buffer -- */ #define CHUNK 32768 /* must be a power of two and fit in unsigned */ /* bin buffered input file type */ typedef struct { char *name; /* name of file for error messages */ int fd; /* file descriptor */ unsigned left; /* bytes remaining at next */ unsigned char *next; /* next byte to read */ unsigned char *buf; /* allocated buffer of length CHUNK */ } bin; /* close a buffered file and free allocated memory */ local void bclose(bin *in) { if (in != NULL) { if (in->fd != -1) close(in->fd); if (in->buf != NULL) free(in->buf); free(in); } } /* open a buffered file for input, return a pointer to type bin, or NULL on failure */ local bin *bopen(char *name) { bin *in; in = malloc(sizeof(bin)); if (in == NULL) return NULL; in->buf = malloc(CHUNK); in->fd = open(name, O_RDONLY, 0); if (in->buf == NULL || in->fd == -1) { bclose(in); return NULL; } in->left = 0; in->next = in->buf; in->name = name; return in; } /* load buffer from file, return -1 on read error, 0 or 1 on success, with 1 indicating that end-of-file was reached */ local int bload(bin *in) { long len; if (in == NULL) return -1; if (in->left != 0) return 0; in->next = in->buf; do { len = (long)read(in->fd, in->buf + in->left, CHUNK - in->left); if (len < 0) return -1; in->left += (unsigned)len; } while (len != 0 && in->left < CHUNK); return len == 0 ? 1 : 0; } /* get a byte from the file, bail if end of file */ #define bget(in) (in->left ? 0 : bload(in), \ in->left ? (in->left--, *(in->next)++) : \ bail("unexpected end of file on ", in->name)) /* get a four-byte little-endian unsigned integer from file */ local unsigned long bget4(bin *in) { unsigned long val; val = bget(in); val += (unsigned long)(bget(in)) << 8; val += (unsigned long)(bget(in)) << 16; val += (unsigned long)(bget(in)) << 24; return val; } /* skip bytes in file */ local void bskip(bin *in, unsigned skip) { /* check pointer */ if (in == NULL) return; /* easy case -- skip bytes in buffer */ if (skip <= in->left) { in->left -= skip; in->next += skip; return; } /* skip what's in buffer, discard buffer contents */ skip -= in->left; in->left = 0; /* seek past multiples of CHUNK bytes */ if (skip > CHUNK) { unsigned left; left = skip & (CHUNK - 1); if (left == 0) { /* exact number of chunks: seek all the way minus one byte to check for end-of-file with a read */ lseek(in->fd, skip - 1, SEEK_CUR); if (read(in->fd, in->buf, 1) != 1) bail("unexpected end of file on ", in->name); return; } /* skip the integral chunks, update skip with remainder */ lseek(in->fd, skip - left, SEEK_CUR); skip = left; } /* read more input and skip remainder */ bload(in); if (skip > in->left) bail("unexpected end of file on ", in->name); in->left -= skip; in->next += skip; } /* -- end of buffered input functions -- */ /* skip the gzip header from file in */ local void gzhead(bin *in) { int flags; /* verify gzip magic header and compression method */ if (bget(in) != 0x1f || bget(in) != 0x8b || bget(in) != 8) bail(in->name, " is not a valid gzip file"); /* get and verify flags */ flags = bget(in); if ((flags & 0xe0) != 0) bail("unknown reserved bits set in ", in->name); /* skip modification time, extra flags, and os */ bskip(in, 6); /* skip extra field if present */ if (flags & 4) { unsigned len; len = bget(in); len += (unsigned)(bget(in)) << 8; bskip(in, len); } /* skip file name if present */ if (flags & 8) while (bget(in) != 0) ; /* skip comment if present */ if (flags & 16) while (bget(in) != 0) ; /* skip header crc if present */ if (flags & 2) bskip(in, 2); } /* write a four-byte little-endian unsigned integer to out */ local void put4(unsigned long val, FILE *out) { putc(val & 0xff, out); putc((val >> 8) & 0xff, out); putc((val >> 16) & 0xff, out); putc((val >> 24) & 0xff, out); } /* Load up zlib stream from buffered input, bail if end of file */ local void zpull(z_streamp strm, bin *in) { if (in->left == 0) bload(in); if (in->left == 0) bail("unexpected end of file on ", in->name); strm->avail_in = in->left; strm->next_in = in->next; } /* Write header for gzip file to out and initialize trailer. */ local void gzinit(unsigned long *crc, unsigned long *tot, FILE *out) { fwrite("\x1f\x8b\x08\0\0\0\0\0\0\xff", 1, 10, out); *crc = crc32(0L, Z_NULL, 0); *tot = 0; } /* Copy the compressed data from name, zeroing the last block bit of the last block if clr is true, and adding empty blocks as needed to get to a byte boundary. If clr is false, then the last block becomes the last block of the output, and the gzip trailer is written. crc and tot maintains the crc and length (modulo 2^32) of the output for the trailer. The resulting gzip file is written to out. gzinit() must be called before the first call of gzcopy() to write the gzip header and to initialize crc and tot. */ local void gzcopy(char *name, int clr, unsigned long *crc, unsigned long *tot, FILE *out) { int ret; /* return value from zlib functions */ int pos; /* where the "last block" bit is in byte */ int last; /* true if processing the last block */ bin *in; /* buffered input file */ unsigned char *start; /* start of compressed data in buffer */ unsigned char *junk; /* buffer for uncompressed data -- discarded */ z_off_t len; /* length of uncompressed data (support > 4 GB) */ z_stream strm; /* zlib inflate stream */ /* open gzip file and skip header */ in = bopen(name); if (in == NULL) bail("could not open ", name); gzhead(in); /* allocate buffer for uncompressed data and initialize raw inflate stream */ junk = malloc(CHUNK); strm.zalloc = Z_NULL; strm.zfree = Z_NULL; strm.opaque = Z_NULL; strm.avail_in = 0; strm.next_in = Z_NULL; ret = inflateInit2(&strm, -15); if (junk == NULL || ret != Z_OK) bail("out of memory", ""); /* inflate and copy compressed data, clear last-block bit if requested */ len = 0; zpull(&strm, in); start = in->next; last = start[0] & 1; if (last && clr) start[0] &= ~1; strm.avail_out = 0; for (;;) { /* if input used and output done, write used input and get more */ if (strm.avail_in == 0 && strm.avail_out != 0) { fwrite(start, 1, strm.next_in - start, out); start = in->buf; in->left = 0; zpull(&strm, in); } /* decompress -- return early when end-of-block reached */ strm.avail_out = CHUNK; strm.next_out = junk; ret = inflate(&strm, Z_BLOCK); switch (ret) { case Z_MEM_ERROR: bail("out of memory", ""); case Z_DATA_ERROR: bail("invalid compressed data in ", in->name); } /* update length of uncompressed data */ len += CHUNK - strm.avail_out; /* check for block boundary (only get this when block copied out) */ if (strm.data_type & 128) { /* if that was the last block, then done */ if (last) break; /* number of unused bits in last byte */ pos = strm.data_type & 7; /* find the next last-block bit */ if (pos != 0) { /* next last-block bit is in last used byte */ pos = 0x100 >> pos; last = strm.next_in[-1] & pos; if (last && clr) in->buf[strm.next_in - in->buf - 1] &= ~pos; } else { /* next last-block bit is in next unused byte */ if (strm.avail_in == 0) { /* don't have that byte yet -- get it */ fwrite(start, 1, strm.next_in - start, out); start = in->buf; in->left = 0; zpull(&strm, in); } last = strm.next_in[0] & 1; if (last && clr) in->buf[strm.next_in - in->buf] &= ~1; } } } /* update buffer with unused input */ in->left = strm.avail_in; in->next = in->buf + (strm.next_in - in->buf); /* copy used input, write empty blocks to get to byte boundary */ pos = strm.data_type & 7; fwrite(start, 1, in->next - start - 1, out); last = in->next[-1]; if (pos == 0 || !clr) /* already at byte boundary, or last file: write last byte */ putc(last, out); else { /* append empty blocks to last byte */ last &= ((0x100 >> pos) - 1); /* assure unused bits are zero */ if (pos & 1) { /* odd -- append an empty stored block */ putc(last, out); if (pos == 1) putc(0, out); /* two more bits in block header */ fwrite("\0\0\xff\xff", 1, 4, out); } else { /* even -- append 1, 2, or 3 empty fixed blocks */ switch (pos) { case 6: putc(last | 8, out); last = 0; case 4: putc(last | 0x20, out); last = 0; case 2: putc(last | 0x80, out); putc(0, out); } } } /* update crc and tot */ *crc = crc32_combine(*crc, bget4(in), len); *tot += (unsigned long)len; /* clean up */ inflateEnd(&strm); free(junk); bclose(in); /* write trailer if this is the last gzip file */ if (!clr) { put4(*crc, out); put4(*tot, out); } } /* join the gzip files on the command line, write result to stdout */ int main(int argc, char **argv) { unsigned long crc, tot; /* running crc and total uncompressed length */ /* skip command name */ argc--; argv++; /* show usage if no arguments */ if (argc == 0) { fputs("gzjoin usage: gzjoin f1.gz [f2.gz [f3.gz ...]] > fjoin.gz\n", stderr); return 0; } /* join gzip files on command line and write to stdout */ gzinit(&crc, &tot, stdout); while (argc--) gzcopy(*argv++, argc, &crc, &tot, stdout); /* done */ return 0; } tcl8.6.14/compat/zlib/inflate.c0000644000175000017500000015433714560736524015677 0ustar sergeisergei/* inflate.c -- zlib decompression * Copyright (C) 1995-2022 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* * Change history: * * 1.2.beta0 24 Nov 2002 * - First version -- complete rewrite of inflate to simplify code, avoid * creation of window when not needed, minimize use of window when it is * needed, make inffast.c even faster, implement gzip decoding, and to * improve code readability and style over the previous zlib inflate code * * 1.2.beta1 25 Nov 2002 * - Use pointers for available input and output checking in inffast.c * - Remove input and output counters in inffast.c * - Change inffast.c entry and loop from avail_in >= 7 to >= 6 * - Remove unnecessary second byte pull from length extra in inffast.c * - Unroll direct copy to three copies per loop in inffast.c * * 1.2.beta2 4 Dec 2002 * - Change external routine names to reduce potential conflicts * - Correct filename to inffixed.h for fixed tables in inflate.c * - Make hbuf[] unsigned char to match parameter type in inflate.c * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset) * to avoid negation problem on Alphas (64 bit) in inflate.c * * 1.2.beta3 22 Dec 2002 * - Add comments on state->bits assertion in inffast.c * - Add comments on op field in inftrees.h * - Fix bug in reuse of allocated window after inflateReset() * - Remove bit fields--back to byte structure for speed * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths * - Change post-increments to pre-increments in inflate_fast(), PPC biased? * - Add compile time option, POSTINC, to use post-increments instead (Intel?) * - Make MATCH copy in inflate() much faster for when inflate_fast() not used * - Use local copies of stream next and avail values, as well as local bit * buffer and bit count in inflate()--for speed when inflate_fast() not used * * 1.2.beta4 1 Jan 2003 * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings * - Move a comment on output buffer sizes from inffast.c to inflate.c * - Add comments in inffast.c to introduce the inflate_fast() routine * - Rearrange window copies in inflate_fast() for speed and simplification * - Unroll last copy for window match in inflate_fast() * - Use local copies of window variables in inflate_fast() for speed * - Pull out common wnext == 0 case for speed in inflate_fast() * - Make op and len in inflate_fast() unsigned for consistency * - Add FAR to lcode and dcode declarations in inflate_fast() * - Simplified bad distance check in inflate_fast() * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new * source file infback.c to provide a call-back interface to inflate for * programs like gzip and unzip -- uses window as output buffer to avoid * window copying * * 1.2.beta5 1 Jan 2003 * - Improved inflateBack() interface to allow the caller to provide initial * input in strm. * - Fixed stored blocks bug in inflateBack() * * 1.2.beta6 4 Jan 2003 * - Added comments in inffast.c on effectiveness of POSTINC * - Typecasting all around to reduce compiler warnings * - Changed loops from while (1) or do {} while (1) to for (;;), again to * make compilers happy * - Changed type of window in inflateBackInit() to unsigned char * * * 1.2.beta7 27 Jan 2003 * - Changed many types to unsigned or unsigned short to avoid warnings * - Added inflateCopy() function * * 1.2.0 9 Mar 2003 * - Changed inflateBack() interface to provide separate opaque descriptors * for the in() and out() functions * - Changed inflateBack() argument and in_func typedef to swap the length * and buffer address return values for the input function * - Check next_in and next_out for Z_NULL on entry to inflate() * * The history for versions after 1.2.0 are in ChangeLog in zlib distribution. */ #include "zutil.h" #include "inftrees.h" #include "inflate.h" #include "inffast.h" #ifdef MAKEFIXED # ifndef BUILDFIXED # define BUILDFIXED # endif #endif local int inflateStateCheck(z_streamp strm) { struct inflate_state FAR *state; if (strm == Z_NULL || strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) return 1; state = (struct inflate_state FAR *)strm->state; if (state == Z_NULL || state->strm != strm || state->mode < HEAD || state->mode > SYNC) return 1; return 0; } int ZEXPORT inflateResetKeep(z_streamp strm) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; strm->total_in = strm->total_out = state->total = 0; strm->msg = Z_NULL; if (state->wrap) /* to support ill-conceived Java test suite */ strm->adler = state->wrap & 1; state->mode = HEAD; state->last = 0; state->havedict = 0; state->flags = -1; state->dmax = 32768U; state->head = Z_NULL; state->hold = 0; state->bits = 0; state->lencode = state->distcode = state->next = state->codes; state->sane = 1; state->back = -1; Tracev((stderr, "inflate: reset\n")); return Z_OK; } int ZEXPORT inflateReset(z_streamp strm) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; state->wsize = 0; state->whave = 0; state->wnext = 0; return inflateResetKeep(strm); } int ZEXPORT inflateReset2(z_streamp strm, int windowBits) { int wrap; struct inflate_state FAR *state; /* get the state */ if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; /* extract wrap request from windowBits parameter */ if (windowBits < 0) { if (windowBits < -15) return Z_STREAM_ERROR; wrap = 0; windowBits = -windowBits; } else { wrap = (windowBits >> 4) + 5; #ifdef GUNZIP if (windowBits < 48) windowBits &= 15; #endif } /* set number of window bits, free window if different */ if (windowBits && (windowBits < 8 || windowBits > 15)) return Z_STREAM_ERROR; if (state->window != Z_NULL && state->wbits != (unsigned)windowBits) { ZFREE(strm, state->window); state->window = Z_NULL; } /* update state and reset the rest of it */ state->wrap = wrap; state->wbits = (unsigned)windowBits; return inflateReset(strm); } int ZEXPORT inflateInit2_(z_streamp strm, int windowBits, const char *version, int stream_size) { int ret; struct inflate_state FAR *state; if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || stream_size != (int)(sizeof(z_stream))) return Z_VERSION_ERROR; if (strm == Z_NULL) return Z_STREAM_ERROR; strm->msg = Z_NULL; /* in case we return an error */ if (strm->zalloc == (alloc_func)0) { #ifdef Z_SOLO return Z_STREAM_ERROR; #else strm->zalloc = zcalloc; strm->opaque = (voidpf)0; #endif } if (strm->zfree == (free_func)0) #ifdef Z_SOLO return Z_STREAM_ERROR; #else strm->zfree = zcfree; #endif state = (struct inflate_state FAR *) ZALLOC(strm, 1, sizeof(struct inflate_state)); if (state == Z_NULL) return Z_MEM_ERROR; Tracev((stderr, "inflate: allocated\n")); strm->state = (struct internal_state FAR *)state; state->strm = strm; state->window = Z_NULL; state->mode = HEAD; /* to pass state test in inflateReset2() */ ret = inflateReset2(strm, windowBits); if (ret != Z_OK) { ZFREE(strm, state); strm->state = Z_NULL; } return ret; } int ZEXPORT inflateInit_(z_streamp strm, const char *version, int stream_size) { return inflateInit2_(strm, DEF_WBITS, version, stream_size); } int ZEXPORT inflatePrime(z_streamp strm, int bits, int value) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return Z_STREAM_ERROR; if (bits == 0) return Z_OK; state = (struct inflate_state FAR *)strm->state; if (bits < 0) { state->hold = 0; state->bits = 0; return Z_OK; } if (bits > 16 || state->bits + (uInt)bits > 32) return Z_STREAM_ERROR; value &= (1L << bits) - 1; state->hold += (unsigned)value << state->bits; state->bits += (uInt)bits; return Z_OK; } /* Return state with length and distance decoding tables and index sizes set to fixed code decoding. Normally this returns fixed tables from inffixed.h. If BUILDFIXED is defined, then instead this routine builds the tables the first time it's called, and returns those tables the first time and thereafter. This reduces the size of the code by about 2K bytes, in exchange for a little execution time. However, BUILDFIXED should not be used for threaded applications, since the rewriting of the tables and virgin may not be thread-safe. */ local void fixedtables(struct inflate_state FAR *state) { #ifdef BUILDFIXED static int virgin = 1; static code *lenfix, *distfix; static code fixed[544]; /* build fixed huffman tables if first call (may not be thread safe) */ if (virgin) { unsigned sym, bits; static code *next; /* literal/length table */ sym = 0; while (sym < 144) state->lens[sym++] = 8; while (sym < 256) state->lens[sym++] = 9; while (sym < 280) state->lens[sym++] = 7; while (sym < 288) state->lens[sym++] = 8; next = fixed; lenfix = next; bits = 9; inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); /* distance table */ sym = 0; while (sym < 32) state->lens[sym++] = 5; distfix = next; bits = 5; inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); /* do this just once */ virgin = 0; } #else /* !BUILDFIXED */ # include "inffixed.h" #endif /* BUILDFIXED */ state->lencode = lenfix; state->lenbits = 9; state->distcode = distfix; state->distbits = 5; } #ifdef MAKEFIXED #include /* Write out the inffixed.h that is #include'd above. Defining MAKEFIXED also defines BUILDFIXED, so the tables are built on the fly. makefixed() writes those tables to stdout, which would be piped to inffixed.h. A small program can simply call makefixed to do this: void makefixed(void); int main(void) { makefixed(); return 0; } Then that can be linked with zlib built with MAKEFIXED defined and run: a.out > inffixed.h */ void makefixed(void) { unsigned low, size; struct inflate_state state; fixedtables(&state); puts(" /* inffixed.h -- table for decoding fixed codes"); puts(" * Generated automatically by makefixed()."); puts(" */"); puts(""); puts(" /* WARNING: this file should *not* be used by applications."); puts(" It is part of the implementation of this library and is"); puts(" subject to change. Applications should only use zlib.h."); puts(" */"); puts(""); size = 1U << 9; printf(" static const code lenfix[%u] = {", size); low = 0; for (;;) { if ((low % 7) == 0) printf("\n "); printf("{%u,%u,%d}", (low & 127) == 99 ? 64 : state.lencode[low].op, state.lencode[low].bits, state.lencode[low].val); if (++low == size) break; putchar(','); } puts("\n };"); size = 1U << 5; printf("\n static const code distfix[%u] = {", size); low = 0; for (;;) { if ((low % 6) == 0) printf("\n "); printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits, state.distcode[low].val); if (++low == size) break; putchar(','); } puts("\n };"); } #endif /* MAKEFIXED */ /* Update the window with the last wsize (normally 32K) bytes written before returning. If window does not exist yet, create it. This is only called when a window is already in use, or when output has been written during this inflate call, but the end of the deflate stream has not been reached yet. It is also called to create a window for dictionary data when a dictionary is loaded. Providing output buffers larger than 32K to inflate() should provide a speed advantage, since only the last 32K of output is copied to the sliding window upon return from inflate(), and since all distances after the first 32K of output will fall in the output data, making match copies simpler and faster. The advantage may be dependent on the size of the processor's data caches. */ local int updatewindow(z_streamp strm, const Bytef *end, unsigned copy) { struct inflate_state FAR *state; unsigned dist; state = (struct inflate_state FAR *)strm->state; /* if it hasn't been done already, allocate space for the window */ if (state->window == Z_NULL) { state->window = (unsigned char FAR *) ZALLOC(strm, 1U << state->wbits, sizeof(unsigned char)); if (state->window == Z_NULL) return 1; } /* if window not in use yet, initialize */ if (state->wsize == 0) { state->wsize = 1U << state->wbits; state->wnext = 0; state->whave = 0; } /* copy state->wsize or less output bytes into the circular window */ if (copy >= state->wsize) { zmemcpy(state->window, end - state->wsize, state->wsize); state->wnext = 0; state->whave = state->wsize; } else { dist = state->wsize - state->wnext; if (dist > copy) dist = copy; zmemcpy(state->window + state->wnext, end - copy, dist); copy -= dist; if (copy) { zmemcpy(state->window, end - copy, copy); state->wnext = copy; state->whave = state->wsize; } else { state->wnext += dist; if (state->wnext == state->wsize) state->wnext = 0; if (state->whave < state->wsize) state->whave += dist; } } return 0; } /* Macros for inflate(): */ /* check function to use adler32() for zlib or crc32() for gzip */ #ifdef GUNZIP # define UPDATE_CHECK(check, buf, len) \ (state->flags ? crc32(check, buf, len) : adler32(check, buf, len)) #else # define UPDATE_CHECK(check, buf, len) adler32(check, buf, len) #endif /* check macros for header crc */ #ifdef GUNZIP # define CRC2(check, word) \ do { \ hbuf[0] = (unsigned char)(word); \ hbuf[1] = (unsigned char)((word) >> 8); \ check = crc32(check, hbuf, 2); \ } while (0) # define CRC4(check, word) \ do { \ hbuf[0] = (unsigned char)(word); \ hbuf[1] = (unsigned char)((word) >> 8); \ hbuf[2] = (unsigned char)((word) >> 16); \ hbuf[3] = (unsigned char)((word) >> 24); \ check = crc32(check, hbuf, 4); \ } while (0) #endif /* Load registers with state in inflate() for speed */ #define LOAD() \ do { \ put = strm->next_out; \ left = strm->avail_out; \ next = strm->next_in; \ have = strm->avail_in; \ hold = state->hold; \ bits = state->bits; \ } while (0) /* Restore state from registers in inflate() */ #define RESTORE() \ do { \ strm->next_out = put; \ strm->avail_out = left; \ strm->next_in = next; \ strm->avail_in = have; \ state->hold = hold; \ state->bits = bits; \ } while (0) /* Clear the input bit accumulator */ #define INITBITS() \ do { \ hold = 0; \ bits = 0; \ } while (0) /* Get a byte of input into the bit accumulator, or return from inflate() if there is no input available. */ #define PULLBYTE() \ do { \ if (have == 0) goto inf_leave; \ have--; \ hold += (unsigned long)(*next++) << bits; \ bits += 8; \ } while (0) /* Assure that there are at least n bits in the bit accumulator. If there is not enough available input to do that, then return from inflate(). */ #define NEEDBITS(n) \ do { \ while (bits < (unsigned)(n)) \ PULLBYTE(); \ } while (0) /* Return the low n bits of the bit accumulator (n < 16) */ #define BITS(n) \ ((unsigned)hold & ((1U << (n)) - 1)) /* Remove n bits from the bit accumulator */ #define DROPBITS(n) \ do { \ hold >>= (n); \ bits -= (unsigned)(n); \ } while (0) /* Remove zero to seven bits as needed to go to a byte boundary */ #define BYTEBITS() \ do { \ hold >>= bits & 7; \ bits -= bits & 7; \ } while (0) /* inflate() uses a state machine to process as much input data and generate as much output data as possible before returning. The state machine is structured roughly as follows: for (;;) switch (state) { ... case STATEn: if (not enough input data or output space to make progress) return; ... make progress ... state = STATEm; break; ... } so when inflate() is called again, the same case is attempted again, and if the appropriate resources are provided, the machine proceeds to the next state. The NEEDBITS() macro is usually the way the state evaluates whether it can proceed or should return. NEEDBITS() does the return if the requested bits are not available. The typical use of the BITS macros is: NEEDBITS(n); ... do something with BITS(n) ... DROPBITS(n); where NEEDBITS(n) either returns from inflate() if there isn't enough input left to load n bits into the accumulator, or it continues. BITS(n) gives the low n bits in the accumulator. When done, DROPBITS(n) drops the low n bits off the accumulator. INITBITS() clears the accumulator and sets the number of available bits to zero. BYTEBITS() discards just enough bits to put the accumulator on a byte boundary. After BYTEBITS() and a NEEDBITS(8), then BITS(8) would return the next byte in the stream. NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return if there is no input available. The decoding of variable length codes uses PULLBYTE() directly in order to pull just enough bytes to decode the next code, and no more. Some states loop until they get enough input, making sure that enough state information is maintained to continue the loop where it left off if NEEDBITS() returns in the loop. For example, want, need, and keep would all have to actually be part of the saved state in case NEEDBITS() returns: case STATEw: while (want < need) { NEEDBITS(n); keep[want++] = BITS(n); DROPBITS(n); } state = STATEx; case STATEx: As shown above, if the next state is also the next case, then the break is omitted. A state may also return if there is not enough output space available to complete that state. Those states are copying stored data, writing a literal byte, and copying a matching string. When returning, a "goto inf_leave" is used to update the total counters, update the check value, and determine whether any progress has been made during that inflate() call in order to return the proper return code. Progress is defined as a change in either strm->avail_in or strm->avail_out. When there is a window, goto inf_leave will update the window with the last output written. If a goto inf_leave occurs in the middle of decompression and there is no window currently, goto inf_leave will create one and copy output to the window for the next call of inflate(). In this implementation, the flush parameter of inflate() only affects the return code (per zlib.h). inflate() always writes as much as possible to strm->next_out, given the space available and the provided input--the effect documented in zlib.h of Z_SYNC_FLUSH. Furthermore, inflate() always defers the allocation of and copying into a sliding window until necessary, which provides the effect documented in zlib.h for Z_FINISH when the entire input stream available. So the only thing the flush parameter actually does is: when flush is set to Z_FINISH, inflate() cannot return Z_OK. Instead it will return Z_BUF_ERROR if it has not reached the end of the stream. */ int ZEXPORT inflate(z_streamp strm, int flush) { struct inflate_state FAR *state; z_const unsigned char FAR *next; /* next input */ unsigned char FAR *put; /* next output */ unsigned have, left; /* available input and output */ unsigned long hold; /* bit buffer */ unsigned bits; /* bits in bit buffer */ unsigned in, out; /* save starting available input and output */ unsigned copy; /* number of stored or match bytes to copy */ unsigned char FAR *from; /* where to copy match bytes from */ code here; /* current decoding table entry */ code last; /* parent table entry */ unsigned len; /* length to copy for repeats, bits to drop */ int ret; /* return code */ #ifdef GUNZIP unsigned char hbuf[4]; /* buffer for gzip header crc calculation */ #endif static const unsigned short order[19] = /* permutation of code lengths */ {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; if (inflateStateCheck(strm) || strm->next_out == Z_NULL || (strm->next_in == Z_NULL && strm->avail_in != 0)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; if (state->mode == TYPE) state->mode = TYPEDO; /* skip check */ LOAD(); in = have; out = left; ret = Z_OK; for (;;) switch (state->mode) { case HEAD: if (state->wrap == 0) { state->mode = TYPEDO; break; } NEEDBITS(16); #ifdef GUNZIP if ((state->wrap & 2) && hold == 0x8b1f) { /* gzip header */ if (state->wbits == 0) state->wbits = 15; state->check = crc32(0L, Z_NULL, 0); CRC2(state->check, hold); INITBITS(); state->mode = FLAGS; break; } if (state->head != Z_NULL) state->head->done = -1; if (!(state->wrap & 1) || /* check if zlib header allowed */ #else if ( #endif ((BITS(8) << 8) + (hold >> 8)) % 31) { strm->msg = (char *)"incorrect header check"; state->mode = BAD; break; } if (BITS(4) != Z_DEFLATED) { strm->msg = (char *)"unknown compression method"; state->mode = BAD; break; } DROPBITS(4); len = BITS(4) + 8; if (state->wbits == 0) state->wbits = len; if (len > 15 || len > state->wbits) { strm->msg = (char *)"invalid window size"; state->mode = BAD; break; } state->dmax = 1U << len; state->flags = 0; /* indicate zlib header */ Tracev((stderr, "inflate: zlib header ok\n")); strm->adler = state->check = adler32(0L, Z_NULL, 0); state->mode = hold & 0x200 ? DICTID : TYPE; INITBITS(); break; #ifdef GUNZIP case FLAGS: NEEDBITS(16); state->flags = (int)(hold); if ((state->flags & 0xff) != Z_DEFLATED) { strm->msg = (char *)"unknown compression method"; state->mode = BAD; break; } if (state->flags & 0xe000) { strm->msg = (char *)"unknown header flags set"; state->mode = BAD; break; } if (state->head != Z_NULL) state->head->text = (int)((hold >> 8) & 1); if ((state->flags & 0x0200) && (state->wrap & 4)) CRC2(state->check, hold); INITBITS(); state->mode = TIME; /* fallthrough */ case TIME: NEEDBITS(32); if (state->head != Z_NULL) state->head->time = hold; if ((state->flags & 0x0200) && (state->wrap & 4)) CRC4(state->check, hold); INITBITS(); state->mode = OS; /* fallthrough */ case OS: NEEDBITS(16); if (state->head != Z_NULL) { state->head->xflags = (int)(hold & 0xff); state->head->os = (int)(hold >> 8); } if ((state->flags & 0x0200) && (state->wrap & 4)) CRC2(state->check, hold); INITBITS(); state->mode = EXLEN; /* fallthrough */ case EXLEN: if (state->flags & 0x0400) { NEEDBITS(16); state->length = (unsigned)(hold); if (state->head != Z_NULL) state->head->extra_len = (unsigned)hold; if ((state->flags & 0x0200) && (state->wrap & 4)) CRC2(state->check, hold); INITBITS(); } else if (state->head != Z_NULL) state->head->extra = Z_NULL; state->mode = EXTRA; /* fallthrough */ case EXTRA: if (state->flags & 0x0400) { copy = state->length; if (copy > have) copy = have; if (copy) { if (state->head != Z_NULL && state->head->extra != Z_NULL && (len = state->head->extra_len - state->length) < state->head->extra_max) { zmemcpy(state->head->extra + len, next, len + copy > state->head->extra_max ? state->head->extra_max - len : copy); } if ((state->flags & 0x0200) && (state->wrap & 4)) state->check = crc32(state->check, next, copy); have -= copy; next += copy; state->length -= copy; } if (state->length) goto inf_leave; } state->length = 0; state->mode = NAME; /* fallthrough */ case NAME: if (state->flags & 0x0800) { if (have == 0) goto inf_leave; copy = 0; do { len = (unsigned)(next[copy++]); if (state->head != Z_NULL && state->head->name != Z_NULL && state->length < state->head->name_max) state->head->name[state->length++] = (Bytef)len; } while (len && copy < have); if ((state->flags & 0x0200) && (state->wrap & 4)) state->check = crc32(state->check, next, copy); have -= copy; next += copy; if (len) goto inf_leave; } else if (state->head != Z_NULL) state->head->name = Z_NULL; state->length = 0; state->mode = COMMENT; /* fallthrough */ case COMMENT: if (state->flags & 0x1000) { if (have == 0) goto inf_leave; copy = 0; do { len = (unsigned)(next[copy++]); if (state->head != Z_NULL && state->head->comment != Z_NULL && state->length < state->head->comm_max) state->head->comment[state->length++] = (Bytef)len; } while (len && copy < have); if ((state->flags & 0x0200) && (state->wrap & 4)) state->check = crc32(state->check, next, copy); have -= copy; next += copy; if (len) goto inf_leave; } else if (state->head != Z_NULL) state->head->comment = Z_NULL; state->mode = HCRC; /* fallthrough */ case HCRC: if (state->flags & 0x0200) { NEEDBITS(16); if ((state->wrap & 4) && hold != (state->check & 0xffff)) { strm->msg = (char *)"header crc mismatch"; state->mode = BAD; break; } INITBITS(); } if (state->head != Z_NULL) { state->head->hcrc = (int)((state->flags >> 9) & 1); state->head->done = 1; } strm->adler = state->check = crc32(0L, Z_NULL, 0); state->mode = TYPE; break; #endif case DICTID: NEEDBITS(32); strm->adler = state->check = ZSWAP32(hold); INITBITS(); state->mode = DICT; /* fallthrough */ case DICT: if (state->havedict == 0) { RESTORE(); return Z_NEED_DICT; } strm->adler = state->check = adler32(0L, Z_NULL, 0); state->mode = TYPE; /* fallthrough */ case TYPE: if (flush == Z_BLOCK || flush == Z_TREES) goto inf_leave; /* fallthrough */ case TYPEDO: if (state->last) { BYTEBITS(); state->mode = CHECK; break; } NEEDBITS(3); state->last = BITS(1); DROPBITS(1); switch (BITS(2)) { case 0: /* stored block */ Tracev((stderr, "inflate: stored block%s\n", state->last ? " (last)" : "")); state->mode = STORED; break; case 1: /* fixed block */ fixedtables(state); Tracev((stderr, "inflate: fixed codes block%s\n", state->last ? " (last)" : "")); state->mode = LEN_; /* decode codes */ if (flush == Z_TREES) { DROPBITS(2); goto inf_leave; } break; case 2: /* dynamic block */ Tracev((stderr, "inflate: dynamic codes block%s\n", state->last ? " (last)" : "")); state->mode = TABLE; break; case 3: strm->msg = (char *)"invalid block type"; state->mode = BAD; } DROPBITS(2); break; case STORED: BYTEBITS(); /* go to byte boundary */ NEEDBITS(32); if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { strm->msg = (char *)"invalid stored block lengths"; state->mode = BAD; break; } state->length = (unsigned)hold & 0xffff; Tracev((stderr, "inflate: stored length %u\n", state->length)); INITBITS(); state->mode = COPY_; if (flush == Z_TREES) goto inf_leave; /* fallthrough */ case COPY_: state->mode = COPY; /* fallthrough */ case COPY: copy = state->length; if (copy) { if (copy > have) copy = have; if (copy > left) copy = left; if (copy == 0) goto inf_leave; zmemcpy(put, next, copy); have -= copy; next += copy; left -= copy; put += copy; state->length -= copy; break; } Tracev((stderr, "inflate: stored end\n")); state->mode = TYPE; break; case TABLE: NEEDBITS(14); state->nlen = BITS(5) + 257; DROPBITS(5); state->ndist = BITS(5) + 1; DROPBITS(5); state->ncode = BITS(4) + 4; DROPBITS(4); #ifndef PKZIP_BUG_WORKAROUND if (state->nlen > 286 || state->ndist > 30) { strm->msg = (char *)"too many length or distance symbols"; state->mode = BAD; break; } #endif Tracev((stderr, "inflate: table sizes ok\n")); state->have = 0; state->mode = LENLENS; /* fallthrough */ case LENLENS: while (state->have < state->ncode) { NEEDBITS(3); state->lens[order[state->have++]] = (unsigned short)BITS(3); DROPBITS(3); } while (state->have < 19) state->lens[order[state->have++]] = 0; state->next = state->codes; state->lencode = (const code FAR *)(state->next); state->lenbits = 7; ret = inflate_table(CODES, state->lens, 19, &(state->next), &(state->lenbits), state->work); if (ret) { strm->msg = (char *)"invalid code lengths set"; state->mode = BAD; break; } Tracev((stderr, "inflate: code lengths ok\n")); state->have = 0; state->mode = CODELENS; /* fallthrough */ case CODELENS: while (state->have < state->nlen + state->ndist) { for (;;) { here = state->lencode[BITS(state->lenbits)]; if ((unsigned)(here.bits) <= bits) break; PULLBYTE(); } if (here.val < 16) { DROPBITS(here.bits); state->lens[state->have++] = here.val; } else { if (here.val == 16) { NEEDBITS(here.bits + 2); DROPBITS(here.bits); if (state->have == 0) { strm->msg = (char *)"invalid bit length repeat"; state->mode = BAD; break; } len = state->lens[state->have - 1]; copy = 3 + BITS(2); DROPBITS(2); } else if (here.val == 17) { NEEDBITS(here.bits + 3); DROPBITS(here.bits); len = 0; copy = 3 + BITS(3); DROPBITS(3); } else { NEEDBITS(here.bits + 7); DROPBITS(here.bits); len = 0; copy = 11 + BITS(7); DROPBITS(7); } if (state->have + copy > state->nlen + state->ndist) { strm->msg = (char *)"invalid bit length repeat"; state->mode = BAD; break; } while (copy--) state->lens[state->have++] = (unsigned short)len; } } /* handle error breaks in while */ if (state->mode == BAD) break; /* check for end-of-block code (better have one) */ if (state->lens[256] == 0) { strm->msg = (char *)"invalid code -- missing end-of-block"; state->mode = BAD; break; } /* build code tables -- note: do not change the lenbits or distbits values here (9 and 6) without reading the comments in inftrees.h concerning the ENOUGH constants, which depend on those values */ state->next = state->codes; state->lencode = (const code FAR *)(state->next); state->lenbits = 9; ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), &(state->lenbits), state->work); if (ret) { strm->msg = (char *)"invalid literal/lengths set"; state->mode = BAD; break; } state->distcode = (const code FAR *)(state->next); state->distbits = 6; ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, &(state->next), &(state->distbits), state->work); if (ret) { strm->msg = (char *)"invalid distances set"; state->mode = BAD; break; } Tracev((stderr, "inflate: codes ok\n")); state->mode = LEN_; if (flush == Z_TREES) goto inf_leave; /* fallthrough */ case LEN_: state->mode = LEN; /* fallthrough */ case LEN: if (have >= 6 && left >= 258) { RESTORE(); inflate_fast(strm, out); LOAD(); if (state->mode == TYPE) state->back = -1; break; } state->back = 0; for (;;) { here = state->lencode[BITS(state->lenbits)]; if ((unsigned)(here.bits) <= bits) break; PULLBYTE(); } if (here.op && (here.op & 0xf0) == 0) { last = here; for (;;) { here = state->lencode[last.val + (BITS(last.bits + last.op) >> last.bits)]; if ((unsigned)(last.bits + here.bits) <= bits) break; PULLBYTE(); } DROPBITS(last.bits); state->back += last.bits; } DROPBITS(here.bits); state->back += here.bits; state->length = (unsigned)here.val; if ((int)(here.op) == 0) { Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ? "inflate: literal '%c'\n" : "inflate: literal 0x%02x\n", here.val)); state->mode = LIT; break; } if (here.op & 32) { Tracevv((stderr, "inflate: end of block\n")); state->back = -1; state->mode = TYPE; break; } if (here.op & 64) { strm->msg = (char *)"invalid literal/length code"; state->mode = BAD; break; } state->extra = (unsigned)(here.op) & 15; state->mode = LENEXT; /* fallthrough */ case LENEXT: if (state->extra) { NEEDBITS(state->extra); state->length += BITS(state->extra); DROPBITS(state->extra); state->back += state->extra; } Tracevv((stderr, "inflate: length %u\n", state->length)); state->was = state->length; state->mode = DIST; /* fallthrough */ case DIST: for (;;) { here = state->distcode[BITS(state->distbits)]; if ((unsigned)(here.bits) <= bits) break; PULLBYTE(); } if ((here.op & 0xf0) == 0) { last = here; for (;;) { here = state->distcode[last.val + (BITS(last.bits + last.op) >> last.bits)]; if ((unsigned)(last.bits + here.bits) <= bits) break; PULLBYTE(); } DROPBITS(last.bits); state->back += last.bits; } DROPBITS(here.bits); state->back += here.bits; if (here.op & 64) { strm->msg = (char *)"invalid distance code"; state->mode = BAD; break; } state->offset = (unsigned)here.val; state->extra = (unsigned)(here.op) & 15; state->mode = DISTEXT; /* fallthrough */ case DISTEXT: if (state->extra) { NEEDBITS(state->extra); state->offset += BITS(state->extra); DROPBITS(state->extra); state->back += state->extra; } #ifdef INFLATE_STRICT if (state->offset > state->dmax) { strm->msg = (char *)"invalid distance too far back"; state->mode = BAD; break; } #endif Tracevv((stderr, "inflate: distance %u\n", state->offset)); state->mode = MATCH; /* fallthrough */ case MATCH: if (left == 0) goto inf_leave; copy = out - left; if (state->offset > copy) { /* copy from window */ copy = state->offset - copy; if (copy > state->whave) { if (state->sane) { strm->msg = (char *)"invalid distance too far back"; state->mode = BAD; break; } #ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR Trace((stderr, "inflate.c too far\n")); copy -= state->whave; if (copy > state->length) copy = state->length; if (copy > left) copy = left; left -= copy; state->length -= copy; do { *put++ = 0; } while (--copy); if (state->length == 0) state->mode = LEN; break; #endif } if (copy > state->wnext) { copy -= state->wnext; from = state->window + (state->wsize - copy); } else from = state->window + (state->wnext - copy); if (copy > state->length) copy = state->length; } else { /* copy from output */ from = put - state->offset; copy = state->length; } if (copy > left) copy = left; left -= copy; state->length -= copy; do { *put++ = *from++; } while (--copy); if (state->length == 0) state->mode = LEN; break; case LIT: if (left == 0) goto inf_leave; *put++ = (unsigned char)(state->length); left--; state->mode = LEN; break; case CHECK: if (state->wrap) { NEEDBITS(32); out -= left; strm->total_out += out; state->total += out; if ((state->wrap & 4) && out) strm->adler = state->check = UPDATE_CHECK(state->check, put - out, out); out = left; if ((state->wrap & 4) && ( #ifdef GUNZIP state->flags ? hold : #endif ZSWAP32(hold)) != state->check) { strm->msg = (char *)"incorrect data check"; state->mode = BAD; break; } INITBITS(); Tracev((stderr, "inflate: check matches trailer\n")); } #ifdef GUNZIP state->mode = LENGTH; /* fallthrough */ case LENGTH: if (state->wrap && state->flags) { NEEDBITS(32); if ((state->wrap & 4) && hold != (state->total & 0xffffffff)) { strm->msg = (char *)"incorrect length check"; state->mode = BAD; break; } INITBITS(); Tracev((stderr, "inflate: length matches trailer\n")); } #endif state->mode = DONE; /* fallthrough */ case DONE: ret = Z_STREAM_END; goto inf_leave; case BAD: ret = Z_DATA_ERROR; goto inf_leave; case MEM: return Z_MEM_ERROR; case SYNC: /* fallthrough */ default: return Z_STREAM_ERROR; } /* Return from inflate(), updating the total counts and the check value. If there was no progress during the inflate() call, return a buffer error. Call updatewindow() to create and/or update the window state. Note: a memory error from inflate() is non-recoverable. */ inf_leave: RESTORE(); if (state->wsize || (out != strm->avail_out && state->mode < BAD && (state->mode < CHECK || flush != Z_FINISH))) if (updatewindow(strm, strm->next_out, out - strm->avail_out)) { state->mode = MEM; return Z_MEM_ERROR; } in -= strm->avail_in; out -= strm->avail_out; strm->total_in += in; strm->total_out += out; state->total += out; if ((state->wrap & 4) && out) strm->adler = state->check = UPDATE_CHECK(state->check, strm->next_out - out, out); strm->data_type = (int)state->bits + (state->last ? 64 : 0) + (state->mode == TYPE ? 128 : 0) + (state->mode == LEN_ || state->mode == COPY_ ? 256 : 0); if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK) ret = Z_BUF_ERROR; return ret; } int ZEXPORT inflateEnd(z_streamp strm) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; if (state->window != Z_NULL) ZFREE(strm, state->window); ZFREE(strm, strm->state); strm->state = Z_NULL; Tracev((stderr, "inflate: end\n")); return Z_OK; } int ZEXPORT inflateGetDictionary(z_streamp strm, Bytef *dictionary, uInt *dictLength) { struct inflate_state FAR *state; /* check state */ if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; /* copy dictionary */ if (state->whave && dictionary != Z_NULL) { zmemcpy(dictionary, state->window + state->wnext, state->whave - state->wnext); zmemcpy(dictionary + state->whave - state->wnext, state->window, state->wnext); } if (dictLength != Z_NULL) *dictLength = state->whave; return Z_OK; } int ZEXPORT inflateSetDictionary(z_streamp strm, const Bytef *dictionary, uInt dictLength) { struct inflate_state FAR *state; unsigned long dictid; int ret; /* check state */ if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; if (state->wrap != 0 && state->mode != DICT) return Z_STREAM_ERROR; /* check for correct dictionary identifier */ if (state->mode == DICT) { dictid = adler32(0L, Z_NULL, 0); dictid = adler32(dictid, dictionary, dictLength); if (dictid != state->check) return Z_DATA_ERROR; } /* copy dictionary to window using updatewindow(), which will amend the existing dictionary if appropriate */ ret = updatewindow(strm, dictionary + dictLength, dictLength); if (ret) { state->mode = MEM; return Z_MEM_ERROR; } state->havedict = 1; Tracev((stderr, "inflate: dictionary set\n")); return Z_OK; } int ZEXPORT inflateGetHeader(z_streamp strm, gz_headerp head) { struct inflate_state FAR *state; /* check state */ if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; if ((state->wrap & 2) == 0) return Z_STREAM_ERROR; /* save header structure */ state->head = head; head->done = 0; return Z_OK; } /* Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff. Return when found or when out of input. When called, *have is the number of pattern bytes found in order so far, in 0..3. On return *have is updated to the new state. If on return *have equals four, then the pattern was found and the return value is how many bytes were read including the last byte of the pattern. If *have is less than four, then the pattern has not been found yet and the return value is len. In the latter case, syncsearch() can be called again with more data and the *have state. *have is initialized to zero for the first call. */ local unsigned syncsearch(unsigned FAR *have, const unsigned char FAR *buf, unsigned len) { unsigned got; unsigned next; got = *have; next = 0; while (next < len && got < 4) { if ((int)(buf[next]) == (got < 2 ? 0 : 0xff)) got++; else if (buf[next]) got = 0; else got = 4 - got; next++; } *have = got; return next; } int ZEXPORT inflateSync(z_streamp strm) { unsigned len; /* number of bytes to look at or looked at */ int flags; /* temporary to save header status */ unsigned long in, out; /* temporary to save total_in and total_out */ unsigned char buf[4]; /* to restore bit buffer to byte string */ struct inflate_state FAR *state; /* check parameters */ if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR; /* if first time, start search in bit buffer */ if (state->mode != SYNC) { state->mode = SYNC; state->hold >>= state->bits & 7; state->bits -= state->bits & 7; len = 0; while (state->bits >= 8) { buf[len++] = (unsigned char)(state->hold); state->hold >>= 8; state->bits -= 8; } state->have = 0; syncsearch(&(state->have), buf, len); } /* search available input */ len = syncsearch(&(state->have), strm->next_in, strm->avail_in); strm->avail_in -= len; strm->next_in += len; strm->total_in += len; /* return no joy or set up to restart inflate() on a new block */ if (state->have != 4) return Z_DATA_ERROR; if (state->flags == -1) state->wrap = 0; /* if no header yet, treat as raw */ else state->wrap &= ~4; /* no point in computing a check value now */ flags = state->flags; in = strm->total_in; out = strm->total_out; inflateReset(strm); strm->total_in = in; strm->total_out = out; state->flags = flags; state->mode = TYPE; return Z_OK; } /* Returns true if inflate is currently at the end of a block generated by Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP implementation to provide an additional safety check. PPP uses Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored block. When decompressing, PPP checks that at the end of input packet, inflate is waiting for these length bytes. */ int ZEXPORT inflateSyncPoint(z_streamp strm) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; return state->mode == STORED && state->bits == 0; } int ZEXPORT inflateCopy(z_streamp dest, z_streamp source) { struct inflate_state FAR *state; struct inflate_state FAR *copy; unsigned char FAR *window; unsigned wsize; /* check input */ if (inflateStateCheck(source) || dest == Z_NULL) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)source->state; /* allocate space */ copy = (struct inflate_state FAR *) ZALLOC(source, 1, sizeof(struct inflate_state)); if (copy == Z_NULL) return Z_MEM_ERROR; window = Z_NULL; if (state->window != Z_NULL) { window = (unsigned char FAR *) ZALLOC(source, 1U << state->wbits, sizeof(unsigned char)); if (window == Z_NULL) { ZFREE(source, copy); return Z_MEM_ERROR; } } /* copy state */ zmemcpy((voidpf)dest, (voidpf)source, sizeof(z_stream)); zmemcpy((voidpf)copy, (voidpf)state, sizeof(struct inflate_state)); copy->strm = dest; if (state->lencode >= state->codes && state->lencode <= state->codes + ENOUGH - 1) { copy->lencode = copy->codes + (state->lencode - state->codes); copy->distcode = copy->codes + (state->distcode - state->codes); } copy->next = copy->codes + (state->next - state->codes); if (window != Z_NULL) { wsize = 1U << state->wbits; zmemcpy(window, state->window, wsize); } copy->window = window; dest->state = (struct internal_state FAR *)copy; return Z_OK; } int ZEXPORT inflateUndermine(z_streamp strm, int subvert) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; #ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR state->sane = !subvert; return Z_OK; #else (void)subvert; state->sane = 1; return Z_DATA_ERROR; #endif } int ZEXPORT inflateValidate(z_streamp strm, int check) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; if (check && state->wrap) state->wrap |= 4; else state->wrap &= ~4; return Z_OK; } long ZEXPORT inflateMark(z_streamp strm) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return -(1L << 16); state = (struct inflate_state FAR *)strm->state; return (long)(((unsigned long)((long)state->back)) << 16) + (state->mode == COPY ? state->length : (state->mode == MATCH ? state->was - state->length : 0)); } unsigned long ZEXPORT inflateCodesUsed(z_streamp strm) { struct inflate_state FAR *state; if (inflateStateCheck(strm)) return (unsigned long)-1; state = (struct inflate_state FAR *)strm->state; return (unsigned long)(state->next - state->codes); } tcl8.6.14/compat/zlib/trees.c0000644000175000017500000011775114560736524015376 0ustar sergeisergei/* trees.c -- output deflated data using Huffman coding * Copyright (C) 1995-2024 Jean-loup Gailly * detect_data_type() function provided freely by Cosmin Truta, 2006 * For conditions of distribution and use, see copyright notice in zlib.h */ /* * ALGORITHM * * The "deflation" process uses several Huffman trees. The more * common source values are represented by shorter bit sequences. * * Each code tree is stored in a compressed form which is itself * a Huffman encoding of the lengths of all the code strings (in * ascending order by source values). The actual code strings are * reconstructed from the lengths in the inflate process, as described * in the deflate specification. * * REFERENCES * * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification". * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc * * Storer, James A. * Data Compression: Methods and Theory, pp. 49-50. * Computer Science Press, 1988. ISBN 0-7167-8156-5. * * Sedgewick, R. * Algorithms, p290. * Addison-Wesley, 1983. ISBN 0-201-06672-6. */ /* @(#) $Id$ */ /* #define GEN_TREES_H */ #include "deflate.h" #ifdef ZLIB_DEBUG # include #endif /* =========================================================================== * Constants */ #define MAX_BL_BITS 7 /* Bit length codes must not exceed MAX_BL_BITS bits */ #define END_BLOCK 256 /* end of block literal code */ #define REP_3_6 16 /* repeat previous bit length 3-6 times (2 bits of repeat count) */ #define REPZ_3_10 17 /* repeat a zero length 3-10 times (3 bits of repeat count) */ #define REPZ_11_138 18 /* repeat a zero length 11-138 times (7 bits of repeat count) */ local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */ = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0}; local const int extra_dbits[D_CODES] /* extra bits for each distance code */ = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13}; local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */ = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7}; local const uch bl_order[BL_CODES] = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15}; /* The lengths of the bit length codes are sent in order of decreasing * probability, to avoid transmitting the lengths for unused bit length codes. */ /* =========================================================================== * Local data. These are initialized only once. */ #define DIST_CODE_LEN 512 /* see definition of array dist_code below */ #if defined(GEN_TREES_H) || !defined(STDC) /* non ANSI compilers may not accept trees.h */ local ct_data static_ltree[L_CODES+2]; /* The static literal tree. Since the bit lengths are imposed, there is no * need for the L_CODES extra codes used during heap construction. However * The codes 286 and 287 are needed to build a canonical tree (see _tr_init * below). */ local ct_data static_dtree[D_CODES]; /* The static distance tree. (Actually a trivial tree since all codes use * 5 bits.) */ uch _dist_code[DIST_CODE_LEN]; /* Distance codes. The first 256 values correspond to the distances * 3 .. 258, the last 256 values correspond to the top 8 bits of * the 15 bit distances. */ uch _length_code[MAX_MATCH-MIN_MATCH+1]; /* length code for each normalized match length (0 == MIN_MATCH) */ local int base_length[LENGTH_CODES]; /* First normalized length for each code (0 = MIN_MATCH) */ local int base_dist[D_CODES]; /* First normalized distance for each code (0 = distance of 1) */ #else # include "trees.h" #endif /* GEN_TREES_H */ struct static_tree_desc_s { const ct_data *static_tree; /* static tree or NULL */ const intf *extra_bits; /* extra bits for each code or NULL */ int extra_base; /* base index for extra_bits */ int elems; /* max number of elements in the tree */ int max_length; /* max bit length for the codes */ }; #ifdef NO_INIT_GLOBAL_POINTERS # define TCONST #else # define TCONST const #endif local TCONST static_tree_desc static_l_desc = {static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS}; local TCONST static_tree_desc static_d_desc = {static_dtree, extra_dbits, 0, D_CODES, MAX_BITS}; local TCONST static_tree_desc static_bl_desc = {(const ct_data *)0, extra_blbits, 0, BL_CODES, MAX_BL_BITS}; /* =========================================================================== * Output a short LSB first on the stream. * IN assertion: there is enough room in pendingBuf. */ #define put_short(s, w) { \ put_byte(s, (uch)((w) & 0xff)); \ put_byte(s, (uch)((ush)(w) >> 8)); \ } /* =========================================================================== * Reverse the first len bits of a code, using straightforward code (a faster * method would use a table) * IN assertion: 1 <= len <= 15 */ local unsigned bi_reverse(unsigned code, int len) { register unsigned res = 0; do { res |= code & 1; code >>= 1, res <<= 1; } while (--len > 0); return res >> 1; } /* =========================================================================== * Flush the bit buffer, keeping at most 7 bits in it. */ local void bi_flush(deflate_state *s) { if (s->bi_valid == 16) { put_short(s, s->bi_buf); s->bi_buf = 0; s->bi_valid = 0; } else if (s->bi_valid >= 8) { put_byte(s, (Byte)s->bi_buf); s->bi_buf >>= 8; s->bi_valid -= 8; } } /* =========================================================================== * Flush the bit buffer and align the output on a byte boundary */ local void bi_windup(deflate_state *s) { if (s->bi_valid > 8) { put_short(s, s->bi_buf); } else if (s->bi_valid > 0) { put_byte(s, (Byte)s->bi_buf); } s->bi_buf = 0; s->bi_valid = 0; #ifdef ZLIB_DEBUG s->bits_sent = (s->bits_sent + 7) & ~7; #endif } /* =========================================================================== * Generate the codes for a given tree and bit counts (which need not be * optimal). * IN assertion: the array bl_count contains the bit length statistics for * the given tree and the field len is set for all tree elements. * OUT assertion: the field code is set for all tree elements of non * zero code length. */ local void gen_codes(ct_data *tree, int max_code, ushf *bl_count) { ush next_code[MAX_BITS+1]; /* next code value for each bit length */ unsigned code = 0; /* running code value */ int bits; /* bit index */ int n; /* code index */ /* The distribution counts are first used to generate the code values * without bit reversal. */ for (bits = 1; bits <= MAX_BITS; bits++) { code = (code + bl_count[bits - 1]) << 1; next_code[bits] = (ush)code; } /* Check that the bit counts in bl_count are consistent. The last code * must be all ones. */ Assert (code + bl_count[MAX_BITS] - 1 == (1 << MAX_BITS) - 1, "inconsistent bit counts"); Tracev((stderr,"\ngen_codes: max_code %d ", max_code)); for (n = 0; n <= max_code; n++) { int len = tree[n].Len; if (len == 0) continue; /* Now reverse the bits */ tree[n].Code = (ush)bi_reverse(next_code[len]++, len); Tracecv(tree != static_ltree, (stderr,"\nn %3d %c l %2d c %4x (%x) ", n, (isgraph(n) ? n : ' '), len, tree[n].Code, next_code[len] - 1)); } } #ifdef GEN_TREES_H local void gen_trees_header(void); #endif #ifndef ZLIB_DEBUG # define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len) /* Send a code of the given tree. c and tree must not have side effects */ #else /* !ZLIB_DEBUG */ # define send_code(s, c, tree) \ { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \ send_bits(s, tree[c].Code, tree[c].Len); } #endif /* =========================================================================== * Send a value on a given number of bits. * IN assertion: length <= 16 and value fits in length bits. */ #ifdef ZLIB_DEBUG local void send_bits(deflate_state *s, int value, int length) { Tracevv((stderr," l %2d v %4x ", length, value)); Assert(length > 0 && length <= 15, "invalid length"); s->bits_sent += (ulg)length; /* If not enough room in bi_buf, use (valid) bits from bi_buf and * (16 - bi_valid) bits from value, leaving (width - (16 - bi_valid)) * unused bits in value. */ if (s->bi_valid > (int)Buf_size - length) { s->bi_buf |= (ush)value << s->bi_valid; put_short(s, s->bi_buf); s->bi_buf = (ush)value >> (Buf_size - s->bi_valid); s->bi_valid += length - Buf_size; } else { s->bi_buf |= (ush)value << s->bi_valid; s->bi_valid += length; } } #else /* !ZLIB_DEBUG */ #define send_bits(s, value, length) \ { int len = length;\ if (s->bi_valid > (int)Buf_size - len) {\ int val = (int)value;\ s->bi_buf |= (ush)val << s->bi_valid;\ put_short(s, s->bi_buf);\ s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\ s->bi_valid += len - Buf_size;\ } else {\ s->bi_buf |= (ush)(value) << s->bi_valid;\ s->bi_valid += len;\ }\ } #endif /* ZLIB_DEBUG */ /* the arguments must not have side effects */ /* =========================================================================== * Initialize the various 'constant' tables. */ local void tr_static_init(void) { #if defined(GEN_TREES_H) || !defined(STDC) static int static_init_done = 0; int n; /* iterates over tree elements */ int bits; /* bit counter */ int length; /* length value */ int code; /* code value */ int dist; /* distance index */ ush bl_count[MAX_BITS+1]; /* number of codes at each bit length for an optimal tree */ if (static_init_done) return; /* For some embedded targets, global variables are not initialized: */ #ifdef NO_INIT_GLOBAL_POINTERS static_l_desc.static_tree = static_ltree; static_l_desc.extra_bits = extra_lbits; static_d_desc.static_tree = static_dtree; static_d_desc.extra_bits = extra_dbits; static_bl_desc.extra_bits = extra_blbits; #endif /* Initialize the mapping length (0..255) -> length code (0..28) */ length = 0; for (code = 0; code < LENGTH_CODES-1; code++) { base_length[code] = length; for (n = 0; n < (1 << extra_lbits[code]); n++) { _length_code[length++] = (uch)code; } } Assert (length == 256, "tr_static_init: length != 256"); /* Note that the length 255 (match length 258) can be represented * in two different ways: code 284 + 5 bits or code 285, so we * overwrite length_code[255] to use the best encoding: */ _length_code[length - 1] = (uch)code; /* Initialize the mapping dist (0..32K) -> dist code (0..29) */ dist = 0; for (code = 0 ; code < 16; code++) { base_dist[code] = dist; for (n = 0; n < (1 << extra_dbits[code]); n++) { _dist_code[dist++] = (uch)code; } } Assert (dist == 256, "tr_static_init: dist != 256"); dist >>= 7; /* from now on, all distances are divided by 128 */ for ( ; code < D_CODES; code++) { base_dist[code] = dist << 7; for (n = 0; n < (1 << (extra_dbits[code] - 7)); n++) { _dist_code[256 + dist++] = (uch)code; } } Assert (dist == 256, "tr_static_init: 256 + dist != 512"); /* Construct the codes of the static literal tree */ for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0; n = 0; while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++; while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++; while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++; while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++; /* Codes 286 and 287 do not exist, but we must include them in the * tree construction to get a canonical Huffman tree (longest code * all ones) */ gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count); /* The static distance tree is trivial: */ for (n = 0; n < D_CODES; n++) { static_dtree[n].Len = 5; static_dtree[n].Code = bi_reverse((unsigned)n, 5); } static_init_done = 1; # ifdef GEN_TREES_H gen_trees_header(); # endif #endif /* defined(GEN_TREES_H) || !defined(STDC) */ } /* =========================================================================== * Generate the file trees.h describing the static trees. */ #ifdef GEN_TREES_H # ifndef ZLIB_DEBUG # include # endif # define SEPARATOR(i, last, width) \ ((i) == (last)? "\n};\n\n" : \ ((i) % (width) == (width) - 1 ? ",\n" : ", ")) void gen_trees_header(void) { FILE *header = fopen("trees.h", "w"); int i; Assert (header != NULL, "Can't open trees.h"); fprintf(header, "/* header created automatically with -DGEN_TREES_H */\n\n"); fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n"); for (i = 0; i < L_CODES+2; i++) { fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code, static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5)); } fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n"); for (i = 0; i < D_CODES; i++) { fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code, static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5)); } fprintf(header, "const uch ZLIB_INTERNAL _dist_code[DIST_CODE_LEN] = {\n"); for (i = 0; i < DIST_CODE_LEN; i++) { fprintf(header, "%2u%s", _dist_code[i], SEPARATOR(i, DIST_CODE_LEN-1, 20)); } fprintf(header, "const uch ZLIB_INTERNAL _length_code[MAX_MATCH-MIN_MATCH+1]= {\n"); for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) { fprintf(header, "%2u%s", _length_code[i], SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20)); } fprintf(header, "local const int base_length[LENGTH_CODES] = {\n"); for (i = 0; i < LENGTH_CODES; i++) { fprintf(header, "%1u%s", base_length[i], SEPARATOR(i, LENGTH_CODES-1, 20)); } fprintf(header, "local const int base_dist[D_CODES] = {\n"); for (i = 0; i < D_CODES; i++) { fprintf(header, "%5u%s", base_dist[i], SEPARATOR(i, D_CODES-1, 10)); } fclose(header); } #endif /* GEN_TREES_H */ /* =========================================================================== * Initialize a new block. */ local void init_block(deflate_state *s) { int n; /* iterates over tree elements */ /* Initialize the trees. */ for (n = 0; n < L_CODES; n++) s->dyn_ltree[n].Freq = 0; for (n = 0; n < D_CODES; n++) s->dyn_dtree[n].Freq = 0; for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0; s->dyn_ltree[END_BLOCK].Freq = 1; s->opt_len = s->static_len = 0L; s->sym_next = s->matches = 0; } /* =========================================================================== * Initialize the tree data structures for a new zlib stream. */ void ZLIB_INTERNAL _tr_init(deflate_state *s) { tr_static_init(); s->l_desc.dyn_tree = s->dyn_ltree; s->l_desc.stat_desc = &static_l_desc; s->d_desc.dyn_tree = s->dyn_dtree; s->d_desc.stat_desc = &static_d_desc; s->bl_desc.dyn_tree = s->bl_tree; s->bl_desc.stat_desc = &static_bl_desc; s->bi_buf = 0; s->bi_valid = 0; #ifdef ZLIB_DEBUG s->compressed_len = 0L; s->bits_sent = 0L; #endif /* Initialize the first block of the first file: */ init_block(s); } #define SMALLEST 1 /* Index within the heap array of least frequent node in the Huffman tree */ /* =========================================================================== * Remove the smallest element from the heap and recreate the heap with * one less element. Updates heap and heap_len. */ #define pqremove(s, tree, top) \ {\ top = s->heap[SMALLEST]; \ s->heap[SMALLEST] = s->heap[s->heap_len--]; \ pqdownheap(s, tree, SMALLEST); \ } /* =========================================================================== * Compares to subtrees, using the tree depth as tie breaker when * the subtrees have equal frequency. This minimizes the worst case length. */ #define smaller(tree, n, m, depth) \ (tree[n].Freq < tree[m].Freq || \ (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m])) /* =========================================================================== * Restore the heap property by moving down the tree starting at node k, * exchanging a node with the smallest of its two sons if necessary, stopping * when the heap property is re-established (each father smaller than its * two sons). */ local void pqdownheap(deflate_state *s, ct_data *tree, int k) { int v = s->heap[k]; int j = k << 1; /* left son of k */ while (j <= s->heap_len) { /* Set j to the smallest of the two sons: */ if (j < s->heap_len && smaller(tree, s->heap[j + 1], s->heap[j], s->depth)) { j++; } /* Exit if v is smaller than both sons */ if (smaller(tree, v, s->heap[j], s->depth)) break; /* Exchange v with the smallest son */ s->heap[k] = s->heap[j]; k = j; /* And continue down the tree, setting j to the left son of k */ j <<= 1; } s->heap[k] = v; } /* =========================================================================== * Compute the optimal bit lengths for a tree and update the total bit length * for the current block. * IN assertion: the fields freq and dad are set, heap[heap_max] and * above are the tree nodes sorted by increasing frequency. * OUT assertions: the field len is set to the optimal bit length, the * array bl_count contains the frequencies for each bit length. * The length opt_len is updated; static_len is also updated if stree is * not null. */ local void gen_bitlen(deflate_state *s, tree_desc *desc) { ct_data *tree = desc->dyn_tree; int max_code = desc->max_code; const ct_data *stree = desc->stat_desc->static_tree; const intf *extra = desc->stat_desc->extra_bits; int base = desc->stat_desc->extra_base; int max_length = desc->stat_desc->max_length; int h; /* heap index */ int n, m; /* iterate over the tree elements */ int bits; /* bit length */ int xbits; /* extra bits */ ush f; /* frequency */ int overflow = 0; /* number of elements with bit length too large */ for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0; /* In a first pass, compute the optimal bit lengths (which may * overflow in the case of the bit length tree). */ tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */ for (h = s->heap_max + 1; h < HEAP_SIZE; h++) { n = s->heap[h]; bits = tree[tree[n].Dad].Len + 1; if (bits > max_length) bits = max_length, overflow++; tree[n].Len = (ush)bits; /* We overwrite tree[n].Dad which is no longer needed */ if (n > max_code) continue; /* not a leaf node */ s->bl_count[bits]++; xbits = 0; if (n >= base) xbits = extra[n - base]; f = tree[n].Freq; s->opt_len += (ulg)f * (unsigned)(bits + xbits); if (stree) s->static_len += (ulg)f * (unsigned)(stree[n].Len + xbits); } if (overflow == 0) return; Tracev((stderr,"\nbit length overflow\n")); /* This happens for example on obj2 and pic of the Calgary corpus */ /* Find the first bit length which could increase: */ do { bits = max_length - 1; while (s->bl_count[bits] == 0) bits--; s->bl_count[bits]--; /* move one leaf down the tree */ s->bl_count[bits + 1] += 2; /* move one overflow item as its brother */ s->bl_count[max_length]--; /* The brother of the overflow item also moves one step up, * but this does not affect bl_count[max_length] */ overflow -= 2; } while (overflow > 0); /* Now recompute all bit lengths, scanning in increasing frequency. * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all * lengths instead of fixing only the wrong ones. This idea is taken * from 'ar' written by Haruhiko Okumura.) */ for (bits = max_length; bits != 0; bits--) { n = s->bl_count[bits]; while (n != 0) { m = s->heap[--h]; if (m > max_code) continue; if ((unsigned) tree[m].Len != (unsigned) bits) { Tracev((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits)); s->opt_len += ((ulg)bits - tree[m].Len) * tree[m].Freq; tree[m].Len = (ush)bits; } n--; } } } #ifdef DUMP_BL_TREE # include #endif /* =========================================================================== * Construct one Huffman tree and assigns the code bit strings and lengths. * Update the total bit length for the current block. * IN assertion: the field freq is set for all tree elements. * OUT assertions: the fields len and code are set to the optimal bit length * and corresponding code. The length opt_len is updated; static_len is * also updated if stree is not null. The field max_code is set. */ local void build_tree(deflate_state *s, tree_desc *desc) { ct_data *tree = desc->dyn_tree; const ct_data *stree = desc->stat_desc->static_tree; int elems = desc->stat_desc->elems; int n, m; /* iterate over heap elements */ int max_code = -1; /* largest code with non zero frequency */ int node; /* new node being created */ /* Construct the initial heap, with least frequent element in * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n + 1]. * heap[0] is not used. */ s->heap_len = 0, s->heap_max = HEAP_SIZE; for (n = 0; n < elems; n++) { if (tree[n].Freq != 0) { s->heap[++(s->heap_len)] = max_code = n; s->depth[n] = 0; } else { tree[n].Len = 0; } } /* The pkzip format requires that at least one distance code exists, * and that at least one bit should be sent even if there is only one * possible code. So to avoid special checks later on we force at least * two codes of non zero frequency. */ while (s->heap_len < 2) { node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0); tree[node].Freq = 1; s->depth[node] = 0; s->opt_len--; if (stree) s->static_len -= stree[node].Len; /* node is 0 or 1 so it does not have extra bits */ } desc->max_code = max_code; /* The elements heap[heap_len/2 + 1 .. heap_len] are leaves of the tree, * establish sub-heaps of increasing lengths: */ for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n); /* Construct the Huffman tree by repeatedly combining the least two * frequent nodes. */ node = elems; /* next internal node of the tree */ do { pqremove(s, tree, n); /* n = node of least frequency */ m = s->heap[SMALLEST]; /* m = node of next least frequency */ s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */ s->heap[--(s->heap_max)] = m; /* Create a new node father of n and m */ tree[node].Freq = tree[n].Freq + tree[m].Freq; s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ? s->depth[n] : s->depth[m]) + 1); tree[n].Dad = tree[m].Dad = (ush)node; #ifdef DUMP_BL_TREE if (tree == s->bl_tree) { fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)", node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq); } #endif /* and insert the new node in the heap */ s->heap[SMALLEST] = node++; pqdownheap(s, tree, SMALLEST); } while (s->heap_len >= 2); s->heap[--(s->heap_max)] = s->heap[SMALLEST]; /* At this point, the fields freq and dad are set. We can now * generate the bit lengths. */ gen_bitlen(s, (tree_desc *)desc); /* The field len is now set, we can generate the bit codes */ gen_codes ((ct_data *)tree, max_code, s->bl_count); } /* =========================================================================== * Scan a literal or distance tree to determine the frequencies of the codes * in the bit length tree. */ local void scan_tree(deflate_state *s, ct_data *tree, int max_code) { int n; /* iterates over all tree elements */ int prevlen = -1; /* last emitted length */ int curlen; /* length of current code */ int nextlen = tree[0].Len; /* length of next code */ int count = 0; /* repeat count of the current code */ int max_count = 7; /* max repeat count */ int min_count = 4; /* min repeat count */ if (nextlen == 0) max_count = 138, min_count = 3; tree[max_code + 1].Len = (ush)0xffff; /* guard */ for (n = 0; n <= max_code; n++) { curlen = nextlen; nextlen = tree[n + 1].Len; if (++count < max_count && curlen == nextlen) { continue; } else if (count < min_count) { s->bl_tree[curlen].Freq += count; } else if (curlen != 0) { if (curlen != prevlen) s->bl_tree[curlen].Freq++; s->bl_tree[REP_3_6].Freq++; } else if (count <= 10) { s->bl_tree[REPZ_3_10].Freq++; } else { s->bl_tree[REPZ_11_138].Freq++; } count = 0; prevlen = curlen; if (nextlen == 0) { max_count = 138, min_count = 3; } else if (curlen == nextlen) { max_count = 6, min_count = 3; } else { max_count = 7, min_count = 4; } } } /* =========================================================================== * Send a literal or distance tree in compressed form, using the codes in * bl_tree. */ local void send_tree(deflate_state *s, ct_data *tree, int max_code) { int n; /* iterates over all tree elements */ int prevlen = -1; /* last emitted length */ int curlen; /* length of current code */ int nextlen = tree[0].Len; /* length of next code */ int count = 0; /* repeat count of the current code */ int max_count = 7; /* max repeat count */ int min_count = 4; /* min repeat count */ /* tree[max_code + 1].Len = -1; */ /* guard already set */ if (nextlen == 0) max_count = 138, min_count = 3; for (n = 0; n <= max_code; n++) { curlen = nextlen; nextlen = tree[n + 1].Len; if (++count < max_count && curlen == nextlen) { continue; } else if (count < min_count) { do { send_code(s, curlen, s->bl_tree); } while (--count != 0); } else if (curlen != 0) { if (curlen != prevlen) { send_code(s, curlen, s->bl_tree); count--; } Assert(count >= 3 && count <= 6, " 3_6?"); send_code(s, REP_3_6, s->bl_tree); send_bits(s, count - 3, 2); } else if (count <= 10) { send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count - 3, 3); } else { send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count - 11, 7); } count = 0; prevlen = curlen; if (nextlen == 0) { max_count = 138, min_count = 3; } else if (curlen == nextlen) { max_count = 6, min_count = 3; } else { max_count = 7, min_count = 4; } } } /* =========================================================================== * Construct the Huffman tree for the bit lengths and return the index in * bl_order of the last bit length code to send. */ local int build_bl_tree(deflate_state *s) { int max_blindex; /* index of last bit length code of non zero freq */ /* Determine the bit length frequencies for literal and distance trees */ scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code); scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code); /* Build the bit length tree: */ build_tree(s, (tree_desc *)(&(s->bl_desc))); /* opt_len now includes the length of the tree representations, except the * lengths of the bit lengths codes and the 5 + 5 + 4 bits for the counts. */ /* Determine the number of bit length codes to send. The pkzip format * requires that at least 4 bit length codes be sent. (appnote.txt says * 3 but the actual value used is 4.) */ for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) { if (s->bl_tree[bl_order[max_blindex]].Len != 0) break; } /* Update opt_len to include the bit length tree and counts */ s->opt_len += 3*((ulg)max_blindex + 1) + 5 + 5 + 4; Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld", s->opt_len, s->static_len)); return max_blindex; } /* =========================================================================== * Send the header for a block using dynamic Huffman trees: the counts, the * lengths of the bit length codes, the literal tree and the distance tree. * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. */ local void send_all_trees(deflate_state *s, int lcodes, int dcodes, int blcodes) { int rank; /* index in bl_order */ Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes"); Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES, "too many codes"); Tracev((stderr, "\nbl counts: ")); send_bits(s, lcodes - 257, 5); /* not +255 as stated in appnote.txt */ send_bits(s, dcodes - 1, 5); send_bits(s, blcodes - 4, 4); /* not -3 as stated in appnote.txt */ for (rank = 0; rank < blcodes; rank++) { Tracev((stderr, "\nbl code %2d ", bl_order[rank])); send_bits(s, s->bl_tree[bl_order[rank]].Len, 3); } Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent)); send_tree(s, (ct_data *)s->dyn_ltree, lcodes - 1); /* literal tree */ Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent)); send_tree(s, (ct_data *)s->dyn_dtree, dcodes - 1); /* distance tree */ Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent)); } /* =========================================================================== * Send a stored block */ void ZLIB_INTERNAL _tr_stored_block(deflate_state *s, charf *buf, ulg stored_len, int last) { send_bits(s, (STORED_BLOCK<<1) + last, 3); /* send block type */ bi_windup(s); /* align on byte boundary */ put_short(s, (ush)stored_len); put_short(s, (ush)~stored_len); if (stored_len) zmemcpy(s->pending_buf + s->pending, (Bytef *)buf, stored_len); s->pending += stored_len; #ifdef ZLIB_DEBUG s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L; s->compressed_len += (stored_len + 4) << 3; s->bits_sent += 2*16; s->bits_sent += stored_len << 3; #endif } /* =========================================================================== * Flush the bits in the bit buffer to pending output (leaves at most 7 bits) */ void ZLIB_INTERNAL _tr_flush_bits(deflate_state *s) { bi_flush(s); } /* =========================================================================== * Send one empty static block to give enough lookahead for inflate. * This takes 10 bits, of which 7 may remain in the bit buffer. */ void ZLIB_INTERNAL _tr_align(deflate_state *s) { send_bits(s, STATIC_TREES<<1, 3); send_code(s, END_BLOCK, static_ltree); #ifdef ZLIB_DEBUG s->compressed_len += 10L; /* 3 for block type, 7 for EOB */ #endif bi_flush(s); } /* =========================================================================== * Send the block data compressed using the given Huffman trees */ local void compress_block(deflate_state *s, const ct_data *ltree, const ct_data *dtree) { unsigned dist; /* distance of matched string */ int lc; /* match length or unmatched char (if dist == 0) */ unsigned sx = 0; /* running index in symbol buffers */ unsigned code; /* the code to send */ int extra; /* number of extra bits to send */ if (s->sym_next != 0) do { #ifdef LIT_MEM dist = s->d_buf[sx]; lc = s->l_buf[sx++]; #else dist = s->sym_buf[sx++] & 0xff; dist += (unsigned)(s->sym_buf[sx++] & 0xff) << 8; lc = s->sym_buf[sx++]; #endif if (dist == 0) { send_code(s, lc, ltree); /* send a literal byte */ Tracecv(isgraph(lc), (stderr," '%c' ", lc)); } else { /* Here, lc is the match length - MIN_MATCH */ code = _length_code[lc]; send_code(s, code + LITERALS + 1, ltree); /* send length code */ extra = extra_lbits[code]; if (extra != 0) { lc -= base_length[code]; send_bits(s, lc, extra); /* send the extra length bits */ } dist--; /* dist is now the match distance - 1 */ code = d_code(dist); Assert (code < D_CODES, "bad d_code"); send_code(s, code, dtree); /* send the distance code */ extra = extra_dbits[code]; if (extra != 0) { dist -= (unsigned)base_dist[code]; send_bits(s, dist, extra); /* send the extra distance bits */ } } /* literal or match pair ? */ /* Check for no overlay of pending_buf on needed symbols */ #ifdef LIT_MEM Assert(s->pending < 2 * (s->lit_bufsize + sx), "pendingBuf overflow"); #else Assert(s->pending < s->lit_bufsize + sx, "pendingBuf overflow"); #endif } while (sx < s->sym_next); send_code(s, END_BLOCK, ltree); } /* =========================================================================== * Check if the data type is TEXT or BINARY, using the following algorithm: * - TEXT if the two conditions below are satisfied: * a) There are no non-portable control characters belonging to the * "block list" (0..6, 14..25, 28..31). * b) There is at least one printable character belonging to the * "allow list" (9 {TAB}, 10 {LF}, 13 {CR}, 32..255). * - BINARY otherwise. * - The following partially-portable control characters form a * "gray list" that is ignored in this detection algorithm: * (7 {BEL}, 8 {BS}, 11 {VT}, 12 {FF}, 26 {SUB}, 27 {ESC}). * IN assertion: the fields Freq of dyn_ltree are set. */ local int detect_data_type(deflate_state *s) { /* block_mask is the bit mask of block-listed bytes * set bits 0..6, 14..25, and 28..31 * 0xf3ffc07f = binary 11110011111111111100000001111111 */ unsigned long block_mask = 0xf3ffc07fUL; int n; /* Check for non-textual ("block-listed") bytes. */ for (n = 0; n <= 31; n++, block_mask >>= 1) if ((block_mask & 1) && (s->dyn_ltree[n].Freq != 0)) return Z_BINARY; /* Check for textual ("allow-listed") bytes. */ if (s->dyn_ltree[9].Freq != 0 || s->dyn_ltree[10].Freq != 0 || s->dyn_ltree[13].Freq != 0) return Z_TEXT; for (n = 32; n < LITERALS; n++) if (s->dyn_ltree[n].Freq != 0) return Z_TEXT; /* There are no "block-listed" or "allow-listed" bytes: * this stream either is empty or has tolerated ("gray-listed") bytes only. */ return Z_BINARY; } /* =========================================================================== * Determine the best encoding for the current block: dynamic trees, static * trees or store, and write out the encoded block. */ void ZLIB_INTERNAL _tr_flush_block(deflate_state *s, charf *buf, ulg stored_len, int last) { ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */ int max_blindex = 0; /* index of last bit length code of non zero freq */ /* Build the Huffman trees unless a stored block is forced */ if (s->level > 0) { /* Check if the file is binary or text */ if (s->strm->data_type == Z_UNKNOWN) s->strm->data_type = detect_data_type(s); /* Construct the literal and distance trees */ build_tree(s, (tree_desc *)(&(s->l_desc))); Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len, s->static_len)); build_tree(s, (tree_desc *)(&(s->d_desc))); Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len, s->static_len)); /* At this point, opt_len and static_len are the total bit lengths of * the compressed block data, excluding the tree representations. */ /* Build the bit length tree for the above two trees, and get the index * in bl_order of the last bit length code to send. */ max_blindex = build_bl_tree(s); /* Determine the best encoding. Compute the block lengths in bytes. */ opt_lenb = (s->opt_len + 3 + 7) >> 3; static_lenb = (s->static_len + 3 + 7) >> 3; Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ", opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len, s->sym_next / 3)); #ifndef FORCE_STATIC if (static_lenb <= opt_lenb || s->strategy == Z_FIXED) #endif opt_lenb = static_lenb; } else { Assert(buf != (char*)0, "lost buf"); opt_lenb = static_lenb = stored_len + 5; /* force a stored block */ } #ifdef FORCE_STORED if (buf != (char*)0) { /* force stored block */ #else if (stored_len + 4 <= opt_lenb && buf != (char*)0) { /* 4: two words for the lengths */ #endif /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE. * Otherwise we can't have processed more than WSIZE input bytes since * the last block flush, because compression would have been * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to * transform a block into a stored block. */ _tr_stored_block(s, buf, stored_len, last); } else if (static_lenb == opt_lenb) { send_bits(s, (STATIC_TREES<<1) + last, 3); compress_block(s, (const ct_data *)static_ltree, (const ct_data *)static_dtree); #ifdef ZLIB_DEBUG s->compressed_len += 3 + s->static_len; #endif } else { send_bits(s, (DYN_TREES<<1) + last, 3); send_all_trees(s, s->l_desc.max_code + 1, s->d_desc.max_code + 1, max_blindex + 1); compress_block(s, (const ct_data *)s->dyn_ltree, (const ct_data *)s->dyn_dtree); #ifdef ZLIB_DEBUG s->compressed_len += 3 + s->opt_len; #endif } Assert (s->compressed_len == s->bits_sent, "bad compressed size"); /* The above check is made mod 2^32, for files larger than 512 MB * and uLong implemented on 32 bits. */ init_block(s); if (last) { bi_windup(s); #ifdef ZLIB_DEBUG s->compressed_len += 7; /* align on byte boundary */ #endif } Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len >> 3, s->compressed_len - 7*last)); } /* =========================================================================== * Save the match info and tally the frequency counts. Return true if * the current block must be flushed. */ int ZLIB_INTERNAL _tr_tally(deflate_state *s, unsigned dist, unsigned lc) { #ifdef LIT_MEM s->d_buf[s->sym_next] = (ush)dist; s->l_buf[s->sym_next++] = (uch)lc; #else s->sym_buf[s->sym_next++] = (uch)dist; s->sym_buf[s->sym_next++] = (uch)(dist >> 8); s->sym_buf[s->sym_next++] = (uch)lc; #endif if (dist == 0) { /* lc is the unmatched char */ s->dyn_ltree[lc].Freq++; } else { s->matches++; /* Here, lc is the match length - MIN_MATCH */ dist--; /* dist = match distance - 1 */ Assert((ush)dist < (ush)MAX_DIST(s) && (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) && (ush)d_code(dist) < (ush)D_CODES, "_tr_tally: bad match"); s->dyn_ltree[_length_code[lc] + LITERALS + 1].Freq++; s->dyn_dtree[d_code(dist)].Freq++; } return (s->sym_next == s->sym_end); } tcl8.6.14/compat/zlib/gzguts.h0000644000175000017500000001502414560736524015572 0ustar sergeisergei/* gzguts.h -- zlib internal header definitions for gz* operations * Copyright (C) 2004-2024 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ #ifdef _LARGEFILE64_SOURCE # ifndef _LARGEFILE_SOURCE # define _LARGEFILE_SOURCE 1 # endif # undef _FILE_OFFSET_BITS # undef _TIME_BITS #endif #ifdef HAVE_HIDDEN # define ZLIB_INTERNAL __attribute__((visibility ("hidden"))) #else # define ZLIB_INTERNAL #endif #include #include "zlib.h" #ifdef STDC # include # include # include #endif #ifndef _POSIX_SOURCE # define _POSIX_SOURCE #endif #include #ifdef _WIN32 # include #endif #if defined(__TURBOC__) || defined(_MSC_VER) || defined(_WIN32) # include #endif #if defined(_WIN32) # define WIDECHAR #endif #ifdef WINAPI_FAMILY # define open _open # define read _read # define write _write # define close _close #endif #ifdef NO_DEFLATE /* for compatibility with old definition */ # define NO_GZCOMPRESS #endif #if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550) # ifndef HAVE_VSNPRINTF # define HAVE_VSNPRINTF # endif #endif #if defined(__CYGWIN__) # ifndef HAVE_VSNPRINTF # define HAVE_VSNPRINTF # endif #endif #if defined(MSDOS) && defined(__BORLANDC__) && (BORLANDC > 0x410) # ifndef HAVE_VSNPRINTF # define HAVE_VSNPRINTF # endif #endif #ifndef HAVE_VSNPRINTF # ifdef MSDOS /* vsnprintf may exist on some MS-DOS compilers (DJGPP?), but for now we just assume it doesn't. */ # define NO_vsnprintf # endif # ifdef __TURBOC__ # define NO_vsnprintf # endif # ifdef WIN32 /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ # if !defined(vsnprintf) && !defined(NO_vsnprintf) # if !defined(_MSC_VER) || ( defined(_MSC_VER) && _MSC_VER < 1500 ) # define vsnprintf _vsnprintf # endif # endif # endif # ifdef __SASC # define NO_vsnprintf # endif # ifdef VMS # define NO_vsnprintf # endif # ifdef __OS400__ # define NO_vsnprintf # endif # ifdef __MVS__ # define NO_vsnprintf # endif #endif /* unlike snprintf (which is required in C99), _snprintf does not guarantee null termination of the result -- however this is only used in gzlib.c where the result is assured to fit in the space provided */ #if defined(_MSC_VER) && _MSC_VER < 1900 # define snprintf _snprintf #endif #ifndef local # define local static #endif /* since "static" is used to mean two completely different things in C, we define "local" for the non-static meaning of "static", for readability (compile with -Dlocal if your debugger can't find static symbols) */ /* gz* functions always use library allocation functions */ #ifndef STDC extern voidp malloc(uInt size); extern void free(voidpf ptr); #endif /* get errno and strerror definition */ #if defined UNDER_CE # include # define zstrerror() gz_strwinerror((DWORD)GetLastError()) #else # ifndef NO_STRERROR # include # define zstrerror() strerror(errno) # else # define zstrerror() "stdio error (consult errno)" # endif #endif /* provide prototypes for these when building zlib without LFS */ #if !defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0 ZEXTERN gzFile ZEXPORT gzopen64(const char *, const char *); ZEXTERN z_off64_t ZEXPORT gzseek64(gzFile, z_off64_t, int); ZEXTERN z_off64_t ZEXPORT gztell64(gzFile); ZEXTERN z_off64_t ZEXPORT gzoffset64(gzFile); #endif /* default memLevel */ #if MAX_MEM_LEVEL >= 8 # define DEF_MEM_LEVEL 8 #else # define DEF_MEM_LEVEL MAX_MEM_LEVEL #endif /* default i/o buffer size -- double this for output when reading (this and twice this must be able to fit in an unsigned type) */ #define GZBUFSIZE 8192 /* gzip modes, also provide a little integrity check on the passed structure */ #define GZ_NONE 0 #define GZ_READ 7247 #define GZ_WRITE 31153 #define GZ_APPEND 1 /* mode set to GZ_WRITE after the file is opened */ /* values for gz_state how */ #define LOOK 0 /* look for a gzip header */ #define COPY 1 /* copy input directly */ #define GZIP 2 /* decompress a gzip stream */ /* internal gzip file state data structure */ typedef struct { /* exposed contents for gzgetc() macro */ struct gzFile_s x; /* "x" for exposed */ /* x.have: number of bytes available at x.next */ /* x.next: next output data to deliver or write */ /* x.pos: current position in uncompressed data */ /* used for both reading and writing */ int mode; /* see gzip modes above */ int fd; /* file descriptor */ char *path; /* path or fd for error messages */ unsigned size; /* buffer size, zero if not allocated yet */ unsigned want; /* requested buffer size, default is GZBUFSIZE */ unsigned char *in; /* input buffer (double-sized when writing) */ unsigned char *out; /* output buffer (double-sized when reading) */ int direct; /* 0 if processing gzip, 1 if transparent */ /* just for reading */ int how; /* 0: get header, 1: copy, 2: decompress */ z_off64_t start; /* where the gzip data started, for rewinding */ int eof; /* true if end of input file reached */ int past; /* true if read requested past end */ /* just for writing */ int level; /* compression level */ int strategy; /* compression strategy */ int reset; /* true if a reset is pending after a Z_FINISH */ /* seek request */ z_off64_t skip; /* amount to skip (already rewound if backwards) */ int seek; /* true if seek request pending */ /* error information */ int err; /* error code */ char *msg; /* error message */ /* zlib inflate or deflate stream */ z_stream strm; /* stream structure in-place (not a pointer) */ } gz_state; typedef gz_state FAR *gz_statep; /* shared functions */ void ZLIB_INTERNAL gz_error(gz_statep, int, const char *); #if defined UNDER_CE char ZLIB_INTERNAL *gz_strwinerror(DWORD error); #endif /* GT_OFF(x), where x is an unsigned value, is true if x > maximum z_off64_t value -- needed when comparing unsigned to z_off64_t, which is signed (possible z_off64_t types off_t, off64_t, and long are all signed) */ unsigned ZLIB_INTERNAL gz_intmax(void); #define GT_OFF(x) (sizeof(int) == sizeof(z_off64_t) && (x) > gz_intmax()) tcl8.6.14/compat/zlib/gzwrite.c0000644000175000017500000004544514554262142015740 0ustar sergeisergei/* gzwrite.c -- zlib functions for writing gzip files * Copyright (C) 2004-2019 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ #include "gzguts.h" /* Initialize state for writing a gzip file. Mark initialization by setting state->size to non-zero. Return -1 on a memory allocation failure, or 0 on success. */ local int gz_init(gz_statep state) { int ret; z_streamp strm = &(state->strm); /* allocate input buffer (double size for gzprintf) */ state->in = (unsigned char *)malloc(state->want << 1); if (state->in == NULL) { gz_error(state, Z_MEM_ERROR, "out of memory"); return -1; } /* only need output buffer and deflate state if compressing */ if (!state->direct) { /* allocate output buffer */ state->out = (unsigned char *)malloc(state->want); if (state->out == NULL) { free(state->in); gz_error(state, Z_MEM_ERROR, "out of memory"); return -1; } /* allocate deflate memory, set up for gzip compression */ strm->zalloc = Z_NULL; strm->zfree = Z_NULL; strm->opaque = Z_NULL; ret = deflateInit2(strm, state->level, Z_DEFLATED, MAX_WBITS + 16, DEF_MEM_LEVEL, state->strategy); if (ret != Z_OK) { free(state->out); free(state->in); gz_error(state, Z_MEM_ERROR, "out of memory"); return -1; } strm->next_in = NULL; } /* mark state as initialized */ state->size = state->want; /* initialize write buffer if compressing */ if (!state->direct) { strm->avail_out = state->size; strm->next_out = state->out; state->x.next = strm->next_out; } return 0; } /* Compress whatever is at avail_in and next_in and write to the output file. Return -1 if there is an error writing to the output file or if gz_init() fails to allocate memory, otherwise 0. flush is assumed to be a valid deflate() flush value. If flush is Z_FINISH, then the deflate() state is reset to start a new gzip stream. If gz->direct is true, then simply write to the output file without compressing, and ignore flush. */ local int gz_comp(gz_statep state, int flush) { int ret, writ; unsigned have, put, max = ((unsigned)-1 >> 2) + 1; z_streamp strm = &(state->strm); /* allocate memory if this is the first time through */ if (state->size == 0 && gz_init(state) == -1) return -1; /* write directly if requested */ if (state->direct) { while (strm->avail_in) { put = strm->avail_in > max ? max : strm->avail_in; writ = write(state->fd, strm->next_in, put); if (writ < 0) { gz_error(state, Z_ERRNO, zstrerror()); return -1; } strm->avail_in -= (unsigned)writ; strm->next_in += writ; } return 0; } /* check for a pending reset */ if (state->reset) { /* don't start a new gzip member unless there is data to write */ if (strm->avail_in == 0) return 0; deflateReset(strm); state->reset = 0; } /* run deflate() on provided input until it produces no more output */ ret = Z_OK; do { /* write out current buffer contents if full, or if flushing, but if doing Z_FINISH then don't write until we get to Z_STREAM_END */ if (strm->avail_out == 0 || (flush != Z_NO_FLUSH && (flush != Z_FINISH || ret == Z_STREAM_END))) { while (strm->next_out > state->x.next) { put = strm->next_out - state->x.next > (int)max ? max : (unsigned)(strm->next_out - state->x.next); writ = write(state->fd, state->x.next, put); if (writ < 0) { gz_error(state, Z_ERRNO, zstrerror()); return -1; } state->x.next += writ; } if (strm->avail_out == 0) { strm->avail_out = state->size; strm->next_out = state->out; state->x.next = state->out; } } /* compress */ have = strm->avail_out; ret = deflate(strm, flush); if (ret == Z_STREAM_ERROR) { gz_error(state, Z_STREAM_ERROR, "internal error: deflate stream corrupt"); return -1; } have -= strm->avail_out; } while (have); /* if that completed a deflate stream, allow another to start */ if (flush == Z_FINISH) state->reset = 1; /* all done, no errors */ return 0; } /* Compress len zeros to output. Return -1 on a write error or memory allocation failure by gz_comp(), or 0 on success. */ local int gz_zero(gz_statep state, z_off64_t len) { int first; unsigned n; z_streamp strm = &(state->strm); /* consume whatever's left in the input buffer */ if (strm->avail_in && gz_comp(state, Z_NO_FLUSH) == -1) return -1; /* compress len zeros (len guaranteed > 0) */ first = 1; while (len) { n = GT_OFF(state->size) || (z_off64_t)state->size > len ? (unsigned)len : state->size; if (first) { memset(state->in, 0, n); first = 0; } strm->avail_in = n; strm->next_in = state->in; state->x.pos += n; if (gz_comp(state, Z_NO_FLUSH) == -1) return -1; len -= n; } return 0; } /* Write len bytes from buf to file. Return the number of bytes written. If the returned value is less than len, then there was an error. */ local z_size_t gz_write(gz_statep state, voidpc buf, z_size_t len) { z_size_t put = len; /* if len is zero, avoid unnecessary operations */ if (len == 0) return 0; /* allocate memory if this is the first time through */ if (state->size == 0 && gz_init(state) == -1) return 0; /* check for seek request */ if (state->seek) { state->seek = 0; if (gz_zero(state, state->skip) == -1) return 0; } /* for small len, copy to input buffer, otherwise compress directly */ if (len < state->size) { /* copy to input buffer, compress when full */ do { unsigned have, copy; if (state->strm.avail_in == 0) state->strm.next_in = state->in; have = (unsigned)((state->strm.next_in + state->strm.avail_in) - state->in); copy = state->size - have; if (copy > len) copy = (unsigned)len; memcpy(state->in + have, buf, copy); state->strm.avail_in += copy; state->x.pos += copy; buf = (const char *)buf + copy; len -= copy; if (len && gz_comp(state, Z_NO_FLUSH) == -1) return 0; } while (len); } else { /* consume whatever's left in the input buffer */ if (state->strm.avail_in && gz_comp(state, Z_NO_FLUSH) == -1) return 0; /* directly compress user buffer to file */ state->strm.next_in = (z_const Bytef *)buf; do { unsigned n = (unsigned)-1; if (n > len) n = (unsigned)len; state->strm.avail_in = n; state->x.pos += n; if (gz_comp(state, Z_NO_FLUSH) == -1) return 0; len -= n; } while (len); } /* input was all buffered or compressed */ return put; } /* -- see zlib.h -- */ int ZEXPORT gzwrite(gzFile file, voidpc buf, unsigned len) { gz_statep state; /* get internal structure */ if (file == NULL) return 0; state = (gz_statep)file; /* check that we're writing and that there's no error */ if (state->mode != GZ_WRITE || state->err != Z_OK) return 0; /* since an int is returned, make sure len fits in one, otherwise return with an error (this avoids a flaw in the interface) */ if ((int)len < 0) { gz_error(state, Z_DATA_ERROR, "requested length does not fit in int"); return 0; } /* write len bytes from buf (the return value will fit in an int) */ return (int)gz_write(state, buf, len); } /* -- see zlib.h -- */ z_size_t ZEXPORT gzfwrite(voidpc buf, z_size_t size, z_size_t nitems, gzFile file) { z_size_t len; gz_statep state; /* get internal structure */ if (file == NULL) return 0; state = (gz_statep)file; /* check that we're writing and that there's no error */ if (state->mode != GZ_WRITE || state->err != Z_OK) return 0; /* compute bytes to read -- error on overflow */ len = nitems * size; if (size && len / size != nitems) { gz_error(state, Z_STREAM_ERROR, "request does not fit in a size_t"); return 0; } /* write len bytes to buf, return the number of full items written */ return len ? gz_write(state, buf, len) / size : 0; } /* -- see zlib.h -- */ int ZEXPORT gzputc(gzFile file, int c) { unsigned have; unsigned char buf[1]; gz_statep state; z_streamp strm; /* get internal structure */ if (file == NULL) return -1; state = (gz_statep)file; strm = &(state->strm); /* check that we're writing and that there's no error */ if (state->mode != GZ_WRITE || state->err != Z_OK) return -1; /* check for seek request */ if (state->seek) { state->seek = 0; if (gz_zero(state, state->skip) == -1) return -1; } /* try writing to input buffer for speed (state->size == 0 if buffer not initialized) */ if (state->size) { if (strm->avail_in == 0) strm->next_in = state->in; have = (unsigned)((strm->next_in + strm->avail_in) - state->in); if (have < state->size) { state->in[have] = (unsigned char)c; strm->avail_in++; state->x.pos++; return c & 0xff; } } /* no room in buffer or not initialized, use gz_write() */ buf[0] = (unsigned char)c; if (gz_write(state, buf, 1) != 1) return -1; return c & 0xff; } /* -- see zlib.h -- */ int ZEXPORT gzputs(gzFile file, const char *s) { z_size_t len, put; gz_statep state; /* get internal structure */ if (file == NULL) return -1; state = (gz_statep)file; /* check that we're writing and that there's no error */ if (state->mode != GZ_WRITE || state->err != Z_OK) return -1; /* write string */ len = strlen(s); if ((int)len < 0 || (unsigned)len != len) { gz_error(state, Z_STREAM_ERROR, "string length does not fit in int"); return -1; } put = gz_write(state, s, len); return put < len ? -1 : (int)len; } #if defined(STDC) || defined(Z_HAVE_STDARG_H) #include /* -- see zlib.h -- */ int ZEXPORTVA gzvprintf(gzFile file, const char *format, va_list va) { int len; unsigned left; char *next; gz_statep state; z_streamp strm; /* get internal structure */ if (file == NULL) return Z_STREAM_ERROR; state = (gz_statep)file; strm = &(state->strm); /* check that we're writing and that there's no error */ if (state->mode != GZ_WRITE || state->err != Z_OK) return Z_STREAM_ERROR; /* make sure we have some buffer space */ if (state->size == 0 && gz_init(state) == -1) return state->err; /* check for seek request */ if (state->seek) { state->seek = 0; if (gz_zero(state, state->skip) == -1) return state->err; } /* do the printf() into the input buffer, put length in len -- the input buffer is double-sized just for this function, so there is guaranteed to be state->size bytes available after the current contents */ if (strm->avail_in == 0) strm->next_in = state->in; next = (char *)(state->in + (strm->next_in - state->in) + strm->avail_in); next[state->size - 1] = 0; #ifdef NO_vsnprintf # ifdef HAS_vsprintf_void (void)vsprintf(next, format, va); for (len = 0; len < state->size; len++) if (next[len] == 0) break; # else len = vsprintf(next, format, va); # endif #else # ifdef HAS_vsnprintf_void (void)vsnprintf(next, state->size, format, va); len = strlen(next); # else len = vsnprintf(next, state->size, format, va); # endif #endif /* check that printf() results fit in buffer */ if (len == 0 || (unsigned)len >= state->size || next[state->size - 1] != 0) return 0; /* update buffer and position, compress first half if past that */ strm->avail_in += (unsigned)len; state->x.pos += len; if (strm->avail_in >= state->size) { left = strm->avail_in - state->size; strm->avail_in = state->size; if (gz_comp(state, Z_NO_FLUSH) == -1) return state->err; memmove(state->in, state->in + state->size, left); strm->next_in = state->in; strm->avail_in = left; } return len; } int ZEXPORTVA gzprintf(gzFile file, const char *format, ...) { va_list va; int ret; va_start(va, format); ret = gzvprintf(file, format, va); va_end(va); return ret; } #else /* !STDC && !Z_HAVE_STDARG_H */ /* -- see zlib.h -- */ int ZEXPORTVA gzprintf(gzFile file, const char *format, int a1, int a2, int a3, int a4, int a5, int a6, int a7, int a8, int a9, int a10, int a11, int a12, int a13, int a14, int a15, int a16, int a17, int a18, int a19, int a20) { unsigned len, left; char *next; gz_statep state; z_streamp strm; /* get internal structure */ if (file == NULL) return Z_STREAM_ERROR; state = (gz_statep)file; strm = &(state->strm); /* check that can really pass pointer in ints */ if (sizeof(int) != sizeof(void *)) return Z_STREAM_ERROR; /* check that we're writing and that there's no error */ if (state->mode != GZ_WRITE || state->err != Z_OK) return Z_STREAM_ERROR; /* make sure we have some buffer space */ if (state->size == 0 && gz_init(state) == -1) return state->error; /* check for seek request */ if (state->seek) { state->seek = 0; if (gz_zero(state, state->skip) == -1) return state->error; } /* do the printf() into the input buffer, put length in len -- the input buffer is double-sized just for this function, so there is guaranteed to be state->size bytes available after the current contents */ if (strm->avail_in == 0) strm->next_in = state->in; next = (char *)(strm->next_in + strm->avail_in); next[state->size - 1] = 0; #ifdef NO_snprintf # ifdef HAS_sprintf_void sprintf(next, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); for (len = 0; len < size; len++) if (next[len] == 0) break; # else len = sprintf(next, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); # endif #else # ifdef HAS_snprintf_void snprintf(next, state->size, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); len = strlen(next); # else len = snprintf(next, state->size, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); # endif #endif /* check that printf() results fit in buffer */ if (len == 0 || len >= state->size || next[state->size - 1] != 0) return 0; /* update buffer and position, compress first half if past that */ strm->avail_in += len; state->x.pos += len; if (strm->avail_in >= state->size) { left = strm->avail_in - state->size; strm->avail_in = state->size; if (gz_comp(state, Z_NO_FLUSH) == -1) return state->err; memmove(state->in, state->in + state->size, left); strm->next_in = state->in; strm->avail_in = left; } return (int)len; } #endif /* -- see zlib.h -- */ int ZEXPORT gzflush(gzFile file, int flush) { gz_statep state; /* get internal structure */ if (file == NULL) return Z_STREAM_ERROR; state = (gz_statep)file; /* check that we're writing and that there's no error */ if (state->mode != GZ_WRITE || state->err != Z_OK) return Z_STREAM_ERROR; /* check flush parameter */ if (flush < 0 || flush > Z_FINISH) return Z_STREAM_ERROR; /* check for seek request */ if (state->seek) { state->seek = 0; if (gz_zero(state, state->skip) == -1) return state->err; } /* compress remaining data with requested flush */ (void)gz_comp(state, flush); return state->err; } /* -- see zlib.h -- */ int ZEXPORT gzsetparams(gzFile file, int level, int strategy) { gz_statep state; z_streamp strm; /* get internal structure */ if (file == NULL) return Z_STREAM_ERROR; state = (gz_statep)file; strm = &(state->strm); /* check that we're writing and that there's no error */ if (state->mode != GZ_WRITE || state->err != Z_OK || state->direct) return Z_STREAM_ERROR; /* if no change is requested, then do nothing */ if (level == state->level && strategy == state->strategy) return Z_OK; /* check for seek request */ if (state->seek) { state->seek = 0; if (gz_zero(state, state->skip) == -1) return state->err; } /* change compression parameters for subsequent input */ if (state->size) { /* flush previous input with previous parameters before changing */ if (strm->avail_in && gz_comp(state, Z_BLOCK) == -1) return state->err; deflateParams(strm, level, strategy); } state->level = level; state->strategy = strategy; return Z_OK; } /* -- see zlib.h -- */ int ZEXPORT gzclose_w(gzFile file) { int ret = Z_OK; gz_statep state; /* get internal structure */ if (file == NULL) return Z_STREAM_ERROR; state = (gz_statep)file; /* check that we're writing */ if (state->mode != GZ_WRITE) return Z_STREAM_ERROR; /* check for seek request */ if (state->seek) { state->seek = 0; if (gz_zero(state, state->skip) == -1) ret = state->err; } /* flush, free memory, and close file */ if (gz_comp(state, Z_FINISH) == -1) ret = state->err; if (state->size) { if (!state->direct) { (void)deflateEnd(&(state->strm)); free(state->out); } free(state->in); } gz_error(state, Z_OK, NULL); free(state->path); if (close(state->fd) == -1) ret = Z_ERRNO; free(state); return ret; } tcl8.6.14/compat/zlib/win32/0000755000175000017500000000000014566153412015031 5ustar sergeisergeitcl8.6.14/compat/zlib/win32/zdll.lib0000644000175000017500000004260614554262142016474 0ustar sergeisergei! / 1649754903 0 3636 ` Еђ HEE'T'T(ˆ(ˆ:Ю:Ю=D=D,@,@(ю(ю( ( +l+l*0*0--'И'И*š*š++,А,АAfAf=Њ=ЊAжAж<м<м@(@(@@?Р?Р?X?X>>;2;2;š;šDВDВ#:#:#ž#ž$$C‚C‚CшCш4”4”0L0L-ю-ю8r8r6ц6ц1к1к:j:j2>2>5О5О::6„6„3h3h6"6"2Ђ2Ђ9 9 1v1v7Ќ7Ќ7H7H8к8к3Ъ3Ъ0А0А/ш/ш.И.И///‚/‚11.R.R4і4і889<9<4.4."f"f%:%:&&!–!–"д"д$n$n&№&№!њ!њ$а$а%І%І&„&„)Ш)Ш)^)^>№>№>†>†<<33DPDPB>B>-„-„BЊBЊCC2;š;ВD:#ž#$‚CшC”4L0ю-r8ц6к1j:>2О5:„6h3"6Ђ2 9v1Ќ7H7к8Ъ3А0ш/И./‚/1R.і48<9.4f":%&–!д"n$№&њ!а$І%„&Ш)^)№>†><3PD>B„-ЊBCp<њ@д+Z5ЕFJCG !HKDLEMI  ON  [ V&>:;<9%8=3)+1S/7B$?\,0.(54@'6A2-*RYQPZUWX"#TFJCG !HKDLEMI  ON  [ V&>:;<9%8=3)+1S/7B$?\,0.(54@'6A2-*RYQPZUWX"#T__IMPORT_DESCRIPTOR_zlib1__NULL_IMPORT_DESCRIPTOR__imp__adler32__imp__adler32_combine__imp__adler32_combine64__imp__adler32_z__imp__compress__imp__compress2__imp__compressBound__imp__crc32__imp__crc32_combine__imp__crc32_combine64__imp__crc32_combine_gen__imp__crc32_combine_gen64__imp__crc32_combine_op__imp__crc32_z__imp__deflate__imp__deflateBound__imp__deflateCopy__imp__deflateEnd__imp__deflateGetDictionary__imp__deflateInit2___imp__deflateInit___imp__deflateParams__imp__deflatePending__imp__deflatePrime__imp__deflateReset__imp__deflateResetKeep__imp__deflateSetDictionary__imp__deflateSetHeader__imp__deflateTune__imp__get_crc_table__imp__gzbuffer__imp__gzclearerr__imp__gzclose__imp__gzclose_r__imp__gzclose_w__imp__gzdirect__imp__gzdopen__imp__gzeof__imp__gzerror__imp__gzflush__imp__gzfread__imp__gzfwrite__imp__gzgetc__imp__gzgetc___imp__gzgets__imp__gzoffset__imp__gzoffset64__imp__gzopen__imp__gzopen64__imp__gzopen_w__imp__gzprintf__imp__gzputc__imp__gzputs__imp__gzread__imp__gzrewind__imp__gzseek__imp__gzseek64__imp__gzsetparams__imp__gztell__imp__gztell64__imp__gzungetc__imp__gzvprintf__imp__gzwrite__imp__inflate__imp__inflateBack__imp__inflateBackEnd__imp__inflateBackInit___imp__inflateCodesUsed__imp__inflateCopy__imp__inflateEnd__imp__inflateGetDictionary__imp__inflateGetHeader__imp__inflateInit2___imp__inflateInit___imp__inflateMark__imp__inflatePrime__imp__inflateReset__imp__inflateReset2__imp__inflateResetKeep__imp__inflateSetDictionary__imp__inflateSync__imp__inflateSyncPoint__imp__inflateUndermine__imp__inflateValidate__imp__uncompress__imp__uncompress2__imp__zError__imp__zlibCompileFlags__imp__zlibVersion_adler32_adler32_combine_adler32_combine64_adler32_z_compress_compress2_compressBound_crc32_crc32_combine_crc32_combine64_crc32_combine_gen_crc32_combine_gen64_crc32_combine_op_crc32_z_deflate_deflateBound_deflateCopy_deflateEnd_deflateGetDictionary_deflateInit2__deflateInit__deflateParams_deflatePending_deflatePrime_deflateReset_deflateResetKeep_deflateSetDictionary_deflateSetHeader_deflateTune_get_crc_table_gzbuffer_gzclearerr_gzclose_gzclose_r_gzclose_w_gzdirect_gzdopen_gzeof_gzerror_gzflush_gzfread_gzfwrite_gzgetc_gzgetc__gzgets_gzoffset_gzoffset64_gzopen_gzopen64_gzopen_w_gzprintf_gzputc_gzputs_gzread_gzrewind_gzseek_gzseek64_gzsetparams_gztell_gztell64_gzungetc_gzvprintf_gzwrite_inflate_inflateBack_inflateBackEnd_inflateBackInit__inflateCodesUsed_inflateCopy_inflateEnd_inflateGetDictionary_inflateGetHeader_inflateInit2__inflateInit__inflateMark_inflatePrime_inflateReset_inflateReset2_inflateResetKeep_inflateSetDictionary_inflateSync_inflateSyncPoint_inflateUndermine_inflateValidate_uncompress_uncompress2_zError_zlibCompileFlags_zlibVersionzlib1_NULL_THUNK_DATAzlib1.dll/ 1649754903 0 485 ` LCUb.debug$S?Œ@B.idata$2Ып@0Р.idata$6 §п@ Р zlib1.dll'ЅiMicrosoft (R) LINK zlib1.dll@comp.idЅiџџ.idata$2@Рh.idata$6.idata$4@Рh.idata$5@Рh7N__IMPORT_DESCRIPTOR_zlib1__NULL_IMPORT_DESCRIPTORzlib1_NULL_THUNK_DATA zlib1.dll/ 1649754903 0 248 ` LCUbЗ.debug$S?d@B.idata$3Ѓ@0Р zlib1.dll'ЅiMicrosoft (R) LINK@comp.idЅiџџ__NULL_IMPORT_DESCRIPTORzlib1.dll/ 1649754903 0 274 ` LCUbг.debug$S?Œ@B.idata$5Ы@0Р.idata$4Я@0Р zlib1.dll'ЅiMicrosoft (R) LINK@comp.idЅiџџzlib1_NULL_THUNK_DATAzlib1.dll/ 1649754903 0 39 ` џџLCUb_adler32zlib1.dll zlib1.dll/ 1649754903 0 47 ` џџLCUb_adler32_combinezlib1.dll zlib1.dll/ 1649754903 0 49 ` џџLCUb_adler32_combine64zlib1.dll zlib1.dll/ 1649754903 0 41 ` џџLCUb_adler32_zzlib1.dll zlib1.dll/ 1649754903 0 40 ` џџLCUb_compresszlib1.dllzlib1.dll/ 1649754903 0 41 ` џџLCUb_compress2zlib1.dll zlib1.dll/ 1649754903 0 45 ` џџLCUb_compressBoundzlib1.dll zlib1.dll/ 1649754903 0 37 ` џџLCUb_crc32zlib1.dll zlib1.dll/ 1649754903 0 45 ` џџLCUb_crc32_combinezlib1.dll zlib1.dll/ 1649754903 0 47 ` џџLCUb _crc32_combine64zlib1.dll zlib1.dll/ 1649754903 0 49 ` џџLCUb _crc32_combine_genzlib1.dll zlib1.dll/ 1649754903 0 51 ` џџLCUb _crc32_combine_gen64zlib1.dll zlib1.dll/ 1649754903 0 48 ` џџLCUb _crc32_combine_opzlib1.dllzlib1.dll/ 1649754903 0 39 ` џџLCUb _crc32_zzlib1.dll zlib1.dll/ 1649754903 0 39 ` џџLCUb_deflatezlib1.dll zlib1.dll/ 1649754903 0 44 ` џџLCUb_deflateBoundzlib1.dllzlib1.dll/ 1649754903 0 43 ` џџLCUb_deflateCopyzlib1.dll zlib1.dll/ 1649754903 0 42 ` џџLCUb_deflateEndzlib1.dllzlib1.dll/ 1649754903 0 52 ` џџLCUb _deflateGetDictionaryzlib1.dllzlib1.dll/ 1649754903 0 45 ` џџLCUb_deflateInit2_zlib1.dll zlib1.dll/ 1649754903 0 44 ` џџLCUb_deflateInit_zlib1.dllzlib1.dll/ 1649754903 0 45 ` џџLCUb_deflateParamszlib1.dll zlib1.dll/ 1649754903 0 46 ` џџLCUb_deflatePendingzlib1.dllzlib1.dll/ 1649754903 0 44 ` џџLCUb_deflatePrimezlib1.dllzlib1.dll/ 1649754903 0 44 ` џџLCUb_deflateResetzlib1.dllzlib1.dll/ 1649754903 0 48 ` џџLCUb_deflateResetKeepzlib1.dllzlib1.dll/ 1649754903 0 52 ` џџLCUb _deflateSetDictionaryzlib1.dllzlib1.dll/ 1649754903 0 48 ` џџLCUb_deflateSetHeaderzlib1.dllzlib1.dll/ 1649754903 0 43 ` џџLCUb_deflateTunezlib1.dll zlib1.dll/ 1649754903 0 45 ` џџLCUb_get_crc_tablezlib1.dll zlib1.dll/ 1649754903 0 40 ` џџLCUb_gzbufferzlib1.dllzlib1.dll/ 1649754903 0 42 ` џџLCUb_gzclearerrzlib1.dllzlib1.dll/ 1649754903 0 39 ` џџLCUb _gzclosezlib1.dll zlib1.dll/ 1649754903 0 41 ` џџLCUb!_gzclose_rzlib1.dll zlib1.dll/ 1649754903 0 41 ` џџLCUb"_gzclose_wzlib1.dll zlib1.dll/ 1649754903 0 40 ` џџLCUb#_gzdirectzlib1.dllzlib1.dll/ 1649754903 0 39 ` џџLCUb$_gzdopenzlib1.dll zlib1.dll/ 1649754903 0 37 ` џџLCUb%_gzeofzlib1.dll zlib1.dll/ 1649754903 0 39 ` џџLCUb&_gzerrorzlib1.dll zlib1.dll/ 1649754903 0 39 ` џџLCUb'_gzflushzlib1.dll zlib1.dll/ 1649754903 0 39 ` џџLCUb(_gzfreadzlib1.dll zlib1.dll/ 1649754903 0 40 ` џџLCUb)_gzfwritezlib1.dllzlib1.dll/ 1649754903 0 38 ` џџLCUb*_gzgetczlib1.dllzlib1.dll/ 1649754903 0 39 ` џџLCUb+_gzgetc_zlib1.dll zlib1.dll/ 1649754903 0 38 ` џџLCUb,_gzgetszlib1.dllzlib1.dll/ 1649754903 0 40 ` џџLCUb-_gzoffsetzlib1.dllzlib1.dll/ 1649754903 0 42 ` џџLCUb._gzoffset64zlib1.dllzlib1.dll/ 1649754903 0 38 ` џџLCUb/_gzopenzlib1.dllzlib1.dll/ 1649754903 0 40 ` џџLCUb0_gzopen64zlib1.dllzlib1.dll/ 1649754903 0 40 ` џџLCUb1_gzopen_wzlib1.dllzlib1.dll/ 1649754903 0 40 ` џџLCUb2_gzprintfzlib1.dllzlib1.dll/ 1649754903 0 38 ` џџLCUb3_gzputczlib1.dllzlib1.dll/ 1649754903 0 38 ` џџLCUb4_gzputszlib1.dllzlib1.dll/ 1649754903 0 38 ` џџLCUb5_gzreadzlib1.dllzlib1.dll/ 1649754903 0 40 ` џџLCUb6_gzrewindzlib1.dllzlib1.dll/ 1649754903 0 38 ` џџLCUb7_gzseekzlib1.dllzlib1.dll/ 1649754903 0 40 ` џџLCUb8_gzseek64zlib1.dllzlib1.dll/ 1649754903 0 43 ` џџLCUb9_gzsetparamszlib1.dll zlib1.dll/ 1649754903 0 38 ` џџLCUb:_gztellzlib1.dllzlib1.dll/ 1649754903 0 40 ` џџLCUb;_gztell64zlib1.dllzlib1.dll/ 1649754903 0 40 ` џџLCUb<_gzungetczlib1.dllzlib1.dll/ 1649754903 0 41 ` џџLCUb=_gzvprintfzlib1.dll zlib1.dll/ 1649754903 0 39 ` џџLCUb>_gzwritezlib1.dll zlib1.dll/ 1649754903 0 39 ` џџLCUb?_inflatezlib1.dll zlib1.dll/ 1649754903 0 43 ` џџLCUb@_inflateBackzlib1.dll zlib1.dll/ 1649754903 0 46 ` џџLCUbA_inflateBackEndzlib1.dllzlib1.dll/ 1649754903 0 48 ` џџLCUbB_inflateBackInit_zlib1.dllzlib1.dll/ 1649754903 0 48 ` џџLCUbC_inflateCodesUsedzlib1.dllzlib1.dll/ 1649754903 0 43 ` џџLCUbD_inflateCopyzlib1.dll zlib1.dll/ 1649754903 0 42 ` џџLCUbE_inflateEndzlib1.dllzlib1.dll/ 1649754903 0 52 ` џџLCUb F_inflateGetDictionaryzlib1.dllzlib1.dll/ 1649754903 0 48 ` џџLCUbG_inflateGetHeaderzlib1.dllzlib1.dll/ 1649754903 0 45 ` џџLCUbH_inflateInit2_zlib1.dll zlib1.dll/ 1649754903 0 44 ` џџLCUbI_inflateInit_zlib1.dllzlib1.dll/ 1649754903 0 43 ` џџLCUbJ_inflateMarkzlib1.dll zlib1.dll/ 1649754903 0 44 ` џџLCUbK_inflatePrimezlib1.dllzlib1.dll/ 1649754903 0 44 ` џџLCUbL_inflateResetzlib1.dllzlib1.dll/ 1649754903 0 45 ` џџLCUbM_inflateReset2zlib1.dll zlib1.dll/ 1649754903 0 48 ` џџLCUbN_inflateResetKeepzlib1.dllzlib1.dll/ 1649754903 0 52 ` џџLCUb O_inflateSetDictionaryzlib1.dllzlib1.dll/ 1649754903 0 43 ` џџLCUbP_inflateSynczlib1.dll zlib1.dll/ 1649754903 0 48 ` џџLCUbQ_inflateSyncPointzlib1.dllzlib1.dll/ 1649754903 0 48 ` џџLCUbR_inflateUnderminezlib1.dllzlib1.dll/ 1649754903 0 47 ` џџLCUbS_inflateValidatezlib1.dll zlib1.dll/ 1649754903 0 42 ` џџLCUbT_uncompresszlib1.dllzlib1.dll/ 1649754903 0 43 ` џџLCUbU_uncompress2zlib1.dll zlib1.dll/ 1649754903 0 38 ` џџLCUbV_zErrorzlib1.dllzlib1.dll/ 1649754903 0 48 ` џџLCUbW_zlibCompileFlagszlib1.dllzlib1.dll/ 1649754903 0 43 ` џџLCUbX_zlibVersionzlib1.dll tcl8.6.14/compat/zlib/win32/zlib.def0000644000175000017500000000323014554262142016445 0ustar sergeisergei; zlib data compression library EXPORTS ; basic functions zlibVersion deflate deflateEnd inflate inflateEnd ; advanced functions deflateSetDictionary deflateGetDictionary deflateCopy deflateReset deflateParams deflateTune deflateBound deflatePending deflatePrime deflateSetHeader inflateSetDictionary inflateGetDictionary inflateSync inflateCopy inflateReset inflateReset2 inflatePrime inflateMark inflateGetHeader inflateBack inflateBackEnd zlibCompileFlags ; utility functions compress compress2 compressBound uncompress uncompress2 gzopen gzdopen gzbuffer gzsetparams gzread gzfread gzwrite gzfwrite gzprintf gzvprintf gzputs gzgets gzputc gzgetc gzungetc gzflush gzseek gzrewind gztell gzoffset gzeof gzdirect gzclose gzclose_r gzclose_w gzerror gzclearerr ; large file functions gzopen64 gzseek64 gztell64 gzoffset64 adler32_combine64 crc32_combine64 crc32_combine_gen64 ; checksum functions adler32 adler32_z crc32 crc32_z adler32_combine crc32_combine crc32_combine_gen crc32_combine_op ; various hacks, don't look :) deflateInit_ deflateInit2_ inflateInit_ inflateInit2_ inflateBackInit_ gzgetc_ zError inflateSyncPoint get_crc_table inflateUndermine inflateValidate inflateCodesUsed inflateResetKeep deflateResetKeep gzopen_w tcl8.6.14/compat/zlib/win32/USAGE.txt0000644000175000017500000000611014554262142016432 0ustar sergeisergei Installing ZLIB1.DLL ==================== Copy ZLIB1.DLL to the SYSTEM or the SYSTEM32 directory. If you want to install the 32-bit dll on a 64-bit machine, use the SysWOW64 directory instead. Using ZLIB1.DLL with Microsoft Visual C++ ========================================= 1. Install the supplied header files "zlib.h" and "zconf.h" into a directory found in the INCLUDE path list. 2. Install the supplied library file "zdll.lib" into a directory found in the LIB path list. 3. Add "zdll.lib" to your project. Using ZLIB1.DLL with gcc/MinGW ============================== 1. Install the supplied header files "zlib.h" and "zconf.h" into the INCLUDE directory. 2. (32-bit): Copy the supplied library file "zdll.lib" to "libzdll.a": cp lib/zdll.lib lib/libzdll.a OR 2'. (64-bit): Copy the supplied library file "libz.dll.a" to "libzdll.a": cp lib/libz.dll.a lib/libzdll.a OR 2'' Build the import library from the supplied "zlib.def": dlltool -D zlib1.dll -d lib/zlib.def -l lib/libzdll.a 3. Install "libzdll.a" into the LIB directory. 4. Add "libzdll.a" to your project, or use the -lzdll option. Using ZLIB1.DLL with gcc/Cygwin =============================== ZLIB1.DLL is not designed to work with Cygwin. The Cygwin system has its own DLL build of zlib, named CYGZ.DLL. Using ZLIB1.DLL with Borland C++ ================================ 1. Install the supplied header files "zlib.h" and "zconf.h" into a directory found in the INCLUDE path list. 2. Build the import library using the IMPLIB tool: implib -a -c -f lib\zdllbor.lib zlib1.dll OR 2' Convert the supplied library file "zdll.lib" to OMF format, using the COFF2OMF tool: coff2omf lib\zdll.lib lib\zdllbor.lib 3. Install "zdllbor.lib" into a directory found in the LIB path list. 4. Add "zdllbor.lib" to your project. Notes: - The modules that are linked with "zdllbor.lib" must be compiled using a 4-byte alignment (option -a): bcc32 -a -c myprog.c bcc32 myprog.obj zdllbor.lib - If you wish, you may use "zlib1.lib" instead of "zdllbor.lib". Rebuilding ZLIB1.DLL ==================== Depending on your build environment, use the appropriate makefile from the win32/ directory, found in the zlib source distribution. Your custom build has to comply with the requirements stated in DLL_FAQ.txt, including (but not limited to) the following: - It must be built from an unaltered zlib source distribution. - It must be linked to MSVCRT.DLL. - The macros that compile out certain portions of the zlib code (such as NO_GZCOMPRESS, NO_GZIP) must not be enabled. - The ZLIB_WINAPI macro must not be enabled. Furthermore, it has to run successfully with the test suite found in this package. It is recommended, however, to use the supplied ZLIB1.DLL, instead of rebuilding it yourself. You should rebuild it only if you have a special reason. tcl8.6.14/compat/zlib/win32/README-WIN32.txt0000644000175000017500000001140014560736524017330 0ustar sergeisergeiZLIB DATA COMPRESSION LIBRARY zlib 1.3.1 is a general purpose data compression library. All the code is thread safe. The data format used by the zlib library is described by RFCs (Request for Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). All functions of the compression library are documented in the file zlib.h (volunteer to write man pages welcome, contact zlib@gzip.org). Two compiled examples are distributed in this package, example and minigzip. The example_d and minigzip_d flavors validate that the zlib1.dll file is working correctly. Questions about zlib should be sent to . The zlib home page is http://zlib.net/ . Before reporting a problem, please check this site to verify that you have the latest version of zlib; otherwise get the latest version and check whether the problem still exists or not. PLEASE read DLL_FAQ.txt, and the zlib FAQ http://zlib.net/zlib_faq.html before asking for help. Manifest: The package zlib-1.3.1-win32-x86.zip will contain the following files: README-WIN32.txt This document ChangeLog Changes since previous zlib packages DLL_FAQ.txt Frequently asked questions about zlib1.dll zlib.3.pdf Documentation of this library in Adobe Acrobat format example.exe A statically-bound example (using zlib.lib, not the dll) example.pdb Symbolic information for debugging example.exe example_d.exe A zlib1.dll bound example (using zdll.lib) example_d.pdb Symbolic information for debugging example_d.exe minigzip.exe A statically-bound test program (using zlib.lib, not the dll) minigzip.pdb Symbolic information for debugging minigzip.exe minigzip_d.exe A zlib1.dll bound test program (using zdll.lib) minigzip_d.pdb Symbolic information for debugging minigzip_d.exe zlib.h Install these files into the compilers' INCLUDE path to zconf.h compile programs which use zlib.lib or zdll.lib zdll.lib Install these files into the compilers' LIB path if linking zdll.exp a compiled program to the zlib1.dll binary zlib.lib Install these files into the compilers' LIB path to link zlib zlib.pdb into compiled programs, without zlib1.dll runtime dependency (zlib.pdb provides debugging info to the compile time linker) zlib1.dll Install this binary shared library into the system PATH, or the program's runtime directory (where the .exe resides) zlib1.pdb Install in the same directory as zlib1.dll, in order to debug an application crash using WinDbg or similar tools. All .pdb files above are entirely optional, but are very useful to a developer attempting to diagnose program misbehavior or a crash. Many additional important files for developers can be found in the zlib127.zip source package available from http://zlib.net/ - review that package's README file for details. Acknowledgments: The deflate format used by zlib was defined by Phil Katz. The deflate and zlib specifications were written by L. Peter Deutsch. Thanks to all the people who reported problems and suggested various improvements in zlib; they are too numerous to cite here. Copyright notice: (C) 1995-2017 Jean-loup Gailly and Mark Adler This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. Jean-loup Gailly Mark Adler jloup@gzip.org madler@alumni.caltech.edu If you use the zlib library in a product, we would appreciate *not* receiving lengthy legal documents to sign. The sources are provided for free but without warranty of any kind. The library has been entirely written by Jean-loup Gailly and Mark Adler; it does not include third-party code. If you redistribute modified sources, we would appreciate that you include in the file ChangeLog history information documenting your changes. Please read the FAQ for more information on the distribution of modified source versions. tcl8.6.14/compat/zlib/win32/Makefile.gcc0000644000175000017500000001156714554262142017234 0ustar sergeisergei# Makefile for zlib, derived from Makefile.dj2. # Modified for mingw32 by C. Spieler, 6/16/98. # Updated for zlib 1.2.x by Christian Spieler and Cosmin Truta, Mar-2003. # Last updated: Mar 2012. # Tested under Cygwin and MinGW. # Copyright (C) 1995-2003 Jean-loup Gailly. # For conditions of distribution and use, see copyright notice in zlib.h # To compile, or to compile and test, type from the top level zlib directory: # # make -fwin32/Makefile.gcc; make test testdll -fwin32/Makefile.gcc # # To install libz.a, zconf.h and zlib.h in the system directories, type: # # make install -fwin32/Makefile.gcc # # BINARY_PATH, INCLUDE_PATH and LIBRARY_PATH must be set. # # To install the shared lib, append SHARED_MODE=1 to the make command : # # make install -fwin32/Makefile.gcc SHARED_MODE=1 # Note: # If the platform is *not* MinGW (e.g. it is Cygwin or UWIN), # the DLL name should be changed from "zlib1.dll". STATICLIB = libz.a SHAREDLIB = zlib1.dll IMPLIB = libz.dll.a # # Set to 1 if shared object needs to be installed # SHARED_MODE=0 #LOC = -DZLIB_DEBUG -g PREFIX = CC = $(PREFIX)gcc CFLAGS = $(LOC) -O3 -Wall AS = $(CC) ASFLAGS = $(LOC) -Wall LD = $(CC) LDFLAGS = $(LOC) AR = $(PREFIX)ar ARFLAGS = rcs RC = $(PREFIX)windres RCFLAGS = --define GCC_WINDRES STRIP = $(PREFIX)strip CP = cp -fp # If GNU install is available, replace $(CP) with install. INSTALL = $(CP) RM = rm -f prefix ?= /usr/local exec_prefix = $(prefix) OBJS = adler32.o compress.o crc32.o deflate.o gzclose.o gzlib.o gzread.o \ gzwrite.o infback.o inffast.o inflate.o inftrees.o trees.o uncompr.o zutil.o OBJA = all: $(STATICLIB) $(SHAREDLIB) $(IMPLIB) example.exe minigzip.exe example_d.exe minigzip_d.exe test: example.exe minigzip.exe ./example echo hello world | ./minigzip | ./minigzip -d testdll: example_d.exe minigzip_d.exe ./example_d echo hello world | ./minigzip_d | ./minigzip_d -d .c.o: $(CC) $(CFLAGS) -c -o $@ $< .S.o: $(AS) $(ASFLAGS) -c -o $@ $< $(STATICLIB): $(OBJS) $(OBJA) $(AR) $(ARFLAGS) $@ $(OBJS) $(OBJA) $(IMPLIB): $(SHAREDLIB) $(SHAREDLIB): win32/zlib.def $(OBJS) $(OBJA) zlibrc.o $(CC) -shared -Wl,--out-implib,$(IMPLIB) $(LDFLAGS) \ -o $@ win32/zlib.def $(OBJS) $(OBJA) zlibrc.o $(STRIP) $@ example.exe: example.o $(STATICLIB) $(LD) $(LDFLAGS) -o $@ example.o $(STATICLIB) $(STRIP) $@ minigzip.exe: minigzip.o $(STATICLIB) $(LD) $(LDFLAGS) -o $@ minigzip.o $(STATICLIB) $(STRIP) $@ example_d.exe: example.o $(IMPLIB) $(LD) $(LDFLAGS) -o $@ example.o $(IMPLIB) $(STRIP) $@ minigzip_d.exe: minigzip.o $(IMPLIB) $(LD) $(LDFLAGS) -o $@ minigzip.o $(IMPLIB) $(STRIP) $@ example.o: test/example.c zlib.h zconf.h $(CC) $(CFLAGS) -I. -c -o $@ test/example.c minigzip.o: test/minigzip.c zlib.h zconf.h $(CC) $(CFLAGS) -I. -c -o $@ test/minigzip.c zlibrc.o: win32/zlib1.rc $(RC) $(RCFLAGS) -o $@ win32/zlib1.rc .PHONY: install uninstall clean install: zlib.h zconf.h $(STATICLIB) $(IMPLIB) @if test -z "$(DESTDIR)$(INCLUDE_PATH)" -o -z "$(DESTDIR)$(LIBRARY_PATH)" -o -z "$(DESTDIR)$(BINARY_PATH)"; then \ echo INCLUDE_PATH, LIBRARY_PATH, and BINARY_PATH must be specified; \ exit 1; \ fi -@mkdir -p '$(DESTDIR)$(INCLUDE_PATH)' -@mkdir -p '$(DESTDIR)$(LIBRARY_PATH)' '$(DESTDIR)$(LIBRARY_PATH)'/pkgconfig -if [ "$(SHARED_MODE)" = "1" ]; then \ mkdir -p '$(DESTDIR)$(BINARY_PATH)'; \ $(INSTALL) $(SHAREDLIB) '$(DESTDIR)$(BINARY_PATH)'; \ $(INSTALL) $(IMPLIB) '$(DESTDIR)$(LIBRARY_PATH)'; \ fi -$(INSTALL) zlib.h '$(DESTDIR)$(INCLUDE_PATH)' -$(INSTALL) zconf.h '$(DESTDIR)$(INCLUDE_PATH)' -$(INSTALL) $(STATICLIB) '$(DESTDIR)$(LIBRARY_PATH)' sed \ -e 's|@prefix@|${prefix}|g' \ -e 's|@exec_prefix@|${exec_prefix}|g' \ -e 's|@libdir@|$(LIBRARY_PATH)|g' \ -e 's|@sharedlibdir@|$(LIBRARY_PATH)|g' \ -e 's|@includedir@|$(INCLUDE_PATH)|g' \ -e 's|@VERSION@|'`sed -n -e '/VERSION "/s/.*"\(.*\)".*/\1/p' zlib.h`'|g' \ zlib.pc.in > '$(DESTDIR)$(LIBRARY_PATH)'/pkgconfig/zlib.pc uninstall: -if [ "$(SHARED_MODE)" = "1" ]; then \ $(RM) '$(DESTDIR)$(BINARY_PATH)'/$(SHAREDLIB); \ $(RM) '$(DESTDIR)$(LIBRARY_PATH)'/$(IMPLIB); \ fi -$(RM) '$(DESTDIR)$(INCLUDE_PATH)'/zlib.h -$(RM) '$(DESTDIR)$(INCLUDE_PATH)'/zconf.h -$(RM) '$(DESTDIR)$(LIBRARY_PATH)'/$(STATICLIB) clean: -$(RM) $(STATICLIB) -$(RM) $(SHAREDLIB) -$(RM) $(IMPLIB) -$(RM) *.o -$(RM) *.exe -$(RM) foo.gz adler32.o: zlib.h zconf.h compress.o: zlib.h zconf.h crc32.o: crc32.h zlib.h zconf.h deflate.o: deflate.h zutil.h zlib.h zconf.h gzclose.o: zlib.h zconf.h gzguts.h gzlib.o: zlib.h zconf.h gzguts.h gzread.o: zlib.h zconf.h gzguts.h gzwrite.o: zlib.h zconf.h gzguts.h inffast.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h inflate.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h infback.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h inftrees.o: zutil.h zlib.h zconf.h inftrees.h trees.o: deflate.h zutil.h zlib.h zconf.h trees.h uncompr.o: zlib.h zconf.h zutil.o: zutil.h zlib.h zconf.h tcl8.6.14/compat/zlib/win32/Makefile.msc0000644000175000017500000001106114554262142017247 0ustar sergeisergei# Makefile for zlib using Microsoft (Visual) C # zlib is copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler # # Usage: # nmake -f win32/Makefile.msc (standard build) # nmake -f win32/Makefile.msc LOC=-DFOO (nonstandard build) # The toplevel directory of the source tree. # TOP = . # optional build flags LOC = # variables STATICLIB = zlib.lib SHAREDLIB = zlib1.dll IMPLIB = zdll.lib CC = cl AS = ml LD = link AR = lib RC = rc CFLAGS = -nologo -MD -W3 -O2 -Oy- -Zi -Fd"zlib" $(LOC) WFLAGS = -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE ASFLAGS = -coff -Zi $(LOC) LDFLAGS = -nologo -debug -incremental:no -opt:ref ARFLAGS = -nologo RCFLAGS = /dWIN32 /r OBJS = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj \ gzwrite.obj infback.obj inflate.obj inftrees.obj inffast.obj trees.obj uncompr.obj zutil.obj OBJA = # targets all: $(STATICLIB) $(SHAREDLIB) $(IMPLIB) \ example.exe minigzip.exe example_d.exe minigzip_d.exe $(STATICLIB): $(OBJS) $(OBJA) $(AR) $(ARFLAGS) -out:$@ $(OBJS) $(OBJA) $(IMPLIB): $(SHAREDLIB) $(SHAREDLIB): $(TOP)/win32/zlib.def $(OBJS) $(OBJA) zlib1.res $(LD) $(LDFLAGS) -def:$(TOP)/win32/zlib.def -dll -implib:$(IMPLIB) \ -out:$@ -base:0x5A4C0000 $(OBJS) $(OBJA) zlib1.res if exist $@.manifest \ mt -nologo -manifest $@.manifest -outputresource:$@;2 example.exe: example.obj $(STATICLIB) $(LD) $(LDFLAGS) example.obj $(STATICLIB) if exist $@.manifest \ mt -nologo -manifest $@.manifest -outputresource:$@;1 minigzip.exe: minigzip.obj $(STATICLIB) $(LD) $(LDFLAGS) minigzip.obj $(STATICLIB) if exist $@.manifest \ mt -nologo -manifest $@.manifest -outputresource:$@;1 example_d.exe: example.obj $(IMPLIB) $(LD) $(LDFLAGS) -out:$@ example.obj $(IMPLIB) if exist $@.manifest \ mt -nologo -manifest $@.manifest -outputresource:$@;1 minigzip_d.exe: minigzip.obj $(IMPLIB) $(LD) $(LDFLAGS) -out:$@ minigzip.obj $(IMPLIB) if exist $@.manifest \ mt -nologo -manifest $@.manifest -outputresource:$@;1 {$(TOP)}.c.obj: $(CC) -c $(WFLAGS) $(CFLAGS) $< {$(TOP)/test}.c.obj: $(CC) -c -I$(TOP) $(WFLAGS) $(CFLAGS) $< {$(TOP)/contrib/masmx64}.c.obj: $(CC) -c $(WFLAGS) $(CFLAGS) $< {$(TOP)/contrib/masmx64}.asm.obj: $(AS) -c $(ASFLAGS) $< {$(TOP)/contrib/masmx86}.asm.obj: $(AS) -c $(ASFLAGS) $< adler32.obj: $(TOP)/adler32.c $(TOP)/zlib.h $(TOP)/zconf.h compress.obj: $(TOP)/compress.c $(TOP)/zlib.h $(TOP)/zconf.h crc32.obj: $(TOP)/crc32.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/crc32.h deflate.obj: $(TOP)/deflate.c $(TOP)/deflate.h $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h gzclose.obj: $(TOP)/gzclose.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h gzlib.obj: $(TOP)/gzlib.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h gzread.obj: $(TOP)/gzread.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h gzwrite.obj: $(TOP)/gzwrite.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h infback.obj: $(TOP)/infback.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \ $(TOP)/inffast.h $(TOP)/inffixed.h inffast.obj: $(TOP)/inffast.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \ $(TOP)/inffast.h inflate.obj: $(TOP)/inflate.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \ $(TOP)/inffast.h $(TOP)/inffixed.h inftrees.obj: $(TOP)/inftrees.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h trees.obj: $(TOP)/trees.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/deflate.h $(TOP)/trees.h uncompr.obj: $(TOP)/uncompr.c $(TOP)/zlib.h $(TOP)/zconf.h zutil.obj: $(TOP)/zutil.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h gvmat64.obj: $(TOP)/contrib\masmx64\gvmat64.asm inffasx64.obj: $(TOP)/contrib\masmx64\inffasx64.asm inffas8664.obj: $(TOP)/contrib\masmx64\inffas8664.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h \ $(TOP)/inftrees.h $(TOP)/inflate.h $(TOP)/inffast.h inffas32.obj: $(TOP)/contrib\masmx86\inffas32.asm match686.obj: $(TOP)/contrib\masmx86\match686.asm example.obj: $(TOP)/test/example.c $(TOP)/zlib.h $(TOP)/zconf.h minigzip.obj: $(TOP)/test/minigzip.c $(TOP)/zlib.h $(TOP)/zconf.h zlib1.res: $(TOP)/win32/zlib1.rc $(RC) $(RCFLAGS) /fo$@ $(TOP)/win32/zlib1.rc # testing test: example.exe minigzip.exe example echo hello world | minigzip | minigzip -d testdll: example_d.exe minigzip_d.exe example_d echo hello world | minigzip_d | minigzip_d -d # cleanup clean: -del $(STATICLIB) -del $(SHAREDLIB) -del $(IMPLIB) -del *.obj -del *.res -del *.exp -del *.exe -del *.pdb -del *.manifest -del foo.gz tcl8.6.14/compat/zlib/win32/Makefile.bor0000644000175000017500000000471314554262142017255 0ustar sergeisergei# Makefile for zlib # Borland C++ for Win32 # # Usage: # make -f win32/Makefile.bor # ------------ Borland C++ ------------ # Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7) # should be added to the environment via "set LOCAL_ZLIB=-DFOO" or # added to the declaration of LOC here: LOC = $(LOCAL_ZLIB) CC = bcc32 AS = bcc32 LD = bcc32 AR = tlib CFLAGS = -a -d -k- -O2 $(LOC) ASFLAGS = $(LOC) LDFLAGS = $(LOC) # variables ZLIB_LIB = zlib.lib OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj #OBJA = OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj #OBJPA= # targets all: $(ZLIB_LIB) example.exe minigzip.exe .c.obj: $(CC) -c $(CFLAGS) $< .asm.obj: $(AS) -c $(ASFLAGS) $< adler32.obj: adler32.c zlib.h zconf.h compress.obj: compress.c zlib.h zconf.h crc32.obj: crc32.c zlib.h zconf.h crc32.h deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h gzread.obj: gzread.c zlib.h zconf.h gzguts.h gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h uncompr.obj: uncompr.c zlib.h zconf.h zutil.obj: zutil.c zutil.h zlib.h zconf.h example.obj: test/example.c zlib.h zconf.h minigzip.obj: test/minigzip.c zlib.h zconf.h # For the sake of the old Borland make, # the command line is cut to fit in the MS-DOS 128 byte limit: $(ZLIB_LIB): $(OBJ1) $(OBJ2) $(OBJA) -del $(ZLIB_LIB) $(AR) $(ZLIB_LIB) $(OBJP1) $(AR) $(ZLIB_LIB) $(OBJP2) $(AR) $(ZLIB_LIB) $(OBJPA) # testing test: example.exe minigzip.exe example echo hello world | minigzip | minigzip -d example.exe: example.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB) minigzip.exe: minigzip.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB) # cleanup clean: -del $(ZLIB_LIB) -del *.obj -del *.exe -del *.tds -del zlib.bak -del foo.gz tcl8.6.14/compat/zlib/win32/README.txt0000644000175000017500000000355414560736524016543 0ustar sergeisergei What's here =========== The official ZLIB1.DLL Source ====== zlib version 1.3.1 available at http://www.gzip.org/zlib/ Specification and rationale =========================== See the accompanying DLL_FAQ.txt Usage ===== See the accompanying USAGE.txt Build info ========== Contributed by Jan Nijtmans. Compiler: i686-w64-mingw32-gcc (GCC) 5.4.0 Library: mingw64-i686-runtime/headers: 5.0.0 Build commands: i686-w64-mingw32-gcc -c -DASMV contrib/asm686/match.S i686-w64-mingw32-gcc -c -DASMINF -I. -O3 contrib/inflate86/inffas86.c make -f win32/Makefile.gcc PREFIX=i686-w64-mingw32- LOC="-mms-bitfields -DASMV -DASMINF" OBJA="inffas86.o match.o" Finally, from VS commandline (VS2005 or higher): lib -machine:X86 -name:zlib1.dll -def:zlib.def -out:zdll.lib Copyright notice ================ Copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. Jean-loup Gailly Mark Adler jloup@gzip.org madler@alumni.caltech.edu tcl8.6.14/compat/zlib/win32/zlib1.rc0000644000175000017500000000216214554262142016377 0ustar sergeisergei#include #include "../zlib.h" #ifdef GCC_WINDRES VS_VERSION_INFO VERSIONINFO #else VS_VERSION_INFO VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE #endif FILEVERSION ZLIB_VER_MAJOR,ZLIB_VER_MINOR,ZLIB_VER_REVISION,0 PRODUCTVERSION ZLIB_VER_MAJOR,ZLIB_VER_MINOR,ZLIB_VER_REVISION,0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK #ifdef _DEBUG FILEFLAGS 1 #else FILEFLAGS 0 #endif FILEOS VOS__WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0 // not used BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904E4" //language ID = U.S. English, char set = Windows, Multilingual BEGIN VALUE "FileDescription", "zlib data compression library\0" VALUE "FileVersion", ZLIB_VERSION "\0" VALUE "InternalName", "zlib1.dll\0" VALUE "LegalCopyright", "(C) 1995-2022 Jean-loup Gailly & Mark Adler\0" VALUE "OriginalFilename", "zlib1.dll\0" VALUE "ProductName", "zlib\0" VALUE "ProductVersion", ZLIB_VERSION "\0" VALUE "Comments", "For more information visit http://www.zlib.net/\0" END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x0409, 1252 END END tcl8.6.14/compat/zlib/win32/DLL_FAQ.txt0000644000175000017500000004164114560736524016707 0ustar sergeisergei Frequently Asked Questions about ZLIB1.DLL This document describes the design, the rationale, and the usage of the common DLL build of zlib, named ZLIB1.DLL. If you have general questions about zlib, you should see the file "FAQ" found in the zlib distribution, or at the following location: http://www.gzip.org/zlib/zlib_faq.html 1. What is ZLIB1.DLL, and how can I get it? - ZLIB1.DLL is the common build of zlib as a DLL. (Please remark the character '1' in the name.) Applications that link to ZLIB1.DLL can rely on the following specification: * The exported symbols are exclusively defined in the source files "zlib.h" and "zlib.def", found in an official zlib source distribution. * The symbols are exported by name, not by ordinal. * The exported names are undecorated. * The calling convention of functions is "C" (CDECL). * The ZLIB1.DLL binary is linked to MSVCRT.DLL. The archive in which ZLIB1.DLL is bundled contains compiled test programs that must run with a valid build of ZLIB1.DLL. It is recommended to download the prebuilt DLL from the zlib web site, instead of building it yourself, to avoid potential incompatibilities that could be introduced by your compiler and build settings. If you do build the DLL yourself, please make sure that it complies with all the above requirements, and it runs with the precompiled test programs, bundled with the original ZLIB1.DLL distribution. If, for any reason, you need to build an incompatible DLL, please use a different file name. 2. Why did you change the name of the DLL to ZLIB1.DLL? What happened to the old ZLIB.DLL? - The old ZLIB.DLL, built from zlib-1.1.4 or earlier, required compilation settings that were incompatible to those used by a static build. The DLL settings were supposed to be enabled by defining the macro ZLIB_DLL, before including "zlib.h". Incorrect handling of this macro was silently accepted at build time, resulting in two major problems: * ZLIB_DLL was missing from the old makefile. When building the DLL, not all people added it to the build options. In consequence, incompatible incarnations of ZLIB.DLL started to circulate around the net. * When switching from using the static library to using the DLL, applications had to define the ZLIB_DLL macro and to recompile all the sources that contained calls to zlib functions. Failure to do so resulted in creating binaries that were unable to run with the official ZLIB.DLL build. The only possible solution that we could foresee was to make a binary-incompatible change in the DLL interface, in order to remove the dependency on the ZLIB_DLL macro, and to release the new DLL under a different name. We chose the name ZLIB1.DLL, where '1' indicates the major zlib version number. We hope that we will not have to break the binary compatibility again, at least not as long as the zlib-1.x series will last. There is still a ZLIB_DLL macro, that can trigger a more efficient build and use of the DLL, but compatibility no longer dependents on it. 3. Can I build ZLIB.DLL from the new zlib sources, and replace an old ZLIB.DLL, that was built from zlib-1.1.4 or earlier? - In principle, you can do it by assigning calling convention keywords to the macros ZEXPORT and ZEXPORTVA. In practice, it depends on what you mean by "an old ZLIB.DLL", because the old DLL exists in several mutually-incompatible versions. You have to find out first what kind of calling convention is being used in your particular ZLIB.DLL build, and to use the same one in the new build. If you don't know what this is all about, you might be better off if you would just leave the old DLL intact. 4. Can I compile my application using the new zlib interface, and link it to an old ZLIB.DLL, that was built from zlib-1.1.4 or earlier? - The official answer is "no"; the real answer depends again on what kind of ZLIB.DLL you have. Even if you are lucky, this course of action is unreliable. If you rebuild your application and you intend to use a newer version of zlib (post- 1.1.4), it is strongly recommended to link it to the new ZLIB1.DLL. 5. Why are the zlib symbols exported by name, and not by ordinal? - Although exporting symbols by ordinal is a little faster, it is risky. Any single glitch in the maintenance or use of the DEF file that contains the ordinals can result in incompatible builds and frustrating crashes. Simply put, the benefits of exporting symbols by ordinal do not justify the risks. Technically, it should be possible to maintain ordinals in the DEF file, and still export the symbols by name. Ordinals exist in every DLL, and even if the dynamic linking performed at the DLL startup is searching for names, ordinals serve as hints, for a faster name lookup. However, if the DEF file contains ordinals, the Microsoft linker automatically builds an implib that will cause the executables linked to it to use those ordinals, and not the names. It is interesting to notice that the GNU linker for Win32 does not suffer from this problem. It is possible to avoid the DEF file if the exported symbols are accompanied by a "__declspec(dllexport)" attribute in the source files. You can do this in zlib by predefining the ZLIB_DLL macro. 6. I see that the ZLIB1.DLL functions use the "C" (CDECL) calling convention. Why not use the STDCALL convention? STDCALL is the standard convention in Win32, and I need it in my Visual Basic project! (For readability, we use CDECL to refer to the convention triggered by the "__cdecl" keyword, STDCALL to refer to the convention triggered by "__stdcall", and FASTCALL to refer to the convention triggered by "__fastcall".) - Most of the native Windows API functions (without varargs) use indeed the WINAPI convention (which translates to STDCALL in Win32), but the standard C functions use CDECL. If a user application is intrinsically tied to the Windows API (e.g. it calls native Windows API functions such as CreateFile()), sometimes it makes sense to decorate its own functions with WINAPI. But if ANSI C or POSIX portability is a goal (e.g. it calls standard C functions such as fopen()), it is not a sound decision to request the inclusion of , or to use non-ANSI constructs, for the sole purpose to make the user functions STDCALL-able. The functionality offered by zlib is not in the category of "Windows functionality", but is more like "C functionality". Technically, STDCALL is not bad; in fact, it is slightly faster than CDECL, and it works with variable-argument functions, just like CDECL. It is unfortunate that, in spite of using STDCALL in the Windows API, it is not the default convention used by the C compilers that run under Windows. The roots of the problem reside deep inside the unsafety of the K&R-style function prototypes, where the argument types are not specified; but that is another story for another day. The remaining fact is that CDECL is the default convention. Even if an explicit convention is hard-coded into the function prototypes inside C headers, problems may appear. The necessity to expose the convention in users' callbacks is one of these problems. The calling convention issues are also important when using zlib in other programming languages. Some of them, like Ada (GNAT) and Fortran (GNU G77), have C bindings implemented initially on Unix, and relying on the C calling convention. On the other hand, the pre- .NET versions of Microsoft Visual Basic require STDCALL, while Borland Delphi prefers, although it does not require, FASTCALL. In fairness to all possible uses of zlib outside the C programming language, we choose the default "C" convention. Anyone interested in different bindings or conventions is encouraged to maintain specialized projects. The "contrib/" directory from the zlib distribution already holds a couple of foreign bindings, such as Ada, C++, and Delphi. 7. I need a DLL for my Visual Basic project. What can I do? - Define the ZLIB_WINAPI macro before including "zlib.h", when building both the DLL and the user application (except that you don't need to define anything when using the DLL in Visual Basic). The ZLIB_WINAPI macro will switch on the WINAPI (STDCALL) convention. The name of this DLL must be different than the official ZLIB1.DLL. Gilles Vollant has contributed a build named ZLIBWAPI.DLL, with the ZLIB_WINAPI macro turned on, and with the minizip functionality built in. For more information, please read the notes inside "contrib/vstudio/readme.txt", found in the zlib distribution. 8. I need to use zlib in my Microsoft .NET project. What can I do? - Henrik Ravn has contributed a .NET wrapper around zlib. Look into contrib/dotzlib/, inside the zlib distribution. 9. If my application uses ZLIB1.DLL, should I link it to MSVCRT.DLL? Why? - It is not required, but it is recommended to link your application to MSVCRT.DLL, if it uses ZLIB1.DLL. The executables (.EXE, .DLL, etc.) that are involved in the same process and are using the C run-time library (i.e. they are calling standard C functions), must link to the same library. There are several libraries in the Win32 system: CRTDLL.DLL, MSVCRT.DLL, the static C libraries, etc. Since ZLIB1.DLL is linked to MSVCRT.DLL, the executables that depend on it should also be linked to MSVCRT.DLL. 10. Why are you saying that ZLIB1.DLL and my application should be linked to the same C run-time (CRT) library? I linked my application and my DLLs to different C libraries (e.g. my application to a static library, and my DLLs to MSVCRT.DLL), and everything works fine. - If a user library invokes only pure Win32 API (accessible via and the related headers), its DLL build will work in any context. But if this library invokes standard C API, things get more complicated. There is a single Win32 library in a Win32 system. Every function in this library resides in a single DLL module, that is safe to call from anywhere. On the other hand, there are multiple versions of the C library, and each of them has its own separate internal state. Standalone executables and user DLLs that call standard C functions must link to a C run-time (CRT) library, be it static or shared (DLL). Intermixing occurs when an executable (not necessarily standalone) and a DLL are linked to different CRTs, and both are running in the same process. Intermixing multiple CRTs is possible, as long as their internal states are kept intact. The Microsoft Knowledge Base articles KB94248 "HOWTO: Use the C Run-Time" and KB140584 "HOWTO: Link with the Correct C Run-Time (CRT) Library" mention the potential problems raised by intermixing. If intermixing works for you, it's because your application and DLLs are avoiding the corruption of each of the CRTs' internal states, maybe by careful design, or maybe by fortune. Also note that linking ZLIB1.DLL to non-Microsoft CRTs, such as those provided by Borland, raises similar problems. 11. Why are you linking ZLIB1.DLL to MSVCRT.DLL? - MSVCRT.DLL exists on every Windows 95 with a new service pack installed, or with Microsoft Internet Explorer 4 or later, and on all other Windows 4.x or later (Windows 98, Windows NT 4, or later). It is freely distributable; if not present in the system, it can be downloaded from Microsoft or from other software provider for free. The fact that MSVCRT.DLL does not exist on a virgin Windows 95 is not so problematic. Windows 95 is scarcely found nowadays, Microsoft ended its support a long time ago, and many recent applications from various vendors, including Microsoft, do not even run on it. Furthermore, no serious user should run Windows 95 without a proper update installed. 12. Why are you not linking ZLIB1.DLL to <> ? - We considered and abandoned the following alternatives: * Linking ZLIB1.DLL to a static C library (LIBC.LIB, or LIBCMT.LIB) is not a good option. People are using the DLL mainly to save disk space. If you are linking your program to a static C library, you may as well consider linking zlib in statically, too. * Linking ZLIB1.DLL to CRTDLL.DLL looks appealing, because CRTDLL.DLL is present on every Win32 installation. Unfortunately, it has a series of problems: it does not work properly with Microsoft's C++ libraries, it does not provide support for 64-bit file offsets, (and so on...), and Microsoft discontinued its support a long time ago. * Linking ZLIB1.DLL to MSVCR70.DLL or MSVCR71.DLL, supplied with the Microsoft .NET platform, and Visual C++ 7.0/7.1, raises problems related to the status of ZLIB1.DLL as a system component. According to the Microsoft Knowledge Base article KB326922 "INFO: Redistribution of the Shared C Runtime Component in Visual C++ .NET", MSVCR70.DLL and MSVCR71.DLL are not supposed to function as system DLLs, because they may clash with MSVCRT.DLL. Instead, the application's installer is supposed to put these DLLs (if needed) in the application's private directory. If ZLIB1.DLL depends on a non-system runtime, it cannot function as a redistributable system component. * Linking ZLIB1.DLL to non-Microsoft runtimes, such as Borland's, or Cygwin's, raises problems related to the reliable presence of these runtimes on Win32 systems. It's easier to let the DLL build of zlib up to the people who distribute these runtimes, and who may proceed as explained in the answer to Question 14. 13. If ZLIB1.DLL cannot be linked to MSVCR70.DLL or MSVCR71.DLL, how can I build/use ZLIB1.DLL in Microsoft Visual C++ 7.0 (Visual Studio .NET) or newer? - Due to the problems explained in the Microsoft Knowledge Base article KB326922 (see the previous answer), the C runtime that comes with the VC7 environment is no longer considered a system component. That is, it should not be assumed that this runtime exists, or may be installed in a system directory. Since ZLIB1.DLL is supposed to be a system component, it may not depend on a non-system component. In order to link ZLIB1.DLL and your application to MSVCRT.DLL in VC7, you need the library of Visual C++ 6.0 or older. If you don't have this library at hand, it's probably best not to use ZLIB1.DLL. We are hoping that, in the future, Microsoft will provide a way to build applications linked to a proper system runtime, from the Visual C++ environment. Until then, you have a couple of alternatives, such as linking zlib in statically. If your application requires dynamic linking, you may proceed as explained in the answer to Question 14. 14. I need to link my own DLL build to a CRT different than MSVCRT.DLL. What can I do? - Feel free to rebuild the DLL from the zlib sources, and link it the way you want. You should, however, clearly state that your build is unofficial. You should give it a different file name, and/or install it in a private directory that can be accessed by your application only, and is not visible to the others (i.e. it's neither in the PATH, nor in the SYSTEM or SYSTEM32 directories). Otherwise, your build may clash with applications that link to the official build. For example, in Cygwin, zlib is linked to the Cygwin runtime CYGWIN1.DLL, and it is distributed under the name CYGZ.DLL. 15. May I include additional pieces of code that I find useful, link them in ZLIB1.DLL, and export them? - No. A legitimate build of ZLIB1.DLL must not include code that does not originate from the official zlib source code. But you can make your own private DLL build, under a different file name, as suggested in the previous answer. For example, zlib is a part of the VCL library, distributed with Borland Delphi and C++ Builder. The DLL build of VCL is a redistributable file, named VCLxx.DLL. 16. May I remove some functionality out of ZLIB1.DLL, by enabling macros like NO_GZCOMPRESS or NO_GZIP at compile time? - No. A legitimate build of ZLIB1.DLL must provide the complete zlib functionality, as implemented in the official zlib source code. But you can make your own private DLL build, under a different file name, as suggested in the previous answer. ** This document is written and maintained by Cosmin Truta tcl8.6.14/compat/zlib/win32/zlib1.dll0000755000175000017500000036000014560736524016556 0ustar sergeisergeiMZџџИ@€КД Э!ИLЭ!This program cannot be run in DOS mode. $PEL dЗeр# 'xм Аc`1@ б@ˆPдкШ.textдwx``.dataH|@Р.rdatadC D~@@.bss0 №€Р.edataбТ@@.idataЪ@Р.CRT, а@Р.tls0в@Р.rsrcˆ@д@Р.relocPи@BƒьЧ$№ cшApƒФУД&ЖWVSƒь‹D$$…Рur‹ № c…в~Wƒъ1џО‰ № cыЖЧ$шџ( cƒь‰ј№Б5№ c‰У…РuрЁ№ cƒј„тЧ$шжtИƒФ[^_Т Д&ƒј…ЇdЁ‹=( c‹X1іыt&9У„ШЧ$шџзƒь‰№№Б№ c…Рuо1лЁ№ cƒј„Ё№ c…Р„БЁ№ cƒј„Ы…л„‹Ёак c…Рt‹T$(ЧD$‰T$‹T$ ‰$џаƒь ƒ № cƒФИ[^_Т ƒФИ[^_Т fЧ$№ cшфoЧ№ c‡№ cИщ џџџД&vЛщJџџџЖ‡№ cщjџџџt&ЧD$ cЧ$ cЧ№ cшЊsщ,џџџt&ЧD$ cЧ$ cшŒsЧ№ cщџџџt&Ч$шTsщюўџџД&Д&UW‰ЯV‰ЦS‰гƒь‰  c…вuiЁ № c…РtHш{‰|$ЧD$‰4$шƒь ‰|$‰\$‰4$шфƒь ‰Х‰|$‰\$‰4$шŸ§џџƒь …Рu1эЧ  cџџџџƒФ‰ш[^_]УfшCџ‰|$‰\$‰4$ƒј‡Єш_§џџƒь …РtР‰|$‰\$‰4$шxƒь ‰Х…Р„›ƒћ…шэ ‰|$ЧD$‰4$шYƒь ‰Х…Р…vџџџ‰|$ЧD$‰4$ш8ƒь ‰|$ЧD$‰4$шƒь ‰|$ЧD$‰4$шЪќџџƒь щ,џџџfшћƒь ‰Хƒћ…џџџщфўџџД&ƒћ…џўџџыЗ‰|$ЧD$‰4$шСƒь ‰ХщсўџџД&ƒь Ч,№ c‹L$‹T$‹D$шRўџџƒФ Т Д&t&ƒь‹D$ Ч$№ c‰D$ш‰lƒФУU‰хƒьЧ$ cшЮџџџЩУД&t&УUWVSƒь8‹D$L‹L$P‰УЗшСыƒ|$T‰\$,„ …Щ„”ƒ|$T†А|$TЏ‰D$0†‹D$0ИPъџџ‹D$Tl$TА‰D$4t&ЖƒЧ(ЖGё‰$и‰ЦЖGђ‰t$‰ТЖGѓђ‰СЖGє‰T$б‰ХЖGѕ‰L$ Эш‰l$‰ЦЖGі‰t$№Жwћ‰УЖGї‰\$иЖ_ќ‰ТЖGј‰T$‰СЖGљбЖWў‰ХЖGњ‰L$ ЭЖO§ш‰l$$ЖoџЦ‰D$(‹$D$D$ѓD$ D$йD$D$ЪD$D$ еD$$D$(№иШашD$,‹D$0‰С9Ч…џџџИq€€‹\$,їхСъiТёџ)ХИq€€їуСъiТёџ)У‡А|$TЏ‰\$,‰D$0‡Жўџџ‹D$T…Р…Л‹D$,ƒФ8[^Ср_ ш]У‹T$T…в„3ЖХl$,ƒ|$T‹\$,„ЖAХыƒ|$T‰\$,„ЖAХыƒ|$T‰\$,„эЖAХыƒ|$T‰\$,„жЖAХыƒ|$T‰\$,„ПЖAХыƒ|$T‰\$,„ЈЖAХыƒ|$T‰\$,„‘ЖAХыƒ|$T‰\$,t~ЖAХыƒ|$T ‰\$,tkЖA Хыƒ|$T ‰\$,tXЖA Хыƒ|$T ‰\$,tEЖA Хыƒ|$T ‰\$,t2ЖA Хыƒ|$T ‰\$,tЖA Хыƒ|$T‰\$,t ЖAХы‰\$,§№џ…џџКq€€Gш‹D$,їтСъiТёџ‹T$,ƒФ8[^_)Т‰аСр ш]УЖъњ№џ‚џџGа‰иа=№џˆџџGСƒФ8[^Ср_] аУƒ|$T†b‹D$TƒшСш‰D$0ƒРСрШ‰D$(ЖЖQƒСшЖQђ‰$$к‰гЖQѓ‰\$D$к‰жЖQє‰t$D$ђ‰зЖQѕ‰|$ D$ ‰еЖQі§ъ‰l$D$‰гЖQї‰\$D$кЖY§‰жЖQј‰t$ђЖqќ‰зЖQљ‰|$њЖyћ‰еЖQњ‰l$ ъЖiџз‰T$$ЖQўD$D$ўD$ D$$ѓјк№еиашD$,;L$(…'џџџ‹D$0‹\$TСрїиDяƒу„‹t$(Жеl$,‹\$,…Р„ЖVеы‰\$,ƒј„ьЖVеы‰\$,ƒј„зЖVеы‰\$,ƒј„ТЖVеы‰\$,ƒј„­ЖVеы‰\$,ƒј„˜ЖVеы‰\$,ƒј„ƒЖVеы‰\$,ƒјtrЖVеы‰\$,ƒјtaЖV еы‰\$,ƒј tPЖV еы‰\$,ƒј t?ЖV еы‰\$,ƒј t.ЖV еы‰\$,ƒј tЖV еы‰\$,ƒј t ЖFХы‰\$,‰шЙq€€їс‰аСшiРёџ)Х‹D$,їсСъiТёџ)D$,щхћџџƒФ8И[^_]У‹D$4‰|$(-Бщ™ўџџД&Д&щ њџџД&t&UWVS‹t$‹L$…іˆŒ‰№Лq€€ЗщСщїуСъiТёџ)Ц‹D$‰ї‰ђЗt$Џ§)бСшС‰јїуСъiвёџ)зК№џљёџюtVџюђџњ№џGжщёџ=сџ[GС^_]=№џˆџџGССр аУv[Иџџџџ^_]УЖUWVS‹t$‹L$…іˆŒ‰№Лq€€ЗщСщїуСъiТёџ)Ц‹D$‰ї‰ђЗt$Џ§)бСшС‰јїуСъiвёџ)зК№џљёџюtVџюђџњ№џGжщёџ=сџ[GС^_]=№џˆџџGССр аУv[Иџџџџ^_]УUWVSƒьl‹„$„t$(ЧD$HЧD$L‹œ$Œ‹8Ч‹„$ЧD$ 8ЧD$  c‰D$‰4$ЧD$PшДH‰Х…Р…Ѓ‹„$€ЧD$81вЧD$,‰D$4‹„$ˆ‰D$(1Ры*ЖЧD$‰4$‰\$,шФC‰Т…Рu41л‹D$8‹T$,…Рu‰|$81џ…вtЮ1Р…л‰4$”РСр‰D$шC‰Т…РtЮ‹D$<‹Œ$„‰T$‰‰4$шёC‹T$ƒњEъƒФl‰ш[^_]УД&Жƒь,‹D$<ЧD$џџџџ‰D$ ‹D$8‰D$‹D$4‰D$‹D$0‰$шБўџџƒФ,УД&Ж‹T$‰а‰бСш СщD СъШаУИ А cУД&vUWVSƒь‹T$,…в„m‹L$(ƒ|$0їб‡$ƒ|$0†K‹D$0‰Ъ‹t$,СъXј‹D$,2ЖЩ3 А c‰а2VЖвСш3• А c‰Т2FЖРСъ3… А c‰а2VЖвСш3• А c‰Т2FЖРСъ3… А c‰а2VЖвСш3• А c‰Т2FЖРСъ3… А c‰б2VЖвСщ3 • А cƒћ†‰Ъ2NЖЩСъ3 А c‰а2V ЖвСш3• А c‰Т2F ЖРСъ3… А c‰а2V ЖвСш3• А c‰Т2F ЖРСъ3… А c‰а2V ЖвСш3• А c‰Т2FЖРСъ3… А c‰б2VЖвСщ3 • А c‹D$,Сыƒd$0Dи‰D$,‹D$0…Р„Б‹t$,‰ШСш2ЖЩ3 А cƒ|$0‰С„2NСшЖЩ3 А cƒ|$0‰Сtv2NСшЖЩ3 А cƒ|$0‰Сt]2NСшЖЩ3 А cƒ|$0‰СtD2N‹T$0СшЖЩ3 А c‰Сƒъt)2NСшЖЩ3 А c‰Сƒњt2NСшЖЩ3 А c‰СƒФ‰Ш[їа^_]Уt&‹D$,‹T$0Ј„шƒР‰Ы2HџСыЖЩ3 А c‰йƒъuм‰D$,‰T$0ЧD$џџџџ‹D$1э1в1л‰ $1џ‰й‰D$ ‹D$,‰l$‰Х‰аv3E‹4$ƒХ3uь3}є‰D$‰№‰њ‹\$3]№Жј‰№3MјСш‹<Н   c3<… Ќ c‰№СюЖФ3<… Є c‰№Ж№3<Е Ј cЖѓ‰<$‰п‹4Е   cСя34Н Ќ cЖџСыЖл34Н Є c34 Ј c‰гСы‰t$Жђ‹<Е   c3< Ќ cЖоСъ3< Є cЖв‰Ы‹t$Сы3<• Ј cЖб‹•   c3 Ќ c‰№ЖнСщ3 Є cЖЩ3 Ј c‰бЖа‰№Сш‹•   c3… Ќ c‰№ЖмСшЖР3 Є c3… Ј cƒl$ ‰а…мўџџ‹D$‹t$,‰Ы‹l$‹ $€†‰D$,3ЖёСщ3 Е А c‹t$,‰ШЖЩСш3 А c3n‰СЖРСщ3 … А c‰ШСщЖР1щ3 … А cЖё‰ШСш3Е А c‹t$,‰СЖРСщ3 … А c‰ШСщЖР3 … А c‹F‰ЮЖЩ1јСю‹|$,1№3 А cЖШСш3 А c‰СЖРСщ3 … А c‰ШСщЖР3 … А c‹G 1и‰ЫЖЩСы1и3 А cЖШСш3 А cƒD$,‰СЖРСщ3 … А c‰ШСщЖР3 … А c‹G1а‰ЪЖЩСъ1а3 А cЖаСш3• А c‰ТЖРСъ3… А c‰аСъЖР3… А c‰бЖвСщ3 • А cщчњџџv‰T$0‰D$,ИЭЬЬЬїd$0Съ’Ср)D$0ƒъ‰T$…§џџ‹D$,1в1л1џ1эщkўџџt&ƒФ1Р[^_]УЖщkњџџД&t&UWП€VSƒь‹D$ ‹L$…РtgЧ$‹l$ ы vƒ$б§tKїХt№‹$К€ƒр‹4…   c‰ј1џы‰Убш‰Сƒубъё ƒИэ…лEС…жtцJџ1Ч…ёuнƒ$б§uЕ‹L$1РК€ыД&‰Юбщ‰Ыƒцбъѓ ƒИэ…іEЫ…њtцZџ1Ш…ћuн3D$ƒФ[^_]УUWП€VSƒь‹D$ ‹L$…РtgЧ$‹l$ ы vƒ$б§tKїХt№‹$К€ƒр‹4…   c‰ј1џы‰Убш‰Сƒубъё ƒИэ…лEС…жtцJџ1Ч…ёuнƒ$б§uЕ‹L$1РК€ыД&‰Юбщ‰Ыƒцбъѓ ƒИэ…іEЫ…њtцZџ1Ш…ћuн3D$ƒФ[^_]УUWП€VSƒь‹l$…эtgЧ$ы vƒ$б§tSїХt№‹$К€ƒр‹4…   c‰ј1џыД&‰Убш‰Сƒубъё ƒИэ…лEС…жtцJџ1Ч…ёuнƒ$б§u­ƒФ‰ј[^_]УД&t&UWП€VSƒь‹l$…эtgЧ$ы vƒ$б§tSїХt№‹$К€ƒр‹4…   c‰ј1џыД&‰Убш‰Сƒубъё ƒИэ…лEС…жtцJџ1Ч…ёuнƒ$б§u­ƒФ‰ј[^_]УД&t&W1РЙ€VS‹T$‹|$ыt&‰жбъ‰гƒцбщѓ ƒИэ…іEг…ЯtцYџ1а…ћuн3D$[^_УUW‰Ч‰аVSƒь,‹Wl‹o8‹_x‹O|‰|$ t‰t$‹З‰t$‹w,Оњўџџ‰4$В+4$9њП”Gў‰T$‰|$‹|$ ‹w@‰t$‹w4‰t$ ‹t$ЖTџˆT$ЖˆT$;ŸŒrСщ‹|$ ‹T$‰ $‹t9њ‰|$$Gз‰T$ы&Ж‹t$#D$ ЗF9D$ƒ ƒ,$„TЖL$‰п8 uаЖL$8LџuХ‹t$Ж8 uКЖN8JuБ‰D$(‹ $vƒТыcfЖB8F…ЭЖB8F…ЬЖB8F…ЫЖB8F…мЖB8F…РЖB8F…бƒЦƒТЖ8uv9t$vpЖB8Ft–‰ $‹D$(ƒЦt&‹T$)ђО)ж9ѓџџџ‹\$ ‰ї‰Cp;t$}$‹L$Л)гЖˆ\$Ж1ˆ\$‰ѓщтўџџf‹D$$9јGЧƒФ,[^_]У‰ $‹D$(ыž‰ $‹D$(ƒЦы’‰ $‹D$(ƒЦы†‰ $‹D$(ƒЦщwџџџ‰ $‹D$(ƒЦщhџџџ‰ $‹D$(ƒЦщYџџџ‰ $‹D$(ƒЦщJџџџfU‰ХWVSƒь<‹@,‹}t‰У‰D$(ы‰\$$щŽt&‹u‹F…Р„*9У‹}tGи…лt>)иЯ}8‰F‹‰\$‰D$‰<$шЂ]‹F‹@ƒј„ƒј„*^]t‰п‹Д‰}t;ƒј‡3џ‡П‹E‹X…л„Б‹E,‹U<‹MlD$$‰г)Ы)ћ9С‚^џџџ‹t$(‹E8ё‰$)б0љ‰T$‰L$ш]‹Ml)up)u\)ё‰Ml;Дs‰Д‹u,‹EL‹}DЗTGў9懓)ђf‰TGўƒшuч‹}@‰№fЗTGў9жw_)ђf‰TGўƒшuы\$(‹u‹F…Р…пўџџД&f‹…Р‹U<9аs‹]t]l9и‚@‹9Ш‚kƒФ<[^_]УД&1вf‰TGўƒшuŒ\$(ыŸЖ1вf‰TGўƒш…Pџџџщdџџџv‹Ul‹E8‹MX)к‰D$‰жЖ‰L$‰t$,‰T$‰UHЖD0‹t$‹UT‰\$гц‰T$1№!а‹Ul‰EHњ‰T$ ‹T$,‰|$,ыRt&ЖL$‹t$‹}4ƒl$грЖL‹u@!з1Ш‹MD#D$‰EH AЗf‰~‹\$f‰‹L$ ƒТ‰Д)бƒљv‹t$…іuЊ‹|$,щўџџ‰\$‰|$‹F0‰$шяџџ‰F0щл§џџt&‰\$‰|$‹F0‰$ш јџџ‰F0щЛ§џџИ)к9ТGа‹E8иƒњsW…вtЦіТt1Щf‰LўꉕРƒФ<[^_]У)У)ТЧD$У9гGкE8‰$‰\$шіZРƒФ<[^_]УxЧƒчќЧDќ)ј 1РСщѓЋыšЖUWVSƒь<‹l$P‹E ‹U,‹uƒш9аFа‹F‰T$(‰D$,‰D$ыv€|$$…Е‹…М‹NƒР*Сј9С‚^)С‹El+E\Лџџ‰D$ D$=ўџFи9ЫGй;\$(s3…л”Сƒ|$T‰Я•С‰њ„Ъ…‹T$T…в”С9У‰Я•С‰њб…9УЧD$”Тƒ|$TЧD$”Р‰,$!ТЖТ‰D$ ˆD$$ш1н‹U‹E‰йїбˆ\ќ‹U‹Eˆ|§‹U‹EˆLў‰й‹U‹Eїбˆlџ‹}‹W‰$‰T$ш_о‹T$‹w‹B9№F№…іt1‹J‹G ‰t$‰L$‰$шfY‹T$w rw)w)ru‹B‰B‹D$ ‹u…Р…ќ‹F‰D$…л„­ўџџ9У‰С‹~ FЫ…ЩtI)Ш‰L$‰F‹‰L$‰D$‰<$шY‹F‹L$‹@ƒј„ƒј„АN‹u‹F‹~ ‰D$п)^^€|$$‰~ „Kўџџ‹T$‹\$,ЧD$)г„Р‹}8‹E,‰|$ 9и†ž‹Ml‹}<)Я9п†Ж‹D$ +T$,‰\$Ш‰T$‰$шjX‹El‹U,+•Ди9к‰ElGг•Д‰•Д‰E\ы^v‹D$ ‹V 9У‰Ч‹E\FћE8‰$‰D$‰|$)ћшX‹u~ )~~}\щЪўџџЖ‹T$‹\$,ЧD$)г…@џџџ‹El9…Рs‰…Р‹|$…џ…Л‹u‹VїD$Tћџџџt{…вuw;E\„5‹M,9…Рs‰…Р‹НМ‹U _*‹}\Сћ)кЛџџ9кGг)ј9ЪFЪ9С†А…Р•Сƒ|$T‰Ю”С‰ѓйt ‹t$T…і…R‹D$ƒФ<[^_]Уv‹]<)У9гs‹}\‹M,9Я„9гGк…л„nџџџ9г‰зFћ…џ…Ч‹M,и‰El‰Ъ+•Д9кGг•Д‰•Дщ<џџџД&‰L$‰|$‹F0‰$ш§ъџџ‹L$‰F0щй§џџ9Т‰ЦFђƒ|$T„с1Р‰D$ ‰t$}8‰|$‰,$шѕйu\‹u‹~‰<$шTл‹_‹F9УGи…л„"џџџ‹F ‹W‰\$‰T$‰$ш[V^ _^)^)_…їўџџ‹G‰Gщьўџџv‰L$‰|$‹F0‰L$‰$шсђџџ‹L$‰F0щ-§џџt&ЧD$‹D$ƒФ<[^_]Уt&Ч…А‹‰D$)Т‰<$‰T$шкU‹E,‰El‰Тщ§џџ‹M‹I…Щ…џџџ9Т‚ џџџЧD$Ищљўџџ‹U8)Ш)Я‰}\б‰El‰D$‰L$‰$ш†U‹…Аƒјw ƒР‰…А‹El],9…Дv‰…Д‹u‹V9гGк…л„§џџщ*ўџџE8)њ‰С‹‰V‰ $‰|$‰D$‰L$ ш&U‹F‹L$ ‹@ƒј„Їƒј„Й>‹El~щ№§џџ‹M‹Y…л… §џџ9Т‚˜§џџFТƒ|$T‰Ц…)ўџџщџџџf‹|$ )С‰T$$‰Mlј‰L$‰D$‰<$шБT‹…А‹T$$ƒјw ƒР‰…А‹Ml9Дv‰Д‹E8‹u‰D$ щѓћџџЧD$щ§џџ‰|$‰L$‹F0‰$ш‰шџџ‰F0щGџџџ‰|$‰L$‹F0‰$шў№џџ‰F0щ,џџџЖUWVSƒьL‹l$`‹}tfџ†y‹]l‹E8‹MX‹UH‹u4ЖDгт‹M@!о1а‹UD#ET‰EHBЗf‰qf‰…вt‹E,‰й)б-9С†iД&f‹E`‹• J•˜ƒј†•f+]p‰ ƒшˆ‹• ‹˜r‰Е ˆ<‹• ƒы‹˜r‰Е ˆЖРЖ€ а cfƒ„…˜fћџv fСыfУЗл‹}t‹u`Жƒ б c)їfƒ„…ˆ ‹… ‰}t‰D$$‹…Є‰D$(‹El‰D$ ‹E8‰D$‹EX‰D$‹ET‰D$;Е€w ƒџ‡‘‹T$ ЖL$ЧE`ђ‹t$‰UlЖ‰EHЖTгр1Т#T$‰UH‹t$(9t$$…ƒўџџ‹E\‹Ul)Т…РˆуE8‰T$‰D$ЧD$ ‰,$шй‹u‹El‹~‰E\‰<$ш4з‹_‹F9УGи…лt-‹F ‹W‰\$‰T$‰$ш?R^ _^)^)_u‹G‰G‹E‹X…л…ѕ§џџƒФL1Р[^_]У‹E8Ж‰ Ц‹• ‹˜Z‰ Ц‹• ‹˜Z‰ ˆfƒ„…”‹EtƒElxџ‹…Є‰}t9… „џџџџ‡‡§џџ‰шш”ѓџџ‹Et=‡r§џџ‹t$d…і„`џџџ…Р„в‹]lƒј†І§џџщP§џџ‰шшёџџ‰E`щ”§џџ‹ED^џ‹L$ ‰t$8‰]`‰D$,‹E@Q‰|$<‰D$0‹E4‰\$‰D$4‹EHД&ЖL$‹|$‰Ul‹t$0ƒl$грЖL‹|$,1Ш#D$ G‹|$4‰EHЗ!зf‰~‹|$f‰ƒТ‰}`…џuЖ‹t$8‹D$ ‹|$<№‰ElщўџџД&1РщўџџД&f‹UlИ9ТFТƒ|$d‰…Дtx‹ И…Щ„П‹E\1Щ)Т…РxE8‰С‰T$‰L$ЧD$ ‰,$шлж‹}‹El‹w‰E\‰4$ше‹^‹G9УGи…л…Ї‹E‹@…Р•РƒФL[ЖР^_]У‹E\1Щ)Т…РxE8‰С‰T$‰L$ЧD$ ‰,$шvж‹u‹El‹~‰E\‰<$шЂд‹_‹F9УGи…лu‹EƒxИƒиџƒФL[^_]У‹F ‹W‰\$‰T$‰$ш–O^ _^)^)_uТ‹G‰GыК‹G ‹V‰\$‰T$‰$шgO_ ^_)_)^….џџџ‹F‰Fщ#џџџД&UWVSƒь<‹l$P‹}tfџ†C‹Ep‹]l‹u`‰D$‹E8‹MX‹UHЖDгт‹M41а‹UD#ET‰EH!йBЗ‰T$‹U@f‰J‹T$f‰‹T$‰ux‰UdЧE`…Рt9Е€v‹U,‰й)Съ9б†ƒў‡‹Eh…Р„™‹• ‹E8‹˜ЖDџZ‰ Ц‹• ‹˜Z‰ Ц‹• ‹˜Z‰ ˆfƒ„…”‹…Є9… „Œ‹EtƒElxџ‹E‰}t‹p…і…сўџџ1РƒФ<[^_]УД&ƒУƒяЧEh‰]l‰}tџ‡Нўџџ‰шшкяџџ‹}tџ‡Їўџџ‹D$T…РtВ…џ„-‹Ep‹]l‹u`‰D$ƒџ‡Žўџџ‰ux‰EdЧE`ƒў†ыўџџ‹• D§f+\$‰D$F§‹Е˜Kџzƒы‰Н ˆ ‹• ‹Е˜z‰Н ˆ,‹• ‹˜r‰Е Ж№ˆЖ† а cfƒ„…˜fћџ‡3ЗлЖƒ б cfƒ„…ˆ ‹… ‹ux‰D$‹…ЄVў‰t$$‰D$ ‹Et‰UxƒР)№‰Ч‰Et‹El‰|$,‰С‰D$(A‰El;D$wQД&f‹u8‹}HЖt‹MXгч‰љ‹}41ё‹uD#MT‰MH!Чƒъ N‹u@Зf‰~f‰‰Uxt‰СA‰El;D$vИƒъ‰Uxuъ‹D$$‹\$(ЧEh‹|$,‹t$ ЧE`Dџ‰El9t$…§џџ‹U\1Щ)а…вxU8‰б‰D$‰L$ЧD$ ‰,$ш™в‹u‹El‹~‰E\‰<$шХа‹_‹F9УGи…лt+‹F ‹W‰\$‰T$‰$шаK^ _^)^)_„"‹E‹@…Р„œ§џџ‹}tщuќџџt&‹U\‹El1Щ)а…вxU8‰б‰D$‰L$ЧD$ ‰,$шв‹u‹El‹~‰E\‰<$ш1а‹_‹F9УGи…л„"§џџ‹F ‹W‰\$‰T$‰$ш8K^ _^)^)_…їќџџ‹G‰GщьќџџД&‰Т‰шшЧъџџ‰E`ƒјv?ƒў†Rќџџ9Ц‚JќџџщZ§џџД&ffСыƒЗРЖ€ б cщО§џџД&ƒНˆtƒјuГ‰к+UpњvІЧE`щьћџџ‹G‰Gщгўџџ‹]h…л…П‹UlИ9ТFТƒ|$T‰…Д„ ‹ И…Щ„Cќџџ‹E\1Щ)Т…РxE8‰С‰T$‰L$ЧD$ ‰,$шКа‹}‹El‹w‰E\‰4$шцЮ‹^‹G9УGи…лt-‹G ‹V‰\$‰T$‰$шёI_ ^_)_)^u‹F‰F‹E‹@…Р•РƒФ<[ЖР^_]У‹U8‹El‹˜ЖDџ‹• Z‰ Ц‹• ‹˜Z‰ Ц‹• ‹˜Z‰ ˆfƒ„…”ЧEhщзўџџ‹E\1Щ)Т…РxE8‰С‰T$‰L$ЧD$ ‰,$шТЯ‹}‹El‹w‰E\‰4$шюЭ‹^‹G9УGи…лt-‹G ‹V‰\$‰T$‰$шљH_ ^_)_)^u‹F‰F‹EƒxИƒиџƒФ<[^_]УД&t&UWV‰ЦSƒь<‹X‹@ ‰T$$…Р„П‹N…Щ…Њ‹Cƒ|$$•Т=šu„в…š‹~…џ„,‹l$$ƒ{‹{(‰k(…й…Щ„‰=š„ƒј*…ї‹C…Р…ъ‹FЧCq…Р„ЈД&‹ƒ„…Р„* ‹“ˆƒњ„ы ƒњ„J‹|$$@‰$‰|$џ…ЈД c‰ТHўƒт§ƒљ‡< ЧCš…в„ƒ|$$…‹KИ…ЩŽ‹C‹V0xC‰{ƒљ„r‰бСъСщˆ‹K‹{A‰Cˆ‹CЗV0‹Kx‰{ˆ4‹C‹Kx‰{ˆ‹n‰,$шЬ‹}‹F9ЧGј…џt+‹F ‹U‰|$‰T$‰$ш'G~ }~)~)}„R‹C…Р~їи‰C‹S1Р…в”РƒФ<[^_]Уt&‹.…э…LўџџЁPк c‰FИўџџџщ-t&‰щl-ƒљЙEЭƒџ‰L$ ?iїOЭ9L$„в…X=š…Hўџџ‹F…Р…B‹F…Р…`ўџџ‹Ct…Р…Uўџџ‹D$$…Р„Р{š…<ўџџщ’ўџџД&‹C0Ср ƒЛˆˆˆџџŽG‹Cl…РtƒЩ ‰ШК…Bїт)ббщЪ‹KСъ‰аСр)а‹SƒРz‰{ˆ$‹S‹Kz‰{ˆ‹kl…эtL‹F0‹S‹k‰СzСшСщ‰{ˆL‹S‹Kz‰{ˆ‹CЗV0‹Kx‰{ˆ4‹C‹Kx‰{ˆЧD$ЧD$Ч$шДйџџ‹n‰F0ЧCq‰,$ш?Ъ‹}‹F9ЧGј…џ…4‹{…џ…Ё‹Cƒј9…ЅЧD$ЧD$Ч$шщсџџ‹S‰F0‹CH‰KЦ‹C‹SH‰KЦ‹‹C‹SH‰KЦ‹S…в„S‹B,‹k…Р‹B•С…Р•РСрƒ: H‹B‹R$€йџ…ЕЅвС•Т‹KСтyа‰{ˆD ‹C‹S‹H‹Cx‰{ˆ ‹C‹S‹H‹Cx‰{ˆ,‹C‹SЗH‹Cx‰{ˆ ‹C‹SЖH‹Cx‰{ˆ ‹“„Иƒњ tƒЛˆŸРƒњžТ аСр‹S‹Kz‰{ˆ‹C‹S‹H ‹Cx‰{ˆ ‹K‹i…эt*‹C‹I‹Sx‰{ˆ ‹C‹S‹H‹Cx‰{ˆ,‹K‹y,…џ…9ЧC ЧCE‹Q…в„И‹C ЗI‹{‹k )С‰L$љ‰l$ 9щ‡–щPД&v‹Vk ‰$‰T$(ш>Ш‹T$(‹n‹B9шFш…эt1‹B‹N ‰l$‰D$‰ $шEC‹T$(n jn)n)ju‹B‰B‹k…э…o+|$ ‹C|$‹K ‹|$‹P‰L$ ‹C 9љƒЫ1џ‹K‹l$ Т‰T$љ)§‰ $‰l$шмB‹S‹C ‹J,‰C…Щ„Hџџџ9ј†@џџџ)ј‰D$‹Cј‰D$‹F0‰$шfпџџ‰F0щџџџЖ:N…/ :N…& ‹L$‰D$,ƒЦ‰ј‹|$,Œ‰L$(‹L$ыOt&:F…v:F…_:F…H:F…i:F…|:F…eƒЦ8…9t$(† :FtА‰L$‰јƒЦ+t$(Ц‰s`9Ц†Т ‰C`‰Цt&‹“ ‹‹˜F§r‰Г Ц‹“ ‹‹˜r‰Г Ц‹“ ‹‹˜r‰Г ˆЖР‹S`Ж€ а c‹ГЄfƒ„ƒ˜‹CtfƒDЋ)аSlЧC`‰Ct‰Sl9Г …w ‹C\1Щ)Т…РxC8‰С‰T$‰L$ЧD$ ‰$шРЧ‹;‹Cl‹W‰C\‰$‰T$шщХ‹T$‹w‹B9№F№…іt1‹J‹G ‰t$‰L$‰$ш№@‹T$w rw)w)ru‹B‰B‹‹@…Р…)‹t$ t&‹n…эuД&fЧC(џџџџ1РƒФ<[^_]УД&‹C‹SH‰KЦ‹C‹SH‰KЦ‹C‹SH‰KЦ‹C‹SH‰KЦ‹C‹SH‰KЦ‹“„Иƒњ tƒЛˆŸРƒњžТ аСр‹S‹Kz‰{ˆ‹C‹SH‰KЦ ‹nЧCq‰,$шТФ‹}‹F9ЧGј…џt-‹F ‹U‰|$‰T$‰$шЭ?~ }~)~)}u‹E‰E‹K…Щ…ћўџџ‹CД&ƒјE…Ч‹KщдћџџД&‰$шPФ‹F‹{9јFј…џu…Р„ ‹CщРјџџ‹F ‹S‰|$‰T$‰$шJ?‹F~ {)ј~‰F){uУ‹S‰SыЛt&‹F ‹U‰|$‰T$‰$ш?~ }~)~)}…Ёљџџ‹E‰Eщ–љџџf‹ƒ„ƒјŽЊјџџƒјШƒЩ@щ™јџџƒјI…Б‹K‹y…џ„х‹{‰јы,f‹S ‹Ij‰k Жh‹K‰kˆ„в„œ‹C‹K9C uб‹Q,…вt9Ч‚Ђ‹n‰,$ш7У‹}‹F9ЧGј…џt-‹F ‹U‰|$‰T$‰$шB>~ }~)~)}u‹E‰E‹C…Р…p§џџ‹K1џщfџџџƒј[„] ƒјg…yїџџ‹C‹@,щ‰Д&f‹K‹i,…эt ‹C9ј‡&ЧC ЧC[‹y$…џ„2‹{‰јы-v‹S ‹I$j‰k Жh‹K‰kˆ„в„‹C‹K9C uб‹Q,…вt9Ч‚Ъ‹n‰,$ш?Т‹}‹F9ЧGј…џt-‹F ‹U‰|$‰T$‰$шJ=~ }~)~)}u‹E‰E‹C…Р…xќџџ‹K1џщfџџџЖ‰t$‹CtщŒt&‹S8‹ClЧC`‹‹˜Ж‹“ r‰Г Ц‹“ ‹‹˜r‰Г Ц‹“ ‹‹˜r‰Г ˆ‹{lfƒ„ƒ”‹CtW‹ЛЄƒш‰Sl‰Ct9Л „…Р…pџџџ‰ишqоџџ‹kt…э…^џџџ‹|$$‹t$…џ„–ћџџЧƒДƒ|$$„І‹‹ …Щ„Ќ‹S\‹Cl1Щ)а…вx‹K8б‰D$‰L$ЧD$ ‰$ш˜Т‹‹Cl‹j‰C\‰T$‰,$шСР‹T$‹}‹B9ЧGј…џt1‹B ‹M‰|$‰L$‰$шШ;‹T$z }z)z)}u‹E‰E‹‹@…Р•РЖР‰ТЖ…в„ањџџƒј…Тѓџџƒ|$$„д‹|$$ƒџ…ч‹n‰,$ш4Р‹F‹}9јFј…џ…a…Р…„ѓџџЧC(џџџџƒФ<[^_]У‰§‹|$t&‹KТ‰|$‰T$щ‰ $ш;‹K‹C‹Q,ј‰C…вt9ш‡“ЧC ЧCIщ(ќџџt&‹D$$‰$‰D$ш(рџџщюђџџv)ј‰D${‰|$‹F0‰$шxзџџ‰F0щ>ќџџ)ј‰D${‰|$‹F0‰$шXзџџ‰F0щ§џџ‹C‹@,…Р„Š‹S9њ‡хЧCg…Рtt‹CP;S v)‹n‰,$ш&П‹}‹F9ЧGј…џ…K‹C…Р…ˆљџџ‹N0‹Sx‰{ˆ ‹C‹N0‹Sx‰{ˆ,ЧD$ЧD$Ч$шЛжџџ‰F0‹nЧCq‰,$шЖО‹}‹F9ЧGј…џt-‹F ‹U‰|$‰T$‰$шС9~ }~)~)}u‹E‰E‹C…Р„ѓџџщъјџџД&v‹A,щџџџД&‹C\1Щ)Т…РxC8‰С‰T$‰L$ЧD$ ‰$шшП‹+‹Cl‹u‰C\‰4$шО‹~‹E9ЧGј…џt-‹E ‹N‰|$‰L$‰$ш 9} ~})})~u‹F‰F‹‹p…і…шћџџ‹t$щ3јџџv‹F ‹U‰|$‰T$‰$шк8‹F~ })ј~‰F)}…o§џџ‹U‰Uщd§џџt&Ж б c‰t$ Ј`‹CtщЖД&‹s8‹SlЧC`‰t$…вt‹t$tџЖ>‰љ:N„Эѕџџt&‹D$‹‹˜Ж‹“ r‰Г Ц‹“ ‹‹˜r‰Г Ц‹“ ‹‹˜r‰Г ˆ‹{lfƒ„ƒ”‹CtW‹ЛЄƒш‰Sl‰Ct9Л „‰іџџ=‡Fџџџ‰ишЯйџџ‹Ct=‡1џџџ‹T$$…в„эіџџ…Р„E‹s8‹SlЧC`‰t$ƒј†3џџџщџџџЖЧD$ ЧD$ЧD$‰$шШКƒџ…№ћџџ‹SL‹CD1Щf‰LPўTў‰T$ЧD$‰$шJ7‹{t…џ…РћџџЧClЧC\ЧƒДщЃћџџf‰Ъ€ЩР€Ъ€ƒјDЪщЦ№џџt&‹F ‹U‰|$‰T$‰$шт6~ }~)~)}…Šќџџ‹E‰Eщќџџf‹E‰EщЃяџџ)ј‰D${‰|$‹F0‰$ш]гџџ‹K‰F0щЗјџџ)њ‰T${‰|$‹F0‰$ш:гџџ‰F0‹C‹@,щѕћџџ)ш‰D$k‰l$‹F0‰$шгџџ‹K‰F0щJћџџЁ\к c‰FИћџџџщѕџџД&ƒў‡?єџџщТ§џџfˆ‹C‹N0‹Sx‰{ˆ,‹CЗN2‹Sx‰{ˆ ‹CЖN3‹Sx‰{ˆ ‹C‹N‹Sx‰{ˆ ‹C‹N‹Sx‰{ˆ,‹CЗN ‹Sx‰{ˆ ЖN ‹S‹Cx‰{ˆ щ@юџџД&‹C‰D$‹C‰D$‹F0‰$ш7вџџ‹K‰F0щЃёџџt&ƒ|$$‹t$ ЧƒД…љџџ‹S\‹Cl1Щ)а…вx‹K8б‰D$‰L$ЧD$ ‰$шДЛ‹‹Cl‹j‰C\‰T$‰,$шнЙ‹T$‹}‹B9ЧGј…џt1‹B ‹M‰|$‰L$‰$шф4‹T$z }z)z)}u‹E‰E‹‹@ЧCš…Р…ћьџџщ№ѓџџ‹Kщліџџ‰$шКщ,љџџ‹S\‹Cl1Щ)а…вx‹K8б‰D$‰L$ЧD$ ‰$шЛ‹+‹Cl‹U‰C\‰$‰T$ш)Й‹T$‹E‹z9ЧGј…џ„yџџџ‹J‹E ‰|$‰L$‰$ш,4‹T$} z})})z…Jџџџ‹B‰Bщ?џџџ‰L$‰јщіёџџ‰L$‰јƒЦщшёџџ‰L$‰јƒЦщкёџџ‰L$‰јƒЦщЬёџџ‰L$‰јƒЦщОёџџ‰L$‰јƒЦщАёџџ‰L$‰јƒЦщЂёџџД&fUWVSƒьL‹D$`‹\$d…РtM‹D$`‹h …эtB‹x$…џt;‹xИўџџџ…џt4‹79t$`u,‹Wƒњ*t4ƒњ9t/ƒњq"ƒњZBЛƒрћtt&ИўџџџƒФL[^_]Уњšu№…лtч‹G‰D$4ƒјtлƒј„?‹Gt…РuЫЧG‹G,;D$h‡s‹t$4…і„p‹T$h)Тг‹t$`‹v‰t$8‹t$`‹6‰t$<‹t$`‰F‰ј‰шОдџџ‹_tƒћ†f‹GX‹Wl‹w@‰D$‹G8\ў‰\$0‰D$ ‹GT‰D$$‹GD‰D$(‹G4‰D$,‹GHt&ЖL$‹l$,гр‹L$ !еЖL1Ш‹L$(#D$$‰GH AЗf‰nf‰ƒТ;T$0uЧ‰Wl‰јЧGtш.дџџ‹_tƒћ‡rџџџ‹Gl‹t$<‰ŸДЧGtиЧGx‰Gl‰G\‹D$`ЧG`ЧGh‰0‹t$8‰p‹D$4‰GƒФL1Р[^_]Уƒњ*…Šўџџ‹WtИўџџџ…в…ўџџ‹D$h‰\$‰D$‹D$`‹@0‰$шЯХџџ‹t$`‰F0‹G,ЧG9D$hƒ™ўџџ‹D$hщ˜ўџџ‹WL‹GD1Щf‰LPўTў‰T$ЧD$‰$шf1ЧGl‹G,ЧG\Ч‡ДщKўџџBЅЙ@ЃСƒх§џџщѕ§џџSƒь‹D$ …РtQ‹P …вtJ‹X$…лtC‹PЙўџџџ…вt#;u‹Bƒј*tEƒј9t@ƒјq4ƒјZƒшEƒрћt.ƒФ‰Ш[Уƒш[Й@ЃСrЙўџџџƒФ‰Ш[УД&=šuв‹Z,‹Bt‹L$$Bl9иFи…Щt…лu‹D$(1Щ…РtЎ‹D$(‰ƒФ‰Ш[УД&)иB8‰\$‰D$‹D$$‰$шW0ыЦt&VSƒь‹\$ …лtP‹S …вtI‹C$…РtB‹sИўџџџ…іt#;u‹Vƒњ*tEƒњ9t@ƒњq3ƒњZƒъEƒтћt.ƒФ[^Уƒъ[И@ЃаrƒФИўџџџ[^УД&њšuв‹FЧCЧCЧCЧC,‰F‹FЧF…Рyїи‰Fƒјt>ЧF*ЧD$ЧD$Ч$шЋУџџ‰C0ЧF(ўџџџ‰4$шщБƒФ1Р[^УЧF9ЧD$ЧD$Ч$ш§ЫџџыРД&t&VSƒь‹\$ …лtP‹C …РtI‹s$…іtB‹sИўџџџ…іt#;u‹Vƒњ*tEƒњ9t@ƒњq3ƒњZƒъEƒтћt.ƒФ[^Уƒъ[И@ЃаrƒФИўџџџ[^УД&њšuв‹FЧCЧCЧCЧC,‰F‹FЧF…Рyїи‰Fƒј„ъЧF*ЧD$ЧD$Ч$ш‡Тџџ‰C0ЧF(ўџџџ‰4$шХА‹[1Щ‹C,‹SLР‰C<‹CDf‰LPўTў‰T$ЧD$‰$ш%.‹ƒ„ЧClЧC\@ЧCtСрЧCxЗЂД cЧC`ЧƒД‰“€З Д cЧCh‰“ŒЗЄД cЗ€ІД cЧCH‰“‰C|ƒФ1Р[^Уt&ЧF9ЧD$ЧD$Ч$ш-ЪџџщџџџД&‹D$…РtU‹H …ЩtN‹P$…вtG‹PЙўџџџ…вt#;u‹Bƒј*tAƒј9t<ƒјq0ƒјZƒшEƒрћt*‰ШУД&ƒш[Й@ЃСrЙўџџџ‰ШУv=šuжƒzuш‹D$1Щ‰B‰ШУД&Д&‹D$…РtU‹P …вtN‹H$…ЩtG‹HКўџџџ…Щt#;u‹Aƒј*tAƒј9t<ƒјq0ƒјZƒшEƒрћt*‰аУД&ƒш[К@ЃТrКўџџџ‰аУv=šuж‹T$…вt ‹A‹T$‰‹D$ 1в…РtЛ‹М‹L$ ‰‰аУД&UWVSƒь‹D$0‹t$4‹l$8…РtA‹H …Щt:‹P$…вt3‹x…џt,;u(‹Gƒј*t6ƒј9t1ƒјq%ƒјZŠƒшEƒрћtt&ОўџџџƒФ‰№[^_]У=šuъƒўwu‹GƒР9‡˜rgД&‹—МЛИ)г9ѓOо‰йгр‰бкƒш‰—М!шгрf ‡И‰<$ш=А‰йг§)оuНƒФ‰№[^_]Уƒш[К@ЃТƒrџџџы†ОћџџџщkџџџД&Д&UWVSƒь,‹t$@‹|$D‹l$H…і„E‹F …Р„:‹^$…л„/‹^…л„$;3…‹Cƒј*‰D$•Сƒј9•Р СˆL$… ƒџџ„,ƒџ —Рƒ§‡х„Р…н‹ƒ„ @‹ЈД c9Ћˆ„ ƒ{(ў…9Ч„ƒ…РuB‹“А…вt8‹sD‹CLƒњ„’1вf‰TFўDў‰D$ЧD$‰4$шS*ЧƒА‰Л„СрЗЂД c‰“€З Д c‰“ŒЗЄД cЗ€ІД c‰“‰C|‰ЋˆƒФ,1Р[^_]Уt&ƒш[Й@ЃС‚ џџџД&ИўџџџƒФ,[^_]Уvƒ|$qЕƒ|$Z‹D$ТƒшEƒрћuвщаўџџt&1РПщЮўџџt& 9ЈД c„ёўџџƒ{(ў„чўџџ€|$t'ƒ|$qxƒ|$Z‹T$яƒъEƒтћ…uџџџt&К‰№шtрџџƒјў„[џџџ‹N…Щ…д‹CtCl9C\…Х‹ƒ„щўџџЖ|$šИўџџџ…"џџџщўџџ|$šИўџџџ… џџџы“v‹K,t&ЗTFў9ЪrO)Ъf‰TFўƒшuы‹s@‰ШЖЗTFў9бw)Ъf‰TFўƒш„LўџџЗTFў9бvч1вf‰TFўƒшuвщ2ўџџt&1вf‰TFўƒшuœыЏƒъ[И@Ѓаƒўџџщ џџџИћџџџщwўџџf‹D$…РtU‹H …ЩtN‹P$…вtG‹PЙўџџџ…вt#;u‹Bƒј*tAƒј9t<ƒјq0ƒјZƒшEƒрћt*‰ШУД&ƒш[Й@ЃСrЙўџџџ‰ШУv=šuж‹D$1Щ‰‚Œ‹D$ ‰‚€‹D$‰‚‹D$‰B|‰ШУД&UWVSƒь‹T$ ‹D$‰б‰гrСщСыL й‰гСы ,‰б‰гСщСыёй‰гСы й…Рt=‹x …џt6‹X$…лt/‹X…лt(;u$‹Cƒј*t;ƒј9t6ƒјq*ƒјZ‘ƒшEƒрћt 9Э‰ШCХƒРƒФ[^_]УЖ=šuс‹Cƒј„хƒјtpїиРƒр‹{0‰<$ƒ<$‹{Pu"ƒџu‰б‰гСъСщ СыёйЪаыЈЖ9<$w ‹“„…вEЭƒФШ[^_]УЖƒш[П@ЃЧƒgџџџы„t&‹{И‰<$…џtˆƒt ‹G‰D$ƒР‹<$‹…џt)Чt&ƒР€|џuі‹<$‹$…џt)ЧД&vƒР€|џuі‹<$‹,…џ„/џџџƒРщ'џџџƒ{lРƒрќƒР щџџџД&Д&S‹D$‹T$ …Рt‹X …лt‹H$…Щt ‹H…Щt;t Иўџџџ[Уv‹Iƒљ*tƒљ9tƒљqƒљZ)ƒщEƒсћuзƒњwб[щемџџt&љšuОыцЖƒщ[Л@ЃЫsЉыбWVSƒь‹\$ …лtB‹C …Рt;‹S$…вt4‹CЙўџџџ…Рt-;u)‹pƒў*t4ƒў9t/ƒўq"ƒўZБNЛƒсћtЙўџџџƒФ‰Ш[^_Уfўšuэ‹H…Щt‰L$‹C(‰$џв‹C‹S$‹HD…Щt‰L$‹C(‰$џв‹C‹S$‹H@…Щt‰L$‹C(‰$џв‹C‹S$‹H8…Щt‰L$‹C(‰$џв‹S$‹C‰D$‹C(‰$џв1ЩƒўqЧC•СƒФLI§[^‰Ш_Уt&NЅП@ЃЯƒGџџџщZџџџfUWVSƒь,‹|$P‹D$D‹T$X‹t$@‹\$H‹L$\‰|$‹|$T‰D$‹D$L‰|$…в„•€:1•Тƒљ8•СЪ‰е……і„g‹V ЧF…в„=‹N$…Щ„"‹|$ЙƒџџEЯ‰L$…РˆяПƒјЩ‹L$ƒщƒљ‡Hјƒљ‡ƒћ…ќƒ|$ ‡ёƒ|$‡цƒјu ‰щ„Щ…зƒјЙ ЧD$ФEШЧD$‹F(‰Э‰$џв‰У…Р„ц‰F‰щ‹T$‰xП‰h0‰0Ч@*Ч@‰јгрJƒТ ‰C,‰Х@џ‰C4‰јгр‰KPЙЋЊЊЊ‰CLƒш‰CT‰аїсбъ‰SX‰l$ЧD$‹F(‰$џV ‰C8ЧD$‹C,‰D$‹F(‰$џV ‰C@ЧD$‹CL‰D$‹F(‰$џV ‹T$ЧƒР‰CDJгч‰ЛœЧD$‰|$‹F(‰$џV ‹“œ‹k8‰C •‰K …э„з‹{@…џ„Ь‹KD…Щ„С…Р„ЙаЦC$‰ƒ˜DR§‰ƒЄ‹D$‰ƒ„‹D$‰ƒˆ‰t$@ƒФ,[^_]щЯђџџД&ƒшНПщ%ўџџЖƒјё|;їиН1џщ ўџџt&ЧF$ cщв§џџt&ЧF р cКр cЧF(щЋ§џџИўџџџƒФ,[^_]УvИњџџџыюД&fЁXк cЧCš‰F‰4$шљћџџИќџџџыЧИќџџџыРД&t&WVSƒь‹D$(‹t$ ‹|$$‹T$,…Р„т€81…йƒњ8…а…і„и‹F ЧF…Р„ž‹^$…л„ƒƒџџ„jƒџ ‡ЉЧD$ФЧD$‹V(‰$џа‰У…Р„Е‰F‰0Ч@*Ч@Ч@Ч@0Ч@,€Ч@4џЧ@PЧ@L€Ч@TџЧ@XЧD$ЧD$€‹F(‰$џV ‰C8ЧD$‹C,‰D$‹F(‰$џV ‰C@ЧD$‹CL‰D$‹F(‰$џV ЧƒР‰CDЧƒœ@ЧD$ЧD$@‹F(‰$џV ‹“œ‰C •‰K ‹K8…Щ„Џ‹K@…Щ„Є‹KD…Щ„™…Р„‘а‰Л„‰ƒ˜DR§‰ƒЄЧƒˆЦC$‰t$ ƒФ[^_щ\№џџt&Пщ•ўџџЖЧF$ cщqўџџt&ЧF р cИр cЧF(щJўџџИњџџџƒФ[^_Уt&ИўџџџыюД&fЁXк cЧCš‰F‰4$шЉљџџИќџџџыЧИќџџџыРД&t&UWVSƒь,‹D$D‹l$@…РtZ‹X …лtS‹x$…џtL‹PЙўџџџ…вt#;u‹rƒў*tOƒў9tJƒўq=ƒўZƒюEƒцћt8ƒФ,‰Ш[^_]УЖƒю[Й@ЃёrƒФ,Йўџџџ[‰Ш^_]Уt&ўšuШ‰T$…эt틉M‹H‰M‹H‰M‹H ‰M ‹H‰M‹H‰M‹H‰M‹H‰M‹H ‰M ‹H$‰M$‹H(‰M(‹p,‰u,‹p0‰u0‹@4‰E4ЧD$ФЧD$‰ $џг‰У…Р„А‹T$‰E{‰йƒчќ‹‰ж)љ)ЮСФ‰‹‚РСщ‰ƒР‰T$ѓЅ‰+ЧD$‹C,‰D$‹E(‰$џU ‰C8ЧD$‹C,‰D$‹E(‰$џU ‰C@ЧD$‹CL‰D$‹E(‰$џU ‰CDЧD$‹ƒœ‰D$‹E(‰$џU ‹K8‰C…Щ„ю‹s@…і„у‹SD…в„и…Р‹T$„Ь‹C,‹r8‰ $‰T$Р‰t$‰D$ш‹T$‹C,‹K@‹r@Р‰ $‰t$‰D$шё‹T$‹CL‹KD‹rDР‰ $‰t$‰D$шв‹T$‹ƒœ‹K‹rСр‰ $‰t$‰D$шЏ‹C‹T$‰СƒœJ+J‰ƒ˜ƒ”‰ƒ ƒˆ ‰ƒ$ ƒ| ‰K1Щ‰ƒ0 ƒФ,‰Ш[^_]У‰,$шшіџџЙќџџџщž§џџЙќџџџщ”§џџ‹D$…Рtx Ot‰D$щж(ЖщлИўџџџУƒьD$,‰D$ ‹D$(‰D$‹D$$‰D$‹D$ ‰$шiРƒФУt&UWVSƒь,…Р„ЁЧ$‰Ч‰ж‰ЭшЏ‰У…Р„…Ч@Ч@ Ч@TЧ@ Ч@<џџџџЧ@@Ч@(ЖEЧD$„Рuы:fОв‰S<ЖEƒХ„РtOPа€њ vчƒш+џ‰C$…ЄЋC@ЧCxЧC|‰D$‹C<Чƒ€‰D$CXЧD$8ЧD$ОЗ cЧD$ЧD$ ЧD$‰$шŠкџџ…Рu+‹S‹C(ЧCX‰S…Р…iџџџ‰Sh‹S$‰Sd‰SƒФ [^_У‹C$‰$шˆў‹C ‰$ш}ўЧD$АЗ cЧD$ќџџџ‰$ш-юџџИџџџџщ џџџ‰4$ыдД&Д&UWV‰жS‰Уƒь,‹x…џ„b‹{(…џ„‹S\…℉‹CXыД&‹S\)ТCX‰S\‰CX…вtkЙ@‰D$‹C9ЪGб‰$‰T$шС§…РyЭџL cПџџџџ‹‰$шўЧD$џџџџ‰D$‰$ш|эџџƒФ,‰ј[^_]Уf‹KDCX‰D$…Щt)‹S\…вuƒФ,1џ[‰ј^_]УД&‰$шpЮџџЧCD‹Kh1Р…ЩtP…іtƒў…Уƒј„К‰Э‹D$‰t$‰$шxзџџƒјў„Ў‹Kh9щuФƒўu˜ЧCDщkџџџД&‹Sd‹C9Тwы_t&‹SdC‰C9аsC)ТЙ@‰D$‹C9ЪOб‰$‰T$шМќ…Рyащіўџџvшc§џџ‰Чƒјџ…Žўџџщџџџv‹kh…э…]џџџ‹C$‹k‰Cd‰kh‰CщIџџџ‹Sd‹C9Тw“щ7џџџЧD$ФЗ cПџџџџЧD$ўџџџ‰$ш4ьџџщГўџџД&Д&WVS‰Уƒь‹p…і„-‹K(…Щt~‹S\…в„„‹CXыЖ‹S\)ТCX‰S\‰CX…вtgЙ@‰D$‹C9ЪGб‰$‰T$шйћ…РyЭџL c‹‰$ш-ќЧD$џџџџ‰D$‰$ш™ыџџИџџџџƒФ[^_Уt&‹SDsX…вt%‹C\…РuƒФ1Р[^_УЖ‰4$шЬџџЧCD‹Ch‰Ч…Рt&ЧD$‰4$шАеџџƒјў„Ž‹Ch9јtЙ‰Ч…Рuк‹Sd‹C9ТwыaЖ‹SdC‰C9ТvC)ТЙ@‰D$‹C9ЪOб‰$‰T$шћ…Рyащ&џџџvшЋћџџƒјџ…Хўџџщ9џџџt&‹{h…џ…mџџџ‹C$‹{‰Cd‰{h‰CщYџџџЧD$ФЗ cЧD$ўџџџ‰$ш‘ъџџИџџџџщѓўџџД&UW‰зVS‰Уƒь‹@\…Рu~Н…џtCt&‹sш(ыџџ9ЦwD‹s9ў=…эu?Д&f‹C s‰s\‰CX‰иш ўџџƒјџtH1э)їuТƒФ1Р[^_]УД&‰ў…эtЪ‹C ‰t$ЧD$‰$шcњыБ‰ишЩ§џџƒјџ…rџџџƒФИџџџџ[^_]УvUWVS‰Уƒь,‰L$…Щ„›‰ж‹P…в„~‹CL…Р…Ы‹C‹S\9D$ƒ‹‹|$‹K ‰Х…вtKЖ‹CXТ‰t$‰а‰$)Ш)Х9§Gя‰l$шРљk\k)яt>‰иш/§џџƒјџt*‹S\ю‹K ‹k…вuЛ‰KX‰ШыЗt&шћљџџƒјџ…tџџџfЧD$‹D$ƒФ,[^_]Уt&…вuT‹D$C‰sX‰C\‰ишаќџџƒјџtЫ‹D$ƒФ,[^_]УД&ЧCL‹SH‰ишGўџџƒјџtЂ‹C‹S\9D$‚џџџыЈ‰иш‰ќџџƒјџu ы‚fƒь‹D$ ‹T$$‹L$(…Рt5x Бyu,ƒxPu&…Щx ƒФщЂўџџfЧD$ьЗ cЧD$§џџџ‰$шXшџџ1РƒФУfS1Рƒь‹\$,…лt9{ Бyu0‹KP…Щu)‹T$$…вt!‹D$(їd$$p …Рt‹T$ ‰С‰иш?ўџџ1вїt$$ƒФ[Уt&ЧD$И cЧD$ўџџџ‰$шшчџџ1Рылt&WVSƒь‹\$ ‹t$$…л„š{ Бy…‹SP…в…‚‹CL…Рuc‹S…вt/‹C\‹K …Рu‰KX‰№ˆЖРƒC\ƒCƒФ[^_УCX‰Ч)Я9њwL‰№ЙT$ˆD$‰иш§џџƒјu*‰№ЖРƒФ[^_УЖЧCL‹SH‰ишЗќџџƒјџu‡fИџџџџыд‰СыŽt&WVSƒь‹t$ ‹|$$…іt6~ Бyu-‹FP…Рu&‰<$ш~ї‰њ‰У‰С‰№ш§џџ9Уw ƒФ‰и[^_Уt&ЛџџџџыьUWVSƒь‹\$0…л„-{ Бy… ‹KP…Щ…‹S…вt~‹CL…Р…Ѓ‹C\…Рt\‹SX<‹CЦDџ‹D$8‰D$ ‹D$4‰D$‹C‰<$‰D$ш?›‰Ц…Рt‹k9ХvR€|/џuK‹{\CЧ‰{\9§vlƒФ‰№[^_]Уf‹S ‰SXыŸД&‰ишщіџџƒјџ…rџџџ‹sPƒФ[‰№^_]УvƒФ1і[‰№^_]Уt&ЧCL‹SH‰иш_ћџџƒјџ…CџџџыФt&‰k\‰ишІљџџƒјџtБ)я‹C ‰|$‹S‰$Т‰T$ші‹C ‰{\‰CXщ]џџџД&fОўџџџщJџџџЖUWVSƒь‹\$0…л„-{ Бy… ‹KP…Щ…‹S…вt~‹CL…Р…Ѓ‹C\…Рt\‹SX<‹CЦDџD$8‰D$ ‹D$4‰D$‹C‰<$‰D$шя™‰Ц…Рt‹k9ХvR€|/џuK‹{\CЧ‰{\9§vlƒФ‰№[^_]Уf‹S ‰SXыŸД&‰иш™ѕџџƒјџ…rџџџ‹sPƒФ[‰№^_]УvƒФ1і[‰№^_]Уt&ЧCL‹SH‰ишњџџƒјџ…CџџџыФt&‰k\‰ишVјџџƒјџtБ)я‹C ‰|$‹S‰$Т‰T$шПє‹C ‰{\‰CXщ]џџџД&fОўџџџщJџџџЖVSƒь‹\$‹t$…лtO{ БyuF‹SP…вu?ƒўw:‹CL…Рu‰ђ‰ишъѕџџ‹CPƒФ[^УЧCL‹SH‰иш_љџџƒјџuзыоД&ИўџџџывД&fUWVSƒь‹\$0‹t$4‹l$8…л„Ѕ{ Бy…˜‹{P…џ…‹{(…џ…‚9sЧBA?Сюƒя‰љƒчјƒсгю‰ѓƒџwQ‹Д$ЄД&f…эuD$|‰D$‹„$Ј‰$џж‰Х…Р„і‹D$|ƒэH‰L$|Ж‰љƒЧгрУƒџvПЗѓСыѓџџ9о„П‹|$(‹„$ Ч@SИ c‹w,ЧGQ?ЦD$0Л§џџџщќџџ‹„$ ‹T$4‰X‰P ‹D$|‹”$ ‰‹D$(‰j‰p<‰Ц‰x@‹@,9F0s‰Т)к‰V0‰D$‹„$ ‰$шЁ}‹„$ ‹@ ‰D$4‹„$ ‹@‰D$,‹„$ ‹‰D$|‹„$ ‹h‹D$(‹p<‹x@‹@щFћџџ‹D$(‰pD…і„И‹|$,‰ђ‰Цt&…эu+D$|‰T$,‰D$‹„$Ј‰$џ”$Є‹T$,…Р‰Х„L…џu6‹F8‹~,‰T$,‰~0‰D$4‰D$‹„$А‰|$‰$џ”$Ќ‹T$,…Р…њ9§‰ћ‹D$|Fн‰D$‹D$49гGк‰$‰\$)н)пшы‹VD\$|\$4)к‰VD…Yџџџ‰|$,‹D$(1џ1іЧ@??‹@…Р„—ќџџv‹|$(ЧGP?ЦD$0‹w,Лщlњџџv‹|$(ЧD$|‹w,ЛћџџџЦD$0щKњџџ‹|$(ыЧ‹|$(‹w,щ)ўџџД&‹|$(ЧD$|Лћџџџ‹w,щњџџ‰иЧCl1л‰T$8‰к‰УƒџwG…эu)D$|‰D$‹„$Ј‰$џ”$Є‰Х…РtU‹C`‹Sl‰D$8‹D$|ƒэH‰L$|Ж‰љƒЧгрЦЗ„@Т cJ‰ђƒяƒт‰KlСюf‰TCt;L$8ƒ$‰ЪƒџvŠыЯ‰пЧD$|Лћџџџ‹w,щqљџџЧBP@К cСюƒяЧBX ЧBTРЙ cЧB\ЧBH?щ њџџ‹„$ ‹r,‰зЧ@@И cЧBQ?щ§џџіD$<@„ ‹|$(‹„$ ‹w,Ч@Й cЧGQ?щшќџџЛўџџџщ7љџџ‰|$,Лћџџџ‰ї‹v,ЦD$0щжјџџ‰|$,‰їщfўџџ Иџџџџгрїа‰D$DыXД&…эu.D$|‰D$‹„$Ј‰$џ”$Є‰Х…Р„Yўџџ‹D$(‹@P‰D$@‹D$|‰љƒэƒЧP‰T$|ЖгрЦ‹D$D‹T$@‰й!№гшD$8‚ЗHЖf‰L$<Ж@ 9љwˆ‰й)п‹\$(гю)Ч‰СЗD$<гю‰D$8‰CD„в„xјџџˆT$<щчљџџЖD$<‹T$(‰Уƒу‰ZLЈtu9ћvY‰к‹œ$ЈД&f…эu#D$|‰$‰D$џ”$Є‰Х…Р„§џџ‹D$(‹PL‹D$|ƒэH‰L$|Ж‰љƒЧгрЦ9зrЛ‰г‰йИџџџџ‹T$()пгрїа!№BDгю‹D$(‹X\‹PTИџџџџ‰й‰T$<гр‰бїа!№‚ЖˆT$8ЖPЗ@f‰D$@ЖТ‰D$L9Чƒ•‰\$<‰ѓ‰ЮЖ…эu1D$|‰D$‹„$Ј‰$џ”$Є‰Х…Р„йќџџ‹D$(‹pT‹@\‰D$<‹D$|‰љƒЧƒэP‰T$|ЖгрЖL$<УИџџџџгрїа!и†ЖˆT$8ЖPЗ@f‰D$@ЖТ9јwƒ‰D$L‰t$<‰оіD$8№„K‰б)ЧгюіD$8@„й‹|$(‹„$ ‹w,Ч@#Й cЧGQ?щ]њџџƒљw,‹\$(„ @Т cЙfТ cЗƒРfЧDSt9Сuя‹D$(Ч@l‹\$(ƒ4ЧCXSX‰CpKp‰CP‰D$hƒєƒУt‰D$‰T$‰L$ ЧD$‰\$Ч$‰D$P‰T$l‰L$T‰\$Xш B…Р„1‹|$(‹„$ ‹w,Ч@”И cЧGQ?щЅљџџЖD$8‹L$(ЗT$@‰Уƒу‰QH‰YLЈ…‹D$(‹X,;X0ИGD$,‰й)С9бƒ‹|$(‹„$ ‰оЧ@9Й cЧGQ?щDљџџЗL$@‰У‰L$DЖL$8СƒШџгр‰бїа‰D$H!№ыT…эu.D$|‰D$‹„$Ј‰$џ”$Є‰Х…Р„йњџџ‹D$(‹@T‰D$<‹D$|‰љƒэƒЧP‰T$|Жгр‰йЦ‹D$H!№‹T$<гшD$D‚ЖˆT$8ЖPЗ@f‰D$@ЖТ 9љw‰й+|$Lгющўџџ‹T$(‹BhBdЧBl„ѓ‰l$8‹\$(‹CXНџџџџ‹SP‰С‰D$<гх‰шїа!№‚ЖhЗ@‰l$@‰щ9§†„‰\$D‹l$8…эu1D$|‰D$‹„$Ј‰$џ”$Є‰Х…Р„•‹D$D‹PP‹@X‰D$<‹D$|ƒэH‰L$|Ж‰љƒЧгрЖL$<ЦИџџџџгрїа!№‚ЖXЗ@‰й9ћw‰l$8‰\$@‹\$Dfƒјwq‹Slгю+|$@J‰Klf‰DSt‹Ch‹Sd‰D$@T$@9Sl‚џџџ‹l$8‹D$(xQ?„m‹D$(fƒИt…№‰Ч‹„$ ‹w,Ч@АИ cЧGQ?щIїџџfƒј„0fƒј‹D$@„*ƒР‹l$8‰D$<9јvK…эu#D$|‰D$‹„$Ј‰$џ”$Є‰Х…Р„ƒљџџ‹D$|‰љƒэƒЧP‰T$|ЖгрЦ;|$?1і‹D$(‹P…в„!ЧD$ЧD$Ч$шІgџџ‹\$(‹”$ ‰C‰B0ЧC??Жƒ|$P†]‹D$(‹P…в„~ ‰ѓ‰ю‹l$(‰йƒујЧEN?ƒсгl$,‹E ‰D$@…Р„ьƒћ‡ …џ„?F‰йWџ‰D$(ЖгрKD$,ƒљ‡n…в„0FWў‰D$(ЖFгрKD$,ƒљ‡F…в„FW§‰D$(ЖFгрKD$,ƒљ‡…в„рFƒяƒУ ‰D$(ЖFгрD$,‹t$4‹”$ ‹L$0‰№)ШB‹T$@E ƒт…Р„…в…7‹D$0‹t$(ЧD$,1л‰D$4t&ЧEO?щ+ƒМ$ЄЧEP`Х cЧEX ЧETрФ cЧE\ЧEG?„Т"Сl$,ƒю‰Х‹D$(Ч@H?ƒџ†” ‹D$0=†… ‹”$ ‹\$8‰B‹D$,‰Z ‹\$(‰*‰z‰C<‹D$4‰s@‰D$‰$шЙb‹„$ ‹s@‹@ ‰D$8‹„$ ‹@‰D$0‹„$ ‹(‹x‹C<‰D$,‹C=??„ё-4?щŠќџџД&‹D$(‹XL…л…щ‹D$(Ч@L?‹\$0…л„2‹T$(‹L$4‹RH‰Ш)и9Т†ћ‹T$(‰У)Ы‰й9Z0ƒЅ ‹šФ…л„— ‹„$ ‰ѓ‰ю‰еЧ@эУ cЧBQ?ЧD$(§џџџ‹L$4+L$0t&‹„$ ‹T$8‰P ‰Т‹D$0‰2‹t$,‰B‰z‹U,‰u<‰]@…вu+9D$4tT‹E=P?wJƒМ$Єu=M?w9Д&v‹T$8‹„$ шђџџ…Р…D‹„$ ‹L$4‹x‹@‰D$0)С‹„$ ‹\$<H)ћXM іE t…Щ…U‹u1в…і‹u•ТСтU@‚€ў??t"ўG?”РўB?‰Ч”Р‰Ц‰ј №ЖРСра‹М$  Ы‰G,tƒМ$Є…]њџџ‹D$(…Р…QњџџЧD$(ћџџџщDњџџt&‹D$(‹PL…в…‘‹D$(‹@D‹T$(‰‚ЬЧBJ?‹D$(‹H\‹XTИџџџџгр‰\$Dїа‰D$L#D$,ƒЖPЖЗ@f‰D$@ЖТ‰D$H9№ve…џ„$ ‰ё‰ў‹|$,ыД&v…і„ШЖE‹\$DƒХƒюгрƒСЧ‹D$L!јƒЖPЖЗ@f‰D$@ЖТ‰D$H9ШwП‰|$,‰ї‰Ю‰СіУ№„‹D$(‹€Шгl$,С‹D$(+t$H‰ˆШіУ@„ ‰ѓ‰ю‰Х‹„$ Ч@зУ cЧEQ?щЉ§џџt&…џ„Yљџџщљџџv‹D$(‹@D‹T$(ЧBC?…Р„.9ЧFЧ‰У‹D$09УGи…л„ї‹D$8‰l$)пн‰\$‰$шЮ‹D$()\$0\$8)XD‹@щІќџџД&‹D$(‹@DыЁД&‹D$(‹@‰Тт…в„Є‹L$(‹QD9з‰гFп‰\$@…лt‹I$…ЩtM‹Y‰\$D…лtB‹Y‹I‰\$H)г9йv2‹D$@Ъ+T$H‰l$и9С‰а‹T$DCD$@к‰D$‰$ш^Э‹L$(‹AіФt‹D$(і@ …Т‹D$(‹\$@‹PD)пн‰T$@)к‰PD…в…4 ‹D$(‹@‹\$(ЧCDЧC:?іФ… ‹L$(‹Q$…вtЧB‹\$(ЧCDЧC;?іФ… ‹L$(‹Q$…вtЧB$‹\$(ЧC?uцЧD$ЧD$Ч$шEAџџ‹L$(‰$‰L$‹L$$‰L$ш-Aџџ9FuH‹L$(‹T$$‰иT$(ш5Яџџ…Рu;ЧFƒФ[^Уt&ƒФИўџџџ[^Уt&њ>?uРы…ЖИ§џџџщ[џџџЧFR?ИќџџџщJџџџt&S‹D$‹\$ …РtS‹H …ЩtL‹P$…вtE‹PЙўџџџ…вt;u ‹B-4?ƒјv‰Ш[Уt&іB tђ1Щ‰Z$‰ШЧC0[УД&vЙўџџџ[‰ШУД&UWVSƒь‹\$0…넧‹S …в„ђ‹C$…Р„ч‹kИўџџџ…эt;]u‹UŠЬРџџƒљvƒФ[^_]У‹C‰Ч…Р…г‹E@ƒј†-њS?„ ‹U<‰СƒрјЧES?ƒс‰E@гъ‰U<‰бxјˆT$Сщƒџv(ˆL$p№‰бСщƒўvСъƒшˆL$‰бƒјvˆT$1ЩСя‰M<1Р1вЧE@ƒЧ‰оы"„л…Л)Уƒћ‰и–СƒТ9зv*„Щt&ƒјЖ\Щїб8ЫuЮƒРƒј–СƒТ9зwмЖ‰ѓ‰El‹{…џ‹3•Т ЪˆT$Кt\‰l$‰ны&t&„л…ШЛ)Уƒћ‰и–СƒТ9њs*„Щt&ƒјЖЩїб8ЫuЯƒРƒј–СƒТ9њrнД&‰ы‹l$ж‰El‰3‹s)Sж‰sƒј…г‹}1Рƒџџt‹E ƒрћ‹S‰E ‰$‰T$шХЮџџ‹T$‰s1Р‰S‰}ЧE??ƒФ[^_]УД&Й1Рщыўџџt&ƒФИўџџџ[^_]УvЖL$1Рщ;џџџt&њS?t8‹E@‹U<ЧES?‰Сƒрјƒс‰E@гъ‰U<ƒј‡1ўџџЙ1РщРўџџЖ‹Elƒј–СщВўџџf‹3‹El1вщџџџИ§џџџщВ§џџИћџџџщЈ§џџS‹D$…РtW‹H …ЩtP‹P$…вtI‹HКўџџџ…Щt;u‹A˜ЬРџџƒћv ‰а[УД&1в=A?uь‹A@1в[…Р”Т‰аУД&fКўџџџ[‰аУД&UWVSƒь,‹t$D‹\$@…і„‰‹N …Щ„~‹V$…в„s‹VИўџџџ…в„Y;2…Q‹B‰T$-4?ƒј‡F…л„>ЧD$аЧD$‹F(‰$џб‰Х…Р„‹T$‹B8‰D$…Р„ЧD$‹J(И‰T$гр‰D$‹F(‰$џV ‹T$…Р‰D$„д‹}‰щƒчќ‰‹F)љ‰C‹F‰C‹F ‰C ‹F‰C‹F‰C‹F‰C‹F‰C‹F ‰C ‹F$‰C$‹F(‰C(‹F,‰C,‹F0‰C0‹F4‰ж)ЮСа‰C4‹Сщ‰E‹‚Ь‰…ЬѓЅ‹BPŠ4‰]9С†ц‹Bp)Ш„4‰Ep‹J(И‹R8гр‰T$‰D$‹D$‰$ш†Ї‹D$‰E81Р‰kƒФ,[^_]УfƒФ,Иўџџџ[^_]Уv‹}‰щƒчќ‰‹F)љ‰C‹F‰C‹F ‰C ‹F‰C‹F‰C‹F‰C‹F‰C‹F ‰C ‹F$‰C$‹F(‰C(‹F,‰C,‹F0‰C0‹F4‰ж)ЮСа‰C4‹Сщ‰E‹‚Ь‰…ЬѓЅ‹BPŠ4‰]9ШrDt&КРЕ49јw)Ш№‰EP‹BT)Ш№‰ET‹Bp)ШЦ‹D$‰up…Р„џџџщэўџџt&‹Bp)Ш„4‰EpщіўџџИќџџџщјўџџ‰l$‹F(‰$џV$ИќџџџщсўџџД&t&‹D$…РtP‹H …ЩtI‹P$…вtB‹HКўџџџ…Щt;u ‹A-4?ƒјv ‰аУД&vЧФК§џџџ‰аУЖКўџџџ‰аУ‹D$…Рth‹H …Щta‹P$…вtZ‹PЙўџџџ…вt;u ‹B-4?ƒјv ‰ШУД&v‹L$‹B …Щt…РtƒШ1Щ‰B ‰ШУЖƒрћ1Щ‰B ‰ШУt&Йўџџџ‰ШУД&S‹T$…вt_‹J …ЩtX‹B$…РtQ‹JИџџ…Щt;u‹QšЬРџџƒћv [УД&f‹ШСрњC?tњL?uмЬ[+ADУt&Иџџ[УAD[УД&t&‹T$…вtH‹J …ЩtA‹B$…Рt:‹JИџџџџ…Щt;u‹Qъ4?ƒњvУv‹Ap‘4)аСјУД&fИџџџџУU1в1РWVSƒФ€‰T@ƒРƒј rє‹„$˜‹œ$œ X…лtt&ЗƒРfƒDT@9Шu№‹„$ЄЗ|$^‹‰D$f…џ…сfƒ|$\…fƒ|$Z…Qfƒ|$X…д fƒ|$V…Ђfƒ|$T…р fƒ|$R…ј fƒ|$P…ь fƒ|$N… fƒ|$L…l fƒ|$J…„ fƒ|$H…т fƒ|$F…­ fƒ|$D… fƒ|$B…ѓ ‹„$ ‹М$ ‹PЧ@‰Ч@@‹„$ЄЧ1Рƒь€[^_]Уfƒ|$B…? fƒ|$D…, fƒ|$F…ФЧ$fƒ|$HtP‹$Ч$‰D$ щfƒ|$B…Њfƒ|$D…Б Ч$fƒ|$F…Ж fƒ|$HuКƒ<$„9 fƒ|$J‹$…I ƒј„3 fƒ|$L…› ƒј„… fƒ|$N…i ƒј„S fƒ|$P…7 ƒј „! fƒ|$R… ƒј „c fƒ|$T…є ƒј „о fƒ|$V…Т ƒј „Ќ fƒ|$X… ‰Цƒј „x fƒ|$Z…У ƒј…O fƒ|$\ИЧD$ DЦ‰$ЗT$BИ‰б)аˆЂЗ\$DР‰к)иˆ‘Зt$FР‰ѓ)№ˆ€Зt$HР‰ѕ)№ˆoЗt$JРf‰t$)№ˆ[Зt$LРf‰t$)№ˆGЗt$NРf‰t$)№ˆ3Зt$PРf‰t$<)№ˆЗt$RРf‰t$)№ˆ Зt$TРf‰t$)№ˆїЗt$VРf‰t$ )№ˆуЗt$XРf‰t$$)№ˆЯЗt$ZРf‰t$()№ˆЛЗt$\Рf‰t$,)№ˆЇРЗї9№ˆšt‹„$”…Р„‰ƒ|$ …~Ъ‹М$œ1іf‰L$df‰T$fк1Рf‰T$hъf‰T$jfT$f‰T$lfT$f‰T$nfT$f‰T$pfT$|$$PЖD$>†р„Р„иƒь€И[^_]УЧD$ Ч$щb§џџЧD$ Ч$щN§џџt&ƒь€Иџџџџ[^_]У|$$TwАЧD$ ЧD$8 Ю cЧD$4`Ю cЦD$?ЦD$>ы.t&‹„$ЈЧD$ ЦD$>‰D$8‰D$4ƒМ$””D$?‹D$$ЧD$(џџџџ1эЧD$ƒш‰D$,‹„$Ј‰D$‹D$0‰D$‹D$‰D$Д&Ж$*D$1вˆD$<‹D$‹\$ ЗH‰Ч9йr9и‚‹|$8)иЖG‹|$4З…Cћџџ‹\$01вŠT$‰|$(Št$ Лf‰‹T$)кСњf‰Qщ§џџf‰L$ы’…Рt‹|$Ж\$<1в‡Ц@ˆXf‰P‹|$$‹D$0И‹М$ ‰‹„$Є‹|$‰81Рщъіџџ‰\$щEџџџfƒ|$B…Дfƒ|$D…”Ч$ щ*їџџfƒ|$B…№fƒ|$D…аЧ$ щїџџfƒ|$B…Dfƒ|$D…$Ч$щтіџџfƒ|$B…\fƒ|$D…dfƒ|$F…БЧ$щxіџџЧD$ ЧD$8 Э cЧD$4рЭ cщ њџџfƒ|$B…ЧD$ 1ЩИЧ$щ{їџџfƒ|$B…pfƒ|$D…PЧ$щJіџџfƒ|$B…fƒ|$D…afƒ|$F…AЗD$HЧD$ fїиРƒР‰$щїџџfƒ|$B… ЗD$DЧD$ fїиРƒР‰$щйіџџfƒ|$B…‹fƒ|$D…ъЗD$FЧD$ fїиРƒР‰$щЄіџџЧD$ Ч$щіџџЧD$ щƒіџџ‰D$ Ч$щsіџџ‰D$ Ч$ щcіџџЧD$ щVіџџ‰D$ Ч$щFіџџЧD$ щ9іџџ‰D$ Ч$щ)іџџЧD$ щіџџ‰D$ Ч$щ іџџЧD$ щџѕџџfƒ|$B…rfƒ|$D…Rfƒ|$F…Ч$ щœєџџt&ЧD$ Ч$щЖѕџџЧD$ щЉѕџџ‰D$ Ч$ щ™ѕџџЧD$ щŒѕџџ‰D$ Ч$ щ|ѕџџЧD$ щoѕџџ‰D$ Ч$ щ_ѕџџ‰D$ Ч$ щOѕџџЧD$ Ч$щ;ѕџџЧD$ Ч$щ'ѕџџЧD$ Ч$щѕџџЧD$ Ч$щџєџџЧD$ Ч$щыєџџЧD$ Ч$щзєџџЧD$ Ч$щУєџџЧD$ Ч$щЏєџџЧD$ Ч$щ›єџџЧD$ Ч$щ‡єџџЧD$ Ч$щsєџџЧD$ Ч$щ_єџџЧD$ Ч$щKєџџЧD$ Ч$щ7єџџ‹$Ч$‰D$ щ$єџџД&vЧD$ Ч$щєџџЧD$ Ч$щђѓџџЧD$ Ч$щоѓџџЧD$ Ч$щЪѓџџЧD$ Ч$щЖѓџџЧD$ Ч$щЂѓџџЧD$ щ•ѓџџЧD$ Ч$щѓџџЧD$ Ч$щmѓџџfƒ|$Bu_fƒ|$DuCfƒ|$Fu'Ч$ щђџџД&ЧD$ Ч$щ.ѓџџЧD$ Ч$щѓџџЧD$ Ч$щѓџџЧD$ Ч$щђђџџД&ЧD$ Ч$щжђџџfƒ|$Bufƒ|$Duv9з„И9№Rt•‹МПЗ–~ Зž| )з‰игрf …И9ЯŒЮб‹\$f‰…И‰М…л„ЋЗž| З–~ ‰\$гу иЛ)г9ЫŒібƒ|$f‰…И‰МtpЗž| З–~ П‰о)згц №4 9Я}A‹M‹uf‰…Иy‰}ˆ‹EЖЙ‹ux‰}ˆ ‹ЕМЙ)ёt№гћ‰иf‰…И‰ЕМ‹D$…Р„ќ‹L$ ОЛЧD$ƒ$‹$9D$„Ц‹$‹T$З‰T$ ‰D$‰Ч‹D$ƒР‰D$9иŒžўџџ‹t$ ‹…МЗ•И…і„Е9ЮtvЗœЕ~ ЗДЕ| ‰С‰їгчЙ)й њ9СК‹E‹}f‰•ИH‰Mˆ‹EЖЙ‹}P‰Uˆ ‹…МЙ)СD№‹\$‰…Мгў‰\$‰ђЗЕМ ‰СЗО ‰їгч  њП)п9Ч}A‹E‹Mf‰•Иx‰}ˆ‹EЖЙ‹Ux‰}ˆ ‹…МЙ)СгўL№‰ђ‰МƒљŽЇ‹D$‹]ƒшЗР‰Чгч‹M њqf‰•И‰uˆ ‹UЖЙ‹Mr‰uˆ‹•МЙ)бƒъгј‰•Мf‰…И‹T$…вtD‹|$ 9|$…:ўџџƒ$‹L$ОЛЧD$‹$9D$…:ўџџƒФ[^_]УД&‹L$ ОЛŠЧD$щџ§џџt&ƒ|$ §ЗЕТ ЙЗР )ё9Сx‰С‰пгч‰ј‹} а‹Uf‰…ИJ‰Mˆ‹EЖЙ‹}P‰Uˆ ‹…МЙ)СгћL0№‰Мƒљ Ž<‹T$ƒъЗв‰агр‹M и‹]qf‰…И‰uˆ ‹EЖЙ‹Mp‰uˆ‹…МЙ)Сƒш гњ‰…Мf‰•ИщДўџџЗD$ƒшЗРгрƒС Т‰Мf‰•Ищўџџt&ЗНФ ‰СЗЦ ‰ўгц  ђО)о9Ц}A‹E‹Mf‰•Иp‰uˆ‹EЖЙ‹Up‰uˆ ‹…МЙ)СгџL№‰њ‰Мƒљ Žl‹D$‹]ƒш ЗР‰Чгч‹M њqf‰•И‰uˆ ‹UЖЙ‹Mr‰uˆ‹•МЙ)бƒъ гј‰•Мf‰…ИщИ§џџt&‹Mf‰…Иy‰}‹}ˆ‹EЖЙx‰}‹}ˆ Й+Мгћ‰и‹МL№щъњџџЖи‹\$‰…М‰\$щ€ќџџv‹Mf‰…ИY‰]‹]ˆ ‹EЖЙ‹}H‰MЙˆ‹М‹D$)йгјL№щФњџџ‰D$щaћџџД&‰Сгу‰й‰г Ы ‰Мƒљ Ф§џџЗT$‰пA‰…МƒъЗвгт зf‰НИщВќџџЖЗD$ƒш ЗРгрƒС Т‰Мf‰•Ищˆќџџt&U‰ХWVSƒь‹ИМЗАИ‹€ ‰T$‰L$…Р„ЧD$‰ѓ‰<$щ‹f‹D$‹<$‰љЗPЗ‰ЦгцЙ ѓ)бf‰И9љQ‹M‹uy‰}ˆ‹MЖЙ‹uy‰}ˆ‹ЕМЙ)ёгјf‰…И‰УD№‰$‰…М‹D$9… †_‹|$‹•˜ЖD:Ж :wƒЧЖ2‰|$СрШ‰Ц„IџџџЖТ‹|$‰D$ Ж€ а cŒ‡ЗQЗ ‰Я‰L$Ж $гч‹ $ ћП)зб;<$}E‹Mf‰Иy‰}‹}ˆ‹MЖЙy‰}‹}ˆ‹НМЛ)ћ‰й‹\$гћL№‹… й c‰М…вtj‹|$ +<… Я cЗџ‰јгр УИ)а9Ш)‹Ef‰ИH‰M‹Mˆ‹EЖЙH‰M‹Mˆ‹…МЙ)СгџL№‰М‰ћFџ‰D$ =џ‡ЈЖЖб c‹D$АЗBЗ‰згч ћП)Ч‰|$<‰<$‹|$9Я}D‹Mf‰Иy‰}‹}ˆ‹MЖЙy‰}‹}ˆ‹НМЙD№)љ‰$гњ‰г‹<$‹Е и cf‰И‰НМ…Р„ўџџ‹T$ +Е Я c‰љЗђ‰ђгт гК)Тf‰И9њ‹U‹}J‰Mˆ‹UЖЙ‹}J‰MЙˆ‹•М)бD№гў‰$‰…М‰ѓ‹D$f‰ЕИ9… ‡Є§џџv‹<$‰о‹D$‰љЗЗ€‰$грЙ: №‰Ю)ж9ў}=‹]‹uf‰…И{‰}ˆ‹EЖЙ‹ux‰}ˆ‹М‹$)й\№гј‰Мf‰…ИƒФ[^_]УЖСшЖА в cщPўџџ$‹$‰…МщшќџџД&б‰Мщўџџv$‹$‰…МщРќџџД&U‰СWVSƒь‹€` ‹ЙP‰T$‰D$ƒџŽЦЗ‚НК‰l$f‰D$ы‹D$‰œ\ ‹$9њ‰D$‹œ‘\ ‹D$‰$‰еЗ4˜9њ}ƒХ‰,$‹Ќ‘` ЗЈf9№r=tC‰$f9t$ruЇ‹D$Ж”X8”Xw’‹l$‹D$‰„Љ\ ƒФ[^_]Уv‰Ц‰ыыТfЖ„X8„)XwЌ‰ыыЋv‰ХыЦНыПД&ЖU‰Х‰аWVSƒьP‹@‰T$$‹‹0‹H ‰D$(‰T$‰t$ ‰L$,Ч…PЧ…T=…ЩŽХ 1џЛџџџџ1Ры!ƒЧ‰У‰НP‰„Н\ Ц„XƒР9Сtfƒ<‚uи1іf‰t‚ƒР9Сuы‰\$ ƒџ† ‹\$ ‹•Ј…л„I‹ЕЌG:‰|$‰D$‹|$ ‰$‰t$ыД&v‹|$ƒџ~W‰|$‹\$1Щ1вО‰”…\ f‰3‹4$Ц„X)Ц‰t$ ‹t$ ЗL)L$ƒјu0Иƒџу‡ыЉД&fW‹t$ •‰T$ыž‹t$‹D$ ЙЧ…P‰•d ‹|$f‰ Ц„X‰…Ј‰ЕЌИ1в)јƒџ‹|$OТЧ‹D$$‹t$‰p‰ј‰ўбј‰D$Д&‹|$‹„Н\ ?‰D$9ђВ‹L$‰|$Зf‰D$ t&‹Œ•\ ‹\$З‹f‰$‰а9ђ} ‹М•` ƒР‰|$З<Лf;<$‚Kt9‰аЗ$f9\$ rT„‹T$‰Œ•\ 9ђ0‰D$ыšД&v‹|$Жœ X8œ=XwВЗ$‰љf9\$ sВЖ‹|$ƒl$‹D$‰„Н\ …џџџ‹НP‹t$,‰<$‹|$ыv‰оƒ,$‹$‰њ‹` ‰…P‹„…` ‰…` ‰шш-ќџџ‹T‹…` ‰\$T‰L$ƒщ‰šX ‰T$‰T‰L$ ‡‰‚T ŸЗff‰З‹\$ЖœXˆ\$ЖœXЖD$ƒР8\$ˆD$ CЖ\$ CУ^ˆ„5X‰шf‰qf‰r‰њ‰Е` ш”ћџџƒ<$2џџџ‹D$‹Е` @ ƒсќƒш‰…T‹D$‰АP ‹D$$‹@‰$‹D$(‹X‹x‰\$$‹X…< )Ш‰\$P 1л1РЧ…< ƒтќЧ…X ‰ƒР9аrі‹D$1в|$<f‰TА‹‹\$ ‹D$…л„NД…T …PЧD$‰D$‰|$ Д&‹‹|$• ЗAЗD‡‹|$ ƒР9Ч}ƒD$‰јf‰A9$|>fƒ„E< 1џ9T$ ‹|$$+T$‹<—јЗЏТ…Ј‹D$ ЗDјЏТ…ЌƒЦ;t$u…‹|$ ‹\$…л„ЬGџt}‰D$Gў‰D$ щMЖЗ†8 ‹L$ f…Р…ZЗ†6 W§f…Р…PЗ†4 Oќf…Р…цЗ†2 Wћf…Р…SЗ†0 Oњf…Р…РЗ†. Wљf…Р…-З†, Oјf…Р…šЗ†* Wїf…Р…З†( Oіf…РuxЗ†& Wѕf…Р…хЗ†$ Oєf…РuVЗ†" Wѓf…Р…УЗ† Oђf…Рu4Gё‰D$З† f…Р…З† W№f…Р… З† Oяƒшƒыf‰„M< fƒ„U< fƒЎ< …лŽМЗ†: f…Р„Љўџџ‹L$‰њыС‹|$Жœ X8œ=X‡бћџџщќџџff‰<$‹L$щЌћџџv‰ЧщќџџД&f‰L$‰б‹T$щqџџџЗ•< З…> ваf‰T$2З•@ РТf‰D$4З…B ваf‰T$6З•D РТf‰D$8З…F ваf‰T$:З•H РТf‰D$<З…J ваf‰T$>З•L РТf‰D$@З…N ваf‰T$BЗ•P РТf‰D$DЗ…R ваf‰T$FЗ•T РТf‰D$HЗ…V ваf‰T$JЗ•X Рf‰D$LаРƒ|$џf‰D$NtW‹\$‹D$tƒы ЖƒУ9ѓt<ЗS…вtёЗLT01џAf‰DT0Д&v‰Шбщƒр ј<ƒъuяf‰ƒУ9ѓuФƒФP[^_]У…џ„ЄўџџИ=З”}< …вt;t&ƒш‹Œ…\ 9 $|ё‹t$ ŽЗY9ћt‰ў)оЗЏоЈf‰yƒъuЩ‹t$‰ї…і„Jўџџƒю‰t$ыЂ‹T$щЉ§џџ‰б‹T$ щž§џџЕPЧD$Œ…T ‰l$ ‰t$‹t$t&‹–ЗCЗD†ƒР9Ч}ƒD$‰јf‰C9$|/‹l$ fƒ„E< 9T$ ‹l$$+T$D•ЗЏа‹D$ ЈƒС9L$uЃ‹l$ щЩћџџ4:_‰4$‹t$ ‰иƒўŽŠ‰t$ ‹ $КЧ„…\ ‹t$)Сf‰Ц…Xƒј…‹$ЙЧ…` Ч…PЧ…d ƒшf‰Ц…X‰…ЈИ1в)јƒџOТ<‹D$ ‰D$щјџџf‹L$ƒЦ‰Д…\ БЙf‰ ‹ $Ц„5X)СƒјugИщ8џџџ‰ђ1РО‰…d Ч…Pf‰2Ц„X‰Јщ{џџџ‰Ъ‹L$щќџџ‰б‹T$щіћџџЧD$ џџџџ1џщzіџџ‰\$щrїџџ‰t$ ‰№ыŸЖV1ЩS‹\$ ƒ”“ˆ Чƒ Я cГ| ‰ƒ ‰“$ Чƒ, єЮ c‰Г0 Чƒ8 рЮ cЧƒМf‰‹И‹ Д&fЧƒР9Шuє‰а“ t&1ЩƒРf‰Hќ9аuѓ‰№“Ш v1ЩƒРf‰Hќ9аuѓЧƒЌИf‰ƒ”ЧƒЈЧƒАЧƒ [^Уt&UWVSƒь,‹\$@З|$L‹T$H‹‹М‰јгрqf ƒИƒљ ~@‹K‹sf‰ƒИi‰kˆ‹CЖ‹Й‹sh‰kˆ ‹ГМЙ)ёƒю гџ‰ј‹Kf‰ƒИ‰ГМy‰|$‹{,ƒўŽ‹|$‰{ˆE‹CЖ‹Й‹sx‰{ˆ ‹{‹KЧƒМ1Рf‰ƒИA‰Cˆ‹C‹Kp‰sˆ4‹C‰б‹{їбp‰sˆ ‹C‰б‹{їбp‰sˆ,…вu2SƒФ,[^_]УД&…і~•‹t$‰sˆE‹{‹KыƒД&v‹L$D‹C‰T$HC‰T$‰L$‰$шB{‹T$HSƒФ,[^_]УvVS‹D$ ‹Мƒњt/ƒњ~%‹PǘИ‹Hr‰pˆƒЈМfСЈИ[^Уf‹PǘИ‹Hr‰pˆ‹PƘЙ‹Hr‰pˆ1вf‰ИЧ€М[^УД&Д&WVОS‹D$‰ђ‹ˆМгтYf Иƒљ ~@‹H‹Xf‰Иy‰xˆ ‹PƘЙ‹Hz‰xˆ‹˜МЙ)йƒы гў‰ђf‰ИK‰˜Мƒћ ~9‹H‹Xq‰pˆ ‹PƘЙ‹Hr‰pˆ‹ИМ1Щ1вf‰ˆИOї‰ˆМƒљt*ƒљ~‹H‹Xq‰pˆ ƒЈМfСЈИ[^_Уv‹H‹Xq‰pˆ ‹PƘЙ‹Hr‰pˆ1вf‰ИЧ€М[^_УД&t&UWVSƒь<‹\$P‹|$X‹Ћ„…эŽy‹3ƒ”‰D$ ƒ~,„ш“ ‰иш€ёџџ“$ ‰ишsёџџ‹‹ ‹T$ ‰ишВфџџƒˆ ‹‹( ‰Т‰D$$‰иш™фџџ“0 ‰иш<ёџџfƒЛК …fƒЛ‚ …\fƒЛЖ …@fƒЛ† …GfƒЛВ …@fƒЛŠ …@fƒЛЎ …GfƒЛŽ …@fƒЛЊ …9fƒЛ’ …2fƒЛІ …+fƒЛ– …$fƒЛЂ …хfƒЛš …оfƒЛž …fƒЛ~ К Н…№‹ƒЈDP ‰ƒЈ‹ƒЌСъƒР Сш9ТƒƒЛˆ„G9Тr ‹T$T…в… ‹‹МЗƒИƒљ Ž‹t$\VЗв‰жгц‹K №‹syf‰ƒИ‰{ˆ‹CЖ‹Й‹sx‰{ˆ ‹ГМЙ)ёгњNѓ‰а‹Г( ‰‹М‰t$(‹Г ‰t$,ƒљ Žu–џџџЗњ‰њгт‹K а‹Sf‰ƒИr‰sˆ‹CЖ‹Й‹Sp‰sˆ ‹“МЙ)бгџJѕ‰ј‰‹Мƒљ ŽуЗ|$(‰њгт‹K а‹Sf‰ƒИr‰sˆ‹CЖ‹Й‹Sp‰sˆ ‹“МЙ)бгџJѕ‰‹М‰јƒљ ŽЄU§Зњ‰њгт‹K а‹Sf‰ƒИr‰sˆ‹CЖ‹Й‹Sp‰suˆ ‹“МЙ‰t$)бгџJє‰ј‰‹МК1іыbt&‹K‹{f‰ƒИƒЦi‰kˆ‹CЖ‹Й‹{h‰kˆ ‹ЛМЙ)љгњOѓf‰“И‰а‰‹М9t$t3Ж– и cЗ”“~ ‰згч јƒљ ƒСf‰ƒИƒЦ‰‹М;t$uЭ‹|$ ‹L$,‰и‰њш6тџџ‹t$$‹L$(‰и‰ђш%тџџ‰ё‰њ‰ишЊшџџщХ‹КРџѓД&vіТt fƒ8…ЈƒРбъ9СuшfƒЛИИu7fƒЛМu-fƒЛШu#ƒ”ыt&ƒС9Ш„dfƒ9tяИ‰F,щћџџГ”G‰t$ Гˆ ‰t$$W9Т‡ ‹D$T…Р„‹D$\‰|$‰$‰D$ ‹D$T‰D$ш№їџџ‹D$ “ Ж1іƒРf‰pќ9Тuѓ‹D$$“ Д&f1ЩƒРf‰Hќ9аuѓƒ| “Ш Д&1эƒРf‰hќ9Тuѓ‹|$\ОЧƒЌf‰Г”ЧƒЈЧƒАЧƒ …џuƒФ<[^_]У‹ƒМƒјМ…Р~З‹И‹C‹Sp‰sˆ ЧƒМ1Щf‰‹ИƒФ<[^_]У‹‹МЗ“Иƒљ Ž“‹D$\ƒРЗР‰Цгц‹K ђ‹syf‰“И‰{ˆ‹SЖ‹Й‹sz‰{ˆ ‹“МЙ)бƒъ гјf‰ƒИЙ г c‰и‰“МК г cшyцџџщ”ўџџ‹CЗ‹И‹Sp‰sˆ Ж‹Йщ-џџџЗD$\ƒРЗРгр аQыЇЗT$(гтƒС‰‹М аƒљ \ќџџU§uЗв‰t$гтƒС ащ–ќџџЗt$,–џџџЗвгтƒС ащРћџџЗt$\VЗвгтƒС ащ7ћџџ1Рщ §џџНTmщrњџџНы№НыщНытНылН ыдНыЭНыЦН ыПН ыИН ыБН ыЊНыЃНыœНы•НыŽД&t&WVS‹D$‹T$‹L$‹˜ ‹А˜{‰И ˆ‹˜ ‹А˜{‰И ˆ4‹˜ ‹И˜s‰А ˆ …вu%fƒ„ˆ”‹ˆЄ9ˆ ”Р[^ЖР_УЖЖ‰ а cZџƒ€Аfƒ„ˆ˜ћџvСыЖ“ в cfƒ„ˆ ы­Д&fЖ’б cыуUWVSƒьl‹„$Œ‹8‹„$„‹…л„Чt$(ЧD$8‹„$ˆЧD$ й c‰4$‰D$(ЧD$,ЧD$HЧD$LЧD$PшR™џџ‰D$…Р…Е‹„$€ЧD$81э‰D$41Ры#t&‰l$‰4$‰|$,шшšџџ…Р…Ј1џ‹D$8…Рu‰\$81л‹D$,…Рtа‰l$‰4$шМšџџ…Рtк‰Т‹„$Œ‹Œ$Œ‹+D$,)ј‰‹D$<L$'9Œ$€te‹Œ$„‰‰4$‰T$ш8Сџџ‹T$ƒњtƒњtj‰T$ƒњћtO‹D$ƒФl[^_]Уt&D$'Л‰„$€щвўџџv‰Т1џщyџџџД&…Рt ƒњћu›‰4$ЛшвРџџ\$8u ЧD$ћџџџыЁfЧD$§џџџы•ЖƒьD$,‰D$ ‹D$(‰D$‹D$$‰D$‹D$ ‰$ш9ўџџƒФУИРй cУД&vИUУД&v‹D$PИЦй cƒњwИ+D$‹…@к cУД&Д&‹D$ ЏD$‰D$щюnД&Д&‹D$‰D$щЛnffffffffUWVSƒьP‹D$d‹|$d‹h‹‹@‹O‹u<‰\$ Dћ‰Ъ+T$h‰D$‹D$d‰t$,‹@ Т‰D$„џўџџ‰D$‹E4‰T$‹U,‰D$8‹E8‰T$4‹U@‰D$ ‹EP‰T$0‰D$$‹ET‰D$(‹MXИ‰Чгч‰љƒщ‰L$<‹M\гр‰бƒш‰D$@CіУt't&‰D$ ЖPџгтƒСж‰Т‰L$0ƒРƒт‰t$,…вuнD$‰ ‰h‰Ф‹t$‹|$‹T$(‹\$,‹l$ ќы'Д&Д&t&9|$†w9t$ †m€ћw 1Рf­ˆй€Угр Т‹D$8!а‹D…ˆс(угъ„РuСшЊыР‰ССщ‰L$@ˆСЈ„ €сt%8ЫsˆЭ1Рf­ˆй€Угр Тˆщ(Ы1Р@грH!агъD$@€ћw 1Рf­ˆй€Угр Т‹D$<‹L$$!а‹‰ХСэˆс(угъˆСЈ„Я€сtj8ЫsˆЭ1Рf­ˆй€Угр Тˆщ(Ы1Р@грH!агъХ‰t$‰ј+D$9ш‚Е‹L$@‰ў)юбљsfѓЅŠˆG‹t$‹l$ щєўџџfѓЅ‹t$‹l$ щфўџџt&ƒ§uД9|$tЎ‹L$@ŠGџˆФбљsˆGfѓЋ‹l$ щЙўџџыД&Д&Д&fЈ@…щ1Р@грH!аD$@‹D…щГўџџvЈ@…с1Р@грH!аш‹L$$‹щўўџџf‰С‹D$0їй‹t$9ш‚Пщƒ|$4u#)ШЦ‹D$@9Шvw)ШѓЄ‰ў)юыmД&Ж‹D$49Сv8t$0Ц)Ю)С‹D$@9ШvF)ШѓЄ‹t$‹L$49Шv6)ШѓЄ‰ў)юы,Д&t&Ц)Ю‹D$@9Шv)ШѓЄ‰ў)юы Д&v‰СѓЄ‹t$‹l$ щЏ§џџЈ t ЧD$Hы*ЧD$Hы ЧD$Hы‹t$ЧD$HыЧD$H‰t$‰|$‰\$,‰T$(‹l$‹$$‹D$Lƒј†ЋК€к cƒјtƒјКВк cИœк cDа‹D$d‰PЧEQ?‹L$0‹t$ ‹|$d‹\$‰Ш‹T$ƒсСш‰_ )ЦИџџџџгр‰7їа#D$,9жs/)ђƒТ‰W‹T$9гs/)к‰ћТ‰S‰E<‰M@ƒФP[^_]Уt&)ђƒТ‰W‹T$9гrб)к‰ћТыЯt&…wџџџЧE??щkџџџUWVSƒь$‹T$8‹L$<‹Bx‹šŒ9и‹B4‹Z||СыKСу У‰$‹‚‹Zt9У|‰У‰\$‹r8‰t$‹jl<.‰|$ ‰јїиƒр‰D$‹B,-)Х1э‹Bx‰D$Ц‰t$З‰\$З\џ‰\$ ‹z@‹$ы!бЗ O9щ†ръˆдЗDџ9иuн‹D$З;D$uЯ‰$‹t$‹|$ Ю‹D$КјўџџМД‹3u‹D3DuƒТuщыqƒТЉџџuƒТСш,ƒв‹|$ )ј=}L‹T$8‹\$9и‹t$‹z@‹\$ ‹$щNџџџ‹\$‰D$‰Jp9и}-‹t$Ц‰t$З\џ‹z@‰\$ ‹$щ!џџџ‹T$8ЧD$‰Jp‹T$8‹\$‹Bt9У‰иƒФ$[^_]УЁ c‹…Рt%ƒь fџаЁ cP‹@‰ c…РuщƒФ Уt&УД&Д&Sƒь‹Р‡ cƒћџt)…лtt&џР‡ cƒыuєЧ$@ cш0іўџƒФ[Уv1РЖ‰УƒР‹…Р‡ c…вu№ыНД&Д&Ё№ c…РtУЖЧ№ cы„ƒь‹D$$ƒјt…РtИƒФТ t&‰D$‹T$(‹D$ ‰T$‰$шИƒФТ Д&ЖVSƒьƒ= c‹D$$t Ч cƒјtƒјtJƒФИ[^Т t&Л( cО( c9оtрД&v‹…РtџаƒУ9оuёƒФИ[^Т t&‹D$(ЧD$‰D$‹D$ ‰$шdƒФИ[^Т Д&1РУSƒьЧ$\$$ш_ЧD$‰D$ ЧD$Ч$ьк cшœfЧ$ш№^‹T$ ‰\$‰$‰T$шдfшWfД&WVS‰Уƒь0‹54№ c…іŽ Ё8№ c1ЩƒР ‹9кw‹xW9г‚ƒƒСƒР9ёuт‰$шš‰Ч…Р„їЁ8№ cЖСуи‰xЧшЕ‹8№ cG ‰D T$ЧD$‰T$‰$џ4 cƒь …Р„‹‹D$(PРƒтПtPќƒтћuƒ4№ cƒФ0[^_УfƒјК@И‹L$ EТ‹T$8№ c‰K‰S‰\$ ‰D$‰L$‰$џ0 cƒь…РuАџ  cЧ$\л c‰D$шŠўџџД&v1іщџџџЁ8№ c‹D ‰D$‹GЧ$(л c‰D$шYўџџ‰\$Ч$л cшIўџџД&fU‰хWVSƒь\‹=0№ c…џt eє[^_]Уt&Ч0№ cшб€…СшСрш Ч4№ c)ФD$#ƒр№Ѓ8№ cИdу c-dу cƒј~Ј‹dу cƒј ЦЛdу c‹…Р…Ь‹C…Р…С‹Cƒј…OƒУ ћdу cƒdџџџ‰}Ры>t&‹Eд)№‡cтр‰Цu…Р‰S‹EашУ§џџ‰ЗcƒУ ћdу cƒл‹{‹S‡c‰Eа‹Аc‹€c‰EдЖТ‰EЬ€њtSƒј t–ƒј„­‹MЬЧ$Ил c‰L$ш§џџf…в…Ёhу cЛpу c‰С lу c„џџџЛdу cщ"џџџЖЗ‡c‰Сf‰EЪЩџџfƒ}ЪHС‹Mд)№тр4uў€џџŒўџџy‹EаƒУ шцќџџf‰Зcћdу c‚%џџџ‹}РщНvЖ‡c‰СˆEЪЩџџџ€}ЪHС‰MФ)№‹uдЦтрu ƒў€| ўџ‹Eашˆќџџ‰№ˆ‡cщОўџџv‹Eд‹MЬ‰t$Ч$фл c‰D$ ‹Eа‰L$‰D$шѓћџџvЛdу cћdу cƒВ§џџ‰}дt&‹s‹;ƒУОc†cшќџџ‰Оcћdу crй‹}д‹4№ c…вŽs§џџ‹0 cuфД&‹8№ cП‚‹…вt‰t$ ‰T$‹P‰T$‹@‰$џгƒьƒЧ;=4№ c|Щeє[^_]У‰D$Ч$„л cшAћџџUWVSƒьЧ$D№ cџ c‹<№ cƒь…лt4‹-, c‹=  cv‹‰$џеƒь‰Цџз…Рu …іt‹C‰4$џа‹[…лuлЧ$D№ cџ  cƒьƒФ[^_]УvЁ@№ c…РuУЖSƒьЧD$ Ч$ш`a‰У…РtB‹D$ Ч$D№ c‰‹D$$‰Cџ cЁ<№ c‰<№ cƒь‰CЧ$D№ cџ  c1РƒьƒФ[УƒШџыіД&t&SƒьЁ@№ c‹\$ …РuƒФ1Р[УД&Ч$D№ cџ cЁ<№ cƒь…Рt'1Щы v‰С…вt‰а‹9к‹Puя…Щt+‰Q‰$шИ`Ч$D№ cџ  c1РƒьƒФ[УД&f‰<№ cыаД&Sƒь‹D$$ƒјtCw)…РtMЁ@№ c…Р„АЧ@№ cƒФИ[Уt&ƒјuэЁ@№ c…Рtфш5ўџџынvш{ƒФИ[УЁ@№ c…РuWЁ@№ cƒјuЗ‹<№ c…лtv‰и‹[‰$шћ_…лuяЧ<№ cЧ@№ cЧ$D№ cџ cƒьщpџџџЖшЛ§џџыЂД&fЧ$D№ cџ cƒьщ;џџџ‹D$1вf8MZu @<8PEt‰аУt&1вfx ”Т‰аУfVS‹T$ ‹\$R<ЗBЗrD…іt1Щ‹P 9кwP9кw ƒСƒР(9ёuш1Р[^УvUWVS1лƒь‹|$0‰<$шc_ƒјwhf=cMZu]‹<cКcPE‚cuEfКc u:З’cЗh\…эt51іы ƒЦƒУ(9ѕt&ЧD$‰|$‰$ш_…РuоƒФ‰и[^_]Уt&ƒФ1л‰и[^_]Уt&1Рf=cMZu‹ <cЙcPE‘ct УД&vfЙc uъVЗcSЗБc‹\$ Dыc…іt1Щ‹P 9гrP9гr ƒСƒР(9ёuш1Р[^Уv1Рf=cMZu‹<cКcPEtУfКc uєЗ‚cУД&Ж1РS‹L$f=cMZu‹<cЛcPE“ct[Уt&fЛc uяЗƒcЗ›cD…лt1вt&і@' t…ЩtШƒщƒТƒР(9гuщ1Р[УД&Ж1Рf=cMZu‹<cКcPEtУfКc КcDТУД&Д&1Рf=cMZu‹<cКcPEŠct УД&vfКc uъVЗ’cS‹\$ ЗqTыc…іt 1Щt&‹B 9УrB9УrƒСƒТ(9Юuш1Р[^Уv‹B$[^їаСшУt&1ЩWf=cMZVS‹\$uЁ<cИcPEАct [‰Ш^_УД&fИc uш‹€€c…РtоЗVЗ~T…џtЮ1і‹J 9ШrJ9ШrƒЦƒТ(9ўuш1Щ[^‰Ш_УcыД&fƒыƒР‹H…Щu‹P …вtд…лш‹H [^_Сc‰ШУлуУQP=L$ rщƒ -=wы)Сƒ XYУffИТ ИТ VSƒь$‹D$4‹t$0‹T$8‹L$<…Рt7Xџ‰t$‰\$‰L$‰T$ Ч$шˆ9УOиЦƒФ$[^УД&f‰t$‰L$‰T$ ЧD$Ч$шPƒФ$[^УWVS‰Уƒь`лl$pйРл|$Pйх›пріФt$іФ„“л|$01РЗ|$8ЧD$HыЖл|$ З|$(іФuR1і1Р‰t$Hч€‹t$|‰>t$L‰T$T$H‰T$ T$P‰t$‰\$‰L$‰T$‰D$Ч$ cш*+ƒФ`[^_УvіФ@t+ОИУПџџыЁД&ниЧD$H1Р1џы”Д&‰јОf%џf->@˜щmџџџД&t&S‰г‰Сƒь‹RіЦ@u‹C 9C$~‹€ц u‹S ˆ ‹C ƒР‰C ƒФ[Уt&‰D$‰ $шœY‹C ƒР‰C ƒФ[УД&Д&UWV‰жS‰ЫƒьL‰D$|$0D$(‰D$ЧD$‰<$шuR‹C 9Ц‰ТNж…Р‹CIђ9№дЧCџџџџ…іŽ ‰t$Д&ƒD$‹D$L$(‰L$З@ў‰<$‰D$шR…Р~,‰ўыt&‹S ˆ‹C ƒР‰C 9юt7‹SƒЦіЦ@u‹C 9C$~уОFџ‹ €ц tЯ‰L$‰$шГX‹C ƒР‰C 9юuЩƒl$…{џџџ‹CPџ‰S…Р~Ж‰кИ шœўџџ‹CPџ‰S…РчƒФL[^_]У)№‰CіCu*ƒш‰CЖ‰кИ шdўџџ‹CPџ‰S…Рuчщўўџџ…іўўџџƒш‰CыšЧCўџџџыЊД&fW‰зV‰ЦS‰Ыƒь‹A 9Т‰ТNз…Р‹AIњ9јКЧAџџџџ…џ„œ‹C|>џыf‹C ˆ‹S ƒТ‰S 9їtE‹CƒЦіФ@u‹S 9S$~уО‹ іФ tа‰$‰L$ш”W‹S ыШД&‹C Ц ‹S ƒТ‰S ‹CPџ‰S…Р~3‹CіФ@u‹S 9S$~н‹іФ tЬ‰T$Ч$ шDW‹S ыСЧCўџџџƒФ[^_У)ј‰C‰Т‹AіФu1Bџ‰Av‰кИ ш,§џџ‹CPџ‰S…РuчщџџџД&v…џ…џџџƒъ‰SщuџџџД&ЖV‰жS‰Уƒь…РИ8м cDи‹B …Рx&‰$‰D$шКNƒФ‰ё‰Т‰и[^щŠўџџД&v‰$шрVƒФ‰ё‰Т‰и[^щhўџџД&U‰ЭW‰зVSƒьЧA џџџџ‹Y…Рt?ЦD$ -T$ t$ ƒу 1ЩЖƒрп иˆ ƒСƒљuьƒТ‰щ‰№)ђшўџџƒФ[^_]УvіЧtЦD$ +T$ t$ ыКt&іУ@tЦD$ T$ t$ ыЂt&t$ ‰ђы–U‰хW‰ЧVSƒь\‰EФ‹E‹]‰Eи‹E ‹Uи‰Eм‹E‹Mм‰UИ‰Eр‹E‰MМ‰Eфƒџo„R‹C 1Щ‹{…Р‰EРIШƒСїЧ…г‹C9Ш‰EДMШAСшСршЪљџџЙ)ФЧEдD$ƒр№‰EШ‹EИ‹UМ а„љЖEФ‹uШˆMа‰]ƒр ‰}А‰ѓ‹}МˆEЬ‹uИЖЖEаƒУ!№H0ƒР7 EЬ‰Ъ€љ:ЖMдCа1Р­ўгяіС ˆSџEїEј‰№ јuЩ‰о‹}А‹];uШ„‹EР…Р~‰ђ+UШ)а…Р–ƒ}Фo„Р‰№+EШ‹}Д9јŒРƒ}ФoЧCџџџџ„ЙџџџџіC…p‹UШ9ж†Х‰Mа‹{ыt&‹{ ˆ9‹C ƒР‰C 9жvB‹{ƒюїЧ@u‹C 9C$~рч О‹ tЪ‰L$‰$‰Uдш+T‹C ‹UдƒР‰C 9жwО‹Mаqџ…ЩыWД&‹S Ц ‹C ƒР‰C ƒюr;‹{їЧ@u‹C 9C$~тч ‹tЮ‰D$Ч$ шЦS‹C ƒР‰C ƒюsХeє[^_]Уfƒ{ЧEд„N‰ШКЋЊЊЊїт‹C‰EДбъЪ‰С9Т‰аLСƒРСшСршдїџџ)ФD$ƒр№ƒ}Фo‰EШ„YЙ‹EИ‹UМ а…ўџџ‹uШ‹MР‰ј‰ђ+UШ€фї‰C‰Ш)а…ЩŽF…РП‰4$OјЧD$0‰|$ўшLS;uШ…KўџџV‹}ДЦ0‰а+EШ‰ж9јCўџџv)Чƒ}Фo‰{‰љ‹{„ їЧ„(ƒщ…Щ~ ‹UР…вˆЖEФЦF0ƒЦˆFў…ЩŽўџџ‹{їЧ…yџЖИ ‰кшœјџџ‰јƒя…РыЙџџџџ;uШ†Mўџџ‹{‹UШ‰Mащ§§џџД&‹C 1Щ‹{…Р‰EРIШƒСїЧ…С‹C9Ш‰EДMШAСшСршxіџџ)ФЧEдD$ƒр№‰EШЙщЉќџџvч„4§џџЦ0ƒЦ;uШ…%§џџ‹UР1Ѕ℧џџщШўџџv‹EР…РˆИїЧ„ џџџ;uШw(qџщД§џџt&‹EР…РˆэїЧ„јўџџ9uШsи‰Mа‹UШщ§џџД&ffƒ{„ЧEдщЛ§џџД&f‹S‰Ш9б‰UДLТƒРСшСрш•ѕџџЙ)ФD$ƒр№‰EШщЦ§џџД&ЖEФЦF0ƒЦˆFўщ}ќџџ‰ј%=…6џџџ‰L$Aџ‰4$ЧD$0‰Mд‰MЬ‰EашQ‹MЬ‹Eаuд)Шƒ}Фo‰С„ўџџч„ўџџщѕ§џџv‰ј%=tЇїЧ…и§џџщєўџџД&f;uШ†ПќџџЙџџџџ‹{‹UШ‰Mащ ќџџ‹s‰Ш9ё‰uДLЦƒРщ,ўџџД&Д&U1Щ‰хWVSƒьL‹E‹u‰Eи‹E ‹^‰Eм‹E‹Uм‰Eр‹E‰Uд‰Eф‹Eи‰Eа‹F …Р‰EИIШƒСіЧt fƒ~…‹F9Ш‰EМMШAСшСрш4єџџ)ФD$ƒр№‰EРіУ€t‹Uд‹Eа…вˆ•€у‰^‹Eа‹Uд‰С‰а‰г Ш„[‹EР‰u‰п‰Ю‰EФЖ‰ёИЭЬЬЬљƒб1лїс‰]д‰аƒтќСшТ‰№)б‰њ)Ш‰MаЖMак‰EШИЭЬЬЬiкЭЬЬЬiUШЬЬЬЬгїeШк‰УƒуЌа‰EШ›‹EФбъ\ 0‰UЬˆPИ 9№ИјsN‹}Р9зt/‹Eі@t&fƒxt‰а)ј%€ƒјu‹EФЦ@,PД&‹uШ‹}Ь‰UФщBџџџД&v‹EИ‹u‰з…РŽр+UР)а…Р~ …РЛ‰<$OиЧD$0‰\$пшЧN9}Р„о‹MМ…ЩŽ”‰ј+EР)EМ‹EМ‹^‰F…Р~.їУРt ‹EМƒш‰F‹UИ…вˆВіЧ„)Д&fіУ€„ЧЦ-W‹EР9ТvS‰з‰к‰Уыf‹V ˆ‹F ƒР‰F 9ћt6‹VƒяіЦ@u‹F 9F$~уО‹€ц tа‰L$‰$шдM‹F ƒР‰F 9ћuЪ‹Fыf‹V Ц ‹V ‹FƒТ‰V ‰Тƒш‰F…в~1‹NіХ@u‹V 9V$~о‹€х tЪ‰D$Ч$ шzM‹V ‹FыПfeє[^_]УД&іЧt#Ц+Wщ/џџџ‰ШКЋЊЊЊїтбъбщQ§џџЖ‰њіУ@„ џџџЦ ƒТщџџџfїиƒв‰Сїк‰гщu§џџ‹FPџ‰V…РŽЯўџџД&‰ђИ ш ѓџџ‹FPџ‰V…Рч‹^щЇўџџД&9UР…Iўџџ‹]И…лu ‹EМ‹^…РŽ‚ўџџїУР…Pўџџщ_ўџџЦ0ƒЧщўџџt&‰и%=…<ўџџ‹VBџ‰F…вŽ=ўџџ‰T$‰<$ЧD$0‰Uаш–L‹UаЧFџџџџзщўџџt&‹]И‹}Р‰и…л‰§џџщdџџџД&t&U‰хWVS‰Уƒь<ƒx§„ЫЗPf…в„І‹C‰eдƒРСшСршJ№џџ)ФEрЧEрt$ЧEф‰D$‰T$‰4$шуD…РŽЫ<ыЖ‹C ˆ‹S ƒТ‰S 9ўt7‹CƒЦіФ@u‹S 9S$~уОVџ‹ іФ tЯ‰$‰L$шsK‹S ƒТ‰S 9ўuЩ‹eдeє[^_]Уv‰кИ.шlёџџeє[^_]Уt&ЧEрuрЧEфшBK‰t$ ЧD$‹‰D$Eо‰$ш­H…Р~1ЗUоf‰S‰CщђўџџД&f‰кИ.шёџџ‹eдщyџџџt&ЗSыбfU‰ХW‰зV‰ЮSƒь ‹\$ ‹C…ЩŽД9Ш<ЧCџџџџіCtxfƒ{tqЙџџџџFКЋЊЊЊїт‰ШбъJџ)Сƒњ…їД&…Р~E…э…ф‹SїТР„еƒш‰Ct1іЦu,ƒш‰Cf‰кИ шT№џџ‹CPџ‰S…Рч…э…@‹SіЦ…Sƒт@…Т‹C…Р~‹Sтњ„Fk…іŽ“vЖИ0„вtƒЧОТ‰кшчяџџƒю„žіCtиfƒ{tбiЦЋЊЊЊ=UUUUwФ‰йК‰шш№џџыДt&ƒш‰ЪТ‰C„џџџ…РьщPџџџД&)Ш‰CˆЙўџџ‹S 9аŽЎўџџ)а‰C…вŽ]ƒш‰C…іŽЯўџџіC„Хўџџfƒ{„Кўџџ‰Сщўџџv‹C …РQіCuKƒш‰C ƒФ [^_]Уt&…РŽ˜ƒш‹S 9а”ЧCџџџџ…э„Рўџџ‰кИ-шѓюџџщФўџџЖ‰ишЁќџџы Д&ЖИ0„вtƒЧОТ‰кшПюџџ‹C Pџ‰S …РкƒФ [^_]УД&vƒш‰Ct™їC„#ўџџ‰кИ-шюџџщPўџџД&vИ0‰кшdюџџ‹C …РіCu…іuщџџџЖ‰ишќџџ…і„zџџџ‹C №‰C ‰кИ0ш$юџџƒЦuящ[џџџД&v‹SіЦ…—ўџџ…іŽp§џџ€ц„g§џџfƒ{„\§џџ‰Сщ.§џџ‰кИ+шдэџџщЅ§џџД&ƒш‰Cf‰кИ0шДэџџ‹CPџ‰S…Рчщ”§џџfіЦ…[§џџ‹CHџ‰K…РŽJ§џџщ!§џџ„eўџџЧCџџџџщgўџџЖ‰кИ ш\эџџщ-§џџД&UW‰зVSYџЙgfffƒьL‰D$,‰и‹t$`Сј‰\$0‰D$4‰иСћїщ‰бСљ)йЛtНgfff‰ШƒУїэ‰ШСјСњ‰б)Сuы‹F(ƒјџu ЧF(И9У‹NLи‰ШS)а9бКџџџџЙNТ‰њƒУ‰F‹D$,‰4$шХћџџ‹F(‰F ‹F‰Тƒр ЪРƒШE‰V‰ђш”ьџџ‹D$0^‰t$‰$‹D$4‰D$‹D$8‰D$‹D$<‰D$ ш іџџƒФL[^_]УVS‰Уƒь$‹P …вxRƒТлl$0D$L$‰D$ Ил<$шBыџџ‹L$‰Цљ€џџt4‰$‰Т‹D$шЦўџџ‰4$шžƒФ$[^УД&Ч@ КыЃf‰Т‹D$‰йшSяџџ‰4$шkƒФ$[^Уt&VS‰Уƒь$‹P …вy Ч@ Клl$0D$L$‰D$ Ил<$шЉъџџ‹L$‰Цљ€џџtk‰$‰Т‹D$шњџџ‹CыД&‹S Ц ‹S ‹CƒТ‰S ‰Тƒш‰C…в~>‹KіХ@u‹S 9S$~о‹€х tЪ‰D$Ч$ ш E‹S ‹CыПf‰Т‹D$‰йшƒюџџ‰4$ш›ƒФ$[^Уt&WVS‰Уƒь ‹P …вˆѕ„злl$0D$L$‰D$ Ил<$шкщџџ‹|$‰Цџ€џџ„и‹C%ƒџ§|[‹S 9зT…Р„м)њ‰S ‰$‹D$‰љ‰ђш—љџџыt&‰кИ шtъџџ‹CPџ‰S…Рч‰4$шяƒФ [^_УД&…Рu4‰4$ш|Dƒш‰C ‹D$‰љ‰ђ‰$шоќџџ‰4$шЖƒФ [^_УД&‹C ƒшыЯЧ@ КщџџџД&Ч@ КщџџџД&‰Т‹D$‰йшCэџџ‰4$ш[ƒФ [^_Уt&‰4$ш№C)ј‰C ‰џџџ‹S…вŽ џџџа‰CщџџџД&U‰еW‰Ч‰ШV‰ўSƒь| ж‹œ$•Сf…Рu 1іf‰t$4„Щtƒшf‰D$4‹s …і‰t$(ŸD$,ƒў‡ЎЙИ1в)ё1іСсЅТгріС EаEЦЌя‰ўбэ‰яЦз…џˆЄїЙі+L$(Сс‰§‰ї1Р­ягэіС E§Eш‰ј ш…Œ€|$,…‹C‰D$8D$X‰D$(‹|$8‹D$(‰|$0ч…Ц0p‹C‰D$<…РŽ(‹S ‰№+D$(Пl$4…в ‹T$8OС‰l$,тРƒњ‰ЧКgfff‰шƒпњїъ‰шСјСњ‰б)С„’‰œ$Нgfff‰t$4‰ўД&‰ШƒЧїэ‰Ш_Сј)ѓСњ‰б)СuцПы‹t$4‹œ$‹D$<9јŽќ)јїD$8…Pџ‰S…РŽ„Ж‰кИ шдчџџ‹CPџ‰S…Рч‹C‰D$0іD$0€„^t&‰кИ-шЄчџџщaД&„Щu €|$,„ЕўџџИы6fЌўЙСя1Р+L$(‰§‰їfƒD$4Сс­ягэƒс E§Eш‹D$(ƒР‹Kt$X‰t$(‰Ъ‰L$8‰L$0тƒс ˆL$,‰T$<ы't&;t$(w‹K …Щx ƒТ0‰ёˆƒЦЌяСэƒшt=‰њƒтƒјt[‹K …Щ~ƒщ‰K …вtТƒњ vЪƒТ7‰ё T$,ыФf…вuъ…ЩtЕД&;t$(…ўџџ‹C …РŽц§џџЦD$X.D$Yщ№§џџt&;t$(w‹L$<…Щu ‹K …Щ~ГvЦ.ƒЦы’Д&ПD$4Н‰D$,іD$0€…ЇўџџїD$0…QіD$0@…n‰кИ0ш2цџџ‹C‰кƒр ƒШXш"цџџ‹C…Р~,іCt&ƒш‰CД&‰кИ0шќхџџ‹CPџ‰S…Рч‹|$(;t$(wыGvЗCf‰D$Hf…Р…Ў9ўt.ОFџƒюƒј.„Šƒј,tе‰кшЎхџџыоt&‰кИ0шœхџџ‹C Pџ‰S …Рч‹C‰кƒр ƒШPшхџџ‹D$,kKР™‰D$H‰T$L‰б‰$‹D$LСљ‰\$‰L$P‰L$T‰D$‰L$‰L$ шпюџџƒФ|[^_]УД&‰ишщђџџщVџџџt&‰йКD$Hшpхџџщ=џџџvЧCџџџџщšўџџt&‰кИ+шьфџџщЉўџџД&‰CщvўџџД&‰кИ шФфџџщўџџНщЅќџџt&UWVSьм‹œ$ќ‹М$ш#>‹Ч„$ЌџџџџЧ„$Аџџџџ‰D$8‹„$єЧ„$Д§џџџ‰„$Є‹„$№Ч„$МЧ„$Ф%`‰D$,‰„$Ј1Рf‰„$И1Рf‰„$Р‹„$јЧ„$Ьџџџџ‰„$ШО…Р„k‰Сы[f‹œ$ЈіЧ@u‹”$Ф9”$Ш~!‹”$Є€ч …”‹„$Фˆ ‹”$ФƒТ‰”$ФЖMƒХОС…Р„Ÿƒј%uЂЧ„$Аџџџџ‹D$,Ч„$Ќџџџџ‰„$ЈЖE„Рtqœ$Ќ‰l$4‰ю1Щ‰\$0ЧD$(Pр^Ош€њZw`Жвџ$•Xм cЖ‰T$‰$ш=‹”$ФщeџџџЧD$(ЖFЙ‰оt&„РuЎt&‹„$ФФм[^_]УЖƒш0< ‡Ѕƒљ‡œ…Щ…„Й‹D$0…Р„‹T$0‹…Рˆ=‹T$0€DEа‰ЖF‰оыЄ$Јџўџџƒ|$(„bƒ|$(w„z ‹?1вƒ|$(‰ј„Гƒ|$(„о ‰”$”‰М$‰ї„$Єƒ§u‰D$‹„$‰$‹„$”‰D$‹„$˜‰D$‹„$œ‰D$ „ž‰ш‰ншјхџџщJўџџŒ$Ј€ƒ|$(„‹ƒЧ‰Ш™ƒ|$(tƒ|$(„7ƒ|$(uОЩ‰Ш™‰„$‰”$”‰аСј™‰С‰„$˜„$Є‰D$‹„$‰”$œ‰$‹„$”‰L$‰D$‹„$œ‰D$ шўъџџ‰нщЎ§џџ‹D$(wƒшƒј†К‹”$Є‰ї‰ншBфџџщ„§џџ‹T$(‹wЧ„$Аџџџџƒъƒњ†Nˆ„$К‰ї‰нŒ$Є„$шКтџџщ<§џџ‹”$ЈƒЪ ‰”$ЈіТ„щл/w йх›прf%Ef=„{йРл|$pЗL$xf…Щy €Ъ€‰”$Јйх›прf%Ef=„Лл|$`‹D$`‹T$dfсџ…q‰з ЧПРџџEЯМ$Є‰<$шФіџџщќ…Щ…ЏŒ$ЈЖF‰ощ1§џџƒљ†ЪЖFЙ‰ощ§џџЖF<6„g<3„ЧD$(‰оЙщ№ќџџЖFƒŒ$Ј‰оЙщиќџџЖFћџџЖƒшЧD$t‰D$щЎќџџ‹T$X…вˆП ‹D$4‹|$d9xМЧD$0НџџџџЧD$xџџџџД&v‹|$4)оF‹W‹|$X‰„$œ)ї9з}‹|$‰ўƒюƒц§…2 ƒ|$Ž ‹t$hEџ9ЦŒІ )Ц‰ї…эˆZ ‹D$\l$P‰Ќ$œ‰D$Xш‰D$\Ч$‰L$8шТЧD$`‹L$8‰Ц‹T$X…в~"‹D$P…Р~9ТNТ)D$\)D$P)Т‰„$œ‰T$X‹D$h…РtV‹T$`…в„Ѓ…џ~:‰4$‰|$‰L$8шВ‹L$8‰$‰Ц‰L$‰L$pшќ‹L$p‰D$8‰ $шь‹L$8‹D$h)ј…]Ч$‰L$hшƒћ‹|$D‹L$h”Тƒ|$‰D$8žУ!г…џИ1џ„л… ‹D$DЛ…Р…Л+\$P‹T$\ƒыƒук‰œ$œ‰и…в~‰ $‰T$шф‰С‹„$œD$P…Р~‰D$‹D$8‰L$(‰$шП‹L$(‰D$8‹D$lƒ|$ŸТ…Р…ѓ…эc„в„[…э…і‹D$8ЧD$ЧD$‰$‰L$ш[‹L$‰D$‰ $‰D$8ш—‹L$…РŽЖ‹D$d‹\$TƒР‰D$4ƒD$TЦ1ЧD$, ‹D$8‰L$‰$шœ…і‹L$t‰4$‰L$шˆ‹L$‰ $ш|‹t$‹D$T‹|$4Ц‰>‹t$ …іt‰‹D$@‹t$, 0ФЌ‰и[^_]УйРиСио cн\$H‹D$H‹T$L‰D$H‰а-@‰D$Lи%о cнD$HйЩлё‡Ѕ йЩйрпёни‡фы ниниыниыниЧD$Ht&‹|$X…џˆœ‹|$4‹D$d9GŒ‹‹T$0нХ@о c…в‰u…эm…‰и о cнD$8йЩпёниsyƒРЧD$8‹\$T1і‰D$4щТўџџЖƒ|$…mћџџЧD$`‹T$0И…вOТ‰„$œ‰Х‰D$x‰D$0щљџџ‹D$`…Р…Dќџџ‹D$\‹|$h1і‰D$XщНќџџниЧD$81і‹D$0‹\$TЧD$,їи‰D$4щNўџџД&v‰|$‰$ш„„л‹L$h‰D$8…r1џ‹\$8‹CН\ƒƒѓщ1§џџЖ‹D$dƒР‰D$4‹D$`…Р„ё\$X…л~‰4$‰\$‰L$(ш ‹L$(‰Ц‰t$X…џ…Є‹D$T‹|$X‰l$P‰ѕ‰Ю‰D$0ИщЦД&f‰$шHИ…лˆќ \$u ‹\$$і„щ‹L$0Y‰к…Р~ ƒ|$H…УЖD$(ˆCџ‹D$P9„$œ„о‰4$ЧD$ЧD$ шOЧD$ЧD$ ‰Ц‰,$9§„Rш-‰<$ЧD$‰ХЧD$ ш‰Ч‹„$œ‰\$0ƒР‰„$œ‹D$8‰4$‰D$шЬ№џџ‰l$‰4$H0‰L$(‰D$Dш%‰|$‰У‹D$8‰$шc‹H …Щ…јўџџ‰D$‰4$‰D$\шј‹T$\‰D$X‰$ш(‹D$X D$…О ‹L$$‹ ‰Ъ‰L$Xƒт T$H…Оўџџƒ|$(9‰|$X‰ё‰ю‹|$D„c…лŽ_ G1ЧD$, ‰D$(‹\$0ЖD$(‰ѕ‹t$Xˆ{Д&‹D$8‰L$‰$шЈ …і‹L$„Ž…э„>9ѕ„6‰,$ш„ ‹\$T‹L$‰|$Tщпћџџvшл ‰Х‰ЧщСўџџ‹D$4‹@ƒР9D$(Žz§џџƒD$\ПƒD$PщœњџџД&v‹D$8‰ $ˆT$4‰D$‰L$(ши‹L$(ЖT$4…Р‰фњџџ‰ $‹D$dЧD$ЧD$ hџˆT$(шT ЖT$(‰С‹D$x…РžР!Т‹D$`…Р…„в…[‹D$d‹l$x‰D$4f‰t$‹|$TИ‰Ю‹\$8ы'v‰4$ЧD$ЧD$ ш№ ‰Ц‹„$œƒР‰\$ƒЧ‰4$‰„$œшЎюџџƒР0ˆGџ9Ќ$œ|З‰D$(‰ё‹t$1э‹\$H…лtJ‹QЖGџƒћtyƒњ‹Q…вt‹\$Tыt&9к„$ЖBџ‰зWџ<9tыƒРЧD$, ˆщ9ўџџ‰ $ЧD$шa‰С‹D$8‰ $‰D$‰L$ш‹‹L$…РЖGџœuіD$(u“ƒyŽ0ЧD$,‰јf‰Чƒш€80tіщй§џџЧD$`щ)єџџ‹D$h‰ $‰D$ш‰Сщјџџt&Ч„$œИщєџџ‹D$dНџџџџнХ@о cйМ$ŽнD$8‹t$TЧ„$œЗ„$ŽVйРиђ€Ь f‰„$ŒйЌ$Œл\$йЌ$ŽлD$ЖD$ƒР0иЪˆ‹D$dƒР‰D$4ощйюйЩлщнйzЖuнини‹\$T‰T$Tщ9љџџt&‹„$œ9ш„жи о cƒРƒТ‰„$œйРиђйЌ$Œл\$йЌ$ŽлD$ЖD$ƒР0иЪˆBџощйюйЩлщнй{“ыЉ)о‰їF‹t$4‰„$œ‹V‹t$X)ў9ђкЧD$0НџџџџЧD$xџџџџ‹t$\D$P‹|$h№‰t$X‰D$\щŒіџџ‹\$T‰|$Tщ}јџџ‰Т1џ+T$h‰D$hT$DщIіџџ‹D$TƒD$4ЧD$, Ц1щќџџ‹D$H…Р„Униниƒј„„‹\$TЧD$,‰T$Tщ!јџџйМ$Ž‰Ќ$€‹|$TоЩ‰Œ$„‹l$p1ЩЗ„$Ž‰Д$ˆКЖt$t€Ь f‰„$ŒйСыt&и о cƒТ‰ёйЌ$ŒлT$HйЌ$Ž‰”$œ‹D$H…РtлD$H‰ёощƒЧƒР0ˆGџ‹”$œ9ъuИ‰Ъ‹Ќ$€‹Œ$„„в‹Д$ˆкЪнкйо cйСиСйЫлѓнл‡Шоспё†иїџџйю1вЛ‰ўпщниšТEг‹\$TСт‰T$,ыЖBџ‰жVџ<0tѓ‹D$|‰t$TƒР‰D$4щ їџџ‹D$X)аƒРƒџŸТ…э‰D$8‰ж‰„$œŸТ‰№„аt 9l$8Јєџџ‹D$\‹t$8‹|$ht$P‰D$X№‰D$\щНєџџ‹T$H‰|$X‰ё‰ю‹|$D…в„0ƒyŽўƒ|$H„q‰ѓ‹|$X‹l$0‰Юыjt&ЖD$(‰L$$ˆAџ‰<$ЧD$ЧD$ шL‰4$9ћЧD$DиЧD$ ‰D$ш+‰Ц‹D$8‰4$‰D$шљщџџ‹l$$‹|$ƒР0‰D$(‹D$8‰|$‰$шJM…Рƒ‰Ш‰ё‰о‰|$X‰У‹D$(‰l$0ƒј9„цƒРЧD$, ‰ѕ‰ў‰D$(ЖD$(‰п‹\$0ˆщ‰љџџЧ„$œ‹D$\)ш‰D$XщЅѓџџ…э„еѕџџ‹|$x…џŽіџџи о c‰|$pЧD$|џџџџйРи о cио cн\$H‹D$H‹T$L‰D$H‰а-@‰D$Lщh№џџ‹F‰L$(‰$шд‰Уx ‹F‰<$…F ‰T$‰D$шRЧD$‰$ш ‹L$(‰D$Xщїџџ‹D$4‹@ƒР;D$(гѓџџщљџџниниЧD$4‹\$T1іЧD$8щ‘єџџƒ|$(9‰|$X‰ё‰п‰ю„И‹\$0‹t$XЧD$, ЖD$(ƒРˆщaјџџ‰ј‰ё‰з‰ЦщЩљџџЦ0ЖFџƒD$|‰t$Tщ˜№џџ…Р~H‰ $ЧD$шc ‰С‹D$8‰ $‰D$‰L$ш ‹L$…РŽџƒ|$(9t3G1ЧD$H ‰D$(ƒyŽЇ‹D$0‰ѕЧD$,‹t$XXщ4ўџџ‹D$0X‹D$0‰п‰ѕ‹\$T‹t$XЦ9И9щYљџџ‰l$d‹l$xщCѓџџ‹\$T‰|$TщЕѓџџнийю1РЛпщниšРEУ‹\$T‰T$TСр‰D$,‹D$|ƒР‰D$4щ‘ѓџџнинини‹\$T‰ўщšяџџиРЖBџлё‡пщни‹\$T‹|$d‰жŠ:…4іD$‰|$|…cяџџЧD$,щќџџ‰4$ЧD$ЧD$ ˆT$4‰L$(шЖT$4‹L$(‰Ц„в…*џџџ‹D$d‹l$x‰D$4щлєџџ‹YИ…лDD$,‰D$,щРјџџ‹D$XЧD$0НџџџџЧD$xџџџџ)аƒР‰D$8‰„$œщићџџ‹|$dЖBџ‰ж‹\$T‰|$|щЕюџџ‹i…э…їћџџ…Рўџџ‹D$0‰ѕ‹t$XXщЇќџџ‹Y‰ѕ‹t$X…лtV‹D$0ЧD$,Xщ†ќџџнини‹|$d‹\$T‰ж‰|$|щXюџџu іD$(…є§џџЧD$H щ§§џџ‰|$|ЧD$,щэњџџ‹D$H‰D$,‹D$0Xщ0ќџџƒyЧD$,žѕџџ1Рƒy•РСр‰D$,щ‰ѕџџ‹D$XщєџџUWVSƒь‹|$,‹t$(‰ј‹^Сј‰D$‰\$9У~}n\t…ƒч„‰И ‰љV)ј‰D$ ‹гш9г†­‰$‰ю‰l$‹l$ ‹‰щƒЦƒТгу‰љ и‰Fќ‹Bќгш9$wу‹l$‹T$+T$T•ќ‰…РtNƒТыIД&‹D$(Ч@‹D$(Ч@ƒФ[^_]Уf‰я9ѓvкД&vЅ9ѓwћ‹D$+D$T…‰а‹|$()шСј‰G9ъtИƒФ[^_]Уt&‹|$(‰G…Рt•‰ъы„S‹T$B‹R1в9иrы$Д&vƒРƒТ 9Уv‹…Щt№9УvѓМЩЪ‰а[УV‰ЦSƒьЁШљ cƒјtz…Рt3ƒјu!‹( cЧ$џгЁШљ cƒьƒјtъƒјtPƒФ[^УД&И‡Шљ c…РuY‹ cЧ$рљ cџгƒьЧ$јљ cџгƒьЧ$q cшЃўџЧШљ cvХрљ c‰$џ cƒьƒФ[^УД&fƒјtЬЁШљ cƒј„WџџџщnџџџД&И‡Шљ cƒјtУД&Sƒь‹ cЧ$рљ cџгƒьЧ$јљ cџгƒьƒФ[УW1РVSƒь ‹\$0шпўџџƒћ ~JО‰йгцЕƒрј‰$ш_…Рtƒ=Шљ c‰X‰pt9Ч@Ч@ ƒФ [^_УД&‹ љ c…Рt5‹ƒ=Шљ c‰ љ cuЧ‰D$Ч$рљ cџ  cƒь‹D$ы­Д&f‰йЁ, cОгц Е‰Тъ № c‰ЯСњСяњњ ‡CџџџƒсјС‰ , cщRџџџД&ЖSƒь‹\$ …лt7ƒ{ ~ƒФ[щmt&1Ршй§џџ‹Cƒ=Шљ c‹… љ c‰… љ c‰t ƒФ[УД&Ч$рљ cџ  cƒьысД&Д&U1ЩWVSƒь,‹\$@‹t$H‹C‰їСџ‰D$‹D$D‰D$Сј‰D$t&‹l$‹D$Џl‹їd‹ъ№њ‰D‹1џƒС‰ж9L$и‰ј‰н аt‹D$9C~‹D$‰н‰tƒƒР‰CƒФ,‰ш[^_]Уt&‹CƒР‰$ш ўџџ‰Х…РtнH ‹C‰ $…C ‰T$‰D$ш„‰$‰ы‰ншШўџџ‹D$‰tƒƒР‰CыЁД&1Рƒь,шІќџџЁЄљ c…Рt-‹ƒ=Шљ c‰Єљ ct^‹T$0Ч@ Ч@‰PƒФ,УvЁ, c‰Тъ № cСњƒТњ vEЧ$ шщ…РtЮƒ=Шљ cЧ@Ч@uЂ‰D$Ч$рљ cџ  cƒь‹D$ыˆt&P ‰, cыРt&UWVSƒьL‹|$`‹\$d‹w‹k9ю| ‰ш‰ѕ‰Ц‰и‰ћ‰ЧD59C‰D$,œРЖРC‰$шЯќџџ‰D$0‰С…Р„E‹D$,ƒС‰L$49Сs)+D$0ЧD$ƒшСш…‰D$‹D$4‰$ш6C‰D$8Ј‰D$ G<А‰D$‰|$(9јƒЕ‹|$ К‰ј)иƒУƒшСш9п…Cа‹D$4‰T$<‰D$$ыfƒD$$‹|$9|$(vtƒD$‹D$‹hќ…эtс‹\$8‹L$$‰l$1і1џ‰\$‰ЭvƒD$‹\$‹D$‹Mїcќ1лШ깋\$њƒХ1џ‰ж‰Eќ9\$ wЯ‹D$$‹L$<ƒD$$‹|$‰9|$(wŒ‹t$,…і~‹T$4‹D$,ыvƒшt‹L‚ќ…Щtѓ‰D$,‹D$0‹|$,‰x‹D$0ƒФL[^_]УUWVSƒь,‹\$D‹|$@‰иƒр…Сћ‰§tb‹5€№ c…і„2Ё  c‰§‰D$іУuбћt?‹>…џtF‰ўіУtя‰t$‰,$шўџџ‰Ч…Р„ю…э„‘ƒ} ~K‰,$‰§шiбћuСƒФ,‰ш[^_]УvИшЦљџџ‹>…џtpƒ=Шљ cuЁЧ$јљ c‹D$‰ўџаƒьыv1Рш™љџџ‹Eƒ=Шљ c‹… љ c‰,… љ c‰U‰§…VџџџЧ$рљ cџ  cƒьщAџџџ‰Хщ9џџџД&f‰t$‰4$шD§џџ‰‰Ч…Рt1Чщqџџџ‹…о c‰<$ЧD$‰D$ш…ћџџ‰Ч…Р…ХўџџƒФ,1э[‰ш^_]УИшѕјџџ‹5€№ c…іt"ƒ=Шљ c…­ўџџЧ$јљ cџ  cƒьщ˜ўџџЧ$шЭљџџ‰Ц…РtЧ@qЧ@Ѓ€№ cЧыБЧ€№ c1эщЎўџџД&t&UWVSƒь<‹D$P‹l$T‰Ч‹P‰ю‹@Сў№‰D$ X‹G9У~ t&РƒТ9Уї‰$шOљџџ‰D$…Р„Ыx…і~Сц‰<$‰t$їЧD$шг ‹D$P‰щp‹@†ƒс„ЃИ ‰\$,‰§)Ш‰L$‰D$$1Р‰|$(‹|$$t&‹ЖL$ƒХƒЦгу‰љ и‰Eќ‹Fќгш9ђwс‰б‹t$P+L$Pƒщ‹|$(‹\$,СщƒЦ9ђ КBЪ…РD\$ ‰‰\$ ‹D$‹|$ ‰x‹D$P‰$шhљџџ‹D$ƒФ<[^_]Уt&Ѕ9ђvдЅ9ђwіыЭД&t&VS‹L$ ‹t$‹Y‹F)Уu1…ƒСTы Д&f9Сsƒшƒъ‹290t№лƒЫ‰и[^УЖUWVSƒьL‹\$`‹D$d‹s‹@)Ц…Ћ‹|$d…KTы t&9СƒАƒшƒъ‹:98tь‚‹C‰$шЃїџџ‰D$(‰Ч…Р„N‰p ‹CƒУ‰\$44…‰D$0‰и№‰\$‰D$,‹D$d‰t$<1іh‹@D…‰D$$G1џ‰D$8‰D$ t&ƒD$‹D$ƒХ1в‹Mќ‹@ќ)№њ1л)Шк‰СƒD$ ‹D$ ƒт1џ‰ж‰Hќ‰Ъ9l$$wХ‹l$$‹D$dH‰ш+D$dƒш‰УƒрќСы9ЭНBХ‹l$8ш9L$$ЙBй‹L$4йн‰L$ 9L$,vH‰l$$‰ы‹l$,f‹ƒС1в)№њ‰D$ƒУ1џ‰T$ƒт‰ж‹T$‰Sќ9Эwи‹D$,‹l$$ƒш+D$ ƒрќш…вu‹T$0+D$<Д&ƒъ‹ …Щtі‰T$0‹D$(‹|$0‰x‹D$(ƒФL[^_]УvО‰ўџџ‰иО‹\$d‰D$dщkўџџД&fЧ$шіџџ‰D$(…РtЕ‹D$(Ч@Ч@‹D$(ƒФL[^_]УД&Д&UWП VSƒь ‹D$ ‹L$$p‹@†‹SќkќНТƒ№)Ч‰9ƒј ŽŠƒш 9юs[‹{ј…РtZЙ )С‰Э‰Сгт‰щ‰$‰њгъ‰б‹$Ч$ Ъ‰СCјЪ№?гч‰T$9Цs2‹Cє‰щгш Ч‰<$н$ƒФ [^_]Уt&1џ…РubЪ№?Ч$‰T$‰<$н$ƒФ [^_]УvЙ ‰зЧ$)СгяЯ№?‰|$1џ9юs‹{јгяH‰агр Ч‰<$н$ƒФ [^_]Уf‰С1џЧ$гт‰<$Ъ№?‰T$н$ƒФ [^_]УД&t&UWVSƒь,нD$@Ч$н\$ш…єџџ…Рt~‹T$‹|$‰гСъуџџ‰йЩтџEй…џta1іѓМї‰ёгя…іtЙ ‰н)ёгх‰ё ягыƒћ‰XЛƒлџ‰x‰X…вuDю2НT˜‹|$HСу‰7‹t$Lƒђ)г‰ƒФ,[^_]Уv1ЩѓМЫгыq ‰XЛ‰X…вtМ‹|$H”2Эћџџ‰К5)ђ‹t$L‰ƒФ,[^_]УД&t&‹L$‹D$QЖ ˆ„Щtt&Ж ƒРƒТˆ„ЩuёУS‹\$1в‹L$ ‰и…Щuыt&ƒР‰Т)к9Ъs€8u№‰а[У‹T$‹L$1Р…вu ыƒР9Тt fƒ‰ѓf‰T$>‰ў‹|$dы t&Ц‹‹T$(№‰\$‰\$‰T$‹T$l‰D$‰T$ ‰,$шцќџџ…РвƒФL‰ї[‰ј^_]УЖƒФL1џ[‰ј^_]Уt&V1РSƒь4‹\$Hf‰D$.ш ‰Цшє…лК њ c‰t$‰D$‹D$DDк‰D$‹D$@‰\$ ‰D$D$.‰$шrќџџƒФ4[^Уџ%D cџ%H cџ%L cџ%P cџ%X cџ%\ cџ%` cџ%d cџ%h cџ%p cџ%t cџ%| cџ%€ cџ%„ cџ%ˆ cџ%Œ cџ% cџ%” cџ%˜ cџ%œ cџ%  cџ%Є cџ%А cџ%Д cџ%И cџ%М cџ%Р cџ%Ф cЁ,њ c‹УД&ƒьЧD$Ч$шбЧD$.‰$шЩ1в…Рt ƒР‰$шЈ‰Т‰аƒФУVSƒьЧ$€п cџ cƒь…Рt/‰$‹5 c‰УЧD$–п cџжƒь…Рt+Ѓ@ cƒФ[^џрД&ИP† cЃ@ cƒФ[^џрД&ЧD$Њп c‰$џжЃ,њ cƒь…РtЯИ@† cыЕџ%@ cЁ@ c‹Уџ%x cџ%Ј cџ%Ќ c‹D$ ‹t$‰•` fЧ‹|$Ц„XЗ@Ч…PЧ…d )Ц‹D$fЧ‹$Ц…Xƒш‰ЕЌ‰…ЈщxџџffffщKŒўџџџџџА‡ cџџџџа‡ cџџџџџџџџ@УПџџР? № c0~ cP c€€ cP€ c† c ‡ c1.3.1@ €€ ƒИэ’АцБ%j Ў}bэgDбˆjўЛзDьpЁ~Ž€'dрКGMTў -…ƒ/60УœZ{iСў1*ьŸФэlM‡жNzо_7йКя^N.ЂЋNРrЄЈž–šB*0аІ Ф<,тФF;geŒvЮЪЪMЉЏYыэNаŠ+е#„“ІDсВжлєэМј> Wx›r2ы=6г­QЖgKј!pŸ|%ЋЦрcЁ…Љн*яцoO|@+Ў:{LЫ№6хdЖ ‚—}}бFz гЗ]0ДвЮ–№3ˆ­—VBр>љлYœ PќMk›‡&2аСUЕRЛT€v1оЭпž˜іИћЙ†'‡џН@т5№щMsЫŽ(рmЪЩІV­Ќl* cf.ћ:њhР]ŸЂє0фЖ“UwзД1+Абћf~Н]~œ-сgк†[/­V`HШХЦ )ƒ§kLIАТу‹Ѕ† ј5P›ŸPšж6џмэQšOK{ prУ=лБ…МдЄv#ЈтMDЭ(эbn;Š§ЮцЛІЉƒqы,7аgI3 >еu0YАП}№љF—zjрг›,лДўц–Q ­z4нхHЧц‚- Ћ+‚KLчи6ž ocT@ЦЬ{ЁЉ№/[ЫcJ‘†ЪхзН­€Dщa ŽШm'ЋŽV@ЮЏ&пВщИз#PxekvіЭ2ќАіU™zЛќ6<€›S8[ТЯ~`ЅЊД- ђk`aА/'‹HфэЦсKЋ§†.ŠRЬЖ~7ћз˜@РА§гfє•]“y_:ж+]Г,@ёkj{– 6?Ёц XФuЋ%3{@љнвяПцЕŠž–*іи­M“рф[P&пkAКз&ш‘pАm іVwi<оЦz ЙЃщ†§BЏНš'e№3ˆ#ЫTэ:р ^|лn;Ж–Ч”№­ ёc ф%0ƒuя}*кЉFMПˆ6вУЮ ЕІ@ B{{lбн?—цXш]ЋёG–"KЯОYpЈл“=tеfF "№›E•Ъжь:Œэ‹_­#ыІsF!ыкщgаНŒєvљmВMžx7Ї>;PТ1АѕDw‹’!НЦ;Žћ§\ыh[ .`oф-жРЂБЅƒf.йХ]IМрI+‡vкУ—œЖЄђVћ ]Рj83ЄR Tјm§nоVš M№оъ ЫЙС† ‡НwEІЭш9рі\*Л&ѓl€A–џ&wЙbsPЫН5kЌиX€тзёДtЉ†VЃт hщКŠ> мK‹>J…Ё нCоt},›їЊgЩр?+7–}”Ю–ŸC ;BRЛ Фћ=іgЃНАш6*њАЖШ-0žŽAА|Y&узІЭ~ Wn& ЕЙm+‹ѓ5Ћi$œ-?‡Ф­нPv„&Lіfёхp0RН№в…і{ьЯЎћ}XЛ_§Кl‘k%/ЩыЧј`m‘[8эsŒsfMЦ+цЏ‚`љВкрeMЦ5FЭ$тяKrAЗЫ–ќ@ЎмЄРL FЈUЦј›Pg<Уа…ыjVгH2ж1Ÿy]е!нэˆ[ЛЁалYv(ьMplъšйъМ9j^юЪс`Є’a‚s;чдаcg6­ёЉDѕqK“\ї0wџчOќС­|#zОњuйцz—"зJ^zWЈ‰гбў*‹Q§Рк"ǘZР`1м–Уi\tЇЪыWџJ €VЬ_#LНєEЧƒОGaiДС7ЪьAе<šŒkdnМЭœ8•кШо—ф‚†U/‘PіwВ!Й‡-bсЯЕH™{С[ŠE‹ Ї\ЊŒёџђ (6ЁЮxn!,ЏЧЇz Ÿ'˜лдЌІ‘Œ,DF%Њх}*№2ГМoqы<ІBКл:9вQБ˜ 1хO ЗГьј7Q;PиšXѓMЁоЅюљ^G9ВеysъU›ЄCгЭS/аеХА“ERD$Уч|Cц07ШиzoH:­ЦЮlžNŽйZуS‰cБ^Ћхч§ѓe*Ию;`рnйЗIшhmУпўђ€‡~W.јFєvxЄ#=ѓšiesxОЬѕ.”uЬЪDЎ•М.wkЕЈ!Шэ(УІЃ§Uў#‚WЅI!%ЋіСГ4Е™3жb0Е€Сh5b#О\\{>О‹вИш(Š8 џN•зЏ5xП“cлч Ќ˜ПFє]‘]ž 2щхЫˆvІ“”q:ŽТвb )…Oqќ˜иƒЊ;€Hьx4з Дћ‰2­ЃбВOtš9q>ТЙ“щk?ХJ3П'§)ИоЅЉZ / ЊTЏю}$а7GЄ2рю"dCЖЂ†”r[Ф*Йƒ яАл‰ g3-Ш‚бњa‡Y9„eŽїњЭЏ’NЙ^”Ќn’$MŸpѓф&PМ™Ф‡lBё4Т&D)…ХФЫRŽOѕжЯЯIAl'ЩЃЛщ_<јБпо/YˆŒ@йj[ RTSвЖЦњTрeЂдВfyпт>љ=5—k–Яџ‰A„tЗ мєUмur-ђсЈуd~ыЛфœ<bЪŸJт(HiYщєе№oЂvЈя@ЁсЖRяƒkдbн†ъзЈ чaњф…М|d .с ЎQэјХ…nsз§ yљыЯЋѓ‰-hЄі\Ѓ.љъёС›7w+z%Ф‹ %џ=YЪрп |VЯђђ9ѕD ж—™&ˆQbPШЫчБ~™гЃт2M VcьЗЉ1еtЗщ4Тх\fš№НаШп Nѕ>ЛZБ2ћЛ`йкцў8lДH”hЩЉ":&ЫџМЬ*Iю#NCРТЏѕ’-Э(Ч,žF(D:9оЅŒk1ЧQэл&чП4Bэ‘еЃ[У:С†Eа 0?цkЎ`P9AПЋу;эD‡1УЅf‡‘JZ хьEOH:ЙlўhV#юМя•МS‹Ÿ’Вj)Р]єFЗщBX™КШ€x šoб…ћgNjŸm`‹~л2dДŽ§Ацa•™—tЂЫxM’їЩ}“У1œrucsЈх™ёЗvБ^-ѓPш25љігƒЋЗ‰…јV?з4тQ§еTН№|ф\F. >›Јсп-њЛ'дяZ‘†8LъйњRЉŽнHДм2*iZиЫп7Џе&жNct9,ОђгЭ <ЅЌпЪD%&Ч ЯЧqY Ѓ{wСBЭ%. ЃФСІё+с–ц Дћb§2ƒK`ўчANї№d*š…œШѕэ8З ŽхьnScх1щыя YMчh„Ы ‰2™тљЪE:|еzЁ‘?›Уаџэ1ЋПо|v94Рkлѕd-вFТvР(—Й’ЧѓГМ&юЩpиh#‘n:Ьб. I0˜ђІREtLГѓ&ЃзљB6OZ­T’мGЕ$ŽЈн€ё^<6ЃБ^ы%[П]wДлWYU:с КX<PЙŠпПЩrg(ФQˆJзbЋЏ…ЯЅЋl.љƒLЮi­x-†ХмRp$jŸFЗ†uЇдšУ њ{"НЈ”@`.~Ёж|‘CЫІ‡Ч<д„[šSЯ'sŒьЎєЗ4ЇK|’ žOцн„ЖaYп,2ŠЕQh•ЃО–ј$Aе3‚Ц}™Q>RїК mУљТЫDВОYdёuџуu.eА6хУ7ужAё чv$F}%gлЂ,ёI‚o:яыauVЈЊгбњ2Ѓ.ЙљЉ=ЂŸњ~i9}5Ћ]vо кђ…—‰БN1d}ГШ'ЖOЃэр&)›ЋZЛЛш‘м;BN.x‰шЉќвrњПд}j*VЛ)с№<­КjoюqЬшЅ ^ШцЦјObb!VФ›‰ќJЪ7БЭNl+ž ЇFл9ЙОK#эТ€…jГЌTxЁ+а#;x“шџи”п›_ЉX3 \Я•ŒWхsMœCєЩЧйЇŠ  Сpэ‚ЛK‡рбдE+wSѕ•ггSWˆЩACoЦ_?§цє[a˜ЏС2лdgЕsЮДd0уД^ˆАї•.7МщМџ"{y€У8В&DэЄ‚ЎJ*˜Viк>б"ІЌёam vх6%І§6ЂшЫŒКЋ*=/[Аnlщ'ь„Щd'"Nр|ИЃЗšv„œ\5O:лБ ˆђпЙЃ”/њh2Ј~3Јћ=ј|•Rн­ж™{*RТсy GўZuеоОsYхщ о.O ЭKHжkЬЬёŸFWФ:Х8‡ёcПЊљь@a_kљ/”Q2‰еi@–ЂЕЧно'чž`N3Y…НДŒЖ?rЯ}™ѕK&ІэЅ!C‘7Z‘†„ еЧЪ­Ro`~ƒ,ЋиЈ№BWы;фа Gv№уŒаwgзJ$$ьЃё/neВфШт6ПRБutє6>f}УР‘љ˜ZТКSќEЎЪч_el`л>і3˜ѕPДг‰Т”Bdў@WвXЧ‚скС*|†EqцеК@RMЦвr tѕŠVюІЩH!a7›№"ќ=wІЇЇ$хlЃЎ“ƒэл5i€ЏW*K аџx‹МГ-‘8шЗТ{#E0_ƒes”%тїЯПБД6цœiЩЅWЯN! UbЧѓš)ЛaКjpЧ=ю+]n­рћщxгy/;пЈПCEћќˆу|Зєq\є?злpdMˆ3Џы›8оиЮžY\• ^ЂT"0­щ–*“В yаyЊўJ(8FŽПТкьВkЪm K‰І†Ь §ŸN6К–0w,aюКQ ™Фmєjp5ЅcщЃ•dž2ˆлЄИмyщерˆйв—+LЖ Н|Б~-Ич‘ПdЗђ АjHqЙѓоAО„}дкыфнmQЕдєЧ…гƒV˜lРЈkdzљb§ьЩeŠO\йlcc=њѕ Ш n;^iLфA`еrqgЂбфjm ЈZjz Яфџ “'Ў Бž}D“№вЃ‡hђўТi]WbїЫge€q6lчknvдўр+г‰ZzкЬJнgoпЙљљяОŽCОЗеŽА`шЃжж~“бЁФТи8RђпOёgЛбgWМІнЕ?K6ВHк+ иL ЏіJ6`zAУя`пUпgЈяŽn1yОiFŒГaЫƒfМ вo%6тhR•w ЬG ЛЙ"/&UО;КХ( НВ’ZД+jГ\ЇџзТ1ЯаЕ‹žй,Ўо[АТd›&ђcьœЃju “mЉ œ?6ы…grW‚JП•zИтЎ+Б{8Ж ›Žв’ ОехЗям|!пл двг†BтдёјГнhnƒкЭО[&ЙісwАowGЗцZˆpjџЪ;f\ џžeiЎbјгџkaEЯlxт  юв зTƒNТГ9a&gЇї`аMGiIлwn>JjбЎмZжйf п@№;и7SЎМЉХžЛоЯВGщџЕ0ђННŠТКЪ0“ГSІЃД$6аК“зЭ)WоTПgй#.zfГИJaФh]”+o*7О ДЁŽ УпZя-@+cР1cР1c Р1cА6c А6c€€А6c €А6c €А6c А6c deflate 1.3.1 Copyright 1995-2024 Jean-loup Gailly and Mark Adler %sИjc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc lc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jclc†jclc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jc†jcќkc†jc†jc†jc†jc№kc†jcфkc†jc†jc†jc†jc†jc†jc†jc†jc†jcиkc†jc†jc†jc†jcЬjc‚lcout of memory: %s%s%sout of memory1.3.1compressed data errorunexpected end of fileinternal error: inflate stream corruptrequest does not fit in an intrequest does not fit in a size_tout of room to push charactersout of memory1.3.1internal error: deflate stream corruptrequested length does not fit in intrequest does not fit in a size_tinvalid block typeinvalid stored block lengthstoo many length or distance symbolsinvalid code lengths setinvalid code -- missing end-of-blockinvalid literal/lengths setinvalid distances setinvalid literal/length codeinvalid distance codeinvalid distance too far backinvalid bit length repeat(—c •c˜c •c •cА—c •c •c •cћ•c •c •c •c •c •c •c •cцšcьšcA@!  @a`10  С@`Psp0 Р `  €@ рX ;x8 аh( АˆH №Tу+t4 Ш d$ Ј„D ш\ ˜S|< иl, И ŒL јRЃ#r2 Ф b" Є‚B фZ ”Cz: дj* Д ŠJ єV@3v6 Ьf& Ќ†F ь ^ œc~> мn. МŽN ќ`Qƒq1 Т a! ЂA тY ’;y9 вi) В ‰I ђU+u5 Ъ e% Њ…E ъ] šS}= кm- К M њSУ#s3 Ц c# ІƒC ц[ –C{; жk+ Ж ‹K іW@3w7 Юg' Ў‡G ю _ žc? оo/ ОO ў`Psp0 С ` Ё€@ сX ‘;x8 бh( БˆH ёTу+t4 Щ d$ Љ„D щ\ ™S|< йl, Й ŒL љRЃ#r2 Х b" Ѕ‚B хZ •Cz: еj* Е ŠJ ѕV@3v6 Эf& ­†F э ^ c~> нn. НŽN §`Qƒq1 У a! ЃA уY “;y9 гi) Г ‰I ѓU+u5 Ы e% Ћ…E ы] ›S}= лm- Л M ћSУ#s3 Ч c# ЇƒC ч[ —C{; зk+ З ‹K їW@3w7 Яg' Џ‡G я _ Ÿc? пo/ ПO џ     incorrect header checkunknown compression methodinvalid window sizeunknown header flags setheader crc mismatchinvalid block typeinvalid stored block lengthstoo many length or distance symbolsinvalid code lengths setinvalid code -- missing end-of-blockinvalid literal/lengths setinvalid distances setinvalid literal/length codeinvalid distance codeinvalid distance too far backincorrect data checkincorrect length checkinvalid bit length repeatШЙcЈОcшЙcМcаМcИc˜ЙcЈЙcИЙcpБcOВc˜ВcЃВc Пc ЗcИcРchКchНcДcДcpЖc—ЖcИДcвДc‚СcэУc№Кc№ЛcŒеc˜ОcA@!  @a`10  С@`Psp0 Р `  €@ рX ;x8 аh( АˆH №Tу+t4 Ш d$ Ј„D ш\ ˜S|< иl, И ŒL јRЃ#r2 Ф b" Є‚B фZ ”Cz: дj* Д ŠJ єV@3v6 Ьf& Ќ†F ь ^ œc~> мn. МŽN ќ`Qƒq1 Т a! ЂA тY ’;y9 вi) В ‰I ђU+u5 Ъ e% Њ…E ъ] šS}= кm- К M њSУ#s3 Ц c# ІƒC ц[ –C{; жk+ Ж ‹K іW@3w7 Юg' Ў‡G ю _ žc? оo/ ОO ў`Psp0 С ` Ё€@ сX ‘;x8 бh( БˆH ёTу+t4 Щ d$ Љ„D щ\ ™S|< йl, Й ŒL љRЃ#r2 Х b" Ѕ‚B хZ •Cz: еj* Е ŠJ ѕV@3v6 Эf& ­†F э ^ c~> нn. НŽN §`Qƒq1 У a! ЃA уY “;y9 гi) Г ‰I ѓU+u5 Ы e% Ћ…E ы] ›S}= лm- Л M ћSУ#s3 Ч c# ЇƒC ч[ —C{; зk+ З ‹K їW@3w7 Яg' Џ‡G я _ Ÿc? пo/ ПO џ     @@ !1AaС  0@`ЫM #+3;CScsƒЃУу inflate 1.3.1 Copyright 1995-2024 Mark Adler @и c г c и c г c й c  0@`€Р€  0@`  (08@P`p€ Рр        ŒLЬ,Ќlьœ\м<М|ќ‚BТ"Ђbт’Rв2Вrђ ŠJЪ*ЊjъšZк:Кzњ†FЦ&Іfц–Vж6ЖvіŽNЮ.Ўnюž^о>О~ўAС!Ёaс‘Qб1Бqё ‰IЩ)Љiщ™Yй9Йyљ…EХ%Ѕeх•Uе5Еuѕ MЭ-­mэ]н=Н}§  “ “ S S г г 3 3 Г Г s s ѓ ѓ  ‹ ‹ K K Ы Ы + + Ћ Ћ k k ы ы   › › [ [ л л ; ; Л Л { { ћ ћ   ‡ ‡ G G Ч Ч ' ' Ї Ї g g ч ч   — — W W з з 7 7 З З w w ї ї     O O Я Я / / Џ Џ o o я я   Ÿ Ÿ _ _ п п ? ? П П   џ џ @ `P0pH(hX8xD$dT4tƒCУ#Ѓcу      1.3.11.3.1need dictionarystream endfile errorstream errordata errorinsufficient memorybuffer errorincompatible versionЧй cзй cЦй cтй cэй cњй cк cк c&к cЦй cinvalid literal/length codeinvalid distance codeinvalid distance too far backP c0 c0 c(№ c cMingw-w64 runtime failure: Address %p has no image-section VirtualQuery failed for %d bytes at address %p VirtualProtect failed with code 0x%x Unknown pseudo relocation protocol version %d. Unknown pseudo relocation bit size %d. %d bit pseudo relocation at %p out of range, targeting %p, yielding the value %p. (null)(null)NaNInfЊO cI cI cХO cI cћM cI c9P cI cI cпO cP cI c‘K cЏK cI cаN cI cI cI cI cI cI cI cI cI cI cI cI cI cI cI cI cюN cI cN cI cLN cxN cЄN cI cШK cI cI c№K cI cI cI cI cI cI cSP cI cI cI cI cPI cI cI cI cI cI cI cI cI cћJ cI cГJ cэI c@M cL cЕL cL cэI c(L cI c@L c`L cыL cPI cvM cI cI c‰J cШH cPI cI cI cPI cI cШH cInfinityNaN0Р?aCocЇ‡в?ГШ`‹(ŠЦ?ћyŸPDг?њ}-”<2ZGUDг?€? A@@р@ @?}№?$@Y@@@ˆУ@jј@€„.AаcA„з—AeЭЭA _ BшvH7BЂ”mB@хœ0ЂBФМжB4&ѕk C€р7yУAC и…W4vCШNgmСЋC=‘`фXсC@ŒЕxЏDPятжфKD’еMЯ№€DМ‰и—Ввœ<3ЇЈе#іI9=ЇєD§Ѕ2—ŒЯК[%CoЌd(Ш €р7yУACnЕЕИ“Fѕљ?щO8M20љHw‚Z<ПsнOumsvcrt.dll___lc_codepage_func__lc_codepageGCC: (GNU) 11.2.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.3.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.3.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.2.0GCC: (GNU) 11.3.0 dЗeЂYY(Œ№ 0р0А№А"€#Р"а$@$`% `P^№f€`аTa dРZ YРYРV UPRXА]Рn uАiА… ’`…0ntРt`‘@€Аƒ tАs№mn nАpŽ~oq№oа‘ps0s№РŽ№ŒPА”Ј“срмз з`й ­€Ў€рАЏpЊpЋ€Љ`иайpм пр`РА ЌДФжрщѓ%7K\dly…ЅГРЮнъї.:HQ\dnx‰—ŸЇАЗПЦЯксъѓќ !*6=FOYaiu„•ІВНвуёў $2CXdu†–Ё­ДХ  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXzlib1.dlladler32adler32_combineadler32_combine64adler32_zcompresscompress2compressBoundcrc32crc32_combinecrc32_combine64crc32_combine_gencrc32_combine_gen64crc32_combine_opcrc32_zdeflatedeflateBounddeflateCopydeflateEnddeflateGetDictionarydeflateInit2_deflateInit_deflateParamsdeflatePendingdeflatePrimedeflateResetdeflateResetKeepdeflateSetDictionarydeflateSetHeaderdeflateTuneget_crc_tablegzbuffergzclearerrgzclosegzclose_rgzclose_wgzdirectgzdopengzeofgzerrorgzflushgzfreadgzfwritegzgetcgzgetc_gzgetsgzoffsetgzoffset64gzopengzopen64gzopen_wgzprintfgzputcgzputsgzreadgzrewindgzseekgzseek64gzsetparamsgztellgztell64gzungetcgzvprintfgzwriteinflateinflateBackinflateBackEndinflateBackInit_inflateCodesUsedinflateCopyinflateEndinflateGetDictionaryinflateGetHeaderinflateInit2_inflateInit_inflateMarkinflatePrimeinflateResetinflateReset2inflateResetKeepinflateSetDictionaryinflateSyncinflateSyncPointinflateUndermineinflateValidateuncompressuncompress2zErrorzlibCompileFlagszlibVersion<tx @Ьфќ  2Nbz˜ІИШоюќ$,8@HR\fnv€ˆšЈВМЦакф№њ&0Ьфќ  2Nbz˜ІИШоюќ$,8@HR\fnv€ˆšЈВМЦакф№њ&0DeleteCriticalSection6EnterCriticalSectioniGetLastError€GetModuleHandleWЖGetProcAddressmInitializeCriticalSectionIsDBCSLeadByteExЭLeaveCriticalSectionMultiByteToWideCharjSleepTlsGetValueНVirtualProtectРVirtualQueryђWideCharToMultiByteH__mb_cur_max“_amsg_exitГ_closeс_errnoc_inittermg_iobд_lockм_lseeki64€_openŸ_readN_unlockч_wopenј_write%abort.atoi2callocQfputcVfreecfwriteŽlocaleconv”mallocšmemchrœmemcpymemmovežmemsetАreallocЗsetlocaleХstrchrЫstrerrorЭstrlenаstrncmpљvfprintfwcslenwcstombsKERNEL32.dllmsvcrt.dllcP c c€0€ HX@,,4VS_VERSION_INFOНяў?ŒStringFileInfoh040904E4dFileDescriptionzlib data compression library,FileVersion1.3.14 InternalNamezlib1.dll|,LegalCopyright(C) 1995-2022 Jean-loup Gailly & Mark Adler< OriginalFilenamezlib1.dll*ProductNamezlib0ProductVersion1.3.1x0CommentsFor more information visit http://www.zlib.net/DVarFileInfo$Translation ф|000D0Y0f0q0Б0к0х0ѓ011<1c1n1x1Ђ1Д1Л1С1м1у1ю1/282Œ2Е3ъ3 4д;=k=}==Ё=Г=Х=з=щ=>>(>:>L>^>p>‚>З>д>э>?#?:?Q?‰?є?ћ? \ 00%0/0?0F0Y0`0m0€0Š0‘0 0Њ0Л0Т0д0л01%171H1W1j1y1“1 1Џ1О1д1с1ѕ122'262E2T23Ц3~450“2М2Х8у8 ;> ?@^4C=Ј?P8$888?8O;Ц;г;р;ч;n<` +4;4@4q4{6‹66С6І:);=X>p(№4њ46*6w7Д7Ь8˜97:g:”:;-<Ъ=ъ>є?€”3т6O7э7C9е9ы:$=”=(V4]4o45_89|;У;з;§;)<Д>а>е>l?Э? Ш17}7в73>C>J>c?s?z?АC1п3э3)5{7К:н;„>?Р j0O1$5;дЏ>Ц>;?Ќ?а'0Р4K5Б5З6рг6л6[d>‰>Ž>+?j?w?Б?Э?э? 0:0U0b0i0ˆ0š0Ў0Ы0т0111"1-1;1e11Ÿ1Ј1К1Х1Ы1ё1 222!232}2ƒ2›2м2ѕ2332383C3I3T3b3r3Ё3Ж3Ъ3а3ж3у3щ34414e4t4y44Œ4’4Е4г4й4о45525T5b5~5Ё5Њ5Е5г5н5ш5ю566Н6Ч6Э6з6р6ы6E7O7U7_7s77‡7•7Х7Я7е7у7ю7 888$838>8E8…88•8Ѓ8Њ8Х8Я8е8п8ѓ8џ89V9e9k9u9‹9•9б9:};ќ>@ І8P0Y0И13@3†7З8У8а8о8ј8c9Е9ї9Ђ;р;)Е>€p2W2 33Т35b5j5r5z5‚5Š5’5š5Ђ5Њ5В5К5Т5Ъ5в5к5т5ъ5ђ5њ56 666"6*626:6A6˜6ž6Ў6И6Ц6й6о6є6ў6 77!727:7B7Ф70,0004080<0@0D0АрЈ4Д4Р4Ь4и4ф4№4ќ455„5ˆ5Œ55”5˜5œ5 5Є5Ј5Ќ5А5Д5И5М5Р5Ф5Ш5Ь5а5д5и5м5р5ф5ш5ь5№5є5ј5ќ5666 66666 6$6(6,6064686<6@6D6H6L6P6T6X6\6`6d6h6l6p6t6x6|6€6„6ˆ6Œ66”6˜6œ6 6Є6Ј6Ќ6А6Д6И6t9x9|9€9„9ˆ9Œ99”9˜9œ9 9Є9Ј9Ќ9А9Д9И9М9РPT4X4\4`4d4h4l4p4t4x4|4€4„4ˆ4Œ44”4˜4œ4 4Є4Ј4Ќ4А4Д4И4М4Р4Ф4Ш4Ь4ф>є>ј>? ?ам@:D:H:L:P:T:X:\:`:d:а:д:и:м:р:X<\<`mode == LEN strm->avail_in >= 6 strm->avail_out >= 258 start >= strm->avail_out state->bits < 8 On return, state->mode is one of: LEN -- ran out of enough output space or enough available input TYPE -- reached end of block code, inflate() to interpret next block BAD -- error in block data Notes: - The maximum input bits used by a length/distance pair is 15 bits for the length code, 5 bits for the length extra, 15 bits for the distance code, and 13 bits for the distance extra. This totals 48 bits, or six bytes. Therefore if strm->avail_in >= 6, then there is enough input to avoid checking for available input while decoding. - The maximum bytes that a single length/distance pair can output is 258 bytes, which is the maximum length that can be coded. inflate_fast() requires strm->avail_out >= 258 for each loop to avoid checking for output space. */ void ZLIB_INTERNAL inflate_fast(z_streamp strm, unsigned start) { struct inflate_state FAR *state; z_const unsigned char FAR *in; /* local strm->next_in */ z_const unsigned char FAR *last; /* have enough input while in < last */ unsigned char FAR *out; /* local strm->next_out */ unsigned char FAR *beg; /* inflate()'s initial strm->next_out */ unsigned char FAR *end; /* while out < end, enough space available */ #ifdef INFLATE_STRICT unsigned dmax; /* maximum distance from zlib header */ #endif unsigned wsize; /* window size or zero if not using window */ unsigned whave; /* valid bytes in the window */ unsigned wnext; /* window write index */ unsigned char FAR *window; /* allocated sliding window, if wsize != 0 */ unsigned long hold; /* local strm->hold */ unsigned bits; /* local strm->bits */ code const FAR *lcode; /* local strm->lencode */ code const FAR *dcode; /* local strm->distcode */ unsigned lmask; /* mask for first level of length codes */ unsigned dmask; /* mask for first level of distance codes */ code const *here; /* retrieved table entry */ unsigned op; /* code bits, operation, extra bits, or */ /* window position, window bytes to copy */ unsigned len; /* match length, unused bytes */ unsigned dist; /* match distance */ unsigned char FAR *from; /* where to copy match from */ /* copy state to local variables */ state = (struct inflate_state FAR *)strm->state; in = strm->next_in; last = in + (strm->avail_in - 5); out = strm->next_out; beg = out - (start - strm->avail_out); end = out + (strm->avail_out - 257); #ifdef INFLATE_STRICT dmax = state->dmax; #endif wsize = state->wsize; whave = state->whave; wnext = state->wnext; window = state->window; hold = state->hold; bits = state->bits; lcode = state->lencode; dcode = state->distcode; lmask = (1U << state->lenbits) - 1; dmask = (1U << state->distbits) - 1; /* decode literals and length/distances until end-of-block or not enough input data or output space */ do { if (bits < 15) { hold += (unsigned long)(*in++) << bits; bits += 8; hold += (unsigned long)(*in++) << bits; bits += 8; } here = lcode + (hold & lmask); dolen: op = (unsigned)(here->bits); hold >>= op; bits -= op; op = (unsigned)(here->op); if (op == 0) { /* literal */ Tracevv((stderr, here->val >= 0x20 && here->val < 0x7f ? "inflate: literal '%c'\n" : "inflate: literal 0x%02x\n", here->val)); *out++ = (unsigned char)(here->val); } else if (op & 16) { /* length base */ len = (unsigned)(here->val); op &= 15; /* number of extra bits */ if (op) { if (bits < op) { hold += (unsigned long)(*in++) << bits; bits += 8; } len += (unsigned)hold & ((1U << op) - 1); hold >>= op; bits -= op; } Tracevv((stderr, "inflate: length %u\n", len)); if (bits < 15) { hold += (unsigned long)(*in++) << bits; bits += 8; hold += (unsigned long)(*in++) << bits; bits += 8; } here = dcode + (hold & dmask); dodist: op = (unsigned)(here->bits); hold >>= op; bits -= op; op = (unsigned)(here->op); if (op & 16) { /* distance base */ dist = (unsigned)(here->val); op &= 15; /* number of extra bits */ if (bits < op) { hold += (unsigned long)(*in++) << bits; bits += 8; if (bits < op) { hold += (unsigned long)(*in++) << bits; bits += 8; } } dist += (unsigned)hold & ((1U << op) - 1); #ifdef INFLATE_STRICT if (dist > dmax) { strm->msg = (char *)"invalid distance too far back"; state->mode = BAD; break; } #endif hold >>= op; bits -= op; Tracevv((stderr, "inflate: distance %u\n", dist)); op = (unsigned)(out - beg); /* max distance in output */ if (dist > op) { /* see if copy from window */ op = dist - op; /* distance back in window */ if (op > whave) { if (state->sane) { strm->msg = (char *)"invalid distance too far back"; state->mode = BAD; break; } #ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR if (len <= op - whave) { do { *out++ = 0; } while (--len); continue; } len -= op - whave; do { *out++ = 0; } while (--op > whave); if (op == 0) { from = out - dist; do { *out++ = *from++; } while (--len); continue; } #endif } from = window; if (wnext == 0) { /* very common case */ from += wsize - op; if (op < len) { /* some from window */ len -= op; do { *out++ = *from++; } while (--op); from = out - dist; /* rest from output */ } } else if (wnext < op) { /* wrap around window */ from += wsize + wnext - op; op -= wnext; if (op < len) { /* some from end of window */ len -= op; do { *out++ = *from++; } while (--op); from = window; if (wnext < len) { /* some from start of window */ op = wnext; len -= op; do { *out++ = *from++; } while (--op); from = out - dist; /* rest from output */ } } } else { /* contiguous in window */ from += wnext - op; if (op < len) { /* some from window */ len -= op; do { *out++ = *from++; } while (--op); from = out - dist; /* rest from output */ } } while (len > 2) { *out++ = *from++; *out++ = *from++; *out++ = *from++; len -= 3; } if (len) { *out++ = *from++; if (len > 1) *out++ = *from++; } } else { from = out - dist; /* copy direct from output */ do { /* minimum length is three */ *out++ = *from++; *out++ = *from++; *out++ = *from++; len -= 3; } while (len > 2); if (len) { *out++ = *from++; if (len > 1) *out++ = *from++; } } } else if ((op & 64) == 0) { /* 2nd level distance code */ here = dcode + here->val + (hold & ((1U << op) - 1)); goto dodist; } else { strm->msg = (char *)"invalid distance code"; state->mode = BAD; break; } } else if ((op & 64) == 0) { /* 2nd level length code */ here = lcode + here->val + (hold & ((1U << op) - 1)); goto dolen; } else if (op & 32) { /* end-of-block */ Tracevv((stderr, "inflate: end of block\n")); state->mode = TYPE; break; } else { strm->msg = (char *)"invalid literal/length code"; state->mode = BAD; break; } } while (in < last && out < end); /* return unused bytes (on entry, bits < 8, so in won't go too far back) */ len = bits >> 3; in -= len; bits -= len << 3; hold &= (1U << bits) - 1; /* update state and return */ strm->next_in = in; strm->next_out = out; strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last)); strm->avail_out = (unsigned)(out < end ? 257 + (end - out) : 257 - (out - end)); state->hold = hold; state->bits = bits; return; } /* inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe): - Using bit fields for code structure - Different op definition to avoid & for extra bits (do & for table bits) - Three separate decoding do-loops for direct, window, and wnext == 0 - Special case for distance > 1 copies to do overlapped load and store copy - Explicit branch predictions (based on measured branch probabilities) - Deferring match copy and interspersed it with decoding subsequent codes - Swapping literal/length else - Swapping window/direct else - Larger unrolled copy loops (three is about right) - Moving len -= 3 statement into middle of loop */ #endif /* !ASMINF */ tcl8.6.14/compat/zlib/zlib.pc.in0000644000175000017500000000037614554262142015764 0ustar sergeisergeiprefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ sharedlibdir=@sharedlibdir@ includedir=@includedir@ Name: zlib Description: zlib compression library Version: @VERSION@ Requires: Libs: -L${libdir} -L${sharedlibdir} -lz Cflags: -I${includedir} tcl8.6.14/compat/zlib/gzclose.c0000644000175000017500000000123414554262142015677 0ustar sergeisergei/* gzclose.c -- zlib gzclose() function * Copyright (C) 2004, 2010 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ #include "gzguts.h" /* gzclose() is in a separate file so that it is linked in only if it is used. That way the other gzclose functions can be used instead to avoid linking in unneeded compression or decompression routines. */ int ZEXPORT gzclose(gzFile file) { #ifndef NO_GZCOMPRESS gz_statep state; if (file == NULL) return Z_STREAM_ERROR; state = (gz_statep)file; return state->mode == GZ_READ ? gzclose_r(file) : gzclose_w(file); #else return gzclose_r(file); #endif } tcl8.6.14/compat/zlib/contrib/0000755000175000017500000000000014566153412015527 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/puff/0000755000175000017500000000000014566153412016467 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/puff/zeros.raw0000644000175000017500000000472514554262142020352 0ustar sergeisergeib`Ѓ`Œ‚Q0 FС(Ѓ`Œ‚Q0 FС(Ѓ`Œ‚Q0 FС(Ѓ`Œ‚Q0 FС(Ѓ`Œ‚Q0Є€ 8тПВ$‚ўПnG 0 іџэм€ ыF(ь_Рtcl8.6.14/compat/zlib/contrib/puff/README0000644000175000017500000000600514554262142017346 0ustar sergeisergeiPuff -- A Simple Inflate 3 Mar 2003 Mark Adler madler@alumni.caltech.edu What this is -- puff.c provides the routine puff() to decompress the deflate data format. It does so more slowly than zlib, but the code is about one-fifth the size of the inflate code in zlib, and written to be very easy to read. Why I wrote this -- puff.c was written to document the deflate format unambiguously, by virtue of being working C code. It is meant to supplement RFC 1951, which formally describes the deflate format. I have received many questions on details of the deflate format, and I hope that reading this code will answer those questions. puff.c is heavily commented with details of the deflate format, especially those little nooks and cranies of the format that might not be obvious from a specification. puff.c may also be useful in applications where code size or memory usage is a very limited resource, and speed is not as important. How to use it -- Well, most likely you should just be reading puff.c and using zlib for actual applications, but if you must ... Include puff.h in your code, which provides this prototype: int puff(unsigned char *dest, /* pointer to destination pointer */ unsigned long *destlen, /* amount of output space */ unsigned char *source, /* pointer to source data pointer */ unsigned long *sourcelen); /* amount of input available */ Then you can call puff() to decompress a deflate stream that is in memory in its entirety at source, to a sufficiently sized block of memory for the decompressed data at dest. puff() is the only external symbol in puff.c The only C library functions that puff.c needs are setjmp() and longjmp(), which are used to simplify error checking in the code to improve readability. puff.c does no memory allocation, and uses less than 2K bytes off of the stack. If destlen is not enough space for the uncompressed data, then inflate will return an error without writing more than destlen bytes. Note that this means that in order to decompress the deflate data successfully, you need to know the size of the uncompressed data ahead of time. If needed, puff() can determine the size of the uncompressed data with no output space. This is done by passing dest equal to (unsigned char *)0. Then the initial value of *destlen is ignored and *destlen is set to the length of the uncompressed data. So if the size of the uncompressed data is not known, then two passes of puff() can be used--first to determine the size, and second to do the actual inflation after allocating the appropriate memory. Not pretty, but it works. (This is one of the reasons you should be using zlib.) The deflate format is self-terminating. If the deflate stream does not end in *sourcelen bytes, puff() will return an error without reading at or past endsource. On return, *sourcelen is updated to the amount of input data consumed, and *destlen is updated to the size of the uncompressed data. See the comments in puff.c for the possible return codes for puff(). tcl8.6.14/compat/zlib/contrib/puff/puff.c0000644000175000017500000011177214560736523017610 0ustar sergeisergei/* * puff.c * Copyright (C) 2002-2013 Mark Adler * For conditions of distribution and use, see copyright notice in puff.h * version 2.3, 21 Jan 2013 * * puff.c is a simple inflate written to be an unambiguous way to specify the * deflate format. It is not written for speed but rather simplicity. As a * side benefit, this code might actually be useful when small code is more * important than speed, such as bootstrap applications. For typical deflate * data, zlib's inflate() is about four times as fast as puff(). zlib's * inflate compiles to around 20K on my machine, whereas puff.c compiles to * around 4K on my machine (a PowerPC using GNU cc). If the faster decode() * function here is used, then puff() is only twice as slow as zlib's * inflate(). * * All dynamically allocated memory comes from the stack. The stack required * is less than 2K bytes. This code is compatible with 16-bit int's and * assumes that long's are at least 32 bits. puff.c uses the short data type, * assumed to be 16 bits, for arrays in order to conserve memory. The code * works whether integers are stored big endian or little endian. * * In the comments below are "Format notes" that describe the inflate process * and document some of the less obvious aspects of the format. This source * code is meant to supplement RFC 1951, which formally describes the deflate * format: * * http://www.zlib.org/rfc-deflate.html */ /* * Change history: * * 1.0 10 Feb 2002 - First version * 1.1 17 Feb 2002 - Clarifications of some comments and notes * - Update puff() dest and source pointers on negative * errors to facilitate debugging deflators * - Remove longest from struct huffman -- not needed * - Simplify offs[] index in construct() * - Add input size and checking, using longjmp() to * maintain easy readability * - Use short data type for large arrays * - Use pointers instead of long to specify source and * destination sizes to avoid arbitrary 4 GB limits * 1.2 17 Mar 2002 - Add faster version of decode(), doubles speed (!), * but leave simple version for readability * - Make sure invalid distances detected if pointers * are 16 bits * - Fix fixed codes table error * - Provide a scanning mode for determining size of * uncompressed data * 1.3 20 Mar 2002 - Go back to lengths for puff() parameters [Gailly] * - Add a puff.h file for the interface * - Add braces in puff() for else do [Gailly] * - Use indexes instead of pointers for readability * 1.4 31 Mar 2002 - Simplify construct() code set check * - Fix some comments * - Add FIXLCODES #define * 1.5 6 Apr 2002 - Minor comment fixes * 1.6 7 Aug 2002 - Minor format changes * 1.7 3 Mar 2003 - Added test code for distribution * - Added zlib-like license * 1.8 9 Jan 2004 - Added some comments on no distance codes case * 1.9 21 Feb 2008 - Fix bug on 16-bit integer architectures [Pohland] * - Catch missing end-of-block symbol error * 2.0 25 Jul 2008 - Add #define to permit distance too far back * - Add option in TEST code for puff to write the data * - Add option in TEST code to skip input bytes * - Allow TEST code to read from piped stdin * 2.1 4 Apr 2010 - Avoid variable initialization for happier compilers * - Avoid unsigned comparisons for even happier compilers * 2.2 25 Apr 2010 - Fix bug in variable initializations [Oberhumer] * - Add const where appropriate [Oberhumer] * - Split if's and ?'s for coverage testing * - Break out test code to separate file * - Move NIL to puff.h * - Allow incomplete code only if single code length is 1 * - Add full code coverage test to Makefile * 2.3 21 Jan 2013 - Check for invalid code length codes in dynamic blocks */ #include /* for setjmp(), longjmp(), and jmp_buf */ #include "puff.h" /* prototype for puff() */ #define local static /* for local function definitions */ /* * Maximums for allocations and loops. It is not useful to change these -- * they are fixed by the deflate format. */ #define MAXBITS 15 /* maximum bits in a code */ #define MAXLCODES 286 /* maximum number of literal/length codes */ #define MAXDCODES 30 /* maximum number of distance codes */ #define MAXCODES (MAXLCODES+MAXDCODES) /* maximum codes lengths to read */ #define FIXLCODES 288 /* number of fixed literal/length codes */ /* input and output state */ struct state { /* output state */ unsigned char *out; /* output buffer */ unsigned long outlen; /* available space at out */ unsigned long outcnt; /* bytes written to out so far */ /* input state */ const unsigned char *in; /* input buffer */ unsigned long inlen; /* available input at in */ unsigned long incnt; /* bytes read so far */ int bitbuf; /* bit buffer */ int bitcnt; /* number of bits in bit buffer */ /* input limit error return state for bits() and decode() */ jmp_buf env; }; /* * Return need bits from the input stream. This always leaves less than * eight bits in the buffer. bits() works properly for need == 0. * * Format notes: * * - Bits are stored in bytes from the least significant bit to the most * significant bit. Therefore bits are dropped from the bottom of the bit * buffer, using shift right, and new bytes are appended to the top of the * bit buffer, using shift left. */ local int bits(struct state *s, int need) { long val; /* bit accumulator (can use up to 20 bits) */ /* load at least need bits into val */ val = s->bitbuf; while (s->bitcnt < need) { if (s->incnt == s->inlen) longjmp(s->env, 1); /* out of input */ val |= (long)(s->in[s->incnt++]) << s->bitcnt; /* load eight bits */ s->bitcnt += 8; } /* drop need bits and update buffer, always zero to seven bits left */ s->bitbuf = (int)(val >> need); s->bitcnt -= need; /* return need bits, zeroing the bits above that */ return (int)(val & ((1L << need) - 1)); } /* * Process a stored block. * * Format notes: * * - After the two-bit stored block type (00), the stored block length and * stored bytes are byte-aligned for fast copying. Therefore any leftover * bits in the byte that has the last bit of the type, as many as seven, are * discarded. The value of the discarded bits are not defined and should not * be checked against any expectation. * * - The second inverted copy of the stored block length does not have to be * checked, but it's probably a good idea to do so anyway. * * - A stored block can have zero length. This is sometimes used to byte-align * subsets of the compressed data for random access or partial recovery. */ local int stored(struct state *s) { unsigned len; /* length of stored block */ /* discard leftover bits from current byte (assumes s->bitcnt < 8) */ s->bitbuf = 0; s->bitcnt = 0; /* get length and check against its one's complement */ if (s->incnt + 4 > s->inlen) return 2; /* not enough input */ len = s->in[s->incnt++]; len |= s->in[s->incnt++] << 8; if (s->in[s->incnt++] != (~len & 0xff) || s->in[s->incnt++] != ((~len >> 8) & 0xff)) return -2; /* didn't match complement! */ /* copy len bytes from in to out */ if (s->incnt + len > s->inlen) return 2; /* not enough input */ if (s->out != NIL) { if (s->outcnt + len > s->outlen) return 1; /* not enough output space */ while (len--) s->out[s->outcnt++] = s->in[s->incnt++]; } else { /* just scanning */ s->outcnt += len; s->incnt += len; } /* done with a valid stored block */ return 0; } /* * Huffman code decoding tables. count[1..MAXBITS] is the number of symbols of * each length, which for a canonical code are stepped through in order. * symbol[] are the symbol values in canonical order, where the number of * entries is the sum of the counts in count[]. The decoding process can be * seen in the function decode() below. */ struct huffman { short *count; /* number of symbols of each length */ short *symbol; /* canonically ordered symbols */ }; /* * Decode a code from the stream s using huffman table h. Return the symbol or * a negative value if there is an error. If all of the lengths are zero, i.e. * an empty code, or if the code is incomplete and an invalid code is received, * then -10 is returned after reading MAXBITS bits. * * Format notes: * * - The codes as stored in the compressed data are bit-reversed relative to * a simple integer ordering of codes of the same lengths. Hence below the * bits are pulled from the compressed data one at a time and used to * build the code value reversed from what is in the stream in order to * permit simple integer comparisons for decoding. A table-based decoding * scheme (as used in zlib) does not need to do this reversal. * * - The first code for the shortest length is all zeros. Subsequent codes of * the same length are simply integer increments of the previous code. When * moving up a length, a zero bit is appended to the code. For a complete * code, the last code of the longest length will be all ones. * * - Incomplete codes are handled by this decoder, since they are permitted * in the deflate format. See the format notes for fixed() and dynamic(). */ #ifdef SLOW local int decode(struct state *s, const struct huffman *h) { int len; /* current number of bits in code */ int code; /* len bits being decoded */ int first; /* first code of length len */ int count; /* number of codes of length len */ int index; /* index of first code of length len in symbol table */ code = first = index = 0; for (len = 1; len <= MAXBITS; len++) { code |= bits(s, 1); /* get next bit */ count = h->count[len]; if (code - count < first) /* if length len, return symbol */ return h->symbol[index + (code - first)]; index += count; /* else update for next length */ first += count; first <<= 1; code <<= 1; } return -10; /* ran out of codes */ } /* * A faster version of decode() for real applications of this code. It's not * as readable, but it makes puff() twice as fast. And it only makes the code * a few percent larger. */ #else /* !SLOW */ local int decode(struct state *s, const struct huffman *h) { int len; /* current number of bits in code */ int code; /* len bits being decoded */ int first; /* first code of length len */ int count; /* number of codes of length len */ int index; /* index of first code of length len in symbol table */ int bitbuf; /* bits from stream */ int left; /* bits left in next or left to process */ short *next; /* next number of codes */ bitbuf = s->bitbuf; left = s->bitcnt; code = first = index = 0; len = 1; next = h->count + 1; while (1) { while (left--) { code |= bitbuf & 1; bitbuf >>= 1; count = *next++; if (code - count < first) { /* if length len, return symbol */ s->bitbuf = bitbuf; s->bitcnt = (s->bitcnt - len) & 7; return h->symbol[index + (code - first)]; } index += count; /* else update for next length */ first += count; first <<= 1; code <<= 1; len++; } left = (MAXBITS+1) - len; if (left == 0) break; if (s->incnt == s->inlen) longjmp(s->env, 1); /* out of input */ bitbuf = s->in[s->incnt++]; if (left > 8) left = 8; } return -10; /* ran out of codes */ } #endif /* SLOW */ /* * Given the list of code lengths length[0..n-1] representing a canonical * Huffman code for n symbols, construct the tables required to decode those * codes. Those tables are the number of codes of each length, and the symbols * sorted by length, retaining their original order within each length. The * return value is zero for a complete code set, negative for an over- * subscribed code set, and positive for an incomplete code set. The tables * can be used if the return value is zero or positive, but they cannot be used * if the return value is negative. If the return value is zero, it is not * possible for decode() using that table to return an error--any stream of * enough bits will resolve to a symbol. If the return value is positive, then * it is possible for decode() using that table to return an error for received * codes past the end of the incomplete lengths. * * Not used by decode(), but used for error checking, h->count[0] is the number * of the n symbols not in the code. So n - h->count[0] is the number of * codes. This is useful for checking for incomplete codes that have more than * one symbol, which is an error in a dynamic block. * * Assumption: for all i in 0..n-1, 0 <= length[i] <= MAXBITS * This is assured by the construction of the length arrays in dynamic() and * fixed() and is not verified by construct(). * * Format notes: * * - Permitted and expected examples of incomplete codes are one of the fixed * codes and any code with a single symbol which in deflate is coded as one * bit instead of zero bits. See the format notes for fixed() and dynamic(). * * - Within a given code length, the symbols are kept in ascending order for * the code bits definition. */ local int construct(struct huffman *h, const short *length, int n) { int symbol; /* current symbol when stepping through length[] */ int len; /* current length when stepping through h->count[] */ int left; /* number of possible codes left of current length */ short offs[MAXBITS+1]; /* offsets in symbol table for each length */ /* count number of codes of each length */ for (len = 0; len <= MAXBITS; len++) h->count[len] = 0; for (symbol = 0; symbol < n; symbol++) (h->count[length[symbol]])++; /* assumes lengths are within bounds */ if (h->count[0] == n) /* no codes! */ return 0; /* complete, but decode() will fail */ /* check for an over-subscribed or incomplete set of lengths */ left = 1; /* one possible code of zero length */ for (len = 1; len <= MAXBITS; len++) { left <<= 1; /* one more bit, double codes left */ left -= h->count[len]; /* deduct count from possible codes */ if (left < 0) return left; /* over-subscribed--return negative */ } /* left > 0 means incomplete */ /* generate offsets into symbol table for each length for sorting */ offs[1] = 0; for (len = 1; len < MAXBITS; len++) offs[len + 1] = offs[len] + h->count[len]; /* * put symbols in table sorted by length, by symbol order within each * length */ for (symbol = 0; symbol < n; symbol++) if (length[symbol] != 0) h->symbol[offs[length[symbol]]++] = symbol; /* return zero for complete set, positive for incomplete set */ return left; } /* * Decode literal/length and distance codes until an end-of-block code. * * Format notes: * * - Compressed data that is after the block type if fixed or after the code * description if dynamic is a combination of literals and length/distance * pairs terminated by and end-of-block code. Literals are simply Huffman * coded bytes. A length/distance pair is a coded length followed by a * coded distance to represent a string that occurs earlier in the * uncompressed data that occurs again at the current location. * * - Literals, lengths, and the end-of-block code are combined into a single * code of up to 286 symbols. They are 256 literals (0..255), 29 length * symbols (257..285), and the end-of-block symbol (256). * * - There are 256 possible lengths (3..258), and so 29 symbols are not enough * to represent all of those. Lengths 3..10 and 258 are in fact represented * by just a length symbol. Lengths 11..257 are represented as a symbol and * some number of extra bits that are added as an integer to the base length * of the length symbol. The number of extra bits is determined by the base * length symbol. These are in the static arrays below, lens[] for the base * lengths and lext[] for the corresponding number of extra bits. * * - The reason that 258 gets its own symbol is that the longest length is used * often in highly redundant files. Note that 258 can also be coded as the * base value 227 plus the maximum extra value of 31. While a good deflate * should never do this, it is not an error, and should be decoded properly. * * - If a length is decoded, including its extra bits if any, then it is * followed a distance code. There are up to 30 distance symbols. Again * there are many more possible distances (1..32768), so extra bits are added * to a base value represented by the symbol. The distances 1..4 get their * own symbol, but the rest require extra bits. The base distances and * corresponding number of extra bits are below in the static arrays dist[] * and dext[]. * * - Literal bytes are simply written to the output. A length/distance pair is * an instruction to copy previously uncompressed bytes to the output. The * copy is from distance bytes back in the output stream, copying for length * bytes. * * - Distances pointing before the beginning of the output data are not * permitted. * * - Overlapped copies, where the length is greater than the distance, are * allowed and common. For example, a distance of one and a length of 258 * simply copies the last byte 258 times. A distance of four and a length of * twelve copies the last four bytes three times. A simple forward copy * ignoring whether the length is greater than the distance or not implements * this correctly. You should not use memcpy() since its behavior is not * defined for overlapped arrays. You should not use memmove() or bcopy() * since though their behavior -is- defined for overlapping arrays, it is * defined to do the wrong thing in this case. */ local int codes(struct state *s, const struct huffman *lencode, const struct huffman *distcode) { int symbol; /* decoded symbol */ int len; /* length for copy */ unsigned dist; /* distance for copy */ static const short lens[29] = { /* Size base for length codes 257..285 */ 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258}; static const short lext[29] = { /* Extra bits for length codes 257..285 */ 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0}; static const short dists[30] = { /* Offset base for distance codes 0..29 */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289, 16385, 24577}; static const short dext[30] = { /* Extra bits for distance codes 0..29 */ 0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13}; /* decode literals and length/distance pairs */ do { symbol = decode(s, lencode); if (symbol < 0) return symbol; /* invalid symbol */ if (symbol < 256) { /* literal: symbol is the byte */ /* write out the literal */ if (s->out != NIL) { if (s->outcnt == s->outlen) return 1; s->out[s->outcnt] = symbol; } s->outcnt++; } else if (symbol > 256) { /* length */ /* get and compute length */ symbol -= 257; if (symbol >= 29) return -10; /* invalid fixed code */ len = lens[symbol] + bits(s, lext[symbol]); /* get and check distance */ symbol = decode(s, distcode); if (symbol < 0) return symbol; /* invalid symbol */ dist = dists[symbol] + bits(s, dext[symbol]); #ifndef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR if (dist > s->outcnt) return -11; /* distance too far back */ #endif /* copy length bytes from distance bytes back */ if (s->out != NIL) { if (s->outcnt + len > s->outlen) return 1; while (len--) { s->out[s->outcnt] = #ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR dist > s->outcnt ? 0 : #endif s->out[s->outcnt - dist]; s->outcnt++; } } else s->outcnt += len; } } while (symbol != 256); /* end of block symbol */ /* done with a valid fixed or dynamic block */ return 0; } /* * Process a fixed codes block. * * Format notes: * * - This block type can be useful for compressing small amounts of data for * which the size of the code descriptions in a dynamic block exceeds the * benefit of custom codes for that block. For fixed codes, no bits are * spent on code descriptions. Instead the code lengths for literal/length * codes and distance codes are fixed. The specific lengths for each symbol * can be seen in the "for" loops below. * * - The literal/length code is complete, but has two symbols that are invalid * and should result in an error if received. This cannot be implemented * simply as an incomplete code since those two symbols are in the "middle" * of the code. They are eight bits long and the longest literal/length\ * code is nine bits. Therefore the code must be constructed with those * symbols, and the invalid symbols must be detected after decoding. * * - The fixed distance codes also have two invalid symbols that should result * in an error if received. Since all of the distance codes are the same * length, this can be implemented as an incomplete code. Then the invalid * codes are detected while decoding. */ local int fixed(struct state *s) { static int virgin = 1; static short lencnt[MAXBITS+1], lensym[FIXLCODES]; static short distcnt[MAXBITS+1], distsym[MAXDCODES]; static struct huffman lencode, distcode; /* build fixed huffman tables if first call (may not be thread safe) */ if (virgin) { int symbol; short lengths[FIXLCODES]; /* construct lencode and distcode */ lencode.count = lencnt; lencode.symbol = lensym; distcode.count = distcnt; distcode.symbol = distsym; /* literal/length table */ for (symbol = 0; symbol < 144; symbol++) lengths[symbol] = 8; for (; symbol < 256; symbol++) lengths[symbol] = 9; for (; symbol < 280; symbol++) lengths[symbol] = 7; for (; symbol < FIXLCODES; symbol++) lengths[symbol] = 8; construct(&lencode, lengths, FIXLCODES); /* distance table */ for (symbol = 0; symbol < MAXDCODES; symbol++) lengths[symbol] = 5; construct(&distcode, lengths, MAXDCODES); /* do this just once */ virgin = 0; } /* decode data until end-of-block code */ return codes(s, &lencode, &distcode); } /* * Process a dynamic codes block. * * Format notes: * * - A dynamic block starts with a description of the literal/length and * distance codes for that block. New dynamic blocks allow the compressor to * rapidly adapt to changing data with new codes optimized for that data. * * - The codes used by the deflate format are "canonical", which means that * the actual bits of the codes are generated in an unambiguous way simply * from the number of bits in each code. Therefore the code descriptions * are simply a list of code lengths for each symbol. * * - The code lengths are stored in order for the symbols, so lengths are * provided for each of the literal/length symbols, and for each of the * distance symbols. * * - If a symbol is not used in the block, this is represented by a zero as the * code length. This does not mean a zero-length code, but rather that no * code should be created for this symbol. There is no way in the deflate * format to represent a zero-length code. * * - The maximum number of bits in a code is 15, so the possible lengths for * any code are 1..15. * * - The fact that a length of zero is not permitted for a code has an * interesting consequence. Normally if only one symbol is used for a given * code, then in fact that code could be represented with zero bits. However * in deflate, that code has to be at least one bit. So for example, if * only a single distance base symbol appears in a block, then it will be * represented by a single code of length one, in particular one 0 bit. This * is an incomplete code, since if a 1 bit is received, it has no meaning, * and should result in an error. So incomplete distance codes of one symbol * should be permitted, and the receipt of invalid codes should be handled. * * - It is also possible to have a single literal/length code, but that code * must be the end-of-block code, since every dynamic block has one. This * is not the most efficient way to create an empty block (an empty fixed * block is fewer bits), but it is allowed by the format. So incomplete * literal/length codes of one symbol should also be permitted. * * - If there are only literal codes and no lengths, then there are no distance * codes. This is represented by one distance code with zero bits. * * - The list of up to 286 length/literal lengths and up to 30 distance lengths * are themselves compressed using Huffman codes and run-length encoding. In * the list of code lengths, a 0 symbol means no code, a 1..15 symbol means * that length, and the symbols 16, 17, and 18 are run-length instructions. * Each of 16, 17, and 18 are followed by extra bits to define the length of * the run. 16 copies the last length 3 to 6 times. 17 represents 3 to 10 * zero lengths, and 18 represents 11 to 138 zero lengths. Unused symbols * are common, hence the special coding for zero lengths. * * - The symbols for 0..18 are Huffman coded, and so that code must be * described first. This is simply a sequence of up to 19 three-bit values * representing no code (0) or the code length for that symbol (1..7). * * - A dynamic block starts with three fixed-size counts from which is computed * the number of literal/length code lengths, the number of distance code * lengths, and the number of code length code lengths (ok, you come up with * a better name!) in the code descriptions. For the literal/length and * distance codes, lengths after those provided are considered zero, i.e. no * code. The code length code lengths are received in a permuted order (see * the order[] array below) to make a short code length code length list more * likely. As it turns out, very short and very long codes are less likely * to be seen in a dynamic code description, hence what may appear initially * to be a peculiar ordering. * * - Given the number of literal/length code lengths (nlen) and distance code * lengths (ndist), then they are treated as one long list of nlen + ndist * code lengths. Therefore run-length coding can and often does cross the * boundary between the two sets of lengths. * * - So to summarize, the code description at the start of a dynamic block is * three counts for the number of code lengths for the literal/length codes, * the distance codes, and the code length codes. This is followed by the * code length code lengths, three bits each. This is used to construct the * code length code which is used to read the remainder of the lengths. Then * the literal/length code lengths and distance lengths are read as a single * set of lengths using the code length codes. Codes are constructed from * the resulting two sets of lengths, and then finally you can start * decoding actual compressed data in the block. * * - For reference, a "typical" size for the code description in a dynamic * block is around 80 bytes. */ local int dynamic(struct state *s) { int nlen, ndist, ncode; /* number of lengths in descriptor */ int index; /* index of lengths[] */ int err; /* construct() return value */ short lengths[MAXCODES]; /* descriptor code lengths */ short lencnt[MAXBITS+1], lensym[MAXLCODES]; /* lencode memory */ short distcnt[MAXBITS+1], distsym[MAXDCODES]; /* distcode memory */ struct huffman lencode, distcode; /* length and distance codes */ static const short order[19] = /* permutation of code length codes */ {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; /* construct lencode and distcode */ lencode.count = lencnt; lencode.symbol = lensym; distcode.count = distcnt; distcode.symbol = distsym; /* get number of lengths in each table, check lengths */ nlen = bits(s, 5) + 257; ndist = bits(s, 5) + 1; ncode = bits(s, 4) + 4; if (nlen > MAXLCODES || ndist > MAXDCODES) return -3; /* bad counts */ /* read code length code lengths (really), missing lengths are zero */ for (index = 0; index < ncode; index++) lengths[order[index]] = bits(s, 3); for (; index < 19; index++) lengths[order[index]] = 0; /* build huffman table for code lengths codes (use lencode temporarily) */ err = construct(&lencode, lengths, 19); if (err != 0) /* require complete code set here */ return -4; /* read length/literal and distance code length tables */ index = 0; while (index < nlen + ndist) { int symbol; /* decoded value */ int len; /* last length to repeat */ symbol = decode(s, &lencode); if (symbol < 0) return symbol; /* invalid symbol */ if (symbol < 16) /* length in 0..15 */ lengths[index++] = symbol; else { /* repeat instruction */ len = 0; /* assume repeating zeros */ if (symbol == 16) { /* repeat last length 3..6 times */ if (index == 0) return -5; /* no last length! */ len = lengths[index - 1]; /* last length */ symbol = 3 + bits(s, 2); } else if (symbol == 17) /* repeat zero 3..10 times */ symbol = 3 + bits(s, 3); else /* == 18, repeat zero 11..138 times */ symbol = 11 + bits(s, 7); if (index + symbol > nlen + ndist) return -6; /* too many lengths! */ while (symbol--) /* repeat last or zero symbol times */ lengths[index++] = len; } } /* check for end-of-block code -- there better be one! */ if (lengths[256] == 0) return -9; /* build huffman table for literal/length codes */ err = construct(&lencode, lengths, nlen); if (err && (err < 0 || nlen != lencode.count[0] + lencode.count[1])) return -7; /* incomplete code ok only for single length 1 code */ /* build huffman table for distance codes */ err = construct(&distcode, lengths + nlen, ndist); if (err && (err < 0 || ndist != distcode.count[0] + distcode.count[1])) return -8; /* incomplete code ok only for single length 1 code */ /* decode data until end-of-block code */ return codes(s, &lencode, &distcode); } /* * Inflate source to dest. On return, destlen and sourcelen are updated to the * size of the uncompressed data and the size of the deflate data respectively. * On success, the return value of puff() is zero. If there is an error in the * source data, i.e. it is not in the deflate format, then a negative value is * returned. If there is not enough input available or there is not enough * output space, then a positive error is returned. In that case, destlen and * sourcelen are not updated to facilitate retrying from the beginning with the * provision of more input data or more output space. In the case of invalid * inflate data (a negative error), the dest and source pointers are updated to * facilitate the debugging of deflators. * * puff() also has a mode to determine the size of the uncompressed output with * no output written. For this dest must be (unsigned char *)0. In this case, * the input value of *destlen is ignored, and on return *destlen is set to the * size of the uncompressed output. * * The return codes are: * * 2: available inflate data did not terminate * 1: output space exhausted before completing inflate * 0: successful inflate * -1: invalid block type (type == 3) * -2: stored block length did not match one's complement * -3: dynamic block code description: too many length or distance codes * -4: dynamic block code description: code lengths codes incomplete * -5: dynamic block code description: repeat lengths with no first length * -6: dynamic block code description: repeat more than specified lengths * -7: dynamic block code description: invalid literal/length code lengths * -8: dynamic block code description: invalid distance code lengths * -9: dynamic block code description: missing end-of-block code * -10: invalid literal/length or distance code in fixed or dynamic block * -11: distance is too far back in fixed or dynamic block * * Format notes: * * - Three bits are read for each block to determine the kind of block and * whether or not it is the last block. Then the block is decoded and the * process repeated if it was not the last block. * * - The leftover bits in the last byte of the deflate data after the last * block (if it was a fixed or dynamic block) are undefined and have no * expected values to check. */ int puff(unsigned char *dest, /* pointer to destination pointer */ unsigned long *destlen, /* amount of output space */ const unsigned char *source, /* pointer to source data pointer */ unsigned long *sourcelen) /* amount of input available */ { struct state s; /* input/output state */ int last, type; /* block information */ int err; /* return value */ /* initialize output state */ s.out = dest; s.outlen = *destlen; /* ignored if dest is NIL */ s.outcnt = 0; /* initialize input state */ s.in = source; s.inlen = *sourcelen; s.incnt = 0; s.bitbuf = 0; s.bitcnt = 0; /* return if bits() or decode() tries to read past available input */ if (setjmp(s.env) != 0) /* if came back here via longjmp() */ err = 2; /* then skip do-loop, return error */ else { /* process blocks until last block or error */ do { last = bits(&s, 1); /* one if last block */ type = bits(&s, 2); /* block type 0..3 */ err = type == 0 ? stored(&s) : (type == 1 ? fixed(&s) : (type == 2 ? dynamic(&s) : -1)); /* type == 3, invalid */ if (err != 0) break; /* return with error */ } while (!last); } /* update the lengths and return */ if (err <= 0) { *destlen = s.outcnt; *sourcelen = s.incnt; } return err; } tcl8.6.14/compat/zlib/contrib/puff/Makefile0000644000175000017500000000355314554262142020133 0ustar sergeisergeiCFLAGS=-O puff: puff.o pufftest.o puff.o: puff.h pufftest.o: puff.h test: puff puff zeros.raw puft: puff.c puff.h pufftest.o cc -fprofile-arcs -ftest-coverage -o puft puff.c pufftest.o # puff full coverage test (should say 100%) cov: puft @rm -f *.gcov *.gcda @puft -w zeros.raw 2>&1 | cat > /dev/null @echo '04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2 @echo '00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2 @echo '00 00 00 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 254 @echo '00 01 00 fe ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2 @echo '01 01 00 fe ff 0a' | xxd -r -p | puft -f 2>&1 | cat > /dev/null @echo '02 7e ff ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246 @echo '02' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2 @echo '04 80 49 92 24 49 92 24 0f b4 ff ff c3 04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2 @echo '04 80 49 92 24 49 92 24 71 ff ff 93 11 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 249 @echo '04 c0 81 08 00 00 00 00 20 7f eb 0b 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246 @echo '0b 00 00' | xxd -r -p | puft -f 2>&1 | cat > /dev/null @echo '1a 07' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246 @echo '0c c0 81 00 00 00 00 00 90 ff 6b 04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 245 @puft -f zeros.raw 2>&1 | cat > /dev/null @echo 'fc 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 253 @echo '04 00 fe ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 252 @echo '04 00 24 49' | xxd -r -p | puft 2> /dev/null || test $$? -eq 251 @echo '04 80 49 92 24 49 92 24 0f b4 ff ff c3 84' | xxd -r -p | puft 2> /dev/null || test $$? -eq 248 @echo '04 00 24 e9 ff ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 250 @echo '04 00 24 e9 ff 6d' | xxd -r -p | puft 2> /dev/null || test $$? -eq 247 @gcov -n puff.c clean: rm -f puff puft *.o *.gc* tcl8.6.14/compat/zlib/contrib/puff/pufftest.c0000644000175000017500000001146614554262142020501 0ustar sergeisergei/* * pufftest.c * Copyright (C) 2002-2013 Mark Adler * For conditions of distribution and use, see copyright notice in puff.h * version 2.3, 21 Jan 2013 */ /* Example of how to use puff(). Usage: puff [-w] [-f] [-nnn] file ... | puff [-w] [-f] [-nnn] where file is the input file with deflate data, nnn is the number of bytes of input to skip before inflating (e.g. to skip a zlib or gzip header), and -w is used to write the decompressed data to stdout. -f is for coverage testing, and causes pufftest to fail with not enough output space (-f does a write like -w, so -w is not required). */ #include #include #include "puff.h" #if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__) # include # include # define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY) #else # define SET_BINARY_MODE(file) #endif #define local static /* Return size times approximately the cube root of 2, keeping the result as 1, 3, or 5 times a power of 2 -- the result is always > size, until the result is the maximum value of an unsigned long, where it remains. This is useful to keep reallocations less than ~33% over the actual data. */ local size_t bythirds(size_t size) { int n; size_t m; m = size; for (n = 0; m; n++) m >>= 1; if (n < 3) return size + 1; n -= 3; m = size >> n; m += m == 6 ? 2 : 1; m <<= n; return m > size ? m : (size_t)(-1); } /* Read the input file *name, or stdin if name is NULL, into allocated memory. Reallocate to larger buffers until the entire file is read in. Return a pointer to the allocated data, or NULL if there was a memory allocation failure. *len is the number of bytes of data read from the input file (even if load() returns NULL). If the input file was empty or could not be opened or read, *len is zero. */ local void *load(const char *name, size_t *len) { size_t size; void *buf, *swap; FILE *in; *len = 0; buf = malloc(size = 4096); if (buf == NULL) return NULL; in = name == NULL ? stdin : fopen(name, "rb"); if (in != NULL) { for (;;) { *len += fread((char *)buf + *len, 1, size - *len, in); if (*len < size) break; size = bythirds(size); if (size == *len || (swap = realloc(buf, size)) == NULL) { free(buf); buf = NULL; break; } buf = swap; } fclose(in); } return buf; } int main(int argc, char **argv) { int ret, put = 0, fail = 0; unsigned skip = 0; char *arg, *name = NULL; unsigned char *source = NULL, *dest; size_t len = 0; unsigned long sourcelen, destlen; /* process arguments */ while (arg = *++argv, --argc) if (arg[0] == '-') { if (arg[1] == 'w' && arg[2] == 0) put = 1; else if (arg[1] == 'f' && arg[2] == 0) fail = 1, put = 1; else if (arg[1] >= '0' && arg[1] <= '9') skip = (unsigned)atoi(arg + 1); else { fprintf(stderr, "invalid option %s\n", arg); return 3; } } else if (name != NULL) { fprintf(stderr, "only one file name allowed\n"); return 3; } else name = arg; source = load(name, &len); if (source == NULL) { fprintf(stderr, "memory allocation failure\n"); return 4; } if (len == 0) { fprintf(stderr, "could not read %s, or it was empty\n", name == NULL ? "" : name); free(source); return 3; } if (skip >= len) { fprintf(stderr, "skip request of %d leaves no input\n", skip); free(source); return 3; } /* test inflate data with offset skip */ len -= skip; sourcelen = (unsigned long)len; ret = puff(NIL, &destlen, source + skip, &sourcelen); if (ret) fprintf(stderr, "puff() failed with return code %d\n", ret); else { fprintf(stderr, "puff() succeeded uncompressing %lu bytes\n", destlen); if (sourcelen < len) fprintf(stderr, "%lu compressed bytes unused\n", len - sourcelen); } /* if requested, inflate again and write decompressed data to stdout */ if (put && ret == 0) { if (fail) destlen >>= 1; dest = malloc(destlen); if (dest == NULL) { fprintf(stderr, "memory allocation failure\n"); free(source); return 4; } puff(dest, &destlen, source + skip, &sourcelen); SET_BINARY_MODE(stdout); fwrite(dest, 1, destlen, stdout); free(dest); } /* clean up */ free(source); return ret; } tcl8.6.14/compat/zlib/contrib/puff/puff.h0000644000175000017500000000260714554262142017603 0ustar sergeisergei/* puff.h Copyright (C) 2002-2013 Mark Adler, all rights reserved version 2.3, 21 Jan 2013 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. Mark Adler madler@alumni.caltech.edu */ /* * See puff.c for purpose and usage. */ #ifndef NIL # define NIL ((unsigned char *)0) /* for no output option */ #endif int puff(unsigned char *dest, /* pointer to destination pointer */ unsigned long *destlen, /* amount of output space */ const unsigned char *source, /* pointer to source data pointer */ unsigned long *sourcelen); /* amount of input available */ tcl8.6.14/compat/zlib/contrib/README.contrib0000644000175000017500000000430014554262142020041 0ustar sergeisergeiAll files under this contrib directory are UNSUPPORTED. They were provided by users of zlib and were not tested by the authors of zlib. Use at your own risk. Please contact the authors of the contributions for help about these, not the zlib authors. Thanks. ada/ by Dmitriy Anisimkov Support for Ada See http://zlib-ada.sourceforge.net/ blast/ by Mark Adler Decompressor for output of PKWare Data Compression Library (DCL) delphi/ by Cosmin Truta Support for Delphi and C++ Builder dotzlib/ by Henrik Ravn Support for Microsoft .Net and Visual C++ .Net gcc_gvmat64/by Gilles Vollant GCC Version of x86 64-bit (AMD64 and Intel EM64t) code for x64 assembler to replace longest_match() and inflate_fast() infback9/ by Mark Adler Unsupported diffs to infback to decode the deflate64 format iostream/ by Kevin Ruland A C++ I/O streams interface to the zlib gz* functions iostream2/ by Tyge LУИvset Another C++ I/O streams interface iostream3/ by Ludwig Schwardt and Kevin Ruland Yet another C++ I/O streams interface minizip/ by Gilles Vollant Mini zip and unzip based on zlib Includes Zip64 support by Mathias Svensson See http://www.winimage.com/zLibDll/minizip.html pascal/ by Bob Dellaca et al. Support for Pascal puff/ by Mark Adler Small, low memory usage inflate. Also serves to provide an unambiguous description of the deflate format. testzlib/ by Gilles Vollant Example of the use of zlib untgz/ by Pedro A. Aranda Gutierrez A very simple tar.gz file extractor using zlib vstudio/ by Gilles Vollant Building a minizip-enhanced zlib with Microsoft Visual Studio Includes vc11 from kreuzerkrieg and vc12 from davispuh tcl8.6.14/compat/zlib/contrib/testzlib/0000755000175000017500000000000014566153412017367 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/testzlib/testzlib.c0000644000175000017500000001631114554262142021373 0ustar sergeisergei#include #include #include #include "zlib.h" void MyDoMinus64(LARGE_INTEGER *R,LARGE_INTEGER A,LARGE_INTEGER B) { R->HighPart = A.HighPart - B.HighPart; if (A.LowPart >= B.LowPart) R->LowPart = A.LowPart - B.LowPart; else { R->LowPart = A.LowPart - B.LowPart; R->HighPart --; } } #ifdef _M_X64 // see http://msdn2.microsoft.com/library/twchhe95(en-us,vs.80).aspx for __rdtsc unsigned __int64 __rdtsc(void); void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64) { // printf("rdtsc = %I64x\n",__rdtsc()); pbeginTime64->QuadPart=__rdtsc(); } LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf) { LARGE_INTEGER LIres; unsigned _int64 res=__rdtsc()-((unsigned _int64)(beginTime64.QuadPart)); LIres.QuadPart=res; // printf("rdtsc = %I64x\n",__rdtsc()); return LIres; } #else #ifdef _M_IX86 void myGetRDTSC32(LARGE_INTEGER * pbeginTime64) { DWORD dwEdx,dwEax; _asm { rdtsc mov dwEax,eax mov dwEdx,edx } pbeginTime64->LowPart=dwEax; pbeginTime64->HighPart=dwEdx; } void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64) { myGetRDTSC32(pbeginTime64); } LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf) { LARGE_INTEGER LIres,endTime64; myGetRDTSC32(&endTime64); LIres.LowPart=LIres.HighPart=0; MyDoMinus64(&LIres,endTime64,beginTime64); return LIres; } #else void myGetRDTSC32(LARGE_INTEGER * pbeginTime64) { } void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64) { } LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf) { LARGE_INTEGER lr; lr.QuadPart=0; return lr; } #endif #endif void BeginCountPerfCounter(LARGE_INTEGER * pbeginTime64,BOOL fComputeTimeQueryPerf) { if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(pbeginTime64))) { pbeginTime64->LowPart = GetTickCount(); pbeginTime64->HighPart = 0; } } DWORD GetMsecSincePerfCounter(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf) { LARGE_INTEGER endTime64,ticksPerSecond,ticks; DWORDLONG ticksShifted,tickSecShifted; DWORD dwLog=16+0; DWORD dwRet; if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(&endTime64))) dwRet = (GetTickCount() - beginTime64.LowPart)*1; else { MyDoMinus64(&ticks,endTime64,beginTime64); QueryPerformanceFrequency(&ticksPerSecond); { ticksShifted = Int64ShrlMod32(*(DWORDLONG*)&ticks,dwLog); tickSecShifted = Int64ShrlMod32(*(DWORDLONG*)&ticksPerSecond,dwLog); } dwRet = (DWORD)((((DWORD)ticksShifted)*1000)/(DWORD)(tickSecShifted)); dwRet *=1; } return dwRet; } int ReadFileMemory(const char* filename,long* plFileSize,unsigned char** pFilePtr) { FILE* stream; unsigned char* ptr; int retVal=1; stream=fopen(filename, "rb"); if (stream==NULL) return 0; fseek(stream,0,SEEK_END); *plFileSize=ftell(stream); fseek(stream,0,SEEK_SET); ptr=malloc((*plFileSize)+1); if (ptr==NULL) retVal=0; else { if (fread(ptr, 1, *plFileSize,stream) != (*plFileSize)) retVal=0; } fclose(stream); *pFilePtr=ptr; return retVal; } int main(int argc, char *argv[]) { int BlockSizeCompress=0x8000; int BlockSizeUncompress=0x8000; int cprLevel=Z_DEFAULT_COMPRESSION ; long lFileSize; unsigned char* FilePtr; long lBufferSizeCpr; long lBufferSizeUncpr; long lCompressedSize=0; unsigned char* CprPtr; unsigned char* UncprPtr; long lSizeCpr,lSizeUncpr; DWORD dwGetTick,dwMsecQP; LARGE_INTEGER li_qp,li_rdtsc,dwResRdtsc; if (argc<=1) { printf("run TestZlib [BlockSizeCompress] [BlockSizeUncompress] [compres. level]\n"); return 0; } if (ReadFileMemory(argv[1],&lFileSize,&FilePtr)==0) { printf("error reading %s\n",argv[1]); return 1; } else printf("file %s read, %ld bytes\n",argv[1],lFileSize); if (argc>=3) BlockSizeCompress=atol(argv[2]); if (argc>=4) BlockSizeUncompress=atol(argv[3]); if (argc>=5) cprLevel=(int)atol(argv[4]); lBufferSizeCpr = lFileSize + (lFileSize/0x10) + 0x200; lBufferSizeUncpr = lBufferSizeCpr; CprPtr=(unsigned char*)malloc(lBufferSizeCpr + BlockSizeCompress); BeginCountPerfCounter(&li_qp,TRUE); dwGetTick=GetTickCount(); BeginCountRdtsc(&li_rdtsc); { z_stream zcpr; int ret=Z_OK; long lOrigToDo = lFileSize; long lOrigDone = 0; int step=0; memset(&zcpr,0,sizeof(z_stream)); deflateInit(&zcpr,cprLevel); zcpr.next_in = FilePtr; zcpr.next_out = CprPtr; do { long all_read_before = zcpr.total_in; zcpr.avail_in = min(lOrigToDo,BlockSizeCompress); zcpr.avail_out = BlockSizeCompress; ret=deflate(&zcpr,(zcpr.avail_in==lOrigToDo) ? Z_FINISH : Z_SYNC_FLUSH); lOrigDone += (zcpr.total_in-all_read_before); lOrigToDo -= (zcpr.total_in-all_read_before); step++; } while (ret==Z_OK); lSizeCpr=zcpr.total_out; deflateEnd(&zcpr); dwGetTick=GetTickCount()-dwGetTick; dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE); dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE); printf("total compress size = %u, in %u step\n",lSizeCpr,step); printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.); printf("defcpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.); printf("defcpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart); } CprPtr=(unsigned char*)realloc(CprPtr,lSizeCpr); UncprPtr=(unsigned char*)malloc(lBufferSizeUncpr + BlockSizeUncompress); BeginCountPerfCounter(&li_qp,TRUE); dwGetTick=GetTickCount(); BeginCountRdtsc(&li_rdtsc); { z_stream zcpr; int ret=Z_OK; long lOrigToDo = lSizeCpr; long lOrigDone = 0; int step=0; memset(&zcpr,0,sizeof(z_stream)); inflateInit(&zcpr); zcpr.next_in = CprPtr; zcpr.next_out = UncprPtr; do { long all_read_before = zcpr.total_in; zcpr.avail_in = min(lOrigToDo,BlockSizeUncompress); zcpr.avail_out = BlockSizeUncompress; ret=inflate(&zcpr,Z_SYNC_FLUSH); lOrigDone += (zcpr.total_in-all_read_before); lOrigToDo -= (zcpr.total_in-all_read_before); step++; } while (ret==Z_OK); lSizeUncpr=zcpr.total_out; inflateEnd(&zcpr); dwGetTick=GetTickCount()-dwGetTick; dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE); dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE); printf("total uncompress size = %u, in %u step\n",lSizeUncpr,step); printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.); printf("uncpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.); printf("uncpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart); } if (lSizeUncpr==lFileSize) { if (memcmp(FilePtr,UncprPtr,lFileSize)==0) printf("compare ok\n"); } return 0; } tcl8.6.14/compat/zlib/contrib/testzlib/testzlib.txt0000644000175000017500000000031514554262142021765 0ustar sergeisergeiTo build testzLib with Visual Studio 2005: copy to a directory file from : - root of zLib tree - contrib/testzlib - contrib/masmx86 - contrib/masmx64 - contrib/vstudio/vc7 and open testzlib8.slntcl8.6.14/compat/zlib/contrib/asm686/0000755000175000017500000000000014566153412016553 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/asm686/match.S0000644000175000017500000002417514554262142020002 0ustar sergeisergei/* match.S -- x86 assembly version of the zlib longest_match() function. * Optimized for the Intel 686 chips (PPro and later). * * Copyright (C) 1998, 2007 Brian Raiter * * This software is provided 'as-is', without any express or implied * warranty. In no event will the author be held liable for any damages * arising from the use of this software. * * Permission is granted to anyone to use this software for any purpose, * including commercial applications, and to alter it and redistribute it * freely, subject to the following restrictions: * * 1. The origin of this software must not be misrepresented; you must not * claim that you wrote the original software. If you use this software * in a product, an acknowledgment in the product documentation would be * appreciated but is not required. * 2. Altered source versions must be plainly marked as such, and must not be * misrepresented as being the original software. * 3. This notice may not be removed or altered from any source distribution. */ #ifndef NO_UNDERLINE #define match_init _match_init #define longest_match _longest_match #endif #define MAX_MATCH (258) #define MIN_MATCH (3) #define MIN_LOOKAHEAD (MAX_MATCH + MIN_MATCH + 1) #define MAX_MATCH_8 ((MAX_MATCH + 7) & ~7) /* stack frame offsets */ #define chainlenwmask 0 /* high word: current chain len */ /* low word: s->wmask */ #define window 4 /* local copy of s->window */ #define windowbestlen 8 /* s->window + bestlen */ #define scanstart 16 /* first two bytes of string */ #define scanend 12 /* last two bytes of string */ #define scanalign 20 /* dword-misalignment of string */ #define nicematch 24 /* a good enough match size */ #define bestlen 28 /* size of best match so far */ #define scan 32 /* ptr to string wanting match */ #define LocalVarsSize (36) /* saved ebx 36 */ /* saved edi 40 */ /* saved esi 44 */ /* saved ebp 48 */ /* return address 52 */ #define deflatestate 56 /* the function arguments */ #define curmatch 60 /* All the +zlib1222add offsets are due to the addition of fields * in zlib in the deflate_state structure since the asm code was first written * (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)"). * (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0"). * if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8"). */ #define zlib1222add (8) #define dsWSize (36+zlib1222add) #define dsWMask (44+zlib1222add) #define dsWindow (48+zlib1222add) #define dsPrev (56+zlib1222add) #define dsMatchLen (88+zlib1222add) #define dsPrevMatch (92+zlib1222add) #define dsStrStart (100+zlib1222add) #define dsMatchStart (104+zlib1222add) #define dsLookahead (108+zlib1222add) #define dsPrevLen (112+zlib1222add) #define dsMaxChainLen (116+zlib1222add) #define dsGoodMatch (132+zlib1222add) #define dsNiceMatch (136+zlib1222add) .file "match.S" .globl match_init, longest_match .text /* uInt longest_match(deflate_state *deflatestate, IPos curmatch) */ .cfi_sections .debug_frame longest_match: .cfi_startproc /* Save registers that the compiler may be using, and adjust %esp to */ /* make room for our stack frame. */ pushl %ebp .cfi_def_cfa_offset 8 .cfi_offset ebp, -8 pushl %edi .cfi_def_cfa_offset 12 pushl %esi .cfi_def_cfa_offset 16 pushl %ebx .cfi_def_cfa_offset 20 subl $LocalVarsSize, %esp .cfi_def_cfa_offset LocalVarsSize+20 /* Retrieve the function arguments. %ecx will hold cur_match */ /* throughout the entire function. %edx will hold the pointer to the */ /* deflate_state structure during the function's setup (before */ /* entering the main loop). */ movl deflatestate(%esp), %edx movl curmatch(%esp), %ecx /* uInt wmask = s->w_mask; */ /* unsigned chain_length = s->max_chain_length; */ /* if (s->prev_length >= s->good_match) { */ /* chain_length >>= 2; */ /* } */ movl dsPrevLen(%edx), %eax movl dsGoodMatch(%edx), %ebx cmpl %ebx, %eax movl dsWMask(%edx), %eax movl dsMaxChainLen(%edx), %ebx jl LastMatchGood shrl $2, %ebx LastMatchGood: /* chainlen is decremented once beforehand so that the function can */ /* use the sign flag instead of the zero flag for the exit test. */ /* It is then shifted into the high word, to make room for the wmask */ /* value, which it will always accompany. */ decl %ebx shll $16, %ebx orl %eax, %ebx movl %ebx, chainlenwmask(%esp) /* if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; */ movl dsNiceMatch(%edx), %eax movl dsLookahead(%edx), %ebx cmpl %eax, %ebx jl LookaheadLess movl %eax, %ebx LookaheadLess: movl %ebx, nicematch(%esp) /* register Bytef *scan = s->window + s->strstart; */ movl dsWindow(%edx), %esi movl %esi, window(%esp) movl dsStrStart(%edx), %ebp lea (%esi,%ebp), %edi movl %edi, scan(%esp) /* Determine how many bytes the scan ptr is off from being */ /* dword-aligned. */ movl %edi, %eax negl %eax andl $3, %eax movl %eax, scanalign(%esp) /* IPos limit = s->strstart > (IPos)MAX_DIST(s) ? */ /* s->strstart - (IPos)MAX_DIST(s) : NIL; */ movl dsWSize(%edx), %eax subl $MIN_LOOKAHEAD, %eax subl %eax, %ebp jg LimitPositive xorl %ebp, %ebp LimitPositive: /* int best_len = s->prev_length; */ movl dsPrevLen(%edx), %eax movl %eax, bestlen(%esp) /* Store the sum of s->window + best_len in %esi locally, and in %esi. */ addl %eax, %esi movl %esi, windowbestlen(%esp) /* register ush scan_start = *(ushf*)scan; */ /* register ush scan_end = *(ushf*)(scan+best_len-1); */ /* Posf *prev = s->prev; */ movzwl (%edi), %ebx movl %ebx, scanstart(%esp) movzwl -1(%edi,%eax), %ebx movl %ebx, scanend(%esp) movl dsPrev(%edx), %edi /* Jump into the main loop. */ movl chainlenwmask(%esp), %edx jmp LoopEntry .balign 16 /* do { * match = s->window + cur_match; * if (*(ushf*)(match+best_len-1) != scan_end || * *(ushf*)match != scan_start) continue; * [...] * } while ((cur_match = prev[cur_match & wmask]) > limit * && --chain_length != 0); * * Here is the inner loop of the function. The function will spend the * majority of its time in this loop, and majority of that time will * be spent in the first ten instructions. * * Within this loop: * %ebx = scanend * %ecx = curmatch * %edx = chainlenwmask - i.e., ((chainlen << 16) | wmask) * %esi = windowbestlen - i.e., (window + bestlen) * %edi = prev * %ebp = limit */ LookupLoop: andl %edx, %ecx movzwl (%edi,%ecx,2), %ecx cmpl %ebp, %ecx jbe LeaveNow subl $0x00010000, %edx js LeaveNow LoopEntry: movzwl -1(%esi,%ecx), %eax cmpl %ebx, %eax jnz LookupLoop movl window(%esp), %eax movzwl (%eax,%ecx), %eax cmpl scanstart(%esp), %eax jnz LookupLoop /* Store the current value of chainlen. */ movl %edx, chainlenwmask(%esp) /* Point %edi to the string under scrutiny, and %esi to the string we */ /* are hoping to match it up with. In actuality, %esi and %edi are */ /* both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and %edx is */ /* initialized to -(MAX_MATCH_8 - scanalign). */ movl window(%esp), %esi movl scan(%esp), %edi addl %ecx, %esi movl scanalign(%esp), %eax movl $(-MAX_MATCH_8), %edx lea MAX_MATCH_8(%edi,%eax), %edi lea MAX_MATCH_8(%esi,%eax), %esi /* Test the strings for equality, 8 bytes at a time. At the end, * adjust %edx so that it is offset to the exact byte that mismatched. * * We already know at this point that the first three bytes of the * strings match each other, and they can be safely passed over before * starting the compare loop. So what this code does is skip over 0-3 * bytes, as much as necessary in order to dword-align the %edi * pointer. (%esi will still be misaligned three times out of four.) * * It should be confessed that this loop usually does not represent * much of the total running time. Replacing it with a more * straightforward "rep cmpsb" would not drastically degrade * performance. */ LoopCmps: movl (%esi,%edx), %eax xorl (%edi,%edx), %eax jnz LeaveLoopCmps movl 4(%esi,%edx), %eax xorl 4(%edi,%edx), %eax jnz LeaveLoopCmps4 addl $8, %edx jnz LoopCmps jmp LenMaximum LeaveLoopCmps4: addl $4, %edx LeaveLoopCmps: testl $0x0000FFFF, %eax jnz LenLower addl $2, %edx shrl $16, %eax LenLower: subb $1, %al adcl $0, %edx /* Calculate the length of the match. If it is longer than MAX_MATCH, */ /* then automatically accept it as the best possible match and leave. */ lea (%edi,%edx), %eax movl scan(%esp), %edi subl %edi, %eax cmpl $MAX_MATCH, %eax jge LenMaximum /* If the length of the match is not longer than the best match we */ /* have so far, then forget it and return to the lookup loop. */ movl deflatestate(%esp), %edx movl bestlen(%esp), %ebx cmpl %ebx, %eax jg LongerMatch movl windowbestlen(%esp), %esi movl dsPrev(%edx), %edi movl scanend(%esp), %ebx movl chainlenwmask(%esp), %edx jmp LookupLoop /* s->match_start = cur_match; */ /* best_len = len; */ /* if (len >= nice_match) break; */ /* scan_end = *(ushf*)(scan+best_len-1); */ LongerMatch: movl nicematch(%esp), %ebx movl %eax, bestlen(%esp) movl %ecx, dsMatchStart(%edx) cmpl %ebx, %eax jge LeaveNow movl window(%esp), %esi addl %eax, %esi movl %esi, windowbestlen(%esp) movzwl -1(%edi,%eax), %ebx movl dsPrev(%edx), %edi movl %ebx, scanend(%esp) movl chainlenwmask(%esp), %edx jmp LookupLoop /* Accept the current string, with the maximum possible length. */ LenMaximum: movl deflatestate(%esp), %edx movl $MAX_MATCH, bestlen(%esp) movl %ecx, dsMatchStart(%edx) /* if ((uInt)best_len <= s->lookahead) return (uInt)best_len; */ /* return s->lookahead; */ LeaveNow: movl deflatestate(%esp), %edx movl bestlen(%esp), %ebx movl dsLookahead(%edx), %eax cmpl %eax, %ebx jg LookaheadRet movl %ebx, %eax LookaheadRet: /* Restore the stack and return from whence we came. */ addl $LocalVarsSize, %esp .cfi_def_cfa_offset 20 popl %ebx .cfi_def_cfa_offset 16 popl %esi .cfi_def_cfa_offset 12 popl %edi .cfi_def_cfa_offset 8 popl %ebp .cfi_def_cfa_offset 4 .cfi_endproc match_init: ret tcl8.6.14/compat/zlib/contrib/infback9/0000755000175000017500000000000014566153412017215 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/infback9/README0000644000175000017500000000006314554262142020072 0ustar sergeisergeiSee infback9.h for what this is and how to use it. tcl8.6.14/compat/zlib/contrib/infback9/inffix9.h0000644000175000017500000001470714554262142020751 0ustar sergeisergei /* inffix9.h -- table for decoding deflate64 fixed codes * Generated automatically by makefixed9(). */ /* WARNING: this file should *not* be used by applications. It is part of the implementation of this library and is subject to change. Applications should only use zlib.h. */ static const code lenfix[512] = { {96,7,0},{0,8,80},{0,8,16},{132,8,115},{130,7,31},{0,8,112}, {0,8,48},{0,9,192},{128,7,10},{0,8,96},{0,8,32},{0,9,160}, {0,8,0},{0,8,128},{0,8,64},{0,9,224},{128,7,6},{0,8,88}, {0,8,24},{0,9,144},{131,7,59},{0,8,120},{0,8,56},{0,9,208}, {129,7,17},{0,8,104},{0,8,40},{0,9,176},{0,8,8},{0,8,136}, {0,8,72},{0,9,240},{128,7,4},{0,8,84},{0,8,20},{133,8,227}, {131,7,43},{0,8,116},{0,8,52},{0,9,200},{129,7,13},{0,8,100}, {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232}, {128,7,8},{0,8,92},{0,8,28},{0,9,152},{132,7,83},{0,8,124}, {0,8,60},{0,9,216},{130,7,23},{0,8,108},{0,8,44},{0,9,184}, {0,8,12},{0,8,140},{0,8,76},{0,9,248},{128,7,3},{0,8,82}, {0,8,18},{133,8,163},{131,7,35},{0,8,114},{0,8,50},{0,9,196}, {129,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2},{0,8,130}, {0,8,66},{0,9,228},{128,7,7},{0,8,90},{0,8,26},{0,9,148}, {132,7,67},{0,8,122},{0,8,58},{0,9,212},{130,7,19},{0,8,106}, {0,8,42},{0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244}, {128,7,5},{0,8,86},{0,8,22},{65,8,0},{131,7,51},{0,8,118}, {0,8,54},{0,9,204},{129,7,15},{0,8,102},{0,8,38},{0,9,172}, {0,8,6},{0,8,134},{0,8,70},{0,9,236},{128,7,9},{0,8,94}, {0,8,30},{0,9,156},{132,7,99},{0,8,126},{0,8,62},{0,9,220}, {130,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142}, {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{133,8,131}, {130,7,31},{0,8,113},{0,8,49},{0,9,194},{128,7,10},{0,8,97}, {0,8,33},{0,9,162},{0,8,1},{0,8,129},{0,8,65},{0,9,226}, {128,7,6},{0,8,89},{0,8,25},{0,9,146},{131,7,59},{0,8,121}, {0,8,57},{0,9,210},{129,7,17},{0,8,105},{0,8,41},{0,9,178}, {0,8,9},{0,8,137},{0,8,73},{0,9,242},{128,7,4},{0,8,85}, {0,8,21},{144,8,3},{131,7,43},{0,8,117},{0,8,53},{0,9,202}, {129,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133}, {0,8,69},{0,9,234},{128,7,8},{0,8,93},{0,8,29},{0,9,154}, {132,7,83},{0,8,125},{0,8,61},{0,9,218},{130,7,23},{0,8,109}, {0,8,45},{0,9,186},{0,8,13},{0,8,141},{0,8,77},{0,9,250}, {128,7,3},{0,8,83},{0,8,19},{133,8,195},{131,7,35},{0,8,115}, {0,8,51},{0,9,198},{129,7,11},{0,8,99},{0,8,35},{0,9,166}, {0,8,3},{0,8,131},{0,8,67},{0,9,230},{128,7,7},{0,8,91}, {0,8,27},{0,9,150},{132,7,67},{0,8,123},{0,8,59},{0,9,214}, {130,7,19},{0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139}, {0,8,75},{0,9,246},{128,7,5},{0,8,87},{0,8,23},{77,8,0}, {131,7,51},{0,8,119},{0,8,55},{0,9,206},{129,7,15},{0,8,103}, {0,8,39},{0,9,174},{0,8,7},{0,8,135},{0,8,71},{0,9,238}, {128,7,9},{0,8,95},{0,8,31},{0,9,158},{132,7,99},{0,8,127}, {0,8,63},{0,9,222},{130,7,27},{0,8,111},{0,8,47},{0,9,190}, {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80}, {0,8,16},{132,8,115},{130,7,31},{0,8,112},{0,8,48},{0,9,193}, {128,7,10},{0,8,96},{0,8,32},{0,9,161},{0,8,0},{0,8,128}, {0,8,64},{0,9,225},{128,7,6},{0,8,88},{0,8,24},{0,9,145}, {131,7,59},{0,8,120},{0,8,56},{0,9,209},{129,7,17},{0,8,104}, {0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72},{0,9,241}, {128,7,4},{0,8,84},{0,8,20},{133,8,227},{131,7,43},{0,8,116}, {0,8,52},{0,9,201},{129,7,13},{0,8,100},{0,8,36},{0,9,169}, {0,8,4},{0,8,132},{0,8,68},{0,9,233},{128,7,8},{0,8,92}, {0,8,28},{0,9,153},{132,7,83},{0,8,124},{0,8,60},{0,9,217}, {130,7,23},{0,8,108},{0,8,44},{0,9,185},{0,8,12},{0,8,140}, {0,8,76},{0,9,249},{128,7,3},{0,8,82},{0,8,18},{133,8,163}, {131,7,35},{0,8,114},{0,8,50},{0,9,197},{129,7,11},{0,8,98}, {0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229}, {128,7,7},{0,8,90},{0,8,26},{0,9,149},{132,7,67},{0,8,122}, {0,8,58},{0,9,213},{130,7,19},{0,8,106},{0,8,42},{0,9,181}, {0,8,10},{0,8,138},{0,8,74},{0,9,245},{128,7,5},{0,8,86}, {0,8,22},{65,8,0},{131,7,51},{0,8,118},{0,8,54},{0,9,205}, {129,7,15},{0,8,102},{0,8,38},{0,9,173},{0,8,6},{0,8,134}, {0,8,70},{0,9,237},{128,7,9},{0,8,94},{0,8,30},{0,9,157}, {132,7,99},{0,8,126},{0,8,62},{0,9,221},{130,7,27},{0,8,110}, {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253}, {96,7,0},{0,8,81},{0,8,17},{133,8,131},{130,7,31},{0,8,113}, {0,8,49},{0,9,195},{128,7,10},{0,8,97},{0,8,33},{0,9,163}, {0,8,1},{0,8,129},{0,8,65},{0,9,227},{128,7,6},{0,8,89}, {0,8,25},{0,9,147},{131,7,59},{0,8,121},{0,8,57},{0,9,211}, {129,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9},{0,8,137}, {0,8,73},{0,9,243},{128,7,4},{0,8,85},{0,8,21},{144,8,3}, {131,7,43},{0,8,117},{0,8,53},{0,9,203},{129,7,13},{0,8,101}, {0,8,37},{0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235}, {128,7,8},{0,8,93},{0,8,29},{0,9,155},{132,7,83},{0,8,125}, {0,8,61},{0,9,219},{130,7,23},{0,8,109},{0,8,45},{0,9,187}, {0,8,13},{0,8,141},{0,8,77},{0,9,251},{128,7,3},{0,8,83}, {0,8,19},{133,8,195},{131,7,35},{0,8,115},{0,8,51},{0,9,199}, {129,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131}, {0,8,67},{0,9,231},{128,7,7},{0,8,91},{0,8,27},{0,9,151}, {132,7,67},{0,8,123},{0,8,59},{0,9,215},{130,7,19},{0,8,107}, {0,8,43},{0,9,183},{0,8,11},{0,8,139},{0,8,75},{0,9,247}, {128,7,5},{0,8,87},{0,8,23},{77,8,0},{131,7,51},{0,8,119}, {0,8,55},{0,9,207},{129,7,15},{0,8,103},{0,8,39},{0,9,175}, {0,8,7},{0,8,135},{0,8,71},{0,9,239},{128,7,9},{0,8,95}, {0,8,31},{0,9,159},{132,7,99},{0,8,127},{0,8,63},{0,9,223}, {130,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143}, {0,8,79},{0,9,255} }; static const code distfix[32] = { {128,5,1},{135,5,257},{131,5,17},{139,5,4097},{129,5,5}, {137,5,1025},{133,5,65},{141,5,16385},{128,5,3},{136,5,513}, {132,5,33},{140,5,8193},{130,5,9},{138,5,2049},{134,5,129}, {142,5,32769},{128,5,2},{135,5,385},{131,5,25},{139,5,6145}, {129,5,7},{137,5,1537},{133,5,97},{141,5,24577},{128,5,4}, {136,5,769},{132,5,49},{140,5,12289},{130,5,13},{138,5,3073}, {134,5,193},{142,5,49153} }; tcl8.6.14/compat/zlib/contrib/infback9/inftree9.h0000644000175000017500000000550114560736523021120 0ustar sergeisergei/* inftree9.h -- header to use inftree9.c * Copyright (C) 1995-2008 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* WARNING: this file should *not* be used by applications. It is part of the implementation of the compression library and is subject to change. Applications should only use zlib.h. */ /* Structure for decoding tables. Each entry provides either the information needed to do the operation requested by the code that indexed that table entry, or it provides a pointer to another table that indexes more bits of the code. op indicates whether the entry is a pointer to another table, a literal, a length or distance, an end-of-block, or an invalid code. For a table pointer, the low four bits of op is the number of index bits of that table. For a length or distance, the low four bits of op is the number of extra bits to get after the code. bits is the number of bits in this code or part of the code to drop off of the bit buffer. val is the actual byte to output in the case of a literal, the base length or distance, or the offset from the current table to the next table. Each entry is four bytes. */ typedef struct { unsigned char op; /* operation, extra bits, table bits */ unsigned char bits; /* bits in this part of the code */ unsigned short val; /* offset in table or code value */ } code; /* op values as set by inflate_table(): 00000000 - literal 0000tttt - table link, tttt != 0 is the number of table index bits 100eeeee - length or distance, eeee is the number of extra bits 01100000 - end of block 01000000 - invalid code */ /* Maximum size of the dynamic table. The maximum number of code structures is 1446, which is the sum of 852 for literal/length codes and 594 for distance codes. These values were found by exhaustive searches using the program examples/enough.c found in the zlib distribution. The arguments to that program are the number of symbols, the initial root table size, and the maximum bit length of a code. "enough 286 9 15" for literal/length codes returns 852, and "enough 32 6 15" for distance codes returns 594. The initial root table size (9 or 6) is found in the fifth argument of the inflate_table() calls in infback9.c. If the root table size is changed, then these maximum sizes would be need to be recalculated and updated. */ #define ENOUGH_LENS 852 #define ENOUGH_DISTS 594 #define ENOUGH (ENOUGH_LENS+ENOUGH_DISTS) /* Type of code to build for inflate_table9() */ typedef enum { CODES, LENS, DISTS } codetype; extern int inflate_table9(codetype type, unsigned short FAR *lens, unsigned codes, code FAR * FAR *table, unsigned FAR *bits, unsigned short FAR *work); tcl8.6.14/compat/zlib/contrib/infback9/inftree9.c0000644000175000017500000003213514560736523021116 0ustar sergeisergei/* inftree9.c -- generate Huffman trees for efficient decoding * Copyright (C) 1995-2024 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ #include "zutil.h" #include "inftree9.h" #define MAXBITS 15 const char inflate9_copyright[] = " inflate9 1.3.1 Copyright 1995-2024 Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot include such an acknowledgment, I would appreciate that you keep this copyright string in the executable of your product. */ /* Build a set of tables to decode the provided canonical Huffman code. The code lengths are lens[0..codes-1]. The result starts at *table, whose indices are 0..2^bits-1. work is a writable array of at least lens shorts, which is used as a work area. type is the type of code to be generated, CODES, LENS, or DISTS. On return, zero is success, -1 is an invalid code, and +1 means that ENOUGH isn't enough. table on return points to the next available entry's address. bits is the requested root table index bits, and on return it is the actual root table index bits. It will differ if the request is greater than the longest code or if it is less than the shortest code. */ int inflate_table9(codetype type, unsigned short FAR *lens, unsigned codes, code FAR * FAR *table, unsigned FAR *bits, unsigned short FAR *work) { unsigned len; /* a code's length in bits */ unsigned sym; /* index of code symbols */ unsigned min, max; /* minimum and maximum code lengths */ unsigned root; /* number of index bits for root table */ unsigned curr; /* number of index bits for current table */ unsigned drop; /* code bits to drop for sub-table */ int left; /* number of prefix codes available */ unsigned used; /* code entries in table used */ unsigned huff; /* Huffman code */ unsigned incr; /* for incrementing code, index */ unsigned fill; /* index for replicating entries */ unsigned low; /* low bits for current root entry */ unsigned mask; /* mask for low root bits */ code this; /* table entry for duplication */ code FAR *next; /* next available space in table */ const unsigned short FAR *base; /* base value table to use */ const unsigned short FAR *extra; /* extra bits table to use */ int end; /* use base and extra for symbol > end */ unsigned short count[MAXBITS+1]; /* number of codes of each length */ unsigned short offs[MAXBITS+1]; /* offsets in table for each length */ static const unsigned short lbase[31] = { /* Length codes 257..285 base */ 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 3, 0, 0}; static const unsigned short lext[31] = { /* Length codes 257..285 extra */ 128, 128, 128, 128, 128, 128, 128, 128, 129, 129, 129, 129, 130, 130, 130, 130, 131, 131, 131, 131, 132, 132, 132, 132, 133, 133, 133, 133, 144, 203, 77}; static const unsigned short dbase[32] = { /* Distance codes 0..31 base */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289, 16385, 24577, 32769, 49153}; static const unsigned short dext[32] = { /* Distance codes 0..31 extra */ 128, 128, 128, 128, 129, 129, 130, 130, 131, 131, 132, 132, 133, 133, 134, 134, 135, 135, 136, 136, 137, 137, 138, 138, 139, 139, 140, 140, 141, 141, 142, 142}; /* Process a set of code lengths to create a canonical Huffman code. The code lengths are lens[0..codes-1]. Each length corresponds to the symbols 0..codes-1. The Huffman code is generated by first sorting the symbols by length from short to long, and retaining the symbol order for codes with equal lengths. Then the code starts with all zero bits for the first code of the shortest length, and the codes are integer increments for the same length, and zeros are appended as the length increases. For the deflate format, these bits are stored backwards from their more natural integer increment ordering, and so when the decoding tables are built in the large loop below, the integer codes are incremented backwards. This routine assumes, but does not check, that all of the entries in lens[] are in the range 0..MAXBITS. The caller must assure this. 1..MAXBITS is interpreted as that code length. zero means that that symbol does not occur in this code. The codes are sorted by computing a count of codes for each length, creating from that a table of starting indices for each length in the sorted table, and then entering the symbols in order in the sorted table. The sorted table is work[], with that space being provided by the caller. The length counts are used for other purposes as well, i.e. finding the minimum and maximum length codes, determining if there are any codes at all, checking for a valid set of lengths, and looking ahead at length counts to determine sub-table sizes when building the decoding tables. */ /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */ for (len = 0; len <= MAXBITS; len++) count[len] = 0; for (sym = 0; sym < codes; sym++) count[lens[sym]]++; /* bound code lengths, force root to be within code lengths */ root = *bits; for (max = MAXBITS; max >= 1; max--) if (count[max] != 0) break; if (root > max) root = max; if (max == 0) return -1; /* no codes! */ for (min = 1; min <= MAXBITS; min++) if (count[min] != 0) break; if (root < min) root = min; /* check for an over-subscribed or incomplete set of lengths */ left = 1; for (len = 1; len <= MAXBITS; len++) { left <<= 1; left -= count[len]; if (left < 0) return -1; /* over-subscribed */ } if (left > 0 && (type == CODES || max != 1)) return -1; /* incomplete set */ /* generate offsets into symbol table for each length for sorting */ offs[1] = 0; for (len = 1; len < MAXBITS; len++) offs[len + 1] = offs[len] + count[len]; /* sort symbols by length, by symbol order within each length */ for (sym = 0; sym < codes; sym++) if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym; /* Create and fill in decoding tables. In this loop, the table being filled is at next and has curr index bits. The code being used is huff with length len. That code is converted to an index by dropping drop bits off of the bottom. For codes where len is less than drop + curr, those top drop + curr - len bits are incremented through all values to fill the table with replicated entries. root is the number of index bits for the root table. When len exceeds root, sub-tables are created pointed to by the root entry with an index of the low root bits of huff. This is saved in low to check for when a new sub-table should be started. drop is zero when the root table is being filled, and drop is root when sub-tables are being filled. When a new sub-table is needed, it is necessary to look ahead in the code lengths to determine what size sub-table is needed. The length counts are used for this, and so count[] is decremented as codes are entered in the tables. used keeps track of how many table entries have been allocated from the provided *table space. It is checked for LENS and DIST tables against the constants ENOUGH_LENS and ENOUGH_DISTS to guard against changes in the initial root table size constants. See the comments in inftree9.h for more information. sym increments through all symbols, and the loop terminates when all codes of length max, i.e. all codes, have been processed. This routine permits incomplete codes, so another loop after this one fills in the rest of the decoding tables with invalid code markers. */ /* set up for code type */ switch (type) { case CODES: base = extra = work; /* dummy value--not used */ end = 19; break; case LENS: base = lbase; base -= 257; extra = lext; extra -= 257; end = 256; break; default: /* DISTS */ base = dbase; extra = dext; end = -1; } /* initialize state for loop */ huff = 0; /* starting code */ sym = 0; /* starting code symbol */ len = min; /* starting code length */ next = *table; /* current table to fill in */ curr = root; /* current table index bits */ drop = 0; /* current bits to drop from code for index */ low = (unsigned)(-1); /* trigger new sub-table when len > root */ used = 1U << root; /* use root table entries */ mask = used - 1; /* mask for comparing low */ /* check available table space */ if ((type == LENS && used >= ENOUGH_LENS) || (type == DISTS && used >= ENOUGH_DISTS)) return 1; /* process all codes and make table entries */ for (;;) { /* create table entry */ this.bits = (unsigned char)(len - drop); if ((int)(work[sym]) < end) { this.op = (unsigned char)0; this.val = work[sym]; } else if ((int)(work[sym]) > end) { this.op = (unsigned char)(extra[work[sym]]); this.val = base[work[sym]]; } else { this.op = (unsigned char)(32 + 64); /* end of block */ this.val = 0; } /* replicate for those indices with low len bits equal to huff */ incr = 1U << (len - drop); fill = 1U << curr; do { fill -= incr; next[(huff >> drop) + fill] = this; } while (fill != 0); /* backwards increment the len-bit code huff */ incr = 1U << (len - 1); while (huff & incr) incr >>= 1; if (incr != 0) { huff &= incr - 1; huff += incr; } else huff = 0; /* go to next symbol, update count, len */ sym++; if (--(count[len]) == 0) { if (len == max) break; len = lens[work[sym]]; } /* create new sub-table if needed */ if (len > root && (huff & mask) != low) { /* if first time, transition to sub-tables */ if (drop == 0) drop = root; /* increment past last table */ next += 1U << curr; /* determine length of next table */ curr = len - drop; left = (int)(1 << curr); while (curr + drop < max) { left -= count[curr + drop]; if (left <= 0) break; curr++; left <<= 1; } /* check for enough space */ used += 1U << curr; if ((type == LENS && used >= ENOUGH_LENS) || (type == DISTS && used >= ENOUGH_DISTS)) return 1; /* point entry in root table to sub-table */ low = huff & mask; (*table)[low].op = (unsigned char)curr; (*table)[low].bits = (unsigned char)root; (*table)[low].val = (unsigned short)(next - *table); } } /* Fill in rest of table for incomplete codes. This loop is similar to the loop above in incrementing huff for table indices. It is assumed that len is equal to curr + drop, so there is no loop needed to increment through high index bits. When the current sub-table is filled, the loop drops back to the root table to fill in any remaining entries there. */ this.op = (unsigned char)64; /* invalid code marker */ this.bits = (unsigned char)(len - drop); this.val = (unsigned short)0; while (huff != 0) { /* when done with sub-table, drop back to root table */ if (drop != 0 && (huff & mask) != low) { drop = 0; len = root; next = *table; curr = root; this.bits = (unsigned char)len; } /* put invalid code marker in table */ next[huff >> drop] = this; /* backwards increment the len-bit code huff */ incr = 1U << (len - 1); while (huff & incr) incr >>= 1; if (incr != 0) { huff &= incr - 1; huff += incr; } else huff = 0; } /* set return parameters */ *table += used; *bits = root; return 0; } tcl8.6.14/compat/zlib/contrib/infback9/inflate9.h0000644000175000017500000000370714554262142021106 0ustar sergeisergei/* inflate9.h -- internal inflate state definition * Copyright (C) 1995-2003 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* WARNING: this file should *not* be used by applications. It is part of the implementation of the compression library and is subject to change. Applications should only use zlib.h. */ /* Possible inflate modes between inflate() calls */ typedef enum { TYPE, /* i: waiting for type bits, including last-flag bit */ STORED, /* i: waiting for stored size (length and complement) */ TABLE, /* i: waiting for dynamic block table lengths */ LEN, /* i: waiting for length/lit code */ DONE, /* finished check, done -- remain here until reset */ BAD /* got a data error -- remain here until reset */ } inflate_mode; /* State transitions between above modes - (most modes can go to the BAD mode -- not shown for clarity) Read deflate blocks: TYPE -> STORED or TABLE or LEN or DONE STORED -> TYPE TABLE -> LENLENS -> CODELENS -> LEN Read deflate codes: LEN -> LEN or TYPE */ /* state maintained between inflate() calls. Approximately 7K bytes. */ struct inflate_state { /* sliding window */ unsigned char FAR *window; /* allocated sliding window, if needed */ /* dynamic table building */ unsigned ncode; /* number of code length code lengths */ unsigned nlen; /* number of length code lengths */ unsigned ndist; /* number of distance code lengths */ unsigned have; /* number of code lengths in lens[] */ code FAR *next; /* next available space in codes[] */ unsigned short lens[320]; /* temporary storage for code lengths */ unsigned short work[288]; /* work area for code table building */ code codes[ENOUGH]; /* space for code tables */ }; tcl8.6.14/compat/zlib/contrib/infback9/infback9.c0000644000175000017500000005215014554262142021050 0ustar sergeisergei/* infback9.c -- inflate deflate64 data using a call-back interface * Copyright (C) 1995-2008 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ #include "zutil.h" #include "infback9.h" #include "inftree9.h" #include "inflate9.h" #define WSIZE 65536UL /* strm provides memory allocation functions in zalloc and zfree, or Z_NULL to use the library memory allocation functions. window is a user-supplied window and output buffer that is 64K bytes. */ int ZEXPORT inflateBack9Init_(z_stream FAR *strm, unsigned char FAR *window, const char *version, int stream_size) { struct inflate_state FAR *state; if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || stream_size != (int)(sizeof(z_stream))) return Z_VERSION_ERROR; if (strm == Z_NULL || window == Z_NULL) return Z_STREAM_ERROR; strm->msg = Z_NULL; /* in case we return an error */ if (strm->zalloc == (alloc_func)0) { strm->zalloc = zcalloc; strm->opaque = (voidpf)0; } if (strm->zfree == (free_func)0) strm->zfree = zcfree; state = (struct inflate_state FAR *)ZALLOC(strm, 1, sizeof(struct inflate_state)); if (state == Z_NULL) return Z_MEM_ERROR; Tracev((stderr, "inflate: allocated\n")); strm->state = (voidpf)state; state->window = window; return Z_OK; } /* Build and output length and distance decoding tables for fixed code decoding. */ #ifdef MAKEFIXED #include void makefixed9(void) { unsigned sym, bits, low, size; code *next, *lenfix, *distfix; struct inflate_state state; code fixed[544]; /* literal/length table */ sym = 0; while (sym < 144) state.lens[sym++] = 8; while (sym < 256) state.lens[sym++] = 9; while (sym < 280) state.lens[sym++] = 7; while (sym < 288) state.lens[sym++] = 8; next = fixed; lenfix = next; bits = 9; inflate_table9(LENS, state.lens, 288, &(next), &(bits), state.work); /* distance table */ sym = 0; while (sym < 32) state.lens[sym++] = 5; distfix = next; bits = 5; inflate_table9(DISTS, state.lens, 32, &(next), &(bits), state.work); /* write tables */ puts(" /* inffix9.h -- table for decoding deflate64 fixed codes"); puts(" * Generated automatically by makefixed9()."); puts(" */"); puts(""); puts(" /* WARNING: this file should *not* be used by applications."); puts(" It is part of the implementation of this library and is"); puts(" subject to change. Applications should only use zlib.h."); puts(" */"); puts(""); size = 1U << 9; printf(" static const code lenfix[%u] = {", size); low = 0; for (;;) { if ((low % 6) == 0) printf("\n "); printf("{%u,%u,%d}", lenfix[low].op, lenfix[low].bits, lenfix[low].val); if (++low == size) break; putchar(','); } puts("\n };"); size = 1U << 5; printf("\n static const code distfix[%u] = {", size); low = 0; for (;;) { if ((low % 5) == 0) printf("\n "); printf("{%u,%u,%d}", distfix[low].op, distfix[low].bits, distfix[low].val); if (++low == size) break; putchar(','); } puts("\n };"); } #endif /* MAKEFIXED */ /* Macros for inflateBack(): */ /* Clear the input bit accumulator */ #define INITBITS() \ do { \ hold = 0; \ bits = 0; \ } while (0) /* Assure that some input is available. If input is requested, but denied, then return a Z_BUF_ERROR from inflateBack(). */ #define PULL() \ do { \ if (have == 0) { \ have = in(in_desc, &next); \ if (have == 0) { \ next = Z_NULL; \ ret = Z_BUF_ERROR; \ goto inf_leave; \ } \ } \ } while (0) /* Get a byte of input into the bit accumulator, or return from inflateBack() with an error if there is no input available. */ #define PULLBYTE() \ do { \ PULL(); \ have--; \ hold += (unsigned long)(*next++) << bits; \ bits += 8; \ } while (0) /* Assure that there are at least n bits in the bit accumulator. If there is not enough available input to do that, then return from inflateBack() with an error. */ #define NEEDBITS(n) \ do { \ while (bits < (unsigned)(n)) \ PULLBYTE(); \ } while (0) /* Return the low n bits of the bit accumulator (n <= 16) */ #define BITS(n) \ ((unsigned)hold & ((1U << (n)) - 1)) /* Remove n bits from the bit accumulator */ #define DROPBITS(n) \ do { \ hold >>= (n); \ bits -= (unsigned)(n); \ } while (0) /* Remove zero to seven bits as needed to go to a byte boundary */ #define BYTEBITS() \ do { \ hold >>= bits & 7; \ bits -= bits & 7; \ } while (0) /* Assure that some output space is available, by writing out the window if it's full. If the write fails, return from inflateBack() with a Z_BUF_ERROR. */ #define ROOM() \ do { \ if (left == 0) { \ put = window; \ left = WSIZE; \ wrap = 1; \ if (out(out_desc, put, (unsigned)left)) { \ ret = Z_BUF_ERROR; \ goto inf_leave; \ } \ } \ } while (0) /* strm provides the memory allocation functions and window buffer on input, and provides information on the unused input on return. For Z_DATA_ERROR returns, strm will also provide an error message. in() and out() are the call-back input and output functions. When inflateBack() needs more input, it calls in(). When inflateBack() has filled the window with output, or when it completes with data in the window, it calls out() to write out the data. The application must not change the provided input until in() is called again or inflateBack() returns. The application must not change the window/output buffer until inflateBack() returns. in() and out() are called with a descriptor parameter provided in the inflateBack() call. This parameter can be a structure that provides the information required to do the read or write, as well as accumulated information on the input and output such as totals and check values. in() should return zero on failure. out() should return non-zero on failure. If either in() or out() fails, than inflateBack() returns a Z_BUF_ERROR. strm->next_in can be checked for Z_NULL to see whether it was in() or out() that caused in the error. Otherwise, inflateBack() returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format error, or Z_MEM_ERROR if it could not allocate memory for the state. inflateBack() can also return Z_STREAM_ERROR if the input parameters are not correct, i.e. strm is Z_NULL or the state was not initialized. */ int ZEXPORT inflateBack9(z_stream FAR *strm, in_func in, void FAR *in_desc, out_func out, void FAR *out_desc) { struct inflate_state FAR *state; z_const unsigned char FAR *next; /* next input */ unsigned char FAR *put; /* next output */ unsigned have; /* available input */ unsigned long left; /* available output */ inflate_mode mode; /* current inflate mode */ int lastblock; /* true if processing last block */ int wrap; /* true if the window has wrapped */ unsigned char FAR *window; /* allocated sliding window, if needed */ unsigned long hold; /* bit buffer */ unsigned bits; /* bits in bit buffer */ unsigned extra; /* extra bits needed */ unsigned long length; /* literal or length of data to copy */ unsigned long offset; /* distance back to copy string from */ unsigned long copy; /* number of stored or match bytes to copy */ unsigned char FAR *from; /* where to copy match bytes from */ code const FAR *lencode; /* starting table for length/literal codes */ code const FAR *distcode; /* starting table for distance codes */ unsigned lenbits; /* index bits for lencode */ unsigned distbits; /* index bits for distcode */ code here; /* current decoding table entry */ code last; /* parent table entry */ unsigned len; /* length to copy for repeats, bits to drop */ int ret; /* return code */ static const unsigned short order[19] = /* permutation of code lengths */ {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; #include "inffix9.h" /* Check that the strm exists and that the state was initialized */ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; /* Reset the state */ strm->msg = Z_NULL; mode = TYPE; lastblock = 0; wrap = 0; window = state->window; next = strm->next_in; have = next != Z_NULL ? strm->avail_in : 0; hold = 0; bits = 0; put = window; left = WSIZE; lencode = Z_NULL; distcode = Z_NULL; /* Inflate until end of block marked as last */ for (;;) switch (mode) { case TYPE: /* determine and dispatch block type */ if (lastblock) { BYTEBITS(); mode = DONE; break; } NEEDBITS(3); lastblock = BITS(1); DROPBITS(1); switch (BITS(2)) { case 0: /* stored block */ Tracev((stderr, "inflate: stored block%s\n", lastblock ? " (last)" : "")); mode = STORED; break; case 1: /* fixed block */ lencode = lenfix; lenbits = 9; distcode = distfix; distbits = 5; Tracev((stderr, "inflate: fixed codes block%s\n", lastblock ? " (last)" : "")); mode = LEN; /* decode codes */ break; case 2: /* dynamic block */ Tracev((stderr, "inflate: dynamic codes block%s\n", lastblock ? " (last)" : "")); mode = TABLE; break; case 3: strm->msg = (char *)"invalid block type"; mode = BAD; } DROPBITS(2); break; case STORED: /* get and verify stored block length */ BYTEBITS(); /* go to byte boundary */ NEEDBITS(32); if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { strm->msg = (char *)"invalid stored block lengths"; mode = BAD; break; } length = (unsigned)hold & 0xffff; Tracev((stderr, "inflate: stored length %lu\n", length)); INITBITS(); /* copy stored block from input to output */ while (length != 0) { copy = length; PULL(); ROOM(); if (copy > have) copy = have; if (copy > left) copy = left; zmemcpy(put, next, copy); have -= copy; next += copy; left -= copy; put += copy; length -= copy; } Tracev((stderr, "inflate: stored end\n")); mode = TYPE; break; case TABLE: /* get dynamic table entries descriptor */ NEEDBITS(14); state->nlen = BITS(5) + 257; DROPBITS(5); state->ndist = BITS(5) + 1; DROPBITS(5); state->ncode = BITS(4) + 4; DROPBITS(4); if (state->nlen > 286) { strm->msg = (char *)"too many length symbols"; mode = BAD; break; } Tracev((stderr, "inflate: table sizes ok\n")); /* get code length code lengths (not a typo) */ state->have = 0; while (state->have < state->ncode) { NEEDBITS(3); state->lens[order[state->have++]] = (unsigned short)BITS(3); DROPBITS(3); } while (state->have < 19) state->lens[order[state->have++]] = 0; state->next = state->codes; lencode = (code const FAR *)(state->next); lenbits = 7; ret = inflate_table9(CODES, state->lens, 19, &(state->next), &(lenbits), state->work); if (ret) { strm->msg = (char *)"invalid code lengths set"; mode = BAD; break; } Tracev((stderr, "inflate: code lengths ok\n")); /* get length and distance code code lengths */ state->have = 0; while (state->have < state->nlen + state->ndist) { for (;;) { here = lencode[BITS(lenbits)]; if ((unsigned)(here.bits) <= bits) break; PULLBYTE(); } if (here.val < 16) { NEEDBITS(here.bits); DROPBITS(here.bits); state->lens[state->have++] = here.val; } else { if (here.val == 16) { NEEDBITS(here.bits + 2); DROPBITS(here.bits); if (state->have == 0) { strm->msg = (char *)"invalid bit length repeat"; mode = BAD; break; } len = (unsigned)(state->lens[state->have - 1]); copy = 3 + BITS(2); DROPBITS(2); } else if (here.val == 17) { NEEDBITS(here.bits + 3); DROPBITS(here.bits); len = 0; copy = 3 + BITS(3); DROPBITS(3); } else { NEEDBITS(here.bits + 7); DROPBITS(here.bits); len = 0; copy = 11 + BITS(7); DROPBITS(7); } if (state->have + copy > state->nlen + state->ndist) { strm->msg = (char *)"invalid bit length repeat"; mode = BAD; break; } while (copy--) state->lens[state->have++] = (unsigned short)len; } } /* handle error breaks in while */ if (mode == BAD) break; /* check for end-of-block code (better have one) */ if (state->lens[256] == 0) { strm->msg = (char *)"invalid code -- missing end-of-block"; mode = BAD; break; } /* build code tables -- note: do not change the lenbits or distbits values here (9 and 6) without reading the comments in inftree9.h concerning the ENOUGH constants, which depend on those values */ state->next = state->codes; lencode = (code const FAR *)(state->next); lenbits = 9; ret = inflate_table9(LENS, state->lens, state->nlen, &(state->next), &(lenbits), state->work); if (ret) { strm->msg = (char *)"invalid literal/lengths set"; mode = BAD; break; } distcode = (code const FAR *)(state->next); distbits = 6; ret = inflate_table9(DISTS, state->lens + state->nlen, state->ndist, &(state->next), &(distbits), state->work); if (ret) { strm->msg = (char *)"invalid distances set"; mode = BAD; break; } Tracev((stderr, "inflate: codes ok\n")); mode = LEN; case LEN: /* get a literal, length, or end-of-block code */ for (;;) { here = lencode[BITS(lenbits)]; if ((unsigned)(here.bits) <= bits) break; PULLBYTE(); } if (here.op && (here.op & 0xf0) == 0) { last = here; for (;;) { here = lencode[last.val + (BITS(last.bits + last.op) >> last.bits)]; if ((unsigned)(last.bits + here.bits) <= bits) break; PULLBYTE(); } DROPBITS(last.bits); } DROPBITS(here.bits); length = (unsigned)here.val; /* process literal */ if (here.op == 0) { Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ? "inflate: literal '%c'\n" : "inflate: literal 0x%02x\n", here.val)); ROOM(); *put++ = (unsigned char)(length); left--; mode = LEN; break; } /* process end of block */ if (here.op & 32) { Tracevv((stderr, "inflate: end of block\n")); mode = TYPE; break; } /* invalid code */ if (here.op & 64) { strm->msg = (char *)"invalid literal/length code"; mode = BAD; break; } /* length code -- get extra bits, if any */ extra = (unsigned)(here.op) & 31; if (extra != 0) { NEEDBITS(extra); length += BITS(extra); DROPBITS(extra); } Tracevv((stderr, "inflate: length %lu\n", length)); /* get distance code */ for (;;) { here = distcode[BITS(distbits)]; if ((unsigned)(here.bits) <= bits) break; PULLBYTE(); } if ((here.op & 0xf0) == 0) { last = here; for (;;) { here = distcode[last.val + (BITS(last.bits + last.op) >> last.bits)]; if ((unsigned)(last.bits + here.bits) <= bits) break; PULLBYTE(); } DROPBITS(last.bits); } DROPBITS(here.bits); if (here.op & 64) { strm->msg = (char *)"invalid distance code"; mode = BAD; break; } offset = (unsigned)here.val; /* get distance extra bits, if any */ extra = (unsigned)(here.op) & 15; if (extra != 0) { NEEDBITS(extra); offset += BITS(extra); DROPBITS(extra); } if (offset > WSIZE - (wrap ? 0: left)) { strm->msg = (char *)"invalid distance too far back"; mode = BAD; break; } Tracevv((stderr, "inflate: distance %lu\n", offset)); /* copy match from window to output */ do { ROOM(); copy = WSIZE - offset; if (copy < left) { from = put + copy; copy = left - copy; } else { from = put - offset; copy = left; } if (copy > length) copy = length; length -= copy; left -= copy; do { *put++ = *from++; } while (--copy); } while (length != 0); break; case DONE: /* inflate stream terminated properly -- write leftover output */ ret = Z_STREAM_END; if (left < WSIZE) { if (out(out_desc, window, (unsigned)(WSIZE - left))) ret = Z_BUF_ERROR; } goto inf_leave; case BAD: ret = Z_DATA_ERROR; goto inf_leave; default: /* can't happen, but makes compilers happy */ ret = Z_STREAM_ERROR; goto inf_leave; } /* Return unused input */ inf_leave: strm->next_in = next; strm->avail_in = have; return ret; } int ZEXPORT inflateBack9End(z_stream FAR *strm) { if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) return Z_STREAM_ERROR; ZFREE(strm, strm->state); strm->state = Z_NULL; Tracev((stderr, "inflate: end\n")); return Z_OK; } tcl8.6.14/compat/zlib/contrib/infback9/infback9.h0000644000175000017500000000303414554262142021052 0ustar sergeisergei/* infback9.h -- header for using inflateBack9 functions * Copyright (C) 2003 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* * This header file and associated patches provide a decoder for PKWare's * undocumented deflate64 compression method (method 9). Use with infback9.c, * inftree9.h, inftree9.c, and inffix9.h. These patches are not supported. * This should be compiled with zlib, since it uses zutil.h and zutil.o. * This code has not yet been tested on 16-bit architectures. See the * comments in zlib.h for inflateBack() usage. These functions are used * identically, except that there is no windowBits parameter, and a 64K * window must be provided. Also if int's are 16 bits, then a zero for * the third parameter of the "out" function actually means 65536UL. * zlib.h must be included before this header file. */ #ifdef __cplusplus extern "C" { #endif ZEXTERN int ZEXPORT inflateBack9(z_stream FAR *strm, in_func in, void FAR *in_desc, out_func out, void FAR *out_desc); ZEXTERN int ZEXPORT inflateBack9End(z_stream FAR *strm); ZEXTERN int ZEXPORT inflateBack9Init_(z_stream FAR *strm, unsigned char FAR *window, const char *version, int stream_size); #define inflateBack9Init(strm, window) \ inflateBack9Init_((strm), (window), \ ZLIB_VERSION, sizeof(z_stream)) #ifdef __cplusplus } #endif tcl8.6.14/compat/zlib/contrib/dotzlib/0000755000175000017500000000000014570615667017210 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/dotzlib/readme.txt0000644000175000017500000000446614554262142021204 0ustar sergeisergeiThis directory contains a .Net wrapper class library for the ZLib1.dll The wrapper includes support for inflating/deflating memory buffers, .Net streaming wrappers for the gz streams part of zlib, and wrappers for the checksum parts of zlib. See DotZLib/UnitTests.cs for examples. Directory structure: -------------------- LICENSE_1_0.txt - License file. readme.txt - This file. DotZLib.chm - Class library documentation DotZLib.build - NAnt build file DotZLib.sln - Microsoft Visual Studio 2003 solution file DotZLib\*.cs - Source files for the class library Unit tests: ----------- The file DotZLib/UnitTests.cs contains unit tests for use with NUnit 2.1 or higher. To include unit tests in the build, define nunit before building. Build instructions: ------------------- 1. Using Visual Studio.Net 2003: Open DotZLib.sln in VS.Net and build from there. Output file (DotZLib.dll) will be found ./DotZLib/bin/release or ./DotZLib/bin/debug, depending on you are building the release or debug version of the library. Check DotZLib/UnitTests.cs for instructions on how to include unit tests in the build. 2. Using NAnt: Open a command prompt with access to the build environment and run nant in the same directory as the DotZLib.build file. You can define 2 properties on the nant command-line to control the build: debug={true|false} to toggle between release/debug builds (default=true). nunit={true|false} to include or exclude unit tests (default=true). Also the target clean will remove binaries. Output file (DotZLib.dll) will be found in either ./DotZLib/bin/release or ./DotZLib/bin/debug, depending on whether you are building the release or debug version of the library. Examples: nant -D:debug=false -D:nunit=false will build a release mode version of the library without unit tests. nant will build a debug version of the library with unit tests nant clean will remove all previously built files. --------------------------------- Copyright (c) Henrik Ravn 2004 Use, modification and distribution are subject to the Boost Software License, Version 1.0. (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib.build0000644000175000017500000000222714554262142021527 0ustar sergeisergeiяЛП A .Net wrapper library around ZLib1.dll tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib.sln0000644000175000017500000000161314554262142021222 0ustar sergeisergeiMicrosoft Visual Studio Solution File, Format Version 8.00 Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "DotZLib", "DotZLib\DotZLib.csproj", "{BB1EE0B1-1808-46CB-B786-949D91117FC5}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Global GlobalSection(SolutionConfiguration) = preSolution Debug = Debug Release = Release EndGlobalSection GlobalSection(ProjectConfiguration) = postSolution {BB1EE0B1-1808-46CB-B786-949D91117FC5}.Debug.ActiveCfg = Debug|.NET {BB1EE0B1-1808-46CB-B786-949D91117FC5}.Debug.Build.0 = Debug|.NET {BB1EE0B1-1808-46CB-B786-949D91117FC5}.Release.ActiveCfg = Release|.NET {BB1EE0B1-1808-46CB-B786-949D91117FC5}.Release.Build.0 = Release|.NET EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution EndGlobalSection GlobalSection(ExtensibilityAddIns) = postSolution EndGlobalSection EndGlobal tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/0000755000175000017500000000000014566153412020505 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs0000644000175000017500000002515314560736523023073 0ustar sergeisergei// // ТЉ Copyright Henrik Ravn 2004 // // Use, modification and distribution are subject to the Boost Software License, Version 1.0. // (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) // using System; using System.IO; using System.Runtime.InteropServices; namespace DotZLib { /// /// Implements a compressed , in GZip (.gz) format. /// public class GZipStream : Stream, IDisposable { #region Dll Imports [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] private static extern IntPtr gzopen(string name, string mode); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int gzclose(IntPtr gzFile); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int gzwrite(IntPtr gzFile, int data, int length); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int gzread(IntPtr gzFile, int data, int length); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int gzgetc(IntPtr gzFile); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int gzputc(IntPtr gzFile, int c); #endregion #region Private data private IntPtr _gzFile; private bool _isDisposed = false; private bool _isWriting; #endregion #region Constructors /// /// Creates a new file as a writeable GZipStream /// /// The name of the compressed file to create /// The compression level to use when adding data /// If an error occurred in the internal zlib function public GZipStream(string fileName, CompressLevel level) { _isWriting = true; _gzFile = gzopen(fileName, String.Format("wb{0}", (int)level)); if (_gzFile == IntPtr.Zero) throw new ZLibException(-1, "Could not open " + fileName); } /// /// Opens an existing file as a readable GZipStream /// /// The name of the file to open /// If an error occurred in the internal zlib function public GZipStream(string fileName) { _isWriting = false; _gzFile = gzopen(fileName, "rb"); if (_gzFile == IntPtr.Zero) throw new ZLibException(-1, "Could not open " + fileName); } #endregion #region Access properties /// /// Returns true of this stream can be read from, false otherwise /// public override bool CanRead { get { return !_isWriting; } } /// /// Returns false. /// public override bool CanSeek { get { return false; } } /// /// Returns true if this tsream is writeable, false otherwise /// public override bool CanWrite { get { return _isWriting; } } #endregion #region Destructor & IDispose stuff /// /// Destroys this instance /// ~GZipStream() { cleanUp(false); } /// /// Closes the external file handle /// public void Dispose() { cleanUp(true); } // Does the actual closing of the file handle. private void cleanUp(bool isDisposing) { if (!_isDisposed) { gzclose(_gzFile); _isDisposed = true; } } #endregion #region Basic reading and writing /// /// Attempts to read a number of bytes from the stream. /// /// The destination data buffer /// The index of the first destination byte in buffer /// The number of bytes requested /// The number of bytes read /// If buffer is null /// If count or offset are negative /// If offset + count is > buffer.Length /// If this stream is not readable. /// If this stream has been disposed. public override int Read(byte[] buffer, int offset, int count) { if (!CanRead) throw new NotSupportedException(); if (buffer == null) throw new ArgumentNullException(); if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); if ((offset+count) > buffer.Length) throw new ArgumentException(); if (_isDisposed) throw new ObjectDisposedException("GZipStream"); GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned); int result; try { result = gzread(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count); if (result < 0) throw new IOException(); } finally { h.Free(); } return result; } /// /// Attempts to read a single byte from the stream. /// /// The byte that was read, or -1 in case of error or End-Of-File public override int ReadByte() { if (!CanRead) throw new NotSupportedException(); if (_isDisposed) throw new ObjectDisposedException("GZipStream"); return gzgetc(_gzFile); } /// /// Writes a number of bytes to the stream /// /// /// /// /// If buffer is null /// If count or offset are negative /// If offset + count is > buffer.Length /// If this stream is not writeable. /// If this stream has been disposed. public override void Write(byte[] buffer, int offset, int count) { if (!CanWrite) throw new NotSupportedException(); if (buffer == null) throw new ArgumentNullException(); if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); if ((offset+count) > buffer.Length) throw new ArgumentException(); if (_isDisposed) throw new ObjectDisposedException("GZipStream"); GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned); try { int result = gzwrite(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count); if (result < 0) throw new IOException(); } finally { h.Free(); } } /// /// Writes a single byte to the stream /// /// The byte to add to the stream. /// If this stream is not writeable. /// If this stream has been disposed. public override void WriteByte(byte value) { if (!CanWrite) throw new NotSupportedException(); if (_isDisposed) throw new ObjectDisposedException("GZipStream"); int result = gzputc(_gzFile, (int)value); if (result < 0) throw new IOException(); } #endregion #region Position & length stuff /// /// Not supported. /// /// /// Always thrown public override void SetLength(long value) { throw new NotSupportedException(); } /// /// Not supported. /// /// /// /// /// Always thrown public override long Seek(long offset, SeekOrigin origin) { throw new NotSupportedException(); } /// /// Flushes the GZipStream. /// /// In this implementation, this method does nothing. This is because excessive /// flushing may degrade the achievable compression rates. public override void Flush() { // left empty on purpose } /// /// Gets/sets the current position in the GZipStream. Not supported. /// /// In this implementation this property is not supported /// Always thrown public override long Position { get { throw new NotSupportedException(); } set { throw new NotSupportedException(); } } /// /// Gets the size of the stream. Not supported. /// /// In this implementation this property is not supported /// Always thrown public override long Length { get { throw new NotSupportedException(); } } #endregion } } tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs0000644000175000017500000000706414560736523022613 0ustar sergeisergei// // ТЉ Copyright Henrik Ravn 2004 // // Use, modification and distribution are subject to the Boost Software License, Version 1.0. // (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) // using System; using System.Diagnostics; using System.Runtime.InteropServices; namespace DotZLib { /// /// Implements a data decompressor, using the inflate algorithm in the ZLib dll /// public class Inflater : CodecBase { #region Dll imports [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] private static extern int inflateInit_(ref ZStream sz, string vs, int size); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int inflate(ref ZStream sz, int flush); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int inflateReset(ref ZStream sz); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int inflateEnd(ref ZStream sz); #endregion /// /// Constructs an new instance of the Inflater /// public Inflater() : base() { int retval = inflateInit_(ref _ztream, Info.Version, Marshal.SizeOf(_ztream)); if (retval != 0) throw new ZLibException(retval, "Could not initialize inflater"); resetOutput(); } /// /// Adds more data to the codec to be processed. /// /// Byte array containing the data to be added to the codec /// The index of the first byte to add from data /// The number of bytes to add /// Adding data may, or may not, raise the DataAvailable event public override void Add(byte[] data, int offset, int count) { if (data == null) throw new ArgumentNullException(); if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); if ((offset+count) > data.Length) throw new ArgumentException(); int total = count; int inputIndex = offset; int err = 0; while (err >= 0 && inputIndex < total) { copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize)); err = inflate(ref _ztream, (int)FlushTypes.None); if (err == 0) while (_ztream.avail_out == 0) { OnDataAvailable(); err = inflate(ref _ztream, (int)FlushTypes.None); } inputIndex += (int)_ztream.total_in; } setChecksum( _ztream.adler ); } /// /// Finishes up any pending data that needs to be processed and handled. /// public override void Finish() { int err; do { err = inflate(ref _ztream, (int)FlushTypes.Finish); OnDataAvailable(); } while (err == 0); setChecksum( _ztream.adler ); inflateReset(ref _ztream); resetOutput(); } /// /// Closes the internal zlib inflate stream /// protected override void CleanUp() { inflateEnd(ref _ztream); } } } tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs0000644000175000017500000001724114560736523023431 0ustar sergeisergei// // ТЉ Copyright Henrik Ravn 2004 // // Use, modification and distribution are subject to the Boost Software License, Version 1.0. // (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) // using System; using System.Runtime.InteropServices; using System.Text; namespace DotZLib { #region ChecksumGeneratorBase /// /// Implements the common functionality needed for all s /// /// public abstract class ChecksumGeneratorBase : ChecksumGenerator { /// /// The value of the current checksum /// protected uint _current; /// /// Initializes a new instance of the checksum generator base - the current checksum is /// set to zero /// public ChecksumGeneratorBase() { _current = 0; } /// /// Initializes a new instance of the checksum generator base with a specified value /// /// The value to set the current checksum to public ChecksumGeneratorBase(uint initialValue) { _current = initialValue; } /// /// Resets the current checksum to zero /// public void Reset() { _current = 0; } /// /// Gets the current checksum value /// public uint Value { get { return _current; } } /// /// Updates the current checksum with part of an array of bytes /// /// The data to update the checksum with /// Where in data to start updating /// The number of bytes from data to use /// The sum of offset and count is larger than the length of data /// data is a null reference /// Offset or count is negative. /// All the other Update methods are implemented in terms of this one. /// This is therefore the only method a derived class has to implement public abstract void Update(byte[] data, int offset, int count); /// /// Updates the current checksum with an array of bytes. /// /// The data to update the checksum with public void Update(byte[] data) { Update(data, 0, data.Length); } /// /// Updates the current checksum with the data from a string /// /// The string to update the checksum with /// The characters in the string are converted by the UTF-8 encoding public void Update(string data) { Update(Encoding.UTF8.GetBytes(data)); } /// /// Updates the current checksum with the data from a string, using a specific encoding /// /// The string to update the checksum with /// The encoding to use public void Update(string data, Encoding encoding) { Update(encoding.GetBytes(data)); } } #endregion #region CRC32 /// /// Implements a CRC32 checksum generator /// public sealed class CRC32Checksum : ChecksumGeneratorBase { #region DLL imports [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern uint crc32(uint crc, int data, uint length); #endregion /// /// Initializes a new instance of the CRC32 checksum generator /// public CRC32Checksum() : base() {} /// /// Initializes a new instance of the CRC32 checksum generator with a specified value /// /// The value to set the current checksum to public CRC32Checksum(uint initialValue) : base(initialValue) {} /// /// Updates the current checksum with part of an array of bytes /// /// The data to update the checksum with /// Where in data to start updating /// The number of bytes from data to use /// The sum of offset and count is larger than the length of data /// data is a null reference /// Offset or count is negative. public override void Update(byte[] data, int offset, int count) { if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); if ((offset+count) > data.Length) throw new ArgumentException(); GCHandle hData = GCHandle.Alloc(data, GCHandleType.Pinned); try { _current = crc32(_current, hData.AddrOfPinnedObject().ToInt32()+offset, (uint)count); } finally { hData.Free(); } } } #endregion #region Adler /// /// Implements a checksum generator that computes the Adler checksum on data /// public sealed class AdlerChecksum : ChecksumGeneratorBase { #region DLL imports [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern uint adler32(uint adler, int data, uint length); #endregion /// /// Initializes a new instance of the Adler checksum generator /// public AdlerChecksum() : base() {} /// /// Initializes a new instance of the Adler checksum generator with a specified value /// /// The value to set the current checksum to public AdlerChecksum(uint initialValue) : base(initialValue) {} /// /// Updates the current checksum with part of an array of bytes /// /// The data to update the checksum with /// Where in data to start updating /// The number of bytes from data to use /// The sum of offset and count is larger than the length of data /// data is a null reference /// Offset or count is negative. public override void Update(byte[] data, int offset, int count) { if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); if ((offset+count) > data.Length) throw new ArgumentException(); GCHandle hData = GCHandle.Alloc(data, GCHandleType.Pinned); try { _current = adler32(_current, hData.AddrOfPinnedObject().ToInt32()+offset, (uint)count); } finally { hData.Free(); } } } #endregion }tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs0000644000175000017500000000416414560736523023743 0ustar sergeisergei// // ТЉ Copyright Henrik Ravn 2004 // // Use, modification and distribution are subject to the Boost Software License, Version 1.0. // (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) // using System; using System.Diagnostics; namespace DotZLib { /// /// This class implements a circular buffer /// internal class CircularBuffer { #region Private data private int _capacity; private int _head; private int _tail; private int _size; private byte[] _buffer; #endregion public CircularBuffer(int capacity) { Debug.Assert( capacity > 0 ); _buffer = new byte[capacity]; _capacity = capacity; _head = 0; _tail = 0; _size = 0; } public int Size { get { return _size; } } public int Put(byte[] source, int offset, int count) { Debug.Assert( count > 0 ); int trueCount = Math.Min(count, _capacity - Size); for (int i = 0; i < trueCount; ++i) _buffer[(_tail+i) % _capacity] = source[offset+i]; _tail += trueCount; _tail %= _capacity; _size += trueCount; return trueCount; } public bool Put(byte b) { if (Size == _capacity) // no room return false; _buffer[_tail++] = b; _tail %= _capacity; ++_size; return true; } public int Get(byte[] destination, int offset, int count) { int trueCount = Math.Min(count,Size); for (int i = 0; i < trueCount; ++i) destination[offset + i] = _buffer[(_head+i) % _capacity]; _head += trueCount; _head %= _capacity; _size -= trueCount; return trueCount; } public int Get() { if (Size == 0) return -1; int result = (int)_buffer[_head++ % _capacity]; --_size; return result; } } } tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/AssemblyInfo.cs0000644000175000017500000000470414554262142023432 0ustar sergeisergeiusing System.Reflection; using System.Runtime.CompilerServices; // // General Information about an assembly is controlled through the following // set of attributes. Change these attribute values to modify the information // associated with an assembly. // [assembly: AssemblyTitle("DotZLib")] [assembly: AssemblyDescription(".Net bindings for ZLib compression dll 1.2.x")] [assembly: AssemblyConfiguration("")] [assembly: AssemblyCompany("Henrik Ravn")] [assembly: AssemblyProduct("")] [assembly: AssemblyCopyright("(c) 2004 by Henrik Ravn")] [assembly: AssemblyTrademark("")] [assembly: AssemblyCulture("")] // // Version information for an assembly consists of the following four values: // // Major Version // Minor Version // Build Number // Revision // // You can specify all the values or you can default the Revision and Build Numbers // by using the '*' as shown below: [assembly: AssemblyVersion("1.0.*")] // // In order to sign your assembly you must specify a key to use. Refer to the // Microsoft .NET Framework documentation for more information on assembly signing. // // Use the attributes below to control which key is used for signing. // // Notes: // (*) If no key is specified, the assembly is not signed. // (*) KeyName refers to a key that has been installed in the Crypto Service // Provider (CSP) on your machine. KeyFile refers to a file which contains // a key. // (*) If the KeyFile and the KeyName values are both specified, the // following processing occurs: // (1) If the KeyName can be found in the CSP, that key is used. // (2) If the KeyName does not exist and the KeyFile does exist, the key // in the KeyFile is installed into the CSP and used. // (*) In order to create a KeyFile, you can use the sn.exe (Strong Name) utility. // When specifying the KeyFile, the location of the KeyFile should be // relative to the project output directory which is // %Project Directory%\obj\. For example, if your KeyFile is // located in the project directory, you would specify the AssemblyKeyFile // attribute as [assembly: AssemblyKeyFile("..\\..\\mykey.snk")] // (*) Delay Signing is an advanced option - see the Microsoft .NET Framework // documentation for more information on this. // [assembly: AssemblyDelaySign(false)] [assembly: AssemblyKeyFile("")] [assembly: AssemblyKeyName("")] tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs0000644000175000017500000001377114560736523022661 0ustar sergeisergei// // ТЉ Copyright Henrik Ravn 2004 // // Use, modification and distribution are subject to the Boost Software License, Version 1.0. // (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) // using System; using System.Runtime.InteropServices; namespace DotZLib { /// /// Implements the common functionality needed for all s /// public abstract class CodecBase : Codec, IDisposable { #region Data members /// /// Instance of the internal zlib buffer structure that is /// passed to all functions in the zlib dll /// internal ZStream _ztream = new ZStream(); /// /// True if the object instance has been disposed, false otherwise /// protected bool _isDisposed = false; /// /// The size of the internal buffers /// protected const int kBufferSize = 16384; private byte[] _outBuffer = new byte[kBufferSize]; private byte[] _inBuffer = new byte[kBufferSize]; private GCHandle _hInput; private GCHandle _hOutput; private uint _checksum = 0; #endregion /// /// Initializes a new instance of the CodeBase class. /// public CodecBase() { try { _hInput = GCHandle.Alloc(_inBuffer, GCHandleType.Pinned); _hOutput = GCHandle.Alloc(_outBuffer, GCHandleType.Pinned); } catch (Exception) { CleanUp(false); throw; } } #region Codec Members /// /// Occurs when more processed data are available. /// public event DataAvailableHandler DataAvailable; /// /// Fires the event /// protected void OnDataAvailable() { if (_ztream.total_out > 0) { if (DataAvailable != null) DataAvailable( _outBuffer, 0, (int)_ztream.total_out); resetOutput(); } } /// /// Adds more data to the codec to be processed. /// /// Byte array containing the data to be added to the codec /// Adding data may, or may not, raise the DataAvailable event public void Add(byte[] data) { Add(data,0,data.Length); } /// /// Adds more data to the codec to be processed. /// /// Byte array containing the data to be added to the codec /// The index of the first byte to add from data /// The number of bytes to add /// Adding data may, or may not, raise the DataAvailable event /// This must be implemented by a derived class public abstract void Add(byte[] data, int offset, int count); /// /// Finishes up any pending data that needs to be processed and handled. /// /// This must be implemented by a derived class public abstract void Finish(); /// /// Gets the checksum of the data that has been added so far /// public uint Checksum { get { return _checksum; } } #endregion #region Destructor & IDisposable stuff /// /// Destroys this instance /// ~CodecBase() { CleanUp(false); } /// /// Releases any unmanaged resources and calls the method of the derived class /// public void Dispose() { CleanUp(true); } /// /// Performs any codec specific cleanup /// /// This must be implemented by a derived class protected abstract void CleanUp(); // performs the release of the handles and calls the derived CleanUp() private void CleanUp(bool isDisposing) { if (!_isDisposed) { CleanUp(); if (_hInput.IsAllocated) _hInput.Free(); if (_hOutput.IsAllocated) _hOutput.Free(); _isDisposed = true; } } #endregion #region Helper methods /// /// Copies a number of bytes to the internal codec buffer - ready for processing /// /// The byte array that contains the data to copy /// The index of the first byte to copy /// The number of bytes to copy from data protected void copyInput(byte[] data, int startIndex, int count) { Array.Copy(data, startIndex, _inBuffer,0, count); _ztream.next_in = _hInput.AddrOfPinnedObject(); _ztream.total_in = 0; _ztream.avail_in = (uint)count; } /// /// Resets the internal output buffers to a known state - ready for processing /// protected void resetOutput() { _ztream.total_out = 0; _ztream.avail_out = kBufferSize; _ztream.next_out = _hOutput.AddrOfPinnedObject(); } /// /// Updates the running checksum property /// /// The new checksum value protected void setChecksum(uint newSum) { _checksum = newSum; } #endregion } } tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs0000644000175000017500000001700414560736523023004 0ustar sergeisergei// // ТЉ Copyright Henrik Ravn 2004 // // Use, modification and distribution are subject to the Boost Software License, Version 1.0. // (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) // using System; using System.Collections; using System.IO; // uncomment the define below to include unit tests //#define nunit #if nunit using NUnit.Framework; // Unit tests for the DotZLib class library // ---------------------------------------- // // Use this with NUnit 2 from http://www.nunit.org // namespace DotZLibTests { using DotZLib; // helper methods internal class Utils { public static bool byteArrEqual( byte[] lhs, byte[] rhs ) { if (lhs.Length != rhs.Length) return false; for (int i = lhs.Length-1; i >= 0; --i) if (lhs[i] != rhs[i]) return false; return true; } } [TestFixture] public class CircBufferTests { #region Circular buffer tests [Test] public void SinglePutGet() { CircularBuffer buf = new CircularBuffer(10); Assert.AreEqual( 0, buf.Size ); Assert.AreEqual( -1, buf.Get() ); Assert.IsTrue(buf.Put( 1 )); Assert.AreEqual( 1, buf.Size ); Assert.AreEqual( 1, buf.Get() ); Assert.AreEqual( 0, buf.Size ); Assert.AreEqual( -1, buf.Get() ); } [Test] public void BlockPutGet() { CircularBuffer buf = new CircularBuffer(10); byte[] arr = {1,2,3,4,5,6,7,8,9,10}; Assert.AreEqual( 10, buf.Put(arr,0,10) ); Assert.AreEqual( 10, buf.Size ); Assert.IsFalse( buf.Put(11) ); Assert.AreEqual( 1, buf.Get() ); Assert.IsTrue( buf.Put(11) ); byte[] arr2 = (byte[])arr.Clone(); Assert.AreEqual( 9, buf.Get(arr2,1,9) ); Assert.IsTrue( Utils.byteArrEqual(arr,arr2) ); } #endregion } [TestFixture] public class ChecksumTests { #region CRC32 Tests [Test] public void CRC32_Null() { CRC32Checksum crc32 = new CRC32Checksum(); Assert.AreEqual( 0, crc32.Value ); crc32 = new CRC32Checksum(1); Assert.AreEqual( 1, crc32.Value ); crc32 = new CRC32Checksum(556); Assert.AreEqual( 556, crc32.Value ); } [Test] public void CRC32_Data() { CRC32Checksum crc32 = new CRC32Checksum(); byte[] data = { 1,2,3,4,5,6,7 }; crc32.Update(data); Assert.AreEqual( 0x70e46888, crc32.Value ); crc32 = new CRC32Checksum(); crc32.Update("penguin"); Assert.AreEqual( 0x0e5c1a120, crc32.Value ); crc32 = new CRC32Checksum(1); crc32.Update("penguin"); Assert.AreEqual(0x43b6aa94, crc32.Value); } #endregion #region Adler tests [Test] public void Adler_Null() { AdlerChecksum adler = new AdlerChecksum(); Assert.AreEqual(0, adler.Value); adler = new AdlerChecksum(1); Assert.AreEqual( 1, adler.Value ); adler = new AdlerChecksum(556); Assert.AreEqual( 556, adler.Value ); } [Test] public void Adler_Data() { AdlerChecksum adler = new AdlerChecksum(1); byte[] data = { 1,2,3,4,5,6,7 }; adler.Update(data); Assert.AreEqual( 0x5b001d, adler.Value ); adler = new AdlerChecksum(); adler.Update("penguin"); Assert.AreEqual(0x0bcf02f6, adler.Value ); adler = new AdlerChecksum(1); adler.Update("penguin"); Assert.AreEqual(0x0bd602f7, adler.Value); } #endregion } [TestFixture] public class InfoTests { #region Info tests [Test] public void Info_Version() { Info info = new Info(); Assert.AreEqual("1.3.1", Info.Version); Assert.AreEqual(32, info.SizeOfUInt); Assert.AreEqual(32, info.SizeOfULong); Assert.AreEqual(32, info.SizeOfPointer); Assert.AreEqual(32, info.SizeOfOffset); } #endregion } [TestFixture] public class DeflateInflateTests { #region Deflate tests [Test] public void Deflate_Init() { using (Deflater def = new Deflater(CompressLevel.Default)) { } } private ArrayList compressedData = new ArrayList(); private uint adler1; private ArrayList uncompressedData = new ArrayList(); private uint adler2; public void CDataAvail(byte[] data, int startIndex, int count) { for (int i = 0; i < count; ++i) compressedData.Add(data[i+startIndex]); } [Test] public void Deflate_Compress() { compressedData.Clear(); byte[] testData = new byte[35000]; for (int i = 0; i < testData.Length; ++i) testData[i] = 5; using (Deflater def = new Deflater((CompressLevel)5)) { def.DataAvailable += new DataAvailableHandler(CDataAvail); def.Add(testData); def.Finish(); adler1 = def.Checksum; } } #endregion #region Inflate tests [Test] public void Inflate_Init() { using (Inflater inf = new Inflater()) { } } private void DDataAvail(byte[] data, int startIndex, int count) { for (int i = 0; i < count; ++i) uncompressedData.Add(data[i+startIndex]); } [Test] public void Inflate_Expand() { uncompressedData.Clear(); using (Inflater inf = new Inflater()) { inf.DataAvailable += new DataAvailableHandler(DDataAvail); inf.Add((byte[])compressedData.ToArray(typeof(byte))); inf.Finish(); adler2 = inf.Checksum; } Assert.AreEqual( adler1, adler2 ); } #endregion } [TestFixture] public class GZipStreamTests { #region GZipStream test [Test] public void GZipStream_WriteRead() { using (GZipStream gzOut = new GZipStream("gzstream.gz", CompressLevel.Best)) { BinaryWriter writer = new BinaryWriter(gzOut); writer.Write("hi there"); writer.Write(Math.PI); writer.Write(42); } using (GZipStream gzIn = new GZipStream("gzstream.gz")) { BinaryReader reader = new BinaryReader(gzIn); string s = reader.ReadString(); Assert.AreEqual("hi there",s); double d = reader.ReadDouble(); Assert.AreEqual(Math.PI, d); int i = reader.ReadInt32(); Assert.AreEqual(42,i); } } #endregion } } #endif tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs0000644000175000017500000002265014560736523022354 0ustar sergeisergei// // ТЉ Copyright Henrik Ravn 2004 // // Use, modification and distribution are subject to the Boost Software License, Version 1.0. // (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) // using System; using System.IO; using System.Runtime.InteropServices; using System.Text; namespace DotZLib { #region Internal types /// /// Defines constants for the various flush types used with zlib /// internal enum FlushTypes { None, Partial, Sync, Full, Finish, Block } #region ZStream structure // internal mapping of the zlib zstream structure for marshalling [StructLayoutAttribute(LayoutKind.Sequential, Pack=4, Size=0, CharSet=CharSet.Ansi)] internal struct ZStream { public IntPtr next_in; public uint avail_in; public uint total_in; public IntPtr next_out; public uint avail_out; public uint total_out; [MarshalAs(UnmanagedType.LPStr)] string msg; uint state; uint zalloc; uint zfree; uint opaque; int data_type; public uint adler; uint reserved; } #endregion #endregion #region Public enums /// /// Defines constants for the available compression levels in zlib /// public enum CompressLevel : int { /// /// The default compression level with a reasonable compromise between compression and speed /// Default = -1, /// /// No compression at all. The data are passed straight through. /// None = 0, /// /// The maximum compression rate available. /// Best = 9, /// /// The fastest available compression level. /// Fastest = 1 } #endregion #region Exception classes /// /// The exception that is thrown when an error occurs on the zlib dll /// public class ZLibException : ApplicationException { /// /// Initializes a new instance of the class with a specified /// error message and error code /// /// The zlib error code that caused the exception /// A message that (hopefully) describes the error public ZLibException(int errorCode, string msg) : base(String.Format("ZLib error {0} {1}", errorCode, msg)) { } /// /// Initializes a new instance of the class with a specified /// error code /// /// The zlib error code that caused the exception public ZLibException(int errorCode) : base(String.Format("ZLib error {0}", errorCode)) { } } #endregion #region Interfaces /// /// Declares methods and properties that enables a running checksum to be calculated /// public interface ChecksumGenerator { /// /// Gets the current value of the checksum /// uint Value { get; } /// /// Clears the current checksum to 0 /// void Reset(); /// /// Updates the current checksum with an array of bytes /// /// The data to update the checksum with void Update(byte[] data); /// /// Updates the current checksum with part of an array of bytes /// /// The data to update the checksum with /// Where in data to start updating /// The number of bytes from data to use /// The sum of offset and count is larger than the length of data /// data is a null reference /// Offset or count is negative. void Update(byte[] data, int offset, int count); /// /// Updates the current checksum with the data from a string /// /// The string to update the checksum with /// The characters in the string are converted by the UTF-8 encoding void Update(string data); /// /// Updates the current checksum with the data from a string, using a specific encoding /// /// The string to update the checksum with /// The encoding to use void Update(string data, Encoding encoding); } /// /// Represents the method that will be called from a codec when new data /// are available. /// /// The byte array containing the processed data /// The index of the first processed byte in data /// The number of processed bytes available /// On return from this method, the data may be overwritten, so grab it while you can. /// You cannot assume that startIndex will be zero. /// public delegate void DataAvailableHandler(byte[] data, int startIndex, int count); /// /// Declares methods and events for implementing compressors/decompressors /// public interface Codec { /// /// Occurs when more processed data are available. /// event DataAvailableHandler DataAvailable; /// /// Adds more data to the codec to be processed. /// /// Byte array containing the data to be added to the codec /// Adding data may, or may not, raise the DataAvailable event void Add(byte[] data); /// /// Adds more data to the codec to be processed. /// /// Byte array containing the data to be added to the codec /// The index of the first byte to add from data /// The number of bytes to add /// Adding data may, or may not, raise the DataAvailable event void Add(byte[] data, int offset, int count); /// /// Finishes up any pending data that needs to be processed and handled. /// void Finish(); /// /// Gets the checksum of the data that has been added so far /// uint Checksum { get; } } #endregion #region Classes /// /// Encapsulates general information about the ZLib library /// public class Info { #region DLL imports [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern uint zlibCompileFlags(); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern string zlibVersion(); #endregion #region Private stuff private uint _flags; // helper function that unpacks a bitsize mask private static int bitSize(uint bits) { switch (bits) { case 0: return 16; case 1: return 32; case 2: return 64; } return -1; } #endregion /// /// Constructs an instance of the Info class. /// public Info() { _flags = zlibCompileFlags(); } /// /// True if the library is compiled with debug info /// public bool HasDebugInfo { get { return 0 != (_flags & 0x100); } } /// /// True if the library is compiled with assembly optimizations /// public bool UsesAssemblyCode { get { return 0 != (_flags & 0x200); } } /// /// Gets the size of the unsigned int that was compiled into Zlib /// public int SizeOfUInt { get { return bitSize(_flags & 3); } } /// /// Gets the size of the unsigned long that was compiled into Zlib /// public int SizeOfULong { get { return bitSize((_flags >> 2) & 3); } } /// /// Gets the size of the pointers that were compiled into Zlib /// public int SizeOfPointer { get { return bitSize((_flags >> 4) & 3); } } /// /// Gets the size of the z_off_t type that was compiled into Zlib /// public int SizeOfOffset { get { return bitSize((_flags >> 6) & 3); } } /// /// Gets the version of ZLib as a string, e.g. "1.2.1" /// public static string Version { get { return zlibVersion(); } } } #endregion } tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.csproj0000644000175000017500000001242414554262142023237 0ustar sergeisergei tcl8.6.14/compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs0000644000175000017500000000745714560736523022603 0ustar sergeisergei// // ТЉ Copyright Henrik Ravn 2004 // // Use, modification and distribution are subject to the Boost Software License, Version 1.0. // (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) // using System; using System.Diagnostics; using System.Runtime.InteropServices; namespace DotZLib { /// /// Implements a data compressor, using the deflate algorithm in the ZLib dll /// public sealed class Deflater : CodecBase { #region Dll imports [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] private static extern int deflateInit_(ref ZStream sz, int level, string vs, int size); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int deflate(ref ZStream sz, int flush); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int deflateReset(ref ZStream sz); [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] private static extern int deflateEnd(ref ZStream sz); #endregion /// /// Constructs an new instance of the Deflater /// /// The compression level to use for this Deflater public Deflater(CompressLevel level) : base() { int retval = deflateInit_(ref _ztream, (int)level, Info.Version, Marshal.SizeOf(_ztream)); if (retval != 0) throw new ZLibException(retval, "Could not initialize deflater"); resetOutput(); } /// /// Adds more data to the codec to be processed. /// /// Byte array containing the data to be added to the codec /// The index of the first byte to add from data /// The number of bytes to add /// Adding data may, or may not, raise the DataAvailable event public override void Add(byte[] data, int offset, int count) { if (data == null) throw new ArgumentNullException(); if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); if ((offset+count) > data.Length) throw new ArgumentException(); int total = count; int inputIndex = offset; int err = 0; while (err >= 0 && inputIndex < total) { copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize)); while (err >= 0 && _ztream.avail_in > 0) { err = deflate(ref _ztream, (int)FlushTypes.None); if (err == 0) while (_ztream.avail_out == 0) { OnDataAvailable(); err = deflate(ref _ztream, (int)FlushTypes.None); } inputIndex += (int)_ztream.total_in; } } setChecksum( _ztream.adler ); } /// /// Finishes up any pending data that needs to be processed and handled. /// public override void Finish() { int err; do { err = deflate(ref _ztream, (int)FlushTypes.Finish); OnDataAvailable(); } while (err == 0); setChecksum( _ztream.adler ); deflateReset(ref _ztream); resetOutput(); } /// /// Closes the internal zlib deflate stream /// protected override void CleanUp() { deflateEnd(ref _ztream); } } } tcl8.6.14/compat/zlib/contrib/dotzlib/LICENSE_1_0.txt0000644000175000017500000000251714554262142021463 0ustar sergeisergeiBoost Software License - Version 1.0 - August 17th, 2003 Permission is hereby granted, free of charge, to any person or organization obtaining a copy of the software and accompanying documentation covered by this license (the "Software") to use, reproduce, display, distribute, execute, and transmit the Software, and to prepare derivative works of the Software, and to permit third-parties to whom the Software is furnished to do so, all subject to the following: The copyright notices in the Software and this entire statement, including the above license grant, this restriction and the following disclaimer, must be included in all copies of the Software, in whole or in part, and all derivative works of the Software, unless such copies or derivative works are solely in the form of machine-executable object code generated by a source language processor. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.tcl8.6.14/compat/zlib/contrib/blast/0000755000175000017500000000000014566153412016634 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/blast/test.pk0000644000175000017500000000001014554262142020134 0ustar sergeisergei‚$%€tcl8.6.14/compat/zlib/contrib/blast/README0000644000175000017500000000011214554262142017504 0ustar sergeisergeiRead blast.h for purpose and usage. Mark Adler madler@alumni.caltech.edu tcl8.6.14/compat/zlib/contrib/blast/blast.c0000644000175000017500000004336214554262142020113 0ustar sergeisergei/* blast.c * Copyright (C) 2003, 2012, 2013 Mark Adler * For conditions of distribution and use, see copyright notice in blast.h * version 1.3, 24 Aug 2013 * * blast.c decompresses data compressed by the PKWare Compression Library. * This function provides functionality similar to the explode() function of * the PKWare library, hence the name "blast". * * This decompressor is based on the excellent format description provided by * Ben Rudiak-Gould in comp.compression on August 13, 2001. Interestingly, the * example Ben provided in the post is incorrect. The distance 110001 should * instead be 111000. When corrected, the example byte stream becomes: * * 00 04 82 24 25 8f 80 7f * * which decompresses to "AIAIAIAIAIAIA" (without the quotes). */ /* * Change history: * * 1.0 12 Feb 2003 - First version * 1.1 16 Feb 2003 - Fixed distance check for > 4 GB uncompressed data * 1.2 24 Oct 2012 - Add note about using binary mode in stdio * - Fix comparisons of differently signed integers * 1.3 24 Aug 2013 - Return unused input from blast() * - Fix test code to correctly report unused input * - Enable the provision of initial input to blast() */ #include /* for NULL */ #include /* for setjmp(), longjmp(), and jmp_buf */ #include "blast.h" /* prototype for blast() */ #define local static /* for local function definitions */ #define MAXBITS 13 /* maximum code length */ #define MAXWIN 4096 /* maximum window size */ /* input and output state */ struct state { /* input state */ blast_in infun; /* input function provided by user */ void *inhow; /* opaque information passed to infun() */ unsigned char *in; /* next input location */ unsigned left; /* available input at in */ int bitbuf; /* bit buffer */ int bitcnt; /* number of bits in bit buffer */ /* input limit error return state for bits() and decode() */ jmp_buf env; /* output state */ blast_out outfun; /* output function provided by user */ void *outhow; /* opaque information passed to outfun() */ unsigned next; /* index of next write location in out[] */ int first; /* true to check distances (for first 4K) */ unsigned char out[MAXWIN]; /* output buffer and sliding window */ }; /* * Return need bits from the input stream. This always leaves less than * eight bits in the buffer. bits() works properly for need == 0. * * Format notes: * * - Bits are stored in bytes from the least significant bit to the most * significant bit. Therefore bits are dropped from the bottom of the bit * buffer, using shift right, and new bytes are appended to the top of the * bit buffer, using shift left. */ local int bits(struct state *s, int need) { int val; /* bit accumulator */ /* load at least need bits into val */ val = s->bitbuf; while (s->bitcnt < need) { if (s->left == 0) { s->left = s->infun(s->inhow, &(s->in)); if (s->left == 0) longjmp(s->env, 1); /* out of input */ } val |= (int)(*(s->in)++) << s->bitcnt; /* load eight bits */ s->left--; s->bitcnt += 8; } /* drop need bits and update buffer, always zero to seven bits left */ s->bitbuf = val >> need; s->bitcnt -= need; /* return need bits, zeroing the bits above that */ return val & ((1 << need) - 1); } /* * Huffman code decoding tables. count[1..MAXBITS] is the number of symbols of * each length, which for a canonical code are stepped through in order. * symbol[] are the symbol values in canonical order, where the number of * entries is the sum of the counts in count[]. The decoding process can be * seen in the function decode() below. */ struct huffman { short *count; /* number of symbols of each length */ short *symbol; /* canonically ordered symbols */ }; /* * Decode a code from the stream s using huffman table h. Return the symbol or * a negative value if there is an error. If all of the lengths are zero, i.e. * an empty code, or if the code is incomplete and an invalid code is received, * then -9 is returned after reading MAXBITS bits. * * Format notes: * * - The codes as stored in the compressed data are bit-reversed relative to * a simple integer ordering of codes of the same lengths. Hence below the * bits are pulled from the compressed data one at a time and used to * build the code value reversed from what is in the stream in order to * permit simple integer comparisons for decoding. * * - The first code for the shortest length is all ones. Subsequent codes of * the same length are simply integer decrements of the previous code. When * moving up a length, a one bit is appended to the code. For a complete * code, the last code of the longest length will be all zeros. To support * this ordering, the bits pulled during decoding are inverted to apply the * more "natural" ordering starting with all zeros and incrementing. */ local int decode(struct state *s, struct huffman *h) { int len; /* current number of bits in code */ int code; /* len bits being decoded */ int first; /* first code of length len */ int count; /* number of codes of length len */ int index; /* index of first code of length len in symbol table */ int bitbuf; /* bits from stream */ int left; /* bits left in next or left to process */ short *next; /* next number of codes */ bitbuf = s->bitbuf; left = s->bitcnt; code = first = index = 0; len = 1; next = h->count + 1; while (1) { while (left--) { code |= (bitbuf & 1) ^ 1; /* invert code */ bitbuf >>= 1; count = *next++; if (code < first + count) { /* if length len, return symbol */ s->bitbuf = bitbuf; s->bitcnt = (s->bitcnt - len) & 7; return h->symbol[index + (code - first)]; } index += count; /* else update for next length */ first += count; first <<= 1; code <<= 1; len++; } left = (MAXBITS+1) - len; if (left == 0) break; if (s->left == 0) { s->left = s->infun(s->inhow, &(s->in)); if (s->left == 0) longjmp(s->env, 1); /* out of input */ } bitbuf = *(s->in)++; s->left--; if (left > 8) left = 8; } return -9; /* ran out of codes */ } /* * Given a list of repeated code lengths rep[0..n-1], where each byte is a * count (high four bits + 1) and a code length (low four bits), generate the * list of code lengths. This compaction reduces the size of the object code. * Then given the list of code lengths length[0..n-1] representing a canonical * Huffman code for n symbols, construct the tables required to decode those * codes. Those tables are the number of codes of each length, and the symbols * sorted by length, retaining their original order within each length. The * return value is zero for a complete code set, negative for an over- * subscribed code set, and positive for an incomplete code set. The tables * can be used if the return value is zero or positive, but they cannot be used * if the return value is negative. If the return value is zero, it is not * possible for decode() using that table to return an error--any stream of * enough bits will resolve to a symbol. If the return value is positive, then * it is possible for decode() using that table to return an error for received * codes past the end of the incomplete lengths. */ local int construct(struct huffman *h, const unsigned char *rep, int n) { int symbol; /* current symbol when stepping through length[] */ int len; /* current length when stepping through h->count[] */ int left; /* number of possible codes left of current length */ short offs[MAXBITS+1]; /* offsets in symbol table for each length */ short length[256]; /* code lengths */ /* convert compact repeat counts into symbol bit length list */ symbol = 0; do { len = *rep++; left = (len >> 4) + 1; len &= 15; do { length[symbol++] = len; } while (--left); } while (--n); n = symbol; /* count number of codes of each length */ for (len = 0; len <= MAXBITS; len++) h->count[len] = 0; for (symbol = 0; symbol < n; symbol++) (h->count[length[symbol]])++; /* assumes lengths are within bounds */ if (h->count[0] == n) /* no codes! */ return 0; /* complete, but decode() will fail */ /* check for an over-subscribed or incomplete set of lengths */ left = 1; /* one possible code of zero length */ for (len = 1; len <= MAXBITS; len++) { left <<= 1; /* one more bit, double codes left */ left -= h->count[len]; /* deduct count from possible codes */ if (left < 0) return left; /* over-subscribed--return negative */ } /* left > 0 means incomplete */ /* generate offsets into symbol table for each length for sorting */ offs[1] = 0; for (len = 1; len < MAXBITS; len++) offs[len + 1] = offs[len] + h->count[len]; /* * put symbols in table sorted by length, by symbol order within each * length */ for (symbol = 0; symbol < n; symbol++) if (length[symbol] != 0) h->symbol[offs[length[symbol]]++] = symbol; /* return zero for complete set, positive for incomplete set */ return left; } /* * Decode PKWare Compression Library stream. * * Format notes: * * - First byte is 0 if literals are uncoded or 1 if they are coded. Second * byte is 4, 5, or 6 for the number of extra bits in the distance code. * This is the base-2 logarithm of the dictionary size minus six. * * - Compressed data is a combination of literals and length/distance pairs * terminated by an end code. Literals are either Huffman coded or * uncoded bytes. A length/distance pair is a coded length followed by a * coded distance to represent a string that occurs earlier in the * uncompressed data that occurs again at the current location. * * - A bit preceding a literal or length/distance pair indicates which comes * next, 0 for literals, 1 for length/distance. * * - If literals are uncoded, then the next eight bits are the literal, in the * normal bit order in the stream, i.e. no bit-reversal is needed. Similarly, * no bit reversal is needed for either the length extra bits or the distance * extra bits. * * - Literal bytes are simply written to the output. A length/distance pair is * an instruction to copy previously uncompressed bytes to the output. The * copy is from distance bytes back in the output stream, copying for length * bytes. * * - Distances pointing before the beginning of the output data are not * permitted. * * - Overlapped copies, where the length is greater than the distance, are * allowed and common. For example, a distance of one and a length of 518 * simply copies the last byte 518 times. A distance of four and a length of * twelve copies the last four bytes three times. A simple forward copy * ignoring whether the length is greater than the distance or not implements * this correctly. */ local int decomp(struct state *s) { int lit; /* true if literals are coded */ int dict; /* log2(dictionary size) - 6 */ int symbol; /* decoded symbol, extra bits for distance */ int len; /* length for copy */ unsigned dist; /* distance for copy */ int copy; /* copy counter */ unsigned char *from, *to; /* copy pointers */ static int virgin = 1; /* build tables once */ static short litcnt[MAXBITS+1], litsym[256]; /* litcode memory */ static short lencnt[MAXBITS+1], lensym[16]; /* lencode memory */ static short distcnt[MAXBITS+1], distsym[64]; /* distcode memory */ static struct huffman litcode = {litcnt, litsym}; /* length code */ static struct huffman lencode = {lencnt, lensym}; /* length code */ static struct huffman distcode = {distcnt, distsym};/* distance code */ /* bit lengths of literal codes */ static const unsigned char litlen[] = { 11, 124, 8, 7, 28, 7, 188, 13, 76, 4, 10, 8, 12, 10, 12, 10, 8, 23, 8, 9, 7, 6, 7, 8, 7, 6, 55, 8, 23, 24, 12, 11, 7, 9, 11, 12, 6, 7, 22, 5, 7, 24, 6, 11, 9, 6, 7, 22, 7, 11, 38, 7, 9, 8, 25, 11, 8, 11, 9, 12, 8, 12, 5, 38, 5, 38, 5, 11, 7, 5, 6, 21, 6, 10, 53, 8, 7, 24, 10, 27, 44, 253, 253, 253, 252, 252, 252, 13, 12, 45, 12, 45, 12, 61, 12, 45, 44, 173}; /* bit lengths of length codes 0..15 */ static const unsigned char lenlen[] = {2, 35, 36, 53, 38, 23}; /* bit lengths of distance codes 0..63 */ static const unsigned char distlen[] = {2, 20, 53, 230, 247, 151, 248}; static const short base[16] = { /* base for length codes */ 3, 2, 4, 5, 6, 7, 8, 9, 10, 12, 16, 24, 40, 72, 136, 264}; static const char extra[16] = { /* extra bits for length codes */ 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8}; /* set up decoding tables (once--might not be thread-safe) */ if (virgin) { construct(&litcode, litlen, sizeof(litlen)); construct(&lencode, lenlen, sizeof(lenlen)); construct(&distcode, distlen, sizeof(distlen)); virgin = 0; } /* read header */ lit = bits(s, 8); if (lit > 1) return -1; dict = bits(s, 8); if (dict < 4 || dict > 6) return -2; /* decode literals and length/distance pairs */ do { if (bits(s, 1)) { /* get length */ symbol = decode(s, &lencode); len = base[symbol] + bits(s, extra[symbol]); if (len == 519) break; /* end code */ /* get distance */ symbol = len == 2 ? 2 : dict; dist = decode(s, &distcode) << symbol; dist += bits(s, symbol); dist++; if (s->first && dist > s->next) return -3; /* distance too far back */ /* copy length bytes from distance bytes back */ do { to = s->out + s->next; from = to - dist; copy = MAXWIN; if (s->next < dist) { from += copy; copy = dist; } copy -= s->next; if (copy > len) copy = len; len -= copy; s->next += copy; do { *to++ = *from++; } while (--copy); if (s->next == MAXWIN) { if (s->outfun(s->outhow, s->out, s->next)) return 1; s->next = 0; s->first = 0; } } while (len != 0); } else { /* get literal and write it */ symbol = lit ? decode(s, &litcode) : bits(s, 8); s->out[s->next++] = symbol; if (s->next == MAXWIN) { if (s->outfun(s->outhow, s->out, s->next)) return 1; s->next = 0; s->first = 0; } } } while (1); return 0; } /* See comments in blast.h */ int blast(blast_in infun, void *inhow, blast_out outfun, void *outhow, unsigned *left, unsigned char **in) { struct state s; /* input/output state */ int err; /* return value */ /* initialize input state */ s.infun = infun; s.inhow = inhow; if (left != NULL && *left) { s.left = *left; s.in = *in; } else s.left = 0; s.bitbuf = 0; s.bitcnt = 0; /* initialize output state */ s.outfun = outfun; s.outhow = outhow; s.next = 0; s.first = 1; /* return if bits() or decode() tries to read past available input */ if (setjmp(s.env) != 0) /* if came back here via longjmp(), */ err = 2; /* then skip decomp(), return error */ else err = decomp(&s); /* decompress */ /* return unused input */ if (left != NULL) *left = s.left; if (in != NULL) *in = s.left ? s.in : NULL; /* write any leftover output and update the error code if needed */ if (err != 1 && s.next && s.outfun(s.outhow, s.out, s.next) && err == 0) err = 1; return err; } #ifdef TEST /* Example of how to use blast() */ #include #include #define CHUNK 16384 local unsigned inf(void *how, unsigned char **buf) { static unsigned char hold[CHUNK]; *buf = hold; return fread(hold, 1, CHUNK, (FILE *)how); } local int outf(void *how, unsigned char *buf, unsigned len) { return fwrite(buf, 1, len, (FILE *)how) != len; } /* Decompress a PKWare Compression Library stream from stdin to stdout */ int main(void) { int ret; unsigned left; /* decompress to stdout */ left = 0; ret = blast(inf, stdin, outf, stdout, &left, NULL); if (ret != 0) fprintf(stderr, "blast error: %d\n", ret); /* count any leftover bytes */ while (getchar() != EOF) left++; if (left) fprintf(stderr, "blast warning: %u unused bytes of input\n", left); /* return blast() error code */ return ret; } #endif tcl8.6.14/compat/zlib/contrib/blast/Makefile0000644000175000017500000000017714554262142020277 0ustar sergeisergeiblast: blast.c blast.h cc -DTEST -o blast blast.c test: blast blast < test.pk | cmp - test.txt clean: rm -f blast blast.o tcl8.6.14/compat/zlib/contrib/blast/blast.h0000644000175000017500000000743014554262142020114 0ustar sergeisergei/* blast.h -- interface for blast.c Copyright (C) 2003, 2012, 2013 Mark Adler version 1.3, 24 Aug 2013 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. Mark Adler madler@alumni.caltech.edu */ /* * blast() decompresses the PKWare Data Compression Library (DCL) compressed * format. It provides the same functionality as the explode() function in * that library. (Note: PKWare overused the "implode" verb, and the format * used by their library implode() function is completely different and * incompatible with the implode compression method supported by PKZIP.) * * The binary mode for stdio functions should be used to assure that the * compressed data is not corrupted when read or written. For example: * fopen(..., "rb") and fopen(..., "wb"). */ typedef unsigned (*blast_in)(void *how, unsigned char **buf); typedef int (*blast_out)(void *how, unsigned char *buf, unsigned len); /* Definitions for input/output functions passed to blast(). See below for * what the provided functions need to do. */ int blast(blast_in infun, void *inhow, blast_out outfun, void *outhow, unsigned *left, unsigned char **in); /* Decompress input to output using the provided infun() and outfun() calls. * On success, the return value of blast() is zero. If there is an error in * the source data, i.e. it is not in the proper format, then a negative value * is returned. If there is not enough input available or there is not enough * output space, then a positive error is returned. * * The input function is invoked: len = infun(how, &buf), where buf is set by * infun() to point to the input buffer, and infun() returns the number of * available bytes there. If infun() returns zero, then blast() returns with * an input error. (blast() only asks for input if it needs it.) inhow is for * use by the application to pass an input descriptor to infun(), if desired. * * If left and in are not NULL and *left is not zero when blast() is called, * then the *left bytes at *in are consumed for input before infun() is used. * * The output function is invoked: err = outfun(how, buf, len), where the bytes * to be written are buf[0..len-1]. If err is not zero, then blast() returns * with an output error. outfun() is always called with len <= 4096. outhow * is for use by the application to pass an output descriptor to outfun(), if * desired. * * If there is any unused input, *left is set to the number of bytes that were * read and *in points to them. Otherwise *left is set to zero and *in is set * to NULL. If left or in are NULL, then they are not set. * * The return codes are: * * 2: ran out of input before completing decompression * 1: output error before completing decompression * 0: successful decompression * -1: literal flag not zero or one * -2: dictionary size not in 4..6 * -3: distance is too far back * * At the bottom of blast.c is an example program that uses blast() that can be * compiled to produce a command-line decompression filter by defining TEST. */ tcl8.6.14/compat/zlib/contrib/blast/test.txt0000644000175000017500000000001514554262142020346 0ustar sergeisergeiAIAIAIAIAIAIAtcl8.6.14/compat/zlib/contrib/vstudio/0000755000175000017500000000000014566153412017224 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/vstudio/readme.txt0000644000175000017500000000610014560736523021223 0ustar sergeisergeiBuilding instructions for the DLL versions of Zlib 1.3.1 ======================================================== This directory contains projects that build zlib and minizip using Microsoft Visual C++ 9.0/10.0. You don't need to build these projects yourself. You can download the binaries from: http://www.winimage.com/zLibDll More information can be found at this site. Build instructions for Visual Studio 2008 (32 bits or 64 bits) -------------------------------------------------------------- - Decompress current zlib, including all contrib/* files - Open contrib\vstudio\vc9\zlibvc.sln with Microsoft Visual C++ 2008 - Or run: vcbuild /rebuild contrib\vstudio\vc9\zlibvc.sln "Release|Win32" Build instructions for Visual Studio 2010 (32 bits or 64 bits) -------------------------------------------------------------- - Decompress current zlib, including all contrib/* files - Open contrib\vstudio\vc10\zlibvc.sln with Microsoft Visual C++ 2010 Build instructions for Visual Studio 2012 (32 bits or 64 bits) -------------------------------------------------------------- - Decompress current zlib, including all contrib/* files - Open contrib\vstudio\vc11\zlibvc.sln with Microsoft Visual C++ 2012 Build instructions for Visual Studio 2013 (32 bits or 64 bits) -------------------------------------------------------------- - Decompress current zlib, including all contrib/* files - Open contrib\vstudio\vc12\zlibvc.sln with Microsoft Visual C++ 2013 Build instructions for Visual Studio 2015 (32 bits or 64 bits) -------------------------------------------------------------- - Decompress current zlib, including all contrib/* files - Open contrib\vstudio\vc14\zlibvc.sln with Microsoft Visual C++ 2015 Build instructions for Visual Studio 2022 (64 bits) -------------------------------------------------------------- - Decompress current zlib, including all contrib/* files - Open contrib\vstudio\vc143\zlibvc.sln with Microsoft Visual C++ 2022 Important --------- - To use zlibwapi.dll in your application, you must define the macro ZLIB_WINAPI when compiling your application's source files. Additional notes ---------------- - This DLL, named zlibwapi.dll, is compatible to the old zlib.dll built by Gilles Vollant from the zlib 1.1.x sources, and distributed at http://www.winimage.com/zLibDll It uses the WINAPI calling convention for the exported functions, and includes the minizip functionality. If your application needs that particular build of zlib.dll, you can rename zlibwapi.dll to zlib.dll. - The new DLL was renamed because there exist several incompatible versions of zlib.dll on the Internet. - There is also an official DLL build of zlib, named zlib1.dll. This one is exporting the functions using the CDECL convention. See the file win32\DLL_FAQ.txt found in this zlib distribution. - There used to be a ZLIB_DLL macro in zlib 1.1.x, but now this symbol has a slightly different effect. To avoid compatibility problems, do not define it here. Gilles Vollant info@winimage.com Visual Studio 2013, 2015, and 2022 Projects from Sean Hunt seandhunt_7@yahoo.com tcl8.6.14/compat/zlib/contrib/vstudio/vc9/0000755000175000017500000000000014566153412017725 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/vstudio/vc9/testzlibdll.vcproj0000644000175000017500000003125614554262142023513 0ustar sergeisergei tcl8.6.14/compat/zlib/contrib/vstudio/vc9/minizip.vcproj0000644000175000017500000003071514554262142022635 0ustar sergeisergei tcl8.6.14/compat/zlib/contrib/vstudio/vc9/zlibvc.vcproj0000644000175000017500000006345114554262142022452 0ustar sergeisergei tcl8.6.14/compat/zlib/contrib/vstudio/vc9/testzlib.vcproj0000644000175000017500000004206114554262142023013 0ustar sergeisergei tcl8.6.14/compat/zlib/contrib/vstudio/vc9/zlibstat.vcproj0000644000175000017500000004327214554262142023014 0ustar sergeisergei tcl8.6.14/compat/zlib/contrib/vstudio/vc9/zlibvc.sln0000644000175000017500000002456414554262142021745 0ustar sergeisergeiяЛП Microsoft Visual Studio Solution File, Format Version 10.00 # Visual Studio 2008 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "TestZlibDll", "testzlibdll.vcproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}" ProjectSection(ProjectDependencies) = postProject {8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D} EndProjectSection EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}" ProjectSection(ProjectDependencies) = postProject {8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D} EndProjectSection EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}" ProjectSection(ProjectDependencies) = postProject {8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D} EndProjectSection EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Itanium = Debug|Itanium Debug|Win32 = Debug|Win32 Debug|x64 = Debug|x64 Release|Itanium = Release|Itanium Release|Win32 = Release|Win32 Release|x64 = Release|x64 ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32 ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.Build.0 = Debug|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.Build.0 = Release|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.Build.0 = Debug|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.Build.0 = Release|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.Build.0 = Debug|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.Build.0 = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.Build.0 = Debug|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.Build.0 = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection EndGlobal tcl8.6.14/compat/zlib/contrib/vstudio/vc9/miniunz.vcproj0000644000175000017500000003120714554262142022644 0ustar sergeisergei tcl8.6.14/compat/zlib/contrib/vstudio/vc9/zlibvc.def0000644000175000017500000001624514560736523021712 0ustar sergeisergeiLIBRARY ; zlib data compression and ZIP file I/O library VERSION 1.3.1 EXPORTS adler32 @1 compress @2 crc32 @3 deflate @4 deflateCopy @5 deflateEnd @6 deflateInit2_ @7 deflateInit_ @8 deflateParams @9 deflateReset @10 deflateSetDictionary @11 gzclose @12 gzdopen @13 gzerror @14 gzflush @15 gzopen @16 gzread @17 gzwrite @18 inflate @19 inflateEnd @20 inflateInit2_ @21 inflateInit_ @22 inflateReset @23 inflateSetDictionary @24 inflateSync @25 uncompress @26 zlibVersion @27 gzprintf @28 gzputc @29 gzgetc @30 gzseek @31 gzrewind @32 gztell @33 gzeof @34 gzsetparams @35 zError @36 inflateSyncPoint @37 get_crc_table @38 compress2 @39 gzputs @40 gzgets @41 inflateCopy @42 inflateBackInit_ @43 inflateBack @44 inflateBackEnd @45 compressBound @46 deflateBound @47 gzclearerr @48 gzungetc @49 zlibCompileFlags @50 deflatePrime @51 deflatePending @52 unzOpen @61 unzClose @62 unzGetGlobalInfo @63 unzGetCurrentFileInfo @64 unzGoToFirstFile @65 unzGoToNextFile @66 unzOpenCurrentFile @67 unzReadCurrentFile @68 unzOpenCurrentFile3 @69 unztell @70 unzeof @71 unzCloseCurrentFile @72 unzGetGlobalComment @73 unzStringFileNameCompare @74 unzLocateFile @75 unzGetLocalExtrafield @76 unzOpen2 @77 unzOpenCurrentFile2 @78 unzOpenCurrentFilePassword @79 zipOpen @80 zipOpenNewFileInZip @81 zipWriteInFileInZip @82 zipCloseFileInZip @83 zipClose @84 zipOpenNewFileInZip2 @86 zipCloseFileInZipRaw @87 zipOpen2 @88 zipOpenNewFileInZip3 @89 unzGetFilePos @100 unzGoToFilePos @101 fill_win32_filefunc @110 ; zlibwapi v1.2.4 added: fill_win32_filefunc64 @111 fill_win32_filefunc64A @112 fill_win32_filefunc64W @113 unzOpen64 @120 unzOpen2_64 @121 unzGetGlobalInfo64 @122 unzGetCurrentFileInfo64 @124 unzGetCurrentFileZStreamPos64 @125 unztell64 @126 unzGetFilePos64 @127 unzGoToFilePos64 @128 zipOpen64 @130 zipOpen2_64 @131 zipOpenNewFileInZip64 @132 zipOpenNewFileInZip2_64 @133 zipOpenNewFileInZip3_64 @134 zipOpenNewFileInZip4_64 @135 zipCloseFileInZipRaw64 @136 ; zlib1 v1.2.4 added: adler32_combine @140 crc32_combine @142 deflateSetHeader @144 deflateTune @145 gzbuffer @146 gzclose_r @147 gzclose_w @148 gzdirect @149 gzoffset @150 inflateGetHeader @156 inflateMark @157 inflatePrime @158 inflateReset2 @159 inflateUndermine @160 ; zlib1 v1.2.6 added: gzgetc_ @161 inflateResetKeep @163 deflateResetKeep @164 ; zlib1 v1.2.7 added: gzopen_w @165 ; zlib1 v1.2.8 added: inflateGetDictionary @166 gzvprintf @167 ; zlib1 v1.2.9 added: inflateCodesUsed @168 inflateValidate @169 uncompress2 @170 gzfread @171 gzfwrite @172 deflateGetDictionary @173 adler32_z @174 crc32_z @175 ; zlib1 v1.2.12 added: crc32_combine_gen @176 crc32_combine_gen64 @177 crc32_combine_op @178 tcl8.6.14/compat/zlib/contrib/vstudio/vc9/zlib.rc0000644000175000017500000000167214560736523021225 0ustar sergeisergei#include #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE FILEVERSION 1, 3, 1, 0 PRODUCTVERSION 1, 3, 1, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0 // not used BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904E4" //language ID = U.S. English, char set = Windows, Multilingual BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" VALUE "FileVersion", "1.3.1\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0" VALUE "LegalCopyright", "(C) 1995-2024 Jean-loup Gailly & Mark Adler\0" END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x0409, 1252 END END tcl8.6.14/compat/zlib/contrib/vstudio/vc10/0000755000175000017500000000000014566153412017775 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj0000644000175000017500000011344514554262142022711 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D} DynamicLibrary false true DynamicLibrary false true DynamicLibrary false DynamicLibrary false true DynamicLibrary false true DynamicLibrary false DynamicLibrary false true DynamicLibrary false true DynamicLibrary false <_ProjectFileVersion>10.0.30128.1 x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ true false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ true false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ true false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset zlibwapid zlibwapi zlibwapi zlibwapid zlibwapi zlibwapi _DEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) MultiThreadedDebug false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true EditAndContinue _DEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) true .\zlibvc.def true true Windows false NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) true false .\zlibvc.def true Windows false NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) true false .\zlibvc.def true Windows false _DEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) true .\zlibvc.def true true Windows MachineX64 _DEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c true false .\zlibvc.def true Windows MachineX64 NDEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) true false .\zlibvc.def true Windows MachineX64 NDEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) tcl8.6.14/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.filters0000644000175000017500000000753214554262142024357 0ustar sergeisergeiяЛП {07934a85-8b61-443d-a0ee-b2eedb74f3cd} cpp;c;cxx;rc;def;r;odl;hpj;bat;for;f90 {1d99675b-433d-4a21-9e50-ed4ab8b19762} h;hpp;hxx;hm;inl;fi;fd {431c0958-fa71-44d0-9084-2d19d100c0cc} ico;cur;bmp;dlg;rc2;rct;bin;cnt;rtf;gif;jpg;jpeg;jpe Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Header Files Header Files Header Files Header Files Header Files Header Files Header Files Header Files Header Files tcl8.6.14/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj0000644000175000017500000004503114554262142023104 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A} Win32Proj Application MultiByte Application MultiByte Application MultiByte Application MultiByte Application MultiByte Application MultiByte <_ProjectFileVersion>10.0.30128.1 x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ true false x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ false false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ true false ia64\MiniUnzip$(Configuration)\ ia64\MiniUnzip$(Configuration)\Tmp\ true false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ false false ia64\MiniUnzip$(Configuration)\ ia64\MiniUnzip$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebug false $(IntDir) Level3 EditAndContinue x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.filters0000644000175000017500000000162514554262142024542 0ustar sergeisergeiяЛП {c0419b40-bf50-40da-b153-ff74215b79de} cpp;c;cxx;def;odl;idl;hpj;bat {bb87b070-735b-478e-92ce-7383abb2f36c} h;hpp;hxx;hm;inl;inc {f46ab6a6-548f-43cb-ae96-681abb5bd5db} rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe Source Files tcl8.6.14/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.filters0000644000175000017500000000375214554262142024726 0ustar sergeisergeiяЛП {c1f6a2e3-5da5-4955-8653-310d3efe05a9} cpp;c;cxx;def;odl;idl;hpj;bat {c2aaffdc-2c95-4d6f-8466-4bec5890af2c} h;hpp;hxx;hm;inl;inc {c274fe07-05f2-461c-964b-f6341e4e7eb5} rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files tcl8.6.14/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj0000644000175000017500000006326014554262142023257 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B} testzlib Win32Proj Application MultiByte true Application MultiByte true Application MultiByte Application MultiByte true Application MultiByte true Application MultiByte Application true Application true Application <_ProjectFileVersion>10.0.30128.1 x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ true false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ true false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreadedDebug false AssemblyAndSourceCode $(IntDir) Level3 EditAndContinue %(AdditionalDependencies) $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true Console true true false MachineX86 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDebugDLL false $(IntDir) %(AdditionalDependencies) Itanium Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false AssemblyAndSourceCode $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console MachineIA64 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) Itanium MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true MachineIA64 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) Itanium MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true MachineIA64 tcl8.6.14/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.filters0000644000175000017500000000454514554262142024723 0ustar sergeisergeiяЛП {174213f6-7f66-4ae8-a3a8-a1e0a1e6ffdd} Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files Source Files tcl8.6.14/compat/zlib/contrib/vstudio/vc10/zlibvc.sln0000644000175000017500000002365114554262142022011 0ustar sergeisergeiяЛП Microsoft Visual Studio Solution File, Format Version 11.00 # Visual Studio 2010 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Itanium = Debug|Itanium Debug|Win32 = Debug|Win32 Debug|x64 = Debug|x64 Release|Itanium = Release|Itanium Release|Win32 = Release|Win32 Release|x64 = Release|x64 ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32 ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.Build.0 = Debug|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.Build.0 = Release|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.Build.0 = Debug|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.Build.0 = Release|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.Build.0 = Debug|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.Build.0 = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.Build.0 = Debug|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.Build.0 = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection EndGlobal tcl8.6.14/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj0000644000175000017500000006373114554262142023256 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8} StaticLibrary false StaticLibrary false StaticLibrary false StaticLibrary false StaticLibrary false StaticLibrary false StaticLibrary false StaticLibrary false StaticLibrary false <_ProjectFileVersion>10.0.30128.1 x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled %(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) MultiThreadedDebug false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Itanium Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true Itanium OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Itanium OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true tcl8.6.14/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj0000644000175000017500000004416514554262142023101 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B} Win32Proj Application MultiByte Application MultiByte Application MultiByte Application MultiByte Application MultiByte Application MultiByte <_ProjectFileVersion>10.0.30128.1 x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ true false x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ false x64\$(Configuration)\ x64\$(Configuration)\ true false ia64\$(Configuration)\ ia64\$(Configuration)\ true false x64\$(Configuration)\ x64\$(Configuration)\ false ia64\$(Configuration)\ ia64\$(Configuration)\ false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebug false $(IntDir) Level3 EditAndContinue x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.filters0000644000175000017500000000162514554262142024554 0ustar sergeisergeiяЛП {048af943-022b-4db6-beeb-a54c34774ee2} cpp;c;cxx;def;odl;idl;hpj;bat {c1d600d2-888f-4aea-b73e-8b0dd9befa0c} h;hpp;hxx;hm;inl;inc {0844199a-966b-4f19-81db-1e0125e141b9} rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe Source Files tcl8.6.14/compat/zlib/contrib/vstudio/vc10/zlibvc.def0000644000175000017500000001624514560736523021762 0ustar sergeisergeiLIBRARY ; zlib data compression and ZIP file I/O library VERSION 1.3.1 EXPORTS adler32 @1 compress @2 crc32 @3 deflate @4 deflateCopy @5 deflateEnd @6 deflateInit2_ @7 deflateInit_ @8 deflateParams @9 deflateReset @10 deflateSetDictionary @11 gzclose @12 gzdopen @13 gzerror @14 gzflush @15 gzopen @16 gzread @17 gzwrite @18 inflate @19 inflateEnd @20 inflateInit2_ @21 inflateInit_ @22 inflateReset @23 inflateSetDictionary @24 inflateSync @25 uncompress @26 zlibVersion @27 gzprintf @28 gzputc @29 gzgetc @30 gzseek @31 gzrewind @32 gztell @33 gzeof @34 gzsetparams @35 zError @36 inflateSyncPoint @37 get_crc_table @38 compress2 @39 gzputs @40 gzgets @41 inflateCopy @42 inflateBackInit_ @43 inflateBack @44 inflateBackEnd @45 compressBound @46 deflateBound @47 gzclearerr @48 gzungetc @49 zlibCompileFlags @50 deflatePrime @51 deflatePending @52 unzOpen @61 unzClose @62 unzGetGlobalInfo @63 unzGetCurrentFileInfo @64 unzGoToFirstFile @65 unzGoToNextFile @66 unzOpenCurrentFile @67 unzReadCurrentFile @68 unzOpenCurrentFile3 @69 unztell @70 unzeof @71 unzCloseCurrentFile @72 unzGetGlobalComment @73 unzStringFileNameCompare @74 unzLocateFile @75 unzGetLocalExtrafield @76 unzOpen2 @77 unzOpenCurrentFile2 @78 unzOpenCurrentFilePassword @79 zipOpen @80 zipOpenNewFileInZip @81 zipWriteInFileInZip @82 zipCloseFileInZip @83 zipClose @84 zipOpenNewFileInZip2 @86 zipCloseFileInZipRaw @87 zipOpen2 @88 zipOpenNewFileInZip3 @89 unzGetFilePos @100 unzGoToFilePos @101 fill_win32_filefunc @110 ; zlibwapi v1.2.4 added: fill_win32_filefunc64 @111 fill_win32_filefunc64A @112 fill_win32_filefunc64W @113 unzOpen64 @120 unzOpen2_64 @121 unzGetGlobalInfo64 @122 unzGetCurrentFileInfo64 @124 unzGetCurrentFileZStreamPos64 @125 unztell64 @126 unzGetFilePos64 @127 unzGoToFilePos64 @128 zipOpen64 @130 zipOpen2_64 @131 zipOpenNewFileInZip64 @132 zipOpenNewFileInZip2_64 @133 zipOpenNewFileInZip3_64 @134 zipOpenNewFileInZip4_64 @135 zipCloseFileInZipRaw64 @136 ; zlib1 v1.2.4 added: adler32_combine @140 crc32_combine @142 deflateSetHeader @144 deflateTune @145 gzbuffer @146 gzclose_r @147 gzclose_w @148 gzdirect @149 gzoffset @150 inflateGetHeader @156 inflateMark @157 inflatePrime @158 inflateReset2 @159 inflateUndermine @160 ; zlib1 v1.2.6 added: gzgetc_ @161 inflateResetKeep @163 deflateResetKeep @164 ; zlib1 v1.2.7 added: gzopen_w @165 ; zlib1 v1.2.8 added: inflateGetDictionary @166 gzvprintf @167 ; zlib1 v1.2.9 added: inflateCodesUsed @168 inflateValidate @169 uncompress2 @170 gzfread @171 gzfwrite @172 deflateGetDictionary @173 adler32_z @174 crc32_z @175 ; zlib1 v1.2.12 added: crc32_combine_gen @176 crc32_combine_gen64 @177 crc32_combine_op @178 tcl8.6.14/compat/zlib/contrib/vstudio/vc10/zlib.rc0000644000175000017500000000167214560736523021275 0ustar sergeisergei#include #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE FILEVERSION 1, 3, 1, 0 PRODUCTVERSION 1, 3, 1, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0 // not used BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904E4" //language ID = U.S. English, char set = Windows, Multilingual BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" VALUE "FileVersion", "1.3.1\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0" VALUE "LegalCopyright", "(C) 1995-2024 Jean-loup Gailly & Mark Adler\0" END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x0409, 1252 END END tcl8.6.14/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj0000644000175000017500000004511614554262142023753 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A} Win32Proj Application MultiByte Application MultiByte Application MultiByte Application MultiByte Application MultiByte Application MultiByte <_ProjectFileVersion>10.0.30128.1 x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ true false x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ false false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ true false ia64\TestZlibDll$(Configuration)\ ia64\TestZlibDll$(Configuration)\Tmp\ true false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ false false ia64\TestZlibDll$(Configuration)\ ia64\TestZlibDll$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebug false $(IntDir) Level3 EditAndContinue x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.filters0000644000175000017500000000162714554262142025421 0ustar sergeisergeiяЛП {fa61a89f-93fc-4c89-b29e-36224b7592f4} cpp;c;cxx;def;odl;idl;hpj;bat {d4b85da0-2ba2-4934-b57f-e2584e3848ee} h;hpp;hxx;hm;inl;inc {e573e075-00bd-4a7d-bd67-a8cc9bfc5aca} rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe Source Files tcl8.6.14/compat/zlib/contrib/vstudio/vc14/0000755000175000017500000000000014566153412020001 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/vstudio/vc14/zlibvc.vcxproj0000644000175000017500000011610314554262142022707 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D} DynamicLibrary false true v140 DynamicLibrary false true v140 DynamicLibrary false v140 Unicode DynamicLibrary false true v140 DynamicLibrary false true v140 DynamicLibrary false v140 DynamicLibrary false true v140 DynamicLibrary false true v140 DynamicLibrary false v140 <_ProjectFileVersion>10.0.30128.1 x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ true false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ true false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ true false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi _DEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib false _DEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 _DEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 NDEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 NDEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) tcl8.6.14/compat/zlib/contrib/vstudio/vc14/miniunz.vcxproj0000644000175000017500000004475614554262142023125 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A} Win32Proj Application MultiByte v140 Application Unicode v140 Application MultiByte v140 Application MultiByte v140 Application MultiByte v140 Application MultiByte v140 <_ProjectFileVersion>10.0.30128.1 x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ true false x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ false false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ true false ia64\MiniUnzip$(Configuration)\ ia64\MiniUnzip$(Configuration)\Tmp\ true false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ false false ia64\MiniUnzip$(Configuration)\ ia64\MiniUnzip$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc14/testzlib.vcxproj0000644000175000017500000006335614554262142023271 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B} testzlib Win32Proj Application MultiByte true v140 Application MultiByte true v140 Application Unicode v140 Application MultiByte true v140 Application MultiByte true v140 Application MultiByte v140 Application true v140 Application true v140 Application v140 <_ProjectFileVersion>10.0.30128.1 x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ true false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ true false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false AssemblyAndSourceCode $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true Console true true false MachineX86 false ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDebugDLL false $(IntDir) %(AdditionalDependencies) Itanium Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false AssemblyAndSourceCode $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console MachineIA64 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) Itanium MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true MachineIA64 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) Itanium MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true MachineIA64 tcl8.6.14/compat/zlib/contrib/vstudio/vc14/zlibvc.sln0000644000175000017500000002046114554262142022011 0ustar sergeisergeiяЛП Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 14 VisualStudioVersion = 14.0.25420.1 MinimumVisualStudioVersion = 10.0.40219.1 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Itanium = Debug|Itanium Debug|Win32 = Debug|Win32 Debug|x64 = Debug|x64 Release|Itanium = Release|Itanium Release|Win32 = Release|Win32 Release|x64 = Release|x64 ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32 ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection EndGlobal tcl8.6.14/compat/zlib/contrib/vstudio/vc14/zlibstat.vcxproj0000644000175000017500000006373314554262142023264 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8} StaticLibrary false v140 StaticLibrary false v140 StaticLibrary false v140 Unicode StaticLibrary false v140 StaticLibrary false v140 StaticLibrary false v140 StaticLibrary false v140 StaticLibrary false v140 StaticLibrary false v140 <_ProjectFileVersion>10.0.30128.1 x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Itanium Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true Itanium OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Itanium OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true tcl8.6.14/compat/zlib/contrib/vstudio/vc14/minizip.vcxproj0000644000175000017500000004411514554262142023100 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B} Win32Proj Application MultiByte v140 Application Unicode v140 Application MultiByte v140 Application MultiByte v140 Application MultiByte v140 Application MultiByte v140 <_ProjectFileVersion>10.0.30128.1 x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ true false x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ false x64\$(Configuration)\ x64\$(Configuration)\ true false ia64\$(Configuration)\ ia64\$(Configuration)\ true false x64\$(Configuration)\ x64\$(Configuration)\ false ia64\$(Configuration)\ ia64\$(Configuration)\ false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc14/zlibvc.def0000644000175000017500000001624514560736523021766 0ustar sergeisergeiLIBRARY ; zlib data compression and ZIP file I/O library VERSION 1.3.1 EXPORTS adler32 @1 compress @2 crc32 @3 deflate @4 deflateCopy @5 deflateEnd @6 deflateInit2_ @7 deflateInit_ @8 deflateParams @9 deflateReset @10 deflateSetDictionary @11 gzclose @12 gzdopen @13 gzerror @14 gzflush @15 gzopen @16 gzread @17 gzwrite @18 inflate @19 inflateEnd @20 inflateInit2_ @21 inflateInit_ @22 inflateReset @23 inflateSetDictionary @24 inflateSync @25 uncompress @26 zlibVersion @27 gzprintf @28 gzputc @29 gzgetc @30 gzseek @31 gzrewind @32 gztell @33 gzeof @34 gzsetparams @35 zError @36 inflateSyncPoint @37 get_crc_table @38 compress2 @39 gzputs @40 gzgets @41 inflateCopy @42 inflateBackInit_ @43 inflateBack @44 inflateBackEnd @45 compressBound @46 deflateBound @47 gzclearerr @48 gzungetc @49 zlibCompileFlags @50 deflatePrime @51 deflatePending @52 unzOpen @61 unzClose @62 unzGetGlobalInfo @63 unzGetCurrentFileInfo @64 unzGoToFirstFile @65 unzGoToNextFile @66 unzOpenCurrentFile @67 unzReadCurrentFile @68 unzOpenCurrentFile3 @69 unztell @70 unzeof @71 unzCloseCurrentFile @72 unzGetGlobalComment @73 unzStringFileNameCompare @74 unzLocateFile @75 unzGetLocalExtrafield @76 unzOpen2 @77 unzOpenCurrentFile2 @78 unzOpenCurrentFilePassword @79 zipOpen @80 zipOpenNewFileInZip @81 zipWriteInFileInZip @82 zipCloseFileInZip @83 zipClose @84 zipOpenNewFileInZip2 @86 zipCloseFileInZipRaw @87 zipOpen2 @88 zipOpenNewFileInZip3 @89 unzGetFilePos @100 unzGoToFilePos @101 fill_win32_filefunc @110 ; zlibwapi v1.2.4 added: fill_win32_filefunc64 @111 fill_win32_filefunc64A @112 fill_win32_filefunc64W @113 unzOpen64 @120 unzOpen2_64 @121 unzGetGlobalInfo64 @122 unzGetCurrentFileInfo64 @124 unzGetCurrentFileZStreamPos64 @125 unztell64 @126 unzGetFilePos64 @127 unzGoToFilePos64 @128 zipOpen64 @130 zipOpen2_64 @131 zipOpenNewFileInZip64 @132 zipOpenNewFileInZip2_64 @133 zipOpenNewFileInZip3_64 @134 zipOpenNewFileInZip4_64 @135 zipCloseFileInZipRaw64 @136 ; zlib1 v1.2.4 added: adler32_combine @140 crc32_combine @142 deflateSetHeader @144 deflateTune @145 gzbuffer @146 gzclose_r @147 gzclose_w @148 gzdirect @149 gzoffset @150 inflateGetHeader @156 inflateMark @157 inflatePrime @158 inflateReset2 @159 inflateUndermine @160 ; zlib1 v1.2.6 added: gzgetc_ @161 inflateResetKeep @163 deflateResetKeep @164 ; zlib1 v1.2.7 added: gzopen_w @165 ; zlib1 v1.2.8 added: inflateGetDictionary @166 gzvprintf @167 ; zlib1 v1.2.9 added: inflateCodesUsed @168 inflateValidate @169 uncompress2 @170 gzfread @171 gzfwrite @172 deflateGetDictionary @173 adler32_z @174 crc32_z @175 ; zlib1 v1.2.12 added: crc32_combine_gen @176 crc32_combine_gen64 @177 crc32_combine_op @178 tcl8.6.14/compat/zlib/contrib/vstudio/vc14/zlib.rc0000644000175000017500000000163214560736523021275 0ustar sergeisergei#include #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE FILEVERSION 1, 3, 1, 0 PRODUCTVERSION 1, 3, 1, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0 // not used BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904E4" //language ID = U.S. English, char set = Windows, Multilingual BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" VALUE "FileVersion", "1.3.1\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0" VALUE "LegalCopyright", "(C) 1995-2024 Jean-loup Gailly & Mark Adler\0" END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x0409, 1252 END END tcl8.6.14/compat/zlib/contrib/vstudio/vc14/testzlibdll.vcxproj0000644000175000017500000004504314554262142023756 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A} Win32Proj Application MultiByte v140 Application Unicode v140 Application MultiByte v140 Application MultiByte v140 Application MultiByte v140 Application MultiByte v140 <_ProjectFileVersion>10.0.30128.1 x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ true false x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ false false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ true false ia64\TestZlibDll$(Configuration)\ ia64\TestZlibDll$(Configuration)\Tmp\ true false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ false false ia64\TestZlibDll$(Configuration)\ ia64\TestZlibDll$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc17/0000755000175000017500000000000014566153412020004 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/vstudio/vc17/zlibvc.vcxproj0000644000175000017500000014566414560736524022737 0ustar sergeisergeiяЛП Debug ARM Debug ARM64 Debug Win32 Debug x64 ReleaseWithoutAsm ARM ReleaseWithoutAsm ARM64 ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release ARM Release ARM64 Release Win32 Release x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D} 10.0 DynamicLibrary false true v143 DynamicLibrary false true v143 DynamicLibrary false v143 Unicode DynamicLibrary false true v143 DynamicLibrary false true v143 DynamicLibrary false true v143 DynamicLibrary false true v143 DynamicLibrary false true v143 DynamicLibrary false true v143 DynamicLibrary false v143 DynamicLibrary false v143 DynamicLibrary false v143 <_ProjectFileVersion>10.0.30128.1 x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ true false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ true true true false false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false false false false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false false false false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi arm64\ZlibDll$(Configuration)\ arm64\ZlibDll$(Configuration)\Tmp\ arm\ZlibDll$(Configuration)\ arm\ZlibDll$(Configuration)\Tmp\ arm64\ZlibDll$(Configuration)\ arm64\ZlibDll$(Configuration)\Tmp\ arm64\ZlibDll$(Configuration)\ arm64\ZlibDll$(Configuration)\Tmp\ arm\ZlibDll$(Configuration)\ arm\ZlibDll$(Configuration)\Tmp\ arm\ZlibDll$(Configuration)\ arm\ZlibDll$(Configuration)\Tmp\ _DEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib false _DEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 _DEBUG;%(PreprocessorDefinitions) true true $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib _DEBUG;%(PreprocessorDefinitions) true true $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 NDEBUG;%(PreprocessorDefinitions) true true $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 NDEBUG;%(PreprocessorDefinitions) true true $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN32;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) %(AdditionalIncludeDirectories) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) ZLIB_INTERNAL;%(PreprocessorDefinitions) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) %(AdditionalIncludeDirectories) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) ZLIB_INTERNAL;%(PreprocessorDefinitions) ZLIB_INTERNAL;%(PreprocessorDefinitions) tcl8.6.14/compat/zlib/contrib/vstudio/vc17/miniunz.vcxproj0000644000175000017500000005734614560736524023136 0ustar sergeisergeiяЛП Debug ARM Debug ARM64 Debug Win32 Debug x64 Release ARM Release ARM64 Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A} Win32Proj 10.0 Application MultiByte v143 Application Unicode v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 <_ProjectFileVersion>10.0.30128.1 x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ true false x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ false false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ true true true false false false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ false false false false false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset arm64\MiniUnzip$(Configuration)\ arm64\MiniUnzip$(Configuration)\Tmp\ arm64\MiniUnzip$(Configuration)\ arm64\MiniUnzip$(Configuration)\Tmp\ arm\MiniUnzip$(Configuration)\ arm\MiniUnzip$(Configuration)\Tmp\ arm\MiniUnzip$(Configuration)\ arm\MiniUnzip$(Configuration)\Tmp\ Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineX64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineX64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc17/testzlib.vcxproj0000644000175000017500000007265014560736524023300 0ustar sergeisergeiяЛП Debug ARM Debug ARM64 Debug Win32 Debug x64 ReleaseWithoutAsm ARM ReleaseWithoutAsm ARM64 ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release ARM Release ARM64 Release Win32 Release x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B} testzlib Win32Proj 10.0 Application MultiByte true v143 Application MultiByte true v143 Application Unicode v143 Application true v143 Application true v143 Application true v143 Application true v143 Application true v143 Application true v143 Application v143 Application v143 Application v143 <_ProjectFileVersion>10.0.30128.1 x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ true false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset arm64\TestZlib$(Configuration)\ arm64\TestZlib$(Configuration)\Tmp\ arm64\TestZlib$(Configuration)\ arm64\TestZlib$(Configuration)\Tmp\ arm64\TestZlib$(Configuration)\ arm64\TestZlib$(Configuration)\Tmp\ arm\TestZlib$(Configuration)\ arm\TestZlib$(Configuration)\Tmp\ arm\TestZlib$(Configuration)\ arm\TestZlib$(Configuration)\Tmp\ arm\TestZlib$(Configuration)\ arm\TestZlib$(Configuration)\Tmp\ Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false AssemblyAndSourceCode $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true Console true true false MachineX86 false ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDebugDLL false $(IntDir) %(AdditionalDependencies) ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDebugDLL false $(IntDir) %(AdditionalDependencies) ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDebugDLL false $(IntDir) %(AdditionalDependencies) ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) tcl8.6.14/compat/zlib/contrib/vstudio/vc17/zlibvc.sln0000644000175000017500000003136014560736524022023 0ustar sergeisergeiяЛП Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio Version 17 VisualStudioVersion = 17.4.33015.44 MinimumVisualStudioVersion = 10.0.40219.1 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|ARM = Debug|ARM Debug|ARM64 = Debug|ARM64 Debug|Win32 = Debug|Win32 Debug|x64 = Debug|x64 Release|ARM = Release|ARM Release|ARM64 = Release|ARM64 Release|Win32 = Release|Win32 Release|x64 = Release|x64 ReleaseWithoutAsm|ARM = ReleaseWithoutAsm|ARM ReleaseWithoutAsm|ARM64 = ReleaseWithoutAsm|ARM64 ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32 ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|ARM.ActiveCfg = Debug|ARM {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|ARM.Build.0 = Debug|ARM {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|ARM64.ActiveCfg = Debug|ARM64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|ARM64.Build.0 = Debug|ARM64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|ARM.ActiveCfg = Release|ARM {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|ARM.Build.0 = Release|ARM {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|ARM64.ActiveCfg = Release|ARM64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|ARM64.Build.0 = Release|ARM64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|ARM.ActiveCfg = ReleaseWithoutAsm|ARM {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|ARM.Build.0 = ReleaseWithoutAsm|ARM {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|ARM64.ActiveCfg = ReleaseWithoutAsm|ARM64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|ARM64.Build.0 = ReleaseWithoutAsm|ARM64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|ARM.ActiveCfg = Debug|ARM {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|ARM.Build.0 = Debug|ARM {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|ARM64.ActiveCfg = Debug|ARM64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|ARM64.Build.0 = Debug|ARM64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|ARM.ActiveCfg = Release|ARM {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|ARM.Build.0 = Release|ARM {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|ARM64.ActiveCfg = Release|ARM64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|ARM64.Build.0 = Release|ARM64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|ARM.ActiveCfg = ReleaseWithoutAsm|ARM {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|ARM.Build.0 = ReleaseWithoutAsm|ARM {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|ARM64.ActiveCfg = ReleaseWithoutAsm|ARM64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|ARM64.Build.0 = ReleaseWithoutAsm|ARM64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|ARM.ActiveCfg = Debug|ARM {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|ARM.Build.0 = Debug|ARM {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|ARM64.ActiveCfg = Debug|ARM64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|ARM64.Build.0 = Debug|ARM64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|ARM.ActiveCfg = Release|ARM {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|ARM.Build.0 = Release|ARM {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|ARM64.ActiveCfg = Release|ARM64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|ARM64.Build.0 = Release|ARM64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|ARM.ActiveCfg = ReleaseWithoutAsm|ARM {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|ARM.Build.0 = ReleaseWithoutAsm|ARM {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|ARM64.ActiveCfg = ReleaseWithoutAsm|ARM64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|ARM64.Build.0 = ReleaseWithoutAsm|ARM64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|ARM.ActiveCfg = Debug|ARM {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|ARM.Build.0 = Debug|ARM {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|ARM64.ActiveCfg = Debug|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|ARM64.Build.0 = Debug|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|ARM.ActiveCfg = Release|ARM {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|ARM.Build.0 = Release|ARM {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|ARM64.ActiveCfg = Release|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|ARM64.Build.0 = Release|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|ARM.ActiveCfg = Release|ARM {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|ARM.Build.0 = Release|ARM {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|ARM64.ActiveCfg = Release|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|ARM64.Build.0 = Release|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|ARM.ActiveCfg = Debug|ARM {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|ARM.Build.0 = Debug|ARM {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|ARM64.ActiveCfg = Debug|ARM64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|ARM64.Build.0 = Debug|ARM64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|ARM.ActiveCfg = Release|ARM {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|ARM.Build.0 = Release|ARM {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|ARM64.ActiveCfg = Release|ARM64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|ARM64.Build.0 = Release|ARM64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|ARM.ActiveCfg = Release|ARM {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|ARM.Build.0 = Release|ARM {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|ARM64.ActiveCfg = Release|ARM64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|ARM64.Build.0 = Release|ARM64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|ARM.ActiveCfg = Debug|ARM {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|ARM.Build.0 = Debug|ARM {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|ARM64.ActiveCfg = Debug|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|ARM64.Build.0 = Debug|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|ARM.ActiveCfg = Release|ARM {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|ARM.Build.0 = Release|ARM {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|ARM64.ActiveCfg = Release|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|ARM64.Build.0 = Release|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|ARM.ActiveCfg = Release|ARM {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|ARM.Build.0 = Release|ARM {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|ARM64.ActiveCfg = Release|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|ARM64.Build.0 = Release|ARM64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {EAA58685-56D9-43F2-8703-FD2CB020745E} EndGlobalSection EndGlobal tcl8.6.14/compat/zlib/contrib/vstudio/vc17/zlibstat.vcxproj0000644000175000017500000010322614560736524023266 0ustar sergeisergeiяЛП Debug ARM Debug ARM64 Debug Win32 Debug x64 ReleaseWithoutAsm ARM ReleaseWithoutAsm ARM64 ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release ARM Release ARM64 Release Win32 Release x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8} 10.0 StaticLibrary false v143 StaticLibrary false v143 StaticLibrary false v143 Unicode StaticLibrary false v143 StaticLibrary false v143 StaticLibrary false v143 StaticLibrary false v143 StaticLibrary false v143 StaticLibrary false v143 StaticLibrary false v143 StaticLibrary false v143 StaticLibrary false v143 <_ProjectFileVersion>10.0.30128.1 x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset arm64\ZlibStat$(Configuration)\ arm64\ZlibStat$(Configuration)\Tmp\ arm64\ZlibStat$(Configuration)\ arm64\ZlibStat$(Configuration)\Tmp\ arm64\ZlibStat$(Configuration)\ arm64\ZlibStat$(Configuration)\Tmp\ arm\ZlibStat$(Configuration)\ arm\ZlibStat$(Configuration)\Tmp\ arm\ZlibStat$(Configuration)\ arm\ZlibStat$(Configuration)\Tmp\ arm\ZlibStat$(Configuration)\ arm\ZlibStat$(Configuration)\Tmp\ Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:ARM64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:ARM /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:ARM64 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:ARM /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:ARM64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:ARM /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true tcl8.6.14/compat/zlib/contrib/vstudio/vc17/minizip.vcxproj0000644000175000017500000005637214560736524023122 0ustar sergeisergeiяЛП Debug ARM Debug ARM64 Debug Win32 Debug x64 Release ARM Release ARM64 Release Win32 Release x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B} Win32Proj 10.0 Application MultiByte v143 Application Unicode v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 <_ProjectFileVersion>10.0.30128.1 x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ true false x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ false x64\$(Configuration)\ x64\$(Configuration)\ true true true false false false x64\$(Configuration)\ x64\$(Configuration)\ false false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset arm64\MiniZip$(Configuration)\ arm64\MiniZip$(Configuration)\Tmp\ arm64\MiniZip$(Configuration)\ arm64\MiniZip$(Configuration)\Tmp\ arm\MiniZip$(Configuration)\ arm\MiniZip$(Configuration)\Tmp\ arm\MiniZip$(Configuration)\ arm\MiniZip$(Configuration)\Tmp\ Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineX64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineX64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc17/zlibvc.def0000644000175000017500000001600714560736524021766 0ustar sergeisergeiLIBRARY ; zlib data compression and ZIP file I/O library VERSION 1.3.1 EXPORTS adler32 @1 compress @2 crc32 @3 deflate @4 deflateCopy @5 deflateEnd @6 deflateInit2_ @7 deflateInit_ @8 deflateParams @9 deflateReset @10 deflateSetDictionary @11 gzclose @12 gzdopen @13 gzerror @14 gzflush @15 gzopen @16 gzread @17 gzwrite @18 inflate @19 inflateEnd @20 inflateInit2_ @21 inflateInit_ @22 inflateReset @23 inflateSetDictionary @24 inflateSync @25 uncompress @26 zlibVersion @27 gzprintf @28 gzputc @29 gzgetc @30 gzseek @31 gzrewind @32 gztell @33 gzeof @34 gzsetparams @35 zError @36 inflateSyncPoint @37 get_crc_table @38 compress2 @39 gzputs @40 gzgets @41 inflateCopy @42 inflateBackInit_ @43 inflateBack @44 inflateBackEnd @45 compressBound @46 deflateBound @47 gzclearerr @48 gzungetc @49 zlibCompileFlags @50 deflatePrime @51 deflatePending @52 unzOpen @61 unzClose @62 unzGetGlobalInfo @63 unzGetCurrentFileInfo @64 unzGoToFirstFile @65 unzGoToNextFile @66 unzOpenCurrentFile @67 unzReadCurrentFile @68 unzOpenCurrentFile3 @69 unztell @70 unzeof @71 unzCloseCurrentFile @72 unzGetGlobalComment @73 unzStringFileNameCompare @74 unzLocateFile @75 unzGetLocalExtrafield @76 unzOpen2 @77 unzOpenCurrentFile2 @78 unzOpenCurrentFilePassword @79 zipOpen @80 zipOpenNewFileInZip @81 zipWriteInFileInZip @82 zipCloseFileInZip @83 zipClose @84 zipOpenNewFileInZip2 @86 zipCloseFileInZipRaw @87 zipOpen2 @88 zipOpenNewFileInZip3 @89 unzGetFilePos @100 unzGoToFilePos @101 fill_win32_filefunc @110 ; zlibwapi v1.2.4 added: fill_win32_filefunc64 @111 fill_win32_filefunc64A @112 fill_win32_filefunc64W @113 unzOpen64 @120 unzOpen2_64 @121 unzGetGlobalInfo64 @122 unzGetCurrentFileInfo64 @124 unzGetCurrentFileZStreamPos64 @125 unztell64 @126 unzGetFilePos64 @127 unzGoToFilePos64 @128 zipOpen64 @130 zipOpen2_64 @131 zipOpenNewFileInZip64 @132 zipOpenNewFileInZip2_64 @133 zipOpenNewFileInZip3_64 @134 zipOpenNewFileInZip4_64 @135 zipCloseFileInZipRaw64 @136 ; zlib1 v1.2.4 added: adler32_combine @140 crc32_combine @142 deflateSetHeader @144 deflateTune @145 gzbuffer @146 gzclose_r @147 gzclose_w @148 gzdirect @149 gzoffset @150 inflateGetHeader @156 inflateMark @157 inflatePrime @158 inflateReset2 @159 inflateUndermine @160 ; zlib1 v1.2.6 added: gzgetc_ @161 inflateResetKeep @163 deflateResetKeep @164 ; zlib1 v1.2.7 added: gzopen_w @165 ; zlib1 v1.2.8 added: inflateGetDictionary @166 gzvprintf @167 ; zlib1 v1.2.9 added: inflateCodesUsed @168 inflateValidate @169 uncompress2 @170 gzfread @171 gzfwrite @172 deflateGetDictionary @173 adler32_z @174 crc32_z @175 ; zlib1 v1.2.12 added: crc32_combine_gen @176 crc32_combine_gen64 @177 crc32_combine_op @178 tcl8.6.14/compat/zlib/contrib/vstudio/vc17/zlib.rc0000644000175000017500000000163214560736524021301 0ustar sergeisergei#include #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE FILEVERSION 1, 3, 1, 0 PRODUCTVERSION 1, 3, 1, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0 // not used BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904E4" //language ID = U.S. English, char set = Windows, Multilingual BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" VALUE "FileVersion", "1.3.1\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0" VALUE "LegalCopyright", "(C) 1995-2024 Jean-loup Gailly & Mark Adler\0" END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x0409, 1252 END END tcl8.6.14/compat/zlib/contrib/vstudio/vc17/testzlibdll.vcxproj0000644000175000017500000005745414560736524024001 0ustar sergeisergeiяЛП Debug ARM Debug ARM64 Debug Win32 Debug x64 Release ARM Release ARM64 Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A} Win32Proj 10.0 Application MultiByte v143 Application Unicode v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 Application MultiByte v143 <_ProjectFileVersion>10.0.30128.1 x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ true false x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ false false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ true true true false false false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ false false false false false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset arm64\TestZlibDll$(Configuration)\ arm64\TestZlibDll$(Configuration)\Tmp\ arm64\TestZlibDll$(Configuration)\ arm64\TestZlibDll$(Configuration)\Tmp\ arm\TestZlibDll$(Configuration)\ arm\TestZlibDll$(Configuration)\Tmp\ arm\TestZlibDll$(Configuration)\ arm\TestZlibDll$(Configuration)\Tmp\ Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineX64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineX64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc12/0000755000175000017500000000000014566153412017777 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/vstudio/vc12/zlibvc.vcxproj0000644000175000017500000011610314554262142022705 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D} DynamicLibrary false true v120 DynamicLibrary false true v120 DynamicLibrary false v120 Unicode DynamicLibrary false true v120 DynamicLibrary false true v120 DynamicLibrary false v120 DynamicLibrary false true v120 DynamicLibrary false true v120 DynamicLibrary false v120 <_ProjectFileVersion>10.0.30128.1 x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ true false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ true false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ true false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi _DEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib false _DEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 _DEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 NDEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 NDEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) tcl8.6.14/compat/zlib/contrib/vstudio/vc12/miniunz.vcxproj0000644000175000017500000004475614554262142023123 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A} Win32Proj Application MultiByte v120 Application Unicode v120 Application MultiByte v120 Application MultiByte v120 Application MultiByte v120 Application MultiByte v120 <_ProjectFileVersion>10.0.30128.1 x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ true false x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ false false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ true false ia64\MiniUnzip$(Configuration)\ ia64\MiniUnzip$(Configuration)\Tmp\ true false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ false false ia64\MiniUnzip$(Configuration)\ ia64\MiniUnzip$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc12/testzlib.vcxproj0000644000175000017500000006335614554262142023267 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B} testzlib Win32Proj Application MultiByte true v120 Application MultiByte true v120 Application Unicode v120 Application MultiByte true v120 Application MultiByte true v120 Application MultiByte v120 Application true v120 Application true v120 Application v120 <_ProjectFileVersion>10.0.30128.1 x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ true false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ true false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false AssemblyAndSourceCode $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true Console true true false MachineX86 false ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDebugDLL false $(IntDir) %(AdditionalDependencies) Itanium Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false AssemblyAndSourceCode $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console MachineIA64 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) Itanium MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true MachineIA64 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) Itanium MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true MachineIA64 tcl8.6.14/compat/zlib/contrib/vstudio/vc12/zlibvc.sln0000644000175000017500000002046314554262142022011 0ustar sergeisergeiяЛП Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 2013 VisualStudioVersion = 12.0.40629.0 MinimumVisualStudioVersion = 10.0.40219.1 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Itanium = Debug|Itanium Debug|Win32 = Debug|Win32 Debug|x64 = Debug|x64 Release|Itanium = Release|Itanium Release|Win32 = Release|Win32 Release|x64 = Release|x64 ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32 ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection EndGlobal tcl8.6.14/compat/zlib/contrib/vstudio/vc12/zlibstat.vcxproj0000644000175000017500000006373314554262142023262 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8} StaticLibrary false v120 StaticLibrary false v120 StaticLibrary false v120 Unicode StaticLibrary false v120 StaticLibrary false v120 StaticLibrary false v120 StaticLibrary false v120 StaticLibrary false v120 StaticLibrary false v120 <_ProjectFileVersion>10.0.30128.1 x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Itanium Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true Itanium OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Itanium OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true tcl8.6.14/compat/zlib/contrib/vstudio/vc12/minizip.vcxproj0000644000175000017500000004411514554262142023076 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B} Win32Proj Application MultiByte v120 Application Unicode v120 Application MultiByte v120 Application MultiByte v120 Application MultiByte v120 Application MultiByte v120 <_ProjectFileVersion>10.0.30128.1 x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ true false x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ false x64\$(Configuration)\ x64\$(Configuration)\ true false ia64\$(Configuration)\ ia64\$(Configuration)\ true false x64\$(Configuration)\ x64\$(Configuration)\ false ia64\$(Configuration)\ ia64\$(Configuration)\ false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc12/zlibvc.def0000644000175000017500000001624514560736523021764 0ustar sergeisergeiLIBRARY ; zlib data compression and ZIP file I/O library VERSION 1.3.1 EXPORTS adler32 @1 compress @2 crc32 @3 deflate @4 deflateCopy @5 deflateEnd @6 deflateInit2_ @7 deflateInit_ @8 deflateParams @9 deflateReset @10 deflateSetDictionary @11 gzclose @12 gzdopen @13 gzerror @14 gzflush @15 gzopen @16 gzread @17 gzwrite @18 inflate @19 inflateEnd @20 inflateInit2_ @21 inflateInit_ @22 inflateReset @23 inflateSetDictionary @24 inflateSync @25 uncompress @26 zlibVersion @27 gzprintf @28 gzputc @29 gzgetc @30 gzseek @31 gzrewind @32 gztell @33 gzeof @34 gzsetparams @35 zError @36 inflateSyncPoint @37 get_crc_table @38 compress2 @39 gzputs @40 gzgets @41 inflateCopy @42 inflateBackInit_ @43 inflateBack @44 inflateBackEnd @45 compressBound @46 deflateBound @47 gzclearerr @48 gzungetc @49 zlibCompileFlags @50 deflatePrime @51 deflatePending @52 unzOpen @61 unzClose @62 unzGetGlobalInfo @63 unzGetCurrentFileInfo @64 unzGoToFirstFile @65 unzGoToNextFile @66 unzOpenCurrentFile @67 unzReadCurrentFile @68 unzOpenCurrentFile3 @69 unztell @70 unzeof @71 unzCloseCurrentFile @72 unzGetGlobalComment @73 unzStringFileNameCompare @74 unzLocateFile @75 unzGetLocalExtrafield @76 unzOpen2 @77 unzOpenCurrentFile2 @78 unzOpenCurrentFilePassword @79 zipOpen @80 zipOpenNewFileInZip @81 zipWriteInFileInZip @82 zipCloseFileInZip @83 zipClose @84 zipOpenNewFileInZip2 @86 zipCloseFileInZipRaw @87 zipOpen2 @88 zipOpenNewFileInZip3 @89 unzGetFilePos @100 unzGoToFilePos @101 fill_win32_filefunc @110 ; zlibwapi v1.2.4 added: fill_win32_filefunc64 @111 fill_win32_filefunc64A @112 fill_win32_filefunc64W @113 unzOpen64 @120 unzOpen2_64 @121 unzGetGlobalInfo64 @122 unzGetCurrentFileInfo64 @124 unzGetCurrentFileZStreamPos64 @125 unztell64 @126 unzGetFilePos64 @127 unzGoToFilePos64 @128 zipOpen64 @130 zipOpen2_64 @131 zipOpenNewFileInZip64 @132 zipOpenNewFileInZip2_64 @133 zipOpenNewFileInZip3_64 @134 zipOpenNewFileInZip4_64 @135 zipCloseFileInZipRaw64 @136 ; zlib1 v1.2.4 added: adler32_combine @140 crc32_combine @142 deflateSetHeader @144 deflateTune @145 gzbuffer @146 gzclose_r @147 gzclose_w @148 gzdirect @149 gzoffset @150 inflateGetHeader @156 inflateMark @157 inflatePrime @158 inflateReset2 @159 inflateUndermine @160 ; zlib1 v1.2.6 added: gzgetc_ @161 inflateResetKeep @163 deflateResetKeep @164 ; zlib1 v1.2.7 added: gzopen_w @165 ; zlib1 v1.2.8 added: inflateGetDictionary @166 gzvprintf @167 ; zlib1 v1.2.9 added: inflateCodesUsed @168 inflateValidate @169 uncompress2 @170 gzfread @171 gzfwrite @172 deflateGetDictionary @173 adler32_z @174 crc32_z @175 ; zlib1 v1.2.12 added: crc32_combine_gen @176 crc32_combine_gen64 @177 crc32_combine_op @178 tcl8.6.14/compat/zlib/contrib/vstudio/vc12/zlib.rc0000644000175000017500000000163214560736523021273 0ustar sergeisergei#include #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE FILEVERSION 1, 3, 1, 0 PRODUCTVERSION 1, 3, 1, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0 // not used BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904E4" //language ID = U.S. English, char set = Windows, Multilingual BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" VALUE "FileVersion", "1.3.1\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0" VALUE "LegalCopyright", "(C) 1995-2024 Jean-loup Gailly & Mark Adler\0" END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x0409, 1252 END END tcl8.6.14/compat/zlib/contrib/vstudio/vc12/testzlibdll.vcxproj0000644000175000017500000004504314554262142023754 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A} Win32Proj Application MultiByte v120 Application Unicode v120 Application MultiByte v120 Application MultiByte v120 Application MultiByte v120 Application MultiByte v120 <_ProjectFileVersion>10.0.30128.1 x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ true false x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ false false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ true false ia64\TestZlibDll$(Configuration)\ ia64\TestZlibDll$(Configuration)\Tmp\ true false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ false false ia64\TestZlibDll$(Configuration)\ ia64\TestZlibDll$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc11/0000755000175000017500000000000014566153412017776 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj0000644000175000017500000011701214554262142022704 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D} DynamicLibrary false true v110 DynamicLibrary false true v110 DynamicLibrary false v110 Unicode DynamicLibrary false true DynamicLibrary false true DynamicLibrary false DynamicLibrary false true v110 DynamicLibrary false true v110 DynamicLibrary false v110 <_ProjectFileVersion>10.0.30128.1 x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ true false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x86\ZlibDll$(Configuration)\ x86\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ true false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ true false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ false false x64\ZlibDll$(Configuration)\ x64\ZlibDll$(Configuration)\Tmp\ false false ia64\ZlibDll$(Configuration)\ ia64\ZlibDll$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi zlibwapi _DEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib NDEBUG;%(PreprocessorDefinitions) true true Win32 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c /MACHINE:I386 %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows false $(OutDir)zlibwapi.lib _DEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 _DEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibvc.pch $(IntDir) $(IntDir) $(OutDir) Level3 true ProgramDatabase _DEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true .\zlibvc.def true $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 NDEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 NDEBUG;%(PreprocessorDefinitions) true true X64 $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c %(AdditionalDependencies) $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineX64 NDEBUG;%(PreprocessorDefinitions) true true Itanium $(OutDir)zlibvc.tlb OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibvc.pch All $(IntDir) $(IntDir) $(OutDir) Level3 true NDEBUG;%(PreprocessorDefinitions) 0x040c $(OutDir)zlibwapi.dll true false .\zlibvc.def $(OutDir)zlibwapi.pdb true $(OutDir)zlibwapi.map Windows $(OutDir)zlibwapi.lib MachineIA64 %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) %(AdditionalIncludeDirectories) ZLIB_INTERNAL;%(PreprocessorDefinitions) tcl8.6.14/compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj0000644000175000017500000004531614554262142023113 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A} Win32Proj Application MultiByte v110 Application Unicode v110 Application MultiByte Application MultiByte Application MultiByte v110 Application MultiByte v110 <_ProjectFileVersion>10.0.30128.1 x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ true false x86\MiniUnzip$(Configuration)\ x86\MiniUnzip$(Configuration)\Tmp\ false false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ true false ia64\MiniUnzip$(Configuration)\ ia64\MiniUnzip$(Configuration)\Tmp\ true false x64\MiniUnzip$(Configuration)\ x64\MiniUnzip$(Configuration)\Tmp\ false false ia64\MiniUnzip$(Configuration)\ ia64\MiniUnzip$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true $(OutDir)miniunz.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)miniunz.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj0000644000175000017500000006367714554262142023274 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B} testzlib Win32Proj Application MultiByte true v110 Application MultiByte true v110 Application Unicode v110 Application MultiByte true Application MultiByte true Application MultiByte Application true v110 Application true v110 Application v110 <_ProjectFileVersion>10.0.30128.1 x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ true false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x86\TestZlib$(Configuration)\ x86\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ true false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ false false x64\TestZlib$(Configuration)\ x64\TestZlib$(Configuration)\Tmp\ false ia64\TestZlib$(Configuration)\ ia64\TestZlib$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false AssemblyAndSourceCode $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase %(AdditionalDependencies) $(OutDir)testzlib.exe true Console true true false MachineX86 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDebugDLL false $(IntDir) %(AdditionalDependencies) Itanium Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false AssemblyAndSourceCode $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true $(OutDir)testzlib.pdb Console MachineIA64 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) Itanium MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true MachineIA64 ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) Default MultiThreadedDLL false $(IntDir) %(AdditionalDependencies) Itanium MaxSpeed OnlyExplicitInline true ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase $(OutDir)testzlib.exe true Console true true MachineIA64 tcl8.6.14/compat/zlib/contrib/vstudio/vc11/zlibvc.sln0000644000175000017500000002053314554262142022006 0ustar sergeisergeiяЛП Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 2012 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Itanium = Debug|Itanium Debug|Win32 = Debug|Win32 Debug|x64 = Debug|x64 Release|Itanium = Release|Itanium Release|Win32 = Release|Win32 Release|x64 = Release|x64 ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32 ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64 {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32 {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection EndGlobal tcl8.6.14/compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj0000644000175000017500000006443514554262142023261 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 ReleaseWithoutAsm Itanium ReleaseWithoutAsm Win32 ReleaseWithoutAsm x64 Release Itanium Release Win32 Release x64 {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8} StaticLibrary false v110 StaticLibrary false v110 StaticLibrary false v110 Unicode StaticLibrary false StaticLibrary false StaticLibrary false StaticLibrary false v110 StaticLibrary false v110 StaticLibrary false v110 <_ProjectFileVersion>10.0.30128.1 x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x86\ZlibStat$(Configuration)\ x86\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ x64\ZlibStat$(Configuration)\ x64\ZlibStat$(Configuration)\Tmp\ ia64\ZlibStat$(Configuration)\ ia64\ZlibStat$(Configuration)\Tmp\ AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions) true MultiThreaded false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Itanium Disabled ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) MultiThreadedDebugDLL false $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true OldStyle 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) %(AdditionalDependencies) $(OutDir)zlibstat.lib true Itanium OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true X64 OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true Itanium OnlyExplicitInline ..\..\..;%(AdditionalIncludeDirectories) ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions) true MultiThreadedDLL false true $(IntDir)zlibstat.pch $(IntDir) $(IntDir) $(OutDir) Level3 true 0x040c /MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions) $(OutDir)zlibstat.lib true tcl8.6.14/compat/zlib/contrib/vstudio/vc11/minizip.vcxproj0000644000175000017500000004445214554262142023101 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B} Win32Proj Application MultiByte v110 Application Unicode v110 Application MultiByte Application MultiByte Application MultiByte v110 Application MultiByte v110 <_ProjectFileVersion>10.0.30128.1 x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ true false x86\MiniZip$(Configuration)\ x86\MiniZip$(Configuration)\Tmp\ false x64\$(Configuration)\ x64\$(Configuration)\ true false ia64\$(Configuration)\ ia64\$(Configuration)\ true false x64\$(Configuration)\ x64\$(Configuration)\ false ia64\$(Configuration)\ ia64\$(Configuration)\ false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true $(OutDir)minizip.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)minizip.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/vstudio/vc11/zlibvc.def0000644000175000017500000001624514560736523021763 0ustar sergeisergeiLIBRARY ; zlib data compression and ZIP file I/O library VERSION 1.3.1 EXPORTS adler32 @1 compress @2 crc32 @3 deflate @4 deflateCopy @5 deflateEnd @6 deflateInit2_ @7 deflateInit_ @8 deflateParams @9 deflateReset @10 deflateSetDictionary @11 gzclose @12 gzdopen @13 gzerror @14 gzflush @15 gzopen @16 gzread @17 gzwrite @18 inflate @19 inflateEnd @20 inflateInit2_ @21 inflateInit_ @22 inflateReset @23 inflateSetDictionary @24 inflateSync @25 uncompress @26 zlibVersion @27 gzprintf @28 gzputc @29 gzgetc @30 gzseek @31 gzrewind @32 gztell @33 gzeof @34 gzsetparams @35 zError @36 inflateSyncPoint @37 get_crc_table @38 compress2 @39 gzputs @40 gzgets @41 inflateCopy @42 inflateBackInit_ @43 inflateBack @44 inflateBackEnd @45 compressBound @46 deflateBound @47 gzclearerr @48 gzungetc @49 zlibCompileFlags @50 deflatePrime @51 deflatePending @52 unzOpen @61 unzClose @62 unzGetGlobalInfo @63 unzGetCurrentFileInfo @64 unzGoToFirstFile @65 unzGoToNextFile @66 unzOpenCurrentFile @67 unzReadCurrentFile @68 unzOpenCurrentFile3 @69 unztell @70 unzeof @71 unzCloseCurrentFile @72 unzGetGlobalComment @73 unzStringFileNameCompare @74 unzLocateFile @75 unzGetLocalExtrafield @76 unzOpen2 @77 unzOpenCurrentFile2 @78 unzOpenCurrentFilePassword @79 zipOpen @80 zipOpenNewFileInZip @81 zipWriteInFileInZip @82 zipCloseFileInZip @83 zipClose @84 zipOpenNewFileInZip2 @86 zipCloseFileInZipRaw @87 zipOpen2 @88 zipOpenNewFileInZip3 @89 unzGetFilePos @100 unzGoToFilePos @101 fill_win32_filefunc @110 ; zlibwapi v1.2.4 added: fill_win32_filefunc64 @111 fill_win32_filefunc64A @112 fill_win32_filefunc64W @113 unzOpen64 @120 unzOpen2_64 @121 unzGetGlobalInfo64 @122 unzGetCurrentFileInfo64 @124 unzGetCurrentFileZStreamPos64 @125 unztell64 @126 unzGetFilePos64 @127 unzGoToFilePos64 @128 zipOpen64 @130 zipOpen2_64 @131 zipOpenNewFileInZip64 @132 zipOpenNewFileInZip2_64 @133 zipOpenNewFileInZip3_64 @134 zipOpenNewFileInZip4_64 @135 zipCloseFileInZipRaw64 @136 ; zlib1 v1.2.4 added: adler32_combine @140 crc32_combine @142 deflateSetHeader @144 deflateTune @145 gzbuffer @146 gzclose_r @147 gzclose_w @148 gzdirect @149 gzoffset @150 inflateGetHeader @156 inflateMark @157 inflatePrime @158 inflateReset2 @159 inflateUndermine @160 ; zlib1 v1.2.6 added: gzgetc_ @161 inflateResetKeep @163 deflateResetKeep @164 ; zlib1 v1.2.7 added: gzopen_w @165 ; zlib1 v1.2.8 added: inflateGetDictionary @166 gzvprintf @167 ; zlib1 v1.2.9 added: inflateCodesUsed @168 inflateValidate @169 uncompress2 @170 gzfread @171 gzfwrite @172 deflateGetDictionary @173 adler32_z @174 crc32_z @175 ; zlib1 v1.2.12 added: crc32_combine_gen @176 crc32_combine_gen64 @177 crc32_combine_op @178 tcl8.6.14/compat/zlib/contrib/vstudio/vc11/zlib.rc0000644000175000017500000000167214560736523021276 0ustar sergeisergei#include #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE FILEVERSION 1, 3, 1, 0 PRODUCTVERSION 1, 3, 1, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0 // not used BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904E4" //language ID = U.S. English, char set = Windows, Multilingual BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" VALUE "FileVersion", "1.3.1\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0" VALUE "LegalCopyright", "(C) 1995-2024 Jean-loup Gailly & Mark Adler\0" END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x0409, 1252 END END tcl8.6.14/compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj0000644000175000017500000004540314554262142023753 0ustar sergeisergeiяЛП Debug Itanium Debug Win32 Debug x64 Release Itanium Release Win32 Release x64 {C52F9E7B-498A-42BE-8DB4-85A15694366A} Win32Proj Application MultiByte v110 Application Unicode v110 Application MultiByte Application MultiByte Application MultiByte v110 Application MultiByte v110 <_ProjectFileVersion>10.0.30128.1 x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ true false x86\TestZlibDll$(Configuration)\ x86\TestZlibDll$(Configuration)\Tmp\ false false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ true false ia64\TestZlibDll$(Configuration)\ ia64\TestZlibDll$(Configuration)\Tmp\ true false x64\TestZlibDll$(Configuration)\ x64\TestZlibDll$(Configuration)\Tmp\ false false ia64\TestZlibDll$(Configuration)\ ia64\TestZlibDll$(Configuration)\Tmp\ false false AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset AllRules.ruleset Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console false MachineX86 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true Default MultiThreaded false true $(IntDir) Level3 ProgramDatabase x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true false MachineX86 X64 Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineX64 Itanium Disabled ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDebugDLL false $(IntDir) Level3 ProgramDatabase ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true $(OutDir)testzlib.pdb Console MachineIA64 X64 MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineX64 Itanium MaxSpeed OnlyExplicitInline true ..\..\..;..\..\minizip;%(AdditionalIncludeDirectories) _CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions) true Default MultiThreadedDLL false true $(IntDir) Level3 ProgramDatabase ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies) $(OutDir)testzlibdll.exe true Console true true MachineIA64 {8fd826f8-3739-44e6-8cc8-997122e53b8d} tcl8.6.14/compat/zlib/contrib/gcc_gvmat64/0000755000175000017500000000000014566153412017633 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/gcc_gvmat64/gvmat64.S0000644000175000017500000004003514554262142021247 0ustar sergeisergei/* ;uInt longest_match_x64( ; deflate_state *s, ; IPos cur_match); // current match ; gvmat64.S -- Asm portion of the optimized longest_match for 32 bits x86_64 ; (AMD64 on Athlon 64, Opteron, Phenom ; and Intel EM64T on Pentium 4 with EM64T, Pentium D, Core 2 Duo, Core I5/I7) ; this file is translation from gvmat64.asm to GCC 4.x (for Linux, Mac XCode) ; Copyright (C) 1995-2010 Jean-loup Gailly, Brian Raiter and Gilles Vollant. ; ; File written by Gilles Vollant, by converting to assembly the longest_match ; from Jean-loup Gailly in deflate.c of zLib and infoZip zip. ; and by taking inspiration on asm686 with masm, optimised assembly code ; from Brian Raiter, written 1998 ; ; This software is provided 'as-is', without any express or implied ; warranty. In no event will the authors be held liable for any damages ; arising from the use of this software. ; ; Permission is granted to anyone to use this software for any purpose, ; including commercial applications, and to alter it and redistribute it ; freely, subject to the following restrictions: ; ; 1. The origin of this software must not be misrepresented; you must not ; claim that you wrote the original software. If you use this software ; in a product, an acknowledgment in the product documentation would be ; appreciated but is not required. ; 2. Altered source versions must be plainly marked as such, and must not be ; misrepresented as being the original software ; 3. This notice may not be removed or altered from any source distribution. ; ; http://www.zlib.net ; http://www.winimage.com/zLibDll ; http://www.muppetlabs.com/~breadbox/software/assembly.html ; ; to compile this file for zLib, I use option: ; gcc -c -arch x86_64 gvmat64.S ;uInt longest_match(s, cur_match) ; deflate_state *s; ; IPos cur_match; // current match / ; ; with XCode for Mac, I had strange error with some jump on intel syntax ; this is why BEFORE_JMP and AFTER_JMP are used */ #define BEFORE_JMP .att_syntax #define AFTER_JMP .intel_syntax noprefix #ifndef NO_UNDERLINE # define match_init _match_init # define longest_match _longest_match #endif .intel_syntax noprefix .globl match_init, longest_match .text longest_match: #define LocalVarsSize 96 /* ; register used : rax,rbx,rcx,rdx,rsi,rdi,r8,r9,r10,r11,r12 ; free register : r14,r15 ; register can be saved : rsp */ #define chainlenwmask (rsp + 8 - LocalVarsSize) #define nicematch (rsp + 16 - LocalVarsSize) #define save_rdi (rsp + 24 - LocalVarsSize) #define save_rsi (rsp + 32 - LocalVarsSize) #define save_rbx (rsp + 40 - LocalVarsSize) #define save_rbp (rsp + 48 - LocalVarsSize) #define save_r12 (rsp + 56 - LocalVarsSize) #define save_r13 (rsp + 64 - LocalVarsSize) #define save_r14 (rsp + 72 - LocalVarsSize) #define save_r15 (rsp + 80 - LocalVarsSize) /* ; all the +4 offsets are due to the addition of pending_buf_size (in zlib ; in the deflate_state structure since the asm code was first written ; (if you compile with zlib 1.0.4 or older, remove the +4). ; Note : these value are good with a 8 bytes boundary pack structure */ #define MAX_MATCH 258 #define MIN_MATCH 3 #define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) /* ;;; Offsets for fields in the deflate_state structure. These numbers ;;; are calculated from the definition of deflate_state, with the ;;; assumption that the compiler will dword-align the fields. (Thus, ;;; changing the definition of deflate_state could easily cause this ;;; program to crash horribly, without so much as a warning at ;;; compile time. Sigh.) ; all the +zlib1222add offsets are due to the addition of fields ; in zlib in the deflate_state structure since the asm code was first written ; (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)"). ; (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0"). ; if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8"). */ /* you can check the structure offset by running #include #include #include "deflate.h" void print_depl() { deflate_state ds; deflate_state *s=&ds; printf("size pointer=%u\n",(int)sizeof(void*)); printf("#define dsWSize %u\n",(int)(((char*)&(s->w_size))-((char*)s))); printf("#define dsWMask %u\n",(int)(((char*)&(s->w_mask))-((char*)s))); printf("#define dsWindow %u\n",(int)(((char*)&(s->window))-((char*)s))); printf("#define dsPrev %u\n",(int)(((char*)&(s->prev))-((char*)s))); printf("#define dsMatchLen %u\n",(int)(((char*)&(s->match_length))-((char*)s))); printf("#define dsPrevMatch %u\n",(int)(((char*)&(s->prev_match))-((char*)s))); printf("#define dsStrStart %u\n",(int)(((char*)&(s->strstart))-((char*)s))); printf("#define dsMatchStart %u\n",(int)(((char*)&(s->match_start))-((char*)s))); printf("#define dsLookahead %u\n",(int)(((char*)&(s->lookahead))-((char*)s))); printf("#define dsPrevLen %u\n",(int)(((char*)&(s->prev_length))-((char*)s))); printf("#define dsMaxChainLen %u\n",(int)(((char*)&(s->max_chain_length))-((char*)s))); printf("#define dsGoodMatch %u\n",(int)(((char*)&(s->good_match))-((char*)s))); printf("#define dsNiceMatch %u\n",(int)(((char*)&(s->nice_match))-((char*)s))); } */ #define dsWSize 68 #define dsWMask 76 #define dsWindow 80 #define dsPrev 96 #define dsMatchLen 144 #define dsPrevMatch 148 #define dsStrStart 156 #define dsMatchStart 160 #define dsLookahead 164 #define dsPrevLen 168 #define dsMaxChainLen 172 #define dsGoodMatch 188 #define dsNiceMatch 192 #define window_size [ rcx + dsWSize] #define WMask [ rcx + dsWMask] #define window_ad [ rcx + dsWindow] #define prev_ad [ rcx + dsPrev] #define strstart [ rcx + dsStrStart] #define match_start [ rcx + dsMatchStart] #define Lookahead [ rcx + dsLookahead] //; 0ffffffffh on infozip #define prev_length [ rcx + dsPrevLen] #define max_chain_length [ rcx + dsMaxChainLen] #define good_match [ rcx + dsGoodMatch] #define nice_match [ rcx + dsNiceMatch] /* ; windows: ; parameter 1 in rcx(deflate state s), param 2 in rdx (cur match) ; see http://weblogs.asp.net/oldnewthing/archive/2004/01/14/58579.aspx and ; http://msdn.microsoft.com/library/en-us/kmarch/hh/kmarch/64bitAMD_8e951dd2-ee77-4728-8702-55ce4b5dd24a.xml.asp ; ; All registers must be preserved across the call, except for ; rax, rcx, rdx, r8, r9, r10, and r11, which are scratch. ; ; gcc on macosx-linux: ; see http://www.x86-64.org/documentation/abi-0.99.pdf ; param 1 in rdi, param 2 in rsi ; rbx, rsp, rbp, r12 to r15 must be preserved ;;; Save registers that the compiler may be using, and adjust esp to ;;; make room for our stack frame. ;;; Retrieve the function arguments. r8d will hold cur_match ;;; throughout the entire function. edx will hold the pointer to the ;;; deflate_state structure during the function's setup (before ;;; entering the main loop. ; ms: parameter 1 in rcx (deflate_state* s), param 2 in edx -> r8 (cur match) ; mac: param 1 in rdi, param 2 rsi ; this clear high 32 bits of r8, which can be garbage in both r8 and rdx */ mov [save_rbx],rbx mov [save_rbp],rbp mov rcx,rdi mov r8d,esi mov [save_r12],r12 mov [save_r13],r13 mov [save_r14],r14 mov [save_r15],r15 //;;; uInt wmask = s->w_mask; //;;; unsigned chain_length = s->max_chain_length; //;;; if (s->prev_length >= s->good_match) { //;;; chain_length >>= 2; //;;; } mov edi, prev_length mov esi, good_match mov eax, WMask mov ebx, max_chain_length cmp edi, esi jl LastMatchGood shr ebx, 2 LastMatchGood: //;;; chainlen is decremented once beforehand so that the function can //;;; use the sign flag instead of the zero flag for the exit test. //;;; It is then shifted into the high word, to make room for the wmask //;;; value, which it will always accompany. dec ebx shl ebx, 16 or ebx, eax //;;; on zlib only //;;; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; mov eax, nice_match mov [chainlenwmask], ebx mov r10d, Lookahead cmp r10d, eax cmovnl r10d, eax mov [nicematch],r10d //;;; register Bytef *scan = s->window + s->strstart; mov r10, window_ad mov ebp, strstart lea r13, [r10 + rbp] //;;; Determine how many bytes the scan ptr is off from being //;;; dword-aligned. mov r9,r13 neg r13 and r13,3 //;;; IPos limit = s->strstart > (IPos)MAX_DIST(s) ? //;;; s->strstart - (IPos)MAX_DIST(s) : NIL; mov eax, window_size sub eax, MIN_LOOKAHEAD xor edi,edi sub ebp, eax mov r11d, prev_length cmovng ebp,edi //;;; int best_len = s->prev_length; //;;; Store the sum of s->window + best_len in esi locally, and in esi. lea rsi,[r10+r11] //;;; register ush scan_start = *(ushf*)scan; //;;; register ush scan_end = *(ushf*)(scan+best_len-1); //;;; Posf *prev = s->prev; movzx r12d,word ptr [r9] movzx ebx, word ptr [r9 + r11 - 1] mov rdi, prev_ad //;;; Jump into the main loop. mov edx, [chainlenwmask] cmp bx,word ptr [rsi + r8 - 1] jz LookupLoopIsZero LookupLoop1: and r8d, edx movzx r8d, word ptr [rdi + r8*2] cmp r8d, ebp jbe LeaveNow sub edx, 0x00010000 BEFORE_JMP js LeaveNow AFTER_JMP LoopEntry1: cmp bx,word ptr [rsi + r8 - 1] BEFORE_JMP jz LookupLoopIsZero AFTER_JMP LookupLoop2: and r8d, edx movzx r8d, word ptr [rdi + r8*2] cmp r8d, ebp BEFORE_JMP jbe LeaveNow AFTER_JMP sub edx, 0x00010000 BEFORE_JMP js LeaveNow AFTER_JMP LoopEntry2: cmp bx,word ptr [rsi + r8 - 1] BEFORE_JMP jz LookupLoopIsZero AFTER_JMP LookupLoop4: and r8d, edx movzx r8d, word ptr [rdi + r8*2] cmp r8d, ebp BEFORE_JMP jbe LeaveNow AFTER_JMP sub edx, 0x00010000 BEFORE_JMP js LeaveNow AFTER_JMP LoopEntry4: cmp bx,word ptr [rsi + r8 - 1] BEFORE_JMP jnz LookupLoop1 jmp LookupLoopIsZero AFTER_JMP /* ;;; do { ;;; match = s->window + cur_match; ;;; if (*(ushf*)(match+best_len-1) != scan_end || ;;; *(ushf*)match != scan_start) continue; ;;; [...] ;;; } while ((cur_match = prev[cur_match & wmask]) > limit ;;; && --chain_length != 0); ;;; ;;; Here is the inner loop of the function. The function will spend the ;;; majority of its time in this loop, and majority of that time will ;;; be spent in the first ten instructions. ;;; ;;; Within this loop: ;;; ebx = scanend ;;; r8d = curmatch ;;; edx = chainlenwmask - i.e., ((chainlen << 16) | wmask) ;;; esi = windowbestlen - i.e., (window + bestlen) ;;; edi = prev ;;; ebp = limit */ .balign 16 LookupLoop: and r8d, edx movzx r8d, word ptr [rdi + r8*2] cmp r8d, ebp BEFORE_JMP jbe LeaveNow AFTER_JMP sub edx, 0x00010000 BEFORE_JMP js LeaveNow AFTER_JMP LoopEntry: cmp bx,word ptr [rsi + r8 - 1] BEFORE_JMP jnz LookupLoop1 AFTER_JMP LookupLoopIsZero: cmp r12w, word ptr [r10 + r8] BEFORE_JMP jnz LookupLoop1 AFTER_JMP //;;; Store the current value of chainlen. mov [chainlenwmask], edx /* ;;; Point edi to the string under scrutiny, and esi to the string we ;;; are hoping to match it up with. In actuality, esi and edi are ;;; both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and edx is ;;; initialized to -(MAX_MATCH_8 - scanalign). */ lea rsi,[r8+r10] mov rdx, 0xfffffffffffffef8 //; -(MAX_MATCH_8) lea rsi, [rsi + r13 + 0x0108] //;MAX_MATCH_8] lea rdi, [r9 + r13 + 0x0108] //;MAX_MATCH_8] prefetcht1 [rsi+rdx] prefetcht1 [rdi+rdx] /* ;;; Test the strings for equality, 8 bytes at a time. At the end, ;;; adjust rdx so that it is offset to the exact byte that mismatched. ;;; ;;; We already know at this point that the first three bytes of the ;;; strings match each other, and they can be safely passed over before ;;; starting the compare loop. So what this code does is skip over 0-3 ;;; bytes, as much as necessary in order to dword-align the edi ;;; pointer. (rsi will still be misaligned three times out of four.) ;;; ;;; It should be confessed that this loop usually does not represent ;;; much of the total running time. Replacing it with a more ;;; straightforward "rep cmpsb" would not drastically degrade ;;; performance. */ LoopCmps: mov rax, [rsi + rdx] xor rax, [rdi + rdx] jnz LeaveLoopCmps mov rax, [rsi + rdx + 8] xor rax, [rdi + rdx + 8] jnz LeaveLoopCmps8 mov rax, [rsi + rdx + 8+8] xor rax, [rdi + rdx + 8+8] jnz LeaveLoopCmps16 add rdx,8+8+8 BEFORE_JMP jnz LoopCmps jmp LenMaximum AFTER_JMP LeaveLoopCmps16: add rdx,8 LeaveLoopCmps8: add rdx,8 LeaveLoopCmps: test eax, 0x0000FFFF jnz LenLower test eax,0xffffffff jnz LenLower32 add rdx,4 shr rax,32 or ax,ax BEFORE_JMP jnz LenLower AFTER_JMP LenLower32: shr eax,16 add rdx,2 LenLower: sub al, 1 adc rdx, 0 //;;; Calculate the length of the match. If it is longer than MAX_MATCH, //;;; then automatically accept it as the best possible match and leave. lea rax, [rdi + rdx] sub rax, r9 cmp eax, MAX_MATCH BEFORE_JMP jge LenMaximum AFTER_JMP /* ;;; If the length of the match is not longer than the best match we ;;; have so far, then forget it and return to the lookup loop. ;/////////////////////////////////// */ cmp eax, r11d jg LongerMatch lea rsi,[r10+r11] mov rdi, prev_ad mov edx, [chainlenwmask] BEFORE_JMP jmp LookupLoop AFTER_JMP /* ;;; s->match_start = cur_match; ;;; best_len = len; ;;; if (len >= nice_match) break; ;;; scan_end = *(ushf*)(scan+best_len-1); */ LongerMatch: mov r11d, eax mov match_start, r8d cmp eax, [nicematch] BEFORE_JMP jge LeaveNow AFTER_JMP lea rsi,[r10+rax] movzx ebx, word ptr [r9 + rax - 1] mov rdi, prev_ad mov edx, [chainlenwmask] BEFORE_JMP jmp LookupLoop AFTER_JMP //;;; Accept the current string, with the maximum possible length. LenMaximum: mov r11d,MAX_MATCH mov match_start, r8d //;;; if ((uInt)best_len <= s->lookahead) return (uInt)best_len; //;;; return s->lookahead; LeaveNow: mov eax, Lookahead cmp r11d, eax cmovng eax, r11d //;;; Restore the stack and return from whence we came. // mov rsi,[save_rsi] // mov rdi,[save_rdi] mov rbx,[save_rbx] mov rbp,[save_rbp] mov r12,[save_r12] mov r13,[save_r13] mov r14,[save_r14] mov r15,[save_r15] ret 0 //; please don't remove this string ! //; Your can freely use gvmat64 in any free or commercial app //; but it is far better don't remove the string in the binary! // db 0dh,0ah,"asm686 with masm, optimised assembly code from Brian Raiter, written 1998, converted to amd 64 by Gilles Vollant 2005",0dh,0ah,0 match_init: ret 0 tcl8.6.14/compat/zlib/contrib/delphi/0000755000175000017500000000000014566153412016774 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/delphi/ZLib.pas0000644000175000017500000004003414560736523020346 0ustar sergeisergei{*******************************************************} { } { Borland Delphi Supplemental Components } { ZLIB Data Compression Interface Unit } { } { Copyright (c) 1997,99 Borland Corporation } { } {*******************************************************} { Updated for zlib 1.2.x by Cosmin Truta } unit ZLib; interface uses SysUtils, Classes; type TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; cdecl; TFree = procedure (AppData, Block: Pointer); cdecl; // Internal structure. Ignore. TZStreamRec = packed record next_in: PChar; // next input byte avail_in: Integer; // number of bytes available at next_in total_in: Longint; // total nb of input bytes read so far next_out: PChar; // next output byte should be put here avail_out: Integer; // remaining free space at next_out total_out: Longint; // total nb of bytes output so far msg: PChar; // last error message, NULL if no error internal: Pointer; // not visible by applications zalloc: TAlloc; // used to allocate the internal state zfree: TFree; // used to free the internal state AppData: Pointer; // private data object passed to zalloc and zfree data_type: Integer; // best guess about the data type: ascii or binary adler: Longint; // adler32 value of the uncompressed data reserved: Longint; // reserved for future use end; // Abstract ancestor class TCustomZlibStream = class(TStream) private FStrm: TStream; FStrmPos: Integer; FOnProgress: TNotifyEvent; FZRec: TZStreamRec; FBuffer: array [Word] of Char; protected procedure Progress(Sender: TObject); dynamic; property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; constructor Create(Strm: TStream); end; { TCompressionStream compresses data on the fly as data is written to it, and stores the compressed data to another stream. TCompressionStream is write-only and strictly sequential. Reading from the stream will raise an exception. Using Seek to move the stream pointer will raise an exception. Output data is cached internally, written to the output stream only when the internal output buffer is full. All pending output data is flushed when the stream is destroyed. The Position property returns the number of uncompressed bytes of data that have been written to the stream so far. CompressionRate returns the on-the-fly percentage by which the original data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100 If raw data size = 100 and compressed data size = 25, the CompressionRate is 75% The OnProgress event is called each time the output buffer is filled and written to the output stream. This is useful for updating a progress indicator when you are writing a large chunk of data to the compression stream in a single call.} TCompressionLevel = (clNone, clFastest, clDefault, clMax); TCompressionStream = class(TCustomZlibStream) private function GetCompressionRate: Single; public constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream); destructor Destroy; override; function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; function Seek(Offset: Longint; Origin: Word): Longint; override; property CompressionRate: Single read GetCompressionRate; property OnProgress; end; { TDecompressionStream decompresses data on the fly as data is read from it. Compressed data comes from a separate source stream. TDecompressionStream is read-only and unidirectional; you can seek forward in the stream, but not backwards. The special case of setting the stream position to zero is allowed. Seeking forward decompresses data until the requested position in the uncompressed data has been reached. Seeking backwards, seeking relative to the end of the stream, requesting the size of the stream, and writing to the stream will raise an exception. The Position property returns the number of bytes of uncompressed data that have been read from the stream so far. The OnProgress event is called each time the internal input buffer of compressed data is exhausted and the next block is read from the input stream. This is useful for updating a progress indicator when you are reading a large chunk of data from the decompression stream in a single call.} TDecompressionStream = class(TCustomZlibStream) public constructor Create(Source: TStream); destructor Destroy; override; function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; function Seek(Offset: Longint; Origin: Word): Longint; override; property OnProgress; end; { CompressBuf compresses data, buffer to buffer, in one call. In: InBuf = ptr to compressed data InBytes = number of bytes in InBuf Out: OutBuf = ptr to newly allocated buffer containing decompressed data OutBytes = number of bytes in OutBuf } procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; out OutBuf: Pointer; out OutBytes: Integer); { DecompressBuf decompresses data, buffer to buffer, in one call. In: InBuf = ptr to compressed data InBytes = number of bytes in InBuf OutEstimate = zero, or est. size of the decompressed data Out: OutBuf = ptr to newly allocated buffer containing decompressed data OutBytes = number of bytes in OutBuf } procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); { DecompressToUserBuf decompresses data, buffer to buffer, in one call. In: InBuf = ptr to compressed data InBytes = number of bytes in InBuf Out: OutBuf = ptr to user-allocated buffer to contain decompressed data BufSize = number of bytes in OutBuf } procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer; const OutBuf: Pointer; BufSize: Integer); const zlib_version = '1.3.1'; type EZlibError = class(Exception); ECompressionError = class(EZlibError); EDecompressionError = class(EZlibError); implementation uses ZLibConst; const Z_NO_FLUSH = 0; Z_PARTIAL_FLUSH = 1; Z_SYNC_FLUSH = 2; Z_FULL_FLUSH = 3; Z_FINISH = 4; Z_OK = 0; Z_STREAM_END = 1; Z_NEED_DICT = 2; Z_ERRNO = (-1); Z_STREAM_ERROR = (-2); Z_DATA_ERROR = (-3); Z_MEM_ERROR = (-4); Z_BUF_ERROR = (-5); Z_VERSION_ERROR = (-6); Z_NO_COMPRESSION = 0; Z_BEST_SPEED = 1; Z_BEST_COMPRESSION = 9; Z_DEFAULT_COMPRESSION = (-1); Z_FILTERED = 1; Z_HUFFMAN_ONLY = 2; Z_RLE = 3; Z_DEFAULT_STRATEGY = 0; Z_BINARY = 0; Z_ASCII = 1; Z_UNKNOWN = 2; Z_DEFLATED = 8; {$L adler32.obj} {$L compress.obj} {$L crc32.obj} {$L deflate.obj} {$L infback.obj} {$L inffast.obj} {$L inflate.obj} {$L inftrees.obj} {$L trees.obj} {$L uncompr.obj} {$L zutil.obj} procedure adler32; external; procedure compressBound; external; procedure crc32; external; procedure deflateInit2_; external; procedure deflateParams; external; function _malloc(Size: Integer): Pointer; cdecl; begin Result := AllocMem(Size); end; procedure _free(Block: Pointer); cdecl; begin FreeMem(Block); end; procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl; begin FillChar(P^, count, B); end; procedure _memcpy(dest, source: Pointer; count: Integer); cdecl; begin Move(source^, dest^, count); end; // deflate compresses data function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; recsize: Integer): Integer; external; function deflate(var strm: TZStreamRec; flush: Integer): Integer; external; function deflateEnd(var strm: TZStreamRec): Integer; external; // inflate decompresses data function inflateInit_(var strm: TZStreamRec; version: PChar; recsize: Integer): Integer; external; function inflate(var strm: TZStreamRec; flush: Integer): Integer; external; function inflateEnd(var strm: TZStreamRec): Integer; external; function inflateReset(var strm: TZStreamRec): Integer; external; function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl; begin // GetMem(Result, Items*Size); Result := AllocMem(Items * Size); end; procedure zlibFreeMem(AppData, Block: Pointer); cdecl; begin FreeMem(Block); end; {function zlibCheck(code: Integer): Integer; begin Result := code; if code < 0 then raise EZlibError.Create('error'); //!! end;} function CCheck(code: Integer): Integer; begin Result := code; if code < 0 then raise ECompressionError.Create('error'); //!! end; function DCheck(code: Integer): Integer; begin Result := code; if code < 0 then raise EDecompressionError.Create('error'); //!! end; procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; out OutBuf: Pointer; out OutBytes: Integer); var strm: TZStreamRec; P: Pointer; begin FillChar(strm, sizeof(strm), 0); strm.zalloc := zlibAllocMem; strm.zfree := zlibFreeMem; OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; GetMem(OutBuf, OutBytes); try strm.next_in := InBuf; strm.avail_in := InBytes; strm.next_out := OutBuf; strm.avail_out := OutBytes; CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm))); try while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do begin P := OutBuf; Inc(OutBytes, 256); ReallocMem(OutBuf, OutBytes); strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); strm.avail_out := 256; end; finally CCheck(deflateEnd(strm)); end; ReallocMem(OutBuf, strm.total_out); OutBytes := strm.total_out; except FreeMem(OutBuf); raise end; end; procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); var strm: TZStreamRec; P: Pointer; BufInc: Integer; begin FillChar(strm, sizeof(strm), 0); strm.zalloc := zlibAllocMem; strm.zfree := zlibFreeMem; BufInc := (InBytes + 255) and not 255; if OutEstimate = 0 then OutBytes := BufInc else OutBytes := OutEstimate; GetMem(OutBuf, OutBytes); try strm.next_in := InBuf; strm.avail_in := InBytes; strm.next_out := OutBuf; strm.avail_out := OutBytes; DCheck(inflateInit_(strm, zlib_version, sizeof(strm))); try while DCheck(inflate(strm, Z_NO_FLUSH)) <> Z_STREAM_END do begin P := OutBuf; Inc(OutBytes, BufInc); ReallocMem(OutBuf, OutBytes); strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); strm.avail_out := BufInc; end; finally DCheck(inflateEnd(strm)); end; ReallocMem(OutBuf, strm.total_out); OutBytes := strm.total_out; except FreeMem(OutBuf); raise end; end; procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer; const OutBuf: Pointer; BufSize: Integer); var strm: TZStreamRec; begin FillChar(strm, sizeof(strm), 0); strm.zalloc := zlibAllocMem; strm.zfree := zlibFreeMem; strm.next_in := InBuf; strm.avail_in := InBytes; strm.next_out := OutBuf; strm.avail_out := BufSize; DCheck(inflateInit_(strm, zlib_version, sizeof(strm))); try if DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END then raise EZlibError.CreateRes(@sTargetBufferTooSmall); finally DCheck(inflateEnd(strm)); end; end; // TCustomZlibStream constructor TCustomZLibStream.Create(Strm: TStream); begin inherited Create; FStrm := Strm; FStrmPos := Strm.Position; FZRec.zalloc := zlibAllocMem; FZRec.zfree := zlibFreeMem; end; procedure TCustomZLibStream.Progress(Sender: TObject); begin if Assigned(FOnProgress) then FOnProgress(Sender); end; // TCompressionStream constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel; Dest: TStream); const Levels: array [TCompressionLevel] of ShortInt = (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION); begin inherited Create(Dest); FZRec.next_out := FBuffer; FZRec.avail_out := sizeof(FBuffer); CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec))); end; destructor TCompressionStream.Destroy; begin FZRec.next_in := nil; FZRec.avail_in := 0; try if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END) and (FZRec.avail_out = 0) do begin FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); FZRec.next_out := FBuffer; FZRec.avail_out := sizeof(FBuffer); end; if FZRec.avail_out < sizeof(FBuffer) then FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out); finally deflateEnd(FZRec); end; inherited Destroy; end; function TCompressionStream.Read(var Buffer; Count: Longint): Longint; begin raise ECompressionError.CreateRes(@sInvalidStreamOp); end; function TCompressionStream.Write(const Buffer; Count: Longint): Longint; begin FZRec.next_in := @Buffer; FZRec.avail_in := Count; if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; while (FZRec.avail_in > 0) do begin CCheck(deflate(FZRec, 0)); if FZRec.avail_out = 0 then begin FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); FZRec.next_out := FBuffer; FZRec.avail_out := sizeof(FBuffer); FStrmPos := FStrm.Position; Progress(Self); end; end; Result := Count; end; function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint; begin if (Offset = 0) and (Origin = soFromCurrent) then Result := FZRec.total_in else raise ECompressionError.CreateRes(@sInvalidStreamOp); end; function TCompressionStream.GetCompressionRate: Single; begin if FZRec.total_in = 0 then Result := 0 else Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0; end; // TDecompressionStream constructor TDecompressionStream.Create(Source: TStream); begin inherited Create(Source); FZRec.next_in := FBuffer; FZRec.avail_in := 0; DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec))); end; destructor TDecompressionStream.Destroy; begin FStrm.Seek(-FZRec.avail_in, 1); inflateEnd(FZRec); inherited Destroy; end; function TDecompressionStream.Read(var Buffer; Count: Longint): Longint; begin FZRec.next_out := @Buffer; FZRec.avail_out := Count; if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; while (FZRec.avail_out > 0) do begin if FZRec.avail_in = 0 then begin FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer)); if FZRec.avail_in = 0 then begin Result := Count - FZRec.avail_out; Exit; end; FZRec.next_in := FBuffer; FStrmPos := FStrm.Position; Progress(Self); end; CCheck(inflate(FZRec, 0)); end; Result := Count; end; function TDecompressionStream.Write(const Buffer; Count: Longint): Longint; begin raise EDecompressionError.CreateRes(@sInvalidStreamOp); end; function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint; var I: Integer; Buf: array [0..4095] of Char; begin if (Offset = 0) and (Origin = soFromBeginning) then begin DCheck(inflateReset(FZRec)); FZRec.next_in := FBuffer; FZRec.avail_in := 0; FStrm.Position := 0; FStrmPos := 0; end else if ( (Offset >= 0) and (Origin = soFromCurrent)) or ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then begin if Origin = soFromBeginning then Dec(Offset, FZRec.total_out); if Offset > 0 then begin for I := 1 to Offset div sizeof(Buf) do ReadBuffer(Buf, sizeof(Buf)); ReadBuffer(Buf, Offset mod sizeof(Buf)); end; end else raise EDecompressionError.CreateRes(@sInvalidStreamOp); Result := FZRec.total_out; end; end. tcl8.6.14/compat/zlib/contrib/delphi/readme.txt0000644000175000017500000000470414554262142020775 0ustar sergeisergei Overview ======== This directory contains an update to the ZLib interface unit, distributed by Borland as a Delphi supplemental component. The original ZLib unit is Copyright (c) 1997,99 Borland Corp., and is based on zlib version 1.0.4. There are a series of bugs and security problems associated with that old zlib version, and we recommend the users to update their ZLib unit. Summary of modifications ======================== - Improved makefile, adapted to zlib version 1.2.1. - Some field types from TZStreamRec are changed from Integer to Longint, for consistency with the zlib.h header, and for 64-bit readiness. - The zlib_version constant is updated. - The new Z_RLE strategy has its corresponding symbolic constant. - The allocation and deallocation functions and function types (TAlloc, TFree, zlibAllocMem and zlibFreeMem) are now cdecl, and _malloc and _free are added as C RTL stubs. As a result, the original C sources of zlib can be compiled out of the box, and linked to the ZLib unit. Suggestions for improvements ============================ Currently, the ZLib unit provides only a limited wrapper around the zlib library, and much of the original zlib functionality is missing. Handling compressed file formats like ZIP/GZIP or PNG cannot be implemented without having this functionality. Applications that handle these formats are either using their own, duplicated code, or not using the ZLib unit at all. Here are a few suggestions: - Checksum class wrappers around adler32() and crc32(), similar to the Java classes that implement the java.util.zip.Checksum interface. - The ability to read and write raw deflate streams, without the zlib stream header and trailer. Raw deflate streams are used in the ZIP file format. - The ability to read and write gzip streams, used in the GZIP file format, and normally produced by the gzip program. - The ability to select a different compression strategy, useful to PNG and MNG image compression, and to multimedia compression in general. Besides the compression level TCompressionLevel = (clNone, clFastest, clDefault, clMax); which, in fact, could have used the 'z' prefix and avoided TColor-like symbols TCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax); there could be a compression strategy TCompressionStrategy = (zsDefault, zsFiltered, zsHuffmanOnly, zsRle); - ZIP and GZIP stream handling via TStreams. -- Cosmin Truta tcl8.6.14/compat/zlib/contrib/delphi/ZLibConst.pas0000644000175000017500000000027214554262142021347 0ustar sergeisergeiunit ZLibConst; interface resourcestring sTargetBufferTooSmall = 'ZLib error: target buffer may be too small'; sInvalidStreamOp = 'Invalid stream operation'; implementation end. tcl8.6.14/compat/zlib/contrib/delphi/zlibd32.mak0000644000175000017500000000447014554262142020742 0ustar sergeisergei# Makefile for zlib # For use with Delphi and C++ Builder under Win32 # Updated for zlib 1.2.x by Cosmin Truta # ------------ Borland C++ ------------ # This project uses the Delphi (fastcall/register) calling convention: LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl CC = bcc32 LD = bcc32 AR = tlib # do not use "-pr" in CFLAGS CFLAGS = -a -d -k- -O2 $(LOC) LDFLAGS = # variables ZLIB_LIB = zlib.lib OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj # targets all: $(ZLIB_LIB) example.exe minigzip.exe .c.obj: $(CC) -c $(CFLAGS) $*.c adler32.obj: adler32.c zlib.h zconf.h compress.obj: compress.c zlib.h zconf.h crc32.obj: crc32.c zlib.h zconf.h crc32.h deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h gzread.obj: gzread.c zlib.h zconf.h gzguts.h gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h uncompr.obj: uncompr.c zlib.h zconf.h zutil.obj: zutil.c zutil.h zlib.h zconf.h example.obj: test/example.c zlib.h zconf.h minigzip.obj: test/minigzip.c zlib.h zconf.h # For the sake of the old Borland make, # the command line is cut to fit in the MS-DOS 128 byte limit: $(ZLIB_LIB): $(OBJ1) $(OBJ2) -del $(ZLIB_LIB) $(AR) $(ZLIB_LIB) $(OBJP1) $(AR) $(ZLIB_LIB) $(OBJP2) # testing test: example.exe minigzip.exe example echo hello world | minigzip | minigzip -d example.exe: example.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB) minigzip.exe: minigzip.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB) # cleanup clean: -del *.obj -del *.exe -del *.lib -del *.tds -del zlib.bak -del foo.gz tcl8.6.14/compat/zlib/contrib/inflate86/0000755000175000017500000000000014566153412017327 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/inflate86/inffas86.c0000644000175000017500000011724014554262142021122 0ustar sergeisergei/* inffas86.c is a hand tuned assembler version of * * inffast.c -- fast decoding * Copyright (C) 1995-2003 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h * * Copyright (C) 2003 Chris Anderson * Please use the copyright conditions above. * * Dec-29-2003 -- I added AMD64 inflate asm support. This version is also * slightly quicker on x86 systems because, instead of using rep movsb to copy * data, it uses rep movsw, which moves data in 2-byte chunks instead of single * bytes. I've tested the AMD64 code on a Fedora Core 1 + the x86_64 updates * from http://fedora.linux.duke.edu/fc1_x86_64 * which is running on an Athlon 64 3000+ / Gigabyte GA-K8VT800M system with * 1GB ram. The 64-bit version is about 4% faster than the 32-bit version, * when decompressing mozilla-source-1.3.tar.gz. * * Mar-13-2003 -- Most of this is derived from inffast.S which is derived from * the gcc -S output of zlib-1.2.0/inffast.c. Zlib-1.2.0 is in beta release at * the moment. I have successfully compiled and tested this code with gcc2.96, * gcc3.2, icc5.0, msvc6.0. It is very close to the speed of inffast.S * compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX * enabled. I will attempt to merge the MMX code into this version. Newer * versions of this and inffast.S can be found at * http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/ */ #include "zutil.h" #include "inftrees.h" #include "inflate.h" #include "inffast.h" /* Mark Adler's comments from inffast.c: */ /* Decode literal, length, and distance codes and write out the resulting literal and match bytes until either not enough input or output is available, an end-of-block is encountered, or a data error is encountered. When large enough input and output buffers are supplied to inflate(), for example, a 16K input buffer and a 64K output buffer, more than 95% of the inflate execution time is spent in this routine. Entry assumptions: state->mode == LEN strm->avail_in >= 6 strm->avail_out >= 258 start >= strm->avail_out state->bits < 8 On return, state->mode is one of: LEN -- ran out of enough output space or enough available input TYPE -- reached end of block code, inflate() to interpret next block BAD -- error in block data Notes: - The maximum input bits used by a length/distance pair is 15 bits for the length code, 5 bits for the length extra, 15 bits for the distance code, and 13 bits for the distance extra. This totals 48 bits, or six bytes. Therefore if strm->avail_in >= 6, then there is enough input to avoid checking for available input while decoding. - The maximum bytes that a single length/distance pair can output is 258 bytes, which is the maximum length that can be coded. inflate_fast() requires strm->avail_out >= 258 for each loop to avoid checking for output space. */ void inflate_fast(strm, start) z_streamp strm; unsigned start; /* inflate()'s starting value for strm->avail_out */ { struct inflate_state FAR *state; struct inffast_ar { /* 64 32 x86 x86_64 */ /* ar offset register */ /* 0 0 */ void *esp; /* esp save */ /* 8 4 */ void *ebp; /* ebp save */ /* 16 8 */ unsigned char FAR *in; /* esi rsi local strm->next_in */ /* 24 12 */ unsigned char FAR *last; /* r9 while in < last */ /* 32 16 */ unsigned char FAR *out; /* edi rdi local strm->next_out */ /* 40 20 */ unsigned char FAR *beg; /* inflate()'s init next_out */ /* 48 24 */ unsigned char FAR *end; /* r10 while out < end */ /* 56 28 */ unsigned char FAR *window;/* size of window, wsize!=0 */ /* 64 32 */ code const FAR *lcode; /* ebp rbp local strm->lencode */ /* 72 36 */ code const FAR *dcode; /* r11 local strm->distcode */ /* 80 40 */ unsigned long hold; /* edx rdx local strm->hold */ /* 88 44 */ unsigned bits; /* ebx rbx local strm->bits */ /* 92 48 */ unsigned wsize; /* window size */ /* 96 52 */ unsigned write; /* window write index */ /*100 56 */ unsigned lmask; /* r12 mask for lcode */ /*104 60 */ unsigned dmask; /* r13 mask for dcode */ /*108 64 */ unsigned len; /* r14 match length */ /*112 68 */ unsigned dist; /* r15 match distance */ /*116 72 */ unsigned status; /* set when state chng*/ } ar; #if defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 ) #define PAD_AVAIL_IN 6 #define PAD_AVAIL_OUT 258 #else #define PAD_AVAIL_IN 5 #define PAD_AVAIL_OUT 257 #endif /* copy state to local variables */ state = (struct inflate_state FAR *)strm->state; ar.in = strm->next_in; ar.last = ar.in + (strm->avail_in - PAD_AVAIL_IN); ar.out = strm->next_out; ar.beg = ar.out - (start - strm->avail_out); ar.end = ar.out + (strm->avail_out - PAD_AVAIL_OUT); ar.wsize = state->wsize; ar.write = state->wnext; ar.window = state->window; ar.hold = state->hold; ar.bits = state->bits; ar.lcode = state->lencode; ar.dcode = state->distcode; ar.lmask = (1U << state->lenbits) - 1; ar.dmask = (1U << state->distbits) - 1; /* decode literals and length/distances until end-of-block or not enough input data or output space */ /* align in on 1/2 hold size boundary */ while (((unsigned long)(void *)ar.in & (sizeof(ar.hold) / 2 - 1)) != 0) { ar.hold += (unsigned long)*ar.in++ << ar.bits; ar.bits += 8; } #if defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 ) __asm__ __volatile__ ( " leaq %0, %%rax\n" " movq %%rbp, 8(%%rax)\n" /* save regs rbp and rsp */ " movq %%rsp, (%%rax)\n" " movq %%rax, %%rsp\n" /* make rsp point to &ar */ " movq 16(%%rsp), %%rsi\n" /* rsi = in */ " movq 32(%%rsp), %%rdi\n" /* rdi = out */ " movq 24(%%rsp), %%r9\n" /* r9 = last */ " movq 48(%%rsp), %%r10\n" /* r10 = end */ " movq 64(%%rsp), %%rbp\n" /* rbp = lcode */ " movq 72(%%rsp), %%r11\n" /* r11 = dcode */ " movq 80(%%rsp), %%rdx\n" /* rdx = hold */ " movl 88(%%rsp), %%ebx\n" /* ebx = bits */ " movl 100(%%rsp), %%r12d\n" /* r12d = lmask */ " movl 104(%%rsp), %%r13d\n" /* r13d = dmask */ /* r14d = len */ /* r15d = dist */ " cld\n" " cmpq %%rdi, %%r10\n" " je .L_one_time\n" /* if only one decode left */ " cmpq %%rsi, %%r9\n" " je .L_one_time\n" " jmp .L_do_loop\n" ".L_one_time:\n" " movq %%r12, %%r8\n" /* r8 = lmask */ " cmpb $32, %%bl\n" " ja .L_get_length_code_one_time\n" " lodsl\n" /* eax = *(uint *)in++ */ " movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */ " addb $32, %%bl\n" /* bits += 32 */ " shlq %%cl, %%rax\n" " orq %%rax, %%rdx\n" /* hold |= *((uint *)in)++ << bits */ " jmp .L_get_length_code_one_time\n" ".align 32,0x90\n" ".L_while_test:\n" " cmpq %%rdi, %%r10\n" " jbe .L_break_loop\n" " cmpq %%rsi, %%r9\n" " jbe .L_break_loop\n" ".L_do_loop:\n" " movq %%r12, %%r8\n" /* r8 = lmask */ " cmpb $32, %%bl\n" " ja .L_get_length_code\n" /* if (32 < bits) */ " lodsl\n" /* eax = *(uint *)in++ */ " movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */ " addb $32, %%bl\n" /* bits += 32 */ " shlq %%cl, %%rax\n" " orq %%rax, %%rdx\n" /* hold |= *((uint *)in)++ << bits */ ".L_get_length_code:\n" " andq %%rdx, %%r8\n" /* r8 &= hold */ " movl (%%rbp,%%r8,4), %%eax\n" /* eax = lcode[hold & lmask] */ " movb %%ah, %%cl\n" /* cl = this.bits */ " subb %%ah, %%bl\n" /* bits -= this.bits */ " shrq %%cl, %%rdx\n" /* hold >>= this.bits */ " testb %%al, %%al\n" " jnz .L_test_for_length_base\n" /* if (op != 0) 45.7% */ " movq %%r12, %%r8\n" /* r8 = lmask */ " shrl $16, %%eax\n" /* output this.val char */ " stosb\n" ".L_get_length_code_one_time:\n" " andq %%rdx, %%r8\n" /* r8 &= hold */ " movl (%%rbp,%%r8,4), %%eax\n" /* eax = lcode[hold & lmask] */ ".L_dolen:\n" " movb %%ah, %%cl\n" /* cl = this.bits */ " subb %%ah, %%bl\n" /* bits -= this.bits */ " shrq %%cl, %%rdx\n" /* hold >>= this.bits */ " testb %%al, %%al\n" " jnz .L_test_for_length_base\n" /* if (op != 0) 45.7% */ " shrl $16, %%eax\n" /* output this.val char */ " stosb\n" " jmp .L_while_test\n" ".align 32,0x90\n" ".L_test_for_length_base:\n" " movl %%eax, %%r14d\n" /* len = this */ " shrl $16, %%r14d\n" /* len = this.val */ " movb %%al, %%cl\n" " testb $16, %%al\n" " jz .L_test_for_second_level_length\n" /* if ((op & 16) == 0) 8% */ " andb $15, %%cl\n" /* op &= 15 */ " jz .L_decode_distance\n" /* if (!op) */ ".L_add_bits_to_len:\n" " subb %%cl, %%bl\n" " xorl %%eax, %%eax\n" " incl %%eax\n" " shll %%cl, %%eax\n" " decl %%eax\n" " andl %%edx, %%eax\n" /* eax &= hold */ " shrq %%cl, %%rdx\n" " addl %%eax, %%r14d\n" /* len += hold & mask[op] */ ".L_decode_distance:\n" " movq %%r13, %%r8\n" /* r8 = dmask */ " cmpb $32, %%bl\n" " ja .L_get_distance_code\n" /* if (32 < bits) */ " lodsl\n" /* eax = *(uint *)in++ */ " movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */ " addb $32, %%bl\n" /* bits += 32 */ " shlq %%cl, %%rax\n" " orq %%rax, %%rdx\n" /* hold |= *((uint *)in)++ << bits */ ".L_get_distance_code:\n" " andq %%rdx, %%r8\n" /* r8 &= hold */ " movl (%%r11,%%r8,4), %%eax\n" /* eax = dcode[hold & dmask] */ ".L_dodist:\n" " movl %%eax, %%r15d\n" /* dist = this */ " shrl $16, %%r15d\n" /* dist = this.val */ " movb %%ah, %%cl\n" " subb %%ah, %%bl\n" /* bits -= this.bits */ " shrq %%cl, %%rdx\n" /* hold >>= this.bits */ " movb %%al, %%cl\n" /* cl = this.op */ " testb $16, %%al\n" /* if ((op & 16) == 0) */ " jz .L_test_for_second_level_dist\n" " andb $15, %%cl\n" /* op &= 15 */ " jz .L_check_dist_one\n" ".L_add_bits_to_dist:\n" " subb %%cl, %%bl\n" " xorl %%eax, %%eax\n" " incl %%eax\n" " shll %%cl, %%eax\n" " decl %%eax\n" /* (1 << op) - 1 */ " andl %%edx, %%eax\n" /* eax &= hold */ " shrq %%cl, %%rdx\n" " addl %%eax, %%r15d\n" /* dist += hold & ((1 << op) - 1) */ ".L_check_window:\n" " movq %%rsi, %%r8\n" /* save in so from can use it's reg */ " movq %%rdi, %%rax\n" " subq 40(%%rsp), %%rax\n" /* nbytes = out - beg */ " cmpl %%r15d, %%eax\n" " jb .L_clip_window\n" /* if (dist > nbytes) 4.2% */ " movl %%r14d, %%ecx\n" /* ecx = len */ " movq %%rdi, %%rsi\n" " subq %%r15, %%rsi\n" /* from = out - dist */ " sarl %%ecx\n" " jnc .L_copy_two\n" /* if len % 2 == 0 */ " rep movsw\n" " movb (%%rsi), %%al\n" " movb %%al, (%%rdi)\n" " incq %%rdi\n" " movq %%r8, %%rsi\n" /* move in back to %rsi, toss from */ " jmp .L_while_test\n" ".L_copy_two:\n" " rep movsw\n" " movq %%r8, %%rsi\n" /* move in back to %rsi, toss from */ " jmp .L_while_test\n" ".align 32,0x90\n" ".L_check_dist_one:\n" " cmpl $1, %%r15d\n" /* if dist 1, is a memset */ " jne .L_check_window\n" " cmpq %%rdi, 40(%%rsp)\n" /* if out == beg, outside window */ " je .L_check_window\n" " movl %%r14d, %%ecx\n" /* ecx = len */ " movb -1(%%rdi), %%al\n" " movb %%al, %%ah\n" " sarl %%ecx\n" " jnc .L_set_two\n" " movb %%al, (%%rdi)\n" " incq %%rdi\n" ".L_set_two:\n" " rep stosw\n" " jmp .L_while_test\n" ".align 32,0x90\n" ".L_test_for_second_level_length:\n" " testb $64, %%al\n" " jnz .L_test_for_end_of_block\n" /* if ((op & 64) != 0) */ " xorl %%eax, %%eax\n" " incl %%eax\n" " shll %%cl, %%eax\n" " decl %%eax\n" " andl %%edx, %%eax\n" /* eax &= hold */ " addl %%r14d, %%eax\n" /* eax += len */ " movl (%%rbp,%%rax,4), %%eax\n" /* eax = lcode[val+(hold&mask[op])]*/ " jmp .L_dolen\n" ".align 32,0x90\n" ".L_test_for_second_level_dist:\n" " testb $64, %%al\n" " jnz .L_invalid_distance_code\n" /* if ((op & 64) != 0) */ " xorl %%eax, %%eax\n" " incl %%eax\n" " shll %%cl, %%eax\n" " decl %%eax\n" " andl %%edx, %%eax\n" /* eax &= hold */ " addl %%r15d, %%eax\n" /* eax += dist */ " movl (%%r11,%%rax,4), %%eax\n" /* eax = dcode[val+(hold&mask[op])]*/ " jmp .L_dodist\n" ".align 32,0x90\n" ".L_clip_window:\n" " movl %%eax, %%ecx\n" /* ecx = nbytes */ " movl 92(%%rsp), %%eax\n" /* eax = wsize, prepare for dist cmp */ " negl %%ecx\n" /* nbytes = -nbytes */ " cmpl %%r15d, %%eax\n" " jb .L_invalid_distance_too_far\n" /* if (dist > wsize) */ " addl %%r15d, %%ecx\n" /* nbytes = dist - nbytes */ " cmpl $0, 96(%%rsp)\n" " jne .L_wrap_around_window\n" /* if (write != 0) */ " movq 56(%%rsp), %%rsi\n" /* from = window */ " subl %%ecx, %%eax\n" /* eax -= nbytes */ " addq %%rax, %%rsi\n" /* from += wsize - nbytes */ " movl %%r14d, %%eax\n" /* eax = len */ " cmpl %%ecx, %%r14d\n" " jbe .L_do_copy\n" /* if (nbytes >= len) */ " subl %%ecx, %%eax\n" /* eax -= nbytes */ " rep movsb\n" " movq %%rdi, %%rsi\n" " subq %%r15, %%rsi\n" /* from = &out[ -dist ] */ " jmp .L_do_copy\n" ".align 32,0x90\n" ".L_wrap_around_window:\n" " movl 96(%%rsp), %%eax\n" /* eax = write */ " cmpl %%eax, %%ecx\n" " jbe .L_contiguous_in_window\n" /* if (write >= nbytes) */ " movl 92(%%rsp), %%esi\n" /* from = wsize */ " addq 56(%%rsp), %%rsi\n" /* from += window */ " addq %%rax, %%rsi\n" /* from += write */ " subq %%rcx, %%rsi\n" /* from -= nbytes */ " subl %%eax, %%ecx\n" /* nbytes -= write */ " movl %%r14d, %%eax\n" /* eax = len */ " cmpl %%ecx, %%eax\n" " jbe .L_do_copy\n" /* if (nbytes >= len) */ " subl %%ecx, %%eax\n" /* len -= nbytes */ " rep movsb\n" " movq 56(%%rsp), %%rsi\n" /* from = window */ " movl 96(%%rsp), %%ecx\n" /* nbytes = write */ " cmpl %%ecx, %%eax\n" " jbe .L_do_copy\n" /* if (nbytes >= len) */ " subl %%ecx, %%eax\n" /* len -= nbytes */ " rep movsb\n" " movq %%rdi, %%rsi\n" " subq %%r15, %%rsi\n" /* from = out - dist */ " jmp .L_do_copy\n" ".align 32,0x90\n" ".L_contiguous_in_window:\n" " movq 56(%%rsp), %%rsi\n" /* rsi = window */ " addq %%rax, %%rsi\n" " subq %%rcx, %%rsi\n" /* from += write - nbytes */ " movl %%r14d, %%eax\n" /* eax = len */ " cmpl %%ecx, %%eax\n" " jbe .L_do_copy\n" /* if (nbytes >= len) */ " subl %%ecx, %%eax\n" /* len -= nbytes */ " rep movsb\n" " movq %%rdi, %%rsi\n" " subq %%r15, %%rsi\n" /* from = out - dist */ " jmp .L_do_copy\n" /* if (nbytes >= len) */ ".align 32,0x90\n" ".L_do_copy:\n" " movl %%eax, %%ecx\n" /* ecx = len */ " rep movsb\n" " movq %%r8, %%rsi\n" /* move in back to %esi, toss from */ " jmp .L_while_test\n" ".L_test_for_end_of_block:\n" " testb $32, %%al\n" " jz .L_invalid_literal_length_code\n" " movl $1, 116(%%rsp)\n" " jmp .L_break_loop_with_status\n" ".L_invalid_literal_length_code:\n" " movl $2, 116(%%rsp)\n" " jmp .L_break_loop_with_status\n" ".L_invalid_distance_code:\n" " movl $3, 116(%%rsp)\n" " jmp .L_break_loop_with_status\n" ".L_invalid_distance_too_far:\n" " movl $4, 116(%%rsp)\n" " jmp .L_break_loop_with_status\n" ".L_break_loop:\n" " movl $0, 116(%%rsp)\n" ".L_break_loop_with_status:\n" /* put in, out, bits, and hold back into ar and pop esp */ " movq %%rsi, 16(%%rsp)\n" /* in */ " movq %%rdi, 32(%%rsp)\n" /* out */ " movl %%ebx, 88(%%rsp)\n" /* bits */ " movq %%rdx, 80(%%rsp)\n" /* hold */ " movq (%%rsp), %%rax\n" /* restore rbp and rsp */ " movq 8(%%rsp), %%rbp\n" " movq %%rax, %%rsp\n" : : "m" (ar) : "memory", "%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%r8", "%r9", "%r10", "%r11", "%r12", "%r13", "%r14", "%r15" ); #elif ( defined( __GNUC__ ) || defined( __ICC ) ) && defined( __i386 ) __asm__ __volatile__ ( " leal %0, %%eax\n" " movl %%esp, (%%eax)\n" /* save esp, ebp */ " movl %%ebp, 4(%%eax)\n" " movl %%eax, %%esp\n" " movl 8(%%esp), %%esi\n" /* esi = in */ " movl 16(%%esp), %%edi\n" /* edi = out */ " movl 40(%%esp), %%edx\n" /* edx = hold */ " movl 44(%%esp), %%ebx\n" /* ebx = bits */ " movl 32(%%esp), %%ebp\n" /* ebp = lcode */ " cld\n" " jmp .L_do_loop\n" ".align 32,0x90\n" ".L_while_test:\n" " cmpl %%edi, 24(%%esp)\n" /* out < end */ " jbe .L_break_loop\n" " cmpl %%esi, 12(%%esp)\n" /* in < last */ " jbe .L_break_loop\n" ".L_do_loop:\n" " cmpb $15, %%bl\n" " ja .L_get_length_code\n" /* if (15 < bits) */ " xorl %%eax, %%eax\n" " lodsw\n" /* al = *(ushort *)in++ */ " movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */ " addb $16, %%bl\n" /* bits += 16 */ " shll %%cl, %%eax\n" " orl %%eax, %%edx\n" /* hold |= *((ushort *)in)++ << bits */ ".L_get_length_code:\n" " movl 56(%%esp), %%eax\n" /* eax = lmask */ " andl %%edx, %%eax\n" /* eax &= hold */ " movl (%%ebp,%%eax,4), %%eax\n" /* eax = lcode[hold & lmask] */ ".L_dolen:\n" " movb %%ah, %%cl\n" /* cl = this.bits */ " subb %%ah, %%bl\n" /* bits -= this.bits */ " shrl %%cl, %%edx\n" /* hold >>= this.bits */ " testb %%al, %%al\n" " jnz .L_test_for_length_base\n" /* if (op != 0) 45.7% */ " shrl $16, %%eax\n" /* output this.val char */ " stosb\n" " jmp .L_while_test\n" ".align 32,0x90\n" ".L_test_for_length_base:\n" " movl %%eax, %%ecx\n" /* len = this */ " shrl $16, %%ecx\n" /* len = this.val */ " movl %%ecx, 64(%%esp)\n" /* save len */ " movb %%al, %%cl\n" " testb $16, %%al\n" " jz .L_test_for_second_level_length\n" /* if ((op & 16) == 0) 8% */ " andb $15, %%cl\n" /* op &= 15 */ " jz .L_decode_distance\n" /* if (!op) */ " cmpb %%cl, %%bl\n" " jae .L_add_bits_to_len\n" /* if (op <= bits) */ " movb %%cl, %%ch\n" /* stash op in ch, freeing cl */ " xorl %%eax, %%eax\n" " lodsw\n" /* al = *(ushort *)in++ */ " movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */ " addb $16, %%bl\n" /* bits += 16 */ " shll %%cl, %%eax\n" " orl %%eax, %%edx\n" /* hold |= *((ushort *)in)++ << bits */ " movb %%ch, %%cl\n" /* move op back to ecx */ ".L_add_bits_to_len:\n" " subb %%cl, %%bl\n" " xorl %%eax, %%eax\n" " incl %%eax\n" " shll %%cl, %%eax\n" " decl %%eax\n" " andl %%edx, %%eax\n" /* eax &= hold */ " shrl %%cl, %%edx\n" " addl %%eax, 64(%%esp)\n" /* len += hold & mask[op] */ ".L_decode_distance:\n" " cmpb $15, %%bl\n" " ja .L_get_distance_code\n" /* if (15 < bits) */ " xorl %%eax, %%eax\n" " lodsw\n" /* al = *(ushort *)in++ */ " movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */ " addb $16, %%bl\n" /* bits += 16 */ " shll %%cl, %%eax\n" " orl %%eax, %%edx\n" /* hold |= *((ushort *)in)++ << bits */ ".L_get_distance_code:\n" " movl 60(%%esp), %%eax\n" /* eax = dmask */ " movl 36(%%esp), %%ecx\n" /* ecx = dcode */ " andl %%edx, %%eax\n" /* eax &= hold */ " movl (%%ecx,%%eax,4), %%eax\n"/* eax = dcode[hold & dmask] */ ".L_dodist:\n" " movl %%eax, %%ebp\n" /* dist = this */ " shrl $16, %%ebp\n" /* dist = this.val */ " movb %%ah, %%cl\n" " subb %%ah, %%bl\n" /* bits -= this.bits */ " shrl %%cl, %%edx\n" /* hold >>= this.bits */ " movb %%al, %%cl\n" /* cl = this.op */ " testb $16, %%al\n" /* if ((op & 16) == 0) */ " jz .L_test_for_second_level_dist\n" " andb $15, %%cl\n" /* op &= 15 */ " jz .L_check_dist_one\n" " cmpb %%cl, %%bl\n" " jae .L_add_bits_to_dist\n" /* if (op <= bits) 97.6% */ " movb %%cl, %%ch\n" /* stash op in ch, freeing cl */ " xorl %%eax, %%eax\n" " lodsw\n" /* al = *(ushort *)in++ */ " movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */ " addb $16, %%bl\n" /* bits += 16 */ " shll %%cl, %%eax\n" " orl %%eax, %%edx\n" /* hold |= *((ushort *)in)++ << bits */ " movb %%ch, %%cl\n" /* move op back to ecx */ ".L_add_bits_to_dist:\n" " subb %%cl, %%bl\n" " xorl %%eax, %%eax\n" " incl %%eax\n" " shll %%cl, %%eax\n" " decl %%eax\n" /* (1 << op) - 1 */ " andl %%edx, %%eax\n" /* eax &= hold */ " shrl %%cl, %%edx\n" " addl %%eax, %%ebp\n" /* dist += hold & ((1 << op) - 1) */ ".L_check_window:\n" " movl %%esi, 8(%%esp)\n" /* save in so from can use it's reg */ " movl %%edi, %%eax\n" " subl 20(%%esp), %%eax\n" /* nbytes = out - beg */ " cmpl %%ebp, %%eax\n" " jb .L_clip_window\n" /* if (dist > nbytes) 4.2% */ " movl 64(%%esp), %%ecx\n" /* ecx = len */ " movl %%edi, %%esi\n" " subl %%ebp, %%esi\n" /* from = out - dist */ " sarl %%ecx\n" " jnc .L_copy_two\n" /* if len % 2 == 0 */ " rep movsw\n" " movb (%%esi), %%al\n" " movb %%al, (%%edi)\n" " incl %%edi\n" " movl 8(%%esp), %%esi\n" /* move in back to %esi, toss from */ " movl 32(%%esp), %%ebp\n" /* ebp = lcode */ " jmp .L_while_test\n" ".L_copy_two:\n" " rep movsw\n" " movl 8(%%esp), %%esi\n" /* move in back to %esi, toss from */ " movl 32(%%esp), %%ebp\n" /* ebp = lcode */ " jmp .L_while_test\n" ".align 32,0x90\n" ".L_check_dist_one:\n" " cmpl $1, %%ebp\n" /* if dist 1, is a memset */ " jne .L_check_window\n" " cmpl %%edi, 20(%%esp)\n" " je .L_check_window\n" /* out == beg, if outside window */ " movl 64(%%esp), %%ecx\n" /* ecx = len */ " movb -1(%%edi), %%al\n" " movb %%al, %%ah\n" " sarl %%ecx\n" " jnc .L_set_two\n" " movb %%al, (%%edi)\n" " incl %%edi\n" ".L_set_two:\n" " rep stosw\n" " movl 32(%%esp), %%ebp\n" /* ebp = lcode */ " jmp .L_while_test\n" ".align 32,0x90\n" ".L_test_for_second_level_length:\n" " testb $64, %%al\n" " jnz .L_test_for_end_of_block\n" /* if ((op & 64) != 0) */ " xorl %%eax, %%eax\n" " incl %%eax\n" " shll %%cl, %%eax\n" " decl %%eax\n" " andl %%edx, %%eax\n" /* eax &= hold */ " addl 64(%%esp), %%eax\n" /* eax += len */ " movl (%%ebp,%%eax,4), %%eax\n" /* eax = lcode[val+(hold&mask[op])]*/ " jmp .L_dolen\n" ".align 32,0x90\n" ".L_test_for_second_level_dist:\n" " testb $64, %%al\n" " jnz .L_invalid_distance_code\n" /* if ((op & 64) != 0) */ " xorl %%eax, %%eax\n" " incl %%eax\n" " shll %%cl, %%eax\n" " decl %%eax\n" " andl %%edx, %%eax\n" /* eax &= hold */ " addl %%ebp, %%eax\n" /* eax += dist */ " movl 36(%%esp), %%ecx\n" /* ecx = dcode */ " movl (%%ecx,%%eax,4), %%eax\n" /* eax = dcode[val+(hold&mask[op])]*/ " jmp .L_dodist\n" ".align 32,0x90\n" ".L_clip_window:\n" " movl %%eax, %%ecx\n" " movl 48(%%esp), %%eax\n" /* eax = wsize */ " negl %%ecx\n" /* nbytes = -nbytes */ " movl 28(%%esp), %%esi\n" /* from = window */ " cmpl %%ebp, %%eax\n" " jb .L_invalid_distance_too_far\n" /* if (dist > wsize) */ " addl %%ebp, %%ecx\n" /* nbytes = dist - nbytes */ " cmpl $0, 52(%%esp)\n" " jne .L_wrap_around_window\n" /* if (write != 0) */ " subl %%ecx, %%eax\n" " addl %%eax, %%esi\n" /* from += wsize - nbytes */ " movl 64(%%esp), %%eax\n" /* eax = len */ " cmpl %%ecx, %%eax\n" " jbe .L_do_copy\n" /* if (nbytes >= len) */ " subl %%ecx, %%eax\n" /* len -= nbytes */ " rep movsb\n" " movl %%edi, %%esi\n" " subl %%ebp, %%esi\n" /* from = out - dist */ " jmp .L_do_copy\n" ".align 32,0x90\n" ".L_wrap_around_window:\n" " movl 52(%%esp), %%eax\n" /* eax = write */ " cmpl %%eax, %%ecx\n" " jbe .L_contiguous_in_window\n" /* if (write >= nbytes) */ " addl 48(%%esp), %%esi\n" /* from += wsize */ " addl %%eax, %%esi\n" /* from += write */ " subl %%ecx, %%esi\n" /* from -= nbytes */ " subl %%eax, %%ecx\n" /* nbytes -= write */ " movl 64(%%esp), %%eax\n" /* eax = len */ " cmpl %%ecx, %%eax\n" " jbe .L_do_copy\n" /* if (nbytes >= len) */ " subl %%ecx, %%eax\n" /* len -= nbytes */ " rep movsb\n" " movl 28(%%esp), %%esi\n" /* from = window */ " movl 52(%%esp), %%ecx\n" /* nbytes = write */ " cmpl %%ecx, %%eax\n" " jbe .L_do_copy\n" /* if (nbytes >= len) */ " subl %%ecx, %%eax\n" /* len -= nbytes */ " rep movsb\n" " movl %%edi, %%esi\n" " subl %%ebp, %%esi\n" /* from = out - dist */ " jmp .L_do_copy\n" ".align 32,0x90\n" ".L_contiguous_in_window:\n" " addl %%eax, %%esi\n" " subl %%ecx, %%esi\n" /* from += write - nbytes */ " movl 64(%%esp), %%eax\n" /* eax = len */ " cmpl %%ecx, %%eax\n" " jbe .L_do_copy\n" /* if (nbytes >= len) */ " subl %%ecx, %%eax\n" /* len -= nbytes */ " rep movsb\n" " movl %%edi, %%esi\n" " subl %%ebp, %%esi\n" /* from = out - dist */ " jmp .L_do_copy\n" /* if (nbytes >= len) */ ".align 32,0x90\n" ".L_do_copy:\n" " movl %%eax, %%ecx\n" " rep movsb\n" " movl 8(%%esp), %%esi\n" /* move in back to %esi, toss from */ " movl 32(%%esp), %%ebp\n" /* ebp = lcode */ " jmp .L_while_test\n" ".L_test_for_end_of_block:\n" " testb $32, %%al\n" " jz .L_invalid_literal_length_code\n" " movl $1, 72(%%esp)\n" " jmp .L_break_loop_with_status\n" ".L_invalid_literal_length_code:\n" " movl $2, 72(%%esp)\n" " jmp .L_break_loop_with_status\n" ".L_invalid_distance_code:\n" " movl $3, 72(%%esp)\n" " jmp .L_break_loop_with_status\n" ".L_invalid_distance_too_far:\n" " movl 8(%%esp), %%esi\n" " movl $4, 72(%%esp)\n" " jmp .L_break_loop_with_status\n" ".L_break_loop:\n" " movl $0, 72(%%esp)\n" ".L_break_loop_with_status:\n" /* put in, out, bits, and hold back into ar and pop esp */ " movl %%esi, 8(%%esp)\n" /* save in */ " movl %%edi, 16(%%esp)\n" /* save out */ " movl %%ebx, 44(%%esp)\n" /* save bits */ " movl %%edx, 40(%%esp)\n" /* save hold */ " movl 4(%%esp), %%ebp\n" /* restore esp, ebp */ " movl (%%esp), %%esp\n" : : "m" (ar) : "memory", "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi" ); #elif defined( _MSC_VER ) && ! defined( _M_AMD64 ) __asm { lea eax, ar mov [eax], esp /* save esp, ebp */ mov [eax+4], ebp mov esp, eax mov esi, [esp+8] /* esi = in */ mov edi, [esp+16] /* edi = out */ mov edx, [esp+40] /* edx = hold */ mov ebx, [esp+44] /* ebx = bits */ mov ebp, [esp+32] /* ebp = lcode */ cld jmp L_do_loop ALIGN 4 L_while_test: cmp [esp+24], edi jbe L_break_loop cmp [esp+12], esi jbe L_break_loop L_do_loop: cmp bl, 15 ja L_get_length_code /* if (15 < bits) */ xor eax, eax lodsw /* al = *(ushort *)in++ */ mov cl, bl /* cl = bits, needs it for shifting */ add bl, 16 /* bits += 16 */ shl eax, cl or edx, eax /* hold |= *((ushort *)in)++ << bits */ L_get_length_code: mov eax, [esp+56] /* eax = lmask */ and eax, edx /* eax &= hold */ mov eax, [ebp+eax*4] /* eax = lcode[hold & lmask] */ L_dolen: mov cl, ah /* cl = this.bits */ sub bl, ah /* bits -= this.bits */ shr edx, cl /* hold >>= this.bits */ test al, al jnz L_test_for_length_base /* if (op != 0) 45.7% */ shr eax, 16 /* output this.val char */ stosb jmp L_while_test ALIGN 4 L_test_for_length_base: mov ecx, eax /* len = this */ shr ecx, 16 /* len = this.val */ mov [esp+64], ecx /* save len */ mov cl, al test al, 16 jz L_test_for_second_level_length /* if ((op & 16) == 0) 8% */ and cl, 15 /* op &= 15 */ jz L_decode_distance /* if (!op) */ cmp bl, cl jae L_add_bits_to_len /* if (op <= bits) */ mov ch, cl /* stash op in ch, freeing cl */ xor eax, eax lodsw /* al = *(ushort *)in++ */ mov cl, bl /* cl = bits, needs it for shifting */ add bl, 16 /* bits += 16 */ shl eax, cl or edx, eax /* hold |= *((ushort *)in)++ << bits */ mov cl, ch /* move op back to ecx */ L_add_bits_to_len: sub bl, cl xor eax, eax inc eax shl eax, cl dec eax and eax, edx /* eax &= hold */ shr edx, cl add [esp+64], eax /* len += hold & mask[op] */ L_decode_distance: cmp bl, 15 ja L_get_distance_code /* if (15 < bits) */ xor eax, eax lodsw /* al = *(ushort *)in++ */ mov cl, bl /* cl = bits, needs it for shifting */ add bl, 16 /* bits += 16 */ shl eax, cl or edx, eax /* hold |= *((ushort *)in)++ << bits */ L_get_distance_code: mov eax, [esp+60] /* eax = dmask */ mov ecx, [esp+36] /* ecx = dcode */ and eax, edx /* eax &= hold */ mov eax, [ecx+eax*4]/* eax = dcode[hold & dmask] */ L_dodist: mov ebp, eax /* dist = this */ shr ebp, 16 /* dist = this.val */ mov cl, ah sub bl, ah /* bits -= this.bits */ shr edx, cl /* hold >>= this.bits */ mov cl, al /* cl = this.op */ test al, 16 /* if ((op & 16) == 0) */ jz L_test_for_second_level_dist and cl, 15 /* op &= 15 */ jz L_check_dist_one cmp bl, cl jae L_add_bits_to_dist /* if (op <= bits) 97.6% */ mov ch, cl /* stash op in ch, freeing cl */ xor eax, eax lodsw /* al = *(ushort *)in++ */ mov cl, bl /* cl = bits, needs it for shifting */ add bl, 16 /* bits += 16 */ shl eax, cl or edx, eax /* hold |= *((ushort *)in)++ << bits */ mov cl, ch /* move op back to ecx */ L_add_bits_to_dist: sub bl, cl xor eax, eax inc eax shl eax, cl dec eax /* (1 << op) - 1 */ and eax, edx /* eax &= hold */ shr edx, cl add ebp, eax /* dist += hold & ((1 << op) - 1) */ L_check_window: mov [esp+8], esi /* save in so from can use it's reg */ mov eax, edi sub eax, [esp+20] /* nbytes = out - beg */ cmp eax, ebp jb L_clip_window /* if (dist > nbytes) 4.2% */ mov ecx, [esp+64] /* ecx = len */ mov esi, edi sub esi, ebp /* from = out - dist */ sar ecx, 1 jnc L_copy_two rep movsw mov al, [esi] mov [edi], al inc edi mov esi, [esp+8] /* move in back to %esi, toss from */ mov ebp, [esp+32] /* ebp = lcode */ jmp L_while_test L_copy_two: rep movsw mov esi, [esp+8] /* move in back to %esi, toss from */ mov ebp, [esp+32] /* ebp = lcode */ jmp L_while_test ALIGN 4 L_check_dist_one: cmp ebp, 1 /* if dist 1, is a memset */ jne L_check_window cmp [esp+20], edi je L_check_window /* out == beg, if outside window */ mov ecx, [esp+64] /* ecx = len */ mov al, [edi-1] mov ah, al sar ecx, 1 jnc L_set_two mov [edi], al /* memset out with from[-1] */ inc edi L_set_two: rep stosw mov ebp, [esp+32] /* ebp = lcode */ jmp L_while_test ALIGN 4 L_test_for_second_level_length: test al, 64 jnz L_test_for_end_of_block /* if ((op & 64) != 0) */ xor eax, eax inc eax shl eax, cl dec eax and eax, edx /* eax &= hold */ add eax, [esp+64] /* eax += len */ mov eax, [ebp+eax*4] /* eax = lcode[val+(hold&mask[op])]*/ jmp L_dolen ALIGN 4 L_test_for_second_level_dist: test al, 64 jnz L_invalid_distance_code /* if ((op & 64) != 0) */ xor eax, eax inc eax shl eax, cl dec eax and eax, edx /* eax &= hold */ add eax, ebp /* eax += dist */ mov ecx, [esp+36] /* ecx = dcode */ mov eax, [ecx+eax*4] /* eax = dcode[val+(hold&mask[op])]*/ jmp L_dodist ALIGN 4 L_clip_window: mov ecx, eax mov eax, [esp+48] /* eax = wsize */ neg ecx /* nbytes = -nbytes */ mov esi, [esp+28] /* from = window */ cmp eax, ebp jb L_invalid_distance_too_far /* if (dist > wsize) */ add ecx, ebp /* nbytes = dist - nbytes */ cmp dword ptr [esp+52], 0 jne L_wrap_around_window /* if (write != 0) */ sub eax, ecx add esi, eax /* from += wsize - nbytes */ mov eax, [esp+64] /* eax = len */ cmp eax, ecx jbe L_do_copy /* if (nbytes >= len) */ sub eax, ecx /* len -= nbytes */ rep movsb mov esi, edi sub esi, ebp /* from = out - dist */ jmp L_do_copy ALIGN 4 L_wrap_around_window: mov eax, [esp+52] /* eax = write */ cmp ecx, eax jbe L_contiguous_in_window /* if (write >= nbytes) */ add esi, [esp+48] /* from += wsize */ add esi, eax /* from += write */ sub esi, ecx /* from -= nbytes */ sub ecx, eax /* nbytes -= write */ mov eax, [esp+64] /* eax = len */ cmp eax, ecx jbe L_do_copy /* if (nbytes >= len) */ sub eax, ecx /* len -= nbytes */ rep movsb mov esi, [esp+28] /* from = window */ mov ecx, [esp+52] /* nbytes = write */ cmp eax, ecx jbe L_do_copy /* if (nbytes >= len) */ sub eax, ecx /* len -= nbytes */ rep movsb mov esi, edi sub esi, ebp /* from = out - dist */ jmp L_do_copy ALIGN 4 L_contiguous_in_window: add esi, eax sub esi, ecx /* from += write - nbytes */ mov eax, [esp+64] /* eax = len */ cmp eax, ecx jbe L_do_copy /* if (nbytes >= len) */ sub eax, ecx /* len -= nbytes */ rep movsb mov esi, edi sub esi, ebp /* from = out - dist */ jmp L_do_copy ALIGN 4 L_do_copy: mov ecx, eax rep movsb mov esi, [esp+8] /* move in back to %esi, toss from */ mov ebp, [esp+32] /* ebp = lcode */ jmp L_while_test L_test_for_end_of_block: test al, 32 jz L_invalid_literal_length_code mov dword ptr [esp+72], 1 jmp L_break_loop_with_status L_invalid_literal_length_code: mov dword ptr [esp+72], 2 jmp L_break_loop_with_status L_invalid_distance_code: mov dword ptr [esp+72], 3 jmp L_break_loop_with_status L_invalid_distance_too_far: mov esi, [esp+4] mov dword ptr [esp+72], 4 jmp L_break_loop_with_status L_break_loop: mov dword ptr [esp+72], 0 L_break_loop_with_status: /* put in, out, bits, and hold back into ar and pop esp */ mov [esp+8], esi /* save in */ mov [esp+16], edi /* save out */ mov [esp+44], ebx /* save bits */ mov [esp+40], edx /* save hold */ mov ebp, [esp+4] /* restore esp, ebp */ mov esp, [esp] } #else #error "x86 architecture not defined" #endif if (ar.status > 1) { if (ar.status == 2) strm->msg = "invalid literal/length code"; else if (ar.status == 3) strm->msg = "invalid distance code"; else strm->msg = "invalid distance too far back"; state->mode = BAD; } else if ( ar.status == 1 ) { state->mode = TYPE; } /* return unused bytes (on entry, bits < 8, so in won't go too far back) */ ar.len = ar.bits >> 3; ar.in -= ar.len; ar.bits -= ar.len << 3; ar.hold &= (1U << ar.bits) - 1; /* update state and return */ strm->next_in = ar.in; strm->next_out = ar.out; strm->avail_in = (unsigned)(ar.in < ar.last ? PAD_AVAIL_IN + (ar.last - ar.in) : PAD_AVAIL_IN - (ar.in - ar.last)); strm->avail_out = (unsigned)(ar.out < ar.end ? PAD_AVAIL_OUT + (ar.end - ar.out) : PAD_AVAIL_OUT - (ar.out - ar.end)); state->hold = ar.hold; state->bits = ar.bits; return; } tcl8.6.14/compat/zlib/contrib/untgz/0000755000175000017500000000000014566153412016676 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/untgz/untgz.c0000644000175000017500000004054014554262142020212 0ustar sergeisergei/* * untgz.c -- Display contents and extract files from a gzip'd TAR file * * written by Pedro A. Aranda Gutierrez * adaptation to Unix by Jean-loup Gailly * various fixes by Cosmin Truta * * This software is provided 'as-is', without any express or implied * warranty. In no event will the authors be held liable for any damages * arising from the use of this software. * * Permission is granted to anyone to use this software for any purpose, * including commercial applications, and to alter it and redistribute it * freely, subject to the following restrictions: * * 1. The origin of this software must not be misrepresented; you must not * claim that you wrote the original software. If you use this software * in a product, an acknowledgment in the product documentation would be * appreciated but is not required. * 2. Altered source versions must be plainly marked as such, and must not be * misrepresented as being the original software. * 3. This notice may not be removed or altered from any source distribution. */ #include #include #include #include #include #include "zlib.h" #ifdef _WIN32 # include # include # include # ifndef F_OK # define F_OK 0 # endif # define mkdir(dirname,mode) _mkdir(dirname) # ifdef _MSC_VER # define access(path,mode) _access(path,mode) # define chmod(path,mode) _chmod(path,mode) # define strdup(str) _strdup(str) # endif #else # include # include # include #endif /* values used in typeflag field */ #define REGTYPE '0' /* regular file */ #define AREGTYPE '\0' /* regular file */ #define LNKTYPE '1' /* link */ #define SYMTYPE '2' /* reserved */ #define CHRTYPE '3' /* character special */ #define BLKTYPE '4' /* block special */ #define DIRTYPE '5' /* directory */ #define FIFOTYPE '6' /* FIFO special */ #define CONTTYPE '7' /* reserved */ /* GNU tar extensions */ #define GNUTYPE_DUMPDIR 'D' /* file names from dumped directory */ #define GNUTYPE_LONGLINK 'K' /* long link name */ #define GNUTYPE_LONGNAME 'L' /* long file name */ #define GNUTYPE_MULTIVOL 'M' /* continuation of file from another volume */ #define GNUTYPE_NAMES 'N' /* file name that does not fit into main hdr */ #define GNUTYPE_SPARSE 'S' /* sparse file */ #define GNUTYPE_VOLHDR 'V' /* tape/volume header */ /* tar header */ #define BLOCKSIZE 512 #define SHORTNAMESIZE 100 struct tar_header { /* byte offset */ char name[100]; /* 0 */ char mode[8]; /* 100 */ char uid[8]; /* 108 */ char gid[8]; /* 116 */ char size[12]; /* 124 */ char mtime[12]; /* 136 */ char chksum[8]; /* 148 */ char typeflag; /* 156 */ char linkname[100]; /* 157 */ char magic[6]; /* 257 */ char version[2]; /* 263 */ char uname[32]; /* 265 */ char gname[32]; /* 297 */ char devmajor[8]; /* 329 */ char devminor[8]; /* 337 */ char prefix[155]; /* 345 */ /* 500 */ }; union tar_buffer { char buffer[BLOCKSIZE]; struct tar_header header; }; struct attr_item { struct attr_item *next; char *fname; int mode; time_t time; }; enum { TGZ_EXTRACT, TGZ_LIST, TGZ_INVALID }; char *prog; void error(const char *msg) { fprintf(stderr, "%s: %s\n", prog, msg); exit(1); } const char *TGZsuffix[] = { "\0", ".tar", ".tar.gz", ".taz", ".tgz", NULL }; /* return the file name of the TGZ archive */ /* or NULL if it does not exist */ char *TGZfname (const char *arcname) { static char buffer[1024]; int origlen,i; strcpy(buffer,arcname); origlen = strlen(buffer); for (i=0; TGZsuffix[i]; i++) { strcpy(buffer+origlen,TGZsuffix[i]); if (access(buffer,F_OK) == 0) return buffer; } return NULL; } /* error message for the filename */ void TGZnotfound (const char *arcname) { int i; fprintf(stderr,"%s: Couldn't find ",prog); for (i=0;TGZsuffix[i];i++) fprintf(stderr,(TGZsuffix[i+1]) ? "%s%s, " : "or %s%s\n", arcname, TGZsuffix[i]); exit(1); } /* convert octal digits to int */ /* on error return -1 */ int getoct (char *p,int width) { int result = 0; char c; while (width--) { c = *p++; if (c == 0) break; if (c == ' ') continue; if (c < '0' || c > '7') return -1; result = result * 8 + (c - '0'); } return result; } /* convert time_t to string */ /* use the "YYYY/MM/DD hh:mm:ss" format */ char *strtime (time_t *t) { struct tm *local; static char result[32]; local = localtime(t); sprintf(result,"%4d/%02d/%02d %02d:%02d:%02d", local->tm_year+1900, local->tm_mon+1, local->tm_mday, local->tm_hour, local->tm_min, local->tm_sec); return result; } /* set file time */ int setfiletime (char *fname,time_t ftime) { #ifdef _WIN32 static int isWinNT = -1; SYSTEMTIME st; FILETIME locft, modft; struct tm *loctm; HANDLE hFile; int result; loctm = localtime(&ftime); if (loctm == NULL) return -1; st.wYear = (WORD)loctm->tm_year + 1900; st.wMonth = (WORD)loctm->tm_mon + 1; st.wDayOfWeek = (WORD)loctm->tm_wday; st.wDay = (WORD)loctm->tm_mday; st.wHour = (WORD)loctm->tm_hour; st.wMinute = (WORD)loctm->tm_min; st.wSecond = (WORD)loctm->tm_sec; st.wMilliseconds = 0; if (!SystemTimeToFileTime(&st, &locft) || !LocalFileTimeToFileTime(&locft, &modft)) return -1; if (isWinNT < 0) isWinNT = (GetVersion() < 0x80000000) ? 1 : 0; hFile = CreateFile(fname, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, (isWinNT ? FILE_FLAG_BACKUP_SEMANTICS : 0), NULL); if (hFile == INVALID_HANDLE_VALUE) return -1; result = SetFileTime(hFile, NULL, NULL, &modft) ? 0 : -1; CloseHandle(hFile); return result; #else struct utimbuf settime; settime.actime = settime.modtime = ftime; return utime(fname,&settime); #endif } /* push file attributes */ void push_attr(struct attr_item **list,char *fname,int mode,time_t time) { struct attr_item *item; item = (struct attr_item *)malloc(sizeof(struct attr_item)); if (item == NULL) error("Out of memory"); item->fname = strdup(fname); item->mode = mode; item->time = time; item->next = *list; *list = item; } /* restore file attributes */ void restore_attr(struct attr_item **list) { struct attr_item *item, *prev; for (item = *list; item != NULL; ) { setfiletime(item->fname,item->time); chmod(item->fname,item->mode); prev = item; item = item->next; free(prev); } *list = NULL; } /* match regular expression */ #define ISSPECIAL(c) (((c) == '*') || ((c) == '/')) int ExprMatch (char *string,char *expr) { while (1) { if (ISSPECIAL(*expr)) { if (*expr == '/') { if (*string != '\\' && *string != '/') return 0; string ++; expr++; } else if (*expr == '*') { if (*expr ++ == 0) return 1; while (*++string != *expr) if (*string == 0) return 0; } } else { if (*string != *expr) return 0; if (*expr++ == 0) return 1; string++; } } } /* recursive mkdir */ /* abort on ENOENT; ignore other errors like "directory already exists" */ /* return 1 if OK */ /* 0 on error */ int makedir (char *newdir) { char *buffer = strdup(newdir); char *p; int len = strlen(buffer); if (len <= 0) { free(buffer); return 0; } if (buffer[len-1] == '/') { buffer[len-1] = '\0'; } if (mkdir(buffer, 0755) == 0) { free(buffer); return 1; } p = buffer+1; while (1) { char hold; while(*p && *p != '\\' && *p != '/') p++; hold = *p; *p = 0; if ((mkdir(buffer, 0755) == -1) && (errno == ENOENT)) { fprintf(stderr,"%s: Couldn't create directory %s\n",prog,buffer); free(buffer); return 0; } if (hold == 0) break; *p++ = hold; } free(buffer); return 1; } int matchname (int arg,int argc,char **argv,char *fname) { if (arg == argc) /* no arguments given (untgz tgzarchive) */ return 1; while (arg < argc) if (ExprMatch(fname,argv[arg++])) return 1; return 0; /* ignore this for the moment being */ } /* tar file list or extract */ int tar (gzFile in,int action,int arg,int argc,char **argv) { union tar_buffer buffer; int len; int err; int getheader = 1; int remaining = 0; FILE *outfile = NULL; char fname[BLOCKSIZE]; int tarmode; time_t tartime; struct attr_item *attributes = NULL; if (action == TGZ_LIST) printf(" date time size file\n" " ---------- -------- --------- -------------------------------------\n"); while (1) { len = gzread(in, &buffer, BLOCKSIZE); if (len < 0) error(gzerror(in, &err)); /* * Always expect complete blocks to process * the tar information. */ if (len != BLOCKSIZE) { action = TGZ_INVALID; /* force error exit */ remaining = 0; /* force I/O cleanup */ } /* * If we have to get a tar header */ if (getheader >= 1) { /* * if we met the end of the tar * or the end-of-tar block, * we are done */ if (len == 0 || buffer.header.name[0] == 0) break; tarmode = getoct(buffer.header.mode,8); tartime = (time_t)getoct(buffer.header.mtime,12); if (tarmode == -1 || tartime == (time_t)-1) { buffer.header.name[0] = 0; action = TGZ_INVALID; } if (getheader == 1) { strncpy(fname,buffer.header.name,SHORTNAMESIZE); if (fname[SHORTNAMESIZE-1] != 0) fname[SHORTNAMESIZE] = 0; } else { /* * The file name is longer than SHORTNAMESIZE */ if (strncmp(fname,buffer.header.name,SHORTNAMESIZE-1) != 0) error("bad long name"); getheader = 1; } /* * Act according to the type flag */ switch (buffer.header.typeflag) { case DIRTYPE: if (action == TGZ_LIST) printf(" %s %s\n",strtime(&tartime),fname); if (action == TGZ_EXTRACT) { makedir(fname); push_attr(&attributes,fname,tarmode,tartime); } break; case REGTYPE: case AREGTYPE: remaining = getoct(buffer.header.size,12); if (remaining == -1) { action = TGZ_INVALID; break; } if (action == TGZ_LIST) printf(" %s %9d %s\n",strtime(&tartime),remaining,fname); else if (action == TGZ_EXTRACT) { if (matchname(arg,argc,argv,fname)) { outfile = fopen(fname,"wb"); if (outfile == NULL) { /* try creating directory */ char *p = strrchr(fname, '/'); if (p != NULL) { *p = '\0'; makedir(fname); *p = '/'; outfile = fopen(fname,"wb"); } } if (outfile != NULL) printf("Extracting %s\n",fname); else fprintf(stderr, "%s: Couldn't create %s",prog,fname); } else outfile = NULL; } getheader = 0; break; case GNUTYPE_LONGLINK: case GNUTYPE_LONGNAME: remaining = getoct(buffer.header.size,12); if (remaining < 0 || remaining >= BLOCKSIZE) { action = TGZ_INVALID; break; } len = gzread(in, fname, BLOCKSIZE); if (len < 0) error(gzerror(in, &err)); if (fname[BLOCKSIZE-1] != 0 || (int)strlen(fname) > remaining) { action = TGZ_INVALID; break; } getheader = 2; break; default: if (action == TGZ_LIST) printf(" %s <---> %s\n",strtime(&tartime),fname); break; } } else { unsigned int bytes = (remaining > BLOCKSIZE) ? BLOCKSIZE : remaining; if (outfile != NULL) { if (fwrite(&buffer,sizeof(char),bytes,outfile) != bytes) { fprintf(stderr, "%s: Error writing %s -- skipping\n",prog,fname); fclose(outfile); outfile = NULL; remove(fname); } } remaining -= bytes; } if (remaining == 0) { getheader = 1; if (outfile != NULL) { fclose(outfile); outfile = NULL; if (action != TGZ_INVALID) push_attr(&attributes,fname,tarmode,tartime); } } /* * Abandon if errors are found */ if (action == TGZ_INVALID) { error("broken archive"); break; } } /* * Restore file modes and time stamps */ restore_attr(&attributes); if (gzclose(in) != Z_OK) error("failed gzclose"); return 0; } /* ============================================================ */ void help(int exitval) { printf("untgz version 0.2.1\n" " using zlib version %s\n\n", zlibVersion()); printf("Usage: untgz file.tgz extract all files\n" " untgz file.tgz fname ... extract selected files\n" " untgz -l file.tgz list archive contents\n" " untgz -h display this help\n"); exit(exitval); } /* ============================================================ */ #if defined(WIN32) && defined(__GNUC__) int _CRT_glob = 0; /* disable argument globbing in MinGW */ #endif int main(int argc,char **argv) { int action = TGZ_EXTRACT; int arg = 1; char *TGZfile; gzFile f; prog = strrchr(argv[0],'\\'); if (prog == NULL) { prog = strrchr(argv[0],'/'); if (prog == NULL) { prog = strrchr(argv[0],':'); if (prog == NULL) prog = argv[0]; else prog++; } else prog++; } else prog++; if (argc == 1) help(0); if (strcmp(argv[arg],"-l") == 0) { action = TGZ_LIST; if (argc == ++arg) help(0); } else if (strcmp(argv[arg],"-h") == 0) { help(0); } if ((TGZfile = TGZfname(argv[arg])) == NULL) TGZnotfound(argv[arg]); ++arg; if ((action == TGZ_LIST) && (arg != argc)) help(1); /* * Process the TGZ file */ switch(action) { case TGZ_LIST: case TGZ_EXTRACT: f = gzopen(TGZfile,"rb"); if (f == NULL) { fprintf(stderr,"%s: Couldn't gzopen %s\n",prog,TGZfile); return 1; } exit(tar(f, action, arg, argc, argv)); break; default: error("Unknown option"); exit(1); } return 0; } tcl8.6.14/compat/zlib/contrib/untgz/Makefile.msc0000644000175000017500000000043114554262142021113 0ustar sergeisergeiCC=cl CFLAGS=-MD untgz.exe: untgz.obj ..\..\zlib.lib $(CC) $(CFLAGS) untgz.obj ..\..\zlib.lib untgz.obj: untgz.c ..\..\zlib.h $(CC) $(CFLAGS) -c -I..\.. untgz.c ..\..\zlib.lib: cd ..\.. $(MAKE) -f win32\makefile.msc cd contrib\untgz clean: -del untgz.obj -del untgz.exe tcl8.6.14/compat/zlib/contrib/untgz/Makefile0000644000175000017500000000035214554262142020334 0ustar sergeisergeiCC=cc CFLAGS=-g untgz: untgz.o ../../libz.a $(CC) $(CFLAGS) -o untgz untgz.o -L../.. -lz untgz.o: untgz.c ../../zlib.h $(CC) $(CFLAGS) -c -I../.. untgz.c ../../libz.a: cd ../..; ./configure; make clean: rm -f untgz untgz.o *~ tcl8.6.14/compat/zlib/contrib/iostream/0000755000175000017500000000000014566153412017352 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/iostream/test.cpp0000644000175000017500000000101614554262142021031 0ustar sergeisergei #include "zfstream.h" int main() { // Construct a stream object with this filebuffer. Anything sent // to this stream will go to standard out. gzofstream os( 1, ios::out ); // This text is getting compressed and sent to stdout. // To prove this, run 'test | zcat'. os << "Hello, Mommy" << endl; os << setcompressionlevel( Z_NO_COMPRESSION ); os << "hello, hello, hi, ho!" << endl; setcompressionlevel( os, Z_DEFAULT_COMPRESSION ) << "I'm compressing again" << endl; os.close(); return 0; } tcl8.6.14/compat/zlib/contrib/iostream/zfstream.cpp0000644000175000017500000001177014554262142021715 0ustar sergeisergei #include "zfstream.h" gzfilebuf::gzfilebuf() : file(NULL), mode(0), own_file_descriptor(0) { } gzfilebuf::~gzfilebuf() { sync(); if ( own_file_descriptor ) close(); } gzfilebuf *gzfilebuf::open( const char *name, int io_mode ) { if ( is_open() ) return NULL; char char_mode[10]; char *p = char_mode; if ( io_mode & ios::in ) { mode = ios::in; *p++ = 'r'; } else if ( io_mode & ios::app ) { mode = ios::app; *p++ = 'a'; } else { mode = ios::out; *p++ = 'w'; } if ( io_mode & ios::binary ) { mode |= ios::binary; *p++ = 'b'; } // Hard code the compression level if ( io_mode & (ios::out|ios::app )) { *p++ = '9'; } // Put the end-of-string indicator *p = '\0'; if ( (file = gzopen(name, char_mode)) == NULL ) return NULL; own_file_descriptor = 1; return this; } gzfilebuf *gzfilebuf::attach( int file_descriptor, int io_mode ) { if ( is_open() ) return NULL; char char_mode[10]; char *p = char_mode; if ( io_mode & ios::in ) { mode = ios::in; *p++ = 'r'; } else if ( io_mode & ios::app ) { mode = ios::app; *p++ = 'a'; } else { mode = ios::out; *p++ = 'w'; } if ( io_mode & ios::binary ) { mode |= ios::binary; *p++ = 'b'; } // Hard code the compression level if ( io_mode & (ios::out|ios::app )) { *p++ = '9'; } // Put the end-of-string indicator *p = '\0'; if ( (file = gzdopen(file_descriptor, char_mode)) == NULL ) return NULL; own_file_descriptor = 0; return this; } gzfilebuf *gzfilebuf::close() { if ( is_open() ) { sync(); gzclose( file ); file = NULL; } return this; } int gzfilebuf::setcompressionlevel( int comp_level ) { return gzsetparams(file, comp_level, -2); } int gzfilebuf::setcompressionstrategy( int comp_strategy ) { return gzsetparams(file, -2, comp_strategy); } streampos gzfilebuf::seekoff( streamoff off, ios::seek_dir dir, int which ) { return streampos(EOF); } int gzfilebuf::underflow() { // If the file hasn't been opened for reading, error. if ( !is_open() || !(mode & ios::in) ) return EOF; // if a buffer doesn't exists, allocate one. if ( !base() ) { if ( (allocate()) == EOF ) return EOF; setp(0,0); } else { if ( in_avail() ) return (unsigned char) *gptr(); if ( out_waiting() ) { if ( flushbuf() == EOF ) return EOF; } } // Attempt to fill the buffer. int result = fillbuf(); if ( result == EOF ) { // disable get area setg(0,0,0); return EOF; } return (unsigned char) *gptr(); } int gzfilebuf::overflow( int c ) { if ( !is_open() || !(mode & ios::out) ) return EOF; if ( !base() ) { if ( allocate() == EOF ) return EOF; setg(0,0,0); } else { if (in_avail()) { return EOF; } if (out_waiting()) { if (flushbuf() == EOF) return EOF; } } int bl = blen(); setp( base(), base() + bl); if ( c != EOF ) { *pptr() = c; pbump(1); } return 0; } int gzfilebuf::sync() { if ( !is_open() ) return EOF; if ( out_waiting() ) return flushbuf(); return 0; } int gzfilebuf::flushbuf() { int n; char *q; q = pbase(); n = pptr() - q; if ( gzwrite( file, q, n) < n ) return EOF; setp(0,0); return 0; } int gzfilebuf::fillbuf() { int required; char *p; p = base(); required = blen(); int t = gzread( file, p, required ); if ( t <= 0) return EOF; setg( base(), base(), base()+t); return t; } gzfilestream_common::gzfilestream_common() : ios( gzfilestream_common::rdbuf() ) { } gzfilestream_common::~gzfilestream_common() { } void gzfilestream_common::attach( int fd, int io_mode ) { if ( !buffer.attach( fd, io_mode) ) clear( ios::failbit | ios::badbit ); else clear(); } void gzfilestream_common::open( const char *name, int io_mode ) { if ( !buffer.open( name, io_mode ) ) clear( ios::failbit | ios::badbit ); else clear(); } void gzfilestream_common::close() { if ( !buffer.close() ) clear( ios::failbit | ios::badbit ); } gzfilebuf *gzfilestream_common::rdbuf() { return &buffer; } gzifstream::gzifstream() : ios( gzfilestream_common::rdbuf() ) { clear( ios::badbit ); } gzifstream::gzifstream( const char *name, int io_mode ) : ios( gzfilestream_common::rdbuf() ) { gzfilestream_common::open( name, io_mode ); } gzifstream::gzifstream( int fd, int io_mode ) : ios( gzfilestream_common::rdbuf() ) { gzfilestream_common::attach( fd, io_mode ); } gzifstream::~gzifstream() { } gzofstream::gzofstream() : ios( gzfilestream_common::rdbuf() ) { clear( ios::badbit ); } gzofstream::gzofstream( const char *name, int io_mode ) : ios( gzfilestream_common::rdbuf() ) { gzfilestream_common::open( name, io_mode ); } gzofstream::gzofstream( int fd, int io_mode ) : ios( gzfilestream_common::rdbuf() ) { gzfilestream_common::attach( fd, io_mode ); } gzofstream::~gzofstream() { } tcl8.6.14/compat/zlib/contrib/iostream/zfstream.h0000644000175000017500000000464314554262142021363 0ustar sergeisergei #ifndef zfstream_h #define zfstream_h #include #include "zlib.h" class gzfilebuf : public streambuf { public: gzfilebuf( ); virtual ~gzfilebuf(); gzfilebuf *open( const char *name, int io_mode ); gzfilebuf *attach( int file_descriptor, int io_mode ); gzfilebuf *close(); int setcompressionlevel( int comp_level ); int setcompressionstrategy( int comp_strategy ); inline int is_open() const { return (file !=NULL); } virtual streampos seekoff( streamoff, ios::seek_dir, int ); virtual int sync(); protected: virtual int underflow(); virtual int overflow( int = EOF ); private: gzFile file; short mode; short own_file_descriptor; int flushbuf(); int fillbuf(); }; class gzfilestream_common : virtual public ios { friend class gzifstream; friend class gzofstream; friend gzofstream &setcompressionlevel( gzofstream &, int ); friend gzofstream &setcompressionstrategy( gzofstream &, int ); public: virtual ~gzfilestream_common(); void attach( int fd, int io_mode ); void open( const char *name, int io_mode ); void close(); protected: gzfilestream_common(); private: gzfilebuf *rdbuf(); gzfilebuf buffer; }; class gzifstream : public gzfilestream_common, public istream { public: gzifstream(); gzifstream( const char *name, int io_mode = ios::in ); gzifstream( int fd, int io_mode = ios::in ); virtual ~gzifstream(); }; class gzofstream : public gzfilestream_common, public ostream { public: gzofstream(); gzofstream( const char *name, int io_mode = ios::out ); gzofstream( int fd, int io_mode = ios::out ); virtual ~gzofstream(); }; template class gzomanip { friend gzofstream &operator<<(gzofstream &, const gzomanip &); public: gzomanip(gzofstream &(*f)(gzofstream &, T), T v) : func(f), val(v) { } private: gzofstream &(*func)(gzofstream &, T); T val; }; template gzofstream &operator<<(gzofstream &s, const gzomanip &m) { return (*m.func)(s, m.val); } inline gzofstream &setcompressionlevel( gzofstream &s, int l ) { (s.rdbuf())->setcompressionlevel(l); return s; } inline gzofstream &setcompressionstrategy( gzofstream &s, int l ) { (s.rdbuf())->setcompressionstrategy(l); return s; } inline gzomanip setcompressionlevel(int l) { return gzomanip(&setcompressionlevel,l); } inline gzomanip setcompressionstrategy(int l) { return gzomanip(&setcompressionstrategy,l); } #endif tcl8.6.14/compat/zlib/contrib/iostream2/0000755000175000017500000000000014566153412017434 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/iostream2/zstream.h0000644000175000017500000002210314554262142021266 0ustar sergeisergei/* * * Copyright (c) 1997 * Christian Michelsen Research AS * Advanced Computing * Fantoftvegen 38, 5036 BERGEN, Norway * http://www.cmr.no * * Permission to use, copy, modify, distribute and sell this software * and its documentation for any purpose is hereby granted without fee, * provided that the above copyright notice appear in all copies and * that both that copyright notice and this permission notice appear * in supporting documentation. Christian Michelsen Research AS makes no * representations about the suitability of this software for any * purpose. It is provided "as is" without express or implied warranty. * */ #ifndef ZSTREAM__H #define ZSTREAM__H /* * zstream.h - C++ interface to the 'zlib' general purpose compression library * $Id: zstream.h 1.1 1997-06-25 12:00:56+02 tyge Exp tyge $ */ #include #include #include #include "zlib.h" #if defined(_WIN32) # include # include # define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY) #else # define SET_BINARY_MODE(file) #endif class zstringlen { public: zstringlen(class izstream&); zstringlen(class ozstream&, const char*); size_t value() const { return val.word; } private: struct Val { unsigned char byte; size_t word; } val; }; // ----------------------------- izstream ----------------------------- class izstream { public: izstream() : m_fp(0) {} izstream(FILE* fp) : m_fp(0) { open(fp); } izstream(const char* name) : m_fp(0) { open(name); } ~izstream() { close(); } /* Opens a gzip (.gz) file for reading. * open() can be used to read a file which is not in gzip format; * in this case read() will directly read from the file without * decompression. errno can be checked to distinguish two error * cases (if errno is zero, the zlib error is Z_MEM_ERROR). */ void open(const char* name) { if (m_fp) close(); m_fp = ::gzopen(name, "rb"); } void open(FILE* fp) { SET_BINARY_MODE(fp); if (m_fp) close(); m_fp = ::gzdopen(fileno(fp), "rb"); } /* Flushes all pending input if necessary, closes the compressed file * and deallocates all the (de)compression state. The return value is * the zlib error number (see function error() below). */ int close() { int r = ::gzclose(m_fp); m_fp = 0; return r; } /* Binary read the given number of bytes from the compressed file. */ int read(void* buf, size_t len) { return ::gzread(m_fp, buf, len); } /* Returns the error message for the last error which occurred on the * given compressed file. errnum is set to zlib error number. If an * error occurred in the file system and not in the compression library, * errnum is set to Z_ERRNO and the application may consult errno * to get the exact error code. */ const char* error(int* errnum) { return ::gzerror(m_fp, errnum); } gzFile fp() { return m_fp; } private: gzFile m_fp; }; /* * Binary read the given (array of) object(s) from the compressed file. * If the input file was not in gzip format, read() copies the objects number * of bytes into the buffer. * returns the number of uncompressed bytes actually read * (0 for end of file, -1 for error). */ template inline int read(izstream& zs, T* x, Items items) { return ::gzread(zs.fp(), x, items*sizeof(T)); } /* * Binary input with the '>' operator. */ template inline izstream& operator>(izstream& zs, T& x) { ::gzread(zs.fp(), &x, sizeof(T)); return zs; } inline zstringlen::zstringlen(izstream& zs) { zs > val.byte; if (val.byte == 255) zs > val.word; else val.word = val.byte; } /* * Read length of string + the string with the '>' operator. */ inline izstream& operator>(izstream& zs, char* x) { zstringlen len(zs); ::gzread(zs.fp(), x, len.value()); x[len.value()] = '\0'; return zs; } inline char* read_string(izstream& zs) { zstringlen len(zs); char* x = new char[len.value()+1]; ::gzread(zs.fp(), x, len.value()); x[len.value()] = '\0'; return x; } // ----------------------------- ozstream ----------------------------- class ozstream { public: ozstream() : m_fp(0), m_os(0) { } ozstream(FILE* fp, int level = Z_DEFAULT_COMPRESSION) : m_fp(0), m_os(0) { open(fp, level); } ozstream(const char* name, int level = Z_DEFAULT_COMPRESSION) : m_fp(0), m_os(0) { open(name, level); } ~ozstream() { close(); } /* Opens a gzip (.gz) file for writing. * The compression level parameter should be in 0..9 * errno can be checked to distinguish two error cases * (if errno is zero, the zlib error is Z_MEM_ERROR). */ void open(const char* name, int level = Z_DEFAULT_COMPRESSION) { char mode[4] = "wb\0"; if (level != Z_DEFAULT_COMPRESSION) mode[2] = '0'+level; if (m_fp) close(); m_fp = ::gzopen(name, mode); } /* open from a FILE pointer. */ void open(FILE* fp, int level = Z_DEFAULT_COMPRESSION) { SET_BINARY_MODE(fp); char mode[4] = "wb\0"; if (level != Z_DEFAULT_COMPRESSION) mode[2] = '0'+level; if (m_fp) close(); m_fp = ::gzdopen(fileno(fp), mode); } /* Flushes all pending output if necessary, closes the compressed file * and deallocates all the (de)compression state. The return value is * the zlib error number (see function error() below). */ int close() { if (m_os) { ::gzwrite(m_fp, m_os->str(), m_os->pcount()); delete[] m_os->str(); delete m_os; m_os = 0; } int r = ::gzclose(m_fp); m_fp = 0; return r; } /* Binary write the given number of bytes into the compressed file. */ int write(const void* buf, size_t len) { return ::gzwrite(m_fp, (voidp) buf, len); } /* Flushes all pending output into the compressed file. The parameter * _flush is as in the deflate() function. The return value is the zlib * error number (see function gzerror below). flush() returns Z_OK if * the flush_ parameter is Z_FINISH and all output could be flushed. * flush() should be called only when strictly necessary because it can * degrade compression. */ int flush(int _flush) { os_flush(); return ::gzflush(m_fp, _flush); } /* Returns the error message for the last error which occurred on the * given compressed file. errnum is set to zlib error number. If an * error occurred in the file system and not in the compression library, * errnum is set to Z_ERRNO and the application may consult errno * to get the exact error code. */ const char* error(int* errnum) { return ::gzerror(m_fp, errnum); } gzFile fp() { return m_fp; } ostream& os() { if (m_os == 0) m_os = new ostrstream; return *m_os; } void os_flush() { if (m_os && m_os->pcount()>0) { ostrstream* oss = new ostrstream; oss->fill(m_os->fill()); oss->flags(m_os->flags()); oss->precision(m_os->precision()); oss->width(m_os->width()); ::gzwrite(m_fp, m_os->str(), m_os->pcount()); delete[] m_os->str(); delete m_os; m_os = oss; } } private: gzFile m_fp; ostrstream* m_os; }; /* * Binary write the given (array of) object(s) into the compressed file. * returns the number of uncompressed bytes actually written * (0 in case of error). */ template inline int write(ozstream& zs, const T* x, Items items) { return ::gzwrite(zs.fp(), (voidp) x, items*sizeof(T)); } /* * Binary output with the '<' operator. */ template inline ozstream& operator<(ozstream& zs, const T& x) { ::gzwrite(zs.fp(), (voidp) &x, sizeof(T)); return zs; } inline zstringlen::zstringlen(ozstream& zs, const char* x) { val.byte = 255; val.word = ::strlen(x); if (val.word < 255) zs < (val.byte = val.word); else zs < val; } /* * Write length of string + the string with the '<' operator. */ inline ozstream& operator<(ozstream& zs, const char* x) { zstringlen len(zs, x); ::gzwrite(zs.fp(), (voidp) x, len.value()); return zs; } #ifdef _MSC_VER inline ozstream& operator<(ozstream& zs, char* const& x) { return zs < (const char*) x; } #endif /* * Ascii write with the << operator; */ template inline ostream& operator<<(ozstream& zs, const T& x) { zs.os_flush(); return zs.os() << x; } #endif tcl8.6.14/compat/zlib/contrib/iostream2/zstream_test.cpp0000644000175000017500000000130714554262142022663 0ustar sergeisergei#include "zstream.h" #include #include #include void main() { char h[256] = "Hello"; char* g = "Goodbye"; ozstream out("temp.gz"); out < "This works well" < h < g; out.close(); izstream in("temp.gz"); // read it back char *x = read_string(in), *y = new char[256], z[256]; in > y > z; in.close(); cout << x << endl << y << endl << z << endl; out.open("temp.gz"); // try ascii output; zcat temp.gz to see the results out << setw(50) << setfill('#') << setprecision(20) << x << endl << y << endl << z << endl; out << z << endl << y << endl << x << endl; out << 1.1234567890123456789 << endl; delete[] x; delete[] y; } tcl8.6.14/compat/zlib/contrib/pascal/0000755000175000017500000000000014566153412016772 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/pascal/readme.txt0000644000175000017500000000567414554262142021002 0ustar sergeisergei This directory contains a Pascal (Delphi, Kylix) interface to the zlib data compression library. Directory listing ================= zlibd32.mak makefile for Borland C++ example.pas usage example of zlib zlibpas.pas the Pascal interface to zlib readme.txt this file Compatibility notes =================== - Although the name "zlib" would have been more normal for the zlibpas unit, this name is already taken by Borland's ZLib unit. This is somehow unfortunate, because that unit is not a genuine interface to the full-fledged zlib functionality, but a suite of class wrappers around zlib streams. Other essential features, such as checksums, are missing. It would have been more appropriate for that unit to have a name like "ZStreams", or something similar. - The C and zlib-supplied types int, uInt, long, uLong, etc. are translated directly into Pascal types of similar sizes (Integer, LongInt, etc.), to avoid namespace pollution. In particular, there is no conversion of unsigned int into a Pascal unsigned integer. The Word type is non-portable and has the same size (16 bits) both in a 16-bit and in a 32-bit environment, unlike Integer. Even if there is a 32-bit Cardinal type, there is no real need for unsigned int in zlib under a 32-bit environment. - Except for the callbacks, the zlib function interfaces are assuming the calling convention normally used in Pascal (__pascal for DOS and Windows16, __fastcall for Windows32). Since the cdecl keyword is used, the old Turbo Pascal does not work with this interface. - The gz* function interfaces are not translated, to avoid interfacing problems with the C runtime library. Besides, gzprintf(gzFile file, const char *format, ...) cannot be translated into Pascal. Legal issues ============ The zlibpas interface is: Copyright (C) 1995-2003 Jean-loup Gailly and Mark Adler. Copyright (C) 1998 by Bob Dellaca. Copyright (C) 2003 by Cosmin Truta. The example program is: Copyright (C) 1995-2003 by Jean-loup Gailly. Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali. Copyright (C) 2003 by Cosmin Truta. This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. tcl8.6.14/compat/zlib/contrib/pascal/zlibpas.pas0000644000175000017500000002361614560736523021157 0ustar sergeisergei(* zlibpas -- Pascal interface to the zlib data compression library * * Copyright (C) 2003 Cosmin Truta. * Derived from original sources by Bob Dellaca. * For conditions of distribution and use, see copyright notice in readme.txt *) unit zlibpas; interface const ZLIB_VERSION = '1.3.1'; ZLIB_VERNUM = $12a0; type alloc_func = function(opaque: Pointer; items, size: Integer): Pointer; cdecl; free_func = procedure(opaque, address: Pointer); cdecl; in_func = function(opaque: Pointer; var buf: PByte): Integer; cdecl; out_func = function(opaque: Pointer; buf: PByte; size: Integer): Integer; cdecl; z_streamp = ^z_stream; z_stream = packed record next_in: PChar; (* next input byte *) avail_in: Integer; (* number of bytes available at next_in *) total_in: LongInt; (* total nb of input bytes read so far *) next_out: PChar; (* next output byte should be put there *) avail_out: Integer; (* remaining free space at next_out *) total_out: LongInt; (* total nb of bytes output so far *) msg: PChar; (* last error message, NULL if no error *) state: Pointer; (* not visible by applications *) zalloc: alloc_func; (* used to allocate the internal state *) zfree: free_func; (* used to free the internal state *) opaque: Pointer; (* private data object passed to zalloc and zfree *) data_type: Integer; (* best guess about the data type: ascii or binary *) adler: LongInt; (* adler32 value of the uncompressed data *) reserved: LongInt; (* reserved for future use *) end; gz_headerp = ^gz_header; gz_header = packed record text: Integer; (* true if compressed data believed to be text *) time: LongInt; (* modification time *) xflags: Integer; (* extra flags (not used when writing a gzip file) *) os: Integer; (* operating system *) extra: PChar; (* pointer to extra field or Z_NULL if none *) extra_len: Integer; (* extra field length (valid if extra != Z_NULL) *) extra_max: Integer; (* space at extra (only when reading header) *) name: PChar; (* pointer to zero-terminated file name or Z_NULL *) name_max: Integer; (* space at name (only when reading header) *) comment: PChar; (* pointer to zero-terminated comment or Z_NULL *) comm_max: Integer; (* space at comment (only when reading header) *) hcrc: Integer; (* true if there was or will be a header crc *) done: Integer; (* true when done reading gzip header *) end; (* constants *) const Z_NO_FLUSH = 0; Z_PARTIAL_FLUSH = 1; Z_SYNC_FLUSH = 2; Z_FULL_FLUSH = 3; Z_FINISH = 4; Z_BLOCK = 5; Z_TREES = 6; Z_OK = 0; Z_STREAM_END = 1; Z_NEED_DICT = 2; Z_ERRNO = -1; Z_STREAM_ERROR = -2; Z_DATA_ERROR = -3; Z_MEM_ERROR = -4; Z_BUF_ERROR = -5; Z_VERSION_ERROR = -6; Z_NO_COMPRESSION = 0; Z_BEST_SPEED = 1; Z_BEST_COMPRESSION = 9; Z_DEFAULT_COMPRESSION = -1; Z_FILTERED = 1; Z_HUFFMAN_ONLY = 2; Z_RLE = 3; Z_FIXED = 4; Z_DEFAULT_STRATEGY = 0; Z_BINARY = 0; Z_TEXT = 1; Z_ASCII = 1; Z_UNKNOWN = 2; Z_DEFLATED = 8; (* basic functions *) function zlibVersion: PChar; function deflateInit(var strm: z_stream; level: Integer): Integer; function deflate(var strm: z_stream; flush: Integer): Integer; function deflateEnd(var strm: z_stream): Integer; function inflateInit(var strm: z_stream): Integer; function inflate(var strm: z_stream; flush: Integer): Integer; function inflateEnd(var strm: z_stream): Integer; (* advanced functions *) function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel, strategy: Integer): Integer; function deflateSetDictionary(var strm: z_stream; const dictionary: PChar; dictLength: Integer): Integer; function deflateCopy(var dest, source: z_stream): Integer; function deflateReset(var strm: z_stream): Integer; function deflateParams(var strm: z_stream; level, strategy: Integer): Integer; function deflateTune(var strm: z_stream; good_length, max_lazy, nice_length, max_chain: Integer): Integer; function deflateBound(var strm: z_stream; sourceLen: LongInt): LongInt; function deflatePending(var strm: z_stream; var pending: Integer; var bits: Integer): Integer; function deflatePrime(var strm: z_stream; bits, value: Integer): Integer; function deflateSetHeader(var strm: z_stream; head: gz_header): Integer; function inflateInit2(var strm: z_stream; windowBits: Integer): Integer; function inflateSetDictionary(var strm: z_stream; const dictionary: PChar; dictLength: Integer): Integer; function inflateSync(var strm: z_stream): Integer; function inflateCopy(var dest, source: z_stream): Integer; function inflateReset(var strm: z_stream): Integer; function inflateReset2(var strm: z_stream; windowBits: Integer): Integer; function inflatePrime(var strm: z_stream; bits, value: Integer): Integer; function inflateMark(var strm: z_stream): LongInt; function inflateGetHeader(var strm: z_stream; var head: gz_header): Integer; function inflateBackInit(var strm: z_stream; windowBits: Integer; window: PChar): Integer; function inflateBack(var strm: z_stream; in_fn: in_func; in_desc: Pointer; out_fn: out_func; out_desc: Pointer): Integer; function inflateBackEnd(var strm: z_stream): Integer; function zlibCompileFlags: LongInt; (* utility functions *) function compress(dest: PChar; var destLen: LongInt; const source: PChar; sourceLen: LongInt): Integer; function compress2(dest: PChar; var destLen: LongInt; const source: PChar; sourceLen: LongInt; level: Integer): Integer; function compressBound(sourceLen: LongInt): LongInt; function uncompress(dest: PChar; var destLen: LongInt; const source: PChar; sourceLen: LongInt): Integer; (* checksum functions *) function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; function adler32_combine(adler1, adler2, len2: LongInt): LongInt; function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt; function crc32_combine(crc1, crc2, len2: LongInt): LongInt; (* various hacks, don't look :) *) function deflateInit_(var strm: z_stream; level: Integer; const version: PChar; stream_size: Integer): Integer; function inflateInit_(var strm: z_stream; const version: PChar; stream_size: Integer): Integer; function deflateInit2_(var strm: z_stream; level, method, windowBits, memLevel, strategy: Integer; const version: PChar; stream_size: Integer): Integer; function inflateInit2_(var strm: z_stream; windowBits: Integer; const version: PChar; stream_size: Integer): Integer; function inflateBackInit_(var strm: z_stream; windowBits: Integer; window: PChar; const version: PChar; stream_size: Integer): Integer; implementation {$L adler32.obj} {$L compress.obj} {$L crc32.obj} {$L deflate.obj} {$L infback.obj} {$L inffast.obj} {$L inflate.obj} {$L inftrees.obj} {$L trees.obj} {$L uncompr.obj} {$L zutil.obj} function adler32; external; function adler32_combine; external; function compress; external; function compress2; external; function compressBound; external; function crc32; external; function crc32_combine; external; function deflate; external; function deflateBound; external; function deflateCopy; external; function deflateEnd; external; function deflateInit_; external; function deflateInit2_; external; function deflateParams; external; function deflatePending; external; function deflatePrime; external; function deflateReset; external; function deflateSetDictionary; external; function deflateSetHeader; external; function deflateTune; external; function inflate; external; function inflateBack; external; function inflateBackEnd; external; function inflateBackInit_; external; function inflateCopy; external; function inflateEnd; external; function inflateGetHeader; external; function inflateInit_; external; function inflateInit2_; external; function inflateMark; external; function inflatePrime; external; function inflateReset; external; function inflateReset2; external; function inflateSetDictionary; external; function inflateSync; external; function uncompress; external; function zlibCompileFlags; external; function zlibVersion; external; function deflateInit(var strm: z_stream; level: Integer): Integer; begin Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(z_stream)); end; function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel, strategy: Integer): Integer; begin Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, sizeof(z_stream)); end; function inflateInit(var strm: z_stream): Integer; begin Result := inflateInit_(strm, ZLIB_VERSION, sizeof(z_stream)); end; function inflateInit2(var strm: z_stream; windowBits: Integer): Integer; begin Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(z_stream)); end; function inflateBackInit(var strm: z_stream; windowBits: Integer; window: PChar): Integer; begin Result := inflateBackInit_(strm, windowBits, window, ZLIB_VERSION, sizeof(z_stream)); end; function _malloc(Size: Integer): Pointer; cdecl; begin GetMem(Result, Size); end; procedure _free(Block: Pointer); cdecl; begin FreeMem(Block); end; procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl; begin FillChar(P^, count, B); end; procedure _memcpy(dest, source: Pointer; count: Integer); cdecl; begin Move(source^, dest^, count); end; end. tcl8.6.14/compat/zlib/contrib/pascal/example.pas0000644000175000017500000003650714554262142021143 0ustar sergeisergei(* example.c -- usage example of the zlib compression library * Copyright (C) 1995-2003 Jean-loup Gailly. * For conditions of distribution and use, see copyright notice in zlib.h * * Pascal translation * Copyright (C) 1998 by Jacques Nomssi Nzali. * For conditions of distribution and use, see copyright notice in readme.txt * * Adaptation to the zlibpas interface * Copyright (C) 2003 by Cosmin Truta. * For conditions of distribution and use, see copyright notice in readme.txt *) program example; {$DEFINE TEST_COMPRESS} {DO NOT $DEFINE TEST_GZIO} {$DEFINE TEST_DEFLATE} {$DEFINE TEST_INFLATE} {$DEFINE TEST_FLUSH} {$DEFINE TEST_SYNC} {$DEFINE TEST_DICT} uses SysUtils, zlibpas; const TESTFILE = 'foo.gz'; (* "hello world" would be more standard, but the repeated "hello" * stresses the compression code better, sorry... *) const hello: PChar = 'hello, hello!'; const dictionary: PChar = 'hello'; var dictId: LongInt; (* Adler32 value of the dictionary *) procedure CHECK_ERR(err: Integer; msg: String); begin if err <> Z_OK then begin WriteLn(msg, ' error: ', err); Halt(1); end; end; procedure EXIT_ERR(const msg: String); begin WriteLn('Error: ', msg); Halt(1); end; (* =========================================================================== * Test compress and uncompress *) {$IFDEF TEST_COMPRESS} procedure test_compress(compr: Pointer; comprLen: LongInt; uncompr: Pointer; uncomprLen: LongInt); var err: Integer; len: LongInt; begin len := StrLen(hello)+1; err := compress(compr, comprLen, hello, len); CHECK_ERR(err, 'compress'); StrCopy(PChar(uncompr), 'garbage'); err := uncompress(uncompr, uncomprLen, compr, comprLen); CHECK_ERR(err, 'uncompress'); if StrComp(PChar(uncompr), hello) <> 0 then EXIT_ERR('bad uncompress') else WriteLn('uncompress(): ', PChar(uncompr)); end; {$ENDIF} (* =========================================================================== * Test read/write of .gz files *) {$IFDEF TEST_GZIO} procedure test_gzio(const fname: PChar; (* compressed file name *) uncompr: Pointer; uncomprLen: LongInt); var err: Integer; len: Integer; zfile: gzFile; pos: LongInt; begin len := StrLen(hello)+1; zfile := gzopen(fname, 'wb'); if zfile = NIL then begin WriteLn('gzopen error'); Halt(1); end; gzputc(zfile, 'h'); if gzputs(zfile, 'ello') <> 4 then begin WriteLn('gzputs err: ', gzerror(zfile, err)); Halt(1); end; {$IFDEF GZ_FORMAT_STRING} if gzprintf(zfile, ', %s!', 'hello') <> 8 then begin WriteLn('gzprintf err: ', gzerror(zfile, err)); Halt(1); end; {$ELSE} if gzputs(zfile, ', hello!') <> 8 then begin WriteLn('gzputs err: ', gzerror(zfile, err)); Halt(1); end; {$ENDIF} gzseek(zfile, 1, SEEK_CUR); (* add one zero byte *) gzclose(zfile); zfile := gzopen(fname, 'rb'); if zfile = NIL then begin WriteLn('gzopen error'); Halt(1); end; StrCopy(PChar(uncompr), 'garbage'); if gzread(zfile, uncompr, uncomprLen) <> len then begin WriteLn('gzread err: ', gzerror(zfile, err)); Halt(1); end; if StrComp(PChar(uncompr), hello) <> 0 then begin WriteLn('bad gzread: ', PChar(uncompr)); Halt(1); end else WriteLn('gzread(): ', PChar(uncompr)); pos := gzseek(zfile, -8, SEEK_CUR); if (pos <> 6) or (gztell(zfile) <> pos) then begin WriteLn('gzseek error, pos=', pos, ', gztell=', gztell(zfile)); Halt(1); end; if gzgetc(zfile) <> ' ' then begin WriteLn('gzgetc error'); Halt(1); end; if gzungetc(' ', zfile) <> ' ' then begin WriteLn('gzungetc error'); Halt(1); end; gzgets(zfile, PChar(uncompr), uncomprLen); uncomprLen := StrLen(PChar(uncompr)); if uncomprLen <> 7 then (* " hello!" *) begin WriteLn('gzgets err after gzseek: ', gzerror(zfile, err)); Halt(1); end; if StrComp(PChar(uncompr), hello + 6) <> 0 then begin WriteLn('bad gzgets after gzseek'); Halt(1); end else WriteLn('gzgets() after gzseek: ', PChar(uncompr)); gzclose(zfile); end; {$ENDIF} (* =========================================================================== * Test deflate with small buffers *) {$IFDEF TEST_DEFLATE} procedure test_deflate(compr: Pointer; comprLen: LongInt); var c_stream: z_stream; (* compression stream *) err: Integer; len: LongInt; begin len := StrLen(hello)+1; c_stream.zalloc := NIL; c_stream.zfree := NIL; c_stream.opaque := NIL; err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION); CHECK_ERR(err, 'deflateInit'); c_stream.next_in := hello; c_stream.next_out := compr; while (c_stream.total_in <> len) and (c_stream.total_out < comprLen) do begin c_stream.avail_out := 1; { force small buffers } c_stream.avail_in := 1; err := deflate(c_stream, Z_NO_FLUSH); CHECK_ERR(err, 'deflate'); end; (* Finish the stream, still forcing small buffers: *) while TRUE do begin c_stream.avail_out := 1; err := deflate(c_stream, Z_FINISH); if err = Z_STREAM_END then break; CHECK_ERR(err, 'deflate'); end; err := deflateEnd(c_stream); CHECK_ERR(err, 'deflateEnd'); end; {$ENDIF} (* =========================================================================== * Test inflate with small buffers *) {$IFDEF TEST_INFLATE} procedure test_inflate(compr: Pointer; comprLen : LongInt; uncompr: Pointer; uncomprLen : LongInt); var err: Integer; d_stream: z_stream; (* decompression stream *) begin StrCopy(PChar(uncompr), 'garbage'); d_stream.zalloc := NIL; d_stream.zfree := NIL; d_stream.opaque := NIL; d_stream.next_in := compr; d_stream.avail_in := 0; d_stream.next_out := uncompr; err := inflateInit(d_stream); CHECK_ERR(err, 'inflateInit'); while (d_stream.total_out < uncomprLen) and (d_stream.total_in < comprLen) do begin d_stream.avail_out := 1; (* force small buffers *) d_stream.avail_in := 1; err := inflate(d_stream, Z_NO_FLUSH); if err = Z_STREAM_END then break; CHECK_ERR(err, 'inflate'); end; err := inflateEnd(d_stream); CHECK_ERR(err, 'inflateEnd'); if StrComp(PChar(uncompr), hello) <> 0 then EXIT_ERR('bad inflate') else WriteLn('inflate(): ', PChar(uncompr)); end; {$ENDIF} (* =========================================================================== * Test deflate with large buffers and dynamic change of compression level *) {$IFDEF TEST_DEFLATE} procedure test_large_deflate(compr: Pointer; comprLen: LongInt; uncompr: Pointer; uncomprLen: LongInt); var c_stream: z_stream; (* compression stream *) err: Integer; begin c_stream.zalloc := NIL; c_stream.zfree := NIL; c_stream.opaque := NIL; err := deflateInit(c_stream, Z_BEST_SPEED); CHECK_ERR(err, 'deflateInit'); c_stream.next_out := compr; c_stream.avail_out := Integer(comprLen); (* At this point, uncompr is still mostly zeroes, so it should compress * very well: *) c_stream.next_in := uncompr; c_stream.avail_in := Integer(uncomprLen); err := deflate(c_stream, Z_NO_FLUSH); CHECK_ERR(err, 'deflate'); if c_stream.avail_in <> 0 then EXIT_ERR('deflate not greedy'); (* Feed in already compressed data and switch to no compression: *) deflateParams(c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY); c_stream.next_in := compr; c_stream.avail_in := Integer(comprLen div 2); err := deflate(c_stream, Z_NO_FLUSH); CHECK_ERR(err, 'deflate'); (* Switch back to compressing mode: *) deflateParams(c_stream, Z_BEST_COMPRESSION, Z_FILTERED); c_stream.next_in := uncompr; c_stream.avail_in := Integer(uncomprLen); err := deflate(c_stream, Z_NO_FLUSH); CHECK_ERR(err, 'deflate'); err := deflate(c_stream, Z_FINISH); if err <> Z_STREAM_END then EXIT_ERR('deflate should report Z_STREAM_END'); err := deflateEnd(c_stream); CHECK_ERR(err, 'deflateEnd'); end; {$ENDIF} (* =========================================================================== * Test inflate with large buffers *) {$IFDEF TEST_INFLATE} procedure test_large_inflate(compr: Pointer; comprLen: LongInt; uncompr: Pointer; uncomprLen: LongInt); var err: Integer; d_stream: z_stream; (* decompression stream *) begin StrCopy(PChar(uncompr), 'garbage'); d_stream.zalloc := NIL; d_stream.zfree := NIL; d_stream.opaque := NIL; d_stream.next_in := compr; d_stream.avail_in := Integer(comprLen); err := inflateInit(d_stream); CHECK_ERR(err, 'inflateInit'); while TRUE do begin d_stream.next_out := uncompr; (* discard the output *) d_stream.avail_out := Integer(uncomprLen); err := inflate(d_stream, Z_NO_FLUSH); if err = Z_STREAM_END then break; CHECK_ERR(err, 'large inflate'); end; err := inflateEnd(d_stream); CHECK_ERR(err, 'inflateEnd'); if d_stream.total_out <> 2 * uncomprLen + comprLen div 2 then begin WriteLn('bad large inflate: ', d_stream.total_out); Halt(1); end else WriteLn('large_inflate(): OK'); end; {$ENDIF} (* =========================================================================== * Test deflate with full flush *) {$IFDEF TEST_FLUSH} procedure test_flush(compr: Pointer; var comprLen : LongInt); var c_stream: z_stream; (* compression stream *) err: Integer; len: Integer; begin len := StrLen(hello)+1; c_stream.zalloc := NIL; c_stream.zfree := NIL; c_stream.opaque := NIL; err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION); CHECK_ERR(err, 'deflateInit'); c_stream.next_in := hello; c_stream.next_out := compr; c_stream.avail_in := 3; c_stream.avail_out := Integer(comprLen); err := deflate(c_stream, Z_FULL_FLUSH); CHECK_ERR(err, 'deflate'); Inc(PByteArray(compr)^[3]); (* force an error in first compressed block *) c_stream.avail_in := len - 3; err := deflate(c_stream, Z_FINISH); if err <> Z_STREAM_END then CHECK_ERR(err, 'deflate'); err := deflateEnd(c_stream); CHECK_ERR(err, 'deflateEnd'); comprLen := c_stream.total_out; end; {$ENDIF} (* =========================================================================== * Test inflateSync() *) {$IFDEF TEST_SYNC} procedure test_sync(compr: Pointer; comprLen: LongInt; uncompr: Pointer; uncomprLen : LongInt); var err: Integer; d_stream: z_stream; (* decompression stream *) begin StrCopy(PChar(uncompr), 'garbage'); d_stream.zalloc := NIL; d_stream.zfree := NIL; d_stream.opaque := NIL; d_stream.next_in := compr; d_stream.avail_in := 2; (* just read the zlib header *) err := inflateInit(d_stream); CHECK_ERR(err, 'inflateInit'); d_stream.next_out := uncompr; d_stream.avail_out := Integer(uncomprLen); inflate(d_stream, Z_NO_FLUSH); CHECK_ERR(err, 'inflate'); d_stream.avail_in := Integer(comprLen-2); (* read all compressed data *) err := inflateSync(d_stream); (* but skip the damaged part *) CHECK_ERR(err, 'inflateSync'); err := inflate(d_stream, Z_FINISH); if err <> Z_DATA_ERROR then EXIT_ERR('inflate should report DATA_ERROR'); (* Because of incorrect adler32 *) err := inflateEnd(d_stream); CHECK_ERR(err, 'inflateEnd'); WriteLn('after inflateSync(): hel', PChar(uncompr)); end; {$ENDIF} (* =========================================================================== * Test deflate with preset dictionary *) {$IFDEF TEST_DICT} procedure test_dict_deflate(compr: Pointer; comprLen: LongInt); var c_stream: z_stream; (* compression stream *) err: Integer; begin c_stream.zalloc := NIL; c_stream.zfree := NIL; c_stream.opaque := NIL; err := deflateInit(c_stream, Z_BEST_COMPRESSION); CHECK_ERR(err, 'deflateInit'); err := deflateSetDictionary(c_stream, dictionary, StrLen(dictionary)); CHECK_ERR(err, 'deflateSetDictionary'); dictId := c_stream.adler; c_stream.next_out := compr; c_stream.avail_out := Integer(comprLen); c_stream.next_in := hello; c_stream.avail_in := StrLen(hello)+1; err := deflate(c_stream, Z_FINISH); if err <> Z_STREAM_END then EXIT_ERR('deflate should report Z_STREAM_END'); err := deflateEnd(c_stream); CHECK_ERR(err, 'deflateEnd'); end; {$ENDIF} (* =========================================================================== * Test inflate with a preset dictionary *) {$IFDEF TEST_DICT} procedure test_dict_inflate(compr: Pointer; comprLen: LongInt; uncompr: Pointer; uncomprLen: LongInt); var err: Integer; d_stream: z_stream; (* decompression stream *) begin StrCopy(PChar(uncompr), 'garbage'); d_stream.zalloc := NIL; d_stream.zfree := NIL; d_stream.opaque := NIL; d_stream.next_in := compr; d_stream.avail_in := Integer(comprLen); err := inflateInit(d_stream); CHECK_ERR(err, 'inflateInit'); d_stream.next_out := uncompr; d_stream.avail_out := Integer(uncomprLen); while TRUE do begin err := inflate(d_stream, Z_NO_FLUSH); if err = Z_STREAM_END then break; if err = Z_NEED_DICT then begin if d_stream.adler <> dictId then EXIT_ERR('unexpected dictionary'); err := inflateSetDictionary(d_stream, dictionary, StrLen(dictionary)); end; CHECK_ERR(err, 'inflate with dict'); end; err := inflateEnd(d_stream); CHECK_ERR(err, 'inflateEnd'); if StrComp(PChar(uncompr), hello) <> 0 then EXIT_ERR('bad inflate with dict') else WriteLn('inflate with dictionary: ', PChar(uncompr)); end; {$ENDIF} var compr, uncompr: Pointer; comprLen, uncomprLen: LongInt; begin if zlibVersion^ <> ZLIB_VERSION[1] then EXIT_ERR('Incompatible zlib version'); WriteLn('zlib version: ', zlibVersion); WriteLn('zlib compile flags: ', Format('0x%x', [zlibCompileFlags])); comprLen := 10000 * SizeOf(Integer); (* don't overflow on MSDOS *) uncomprLen := comprLen; GetMem(compr, comprLen); GetMem(uncompr, uncomprLen); if (compr = NIL) or (uncompr = NIL) then EXIT_ERR('Out of memory'); (* compr and uncompr are cleared to avoid reading uninitialized * data and to ensure that uncompr compresses well. *) FillChar(compr^, comprLen, 0); FillChar(uncompr^, uncomprLen, 0); {$IFDEF TEST_COMPRESS} WriteLn('** Testing compress'); test_compress(compr, comprLen, uncompr, uncomprLen); {$ENDIF} {$IFDEF TEST_GZIO} WriteLn('** Testing gzio'); if ParamCount >= 1 then test_gzio(ParamStr(1), uncompr, uncomprLen) else test_gzio(TESTFILE, uncompr, uncomprLen); {$ENDIF} {$IFDEF TEST_DEFLATE} WriteLn('** Testing deflate with small buffers'); test_deflate(compr, comprLen); {$ENDIF} {$IFDEF TEST_INFLATE} WriteLn('** Testing inflate with small buffers'); test_inflate(compr, comprLen, uncompr, uncomprLen); {$ENDIF} {$IFDEF TEST_DEFLATE} WriteLn('** Testing deflate with large buffers'); test_large_deflate(compr, comprLen, uncompr, uncomprLen); {$ENDIF} {$IFDEF TEST_INFLATE} WriteLn('** Testing inflate with large buffers'); test_large_inflate(compr, comprLen, uncompr, uncomprLen); {$ENDIF} {$IFDEF TEST_FLUSH} WriteLn('** Testing deflate with full flush'); test_flush(compr, comprLen); {$ENDIF} {$IFDEF TEST_SYNC} WriteLn('** Testing inflateSync'); test_sync(compr, comprLen, uncompr, uncomprLen); {$ENDIF} comprLen := uncomprLen; {$IFDEF TEST_DICT} WriteLn('** Testing deflate and inflate with preset dictionary'); test_dict_deflate(compr, comprLen); test_dict_inflate(compr, comprLen, uncompr, uncomprLen); {$ENDIF} FreeMem(compr, comprLen); FreeMem(uncompr, uncomprLen); end. tcl8.6.14/compat/zlib/contrib/pascal/zlibd32.mak0000644000175000017500000000447014554262142020740 0ustar sergeisergei# Makefile for zlib # For use with Delphi and C++ Builder under Win32 # Updated for zlib 1.2.x by Cosmin Truta # ------------ Borland C++ ------------ # This project uses the Delphi (fastcall/register) calling convention: LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl CC = bcc32 LD = bcc32 AR = tlib # do not use "-pr" in CFLAGS CFLAGS = -a -d -k- -O2 $(LOC) LDFLAGS = # variables ZLIB_LIB = zlib.lib OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj # targets all: $(ZLIB_LIB) example.exe minigzip.exe .c.obj: $(CC) -c $(CFLAGS) $*.c adler32.obj: adler32.c zlib.h zconf.h compress.obj: compress.c zlib.h zconf.h crc32.obj: crc32.c zlib.h zconf.h crc32.h deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h gzread.obj: gzread.c zlib.h zconf.h gzguts.h gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h uncompr.obj: uncompr.c zlib.h zconf.h zutil.obj: zutil.c zutil.h zlib.h zconf.h example.obj: test/example.c zlib.h zconf.h minigzip.obj: test/minigzip.c zlib.h zconf.h # For the sake of the old Borland make, # the command line is cut to fit in the MS-DOS 128 byte limit: $(ZLIB_LIB): $(OBJ1) $(OBJ2) -del $(ZLIB_LIB) $(AR) $(ZLIB_LIB) $(OBJP1) $(AR) $(ZLIB_LIB) $(OBJP2) # testing test: example.exe minigzip.exe example echo hello world | minigzip | minigzip -d example.exe: example.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB) minigzip.exe: minigzip.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB) # cleanup clean: -del *.obj -del *.exe -del *.lib -del *.tds -del zlib.bak -del foo.gz tcl8.6.14/compat/zlib/contrib/iostream3/0000755000175000017500000000000014566153412017435 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/iostream3/README0000644000175000017500000000272214554262142020316 0ustar sergeisergeiThese classes provide a C++ stream interface to the zlib library. It allows you to do things like: gzofstream outf("blah.gz"); outf << "These go into the gzip file " << 123 << endl; It does this by deriving a specialized stream buffer for gzipped files, which is the way Stroustrup would have done it. :-> The gzifstream and gzofstream classes were originally written by Kevin Ruland and made available in the zlib contrib/iostream directory. The older version still compiles under gcc 2.xx, but not under gcc 3.xx, which sparked the development of this version. The new classes are as standard-compliant as possible, closely following the approach of the standard library's fstream classes. It compiles under gcc versions 3.2 and 3.3, but not under gcc 2.xx. This is mainly due to changes in the standard library naming scheme. The new version of gzifstream/gzofstream/gzfilebuf differs from the previous one in the following respects: - added showmanyc - added setbuf, with support for unbuffered output via setbuf(0,0) - a few bug fixes of stream behavior - gzipped output file opened with default compression level instead of maximum level - setcompressionlevel()/strategy() members replaced by single setcompression() The code is provided "as is", with the permission to use, copy, modify, distribute and sell it for any purpose without fee. Ludwig Schwardt DSP Lab Electrical & Electronic Engineering Department University of Stellenbosch South Africa tcl8.6.14/compat/zlib/contrib/iostream3/zfstream.cc0000644000175000017500000003220714554262142021601 0ustar sergeisergei/* * A C++ I/O streams interface to the zlib gz* functions * * by Ludwig Schwardt * original version by Kevin Ruland * * This version is standard-compliant and compatible with gcc 3.x. */ #include "zfstream.h" #include // for strcpy, strcat, strlen (mode strings) #include // for BUFSIZ // Internal buffer sizes (default and "unbuffered" versions) #define BIGBUFSIZE BUFSIZ #define SMALLBUFSIZE 1 /*****************************************************************************/ // Default constructor gzfilebuf::gzfilebuf() : file(NULL), io_mode(std::ios_base::openmode(0)), own_fd(false), buffer(NULL), buffer_size(BIGBUFSIZE), own_buffer(true) { // No buffers to start with this->disable_buffer(); } // Destructor gzfilebuf::~gzfilebuf() { // Sync output buffer and close only if responsible for file // (i.e. attached streams should be left open at this stage) this->sync(); if (own_fd) this->close(); // Make sure internal buffer is deallocated this->disable_buffer(); } // Set compression level and strategy int gzfilebuf::setcompression(int comp_level, int comp_strategy) { return gzsetparams(file, comp_level, comp_strategy); } // Open gzipped file gzfilebuf* gzfilebuf::open(const char *name, std::ios_base::openmode mode) { // Fail if file already open if (this->is_open()) return NULL; // Don't support simultaneous read/write access (yet) if ((mode & std::ios_base::in) && (mode & std::ios_base::out)) return NULL; // Build mode string for gzopen and check it [27.8.1.3.2] char char_mode[6] = "\0\0\0\0\0"; if (!this->open_mode(mode, char_mode)) return NULL; // Attempt to open file if ((file = gzopen(name, char_mode)) == NULL) return NULL; // On success, allocate internal buffer and set flags this->enable_buffer(); io_mode = mode; own_fd = true; return this; } // Attach to gzipped file gzfilebuf* gzfilebuf::attach(int fd, std::ios_base::openmode mode) { // Fail if file already open if (this->is_open()) return NULL; // Don't support simultaneous read/write access (yet) if ((mode & std::ios_base::in) && (mode & std::ios_base::out)) return NULL; // Build mode string for gzdopen and check it [27.8.1.3.2] char char_mode[6] = "\0\0\0\0\0"; if (!this->open_mode(mode, char_mode)) return NULL; // Attempt to attach to file if ((file = gzdopen(fd, char_mode)) == NULL) return NULL; // On success, allocate internal buffer and set flags this->enable_buffer(); io_mode = mode; own_fd = false; return this; } // Close gzipped file gzfilebuf* gzfilebuf::close() { // Fail immediately if no file is open if (!this->is_open()) return NULL; // Assume success gzfilebuf* retval = this; // Attempt to sync and close gzipped file if (this->sync() == -1) retval = NULL; if (gzclose(file) < 0) retval = NULL; // File is now gone anyway (postcondition [27.8.1.3.8]) file = NULL; own_fd = false; // Destroy internal buffer if it exists this->disable_buffer(); return retval; } /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ // Convert int open mode to mode string bool gzfilebuf::open_mode(std::ios_base::openmode mode, char* c_mode) const { bool testb = mode & std::ios_base::binary; bool testi = mode & std::ios_base::in; bool testo = mode & std::ios_base::out; bool testt = mode & std::ios_base::trunc; bool testa = mode & std::ios_base::app; // Check for valid flag combinations - see [27.8.1.3.2] (Table 92) // Original zfstream hardcoded the compression level to maximum here... // Double the time for less than 1% size improvement seems // excessive though - keeping it at the default level // To change back, just append "9" to the next three mode strings if (!testi && testo && !testt && !testa) strcpy(c_mode, "w"); if (!testi && testo && !testt && testa) strcpy(c_mode, "a"); if (!testi && testo && testt && !testa) strcpy(c_mode, "w"); if (testi && !testo && !testt && !testa) strcpy(c_mode, "r"); // No read/write mode yet // if (testi && testo && !testt && !testa) // strcpy(c_mode, "r+"); // if (testi && testo && testt && !testa) // strcpy(c_mode, "w+"); // Mode string should be empty for invalid combination of flags if (strlen(c_mode) == 0) return false; if (testb) strcat(c_mode, "b"); return true; } // Determine number of characters in internal get buffer std::streamsize gzfilebuf::showmanyc() { // Calls to underflow will fail if file not opened for reading if (!this->is_open() || !(io_mode & std::ios_base::in)) return -1; // Make sure get area is in use if (this->gptr() && (this->gptr() < this->egptr())) return std::streamsize(this->egptr() - this->gptr()); else return 0; } // Fill get area from gzipped file gzfilebuf::int_type gzfilebuf::underflow() { // If something is left in the get area by chance, return it // (this shouldn't normally happen, as underflow is only supposed // to be called when gptr >= egptr, but it serves as error check) if (this->gptr() && (this->gptr() < this->egptr())) return traits_type::to_int_type(*(this->gptr())); // If the file hasn't been opened for reading, produce error if (!this->is_open() || !(io_mode & std::ios_base::in)) return traits_type::eof(); // Attempt to fill internal buffer from gzipped file // (buffer must be guaranteed to exist...) int bytes_read = gzread(file, buffer, buffer_size); // Indicates error or EOF if (bytes_read <= 0) { // Reset get area this->setg(buffer, buffer, buffer); return traits_type::eof(); } // Make all bytes read from file available as get area this->setg(buffer, buffer, buffer + bytes_read); // Return next character in get area return traits_type::to_int_type(*(this->gptr())); } // Write put area to gzipped file gzfilebuf::int_type gzfilebuf::overflow(int_type c) { // Determine whether put area is in use if (this->pbase()) { // Double-check pointer range if (this->pptr() > this->epptr() || this->pptr() < this->pbase()) return traits_type::eof(); // Add extra character to buffer if not EOF if (!traits_type::eq_int_type(c, traits_type::eof())) { *(this->pptr()) = traits_type::to_char_type(c); this->pbump(1); } // Number of characters to write to file int bytes_to_write = this->pptr() - this->pbase(); // Overflow doesn't fail if nothing is to be written if (bytes_to_write > 0) { // If the file hasn't been opened for writing, produce error if (!this->is_open() || !(io_mode & std::ios_base::out)) return traits_type::eof(); // If gzipped file won't accept all bytes written to it, fail if (gzwrite(file, this->pbase(), bytes_to_write) != bytes_to_write) return traits_type::eof(); // Reset next pointer to point to pbase on success this->pbump(-bytes_to_write); } } // Write extra character to file if not EOF else if (!traits_type::eq_int_type(c, traits_type::eof())) { // If the file hasn't been opened for writing, produce error if (!this->is_open() || !(io_mode & std::ios_base::out)) return traits_type::eof(); // Impromptu char buffer (allows "unbuffered" output) char_type last_char = traits_type::to_char_type(c); // If gzipped file won't accept this character, fail if (gzwrite(file, &last_char, 1) != 1) return traits_type::eof(); } // If you got here, you have succeeded (even if c was EOF) // The return value should therefore be non-EOF if (traits_type::eq_int_type(c, traits_type::eof())) return traits_type::not_eof(c); else return c; } // Assign new buffer std::streambuf* gzfilebuf::setbuf(char_type* p, std::streamsize n) { // First make sure stuff is sync'ed, for safety if (this->sync() == -1) return NULL; // If buffering is turned off on purpose via setbuf(0,0), still allocate one... // "Unbuffered" only really refers to put [27.8.1.4.10], while get needs at // least a buffer of size 1 (very inefficient though, therefore make it bigger?) // This follows from [27.5.2.4.3]/12 (gptr needs to point at something, it seems) if (!p || !n) { // Replace existing buffer (if any) with small internal buffer this->disable_buffer(); buffer = NULL; buffer_size = 0; own_buffer = true; this->enable_buffer(); } else { // Replace existing buffer (if any) with external buffer this->disable_buffer(); buffer = p; buffer_size = n; own_buffer = false; this->enable_buffer(); } return this; } // Write put area to gzipped file (i.e. ensures that put area is empty) int gzfilebuf::sync() { return traits_type::eq_int_type(this->overflow(), traits_type::eof()) ? -1 : 0; } /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ // Allocate internal buffer void gzfilebuf::enable_buffer() { // If internal buffer required, allocate one if (own_buffer && !buffer) { // Check for buffered vs. "unbuffered" if (buffer_size > 0) { // Allocate internal buffer buffer = new char_type[buffer_size]; // Get area starts empty and will be expanded by underflow as need arises this->setg(buffer, buffer, buffer); // Setup entire internal buffer as put area. // The one-past-end pointer actually points to the last element of the buffer, // so that overflow(c) can safely add the extra character c to the sequence. // These pointers remain in place for the duration of the buffer this->setp(buffer, buffer + buffer_size - 1); } else { // Even in "unbuffered" case, (small?) get buffer is still required buffer_size = SMALLBUFSIZE; buffer = new char_type[buffer_size]; this->setg(buffer, buffer, buffer); // "Unbuffered" means no put buffer this->setp(0, 0); } } else { // If buffer already allocated, reset buffer pointers just to make sure no // stale chars are lying around this->setg(buffer, buffer, buffer); this->setp(buffer, buffer + buffer_size - 1); } } // Destroy internal buffer void gzfilebuf::disable_buffer() { // If internal buffer exists, deallocate it if (own_buffer && buffer) { // Preserve unbuffered status by zeroing size if (!this->pbase()) buffer_size = 0; delete[] buffer; buffer = NULL; this->setg(0, 0, 0); this->setp(0, 0); } else { // Reset buffer pointers to initial state if external buffer exists this->setg(buffer, buffer, buffer); if (buffer) this->setp(buffer, buffer + buffer_size - 1); else this->setp(0, 0); } } /*****************************************************************************/ // Default constructor initializes stream buffer gzifstream::gzifstream() : std::istream(NULL), sb() { this->init(&sb); } // Initialize stream buffer and open file gzifstream::gzifstream(const char* name, std::ios_base::openmode mode) : std::istream(NULL), sb() { this->init(&sb); this->open(name, mode); } // Initialize stream buffer and attach to file gzifstream::gzifstream(int fd, std::ios_base::openmode mode) : std::istream(NULL), sb() { this->init(&sb); this->attach(fd, mode); } // Open file and go into fail() state if unsuccessful void gzifstream::open(const char* name, std::ios_base::openmode mode) { if (!sb.open(name, mode | std::ios_base::in)) this->setstate(std::ios_base::failbit); else this->clear(); } // Attach to file and go into fail() state if unsuccessful void gzifstream::attach(int fd, std::ios_base::openmode mode) { if (!sb.attach(fd, mode | std::ios_base::in)) this->setstate(std::ios_base::failbit); else this->clear(); } // Close file void gzifstream::close() { if (!sb.close()) this->setstate(std::ios_base::failbit); } /*****************************************************************************/ // Default constructor initializes stream buffer gzofstream::gzofstream() : std::ostream(NULL), sb() { this->init(&sb); } // Initialize stream buffer and open file gzofstream::gzofstream(const char* name, std::ios_base::openmode mode) : std::ostream(NULL), sb() { this->init(&sb); this->open(name, mode); } // Initialize stream buffer and attach to file gzofstream::gzofstream(int fd, std::ios_base::openmode mode) : std::ostream(NULL), sb() { this->init(&sb); this->attach(fd, mode); } // Open file and go into fail() state if unsuccessful void gzofstream::open(const char* name, std::ios_base::openmode mode) { if (!sb.open(name, mode | std::ios_base::out)) this->setstate(std::ios_base::failbit); else this->clear(); } // Attach to file and go into fail() state if unsuccessful void gzofstream::attach(int fd, std::ios_base::openmode mode) { if (!sb.attach(fd, mode | std::ios_base::out)) this->setstate(std::ios_base::failbit); else this->clear(); } // Close file void gzofstream::close() { if (!sb.close()) this->setstate(std::ios_base::failbit); } tcl8.6.14/compat/zlib/contrib/iostream3/TODO0000644000175000017500000000075314554262142020130 0ustar sergeisergeiPossible upgrades to gzfilebuf: - The ability to do putback (e.g. putbackfail) - The ability to seek (zlib supports this, but could be slow/tricky) - Simultaneous read/write access (does it make sense?) - Support for ios_base::ate open mode - Locale support? - Check public interface to see which calls give problems (due to dependence on library internals) - Override operator<<(ostream&, gzfilebuf*) to allow direct copying of stream buffer to stream ( i.e. os << is.rdbuf(); ) tcl8.6.14/compat/zlib/contrib/iostream3/zfstream.h0000644000175000017500000002772014560736523021455 0ustar sergeisergei/* * A C++ I/O streams interface to the zlib gz* functions * * by Ludwig Schwardt * original version by Kevin Ruland * * This version is standard-compliant and compatible with gcc 3.x. */ #ifndef ZFSTREAM_H #define ZFSTREAM_H #include // not iostream, since we don't need cin/cout #include #include "zlib.h" /*****************************************************************************/ /** * @brief Gzipped file stream buffer class. * * This class implements basic_filebuf for gzipped files. It doesn't yet support * seeking (allowed by zlib but slow/limited), putback and read/write access * (tricky). Otherwise, it attempts to be a drop-in replacement for the standard * file streambuf. */ class gzfilebuf : public std::streambuf { public: // Default constructor. gzfilebuf(); // Destructor. virtual ~gzfilebuf(); /** * @brief Set compression level and strategy on the fly. * @param comp_level Compression level (see zlib.h for allowed values) * @param comp_strategy Compression strategy (see zlib.h for allowed values) * @return Z_OK on success, Z_STREAM_ERROR otherwise. * * Unfortunately, these parameters cannot be modified separately, as the * previous zfstream version assumed. Since the strategy is seldom changed, * it can default and setcompression(level) then becomes like the old * setcompressionlevel(level). */ int setcompression(int comp_level, int comp_strategy = Z_DEFAULT_STRATEGY); /** * @brief Check if file is open. * @return True if file is open. */ bool is_open() const { return (file != NULL); } /** * @brief Open gzipped file. * @param name File name. * @param mode Open mode flags. * @return @c this on success, NULL on failure. */ gzfilebuf* open(const char* name, std::ios_base::openmode mode); /** * @brief Attach to already open gzipped file. * @param fd File descriptor. * @param mode Open mode flags. * @return @c this on success, NULL on failure. */ gzfilebuf* attach(int fd, std::ios_base::openmode mode); /** * @brief Close gzipped file. * @return @c this on success, NULL on failure. */ gzfilebuf* close(); protected: /** * @brief Convert ios open mode int to mode string used by zlib. * @return True if valid mode flag combination. */ bool open_mode(std::ios_base::openmode mode, char* c_mode) const; /** * @brief Number of characters available in stream buffer. * @return Number of characters. * * This indicates number of characters in get area of stream buffer. * These characters can be read without accessing the gzipped file. */ virtual std::streamsize showmanyc(); /** * @brief Fill get area from gzipped file. * @return First character in get area on success, EOF on error. * * This actually reads characters from gzipped file to stream * buffer. Always buffered. */ virtual int_type underflow(); /** * @brief Write put area to gzipped file. * @param c Extra character to add to buffer contents. * @return Non-EOF on success, EOF on error. * * This actually writes characters in stream buffer to * gzipped file. With unbuffered output this is done one * character at a time. */ virtual int_type overflow(int_type c = traits_type::eof()); /** * @brief Installs external stream buffer. * @param p Pointer to char buffer. * @param n Size of external buffer. * @return @c this on success, NULL on failure. * * Call setbuf(0,0) to enable unbuffered output. */ virtual std::streambuf* setbuf(char_type* p, std::streamsize n); /** * @brief Flush stream buffer to file. * @return 0 on success, -1 on error. * * This calls underflow(EOF) to do the job. */ virtual int sync(); // // Some future enhancements // // virtual int_type uflow(); // virtual int_type pbackfail(int_type c = traits_type::eof()); // virtual pos_type // seekoff(off_type off, // std::ios_base::seekdir way, // std::ios_base::openmode mode = std::ios_base::in|std::ios_base::out); // virtual pos_type // seekpos(pos_type sp, // std::ios_base::openmode mode = std::ios_base::in|std::ios_base::out); private: /** * @brief Allocate internal buffer. * * This function is safe to call multiple times. It will ensure * that a proper internal buffer exists if it is required. If the * buffer already exists or is external, the buffer pointers will be * reset to their original state. */ void enable_buffer(); /** * @brief Destroy internal buffer. * * This function is safe to call multiple times. It will ensure * that the internal buffer is deallocated if it exists. In any * case, it will also reset the buffer pointers. */ void disable_buffer(); /** * Underlying file pointer. */ gzFile file; /** * Mode in which file was opened. */ std::ios_base::openmode io_mode; /** * @brief True if this object owns file descriptor. * * This makes the class responsible for closing the file * upon destruction. */ bool own_fd; /** * @brief Stream buffer. * * For simplicity this remains allocated on the free store for the * entire life span of the gzfilebuf object, unless replaced by setbuf. */ char_type* buffer; /** * @brief Stream buffer size. * * Defaults to system default buffer size (typically 8192 bytes). * Modified by setbuf. */ std::streamsize buffer_size; /** * @brief True if this object owns stream buffer. * * This makes the class responsible for deleting the buffer * upon destruction. */ bool own_buffer; }; /*****************************************************************************/ /** * @brief Gzipped file input stream class. * * This class implements ifstream for gzipped files. Seeking and putback * is not supported yet. */ class gzifstream : public std::istream { public: // Default constructor gzifstream(); /** * @brief Construct stream on gzipped file to be opened. * @param name File name. * @param mode Open mode flags (forced to contain ios::in). */ explicit gzifstream(const char* name, std::ios_base::openmode mode = std::ios_base::in); /** * @brief Construct stream on already open gzipped file. * @param fd File descriptor. * @param mode Open mode flags (forced to contain ios::in). */ explicit gzifstream(int fd, std::ios_base::openmode mode = std::ios_base::in); /** * Obtain underlying stream buffer. */ gzfilebuf* rdbuf() const { return const_cast(&sb); } /** * @brief Check if file is open. * @return True if file is open. */ bool is_open() { return sb.is_open(); } /** * @brief Open gzipped file. * @param name File name. * @param mode Open mode flags (forced to contain ios::in). * * Stream will be in state good() if file opens successfully; * otherwise in state fail(). This differs from the behavior of * ifstream, which never sets the state to good() and therefore * won't allow you to reuse the stream for a second file unless * you manually clear() the state. The choice is a matter of * convenience. */ void open(const char* name, std::ios_base::openmode mode = std::ios_base::in); /** * @brief Attach to already open gzipped file. * @param fd File descriptor. * @param mode Open mode flags (forced to contain ios::in). * * Stream will be in state good() if attach succeeded; otherwise * in state fail(). */ void attach(int fd, std::ios_base::openmode mode = std::ios_base::in); /** * @brief Close gzipped file. * * Stream will be in state fail() if close failed. */ void close(); private: /** * Underlying stream buffer. */ gzfilebuf sb; }; /*****************************************************************************/ /** * @brief Gzipped file output stream class. * * This class implements ofstream for gzipped files. Seeking and putback * is not supported yet. */ class gzofstream : public std::ostream { public: // Default constructor gzofstream(); /** * @brief Construct stream on gzipped file to be opened. * @param name File name. * @param mode Open mode flags (forced to contain ios::out). */ explicit gzofstream(const char* name, std::ios_base::openmode mode = std::ios_base::out); /** * @brief Construct stream on already open gzipped file. * @param fd File descriptor. * @param mode Open mode flags (forced to contain ios::out). */ explicit gzofstream(int fd, std::ios_base::openmode mode = std::ios_base::out); /** * Obtain underlying stream buffer. */ gzfilebuf* rdbuf() const { return const_cast(&sb); } /** * @brief Check if file is open. * @return True if file is open. */ bool is_open() { return sb.is_open(); } /** * @brief Open gzipped file. * @param name File name. * @param mode Open mode flags (forced to contain ios::out). * * Stream will be in state good() if file opens successfully; * otherwise in state fail(). This differs from the behavior of * ofstream, which never sets the state to good() and therefore * won't allow you to reuse the stream for a second file unless * you manually clear() the state. The choice is a matter of * convenience. */ void open(const char* name, std::ios_base::openmode mode = std::ios_base::out); /** * @brief Attach to already open gzipped file. * @param fd File descriptor. * @param mode Open mode flags (forced to contain ios::out). * * Stream will be in state good() if attach succeeded; otherwise * in state fail(). */ void attach(int fd, std::ios_base::openmode mode = std::ios_base::out); /** * @brief Close gzipped file. * * Stream will be in state fail() if close failed. */ void close(); private: /** * Underlying stream buffer. */ gzfilebuf sb; }; /*****************************************************************************/ /** * @brief Gzipped file output stream manipulator class. * * This class defines a two-argument manipulator for gzofstream. It is used * as base for the setcompression(int,int) manipulator. */ template class gzomanip2 { public: // Allows inserter to peek at internals template friend gzofstream& operator<<(gzofstream&, const gzomanip2&); // Constructor gzomanip2(gzofstream& (*f)(gzofstream&, T1, T2), T1 v1, T2 v2); private: // Underlying manipulator function gzofstream& (*func)(gzofstream&, T1, T2); // Arguments for manipulator function T1 val1; T2 val2; }; /*****************************************************************************/ // Manipulator function thunks through to stream buffer inline gzofstream& setcompression(gzofstream &gzs, int l, int s = Z_DEFAULT_STRATEGY) { (gzs.rdbuf())->setcompression(l, s); return gzs; } // Manipulator constructor stores arguments template inline gzomanip2::gzomanip2(gzofstream &(*f)(gzofstream &, T1, T2), T1 v1, T2 v2) : func(f), val1(v1), val2(v2) { } // Inserter applies underlying manipulator function to stream template inline gzofstream& operator<<(gzofstream& s, const gzomanip2& m) { return (*m.func)(s, m.val1, m.val2); } // Insert this onto stream to simplify setting of compression level inline gzomanip2 setcompression(int l, int s = Z_DEFAULT_STRATEGY) { return gzomanip2(&setcompression, l, s); } #endif // ZFSTREAM_H tcl8.6.14/compat/zlib/contrib/iostream3/test.cc0000644000175000017500000000272214554262142020724 0ustar sergeisergei/* * Test program for gzifstream and gzofstream * * by Ludwig Schwardt * original version by Kevin Ruland */ #include "zfstream.h" #include // for cout int main() { gzofstream outf; gzifstream inf; char buf[80]; outf.open("test1.txt.gz"); outf << "The quick brown fox sidestepped the lazy canine\n" << 1.3 << "\nPlan " << 9 << std::endl; outf.close(); std::cout << "Wrote the following message to 'test1.txt.gz' (check with zcat or zless):\n" << "The quick brown fox sidestepped the lazy canine\n" << 1.3 << "\nPlan " << 9 << std::endl; std::cout << "\nReading 'test1.txt.gz' (buffered) produces:\n"; inf.open("test1.txt.gz"); while (inf.getline(buf,80,'\n')) { std::cout << buf << "\t(" << inf.rdbuf()->in_avail() << " chars left in buffer)\n"; } inf.close(); outf.rdbuf()->pubsetbuf(0,0); outf.open("test2.txt.gz"); outf << setcompression(Z_NO_COMPRESSION) << "The quick brown fox sidestepped the lazy canine\n" << 1.3 << "\nPlan " << 9 << std::endl; outf.close(); std::cout << "\nWrote the same message to 'test2.txt.gz' in uncompressed form"; std::cout << "\nReading 'test2.txt.gz' (unbuffered) produces:\n"; inf.rdbuf()->pubsetbuf(0,0); inf.open("test2.txt.gz"); while (inf.getline(buf,80,'\n')) { std::cout << buf << "\t(" << inf.rdbuf()->in_avail() << " chars left in buffer)\n"; } inf.close(); return 0; } tcl8.6.14/compat/zlib/contrib/minizip/0000755000175000017500000000000014566153412017206 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/minizip/crypt.h0000644000175000017500000001127014554262142020517 0ustar sergeisergei/* crypt.h -- base code for crypt/uncrypt ZIPfile Version 1.01e, February 12th, 2005 Copyright (C) 1998-2005 Gilles Vollant This code is a modified version of crypting code in Infozip distribution The encryption/decryption parts of this source code (as opposed to the non-echoing password parts) were originally written in Europe. The whole source package can be freely distributed, including from the USA. (Prior to January 2000, re-export from the US was a violation of US law.) This encryption code is a direct transcription of the algorithm from Roger Schlafly, described by Phil Katz in the file appnote.txt. This file (appnote.txt) is distributed with the PKZIP program (even in the version without encryption capabilities). If you don't need crypting in your application, just define symbols NOCRYPT and NOUNCRYPT. This code support the "Traditional PKWARE Encryption". The new AES encryption added on Zip format by Winzip (see the page http://www.winzip.com/aes_info.htm ) and PKWare PKZip 5.x Strong Encryption is not supported. */ #define CRC32(c, b) ((*(pcrc_32_tab+(((int)(c) ^ (b)) & 0xff))) ^ ((c) >> 8)) /*********************************************************************** * Return the next byte in the pseudo-random sequence */ static int decrypt_byte(unsigned long* pkeys, const z_crc_t* pcrc_32_tab) { unsigned temp; /* POTENTIAL BUG: temp*(temp^1) may overflow in an * unpredictable manner on 16-bit systems; not a problem * with any known compiler so far, though */ (void)pcrc_32_tab; temp = ((unsigned)(*(pkeys+2)) & 0xffff) | 2; return (int)(((temp * (temp ^ 1)) >> 8) & 0xff); } /*********************************************************************** * Update the encryption keys with the next byte of plain text */ static int update_keys(unsigned long* pkeys, const z_crc_t* pcrc_32_tab, int c) { (*(pkeys+0)) = CRC32((*(pkeys+0)), c); (*(pkeys+1)) += (*(pkeys+0)) & 0xff; (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; { int keyshift = (int)((*(pkeys+1)) >> 24); (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift); } return c; } /*********************************************************************** * Initialize the encryption keys and the random header according to * the given password. */ static void init_keys(const char* passwd, unsigned long* pkeys, const z_crc_t* pcrc_32_tab) { *(pkeys+0) = 305419896L; *(pkeys+1) = 591751049L; *(pkeys+2) = 878082192L; while (*passwd != '\0') { update_keys(pkeys,pcrc_32_tab,(int)*passwd); passwd++; } } #define zdecode(pkeys,pcrc_32_tab,c) \ (update_keys(pkeys,pcrc_32_tab,c ^= decrypt_byte(pkeys,pcrc_32_tab))) #define zencode(pkeys,pcrc_32_tab,c,t) \ (t=decrypt_byte(pkeys,pcrc_32_tab), update_keys(pkeys,pcrc_32_tab,c), (Byte)t^(c)) #ifdef INCLUDECRYPTINGCODE_IFCRYPTALLOWED #define RAND_HEAD_LEN 12 /* "last resort" source for second part of crypt seed pattern */ # ifndef ZCR_SEED2 # define ZCR_SEED2 3141592654UL /* use PI as default pattern */ # endif static unsigned crypthead(const char* passwd, /* password string */ unsigned char* buf, /* where to write header */ int bufSize, unsigned long* pkeys, const z_crc_t* pcrc_32_tab, unsigned long crcForCrypting) { unsigned n; /* index in random header */ int t; /* temporary */ int c; /* random byte */ unsigned char header[RAND_HEAD_LEN-2]; /* random header */ static unsigned calls = 0; /* ensure different random header each time */ if (bufSize> 7) & 0xff; header[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, c, t); } /* Encrypt random header (last two bytes is high word of crc) */ init_keys(passwd, pkeys, pcrc_32_tab); for (n = 0; n < RAND_HEAD_LEN-2; n++) { buf[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, header[n], t); } buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 16) & 0xff, t); buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 24) & 0xff, t); return n; } #endif tcl8.6.14/compat/zlib/contrib/minizip/MiniZip64_Changes.txt0000644000175000017500000000015414554262142023126 0ustar sergeisergei MiniZip 1.1 was derived from MiniZip at version 1.01f Change in 1.0 (Okt 2009) - **TODO - Add history** tcl8.6.14/compat/zlib/contrib/minizip/Makefile.am0000644000175000017500000000146214554262142021243 0ustar sergeisergeilib_LTLIBRARIES = libminizip.la if COND_DEMOS bin_PROGRAMS = miniunzip minizip endif zlib_top_srcdir = $(top_srcdir)/../.. zlib_top_builddir = $(top_builddir)/../.. AM_CPPFLAGS = -I$(zlib_top_srcdir) AM_LDFLAGS = -L$(zlib_top_builddir) if WIN32 iowin32_src = iowin32.c iowin32_h = iowin32.h endif libminizip_la_SOURCES = \ ioapi.c \ mztools.c \ unzip.c \ zip.c \ ${iowin32_src} libminizip_la_LDFLAGS = $(AM_LDFLAGS) -version-info 1:0:0 -lz minizip_includedir = $(includedir)/minizip minizip_include_HEADERS = \ crypt.h \ ioapi.h \ mztools.h \ unzip.h \ zip.h \ ${iowin32_h} pkgconfigdir = $(libdir)/pkgconfig pkgconfig_DATA = minizip.pc EXTRA_PROGRAMS = miniunzip minizip miniunzip_SOURCES = miniunz.c miniunzip_LDADD = libminizip.la minizip_SOURCES = minizip.c minizip_LDADD = libminizip.la -lz tcl8.6.14/compat/zlib/contrib/minizip/zip.h0000644000175000017500000003623514560736523020176 0ustar sergeisergei/* zip.h -- IO on .zip files using zlib Version 1.1, February 14h, 2010 part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications for Zip64 support Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) For more info read MiniZip_info.txt --------------------------------------------------------------------------- Condition of use and distribution are the same than zlib : This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. --------------------------------------------------------------------------- Changes See header of zip.h */ #ifndef _zip12_H #define _zip12_H #ifdef __cplusplus extern "C" { #endif //#define HAVE_BZIP2 #ifndef _ZLIB_H #include "zlib.h" #endif #ifndef _ZLIBIOAPI_H #include "ioapi.h" #endif #ifdef HAVE_BZIP2 #include "bzlib.h" #endif #define Z_BZIP2ED 12 #if defined(STRICTZIP) || defined(STRICTZIPUNZIP) /* like the STRICT of WIN32, we define a pointer that cannot be converted from (void*) without cast */ typedef struct TagzipFile__ { int unused; } zipFile__; typedef zipFile__ *zipFile; #else typedef voidp zipFile; #endif #define ZIP_OK (0) #define ZIP_EOF (0) #define ZIP_ERRNO (Z_ERRNO) #define ZIP_PARAMERROR (-102) #define ZIP_BADZIPFILE (-103) #define ZIP_INTERNALERROR (-104) #ifndef DEF_MEM_LEVEL # if MAX_MEM_LEVEL >= 8 # define DEF_MEM_LEVEL 8 # else # define DEF_MEM_LEVEL MAX_MEM_LEVEL # endif #endif /* default memLevel */ /* tm_zip contain date/time info */ typedef struct tm_zip_s { int tm_sec; /* seconds after the minute - [0,59] */ int tm_min; /* minutes after the hour - [0,59] */ int tm_hour; /* hours since midnight - [0,23] */ int tm_mday; /* day of the month - [1,31] */ int tm_mon; /* months since January - [0,11] */ int tm_year; /* years - [1980..2044] */ } tm_zip; typedef struct { tm_zip tmz_date; /* date in understandable format */ uLong dosDate; /* if dos_date == 0, tmu_date is used */ /* uLong flag; */ /* general purpose bit flag 2 bytes */ uLong internal_fa; /* internal file attributes 2 bytes */ uLong external_fa; /* external file attributes 4 bytes */ } zip_fileinfo; typedef const char* zipcharpc; #define APPEND_STATUS_CREATE (0) #define APPEND_STATUS_CREATEAFTER (1) #define APPEND_STATUS_ADDINZIP (2) extern zipFile ZEXPORT zipOpen(const char *pathname, int append); extern zipFile ZEXPORT zipOpen64(const void *pathname, int append); /* Create a zipfile. pathname contain on Windows XP a filename like "c:\\zlib\\zlib113.zip" or on an Unix computer "zlib/zlib113.zip". if the file pathname exist and append==APPEND_STATUS_CREATEAFTER, the zip will be created at the end of the file. (useful if the file contain a self extractor code) if the file pathname exist and append==APPEND_STATUS_ADDINZIP, we will add files in existing zip (be sure you don't add file that doesn't exist) If the zipfile cannot be opened, the return value is NULL. Else, the return value is a zipFile Handle, usable with other function of this zip package. */ /* Note : there is no delete function into a zipfile. If you want delete file into a zipfile, you must open a zipfile, and create another Of course, you can use RAW reading and writing to copy the file you did not want delete */ extern zipFile ZEXPORT zipOpen2(const char *pathname, int append, zipcharpc* globalcomment, zlib_filefunc_def* pzlib_filefunc_def); extern zipFile ZEXPORT zipOpen2_64(const void *pathname, int append, zipcharpc* globalcomment, zlib_filefunc64_def* pzlib_filefunc_def); extern zipFile ZEXPORT zipOpen3(const void *pathname, int append, zipcharpc* globalcomment, zlib_filefunc64_32_def* pzlib_filefunc64_32_def); extern int ZEXPORT zipOpenNewFileInZip(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level); extern int ZEXPORT zipOpenNewFileInZip64(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int zip64); /* Open a file in the ZIP for writing. filename : the filename in zip (if NULL, '-' without quote will be used *zipfi contain supplemental information if extrafield_local!=NULL and size_extrafield_local>0, extrafield_local contains the extrafield data for the local header if extrafield_global!=NULL and size_extrafield_global>0, extrafield_global contains the extrafield data for the global header if comment != NULL, comment contain the comment string method contain the compression method (0 for store, Z_DEFLATED for deflate) level contain the level of compression (can be Z_DEFAULT_COMPRESSION) zip64 is set to 1 if a zip64 extended information block should be added to the local file header. this MUST be '1' if the uncompressed size is >= 0xffffffff. */ extern int ZEXPORT zipOpenNewFileInZip2(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw); extern int ZEXPORT zipOpenNewFileInZip2_64(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int zip64); /* Same than zipOpenNewFileInZip, except if raw=1, we write raw file */ extern int ZEXPORT zipOpenNewFileInZip3(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int windowBits, int memLevel, int strategy, const char* password, uLong crcForCrypting); extern int ZEXPORT zipOpenNewFileInZip3_64(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int windowBits, int memLevel, int strategy, const char* password, uLong crcForCrypting, int zip64); /* Same than zipOpenNewFileInZip2, except windowBits,memLevel,,strategy : see parameter strategy in deflateInit2 password : crypting password (NULL for no crypting) crcForCrypting : crc of file to compress (needed for crypting) */ extern int ZEXPORT zipOpenNewFileInZip4(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int windowBits, int memLevel, int strategy, const char* password, uLong crcForCrypting, uLong versionMadeBy, uLong flagBase); extern int ZEXPORT zipOpenNewFileInZip4_64(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int windowBits, int memLevel, int strategy, const char* password, uLong crcForCrypting, uLong versionMadeBy, uLong flagBase, int zip64); /* Same than zipOpenNewFileInZip4, except versionMadeBy : value for Version made by field flag : value for flag field (compression level info will be added) */ extern int ZEXPORT zipWriteInFileInZip(zipFile file, const void* buf, unsigned len); /* Write data in the zipfile */ extern int ZEXPORT zipCloseFileInZip(zipFile file); /* Close the current file in the zipfile */ extern int ZEXPORT zipCloseFileInZipRaw(zipFile file, uLong uncompressed_size, uLong crc32); extern int ZEXPORT zipCloseFileInZipRaw64(zipFile file, ZPOS64_T uncompressed_size, uLong crc32); /* Close the current file in the zipfile, for file opened with parameter raw=1 in zipOpenNewFileInZip2 uncompressed_size and crc32 are value for the uncompressed size */ extern int ZEXPORT zipClose(zipFile file, const char* global_comment); /* Close the zipfile */ extern int ZEXPORT zipRemoveExtraInfoBlock(char* pData, int* dataLen, short sHeader); /* zipRemoveExtraInfoBlock - Added by Mathias Svensson Remove extra information block from a extra information data for the local file header or central directory header It is needed to remove ZIP64 extra information blocks when before data is written if using RAW mode. 0x0001 is the signature header for the ZIP64 extra information blocks usage. Remove ZIP64 Extra information from a central director extra field data zipRemoveExtraInfoBlock(pCenDirExtraFieldData, &nCenDirExtraFieldDataLen, 0x0001); Remove ZIP64 Extra information from a Local File Header extra field data zipRemoveExtraInfoBlock(pLocalHeaderExtraFieldData, &nLocalHeaderExtraFieldDataLen, 0x0001); */ #ifdef __cplusplus } #endif #endif /* _zip64_H */ tcl8.6.14/compat/zlib/contrib/minizip/make_vms.com0000644000175000017500000000160514554262142021510 0ustar sergeisergei$ if f$search("ioapi.h_orig") .eqs. "" then copy ioapi.h ioapi.h_orig $ open/write zdef vmsdefs.h $ copy sys$input: zdef $ deck #define unix #define fill_zlib_filefunc64_32_def_from_filefunc32 fillzffunc64from #define Write_Zip64EndOfCentralDirectoryLocator Write_Zip64EoDLocator #define Write_Zip64EndOfCentralDirectoryRecord Write_Zip64EoDRecord #define Write_EndOfCentralDirectoryRecord Write_EoDRecord $ eod $ close zdef $ copy vmsdefs.h,ioapi.h_orig ioapi.h $ cc/include=[--]/prefix=all ioapi.c $ cc/include=[--]/prefix=all miniunz.c $ cc/include=[--]/prefix=all unzip.c $ cc/include=[--]/prefix=all minizip.c $ cc/include=[--]/prefix=all zip.c $ link miniunz,unzip,ioapi,[--]libz.olb/lib $ link minizip,zip,ioapi,[--]libz.olb/lib $ mcr []minizip test minizip_info.txt $ mcr []miniunz -l test.zip $ rename minizip_info.txt; minizip_info.txt_old $ mcr []miniunz test.zip $ delete test.zip;* $exit tcl8.6.14/compat/zlib/contrib/minizip/ioapi.h0000644000175000017500000001567414560736523020501 0ustar sergeisergei/* ioapi.h -- IO base function header for compress/uncompress .zip part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications for Zip64 support Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) For more info read MiniZip_info.txt Changes Oct-2009 - Defined ZPOS64_T to fpos_t on windows and u_int64_t on linux. (might need to find a better why for this) Oct-2009 - Change to fseeko64, ftello64 and fopen64 so large files would work on linux. More if/def section may be needed to support other platforms Oct-2009 - Defined fxxxx64 calls to normal fopen/ftell/fseek so they would compile on windows. (but you should use iowin32.c for windows instead) */ #ifndef _ZLIBIOAPI64_H #define _ZLIBIOAPI64_H #if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__)) // Linux needs this to support file operation on files larger then 4+GB // But might need better if/def to select just the platforms that needs them. #ifndef __USE_FILE_OFFSET64 #define __USE_FILE_OFFSET64 #endif #ifndef __USE_LARGEFILE64 #define __USE_LARGEFILE64 #endif #ifndef _LARGEFILE64_SOURCE #define _LARGEFILE64_SOURCE #endif #ifndef _FILE_OFFSET_BIT #define _FILE_OFFSET_BIT 64 #endif #endif #include #include #include "zlib.h" #if defined(USE_FILE32API) #define fopen64 fopen #define ftello64 ftell #define fseeko64 fseek #else #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__HAIKU__) || defined(MINIZIP_FOPEN_NO_64) #define fopen64 fopen #define ftello64 ftello #define fseeko64 fseeko #endif #ifdef _MSC_VER #define fopen64 fopen #if (_MSC_VER >= 1400) && (!(defined(NO_MSCVER_FILE64_FUNC))) #define ftello64 _ftelli64 #define fseeko64 _fseeki64 #else // old MSC #define ftello64 ftell #define fseeko64 fseek #endif #endif #endif /* #ifndef ZPOS64_T #ifdef _WIN32 #define ZPOS64_T fpos_t #else #include #define ZPOS64_T uint64_t #endif #endif */ #ifdef HAVE_MINIZIP64_CONF_H #include "mz64conf.h" #endif /* a type chosen by DEFINE */ #ifdef HAVE_64BIT_INT_CUSTOM typedef 64BIT_INT_CUSTOM_TYPE ZPOS64_T; #else #ifdef HAS_STDINT_H #include "stdint.h" typedef uint64_t ZPOS64_T; #else #if defined(_MSC_VER) || defined(__BORLANDC__) typedef unsigned __int64 ZPOS64_T; #else typedef unsigned long long int ZPOS64_T; #endif #endif #endif /* Maximum unsigned 32-bit value used as placeholder for zip64 */ #ifndef MAXU32 #define MAXU32 (0xffffffff) #endif #ifdef __cplusplus extern "C" { #endif #define ZLIB_FILEFUNC_SEEK_CUR (1) #define ZLIB_FILEFUNC_SEEK_END (2) #define ZLIB_FILEFUNC_SEEK_SET (0) #define ZLIB_FILEFUNC_MODE_READ (1) #define ZLIB_FILEFUNC_MODE_WRITE (2) #define ZLIB_FILEFUNC_MODE_READWRITEFILTER (3) #define ZLIB_FILEFUNC_MODE_EXISTING (4) #define ZLIB_FILEFUNC_MODE_CREATE (8) #ifndef ZCALLBACK #if (defined(WIN32) || defined(_WIN32) || defined (WINDOWS) || defined (_WINDOWS)) && defined(CALLBACK) && defined (USEWINDOWS_CALLBACK) #define ZCALLBACK CALLBACK #else #define ZCALLBACK #endif #endif typedef voidpf (ZCALLBACK *open_file_func) (voidpf opaque, const char* filename, int mode); typedef uLong (ZCALLBACK *read_file_func) (voidpf opaque, voidpf stream, void* buf, uLong size); typedef uLong (ZCALLBACK *write_file_func) (voidpf opaque, voidpf stream, const void* buf, uLong size); typedef int (ZCALLBACK *close_file_func) (voidpf opaque, voidpf stream); typedef int (ZCALLBACK *testerror_file_func) (voidpf opaque, voidpf stream); typedef long (ZCALLBACK *tell_file_func) (voidpf opaque, voidpf stream); typedef long (ZCALLBACK *seek_file_func) (voidpf opaque, voidpf stream, uLong offset, int origin); /* here is the "old" 32 bits structure */ typedef struct zlib_filefunc_def_s { open_file_func zopen_file; read_file_func zread_file; write_file_func zwrite_file; tell_file_func ztell_file; seek_file_func zseek_file; close_file_func zclose_file; testerror_file_func zerror_file; voidpf opaque; } zlib_filefunc_def; typedef ZPOS64_T (ZCALLBACK *tell64_file_func) (voidpf opaque, voidpf stream); typedef long (ZCALLBACK *seek64_file_func) (voidpf opaque, voidpf stream, ZPOS64_T offset, int origin); typedef voidpf (ZCALLBACK *open64_file_func) (voidpf opaque, const void* filename, int mode); typedef struct zlib_filefunc64_def_s { open64_file_func zopen64_file; read_file_func zread_file; write_file_func zwrite_file; tell64_file_func ztell64_file; seek64_file_func zseek64_file; close_file_func zclose_file; testerror_file_func zerror_file; voidpf opaque; } zlib_filefunc64_def; void fill_fopen64_filefunc(zlib_filefunc64_def* pzlib_filefunc_def); void fill_fopen_filefunc(zlib_filefunc_def* pzlib_filefunc_def); /* now internal definition, only for zip.c and unzip.h */ typedef struct zlib_filefunc64_32_def_s { zlib_filefunc64_def zfile_func64; open_file_func zopen32_file; tell_file_func ztell32_file; seek_file_func zseek32_file; } zlib_filefunc64_32_def; #define ZREAD64(filefunc,filestream,buf,size) ((*((filefunc).zfile_func64.zread_file)) ((filefunc).zfile_func64.opaque,filestream,buf,size)) #define ZWRITE64(filefunc,filestream,buf,size) ((*((filefunc).zfile_func64.zwrite_file)) ((filefunc).zfile_func64.opaque,filestream,buf,size)) //#define ZTELL64(filefunc,filestream) ((*((filefunc).ztell64_file)) ((filefunc).opaque,filestream)) //#define ZSEEK64(filefunc,filestream,pos,mode) ((*((filefunc).zseek64_file)) ((filefunc).opaque,filestream,pos,mode)) #define ZCLOSE64(filefunc,filestream) ((*((filefunc).zfile_func64.zclose_file)) ((filefunc).zfile_func64.opaque,filestream)) #define ZERROR64(filefunc,filestream) ((*((filefunc).zfile_func64.zerror_file)) ((filefunc).zfile_func64.opaque,filestream)) voidpf call_zopen64(const zlib_filefunc64_32_def* pfilefunc,const void*filename,int mode); long call_zseek64(const zlib_filefunc64_32_def* pfilefunc,voidpf filestream, ZPOS64_T offset, int origin); ZPOS64_T call_ztell64(const zlib_filefunc64_32_def* pfilefunc,voidpf filestream); void fill_zlib_filefunc64_32_def_from_filefunc32(zlib_filefunc64_32_def* p_filefunc64_32,const zlib_filefunc_def* p_filefunc32); #define ZOPEN64(filefunc,filename,mode) (call_zopen64((&(filefunc)),(filename),(mode))) #define ZTELL64(filefunc,filestream) (call_ztell64((&(filefunc)),(filestream))) #define ZSEEK64(filefunc,filestream,pos,mode) (call_zseek64((&(filefunc)),(filestream),(pos),(mode))) #ifdef __cplusplus } #endif #endif tcl8.6.14/compat/zlib/contrib/minizip/Makefile0000644000175000017500000000106314560736523020652 0ustar sergeisergeiCC?=cc CFLAGS := $(CFLAGS) -O -I../.. UNZ_OBJS = miniunz.o unzip.o ioapi.o ../../libz.a ZIP_OBJS = minizip.o zip.o ioapi.o ../../libz.a .c.o: $(CC) -c $(CFLAGS) $*.c all: miniunz minizip miniunz: $(UNZ_OBJS) $(CC) $(CFLAGS) -o $@ $(UNZ_OBJS) minizip: $(ZIP_OBJS) $(CC) $(CFLAGS) -o $@ $(ZIP_OBJS) test: miniunz minizip @rm -f test.* @echo hello hello hello > test.txt ./minizip test test.txt ./miniunz -l test.zip @mv test.txt test.old ./miniunz test.zip @cmp test.txt test.old @rm -f test.* clean: /bin/rm -f *.o *~ minizip miniunz test.* tcl8.6.14/compat/zlib/contrib/minizip/minizip.c0000644000175000017500000003645414554262142021043 0ustar sergeisergei/* minizip.c Version 1.1, February 14h, 2010 sample part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications of Unzip for Zip64 Copyright (C) 2007-2008 Even Rouault Modifications for Zip64 support on both zip and unzip Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) */ #if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__)) #ifndef __USE_FILE_OFFSET64 #define __USE_FILE_OFFSET64 #endif #ifndef __USE_LARGEFILE64 #define __USE_LARGEFILE64 #endif #ifndef _LARGEFILE64_SOURCE #define _LARGEFILE64_SOURCE #endif #ifndef _FILE_OFFSET_BIT #define _FILE_OFFSET_BIT 64 #endif #endif #if defined(_WIN32) #define FOPEN_FUNC(filename, mode) fopen(filename, mode) #define FTELLO_FUNC(stream) _ftelli64(stream) #define FSEEKO_FUNC(stream, offset, origin) _fseeki64(stream, offset, origin) #elif defined(__APPLE__) || defined(IOAPI_NO_64) // In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions #define FOPEN_FUNC(filename, mode) fopen(filename, mode) #define FTELLO_FUNC(stream) ftello(stream) #define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin) #else #define FOPEN_FUNC(filename, mode) fopen64(filename, mode) #define FTELLO_FUNC(stream) ftello64(stream) #define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin) #endif #include "tinydir.h" #include #include #include #include #include #include #ifdef _WIN32 # include # include #else # include # include # include # include #endif #include "zip.h" #ifdef _WIN32 #define USEWIN32IOAPI #include "iowin32.h" # if defined(_MSC_VER) # define snprintf _snprintf # endif #endif #define WRITEBUFFERSIZE (16384) #define MAXFILENAME (256) #ifdef _WIN32 /* f: name of file to get info on, tmzip: return value: access, modification and creation times, dt: dostime */ static int filetime(const char *f, tm_zip *tmzip, uLong *dt) { int ret = 0; { FILETIME ftLocal; HANDLE hFind; WIN32_FIND_DATAA ff32; hFind = FindFirstFileA(f,&ff32); if (hFind != INVALID_HANDLE_VALUE) { FileTimeToLocalFileTime(&(ff32.ftLastWriteTime),&ftLocal); FileTimeToDosDateTime(&ftLocal,((LPWORD)dt)+1,((LPWORD)dt)+0); FindClose(hFind); ret = 1; } } return ret; } #else #if defined(unix) || defined(__APPLE__) /* f: name of file to get info on, tmzip: return value: access, modification and creation times, dt: dostime */ static int filetime(const char *f, tm_zip *tmzip, uLong *dt) { (void)dt; int ret=0; struct stat s; /* results of stat() */ struct tm* filedate; time_t tm_t=0; if (strcmp(f,"-")!=0) { char name[MAXFILENAME+1]; size_t len = strlen(f); if (len > MAXFILENAME) len = MAXFILENAME; strncpy(name, f,MAXFILENAME-1); /* strncpy doesn't append the trailing NULL, of the string is too long. */ name[ MAXFILENAME ] = '\0'; if (name[len - 1] == '/') name[len - 1] = '\0'; /* not all systems allow stat'ing a file with / appended */ if (stat(name,&s)==0) { tm_t = s.st_mtime; ret = 1; } } filedate = localtime(&tm_t); tmzip->tm_sec = filedate->tm_sec; tmzip->tm_min = filedate->tm_min; tmzip->tm_hour = filedate->tm_hour; tmzip->tm_mday = filedate->tm_mday; tmzip->tm_mon = filedate->tm_mon ; tmzip->tm_year = filedate->tm_year; return ret; } #else /* f: name of file to get info on, tmzip: return value: access, modification and creation times, dt: dostime */ static int filetime(const char *f, tm_zip *tmzip, uLong *dt) { (void)f; (void)tmzip; (void)dt; return 0; } #endif #endif static int check_exist_file(const char* filename) { FILE* ftestexist; int ret = 1; ftestexist = FOPEN_FUNC(filename,"rb"); if (ftestexist==NULL) ret = 0; else fclose(ftestexist); return ret; } static void do_banner(void) { printf("MiniZip 1.1, demo of zLib + MiniZip64 package, written by Gilles Vollant\n"); printf("more info on MiniZip at http://www.winimage.com/zLibDll/minizip.html\n\n"); } static void do_help(void) { printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \ " -r Scan directories recursively\n" \ " -o Overwrite existing file.zip\n" \ " -a Append to existing file.zip\n" \ " -0 Store only\n" \ " -1 Compress faster\n" \ " -9 Compress better\n\n" \ " -j exclude path. store only the file name.\n\n"); } /* calculate the CRC32 of a file, because to encrypt a file, we need known the CRC32 of the file before */ static int getFileCrc(const char* filenameinzip, void* buf, unsigned long size_buf, unsigned long* result_crc) { unsigned long calculate_crc=0; int err=ZIP_OK; FILE * fin = FOPEN_FUNC(filenameinzip,"rb"); unsigned long size_read = 0; /* unsigned long total_read = 0; */ if (fin==NULL) { err = ZIP_ERRNO; } if (err == ZIP_OK) do { err = ZIP_OK; size_read = fread(buf,1,size_buf,fin); if (size_read < size_buf) if (feof(fin)==0) { printf("error in reading %s\n",filenameinzip); err = ZIP_ERRNO; } if (size_read>0) calculate_crc = crc32_z(calculate_crc,buf,size_read); /* total_read += size_read; */ } while ((err == ZIP_OK) && (size_read>0)); if (fin) fclose(fin); *result_crc=calculate_crc; printf("file %s crc %lx\n", filenameinzip, calculate_crc); return err; } static int isLargeFile(const char* filename) { int largeFile = 0; ZPOS64_T pos = 0; FILE* pFile = FOPEN_FUNC(filename, "rb"); if(pFile != NULL) { FSEEKO_FUNC(pFile, 0, SEEK_END); pos = (ZPOS64_T)FTELLO_FUNC(pFile); printf("File : %s is %llu bytes\n", filename, pos); if(pos >= 0xffffffff) largeFile = 1; fclose(pFile); } return largeFile; } void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) { FILE * fin; int size_read; const char *savefilenameinzip; zip_fileinfo zi; unsigned long crcFile=0; int zip64 = 0; int err=0; int size_buf=WRITEBUFFERSIZE; unsigned char buf[WRITEBUFFERSIZE]; zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour = zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0; zi.dosDate = 0; zi.internal_fa = 0; zi.external_fa = 0; filetime(filenameinzip,&zi.tmz_date,&zi.dosDate); /* err = zipOpenNewFileInZip(zf,filenameinzip,&zi, NULL,0,NULL,0,NULL / * comment * /, (opt_compress_level != 0) ? Z_DEFLATED : 0, opt_compress_level); */ if ((password != NULL) && (err==ZIP_OK)) err = getFileCrc(filenameinzip,buf,size_buf,&crcFile); zip64 = isLargeFile(filenameinzip); /* The path name saved, should not include a leading slash. */ /*if it did, windows/xp and dynazip couldn't read the zip file. */ savefilenameinzip = filenameinzip; while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' ) { savefilenameinzip++; } /*should the zip file contain any path at all?*/ if( opt_exclude_path ) { const char *tmpptr; const char *lastslash = 0; for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++) { if( *tmpptr == '\\' || *tmpptr == '/') { lastslash = tmpptr; } } if( lastslash != NULL ) { savefilenameinzip = lastslash+1; // base filename follows last slash. } } /**/ err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi, NULL,0,NULL,0,NULL /* comment*/, (opt_compress_level != 0) ? Z_DEFLATED : 0, opt_compress_level,0, /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */ -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, password,crcFile, zip64); if (err != ZIP_OK) printf("error in opening %s in zipfile\n",filenameinzip); else { fin = FOPEN_FUNC(filenameinzip,"rb"); if (fin==NULL) { err=ZIP_ERRNO; printf("error in opening %s for reading\n",filenameinzip); } } if (err == ZIP_OK) do { err = ZIP_OK; size_read = (int)fread(buf,1,size_buf,fin); if (size_read < size_buf) if (feof(fin)==0) { printf("error in reading %s\n",filenameinzip); err = ZIP_ERRNO; } if (size_read>0) { err = zipWriteInFileInZip (zf,buf,size_read); if (err<0) { printf("error in writing %s in the zipfile\n", filenameinzip); } } } while ((err == ZIP_OK) && (size_read>0)); if (fin) fclose(fin); if (err<0) err=ZIP_ERRNO; else { err = zipCloseFileInZip(zf); if (err!=ZIP_OK) printf("error in closing %s in the zipfile\n", filenameinzip); } } void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) { tinydir_dir dir; int i; char newname[MAXFILENAME+1+MAXFILENAME+1]; tinydir_open_sorted(&dir, filenameinzip); for (i = 0; i < dir.n_files; i++) { tinydir_file file; tinydir_readfile_n(&dir, &file, i); if(strcmp(file.name,".")==0) continue; if(strcmp(file.name,"..")==0) continue; snprintf(newname, sizeof(newname), "%.*s/%.*s", MAXFILENAME, dir.path, MAXFILENAME, file.name); if (file.is_dir) { addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level); } else { addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level); } } tinydir_close(&dir); } int main(int argc, char *argv[]) { int i; int opt_recursive=0; int opt_overwrite=0; int opt_compress_level=Z_DEFAULT_COMPRESSION; int opt_exclude_path=0; int zipfilenamearg = 0; char filename_try[MAXFILENAME+16]; int zipok; int err=0; size_t size_buf=0; void* buf=NULL; const char* password=NULL; do_banner(); if (argc==1) { do_help(); return 0; } else { for (i=1;i='0') && (c<='9')) opt_compress_level = c-'0'; if ((c=='j') || (c=='J')) opt_exclude_path = 1; if ((c=='r') || (c=='R')) opt_recursive = 1; if (((c=='p') || (c=='P')) && (i+1='a') && (rep<='z')) rep -= 0x20; } while ((rep!='Y') && (rep!='N') && (rep!='A')); if (rep=='N') zipok = 0; if (rep=='A') opt_overwrite = 2; } } if (zipok==1) { zipFile zf; int errclose; # ifdef USEWIN32IOAPI zlib_filefunc64_def ffunc; fill_win32_filefunc64A(&ffunc); zf = zipOpen2_64(filename_try,(opt_overwrite==2) ? 2 : 0,NULL,&ffunc); # else zf = zipOpen64(filename_try,(opt_overwrite==2) ? 2 : 0); # endif if (zf == NULL) { printf("error opening %s\n",filename_try); err= ZIP_ERRNO; } else printf("creating %s\n",filename_try); for (i=zipfilenamearg+1;(i='0') || (argv[i][1]<='9'))) && (strlen(argv[i]) == 2))) { if(opt_recursive) { addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level); } else { addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level); } } } errclose = zipClose(zf,NULL); if (errclose != ZIP_OK) printf("error in closing %s\n",filename_try); } else { do_help(); } free(buf); return 0; } tcl8.6.14/compat/zlib/contrib/minizip/unzip.c0000644000175000017500000020407014560736523020526 0ustar sergeisergei/* unzip.c -- IO for uncompress .zip files using zlib Version 1.1, February 14h, 2010 part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications of Unzip for Zip64 Copyright (C) 2007-2008 Even Rouault Modifications for Zip64 support on both zip and unzip Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) For more info read MiniZip_info.txt ------------------------------------------------------------------------------------ Decryption code comes from crypt.c by Info-ZIP but has been greatly reduced in terms of compatibility with older software. The following is from the original crypt.c. Code woven in by Terry Thorsen 1/2003. Copyright (c) 1990-2000 Info-ZIP. All rights reserved. See the accompanying file LICENSE, version 2000-Apr-09 or later (the contents of which are also included in zip.h) for terms of use. If, for some reason, all these files are missing, the Info-ZIP license also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html crypt.c (full version) by Info-ZIP. Last revised: [see crypt.h] The encryption/decryption parts of this source code (as opposed to the non-echoing password parts) were originally written in Europe. The whole source package can be freely distributed, including from the USA. (Prior to January 2000, re-export from the US was a violation of US law.) This encryption code is a direct transcription of the algorithm from Roger Schlafly, described by Phil Katz in the file appnote.txt. This file (appnote.txt) is distributed with the PKZIP program (even in the version without encryption capabilities). ------------------------------------------------------------------------------------ Changes in unzip.c 2007-2008 - Even Rouault - Addition of cpl_unzGetCurrentFileZStreamPos 2007-2008 - Even Rouault - Decoration of symbol names unz* -> cpl_unz* 2007-2008 - Even Rouault - Remove old C style function prototypes 2007-2008 - Even Rouault - Add unzip support for ZIP64 Copyright (C) 2007-2008 Even Rouault Oct-2009 - Mathias Svensson - Removed cpl_* from symbol names (Even Rouault added them but since this is now moved to a new project (minizip64) I renamed them again). Oct-2009 - Mathias Svensson - Fixed problem if uncompressed size was > 4G and compressed size was <4G should only read the compressed/uncompressed size from the Zip64 format if the size from normal header was 0xFFFFFFFF Oct-2009 - Mathias Svensson - Applied some bug fixes from patches received from Gilles Vollant Oct-2009 - Mathias Svensson - Applied support to unzip files with compression method BZIP2 (bzip2 lib is required) Patch created by Daniel Borca Jan-2010 - back to unzip and minizip 1.0 name scheme, with compatibility layer Copyright (C) 1998 - 2010 Gilles Vollant, Even Rouault, Mathias Svensson */ #include #include #include #ifndef NOUNCRYPT #define NOUNCRYPT #endif #include "zlib.h" #include "unzip.h" #ifdef STDC # include #endif #ifdef NO_ERRNO_H extern int errno; #else # include #endif #ifndef local # define local static #endif /* compile with -Dlocal if your debugger can't find static symbols */ #ifndef CASESENSITIVITYDEFAULT_NO # if !defined(unix) && !defined(CASESENSITIVITYDEFAULT_YES) # define CASESENSITIVITYDEFAULT_NO # endif #endif #ifndef UNZ_BUFSIZE #define UNZ_BUFSIZE (16384) #endif #ifndef UNZ_MAXFILENAMEINZIP #define UNZ_MAXFILENAMEINZIP (256) #endif #ifndef ALLOC # define ALLOC(size) (malloc(size)) #endif #define SIZECENTRALDIRITEM (0x2e) #define SIZEZIPLOCALHEADER (0x1e) const char unz_copyright[] = " unzip 1.01 Copyright 1998-2004 Gilles Vollant - http://www.winimage.com/zLibDll"; /* unz_file_info64_internal contain internal info about a file in zipfile*/ typedef struct unz_file_info64_internal_s { ZPOS64_T offset_curfile;/* relative offset of local header 8 bytes */ } unz_file_info64_internal; /* file_in_zip_read_info_s contain internal information about a file in zipfile, when reading and decompress it */ typedef struct { char *read_buffer; /* internal buffer for compressed data */ z_stream stream; /* zLib stream structure for inflate */ #ifdef HAVE_BZIP2 bz_stream bstream; /* bzLib stream structure for bziped */ #endif ZPOS64_T pos_in_zipfile; /* position in byte on the zipfile, for fseek*/ uLong stream_initialised; /* flag set if stream structure is initialised*/ ZPOS64_T offset_local_extrafield;/* offset of the local extra field */ uInt size_local_extrafield;/* size of the local extra field */ ZPOS64_T pos_local_extrafield; /* position in the local extra field in read*/ ZPOS64_T total_out_64; uLong crc32; /* crc32 of all data uncompressed */ uLong crc32_wait; /* crc32 we must obtain after decompress all */ ZPOS64_T rest_read_compressed; /* number of byte to be decompressed */ ZPOS64_T rest_read_uncompressed;/*number of byte to be obtained after decomp*/ zlib_filefunc64_32_def z_filefunc; voidpf filestream; /* io structure of the zipfile */ uLong compression_method; /* compression method (0==store) */ ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/ int raw; } file_in_zip64_read_info_s; /* unz64_s contain internal information about the zipfile */ typedef struct { zlib_filefunc64_32_def z_filefunc; int is64bitOpenFunction; voidpf filestream; /* io structure of the zipfile */ unz_global_info64 gi; /* public global information */ ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/ ZPOS64_T num_file; /* number of the current file in the zipfile*/ ZPOS64_T pos_in_central_dir; /* pos of the current file in the central dir*/ ZPOS64_T current_file_ok; /* flag about the usability of the current file*/ ZPOS64_T central_pos; /* position of the beginning of the central dir*/ ZPOS64_T size_central_dir; /* size of the central directory */ ZPOS64_T offset_central_dir; /* offset of start of central directory with respect to the starting disk number */ unz_file_info64 cur_file_info; /* public info about the current file in zip*/ unz_file_info64_internal cur_file_info_internal; /* private info about it*/ file_in_zip64_read_info_s* pfile_in_zip_read; /* structure about the current file if we are decompressing it */ int encrypted; int isZip64; # ifndef NOUNCRYPT unsigned long keys[3]; /* keys defining the pseudo-random sequence */ const z_crc_t* pcrc_32_tab; # endif } unz64_s; #ifndef NOUNCRYPT #include "crypt.h" #endif /* =========================================================================== Reads a long in LSB order from the given gz_stream. Sets */ local int unz64local_getShort(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong *pX) { unsigned char c[2]; int err = (int)ZREAD64(*pzlib_filefunc_def,filestream,c,2); if (err==2) { *pX = c[0] | ((uLong)c[1] << 8); return UNZ_OK; } else { *pX = 0; if (ZERROR64(*pzlib_filefunc_def,filestream)) return UNZ_ERRNO; else return UNZ_EOF; } } local int unz64local_getLong(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong *pX) { unsigned char c[4]; int err = (int)ZREAD64(*pzlib_filefunc_def,filestream,c,4); if (err==4) { *pX = c[0] | ((uLong)c[1] << 8) | ((uLong)c[2] << 16) | ((uLong)c[3] << 24); return UNZ_OK; } else { *pX = 0; if (ZERROR64(*pzlib_filefunc_def,filestream)) return UNZ_ERRNO; else return UNZ_EOF; } } local int unz64local_getLong64(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T *pX) { unsigned char c[8]; int err = (int)ZREAD64(*pzlib_filefunc_def,filestream,c,8); if (err==8) { *pX = c[0] | ((ZPOS64_T)c[1] << 8) | ((ZPOS64_T)c[2] << 16) | ((ZPOS64_T)c[3] << 24) | ((ZPOS64_T)c[4] << 32) | ((ZPOS64_T)c[5] << 40) | ((ZPOS64_T)c[6] << 48) | ((ZPOS64_T)c[7] << 56); return UNZ_OK; } else { *pX = 0; if (ZERROR64(*pzlib_filefunc_def,filestream)) return UNZ_ERRNO; else return UNZ_EOF; } } /* My own strcmpi / strcasecmp */ local int strcmpcasenosensitive_internal(const char* fileName1, const char* fileName2) { for (;;) { char c1=*(fileName1++); char c2=*(fileName2++); if ((c1>='a') && (c1<='z')) c1 -= 0x20; if ((c2>='a') && (c2<='z')) c2 -= 0x20; if (c1=='\0') return ((c2=='\0') ? 0 : -1); if (c2=='\0') return 1; if (c1c2) return 1; } } #ifdef CASESENSITIVITYDEFAULT_NO #define CASESENSITIVITYDEFAULTVALUE 2 #else #define CASESENSITIVITYDEFAULTVALUE 1 #endif #ifndef STRCMPCASENOSENTIVEFUNCTION #define STRCMPCASENOSENTIVEFUNCTION strcmpcasenosensitive_internal #endif /* Compare two filenames (fileName1,fileName2). If iCaseSensitivity = 1, comparison is case sensitive (like strcmp) If iCaseSensitivity = 2, comparison is not case sensitive (like strcmpi or strcasecmp) If iCaseSensitivity = 0, case sensitivity is default of your operating system (like 1 on Unix, 2 on Windows) */ extern int ZEXPORT unzStringFileNameCompare (const char* fileName1, const char* fileName2, int iCaseSensitivity) { if (iCaseSensitivity==0) iCaseSensitivity=CASESENSITIVITYDEFAULTVALUE; if (iCaseSensitivity==1) return strcmp(fileName1,fileName2); return STRCMPCASENOSENTIVEFUNCTION(fileName1,fileName2); } #ifndef BUFREADCOMMENT #define BUFREADCOMMENT (0x400) #endif #ifndef CENTRALDIRINVALID #define CENTRALDIRINVALID ((ZPOS64_T)(-1)) #endif /* Locate the Central directory of a zipfile (at the end, just before the global comment) */ local ZPOS64_T unz64local_SearchCentralDir(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream) { unsigned char* buf; ZPOS64_T uSizeFile; ZPOS64_T uBackRead; ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */ ZPOS64_T uPosFound=CENTRALDIRINVALID; if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0) return CENTRALDIRINVALID; uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream); if (uMaxBack>uSizeFile) uMaxBack = uSizeFile; buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4); if (buf==NULL) return CENTRALDIRINVALID; uBackRead = 4; while (uBackReaduMaxBack) uBackRead = uMaxBack; else uBackRead+=BUFREADCOMMENT; uReadPos = uSizeFile-uBackRead ; uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ? (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos); if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0) break; if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize) break; for (i=(int)uReadSize-3; (i--)>0;) if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) && ((*(buf+i+2))==0x05) && ((*(buf+i+3))==0x06)) { uPosFound = uReadPos+(unsigned)i; break; } if (uPosFound!=CENTRALDIRINVALID) break; } free(buf); return uPosFound; } /* Locate the Central directory 64 of a zipfile (at the end, just before the global comment) */ local ZPOS64_T unz64local_SearchCentralDir64(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream) { unsigned char* buf; ZPOS64_T uSizeFile; ZPOS64_T uBackRead; ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */ ZPOS64_T uPosFound=CENTRALDIRINVALID; uLong uL; ZPOS64_T relativeOffset; if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0) return CENTRALDIRINVALID; uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream); if (uMaxBack>uSizeFile) uMaxBack = uSizeFile; buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4); if (buf==NULL) return CENTRALDIRINVALID; uBackRead = 4; while (uBackReaduMaxBack) uBackRead = uMaxBack; else uBackRead+=BUFREADCOMMENT; uReadPos = uSizeFile-uBackRead ; uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ? (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos); if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0) break; if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize) break; for (i=(int)uReadSize-3; (i--)>0;) if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) && ((*(buf+i+2))==0x06) && ((*(buf+i+3))==0x07)) { uPosFound = uReadPos+(unsigned)i; break; } if (uPosFound!=CENTRALDIRINVALID) break; } free(buf); if (uPosFound == CENTRALDIRINVALID) return CENTRALDIRINVALID; /* Zip64 end of central directory locator */ if (ZSEEK64(*pzlib_filefunc_def,filestream, uPosFound,ZLIB_FILEFUNC_SEEK_SET)!=0) return CENTRALDIRINVALID; /* the signature, already checked */ if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK) return CENTRALDIRINVALID; /* number of the disk with the start of the zip64 end of central directory */ if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK) return CENTRALDIRINVALID; if (uL != 0) return CENTRALDIRINVALID; /* relative offset of the zip64 end of central directory record */ if (unz64local_getLong64(pzlib_filefunc_def,filestream,&relativeOffset)!=UNZ_OK) return CENTRALDIRINVALID; /* total number of disks */ if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK) return CENTRALDIRINVALID; if (uL != 1) return CENTRALDIRINVALID; /* Goto end of central directory record */ if (ZSEEK64(*pzlib_filefunc_def,filestream, relativeOffset,ZLIB_FILEFUNC_SEEK_SET)!=0) return CENTRALDIRINVALID; /* the signature */ if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK) return CENTRALDIRINVALID; if (uL != 0x06064b50) return CENTRALDIRINVALID; return relativeOffset; } /* Open a Zip file. path contain the full pathname (by example, on a Windows NT computer "c:\\test\\zlib114.zip" or on an Unix computer "zlib/zlib114.zip". If the zipfile cannot be opened (file doesn't exist or in not valid), the return value is NULL. Else, the return value is a unzFile Handle, usable with other function of this unzip package. */ local unzFile unzOpenInternal(const void *path, zlib_filefunc64_32_def* pzlib_filefunc64_32_def, int is64bitOpenFunction) { unz64_s us; unz64_s *s; ZPOS64_T central_pos; uLong uL; uLong number_disk; /* number of the current disk, used for spanning ZIP, unsupported, always 0*/ uLong number_disk_with_CD; /* number the disk with central dir, used for spanning ZIP, unsupported, always 0*/ ZPOS64_T number_entry_CD; /* total number of entries in the central dir (same than number_entry on nospan) */ int err=UNZ_OK; if (unz_copyright[0]!=' ') return NULL; us.z_filefunc.zseek32_file = NULL; us.z_filefunc.ztell32_file = NULL; if (pzlib_filefunc64_32_def==NULL) fill_fopen64_filefunc(&us.z_filefunc.zfile_func64); else us.z_filefunc = *pzlib_filefunc64_32_def; us.is64bitOpenFunction = is64bitOpenFunction; us.filestream = ZOPEN64(us.z_filefunc, path, ZLIB_FILEFUNC_MODE_READ | ZLIB_FILEFUNC_MODE_EXISTING); if (us.filestream==NULL) return NULL; central_pos = unz64local_SearchCentralDir64(&us.z_filefunc,us.filestream); if (central_pos!=CENTRALDIRINVALID) { uLong uS; ZPOS64_T uL64; us.isZip64 = 1; if (ZSEEK64(us.z_filefunc, us.filestream, central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0) err=UNZ_ERRNO; /* the signature, already checked */ if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK) err=UNZ_ERRNO; /* size of zip64 end of central directory record */ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&uL64)!=UNZ_OK) err=UNZ_ERRNO; /* version made by */ if (unz64local_getShort(&us.z_filefunc, us.filestream,&uS)!=UNZ_OK) err=UNZ_ERRNO; /* version needed to extract */ if (unz64local_getShort(&us.z_filefunc, us.filestream,&uS)!=UNZ_OK) err=UNZ_ERRNO; /* number of this disk */ if (unz64local_getLong(&us.z_filefunc, us.filestream,&number_disk)!=UNZ_OK) err=UNZ_ERRNO; /* number of the disk with the start of the central directory */ if (unz64local_getLong(&us.z_filefunc, us.filestream,&number_disk_with_CD)!=UNZ_OK) err=UNZ_ERRNO; /* total number of entries in the central directory on this disk */ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.gi.number_entry)!=UNZ_OK) err=UNZ_ERRNO; /* total number of entries in the central directory */ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&number_entry_CD)!=UNZ_OK) err=UNZ_ERRNO; if ((number_entry_CD!=us.gi.number_entry) || (number_disk_with_CD!=0) || (number_disk!=0)) err=UNZ_BADZIPFILE; /* size of the central directory */ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.size_central_dir)!=UNZ_OK) err=UNZ_ERRNO; /* offset of start of central directory with respect to the starting disk number */ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.offset_central_dir)!=UNZ_OK) err=UNZ_ERRNO; us.gi.size_comment = 0; } else { central_pos = unz64local_SearchCentralDir(&us.z_filefunc,us.filestream); if (central_pos==CENTRALDIRINVALID) err=UNZ_ERRNO; us.isZip64 = 0; if (ZSEEK64(us.z_filefunc, us.filestream, central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0) err=UNZ_ERRNO; /* the signature, already checked */ if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK) err=UNZ_ERRNO; /* number of this disk */ if (unz64local_getShort(&us.z_filefunc, us.filestream,&number_disk)!=UNZ_OK) err=UNZ_ERRNO; /* number of the disk with the start of the central directory */ if (unz64local_getShort(&us.z_filefunc, us.filestream,&number_disk_with_CD)!=UNZ_OK) err=UNZ_ERRNO; /* total number of entries in the central dir on this disk */ if (unz64local_getShort(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK) err=UNZ_ERRNO; us.gi.number_entry = uL; /* total number of entries in the central dir */ if (unz64local_getShort(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK) err=UNZ_ERRNO; number_entry_CD = uL; if ((number_entry_CD!=us.gi.number_entry) || (number_disk_with_CD!=0) || (number_disk!=0)) err=UNZ_BADZIPFILE; /* size of the central directory */ if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK) err=UNZ_ERRNO; us.size_central_dir = uL; /* offset of start of central directory with respect to the starting disk number */ if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK) err=UNZ_ERRNO; us.offset_central_dir = uL; /* zipfile comment length */ if (unz64local_getShort(&us.z_filefunc, us.filestream,&us.gi.size_comment)!=UNZ_OK) err=UNZ_ERRNO; } if ((central_pospfile_in_zip_read!=NULL) unzCloseCurrentFile(file); ZCLOSE64(s->z_filefunc, s->filestream); free(s); return UNZ_OK; } /* Write info about the ZipFile in the *pglobal_info structure. No preparation of the structure is needed return UNZ_OK if there is no problem. */ extern int ZEXPORT unzGetGlobalInfo64(unzFile file, unz_global_info64* pglobal_info) { unz64_s* s; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; *pglobal_info=s->gi; return UNZ_OK; } extern int ZEXPORT unzGetGlobalInfo(unzFile file, unz_global_info* pglobal_info32) { unz64_s* s; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; /* to do : check if number_entry is not truncated */ pglobal_info32->number_entry = (uLong)s->gi.number_entry; pglobal_info32->size_comment = s->gi.size_comment; return UNZ_OK; } /* Translate date/time from Dos format to tm_unz (readable more easily) */ local void unz64local_DosDateToTmuDate(ZPOS64_T ulDosDate, tm_unz* ptm) { ZPOS64_T uDate; uDate = (ZPOS64_T)(ulDosDate>>16); ptm->tm_mday = (int)(uDate&0x1f) ; ptm->tm_mon = (int)((((uDate)&0x1E0)/0x20)-1) ; ptm->tm_year = (int)(((uDate&0x0FE00)/0x0200)+1980) ; ptm->tm_hour = (int) ((ulDosDate &0xF800)/0x800); ptm->tm_min = (int) ((ulDosDate&0x7E0)/0x20) ; ptm->tm_sec = (int) (2*(ulDosDate&0x1f)) ; } /* Get Info about the current file in the zipfile, with internal only info */ local int unz64local_GetCurrentFileInfoInternal(unzFile file, unz_file_info64 *pfile_info, unz_file_info64_internal *pfile_info_internal, char *szFileName, uLong fileNameBufferSize, void *extraField, uLong extraFieldBufferSize, char *szComment, uLong commentBufferSize) { unz64_s* s; unz_file_info64 file_info; unz_file_info64_internal file_info_internal; int err=UNZ_OK; uLong uMagic; long lSeek=0; uLong uL; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; if (ZSEEK64(s->z_filefunc, s->filestream, s->pos_in_central_dir+s->byte_before_the_zipfile, ZLIB_FILEFUNC_SEEK_SET)!=0) err=UNZ_ERRNO; /* we check the magic */ if (err==UNZ_OK) { if (unz64local_getLong(&s->z_filefunc, s->filestream,&uMagic) != UNZ_OK) err=UNZ_ERRNO; else if (uMagic!=0x02014b50) err=UNZ_BADZIPFILE; } if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.version) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.version_needed) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.flag) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.compression_method) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.dosDate) != UNZ_OK) err=UNZ_ERRNO; unz64local_DosDateToTmuDate(file_info.dosDate,&file_info.tmu_date); if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.crc) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK) err=UNZ_ERRNO; file_info.compressed_size = uL; if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK) err=UNZ_ERRNO; file_info.uncompressed_size = uL; if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_filename) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_file_extra) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_file_comment) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.disk_num_start) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.internal_fa) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.external_fa) != UNZ_OK) err=UNZ_ERRNO; // relative offset of local header if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK) err=UNZ_ERRNO; file_info_internal.offset_curfile = uL; lSeek+=file_info.size_filename; if ((err==UNZ_OK) && (szFileName!=NULL)) { uLong uSizeRead ; if (file_info.size_filename0) && (fileNameBufferSize>0)) if (ZREAD64(s->z_filefunc, s->filestream,szFileName,uSizeRead)!=uSizeRead) err=UNZ_ERRNO; lSeek -= uSizeRead; } // Read extrafield if ((err==UNZ_OK) && (extraField!=NULL)) { ZPOS64_T uSizeRead ; if (file_info.size_file_extraz_filefunc, s->filestream,(ZPOS64_T)lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0) lSeek=0; else err=UNZ_ERRNO; } if ((file_info.size_file_extra>0) && (extraFieldBufferSize>0)) if (ZREAD64(s->z_filefunc, s->filestream,extraField,(uLong)uSizeRead)!=uSizeRead) err=UNZ_ERRNO; lSeek += file_info.size_file_extra - (uLong)uSizeRead; } else lSeek += file_info.size_file_extra; if ((err==UNZ_OK) && (file_info.size_file_extra != 0)) { uLong acc = 0; // since lSeek now points to after the extra field we need to move back lSeek -= file_info.size_file_extra; if (lSeek!=0) { if (ZSEEK64(s->z_filefunc, s->filestream,(ZPOS64_T)lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0) lSeek=0; else err=UNZ_ERRNO; } while(acc < file_info.size_file_extra) { uLong headerId; uLong dataSize; if (unz64local_getShort(&s->z_filefunc, s->filestream,&headerId) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&dataSize) != UNZ_OK) err=UNZ_ERRNO; /* ZIP64 extra fields */ if (headerId == 0x0001) { if(file_info.uncompressed_size == MAXU32) { if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info.uncompressed_size) != UNZ_OK) err=UNZ_ERRNO; } if(file_info.compressed_size == MAXU32) { if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info.compressed_size) != UNZ_OK) err=UNZ_ERRNO; } if(file_info_internal.offset_curfile == MAXU32) { /* Relative Header offset */ if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info_internal.offset_curfile) != UNZ_OK) err=UNZ_ERRNO; } if(file_info.disk_num_start == 0xffff) { /* Disk Start Number */ if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.disk_num_start) != UNZ_OK) err=UNZ_ERRNO; } } else { if (ZSEEK64(s->z_filefunc, s->filestream,dataSize,ZLIB_FILEFUNC_SEEK_CUR)!=0) err=UNZ_ERRNO; } acc += 2 + 2 + dataSize; } } if ((err==UNZ_OK) && (szComment!=NULL)) { uLong uSizeRead ; if (file_info.size_file_commentz_filefunc, s->filestream,(ZPOS64_T)lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0) lSeek=0; else err=UNZ_ERRNO; } if ((file_info.size_file_comment>0) && (commentBufferSize>0)) if (ZREAD64(s->z_filefunc, s->filestream,szComment,uSizeRead)!=uSizeRead) err=UNZ_ERRNO; lSeek+=file_info.size_file_comment - uSizeRead; } else lSeek+=file_info.size_file_comment; if ((err==UNZ_OK) && (pfile_info!=NULL)) *pfile_info=file_info; if ((err==UNZ_OK) && (pfile_info_internal!=NULL)) *pfile_info_internal=file_info_internal; return err; } /* Write info about the ZipFile in the *pglobal_info structure. No preparation of the structure is needed return UNZ_OK if there is no problem. */ extern int ZEXPORT unzGetCurrentFileInfo64(unzFile file, unz_file_info64 * pfile_info, char * szFileName, uLong fileNameBufferSize, void *extraField, uLong extraFieldBufferSize, char* szComment, uLong commentBufferSize) { return unz64local_GetCurrentFileInfoInternal(file,pfile_info,NULL, szFileName,fileNameBufferSize, extraField,extraFieldBufferSize, szComment,commentBufferSize); } extern int ZEXPORT unzGetCurrentFileInfo(unzFile file, unz_file_info * pfile_info, char * szFileName, uLong fileNameBufferSize, void *extraField, uLong extraFieldBufferSize, char* szComment, uLong commentBufferSize) { int err; unz_file_info64 file_info64; err = unz64local_GetCurrentFileInfoInternal(file,&file_info64,NULL, szFileName,fileNameBufferSize, extraField,extraFieldBufferSize, szComment,commentBufferSize); if ((err==UNZ_OK) && (pfile_info != NULL)) { pfile_info->version = file_info64.version; pfile_info->version_needed = file_info64.version_needed; pfile_info->flag = file_info64.flag; pfile_info->compression_method = file_info64.compression_method; pfile_info->dosDate = file_info64.dosDate; pfile_info->crc = file_info64.crc; pfile_info->size_filename = file_info64.size_filename; pfile_info->size_file_extra = file_info64.size_file_extra; pfile_info->size_file_comment = file_info64.size_file_comment; pfile_info->disk_num_start = file_info64.disk_num_start; pfile_info->internal_fa = file_info64.internal_fa; pfile_info->external_fa = file_info64.external_fa; pfile_info->tmu_date = file_info64.tmu_date; pfile_info->compressed_size = (uLong)file_info64.compressed_size; pfile_info->uncompressed_size = (uLong)file_info64.uncompressed_size; } return err; } /* Set the current file of the zipfile to the first file. return UNZ_OK if there is no problem */ extern int ZEXPORT unzGoToFirstFile(unzFile file) { int err=UNZ_OK; unz64_s* s; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; s->pos_in_central_dir=s->offset_central_dir; s->num_file=0; err=unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info, &s->cur_file_info_internal, NULL,0,NULL,0,NULL,0); s->current_file_ok = (err == UNZ_OK); return err; } /* Set the current file of the zipfile to the next file. return UNZ_OK if there is no problem return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest. */ extern int ZEXPORT unzGoToNextFile(unzFile file) { unz64_s* s; int err; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; if (!s->current_file_ok) return UNZ_END_OF_LIST_OF_FILE; if (s->gi.number_entry != 0xffff) /* 2^16 files overflow hack */ if (s->num_file+1==s->gi.number_entry) return UNZ_END_OF_LIST_OF_FILE; s->pos_in_central_dir += SIZECENTRALDIRITEM + s->cur_file_info.size_filename + s->cur_file_info.size_file_extra + s->cur_file_info.size_file_comment ; s->num_file++; err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info, &s->cur_file_info_internal, NULL,0,NULL,0,NULL,0); s->current_file_ok = (err == UNZ_OK); return err; } /* Try locate the file szFileName in the zipfile. For the iCaseSensitivity signification, see unzStringFileNameCompare return value : UNZ_OK if the file is found. It becomes the current file. UNZ_END_OF_LIST_OF_FILE if the file is not found */ extern int ZEXPORT unzLocateFile(unzFile file, const char *szFileName, int iCaseSensitivity) { unz64_s* s; int err; /* We remember the 'current' position in the file so that we can jump * back there if we fail. */ unz_file_info64 cur_file_infoSaved; unz_file_info64_internal cur_file_info_internalSaved; ZPOS64_T num_fileSaved; ZPOS64_T pos_in_central_dirSaved; if (file==NULL) return UNZ_PARAMERROR; if (strlen(szFileName)>=UNZ_MAXFILENAMEINZIP) return UNZ_PARAMERROR; s=(unz64_s*)file; if (!s->current_file_ok) return UNZ_END_OF_LIST_OF_FILE; /* Save the current state */ num_fileSaved = s->num_file; pos_in_central_dirSaved = s->pos_in_central_dir; cur_file_infoSaved = s->cur_file_info; cur_file_info_internalSaved = s->cur_file_info_internal; err = unzGoToFirstFile(file); while (err == UNZ_OK) { char szCurrentFileName[UNZ_MAXFILENAMEINZIP+1]; err = unzGetCurrentFileInfo64(file,NULL, szCurrentFileName,sizeof(szCurrentFileName)-1, NULL,0,NULL,0); if (err == UNZ_OK) { if (unzStringFileNameCompare(szCurrentFileName, szFileName,iCaseSensitivity)==0) return UNZ_OK; err = unzGoToNextFile(file); } } /* We failed, so restore the state of the 'current file' to where we * were. */ s->num_file = num_fileSaved ; s->pos_in_central_dir = pos_in_central_dirSaved ; s->cur_file_info = cur_file_infoSaved; s->cur_file_info_internal = cur_file_info_internalSaved; return err; } /* /////////////////////////////////////////// // Contributed by Ryan Haksi (mailto://cryogen@infoserve.net) // I need random access // // Further optimization could be realized by adding an ability // to cache the directory in memory. The goal being a single // comprehensive file read to put the file I need in a memory. */ /* typedef struct unz_file_pos_s { ZPOS64_T pos_in_zip_directory; // offset in file ZPOS64_T num_of_file; // # of file } unz_file_pos; */ extern int ZEXPORT unzGetFilePos64(unzFile file, unz64_file_pos* file_pos) { unz64_s* s; if (file==NULL || file_pos==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; if (!s->current_file_ok) return UNZ_END_OF_LIST_OF_FILE; file_pos->pos_in_zip_directory = s->pos_in_central_dir; file_pos->num_of_file = s->num_file; return UNZ_OK; } extern int ZEXPORT unzGetFilePos(unzFile file, unz_file_pos* file_pos) { unz64_file_pos file_pos64; int err = unzGetFilePos64(file,&file_pos64); if (err==UNZ_OK) { file_pos->pos_in_zip_directory = (uLong)file_pos64.pos_in_zip_directory; file_pos->num_of_file = (uLong)file_pos64.num_of_file; } return err; } extern int ZEXPORT unzGoToFilePos64(unzFile file, const unz64_file_pos* file_pos) { unz64_s* s; int err; if (file==NULL || file_pos==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; /* jump to the right spot */ s->pos_in_central_dir = file_pos->pos_in_zip_directory; s->num_file = file_pos->num_of_file; /* set the current file */ err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info, &s->cur_file_info_internal, NULL,0,NULL,0,NULL,0); /* return results */ s->current_file_ok = (err == UNZ_OK); return err; } extern int ZEXPORT unzGoToFilePos(unzFile file, unz_file_pos* file_pos) { unz64_file_pos file_pos64; if (file_pos == NULL) return UNZ_PARAMERROR; file_pos64.pos_in_zip_directory = file_pos->pos_in_zip_directory; file_pos64.num_of_file = file_pos->num_of_file; return unzGoToFilePos64(file,&file_pos64); } /* // Unzip Helper Functions - should be here? /////////////////////////////////////////// */ /* Read the local header of the current zipfile Check the coherency of the local header and info in the end of central directory about this file store in *piSizeVar the size of extra info in local header (filename and size of extra field data) */ local int unz64local_CheckCurrentFileCoherencyHeader(unz64_s* s, uInt* piSizeVar, ZPOS64_T * poffset_local_extrafield, uInt * psize_local_extrafield) { uLong uMagic,uData,uFlags; uLong size_filename; uLong size_extra_field; int err=UNZ_OK; *piSizeVar = 0; *poffset_local_extrafield = 0; *psize_local_extrafield = 0; if (ZSEEK64(s->z_filefunc, s->filestream,s->cur_file_info_internal.offset_curfile + s->byte_before_the_zipfile,ZLIB_FILEFUNC_SEEK_SET)!=0) return UNZ_ERRNO; if (err==UNZ_OK) { if (unz64local_getLong(&s->z_filefunc, s->filestream,&uMagic) != UNZ_OK) err=UNZ_ERRNO; else if (uMagic!=0x04034b50) err=UNZ_BADZIPFILE; } if (unz64local_getShort(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) err=UNZ_ERRNO; /* else if ((err==UNZ_OK) && (uData!=s->cur_file_info.wVersion)) err=UNZ_BADZIPFILE; */ if (unz64local_getShort(&s->z_filefunc, s->filestream,&uFlags) != UNZ_OK) err=UNZ_ERRNO; if (unz64local_getShort(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) err=UNZ_ERRNO; else if ((err==UNZ_OK) && (uData!=s->cur_file_info.compression_method)) err=UNZ_BADZIPFILE; if ((err==UNZ_OK) && (s->cur_file_info.compression_method!=0) && /* #ifdef HAVE_BZIP2 */ (s->cur_file_info.compression_method!=Z_BZIP2ED) && /* #endif */ (s->cur_file_info.compression_method!=Z_DEFLATED)) err=UNZ_BADZIPFILE; if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* date/time */ err=UNZ_ERRNO; if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* crc */ err=UNZ_ERRNO; else if ((err==UNZ_OK) && (uData!=s->cur_file_info.crc) && ((uFlags & 8)==0)) err=UNZ_BADZIPFILE; if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* size compr */ err=UNZ_ERRNO; else if (uData != 0xFFFFFFFF && (err==UNZ_OK) && (uData!=s->cur_file_info.compressed_size) && ((uFlags & 8)==0)) err=UNZ_BADZIPFILE; if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* size uncompr */ err=UNZ_ERRNO; else if (uData != 0xFFFFFFFF && (err==UNZ_OK) && (uData!=s->cur_file_info.uncompressed_size) && ((uFlags & 8)==0)) err=UNZ_BADZIPFILE; if (unz64local_getShort(&s->z_filefunc, s->filestream,&size_filename) != UNZ_OK) err=UNZ_ERRNO; else if ((err==UNZ_OK) && (size_filename!=s->cur_file_info.size_filename)) err=UNZ_BADZIPFILE; *piSizeVar += (uInt)size_filename; if (unz64local_getShort(&s->z_filefunc, s->filestream,&size_extra_field) != UNZ_OK) err=UNZ_ERRNO; *poffset_local_extrafield= s->cur_file_info_internal.offset_curfile + SIZEZIPLOCALHEADER + size_filename; *psize_local_extrafield = (uInt)size_extra_field; *piSizeVar += (uInt)size_extra_field; return err; } /* Open for reading data the current file in the zipfile. If there is no error and the file is opened, the return value is UNZ_OK. */ extern int ZEXPORT unzOpenCurrentFile3(unzFile file, int* method, int* level, int raw, const char* password) { int err=UNZ_OK; uInt iSizeVar; unz64_s* s; file_in_zip64_read_info_s* pfile_in_zip_read_info; ZPOS64_T offset_local_extrafield; /* offset of the local extra field */ uInt size_local_extrafield; /* size of the local extra field */ # ifndef NOUNCRYPT char source[12]; # else if (password != NULL) return UNZ_PARAMERROR; # endif if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; if (!s->current_file_ok) return UNZ_PARAMERROR; if (s->pfile_in_zip_read != NULL) unzCloseCurrentFile(file); if (unz64local_CheckCurrentFileCoherencyHeader(s,&iSizeVar, &offset_local_extrafield,&size_local_extrafield)!=UNZ_OK) return UNZ_BADZIPFILE; pfile_in_zip_read_info = (file_in_zip64_read_info_s*)ALLOC(sizeof(file_in_zip64_read_info_s)); if (pfile_in_zip_read_info==NULL) return UNZ_INTERNALERROR; pfile_in_zip_read_info->read_buffer=(char*)ALLOC(UNZ_BUFSIZE); pfile_in_zip_read_info->offset_local_extrafield = offset_local_extrafield; pfile_in_zip_read_info->size_local_extrafield = size_local_extrafield; pfile_in_zip_read_info->pos_local_extrafield=0; pfile_in_zip_read_info->raw=raw; if (pfile_in_zip_read_info->read_buffer==NULL) { free(pfile_in_zip_read_info); return UNZ_INTERNALERROR; } pfile_in_zip_read_info->stream_initialised=0; if (method!=NULL) *method = (int)s->cur_file_info.compression_method; if (level!=NULL) { *level = 6; switch (s->cur_file_info.flag & 0x06) { case 6 : *level = 1; break; case 4 : *level = 2; break; case 2 : *level = 9; break; } } if ((s->cur_file_info.compression_method!=0) && /* #ifdef HAVE_BZIP2 */ (s->cur_file_info.compression_method!=Z_BZIP2ED) && /* #endif */ (s->cur_file_info.compression_method!=Z_DEFLATED)) err=UNZ_BADZIPFILE; pfile_in_zip_read_info->crc32_wait=s->cur_file_info.crc; pfile_in_zip_read_info->crc32=0; pfile_in_zip_read_info->total_out_64=0; pfile_in_zip_read_info->compression_method = s->cur_file_info.compression_method; pfile_in_zip_read_info->filestream=s->filestream; pfile_in_zip_read_info->z_filefunc=s->z_filefunc; pfile_in_zip_read_info->byte_before_the_zipfile=s->byte_before_the_zipfile; pfile_in_zip_read_info->stream.total_out = 0; if ((s->cur_file_info.compression_method==Z_BZIP2ED) && (!raw)) { #ifdef HAVE_BZIP2 pfile_in_zip_read_info->bstream.bzalloc = (void *(*) (void *, int, int))0; pfile_in_zip_read_info->bstream.bzfree = (free_func)0; pfile_in_zip_read_info->bstream.opaque = (voidpf)0; pfile_in_zip_read_info->bstream.state = (voidpf)0; pfile_in_zip_read_info->stream.zalloc = (alloc_func)0; pfile_in_zip_read_info->stream.zfree = (free_func)0; pfile_in_zip_read_info->stream.opaque = (voidpf)0; pfile_in_zip_read_info->stream.next_in = (voidpf)0; pfile_in_zip_read_info->stream.avail_in = 0; err=BZ2_bzDecompressInit(&pfile_in_zip_read_info->bstream, 0, 0); if (err == Z_OK) pfile_in_zip_read_info->stream_initialised=Z_BZIP2ED; else { free(pfile_in_zip_read_info->read_buffer); free(pfile_in_zip_read_info); return err; } #else pfile_in_zip_read_info->raw=1; #endif } else if ((s->cur_file_info.compression_method==Z_DEFLATED) && (!raw)) { pfile_in_zip_read_info->stream.zalloc = (alloc_func)0; pfile_in_zip_read_info->stream.zfree = (free_func)0; pfile_in_zip_read_info->stream.opaque = (voidpf)0; pfile_in_zip_read_info->stream.next_in = 0; pfile_in_zip_read_info->stream.avail_in = 0; err=inflateInit2(&pfile_in_zip_read_info->stream, -MAX_WBITS); if (err == Z_OK) pfile_in_zip_read_info->stream_initialised=Z_DEFLATED; else { free(pfile_in_zip_read_info->read_buffer); free(pfile_in_zip_read_info); return err; } /* windowBits is passed < 0 to tell that there is no zlib header. * Note that in this case inflate *requires* an extra "dummy" byte * after the compressed stream in order to complete decompression and * return Z_STREAM_END. * In unzip, i don't wait absolutely Z_STREAM_END because I known the * size of both compressed and uncompressed data */ } pfile_in_zip_read_info->rest_read_compressed = s->cur_file_info.compressed_size ; pfile_in_zip_read_info->rest_read_uncompressed = s->cur_file_info.uncompressed_size ; pfile_in_zip_read_info->pos_in_zipfile = s->cur_file_info_internal.offset_curfile + SIZEZIPLOCALHEADER + iSizeVar; pfile_in_zip_read_info->stream.avail_in = (uInt)0; s->pfile_in_zip_read = pfile_in_zip_read_info; s->encrypted = 0; # ifndef NOUNCRYPT if (password != NULL) { int i; s->pcrc_32_tab = get_crc_table(); init_keys(password,s->keys,s->pcrc_32_tab); if (ZSEEK64(s->z_filefunc, s->filestream, s->pfile_in_zip_read->pos_in_zipfile + s->pfile_in_zip_read->byte_before_the_zipfile, SEEK_SET)!=0) return UNZ_INTERNALERROR; if(ZREAD64(s->z_filefunc, s->filestream,source, 12)<12) return UNZ_INTERNALERROR; for (i = 0; i<12; i++) zdecode(s->keys,s->pcrc_32_tab,source[i]); s->pfile_in_zip_read->pos_in_zipfile+=12; s->encrypted=1; } # endif return UNZ_OK; } extern int ZEXPORT unzOpenCurrentFile(unzFile file) { return unzOpenCurrentFile3(file, NULL, NULL, 0, NULL); } extern int ZEXPORT unzOpenCurrentFilePassword(unzFile file, const char* password) { return unzOpenCurrentFile3(file, NULL, NULL, 0, password); } extern int ZEXPORT unzOpenCurrentFile2(unzFile file, int* method, int* level, int raw) { return unzOpenCurrentFile3(file, method, level, raw, NULL); } /** Addition for GDAL : START */ extern ZPOS64_T ZEXPORT unzGetCurrentFileZStreamPos64(unzFile file) { unz64_s* s; file_in_zip64_read_info_s* pfile_in_zip_read_info; s=(unz64_s*)file; if (file==NULL) return 0; //UNZ_PARAMERROR; pfile_in_zip_read_info=s->pfile_in_zip_read; if (pfile_in_zip_read_info==NULL) return 0; //UNZ_PARAMERROR; return pfile_in_zip_read_info->pos_in_zipfile + pfile_in_zip_read_info->byte_before_the_zipfile; } /** Addition for GDAL : END */ /* Read bytes from the current file. buf contain buffer where data must be copied len the size of buf. return the number of byte copied if some bytes are copied return 0 if the end of file was reached return <0 with error code if there is an error (UNZ_ERRNO for IO error, or zLib error for uncompress error) */ extern int ZEXPORT unzReadCurrentFile(unzFile file, voidp buf, unsigned len) { int err=UNZ_OK; uInt iRead = 0; unz64_s* s; file_in_zip64_read_info_s* pfile_in_zip_read_info; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; pfile_in_zip_read_info=s->pfile_in_zip_read; if (pfile_in_zip_read_info==NULL) return UNZ_PARAMERROR; if (pfile_in_zip_read_info->read_buffer == NULL) return UNZ_END_OF_LIST_OF_FILE; if (len==0) return 0; pfile_in_zip_read_info->stream.next_out = (Bytef*)buf; pfile_in_zip_read_info->stream.avail_out = (uInt)len; if ((len>pfile_in_zip_read_info->rest_read_uncompressed) && (!(pfile_in_zip_read_info->raw))) pfile_in_zip_read_info->stream.avail_out = (uInt)pfile_in_zip_read_info->rest_read_uncompressed; if ((len>pfile_in_zip_read_info->rest_read_compressed+ pfile_in_zip_read_info->stream.avail_in) && (pfile_in_zip_read_info->raw)) pfile_in_zip_read_info->stream.avail_out = (uInt)pfile_in_zip_read_info->rest_read_compressed+ pfile_in_zip_read_info->stream.avail_in; while (pfile_in_zip_read_info->stream.avail_out>0) { if ((pfile_in_zip_read_info->stream.avail_in==0) && (pfile_in_zip_read_info->rest_read_compressed>0)) { uInt uReadThis = UNZ_BUFSIZE; if (pfile_in_zip_read_info->rest_read_compressedrest_read_compressed; if (uReadThis == 0) return UNZ_EOF; if (ZSEEK64(pfile_in_zip_read_info->z_filefunc, pfile_in_zip_read_info->filestream, pfile_in_zip_read_info->pos_in_zipfile + pfile_in_zip_read_info->byte_before_the_zipfile, ZLIB_FILEFUNC_SEEK_SET)!=0) return UNZ_ERRNO; if (ZREAD64(pfile_in_zip_read_info->z_filefunc, pfile_in_zip_read_info->filestream, pfile_in_zip_read_info->read_buffer, uReadThis)!=uReadThis) return UNZ_ERRNO; # ifndef NOUNCRYPT if(s->encrypted) { uInt i; for(i=0;iread_buffer[i] = zdecode(s->keys,s->pcrc_32_tab, pfile_in_zip_read_info->read_buffer[i]); } # endif pfile_in_zip_read_info->pos_in_zipfile += uReadThis; pfile_in_zip_read_info->rest_read_compressed-=uReadThis; pfile_in_zip_read_info->stream.next_in = (Bytef*)pfile_in_zip_read_info->read_buffer; pfile_in_zip_read_info->stream.avail_in = (uInt)uReadThis; } if ((pfile_in_zip_read_info->compression_method==0) || (pfile_in_zip_read_info->raw)) { uInt uDoCopy,i ; if ((pfile_in_zip_read_info->stream.avail_in == 0) && (pfile_in_zip_read_info->rest_read_compressed == 0)) return (iRead==0) ? UNZ_EOF : (int)iRead; if (pfile_in_zip_read_info->stream.avail_out < pfile_in_zip_read_info->stream.avail_in) uDoCopy = pfile_in_zip_read_info->stream.avail_out ; else uDoCopy = pfile_in_zip_read_info->stream.avail_in ; for (i=0;istream.next_out+i) = *(pfile_in_zip_read_info->stream.next_in+i); pfile_in_zip_read_info->total_out_64 = pfile_in_zip_read_info->total_out_64 + uDoCopy; pfile_in_zip_read_info->crc32 = crc32(pfile_in_zip_read_info->crc32, pfile_in_zip_read_info->stream.next_out, uDoCopy); pfile_in_zip_read_info->rest_read_uncompressed-=uDoCopy; pfile_in_zip_read_info->stream.avail_in -= uDoCopy; pfile_in_zip_read_info->stream.avail_out -= uDoCopy; pfile_in_zip_read_info->stream.next_out += uDoCopy; pfile_in_zip_read_info->stream.next_in += uDoCopy; pfile_in_zip_read_info->stream.total_out += uDoCopy; iRead += uDoCopy; } else if (pfile_in_zip_read_info->compression_method==Z_BZIP2ED) { #ifdef HAVE_BZIP2 uLong uTotalOutBefore,uTotalOutAfter; const Bytef *bufBefore; uLong uOutThis; pfile_in_zip_read_info->bstream.next_in = (char*)pfile_in_zip_read_info->stream.next_in; pfile_in_zip_read_info->bstream.avail_in = pfile_in_zip_read_info->stream.avail_in; pfile_in_zip_read_info->bstream.total_in_lo32 = pfile_in_zip_read_info->stream.total_in; pfile_in_zip_read_info->bstream.total_in_hi32 = 0; pfile_in_zip_read_info->bstream.next_out = (char*)pfile_in_zip_read_info->stream.next_out; pfile_in_zip_read_info->bstream.avail_out = pfile_in_zip_read_info->stream.avail_out; pfile_in_zip_read_info->bstream.total_out_lo32 = pfile_in_zip_read_info->stream.total_out; pfile_in_zip_read_info->bstream.total_out_hi32 = 0; uTotalOutBefore = pfile_in_zip_read_info->bstream.total_out_lo32; bufBefore = (const Bytef *)pfile_in_zip_read_info->bstream.next_out; err=BZ2_bzDecompress(&pfile_in_zip_read_info->bstream); uTotalOutAfter = pfile_in_zip_read_info->bstream.total_out_lo32; uOutThis = uTotalOutAfter-uTotalOutBefore; pfile_in_zip_read_info->total_out_64 = pfile_in_zip_read_info->total_out_64 + uOutThis; pfile_in_zip_read_info->crc32 = crc32(pfile_in_zip_read_info->crc32,bufBefore, (uInt)(uOutThis)); pfile_in_zip_read_info->rest_read_uncompressed -= uOutThis; iRead += (uInt)(uTotalOutAfter - uTotalOutBefore); pfile_in_zip_read_info->stream.next_in = (Bytef*)pfile_in_zip_read_info->bstream.next_in; pfile_in_zip_read_info->stream.avail_in = pfile_in_zip_read_info->bstream.avail_in; pfile_in_zip_read_info->stream.total_in = pfile_in_zip_read_info->bstream.total_in_lo32; pfile_in_zip_read_info->stream.next_out = (Bytef*)pfile_in_zip_read_info->bstream.next_out; pfile_in_zip_read_info->stream.avail_out = pfile_in_zip_read_info->bstream.avail_out; pfile_in_zip_read_info->stream.total_out = pfile_in_zip_read_info->bstream.total_out_lo32; if (err==BZ_STREAM_END) return (iRead==0) ? UNZ_EOF : iRead; if (err!=BZ_OK) break; #endif } // end Z_BZIP2ED else { ZPOS64_T uTotalOutBefore,uTotalOutAfter; const Bytef *bufBefore; ZPOS64_T uOutThis; int flush=Z_SYNC_FLUSH; uTotalOutBefore = pfile_in_zip_read_info->stream.total_out; bufBefore = pfile_in_zip_read_info->stream.next_out; /* if ((pfile_in_zip_read_info->rest_read_uncompressed == pfile_in_zip_read_info->stream.avail_out) && (pfile_in_zip_read_info->rest_read_compressed == 0)) flush = Z_FINISH; */ err=inflate(&pfile_in_zip_read_info->stream,flush); if ((err>=0) && (pfile_in_zip_read_info->stream.msg!=NULL)) err = Z_DATA_ERROR; uTotalOutAfter = pfile_in_zip_read_info->stream.total_out; /* Detect overflow, because z_stream.total_out is uLong (32 bits) */ if (uTotalOutAftertotal_out_64 = pfile_in_zip_read_info->total_out_64 + uOutThis; pfile_in_zip_read_info->crc32 = crc32(pfile_in_zip_read_info->crc32,bufBefore, (uInt)(uOutThis)); pfile_in_zip_read_info->rest_read_uncompressed -= uOutThis; iRead += (uInt)(uTotalOutAfter - uTotalOutBefore); if (err==Z_STREAM_END) return (iRead==0) ? UNZ_EOF : (int)iRead; if (err!=Z_OK) break; } } if (err==Z_OK) return (int)iRead; return err; } /* Give the current position in uncompressed data */ extern z_off_t ZEXPORT unztell(unzFile file) { unz64_s* s; file_in_zip64_read_info_s* pfile_in_zip_read_info; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; pfile_in_zip_read_info=s->pfile_in_zip_read; if (pfile_in_zip_read_info==NULL) return UNZ_PARAMERROR; return (z_off_t)pfile_in_zip_read_info->stream.total_out; } extern ZPOS64_T ZEXPORT unztell64(unzFile file) { unz64_s* s; file_in_zip64_read_info_s* pfile_in_zip_read_info; if (file==NULL) return (ZPOS64_T)-1; s=(unz64_s*)file; pfile_in_zip_read_info=s->pfile_in_zip_read; if (pfile_in_zip_read_info==NULL) return (ZPOS64_T)-1; return pfile_in_zip_read_info->total_out_64; } /* return 1 if the end of file was reached, 0 elsewhere */ extern int ZEXPORT unzeof(unzFile file) { unz64_s* s; file_in_zip64_read_info_s* pfile_in_zip_read_info; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; pfile_in_zip_read_info=s->pfile_in_zip_read; if (pfile_in_zip_read_info==NULL) return UNZ_PARAMERROR; if (pfile_in_zip_read_info->rest_read_uncompressed == 0) return 1; else return 0; } /* Read extra field from the current file (opened by unzOpenCurrentFile) This is the local-header version of the extra field (sometimes, there is more info in the local-header version than in the central-header) if buf==NULL, it return the size of the local extra field that can be read if buf!=NULL, len is the size of the buffer, the extra header is copied in buf. the return value is the number of bytes copied in buf, or (if <0) the error code */ extern int ZEXPORT unzGetLocalExtrafield(unzFile file, voidp buf, unsigned len) { unz64_s* s; file_in_zip64_read_info_s* pfile_in_zip_read_info; uInt read_now; ZPOS64_T size_to_read; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; pfile_in_zip_read_info=s->pfile_in_zip_read; if (pfile_in_zip_read_info==NULL) return UNZ_PARAMERROR; size_to_read = (pfile_in_zip_read_info->size_local_extrafield - pfile_in_zip_read_info->pos_local_extrafield); if (buf==NULL) return (int)size_to_read; if (len>size_to_read) read_now = (uInt)size_to_read; else read_now = (uInt)len ; if (read_now==0) return 0; if (ZSEEK64(pfile_in_zip_read_info->z_filefunc, pfile_in_zip_read_info->filestream, pfile_in_zip_read_info->offset_local_extrafield + pfile_in_zip_read_info->pos_local_extrafield, ZLIB_FILEFUNC_SEEK_SET)!=0) return UNZ_ERRNO; if (ZREAD64(pfile_in_zip_read_info->z_filefunc, pfile_in_zip_read_info->filestream, buf,read_now)!=read_now) return UNZ_ERRNO; return (int)read_now; } /* Close the file in zip opened with unzOpenCurrentFile Return UNZ_CRCERROR if all the file was read but the CRC is not good */ extern int ZEXPORT unzCloseCurrentFile(unzFile file) { int err=UNZ_OK; unz64_s* s; file_in_zip64_read_info_s* pfile_in_zip_read_info; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; pfile_in_zip_read_info=s->pfile_in_zip_read; if (pfile_in_zip_read_info==NULL) return UNZ_PARAMERROR; if ((pfile_in_zip_read_info->rest_read_uncompressed == 0) && (!pfile_in_zip_read_info->raw)) { if (pfile_in_zip_read_info->crc32 != pfile_in_zip_read_info->crc32_wait) err=UNZ_CRCERROR; } free(pfile_in_zip_read_info->read_buffer); pfile_in_zip_read_info->read_buffer = NULL; if (pfile_in_zip_read_info->stream_initialised == Z_DEFLATED) inflateEnd(&pfile_in_zip_read_info->stream); #ifdef HAVE_BZIP2 else if (pfile_in_zip_read_info->stream_initialised == Z_BZIP2ED) BZ2_bzDecompressEnd(&pfile_in_zip_read_info->bstream); #endif pfile_in_zip_read_info->stream_initialised = 0; free(pfile_in_zip_read_info); s->pfile_in_zip_read=NULL; return err; } /* Get the global comment string of the ZipFile, in the szComment buffer. uSizeBuf is the size of the szComment buffer. return the number of byte copied or an error code <0 */ extern int ZEXPORT unzGetGlobalComment(unzFile file, char * szComment, uLong uSizeBuf) { unz64_s* s; uLong uReadThis ; if (file==NULL) return (int)UNZ_PARAMERROR; s=(unz64_s*)file; uReadThis = uSizeBuf; if (uReadThis>s->gi.size_comment) uReadThis = s->gi.size_comment; if (ZSEEK64(s->z_filefunc,s->filestream,s->central_pos+22,ZLIB_FILEFUNC_SEEK_SET)!=0) return UNZ_ERRNO; if (uReadThis>0) { *szComment='\0'; if (ZREAD64(s->z_filefunc,s->filestream,szComment,uReadThis)!=uReadThis) return UNZ_ERRNO; } if ((szComment != NULL) && (uSizeBuf > s->gi.size_comment)) *(szComment+s->gi.size_comment)='\0'; return (int)uReadThis; } /* Additions by RX '2004 */ extern ZPOS64_T ZEXPORT unzGetOffset64(unzFile file) { unz64_s* s; if (file==NULL) return 0; //UNZ_PARAMERROR; s=(unz64_s*)file; if (!s->current_file_ok) return 0; if (s->gi.number_entry != 0 && s->gi.number_entry != 0xffff) if (s->num_file==s->gi.number_entry) return 0; return s->pos_in_central_dir; } extern uLong ZEXPORT unzGetOffset(unzFile file) { ZPOS64_T offset64; if (file==NULL) return 0; //UNZ_PARAMERROR; offset64 = unzGetOffset64(file); return (uLong)offset64; } extern int ZEXPORT unzSetOffset64(unzFile file, ZPOS64_T pos) { unz64_s* s; int err; if (file==NULL) return UNZ_PARAMERROR; s=(unz64_s*)file; s->pos_in_central_dir = pos; s->num_file = s->gi.number_entry; /* hack */ err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info, &s->cur_file_info_internal, NULL,0,NULL,0,NULL,0); s->current_file_ok = (err == UNZ_OK); return err; } extern int ZEXPORT unzSetOffset (unzFile file, uLong pos) { return unzSetOffset64(file,pos); } tcl8.6.14/compat/zlib/contrib/minizip/mztools.c0000644000175000017500000001763314554262142021071 0ustar sergeisergei/* Additional tools for Minizip Code: Xavier Roche '2004 License: Same as ZLIB (www.gzip.org) */ /* Code */ #include #include #include #include "zlib.h" #include "unzip.h" #define READ_8(adr) ((unsigned char)*(adr)) #define READ_16(adr) ( READ_8(adr) | (READ_8(adr+1) << 8) ) #define READ_32(adr) ( READ_16(adr) | (READ_16((adr)+2) << 16) ) #define WRITE_8(buff, n) do { \ *((unsigned char*)(buff)) = (unsigned char) ((n) & 0xff); \ } while(0) #define WRITE_16(buff, n) do { \ WRITE_8((unsigned char*)(buff), n); \ WRITE_8(((unsigned char*)(buff)) + 1, (n) >> 8); \ } while(0) #define WRITE_32(buff, n) do { \ WRITE_16((unsigned char*)(buff), (n) & 0xffff); \ WRITE_16((unsigned char*)(buff) + 2, (n) >> 16); \ } while(0) extern int ZEXPORT unzRepair(const char* file, const char* fileOut, const char* fileOutTmp, uLong* nRecovered, uLong* bytesRecovered) { int err = Z_OK; FILE* fpZip = fopen(file, "rb"); FILE* fpOut = fopen(fileOut, "wb"); FILE* fpOutCD = fopen(fileOutTmp, "wb"); if (fpZip != NULL && fpOut != NULL) { int entries = 0; uLong totalBytes = 0; char header[30]; char filename[1024]; char extra[1024]; int offset = 0; int offsetCD = 0; while ( fread(header, 1, 30, fpZip) == 30 ) { int currentOffset = offset; /* File entry */ if (READ_32(header) == 0x04034b50) { unsigned int version = READ_16(header + 4); unsigned int gpflag = READ_16(header + 6); unsigned int method = READ_16(header + 8); unsigned int filetime = READ_16(header + 10); unsigned int filedate = READ_16(header + 12); unsigned int crc = READ_32(header + 14); /* crc */ unsigned int cpsize = READ_32(header + 18); /* compressed size */ unsigned int uncpsize = READ_32(header + 22); /* uncompressed sz */ unsigned int fnsize = READ_16(header + 26); /* file name length */ unsigned int extsize = READ_16(header + 28); /* extra field length */ filename[0] = extra[0] = '\0'; /* Header */ if (fwrite(header, 1, 30, fpOut) == 30) { offset += 30; } else { err = Z_ERRNO; break; } /* Filename */ if (fnsize > 0) { if (fnsize < sizeof(filename)) { if (fread(filename, 1, fnsize, fpZip) == fnsize) { if (fwrite(filename, 1, fnsize, fpOut) == fnsize) { offset += fnsize; } else { err = Z_ERRNO; break; } } else { err = Z_ERRNO; break; } } else { err = Z_ERRNO; break; } } else { err = Z_STREAM_ERROR; break; } /* Extra field */ if (extsize > 0) { if (extsize < sizeof(extra)) { if (fread(extra, 1, extsize, fpZip) == extsize) { if (fwrite(extra, 1, extsize, fpOut) == extsize) { offset += extsize; } else { err = Z_ERRNO; break; } } else { err = Z_ERRNO; break; } } else { err = Z_ERRNO; break; } } /* Data */ { int dataSize = cpsize; if (dataSize == 0) { dataSize = uncpsize; } if (dataSize > 0) { char* data = malloc(dataSize); if (data != NULL) { if ((int)fread(data, 1, dataSize, fpZip) == dataSize) { if ((int)fwrite(data, 1, dataSize, fpOut) == dataSize) { offset += dataSize; totalBytes += dataSize; } else { err = Z_ERRNO; } } else { err = Z_ERRNO; } free(data); if (err != Z_OK) { break; } } else { err = Z_MEM_ERROR; break; } } } /* Central directory entry */ { char header[46]; char* comment = ""; int comsize = (int) strlen(comment); WRITE_32(header, 0x02014b50); WRITE_16(header + 4, version); WRITE_16(header + 6, version); WRITE_16(header + 8, gpflag); WRITE_16(header + 10, method); WRITE_16(header + 12, filetime); WRITE_16(header + 14, filedate); WRITE_32(header + 16, crc); WRITE_32(header + 20, cpsize); WRITE_32(header + 24, uncpsize); WRITE_16(header + 28, fnsize); WRITE_16(header + 30, extsize); WRITE_16(header + 32, comsize); WRITE_16(header + 34, 0); /* disk # */ WRITE_16(header + 36, 0); /* int attrb */ WRITE_32(header + 38, 0); /* ext attrb */ WRITE_32(header + 42, currentOffset); /* Header */ if (fwrite(header, 1, 46, fpOutCD) == 46) { offsetCD += 46; /* Filename */ if (fnsize > 0) { if (fwrite(filename, 1, fnsize, fpOutCD) == fnsize) { offsetCD += fnsize; } else { err = Z_ERRNO; break; } } else { err = Z_STREAM_ERROR; break; } /* Extra field */ if (extsize > 0) { if (fwrite(extra, 1, extsize, fpOutCD) == extsize) { offsetCD += extsize; } else { err = Z_ERRNO; break; } } /* Comment field */ if (comsize > 0) { if ((int)fwrite(comment, 1, comsize, fpOutCD) == comsize) { offsetCD += comsize; } else { err = Z_ERRNO; break; } } } else { err = Z_ERRNO; break; } } /* Success */ entries++; } else { break; } } /* Final central directory */ { int entriesZip = entries; char header[22]; char* comment = ""; // "ZIP File recovered by zlib/minizip/mztools"; int comsize = (int) strlen(comment); if (entriesZip > 0xffff) { entriesZip = 0xffff; } WRITE_32(header, 0x06054b50); WRITE_16(header + 4, 0); /* disk # */ WRITE_16(header + 6, 0); /* disk # */ WRITE_16(header + 8, entriesZip); /* hack */ WRITE_16(header + 10, entriesZip); /* hack */ WRITE_32(header + 12, offsetCD); /* size of CD */ WRITE_32(header + 16, offset); /* offset to CD */ WRITE_16(header + 20, comsize); /* comment */ /* Header */ if (fwrite(header, 1, 22, fpOutCD) == 22) { /* Comment field */ if (comsize > 0) { if ((int)fwrite(comment, 1, comsize, fpOutCD) != comsize) { err = Z_ERRNO; } } } else { err = Z_ERRNO; } } /* Final merge (file + central directory) */ fclose(fpOutCD); if (err == Z_OK) { fpOutCD = fopen(fileOutTmp, "rb"); if (fpOutCD != NULL) { int nRead; char buffer[8192]; while ( (nRead = (int)fread(buffer, 1, sizeof(buffer), fpOutCD)) > 0) { if ((int)fwrite(buffer, 1, nRead, fpOut) != nRead) { err = Z_ERRNO; break; } } fclose(fpOutCD); } } /* Close */ fclose(fpZip); fclose(fpOut); /* Wipe temporary file */ (void)remove(fileOutTmp); /* Number of recovered entries */ if (err == Z_OK) { if (nRecovered != NULL) { *nRecovered = entries; } if (bytesRecovered != NULL) { *bytesRecovered = totalBytes; } } } else { err = Z_STREAM_ERROR; } return err; } tcl8.6.14/compat/zlib/contrib/minizip/unzip.h0000644000175000017500000004010014560736523020523 0ustar sergeisergei/* unzip.h -- IO for uncompress .zip files using zlib Version 1.1, February 14h, 2010 part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications of Unzip for Zip64 Copyright (C) 2007-2008 Even Rouault Modifications for Zip64 support on both zip and unzip Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) For more info read MiniZip_info.txt --------------------------------------------------------------------------------- Condition of use and distribution are the same than zlib : This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. --------------------------------------------------------------------------------- Changes See header of unzip64.c */ #ifndef _unz64_H #define _unz64_H #ifdef __cplusplus extern "C" { #endif #ifndef _ZLIB_H #include "zlib.h" #endif #ifndef _ZLIBIOAPI_H #include "ioapi.h" #endif #ifdef HAVE_BZIP2 #include "bzlib.h" #endif #define Z_BZIP2ED 12 #if defined(STRICTUNZIP) || defined(STRICTZIPUNZIP) /* like the STRICT of WIN32, we define a pointer that cannot be converted from (void*) without cast */ typedef struct TagunzFile__ { int unused; } unzFile__; typedef unzFile__ *unzFile; #else typedef voidp unzFile; #endif #define UNZ_OK (0) #define UNZ_END_OF_LIST_OF_FILE (-100) #define UNZ_ERRNO (Z_ERRNO) #define UNZ_EOF (0) #define UNZ_PARAMERROR (-102) #define UNZ_BADZIPFILE (-103) #define UNZ_INTERNALERROR (-104) #define UNZ_CRCERROR (-105) /* tm_unz contain date/time info */ typedef struct tm_unz_s { int tm_sec; /* seconds after the minute - [0,59] */ int tm_min; /* minutes after the hour - [0,59] */ int tm_hour; /* hours since midnight - [0,23] */ int tm_mday; /* day of the month - [1,31] */ int tm_mon; /* months since January - [0,11] */ int tm_year; /* years - [1980..2044] */ } tm_unz; /* unz_global_info structure contain global data about the ZIPfile These data comes from the end of central dir */ typedef struct unz_global_info64_s { ZPOS64_T number_entry; /* total number of entries in the central dir on this disk */ uLong size_comment; /* size of the global comment of the zipfile */ } unz_global_info64; typedef struct unz_global_info_s { uLong number_entry; /* total number of entries in the central dir on this disk */ uLong size_comment; /* size of the global comment of the zipfile */ } unz_global_info; /* unz_file_info contain information about a file in the zipfile */ typedef struct unz_file_info64_s { uLong version; /* version made by 2 bytes */ uLong version_needed; /* version needed to extract 2 bytes */ uLong flag; /* general purpose bit flag 2 bytes */ uLong compression_method; /* compression method 2 bytes */ uLong dosDate; /* last mod file date in Dos fmt 4 bytes */ uLong crc; /* crc-32 4 bytes */ ZPOS64_T compressed_size; /* compressed size 8 bytes */ ZPOS64_T uncompressed_size; /* uncompressed size 8 bytes */ uLong size_filename; /* filename length 2 bytes */ uLong size_file_extra; /* extra field length 2 bytes */ uLong size_file_comment; /* file comment length 2 bytes */ uLong disk_num_start; /* disk number start 2 bytes */ uLong internal_fa; /* internal file attributes 2 bytes */ uLong external_fa; /* external file attributes 4 bytes */ tm_unz tmu_date; } unz_file_info64; typedef struct unz_file_info_s { uLong version; /* version made by 2 bytes */ uLong version_needed; /* version needed to extract 2 bytes */ uLong flag; /* general purpose bit flag 2 bytes */ uLong compression_method; /* compression method 2 bytes */ uLong dosDate; /* last mod file date in Dos fmt 4 bytes */ uLong crc; /* crc-32 4 bytes */ uLong compressed_size; /* compressed size 4 bytes */ uLong uncompressed_size; /* uncompressed size 4 bytes */ uLong size_filename; /* filename length 2 bytes */ uLong size_file_extra; /* extra field length 2 bytes */ uLong size_file_comment; /* file comment length 2 bytes */ uLong disk_num_start; /* disk number start 2 bytes */ uLong internal_fa; /* internal file attributes 2 bytes */ uLong external_fa; /* external file attributes 4 bytes */ tm_unz tmu_date; } unz_file_info; extern int ZEXPORT unzStringFileNameCompare(const char* fileName1, const char* fileName2, int iCaseSensitivity); /* Compare two filenames (fileName1,fileName2). If iCaseSensitivity = 1, comparison is case sensitive (like strcmp) If iCaseSensitivity = 2, comparison is not case sensitive (like strcmpi or strcasecmp) If iCaseSensitivity = 0, case sensitivity is default of your operating system (like 1 on Unix, 2 on Windows) */ extern unzFile ZEXPORT unzOpen(const char *path); extern unzFile ZEXPORT unzOpen64(const void *path); /* Open a Zip file. path contain the full pathname (by example, on a Windows XP computer "c:\\zlib\\zlib113.zip" or on an Unix computer "zlib/zlib113.zip". If the zipfile cannot be opened (file don't exist or in not valid), the return value is NULL. Else, the return value is a unzFile Handle, usable with other function of this unzip package. the "64" function take a const void* pointer, because the path is just the value passed to the open64_file_func callback. Under Windows, if UNICODE is defined, using fill_fopen64_filefunc, the path is a pointer to a wide unicode string (LPCTSTR is LPCWSTR), so const char* does not describe the reality */ extern unzFile ZEXPORT unzOpen2(const char *path, zlib_filefunc_def* pzlib_filefunc_def); /* Open a Zip file, like unzOpen, but provide a set of file low level API for read/write the zip file (see ioapi.h) */ extern unzFile ZEXPORT unzOpen2_64(const void *path, zlib_filefunc64_def* pzlib_filefunc_def); /* Open a Zip file, like unz64Open, but provide a set of file low level API for read/write the zip file (see ioapi.h) */ extern int ZEXPORT unzClose(unzFile file); /* Close a ZipFile opened with unzOpen. If there is files inside the .Zip opened with unzOpenCurrentFile (see later), these files MUST be closed with unzCloseCurrentFile before call unzClose. return UNZ_OK if there is no problem. */ extern int ZEXPORT unzGetGlobalInfo(unzFile file, unz_global_info *pglobal_info); extern int ZEXPORT unzGetGlobalInfo64(unzFile file, unz_global_info64 *pglobal_info); /* Write info about the ZipFile in the *pglobal_info structure. No preparation of the structure is needed return UNZ_OK if there is no problem. */ extern int ZEXPORT unzGetGlobalComment(unzFile file, char *szComment, uLong uSizeBuf); /* Get the global comment string of the ZipFile, in the szComment buffer. uSizeBuf is the size of the szComment buffer. return the number of byte copied or an error code <0 */ /***************************************************************************/ /* Unzip package allow you browse the directory of the zipfile */ extern int ZEXPORT unzGoToFirstFile(unzFile file); /* Set the current file of the zipfile to the first file. return UNZ_OK if there is no problem */ extern int ZEXPORT unzGoToNextFile(unzFile file); /* Set the current file of the zipfile to the next file. return UNZ_OK if there is no problem return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest. */ extern int ZEXPORT unzLocateFile(unzFile file, const char *szFileName, int iCaseSensitivity); /* Try locate the file szFileName in the zipfile. For the iCaseSensitivity signification, see unzStringFileNameCompare return value : UNZ_OK if the file is found. It becomes the current file. UNZ_END_OF_LIST_OF_FILE if the file is not found */ /* ****************************************** */ /* Ryan supplied functions */ /* unz_file_info contain information about a file in the zipfile */ typedef struct unz_file_pos_s { uLong pos_in_zip_directory; /* offset in zip file directory */ uLong num_of_file; /* # of file */ } unz_file_pos; extern int ZEXPORT unzGetFilePos( unzFile file, unz_file_pos* file_pos); extern int ZEXPORT unzGoToFilePos( unzFile file, unz_file_pos* file_pos); typedef struct unz64_file_pos_s { ZPOS64_T pos_in_zip_directory; /* offset in zip file directory */ ZPOS64_T num_of_file; /* # of file */ } unz64_file_pos; extern int ZEXPORT unzGetFilePos64( unzFile file, unz64_file_pos* file_pos); extern int ZEXPORT unzGoToFilePos64( unzFile file, const unz64_file_pos* file_pos); /* ****************************************** */ extern int ZEXPORT unzGetCurrentFileInfo64(unzFile file, unz_file_info64 *pfile_info, char *szFileName, uLong fileNameBufferSize, void *extraField, uLong extraFieldBufferSize, char *szComment, uLong commentBufferSize); extern int ZEXPORT unzGetCurrentFileInfo(unzFile file, unz_file_info *pfile_info, char *szFileName, uLong fileNameBufferSize, void *extraField, uLong extraFieldBufferSize, char *szComment, uLong commentBufferSize); /* Get Info about the current file if pfile_info!=NULL, the *pfile_info structure will contain some info about the current file if szFileName!=NULL, the filename string will be copied in szFileName (fileNameBufferSize is the size of the buffer) if extraField!=NULL, the extra field information will be copied in extraField (extraFieldBufferSize is the size of the buffer). This is the Central-header version of the extra field if szComment!=NULL, the comment string of the file will be copied in szComment (commentBufferSize is the size of the buffer) */ /** Addition for GDAL : START */ extern ZPOS64_T ZEXPORT unzGetCurrentFileZStreamPos64(unzFile file); /** Addition for GDAL : END */ /***************************************************************************/ /* for reading the content of the current zipfile, you can open it, read data from it, and close it (you can close it before reading all the file) */ extern int ZEXPORT unzOpenCurrentFile(unzFile file); /* Open for reading data the current file in the zipfile. If there is no error, the return value is UNZ_OK. */ extern int ZEXPORT unzOpenCurrentFilePassword(unzFile file, const char* password); /* Open for reading data the current file in the zipfile. password is a crypting password If there is no error, the return value is UNZ_OK. */ extern int ZEXPORT unzOpenCurrentFile2(unzFile file, int* method, int* level, int raw); /* Same than unzOpenCurrentFile, but open for read raw the file (not uncompress) if raw==1 *method will receive method of compression, *level will receive level of compression note : you can set level parameter as NULL (if you did not want known level, but you CANNOT set method parameter as NULL */ extern int ZEXPORT unzOpenCurrentFile3(unzFile file, int* method, int* level, int raw, const char* password); /* Same than unzOpenCurrentFile, but open for read raw the file (not uncompress) if raw==1 *method will receive method of compression, *level will receive level of compression note : you can set level parameter as NULL (if you did not want known level, but you CANNOT set method parameter as NULL */ extern int ZEXPORT unzCloseCurrentFile(unzFile file); /* Close the file in zip opened with unzOpenCurrentFile Return UNZ_CRCERROR if all the file was read but the CRC is not good */ extern int ZEXPORT unzReadCurrentFile(unzFile file, voidp buf, unsigned len); /* Read bytes from the current file (opened by unzOpenCurrentFile) buf contain buffer where data must be copied len the size of buf. return the number of byte copied if some bytes are copied return 0 if the end of file was reached return <0 with error code if there is an error (UNZ_ERRNO for IO error, or zLib error for uncompress error) */ extern z_off_t ZEXPORT unztell(unzFile file); extern ZPOS64_T ZEXPORT unztell64(unzFile file); /* Give the current position in uncompressed data */ extern int ZEXPORT unzeof(unzFile file); /* return 1 if the end of file was reached, 0 elsewhere */ extern int ZEXPORT unzGetLocalExtrafield(unzFile file, voidp buf, unsigned len); /* Read extra field from the current file (opened by unzOpenCurrentFile) This is the local-header version of the extra field (sometimes, there is more info in the local-header version than in the central-header) if buf==NULL, it return the size of the local extra field if buf!=NULL, len is the size of the buffer, the extra header is copied in buf. the return value is the number of bytes copied in buf, or (if <0) the error code */ /***************************************************************************/ /* Get the current file offset */ extern ZPOS64_T ZEXPORT unzGetOffset64 (unzFile file); extern uLong ZEXPORT unzGetOffset (unzFile file); /* Set the current file offset */ extern int ZEXPORT unzSetOffset64 (unzFile file, ZPOS64_T pos); extern int ZEXPORT unzSetOffset (unzFile file, uLong pos); #ifdef __cplusplus } #endif #endif /* _unz64_H */ tcl8.6.14/compat/zlib/contrib/minizip/ioapi.c0000644000175000017500000001740714554262142020462 0ustar sergeisergei/* ioapi.h -- IO base function header for compress/uncompress .zip part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications for Zip64 support Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) For more info read MiniZip_info.txt */ #if defined(_WIN32) && (!(defined(_CRT_SECURE_NO_WARNINGS))) #define _CRT_SECURE_NO_WARNINGS #endif #if defined(_WIN32) #define FOPEN_FUNC(filename, mode) fopen(filename, mode) #define FTELLO_FUNC(stream) _ftelli64(stream) #define FSEEKO_FUNC(stream, offset, origin) _fseeki64(stream, offset, origin) #elif defined(__APPLE__) || defined(IOAPI_NO_64) || defined(__HAIKU__) || defined(MINIZIP_FOPEN_NO_64) // In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions #define FOPEN_FUNC(filename, mode) fopen(filename, mode) #define FTELLO_FUNC(stream) ftello(stream) #define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin) #else #define FOPEN_FUNC(filename, mode) fopen64(filename, mode) #define FTELLO_FUNC(stream) ftello64(stream) #define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin) #endif #include "ioapi.h" voidpf call_zopen64 (const zlib_filefunc64_32_def* pfilefunc, const void*filename, int mode) { if (pfilefunc->zfile_func64.zopen64_file != NULL) return (*(pfilefunc->zfile_func64.zopen64_file)) (pfilefunc->zfile_func64.opaque,filename,mode); else { return (*(pfilefunc->zopen32_file))(pfilefunc->zfile_func64.opaque,(const char*)filename,mode); } } long call_zseek64 (const zlib_filefunc64_32_def* pfilefunc,voidpf filestream, ZPOS64_T offset, int origin) { if (pfilefunc->zfile_func64.zseek64_file != NULL) return (*(pfilefunc->zfile_func64.zseek64_file)) (pfilefunc->zfile_func64.opaque,filestream,offset,origin); else { uLong offsetTruncated = (uLong)offset; if (offsetTruncated != offset) return -1; else return (*(pfilefunc->zseek32_file))(pfilefunc->zfile_func64.opaque,filestream,offsetTruncated,origin); } } ZPOS64_T call_ztell64 (const zlib_filefunc64_32_def* pfilefunc, voidpf filestream) { if (pfilefunc->zfile_func64.zseek64_file != NULL) return (*(pfilefunc->zfile_func64.ztell64_file)) (pfilefunc->zfile_func64.opaque,filestream); else { uLong tell_uLong = (uLong)(*(pfilefunc->ztell32_file))(pfilefunc->zfile_func64.opaque,filestream); if ((tell_uLong) == MAXU32) return (ZPOS64_T)-1; else return tell_uLong; } } void fill_zlib_filefunc64_32_def_from_filefunc32(zlib_filefunc64_32_def* p_filefunc64_32, const zlib_filefunc_def* p_filefunc32) { p_filefunc64_32->zfile_func64.zopen64_file = NULL; p_filefunc64_32->zopen32_file = p_filefunc32->zopen_file; p_filefunc64_32->zfile_func64.zread_file = p_filefunc32->zread_file; p_filefunc64_32->zfile_func64.zwrite_file = p_filefunc32->zwrite_file; p_filefunc64_32->zfile_func64.ztell64_file = NULL; p_filefunc64_32->zfile_func64.zseek64_file = NULL; p_filefunc64_32->zfile_func64.zclose_file = p_filefunc32->zclose_file; p_filefunc64_32->zfile_func64.zerror_file = p_filefunc32->zerror_file; p_filefunc64_32->zfile_func64.opaque = p_filefunc32->opaque; p_filefunc64_32->zseek32_file = p_filefunc32->zseek_file; p_filefunc64_32->ztell32_file = p_filefunc32->ztell_file; } static voidpf ZCALLBACK fopen_file_func(voidpf opaque, const char* filename, int mode) { FILE* file = NULL; const char* mode_fopen = NULL; (void)opaque; if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ) mode_fopen = "rb"; else if (mode & ZLIB_FILEFUNC_MODE_EXISTING) mode_fopen = "r+b"; else if (mode & ZLIB_FILEFUNC_MODE_CREATE) mode_fopen = "wb"; if ((filename!=NULL) && (mode_fopen != NULL)) file = fopen(filename, mode_fopen); return file; } static voidpf ZCALLBACK fopen64_file_func(voidpf opaque, const void* filename, int mode) { FILE* file = NULL; const char* mode_fopen = NULL; (void)opaque; if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ) mode_fopen = "rb"; else if (mode & ZLIB_FILEFUNC_MODE_EXISTING) mode_fopen = "r+b"; else if (mode & ZLIB_FILEFUNC_MODE_CREATE) mode_fopen = "wb"; if ((filename!=NULL) && (mode_fopen != NULL)) file = FOPEN_FUNC((const char*)filename, mode_fopen); return file; } static uLong ZCALLBACK fread_file_func(voidpf opaque, voidpf stream, void* buf, uLong size) { uLong ret; (void)opaque; ret = (uLong)fread(buf, 1, (size_t)size, (FILE *)stream); return ret; } static uLong ZCALLBACK fwrite_file_func(voidpf opaque, voidpf stream, const void* buf, uLong size) { uLong ret; (void)opaque; ret = (uLong)fwrite(buf, 1, (size_t)size, (FILE *)stream); return ret; } static long ZCALLBACK ftell_file_func(voidpf opaque, voidpf stream) { long ret; (void)opaque; ret = ftell((FILE *)stream); return ret; } static ZPOS64_T ZCALLBACK ftell64_file_func(voidpf opaque, voidpf stream) { ZPOS64_T ret; (void)opaque; ret = (ZPOS64_T)FTELLO_FUNC((FILE *)stream); return ret; } static long ZCALLBACK fseek_file_func(voidpf opaque, voidpf stream, uLong offset, int origin) { int fseek_origin=0; long ret; (void)opaque; switch (origin) { case ZLIB_FILEFUNC_SEEK_CUR : fseek_origin = SEEK_CUR; break; case ZLIB_FILEFUNC_SEEK_END : fseek_origin = SEEK_END; break; case ZLIB_FILEFUNC_SEEK_SET : fseek_origin = SEEK_SET; break; default: return -1; } ret = 0; if (fseek((FILE *)stream, (long)offset, fseek_origin) != 0) ret = -1; return ret; } static long ZCALLBACK fseek64_file_func(voidpf opaque, voidpf stream, ZPOS64_T offset, int origin) { int fseek_origin=0; long ret; (void)opaque; switch (origin) { case ZLIB_FILEFUNC_SEEK_CUR : fseek_origin = SEEK_CUR; break; case ZLIB_FILEFUNC_SEEK_END : fseek_origin = SEEK_END; break; case ZLIB_FILEFUNC_SEEK_SET : fseek_origin = SEEK_SET; break; default: return -1; } ret = 0; if(FSEEKO_FUNC((FILE *)stream, (z_off64_t)offset, fseek_origin) != 0) ret = -1; return ret; } static int ZCALLBACK fclose_file_func(voidpf opaque, voidpf stream) { int ret; (void)opaque; ret = fclose((FILE *)stream); return ret; } static int ZCALLBACK ferror_file_func(voidpf opaque, voidpf stream) { int ret; (void)opaque; ret = ferror((FILE *)stream); return ret; } void fill_fopen_filefunc(zlib_filefunc_def* pzlib_filefunc_def) { pzlib_filefunc_def->zopen_file = fopen_file_func; pzlib_filefunc_def->zread_file = fread_file_func; pzlib_filefunc_def->zwrite_file = fwrite_file_func; pzlib_filefunc_def->ztell_file = ftell_file_func; pzlib_filefunc_def->zseek_file = fseek_file_func; pzlib_filefunc_def->zclose_file = fclose_file_func; pzlib_filefunc_def->zerror_file = ferror_file_func; pzlib_filefunc_def->opaque = NULL; } void fill_fopen64_filefunc(zlib_filefunc64_def* pzlib_filefunc_def) { pzlib_filefunc_def->zopen64_file = fopen64_file_func; pzlib_filefunc_def->zread_file = fread_file_func; pzlib_filefunc_def->zwrite_file = fwrite_file_func; pzlib_filefunc_def->ztell64_file = ftell64_file_func; pzlib_filefunc_def->zseek64_file = fseek64_file_func; pzlib_filefunc_def->zclose_file = fclose_file_func; pzlib_filefunc_def->zerror_file = ferror_file_func; pzlib_filefunc_def->opaque = NULL; } tcl8.6.14/compat/zlib/contrib/minizip/tinydir.h0000644000175000017500000004503414554262142021045 0ustar sergeisergei/* Copyright (c) 2013-2021, tinydir authors: - Cong Xu - Lautis Sun - Baudouin Feildel - Andargor All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef TINYDIR_H #define TINYDIR_H #ifdef __cplusplus extern "C" { #endif #if ((defined _UNICODE) && !(defined UNICODE)) #define UNICODE #endif #if ((defined UNICODE) && !(defined _UNICODE)) #define _UNICODE #endif #include #include #include #ifdef _MSC_VER # ifndef WIN32_LEAN_AND_MEAN # define WIN32_LEAN_AND_MEAN # endif # include # include # pragma warning(push) # pragma warning (disable : 4996) #else # include # include # include # include #endif #ifdef __MINGW32__ # include #endif /* types */ /* Windows UNICODE wide character support */ #if defined _MSC_VER || defined __MINGW32__ # define _tinydir_char_t TCHAR # define TINYDIR_STRING(s) _TEXT(s) # define _tinydir_strlen _tcslen # define _tinydir_strcpy _tcscpy # define _tinydir_strcat _tcscat # define _tinydir_strcmp _tcscmp # define _tinydir_strrchr _tcsrchr # define _tinydir_strncmp _tcsncmp #else # define _tinydir_char_t char # define TINYDIR_STRING(s) s # define _tinydir_strlen strlen # define _tinydir_strcpy strcpy # define _tinydir_strcat strcat # define _tinydir_strcmp strcmp # define _tinydir_strrchr strrchr # define _tinydir_strncmp strncmp #endif #if (defined _MSC_VER || defined __MINGW32__) # include # define _TINYDIR_PATH_MAX MAX_PATH #elif defined __linux__ # include # ifdef PATH_MAX # define _TINYDIR_PATH_MAX PATH_MAX # endif #elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__)) # include # if defined(BSD) # include # ifdef PATH_MAX # define _TINYDIR_PATH_MAX PATH_MAX # endif # endif #endif #ifndef _TINYDIR_PATH_MAX #define _TINYDIR_PATH_MAX 4096 #endif #ifdef _MSC_VER /* extra chars for the "\\*" mask */ # define _TINYDIR_PATH_EXTRA 2 #else # define _TINYDIR_PATH_EXTRA 0 #endif #define _TINYDIR_FILENAME_MAX 256 #if (defined _MSC_VER || defined __MINGW32__) #define _TINYDIR_DRIVE_MAX 3 #endif #ifdef _MSC_VER # define _TINYDIR_FUNC static __inline #elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # define _TINYDIR_FUNC static __inline__ #elif defined(__cplusplus) # define _TINYDIR_FUNC static inline #elif defined(__GNUC__) /* Suppress unused function warning */ # define _TINYDIR_FUNC __attribute__((unused)) static #else # define _TINYDIR_FUNC static #endif /* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */ #ifdef TINYDIR_USE_READDIR_R /* readdir_r is a POSIX-only function, and may not be available under various * environments/settings, e.g. MinGW. Use readdir fallback */ #if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\ _POSIX_SOURCE # define _TINYDIR_HAS_READDIR_R #endif #if _POSIX_C_SOURCE >= 200112L # define _TINYDIR_HAS_FPATHCONF # include #endif #if _BSD_SOURCE || _SVID_SOURCE || \ (_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700) # define _TINYDIR_HAS_DIRFD # include #endif #if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\ defined _PC_NAME_MAX # define _TINYDIR_USE_FPATHCONF #endif #if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\ !(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX) # define _TINYDIR_USE_READDIR #endif /* Use readdir by default */ #else # define _TINYDIR_USE_READDIR #endif /* MINGW32 has two versions of dirent, ASCII and UNICODE*/ #ifndef _MSC_VER #if (defined __MINGW32__) && (defined _UNICODE) #define _TINYDIR_DIR _WDIR #define _tinydir_dirent _wdirent #define _tinydir_opendir _wopendir #define _tinydir_readdir _wreaddir #define _tinydir_closedir _wclosedir #else #define _TINYDIR_DIR DIR #define _tinydir_dirent dirent #define _tinydir_opendir opendir #define _tinydir_readdir readdir #define _tinydir_closedir closedir #endif #endif /* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */ #if defined(_TINYDIR_MALLOC) && defined(_TINYDIR_FREE) #elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE) #else #error "Either define both alloc and free or none of them!" #endif #if !defined(_TINYDIR_MALLOC) #define _TINYDIR_MALLOC(_size) malloc(_size) #define _TINYDIR_FREE(_ptr) free(_ptr) #endif /* !defined(_TINYDIR_MALLOC) */ typedef struct tinydir_file { _tinydir_char_t path[_TINYDIR_PATH_MAX]; _tinydir_char_t name[_TINYDIR_FILENAME_MAX]; _tinydir_char_t *extension; int is_dir; int is_reg; #ifndef _MSC_VER #ifdef __MINGW32__ struct _stat _s; #else struct stat _s; #endif #endif } tinydir_file; typedef struct tinydir_dir { _tinydir_char_t path[_TINYDIR_PATH_MAX]; int has_next; size_t n_files; tinydir_file *_files; #ifdef _MSC_VER HANDLE _h; WIN32_FIND_DATA _f; #else _TINYDIR_DIR *_d; struct _tinydir_dirent *_e; #ifndef _TINYDIR_USE_READDIR struct _tinydir_dirent *_ep; #endif #endif } tinydir_dir; /* declarations */ _TINYDIR_FUNC int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path); _TINYDIR_FUNC int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path); _TINYDIR_FUNC void tinydir_close(tinydir_dir *dir); _TINYDIR_FUNC int tinydir_next(tinydir_dir *dir); _TINYDIR_FUNC int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file); _TINYDIR_FUNC int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i); _TINYDIR_FUNC int tinydir_open_subdir_n(tinydir_dir *dir, size_t i); _TINYDIR_FUNC int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path); _TINYDIR_FUNC void _tinydir_get_ext(tinydir_file *file); _TINYDIR_FUNC int _tinydir_file_cmp(const void *a, const void *b); #ifndef _MSC_VER #ifndef _TINYDIR_USE_READDIR _TINYDIR_FUNC size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp); #endif #endif /* definitions*/ _TINYDIR_FUNC int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path) { #ifndef _MSC_VER #ifndef _TINYDIR_USE_READDIR int error; int size; /* using int size */ #endif #else _tinydir_char_t path_buf[_TINYDIR_PATH_MAX]; #endif _tinydir_char_t *pathp; if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0) { errno = EINVAL; return -1; } if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX) { errno = ENAMETOOLONG; return -1; } /* initialise dir */ dir->_files = NULL; #ifdef _MSC_VER dir->_h = INVALID_HANDLE_VALUE; #else dir->_d = NULL; #ifndef _TINYDIR_USE_READDIR dir->_ep = NULL; #endif #endif tinydir_close(dir); _tinydir_strcpy(dir->path, path); /* Remove trailing slashes */ pathp = &dir->path[_tinydir_strlen(dir->path) - 1]; while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/'))) { *pathp = TINYDIR_STRING('\0'); pathp++; } #ifdef _MSC_VER _tinydir_strcpy(path_buf, dir->path); _tinydir_strcat(path_buf, TINYDIR_STRING("\\*")); #if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP) dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0); #else dir->_h = FindFirstFile(path_buf, &dir->_f); #endif if (dir->_h == INVALID_HANDLE_VALUE) { errno = ENOENT; #else dir->_d = _tinydir_opendir(path); if (dir->_d == NULL) { #endif goto bail; } /* read first file */ dir->has_next = 1; #ifndef _MSC_VER #ifdef _TINYDIR_USE_READDIR dir->_e = _tinydir_readdir(dir->_d); #else /* allocate dirent buffer for readdir_r */ size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */ if (size == -1) return -1; dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size); if (dir->_ep == NULL) return -1; error = readdir_r(dir->_d, dir->_ep, &dir->_e); if (error != 0) return -1; #endif if (dir->_e == NULL) { dir->has_next = 0; } #endif return 0; bail: tinydir_close(dir); return -1; } _TINYDIR_FUNC int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path) { /* Count the number of files first, to pre-allocate the files array */ size_t n_files = 0; if (tinydir_open(dir, path) == -1) { return -1; } while (dir->has_next) { n_files++; if (tinydir_next(dir) == -1) { goto bail; } } tinydir_close(dir); if (n_files == 0 || tinydir_open(dir, path) == -1) { return -1; } dir->n_files = 0; dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files); if (dir->_files == NULL) { goto bail; } while (dir->has_next) { tinydir_file *p_file; dir->n_files++; p_file = &dir->_files[dir->n_files - 1]; if (tinydir_readfile(dir, p_file) == -1) { goto bail; } if (tinydir_next(dir) == -1) { goto bail; } /* Just in case the number of files has changed between the first and second reads, terminate without writing into unallocated memory */ if (dir->n_files == n_files) { break; } } qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp); return 0; bail: tinydir_close(dir); return -1; } _TINYDIR_FUNC void tinydir_close(tinydir_dir *dir) { if (dir == NULL) { return; } memset(dir->path, 0, sizeof(dir->path)); dir->has_next = 0; dir->n_files = 0; _TINYDIR_FREE(dir->_files); dir->_files = NULL; #ifdef _MSC_VER if (dir->_h != INVALID_HANDLE_VALUE) { FindClose(dir->_h); } dir->_h = INVALID_HANDLE_VALUE; #else if (dir->_d) { _tinydir_closedir(dir->_d); } dir->_d = NULL; dir->_e = NULL; #ifndef _TINYDIR_USE_READDIR _TINYDIR_FREE(dir->_ep); dir->_ep = NULL; #endif #endif } _TINYDIR_FUNC int tinydir_next(tinydir_dir *dir) { if (dir == NULL) { errno = EINVAL; return -1; } if (!dir->has_next) { errno = ENOENT; return -1; } #ifdef _MSC_VER if (FindNextFile(dir->_h, &dir->_f) == 0) #else #ifdef _TINYDIR_USE_READDIR dir->_e = _tinydir_readdir(dir->_d); #else if (dir->_ep == NULL) { return -1; } if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0) { return -1; } #endif if (dir->_e == NULL) #endif { dir->has_next = 0; #ifdef _MSC_VER if (GetLastError() != ERROR_SUCCESS && GetLastError() != ERROR_NO_MORE_FILES) { tinydir_close(dir); errno = EIO; return -1; } #endif } return 0; } _TINYDIR_FUNC int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file) { const _tinydir_char_t *filename; if (dir == NULL || file == NULL) { errno = EINVAL; return -1; } #ifdef _MSC_VER if (dir->_h == INVALID_HANDLE_VALUE) #else if (dir->_e == NULL) #endif { errno = ENOENT; return -1; } filename = #ifdef _MSC_VER dir->_f.cFileName; #else dir->_e->d_name; #endif if (_tinydir_strlen(dir->path) + _tinydir_strlen(filename) + 1 + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX) { /* the path for the file will be too long */ errno = ENAMETOOLONG; return -1; } if (_tinydir_strlen(filename) >= _TINYDIR_FILENAME_MAX) { errno = ENAMETOOLONG; return -1; } _tinydir_strcpy(file->path, dir->path); if (_tinydir_strcmp(dir->path, TINYDIR_STRING("/")) != 0) _tinydir_strcat(file->path, TINYDIR_STRING("/")); _tinydir_strcpy(file->name, filename); _tinydir_strcat(file->path, filename); #ifndef _MSC_VER #ifdef __MINGW32__ if (_tstat( #else if (stat( #endif file->path, &file->_s) == -1) { return -1; } #endif _tinydir_get_ext(file); file->is_dir = #ifdef _MSC_VER !!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY); #else S_ISDIR(file->_s.st_mode); #endif file->is_reg = #ifdef _MSC_VER !!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) || ( !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) && !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) && !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) && #ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) && #endif #ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) && #endif !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) && !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY)); #else S_ISREG(file->_s.st_mode); #endif return 0; } _TINYDIR_FUNC int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i) { if (dir == NULL || file == NULL) { errno = EINVAL; return -1; } if (i >= dir->n_files) { errno = ENOENT; return -1; } memcpy(file, &dir->_files[i], sizeof(tinydir_file)); _tinydir_get_ext(file); return 0; } _TINYDIR_FUNC int tinydir_open_subdir_n(tinydir_dir *dir, size_t i) { _tinydir_char_t path[_TINYDIR_PATH_MAX]; if (dir == NULL) { errno = EINVAL; return -1; } if (i >= dir->n_files || !dir->_files[i].is_dir) { errno = ENOENT; return -1; } _tinydir_strcpy(path, dir->_files[i].path); tinydir_close(dir); if (tinydir_open_sorted(dir, path) == -1) { return -1; } return 0; } /* Open a single file given its path */ _TINYDIR_FUNC int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path) { tinydir_dir dir; int result = 0; int found = 0; _tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX]; _tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX]; _tinydir_char_t *dir_name; _tinydir_char_t *base_name; #if (defined _MSC_VER || defined __MINGW32__) _tinydir_char_t drive_buf[_TINYDIR_PATH_MAX]; _tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX]; #endif if (file == NULL || path == NULL || _tinydir_strlen(path) == 0) { errno = EINVAL; return -1; } if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX) { errno = ENAMETOOLONG; return -1; } /* Get the parent path */ #if (defined _MSC_VER || defined __MINGW32__) #if ((defined _MSC_VER) && (_MSC_VER >= 1400)) errno = _tsplitpath_s( path, drive_buf, _TINYDIR_DRIVE_MAX, dir_name_buf, _TINYDIR_FILENAME_MAX, file_name_buf, _TINYDIR_FILENAME_MAX, ext_buf, _TINYDIR_FILENAME_MAX); #else _tsplitpath( path, drive_buf, dir_name_buf, file_name_buf, ext_buf); #endif if (errno) { return -1; } /* _splitpath_s not work fine with only filename and widechar support */ #ifdef _UNICODE if (drive_buf[0] == L'\xFEFE') drive_buf[0] = '\0'; if (dir_name_buf[0] == L'\xFEFE') dir_name_buf[0] = '\0'; #endif /* Emulate the behavior of dirname by returning "." for dir name if it's empty */ if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0') { _tinydir_strcpy(dir_name_buf, TINYDIR_STRING(".")); } /* Concatenate the drive letter and dir name to form full dir name */ _tinydir_strcat(drive_buf, dir_name_buf); dir_name = drive_buf; /* Concatenate the file name and extension to form base name */ _tinydir_strcat(file_name_buf, ext_buf); base_name = file_name_buf; #else _tinydir_strcpy(dir_name_buf, path); dir_name = dirname(dir_name_buf); _tinydir_strcpy(file_name_buf, path); base_name = basename(file_name_buf); #endif /* Special case: if the path is a root dir, open the parent dir as the file */ #if (defined _MSC_VER || defined __MINGW32__) if (_tinydir_strlen(base_name) == 0) #else if ((_tinydir_strcmp(base_name, TINYDIR_STRING("/"))) == 0) #endif { memset(file, 0, sizeof * file); file->is_dir = 1; file->is_reg = 0; _tinydir_strcpy(file->path, dir_name); file->extension = file->path + _tinydir_strlen(file->path); return 0; } /* Open the parent directory */ if (tinydir_open(&dir, dir_name) == -1) { return -1; } /* Read through the parent directory and look for the file */ while (dir.has_next) { if (tinydir_readfile(&dir, file) == -1) { result = -1; goto bail; } if (_tinydir_strcmp(file->name, base_name) == 0) { /* File found */ found = 1; break; } tinydir_next(&dir); } if (!found) { result = -1; errno = ENOENT; } bail: tinydir_close(&dir); return result; } _TINYDIR_FUNC void _tinydir_get_ext(tinydir_file *file) { _tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.')); if (period == NULL) { file->extension = &(file->name[_tinydir_strlen(file->name)]); } else { file->extension = period + 1; } } _TINYDIR_FUNC int _tinydir_file_cmp(const void *a, const void *b) { const tinydir_file *fa = (const tinydir_file *)a; const tinydir_file *fb = (const tinydir_file *)b; if (fa->is_dir != fb->is_dir) { return -(fa->is_dir - fb->is_dir); } return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX); } #ifndef _MSC_VER #ifndef _TINYDIR_USE_READDIR /* The following authored by Ben Hutchings from https://womble.decadent.org.uk/readdir_r-advisory.html */ /* Calculate the required buffer size (in bytes) for directory * * entries read from the given directory handle. Return -1 if this * * this cannot be done. * * * * This code does not trust values of NAME_MAX that are less than * * 255, since some systems (including at least HP-UX) incorrectly * * define it to be a smaller value. */ _TINYDIR_FUNC size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp) { long name_max; size_t name_end; /* parameter may be unused */ (void)dirp; #if defined _TINYDIR_USE_FPATHCONF name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX); if (name_max == -1) #if defined(NAME_MAX) name_max = (NAME_MAX > 255) ? NAME_MAX : 255; #else return (size_t)(-1); #endif #elif defined(NAME_MAX) name_max = (NAME_MAX > 255) ? NAME_MAX : 255; #else #error "buffer size for readdir_r cannot be determined" #endif name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1; return (name_end > sizeof(struct _tinydir_dirent) ? name_end : sizeof(struct _tinydir_dirent)); } #endif #endif #ifdef __cplusplus } #endif # if defined (_MSC_VER) # pragma warning(pop) # endif #endif tcl8.6.14/compat/zlib/contrib/minizip/iowin32.c0000644000175000017500000003266514554262142020656 0ustar sergeisergei/* iowin32.c -- IO base function header for compress/uncompress .zip Version 1.1, February 14h, 2010 part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications for Zip64 support Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) For more info read MiniZip_info.txt */ #include #include "zlib.h" #include "ioapi.h" #include "iowin32.h" #ifndef INVALID_HANDLE_VALUE #define INVALID_HANDLE_VALUE (0xFFFFFFFF) #endif #ifndef INVALID_SET_FILE_POINTER #define INVALID_SET_FILE_POINTER ((DWORD)-1) #endif // see Include/shared/winapifamily.h in the Windows Kit #if defined(WINAPI_FAMILY_PARTITION) && (!(defined(IOWIN32_USING_WINRT_API))) #if !defined(WINAPI_FAMILY_ONE_PARTITION) #define WINAPI_FAMILY_ONE_PARTITION(PartitionSet, Partition) ((WINAPI_FAMILY & PartitionSet) == Partition) #endif #if WINAPI_FAMILY_ONE_PARTITION(WINAPI_FAMILY, WINAPI_PARTITION_APP) #define IOWIN32_USING_WINRT_API 1 #endif #endif typedef struct { HANDLE hf; int error; } WIN32FILE_IOWIN; static void win32_translate_open_mode(int mode, DWORD* lpdwDesiredAccess, DWORD* lpdwCreationDisposition, DWORD* lpdwShareMode, DWORD* lpdwFlagsAndAttributes) { *lpdwDesiredAccess = *lpdwShareMode = *lpdwFlagsAndAttributes = *lpdwCreationDisposition = 0; if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ) { *lpdwDesiredAccess = GENERIC_READ; *lpdwCreationDisposition = OPEN_EXISTING; *lpdwShareMode = FILE_SHARE_READ; } else if (mode & ZLIB_FILEFUNC_MODE_EXISTING) { *lpdwDesiredAccess = GENERIC_WRITE | GENERIC_READ; *lpdwCreationDisposition = OPEN_EXISTING; } else if (mode & ZLIB_FILEFUNC_MODE_CREATE) { *lpdwDesiredAccess = GENERIC_WRITE | GENERIC_READ; *lpdwCreationDisposition = CREATE_ALWAYS; } } static voidpf win32_build_iowin(HANDLE hFile) { voidpf ret=NULL; if ((hFile != NULL) && (hFile != INVALID_HANDLE_VALUE)) { WIN32FILE_IOWIN w32fiow; w32fiow.hf = hFile; w32fiow.error = 0; ret = malloc(sizeof(WIN32FILE_IOWIN)); if (ret==NULL) CloseHandle(hFile); else *((WIN32FILE_IOWIN*)ret) = w32fiow; } return ret; } voidpf ZCALLBACK win32_open64_file_func(voidpf opaque, const void* filename, int mode) { const char* mode_fopen = NULL; DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ; HANDLE hFile = NULL; win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes); #ifdef IOWIN32_USING_WINRT_API #ifdef UNICODE if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFile2((LPCTSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); #else if ((filename!=NULL) && (dwDesiredAccess != 0)) { WCHAR filenameW[FILENAME_MAX + 0x200 + 1]; MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200); hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); } #endif #else if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFile((LPCTSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL); #endif return win32_build_iowin(hFile); } voidpf ZCALLBACK win32_open64_file_funcA(voidpf opaque, const void* filename, int mode) { const char* mode_fopen = NULL; DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ; HANDLE hFile = NULL; win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes); #ifdef IOWIN32_USING_WINRT_API if ((filename!=NULL) && (dwDesiredAccess != 0)) { WCHAR filenameW[FILENAME_MAX + 0x200 + 1]; MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200); hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); } #else if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFileA((LPCSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL); #endif return win32_build_iowin(hFile); } voidpf ZCALLBACK win32_open64_file_funcW(voidpf opaque, const void* filename, int mode) { const char* mode_fopen = NULL; DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ; HANDLE hFile = NULL; win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes); #ifdef IOWIN32_USING_WINRT_API if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFile2((LPCWSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition,NULL); #else if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFileW((LPCWSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL); #endif return win32_build_iowin(hFile); } voidpf ZCALLBACK win32_open_file_func(voidpf opaque, const char* filename, int mode) { const char* mode_fopen = NULL; DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ; HANDLE hFile = NULL; win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes); #ifdef IOWIN32_USING_WINRT_API #ifdef UNICODE if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFile2((LPCTSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); #else if ((filename!=NULL) && (dwDesiredAccess != 0)) { WCHAR filenameW[FILENAME_MAX + 0x200 + 1]; MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200); hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); } #endif #else if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFile((LPCTSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL); #endif return win32_build_iowin(hFile); } uLong ZCALLBACK win32_read_file_func(voidpf opaque, voidpf stream, void* buf,uLong size) { uLong ret=0; HANDLE hFile = NULL; if (stream!=NULL) hFile = ((WIN32FILE_IOWIN*)stream) -> hf; if (hFile != NULL) { if (!ReadFile(hFile, buf, size, &ret, NULL)) { DWORD dwErr = GetLastError(); if (dwErr == ERROR_HANDLE_EOF) dwErr = 0; ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; } } return ret; } uLong ZCALLBACK win32_write_file_func(voidpf opaque, voidpf stream, const void* buf, uLong size) { uLong ret=0; HANDLE hFile = NULL; if (stream!=NULL) hFile = ((WIN32FILE_IOWIN*)stream) -> hf; if (hFile != NULL) { if (!WriteFile(hFile, buf, size, &ret, NULL)) { DWORD dwErr = GetLastError(); if (dwErr == ERROR_HANDLE_EOF) dwErr = 0; ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; } } return ret; } static BOOL MySetFilePointerEx(HANDLE hFile, LARGE_INTEGER pos, LARGE_INTEGER *newPos, DWORD dwMoveMethod) { #ifdef IOWIN32_USING_WINRT_API return SetFilePointerEx(hFile, pos, newPos, dwMoveMethod); #else LONG lHigh = pos.HighPart; DWORD dwNewPos = SetFilePointer(hFile, pos.LowPart, &lHigh, dwMoveMethod); BOOL fOk = TRUE; if (dwNewPos == 0xFFFFFFFF) if (GetLastError() != NO_ERROR) fOk = FALSE; if ((newPos != NULL) && (fOk)) { newPos->LowPart = dwNewPos; newPos->HighPart = lHigh; } return fOk; #endif } long ZCALLBACK win32_tell_file_func(voidpf opaque, voidpf stream) { long ret=-1; HANDLE hFile = NULL; if (stream!=NULL) hFile = ((WIN32FILE_IOWIN*)stream) -> hf; if (hFile != NULL) { LARGE_INTEGER pos; pos.QuadPart = 0; if (!MySetFilePointerEx(hFile, pos, &pos, FILE_CURRENT)) { DWORD dwErr = GetLastError(); ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; ret = -1; } else ret=(long)pos.LowPart; } return ret; } ZPOS64_T ZCALLBACK win32_tell64_file_func(voidpf opaque, voidpf stream) { ZPOS64_T ret= (ZPOS64_T)-1; HANDLE hFile = NULL; if (stream!=NULL) hFile = ((WIN32FILE_IOWIN*)stream)->hf; if (hFile) { LARGE_INTEGER pos; pos.QuadPart = 0; if (!MySetFilePointerEx(hFile, pos, &pos, FILE_CURRENT)) { DWORD dwErr = GetLastError(); ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; ret = (ZPOS64_T)-1; } else ret=pos.QuadPart; } return ret; } long ZCALLBACK win32_seek_file_func(voidpf opaque, voidpf stream, uLong offset, int origin) { DWORD dwMoveMethod=0xFFFFFFFF; HANDLE hFile = NULL; long ret=-1; if (stream!=NULL) hFile = ((WIN32FILE_IOWIN*)stream) -> hf; switch (origin) { case ZLIB_FILEFUNC_SEEK_CUR : dwMoveMethod = FILE_CURRENT; break; case ZLIB_FILEFUNC_SEEK_END : dwMoveMethod = FILE_END; break; case ZLIB_FILEFUNC_SEEK_SET : dwMoveMethod = FILE_BEGIN; break; default: return -1; } if (hFile != NULL) { LARGE_INTEGER pos; pos.QuadPart = offset; if (!MySetFilePointerEx(hFile, pos, NULL, dwMoveMethod)) { DWORD dwErr = GetLastError(); ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; ret = -1; } else ret=0; } return ret; } long ZCALLBACK win32_seek64_file_func(voidpf opaque, voidpf stream, ZPOS64_T offset, int origin) { DWORD dwMoveMethod=0xFFFFFFFF; HANDLE hFile = NULL; long ret=-1; if (stream!=NULL) hFile = ((WIN32FILE_IOWIN*)stream)->hf; switch (origin) { case ZLIB_FILEFUNC_SEEK_CUR : dwMoveMethod = FILE_CURRENT; break; case ZLIB_FILEFUNC_SEEK_END : dwMoveMethod = FILE_END; break; case ZLIB_FILEFUNC_SEEK_SET : dwMoveMethod = FILE_BEGIN; break; default: return -1; } if (hFile) { LARGE_INTEGER pos; pos.QuadPart = offset; if (!MySetFilePointerEx(hFile, pos, NULL, dwMoveMethod)) { DWORD dwErr = GetLastError(); ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; ret = -1; } else ret=0; } return ret; } int ZCALLBACK win32_close_file_func(voidpf opaque, voidpf stream) { int ret=-1; if (stream!=NULL) { HANDLE hFile; hFile = ((WIN32FILE_IOWIN*)stream) -> hf; if (hFile != NULL) { CloseHandle(hFile); ret=0; } free(stream); } return ret; } int ZCALLBACK win32_error_file_func(voidpf opaque, voidpf stream) { int ret=-1; if (stream!=NULL) { ret = ((WIN32FILE_IOWIN*)stream) -> error; } return ret; } void fill_win32_filefunc(zlib_filefunc_def* pzlib_filefunc_def) { pzlib_filefunc_def->zopen_file = win32_open_file_func; pzlib_filefunc_def->zread_file = win32_read_file_func; pzlib_filefunc_def->zwrite_file = win32_write_file_func; pzlib_filefunc_def->ztell_file = win32_tell_file_func; pzlib_filefunc_def->zseek_file = win32_seek_file_func; pzlib_filefunc_def->zclose_file = win32_close_file_func; pzlib_filefunc_def->zerror_file = win32_error_file_func; pzlib_filefunc_def->opaque = NULL; } void fill_win32_filefunc64(zlib_filefunc64_def* pzlib_filefunc_def) { pzlib_filefunc_def->zopen64_file = win32_open64_file_func; pzlib_filefunc_def->zread_file = win32_read_file_func; pzlib_filefunc_def->zwrite_file = win32_write_file_func; pzlib_filefunc_def->ztell64_file = win32_tell64_file_func; pzlib_filefunc_def->zseek64_file = win32_seek64_file_func; pzlib_filefunc_def->zclose_file = win32_close_file_func; pzlib_filefunc_def->zerror_file = win32_error_file_func; pzlib_filefunc_def->opaque = NULL; } void fill_win32_filefunc64A(zlib_filefunc64_def* pzlib_filefunc_def) { pzlib_filefunc_def->zopen64_file = win32_open64_file_funcA; pzlib_filefunc_def->zread_file = win32_read_file_func; pzlib_filefunc_def->zwrite_file = win32_write_file_func; pzlib_filefunc_def->ztell64_file = win32_tell64_file_func; pzlib_filefunc_def->zseek64_file = win32_seek64_file_func; pzlib_filefunc_def->zclose_file = win32_close_file_func; pzlib_filefunc_def->zerror_file = win32_error_file_func; pzlib_filefunc_def->opaque = NULL; } void fill_win32_filefunc64W(zlib_filefunc64_def* pzlib_filefunc_def) { pzlib_filefunc_def->zopen64_file = win32_open64_file_funcW; pzlib_filefunc_def->zread_file = win32_read_file_func; pzlib_filefunc_def->zwrite_file = win32_write_file_func; pzlib_filefunc_def->ztell64_file = win32_tell64_file_func; pzlib_filefunc_def->zseek64_file = win32_seek64_file_func; pzlib_filefunc_def->zclose_file = win32_close_file_func; pzlib_filefunc_def->zerror_file = win32_error_file_func; pzlib_filefunc_def->opaque = NULL; } tcl8.6.14/compat/zlib/contrib/minizip/mztools.h0000644000175000017500000000130414554262142021062 0ustar sergeisergei/* Additional tools for Minizip Code: Xavier Roche '2004 License: Same as ZLIB (www.gzip.org) */ #ifndef _zip_tools_H #define _zip_tools_H #ifdef __cplusplus extern "C" { #endif #ifndef _ZLIB_H #include "zlib.h" #endif #include "unzip.h" /* Repair a ZIP file (missing central directory) file: file to recover fileOut: output file after recovery fileOutTmp: temporary file name used for recovery */ extern int ZEXPORT unzRepair(const char* file, const char* fileOut, const char* fileOutTmp, uLong* nRecovered, uLong* bytesRecovered); #ifdef __cplusplus } #endif #endif tcl8.6.14/compat/zlib/contrib/minizip/configure.ac0000644000175000017500000000142214560736523021477 0ustar sergeisergei# -*- Autoconf -*- # Process this file with autoconf to produce a configure script. AC_INIT([minizip], [1.3.1], [bugzilla.redhat.com]) AC_CONFIG_SRCDIR([minizip.c]) AM_INIT_AUTOMAKE([foreign]) LT_INIT AC_MSG_CHECKING([whether to build example programs]) AC_ARG_ENABLE([demos], AC_HELP_STRING([--enable-demos], [build example programs])) AM_CONDITIONAL([COND_DEMOS], [test "$enable_demos" = yes]) if test "$enable_demos" = yes then AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) fi case "${host}" in *-mingw* | mingw*) WIN32="yes" ;; *) ;; esac AM_CONDITIONAL([WIN32], [test "${WIN32}" = "yes"]) AC_SUBST([HAVE_UNISTD_H], [0]) AC_CHECK_HEADER([unistd.h], [HAVE_UNISTD_H=1], []) AC_CONFIG_FILES([Makefile minizip.pc]) AC_OUTPUT tcl8.6.14/compat/zlib/contrib/minizip/minizip.10000644000175000017500000000266614554262142020757 0ustar sergeisergei.\" Hey, EMACS: -*- nroff -*- .TH minizip 1 "May 2, 2001" .\" Please adjust this date whenever revising the manpage. .\" .\" Some roff macros, for reference: .\" .nh disable hyphenation .\" .hy enable hyphenation .\" .ad l left justify .\" .ad b justify to both left and right margins .\" .nf disable filling .\" .fi enable filling .\" .br insert line break .\" .sp insert n+1 empty lines .\" for manpage-specific macros, see man(7) .SH NAME minizip - create ZIP archives .SH SYNOPSIS .B minizip .RI [ -o ] zipfile [ " files" ... ] .SH DESCRIPTION .B minizip is a simple tool which allows the creation of compressed file archives in the ZIP format used by the MS-DOS utility PKZIP. It was written as a demonstration of the .IR zlib (3) library and therefore lack many of the features of the .IR zip (1) program. .SH OPTIONS The first argument supplied is the name of the ZIP archive to create or .RI -o in which case it is ignored and the second argument treated as the name of the ZIP file. If the ZIP file already exists it will be overwritten. .PP Subsequent arguments specify a list of files to place in the ZIP archive. If none are specified then an empty archive will be created. .SH SEE ALSO .BR miniunzip (1), .BR zlib (3), .BR zip (1). .SH AUTHOR This program was written by Gilles Vollant. This manual page was written by Mark Brown . tcl8.6.14/compat/zlib/contrib/minizip/miniunz.c0000644000175000017500000004331614560736523021056 0ustar sergeisergei/* miniunz.c Version 1.1, February 14h, 2010 sample part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications of Unzip for Zip64 Copyright (C) 2007-2008 Even Rouault Modifications for Zip64 support on both zip and unzip Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) */ #if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__)) #ifndef __USE_FILE_OFFSET64 #define __USE_FILE_OFFSET64 #endif #ifndef __USE_LARGEFILE64 #define __USE_LARGEFILE64 #endif #ifndef _LARGEFILE64_SOURCE #define _LARGEFILE64_SOURCE #endif #ifndef _FILE_OFFSET_BIT #define _FILE_OFFSET_BIT 64 #endif #endif #if defined(__APPLE__) || defined(__HAIKU__) || defined(MINIZIP_FOPEN_NO_64) // In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions #define FOPEN_FUNC(filename, mode) fopen(filename, mode) #define FTELLO_FUNC(stream) ftello(stream) #define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin) #else #define FOPEN_FUNC(filename, mode) fopen64(filename, mode) #define FTELLO_FUNC(stream) ftello64(stream) #define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin) #endif #include #include #include #include #include #include #include #ifdef _WIN32 # include # include #else # include # include #endif #include "unzip.h" #define CASESENSITIVITY (0) #define WRITEBUFFERSIZE (8192) #define MAXFILENAME (256) #ifdef _WIN32 #define USEWIN32IOAPI #include "iowin32.h" #endif /* mini unzip, demo of unzip package usage : Usage : miniunz [-exvlo] file.zip [file_to_extract] [-d extractdir] list the file in the zipfile, and print the content of FILE_ID.ZIP or README.TXT if it exists */ /* change_file_date : change the date/time of a file filename : the filename of the file where date/time must be modified dosdate : the new date at the MSDOS format (4 bytes) tmu_date : the SAME new date at the tm_unz format */ static void change_file_date(const char *filename, uLong dosdate, tm_unz tmu_date) { #ifdef _WIN32 HANDLE hFile; FILETIME ftm,ftLocal,ftCreate,ftLastAcc,ftLastWrite; hFile = CreateFileA(filename,GENERIC_READ | GENERIC_WRITE, 0,NULL,OPEN_EXISTING,0,NULL); GetFileTime(hFile,&ftCreate,&ftLastAcc,&ftLastWrite); DosDateTimeToFileTime((WORD)(dosdate>>16),(WORD)dosdate,&ftLocal); LocalFileTimeToFileTime(&ftLocal,&ftm); SetFileTime(hFile,&ftm,&ftLastAcc,&ftm); CloseHandle(hFile); #else #if defined(unix) || defined(__APPLE__) (void)dosdate; struct utimbuf ut; struct tm newdate; newdate.tm_sec = tmu_date.tm_sec; newdate.tm_min=tmu_date.tm_min; newdate.tm_hour=tmu_date.tm_hour; newdate.tm_mday=tmu_date.tm_mday; newdate.tm_mon=tmu_date.tm_mon; if (tmu_date.tm_year > 1900) newdate.tm_year=tmu_date.tm_year - 1900; else newdate.tm_year=tmu_date.tm_year ; newdate.tm_isdst=-1; ut.actime=ut.modtime=mktime(&newdate); utime(filename,&ut); #else (void)filename; (void)dosdate; (void)tmu_date; #endif #endif } /* mymkdir and change_file_date are not 100 % portable As I don't know well Unix, I wait feedback for the unix portion */ static int mymkdir(const char* dirname) { int ret=0; #ifdef _WIN32 ret = _mkdir(dirname); #elif unix ret = mkdir (dirname,0775); #elif __APPLE__ ret = mkdir (dirname,0775); #else (void)dirname; #endif return ret; } static int makedir(const char *newdir) { char *buffer ; char *p; size_t len = strlen(newdir); if (len == 0) return 0; buffer = (char*)malloc(len+1); if (buffer==NULL) { printf("Error allocating memory\n"); return UNZ_INTERNALERROR; } strcpy(buffer,newdir); if (buffer[len-1] == '/') { buffer[len-1] = '\0'; } if (mymkdir(buffer) == 0) { free(buffer); return 1; } p = buffer+1; while (1) { char hold; while(*p && *p != '\\' && *p != '/') p++; hold = *p; *p = 0; if ((mymkdir(buffer) == -1) && (errno == ENOENT)) { printf("couldn't create directory %s\n",buffer); free(buffer); return 0; } if (hold == 0) break; *p++ = hold; } free(buffer); return 1; } static void do_banner(void) { printf("MiniUnz 1.1, demo of zLib + Unz package written by Gilles Vollant\n"); printf("more info at http://www.winimage.com/zLibDll/unzip.html\n\n"); } static void do_help(void) { printf("Usage : miniunz [-e] [-x] [-v] [-l] [-o] [-p password] file.zip [file_to_extr.] [-d extractdir]\n\n" \ " -e Extract without pathname (junk paths)\n" \ " -x Extract with pathname\n" \ " -v list files\n" \ " -l list files\n" \ " -d directory to extract into\n" \ " -o overwrite files without prompting\n" \ " -p extract encrypted file using password\n\n"); } static void Display64BitsSize(ZPOS64_T n, int size_char) { /* to avoid compatibility problem , we do here the conversion */ char number[21]; int offset=19; int pos_string = 19; number[20]=0; for (;;) { number[offset]=(char)((n%10)+'0'); if (number[offset] != '0') pos_string=offset; n/=10; if (offset==0) break; offset--; } { int size_display_string = 19-pos_string; while (size_char > size_display_string) { size_char--; printf(" "); } } printf("%s",&number[pos_string]); } static int do_list(unzFile uf) { uLong i; unz_global_info64 gi; int err; err = unzGetGlobalInfo64(uf,&gi); if (err!=UNZ_OK) printf("error %d with zipfile in unzGetGlobalInfo \n",err); printf(" Length Method Size Ratio Date Time CRC-32 Name\n"); printf(" ------ ------ ---- ----- ---- ---- ------ ----\n"); for (i=0;i0) ratio = (uLong)((file_info.compressed_size*100)/file_info.uncompressed_size); /* display a '*' if the file is encrypted */ if ((file_info.flag & 1) != 0) charCrypt='*'; if (file_info.compression_method==0) string_method="Stored"; else if (file_info.compression_method==Z_DEFLATED) { uInt iLevel=(uInt)((file_info.flag & 0x6)/2); if (iLevel==0) string_method="Defl:N"; else if (iLevel==1) string_method="Defl:X"; else if ((iLevel==2) || (iLevel==3)) string_method="Defl:F"; /* 2:fast , 3 : extra fast*/ } else if (file_info.compression_method==Z_BZIP2ED) { string_method="BZip2 "; } else string_method="Unkn. "; Display64BitsSize(file_info.uncompressed_size,7); printf(" %6s%c",string_method,charCrypt); Display64BitsSize(file_info.compressed_size,7); printf(" %3lu%% %2.2lu-%2.2lu-%2.2lu %2.2lu:%2.2lu %8.8lx %s\n", ratio, (uLong)file_info.tmu_date.tm_mon + 1, (uLong)file_info.tmu_date.tm_mday, (uLong)file_info.tmu_date.tm_year % 100, (uLong)file_info.tmu_date.tm_hour,(uLong)file_info.tmu_date.tm_min, (uLong)file_info.crc,filename_inzip); if ((i+1)='a') && (rep<='z')) rep -= 0x20; } while ((rep!='Y') && (rep!='N') && (rep!='A')); } if (rep == 'N') skip = 1; if (rep == 'A') *popt_overwrite=1; } if ((skip==0) && (err==UNZ_OK)) { fout=FOPEN_FUNC(write_filename,"wb"); /* some zipfile don't contain directory alone before file */ if ((fout==NULL) && ((*popt_extract_without_path)==0) && (filename_withoutpath!=(char*)filename_inzip)) { char c=*(filename_withoutpath-1); *(filename_withoutpath-1)='\0'; makedir(write_filename); *(filename_withoutpath-1)=c; fout=FOPEN_FUNC(write_filename,"wb"); } if (fout==NULL) { printf("error opening %s\n",write_filename); } } if (fout!=NULL) { printf(" extracting: %s\n",write_filename); do { err = unzReadCurrentFile(uf,buf,size_buf); if (err<0) { printf("error %d with zipfile in unzReadCurrentFile\n",err); break; } if (err>0) if (fwrite(buf,(unsigned)err,1,fout)!=1) { printf("error in writing extracted file\n"); err=UNZ_ERRNO; break; } } while (err>0); if (fout) fclose(fout); if (err==0) change_file_date(write_filename,file_info.dosDate, file_info.tmu_date); } if (err==UNZ_OK) { err = unzCloseCurrentFile (uf); if (err!=UNZ_OK) { printf("error %d with zipfile in unzCloseCurrentFile\n",err); } } else unzCloseCurrentFile(uf); /* don't lose the error */ } free(buf); return err; } static int do_extract(unzFile uf, int opt_extract_without_path, int opt_overwrite, const char* password) { uLong i; unz_global_info64 gi; int err; err = unzGetGlobalInfo64(uf,&gi); if (err!=UNZ_OK) printf("error %d with zipfile in unzGetGlobalInfo \n",err); for (i=0;i #include #include #include #include #include "zlib.h" #include "zip.h" #ifdef STDC # include #endif #ifdef NO_ERRNO_H extern int errno; #else # include #endif #ifndef local # define local static #endif /* compile with -Dlocal if your debugger can't find static symbols */ #ifndef VERSIONMADEBY # define VERSIONMADEBY (0x0) /* platform dependent */ #endif #ifndef Z_BUFSIZE #define Z_BUFSIZE (64*1024) //(16384) #endif #ifndef Z_MAXFILENAMEINZIP #define Z_MAXFILENAMEINZIP (256) #endif #ifndef ALLOC # define ALLOC(size) (malloc(size)) #endif /* #define SIZECENTRALDIRITEM (0x2e) #define SIZEZIPLOCALHEADER (0x1e) */ /* I've found an old Unix (a SunOS 4.1.3_U1) without all SEEK_* defined.... */ // NOT sure that this work on ALL platform #define MAKEULONG64(a, b) ((ZPOS64_T)(((unsigned long)(a)) | ((ZPOS64_T)((unsigned long)(b))) << 32)) #ifndef SEEK_CUR #define SEEK_CUR 1 #endif #ifndef SEEK_END #define SEEK_END 2 #endif #ifndef SEEK_SET #define SEEK_SET 0 #endif #ifndef DEF_MEM_LEVEL #if MAX_MEM_LEVEL >= 8 # define DEF_MEM_LEVEL 8 #else # define DEF_MEM_LEVEL MAX_MEM_LEVEL #endif #endif const char zip_copyright[] =" zip 1.01 Copyright 1998-2004 Gilles Vollant - http://www.winimage.com/zLibDll"; #define SIZEDATA_INDATABLOCK (4096-(4*4)) #define LOCALHEADERMAGIC (0x04034b50) #define CENTRALHEADERMAGIC (0x02014b50) #define ENDHEADERMAGIC (0x06054b50) #define ZIP64ENDHEADERMAGIC (0x6064b50) #define ZIP64ENDLOCHEADERMAGIC (0x7064b50) #define FLAG_LOCALHEADER_OFFSET (0x06) #define CRC_LOCALHEADER_OFFSET (0x0e) #define SIZECENTRALHEADER (0x2e) /* 46 */ typedef struct linkedlist_datablock_internal_s { struct linkedlist_datablock_internal_s* next_datablock; uLong avail_in_this_block; uLong filled_in_this_block; uLong unused; /* for future use and alignment */ unsigned char data[SIZEDATA_INDATABLOCK]; } linkedlist_datablock_internal; typedef struct linkedlist_data_s { linkedlist_datablock_internal* first_block; linkedlist_datablock_internal* last_block; } linkedlist_data; typedef struct { z_stream stream; /* zLib stream structure for inflate */ #ifdef HAVE_BZIP2 bz_stream bstream; /* bzLib stream structure for bziped */ #endif int stream_initialised; /* 1 is stream is initialised */ uInt pos_in_buffered_data; /* last written byte in buffered_data */ ZPOS64_T pos_local_header; /* offset of the local header of the file currently writing */ char* central_header; /* central header data for the current file */ uLong size_centralExtra; uLong size_centralheader; /* size of the central header for cur file */ uLong size_centralExtraFree; /* Extra bytes allocated to the centralheader but that are not used */ uLong flag; /* flag of the file currently writing */ int method; /* compression method of file currently wr.*/ int raw; /* 1 for directly writing raw data */ Byte buffered_data[Z_BUFSIZE];/* buffer contain compressed data to be writ*/ uLong dosDate; uLong crc32; int encrypt; int zip64; /* Add ZIP64 extended information in the extra field */ ZPOS64_T pos_zip64extrainfo; ZPOS64_T totalCompressedData; ZPOS64_T totalUncompressedData; #ifndef NOCRYPT unsigned long keys[3]; /* keys defining the pseudo-random sequence */ const z_crc_t* pcrc_32_tab; unsigned crypt_header_size; #endif } curfile64_info; typedef struct { zlib_filefunc64_32_def z_filefunc; voidpf filestream; /* io structure of the zipfile */ linkedlist_data central_dir;/* datablock with central dir in construction*/ int in_opened_file_inzip; /* 1 if a file in the zip is currently writ.*/ curfile64_info ci; /* info on the file currently writing */ ZPOS64_T begin_pos; /* position of the beginning of the zipfile */ ZPOS64_T add_position_when_writing_offset; ZPOS64_T number_entry; #ifndef NO_ADDFILEINEXISTINGZIP char *globalcomment; #endif } zip64_internal; #ifndef NOCRYPT #define INCLUDECRYPTINGCODE_IFCRYPTALLOWED #include "crypt.h" #endif local linkedlist_datablock_internal* allocate_new_datablock(void) { linkedlist_datablock_internal* ldi; ldi = (linkedlist_datablock_internal*) ALLOC(sizeof(linkedlist_datablock_internal)); if (ldi!=NULL) { ldi->next_datablock = NULL ; ldi->filled_in_this_block = 0 ; ldi->avail_in_this_block = SIZEDATA_INDATABLOCK ; } return ldi; } local void free_datablock(linkedlist_datablock_internal* ldi) { while (ldi!=NULL) { linkedlist_datablock_internal* ldinext = ldi->next_datablock; free(ldi); ldi = ldinext; } } local void init_linkedlist(linkedlist_data* ll) { ll->first_block = ll->last_block = NULL; } local void free_linkedlist(linkedlist_data* ll) { free_datablock(ll->first_block); ll->first_block = ll->last_block = NULL; } local int add_data_in_datablock(linkedlist_data* ll, const void* buf, uLong len) { linkedlist_datablock_internal* ldi; const unsigned char* from_copy; if (ll==NULL) return ZIP_INTERNALERROR; if (ll->last_block == NULL) { ll->first_block = ll->last_block = allocate_new_datablock(); if (ll->first_block == NULL) return ZIP_INTERNALERROR; } ldi = ll->last_block; from_copy = (const unsigned char*)buf; while (len>0) { uInt copy_this; uInt i; unsigned char* to_copy; if (ldi->avail_in_this_block==0) { ldi->next_datablock = allocate_new_datablock(); if (ldi->next_datablock == NULL) return ZIP_INTERNALERROR; ldi = ldi->next_datablock ; ll->last_block = ldi; } if (ldi->avail_in_this_block < len) copy_this = (uInt)ldi->avail_in_this_block; else copy_this = (uInt)len; to_copy = &(ldi->data[ldi->filled_in_this_block]); for (i=0;ifilled_in_this_block += copy_this; ldi->avail_in_this_block -= copy_this; from_copy += copy_this ; len -= copy_this; } return ZIP_OK; } /****************************************************************************/ #ifndef NO_ADDFILEINEXISTINGZIP /* =========================================================================== Inputs a long in LSB order to the given file nbByte == 1, 2 ,4 or 8 (byte, short or long, ZPOS64_T) */ local int zip64local_putValue(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T x, int nbByte) { unsigned char buf[8]; int n; for (n = 0; n < nbByte; n++) { buf[n] = (unsigned char)(x & 0xff); x >>= 8; } if (x != 0) { /* data overflow - hack for ZIP64 (X Roche) */ for (n = 0; n < nbByte; n++) { buf[n] = 0xff; } } if (ZWRITE64(*pzlib_filefunc_def,filestream,buf,(uLong)nbByte)!=(uLong)nbByte) return ZIP_ERRNO; else return ZIP_OK; } local void zip64local_putValue_inmemory (void* dest, ZPOS64_T x, int nbByte) { unsigned char* buf=(unsigned char*)dest; int n; for (n = 0; n < nbByte; n++) { buf[n] = (unsigned char)(x & 0xff); x >>= 8; } if (x != 0) { /* data overflow - hack for ZIP64 */ for (n = 0; n < nbByte; n++) { buf[n] = 0xff; } } } /****************************************************************************/ local uLong zip64local_TmzDateToDosDate(const tm_zip* ptm) { uLong year = (uLong)ptm->tm_year; if (year>=1980) year-=1980; else if (year>=80) year-=80; return (uLong) (((uLong)(ptm->tm_mday) + (32 * (uLong)(ptm->tm_mon+1)) + (512 * year)) << 16) | (((uLong)ptm->tm_sec/2) + (32 * (uLong)ptm->tm_min) + (2048 * (uLong)ptm->tm_hour)); } /****************************************************************************/ local int zip64local_getByte(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, int* pi) { unsigned char c; int err = (int)ZREAD64(*pzlib_filefunc_def,filestream,&c,1); if (err==1) { *pi = (int)c; return ZIP_OK; } else { if (ZERROR64(*pzlib_filefunc_def,filestream)) return ZIP_ERRNO; else return ZIP_EOF; } } /* =========================================================================== Reads a long in LSB order from the given gz_stream. Sets */ local int zip64local_getShort(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong* pX) { uLong x ; int i = 0; int err; err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x = (uLong)i; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((uLong)i)<<8; if (err==ZIP_OK) *pX = x; else *pX = 0; return err; } local int zip64local_getLong(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong* pX) { uLong x ; int i = 0; int err; err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x = (uLong)i; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((uLong)i)<<8; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((uLong)i)<<16; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((uLong)i)<<24; if (err==ZIP_OK) *pX = x; else *pX = 0; return err; } local int zip64local_getLong64(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T *pX) { ZPOS64_T x; int i = 0; int err; err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x = (ZPOS64_T)i; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((ZPOS64_T)i)<<8; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((ZPOS64_T)i)<<16; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((ZPOS64_T)i)<<24; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((ZPOS64_T)i)<<32; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((ZPOS64_T)i)<<40; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((ZPOS64_T)i)<<48; if (err==ZIP_OK) err = zip64local_getByte(pzlib_filefunc_def,filestream,&i); x += ((ZPOS64_T)i)<<56; if (err==ZIP_OK) *pX = x; else *pX = 0; return err; } #ifndef BUFREADCOMMENT #define BUFREADCOMMENT (0x400) #endif /* Locate the Central directory of a zipfile (at the end, just before the global comment) */ local ZPOS64_T zip64local_SearchCentralDir(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream) { unsigned char* buf; ZPOS64_T uSizeFile; ZPOS64_T uBackRead; ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */ ZPOS64_T uPosFound=0; if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0) return 0; uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream); if (uMaxBack>uSizeFile) uMaxBack = uSizeFile; buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4); if (buf==NULL) return 0; uBackRead = 4; while (uBackReaduMaxBack) uBackRead = uMaxBack; else uBackRead+=BUFREADCOMMENT; uReadPos = uSizeFile-uBackRead ; uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ? (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos); if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0) break; if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize) break; for (i=(int)uReadSize-3; (i--)>0;) if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) && ((*(buf+i+2))==0x05) && ((*(buf+i+3))==0x06)) { uPosFound = uReadPos+(unsigned)i; break; } if (uPosFound!=0) break; } free(buf); return uPosFound; } /* Locate the End of Zip64 Central directory locator and from there find the CD of a zipfile (at the end, just before the global comment) */ local ZPOS64_T zip64local_SearchCentralDir64(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream) { unsigned char* buf; ZPOS64_T uSizeFile; ZPOS64_T uBackRead; ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */ ZPOS64_T uPosFound=0; uLong uL; ZPOS64_T relativeOffset; if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0) return 0; uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream); if (uMaxBack>uSizeFile) uMaxBack = uSizeFile; buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4); if (buf==NULL) return 0; uBackRead = 4; while (uBackReaduMaxBack) uBackRead = uMaxBack; else uBackRead+=BUFREADCOMMENT; uReadPos = uSizeFile-uBackRead ; uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ? (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos); if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0) break; if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize) break; for (i=(int)uReadSize-3; (i--)>0;) { // Signature "0x07064b50" Zip64 end of central directory locater if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) && ((*(buf+i+2))==0x06) && ((*(buf+i+3))==0x07)) { uPosFound = uReadPos+(unsigned)i; break; } } if (uPosFound!=0) break; } free(buf); if (uPosFound == 0) return 0; /* Zip64 end of central directory locator */ if (ZSEEK64(*pzlib_filefunc_def,filestream, uPosFound,ZLIB_FILEFUNC_SEEK_SET)!=0) return 0; /* the signature, already checked */ if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK) return 0; /* number of the disk with the start of the zip64 end of central directory */ if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK) return 0; if (uL != 0) return 0; /* relative offset of the zip64 end of central directory record */ if (zip64local_getLong64(pzlib_filefunc_def,filestream,&relativeOffset)!=ZIP_OK) return 0; /* total number of disks */ if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK) return 0; if (uL != 1) return 0; /* Goto Zip64 end of central directory record */ if (ZSEEK64(*pzlib_filefunc_def,filestream, relativeOffset,ZLIB_FILEFUNC_SEEK_SET)!=0) return 0; /* the signature */ if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK) return 0; if (uL != 0x06064b50) // signature of 'Zip64 end of central directory' return 0; return relativeOffset; } local int LoadCentralDirectoryRecord(zip64_internal* pziinit) { int err=ZIP_OK; ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/ ZPOS64_T size_central_dir; /* size of the central directory */ ZPOS64_T offset_central_dir; /* offset of start of central directory */ ZPOS64_T central_pos; uLong uL; uLong number_disk; /* number of the current disk, used for spanning ZIP, unsupported, always 0*/ uLong number_disk_with_CD; /* number of the disk with central dir, used for spanning ZIP, unsupported, always 0*/ ZPOS64_T number_entry; ZPOS64_T number_entry_CD; /* total number of entries in the central dir (same than number_entry on nospan) */ uLong VersionMadeBy; uLong VersionNeeded; uLong size_comment; int hasZIP64Record = 0; // check first if we find a ZIP64 record central_pos = zip64local_SearchCentralDir64(&pziinit->z_filefunc,pziinit->filestream); if(central_pos > 0) { hasZIP64Record = 1; } else if(central_pos == 0) { central_pos = zip64local_SearchCentralDir(&pziinit->z_filefunc,pziinit->filestream); } /* disable to allow appending to empty ZIP archive if (central_pos==0) err=ZIP_ERRNO; */ if(hasZIP64Record) { ZPOS64_T sizeEndOfCentralDirectory; if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, central_pos, ZLIB_FILEFUNC_SEEK_SET) != 0) err=ZIP_ERRNO; /* the signature, already checked */ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&uL)!=ZIP_OK) err=ZIP_ERRNO; /* size of zip64 end of central directory record */ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream, &sizeEndOfCentralDirectory)!=ZIP_OK) err=ZIP_ERRNO; /* version made by */ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &VersionMadeBy)!=ZIP_OK) err=ZIP_ERRNO; /* version needed to extract */ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &VersionNeeded)!=ZIP_OK) err=ZIP_ERRNO; /* number of this disk */ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&number_disk)!=ZIP_OK) err=ZIP_ERRNO; /* number of the disk with the start of the central directory */ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&number_disk_with_CD)!=ZIP_OK) err=ZIP_ERRNO; /* total number of entries in the central directory on this disk */ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream, &number_entry)!=ZIP_OK) err=ZIP_ERRNO; /* total number of entries in the central directory */ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&number_entry_CD)!=ZIP_OK) err=ZIP_ERRNO; if ((number_entry_CD!=number_entry) || (number_disk_with_CD!=0) || (number_disk!=0)) err=ZIP_BADZIPFILE; /* size of the central directory */ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&size_central_dir)!=ZIP_OK) err=ZIP_ERRNO; /* offset of start of central directory with respect to the starting disk number */ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&offset_central_dir)!=ZIP_OK) err=ZIP_ERRNO; // TODO.. // read the comment from the standard central header. size_comment = 0; } else { // Read End of central Directory info if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0) err=ZIP_ERRNO; /* the signature, already checked */ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&uL)!=ZIP_OK) err=ZIP_ERRNO; /* number of this disk */ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream,&number_disk)!=ZIP_OK) err=ZIP_ERRNO; /* number of the disk with the start of the central directory */ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream,&number_disk_with_CD)!=ZIP_OK) err=ZIP_ERRNO; /* total number of entries in the central dir on this disk */ number_entry = 0; if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK) err=ZIP_ERRNO; else number_entry = uL; /* total number of entries in the central dir */ number_entry_CD = 0; if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK) err=ZIP_ERRNO; else number_entry_CD = uL; if ((number_entry_CD!=number_entry) || (number_disk_with_CD!=0) || (number_disk!=0)) err=ZIP_BADZIPFILE; /* size of the central directory */ size_central_dir = 0; if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK) err=ZIP_ERRNO; else size_central_dir = uL; /* offset of start of central directory with respect to the starting disk number */ offset_central_dir = 0; if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK) err=ZIP_ERRNO; else offset_central_dir = uL; /* zipfile global comment length */ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &size_comment)!=ZIP_OK) err=ZIP_ERRNO; } if ((central_posz_filefunc, pziinit->filestream); return ZIP_ERRNO; } if (size_comment>0) { pziinit->globalcomment = (char*)ALLOC(size_comment+1); if (pziinit->globalcomment) { size_comment = ZREAD64(pziinit->z_filefunc, pziinit->filestream, pziinit->globalcomment,size_comment); pziinit->globalcomment[size_comment]=0; } } byte_before_the_zipfile = central_pos - (offset_central_dir+size_central_dir); pziinit->add_position_when_writing_offset = byte_before_the_zipfile; { ZPOS64_T size_central_dir_to_read = size_central_dir; size_t buf_size = SIZEDATA_INDATABLOCK; void* buf_read = (void*)ALLOC(buf_size); if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, offset_central_dir + byte_before_the_zipfile, ZLIB_FILEFUNC_SEEK_SET) != 0) err=ZIP_ERRNO; while ((size_central_dir_to_read>0) && (err==ZIP_OK)) { ZPOS64_T read_this = SIZEDATA_INDATABLOCK; if (read_this > size_central_dir_to_read) read_this = size_central_dir_to_read; if (ZREAD64(pziinit->z_filefunc, pziinit->filestream,buf_read,(uLong)read_this) != read_this) err=ZIP_ERRNO; if (err==ZIP_OK) err = add_data_in_datablock(&pziinit->central_dir,buf_read, (uLong)read_this); size_central_dir_to_read-=read_this; } free(buf_read); } pziinit->begin_pos = byte_before_the_zipfile; pziinit->number_entry = number_entry_CD; if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, offset_central_dir+byte_before_the_zipfile,ZLIB_FILEFUNC_SEEK_SET) != 0) err=ZIP_ERRNO; return err; } #endif /* !NO_ADDFILEINEXISTINGZIP*/ /************************************************************/ extern zipFile ZEXPORT zipOpen3(const void *pathname, int append, zipcharpc* globalcomment, zlib_filefunc64_32_def* pzlib_filefunc64_32_def) { zip64_internal ziinit; zip64_internal* zi; int err=ZIP_OK; ziinit.z_filefunc.zseek32_file = NULL; ziinit.z_filefunc.ztell32_file = NULL; if (pzlib_filefunc64_32_def==NULL) fill_fopen64_filefunc(&ziinit.z_filefunc.zfile_func64); else ziinit.z_filefunc = *pzlib_filefunc64_32_def; ziinit.filestream = ZOPEN64(ziinit.z_filefunc, pathname, (append == APPEND_STATUS_CREATE) ? (ZLIB_FILEFUNC_MODE_READ | ZLIB_FILEFUNC_MODE_WRITE | ZLIB_FILEFUNC_MODE_CREATE) : (ZLIB_FILEFUNC_MODE_READ | ZLIB_FILEFUNC_MODE_WRITE | ZLIB_FILEFUNC_MODE_EXISTING)); if (ziinit.filestream == NULL) return NULL; if (append == APPEND_STATUS_CREATEAFTER) ZSEEK64(ziinit.z_filefunc,ziinit.filestream,0,SEEK_END); ziinit.begin_pos = ZTELL64(ziinit.z_filefunc,ziinit.filestream); ziinit.in_opened_file_inzip = 0; ziinit.ci.stream_initialised = 0; ziinit.number_entry = 0; ziinit.add_position_when_writing_offset = 0; init_linkedlist(&(ziinit.central_dir)); zi = (zip64_internal*)ALLOC(sizeof(zip64_internal)); if (zi==NULL) { ZCLOSE64(ziinit.z_filefunc,ziinit.filestream); return NULL; } /* now we add file in a zipfile */ # ifndef NO_ADDFILEINEXISTINGZIP ziinit.globalcomment = NULL; if (append == APPEND_STATUS_ADDINZIP) { // Read and Cache Central Directory Records err = LoadCentralDirectoryRecord(&ziinit); } if (globalcomment) { *globalcomment = ziinit.globalcomment; } # endif /* !NO_ADDFILEINEXISTINGZIP*/ if (err != ZIP_OK) { # ifndef NO_ADDFILEINEXISTINGZIP free(ziinit.globalcomment); # endif /* !NO_ADDFILEINEXISTINGZIP*/ free(zi); return NULL; } else { *zi = ziinit; return (zipFile)zi; } } extern zipFile ZEXPORT zipOpen2(const char *pathname, int append, zipcharpc* globalcomment, zlib_filefunc_def* pzlib_filefunc32_def) { if (pzlib_filefunc32_def != NULL) { zlib_filefunc64_32_def zlib_filefunc64_32_def_fill; fill_zlib_filefunc64_32_def_from_filefunc32(&zlib_filefunc64_32_def_fill,pzlib_filefunc32_def); return zipOpen3(pathname, append, globalcomment, &zlib_filefunc64_32_def_fill); } else return zipOpen3(pathname, append, globalcomment, NULL); } extern zipFile ZEXPORT zipOpen2_64(const void *pathname, int append, zipcharpc* globalcomment, zlib_filefunc64_def* pzlib_filefunc_def) { if (pzlib_filefunc_def != NULL) { zlib_filefunc64_32_def zlib_filefunc64_32_def_fill; zlib_filefunc64_32_def_fill.zfile_func64 = *pzlib_filefunc_def; zlib_filefunc64_32_def_fill.ztell32_file = NULL; zlib_filefunc64_32_def_fill.zseek32_file = NULL; return zipOpen3(pathname, append, globalcomment, &zlib_filefunc64_32_def_fill); } else return zipOpen3(pathname, append, globalcomment, NULL); } extern zipFile ZEXPORT zipOpen(const char* pathname, int append) { return zipOpen3((const void*)pathname,append,NULL,NULL); } extern zipFile ZEXPORT zipOpen64(const void* pathname, int append) { return zipOpen3(pathname,append,NULL,NULL); } local int Write_LocalFileHeader(zip64_internal* zi, const char* filename, uInt size_extrafield_local, const void* extrafield_local) { /* write the local header */ int err; uInt size_filename = (uInt)strlen(filename); uInt size_extrafield = size_extrafield_local; err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)LOCALHEADERMAGIC, 4); if (err==ZIP_OK) { if(zi->ci.zip64) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2);/* version needed to extract */ else err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)20,2);/* version needed to extract */ } if (err==ZIP_OK) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.flag,2); if (err==ZIP_OK) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.method,2); if (err==ZIP_OK) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.dosDate,4); // CRC / Compressed size / Uncompressed size will be filled in later and rewritten later if (err==ZIP_OK) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* crc 32, unknown */ if (err==ZIP_OK) { if(zi->ci.zip64) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xFFFFFFFF,4); /* compressed size, unknown */ else err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* compressed size, unknown */ } if (err==ZIP_OK) { if(zi->ci.zip64) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xFFFFFFFF,4); /* uncompressed size, unknown */ else err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* uncompressed size, unknown */ } if (err==ZIP_OK) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_filename,2); if(zi->ci.zip64) { size_extrafield += 20; } if (err==ZIP_OK) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_extrafield,2); if ((err==ZIP_OK) && (size_filename > 0)) { if (ZWRITE64(zi->z_filefunc,zi->filestream,filename,size_filename)!=size_filename) err = ZIP_ERRNO; } if ((err==ZIP_OK) && (size_extrafield_local > 0)) { if (ZWRITE64(zi->z_filefunc, zi->filestream, extrafield_local, size_extrafield_local) != size_extrafield_local) err = ZIP_ERRNO; } if ((err==ZIP_OK) && (zi->ci.zip64)) { // write the Zip64 extended info short HeaderID = 1; short DataSize = 16; ZPOS64_T CompressedSize = 0; ZPOS64_T UncompressedSize = 0; // Remember position of Zip64 extended info for the local file header. (needed when we update size after done with file) zi->ci.pos_zip64extrainfo = ZTELL64(zi->z_filefunc,zi->filestream); err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (ZPOS64_T)HeaderID,2); err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (ZPOS64_T)DataSize,2); err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (ZPOS64_T)UncompressedSize,8); err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (ZPOS64_T)CompressedSize,8); } return err; } /* NOTE. When writing RAW the ZIP64 extended information in extrafield_local and extrafield_global needs to be stripped before calling this function it can be done with zipRemoveExtraInfoBlock It is not done here because then we need to realloc a new buffer since parameters are 'const' and I want to minimize unnecessary allocations. */ extern int ZEXPORT zipOpenNewFileInZip4_64(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int windowBits,int memLevel, int strategy, const char* password, uLong crcForCrypting, uLong versionMadeBy, uLong flagBase, int zip64) { zip64_internal* zi; uInt size_filename; uInt size_comment; uInt i; int err = ZIP_OK; # ifdef NOCRYPT (crcForCrypting); if (password != NULL) return ZIP_PARAMERROR; # endif if (file == NULL) return ZIP_PARAMERROR; #ifdef HAVE_BZIP2 if ((method!=0) && (method!=Z_DEFLATED) && (method!=Z_BZIP2ED)) return ZIP_PARAMERROR; #else if ((method!=0) && (method!=Z_DEFLATED)) return ZIP_PARAMERROR; #endif // The filename and comment length must fit in 16 bits. if ((filename!=NULL) && (strlen(filename)>0xffff)) return ZIP_PARAMERROR; if ((comment!=NULL) && (strlen(comment)>0xffff)) return ZIP_PARAMERROR; // The extra field length must fit in 16 bits. If the member also requires // a Zip64 extra block, that will also need to fit within that 16-bit // length, but that will be checked for later. if ((size_extrafield_local>0xffff) || (size_extrafield_global>0xffff)) return ZIP_PARAMERROR; zi = (zip64_internal*)file; if (zi->in_opened_file_inzip == 1) { err = zipCloseFileInZip (file); if (err != ZIP_OK) return err; } if (filename==NULL) filename="-"; if (comment==NULL) size_comment = 0; else size_comment = (uInt)strlen(comment); size_filename = (uInt)strlen(filename); if (zipfi == NULL) zi->ci.dosDate = 0; else { if (zipfi->dosDate != 0) zi->ci.dosDate = zipfi->dosDate; else zi->ci.dosDate = zip64local_TmzDateToDosDate(&zipfi->tmz_date); } zi->ci.flag = flagBase; if ((level==8) || (level==9)) zi->ci.flag |= 2; if (level==2) zi->ci.flag |= 4; if (level==1) zi->ci.flag |= 6; if (password != NULL) zi->ci.flag |= 1; zi->ci.crc32 = 0; zi->ci.method = method; zi->ci.encrypt = 0; zi->ci.stream_initialised = 0; zi->ci.pos_in_buffered_data = 0; zi->ci.raw = raw; zi->ci.pos_local_header = ZTELL64(zi->z_filefunc,zi->filestream); zi->ci.size_centralheader = SIZECENTRALHEADER + size_filename + size_extrafield_global + size_comment; zi->ci.size_centralExtraFree = 32; // Extra space we have reserved in case we need to add ZIP64 extra info data zi->ci.central_header = (char*)ALLOC((uInt)zi->ci.size_centralheader + zi->ci.size_centralExtraFree); zi->ci.size_centralExtra = size_extrafield_global; zip64local_putValue_inmemory(zi->ci.central_header,(uLong)CENTRALHEADERMAGIC,4); /* version info */ zip64local_putValue_inmemory(zi->ci.central_header+4,(uLong)versionMadeBy,2); zip64local_putValue_inmemory(zi->ci.central_header+6,(uLong)20,2); zip64local_putValue_inmemory(zi->ci.central_header+8,(uLong)zi->ci.flag,2); zip64local_putValue_inmemory(zi->ci.central_header+10,(uLong)zi->ci.method,2); zip64local_putValue_inmemory(zi->ci.central_header+12,(uLong)zi->ci.dosDate,4); zip64local_putValue_inmemory(zi->ci.central_header+16,(uLong)0,4); /*crc*/ zip64local_putValue_inmemory(zi->ci.central_header+20,(uLong)0,4); /*compr size*/ zip64local_putValue_inmemory(zi->ci.central_header+24,(uLong)0,4); /*uncompr size*/ zip64local_putValue_inmemory(zi->ci.central_header+28,(uLong)size_filename,2); zip64local_putValue_inmemory(zi->ci.central_header+30,(uLong)size_extrafield_global,2); zip64local_putValue_inmemory(zi->ci.central_header+32,(uLong)size_comment,2); zip64local_putValue_inmemory(zi->ci.central_header+34,(uLong)0,2); /*disk nm start*/ if (zipfi==NULL) zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)0,2); else zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)zipfi->internal_fa,2); if (zipfi==NULL) zip64local_putValue_inmemory(zi->ci.central_header+38,(uLong)0,4); else zip64local_putValue_inmemory(zi->ci.central_header+38,(uLong)zipfi->external_fa,4); if(zi->ci.pos_local_header >= 0xffffffff) zip64local_putValue_inmemory(zi->ci.central_header+42,(uLong)0xffffffff,4); else zip64local_putValue_inmemory(zi->ci.central_header+42,(uLong)zi->ci.pos_local_header - zi->add_position_when_writing_offset,4); for (i=0;ici.central_header+SIZECENTRALHEADER+i) = *(filename+i); for (i=0;ici.central_header+SIZECENTRALHEADER+size_filename+i) = *(((const char*)extrafield_global)+i); for (i=0;ici.central_header+SIZECENTRALHEADER+size_filename+ size_extrafield_global+i) = *(comment+i); if (zi->ci.central_header == NULL) return ZIP_INTERNALERROR; zi->ci.zip64 = zip64; zi->ci.totalCompressedData = 0; zi->ci.totalUncompressedData = 0; zi->ci.pos_zip64extrainfo = 0; err = Write_LocalFileHeader(zi, filename, size_extrafield_local, extrafield_local); #ifdef HAVE_BZIP2 zi->ci.bstream.avail_in = (uInt)0; zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE; zi->ci.bstream.next_out = (char*)zi->ci.buffered_data; zi->ci.bstream.total_in_hi32 = 0; zi->ci.bstream.total_in_lo32 = 0; zi->ci.bstream.total_out_hi32 = 0; zi->ci.bstream.total_out_lo32 = 0; #endif zi->ci.stream.avail_in = (uInt)0; zi->ci.stream.avail_out = (uInt)Z_BUFSIZE; zi->ci.stream.next_out = zi->ci.buffered_data; zi->ci.stream.total_in = 0; zi->ci.stream.total_out = 0; zi->ci.stream.data_type = Z_BINARY; #ifdef HAVE_BZIP2 if ((err==ZIP_OK) && (zi->ci.method == Z_DEFLATED || zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw)) #else if ((err==ZIP_OK) && (zi->ci.method == Z_DEFLATED) && (!zi->ci.raw)) #endif { if(zi->ci.method == Z_DEFLATED) { zi->ci.stream.zalloc = (alloc_func)0; zi->ci.stream.zfree = (free_func)0; zi->ci.stream.opaque = (voidpf)0; if (windowBits>0) windowBits = -windowBits; err = deflateInit2(&zi->ci.stream, level, Z_DEFLATED, windowBits, memLevel, strategy); if (err==Z_OK) zi->ci.stream_initialised = Z_DEFLATED; } else if(zi->ci.method == Z_BZIP2ED) { #ifdef HAVE_BZIP2 // Init BZip stuff here zi->ci.bstream.bzalloc = 0; zi->ci.bstream.bzfree = 0; zi->ci.bstream.opaque = (voidpf)0; err = BZ2_bzCompressInit(&zi->ci.bstream, level, 0,35); if(err == BZ_OK) zi->ci.stream_initialised = Z_BZIP2ED; #endif } } # ifndef NOCRYPT zi->ci.crypt_header_size = 0; if ((err==Z_OK) && (password != NULL)) { unsigned char bufHead[RAND_HEAD_LEN]; unsigned int sizeHead; zi->ci.encrypt = 1; zi->ci.pcrc_32_tab = get_crc_table(); /*init_keys(password,zi->ci.keys,zi->ci.pcrc_32_tab);*/ sizeHead=crypthead(password,bufHead,RAND_HEAD_LEN,zi->ci.keys,zi->ci.pcrc_32_tab,crcForCrypting); zi->ci.crypt_header_size = sizeHead; if (ZWRITE64(zi->z_filefunc,zi->filestream,bufHead,sizeHead) != sizeHead) err = ZIP_ERRNO; } # endif if (err==Z_OK) zi->in_opened_file_inzip = 1; return err; } extern int ZEXPORT zipOpenNewFileInZip4(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int windowBits,int memLevel, int strategy, const char* password, uLong crcForCrypting, uLong versionMadeBy, uLong flagBase) { return zipOpenNewFileInZip4_64(file, filename, zipfi, extrafield_local, size_extrafield_local, extrafield_global, size_extrafield_global, comment, method, level, raw, windowBits, memLevel, strategy, password, crcForCrypting, versionMadeBy, flagBase, 0); } extern int ZEXPORT zipOpenNewFileInZip3(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int windowBits,int memLevel, int strategy, const char* password, uLong crcForCrypting) { return zipOpenNewFileInZip4_64(file, filename, zipfi, extrafield_local, size_extrafield_local, extrafield_global, size_extrafield_global, comment, method, level, raw, windowBits, memLevel, strategy, password, crcForCrypting, VERSIONMADEBY, 0, 0); } extern int ZEXPORT zipOpenNewFileInZip3_64(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int windowBits,int memLevel, int strategy, const char* password, uLong crcForCrypting, int zip64) { return zipOpenNewFileInZip4_64(file, filename, zipfi, extrafield_local, size_extrafield_local, extrafield_global, size_extrafield_global, comment, method, level, raw, windowBits, memLevel, strategy, password, crcForCrypting, VERSIONMADEBY, 0, zip64); } extern int ZEXPORT zipOpenNewFileInZip2(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw) { return zipOpenNewFileInZip4_64(file, filename, zipfi, extrafield_local, size_extrafield_local, extrafield_global, size_extrafield_global, comment, method, level, raw, -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, NULL, 0, VERSIONMADEBY, 0, 0); } extern int ZEXPORT zipOpenNewFileInZip2_64(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void* extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int raw, int zip64) { return zipOpenNewFileInZip4_64(file, filename, zipfi, extrafield_local, size_extrafield_local, extrafield_global, size_extrafield_global, comment, method, level, raw, -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, NULL, 0, VERSIONMADEBY, 0, zip64); } extern int ZEXPORT zipOpenNewFileInZip64(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void*extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level, int zip64) { return zipOpenNewFileInZip4_64(file, filename, zipfi, extrafield_local, size_extrafield_local, extrafield_global, size_extrafield_global, comment, method, level, 0, -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, NULL, 0, VERSIONMADEBY, 0, zip64); } extern int ZEXPORT zipOpenNewFileInZip(zipFile file, const char* filename, const zip_fileinfo* zipfi, const void* extrafield_local, uInt size_extrafield_local, const void*extrafield_global, uInt size_extrafield_global, const char* comment, int method, int level) { return zipOpenNewFileInZip4_64(file, filename, zipfi, extrafield_local, size_extrafield_local, extrafield_global, size_extrafield_global, comment, method, level, 0, -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, NULL, 0, VERSIONMADEBY, 0, 0); } local int zip64FlushWriteBuffer(zip64_internal* zi) { int err=ZIP_OK; if (zi->ci.encrypt != 0) { #ifndef NOCRYPT uInt i; int t; for (i=0;ici.pos_in_buffered_data;i++) zi->ci.buffered_data[i] = zencode(zi->ci.keys, zi->ci.pcrc_32_tab, zi->ci.buffered_data[i],t); #endif } if (ZWRITE64(zi->z_filefunc,zi->filestream,zi->ci.buffered_data,zi->ci.pos_in_buffered_data) != zi->ci.pos_in_buffered_data) err = ZIP_ERRNO; zi->ci.totalCompressedData += zi->ci.pos_in_buffered_data; #ifdef HAVE_BZIP2 if(zi->ci.method == Z_BZIP2ED) { zi->ci.totalUncompressedData += zi->ci.bstream.total_in_lo32; zi->ci.bstream.total_in_lo32 = 0; zi->ci.bstream.total_in_hi32 = 0; } else #endif { zi->ci.totalUncompressedData += zi->ci.stream.total_in; zi->ci.stream.total_in = 0; } zi->ci.pos_in_buffered_data = 0; return err; } extern int ZEXPORT zipWriteInFileInZip(zipFile file, const void* buf, unsigned int len) { zip64_internal* zi; int err=ZIP_OK; if (file == NULL) return ZIP_PARAMERROR; zi = (zip64_internal*)file; if (zi->in_opened_file_inzip == 0) return ZIP_PARAMERROR; zi->ci.crc32 = crc32(zi->ci.crc32,buf,(uInt)len); #ifdef HAVE_BZIP2 if(zi->ci.method == Z_BZIP2ED && (!zi->ci.raw)) { zi->ci.bstream.next_in = (void*)buf; zi->ci.bstream.avail_in = len; err = BZ_RUN_OK; while ((err==BZ_RUN_OK) && (zi->ci.bstream.avail_in>0)) { if (zi->ci.bstream.avail_out == 0) { if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO) err = ZIP_ERRNO; zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE; zi->ci.bstream.next_out = (char*)zi->ci.buffered_data; } if(err != BZ_RUN_OK) break; if ((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw)) { uLong uTotalOutBefore_lo = zi->ci.bstream.total_out_lo32; // uLong uTotalOutBefore_hi = zi->ci.bstream.total_out_hi32; err=BZ2_bzCompress(&zi->ci.bstream, BZ_RUN); zi->ci.pos_in_buffered_data += (uInt)(zi->ci.bstream.total_out_lo32 - uTotalOutBefore_lo) ; } } if(err == BZ_RUN_OK) err = ZIP_OK; } else #endif { zi->ci.stream.next_in = (Bytef*)(uintptr_t)buf; zi->ci.stream.avail_in = len; while ((err==ZIP_OK) && (zi->ci.stream.avail_in>0)) { if (zi->ci.stream.avail_out == 0) { if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO) err = ZIP_ERRNO; zi->ci.stream.avail_out = (uInt)Z_BUFSIZE; zi->ci.stream.next_out = zi->ci.buffered_data; } if(err != ZIP_OK) break; if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw)) { uLong uTotalOutBefore = zi->ci.stream.total_out; err=deflate(&zi->ci.stream, Z_NO_FLUSH); zi->ci.pos_in_buffered_data += (uInt)(zi->ci.stream.total_out - uTotalOutBefore) ; } else { uInt copy_this,i; if (zi->ci.stream.avail_in < zi->ci.stream.avail_out) copy_this = zi->ci.stream.avail_in; else copy_this = zi->ci.stream.avail_out; for (i = 0; i < copy_this; i++) *(((char*)zi->ci.stream.next_out)+i) = *(((const char*)zi->ci.stream.next_in)+i); { zi->ci.stream.avail_in -= copy_this; zi->ci.stream.avail_out-= copy_this; zi->ci.stream.next_in+= copy_this; zi->ci.stream.next_out+= copy_this; zi->ci.stream.total_in+= copy_this; zi->ci.stream.total_out+= copy_this; zi->ci.pos_in_buffered_data += copy_this; } } }// while(...) } return err; } extern int ZEXPORT zipCloseFileInZipRaw(zipFile file, uLong uncompressed_size, uLong crc32) { return zipCloseFileInZipRaw64 (file, uncompressed_size, crc32); } extern int ZEXPORT zipCloseFileInZipRaw64(zipFile file, ZPOS64_T uncompressed_size, uLong crc32) { zip64_internal* zi; ZPOS64_T compressed_size; uLong invalidValue = 0xffffffff; unsigned datasize = 0; int err=ZIP_OK; if (file == NULL) return ZIP_PARAMERROR; zi = (zip64_internal*)file; if (zi->in_opened_file_inzip == 0) return ZIP_PARAMERROR; zi->ci.stream.avail_in = 0; if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw)) { while (err==ZIP_OK) { uLong uTotalOutBefore; if (zi->ci.stream.avail_out == 0) { if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO) err = ZIP_ERRNO; zi->ci.stream.avail_out = (uInt)Z_BUFSIZE; zi->ci.stream.next_out = zi->ci.buffered_data; } uTotalOutBefore = zi->ci.stream.total_out; err=deflate(&zi->ci.stream, Z_FINISH); zi->ci.pos_in_buffered_data += (uInt)(zi->ci.stream.total_out - uTotalOutBefore) ; } } else if ((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw)) { #ifdef HAVE_BZIP2 err = BZ_FINISH_OK; while (err==BZ_FINISH_OK) { uLong uTotalOutBefore; if (zi->ci.bstream.avail_out == 0) { if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO) err = ZIP_ERRNO; zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE; zi->ci.bstream.next_out = (char*)zi->ci.buffered_data; } uTotalOutBefore = zi->ci.bstream.total_out_lo32; err=BZ2_bzCompress(&zi->ci.bstream, BZ_FINISH); if(err == BZ_STREAM_END) err = Z_STREAM_END; zi->ci.pos_in_buffered_data += (uInt)(zi->ci.bstream.total_out_lo32 - uTotalOutBefore); } if(err == BZ_FINISH_OK) err = ZIP_OK; #endif } if (err==Z_STREAM_END) err=ZIP_OK; /* this is normal */ if ((zi->ci.pos_in_buffered_data>0) && (err==ZIP_OK)) { if (zip64FlushWriteBuffer(zi)==ZIP_ERRNO) err = ZIP_ERRNO; } if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw)) { int tmp_err = deflateEnd(&zi->ci.stream); if (err == ZIP_OK) err = tmp_err; zi->ci.stream_initialised = 0; } #ifdef HAVE_BZIP2 else if((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw)) { int tmperr = BZ2_bzCompressEnd(&zi->ci.bstream); if (err==ZIP_OK) err = tmperr; zi->ci.stream_initialised = 0; } #endif if (!zi->ci.raw) { crc32 = (uLong)zi->ci.crc32; uncompressed_size = zi->ci.totalUncompressedData; } compressed_size = zi->ci.totalCompressedData; # ifndef NOCRYPT compressed_size += zi->ci.crypt_header_size; # endif // update Current Item crc and sizes, if(compressed_size >= 0xffffffff || uncompressed_size >= 0xffffffff || zi->ci.pos_local_header >= 0xffffffff) { /*version Made by*/ zip64local_putValue_inmemory(zi->ci.central_header+4,(uLong)45,2); /*version needed*/ zip64local_putValue_inmemory(zi->ci.central_header+6,(uLong)45,2); } zip64local_putValue_inmemory(zi->ci.central_header+16,crc32,4); /*crc*/ if(compressed_size >= 0xffffffff) zip64local_putValue_inmemory(zi->ci.central_header+20, invalidValue,4); /*compr size*/ else zip64local_putValue_inmemory(zi->ci.central_header+20, compressed_size,4); /*compr size*/ /// set internal file attributes field if (zi->ci.stream.data_type == Z_ASCII) zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)Z_ASCII,2); if(uncompressed_size >= 0xffffffff) zip64local_putValue_inmemory(zi->ci.central_header+24, invalidValue,4); /*uncompr size*/ else zip64local_putValue_inmemory(zi->ci.central_header+24, uncompressed_size,4); /*uncompr size*/ // Add ZIP64 extra info field for uncompressed size if(uncompressed_size >= 0xffffffff) datasize += 8; // Add ZIP64 extra info field for compressed size if(compressed_size >= 0xffffffff) datasize += 8; // Add ZIP64 extra info field for relative offset to local file header of current file if(zi->ci.pos_local_header >= 0xffffffff) datasize += 8; if(datasize > 0) { char* p = NULL; if((uLong)(datasize + 4) > zi->ci.size_centralExtraFree) { // we cannot write more data to the buffer that we have room for. return ZIP_BADZIPFILE; } p = zi->ci.central_header + zi->ci.size_centralheader; // Add Extra Information Header for 'ZIP64 information' zip64local_putValue_inmemory(p, 0x0001, 2); // HeaderID p += 2; zip64local_putValue_inmemory(p, datasize, 2); // DataSize p += 2; if(uncompressed_size >= 0xffffffff) { zip64local_putValue_inmemory(p, uncompressed_size, 8); p += 8; } if(compressed_size >= 0xffffffff) { zip64local_putValue_inmemory(p, compressed_size, 8); p += 8; } if(zi->ci.pos_local_header >= 0xffffffff) { zip64local_putValue_inmemory(p, zi->ci.pos_local_header, 8); p += 8; } // Update how much extra free space we got in the memory buffer // and increase the centralheader size so the new ZIP64 fields are included // ( 4 below is the size of HeaderID and DataSize field ) zi->ci.size_centralExtraFree -= datasize + 4; zi->ci.size_centralheader += datasize + 4; // Update the extra info size field zi->ci.size_centralExtra += datasize + 4; zip64local_putValue_inmemory(zi->ci.central_header+30,(uLong)zi->ci.size_centralExtra,2); } if (err==ZIP_OK) err = add_data_in_datablock(&zi->central_dir, zi->ci.central_header, (uLong)zi->ci.size_centralheader); free(zi->ci.central_header); if (err==ZIP_OK) { // Update the LocalFileHeader with the new values. ZPOS64_T cur_pos_inzip = ZTELL64(zi->z_filefunc,zi->filestream); if (ZSEEK64(zi->z_filefunc,zi->filestream, zi->ci.pos_local_header + 14,ZLIB_FILEFUNC_SEEK_SET)!=0) err = ZIP_ERRNO; if (err==ZIP_OK) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,crc32,4); /* crc 32, unknown */ if(uncompressed_size >= 0xffffffff || compressed_size >= 0xffffffff ) { if(zi->ci.pos_zip64extrainfo > 0) { // Update the size in the ZIP64 extended field. if (ZSEEK64(zi->z_filefunc,zi->filestream, zi->ci.pos_zip64extrainfo + 4,ZLIB_FILEFUNC_SEEK_SET)!=0) err = ZIP_ERRNO; if (err==ZIP_OK) /* compressed size, unknown */ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, uncompressed_size, 8); if (err==ZIP_OK) /* uncompressed size, unknown */ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, compressed_size, 8); } else err = ZIP_BADZIPFILE; // Caller passed zip64 = 0, so no room for zip64 info -> fatal } else { if (err==ZIP_OK) /* compressed size, unknown */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,compressed_size,4); if (err==ZIP_OK) /* uncompressed size, unknown */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,uncompressed_size,4); } if (ZSEEK64(zi->z_filefunc,zi->filestream, cur_pos_inzip,ZLIB_FILEFUNC_SEEK_SET)!=0) err = ZIP_ERRNO; } zi->number_entry ++; zi->in_opened_file_inzip = 0; return err; } extern int ZEXPORT zipCloseFileInZip(zipFile file) { return zipCloseFileInZipRaw (file,0,0); } local int Write_Zip64EndOfCentralDirectoryLocator(zip64_internal* zi, ZPOS64_T zip64eocd_pos_inzip) { int err = ZIP_OK; ZPOS64_T pos = zip64eocd_pos_inzip - zi->add_position_when_writing_offset; err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ZIP64ENDLOCHEADERMAGIC,4); /*num disks*/ if (err==ZIP_OK) /* number of the disk with the start of the central directory */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /*relative offset*/ if (err==ZIP_OK) /* Relative offset to the Zip64EndOfCentralDirectory */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream, pos,8); /*total disks*/ /* Do not support spawning of disk so always say 1 here*/ if (err==ZIP_OK) /* number of the disk with the start of the central directory */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)1,4); return err; } local int Write_Zip64EndOfCentralDirectoryRecord(zip64_internal* zi, uLong size_centraldir, ZPOS64_T centraldir_pos_inzip) { int err = ZIP_OK; uLong Zip64DataSize = 44; err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ZIP64ENDHEADERMAGIC,4); if (err==ZIP_OK) /* size of this 'zip64 end of central directory' */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(ZPOS64_T)Zip64DataSize,8); // why ZPOS64_T of this ? if (err==ZIP_OK) /* version made by */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2); if (err==ZIP_OK) /* version needed */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2); if (err==ZIP_OK) /* number of this disk */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); if (err==ZIP_OK) /* number of the disk with the start of the central directory */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); if (err==ZIP_OK) /* total number of entries in the central dir on this disk */ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, zi->number_entry, 8); if (err==ZIP_OK) /* total number of entries in the central dir */ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, zi->number_entry, 8); if (err==ZIP_OK) /* size of the central directory */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(ZPOS64_T)size_centraldir,8); if (err==ZIP_OK) /* offset of start of central directory with respect to the starting disk number */ { ZPOS64_T pos = centraldir_pos_inzip - zi->add_position_when_writing_offset; err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (ZPOS64_T)pos,8); } return err; } local int Write_EndOfCentralDirectoryRecord(zip64_internal* zi, uLong size_centraldir, ZPOS64_T centraldir_pos_inzip) { int err = ZIP_OK; /*signature*/ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ENDHEADERMAGIC,4); if (err==ZIP_OK) /* number of this disk */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,2); if (err==ZIP_OK) /* number of the disk with the start of the central directory */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,2); if (err==ZIP_OK) /* total number of entries in the central dir on this disk */ { { if(zi->number_entry >= 0xFFFF) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xffff,2); // use value in ZIP64 record else err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->number_entry,2); } } if (err==ZIP_OK) /* total number of entries in the central dir */ { if(zi->number_entry >= 0xFFFF) err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xffff,2); // use value in ZIP64 record else err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->number_entry,2); } if (err==ZIP_OK) /* size of the central directory */ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_centraldir,4); if (err==ZIP_OK) /* offset of start of central directory with respect to the starting disk number */ { ZPOS64_T pos = centraldir_pos_inzip - zi->add_position_when_writing_offset; if(pos >= 0xffffffff) { err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (uLong)0xffffffff,4); } else err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (uLong)(centraldir_pos_inzip - zi->add_position_when_writing_offset),4); } return err; } local int Write_GlobalComment(zip64_internal* zi, const char* global_comment) { int err = ZIP_OK; uInt size_global_comment = 0; if(global_comment != NULL) size_global_comment = (uInt)strlen(global_comment); err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_global_comment,2); if (err == ZIP_OK && size_global_comment > 0) { if (ZWRITE64(zi->z_filefunc,zi->filestream, global_comment, size_global_comment) != size_global_comment) err = ZIP_ERRNO; } return err; } extern int ZEXPORT zipClose(zipFile file, const char* global_comment) { zip64_internal* zi; int err = 0; uLong size_centraldir = 0; ZPOS64_T centraldir_pos_inzip; ZPOS64_T pos; if (file == NULL) return ZIP_PARAMERROR; zi = (zip64_internal*)file; if (zi->in_opened_file_inzip == 1) { err = zipCloseFileInZip (file); } #ifndef NO_ADDFILEINEXISTINGZIP if (global_comment==NULL) global_comment = zi->globalcomment; #endif centraldir_pos_inzip = ZTELL64(zi->z_filefunc,zi->filestream); if (err==ZIP_OK) { linkedlist_datablock_internal* ldi = zi->central_dir.first_block; while (ldi!=NULL) { if ((err==ZIP_OK) && (ldi->filled_in_this_block>0)) { if (ZWRITE64(zi->z_filefunc,zi->filestream, ldi->data, ldi->filled_in_this_block) != ldi->filled_in_this_block) err = ZIP_ERRNO; } size_centraldir += ldi->filled_in_this_block; ldi = ldi->next_datablock; } } free_linkedlist(&(zi->central_dir)); pos = centraldir_pos_inzip - zi->add_position_when_writing_offset; if(pos >= 0xffffffff || zi->number_entry >= 0xFFFF) { ZPOS64_T Zip64EOCDpos = ZTELL64(zi->z_filefunc,zi->filestream); Write_Zip64EndOfCentralDirectoryRecord(zi, size_centraldir, centraldir_pos_inzip); Write_Zip64EndOfCentralDirectoryLocator(zi, Zip64EOCDpos); } if (err==ZIP_OK) err = Write_EndOfCentralDirectoryRecord(zi, size_centraldir, centraldir_pos_inzip); if(err == ZIP_OK) err = Write_GlobalComment(zi, global_comment); if (ZCLOSE64(zi->z_filefunc,zi->filestream) != 0) if (err == ZIP_OK) err = ZIP_ERRNO; #ifndef NO_ADDFILEINEXISTINGZIP free(zi->globalcomment); #endif free(zi); return err; } extern int ZEXPORT zipRemoveExtraInfoBlock(char* pData, int* dataLen, short sHeader) { char* p = pData; int size = 0; char* pNewHeader; char* pTmp; short header; short dataSize; int retVal = ZIP_OK; if(pData == NULL || dataLen == NULL || *dataLen < 4) return ZIP_PARAMERROR; pNewHeader = (char*)ALLOC((unsigned)*dataLen); pTmp = pNewHeader; while(p < (pData + *dataLen)) { header = *(short*)p; dataSize = *(((short*)p)+1); if( header == sHeader ) // Header found. { p += dataSize + 4; // skip it. do not copy to temp buffer } else { // Extra Info block should not be removed, So copy it to the temp buffer. memcpy(pTmp, p, dataSize + 4); p += dataSize + 4; size += dataSize + 4; } } if(size < *dataLen) { // clean old extra info block. memset(pData,0, *dataLen); // copy the new extra info block over the old if(size > 0) memcpy(pData, pNewHeader, size); // set the new extra info size *dataLen = size; retVal = ZIP_OK; } else retVal = ZIP_ERRNO; free(pNewHeader); return retVal; } tcl8.6.14/compat/zlib/contrib/minizip/miniunzip.10000644000175000017500000000350514554262142021313 0ustar sergeisergei.\" Hey, EMACS: -*- nroff -*- .TH miniunzip 1 "Nov 7, 2001" .\" Please adjust this date whenever revising the manpage. .\" .\" Some roff macros, for reference: .\" .nh disable hyphenation .\" .hy enable hyphenation .\" .ad l left justify .\" .ad b justify to both left and right margins .\" .nf disable filling .\" .fi enable filling .\" .br insert line break .\" .sp insert n+1 empty lines .\" for manpage-specific macros, see man(7) .SH NAME miniunzip - uncompress and examine ZIP archives .SH SYNOPSIS .B miniunzip .RI [ -exvlo ] zipfile [ files_to_extract ] [-d tempdir] .SH DESCRIPTION .B minizip is a simple tool which allows the extraction of compressed file archives in the ZIP format used by the MS-DOS utility PKZIP. It was written as a demonstration of the .IR zlib (3) library and therefore lack many of the features of the .IR unzip (1) program. .SH OPTIONS A number of options are supported. With the exception of .BI \-d\ tempdir these must be supplied before any other arguments and are: .TP .BI \-l\ ,\ \-\-v List the files in the archive without extracting them. .TP .B \-o Overwrite files without prompting for confirmation. .TP .B \-x Extract files (default). .PP The .I zipfile argument is the name of the archive to process. The next argument can be used to specify a single file to extract from the archive. Lastly, the following option can be specified at the end of the command-line: .TP .BI \-d\ tempdir Extract the archive in the directory .I tempdir rather than the current directory. .SH SEE ALSO .BR minizip (1), .BR zlib (3), .BR unzip (1). .SH AUTHOR This program was written by Gilles Vollant. This manual page was written by Mark Brown . The -d tempdir option was added by Dirk Eddelbuettel . tcl8.6.14/compat/zlib/contrib/minizip/minizip.pc.in0000644000175000017500000000040714554262142021615 0ustar sergeisergeiprefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@/minizip Name: minizip Description: Minizip zip file manipulation library Requires: Version: @PACKAGE_VERSION@ Libs: -L${libdir} -lminizip Libs.private: -lz Cflags: -I${includedir} tcl8.6.14/compat/zlib/contrib/minizip/iowin32.h0000644000175000017500000000147714554262142020660 0ustar sergeisergei/* iowin32.h -- IO base function header for compress/uncompress .zip Version 1.1, February 14h, 2010 part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html ) Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html ) Modifications for Zip64 support Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) For more info read MiniZip_info.txt */ #include #ifdef __cplusplus extern "C" { #endif void fill_win32_filefunc(zlib_filefunc_def* pzlib_filefunc_def); void fill_win32_filefunc64(zlib_filefunc64_def* pzlib_filefunc_def); void fill_win32_filefunc64A(zlib_filefunc64_def* pzlib_filefunc_def); void fill_win32_filefunc64W(zlib_filefunc64_def* pzlib_filefunc_def); #ifdef __cplusplus } #endif tcl8.6.14/compat/zlib/contrib/nuget/0000755000175000017500000000000014566153412016651 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/nuget/nuget.sln0000644000175000017500000000170314560736524020517 0ustar sergeisergeiяЛП Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio Version 17 VisualStudioVersion = 17.0.31903.59 MinimumVisualStudioVersion = 10.0.40219.1 Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "nuget", "nuget.csproj", "{B1BD3984-EF8F-4E9D-9A94-EB784E5EB1E8}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU Release|Any CPU = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {B1BD3984-EF8F-4E9D-9A94-EB784E5EB1E8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {B1BD3984-EF8F-4E9D-9A94-EB784E5EB1E8}.Debug|Any CPU.Build.0 = Debug|Any CPU {B1BD3984-EF8F-4E9D-9A94-EB784E5EB1E8}.Release|Any CPU.ActiveCfg = Release|Any CPU {B1BD3984-EF8F-4E9D-9A94-EB784E5EB1E8}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection EndGlobal tcl8.6.14/compat/zlib/contrib/nuget/nuget.csproj0000644000175000017500000000713214560736524021225 0ustar sergeisergei net6.0 madler.zlib.redist $(PackageId).win $(PackageId).linux $(PackageId).osx (C) 1995-2024 Jean-loup Gailly and Mark Adler 1.3.1 NuGet Package for consuming native builds of zlib into .NET without complexity. NU5128 $(MSBuildProjectDirectory) Jean-loup Gailly and Mark Adler tcl8.6.14/compat/zlib/contrib/ada/0000755000175000017500000000000014566153412016254 5ustar sergeisergeitcl8.6.14/compat/zlib/contrib/ada/readme.txt0000644000175000017500000000420114554262142020245 0ustar sergeisergei ZLib for Ada thick binding (ZLib.Ada) Release 1.3 ZLib.Ada is a thick binding interface to the popular ZLib data compression library, available at http://www.gzip.org/zlib/. It provides Ada-style access to the ZLib C library. Here are the main changes since ZLib.Ada 1.2: - Attention: ZLib.Read generic routine have a initialization requirement for Read_Last parameter now. It is a bit incompatible with previous version, but extends functionality, we could use new parameters Allow_Read_Some and Flush now. - Added Is_Open routines to ZLib and ZLib.Streams packages. - Add pragma Assert to check Stream_Element is 8 bit. - Fix extraction to buffer with exact known decompressed size. Error reported by Steve Sangwine. - Fix definition of ULong (changed to unsigned_long), fix regression on 64 bits computers. Patch provided by Pascal Obry. - Add Status_Error exception definition. - Add pragma Assertion that Ada.Streams.Stream_Element size is 8 bit. How to build ZLib.Ada under GNAT You should have the ZLib library already build on your computer, before building ZLib.Ada. Make the directory of ZLib.Ada sources current and issue the command: gnatmake test -largs -L -lz Or use the GNAT project file build for GNAT 3.15 or later: gnatmake -Pzlib.gpr -L How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2 1. Make a project with all *.ads and *.adb files from the distribution. 2. Build the libz.a library from the ZLib C sources. 3. Rename libz.a to z.lib. 4. Add the library z.lib to the project. 5. Add the libc.lib library from the ObjectAda distribution to the project. 6. Build the executable using test.adb as a main procedure. How to use ZLib.Ada The source files test.adb and read.adb are small demo programs that show the main functionality of ZLib.Ada. The routines from the package specifications are commented. Homepage: http://zlib-ada.sourceforge.net/ Author: Dmitriy Anisimkov Contributors: Pascal Obry , Steve Sangwine tcl8.6.14/compat/zlib/contrib/ada/buffer_demo.adb0000644000175000017500000000720514554262142021203 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2004 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- -- $Id: buffer_demo.adb,v 1.3 2004/09/06 06:55:35 vagul Exp $ -- This demo program provided by Dr Steve Sangwine -- -- Demonstration of a problem with Zlib-Ada (already fixed) when a buffer -- of exactly the correct size is used for decompressed data, and the last -- few bytes passed in to Zlib are checksum bytes. -- This program compresses a string of text, and then decompresses the -- compressed text into a buffer of the same size as the original text. with Ada.Streams; use Ada.Streams; with Ada.Text_IO; with ZLib; use ZLib; procedure Buffer_Demo is EOL : Character renames ASCII.LF; Text : constant String := "Four score and seven years ago our fathers brought forth," & EOL & "upon this continent, a new nation, conceived in liberty," & EOL & "and dedicated to the proposition that `all men are created equal'."; Source : Stream_Element_Array (1 .. Text'Length); for Source'Address use Text'Address; begin Ada.Text_IO.Put (Text); Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("Uncompressed size : " & Positive'Image (Text'Length) & " bytes"); declare Compressed_Data : Stream_Element_Array (1 .. Text'Length); L : Stream_Element_Offset; begin Compress : declare Compressor : Filter_Type; I : Stream_Element_Offset; begin Deflate_Init (Compressor); -- Compress the whole of T at once. Translate (Compressor, Source, I, Compressed_Data, L, Finish); pragma Assert (I = Source'Last); Close (Compressor); Ada.Text_IO.Put_Line ("Compressed size : " & Stream_Element_Offset'Image (L) & " bytes"); end Compress; -- Now we decompress the data, passing short blocks of data to Zlib -- (because this demonstrates the problem - the last block passed will -- contain checksum information and there will be no output, only a -- check inside Zlib that the checksum is correct). Decompress : declare Decompressor : Filter_Type; Uncompressed_Data : Stream_Element_Array (1 .. Text'Length); Block_Size : constant := 4; -- This makes sure that the last block contains -- only Adler checksum data. P : Stream_Element_Offset := Compressed_Data'First - 1; O : Stream_Element_Offset; begin Inflate_Init (Decompressor); loop Translate (Decompressor, Compressed_Data (P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)), P, Uncompressed_Data (Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last), O, No_Flush); Ada.Text_IO.Put_Line ("Total in : " & Count'Image (Total_In (Decompressor)) & ", out : " & Count'Image (Total_Out (Decompressor))); exit when P = L; end loop; Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("Decompressed text matches original text : " & Boolean'Image (Uncompressed_Data = Source)); end Decompress; end; end Buffer_Demo; tcl8.6.14/compat/zlib/contrib/ada/zlib-thin.ads0000644000175000017500000003671314554262142020655 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $ with Interfaces.C.Strings; with System; private package ZLib.Thin is -- From zconf.h MAX_MEM_LEVEL : constant := 9; -- zconf.h:105 -- zconf.h:105 MAX_WBITS : constant := 15; -- zconf.h:115 -- 32K LZ77 window -- zconf.h:115 SEEK_SET : constant := 8#0000#; -- zconf.h:244 -- Seek from beginning of file. -- zconf.h:244 SEEK_CUR : constant := 1; -- zconf.h:245 -- Seek from current position. -- zconf.h:245 SEEK_END : constant := 2; -- zconf.h:246 -- Set file pointer to EOF plus "offset" -- zconf.h:246 type Byte is new Interfaces.C.unsigned_char; -- 8 bits -- zconf.h:214 type UInt is new Interfaces.C.unsigned; -- 16 bits or more -- zconf.h:216 type Int is new Interfaces.C.int; type ULong is new Interfaces.C.unsigned_long; -- 32 bits or more -- zconf.h:217 subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr; type ULong_Access is access ULong; type Int_Access is access Int; subtype Voidp is System.Address; -- zconf.h:232 subtype Byte_Access is Voidp; Nul : constant Voidp := System.Null_Address; -- end from zconf Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125 -- zlib.h:125 Z_PARTIAL_FLUSH : constant := 1; -- zlib.h:126 -- will be removed, use -- Z_SYNC_FLUSH instead -- zlib.h:126 Z_SYNC_FLUSH : constant := 2; -- zlib.h:127 -- zlib.h:127 Z_FULL_FLUSH : constant := 3; -- zlib.h:128 -- zlib.h:128 Z_FINISH : constant := 4; -- zlib.h:129 -- zlib.h:129 Z_OK : constant := 8#0000#; -- zlib.h:132 -- zlib.h:132 Z_STREAM_END : constant := 1; -- zlib.h:133 -- zlib.h:133 Z_NEED_DICT : constant := 2; -- zlib.h:134 -- zlib.h:134 Z_ERRNO : constant := -1; -- zlib.h:135 -- zlib.h:135 Z_STREAM_ERROR : constant := -2; -- zlib.h:136 -- zlib.h:136 Z_DATA_ERROR : constant := -3; -- zlib.h:137 -- zlib.h:137 Z_MEM_ERROR : constant := -4; -- zlib.h:138 -- zlib.h:138 Z_BUF_ERROR : constant := -5; -- zlib.h:139 -- zlib.h:139 Z_VERSION_ERROR : constant := -6; -- zlib.h:140 -- zlib.h:140 Z_NO_COMPRESSION : constant := 8#0000#; -- zlib.h:145 -- zlib.h:145 Z_BEST_SPEED : constant := 1; -- zlib.h:146 -- zlib.h:146 Z_BEST_COMPRESSION : constant := 9; -- zlib.h:147 -- zlib.h:147 Z_DEFAULT_COMPRESSION : constant := -1; -- zlib.h:148 -- zlib.h:148 Z_FILTERED : constant := 1; -- zlib.h:151 -- zlib.h:151 Z_HUFFMAN_ONLY : constant := 2; -- zlib.h:152 -- zlib.h:152 Z_DEFAULT_STRATEGY : constant := 8#0000#; -- zlib.h:153 -- zlib.h:153 Z_BINARY : constant := 8#0000#; -- zlib.h:156 -- zlib.h:156 Z_ASCII : constant := 1; -- zlib.h:157 -- zlib.h:157 Z_UNKNOWN : constant := 2; -- zlib.h:158 -- zlib.h:158 Z_DEFLATED : constant := 8; -- zlib.h:161 -- zlib.h:161 Z_NULL : constant := 8#0000#; -- zlib.h:164 -- for initializing zalloc, zfree, opaque -- zlib.h:164 type gzFile is new Voidp; -- zlib.h:646 type Z_Stream is private; type Z_Streamp is access all Z_Stream; -- zlib.h:89 type alloc_func is access function (Opaque : Voidp; Items : UInt; Size : UInt) return Voidp; -- zlib.h:63 type free_func is access procedure (opaque : Voidp; address : Voidp); function zlibVersion return Chars_Ptr; function Deflate (strm : Z_Streamp; flush : Int) return Int; function DeflateEnd (strm : Z_Streamp) return Int; function Inflate (strm : Z_Streamp; flush : Int) return Int; function InflateEnd (strm : Z_Streamp) return Int; function deflateSetDictionary (strm : Z_Streamp; dictionary : Byte_Access; dictLength : UInt) return Int; function deflateCopy (dest : Z_Streamp; source : Z_Streamp) return Int; -- zlib.h:478 function deflateReset (strm : Z_Streamp) return Int; -- zlib.h:495 function deflateParams (strm : Z_Streamp; level : Int; strategy : Int) return Int; -- zlib.h:506 function inflateSetDictionary (strm : Z_Streamp; dictionary : Byte_Access; dictLength : UInt) return Int; -- zlib.h:548 function inflateSync (strm : Z_Streamp) return Int; -- zlib.h:565 function inflateReset (strm : Z_Streamp) return Int; -- zlib.h:580 function compress (dest : Byte_Access; destLen : ULong_Access; source : Byte_Access; sourceLen : ULong) return Int; -- zlib.h:601 function compress2 (dest : Byte_Access; destLen : ULong_Access; source : Byte_Access; sourceLen : ULong; level : Int) return Int; -- zlib.h:615 function uncompress (dest : Byte_Access; destLen : ULong_Access; source : Byte_Access; sourceLen : ULong) return Int; function gzopen (path : Chars_Ptr; mode : Chars_Ptr) return gzFile; function gzdopen (fd : Int; mode : Chars_Ptr) return gzFile; function gzsetparams (file : gzFile; level : Int; strategy : Int) return Int; function gzread (file : gzFile; buf : Voidp; len : UInt) return Int; function gzwrite (file : in gzFile; buf : in Voidp; len : in UInt) return Int; function gzprintf (file : in gzFile; format : in Chars_Ptr) return Int; function gzputs (file : in gzFile; s : in Chars_Ptr) return Int; function gzgets (file : gzFile; buf : Chars_Ptr; len : Int) return Chars_Ptr; function gzputc (file : gzFile; char : Int) return Int; function gzgetc (file : gzFile) return Int; function gzflush (file : gzFile; flush : Int) return Int; function gzseek (file : gzFile; offset : Int; whence : Int) return Int; function gzrewind (file : gzFile) return Int; function gztell (file : gzFile) return Int; function gzeof (file : gzFile) return Int; function gzclose (file : gzFile) return Int; function gzerror (file : gzFile; errnum : Int_Access) return Chars_Ptr; function adler32 (adler : ULong; buf : Byte_Access; len : UInt) return ULong; function crc32 (crc : ULong; buf : Byte_Access; len : UInt) return ULong; function deflateInit (strm : Z_Streamp; level : Int; version : Chars_Ptr; stream_size : Int) return Int; function deflateInit2 (strm : Z_Streamp; level : Int; method : Int; windowBits : Int; memLevel : Int; strategy : Int; version : Chars_Ptr; stream_size : Int) return Int; function Deflate_Init (strm : Z_Streamp; level : Int; method : Int; windowBits : Int; memLevel : Int; strategy : Int) return Int; pragma Inline (Deflate_Init); function inflateInit (strm : Z_Streamp; version : Chars_Ptr; stream_size : Int) return Int; function inflateInit2 (strm : in Z_Streamp; windowBits : in Int; version : in Chars_Ptr; stream_size : in Int) return Int; function inflateBackInit (strm : in Z_Streamp; windowBits : in Int; window : in Byte_Access; version : in Chars_Ptr; stream_size : in Int) return Int; -- Size of window have to be 2**windowBits. function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int; pragma Inline (Inflate_Init); function zError (err : Int) return Chars_Ptr; function inflateSyncPoint (z : Z_Streamp) return Int; function get_crc_table return ULong_Access; -- Interface to the available fields of the z_stream structure. -- The application must update next_in and avail_in when avail_in has -- dropped to zero. It must update next_out and avail_out when avail_out -- has dropped to zero. The application must initialize zalloc, zfree and -- opaque before calling the init function. procedure Set_In (Strm : in out Z_Stream; Buffer : in Voidp; Size : in UInt); pragma Inline (Set_In); procedure Set_Out (Strm : in out Z_Stream; Buffer : in Voidp; Size : in UInt); pragma Inline (Set_Out); procedure Set_Mem_Func (Strm : in out Z_Stream; Opaque : in Voidp; Alloc : in alloc_func; Free : in free_func); pragma Inline (Set_Mem_Func); function Last_Error_Message (Strm : in Z_Stream) return String; pragma Inline (Last_Error_Message); function Avail_Out (Strm : in Z_Stream) return UInt; pragma Inline (Avail_Out); function Avail_In (Strm : in Z_Stream) return UInt; pragma Inline (Avail_In); function Total_In (Strm : in Z_Stream) return ULong; pragma Inline (Total_In); function Total_Out (Strm : in Z_Stream) return ULong; pragma Inline (Total_Out); function inflateCopy (dest : in Z_Streamp; Source : in Z_Streamp) return Int; function compressBound (Source_Len : in ULong) return ULong; function deflateBound (Strm : in Z_Streamp; Source_Len : in ULong) return ULong; function gzungetc (C : in Int; File : in gzFile) return Int; function zlibCompileFlags return ULong; private type Z_Stream is record -- zlib.h:68 Next_In : Voidp := Nul; -- next input byte Avail_In : UInt := 0; -- number of bytes available at next_in Total_In : ULong := 0; -- total nb of input bytes read so far Next_Out : Voidp := Nul; -- next output byte should be put there Avail_Out : UInt := 0; -- remaining free space at next_out Total_Out : ULong := 0; -- total nb of bytes output so far msg : Chars_Ptr; -- last error message, NULL if no error state : Voidp; -- not visible by applications zalloc : alloc_func := null; -- used to allocate the internal state zfree : free_func := null; -- used to free the internal state opaque : Voidp; -- private data object passed to -- zalloc and zfree data_type : Int; -- best guess about the data type: -- ascii or binary adler : ULong; -- adler32 value of the uncompressed -- data reserved : ULong; -- reserved for future use end record; pragma Convention (C, Z_Stream); pragma Import (C, zlibVersion, "zlibVersion"); pragma Import (C, Deflate, "deflate"); pragma Import (C, DeflateEnd, "deflateEnd"); pragma Import (C, Inflate, "inflate"); pragma Import (C, InflateEnd, "inflateEnd"); pragma Import (C, deflateSetDictionary, "deflateSetDictionary"); pragma Import (C, deflateCopy, "deflateCopy"); pragma Import (C, deflateReset, "deflateReset"); pragma Import (C, deflateParams, "deflateParams"); pragma Import (C, inflateSetDictionary, "inflateSetDictionary"); pragma Import (C, inflateSync, "inflateSync"); pragma Import (C, inflateReset, "inflateReset"); pragma Import (C, compress, "compress"); pragma Import (C, compress2, "compress2"); pragma Import (C, uncompress, "uncompress"); pragma Import (C, gzopen, "gzopen"); pragma Import (C, gzdopen, "gzdopen"); pragma Import (C, gzsetparams, "gzsetparams"); pragma Import (C, gzread, "gzread"); pragma Import (C, gzwrite, "gzwrite"); pragma Import (C, gzprintf, "gzprintf"); pragma Import (C, gzputs, "gzputs"); pragma Import (C, gzgets, "gzgets"); pragma Import (C, gzputc, "gzputc"); pragma Import (C, gzgetc, "gzgetc"); pragma Import (C, gzflush, "gzflush"); pragma Import (C, gzseek, "gzseek"); pragma Import (C, gzrewind, "gzrewind"); pragma Import (C, gztell, "gztell"); pragma Import (C, gzeof, "gzeof"); pragma Import (C, gzclose, "gzclose"); pragma Import (C, gzerror, "gzerror"); pragma Import (C, adler32, "adler32"); pragma Import (C, crc32, "crc32"); pragma Import (C, deflateInit, "deflateInit_"); pragma Import (C, inflateInit, "inflateInit_"); pragma Import (C, deflateInit2, "deflateInit2_"); pragma Import (C, inflateInit2, "inflateInit2_"); pragma Import (C, zError, "zError"); pragma Import (C, inflateSyncPoint, "inflateSyncPoint"); pragma Import (C, get_crc_table, "get_crc_table"); -- since zlib 1.2.0: pragma Import (C, inflateCopy, "inflateCopy"); pragma Import (C, compressBound, "compressBound"); pragma Import (C, deflateBound, "deflateBound"); pragma Import (C, gzungetc, "gzungetc"); pragma Import (C, zlibCompileFlags, "zlibCompileFlags"); pragma Import (C, inflateBackInit, "inflateBackInit_"); -- I stopped binding the inflateBack routines, because realize that -- it does not support zlib and gzip headers for now, and have no -- symmetric deflateBack routines. -- ZLib-Ada is symmetric regarding deflate/inflate data transformation -- and has a similar generic callback interface for the -- deflate/inflate transformation based on the regular Deflate/Inflate -- routines. -- pragma Import (C, inflateBack, "inflateBack"); -- pragma Import (C, inflateBackEnd, "inflateBackEnd"); end ZLib.Thin; tcl8.6.14/compat/zlib/contrib/ada/mtest.adb0000644000175000017500000001056314554262142020063 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- Continuous test for ZLib multithreading. If the test would fail -- we should provide thread safe allocation routines for the Z_Stream. -- -- $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $ with ZLib; with Ada.Streams; with Ada.Numerics.Discrete_Random; with Ada.Text_IO; with Ada.Exceptions; with Ada.Task_Identification; procedure MTest is use Ada.Streams; use ZLib; Stop : Boolean := False; pragma Atomic (Stop); subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#; package Random_Elements is new Ada.Numerics.Discrete_Random (Visible_Symbols); task type Test_Task; task body Test_Task is Buffer : Stream_Element_Array (1 .. 100_000); Gen : Random_Elements.Generator; Buffer_First : Stream_Element_Offset; Compare_First : Stream_Element_Offset; Deflate : Filter_Type; Inflate : Filter_Type; procedure Further (Item : in Stream_Element_Array); procedure Read_Buffer (Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); ------------- -- Further -- ------------- procedure Further (Item : in Stream_Element_Array) is procedure Compare (Item : in Stream_Element_Array); ------------- -- Compare -- ------------- procedure Compare (Item : in Stream_Element_Array) is Next_First : Stream_Element_Offset := Compare_First + Item'Length; begin if Buffer (Compare_First .. Next_First - 1) /= Item then raise Program_Error; end if; Compare_First := Next_First; end Compare; procedure Compare_Write is new ZLib.Write (Write => Compare); begin Compare_Write (Inflate, Item, No_Flush); end Further; ----------------- -- Read_Buffer -- ----------------- procedure Read_Buffer (Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset) is Buff_Diff : Stream_Element_Offset := Buffer'Last - Buffer_First; Next_First : Stream_Element_Offset; begin if Item'Length <= Buff_Diff then Last := Item'Last; Next_First := Buffer_First + Item'Length; Item := Buffer (Buffer_First .. Next_First - 1); Buffer_First := Next_First; else Last := Item'First + Buff_Diff; Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last); Buffer_First := Buffer'Last + 1; end if; end Read_Buffer; procedure Translate is new Generic_Translate (Data_In => Read_Buffer, Data_Out => Further); begin Random_Elements.Reset (Gen); Buffer := (others => 20); Main : loop for J in Buffer'Range loop Buffer (J) := Random_Elements.Random (Gen); Deflate_Init (Deflate); Inflate_Init (Inflate); Buffer_First := Buffer'First; Compare_First := Buffer'First; Translate (Deflate); if Compare_First /= Buffer'Last + 1 then raise Program_Error; end if; Ada.Text_IO.Put_Line (Ada.Task_Identification.Image (Ada.Task_Identification.Current_Task) & Stream_Element_Offset'Image (J) & ZLib.Count'Image (Total_Out (Deflate))); Close (Deflate); Close (Inflate); exit Main when Stop; end loop; end loop Main; exception when E : others => Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E)); Stop := True; end Test_Task; Test : array (1 .. 4) of Test_Task; pragma Unreferenced (Test); Dummy : Character; begin Ada.Text_IO.Get_Immediate (Dummy); Stop := True; end MTest; tcl8.6.14/compat/zlib/contrib/ada/zlib.adb0000644000175000017500000004766114554262142017700 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2004 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $ with Ada.Exceptions; with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with Interfaces.C.Strings; with ZLib.Thin; package body ZLib is use type Thin.Int; type Z_Stream is new Thin.Z_Stream; type Return_Code_Enum is (OK, STREAM_END, NEED_DICT, ERRNO, STREAM_ERROR, DATA_ERROR, MEM_ERROR, BUF_ERROR, VERSION_ERROR); type Flate_Step_Function is access function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int; pragma Convention (C, Flate_Step_Function); type Flate_End_Function is access function (Ctrm : in Thin.Z_Streamp) return Thin.Int; pragma Convention (C, Flate_End_Function); type Flate_Type is record Step : Flate_Step_Function; Done : Flate_End_Function; end record; subtype Footer_Array is Stream_Element_Array (1 .. 8); Simple_GZip_Header : constant Stream_Element_Array (1 .. 10) := (16#1f#, 16#8b#, -- Magic header 16#08#, -- Z_DEFLATED 16#00#, -- Flags 16#00#, 16#00#, 16#00#, 16#00#, -- Time 16#00#, -- XFlags 16#03# -- OS code ); -- The simplest gzip header is not for informational, but just for -- gzip format compatibility. -- Note that some code below is using assumption -- Simple_GZip_Header'Last > Footer_Array'Last, so do not make -- Simple_GZip_Header'Last <= Footer_Array'Last. Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum := (0 => OK, 1 => STREAM_END, 2 => NEED_DICT, -1 => ERRNO, -2 => STREAM_ERROR, -3 => DATA_ERROR, -4 => MEM_ERROR, -5 => BUF_ERROR, -6 => VERSION_ERROR); Flate : constant array (Boolean) of Flate_Type := (True => (Step => Thin.Deflate'Access, Done => Thin.DeflateEnd'Access), False => (Step => Thin.Inflate'Access, Done => Thin.InflateEnd'Access)); Flush_Finish : constant array (Boolean) of Flush_Mode := (True => Finish, False => No_Flush); procedure Raise_Error (Stream : in Z_Stream); pragma Inline (Raise_Error); procedure Raise_Error (Message : in String); pragma Inline (Raise_Error); procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int); procedure Free is new Ada.Unchecked_Deallocation (Z_Stream, Z_Stream_Access); function To_Thin_Access is new Ada.Unchecked_Conversion (Z_Stream_Access, Thin.Z_Streamp); procedure Translate_GZip (Filter : in out Filter_Type; In_Data : in Ada.Streams.Stream_Element_Array; In_Last : out Ada.Streams.Stream_Element_Offset; Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode); -- Separate translate routine for make gzip header. procedure Translate_Auto (Filter : in out Filter_Type; In_Data : in Ada.Streams.Stream_Element_Array; In_Last : out Ada.Streams.Stream_Element_Offset; Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode); -- translate routine without additional headers. ----------------- -- Check_Error -- ----------------- procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is use type Thin.Int; begin if Code /= Thin.Z_OK then Raise_Error (Return_Code_Enum'Image (Return_Code (Code)) & ": " & Last_Error_Message (Stream)); end if; end Check_Error; ----------- -- Close -- ----------- procedure Close (Filter : in out Filter_Type; Ignore_Error : in Boolean := False) is Code : Thin.Int; begin if not Ignore_Error and then not Is_Open (Filter) then raise Status_Error; end if; Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm)); if Ignore_Error or else Code = Thin.Z_OK then Free (Filter.Strm); else declare Error_Message : constant String := Last_Error_Message (Filter.Strm.all); begin Free (Filter.Strm); Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Return_Code_Enum'Image (Return_Code (Code)) & ": " & Error_Message); end; end if; end Close; ----------- -- CRC32 -- ----------- function CRC32 (CRC : in Unsigned_32; Data : in Ada.Streams.Stream_Element_Array) return Unsigned_32 is use Thin; begin return Unsigned_32 (crc32 (ULong (CRC), Data'Address, Data'Length)); end CRC32; procedure CRC32 (CRC : in out Unsigned_32; Data : in Ada.Streams.Stream_Element_Array) is begin CRC := CRC32 (CRC, Data); end CRC32; ------------------ -- Deflate_Init -- ------------------ procedure Deflate_Init (Filter : in out Filter_Type; Level : in Compression_Level := Default_Compression; Strategy : in Strategy_Type := Default_Strategy; Method : in Compression_Method := Deflated; Window_Bits : in Window_Bits_Type := Default_Window_Bits; Memory_Level : in Memory_Level_Type := Default_Memory_Level; Header : in Header_Type := Default) is use type Thin.Int; Win_Bits : Thin.Int := Thin.Int (Window_Bits); begin if Is_Open (Filter) then raise Status_Error; end if; -- We allow ZLib to make header only in case of default header type. -- Otherwise we would either do header by ourselves, or do not do -- header at all. if Header = None or else Header = GZip then Win_Bits := -Win_Bits; end if; -- For the GZip CRC calculation and make headers. if Header = GZip then Filter.CRC := 0; Filter.Offset := Simple_GZip_Header'First; else Filter.Offset := Simple_GZip_Header'Last + 1; end if; Filter.Strm := new Z_Stream; Filter.Compression := True; Filter.Stream_End := False; Filter.Header := Header; if Thin.Deflate_Init (To_Thin_Access (Filter.Strm), Level => Thin.Int (Level), method => Thin.Int (Method), windowBits => Win_Bits, memLevel => Thin.Int (Memory_Level), strategy => Thin.Int (Strategy)) /= Thin.Z_OK then Raise_Error (Filter.Strm.all); end if; end Deflate_Init; ----------- -- Flush -- ----------- procedure Flush (Filter : in out Filter_Type; Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode) is No_Data : Stream_Element_Array := (1 .. 0 => 0); Last : Stream_Element_Offset; begin Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush); end Flush; ----------------------- -- Generic_Translate -- ----------------------- procedure Generic_Translate (Filter : in out ZLib.Filter_Type; In_Buffer_Size : in Integer := Default_Buffer_Size; Out_Buffer_Size : in Integer := Default_Buffer_Size) is In_Buffer : Stream_Element_Array (1 .. Stream_Element_Offset (In_Buffer_Size)); Out_Buffer : Stream_Element_Array (1 .. Stream_Element_Offset (Out_Buffer_Size)); Last : Stream_Element_Offset; In_Last : Stream_Element_Offset; In_First : Stream_Element_Offset; Out_Last : Stream_Element_Offset; begin Main : loop Data_In (In_Buffer, Last); In_First := In_Buffer'First; loop Translate (Filter => Filter, In_Data => In_Buffer (In_First .. Last), In_Last => In_Last, Out_Data => Out_Buffer, Out_Last => Out_Last, Flush => Flush_Finish (Last < In_Buffer'First)); if Out_Buffer'First <= Out_Last then Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last)); end if; exit Main when Stream_End (Filter); -- The end of in buffer. exit when In_Last = Last; In_First := In_Last + 1; end loop; end loop Main; end Generic_Translate; ------------------ -- Inflate_Init -- ------------------ procedure Inflate_Init (Filter : in out Filter_Type; Window_Bits : in Window_Bits_Type := Default_Window_Bits; Header : in Header_Type := Default) is use type Thin.Int; Win_Bits : Thin.Int := Thin.Int (Window_Bits); procedure Check_Version; -- Check the latest header types compatibility. procedure Check_Version is begin if Version <= "1.1.4" then Raise_Error ("Inflate header type " & Header_Type'Image (Header) & " incompatible with ZLib version " & Version); end if; end Check_Version; begin if Is_Open (Filter) then raise Status_Error; end if; case Header is when None => Check_Version; -- Inflate data without headers determined -- by negative Win_Bits. Win_Bits := -Win_Bits; when GZip => Check_Version; -- Inflate gzip data defined by flag 16. Win_Bits := Win_Bits + 16; when Auto => Check_Version; -- Inflate with automatic detection -- of gzip or native header defined by flag 32. Win_Bits := Win_Bits + 32; when Default => null; end case; Filter.Strm := new Z_Stream; Filter.Compression := False; Filter.Stream_End := False; Filter.Header := Header; if Thin.Inflate_Init (To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK then Raise_Error (Filter.Strm.all); end if; end Inflate_Init; ------------- -- Is_Open -- ------------- function Is_Open (Filter : in Filter_Type) return Boolean is begin return Filter.Strm /= null; end Is_Open; ----------------- -- Raise_Error -- ----------------- procedure Raise_Error (Message : in String) is begin Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message); end Raise_Error; procedure Raise_Error (Stream : in Z_Stream) is begin Raise_Error (Last_Error_Message (Stream)); end Raise_Error; ---------- -- Read -- ---------- procedure Read (Filter : in out Filter_Type; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode := No_Flush) is In_Last : Stream_Element_Offset; Item_First : Ada.Streams.Stream_Element_Offset := Item'First; V_Flush : Flush_Mode := Flush; begin pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1); pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last); loop if Rest_Last = Buffer'First - 1 then V_Flush := Finish; elsif Rest_First > Rest_Last then Read (Buffer, Rest_Last); Rest_First := Buffer'First; if Rest_Last < Buffer'First then V_Flush := Finish; end if; end if; Translate (Filter => Filter, In_Data => Buffer (Rest_First .. Rest_Last), In_Last => In_Last, Out_Data => Item (Item_First .. Item'Last), Out_Last => Last, Flush => V_Flush); Rest_First := In_Last + 1; exit when Stream_End (Filter) or else Last = Item'Last or else (Last >= Item'First and then Allow_Read_Some); Item_First := Last + 1; end loop; end Read; ---------------- -- Stream_End -- ---------------- function Stream_End (Filter : in Filter_Type) return Boolean is begin if Filter.Header = GZip and Filter.Compression then return Filter.Stream_End and then Filter.Offset = Footer_Array'Last + 1; else return Filter.Stream_End; end if; end Stream_End; -------------- -- Total_In -- -------------- function Total_In (Filter : in Filter_Type) return Count is begin return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all)); end Total_In; --------------- -- Total_Out -- --------------- function Total_Out (Filter : in Filter_Type) return Count is begin return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all)); end Total_Out; --------------- -- Translate -- --------------- procedure Translate (Filter : in out Filter_Type; In_Data : in Ada.Streams.Stream_Element_Array; In_Last : out Ada.Streams.Stream_Element_Offset; Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode) is begin if Filter.Header = GZip and then Filter.Compression then Translate_GZip (Filter => Filter, In_Data => In_Data, In_Last => In_Last, Out_Data => Out_Data, Out_Last => Out_Last, Flush => Flush); else Translate_Auto (Filter => Filter, In_Data => In_Data, In_Last => In_Last, Out_Data => Out_Data, Out_Last => Out_Last, Flush => Flush); end if; end Translate; -------------------- -- Translate_Auto -- -------------------- procedure Translate_Auto (Filter : in out Filter_Type; In_Data : in Ada.Streams.Stream_Element_Array; In_Last : out Ada.Streams.Stream_Element_Offset; Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode) is use type Thin.Int; Code : Thin.Int; begin if not Is_Open (Filter) then raise Status_Error; end if; if Out_Data'Length = 0 and then In_Data'Length = 0 then raise Constraint_Error; end if; Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length); Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length); Code := Flate (Filter.Compression).Step (To_Thin_Access (Filter.Strm), Thin.Int (Flush)); if Code = Thin.Z_STREAM_END then Filter.Stream_End := True; else Check_Error (Filter.Strm.all, Code); end if; In_Last := In_Data'Last - Stream_Element_Offset (Avail_In (Filter.Strm.all)); Out_Last := Out_Data'Last - Stream_Element_Offset (Avail_Out (Filter.Strm.all)); end Translate_Auto; -------------------- -- Translate_GZip -- -------------------- procedure Translate_GZip (Filter : in out Filter_Type; In_Data : in Ada.Streams.Stream_Element_Array; In_Last : out Ada.Streams.Stream_Element_Offset; Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode) is Out_First : Stream_Element_Offset; procedure Add_Data (Data : in Stream_Element_Array); -- Add data to stream from the Filter.Offset till necessary, -- used for add gzip headr/footer. procedure Put_32 (Item : in out Stream_Element_Array; Data : in Unsigned_32); pragma Inline (Put_32); -------------- -- Add_Data -- -------------- procedure Add_Data (Data : in Stream_Element_Array) is Data_First : Stream_Element_Offset renames Filter.Offset; Data_Last : Stream_Element_Offset; Data_Len : Stream_Element_Offset; -- -1 Out_Len : Stream_Element_Offset; -- -1 begin Out_First := Out_Last + 1; if Data_First > Data'Last then return; end if; Data_Len := Data'Last - Data_First; Out_Len := Out_Data'Last - Out_First; if Data_Len <= Out_Len then Out_Last := Out_First + Data_Len; Data_Last := Data'Last; else Out_Last := Out_Data'Last; Data_Last := Data_First + Out_Len; end if; Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last); Data_First := Data_Last + 1; Out_First := Out_Last + 1; end Add_Data; ------------ -- Put_32 -- ------------ procedure Put_32 (Item : in out Stream_Element_Array; Data : in Unsigned_32) is D : Unsigned_32 := Data; begin for J in Item'First .. Item'First + 3 loop Item (J) := Stream_Element (D and 16#FF#); D := Shift_Right (D, 8); end loop; end Put_32; begin Out_Last := Out_Data'First - 1; if not Filter.Stream_End then Add_Data (Simple_GZip_Header); Translate_Auto (Filter => Filter, In_Data => In_Data, In_Last => In_Last, Out_Data => Out_Data (Out_First .. Out_Data'Last), Out_Last => Out_Last, Flush => Flush); CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last)); end if; if Filter.Stream_End and then Out_Last <= Out_Data'Last then -- This detection method would work only when -- Simple_GZip_Header'Last > Footer_Array'Last if Filter.Offset = Simple_GZip_Header'Last + 1 then Filter.Offset := Footer_Array'First; end if; declare Footer : Footer_Array; begin Put_32 (Footer, Filter.CRC); Put_32 (Footer (Footer'First + 4 .. Footer'Last), Unsigned_32 (Total_In (Filter))); Add_Data (Footer); end; end if; end Translate_GZip; ------------- -- Version -- ------------- function Version return String is begin return Interfaces.C.Strings.Value (Thin.zlibVersion); end Version; ----------- -- Write -- ----------- procedure Write (Filter : in out Filter_Type; Item : in Ada.Streams.Stream_Element_Array; Flush : in Flush_Mode := No_Flush) is Buffer : Stream_Element_Array (1 .. Buffer_Size); In_Last : Stream_Element_Offset; Out_Last : Stream_Element_Offset; In_First : Stream_Element_Offset := Item'First; begin if Item'Length = 0 and Flush = No_Flush then return; end if; loop Translate (Filter => Filter, In_Data => Item (In_First .. Item'Last), In_Last => In_Last, Out_Data => Buffer, Out_Last => Out_Last, Flush => Flush); if Out_Last >= Buffer'First then Write (Buffer (1 .. Out_Last)); end if; exit when In_Last = Item'Last or Stream_End (Filter); In_First := In_Last + 1; end loop; end Write; end ZLib; tcl8.6.14/compat/zlib/contrib/ada/zlib-streams.adb0000644000175000017500000001355414554262142021346 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $ with Ada.Unchecked_Deallocation; package body ZLib.Streams is ----------- -- Close -- ----------- procedure Close (Stream : in out Stream_Type) is procedure Free is new Ada.Unchecked_Deallocation (Stream_Element_Array, Buffer_Access); begin if Stream.Mode = Out_Stream or Stream.Mode = Duplex then -- We should flush the data written by the writer. Flush (Stream, Finish); Close (Stream.Writer); end if; if Stream.Mode = In_Stream or Stream.Mode = Duplex then Close (Stream.Reader); Free (Stream.Buffer); end if; end Close; ------------ -- Create -- ------------ procedure Create (Stream : out Stream_Type; Mode : in Stream_Mode; Back : in Stream_Access; Back_Compressed : in Boolean; Level : in Compression_Level := Default_Compression; Strategy : in Strategy_Type := Default_Strategy; Header : in Header_Type := Default; Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset := Default_Buffer_Size; Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset := Default_Buffer_Size) is subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size); procedure Init_Filter (Filter : in out Filter_Type; Compress : in Boolean); ----------------- -- Init_Filter -- ----------------- procedure Init_Filter (Filter : in out Filter_Type; Compress : in Boolean) is begin if Compress then Deflate_Init (Filter, Level, Strategy, Header => Header); else Inflate_Init (Filter, Header => Header); end if; end Init_Filter; begin Stream.Back := Back; Stream.Mode := Mode; if Mode = Out_Stream or Mode = Duplex then Init_Filter (Stream.Writer, Back_Compressed); Stream.Buffer_Size := Write_Buffer_Size; else Stream.Buffer_Size := 0; end if; if Mode = In_Stream or Mode = Duplex then Init_Filter (Stream.Reader, not Back_Compressed); Stream.Buffer := new Buffer_Subtype; Stream.Rest_First := Stream.Buffer'Last + 1; Stream.Rest_Last := Stream.Buffer'Last; end if; end Create; ----------- -- Flush -- ----------- procedure Flush (Stream : in out Stream_Type; Mode : in Flush_Mode := Sync_Flush) is Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size); Last : Stream_Element_Offset; begin loop Flush (Stream.Writer, Buffer, Last, Mode); Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last)); exit when Last < Buffer'Last; end loop; end Flush; ------------- -- Is_Open -- ------------- function Is_Open (Stream : Stream_Type) return Boolean is begin return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer); end Is_Open; ---------- -- Read -- ---------- procedure Read (Stream : in out Stream_Type; Item : out Stream_Element_Array; Last : out Stream_Element_Offset) is procedure Read (Item : out Stream_Element_Array; Last : out Stream_Element_Offset); ---------- -- Read -- ---------- procedure Read (Item : out Stream_Element_Array; Last : out Stream_Element_Offset) is begin Ada.Streams.Read (Stream.Back.all, Item, Last); end Read; procedure Read is new ZLib.Read (Read => Read, Buffer => Stream.Buffer.all, Rest_First => Stream.Rest_First, Rest_Last => Stream.Rest_Last); begin Read (Stream.Reader, Item, Last); end Read; ------------------- -- Read_Total_In -- ------------------- function Read_Total_In (Stream : in Stream_Type) return Count is begin return Total_In (Stream.Reader); end Read_Total_In; -------------------- -- Read_Total_Out -- -------------------- function Read_Total_Out (Stream : in Stream_Type) return Count is begin return Total_Out (Stream.Reader); end Read_Total_Out; ----------- -- Write -- ----------- procedure Write (Stream : in out Stream_Type; Item : in Stream_Element_Array) is procedure Write (Item : in Stream_Element_Array); ----------- -- Write -- ----------- procedure Write (Item : in Stream_Element_Array) is begin Ada.Streams.Write (Stream.Back.all, Item); end Write; procedure Write is new ZLib.Write (Write => Write, Buffer_Size => Stream.Buffer_Size); begin Write (Stream.Writer, Item, No_Flush); end Write; -------------------- -- Write_Total_In -- -------------------- function Write_Total_In (Stream : in Stream_Type) return Count is begin return Total_In (Stream.Writer); end Write_Total_In; --------------------- -- Write_Total_Out -- --------------------- function Write_Total_Out (Stream : in Stream_Type) return Count is begin return Total_Out (Stream.Writer); end Write_Total_Out; end ZLib.Streams; tcl8.6.14/compat/zlib/contrib/ada/read.adb0000644000175000017500000001023014554262142017631 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $ -- Test/demo program for the generic read interface. with Ada.Numerics.Discrete_Random; with Ada.Streams; with Ada.Text_IO; with ZLib; procedure Read is use Ada.Streams; ------------------------------------ -- Test configuration parameters -- ------------------------------------ File_Size : Stream_Element_Offset := 100_000; Continuous : constant Boolean := False; -- If this constant is True, the test would be repeated again and again, -- with increment File_Size for every iteration. Header : constant ZLib.Header_Type := ZLib.Default; -- Do not use Header other than Default in ZLib versions 1.1.4 and older. Init_Random : constant := 8; -- We are using the same random sequence, in case of we catch bug, -- so we would be able to reproduce it. -- End -- Pack_Size : Stream_Element_Offset; Offset : Stream_Element_Offset; Filter : ZLib.Filter_Type; subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#; package Random_Elements is new Ada.Numerics.Discrete_Random (Visible_Symbols); Gen : Random_Elements.Generator; Period : constant Stream_Element_Offset := 200; -- Period constant variable for random generator not to be very random. -- Bigger period, harder random. Read_Buffer : Stream_Element_Array (1 .. 2048); Read_First : Stream_Element_Offset; Read_Last : Stream_Element_Offset; procedure Reset; procedure Read (Item : out Stream_Element_Array; Last : out Stream_Element_Offset); -- this procedure is for generic instantiation of -- ZLib.Read -- reading data from the File_In. procedure Read is new ZLib.Read (Read, Read_Buffer, Rest_First => Read_First, Rest_Last => Read_Last); ---------- -- Read -- ---------- procedure Read (Item : out Stream_Element_Array; Last : out Stream_Element_Offset) is begin Last := Stream_Element_Offset'Min (Item'Last, Item'First + File_Size - Offset); for J in Item'First .. Last loop if J < Item'First + Period then Item (J) := Random_Elements.Random (Gen); else Item (J) := Item (J - Period); end if; Offset := Offset + 1; end loop; end Read; ----------- -- Reset -- ----------- procedure Reset is begin Random_Elements.Reset (Gen, Init_Random); Pack_Size := 0; Offset := 1; Read_First := Read_Buffer'Last + 1; Read_Last := Read_Buffer'Last; end Reset; begin Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version); loop for Level in ZLib.Compression_Level'Range loop Ada.Text_IO.Put ("Level =" & ZLib.Compression_Level'Image (Level)); -- Deflate using generic instantiation. ZLib.Deflate_Init (Filter, Level, Header => Header); Reset; Ada.Text_IO.Put (Stream_Element_Offset'Image (File_Size) & " ->"); loop declare Buffer : Stream_Element_Array (1 .. 1024); Last : Stream_Element_Offset; begin Read (Filter, Buffer, Last); Pack_Size := Pack_Size + Last - Buffer'First + 1; exit when Last < Buffer'Last; end; end loop; Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size)); ZLib.Close (Filter); end loop; exit when not Continuous; File_Size := File_Size + 1; end loop; end Read; tcl8.6.14/compat/zlib/contrib/ada/zlib-thin.adb0000644000175000017500000000640114554262142020623 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $ package body ZLib.Thin is ZLIB_VERSION : constant Chars_Ptr := zlibVersion; Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit; -------------- -- Avail_In -- -------------- function Avail_In (Strm : in Z_Stream) return UInt is begin return Strm.Avail_In; end Avail_In; --------------- -- Avail_Out -- --------------- function Avail_Out (Strm : in Z_Stream) return UInt is begin return Strm.Avail_Out; end Avail_Out; ------------------ -- Deflate_Init -- ------------------ function Deflate_Init (strm : Z_Streamp; level : Int; method : Int; windowBits : Int; memLevel : Int; strategy : Int) return Int is begin return deflateInit2 (strm, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, Z_Stream_Size); end Deflate_Init; ------------------ -- Inflate_Init -- ------------------ function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is begin return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size); end Inflate_Init; ------------------------ -- Last_Error_Message -- ------------------------ function Last_Error_Message (Strm : in Z_Stream) return String is use Interfaces.C.Strings; begin if Strm.msg = Null_Ptr then return ""; else return Value (Strm.msg); end if; end Last_Error_Message; ------------ -- Set_In -- ------------ procedure Set_In (Strm : in out Z_Stream; Buffer : in Voidp; Size : in UInt) is begin Strm.Next_In := Buffer; Strm.Avail_In := Size; end Set_In; ------------------ -- Set_Mem_Func -- ------------------ procedure Set_Mem_Func (Strm : in out Z_Stream; Opaque : in Voidp; Alloc : in alloc_func; Free : in free_func) is begin Strm.opaque := Opaque; Strm.zalloc := Alloc; Strm.zfree := Free; end Set_Mem_Func; ------------- -- Set_Out -- ------------- procedure Set_Out (Strm : in out Z_Stream; Buffer : in Voidp; Size : in UInt) is begin Strm.Next_Out := Buffer; Strm.Avail_Out := Size; end Set_Out; -------------- -- Total_In -- -------------- function Total_In (Strm : in Z_Stream) return ULong is begin return Strm.Total_In; end Total_In; --------------- -- Total_Out -- --------------- function Total_Out (Strm : in Z_Stream) return ULong is begin return Strm.Total_Out; end Total_Out; end ZLib.Thin; tcl8.6.14/compat/zlib/contrib/ada/zlib.ads0000644000175000017500000003243314554262142017710 0ustar sergeisergei------------------------------------------------------------------------------ -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2004 Dmitriy Anisimkov -- -- -- -- This library is free software; you can redistribute it and/or modify -- -- it under the terms of the GNU General Public License as published by -- -- the Free Software Foundation; either version 2 of the License, or (at -- -- your option) any later version. -- -- -- -- This library is distributed in the hope that it will be useful, but -- -- WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- -- General Public License for more details. -- -- -- -- You should have received a copy of the GNU General Public License -- -- along with this library; if not, write to the Free Software Foundation, -- -- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- ------------------------------------------------------------------------------ -- $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $ with Ada.Streams; with Interfaces; package ZLib is ZLib_Error : exception; Status_Error : exception; type Compression_Level is new Integer range -1 .. 9; type Flush_Mode is private; type Compression_Method is private; type Window_Bits_Type is new Integer range 8 .. 15; type Memory_Level_Type is new Integer range 1 .. 9; type Unsigned_32 is new Interfaces.Unsigned_32; type Strategy_Type is private; type Header_Type is (None, Auto, Default, GZip); -- Header type usage have a some limitation for inflate. -- See comment for Inflate_Init. subtype Count is Ada.Streams.Stream_Element_Count; Default_Memory_Level : constant Memory_Level_Type := 8; Default_Window_Bits : constant Window_Bits_Type := 15; ---------------------------------- -- Compression method constants -- ---------------------------------- Deflated : constant Compression_Method; -- Only one method allowed in this ZLib version --------------------------------- -- Compression level constants -- --------------------------------- No_Compression : constant Compression_Level := 0; Best_Speed : constant Compression_Level := 1; Best_Compression : constant Compression_Level := 9; Default_Compression : constant Compression_Level := -1; -------------------------- -- Flush mode constants -- -------------------------- No_Flush : constant Flush_Mode; -- Regular way for compression, no flush Partial_Flush : constant Flush_Mode; -- Will be removed, use Z_SYNC_FLUSH instead Sync_Flush : constant Flush_Mode; -- All pending output is flushed to the output buffer and the output -- is aligned on a byte boundary, so that the decompressor can get all -- input data available so far. (In particular avail_in is zero after the -- call if enough output space has been provided before the call.) -- Flushing may degrade compression for some compression algorithms and so -- it should be used only when necessary. Block_Flush : constant Flush_Mode; -- Z_BLOCK requests that inflate() stop -- if and when it get to the next deflate block boundary. When decoding the -- zlib or gzip format, this will cause inflate() to return immediately -- after the header and before the first block. When doing a raw inflate, -- inflate() will go ahead and process the first block, and will return -- when it gets to the end of that block, or when it runs out of data. Full_Flush : constant Flush_Mode; -- All output is flushed as with SYNC_FLUSH, and the compression state -- is reset so that decompression can restart from this point if previous -- compressed data has been damaged or if random access is desired. Using -- Full_Flush too often can seriously degrade the compression. Finish : constant Flush_Mode; -- Just for tell the compressor that input data is complete. ------------------------------------ -- Compression strategy constants -- ------------------------------------ -- RLE strategy could be used only in version 1.2.0 and later. Filtered : constant Strategy_Type; Huffman_Only : constant Strategy_Type; RLE : constant Strategy_Type; Default_Strategy : constant Strategy_Type; Default_Buffer_Size : constant := 4096; type Filter_Type is tagged limited private; -- The filter is for compression and for decompression. -- The usage of the type is depend of its initialization. function Version return String; pragma Inline (Version); -- Return string representation of the ZLib version. procedure Deflate_Init (Filter : in out Filter_Type; Level : in Compression_Level := Default_Compression; Strategy : in Strategy_Type := Default_Strategy; Method : in Compression_Method := Deflated; Window_Bits : in Window_Bits_Type := Default_Window_Bits; Memory_Level : in Memory_Level_Type := Default_Memory_Level; Header : in Header_Type := Default); -- Compressor initialization. -- When Header parameter is Auto or Default, then default zlib header -- would be provided for compressed data. -- When Header is GZip, then gzip header would be set instead of -- default header. -- When Header is None, no header would be set for compressed data. procedure Inflate_Init (Filter : in out Filter_Type; Window_Bits : in Window_Bits_Type := Default_Window_Bits; Header : in Header_Type := Default); -- Decompressor initialization. -- Default header type mean that ZLib default header is expecting in the -- input compressed stream. -- Header type None mean that no header is expecting in the input stream. -- GZip header type mean that GZip header is expecting in the -- input compressed stream. -- Auto header type mean that header type (GZip or Native) would be -- detected automatically in the input stream. -- Note that header types parameter values None, GZip and Auto are -- supported for inflate routine only in ZLib versions 1.2.0.2 and later. -- Deflate_Init is supporting all header types. function Is_Open (Filter : in Filter_Type) return Boolean; pragma Inline (Is_Open); -- Is the filter opened for compression or decompression. procedure Close (Filter : in out Filter_Type; Ignore_Error : in Boolean := False); -- Closing the compression or decompressor. -- If stream is closing before the complete and Ignore_Error is False, -- The exception would be raised. generic with procedure Data_In (Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); with procedure Data_Out (Item : in Ada.Streams.Stream_Element_Array); procedure Generic_Translate (Filter : in out Filter_Type; In_Buffer_Size : in Integer := Default_Buffer_Size; Out_Buffer_Size : in Integer := Default_Buffer_Size); -- Compress/decompress data fetch from Data_In routine and pass the result -- to the Data_Out routine. User should provide Data_In and Data_Out -- for compression/decompression data flow. -- Compression or decompression depend on Filter initialization. function Total_In (Filter : in Filter_Type) return Count; pragma Inline (Total_In); -- Returns total number of input bytes read so far function Total_Out (Filter : in Filter_Type) return Count; pragma Inline (Total_Out); -- Returns total number of bytes output so far function CRC32 (CRC : in Unsigned_32; Data : in Ada.Streams.Stream_Element_Array) return Unsigned_32; pragma Inline (CRC32); -- Compute CRC32, it could be necessary for make gzip format procedure CRC32 (CRC : in out Unsigned_32; Data : in Ada.Streams.Stream_Element_Array); pragma Inline (CRC32); -- Compute CRC32, it could be necessary for make gzip format ------------------------------------------------- -- Below is more complex low level routines. -- ------------------------------------------------- procedure Translate (Filter : in out Filter_Type; In_Data : in Ada.Streams.Stream_Element_Array; In_Last : out Ada.Streams.Stream_Element_Offset; Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode); -- Compress/decompress the In_Data buffer and place the result into -- Out_Data. In_Last is the index of last element from In_Data accepted by -- the Filter. Out_Last is the last element of the received data from -- Filter. To tell the filter that incoming data are complete put the -- Flush parameter to Finish. function Stream_End (Filter : in Filter_Type) return Boolean; pragma Inline (Stream_End); -- Return the true when the stream is complete. procedure Flush (Filter : in out Filter_Type; Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode); pragma Inline (Flush); -- Flushing the data from the compressor. generic with procedure Write (Item : in Ada.Streams.Stream_Element_Array); -- User should provide this routine for accept -- compressed/decompressed data. Buffer_Size : in Ada.Streams.Stream_Element_Offset := Default_Buffer_Size; -- Buffer size for Write user routine. procedure Write (Filter : in out Filter_Type; Item : in Ada.Streams.Stream_Element_Array; Flush : in Flush_Mode := No_Flush); -- Compress/Decompress data from Item to the generic parameter procedure -- Write. Output buffer size could be set in Buffer_Size generic parameter. generic with procedure Read (Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); -- User should provide data for compression/decompression -- thru this routine. Buffer : in out Ada.Streams.Stream_Element_Array; -- Buffer for keep remaining data from the previous -- back read. Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset; -- Rest_First have to be initialized to Buffer'Last + 1 -- Rest_Last have to be initialized to Buffer'Last -- before usage. Allow_Read_Some : in Boolean := False; -- Is it allowed to return Last < Item'Last before end of data. procedure Read (Filter : in out Filter_Type; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode := No_Flush); -- Compress/Decompress data from generic parameter procedure Read to the -- Item. User should provide Buffer and initialized Rest_First, Rest_Last -- indicators. If Allow_Read_Some is True, Read routines could return -- Last < Item'Last only at end of stream. private use Ada.Streams; pragma Assert (Ada.Streams.Stream_Element'Size = 8); pragma Assert (Ada.Streams.Stream_Element'Modulus = 2**8); type Flush_Mode is new Integer range 0 .. 5; type Compression_Method is new Integer range 8 .. 8; type Strategy_Type is new Integer range 0 .. 3; No_Flush : constant Flush_Mode := 0; Partial_Flush : constant Flush_Mode := 1; Sync_Flush : constant Flush_Mode := 2; Full_Flush : constant Flush_Mode := 3; Finish : constant Flush_Mode := 4; Block_Flush : constant Flush_Mode := 5; Filtered : constant Strategy_Type := 1; Huffman_Only : constant Strategy_Type := 2; RLE : constant Strategy_Type := 3; Default_Strategy : constant Strategy_Type := 0; Deflated : constant Compression_Method := 8; type Z_Stream; type Z_Stream_Access is access all Z_Stream; type Filter_Type is tagged limited record Strm : Z_Stream_Access; Compression : Boolean; Stream_End : Boolean; Header : Header_Type; CRC : Unsigned_32; Offset : Stream_Element_Offset; -- Offset for gzip header/footer output. end record; end ZLib; tcl8.6.14/compat/zlib/contrib/ada/test.adb0000644000175000017500000003157214554262142017711 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- $Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp $ -- The program has a few aims. -- 1. Test ZLib.Ada95 thick binding functionality. -- 2. Show the example of use main functionality of the ZLib.Ada95 binding. -- 3. Build this program automatically compile all ZLib.Ada95 packages under -- GNAT Ada95 compiler. with ZLib.Streams; with Ada.Streams.Stream_IO; with Ada.Numerics.Discrete_Random; with Ada.Text_IO; with Ada.Calendar; procedure Test is use Ada.Streams; use Stream_IO; ------------------------------------ -- Test configuration parameters -- ------------------------------------ File_Size : Count := 100_000; Continuous : constant Boolean := False; Header : constant ZLib.Header_Type := ZLib.Default; -- ZLib.None; -- ZLib.Auto; -- ZLib.GZip; -- Do not use Header other then Default in ZLib versions 1.1.4 -- and older. Strategy : constant ZLib.Strategy_Type := ZLib.Default_Strategy; Init_Random : constant := 10; -- End -- In_File_Name : constant String := "testzlib.in"; -- Name of the input file Z_File_Name : constant String := "testzlib.zlb"; -- Name of the compressed file. Out_File_Name : constant String := "testzlib.out"; -- Name of the decompressed file. File_In : File_Type; File_Out : File_Type; File_Back : File_Type; File_Z : ZLib.Streams.Stream_Type; Filter : ZLib.Filter_Type; Time_Stamp : Ada.Calendar.Time; procedure Generate_File; -- Generate file of specified size with some random data. -- The random data is repeatable, for the good compression. procedure Compare_Streams (Left, Right : in out Root_Stream_Type'Class); -- The procedure comparing data in 2 streams. -- It is for compare data before and after compression/decompression. procedure Compare_Files (Left, Right : String); -- Compare files. Based on the Compare_Streams. procedure Copy_Streams (Source, Target : in out Root_Stream_Type'Class; Buffer_Size : in Stream_Element_Offset := 1024); -- Copying data from one stream to another. It is for test stream -- interface of the library. procedure Data_In (Item : out Stream_Element_Array; Last : out Stream_Element_Offset); -- this procedure is for generic instantiation of -- ZLib.Generic_Translate. -- reading data from the File_In. procedure Data_Out (Item : in Stream_Element_Array); -- this procedure is for generic instantiation of -- ZLib.Generic_Translate. -- writing data to the File_Out. procedure Stamp; -- Store the timestamp to the local variable. procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count); -- Print the time statistic with the message. procedure Translate is new ZLib.Generic_Translate (Data_In => Data_In, Data_Out => Data_Out); -- This procedure is moving data from File_In to File_Out -- with compression or decompression, depend on initialization of -- Filter parameter. ------------------- -- Compare_Files -- ------------------- procedure Compare_Files (Left, Right : String) is Left_File, Right_File : File_Type; begin Open (Left_File, In_File, Left); Open (Right_File, In_File, Right); Compare_Streams (Stream (Left_File).all, Stream (Right_File).all); Close (Left_File); Close (Right_File); end Compare_Files; --------------------- -- Compare_Streams -- --------------------- procedure Compare_Streams (Left, Right : in out Ada.Streams.Root_Stream_Type'Class) is Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#); Left_Last, Right_Last : Stream_Element_Offset; begin loop Read (Left, Left_Buffer, Left_Last); Read (Right, Right_Buffer, Right_Last); if Left_Last /= Right_Last then Ada.Text_IO.Put_Line ("Compare error :" & Stream_Element_Offset'Image (Left_Last) & " /= " & Stream_Element_Offset'Image (Right_Last)); raise Constraint_Error; elsif Left_Buffer (0 .. Left_Last) /= Right_Buffer (0 .. Right_Last) then Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal."); raise Constraint_Error; end if; exit when Left_Last < Left_Buffer'Last; end loop; end Compare_Streams; ------------------ -- Copy_Streams -- ------------------ procedure Copy_Streams (Source, Target : in out Ada.Streams.Root_Stream_Type'Class; Buffer_Size : in Stream_Element_Offset := 1024) is Buffer : Stream_Element_Array (1 .. Buffer_Size); Last : Stream_Element_Offset; begin loop Read (Source, Buffer, Last); Write (Target, Buffer (1 .. Last)); exit when Last < Buffer'Last; end loop; end Copy_Streams; ------------- -- Data_In -- ------------- procedure Data_In (Item : out Stream_Element_Array; Last : out Stream_Element_Offset) is begin Read (File_In, Item, Last); end Data_In; -------------- -- Data_Out -- -------------- procedure Data_Out (Item : in Stream_Element_Array) is begin Write (File_Out, Item); end Data_Out; ------------------- -- Generate_File -- ------------------- procedure Generate_File is subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#; package Random_Elements is new Ada.Numerics.Discrete_Random (Visible_Symbols); Gen : Random_Elements.Generator; Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10; Buffer_Count : constant Count := File_Size / Buffer'Length; -- Number of same buffers in the packet. Density : constant Count := 30; -- from 0 to Buffer'Length - 2; procedure Fill_Buffer (J, D : in Count); -- Change the part of the buffer. ----------------- -- Fill_Buffer -- ----------------- procedure Fill_Buffer (J, D : in Count) is begin for K in 0 .. D loop Buffer (Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1)) := Random_Elements.Random (Gen); end loop; end Fill_Buffer; begin Random_Elements.Reset (Gen, Init_Random); Create (File_In, Out_File, In_File_Name); Fill_Buffer (1, Buffer'Length - 2); for J in 1 .. Buffer_Count loop Write (File_In, Buffer); Fill_Buffer (J, Density); end loop; -- fill remain size. Write (File_In, Buffer (1 .. Stream_Element_Offset (File_Size - Buffer'Length * Buffer_Count))); Flush (File_In); Close (File_In); end Generate_File; --------------------- -- Print_Statistic -- --------------------- procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is use Ada.Calendar; use Ada.Text_IO; package Count_IO is new Integer_IO (ZLib.Count); Curr_Dur : Duration := Clock - Time_Stamp; begin Put (Msg); Set_Col (20); Ada.Text_IO.Put ("size ="); Count_IO.Put (Data_Size, Width => Stream_IO.Count'Image (File_Size)'Length); Put_Line (" duration =" & Duration'Image (Curr_Dur)); end Print_Statistic; ----------- -- Stamp -- ----------- procedure Stamp is begin Time_Stamp := Ada.Calendar.Clock; end Stamp; begin Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version); loop Generate_File; for Level in ZLib.Compression_Level'Range loop Ada.Text_IO.Put_Line ("Level =" & ZLib.Compression_Level'Image (Level)); -- Test generic interface. Open (File_In, In_File, In_File_Name); Create (File_Out, Out_File, Z_File_Name); Stamp; -- Deflate using generic instantiation. ZLib.Deflate_Init (Filter => Filter, Level => Level, Strategy => Strategy, Header => Header); Translate (Filter); Print_Statistic ("Generic compress", ZLib.Total_Out (Filter)); ZLib.Close (Filter); Close (File_In); Close (File_Out); Open (File_In, In_File, Z_File_Name); Create (File_Out, Out_File, Out_File_Name); Stamp; -- Inflate using generic instantiation. ZLib.Inflate_Init (Filter, Header => Header); Translate (Filter); Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter)); ZLib.Close (Filter); Close (File_In); Close (File_Out); Compare_Files (In_File_Name, Out_File_Name); -- Test stream interface. -- Compress to the back stream. Open (File_In, In_File, In_File_Name); Create (File_Back, Out_File, Z_File_Name); Stamp; ZLib.Streams.Create (Stream => File_Z, Mode => ZLib.Streams.Out_Stream, Back => ZLib.Streams.Stream_Access (Stream (File_Back)), Back_Compressed => True, Level => Level, Strategy => Strategy, Header => Header); Copy_Streams (Source => Stream (File_In).all, Target => File_Z); -- Flushing internal buffers to the back stream. ZLib.Streams.Flush (File_Z, ZLib.Finish); Print_Statistic ("Write compress", ZLib.Streams.Write_Total_Out (File_Z)); ZLib.Streams.Close (File_Z); Close (File_In); Close (File_Back); -- Compare reading from original file and from -- decompression stream. Open (File_In, In_File, In_File_Name); Open (File_Back, In_File, Z_File_Name); ZLib.Streams.Create (Stream => File_Z, Mode => ZLib.Streams.In_Stream, Back => ZLib.Streams.Stream_Access (Stream (File_Back)), Back_Compressed => True, Header => Header); Stamp; Compare_Streams (Stream (File_In).all, File_Z); Print_Statistic ("Read decompress", ZLib.Streams.Read_Total_Out (File_Z)); ZLib.Streams.Close (File_Z); Close (File_In); Close (File_Back); -- Compress by reading from compression stream. Open (File_Back, In_File, In_File_Name); Create (File_Out, Out_File, Z_File_Name); ZLib.Streams.Create (Stream => File_Z, Mode => ZLib.Streams.In_Stream, Back => ZLib.Streams.Stream_Access (Stream (File_Back)), Back_Compressed => False, Level => Level, Strategy => Strategy, Header => Header); Stamp; Copy_Streams (Source => File_Z, Target => Stream (File_Out).all); Print_Statistic ("Read compress", ZLib.Streams.Read_Total_Out (File_Z)); ZLib.Streams.Close (File_Z); Close (File_Out); Close (File_Back); -- Decompress to decompression stream. Open (File_In, In_File, Z_File_Name); Create (File_Back, Out_File, Out_File_Name); ZLib.Streams.Create (Stream => File_Z, Mode => ZLib.Streams.Out_Stream, Back => ZLib.Streams.Stream_Access (Stream (File_Back)), Back_Compressed => False, Header => Header); Stamp; Copy_Streams (Source => Stream (File_In).all, Target => File_Z); Print_Statistic ("Write decompress", ZLib.Streams.Write_Total_Out (File_Z)); ZLib.Streams.Close (File_Z); Close (File_In); Close (File_Back); Compare_Files (In_File_Name, Out_File_Name); end loop; Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok."); exit when not Continuous; File_Size := File_Size + 1; end loop; end Test; tcl8.6.14/compat/zlib/contrib/ada/zlib-streams.ads0000644000175000017500000001035214554262142021360 0ustar sergeisergei---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- -- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $ package ZLib.Streams is type Stream_Mode is (In_Stream, Out_Stream, Duplex); type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class; type Stream_Type is new Ada.Streams.Root_Stream_Type with private; procedure Read (Stream : in out Stream_Type; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); procedure Write (Stream : in out Stream_Type; Item : in Ada.Streams.Stream_Element_Array); procedure Flush (Stream : in out Stream_Type; Mode : in Flush_Mode := Sync_Flush); -- Flush the written data to the back stream, -- all data placed to the compressor is flushing to the Back stream. -- Should not be used until necessary, because it is decreasing -- compression. function Read_Total_In (Stream : in Stream_Type) return Count; pragma Inline (Read_Total_In); -- Return total number of bytes read from back stream so far. function Read_Total_Out (Stream : in Stream_Type) return Count; pragma Inline (Read_Total_Out); -- Return total number of bytes read so far. function Write_Total_In (Stream : in Stream_Type) return Count; pragma Inline (Write_Total_In); -- Return total number of bytes written so far. function Write_Total_Out (Stream : in Stream_Type) return Count; pragma Inline (Write_Total_Out); -- Return total number of bytes written to the back stream. procedure Create (Stream : out Stream_Type; Mode : in Stream_Mode; Back : in Stream_Access; Back_Compressed : in Boolean; Level : in Compression_Level := Default_Compression; Strategy : in Strategy_Type := Default_Strategy; Header : in Header_Type := Default; Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset := Default_Buffer_Size; Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset := Default_Buffer_Size); -- Create the Compression/Decompression stream. -- If mode is In_Stream then Write operation is disabled. -- If mode is Out_Stream then Read operation is disabled. -- If Back_Compressed is true then -- Data written to the Stream is compressing to the Back stream -- and data read from the Stream is decompressed data from the Back stream. -- If Back_Compressed is false then -- Data written to the Stream is decompressing to the Back stream -- and data read from the Stream is compressed data from the Back stream. -- !!! When the Need_Header is False ZLib-Ada is using undocumented -- ZLib 1.1.4 functionality to do not create/wait for ZLib headers. function Is_Open (Stream : Stream_Type) return Boolean; procedure Close (Stream : in out Stream_Type); private use Ada.Streams; type Buffer_Access is access all Stream_Element_Array; type Stream_Type is new Root_Stream_Type with record Mode : Stream_Mode; Buffer : Buffer_Access; Rest_First : Stream_Element_Offset; Rest_Last : Stream_Element_Offset; -- Buffer for Read operation. -- We need to have this buffer in the record -- because not all read data from back stream -- could be processed during the read operation. Buffer_Size : Stream_Element_Offset; -- Buffer size for write operation. -- We do not need to have this buffer -- in the record because all data could be -- processed in the write operation. Back : Stream_Access; Reader : Filter_Type; Writer : Filter_Type; end record; end ZLib.Streams; tcl8.6.14/compat/zlib/contrib/ada/zlib.gpr0000644000175000017500000000077714554262142017737 0ustar sergeisergeiproject Zlib is for Languages use ("Ada"); for Source_Dirs use ("."); for Object_Dir use "."; for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo"); package Compiler is for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst"); end Compiler; package Linker is for Default_Switches ("ada") use ("-lz"); end Linker; package Builder is for Default_Switches ("ada") use ("-s", "-gnatQ"); end Builder; end Zlib; tcl8.6.14/compat/zlib/deflate.c0000644000175000017500000023750314560736523015655 0ustar sergeisergei/* deflate.c -- compress data using the deflation algorithm * Copyright (C) 1995-2024 Jean-loup Gailly and Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* * ALGORITHM * * The "deflation" process depends on being able to identify portions * of the input text which are identical to earlier input (within a * sliding window trailing behind the input currently being processed). * * The most straightforward technique turns out to be the fastest for * most input files: try all possible matches and select the longest. * The key feature of this algorithm is that insertions into the string * dictionary are very simple and thus fast, and deletions are avoided * completely. Insertions are performed at each input character, whereas * string matches are performed only when the previous match ends. So it * is preferable to spend more time in matches to allow very fast string * insertions and avoid deletions. The matching algorithm for small * strings is inspired from that of Rabin & Karp. A brute force approach * is used to find longer strings when a small match has been found. * A similar algorithm is used in comic (by Jan-Mark Wams) and freeze * (by Leonid Broukhis). * A previous version of this file used a more sophisticated algorithm * (by Fiala and Greene) which is guaranteed to run in linear amortized * time, but has a larger average cost, uses more memory and is patented. * However the F&G algorithm may be faster for some highly redundant * files if the parameter max_chain_length (described below) is too large. * * ACKNOWLEDGEMENTS * * The idea of lazy evaluation of matches is due to Jan-Mark Wams, and * I found it in 'freeze' written by Leonid Broukhis. * Thanks to many people for bug reports and testing. * * REFERENCES * * Deutsch, L.P.,"DEFLATE Compressed Data Format Specification". * Available in http://tools.ietf.org/html/rfc1951 * * A description of the Rabin and Karp algorithm is given in the book * "Algorithms" by R. Sedgewick, Addison-Wesley, p252. * * Fiala,E.R., and Greene,D.H. * Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595 * */ /* @(#) $Id$ */ #include "deflate.h" const char deflate_copyright[] = " deflate 1.3.1 Copyright 1995-2024 Jean-loup Gailly and Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot include such an acknowledgment, I would appreciate that you keep this copyright string in the executable of your product. */ typedef enum { need_more, /* block not completed, need more input or more output */ block_done, /* block flush performed */ finish_started, /* finish started, need only more output at next deflate */ finish_done /* finish done, accept no more input or output */ } block_state; typedef block_state (*compress_func)(deflate_state *s, int flush); /* Compression function. Returns the block state after the call. */ local block_state deflate_stored(deflate_state *s, int flush); local block_state deflate_fast(deflate_state *s, int flush); #ifndef FASTEST local block_state deflate_slow(deflate_state *s, int flush); #endif local block_state deflate_rle(deflate_state *s, int flush); local block_state deflate_huff(deflate_state *s, int flush); /* =========================================================================== * Local data */ #define NIL 0 /* Tail of hash chains */ #ifndef TOO_FAR # define TOO_FAR 4096 #endif /* Matches of length 3 are discarded if their distance exceeds TOO_FAR */ /* Values for max_lazy_match, good_match and max_chain_length, depending on * the desired pack level (0..9). The values given below have been tuned to * exclude worst case performance for pathological files. Better values may be * found for specific files. */ typedef struct config_s { ush good_length; /* reduce lazy search above this match length */ ush max_lazy; /* do not perform lazy search above this match length */ ush nice_length; /* quit search above this match length */ ush max_chain; compress_func func; } config; #ifdef FASTEST local const config configuration_table[2] = { /* good lazy nice chain */ /* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ /* 1 */ {4, 4, 8, 4, deflate_fast}}; /* max speed, no lazy matches */ #else local const config configuration_table[10] = { /* good lazy nice chain */ /* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ /* 1 */ {4, 4, 8, 4, deflate_fast}, /* max speed, no lazy matches */ /* 2 */ {4, 5, 16, 8, deflate_fast}, /* 3 */ {4, 6, 32, 32, deflate_fast}, /* 4 */ {4, 4, 16, 16, deflate_slow}, /* lazy matches */ /* 5 */ {8, 16, 32, 32, deflate_slow}, /* 6 */ {8, 16, 128, 128, deflate_slow}, /* 7 */ {8, 32, 128, 256, deflate_slow}, /* 8 */ {32, 128, 258, 1024, deflate_slow}, /* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */ #endif /* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4 * For deflate_fast() (levels <= 3) good is ignored and lazy has a different * meaning. */ /* rank Z_BLOCK between Z_NO_FLUSH and Z_PARTIAL_FLUSH */ #define RANK(f) (((f) * 2) - ((f) > 4 ? 9 : 0)) /* =========================================================================== * Update a hash value with the given input byte * IN assertion: all calls to UPDATE_HASH are made with consecutive input * characters, so that a running hash key can be computed from the previous * key instead of complete recalculation each time. */ #define UPDATE_HASH(s,h,c) (h = (((h) << s->hash_shift) ^ (c)) & s->hash_mask) /* =========================================================================== * Insert string str in the dictionary and set match_head to the previous head * of the hash chain (the most recent string with same hash key). Return * the previous length of the hash chain. * If this file is compiled with -DFASTEST, the compression level is forced * to 1, and no hash chains are maintained. * IN assertion: all calls to INSERT_STRING are made with consecutive input * characters and the first MIN_MATCH bytes of str are valid (except for * the last MIN_MATCH-1 bytes of the input file). */ #ifdef FASTEST #define INSERT_STRING(s, str, match_head) \ (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ match_head = s->head[s->ins_h], \ s->head[s->ins_h] = (Pos)(str)) #else #define INSERT_STRING(s, str, match_head) \ (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \ s->head[s->ins_h] = (Pos)(str)) #endif /* =========================================================================== * Initialize the hash table (avoiding 64K overflow for 16 bit systems). * prev[] will be initialized on the fly. */ #define CLEAR_HASH(s) \ do { \ s->head[s->hash_size - 1] = NIL; \ zmemzero((Bytef *)s->head, \ (unsigned)(s->hash_size - 1)*sizeof(*s->head)); \ } while (0) /* =========================================================================== * Slide the hash table when sliding the window down (could be avoided with 32 * bit values at the expense of memory usage). We slide even when level == 0 to * keep the hash table consistent if we switch back to level > 0 later. */ #if defined(__has_feature) # if __has_feature(memory_sanitizer) __attribute__((no_sanitize("memory"))) # endif #endif local void slide_hash(deflate_state *s) { unsigned n, m; Posf *p; uInt wsize = s->w_size; n = s->hash_size; p = &s->head[n]; do { m = *--p; *p = (Pos)(m >= wsize ? m - wsize : NIL); } while (--n); n = wsize; #ifndef FASTEST p = &s->prev[n]; do { m = *--p; *p = (Pos)(m >= wsize ? m - wsize : NIL); /* If n is not on any hash chain, prev[n] is garbage but * its value will never be used. */ } while (--n); #endif } /* =========================================================================== * Read a new buffer from the current input stream, update the adler32 * and total number of bytes read. All deflate() input goes through * this function so some applications may wish to modify it to avoid * allocating a large strm->next_in buffer and copying from it. * (See also flush_pending()). */ local unsigned read_buf(z_streamp strm, Bytef *buf, unsigned size) { unsigned len = strm->avail_in; if (len > size) len = size; if (len == 0) return 0; strm->avail_in -= len; zmemcpy(buf, strm->next_in, len); if (strm->state->wrap == 1) { strm->adler = adler32(strm->adler, buf, len); } #ifdef GZIP else if (strm->state->wrap == 2) { strm->adler = crc32(strm->adler, buf, len); } #endif strm->next_in += len; strm->total_in += len; return len; } /* =========================================================================== * Fill the window when the lookahead becomes insufficient. * Updates strstart and lookahead. * * IN assertion: lookahead < MIN_LOOKAHEAD * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD * At least one byte has been read, or avail_in == 0; reads are * performed for at least two bytes (required for the zip translate_eol * option -- not supported here). */ local void fill_window(deflate_state *s) { unsigned n; unsigned more; /* Amount of free space at the end of the window. */ uInt wsize = s->w_size; Assert(s->lookahead < MIN_LOOKAHEAD, "already enough lookahead"); do { more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart); /* Deal with !@#$% 64K limit: */ if (sizeof(int) <= 2) { if (more == 0 && s->strstart == 0 && s->lookahead == 0) { more = wsize; } else if (more == (unsigned)(-1)) { /* Very unlikely, but possible on 16 bit machine if * strstart == 0 && lookahead == 1 (input done a byte at time) */ more--; } } /* If the window is almost full and there is insufficient lookahead, * move the upper half to the lower one to make room in the upper half. */ if (s->strstart >= wsize + MAX_DIST(s)) { zmemcpy(s->window, s->window + wsize, (unsigned)wsize - more); s->match_start -= wsize; s->strstart -= wsize; /* we now have strstart >= MAX_DIST */ s->block_start -= (long) wsize; if (s->insert > s->strstart) s->insert = s->strstart; slide_hash(s); more += wsize; } if (s->strm->avail_in == 0) break; /* If there was no sliding: * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 && * more == window_size - lookahead - strstart * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1) * => more >= window_size - 2*WSIZE + 2 * In the BIG_MEM or MMAP case (not yet supported), * window_size == input_size + MIN_LOOKAHEAD && * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD. * Otherwise, window_size == 2*WSIZE so more >= 2. * If there was sliding, more >= WSIZE. So in all cases, more >= 2. */ Assert(more >= 2, "more < 2"); n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more); s->lookahead += n; /* Initialize the hash value now that we have some input: */ if (s->lookahead + s->insert >= MIN_MATCH) { uInt str = s->strstart - s->insert; s->ins_h = s->window[str]; UPDATE_HASH(s, s->ins_h, s->window[str + 1]); #if MIN_MATCH != 3 Call UPDATE_HASH() MIN_MATCH-3 more times #endif while (s->insert) { UPDATE_HASH(s, s->ins_h, s->window[str + MIN_MATCH-1]); #ifndef FASTEST s->prev[str & s->w_mask] = s->head[s->ins_h]; #endif s->head[s->ins_h] = (Pos)str; str++; s->insert--; if (s->lookahead + s->insert < MIN_MATCH) break; } } /* If the whole input has less than MIN_MATCH bytes, ins_h is garbage, * but this is not important since only literal bytes will be emitted. */ } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0); /* If the WIN_INIT bytes after the end of the current data have never been * written, then zero those bytes in order to avoid memory check reports of * the use of uninitialized (or uninitialised as Julian writes) bytes by * the longest match routines. Update the high water mark for the next * time through here. WIN_INIT is set to MAX_MATCH since the longest match * routines allow scanning to strstart + MAX_MATCH, ignoring lookahead. */ if (s->high_water < s->window_size) { ulg curr = s->strstart + (ulg)(s->lookahead); ulg init; if (s->high_water < curr) { /* Previous high water mark below current data -- zero WIN_INIT * bytes or up to end of window, whichever is less. */ init = s->window_size - curr; if (init > WIN_INIT) init = WIN_INIT; zmemzero(s->window + curr, (unsigned)init); s->high_water = curr + init; } else if (s->high_water < (ulg)curr + WIN_INIT) { /* High water mark at or above current data, but below current data * plus WIN_INIT -- zero out to current data plus WIN_INIT, or up * to end of window, whichever is less. */ init = (ulg)curr + WIN_INIT - s->high_water; if (init > s->window_size - s->high_water) init = s->window_size - s->high_water; zmemzero(s->window + s->high_water, (unsigned)init); s->high_water += init; } } Assert((ulg)s->strstart <= s->window_size - MIN_LOOKAHEAD, "not enough room for search"); } /* ========================================================================= */ int ZEXPORT deflateInit_(z_streamp strm, int level, const char *version, int stream_size) { return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, version, stream_size); /* To do: ignore strm->next_in if we use it as window */ } /* ========================================================================= */ int ZEXPORT deflateInit2_(z_streamp strm, int level, int method, int windowBits, int memLevel, int strategy, const char *version, int stream_size) { deflate_state *s; int wrap = 1; static const char my_version[] = ZLIB_VERSION; if (version == Z_NULL || version[0] != my_version[0] || stream_size != sizeof(z_stream)) { return Z_VERSION_ERROR; } if (strm == Z_NULL) return Z_STREAM_ERROR; strm->msg = Z_NULL; if (strm->zalloc == (alloc_func)0) { #ifdef Z_SOLO return Z_STREAM_ERROR; #else strm->zalloc = zcalloc; strm->opaque = (voidpf)0; #endif } if (strm->zfree == (free_func)0) #ifdef Z_SOLO return Z_STREAM_ERROR; #else strm->zfree = zcfree; #endif #ifdef FASTEST if (level != 0) level = 1; #else if (level == Z_DEFAULT_COMPRESSION) level = 6; #endif if (windowBits < 0) { /* suppress zlib wrapper */ wrap = 0; if (windowBits < -15) return Z_STREAM_ERROR; windowBits = -windowBits; } #ifdef GZIP else if (windowBits > 15) { wrap = 2; /* write gzip wrapper instead */ windowBits -= 16; } #endif if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED || windowBits < 8 || windowBits > 15 || level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED || (windowBits == 8 && wrap != 1)) { return Z_STREAM_ERROR; } if (windowBits == 8) windowBits = 9; /* until 256-byte window bug fixed */ s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state)); if (s == Z_NULL) return Z_MEM_ERROR; strm->state = (struct internal_state FAR *)s; s->strm = strm; s->status = INIT_STATE; /* to pass state test in deflateReset() */ s->wrap = wrap; s->gzhead = Z_NULL; s->w_bits = (uInt)windowBits; s->w_size = 1 << s->w_bits; s->w_mask = s->w_size - 1; s->hash_bits = (uInt)memLevel + 7; s->hash_size = 1 << s->hash_bits; s->hash_mask = s->hash_size - 1; s->hash_shift = ((s->hash_bits + MIN_MATCH-1) / MIN_MATCH); s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte)); s->prev = (Posf *) ZALLOC(strm, s->w_size, sizeof(Pos)); s->head = (Posf *) ZALLOC(strm, s->hash_size, sizeof(Pos)); s->high_water = 0; /* nothing written to s->window yet */ s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */ /* We overlay pending_buf and sym_buf. This works since the average size * for length/distance pairs over any compressed block is assured to be 31 * bits or less. * * Analysis: The longest fixed codes are a length code of 8 bits plus 5 * extra bits, for lengths 131 to 257. The longest fixed distance codes are * 5 bits plus 13 extra bits, for distances 16385 to 32768. The longest * possible fixed-codes length/distance pair is then 31 bits total. * * sym_buf starts one-fourth of the way into pending_buf. So there are * three bytes in sym_buf for every four bytes in pending_buf. Each symbol * in sym_buf is three bytes -- two for the distance and one for the * literal/length. As each symbol is consumed, the pointer to the next * sym_buf value to read moves forward three bytes. From that symbol, up to * 31 bits are written to pending_buf. The closest the written pending_buf * bits gets to the next sym_buf symbol to read is just before the last * code is written. At that time, 31*(n - 2) bits have been written, just * after 24*(n - 2) bits have been consumed from sym_buf. sym_buf starts at * 8*n bits into pending_buf. (Note that the symbol buffer fills when n - 1 * symbols are written.) The closest the writing gets to what is unread is * then n + 14 bits. Here n is lit_bufsize, which is 16384 by default, and * can range from 128 to 32768. * * Therefore, at a minimum, there are 142 bits of space between what is * written and what is read in the overlain buffers, so the symbols cannot * be overwritten by the compressed data. That space is actually 139 bits, * due to the three-bit fixed-code block header. * * That covers the case where either Z_FIXED is specified, forcing fixed * codes, or when the use of fixed codes is chosen, because that choice * results in a smaller compressed block than dynamic codes. That latter * condition then assures that the above analysis also covers all dynamic * blocks. A dynamic-code block will only be chosen to be emitted if it has * fewer bits than a fixed-code block would for the same set of symbols. * Therefore its average symbol length is assured to be less than 31. So * the compressed data for a dynamic block also cannot overwrite the * symbols from which it is being constructed. */ s->pending_buf = (uchf *) ZALLOC(strm, s->lit_bufsize, LIT_BUFS); s->pending_buf_size = (ulg)s->lit_bufsize * 4; if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL || s->pending_buf == Z_NULL) { s->status = FINISH_STATE; strm->msg = ERR_MSG(Z_MEM_ERROR); deflateEnd (strm); return Z_MEM_ERROR; } #ifdef LIT_MEM s->d_buf = (ushf *)(s->pending_buf + (s->lit_bufsize << 1)); s->l_buf = s->pending_buf + (s->lit_bufsize << 2); s->sym_end = s->lit_bufsize - 1; #else s->sym_buf = s->pending_buf + s->lit_bufsize; s->sym_end = (s->lit_bufsize - 1) * 3; #endif /* We avoid equality with lit_bufsize*3 because of wraparound at 64K * on 16 bit machines and because stored blocks are restricted to * 64K-1 bytes. */ s->level = level; s->strategy = strategy; s->method = (Byte)method; return deflateReset(strm); } /* ========================================================================= * Check for a valid deflate stream state. Return 0 if ok, 1 if not. */ local int deflateStateCheck(z_streamp strm) { deflate_state *s; if (strm == Z_NULL || strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) return 1; s = strm->state; if (s == Z_NULL || s->strm != strm || (s->status != INIT_STATE && #ifdef GZIP s->status != GZIP_STATE && #endif s->status != EXTRA_STATE && s->status != NAME_STATE && s->status != COMMENT_STATE && s->status != HCRC_STATE && s->status != BUSY_STATE && s->status != FINISH_STATE)) return 1; return 0; } /* ========================================================================= */ int ZEXPORT deflateSetDictionary(z_streamp strm, const Bytef *dictionary, uInt dictLength) { deflate_state *s; uInt str, n; int wrap; unsigned avail; z_const unsigned char *next; if (deflateStateCheck(strm) || dictionary == Z_NULL) return Z_STREAM_ERROR; s = strm->state; wrap = s->wrap; if (wrap == 2 || (wrap == 1 && s->status != INIT_STATE) || s->lookahead) return Z_STREAM_ERROR; /* when using zlib wrappers, compute Adler-32 for provided dictionary */ if (wrap == 1) strm->adler = adler32(strm->adler, dictionary, dictLength); s->wrap = 0; /* avoid computing Adler-32 in read_buf */ /* if dictionary would fill window, just replace the history */ if (dictLength >= s->w_size) { if (wrap == 0) { /* already empty otherwise */ CLEAR_HASH(s); s->strstart = 0; s->block_start = 0L; s->insert = 0; } dictionary += dictLength - s->w_size; /* use the tail */ dictLength = s->w_size; } /* insert dictionary into window and hash */ avail = strm->avail_in; next = strm->next_in; strm->avail_in = dictLength; strm->next_in = (z_const Bytef *)dictionary; fill_window(s); while (s->lookahead >= MIN_MATCH) { str = s->strstart; n = s->lookahead - (MIN_MATCH-1); do { UPDATE_HASH(s, s->ins_h, s->window[str + MIN_MATCH-1]); #ifndef FASTEST s->prev[str & s->w_mask] = s->head[s->ins_h]; #endif s->head[s->ins_h] = (Pos)str; str++; } while (--n); s->strstart = str; s->lookahead = MIN_MATCH-1; fill_window(s); } s->strstart += s->lookahead; s->block_start = (long)s->strstart; s->insert = s->lookahead; s->lookahead = 0; s->match_length = s->prev_length = MIN_MATCH-1; s->match_available = 0; strm->next_in = next; strm->avail_in = avail; s->wrap = wrap; return Z_OK; } /* ========================================================================= */ int ZEXPORT deflateGetDictionary(z_streamp strm, Bytef *dictionary, uInt *dictLength) { deflate_state *s; uInt len; if (deflateStateCheck(strm)) return Z_STREAM_ERROR; s = strm->state; len = s->strstart + s->lookahead; if (len > s->w_size) len = s->w_size; if (dictionary != Z_NULL && len) zmemcpy(dictionary, s->window + s->strstart + s->lookahead - len, len); if (dictLength != Z_NULL) *dictLength = len; return Z_OK; } /* ========================================================================= */ int ZEXPORT deflateResetKeep(z_streamp strm) { deflate_state *s; if (deflateStateCheck(strm)) { return Z_STREAM_ERROR; } strm->total_in = strm->total_out = 0; strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */ strm->data_type = Z_UNKNOWN; s = (deflate_state *)strm->state; s->pending = 0; s->pending_out = s->pending_buf; if (s->wrap < 0) { s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */ } s->status = #ifdef GZIP s->wrap == 2 ? GZIP_STATE : #endif INIT_STATE; strm->adler = #ifdef GZIP s->wrap == 2 ? crc32(0L, Z_NULL, 0) : #endif adler32(0L, Z_NULL, 0); s->last_flush = -2; _tr_init(s); return Z_OK; } /* =========================================================================== * Initialize the "longest match" routines for a new zlib stream */ local void lm_init(deflate_state *s) { s->window_size = (ulg)2L*s->w_size; CLEAR_HASH(s); /* Set the default configuration parameters: */ s->max_lazy_match = configuration_table[s->level].max_lazy; s->good_match = configuration_table[s->level].good_length; s->nice_match = configuration_table[s->level].nice_length; s->max_chain_length = configuration_table[s->level].max_chain; s->strstart = 0; s->block_start = 0L; s->lookahead = 0; s->insert = 0; s->match_length = s->prev_length = MIN_MATCH-1; s->match_available = 0; s->ins_h = 0; } /* ========================================================================= */ int ZEXPORT deflateReset(z_streamp strm) { int ret; ret = deflateResetKeep(strm); if (ret == Z_OK) lm_init(strm->state); return ret; } /* ========================================================================= */ int ZEXPORT deflateSetHeader(z_streamp strm, gz_headerp head) { if (deflateStateCheck(strm) || strm->state->wrap != 2) return Z_STREAM_ERROR; strm->state->gzhead = head; return Z_OK; } /* ========================================================================= */ int ZEXPORT deflatePending(z_streamp strm, unsigned *pending, int *bits) { if (deflateStateCheck(strm)) return Z_STREAM_ERROR; if (pending != Z_NULL) *pending = strm->state->pending; if (bits != Z_NULL) *bits = strm->state->bi_valid; return Z_OK; } /* ========================================================================= */ int ZEXPORT deflatePrime(z_streamp strm, int bits, int value) { deflate_state *s; int put; if (deflateStateCheck(strm)) return Z_STREAM_ERROR; s = strm->state; #ifdef LIT_MEM if (bits < 0 || bits > 16 || (uchf *)s->d_buf < s->pending_out + ((Buf_size + 7) >> 3)) return Z_BUF_ERROR; #else if (bits < 0 || bits > 16 || s->sym_buf < s->pending_out + ((Buf_size + 7) >> 3)) return Z_BUF_ERROR; #endif do { put = Buf_size - s->bi_valid; if (put > bits) put = bits; s->bi_buf |= (ush)((value & ((1 << put) - 1)) << s->bi_valid); s->bi_valid += put; _tr_flush_bits(s); value >>= put; bits -= put; } while (bits); return Z_OK; } /* ========================================================================= */ int ZEXPORT deflateParams(z_streamp strm, int level, int strategy) { deflate_state *s; compress_func func; if (deflateStateCheck(strm)) return Z_STREAM_ERROR; s = strm->state; #ifdef FASTEST if (level != 0) level = 1; #else if (level == Z_DEFAULT_COMPRESSION) level = 6; #endif if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) { return Z_STREAM_ERROR; } func = configuration_table[s->level].func; if ((strategy != s->strategy || func != configuration_table[level].func) && s->last_flush != -2) { /* Flush the last buffer: */ int err = deflate(strm, Z_BLOCK); if (err == Z_STREAM_ERROR) return err; if (strm->avail_in || (s->strstart - s->block_start) + s->lookahead) return Z_BUF_ERROR; } if (s->level != level) { if (s->level == 0 && s->matches != 0) { if (s->matches == 1) slide_hash(s); else CLEAR_HASH(s); s->matches = 0; } s->level = level; s->max_lazy_match = configuration_table[level].max_lazy; s->good_match = configuration_table[level].good_length; s->nice_match = configuration_table[level].nice_length; s->max_chain_length = configuration_table[level].max_chain; } s->strategy = strategy; return Z_OK; } /* ========================================================================= */ int ZEXPORT deflateTune(z_streamp strm, int good_length, int max_lazy, int nice_length, int max_chain) { deflate_state *s; if (deflateStateCheck(strm)) return Z_STREAM_ERROR; s = strm->state; s->good_match = (uInt)good_length; s->max_lazy_match = (uInt)max_lazy; s->nice_match = nice_length; s->max_chain_length = (uInt)max_chain; return Z_OK; } /* ========================================================================= * For the default windowBits of 15 and memLevel of 8, this function returns a * close to exact, as well as small, upper bound on the compressed size. This * is an expansion of ~0.03%, plus a small constant. * * For any setting other than those defaults for windowBits and memLevel, one * of two worst case bounds is returned. This is at most an expansion of ~4% or * ~13%, plus a small constant. * * Both the 0.03% and 4% derive from the overhead of stored blocks. The first * one is for stored blocks of 16383 bytes (memLevel == 8), whereas the second * is for stored blocks of 127 bytes (the worst case memLevel == 1). The * expansion results from five bytes of header for each stored block. * * The larger expansion of 13% results from a window size less than or equal to * the symbols buffer size (windowBits <= memLevel + 7). In that case some of * the data being compressed may have slid out of the sliding window, impeding * a stored block from being emitted. Then the only choice is a fixed or * dynamic block, where a fixed block limits the maximum expansion to 9 bits * per 8-bit byte, plus 10 bits for every block. The smallest block size for * which this can occur is 255 (memLevel == 2). * * Shifts are used to approximate divisions, for speed. */ uLong ZEXPORT deflateBound(z_streamp strm, uLong sourceLen) { deflate_state *s; uLong fixedlen, storelen, wraplen; /* upper bound for fixed blocks with 9-bit literals and length 255 (memLevel == 2, which is the lowest that may not use stored blocks) -- ~13% overhead plus a small constant */ fixedlen = sourceLen + (sourceLen >> 3) + (sourceLen >> 8) + (sourceLen >> 9) + 4; /* upper bound for stored blocks with length 127 (memLevel == 1) -- ~4% overhead plus a small constant */ storelen = sourceLen + (sourceLen >> 5) + (sourceLen >> 7) + (sourceLen >> 11) + 7; /* if can't get parameters, return larger bound plus a zlib wrapper */ if (deflateStateCheck(strm)) return (fixedlen > storelen ? fixedlen : storelen) + 6; /* compute wrapper length */ s = strm->state; switch (s->wrap) { case 0: /* raw deflate */ wraplen = 0; break; case 1: /* zlib wrapper */ wraplen = 6 + (s->strstart ? 4 : 0); break; #ifdef GZIP case 2: /* gzip wrapper */ wraplen = 18; if (s->gzhead != Z_NULL) { /* user-supplied gzip header */ Bytef *str; if (s->gzhead->extra != Z_NULL) wraplen += 2 + s->gzhead->extra_len; str = s->gzhead->name; if (str != Z_NULL) do { wraplen++; } while (*str++); str = s->gzhead->comment; if (str != Z_NULL) do { wraplen++; } while (*str++); if (s->gzhead->hcrc) wraplen += 2; } break; #endif default: /* for compiler happiness */ wraplen = 6; } /* if not default parameters, return one of the conservative bounds */ if (s->w_bits != 15 || s->hash_bits != 8 + 7) return (s->w_bits <= s->hash_bits && s->level ? fixedlen : storelen) + wraplen; /* default settings: return tight bound for that case -- ~0.03% overhead plus a small constant */ return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) + (sourceLen >> 25) + 13 - 6 + wraplen; } /* ========================================================================= * Put a short in the pending buffer. The 16-bit value is put in MSB order. * IN assertion: the stream state is correct and there is enough room in * pending_buf. */ local void putShortMSB(deflate_state *s, uInt b) { put_byte(s, (Byte)(b >> 8)); put_byte(s, (Byte)(b & 0xff)); } /* ========================================================================= * Flush as much pending output as possible. All deflate() output, except for * some deflate_stored() output, goes through this function so some * applications may wish to modify it to avoid allocating a large * strm->next_out buffer and copying into it. (See also read_buf()). */ local void flush_pending(z_streamp strm) { unsigned len; deflate_state *s = strm->state; _tr_flush_bits(s); len = s->pending; if (len > strm->avail_out) len = strm->avail_out; if (len == 0) return; zmemcpy(strm->next_out, s->pending_out, len); strm->next_out += len; s->pending_out += len; strm->total_out += len; strm->avail_out -= len; s->pending -= len; if (s->pending == 0) { s->pending_out = s->pending_buf; } } /* =========================================================================== * Update the header CRC with the bytes s->pending_buf[beg..s->pending - 1]. */ #define HCRC_UPDATE(beg) \ do { \ if (s->gzhead->hcrc && s->pending > (beg)) \ strm->adler = crc32(strm->adler, s->pending_buf + (beg), \ s->pending - (beg)); \ } while (0) /* ========================================================================= */ int ZEXPORT deflate(z_streamp strm, int flush) { int old_flush; /* value of flush param for previous deflate call */ deflate_state *s; if (deflateStateCheck(strm) || flush > Z_BLOCK || flush < 0) { return Z_STREAM_ERROR; } s = strm->state; if (strm->next_out == Z_NULL || (strm->avail_in != 0 && strm->next_in == Z_NULL) || (s->status == FINISH_STATE && flush != Z_FINISH)) { ERR_RETURN(strm, Z_STREAM_ERROR); } if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR); old_flush = s->last_flush; s->last_flush = flush; /* Flush as much pending output as possible */ if (s->pending != 0) { flush_pending(strm); if (strm->avail_out == 0) { /* Since avail_out is 0, deflate will be called again with * more output space, but possibly with both pending and * avail_in equal to zero. There won't be anything to do, * but this is not an error situation so make sure we * return OK instead of BUF_ERROR at next call of deflate: */ s->last_flush = -1; return Z_OK; } /* Make sure there is something to do and avoid duplicate consecutive * flushes. For repeated and useless calls with Z_FINISH, we keep * returning Z_STREAM_END instead of Z_BUF_ERROR. */ } else if (strm->avail_in == 0 && RANK(flush) <= RANK(old_flush) && flush != Z_FINISH) { ERR_RETURN(strm, Z_BUF_ERROR); } /* User must not provide more input after the first FINISH: */ if (s->status == FINISH_STATE && strm->avail_in != 0) { ERR_RETURN(strm, Z_BUF_ERROR); } /* Write the header */ if (s->status == INIT_STATE && s->wrap == 0) s->status = BUSY_STATE; if (s->status == INIT_STATE) { /* zlib header */ uInt header = (Z_DEFLATED + ((s->w_bits - 8) << 4)) << 8; uInt level_flags; if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2) level_flags = 0; else if (s->level < 6) level_flags = 1; else if (s->level == 6) level_flags = 2; else level_flags = 3; header |= (level_flags << 6); if (s->strstart != 0) header |= PRESET_DICT; header += 31 - (header % 31); putShortMSB(s, header); /* Save the adler32 of the preset dictionary: */ if (s->strstart != 0) { putShortMSB(s, (uInt)(strm->adler >> 16)); putShortMSB(s, (uInt)(strm->adler & 0xffff)); } strm->adler = adler32(0L, Z_NULL, 0); s->status = BUSY_STATE; /* Compression must start with an empty pending buffer */ flush_pending(strm); if (s->pending != 0) { s->last_flush = -1; return Z_OK; } } #ifdef GZIP if (s->status == GZIP_STATE) { /* gzip header */ strm->adler = crc32(0L, Z_NULL, 0); put_byte(s, 31); put_byte(s, 139); put_byte(s, 8); if (s->gzhead == Z_NULL) { put_byte(s, 0); put_byte(s, 0); put_byte(s, 0); put_byte(s, 0); put_byte(s, 0); put_byte(s, s->level == 9 ? 2 : (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? 4 : 0)); put_byte(s, OS_CODE); s->status = BUSY_STATE; /* Compression must start with an empty pending buffer */ flush_pending(strm); if (s->pending != 0) { s->last_flush = -1; return Z_OK; } } else { put_byte(s, (s->gzhead->text ? 1 : 0) + (s->gzhead->hcrc ? 2 : 0) + (s->gzhead->extra == Z_NULL ? 0 : 4) + (s->gzhead->name == Z_NULL ? 0 : 8) + (s->gzhead->comment == Z_NULL ? 0 : 16) ); put_byte(s, (Byte)(s->gzhead->time & 0xff)); put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff)); put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff)); put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff)); put_byte(s, s->level == 9 ? 2 : (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? 4 : 0)); put_byte(s, s->gzhead->os & 0xff); if (s->gzhead->extra != Z_NULL) { put_byte(s, s->gzhead->extra_len & 0xff); put_byte(s, (s->gzhead->extra_len >> 8) & 0xff); } if (s->gzhead->hcrc) strm->adler = crc32(strm->adler, s->pending_buf, s->pending); s->gzindex = 0; s->status = EXTRA_STATE; } } if (s->status == EXTRA_STATE) { if (s->gzhead->extra != Z_NULL) { ulg beg = s->pending; /* start of bytes to update crc */ uInt left = (s->gzhead->extra_len & 0xffff) - s->gzindex; while (s->pending + left > s->pending_buf_size) { uInt copy = s->pending_buf_size - s->pending; zmemcpy(s->pending_buf + s->pending, s->gzhead->extra + s->gzindex, copy); s->pending = s->pending_buf_size; HCRC_UPDATE(beg); s->gzindex += copy; flush_pending(strm); if (s->pending != 0) { s->last_flush = -1; return Z_OK; } beg = 0; left -= copy; } zmemcpy(s->pending_buf + s->pending, s->gzhead->extra + s->gzindex, left); s->pending += left; HCRC_UPDATE(beg); s->gzindex = 0; } s->status = NAME_STATE; } if (s->status == NAME_STATE) { if (s->gzhead->name != Z_NULL) { ulg beg = s->pending; /* start of bytes to update crc */ int val; do { if (s->pending == s->pending_buf_size) { HCRC_UPDATE(beg); flush_pending(strm); if (s->pending != 0) { s->last_flush = -1; return Z_OK; } beg = 0; } val = s->gzhead->name[s->gzindex++]; put_byte(s, val); } while (val != 0); HCRC_UPDATE(beg); s->gzindex = 0; } s->status = COMMENT_STATE; } if (s->status == COMMENT_STATE) { if (s->gzhead->comment != Z_NULL) { ulg beg = s->pending; /* start of bytes to update crc */ int val; do { if (s->pending == s->pending_buf_size) { HCRC_UPDATE(beg); flush_pending(strm); if (s->pending != 0) { s->last_flush = -1; return Z_OK; } beg = 0; } val = s->gzhead->comment[s->gzindex++]; put_byte(s, val); } while (val != 0); HCRC_UPDATE(beg); } s->status = HCRC_STATE; } if (s->status == HCRC_STATE) { if (s->gzhead->hcrc) { if (s->pending + 2 > s->pending_buf_size) { flush_pending(strm); if (s->pending != 0) { s->last_flush = -1; return Z_OK; } } put_byte(s, (Byte)(strm->adler & 0xff)); put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); strm->adler = crc32(0L, Z_NULL, 0); } s->status = BUSY_STATE; /* Compression must start with an empty pending buffer */ flush_pending(strm); if (s->pending != 0) { s->last_flush = -1; return Z_OK; } } #endif /* Start a new block or continue the current one. */ if (strm->avail_in != 0 || s->lookahead != 0 || (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) { block_state bstate; bstate = s->level == 0 ? deflate_stored(s, flush) : s->strategy == Z_HUFFMAN_ONLY ? deflate_huff(s, flush) : s->strategy == Z_RLE ? deflate_rle(s, flush) : (*(configuration_table[s->level].func))(s, flush); if (bstate == finish_started || bstate == finish_done) { s->status = FINISH_STATE; } if (bstate == need_more || bstate == finish_started) { if (strm->avail_out == 0) { s->last_flush = -1; /* avoid BUF_ERROR next call, see above */ } return Z_OK; /* If flush != Z_NO_FLUSH && avail_out == 0, the next call * of deflate should use the same flush parameter to make sure * that the flush is complete. So we don't have to output an * empty block here, this will be done at next call. This also * ensures that for a very small output buffer, we emit at most * one empty block. */ } if (bstate == block_done) { if (flush == Z_PARTIAL_FLUSH) { _tr_align(s); } else if (flush != Z_BLOCK) { /* FULL_FLUSH or SYNC_FLUSH */ _tr_stored_block(s, (char*)0, 0L, 0); /* For a full flush, this empty block will be recognized * as a special marker by inflate_sync(). */ if (flush == Z_FULL_FLUSH) { CLEAR_HASH(s); /* forget history */ if (s->lookahead == 0) { s->strstart = 0; s->block_start = 0L; s->insert = 0; } } } flush_pending(strm); if (strm->avail_out == 0) { s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */ return Z_OK; } } } if (flush != Z_FINISH) return Z_OK; if (s->wrap <= 0) return Z_STREAM_END; /* Write the trailer */ #ifdef GZIP if (s->wrap == 2) { put_byte(s, (Byte)(strm->adler & 0xff)); put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); put_byte(s, (Byte)((strm->adler >> 16) & 0xff)); put_byte(s, (Byte)((strm->adler >> 24) & 0xff)); put_byte(s, (Byte)(strm->total_in & 0xff)); put_byte(s, (Byte)((strm->total_in >> 8) & 0xff)); put_byte(s, (Byte)((strm->total_in >> 16) & 0xff)); put_byte(s, (Byte)((strm->total_in >> 24) & 0xff)); } else #endif { putShortMSB(s, (uInt)(strm->adler >> 16)); putShortMSB(s, (uInt)(strm->adler & 0xffff)); } flush_pending(strm); /* If avail_out is zero, the application will call deflate again * to flush the rest. */ if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */ return s->pending != 0 ? Z_OK : Z_STREAM_END; } /* ========================================================================= */ int ZEXPORT deflateEnd(z_streamp strm) { int status; if (deflateStateCheck(strm)) return Z_STREAM_ERROR; status = strm->state->status; /* Deallocate in reverse order of allocations: */ TRY_FREE(strm, strm->state->pending_buf); TRY_FREE(strm, strm->state->head); TRY_FREE(strm, strm->state->prev); TRY_FREE(strm, strm->state->window); ZFREE(strm, strm->state); strm->state = Z_NULL; return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK; } /* ========================================================================= * Copy the source state to the destination state. * To simplify the source, this is not supported for 16-bit MSDOS (which * doesn't have enough memory anyway to duplicate compression states). */ int ZEXPORT deflateCopy(z_streamp dest, z_streamp source) { #ifdef MAXSEG_64K (void)dest; (void)source; return Z_STREAM_ERROR; #else deflate_state *ds; deflate_state *ss; if (deflateStateCheck(source) || dest == Z_NULL) { return Z_STREAM_ERROR; } ss = source->state; zmemcpy((voidpf)dest, (voidpf)source, sizeof(z_stream)); ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state)); if (ds == Z_NULL) return Z_MEM_ERROR; dest->state = (struct internal_state FAR *) ds; zmemcpy((voidpf)ds, (voidpf)ss, sizeof(deflate_state)); ds->strm = dest; ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte)); ds->prev = (Posf *) ZALLOC(dest, ds->w_size, sizeof(Pos)); ds->head = (Posf *) ZALLOC(dest, ds->hash_size, sizeof(Pos)); ds->pending_buf = (uchf *) ZALLOC(dest, ds->lit_bufsize, LIT_BUFS); if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL || ds->pending_buf == Z_NULL) { deflateEnd (dest); return Z_MEM_ERROR; } /* following zmemcpy do not work for 16-bit MSDOS */ zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte)); zmemcpy((voidpf)ds->prev, (voidpf)ss->prev, ds->w_size * sizeof(Pos)); zmemcpy((voidpf)ds->head, (voidpf)ss->head, ds->hash_size * sizeof(Pos)); zmemcpy(ds->pending_buf, ss->pending_buf, ds->lit_bufsize * LIT_BUFS); ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf); #ifdef LIT_MEM ds->d_buf = (ushf *)(ds->pending_buf + (ds->lit_bufsize << 1)); ds->l_buf = ds->pending_buf + (ds->lit_bufsize << 2); #else ds->sym_buf = ds->pending_buf + ds->lit_bufsize; #endif ds->l_desc.dyn_tree = ds->dyn_ltree; ds->d_desc.dyn_tree = ds->dyn_dtree; ds->bl_desc.dyn_tree = ds->bl_tree; return Z_OK; #endif /* MAXSEG_64K */ } #ifndef FASTEST /* =========================================================================== * Set match_start to the longest match starting at the given string and * return its length. Matches shorter or equal to prev_length are discarded, * in which case the result is equal to prev_length and match_start is * garbage. * IN assertions: cur_match is the head of the hash chain for the current * string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1 * OUT assertion: the match length is not greater than s->lookahead. */ local uInt longest_match(deflate_state *s, IPos cur_match) { unsigned chain_length = s->max_chain_length;/* max hash chain length */ register Bytef *scan = s->window + s->strstart; /* current string */ register Bytef *match; /* matched string */ register int len; /* length of current match */ int best_len = (int)s->prev_length; /* best match length so far */ int nice_match = s->nice_match; /* stop if match long enough */ IPos limit = s->strstart > (IPos)MAX_DIST(s) ? s->strstart - (IPos)MAX_DIST(s) : NIL; /* Stop when cur_match becomes <= limit. To simplify the code, * we prevent matches with the string of window index 0. */ Posf *prev = s->prev; uInt wmask = s->w_mask; #ifdef UNALIGNED_OK /* Compare two bytes at a time. Note: this is not always beneficial. * Try with and without -DUNALIGNED_OK to check. */ register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1; register ush scan_start = *(ushf*)scan; register ush scan_end = *(ushf*)(scan + best_len - 1); #else register Bytef *strend = s->window + s->strstart + MAX_MATCH; register Byte scan_end1 = scan[best_len - 1]; register Byte scan_end = scan[best_len]; #endif /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16. * It is easy to get rid of this optimization if necessary. */ Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); /* Do not waste too much time if we already have a good match: */ if (s->prev_length >= s->good_match) { chain_length >>= 2; } /* Do not look for matches beyond the end of the input. This is necessary * to make deflate deterministic. */ if ((uInt)nice_match > s->lookahead) nice_match = (int)s->lookahead; Assert((ulg)s->strstart <= s->window_size - MIN_LOOKAHEAD, "need lookahead"); do { Assert(cur_match < s->strstart, "no future"); match = s->window + cur_match; /* Skip to next match if the match length cannot increase * or if the match length is less than 2. Note that the checks below * for insufficient lookahead only occur occasionally for performance * reasons. Therefore uninitialized memory will be accessed, and * conditional jumps will be made that depend on those values. * However the length of the match is limited to the lookahead, so * the output of deflate is not affected by the uninitialized values. */ #if (defined(UNALIGNED_OK) && MAX_MATCH == 258) /* This code assumes sizeof(unsigned short) == 2. Do not use * UNALIGNED_OK if your compiler uses a different size. */ if (*(ushf*)(match + best_len - 1) != scan_end || *(ushf*)match != scan_start) continue; /* It is not necessary to compare scan[2] and match[2] since they are * always equal when the other bytes match, given that the hash keys * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at * strstart + 3, + 5, up to strstart + 257. We check for insufficient * lookahead only every 4th comparison; the 128th check will be made * at strstart + 257. If MAX_MATCH-2 is not a multiple of 8, it is * necessary to put more guard bytes at the end of the window, or * to check more often for insufficient lookahead. */ Assert(scan[2] == match[2], "scan[2]?"); scan++, match++; do { } while (*(ushf*)(scan += 2) == *(ushf*)(match += 2) && *(ushf*)(scan += 2) == *(ushf*)(match += 2) && *(ushf*)(scan += 2) == *(ushf*)(match += 2) && *(ushf*)(scan += 2) == *(ushf*)(match += 2) && scan < strend); /* The funny "do {}" generates better code on most compilers */ /* Here, scan <= window + strstart + 257 */ Assert(scan <= s->window + (unsigned)(s->window_size - 1), "wild scan"); if (*scan == *match) scan++; len = (MAX_MATCH - 1) - (int)(strend - scan); scan = strend - (MAX_MATCH-1); #else /* UNALIGNED_OK */ if (match[best_len] != scan_end || match[best_len - 1] != scan_end1 || *match != *scan || *++match != scan[1]) continue; /* The check at best_len - 1 can be removed because it will be made * again later. (This heuristic is not always a win.) * It is not necessary to compare scan[2] and match[2] since they * are always equal when the other bytes match, given that * the hash keys are equal and that HASH_BITS >= 8. */ scan += 2, match++; Assert(*scan == *match, "match[2]?"); /* We check for insufficient lookahead only every 8th comparison; * the 256th check will be made at strstart + 258. */ do { } while (*++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && scan < strend); Assert(scan <= s->window + (unsigned)(s->window_size - 1), "wild scan"); len = MAX_MATCH - (int)(strend - scan); scan = strend - MAX_MATCH; #endif /* UNALIGNED_OK */ if (len > best_len) { s->match_start = cur_match; best_len = len; if (len >= nice_match) break; #ifdef UNALIGNED_OK scan_end = *(ushf*)(scan + best_len - 1); #else scan_end1 = scan[best_len - 1]; scan_end = scan[best_len]; #endif } } while ((cur_match = prev[cur_match & wmask]) > limit && --chain_length != 0); if ((uInt)best_len <= s->lookahead) return (uInt)best_len; return s->lookahead; } #else /* FASTEST */ /* --------------------------------------------------------------------------- * Optimized version for FASTEST only */ local uInt longest_match(deflate_state *s, IPos cur_match) { register Bytef *scan = s->window + s->strstart; /* current string */ register Bytef *match; /* matched string */ register int len; /* length of current match */ register Bytef *strend = s->window + s->strstart + MAX_MATCH; /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16. * It is easy to get rid of this optimization if necessary. */ Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); Assert((ulg)s->strstart <= s->window_size - MIN_LOOKAHEAD, "need lookahead"); Assert(cur_match < s->strstart, "no future"); match = s->window + cur_match; /* Return failure if the match length is less than 2: */ if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1; /* The check at best_len - 1 can be removed because it will be made * again later. (This heuristic is not always a win.) * It is not necessary to compare scan[2] and match[2] since they * are always equal when the other bytes match, given that * the hash keys are equal and that HASH_BITS >= 8. */ scan += 2, match += 2; Assert(*scan == *match, "match[2]?"); /* We check for insufficient lookahead only every 8th comparison; * the 256th check will be made at strstart + 258. */ do { } while (*++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && *++scan == *++match && scan < strend); Assert(scan <= s->window + (unsigned)(s->window_size - 1), "wild scan"); len = MAX_MATCH - (int)(strend - scan); if (len < MIN_MATCH) return MIN_MATCH - 1; s->match_start = cur_match; return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead; } #endif /* FASTEST */ #ifdef ZLIB_DEBUG #define EQUAL 0 /* result of memcmp for equal strings */ /* =========================================================================== * Check that the match at match_start is indeed a match. */ local void check_match(deflate_state *s, IPos start, IPos match, int length) { /* check that the match is indeed a match */ Bytef *back = s->window + (int)match, *here = s->window + start; IPos len = length; if (match == (IPos)-1) { /* match starts one byte before the current window -- just compare the subsequent length-1 bytes */ back++; here++; len--; } if (zmemcmp(back, here, len) != EQUAL) { fprintf(stderr, " start %u, match %d, length %d\n", start, (int)match, length); do { fprintf(stderr, "(%02x %02x)", *back++, *here++); } while (--len != 0); z_error("invalid match"); } if (z_verbose > 1) { fprintf(stderr,"\\[%d,%d]", start - match, length); do { putc(s->window[start++], stderr); } while (--length != 0); } } #else # define check_match(s, start, match, length) #endif /* ZLIB_DEBUG */ /* =========================================================================== * Flush the current block, with given end-of-file flag. * IN assertion: strstart is set to the end of the current match. */ #define FLUSH_BLOCK_ONLY(s, last) { \ _tr_flush_block(s, (s->block_start >= 0L ? \ (charf *)&s->window[(unsigned)s->block_start] : \ (charf *)Z_NULL), \ (ulg)((long)s->strstart - s->block_start), \ (last)); \ s->block_start = s->strstart; \ flush_pending(s->strm); \ Tracev((stderr,"[FLUSH]")); \ } /* Same but force premature exit if necessary. */ #define FLUSH_BLOCK(s, last) { \ FLUSH_BLOCK_ONLY(s, last); \ if (s->strm->avail_out == 0) return (last) ? finish_started : need_more; \ } /* Maximum stored block length in deflate format (not including header). */ #define MAX_STORED 65535 /* Minimum of a and b. */ #define MIN(a, b) ((a) > (b) ? (b) : (a)) /* =========================================================================== * Copy without compression as much as possible from the input stream, return * the current block state. * * In case deflateParams() is used to later switch to a non-zero compression * level, s->matches (otherwise unused when storing) keeps track of the number * of hash table slides to perform. If s->matches is 1, then one hash table * slide will be done when switching. If s->matches is 2, the maximum value * allowed here, then the hash table will be cleared, since two or more slides * is the same as a clear. * * deflate_stored() is written to minimize the number of times an input byte is * copied. It is most efficient with large input and output buffers, which * maximizes the opportunities to have a single copy from next_in to next_out. */ local block_state deflate_stored(deflate_state *s, int flush) { /* Smallest worthy block size when not flushing or finishing. By default * this is 32K. This can be as small as 507 bytes for memLevel == 1. For * large input and output buffers, the stored block size will be larger. */ unsigned min_block = MIN(s->pending_buf_size - 5, s->w_size); /* Copy as many min_block or larger stored blocks directly to next_out as * possible. If flushing, copy the remaining available input to next_out as * stored blocks, if there is enough space. */ unsigned len, left, have, last = 0; unsigned used = s->strm->avail_in; do { /* Set len to the maximum size block that we can copy directly with the * available input data and output space. Set left to how much of that * would be copied from what's left in the window. */ len = MAX_STORED; /* maximum deflate stored block length */ have = (s->bi_valid + 42) >> 3; /* number of header bytes */ if (s->strm->avail_out < have) /* need room for header */ break; /* maximum stored block length that will fit in avail_out: */ have = s->strm->avail_out - have; left = s->strstart - s->block_start; /* bytes left in window */ if (len > (ulg)left + s->strm->avail_in) len = left + s->strm->avail_in; /* limit len to the input */ if (len > have) len = have; /* limit len to the output */ /* If the stored block would be less than min_block in length, or if * unable to copy all of the available input when flushing, then try * copying to the window and the pending buffer instead. Also don't * write an empty block when flushing -- deflate() does that. */ if (len < min_block && ((len == 0 && flush != Z_FINISH) || flush == Z_NO_FLUSH || len != left + s->strm->avail_in)) break; /* Make a dummy stored block in pending to get the header bytes, * including any pending bits. This also updates the debugging counts. */ last = flush == Z_FINISH && len == left + s->strm->avail_in ? 1 : 0; _tr_stored_block(s, (char *)0, 0L, last); /* Replace the lengths in the dummy stored block with len. */ s->pending_buf[s->pending - 4] = len; s->pending_buf[s->pending - 3] = len >> 8; s->pending_buf[s->pending - 2] = ~len; s->pending_buf[s->pending - 1] = ~len >> 8; /* Write the stored block header bytes. */ flush_pending(s->strm); #ifdef ZLIB_DEBUG /* Update debugging counts for the data about to be copied. */ s->compressed_len += len << 3; s->bits_sent += len << 3; #endif /* Copy uncompressed bytes from the window to next_out. */ if (left) { if (left > len) left = len; zmemcpy(s->strm->next_out, s->window + s->block_start, left); s->strm->next_out += left; s->strm->avail_out -= left; s->strm->total_out += left; s->block_start += left; len -= left; } /* Copy uncompressed bytes directly from next_in to next_out, updating * the check value. */ if (len) { read_buf(s->strm, s->strm->next_out, len); s->strm->next_out += len; s->strm->avail_out -= len; s->strm->total_out += len; } } while (last == 0); /* Update the sliding window with the last s->w_size bytes of the copied * data, or append all of the copied data to the existing window if less * than s->w_size bytes were copied. Also update the number of bytes to * insert in the hash tables, in the event that deflateParams() switches to * a non-zero compression level. */ used -= s->strm->avail_in; /* number of input bytes directly copied */ if (used) { /* If any input was used, then no unused input remains in the window, * therefore s->block_start == s->strstart. */ if (used >= s->w_size) { /* supplant the previous history */ s->matches = 2; /* clear hash */ zmemcpy(s->window, s->strm->next_in - s->w_size, s->w_size); s->strstart = s->w_size; s->insert = s->strstart; } else { if (s->window_size - s->strstart <= used) { /* Slide the window down. */ s->strstart -= s->w_size; zmemcpy(s->window, s->window + s->w_size, s->strstart); if (s->matches < 2) s->matches++; /* add a pending slide_hash() */ if (s->insert > s->strstart) s->insert = s->strstart; } zmemcpy(s->window + s->strstart, s->strm->next_in - used, used); s->strstart += used; s->insert += MIN(used, s->w_size - s->insert); } s->block_start = s->strstart; } if (s->high_water < s->strstart) s->high_water = s->strstart; /* If the last block was written to next_out, then done. */ if (last) return finish_done; /* If flushing and all input has been consumed, then done. */ if (flush != Z_NO_FLUSH && flush != Z_FINISH && s->strm->avail_in == 0 && (long)s->strstart == s->block_start) return block_done; /* Fill the window with any remaining input. */ have = s->window_size - s->strstart; if (s->strm->avail_in > have && s->block_start >= (long)s->w_size) { /* Slide the window down. */ s->block_start -= s->w_size; s->strstart -= s->w_size; zmemcpy(s->window, s->window + s->w_size, s->strstart); if (s->matches < 2) s->matches++; /* add a pending slide_hash() */ have += s->w_size; /* more space now */ if (s->insert > s->strstart) s->insert = s->strstart; } if (have > s->strm->avail_in) have = s->strm->avail_in; if (have) { read_buf(s->strm, s->window + s->strstart, have); s->strstart += have; s->insert += MIN(have, s->w_size - s->insert); } if (s->high_water < s->strstart) s->high_water = s->strstart; /* There was not enough avail_out to write a complete worthy or flushed * stored block to next_out. Write a stored block to pending instead, if we * have enough input for a worthy block, or if flushing and there is enough * room for the remaining input as a stored block in the pending buffer. */ have = (s->bi_valid + 42) >> 3; /* number of header bytes */ /* maximum stored block length that will fit in pending: */ have = MIN(s->pending_buf_size - have, MAX_STORED); min_block = MIN(have, s->w_size); left = s->strstart - s->block_start; if (left >= min_block || ((left || flush == Z_FINISH) && flush != Z_NO_FLUSH && s->strm->avail_in == 0 && left <= have)) { len = MIN(left, have); last = flush == Z_FINISH && s->strm->avail_in == 0 && len == left ? 1 : 0; _tr_stored_block(s, (charf *)s->window + s->block_start, len, last); s->block_start += len; flush_pending(s->strm); } /* We've done all we can with the available input and output. */ return last ? finish_started : need_more; } /* =========================================================================== * Compress as much as possible from the input stream, return the current * block state. * This function does not perform lazy evaluation of matches and inserts * new strings in the dictionary only for unmatched strings or for short * matches. It is used only for the fast compression options. */ local block_state deflate_fast(deflate_state *s, int flush) { IPos hash_head; /* head of the hash chain */ int bflush; /* set if current block must be flushed */ for (;;) { /* Make sure that we always have enough lookahead, except * at the end of the input file. We need MAX_MATCH bytes * for the next match, plus MIN_MATCH bytes to insert the * string following the next match. */ if (s->lookahead < MIN_LOOKAHEAD) { fill_window(s); if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { return need_more; } if (s->lookahead == 0) break; /* flush the current block */ } /* Insert the string window[strstart .. strstart + 2] in the * dictionary, and set hash_head to the head of the hash chain: */ hash_head = NIL; if (s->lookahead >= MIN_MATCH) { INSERT_STRING(s, s->strstart, hash_head); } /* Find the longest match, discarding those <= prev_length. * At this point we have always match_length < MIN_MATCH */ if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) { /* To simplify the code, we prevent matches with the string * of window index 0 (in particular we have to avoid a match * of the string with itself at the start of the input file). */ s->match_length = longest_match (s, hash_head); /* longest_match() sets match_start */ } if (s->match_length >= MIN_MATCH) { check_match(s, s->strstart, s->match_start, s->match_length); _tr_tally_dist(s, s->strstart - s->match_start, s->match_length - MIN_MATCH, bflush); s->lookahead -= s->match_length; /* Insert new strings in the hash table only if the match length * is not too large. This saves time but degrades compression. */ #ifndef FASTEST if (s->match_length <= s->max_insert_length && s->lookahead >= MIN_MATCH) { s->match_length--; /* string at strstart already in table */ do { s->strstart++; INSERT_STRING(s, s->strstart, hash_head); /* strstart never exceeds WSIZE-MAX_MATCH, so there are * always MIN_MATCH bytes ahead. */ } while (--s->match_length != 0); s->strstart++; } else #endif { s->strstart += s->match_length; s->match_length = 0; s->ins_h = s->window[s->strstart]; UPDATE_HASH(s, s->ins_h, s->window[s->strstart + 1]); #if MIN_MATCH != 3 Call UPDATE_HASH() MIN_MATCH-3 more times #endif /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not * matter since it will be recomputed at next deflate call. */ } } else { /* No match, output a literal byte */ Tracevv((stderr,"%c", s->window[s->strstart])); _tr_tally_lit(s, s->window[s->strstart], bflush); s->lookahead--; s->strstart++; } if (bflush) FLUSH_BLOCK(s, 0); } s->insert = s->strstart < MIN_MATCH-1 ? s->strstart : MIN_MATCH-1; if (flush == Z_FINISH) { FLUSH_BLOCK(s, 1); return finish_done; } if (s->sym_next) FLUSH_BLOCK(s, 0); return block_done; } #ifndef FASTEST /* =========================================================================== * Same as above, but achieves better compression. We use a lazy * evaluation for matches: a match is finally adopted only if there is * no better match at the next window position. */ local block_state deflate_slow(deflate_state *s, int flush) { IPos hash_head; /* head of hash chain */ int bflush; /* set if current block must be flushed */ /* Process the input block. */ for (;;) { /* Make sure that we always have enough lookahead, except * at the end of the input file. We need MAX_MATCH bytes * for the next match, plus MIN_MATCH bytes to insert the * string following the next match. */ if (s->lookahead < MIN_LOOKAHEAD) { fill_window(s); if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { return need_more; } if (s->lookahead == 0) break; /* flush the current block */ } /* Insert the string window[strstart .. strstart + 2] in the * dictionary, and set hash_head to the head of the hash chain: */ hash_head = NIL; if (s->lookahead >= MIN_MATCH) { INSERT_STRING(s, s->strstart, hash_head); } /* Find the longest match, discarding those <= prev_length. */ s->prev_length = s->match_length, s->prev_match = s->match_start; s->match_length = MIN_MATCH-1; if (hash_head != NIL && s->prev_length < s->max_lazy_match && s->strstart - hash_head <= MAX_DIST(s)) { /* To simplify the code, we prevent matches with the string * of window index 0 (in particular we have to avoid a match * of the string with itself at the start of the input file). */ s->match_length = longest_match (s, hash_head); /* longest_match() sets match_start */ if (s->match_length <= 5 && (s->strategy == Z_FILTERED #if TOO_FAR <= 32767 || (s->match_length == MIN_MATCH && s->strstart - s->match_start > TOO_FAR) #endif )) { /* If prev_match is also MIN_MATCH, match_start is garbage * but we will ignore the current match anyway. */ s->match_length = MIN_MATCH-1; } } /* If there was a match at the previous step and the current * match is not better, output the previous match: */ if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) { uInt max_insert = s->strstart + s->lookahead - MIN_MATCH; /* Do not insert strings in hash table beyond this. */ check_match(s, s->strstart - 1, s->prev_match, s->prev_length); _tr_tally_dist(s, s->strstart - 1 - s->prev_match, s->prev_length - MIN_MATCH, bflush); /* Insert in hash table all strings up to the end of the match. * strstart - 1 and strstart are already inserted. If there is not * enough lookahead, the last two strings are not inserted in * the hash table. */ s->lookahead -= s->prev_length - 1; s->prev_length -= 2; do { if (++s->strstart <= max_insert) { INSERT_STRING(s, s->strstart, hash_head); } } while (--s->prev_length != 0); s->match_available = 0; s->match_length = MIN_MATCH-1; s->strstart++; if (bflush) FLUSH_BLOCK(s, 0); } else if (s->match_available) { /* If there was no match at the previous position, output a * single literal. If there was a match but the current match * is longer, truncate the previous match to a single literal. */ Tracevv((stderr,"%c", s->window[s->strstart - 1])); _tr_tally_lit(s, s->window[s->strstart - 1], bflush); if (bflush) { FLUSH_BLOCK_ONLY(s, 0); } s->strstart++; s->lookahead--; if (s->strm->avail_out == 0) return need_more; } else { /* There is no previous match to compare with, wait for * the next step to decide. */ s->match_available = 1; s->strstart++; s->lookahead--; } } Assert (flush != Z_NO_FLUSH, "no flush?"); if (s->match_available) { Tracevv((stderr,"%c", s->window[s->strstart - 1])); _tr_tally_lit(s, s->window[s->strstart - 1], bflush); s->match_available = 0; } s->insert = s->strstart < MIN_MATCH-1 ? s->strstart : MIN_MATCH-1; if (flush == Z_FINISH) { FLUSH_BLOCK(s, 1); return finish_done; } if (s->sym_next) FLUSH_BLOCK(s, 0); return block_done; } #endif /* FASTEST */ /* =========================================================================== * For Z_RLE, simply look for runs of bytes, generate matches only of distance * one. Do not maintain a hash table. (It will be regenerated if this run of * deflate switches away from Z_RLE.) */ local block_state deflate_rle(deflate_state *s, int flush) { int bflush; /* set if current block must be flushed */ uInt prev; /* byte at distance one to match */ Bytef *scan, *strend; /* scan goes up to strend for length of run */ for (;;) { /* Make sure that we always have enough lookahead, except * at the end of the input file. We need MAX_MATCH bytes * for the longest run, plus one for the unrolled loop. */ if (s->lookahead <= MAX_MATCH) { fill_window(s); if (s->lookahead <= MAX_MATCH && flush == Z_NO_FLUSH) { return need_more; } if (s->lookahead == 0) break; /* flush the current block */ } /* See how many times the previous byte repeats */ s->match_length = 0; if (s->lookahead >= MIN_MATCH && s->strstart > 0) { scan = s->window + s->strstart - 1; prev = *scan; if (prev == *++scan && prev == *++scan && prev == *++scan) { strend = s->window + s->strstart + MAX_MATCH; do { } while (prev == *++scan && prev == *++scan && prev == *++scan && prev == *++scan && prev == *++scan && prev == *++scan && prev == *++scan && prev == *++scan && scan < strend); s->match_length = MAX_MATCH - (uInt)(strend - scan); if (s->match_length > s->lookahead) s->match_length = s->lookahead; } Assert(scan <= s->window + (uInt)(s->window_size - 1), "wild scan"); } /* Emit match if have run of MIN_MATCH or longer, else emit literal */ if (s->match_length >= MIN_MATCH) { check_match(s, s->strstart, s->strstart - 1, s->match_length); _tr_tally_dist(s, 1, s->match_length - MIN_MATCH, bflush); s->lookahead -= s->match_length; s->strstart += s->match_length; s->match_length = 0; } else { /* No match, output a literal byte */ Tracevv((stderr,"%c", s->window[s->strstart])); _tr_tally_lit(s, s->window[s->strstart], bflush); s->lookahead--; s->strstart++; } if (bflush) FLUSH_BLOCK(s, 0); } s->insert = 0; if (flush == Z_FINISH) { FLUSH_BLOCK(s, 1); return finish_done; } if (s->sym_next) FLUSH_BLOCK(s, 0); return block_done; } /* =========================================================================== * For Z_HUFFMAN_ONLY, do not look for matches. Do not maintain a hash table. * (It will be regenerated if this run of deflate switches away from Huffman.) */ local block_state deflate_huff(deflate_state *s, int flush) { int bflush; /* set if current block must be flushed */ for (;;) { /* Make sure that we have a literal to write. */ if (s->lookahead == 0) { fill_window(s); if (s->lookahead == 0) { if (flush == Z_NO_FLUSH) return need_more; break; /* flush the current block */ } } /* Output a literal byte */ s->match_length = 0; Tracevv((stderr,"%c", s->window[s->strstart])); _tr_tally_lit(s, s->window[s->strstart], bflush); s->lookahead--; s->strstart++; if (bflush) FLUSH_BLOCK(s, 0); } s->insert = 0; if (flush == Z_FINISH) { FLUSH_BLOCK(s, 1); return finish_done; } if (s->sym_next) FLUSH_BLOCK(s, 0); return block_done; } tcl8.6.14/compat/zlib/zutil.h0000644000175000017500000001502514560736524015417 0ustar sergeisergei/* zutil.h -- internal interface and configuration of the compression library * Copyright (C) 1995-2024 Jean-loup Gailly, Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* WARNING: this file should *not* be used by applications. It is part of the implementation of the compression library and is subject to change. Applications should only use zlib.h. */ /* @(#) $Id$ */ #ifndef ZUTIL_H #define ZUTIL_H #ifdef HAVE_HIDDEN # define ZLIB_INTERNAL __attribute__((visibility ("hidden"))) #else # define ZLIB_INTERNAL #endif #include "zlib.h" #if defined(STDC) && !defined(Z_SOLO) # if !(defined(_WIN32_WCE) && defined(_MSC_VER)) # include # endif # include # include #endif #ifndef local # define local static #endif /* since "static" is used to mean two completely different things in C, we define "local" for the non-static meaning of "static", for readability (compile with -Dlocal if your debugger can't find static symbols) */ typedef unsigned char uch; typedef uch FAR uchf; typedef unsigned short ush; typedef ush FAR ushf; typedef unsigned long ulg; #if !defined(Z_U8) && !defined(Z_SOLO) && defined(STDC) # include # if (ULONG_MAX == 0xffffffffffffffff) # define Z_U8 unsigned long # elif (ULLONG_MAX == 0xffffffffffffffff) # define Z_U8 unsigned long long # elif (UINT_MAX == 0xffffffffffffffff) # define Z_U8 unsigned # endif #endif extern z_const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ /* (size given to avoid silly warnings with Visual C++) */ #define ERR_MSG(err) z_errmsg[(err) < -6 || (err) > 2 ? 9 : 2 - (err)] #define ERR_RETURN(strm,err) \ return (strm->msg = ERR_MSG(err), (err)) /* To be used only when the state is known to be valid */ /* common constants */ #ifndef DEF_WBITS # define DEF_WBITS MAX_WBITS #endif /* default windowBits for decompression. MAX_WBITS is for compression only */ #if MAX_MEM_LEVEL >= 8 # define DEF_MEM_LEVEL 8 #else # define DEF_MEM_LEVEL MAX_MEM_LEVEL #endif /* default memLevel */ #define STORED_BLOCK 0 #define STATIC_TREES 1 #define DYN_TREES 2 /* The three kinds of block type */ #define MIN_MATCH 3 #define MAX_MATCH 258 /* The minimum and maximum match lengths */ #define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */ /* target dependencies */ #if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32)) # define OS_CODE 0x00 # ifndef Z_SOLO # if defined(__TURBOC__) || defined(__BORLANDC__) # if (__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__)) /* Allow compilation with ANSI keywords only enabled */ void _Cdecl farfree( void *block ); void *_Cdecl farmalloc( unsigned long nbytes ); # else # include # endif # else /* MSC or DJGPP */ # include # endif # endif #endif #ifdef AMIGA # define OS_CODE 1 #endif #if defined(VAXC) || defined(VMS) # define OS_CODE 2 # define F_OPEN(name, mode) \ fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512") #endif #ifdef __370__ # if __TARGET_LIB__ < 0x20000000 # define OS_CODE 4 # elif __TARGET_LIB__ < 0x40000000 # define OS_CODE 11 # else # define OS_CODE 8 # endif #endif #if defined(ATARI) || defined(atarist) # define OS_CODE 5 #endif #ifdef OS2 # define OS_CODE 6 # if defined(M_I86) && !defined(Z_SOLO) # include # endif #endif #if defined(MACOS) # define OS_CODE 7 #endif #ifdef __acorn # define OS_CODE 13 #endif #if defined(WIN32) && !defined(__CYGWIN__) # define OS_CODE 10 #endif #ifdef _BEOS_ # define OS_CODE 16 #endif #ifdef __TOS_OS400__ # define OS_CODE 18 #endif #ifdef __APPLE__ # define OS_CODE 19 #endif #if defined(__BORLANDC__) && !defined(MSDOS) #pragma warn -8004 #pragma warn -8008 #pragma warn -8066 #endif /* provide prototypes for these when building zlib without LFS */ #if !defined(_WIN32) && \ (!defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0) ZEXTERN uLong ZEXPORT adler32_combine64(uLong, uLong, z_off_t); ZEXTERN uLong ZEXPORT crc32_combine64(uLong, uLong, z_off_t); ZEXTERN uLong ZEXPORT crc32_combine_gen64(z_off_t); #endif /* common defaults */ #ifndef OS_CODE # define OS_CODE 3 /* assume Unix */ #endif #ifndef F_OPEN # define F_OPEN(name, mode) fopen((name), (mode)) #endif /* functions */ #if defined(pyr) || defined(Z_SOLO) # define NO_MEMCPY #endif #if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__) /* Use our own functions for small and medium model with MSC <= 5.0. * You may have to use the same strategy for Borland C (untested). * The __SC__ check is for Symantec. */ # define NO_MEMCPY #endif #if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY) # define HAVE_MEMCPY #endif #ifdef HAVE_MEMCPY # ifdef SMALL_MEDIUM /* MSDOS small or medium model */ # define zmemcpy _fmemcpy # define zmemcmp _fmemcmp # define zmemzero(dest, len) _fmemset(dest, 0, len) # else # define zmemcpy memcpy # define zmemcmp memcmp # define zmemzero(dest, len) memset(dest, 0, len) # endif #else void ZLIB_INTERNAL zmemcpy(Bytef* dest, const Bytef* source, uInt len); int ZLIB_INTERNAL zmemcmp(const Bytef* s1, const Bytef* s2, uInt len); void ZLIB_INTERNAL zmemzero(Bytef* dest, uInt len); #endif /* Diagnostic functions */ #ifdef ZLIB_DEBUG # include extern int ZLIB_INTERNAL z_verbose; extern void ZLIB_INTERNAL z_error(char *m); # define Assert(cond,msg) {if(!(cond)) z_error(msg);} # define Trace(x) {if (z_verbose>=0) fprintf x ;} # define Tracev(x) {if (z_verbose>0) fprintf x ;} # define Tracevv(x) {if (z_verbose>1) fprintf x ;} # define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;} # define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;} #else # define Assert(cond,msg) # define Trace(x) # define Tracev(x) # define Tracevv(x) # define Tracec(c,x) # define Tracecv(c,x) #endif #ifndef Z_SOLO voidpf ZLIB_INTERNAL zcalloc(voidpf opaque, unsigned items, unsigned size); void ZLIB_INTERNAL zcfree(voidpf opaque, voidpf ptr); #endif #define ZALLOC(strm, items, size) \ (*((strm)->zalloc))((strm)->opaque, (items), (size)) #define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr)) #define TRY_FREE(s, p) {if (p) ZFREE(s, p);} /* Reverse the bytes in a 32-bit value */ #define ZSWAP32(q) ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \ (((q) & 0xff00) << 8) + (((q) & 0xff) << 24)) #endif /* ZUTIL_H */ tcl8.6.14/compat/zlib/test/0000755000175000017500000000000014566153412015046 5ustar sergeisergeitcl8.6.14/compat/zlib/test/minigzip.c0000644000175000017500000003503214560736524017050 0ustar sergeisergei/* minigzip.c -- simulate gzip using the zlib compression library * Copyright (C) 1995-2006, 2010, 2011, 2016 Jean-loup Gailly * For conditions of distribution and use, see copyright notice in zlib.h */ /* * minigzip is a minimal implementation of the gzip utility. This is * only an example of using zlib and isn't meant to replace the * full-featured gzip. No attempt is made to deal with file systems * limiting names to 14 or 8+3 characters, etc... Error checking is * very limited. So use minigzip only for testing; use gzip for the * real thing. On MSDOS, use only on file names without extension * or in pipe mode. */ /* @(#) $Id$ */ #include "zlib.h" #include #ifdef STDC # include # include #endif #ifdef USE_MMAP # include # include # include #endif #if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__) # include # include # ifdef UNDER_CE # include # endif # define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY) #else # define SET_BINARY_MODE(file) #endif #if defined(_MSC_VER) && _MSC_VER < 1900 # define snprintf _snprintf #endif #ifdef VMS # define unlink delete # define GZ_SUFFIX "-gz" #endif #ifdef RISCOS # define unlink remove # define GZ_SUFFIX "-gz" # define fileno(file) file->__file #endif #if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os # include /* for fileno */ #endif #if !defined(Z_HAVE_UNISTD_H) && !defined(_LARGEFILE64_SOURCE) #ifndef WIN32 /* unlink already in stdio.h for WIN32 */ extern int unlink(const char *); #endif #endif #if defined(UNDER_CE) # include # define perror(s) pwinerror(s) /* Map the Windows error number in ERROR to a locale-dependent error message string and return a pointer to it. Typically, the values for ERROR come from GetLastError. The string pointed to shall not be modified by the application, but may be overwritten by a subsequent call to strwinerror The strwinerror function does not change the current setting of GetLastError. */ static char *strwinerror (error) DWORD error; { static char buf[1024]; wchar_t *msgbuf; DWORD lasterr = GetLastError(); DWORD chars = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, 0, /* Default language */ (LPVOID)&msgbuf, 0, NULL); if (chars != 0) { /* If there is an \r\n appended, zap it. */ if (chars >= 2 && msgbuf[chars - 2] == '\r' && msgbuf[chars - 1] == '\n') { chars -= 2; msgbuf[chars] = 0; } if (chars > sizeof (buf) - 1) { chars = sizeof (buf) - 1; msgbuf[chars] = 0; } wcstombs(buf, msgbuf, chars + 1); LocalFree(msgbuf); } else { sprintf(buf, "unknown win32 error (%ld)", error); } SetLastError(lasterr); return buf; } static void pwinerror (s) const char *s; { if (s && *s) fprintf(stderr, "%s: %s\n", s, strwinerror(GetLastError ())); else fprintf(stderr, "%s\n", strwinerror(GetLastError ())); } #endif /* UNDER_CE */ #ifndef GZ_SUFFIX # define GZ_SUFFIX ".gz" #endif #define SUFFIX_LEN (sizeof(GZ_SUFFIX)-1) #define BUFLEN 16384 #define MAX_NAME_LEN 1024 #ifdef MAXSEG_64K # define local static /* Needed for systems with limitation on stack size. */ #else # define local #endif #ifdef Z_SOLO /* for Z_SOLO, create simplified gz* functions using deflate and inflate */ #if defined(Z_HAVE_UNISTD_H) || defined(Z_LARGE) # include /* for unlink() */ #endif static void *myalloc(void *q, unsigned n, unsigned m) { (void)q; return calloc(n, m); } static void myfree(void *q, void *p) { (void)q; free(p); } typedef struct gzFile_s { FILE *file; int write; int err; char *msg; z_stream strm; } *gzFile; static gzFile gz_open(const char *path, int fd, const char *mode) { gzFile gz; int ret; gz = malloc(sizeof(struct gzFile_s)); if (gz == NULL) return NULL; gz->write = strchr(mode, 'w') != NULL; gz->strm.zalloc = myalloc; gz->strm.zfree = myfree; gz->strm.opaque = Z_NULL; if (gz->write) ret = deflateInit2(&(gz->strm), -1, 8, 15 + 16, 8, 0); else { gz->strm.next_in = 0; gz->strm.avail_in = Z_NULL; ret = inflateInit2(&(gz->strm), 15 + 16); } if (ret != Z_OK) { free(gz); return NULL; } gz->file = path == NULL ? fdopen(fd, gz->write ? "wb" : "rb") : fopen(path, gz->write ? "wb" : "rb"); if (gz->file == NULL) { gz->write ? deflateEnd(&(gz->strm)) : inflateEnd(&(gz->strm)); free(gz); return NULL; } gz->err = 0; gz->msg = ""; return gz; } static gzFile gzopen(const char *path, const char *mode) { return gz_open(path, -1, mode); } static gzFile gzdopen(int fd, const char *mode) { return gz_open(NULL, fd, mode); } static int gzwrite(gzFile gz, const void *buf, unsigned len) { z_stream *strm; unsigned char out[BUFLEN]; if (gz == NULL || !gz->write) return 0; strm = &(gz->strm); strm->next_in = (void *)buf; strm->avail_in = len; do { strm->next_out = out; strm->avail_out = BUFLEN; (void)deflate(strm, Z_NO_FLUSH); fwrite(out, 1, BUFLEN - strm->avail_out, gz->file); } while (strm->avail_out == 0); return len; } static int gzread(gzFile gz, void *buf, unsigned len) { int ret; unsigned got; unsigned char in[1]; z_stream *strm; if (gz == NULL || gz->write) return 0; if (gz->err) return 0; strm = &(gz->strm); strm->next_out = (void *)buf; strm->avail_out = len; do { got = fread(in, 1, 1, gz->file); if (got == 0) break; strm->next_in = in; strm->avail_in = 1; ret = inflate(strm, Z_NO_FLUSH); if (ret == Z_DATA_ERROR) { gz->err = Z_DATA_ERROR; gz->msg = strm->msg; return 0; } if (ret == Z_STREAM_END) inflateReset(strm); } while (strm->avail_out); return len - strm->avail_out; } static int gzclose(gzFile gz) { z_stream *strm; unsigned char out[BUFLEN]; if (gz == NULL) return Z_STREAM_ERROR; strm = &(gz->strm); if (gz->write) { strm->next_in = Z_NULL; strm->avail_in = 0; do { strm->next_out = out; strm->avail_out = BUFLEN; (void)deflate(strm, Z_FINISH); fwrite(out, 1, BUFLEN - strm->avail_out, gz->file); } while (strm->avail_out == 0); deflateEnd(strm); } else inflateEnd(strm); fclose(gz->file); free(gz); return Z_OK; } static const char *gzerror(gzFile gz, int *err) { *err = gz->err; return gz->msg; } #endif static char *prog; /* =========================================================================== * Display error message and exit */ static void error(const char *msg) { fprintf(stderr, "%s: %s\n", prog, msg); exit(1); } #ifdef USE_MMAP /* MMAP version, Miguel Albrecht */ /* Try compressing the input file at once using mmap. Return Z_OK if * success, Z_ERRNO otherwise. */ static int gz_compress_mmap(FILE *in, gzFile out) { int len; int err; int ifd = fileno(in); caddr_t buf; /* mmap'ed buffer for the entire input file */ off_t buf_len; /* length of the input file */ struct stat sb; /* Determine the size of the file, needed for mmap: */ if (fstat(ifd, &sb) < 0) return Z_ERRNO; buf_len = sb.st_size; if (buf_len <= 0) return Z_ERRNO; /* Now do the actual mmap: */ buf = mmap((caddr_t) 0, buf_len, PROT_READ, MAP_SHARED, ifd, (off_t)0); if (buf == (caddr_t)(-1)) return Z_ERRNO; /* Compress the whole file at once: */ len = gzwrite(out, (char *)buf, (unsigned)buf_len); if (len != (int)buf_len) error(gzerror(out, &err)); munmap(buf, buf_len); fclose(in); if (gzclose(out) != Z_OK) error("failed gzclose"); return Z_OK; } #endif /* USE_MMAP */ /* =========================================================================== * Compress input to output then close both files. */ static void gz_compress(FILE *in, gzFile out) { local char buf[BUFLEN]; int len; int err; #ifdef USE_MMAP /* Try first compressing with mmap. If mmap fails (minigzip used in a * pipe), use the normal fread loop. */ if (gz_compress_mmap(in, out) == Z_OK) return; #endif for (;;) { len = (int)fread(buf, 1, sizeof(buf), in); if (ferror(in)) { perror("fread"); exit(1); } if (len == 0) break; if (gzwrite(out, buf, (unsigned)len) != len) error(gzerror(out, &err)); } fclose(in); if (gzclose(out) != Z_OK) error("failed gzclose"); } /* =========================================================================== * Uncompress input to output then close both files. */ static void gz_uncompress(gzFile in, FILE *out) { local char buf[BUFLEN]; int len; int err; for (;;) { len = gzread(in, buf, sizeof(buf)); if (len < 0) error (gzerror(in, &err)); if (len == 0) break; if ((int)fwrite(buf, 1, (unsigned)len, out) != len) { error("failed fwrite"); } } if (fclose(out)) error("failed fclose"); if (gzclose(in) != Z_OK) error("failed gzclose"); } /* =========================================================================== * Compress the given file: create a corresponding .gz file and remove the * original. */ static void file_compress(char *file, char *mode) { local char outfile[MAX_NAME_LEN]; FILE *in; gzFile out; if (strlen(file) + strlen(GZ_SUFFIX) >= sizeof(outfile)) { fprintf(stderr, "%s: filename too long\n", prog); exit(1); } #if !defined(NO_snprintf) && !defined(NO_vsnprintf) snprintf(outfile, sizeof(outfile), "%s%s", file, GZ_SUFFIX); #else strcpy(outfile, file); strcat(outfile, GZ_SUFFIX); #endif in = fopen(file, "rb"); if (in == NULL) { perror(file); exit(1); } out = gzopen(outfile, mode); if (out == NULL) { fprintf(stderr, "%s: can't gzopen %s\n", prog, outfile); exit(1); } gz_compress(in, out); unlink(file); } /* =========================================================================== * Uncompress the given file and remove the original. */ static void file_uncompress(char *file) { local char buf[MAX_NAME_LEN]; char *infile, *outfile; FILE *out; gzFile in; z_size_t len = strlen(file); if (len + strlen(GZ_SUFFIX) >= sizeof(buf)) { fprintf(stderr, "%s: filename too long\n", prog); exit(1); } #if !defined(NO_snprintf) && !defined(NO_vsnprintf) snprintf(buf, sizeof(buf), "%s", file); #else strcpy(buf, file); #endif if (len > SUFFIX_LEN && strcmp(file+len-SUFFIX_LEN, GZ_SUFFIX) == 0) { infile = file; outfile = buf; outfile[len-3] = '\0'; } else { outfile = file; infile = buf; #if !defined(NO_snprintf) && !defined(NO_vsnprintf) snprintf(buf + len, sizeof(buf) - len, "%s", GZ_SUFFIX); #else strcat(infile, GZ_SUFFIX); #endif } in = gzopen(infile, "rb"); if (in == NULL) { fprintf(stderr, "%s: can't gzopen %s\n", prog, infile); exit(1); } out = fopen(outfile, "wb"); if (out == NULL) { perror(file); exit(1); } gz_uncompress(in, out); unlink(infile); } /* =========================================================================== * Usage: minigzip [-c] [-d] [-f] [-h] [-r] [-1 to -9] [files...] * -c : write to standard output * -d : decompress * -f : compress with Z_FILTERED * -h : compress with Z_HUFFMAN_ONLY * -r : compress with Z_RLE * -1 to -9 : compression level */ int main(int argc, char *argv[]) { int copyout = 0; int uncompr = 0; gzFile file; char *bname, outmode[20]; #if !defined(NO_snprintf) && !defined(NO_vsnprintf) snprintf(outmode, sizeof(outmode), "%s", "wb6 "); #else strcpy(outmode, "wb6 "); #endif prog = argv[0]; bname = strrchr(argv[0], '/'); if (bname) bname++; else bname = argv[0]; argc--, argv++; if (!strcmp(bname, "gunzip")) uncompr = 1; else if (!strcmp(bname, "zcat")) copyout = uncompr = 1; while (argc > 0) { if (strcmp(*argv, "-c") == 0) copyout = 1; else if (strcmp(*argv, "-d") == 0) uncompr = 1; else if (strcmp(*argv, "-f") == 0) outmode[3] = 'f'; else if (strcmp(*argv, "-h") == 0) outmode[3] = 'h'; else if (strcmp(*argv, "-r") == 0) outmode[3] = 'R'; else if ((*argv)[0] == '-' && (*argv)[1] >= '1' && (*argv)[1] <= '9' && (*argv)[2] == 0) outmode[2] = (*argv)[1]; else break; argc--, argv++; } if (outmode[3] == ' ') outmode[3] = 0; if (argc == 0) { SET_BINARY_MODE(stdin); SET_BINARY_MODE(stdout); if (uncompr) { file = gzdopen(fileno(stdin), "rb"); if (file == NULL) error("can't gzdopen stdin"); gz_uncompress(file, stdout); } else { file = gzdopen(fileno(stdout), outmode); if (file == NULL) error("can't gzdopen stdout"); gz_compress(stdin, file); } } else { if (copyout) { SET_BINARY_MODE(stdout); } do { if (uncompr) { if (copyout) { file = gzopen(*argv, "rb"); if (file == NULL) fprintf(stderr, "%s: can't gzopen %s\n", prog, *argv); else gz_uncompress(file, stdout); } else { file_uncompress(*argv); } } else { if (copyout) { FILE * in = fopen(*argv, "rb"); if (in == NULL) { perror(*argv); } else { file = gzdopen(fileno(stdout), outmode); if (file == NULL) error("can't gzdopen stdout"); gz_compress(in, file); } } else { file_compress(*argv, outmode); } } } while (argv++, --argc); } return 0; } tcl8.6.14/compat/zlib/test/example.c0000644000175000017500000003627314560736524016665 0ustar sergeisergei/* example.c -- usage example of the zlib compression library * Copyright (C) 1995-2006, 2011, 2016 Jean-loup Gailly * For conditions of distribution and use, see copyright notice in zlib.h */ /* @(#) $Id$ */ #include "zlib.h" #include #ifdef STDC # include # include #endif #if defined(VMS) || defined(RISCOS) # define TESTFILE "foo-gz" #else # define TESTFILE "foo.gz" #endif #define CHECK_ERR(err, msg) { \ if (err != Z_OK) { \ fprintf(stderr, "%s error: %d\n", msg, err); \ exit(1); \ } \ } static z_const char hello[] = "hello, hello!"; /* "hello world" would be more standard, but the repeated "hello" * stresses the compression code better, sorry... */ static const char dictionary[] = "hello"; static uLong dictId; /* Adler32 value of the dictionary */ #ifdef Z_SOLO static void *myalloc(void *q, unsigned n, unsigned m) { (void)q; return calloc(n, m); } static void myfree(void *q, void *p) { (void)q; free(p); } static alloc_func zalloc = myalloc; static free_func zfree = myfree; #else /* !Z_SOLO */ static alloc_func zalloc = (alloc_func)0; static free_func zfree = (free_func)0; /* =========================================================================== * Test compress() and uncompress() */ static void test_compress(Byte *compr, uLong comprLen, Byte *uncompr, uLong uncomprLen) { int err; uLong len = (uLong)strlen(hello)+1; err = compress(compr, &comprLen, (const Bytef*)hello, len); CHECK_ERR(err, "compress"); strcpy((char*)uncompr, "garbage"); err = uncompress(uncompr, &uncomprLen, compr, comprLen); CHECK_ERR(err, "uncompress"); if (strcmp((char*)uncompr, hello)) { fprintf(stderr, "bad uncompress\n"); exit(1); } else { printf("uncompress(): %s\n", (char *)uncompr); } } /* =========================================================================== * Test read/write of .gz files */ static void test_gzio(const char *fname, Byte *uncompr, uLong uncomprLen) { #ifdef NO_GZCOMPRESS fprintf(stderr, "NO_GZCOMPRESS -- gz* functions cannot compress\n"); #else int err; int len = (int)strlen(hello)+1; gzFile file; z_off_t pos; file = gzopen(fname, "wb"); if (file == NULL) { fprintf(stderr, "gzopen error\n"); exit(1); } gzputc(file, 'h'); if (gzputs(file, "ello") != 4) { fprintf(stderr, "gzputs err: %s\n", gzerror(file, &err)); exit(1); } if (gzprintf(file, ", %s!", "hello") != 8) { fprintf(stderr, "gzprintf err: %s\n", gzerror(file, &err)); exit(1); } gzseek(file, 1L, SEEK_CUR); /* add one zero byte */ gzclose(file); file = gzopen(fname, "rb"); if (file == NULL) { fprintf(stderr, "gzopen error\n"); exit(1); } strcpy((char*)uncompr, "garbage"); if (gzread(file, uncompr, (unsigned)uncomprLen) != len) { fprintf(stderr, "gzread err: %s\n", gzerror(file, &err)); exit(1); } if (strcmp((char*)uncompr, hello)) { fprintf(stderr, "bad gzread: %s\n", (char*)uncompr); exit(1); } else { printf("gzread(): %s\n", (char*)uncompr); } pos = gzseek(file, -8L, SEEK_CUR); if (pos != 6 || gztell(file) != pos) { fprintf(stderr, "gzseek error, pos=%ld, gztell=%ld\n", (long)pos, (long)gztell(file)); exit(1); } if (gzgetc(file) != ' ') { fprintf(stderr, "gzgetc error\n"); exit(1); } if (gzungetc(' ', file) != ' ') { fprintf(stderr, "gzungetc error\n"); exit(1); } gzgets(file, (char*)uncompr, (int)uncomprLen); if (strlen((char*)uncompr) != 7) { /* " hello!" */ fprintf(stderr, "gzgets err after gzseek: %s\n", gzerror(file, &err)); exit(1); } if (strcmp((char*)uncompr, hello + 6)) { fprintf(stderr, "bad gzgets after gzseek\n"); exit(1); } else { printf("gzgets() after gzseek: %s\n", (char*)uncompr); } gzclose(file); #endif } #endif /* Z_SOLO */ /* =========================================================================== * Test deflate() with small buffers */ static void test_deflate(Byte *compr, uLong comprLen) { z_stream c_stream; /* compression stream */ int err; uLong len = (uLong)strlen(hello)+1; c_stream.zalloc = zalloc; c_stream.zfree = zfree; c_stream.opaque = (voidpf)0; err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION); CHECK_ERR(err, "deflateInit"); c_stream.next_in = (z_const unsigned char *)hello; c_stream.next_out = compr; while (c_stream.total_in != len && c_stream.total_out < comprLen) { c_stream.avail_in = c_stream.avail_out = 1; /* force small buffers */ err = deflate(&c_stream, Z_NO_FLUSH); CHECK_ERR(err, "deflate"); } /* Finish the stream, still forcing small buffers: */ for (;;) { c_stream.avail_out = 1; err = deflate(&c_stream, Z_FINISH); if (err == Z_STREAM_END) break; CHECK_ERR(err, "deflate"); } err = deflateEnd(&c_stream); CHECK_ERR(err, "deflateEnd"); } /* =========================================================================== * Test inflate() with small buffers */ static void test_inflate(Byte *compr, uLong comprLen, Byte *uncompr, uLong uncomprLen) { int err; z_stream d_stream; /* decompression stream */ strcpy((char*)uncompr, "garbage"); d_stream.zalloc = zalloc; d_stream.zfree = zfree; d_stream.opaque = (voidpf)0; d_stream.next_in = compr; d_stream.avail_in = 0; d_stream.next_out = uncompr; err = inflateInit(&d_stream); CHECK_ERR(err, "inflateInit"); while (d_stream.total_out < uncomprLen && d_stream.total_in < comprLen) { d_stream.avail_in = d_stream.avail_out = 1; /* force small buffers */ err = inflate(&d_stream, Z_NO_FLUSH); if (err == Z_STREAM_END) break; CHECK_ERR(err, "inflate"); } err = inflateEnd(&d_stream); CHECK_ERR(err, "inflateEnd"); if (strcmp((char*)uncompr, hello)) { fprintf(stderr, "bad inflate\n"); exit(1); } else { printf("inflate(): %s\n", (char *)uncompr); } } /* =========================================================================== * Test deflate() with large buffers and dynamic change of compression level */ static void test_large_deflate(Byte *compr, uLong comprLen, Byte *uncompr, uLong uncomprLen) { z_stream c_stream; /* compression stream */ int err; c_stream.zalloc = zalloc; c_stream.zfree = zfree; c_stream.opaque = (voidpf)0; err = deflateInit(&c_stream, Z_BEST_SPEED); CHECK_ERR(err, "deflateInit"); c_stream.next_out = compr; c_stream.avail_out = (uInt)comprLen; /* At this point, uncompr is still mostly zeroes, so it should compress * very well: */ c_stream.next_in = uncompr; c_stream.avail_in = (uInt)uncomprLen; err = deflate(&c_stream, Z_NO_FLUSH); CHECK_ERR(err, "deflate"); if (c_stream.avail_in != 0) { fprintf(stderr, "deflate not greedy\n"); exit(1); } /* Feed in already compressed data and switch to no compression: */ deflateParams(&c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY); c_stream.next_in = compr; c_stream.avail_in = (uInt)uncomprLen/2; err = deflate(&c_stream, Z_NO_FLUSH); CHECK_ERR(err, "deflate"); /* Switch back to compressing mode: */ deflateParams(&c_stream, Z_BEST_COMPRESSION, Z_FILTERED); c_stream.next_in = uncompr; c_stream.avail_in = (uInt)uncomprLen; err = deflate(&c_stream, Z_NO_FLUSH); CHECK_ERR(err, "deflate"); err = deflate(&c_stream, Z_FINISH); if (err != Z_STREAM_END) { fprintf(stderr, "deflate should report Z_STREAM_END\n"); exit(1); } err = deflateEnd(&c_stream); CHECK_ERR(err, "deflateEnd"); } /* =========================================================================== * Test inflate() with large buffers */ static void test_large_inflate(Byte *compr, uLong comprLen, Byte *uncompr, uLong uncomprLen) { int err; z_stream d_stream; /* decompression stream */ strcpy((char*)uncompr, "garbage"); d_stream.zalloc = zalloc; d_stream.zfree = zfree; d_stream.opaque = (voidpf)0; d_stream.next_in = compr; d_stream.avail_in = (uInt)comprLen; err = inflateInit(&d_stream); CHECK_ERR(err, "inflateInit"); for (;;) { d_stream.next_out = uncompr; /* discard the output */ d_stream.avail_out = (uInt)uncomprLen; err = inflate(&d_stream, Z_NO_FLUSH); if (err == Z_STREAM_END) break; CHECK_ERR(err, "large inflate"); } err = inflateEnd(&d_stream); CHECK_ERR(err, "inflateEnd"); if (d_stream.total_out != 2*uncomprLen + uncomprLen/2) { fprintf(stderr, "bad large inflate: %ld\n", d_stream.total_out); exit(1); } else { printf("large_inflate(): OK\n"); } } /* =========================================================================== * Test deflate() with full flush */ static void test_flush(Byte *compr, uLong *comprLen) { z_stream c_stream; /* compression stream */ int err; uInt len = (uInt)strlen(hello)+1; c_stream.zalloc = zalloc; c_stream.zfree = zfree; c_stream.opaque = (voidpf)0; err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION); CHECK_ERR(err, "deflateInit"); c_stream.next_in = (z_const unsigned char *)hello; c_stream.next_out = compr; c_stream.avail_in = 3; c_stream.avail_out = (uInt)*comprLen; err = deflate(&c_stream, Z_FULL_FLUSH); CHECK_ERR(err, "deflate"); compr[3]++; /* force an error in first compressed block */ c_stream.avail_in = len - 3; err = deflate(&c_stream, Z_FINISH); if (err != Z_STREAM_END) { CHECK_ERR(err, "deflate"); } err = deflateEnd(&c_stream); CHECK_ERR(err, "deflateEnd"); *comprLen = c_stream.total_out; } /* =========================================================================== * Test inflateSync() */ static void test_sync(Byte *compr, uLong comprLen, Byte *uncompr, uLong uncomprLen) { int err; z_stream d_stream; /* decompression stream */ strcpy((char*)uncompr, "garbage"); d_stream.zalloc = zalloc; d_stream.zfree = zfree; d_stream.opaque = (voidpf)0; d_stream.next_in = compr; d_stream.avail_in = 2; /* just read the zlib header */ err = inflateInit(&d_stream); CHECK_ERR(err, "inflateInit"); d_stream.next_out = uncompr; d_stream.avail_out = (uInt)uncomprLen; err = inflate(&d_stream, Z_NO_FLUSH); CHECK_ERR(err, "inflate"); d_stream.avail_in = (uInt)comprLen-2; /* read all compressed data */ err = inflateSync(&d_stream); /* but skip the damaged part */ CHECK_ERR(err, "inflateSync"); err = inflate(&d_stream, Z_FINISH); if (err != Z_STREAM_END) { fprintf(stderr, "inflate should report Z_STREAM_END\n"); exit(1); } err = inflateEnd(&d_stream); CHECK_ERR(err, "inflateEnd"); printf("after inflateSync(): hel%s\n", (char *)uncompr); } /* =========================================================================== * Test deflate() with preset dictionary */ static void test_dict_deflate(Byte *compr, uLong comprLen) { z_stream c_stream; /* compression stream */ int err; c_stream.zalloc = zalloc; c_stream.zfree = zfree; c_stream.opaque = (voidpf)0; err = deflateInit(&c_stream, Z_BEST_COMPRESSION); CHECK_ERR(err, "deflateInit"); err = deflateSetDictionary(&c_stream, (const Bytef*)dictionary, (int)sizeof(dictionary)); CHECK_ERR(err, "deflateSetDictionary"); dictId = c_stream.adler; c_stream.next_out = compr; c_stream.avail_out = (uInt)comprLen; c_stream.next_in = (z_const unsigned char *)hello; c_stream.avail_in = (uInt)strlen(hello)+1; err = deflate(&c_stream, Z_FINISH); if (err != Z_STREAM_END) { fprintf(stderr, "deflate should report Z_STREAM_END\n"); exit(1); } err = deflateEnd(&c_stream); CHECK_ERR(err, "deflateEnd"); } /* =========================================================================== * Test inflate() with a preset dictionary */ static void test_dict_inflate(Byte *compr, uLong comprLen, Byte *uncompr, uLong uncomprLen) { int err; z_stream d_stream; /* decompression stream */ strcpy((char*)uncompr, "garbage"); d_stream.zalloc = zalloc; d_stream.zfree = zfree; d_stream.opaque = (voidpf)0; d_stream.next_in = compr; d_stream.avail_in = (uInt)comprLen; err = inflateInit(&d_stream); CHECK_ERR(err, "inflateInit"); d_stream.next_out = uncompr; d_stream.avail_out = (uInt)uncomprLen; for (;;) { err = inflate(&d_stream, Z_NO_FLUSH); if (err == Z_STREAM_END) break; if (err == Z_NEED_DICT) { if (d_stream.adler != dictId) { fprintf(stderr, "unexpected dictionary"); exit(1); } err = inflateSetDictionary(&d_stream, (const Bytef*)dictionary, (int)sizeof(dictionary)); } CHECK_ERR(err, "inflate with dict"); } err = inflateEnd(&d_stream); CHECK_ERR(err, "inflateEnd"); if (strcmp((char*)uncompr, hello)) { fprintf(stderr, "bad inflate with dict\n"); exit(1); } else { printf("inflate with dictionary: %s\n", (char *)uncompr); } } /* =========================================================================== * Usage: example [output.gz [input.gz]] */ int main(int argc, char *argv[]) { Byte *compr, *uncompr; uLong uncomprLen = 20000; uLong comprLen = 3 * uncomprLen; static const char* myVersion = ZLIB_VERSION; if (zlibVersion()[0] != myVersion[0]) { fprintf(stderr, "incompatible zlib version\n"); exit(1); } else if (strcmp(zlibVersion(), ZLIB_VERSION) != 0) { fprintf(stderr, "warning: different zlib version linked: %s\n", zlibVersion()); } printf("zlib version %s = 0x%04x, compile flags = 0x%lx\n", ZLIB_VERSION, ZLIB_VERNUM, zlibCompileFlags()); compr = (Byte*)calloc((uInt)comprLen, 1); uncompr = (Byte*)calloc((uInt)uncomprLen, 1); /* compr and uncompr are cleared to avoid reading uninitialized * data and to ensure that uncompr compresses well. */ if (compr == Z_NULL || uncompr == Z_NULL) { printf("out of memory\n"); exit(1); } #ifdef Z_SOLO (void)argc; (void)argv; #else test_compress(compr, comprLen, uncompr, uncomprLen); test_gzio((argc > 1 ? argv[1] : TESTFILE), uncompr, uncomprLen); #endif test_deflate(compr, comprLen); test_inflate(compr, comprLen, uncompr, uncomprLen); test_large_deflate(compr, comprLen, uncompr, uncomprLen); test_large_inflate(compr, comprLen, uncompr, uncomprLen); test_flush(compr, &comprLen); test_sync(compr, comprLen, uncompr, uncomprLen); comprLen = 3 * uncomprLen; test_dict_deflate(compr, comprLen); test_dict_inflate(compr, comprLen, uncompr, uncomprLen); free(compr); free(uncompr); return 0; } tcl8.6.14/compat/zlib/test/infcover.c0000644000175000017500000006022414554262142017027 0ustar sergeisergei/* infcover.c -- test zlib's inflate routines with full code coverage * Copyright (C) 2011, 2016 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* to use, do: ./configure --cover && make cover */ #include #include #include #include #include "zlib.h" /* get definition of internal structure so we can mess with it (see pull()), and so we can call inflate_trees() (see cover5()) */ #define ZLIB_INTERNAL #include "inftrees.h" #include "inflate.h" #define local static /* -- memory tracking routines -- */ /* These memory tracking routines are provided to zlib and track all of zlib's allocations and deallocations, check for LIFO operations, keep a current and high water mark of total bytes requested, optionally set a limit on the total memory that can be allocated, and when done check for memory leaks. They are used as follows: z_stream strm; mem_setup(&strm) initializes the memory tracking and sets the zalloc, zfree, and opaque members of strm to use memory tracking for all zlib operations on strm mem_limit(&strm, limit) sets a limit on the total bytes requested -- a request that exceeds this limit will result in an allocation failure (returns NULL) -- setting the limit to zero means no limit, which is the default after mem_setup() mem_used(&strm, "msg") prints to stderr "msg" and the total bytes used mem_high(&strm, "msg") prints to stderr "msg" and the high water mark mem_done(&strm, "msg") ends memory tracking, releases all allocations for the tracking as well as leaked zlib blocks, if any. If there was anything unusual, such as leaked blocks, non-FIFO frees, or frees of addresses not allocated, then "msg" and information about the problem is printed to stderr. If everything is normal, nothing is printed. mem_done resets the strm members to Z_NULL to use the default memory allocation routines on the next zlib initialization using strm. */ /* these items are strung together in a linked list, one for each allocation */ struct mem_item { void *ptr; /* pointer to allocated memory */ size_t size; /* requested size of allocation */ struct mem_item *next; /* pointer to next item in list, or NULL */ }; /* this structure is at the root of the linked list, and tracks statistics */ struct mem_zone { struct mem_item *first; /* pointer to first item in list, or NULL */ size_t total, highwater; /* total allocations, and largest total */ size_t limit; /* memory allocation limit, or 0 if no limit */ int notlifo, rogue; /* counts of non-LIFO frees and rogue frees */ }; /* memory allocation routine to pass to zlib */ local void *mem_alloc(void *mem, unsigned count, unsigned size) { void *ptr; struct mem_item *item; struct mem_zone *zone = mem; size_t len = count * (size_t)size; /* induced allocation failure */ if (zone == NULL || (zone->limit && zone->total + len > zone->limit)) return NULL; /* perform allocation using the standard library, fill memory with a non-zero value to make sure that the code isn't depending on zeros */ ptr = malloc(len); if (ptr == NULL) return NULL; memset(ptr, 0xa5, len); /* create a new item for the list */ item = malloc(sizeof(struct mem_item)); if (item == NULL) { free(ptr); return NULL; } item->ptr = ptr; item->size = len; /* insert item at the beginning of the list */ item->next = zone->first; zone->first = item; /* update the statistics */ zone->total += item->size; if (zone->total > zone->highwater) zone->highwater = zone->total; /* return the allocated memory */ return ptr; } /* memory free routine to pass to zlib */ local void mem_free(void *mem, void *ptr) { struct mem_item *item, *next; struct mem_zone *zone = mem; /* if no zone, just do a free */ if (zone == NULL) { free(ptr); return; } /* point next to the item that matches ptr, or NULL if not found -- remove the item from the linked list if found */ next = zone->first; if (next) { if (next->ptr == ptr) zone->first = next->next; /* first one is it, remove from list */ else { do { /* search the linked list */ item = next; next = item->next; } while (next != NULL && next->ptr != ptr); if (next) { /* if found, remove from linked list */ item->next = next->next; zone->notlifo++; /* not a LIFO free */ } } } /* if found, update the statistics and free the item */ if (next) { zone->total -= next->size; free(next); } /* if not found, update the rogue count */ else zone->rogue++; /* in any case, do the requested free with the standard library function */ free(ptr); } /* set up a controlled memory allocation space for monitoring, set the stream parameters to the controlled routines, with opaque pointing to the space */ local void mem_setup(z_stream *strm) { struct mem_zone *zone; zone = malloc(sizeof(struct mem_zone)); assert(zone != NULL); zone->first = NULL; zone->total = 0; zone->highwater = 0; zone->limit = 0; zone->notlifo = 0; zone->rogue = 0; strm->opaque = zone; strm->zalloc = mem_alloc; strm->zfree = mem_free; } /* set a limit on the total memory allocation, or 0 to remove the limit */ local void mem_limit(z_stream *strm, size_t limit) { struct mem_zone *zone = strm->opaque; zone->limit = limit; } /* show the current total requested allocations in bytes */ local void mem_used(z_stream *strm, char *prefix) { struct mem_zone *zone = strm->opaque; fprintf(stderr, "%s: %lu allocated\n", prefix, zone->total); } /* show the high water allocation in bytes */ local void mem_high(z_stream *strm, char *prefix) { struct mem_zone *zone = strm->opaque; fprintf(stderr, "%s: %lu high water mark\n", prefix, zone->highwater); } /* release the memory allocation zone -- if there are any surprises, notify */ local void mem_done(z_stream *strm, char *prefix) { int count = 0; struct mem_item *item, *next; struct mem_zone *zone = strm->opaque; /* show high water mark */ mem_high(strm, prefix); /* free leftover allocations and item structures, if any */ item = zone->first; while (item != NULL) { free(item->ptr); next = item->next; free(item); item = next; count++; } /* issue alerts about anything unexpected */ if (count || zone->total) fprintf(stderr, "** %s: %lu bytes in %d blocks not freed\n", prefix, zone->total, count); if (zone->notlifo) fprintf(stderr, "** %s: %d frees not LIFO\n", prefix, zone->notlifo); if (zone->rogue) fprintf(stderr, "** %s: %d frees not recognized\n", prefix, zone->rogue); /* free the zone and delete from the stream */ free(zone); strm->opaque = Z_NULL; strm->zalloc = Z_NULL; strm->zfree = Z_NULL; } /* -- inflate test routines -- */ /* Decode a hexadecimal string, set *len to length, in[] to the bytes. This decodes liberally, in that hex digits can be adjacent, in which case two in a row writes a byte. Or they can be delimited by any non-hex character, where the delimiters are ignored except when a single hex digit is followed by a delimiter, where that single digit writes a byte. The returned data is allocated and must eventually be freed. NULL is returned if out of memory. If the length is not needed, then len can be NULL. */ local unsigned char *h2b(const char *hex, unsigned *len) { unsigned char *in, *re; unsigned next, val; in = malloc((strlen(hex) + 1) >> 1); if (in == NULL) return NULL; next = 0; val = 1; do { if (*hex >= '0' && *hex <= '9') val = (val << 4) + *hex - '0'; else if (*hex >= 'A' && *hex <= 'F') val = (val << 4) + *hex - 'A' + 10; else if (*hex >= 'a' && *hex <= 'f') val = (val << 4) + *hex - 'a' + 10; else if (val != 1 && val < 32) /* one digit followed by delimiter */ val += 240; /* make it look like two digits */ if (val > 255) { /* have two digits */ in[next++] = val & 0xff; /* save the decoded byte */ val = 1; /* start over */ } } while (*hex++); /* go through the loop with the terminating null */ if (len != NULL) *len = next; re = realloc(in, next); return re == NULL ? in : re; } /* generic inflate() run, where hex is the hexadecimal input data, what is the text to include in an error message, step is how much input data to feed inflate() on each call, or zero to feed it all, win is the window bits parameter to inflateInit2(), len is the size of the output buffer, and err is the error code expected from the first inflate() call (the second inflate() call is expected to return Z_STREAM_END). If win is 47, then header information is collected with inflateGetHeader(). If a zlib stream is looking for a dictionary, then an empty dictionary is provided. inflate() is run until all of the input data is consumed. */ local void inf(char *hex, char *what, unsigned step, int win, unsigned len, int err) { int ret; unsigned have; unsigned char *in, *out; z_stream strm, copy; gz_header head; mem_setup(&strm); strm.avail_in = 0; strm.next_in = Z_NULL; ret = inflateInit2(&strm, win); if (ret != Z_OK) { mem_done(&strm, what); return; } out = malloc(len); assert(out != NULL); if (win == 47) { head.extra = out; head.extra_max = len; head.name = out; head.name_max = len; head.comment = out; head.comm_max = len; ret = inflateGetHeader(&strm, &head); assert(ret == Z_OK); } in = h2b(hex, &have); assert(in != NULL); if (step == 0 || step > have) step = have; strm.avail_in = step; have -= step; strm.next_in = in; do { strm.avail_out = len; strm.next_out = out; ret = inflate(&strm, Z_NO_FLUSH); assert(err == 9 || ret == err); if (ret != Z_OK && ret != Z_BUF_ERROR && ret != Z_NEED_DICT) break; if (ret == Z_NEED_DICT) { ret = inflateSetDictionary(&strm, in, 1); assert(ret == Z_DATA_ERROR); mem_limit(&strm, 1); ret = inflateSetDictionary(&strm, out, 0); assert(ret == Z_MEM_ERROR); mem_limit(&strm, 0); ((struct inflate_state *)strm.state)->mode = DICT; ret = inflateSetDictionary(&strm, out, 0); assert(ret == Z_OK); ret = inflate(&strm, Z_NO_FLUSH); assert(ret == Z_BUF_ERROR); } ret = inflateCopy(©, &strm); assert(ret == Z_OK); ret = inflateEnd(©); assert(ret == Z_OK); err = 9; /* don't care next time around */ have += strm.avail_in; strm.avail_in = step > have ? have : step; have -= strm.avail_in; } while (strm.avail_in); free(in); free(out); ret = inflateReset2(&strm, -8); assert(ret == Z_OK); ret = inflateEnd(&strm); assert(ret == Z_OK); mem_done(&strm, what); } /* cover all of the lines in inflate.c up to inflate() */ local void cover_support(void) { int ret; z_stream strm; mem_setup(&strm); strm.avail_in = 0; strm.next_in = Z_NULL; ret = inflateInit(&strm); assert(ret == Z_OK); mem_used(&strm, "inflate init"); ret = inflatePrime(&strm, 5, 31); assert(ret == Z_OK); ret = inflatePrime(&strm, -1, 0); assert(ret == Z_OK); ret = inflateSetDictionary(&strm, Z_NULL, 0); assert(ret == Z_STREAM_ERROR); ret = inflateEnd(&strm); assert(ret == Z_OK); mem_done(&strm, "prime"); inf("63 0", "force window allocation", 0, -15, 1, Z_OK); inf("63 18 5", "force window replacement", 0, -8, 259, Z_OK); inf("63 18 68 30 d0 0 0", "force split window update", 4, -8, 259, Z_OK); inf("3 0", "use fixed blocks", 0, -15, 1, Z_STREAM_END); inf("", "bad window size", 0, 1, 0, Z_STREAM_ERROR); mem_setup(&strm); strm.avail_in = 0; strm.next_in = Z_NULL; ret = inflateInit_(&strm, "!", (int)sizeof(z_stream)); assert(ret == Z_VERSION_ERROR); mem_done(&strm, "wrong version"); strm.avail_in = 0; strm.next_in = Z_NULL; ret = inflateInit(&strm); assert(ret == Z_OK); ret = inflateEnd(&strm); assert(ret == Z_OK); fputs("inflate built-in memory routines\n", stderr); } /* cover all inflate() header and trailer cases and code after inflate() */ local void cover_wrap(void) { int ret; z_stream strm, copy; unsigned char dict[257]; ret = inflate(Z_NULL, 0); assert(ret == Z_STREAM_ERROR); ret = inflateEnd(Z_NULL); assert(ret == Z_STREAM_ERROR); ret = inflateCopy(Z_NULL, Z_NULL); assert(ret == Z_STREAM_ERROR); fputs("inflate bad parameters\n", stderr); inf("1f 8b 0 0", "bad gzip method", 0, 31, 0, Z_DATA_ERROR); inf("1f 8b 8 80", "bad gzip flags", 0, 31, 0, Z_DATA_ERROR); inf("77 85", "bad zlib method", 0, 15, 0, Z_DATA_ERROR); inf("8 99", "set window size from header", 0, 0, 0, Z_OK); inf("78 9c", "bad zlib window size", 0, 8, 0, Z_DATA_ERROR); inf("78 9c 63 0 0 0 1 0 1", "check adler32", 0, 15, 1, Z_STREAM_END); inf("1f 8b 8 1e 0 0 0 0 0 0 1 0 0 0 0 0 0", "bad header crc", 0, 47, 1, Z_DATA_ERROR); inf("1f 8b 8 2 0 0 0 0 0 0 1d 26 3 0 0 0 0 0 0 0 0 0", "check gzip length", 0, 47, 0, Z_STREAM_END); inf("78 90", "bad zlib header check", 0, 47, 0, Z_DATA_ERROR); inf("8 b8 0 0 0 1", "need dictionary", 0, 8, 0, Z_NEED_DICT); inf("78 9c 63 0", "compute adler32", 0, 15, 1, Z_OK); mem_setup(&strm); strm.avail_in = 0; strm.next_in = Z_NULL; ret = inflateInit2(&strm, -8); strm.avail_in = 2; strm.next_in = (void *)"\x63"; strm.avail_out = 1; strm.next_out = (void *)&ret; mem_limit(&strm, 1); ret = inflate(&strm, Z_NO_FLUSH); assert(ret == Z_MEM_ERROR); ret = inflate(&strm, Z_NO_FLUSH); assert(ret == Z_MEM_ERROR); mem_limit(&strm, 0); memset(dict, 0, 257); ret = inflateSetDictionary(&strm, dict, 257); assert(ret == Z_OK); mem_limit(&strm, (sizeof(struct inflate_state) << 1) + 256); ret = inflatePrime(&strm, 16, 0); assert(ret == Z_OK); strm.avail_in = 2; strm.next_in = (void *)"\x80"; ret = inflateSync(&strm); assert(ret == Z_DATA_ERROR); ret = inflate(&strm, Z_NO_FLUSH); assert(ret == Z_STREAM_ERROR); strm.avail_in = 4; strm.next_in = (void *)"\0\0\xff\xff"; ret = inflateSync(&strm); assert(ret == Z_OK); (void)inflateSyncPoint(&strm); ret = inflateCopy(©, &strm); assert(ret == Z_MEM_ERROR); mem_limit(&strm, 0); ret = inflateUndermine(&strm, 1); assert(ret == Z_DATA_ERROR); (void)inflateMark(&strm); ret = inflateEnd(&strm); assert(ret == Z_OK); mem_done(&strm, "miscellaneous, force memory errors"); } /* input and output functions for inflateBack() */ local unsigned pull(void *desc, unsigned char **buf) { static unsigned int next = 0; static unsigned char dat[] = {0x63, 0, 2, 0}; struct inflate_state *state; if (desc == Z_NULL) { next = 0; return 0; /* no input (already provided at next_in) */ } state = (void *)((z_stream *)desc)->state; if (state != Z_NULL) state->mode = SYNC; /* force an otherwise impossible situation */ return next < sizeof(dat) ? (*buf = dat + next++, 1) : 0; } local int push(void *desc, unsigned char *buf, unsigned len) { (void)buf; (void)len; return desc != Z_NULL; /* force error if desc not null */ } /* cover inflateBack() up to common deflate data cases and after those */ local void cover_back(void) { int ret; z_stream strm; unsigned char win[32768]; ret = inflateBackInit_(Z_NULL, 0, win, 0, 0); assert(ret == Z_VERSION_ERROR); ret = inflateBackInit(Z_NULL, 0, win); assert(ret == Z_STREAM_ERROR); ret = inflateBack(Z_NULL, Z_NULL, Z_NULL, Z_NULL, Z_NULL); assert(ret == Z_STREAM_ERROR); ret = inflateBackEnd(Z_NULL); assert(ret == Z_STREAM_ERROR); fputs("inflateBack bad parameters\n", stderr); mem_setup(&strm); ret = inflateBackInit(&strm, 15, win); assert(ret == Z_OK); strm.avail_in = 2; strm.next_in = (void *)"\x03"; ret = inflateBack(&strm, pull, Z_NULL, push, Z_NULL); assert(ret == Z_STREAM_END); /* force output error */ strm.avail_in = 3; strm.next_in = (void *)"\x63\x00"; ret = inflateBack(&strm, pull, Z_NULL, push, &strm); assert(ret == Z_BUF_ERROR); /* force mode error by mucking with state */ ret = inflateBack(&strm, pull, &strm, push, Z_NULL); assert(ret == Z_STREAM_ERROR); ret = inflateBackEnd(&strm); assert(ret == Z_OK); mem_done(&strm, "inflateBack bad state"); ret = inflateBackInit(&strm, 15, win); assert(ret == Z_OK); ret = inflateBackEnd(&strm); assert(ret == Z_OK); fputs("inflateBack built-in memory routines\n", stderr); } /* do a raw inflate of data in hexadecimal with both inflate and inflateBack */ local int try(char *hex, char *id, int err) { int ret; unsigned len, size; unsigned char *in, *out, *win; char *prefix; z_stream strm; /* convert to hex */ in = h2b(hex, &len); assert(in != NULL); /* allocate work areas */ size = len << 3; out = malloc(size); assert(out != NULL); win = malloc(32768); assert(win != NULL); prefix = malloc(strlen(id) + 6); assert(prefix != NULL); /* first with inflate */ strcpy(prefix, id); strcat(prefix, "-late"); mem_setup(&strm); strm.avail_in = 0; strm.next_in = Z_NULL; ret = inflateInit2(&strm, err < 0 ? 47 : -15); assert(ret == Z_OK); strm.avail_in = len; strm.next_in = in; do { strm.avail_out = size; strm.next_out = out; ret = inflate(&strm, Z_TREES); assert(ret != Z_STREAM_ERROR && ret != Z_MEM_ERROR); if (ret == Z_DATA_ERROR || ret == Z_NEED_DICT) break; } while (strm.avail_in || strm.avail_out == 0); if (err) { assert(ret == Z_DATA_ERROR); assert(strcmp(id, strm.msg) == 0); } inflateEnd(&strm); mem_done(&strm, prefix); /* then with inflateBack */ if (err >= 0) { strcpy(prefix, id); strcat(prefix, "-back"); mem_setup(&strm); ret = inflateBackInit(&strm, 15, win); assert(ret == Z_OK); strm.avail_in = len; strm.next_in = in; ret = inflateBack(&strm, pull, Z_NULL, push, Z_NULL); assert(ret != Z_STREAM_ERROR); if (err) { assert(ret == Z_DATA_ERROR); assert(strcmp(id, strm.msg) == 0); } inflateBackEnd(&strm); mem_done(&strm, prefix); } /* clean up */ free(prefix); free(win); free(out); free(in); return ret; } /* cover deflate data cases in both inflate() and inflateBack() */ local void cover_inflate(void) { try("0 0 0 0 0", "invalid stored block lengths", 1); try("3 0", "fixed", 0); try("6", "invalid block type", 1); try("1 1 0 fe ff 0", "stored", 0); try("fc 0 0", "too many length or distance symbols", 1); try("4 0 fe ff", "invalid code lengths set", 1); try("4 0 24 49 0", "invalid bit length repeat", 1); try("4 0 24 e9 ff ff", "invalid bit length repeat", 1); try("4 0 24 e9 ff 6d", "invalid code -- missing end-of-block", 1); try("4 80 49 92 24 49 92 24 71 ff ff 93 11 0", "invalid literal/lengths set", 1); try("4 80 49 92 24 49 92 24 f b4 ff ff c3 84", "invalid distances set", 1); try("4 c0 81 8 0 0 0 0 20 7f eb b 0 0", "invalid literal/length code", 1); try("2 7e ff ff", "invalid distance code", 1); try("c c0 81 0 0 0 0 0 90 ff 6b 4 0", "invalid distance too far back", 1); /* also trailer mismatch just in inflate() */ try("1f 8b 8 0 0 0 0 0 0 0 3 0 0 0 0 1", "incorrect data check", -1); try("1f 8b 8 0 0 0 0 0 0 0 3 0 0 0 0 0 0 0 0 1", "incorrect length check", -1); try("5 c0 21 d 0 0 0 80 b0 fe 6d 2f 91 6c", "pull 17", 0); try("5 e0 81 91 24 cb b2 2c 49 e2 f 2e 8b 9a 47 56 9f fb fe ec d2 ff 1f", "long code", 0); try("ed c0 1 1 0 0 0 40 20 ff 57 1b 42 2c 4f", "length extra", 0); try("ed cf c1 b1 2c 47 10 c4 30 fa 6f 35 1d 1 82 59 3d fb be 2e 2a fc f c", "long distance and extra", 0); try("ed c0 81 0 0 0 0 80 a0 fd a9 17 a9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 " "0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6", "window end", 0); inf("2 8 20 80 0 3 0", "inflate_fast TYPE return", 0, -15, 258, Z_STREAM_END); inf("63 18 5 40 c 0", "window wrap", 3, -8, 300, Z_OK); } /* cover remaining lines in inftrees.c */ local void cover_trees(void) { int ret; unsigned bits; unsigned short lens[16], work[16]; code *next, table[ENOUGH_DISTS]; /* we need to call inflate_table() directly in order to manifest not- enough errors, since zlib insures that enough is always enough */ for (bits = 0; bits < 15; bits++) lens[bits] = (unsigned short)(bits + 1); lens[15] = 15; next = table; bits = 15; ret = inflate_table(DISTS, lens, 16, &next, &bits, work); assert(ret == 1); next = table; bits = 1; ret = inflate_table(DISTS, lens, 16, &next, &bits, work); assert(ret == 1); fputs("inflate_table not enough errors\n", stderr); } /* cover remaining inffast.c decoding and window copying */ local void cover_fast(void) { inf("e5 e0 81 ad 6d cb b2 2c c9 01 1e 59 63 ae 7d ee fb 4d fd b5 35 41 68" " ff 7f 0f 0 0 0", "fast length extra bits", 0, -8, 258, Z_DATA_ERROR); inf("25 fd 81 b5 6d 59 b6 6a 49 ea af 35 6 34 eb 8c b9 f6 b9 1e ef 67 49" " 50 fe ff ff 3f 0 0", "fast distance extra bits", 0, -8, 258, Z_DATA_ERROR); inf("3 7e 0 0 0 0 0", "fast invalid distance code", 0, -8, 258, Z_DATA_ERROR); inf("1b 7 0 0 0 0 0", "fast invalid literal/length code", 0, -8, 258, Z_DATA_ERROR); inf("d c7 1 ae eb 38 c 4 41 a0 87 72 de df fb 1f b8 36 b1 38 5d ff ff 0", "fast 2nd level codes and too far back", 0, -8, 258, Z_DATA_ERROR); inf("63 18 5 8c 10 8 0 0 0 0", "very common case", 0, -8, 259, Z_OK); inf("63 60 60 18 c9 0 8 18 18 18 26 c0 28 0 29 0 0 0", "contiguous and wrap around window", 6, -8, 259, Z_OK); inf("63 0 3 0 0 0 0 0", "copy direct from output", 0, -8, 259, Z_STREAM_END); } int main(void) { fprintf(stderr, "%s\n", zlibVersion()); cover_support(); cover_wrap(); cover_back(); cover_inflate(); cover_trees(); cover_fast(); return 0; } tcl8.6.14/compat/zlib/trees.h0000644000175000017500000002043014554262142015357 0ustar sergeisergei/* header created automatically with -DGEN_TREES_H */ local const ct_data static_ltree[L_CODES+2] = { {{ 12},{ 8}}, {{140},{ 8}}, {{ 76},{ 8}}, {{204},{ 8}}, {{ 44},{ 8}}, {{172},{ 8}}, {{108},{ 8}}, {{236},{ 8}}, {{ 28},{ 8}}, {{156},{ 8}}, {{ 92},{ 8}}, {{220},{ 8}}, {{ 60},{ 8}}, {{188},{ 8}}, {{124},{ 8}}, {{252},{ 8}}, {{ 2},{ 8}}, {{130},{ 8}}, {{ 66},{ 8}}, {{194},{ 8}}, {{ 34},{ 8}}, {{162},{ 8}}, {{ 98},{ 8}}, {{226},{ 8}}, {{ 18},{ 8}}, {{146},{ 8}}, {{ 82},{ 8}}, {{210},{ 8}}, {{ 50},{ 8}}, {{178},{ 8}}, {{114},{ 8}}, {{242},{ 8}}, {{ 10},{ 8}}, {{138},{ 8}}, {{ 74},{ 8}}, {{202},{ 8}}, {{ 42},{ 8}}, {{170},{ 8}}, {{106},{ 8}}, {{234},{ 8}}, {{ 26},{ 8}}, {{154},{ 8}}, {{ 90},{ 8}}, {{218},{ 8}}, {{ 58},{ 8}}, {{186},{ 8}}, {{122},{ 8}}, {{250},{ 8}}, {{ 6},{ 8}}, {{134},{ 8}}, {{ 70},{ 8}}, {{198},{ 8}}, {{ 38},{ 8}}, {{166},{ 8}}, {{102},{ 8}}, {{230},{ 8}}, {{ 22},{ 8}}, {{150},{ 8}}, {{ 86},{ 8}}, {{214},{ 8}}, {{ 54},{ 8}}, {{182},{ 8}}, {{118},{ 8}}, {{246},{ 8}}, {{ 14},{ 8}}, {{142},{ 8}}, {{ 78},{ 8}}, {{206},{ 8}}, {{ 46},{ 8}}, {{174},{ 8}}, {{110},{ 8}}, {{238},{ 8}}, {{ 30},{ 8}}, {{158},{ 8}}, {{ 94},{ 8}}, {{222},{ 8}}, {{ 62},{ 8}}, {{190},{ 8}}, {{126},{ 8}}, {{254},{ 8}}, {{ 1},{ 8}}, {{129},{ 8}}, {{ 65},{ 8}}, {{193},{ 8}}, {{ 33},{ 8}}, {{161},{ 8}}, {{ 97},{ 8}}, {{225},{ 8}}, {{ 17},{ 8}}, {{145},{ 8}}, {{ 81},{ 8}}, {{209},{ 8}}, {{ 49},{ 8}}, {{177},{ 8}}, {{113},{ 8}}, {{241},{ 8}}, {{ 9},{ 8}}, {{137},{ 8}}, {{ 73},{ 8}}, {{201},{ 8}}, {{ 41},{ 8}}, {{169},{ 8}}, {{105},{ 8}}, {{233},{ 8}}, {{ 25},{ 8}}, {{153},{ 8}}, {{ 89},{ 8}}, {{217},{ 8}}, {{ 57},{ 8}}, {{185},{ 8}}, {{121},{ 8}}, {{249},{ 8}}, {{ 5},{ 8}}, {{133},{ 8}}, {{ 69},{ 8}}, {{197},{ 8}}, {{ 37},{ 8}}, {{165},{ 8}}, {{101},{ 8}}, {{229},{ 8}}, {{ 21},{ 8}}, {{149},{ 8}}, {{ 85},{ 8}}, {{213},{ 8}}, {{ 53},{ 8}}, {{181},{ 8}}, {{117},{ 8}}, {{245},{ 8}}, {{ 13},{ 8}}, {{141},{ 8}}, {{ 77},{ 8}}, {{205},{ 8}}, {{ 45},{ 8}}, {{173},{ 8}}, {{109},{ 8}}, {{237},{ 8}}, {{ 29},{ 8}}, {{157},{ 8}}, {{ 93},{ 8}}, {{221},{ 8}}, {{ 61},{ 8}}, {{189},{ 8}}, {{125},{ 8}}, {{253},{ 8}}, {{ 19},{ 9}}, {{275},{ 9}}, {{147},{ 9}}, {{403},{ 9}}, {{ 83},{ 9}}, {{339},{ 9}}, {{211},{ 9}}, {{467},{ 9}}, {{ 51},{ 9}}, {{307},{ 9}}, {{179},{ 9}}, {{435},{ 9}}, {{115},{ 9}}, {{371},{ 9}}, {{243},{ 9}}, {{499},{ 9}}, {{ 11},{ 9}}, {{267},{ 9}}, {{139},{ 9}}, {{395},{ 9}}, {{ 75},{ 9}}, {{331},{ 9}}, {{203},{ 9}}, {{459},{ 9}}, {{ 43},{ 9}}, {{299},{ 9}}, {{171},{ 9}}, {{427},{ 9}}, {{107},{ 9}}, {{363},{ 9}}, {{235},{ 9}}, {{491},{ 9}}, {{ 27},{ 9}}, {{283},{ 9}}, {{155},{ 9}}, {{411},{ 9}}, {{ 91},{ 9}}, {{347},{ 9}}, {{219},{ 9}}, {{475},{ 9}}, {{ 59},{ 9}}, {{315},{ 9}}, {{187},{ 9}}, {{443},{ 9}}, {{123},{ 9}}, {{379},{ 9}}, {{251},{ 9}}, {{507},{ 9}}, {{ 7},{ 9}}, {{263},{ 9}}, {{135},{ 9}}, {{391},{ 9}}, {{ 71},{ 9}}, {{327},{ 9}}, {{199},{ 9}}, {{455},{ 9}}, {{ 39},{ 9}}, {{295},{ 9}}, {{167},{ 9}}, {{423},{ 9}}, {{103},{ 9}}, {{359},{ 9}}, {{231},{ 9}}, {{487},{ 9}}, {{ 23},{ 9}}, {{279},{ 9}}, {{151},{ 9}}, {{407},{ 9}}, {{ 87},{ 9}}, {{343},{ 9}}, {{215},{ 9}}, {{471},{ 9}}, {{ 55},{ 9}}, {{311},{ 9}}, {{183},{ 9}}, {{439},{ 9}}, {{119},{ 9}}, {{375},{ 9}}, {{247},{ 9}}, {{503},{ 9}}, {{ 15},{ 9}}, {{271},{ 9}}, {{143},{ 9}}, {{399},{ 9}}, {{ 79},{ 9}}, {{335},{ 9}}, {{207},{ 9}}, {{463},{ 9}}, {{ 47},{ 9}}, {{303},{ 9}}, {{175},{ 9}}, {{431},{ 9}}, {{111},{ 9}}, {{367},{ 9}}, {{239},{ 9}}, {{495},{ 9}}, {{ 31},{ 9}}, {{287},{ 9}}, {{159},{ 9}}, {{415},{ 9}}, {{ 95},{ 9}}, {{351},{ 9}}, {{223},{ 9}}, {{479},{ 9}}, {{ 63},{ 9}}, {{319},{ 9}}, {{191},{ 9}}, {{447},{ 9}}, {{127},{ 9}}, {{383},{ 9}}, {{255},{ 9}}, {{511},{ 9}}, {{ 0},{ 7}}, {{ 64},{ 7}}, {{ 32},{ 7}}, {{ 96},{ 7}}, {{ 16},{ 7}}, {{ 80},{ 7}}, {{ 48},{ 7}}, {{112},{ 7}}, {{ 8},{ 7}}, {{ 72},{ 7}}, {{ 40},{ 7}}, {{104},{ 7}}, {{ 24},{ 7}}, {{ 88},{ 7}}, {{ 56},{ 7}}, {{120},{ 7}}, {{ 4},{ 7}}, {{ 68},{ 7}}, {{ 36},{ 7}}, {{100},{ 7}}, {{ 20},{ 7}}, {{ 84},{ 7}}, {{ 52},{ 7}}, {{116},{ 7}}, {{ 3},{ 8}}, {{131},{ 8}}, {{ 67},{ 8}}, {{195},{ 8}}, {{ 35},{ 8}}, {{163},{ 8}}, {{ 99},{ 8}}, {{227},{ 8}} }; local const ct_data static_dtree[D_CODES] = { {{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}}, {{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}}, {{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}}, {{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}}, {{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}}, {{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}} }; const uch ZLIB_INTERNAL _dist_code[DIST_CODE_LEN] = { 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17, 18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29 }; const uch ZLIB_INTERNAL _length_code[MAX_MATCH-MIN_MATCH+1]= { 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12, 13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, 19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28 }; local const int base_length[LENGTH_CODES] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 0 }; local const int base_dist[D_CODES] = { 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, 32, 48, 64, 96, 128, 192, 256, 384, 512, 768, 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576 }; tcl8.6.14/compat/zlib/inftrees.h0000644000175000017500000000555014560736524016071 0ustar sergeisergei/* inftrees.h -- header to use inftrees.c * Copyright (C) 1995-2005, 2010 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* WARNING: this file should *not* be used by applications. It is part of the implementation of the compression library and is subject to change. Applications should only use zlib.h. */ /* Structure for decoding tables. Each entry provides either the information needed to do the operation requested by the code that indexed that table entry, or it provides a pointer to another table that indexes more bits of the code. op indicates whether the entry is a pointer to another table, a literal, a length or distance, an end-of-block, or an invalid code. For a table pointer, the low four bits of op is the number of index bits of that table. For a length or distance, the low four bits of op is the number of extra bits to get after the code. bits is the number of bits in this code or part of the code to drop off of the bit buffer. val is the actual byte to output in the case of a literal, the base length or distance, or the offset from the current table to the next table. Each entry is four bytes. */ typedef struct { unsigned char op; /* operation, extra bits, table bits */ unsigned char bits; /* bits in this part of the code */ unsigned short val; /* offset in table or code value */ } code; /* op values as set by inflate_table(): 00000000 - literal 0000tttt - table link, tttt != 0 is the number of table index bits 0001eeee - length or distance, eeee is the number of extra bits 01100000 - end of block 01000000 - invalid code */ /* Maximum size of the dynamic table. The maximum number of code structures is 1444, which is the sum of 852 for literal/length codes and 592 for distance codes. These values were found by exhaustive searches using the program examples/enough.c found in the zlib distribution. The arguments to that program are the number of symbols, the initial root table size, and the maximum bit length of a code. "enough 286 9 15" for literal/length codes returns 852, and "enough 30 6 15" for distance codes returns 592. The initial root table size (9 or 6) is found in the fifth argument of the inflate_table() calls in inflate.c and infback.c. If the root table size is changed, then these maximum sizes would be need to be recalculated and updated. */ #define ENOUGH_LENS 852 #define ENOUGH_DISTS 592 #define ENOUGH (ENOUGH_LENS+ENOUGH_DISTS) /* Type of code to build for inflate_table() */ typedef enum { CODES, LENS, DISTS } codetype; int ZLIB_INTERNAL inflate_table(codetype type, unsigned short FAR *lens, unsigned codes, code FAR * FAR *table, unsigned FAR *bits, unsigned short FAR *work); tcl8.6.14/compat/zlib/FAQ0000644000175000017500000004014214560736523014426 0ustar sergeisergei Frequently Asked Questions about zlib If your question is not there, please check the zlib home page http://zlib.net/ which may have more recent information. The latest zlib FAQ is at http://zlib.net/zlib_faq.html 1. Is zlib Y2K-compliant? Yes. zlib doesn't handle dates. 2. Where can I get a Windows DLL version? The zlib sources can be compiled without change to produce a DLL. See the file win32/DLL_FAQ.txt in the zlib distribution. 3. Where can I get a Visual Basic interface to zlib? See * http://marknelson.us/1997/01/01/zlib-engine/ * win32/DLL_FAQ.txt in the zlib distribution 4. compress() returns Z_BUF_ERROR. Make sure that before the call of compress(), the length of the compressed buffer is equal to the available size of the compressed buffer and not zero. For Visual Basic, check that this parameter is passed by reference ("as any"), not by value ("as long"). 5. deflate() or inflate() returns Z_BUF_ERROR. Before making the call, make sure that avail_in and avail_out are not zero. When setting the parameter flush equal to Z_FINISH, also make sure that avail_out is big enough to allow processing all pending input. Note that a Z_BUF_ERROR is not fatal--another call to deflate() or inflate() can be made with more input or output space. A Z_BUF_ERROR may in fact be unavoidable depending on how the functions are used, since it is not possible to tell whether or not there is more output pending when strm.avail_out returns with zero. See http://zlib.net/zlib_how.html for a heavily annotated example. 6. Where's the zlib documentation (man pages, etc.)? It's in zlib.h . Examples of zlib usage are in the files test/example.c and test/minigzip.c, with more in examples/ . 7. Why don't you use GNU autoconf or libtool or ...? Because we would like to keep zlib as a very small and simple package. zlib is rather portable and doesn't need much configuration. 8. I found a bug in zlib. Most of the time, such problems are due to an incorrect usage of zlib. Please try to reproduce the problem with a small program and send the corresponding source to us at zlib@gzip.org . Do not send multi-megabyte data files without prior agreement. 9. Why do I get "undefined reference to gzputc"? If "make test" produces something like example.o(.text+0x154): undefined reference to `gzputc' check that you don't have old files libz.* in /usr/lib, /usr/local/lib or /usr/X11R6/lib. Remove any old versions, then do "make install". 10. I need a Delphi interface to zlib. See the contrib/delphi directory in the zlib distribution. 11. Can zlib handle .zip archives? Not by itself, no. See the directory contrib/minizip in the zlib distribution. 12. Can zlib handle .Z files? No, sorry. You have to spawn an uncompress or gunzip subprocess, or adapt the code of uncompress on your own. 13. How can I make a Unix shared library? By default a shared (and a static) library is built for Unix. So: make distclean ./configure make 14. How do I install a shared zlib library on Unix? After the above, then: make install However, many flavors of Unix come with a shared zlib already installed. Before going to the trouble of compiling a shared version of zlib and trying to install it, you may want to check if it's already there! If you can #include , it's there. The -lz option will probably link to it. You can check the version at the top of zlib.h or with the ZLIB_VERSION symbol defined in zlib.h . 15. I have a question about OttoPDF. We are not the authors of OttoPDF. The real author is on the OttoPDF web site: Joel Hainley, jhainley@myndkryme.com. 16. Can zlib decode Flate data in an Adobe PDF file? Yes. See http://www.pdflib.com/ . To modify PDF forms, see http://sourceforge.net/projects/acroformtool/ . 17. Why am I getting this "register_frame_info not found" error on Solaris? After installing zlib 1.1.4 on Solaris 2.6, running applications using zlib generates an error such as: ld.so.1: rpm: fatal: relocation error: file /usr/local/lib/libz.so: symbol __register_frame_info: referenced symbol not found The symbol __register_frame_info is not part of zlib, it is generated by the C compiler (cc or gcc). You must recompile applications using zlib which have this problem. This problem is specific to Solaris. See http://www.sunfreeware.com for Solaris versions of zlib and applications using zlib. 18. Why does gzip give an error on a file I make with compress/deflate? The compress and deflate functions produce data in the zlib format, which is different and incompatible with the gzip format. The gz* functions in zlib on the other hand use the gzip format. Both the zlib and gzip formats use the same compressed data format internally, but have different headers and trailers around the compressed data. 19. Ok, so why are there two different formats? The gzip format was designed to retain the directory information about a single file, such as the name and last modification date. The zlib format on the other hand was designed for in-memory and communication channel applications, and has a much more compact header and trailer and uses a faster integrity check than gzip. 20. Well that's nice, but how do I make a gzip file in memory? You can request that deflate write the gzip format instead of the zlib format using deflateInit2(). You can also request that inflate decode the gzip format using inflateInit2(). Read zlib.h for more details. 21. Is zlib thread-safe? Yes. However any library routines that zlib uses and any application- provided memory allocation routines must also be thread-safe. zlib's gz* functions use stdio library routines, and most of zlib's functions use the library memory allocation routines by default. zlib's *Init* functions allow for the application to provide custom memory allocation routines. Of course, you should only operate on any given zlib or gzip stream from a single thread at a time. 22. Can I use zlib in my commercial application? Yes. Please read the license in zlib.h. 23. Is zlib under the GNU license? No. Please read the license in zlib.h. 24. The license says that altered source versions must be "plainly marked". So what exactly do I need to do to meet that requirement? You need to change the ZLIB_VERSION and ZLIB_VERNUM #defines in zlib.h. In particular, the final version number needs to be changed to "f", and an identification string should be appended to ZLIB_VERSION. Version numbers x.x.x.f are reserved for modifications to zlib by others than the zlib maintainers. For example, if the version of the base zlib you are altering is "1.2.3.4", then in zlib.h you should change ZLIB_VERNUM to 0x123f, and ZLIB_VERSION to something like "1.2.3.f-zachary-mods-v3". You can also update the version strings in deflate.c and inftrees.c. For altered source distributions, you should also note the origin and nature of the changes in zlib.h, as well as in ChangeLog and README, along with the dates of the alterations. The origin should include at least your name (or your company's name), and an email address to contact for help or issues with the library. Note that distributing a compiled zlib library along with zlib.h and zconf.h is also a source distribution, and so you should change ZLIB_VERSION and ZLIB_VERNUM and note the origin and nature of the changes in zlib.h as you would for a full source distribution. 25. Will zlib work on a big-endian or little-endian architecture, and can I exchange compressed data between them? Yes and yes. 26. Will zlib work on a 64-bit machine? Yes. It has been tested on 64-bit machines, and has no dependence on any data types being limited to 32-bits in length. If you have any difficulties, please provide a complete problem report to zlib@gzip.org 27. Will zlib decompress data from the PKWare Data Compression Library? No. The PKWare DCL uses a completely different compressed data format than does PKZIP and zlib. However, you can look in zlib's contrib/blast directory for a possible solution to your problem. 28. Can I access data randomly in a compressed stream? No, not without some preparation. If when compressing you periodically use Z_FULL_FLUSH, carefully write all the pending data at those points, and keep an index of those locations, then you can start decompression at those points. You have to be careful to not use Z_FULL_FLUSH too often, since it can significantly degrade compression. Alternatively, you can scan a deflate stream once to generate an index, and then use that index for random access. See examples/zran.c . 29. Does zlib work on MVS, OS/390, CICS, etc.? It has in the past, but we have not heard of any recent evidence. There were working ports of zlib 1.1.4 to MVS, but those links no longer work. If you know of recent, successful applications of zlib on these operating systems, please let us know. Thanks. 30. Is there some simpler, easier to read version of inflate I can look at to understand the deflate format? First off, you should read RFC 1951. Second, yes. Look in zlib's contrib/puff directory. 31. Does zlib infringe on any patents? As far as we know, no. In fact, that was originally the whole point behind zlib. Look here for some more information: http://www.gzip.org/#faq11 32. Can zlib work with greater than 4 GB of data? Yes. inflate() and deflate() will process any amount of data correctly. Each call of inflate() or deflate() is limited to input and output chunks of the maximum value that can be stored in the compiler's "unsigned int" type, but there is no limit to the number of chunks. Note however that the strm.total_in and strm_total_out counters may be limited to 4 GB. These counters are provided as a convenience and are not used internally by inflate() or deflate(). The application can easily set up its own counters updated after each call of inflate() or deflate() to count beyond 4 GB. compress() and uncompress() may be limited to 4 GB, since they operate in a single call. gzseek() and gztell() may be limited to 4 GB depending on how zlib is compiled. See the zlibCompileFlags() function in zlib.h. The word "may" appears several times above since there is a 4 GB limit only if the compiler's "long" type is 32 bits. If the compiler's "long" type is 64 bits, then the limit is 16 exabytes. 33. Does zlib have any security vulnerabilities? The only one that we are aware of is potentially in gzprintf(). If zlib is compiled to use sprintf() or vsprintf(), then there is no protection against a buffer overflow of an 8K string space (or other value as set by gzbuffer()), other than the caller of gzprintf() assuring that the output will not exceed 8K. On the other hand, if zlib is compiled to use snprintf() or vsnprintf(), which should normally be the case, then there is no vulnerability. The ./configure script will display warnings if an insecure variation of sprintf() will be used by gzprintf(). Also the zlibCompileFlags() function will return information on what variant of sprintf() is used by gzprintf(). If you don't have snprintf() or vsnprintf() and would like one, you can find a portable implementation here: http://www.ijs.si/software/snprintf/ Note that you should be using the most recent version of zlib. Versions 1.1.3 and before were subject to a double-free vulnerability, and versions 1.2.1 and 1.2.2 were subject to an access exception when decompressing invalid compressed data. 34. Is there a Java version of zlib? Probably what you want is to use zlib in Java. zlib is already included as part of the Java SDK in the java.util.zip package. If you really want a version of zlib written in the Java language, look on the zlib home page for links: http://zlib.net/ . 35. I get this or that compiler or source-code scanner warning when I crank it up to maximally-pedantic. Can't you guys write proper code? Many years ago, we gave up attempting to avoid warnings on every compiler in the universe. It just got to be a waste of time, and some compilers were downright silly as well as contradicted each other. So now, we simply make sure that the code always works. 36. Valgrind (or some similar memory access checker) says that deflate is performing a conditional jump that depends on an uninitialized value. Isn't that a bug? No. That is intentional for performance reasons, and the output of deflate is not affected. This only started showing up recently since zlib 1.2.x uses malloc() by default for allocations, whereas earlier versions used calloc(), which zeros out the allocated memory. Even though the code was correct, versions 1.2.4 and later was changed to not stimulate these checkers. 37. Will zlib read the (insert any ancient or arcane format here) compressed data format? Probably not. Look in the comp.compression FAQ for pointers to various formats and associated software. 38. How can I encrypt/decrypt zip files with zlib? zlib doesn't support encryption. The original PKZIP encryption is very weak and can be broken with freely available programs. To get strong encryption, use GnuPG, http://www.gnupg.org/ , which already includes zlib compression. For PKZIP compatible "encryption", look at http://www.info-zip.org/ 39. What's the difference between the "gzip" and "deflate" HTTP 1.1 encodings? "gzip" is the gzip format, and "deflate" is the zlib format. They should probably have called the second one "zlib" instead to avoid confusion with the raw deflate compressed data format. While the HTTP 1.1 RFC 2616 correctly points to the zlib specification in RFC 1950 for the "deflate" transfer encoding, there have been reports of servers and browsers that incorrectly produce or expect raw deflate data per the deflate specification in RFC 1951, most notably Microsoft. So even though the "deflate" transfer encoding using the zlib format would be the more efficient approach (and in fact exactly what the zlib format was designed for), using the "gzip" transfer encoding is probably more reliable due to an unfortunate choice of name on the part of the HTTP 1.1 authors. Bottom line: use the gzip format for HTTP 1.1 encoding. 40. Does zlib support the new "Deflate64" format introduced by PKWare? No. PKWare has apparently decided to keep that format proprietary, since they have not documented it as they have previous compression formats. In any case, the compression improvements are so modest compared to other more modern approaches, that it's not worth the effort to implement. 41. I'm having a problem with the zip functions in zlib, can you help? There are no zip functions in zlib. You are probably using minizip by Giles Vollant, which is found in the contrib directory of zlib. It is not part of zlib. In fact none of the stuff in contrib is part of zlib. The files in there are not supported by the zlib authors. You need to contact the authors of the respective contribution for help. 42. The match.asm code in contrib is under the GNU General Public License. Since it's part of zlib, doesn't that mean that all of zlib falls under the GNU GPL? No. The files in contrib are not part of zlib. They were contributed by other authors and are provided as a convenience to the user within the zlib distribution. Each item in contrib has its own license. 43. Is zlib subject to export controls? What is its ECCN? zlib is not subject to export controls, and so is classified as EAR99. 44. Can you please sign these lengthy legal documents and fax them back to us so that we can use your software in our product? No. Go away. Shoo. tcl8.6.14/compat/zlib/nintendods/0000755000175000017500000000000014566153412016234 5ustar sergeisergeitcl8.6.14/compat/zlib/nintendods/README0000644000175000017500000000032114554262142017106 0ustar sergeisergeiThis Makefile requires devkitARM (http://www.devkitpro.org/category/devkitarm/) and works inside "contrib/nds". It is based on a devkitARM template. Eduardo Costa January 3, 2009 tcl8.6.14/compat/zlib/nintendods/Makefile0000644000175000017500000001120514554262142017671 0ustar sergeisergei#--------------------------------------------------------------------------------- .SUFFIXES: #--------------------------------------------------------------------------------- ifeq ($(strip $(DEVKITARM)),) $(error "Please set DEVKITARM in your environment. export DEVKITARM=devkitARM") endif include $(DEVKITARM)/ds_rules #--------------------------------------------------------------------------------- # TARGET is the name of the output # BUILD is the directory where object files & intermediate files will be placed # SOURCES is a list of directories containing source code # DATA is a list of directories containing data files # INCLUDES is a list of directories containing header files #--------------------------------------------------------------------------------- TARGET := $(shell basename $(CURDIR)) BUILD := build SOURCES := ../../ DATA := data INCLUDES := include #--------------------------------------------------------------------------------- # options for code generation #--------------------------------------------------------------------------------- ARCH := -mthumb -mthumb-interwork CFLAGS := -Wall -O2\ -march=armv5te -mtune=arm946e-s \ -fomit-frame-pointer -ffast-math \ $(ARCH) CFLAGS += $(INCLUDE) -DARM9 CXXFLAGS := $(CFLAGS) -fno-rtti -fno-exceptions ASFLAGS := $(ARCH) -march=armv5te -mtune=arm946e-s LDFLAGS = -specs=ds_arm9.specs -g $(ARCH) -Wl,-Map,$(notdir $*.map) #--------------------------------------------------------------------------------- # list of directories containing libraries, this must be the top level containing # include and lib #--------------------------------------------------------------------------------- LIBDIRS := $(LIBNDS) #--------------------------------------------------------------------------------- # no real need to edit anything past this point unless you need to add additional # rules for different file extensions #--------------------------------------------------------------------------------- ifneq ($(BUILD),$(notdir $(CURDIR))) #--------------------------------------------------------------------------------- export OUTPUT := $(CURDIR)/lib/libz.a export VPATH := $(foreach dir,$(SOURCES),$(CURDIR)/$(dir)) \ $(foreach dir,$(DATA),$(CURDIR)/$(dir)) export DEPSDIR := $(CURDIR)/$(BUILD) CFILES := $(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.c))) CPPFILES := $(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.cpp))) SFILES := $(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.s))) BINFILES := $(foreach dir,$(DATA),$(notdir $(wildcard $(dir)/*.*))) #--------------------------------------------------------------------------------- # use CXX for linking C++ projects, CC for standard C #--------------------------------------------------------------------------------- ifeq ($(strip $(CPPFILES)),) #--------------------------------------------------------------------------------- export LD := $(CC) #--------------------------------------------------------------------------------- else #--------------------------------------------------------------------------------- export LD := $(CXX) #--------------------------------------------------------------------------------- endif #--------------------------------------------------------------------------------- export OFILES := $(addsuffix .o,$(BINFILES)) \ $(CPPFILES:.cpp=.o) $(CFILES:.c=.o) $(SFILES:.s=.o) export INCLUDE := $(foreach dir,$(INCLUDES),-I$(CURDIR)/$(dir)) \ $(foreach dir,$(LIBDIRS),-I$(dir)/include) \ -I$(CURDIR)/$(BUILD) .PHONY: $(BUILD) clean all #--------------------------------------------------------------------------------- all: $(BUILD) @[ -d $@ ] || mkdir -p include @cp ../../*.h include lib: @[ -d $@ ] || mkdir -p $@ $(BUILD): lib @[ -d $@ ] || mkdir -p $@ @$(MAKE) --no-print-directory -C $(BUILD) -f $(CURDIR)/Makefile #--------------------------------------------------------------------------------- clean: @echo clean ... @rm -fr $(BUILD) lib #--------------------------------------------------------------------------------- else DEPENDS := $(OFILES:.o=.d) #--------------------------------------------------------------------------------- # main targets #--------------------------------------------------------------------------------- $(OUTPUT) : $(OFILES) #--------------------------------------------------------------------------------- %.bin.o : %.bin #--------------------------------------------------------------------------------- @echo $(notdir $<) @$(bin2o) -include $(DEPENDS) #--------------------------------------------------------------------------------------- endif #--------------------------------------------------------------------------------------- tcl8.6.14/compat/zlib/inffast.h0000644000175000017500000000064614554262142015676 0ustar sergeisergei/* inffast.h -- header to use inffast.c * Copyright (C) 1995-2003, 2010 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ /* WARNING: this file should *not* be used by applications. It is part of the implementation of the compression library and is subject to change. Applications should only use zlib.h. */ void ZLIB_INTERNAL inflate_fast(z_streamp strm, unsigned start); tcl8.6.14/compat/zlib/msdos/0000755000175000017500000000000014566153412015214 5ustar sergeisergeitcl8.6.14/compat/zlib/msdos/Makefile.emx0000644000175000017500000000264714554262142017453 0ustar sergeisergei# Makefile for zlib. Modified for emx 0.9c by Chr. Spieler, 6/17/98. # Copyright (C) 1995-1998 Jean-loup Gailly. # For conditions of distribution and use, see copyright notice in zlib.h # To compile, or to compile and test, type: # # make -fmakefile.emx; make test -fmakefile.emx # CC=gcc #CFLAGS=-MMD -O #CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7 #CFLAGS=-MMD -g -DZLIB_DEBUG CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \ -Wstrict-prototypes -Wmissing-prototypes # If cp.exe is available, replace "copy /Y" with "cp -fp" . CP=copy /Y # If gnu install.exe is available, replace $(CP) with ginstall. INSTALL=$(CP) # The default value of RM is "rm -f." If "rm.exe" is found, comment out: RM=del LDLIBS=-L. -lzlib LD=$(CC) -s -o LDSHARED=$(CC) INCL=zlib.h zconf.h LIBS=zlib.a AR=ar rcs prefix=/usr/local exec_prefix = $(prefix) OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \ uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o TEST_OBJS = example.o minigzip.o all: example.exe minigzip.exe test: all ./example echo hello world | .\minigzip | .\minigzip -d %.o : %.c $(CC) $(CFLAGS) -c $< -o $@ zlib.a: $(OBJS) $(AR) $@ $(OBJS) %.exe : %.o $(LIBS) $(LD) $@ $< $(LDLIBS) .PHONY : clean clean: $(RM) *.d $(RM) *.o $(RM) *.exe $(RM) zlib.a $(RM) foo.gz DEPS := $(wildcard *.d) ifneq ($(DEPS),) include $(DEPS) endif tcl8.6.14/compat/zlib/msdos/Makefile.tc0000644000175000017500000000514114554262142017260 0ustar sergeisergei# Makefile for zlib # Turbo C 2.01, Turbo C++ 1.01 # Last updated: 15-Mar-2003 # To use, do "make -fmakefile.tc" # To compile in small model, set below: MODEL=s # WARNING: the small model is supported but only for small values of # MAX_WBITS and MAX_MEM_LEVEL. For example: # -DMAX_WBITS=11 -DMAX_MEM_LEVEL=3 # If you wish to reduce the memory requirements (default 256K for big # objects plus a few K), you can add to CFLAGS below: # -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14 # See zconf.h for details about the memory requirements. # ------------ Turbo C 2.01, Turbo C++ 1.01 ------------ MODEL=l CC=tcc LD=tcc AR=tlib # CFLAGS=-O2 -G -Z -m$(MODEL) -DMAX_WBITS=11 -DMAX_MEM_LEVEL=3 CFLAGS=-O2 -G -Z -m$(MODEL) LDFLAGS=-m$(MODEL) -f- # variables ZLIB_LIB = zlib_$(MODEL).lib OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj # targets all: $(ZLIB_LIB) example.exe minigzip.exe .c.obj: $(CC) -c $(CFLAGS) $*.c adler32.obj: adler32.c zlib.h zconf.h compress.obj: compress.c zlib.h zconf.h crc32.obj: crc32.c zlib.h zconf.h crc32.h deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h gzread.obj: gzread.c zlib.h zconf.h gzguts.h gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h uncompr.obj: uncompr.c zlib.h zconf.h zutil.obj: zutil.c zutil.h zlib.h zconf.h example.obj: test/example.c zlib.h zconf.h minigzip.obj: test/minigzip.c zlib.h zconf.h # the command line is cut to fit in the MS-DOS 128 byte limit: $(ZLIB_LIB): $(OBJ1) $(OBJ2) -del $(ZLIB_LIB) $(AR) $(ZLIB_LIB) $(OBJP1) $(AR) $(ZLIB_LIB) $(OBJP2) example.exe: example.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB) minigzip.exe: minigzip.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB) test: example.exe minigzip.exe example echo hello world | minigzip | minigzip -d clean: -del *.obj -del *.lib -del *.exe -del zlib_*.bak -del foo.gz tcl8.6.14/compat/zlib/msdos/Makefile.msc0000644000175000017500000000555414554262142017444 0ustar sergeisergei# Makefile for zlib # Microsoft C 5.1 or later # Last updated: 19-Mar-2003 # To use, do "make makefile.msc" # To compile in small model, set below: MODEL=S # If you wish to reduce the memory requirements (default 256K for big # objects plus a few K), you can add to the LOC macro below: # -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14 # See zconf.h for details about the memory requirements. # ------------- Microsoft C 5.1 and later ------------- # Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7) # should be added to the environment via "set LOCAL_ZLIB=-DFOO" or added # to the declaration of LOC here: LOC = $(LOCAL_ZLIB) # Type for CPU required: 0: 8086, 1: 80186, 2: 80286, 3: 80386, etc. CPU_TYP = 0 # Memory model: one of S, M, C, L (small, medium, compact, large) MODEL=L CC=cl CFLAGS=-nologo -A$(MODEL) -G$(CPU_TYP) -W3 -Oait -Gs $(LOC) #-Ox generates bad code with MSC 5.1 LIB_CFLAGS=-Zl $(CFLAGS) LD=link LDFLAGS=/noi/e/st:0x1500/noe/farcall/packcode # "/farcall/packcode" are only useful for `large code' memory models # but should be a "no-op" for small code models. # variables ZLIB_LIB = zlib_$(MODEL).lib OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj # targets all: $(ZLIB_LIB) example.exe minigzip.exe .c.obj: $(CC) -c $(LIB_CFLAGS) $*.c adler32.obj: adler32.c zlib.h zconf.h compress.obj: compress.c zlib.h zconf.h crc32.obj: crc32.c zlib.h zconf.h crc32.h deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h gzread.obj: gzread.c zlib.h zconf.h gzguts.h gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h uncompr.obj: uncompr.c zlib.h zconf.h zutil.obj: zutil.c zutil.h zlib.h zconf.h example.obj: test/example.c zlib.h zconf.h $(CC) -c $(CFLAGS) $*.c minigzip.obj: test/minigzip.c zlib.h zconf.h $(CC) -c $(CFLAGS) $*.c # the command line is cut to fit in the MS-DOS 128 byte limit: $(ZLIB_LIB): $(OBJ1) $(OBJ2) if exist $(ZLIB_LIB) del $(ZLIB_LIB) lib $(ZLIB_LIB) $(OBJ1); lib $(ZLIB_LIB) $(OBJ2); example.exe: example.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) example.obj,,,$(ZLIB_LIB); minigzip.exe: minigzip.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) minigzip.obj,,,$(ZLIB_LIB); test: example.exe minigzip.exe example echo hello world | minigzip | minigzip -d clean: -del *.obj -del *.lib -del *.exe -del *.map -del zlib_*.bak -del foo.gz tcl8.6.14/compat/zlib/msdos/Makefile.bor0000644000175000017500000000603214554262142017434 0ustar sergeisergei# Makefile for zlib # Borland C++ # Last updated: 15-Mar-2003 # To use, do "make -fmakefile.bor" # To compile in small model, set below: MODEL=s # WARNING: the small model is supported but only for small values of # MAX_WBITS and MAX_MEM_LEVEL. For example: # -DMAX_WBITS=11 -DDEF_WBITS=11 -DMAX_MEM_LEVEL=3 # If you wish to reduce the memory requirements (default 256K for big # objects plus a few K), you can add to the LOC macro below: # -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14 # See zconf.h for details about the memory requirements. # ------------ Turbo C++, Borland C++ ------------ # Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7) # should be added to the environment via "set LOCAL_ZLIB=-DFOO" or added # to the declaration of LOC here: LOC = $(LOCAL_ZLIB) # type for CPU required: 0: 8086, 1: 80186, 2: 80286, 3: 80386, etc. CPU_TYP = 0 # memory model: one of s, m, c, l (small, medium, compact, large) MODEL=l # replace bcc with tcc for Turbo C++ 1.0, with bcc32 for the 32 bit version CC=bcc LD=bcc AR=tlib # compiler flags # replace "-O2" by "-O -G -a -d" for Turbo C++ 1.0 CFLAGS=-O2 -Z -m$(MODEL) $(LOC) LDFLAGS=-m$(MODEL) -f- # variables ZLIB_LIB = zlib_$(MODEL).lib OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj # targets all: $(ZLIB_LIB) example.exe minigzip.exe .c.obj: $(CC) -c $(CFLAGS) $*.c adler32.obj: adler32.c zlib.h zconf.h compress.obj: compress.c zlib.h zconf.h crc32.obj: crc32.c zlib.h zconf.h crc32.h deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h gzread.obj: gzread.c zlib.h zconf.h gzguts.h gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ inffast.h inffixed.h inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h uncompr.obj: uncompr.c zlib.h zconf.h zutil.obj: zutil.c zutil.h zlib.h zconf.h example.obj: test/example.c zlib.h zconf.h minigzip.obj: test/minigzip.c zlib.h zconf.h # the command line is cut to fit in the MS-DOS 128 byte limit: $(ZLIB_LIB): $(OBJ1) $(OBJ2) -del $(ZLIB_LIB) $(AR) $(ZLIB_LIB) $(OBJP1) $(AR) $(ZLIB_LIB) $(OBJP2) example.exe: example.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB) minigzip.exe: minigzip.obj $(ZLIB_LIB) $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB) test: example.exe minigzip.exe example echo hello world | minigzip | minigzip -d clean: -del *.obj -del *.lib -del *.exe -del zlib_*.bak -del foo.gz tcl8.6.14/compat/zlib/msdos/Makefile.dj20000644000175000017500000000507414554262142017336 0ustar sergeisergei# Makefile for zlib. Modified for djgpp v2.0 by F. J. Donahoe, 3/15/96. # Copyright (C) 1995-1998 Jean-loup Gailly. # For conditions of distribution and use, see copyright notice in zlib.h # To compile, or to compile and test, type: # # make -fmakefile.dj2; make test -fmakefile.dj2 # # To install libz.a, zconf.h and zlib.h in the djgpp directories, type: # # make install -fmakefile.dj2 # # after first defining LIBRARY_PATH and INCLUDE_PATH in djgpp.env as # in the sample below if the pattern of the DJGPP distribution is to # be followed. Remember that, while 'es around <=> are ignored in # makefiles, they are *not* in batch files or in djgpp.env. # - - - - - # [make] # INCLUDE_PATH=%\>;INCLUDE_PATH%%\DJDIR%\include # LIBRARY_PATH=%\>;LIBRARY_PATH%%\DJDIR%\lib # BUTT=-m486 # - - - - - # Alternately, these variables may be defined below, overriding the values # in djgpp.env, as # INCLUDE_PATH=c:\usr\include # LIBRARY_PATH=c:\usr\lib CC=gcc #CFLAGS=-MMD -O #CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7 #CFLAGS=-MMD -g -DZLIB_DEBUG CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \ -Wstrict-prototypes -Wmissing-prototypes # If cp.exe is available, replace "copy /Y" with "cp -fp" . CP=copy /Y # If gnu install.exe is available, replace $(CP) with ginstall. INSTALL=$(CP) # The default value of RM is "rm -f." If "rm.exe" is found, comment out: RM=del LDLIBS=-L. -lz LD=$(CC) -s -o LDSHARED=$(CC) INCL=zlib.h zconf.h LIBS=libz.a AR=ar rcs prefix=/usr/local exec_prefix = $(prefix) OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \ uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o OBJA = # to use the asm code: make OBJA=match.o TEST_OBJS = example.o minigzip.o all: example.exe minigzip.exe check: test test: all ./example echo hello world | .\minigzip | .\minigzip -d %.o : %.c $(CC) $(CFLAGS) -c $< -o $@ libz.a: $(OBJS) $(OBJA) $(AR) $@ $(OBJS) $(OBJA) %.exe : %.o $(LIBS) $(LD) $@ $< $(LDLIBS) # INCLUDE_PATH and LIBRARY_PATH were set for [make] in djgpp.env . .PHONY : uninstall clean install: $(INCL) $(LIBS) -@if not exist $(INCLUDE_PATH)\nul mkdir $(INCLUDE_PATH) -@if not exist $(LIBRARY_PATH)\nul mkdir $(LIBRARY_PATH) $(INSTALL) zlib.h $(INCLUDE_PATH) $(INSTALL) zconf.h $(INCLUDE_PATH) $(INSTALL) libz.a $(LIBRARY_PATH) uninstall: $(RM) $(INCLUDE_PATH)\zlib.h $(RM) $(INCLUDE_PATH)\zconf.h $(RM) $(LIBRARY_PATH)\libz.a clean: $(RM) *.d $(RM) *.o $(RM) *.exe $(RM) libz.a $(RM) foo.gz DEPS := $(wildcard *.d) ifneq ($(DEPS),) include $(DEPS) endif tcl8.6.14/compat/zlib/LICENSE0000644000175000017500000000175214560736524015106 0ustar sergeisergeiCopyright notice: (C) 1995-2022 Jean-loup Gailly and Mark Adler This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. Jean-loup Gailly Mark Adler jloup@gzip.org madler@alumni.caltech.edu tcl8.6.14/compat/zlib/old/0000755000175000017500000000000014566153412014645 5ustar sergeisergeitcl8.6.14/compat/zlib/old/descrip.mms0000644000175000017500000000301114554262142017005 0ustar sergeisergei# descrip.mms: MMS description file for building zlib on VMS # written by Martin P.J. Zinser cc_defs = c_deb = .ifdef __DECC__ pref = /prefix=all .endif OBJS = adler32.obj, compress.obj, crc32.obj, gzio.obj, uncompr.obj,\ deflate.obj, trees.obj, zutil.obj, inflate.obj, infblock.obj,\ inftrees.obj, infcodes.obj, infutil.obj, inffast.obj CFLAGS= $(C_DEB) $(CC_DEFS) $(PREF) all : example.exe minigzip.exe @ write sys$output " Example applications available" libz.olb : libz.olb($(OBJS)) @ write sys$output " libz available" example.exe : example.obj libz.olb link example,libz.olb/lib minigzip.exe : minigzip.obj libz.olb link minigzip,libz.olb/lib,x11vms:xvmsutils.olb/lib clean : delete *.obj;*,libz.olb;* # Other dependencies. adler32.obj : zutil.h zlib.h zconf.h compress.obj : zlib.h zconf.h crc32.obj : zutil.h zlib.h zconf.h deflate.obj : deflate.h zutil.h zlib.h zconf.h example.obj : zlib.h zconf.h gzio.obj : zutil.h zlib.h zconf.h infblock.obj : zutil.h zlib.h zconf.h infblock.h inftrees.h infcodes.h infutil.h infcodes.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h infcodes.h inffast.h inffast.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h inffast.h inflate.obj : zutil.h zlib.h zconf.h infblock.h inftrees.obj : zutil.h zlib.h zconf.h inftrees.h infutil.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h minigzip.obj : zlib.h zconf.h trees.obj : deflate.h zutil.h zlib.h zconf.h uncompr.obj : zlib.h zconf.h zutil.obj : zutil.h zlib.h zconf.h tcl8.6.14/compat/zlib/old/Makefile.emx0000644000175000017500000000266014554262142017077 0ustar sergeisergei# Makefile for zlib. Modified for emx/rsxnt by Chr. Spieler, 6/16/98. # Copyright (C) 1995-1998 Jean-loup Gailly. # For conditions of distribution and use, see copyright notice in zlib.h # To compile, or to compile and test, type: # # make -fmakefile.emx; make test -fmakefile.emx # CC=gcc -Zwin32 #CFLAGS=-MMD -O #CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7 #CFLAGS=-MMD -g -DZLIB_DEBUG CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \ -Wstrict-prototypes -Wmissing-prototypes # If cp.exe is available, replace "copy /Y" with "cp -fp" . CP=copy /Y # If gnu install.exe is available, replace $(CP) with ginstall. INSTALL=$(CP) # The default value of RM is "rm -f." If "rm.exe" is found, comment out: RM=del LDLIBS=-L. -lzlib LD=$(CC) -s -o LDSHARED=$(CC) INCL=zlib.h zconf.h LIBS=zlib.a AR=ar rcs prefix=/usr/local exec_prefix = $(prefix) OBJS = adler32.o compress.o crc32.o deflate.o gzclose.o gzlib.o gzread.o \ gzwrite.o infback.o inffast.o inflate.o inftrees.o trees.o uncompr.o zutil.o TEST_OBJS = example.o minigzip.o all: example.exe minigzip.exe test: all ./example echo hello world | .\minigzip | .\minigzip -d %.o : %.c $(CC) $(CFLAGS) -c $< -o $@ zlib.a: $(OBJS) $(AR) $@ $(OBJS) %.exe : %.o $(LIBS) $(LD) $@ $< $(LDLIBS) .PHONY : clean clean: $(RM) *.d $(RM) *.o $(RM) *.exe $(RM) zlib.a $(RM) foo.gz DEPS := $(wildcard *.d) ifneq ($(DEPS),) include $(DEPS) endif tcl8.6.14/compat/zlib/old/README0000644000175000017500000000020514554262142015520 0ustar sergeisergeiThis directory contains files that have not been updated for zlib 1.2.x (Volunteers are encouraged to help clean this up. Thanks.) tcl8.6.14/compat/zlib/old/visual-basic.txt0000644000175000017500000001365014560736524020002 0ustar sergeisergeiSee below some functions declarations for Visual Basic. Frequently Asked Question: Q: Each time I use the compress function I get the -5 error (not enough room in the output buffer). A: Make sure that the length of the compressed buffer is passed by reference ("as any"), not by value ("as long"). Also check that before the call of compress this length is equal to the total size of the compressed buffer and not zero. From: "Jon Caruana" Subject: Re: How to port zlib declares to vb? Date: Mon, 28 Oct 1996 18:33:03 -0600 Got the answer! (I haven't had time to check this but it's what I got, and looks correct): He has the following routines working: compress uncompress gzopen gzwrite gzread gzclose Declares follow: (Quoted from Carlos Rios , in Vb4 form) #If Win16 Then 'Use Win16 calls. Declare Function compress Lib "ZLIB.DLL" (ByVal compr As String, comprLen As Any, ByVal buf As String, ByVal buflen As Long) As Integer Declare Function uncompress Lib "ZLIB.DLL" (ByVal uncompr As String, uncomprLen As Any, ByVal compr As String, ByVal lcompr As Long) As Integer Declare Function gzopen Lib "ZLIB.DLL" (ByVal filePath As String, ByVal mode As String) As Long Declare Function gzread Lib "ZLIB.DLL" (ByVal file As Long, ByVal uncompr As String, ByVal uncomprLen As Integer) As Integer Declare Function gzwrite Lib "ZLIB.DLL" (ByVal file As Long, ByVal uncompr As String, ByVal uncomprLen As Integer) As Integer Declare Function gzclose Lib "ZLIB.DLL" (ByVal file As Long) As Integer #Else Declare Function compress Lib "ZLIB32.DLL" (ByVal compr As String, comprLen As Any, ByVal buf As String, ByVal buflen As Long) As Integer Declare Function uncompress Lib "ZLIB32.DLL" (ByVal uncompr As String, uncomprLen As Any, ByVal compr As String, ByVal lcompr As Long) As Long Declare Function gzopen Lib "ZLIB32.DLL" (ByVal file As String, ByVal mode As String) As Long Declare Function gzread Lib "ZLIB32.DLL" (ByVal file As Long, ByVal uncompr As String, ByVal uncomprLen As Long) As Long Declare Function gzwrite Lib "ZLIB32.DLL" (ByVal file As Long, ByVal uncompr As String, ByVal uncomprLen As Long) As Long Declare Function gzclose Lib "ZLIB32.DLL" (ByVal file As Long) As Long #End If -Jon Caruana jon-net@usa.net Microsoft Sitebuilder Network Level 1 Member - HTML Writer's Guild Member Here is another example from Michael that he says conforms to the VB guidelines, and that solves the problem of not knowing the uncompressed size by storing it at the end of the file: 'Calling the functions: 'bracket meaning: [optional] {Range of possible values} 'Call subCompressFile( [, , [level of compression {1..9}]]) 'Call subUncompressFile() Option Explicit Private lngpvtPcnSml As Long 'Stores value for 'lngPercentSmaller' Private Const SUCCESS As Long = 0 Private Const strFilExt As String = ".cpr" Private Declare Function lngfncCpr Lib "zlib.dll" Alias "compress2" (ByRef dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long, ByVal level As Integer) As Long Private Declare Function lngfncUcp Lib "zlib.dll" Alias "uncompress" (ByRef dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long) As Long Public Sub subCompressFile(ByVal strargOriFilPth As String, Optional ByVal strargCprFilPth As String, Optional ByVal intLvl As Integer = 9) Dim strCprPth As String Dim lngOriSiz As Long Dim lngCprSiz As Long Dim bytaryOri() As Byte Dim bytaryCpr() As Byte lngOriSiz = FileLen(strargOriFilPth) ReDim bytaryOri(lngOriSiz - 1) Open strargOriFilPth For Binary Access Read As #1 Get #1, , bytaryOri() Close #1 strCprPth = IIf(strargCprFilPth = "", strargOriFilPth, strargCprFilPth) 'Select file path and name strCprPth = strCprPth & IIf(Right(strCprPth, Len(strFilExt)) = strFilExt, "", strFilExt) 'Add file extension if not exists lngCprSiz = (lngOriSiz * 1.01) + 12 'Compression needs temporary a bit more space then original file size ReDim bytaryCpr(lngCprSiz - 1) If lngfncCpr(bytaryCpr(0), lngCprSiz, bytaryOri(0), lngOriSiz, intLvl) = SUCCESS Then lngpvtPcnSml = (1# - (lngCprSiz / lngOriSiz)) * 100 ReDim Preserve bytaryCpr(lngCprSiz - 1) Open strCprPth For Binary Access Write As #1 Put #1, , bytaryCpr() Put #1, , lngOriSiz 'Add the original size value to the end (last 4 bytes) Close #1 Else MsgBox "Compression error" End If Erase bytaryCpr Erase bytaryOri End Sub Public Sub subUncompressFile(ByVal strargFilPth As String) Dim bytaryCpr() As Byte Dim bytaryOri() As Byte Dim lngOriSiz As Long Dim lngCprSiz As Long Dim strOriPth As String lngCprSiz = FileLen(strargFilPth) ReDim bytaryCpr(lngCprSiz - 1) Open strargFilPth For Binary Access Read As #1 Get #1, , bytaryCpr() Close #1 'Read the original file size value: lngOriSiz = bytaryCpr(lngCprSiz - 1) * (2 ^ 24) _ + bytaryCpr(lngCprSiz - 2) * (2 ^ 16) _ + bytaryCpr(lngCprSiz - 3) * (2 ^ 8) _ + bytaryCpr(lngCprSiz - 4) ReDim Preserve bytaryCpr(lngCprSiz - 5) 'Cut of the original size value ReDim bytaryOri(lngOriSiz - 1) If lngfncUcp(bytaryOri(0), lngOriSiz, bytaryCpr(0), lngCprSiz) = SUCCESS Then strOriPth = Left(strargFilPth, Len(strargFilPth) - Len(strFilExt)) Open strOriPth For Binary Access Write As #1 Put #1, , bytaryOri() Close #1 Else MsgBox "Uncompression error" End If Erase bytaryCpr Erase bytaryOri End Sub Public Property Get lngPercentSmaller() As Long lngPercentSmaller = lngpvtPcnSml End Property tcl8.6.14/compat/zlib/old/os2/0000755000175000017500000000000014566153412015350 5ustar sergeisergeitcl8.6.14/compat/zlib/old/os2/zlib.def0000644000175000017500000000141214554262142016764 0ustar sergeisergei; ; Slightly modified version of ../nt/zlib.dnt :-) ; LIBRARY Z DESCRIPTION "Zlib compression library for OS/2" CODE PRELOAD MOVEABLE DISCARDABLE DATA PRELOAD MOVEABLE MULTIPLE EXPORTS adler32 compress crc32 deflate deflateCopy deflateEnd deflateInit2_ deflateInit_ deflateParams deflateReset deflateSetDictionary gzclose gzdopen gzerror gzflush gzopen gzread gzwrite inflate inflateEnd inflateInit2_ inflateInit_ inflateReset inflateSetDictionary inflateSync uncompress zlibVersion gzprintf gzputc gzgetc gzseek gzrewind gztell gzeof gzsetparams zError inflateSyncPoint get_crc_table compress2 gzputs gzgets tcl8.6.14/compat/zlib/old/os2/Makefile.os20000644000175000017500000001001514554262142017505 0ustar sergeisergei# Makefile for zlib under OS/2 using GCC (PGCC) # For conditions of distribution and use, see copyright notice in zlib.h # To compile and test, type: # cp Makefile.os2 .. # cd .. # make -f Makefile.os2 test # This makefile will build a static library z.lib, a shared library # z.dll and a import library zdll.lib. You can use either z.lib or # zdll.lib by specifying either -lz or -lzdll on gcc's command line CC=gcc -Zomf -s CFLAGS=-O6 -Wall #CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7 #CFLAGS=-g -DZLIB_DEBUG #CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \ # -Wstrict-prototypes -Wmissing-prototypes #################### BUG WARNING: ##################### ## infcodes.c hits a bug in pgcc-1.0, so you have to use either ## -O# where # <= 4 or one of (-fno-ommit-frame-pointer or -fno-force-mem) ## This bug is reportedly fixed in pgcc >1.0, but this was not tested CFLAGS+=-fno-force-mem LDFLAGS=-s -L. -lzdll -Zcrtdll LDSHARED=$(CC) -s -Zomf -Zdll -Zcrtdll VER=1.1.0 ZLIB=z.lib SHAREDLIB=z.dll SHAREDLIBIMP=zdll.lib LIBS=$(ZLIB) $(SHAREDLIB) $(SHAREDLIBIMP) AR=emxomfar cr IMPLIB=emximp RANLIB=echo TAR=tar SHELL=bash prefix=/usr/local exec_prefix = $(prefix) OBJS = adler32.o compress.o crc32.o gzio.o uncompr.o deflate.o trees.o \ zutil.o inflate.o infblock.o inftrees.o infcodes.o infutil.o inffast.o TEST_OBJS = example.o minigzip.o DISTFILES = README INDEX ChangeLog configure Make*[a-z0-9] *.[ch] descrip.mms \ algorithm.txt zlib.3 msdos/Make*[a-z0-9] msdos/zlib.def msdos/zlib.rc \ nt/Makefile.nt nt/zlib.dnt contrib/README.contrib contrib/*.txt \ contrib/asm386/*.asm contrib/asm386/*.c \ contrib/asm386/*.bat contrib/asm386/zlibvc.d?? contrib/iostream/*.cpp \ contrib/iostream/*.h contrib/iostream2/*.h contrib/iostream2/*.cpp \ contrib/untgz/Makefile contrib/untgz/*.c contrib/untgz/*.w32 all: example.exe minigzip.exe test: all @LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ; export LD_LIBRARY_PATH; \ echo hello world | ./minigzip | ./minigzip -d || \ echo ' *** minigzip test FAILED ***' ; \ if ./example; then \ echo ' *** zlib test OK ***'; \ else \ echo ' *** zlib test FAILED ***'; \ fi $(ZLIB): $(OBJS) $(AR) $@ $(OBJS) -@ ($(RANLIB) $@ || true) >/dev/null 2>&1 $(SHAREDLIB): $(OBJS) os2/z.def $(LDSHARED) -o $@ $^ $(SHAREDLIBIMP): os2/z.def $(IMPLIB) -o $@ $^ example.exe: example.o $(LIBS) $(CC) $(CFLAGS) -o $@ example.o $(LDFLAGS) minigzip.exe: minigzip.o $(LIBS) $(CC) $(CFLAGS) -o $@ minigzip.o $(LDFLAGS) clean: rm -f *.o *~ example minigzip libz.a libz.so* foo.gz distclean: clean zip: mv Makefile Makefile~; cp -p Makefile.in Makefile rm -f test.c ztest*.c v=`sed -n -e 's/\.//g' -e '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`;\ zip -ul9 zlib$$v $(DISTFILES) mv Makefile~ Makefile dist: mv Makefile Makefile~; cp -p Makefile.in Makefile rm -f test.c ztest*.c d=zlib-`sed -n '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`;\ rm -f $$d.tar.gz; \ if test ! -d ../$$d; then rm -f ../$$d; ln -s `pwd` ../$$d; fi; \ files=""; \ for f in $(DISTFILES); do files="$$files $$d/$$f"; done; \ cd ..; \ GZIP=-9 $(TAR) chofz $$d/$$d.tar.gz $$files; \ if test ! -d $$d; then rm -f $$d; fi mv Makefile~ Makefile tags: etags *.[ch] depend: makedepend -- $(CFLAGS) -- *.[ch] # DO NOT DELETE THIS LINE -- make depend depends on it. adler32.o: zlib.h zconf.h compress.o: zlib.h zconf.h crc32.o: zlib.h zconf.h deflate.o: deflate.h zutil.h zlib.h zconf.h example.o: zlib.h zconf.h gzio.o: zutil.h zlib.h zconf.h infblock.o: infblock.h inftrees.h infcodes.h infutil.h zutil.h zlib.h zconf.h infcodes.o: zutil.h zlib.h zconf.h infcodes.o: inftrees.h infblock.h infcodes.h infutil.h inffast.h inffast.o: zutil.h zlib.h zconf.h inftrees.h inffast.o: infblock.h infcodes.h infutil.h inffast.h inflate.o: zutil.h zlib.h zconf.h infblock.h inftrees.o: zutil.h zlib.h zconf.h inftrees.h infutil.o: zutil.h zlib.h zconf.h infblock.h inftrees.h infcodes.h infutil.h minigzip.o: zlib.h zconf.h trees.o: deflate.h zutil.h zlib.h zconf.h trees.h uncompr.o: zlib.h zconf.h zutil.o: zutil.h zlib.h zconf.h tcl8.6.14/compat/zlib/old/Makefile.riscos0000644000175000017500000000726714554262142017620 0ustar sergeisergei# Project: zlib_1_03 # Patched for zlib 1.1.2 rw@shadow.org.uk 19980430 # test works out-of-the-box, installs `somewhere' on demand # Toolflags: CCflags = -c -depend !Depend -IC: -g -throwback -DRISCOS -fah C++flags = -c -depend !Depend -IC: -throwback Linkflags = -aif -c++ -o $@ ObjAsmflags = -throwback -NoCache -depend !Depend CMHGflags = LibFileflags = -c -l -o $@ Squeezeflags = -o $@ # change the line below to where _you_ want the library installed. libdest = lib:zlib # Final targets: @.lib: @.o.adler32 @.o.compress @.o.crc32 @.o.deflate @.o.gzio \ @.o.infblock @.o.infcodes @.o.inffast @.o.inflate @.o.inftrees @.o.infutil @.o.trees \ @.o.uncompr @.o.zutil LibFile $(LibFileflags) @.o.adler32 @.o.compress @.o.crc32 @.o.deflate \ @.o.gzio @.o.infblock @.o.infcodes @.o.inffast @.o.inflate @.o.inftrees @.o.infutil \ @.o.trees @.o.uncompr @.o.zutil test: @.minigzip @.example @.lib @copy @.lib @.libc A~C~DF~L~N~P~Q~RS~TV @echo running tests: hang on. @/@.minigzip -f -9 libc @/@.minigzip -d libc-gz @/@.minigzip -f -1 libc @/@.minigzip -d libc-gz @/@.minigzip -h -9 libc @/@.minigzip -d libc-gz @/@.minigzip -h -1 libc @/@.minigzip -d libc-gz @/@.minigzip -9 libc @/@.minigzip -d libc-gz @/@.minigzip -1 libc @/@.minigzip -d libc-gz @diff @.lib @.libc @echo that should have reported '@.lib and @.libc identical' if you have diff. @/@.example @.fred @.fred @echo that will have given lots of hello!'s. @.minigzip: @.o.minigzip @.lib C:o.Stubs Link $(Linkflags) @.o.minigzip @.lib C:o.Stubs @.example: @.o.example @.lib C:o.Stubs Link $(Linkflags) @.o.example @.lib C:o.Stubs install: @.lib cdir $(libdest) cdir $(libdest).h @copy @.h.zlib $(libdest).h.zlib A~C~DF~L~N~P~Q~RS~TV @copy @.h.zconf $(libdest).h.zconf A~C~DF~L~N~P~Q~RS~TV @copy @.lib $(libdest).lib A~C~DF~L~N~P~Q~RS~TV @echo okay, installed zlib in $(libdest) clean:; remove @.minigzip remove @.example remove @.libc -wipe @.o.* F~r~cV remove @.fred # User-editable dependencies: .c.o: cc $(ccflags) -o $@ $< # Static dependencies: # Dynamic dependencies: o.example: c.example o.example: h.zlib o.example: h.zconf o.minigzip: c.minigzip o.minigzip: h.zlib o.minigzip: h.zconf o.adler32: c.adler32 o.adler32: h.zlib o.adler32: h.zconf o.compress: c.compress o.compress: h.zlib o.compress: h.zconf o.crc32: c.crc32 o.crc32: h.zlib o.crc32: h.zconf o.deflate: c.deflate o.deflate: h.deflate o.deflate: h.zutil o.deflate: h.zlib o.deflate: h.zconf o.gzio: c.gzio o.gzio: h.zutil o.gzio: h.zlib o.gzio: h.zconf o.infblock: c.infblock o.infblock: h.zutil o.infblock: h.zlib o.infblock: h.zconf o.infblock: h.infblock o.infblock: h.inftrees o.infblock: h.infcodes o.infblock: h.infutil o.infcodes: c.infcodes o.infcodes: h.zutil o.infcodes: h.zlib o.infcodes: h.zconf o.infcodes: h.inftrees o.infcodes: h.infblock o.infcodes: h.infcodes o.infcodes: h.infutil o.infcodes: h.inffast o.inffast: c.inffast o.inffast: h.zutil o.inffast: h.zlib o.inffast: h.zconf o.inffast: h.inftrees o.inffast: h.infblock o.inffast: h.infcodes o.inffast: h.infutil o.inffast: h.inffast o.inflate: c.inflate o.inflate: h.zutil o.inflate: h.zlib o.inflate: h.zconf o.inflate: h.infblock o.inftrees: c.inftrees o.inftrees: h.zutil o.inftrees: h.zlib o.inftrees: h.zconf o.inftrees: h.inftrees o.inftrees: h.inffixed o.infutil: c.infutil o.infutil: h.zutil o.infutil: h.zlib o.infutil: h.zconf o.infutil: h.infblock o.infutil: h.inftrees o.infutil: h.infcodes o.infutil: h.infutil o.trees: c.trees o.trees: h.deflate o.trees: h.zutil o.trees: h.zlib o.trees: h.zconf o.trees: h.trees o.uncompr: c.uncompr o.uncompr: h.zlib o.uncompr: h.zconf o.zutil: c.zutil o.zutil: h.zutil o.zutil: h.zlib o.zutil: h.zconf tcl8.6.14/libtommath/0000755000175000017500000000000014566153412014004 5ustar sergeisergeitcl8.6.14/libtommath/bn_cutoffs.c0000644000175000017500000000070114554262142016274 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_CUTOFFS_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef MP_FIXED_CUTOFFS #include "tommath_cutoffs.h" int KARATSUBA_MUL_CUTOFF = MP_DEFAULT_KARATSUBA_MUL_CUTOFF, KARATSUBA_SQR_CUTOFF = MP_DEFAULT_KARATSUBA_SQR_CUTOFF, TOOM_MUL_CUTOFF = MP_DEFAULT_TOOM_MUL_CUTOFF, TOOM_SQR_CUTOFF = MP_DEFAULT_TOOM_SQR_CUTOFF; #endif #endif tcl8.6.14/libtommath/bn_deprecated.c0000644000175000017500000001654114554262142016734 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_DEPRECATED_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifdef BN_MP_GET_BIT_C int mp_get_bit(const mp_int *a, int b) { if (b < 0) { return MP_VAL; } return (s_mp_get_bit(a, (unsigned int)b) == MP_YES) ? MP_YES : MP_NO; } #endif #ifdef BN_MP_JACOBI_C mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c) { if (a->sign == MP_NEG) { return MP_VAL; } if (mp_cmp_d(n, 0uL) != MP_GT) { return MP_VAL; } return mp_kronecker(a, n, c); } #endif #ifdef BN_MP_PRIME_RANDOM_EX_C mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat) { return s_mp_prime_random_ex(a, t, size, flags, cb, dat); } #endif #ifdef BN_MP_RAND_DIGIT_C mp_err mp_rand_digit(mp_digit *r) { mp_err err = s_mp_rand_source(r, sizeof(mp_digit)); *r &= MP_MASK; return err; } #endif #ifdef BN_FAST_MP_INVMOD_C mp_err fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) { return s_mp_invmod_fast(a, b, c); } #endif #ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C mp_err fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) { return s_mp_montgomery_reduce_fast(x, n, rho); } #endif #ifdef BN_FAST_S_MP_MUL_DIGS_C mp_err fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) { return s_mp_mul_digs_fast(a, b, c, digs); } #endif #ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C mp_err fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) { return s_mp_mul_high_digs_fast(a, b, c, digs); } #endif #ifdef BN_FAST_S_MP_SQR_C mp_err fast_s_mp_sqr(const mp_int *a, mp_int *b) { return s_mp_sqr_fast(a, b); } #endif #ifdef BN_MP_BALANCE_MUL_C mp_err mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c) { return s_mp_balance_mul(a, b, c); } #endif #ifdef BN_MP_EXPTMOD_FAST_C mp_err mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) { return s_mp_exptmod_fast(G, X, P, Y, redmode); } #endif #ifdef BN_MP_INVMOD_SLOW_C mp_err mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) { return s_mp_invmod_slow(a, b, c); } #endif #ifdef BN_MP_KARATSUBA_MUL_C mp_err mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) { return s_mp_karatsuba_mul(a, b, c); } #endif #ifdef BN_MP_KARATSUBA_SQR_C mp_err mp_karatsuba_sqr(const mp_int *a, mp_int *b) { return s_mp_karatsuba_sqr(a, b); } #endif #ifdef BN_MP_TOOM_MUL_C mp_err mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) { return s_mp_toom_mul(a, b, c); } #endif #ifdef BN_MP_TOOM_SQR_C mp_err mp_toom_sqr(const mp_int *a, mp_int *b) { return s_mp_toom_sqr(a, b); } #endif #ifdef S_MP_REVERSE_C void bn_reverse(unsigned char *s, int len) { if (len > 0) { s_mp_reverse(s, (size_t)len); } } #endif #ifdef BN_MP_TC_AND_C mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) { return mp_and(a, b, c); } #endif #ifdef BN_MP_TC_OR_C mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) { return mp_or(a, b, c); } #endif #ifdef BN_MP_TC_XOR_C mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) { return mp_xor(a, b, c); } #endif #ifdef BN_MP_TC_DIV_2D_C mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c) { return mp_signed_rsh(a, b, c); } #endif #ifdef BN_MP_INIT_SET_INT_C mp_err mp_init_set_int(mp_int *a, unsigned long b) { return mp_init_u32(a, (uint32_t)b); } #endif #ifdef BN_MP_SET_INT_C mp_err mp_set_int(mp_int *a, unsigned long b) { mp_set_u32(a, (uint32_t)b); return MP_OKAY; } #endif #ifdef BN_MP_SET_LONG_C mp_err mp_set_long(mp_int *a, unsigned long b) { mp_set_u64(a, b); return MP_OKAY; } #endif #ifdef BN_MP_SET_LONG_LONG_C mp_err mp_set_long_long(mp_int *a, unsigned long long b) { mp_set_u64(a, b); return MP_OKAY; } #endif #ifdef BN_MP_GET_INT_C unsigned long mp_get_int(const mp_int *a) { return (unsigned long)mp_get_mag_u32(a); } #endif #ifdef BN_MP_GET_LONG_C unsigned long mp_get_long(const mp_int *a) { return (unsigned long)mp_get_mag_ul(a); } #endif #ifdef BN_MP_GET_LONG_LONG_C unsigned long long mp_get_long_long(const mp_int *a) { return mp_get_mag_ull(a); } #endif #ifdef BN_MP_PRIME_IS_DIVISIBLE_C mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) { return s_mp_prime_is_divisible(a, result); } #endif #ifdef BN_MP_EXPT_D_EX_C mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) { (void)fast; if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { return MP_VAL; } return mp_expt_u32(a, (uint32_t)b, c); } #endif #ifdef BN_MP_EXPT_D_C mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) { if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { return MP_VAL; } return mp_expt_u32(a, (uint32_t)b, c); } #endif #ifdef BN_MP_N_ROOT_EX_C mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) { (void)fast; if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { return MP_VAL; } return mp_root_u32(a, (unsigned int)b, c); } #endif #ifdef BN_MP_N_ROOT_C mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) { if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { return MP_VAL; } return mp_root_u32(a, (unsigned int)b, c); } #endif #ifdef BN_MP_UNSIGNED_BIN_SIZE_C int mp_unsigned_bin_size(const mp_int *a) { return (int)mp_ubin_size(a); } #endif #ifdef BN_MP_READ_UNSIGNED_BIN_C mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) { return mp_from_ubin(a, b, (size_t) c); } #endif #ifdef BN_MP_TO_UNSIGNED_BIN_C mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) { return mp_to_ubin(a, b, SIZE_MAX, NULL); } #endif #ifdef BN_MP_TO_UNSIGNED_BIN_N_C mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) { size_t n = mp_ubin_size(a); if (*outlen < (unsigned long)n) { return MP_VAL; } *outlen = (unsigned long)n; return mp_to_ubin(a, b, n, NULL); } #endif #ifdef BN_MP_SIGNED_BIN_SIZE_C int mp_signed_bin_size(const mp_int *a) { return (int)mp_sbin_size(a); } #endif #ifdef BN_MP_READ_SIGNED_BIN_C mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) { return mp_from_sbin(a, b, (size_t) c); } #endif #ifdef BN_MP_TO_SIGNED_BIN_C mp_err mp_to_signed_bin(const mp_int *a, unsigned char *b) { return mp_to_sbin(a, b, SIZE_MAX, NULL); } #endif #ifdef BN_MP_TO_SIGNED_BIN_N_C mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) { size_t n = mp_sbin_size(a); if (*outlen < (unsigned long)n) { return MP_VAL; } *outlen = (unsigned long)n; return mp_to_sbin(a, b, n, NULL); } #endif #ifdef BN_MP_TORADIX_N_C mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) { if (maxlen < 0) { return MP_VAL; } return mp_to_radix(a, str, (size_t)maxlen, NULL, radix); } #endif #ifdef BN_MP_TORADIX_C mp_err mp_toradix(const mp_int *a, char *str, int radix) { return mp_to_radix(a, str, SIZE_MAX, NULL, radix); } #endif #ifdef BN_MP_IMPORT_C mp_err mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, const void *op) { return mp_unpack(rop, count, order, size, endian, nails, op); } #endif #ifdef BN_MP_EXPORT_C mp_err mp_export(void *rop, size_t *countp, int order, size_t size, int endian, size_t nails, const mp_int *op) { return mp_pack(rop, SIZE_MAX, countp, order, size, endian, nails, op); } #endif #endif tcl8.6.14/libtommath/bn_mp_2expt.c0000644000175000017500000000143014554262142016361 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_2EXPT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* computes a = 2**b * * Simple algorithm which zeroes the int, grows it then just sets one bit * as required. */ mp_err mp_2expt(mp_int *a, int b) { mp_err err; if (b < 0) { return MP_VAL; } /* zero a as per default */ mp_zero(a); /* grow a to accomodate the single bit */ if ((err = mp_grow(a, (b / MP_DIGIT_BIT) + 1)) != MP_OKAY) { return err; } /* set the used count of where the bit will go */ a->used = (b / MP_DIGIT_BIT) + 1; /* put the single bit in its place */ a->dp[b / MP_DIGIT_BIT] = (mp_digit)1 << (mp_digit)(b % MP_DIGIT_BIT); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_abs.c0000644000175000017500000000100714554262142016064 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ABS_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* b = |a| * * Simple function copies the input and fixes the sign to positive */ mp_err mp_abs(const mp_int *a, mp_int *b) { mp_err err; /* copy a to b */ if (a != b) { if ((err = mp_copy(a, b)) != MP_OKAY) { return err; } } /* force the sign of b to positive */ b->sign = MP_ZPOS; return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_add.c0000644000175000017500000000176014554262142016055 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ADD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* high level addition (handles signs) */ mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c) { mp_sign sa, sb; mp_err err; /* get sign of both inputs */ sa = a->sign; sb = b->sign; /* handle two cases, not four */ if (sa == sb) { /* both positive or both negative */ /* add their magnitudes, copy the sign */ c->sign = sa; err = s_mp_add(a, b, c); } else { /* one positive, the other negative */ /* subtract the one with the greater magnitude from */ /* the one of the lesser magnitude. The result gets */ /* the sign of the one with the greater magnitude. */ if (mp_cmp_mag(a, b) == MP_LT) { c->sign = sb; err = s_mp_sub(b, a, c); } else { c->sign = sa; err = s_mp_sub(a, b, c); } } return err; } #endif tcl8.6.14/libtommath/bn_mp_add_d.c0000644000175000017500000000354114554262142016357 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ADD_D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* single digit addition */ mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c) { mp_err err; int ix, oldused; mp_digit *tmpa, *tmpc; /* grow c as required */ if (c->alloc < (a->used + 1)) { if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) { return err; } } /* if a is negative and |a| >= b, call c = |a| - b */ if ((a->sign == MP_NEG) && ((a->used > 1) || (a->dp[0] >= b))) { mp_int a_ = *a; /* temporarily fix sign of a */ a_.sign = MP_ZPOS; /* c = |a| - b */ err = mp_sub_d(&a_, b, c); /* fix sign */ c->sign = MP_NEG; /* clamp */ mp_clamp(c); return err; } /* old number of used digits in c */ oldused = c->used; /* source alias */ tmpa = a->dp; /* destination alias */ tmpc = c->dp; /* if a is positive */ if (a->sign == MP_ZPOS) { /* add digits, mu is carry */ mp_digit mu = b; for (ix = 0; ix < a->used; ix++) { *tmpc = *tmpa++ + mu; mu = *tmpc >> MP_DIGIT_BIT; *tmpc++ &= MP_MASK; } /* set final carry */ ix++; *tmpc++ = mu; /* setup size */ c->used = a->used + 1; } else { /* a was negative and |a| < b */ c->used = 1; /* the result is a single digit */ if (a->used == 1) { *tmpc++ = b - a->dp[0]; } else { *tmpc++ = b; } /* setup count so the clearing of oldused * can fall through correctly */ ix = 1; } /* sign always positive */ c->sign = MP_ZPOS; /* now zero to oldused */ MP_ZERO_DIGITS(tmpc, oldused - ix); mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_addmod.c0000644000175000017500000000100014554262142016540 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ADDMOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* d = a + b (mod c) */ mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) { mp_err err; mp_int t; if ((err = mp_init(&t)) != MP_OKAY) { return err; } if ((err = mp_add(a, b, &t)) != MP_OKAY) { goto LBL_ERR; } err = mp_mod(&t, c, d); LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_and.c0000644000175000017500000000264214554262142016067 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_AND_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* two complement and */ mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c) { int used = MP_MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = ((a->sign == MP_NEG) && (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { if ((err = mp_grow(c, used)) != MP_OKAY) { return err; } } for (i = 0; i < used; i++) { mp_digit x, y; /* convert to two complement if negative */ if (a->sign == MP_NEG) { ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK); x = ac & MP_MASK; ac >>= MP_DIGIT_BIT; } else { x = (i >= a->used) ? 0uL : a->dp[i]; } /* convert to two complement if negative */ if (b->sign == MP_NEG) { bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK); y = bc & MP_MASK; bc >>= MP_DIGIT_BIT; } else { y = (i >= b->used) ? 0uL : b->dp[i]; } c->dp[i] = x & y; /* convert to to sign-magnitude if negative */ if (csign == MP_NEG) { cc += ~c->dp[i] & MP_MASK; c->dp[i] = cc & MP_MASK; cc >>= MP_DIGIT_BIT; } } c->used = used; c->sign = csign; mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_clamp.c0000644000175000017500000000124114554262142016413 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_CLAMP_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* trim unused digits * * This is used to ensure that leading zero digits are * trimed and the leading "used" digit will be non-zero * Typically very fast. Also fixes the sign if there * are no more leading digits */ void mp_clamp(mp_int *a) { /* decrease used while the most significant digit is * zero. */ while ((a->used > 0) && (a->dp[a->used - 1] == 0u)) { --(a->used); } /* reset the sign flag if used == 0 */ if (a->used == 0) { a->sign = MP_ZPOS; } } #endif tcl8.6.14/libtommath/bn_mp_clear.c0000644000175000017500000000076614554262142016420 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_CLEAR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* clear one (frees) */ void mp_clear(mp_int *a) { /* only do anything if a hasn't been freed previously */ if (a->dp != NULL) { /* free ram */ MP_FREE_DIGITS(a->dp, a->alloc); /* reset members to make debugging easier */ a->dp = NULL; a->alloc = a->used = 0; a->sign = MP_ZPOS; } } #endif tcl8.6.14/libtommath/bn_mp_clear_multi.c0000644000175000017500000000064114554262142017622 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_CLEAR_MULTI_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #include void mp_clear_multi(mp_int *mp, ...) { mp_int *next_mp = mp; va_list args; va_start(args, mp); while (next_mp != NULL) { mp_clear(next_mp); next_mp = va_arg(args, mp_int *); } va_end(args); } #endif tcl8.6.14/libtommath/bn_mp_cmp.c0000644000175000017500000000112514554262142016077 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_CMP_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* compare two ints (signed)*/ mp_ord mp_cmp(const mp_int *a, const mp_int *b) { /* compare based on sign */ if (a->sign != b->sign) { if (a->sign == MP_NEG) { return MP_LT; } else { return MP_GT; } } /* compare digits */ if (a->sign == MP_NEG) { /* if negative compare opposite direction */ return mp_cmp_mag(b, a); } else { return mp_cmp_mag(a, b); } } #endif tcl8.6.14/libtommath/bn_mp_cmp_d.c0000644000175000017500000000110414554262142016377 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_CMP_D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* compare a digit */ mp_ord mp_cmp_d(const mp_int *a, mp_digit b) { /* compare based on sign */ if (a->sign == MP_NEG) { return MP_LT; } /* compare based on magnitude */ if (a->used > 1) { return MP_GT; } /* compare the only digit of a to b */ if (a->dp[0] > b) { return MP_GT; } else if (a->dp[0] < b) { return MP_LT; } else { return MP_EQ; } } #endif tcl8.6.14/libtommath/bn_mp_cmp_mag.c0000644000175000017500000000145214554262142016726 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_CMP_MAG_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* compare maginitude of two ints (unsigned) */ mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b) { int n; const mp_digit *tmpa, *tmpb; /* compare based on # of non-zero digits */ if (a->used > b->used) { return MP_GT; } if (a->used < b->used) { return MP_LT; } /* alias for a */ tmpa = a->dp + (a->used - 1); /* alias for b */ tmpb = b->dp + (a->used - 1); /* compare based on digits */ for (n = 0; n < a->used; ++n, --tmpa, --tmpb) { if (*tmpa > *tmpb) { return MP_GT; } if (*tmpa < *tmpb) { return MP_LT; } } return MP_EQ; } #endif tcl8.6.14/libtommath/bn_mp_cnt_lsb.c0000644000175000017500000000142714554262142016751 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_CNT_LSB_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ static const int lnz[16] = { 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0 }; /* Counts the number of lsbs which are zero before the first zero bit */ int mp_cnt_lsb(const mp_int *a) { int x; mp_digit q, qq; /* easy out */ if (MP_IS_ZERO(a)) { return 0; } /* scan lower digits until non-zero */ for (x = 0; (x < a->used) && (a->dp[x] == 0u); x++) {} q = a->dp[x]; x *= MP_DIGIT_BIT; /* now scan this digit until a 1 is found */ if ((q & 1u) == 0u) { do { qq = q & 15u; x += lnz[qq]; q >>= 4; } while (qq == 0u); } return x; } #endif tcl8.6.14/libtommath/bn_mp_complement.c0000644000175000017500000000050514554262142017464 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_COMPLEMENT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* b = ~a */ mp_err mp_complement(const mp_int *a, mp_int *b) { mp_err err = mp_neg(a, b); return (err == MP_OKAY) ? mp_sub_d(b, 1uL, b) : err; } #endif tcl8.6.14/libtommath/bn_mp_copy.c0000644000175000017500000000160414554262142016274 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_COPY_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* copy, b = a */ mp_err mp_copy(const mp_int *a, mp_int *b) { int n; mp_digit *tmpa, *tmpb; mp_err err; /* if dst == src do nothing */ if (a == b) { return MP_OKAY; } /* grow dest */ if (b->alloc < a->used) { if ((err = mp_grow(b, a->used)) != MP_OKAY) { return err; } } /* zero b and copy the parameters over */ /* pointer aliases */ /* source */ tmpa = a->dp; /* destination */ tmpb = b->dp; /* copy all the digits */ for (n = 0; n < a->used; n++) { *tmpb++ = *tmpa++; } /* clear high digits */ MP_ZERO_DIGITS(tmpb, b->used - n); /* copy used count and sign */ b->used = a->used; b->sign = a->sign; return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_count_bits.c0000644000175000017500000000110014554262142017462 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_COUNT_BITS_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* returns the number of bits in an int */ int mp_count_bits(const mp_int *a) { int r; mp_digit q; /* shortcut */ if (MP_IS_ZERO(a)) { return 0; } /* get number of digits and add that */ r = (a->used - 1) * MP_DIGIT_BIT; /* take the last digit and count the bits in it */ q = a->dp[a->used - 1]; while (q > 0u) { ++r; q >>= 1u; } return r; } #endif tcl8.6.14/libtommath/bn_mp_decr.c0000644000175000017500000000142614554262142016241 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DECR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Decrement "a" by one like "a--". Changes input! */ mp_err mp_decr(mp_int *a) { if (MP_IS_ZERO(a)) { mp_set(a,1uL); a->sign = MP_NEG; return MP_OKAY; } else if (a->sign == MP_NEG) { mp_err err; a->sign = MP_ZPOS; if ((err = mp_incr(a)) != MP_OKAY) { return err; } /* There is no -0 in LTM */ if (!MP_IS_ZERO(a)) { a->sign = MP_NEG; } return MP_OKAY; } else if (a->dp[0] > 1uL) { a->dp[0]--; if (a->dp[0] == 0u) { mp_zero(a); } return MP_OKAY; } else { return mp_sub_d(a, 1uL,a); } } #endif tcl8.6.14/libtommath/bn_mp_div.c0000644000175000017500000001562614554262142016115 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DIV_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifdef BN_MP_DIV_SMALL /* slower bit-bang division... also smaller */ mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) { mp_int ta, tb, tq, q; int n, n2; mp_err err; /* is divisor zero ? */ if (MP_IS_ZERO(b)) { return MP_VAL; } /* if a < b then q=0, r = a */ if (mp_cmp_mag(a, b) == MP_LT) { if (d != NULL) { err = mp_copy(a, d); } else { err = MP_OKAY; } if (c != NULL) { mp_zero(c); } return err; } /* init our temps */ if ((err = mp_init_multi(&ta, &tb, &tq, &q, (void *)NULL)) != MP_OKAY) { return err; } mp_set(&tq, 1uL); n = mp_count_bits(a) - mp_count_bits(b); if ((err = mp_abs(a, &ta)) != MP_OKAY) goto LBL_ERR; if ((err = mp_abs(b, &tb)) != MP_OKAY) goto LBL_ERR; if ((err = mp_mul_2d(&tb, n, &tb)) != MP_OKAY) goto LBL_ERR; if ((err = mp_mul_2d(&tq, n, &tq)) != MP_OKAY) goto LBL_ERR; while (n-- >= 0) { if (mp_cmp(&tb, &ta) != MP_GT) { if ((err = mp_sub(&ta, &tb, &ta)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(&q, &tq, &q)) != MP_OKAY) goto LBL_ERR; } if ((err = mp_div_2d(&tb, 1, &tb, NULL)) != MP_OKAY) goto LBL_ERR; if ((err = mp_div_2d(&tq, 1, &tq, NULL)) != MP_OKAY) goto LBL_ERR; } /* now q == quotient and ta == remainder */ n = a->sign; n2 = (a->sign == b->sign) ? MP_ZPOS : MP_NEG; if (c != NULL) { mp_exch(c, &q); c->sign = MP_IS_ZERO(c) ? MP_ZPOS : n2; } if (d != NULL) { mp_exch(d, &ta); d->sign = MP_IS_ZERO(d) ? MP_ZPOS : n; } LBL_ERR: mp_clear_multi(&ta, &tb, &tq, &q, (void *)NULL); return err; } #else /* integer signed division. * c*b + d == a [e.g. a/b, c=quotient, d=remainder] * HAC pp.598 Algorithm 14.20 * * Note that the description in HAC is horribly * incomplete. For example, it doesn't consider * the case where digits are removed from 'x' in * the inner loop. It also doesn't consider the * case that y has fewer than three digits, etc.. * * The overall algorithm is as described as * 14.20 from HAC but fixed to treat these cases. */ mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) { mp_int q, x, y, t1, t2; int n, t, i, norm; mp_sign neg; mp_err err; /* is divisor zero ? */ if (MP_IS_ZERO(b)) { return MP_VAL; } /* if a < b then q=0, r = a */ if (mp_cmp_mag(a, b) == MP_LT) { if (d != NULL) { err = mp_copy(a, d); } else { err = MP_OKAY; } if (c != NULL) { mp_zero(c); } return err; } if ((err = mp_init_size(&q, a->used + 2)) != MP_OKAY) { return err; } q.used = a->used + 2; if ((err = mp_init(&t1)) != MP_OKAY) goto LBL_Q; if ((err = mp_init(&t2)) != MP_OKAY) goto LBL_T1; if ((err = mp_init_copy(&x, a)) != MP_OKAY) goto LBL_T2; if ((err = mp_init_copy(&y, b)) != MP_OKAY) goto LBL_X; /* fix the sign */ neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG; x.sign = y.sign = MP_ZPOS; /* normalize both x and y, ensure that y >= b/2, [b == 2**MP_DIGIT_BIT] */ norm = mp_count_bits(&y) % MP_DIGIT_BIT; if (norm < (MP_DIGIT_BIT - 1)) { norm = (MP_DIGIT_BIT - 1) - norm; if ((err = mp_mul_2d(&x, norm, &x)) != MP_OKAY) goto LBL_Y; if ((err = mp_mul_2d(&y, norm, &y)) != MP_OKAY) goto LBL_Y; } else { norm = 0; } /* note hac does 0 based, so if used==5 then its 0,1,2,3,4, e.g. use 4 */ n = x.used - 1; t = y.used - 1; /* while (x >= y*b**n-t) do { q[n-t] += 1; x -= y*b**{n-t} } */ /* y = y*b**{n-t} */ if ((err = mp_lshd(&y, n - t)) != MP_OKAY) goto LBL_Y; while (mp_cmp(&x, &y) != MP_LT) { ++(q.dp[n - t]); if ((err = mp_sub(&x, &y, &x)) != MP_OKAY) goto LBL_Y; } /* reset y by shifting it back down */ mp_rshd(&y, n - t); /* step 3. for i from n down to (t + 1) */ for (i = n; i >= (t + 1); i--) { if (i > x.used) { continue; } /* step 3.1 if xi == yt then set q{i-t-1} to b-1, * otherwise set q{i-t-1} to (xi*b + x{i-1})/yt */ if (x.dp[i] == y.dp[t]) { q.dp[(i - t) - 1] = ((mp_digit)1 << (mp_digit)MP_DIGIT_BIT) - (mp_digit)1; } else { mp_word tmp; tmp = (mp_word)x.dp[i] << (mp_word)MP_DIGIT_BIT; tmp |= (mp_word)x.dp[i - 1]; tmp /= (mp_word)y.dp[t]; if (tmp > (mp_word)MP_MASK) { tmp = MP_MASK; } q.dp[(i - t) - 1] = (mp_digit)(tmp & (mp_word)MP_MASK); } /* while (q{i-t-1} * (yt * b + y{t-1})) > xi * b**2 + xi-1 * b + xi-2 do q{i-t-1} -= 1; */ q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] + 1uL) & (mp_digit)MP_MASK; do { q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1uL) & (mp_digit)MP_MASK; /* find left hand */ mp_zero(&t1); t1.dp[0] = ((t - 1) < 0) ? 0u : y.dp[t - 1]; t1.dp[1] = y.dp[t]; t1.used = 2; if ((err = mp_mul_d(&t1, q.dp[(i - t) - 1], &t1)) != MP_OKAY) goto LBL_Y; /* find right hand */ t2.dp[0] = ((i - 2) < 0) ? 0u : x.dp[i - 2]; t2.dp[1] = x.dp[i - 1]; /* i >= 1 always holds */ t2.dp[2] = x.dp[i]; t2.used = 3; } while (mp_cmp_mag(&t1, &t2) == MP_GT); /* step 3.3 x = x - q{i-t-1} * y * b**{i-t-1} */ if ((err = mp_mul_d(&y, q.dp[(i - t) - 1], &t1)) != MP_OKAY) goto LBL_Y; if ((err = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY) goto LBL_Y; if ((err = mp_sub(&x, &t1, &x)) != MP_OKAY) goto LBL_Y; /* if x < 0 then { x = x + y*b**{i-t-1}; q{i-t-1} -= 1; } */ if (x.sign == MP_NEG) { if ((err = mp_copy(&y, &t1)) != MP_OKAY) goto LBL_Y; if ((err = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY) goto LBL_Y; if ((err = mp_add(&x, &t1, &x)) != MP_OKAY) goto LBL_Y; q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1uL) & MP_MASK; } } /* now q is the quotient and x is the remainder * [which we have to normalize] */ /* get sign before writing to c */ x.sign = (x.used == 0) ? MP_ZPOS : a->sign; if (c != NULL) { mp_clamp(&q); mp_exch(&q, c); c->sign = neg; } if (d != NULL) { if ((err = mp_div_2d(&x, norm, &x, NULL)) != MP_OKAY) goto LBL_Y; mp_exch(&x, d); } err = MP_OKAY; LBL_Y: mp_clear(&y); LBL_X: mp_clear(&x); LBL_T2: mp_clear(&t2); LBL_T1: mp_clear(&t1); LBL_Q: mp_clear(&q); return err; } #endif #endif tcl8.6.14/libtommath/bn_mp_div_2.c0000644000175000017500000000202714554262142016325 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DIV_2_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* b = a/2 */ mp_err mp_div_2(const mp_int *a, mp_int *b) { int x, oldused; mp_digit r, rr, *tmpa, *tmpb; mp_err err; /* copy */ if (b->alloc < a->used) { if ((err = mp_grow(b, a->used)) != MP_OKAY) { return err; } } oldused = b->used; b->used = a->used; /* source alias */ tmpa = a->dp + b->used - 1; /* dest alias */ tmpb = b->dp + b->used - 1; /* carry */ r = 0; for (x = b->used - 1; x >= 0; x--) { /* get the carry for the next iteration */ rr = *tmpa & 1u; /* shift the current digit, add in carry and store */ *tmpb-- = (*tmpa-- >> 1) | (r << (MP_DIGIT_BIT - 1)); /* forward carry to next iteration */ r = rr; } /* zero excess digits */ MP_ZERO_DIGITS(b->dp + b->used, oldused - b->used); b->sign = a->sign; mp_clamp(b); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_div_2d.c0000644000175000017500000000330014554262142016464 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DIV_2D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* shift right by a certain bit count (store quotient in c, optional remainder in d) */ mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) { mp_digit D, r, rr; int x; mp_err err; /* if the shift count is <= 0 then we do no work */ if (b <= 0) { err = mp_copy(a, c); if (d != NULL) { mp_zero(d); } return err; } /* copy */ if ((err = mp_copy(a, c)) != MP_OKAY) { return err; } /* 'a' should not be used after here - it might be the same as d */ /* get the remainder */ if (d != NULL) { if ((err = mp_mod_2d(a, b, d)) != MP_OKAY) { return err; } } /* shift by as many digits in the bit count */ if (b >= MP_DIGIT_BIT) { mp_rshd(c, b / MP_DIGIT_BIT); } /* shift any bit count < MP_DIGIT_BIT */ D = (mp_digit)(b % MP_DIGIT_BIT); if (D != 0u) { mp_digit *tmpc, mask, shift; /* mask */ mask = ((mp_digit)1 << D) - 1uL; /* shift for lsb */ shift = (mp_digit)MP_DIGIT_BIT - D; /* alias */ tmpc = c->dp + (c->used - 1); /* carry */ r = 0; for (x = c->used - 1; x >= 0; x--) { /* get the lower bits of this word in a temp */ rr = *tmpc & mask; /* shift the current word and mix in the carry bits from the previous word */ *tmpc = (*tmpc >> D) | (r << shift); --tmpc; /* set the carry to the carry bits of the current word found above */ r = rr; } } mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_div_3.c0000644000175000017500000000257214554262142016333 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DIV_3_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* divide by three (based on routine from MPI and the GMP manual) */ mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) { mp_int q; mp_word w, t; mp_digit b; mp_err err; int ix; /* b = 2**MP_DIGIT_BIT / 3 */ b = ((mp_word)1 << (mp_word)MP_DIGIT_BIT) / (mp_word)3; if ((err = mp_init_size(&q, a->used)) != MP_OKAY) { return err; } q.used = a->used; q.sign = a->sign; w = 0; for (ix = a->used - 1; ix >= 0; ix--) { w = (w << (mp_word)MP_DIGIT_BIT) | (mp_word)a->dp[ix]; if (w >= 3u) { /* multiply w by [1/3] */ t = (w * (mp_word)b) >> (mp_word)MP_DIGIT_BIT; /* now subtract 3 * [w/3] from w, to get the remainder */ w -= t+t+t; /* fixup the remainder as required since * the optimization is not exact. */ while (w >= 3u) { t += 1u; w -= 3u; } } else { t = 0; } q.dp[ix] = (mp_digit)t; } /* [optional] store the remainder */ if (d != NULL) { *d = (mp_digit)w; } /* [optional] store the quotient */ if (c != NULL) { mp_clamp(&q); mp_exch(&q, c); } mp_clear(&q); return err; } #endif tcl8.6.14/libtommath/bn_mp_div_d.c0000644000175000017500000000322314554262142016406 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DIV_D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* single digit division (based on routine from MPI) */ mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) { mp_int q; mp_word w; mp_digit t; mp_err err; int ix; /* cannot divide by zero */ if (b == 0u) { return MP_VAL; } /* quick outs */ if ((b == 1u) || MP_IS_ZERO(a)) { if (d != NULL) { *d = 0; } if (c != NULL) { return mp_copy(a, c); } return MP_OKAY; } /* power of two ? */ if ((b & (b - 1u)) == 0u) { ix = 1; while ((ix < MP_DIGIT_BIT) && (b != (((mp_digit)1)<dp[0] & (((mp_digit)1<<(mp_digit)ix) - 1uL); } if (c != NULL) { return mp_div_2d(a, ix, c, NULL); } return MP_OKAY; } /* three? */ if (MP_HAS(MP_DIV_3) && (b == 3u)) { return mp_div_3(a, c, d); } /* no easy answer [c'est la vie]. Just division */ if ((err = mp_init_size(&q, a->used)) != MP_OKAY) { return err; } q.used = a->used; q.sign = a->sign; w = 0; for (ix = a->used - 1; ix >= 0; ix--) { w = (w << (mp_word)MP_DIGIT_BIT) | (mp_word)a->dp[ix]; if (w >= b) { t = (mp_digit)(w / b); w -= (mp_word)t * (mp_word)b; } else { t = 0; } q.dp[ix] = t; } if (d != NULL) { *d = (mp_digit)w; } if (c != NULL) { mp_clamp(&q); mp_exch(&q, c); } mp_clear(&q); return err; } #endif tcl8.6.14/libtommath/bn_mp_dr_is_modulus.c0000644000175000017500000000114214554262142020167 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DR_IS_MODULUS_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* determines if a number is a valid DR modulus */ mp_bool mp_dr_is_modulus(const mp_int *a) { int ix; /* must be at least two digits */ if (a->used < 2) { return MP_NO; } /* must be of the form b**k - a [a <= b] so all * but the first digit must be equal to -1 (mod b). */ for (ix = 1; ix < a->used; ix++) { if (a->dp[ix] != MP_MASK) { return MP_NO; } } return MP_YES; } #endif tcl8.6.14/libtommath/bn_mp_dr_reduce.c0000644000175000017500000000373114554262142017261 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DR_REDUCE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* reduce "x" in place modulo "n" using the Diminished Radix algorithm. * * Based on algorithm from the paper * * "Generating Efficient Primes for Discrete Log Cryptosystems" * Chae Hoon Lim, Pil Joong Lee, * POSTECH Information Research Laboratories * * The modulus must be of a special format [see manual] * * Has been modified to use algorithm 7.10 from the LTM book instead * * Input x must be in the range 0 <= x <= (n-1)**2 */ mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) { mp_err err; int i, m; mp_word r; mp_digit mu, *tmpx1, *tmpx2; /* m = digits in modulus */ m = n->used; /* ensure that "x" has at least 2m digits */ if (x->alloc < (m + m)) { if ((err = mp_grow(x, m + m)) != MP_OKAY) { return err; } } /* top of loop, this is where the code resumes if * another reduction pass is required. */ top: /* aliases for digits */ /* alias for lower half of x */ tmpx1 = x->dp; /* alias for upper half of x, or x/B**m */ tmpx2 = x->dp + m; /* set carry to zero */ mu = 0; /* compute (x mod B**m) + k * [x/B**m] inline and inplace */ for (i = 0; i < m; i++) { r = ((mp_word)*tmpx2++ * (mp_word)k) + *tmpx1 + mu; *tmpx1++ = (mp_digit)(r & MP_MASK); mu = (mp_digit)(r >> ((mp_word)MP_DIGIT_BIT)); } /* set final carry */ *tmpx1++ = mu; /* zero words above m */ MP_ZERO_DIGITS(tmpx1, (x->used - m) - 1); /* clamp, sub and return */ mp_clamp(x); /* if x >= n then subtract and reduce again * Each successive "recursion" makes the input smaller and smaller. */ if (mp_cmp_mag(x, n) != MP_LT) { if ((err = s_mp_sub(x, n, x)) != MP_OKAY) { return err; } goto top; } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_dr_setup.c0000644000175000017500000000072314554262142017150 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_DR_SETUP_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* determines the setup value */ void mp_dr_setup(const mp_int *a, mp_digit *d) { /* the casts are required if MP_DIGIT_BIT is one less than * the number of bits in a mp_digit [e.g. MP_DIGIT_BIT==31] */ *d = (mp_digit)(((mp_word)1 << (mp_word)MP_DIGIT_BIT) - (mp_word)a->dp[0]); } #endif tcl8.6.14/libtommath/bn_mp_error_to_string.c0000644000175000017500000000117214554262142020543 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ERROR_TO_STRING_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* return a char * string for a given code */ const char *mp_error_to_string(mp_err code) { switch (code) { case MP_OKAY: return "Successful"; case MP_ERR: return "Unknown error"; case MP_MEM: return "Out of heap"; case MP_VAL: return "Value out of range"; case MP_ITER: return "Max. iterations reached"; case MP_BUF: return "Buffer overflow"; default: return "Invalid error code"; } } #endif tcl8.6.14/libtommath/bn_mp_exch.c0000644000175000017500000000055614554262142016256 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_EXCH_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* swap the elements of two integers, for cases where you can't simply swap the * mp_int pointers around */ void mp_exch(mp_int *a, mp_int *b) { mp_int t; t = *a; *a = *b; *b = t; } #endif tcl8.6.14/libtommath/bn_mp_expt_u32.c0000644000175000017500000000156214554262142016776 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_EXPT_U32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* calculate c = a**b using a square-multiply algorithm */ mp_err mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) { mp_err err; mp_int g; if ((err = mp_init_copy(&g, a)) != MP_OKAY) { return err; } /* set initial result */ mp_set(c, 1uL); while (b > 0u) { /* if the bit is set multiply */ if ((b & 1u) != 0u) { if ((err = mp_mul(c, &g, c)) != MP_OKAY) { goto LBL_ERR; } } /* square */ if (b > 1u) { if ((err = mp_sqr(&g, &g)) != MP_OKAY) { goto LBL_ERR; } } /* shift to next bit */ b >>= 1; } err = MP_OKAY; LBL_ERR: mp_clear(&g); return err; } #endif tcl8.6.14/libtommath/bn_mp_exptmod.c0000644000175000017500000000430514554262142017003 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_EXPTMOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* this is a shell function that calls either the normal or Montgomery * exptmod functions. Originally the call to the montgomery code was * embedded in the normal function but that wasted alot of stack space * for nothing (since 99% of the time the Montgomery code would be called) */ mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) { int dr; /* modulus P must be positive */ if (P->sign == MP_NEG) { return MP_VAL; } /* if exponent X is negative we have to recurse */ if (X->sign == MP_NEG) { mp_int tmpG, tmpX; mp_err err; if (!MP_HAS(MP_INVMOD)) { return MP_VAL; } if ((err = mp_init_multi(&tmpG, &tmpX, NULL)) != MP_OKAY) { return err; } /* first compute 1/G mod P */ if ((err = mp_invmod(G, P, &tmpG)) != MP_OKAY) { goto LBL_ERR; } /* now get |X| */ if ((err = mp_abs(X, &tmpX)) != MP_OKAY) { goto LBL_ERR; } /* and now compute (1/G)**|X| instead of G**X [X < 0] */ err = mp_exptmod(&tmpG, &tmpX, P, Y); LBL_ERR: mp_clear_multi(&tmpG, &tmpX, NULL); return err; } /* modified diminished radix reduction */ if (MP_HAS(MP_REDUCE_IS_2K_L) && MP_HAS(MP_REDUCE_2K_L) && MP_HAS(S_MP_EXPTMOD) && (mp_reduce_is_2k_l(P) == MP_YES)) { return s_mp_exptmod(G, X, P, Y, 1); } /* is it a DR modulus? default to no */ dr = (MP_HAS(MP_DR_IS_MODULUS) && (mp_dr_is_modulus(P) == MP_YES)) ? 1 : 0; /* if not, is it a unrestricted DR modulus? */ if (MP_HAS(MP_REDUCE_IS_2K) && (dr == 0)) { dr = (mp_reduce_is_2k(P) == MP_YES) ? 2 : 0; } /* if the modulus is odd or dr != 0 use the montgomery method */ if (MP_HAS(S_MP_EXPTMOD_FAST) && (MP_IS_ODD(P) || (dr != 0))) { return s_mp_exptmod_fast(G, X, P, Y, dr); } else if (MP_HAS(S_MP_EXPTMOD)) { /* otherwise use the generic Barrett reduction technique */ return s_mp_exptmod(G, X, P, Y, 0); } else { /* no exptmod for evens */ return MP_VAL; } } #endif tcl8.6.14/libtommath/bn_mp_exteuclid.c0000644000175000017500000000516514554262142017316 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_EXTEUCLID_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Extended euclidean algorithm of (a, b) produces a*u1 + b*u2 = u3 */ mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) { mp_int u1, u2, u3, v1, v2, v3, t1, t2, t3, q, tmp; mp_err err; if ((err = mp_init_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL)) != MP_OKAY) { return err; } /* initialize, (u1,u2,u3) = (1,0,a) */ mp_set(&u1, 1uL); if ((err = mp_copy(a, &u3)) != MP_OKAY) goto LBL_ERR; /* initialize, (v1,v2,v3) = (0,1,b) */ mp_set(&v2, 1uL); if ((err = mp_copy(b, &v3)) != MP_OKAY) goto LBL_ERR; /* loop while v3 != 0 */ while (!MP_IS_ZERO(&v3)) { /* q = u3/v3 */ if ((err = mp_div(&u3, &v3, &q, NULL)) != MP_OKAY) goto LBL_ERR; /* (t1,t2,t3) = (u1,u2,u3) - (v1,v2,v3)q */ if ((err = mp_mul(&v1, &q, &tmp)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&u1, &tmp, &t1)) != MP_OKAY) goto LBL_ERR; if ((err = mp_mul(&v2, &q, &tmp)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&u2, &tmp, &t2)) != MP_OKAY) goto LBL_ERR; if ((err = mp_mul(&v3, &q, &tmp)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&u3, &tmp, &t3)) != MP_OKAY) goto LBL_ERR; /* (u1,u2,u3) = (v1,v2,v3) */ if ((err = mp_copy(&v1, &u1)) != MP_OKAY) goto LBL_ERR; if ((err = mp_copy(&v2, &u2)) != MP_OKAY) goto LBL_ERR; if ((err = mp_copy(&v3, &u3)) != MP_OKAY) goto LBL_ERR; /* (v1,v2,v3) = (t1,t2,t3) */ if ((err = mp_copy(&t1, &v1)) != MP_OKAY) goto LBL_ERR; if ((err = mp_copy(&t2, &v2)) != MP_OKAY) goto LBL_ERR; if ((err = mp_copy(&t3, &v3)) != MP_OKAY) goto LBL_ERR; } /* make sure U3 >= 0 */ if (u3.sign == MP_NEG) { if ((err = mp_neg(&u1, &u1)) != MP_OKAY) goto LBL_ERR; if ((err = mp_neg(&u2, &u2)) != MP_OKAY) goto LBL_ERR; if ((err = mp_neg(&u3, &u3)) != MP_OKAY) goto LBL_ERR; } /* copy result out */ if (U1 != NULL) { mp_exch(U1, &u1); } if (U2 != NULL) { mp_exch(U2, &u2); } if (U3 != NULL) { mp_exch(U3, &u3); } err = MP_OKAY; LBL_ERR: mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL); return err; } #endif tcl8.6.14/libtommath/bn_mp_fread.c0000644000175000017500000000224714554262142016407 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_FREAD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef MP_NO_FILE /* read a bigint from a file stream in ASCII */ mp_err mp_fread(mp_int *a, int radix, FILE *stream) { mp_err err; mp_sign neg; /* if first digit is - then set negative */ int ch = fgetc(stream); if (ch == (int)'-') { neg = MP_NEG; ch = fgetc(stream); } else { neg = MP_ZPOS; } /* no digits, return error */ if (ch == EOF) { return MP_ERR; } /* clear a */ mp_zero(a); do { int y; unsigned pos = (unsigned)(ch - (int)'('); if (mp_s_rmap_reverse_sz < pos) { break; } y = (int)mp_s_rmap_reverse[pos]; if ((y == 0xff) || (y >= radix)) { break; } /* shift up and add */ if ((err = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) { return err; } if ((err = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) { return err; } } while ((ch = fgetc(stream)) != EOF); if (a->used != 0) { a->sign = neg; } return MP_OKAY; } #endif #endif tcl8.6.14/libtommath/bn_mp_from_sbin.c0000644000175000017500000000117314554262142017301 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_FROM_SBIN_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* read signed bin, big endian, first byte is 0==positive or 1==negative */ mp_err mp_from_sbin(mp_int *a, const unsigned char *buf, size_t size) { mp_err err; /* read magnitude */ if ((err = mp_from_ubin(a, buf + 1, size - 1u)) != MP_OKAY) { return err; } /* first byte is 0 for positive, non-zero for negative */ if (buf[0] == (unsigned char)0) { a->sign = MP_ZPOS; } else { a->sign = MP_NEG; } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_from_ubin.c0000644000175000017500000000155414554262142017306 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_FROM_UBIN_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* reads a unsigned char array, assumes the msb is stored first [big endian] */ mp_err mp_from_ubin(mp_int *a, const unsigned char *buf, size_t size) { mp_err err; /* make sure there are at least two digits */ if (a->alloc < 2) { if ((err = mp_grow(a, 2)) != MP_OKAY) { return err; } } /* zero the int */ mp_zero(a); /* read the bytes in */ while (size-- > 0u) { if ((err = mp_mul_2d(a, 8, a)) != MP_OKAY) { return err; } #ifndef MP_8BIT a->dp[0] |= *buf++; a->used += 1; #else a->dp[0] = (*buf & MP_MASK); a->dp[1] |= ((*buf++ >> 7) & 1u); a->used += 2; #endif } mp_clamp(a); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_fwrite.c0000644000175000017500000000174014554262142016623 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_FWRITE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef MP_NO_FILE mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) { char *buf; mp_err err; int len; size_t written; /* TODO: this function is not in this PR */ if (MP_HAS(MP_RADIX_SIZE_OVERESTIMATE)) { /* if ((err = mp_radix_size_overestimate(&t, base, &len)) != MP_OKAY) goto LBL_ERR; */ } else { if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) { return err; } } buf = (char *) MP_MALLOC((size_t)len); if (buf == NULL) { return MP_MEM; } if ((err = mp_to_radix(a, buf, (size_t)len, &written, radix)) != MP_OKAY) { goto LBL_ERR; } if (fwrite(buf, written, 1uL, stream) != 1uL) { err = MP_ERR; goto LBL_ERR; } err = MP_OKAY; LBL_ERR: MP_FREE_BUFFER(buf, (size_t)len); return err; } #endif #endif tcl8.6.14/libtommath/bn_mp_gcd.c0000644000175000017500000000417314554262142016063 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GCD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Greatest Common Divisor using the binary method */ mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c) { mp_int u, v; int k, u_lsb, v_lsb; mp_err err; /* either zero than gcd is the largest */ if (MP_IS_ZERO(a)) { return mp_abs(b, c); } if (MP_IS_ZERO(b)) { return mp_abs(a, c); } /* get copies of a and b we can modify */ if ((err = mp_init_copy(&u, a)) != MP_OKAY) { return err; } if ((err = mp_init_copy(&v, b)) != MP_OKAY) { goto LBL_U; } /* must be positive for the remainder of the algorithm */ u.sign = v.sign = MP_ZPOS; /* B1. Find the common power of two for u and v */ u_lsb = mp_cnt_lsb(&u); v_lsb = mp_cnt_lsb(&v); k = MP_MIN(u_lsb, v_lsb); if (k > 0) { /* divide the power of two out */ if ((err = mp_div_2d(&u, k, &u, NULL)) != MP_OKAY) { goto LBL_V; } if ((err = mp_div_2d(&v, k, &v, NULL)) != MP_OKAY) { goto LBL_V; } } /* divide any remaining factors of two out */ if (u_lsb != k) { if ((err = mp_div_2d(&u, u_lsb - k, &u, NULL)) != MP_OKAY) { goto LBL_V; } } if (v_lsb != k) { if ((err = mp_div_2d(&v, v_lsb - k, &v, NULL)) != MP_OKAY) { goto LBL_V; } } while (!MP_IS_ZERO(&v)) { /* make sure v is the largest */ if (mp_cmp_mag(&u, &v) == MP_GT) { /* swap u and v to make sure v is >= u */ mp_exch(&u, &v); } /* subtract smallest from largest */ if ((err = s_mp_sub(&v, &u, &v)) != MP_OKAY) { goto LBL_V; } /* Divide out all factors of two */ if ((err = mp_div_2d(&v, mp_cnt_lsb(&v), &v, NULL)) != MP_OKAY) { goto LBL_V; } } /* multiply by 2**k which we divided out at the beginning */ if ((err = mp_mul_2d(&u, k, c)) != MP_OKAY) { goto LBL_V; } c->sign = MP_ZPOS; err = MP_OKAY; LBL_V: mp_clear(&u); LBL_U: mp_clear(&v); return err; } #endif tcl8.6.14/libtommath/bn_mp_get_double.c0000644000175000017500000000066414554262142017440 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_DOUBLE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ double mp_get_double(const mp_int *a) { int i; double d = 0.0, fac = 1.0; for (i = 0; i < MP_DIGIT_BIT; ++i) { fac *= 2.0; } for (i = a->used; i --> 0;) { d = (d * fac) + (double)a->dp[i]; } return (a->sign == MP_NEG) ? -d : d; } #endif tcl8.6.14/libtommath/bn_mp_get_i32.c0000644000175000017500000000034714554262142016561 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_I32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_GET_SIGNED(mp_get_i32, mp_get_mag_u32, int32_t, uint32_t) #endif tcl8.6.14/libtommath/bn_mp_get_i64.c0000644000175000017500000000034714554262142016566 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_I64_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_GET_SIGNED(mp_get_i64, mp_get_mag_u64, int64_t, uint64_t) #endif tcl8.6.14/libtommath/bn_mp_get_l.c0000644000175000017500000000034414554262142016414 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_L_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_GET_SIGNED(mp_get_l, mp_get_mag_ul, long, unsigned long) #endif tcl8.6.14/libtommath/bn_mp_get_ll.c0000644000175000017500000000036114554262142016567 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_LL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_GET_SIGNED(mp_get_ll, mp_get_mag_ull, long long, unsigned long long) #endif tcl8.6.14/libtommath/bn_mp_get_mag_u32.c0000644000175000017500000000032314554262142017413 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_MAG_U32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_GET_MAG(mp_get_mag_u32, uint32_t) #endif tcl8.6.14/libtommath/bn_mp_get_mag_u64.c0000644000175000017500000000032314554262142017420 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_MAG_U64_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_GET_MAG(mp_get_mag_u64, uint64_t) #endif tcl8.6.14/libtommath/bn_mp_get_mag_ul.c0000644000175000017500000000032614554262142017425 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_MAG_UL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_GET_MAG(mp_get_mag_ul, unsigned long) #endif tcl8.6.14/libtommath/bn_mp_get_mag_ull.c0000644000175000017500000000033514554262142017601 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GET_MAG_ULL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_GET_MAG(mp_get_mag_ull, unsigned long long) #endif tcl8.6.14/libtommath/bn_mp_grow.c0000644000175000017500000000214714554262142016303 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_GROW_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* grow as required */ mp_err mp_grow(mp_int *a, int size) { int i; mp_digit *tmp; if (size < 0) { return MP_VAL; } /* if the alloc size is smaller alloc more ram */ if (a->alloc < size) { /* reallocate the array a->dp * * We store the return in a temporary variable * in case the operation failed we don't want * to overwrite the dp member of a. */ tmp = (mp_digit *) MP_REALLOC(a->dp, (size_t)a->alloc * sizeof(mp_digit), (size_t)size * sizeof(mp_digit)); if (tmp == NULL) { /* reallocation failed but "a" is still valid [can be freed] */ return MP_MEM; } /* reallocation succeeded so set a->dp */ a->dp = tmp; /* zero excess digits */ i = a->alloc; a->alloc = size; MP_ZERO_DIGITS(a->dp + i, a->alloc - i); } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_incr.c0000644000175000017500000000131614554262142016255 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INCR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Increment "a" by one like "a++". Changes input! */ mp_err mp_incr(mp_int *a) { if (MP_IS_ZERO(a)) { mp_set(a,1uL); return MP_OKAY; } else if (a->sign == MP_NEG) { mp_err err; a->sign = MP_ZPOS; if ((err = mp_decr(a)) != MP_OKAY) { return err; } /* There is no -0 in LTM */ if (!MP_IS_ZERO(a)) { a->sign = MP_NEG; } return MP_OKAY; } else if (a->dp[0] < MP_DIGIT_MAX) { a->dp[0]++; return MP_OKAY; } else { return mp_add_d(a, 1uL,a); } } #endif tcl8.6.14/libtommath/bn_mp_init.c0000644000175000017500000000107414554262142016266 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* init a new mp_int */ mp_err mp_init(mp_int *a) { /* allocate memory required and clear it */ a->dp = (mp_digit *) MP_CALLOC((size_t)MP_PREC, sizeof(mp_digit)); if (a->dp == NULL) { return MP_MEM; } /* set the used to zero, allocated digits to the default precision * and sign to positive */ a->used = 0; a->alloc = MP_PREC; a->sign = MP_ZPOS; return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_init_copy.c0000644000175000017500000000067514554262142017326 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_COPY_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* creates "a" then copies b into it */ mp_err mp_init_copy(mp_int *a, const mp_int *b) { mp_err err; if ((err = mp_init_size(a, b->used)) != MP_OKAY) { return err; } if ((err = mp_copy(b, a)) != MP_OKAY) { mp_clear(a); } return err; } #endif tcl8.6.14/libtommath/bn_mp_init_i32.c0000644000175000017500000000033114554262142016736 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_I32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_INIT_INT(mp_init_i32, mp_set_i32, int32_t) #endif tcl8.6.14/libtommath/bn_mp_init_i64.c0000644000175000017500000000033114554262142016743 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_I64_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_INIT_INT(mp_init_i64, mp_set_i64, int64_t) #endif tcl8.6.14/libtommath/bn_mp_init_l.c0000644000175000017500000000032014554262142016572 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_L_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_INIT_INT(mp_init_l, mp_set_l, long) #endif tcl8.6.14/libtommath/bn_mp_init_ll.c0000644000175000017500000000033014554262142016747 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_LL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_INIT_INT(mp_init_ll, mp_set_ll, long long) #endif tcl8.6.14/libtommath/bn_mp_init_multi.c0000644000175000017500000000217514554262142017503 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_MULTI_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #include mp_err mp_init_multi(mp_int *mp, ...) { mp_err err = MP_OKAY; /* Assume ok until proven otherwise */ int n = 0; /* Number of ok inits */ mp_int *cur_arg = mp; va_list args; va_start(args, mp); /* init args to next argument from caller */ while (cur_arg != NULL) { if (mp_init(cur_arg) != MP_OKAY) { /* Oops - error! Back-track and mp_clear what we already succeeded in init-ing, then return error. */ va_list clean_args; /* now start cleaning up */ cur_arg = mp; va_start(clean_args, mp); while (n-- != 0) { mp_clear(cur_arg); cur_arg = va_arg(clean_args, mp_int *); } va_end(clean_args); err = MP_MEM; break; } n++; cur_arg = va_arg(args, mp_int *); } va_end(args); return err; /* Assumed ok, if error flagged above. */ } #endif tcl8.6.14/libtommath/bn_mp_init_set.c0000644000175000017500000000055014554262142017137 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_SET_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* initialize and set a digit */ mp_err mp_init_set(mp_int *a, mp_digit b) { mp_err err; if ((err = mp_init(a)) != MP_OKAY) { return err; } mp_set(a, b); return err; } #endif tcl8.6.14/libtommath/bn_mp_init_size.c0000644000175000017500000000110714554262142017315 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_SIZE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* init an mp_init for a given size */ mp_err mp_init_size(mp_int *a, int size) { if (size < 0) { return MP_VAL; } size = MP_MAX(MP_MIN_PREC, size); /* alloc mem */ a->dp = (mp_digit *) MP_CALLOC((size_t)size, sizeof(mp_digit)); if (a->dp == NULL) { return MP_MEM; } /* set the members */ a->used = 0; a->alloc = size; a->sign = MP_ZPOS; return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_init_u32.c0000644000175000017500000000033214554262142016753 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_U32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_INIT_INT(mp_init_u32, mp_set_u32, uint32_t) #endif tcl8.6.14/libtommath/bn_mp_init_u64.c0000644000175000017500000000033214554262142016760 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_U64_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_INIT_INT(mp_init_u64, mp_set_u64, uint64_t) #endif tcl8.6.14/libtommath/bn_mp_init_ul.c0000644000175000017500000000033414554262142016764 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_UL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_INIT_INT(mp_init_ul, mp_set_ul, unsigned long) #endif tcl8.6.14/libtommath/bn_mp_init_ull.c0000644000175000017500000000034414554262142017141 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INIT_ULL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_INIT_INT(mp_init_ull, mp_set_ull, unsigned long long) #endif tcl8.6.14/libtommath/bn_mp_invmod.c0000644000175000017500000000121214554262142016611 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_INVMOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* hac 14.61, pp608 */ mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) { /* b cannot be negative and has to be >1 */ if ((b->sign == MP_NEG) || (mp_cmp_d(b, 1uL) != MP_GT)) { return MP_VAL; } /* if the modulus is odd we can use a faster routine instead */ if (MP_HAS(S_MP_INVMOD_FAST) && MP_IS_ODD(b)) { return s_mp_invmod_fast(a, b, c); } return MP_HAS(S_MP_INVMOD_SLOW) ? s_mp_invmod_slow(a, b, c) : MP_VAL; } #endif tcl8.6.14/libtommath/bn_mp_is_square.c0000644000175000017500000000552314554262142017321 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_IS_SQUARE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Check if remainders are possible squares - fast exclude non-squares */ static const char rem_128[128] = { 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1 }; static const char rem_105[105] = { 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1 }; /* Store non-zero to ret if arg is square, and zero if not */ mp_err mp_is_square(const mp_int *arg, mp_bool *ret) { mp_err err; mp_digit c; mp_int t; unsigned long r; /* Default to Non-square :) */ *ret = MP_NO; if (arg->sign == MP_NEG) { return MP_VAL; } if (MP_IS_ZERO(arg)) { return MP_OKAY; } /* First check mod 128 (suppose that MP_DIGIT_BIT is at least 7) */ if (rem_128[127u & arg->dp[0]] == (char)1) { return MP_OKAY; } /* Next check mod 105 (3*5*7) */ if ((err = mp_mod_d(arg, 105uL, &c)) != MP_OKAY) { return err; } if (rem_105[c] == (char)1) { return MP_OKAY; } if ((err = mp_init_u32(&t, 11u*13u*17u*19u*23u*29u*31u)) != MP_OKAY) { return err; } if ((err = mp_mod(arg, &t, &t)) != MP_OKAY) { goto LBL_ERR; } r = mp_get_u32(&t); /* Check for other prime modules, note it's not an ERROR but we must * free "t" so the easiest way is to goto LBL_ERR. We know that err * is already equal to MP_OKAY from the mp_mod call */ if (((1uL<<(r%11uL)) & 0x5C4uL) != 0uL) goto LBL_ERR; if (((1uL<<(r%13uL)) & 0x9E4uL) != 0uL) goto LBL_ERR; if (((1uL<<(r%17uL)) & 0x5CE8uL) != 0uL) goto LBL_ERR; if (((1uL<<(r%19uL)) & 0x4F50CuL) != 0uL) goto LBL_ERR; if (((1uL<<(r%23uL)) & 0x7ACCA0uL) != 0uL) goto LBL_ERR; if (((1uL<<(r%29uL)) & 0xC2EDD0CuL) != 0uL) goto LBL_ERR; if (((1uL<<(r%31uL)) & 0x6DE2B848uL) != 0uL) goto LBL_ERR; /* Final check - is sqr(sqrt(arg)) == arg ? */ if ((err = mp_sqrt(arg, &t)) != MP_OKAY) { goto LBL_ERR; } if ((err = mp_sqr(&t, &t)) != MP_OKAY) { goto LBL_ERR; } *ret = (mp_cmp_mag(&t, arg) == MP_EQ) ? MP_YES : MP_NO; LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_iseven.c0000644000175000017500000000037214554262142016614 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ISEVEN_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ mp_bool mp_iseven(const mp_int *a) { return MP_IS_EVEN(a) ? MP_YES : MP_NO; } #endif tcl8.6.14/libtommath/bn_mp_isodd.c0000644000175000017500000000036714554262142016431 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ISODD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ mp_bool mp_isodd(const mp_int *a) { return MP_IS_ODD(a) ? MP_YES : MP_NO; } #endif tcl8.6.14/libtommath/bn_mp_kronecker.c0000644000175000017500000000530314554262142017305 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_KRONECKER_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Kronecker symbol (a|p) Straightforward implementation of algorithm 1.4.10 in Henri Cohen: "A Course in Computational Algebraic Number Theory" @book{cohen2013course, title={A course in computational algebraic number theory}, author={Cohen, Henri}, volume={138}, year={2013}, publisher={Springer Science \& Business Media} } */ mp_err mp_kronecker(const mp_int *a, const mp_int *p, int *c) { mp_int a1, p1, r; mp_err err; int v, k; static const int table[8] = {0, 1, 0, -1, 0, -1, 0, 1}; if (MP_IS_ZERO(p)) { if ((a->used == 1) && (a->dp[0] == 1u)) { *c = 1; } else { *c = 0; } return MP_OKAY; } if (MP_IS_EVEN(a) && MP_IS_EVEN(p)) { *c = 0; return MP_OKAY; } if ((err = mp_init_copy(&a1, a)) != MP_OKAY) { return err; } if ((err = mp_init_copy(&p1, p)) != MP_OKAY) { goto LBL_KRON_0; } v = mp_cnt_lsb(&p1); if ((err = mp_div_2d(&p1, v, &p1, NULL)) != MP_OKAY) { goto LBL_KRON_1; } if ((v & 1) == 0) { k = 1; } else { k = table[a->dp[0] & 7u]; } if (p1.sign == MP_NEG) { p1.sign = MP_ZPOS; if (a1.sign == MP_NEG) { k = -k; } } if ((err = mp_init(&r)) != MP_OKAY) { goto LBL_KRON_1; } for (;;) { if (MP_IS_ZERO(&a1)) { if (mp_cmp_d(&p1, 1uL) == MP_EQ) { *c = k; goto LBL_KRON; } else { *c = 0; goto LBL_KRON; } } v = mp_cnt_lsb(&a1); if ((err = mp_div_2d(&a1, v, &a1, NULL)) != MP_OKAY) { goto LBL_KRON; } if ((v & 1) == 1) { k = k * table[p1.dp[0] & 7u]; } if (a1.sign == MP_NEG) { /* * Compute k = (-1)^((a1)*(p1-1)/4) * k * a1.dp[0] + 1 cannot overflow because the MSB * of the type mp_digit is not set by definition */ if (((a1.dp[0] + 1u) & p1.dp[0] & 2u) != 0u) { k = -k; } } else { /* compute k = (-1)^((a1-1)*(p1-1)/4) * k */ if ((a1.dp[0] & p1.dp[0] & 2u) != 0u) { k = -k; } } if ((err = mp_copy(&a1, &r)) != MP_OKAY) { goto LBL_KRON; } r.sign = MP_ZPOS; if ((err = mp_mod(&p1, &r, &a1)) != MP_OKAY) { goto LBL_KRON; } if ((err = mp_copy(&r, &p1)) != MP_OKAY) { goto LBL_KRON; } } LBL_KRON: mp_clear(&r); LBL_KRON_1: mp_clear(&p1); LBL_KRON_0: mp_clear(&a1); return err; } #endif tcl8.6.14/libtommath/bn_mp_lcm.c0000644000175000017500000000207314554262142016076 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_LCM_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* computes least common multiple as |a*b|/(a, b) */ mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) { mp_err err; mp_int t1, t2; if ((err = mp_init_multi(&t1, &t2, NULL)) != MP_OKAY) { return err; } /* t1 = get the GCD of the two inputs */ if ((err = mp_gcd(a, b, &t1)) != MP_OKAY) { goto LBL_T; } /* divide the smallest by the GCD */ if (mp_cmp_mag(a, b) == MP_LT) { /* store quotient in t2 such that t2 * b is the LCM */ if ((err = mp_div(a, &t1, &t2, NULL)) != MP_OKAY) { goto LBL_T; } err = mp_mul(b, &t2, c); } else { /* store quotient in t2 such that t2 * a is the LCM */ if ((err = mp_div(b, &t1, &t2, NULL)) != MP_OKAY) { goto LBL_T; } err = mp_mul(a, &t2, c); } /* fix the sign to positive */ c->sign = MP_ZPOS; LBL_T: mp_clear_multi(&t1, &t2, NULL); return err; } #endif tcl8.6.14/libtommath/bn_mp_log_u32.c0000644000175000017500000001006414554262142016574 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_LOG_U32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Compute log_{base}(a) */ static mp_word s_pow(mp_word base, mp_word exponent) { mp_word result = 1u; while (exponent != 0u) { if ((exponent & 1u) == 1u) { result *= base; } exponent >>= 1; base *= base; } return result; } static mp_digit s_digit_ilogb(mp_digit base, mp_digit n) { mp_word bracket_low = 1u, bracket_mid, bracket_high, N; mp_digit ret, high = 1u, low = 0uL, mid; if (n < base) { return 0uL; } if (n == base) { return 1uL; } bracket_high = (mp_word) base ; N = (mp_word) n; while (bracket_high < N) { low = high; bracket_low = bracket_high; high <<= 1; bracket_high *= bracket_high; } while (((mp_digit)(high - low)) > 1u) { mid = (low + high) >> 1; bracket_mid = bracket_low * s_pow(base, (mp_word)(mid - low)); if (N < bracket_mid) { high = mid ; bracket_high = bracket_mid ; } if (N > bracket_mid) { low = mid ; bracket_low = bracket_mid ; } if (N == bracket_mid) { return (mp_digit) mid; } } if (bracket_high == N) { ret = high; } else { ret = low; } return ret; } /* TODO: output could be "int" because the output of mp_radix_size is int, too, as is the output of mp_bitcount. With the same problem: max size is INT_MAX * MP_DIGIT not INT_MAX only! */ mp_err mp_log_u32(const mp_int *a, unsigned int base, unsigned int *c) { mp_err err; mp_ord cmp; unsigned int high, low, mid; mp_int bracket_low, bracket_high, bracket_mid, t, bi_base; err = MP_OKAY; if (a->sign == MP_NEG) { return MP_VAL; } if (MP_IS_ZERO(a)) { return MP_VAL; } if (base < 2u) { return MP_VAL; } /* A small shortcut for bases that are powers of two. */ if ((base & (base - 1u)) == 0u) { int y, bit_count; for (y=0; (y < 7) && ((base & 1u) == 0u); y++) { base >>= 1; } bit_count = mp_count_bits(a) - 1; *c = (unsigned int)(bit_count/y); return MP_OKAY; } if (a->used == 1) { *c = (unsigned int)s_digit_ilogb(base, a->dp[0]); return err; } cmp = mp_cmp_d(a, base); if ((cmp == MP_LT) || (cmp == MP_EQ)) { *c = cmp == MP_EQ; return err; } if ((err = mp_init_multi(&bracket_low, &bracket_high, &bracket_mid, &t, &bi_base, NULL)) != MP_OKAY) { return err; } low = 0u; mp_set(&bracket_low, 1uL); high = 1u; mp_set(&bracket_high, base); /* A kind of Giant-step/baby-step algorithm. Idea shamelessly stolen from https://programmingpraxis.com/2010/05/07/integer-logarithms/2/ The effect is asymptotic, hence needs benchmarks to test if the Giant-step should be skipped for small n. */ while (mp_cmp(&bracket_high, a) == MP_LT) { low = high; if ((err = mp_copy(&bracket_high, &bracket_low)) != MP_OKAY) { goto LBL_ERR; } high <<= 1; if ((err = mp_sqr(&bracket_high, &bracket_high)) != MP_OKAY) { goto LBL_ERR; } } mp_set(&bi_base, base); while ((high - low) > 1u) { mid = (high + low) >> 1; if ((err = mp_expt_u32(&bi_base, mid - low, &t)) != MP_OKAY) { goto LBL_ERR; } if ((err = mp_mul(&bracket_low, &t, &bracket_mid)) != MP_OKAY) { goto LBL_ERR; } cmp = mp_cmp(a, &bracket_mid); if (cmp == MP_LT) { high = mid; mp_exch(&bracket_mid, &bracket_high); } if (cmp == MP_GT) { low = mid; mp_exch(&bracket_mid, &bracket_low); } if (cmp == MP_EQ) { *c = mid; goto LBL_END; } } *c = (mp_cmp(&bracket_high, a) == MP_EQ) ? high : low; LBL_END: LBL_ERR: mp_clear_multi(&bracket_low, &bracket_high, &bracket_mid, &t, &bi_base, NULL); return err; } #endif tcl8.6.14/libtommath/bn_mp_lshd.c0000644000175000017500000000221614554262142016254 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_LSHD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* shift left a certain amount of digits */ mp_err mp_lshd(mp_int *a, int b) { int x; mp_err err; mp_digit *top, *bottom; /* if its less than zero return */ if (b <= 0) { return MP_OKAY; } /* no need to shift 0 around */ if (MP_IS_ZERO(a)) { return MP_OKAY; } /* grow to fit the new digits */ if (a->alloc < (a->used + b)) { if ((err = mp_grow(a, a->used + b)) != MP_OKAY) { return err; } } /* increment the used by the shift amount then copy upwards */ a->used += b; /* top */ top = a->dp + a->used - 1; /* base */ bottom = (a->dp + a->used - 1) - b; /* much like mp_rshd this is implemented using a sliding window * except the window goes the otherway around. Copying from * the bottom to the top. see bn_mp_rshd.c for more info. */ for (x = a->used - 1; x >= b; x--) { *top-- = *bottom--; } /* zero the lower digits */ MP_ZERO_DIGITS(a->dp, b); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_mod.c0000644000175000017500000000122114554262142016074 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* c = a mod b, 0 <= c < b if b > 0, b < c <= 0 if b < 0 */ mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c) { mp_int t; mp_err err; if ((err = mp_init_size(&t, b->used)) != MP_OKAY) { return err; } if ((err = mp_div(a, b, NULL, &t)) != MP_OKAY) { goto LBL_ERR; } if (MP_IS_ZERO(&t) || (t.sign == b->sign)) { err = MP_OKAY; mp_exch(&t, c); } else { err = mp_add(b, &t, c); } LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_mod_2d.c0000644000175000017500000000171314554262142016467 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MOD_2D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* calc a value mod 2**b */ mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c) { int x; mp_err err; /* if b is <= 0 then zero the int */ if (b <= 0) { mp_zero(c); return MP_OKAY; } /* if the modulus is larger than the value than return */ if (b >= (a->used * MP_DIGIT_BIT)) { return mp_copy(a, c); } /* copy */ if ((err = mp_copy(a, c)) != MP_OKAY) { return err; } /* zero digits above the last digit of the modulus */ x = (b / MP_DIGIT_BIT) + (((b % MP_DIGIT_BIT) == 0) ? 0 : 1); MP_ZERO_DIGITS(c->dp + x, c->used - x); /* clear the digit that is not completely outside/inside the modulus */ c->dp[b / MP_DIGIT_BIT] &= ((mp_digit)1 << (mp_digit)(b % MP_DIGIT_BIT)) - (mp_digit)1; mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_mod_d.c0000644000175000017500000000041114554262142016377 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MOD_D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c) { return mp_div_d(a, b, NULL, c); } #endif tcl8.6.14/libtommath/bn_mp_montgomery_calc_normalization.c0000644000175000017500000000216014554262142023450 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MONTGOMERY_CALC_NORMALIZATION_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* * shifts with subtractions when the result is greater than b. * * The method is slightly modified to shift B unconditionally upto just under * the leading bit of b. This saves alot of multiple precision shifting. */ mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) { int x, bits; mp_err err; /* how many bits of last digit does b use */ bits = mp_count_bits(b) % MP_DIGIT_BIT; if (b->used > 1) { if ((err = mp_2expt(a, ((b->used - 1) * MP_DIGIT_BIT) + bits - 1)) != MP_OKAY) { return err; } } else { mp_set(a, 1uL); bits = 1; } /* now compute C = A * B mod b */ for (x = bits - 1; x < (int)MP_DIGIT_BIT; x++) { if ((err = mp_mul_2(a, a)) != MP_OKAY) { return err; } if (mp_cmp_mag(a, b) != MP_LT) { if ((err = s_mp_sub(a, b, a)) != MP_OKAY) { return err; } } } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_montgomery_reduce.c0000644000175000017500000000524714554262142021060 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MONTGOMERY_REDUCE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* computes xR**-1 == x (mod N) via Montgomery Reduction */ mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) { int ix, digs; mp_err err; mp_digit mu; /* can the fast reduction [comba] method be used? * * Note that unlike in mul you're safely allowed *less* * than the available columns [255 per default] since carries * are fixed up in the inner loop. */ digs = (n->used * 2) + 1; if ((digs < MP_WARRAY) && (x->used <= MP_WARRAY) && (n->used < MP_MAXFAST)) { return s_mp_montgomery_reduce_fast(x, n, rho); } /* grow the input as required */ if (x->alloc < digs) { if ((err = mp_grow(x, digs)) != MP_OKAY) { return err; } } x->used = digs; for (ix = 0; ix < n->used; ix++) { /* mu = ai * rho mod b * * The value of rho must be precalculated via * montgomery_setup() such that * it equals -1/n0 mod b this allows the * following inner loop to reduce the * input one digit at a time */ mu = (mp_digit)(((mp_word)x->dp[ix] * (mp_word)rho) & MP_MASK); /* a = a + mu * m * b**i */ { int iy; mp_digit *tmpn, *tmpx, u; mp_word r; /* alias for digits of the modulus */ tmpn = n->dp; /* alias for the digits of x [the input] */ tmpx = x->dp + ix; /* set the carry to zero */ u = 0; /* Multiply and add in place */ for (iy = 0; iy < n->used; iy++) { /* compute product and sum */ r = ((mp_word)mu * (mp_word)*tmpn++) + (mp_word)u + (mp_word)*tmpx; /* get carry */ u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); /* fix digit */ *tmpx++ = (mp_digit)(r & (mp_word)MP_MASK); } /* At this point the ix'th digit of x should be zero */ /* propagate carries upwards as required*/ while (u != 0u) { *tmpx += u; u = *tmpx >> MP_DIGIT_BIT; *tmpx++ &= MP_MASK; } } } /* at this point the n.used'th least * significant digits of x are all zero * which means we can shift x to the * right by n.used digits and the * residue is unchanged. */ /* x = x/b**n.used */ mp_clamp(x); mp_rshd(x, n->used); /* if x >= n then x = x - n */ if (mp_cmp_mag(x, n) != MP_LT) { return s_mp_sub(x, n, x); } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_montgomery_setup.c0000644000175000017500000000222014554262142020735 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MONTGOMERY_SETUP_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* setups the montgomery reduction stuff */ mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) { mp_digit x, b; /* fast inversion mod 2**k * * Based on the fact that * * XA = 1 (mod 2**n) => (X(2-XA)) A = 1 (mod 2**2n) * => 2*X*A - X*X*A*A = 1 * => 2*(1) - (1) = 1 */ b = n->dp[0]; if ((b & 1u) == 0u) { return MP_VAL; } x = (((b + 2u) & 4u) << 1) + b; /* here x*a==1 mod 2**4 */ x *= 2u - (b * x); /* here x*a==1 mod 2**8 */ #if !defined(MP_8BIT) x *= 2u - (b * x); /* here x*a==1 mod 2**16 */ #endif #if defined(MP_64BIT) || !(defined(MP_8BIT) || defined(MP_16BIT)) x *= 2u - (b * x); /* here x*a==1 mod 2**32 */ #endif #ifdef MP_64BIT x *= 2u - (b * x); /* here x*a==1 mod 2**64 */ #endif /* rho = -1/m mod b */ *rho = (mp_digit)(((mp_word)1 << (mp_word)MP_DIGIT_BIT) - x) & MP_MASK; return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_mul.c0000644000175000017500000000413314554262142016117 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MUL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* high level multiplication (handles sign) */ mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) { mp_err err; int min_len = MP_MIN(a->used, b->used), max_len = MP_MAX(a->used, b->used), digs = a->used + b->used + 1; mp_sign neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG; if (a == b) { return mp_sqr(a,c); } else if (MP_HAS(S_MP_BALANCE_MUL) && /* Check sizes. The smaller one needs to be larger than the Karatsuba cut-off. * The bigger one needs to be at least about one MP_KARATSUBA_MUL_CUTOFF bigger * to make some sense, but it depends on architecture, OS, position of the * stars... so YMMV. * Using it to cut the input into slices small enough for s_mp_mul_digs_fast * was actually slower on the author's machine, but YMMV. */ (min_len >= MP_KARATSUBA_MUL_CUTOFF) && ((max_len / 2) >= MP_KARATSUBA_MUL_CUTOFF) && /* Not much effect was observed below a ratio of 1:2, but again: YMMV. */ (max_len >= (2 * min_len))) { err = s_mp_balance_mul(a,b,c); } else if (MP_HAS(S_MP_TOOM_MUL) && (min_len >= MP_TOOM_MUL_CUTOFF)) { err = s_mp_toom_mul(a, b, c); } else if (MP_HAS(S_MP_KARATSUBA_MUL) && (min_len >= MP_KARATSUBA_MUL_CUTOFF)) { err = s_mp_karatsuba_mul(a, b, c); } else if (MP_HAS(S_MP_MUL_DIGS_FAST) && /* can we use the fast multiplier? * * The fast multiplier can be used if the output will * have less than MP_WARRAY digits and the number of * digits won't affect carry propagation */ (digs < MP_WARRAY) && (min_len <= MP_MAXFAST)) { err = s_mp_mul_digs_fast(a, b, c, digs); } else if (MP_HAS(S_MP_MUL_DIGS)) { err = s_mp_mul_digs(a, b, c, digs); } else { err = MP_VAL; } c->sign = (c->used > 0) ? neg : MP_ZPOS; return err; } #endif tcl8.6.14/libtommath/bn_mp_mul_2.c0000644000175000017500000000270714554262142016345 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MUL_2_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* b = a*2 */ mp_err mp_mul_2(const mp_int *a, mp_int *b) { int x, oldused; mp_err err; /* grow to accomodate result */ if (b->alloc < (a->used + 1)) { if ((err = mp_grow(b, a->used + 1)) != MP_OKAY) { return err; } } oldused = b->used; b->used = a->used; { mp_digit r, rr, *tmpa, *tmpb; /* alias for source */ tmpa = a->dp; /* alias for dest */ tmpb = b->dp; /* carry */ r = 0; for (x = 0; x < a->used; x++) { /* get what will be the *next* carry bit from the * MSB of the current digit */ rr = *tmpa >> (mp_digit)(MP_DIGIT_BIT - 1); /* now shift up this digit, add in the carry [from the previous] */ *tmpb++ = ((*tmpa++ << 1uL) | r) & MP_MASK; /* copy the carry that would be from the source * digit into the next iteration */ r = rr; } /* new leading digit? */ if (r != 0u) { /* add a MSB which is always 1 at this point */ *tmpb = 1; ++(b->used); } /* now zero any excess digits on the destination * that we didn't write to */ MP_ZERO_DIGITS(b->dp + b->used, oldused - b->used); } b->sign = a->sign; return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_mul_2d.c0000644000175000017500000000316414554262142016507 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MUL_2D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* shift left by a certain bit count */ mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) { mp_digit d; mp_err err; if (b < 0) { return MP_VAL; } /* copy */ if (a != c) { if ((err = mp_copy(a, c)) != MP_OKAY) { return err; } } if (c->alloc < (c->used + (b / MP_DIGIT_BIT) + 1)) { if ((err = mp_grow(c, c->used + (b / MP_DIGIT_BIT) + 1)) != MP_OKAY) { return err; } } /* shift by as many digits in the bit count */ if (b >= MP_DIGIT_BIT) { if ((err = mp_lshd(c, b / MP_DIGIT_BIT)) != MP_OKAY) { return err; } } /* shift any bit count < MP_DIGIT_BIT */ d = (mp_digit)(b % MP_DIGIT_BIT); if (d != 0u) { mp_digit *tmpc, shift, mask, r, rr; int x; /* bitmask for carries */ mask = ((mp_digit)1 << d) - (mp_digit)1; /* shift for msbs */ shift = (mp_digit)MP_DIGIT_BIT - d; /* alias */ tmpc = c->dp; /* carry */ r = 0; for (x = 0; x < c->used; x++) { /* get the higher bits of the current word */ rr = (*tmpc >> shift) & mask; /* shift the current word and OR in the carry */ *tmpc = ((*tmpc << d) | r) & MP_MASK; ++tmpc; /* set the carry to the carry bits of the current word */ r = rr; } /* set final carry */ if (r != 0u) { c->dp[(c->used)++] = r; } } mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_mul_d.c0000644000175000017500000000257714554262142016434 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MUL_D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* multiply by a digit */ mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c) { mp_digit u, *tmpa, *tmpc; mp_word r; mp_err err; int ix, olduse; /* make sure c is big enough to hold a*b */ if (c->alloc < (a->used + 1)) { if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) { return err; } } /* get the original destinations used count */ olduse = c->used; /* set the sign */ c->sign = a->sign; /* alias for a->dp [source] */ tmpa = a->dp; /* alias for c->dp [dest] */ tmpc = c->dp; /* zero carry */ u = 0; /* compute columns */ for (ix = 0; ix < a->used; ix++) { /* compute product and carry sum for this term */ r = (mp_word)u + ((mp_word)*tmpa++ * (mp_word)b); /* mask off higher bits to get a single digit */ *tmpc++ = (mp_digit)(r & (mp_word)MP_MASK); /* send carry into next iteration */ u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } /* store final carry [if any] and increment ix offset */ *tmpc++ = u; ++ix; /* now zero digits above the top */ MP_ZERO_DIGITS(tmpc, olduse - ix); /* set used count */ c->used = a->used + 1; mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_mulmod.c0000644000175000017500000000101414554262142016612 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_MULMOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* d = a * b (mod c) */ mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) { mp_err err; mp_int t; if ((err = mp_init_size(&t, c->used)) != MP_OKAY) { return err; } if ((err = mp_mul(a, b, &t)) != MP_OKAY) { goto LBL_ERR; } err = mp_mod(&t, c, d); LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_neg.c0000644000175000017500000000074214554262142016075 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_NEG_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* b = -a */ mp_err mp_neg(const mp_int *a, mp_int *b) { mp_err err; if (a != b) { if ((err = mp_copy(a, b)) != MP_OKAY) { return err; } } if (!MP_IS_ZERO(b)) { b->sign = (a->sign == MP_ZPOS) ? MP_NEG : MP_ZPOS; } else { b->sign = MP_ZPOS; } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_or.c0000644000175000017500000000263714554262142015751 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_OR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* two complement or */ mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c) { int used = MP_MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = ((a->sign == MP_NEG) || (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { if ((err = mp_grow(c, used)) != MP_OKAY) { return err; } } for (i = 0; i < used; i++) { mp_digit x, y; /* convert to two complement if negative */ if (a->sign == MP_NEG) { ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK); x = ac & MP_MASK; ac >>= MP_DIGIT_BIT; } else { x = (i >= a->used) ? 0uL : a->dp[i]; } /* convert to two complement if negative */ if (b->sign == MP_NEG) { bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK); y = bc & MP_MASK; bc >>= MP_DIGIT_BIT; } else { y = (i >= b->used) ? 0uL : b->dp[i]; } c->dp[i] = x | y; /* convert to to sign-magnitude if negative */ if (csign == MP_NEG) { cc += ~c->dp[i] & MP_MASK; c->dp[i] = cc & MP_MASK; cc >>= MP_DIGIT_BIT; } } c->used = used; c->sign = csign; mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_pack.c0000644000175000017500000000335414554262142016244 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PACK_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* based on gmp's mpz_export. * see http://gmplib.org/manual/Integer-Import-and-Export.html */ mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op) { mp_err err; size_t odd_nails, nail_bytes, i, j, count; unsigned char odd_nail_mask; mp_int t; count = mp_pack_count(op, nails, size); if (count > maxcount) { return MP_BUF; } if ((err = mp_init_copy(&t, op)) != MP_OKAY) { return err; } if (endian == MP_NATIVE_ENDIAN) { MP_GET_ENDIANNESS(endian); } odd_nails = (nails % 8u); odd_nail_mask = 0xff; for (i = 0u; i < odd_nails; ++i) { odd_nail_mask ^= (unsigned char)(1u << (7u - i)); } nail_bytes = nails / 8u; for (i = 0u; i < count; ++i) { for (j = 0u; j < size; ++j) { unsigned char *byte = (unsigned char *)rop + (((order == MP_LSB_FIRST) ? i : ((count - 1u) - i)) * size) + ((endian == MP_LITTLE_ENDIAN) ? j : ((size - 1u) - j)); if (j >= (size - nail_bytes)) { *byte = 0; continue; } *byte = (unsigned char)((j == ((size - nail_bytes) - 1u)) ? (t.dp[0] & odd_nail_mask) : (t.dp[0] & 0xFFuL)); if ((err = mp_div_2d(&t, (j == ((size - nail_bytes) - 1u)) ? (int)(8u - odd_nails) : 8, &t, NULL)) != MP_OKAY) { goto LBL_ERR; } } } if (written != NULL) { *written = count; } err = MP_OKAY; LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_pack_count.c0000644000175000017500000000057714554262142017460 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PACK_COUNT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ size_t mp_pack_count(const mp_int *a, size_t nails, size_t size) { size_t bits = (size_t)mp_count_bits(a); return ((bits / ((size * 8u) - nails)) + (((bits % ((size * 8u) - nails)) != 0u) ? 1u : 0u)); } #endif tcl8.6.14/libtommath/bn_mp_prime_fermat.c0000644000175000017500000000204114554262142017770 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PRIME_FERMAT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* performs one Fermat test. * * If "a" were prime then b**a == b (mod a) since the order of * the multiplicative sub-group would be phi(a) = a-1. That means * it would be the same as b**(a mod (a-1)) == b**1 == b (mod a). * * Sets result to 1 if the congruence holds, or zero otherwise. */ mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result) { mp_int t; mp_err err; /* default to composite */ *result = MP_NO; /* ensure b > 1 */ if (mp_cmp_d(b, 1uL) != MP_GT) { return MP_VAL; } /* init t */ if ((err = mp_init(&t)) != MP_OKAY) { return err; } /* compute t = b**a mod a */ if ((err = mp_exptmod(b, a, a, &t)) != MP_OKAY) { goto LBL_T; } /* is it equal to b? */ if (mp_cmp(&t, b) == MP_EQ) { *result = MP_YES; } err = MP_OKAY; LBL_T: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_prime_frobenius_underwood.c0000644000175000017500000001060314554262142022577 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PRIME_FROBENIUS_UNDERWOOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* * See file bn_mp_prime_is_prime.c or the documentation in doc/bn.tex for the details */ #ifndef LTM_USE_ONLY_MR #ifdef MP_8BIT /* * floor of positive solution of * (2^16)-1 = (a+4)*(2*a+5) * TODO: Both values are smaller than N^(1/4), would have to use a bigint * for a instead but any a biger than about 120 are already so rare that * it is possible to ignore them and still get enough pseudoprimes. * But it is still a restriction of the set of available pseudoprimes * which makes this implementation less secure if used stand-alone. */ #define LTM_FROBENIUS_UNDERWOOD_A 177 #else #define LTM_FROBENIUS_UNDERWOOD_A 32764 #endif mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) { mp_int T1z, T2z, Np1z, sz, tz; int a, ap2, length, i, j; mp_err err; *result = MP_NO; if ((err = mp_init_multi(&T1z, &T2z, &Np1z, &sz, &tz, NULL)) != MP_OKAY) { return err; } for (a = 0; a < LTM_FROBENIUS_UNDERWOOD_A; a++) { /* TODO: That's ugly! No, really, it is! */ if ((a==2) || (a==4) || (a==7) || (a==8) || (a==10) || (a==14) || (a==18) || (a==23) || (a==26) || (a==28)) { continue; } /* (32764^2 - 4) < 2^31, no bigint for >MP_8BIT needed) */ mp_set_u32(&T1z, (uint32_t)a); if ((err = mp_sqr(&T1z, &T1z)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_sub_d(&T1z, 4uL, &T1z)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_kronecker(&T1z, N, &j)) != MP_OKAY) goto LBL_FU_ERR; if (j == -1) { break; } if (j == 0) { /* composite */ goto LBL_FU_ERR; } } /* Tell it a composite and set return value accordingly */ if (a >= LTM_FROBENIUS_UNDERWOOD_A) { err = MP_ITER; goto LBL_FU_ERR; } /* Composite if N and (a+4)*(2*a+5) are not coprime */ mp_set_u32(&T1z, (uint32_t)((a+4)*((2*a)+5))); if ((err = mp_gcd(N, &T1z, &T1z)) != MP_OKAY) goto LBL_FU_ERR; if (!((T1z.used == 1) && (T1z.dp[0] == 1u))) goto LBL_FU_ERR; ap2 = a + 2; if ((err = mp_add_d(N, 1uL, &Np1z)) != MP_OKAY) goto LBL_FU_ERR; mp_set(&sz, 1uL); mp_set(&tz, 2uL); length = mp_count_bits(&Np1z); for (i = length - 2; i >= 0; i--) { /* * temp = (sz*(a*sz+2*tz))%N; * tz = ((tz-sz)*(tz+sz))%N; * sz = temp; */ if ((err = mp_mul_2(&tz, &T2z)) != MP_OKAY) goto LBL_FU_ERR; /* a = 0 at about 50% of the cases (non-square and odd input) */ if (a != 0) { if ((err = mp_mul_d(&sz, (mp_digit)a, &T1z)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_add(&T1z, &T2z, &T2z)) != MP_OKAY) goto LBL_FU_ERR; } if ((err = mp_mul(&T2z, &sz, &T1z)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_sub(&tz, &sz, &T2z)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_add(&sz, &tz, &sz)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_mul(&sz, &T2z, &tz)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_mod(&tz, N, &tz)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_mod(&T1z, N, &sz)) != MP_OKAY) goto LBL_FU_ERR; if (s_mp_get_bit(&Np1z, (unsigned int)i) == MP_YES) { /* * temp = (a+2) * sz + tz * tz = 2 * tz - sz * sz = temp */ if (a == 0) { if ((err = mp_mul_2(&sz, &T1z)) != MP_OKAY) goto LBL_FU_ERR; } else { if ((err = mp_mul_d(&sz, (mp_digit)ap2, &T1z)) != MP_OKAY) goto LBL_FU_ERR; } if ((err = mp_add(&T1z, &tz, &T1z)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_mul_2(&tz, &T2z)) != MP_OKAY) goto LBL_FU_ERR; if ((err = mp_sub(&T2z, &sz, &tz)) != MP_OKAY) goto LBL_FU_ERR; mp_exch(&sz, &T1z); } } mp_set_u32(&T1z, (uint32_t)((2 * a) + 5)); if ((err = mp_mod(&T1z, N, &T1z)) != MP_OKAY) goto LBL_FU_ERR; if (MP_IS_ZERO(&sz) && (mp_cmp(&tz, &T1z) == MP_EQ)) { *result = MP_YES; } LBL_FU_ERR: mp_clear_multi(&tz, &sz, &Np1z, &T2z, &T1z, NULL); return err; } #endif #endif tcl8.6.14/libtommath/bn_mp_prime_is_prime.c0000644000175000017500000002236214554262142020331 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PRIME_IS_PRIME_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* portable integer log of two with small footprint */ static unsigned int s_floor_ilog2(int value) { unsigned int r = 0; while ((value >>= 1) != 0) { r++; } return r; } mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result) { mp_int b; int ix, p_max = 0, size_a, len; mp_bool res; mp_err err; unsigned int fips_rand, mask; /* default to no */ *result = MP_NO; /* Some shortcuts */ /* N > 3 */ if (a->used == 1) { if ((a->dp[0] == 0u) || (a->dp[0] == 1u)) { *result = MP_NO; return MP_OKAY; } if (a->dp[0] == 2u) { *result = MP_YES; return MP_OKAY; } } /* N must be odd */ if (MP_IS_EVEN(a)) { return MP_OKAY; } /* N is not a perfect square: floor(sqrt(N))^2 != N */ if ((err = mp_is_square(a, &res)) != MP_OKAY) { return err; } if (res != MP_NO) { return MP_OKAY; } /* is the input equal to one of the primes in the table? */ for (ix = 0; ix < PRIVATE_MP_PRIME_TAB_SIZE; ix++) { if (mp_cmp_d(a, s_mp_prime_tab[ix]) == MP_EQ) { *result = MP_YES; return MP_OKAY; } } #ifdef MP_8BIT /* The search in the loop above was exhaustive in this case */ if ((a->used == 1) && (PRIVATE_MP_PRIME_TAB_SIZE >= 31)) { return MP_OKAY; } #endif /* first perform trial division */ if ((err = s_mp_prime_is_divisible(a, &res)) != MP_OKAY) { return err; } /* return if it was trivially divisible */ if (res == MP_YES) { return MP_OKAY; } /* Run the Miller-Rabin test with base 2 for the BPSW test. */ if ((err = mp_init_set(&b, 2uL)) != MP_OKAY) { return err; } if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) { goto LBL_B; } if (res == MP_NO) { goto LBL_B; } /* Rumours have it that Mathematica does a second M-R test with base 3. Other rumours have it that their strong L-S test is slightly different. It does not hurt, though, beside a bit of extra runtime. */ b.dp[0]++; if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) { goto LBL_B; } if (res == MP_NO) { goto LBL_B; } /* * Both, the Frobenius-Underwood test and the the Lucas-Selfridge test are quite * slow so if speed is an issue, define LTM_USE_ONLY_MR to use M-R tests with * bases 2, 3 and t random bases. */ #ifndef LTM_USE_ONLY_MR if (t >= 0) { /* * Use a Frobenius-Underwood test instead of the Lucas-Selfridge test for * MP_8BIT (It is unknown if the Lucas-Selfridge test works with 16-bit * integers but the necesssary analysis is on the todo-list). */ #if defined (MP_8BIT) || defined (LTM_USE_FROBENIUS_TEST) err = mp_prime_frobenius_underwood(a, &res); if ((err != MP_OKAY) && (err != MP_ITER)) { goto LBL_B; } if (res == MP_NO) { goto LBL_B; } #else if ((err = mp_prime_strong_lucas_selfridge(a, &res)) != MP_OKAY) { goto LBL_B; } if (res == MP_NO) { goto LBL_B; } #endif } #endif /* run at least one Miller-Rabin test with a random base */ if (t == 0) { t = 1; } /* Only recommended if the input range is known to be < 3317044064679887385961981 It uses the bases necessary for a deterministic M-R test if the input is smaller than 3317044064679887385961981 The caller has to check the size. TODO: can be made a bit finer grained but comparing is not free. */ if (t < 0) { /* Sorenson, Jonathan; Webster, Jonathan (2015). "Strong Pseudoprimes to Twelve Prime Bases". */ /* 0x437ae92817f9fc85b7e5 = 318665857834031151167461 */ if ((err = mp_read_radix(&b, "437ae92817f9fc85b7e5", 16)) != MP_OKAY) { goto LBL_B; } if (mp_cmp(a, &b) == MP_LT) { p_max = 12; } else { /* 0x2be6951adc5b22410a5fd = 3317044064679887385961981 */ if ((err = mp_read_radix(&b, "2be6951adc5b22410a5fd", 16)) != MP_OKAY) { goto LBL_B; } if (mp_cmp(a, &b) == MP_LT) { p_max = 13; } else { err = MP_VAL; goto LBL_B; } } /* we did bases 2 and 3 already, skip them */ for (ix = 2; ix < p_max; ix++) { mp_set(&b, s_mp_prime_tab[ix]); if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) { goto LBL_B; } if (res == MP_NO) { goto LBL_B; } } } /* Do "t" M-R tests with random bases between 3 and "a". See Fips 186.4 p. 126ff */ else if (t > 0) { /* * The mp_digit's have a defined bit-size but the size of the * array a.dp is a simple 'int' and this library can not assume full * compliance to the current C-standard (ISO/IEC 9899:2011) because * it gets used for small embeded processors, too. Some of those MCUs * have compilers that one cannot call standard compliant by any means. * Hence the ugly type-fiddling in the following code. */ size_a = mp_count_bits(a); mask = (1u << s_floor_ilog2(size_a)) - 1u; /* Assuming the General Rieman hypothesis (never thought to write that in a comment) the upper bound can be lowered to 2*(log a)^2. E. Bach, "Explicit bounds for primality testing and related problems," Math. Comp. 55 (1990), 355-380. size_a = (size_a/10) * 7; len = 2 * (size_a * size_a); E.g.: a number of size 2^2048 would be reduced to the upper limit floor(2048/10)*7 = 1428 2 * 1428^2 = 4078368 (would have been ~4030331.9962 with floats and natural log instead) That number is smaller than 2^28, the default bit-size of mp_digit. */ /* How many tests, you might ask? Dana Jacobsen of Math::Prime::Util fame does exactly 1. In words: one. Look at the end of _GMP_is_prime() in Math-Prime-Util-GMP-0.50/primality.c if you do not believe it. The function mp_rand() goes to some length to use a cryptographically good PRNG. That also means that the chance to always get the same base in the loop is non-zero, although very low. If the BPSW test and/or the addtional Frobenious test have been performed instead of just the Miller-Rabin test with the bases 2 and 3, a single extra test should suffice, so such a very unlikely event will not do much harm. To preemptivly answer the dangling question: no, a witness does not need to be prime. */ for (ix = 0; ix < t; ix++) { /* mp_rand() guarantees the first digit to be non-zero */ if ((err = mp_rand(&b, 1)) != MP_OKAY) { goto LBL_B; } /* * Reduce digit before casting because mp_digit might be bigger than * an unsigned int and "mask" on the other side is most probably not. */ fips_rand = (unsigned int)(b.dp[0] & (mp_digit) mask); #ifdef MP_8BIT /* * One 8-bit digit is too small, so concatenate two if the size of * unsigned int allows for it. */ if ((MP_SIZEOF_BITS(unsigned int)/2) >= MP_SIZEOF_BITS(mp_digit)) { if ((err = mp_rand(&b, 1)) != MP_OKAY) { goto LBL_B; } fips_rand <<= MP_SIZEOF_BITS(mp_digit); fips_rand |= (unsigned int) b.dp[0]; fips_rand &= mask; } #endif if (fips_rand > (unsigned int)(INT_MAX - MP_DIGIT_BIT)) { len = INT_MAX / MP_DIGIT_BIT; } else { len = (((int)fips_rand + MP_DIGIT_BIT) / MP_DIGIT_BIT); } /* Unlikely. */ if (len < 0) { ix--; continue; } /* * As mentioned above, one 8-bit digit is too small and * although it can only happen in the unlikely case that * an "unsigned int" is smaller than 16 bit a simple test * is cheap and the correction even cheaper. */ #ifdef MP_8BIT /* All "a" < 2^8 have been caught before */ if (len == 1) { len++; } #endif if ((err = mp_rand(&b, len)) != MP_OKAY) { goto LBL_B; } /* * That number might got too big and the witness has to be * smaller than "a" */ len = mp_count_bits(&b); if (len >= size_a) { len = (len - size_a) + 1; if ((err = mp_div_2d(&b, len, &b, NULL)) != MP_OKAY) { goto LBL_B; } } /* Although the chance for b <= 3 is miniscule, try again. */ if (mp_cmp_d(&b, 3uL) != MP_GT) { ix--; continue; } if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) { goto LBL_B; } if (res == MP_NO) { goto LBL_B; } } } /* passed the test */ *result = MP_YES; LBL_B: mp_clear(&b); return err; } #endif tcl8.6.14/libtommath/bn_mp_prime_miller_rabin.c0000644000175000017500000000401314554262142021152 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PRIME_MILLER_RABIN_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Miller-Rabin test of "a" to the base of "b" as described in * HAC pp. 139 Algorithm 4.24 * * Sets result to 0 if definitely composite or 1 if probably prime. * Randomly the chance of error is no more than 1/4 and often * very much lower. */ mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result) { mp_int n1, y, r; mp_err err; int s, j; /* default */ *result = MP_NO; /* ensure b > 1 */ if (mp_cmp_d(b, 1uL) != MP_GT) { return MP_VAL; } /* get n1 = a - 1 */ if ((err = mp_init_copy(&n1, a)) != MP_OKAY) { return err; } if ((err = mp_sub_d(&n1, 1uL, &n1)) != MP_OKAY) { goto LBL_N1; } /* set 2**s * r = n1 */ if ((err = mp_init_copy(&r, &n1)) != MP_OKAY) { goto LBL_N1; } /* count the number of least significant bits * which are zero */ s = mp_cnt_lsb(&r); /* now divide n - 1 by 2**s */ if ((err = mp_div_2d(&r, s, &r, NULL)) != MP_OKAY) { goto LBL_R; } /* compute y = b**r mod a */ if ((err = mp_init(&y)) != MP_OKAY) { goto LBL_R; } if ((err = mp_exptmod(b, &r, a, &y)) != MP_OKAY) { goto LBL_Y; } /* if y != 1 and y != n1 do */ if ((mp_cmp_d(&y, 1uL) != MP_EQ) && (mp_cmp(&y, &n1) != MP_EQ)) { j = 1; /* while j <= s-1 and y != n1 */ while ((j <= (s - 1)) && (mp_cmp(&y, &n1) != MP_EQ)) { if ((err = mp_sqrmod(&y, a, &y)) != MP_OKAY) { goto LBL_Y; } /* if y == 1 then composite */ if (mp_cmp_d(&y, 1uL) == MP_EQ) { goto LBL_Y; } ++j; } /* if y != n1 then composite */ if (mp_cmp(&y, &n1) != MP_EQ) { goto LBL_Y; } } /* probably prime now */ *result = MP_YES; LBL_Y: mp_clear(&y); LBL_R: mp_clear(&r); LBL_N1: mp_clear(&n1); return err; } #endif tcl8.6.14/libtommath/bn_mp_prime_next_prime.c0000644000175000017500000000703114554262142020670 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PRIME_NEXT_PRIME_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* finds the next prime after the number "a" using "t" trials * of Miller-Rabin. * * bbs_style = 1 means the prime must be congruent to 3 mod 4 */ mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) { int x, y; mp_ord cmp; mp_err err; mp_bool res = MP_NO; mp_digit res_tab[PRIVATE_MP_PRIME_TAB_SIZE], step, kstep; mp_int b; /* force positive */ a->sign = MP_ZPOS; /* simple algo if a is less than the largest prime in the table */ if (mp_cmp_d(a, s_mp_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE-1]) == MP_LT) { /* find which prime it is bigger than "a" */ for (x = 0; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) { cmp = mp_cmp_d(a, s_mp_prime_tab[x]); if (cmp == MP_EQ) { continue; } if (cmp != MP_GT) { if ((bbs_style == 1) && ((s_mp_prime_tab[x] & 3u) != 3u)) { /* try again until we get a prime congruent to 3 mod 4 */ continue; } else { mp_set(a, s_mp_prime_tab[x]); return MP_OKAY; } } } /* fall through to the sieve */ } /* generate a prime congruent to 3 mod 4 or 1/3 mod 4? */ if (bbs_style == 1) { kstep = 4; } else { kstep = 2; } /* at this point we will use a combination of a sieve and Miller-Rabin */ if (bbs_style == 1) { /* if a mod 4 != 3 subtract the correct value to make it so */ if ((a->dp[0] & 3u) != 3u) { if ((err = mp_sub_d(a, (a->dp[0] & 3u) + 1u, a)) != MP_OKAY) { return err; } } } else { if (MP_IS_EVEN(a)) { /* force odd */ if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) { return err; } } } /* generate the restable */ for (x = 1; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) { if ((err = mp_mod_d(a, s_mp_prime_tab[x], res_tab + x)) != MP_OKAY) { return err; } } /* init temp used for Miller-Rabin Testing */ if ((err = mp_init(&b)) != MP_OKAY) { return err; } for (;;) { /* skip to the next non-trivially divisible candidate */ step = 0; do { /* y == 1 if any residue was zero [e.g. cannot be prime] */ y = 0; /* increase step to next candidate */ step += kstep; /* compute the new residue without using division */ for (x = 1; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) { /* add the step to each residue */ res_tab[x] += kstep; /* subtract the modulus [instead of using division] */ if (res_tab[x] >= s_mp_prime_tab[x]) { res_tab[x] -= s_mp_prime_tab[x]; } /* set flag if zero */ if (res_tab[x] == 0u) { y = 1; } } } while ((y == 1) && (step < (((mp_digit)1 << MP_DIGIT_BIT) - kstep))); /* add the step */ if ((err = mp_add_d(a, step, a)) != MP_OKAY) { goto LBL_ERR; } /* if didn't pass sieve and step == MP_MAX then skip test */ if ((y == 1) && (step >= (((mp_digit)1 << MP_DIGIT_BIT) - kstep))) { continue; } if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) { goto LBL_ERR; } if (res == MP_YES) { break; } } err = MP_OKAY; LBL_ERR: mp_clear(&b); return err; } #endif tcl8.6.14/libtommath/bn_mp_prime_rabin_miller_trials.c0000644000175000017500000000304314554262142022532 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PRIME_RABIN_MILLER_TRIALS_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ static const struct { int k, t; } sizes[] = { { 80, -1 }, /* Use deterministic algorithm for size <= 80 bits */ { 81, 37 }, /* max. error = 2^(-96)*/ { 96, 32 }, /* max. error = 2^(-96)*/ { 128, 40 }, /* max. error = 2^(-112)*/ { 160, 35 }, /* max. error = 2^(-112)*/ { 256, 27 }, /* max. error = 2^(-128)*/ { 384, 16 }, /* max. error = 2^(-128)*/ { 512, 18 }, /* max. error = 2^(-160)*/ { 768, 11 }, /* max. error = 2^(-160)*/ { 896, 10 }, /* max. error = 2^(-160)*/ { 1024, 12 }, /* max. error = 2^(-192)*/ { 1536, 8 }, /* max. error = 2^(-192)*/ { 2048, 6 }, /* max. error = 2^(-192)*/ { 3072, 4 }, /* max. error = 2^(-192)*/ { 4096, 5 }, /* max. error = 2^(-256)*/ { 5120, 4 }, /* max. error = 2^(-256)*/ { 6144, 4 }, /* max. error = 2^(-256)*/ { 8192, 3 }, /* max. error = 2^(-256)*/ { 9216, 3 }, /* max. error = 2^(-256)*/ { 10240, 2 } /* For bigger keysizes use always at least 2 Rounds */ }; /* returns # of RM trials required for a given bit size */ int mp_prime_rabin_miller_trials(int size) { int x; for (x = 0; x < (int)(sizeof(sizes)/(sizeof(sizes[0]))); x++) { if (sizes[x].k == size) { return sizes[x].t; } else if (sizes[x].k > size) { return (x == 0) ? sizes[0].t : sizes[x - 1].t; } } return sizes[x-1].t; } #endif tcl8.6.14/libtommath/bn_mp_prime_rand.c0000644000175000017500000000727214554262142017451 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PRIME_RAND_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* makes a truly random prime of a given size (bits), * * Flags are as follows: * * MP_PRIME_BBS - make prime congruent to 3 mod 4 * MP_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS) * MP_PRIME_2MSB_ON - make the 2nd highest bit one * * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself * so it can be NULL * */ /* This is possibly the mother of all prime generation functions, muahahahahaha! */ mp_err s_mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat) { unsigned char *tmp, maskAND, maskOR_msb, maskOR_lsb; int bsize, maskOR_msb_offset; mp_bool res; mp_err err; /* sanity check the input */ if ((size <= 1) || (t <= 0)) { return MP_VAL; } /* MP_PRIME_SAFE implies MP_PRIME_BBS */ if ((flags & MP_PRIME_SAFE) != 0) { flags |= MP_PRIME_BBS; } /* calc the byte size */ bsize = (size>>3) + ((size&7)?1:0); /* we need a buffer of bsize bytes */ tmp = (unsigned char *) MP_MALLOC((size_t)bsize); if (tmp == NULL) { return MP_MEM; } /* calc the maskAND value for the MSbyte*/ maskAND = ((size&7) == 0) ? 0xFFu : (unsigned char)(0xFFu >> (8 - (size & 7))); /* calc the maskOR_msb */ maskOR_msb = 0; maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0; if ((flags & MP_PRIME_2MSB_ON) != 0) { maskOR_msb |= (unsigned char)(0x80 >> ((9 - size) & 7)); } /* get the maskOR_lsb */ maskOR_lsb = 1u; if ((flags & MP_PRIME_BBS) != 0) { maskOR_lsb |= 3u; } do { /* read the bytes */ if (cb(tmp, bsize, dat) != bsize) { err = MP_VAL; goto error; } /* work over the MSbyte */ tmp[0] &= maskAND; tmp[0] |= (unsigned char)(1 << ((size - 1) & 7)); /* mix in the maskORs */ tmp[maskOR_msb_offset] |= maskOR_msb; tmp[bsize-1] |= maskOR_lsb; /* read it in */ /* TODO: casting only for now until all lengths have been changed to the type "size_t"*/ if ((err = mp_from_ubin(a, tmp, (size_t)bsize)) != MP_OKAY) { goto error; } /* is it prime? */ if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) { goto error; } if (res == MP_NO) { continue; } if ((flags & MP_PRIME_SAFE) != 0) { /* see if (a-1)/2 is prime */ if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) { goto error; } if ((err = mp_div_2(a, a)) != MP_OKAY) { goto error; } /* is it prime? */ if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) { goto error; } } } while (res == MP_NO); if ((flags & MP_PRIME_SAFE) != 0) { /* restore a to the original value */ if ((err = mp_mul_2(a, a)) != MP_OKAY) { goto error; } if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) { goto error; } } err = MP_OKAY; error: MP_FREE_BUFFER(tmp, (size_t)bsize); return err; } static int s_mp_rand_cb(unsigned char *dst, int len, void *dat) { (void)dat; if (len <= 0) { return len; } if (s_mp_rand_source(dst, (size_t)len) != MP_OKAY) { return 0; } return len; } mp_err mp_prime_rand(mp_int *a, int t, int size, int flags) { return s_mp_prime_random_ex(a, t, size, flags, s_mp_rand_cb, NULL); } #endif tcl8.6.14/libtommath/bn_mp_prime_strong_lucas_selfridge.c0000644000175000017500000002722514554262142023254 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* * See file bn_mp_prime_is_prime.c or the documentation in doc/bn.tex for the details */ #ifndef LTM_USE_ONLY_MR /* * 8-bit is just too small. You can try the Frobenius test * but that frobenius test can fail, too, for the same reason. */ #ifndef MP_8BIT /* * multiply bigint a with int d and put the result in c * Like mp_mul_d() but with a signed long as the small input */ static mp_err s_mp_mul_si(const mp_int *a, int32_t d, mp_int *c) { mp_int t; mp_err err; if ((err = mp_init(&t)) != MP_OKAY) { return err; } /* * mp_digit might be smaller than a long, which excludes * the use of mp_mul_d() here. */ mp_set_i32(&t, d); err = mp_mul(a, &t, c); mp_clear(&t); return err; } /* Strong Lucas-Selfridge test. returns MP_YES if it is a strong L-S prime, MP_NO if it is composite Code ported from Thomas Ray Nicely's implementation of the BPSW test at http://www.trnicely.net/misc/bpsw.html Freeware copyright (C) 2016 Thomas R. Nicely . Released into the public domain by the author, who disclaims any legal liability arising from its use The multi-line comments are made by Thomas R. Nicely and are copied verbatim. Additional comments marked "CZ" (without the quotes) are by the code-portist. (If that name sounds familiar, he is the guy who found the fdiv bug in the Pentium (P5x, I think) Intel processor) */ mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) { /* CZ TODO: choose better variable names! */ mp_int Dz, gcd, Np1, Uz, Vz, U2mz, V2mz, Qmz, Q2mz, Qkdz, T1z, T2z, T3z, T4z, Q2kdz; /* CZ TODO: Some of them need the full 32 bit, hence the (temporary) exclusion of MP_8BIT */ int32_t D, Ds, J, sign, P, Q, r, s, u, Nbits; mp_err err; mp_bool oddness; *result = MP_NO; /* Find the first element D in the sequence {5, -7, 9, -11, 13, ...} such that Jacobi(D,N) = -1 (Selfridge's algorithm). Theory indicates that, if N is not a perfect square, D will "nearly always" be "small." Just in case, an overflow trap for D is included. */ if ((err = mp_init_multi(&Dz, &gcd, &Np1, &Uz, &Vz, &U2mz, &V2mz, &Qmz, &Q2mz, &Qkdz, &T1z, &T2z, &T3z, &T4z, &Q2kdz, NULL)) != MP_OKAY) { return err; } D = 5; sign = 1; for (;;) { Ds = sign * D; sign = -sign; mp_set_u32(&Dz, (uint32_t)D); if ((err = mp_gcd(a, &Dz, &gcd)) != MP_OKAY) goto LBL_LS_ERR; /* if 1 < GCD < N then N is composite with factor "D", and Jacobi(D,N) is technically undefined (but often returned as zero). */ if ((mp_cmp_d(&gcd, 1uL) == MP_GT) && (mp_cmp(&gcd, a) == MP_LT)) { goto LBL_LS_ERR; } if (Ds < 0) { Dz.sign = MP_NEG; } if ((err = mp_kronecker(&Dz, a, &J)) != MP_OKAY) goto LBL_LS_ERR; if (J == -1) { break; } D += 2; if (D > (INT_MAX - 2)) { err = MP_VAL; goto LBL_LS_ERR; } } P = 1; /* Selfridge's choice */ Q = (1 - Ds) / 4; /* Required so D = P*P - 4*Q */ /* NOTE: The conditions (a) N does not divide Q, and (b) D is square-free or not a perfect square, are included by some authors; e.g., "Prime numbers and computer methods for factorization," Hans Riesel (2nd ed., 1994, Birkhauser, Boston), p. 130. For this particular application of Lucas sequences, these conditions were found to be immaterial. */ /* Now calculate N - Jacobi(D,N) = N + 1 (even), and calculate the odd positive integer d and positive integer s for which N + 1 = 2^s*d (similar to the step for N - 1 in Miller's test). The strong Lucas-Selfridge test then returns N as a strong Lucas probable prime (slprp) if any of the following conditions is met: U_d=0, V_d=0, V_2d=0, V_4d=0, V_8d=0, V_16d=0, ..., etc., ending with V_{2^(s-1)*d}=V_{(N+1)/2}=0 (all equalities mod N). Thus d is the highest index of U that must be computed (since V_2m is independent of U), compared to U_{N+1} for the standard Lucas-Selfridge test; and no index of V beyond (N+1)/2 is required, just as in the standard Lucas-Selfridge test. However, the quantity Q^d must be computed for use (if necessary) in the latter stages of the test. The result is that the strong Lucas-Selfridge test has a running time only slightly greater (order of 10 %) than that of the standard Lucas-Selfridge test, while producing only (roughly) 30 % as many pseudoprimes (and every strong Lucas pseudoprime is also a standard Lucas pseudoprime). Thus the evidence indicates that the strong Lucas-Selfridge test is more effective than the standard Lucas-Selfridge test, and a Baillie-PSW test based on the strong Lucas-Selfridge test should be more reliable. */ if ((err = mp_add_d(a, 1uL, &Np1)) != MP_OKAY) goto LBL_LS_ERR; s = mp_cnt_lsb(&Np1); /* CZ * This should round towards zero because * Thomas R. Nicely used GMP's mpz_tdiv_q_2exp() * and mp_div_2d() is equivalent. Additionally: * dividing an even number by two does not produce * any leftovers. */ if ((err = mp_div_2d(&Np1, s, &Dz, NULL)) != MP_OKAY) goto LBL_LS_ERR; /* We must now compute U_d and V_d. Since d is odd, the accumulated values U and V are initialized to U_1 and V_1 (if the target index were even, U and V would be initialized instead to U_0=0 and V_0=2). The values of U_2m and V_2m are also initialized to U_1 and V_1; the FOR loop calculates in succession U_2 and V_2, U_4 and V_4, U_8 and V_8, etc. If the corresponding bits (1, 2, 3, ...) of t are on (the zero bit having been accounted for in the initialization of U and V), these values are then combined with the previous totals for U and V, using the composition formulas for addition of indices. */ mp_set(&Uz, 1uL); /* U=U_1 */ mp_set(&Vz, (mp_digit)P); /* V=V_1 */ mp_set(&U2mz, 1uL); /* U_1 */ mp_set(&V2mz, (mp_digit)P); /* V_1 */ mp_set_i32(&Qmz, Q); if ((err = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY) goto LBL_LS_ERR; /* Initializes calculation of Q^d */ mp_set_i32(&Qkdz, Q); Nbits = mp_count_bits(&Dz); for (u = 1; u < Nbits; u++) { /* zero bit off, already accounted for */ /* Formulas for doubling of indices (carried out mod N). Note that * the indices denoted as "2m" are actually powers of 2, specifically * 2^(ul-1) beginning each loop and 2^ul ending each loop. * * U_2m = U_m*V_m * V_2m = V_m*V_m - 2*Q^m */ if ((err = mp_mul(&U2mz, &V2mz, &U2mz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mod(&U2mz, a, &U2mz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_sqr(&V2mz, &V2mz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_sub(&V2mz, &Q2mz, &V2mz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mod(&V2mz, a, &V2mz)) != MP_OKAY) goto LBL_LS_ERR; /* Must calculate powers of Q for use in V_2m, also for Q^d later */ if ((err = mp_sqr(&Qmz, &Qmz)) != MP_OKAY) goto LBL_LS_ERR; /* prevents overflow */ /* CZ still necessary without a fixed prealloc'd mem.? */ if ((err = mp_mod(&Qmz, a, &Qmz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY) goto LBL_LS_ERR; if (s_mp_get_bit(&Dz, (unsigned int)u) == MP_YES) { /* Formulas for addition of indices (carried out mod N); * * U_(m+n) = (U_m*V_n + U_n*V_m)/2 * V_(m+n) = (V_m*V_n + D*U_m*U_n)/2 * * Be careful with division by 2 (mod N)! */ if ((err = mp_mul(&U2mz, &Vz, &T1z)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mul(&Uz, &V2mz, &T2z)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mul(&V2mz, &Vz, &T3z)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mul(&U2mz, &Uz, &T4z)) != MP_OKAY) goto LBL_LS_ERR; if ((err = s_mp_mul_si(&T4z, Ds, &T4z)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_add(&T1z, &T2z, &Uz)) != MP_OKAY) goto LBL_LS_ERR; if (MP_IS_ODD(&Uz)) { if ((err = mp_add(&Uz, a, &Uz)) != MP_OKAY) goto LBL_LS_ERR; } /* CZ * This should round towards negative infinity because * Thomas R. Nicely used GMP's mpz_fdiv_q_2exp(). * But mp_div_2() does not do so, it is truncating instead. */ oddness = MP_IS_ODD(&Uz) ? MP_YES : MP_NO; if ((err = mp_div_2(&Uz, &Uz)) != MP_OKAY) goto LBL_LS_ERR; if ((Uz.sign == MP_NEG) && (oddness != MP_NO)) { if ((err = mp_sub_d(&Uz, 1uL, &Uz)) != MP_OKAY) goto LBL_LS_ERR; } if ((err = mp_add(&T3z, &T4z, &Vz)) != MP_OKAY) goto LBL_LS_ERR; if (MP_IS_ODD(&Vz)) { if ((err = mp_add(&Vz, a, &Vz)) != MP_OKAY) goto LBL_LS_ERR; } oddness = MP_IS_ODD(&Vz) ? MP_YES : MP_NO; if ((err = mp_div_2(&Vz, &Vz)) != MP_OKAY) goto LBL_LS_ERR; if ((Vz.sign == MP_NEG) && (oddness != MP_NO)) { if ((err = mp_sub_d(&Vz, 1uL, &Vz)) != MP_OKAY) goto LBL_LS_ERR; } if ((err = mp_mod(&Uz, a, &Uz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mod(&Vz, a, &Vz)) != MP_OKAY) goto LBL_LS_ERR; /* Calculating Q^d for later use */ if ((err = mp_mul(&Qkdz, &Qmz, &Qkdz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mod(&Qkdz, a, &Qkdz)) != MP_OKAY) goto LBL_LS_ERR; } } /* If U_d or V_d is congruent to 0 mod N, then N is a prime or a strong Lucas pseudoprime. */ if (MP_IS_ZERO(&Uz) || MP_IS_ZERO(&Vz)) { *result = MP_YES; goto LBL_LS_ERR; } /* NOTE: Ribenboim ("The new book of prime number records," 3rd ed., 1995/6) omits the condition V0 on p.142, but includes it on p. 130. The condition is NECESSARY; otherwise the test will return false negatives---e.g., the primes 29 and 2000029 will be returned as composite. */ /* Otherwise, we must compute V_2d, V_4d, V_8d, ..., V_{2^(s-1)*d} by repeated use of the formula V_2m = V_m*V_m - 2*Q^m. If any of these are congruent to 0 mod N, then N is a prime or a strong Lucas pseudoprime. */ /* Initialize 2*Q^(d*2^r) for V_2m */ if ((err = mp_mul_2(&Qkdz, &Q2kdz)) != MP_OKAY) goto LBL_LS_ERR; for (r = 1; r < s; r++) { if ((err = mp_sqr(&Vz, &Vz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_sub(&Vz, &Q2kdz, &Vz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mod(&Vz, a, &Vz)) != MP_OKAY) goto LBL_LS_ERR; if (MP_IS_ZERO(&Vz)) { *result = MP_YES; goto LBL_LS_ERR; } /* Calculate Q^{d*2^r} for next r (final iteration irrelevant). */ if (r < (s - 1)) { if ((err = mp_sqr(&Qkdz, &Qkdz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mod(&Qkdz, a, &Qkdz)) != MP_OKAY) goto LBL_LS_ERR; if ((err = mp_mul_2(&Qkdz, &Q2kdz)) != MP_OKAY) goto LBL_LS_ERR; } } LBL_LS_ERR: mp_clear_multi(&Q2kdz, &T4z, &T3z, &T2z, &T1z, &Qkdz, &Q2mz, &Qmz, &V2mz, &U2mz, &Vz, &Uz, &Np1, &gcd, &Dz, NULL); return err; } #endif #endif #endif tcl8.6.14/libtommath/bn_mp_radix_size.c0000644000175000017500000000246314554262142017467 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_RADIX_SIZE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* returns size of ASCII representation */ mp_err mp_radix_size(const mp_int *a, int radix, int *size) { mp_err err; int digs; mp_int t; mp_digit d; *size = 0; /* make sure the radix is in range */ if ((radix < 2) || (radix > 64)) { return MP_VAL; } if (MP_IS_ZERO(a)) { *size = 2; return MP_OKAY; } /* special case for binary */ if (radix == 2) { *size = (mp_count_bits(a) + ((a->sign == MP_NEG) ? 1 : 0) + 1); return MP_OKAY; } /* digs is the digit count */ digs = 0; /* if it's negative add one for the sign */ if (a->sign == MP_NEG) { ++digs; } /* init a copy of the input */ if ((err = mp_init_copy(&t, a)) != MP_OKAY) { return err; } /* force temp to positive */ t.sign = MP_ZPOS; /* fetch out all of the digits */ while (!MP_IS_ZERO(&t)) { if ((err = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) { goto LBL_ERR; } ++digs; } /* return digs + 1, the 1 is for the NULL byte that would be required. */ *size = digs + 1; err = MP_OKAY; LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_radix_smap.c0000644000175000017500000000217114554262142017451 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_RADIX_SMAP_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* chars used in radix conversions */ const char *const mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/"; const unsigned char mp_s_rmap_reverse[] = { 0xff, 0xff, 0xff, 0x3e, 0xff, 0xff, 0xff, 0x3f, /* ()*+,-./ */ 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, /* 01234567 */ 0x08, 0x09, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, /* 89:;<=>? */ 0xff, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, /* @ABCDEFG */ 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, /* HIJKLMNO */ 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, /* PQRSTUVW */ 0x21, 0x22, 0x23, 0xff, 0xff, 0xff, 0xff, 0xff, /* XYZ[\]^_ */ 0xff, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, /* `abcdefg */ 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, /* hijklmno */ 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, /* pqrstuvw */ 0x3b, 0x3c, 0x3d, 0xff, 0xff, 0xff, 0xff, 0xff, /* xyz{|}~. */ }; const size_t mp_s_rmap_reverse_sz = sizeof(mp_s_rmap_reverse); #endif tcl8.6.14/libtommath/bn_mp_rand.c0000644000175000017500000000204014554262142016241 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_RAND_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ mp_err(*s_mp_rand_source)(void *out, size_t size) = s_mp_rand_platform; void mp_rand_source(mp_err(*source)(void *out, size_t size)) { s_mp_rand_source = (source == NULL) ? s_mp_rand_platform : source; } mp_err mp_rand(mp_int *a, int digits) { int i; mp_err err; mp_zero(a); if (digits <= 0) { return MP_OKAY; } if ((err = mp_grow(a, digits)) != MP_OKAY) { return err; } if ((err = s_mp_rand_source(a->dp, (size_t)digits * sizeof(mp_digit))) != MP_OKAY) { return err; } /* TODO: We ensure that the highest digit is nonzero. Should this be removed? */ while ((a->dp[digits - 1] & MP_MASK) == 0u) { if ((err = s_mp_rand_source(a->dp + digits - 1, sizeof(mp_digit))) != MP_OKAY) { return err; } } a->used = digits; for (i = 0; i < digits; ++i) { a->dp[i] &= MP_MASK; } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_read_radix.c0000644000175000017500000000364114554262142017427 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_READ_RADIX_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #define MP_TOUPPER(c) ((((c) >= 'a') && ((c) <= 'z')) ? (((c) + 'A') - 'a') : (c)) /* read a string [ASCII] in a given radix */ mp_err mp_read_radix(mp_int *a, const char *str, int radix) { mp_err err; int y; mp_sign neg; unsigned pos; char ch; /* zero the digit bignum */ mp_zero(a); /* make sure the radix is ok */ if ((radix < 2) || (radix > 64)) { return MP_VAL; } /* if the leading digit is a * minus set the sign to negative. */ if (*str == '-') { ++str; neg = MP_NEG; } else { neg = MP_ZPOS; } /* set the integer to the default of zero */ mp_zero(a); /* process each digit of the string */ while (*str != '\0') { /* if the radix <= 36 the conversion is case insensitive * this allows numbers like 1AB and 1ab to represent the same value * [e.g. in hex] */ ch = (radix <= 36) ? (char)MP_TOUPPER((int)*str) : *str; pos = (unsigned)(ch - '('); if (mp_s_rmap_reverse_sz < pos) { break; } y = (int)mp_s_rmap_reverse[pos]; /* if the char was found in the map * and is less than the given radix add it * to the number, otherwise exit the loop. */ if ((y == 0xff) || (y >= radix)) { break; } if ((err = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) { return err; } if ((err = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) { return err; } ++str; } /* if an illegal character was found, fail. */ if (!((*str == '\0') || (*str == '\r') || (*str == '\n'))) { mp_zero(a); return MP_VAL; } /* set the sign only if a != 0 */ if (!MP_IS_ZERO(a)) { a->sign = neg; } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_reduce.c0000644000175000017500000000371314554262142016574 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_REDUCE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* reduces x mod m, assumes 0 < x < m**2, mu is * precomputed via mp_reduce_setup. * From HAC pp.604 Algorithm 14.42 */ mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) { mp_int q; mp_err err; int um = m->used; /* q = x */ if ((err = mp_init_copy(&q, x)) != MP_OKAY) { return err; } /* q1 = x / b**(k-1) */ mp_rshd(&q, um - 1); /* according to HAC this optimization is ok */ if ((mp_digit)um > ((mp_digit)1 << (MP_DIGIT_BIT - 1))) { if ((err = mp_mul(&q, mu, &q)) != MP_OKAY) { goto CLEANUP; } } else if (MP_HAS(S_MP_MUL_HIGH_DIGS)) { if ((err = s_mp_mul_high_digs(&q, mu, &q, um)) != MP_OKAY) { goto CLEANUP; } } else if (MP_HAS(S_MP_MUL_HIGH_DIGS_FAST)) { if ((err = s_mp_mul_high_digs_fast(&q, mu, &q, um)) != MP_OKAY) { goto CLEANUP; } } else { err = MP_VAL; goto CLEANUP; } /* q3 = q2 / b**(k+1) */ mp_rshd(&q, um + 1); /* x = x mod b**(k+1), quick (no division) */ if ((err = mp_mod_2d(x, MP_DIGIT_BIT * (um + 1), x)) != MP_OKAY) { goto CLEANUP; } /* q = q * m mod b**(k+1), quick (no division) */ if ((err = s_mp_mul_digs(&q, m, &q, um + 1)) != MP_OKAY) { goto CLEANUP; } /* x = x - q */ if ((err = mp_sub(x, &q, x)) != MP_OKAY) { goto CLEANUP; } /* If x < 0, add b**(k+1) to it */ if (mp_cmp_d(x, 0uL) == MP_LT) { mp_set(&q, 1uL); if ((err = mp_lshd(&q, um + 1)) != MP_OKAY) { goto CLEANUP; } if ((err = mp_add(x, &q, x)) != MP_OKAY) { goto CLEANUP; } } /* Back off if it's too big */ while (mp_cmp(x, m) != MP_LT) { if ((err = s_mp_sub(x, m, x)) != MP_OKAY) { goto CLEANUP; } } CLEANUP: mp_clear(&q); return err; } #endif tcl8.6.14/libtommath/bn_mp_reduce_2k.c0000644000175000017500000000166314554262142017172 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_REDUCE_2K_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* reduces a modulo n where n is of the form 2**p - d */ mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) { mp_int q; mp_err err; int p; if ((err = mp_init(&q)) != MP_OKAY) { return err; } p = mp_count_bits(n); top: /* q = a/2**p, a = a mod 2**p */ if ((err = mp_div_2d(a, p, &q, a)) != MP_OKAY) { goto LBL_ERR; } if (d != 1u) { /* q = q * d */ if ((err = mp_mul_d(&q, d, &q)) != MP_OKAY) { goto LBL_ERR; } } /* a = a + q */ if ((err = s_mp_add(a, &q, a)) != MP_OKAY) { goto LBL_ERR; } if (mp_cmp_mag(a, n) != MP_LT) { if ((err = s_mp_sub(a, n, a)) != MP_OKAY) { goto LBL_ERR; } goto top; } LBL_ERR: mp_clear(&q); return err; } #endif tcl8.6.14/libtommath/bn_mp_reduce_2k_l.c0000644000175000017500000000174614554262142017507 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_REDUCE_2K_L_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* reduces a modulo n where n is of the form 2**p - d This differs from reduce_2k since "d" can be larger than a single digit. */ mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d) { mp_int q; mp_err err; int p; if ((err = mp_init(&q)) != MP_OKAY) { return err; } p = mp_count_bits(n); top: /* q = a/2**p, a = a mod 2**p */ if ((err = mp_div_2d(a, p, &q, a)) != MP_OKAY) { goto LBL_ERR; } /* q = q * d */ if ((err = mp_mul(&q, d, &q)) != MP_OKAY) { goto LBL_ERR; } /* a = a + q */ if ((err = s_mp_add(a, &q, a)) != MP_OKAY) { goto LBL_ERR; } if (mp_cmp_mag(a, n) != MP_LT) { if ((err = s_mp_sub(a, n, a)) != MP_OKAY) { goto LBL_ERR; } goto top; } LBL_ERR: mp_clear(&q); return err; } #endif tcl8.6.14/libtommath/bn_mp_reduce_2k_setup.c0000644000175000017500000000122014554262142020377 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_REDUCE_2K_SETUP_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* determines the setup value */ mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d) { mp_err err; mp_int tmp; int p; if ((err = mp_init(&tmp)) != MP_OKAY) { return err; } p = mp_count_bits(a); if ((err = mp_2expt(&tmp, p)) != MP_OKAY) { mp_clear(&tmp); return err; } if ((err = s_mp_sub(&tmp, a, &tmp)) != MP_OKAY) { mp_clear(&tmp); return err; } *d = tmp.dp[0]; mp_clear(&tmp); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_reduce_2k_setup_l.c0000644000175000017500000000110214554262142020711 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_REDUCE_2K_SETUP_L_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* determines the setup value */ mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) { mp_err err; mp_int tmp; if ((err = mp_init(&tmp)) != MP_OKAY) { return err; } if ((err = mp_2expt(&tmp, mp_count_bits(a))) != MP_OKAY) { goto LBL_ERR; } if ((err = s_mp_sub(&tmp, a, d)) != MP_OKAY) { goto LBL_ERR; } LBL_ERR: mp_clear(&tmp); return err; } #endif tcl8.6.14/libtommath/bn_mp_reduce_is_2k.c0000644000175000017500000000150614554262142017661 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_REDUCE_IS_2K_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* determines if mp_reduce_2k can be used */ mp_bool mp_reduce_is_2k(const mp_int *a) { int ix, iy, iw; mp_digit iz; if (a->used == 0) { return MP_NO; } else if (a->used == 1) { return MP_YES; } else if (a->used > 1) { iy = mp_count_bits(a); iz = 1; iw = 1; /* Test every bit from the second digit up, must be 1 */ for (ix = MP_DIGIT_BIT; ix < iy; ix++) { if ((a->dp[iw] & iz) == 0u) { return MP_NO; } iz <<= 1; if (iz > MP_DIGIT_MAX) { ++iw; iz = 1; } } return MP_YES; } else { return MP_YES; } } #endif tcl8.6.14/libtommath/bn_mp_reduce_is_2k_l.c0000644000175000017500000000125314554262142020173 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_REDUCE_IS_2K_L_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* determines if reduce_2k_l can be used */ mp_bool mp_reduce_is_2k_l(const mp_int *a) { int ix, iy; if (a->used == 0) { return MP_NO; } else if (a->used == 1) { return MP_YES; } else if (a->used > 1) { /* if more than half of the digits are -1 we're sold */ for (iy = ix = 0; ix < a->used; ix++) { if (a->dp[ix] == MP_DIGIT_MAX) { ++iy; } } return (iy >= (a->used/2)) ? MP_YES : MP_NO; } else { return MP_NO; } } #endif tcl8.6.14/libtommath/bn_mp_reduce_setup.c0000644000175000017500000000076214554262142020015 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_REDUCE_SETUP_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* pre-calculate the value required for Barrett reduction * For a given modulus "b" it calulates the value required in "a" */ mp_err mp_reduce_setup(mp_int *a, const mp_int *b) { mp_err err; if ((err = mp_2expt(a, b->used * 2 * MP_DIGIT_BIT)) != MP_OKAY) { return err; } return mp_div(a, b, a, NULL); } #endif tcl8.6.14/libtommath/bn_mp_root_u32.c0000644000175000017500000000735414554262142017006 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ROOT_U32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* find the n'th root of an integer * * Result found such that (c)**b <= a and (c+1)**b > a * * This algorithm uses Newton's approximation * x[i+1] = x[i] - f(x[i])/f'(x[i]) * which will find the root in log(N) time where * each step involves a fair bit. */ mp_err mp_root_u32(const mp_int *a, unsigned int b, mp_int *c) { mp_int t1, t2, t3, a_; mp_ord cmp; int ilog2; mp_err err; /* input must be positive if b is even */ if (((b & 1u) == 0u) && (a->sign == MP_NEG)) { return MP_VAL; } if ((err = mp_init_multi(&t1, &t2, &t3, NULL)) != MP_OKAY) { return err; } /* if a is negative fudge the sign but keep track */ a_ = *a; a_.sign = MP_ZPOS; /* Compute seed: 2^(log_2(n)/b + 2)*/ ilog2 = mp_count_bits(a); /* If "b" is larger than INT_MAX it is also larger than log_2(n) because the bit-length of the "n" is measured with an int and hence the root is always < 2 (two). */ if (b > (unsigned int)(INT_MAX/2)) { mp_set(c, 1uL); c->sign = a->sign; err = MP_OKAY; goto LBL_ERR; } /* "b" is smaller than INT_MAX, we can cast safely */ if (ilog2 < (int)b) { mp_set(c, 1uL); c->sign = a->sign; err = MP_OKAY; goto LBL_ERR; } ilog2 = ilog2 / ((int)b); if (ilog2 == 0) { mp_set(c, 1uL); c->sign = a->sign; err = MP_OKAY; goto LBL_ERR; } /* Start value must be larger than root */ ilog2 += 2; if ((err = mp_2expt(&t2,ilog2)) != MP_OKAY) goto LBL_ERR; do { /* t1 = t2 */ if ((err = mp_copy(&t2, &t1)) != MP_OKAY) goto LBL_ERR; /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */ /* t3 = t1**(b-1) */ if ((err = mp_expt_u32(&t1, b - 1u, &t3)) != MP_OKAY) goto LBL_ERR; /* numerator */ /* t2 = t1**b */ if ((err = mp_mul(&t3, &t1, &t2)) != MP_OKAY) goto LBL_ERR; /* t2 = t1**b - a */ if ((err = mp_sub(&t2, &a_, &t2)) != MP_OKAY) goto LBL_ERR; /* denominator */ /* t3 = t1**(b-1) * b */ if ((err = mp_mul_d(&t3, b, &t3)) != MP_OKAY) goto LBL_ERR; /* t3 = (t1**b - a)/(b * t1**(b-1)) */ if ((err = mp_div(&t2, &t3, &t3, NULL)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&t1, &t3, &t2)) != MP_OKAY) goto LBL_ERR; /* Number of rounds is at most log_2(root). If it is more it got stuck, so break out of the loop and do the rest manually. */ if (ilog2-- == 0) { break; } } while (mp_cmp(&t1, &t2) != MP_EQ); /* result can be off by a few so check */ /* Loop beneath can overshoot by one if found root is smaller than actual root */ for (;;) { if ((err = mp_expt_u32(&t1, b, &t2)) != MP_OKAY) goto LBL_ERR; cmp = mp_cmp(&t2, &a_); if (cmp == MP_EQ) { err = MP_OKAY; goto LBL_ERR; } if (cmp == MP_LT) { if ((err = mp_add_d(&t1, 1uL, &t1)) != MP_OKAY) goto LBL_ERR; } else { break; } } /* correct overshoot from above or from recurrence */ for (;;) { if ((err = mp_expt_u32(&t1, b, &t2)) != MP_OKAY) goto LBL_ERR; if (mp_cmp(&t2, &a_) == MP_GT) { if ((err = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) goto LBL_ERR; } else { break; } } /* set the result */ mp_exch(&t1, c); /* set the sign of the result */ c->sign = a->sign; err = MP_OKAY; LBL_ERR: mp_clear_multi(&t1, &t2, &t3, NULL); return err; } #endif tcl8.6.14/libtommath/bn_mp_rshd.c0000644000175000017500000000213414554262142016261 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_RSHD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* shift right a certain amount of digits */ void mp_rshd(mp_int *a, int b) { int x; mp_digit *bottom, *top; /* if b <= 0 then ignore it */ if (b <= 0) { return; } /* if b > used then simply zero it and return */ if (a->used <= b) { mp_zero(a); return; } /* shift the digits down */ /* bottom */ bottom = a->dp; /* top [offset into digits] */ top = a->dp + b; /* this is implemented as a sliding window where * the window is b-digits long and digits from * the top of the window are copied to the bottom * * e.g. b-2 | b-1 | b0 | b1 | b2 | ... | bb | ----> /\ | ----> \-------------------/ ----> */ for (x = 0; x < (a->used - b); x++) { *bottom++ = *top++; } /* zero the top digits */ MP_ZERO_DIGITS(bottom, a->used - x); /* remove excess digits */ a->used -= b; } #endif tcl8.6.14/libtommath/bn_mp_sbin_size.c0000644000175000017500000000044114554262142017305 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SBIN_SIZE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* get the size for an signed equivalent */ size_t mp_sbin_size(const mp_int *a) { return 1u + mp_ubin_size(a); } #endif tcl8.6.14/libtommath/bn_mp_set.c0000644000175000017500000000056414554262142016121 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* set to a digit */ void mp_set(mp_int *a, mp_digit b) { a->dp[0] = b & MP_MASK; a->sign = MP_ZPOS; a->used = (a->dp[0] != 0u) ? 1 : 0; MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used); } #endif tcl8.6.14/libtommath/bn_mp_set_double.c0000644000175000017500000000234514554262142017452 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_DOUBLE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559) mp_err mp_set_double(mp_int *a, double b) { uint64_t frac; int exp; mp_err err; union { double dbl; uint64_t bits; } cast; cast.dbl = b; exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFu); frac = (cast.bits & (((uint64_t)1 << 52) - (uint64_t)1)) | ((uint64_t)1 << 52); if (exp == 0x7FF) { /* +-inf, NaN */ return MP_VAL; } exp -= 1023 + 52; mp_set_u64(a, frac); err = (exp < 0) ? mp_div_2d(a, -exp, a, NULL) : mp_mul_2d(a, exp, a); if (err != MP_OKAY) { return err; } if (((cast.bits >> 63) != 0u) && !MP_IS_ZERO(a)) { a->sign = MP_NEG; } return MP_OKAY; } #else /* pragma message() not supported by several compilers (in mostly older but still used versions) */ # ifdef _MSC_VER # pragma message("mp_set_double implementation is only available on platforms with IEEE754 floating point format") # else # warning "mp_set_double implementation is only available on platforms with IEEE754 floating point format" # endif #endif #endif tcl8.6.14/libtommath/bn_mp_set_i32.c0000644000175000017500000000034314554262142016571 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_I32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_SET_SIGNED(mp_set_i32, mp_set_u32, int32_t, uint32_t) #endif tcl8.6.14/libtommath/bn_mp_set_i64.c0000644000175000017500000000034314554262142016576 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_I64_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_SET_SIGNED(mp_set_i64, mp_set_u64, int64_t, uint64_t) #endif tcl8.6.14/libtommath/bn_mp_set_l.c0000644000175000017500000000034014554262142016424 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_L_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_SET_SIGNED(mp_set_l, mp_set_ul, long, unsigned long) #endif tcl8.6.14/libtommath/bn_mp_set_ll.c0000644000175000017500000000035514554262142016606 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_LL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_SET_SIGNED(mp_set_ll, mp_set_ull, long long, unsigned long long) #endif tcl8.6.14/libtommath/bn_mp_set_u32.c0000644000175000017500000000032014554262142016600 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_U32_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_SET_UNSIGNED(mp_set_u32, uint32_t) #endif tcl8.6.14/libtommath/bn_mp_set_u64.c0000644000175000017500000000032014554262142016605 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_U64_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_SET_UNSIGNED(mp_set_u64, uint64_t) #endif tcl8.6.14/libtommath/bn_mp_set_ul.c0000644000175000017500000000032314554262142016612 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_UL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_SET_UNSIGNED(mp_set_ul, unsigned long) #endif tcl8.6.14/libtommath/bn_mp_set_ull.c0000644000175000017500000000033214554262142016766 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SET_ULL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ MP_SET_UNSIGNED(mp_set_ull, unsigned long long) #endif tcl8.6.14/libtommath/bn_mp_shrink.c0000644000175000017500000000116514554262142016622 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SHRINK_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* shrink a bignum */ mp_err mp_shrink(mp_int *a) { mp_digit *tmp; int alloc = MP_MAX(MP_MIN_PREC, a->used); if (a->alloc != alloc) { if ((tmp = (mp_digit *) MP_REALLOC(a->dp, (size_t)a->alloc * sizeof(mp_digit), (size_t)alloc * sizeof(mp_digit))) == NULL) { return MP_MEM; } a->dp = tmp; a->alloc = alloc; } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_signed_rsh.c0000644000175000017500000000105114554262142017443 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SIGNED_RSH_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* shift right by a certain bit count with sign extension */ mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c) { mp_err res; if (a->sign == MP_ZPOS) { return mp_div_2d(a, b, c, NULL); } res = mp_add_d(a, 1uL, c); if (res != MP_OKAY) { return res; } res = mp_div_2d(c, b, c, NULL); return (res == MP_OKAY) ? mp_sub_d(c, 1uL, c) : res; } #endif tcl8.6.14/libtommath/bn_mp_sqr.c0000644000175000017500000000156114554262142016131 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SQR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* computes b = a*a */ mp_err mp_sqr(const mp_int *a, mp_int *b) { mp_err err; if (MP_HAS(S_MP_TOOM_SQR) && /* use Toom-Cook? */ (a->used >= MP_TOOM_SQR_CUTOFF)) { err = s_mp_toom_sqr(a, b); } else if (MP_HAS(S_MP_KARATSUBA_SQR) && /* Karatsuba? */ (a->used >= MP_KARATSUBA_SQR_CUTOFF)) { err = s_mp_karatsuba_sqr(a, b); } else if (MP_HAS(S_MP_SQR_FAST) && /* can we use the fast comba multiplier? */ (((a->used * 2) + 1) < MP_WARRAY) && (a->used < (MP_MAXFAST / 2))) { err = s_mp_sqr_fast(a, b); } else if (MP_HAS(S_MP_SQR)) { err = s_mp_sqr(a, b); } else { err = MP_VAL; } b->sign = MP_ZPOS; return err; } #endif tcl8.6.14/libtommath/bn_mp_sqrmod.c0000644000175000017500000000075414554262142016634 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SQRMOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* c = a * a (mod b) */ mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c) { mp_err err; mp_int t; if ((err = mp_init(&t)) != MP_OKAY) { return err; } if ((err = mp_sqr(a, &t)) != MP_OKAY) { goto LBL_ERR; } err = mp_mod(&t, b, c); LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_sqrt.c0000644000175000017500000000572714554262142016325 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SQRT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef NO_FLOATING_POINT #include #include #if (MP_DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024) #define NO_FLOATING_POINT #endif #endif /* this function is less generic than mp_n_root, simpler and faster */ mp_err mp_sqrt(const mp_int *arg, mp_int *ret) { mp_err err; mp_int t1, t2; #ifndef NO_FLOATING_POINT int i, j, k; volatile double d; mp_digit dig; #endif /* must be positive */ if (arg->sign == MP_NEG) { return MP_VAL; } /* easy out */ if (MP_IS_ZERO(arg)) { mp_zero(ret); return MP_OKAY; } #ifndef NO_FLOATING_POINT i = (arg->used / 2) - 1; j = 2 * i; if ((err = mp_init_size(&t1, i+2)) != MP_OKAY) { return err; } if ((err = mp_init(&t2)) != MP_OKAY) { goto E2; } for (k = 0; k < i; ++k) { t1.dp[k] = (mp_digit) 0; } /* Estimate the square root using the hardware floating point unit. */ d = 0.0; for (k = arg->used-1; k >= j; --k) { d = ldexp(d, MP_DIGIT_BIT) + (double)(arg->dp[k]); } /* * At this point, d is the nearest floating point number to the most * significant 1 or 2 mp_digits of arg. Extract its square root. */ d = sqrt(d); /* dig is the most significant mp_digit of the square root */ dig = (mp_digit) ldexp(d, -MP_DIGIT_BIT); /* * If the most significant digit is nonzero, find the next digit down * by subtracting MP_DIGIT_BIT times thie most significant digit. * Subtract one from the result so that our initial estimate is always * low. */ if (dig) { t1.used = i+2; d -= ldexp((double) dig, MP_DIGIT_BIT); if (d >= 1.0) { t1.dp[i+1] = dig; t1.dp[i] = ((mp_digit) d) - 1; } else { t1.dp[i+1] = dig-1; t1.dp[i] = MP_DIGIT_MAX; } } else { t1.used = i+1; t1.dp[i] = ((mp_digit) d) - 1; } #else if ((err = mp_init_copy(&t1, arg)) != MP_OKAY) { return err; } if ((err = mp_init(&t2)) != MP_OKAY) { goto E2; } /* First approx. (not very bad for large arg) */ mp_rshd(&t1, t1.used/2); #endif /* t1 > 0 */ if ((err = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) { goto E1; } if ((err = mp_add(&t1, &t2, &t1)) != MP_OKAY) { goto E1; } if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) { goto E1; } /* And now t1 > sqrt(arg) */ do { if ((err = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) { goto E1; } if ((err = mp_add(&t1, &t2, &t1)) != MP_OKAY) { goto E1; } if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) { goto E1; } /* t1 >= sqrt(arg) >= t2 at this point */ } while (mp_cmp_mag(&t1, &t2) == MP_GT); mp_exch(&t1, ret); E1: mp_clear(&t2); E2: mp_clear(&t1); return err; } #endif tcl8.6.14/libtommath/bn_mp_sqrtmod_prime.c0000644000175000017500000001067414554262142020216 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SQRTMOD_PRIME_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Tonelli-Shanks algorithm * https://en.wikipedia.org/wiki/Tonelli%E2%80%93Shanks_algorithm * https://gmplib.org/list-archives/gmp-discuss/2013-April/005300.html * */ mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) { mp_err err; int legendre; mp_int t1, C, Q, S, Z, M, T, R, two; mp_digit i; /* first handle the simple cases */ if (mp_cmp_d(n, 0uL) == MP_EQ) { mp_zero(ret); return MP_OKAY; } if (mp_cmp_d(prime, 2uL) == MP_EQ) return MP_VAL; /* prime must be odd */ if ((err = mp_kronecker(n, prime, &legendre)) != MP_OKAY) return err; if (legendre == -1) return MP_VAL; /* quadratic non-residue mod prime */ if ((err = mp_init_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL)) != MP_OKAY) { return err; } /* SPECIAL CASE: if prime mod 4 == 3 * compute directly: err = n^(prime+1)/4 mod prime * Handbook of Applied Cryptography algorithm 3.36 */ if ((err = mp_mod_d(prime, 4uL, &i)) != MP_OKAY) goto cleanup; if (i == 3u) { if ((err = mp_add_d(prime, 1uL, &t1)) != MP_OKAY) goto cleanup; if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; if ((err = mp_exptmod(n, &t1, prime, ret)) != MP_OKAY) goto cleanup; err = MP_OKAY; goto cleanup; } /* NOW: Tonelli-Shanks algorithm */ /* factor out powers of 2 from prime-1, defining Q and S as: prime-1 = Q*2^S */ if ((err = mp_copy(prime, &Q)) != MP_OKAY) goto cleanup; if ((err = mp_sub_d(&Q, 1uL, &Q)) != MP_OKAY) goto cleanup; /* Q = prime - 1 */ mp_zero(&S); /* S = 0 */ while (MP_IS_EVEN(&Q)) { if ((err = mp_div_2(&Q, &Q)) != MP_OKAY) goto cleanup; /* Q = Q / 2 */ if ((err = mp_add_d(&S, 1uL, &S)) != MP_OKAY) goto cleanup; /* S = S + 1 */ } /* find a Z such that the Legendre symbol (Z|prime) == -1 */ mp_set_u32(&Z, 2u); /* Z = 2 */ for (;;) { if ((err = mp_kronecker(&Z, prime, &legendre)) != MP_OKAY) goto cleanup; if (legendre == -1) break; if ((err = mp_add_d(&Z, 1uL, &Z)) != MP_OKAY) goto cleanup; /* Z = Z + 1 */ } if ((err = mp_exptmod(&Z, &Q, prime, &C)) != MP_OKAY) goto cleanup; /* C = Z ^ Q mod prime */ if ((err = mp_add_d(&Q, 1uL, &t1)) != MP_OKAY) goto cleanup; if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; /* t1 = (Q + 1) / 2 */ if ((err = mp_exptmod(n, &t1, prime, &R)) != MP_OKAY) goto cleanup; /* R = n ^ ((Q + 1) / 2) mod prime */ if ((err = mp_exptmod(n, &Q, prime, &T)) != MP_OKAY) goto cleanup; /* T = n ^ Q mod prime */ if ((err = mp_copy(&S, &M)) != MP_OKAY) goto cleanup; /* M = S */ mp_set_u32(&two, 2u); for (;;) { if ((err = mp_copy(&T, &t1)) != MP_OKAY) goto cleanup; i = 0; for (;;) { if (mp_cmp_d(&t1, 1uL) == MP_EQ) break; if ((err = mp_exptmod(&t1, &two, prime, &t1)) != MP_OKAY) goto cleanup; i++; } if (i == 0u) { if ((err = mp_copy(&R, ret)) != MP_OKAY) goto cleanup; err = MP_OKAY; goto cleanup; } if ((err = mp_sub_d(&M, i, &t1)) != MP_OKAY) goto cleanup; if ((err = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) goto cleanup; if ((err = mp_exptmod(&two, &t1, prime, &t1)) != MP_OKAY) goto cleanup; /* t1 = 2 ^ (M - i - 1) */ if ((err = mp_exptmod(&C, &t1, prime, &t1)) != MP_OKAY) goto cleanup; /* t1 = C ^ (2 ^ (M - i - 1)) mod prime */ if ((err = mp_sqrmod(&t1, prime, &C)) != MP_OKAY) goto cleanup; /* C = (t1 * t1) mod prime */ if ((err = mp_mulmod(&R, &t1, prime, &R)) != MP_OKAY) goto cleanup; /* R = (R * t1) mod prime */ if ((err = mp_mulmod(&T, &C, prime, &T)) != MP_OKAY) goto cleanup; /* T = (T * C) mod prime */ mp_set(&M, i); /* M = i */ } cleanup: mp_clear_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL); return err; } #endif tcl8.6.14/libtommath/bn_mp_sub.c0000644000175000017500000000236114554262142016114 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SUB_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* high level subtraction (handles signs) */ mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c) { mp_sign sa = a->sign, sb = b->sign; mp_err err; if (sa != sb) { /* subtract a negative from a positive, OR */ /* subtract a positive from a negative. */ /* In either case, ADD their magnitudes, */ /* and use the sign of the first number. */ c->sign = sa; err = s_mp_add(a, b, c); } else { /* subtract a positive from a positive, OR */ /* subtract a negative from a negative. */ /* First, take the difference between their */ /* magnitudes, then... */ if (mp_cmp_mag(a, b) != MP_LT) { /* Copy the sign from the first */ c->sign = sa; /* The first has a larger or equal magnitude */ err = s_mp_sub(a, b, c); } else { /* The result has the *opposite* sign from */ /* the first number. */ c->sign = (sa == MP_ZPOS) ? MP_NEG : MP_ZPOS; /* The second has a larger magnitude */ err = s_mp_sub(b, a, c); } } return err; } #endif tcl8.6.14/libtommath/bn_mp_sub_d.c0000644000175000017500000000307014554262142016415 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SUB_D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* single digit subtraction */ mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) { mp_digit *tmpa, *tmpc; mp_err err; int ix, oldused; /* grow c as required */ if (c->alloc < (a->used + 1)) { if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) { return err; } } /* if a is negative just do an unsigned * addition [with fudged signs] */ if (a->sign == MP_NEG) { mp_int a_ = *a; a_.sign = MP_ZPOS; err = mp_add_d(&a_, b, c); c->sign = MP_NEG; /* clamp */ mp_clamp(c); return err; } /* setup regs */ oldused = c->used; tmpa = a->dp; tmpc = c->dp; /* if a <= b simply fix the single digit */ if (((a->used == 1) && (a->dp[0] <= b)) || (a->used == 0)) { if (a->used == 1) { *tmpc++ = b - *tmpa; } else { *tmpc++ = b; } ix = 1; /* negative/1digit */ c->sign = MP_NEG; c->used = 1; } else { mp_digit mu = b; /* positive/size */ c->sign = MP_ZPOS; c->used = a->used; /* subtract digits, mu is carry */ for (ix = 0; ix < a->used; ix++) { *tmpc = *tmpa++ - mu; mu = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u); *tmpc++ &= MP_MASK; } } /* zero excess digits */ MP_ZERO_DIGITS(tmpc, oldused - ix); mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_submod.c0000644000175000017500000000077614554262142016624 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_SUBMOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* d = a - b (mod c) */ mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) { mp_err err; mp_int t; if ((err = mp_init(&t)) != MP_OKAY) { return err; } if ((err = mp_sub(a, b, &t)) != MP_OKAY) { goto LBL_ERR; } err = mp_mod(&t, c, d); LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_to_radix.c0000644000175000017500000000364414554262142017141 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_TO_RADIX_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* stores a bignum as a ASCII string in a given radix (2..64) * * Stores upto "size - 1" chars and always a NULL byte, puts the number of characters * written, including the '\0', in "written". */ mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) { size_t digs; mp_err err; mp_int t; mp_digit d; char *_s = str; /* check range of radix and size*/ if (maxlen < 2u) { return MP_BUF; } if ((radix < 2) || (radix > 64)) { return MP_VAL; } /* quick out if its zero */ if (MP_IS_ZERO(a)) { *str++ = '0'; *str = '\0'; if (written != NULL) { *written = 2u; } return MP_OKAY; } if ((err = mp_init_copy(&t, a)) != MP_OKAY) { return err; } /* if it is negative output a - */ if (t.sign == MP_NEG) { /* we have to reverse our digits later... but not the - sign!! */ ++_s; /* store the flag and mark the number as positive */ *str++ = '-'; t.sign = MP_ZPOS; /* subtract a char */ --maxlen; } digs = 0u; while (!MP_IS_ZERO(&t)) { if (--maxlen < 1u) { /* no more room */ err = MP_BUF; goto LBL_ERR; } if ((err = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) { goto LBL_ERR; } *str++ = mp_s_rmap[d]; ++digs; } /* reverse the digits of the string. In this case _s points * to the first digit [exluding the sign] of the number */ s_mp_reverse((unsigned char *)_s, digs); /* append a NULL so the string is properly terminated */ *str = '\0'; digs++; if (written != NULL) { *written = (a->sign == MP_NEG) ? (digs + 1u): digs; } LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_to_sbin.c0000644000175000017500000000113614554262142016757 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_TO_SBIN_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* store in signed [big endian] format */ mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) { mp_err err; if (maxlen == 0u) { return MP_BUF; } if ((err = mp_to_ubin(a, buf + 1, maxlen - 1u, written)) != MP_OKAY) { return err; } if (written != NULL) { (*written)++; } buf[0] = (a->sign == MP_ZPOS) ? (unsigned char)0 : (unsigned char)1; return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_to_ubin.c0000644000175000017500000000166614554262142016771 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_TO_UBIN_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* store in unsigned [big endian] format */ mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) { size_t x, count; mp_err err; mp_int t; size_t size = (size_t)mp_count_bits(a); count = (size / 8u) + (((size & 7u) != 0u) ? 1u : 0u); if (count > maxlen) { return MP_BUF; } if ((err = mp_init_copy(&t, a)) != MP_OKAY) { return err; } for (x = count; x --> 0u;) { #ifndef MP_8BIT buf[x] = (unsigned char)(t.dp[0] & 255u); #else buf[x] = (unsigned char)(t.dp[0] | ((t.dp[1] & 1u) << 7)); #endif if ((err = mp_div_2d(&t, 8, &t, NULL)) != MP_OKAY) { goto LBL_ERR; } } if (written != NULL) { *written = count; } LBL_ERR: mp_clear(&t); return err; } #endif tcl8.6.14/libtommath/bn_mp_ubin_size.c0000644000175000017500000000054714554262142017316 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_UBIN_SIZE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* get the size for an unsigned equivalent */ size_t mp_ubin_size(const mp_int *a) { size_t size = (size_t)mp_count_bits(a); return (size / 8u) + (((size & 7u) != 0u) ? 1u : 0u); } #endif tcl8.6.14/libtommath/bn_mp_unpack.c0000644000175000017500000000261314554262142016604 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_UNPACK_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* based on gmp's mpz_import. * see http://gmplib.org/manual/Integer-Import-and-Export.html */ mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) { mp_err err; size_t odd_nails, nail_bytes, i, j; unsigned char odd_nail_mask; mp_zero(rop); if (endian == MP_NATIVE_ENDIAN) { MP_GET_ENDIANNESS(endian); } odd_nails = (nails % 8u); odd_nail_mask = 0xff; for (i = 0; i < odd_nails; ++i) { odd_nail_mask ^= (unsigned char)(1u << (7u - i)); } nail_bytes = nails / 8u; for (i = 0; i < count; ++i) { for (j = 0; j < (size - nail_bytes); ++j) { unsigned char byte = *((const unsigned char *)op + (((order == MP_MSB_FIRST) ? i : ((count - 1u) - i)) * size) + ((endian == MP_BIG_ENDIAN) ? (j + nail_bytes) : (((size - 1u) - j) - nail_bytes))); if ((err = mp_mul_2d(rop, (j == 0u) ? (int)(8u - odd_nails) : 8, rop)) != MP_OKAY) { return err; } rop->dp[0] |= (j == 0u) ? (mp_digit)(byte & odd_nail_mask) : (mp_digit)byte; rop->used += 1; } } mp_clamp(rop); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_xor.c0000644000175000017500000000261214554262142016132 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_XOR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* two complement xor */ mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c) { int used = MP_MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = (a->sign != b->sign) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { if ((err = mp_grow(c, used)) != MP_OKAY) { return err; } } for (i = 0; i < used; i++) { mp_digit x, y; /* convert to two complement if negative */ if (a->sign == MP_NEG) { ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK); x = ac & MP_MASK; ac >>= MP_DIGIT_BIT; } else { x = (i >= a->used) ? 0uL : a->dp[i]; } /* convert to two complement if negative */ if (b->sign == MP_NEG) { bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK); y = bc & MP_MASK; bc >>= MP_DIGIT_BIT; } else { y = (i >= b->used) ? 0uL : b->dp[i]; } c->dp[i] = x ^ y; /* convert to to sign-magnitude if negative */ if (csign == MP_NEG) { cc += ~c->dp[i] & MP_MASK; c->dp[i] = cc & MP_MASK; cc >>= MP_DIGIT_BIT; } } c->used = used; c->sign = csign; mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_mp_zero.c0000644000175000017500000000043714554262142016304 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_MP_ZERO_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* set to zero */ void mp_zero(mp_int *a) { a->sign = MP_ZPOS; a->used = 0; MP_ZERO_DIGITS(a->dp, a->alloc); } #endif tcl8.6.14/libtommath/bn_prime_tab.c0000644000175000017500000000537114554262142016575 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_PRIME_TAB_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ const mp_digit ltm_prime_tab[] = { 0x0002, 0x0003, 0x0005, 0x0007, 0x000B, 0x000D, 0x0011, 0x0013, 0x0017, 0x001D, 0x001F, 0x0025, 0x0029, 0x002B, 0x002F, 0x0035, 0x003B, 0x003D, 0x0043, 0x0047, 0x0049, 0x004F, 0x0053, 0x0059, 0x0061, 0x0065, 0x0067, 0x006B, 0x006D, 0x0071, 0x007F, #ifndef MP_8BIT 0x0083, 0x0089, 0x008B, 0x0095, 0x0097, 0x009D, 0x00A3, 0x00A7, 0x00AD, 0x00B3, 0x00B5, 0x00BF, 0x00C1, 0x00C5, 0x00C7, 0x00D3, 0x00DF, 0x00E3, 0x00E5, 0x00E9, 0x00EF, 0x00F1, 0x00FB, 0x0101, 0x0107, 0x010D, 0x010F, 0x0115, 0x0119, 0x011B, 0x0125, 0x0133, 0x0137, 0x0139, 0x013D, 0x014B, 0x0151, 0x015B, 0x015D, 0x0161, 0x0167, 0x016F, 0x0175, 0x017B, 0x017F, 0x0185, 0x018D, 0x0191, 0x0199, 0x01A3, 0x01A5, 0x01AF, 0x01B1, 0x01B7, 0x01BB, 0x01C1, 0x01C9, 0x01CD, 0x01CF, 0x01D3, 0x01DF, 0x01E7, 0x01EB, 0x01F3, 0x01F7, 0x01FD, 0x0209, 0x020B, 0x021D, 0x0223, 0x022D, 0x0233, 0x0239, 0x023B, 0x0241, 0x024B, 0x0251, 0x0257, 0x0259, 0x025F, 0x0265, 0x0269, 0x026B, 0x0277, 0x0281, 0x0283, 0x0287, 0x028D, 0x0293, 0x0295, 0x02A1, 0x02A5, 0x02AB, 0x02B3, 0x02BD, 0x02C5, 0x02CF, 0x02D7, 0x02DD, 0x02E3, 0x02E7, 0x02EF, 0x02F5, 0x02F9, 0x0301, 0x0305, 0x0313, 0x031D, 0x0329, 0x032B, 0x0335, 0x0337, 0x033B, 0x033D, 0x0347, 0x0355, 0x0359, 0x035B, 0x035F, 0x036D, 0x0371, 0x0373, 0x0377, 0x038B, 0x038F, 0x0397, 0x03A1, 0x03A9, 0x03AD, 0x03B3, 0x03B9, 0x03C7, 0x03CB, 0x03D1, 0x03D7, 0x03DF, 0x03E5, 0x03F1, 0x03F5, 0x03FB, 0x03FD, 0x0407, 0x0409, 0x040F, 0x0419, 0x041B, 0x0425, 0x0427, 0x042D, 0x043F, 0x0443, 0x0445, 0x0449, 0x044F, 0x0455, 0x045D, 0x0463, 0x0469, 0x047F, 0x0481, 0x048B, 0x0493, 0x049D, 0x04A3, 0x04A9, 0x04B1, 0x04BD, 0x04C1, 0x04C7, 0x04CD, 0x04CF, 0x04D5, 0x04E1, 0x04EB, 0x04FD, 0x04FF, 0x0503, 0x0509, 0x050B, 0x0511, 0x0515, 0x0517, 0x051B, 0x0527, 0x0529, 0x052F, 0x0551, 0x0557, 0x055D, 0x0565, 0x0577, 0x0581, 0x058F, 0x0593, 0x0595, 0x0599, 0x059F, 0x05A7, 0x05AB, 0x05AD, 0x05B3, 0x05BF, 0x05C9, 0x05CB, 0x05CF, 0x05D1, 0x05D5, 0x05DB, 0x05E7, 0x05F3, 0x05FB, 0x0607, 0x060D, 0x0611, 0x0617, 0x061F, 0x0623, 0x062B, 0x062F, 0x063D, 0x0641, 0x0647, 0x0649, 0x064D, 0x0653 #endif }; #if defined(__GNUC__) && __GNUC__ >= 4 #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wdeprecated-declarations" const mp_digit *s_mp_prime_tab = ltm_prime_tab; #pragma GCC diagnostic pop #elif defined(_MSC_VER) && _MSC_VER >= 1500 #pragma warning(push) #pragma warning(disable: 4996) const mp_digit *s_mp_prime_tab = ltm_prime_tab; #pragma warning(pop) #else const mp_digit *s_mp_prime_tab = ltm_prime_tab; #endif #endif tcl8.6.14/libtommath/bn_s_mp_add.c0000644000175000017500000000401314554262142016371 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_ADD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* low level addition, based on HAC pp.594, Algorithm 14.7 */ mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) { const mp_int *x; mp_err err; int olduse, min, max; /* find sizes, we let |a| <= |b| which means we have to sort * them. "x" will point to the input with the most digits */ if (a->used > b->used) { min = b->used; max = a->used; x = a; } else { min = a->used; max = b->used; x = b; } /* init result */ if (c->alloc < (max + 1)) { if ((err = mp_grow(c, max + 1)) != MP_OKAY) { return err; } } /* get old used digit count and set new one */ olduse = c->used; c->used = max + 1; { mp_digit u, *tmpa, *tmpb, *tmpc; int i; /* alias for digit pointers */ /* first input */ tmpa = a->dp; /* second input */ tmpb = b->dp; /* destination */ tmpc = c->dp; /* zero the carry */ u = 0; for (i = 0; i < min; i++) { /* Compute the sum at one digit, T[i] = A[i] + B[i] + U */ *tmpc = *tmpa++ + *tmpb++ + u; /* U = carry bit of T[i] */ u = *tmpc >> (mp_digit)MP_DIGIT_BIT; /* take away carry bit from T[i] */ *tmpc++ &= MP_MASK; } /* now copy higher words if any, that is in A+B * if A or B has more digits add those in */ if (min != max) { for (; i < max; i++) { /* T[i] = X[i] + U */ *tmpc = x->dp[i] + u; /* U = carry bit of T[i] */ u = *tmpc >> (mp_digit)MP_DIGIT_BIT; /* take away carry bit from T[i] */ *tmpc++ &= MP_MASK; } } /* add carry */ *tmpc++ = u; /* clear digits above oldused */ MP_ZERO_DIGITS(tmpc, olduse - c->used); } mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_balance_mul.c0000644000175000017500000000404314554262142020106 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_BALANCE_MUL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* single-digit multiplication with the smaller number as the single-digit */ mp_err s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c) { int count, len_a, len_b, nblocks, i, j, bsize; mp_int a0, tmp, A, B, r; mp_err err; len_a = a->used; len_b = b->used; nblocks = MP_MAX(a->used, b->used) / MP_MIN(a->used, b->used); bsize = MP_MIN(a->used, b->used) ; if ((err = mp_init_size(&a0, bsize + 2)) != MP_OKAY) { return err; } if ((err = mp_init_multi(&tmp, &r, (void *)NULL)) != MP_OKAY) { mp_clear(&a0); return err; } /* Make sure that A is the larger one*/ if (len_a < len_b) { B = *a; A = *b; } else { A = *a; B = *b; } for (i = 0, j=0; i < nblocks; i++) { /* Cut a slice off of a */ a0.used = 0; for (count = 0; count < bsize; count++) { a0.dp[count] = A.dp[ j++ ]; a0.used++; } mp_clamp(&a0); /* Multiply with b */ if ((err = mp_mul(&a0, &B, &tmp)) != MP_OKAY) { goto LBL_ERR; } /* Shift tmp to the correct position */ if ((err = mp_lshd(&tmp, bsize * i)) != MP_OKAY) { goto LBL_ERR; } /* Add to output. No carry needed */ if ((err = mp_add(&r, &tmp, &r)) != MP_OKAY) { goto LBL_ERR; } } /* The left-overs; there are always left-overs */ if (j < A.used) { a0.used = 0; for (count = 0; j < A.used; count++) { a0.dp[count] = A.dp[ j++ ]; a0.used++; } mp_clamp(&a0); if ((err = mp_mul(&a0, &B, &tmp)) != MP_OKAY) { goto LBL_ERR; } if ((err = mp_lshd(&tmp, bsize * i)) != MP_OKAY) { goto LBL_ERR; } if ((err = mp_add(&r, &tmp, &r)) != MP_OKAY) { goto LBL_ERR; } } mp_exch(&r,c); LBL_ERR: mp_clear_multi(&a0, &tmp, &r, (void *)NULL); return err; } #endif tcl8.6.14/libtommath/bn_s_mp_exptmod.c0000644000175000017500000001340214554262142017323 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_EXPTMOD_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifdef MP_LOW_MEM # define TAB_SIZE 32 # define MAX_WINSIZE 5 #else # define TAB_SIZE 256 # define MAX_WINSIZE 0 #endif mp_err s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) { mp_int M[TAB_SIZE], res, mu; mp_digit buf; mp_err err; int bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize; mp_err(*redux)(mp_int *x, const mp_int *m, const mp_int *mu); /* find window size */ x = mp_count_bits(X); if (x <= 7) { winsize = 2; } else if (x <= 36) { winsize = 3; } else if (x <= 140) { winsize = 4; } else if (x <= 450) { winsize = 5; } else if (x <= 1303) { winsize = 6; } else if (x <= 3529) { winsize = 7; } else { winsize = 8; } winsize = MAX_WINSIZE ? MP_MIN(MAX_WINSIZE, winsize) : winsize; /* init M array */ /* init first cell */ if ((err = mp_init(&M[1])) != MP_OKAY) { return err; } /* now init the second half of the array */ for (x = 1<<(winsize-1); x < (1 << winsize); x++) { if ((err = mp_init(&M[x])) != MP_OKAY) { for (y = 1<<(winsize-1); y < x; y++) { mp_clear(&M[y]); } mp_clear(&M[1]); return err; } } /* create mu, used for Barrett reduction */ if ((err = mp_init(&mu)) != MP_OKAY) goto LBL_M; if (redmode == 0) { if ((err = mp_reduce_setup(&mu, P)) != MP_OKAY) goto LBL_MU; redux = mp_reduce; } else { if ((err = mp_reduce_2k_setup_l(P, &mu)) != MP_OKAY) goto LBL_MU; redux = mp_reduce_2k_l; } /* create M table * * The M table contains powers of the base, * e.g. M[x] = G**x mod P * * The first half of the table is not * computed though accept for M[0] and M[1] */ if ((err = mp_mod(G, P, &M[1])) != MP_OKAY) goto LBL_MU; /* compute the value at M[1<<(winsize-1)] by squaring * M[1] (winsize-1) times */ if ((err = mp_copy(&M[1], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_MU; for (x = 0; x < (winsize - 1); x++) { /* square it */ if ((err = mp_sqr(&M[(size_t)1 << (winsize - 1)], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_MU; /* reduce modulo P */ if ((err = redux(&M[(size_t)1 << (winsize - 1)], P, &mu)) != MP_OKAY) goto LBL_MU; } /* create upper table, that is M[x] = M[x-1] * M[1] (mod P) * for x = (2**(winsize - 1) + 1) to (2**winsize - 1) */ for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) { if ((err = mp_mul(&M[x - 1], &M[1], &M[x])) != MP_OKAY) goto LBL_MU; if ((err = redux(&M[x], P, &mu)) != MP_OKAY) goto LBL_MU; } /* setup result */ if ((err = mp_init(&res)) != MP_OKAY) goto LBL_MU; mp_set(&res, 1uL); /* set initial mode and bit cnt */ mode = 0; bitcnt = 1; buf = 0; digidx = X->used - 1; bitcpy = 0; bitbuf = 0; for (;;) { /* grab next digit as required */ if (--bitcnt == 0) { /* if digidx == -1 we are out of digits */ if (digidx == -1) { break; } /* read next digit and reset the bitcnt */ buf = X->dp[digidx--]; bitcnt = (int)MP_DIGIT_BIT; } /* grab the next msb from the exponent */ y = (buf >> (mp_digit)(MP_DIGIT_BIT - 1)) & 1uL; buf <<= (mp_digit)1; /* if the bit is zero and mode == 0 then we ignore it * These represent the leading zero bits before the first 1 bit * in the exponent. Technically this opt is not required but it * does lower the # of trivial squaring/reductions used */ if ((mode == 0) && (y == 0)) { continue; } /* if the bit is zero and mode == 1 then we square */ if ((mode == 1) && (y == 0)) { if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; continue; } /* else we add it to the window */ bitbuf |= (y << (winsize - ++bitcpy)); mode = 2; if (bitcpy == winsize) { /* ok window is filled so square as required and multiply */ /* square first */ for (x = 0; x < winsize; x++) { if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; } /* then multiply */ if ((err = mp_mul(&res, &M[bitbuf], &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; /* empty window and reset */ bitcpy = 0; bitbuf = 0; mode = 1; } } /* if bits remain then square/multiply */ if ((mode == 2) && (bitcpy > 0)) { /* square then multiply if the bit is set */ for (x = 0; x < bitcpy; x++) { if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; bitbuf <<= 1; if ((bitbuf & (1 << winsize)) != 0) { /* then multiply */ if ((err = mp_mul(&res, &M[1], &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; } } } mp_exch(&res, Y); err = MP_OKAY; LBL_RES: mp_clear(&res); LBL_MU: mp_clear(&mu); LBL_M: mp_clear(&M[1]); for (x = 1<<(winsize-1); x < (1 << winsize); x++) { mp_clear(&M[x]); } return err; } #endif tcl8.6.14/libtommath/bn_s_mp_exptmod_fast.c0000644000175000017500000001736014554262142020347 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_EXPTMOD_FAST_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* computes Y == G**X mod P, HAC pp.616, Algorithm 14.85 * * Uses a left-to-right k-ary sliding window to compute the modular exponentiation. * The value of k changes based on the size of the exponent. * * Uses Montgomery or Diminished Radix reduction [whichever appropriate] */ #ifdef MP_LOW_MEM # define TAB_SIZE 32 # define MAX_WINSIZE 5 #else # define TAB_SIZE 256 # define MAX_WINSIZE 0 #endif mp_err s_mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) { mp_int M[TAB_SIZE], res; mp_digit buf, mp; int bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize; mp_err err; /* use a pointer to the reduction algorithm. This allows us to use * one of many reduction algorithms without modding the guts of * the code with if statements everywhere. */ mp_err(*redux)(mp_int *x, const mp_int *n, mp_digit rho); /* find window size */ x = mp_count_bits(X); if (x <= 7) { winsize = 2; } else if (x <= 36) { winsize = 3; } else if (x <= 140) { winsize = 4; } else if (x <= 450) { winsize = 5; } else if (x <= 1303) { winsize = 6; } else if (x <= 3529) { winsize = 7; } else { winsize = 8; } winsize = MAX_WINSIZE ? MP_MIN(MAX_WINSIZE, winsize) : winsize; /* init M array */ /* init first cell */ if ((err = mp_init_size(&M[1], P->alloc)) != MP_OKAY) { return err; } /* now init the second half of the array */ for (x = 1<<(winsize-1); x < (1 << winsize); x++) { if ((err = mp_init_size(&M[x], P->alloc)) != MP_OKAY) { for (y = 1<<(winsize-1); y < x; y++) { mp_clear(&M[y]); } mp_clear(&M[1]); return err; } } /* determine and setup reduction code */ if (redmode == 0) { if (MP_HAS(MP_MONTGOMERY_SETUP)) { /* now setup montgomery */ if ((err = mp_montgomery_setup(P, &mp)) != MP_OKAY) goto LBL_M; } else { err = MP_VAL; goto LBL_M; } /* automatically pick the comba one if available (saves quite a few calls/ifs) */ if (MP_HAS(S_MP_MONTGOMERY_REDUCE_FAST) && (((P->used * 2) + 1) < MP_WARRAY) && (P->used < MP_MAXFAST)) { redux = s_mp_montgomery_reduce_fast; } else if (MP_HAS(MP_MONTGOMERY_REDUCE)) { /* use slower baseline Montgomery method */ redux = mp_montgomery_reduce; } else { err = MP_VAL; goto LBL_M; } } else if (redmode == 1) { if (MP_HAS(MP_DR_SETUP) && MP_HAS(MP_DR_REDUCE)) { /* setup DR reduction for moduli of the form B**k - b */ mp_dr_setup(P, &mp); redux = mp_dr_reduce; } else { err = MP_VAL; goto LBL_M; } } else if (MP_HAS(MP_REDUCE_2K_SETUP) && MP_HAS(MP_REDUCE_2K)) { /* setup DR reduction for moduli of the form 2**k - b */ if ((err = mp_reduce_2k_setup(P, &mp)) != MP_OKAY) goto LBL_M; redux = mp_reduce_2k; } else { err = MP_VAL; goto LBL_M; } /* setup result */ if ((err = mp_init_size(&res, P->alloc)) != MP_OKAY) goto LBL_M; /* create M table * * * The first half of the table is not computed though accept for M[0] and M[1] */ if (redmode == 0) { if (MP_HAS(MP_MONTGOMERY_CALC_NORMALIZATION)) { /* now we need R mod m */ if ((err = mp_montgomery_calc_normalization(&res, P)) != MP_OKAY) goto LBL_RES; /* now set M[1] to G * R mod m */ if ((err = mp_mulmod(G, &res, P, &M[1])) != MP_OKAY) goto LBL_RES; } else { err = MP_VAL; goto LBL_RES; } } else { mp_set(&res, 1uL); if ((err = mp_mod(G, P, &M[1])) != MP_OKAY) goto LBL_RES; } /* compute the value at M[1<<(winsize-1)] by squaring M[1] (winsize-1) times */ if ((err = mp_copy(&M[1], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_RES; for (x = 0; x < (winsize - 1); x++) { if ((err = mp_sqr(&M[(size_t)1 << (winsize - 1)], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_RES; if ((err = redux(&M[(size_t)1 << (winsize - 1)], P, mp)) != MP_OKAY) goto LBL_RES; } /* create upper table */ for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) { if ((err = mp_mul(&M[x - 1], &M[1], &M[x])) != MP_OKAY) goto LBL_RES; if ((err = redux(&M[x], P, mp)) != MP_OKAY) goto LBL_RES; } /* set initial mode and bit cnt */ mode = 0; bitcnt = 1; buf = 0; digidx = X->used - 1; bitcpy = 0; bitbuf = 0; for (;;) { /* grab next digit as required */ if (--bitcnt == 0) { /* if digidx == -1 we are out of digits so break */ if (digidx == -1) { break; } /* read next digit and reset bitcnt */ buf = X->dp[digidx--]; bitcnt = (int)MP_DIGIT_BIT; } /* grab the next msb from the exponent */ y = (mp_digit)(buf >> (MP_DIGIT_BIT - 1)) & 1uL; buf <<= (mp_digit)1; /* if the bit is zero and mode == 0 then we ignore it * These represent the leading zero bits before the first 1 bit * in the exponent. Technically this opt is not required but it * does lower the # of trivial squaring/reductions used */ if ((mode == 0) && (y == 0)) { continue; } /* if the bit is zero and mode == 1 then we square */ if ((mode == 1) && (y == 0)) { if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; continue; } /* else we add it to the window */ bitbuf |= (y << (winsize - ++bitcpy)); mode = 2; if (bitcpy == winsize) { /* ok window is filled so square as required and multiply */ /* square first */ for (x = 0; x < winsize; x++) { if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; } /* then multiply */ if ((err = mp_mul(&res, &M[bitbuf], &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; /* empty window and reset */ bitcpy = 0; bitbuf = 0; mode = 1; } } /* if bits remain then square/multiply */ if ((mode == 2) && (bitcpy > 0)) { /* square then multiply if the bit is set */ for (x = 0; x < bitcpy; x++) { if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; /* get next bit of the window */ bitbuf <<= 1; if ((bitbuf & (1 << winsize)) != 0) { /* then multiply */ if ((err = mp_mul(&res, &M[1], &res)) != MP_OKAY) goto LBL_RES; if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; } } } if (redmode == 0) { /* fixup result if Montgomery reduction is used * recall that any value in a Montgomery system is * actually multiplied by R mod n. So we have * to reduce one more time to cancel out the factor * of R. */ if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; } /* swap res with Y */ mp_exch(&res, Y); err = MP_OKAY; LBL_RES: mp_clear(&res); LBL_M: mp_clear(&M[1]); for (x = 1<<(winsize-1); x < (1 << winsize); x++) { mp_clear(&M[x]); } return err; } #endif tcl8.6.14/libtommath/bn_s_mp_get_bit.c0000644000175000017500000000101114554262142017251 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_GET_BIT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Get bit at position b and return MP_YES if the bit is 1, MP_NO if it is 0 */ mp_bool s_mp_get_bit(const mp_int *a, unsigned int b) { mp_digit bit; int limb = (int)(b / MP_DIGIT_BIT); if (limb >= a->used) { return MP_NO; } bit = (mp_digit)1 << (b % MP_DIGIT_BIT); return ((a->dp[limb] & bit) != 0u) ? MP_YES : MP_NO; } #endif tcl8.6.14/libtommath/bn_s_mp_invmod_fast.c0000644000175000017500000000643214554262142020161 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_INVMOD_FAST_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* computes the modular inverse via binary extended euclidean algorithm, * that is c = 1/a mod b * * Based on slow invmod except this is optimized for the case where b is * odd as per HAC Note 14.64 on pp. 610 */ mp_err s_mp_invmod_fast(const mp_int *a, const mp_int *b, mp_int *c) { mp_int x, y, u, v, B, D; mp_sign neg; mp_err err; /* 2. [modified] b must be odd */ if (MP_IS_EVEN(b)) { return MP_VAL; } /* init all our temps */ if ((err = mp_init_multi(&x, &y, &u, &v, &B, &D, NULL)) != MP_OKAY) { return err; } /* x == modulus, y == value to invert */ if ((err = mp_copy(b, &x)) != MP_OKAY) goto LBL_ERR; /* we need y = |a| */ if ((err = mp_mod(a, b, &y)) != MP_OKAY) goto LBL_ERR; /* if one of x,y is zero return an error! */ if (MP_IS_ZERO(&x) || MP_IS_ZERO(&y)) { err = MP_VAL; goto LBL_ERR; } /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */ if ((err = mp_copy(&x, &u)) != MP_OKAY) goto LBL_ERR; if ((err = mp_copy(&y, &v)) != MP_OKAY) goto LBL_ERR; mp_set(&D, 1uL); top: /* 4. while u is even do */ while (MP_IS_EVEN(&u)) { /* 4.1 u = u/2 */ if ((err = mp_div_2(&u, &u)) != MP_OKAY) goto LBL_ERR; /* 4.2 if B is odd then */ if (MP_IS_ODD(&B)) { if ((err = mp_sub(&B, &x, &B)) != MP_OKAY) goto LBL_ERR; } /* B = B/2 */ if ((err = mp_div_2(&B, &B)) != MP_OKAY) goto LBL_ERR; } /* 5. while v is even do */ while (MP_IS_EVEN(&v)) { /* 5.1 v = v/2 */ if ((err = mp_div_2(&v, &v)) != MP_OKAY) goto LBL_ERR; /* 5.2 if D is odd then */ if (MP_IS_ODD(&D)) { /* D = (D-x)/2 */ if ((err = mp_sub(&D, &x, &D)) != MP_OKAY) goto LBL_ERR; } /* D = D/2 */ if ((err = mp_div_2(&D, &D)) != MP_OKAY) goto LBL_ERR; } /* 6. if u >= v then */ if (mp_cmp(&u, &v) != MP_LT) { /* u = u - v, B = B - D */ if ((err = mp_sub(&u, &v, &u)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&B, &D, &B)) != MP_OKAY) goto LBL_ERR; } else { /* v - v - u, D = D - B */ if ((err = mp_sub(&v, &u, &v)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&D, &B, &D)) != MP_OKAY) goto LBL_ERR; } /* if not zero goto step 4 */ if (!MP_IS_ZERO(&u)) { goto top; } /* now a = C, b = D, gcd == g*v */ /* if v != 1 then there is no inverse */ if (mp_cmp_d(&v, 1uL) != MP_EQ) { err = MP_VAL; goto LBL_ERR; } /* b is now the inverse */ neg = a->sign; while (D.sign == MP_NEG) { if ((err = mp_add(&D, b, &D)) != MP_OKAY) goto LBL_ERR; } /* too big */ while (mp_cmp_mag(&D, b) != MP_LT) { if ((err = mp_sub(&D, b, &D)) != MP_OKAY) goto LBL_ERR; } mp_exch(&D, c); c->sign = neg; err = MP_OKAY; LBL_ERR: mp_clear_multi(&x, &y, &u, &v, &B, &D, NULL); return err; } #endif tcl8.6.14/libtommath/bn_s_mp_invmod_slow.c0000644000175000017500000000733514554262142020213 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_INVMOD_SLOW_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* hac 14.61, pp608 */ mp_err s_mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) { mp_int x, y, u, v, A, B, C, D; mp_err err; /* b cannot be negative */ if ((b->sign == MP_NEG) || MP_IS_ZERO(b)) { return MP_VAL; } /* init temps */ if ((err = mp_init_multi(&x, &y, &u, &v, &A, &B, &C, &D, NULL)) != MP_OKAY) { return err; } /* x = a, y = b */ if ((err = mp_mod(a, b, &x)) != MP_OKAY) goto LBL_ERR; if ((err = mp_copy(b, &y)) != MP_OKAY) goto LBL_ERR; /* 2. [modified] if x,y are both even then return an error! */ if (MP_IS_EVEN(&x) && MP_IS_EVEN(&y)) { err = MP_VAL; goto LBL_ERR; } /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */ if ((err = mp_copy(&x, &u)) != MP_OKAY) goto LBL_ERR; if ((err = mp_copy(&y, &v)) != MP_OKAY) goto LBL_ERR; mp_set(&A, 1uL); mp_set(&D, 1uL); top: /* 4. while u is even do */ while (MP_IS_EVEN(&u)) { /* 4.1 u = u/2 */ if ((err = mp_div_2(&u, &u)) != MP_OKAY) goto LBL_ERR; /* 4.2 if A or B is odd then */ if (MP_IS_ODD(&A) || MP_IS_ODD(&B)) { /* A = (A+y)/2, B = (B-x)/2 */ if ((err = mp_add(&A, &y, &A)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&B, &x, &B)) != MP_OKAY) goto LBL_ERR; } /* A = A/2, B = B/2 */ if ((err = mp_div_2(&A, &A)) != MP_OKAY) goto LBL_ERR; if ((err = mp_div_2(&B, &B)) != MP_OKAY) goto LBL_ERR; } /* 5. while v is even do */ while (MP_IS_EVEN(&v)) { /* 5.1 v = v/2 */ if ((err = mp_div_2(&v, &v)) != MP_OKAY) goto LBL_ERR; /* 5.2 if C or D is odd then */ if (MP_IS_ODD(&C) || MP_IS_ODD(&D)) { /* C = (C+y)/2, D = (D-x)/2 */ if ((err = mp_add(&C, &y, &C)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&D, &x, &D)) != MP_OKAY) goto LBL_ERR; } /* C = C/2, D = D/2 */ if ((err = mp_div_2(&C, &C)) != MP_OKAY) goto LBL_ERR; if ((err = mp_div_2(&D, &D)) != MP_OKAY) goto LBL_ERR; } /* 6. if u >= v then */ if (mp_cmp(&u, &v) != MP_LT) { /* u = u - v, A = A - C, B = B - D */ if ((err = mp_sub(&u, &v, &u)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&A, &C, &A)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&B, &D, &B)) != MP_OKAY) goto LBL_ERR; } else { /* v - v - u, C = C - A, D = D - B */ if ((err = mp_sub(&v, &u, &v)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&C, &A, &C)) != MP_OKAY) goto LBL_ERR; if ((err = mp_sub(&D, &B, &D)) != MP_OKAY) goto LBL_ERR; } /* if not zero goto step 4 */ if (!MP_IS_ZERO(&u)) { goto top; } /* now a = C, b = D, gcd == g*v */ /* if v != 1 then there is no inverse */ if (mp_cmp_d(&v, 1uL) != MP_EQ) { err = MP_VAL; goto LBL_ERR; } /* if its too low */ while (mp_cmp_d(&C, 0uL) == MP_LT) { if ((err = mp_add(&C, b, &C)) != MP_OKAY) goto LBL_ERR; } /* too big */ while (mp_cmp_mag(&C, b) != MP_LT) { if ((err = mp_sub(&C, b, &C)) != MP_OKAY) goto LBL_ERR; } /* C is now the inverse */ mp_exch(&C, c); err = MP_OKAY; LBL_ERR: mp_clear_multi(&x, &y, &u, &v, &A, &B, &C, &D, NULL); return err; } #endif tcl8.6.14/libtommath/bn_s_mp_karatsuba_mul.c0000644000175000017500000001100214554262142020467 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_KARATSUBA_MUL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* c = |a| * |b| using Karatsuba Multiplication using * three half size multiplications * * Let B represent the radix [e.g. 2**MP_DIGIT_BIT] and * let n represent half of the number of digits in * the min(a,b) * * a = a1 * B**n + a0 * b = b1 * B**n + b0 * * Then, a * b => a1b1 * B**2n + ((a1 + a0)(b1 + b0) - (a0b0 + a1b1)) * B + a0b0 * * Note that a1b1 and a0b0 are used twice and only need to be * computed once. So in total three half size (half # of * digit) multiplications are performed, a0b0, a1b1 and * (a1+b1)(a0+b0) * * Note that a multiplication of half the digits requires * 1/4th the number of single precision multiplications so in * total after one call 25% of the single precision multiplications * are saved. Note also that the call to mp_mul can end up back * in this function if the a0, a1, b0, or b1 are above the threshold. * This is known as divide-and-conquer and leads to the famous * O(N**lg(3)) or O(N**1.584) work which is asymptopically lower than * the standard O(N**2) that the baseline/comba methods use. * Generally though the overhead of this method doesn't pay off * until a certain size (N ~ 80) is reached. */ mp_err s_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) { mp_int x0, x1, y0, y1, t1, x0y0, x1y1; int B; mp_err err = MP_MEM; /* default the return code to an error */ /* min # of digits */ B = MP_MIN(a->used, b->used); /* now divide in two */ B = B >> 1; /* init copy all the temps */ if (mp_init_size(&x0, B) != MP_OKAY) { goto LBL_ERR; } if (mp_init_size(&x1, a->used - B) != MP_OKAY) { goto X0; } if (mp_init_size(&y0, B) != MP_OKAY) { goto X1; } if (mp_init_size(&y1, b->used - B) != MP_OKAY) { goto Y0; } /* init temps */ if (mp_init_size(&t1, B * 2) != MP_OKAY) { goto Y1; } if (mp_init_size(&x0y0, B * 2) != MP_OKAY) { goto T1; } if (mp_init_size(&x1y1, B * 2) != MP_OKAY) { goto X0Y0; } /* now shift the digits */ x0.used = y0.used = B; x1.used = a->used - B; y1.used = b->used - B; { int x; mp_digit *tmpa, *tmpb, *tmpx, *tmpy; /* we copy the digits directly instead of using higher level functions * since we also need to shift the digits */ tmpa = a->dp; tmpb = b->dp; tmpx = x0.dp; tmpy = y0.dp; for (x = 0; x < B; x++) { *tmpx++ = *tmpa++; *tmpy++ = *tmpb++; } tmpx = x1.dp; for (x = B; x < a->used; x++) { *tmpx++ = *tmpa++; } tmpy = y1.dp; for (x = B; x < b->used; x++) { *tmpy++ = *tmpb++; } } /* only need to clamp the lower words since by definition the * upper words x1/y1 must have a known number of digits */ mp_clamp(&x0); mp_clamp(&y0); /* now calc the products x0y0 and x1y1 */ /* after this x0 is no longer required, free temp [x0==t2]! */ if (mp_mul(&x0, &y0, &x0y0) != MP_OKAY) { goto X1Y1; /* x0y0 = x0*y0 */ } if (mp_mul(&x1, &y1, &x1y1) != MP_OKAY) { goto X1Y1; /* x1y1 = x1*y1 */ } /* now calc x1+x0 and y1+y0 */ if (s_mp_add(&x1, &x0, &t1) != MP_OKAY) { goto X1Y1; /* t1 = x1 - x0 */ } if (s_mp_add(&y1, &y0, &x0) != MP_OKAY) { goto X1Y1; /* t2 = y1 - y0 */ } if (mp_mul(&t1, &x0, &t1) != MP_OKAY) { goto X1Y1; /* t1 = (x1 + x0) * (y1 + y0) */ } /* add x0y0 */ if (mp_add(&x0y0, &x1y1, &x0) != MP_OKAY) { goto X1Y1; /* t2 = x0y0 + x1y1 */ } if (s_mp_sub(&t1, &x0, &t1) != MP_OKAY) { goto X1Y1; /* t1 = (x1+x0)*(y1+y0) - (x1y1 + x0y0) */ } /* shift by B */ if (mp_lshd(&t1, B) != MP_OKAY) { goto X1Y1; /* t1 = (x0y0 + x1y1 - (x1-x0)*(y1-y0))<used; /* now divide in two */ B = B >> 1; /* init copy all the temps */ if (mp_init_size(&x0, B) != MP_OKAY) goto LBL_ERR; if (mp_init_size(&x1, a->used - B) != MP_OKAY) goto X0; /* init temps */ if (mp_init_size(&t1, a->used * 2) != MP_OKAY) goto X1; if (mp_init_size(&t2, a->used * 2) != MP_OKAY) goto T1; if (mp_init_size(&x0x0, B * 2) != MP_OKAY) goto T2; if (mp_init_size(&x1x1, (a->used - B) * 2) != MP_OKAY) goto X0X0; { int x; mp_digit *dst, *src; src = a->dp; /* now shift the digits */ dst = x0.dp; for (x = 0; x < B; x++) { *dst++ = *src++; } dst = x1.dp; for (x = B; x < a->used; x++) { *dst++ = *src++; } } x0.used = B; x1.used = a->used - B; mp_clamp(&x0); /* now calc the products x0*x0 and x1*x1 */ if (mp_sqr(&x0, &x0x0) != MP_OKAY) goto X1X1; /* x0x0 = x0*x0 */ if (mp_sqr(&x1, &x1x1) != MP_OKAY) goto X1X1; /* x1x1 = x1*x1 */ /* now calc (x1+x0)**2 */ if (s_mp_add(&x1, &x0, &t1) != MP_OKAY) goto X1X1; /* t1 = x1 - x0 */ if (mp_sqr(&t1, &t1) != MP_OKAY) goto X1X1; /* t1 = (x1 - x0) * (x1 - x0) */ /* add x0y0 */ if (s_mp_add(&x0x0, &x1x1, &t2) != MP_OKAY) goto X1X1; /* t2 = x0x0 + x1x1 */ if (s_mp_sub(&t1, &t2, &t1) != MP_OKAY) goto X1X1; /* t1 = (x1+x0)**2 - (x0x0 + x1x1) */ /* shift by B */ if (mp_lshd(&t1, B) != MP_OKAY) goto X1X1; /* t1 = (x0x0 + x1x1 - (x1-x0)*(x1-x0))<used > MP_WARRAY) { return MP_VAL; } /* get old used count */ olduse = x->used; /* grow a as required */ if (x->alloc < (n->used + 1)) { if ((err = mp_grow(x, n->used + 1)) != MP_OKAY) { return err; } } /* first we have to get the digits of the input into * an array of double precision words W[...] */ { mp_word *_W; mp_digit *tmpx; /* alias for the W[] array */ _W = W; /* alias for the digits of x*/ tmpx = x->dp; /* copy the digits of a into W[0..a->used-1] */ for (ix = 0; ix < x->used; ix++) { *_W++ = *tmpx++; } /* zero the high words of W[a->used..m->used*2] */ if (ix < ((n->used * 2) + 1)) { MP_ZERO_BUFFER(_W, sizeof(mp_word) * (size_t)(((n->used * 2) + 1) - ix)); } } /* now we proceed to zero successive digits * from the least significant upwards */ for (ix = 0; ix < n->used; ix++) { /* mu = ai * m' mod b * * We avoid a double precision multiplication (which isn't required) * by casting the value down to a mp_digit. Note this requires * that W[ix-1] have the carry cleared (see after the inner loop) */ mp_digit mu; mu = ((W[ix] & MP_MASK) * rho) & MP_MASK; /* a = a + mu * m * b**i * * This is computed in place and on the fly. The multiplication * by b**i is handled by offseting which columns the results * are added to. * * Note the comba method normally doesn't handle carries in the * inner loop In this case we fix the carry from the previous * column since the Montgomery reduction requires digits of the * result (so far) [see above] to work. This is * handled by fixing up one carry after the inner loop. The * carry fixups are done in order so after these loops the * first m->used words of W[] have the carries fixed */ { int iy; mp_digit *tmpn; mp_word *_W; /* alias for the digits of the modulus */ tmpn = n->dp; /* Alias for the columns set by an offset of ix */ _W = W + ix; /* inner loop */ for (iy = 0; iy < n->used; iy++) { *_W++ += (mp_word)mu * (mp_word)*tmpn++; } } /* now fix carry for next digit, W[ix+1] */ W[ix + 1] += W[ix] >> (mp_word)MP_DIGIT_BIT; } /* now we have to propagate the carries and * shift the words downward [all those least * significant digits we zeroed]. */ { mp_digit *tmpx; mp_word *_W, *_W1; /* nox fix rest of carries */ /* alias for current word */ _W1 = W + ix; /* alias for next word, where the carry goes */ _W = W + ++ix; for (; ix < ((n->used * 2) + 1); ix++) { *_W++ += *_W1++ >> (mp_word)MP_DIGIT_BIT; } /* copy out, A = A/b**n * * The result is A/b**n but instead of converting from an * array of mp_word to mp_digit than calling mp_rshd * we just copy them in the right order */ /* alias for destination word */ tmpx = x->dp; /* alias for shifted double precision result */ _W = W + n->used; for (ix = 0; ix < (n->used + 1); ix++) { *tmpx++ = *_W++ & (mp_word)MP_MASK; } /* zero oldused digits, if the input a was larger than * m->used+1 we'll have to clear the digits */ MP_ZERO_DIGITS(tmpx, olduse - ix); } /* set the max used and clamp */ x->used = n->used + 1; mp_clamp(x); /* if A >= m then A = A - m */ if (mp_cmp_mag(x, n) != MP_LT) { return s_mp_sub(x, n, x); } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_mul_digs.c0000644000175000017500000000403314554262142017446 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_MUL_DIGS_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* multiplies |a| * |b| and only computes upto digs digits of result * HAC pp. 595, Algorithm 14.12 Modified so you can control how * many digits of output are created. */ mp_err s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) { mp_int t; mp_err err; int pa, pb, ix, iy; mp_digit u; mp_word r; mp_digit tmpx, *tmpt, *tmpy; if (digs < 0) { return MP_VAL; } /* can we use the fast multiplier? */ if ((digs < MP_WARRAY) && (MP_MIN(a->used, b->used) < MP_MAXFAST)) { return s_mp_mul_digs_fast(a, b, c, digs); } if ((err = mp_init_size(&t, digs)) != MP_OKAY) { return err; } t.used = digs; /* compute the digits of the product directly */ pa = a->used; for (ix = 0; ix < pa; ix++) { /* set the carry to zero */ u = 0; /* limit ourselves to making digs digits of output */ pb = MP_MIN(b->used, digs - ix); /* setup some aliases */ /* copy of the digit from a used within the nested loop */ tmpx = a->dp[ix]; /* an alias for the destination shifted ix places */ tmpt = t.dp + ix; /* an alias for the digits of b */ tmpy = b->dp; /* compute the columns of the output and propagate the carry */ for (iy = 0; iy < pb; iy++) { /* compute the column as a mp_word */ r = (mp_word)*tmpt + ((mp_word)tmpx * (mp_word)*tmpy++) + (mp_word)u; /* the new column is the lower part of the result */ *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK); /* get the carry word from the result */ u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } /* set carry if it is placed below digs */ if ((ix + iy) < digs) { *tmpt = u; } } mp_clamp(&t); mp_exch(&t, c); mp_clear(&t); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_mul_digs_fast.c0000644000175000017500000000451514554262142020470 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_MUL_DIGS_FAST_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Fast (comba) multiplier * * This is the fast column-array [comba] multiplier. It is * designed to compute the columns of the product first * then handle the carries afterwards. This has the effect * of making the nested loops that compute the columns very * simple and schedulable on super-scalar processors. * * This has been modified to produce a variable number of * digits of output so if say only a half-product is required * you don't have to compute the upper half (a feature * required for fast Barrett reduction). * * Based on Algorithm 14.12 on pp.595 of HAC. * */ mp_err s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) { int olduse, pa, ix, iz; mp_err err; mp_digit W[MP_WARRAY]; mp_word _W; if (digs < 0) { return MP_VAL; } /* grow the destination as required */ if (c->alloc < digs) { if ((err = mp_grow(c, digs)) != MP_OKAY) { return err; } } /* number of output digits to produce */ pa = MP_MIN(digs, a->used + b->used); /* clear the carry */ _W = 0; for (ix = 0; ix < pa; ix++) { int tx, ty; int iy; mp_digit *tmpx, *tmpy; /* get offsets into the two bignums */ ty = MP_MIN(b->used-1, ix); tx = ix - ty; /* setup temp aliases */ tmpx = a->dp + tx; tmpy = b->dp + ty; /* this is the number of times the loop will iterrate, essentially while (tx++ < a->used && ty-- >= 0) { ... } */ iy = MP_MIN(a->used-tx, ty+1); /* execute loop */ for (iz = 0; iz < iy; ++iz) { _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; } /* store term */ W[ix] = (mp_digit)_W & MP_MASK; /* make next carry */ _W = _W >> (mp_word)MP_DIGIT_BIT; } /* setup dest */ olduse = c->used; c->used = pa; { mp_digit *tmpc; tmpc = c->dp; for (ix = 0; ix < pa; ix++) { /* now extract the previous digit [below the carry] */ *tmpc++ = W[ix]; } /* clear unused digits [that existed in the old copy of c] */ MP_ZERO_DIGITS(tmpc, olduse - ix); } mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_mul_high_digs.c0000644000175000017500000000340014554262142020442 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_MUL_HIGH_DIGS_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* multiplies |a| * |b| and does not compute the lower digs digits * [meant to get the higher part of the product] */ mp_err s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) { mp_int t; int pa, pb, ix, iy; mp_err err; mp_digit u; mp_word r; mp_digit tmpx, *tmpt, *tmpy; if (digs < 0) { return MP_VAL; } /* can we use the fast multiplier? */ if (MP_HAS(S_MP_MUL_HIGH_DIGS_FAST) && ((a->used + b->used + 1) < MP_WARRAY) && (MP_MIN(a->used, b->used) < MP_MAXFAST)) { return s_mp_mul_high_digs_fast(a, b, c, digs); } if ((err = mp_init_size(&t, a->used + b->used + 1)) != MP_OKAY) { return err; } t.used = a->used + b->used + 1; pa = a->used; pb = b->used; for (ix = 0; ix < pa; ix++) { /* clear the carry */ u = 0; /* left hand side of A[ix] * B[iy] */ tmpx = a->dp[ix]; /* alias to the address of where the digits will be stored */ tmpt = &(t.dp[digs]); /* alias for where to read the right hand side from */ tmpy = b->dp + (digs - ix); for (iy = digs - ix; iy < pb; iy++) { /* calculate the double precision result */ r = (mp_word)*tmpt + ((mp_word)tmpx * (mp_word)*tmpy++) + (mp_word)u; /* get the lower part */ *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK); /* carry the carry */ u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } *tmpt = u; } mp_clamp(&t); mp_exch(&t, c); mp_clear(&t); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_mul_high_digs_fast.c0000644000175000017500000000415314554262142021465 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_MUL_HIGH_DIGS_FAST_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* this is a modified version of s_mp_mul_digs_fast that only produces * output digits *above* digs. See the comments for s_mp_mul_digs_fast * to see how it works. * * This is used in the Barrett reduction since for one of the multiplications * only the higher digits were needed. This essentially halves the work. * * Based on Algorithm 14.12 on pp.595 of HAC. */ mp_err s_mp_mul_high_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) { int olduse, pa, ix, iz; mp_err err; mp_digit W[MP_WARRAY]; mp_word _W; if (digs < 0) { return MP_VAL; } /* grow the destination as required */ pa = a->used + b->used; if (c->alloc < pa) { if ((err = mp_grow(c, pa)) != MP_OKAY) { return err; } } /* number of output digits to produce */ pa = a->used + b->used; _W = 0; for (ix = digs; ix < pa; ix++) { int tx, ty, iy; mp_digit *tmpx, *tmpy; /* get offsets into the two bignums */ ty = MP_MIN(b->used-1, ix); tx = ix - ty; /* setup temp aliases */ tmpx = a->dp + tx; tmpy = b->dp + ty; /* this is the number of times the loop will iterrate, essentially its while (tx++ < a->used && ty-- >= 0) { ... } */ iy = MP_MIN(a->used-tx, ty+1); /* execute loop */ for (iz = 0; iz < iy; iz++) { _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; } /* store term */ W[ix] = (mp_digit)_W & MP_MASK; /* make next carry */ _W = _W >> (mp_word)MP_DIGIT_BIT; } /* setup dest */ olduse = c->used; c->used = pa; { mp_digit *tmpc; tmpc = c->dp + digs; for (ix = digs; ix < pa; ix++) { /* now extract the previous digit [below the carry] */ *tmpc++ = W[ix]; } /* clear unused digits [that existed in the old copy of c] */ MP_ZERO_DIGITS(tmpc, olduse - ix); } mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_prime_is_divisible.c0000644000175000017500000000146714554262142021514 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_PRIME_IS_DIVISIBLE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* determines if an integers is divisible by one * of the first PRIME_SIZE primes or not * * sets result to 0 if not, 1 if yes */ mp_err s_mp_prime_is_divisible(const mp_int *a, mp_bool *result) { int ix; mp_err err; mp_digit res; /* default to not */ *result = MP_NO; for (ix = 0; ix < PRIVATE_MP_PRIME_TAB_SIZE; ix++) { /* what is a mod LBL_prime_tab[ix] */ if ((err = mp_mod_d(a, s_mp_prime_tab[ix], &res)) != MP_OKAY) { return err; } /* is the residue zero? */ if (res == 0u) { *result = MP_YES; return MP_OKAY; } } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_rand_jenkins.c0000644000175000017500000000232114554262142020306 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_RAND_JENKINS_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Bob Jenkins' http://burtleburtle.net/bob/rand/smallprng.html */ /* Chosen for speed and a good "mix" */ typedef struct { uint64_t a; uint64_t b; uint64_t c; uint64_t d; } ranctx; static ranctx jenkins_x; #define rot(x,k) (((x)<<(k))|((x)>>(64-(k)))) static uint64_t s_rand_jenkins_val(void) { uint64_t e = jenkins_x.a - rot(jenkins_x.b, 7); jenkins_x.a = jenkins_x.b ^ rot(jenkins_x.c, 13); jenkins_x.b = jenkins_x.c + rot(jenkins_x.d, 37); jenkins_x.c = jenkins_x.d + e; jenkins_x.d = e + jenkins_x.a; return jenkins_x.d; } void s_mp_rand_jenkins_init(uint64_t seed) { int i; jenkins_x.a = 0xf1ea5eedULL; jenkins_x.b = jenkins_x.c = jenkins_x.d = seed; for (i = 0; i < 20; ++i) { (void)s_rand_jenkins_val(); } } mp_err s_mp_rand_jenkins(void *p, size_t n) { char *q = (char *)p; while (n > 0u) { int i; uint64_t x = s_rand_jenkins_val(); for (i = 0; (i < 8) && (n > 0u); ++i, --n) { *q++ = (char)(x & 0xFFuLL); x >>= 8; } } return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_rand_platform.c0000644000175000017500000000735514554262142020505 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_RAND_PLATFORM_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* First the OS-specific special cases * - *BSD * - Windows */ #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__) #define BN_S_READ_ARC4RANDOM_C static mp_err s_read_arc4random(void *p, size_t n) { arc4random_buf(p, n); return MP_OKAY; } #endif #if defined(_WIN32) || defined(_WIN32_WCE) #define BN_S_READ_WINCSP_C #ifndef _WIN32_WINNT #define _WIN32_WINNT 0x0400 #endif #ifdef _WIN32_WCE #define UNDER_CE #define ARM #endif #define WIN32_LEAN_AND_MEAN #include #include static mp_err s_read_wincsp(void *p, size_t n) { static HCRYPTPROV hProv = 0; if (hProv == 0) { HCRYPTPROV h = 0; if (!CryptAcquireContext(&h, NULL, MS_DEF_PROV, PROV_RSA_FULL, (CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET)) && !CryptAcquireContext(&h, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET | CRYPT_NEWKEYSET)) { return MP_ERR; } hProv = h; } return CryptGenRandom(hProv, (DWORD)n, (BYTE *)p) == TRUE ? MP_OKAY : MP_ERR; } #endif /* WIN32 */ #if !defined(BN_S_READ_WINCSP_C) && defined(__linux__) && defined(__GLIBC_PREREQ) #if __GLIBC_PREREQ(2, 25) #define BN_S_READ_GETRANDOM_C #include #include static mp_err s_read_getrandom(void *p, size_t n) { char *q = (char *)p; while (n > 0u) { ssize_t ret = getrandom(q, n, 0); if (ret < 0) { if (errno == EINTR) { continue; } return MP_ERR; } q += ret; n -= (size_t)ret; } return MP_OKAY; } #endif #endif /* We assume all platforms besides windows provide "/dev/urandom". * In case yours doesn't, define MP_NO_DEV_URANDOM at compile-time. */ #if !defined(BN_S_READ_WINCSP_C) && !defined(MP_NO_DEV_URANDOM) #define BN_S_READ_URANDOM_C #ifndef MP_DEV_URANDOM #define MP_DEV_URANDOM "/dev/urandom" #endif #include #include #include static mp_err s_read_urandom(void *p, size_t n) { int fd; char *q = (char *)p; do { fd = open(MP_DEV_URANDOM, O_RDONLY); } while ((fd == -1) && (errno == EINTR)); if (fd == -1) return MP_ERR; while (n > 0u) { ssize_t ret = read(fd, p, n); if (ret < 0) { if (errno == EINTR) { continue; } close(fd); return MP_ERR; } q += ret; n -= (size_t)ret; } close(fd); return MP_OKAY; } #endif #if defined(MP_PRNG_ENABLE_LTM_RNG) #define BN_S_READ_LTM_RNG unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void)); void (*ltm_rng_callback)(void); static mp_err s_read_ltm_rng(void *p, size_t n) { unsigned long res; if (ltm_rng == NULL) return MP_ERR; res = ltm_rng(p, n, ltm_rng_callback); if (res != n) return MP_ERR; return MP_OKAY; } #endif mp_err s_read_arc4random(void *p, size_t n); mp_err s_read_wincsp(void *p, size_t n); mp_err s_read_getrandom(void *p, size_t n); mp_err s_read_urandom(void *p, size_t n); mp_err s_read_ltm_rng(void *p, size_t n); mp_err s_mp_rand_platform(void *p, size_t n) { mp_err err = MP_ERR; if ((err != MP_OKAY) && MP_HAS(S_READ_ARC4RANDOM)) err = s_read_arc4random(p, n); if ((err != MP_OKAY) && MP_HAS(S_READ_WINCSP)) err = s_read_wincsp(p, n); if ((err != MP_OKAY) && MP_HAS(S_READ_GETRANDOM)) err = s_read_getrandom(p, n); if ((err != MP_OKAY) && MP_HAS(S_READ_URANDOM)) err = s_read_urandom(p, n); if ((err != MP_OKAY) && MP_HAS(S_READ_LTM_RNG)) err = s_read_ltm_rng(p, n); return err; } #endif tcl8.6.14/libtommath/bn_s_mp_reverse.c0000644000175000017500000000070014554262142017313 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_REVERSE_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* reverse an array, used for radix code */ void s_mp_reverse(unsigned char *s, size_t len) { size_t ix, iy; unsigned char t; ix = 0u; iy = len - 1u; while (ix < iy) { t = s[ix]; s[ix] = s[iy]; s[iy] = t; ++ix; --iy; } } #endif tcl8.6.14/libtommath/bn_s_mp_sqr.c0000644000175000017500000000362414554262142016455 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_SQR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* low level squaring, b = a*a, HAC pp.596-597, Algorithm 14.16 */ mp_err s_mp_sqr(const mp_int *a, mp_int *b) { mp_int t; int ix, iy, pa; mp_err err; mp_word r; mp_digit u, tmpx, *tmpt; pa = a->used; if ((err = mp_init_size(&t, (2 * pa) + 1)) != MP_OKAY) { return err; } /* default used is maximum possible size */ t.used = (2 * pa) + 1; for (ix = 0; ix < pa; ix++) { /* first calculate the digit at 2*ix */ /* calculate double precision result */ r = (mp_word)t.dp[2*ix] + ((mp_word)a->dp[ix] * (mp_word)a->dp[ix]); /* store lower part in result */ t.dp[ix+ix] = (mp_digit)(r & (mp_word)MP_MASK); /* get the carry */ u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); /* left hand side of A[ix] * A[iy] */ tmpx = a->dp[ix]; /* alias for where to store the results */ tmpt = t.dp + ((2 * ix) + 1); for (iy = ix + 1; iy < pa; iy++) { /* first calculate the product */ r = (mp_word)tmpx * (mp_word)a->dp[iy]; /* now calculate the double precision result, note we use * addition instead of *2 since it's easier to optimize */ r = (mp_word)*tmpt + r + r + (mp_word)u; /* store lower part */ *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK); /* get carry */ u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } /* propagate upwards */ while (u != 0uL) { r = (mp_word)*tmpt + (mp_word)u; *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK); u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } } mp_clamp(&t); mp_exch(&t, b); mp_clear(&t); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_sqr_fast.c0000644000175000017500000000467314554262142017477 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_SQR_FAST_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* the jist of squaring... * you do like mult except the offset of the tmpx [one that * starts closer to zero] can't equal the offset of tmpy. * So basically you set up iy like before then you min it with * (ty-tx) so that it never happens. You double all those * you add in the inner loop After that loop you do the squares and add them in. */ mp_err s_mp_sqr_fast(const mp_int *a, mp_int *b) { int olduse, pa, ix, iz; mp_digit W[MP_WARRAY], *tmpx; mp_word W1; mp_err err; /* grow the destination as required */ pa = a->used + a->used; if (b->alloc < pa) { if ((err = mp_grow(b, pa)) != MP_OKAY) { return err; } } /* number of output digits to produce */ W1 = 0; for (ix = 0; ix < pa; ix++) { int tx, ty, iy; mp_word _W; mp_digit *tmpy; /* clear counter */ _W = 0; /* get offsets into the two bignums */ ty = MP_MIN(a->used-1, ix); tx = ix - ty; /* setup temp aliases */ tmpx = a->dp + tx; tmpy = a->dp + ty; /* this is the number of times the loop will iterrate, essentially while (tx++ < a->used && ty-- >= 0) { ... } */ iy = MP_MIN(a->used-tx, ty+1); /* now for squaring tx can never equal ty * we halve the distance since they approach at a rate of 2x * and we have to round because odd cases need to be executed */ iy = MP_MIN(iy, ((ty-tx)+1)>>1); /* execute loop */ for (iz = 0; iz < iy; iz++) { _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; } /* double the inner product and add carry */ _W = _W + _W + W1; /* even columns have the square term in them */ if (((unsigned)ix & 1u) == 0u) { _W += (mp_word)a->dp[ix>>1] * (mp_word)a->dp[ix>>1]; } /* store it */ W[ix] = (mp_digit)_W & MP_MASK; /* make next carry */ W1 = _W >> (mp_word)MP_DIGIT_BIT; } /* setup dest */ olduse = b->used; b->used = a->used+a->used; { mp_digit *tmpb; tmpb = b->dp; for (ix = 0; ix < pa; ix++) { *tmpb++ = W[ix] & MP_MASK; } /* clear unused digits [that existed in the old copy of c] */ MP_ZERO_DIGITS(tmpb, olduse - ix); } mp_clamp(b); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_sub.c0000644000175000017500000000336014554262142016436 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_SUB_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* low level subtraction (assumes |a| > |b|), HAC pp.595 Algorithm 14.9 */ mp_err s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) { int olduse, min, max; mp_err err; /* find sizes */ min = b->used; max = a->used; /* init result */ if (c->alloc < max) { if ((err = mp_grow(c, max)) != MP_OKAY) { return err; } } olduse = c->used; c->used = max; { mp_digit u, *tmpa, *tmpb, *tmpc; int i; /* alias for digit pointers */ tmpa = a->dp; tmpb = b->dp; tmpc = c->dp; /* set carry to zero */ u = 0; for (i = 0; i < min; i++) { /* T[i] = A[i] - B[i] - U */ *tmpc = (*tmpa++ - *tmpb++) - u; /* U = carry bit of T[i] * Note this saves performing an AND operation since * if a carry does occur it will propagate all the way to the * MSB. As a result a single shift is enough to get the carry */ u = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u); /* Clear carry from T[i] */ *tmpc++ &= MP_MASK; } /* now copy higher words if any, e.g. if A has more digits than B */ for (; i < max; i++) { /* T[i] = A[i] - U */ *tmpc = *tmpa++ - u; /* U = carry bit of T[i] */ u = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u); /* Clear carry from T[i] */ *tmpc++ &= MP_MASK; } /* clear digits above used (since we may not have grown result above) */ MP_ZERO_DIGITS(tmpc, olduse - c->used); } mp_clamp(c); return MP_OKAY; } #endif tcl8.6.14/libtommath/bn_s_mp_toom_mul.c0000644000175000017500000001554614554262142017511 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_TOOM_MUL_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* multiplication using the Toom-Cook 3-way algorithm * * Much more complicated than Karatsuba but has a lower * asymptotic running time of O(N**1.464). This algorithm is * only particularly useful on VERY large inputs * (we're talking 1000s of digits here...). */ /* This file contains code from J. Arndt's book "Matters Computational" and the accompanying FXT-library with permission of the author. */ /* Setup from Chung, Jaewook, and M. Anwar Hasan. "Asymmetric squaring formulae." 18th IEEE Symposium on Computer Arithmetic (ARITH'07). IEEE, 2007. The interpolation from above needed one temporary variable more than the interpolation here: Bodrato, Marco, and Alberto Zanoni. "What about Toom-Cook matrices optimality." Centro Vito Volterra Universita di Roma Tor Vergata (2006) */ mp_err s_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) { mp_int S1, S2, T1, a0, a1, a2, b0, b1, b2; int B, count; mp_err err; /* init temps */ if ((err = mp_init_multi(&S1, &S2, &T1, (void *)NULL)) != MP_OKAY) { return err; } /* B */ B = MP_MIN(a->used, b->used) / 3; /** a = a2 * x^2 + a1 * x + a0; */ if ((err = mp_init_size(&a0, B)) != MP_OKAY) goto LBL_ERRa0; for (count = 0; count < B; count++) { a0.dp[count] = a->dp[count]; a0.used++; } mp_clamp(&a0); if ((err = mp_init_size(&a1, B)) != MP_OKAY) goto LBL_ERRa1; for (; count < (2 * B); count++) { a1.dp[count - B] = a->dp[count]; a1.used++; } mp_clamp(&a1); if ((err = mp_init_size(&a2, B + (a->used - (3 * B)))) != MP_OKAY) goto LBL_ERRa2; for (; count < a->used; count++) { a2.dp[count - (2 * B)] = a->dp[count]; a2.used++; } mp_clamp(&a2); /** b = b2 * x^2 + b1 * x + b0; */ if ((err = mp_init_size(&b0, B)) != MP_OKAY) goto LBL_ERRb0; for (count = 0; count < B; count++) { b0.dp[count] = b->dp[count]; b0.used++; } mp_clamp(&b0); if ((err = mp_init_size(&b1, B)) != MP_OKAY) goto LBL_ERRb1; for (; count < (2 * B); count++) { b1.dp[count - B] = b->dp[count]; b1.used++; } mp_clamp(&b1); if ((err = mp_init_size(&b2, B + (b->used - (3 * B)))) != MP_OKAY) goto LBL_ERRb2; for (; count < b->used; count++) { b2.dp[count - (2 * B)] = b->dp[count]; b2.used++; } mp_clamp(&b2); /** \\ S1 = (a2+a1+a0) * (b2+b1+b0); */ /** T1 = a2 + a1; */ if ((err = mp_add(&a2, &a1, &T1)) != MP_OKAY) goto LBL_ERR; /** S2 = T1 + a0; */ if ((err = mp_add(&T1, &a0, &S2)) != MP_OKAY) goto LBL_ERR; /** c = b2 + b1; */ if ((err = mp_add(&b2, &b1, c)) != MP_OKAY) goto LBL_ERR; /** S1 = c + b0; */ if ((err = mp_add(c, &b0, &S1)) != MP_OKAY) goto LBL_ERR; /** S1 = S1 * S2; */ if ((err = mp_mul(&S1, &S2, &S1)) != MP_OKAY) goto LBL_ERR; /** \\S2 = (4*a2+2*a1+a0) * (4*b2+2*b1+b0); */ /** T1 = T1 + a2; */ if ((err = mp_add(&T1, &a2, &T1)) != MP_OKAY) goto LBL_ERR; /** T1 = T1 << 1; */ if ((err = mp_mul_2(&T1, &T1)) != MP_OKAY) goto LBL_ERR; /** T1 = T1 + a0; */ if ((err = mp_add(&T1, &a0, &T1)) != MP_OKAY) goto LBL_ERR; /** c = c + b2; */ if ((err = mp_add(c, &b2, c)) != MP_OKAY) goto LBL_ERR; /** c = c << 1; */ if ((err = mp_mul_2(c, c)) != MP_OKAY) goto LBL_ERR; /** c = c + b0; */ if ((err = mp_add(c, &b0, c)) != MP_OKAY) goto LBL_ERR; /** S2 = T1 * c; */ if ((err = mp_mul(&T1, c, &S2)) != MP_OKAY) goto LBL_ERR; /** \\S3 = (a2-a1+a0) * (b2-b1+b0); */ /** a1 = a2 - a1; */ if ((err = mp_sub(&a2, &a1, &a1)) != MP_OKAY) goto LBL_ERR; /** a1 = a1 + a0; */ if ((err = mp_add(&a1, &a0, &a1)) != MP_OKAY) goto LBL_ERR; /** b1 = b2 - b1; */ if ((err = mp_sub(&b2, &b1, &b1)) != MP_OKAY) goto LBL_ERR; /** b1 = b1 + b0; */ if ((err = mp_add(&b1, &b0, &b1)) != MP_OKAY) goto LBL_ERR; /** a1 = a1 * b1; */ if ((err = mp_mul(&a1, &b1, &a1)) != MP_OKAY) goto LBL_ERR; /** b1 = a2 * b2; */ if ((err = mp_mul(&a2, &b2, &b1)) != MP_OKAY) goto LBL_ERR; /** \\S2 = (S2 - S3)/3; */ /** S2 = S2 - a1; */ if ((err = mp_sub(&S2, &a1, &S2)) != MP_OKAY) goto LBL_ERR; /** S2 = S2 / 3; \\ this is an exact division */ if ((err = mp_div_3(&S2, &S2, NULL)) != MP_OKAY) goto LBL_ERR; /** a1 = S1 - a1; */ if ((err = mp_sub(&S1, &a1, &a1)) != MP_OKAY) goto LBL_ERR; /** a1 = a1 >> 1; */ if ((err = mp_div_2(&a1, &a1)) != MP_OKAY) goto LBL_ERR; /** a0 = a0 * b0; */ if ((err = mp_mul(&a0, &b0, &a0)) != MP_OKAY) goto LBL_ERR; /** S1 = S1 - a0; */ if ((err = mp_sub(&S1, &a0, &S1)) != MP_OKAY) goto LBL_ERR; /** S2 = S2 - S1; */ if ((err = mp_sub(&S2, &S1, &S2)) != MP_OKAY) goto LBL_ERR; /** S2 = S2 >> 1; */ if ((err = mp_div_2(&S2, &S2)) != MP_OKAY) goto LBL_ERR; /** S1 = S1 - a1; */ if ((err = mp_sub(&S1, &a1, &S1)) != MP_OKAY) goto LBL_ERR; /** S1 = S1 - b1; */ if ((err = mp_sub(&S1, &b1, &S1)) != MP_OKAY) goto LBL_ERR; /** T1 = b1 << 1; */ if ((err = mp_mul_2(&b1, &T1)) != MP_OKAY) goto LBL_ERR; /** S2 = S2 - T1; */ if ((err = mp_sub(&S2, &T1, &S2)) != MP_OKAY) goto LBL_ERR; /** a1 = a1 - S2; */ if ((err = mp_sub(&a1, &S2, &a1)) != MP_OKAY) goto LBL_ERR; /** P = b1*x^4+ S2*x^3+ S1*x^2+ a1*x + a0; */ if ((err = mp_lshd(&b1, 4 * B)) != MP_OKAY) goto LBL_ERR; if ((err = mp_lshd(&S2, 3 * B)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(&b1, &S2, &b1)) != MP_OKAY) goto LBL_ERR; if ((err = mp_lshd(&S1, 2 * B)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(&b1, &S1, &b1)) != MP_OKAY) goto LBL_ERR; if ((err = mp_lshd(&a1, 1 * B)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(&b1, &a1, &b1)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(&b1, &a0, c)) != MP_OKAY) goto LBL_ERR; /** a * b - P */ LBL_ERR: mp_clear(&b2); LBL_ERRb2: mp_clear(&b1); LBL_ERRb1: mp_clear(&b0); LBL_ERRb0: mp_clear(&a2); LBL_ERRa2: mp_clear(&a1); LBL_ERRa1: mp_clear(&a0); LBL_ERRa0: mp_clear_multi(&S1, &S2, &T1, (void *)NULL); return err; } #endif tcl8.6.14/libtommath/bn_s_mp_toom_sqr.c0000644000175000017500000001071014554262142017505 0ustar sergeisergei#include "tommath_private.h" #ifdef BN_S_MP_TOOM_SQR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* squaring using Toom-Cook 3-way algorithm */ /* This file contains code from J. Arndt's book "Matters Computational" and the accompanying FXT-library with permission of the author. */ /* squaring using Toom-Cook 3-way algorithm */ /* Setup and interpolation from algorithm SQR_3 in Chung, Jaewook, and M. Anwar Hasan. "Asymmetric squaring formulae." 18th IEEE Symposium on Computer Arithmetic (ARITH'07). IEEE, 2007. */ mp_err s_mp_toom_sqr(const mp_int *a, mp_int *b) { mp_int S0, a0, a1, a2; mp_digit *tmpa, *tmpc; int B, count; mp_err err; /* init temps */ if ((err = mp_init(&S0)) != MP_OKAY) { return err; } /* B */ B = a->used / 3; /** a = a2 * x^2 + a1 * x + a0; */ if ((err = mp_init_size(&a0, B)) != MP_OKAY) goto LBL_ERRa0; a0.used = B; if ((err = mp_init_size(&a1, B)) != MP_OKAY) goto LBL_ERRa1; a1.used = B; if ((err = mp_init_size(&a2, B + (a->used - (3 * B)))) != MP_OKAY) goto LBL_ERRa2; tmpa = a->dp; tmpc = a0.dp; for (count = 0; count < B; count++) { *tmpc++ = *tmpa++; } tmpc = a1.dp; for (; count < (2 * B); count++) { *tmpc++ = *tmpa++; } tmpc = a2.dp; for (; count < a->used; count++) { *tmpc++ = *tmpa++; a2.used++; } mp_clamp(&a0); mp_clamp(&a1); mp_clamp(&a2); /** S0 = a0^2; */ if ((err = mp_sqr(&a0, &S0)) != MP_OKAY) goto LBL_ERR; /** \\S1 = (a2 + a1 + a0)^2 */ /** \\S2 = (a2 - a1 + a0)^2 */ /** \\S1 = a0 + a2; */ /** a0 = a0 + a2; */ if ((err = mp_add(&a0, &a2, &a0)) != MP_OKAY) goto LBL_ERR; /** \\S2 = S1 - a1; */ /** b = a0 - a1; */ if ((err = mp_sub(&a0, &a1, b)) != MP_OKAY) goto LBL_ERR; /** \\S1 = S1 + a1; */ /** a0 = a0 + a1; */ if ((err = mp_add(&a0, &a1, &a0)) != MP_OKAY) goto LBL_ERR; /** \\S1 = S1^2; */ /** a0 = a0^2; */ if ((err = mp_sqr(&a0, &a0)) != MP_OKAY) goto LBL_ERR; /** \\S2 = S2^2; */ /** b = b^2; */ if ((err = mp_sqr(b, b)) != MP_OKAY) goto LBL_ERR; /** \\ S3 = 2 * a1 * a2 */ /** \\S3 = a1 * a2; */ /** a1 = a1 * a2; */ if ((err = mp_mul(&a1, &a2, &a1)) != MP_OKAY) goto LBL_ERR; /** \\S3 = S3 << 1; */ /** a1 = a1 << 1; */ if ((err = mp_mul_2(&a1, &a1)) != MP_OKAY) goto LBL_ERR; /** \\S4 = a2^2; */ /** a2 = a2^2; */ if ((err = mp_sqr(&a2, &a2)) != MP_OKAY) goto LBL_ERR; /** \\ tmp = (S1 + S2)/2 */ /** \\tmp = S1 + S2; */ /** b = a0 + b; */ if ((err = mp_add(&a0, b, b)) != MP_OKAY) goto LBL_ERR; /** \\tmp = tmp >> 1; */ /** b = b >> 1; */ if ((err = mp_div_2(b, b)) != MP_OKAY) goto LBL_ERR; /** \\ S1 = S1 - tmp - S3 */ /** \\S1 = S1 - tmp; */ /** a0 = a0 - b; */ if ((err = mp_sub(&a0, b, &a0)) != MP_OKAY) goto LBL_ERR; /** \\S1 = S1 - S3; */ /** a0 = a0 - a1; */ if ((err = mp_sub(&a0, &a1, &a0)) != MP_OKAY) goto LBL_ERR; /** \\S2 = tmp - S4 -S0 */ /** \\S2 = tmp - S4; */ /** b = b - a2; */ if ((err = mp_sub(b, &a2, b)) != MP_OKAY) goto LBL_ERR; /** \\S2 = S2 - S0; */ /** b = b - S0; */ if ((err = mp_sub(b, &S0, b)) != MP_OKAY) goto LBL_ERR; /** \\P = S4*x^4 + S3*x^3 + S2*x^2 + S1*x + S0; */ /** P = a2*x^4 + a1*x^3 + b*x^2 + a0*x + S0; */ if ((err = mp_lshd(&a2, 4 * B)) != MP_OKAY) goto LBL_ERR; if ((err = mp_lshd(&a1, 3 * B)) != MP_OKAY) goto LBL_ERR; if ((err = mp_lshd(b, 2 * B)) != MP_OKAY) goto LBL_ERR; if ((err = mp_lshd(&a0, 1 * B)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(&a2, &a1, &a2)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(&a2, b, b)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(b, &a0, b)) != MP_OKAY) goto LBL_ERR; if ((err = mp_add(b, &S0, b)) != MP_OKAY) goto LBL_ERR; /** a^2 - P */ LBL_ERR: mp_clear(&a2); LBL_ERRa2: mp_clear(&a1); LBL_ERRa1: mp_clear(&a0); LBL_ERRa0: mp_clear(&S0); return err; } #endif tcl8.6.14/libtommath/tommath_class.h0000644000175000017500000007013314554262142017015 0ustar sergeisergei/* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #if !(defined(LTM1) && defined(LTM2) && defined(LTM3)) #define LTM_INSIDE #if defined(LTM2) # define LTM3 #endif #if defined(LTM1) # define LTM2 #endif #define LTM1 #if defined(LTM_ALL) # define BN_CUTOFFS_C # define BN_DEPRECATED_C # define BN_MP_2EXPT_C # define BN_MP_ABS_C # define BN_MP_ADD_C # define BN_MP_ADD_D_C # define BN_MP_ADDMOD_C # define BN_MP_AND_C # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_CMP_MAG_C # define BN_MP_CNT_LSB_C # define BN_MP_COMPLEMENT_C # define BN_MP_COPY_C # define BN_MP_COUNT_BITS_C # define BN_MP_DECR_C # define BN_MP_DIV_C # define BN_MP_DIV_2_C # define BN_MP_DIV_2D_C # define BN_MP_DIV_3_C # define BN_MP_DIV_D_C # define BN_MP_DR_IS_MODULUS_C # define BN_MP_DR_REDUCE_C # define BN_MP_DR_SETUP_C # define BN_MP_ERROR_TO_STRING_C # define BN_MP_EXCH_C # define BN_MP_EXPT_U32_C # define BN_MP_EXPTMOD_C # define BN_MP_EXTEUCLID_C # define BN_MP_FREAD_C # define BN_MP_FROM_SBIN_C # define BN_MP_FROM_UBIN_C # define BN_MP_FWRITE_C # define BN_MP_GCD_C # define BN_MP_GET_DOUBLE_C # define BN_MP_GET_I32_C # define BN_MP_GET_I64_C # define BN_MP_GET_L_C # define BN_MP_GET_LL_C # define BN_MP_GET_MAG_U32_C # define BN_MP_GET_MAG_U64_C # define BN_MP_GET_MAG_UL_C # define BN_MP_GET_MAG_ULL_C # define BN_MP_GROW_C # define BN_MP_INCR_C # define BN_MP_INIT_C # define BN_MP_INIT_COPY_C # define BN_MP_INIT_I32_C # define BN_MP_INIT_I64_C # define BN_MP_INIT_L_C # define BN_MP_INIT_LL_C # define BN_MP_INIT_MULTI_C # define BN_MP_INIT_SET_C # define BN_MP_INIT_SIZE_C # define BN_MP_INIT_U32_C # define BN_MP_INIT_U64_C # define BN_MP_INIT_UL_C # define BN_MP_INIT_ULL_C # define BN_MP_INVMOD_C # define BN_MP_IS_SQUARE_C # define BN_MP_ISEVEN_C # define BN_MP_ISODD_C # define BN_MP_KRONECKER_C # define BN_MP_LCM_C # define BN_MP_LOG_U32_C # define BN_MP_LSHD_C # define BN_MP_MOD_C # define BN_MP_MOD_2D_C # define BN_MP_MOD_D_C # define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C # define BN_MP_MONTGOMERY_REDUCE_C # define BN_MP_MONTGOMERY_SETUP_C # define BN_MP_MUL_C # define BN_MP_MUL_2_C # define BN_MP_MUL_2D_C # define BN_MP_MUL_D_C # define BN_MP_MULMOD_C # define BN_MP_NEG_C # define BN_MP_OR_C # define BN_MP_PACK_C # define BN_MP_PACK_COUNT_C # define BN_MP_PRIME_FERMAT_C # define BN_MP_PRIME_FROBENIUS_UNDERWOOD_C # define BN_MP_PRIME_IS_PRIME_C # define BN_MP_PRIME_MILLER_RABIN_C # define BN_MP_PRIME_NEXT_PRIME_C # define BN_MP_PRIME_RABIN_MILLER_TRIALS_C # define BN_MP_PRIME_RAND_C # define BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C # define BN_MP_RADIX_SIZE_C # define BN_MP_RADIX_SMAP_C # define BN_MP_RAND_C # define BN_MP_READ_RADIX_C # define BN_MP_REDUCE_C # define BN_MP_REDUCE_2K_C # define BN_MP_REDUCE_2K_L_C # define BN_MP_REDUCE_2K_SETUP_C # define BN_MP_REDUCE_2K_SETUP_L_C # define BN_MP_REDUCE_IS_2K_C # define BN_MP_REDUCE_IS_2K_L_C # define BN_MP_REDUCE_SETUP_C # define BN_MP_ROOT_U32_C # define BN_MP_RSHD_C # define BN_MP_SBIN_SIZE_C # define BN_MP_SET_C # define BN_MP_SET_DOUBLE_C # define BN_MP_SET_I32_C # define BN_MP_SET_I64_C # define BN_MP_SET_L_C # define BN_MP_SET_LL_C # define BN_MP_SET_U32_C # define BN_MP_SET_U64_C # define BN_MP_SET_UL_C # define BN_MP_SET_ULL_C # define BN_MP_SHRINK_C # define BN_MP_SIGNED_RSH_C # define BN_MP_SQR_C # define BN_MP_SQRMOD_C # define BN_MP_SQRT_C # define BN_MP_SQRTMOD_PRIME_C # define BN_MP_SUB_C # define BN_MP_SUB_D_C # define BN_MP_SUBMOD_C # define BN_MP_TO_RADIX_C # define BN_MP_TO_SBIN_C # define BN_MP_TO_UBIN_C # define BN_MP_UBIN_SIZE_C # define BN_MP_UNPACK_C # define BN_MP_XOR_C # define BN_MP_ZERO_C # define BN_PRIME_TAB_C # define BN_S_MP_ADD_C # define BN_S_MP_BALANCE_MUL_C # define BN_S_MP_EXPTMOD_C # define BN_S_MP_EXPTMOD_FAST_C # define BN_S_MP_GET_BIT_C # define BN_S_MP_INVMOD_FAST_C # define BN_S_MP_INVMOD_SLOW_C # define BN_S_MP_KARATSUBA_MUL_C # define BN_S_MP_KARATSUBA_SQR_C # define BN_S_MP_MONTGOMERY_REDUCE_FAST_C # define BN_S_MP_MUL_DIGS_C # define BN_S_MP_MUL_DIGS_FAST_C # define BN_S_MP_MUL_HIGH_DIGS_C # define BN_S_MP_MUL_HIGH_DIGS_FAST_C # define BN_S_MP_PRIME_IS_DIVISIBLE_C # define BN_S_MP_RAND_JENKINS_C # define BN_S_MP_RAND_PLATFORM_C # define BN_S_MP_REVERSE_C # define BN_S_MP_SQR_C # define BN_S_MP_SQR_FAST_C # define BN_S_MP_SUB_C # define BN_S_MP_TOOM_MUL_C # define BN_S_MP_TOOM_SQR_C #endif #endif #if defined(BN_CUTOFFS_C) #endif #if defined(BN_DEPRECATED_C) # define BN_FAST_MP_INVMOD_C # define BN_FAST_MP_MONTGOMERY_REDUCE_C # define BN_FAST_S_MP_MUL_DIGS_C # define BN_FAST_S_MP_MUL_HIGH_DIGS_C # define BN_FAST_S_MP_SQR_C # define BN_MP_AND_C # define BN_MP_BALANCE_MUL_C # define BN_MP_CMP_D_C # define BN_MP_EXPORT_C # define BN_MP_EXPTMOD_FAST_C # define BN_MP_EXPT_D_C # define BN_MP_EXPT_D_EX_C # define BN_MP_EXPT_U32_C # define BN_MP_FROM_SBIN_C # define BN_MP_FROM_UBIN_C # define BN_MP_GET_BIT_C # define BN_MP_GET_INT_C # define BN_MP_GET_LONG_C # define BN_MP_GET_LONG_LONG_C # define BN_MP_GET_MAG_U32_C # define BN_MP_GET_MAG_ULL_C # define BN_MP_GET_MAG_UL_C # define BN_MP_IMPORT_C # define BN_MP_INIT_SET_INT_C # define BN_MP_INIT_U32_C # define BN_MP_INVMOD_SLOW_C # define BN_MP_JACOBI_C # define BN_MP_KARATSUBA_MUL_C # define BN_MP_KARATSUBA_SQR_C # define BN_MP_KRONECKER_C # define BN_MP_N_ROOT_C # define BN_MP_N_ROOT_EX_C # define BN_MP_OR_C # define BN_MP_PACK_C # define BN_MP_PRIME_IS_DIVISIBLE_C # define BN_MP_PRIME_RANDOM_EX_C # define BN_MP_RAND_DIGIT_C # define BN_MP_READ_SIGNED_BIN_C # define BN_MP_READ_UNSIGNED_BIN_C # define BN_MP_ROOT_U32_C # define BN_MP_SBIN_SIZE_C # define BN_MP_SET_INT_C # define BN_MP_SET_LONG_C # define BN_MP_SET_LONG_LONG_C # define BN_MP_SET_U32_C # define BN_MP_SET_U64_C # define BN_MP_SIGNED_BIN_SIZE_C # define BN_MP_SIGNED_RSH_C # define BN_MP_TC_AND_C # define BN_MP_TC_DIV_2D_C # define BN_MP_TC_OR_C # define BN_MP_TC_XOR_C # define BN_MP_TOOM_MUL_C # define BN_MP_TOOM_SQR_C # define BN_MP_TORADIX_C # define BN_MP_TORADIX_N_C # define BN_MP_TO_RADIX_C # define BN_MP_TO_SBIN_C # define BN_MP_TO_SIGNED_BIN_C # define BN_MP_TO_SIGNED_BIN_N_C # define BN_MP_TO_UBIN_C # define BN_MP_TO_UNSIGNED_BIN_C # define BN_MP_TO_UNSIGNED_BIN_N_C # define BN_MP_UBIN_SIZE_C # define BN_MP_UNPACK_C # define BN_MP_UNSIGNED_BIN_SIZE_C # define BN_MP_XOR_C # define BN_S_MP_BALANCE_MUL_C # define BN_S_MP_EXPTMOD_FAST_C # define BN_S_MP_GET_BIT_C # define BN_S_MP_INVMOD_FAST_C # define BN_S_MP_INVMOD_SLOW_C # define BN_S_MP_KARATSUBA_MUL_C # define BN_S_MP_KARATSUBA_SQR_C # define BN_S_MP_MONTGOMERY_REDUCE_FAST_C # define BN_S_MP_MUL_DIGS_FAST_C # define BN_S_MP_MUL_HIGH_DIGS_FAST_C # define BN_S_MP_PRIME_IS_DIVISIBLE_C # define BN_S_MP_PRIME_RANDOM_EX_C # define BN_S_MP_RAND_SOURCE_C # define BN_S_MP_REVERSE_C # define BN_S_MP_SQR_FAST_C # define BN_S_MP_TOOM_MUL_C # define BN_S_MP_TOOM_SQR_C #endif #if defined(BN_MP_2EXPT_C) # define BN_MP_GROW_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_ABS_C) # define BN_MP_COPY_C #endif #if defined(BN_MP_ADD_C) # define BN_MP_CMP_MAG_C # define BN_S_MP_ADD_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_ADD_D_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C # define BN_MP_SUB_D_C #endif #if defined(BN_MP_ADDMOD_C) # define BN_MP_ADD_C # define BN_MP_CLEAR_C # define BN_MP_INIT_C # define BN_MP_MOD_C #endif #if defined(BN_MP_AND_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_MP_CLAMP_C) #endif #if defined(BN_MP_CLEAR_C) #endif #if defined(BN_MP_CLEAR_MULTI_C) # define BN_MP_CLEAR_C #endif #if defined(BN_MP_CMP_C) # define BN_MP_CMP_MAG_C #endif #if defined(BN_MP_CMP_D_C) #endif #if defined(BN_MP_CMP_MAG_C) #endif #if defined(BN_MP_CNT_LSB_C) #endif #if defined(BN_MP_COMPLEMENT_C) # define BN_MP_NEG_C # define BN_MP_SUB_D_C #endif #if defined(BN_MP_COPY_C) # define BN_MP_GROW_C #endif #if defined(BN_MP_COUNT_BITS_C) #endif #if defined(BN_MP_DECR_C) # define BN_MP_INCR_C # define BN_MP_SET_C # define BN_MP_SUB_D_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_DIV_C) # define BN_MP_ADD_C # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_CMP_C # define BN_MP_CMP_MAG_C # define BN_MP_COPY_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_2D_C # define BN_MP_EXCH_C # define BN_MP_INIT_C # define BN_MP_INIT_COPY_C # define BN_MP_INIT_SIZE_C # define BN_MP_LSHD_C # define BN_MP_MUL_2D_C # define BN_MP_MUL_D_C # define BN_MP_RSHD_C # define BN_MP_SUB_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_DIV_2_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_MP_DIV_2D_C) # define BN_MP_CLAMP_C # define BN_MP_COPY_C # define BN_MP_MOD_2D_C # define BN_MP_RSHD_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_DIV_3_C) # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_EXCH_C # define BN_MP_INIT_SIZE_C #endif #if defined(BN_MP_DIV_D_C) # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_COPY_C # define BN_MP_DIV_2D_C # define BN_MP_DIV_3_C # define BN_MP_EXCH_C # define BN_MP_INIT_SIZE_C #endif #if defined(BN_MP_DR_IS_MODULUS_C) #endif #if defined(BN_MP_DR_REDUCE_C) # define BN_MP_CLAMP_C # define BN_MP_CMP_MAG_C # define BN_MP_GROW_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_DR_SETUP_C) #endif #if defined(BN_MP_ERROR_TO_STRING_C) #endif #if defined(BN_MP_EXCH_C) #endif #if defined(BN_MP_EXPT_U32_C) # define BN_MP_CLEAR_C # define BN_MP_INIT_COPY_C # define BN_MP_MUL_C # define BN_MP_SET_C # define BN_MP_SQR_C #endif #if defined(BN_MP_EXPTMOD_C) # define BN_MP_ABS_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_DR_IS_MODULUS_C # define BN_MP_INIT_MULTI_C # define BN_MP_INVMOD_C # define BN_MP_REDUCE_IS_2K_C # define BN_MP_REDUCE_IS_2K_L_C # define BN_S_MP_EXPTMOD_C # define BN_S_MP_EXPTMOD_FAST_C #endif #if defined(BN_MP_EXTEUCLID_C) # define BN_MP_CLEAR_MULTI_C # define BN_MP_COPY_C # define BN_MP_DIV_C # define BN_MP_EXCH_C # define BN_MP_INIT_MULTI_C # define BN_MP_MUL_C # define BN_MP_NEG_C # define BN_MP_SET_C # define BN_MP_SUB_C #endif #if defined(BN_MP_FREAD_C) # define BN_MP_ADD_D_C # define BN_MP_MUL_D_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_FROM_SBIN_C) # define BN_MP_FROM_UBIN_C #endif #if defined(BN_MP_FROM_UBIN_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C # define BN_MP_MUL_2D_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_FWRITE_C) # define BN_MP_RADIX_SIZE_C # define BN_MP_TO_RADIX_C #endif #if defined(BN_MP_GCD_C) # define BN_MP_ABS_C # define BN_MP_CLEAR_C # define BN_MP_CMP_MAG_C # define BN_MP_CNT_LSB_C # define BN_MP_DIV_2D_C # define BN_MP_EXCH_C # define BN_MP_INIT_COPY_C # define BN_MP_MUL_2D_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_GET_DOUBLE_C) #endif #if defined(BN_MP_GET_I32_C) # define BN_MP_GET_MAG_U32_C #endif #if defined(BN_MP_GET_I64_C) # define BN_MP_GET_MAG_U64_C #endif #if defined(BN_MP_GET_L_C) # define BN_MP_GET_MAG_UL_C #endif #if defined(BN_MP_GET_LL_C) # define BN_MP_GET_MAG_ULL_C #endif #if defined(BN_MP_GET_MAG_U32_C) #endif #if defined(BN_MP_GET_MAG_U64_C) #endif #if defined(BN_MP_GET_MAG_UL_C) #endif #if defined(BN_MP_GET_MAG_ULL_C) #endif #if defined(BN_MP_GROW_C) #endif #if defined(BN_MP_INCR_C) # define BN_MP_ADD_D_C # define BN_MP_DECR_C # define BN_MP_SET_C #endif #if defined(BN_MP_INIT_C) #endif #if defined(BN_MP_INIT_COPY_C) # define BN_MP_CLEAR_C # define BN_MP_COPY_C # define BN_MP_INIT_SIZE_C #endif #if defined(BN_MP_INIT_I32_C) # define BN_MP_INIT_C # define BN_MP_SET_I32_C #endif #if defined(BN_MP_INIT_I64_C) # define BN_MP_INIT_C # define BN_MP_SET_I64_C #endif #if defined(BN_MP_INIT_L_C) # define BN_MP_INIT_C # define BN_MP_SET_L_C #endif #if defined(BN_MP_INIT_LL_C) # define BN_MP_INIT_C # define BN_MP_SET_LL_C #endif #if defined(BN_MP_INIT_MULTI_C) # define BN_MP_CLEAR_C # define BN_MP_INIT_C #endif #if defined(BN_MP_INIT_SET_C) # define BN_MP_INIT_C # define BN_MP_SET_C #endif #if defined(BN_MP_INIT_SIZE_C) #endif #if defined(BN_MP_INIT_U32_C) # define BN_MP_INIT_C # define BN_MP_SET_U32_C #endif #if defined(BN_MP_INIT_U64_C) # define BN_MP_INIT_C # define BN_MP_SET_U64_C #endif #if defined(BN_MP_INIT_UL_C) # define BN_MP_INIT_C # define BN_MP_SET_UL_C #endif #if defined(BN_MP_INIT_ULL_C) # define BN_MP_INIT_C # define BN_MP_SET_ULL_C #endif #if defined(BN_MP_INVMOD_C) # define BN_MP_CMP_D_C # define BN_S_MP_INVMOD_FAST_C # define BN_S_MP_INVMOD_SLOW_C #endif #if defined(BN_MP_IS_SQUARE_C) # define BN_MP_CLEAR_C # define BN_MP_CMP_MAG_C # define BN_MP_GET_I32_C # define BN_MP_INIT_U32_C # define BN_MP_MOD_C # define BN_MP_MOD_D_C # define BN_MP_SQRT_C # define BN_MP_SQR_C #endif #if defined(BN_MP_ISEVEN_C) #endif #if defined(BN_MP_ISODD_C) #endif #if defined(BN_MP_KRONECKER_C) # define BN_MP_CLEAR_C # define BN_MP_CMP_D_C # define BN_MP_CNT_LSB_C # define BN_MP_COPY_C # define BN_MP_DIV_2D_C # define BN_MP_INIT_C # define BN_MP_INIT_COPY_C # define BN_MP_MOD_C #endif #if defined(BN_MP_LCM_C) # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_MAG_C # define BN_MP_DIV_C # define BN_MP_GCD_C # define BN_MP_INIT_MULTI_C # define BN_MP_MUL_C #endif #if defined(BN_MP_LOG_U32_C) # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_COPY_C # define BN_MP_COUNT_BITS_C # define BN_MP_EXCH_C # define BN_MP_EXPT_U32_C # define BN_MP_INIT_MULTI_C # define BN_MP_MUL_C # define BN_MP_SET_C # define BN_MP_SQR_C #endif #if defined(BN_MP_LSHD_C) # define BN_MP_GROW_C #endif #if defined(BN_MP_MOD_C) # define BN_MP_ADD_C # define BN_MP_CLEAR_C # define BN_MP_DIV_C # define BN_MP_EXCH_C # define BN_MP_INIT_SIZE_C #endif #if defined(BN_MP_MOD_2D_C) # define BN_MP_CLAMP_C # define BN_MP_COPY_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_MOD_D_C) # define BN_MP_DIV_D_C #endif #if defined(BN_MP_MONTGOMERY_CALC_NORMALIZATION_C) # define BN_MP_2EXPT_C # define BN_MP_CMP_MAG_C # define BN_MP_COUNT_BITS_C # define BN_MP_MUL_2_C # define BN_MP_SET_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_MONTGOMERY_REDUCE_C) # define BN_MP_CLAMP_C # define BN_MP_CMP_MAG_C # define BN_MP_GROW_C # define BN_MP_RSHD_C # define BN_S_MP_MONTGOMERY_REDUCE_FAST_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_MONTGOMERY_SETUP_C) #endif #if defined(BN_MP_MUL_C) # define BN_S_MP_BALANCE_MUL_C # define BN_S_MP_KARATSUBA_MUL_C # define BN_S_MP_MUL_DIGS_C # define BN_S_MP_MUL_DIGS_FAST_C # define BN_S_MP_TOOM_MUL_C #endif #if defined(BN_MP_MUL_2_C) # define BN_MP_GROW_C #endif #if defined(BN_MP_MUL_2D_C) # define BN_MP_CLAMP_C # define BN_MP_COPY_C # define BN_MP_GROW_C # define BN_MP_LSHD_C #endif #if defined(BN_MP_MUL_D_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_MP_MULMOD_C) # define BN_MP_CLEAR_C # define BN_MP_INIT_SIZE_C # define BN_MP_MOD_C # define BN_MP_MUL_C #endif #if defined(BN_MP_NEG_C) # define BN_MP_COPY_C #endif #if defined(BN_MP_OR_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_MP_PACK_C) # define BN_MP_CLEAR_C # define BN_MP_DIV_2D_C # define BN_MP_INIT_COPY_C # define BN_MP_PACK_COUNT_C #endif #if defined(BN_MP_PACK_COUNT_C) # define BN_MP_COUNT_BITS_C #endif #if defined(BN_MP_PRIME_FERMAT_C) # define BN_MP_CLEAR_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_EXPTMOD_C # define BN_MP_INIT_C #endif #if defined(BN_MP_PRIME_FROBENIUS_UNDERWOOD_C) # define BN_MP_ADD_C # define BN_MP_ADD_D_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_C # define BN_MP_COUNT_BITS_C # define BN_MP_EXCH_C # define BN_MP_GCD_C # define BN_MP_INIT_MULTI_C # define BN_MP_KRONECKER_C # define BN_MP_MOD_C # define BN_MP_MUL_2_C # define BN_MP_MUL_C # define BN_MP_MUL_D_C # define BN_MP_SET_C # define BN_MP_SET_U32_C # define BN_MP_SQR_C # define BN_MP_SUB_C # define BN_MP_SUB_D_C # define BN_S_MP_GET_BIT_C #endif #if defined(BN_MP_PRIME_IS_PRIME_C) # define BN_MP_CLEAR_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_2D_C # define BN_MP_INIT_SET_C # define BN_MP_IS_SQUARE_C # define BN_MP_PRIME_MILLER_RABIN_C # define BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C # define BN_MP_RAND_C # define BN_MP_READ_RADIX_C # define BN_MP_SET_C # define BN_S_MP_PRIME_IS_DIVISIBLE_C #endif #if defined(BN_MP_PRIME_MILLER_RABIN_C) # define BN_MP_CLEAR_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_CNT_LSB_C # define BN_MP_DIV_2D_C # define BN_MP_EXPTMOD_C # define BN_MP_INIT_C # define BN_MP_INIT_COPY_C # define BN_MP_SQRMOD_C # define BN_MP_SUB_D_C #endif #if defined(BN_MP_PRIME_NEXT_PRIME_C) # define BN_MP_ADD_D_C # define BN_MP_CLEAR_C # define BN_MP_CMP_D_C # define BN_MP_INIT_C # define BN_MP_MOD_D_C # define BN_MP_PRIME_IS_PRIME_C # define BN_MP_SET_C # define BN_MP_SUB_D_C #endif #if defined(BN_MP_PRIME_RABIN_MILLER_TRIALS_C) #endif #if defined(BN_MP_PRIME_RAND_C) # define BN_MP_ADD_D_C # define BN_MP_DIV_2_C # define BN_MP_FROM_UBIN_C # define BN_MP_MUL_2_C # define BN_MP_PRIME_IS_PRIME_C # define BN_MP_SUB_D_C # define BN_S_MP_PRIME_RANDOM_EX_C # define BN_S_MP_RAND_CB_C # define BN_S_MP_RAND_SOURCE_C #endif #if defined(BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C) # define BN_MP_ADD_C # define BN_MP_ADD_D_C # define BN_MP_CLEAR_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_CNT_LSB_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_2D_C # define BN_MP_DIV_2_C # define BN_MP_GCD_C # define BN_MP_INIT_C # define BN_MP_INIT_MULTI_C # define BN_MP_KRONECKER_C # define BN_MP_MOD_C # define BN_MP_MUL_2_C # define BN_MP_MUL_C # define BN_MP_SET_C # define BN_MP_SET_I32_C # define BN_MP_SET_U32_C # define BN_MP_SQR_C # define BN_MP_SUB_C # define BN_MP_SUB_D_C # define BN_S_MP_GET_BIT_C # define BN_S_MP_MUL_SI_C #endif #if defined(BN_MP_RADIX_SIZE_C) # define BN_MP_CLEAR_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_D_C # define BN_MP_INIT_COPY_C #endif #if defined(BN_MP_RADIX_SMAP_C) #endif #if defined(BN_MP_RAND_C) # define BN_MP_GROW_C # define BN_MP_RAND_SOURCE_C # define BN_MP_ZERO_C # define BN_S_MP_RAND_PLATFORM_C # define BN_S_MP_RAND_SOURCE_C #endif #if defined(BN_MP_READ_RADIX_C) # define BN_MP_ADD_D_C # define BN_MP_MUL_D_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_REDUCE_C) # define BN_MP_ADD_C # define BN_MP_CLEAR_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_INIT_COPY_C # define BN_MP_LSHD_C # define BN_MP_MOD_2D_C # define BN_MP_MUL_C # define BN_MP_RSHD_C # define BN_MP_SET_C # define BN_MP_SUB_C # define BN_S_MP_MUL_DIGS_C # define BN_S_MP_MUL_HIGH_DIGS_C # define BN_S_MP_MUL_HIGH_DIGS_FAST_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_REDUCE_2K_C) # define BN_MP_CLEAR_C # define BN_MP_CMP_MAG_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_2D_C # define BN_MP_INIT_C # define BN_MP_MUL_D_C # define BN_S_MP_ADD_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_REDUCE_2K_L_C) # define BN_MP_CLEAR_C # define BN_MP_CMP_MAG_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_2D_C # define BN_MP_INIT_C # define BN_MP_MUL_C # define BN_S_MP_ADD_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_REDUCE_2K_SETUP_C) # define BN_MP_2EXPT_C # define BN_MP_CLEAR_C # define BN_MP_COUNT_BITS_C # define BN_MP_INIT_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_REDUCE_2K_SETUP_L_C) # define BN_MP_2EXPT_C # define BN_MP_CLEAR_C # define BN_MP_COUNT_BITS_C # define BN_MP_INIT_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_REDUCE_IS_2K_C) # define BN_MP_COUNT_BITS_C #endif #if defined(BN_MP_REDUCE_IS_2K_L_C) #endif #if defined(BN_MP_REDUCE_SETUP_C) # define BN_MP_2EXPT_C # define BN_MP_DIV_C #endif #if defined(BN_MP_ROOT_U32_C) # define BN_MP_2EXPT_C # define BN_MP_ADD_D_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_C # define BN_MP_COPY_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_C # define BN_MP_EXCH_C # define BN_MP_EXPT_U32_C # define BN_MP_INIT_MULTI_C # define BN_MP_MUL_C # define BN_MP_MUL_D_C # define BN_MP_SET_C # define BN_MP_SUB_C # define BN_MP_SUB_D_C #endif #if defined(BN_MP_RSHD_C) # define BN_MP_ZERO_C #endif #if defined(BN_MP_SBIN_SIZE_C) # define BN_MP_UBIN_SIZE_C #endif #if defined(BN_MP_SET_C) #endif #if defined(BN_MP_SET_DOUBLE_C) # define BN_MP_DIV_2D_C # define BN_MP_MUL_2D_C # define BN_MP_SET_U64_C #endif #if defined(BN_MP_SET_I32_C) # define BN_MP_SET_U32_C #endif #if defined(BN_MP_SET_I64_C) # define BN_MP_SET_U64_C #endif #if defined(BN_MP_SET_L_C) # define BN_MP_SET_UL_C #endif #if defined(BN_MP_SET_LL_C) # define BN_MP_SET_ULL_C #endif #if defined(BN_MP_SET_U32_C) #endif #if defined(BN_MP_SET_U64_C) #endif #if defined(BN_MP_SET_UL_C) #endif #if defined(BN_MP_SET_ULL_C) #endif #if defined(BN_MP_SHRINK_C) #endif #if defined(BN_MP_SIGNED_RSH_C) # define BN_MP_ADD_D_C # define BN_MP_DIV_2D_C # define BN_MP_SUB_D_C #endif #if defined(BN_MP_SQR_C) # define BN_S_MP_KARATSUBA_SQR_C # define BN_S_MP_SQR_C # define BN_S_MP_SQR_FAST_C # define BN_S_MP_TOOM_SQR_C #endif #if defined(BN_MP_SQRMOD_C) # define BN_MP_CLEAR_C # define BN_MP_INIT_C # define BN_MP_MOD_C # define BN_MP_SQR_C #endif #if defined(BN_MP_SQRT_C) # define BN_MP_ADD_C # define BN_MP_CLEAR_C # define BN_MP_CMP_MAG_C # define BN_MP_DIV_2_C # define BN_MP_DIV_C # define BN_MP_EXCH_C # define BN_MP_INIT_C # define BN_MP_INIT_COPY_C # define BN_MP_RSHD_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_SQRTMOD_PRIME_C) # define BN_MP_ADD_D_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_D_C # define BN_MP_COPY_C # define BN_MP_DIV_2_C # define BN_MP_EXPTMOD_C # define BN_MP_INIT_MULTI_C # define BN_MP_KRONECKER_C # define BN_MP_MOD_D_C # define BN_MP_MULMOD_C # define BN_MP_SET_C # define BN_MP_SET_U32_C # define BN_MP_SQRMOD_C # define BN_MP_SUB_D_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_SUB_C) # define BN_MP_CMP_MAG_C # define BN_S_MP_ADD_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_SUB_D_C) # define BN_MP_ADD_D_C # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_MP_SUBMOD_C) # define BN_MP_CLEAR_C # define BN_MP_INIT_C # define BN_MP_MOD_C # define BN_MP_SUB_C #endif #if defined(BN_MP_TO_RADIX_C) # define BN_MP_CLEAR_C # define BN_MP_DIV_D_C # define BN_MP_INIT_COPY_C # define BN_S_MP_REVERSE_C #endif #if defined(BN_MP_TO_SBIN_C) # define BN_MP_TO_UBIN_C #endif #if defined(BN_MP_TO_UBIN_C) # define BN_MP_CLEAR_C # define BN_MP_DIV_2D_C # define BN_MP_INIT_COPY_C # define BN_MP_UBIN_SIZE_C #endif #if defined(BN_MP_UBIN_SIZE_C) # define BN_MP_COUNT_BITS_C #endif #if defined(BN_MP_UNPACK_C) # define BN_MP_CLAMP_C # define BN_MP_MUL_2D_C # define BN_MP_ZERO_C #endif #if defined(BN_MP_XOR_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_MP_ZERO_C) #endif #if defined(BN_PRIME_TAB_C) #endif #if defined(BN_S_MP_ADD_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_S_MP_BALANCE_MUL_C) # define BN_MP_ADD_C # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_EXCH_C # define BN_MP_INIT_MULTI_C # define BN_MP_INIT_SIZE_C # define BN_MP_LSHD_C # define BN_MP_MUL_C #endif #if defined(BN_S_MP_EXPTMOD_C) # define BN_MP_CLEAR_C # define BN_MP_COPY_C # define BN_MP_COUNT_BITS_C # define BN_MP_EXCH_C # define BN_MP_INIT_C # define BN_MP_MOD_C # define BN_MP_MUL_C # define BN_MP_REDUCE_2K_L_C # define BN_MP_REDUCE_2K_SETUP_L_C # define BN_MP_REDUCE_C # define BN_MP_REDUCE_SETUP_C # define BN_MP_SET_C # define BN_MP_SQR_C #endif #if defined(BN_S_MP_EXPTMOD_FAST_C) # define BN_MP_CLEAR_C # define BN_MP_COPY_C # define BN_MP_COUNT_BITS_C # define BN_MP_DR_REDUCE_C # define BN_MP_DR_SETUP_C # define BN_MP_EXCH_C # define BN_MP_INIT_SIZE_C # define BN_MP_MOD_C # define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C # define BN_MP_MONTGOMERY_REDUCE_C # define BN_MP_MONTGOMERY_SETUP_C # define BN_MP_MULMOD_C # define BN_MP_MUL_C # define BN_MP_REDUCE_2K_C # define BN_MP_REDUCE_2K_SETUP_C # define BN_MP_SET_C # define BN_MP_SQR_C # define BN_S_MP_MONTGOMERY_REDUCE_FAST_C #endif #if defined(BN_S_MP_GET_BIT_C) #endif #if defined(BN_S_MP_INVMOD_FAST_C) # define BN_MP_ADD_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_CMP_MAG_C # define BN_MP_COPY_C # define BN_MP_DIV_2_C # define BN_MP_EXCH_C # define BN_MP_INIT_MULTI_C # define BN_MP_MOD_C # define BN_MP_SET_C # define BN_MP_SUB_C #endif #if defined(BN_S_MP_INVMOD_SLOW_C) # define BN_MP_ADD_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_C # define BN_MP_CMP_D_C # define BN_MP_CMP_MAG_C # define BN_MP_COPY_C # define BN_MP_DIV_2_C # define BN_MP_EXCH_C # define BN_MP_INIT_MULTI_C # define BN_MP_MOD_C # define BN_MP_SET_C # define BN_MP_SUB_C #endif #if defined(BN_S_MP_KARATSUBA_MUL_C) # define BN_MP_ADD_C # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_INIT_SIZE_C # define BN_MP_LSHD_C # define BN_MP_MUL_C # define BN_S_MP_ADD_C # define BN_S_MP_SUB_C #endif #if defined(BN_S_MP_KARATSUBA_SQR_C) # define BN_MP_ADD_C # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_INIT_SIZE_C # define BN_MP_LSHD_C # define BN_MP_SQR_C # define BN_S_MP_ADD_C # define BN_S_MP_SUB_C #endif #if defined(BN_S_MP_MONTGOMERY_REDUCE_FAST_C) # define BN_MP_CLAMP_C # define BN_MP_CMP_MAG_C # define BN_MP_GROW_C # define BN_S_MP_SUB_C #endif #if defined(BN_S_MP_MUL_DIGS_C) # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_EXCH_C # define BN_MP_INIT_SIZE_C # define BN_S_MP_MUL_DIGS_FAST_C #endif #if defined(BN_S_MP_MUL_DIGS_FAST_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_S_MP_MUL_HIGH_DIGS_C) # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_EXCH_C # define BN_MP_INIT_SIZE_C # define BN_S_MP_MUL_HIGH_DIGS_FAST_C #endif #if defined(BN_S_MP_MUL_HIGH_DIGS_FAST_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_S_MP_PRIME_IS_DIVISIBLE_C) # define BN_MP_MOD_D_C #endif #if defined(BN_S_MP_RAND_JENKINS_C) # define BN_S_MP_RAND_JENKINS_INIT_C #endif #if defined(BN_S_MP_RAND_PLATFORM_C) #endif #if defined(BN_S_MP_REVERSE_C) #endif #if defined(BN_S_MP_SQR_C) # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_EXCH_C # define BN_MP_INIT_SIZE_C #endif #if defined(BN_S_MP_SQR_FAST_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_S_MP_SUB_C) # define BN_MP_CLAMP_C # define BN_MP_GROW_C #endif #if defined(BN_S_MP_TOOM_MUL_C) # define BN_MP_ADD_C # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_DIV_2_C # define BN_MP_DIV_3_C # define BN_MP_INIT_MULTI_C # define BN_MP_INIT_SIZE_C # define BN_MP_LSHD_C # define BN_MP_MUL_2_C # define BN_MP_MUL_C # define BN_MP_SUB_C #endif #if defined(BN_S_MP_TOOM_SQR_C) # define BN_MP_ADD_C # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_DIV_2_C # define BN_MP_INIT_C # define BN_MP_INIT_SIZE_C # define BN_MP_LSHD_C # define BN_MP_MUL_2_C # define BN_MP_MUL_C # define BN_MP_SQR_C # define BN_MP_SUB_C #endif #ifdef LTM_INSIDE #undef LTM_INSIDE #ifdef LTM3 # define LTM_LAST #endif #include "tommath_superclass.h" #include "tommath_class.h" #else # define LTM_LAST #endif tcl8.6.14/libtommath/tommath_cutoffs.h0000644000175000017500000000100514554262142017351 0ustar sergeisergei/* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Current values evaluated on an AMD A8-6600K (64-bit). Type "make tune" to optimize them for your machine but be aware that it may take a long time. It took 2:30 minutes on the aforementioned machine for example. */ #define MP_DEFAULT_KARATSUBA_MUL_CUTOFF 80 #define MP_DEFAULT_KARATSUBA_SQR_CUTOFF 120 #define MP_DEFAULT_TOOM_MUL_CUTOFF 350 #define MP_DEFAULT_TOOM_SQR_CUTOFF 400 tcl8.6.14/libtommath/tommath.h0000644000175000017500000007262714554262142015642 0ustar sergeisergei/* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef BN_H_ #define BN_H_ #ifndef MP_NO_STDINT # include #endif #include #include #ifdef LTM_NO_FILE # warning LTM_NO_FILE has been deprecated, use MP_NO_FILE. # define MP_NO_FILE #endif #ifndef MP_NO_FILE # include #endif #ifdef MP_8BIT # ifdef _MSC_VER # pragma message("8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version.") # else # warning "8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version." # endif #endif #ifdef __cplusplus extern "C" { #endif /* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */ #if (defined(_WIN32) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)) && !defined(MP_64BIT) # define MP_32BIT #endif /* detect 64-bit mode if possible */ #if defined(__x86_64__) || defined(_M_X64) || defined(_M_AMD64) || defined(_M_ARM64) || \ defined(__powerpc64__) || defined(__ppc64__) || defined(__PPC64__) || \ defined(__s390x__) || defined(__arch64__) || defined(__aarch64__) || \ defined(__sparcv9) || defined(__sparc_v9__) || defined(__sparc64__) || \ defined(__ia64) || defined(__ia64__) || defined(__itanium__) || defined(_M_IA64) || \ defined(__LP64__) || defined(_LP64) || defined(__64BIT__) # if !(defined(MP_64BIT) || defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT)) # if defined(__GNUC__) && !defined(__hppa) /* we support 128bit integers only via: __attribute__((mode(TI))) */ # define MP_64BIT # else /* otherwise we fall back to MP_32BIT even on 64bit platforms */ # define MP_32BIT # endif # endif #endif #ifdef MP_DIGIT_BIT # error Defining MP_DIGIT_BIT is disallowed, use MP_8/16/31/32/64BIT #endif /* some default configurations. * * A "mp_digit" must be able to hold MP_DIGIT_BIT + 1 bits * A "mp_word" must be able to hold 2*MP_DIGIT_BIT + 1 bits * * At the very least a mp_digit must be able to hold 7 bits * [any size beyond that is ok provided it doesn't overflow the data type] */ #ifdef MP_8BIT typedef unsigned char mp_digit; typedef unsigned short private_mp_word; # define MP_DIGIT_BIT 7 #elif defined(MP_16BIT) typedef unsigned short mp_digit; typedef unsigned int private_mp_word; # define MP_DIGIT_BIT 15 #elif defined(MP_64BIT) /* for GCC only on supported platforms */ typedef Tcl_WideUInt mp_digit; #if defined(__GNUC__) typedef unsigned long private_mp_word __attribute__((mode(TI))); #endif # define MP_DIGIT_BIT 60 #else typedef unsigned int mp_digit; typedef Tcl_WideUInt private_mp_word; # ifdef MP_31BIT /* * This is an extension that uses 31-bit digits. * Please be aware that not all functions support this size, especially s_mp_mul_digs_fast * will be reduced to work on small numbers only: * Up to 8 limbs, 248 bits instead of up to 512 limbs, 15872 bits with MP_28BIT. */ # define MP_DIGIT_BIT 31 # else /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */ # define MP_DIGIT_BIT 28 # define MP_28BIT # endif #endif /* mp_word is a private type */ #define mp_word MP_DEPRECATED_PRAGMA("mp_word has been made private") private_mp_word #define MP_SIZEOF_MP_DIGIT (MP_DEPRECATED_PRAGMA("MP_SIZEOF_MP_DIGIT has been deprecated, use sizeof (mp_digit)") sizeof (mp_digit)) #define MP_MASK ((((mp_digit)1)<<((mp_digit)MP_DIGIT_BIT))-((mp_digit)1)) #define MP_DIGIT_MAX MP_MASK /* Primality generation flags */ #define MP_PRIME_BBS 0x0001 /* BBS style prime */ #define MP_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */ #define MP_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */ #define LTM_PRIME_BBS (MP_DEPRECATED_PRAGMA("LTM_PRIME_BBS has been deprecated, use MP_PRIME_BBS") MP_PRIME_BBS) #define LTM_PRIME_SAFE (MP_DEPRECATED_PRAGMA("LTM_PRIME_SAFE has been deprecated, use MP_PRIME_SAFE") MP_PRIME_SAFE) #define LTM_PRIME_2MSB_ON (MP_DEPRECATED_PRAGMA("LTM_PRIME_2MSB_ON has been deprecated, use MP_PRIME_2MSB_ON") MP_PRIME_2MSB_ON) #ifdef MP_USE_ENUMS typedef enum { MP_ZPOS = 0, /* positive */ MP_NEG = 1 /* negative */ } mp_sign; typedef enum { MP_LT = -1, /* less than */ MP_EQ = 0, /* equal */ MP_GT = 1 /* greater than */ } mp_ord; typedef enum { MP_NO = 0, MP_YES = 1 } mp_bool; typedef enum { MP_OKAY = 0, /* no error */ MP_ERR = -1, /* unknown error */ MP_MEM = -2, /* out of mem */ MP_VAL = -3, /* invalid input */ MP_ITER = -4, /* maximum iterations reached */ MP_BUF = -5 /* buffer overflow, supplied buffer too small */ } mp_err; typedef enum { MP_LSB_FIRST = -1, MP_MSB_FIRST = 1 } mp_order; typedef enum { MP_LITTLE_ENDIAN = -1, MP_NATIVE_ENDIAN = 0, MP_BIG_ENDIAN = 1 } mp_endian; #else typedef int mp_sign; #define MP_ZPOS 0 /* positive integer */ #define MP_NEG 1 /* negative */ typedef int mp_ord; #define MP_LT -1 /* less than */ #define MP_EQ 0 /* equal to */ #define MP_GT 1 /* greater than */ typedef int mp_bool; #define MP_YES 1 #define MP_NO 0 typedef int mp_err; #define MP_OKAY 0 /* no error */ #define MP_ERR -1 /* unknown error */ #define MP_MEM -2 /* out of mem */ #define MP_VAL -3 /* invalid input */ #define MP_RANGE (MP_DEPRECATED_PRAGMA("MP_RANGE has been deprecated in favor of MP_VAL") MP_VAL) #define MP_ITER -4 /* maximum iterations reached */ #define MP_BUF -5 /* buffer overflow, supplied buffer too small */ typedef int mp_order; #define MP_LSB_FIRST -1 #define MP_MSB_FIRST 1 typedef int mp_endian; #define MP_LITTLE_ENDIAN -1 #define MP_NATIVE_ENDIAN 0 #define MP_BIG_ENDIAN 1 #endif /* tunable cutoffs */ #ifndef MP_FIXED_CUTOFFS extern int KARATSUBA_MUL_CUTOFF, KARATSUBA_SQR_CUTOFF, TOOM_MUL_CUTOFF, TOOM_SQR_CUTOFF; #endif /* define this to use lower memory usage routines (exptmods mostly) */ /* #define MP_LOW_MEM */ /* default precision */ #ifndef MP_PREC # ifndef MP_LOW_MEM # define PRIVATE_MP_PREC 32 /* default digits of precision */ # elif defined(MP_8BIT) # define PRIVATE_MP_PREC 16 /* default digits of precision */ # else # define PRIVATE_MP_PREC 8 /* default digits of precision */ # endif # define MP_PREC (MP_DEPRECATED_PRAGMA("MP_PREC is an internal macro") PRIVATE_MP_PREC) #endif /* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */ #define PRIVATE_MP_WARRAY (int)(1 << (((CHAR_BIT * (int)sizeof(private_mp_word)) - (2 * MP_DIGIT_BIT)) + 1)) #define MP_WARRAY (MP_DEPRECATED_PRAGMA("MP_WARRAY is an internal macro") PRIVATE_MP_WARRAY) #if defined(__GNUC__) && __GNUC__ >= 4 # define MP_NULL_TERMINATED __attribute__((sentinel)) #else # define MP_NULL_TERMINATED #endif /* * MP_WUR - warn unused result * --------------------------- * * The result of functions annotated with MP_WUR must be * checked and cannot be ignored. * * Most functions in libtommath return an error code. * This error code must be checked in order to prevent crashes or invalid * results. * * If you still want to avoid the error checks for quick and dirty programs * without robustness guarantees, you can `#define MP_WUR` before including * tommath.h, disabling the warnings. */ #ifndef MP_WUR # if defined(__GNUC__) && __GNUC__ >= 4 # define MP_WUR __attribute__((warn_unused_result)) # else # define MP_WUR # endif #endif #if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405) # define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x))) #elif defined(_MSC_VER) && _MSC_VER >= 1500 # define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x)) #else # define MP_DEPRECATED(x) #endif #ifndef MP_NO_DEPRECATED_PRAGMA #if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301) # define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s) # define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s) #elif defined(_MSC_VER) && _MSC_VER >= 1500 # define MP_DEPRECATED_PRAGMA(s) __pragma(message(s)) #endif #endif #ifndef MP_DEPRECATED_PRAGMA # define MP_DEPRECATED_PRAGMA(s) #endif #define DIGIT_BIT (MP_DEPRECATED_PRAGMA("DIGIT_BIT macro is deprecated, MP_DIGIT_BIT instead") MP_DIGIT_BIT) #define USED(m) (MP_DEPRECATED_PRAGMA("USED macro is deprecated, use z->used instead") (m)->used) #define DIGIT(m, k) (MP_DEPRECATED_PRAGMA("DIGIT macro is deprecated, use z->dp instead") (m)->dp[(k)]) #define SIGN(m) (MP_DEPRECATED_PRAGMA("SIGN macro is deprecated, use z->sign instead") (m)->sign) /* the infamous mp_int structure */ typedef struct { int used, alloc; mp_sign sign; mp_digit *dp; } mp_int; /* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */ typedef int private_mp_prime_callback(unsigned char *dst, int len, void *dat); typedef private_mp_prime_callback MP_DEPRECATED(mp_rand_source) ltm_prime_callback; /* error code to char* string */ const char *mp_error_to_string(mp_err code) MP_WUR; /* ---> init and deinit bignum functions <--- */ /* init a bignum */ mp_err mp_init(mp_int *a) MP_WUR; /* free a bignum */ void mp_clear(mp_int *a); /* init a null terminated series of arguments */ mp_err mp_init_multi(mp_int *mp, ...) MP_NULL_TERMINATED MP_WUR; /* clear a null terminated series of arguments */ void mp_clear_multi(mp_int *mp, ...) MP_NULL_TERMINATED; /* exchange two ints */ void mp_exch(mp_int *a, mp_int *b); /* shrink ram required for a bignum */ mp_err mp_shrink(mp_int *a) MP_WUR; /* grow an int to a given size */ mp_err mp_grow(mp_int *a, int size) MP_WUR; /* init to a given number of digits */ mp_err mp_init_size(mp_int *a, int size) MP_WUR; /* ---> Basic Manipulations <--- */ #define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO) mp_bool mp_iseven(const mp_int *a) MP_WUR; mp_bool mp_isodd(const mp_int *a) MP_WUR; #define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO) /* set to zero */ void mp_zero(mp_int *a); /* get and set doubles */ double mp_get_double(const mp_int *a) MP_WUR; mp_err mp_set_double(mp_int *a, double b) MP_WUR; /* get integer, set integer and init with integer (int32_t) */ #ifndef MP_NO_STDINT int32_t mp_get_i32(const mp_int *a) MP_WUR; void mp_set_i32(mp_int *a, int32_t b); mp_err mp_init_i32(mp_int *a, int32_t b) MP_WUR; /* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint32_t) */ #define mp_get_u32(a) ((uint32_t)mp_get_i32(a)) void mp_set_u32(mp_int *a, uint32_t b); mp_err mp_init_u32(mp_int *a, uint32_t b) MP_WUR; /* get integer, set integer and init with integer (int64_t) */ int64_t mp_get_i64(const mp_int *a) MP_WUR; void mp_set_i64(mp_int *a, int64_t b); mp_err mp_init_i64(mp_int *a, int64_t b) MP_WUR; /* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint64_t) */ #define mp_get_u64(a) ((uint64_t)mp_get_i64(a)) void mp_set_u64(mp_int *a, uint64_t b); mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR; /* get magnitude */ uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR; uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR; #endif unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR; Tcl_WideUInt mp_get_mag_ull(const mp_int *a) MP_WUR; /* get integer, set integer (long) */ long mp_get_l(const mp_int *a) MP_WUR; void mp_set_l(mp_int *a, long b); mp_err mp_init_l(mp_int *a, long b) MP_WUR; /* get integer, set integer (unsigned long) */ #define mp_get_ul(a) ((unsigned long)mp_get_l(a)) void mp_set_ul(mp_int *a, unsigned long b); mp_err mp_init_ul(mp_int *a, unsigned long b) MP_WUR; /* get integer, set integer (Tcl_WideInt) */ Tcl_WideInt mp_get_ll(const mp_int *a) MP_WUR; void mp_set_ll(mp_int *a, Tcl_WideInt b); mp_err mp_init_ll(mp_int *a, Tcl_WideInt b) MP_WUR; /* get integer, set integer (Tcl_WideUInt) */ #define mp_get_ull(a) ((Tcl_WideUInt)mp_get_ll(a)) void mp_set_ull(mp_int *a, Tcl_WideUInt b); mp_err mp_init_ull(mp_int *a, Tcl_WideUInt b) MP_WUR; /* set to single unsigned digit, up to MP_DIGIT_MAX */ void mp_set(mp_int *a, mp_digit b); mp_err mp_init_set(mp_int *a, mp_digit b) MP_WUR; /* get integer, set integer and init with integer (deprecated) */ MP_DEPRECATED(mp_get_mag_u32/mp_get_u32) unsigned long mp_get_int(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_get_mag_ul/mp_get_ul) unsigned long mp_get_long(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) Tcl_WideUInt mp_get_long_long(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int *a, unsigned long b); MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int *a, unsigned long b); MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, Tcl_WideUInt b); MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int *a, unsigned long b) MP_WUR; /* copy, b = a */ mp_err mp_copy(const mp_int *a, mp_int *b) MP_WUR; /* inits and copies, a = b */ mp_err mp_init_copy(mp_int *a, const mp_int *b) MP_WUR; /* trim unused digits */ void mp_clamp(mp_int *a); /* export binary data */ MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order, size_t size, int endian, size_t nails, const mp_int *op) MP_WUR; /* import binary data */ MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, const void *op) MP_WUR; /* unpack binary data */ mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) MP_WUR; /* pack binary data */ size_t mp_pack_count(const mp_int *a, size_t nails, size_t size) MP_WUR; mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op) MP_WUR; /* ---> digit manipulation <--- */ /* right shift by "b" digits */ void mp_rshd(mp_int *a, int b); /* left shift by "b" digits */ mp_err mp_lshd(mp_int *a, int b) MP_WUR; /* c = a / 2**b, implemented as c = a >> b */ mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) MP_WUR; /* b = a/2 */ mp_err mp_div_2(const mp_int *a, mp_int *b) MP_WUR; /* a/3 => 3c + d == a */ mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) MP_WUR; /* c = a * 2**b, implemented as c = a << b */ mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) MP_WUR; /* b = a*2 */ mp_err mp_mul_2(const mp_int *a, mp_int *b) MP_WUR; /* c = a mod 2**b */ mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c) MP_WUR; /* computes a = 2**b */ mp_err mp_2expt(mp_int *a, int b) MP_WUR; /* Counts the number of lsbs which are zero before the first zero bit */ int mp_cnt_lsb(const mp_int *a) MP_WUR; /* I Love Earth! */ /* makes a pseudo-random mp_int of a given size */ mp_err mp_rand(mp_int *a, int digits) MP_WUR; /* makes a pseudo-random small int of a given size */ MP_DEPRECATED(mp_rand) mp_err mp_rand_digit(mp_digit *r) MP_WUR; /* use custom random data source instead of source provided the platform */ void mp_rand_source(mp_err(*source)(void *out, size_t size)); #ifdef MP_PRNG_ENABLE_LTM_RNG # warning MP_PRNG_ENABLE_LTM_RNG has been deprecated, use mp_rand_source instead. /* A last resort to provide random data on systems without any of the other * implemented ways to gather entropy. * It is compatible with `rng_get_bytes()` from libtomcrypt so you could * provide that one and then set `ltm_rng = rng_get_bytes;` */ extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void)); extern void (*ltm_rng_callback)(void); #endif /* ---> binary operations <--- */ /* Checks the bit at position b and returns MP_YES * if the bit is 1, MP_NO if it is 0 and MP_VAL * in case of error */ MP_DEPRECATED(s_mp_get_bit) int mp_get_bit(const mp_int *a, int b) MP_WUR; /* c = a XOR b (two complement) */ MP_DEPRECATED(mp_xor) mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = a OR b (two complement) */ MP_DEPRECATED(mp_or) mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = a AND b (two complement) */ MP_DEPRECATED(mp_and) mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* b = ~a (bitwise not, two complement) */ mp_err mp_complement(const mp_int *a, mp_int *b) MP_WUR; /* right shift with sign extension */ MP_DEPRECATED(mp_signed_rsh) mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c) MP_WUR; mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c) MP_WUR; /* ---> Basic arithmetic <--- */ /* b = -a */ mp_err mp_neg(const mp_int *a, mp_int *b) MP_WUR; /* b = |a| */ mp_err mp_abs(const mp_int *a, mp_int *b) MP_WUR; /* compare a to b */ mp_ord mp_cmp(const mp_int *a, const mp_int *b) MP_WUR; /* compare |a| to |b| */ mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR; /* c = a + b */ mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = a - b */ mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = a * b */ mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* b = a*a */ mp_err mp_sqr(const mp_int *a, mp_int *b) MP_WUR; /* a/b => cb + d == a */ mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) MP_WUR; /* c = a mod b, 0 <= c < b */ mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* Increment "a" by one like "a++". Changes input! */ mp_err mp_incr(mp_int *a) MP_WUR; /* Decrement "a" by one like "a--". Changes input! */ mp_err mp_decr(mp_int *a) MP_WUR; /* ---> single digit functions <--- */ /* compare against a single digit */ mp_ord mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR; /* c = a + b */ mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* c = a - b */ mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* c = a * b */ mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* a/b => cb + d == a */ mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) MP_WUR; /* c = a mod b, 0 <= c < b */ mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c) MP_WUR; /* ---> number theory <--- */ /* d = a + b (mod c) */ mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; /* d = a - b (mod c) */ mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; /* d = a * b (mod c) */ mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; /* c = a * a (mod b) */ mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = 1/a (mod b) */ mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = (a, b) */ mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* produces value such that U1*a + U2*b = U3 */ mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) MP_WUR; /* c = [a, b] or (a*b)/(a, b) */ mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* finds one of the b'th root of a, such that |c|**b <= |a| * * returns error if a < 0 and b is even */ mp_err mp_root_u32(const mp_int *a, unsigned int b, mp_int *c) MP_WUR; MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; /* special sqrt algo */ mp_err mp_sqrt(const mp_int *arg, mp_int *ret) MP_WUR; /* special sqrt (mod prime) */ mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) MP_WUR; /* is number a square? */ mp_err mp_is_square(const mp_int *arg, mp_bool *ret) MP_WUR; /* computes the jacobi c = (a | n) (or Legendre if b is prime) */ MP_DEPRECATED(mp_kronecker) mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c) MP_WUR; /* computes the Kronecker symbol c = (a | p) (like jacobi() but with {a,p} in Z */ mp_err mp_kronecker(const mp_int *a, const mp_int *p, int *c) MP_WUR; /* used to setup the Barrett reduction for a given modulus b */ mp_err mp_reduce_setup(mp_int *a, const mp_int *b) MP_WUR; /* Barrett Reduction, computes a (mod b) with a precomputed value c * * Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely * compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code]. */ mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) MP_WUR; /* setups the montgomery reduction */ mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) MP_WUR; /* computes a = B**n mod b without division or multiplication useful for * normalizing numbers in a Montgomery system. */ mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) MP_WUR; /* computes x/R == x (mod N) via Montgomery Reduction */ mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR; /* returns 1 if a is a valid DR modulus */ mp_bool mp_dr_is_modulus(const mp_int *a) MP_WUR; /* sets the value of "d" required for mp_dr_reduce */ void mp_dr_setup(const mp_int *a, mp_digit *d); /* reduces a modulo n using the Diminished Radix method */ mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) MP_WUR; /* returns true if a can be reduced with mp_reduce_2k */ mp_bool mp_reduce_is_2k(const mp_int *a) MP_WUR; /* determines k value for 2k reduction */ mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d) MP_WUR; /* reduces a modulo b where b is of the form 2**p - k [0 <= a] */ mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) MP_WUR; /* returns true if a can be reduced with mp_reduce_2k_l */ mp_bool mp_reduce_is_2k_l(const mp_int *a) MP_WUR; /* determines k value for 2k reduction */ mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) MP_WUR; /* reduces a modulo b where b is of the form 2**p - k [0 <= a] */ mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d) MP_WUR; /* Y = G**X (mod P) */ mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) MP_WUR; /* ---> Primes <--- */ /* number of primes */ #ifdef MP_8BIT # define PRIVATE_MP_PRIME_TAB_SIZE 31 #else # define PRIVATE_MP_PRIME_TAB_SIZE 256 #endif #define PRIME_SIZE (MP_DEPRECATED_PRAGMA("PRIME_SIZE has been made internal") PRIVATE_MP_PRIME_TAB_SIZE) /* table of first PRIME_SIZE primes */ MP_DEPRECATED(internal) extern const mp_digit ltm_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE]; /* result=1 if a is divisible by one of the first PRIME_SIZE primes */ MP_DEPRECATED(mp_prime_is_prime) mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) MP_WUR; /* performs one Fermat test of "a" using base "b". * Sets result to 0 if composite or 1 if probable prime */ mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR; /* performs one Miller-Rabin test of "a" using base "b". * Sets result to 0 if composite or 1 if probable prime */ mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR; /* This gives [for a given bit size] the number of trials required * such that Miller-Rabin gives a prob of failure lower than 2^-96 */ int mp_prime_rabin_miller_trials(int size) MP_WUR; /* performs one strong Lucas-Selfridge test of "a". * Sets result to 0 if composite or 1 if probable prime */ mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) MP_WUR; /* performs one Frobenius test of "a" as described by Paul Underwood. * Sets result to 0 if composite or 1 if probable prime */ mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) MP_WUR; /* performs t random rounds of Miller-Rabin on "a" additional to * bases 2 and 3. Also performs an initial sieve of trial * division. Determines if "a" is prime with probability * of error no more than (1/4)**t. * Both a strong Lucas-Selfridge to complete the BPSW test * and a separate Frobenius test are available at compile time. * With t<0 a deterministic test is run for primes up to * 318665857834031151167461. With t<13 (abs(t)-13) additional * tests with sequential small primes are run starting at 43. * Is Fips 186.4 compliant if called with t as computed by * mp_prime_rabin_miller_trials(); * * Sets result to 1 if probably prime, 0 otherwise */ mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result) MP_WUR; /* finds the next prime after the number "a" using "t" trials * of Miller-Rabin. * * bbs_style = 1 means the prime must be congruent to 3 mod 4 */ mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) MP_WUR; /* makes a truly random prime of a given size (bytes), * call with bbs = 1 if you want it to be congruent to 3 mod 4 * * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself * so it can be NULL * * The prime generated will be larger than 2^(8*size). */ #define mp_prime_random(a, t, size, bbs, cb, dat) (MP_DEPRECATED_PRAGMA("mp_prime_random has been deprecated, use mp_prime_rand instead") mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?MP_PRIME_BBS:0, cb, dat)) /* makes a truly random prime of a given size (bits), * * Flags are as follows: * * MP_PRIME_BBS - make prime congruent to 3 mod 4 * MP_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS) * MP_PRIME_2MSB_ON - make the 2nd highest bit one * * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself * so it can be NULL * */ MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat) MP_WUR; mp_err mp_prime_rand(mp_int *a, int t, int size, int flags) MP_WUR; /* Integer logarithm to integer base */ mp_err mp_log_u32(const mp_int *a, unsigned int base, unsigned int *c) MP_WUR; /* c = a**b */ mp_err mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) MP_WUR; MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; /* ---> radix conversion <--- */ int mp_count_bits(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_from_ubin) mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) MP_WUR; MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) MP_WUR; MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR; MP_DEPRECATED(mp_sbin_size) int mp_signed_bin_size(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_from_sbin) mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) MP_WUR; MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin(const mp_int *a, unsigned char *b) MP_WUR; MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR; size_t mp_ubin_size(const mp_int *a) MP_WUR; mp_err mp_from_ubin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR; mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; size_t mp_sbin_size(const mp_int *a) MP_WUR; mp_err mp_from_sbin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR; mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; mp_err mp_read_radix(mp_int *a, const char *str, int radix) MP_WUR; MP_DEPRECATED(mp_to_radix) mp_err mp_toradix(const mp_int *a, char *str, int radix) MP_WUR; MP_DEPRECATED(mp_to_radix) mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) MP_WUR; mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; mp_err mp_radix_size(const mp_int *a, int radix, int *size) MP_WUR; #ifndef MP_NO_FILE mp_err mp_fread(mp_int *a, int radix, FILE *stream) MP_WUR; mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) MP_WUR; #endif #define mp_read_raw(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_signed_bin") mp_read_signed_bin((mp), (str), (len))) #define mp_raw_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_signed_bin_size") mp_signed_bin_size(mp)) #define mp_toraw(mp, str) (MP_DEPRECATED_PRAGMA("replaced by mp_to_signed_bin") mp_to_signed_bin((mp), (str))) #define mp_read_mag(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_unsigned_bin") mp_read_unsigned_bin((mp), (str), (len)) #define mp_mag_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_unsigned_bin_size") mp_unsigned_bin_size(mp)) #define mp_tomag(mp, str) (MP_DEPRECATED_PRAGMA("replaced by mp_to_unsigned_bin") mp_to_unsigned_bin((mp), (str))) #define mp_tobinary(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_binary") mp_toradix((M), (S), 2)) #define mp_tooctal(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_octal") mp_toradix((M), (S), 8)) #define mp_todecimal(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_decimal") mp_toradix((M), (S), 10)) #define mp_tohex(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_hex") mp_toradix((M), (S), 16)) #define mp_to_binary(M, S, N) mp_to_radix((M), (S), (N), NULL, 2) #define mp_to_octal(M, S, N) mp_to_radix((M), (S), (N), NULL, 8) #define mp_to_decimal(M, S, N) mp_to_radix((M), (S), (N), NULL, 10) #define mp_to_hex(M, S, N) mp_to_radix((M), (S), (N), NULL, 16) #ifdef __cplusplus } #endif #endif tcl8.6.14/libtommath/tommath_private.h0000644000175000017500000003435514554262142017370 0ustar sergeisergei/* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef TOMMATH_PRIV_H_ #define TOMMATH_PRIV_H_ #include #include "tommath_class.h" /* * Private symbols * --------------- * * On Unix symbols can be marked as hidden if libtommath is compiled * as a shared object. By default, symbols are visible. * As of now, this feature is opt-in via the MP_PRIVATE_SYMBOLS define. * * On Win32 a .def file must be used to specify the exported symbols. */ #if defined (MP_PRIVATE_SYMBOLS) && defined(__GNUC__) && __GNUC__ >= 4 # define MP_PRIVATE __attribute__ ((visibility ("hidden"))) #else # define MP_PRIVATE #endif /* Hardening libtommath * -------------------- * * By default memory is zeroed before calling * MP_FREE to avoid leaking data. This is good * practice in cryptographical applications. * * Note however that memory allocators used * in cryptographical applications can often * be configured by itself to clear memory, * rendering the clearing in tommath unnecessary. * See for example https://github.com/GrapheneOS/hardened_malloc * and the option CONFIG_ZERO_ON_FREE. * * Furthermore there are applications which * value performance more and want this * feature to be disabled. For such applications * define MP_NO_ZERO_ON_FREE during compilation. */ #ifdef MP_NO_ZERO_ON_FREE # define MP_FREE_BUFFER(mem, size) MP_FREE((mem), (size)) # define MP_FREE_DIGITS(mem, digits) MP_FREE((mem), sizeof (mp_digit) * (size_t)(digits)) #else # define MP_FREE_BUFFER(mem, size) \ do { \ size_t fs_ = (size); \ void* fm_ = (mem); \ if (fm_ != NULL) { \ MP_ZERO_BUFFER(fm_, fs_); \ MP_FREE(fm_, fs_); \ } \ } while (0) # define MP_FREE_DIGITS(mem, digits) \ do { \ int fd_ = (digits); \ void* fm_ = (mem); \ if (fm_ != NULL) { \ size_t fs_ = sizeof (mp_digit) * (size_t)fd_; \ MP_ZERO_BUFFER(fm_, fs_); \ MP_FREE(fm_, fs_); \ } \ } while (0) #endif #ifdef MP_USE_MEMSET # include # define MP_ZERO_BUFFER(mem, size) memset((mem), 0, (size)) # define MP_ZERO_DIGITS(mem, digits) \ do { \ int zd_ = (digits); \ if (zd_ > 0) { \ memset((mem), 0, sizeof(mp_digit) * (size_t)zd_); \ } \ } while (0) #else # define MP_ZERO_BUFFER(mem, size) \ do { \ size_t zs_ = (size); \ char* zm_ = (char*)(mem); \ while (zs_-- > 0u) { \ *zm_++ = '\0'; \ } \ } while (0) # define MP_ZERO_DIGITS(mem, digits) \ do { \ int zd_ = (digits); \ mp_digit* zm_ = (mem); \ while (zd_-- > 0) { \ *zm_++ = 0; \ } \ } while (0) #endif /* Tunable cutoffs * --------------- * * - In the default settings, a cutoff X can be modified at runtime * by adjusting the corresponding X_CUTOFF variable. * * - Tunability of the library can be disabled at compile time * by defining the MP_FIXED_CUTOFFS macro. * * - There is an additional file tommath_cutoffs.h, which defines * the default cutoffs. These can be adjusted manually or by the * autotuner. * */ #ifdef MP_FIXED_CUTOFFS # include "tommath_cutoffs.h" # define MP_KARATSUBA_MUL_CUTOFF MP_DEFAULT_KARATSUBA_MUL_CUTOFF # define MP_KARATSUBA_SQR_CUTOFF MP_DEFAULT_KARATSUBA_SQR_CUTOFF # define MP_TOOM_MUL_CUTOFF MP_DEFAULT_TOOM_MUL_CUTOFF # define MP_TOOM_SQR_CUTOFF MP_DEFAULT_TOOM_SQR_CUTOFF #else # define MP_KARATSUBA_MUL_CUTOFF KARATSUBA_MUL_CUTOFF # define MP_KARATSUBA_SQR_CUTOFF KARATSUBA_SQR_CUTOFF # define MP_TOOM_MUL_CUTOFF TOOM_MUL_CUTOFF # define MP_TOOM_SQR_CUTOFF TOOM_SQR_CUTOFF #endif /* define heap macros */ #ifndef MP_MALLOC /* default to libc stuff */ # include # define MP_MALLOC(size) malloc(size) # define MP_REALLOC(mem, oldsize, newsize) realloc((mem), (newsize)) # define MP_CALLOC(nmemb, size) calloc((nmemb), (size)) # define MP_FREE(mem, size) free(mem) #elif 0 /* prototypes for our heap functions */ extern void *MP_MALLOC(size_t size); extern void *MP_REALLOC(void *mem, size_t oldsize, size_t newsize); extern void *MP_CALLOC(size_t nmemb, size_t size); extern void MP_FREE(void *mem, size_t size); #endif /* feature detection macro */ #ifdef _MSC_VER /* Prevent false positive: not enough arguments for function-like macro invocation */ #pragma warning(disable: 4003) #endif #define MP_STRINGIZE(x) MP__STRINGIZE(x) #define MP__STRINGIZE(x) ""#x"" #define MP_HAS(x) (sizeof(MP_STRINGIZE(BN_##x##_C)) == 1u) /* TODO: Remove private_mp_word as soon as deprecated mp_word is removed from tommath. */ #undef mp_word typedef private_mp_word mp_word; #define MP_MIN(x, y) (((x) < (y)) ? (x) : (y)) #define MP_MAX(x, y) (((x) > (y)) ? (x) : (y)) /* Static assertion */ #define MP_STATIC_ASSERT(msg, cond) typedef char mp_static_assert_##msg[(cond) ? 1 : -1]; /* ---> Basic Manipulations <--- */ #define MP_IS_ZERO(a) ((a)->used == 0) #define MP_IS_EVEN(a) (((a)->used == 0) || (((a)->dp[0] & 1u) == 0u)) #define MP_IS_ODD(a) (((a)->used > 0) && (((a)->dp[0] & 1u) == 1u)) #define MP_SIZEOF_BITS(type) ((size_t)CHAR_BIT * sizeof(type)) #define MP_MAXFAST (int)(1uL << (MP_SIZEOF_BITS(mp_word) - (2u * (size_t)MP_DIGIT_BIT))) /* TODO: Remove PRIVATE_MP_WARRAY as soon as deprecated MP_WARRAY is removed from tommath.h */ #undef MP_WARRAY #define MP_WARRAY PRIVATE_MP_WARRAY /* TODO: Remove PRIVATE_MP_PREC as soon as deprecated MP_PREC is removed from tommath.h */ #ifdef PRIVATE_MP_PREC # undef MP_PREC # define MP_PREC PRIVATE_MP_PREC #endif /* Minimum number of available digits in mp_int, MP_PREC >= MP_MIN_PREC */ #define MP_MIN_PREC ((((int)MP_SIZEOF_BITS(Tcl_WideInt) + MP_DIGIT_BIT) - 1) / MP_DIGIT_BIT) MP_STATIC_ASSERT(prec_geq_min_prec, MP_PREC >= MP_MIN_PREC) /* random number source */ extern MP_PRIVATE mp_err(*s_mp_rand_source)(void *out, size_t size); /* lowlevel functions, do not call! */ MP_PRIVATE mp_bool s_mp_get_bit(const mp_int *a, unsigned int b); MP_PRIVATE mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; MP_PRIVATE mp_err s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; MP_PRIVATE mp_err s_mp_mul_high_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; MP_PRIVATE mp_err s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; MP_PRIVATE mp_err s_mp_sqr_fast(const mp_int *a, mp_int *b) MP_WUR; MP_PRIVATE mp_err s_mp_sqr(const mp_int *a, mp_int *b) MP_WUR; MP_PRIVATE mp_err s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_karatsuba_sqr(const mp_int *a, mp_int *b) MP_WUR; MP_PRIVATE mp_err s_mp_toom_sqr(const mp_int *a, mp_int *b) MP_WUR; MP_PRIVATE mp_err s_mp_invmod_fast(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_montgomery_reduce_fast(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR; MP_PRIVATE mp_err s_mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) MP_WUR; MP_PRIVATE mp_err s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) MP_WUR; MP_PRIVATE mp_err s_mp_rand_platform(void *p, size_t n) MP_WUR; MP_PRIVATE mp_err s_mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat); MP_PRIVATE void s_mp_reverse(unsigned char *s, size_t len); MP_PRIVATE mp_err s_mp_prime_is_divisible(const mp_int *a, mp_bool *result); /* TODO: jenkins prng is not thread safe as of now */ MP_PRIVATE mp_err s_mp_rand_jenkins(void *p, size_t n) MP_WUR; #ifndef MP_NO_STDINT MP_PRIVATE void s_mp_rand_jenkins_init(uint64_t seed); #endif extern MP_PRIVATE const char *const mp_s_rmap; extern MP_PRIVATE const unsigned char mp_s_rmap_reverse[]; extern MP_PRIVATE const size_t mp_s_rmap_reverse_sz; extern MP_PRIVATE const mp_digit *s_mp_prime_tab; /* deprecated functions */ #if 0 MP_DEPRECATED(s_mp_invmod_fast) mp_err fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c); MP_DEPRECATED(s_mp_montgomery_reduce_fast) mp_err fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho); MP_DEPRECATED(s_mp_mul_digs_fast) mp_err fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); MP_DEPRECATED(s_mp_mul_high_digs_fast) mp_err fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); MP_DEPRECATED(s_mp_sqr_fast) mp_err fast_s_mp_sqr(const mp_int *a, mp_int *b); MP_DEPRECATED(s_mp_balance_mul) mp_err mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c); MP_DEPRECATED(s_mp_exptmod_fast) mp_err mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode); MP_DEPRECATED(s_mp_invmod_slow) mp_err mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c); MP_DEPRECATED(s_mp_karatsuba_mul) mp_err mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c); MP_DEPRECATED(s_mp_karatsuba_sqr) mp_err mp_karatsuba_sqr(const mp_int *a, mp_int *b); MP_DEPRECATED(s_mp_toom_mul) mp_err mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c); MP_DEPRECATED(s_mp_toom_sqr) mp_err mp_toom_sqr(const mp_int *a, mp_int *b); MP_DEPRECATED(s_mp_reverse) void bn_reverse(unsigned char *s, int len); #endif #define MP_GET_ENDIANNESS(x) \ do{\ short n = 0x1; \ char *p = (char *)&n; \ x = (p[0] == '\x01') ? MP_LITTLE_ENDIAN : MP_BIG_ENDIAN; \ } while (0) /* code-generating macros */ #define MP_SET_UNSIGNED(name, type) \ void name(mp_int * a, type b) \ { \ int i = 0; \ while (b != 0u) { \ a->dp[i++] = ((mp_digit)b & MP_MASK); \ if (MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) { break; } \ b >>= ((MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) ? 0 : MP_DIGIT_BIT); \ } \ a->used = i; \ a->sign = MP_ZPOS; \ MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used); \ } #define MP_SET_SIGNED(name, uname, type, utype) \ void name(mp_int * a, type b) \ { \ uname(a, (b < 0) ? -(utype)b : (utype)b); \ if (b < 0) { a->sign = MP_NEG; } \ } #define MP_INIT_INT(name , set, type) \ mp_err name(mp_int * a, type b) \ { \ mp_err err; \ if ((err = mp_init(a)) != MP_OKAY) { \ return err; \ } \ set(a, b); \ return MP_OKAY; \ } #define MP_GET_MAG(name, type) \ type name(const mp_int* a) \ { \ unsigned i = MP_MIN((unsigned)a->used, (unsigned)((MP_SIZEOF_BITS(type) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT)); \ type res = 0u; \ while (i --> 0u) { \ res <<= ((MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) ? 0 : MP_DIGIT_BIT); \ res |= (type)a->dp[i]; \ if (MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) { break; } \ } \ return res; \ } #define MP_GET_SIGNED(name, mag, type, utype) \ type name(const mp_int* a) \ { \ utype res = mag(a); \ return (a->sign == MP_NEG) ? (type)-res : (type)res; \ } #undef mp_isodd #define mp_isodd TclBN_mp_isodd #endif tcl8.6.14/libtommath/tommath_superclass.h0000644000175000017500000000624114554262142020073 0ustar sergeisergei/* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* super class file for PK algos */ /* default ... include all MPI */ #ifndef LTM_NOTHING #define LTM_ALL #endif /* RSA only (does not support DH/DSA/ECC) */ /* #define SC_RSA_1 */ /* #define SC_RSA_1_WITH_TESTS */ /* For reference.... On an Athlon64 optimizing for speed... LTM's mpi.o with all functions [striped] is 142KiB in size. */ #ifdef SC_RSA_1_WITH_TESTS # define BN_MP_ERROR_TO_STRING_C # define BN_MP_FREAD_C # define BN_MP_FWRITE_C # define BN_MP_INCR_C # define BN_MP_ISEVEN_C # define BN_MP_ISODD_C # define BN_MP_NEG_C # define BN_MP_PRIME_FROBENIUS_UNDERWOOD_C # define BN_MP_RADIX_SIZE_C # define BN_MP_RAND_C # define BN_MP_REDUCE_C # define BN_MP_REDUCE_2K_L_C # define BN_MP_FROM_SBIN_C # define BN_MP_ROOT_U32_C # define BN_MP_SET_L_C # define BN_MP_SET_UL_C # define BN_MP_SBIN_SIZE_C # define BN_MP_TO_RADIX_C # define BN_MP_TO_SBIN_C # define BN_S_MP_RAND_JENKINS_C # define BN_S_MP_RAND_PLATFORM_C #endif /* Works for RSA only, mpi.o is 68KiB */ #if defined(SC_RSA_1) || defined (SC_RSA_1_WITH_TESTS) # define BN_CUTOFFS_C # define BN_MP_ADDMOD_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_EXPTMOD_C # define BN_MP_GCD_C # define BN_MP_INIT_MULTI_C # define BN_MP_INVMOD_C # define BN_MP_LCM_C # define BN_MP_MOD_C # define BN_MP_MOD_D_C # define BN_MP_MULMOD_C # define BN_MP_PRIME_IS_PRIME_C # define BN_MP_PRIME_RABIN_MILLER_TRIALS_C # define BN_MP_PRIME_RAND_C # define BN_MP_RADIX_SMAP_C # define BN_MP_SET_INT_C # define BN_MP_SHRINK_C # define BN_MP_TO_UNSIGNED_BIN_C # define BN_MP_UNSIGNED_BIN_SIZE_C # define BN_PRIME_TAB_C # define BN_S_MP_REVERSE_C /* other modifiers */ # define BN_MP_DIV_SMALL /* Slower division, not critical */ /* here we are on the last pass so we turn things off. The functions classes are still there * but we remove them specifically from the build. This also invokes tweaks in functions * like removing support for even moduli, etc... */ # ifdef LTM_LAST # undef BN_MP_DR_IS_MODULUS_C # undef BN_MP_DR_SETUP_C # undef BN_MP_DR_REDUCE_C # undef BN_MP_DIV_3_C # undef BN_MP_REDUCE_2K_SETUP_C # undef BN_MP_REDUCE_2K_C # undef BN_MP_REDUCE_IS_2K_C # undef BN_MP_REDUCE_SETUP_C # undef BN_S_MP_BALANCE_MUL_C # undef BN_S_MP_EXPTMOD_C # undef BN_S_MP_INVMOD_FAST_C # undef BN_S_MP_KARATSUBA_MUL_C # undef BN_S_MP_KARATSUBA_SQR_C # undef BN_S_MP_MUL_HIGH_DIGS_C # undef BN_S_MP_MUL_HIGH_DIGS_FAST_C # undef BN_S_MP_TOOM_MUL_C # undef BN_S_MP_TOOM_SQR_C # ifndef SC_RSA_1_WITH_TESTS # undef BN_MP_REDUCE_C # endif /* To safely undefine these you have to make sure your RSA key won't exceed the Comba threshold * which is roughly 255 digits [7140 bits for 32-bit machines, 15300 bits for 64-bit machines] * which means roughly speaking you can handle upto 2536-bit RSA keys with these defined without * trouble. */ # undef BN_MP_MONTGOMERY_REDUCE_C # undef BN_S_MP_MUL_DIGS_C # undef BN_S_MP_SQR_C # endif #endif tcl8.6.14/tests/0000755000175000017500000000000014566153412013006 5ustar sergeisergeitcl8.6.14/tests/license.terms0000644000175000017500000000431714554262142015507 0ustar sergeisergeiThis software is copyrighted by the Regents of the University of California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState Corporation and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7014 (b) (3) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license. tcl8.6.14/tests/aaa_exit.test0000644000175000017500000000323114554262142015457 0ustar sergeisergei# Commands covered: exit, emphasis on finalization hangs # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test exit-1.1 {normal, quick exit} { set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\"" r] set aft [after 1000 {set done "Quick exit hangs !!!"}] fileevent $f readable {after cancel $aft;set done OK} vwait done if {$done != "OK"} { fconfigure $f -blocking 0 close $f } else { if {[catch {close $f} err]} { set done "Quick exit misbehaves: $err" } } set done } OK test exit-1.2 {full-finalized exit} { set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\"" r] set aft [after 1000 {set done "Full-finalized exit hangs !!!"}] fileevent $f readable {after cancel $aft;set done OK} vwait done if {$done != "OK"} { fconfigure $f -blocking 0 close $f } else { if {[catch {close $f} err]} { set done "Full-finalized exit misbehaves: $err" } } set done } OK # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/appendComp.test0000644000175000017500000002764314554262142016007 0ustar sergeisergei# Commands covered: append lappend # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } catch {unset x} test appendComp-1.1 {append command} -setup { unset -nocomplain x } -body { proc foo {} {append ::x 1 2 abc "long string"} list [foo] $x } -result {{12abclong string} {12abclong string}} test appendComp-1.2 {append command} { proc foo {} { set x "" list [append x first] [append x second] [append x third] $x } foo } {first firstsecond firstsecondthird firstsecondthird} test appendComp-1.3 {append command} { proc foo {} { set x "abcd" append x } foo } abcd test appendComp-2.1 {long appends} { proc foo {} { set x "" for {set i 0} {$i < 1000} {incr i} { append x "foobar " } set y "foobar" set y "$y $y $y $y $y $y $y $y $y $y" set y "$y $y $y $y $y $y $y $y $y $y" set y "$y $y $y $y $y $y $y $y $y $y " expr {$x == $y} } foo } 1 test appendComp-3.1 {append errors} -returnCodes error -body { proc foo {} {append} foo } -result {wrong # args: should be "append varName ?value ...?"} test appendComp-3.2 {append errors} -returnCodes error -body { proc foo {} { set x "" append x(0) 44 } foo } -result {can't set "x(0)": variable isn't array} test appendComp-3.3 {append errors} -returnCodes error -body { proc foo {} { unset -nocomplain x append x } foo } -result {can't read "x": no such variable} test appendComp-4.1 {lappend command} { proc foo {} { global x unset -nocomplain x lappend x 1 2 abc "long string" } list [foo] $x } {{1 2 abc {long string}} {1 2 abc {long string}}} test appendComp-4.2 {lappend command} { proc foo {} { set x "" list [lappend x first] [lappend x second] [lappend x third] $x } foo } {first {first second} {first second third} {first second third}} test appendComp-4.3 {lappend command} { proc foo {} { global x set x old unset x lappend x new } set result [foo] rename foo {} set result } {new} test appendComp-4.4 {lappend command} { proc foo {} { set x {} lappend x \{\ abc } foo } {\{\ abc} test appendComp-4.5 {lappend command} { proc foo {} { set x {} lappend x \{ abc } foo } {\{ abc} test appendComp-4.6 {lappend command} { proc foo {} { set x {1 2 3} lappend x } foo } {1 2 3} test appendComp-4.7 {lappend command} { proc foo {} { set x "a\{" lappend x abc } foo } "a\\\{ abc" test appendComp-4.8 {lappend command} { proc foo {} { set x "\\\{" lappend x abc } foo } "\\{ abc" test appendComp-4.9 {lappend command} -returnCodes error -body { proc foo {} { set x " \{" lappend x abc } foo } -result {unmatched open brace in list} test appendComp-4.10 {lappend command} -returnCodes error -body { proc foo {} { set x " \{" lappend x abc } foo } -result {unmatched open brace in list} test appendComp-4.11 {lappend command} -returnCodes error -body { proc foo {} { set x "\{\{\{" lappend x abc } foo } -result {unmatched open brace in list} test appendComp-4.12 {lappend command} -returnCodes error -body { proc foo {} { set x "x \{\{\{" lappend x abc } foo } -result {unmatched open brace in list} test appendComp-4.13 {lappend command} { proc foo {} { set x "x\{\{\{" lappend x abc } foo } "x\\\{\\\{\\\{ abc" test appendComp-4.14 {lappend command} { proc foo {} { set x " " lappend x abc } foo } "abc" test appendComp-4.15 {lappend command} { proc foo {} { set x "\\ " lappend x abc } foo } "{ } abc" test appendComp-4.16 {lappend command} { proc foo {} { set x "x " lappend x abc } foo } "x abc" test appendComp-4.17 {lappend command} { proc foo {} { lappend x } foo } {} test appendComp-4.18 {lappend command} { proc foo {} { lappend x {} } foo } {{}} test appendComp-4.19 {lappend command} { proc foo {} { lappend x(0) } foo } {} test appendComp-4.20 {lappend command} { proc foo {} { lappend x(0) abc } foo } {abc} test appendComp-5.1 {long lappends} -setup { unset -nocomplain x proc check {var size} { set l [llength $var] if {$l != $size} { return "length mismatch: should have been $size, was $l" } for {set i 0} {$i < $size} {incr i} { set j [lindex $var $i] if {$j ne "item $i"} { return "element $i should have been \"item $i\", was \"$j\"" } } return ok } } -body { set x "" for {set i 0} {$i < 300} {incr i} { lappend x "item $i" } check $x 300 } -cleanup { unset -nocomplain x catch {rename check ""} } -result ok test appendComp-6.1 {lappend errors} -returnCodes error -body { proc foo {} {lappend} foo } -result {wrong # args: should be "lappend varName ?value ...?"} test appendComp-6.2 {lappend errors} -returnCodes error -body { proc foo {} { set x "" lappend x(0) 44 } foo } -result {can't set "x(0)": variable isn't array} test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup { catch {rename foo ""} unset -nocomplain x } -body { proc bar {} { global x trace add variable x write foo proc foo {} {global x; unset x} catch {lappend x 1} proc foo {args} {global x; unset x} info exists x set x lappend x 1 list [info exists x] [catch {set x} msg] $msg } bar } -result {0 1 {can't read "x": no such variable}} test appendComp-7.2 {lappend var triggers read trace, index var} -setup { unset -nocomplain ::result } -body { proc bar {} { trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar a return $::result } bar } -result {myvar {} read} -constraints {bug-3057639} test appendComp-7.3 {lappend var triggers read trace, stack var} -setup { unset -nocomplain ::result unset -nocomplain ::myvar } -body { proc bar {} { trace add variable ::myvar read foo proc foo {args} {append ::result $args} lappend ::myvar a return $::result } bar } -result {::myvar {} r} -constraints {bug-3057639} test appendComp-7.4 {lappend var triggers read trace, array var} -setup { unset -nocomplain ::result } -body { # The behavior of read triggers on lappend changed in 8.0 to not trigger # them. Maybe not correct, but been there a while. proc bar {} { trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a return $::result } bar } -result {myvar b read} -constraints {bug-3057639} test appendComp-7.5 {lappend var triggers read trace, array var} -setup { unset -nocomplain ::result } -body { # The behavior of read triggers on lappend changed in 8.0 to not trigger # them. Maybe not correct, but been there a while. proc bar {} { trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a b return $::result } bar } -result {myvar b read} test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup { unset -nocomplain ::result } -body { proc bar {} { set myvar(0) 1 trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a return $::result } bar } -result {myvar b read} -constraints {bug-3057639} test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup { unset -nocomplain ::myvar unset -nocomplain ::result } -body { proc bar {} { trace add variable ::myvar read foo proc foo {args} {append ::result $args} lappend ::myvar(b) a return $::result } bar } -result {::myvar b read} -constraints {bug-3057639} test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup { unset -nocomplain ::myvar unset -nocomplain ::result } -body { proc bar {} { trace add variable ::myvar read foo proc foo {args} {append ::result $args} lappend ::myvar(b) a b return $::result } bar } -result {::myvar b read} test appendComp-7.9 {append var does not trigger read trace} -setup { unset -nocomplain ::result } -body { proc bar {} { trace add variable myvar read foo proc foo {args} {append ::result $args} append myvar a info exists ::result } bar } -result {0} test appendComp-8.1 {defer error to runtime} -setup { interp create child } -body { child eval { proc foo {} { proc append args {} append } foo } } -cleanup { interp delete child } -result {} # New tests for bug 3057639 to show off the more consistent behaviour of # lappend in both direct-eval and bytecompiled code paths (see append.test for # the direct-eval variants). lappend now behaves like append. 9.0/1 lappend - # 9.2/3 append. # Note also the tests above now constrained by bug-3057639, these changed # behaviour with the triggering of read traces in bc mode gone. # Going back to the tests below. The direct-eval tests are ok before and after # patch (no read traces run for lappend, append). The compiled tests are # failing for lappend (9.0/1) before the patch, showing how it invokes read # traces in the compiled path. The append tests are good (9.2/3). After the # patch the failures are gone. test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup { unset -nocomplain myvar array set myvar {} } -body { proc nonull {var key val} { upvar 1 $var lvar if {![info exists lvar($key)]} { return -code error "BOOM. no such variable" } } trace add variable myvar read nonull proc foo {} { lappend ::myvar(key) "new value" } list [catch { foo } msg] $msg } -result {0 {{new value}}} test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup { unset -nocomplain ::env(__DUMMY__) } -body { proc foo {} { lappend ::env(__DUMMY__) "new value" } list [catch { foo } msg] $msg } -cleanup { unset -nocomplain ::env(__DUMMY__) } -result {0 {{new value}}} test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} -setup { unset -nocomplain myvar array set myvar {} } -body { proc nonull {var key val} { upvar 1 $var lvar if {![info exists lvar($key)]} { return -code error "BOOM. no such variable" } } trace add variable myvar read nonull proc foo {} { append ::myvar(key) "new value" } list [catch { foo } msg] $msg } -result {0 {new value}} test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup { unset -nocomplain ::env(__DUMMY__) } -body { proc foo {} { append ::env(__DUMMY__) "new value" } list [catch { foo } msg] $msg } -cleanup { unset -nocomplain ::env(__DUMMY__) } -result {0 {new value}} test appendComp-10.1 {Bug 214cc0eb22: lappend with no values} { apply {lst { lappend lst }} "# 1 2 3" } "# 1 2 3" test appendComp-10.2 {Bug 214cc0eb22: lappend with no values} -body { apply {lst { lappend lst }} "1 \{ 2" } -returnCodes error -result {unmatched open brace in list} test appendComp-10.3 {Bug 214cc0eb22: expanded lappend with no values} { apply {lst { lappend lst {*}[list] }} "# 1 2 3" } "# 1 2 3" test appendComp-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body { apply {lst { lappend lst {*}[list] }} "1 \{ 2" } -returnCodes error -result {unmatched open brace in list} catch {unset i x result y} catch {rename foo ""} catch {rename bar ""} catch {rename check ""} catch {rename bar {}} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/append.test0000644000175000017500000002205714554262142015162 0ustar sergeisergei# Commands covered: append lappend # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } unset -nocomplain x test append-1.1 {append command} { unset -nocomplain x list [append x 1 2 abc "long string"] $x } {{12abclong string} {12abclong string}} test append-1.2 {append command} { set x "" list [append x first] [append x second] [append x third] $x } {first firstsecond firstsecondthird firstsecondthird} test append-1.3 {append command} { set x "abcd" append x } abcd test append-2.1 {long appends} { set x "" for {set i 0} {$i < 1000} {incr i} { append x "foobar " } set y "foobar" set y "$y $y $y $y $y $y $y $y $y $y" set y "$y $y $y $y $y $y $y $y $y $y" set y "$y $y $y $y $y $y $y $y $y $y " expr {$x == $y} } 1 test append-3.1 {append errors} -returnCodes error -body { append } -result {wrong # args: should be "append varName ?value ...?"} test append-3.2 {append errors} -returnCodes error -body { set x "" append x(0) 44 } -result {can't set "x(0)": variable isn't array} test append-3.3 {append errors} -returnCodes error -body { unset -nocomplain x append x } -result {can't read "x": no such variable} test append-4.1 {lappend command} { unset -nocomplain x list [lappend x 1 2 abc "long string"] $x } {{1 2 abc {long string}} {1 2 abc {long string}}} test append-4.2 {lappend command} { set x "" list [lappend x first] [lappend x second] [lappend x third] $x } {first {first second} {first second third} {first second third}} test append-4.3 {lappend command} -body { proc foo {} { global x set x old unset x lappend x new } foo } -cleanup { rename foo {} } -result {new} test append-4.4 {lappend command} { set x {} lappend x \{\ abc } {\{\ abc} test append-4.5 {lappend command} { set x {} lappend x \{ abc } {\{ abc} test append-4.6 {lappend command} { set x {1 2 3} lappend x } {1 2 3} test append-4.7 {lappend command} { set x "a\{" lappend x abc } "a\\\{ abc" test append-4.8 {lappend command} { set x "\\\{" lappend x abc } "\\{ abc" test append-4.9 {lappend command} -returnCodes error -body { set x " \{" lappend x abc } -result {unmatched open brace in list} test append-4.10 {lappend command} -returnCodes error -body { set x " \{" lappend x abc } -result {unmatched open brace in list} test append-4.11 {lappend command} -returnCodes error -body { set x "\{\{\{" lappend x abc } -result {unmatched open brace in list} test append-4.12 {lappend command} -returnCodes error -body { set x "x \{\{\{" lappend x abc } -result {unmatched open brace in list} test append-4.13 {lappend command} { set x "x\{\{\{" lappend x abc } "x\\\{\\\{\\\{ abc" test append-4.14 {lappend command} { set x " " lappend x abc } "abc" test append-4.15 {lappend command} { set x "\\ " lappend x abc } "{ } abc" test append-4.16 {lappend command} { set x "x " lappend x abc } "x abc" test append-4.17 {lappend command} { unset -nocomplain x lappend x } {} test append-4.18 {lappend command} { unset -nocomplain x lappend x {} } {{}} test append-4.19 {lappend command} { unset -nocomplain x lappend x(0) } {} test append-4.20 {lappend command} { unset -nocomplain x lappend x(0) abc } {abc} unset -nocomplain x test append-4.21 {lappend command} -returnCodes error -body { set x \" lappend x } -result {unmatched open quote in list} test append-4.22 {lappend command} -returnCodes error -body { set x \" lappend x abc } -result {unmatched open quote in list} test append-5.1 {long lappends} -setup { unset -nocomplain x proc check {var size} { set l [llength $var] if {$l != $size} { return "length mismatch: should have been $size, was $l" } for {set i 0} {$i < $size} {incr i} { set j [lindex $var $i] if {$j ne "item $i"} { return "element $i should have been \"item $i\", was \"$j\"" } } return ok } } -body { set x "" for {set i 0} {$i < 300} {incr i} { lappend x "item $i" } check $x 300 } -cleanup { rename check {} } -result ok test append-6.1 {lappend errors} -returnCodes error -body { lappend } -result {wrong # args: should be "lappend varName ?value ...?"} test append-6.2 {lappend errors} -returnCodes error -body { set x "" lappend x(0) 44 } -result {can't set "x(0)": variable isn't array} test append-7.1 {lappend-created var and error in trace on that var} -setup { catch {rename foo ""} unset -nocomplain x } -body { trace add variable x write foo proc foo {} {global x; unset x} catch {lappend x 1} proc foo {args} {global x; unset x} info exists x set x lappend x 1 list [info exists x] [catch {set x} msg] $msg } -result {0 1 {can't read "x": no such variable}} test append-7.2 {lappend var triggers read trace} -setup { unset -nocomplain myvar unset -nocomplain ::result } -body { trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar a return $::result } -result {myvar {} read} test append-7.3 {lappend var triggers read trace, array var} -setup { unset -nocomplain myvar unset -nocomplain ::result } -body { # The behavior of read triggers on lappend changed in 8.0 to not trigger # them, and was changed back in 8.4. trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a return $::result } -result {myvar b read} test append-7.4 {lappend var triggers read trace, array var exists} -setup { unset -nocomplain myvar unset -nocomplain ::result } -body { set myvar(0) 1 trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a return $::result } -result {myvar b read} test append-7.5 {append var does not trigger read trace} -setup { unset -nocomplain myvar unset -nocomplain ::result } -body { trace add variable myvar read foo proc foo {args} {append ::result $args} append myvar a info exists ::result } -result {0} # THERE ARE NO append-8.* TESTS # New tests for bug 3057639 to show off the more consistent behaviour of # lappend in both direct-eval and bytecompiled code paths (see appendComp.test # for the compiled variants). lappend now behaves like append. 9.0/1 lappend - # 9.2/3 append test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} -setup { unset -nocomplain myvar } -body { array set myvar {} proc nonull {var key val} { upvar 1 $var lvar if {![info exists lvar($key)]} { return -code error "no such variable" } } trace add variable myvar read nonull list [catch { lappend myvar(key) "new value" } msg] $msg } -result {0 {{new value}}} test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup { unset -nocomplain ::env(__DUMMY__) } -body { list [catch { lappend ::env(__DUMMY__) "new value" } msg] $msg } -cleanup { unset -nocomplain ::env(__DUMMY__) } -result {0 {{new value}}} test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} -setup { unset -nocomplain myvar } -body { array set myvar {} proc nonull {var key val} { upvar 1 $var lvar if {![info exists lvar($key)]} { return -code error "no such variable" } } trace add variable myvar read nonull list [catch { append myvar(key) "new value" } msg] $msg } -result {0 {new value}} test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup { unset -nocomplain ::env(__DUMMY__) } -body { list [catch { append ::env(__DUMMY__) "new value" } msg] $msg } -cleanup { unset -nocomplain ::env(__DUMMY__) } -result {0 {new value}} test append-10.1 {Bug 214cc0eb22: lappend with no values} { set lst "# 1 2 3" [subst lappend] lst } "# 1 2 3" test append-10.2 {Bug 214cc0eb22: lappend with no values} -body { set lst "1 \{ 2" [subst lappend] lst } -returnCodes error -result {unmatched open brace in list} test append-10.3 {Bug 214cc0eb22: expanded lappend with no values} { set lst "# 1 2 3" [subst lappend] lst {*}[list] } "# 1 2 3" test append-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body { set lst "1 \{ 2" [subst lappend] lst {*}[list] } -returnCodes error -result {unmatched open brace in list} unset -nocomplain i x result y catch {rename foo ""} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/apply.test0000644000175000017500000002411014554262142015030 0ustar sergeisergei# Commands covered: apply # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2005-2006 Miguel Sofer # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] if {[info commands ::apply] eq {}} { return } testConstraint memory [llength [info commands memory]] testConstraint applylambda [llength [info commands testapplylambda]] # Tests for wrong number of arguments test apply-1.1 {not enough arguments} -returnCodes error -body { apply } -result {wrong # args: should be "apply lambdaExpr ?arg ...?"} # Tests for malformed lambda test apply-2.0 {malformed lambda} -returnCodes error -body { set lambda a apply $lambda } -result {can't interpret "a" as a lambda expression} test apply-2.1 {malformed lambda} -returnCodes error -body { set lambda [list a b c d] apply $lambda } -result {can't interpret "a b c d" as a lambda expression} test apply-2.2 {malformed lambda} { set lambda [list {{}} boo] list [catch {apply $lambda} msg] $msg $::errorInfo } {1 {argument with no name} {argument with no name (parsing lambda expression "{{}} boo") invoked from within "apply $lambda"}} test apply-2.3 {malformed lambda} { set lambda [list {{a b c}} boo] list [catch {apply $lambda} msg] $msg $::errorInfo } {1 {too many fields in argument specifier "a b c"} {too many fields in argument specifier "a b c" (parsing lambda expression "{{a b c}} boo") invoked from within "apply $lambda"}} test apply-2.4 {malformed lambda} { set lambda [list a(1) boo] list [catch {apply $lambda} msg] $msg $::errorInfo } {1 {formal parameter "a(1)" is an array element} {formal parameter "a(1)" is an array element (parsing lambda expression "a(1) boo") invoked from within "apply $lambda"}} test apply-2.5 {malformed lambda} { set lambda [list a::b boo] list [catch {apply $lambda} msg] $msg $::errorInfo } {1 {formal parameter "a::b" is not a simple name} {formal parameter "a::b" is not a simple name (parsing lambda expression "a::b boo") invoked from within "apply $lambda"}} # Tests for runtime errors in the lambda expression test apply-3.1 {non-existing namespace} -body { apply [list x {set x 1} ::NONEXIST::FOR::SURE] x } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} test apply-3.2 {non-existing namespace} -body { namespace eval ::NONEXIST::FOR::SURE {} set lambda [list x {set x 1} ::NONEXIST::FOR::SURE] apply $lambda x namespace delete ::NONEXIST apply $lambda x } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} test apply-3.3 {non-existing namespace} -body { apply [list x {set x 1} NONEXIST::FOR::SURE] x } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} test apply-3.4 {non-existing namespace} -body { namespace eval ::NONEXIST::FOR::SURE {} set lambda [list x {set x 1} NONEXIST::FOR::SURE] apply $lambda x namespace delete ::NONEXIST apply $lambda x } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} test apply-4.1 {error in arguments to lambda expression} -body { set lambda [list x {set x 1}] apply $lambda } -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"} test apply-4.2 {error in arguments to lambda expression} -body { set lambda [list x {set x 1}] apply $lambda a b } -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"} test apply-4.3 {error in arguments to lambda expression} -body { interp alias {} foo {} ::apply [list x {set x 1}] foo a b } -cleanup { rename foo {} } -returnCodes error -result {wrong # args: should be "foo x"} test apply-4.4 {error in arguments to lambda expression} -body { interp alias {} foo {} ::apply [list x {set x 1}] a foo b } -cleanup { rename foo {} } -returnCodes error -result {wrong # args: should be "foo"} test apply-4.5 {error in arguments to lambda expression} -body { set lambda [list x {set x 1}] namespace eval a { namespace ensemble create -command ::bar -map {id {::a::const foo}} proc const val { return $val } proc alias {object slot = command args} { set map [namespace ensemble configure $object -map] dict set map $slot [linsert $args 0 $command] namespace ensemble configure $object -map $map } proc method {object name params body} { set params [linsert $params 0 self] alias $object $name = ::apply [list $params $body] $object } method ::bar boo x {return "[expr {$x*$x}] - $self"} } bar boo } -cleanup { namespace delete ::a } -returnCodes error -result {wrong # args: should be "bar boo x"} test apply-5.1 {runtime error in lambda expression} { set lambda [list {} {error foo}] set res [catch {apply $lambda}] list $res $::errorInfo } {1 {foo while executing "error foo" (lambda term "{} {error foo}" line 1) invoked from within "apply $lambda"}} # Tests for correct execution; as the implementation is the same as that for # procs, the general functionality is mostly tested elsewhere test apply-6.1 {info level} { set lev [info level] set lambda [list {} {info level}] expr {[apply $lambda] - $lev} } 1 test apply-6.2 {info level} { set lambda [list {} {info level 0}] apply $lambda } {apply {{} {info level 0}}} test apply-6.3 {info level} { set lambda [list args {info level 0}] apply $lambda x y } {apply {args {info level 0}} x y} # Tests for correct namespace scope namespace eval ::testApply { proc testApply args {return testApply} } test apply-7.1 {namespace access} { set ::testApply::x 0 set body {set x 1; set x} list [apply [list args $body ::testApply]] $::testApply::x } {1 0} test apply-7.2 {namespace access} { set ::testApply::x 0 set body {variable x; set x} list [apply [list args $body ::testApply]] $::testApply::x } {0 0} test apply-7.3 {namespace access} { set ::testApply::x 0 set body {variable x; set x 1} list [apply [list args $body ::testApply]] $::testApply::x } {1 1} test apply-7.4 {namespace access} { set ::testApply::x 0 set body {testApply} apply [list args $body ::testApply] } testApply test apply-7.5 {namespace access} { set ::testApply::x 0 set body {set x 1; set x} list [apply [list args $body testApply]] $::testApply::x } {1 0} test apply-7.6 {namespace access} { set ::testApply::x 0 set body {variable x; set x} list [apply [list args $body testApply]] $::testApply::x } {0 0} test apply-7.7 {namespace access} { set ::testApply::x 0 set body {variable x; set x 1} list [apply [list args $body testApply]] $::testApply::x } {1 1} test apply-7.8 {namespace access} { set ::testApply::x 0 set body {testApply} apply [list args $body testApply] } testApply # Tests for correct argument treatment set applyBody { set res {} foreach v [info locals] { if {$v eq "res"} continue lappend res [list $v [set $v]] } set res } test apply-8.1 {args treatment} { apply [list args $applyBody] 1 2 3 } {{args {1 2 3}}} test apply-8.2 {args treatment} { apply [list {x args} $applyBody] 1 2 } {{x 1} {args 2}} test apply-8.3 {args treatment} { apply [list {x args} $applyBody] 1 2 3 } {{x 1} {args {2 3}}} test apply-8.4 {default values} { apply [list {{x 1} {y 2}} $applyBody] } {{x 1} {y 2}} test apply-8.5 {default values} { apply [list {{x 1} {y 2}} $applyBody] 3 4 } {{x 3} {y 4}} test apply-8.6 {default values} { apply [list {{x 1} {y 2}} $applyBody] 3 } {{x 3} {y 2}} test apply-8.7 {default values} { apply [list {x {y 2}} $applyBody] 1 } {{x 1} {y 2}} test apply-8.8 {default values} { apply [list {x {y 2}} $applyBody] 1 3 } {{x 1} {y 3}} test apply-8.9 {default values} { apply [list {x {y 2} args} $applyBody] 1 } {{x 1} {y 2} {args {}}} test apply-8.10 {default values} { apply [list {x {y 2} args} $applyBody] 1 3 } {{x 1} {y 3} {args {}}} # Tests for leaks test apply-9.1 {leaking internal rep} -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex $lines 3 3 } set lam [list {} {set a 1}] } -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { ::apply [lrange $lam 0 end] set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { rename getbytes {} unset -nocomplain lam end i tmp leakedBytes } -result 0 test apply-9.2 {leaking internal rep} -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex $lines 3 3 } } -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { ::apply [list {} {set a 1}] set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { rename getbytes {} unset -nocomplain end i tmp leakedBytes } -result 0 test apply-9.3 {leaking internal rep} -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex $lines 3 3 } } -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { set x [list {} {set a 1} ::NS::THAT::DOES::NOT::EXIST] catch {::apply $x} set x {} set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { rename getbytes {} unset -nocomplain end i x tmp leakedBytes } -result 0 # Tests for specific bugs test apply-10.1 {Test for precompiled bytecode body} -constraints { applylambda } -body { testapplylambda } -result 42 # Tests for the avoidance of recompilation # cleanup namespace delete testApply ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/assemble.test0000644000175000017500000017550214554262142015512 0ustar sergeisergei# assemble.test -- # # Test suite for the 'tcl::unsupported::assemble' command # # Copyright (c) 2010 by Ozgur Dogan Ugurlu. # Copyright (c) 2010 by Kevin B. Kenny. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. #----------------------------------------------------------------------------- # Commands covered: assemble if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } namespace eval tcl::unsupported {namespace export assemble} namespace import tcl::unsupported::assemble # Procedure to make code that fills the literal and local variable tables, to # force instructions to spill to four bytes. proc fillTables {} { set s {} set sep {} for {set i 0} {$i < 256} {incr i} { append s $sep [list set v$i literal$i] set sep \n } return $s } testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { set lines [split [memory info] \n] return [lindex $lines 3 3] } proc leaktest {script {iterations 3}} { set end [getbytes] for {set i 0} {$i < $iterations} {incr i} { uplevel 1 $script set tmp $end set end [getbytes] } return [expr {$end - $tmp}] } } # assemble-1 - TclNRAssembleObjCmd test assemble-1.1 {wrong # args, direct eval} { -body { eval [list assemble] } -returnCodes error -result {wrong # args*} -match glob } test assemble-1.2 {wrong # args, direct eval} { -body { eval [list assemble too many] } -returnCodes error -result {wrong # args*} -match glob } test assemble-1.3 {error reporting, direct eval} { -body { list [catch { eval [list assemble { # bad opcode rubbish }] } result] $result $errorInfo } -match glob -result {1 {bad instruction "rubbish":*} {bad instruction "rubbish":* while executing "rubbish" ("assemble" body, line 3)*}} -cleanup {unset result} } test assemble-1.4 {simple direct eval} { -body { eval [list assemble {push {this is a test}}] } -result {this is a test} } # assemble-2 - CompileAssembleObj test assemble-2.1 {bytecode reuse, direct eval} { -body { set x {push "this is a test"} list [eval [list assemble $x]] \ [eval [list assemble $x]] } -result {{this is a test} {this is a test}} } test assemble-2.2 {bytecode discard, direct eval} { -body { set x {load value} proc p1 {x} { set value value1 assemble $x } proc p2 {x} { set a b set value value2 assemble $x } list [p1 $x] [p2 $x] } -result {value1 value2} -cleanup { unset x rename p1 {} rename p2 {} } } test assemble-2.3 {null script, direct eval} { -body { set x {} assemble $x } -result {} -cleanup {unset x} } # assemble-3 - TclCompileAssembleCmd test assemble-3.1 {wrong # args, compiled path} { -body { proc x {} { assemble } x } -returnCodes error -match glob -result {wrong # args:*} -cleanup {rename x {}} } test assemble-3.2 {wrong # args, compiled path} { -body { proc x {} { assemble too many } x } -returnCodes error -match glob -result {wrong # args:*} -cleanup { rename x {} } } # assemble-4 - TclAssembleCode mainline test assemble-4.1 {syntax error} { -body { proc x {} { assemble { {}extra } } list [catch x result] $result $::errorInfo } -cleanup { rename x {} unset result } -match glob -result {1 {extra characters after close-brace} {extra characters after close-brace while executing "{}e" ("assemble" body, line 2)*}} } test assemble-4.2 {null command} { -body { proc x {} { assemble { push hello; pop;;push goodbye } } x } -result goodbye -cleanup { rename x {} } } # assemble-5 - GetNextOperand off-nominal cases test assemble-5.1 {unsupported expansion} { -body { proc x {y} { assemble { {*}$y } } list [catch {x {push hello}} result] $result $::errorCode } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} -cleanup { rename x {} unset result } } test assemble-5.2 {unsupported substitution} { -body { proc x {y} { assemble { $y } } list [catch {x {nop}} result] $result $::errorCode } -cleanup { rename x {} unset result } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} } test assemble-5.3 {unsupported substitution} { -body { proc x {} { assemble { [x] } } list [catch {x} result] $result $::errorCode } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} -cleanup {rename x {}} } test assemble-5.4 {backslash substitution} { -body { proc x {} { assemble { p\x75sh\ hello\ world } } x } -cleanup { rename x {} } -result {hello world} } # assemble-6 - ASSEM_PUSH test assemble-6.1 {push, wrong # args} { -body { assemble push } -returnCodes error -match glob -result {wrong # args*} } test assemble-6.2 {push, wrong # args} { -body { assemble {push too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-6.3 {push} { -body { eval [list assemble {push hello}] } -result hello } test assemble-6.4 {push4} { -body { proc x {} " [fillTables] assemble {push hello} " x } -cleanup { rename x {} } -result hello } # assemble-7 - ASSEM_1BYTE test assemble-7.1 {add, wrong # args} { -body { assemble {add excess} } -returnCodes error -match glob -result {wrong # args*} } test assemble-7.2 {add} { -body { assemble { push 2 push 2 add } } -result {4} } test assemble-7.3 {appendArrayStk} { -body { set a(b) {hello, } assemble { push a push b push world appendArrayStk } set a(b) } -result {hello, world} -cleanup {unset a} } test assemble-7.4 {appendStk} { -body { set a {hello, } assemble { push a push world appendStk } set a } -result {hello, world} -cleanup {unset a} } test assemble-7.5 {bitwise ops} { -body { list \ [assemble {push 0b1100; push 0b1010; bitand}] \ [assemble {push 0b1100; bitnot}] \ [assemble {push 0b1100; push 0b1010; bitor}] \ [assemble {push 0b1100; push 0b1010; bitxor}] } -result {8 -13 14 6} } test assemble-7.6 {div} { -body { assemble {push 999999; push 7; div} } -result 142857 } test assemble-7.7 {dup} { -body { assemble { push 1; dup; dup; add; dup; add; dup; add; add } } -result 9 } test assemble-7.8 {eq} { -body { list \ [assemble {push able; push baker; eq}] \ [assemble {push able; push able; eq}] } -result {0 1} } test assemble-7.9 {evalStk} { -body { assemble { push {concat test 7.3} evalStk } } -result {test 7.3} } test assemble-7.9a {evalStk, syntax} { -body { assemble { push {{}bad} evalStk } } -returnCodes error -result {extra characters after close-brace} } test assemble-7.9b {evalStk, backtrace} { -body { proc y {z} { error testing } proc x {} { assemble { push { # test error in evalStk y asd } evalStk } } list [catch x result] $result $errorInfo } -result {1 testing {testing while executing "error testing" (procedure "y" line 2) invoked from within "y asd"*}} -match glob -cleanup { rename y {} rename x {} } } test assemble-7.10 {existArrayStk} { -body { proc x {name key} { set a(b) c assemble { load name; load key; existArrayStk } } list [x a a] [x a b] [x b a] [x b b] } -result {0 1 0 0} -cleanup {rename x {}} } test assemble-7.11 {existStk} { -body { proc x {name} { set a b assemble { load name; existStk } } list [x a] [x b] } -result {1 0} -cleanup {rename x {}} } test assemble-7.12 {expon} { -body { assemble {push 3; push 4; expon} } -result 81 } test assemble-7.13 {exprStk} { -body { assemble { push {acos(-1)} exprStk } } -result 3.141592653589793 } test assemble-7.13a {exprStk, syntax} { -body { assemble { push {2+} exprStk } } -returnCodes error -result {missing operand at _@_ in expression "2+_@_"} } test assemble-7.13b {exprStk, backtrace} { -body { proc y {z} { error testing } proc x {} { assemble { push {[y asd]} exprStk } } list [catch x result] $result $errorInfo } -result {1 testing {testing while executing "error testing" (procedure "y" line 2) invoked from within "y asd"*}} -match glob -cleanup { rename y {} rename x {} } } test assemble-7.14 {ge gt le lt} { -body { proc x {a b} { list [assemble {load a; load b; ge}] \ [assemble {load a; load b; gt}] \ [assemble {load a; load b; le}] \ [assemble {load a; load b; lt}] } list [x 0 0] [x 0 1] [x 1 0] } -result {{1 0 1 0} {0 0 1 1} {1 1 0 0}} -cleanup {rename x {}} } test assemble-7.15 {incrArrayStk} { -body { proc x {} { set a(b) 5 assemble { push a; push b; push 7; incrArrayStk } } x } -result 12 -cleanup {rename x {}} } test assemble-7.16 {incrStk} { -body { proc x {} { set a 5 assemble { push a; push 7; incrStk } } x } -result 12 -cleanup {rename x {}} } test assemble-7.17 {land/lor} { -body { proc x {a b} { list \ [assemble {load a; load b; land}] \ [assemble {load a; load b; lor}] } list [x 0 0] [x 0 23] [x 35 0] [x 47 59] } -result {{0 0} {0 1} {0 1} {1 1}} -cleanup {rename x {}} } test assemble-7.18 {lappendArrayStk} { -body { proc x {} { set able(baker) charlie assemble { push able push baker push dog lappendArrayStk } } x } -result {charlie dog} -cleanup {rename x {}} } test assemble-7.19 {lappendStk} { -body { proc x {} { set able baker assemble { push able push charlie lappendStk } } x } -result {baker charlie} -cleanup {rename x {}} } test assemble-7.20 {listIndex} { -body { assemble { push {a b c d} push 2 listIndex } } -result c } test assemble-7.21 {listLength} { -body { assemble { push {a b c d} listLength } } -result 4 } test assemble-7.22 {loadArrayStk} { -body { proc x {} { set able(baker) charlie assemble { push able push baker loadArrayStk } } x } -result charlie -cleanup {rename x {}} } test assemble-7.23 {loadStk} { -body { proc x {} { set able baker assemble { push able loadStk } } x } -result baker -cleanup {rename x {}} } test assemble-7.24 {lsetList} { -body { proc x {} { set l {{a b} {c d} {e f} {g h}} assemble { push {2 1}; push i; load l; lsetList } } x } -result {{a b} {c d} {e i} {g h}} -cleanup {rename x {}} } test assemble-7.25 {lshift} { -body { assemble {push 16; push 4; lshift} } -result 256 } test assemble-7.26 {mod} { -body { assemble {push 123456; push 1000; mod} } -result 456 } test assemble-7.27 {mult} { -body { assemble {push 12345679; push 9; mult} } -result 111111111 } test assemble-7.28 {neq} { -body { list \ [assemble {push able; push baker; neq}] \ [assemble {push able; push able; neq}] } -result {1 0} } test assemble-7.29 {not} { -body { list \ [assemble {push 17; not}] \ [assemble {push 0; not}] } -result {0 1} } test assemble-7.30 {pop} { -body { assemble {push this; pop; push that} } -result that } test assemble-7.31 {rshift} { -body { assemble {push 257; push 4; rshift} } -result 16 } test assemble-7.32 {storeArrayStk} { -body { proc x {} { assemble { push able; push baker; push charlie; storeArrayStk } array get able } x } -result {baker charlie} -cleanup {rename x {}} } test assemble-7.33 {storeStk} { -body { proc x {} { assemble { push able; push baker; storeStk } set able } x } -result {baker} -cleanup {rename x {}} } test assemble-7,34 {strcmp} { -body { proc x {a b} { assemble { load a; load b; strcmp } } list [x able baker] [x baker able] [x baker baker] } -result {-1 1 0} -cleanup {rename x {}} } test assemble-7.35 {streq/strneq} { -body { proc x {a b} { list \ [assemble {load a; load b; streq}] \ [assemble {load a; load b; strneq}] } list [x able able] [x able baker] } -result {{1 0} {0 1}} -cleanup {rename x {}} } test assemble-7.36 {strindex} { -body { assemble {push testing; push 4; strindex} } -result i } test assemble-7.37 {strlen} { -body { assemble {push testing; strlen} } -result 7 } test assemble-7.38 {sub} { -body { assemble {push 42; push 17; sub} } -result 25 } test assemble-7.39 {tryCvtToNumeric} { -body { assemble { push 42; tryCvtToNumeric } } -result 42 } # assemble-7.40 absent test assemble-7.41 {uminus} { -body { assemble { push 42; uminus } } -result -42 } test assemble-7.42 {uplus} { -body { assemble { push 42; uplus } } -result 42 } test assemble-7.43 {uplus} { -body { assemble { push NaN; uplus } } -returnCodes error -result {can't use non-numeric floating-point value as operand of "+"} } test assemble-7.43.1 {tryCvtToNumeric} { -body { assemble { push NaN; tryCvtToNumeric } } -returnCodes error -result {domain error: argument not in valid range} } test assemble-7.44 {listIn} { -body { assemble { push b; push {a b c}; listIn } } -result 1 } test assemble-7.45 {listNotIn} { -body { assemble { push d; push {a b c}; listNotIn } } -result 1 } test assemble-7.46 {nop} { -body { assemble { push x; nop; nop; nop} } -result x } # assemble-8 ASSEM_LVT and FindLocalVar test assemble-8.1 {load, wrong # args} { -body { assemble load } -returnCodes error -match glob -result {wrong # args*} } test assemble-8.2 {load, wrong # args} { -body { assemble {load too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-8.3 {nonlocal var} { -body { list [catch {assemble {load ::env}} result] $result $errorCode } -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}} -cleanup {unset result} } test assemble-8.4 {bad context} { -body { set x 1 list [catch {assemble {load x}} result] $result $errorCode } -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}} -cleanup {unset result} } test assemble-8.5 {bad context} { -body { namespace eval assem { set x 1 list [catch {assemble {load x}} result opts] $result [dict get $opts -errorcode] } } -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}} -cleanup {namespace delete assem} } test assemble-8.6 {load1} { -body { proc x {a} { assemble { load a } } x able } -result able -cleanup {rename x {}} } test assemble-8.7 {load4} { -body { proc x {a} " [fillTables] set b \$a assemble {load b} " x able } -result able -cleanup {rename x {}} } test assemble-8.8 {loadArray1} { -body { proc x {} { set able(baker) charlie assemble { push baker loadArray able } } x } -result charlie -cleanup {rename x {}} } test assemble-8.9 {loadArray4} { -body " proc x {} { [fillTables] set able(baker) charlie assemble { push baker loadArray able } } x " -result charlie -cleanup {rename x {}} } test assemble-8.10 {append1} { -body { proc x {} { set y {hello, } assemble { push world; append y } } x } -result {hello, world} -cleanup {rename x {}} } test assemble-8.11 {append4} { -body { proc x {} " [fillTables] set y {hello, } assemble { push world; append y } " x } -result {hello, world} -cleanup {rename x {}} } test assemble-8.12 {appendArray1} { -body { proc x {} { set y(z) {hello, } assemble { push z; push world; appendArray y } } x } -result {hello, world} -cleanup {rename x {}} } test assemble-8.13 {appendArray4} { -body { proc x {} " [fillTables] set y(z) {hello, } assemble { push z; push world; appendArray y } " x } -result {hello, world} -cleanup {rename x {}} } test assemble-8.14 {lappend1} { -body { proc x {} { set y {hello,} assemble { push world; lappend y } } x } -result {hello, world} -cleanup {rename x {}} } test assemble-8.15 {lappend4} { -body { proc x {} " [fillTables] set y {hello,} assemble { push world; lappend y } " x } -result {hello, world} -cleanup {rename x {}} } test assemble-8.16 {lappendArray1} { -body { proc x {} { set y(z) {hello,} assemble { push z; push world; lappendArray y } } x } -result {hello, world} -cleanup {rename x {}} } test assemble-8.17 {lappendArray4} { -body { proc x {} " [fillTables] set y(z) {hello,} assemble { push z; push world; lappendArray y } " x } -result {hello, world} -cleanup {rename x {}} } test assemble-8.18 {store1} { -body { proc x {} { assemble { push test; store y } set y } x } -result {test} -cleanup {rename x {}} } test assemble-8.19 {store4} { -body { proc x {} " [fillTables] assemble { push test; store y } set y " x } -result test -cleanup {rename x {}} } test assemble-8.20 {storeArray1} { -body { proc x {} { assemble { push z; push test; storeArray y } set y(z) } x } -result test -cleanup {rename x {}} } test assemble-8.21 {storeArray4} { -body { proc x {} " [fillTables] assemble { push z; push test; storeArray y } " x } -result test -cleanup {rename x {}} } # assemble-9 - ASSEM_CONCAT1, GetIntegerOperand, CheckOneByte test assemble-9.1 {wrong # args} { -body {assemble concat} -result {wrong # args*} -match glob -returnCodes error } test assemble-9.2 {wrong # args} { -body {assemble {concat too many}} -result {wrong # args*} -match glob -returnCodes error } test assemble-9.3 {not a number} { -body {assemble {concat rubbish}} -result {expected integer but got "rubbish"} -returnCodes error } test assemble-9.4 {too small} { -body {assemble {concat -1}} -result {operand does not fit in one byte} -returnCodes error } test assemble-9.5 {too small} { -body {assemble {concat 256}} -result {operand does not fit in one byte} -returnCodes error } test assemble-9.6 {concat} { -body { assemble {push h; push e; push l; push l; push o; concat 5} } -result hello } test assemble-9.7 {concat} { -body { list [catch {assemble {concat 0}} result] $result $::errorCode } -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} -cleanup {unset result} } # assemble-10 -- eval and expr test assemble-10.1 {eval - wrong # args} { -body { assemble {eval} } -returnCodes error -match glob -result {wrong # args*} } test assemble-10.2 {eval - wrong # args} { -body { assemble {eval too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-10.3 {eval} { -body { proc x {} { assemble { push 3 store n pop eval {expr {3*$n + 1}} push 1 add } } x } -result 11 -cleanup {rename x {}} } test assemble-10.4 {expr} { -body { proc x {} { assemble { push 3 store n pop expr {3*$n + 1} push 1 add } } x } -result 11 -cleanup {rename x {}} } test assemble-10.5 {eval and expr - nonsimple} { -body { proc x {} { assemble { eval "s\x65t n 3" pop expr "\x33*\$n + 1" push 1 add } } x } -result 11 -cleanup { rename x {} } } test assemble-10.6 {eval - noncompilable} { -body { list [catch {assemble {eval $x}} result] $result $::errorCode } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} } test assemble-10.7 {expr - noncompilable} { -body { list [catch {assemble {expr $x}} result] $result $::errorCode } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} } # assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend, # nsupvar, variable, upvar) test assemble-11.1 {exist - wrong # args} { -body { assemble {exist} } -returnCodes error -match glob -result {wrong # args*} } test assemble-11.2 {exist - wrong # args} { -body { assemble {exist too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-11.3 {nonlocal var} { -body { list [catch {assemble {exist ::env}} result] $result $errorCode } -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}} -cleanup {unset result} } test assemble-11.4 {exist} { -body { proc x {} { set y z list [assemble {exist y}] \ [assemble {exist z}] } x } -result {1 0} -cleanup {rename x {}} } test assemble-11.5 {existArray} { -body { proc x {} { set a(b) c list [assemble {push b; existArray a}] \ [assemble {push c; existArray a}] \ [assemble {push a; existArray b}] } x } -result {1 0 0} -cleanup {rename x {}} } test assemble-11.6 {dictAppend} { -body { proc x {} { set dict {a 1 b 2 c 3} assemble {push b; push 22; dictAppend dict} } x } -result {a 1 b 222 c 3} -cleanup {rename x {}} } test assemble-11.7 {dictLappend} { -body { proc x {} { set dict {a 1 b 2 c 3} assemble {push b; push 2; dictLappend dict} } x } -result {a 1 b {2 2} c 3} -cleanup {rename x {}} } test assemble-11.8 {upvar} { -body { proc x {v} { assemble {push 1; load v; upvar w; pop; load w} } proc y {} { set z 123 x z } y } -result 123 -cleanup {rename x {}; rename y {}} } test assemble-11.9 {nsupvar} { -body { namespace eval q { variable v 123 } proc x {} { assemble {push q; push v; nsupvar y; pop; load y} } x } -result 123 -cleanup {namespace delete q; rename x {}} } test assemble-11.10 {variable} { -body { namespace eval q { namespace eval r {variable v 123}} proc x {} { assemble {push q::r::v; variable y; load y} } x } -result 123 -cleanup {namespace delete q; rename x {}} } # assemble-12 - ASSEM_LVT1 (incr and incrArray) test assemble-12.1 {incr - wrong # args} { -body { assemble {incr} } -returnCodes error -match glob -result {wrong # args*} } test assemble-12.2 {incr - wrong # args} { -body { assemble {incr too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-12.3 {incr nonlocal var} { -body { list [catch {assemble {incr ::env}} result] $result $errorCode } -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}} -cleanup {unset result} } test assemble-12.4 {incr} { -body { proc x {} { set y 5 assemble {push 3; incr y} } x } -result 8 -cleanup {rename x {}} } test assemble-12.5 {incrArray} { -body { proc x {} { set a(b) 5 assemble {push b; push 3; incrArray a} } x } -result 8 -cleanup {rename x {}} } test assemble-12.6 {incr, stupid stack restriction} { -body { proc x {} " [fillTables] set y 5 assemble {push 3; incr y} " list [catch {x} result] $result $errorCode } -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}} -cleanup {unset result; rename x {}} } # assemble-13 -- ASSEM_LVT1_SINT1 - incrImm and incrArrayImm test assemble-13.1 {incrImm - wrong # args} { -body { assemble {incrImm x} } -returnCodes error -match glob -result {wrong # args*} } test assemble-13.2 {incrImm - wrong # args} { -body { assemble {incrImm too many args} } -returnCodes error -match glob -result {wrong # args*} } test assemble-13.3 {incrImm nonlocal var} { -body { list [catch {assemble {incrImm ::env 2}} result] $result $errorCode } -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}} -cleanup {unset result} } test assemble-13.4 {incrImm not a number} { -body { proc x {} { assemble {incrImm x rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-13.5 {incrImm too big} { -body { proc x {} { assemble {incrImm x 0x80} } list [catch x result] $result $::errorCode } -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}} -cleanup {rename x {}; unset result} } test assemble-13.6 {incrImm too small} { -body { proc x {} { assemble {incrImm x -0x81} } list [catch x result] $result $::errorCode } -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}} -cleanup {rename x {}; unset result} } test assemble-13.7 {incrImm} { -body { proc x {} { set y 1 list [assemble {incrImm y -0x80}] [assemble {incrImm y 0x7f}] } x } -result {-127 0} -cleanup {rename x {}} } test assemble-13.8 {incrArrayImm} { -body { proc x {} { set a(b) 5 assemble {push b; incrArrayImm a 3} } x } -result 8 -cleanup {rename x {}} } test assemble-13.9 {incrImm, stupid stack restriction} { -body { proc x {} " [fillTables] set y 5 assemble {incrImm y 3} " list [catch {x} result] $result $errorCode } -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}} -cleanup {unset result; rename x {}} } # assemble-14 -- ASSEM_SINT1 (incrArrayStkImm and incrStkImm) test assemble-14.1 {incrStkImm - wrong # args} { -body { assemble {incrStkImm} } -returnCodes error -match glob -result {wrong # args*} } test assemble-14.2 {incrStkImm - wrong # args} { -body { assemble {incrStkImm too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-14.3 {incrStkImm not a number} { -body { proc x {} { assemble {incrStkImm rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-14.4 {incrStkImm too big} { -body { proc x {} { assemble {incrStkImm 0x80} } list [catch x result] $result $::errorCode } -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}} -cleanup {rename x {}; unset result} } test assemble-14.5 {incrStkImm too small} { -body { proc x {} { assemble {incrStkImm -0x81} } list [catch x result] $result $::errorCode } -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}} -cleanup {rename x {}; unset result} } test assemble-14.6 {incrStkImm} { -body { proc x {} { set y 1 list [assemble {push y; incrStkImm -0x80}] \ [assemble {push y; incrStkImm 0x7f}] } x } -result {-127 0} -cleanup {rename x {}} } test assemble-14.7 {incrArrayStkImm} { -body { proc x {} { set a(b) 5 assemble {push a; push b; incrArrayStkImm 3} } x } -result 8 -cleanup {rename x {}} } # assemble-15 - listIndexImm test assemble-15.1 {listIndexImm - wrong # args} -body { assemble {listIndexImm} } -returnCodes error -match glob -result {wrong # args*} test assemble-15.2 {listIndexImm - wrong # args} -body { assemble {listIndexImm too many} } -returnCodes error -match glob -result {wrong # args*} test assemble-15.3 {listIndexImm - bad substitution} -body { list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode } -cleanup { unset result } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} test assemble-15.4 {listIndexImm - invalid index} -body { assemble {listIndexImm rubbish} } -returnCodes error -match glob -result {bad index "rubbish"*} test assemble-15.5 {listIndexImm} -body { assemble {push {a b c}; listIndexImm 2} } -result c test assemble-15.6 {listIndexImm} -body { assemble {push {a b c}; listIndexImm end-1} } -result b test assemble-15.7 {listIndexImm} -body { assemble {push {a b c}; listIndexImm end} } -result c test assemble-15.8 {listIndexImm} -body { assemble {push {a b c}; listIndexImm end+2} } -result {} test assemble-15.9 {listIndexImm} -body { assemble {push {a b c}; listIndexImm -1-1} } -result {} # assemble-16 - invokeStk test assemble-16.1 {invokeStk - wrong # args} { -body { assemble {invokeStk} } -returnCodes error -match glob -result {wrong # args*} } test assemble-16.2 {invokeStk - wrong # args} { -body { assemble {invokeStk too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-16.3 {invokeStk - not a number} { -body { proc x {} { assemble {invokeStk rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-16.4 {invokeStk - no operands} { -body { proc x {} { assemble {invokeStk 0} } list [catch x result] $result $::errorCode } -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} -cleanup {rename x {}; unset result} } test assemble-16.5 {invokeStk1} { -body { tcl::unsupported::assemble {push concat; push 1; push 2; invokeStk 3} } -result {1 2} } test assemble-16.6 {invokeStk4} { -body { proc x {n} { set code {push concat} set shouldbe {} for {set i 1} {$i < $n} {incr i} { append code \n {push a} $i lappend shouldbe a$i } append code \n {invokeStk} { } $n set is [assemble $code] expr {$is eq $shouldbe} } list [x 254] [x 255] [x 256] [x 257] } -result {1 1 1 1} -cleanup {rename x {}} } # assemble-17 -- jumps and labels test assemble-17.1 {label, wrong # args} { -body { assemble {label} } -returnCodes error -match glob -result {wrong # args*} } test assemble-17.2 {label, wrong # args} { -body { assemble {label too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-17.3 {label, bad subst} { -body { list [catch {assemble {label $foo}} result] $result $::errorCode } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} -cleanup {unset result} } test assemble-17.4 {duplicate label} { -body { list [catch {assemble {label foo; label foo}} result] \ $result $::errorCode } -result {1 {duplicate definition of label "foo"} {TCL ASSEM DUPLABEL foo}} } test assemble-17.5 {jump, wrong # args} { -body { assemble {jump} } -returnCodes error -match glob -result {wrong # args*} } test assemble-17.6 {jump, wrong # args} { -body { assemble {jump too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-17.7 {jump, bad subst} { -body { list [catch {assemble {jump $foo}} result] $result $::errorCode } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} -cleanup {unset result} } test assemble-17.8 {jump - ahead and back} { -body { assemble { jump three label one push a jump four label two push b jump six label three push c jump five label four push d jump two label five push e jump one label six push f concat 6 } } -result ceadbf } test assemble-17.9 {jump - resolve a label multiple times} { -body { proc x {} { set case 0 set result {} assemble { jump common label zero pop incrImm case 1 pop push a append result pop jump common label one pop incrImm case 1 pop push b append result pop jump common label common load case dup push 0 eq jumpTrue zero dup push 1 eq jumpTrue one dup push 2 eq jumpTrue two dup push 3 eq jumpTrue three label two pop incrImm case 1 pop push c append result pop jump common label three pop incrImm case 1 pop push d append result } } x } -result abcd -cleanup {rename x {}} } test assemble-17.10 {jump4 needed} { -body { assemble "push x; jump one; label two; [string repeat {dup; pop;} 128] jump three; label one; jump two; label three" } -result x } test assemble-17.11 {jumpTrue} { -body { proc x {y} { assemble { load y jumpTrue then push no jump else label then push yes label else } } list [x 0] [x 1] } -result {no yes} -cleanup {rename x {}} } test assemble-17.12 {jumpFalse} { -body { proc x {y} { assemble { load y jumpFalse then push no jump else label then push yes label else } } list [x 0] [x 1] } -result {yes no} -cleanup {rename x {}} } test assemble-17.13 {jump to undefined label} { -body { list [catch {assemble {jump nowhere}} result] $result $::errorCode } -result {1 {undefined label "nowhere"} {TCL ASSEM NOLABEL nowhere}} } test assemble-17.14 {jump to undefined label, line number correct?} { -body { catch {assemble {#1 #2 #3 jump nowhere #5 #6 }} set ::errorInfo } -match glob -result {*"assemble" body, line 4*} } test assemble-17.15 {multiple passes of code resizing} { -setup { set body { push - } for {set i 0} {$i < 14} {incr i} { append body "label a" $i \ "; push a; concat 2; nop; nop; jump b" \ $i \n } append body {label a14; push a; concat 2; push 1; jumpTrue b14} \n append body {label a15; push a; concat 2; push 0; jumpFalse b15} \n for {set i 0} {$i < 15} {incr i} { append body "label b" $i \ "; push b; concat 2; nop; nop; jump a" \ [expr {$i+1}] \n } append body {label c; push -; concat 2; nop; nop; nop; jump d} \n append body {label b15; push b; concat 2; nop; nop; jump c} \n append body {label d} proc x {} [list assemble $body] } -body { x } -cleanup { catch {unset body} catch {rename x {}} } -result -abababababababababababababababab- } # assemble-18 - lindexMulti test assemble-18.1 {lindexMulti - wrong # args} { -body { assemble {lindexMulti} } -returnCodes error -match glob -result {wrong # args*} } test assemble-18.2 {lindexMulti - wrong # args} { -body { assemble {lindexMulti too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-18.3 {lindexMulti - bad subst} { -body { assemble {lindexMulti $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-18.4 {lindexMulti - not a number} { -body { proc x {} { assemble {lindexMulti rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-18.5 {lindexMulti - bad operand count} { -body { proc x {} { assemble {lindexMulti 0} } list [catch x result] $result $::errorCode } -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} -cleanup {rename x {}; unset result} } test assemble-18.6 {lindexMulti} { -body { assemble {push {{a b c} {d e f} {g h j}}; lindexMulti 1} } -result {{a b c} {d e f} {g h j}} } test assemble-18.7 {lindexMulti} { -body { assemble {push {{a b c} {d e f} {g h j}}; push 1; lindexMulti 2} } -result {d e f} } test assemble-18.8 {lindexMulti} { -body { assemble {push {{a b c} {d e f} {g h j}}; push 2; push 1; lindexMulti 3} } -result h } # assemble-19 - list test assemble-19.1 {list - wrong # args} { -body { assemble {list} } -returnCodes error -match glob -result {wrong # args*} } test assemble-19.2 {list - wrong # args} { -body { assemble {list too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-19.3 {list - bad subst} { -body { assemble {list $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-19.4 {list - not a number} { -body { proc x {} { assemble {list rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-19.5 {list - negative operand count} { -body { proc x {} { assemble {list -1} } list [catch x result] $result $::errorCode } -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}} -cleanup {rename x {}; unset result} } test assemble-19.6 {list - no args} { -body { assemble {list 0} } -result {} } test assemble-19.7 {list - 1 arg} { -body { assemble {push hello; list 1} } -result hello } test assemble-19.8 {list - 2 args} { -body { assemble {push hello; push world; list 2} } -result {hello world} } # assemble-20 - lsetFlat test assemble-20.1 {lsetFlat - wrong # args} { -body { assemble {lsetFlat} } -returnCodes error -match glob -result {wrong # args*} } test assemble-20.2 {lsetFlat - wrong # args} { -body { assemble {lsetFlat too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-20.3 {lsetFlat - bad subst} { -body { assemble {lsetFlat $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-20.4 {lsetFlat - not a number} { -body { proc x {} { assemble {lsetFlat rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-20.5 {lsetFlat - negative operand count} { -body { proc x {} { assemble {lsetFlat 1} } list [catch x result] $result $::errorCode } -result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}} -cleanup {rename x {}; unset result} } test assemble-20.6 {lsetFlat} { -body { assemble {push b; push a; lsetFlat 2} } -result b } test assemble-20.7 {lsetFlat} { -body { assemble {push 1; push d; push {a b c}; lsetFlat 3} } -result {a d c} } # assemble-21 - over test assemble-21.1 {over - wrong # args} { -body { assemble {over} } -returnCodes error -match glob -result {wrong # args*} } test assemble-21.2 {over - wrong # args} { -body { assemble {over too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-21.3 {over - bad subst} { -body { assemble {over $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-21.4 {over - not a number} { -body { proc x {} { assemble {over rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-21.5 {over - negative operand count} { -body { proc x {} { assemble {over -1} } list [catch x result] $result $::errorCode } -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}} -cleanup {rename x {}; unset result} } test assemble-21.6 {over} { -body { proc x {} { assemble { push 1 push 2 push 3 over 0 store x pop pop pop pop load x } } x } -result 3 -cleanup {rename x {}} } test assemble-21.7 {over} { -body { proc x {} { assemble { push 1 push 2 push 3 over 2 store x pop pop pop pop load x } } x } -result 1 -cleanup {rename x {}} } # assemble-22 - reverse test assemble-22.1 {reverse - wrong # args} { -body { assemble {reverse} } -returnCodes error -match glob -result {wrong # args*} } test assemble-22.2 {reverse - wrong # args} { -body { assemble {reverse too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-22.3 {reverse - bad subst} { -body { assemble {reverse $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-22.4 {reverse - not a number} { -body { proc x {} { assemble {reverse rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-22.5 {reverse - negative operand count} { -body { proc x {} { assemble {reverse -1} } list [catch x result] $result $::errorCode } -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}} -cleanup {rename x {}; unset result} } test assemble-22.6 {reverse - zero operand count} { -body { proc x {} { assemble {push 1; reverse 0} } x } -result 1 -cleanup {rename x {}} } test assemble-22.7 {reverse} { -body { proc x {} { assemble { push 1 push 2 push 3 reverse 1 store x pop pop pop load x } } x } -result 3 -cleanup {rename x {}} } test assemble-22.8 {reverse} { -body { proc x {} { assemble { push 1 push 2 push 3 reverse 3 store x pop pop pop load x } } x } -result 1 -cleanup {rename x {}} } # assemble-23 - ASSEM_BOOL (strmatch, unsetStk, unsetArrayStk) test assemble-23.1 {strmatch - wrong # args} { -body { assemble {strmatch} } -returnCodes error -match glob -result {wrong # args*} } test assemble-23.2 {strmatch - wrong # args} { -body { assemble {strmatch too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-23.3 {strmatch - bad subst} { -body { assemble {strmatch $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-23.4 {strmatch - not a boolean} { -body { proc x {} { assemble {strmatch rubbish} } x } -returnCodes error -result {expected boolean value but got "rubbish"} -cleanup {rename x {}} } test assemble-23.5 {strmatch} { -body { proc x {a b} { list [assemble {load a; load b; strmatch 0}] \ [assemble {load a; load b; strmatch 1}] } list [x foo*.grill fengbar.grill] [x foo*.grill foobar.grill] [x foo*.grill FOOBAR.GRILL] } -result {{0 0} {1 1} {0 1}} -cleanup {rename x {}} } test assemble-23.6 {unsetStk} { -body { proc x {} { set a {} assemble {push a; unsetStk false} info exists a } x } -result 0 -cleanup {rename x {}} } test assemble-23.7 {unsetStk} { -body { proc x {} { assemble {push a; unsetStk false} info exists a } x } -result 0 -cleanup {rename x {}} } test assemble-23.8 {unsetStk} { -body { proc x {} { assemble {push a; unsetStk true} info exists a } x } -returnCodes error -result {can't unset "a": no such variable} -cleanup {rename x {}} } test assemble-23.9 {unsetArrayStk} { -body { proc x {} { set a(b) {} assemble {push a; push b; unsetArrayStk false} info exists a(b) } x } -result 0 -cleanup {rename x {}} } test assemble-23.10 {unsetArrayStk} { -body { proc x {} { assemble {push a; push b; unsetArrayStk false} info exists a(b) } x } -result 0 -cleanup {rename x {}} } test assemble-23.11 {unsetArrayStk} { -body { proc x {} { assemble {push a; push b; unsetArrayStk true} info exists a(b) } x } -returnCodes error -result {can't unset "a(b)": no such variable} -cleanup {rename x {}} } # assemble-24 -- ASSEM_BOOL_LVT4 (unset; unsetArray) test assemble-24.1 {unset - wrong # args} { -body { assemble {unset one} } -returnCodes error -match glob -result {wrong # args*} } test assemble-24.2 {unset - wrong # args} { -body { assemble {unset too many args} } -returnCodes error -match glob -result {wrong # args*} } test assemble-24.3 {unset - bad subst -arg 1} { -body { assemble {unset $foo bar} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-24.4 {unset - not a boolean} { -body { proc x {} { assemble {unset rubbish trash} } x } -returnCodes error -result {expected boolean value but got "rubbish"} -cleanup {rename x {}} } test assemble-24.5 {unset - bad subst - arg 2} { -body { assemble {unset true $bar} } -returnCodes error -result {assembly code may not contain substitutions} } test assemble-24.6 {unset - nonlocal var} { -body { assemble {unset true ::foo::bar} } -returnCodes error -result {variable "::foo::bar" is not local} } test assemble-24.7 {unset} { -body { proc x {} { set a {} assemble {unset false a} info exists a } x } -result 0 -cleanup {rename x {}} } test assemble-24.8 {unset} { -body { proc x {} { assemble {unset false a} info exists a } x } -result 0 -cleanup {rename x {}} } test assemble-24.9 {unset} { -body { proc x {} { assemble {unset true a} info exists a } x } -returnCodes error -result {can't unset "a": no such variable} -cleanup {rename x {}} } test assemble-24.10 {unsetArray} { -body { proc x {} { set a(b) {} assemble {push b; unsetArray false a} info exists a(b) } x } -result 0 -cleanup {rename x {}} } test assemble-24.11 {unsetArray} { -body { proc x {} { assemble {push b; unsetArray false a} info exists a(b) } x } -result 0 -cleanup {rename x {}} } test assemble-24.12 {unsetArray} { -body { proc x {} { assemble {push b; unsetArray true a} info exists a(b) } x } -returnCodes error -result {can't unset "a(b)": no such variable} -cleanup {rename x {}} } # assemble-25 - dict get test assemble-25.1 {dict get - wrong # args} { -body { assemble {dictGet} } -returnCodes error -match glob -result {wrong # args*} } test assemble-25.2 {dict get - wrong # args} { -body { assemble {dictGet too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-25.3 {dictGet - bad subst} { -body { assemble {dictGet $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-25.4 {dict get - not a number} { -body { proc x {} { assemble {dictGet rubbish} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-25.5 {dictGet - negative operand count} { -body { proc x {} { assemble {dictGet 0} } list [catch x result] $result $::errorCode } -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} -cleanup {rename x {}; unset result} } test assemble-25.6 {dictGet - 1 index} { -body { assemble {push {a 1 b 2}; push a; dictGet 1} } -result 1 } # assemble-26 - dict set test assemble-26.1 {dict set - wrong # args} { -body { assemble {dictSet 1} } -returnCodes error -match glob -result {wrong # args*} } test assemble-26.2 {dict get - wrong # args} { -body { assemble {dictSet too many args} } -returnCodes error -match glob -result {wrong # args*} } test assemble-26.3 {dictSet - bad subst} { -body { assemble {dictSet 1 $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-26.4 {dictSet - not a number} { -body { proc x {} { assemble {dictSet rubbish foo} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-26.5 {dictSet - zero operand count} { -body { proc x {} { assemble {dictSet 0 foo} } list [catch x result] $result $::errorCode } -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} -cleanup {rename x {}; unset result} } test assemble-26.6 {dictSet - bad local} { -body { proc x {} { assemble {dictSet 1 ::foo::bar} } list [catch x result] $result $::errorCode } -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}} -cleanup {rename x {}; unset result} } test assemble-26.7 {dictSet} { -body { proc x {} { set dict {a 1 b 2 c 3} assemble {push b; push 4; dictSet 1 dict} } x } -result {a 1 b 4 c 3} -cleanup {rename x {}} } # assemble-27 - dictUnset test assemble-27.1 {dictUnset - wrong # args} { -body { assemble {dictUnset 1} } -returnCodes error -match glob -result {wrong # args*} } test assemble-27.2 {dictUnset - wrong # args} { -body { assemble {dictUnset too many args} } -returnCodes error -match glob -result {wrong # args*} } test assemble-27.3 {dictUnset - bad subst} { -body { assemble {dictUnset 1 $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-27.4 {dictUnset - not a number} { -body { proc x {} { assemble {dictUnset rubbish foo} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-27.5 {dictUnset - zero operand count} { -body { proc x {} { assemble {dictUnset 0 foo} } list [catch x result] $result $::errorCode } -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} -cleanup {rename x {}; unset result} } test assemble-27.6 {dictUnset - bad local} { -body { proc x {} { assemble {dictUnset 1 ::foo::bar} } list [catch x result] $result $::errorCode } -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}} -cleanup {rename x {}; unset result} } test assemble-27.7 {dictUnset} { -body { proc x {} { set dict {a 1 b 2 c 3} assemble {push b; dictUnset 1 dict} } x } -result {a 1 c 3} -cleanup {rename x {}} } # assemble-28 - dictIncrImm test assemble-28.1 {dictIncrImm - wrong # args} { -body { assemble {dictIncrImm 1} } -returnCodes error -match glob -result {wrong # args*} } test assemble-28.2 {dictIncrImm - wrong # args} { -body { assemble {dictIncrImm too many args} } -returnCodes error -match glob -result {wrong # args*} } test assemble-28.3 {dictIncrImm - bad subst} { -body { assemble {dictIncrImm 1 $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-28.4 {dictIncrImm - not a number} { -body { proc x {} { assemble {dictIncrImm rubbish foo} } x } -returnCodes error -result {expected integer but got "rubbish"} -cleanup {rename x {}} } test assemble-28.5 {dictIncrImm - bad local} { -body { proc x {} { assemble {dictIncrImm 1 ::foo::bar} } list [catch x result] $result $::errorCode } -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}} -cleanup {rename x {}; unset result} } test assemble-28.6 {dictIncrImm} { -body { proc x {} { set dict {a 1 b 2 c 3} assemble {push b; dictIncrImm 42 dict} } x } -result {a 1 b 44 c 3} -cleanup {rename x {}} } # assemble-29 - ASSEM_REGEXP test assemble-29.1 {regexp - wrong # args} { -body { assemble {regexp} } -returnCodes error -match glob -result {wrong # args*} } test assemble-29.2 {regexp - wrong # args} { -body { assemble {regexp too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-29.3 {regexp - bad subst} { -body { assemble {regexp $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-29.4 {regexp - not a boolean} { -body { proc x {} { assemble {regexp rubbish} } x } -returnCodes error -result {expected boolean value but got "rubbish"} -cleanup {rename x {}} } test assemble-29.5 {regexp} { -body { assemble {push br.*br; push abracadabra; regexp false} } -result 1 } test assemble-29.6 {regexp} { -body { assemble {push br.*br; push aBRacadabra; regexp false} } -result 0 } test assemble-29.7 {regexp} { -body { assemble {push br.*br; push aBRacadabra; regexp true} } -result 1 } # assemble-30 - Catches test assemble-30.1 {simplest possible catch} { -body { proc x {} { assemble { beginCatch @bad push error push testing invokeStk 2 pop push 0 jump @ok label @bad push 1; # should be pushReturnCode label @ok endCatch } } x } -result 1 -cleanup {rename x {}} } test assemble-30.2 {catch in external catch conntext} { -body { proc x {} { list [catch { assemble { beginCatch @bad push error push testing invokeStk 2 pop push 0 jump @ok label @bad pushReturnCode label @ok endCatch } } result] $result } x } -result {0 1} -cleanup {rename x {}} } test assemble-30.3 {embedded catches} { -body { proc x {} { list [catch { assemble { beginCatch @bad push error eval { list [catch {error whatever} result] $result } invokeStk 2 push 0 reverse 2 jump @done label @bad pushReturnCode pushResult label @done endCatch list 2 } } result2] $result2 } x } -result {0 {1 {1 whatever}}} -cleanup {rename x {}} } test assemble-30.4 {throw in wrong context} { -body { proc x {} { list [catch { assemble { beginCatch @bad push error eval { list [catch {error whatever} result] $result } invokeStk 2 push 0 reverse 2 jump @done label @bad load x pushResult label @done endCatch list 2 } } result] $result $::errorCode [split $::errorInfo \n] } x } -match glob -result {1 {"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {TCL ASSEM BADTHROW} {{"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} { in assembly code between lines 10 and 15}*}} -cleanup {rename x {}} } test assemble-30.5 {unclosed catch} { -body { proc x {} { assemble { beginCatch @error push 0 jump @done label @error push 1 label @done push "" pop } } list [catch {x} result] $result $::errorCode $::errorInfo } -match glob -result {1 {catch still active on exit from assembly code} {TCL ASSEM UNCLOSEDCATCH} {catch still active on exit from assembly code ("assemble" body, line 2)*}} -cleanup {rename x {}} } test assemble-30.6 {inconsistent catch contexts} { -body { proc x {y} { assemble { load y jumpTrue @inblock beginCatch @error label @inblock push 0 jump @done label @error push 1 label @done } } list [catch {x 2} result] $::errorCode $::errorInfo } -match glob -result {1 {TCL ASSEM BADCATCH} {execution reaches an instruction in inconsistent exception contexts ("assemble" body, line 5)*}} -cleanup {rename x {}} } # assemble-31 - Jump tables test assemble-31.1 {jumpTable, wrong # args} { -body { assemble {jumpTable} } -returnCodes error -match glob -result {wrong # args*} } test assemble-31.2 {jumpTable, wrong # args} { -body { assemble {jumpTable too many} } -returnCodes error -match glob -result {wrong # args*} } test assemble-31.3 {jumpTable - bad subst} { -body { assemble {jumpTable $foo} } -returnCodes error -match glob -result {assembly code may not contain substitutions} } test assemble-31.4 {jumptable - not a list} { -body { assemble {jumpTable \{rubbish} } -returnCodes error -result {unmatched open brace in list} } test assemble-31.5 {jumpTable, badly structured} { -body { list [catch {assemble { # line 2 jumpTable {one two three};# line 3 }} result] \ $result $::errorCode $::errorInfo } -match glob -result {1 {jump table must have an even number of list elements} {TCL ASSEM BADJUMPTABLE} {jump table must have an even number of list elements*("assemble" body, line 3)*}} } test assemble-31.6 {jumpTable, missing symbol} { -body { list [catch {assemble { # line 2 jumpTable {1 a};# line 3 }} result] \ $result $::errorCode $::errorInfo } -match glob -result {1 {undefined label "a"} {TCL ASSEM NOLABEL a} {undefined label "a"*("assemble" body, line 3)*}} } test assemble-31.7 {jumptable, actual example} { -setup { proc x {} { set result {} for {set i 0} {$i < 5} {incr i} { lappend result [assemble { load i jumpTable {1 @one 2 @two 3 @three} push {none of the above} jump @done label @one push one jump @done label @two push two jump @done label @three push three label @done }] } set tcl_traceCompile 2 set result } } -body x -result {{none of the above} one two three {none of the above}} -cleanup {set tcl_traceCompile 0; rename x {}} } test assemble-40.1 {unbalanced stack} { -body { list \ [catch { assemble { push 3 dup mult push 4 dup mult pop expon } } result] $result $::errorInfo } -result {1 {stack underflow} {stack underflow in assembly code between lines 1 and end of assembly code*}} -match glob -returnCodes ok } test assemble-40.2 {unbalanced stack} {*}{ -body { list \ [catch { assemble { label a push {} label b pop label c pop label d push {} } } result] $result $::errorInfo } -result {1 {stack underflow} {stack underflow in assembly code between lines 7 and 9*}} -match glob -returnCodes ok } test assemble-41.1 {Inconsistent stack usage} {*}{ -body { proc x {y} { assemble { load y jumpFalse else push 0 jump then label else push 1 push 2 label then pop } } catch {x 1} set errorInfo } -match glob -result {inconsistent stack depths on two execution paths ("assemble" body, line 10)*} -cleanup {rename x {}} } test assemble-41.2 {Inconsistent stack, jumptable and default} { -body { proc x {y} { assemble { load y jumpTable {0 else} push 0 label else pop } } catch {x 1} set errorInfo } -match glob -result {inconsistent stack depths on two execution paths ("assemble" body, line 6)*} -cleanup {rename x {}} } test assemble-41.3 {Inconsistent stack, two legs of jumptable} { -body { proc x {y} { assemble { load y jumpTable {0 no 1 yes} label no push 0 label yes pop } } catch {x 1} set errorInfo } -match glob -result {inconsistent stack depths on two execution paths ("assemble" body, line 7)*} -cleanup {rename x {}} } test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} { -body { proc ulam {n} { assemble { load n; # max dup; # max n jump start; # max n label loop; # max n over 1; # max n max over 1; # max in max n ge; # man n max>=n jumpTrue skip; # max n reverse 2; # n max pop; # n dup; # n n label skip; # max n dup; # max n n push 2; # max n n 2 mod; # max n n%2 jumpTrue odd; # max n push 2; # max n 2 div; # max n/2 -> max n jump start; # max n label odd; # max n push 3; # max n 3 mult; # max 3*n push 1; # max 3*n 1 add; # max 3*n+1 label start; # max n dup; # max n n push 1; # max n n 1 neq; # max n n>1 jumpTrue loop; # max n pop; # max } } set result {} for {set i 1} {$i < 30} {incr i} { lappend result [ulam $i] } set result } -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88} -cleanup {rename ulam {}} } test assemble-51.1 {memory leak testing} memory { leaktest { apply {{} {assemble {push hello}}} } } 0 test assemble-51.2 {memory leak testing} memory { leaktest { apply {{{x 0}} {assemble {incrImm x 1}}} } } 0 test assemble-51.3 {memory leak testing} memory { leaktest { apply {{n} { assemble { load n; # max dup; # max n jump start; # max n label loop; # max n over 1; # max n max over 1; # max in max n ge; # man n max>=n jumpTrue skip; # max n reverse 2; # n max pop; # n dup; # n n label skip; # max n dup; # max n n push 2; # max n n 2 mod; # max n n%2 jumpTrue odd; # max n push 2; # max n 2 div; # max n/2 -> max n jump start; # max n label odd; # max n push 3; # max n 3 mult; # max 3*n push 1; # max 3*n 1 add; # max 3*n+1 label start; # max n dup; # max n n push 1; # max n n 1 neq; # max n n>1 jumpTrue loop; # max n pop; # max } }} 1 } } 0 test assemble-51.4 {memory leak testing} memory { leaktest { catch { apply {{} { assemble {reverse polish notation} }} } } } 0 test assemble-52.1 {Bug 3154ea2759} { apply {{} { # Needs six exception ranges to force the range allocations to use the # malloced store. ::tcl::unsupported::assemble { beginCatch @badLabel push error push testing invokeStk 2 pop push 0 jump @okLabel label @badLabel push 1; # should be pushReturnCode label @okLabel endCatch pop beginCatch @badLabel2 push error push testing invokeStk 2 pop push 0 jump @okLabel2 label @badLabel2 push 1; # should be pushReturnCode label @okLabel2 endCatch pop beginCatch @badLabel3 push error push testing invokeStk 2 pop push 0 jump @okLabel3 label @badLabel3 push 1; # should be pushReturnCode label @okLabel3 endCatch pop beginCatch @badLabel4 push error push testing invokeStk 2 pop push 0 jump @okLabel4 label @badLabel4 push 1; # should be pushReturnCode label @okLabel4 endCatch pop beginCatch @badLabel5 push error push testing invokeStk 2 pop push 0 jump @okLabel5 label @badLabel5 push 1; # should be pushReturnCode label @okLabel5 endCatch pop beginCatch @badLabel6 push error push testing invokeStk 2 pop push 0 jump @okLabel6 label @badLabel6 push 1; # should be pushReturnCode label @okLabel6 endCatch pop } }} } {}; # must not crash rename fillTables {} rename assemble {} if {[testConstraint memory]} { rename getbytes {} rename leaktest {} } ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/assocd.test0000644000175000017500000000433414554262142015165 0ustar sergeisergei# This file tests the AssocData facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testgetassocdata [llength [info commands testgetassocdata]] testConstraint testsetassocdata [llength [info commands testsetassocdata]] testConstraint testdelassocdata [llength [info commands testdelassocdata]] test assocd-1.1 {testing setting assoc data} testsetassocdata { testsetassocdata a 1 } "" test assocd-1.2 {testing setting assoc data} testsetassocdata { testsetassocdata a 2 } "" test assocd-1.3 {testing setting assoc data} testsetassocdata { testsetassocdata 123 456 } "" test assocd-1.4 {testing setting assoc data} testsetassocdata { testsetassocdata abc "abc d e f" } "" test assocd-2.1 {testing getting assoc data} -setup { testsetassocdata a 2 } -constraints {testgetassocdata} -body { testgetassocdata a } -result 2 test assocd-2.2 {testing getting assoc data} -setup { testsetassocdata 123 456 } -constraints {testgetassocdata} -body { testgetassocdata 123 } -result 456 test assocd-2.3 {testing getting assoc data} -setup { testsetassocdata abc "abc d e f" } -constraints {testgetassocdata} -body { testgetassocdata abc } -result "abc d e f" test assocd-2.4 {testing getting assoc data} testgetassocdata { testgetassocdata xxx } "" test assocd-3.1 {testing deleting assoc data} testdelassocdata { testdelassocdata a } "" test assocd-3.2 {testing deleting assoc data} testdelassocdata { testdelassocdata 123 } "" test assocd-3.3 {testing deleting assoc data} testdelassocdata { list [catch {testdelassocdata nonexistent} msg] $msg } {0 {}} # cleanup cleanupTests return tcl8.6.14/tests/async.test0000644000175000017500000001512614554262142015027 0ustar sergeisergei# Commands covered: none # # This file contains a collection of tests for Tcl_AsyncCreate and related # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testasync [llength [info commands testasync]] testConstraint threaded [::tcl::pkgconfig get threaded] testConstraint notWinCI [expr {$::tcl_platform(platform) != "windows" || ![info exists ::env(CI)]}] proc async1 {result code} { global aresult acode set aresult $result set acode $code return "new result" } proc async2 {result code} { global aresult acode set aresult $result set acode $code return -code error "xyzzy" } proc async3 {result code} { global aresult set aresult "test pattern" return -code $code $result } proc \# {result code} { global aresult acode set aresult $result set acode $code return "comment quoting" } if {[testConstraint testasync]} { set handler1 [testasync create async1] set handler2 [testasync create async2] set handler3 [testasync create async3] set handler4 [testasync create \#] } test async-1.1 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler1 "original" 0} msg] $msg \ $acode $aresult } {0 {new result} 0 original} test async-1.2 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler1 "original" 1} msg] $msg \ $acode $aresult } {0 {new result} 1 original} test async-1.3 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler2 "old" 0} msg] $msg \ $acode $aresult } {1 xyzzy 0 old} test async-1.4 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler2 "old" 3} msg] $msg \ $acode $aresult } {1 xyzzy 3 old} test async-1.5 {basic async handlers} testasync { set aresult xxx list [catch {testasync mark $handler3 "foobar" 0} msg] $msg $aresult } {0 foobar {test pattern}} test async-1.6 {basic async handlers} testasync { set aresult xxx list [catch {testasync mark $handler3 "foobar" 1} msg] $msg $aresult } {1 foobar {test pattern}} test async-1.7 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler4 "original" 0} msg] $msg \ $acode $aresult } {0 {comment quoting} 0 original} proc mult1 {result code} { global x lappend x mult1 return -code 7 mult1 } proc mult2 {result code} { global x lappend x mult2 return -code 9 mult2 } proc mult3 {result code} { global x hm1 hm2 lappend x [catch {testasync mark $hm2 serial2 0}] lappend x [catch {testasync mark $hm1 serial1 0}] lappend x mult3 return -code 11 mult3 } if {[testConstraint testasync]} { set hm1 [testasync create mult1] set hm2 [testasync create mult2] set hm3 [testasync create mult3] } test async-2.1 {multiple handlers} testasync { set x {} list [catch {testasync mark $hm3 "foobar" 5} msg] $msg $x } {9 mult2 {0 0 mult3 mult1 mult2}} proc del1 {result code} { global x hm1 hm2 hm3 hm4 lappend x [catch {testasync mark $hm3 serial2 0}] lappend x [catch {testasync mark $hm1 serial1 0}] lappend x [catch {testasync mark $hm4 serial1 0}] testasync delete $hm1 testasync delete $hm2 testasync delete $hm3 lappend x del1 return -code 13 del1 } proc del2 {result code} { global x lappend x del2 return -code 3 del2 } if {[testConstraint testasync]} { testasync delete $handler1 testasync delete $hm2 testasync delete $hm3 set hm2 [testasync create del1] set hm3 [testasync create mult2] set hm4 [testasync create del2] } test async-3.1 {deleting handlers} testasync { set x {} list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x } {3 del2 {0 0 0 del1 del2}} test async-4.1 {async interrupting bytecode sequence} -constraints { testasync threaded } -setup { set hm [testasync create async3] proc nothing {} { # empty proc } } -body { apply {{handle} { global aresult set aresult {Async event not delivered} testasync marklater $handle # allow plenty of time to pass in case valgrind is running set start [clock seconds] while { [clock seconds] - $start < 180 && $aresult eq "Async event not delivered" } { # be less busy after 100 nothing } return $aresult }} $hm } -result {test pattern} -cleanup { # give other threads some time to go way so that valgrind doesn't pick up # "still reachable" cases from early thread termination after 100 testasync delete $hm } test async-4.2 {async interrupting straight bytecode sequence} -constraints { testasync threaded } -setup { set hm [testasync create async3] } -body { apply {{handle} { global aresult set aresult {Async event not delivered} testasync marklater $handle # allow plenty of time to pass in case valgrind is running set start [clock seconds] while { [clock seconds] - $start < 180 && $aresult eq "Async event not delivered" } { # be less busy after 100 } return $aresult }} $hm } -result {test pattern} -cleanup { # give other threads some time to go way so that valgrind doesn't pick up # "still reachable" cases from early thread termination after 100 testasync delete $hm } test async-4.3 {async interrupting loop-less bytecode sequence} -constraints { testasync threaded notWinCI } -setup { set hm [testasync create async3] } -body { apply [list {handle} [concat { global aresult set aresult {Async event not delivered} testasync marklater $handle set i 0 } "[string repeat {;incr i;} 1500000]after 10;" { return $aresult }]] $hm } -result {test pattern} -cleanup { # give other threads some time to go way so that valgrind doesn't pick up # "still reachable" cases from early thread termination after 100 testasync delete $hm } # cleanup if {[testConstraint testasync]} { testasync delete } ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/autoMkindex.test0000644000175000017500000002665214554262142016210 0ustar sergeisergei# Commands covered: auto_mkindex auto_import # # This file contains tests related to autoloading and generating the # autoloading index. # # Copyright (c) 1998 Lucent Technologies, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } makeFile {# Test file for: # auto_mkindex # # This file provides example cases for testing the Tcl autoloading facility. # Things are much more complicated with namespaces and classes. The # "auto_mkindex" facility can no longer be built on top of a simple regular # expression parser. It must recognize constructs like this: # # namespace eval foo { # proc test {x y} { ... } # namespace eval bar { # proc another {args} { ... } # } # } # # Note that procedures and itcl class definitions can be nested inside of # namespaces. # # Copyright (c) 1993-1998 Lucent Technologies, Inc. # This shouldn't cause any problems namespace import -force blt::* # Should be able to handle "proc" definitions, even if they are preceded by # white space. proc normal {x y} {return [expr {$x+$y}]} proc indented {x y} {return [expr {$x+$y}]} # # Should be able to handle proc declarations within namespaces, even if they # have explicit namespace paths. # namespace eval buried { proc inside {args} {return "inside: $args"} namespace export pub_* proc pub_one {args} {return "one: $args"} proc pub_two {args} {return "two: $args"} } proc buried::within {args} {return "within: $args"} namespace eval buried { namespace eval under { proc neath {args} {return "neath: $args"} } namespace eval ::buried { proc relative {args} {return "relative: $args"} proc ::top {args} {return "top: $args"} proc ::buried::explicit {args} {return "explicit: $args"} } } # With proper hooks, we should be able to support other commands that create # procedures proc buried::myproc {name body args} { ::proc $name $body $args } namespace eval ::buried { proc mycmd1 args {return "mycmd"} myproc mycmd2 args {return "mycmd"} } ::buried::myproc mycmd3 args {return "another"} proc {buried::my proc} {name body args} { ::proc $name $body $args } namespace eval ::buried { proc mycmd4 args {return "mycmd"} {my proc} mycmd5 args {return "mycmd"} } {::buried::my proc} mycmd6 args {return "another"} # A correctly functioning [auto_import] won't choke when a child namespace # [namespace import]s from its parent. # namespace eval ::parent::child { namespace import ::parent::* } proc ::parent::child::test {} {} } autoMkindex.tcl # Save initial state of auto_mkindex_parser auto_load auto_mkindex if {[info exists auto_mkindex_parser::initCommands]} { set saveCommands $auto_mkindex_parser::initCommands } proc AutoMkindexTestReset {} { global saveCommands if {[info exists saveCommands]} { set auto_mkindex_parser::initCommands $saveCommands } elseif {[info exists auto_mkindex_parser::initCommands]} { unset auto_mkindex_parser::initCommands } } set result "" set origDir [pwd] cd $::tcltest::temporaryDirectory test autoMkindex-1.1 {remove any existing tclIndex file} { file delete tclIndex file exists tclIndex } {0} test autoMkindex-1.2 {build tclIndex based on a test file} { auto_mkindex . autoMkindex.tcl file exists tclIndex } {1} set element "{source [file join . autoMkindex.tcl]}" test autoMkindex-1.3 {examine tclIndex} -setup { file delete tclIndex } -body { auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." variable auto_index source tclIndex set ::result "" foreach elem [lsort [array names auto_index]] { lappend ::result [list $elem $auto_index($elem)] } } return $result } -cleanup { namespace delete tcl_autoMkindex_tmp } -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}" test autoMkindex-2.1 {commands on the autoload path can be imported} -setup { file delete tclIndex interp create child } -body { auto_mkindex . autoMkindex.tcl child eval { namespace eval blt {} set auto_path [linsert $auto_path 0 .] set info [list [catch {namespace import buried::*} result] $result] foreach name [lsort [info commands pub_*]] { lappend info $name [namespace origin $name] } return $info } } -cleanup { interp delete child } -result "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two" # Test auto_mkindex hooks # Slave hook executes interesting code in the interp used to watch code. test autoMkindex-3.1 {slaveHook} -setup { file delete tclIndex } -body { auto_mkindex_parser::slavehook { _%@namespace eval ::blt { proc foo {} {} _%@namespace export foo } } auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* } auto_mkindex . autoMkindex.tcl file exists tclIndex } -cleanup { # Reset initCommands to avoid trashing other tests AutoMkindexTestReset } -result 1 # The auto_mkindex_parser::command is used to register commands that create # new commands. test autoMkindex-3.2 {auto_mkindex_parser::command} -setup { file delete tclIndex } -body { auto_mkindex_parser::command buried::myproc {name args} { variable index variable scriptFile append index [list set auto_index([fullname $name])] \ " \[list source \[file join \$dir [list $scriptFile]\]\]\n" } auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." variable auto_index source tclIndex set ::result "" foreach elem [lsort [array names auto_index]] { lappend ::result [list $elem $auto_index($elem)] } return $::result } } -cleanup { namespace delete tcl_autoMkindex_tmp # Reset initCommands to avoid trashing other tests AutoMkindexTestReset } -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}" test autoMkindex-3.3 {auto_mkindex_parser::command} -setup { file delete tclIndex } -constraints {knownBug} -body { auto_mkindex_parser::command {buried::my proc} {name args} { variable index variable scriptFile puts "my proc $name" append index [list set auto_index([fullname $name])] \ " \[list source \[file join \$dir [list $scriptFile]\]\]\n" } auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." variable auto_index source tclIndex set ::result "" foreach elem [lsort [array names auto_index]] { lappend ::result [list $elem $auto_index($elem)] } } list [lsearch -inline $::result *mycmd4*] \ [lsearch -inline $::result *mycmd5*] \ [lsearch -inline $::result *mycmd6*] } -cleanup { namespace delete tcl_autoMkindex_tmp # Reset initCommands to avoid trashing other tests AutoMkindexTestReset } -result "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}" makeFile { namespace eval wok { namespace ensemble create -subcommands {commands vars} proc commands {{pattern *}} { puts [join [lsort -dictionary [info commands $pattern]] \n] } proc vars {{pattern *}} { puts [join [lsort -dictionary [info vars $pattern]] \n] } } } ensemblecommands.tcl test autoMkindex-3.4 {ensemble commands in tclIndex} { file delete tclIndex auto_mkindex . ensemblecommands.tcl set f [open tclIndex r] set dat [list] foreach r [split [string trim [read $f]] "\n"] { if {[string match {set auto_index*} $r]} { lappend dat $r } } set result [lsort $dat] close $f set result } {{set auto_index(::wok::commands) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source [file join $dir ensemblecommands.tcl]]}} removeFile ensemblecommands.tcl test autoMkindex-4.1 {platform independent source commands} -setup { file delete tclIndex makeDirectory pkg makeFile { package provide football 1.0 namespace eval ::pro:: { # # export only public functions. # namespace export {[a-z]*} } namespace eval ::college:: { # # export only public functions. # namespace export {[a-z]*} } proc ::pro::team {} { puts "go packers!" return true } proc ::college::team {} { puts "go badgers!" return true } } [file join pkg samename.tcl] } -body { auto_mkindex . pkg/samename.tcl set f [open tclIndex r] lsort [lrange [split [string trim [read $f]] "\n"] end-1 end] } -cleanup { catch {close $f} removeFile [file join pkg samename.tcl] removeDirectory pkg } -result {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}} test autoMkindex-5.1 {escape magic tcl chars in general code} -setup { file delete tclIndex makeDirectory pkg makeFile { set dollar1 "this string contains an unescaped dollar sign -> \\$foo" set dollar2 \ "this string contains an escaped dollar sign -> \$foo \\\$foo" set bracket1 "this contains an unescaped bracket [NoSuchProc]" set bracket2 "this contains an escaped bracket \[NoSuchProc\]" set bracket3 \ "this contains nested unescaped brackets [[NoSuchProc]]" proc testProc {} {} } [file join pkg magicchar.tcl] set result {} } -body { auto_mkindex . pkg/magicchar.tcl set f [open tclIndex r] lindex [split [string trim [read $f]] "\n"] end } -cleanup { catch {close $f} removeFile [file join pkg magicchar.tcl] removeDirectory pkg } -result {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]} test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup { file delete tclIndex makeDirectory pkg makeFile { proc {[magic mojo proc]} {} {} } [file join pkg magicchar2.tcl] set result {} interp create child } -body { auto_mkindex . pkg/magicchar2.tcl # Make a child interp to test the autoloading child eval {lappend auto_path [pwd]} child eval {catch {{[magic mojo proc]}}} } -cleanup { interp delete child removeFile [file join pkg magicchar2.tcl] removeDirectory pkg } -result 0 # Clean up. unset result AutoMkindexTestReset if {[info exists saveCommands]} { unset saveCommands } rename AutoMkindexTestReset "" removeFile autoMkindex.tcl if {[file exists tclIndex]} { file delete -force tclIndex } cd $origDir ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/basic.test0000644000175000017500000007777514554262142015015 0ustar sergeisergei# This file contains tests for the tclBasic.c source file. Tests appear in # the same order as the C code that they test. The set of tests is # currently incomplete since it currently includes only new tests for # code changed for the addition of Tcl namespaces. Other variable- # related tests appear in several other test files including # assocd.test, cmdInfo.test, eval.test, expr.test, interp.test, # and trace.test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testevalex [llength [info commands testevalex]] testConstraint testcmdtoken [llength [info commands testcmdtoken]] testConstraint testcreatecommand [llength [info commands testcreatecommand]] testConstraint exec [llength [info commands exec]] catch {namespace delete test_ns_basic} catch {interp delete test_interp} catch {rename p ""} catch {rename q ""} catch {rename cmd ""} unset -nocomplain x test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} { catch {interp delete test_interp} interp create test_interp interp eval test_interp { namespace eval test_ns_basic { proc p {} { return [namespace current] } } } list [interp eval test_interp {test_ns_basic::p}] \ [interp delete test_interp] } {::test_ns_basic {}} test basic-2.1 {TclHideUnsafeCommands} {emptyTest} { } {} test basic-3.1 {Tcl_CallWhenDeleted: see dcall.test} {emptyTest} { } {} test basic-4.1 {Tcl_DontCallWhenDeleted: see dcall.test} {emptyTest} { } {} test basic-5.1 {Tcl_SetAssocData: see assoc.test} {emptyTest} { } {} test basic-6.1 {Tcl_DeleteAssocData: see assoc.test} {emptyTest} { } {} test basic-7.1 {Tcl_GetAssocData: see assoc.test} {emptyTest} { } {} test basic-8.1 {Tcl_InterpDeleted} {emptyTest} { } {} test basic-9.1 {Tcl_DeleteInterp: see interp.test} {emptyTest} { } {} test basic-10.1 {DeleteInterpProc, destroys interp's global namespace} { catch {interp delete test_interp} interp create test_interp interp eval test_interp { namespace eval test_ns_basic { namespace export p proc p {} { return [namespace current] } } namespace eval test_ns_2 { namespace import ::test_ns_basic::p variable v 27 proc q {} { variable v return "[p] $v" } } } list [interp eval test_interp {test_ns_2::q}] \ [interp eval test_interp {namespace delete ::}] \ [catch {interp eval test_interp {set a 123}} msg] $msg \ [interp delete test_interp] } {{::test_ns_basic 27} {} 1 {invalid command name "set"} {}} test basic-11.1 {HiddenCmdsDeleteProc, invalidate cached refs to deleted hidden cmd} { catch {interp delete test_interp} interp create test_interp interp eval test_interp { proc p {} { return 27 } } interp alias {} localP test_interp p list [interp eval test_interp {p}] \ [localP] \ [test_interp hide p] \ [catch {localP} msg] $msg \ [interp delete test_interp] \ [catch {localP} msg] $msg } {27 27 {} 1 {invalid command name "p"} {} 1 {invalid command name "localP"}} # NB: More tests about hide/expose are found in interp.test test basic-12.1 {Tcl_HideCommand, names of hidden cmds can't have namespace qualifiers} { catch {interp delete test_interp} interp create test_interp interp eval test_interp { namespace eval test_ns_basic { proc p {} { return [namespace current] } } } list [catch {test_interp hide test_ns_basic::p x} msg] $msg \ [catch {test_interp hide x test_ns_basic::p} msg1] $msg1 \ [interp delete test_interp] } {1 {can only hide global namespace commands (use rename then hide)} 1 {cannot use namespace qualifiers in hidden command token (rename)} {}} test basic-12.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespace} { catch {namespace delete test_ns_basic} catch {rename cmd ""} proc cmd {} { ;# note that this is global return [namespace current] } namespace eval test_ns_basic { proc hideCmd {} { interp hide {} cmd } proc exposeCmd {} { interp expose {} cmd } proc callCmd {} { cmd } } list [test_ns_basic::callCmd] \ [test_ns_basic::hideCmd] \ [catch {cmd} msg] $msg \ [test_ns_basic::exposeCmd] \ [test_ns_basic::callCmd] \ [namespace delete test_ns_basic] } {:: {} 1 {invalid command name "cmd"} {} :: {}} test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and cannot go to another namespace} { catch {namespace delete test_ns_basic} catch {rename cmd ""} proc cmd {} { ;# note that this is global return [namespace current] } namespace eval test_ns_basic { proc hideCmd {} { interp hide {} cmd } proc exposeCmdFailing {} { interp expose {} cmd ::test_ns_basic::newCmd } proc exposeCmdWorkAround {} { interp expose {} cmd; rename cmd ::test_ns_basic::newCmd; } proc callCmd {} { cmd } } list [test_ns_basic::callCmd] \ [test_ns_basic::hideCmd] \ [catch {test_ns_basic::exposeCmdFailing} msg] $msg \ [test_ns_basic::exposeCmdWorkAround] \ [test_ns_basic::newCmd] \ [namespace delete test_ns_basic] } {:: {} 1 {cannot expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}} test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being exposed} { catch {rename p ""} catch {rename cmd ""} proc p {} { cmd } proc cmd {} { return 42 } list [p] \ [interp hide {} cmd] \ [proc cmd {} {return Hello}] \ [cmd] \ [rename cmd ""] \ [interp expose {} cmd] \ [p] } {42 {} {} Hello {} {} 42} test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {testcreatecommand} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [testcreatecommand create] \ [test_ns_basic::createdcommand] \ [testcreatecommand delete] } {{} {CreatedCommandProc in ::test_ns_basic} {}} test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {testcreatecommand} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename value:at: ""} list [testcreatecommand create2] \ [value:at:] \ [testcreatecommand delete2] } {{} {CreatedCommandProc2 in ::} {}} test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic {} proc test_ns_basic::cmd {} { ;# proc requires that ns already exist return [namespace current] } list [test_ns_basic::cmd] \ [namespace delete test_ns_basic] } {::test_ns_basic {}} test basic-15.2 {Tcl_CreateObjCommand, Bug 0e4d88b650} -setup { proc deleter {ns args} { namespace delete $ns } namespace eval n { proc p {} {} } trace add command n::p delete [list [namespace which deleter] [namespace current]::n] } -body { proc n::p {} {} } -cleanup { namespace delete n rename deleter {} } test basic-16.1 {TclInvokeStringCommand} {emptyTest} { } {} test basic-17.1 {TclInvokeObjCommand} {emptyTest} { } {} test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace qualifiers} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename cmd ""} namespace eval test_ns_basic { proc p {} { return "p in [namespace current]" } } list [test_ns_basic::p] \ [rename test_ns_basic::p test_ns_basic::q] \ [test_ns_basic::q] } {{p in ::test_ns_basic} {} {p in ::test_ns_basic}} test basic-18.2 {TclRenameCommand, existing cmd must be found} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg } {1 {can't rename "test_ns_basic::p": command doesn't exist}} test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic { proc p {} { return "p in [namespace current]" } } list [info commands test_ns_basic::*] \ [rename test_ns_basic::p ""] \ [info commands test_ns_basic::*] } {::test_ns_basic::p {} {}} test basic-18.4 {TclRenameCommand, bad new name} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic { proc p {} { return "p in [namespace current]" } } rename test_ns_basic::p :::george::martha } {} test basic-18.5 {TclRenameCommand, new name must not already exist} -setup { if {![llength [info commands :::george::martha]]} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic { proc p {} { return "p in [namespace current]" } } rename test_ns_basic::p :::george::martha } } -body { namespace eval test_ns_basic { proc q {} { return 42 } } list [catch {rename test_ns_basic::q :::george::martha} msg] $msg } -result {1 {can't rename to ":::george::martha": command already exists}} test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename q ""} proc p {} { return "p in [namespace current]" } proc q {} { return "q in [namespace current]" } namespace eval test_ns_basic { proc callP {} { p } } list [test_ns_basic::callP] \ [rename q test_ns_basic::p] \ [test_ns_basic::callP] } {{p in ::} {} {q in ::test_ns_basic}} test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} { } {} test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {testcmdtoken} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename q ""} unset -nocomplain x set x [namespace eval test_ns_basic::test_ns_basic2 { # the following creates a cmd in the global namespace testcmdtoken create p }] list [testcmdtoken name $x] \ [rename ::p q] \ [testcmdtoken name $x] } {{p ::p} {} {q ::q}} test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {testcmdtoken} { catch {rename q ""} set x [testcmdtoken create test_ns_basic::test_ns_basic2::p] list [testcmdtoken name $x] \ [rename test_ns_basic::test_ns_basic2::p q] \ [testcmdtoken name $x] } {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}} test basic-20.3 {Tcl_GetCommandInfo, #-quoting} testcmdtoken { catch {rename \# ""} set x [testcmdtoken create \#] testcmdtoken name $x } {{#} ::#} test basic-21.1 {Tcl_GetCommandName} {emptyTest} { } {} test basic-22.1 {Tcl_GetCommandFullName} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic1 { namespace export cmd* proc cmd1 {} {} proc cmd2 {} {} } namespace eval test_ns_basic2 { namespace export * namespace import ::test_ns_basic1::* proc p {} {} } namespace eval test_ns_basic3 { namespace import ::test_ns_basic2::* proc q {} {} list [namespace which -command foreach] \ [namespace which -command q] \ [namespace which -command p] \ [namespace which -command cmd1] \ [namespace which -command ::test_ns_basic2::cmd2] } } {::foreach ::test_ns_basic3::q ::test_ns_basic3::p ::test_ns_basic3::cmd1 ::test_ns_basic2::cmd2} test basic-23.1 {Tcl_DeleteCommand} {emptyTest} { } {} test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} { catch {interp delete test_interp} unset -nocomplain x interp create test_interp interp eval test_interp { proc useSet {} { return [set a 123] } } set x [interp eval test_interp {useSet}] interp eval test_interp { rename set "" proc set {args} { return "set called with $args" } } list $x \ [interp eval test_interp {useSet}] \ [interp delete test_interp] } {123 {set called with a 123} {}} test basic-24.2 {Tcl_DeleteCommandFromToken, deleting commands changes command epoch} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} proc p {} { return "global p" } namespace eval test_ns_basic { proc p {} { return "namespace p" } proc callP {} { p } } list [test_ns_basic::callP] \ [rename test_ns_basic::p ""] \ [test_ns_basic::callP] } {{namespace p} {} {global p}} test basic-24.3 {Tcl_DeleteCommandFromToken, delete imported cmds that refer to a deleted cmd} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} namespace eval test_ns_basic { namespace export p proc p {} {return 42} } namespace eval test_ns_basic2 { namespace import ::test_ns_basic::* proc callP {} { p } } list [test_ns_basic2::callP] \ [info commands test_ns_basic2::*] \ [rename test_ns_basic::p ""] \ [catch {test_ns_basic2::callP} msg] $msg \ [info commands test_ns_basic2::*] } {42 {::test_ns_basic2::callP ::test_ns_basic2::p} {} 1 {invalid command name "p"} ::test_ns_basic2::callP} test basic-25.1 {TclCleanupCommand} {emptyTest} { } {} test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup { proc myHandler {msg options} { set ::x [dict get $options -errorinfo] } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] set fName [makeFile {} test1] } -body { # If object isn't preserved, errorInfo would be set to # "foo\n while executing\n\"garbage bytes\"" because the object's # string would have been freed, leaving garbage bytes for the error # message. set f [open $fName w] chan event $f writable "chan event $f writable {}; error foo" set x {} vwait x close $f set x } -cleanup { removeFile test1 interp bgerror {} $handler rename myHandler {} } -result "foo\n while executing\n\"error foo\"" test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body { # # Follow the pure-list branch in a manner that # a - the pure-list internal rep is destroyed by shimmering # b - the command returns an error # As the error code in Tcl_EvalObjv accesses the list elements, this will # cause a segfault if [Bug 1119369] has not been fixed. # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault. # set SRC [list foo 1] ;# pure-list command proc foo str { # Shimmer pure-list to cmdName, cleanup and error proc $::SRC {} {}; $::SRC error "BAD CALL" } catch {eval $SRC} } -result 1 -cleanup { rename foo {} rename $::SRC {} unset ::SRC } test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body { # # Follow the pure-list branch in a manner that # a - the pure-list internal rep is destroyed by shimmering # b - the command accesses its command line # This will cause a segfault if [Bug 1119369] has not been fixed. # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault. # set SRC [list foo 1] ;# pure-list command proc foo str { # Shimmer pure-list to cmdName, cleanup and error proc $::SRC {} {}; $::SRC info level 0 } catch {eval $SRC} } -result 0 -cleanup { rename foo {} rename $::SRC {} unset ::SRC } test basic-27.1 {Tcl_ExprLong} {emptyTest} { } {} test basic-28.1 {Tcl_ExprDouble} {emptyTest} { } {} test basic-29.1 {Tcl_ExprBoolean} {emptyTest} { } {} test basic-30.1 {Tcl_ExprLongObj} {emptyTest} { } {} test basic-31.1 {Tcl_ExprDoubleObj} {emptyTest} { } {} test basic-32.1 {Tcl_ExprBooleanObj} {emptyTest} { } {} test basic-36.1 {Tcl_EvalObjv, lookup of "unknown" command} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {interp delete test_interp} interp create test_interp interp eval test_interp { proc unknown {args} { return "global unknown" } namespace eval test_ns_basic { proc unknown {args} { return "namespace unknown" } } } list [interp alias test_interp newAlias test_interp doesntExist] \ [catch {interp eval test_interp {newAlias}} msg] $msg \ [interp delete test_interp] } {newAlias 0 {global unknown} {}} test basic-37.1 {Tcl_ExprString: see expr.test} {emptyTest} { } {} test basic-38.1 {Tcl_ExprObj} {emptyTest} { } {} # Tests basic-39.* and basic-40.* refactored into trace.test test basic-41.1 {Tcl_AddErrorInfo} {emptyTest} { } {} test basic-42.1 {Tcl_AddObjErrorInfo} {emptyTest} { } {} test basic-43.1 {Tcl_VarEval} {emptyTest} { } {} test basic-44.1 {Tcl_GlobalEval} {emptyTest} { } {} test basic-45.1 {Tcl_SetRecursionLimit: see interp.test} {emptyTest} { } {} test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} { catch {close $f} set res [catch { set f [open |[list [interpreter]] w+] chan configure $f -buffering line puts $f {chan configure stdout -buffering line} puts $f continue puts $f {puts $::errorInfo} puts $f {puts DONE} set newMsg {} set msg {} while {$newMsg != "DONE"} { set newMsg [gets $f] append msg "${newMsg}\n" } close $f } error] list $res $msg } {1 {invoked "continue" outside of a loop while executing "continue" DONE }} test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} -setup { set fName [makeFile { puts hello break } BREAKtest] } -constraints { exec } -body { exec [interpreter] $fName } -cleanup { removeFile BREAKtest } -returnCodes error -match glob -result {hello invoked "break" outside of a loop while executing "break" (file "*BREAKtest" line 3)} test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup { set fName [makeFile { interp alias {} patch {} info patchlevel patch break } BREAKtest] } -constraints { exec } -body { exec [interpreter] $fName } -cleanup { removeFile BREAKtest } -returnCodes error -match glob -result {invoked "break" outside of a loop while executing "break" (file "*BREAKtest" line 4)} test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup { set fName [makeFile { foo [set a 1] [break] } BREAKtest] } -constraints { exec } -body { exec [interpreter] $fName } -cleanup { removeFile BREAKtest } -returnCodes error -match glob -result {invoked "break" outside of a loop while executing* "foo \[set a 1] \[break]" (file "*BREAKtest" line 2)} test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} -setup { set fName [makeFile { return -code return } BREAKtest] } -constraints { exec } -body { exec [interpreter] $fName } -cleanup { removeFile BREAKtest } -returnCodes error -match glob -result {command returned bad code: 2 while executing "return -code return" (file "*BREAKtest" line 2)} test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -constraints { testevalex } -body { testevalex {a[set b [format cd]} } -returnCodes error -result {missing close-bracket} # Some lists for expansion tests to work with set l1 [list a {b b} c d] set l2 [list e f {g g} h] proc l3 {} { list i j k {l l} } # Do all tests once byte compiled and once with direct string evaluation for {set noComp 0} {$noComp <= 1} {incr noComp} { if {$noComp} { interp alias {} run {} testevalex set constraints testevalex } else { interp alias {} run {} if 1 set constraints {} } test basic-47.2.$noComp {Tcl_EvalEx: error during word expansion} -body { run {{*}\{} } -constraints $constraints -returnCodes error -result {unmatched open brace in list} test basic-47.3.$noComp {Tcl_EvalEx, error during substitution} -body { run {{*}[error foo]} } -constraints $constraints -returnCodes error -result foo test basic-47.4.$noComp {Tcl_EvalEx: no expansion} $constraints { run {list {*} {*} {*}} } {* * *} test basic-47.5.$noComp {Tcl_EvalEx: expansion} $constraints { run {list {*}{} {*} {*}x {*}"y z"} } {* x y z} test basic-47.6.$noComp {Tcl_EvalEx: expansion to zero args} $constraints { run {list {*}{}} } {} test basic-47.7.$noComp {Tcl_EvalEx: expansion to one arg} $constraints { run {list {*}x} } x test basic-47.8.$noComp {Tcl_EvalEx: expansion to many args} $constraints { run {list {*}"y z"} } {y z} test basic-47.9.$noComp {Tcl_EvalEx: expansion and subst order} $constraints { set x 0 run {list [incr x] {*}[incr x] [incr x] \ {*}[list [incr x] [incr x]] [incr x]} } {1 2 3 4 5 6} test basic-47.10.$noComp {Tcl_EvalEx: expand and memory management} $constraints { run {concat {*}{} a b c d e f g h i j k l m n o p q r} } {a b c d e f g h i j k l m n o p q r} test basic-47.11.$noComp {Tcl_EvalEx: expand and memory management} $constraints { run {concat {*}1 a b c d e f g h i j k l m n o p q r} } {1 a b c d e f g h i j k l m n o p q r} test basic-47.12.$noComp {Tcl_EvalEx: expand and memory management} $constraints { run {concat {*}{1 2} a b c d e f g h i j k l m n o p q r} } {1 2 a b c d e f g h i j k l m n o p q r} test basic-47.13.$noComp {Tcl_EvalEx: expand and memory management} $constraints { run {concat {*}{} {*}{1 2} a b c d e f g h i j k l m n o p q} } {1 2 a b c d e f g h i j k l m n o p q} test basic-47.14.$noComp {Tcl_EvalEx: expand and memory management} $constraints { run {concat {*}{} a b c d e f g h i j k l m n o p q r s} } {a b c d e f g h i j k l m n o p q r s} test basic-47.15.$noComp {Tcl_EvalEx: expand and memory management} $constraints { run {concat {*}1 a b c d e f g h i j k l m n o p q r s} } {1 a b c d e f g h i j k l m n o p q r s} test basic-47.16.$noComp {Tcl_EvalEx: expand and memory management} $constraints { run {concat {*}{1 2} a b c d e f g h i j k l m n o p q r s} } {1 2 a b c d e f g h i j k l m n o p q r s} test basic-47.17.$noComp {Tcl_EvalEx: expand and memory management} $constraints { run {concat {*}{} {*}{1 2} a b c d e f g h i j k l m n o p q r} } {1 2 a b c d e f g h i j k l m n o p q r} test basic-48.1.$noComp {expansion: parsing} $constraints { run { # A comment # Another comment list 1 2\ 3 {*}$::l1 # Comment again } } {1 2 3 a {b b} c d} test basic-48.2.$noComp {no expansion} $constraints { run {list $::l1 $::l2 [l3]} } {{a {b b} c d} {e f {g g} h} {i j k {l l}}} test basic-48.3.$noComp {expansion} $constraints { run {list {*}$::l1 $::l2 {*}[l3]} } {a {b b} c d {e f {g g} h} i j k {l l}} test basic-48.4.$noComp {expansion: really long cmd} $constraints { set cmd [list list] for {set t 0} {$t < 500} {incr t} { lappend cmd {{*}$::l1} } llength [run [join $cmd]] } 2000 test basic-48.5.$noComp {expansion: error detection} -setup { set l "a {a b}x y" } -constraints $constraints -body { run {list $::l1 {*}$l} } -cleanup { unset l } -returnCodes 1 -result {list element in braces followed by "x" instead of space} test basic-48.6.$noComp {expansion: odd usage} $constraints { run {list {*}$::l1$::l2} } {a {b b} c de f {g g} h} test basic-48.7.$noComp {expansion: odd usage} -constraints $constraints -body { run {list {*}[l3]$::l1} } -returnCodes 1 -result {list element in braces followed by "a" instead of space} test basic-48.8.$noComp {expansion: odd usage} $constraints { run {list {*}hej$::l1} } {heja {b b} c d} test basic-48.9.$noComp {expansion: Not all {*} should trigger} $constraints { run {list {*}$::l1 \{*\}$::l2 "{*}$::l1" {{*} i j k}} } {a {b b} c d {{*}e f {g g} h} {{*}a {b b} c d} {{*} i j k}} test basic-48.10.$noComp {expansion: expansion of command word} -setup { set cmd [list string range jultomte] } -constraints $constraints -body { run {{*}$cmd 2 6} } -cleanup { unset cmd } -result ltomt test basic-48.11.$noComp {expansion: expansion into nothing} -setup { set cmd {} set bar {} } -constraints $constraints -body { run {{*}$cmd {*}$bar} } -cleanup { unset cmd bar } -result {} test basic-48.12.$noComp {expansion: odd usage} $constraints { run {list {*}$::l1 {*}"hej hopp" {*}$::l2} } {a {b b} c d hej hopp e f {g g} h} test basic-48.13.$noComp {expansion: odd usage} $constraints { run {list {*}$::l1 {*}{hej hopp} {*}$::l2} } {a {b b} c d hej hopp e f {g g} h} test basic-48.14.$noComp {expansion: hash command} -setup { catch {rename \# ""} set cmd "#" } -constraints $constraints -body { run { {*}$cmd apa bepa } } -cleanup { unset cmd } -returnCodes 1 -result {invalid command name "#"} test basic-48.15.$noComp {expansion: complex words} -setup { set a(x) [list a {b c} d e] set b x set c [list {f\ g h\ i j k} x y] set d {0\ 1 2 3} } -constraints $constraints -body { run { lappend d {*}$a($b) {*}[lindex $c 0] } } -cleanup { unset a b c d } -result {{0 1} 2 3 a {b c} d e {f g} {h i} j k} testConstraint memory [llength [info commands memory]] test basic-48.16.$noComp {expansion: testing for leaks} -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex [lindex $lines 3] 3 } # This test is made to stress the allocation, reallocation and # object reference management in Tcl_EvalEx. proc stress {} { set a x # Create free objects that should disappear set l [list 1$a 2$a 3$a 4$a 5$a 6$a 7$a] # A short number of words and a short result (8) set l [run {list {*}$l $a$a}] # A short number of words and a longer result (27) set l [run {list {*}$l $a$a {*}$l $a$a {*}$l $a$a}] # A short number of words and a longer result, with an error # This is to stress the cleanup in the error case if {![catch {run {_moo_ {*}$l $a$a {*}$l $a$a {*}$l}}]} { error "An error was expected in the previous statement" } # Many words set l [run {list {*}$l $a$a {*}$l $a$a \ {*}$l $a$a {*}$l $a$a \ {*}$l $a$a {*}$l $a$a \ {*}$l $a$a {*}$l $a$a \ {*}$l $a$a {*}$l $a$a \ {*}$l $a$a {*}$l $a$a \ {*}$l $a$a {*}$l $a$a \ {*}$l $a$a {*}$l $a$a \ {*}$l $a$a {*}$l $a$a \ {*}$l $a$a}] if {[llength $l] != 19*28} { error "Bad Length: [llength $l] should be [expr {19*28}]" } } } -constraints [linsert $constraints 0 memory] -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { stress set tmp $end set end [getbytes] } set leak [expr {$end - $tmp}] } -cleanup { unset end i tmp rename getbytes {} rename stress {} } -result 0 test basic-48.17.$noComp {expansion: object safety} -setup { set old_precision $::tcl_precision set ::tcl_precision 4 } -constraints $constraints -body { set third [expr {1.0/3.0}] set l [list $third $third] set x [run {list $third {*}$l $third}] set res [list] foreach t $x { lappend res [expr {$t * 3.0}] } set res } -cleanup { set ::tcl_precision $old_precision unset old_precision res t l x third } -result {1.0 1.0 1.0 1.0} test basic-48.18.$noComp {expansion: list semantics} -constraints $constraints -body { set badcmd { list a b set apa 10 } set apa 0 list [llength [run { {*}$badcmd }]] $apa } -cleanup { unset apa badcmd } -result {5 0} test basic-48.19.$noComp {expansion: error checking order} -body { set badlist "a {}x y" set a 0 set b 0 catch {run {list [incr a] {*}$badlist [incr b]}} list $a $b } -constraints $constraints -cleanup { unset badlist a b } -result {1 0} test basic-48.20.$noComp {expansion: odd case with word boundaries} $constraints { run {list {*}$::l1 {*}"hej hopp" {*}$::l2} } {a {b b} c d hej hopp e f {g g} h} test basic-48.21.$noComp {expansion: odd case with word boundaries} $constraints { run {list {*}$::l1 {*}{hej hopp} {*}$::l2} } {a {b b} c d hej hopp e f {g g} h} test basic-48.22.$noComp {expansion: odd case with word boundaries} -body { run {list {*}$::l1 {*}"hej hopp {*}$::l2} } -constraints $constraints -returnCodes error -result {missing "} test basic-48.23.$noComp {expansion: handle return codes} -constraints $constraints -body { set res {} for {set t 0} {$t < 10} {incr t} { run { {*}break } } lappend res $t for {set t 0} {$t < 10} {incr t} { run { {*}continue } set t 20 } lappend res $t lappend res [catch { run { {*}{error Hejsan} } } err] lappend res $err } -cleanup { unset res t } -result {0 10 1 Hejsan} test basic-48.24.$noComp {expansion: empty not canonical list, regression test, bug [cc1e91552c]} -constraints $constraints -setup { unset -nocomplain a } -body { run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]} } -result [lrepeat 3 {}] -cleanup {unset -nocomplain a} test basic-48.25.$noComp {Bug cc191552c: expansion: empty non-canonical list} -constraints $constraints -setup { unset -nocomplain ::CRLF set ::CRLF "\r\n" } -body { # Force variant that turned up in Bug 2c154a40be as that's externally # noticeable in an important downstream project. run {scan [list {*}$::CRLF]x %c%c%c} } -cleanup { unset -nocomplain ::CRLF } -result {120 {} {}} } ;# End of noComp loop test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::x global namespace eval ns { variable x namespace testevalex {set x changed} global set ::result [list $::x $x] } namespace delete ns set ::result } {changed namespace} test basic-49.2 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::x global namespace eval ns { variable x namespace testevalex {set ::context $x} global } namespace delete ns set ::context } {global} test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup { interp create child interp alias {} foo child return } -body { list [catch foo m] $m } -cleanup { unset -nocomplain m interp delete child } -result {0 {}} # Clean up after expand tests unset noComp l1 l2 constraints rename l3 {} rename run {} #cleanup catch {namespace delete {*}[namespace children :: test_ns_*]} catch {namespace delete george} catch {interp delete test_interp} catch {rename p ""} catch {rename q ""} catch {rename cmd ""} catch {rename value:at: ""} unset -nocomplain x cleanupTests return tcl8.6.14/tests/binary.test0000644000175000017500000032055114554262142015177 0ustar sergeisergei# This file tests the tclBinary.c file and the "binary" Tcl command. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch {package require -exact Tcltest [info patchlevel]} testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}] testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}] # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues binary scan [binary format dd -1.0 1.0] c* c switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ ieeeValues(-Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ ieeeValues(+Normal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ ieeeValues(+Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 } default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] # ---------------------------------------------------------------------- test binary-0.1 {DupByteArrayInternalRep} { set hdr [binary format cc 0 0316] set buf hellomatt set data $hdr append data $buf string length $data } 11 test binary-1.1 {Tcl_BinaryObjCmd: bad args} -body { binary } -returnCodes error -match glob -result {wrong # args: *} test binary-1.2 {Tcl_BinaryObjCmd: bad args} -returnCodes error -body { binary foo } -match glob -result {unknown or ambiguous subcommand "foo": *} test binary-1.3 {Tcl_BinaryObjCmd: format error} -returnCodes error -body { binary f } -result {wrong # args: should be "binary format formatString ?arg ...?"} test binary-1.4 {Tcl_BinaryObjCmd: format} -body { binary format "" } -result {} test binary-2.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format a } -result {not enough arguments for all format specifiers} test binary-2.2 {Tcl_BinaryObjCmd: format} { binary format a0 foo } {} test binary-2.3 {Tcl_BinaryObjCmd: format} { binary format a f } {f} test binary-2.4 {Tcl_BinaryObjCmd: format} { binary format a foo } {f} test binary-2.5 {Tcl_BinaryObjCmd: format} { binary format a3 foo } {foo} test binary-2.6 {Tcl_BinaryObjCmd: format} { binary format a5 foo } foo\x00\x00 test binary-2.7 {Tcl_BinaryObjCmd: format} { binary format a*a3 foobarbaz blat } foobarbazbla test binary-2.8 {Tcl_BinaryObjCmd: format} { binary format a*X3a2 foobar x } foox\x00r test binary-3.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format A } -result {not enough arguments for all format specifiers} test binary-3.2 {Tcl_BinaryObjCmd: format} { binary format A0 f } {} test binary-3.3 {Tcl_BinaryObjCmd: format} { binary format A f } {f} test binary-3.4 {Tcl_BinaryObjCmd: format} { binary format A foo } {f} test binary-3.5 {Tcl_BinaryObjCmd: format} { binary format A3 foo } {foo} test binary-3.6 {Tcl_BinaryObjCmd: format} { binary format A5 foo } {foo } test binary-3.7 {Tcl_BinaryObjCmd: format} { binary format A*A3 foobarbaz blat } foobarbazbla test binary-3.8 {Tcl_BinaryObjCmd: format} { binary format A*X3A2 foobar x } {foox r} test binary-4.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format B } -result {not enough arguments for all format specifiers} test binary-4.2 {Tcl_BinaryObjCmd: format} { binary format B0 1 } {} test binary-4.3 {Tcl_BinaryObjCmd: format} { binary format B 1 } \x80 test binary-4.4 {Tcl_BinaryObjCmd: format} { binary format B* 010011 } \x4c test binary-4.5 {Tcl_BinaryObjCmd: format} { binary format B8 01001101 } \x4d test binary-4.6 {Tcl_BinaryObjCmd: format} { binary format A2X2B9 oo 01001101 } \x4d\x00 test binary-4.7 {Tcl_BinaryObjCmd: format} { binary format B9 010011011010 } \x4d\x80 test binary-4.8 {Tcl_BinaryObjCmd: format} { binary format B2B3 10 010 } \x80\x40 test binary-4.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format B1B5 1 foo } -result {expected binary string but got "foo" instead} test binary-5.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format b } -result {not enough arguments for all format specifiers} test binary-5.2 {Tcl_BinaryObjCmd: format} { binary format b0 1 } {} test binary-5.3 {Tcl_BinaryObjCmd: format} { binary format b 1 } \x01 test binary-5.4 {Tcl_BinaryObjCmd: format} { binary format b* 010011 } 2 test binary-5.5 {Tcl_BinaryObjCmd: format} { binary format b8 01001101 } \xb2 test binary-5.6 {Tcl_BinaryObjCmd: format} { binary format A2X2b9 oo 01001101 } \xb2\x00 test binary-5.7 {Tcl_BinaryObjCmd: format} { binary format b9 010011011010 } \xb2\x01 test binary-5.8 {Tcl_BinaryObjCmd: format} { binary format b17 1 } \x01\00\00 test binary-5.9 {Tcl_BinaryObjCmd: format} { binary format b2b3 10 010 } \x01\x02 test binary-5.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format b1b5 1 foo } -result {expected binary string but got "foo" instead} test binary-6.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format h } -result {not enough arguments for all format specifiers} test binary-6.2 {Tcl_BinaryObjCmd: format} { binary format h0 1 } {} test binary-6.3 {Tcl_BinaryObjCmd: format} { binary format h 1 } \x01 test binary-6.4 {Tcl_BinaryObjCmd: format} { binary format h c } \x0c test binary-6.5 {Tcl_BinaryObjCmd: format} { binary format h* baadf00d } \xab\xda\x0f\xd0 test binary-6.6 {Tcl_BinaryObjCmd: format} { binary format h4 c410 } \x4c\x01 test binary-6.7 {Tcl_BinaryObjCmd: format} { binary format h6 c4102 } \x4c\x01\x02 test binary-6.8 {Tcl_BinaryObjCmd: format} { binary format h5 c41020304 } \x4c\x01\x02 test binary-6.9 {Tcl_BinaryObjCmd: format} { binary format a3X3h5 foo 2 } \x02\x00\x00 test binary-6.10 {Tcl_BinaryObjCmd: format} { binary format h2h3 23 456 } \x32\x54\x06 test binary-6.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format h2 foo } -result {expected hexadecimal string but got "foo" instead} test binary-7.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format H } -result {not enough arguments for all format specifiers} test binary-7.2 {Tcl_BinaryObjCmd: format} { binary format H0 1 } {} test binary-7.3 {Tcl_BinaryObjCmd: format} { binary format H 1 } \x10 test binary-7.4 {Tcl_BinaryObjCmd: format} { binary format H c } \xc0 test binary-7.5 {Tcl_BinaryObjCmd: format} { binary format H* baadf00d } \xba\xad\xf0\x0d test binary-7.6 {Tcl_BinaryObjCmd: format} { binary format H4 c410 } \xc4\x10 test binary-7.7 {Tcl_BinaryObjCmd: format} { binary format H6 c4102 } \xc4\x10\x20 test binary-7.8 {Tcl_BinaryObjCmd: format} { binary format H5 c41023304 } \xc4\x10\x20 test binary-7.9 {Tcl_BinaryObjCmd: format} { binary format a3X3H5 foo 2 } \x20\x00\x00 test binary-7.10 {Tcl_BinaryObjCmd: format} { binary format H2H3 23 456 } \x23\x45\x60 test binary-7.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format H2 foo } -result {expected hexadecimal string but got "foo" instead} test binary-8.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format c } -result {not enough arguments for all format specifiers} test binary-8.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format c blat } -result {expected integer but got "blat"} test binary-8.3 {Tcl_BinaryObjCmd: format} { binary format c0 0x50 } {} test binary-8.4 {Tcl_BinaryObjCmd: format} { binary format c 0x50 } P test binary-8.5 {Tcl_BinaryObjCmd: format} { binary format c 0x5052 } R test binary-8.6 {Tcl_BinaryObjCmd: format} { binary format c2 {0x50 0x52} } PR test binary-8.7 {Tcl_BinaryObjCmd: format} { binary format c2 {0x50 0x52 0x53} } PR test binary-8.8 {Tcl_BinaryObjCmd: format} { binary format c* {0x50 0x52} } PR test binary-8.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format c2 {0x50} } -result {number of elements in list does not match count} test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format c $a } -result "expected integer but got \"0x50 0x51\"" test binary-8.11 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format c1 $a } P test binary-9.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format s } -result {not enough arguments for all format specifiers} test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format s blat } -result {expected integer but got "blat"} test binary-9.3 {Tcl_BinaryObjCmd: format} { binary format s0 0x50 } {} test binary-9.4 {Tcl_BinaryObjCmd: format} { binary format s 0x50 } P\x00 test binary-9.5 {Tcl_BinaryObjCmd: format} { binary format s 0x5052 } RP test binary-9.6 {Tcl_BinaryObjCmd: format} { binary format s 0x505251 0x53 } QR test binary-9.7 {Tcl_BinaryObjCmd: format} { binary format s2 {0x50 0x52} } P\x00R\x00 test binary-9.8 {Tcl_BinaryObjCmd: format} { binary format s* {0x5051 0x52} } QPR\x00 test binary-9.9 {Tcl_BinaryObjCmd: format} { binary format s2 {0x50 0x52 0x53} 0x54 } P\x00R\x00 test binary-9.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format s2 {0x50} } -result {number of elements in list does not match count} test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format s $a } -result "expected integer but got \"0x50 0x51\"" test binary-9.12 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format s1 $a } P\x00 test binary-10.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format S } -result {not enough arguments for all format specifiers} test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format S blat } -result {expected integer but got "blat"} test binary-10.3 {Tcl_BinaryObjCmd: format} { binary format S0 0x50 } {} test binary-10.4 {Tcl_BinaryObjCmd: format} { binary format S 0x50 } \x00P test binary-10.5 {Tcl_BinaryObjCmd: format} { binary format S 0x5052 } PR test binary-10.6 {Tcl_BinaryObjCmd: format} { binary format S 0x505251 0x53 } RQ test binary-10.7 {Tcl_BinaryObjCmd: format} { binary format S2 {0x50 0x52} } \x00P\x00R test binary-10.8 {Tcl_BinaryObjCmd: format} { binary format S* {0x5051 0x52} } PQ\x00R test binary-10.9 {Tcl_BinaryObjCmd: format} { binary format S2 {0x50 0x52 0x53} 0x54 } \x00P\x00R test binary-10.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format S2 {0x50} } -result {number of elements in list does not match count} test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format S $a } -result "expected integer but got \"0x50 0x51\"" test binary-10.12 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format S1 $a } \x00P test binary-11.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format i } -result {not enough arguments for all format specifiers} test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format i blat } -result {expected integer but got "blat"} test binary-11.3 {Tcl_BinaryObjCmd: format} { binary format i0 0x50 } {} test binary-11.4 {Tcl_BinaryObjCmd: format} { binary format i 0x50 } P\x00\x00\x00 test binary-11.5 {Tcl_BinaryObjCmd: format} { binary format i 0x5052 } RP\x00\x00 test binary-11.6 {Tcl_BinaryObjCmd: format} { binary format i 0x505251 0x53 } QRP\x00 test binary-11.7 {Tcl_BinaryObjCmd: format} { binary format i1 {0x505251 0x53} } QRP\x00 test binary-11.8 {Tcl_BinaryObjCmd: format} { binary format i 0x53525150 } PQRS test binary-11.9 {Tcl_BinaryObjCmd: format} { binary format i2 {0x50 0x52} } P\x00\x00\x00R\x00\x00\x00 test binary-11.10 {Tcl_BinaryObjCmd: format} { binary format i* {0x50515253 0x52} } SRQPR\x00\x00\x00 test binary-11.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format i2 {0x50} } -result {number of elements in list does not match count} test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format i $a } -result "expected integer but got \"0x50 0x51\"" test binary-11.13 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format i1 $a } P\x00\x00\x00 test binary-12.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format I } -result {not enough arguments for all format specifiers} test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format I blat } -result {expected integer but got "blat"} test binary-12.3 {Tcl_BinaryObjCmd: format} { binary format I0 0x50 } {} test binary-12.4 {Tcl_BinaryObjCmd: format} { binary format I 0x50 } \x00\x00\x00P test binary-12.5 {Tcl_BinaryObjCmd: format} { binary format I 0x5052 } \x00\x00PR test binary-12.6 {Tcl_BinaryObjCmd: format} { binary format I 0x505251 0x53 } \x00PRQ test binary-12.7 {Tcl_BinaryObjCmd: format} { binary format I1 {0x505251 0x53} } \x00PRQ test binary-12.8 {Tcl_BinaryObjCmd: format} { binary format I 0x53525150 } SRQP test binary-12.9 {Tcl_BinaryObjCmd: format} { binary format I2 {0x50 0x52} } \x00\x00\x00P\x00\x00\x00R test binary-12.10 {Tcl_BinaryObjCmd: format} { binary format I* {0x50515253 0x52} } PQRS\x00\x00\x00R test binary-12.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format i2 {0x50} } -result {number of elements in list does not match count} test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format I $a } -result "expected integer but got \"0x50 0x51\"" test binary-12.13 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format I1 $a } \x00\x00\x00P test binary-13.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format f } -result {not enough arguments for all format specifiers} test binary-13.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format f blat } -result {expected floating-point number but got "blat"} test binary-13.3 {Tcl_BinaryObjCmd: format} { binary format f0 1.6 } {} test binary-13.4 {Tcl_BinaryObjCmd: format} bigEndian { binary format f 1.6 } \x3f\xcc\xcc\xcd test binary-13.5 {Tcl_BinaryObjCmd: format} littleEndian { binary format f 1.6 } \xcd\xcc\xcc\x3f test binary-13.6 {Tcl_BinaryObjCmd: format} bigEndian { binary format f* {1.6 3.4} } \x3f\xcc\xcc\xcd\x40\x59\x99\x9a test binary-13.7 {Tcl_BinaryObjCmd: format} littleEndian { binary format f* {1.6 3.4} } \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 test binary-13.8 {Tcl_BinaryObjCmd: format} bigEndian { binary format f2 {1.6 3.4} } \x3f\xcc\xcc\xcd\x40\x59\x99\x9a test binary-13.9 {Tcl_BinaryObjCmd: format} littleEndian { binary format f2 {1.6 3.4} } \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 test binary-13.10 {Tcl_BinaryObjCmd: format} bigEndian { binary format f2 {1.6 3.4 5.6} } \x3f\xcc\xcc\xcd\x40\x59\x99\x9a test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian { binary format f2 {1.6 3.4 5.6} } \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian { binary format f -3.402825e+38 } \xff\x7f\xff\xff test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian { binary format f -3.402825e+38 } \xff\xff\x7f\xff test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian { binary format f -3.402825e-100 } \x80\x00\x00\x00 test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian { binary format f -3.402825e-100 } \x00\x00\x00\x80 test binary-13.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format f2 {1.6} } -result {number of elements in list does not match count} test binary-13.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {1.6 3.4} binary format f $a } -result "expected floating-point number but got \"1.6 3.4\"" test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian { set a {1.6 3.4} binary format f1 $a } \x3f\xcc\xcc\xcd test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian { set a {1.6 3.4} binary format f1 $a } \xcd\xcc\xcc\x3f test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format d } -result {not enough arguments for all format specifiers} test binary-14.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format d blat } -result {expected floating-point number but got "blat"} test binary-14.3 {Tcl_BinaryObjCmd: format} { binary format d0 1.6 } {} test binary-14.4 {Tcl_BinaryObjCmd: format} bigEndian { binary format d 1.6 } \x3f\xf9\x99\x99\x99\x99\x99\x9a test binary-14.5 {Tcl_BinaryObjCmd: format} littleEndian { binary format d 1.6 } \x9a\x99\x99\x99\x99\x99\xf9\x3f test binary-14.6 {Tcl_BinaryObjCmd: format} bigEndian { binary format d* {1.6 3.4} } \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 test binary-14.7 {Tcl_BinaryObjCmd: format} littleEndian { binary format d* {1.6 3.4} } \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 test binary-14.8 {Tcl_BinaryObjCmd: format} bigEndian { binary format d2 {1.6 3.4} } \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 test binary-14.9 {Tcl_BinaryObjCmd: format} littleEndian { binary format d2 {1.6 3.4} } \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian { binary format d2 {1.6 3.4 5.6} } \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian { binary format d2 {1.6 3.4 5.6} } \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 test binary-14.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format d2 {1.6} } -result {number of elements in list does not match count} test binary-14.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {1.6 3.4} binary format d $a } -result "expected floating-point number but got \"1.6 3.4\"" test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian { set a {1.6 3.4} binary format d1 $a } \x3f\xf9\x99\x99\x99\x99\x99\x9a test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian { set a {1.6 3.4} binary format d1 $a } \x9a\x99\x99\x99\x99\x99\xf9\x3f test binary-14.18 {FormatNumber: Bug 1116542} { binary scan [binary format d 1.25] d w set w } 1.25 test binary-15.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format ax*a "y" "z" } -result {cannot use "*" in format string with "x"} test binary-15.2 {Tcl_BinaryObjCmd: format} { binary format axa "y" "z" } y\x00z test binary-15.3 {Tcl_BinaryObjCmd: format} { binary format ax3a "y" "z" } y\x00\x00\x00z test binary-15.4 {Tcl_BinaryObjCmd: format} { binary format a*X3x3a* "foo" "z" } \x00\x00\x00z test binary-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} { binary format x0s 1 } \x01\x00 test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} { binary format x0ss 1 1 } \x01\x00\x01\x00 test binary-15.7 {Tcl_BinaryObjCmd: format - bug #1923966} { binary format x1s 1 } \x00\x01\x00 test binary-15.8 {Tcl_BinaryObjCmd: format - bug #1923966} { binary format x1ss 1 1 } \x00\x01\x00\x01\x00 test binary-16.1 {Tcl_BinaryObjCmd: format} { binary format a*X*a "foo" "z" } zoo test binary-16.2 {Tcl_BinaryObjCmd: format} { binary format aX3a "y" "z" } z test binary-16.3 {Tcl_BinaryObjCmd: format} { binary format a*Xa* "foo" "zy" } fozy test binary-16.4 {Tcl_BinaryObjCmd: format} { binary format a*X3a "foobar" "z" } foozar test binary-16.5 {Tcl_BinaryObjCmd: format} { binary format a*X3aX2a "foobar" "z" "b" } fobzar test binary-17.1 {Tcl_BinaryObjCmd: format} { binary format @1 } \x00 test binary-17.2 {Tcl_BinaryObjCmd: format} { binary format @5a2 "ab" } \x00\x00\x00\x00\x00\x61\x62 test binary-17.3 {Tcl_BinaryObjCmd: format} { binary format {a* @0 a2 @* a*} "foobar" "ab" "blat" } abobarblat test binary-18.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format u0a3 abc abd } -result {bad field specifier "u"} test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body { binary s } -result {wrong # args: should be "binary scan value formatString ?varName ...?"} test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body { binary scan foo } -result {wrong # args: should be "binary scan value formatString ?varName ...?"} test binary-19.3 {Tcl_BinaryObjCmd: scan} { binary scan {} {} } 0 test binary-20.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc a } -result {not enough arguments for all format specifiers} test binary-20.2 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan abc a arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-20.3 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { set arg1 abc list [binary scan abc a0 arg1] $arg1 } -result {1 {}} test binary-20.4 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc a* arg1] $arg1 } -result {1 abc} test binary-20.5 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc a5 arg1] [info exists arg1] } -result {0 0} test binary-20.6 {Tcl_BinaryObjCmd: scan} { set arg1 foo list [binary scan abc a2 arg1] $arg1 } {1 ab} test binary-20.7 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 unset -nocomplain arg2 } -body { list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2 } -result {2 ab cd} test binary-20.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc a2 arg1(a)] $arg1(a) } -result {1 ab} test binary-20.9 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc a arg1(a)] $arg1(a) } -result {1 a} test binary-21.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc A } -result {not enough arguments for all format specifiers} test binary-21.2 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan abc A arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-21.3 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { set arg1 abc list [binary scan abc A0 arg1] $arg1 } -result {1 {}} test binary-21.4 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc A* arg1] $arg1 } -result {1 abc} test binary-21.5 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc A5 arg1] [info exists arg1] } -result {0 0} test binary-21.6 {Tcl_BinaryObjCmd: scan} { set arg1 foo list [binary scan abc A2 arg1] $arg1 } {1 ab} test binary-21.7 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 unset -nocomplain arg2 } -body { list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2 } -result {2 ab cd} test binary-21.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc A2 arg1(a)] $arg1(a) } -result {1 ab} test binary-21.9 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc A2 arg1(a)] $arg1(a) } -result {1 ab} test binary-21.10 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan abc A arg1(a)] $arg1(a) } -result {1 a} test binary-21.11 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan "abc def \x00 " A* arg1] $arg1 } -result {1 {abc def}} test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan "abc def \x00ghi " A* arg1] $arg1 } -result [list 1 "abc def \x00ghi"] test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc b } -result {not enough arguments for all format specifiers} test binary-22.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 b* arg1] $arg1 } {1 0100101011001010} test binary-22.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x82\x53 b arg1] $arg1 } {1 0} test binary-22.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x82\x53 b1 arg1] $arg1 } {1 0} test binary-22.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x82\x53 b0 arg1] $arg1 } {1 {}} test binary-22.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 b5 arg1] $arg1 } {1 01001} test binary-22.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 b8 arg1] $arg1 } {1 01001010} test binary-22.8 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 b14 arg1] $arg1 } {1 01001010110010} test binary-22.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 b14 arg1] $arg1 } {0 foo} test binary-22.10 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 b1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-22.11 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 arg2 } -body { set arg1 foo set arg2 bar list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2 } -result {2 11100 1110000110100000} test binary-23.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc B } -result {not enough arguments for all format specifiers} test binary-23.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 B* arg1] $arg1 } {1 0101001001010011} test binary-23.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x82\x53 B arg1] $arg1 } {1 1} test binary-23.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x82\x53 B1 arg1] $arg1 } {1 1} test binary-23.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 B0 arg1] $arg1 } {1 {}} test binary-23.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 B5 arg1] $arg1 } {1 01010} test binary-23.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 B8 arg1] $arg1 } {1 01010010} test binary-23.8 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 B14 arg1] $arg1 } {1 01010010010100} test binary-23.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 B14 arg1] $arg1 } {0 foo} test binary-23.10 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 B1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-23.11 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 arg2 } -body { set arg1 foo set arg2 bar list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2 } -result {2 01110 1000011100000101} test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc h } -result {not enough arguments for all format specifiers} test binary-24.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 h* arg1] $arg1 } {1 253a} test binary-24.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \xc2\xa3 h arg1] $arg1 } {1 2} test binary-24.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x82\x53 h1 arg1] $arg1 } {1 2} test binary-24.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 h0 arg1] $arg1 } {1 {}} test binary-24.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \xf2\x53 h2 arg1] $arg1 } {1 2f} test binary-24.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 h3 arg1] $arg1 } {1 253} test binary-24.8 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 h3 arg1] $arg1 } {0 foo} test binary-24.9 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 h1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-24.10 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 arg2 } -body { set arg1 foo set arg2 bar list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2 } -result {2 07 7850} test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc H } -result {not enough arguments for all format specifiers} test binary-25.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 H* arg1] $arg1 } {1 52a3} test binary-25.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \xc2\xa3 H arg1] $arg1 } {1 c} test binary-25.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x82\x53 H1 arg1] $arg1 } {1 8} test binary-25.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 H0 arg1] $arg1 } {1 {}} test binary-25.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \xf2\x53 H2 arg1] $arg1 } {1 f2} test binary-25.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 H3 arg1] $arg1 } {1 525} test binary-25.8 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 H3 arg1] $arg1 } {0 foo} test binary-25.9 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 H1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-25.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2 } {2 70 8705} test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc c } -result {not enough arguments for all format specifiers} test binary-26.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 c* arg1] $arg1 } {1 {82 -93}} test binary-26.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 c arg1] $arg1 } {1 82} test binary-26.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 c1 arg1] $arg1 } {1 82} test binary-26.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 c0 arg1] $arg1 } {1 {}} test binary-26.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 c2 arg1] $arg1 } {1 {82 -93}} test binary-26.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \xff c arg1] $arg1 } {1 -1} test binary-26.8 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 c3 arg1] $arg1 } {0 foo} test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 c1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-26.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2 } {2 {112 -121} 5} test binary-26.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 cu* arg1] $arg1 } {1 {82 163}} test binary-26.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 cu arg1] $arg1 } {1 82} test binary-26.13 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \xff cu arg1] $arg1 } {1 255} test binary-26.14 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2 } {2 128 -128} test binary-26.15 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2 } {2 -128 128} test binary-27.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc s } -result {not enough arguments for all format specifiers} test binary-27.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1 } {1 {-23726 21587}} test binary-27.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 s arg1] $arg1 } {1 -23726} test binary-27.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 s1 arg1] $arg1 } {1 -23726} test binary-27.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 s0 arg1] $arg1 } {1 {}} test binary-27.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1 } {1 {-23726 21587}} test binary-27.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 s1 arg1] $arg1 } {0 foo} test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 s1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-27.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2 } {2 {-23726 21587} 5} test binary-27.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1 } {1 {41810 21587}} test binary-27.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2 } {2 65535 -1} test binary-27.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2 } {2 -1 65535} test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc S } -result {not enough arguments for all format specifiers} test binary-28.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1 } {1 {21155 21332}} test binary-28.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 S arg1] $arg1 } {1 21155} test binary-28.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 S1 arg1] $arg1 } {1 21155} test binary-28.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3 S0 arg1] $arg1 } {1 {}} test binary-28.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1 } {1 {21155 21332}} test binary-28.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 S1 arg1] $arg1 } {0 foo} test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 S1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-28.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2 } {2 {21155 21332} 5} test binary-28.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1 } {1 {21155 21332}} test binary-28.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1 } {1 {41810 21587}} test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc i } -result {not enough arguments for all format specifiers} test binary-29.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1 } {1 {1414767442 67305985}} test binary-29.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1 } {1 1414767442} test binary-29.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1 } {1 1414767442} test binary-29.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53 i0 arg1] $arg1 } {1 {}} test binary-29.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1 } {1 {1414767442 67305985}} test binary-29.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 i1 arg1] $arg1 } {0 foo} test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53\x53\x54 i1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-29.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2 } {2 {1414767442 67305985} 5} test binary-29.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2 } {2 4294967295 -1} test binary-29.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2 } {2 -1 4294967295} test binary-29.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2 } {2 128 2147483648} test binary-30.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc I } -result {not enough arguments for all format specifiers} test binary-30.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1 } {1 {1386435412 16909060}} test binary-30.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1 } {1 1386435412} test binary-30.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1 } {1 1386435412} test binary-30.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53 I0 arg1] $arg1 } {1 {}} test binary-30.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1 } {1 {1386435412 16909060}} test binary-30.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 I1 arg1] $arg1 } {0 foo} test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53\x53\x54 I1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-30.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2 } {2 {1386435412 16909060} 5} test binary-30.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2 } {2 4294967295 -1} test binary-30.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2 } {2 -1 4294967295} test binary-30.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2 } {2 2147483648 128} test binary-31.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc f } -result {not enough arguments for all format specifiers} test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1 } {1 1.600000023841858} test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1 } {1 1.600000023841858} test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1 } {1 1.600000023841858} test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1 } {1 1.600000023841858} test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1 } {1 {}} test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1 } {1 {}} test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-31.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 f1 arg1] $arg1 } {0 foo} test binary-31.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x3f\xcc\xcc\xcd f1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} test binary-32.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc d } -result {not enough arguments for all format specifiers} test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1 } {1 {1.6 3.4}} test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1 } {1 {1.6 3.4}} test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1 } {1 1.6} test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1 } {1 1.6} test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1 } {1 1.6} test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1 } {1 1.6} test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1 } {1 {}} test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1 } {1 {}} test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1 } {1 {1.6 3.4}} test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1 } {1 {1.6 3.4}} test binary-32.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 d1 arg1] $arg1 } {0 foo} test binary-32.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2 } {2 {1.6 3.4} 5} test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2 } {2 {1.6 3.4} 5} test binary-33.1 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2 } {2 ab def} test binary-33.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 set arg2 foo list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2 } {1 abc foo} test binary-33.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 set arg2 foo list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2 } {1 abc foo} test binary-33.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 set arg2 foo list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2 } {1 abc foo} test binary-33.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef x1a1 arg1] $arg1 } {1 b} test binary-33.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef x5a1 arg1] $arg1 } {1 f} test binary-33.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef x0a1 arg1] $arg1 } {1 a} test binary-34.1 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2 } {2 ab bcd} test binary-34.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 set arg2 foo list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2 } {2 abc abc} test binary-34.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 set arg2 foo list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2 } {2 abc abc} test binary-34.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abc X20a3 arg1] $arg1 } {1 abc} test binary-34.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef x*X1a1 arg1] $arg1 } {1 f} test binary-34.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef x*X5a1 arg1] $arg1 } {1 b} test binary-34.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef x3X0a1 arg1] $arg1 } {1 d} test binary-35.1 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 unset -nocomplain arg2 } -returnCodes error -body { binary scan abcdefg a2@a3 arg1 arg2 } -result {missing count for "@" field specifier} test binary-35.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 set arg2 foo list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2 } {1 abc foo} test binary-35.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 unset -nocomplain arg2 set arg2 foo list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2 } {1 abc foo} test binary-35.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef @2a3 arg1] $arg1 } {1 cde} test binary-35.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef x*@1a1 arg1] $arg1 } {1 b} test binary-35.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan abcdef x*@0a1 arg1] $arg1 } {1 a} test binary-36.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abcdef u0a3 } -result {bad field specifier "u"} # GetFormatSpec is pretty thoroughly tested above, but there are a few cases # we should text explicitly test binary-37.1 {GetFormatSpec: whitespace} { binary format "a3 a5 a3" foo barblat baz } foobarblbaz test binary-37.2 {GetFormatSpec: whitespace} { binary format " " foo } {} test binary-37.3 {GetFormatSpec: whitespace} { binary format " a3" foo } foo test binary-37.4 {GetFormatSpec: whitespace} { binary format "" foo } {} test binary-37.5 {GetFormatSpec: whitespace} { binary format "" foo } {} test binary-37.6 {GetFormatSpec: whitespace} { binary format " a3 " foo } foo test binary-37.7 {GetFormatSpec: numbers} -returnCodes error -body { binary scan abcdef "x-1" foo } -result {bad field specifier "-"} test binary-37.8 {GetFormatSpec: numbers} { unset -nocomplain arg1 set arg1 foo list [binary scan abcdef "a0x3" arg1] $arg1 } {1 {}} test binary-37.9 {GetFormatSpec: numbers} { # test format of neg numbers # bug report/fix provided by Harald Kirsch set x [binary format f* {1 -1 2 -2 0}] binary scan $x f* bla set bla } {1.0 -1.0 2.0 -2.0 0.0} test binary-37.10 {GetFormatSpec: count overflow} { binary scan x a[format %ld 0x7fffffff] r } 0 test binary-37.11 {GetFormatSpec: count overflow} { binary scan x a[format %ld 0x10000000] r } 0 test binary-37.12 {GetFormatSpec: count overflow} { binary scan x a[format %ld 0x100000000] r } 0 test binary-37.13 {GetFormatSpec: count overflow} { binary scan x a[format %lld 0x10000000000000000] r } 0 test binary-38.1 {FormatNumber: word alignment} { set x [binary format c1s1 1 1] } \x01\x01\x00 test binary-38.2 {FormatNumber: word alignment} { set x [binary format c1S1 1 1] } \x01\x00\x01 test binary-38.3 {FormatNumber: word alignment} { set x [binary format c1i1 1 1] } \x01\x01\x00\x00\x00 test binary-38.4 {FormatNumber: word alignment} { set x [binary format c1I1 1 1] } \x01\x00\x00\x00\x01 test binary-38.5 {FormatNumber: word alignment} bigEndian { set x [binary format c1d1 1 1.6] } \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a test binary-38.6 {FormatNumber: word alignment} littleEndian { set x [binary format c1d1 1 1.6] } \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f test binary-38.7 {FormatNumber: word alignment} bigEndian { set x [binary format c1f1 1 1.6] } \x01\x3f\xcc\xcc\xcd test binary-38.8 {FormatNumber: word alignment} littleEndian { set x [binary format c1f1 1 1.6] } \x01\xcd\xcc\xcc\x3f test binary-39.1 {ScanNumber: sign extension} { unset -nocomplain arg1 list [binary scan \x52\xa3 c2 arg1] $arg1 } {1 {82 -93}} test binary-39.2 {ScanNumber: sign extension} { unset -nocomplain arg1 list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1 } {1 {513 -32511 386 -32127}} test binary-39.3 {ScanNumber: sign extension} { unset -nocomplain arg1 list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1 } {1 {258 385 -32255 -32382}} test binary-39.4 {ScanNumber: sign extension} { unset -nocomplain arg1 list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1 } {1 {33620225 16843137 16876033 25297153 -2130640639}} test binary-39.5 {ScanNumber: sign extension} { unset -nocomplain arg1 list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1 } {1 {16843010 -2130640639 25297153 16876033 16843137}} test binary-39.6 {ScanNumber: no sign extension} { unset -nocomplain arg1 list [binary scan \x52\xa3 cu2 arg1] $arg1 } {1 {82 163}} test binary-39.7 {ScanNumber: no sign extension} { unset -nocomplain arg1 list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1 } {1 {513 33025 386 33409}} test binary-39.8 {ScanNumber: no sign extension} { unset -nocomplain arg1 list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1 } {1 {258 385 33281 33154}} test binary-39.9 {ScanNumber: no sign extension} { unset -nocomplain arg1 list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1 } {1 {33620225 16843137 16876033 25297153 2164326657}} test binary-39.10 {ScanNumber: no sign extension} { unset -nocomplain arg1 list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1 } {1 {16843010 2164326657 25297153 16876033 16843137}} test binary-40.3 {ScanNumber: NaN} -body { unset -nocomplain arg1 list [binary scan \xff\xff\xff\xff f1 arg1] $arg1 } -match glob -result {1 -NaN*} test binary-40.4 {ScanNumber: NaN} -body { unset -nocomplain arg1 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1 } -match glob -result {1 -NaN*} test binary-41.1 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -body { list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2 } -result {2 1 1} test binary-41.2 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -body { list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2 } -result {2 1 1} test binary-41.3 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -body { list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2 } -result {2 1 1} test binary-41.4 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -body { list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2 } -result {2 1 1} test binary-41.5 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -constraints bigEndian -body { list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2 } -result {2 1 1.600000023841858} test binary-41.6 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -constraints littleEndian -body { list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2 } -result {2 1 1.600000023841858} test binary-41.7 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -constraints bigEndian -body { list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2 } -result {2 1 1.6} test binary-41.8 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -constraints littleEndian -body { list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 } -result {2 1 1.6} test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body { binary ? } -returnCodes error -match glob -result {unknown or ambiguous subcommand "?": *} # Wide int (guaranteed at least 64-bit) handling test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} { binary format w 7810179016327718216 } HelloTcl test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} { binary format W 7810179016327718216 } lcTolleH test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} { binary scan HelloTcl W x set x } 5216694956358656876 test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} { binary scan lcTolleH w x set x } 5216694956358656876 test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} { binary scan [binary format w [expr {wide(3) << 31}]] w x set x } 6442450944 test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} { binary scan [binary format W [expr {wide(3) << 31}]] W x set x } 6442450944 test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} { unset -nocomplain arg1 list [binary scan \x80[string repeat \x00 7] W arg1] $arg1 } {1 -9223372036854775808} test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} { unset -nocomplain arg1 list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1 } {1 9223372036854775808} test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} { unset -nocomplain arg1 list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1 } {1 9223372036854775808} test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} { unset -nocomplain arg1 arg2 list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2 } {2 9223372036854775808 -9223372036854775808} test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} { unset -nocomplain arg1 arg2 list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2 } {2 9223372036854775808 -9223372036854775808} test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} { binary scan [binary format sws 16450 -1 19521] c* x set x } {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76} test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} { binary scan [binary format sWs 16450 0x7fffffff 19521] c* x set x } {66 64 0 0 0 0 127 -1 -1 -1 65 76} test binary-46.1 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { binary format a* \u20ac } \u00ac test binary-46.2 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { list [binary scan [binary format a* \u20ac\u20bd] s x] $x } {1 -16980} test binary-46.3 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { set x {} set y {} set z {} list [binary scan [binary format a* \u20ac\u20bd] aaa x y z] $x $y $z } "2 \u00ac \u00bd {}" test binary-46.4 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { set x [encoding convertto iso8859-15 \u20ac] set y [binary format a* $x] list $x $y } "\u00a4 \u00a4" test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { set x [binary scan \u00a4 a* y] list $x $y [encoding convertfrom iso8859-15 $y] } "1 \u00a4 \u20ac" test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} { # This test is only reliable when memory debugging is turned on, but # without even memory debugging it should still generate the expected # answers and might therefore still pick up memory corruption caused by # [Bug 851747]. list [binary scan aba ccc x x x] $x } {3 97} ### TIP#129: endian specifiers ---- # format t test binary-48.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format t } -result {not enough arguments for all format specifiers} test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format t blat } -result {expected integer but got "blat"} test binary-48.3 {Tcl_BinaryObjCmd: format} { binary format S0 0x50 } {} test binary-48.4 {Tcl_BinaryObjCmd: format} bigEndian { binary format t 0x50 } \x00P test binary-48.5 {Tcl_BinaryObjCmd: format} littleEndian { binary format t 0x50 } P\x00 test binary-48.6 {Tcl_BinaryObjCmd: format} bigEndian { binary format t 0x5052 } PR test binary-48.7 {Tcl_BinaryObjCmd: format} littleEndian { binary format t 0x5052 } RP test binary-48.8 {Tcl_BinaryObjCmd: format} bigEndian { binary format t 0x505251 0x53 } RQ test binary-48.9 {Tcl_BinaryObjCmd: format} littleEndian { binary format t 0x505251 0x53 } QR test binary-48.10 {Tcl_BinaryObjCmd: format} bigEndian { binary format t2 {0x50 0x52} } \x00P\x00R test binary-48.11 {Tcl_BinaryObjCmd: format} littleEndian { binary format t2 {0x50 0x52} } P\x00R\x00 test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian { binary format t* {0x5051 0x52} } PQ\x00R test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian { binary format t* {0x5051 0x52} } QPR\x00 test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian { binary format t2 {0x50 0x52 0x53} 0x54 } \x00P\x00R test binary-48.15 {Tcl_BinaryObjCmd: format} littleEndian { binary format t2 {0x50 0x52 0x53} 0x54 } P\x00R\x00 test binary-48.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format t2 {0x50} } -result {number of elements in list does not match count} test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format t $a } -result "expected integer but got \"0x50 0x51\"" test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian { set a {0x50 0x51} binary format t1 $a } \x00P test binary-48.19 {Tcl_BinaryObjCmd: format} littleEndian { set a {0x50 0x51} binary format t1 $a } P\x00 # format n test binary-49.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format n } -result {not enough arguments for all format specifiers} test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format n blat } -result {expected integer but got "blat"} test binary-49.3 {Tcl_BinaryObjCmd: format} { binary format n0 0x50 } {} test binary-49.4 {Tcl_BinaryObjCmd: format} littleEndian { binary format n 0x50 } P\x00\x00\x00 test binary-49.5 {Tcl_BinaryObjCmd: format} littleEndian { binary format n 0x5052 } RP\x00\x00 test binary-49.6 {Tcl_BinaryObjCmd: format} littleEndian { binary format n 0x505251 0x53 } QRP\x00 test binary-49.7 {Tcl_BinaryObjCmd: format} littleEndian { binary format i1 {0x505251 0x53} } QRP\x00 test binary-49.8 {Tcl_BinaryObjCmd: format} littleEndian { binary format n 0x53525150 } PQRS test binary-49.9 {Tcl_BinaryObjCmd: format} littleEndian { binary format n2 {0x50 0x52} } P\x00\x00\x00R\x00\x00\x00 test binary-49.10 {Tcl_BinaryObjCmd: format} littleEndian { binary format n* {0x50515253 0x52} } SRQPR\x00\x00\x00 test binary-49.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format n2 {0x50} } -result {number of elements in list does not match count} test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format n $a } -result "expected integer but got \"0x50 0x51\"" test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian { set a {0x50 0x51} binary format n1 $a } P\x00\x00\x00 test binary-49.14 {Tcl_BinaryObjCmd: format} bigEndian { binary format n 0x50 } \x00\x00\x00P test binary-49.15 {Tcl_BinaryObjCmd: format} bigEndian { binary format n 0x5052 } \x00\x00PR test binary-49.16 {Tcl_BinaryObjCmd: format} bigEndian { binary format n 0x505251 0x53 } \x00PRQ test binary-49.17 {Tcl_BinaryObjCmd: format} bigEndian { binary format i1 {0x505251 0x53} } QRP\x00 test binary-49.18 {Tcl_BinaryObjCmd: format} bigEndian { binary format n 0x53525150 } SRQP test binary-49.19 {Tcl_BinaryObjCmd: format} bigEndian { binary format n2 {0x50 0x52} } \x00\x00\x00P\x00\x00\x00R test binary-49.20 {Tcl_BinaryObjCmd: format} bigEndian { binary format n* {0x50515253 0x52} } PQRS\x00\x00\x00R # format m test binary-50.1 {Tcl_BinaryObjCmd: format wide int} littleEndian { binary format m 7810179016327718216 } HelloTcl test binary-50.2 {Tcl_BinaryObjCmd: format wide int} bigEndian { binary format m 7810179016327718216 } lcTolleH test binary-50.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian { binary scan [binary format m [expr {wide(3) << 31}]] w x set x } 6442450944 test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian { binary scan [binary format m [expr {wide(3) << 31}]] W x set x } 6442450944 # format Q/q test binary-51.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format Q } -result {not enough arguments for all format specifiers} test binary-51.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format q blat } -result {expected floating-point number but got "blat"} test binary-51.3 {Tcl_BinaryObjCmd: format} { binary format q0 1.6 } {} test binary-51.4 {Tcl_BinaryObjCmd: format} {} { binary format Q 1.6 } \x3f\xf9\x99\x99\x99\x99\x99\x9a test binary-51.5 {Tcl_BinaryObjCmd: format} {} { binary format q 1.6 } \x9a\x99\x99\x99\x99\x99\xf9\x3f test binary-51.6 {Tcl_BinaryObjCmd: format} {} { binary format Q* {1.6 3.4} } \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 test binary-51.7 {Tcl_BinaryObjCmd: format} {} { binary format q* {1.6 3.4} } \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 test binary-51.8 {Tcl_BinaryObjCmd: format} {} { binary format Q2 {1.6 3.4} } \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 test binary-51.9 {Tcl_BinaryObjCmd: format} {} { binary format q2 {1.6 3.4} } \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 test binary-51.10 {Tcl_BinaryObjCmd: format} {} { binary format Q2 {1.6 3.4 5.6} } \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 test binary-51.11 {Tcl_BinaryObjCmd: format} {} { binary format q2 {1.6 3.4 5.6} } \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 test binary-51.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format q2 {1.6} } -result {number of elements in list does not match count} test binary-51.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {1.6 3.4} binary format q $a } -result "expected floating-point number but got \"1.6 3.4\"" test binary-51.16 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format Q1 $a } \x3f\xf9\x99\x99\x99\x99\x99\x9a test binary-51.17 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format q1 $a } \x9a\x99\x99\x99\x99\x99\xf9\x3f # format R/r test binary-53.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format r } -result {not enough arguments for all format specifiers} test binary-53.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format r blat } -result {expected floating-point number but got "blat"} test binary-53.3 {Tcl_BinaryObjCmd: format} { binary format f0 1.6 } {} test binary-53.4 {Tcl_BinaryObjCmd: format} {} { binary format R 1.6 } \x3f\xcc\xcc\xcd test binary-53.5 {Tcl_BinaryObjCmd: format} {} { binary format r 1.6 } \xcd\xcc\xcc\x3f test binary-53.6 {Tcl_BinaryObjCmd: format} {} { binary format R* {1.6 3.4} } \x3f\xcc\xcc\xcd\x40\x59\x99\x9a test binary-53.7 {Tcl_BinaryObjCmd: format} {} { binary format r* {1.6 3.4} } \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 test binary-53.8 {Tcl_BinaryObjCmd: format} {} { binary format R2 {1.6 3.4} } \x3f\xcc\xcc\xcd\x40\x59\x99\x9a test binary-53.9 {Tcl_BinaryObjCmd: format} {} { binary format r2 {1.6 3.4} } \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 test binary-53.10 {Tcl_BinaryObjCmd: format} {} { binary format R2 {1.6 3.4 5.6} } \x3f\xcc\xcc\xcd\x40\x59\x99\x9a test binary-53.11 {Tcl_BinaryObjCmd: format} {} { binary format r2 {1.6 3.4 5.6} } \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} { binary format R -3.402825e+38 } \xff\x7f\xff\xff test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} { binary format r -3.402825e+38 } \xff\xff\x7f\xff test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} { binary format R -3.402825e-100 } \x80\x00\x00\x00 test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} { binary format r -3.402825e-100 } \x00\x00\x00\x80 test binary-53.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format r2 {1.6} } -result {number of elements in list does not match count} test binary-53.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {1.6 3.4} binary format r $a } -result "expected floating-point number but got \"1.6 3.4\"" test binary-53.18 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format R1 $a } \x3f\xcc\xcc\xcd test binary-53.19 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format r1 $a } \xcd\xcc\xcc\x3f # scan t (s) test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc t } -result {not enough arguments for all format specifiers} test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1 } {1 {-23726 21587}} test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 t arg1] $arg1 } {1 -23726} test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3 t1 arg1] $arg1 } {1 -23726} test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3 t0 arg1] $arg1 } {1 {}} test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1 } {1 {-23726 21587}} test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 t1 arg1] $arg1 } {0 foo} test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 t1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2 } {2 {-23726 21587} 5} test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2 } {2 32768 -32768} test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2 } {2 -32768 32768} # scan t (b) test binary-55.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc t } -result {not enough arguments for all format specifiers} test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1 } {1 {21155 21332}} test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 t arg1] $arg1 } {1 21155} test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3 t1 arg1] $arg1 } {1 21155} test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3 t0 arg1] $arg1 } {1 {}} test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1 } {1 {21155 21332}} test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 t1 arg1] $arg1 } {0 foo} test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53 t1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2 } {2 {21155 21332} 5} test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2 } {2 32768 -32768} test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2 } {2 -32768 32768} # scan n (s) test binary-56.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc n } -result {not enough arguments for all format specifiers} test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1 } {1 {1414767442 67305985}} test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1 } {1 1414767442} test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1 } {1 1414767442} test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53 n0 arg1] $arg1 } {1 {}} test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1 } {1 {1414767442 67305985}} test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 n1 arg1] $arg1 } {0 foo} test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53\x53\x54 n1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 } {2 {1414767442 67305985} 5} test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2 } {2 128 128} test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2 } {2 2147483648 -2147483648} # scan n (b) test binary-57.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc n } -result {not enough arguments for all format specifiers} test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1 } {1 {1386435412 16909060}} test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1 } {1 1386435412} test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1 } {1 1386435412} test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53 n0 arg1] $arg1 } {1 {}} test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1 } {1 {1386435412 16909060}} test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 n1 arg1] $arg1 } {0 foo} test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x52\x53\x53\x54 n1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 } {2 {1386435412 16909060} 5} test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2 } {2 2147483648 -2147483648} test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2 } {2 128 128} # scan Q/q test binary-58.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc q } -result {not enough arguments for all format specifiers} test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1 } {1 {1.6 3.4}} test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1 } {1 {1.6 3.4}} test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1 } {1 1.6} test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1 } {1 1.6} test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1 } {1 1.6} test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1 } {1 1.6} test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1 } {1 {}} test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1 } {1 {}} test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1 } {1 {1.6 3.4}} test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1 } {1 {1.6 3.4}} test binary-58.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 q1 arg1] $arg1 } {0 foo} test binary-58.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2 } {2 {1.6 3.4} 5} test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2 } {2 {1.6 3.4} 5} # scan R/r test binary-59.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc r } -result {not enough arguments for all format specifiers} test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1 } {1 1.600000023841858} test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1 } {1 1.600000023841858} test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1 } {1 1.600000023841858} test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1 } {1 1.600000023841858} test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1 } {1 {}} test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1 } {1 {}} test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-59.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 set arg1 foo list [binary scan \x52 r1 arg1] $arg1 } {0 foo} test binary-59.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 binary scan \x3f\xcc\xcc\xcd r1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} test binary-60.1 {[binary format] with NaN} -body { binary scan [binary format dqQfrR NaN NaN NaN NaN NaN NaN] dqQfrR \ v1 v2 v3 v4 v5 v6 list $v1 $v2 $v3 $v4 $v5 $v6 } -match regexp -result {NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))?} # scan m test binary-61.1 {Tcl_BinaryObjCmd: scan wide int} bigEndian { binary scan HelloTcl m x set x } 5216694956358656876 test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian { binary scan lcTolleH m x set x } 5216694956358656876 test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian { binary scan [binary format w [expr {wide(3) << 31}]] m x set x } 6442450944 test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian { binary scan [binary format W [expr {wide(3) << 31}]] m x set x } 6442450944 # scan/format infinities test binary-62.1 {infinity} ieeeFloatingPoint { binary scan [binary format q Infinity] w w format 0x%016lx $w } 0x7ff0000000000000 test binary-62.2 {infinity} ieeeFloatingPoint { binary scan [binary format q -Infinity] w w format 0x%016lx $w } 0xfff0000000000000 test binary-62.3 {infinity} ieeeFloatingPoint { binary scan [binary format q Inf] w w format 0x%016lx $w } 0x7ff0000000000000 test binary-62.4 {infinity} ieeeFloatingPoint { binary scan [binary format q -Infinity] w w format 0x%016lx $w } 0xfff0000000000000 test binary-62.5 {infinity} ieeeFloatingPoint { binary scan [binary format w 0x7ff0000000000000] q d set d } Inf test binary-62.6 {infinity} ieeeFloatingPoint { binary scan [binary format w 0xfff0000000000000] q d set d } -Inf # scan/format Not-a-Number test binary-63.1 {NaN} ieeeFloatingPoint { binary scan [binary format q NaN] w w format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] } 0x7ff0000000000000 test binary-63.2 {NaN} ieeeFloatingPoint { binary scan [binary format q -NaN] w w format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] } 0xfff0000000000000 test binary-63.3 {NaN} ieeeFloatingPoint { binary scan [binary format q NaN(3123456789aBc)] w w format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] } 0x7ff3123456789abc test binary-63.4 {NaN} ieeeFloatingPoint { binary scan [binary format q {NaN( 3123456789aBc)}] w w format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] } 0x7ff3123456789abc # Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540] test binary-63.5 {NaN} -constraints ieeeFloatingPoint -body { binary format q Nan( } -returnCodes error -match glob -result {expected floating-point number*} test binary-63.6 {NaN} -constraints ieeeFloatingPoint -body { binary format q Nan() } -returnCodes error -match glob -result {expected floating-point number*} test binary-63.7 {NaN} -constraints ieeeFloatingPoint -body { binary format q Nan(g) } -returnCodes error -match glob -result {expected floating-point number*} test binary-63.8 {NaN} -constraints ieeeFloatingPoint -body { binary format q Nan(1,2) } -returnCodes error -match glob -result {expected floating-point number*} test binary-63.9 {NaN} -constraints ieeeFloatingPoint -body { binary format q Nan(1234567890abcd) } -returnCodes error -match glob -result {expected floating-point number*} test binary-64.1 {NaN} -constraints ieeeFloatingPoint -body { binary scan [binary format w 0x7ff8000000000000] q d set d } -match glob -result NaN* test binary-64.2 {NaN} -constraints ieeeFloatingPoint -body { binary scan [binary format w 0x7ff0123456789aBc] q d set d } -match glob -result NaN(*123456789abc) test binary-65.1 {largest significand} ieeeFloatingPoint { binary scan [binary format w 0x3fcfffffffffffff] q d set d } 0.24999999999999997 test binary-65.2 {smallest significand} ieeeFloatingPoint { binary scan [binary format w 0x3fd0000000000000] q d set d } 0.25 test binary-65.3 {largest significand} ieeeFloatingPoint { binary scan [binary format w 0x3fdfffffffffffff] q d set d } 0.49999999999999994 test binary-65.4 {smallest significand} ieeeFloatingPoint { binary scan [binary format w 0x3fe0000000000000] q d set d } 0.5 test binary-65.5 {largest significand} ieeeFloatingPoint { binary scan [binary format w 0x3fffffffffffffff] q d set d } 1.9999999999999998 test binary-65.6 {smallest significand} ieeeFloatingPoint { binary scan [binary format w 0x4000000000000000] q d set d } 2.0 test binary-65.7 {smallest significand} ieeeFloatingPoint { binary scan [binary format w 0x434fffffffffffff] q d set d } 18014398509481982.0 test binary-65.8 {largest significand} ieeeFloatingPoint { binary scan [binary format w 0x4350000000000000] q d set d } 18014398509481984.0 test binary-65.9 {largest significand} ieeeFloatingPoint { binary scan [binary format w 0x4350000000000001] q d set d } 18014398509481988.0 test binary-70.1 {binary encode hex} -body { binary encode hex } -returnCodes error -match glob -result "wrong # args: *" test binary-70.2 {binary encode hex} -body { binary encode hex a } -result {61} test binary-70.3 {binary encode hex} -body { binary encode hex {} } -result {} test binary-70.4 {binary encode hex} -body { binary encode hex [string repeat a 20] } -result [string repeat 61 20] test binary-70.5 {binary encode hex} -body { binary encode hex \0\1\2\3\4\0\1\2\3\4 } -result {00010203040001020304} test binary-71.1 {binary decode hex} -body { binary decode hex } -returnCodes error -match glob -result "wrong # args: *" test binary-71.2 {binary decode hex} -body { binary decode hex 61 } -result {a} test binary-71.3 {binary decode hex} -body { binary decode hex {} } -result {} test binary-71.4 {binary decode hex} -body { binary decode hex [string repeat 61 20] } -result [string repeat a 20] test binary-71.5 {binary decode hex} -body { binary decode hex 00010203040001020304 } -result "\0\1\2\3\4\0\1\2\3\4" test binary-71.6 {binary decode hex} -body { binary decode hex "61 61" } -result {aa} test binary-71.7 {binary decode hex} -body { binary decode hex "61\n\n\n61" } -result {aa} test binary-71.8 {binary decode hex} -body { binary decode hex -strict "61 61" } -returnCodes error -result {invalid hexadecimal digit " " at position 2} test binary-71.9 {binary decode hex} -body { set r [binary decode hex "6"] list [string length $r] $r } -result {0 {}} test binary-71.10 {binary decode hex} -body { string length [binary decode hex " "] } -result 0 test binary-71.11 {binary decode hex: Bug b98fa55285} -body { apply {{} { set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c26\n" set decoded [binary decode hex $str] list [string length $decoded] [scan [string index $decoded end] %c] }} } -result {29 38} test binary-71.12 {binary decode hex: Bug b98fa55285 cross check} -body { apply {{} { set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n" set decoded [binary decode hex $str] list [string length $decoded] [scan [string index $decoded end] %c] }} } -result {28 140} test binary-71.13 {binary decode hex: Bug b98fa55285 cross check} -body { apply {{} { set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n" set decoded [binary decode hex $str] list [string length $decoded] [scan [string index $decoded end] %c] }} } -result {28 140} test binary-71.14 {binary decode hex: Bug b98fa55285 cross check} -body { apply {{} { set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n\n" set decoded [binary decode hex $str] list [string length $decoded] [scan [string index $decoded end] %c] }} } -result {28 140} test binary-72.1 {binary encode base64} -body { binary encode base64 } -returnCodes error -match glob -result "wrong # args: *" test binary-72.2 {binary encode base64} -body { binary encode base64 abc } -result {YWJj} test binary-72.3 {binary encode base64} -body { binary encode base64 {} } -result {} test binary-72.4 {binary encode base64} -body { binary encode base64 [string repeat abc 20] } -result [string repeat YWJj 20] test binary-72.5 {binary encode base64} -body { binary encode base64 \0\1\2\3\4\0\1\2\3 } -result {AAECAwQAAQID} test binary-72.6 {binary encode base64} -body { binary encode base64 \0 } -result {AA==} test binary-72.7 {binary encode base64} -body { binary encode base64 \0\0 } -result {AAA=} test binary-72.8 {binary encode base64} -body { binary encode base64 \0\0\0 } -result {AAAA} test binary-72.9 {binary encode base64} -body { binary encode base64 \0\0\0\0 } -result {AAAAAA==} test binary-72.10 {binary encode base64} -body { binary encode base64 -maxlen 0 -wrapchar : abcabcabc } -result {YWJjYWJjYWJj} test binary-72.11 {binary encode base64} -body { binary encode base64 -maxlen 1 -wrapchar : abcabcabc } -result {Y:W:J:j:Y:W:J:j:Y:W:J:j} test binary-72.12 {binary encode base64} -body { binary encode base64 -maxlen 2 -wrapchar : abcabcabc } -result {YW:Jj:YW:Jj:YW:Jj} test binary-72.13 {binary encode base64} -body { binary encode base64 -maxlen 3 -wrapchar : abcabcabc } -result {YWJ:jYW:JjY:WJj} test binary-72.14 {binary encode base64} -body { binary encode base64 -maxlen 4 -wrapchar : abcabcabc } -result {YWJj:YWJj:YWJj} test binary-72.15 {binary encode base64} -body { binary encode base64 -maxlen 5 -wrapchar : abcabcabc } -result {YWJjY:WJjYW:Jj} test binary-72.16 {binary encode base64} -body { binary encode base64 -maxlen 6 -wrapchar : abcabcabc } -result {YWJjYW:JjYWJj} test binary-72.17 {binary encode base64} -body { binary encode base64 -maxlen 7 -wrapchar : abcabcabc } -result {YWJjYWJ:jYWJj} test binary-72.18 {binary encode base64} -body { binary encode base64 -maxlen 8 -wrapchar : abcabcabc } -result {YWJjYWJj:YWJj} test binary-72.19 {binary encode base64} -body { binary encode base64 -maxlen 9 -wrapchar : abcabcabc } -result {YWJjYWJjY:WJj} test binary-72.20 {binary encode base64} -body { binary encode base64 -maxlen 10 -wrapchar : abcabcabc } -result {YWJjYWJjYW:Jj} test binary-72.21 {binary encode base64} -body { binary encode base64 -maxlen 11 -wrapchar : abcabcabc } -result {YWJjYWJjYWJ:j} test binary-72.22 {binary encode base64} -body { binary encode base64 -maxlen 12 -wrapchar : abcabcabc } -result {YWJjYWJjYWJj} test binary-72.23 {binary encode base64} -body { binary encode base64 -maxlen 13 -wrapchar : abcabcabc } -result {YWJjYWJjYWJj} test binary-72.24 {binary encode base64} -body { binary encode base64 -maxlen 60 -wrapchar : abcabcabc } -result {YWJjYWJjYWJj} test binary-72.25 {binary encode base64} -body { binary encode base64 -maxlen 2 -wrapchar * abcabcabc } -result {YW*Jj*YW*Jj*YW*Jj} test binary-72.26 {binary encode base64} -body { binary encode base64 -maxlen 6 -wrapchar -*- abcabcabc } -result {YWJjYW-*-JjYWJj} test binary-72.27 {binary encode base64} -body { binary encode base64 -maxlen 4 -wrapchar -*- abcabcabc } -result {YWJj-*-YWJj-*-YWJj} test binary-72.28 {binary encode base64} -body { binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc } -result {YWJjYW0123456789JjYWJj} test binary-72.29 {binary encode base64} { string length [binary encode base64 -maxlen 3 -wrapchar \xca abc] } 5 test binary-73.1 {binary decode base64} -body { binary decode base64 } -returnCodes error -match glob -result "wrong # args: *" test binary-73.2 {binary decode base64} -body { binary decode base64 YWJj } -result {abc} test binary-73.3 {binary decode base64} -body { binary decode base64 {} } -result {} test binary-73.4 {binary decode base64} -body { binary decode base64 [string repeat YWJj 20] } -result [string repeat abc 20] test binary-73.5 {binary decode base64} -body { binary decode base64 AAECAwQAAQID } -result "\0\1\2\3\4\0\1\2\3" test binary-73.6 {binary decode base64} -body { binary decode base64 AA== } -result "\0" test binary-73.7 {binary decode base64} -body { binary decode base64 AAA= } -result "\0\0" test binary-73.8 {binary decode base64} -body { binary decode base64 AAAA } -result "\0\0\0" test binary-73.9 {binary decode base64} -body { binary decode base64 AAAAAA== } -result "\0\0\0\0" test binary-73.10 {binary decode base64} -body { set s "[string repeat YWJj 10]\n[string repeat YWJj 10]" binary decode base64 $s } -result [string repeat abc 20] test binary-73.11 {binary decode base64} -body { set s "[string repeat YWJj 10]\n [string repeat YWJj 10]" binary decode base64 $s } -result [string repeat abc 20] test binary-73.12 {binary decode base64} -body { binary decode base64 -strict ":YWJj" } -returnCodes error -match glob -result {invalid base64 character ":" at position 0} test binary-73.13 {binary decode base64} -body { set s "[string repeat YWJj 10]:[string repeat YWJj 10]" binary decode base64 -strict $s } -returnCodes error -match glob -result {invalid base64 character ":" at position 40} test binary-73.14 {binary decode base64} -body { set s "[string repeat YWJj 10]\n [string repeat YWJj 10]" binary decode base64 -strict $s } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.20 {binary decode base64} -body { set r [binary decode base64 Y] list [string length $r] $r } -result {0 {}} test binary-73.21 {binary decode base64} -body { set r [binary decode base64 YW] list [string length $r] $r } -result {1 a} test binary-73.22 {binary decode base64} -body { set r [binary decode base64 YWJ] list [string length $r] $r } -result {2 ab} test binary-73.23 {binary decode base64} -body { set r [binary decode base64 YWJj] list [string length $r] $r } -result {3 abc} test binary-73.24 {binary decode base64} -body { string length [binary decode base64 " "] } -result 0 test binary-73.25 {binary decode base64} -body { list [string length [set r [binary decode base64 WA==\n]]] $r } -result {1 X} test binary-73.26 {binary decode base64} -body { list [string length [set r [binary decode base64 WFk=\n]]] $r } -result {2 XY} test binary-73.27 {binary decode base64} -body { list [string length [set r [binary decode base64 WFla\n]]] $r } -result {3 XYZ} test binary-73.28 {binary decode base64} -body { list [string length [set r [binary decode base64 -strict WA==\n]]] $r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.29 {binary decode base64} -body { list [string length [set r [binary decode base64 -strict WFk=\n]]] $r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.30 {binary decode base64} -body { list [string length [set r [binary decode base64 -strict WFla\n]]] $r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.31 {binary decode base64} -body { list [string length [set r [binary decode base64 -strict WA==WFla]]] $r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.32 {binary decode base64, bug [00d04c4f12]} -body { list \ [string length [binary decode base64 =]] \ [string length [binary decode base64 " ="]] \ [string length [binary decode base64 " ="]] \ [string length [binary decode base64 "\r\n\t="]] \ } -result [lrepeat 4 0] test binary-73.33 {binary decode base64, bug [00d04c4f12]} -body { list \ [string length [binary decode base64 ==]] \ [string length [binary decode base64 " =="]] \ [string length [binary decode base64 " =="]] \ [string length [binary decode base64 " =="]] \ } -result [lrepeat 4 0] test binary-73.34 {binary decode base64, (compatibility) unfulfilled base64 (single char) in non-strict mode} -body { list \ [expr {[binary decode base64 a] eq [binary decode base64 ""]}] \ [expr {[binary decode base64 abcda] eq [binary decode base64 "abcd"]}] } -result [lrepeat 2 1] test binary-73.35 {binary decode base64, bad base64 in strict mode} -body { set r {} foreach c {a " a" " a" " a" " a" abcda abcdabcda a= a== abcda= abcda==} { lappend r \ [catch {binary decode base64 $c}] \ [catch {binary decode base64 -strict $c}] } set r } -result [lrepeat 11 0 1] test binary-73.36 {binary decode base64: check encoded & decoded equals original} -body { set r {} for {set i 0} {$i < 255 && [llength $r] < 20} {incr i} { foreach c {1 2 3 4 5 6 7 8} { set c [string repeat [format %c $i] $c] if {[set a [binary decode base64 [set x [binary encode base64 $c]]]] ne $c} { lappend r "encode & decode is wrong on string `$c` (encoded: $x): `$a` != `$c`" } } } join $r \n } -result {} test binary-73.37 {binary decode base64: Bug ffeb2097af} { binary decode base64 [binary encode base64 -maxlen 3 -wrapchar : abc] } abc test binary-74.1 {binary encode uuencode} -body { binary encode uuencode } -returnCodes error -match glob -result "wrong # args: *" test binary-74.2 {binary encode uuencode} -body { binary encode uuencode abc } -result {#86)C } test binary-74.3 {binary encode uuencode} -body { binary encode uuencode {} } -result {} test binary-74.4 {binary encode uuencode} -body { binary encode uuencode [string repeat abc 20] } -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n" test binary-74.5 {binary encode uuencode} -body { binary encode uuencode \0\1\2\3\4\0\1\2\3 } -result ")``\$\"`P0``0(#\n" test binary-74.6 {binary encode uuencode} -body { binary encode uuencode \0 } -result {!`` } test binary-74.7 {binary encode uuencode} -body { binary encode uuencode \0\0 } -result "\"``` " test binary-74.8 {binary encode uuencode} -body { binary encode uuencode \0\0\0 } -result {#```` } test binary-74.9 {binary encode uuencode} -body { binary encode uuencode \0\0\0\0 } -result {$`````` } test binary-74.10 {binary encode uuencode} -returnCodes error -body { binary encode uuencode -foo 30 abcabcabc } -result {bad option "-foo": must be -maxlen or -wrapchar} test binary-74.11 {binary encode uuencode} -returnCodes error -body { binary encode uuencode -maxlen 4 abcabcabc } -result {line length out of range} test binary-74.12 {binary encode uuencode} -body { binary encode uuencode -maxlen 5 -wrapchar \t abcabcabc } -result #86)C\t#86)C\t#86)C\t test binary-74.13 {binary encode uuencode} -body { binary encode uuencode -maxlen 85 -wrapchar \t abcabcabc } -result )86)C86)C86)C\t test binary-74.14 {binary encode uuencode} -returnCodes error -body { binary encode uuencode -maxlen 86 abcabcabc } -result {line length out of range} test binary-75.1 {binary decode uuencode} -body { binary decode uuencode } -returnCodes error -match glob -result "wrong # args: *" test binary-75.2 {binary decode uuencode} -body { binary decode uuencode "#86)C\n" } -result {abc} test binary-75.3 {binary decode uuencode} -body { binary decode uuencode {} } -result {} test binary-75.3.1 {binary decode uuencode} -body { binary decode uuencode `\n } -result {} test binary-75.4 {binary decode uuencode} -body { binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n" } -result [string repeat abc 20] test binary-75.5 {binary decode uuencode} -body { binary decode uuencode ")``\$\"`P0``0(#" } -result "\0\1\2\3\4\0\1\2\3" test binary-75.6 {binary decode uuencode} -body { string length [binary decode uuencode "`\n"] } -result 0 test binary-75.7 {binary decode uuencode} -body { string length [binary decode uuencode "!`\n"] } -result 1 test binary-75.8 {binary decode uuencode} -body { string length [binary decode uuencode "\"``\n"] } -result 2 test binary-75.9 {binary decode uuencode} -body { string length [binary decode uuencode "#```\n"] } -result 3 test binary-75.10 {binary decode uuencode} -body { set s ">[string repeat 86)C 10]\n>[string repeat 86)C 10]" binary decode uuencode $s } -result [string repeat abc 20] test binary-75.11 {binary decode uuencode} -body { set s ">[string repeat 86)C 10]\n\t>\t[string repeat 86)C 10]\r" binary decode uuencode $s } -result [string repeat abc 20] test binary-75.12 {binary decode uuencode} -body { binary decode uuencode -strict "|86)C" } -returnCodes error -match glob -result {invalid uuencode character "|" at position 0} test binary-75.13 {binary decode uuencode} -body { set s ">[string repeat 86)C 10]|[string repeat 86)C 10]" binary decode uuencode -strict $s } -returnCodes error -match glob -result {invalid uuencode character "|" at position 41} test binary-75.14 {binary decode uuencode} -body { set s ">[string repeat 86)C 10]\na[string repeat 86)C 10]" binary decode uuencode -strict $s } -returnCodes error -match glob -result {invalid uuencode character *} test binary-75.20 {binary decode uuencode} -body { set r [binary decode uuencode " 8"] list [string length $r] $r } -result {0 {}} test binary-75.21 {binary decode uuencode} -body { set r [binary decode uuencode "!86"] list [string length $r] $r } -result {1 a} test binary-75.22 {binary decode uuencode} -body { set r [binary decode uuencode "\"86)"] list [string length $r] $r } -result {2 ab} test binary-75.23 {binary decode uuencode} -body { set r [binary decode uuencode "#86)C"] list [string length $r] $r } -result {3 abc} test binary-75.24 {binary decode uuencode} -body { set s "#04)\# " binary decode uuencode $s } -result ABC test binary-75.25 {binary decode uuencode} -body { set s "#04)\#z" binary decode uuencode $s } -returnCodes error -match glob -result {invalid uuencode character "z" at position 5} test binary-75.26 {binary decode uuencode} -body { string length [binary decode uuencode " "] } -result 0 test binary-76.1 {binary string appending growth algorithm} unix { # Create zero-length byte array first set f [open /dev/null rb] chan configure $f -blocking 0 set str [read $f 2] close $f # Append to it string length [append str [binary format a* foo]] } 3 test binary-76.2 {binary string appending growth algorithm} win { # Create zero-length byte array first set f [open NUL rb] chan configure $f -blocking 0 set str [read $f 2] close $f # Append to it string length [append str [binary format a* foo]] } 3 testConstraint testsetbytearraylength \ [expr {"testsetbytearraylength" in [info commands]}] test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat A B C] 1 } A test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat \u0141 B C] 1 } A # ---------------------------------------------------------------------- # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/case.test0000644000175000017500000000560414554262142014625 0ustar sergeisergei# Commands covered: case # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test case-1.1 {simple pattern} { case a in a {format 1} b {format 2} c {format 3} default {format 4} } 1 test case-1.2 {simple pattern} { case b a {format 1} b {format 2} c {format 3} default {format 4} } 2 test case-1.3 {simple pattern} { case x in a {format 1} b {format 2} c {format 3} default {format 4} } 4 test case-1.4 {simple pattern} { case x a {format 1} b {format 2} c {format 3} } {} test case-1.5 {simple pattern matches many times} { case b a {format 1} b {format 2} b {format 3} b {format 4} } 2 test case-1.6 {fancier pattern} { case cx a {format 1} *c {format 2} *x {format 3} default {format 4} } 3 test case-1.7 {list of patterns} { case abc in {a b c} {format 1} {def abc ghi} {format 2} } 2 test case-2.1 {error in executed command} { list [catch {case a in a {error "Just a test"} default {format 1}} msg] \ $msg $::errorInfo } {1 {Just a test} {Just a test while executing "error "Just a test"" ("a" arm line 1) invoked from within "case a in a {error "Just a test"} default {format 1}"}} test case-2.2 {error: not enough args} { list [catch {case} msg] $msg } {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}} test case-2.3 {error: pattern with no body} { list [catch {case a b} msg] $msg } {1 {extra case pattern with no body}} test case-2.4 {error: pattern with no body} { list [catch {case a in b {format 1} c} msg] $msg } {1 {extra case pattern with no body}} test case-2.5 {error in default command} { list [catch {case foo in a {error case1} default {error case2} \ b {error case 3}} msg] $msg $::errorInfo } {1 case2 {case2 while executing "error case2" ("default" arm line 1) invoked from within "case foo in a {error case1} default {error case2} b {error case 3}"}} test case-3.1 {single-argument form for pattern/command pairs} { case b in { a {format 1} b {format 2} default {format 6} } } {2} test case-3.2 {single-argument form for pattern/command pairs} { case b { a {format 1} b {format 2} default {format 6} } } {2} test case-3.3 {single-argument form for pattern/command pairs} { list [catch {case z in {a 2 b}} msg] $msg } {1 {extra case pattern with no body}} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/chanio.test0000644000175000017500000076471114554262142015166 0ustar sergeisergei# -*- tcl -*- # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 } namespace eval ::tcl::test::io { namespace import ::tcltest::* variable umaskValue variable path variable f variable i variable n variable v variable msg variable expected catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] } source [file join [file dirname [info script]] tcltests.tcl] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testservicemode [llength [info commands testservicemode]] testConstraint notWinCI [expr { $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}] testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] # File permissions broken on wsl without some "exotic" wsl configuration testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 if "umask" cannot be run, the # tests will be skipped. set umaskValue 0 testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}] testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}] # set up a long data file for some of the following tests set path(longfile) [makeFile {} longfile] set f [open $path(longfile) w] chan configure $f -eofchar {} -translation lf for { set i 0 } { $i < 100 } { incr i} { chan puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef \#123456789abcdef01 \#" } chan close $f set path(cat) [makeFile { set f stdin if {$argv != ""} { set f [open [lindex $argv 0]] } chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A chan configure stdout -encoding binary -translation lf -buffering none chan event $f readable "foo $f" proc foo {f} { set x [chan read $f] catch {chan puts -nonewline $x} if {[chan eof $f]} { chan close $f exit 0 } } vwait forever } cat] set thisScript [file join [pwd] [info script]] proc contents {file} { set f [open $file] chan configure $f -translation binary set a [chan read $f] chan close $f return $a } # Wrapper round butt-ugly pipe syntax proc openpipe {{mode r+} args} { open "|[list [interpreter] {*}$args]" $mode } test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} { # no test, need to cause an async error. } {} set path(test1) [makeFile {} test1] test chan-io-1.6 {Tcl_WriteChars: WriteBytes} { set f [open $path(test1) w] chan configure $f -encoding binary chan puts -nonewline $f a\u4E4D\x00 chan close $f contents $path(test1) } aM\x00 test chan-io-1.7 {Tcl_WriteChars: WriteChars} { set f [open $path(test1) w] chan configure $f -encoding shiftjis chan puts -nonewline $f "a\u4E4D\0" chan close $f contents $path(test1) } "a\x93\xE1\x00" set path(test2) [makeFile {} test2] test chan-io-1.8 {Tcl_WriteChars: WriteChars} { # This test written for SF bug #506297. # # Executing this test without the fix for the referenced bug applied to # tcl will cause tcl, more specifically WriteChars, to go into an infinite # loop. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399] chan close $f contents $path(test2) } " \x1B\$B\$O\x1B(B" test chan-io-1.9 {Tcl_WriteChars: WriteChars} { # When closing a channel with an encoding that appends escape bytes, check # for the case where the escape bytes overflow the current IO buffer. The # bytes should be moved into a new buffer. set data "1234567890 [format %c 12399]" set sizes [list] # With default buffer size set f [open $path(test2) w] chan configure $f -encoding iso2022-jp chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] # With buffer size equal to the length of the data, the escape bytes would # go into the next buffer. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 16 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] # With buffer size that is large enough to hold 1 byte of escaped data, # but not all 3. This should not write the escape bytes to the first # buffer and then again to the second buffer. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 17 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] # With buffer size that can hold 2 out of 3 bytes of escaped data. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 18 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] # With buffer size that can hold all the data and escape bytes. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 19 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] } {19 19 19 19 19} test chan-io-2.1 {WriteBytes} { # loop until all bytes are written set f [open $path(test1) w] chan configure $f -encoding binary -buffersize 16 -translation crlf chan puts $f "abcdefghijklmnopqrstuvwxyz" chan close $f contents $path(test1) } "abcdefghijklmnopqrstuvwxyz\r\n" test chan-io-2.2 {WriteBytes: savedLF > 0} { # After flushing buffer, there was a \n left over from the last # \n -> \r\n expansion. It gets stuck at beginning of this buffer. set f [open $path(test1) w] chan configure $f -encoding binary -buffersize 16 -translation crlf chan puts -nonewline $f "123456789012345\n12" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "123456789012345\r" "123456789012345\r\n12"] test chan-io-2.3 {WriteBytes: flush on line} -body { # Tcl "line" buffering has weird behavior: if current buffer contains a # \n, entire buffer gets flushed. Logical behavior would be to flush only # up to the \n. set f [open $path(test1) w] chan configure $f -encoding binary -buffering line -translation crlf chan puts -nonewline $f "\n12" contents $path(test1) } -cleanup { chan close $f } -result "\r\n12" test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} { set f [open $path(test1) w] chan configure $f -encoding binary -buffering line -translation lf \ -buffersize 16 chan puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"] test chan-io-3.1 {WriteChars: compatibility with WriteBytes} { # loop until all bytes are written set f [open $path(test1) w] chan configure $f -encoding ascii -buffersize 16 -translation crlf chan puts $f "abcdefghijklmnopqrstuvwxyz" chan close $f contents $path(test1) } "abcdefghijklmnopqrstuvwxyz\r\n" test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} { # After flushing buffer, there was a \n left over from the last # \n -> \r\n expansion. It gets stuck at beginning of this buffer. set f [open $path(test1) w] chan configure $f -encoding ascii -buffersize 16 -translation crlf chan puts -nonewline $f "123456789012345\n12" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "123456789012345\r" "123456789012345\r\n12"] test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -body { # Tcl "line" buffering has weird behavior: if current buffer contains a # \n, entire buffer gets flushed. Logical behavior would be to flush only # up to the \n. set f [open $path(test1) w] chan configure $f -encoding ascii -buffering line -translation crlf chan puts -nonewline $f "\n12" contents $path(test1) } -cleanup { chan close $f } -result "\r\n12" test chan-io-3.4 {WriteChars: loop over stage buffer} -body { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] chan configure $f -encoding jis0208 -buffersize 16 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } -cleanup { catch {chan close $f} } -result [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test chan-io-3.5 {WriteChars: saved != 0} -body { # Bytes produced by UtfToExternal from end of last channel buffer had to # be moved to beginning of next channel buffer to preserve requested # buffersize. set f [open $path(test1) w] chan configure $f -encoding jis0208 -buffersize 17 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } -cleanup { catch {chan close $f} } -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} -body { # One incomplete UTF-8 character at end of staging buffer. Backup in src # to the beginning of that UTF-8 character and try again. # # Translate the first 16 bytes, produce 14 bytes of output, 2 left over # (first two bytes of \uFF21 in UTF-8). Given those two bytes try # translating them again, find that no bytes are read produced, and break # to outer loop where those two bytes will have the remaining 4 bytes (the # last byte of \uFF21 plus the all of \uFF22) appended. set f [open $path(test1) w] chan configure $f -encoding shiftjis -buffersize 16 chan puts -nonewline $f 12345678901234\uFF21\uFF22 set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } -cleanup { catch {chan close $f} } -result [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"] test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body { # When translating UTF-8 to external, the produced bytes went past end of # the channel buffer. This is done on purpose - we then truncate the bytes # at the end of the partial character to preserve the requested blocksize # on flush. The truncated bytes are moved to the beginning of the next # channel buffer. set f [open $path(test1) w] chan configure $f -encoding jis0208 -buffersize 17 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } -cleanup { catch {chan close $f} } -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test chan-io-3.8 {WriteChars: reset sawLF after each buffer} -body { set f [open $path(test1) w] chan configure $f -encoding ascii -buffering line -translation lf \ -buffersize 16 chan puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } -cleanup { catch {chan close $f} } -result [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"] test chan-io-4.1 {TranslateOutputEOL: lf} { # search for \n set f [open $path(test1) w] chan configure $f -buffering line -translation lf chan puts $f "abcde" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "abcde\n" "abcde\n"] test chan-io-4.2 {TranslateOutputEOL: cr} { # search for \n, replace with \r set f [open $path(test1) w] chan configure $f -buffering line -translation cr chan puts $f "abcde" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "abcde\r" "abcde\r"] test chan-io-4.3 {TranslateOutputEOL: crlf} { # simple case: search for \n, replace with \r set f [open $path(test1) w] chan configure $f -buffering line -translation crlf chan puts $f "abcde" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "abcde\r\n" "abcde\r\n"] test chan-io-4.4 {TranslateOutputEOL: crlf} { # Keep storing more bytes in output buffer until output buffer is full. We # have 13 bytes initially that would turn into 18 bytes. Fill dest buffer # while (dstEnd < dstMax). set f [open $path(test1) w] chan configure $f -translation crlf -buffersize 16 chan puts -nonewline $f "1234567\n\n\n\n\nA" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"] test chan-io-4.5 {TranslateOutputEOL: crlf} { # Check for overflow of the destination buffer set f [open $path(test1) w] chan configure $f -translation crlf -buffersize 12 chan puts -nonewline $f "12345678901\n456789012345678901234" chan close $f set x [contents $path(test1)] } "12345678901\r\n456789012345678901234" test chan-io-5.1 {CheckFlush: not full} { set f [open $path(test1) w] chan configure $f chan puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "" "12345678901234567890"] test chan-io-5.2 {CheckFlush: full} { set f [open $path(test1) w] chan configure $f -buffersize 16 chan puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "1234567890123456" "12345678901234567890"] test chan-io-5.3 {CheckFlush: not line} { set f [open $path(test1) w] chan configure $f -buffering line chan puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "" "12345678901234567890"] test chan-io-5.4 {CheckFlush: line} { set f [open $path(test1) w] chan configure $f -buffering line -translation lf -encoding ascii chan puts -nonewline $f "1234567890\n1234567890" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "1234567890\n1234567890" "1234567890\n1234567890"] test chan-io-5.5 {CheckFlush: none} { set f [open $path(test1) w] chan configure $f -buffering none chan puts -nonewline $f "1234567890" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] } [list "1234567890" "1234567890"] test chan-io-6.1 {Tcl_GetsObj: working} -body { set f [open $path(test1) w] chan puts $f "foo\nboo" chan close $f set f [open $path(test1)] chan gets $f } -cleanup { chan close $f } -result {foo} test chan-io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} emptyTest { # no test, need to cause an async error. } {} test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body { # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved} set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f "abc\ndefg" chan close $f set f [open $path(test1)] list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line } -cleanup { chan close $f } -result {0 3 5 4 defg} test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body { set f [open $path(test1) w] chan configure $f -translation binary chan puts $f "\x81\u1234\x00" chan close $f set f [open $path(test1)] chan configure $f -translation binary list [chan gets $f line] $line } -cleanup { chan close $f } -result [list 3 "\x81\x34\x00"] test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body { set f [open $path(test1) w] chan configure $f -translation binary chan puts $f "\x88\xEA\x92\x9A" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis list [chan gets $f line] $line } -cleanup { chan close $f } -result [list 2 "\u4E00\u4E01"] set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" append a $a append a $a test chan-io-6.6 {Tcl_GetsObj: loop test} -body { # if (dst >= dstEnd) set f [open $path(test1) w] chan puts $f $a chan puts $f hi chan close $f set f [open $path(test1)] list [chan gets $f line] $line } -cleanup { chan close $f } -result [list 256 $a] test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints stdio -body { # if (FilterInputBytes(chanPtr, &gs) != 0) set f [openpipe w+ $path(cat)] chan puts -nonewline $f "hi\nwould" chan flush $f chan gets $f chan configure $f -blocking 0 chan gets $f line } -cleanup { chan close $f } -result {-1} test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body { set f [open $path(test1) w] chan puts $f "abcdef\x1Aghijk\nwombat" chan close $f set f [open $path(test1)] chan configure $f -eofchar \x1A list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {6 abcdef -1 {}} test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body { set f [open $path(test1) w] chan puts $f "abcdefghijk\nwom\u001Abat" chan close $f set f [open $path(test1)] chan configure $f -eofchar \x1A list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {11 abcdefghijk 3 wom} # Comprehensive tests test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} -body { set f [open $path(test1) w] chan close $f set f [open $path(test1)] chan configure $f -translation lf list [chan gets $f line] $line } -cleanup { chan close $f } -result {-1 {}} test chan-io-6.11 {Tcl_GetsObj: lf mode: lone \n} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\n" chan close $f set f [open $path(test1)] chan configure $f -translation lf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {0 {} -1 {}} test chan-io-6.12 {Tcl_GetsObj: lf mode: lone \r} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r" chan close $f set f [open $path(test1)] chan configure $f -translation lf set x [list [chan gets $f line] $line [chan gets $f line] $line] } -cleanup { chan close $f } -result [list 1 "\r" -1 ""] test chan-io-6.13 {Tcl_GetsObj: lf mode: 1 char} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f a chan close $f set f [open $path(test1)] chan configure $f -translation lf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {1 a -1 {}} test chan-io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\n" chan close $f set f [open $path(test1)] chan configure $f -translation lf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {1 a -1 {}} test chan-io-6.15 {Tcl_GetsObj: lf mode: several chars} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop" chan close $f set f [open $path(test1)] chan configure $f -translation lf list [chan gets $f line] $line [chan gets $f line] $line \ [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""] test chan-io-6.16 {Tcl_GetsObj: cr mode: no chars} -body { set f [open $path(test1) w] chan close $f set f [open $path(test1)] chan configure $f -translation cr list [chan gets $f line] $line } -cleanup { chan close $f } -result {-1 {}} test chan-io-6.17 {Tcl_GetsObj: cr mode: lone \n} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\n" chan close $f set f [open $path(test1)] chan configure $f -translation cr list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result [list 1 "\n" -1 ""] test chan-io-6.18 {Tcl_GetsObj: cr mode: lone \r} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r" chan close $f set f [open $path(test1)] chan configure $f -translation cr list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {0 {} -1 {}} test chan-io-6.19 {Tcl_GetsObj: cr mode: 1 char} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f a chan close $f set f [open $path(test1)] chan configure $f -translation cr list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {1 a -1 {}} test chan-io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\r" chan close $f set f [open $path(test1)] chan configure $f -translation cr list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {1 a -1 {}} test chan-io-6.21 {Tcl_GetsObj: cr mode: several chars} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop" chan close $f set f [open $path(test1)] chan configure $f -translation cr list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""] test chan-io-6.22 {Tcl_GetsObj: crlf mode: no chars} -body { set f [open $path(test1) w] chan close $f set f [open $path(test1)] chan configure $f -translation crlf list [chan gets $f line] $line } -cleanup { chan close $f } -result {-1 {}} test chan-io-6.23 {Tcl_GetsObj: crlf mode: lone \n} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\n" chan close $f set f [open $path(test1)] chan configure $f -translation crlf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result [list 1 "\n" -1 ""] test chan-io-6.24 {Tcl_GetsObj: crlf mode: lone \r} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r" chan close $f set f [open $path(test1)] chan configure $f -translation crlf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result [list 1 "\r" -1 ""] test chan-io-6.25 {Tcl_GetsObj: crlf mode: \r\r} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r\r" chan close $f set f [open $path(test1)] chan configure $f -translation crlf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result [list 2 "\r\r" -1 ""] test chan-io-6.26 {Tcl_GetsObj: crlf mode: \r\n} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r\n" chan close $f set f [open $path(test1)] chan configure $f -translation crlf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {0 {} -1 {}} test chan-io-6.27 {Tcl_GetsObj: crlf mode: 1 char} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f a chan close $f set f [open $path(test1)] chan configure $f -translation crlf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {1 a -1 {}} test chan-io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\r\n" chan close $f set f [open $path(test1)] chan configure $f -translation crlf list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {1 a -1 {}} test chan-io-6.29 {Tcl_GetsObj: crlf mode: several chars} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop" chan close $f set f [open $path(test1)] chan configure $f -translation crlf list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""] test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} -constraints {testchannel} -body { # if (eol >= dstEnd) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz" chan close $f set f [open $path(test1)] chan configure $f -translation crlf -buffersize 16 list [chan gets $f line] $line [testchannel inputbuffered $f] } -cleanup { chan close $f } -result [list 15 "123456789012345" 15] test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} -setup { set x "" } -constraints {stdio testchannel fileevent} -body { # (FilterInputBytes() != 0) set f [openpipe w+ $path(cat)] chan configure $f -translation {crlf lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r" chan configure $f -buffersize 16 lappend x [chan gets $f] chan configure $f -blocking 0 lappend x [chan gets $f line] $line [chan blocked $f] \ [testchannel inputbuffered $f] } -cleanup { chan close $f } -result {bbbbbbbbbbbbbb -1 {} 1 16} test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} -constraints {testchannel} -body { # not (FilterInputBytes() != 0) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r\n123" chan close $f set f [open $path(test1)] chan configure $f -translation crlf -buffersize 16 list [chan gets $f line] $line [chan tell $f] [testchannel inputbuffered $f] } -cleanup { chan close $f } -result {15 123456789012345 17 3} test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} -body { # eol still equals dstEnd set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r" chan close $f set f [open $path(test1)] chan configure $f -translation crlf -buffersize 16 list [chan gets $f line] $line [chan eof $f] } -cleanup { chan close $f } -result [list 16 "123456789012345\r" 1] test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} -body { # not (*eol == '\n') set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\rabcd\r\nefg" chan close $f set f [open $path(test1)] chan configure $f -translation crlf -buffersize 16 list [chan gets $f line] $line [chan tell $f] } -cleanup { chan close $f } -result [list 20 "123456789012345\rabcd" 22] test chan-io-6.35 {Tcl_GetsObj: auto mode: no chars} -body { set f [open $path(test1) w] chan close $f set f [open $path(test1)] chan configure $f -translation auto list [chan gets $f line] $line } -cleanup { chan close $f } -result {-1 {}} test chan-io-6.36 {Tcl_GetsObj: auto mode: lone \n} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\n" chan close $f set f [open $path(test1)] chan configure $f -translation auto list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {0 {} -1 {}} test chan-io-6.37 {Tcl_GetsObj: auto mode: lone \r} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r" chan close $f set f [open $path(test1)] chan configure $f -translation auto list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {0 {} -1 {}} test chan-io-6.38 {Tcl_GetsObj: auto mode: \r\r} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r\r" chan close $f set f [open $path(test1)] chan configure $f -translation auto list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {0 {} 0 {} -1 {}} test chan-io-6.39 {Tcl_GetsObj: auto mode: \r\n} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r\n" chan close $f set f [open $path(test1)] chan configure $f -translation auto list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {0 {} -1 {}} test chan-io-6.40 {Tcl_GetsObj: auto mode: 1 char} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f a chan close $f set f [open $path(test1)] chan configure $f -translation auto list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {1 a -1 {}} test chan-io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\r\n" chan close $f set f [open $path(test1)] chan configure $f -translation auto list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {1 a -1 {}} test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} -setup { set x "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop" chan close $f set f [open $path(test1)] chan configure $f -translation auto lappend x [chan gets $f line] $line [chan gets $f line] $line lappend x [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {4 abcd 4 efgh 4 ijkl 4 mnop -1 {}} test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup { set x "" } -constraints {stdio testchannel fileevent} -body { # if (chanPtr->flags & INPUT_SAW_CR) set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" chan configure $f -buffersize 16 lappend x [chan gets $f] chan configure $f -blocking 0 lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 chan puts -nonewline $f "\nabcd\refg\x1A" lappend x [chan gets $f line] $line [testchannel queuedcr $f] lappend x [chan gets $f line] $line } -cleanup { chan close $f } -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg} test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup { set x "" } -constraints {stdio testchannel fileevent} -body { # not (*eol == '\n') set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" chan configure $f -buffersize 16 lappend x [chan gets $f] chan configure $f -blocking 0 lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 chan puts -nonewline $f "abcd\refg\x1A" lappend x [chan gets $f line] $line [testchannel queuedcr $f] lappend x [chan gets $f line] $line } -cleanup { chan close $f } -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg} test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup { set x "" } -constraints {stdio testchannel fileevent} -body { # Tcl_ExternalToUtf() set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none chan configure $f -encoding unicode chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" chan configure $f -buffersize 16 chan gets $f chan configure $f -blocking 0 lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 chan puts -nonewline $f "\nabcd\refg" lappend x [chan gets $f line] $line [testchannel queuedcr $f] } -cleanup { chan close $f } -result {15 123456789abcdef 1 4 abcd 0} test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} -setup { set x "" } -constraints {stdio testchannel fileevent} -body { # memmove() set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" chan configure $f -buffersize 16 chan gets $f chan configure $f -blocking 0 lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 chan puts -nonewline $f "\n\x1A" lappend x [chan gets $f line] $line [testchannel queuedcr $f] } -cleanup { chan close $f } -result {15 123456789abcdef 1 -1 {} 0} test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} -constraints {testchannel} -body { # (eol == dstEnd) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq" chan close $f set f [open $path(test1)] chan configure $f -translation auto -buffersize 16 list [chan gets $f] [testchannel inputbuffered $f] } -cleanup { chan close $f } -result {123456789012345 15} test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} -constraints {testchannel} -body { # PeekAhead() did not get any, so (eol >= dstEnd) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r" chan close $f set f [open $path(test1)] chan configure $f -translation auto -buffersize 16 list [chan gets $f] [testchannel queuedcr $f] } -cleanup { chan close $f } -result {123456789012345 1} test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} -constraints {testchannel} -body { # if (*eol == '\n') {skip++} set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\r\n78901" chan close $f set f [open $path(test1)] list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f] } -cleanup { chan close $f } -result {123456 0 8 78901} test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} -constraints {testchannel} -body { # not (*eol == '\n') set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\r78901" chan close $f set f [open $path(test1)] list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f] } -cleanup { chan close $f } -result {123456 0 7 78901} test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} -body { # else if (*eol == '\n') {goto gotoeol;} set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\n78901" chan close $f set f [open $path(test1)] list [chan gets $f] [chan tell $f] [chan gets $f] } -cleanup { chan close $f } -result {123456 7 78901} test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -body { # if (eof != NULL) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\x1Ak9012345\r" chan close $f set f [open $path(test1)] chan configure $f -eofchar \x1A list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f] } -cleanup { chan close $f } -result {123456 0 6 {}} test chan-io-6.53 {Tcl_GetsObj: device EOF} -body { # didn't produce any bytes set f [open $path(test1) w] chan close $f set f [open $path(test1)] list [chan gets $f line] $line [chan eof $f] } -cleanup { chan close $f } -result {-1 {} 1} test chan-io-6.54 {Tcl_GetsObj: device EOF} -body { # got some bytes before EOF. set f [open $path(test1) w] chan puts -nonewline $f abc chan close $f set f [open $path(test1)] list [chan gets $f line] $line [chan eof $f] } -cleanup { chan close $f } -result {3 abc 1} test chan-io-6.55 {Tcl_GetsObj: overconverted} -body { # Tcl_ExternalToUtf(), make sure state updated set f [open $path(test1) w] chan configure $f -encoding iso2022-jp chan puts $f "there\u4E00ok\n\u4E01more bytes\nhere" chan close $f set f [open $path(test1)] chan configure $f -encoding iso2022-jp list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result [list 8 "there\u4E00ok" 11 "\u4E01more bytes" 4 "here"] test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup { update variable x {} } -constraints {stdio fileevent} -body { set f [openpipe w+ $path(cat)] chan configure $f -buffering none chan puts -nonewline $f "foobar" chan configure $f -blocking 0 after 500 [namespace code { lappend x timeout }] chan event $f readable [namespace code { lappend x [chan gets $f] }] vwait [namespace which -variable x] vwait [namespace which -variable x] chan configure $f -blocking 1 chan puts -nonewline $f "baz\n" after 500 [namespace code { lappend x timeout }] chan configure $f -blocking 0 vwait [namespace which -variable x] vwait [namespace which -variable x] return $x } -cleanup { chan close $f } -result {{} timeout foobarbaz timeout} test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body { # (result == TCL_CONVERT_MULTIBYTE) set f [open $path(test1) w] chan configure $f -encoding shiftjis chan puts $f "1234567890123\uFF10\uFF11\uFF12\uFF13\uFF14\nend" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis -buffersize 16 chan gets $f } -cleanup { chan close $f } -result "1234567890123\uFF10\uFF11\uFF12\uFF13\uFF14" test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body { # (bufPtr->nextAdded < bufPtr->bufLength) set f [open $path(test1) w] chan configure $f -encoding binary chan puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis list [chan gets $f line] $line [chan eof $f] } -cleanup { chan close $f } -result {10 1234567890 0} test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup { set x "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -encoding binary chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis lappend x [chan gets $f line] $line lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f] lappend x [chan gets $f line] $line } -cleanup { chan close $f } -result [list 16 "1234567890123\uFF10\uFF11\x82" 18 0 1 -1 ""] test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup { variable x "" } -constraints {stdio fileevent} -body { set f [openpipe w+ $path(cat)] chan configure $f -encoding binary -buffering none chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" chan configure $f -encoding shiftjis -blocking 0 chan event $f read [namespace code { lappend x [chan gets $f line] $line [chan blocked $f] }] vwait [namespace which -variable x] chan configure $f -encoding binary -blocking 1 chan puts $f "\x51\x82\x52" chan configure $f -encoding shiftjis vwait [namespace which -variable x] return $x } -cleanup { chan close $f } -result [list -1 "" 1 17 "1234567890123\uFF10\uFF11\uFF12\uFF13" 0] test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constraints {testchannel} -body { # (bufPtr->nextPtr == NULL) set f [open $path(test1) w] chan configure $f -encoding ascii -translation lf chan puts -nonewline $f "123456789012345\r\n2345678" chan close $f set f [open $path(test1)] chan configure $f -encoding ascii -translation auto -buffersize 16 # here chan gets $f testchannel inputbuffered $f } -cleanup { chan close $f } -result 7 test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup { variable x {} } -constraints {stdio testchannel fileevent} -body { # not (bufPtr->nextPtr == NULL) set f [openpipe w+ $path(cat)] chan configure $f -translation lf -encoding ascii -buffering none chan puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz" chan event $f read [namespace code { lappend x [chan gets $f line] $line [testchannel inputbuffered $f] }] chan configure $f -encoding unicode -buffersize 16 -blocking 0 vwait [namespace which -variable x] chan configure $f -translation auto -encoding ascii -blocking 1 # here vwait [namespace which -variable x] return $x } -cleanup { chan close $f } -result {-1 {} 42 15 123456789012345 25} test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel fileevent} -body { # (bytesLeft == 0) set f [openpipe w+ $path(cat)] chan configure $f -translation {auto binary} chan puts -nonewline $f "abcdefghijklmno\r" chan flush $f list [chan gets $f line] $line [testchannel queuedcr $f] } -cleanup { chan close $f } -result {15 abcdefghijklmno 1} set a "123456789012345678901234567890" append a "123456789012345678901234567890" append a "1234567890123456789012345678901" test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body { # not (bytesLeft == 0) set f [open $path(test1) w+] chan configure $f -translation binary chan puts $f "${a}\r\nabcdef" chan close $f set f [open $path(test1)] chan configure $f -encoding binary -translation auto # "${a}\r" was converted in one operation (because ENCODING_LINESIZE is # 30). To check if "\n" follows, calls PeekAhead and determines that # cached data is available in buffer w/o having to call driver. chan gets $f } -cleanup { chan close $f } -result $a unset a test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel fileevent} -body { # (bufPtr->nextAdded < bufPtr->length) set f [openpipe w+ $path(cat)] chan configure $f -translation {auto binary} chan puts -nonewline $f "abcdefghijklmno\r" chan flush $f # here list [chan gets $f line] $line [testchannel queuedcr $f] } -cleanup { chan close $f } -result {15 abcdefghijklmno 1} test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel fileevent} -body { # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) set f [openpipe w+ $path(cat)] chan configure $f -translation {auto binary} -buffersize 16 chan puts -nonewline $f "abcdefghijklmno\r" chan flush $f # here list [chan gets $f line] $line [testchannel queuedcr $f] } -cleanup { chan close $f } -result {15 abcdefghijklmno 1} test chan-io-8.7 {PeekAhead: cleanup} -setup { set x "" } -constraints {stdio testchannel fileevent} -body { # Make sure bytes are removed from buffer. set f [openpipe w+ $path(cat)] chan configure $f -translation {auto binary} -buffering none chan puts -nonewline $f "abcdefghijklmno\r" # here lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan puts -nonewline $f \x1A lappend x [chan gets $f line] $line } -cleanup { chan close $f } -result {15 abcdefghijklmno 1 -1 {}} test chan-io-9.1 {CommonGetsCleanup} emptyTest { } {} test chan-io-10.1 {Tcl_ReadChars: CheckChannelErrors} emptyTest { # no test, need to cause an async error. } {} test chan-io-10.2 {Tcl_ReadChars: loop until enough copied} -body { # one time # for (copied = 0; (unsigned) toRead > 0; ) set f [open $path(test1) w] chan puts $f abcdefghijklmnop chan close $f set f [open $path(test1)] chan read $f 5 } -cleanup { chan close $f } -result {abcde} test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} -body { # multiple times # for (copied = 0; (unsigned) toRead > 0; ) set f [open $path(test1) w] chan puts $f abcdefghijklmnopqrstuvwxyz chan close $f set f [open $path(test1)] chan configure $f -buffersize 16 # here chan read $f 19 } -cleanup { chan close $f } -result {abcdefghijklmnopqrs} test chan-io-10.4 {Tcl_ReadChars: no more in channel buffer} -body { # (copiedNow < 0) set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f set f [open $path(test1)] # here chan read $f 1000 } -cleanup { chan close $f } -result {abcdefghijkl} test chan-io-10.5 {Tcl_ReadChars: stop on EOF} -body { # (chanPtr->flags & CHANNEL_EOF) set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f set f [open $path(test1)] # here chan read $f 1000 } -cleanup { chan close $f } -result {abcdefghijkl} test chan-io-11.1 {ReadBytes: want to read a lot} -body { # ((unsigned) toRead > (unsigned) srcLen) set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f set f [open $path(test1)] chan configure $f -encoding binary # here chan read $f 1000 } -cleanup { chan close $f } -result {abcdefghijkl} test chan-io-11.2 {ReadBytes: want to read all} -body { # ((unsigned) toRead > (unsigned) srcLen) set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f set f [open $path(test1)] chan configure $f -encoding binary # here chan read $f } -cleanup { chan close $f } -result {abcdefghijkl} test chan-io-11.3 {ReadBytes: allocate more space} -body { # (toRead > length - offset - 1) set f [open $path(test1) w] chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz chan close $f set f [open $path(test1)] chan configure $f -buffersize 16 -encoding binary # here chan read $f } -cleanup { chan close $f } -result {abcdefghijklmnopqrstuvwxyz} test chan-io-11.4 {ReadBytes: EOF char found} -body { # (TranslateInputEOL() != 0) set f [open $path(test1) w] chan puts $f abcdefghijklmnopqrstuvwxyz chan close $f set f [open $path(test1)] chan configure $f -eofchar m -encoding binary # here list [chan read $f] [chan eof $f] [chan read $f] [chan eof $f] } -cleanup { chan close $f } -result {abcdefghijkl 1 {} 1} test chan-io-12.1 {ReadChars: want to read a lot} -body { # ((unsigned) toRead > (unsigned) srcLen) set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f set f [open $path(test1)] # here chan read $f 1000 } -cleanup { chan close $f } -result {abcdefghijkl} test chan-io-12.2 {ReadChars: want to read all} -body { # ((unsigned) toRead > (unsigned) srcLen) set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f set f [open $path(test1)] # here chan read $f } -cleanup { chan close $f } -result {abcdefghijkl} test chan-io-12.3 {ReadChars: allocate more space} -body { # (toRead > length - offset - 1) set f [open $path(test1) w] chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz chan close $f set f [open $path(test1)] chan configure $f -buffersize 16 # here chan read $f } -cleanup { chan close $f } -result {abcdefghijklmnopqrstuvwxyz} test chan-io-12.4 {ReadChars: split-up char} -setup { variable x {} } -constraints {stdio testchannel fileevent} -body { # (srcRead == 0) set f [openpipe w+ $path(cat)] chan configure $f -encoding binary -buffering none -buffersize 16 chan puts -nonewline $f "123456789012345\x96" chan configure $f -encoding shiftjis -blocking 0 chan event $f read [namespace code { lappend x [chan read $f] [testchannel inputbuffered $f] }] chan configure $f -encoding shiftjis vwait [namespace which -variable x] chan configure $f -encoding binary -blocking 1 chan puts -nonewline $f \x7B after 500 ;# Give the cat process time to catch up chan configure $f -encoding shiftjis -blocking 0 vwait [namespace which -variable x] return $x } -cleanup { chan close $f } -result [list "123456789012345" 1 \u672C 0] test chan-io-12.5 {ReadChars: chan events on partial characters} -setup { variable x {} } -constraints {stdio fileevent} -body { set path(test1) [makeFile { chan configure stdout -encoding binary -buffering none chan gets stdin; chan puts -nonewline \xE7 chan gets stdin; chan puts -nonewline \x89 chan gets stdin; chan puts -nonewline \xA6 } test1] set f [openpipe r+ $path(test1)] chan event $f readable [namespace code { lappend x [chan read $f] if {[chan eof $f]} { lappend x eof } }] chan puts $f "go1" chan flush $f chan configure $f -blocking 0 -encoding utf-8 vwait [namespace which -variable x] after 500 [namespace code { lappend x timeout }] vwait [namespace which -variable x] chan puts $f "go2" chan flush $f vwait [namespace which -variable x] after 500 [namespace code { lappend x timeout }] vwait [namespace which -variable x] chan puts $f "go3" chan flush $f vwait [namespace which -variable x] vwait [namespace which -variable x] lappend x [catch {chan close $f} msg] $msg } -result "{} timeout {} timeout \u7266 {} eof 0 {}" test chan-io-13.1 {TranslateInputEOL: cr mode} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\rdef\r" chan close $f set f [open $path(test1)] chan configure $f -translation cr chan read $f } -cleanup { chan close $f } -result "abcd\ndef\n" test chan-io-13.2 {TranslateInputEOL: crlf mode} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef\r\n" chan close $f set f [open $path(test1)] chan configure $f -translation crlf chan read $f } -cleanup { chan close $f } -result "abcd\ndef\n" test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body { # (src >= srcMax) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef\r" chan close $f set f [open $path(test1)] chan configure $f -translation crlf chan read $f } -cleanup { chan close $f } -result "abcd\ndef\r" test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body { # (src >= srcMax) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef\rfgh" chan close $f set f [open $path(test1)] chan configure $f -translation crlf chan read $f } -cleanup { chan close $f } -result "abcd\ndef\rfgh" test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body { # (src >= srcMax) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef\nfgh" chan close $f set f [open $path(test1)] chan configure $f -translation crlf chan read $f } -cleanup { chan close $f } -result "abcd\ndef\nfgh" test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup { variable x {} variable y {} } -constraints {stdio testchannel fileevent} -body { # (chanPtr->flags & INPUT_SAW_CR) # This test may fail on slower machines. set f [openpipe w+ $path(cat)] chan configure $f -blocking 0 -buffering none -translation {auto lf} chan event $f read [namespace code { lappend x [chan read $f] [testchannel queuedcr $f] }] chan puts -nonewline $f "abcdefghj\r" after 500 [namespace code {set y ok}] vwait [namespace which -variable y] chan puts -nonewline $f "\n01234" after 500 [namespace code {set y ok}] vwait [namespace which -variable y] return $x } -cleanup { chan close $f } -result [list "abcdefghj\n" 1 "01234" 0] test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints testchannel -body { # (src >= srcMax) set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r" chan close $f set f [open $path(test1)] chan configure $f -translation auto list [chan read $f] [testchannel queuedcr $f] } -cleanup { chan close $f } -result [list "abcd\n" 1] test chan-io-13.8 {TranslateInputEOL: auto mode: \r\n} -body { # (*src == '\n') set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef" chan close $f set f [open $path(test1)] chan configure $f -translation auto chan read $f } -cleanup { chan close $f } -result "abcd\ndef" test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\rdef" chan close $f set f [open $path(test1)] chan configure $f -translation auto chan read $f } -cleanup { chan close $f } -result "abcd\ndef" test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body { # not (*src == '\r') set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\ndef" chan close $f set f [open $path(test1)] chan configure $f -translation auto chan read $f } -cleanup { chan close $f } -result "abcd\ndef" test chan-io-13.11 {TranslateInputEOL: EOF char} -body { # (*chanPtr->inEofChar != '\x00') set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\ndefgh" chan close $f set f [open $path(test1)] chan configure $f -translation auto -eofchar e chan read $f } -cleanup { chan close $f } -result "abcd\nd" test chan-io-13.12 {TranslateInputEOL: find EOF char in src} -body { # (*chanPtr->inEofChar != '\x00') set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n" chan close $f set f [open $path(test1)] chan configure $f -translation auto -eofchar e chan read $f } -cleanup { chan close $f } -result "\n\n\nab\n\nd" # Test standard handle management. The functions tested are Tcl_SetStdChannel # and Tcl_GetStdChannel. Incidentally we are also testing channel table # management. if {[testConstraint testchannel]} { set consoleFileNames [lsort [testchannel open]] } else { # just to avoid an error set consoleFileNames [list] } test chan-io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} { set result "" lappend result [chan configure stdin -buffering] lappend result [chan configure stdout -buffering] lappend result [chan configure stderr -buffering] lappend result [lsort [testchannel open]] } [list line line none $consoleFileNames] test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} -setup { interp create x set result "" } -body { lappend result [x eval {chan configure stdin -buffering}] lappend result [x eval {chan configure stdout -buffering}] lappend result [x eval {chan configure stderr -buffering}] } -cleanup { interp delete x } -result {line line none} set path(test3) [makeFile {} test3] test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints exec -body { set f [open $path(test1) w] chan puts -nonewline $f { chan close stdin chan close stdout chan close stderr set f [} chan puts $f [list open $path(test1) r]] chan puts $f "set f2 \[[list open $path(test2) w]]" chan puts $f "set f3 \[[list open $path(test3) w]]" chan puts $f { chan puts stdout [chan gets stdin] chan puts stdout out chan puts stderr err chan close $f chan close $f2 chan close $f3 } chan close $f set result [exec [interpreter] $path(test1)] set f [open $path(test2) r] set f2 [open $path(test3) r] lappend result [chan read $f] [chan read $f2] } -cleanup { chan close $f chan close $f2 } -result {{ out } {err }} # This test relies on the fact that stdout is used before stderr. test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec} -body { set f [open $path(test1) w] chan puts -nonewline $f { chan close stdin chan close stdout chan close stderr set f [} chan puts $f [list open $path(test1) r]] chan puts $f "set f2 \[[list open $path(test2) w]]" chan puts $f "set f3 \[[list open $path(test3) w]]" chan puts $f { chan puts stdout [chan gets stdin] chan puts stdout $f2 chan puts stderr $f3 chan close $f chan close $f2 chan close $f3 } chan close $f set result [exec [interpreter] $path(test1)] set f [open $path(test2) r] set f2 [open $path(test3) r] lappend result [chan read $f] [chan read $f2] } -cleanup { chan close $f chan close $f2 } -result {{ chan close stdin stdout } {stderr }} catch {interp delete z} test chan-io-14.5 {Tcl_GetChannel: stdio name translation} -setup { interp create z } -body { chan eof stdin catch {z eval chan flush stdin} msg1 catch {z eval chan close stdin} msg2 catch {z eval chan flush stdin} msg3 list $msg1 $msg2 $msg3 } -cleanup { interp delete z } -result {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}} test chan-io-14.6 {Tcl_GetChannel: stdio name translation} -setup { interp create z } -body { chan eof stdout catch {z eval chan flush stdout} msg1 catch {z eval chan close stdout} msg2 catch {z eval chan flush stdout} msg3 list $msg1 $msg2 $msg3 } -cleanup { interp delete z } -result {{} {} {can not find channel named "stdout"}} test chan-io-14.7 {Tcl_GetChannel: stdio name translation} -setup { interp create z } -body { chan eof stderr catch {z eval chan flush stderr} msg1 catch {z eval chan close stderr} msg2 catch {z eval chan flush stderr} msg3 list $msg1 $msg2 $msg3 } -cleanup { interp delete z } -result {{} {} {can not find channel named "stderr"}} set path(script) [makeFile {} script] test chan-io-14.8 {reuse of stdio special channels} -setup { file delete $path(script) file delete $path(test1) } -constraints stdio -body { set f [open $path(script) w] chan puts -nonewline $f { chan close stderr set f [} chan puts $f [list open $path(test1) w]] chan puts -nonewline $f { chan puts stderr hello chan close $f set f [} chan puts $f [list open $path(test1) r]] chan puts $f { chan puts [chan gets $f] } chan close $f set f [openpipe r $path(script)] chan gets $f } -cleanup { chan close $f } -result hello test chan-io-14.9 {reuse of stdio special channels} -setup { file delete $path(script) file delete $path(test1) } -constraints {stdio fileevent} -body { set f [open $path(script) w] chan puts $f { array set path [lindex $argv 0] set f [open $path(test1) w] chan puts $f hello chan close $f chan close stderr set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r] chan puts [chan gets $f] } chan close $f set f [openpipe r $path(script) [array get path]] chan gets $f } -cleanup { chan close $f # Added delay to give Windows time to stop the spawned process and clean # up its grip on the file test1. Added delete as proper test cleanup. # The failing tests were 18.1 and 18.2 as first re-users of file "test1". after [expr {[testConstraint win] ? 10000 : 500}] file delete $path(script) file delete $path(test1) } -result hello test chan-io-15.1 {Tcl_CreateChan CloseHandler} emptyTest { } {} test chan-io-16.1 {Tcl_DeleteChan CloseHandler} emptyTest { } {} # Test channel table management. The functions tested are GetChannelTable, # DeleteChannelTable, Tcl_RegisterChannel, Tcl_UnregisterChannel, # Tcl_GetChannel and Tcl_CreateChannel. # # These functions use "eof stdin" to ensure that the standard channels are # added to the channel table of the interpreter. test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} -setup { set l "" } -constraints {testchannel} -body { set l1 [testchannel refcount stdin] chan eof stdin interp create x lappend l [expr {[testchannel refcount stdin] - $l1}] x eval {chan eof stdin} lappend l [expr {[testchannel refcount stdin] - $l1}] interp delete x lappend l [expr {[testchannel refcount stdin] - $l1}] } -result {0 1 0} test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} -setup { set l "" } -constraints {testchannel} -body { set l1 [testchannel refcount stdout] chan eof stdin interp create x lappend l [expr {[testchannel refcount stdout] - $l1}] x eval {chan eof stdout} lappend l [expr {[testchannel refcount stdout] - $l1}] interp delete x lappend l [expr {[testchannel refcount stdout] - $l1}] } -result {0 1 0} test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} -setup { set l "" } -constraints {testchannel} -body { set l1 [testchannel refcount stderr] chan eof stdin interp create x lappend l [expr {[testchannel refcount stderr] - $l1}] x eval {chan eof stderr} lappend l [expr {[testchannel refcount stderr] - $l1}] interp delete x lappend l [expr {[testchannel refcount stderr] - $l1}] } -result {0 1 0} test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup { file delete -force $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] chan close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being chan closed" } string equal $l [list 1 "can not find channel named \"$f\""] } -result 1 test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup { file delete -force $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] interp create x interp share "" $f x lappend l [lindex [testchannel info $f] 15] x eval chan close $f lappend l [lindex [testchannel info $f] 15] interp delete x lappend l [lindex [testchannel info $f] 15] chan close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being chan closed" } string equal $l [list 1 2 1 1 "can not find channel named \"$f\""] } -result 1 test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] interp create x interp share "" $f x lappend l [lindex [testchannel info $f] 15] interp delete x lappend l [lindex [testchannel info $f] 15] chan close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being chan closed" } string equal $l [list 1 2 1 "can not find channel named \"$f\""] } -result 1 test chan-io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} { chan eof stdin } 0 test chan-io-19.2 {testing Tcl_GetChannel, user opened handle} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan eof $f } -cleanup { chan close $f } -result 0 test chan-io-19.3 {Tcl_GetChannel, channel not found} -body { chan eof file34 } -returnCodes error -result {can not find channel named "file34"} test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] lappend l [chan eof $f] chan close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being chan closed" } string equal $l [list 0 "can not find channel named \"$f\""] } -result 1 test chan-io-20.1 {Tcl_CreateChannel: initial settings} -setup { set old [encoding system] } -body { set a [open $path(test2) w] encoding system ascii set f [open $path(test1) w] chan configure $f -encoding } -cleanup { encoding system $old chan close $f chan close $a } -result {ascii} test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body { set f [open $path(test1) w+] list [chan configure $f -eofchar] [chan configure $f -translation] } -cleanup { chan close $f } -result [list [list \x1A ""] {auto crlf}] test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body { set f [open $path(test1) w+] list [chan configure $f -eofchar] [chan configure $f -translation] } -cleanup { chan close $f } -result {{{} {}} {auto lf}} test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup { set path(stdout) [makeFile {} stdout] } -constraints {stdio notWinCI} -body { set f [open $path(script) w] chan puts -nonewline $f { chan close stdout set f1 [} chan puts $f [list open $path(stdout) w]] chan puts $f { chan configure $f1 -buffersize 777 chan puts stderr [chan configure stdout -buffersize] } chan close $f set f [openpipe r $path(script)] chan close $f } -cleanup { removeFile $path(stdout) } -returnCodes error -result {777} test chan-io-21.1 {Chan CloseChannelsOnExit} emptyTest { } {} # Test management of attributes associated with a channel, such as its default # translation, its name and type, etc. The functions tested in this group are # Tcl_GetChannelName, Tcl_GetChannelType and Tcl_GetChannelFile. # Tcl_GetChannelInstanceData not tested because files do not use the instance # data. test chan-io-22.1 {Tcl_GetChannelMode} emptyTest { # Not used anywhere in Tcl. } {} test chan-io-23.1 {Tcl_GetChannelName} -constraints {testchannel} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] set n [testchannel name $f] expr {$n eq $f ? "ok" : "$n != $f"} } -cleanup { chan close $f } -result ok test chan-io-24.1 {Tcl_GetChannelType} -constraints {testchannel} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] testchannel type $f } -cleanup { chan close $f } -result "file" test chan-io-25.1 {Tcl_GetChannelHandle, input} -setup { set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f "1234567890\n098765432" chan close $f set f [open $path(test1) r] chan gets $f lappend l [testchannel inputbuffered $f] lappend l [chan tell $f] } -cleanup { chan close $f } -result {10 11} test chan-io-25.2 {Tcl_GetChannelHandle, output} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [chan tell $f] chan flush $f lappend l [testchannel outputbuffered $f] lappend l [chan tell $f] } -cleanup { chan close $f file delete $path(test1) } -result {6 6 0 6} test chan-io-26.1 {Tcl_GetChannelInstanceData} -body { # "pid" command uses Tcl_GetChannelInstanceData # Don't care what pid is (but must be a number), just want to exercise it. set f [openpipe r << exit] pid $f } -constraints stdio -cleanup { chan close $f } -match regexp -result {^\d+$} # Test flushing. The functions tested here are FlushChannel. test chan-io-27.1 {FlushChannel, no output buffered} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan flush $f file size $path(test1) } -cleanup { chan close $f } -result 0 test chan-io-27.2 {FlushChannel, some output buffered} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f hello lappend l [file size $path(test1)] chan flush $f lappend l [file size $path(test1)] chan close $f lappend l [file size $path(test1)] } -result {0 6 6} test chan-io-27.3 {FlushChannel, implicit flush on chan close} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f hello lappend l [file size $path(test1)] chan close $f lappend l [file size $path(test1)] } -result {0 6} test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan configure $f -buffersize 60 lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { chan puts $f hello } lappend l [file size $path(test1)] chan flush $f lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {0 60 72} test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup { file delete $path(test1) set l "" } -constraints {unixOrWin} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffersize 60 -eofchar {} lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { chan puts $f hello } lappend l [file size $path(test1)] chan close $f lappend l [file size $path(test1)] } -result {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup { file delete $path(pipe) file delete $path(output) } -constraints {stdio asyncPipeChan Close} -body { set f [open $path(pipe) w] chan puts $f "set f \[[list open $path(output) w]]" chan puts $f { chan configure $f -translation lf -buffering none -eofchar {} while {![chan eof stdin]} { after 20 chan puts -nonewline $f [chan read stdin 1024] } chan close $f } chan close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] chan close $f set f [openpipe w $path(pipe)] chan configure $f -blocking off chan puts -nonewline $f $x chan close $f set counter 0 while {([file size $path(output)] < 65536) && ($counter < 1000)} { after 20 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } if {$counter == 1000} { set result "file size only [file size $path(output)]" } else { set result ok } } -result ok # Tests closing a channel. The functions tested are Chan CloseChannel and # Tcl_Chan Close. test chan-io-28.1 {Chan CloseChannel called when all references are dropped} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] interp create x interp share "" $f x lappend l [testchannel refcount $f] x eval chan close $f interp delete x lappend l [testchannel refcount $f] } -cleanup { chan close $f } -result {2 1} test chan-io-28.2 {Chan CloseChannel called when all references are dropped} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] interp create x interp share "" $f x chan puts -nonewline $f abc chan close $f x eval chan puts $f def x eval chan close $f interp delete x set f [open $path(test1) r] chan gets $f } -cleanup { chan close $f } -result abcdef test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} -setup { file delete $path(pipe) file delete $path(output) } -constraints {stdio asyncPipeChan Close nonPortable} -body { set f [open $path(pipe) w] chan puts $f { # Need to not have eof char appended on chan close, because the other # side of the pipe already chan closed, so that writing would cause an # error "invalid file". chan configure stdout -eofchar {} chan configure stderr -eofchar {} set f [open $path(output) w] chan configure $f -translation lf -buffering none for {set x 0} {$x < 20} {incr x} { after 20 chan puts -nonewline $f [chan read stdin 1024] } chan close $f } chan close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] chan close $f set f [openpipe r+ $path(pipe)] chan configure $f -blocking off -eofchar {} chan puts -nonewline $f $x chan close $f set counter 0 while {([file size $path(output)] < 20480) && ($counter < 1000)} { after 20 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } if {$counter == 1000} { set result probably_broken } else { set result ok } } -result ok test chan-io-28.4 {Tcl_Chan Close} -constraints {testchannel} -setup { file delete $path(test1) set l "" } -body { lappend l [lsort [testchannel open]] set f [open $path(test1) w] lappend l [lsort [testchannel open]] chan close $f lappend l [lsort [testchannel open]] set x [list $consoleFileNames \ [lsort [list {*}$consoleFileNames $f]] \ $consoleFileNames] expr {$l eq $x ? "ok" : "{$l} != {$x}"} } -result ok test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup { file delete $path(script) } -constraints {stdio unix testchannel} -body { set f [open $path(script) w] chan puts $f { chan close stdin chan puts [testchannel open] } chan close $f set f [openpipe r $path(script)] set l [chan gets $f] chan close $f lsort $l } -result {file1 file2} test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} -setup { set cat [makeFile { fconfigure stdout -buffering line while {[gets stdin line] >= 0} {puts $line} puts DONE exit 0 } cat.tcl] variable done } -body { set ff [openpipe r+ $cat] puts $ff Hey close $ff w set timer [after 1000 [namespace code {set done Failed}]] set acc {} fileevent $ff readable [namespace code { if {[gets $ff line] < 0} { set done Succeeded } else { lappend acc $line } }] vwait [namespace which -variable done] after cancel $timer close $ff r list $done $acc } -cleanup { removeFile cat.tcl } -result {Succeeded {Hey DONE}} test chan-io-28.7 {Tcl_CloseEx (half-close) socket} -setup { set echo [makeFile { proc accept {s args} {set ::sok $s} set s [socket -server accept 0] puts [lindex [fconfigure $s -sockname] 2] flush stdout vwait ::sok fconfigure $sok -buffering line while {[gets $sok line]>=0} {puts $sok $line} puts $sok DONE exit 0 } echo.tcl] variable done unset -nocomplain done set done "" set timer "" set ff [openpipe r $echo] gets $ff port } -body { set s [socket 127.0.0.1 $port] puts $s Hey close $s w set timer [after 1000 [namespace code {set done Failed}]] set acc {} fileevent $s readable [namespace code { if {[gets $s line]<0} { set done Succeeded } else { lappend acc $line } }] vwait [namespace which -variable done] list $done $acc } -cleanup { catch {close $s} close $ff after cancel $timer removeFile echo.tcl } -result {Succeeded {Hey DONE}} test chan-io-29.1 {Tcl_WriteChars, channel not writable} -body { chan puts stdin hello } -returnCodes error -result {channel "stdin" wasn't opened for writing} test chan-io-29.2 {Tcl_WriteChars, empty string} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -eofchar {} chan puts -nonewline $f "" chan close $f file size $path(test1) } -result 0 test chan-io-29.3 {Tcl_WriteChars, nonempty string} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -eofchar {} chan puts -nonewline $f hello chan close $f file size $path(test1) } -result 5 test chan-io-29.4 {Tcl_WriteChars, buffering in full buffering mode} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering full -eofchar {} chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {6 0 0 6} test chan-io-29.5 {Tcl_WriteChars, buffering in line buffering mode} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering line -eofchar {} chan puts -nonewline $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {5 0 0 11} test chan-io-29.6 {Tcl_WriteChars, buffering in no buffering mode} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering none -eofchar {} chan puts -nonewline $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {0 5 0 11} test chan-io-29.7 {Tcl_Flush, full buffering} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering full -eofchar {} chan puts -nonewline $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {5 0 11 0 0 11} test chan-io-29.8 {Tcl_Flush, full buffering} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering line chan puts -nonewline $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {5 0 0 5 0 11 0 11} test chan-io-29.9 {Tcl_Flush, channel not writable} -body { chan flush stdin } -returnCodes error -result {channel "stdin" wasn't opened for writing} test chan-io-29.10 {Tcl_WriteChars, looping and buffering} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { chan puts $f1 [chan gets $f2] } chan close $f2 chan close $f1 file size $path(test1) } -result 387 test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -eofchar {} set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { chan puts -nonewline $f1 [chan gets $f2] } chan close $f1 chan close $f2 file size $path(test1) } -result 377 test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup { file delete $path(test1) file delete $path(pipe) } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 "set f1 \[[list open $path(longfile) r]]" chan puts $f1 { for {set x 0} {$x < 10} {incr x} { chan puts [chan gets $f1] } } chan close $f1 set f1 [openpipe r $path(pipe)] set f2 [open $path(longfile) r] set y ok for {set x 0} {$x < 10} {incr x} { set l1 [chan gets $f1] set l2 [chan gets $f2] if {$l1 ne $l2} { set y broken:$x } } return $y } -cleanup { chan close $f1 chan close $f2 } -result ok test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} -setup { file delete $path(test1) file delete $path(pipe) } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 { chan puts [chan gets stdin] chan puts [chan gets stdin] } chan close $f1 set y ok set f1 [openpipe r+ $path(pipe)] chan configure $f1 -buffering line set f2 [open $path(longfile) r] set line [chan gets $f2] chan puts $f1 $line set backline [chan gets $f1] if {$line ne $backline} { set y broken1 } set line [chan gets $f2] chan puts $f1 $line set backline [chan gets $f1] if {$line ne $backline} { set y broken2 } return $y } -cleanup { chan close $f1 chan close $f2 } -result ok test chan-io-29.14 {Tcl_WriteChars, buffering and implicit flush at chan close} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan puts -nonewline $f "Text1" chan puts -nonewline $f " Text 2" chan puts $f " Text 3" chan close $f set f [open $path(test3) r] chan gets $f } -cleanup { chan close $f } -result {Text1 Text 2 Text 3} test chan-io-29.15 {Tcl_Flush, channel not open for writing} -setup { file delete $path(test1) set fd [open $path(test1) w] chan close $fd } -body { set fd [open $path(test1) r] chan flush $fd } -returnCodes error -cleanup { catch {chan close $fd} } -match glob -result {channel "*" wasn't opened for writing} test chan-io-29.16 {Tcl_Flush on pipe opened only for reading} -setup { set fd [openpipe r cat longfile] } -constraints stdio -body { chan flush $fd } -returnCodes error -cleanup { catch {chan close $fd} } -match glob -result {channel "*" wasn't opened for writing} test chan-io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 hello chan puts $f1 hello chan puts $f1 hello chan flush $f1 file size $path(test1) } -cleanup { chan close $f1 } -result 18 test chan-io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} -setup { file delete $path(test1) set x "" set f1 [open $path(test1) w] } -body { chan configure $f1 -translation lf chan puts $f1 hello chan puts $f1 hello chan puts $f1 hello chan flush $f1 lappend x [file size $path(test1)] chan puts $f1 hello chan flush $f1 lappend x [file size $path(test1)] chan puts $f1 hello chan flush $f1 lappend x [file size $path(test1)] } -cleanup { chan close $f1 } -result {18 24 30} test chan-io-29.19 {Explicit and implicit flushes} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} set x "" chan puts $f1 hello chan puts $f1 hello chan puts $f1 hello chan flush $f1 lappend x [file size $path(test1)] chan puts $f1 hello chan flush $f1 lappend x [file size $path(test1)] chan puts $f1 hello chan close $f1 lappend x [file size $path(test1)] } -result {18 24 30} test chan-io-29.20 {Implicit flush when buffer is full} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" for {set x 0} {$x < 100} {incr x} { chan puts $f1 $line } set z "" lappend z [file size $path(test1)] for {set x 0} {$x < 100} {incr x} { chan puts $f1 $line } lappend z [file size $path(test1)] chan close $f1 lappend z [file size $path(test1)] } -result {4096 12288 12600} test chan-io-29.21 {Tcl_Flush to pipe} -setup { file delete $path(pipe) } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 {set x [chan read stdin 6]} chan puts $f1 {set cnt [string length $x]} chan puts $f1 {chan puts "read $cnt characters"} chan close $f1 set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello chan flush $f1 chan gets $f1 } -cleanup { catch {chan close $f1} } -result "read 6 characters" test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup { file delete $path(pipe) } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 { chan configure stdout -buffering full chan puts hello chan puts hello chan flush stdout chan gets stdin chan puts bye chan flush stdout } chan close $f1 set f1 [openpipe r+ $path(pipe)] set x "" lappend x [chan gets $f1] lappend x [chan gets $f1] chan puts $f1 hello chan flush $f1 lappend x [chan gets $f1] } -cleanup { chan close $f1 } -result {hello hello bye} test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} -setup { file delete $path(pipe) } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 { chan puts hello chan puts hello chan gets stdin chan puts bye } chan close $f1 set f1 [openpipe r+ $path(pipe)] set x "" lappend x [chan gets $f1] lappend x [chan gets $f1] chan puts $f1 hello chan flush $f1 lappend x [chan gets $f1] } -cleanup { chan close $f1 } -result {hello hello bye} test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} -setup { variable x {} } -body { set f [open $path(test3) w] chan puts $f "Line 1" chan puts $f "Line 2" set f2 [open $path(test3)] lappend x [chan read -nonewline $f2] chan close $f2 chan flush $f set f2 [open $path(test3)] lappend x [chan read -nonewline $f2] } -cleanup { chan close $f2 chan close $f } -result "{} {Line 1\nLine 2}" test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup { file delete $path(test3) } -constraints {stdio fileevent} -body { set f [openpipe w $path(cat) | [interpreter] $path(cat) > $path(test3)] chan puts $f "Line 1" chan puts $f "Line 2" chan close $f after 100 set f [open $path(test3) r] chan read $f } -cleanup { chan close $f } -result "Line 1\nLine 2\n" test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs} -body { set f [open "|[list cat -u]" r+] chan puts $f "Line1" chan flush $f chan gets $f } -cleanup { chan close $f } -result {Line1} test chan-io-29.27 {Tcl_Flush on chan closed pipeline} -setup { file delete $path(pipe) set f [open $path(pipe) w] chan puts $f {exit} chan close $f } -constraints stdio -body { set f [openpipe r+ $path(pipe)] chan gets $f chan puts $f output after 50 # # The flush below will get a SIGPIPE. This is an expected part of the test # and indicates that the test operates correctly. If you run this test # under a debugger, the signal will by intercepted unless you disable the # debugger's signal interception. # if {[catch {chan flush $f} msg]} { set x [list 1 $msg $::errorCode] catch {chan close $f} } elseif {[catch {chan close $f} msg]} { set x [list 1 $msg $::errorCode] } else { set x {this was supposed to fail and did not} } string tolower $x } -match glob -result {1 {error flushing "*": broken pipe} {posix epipe {broken pipe}}} test chan-io-29.28 {Tcl_WriteChars, lf mode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f hello\nthere\nand\nhere chan flush $f file size $path(test1) } -cleanup { chan close $f } -result 21 test chan-io-29.29 {Tcl_WriteChars, cr mode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr -eofchar {} chan puts $f hello\nthere\nand\nhere chan close $f file size $path(test1) } -result 21 test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf -eofchar {} chan puts $f hello\nthere\nand\nhere chan close $f file size $path(test1) } -result 25 test chan-io-29.31 {Tcl_WriteChars, background flush} -setup { file delete $path(pipe) file delete $path(output) } -constraints stdio -body { set f [open $path(pipe) w] chan puts $f "set f \[[list open $path(output) w]]" chan puts $f {chan configure $f -translation lf} set x [list while {![chan eof stdin]}] set x "$x {" chan puts $f $x chan puts $f { chan puts -nonewline $f [chan read stdin 4096]} chan puts $f { chan flush $f} chan puts $f "}" chan puts $f {chan close $f} chan close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] chan close $f set f [openpipe r+ $path(pipe)] chan configure $f -blocking off chan puts -nonewline $f $x chan close $f set counter 0 while {([file size $path(output)] < 65536) && ($counter < 1000)} { after 10 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } if {$counter == 1000} { set result "file size only [file size $path(output)]" } else { set result ok } # allow a little time for the background process to chan close. # otherwise, the following test fails on the [file delete $path(output)] # on Windows because a process still has the file open. after 100 set v 1; vwait v return $result } -result ok test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} -setup { file delete $path(pipe) file delete $path(output) } -constraints {stdio asyncPipeChan Close} -body { set f [open $path(pipe) w] chan puts $f "set f \[[list open $path(output) w]]" chan puts $f {chan configure $f -translation lf} set x [list while {![chan eof stdin]}] set x "$x \{" chan puts $f $x chan puts $f { after 20} chan puts $f { chan puts -nonewline $f [chan read stdin 1024]} chan puts $f { chan flush $f} chan puts $f "\}" chan puts $f {chan close $f} chan close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] chan close $f set f [openpipe r+ $path(pipe)] chan configure $f -blocking off chan puts -nonewline $f $x chan close $f set counter 0 while {([file size $path(output)] < 65536) && ($counter < 1000)} { after 20 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } if {$counter == 1000} { set result "file size only [file size $path(output)]" } else { set result ok } } -result ok test chan-io-29.33 {Tcl_Flush, implicit flush on exit} -setup { set f [open $path(script) w] chan puts $f "set f \[[list open $path(test1) w]]" chan puts $f {chan configure $f -translation lf chan puts $f hello chan puts $f bye chan puts $f strange } chan close $f } -constraints exec -body { exec [interpreter] $path(script) set f [open $path(test1) r] chan read $f } -cleanup { chan close $f } -result "hello\nbye\nstrange\n" test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -setup { variable c 0 variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } } -constraints {socket tempNotMac fileevent notWinCI} -body { proc accept {s a p} { variable x chan event $s readable [namespace code [list readit $s]] chan configure $s -blocking off set x accepted } proc readit {s} { variable c variable x set l [chan gets $s] if {[chan eof $s]} { chan close $s set x done } elseif {([string length $l] > 0) || ![chan blocked $s]} { incr c } } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]] vwait [namespace which -variable x] chan configure $cs -blocking off writelots $cs $l chan close $cs chan close $ss vwait [namespace which -variable x] set c } -result 2000 test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} -setup { catch {interp delete x} catch {interp delete y} } -constraints {socket tempNotMac fileevent} -body { # On Mac, this test screws up sockets such that subsequent tests using # port 2828 either cause errors or panic(). interp create x interp create y set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] proc accept {s a p} { chan puts $s hello chan close $s } set c [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]] interp share {} $c x interp share {} $c y chan close $c x eval { proc readit {s} { chan gets $s if {[chan eof $s]} { chan close $s } } } y eval { proc readit {s} { chan gets $s if {[chan eof $s]} { chan close $s } } } x eval "chan event $c readable \{readit $c\}" y eval "chan event $c readable \{readit $c\}" y eval [list chan close $c] update } -cleanup { chan close $s interp delete x interp delete y } -result "" # Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read. test chan-io-30.1 {Tcl_Write lf, Tcl_Read lf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation lf chan read $f } -cleanup { chan close $f } -result "hello\nthere\nand\nhere\n" test chan-io-30.2 {Tcl_Write lf, Tcl_Read cr} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation cr chan read $f } -cleanup { chan close $f } -result "hello\nthere\nand\nhere\n" test chan-io-30.3 {Tcl_Write lf, Tcl_Read crlf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation crlf chan read $f } -cleanup { chan close $f } -result "hello\nthere\nand\nhere\n" test chan-io-30.4 {Tcl_Write cr, Tcl_Read cr} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation cr chan read $f } -cleanup { chan close $f } -result "hello\nthere\nand\nhere\n" test chan-io-30.5 {Tcl_Write cr, Tcl_Read lf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation lf chan read $f } -cleanup { chan close $f } -result "hello\rthere\rand\rhere\r" test chan-io-30.6 {Tcl_Write cr, Tcl_Read crlf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation crlf chan read $f } -cleanup { chan close $f } -result "hello\rthere\rand\rhere\r" test chan-io-30.7 {Tcl_Write crlf, Tcl_Read crlf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation crlf chan read $f } -cleanup { chan close $f } -result "hello\nthere\nand\nhere\n" test chan-io-30.8 {Tcl_Write crlf, Tcl_Read lf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation lf chan read $f } -cleanup { chan close $f } -result "hello\r\nthere\r\nand\r\nhere\r\n" test chan-io-30.9 {Tcl_Write crlf, Tcl_Read cr} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation cr chan read $f } -cleanup { chan close $f } -result "hello\n\nthere\n\nand\n\nhere\n\n" test chan-io-30.10 {Tcl_Write lf, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] list [chan read $f] [chan configure $f -translation] } -cleanup { chan close $f } -result {{hello there and here } auto} test chan-io-30.11 {Tcl_Write cr, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] list [chan read $f] [chan configure $f -translation] } -cleanup { chan close $f } -result {{hello there and here } auto} test chan-io-30.12 {Tcl_Write crlf, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] list [chan read $f] [chan configure $f -translation] } -cleanup { chan close $f } -result {{hello there and here } auto} test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf chan puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { chan puts $f $line } chan close $f set f [open $path(test1) r] chan configure $f -translation auto string length [chan read $f] } -cleanup { chan close $f } -result [expr {700*15 + 1}] test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf chan puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { chan puts $f $line } chan close $f set f [open $path(test1) r] chan configure $f -translation crlf string length [chan read $f] } -cleanup { chan close $f } -result [expr {700*15 + 1}] test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] chan configure $f -translation auto chan read $f } -cleanup { chan close $f } -result {hello there and here } test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f hello\nthere\nand\rhere\n\x1A chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A chan read $f } -cleanup { chan close $f } -result {hello there and here } test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup { file delete $path(test1) } -constraints {win} -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar \x1A chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A chan read $f } -cleanup { chan close $f } -result {hello there and here } test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] chan puts $f $s chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A set l "" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1 {} 1} test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] chan puts $f $s chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A set l "" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1 {} 1} test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f [format "abc\ndef\n%cghi\nqrs" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation lf -eofchar {} lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "abc def 0 \x1Aghi 0 qrs 0 {} 1" test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f [format "abc\ndef\n%cghi\nqrs" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation cr -eofchar {} set x [chan gets $f] lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {1 1 {} 1} test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f [format "abc\ndef\n%cghi\nqrs" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation crlf -eofchar {} set x [chan gets $f] lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {1 1 {} 1} test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format abc\ndef\n%cqrs\ntuv 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {8 1} test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf set c [format abc\ndef\n%cqrs\ntuv 26] chan puts $f $c chan close $f set f [open $path(test1) r] chan configure $f -translation lf -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {8 1} test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr set c [format abc\ndef\n%cqrs\ntuv 26] chan puts $f $c chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {8 1} test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr set c [format abc\ndef\n%cqrs\ntuv 26] chan puts $f $c chan close $f set f [open $path(test1) r] chan configure $f -translation cr -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {8 1} test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf set c [format abc\ndef\n%cqrs\ntuv 26] chan puts $f $c chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {8 1} test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf set c [format abc\ndef\n%cqrs\ntuv 26] chan puts $f $c chan close $f set f [open $path(test1) r] chan configure $f -translation crlf -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {8 1} # Test end of line translations. Functions tested are Tcl_Write and # Tcl_Gets. test chan-io-31.1 {Tcl_Write lf, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] } -cleanup { chan close $f } -result {hello 6 auto there 12 auto} test chan-io-31.2 {Tcl_Write cr, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] } -cleanup { chan close $f } -result {hello 6 auto there 12 auto} test chan-io-31.3 {Tcl_Write crlf, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] } -cleanup { chan close $f } -result {hello 7 auto there 14 auto} test chan-io-31.4 {Tcl_Write lf, Tcl_Gets lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation lf lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] } -cleanup { chan close $f } -result {hello 6 lf there 12 lf} test chan-io-31.5 {Tcl_Write lf, Tcl_Gets cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation cr lappend l [string length [chan gets $f]] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] } -cleanup { chan close $f } -result {21 21 cr 1 {} 21 cr 1} test chan-io-31.6 {Tcl_Write lf, Tcl_Gets crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation crlf lappend l [string length [chan gets $f]] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] } -cleanup { chan close $f } -result {21 21 crlf 1 {} 21 crlf 1} test chan-io-31.7 {Tcl_Write cr, Tcl_Gets cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation cr lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello 6 cr 0 there 12 cr 0} test chan-io-31.8 {Tcl_Write cr, Tcl_Gets lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation lf lappend l [string length [chan gets $f]] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] } -cleanup { chan close $f } -result {21 21 lf 1 {} 21 lf 1} test chan-io-31.9 {Tcl_Write cr, Tcl_Gets crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation crlf lappend l [string length [chan gets $f]] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] } -cleanup { chan close $f } -result {21 21 crlf 1 {} 21 crlf 1} test chan-io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation crlf lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello 7 crlf 0 there 14 crlf 0} test chan-io-31.11 {Tcl_Write crlf, Tcl_Gets cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation cr lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] lappend l [string length [chan gets $f]] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello 6 cr 0 6 13 cr 0} test chan-io-31.12 {Tcl_Write crlf, Tcl_Gets lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation lf lappend l [string length [chan gets $f]] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] lappend l [string length [chan gets $f]] lappend l [chan tell $f] lappend l [chan configure $f -translation] lappend l [chan eof $f] } -cleanup { chan close $f } -result {6 7 lf 0 6 14 lf 0} test chan-io-31.13 {binary mode is synonym of lf mode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation binary chan configure $f -translation } -cleanup { chan close $f } -result lf # # Test chan-io-9.14 has been removed because "auto" output translation mode is # not supported. # test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\rand\r\nhere chan close $f set f [open $path(test1) r] chan configure $f -translation auto lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello there and here 0 {} 1} test chan-io-31.15 {Tcl_Write mixed, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f hello\nthere\rand\r\nhere\r chan close $f set f [open $path(test1) r] chan configure $f -translation auto lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello there and here 0 {} 1} test chan-io-31.16 {Tcl_Write mixed, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f hello\nthere\rand\r\nhere\n chan close $f set f [open $path(test1) r] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello there and here 0 {} 1} test chan-io-31.17 {Tcl_Write mixed, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f hello\nthere\rand\r\nhere\r\n chan close $f set f [open $path(test1) r] chan configure $f -translation auto lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello there and here 0 {} 1} test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello there and here 0 {} 1} test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar \x1A chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {hello there and here 0 {} 1} test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation lf -eofchar {} lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr -eofchar {} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation cr -eofchar {} lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf -eofchar {} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation crlf -eofchar {} lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation lf -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr -eofchar {} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr -eofchar {} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation cr -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf -eofchar {} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf -eofchar {} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation crlf -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup { file delete $path(test1) set c "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf chan puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { chan puts $f $line } chan close $f set f [open $path(test1) r] chan configure $f -translation crlf while {[chan gets $f line] >= 0} { append c $line\n } chan close $f string length $c } -result [expr {700*15 + 1}] test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup { file delete $path(test1) set c "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf chan puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { chan puts $f $line } chan close $f set f [open $path(test1) r] chan configure $f -translation auto while {[chan gets $f line] >= 0} { append c $line\n } chan close $f string length $c } -result [expr {700*15 + 1}] # Test Tcl_Read and buffering. test chan-io-32.1 {Tcl_Read, channel not readable} -body { read stdout } -returnCodes error -result {channel "stdout" wasn't opened for reading} test chan-io-32.2 {Tcl_Read, zero byte count} { chan read stdin 0 } "" test chan-io-32.3 {Tcl_Read, negative byte count} -setup { set f [open $path(longfile) r] } -body { chan read $f -1 } -returnCodes error -cleanup { chan close $f } -result {expected non-negative integer but got "-1"} test chan-io-32.4 {Tcl_Read, positive byte count} -body { set f [open $path(longfile) r] string length [chan read $f 1024] } -cleanup { chan close $f } -result 1024 test chan-io-32.5 {Tcl_Read, multiple buffers} -body { set f [open $path(longfile) r] chan configure $f -buffersize 100 string length [chan read $f 1024] } -cleanup { chan close $f } -result 1024 test chan-io-32.6 {Tcl_Read, very large read} { set f1 [open $path(longfile) r] set z [chan read $f1 1000000] chan close $f1 set l [string length $z] set x ok set z [file size $path(longfile)] if {$z != $l} { set x "$z != $l" } set x } ok test chan-io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} { set f1 [open $path(longfile) r] chan configure $f1 -blocking off set z [chan read $f1 20] chan close $f1 set l [string length $z] set x ok if {$l != 20} { set x "$l != 20" } set x } ok test chan-io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} { set f1 [open $path(longfile) r] chan configure $f1 -blocking off set z [chan read $f1 1000000] chan close $f1 set x ok set l [string length $z] set z [file size $path(longfile)] if {$z != $l} { set x "$z != $l" } set x } ok test chan-io-32.9 {Tcl_Read, read to end of file} { set f1 [open $path(longfile) r] set z [chan read $f1] chan close $f1 set l [string length $z] set x ok set z [file size $path(longfile)] if {$z != $l} { set x "$z != $l" } set x } ok test chan-io-32.10 {Tcl_Read from a pipe} -setup { file delete $path(pipe) } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 {chan puts [chan gets stdin]} chan close $f1 set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello chan flush $f1 chan read $f1 } -cleanup { chan close $f1 } -result "hello\n" test chan-io-32.11 {Tcl_Read from a pipe} -setup { file delete $path(pipe) set x "" } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 {chan puts [chan gets stdin]} chan puts $f1 {chan puts [chan gets stdin]} chan close $f1 set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello chan flush $f1 lappend x [chan read $f1 6] chan puts $f1 hello chan flush $f1 lappend x [chan read $f1] } -cleanup { chan close $f1 } -result {{hello } {hello }} test chan-io-32.12 {Tcl_Read, -nonewline} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan puts $f1 hello chan puts $f1 bye chan close $f1 set f1 [open $path(test1) r] chan read -nonewline $f1 } -cleanup { chan close $f1 } -result {hello bye} test chan-io-32.13 {Tcl_Read, -nonewline} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan puts $f1 hello chan puts $f1 bye chan close $f1 set f1 [open $path(test1) r] set c [chan read -nonewline $f1] list [string length $c] $c } -cleanup { chan close $f1 } -result {9 {hello bye}} test chan-io-32.14 {Tcl_Read, reading in small chunks} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan puts $f "Two lines: this one" chan puts $f "and this one" chan close $f set f [open $path(test1)] list [chan read $f 1] [chan read $f 2] [chan read $f] } -cleanup { chan close $f } -result {T wo { lines: this one and this one }} test chan-io-32.15 {Tcl_Read, asking for more input than available} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan puts $f "Two lines: this one" chan puts $f "and this one" chan close $f set f [open $path(test1)] chan read $f 100 } -cleanup { chan close $f } -result {Two lines: this one and this one } test chan-io-32.16 {Tcl_Read, read to end of file with -nonewline} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan puts $f "Two lines: this one" chan puts $f "and this one" chan close $f set f [open $path(test1)] chan read -nonewline $f } -cleanup { chan close $f } -result {Two lines: this one and this one} # Test Tcl_Gets. test chan-io-33.1 {Tcl_Gets, reading what was written} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan puts $f1 "first line" chan close $f1 set f1 [open $path(test1) r] chan gets $f1 } -cleanup { chan close $f1 } -result {first line} test chan-io-33.2 {Tcl_Gets into variable} { set f1 [open $path(longfile) r] set c [chan gets $f1 x] set l [string length x] set z ok if {$l != $l} { set z broken } chan close $f1 set z } ok test chan-io-33.3 {Tcl_Gets from pipe} -setup { file delete $path(pipe) } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 {chan puts [chan gets stdin]} chan close $f1 set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello chan flush $f1 chan gets $f1 } -cleanup { chan close $f1 } -result hello test chan-io-33.4 {Tcl_Gets with long line} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" chan puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" chan close $f set f [open $path(test3)] chan gets $f } -cleanup { chan close $f } -result {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} test chan-io-33.5 {Tcl_Gets with long line} -setup { set f [open $path(test3) w] puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f } -body { set f [open $path(test3)] set x [chan gets $f y] chan close $f list $x $y } -result {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} test chan-io-33.6 {Tcl_Gets and end of file} -setup { file delete $path(test3) set x {} } -body { set f [open $path(test3) w] chan puts -nonewline $f "Test1\nTest2" chan close $f set f [open $path(test3)] set y {} lappend x [chan gets $f y] $y set y {} lappend x [chan gets $f y] $y set y {} lappend x [chan gets $f y] $y } -cleanup { chan close $f } -result {5 Test1 5 Test2 -1 {}} test chan-io-33.7 {Tcl_Gets and bad variable} -setup { set f [open $path(test3) w] chan puts $f "Line 1" chan puts $f "Line 2" chan close $f catch {unset x} set f [open $path(test3) r] } -body { set x 24 chan gets $f x(0) } -returnCodes error -cleanup { chan close $f } -result {can't set "x(0)": variable isn't array} test chan-io-33.8 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] chan configure $f -translation lf -eofchar {} set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 100} {incr y} {chan puts $f $x} chan close $f set f [open $path(test3) r] chan configure $f -translation lf for {set y 0} {$y < 100} {incr y} {chan gets $f} chan close $f set y } 100 test chan-io-33.9 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] chan configure $f -translation lf -eofchar {} set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 200} {incr y} {chan puts $f $x} chan close $f set f [open $path(test3) r] chan configure $f -translation lf for {set y 0} {$y < 200} {incr y} {chan gets $f} chan close $f set y } 200 test chan-io-33.10 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] chan configure $f -translation lf -eofchar {} set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 300} {incr y} {chan puts $f $x} chan close $f set f [open $path(test3) r] chan configure $f -translation lf for {set y 0} {$y < 300} {incr y} {chan gets $f} chan close $f set y } 300 # Test Tcl_Seek and Tcl_Tell. test chan-io-34.1 {Tcl_Seek to current position at start of file} -body { set f1 [open $path(longfile) r] chan seek $f1 0 current chan tell $f1 } -cleanup { chan close $f1 } -result 0 test chan-io-34.2 {Tcl_Seek to offset from start} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 10 start chan tell $f1 } -cleanup { chan close $f1 } -result 10 test chan-io-34.3 {Tcl_Seek to end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 0 end chan tell $f1 } -cleanup { chan close $f1 } -result 54 test chan-io-34.4 {Tcl_Seek to offset from end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 -10 end chan tell $f1 } -cleanup { chan close $f1 } -result 44 test chan-io-34.5 {Tcl_Seek to offset from current position} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 10 current chan seek $f1 10 current chan tell $f1 } -cleanup { chan close $f1 } -result 20 test chan-io-34.6 {Tcl_Seek to offset from end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 -10 end list [chan tell $f1] [chan read $f1] } -cleanup { chan close $f1 } -result {44 {rstuvwxyz }} test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 -10 end set c1 [chan tell $f1] set r1 [chan read $f1 5] chan seek $f1 0 current list $c1 $r1 [chan tell $f1] } -cleanup { chan close $f1 } -result {44 rstuv 49} test chan-io-34.8 {Tcl_Seek on pipes: not supported} -setup { set pipe [openpipe] } -constraints stdio -body { chan seek $pipe 0 current } -returnCodes error -cleanup { chan close $pipe } -match glob -result {error during seek on "*": invalid argument} test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan configure $f -eofchar {} chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" chan close $f set f [open $path(test3) RDWR] set x [chan read $f 1] chan seek $f 3 lappend x [chan read $f 1] chan seek $f 0 start lappend x [chan read $f 1] chan seek $f 10 current lappend x [chan read $f 1] chan seek $f -2 end lappend x [chan read $f 1] chan seek $f 50 end lappend x [chan read $f 1] chan seek $f 1 lappend x [chan read $f 1] } -cleanup { chan close $f } -result {a d a l Y {} b} set path(test3) [makeFile {} test3] test chan-io-34.10 {Tcl_Seek testing flushing of buffered input} { set f [open $path(test3) w] chan configure $f -translation lf chan puts $f xyz\n123 chan close $f set f [open $path(test3) r+] chan configure $f -translation lf set x [chan gets $f] chan seek $f 0 current chan puts $f 456 chan close $f list $x [viewFile test3] } "xyz {xyz 456}" test chan-io-34.11 {Tcl_Seek testing flushing of buffered output} { set f [open $path(test3) w] chan puts $f xyz\n123 chan close $f set f [open $path(test3) w+] chan puts $f xyzzy chan seek $f 2 set x [chan gets $f] chan close $f list $x [viewFile test3] } "zzy xyzzy" test chan-io-34.12 {Tcl_Seek testing combination of write, seek back and read} { set f [open $path(test3) w] chan configure $f -translation lf -eofchar {} chan puts $f xyz\n123 chan close $f set f [open $path(test3) a+] chan configure $f -translation lf -eofchar {} chan puts $f xyzzy chan flush $f set x [chan tell $f] chan seek $f -4 cur set y [chan gets $f] chan close $f list $x [viewFile test3] $y } {14 {xyz 123 xyzzy} zzy} test chan-io-34.13 {Tcl_Tell at start of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan tell $f1 } -cleanup { chan close $f1 } -result 0 test chan-io-34.14 {Tcl_Tell after seek to end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 0 end chan tell $f1 } -cleanup { chan close $f1 } -result 54 test chan-io-34.15 {Tcl_Tell combined with seeking} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -eofchar {} chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 10 start set c1 [chan tell $f1] chan seek $f1 10 current list $c1 [chan tell $f1] } -cleanup { chan close $f1 } -result {10 20} test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints stdio -body { set f1 [openpipe] chan tell $f1 } -cleanup { chan close $f1 } -result -1 test chan-io-34.17 {Tcl_Tell on pipe: always -1} stdio { set f1 [openpipe] chan puts $f1 {chan puts hello} chan flush $f1 set c [chan tell $f1] chan gets $f1 chan close $f1 set c } -1 test chan-io-34.18 {Tcl_Tell combined with seeking and reading} -setup { file delete $path(test2) } -body { set f [open $path(test2) w] chan configure $f -translation lf -eofchar {} chan puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n" chan close $f set f [open $path(test2)] chan configure $f -translation lf set x [chan tell $f] chan read $f 3 lappend x [chan tell $f] chan seek $f 2 lappend x [chan tell $f] chan seek $f 10 current lappend x [chan tell $f] chan seek $f 0 end lappend x [chan tell $f] } -cleanup { chan close $f } -result {0 3 2 12 30} test chan-io-34.19 {Tcl_Tell combined with opening in append mode} -body { set f [open $path(test3) w] chan configure $f -translation lf -eofchar {} chan puts $f "abcdefghijklmnopqrstuvwxyz" chan puts $f "abcdefghijklmnopqrstuvwxyz" chan close $f set f [open $path(test3) a] chan tell $f } -cleanup { chan close $f } -result 54 test chan-io-34.20 {Tcl_Tell combined with writing} -setup { set l "" } -body { set f [open $path(test3) w] chan seek $f 29 start lappend l [chan tell $f] chan puts -nonewline $f a chan seek $f 39 start lappend l [chan tell $f] chan puts -nonewline $f a lappend l [chan tell $f] chan seek $f 407 end lappend l [chan tell $f] } -cleanup { chan close $f } -result {29 39 40 447} test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} -setup { file delete $path(test3) set l "" } -constraints {largefileSupport} -body { set f [open $path(test3) w] chan configure $f -encoding binary lappend l [chan tell $f] chan puts -nonewline $f abcdef lappend l [chan tell $f] chan flush $f lappend l [chan tell $f] # 4GB offset! chan seek $f 0x100000000 lappend l [chan tell $f] chan puts -nonewline $f abcdef lappend l [chan tell $f] chan close $f lappend l [file size $path(test3)] # truncate... chan close [open $path(test3) w] lappend l [file size $path(test3)] } -result {0 6 6 4294967296 4294967302 4294967302 0} # Test Tcl_Eof test chan-io-35.1 {Tcl_Eof} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan puts $f hello chan puts $f hello chan close $f set f [open $path(test1)] set x [chan eof $f] lappend x [chan eof $f] chan gets $f lappend x [chan eof $f] chan gets $f lappend x [chan eof $f] chan gets $f lappend x [chan eof $f] lappend x [chan eof $f] } -cleanup { chan close $f } -result {0 0 0 0 1 1} test chan-io-35.2 {Tcl_Eof with pipe} -constraints stdio -setup { file delete $path(pipe) } -body { set f1 [open $path(pipe) w] chan puts $f1 {chan gets stdin} chan puts $f1 {chan puts hello} chan close $f1 set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello set x [chan eof $f1] chan flush $f1 lappend x [chan eof $f1] chan gets $f1 lappend x [chan eof $f1] chan gets $f1 lappend x [chan eof $f1] } -cleanup { chan close $f1 } -result {0 0 0 1} test chan-io-35.3 {Tcl_Eof with pipe} -constraints stdio -setup { file delete $path(pipe) } -body { set f1 [open $path(pipe) w] chan puts $f1 {chan gets stdin} chan puts $f1 {chan puts hello} chan close $f1 set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello set x [chan eof $f1] chan flush $f1 lappend x [chan eof $f1] chan gets $f1 lappend x [chan eof $f1] chan gets $f1 lappend x [chan eof $f1] chan gets $f1 lappend x [chan eof $f1] chan gets $f1 lappend x [chan eof $f1] } -cleanup { chan close $f1 } -result {0 0 0 1 1 1} test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} -setup { file delete $path(test1) set l "" } -constraints {nonBlockFiles} -body { chan close [open $path(test1) w] set f [open $path(test1) r] chan configure $f -blocking off lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {{} 1} test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} -setup { file delete $path(pipe) set l "" } -constraints stdio -body { set f [open $path(pipe) w] chan puts $f { exit } chan close $f set f [openpipe r $path(pipe)] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {{} 1} test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {9 8 1} test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation lf -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {9 8 1} test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {9 8 1} test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation cr -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {9 8 1} test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {11 8 1} test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation crlf -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {11 8 1} test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {17 8 1} test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf -eofchar {} chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation lf -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {17 8 1} test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr -eofchar {} chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {17 8 1} test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr -eofchar {} chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation cr -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {17 8 1} test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf -eofchar {} chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {21 8 1} test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf -eofchar {} chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation crlf -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {21 8 1} # Test Tcl_InputBlocked test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup { set x "" } -constraints stdio -body { set f1 [openpipe] chan puts $f1 {chan puts hello_from_pipe} chan flush $f1 chan gets $f1 chan configure $f1 -blocking off -buffering full chan puts $f1 {chan puts hello} lappend x [chan gets $f1] lappend x [chan blocked $f1] chan flush $f1 after 200 lappend x [chan gets $f1] lappend x [chan blocked $f1] lappend x [chan gets $f1] lappend x [chan blocked $f1] } -cleanup { chan close $f1 } -result {{} 1 hello 0 {} 1} test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} -setup { set x "" } -constraints stdio -body { set f1 [openpipe] chan configure $f1 -buffering line chan puts $f1 {chan puts hello_from_pipe} lappend x [chan gets $f1] lappend x [chan blocked $f1] chan puts $f1 {exit} lappend x [chan gets $f1] lappend x [chan blocked $f1] lappend x [chan eof $f1] } -cleanup { chan close $f1 } -result {hello_from_pipe 0 {} 0 1} test chan-io-36.3 {Tcl_InputBlocked vs files, short read} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan puts $f abcdefghijklmnop chan close $f set f [open $path(test1) r] lappend l [chan blocked $f] lappend l [chan read $f 3] lappend l [chan blocked $f] lappend l [chan read -nonewline $f] lappend l [chan blocked $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {0 abc 0 defghijklmnop 0 1} test chan-io-36.4 {Tcl_InputBlocked vs files, event driven read} -setup { file delete $path(test1) set l "" variable x } -constraints {fileevent} -body { set f [open $path(test1) w] chan puts $f abcdefghijklmnop chan close $f set f [open $path(test1) r] chan event $f readable [namespace code { lappend l [chan read $f 3] if {[chan eof $f]} {lappend l eof; chan close $f; set x done} }] vwait [namespace which -variable x] return $l } -result {abc def ghi jkl mno {p } eof} test chan-io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} -setup { file delete $path(test1) set l "" } -constraints {nonBlockFiles} -body { set f [open $path(test1) w] chan puts $f abcdefghijklmnop chan close $f set f [open $path(test1) r] chan configure $f -blocking off lappend l [chan blocked $f] lappend l [chan read $f 3] lappend l [chan blocked $f] lappend l [chan read -nonewline $f] lappend l [chan blocked $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {0 abc 0 defghijklmnop 0 1} test chan-io-36.6 {Tcl_InputBlocked vs files, event driven read} -setup { file delete $path(test1) set l "" variable x } -constraints {nonBlockFiles fileevent} -body { set f [open $path(test1) w] chan puts $f abcdefghijklmnop chan close $f set f [open $path(test1) r] chan configure $f -blocking off chan event $f readable [namespace code { lappend l [chan read $f 3] if {[chan eof $f]} {lappend l eof; chan close $f; set x done} }] vwait [namespace which -variable x] return $l } -result {abc def ghi jkl mno {p } eof} # Test Tcl_InputBuffered test chan-io-37.1 {Tcl_InputBuffered} -setup { set l "" } -constraints {testchannel} -body { set f [open $path(longfile) r] chan configure $f -buffersize 4096 chan read $f 3 lappend l [testchannel inputbuffered $f] lappend l [chan tell $f] } -cleanup { chan close $f } -result {4093 3} test chan-io-37.2 {Tcl_InputBuffered, test input flushing on seek} -setup { set l "" } -constraints {testchannel} -body { set f [open $path(longfile) r] chan configure $f -buffersize 4096 chan read $f 3 lappend l [testchannel inputbuffered $f] lappend l [chan tell $f] chan seek $f 0 current lappend l [testchannel inputbuffered $f] lappend l [chan tell $f] } -cleanup { chan close $f } -result {4093 3 0 3} # Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize test chan-io-38.1 {Tcl_GetChannelBufferSize, default buffer size} -body { set f [open $path(longfile) r] chan configure $f -buffersize } -cleanup { chan close $f } -result 4096 test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} -setup { set l "" } -body { set f [open $path(longfile) r] lappend l [chan configure $f -buffersize] chan configure $f -buffersize 10000 lappend l [chan configure $f -buffersize] chan configure $f -buffersize 1 lappend l [chan configure $f -buffersize] chan configure $f -buffersize -1 lappend l [chan configure $f -buffersize] chan configure $f -buffersize 0 lappend l [chan configure $f -buffersize] chan configure $f -buffersize 100000 lappend l [chan configure $f -buffersize] chan configure $f -buffersize 10000000 lappend l [chan configure $f -buffersize] } -cleanup { chan close $f } -result {4096 10000 1 1 1 100000 1048576} test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed set chan [open [info script] r] chan configure $chan -buffersize 10 set var [chan read $chan 2] chan configure $chan -buffersize 32 append var [chan read $chan] chan close $chan } {} # Test Tcl_SetChannelOption, Tcl_GetChannelOption test chan-io-39.1 {Tcl_GetChannelOption} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -blocking } -cleanup { chan close $f1 } -result 1 # # Test 17.2 was removed. # test chan-io-39.2 {Tcl_GetChannelOption} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -buffering } -cleanup { chan close $f1 } -result full test chan-io-39.3 {Tcl_GetChannelOption} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -buffering line chan configure $f1 -buffering } -cleanup { chan close $f1 } -result line test chan-io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} -setup { file delete $path(test1) set l "" } -body { set f1 [open $path(test1) w] lappend l [chan configure $f1 -buffering] chan configure $f1 -buffering line lappend l [chan configure $f1 -buffering] chan configure $f1 -buffering none lappend l [chan configure $f1 -buffering] chan configure $f1 -buffering line lappend l [chan configure $f1 -buffering] chan configure $f1 -buffering full lappend l [chan configure $f1 -buffering] } -cleanup { chan close $f1 } -result {full line none line full} test chan-io-39.5 {Tcl_GetChannelOption, invariance} -setup { file delete $path(test1) set l "" } -body { set f1 [open $path(test1) w] lappend l [chan configure $f1 -buffering] lappend l [list [catch {chan configure $f1 -buffering green} msg] $msg] lappend l [chan configure $f1 -buffering] } -cleanup { chan close $f1 } -result {full {1 {bad value for -buffering: must be one of full, line, or none}} full} test chan-io-39.6 {Tcl_SetChannelOption, multiple options} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -buffering line chan puts $f1 hello chan puts $f1 bye file size $path(test1) } -cleanup { chan close $f1 } -result 10 test chan-io-39.7 {Tcl_SetChannelOption, buffering, translation} -setup { file delete $path(test1) set x "" } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 hello chan puts $f1 bye chan configure $f1 -buffering line lappend x [file size $path(test1)] chan puts $f1 really_bye lappend x [file size $path(test1)] } -cleanup { chan close $f1 } -result {0 21} test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} -setup { file delete $path(test1) set l "" } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -buffering none -eofchar {} chan puts -nonewline $f1 hello lappend l [file size $path(test1)] chan puts -nonewline $f1 hello lappend l [file size $path(test1)] chan configure $f1 -buffering full chan puts -nonewline $f1 hello lappend l [file size $path(test1)] chan configure $f1 -buffering none lappend l [file size $path(test1)] chan puts -nonewline $f1 hello lappend l [file size $path(test1)] chan close $f1 lappend l [file size $path(test1)] } -result {5 10 10 10 20 20} test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} -setup { file delete $path(test1) set x "" } -constraints {nonBlockFiles} -body { set f1 [open $path(test1) w] chan close $f1 set f1 [open $path(test1) r] lappend x [chan configure $f1 -blocking] chan configure $f1 -blocking off lappend x [chan configure $f1 -blocking] lappend x [chan gets $f1] lappend x [chan read $f1 1000] lappend x [chan blocked $f1] lappend x [chan eof $f1] } -cleanup { chan close $f1 } -result {1 0 {} {} 0 1} test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} -setup { file delete $path(pipe) set x "" } -constraints stdio -body { set f1 [open $path(pipe) w] chan puts $f1 { chan gets stdin after 100 chan puts hi chan gets stdin } chan close $f1 set f1 [openpipe r+ $path(pipe)] chan configure $f1 -blocking off -buffering line lappend x [chan configure $f1 -blocking] lappend x [chan gets $f1] lappend x [chan blocked $f1] chan configure $f1 -blocking on chan puts $f1 hello chan configure $f1 -blocking off lappend x [chan gets $f1] lappend x [chan blocked $f1] chan configure $f1 -blocking on chan puts $f1 bye chan configure $f1 -blocking off lappend x [chan gets $f1] lappend x [chan blocked $f1] chan configure $f1 -blocking on lappend x [chan configure $f1 -blocking] lappend x [chan gets $f1] lappend x [chan blocked $f1] lappend x [chan eof $f1] lappend x [chan gets $f1] lappend x [chan eof $f1] } -cleanup { chan close $f1 } -result {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1} test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -buffersize -10 chan configure $f -buffersize } -cleanup { chan close $f } -result 1 test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -buffersize 10000000 chan configure $f -buffersize } -cleanup { chan close $f } -result 1048576 test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -buffersize 40000 chan configure $f -buffersize } -cleanup { chan close $f } -result 40000 test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -encoding {} chan puts -nonewline $f \xE7\x89\xA6 chan close $f set f [open $path(test1) r] chan configure $f -encoding utf-8 chan read $f } -cleanup { chan close $f } -result \u7266 test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -encoding binary chan puts -nonewline $f \xE7\x89\xA6 chan close $f set f [open $path(test1) r] chan configure $f -encoding utf-8 chan read $f } -cleanup { chan close $f } -result \u7266 test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup { file delete $path(test1) set f [open $path(test1) w] } -body { chan configure $f -encoding foobar } -returnCodes error -cleanup { chan close $f } -result {unknown encoding "foobar"} test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup { variable x {} } -constraints {stdio fileevent} -body { set f [openpipe r+ $path(cat)] chan configure $f -encoding binary chan puts -nonewline $f \xE7 chan flush $f chan configure $f -encoding utf-8 -blocking 0 chan event $f readable [namespace code { lappend x [chan read $f] }] vwait [namespace which -variable x] after 300 [namespace code { lappend x timeout }] vwait [namespace which -variable x] chan configure $f -encoding utf-8 vwait [namespace which -variable x] after 300 [namespace code { lappend x timeout }] vwait [namespace which -variable x] chan configure $f -encoding binary vwait [namespace which -variable x] after 300 [namespace code { lappend x timeout }] vwait [namespace which -variable x] return $x } -cleanup { chan close $f } -result "{} timeout {} timeout \xE7 timeout" test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \ -constraints {socket} -body { proc accept {s a p} {chan close $s} set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [chan configure $s1 -sockname] 2] set s2 [socket 127.0.0.1 $port] update chan configure $s2 -translation {auto lf} chan configure $s2 -translation } -cleanup { chan close $s1 chan close $s2 } -result {auto lf} test chan-io-39.19 {Tcl_SetChannelOption, setting read mode independently} \ -constraints {socket} -body { proc accept {s a p} {chan close $s} set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [chan configure $s1 -sockname] 2] set s2 [socket 127.0.0.1 $port] update chan configure $s2 -translation {auto crlf} chan configure $s2 -translation } -cleanup { chan close $s1 chan close $s2 } -result {auto crlf} test chan-io-39.20 {Tcl_SetChannelOption, setting read mode independently} \ -constraints {socket} -body { proc accept {s a p} {chan close $s} set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [chan configure $s1 -sockname] 2] set s2 [socket 127.0.0.1 $port] update chan configure $s2 -translation {auto cr} chan configure $s2 -translation } -cleanup { chan close $s1 chan close $s2 } -result {auto cr} test chan-io-39.21 {Tcl_SetChannelOption, setting read mode independently} \ -constraints {socket} -body { proc accept {s a p} {chan close $s} set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [chan configure $s1 -sockname] 2] set s2 [socket 127.0.0.1 $port] update chan configure $s2 -translation {auto auto} chan configure $s2 -translation } -cleanup { chan close $s1 chan close $s2 } -result {auto crlf} test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup { file delete $path(test1) set l "" } -constraints {unix} -body { set f1 [open $path(test1) w+] lappend l [chan configure $f1 -eofchar] chan configure $f1 -eofchar {ON GO} lappend l [chan configure $f1 -eofchar] chan configure $f1 -eofchar D lappend l [chan configure $f1 -eofchar] } -cleanup { chan close $f1 } -result {{{} {}} {O G} {D D}} test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup { file delete $path(test1) set l [list] } -body { set f1 [open $path(test1) w+] chan configure $f1 -eofchar {ON GO} lappend l [chan configure $f1 -eofchar] chan configure $f1 -eofchar D lappend l [chan configure $f1 -eofchar] lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg] } -cleanup { chan close $f1 } -result {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} test chan-io-39.23 { Tcl_GetChannelOption, server socket is not readable or writable, but should still have valid -eofchar and -translation options. } -setup { set l [list] } -body { set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] lappend l [chan configure $sock -eofchar] \ [chan configure $sock -translation] } -cleanup { chan close $sock } -result {{{}} auto} test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\ writable so we can't change -eofchar or -translation} -setup { set l [list] } -body { set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] chan configure $sock -eofchar D -translation lf lappend l [chan configure $sock -eofchar] \ [chan configure $sock -translation] } -cleanup { chan close $sock } -result {{{}} auto} test chan-io-40.1 {POSIX open access modes: RDWR} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan puts $f xyzzy chan close $f set f [open $path(test3) RDWR] chan puts -nonewline $f "ab" chan seek $f 0 current set x [chan gets $f] chan close $f set f [open $path(test3) r] lappend x [chan gets $f] } -cleanup { chan close $f } -result {zzy abzzy} test chan-io-40.2 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -constraints {unix notWsl} -body { set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats set x [format 0o%03o [expr {$stats(mode) & 0o777}]] chan puts $f "line 1" chan close $f set f [open $path(test3) r] lappend x [chan gets $f] } -cleanup { chan close $f } -result {0o600 {line 1}} test chan-io-40.3 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -constraints {unix umask notWsl} -body { # This test only works if your umask is 2, like ouster's. chan close [open $path(test3) {WRONLY CREAT}] file stat $path(test3) stats format 0o%03o [expr {$stats(mode) & 0o777}] } -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]] test chan-io-40.4 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan configure $f -eofchar {} chan puts $f xyzzy chan close $f set f [open $path(test3) {WRONLY CREAT}] chan configure $f -eofchar {} chan puts -nonewline $f "ab" chan close $f set f [open $path(test3) r] chan gets $f } -cleanup { chan close $f } -result abzzy test chan-io-40.5 {POSIX open access modes: APPEND} -setup { file delete $path(test3) set x "" } -body { set f [open $path(test3) w] chan configure $f -translation lf -eofchar {} chan puts $f xyzzy chan close $f set f [open $path(test3) {WRONLY APPEND}] chan configure $f -translation lf chan puts $f "new line" chan seek $f 0 chan puts $f "abc" chan close $f set f [open $path(test3) r] chan configure $f -translation lf chan seek $f 6 current lappend x [chan gets $f] lappend x [chan gets $f] } -cleanup { chan close $f } -result {{new line} abc} test chan-io-40.6 {POSIX open access modes: EXCL} -match regexp -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan puts $f xyzzy chan close $f open $path(test3) {WRONLY CREAT EXCL} } -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists} test chan-io-40.7 {POSIX open access modes: EXCL} -setup { file delete $path(test3) } -body { set f [open $path(test3) {WRONLY CREAT EXCL}] chan configure $f -eofchar {} chan puts $f "A test line" chan close $f viewFile test3 } -result {A test line} test chan-io-40.8 {POSIX open access modes: TRUNC} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan puts $f xyzzy chan close $f set f [open $path(test3) {WRONLY TRUNC}] chan puts $f abc chan close $f set f [open $path(test3) r] chan gets $f } -cleanup { chan close $f } -result abc test chan-io-40.9 {POSIX open access modes: NONBLOCK} -setup { file delete $path(test3) } -constraints {nonPortable unix} -body { set f [open $path(test3) {WRONLY NONBLOCK CREAT}] chan puts $f "NONBLOCK test" chan close $f set f [open $path(test3) r] chan gets $f } -cleanup { chan close $f } -result {NONBLOCK test} test chan-io-40.10 {POSIX open access modes: RDONLY} -body { set f [open $path(test1) w] chan puts $f "two lines: this one" chan puts $f "and this" chan close $f set f [open $path(test1) RDONLY] list [chan gets $f] [catch {chan puts $f Test} msg] $msg } -cleanup { chan close $f } -match glob -result {{two lines: this one} 1 {channel "*" wasn't opened for writing}} test chan-io-40.11 {POSIX open access modes: RDONLY} -match regexp -body { file delete $path(test3) open $path(test3) RDONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test chan-io-40.12 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test chan-io-40.13 {POSIX open access modes: WRONLY} -body { makeFile xyzzy test3 set f [open $path(test3) WRONLY] chan configure $f -eofchar {} chan puts -nonewline $f "ab" chan seek $f 0 current set x [list [catch {chan gets $f} msg] $msg] chan close $f lappend x [viewFile test3] } -match glob -result {1 {channel "*" wasn't opened for reading} abzzy} test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body { file delete $path(test3) open $path(test3) RDWR } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test chan-io-40.15 {POSIX open access modes: RDWR} { makeFile xyzzy test3 set f [open $path(test3) RDWR] chan puts -nonewline $f "ab" chan seek $f 0 current set x [chan gets $f] chan close $f lappend x [viewFile test3] } {zzy abzzy} test chan-io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup { makeFile {Some text} _test_ ~ } -body { file exists [file join $::env(HOME) _test_] } -cleanup { removeFile _test_ ~ } -result 1 test chan-io-40.17 {tilde substitution in open} -setup { set home $::env(HOME) } -body { unset ::env(HOME) open ~/foo } -returnCodes error -cleanup { set ::env(HOME) $home } -result {couldn't find HOME environment variable to expand path} test chan-io-41.1 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event foo } -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"} test chan-io-41.2 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event foo bar baz q } -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"} test chan-io-41.3 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event gorp readable } -returnCodes error -result {can not find channel named "gorp"} test chan-io-41.4 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event gorp writable } -returnCodes error -result {can not find channel named "gorp"} test chan-io-41.5 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event gorp who-knows } -returnCodes error -result {bad event name "who-knows": must be readable or writable} # # Test chan event on a file # set path(foo) [makeFile {} foo] set f [open $path(foo) w+] test chan-io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {fileevent} { list [chan event $f readable] [chan event $f writable] } {{} {}} test chan-io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} { set result {} chan event $f r "first script" lappend result [chan event $f readable] chan event $f r "new script" lappend result [chan event $f readable] chan event $f r "yet another" lappend result [chan event $f readable] chan event $f r "" lappend result [chan event $f readable] } {{first script} {new script} {yet another} {}} test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} { set result {} chan event $f r "first scr\x00ipt" lappend result [string length [chan event $f readable]] chan event $f r "new scr\x00ipt" lappend result [string length [chan event $f readable]] chan event $f r "yet ano\x00ther" lappend result [string length [chan event $f readable]] chan event $f r "" lappend result [chan event $f readable] } {13 11 12 {}} test chan-io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} { set result {} chan event $f readable "script 1" lappend result [chan event $f readable] [chan event $f writable] chan event $f writable "write script" lappend result [chan event $f readable] [chan event $f writable] chan event $f readable {} lappend result [chan event $f readable] [chan event $f writable] chan event $f writable {} lappend result [chan event $f readable] [chan event $f writable] } {{script 1} {} {script 1} {write script} {} {write script} {} {}} test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] set result {} } -constraints {stdio unixExecs fileevent} -body { lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r] chan event $f r "chan read f" chan event $f2 r "chan read f2" chan event $f3 r "chan read f3" lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r] chan event $f2 r {} lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r] chan event $f3 r {} lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r] chan event $f r {} lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r] } -cleanup { catch {chan close $f2} catch {chan close $f3} } -result {{} {} {} {chan read f} {chan read f2} {chan read f3} {chan read f} {} {chan read f3} {chan read f} {} {} {} {} {}} test chan-io-44.1 {FileEventProc procedure: normal read event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent} -body { chan event $f2 readable [namespace code { set x [chan gets $f2]; chan event $f2 readable {} }] chan puts $f2 text; chan flush $f2 variable x initial vwait [namespace which -variable x] return $x } -cleanup { catch {chan close $f2} catch {chan close $f3} } -result {text} test chan-io-44.2 {FileEventProc procedure: error in read event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] proc myHandler {msg options} { variable x $msg } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -constraints {stdio unixExecs fileevent} -body { chan event $f2 readable {error bogus} chan puts $f2 text; chan flush $f2 variable x initial vwait [namespace which -variable x] list $x [chan event $f2 readable] } -cleanup { interp bgerror {} $handler catch {chan close $f2} catch {chan close $f3} } -result {bogus {}} test chan-io-44.3 {FileEventProc procedure: normal write event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent} -body { chan event $f2 writable [namespace code { lappend x "triggered" incr count -1 if {$count <= 0} { chan event $f2 writable {} } }] variable x initial set count 3 vwait [namespace which -variable x] vwait [namespace which -variable x] vwait [namespace which -variable x] return $x } -cleanup { catch {chan close $f2} catch {chan close $f3} } -result {initial triggered triggered triggered} test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] proc myHandler {msg options} { variable x $msg } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -constraints {stdio unixExecs fileevent} -body { chan event $f2 writable {error bad-write} variable x initial vwait [namespace which -variable x] list $x [chan event $f2 writable] } -cleanup { interp bgerror {} $handler catch {chan close $f2} catch {chan close $f3} } -result {bad-write {}} test chan-io-44.5 {FileEventProc procedure: end of file} -constraints { stdio unixExecs fileevent } -body { set f4 [openpipe r $path(cat) << foo] chan event $f4 readable [namespace code { if {[chan gets $f4 line] < 0} { lappend x eof chan event $f4 readable {} } else { lappend x $line } }] variable x initial vwait [namespace which -variable x] vwait [namespace which -variable x] set x } -cleanup { chan close $f4 } -result {initial foo eof} chan close $f makeFile "foo bar" foo test chan-io-45.1 {DeleteFileEvent, cleanup on chan close} {fileevent} { set f [open $path(foo) r] chan event $f readable [namespace code { lappend x "binding triggered: \"[chan gets $f]\"" chan event $f readable {} }] chan close $f set x initial after 100 [namespace code { set y done }] variable y vwait [namespace which -variable y] set x } {initial} test chan-io-45.2 {DeleteFileEvent, cleanup on chan close} {fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] chan event $f readable [namespace code { lappend x "f triggered: \"[chan gets $f]\"" chan event $f readable {} }] chan event $f2 readable [namespace code { lappend x "f2 triggered: \"[chan gets $f2]\"" chan event $f2 readable {} }] chan close $f variable x initial vwait [namespace which -variable x] chan close $f2 set x } {initial {f2 triggered: "foo bar"}} test chan-io-45.3 {DeleteFileEvent, cleanup on chan close} {fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] chan event $f readable {f script} chan event $f2 readable {f2 script} chan event $f3 readable {f3 script} set x {} chan close $f2 lappend x [catch {chan event $f readable} msg] $msg \ [catch {chan event $f2 readable}] \ [catch {chan event $f3 readable} msg] $msg chan close $f3 lappend x [catch {chan event $f readable} msg] $msg \ [catch {chan event $f2 readable}] \ [catch {chan event $f3 readable}] chan close $f lappend x [catch {chan event $f readable}] \ [catch {chan event $f2 readable}] \ [catch {chan event $f3 readable}] } {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1} # Execute these tests only if the "testfevent" command is present. test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent notOSX} { testfevent create set script "set f \[[list open $path(foo) r]]\n" append script { set x "no event" chan event $f readable [namespace code { set x "f triggered: [chan gets $f]" chan event $f readable {} }] } set timer [after 10 lappend x timeout] testfevent cmd $script vwait x after cancel $timer testfevent cmd {chan close $f} list [testfevent cmd {set x}] [testfevent cmd {info commands after}] } {{f triggered: foo bar} after} test chan-io-46.2 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { variable x 0 after 100 {set x triggered} vwait [namespace which -variable x] set x } } {triggered} test chan-io-46.3 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { set x 0 after 10 {lappend x timer} after 30 set result $x update idletasks lappend result $x update lappend result $x } } {0 0 {0 timer}} test chan-io-47.1 {chan event vs multiple interpreters} -setup { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] set x {} } -constraints {testfevent fileevent} -body { chan event $f readable {script 1} testfevent create testfevent share $f2 testfevent cmd "chan event $f2 readable {script 2}" chan event $f3 readable {sript 3} lappend x [chan event $f2 readable] testfevent delete lappend x [chan event $f readable] [chan event $f2 readable] \ [chan event $f3 readable] } -cleanup { chan close $f chan close $f2 chan close $f3 } -result {{} {script 1} {} {sript 3}} test chan-io-47.2 {deleting chan event on interpreter delete} -setup { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] set f4 [open $path(foo) r] } -constraints {testfevent fileevent} -body { chan event $f readable {script 1} testfevent create testfevent share $f2 testfevent share $f3 testfevent cmd "chan event $f2 readable {script 2} chan event $f3 readable {script 3}" chan event $f4 readable {script 4} testfevent delete list [chan event $f readable] [chan event $f2 readable] \ [chan event $f3 readable] [chan event $f4 readable] } -cleanup { chan close $f chan close $f2 chan close $f3 chan close $f4 } -result {{script 1} {} {} {script 4}} test chan-io-47.3 {deleting chan event on interpreter delete} -setup { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] set f4 [open $path(foo) r] } -constraints {testfevent fileevent} -body { testfevent create testfevent share $f3 testfevent share $f4 chan event $f readable {script 1} chan event $f2 readable {script 2} testfevent cmd "chan event $f3 readable {script 3} chan event $f4 readable {script 4}" testfevent delete list [chan event $f readable] [chan event $f2 readable] \ [chan event $f3 readable] [chan event $f4 readable] } -cleanup { chan close $f chan close $f2 chan close $f3 chan close $f4 } -result {{script 1} {script 2} {} {}} test chan-io-47.4 {file events on shared files and multiple interpreters} -setup { set f [open $path(foo) r] set f2 [open $path(foo) r] } -constraints {testfevent fileevent} -body { testfevent create testfevent share $f testfevent cmd "chan event $f readable {script 1}" chan event $f readable {script 2} chan event $f2 readable {script 3} list [chan event $f2 readable] [testfevent cmd "chan event $f readable"] \ [chan event $f readable] } -cleanup { testfevent delete chan close $f chan close $f2 } -result {{script 3} {script 1} {script 2}} test chan-io-47.5 {file events on shared files, deleting file events} -setup { set f [open $path(foo) r] } -body { testfevent create testfevent share $f testfevent cmd "chan event $f readable {script 1}" chan event $f readable {script 2} testfevent cmd "chan event $f readable {}" list [testfevent cmd "chan event $f readable"] [chan event $f readable] } -constraints {testfevent fileevent} -cleanup { testfevent delete chan close $f } -result {{} {script 2}} test chan-io-47.6 {file events on shared files, deleting file events} -setup { set f [open $path(foo) r] } -body { testfevent create testfevent share $f testfevent cmd "chan event $f readable {script 1}" chan event $f readable {script 2} chan event $f readable {} list [testfevent cmd "chan event $f readable"] [chan event $f readable] } -constraints {testfevent fileevent} -cleanup { testfevent delete chan close $f } -result {{script 1} {}} unset path(foo) removeFile foo set path(bar) [makeFile {} bar] test chan-io-48.1 {testing readability conditions} {fileevent} { set f [open $path(bar) w] chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan close $f set f [open $path(bar) r] chan event $f readable [namespace code { lappend l called if {[chan eof $f]} { chan close $f set x done } else { chan gets $f } }] set l "" variable x not_done vwait [namespace which -variable x] list $x $l } {done {called called called called called called called}} test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} { set f [open $path(bar) w] chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan close $f set f [open $path(bar) r] chan event $f readable [namespace code { lappend l called if {[chan eof $f]} { chan close $f set x done } else { chan gets $f } }] chan configure $f -blocking off set l "" variable x not_done vwait [namespace which -variable x] list $x $l } {done {called called called called called called called}} set path(my_script) [makeFile {} my_script] test chan-io-48.3 {testing readability conditions} -setup { set l "" } -constraints {stdio unix nonBlockFiles fileevent} -body { set f [open $path(bar) w] chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan puts $f abcdefg chan close $f set f [open $path(my_script) w] chan puts $f { proc copy_slowly {f} { while {![chan eof $f]} { chan puts [chan gets $f] after 200 } chan close $f } } chan close $f set f [openpipe] chan event $f readable [namespace code { if {[chan eof $f]} { set x done } else { chan gets $f lappend l [chan blocked $f] chan gets $f lappend l [chan blocked $f] } }] chan configure $f -buffering line chan configure $f -blocking off variable x not_done chan puts $f [list source $path(my_script)] chan puts $f "set f \[[list open $path(bar) r]]" chan puts $f {copy_slowly $f} chan puts $f {exit} vwait [namespace which -variable x] list $x $l } -cleanup { chan close $f } -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}} unset path(bar) removeFile bar test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation lf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation lf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation cr -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation cr -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation crlf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation crlf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f } else { lappend l [chan gets $f] incr c } }] variable x vwait [namespace which -variable x] list $c $l } -result {3 {abc def {}}} test chan-io-49.1 {testing crlf reading, leftover cr disgorgment} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\rb\rc\r\n" chan close $f set f [open $path(test1) r] lappend l [file size $path(test1)] chan configure $f -translation crlf lappend l [chan read $f 1] lappend l [chan tell $f] lappend l [chan read $f 1] lappend l [chan tell $f] lappend l [chan read $f 1] lappend l [chan tell $f] lappend l [chan read $f 1] lappend l [chan tell $f] lappend l [chan read $f 1] lappend l [chan tell $f] lappend l [chan read $f 1] lappend l [chan tell $f] lappend l [chan eof $f] lappend l [chan read $f 1] lappend l [chan eof $f] } -cleanup { chan close $f } -result "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 { } 7 0 {} 1" test chan-io-49.2 {testing crlf reading, leftover cr disgorgment} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\rb\rc\r\n" chan close $f set f [open $path(test1) r] lappend l [file size $path(test1)] chan configure $f -translation crlf lappend l [chan read $f 2] lappend l [chan tell $f] lappend l [chan read $f 2] lappend l [chan tell $f] lappend l [chan read $f 2] lappend l [chan tell $f] lappend l [chan eof $f] lappend l [chan read $f 2] lappend l [chan tell $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1" test chan-io-49.3 {testing crlf reading, leftover cr disgorgment} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\rb\rc\r\n" chan close $f set f [open $path(test1) r] lappend l [file size $path(test1)] chan configure $f -translation crlf lappend l [chan read $f 3] lappend l [chan tell $f] lappend l [chan read $f 3] lappend l [chan tell $f] lappend l [chan eof $f] lappend l [chan read $f 3] lappend l [chan tell $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1" test chan-io-49.4 {testing crlf reading, leftover cr disgorgment} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\rb\rc\r\n" chan close $f set f [open $path(test1) r] lappend l [file size $path(test1)] chan configure $f -translation crlf lappend l [chan read $f 3] lappend l [chan tell $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1" test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "a\rb\rc\r\n" chan close $f set f [open $path(test1) r] lappend l [file size $path(test1)] chan configure $f -translation crlf lappend l [set x [chan gets $f]] lappend l [chan tell $f] lappend l [chan gets $f] lappend l [chan tell $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result [list 7 a\rb\rc 7 {} 7 1] test chan-io-50.1 {testing handler deletion} -setup { file delete $path(test1) } -constraints testchannelevent -body { set f [open $path(test1) w] chan close $f set f [open $path(test1) r] variable z not_called set timer [after 50 lappend z timeout] testservicemode 0 testchannelevent $f add readable [namespace code { variable z called testchannelevent $f delete 0 }] testservicemode 1 vwait z after cancel $timer set z } -cleanup { chan close $f } -result called test chan-io-50.2 {testing handler deletion with multiple handlers} -setup { file delete $path(test1) chan close [open $path(test1) w] set z "" } -constraints {testchannelevent testservicemode} -body { proc delhandler {f i} { variable z lappend z "called delhandler $f $i" testchannelevent $f delete 0 } set z "" set timer [after 50 lappend z timeout] testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list delhandler $f 1]] testchannelevent $f add readable [namespace code [list delhandler $f 0]] testservicemode 1 vwait z after cancel $timer string equal $z \ [list [list called delhandler $f 0] [list called delhandler $f 1]] } -cleanup { chan close $f } -result 1 test chan-io-50.3 {testing handler deletion with multiple handlers} -setup { file delete $path(test1) chan close [open $path(test1) w] } -constraints {testchannelevent testservicemode} -body { proc notcalled {f i} { variable z lappend z "notcalled was called!! $f $i" } proc delhandler {f i} { variable z testchannelevent $f delete 1 lappend z "delhandler $f $i called" testchannelevent $f delete 0 lappend z "delhandler $f $i deleted myself" } set z "" set timer [after 50 lappend z timeout] testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list notcalled $f 1]] testchannelevent $f add readable [namespace code [list delhandler $f 0]] testservicemode 1 vwait z after cancel $timer string equal $z \ [list [list delhandler $f 0 called] \ [list delhandler $f 0 deleted myself]] } -cleanup { chan close $f } -result 1 test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup { file delete $path(test1) set f [open $path(test1) w] chan close $f } -constraints testchannelevent -body { set f [open $path(test1) r] testchannelevent $f add readable [namespace code { if {$u eq "recursive"} { testchannelevent $f delete 0 lappend z "delrecursive deleting recursive" } else { lappend z "delrecursive calling recursive" set u recursive update } }] variable u toplevel variable z "" set timer [after 50 lappend z timeout] vwait z after cancel $timer set z } -cleanup { chan close $f update } -result {{delrecursive calling recursive} {delrecursive deleting recursive}} test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup { file delete $path(test1) set f [open $path(test1) w] chan close $f update } -constraints {testchannelevent testservicemode notOSX} -body { proc notcalled {f} { variable z lappend z "notcalled was called!! $f" } proc del {f} { variable u variable z if {$u eq "recursive"} { testchannelevent $f delete 1 testchannelevent $f delete 0 lappend z "del deleted notcalled" lappend z "del deleted myself" } else { set u recursive lappend z "del calling recursive" set timer [after 50 lappend z timeout] set mode [testservicemode 1] vwait z after cancel $timer testservicemode $mode lappend z "del after update" } } set z "" set u toplevel set timer [after 50 lappend z timeout] testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list notcalled $f]] testchannelevent $f add readable [namespace code [list del $f]] testservicemode 1 vwait z after cancel $timer set z } -cleanup { chan close $f update } -result [list {del calling recursive} {del deleted notcalled} \ {del deleted myself} {del after update}] test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup { file delete $path(test1) set f [open $path(test1) w] chan close $f } -constraints {testchannelevent testservicemode} -body { proc first {f} { variable u variable z if {$u eq "toplevel"} { lappend z "first called" set mode [testservicemode 1] set timer [after 50 lappend z timeout] set u first vwait z after cancel $timer testservicemode $mode lappend z "first after update" } else { lappend z "first called not toplevel" } } proc second {f} { variable u variable z if {$u eq "first"} { lappend z "second called, first time" set u second testchannelevent $f delete 0 } elseif {$u eq "second"} { lappend z "second called, second time" testchannelevent $f delete 0 } else { lappend z "second called, cannot happen!" testchannelevent $f removeall } } set z "" set u toplevel set timer [after 50 lappend z timeout] testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list second $f]] testchannelevent $f add readable [namespace code [list first $f]] testservicemode 1 vwait z after cancel $timer set z } -cleanup { chan close $f } -result [list {first called} {first called not toplevel} \ {second called, first time} {second called, second time} \ {first after update}] test chan-io-51.1 {Test old socket deletion on Macintosh} -setup { set x 0 set result "" variable wait "" } -constraints {socket} -body { proc accept {s a p} { variable x chan configure $s -blocking off chan puts $s "sock[incr x]" chan close $s variable wait done } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [chan configure $ss -sockname] 2] set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] } -cleanup { chan close $cs chan close $ss } -result {sock1 sock2 sock3 sock4} test chan-io-52.1 {TclCopyChannel} -constraints {fcopy} -setup { file delete $path(test1) } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan copy $f1 $f2 -command " # " chan copy $f1 $f2 } -returnCodes error -cleanup { chan close $f1 chan close $f2 } -match glob -result {channel "*" is busy} test chan-io-52.2 {TclCopyChannel} -constraints {fcopy} -setup { file delete $path(test1) } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] set f3 [open $thisScript] chan copy $f1 $f2 -command " # " chan copy $f3 $f2 } -returnCodes error -cleanup { chan close $f1 chan close $f2 chan close $f3 } -match glob -result {channel "*" is busy} test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup { file delete $path(test1) } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0 set s0 [chan copy $f1 $f2] set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {($s1 == $s2) && ($s0 == $s1)} { lappend result ok } return $result } -result {0 0 ok} test chan-io-52.4 {TclCopyChannel} -constraints {fcopy} -setup { file delete $path(test1) } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -blocking 0 chan configure $f2 -translation cr -blocking 0 chan copy $f1 $f2 -size 40 set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 lappend result [file size $path(test1)] } -result {0 0 40} test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup { file delete $path(test1) } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified. set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 if {[file size $thisScript] == [file size $path(test1)]} { lappend result ok } return $result } -result {0 0 ok} test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup { file delete $path(test1) } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 if {[file size $thisScript] == [file size $path(test1)]} { lappend result ok } return $result } -result {0 0 ok} test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup { file delete $path(test1) } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 if {[file size $thisScript] == [file size $path(test1)]} { lappend result ok } return $result } -result {0 0 ok} test chan-io-52.6 {TclCopyChannel} -setup { file delete $path(test1) } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]] set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {($s1 == $s2) && ($s0 == $s1)} { lappend result ok } return $result } -result {0 0 ok} test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup { file delete $path(test1) } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] if {[file size $thisScript] == [file size $path(test1)]} { lappend result ok } return $result } -cleanup { chan close $f1 chan close $f2 } -result {0 0 ok} test chan-io-52.8 {TclCopyChannel} -setup { file delete $path(test1) file delete $path(pipe) } -constraints {stdio fcopy} -body { set f1 [open $path(pipe) w] chan configure $f1 -translation lf chan puts $f1 " chan puts ready chan gets stdin set f1 \[open [list $thisScript] r\] chan configure \$f1 -translation lf chan puts \[chan read \$f1 100\] chan close \$f1 " chan close $f1 set f1 [openpipe r+ $path(pipe)] chan configure $f1 -translation lf chan gets $f1 chan puts $f1 ready chan flush $f1 set f2 [open $path(test1) w] chan configure $f2 -translation lf set s0 [chan copy $f1 $f2 -size 40] catch {chan close $f1} chan close $f2 list $s0 [file size $path(test1)] } -result {40 40} # Empty files, to register them with the test facility set path(kyrillic.txt) [makeFile {} kyrillic.txt] set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt] set path(utf8-rp.txt) [makeFile {} utf8-rp.txt] # Create kyrillic file, use lf translation to avoid os eol issues set out [open $path(kyrillic.txt) w] chan configure $out -encoding koi8-r -translation lf chan puts $out \u0410\u0410 chan close $out test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} { # Copy kyrillic to UTF-8, using chan copy. set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] chan configure $in -encoding koi8-r -translation lf chan configure $out -encoding utf-8 -translation lf chan copy $in $out chan close $in chan close $out # Do the same again, but differently (read/chan puts). set in [open $path(kyrillic.txt) r] set out [open $path(utf8-rp.txt) w] chan configure $in -encoding koi8-r -translation lf chan configure $out -encoding utf-8 -translation lf chan puts -nonewline $out [chan read $in] chan close $in chan close $out list [file size $path(kyrillic.txt)] \ [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} { # encoding to binary (=> implies that the internal utf-8 is written) set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] chan configure $in -encoding koi8-r -translation lf # -translation binary is also -encoding binary chan configure $out -translation binary chan copy $in $out chan close $in chan close $out file size $path(utf8-fcopy.txt) } 5 test chan-io-52.11 {TclCopyChannel & encodings} -setup { set f [open $path(utf8-fcopy.txt) w] fconfigure $f -encoding utf-8 -translation lf puts $f \u0410\u0410 close $f } -constraints {fcopy} -body { # binary to encoding => the input has to be in utf-8 to make sense to the # encoder set in [open $path(utf8-fcopy.txt) r] set out [open $path(kyrillic.txt) w] # -translation binary is also -encoding binary chan configure $in -translation binary chan configure $out -encoding koi8-r -translation lf chan copy $in $out chan close $in chan close $out file size $path(kyrillic.txt) } -result 3 test chan-io-53.1 {CopyData} -setup { file delete $path(test1) } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -blocking 0 chan configure $f2 -translation cr -blocking 0 chan copy $f1 $f2 -size 0 set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 lappend result [file size $path(test1)] } -result {0 0 0} test chan-io-53.2 {CopyData} -setup { file delete $path(test1) } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 -command [namespace code {set s0}] set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] variable s0 vwait [namespace which -variable s0] chan close $f1 chan close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {($s1 == $s2) && ($s0 == $s1)} { lappend result ok } return $result } -result {0 0 ok} test chan-io-53.3 {CopyData: background read underflow} -setup { file delete $path(test1) file delete $path(pipe) } -constraints {stdio unix fcopy} -body { set f1 [open $path(pipe) w] chan puts -nonewline $f1 { chan puts ready chan flush stdout ;# Don't assume line buffered! chan copy stdin stdout -command { set x } vwait x set f [} chan puts $f1 [list open $path(test1) w]] chan puts $f1 { chan configure $f -translation lf chan puts $f "done" chan close $f } chan close $f1 set f1 [openpipe r+ $path(pipe)] set result [chan gets $f1] chan puts $f1 line1 chan flush $f1 lappend result [chan gets $f1] chan puts $f1 line2 chan flush $f1 lappend result [chan gets $f1] chan close $f1 after 500 set f [open $path(test1)] lappend result [chan read $f] } -cleanup { chan close $f } -result "ready line1 line2 {done\n}" test chan-io-53.4 {CopyData: background write overflow} -setup { set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n variable x for {set x 0} {$x < 12} {incr x} { append big $big } file delete $path(test1) file delete $path(pipe) } -constraints {stdio unix fileevent fcopy} -body { set f1 [open $path(pipe) w] chan puts $f1 { chan puts ready chan copy stdin stdout -command { set x } vwait x set f [open $path(test1) w] chan configure $f -translation lf chan puts $f "done" chan close $f } chan close $f1 set f1 [openpipe r+ $path(pipe)] set result [chan gets $f1] chan configure $f1 -blocking 0 chan puts $f1 $big chan flush $f1 after 500 set result "" chan event $f1 read [namespace code { append result [chan read $f1 1024] if {[string length $result] >= [string length $big]} { set x done } }] vwait [namespace which -variable x] return $x } -cleanup { set big {} chan close $f1 } -result done set result {} proc FcopyTestAccept {sock args} { after 1000 "chan close $sock" } proc FcopyTestDone {bytes {error {}}} { variable fcopyTestDone if {[string length $error]} { set fcopyTestDone 1 } else { set fcopyTestDone 0 } } test chan-io-53.5 {CopyData: error during chan copy} {socket fcopy} { variable fcopyTestDone set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0] set in [open $thisScript] ;# 126 K set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]] catch {unset fcopyTestDone} chan close $listen ;# This means the socket open never really succeeds chan copy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g. } chan close $in chan close $out set fcopyTestDone ;# 1 for error condition } 1 test chan-io-53.6 {CopyData: error during chan copy} -setup { variable fcopyTestDone file delete $path(pipe) file delete $path(test1) catch {unset fcopyTestDone} } -constraints {stdio fcopy} -body { set f1 [open $path(pipe) w] chan puts $f1 "exit 1" chan close $f1 set in [openpipe r+ $path(pipe)] set out [open $path(test1) w] chan copy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } return $fcopyTestDone ;# 0 for plain end of file } -cleanup { catch {chan close $in} chan close $out } -result 0 proc doFcopy {in out {bytes 0} {error {}}} { variable fcopyTestDone variable fcopyTestCount incr fcopyTestCount $bytes if {[string length $error]} { set fcopyTestDone 1 } elseif {[chan eof $in]} { set fcopyTestDone 0 } else { # Delay next chan copy to wait for size>0 input bytes after 100 [list chan copy $in $out -size 1000 \ -command [namespace code [list doFcopy $in $out]]] } } test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup { variable fcopyTestDone file delete $path(pipe) catch {unset fcopyTestDone} } -constraints {stdio fcopy} -body { set fcopyTestCount 0 set f1 [open $path(pipe) w] chan puts $f1 { # Write 10 bytes / 10 msec proc Write {count} { chan puts -nonewline "1234567890" if {[incr count -1]} { after 10 [list Write $count] } else { set ::ready 1 } } chan configure stdout -buffering none Write 345 ;# 3450 bytes ~3.45 sec vwait ready exit 0 } chan close $f1 set in [openpipe r+ $path(pipe) &] set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } # -1=error 0=script error N=number of bytes expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1} } -cleanup { catch {chan close $in} chan close $out } -result {3450} test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { # copy progress callback. errors out intentionally proc cmd args { lappend ::RES "CMD $args" error !STOP } # capture callback error here proc ::bgerror args { lappend ::RES "bgerror/OK $args" set ::forever has-been-reached return } # Files we use for our channels set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] set bar [makeFile {} bar] # Channels to copy between set f [open $foo r] ; fconfigure $f -translation binary set g [open $bar w] ; fconfigure $g -translation binary -buffering none } -constraints {stdio fcopy} -body { # Record input size, so that result is always defined lappend ::RES [file size $bar] # Run the copy. Should not invoke -command now. chan copy $f $g -size 2 -command [namespace code cmd] # Check that -command was not called synchronously set sbs [file size $bar] lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs # Now let the async part happen. Should capture the error in cmd via # bgerror. If not break the event loop via timer. set token [after 1000 { lappend ::RES {bgerror/FAIL timeout} set ::forever has-been-reached }] vwait ::forever catch {after cancel $token} # Report set ::RES } -cleanup { chan close $f chan close $g catch {unset ::RES} catch {unset ::forever} rename ::bgerror {} removeFile foo removeFile bar } -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}} test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -setup { # copy progress callback. proc cmd args { lappend ::RES "CMD $args" set ::forever has-been-reached return } # Files we use for our channels set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] set bar [makeFile {} bar] # Channels to copy between set f [open $foo r] ; chan configure $f -translation binary set g [open $bar w] ; chan configure $g -translation binary -buffering none } -constraints {stdio fcopy} -body { # Initialize and force eof on the input. chan seek $f 0 end ; chan read $f 1 set ::RES [chan eof $f] # Run the copy. Should not invoke -command now. chan copy $f $g -size 2 -command [namespace code cmd] # Check that -command was not called synchronously lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}] # Now let the async part happen. Should capture the eof in cmd # If not break the event loop via timer. set token [after 1000 { lappend ::RES {cmd/FAIL timeout} set ::forever has-been-reached }] vwait ::forever catch {after cancel $token} # Report return $::RES } -cleanup { chan close $f chan close $g catch {unset ::RES} catch {unset ::forever} removeFile foo removeFile bar } -result {1 sync/OK {CMD 0}} test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup { set out [makeFile {} out] set err [makeFile {} err] set pipe [open "|[list [info nameofexecutable] 2> $err]" r+] chan configure $pipe -translation binary -buffering line chan puts $pipe { chan configure stdout -translation binary -buffering line chan puts stderr Waiting... after 1000 foreach x {a b c} { chan puts stderr Looping... chan puts $x after 500 } proc bye args { if {[chan gets stdin line]<0} { chan puts stderr "CHILD: EOF detected, exiting" exit } else { chan puts stderr "CHILD: ignoring line: $line" } } chan puts stderr Now-sleeping-forever chan event stdin readable bye vwait forever } proc ::done args { set ::forever OK return } set ::forever {} set out [open $out w] } -constraints {stdio fcopy} -body { chan copy $pipe $out -size 6 -command ::done set token [after 5000 { set ::forever {fcopy hangs} }] vwait ::forever catch {after cancel $token} set ::forever } -cleanup { chan close $pipe rename ::done {} if {[testConstraint win]} { after 1000; # Allow Windows time to figure out that the # process is gone } catch {close $out} catch {removeFile out} catch {removeFile err} catch {unset ::forever} } -result OK test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { set err [makeFile {} err] set pipe [open "|[list [info nameofexecutable] 2> $err]" r+] chan configure $pipe -translation binary -buffering line chan puts $pipe { chan configure stderr -buffering line # Kill server when pipe closed by invoker. proc bye args { if {![chan eof stdin]} { chan gets stdin ; return } chan puts stderr BYE exit } # Server code. Bi-directional copy between 2 sockets. proc geof {sok} { chan puts stderr DONE/$sok chan close $sok } proc new {sok args} { chan puts stderr NEW/$sok global l srv chan configure $sok -translation binary -buffering none lappend l $sok if {[llength $l] == 2} { chan close $srv foreach {a b} $l break chan copy $a $b -command [list geof $a] chan copy $b $a -command [list geof $b] chan puts stderr 2COPY } chan puts stderr ... } chan puts stderr SRV set l {} set srv [socket -server new -myaddr 127.0.0.1 0] set port [lindex [chan configure $srv -sockname] 2] chan puts stderr WAITING chan event stdin readable bye puts "OK $port" vwait forever } # wait for OK from server. lassign [chan gets $pipe] ok port # Now the two clients. proc done {sock} { if {[chan eof $sock]} { chan close $sock ; return } lappend ::forever [chan gets $sock] return } set a [socket 127.0.0.1 $port] set b [socket 127.0.0.1 $port] chan configure $a -translation binary -buffering none chan configure $b -translation binary -buffering none chan event $a readable [namespace code "done $a"] chan event $b readable [namespace code "done $b"] } -constraints {stdio fcopy} -body { # Now pass data through the server in both directions. set ::forever {} chan puts $a AB vwait ::forever chan puts $b BA vwait ::forever set ::forever } -cleanup { catch {chan close $a} catch {chan close $b} chan close $pipe if {[testConstraint win]} { after 1000 ;# Give Windows time to kill the process } removeFile err catch {unset ::forever} } -result {AB BA} test chan-io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. proc accept {s a p} { variable as chan configure $s -translation lf chan puts $s "line 1\nline2\nline3" chan flush $s set as $s } proc readit {s next} { variable x variable result lappend result $next if {$next == 1} { chan event $s readable [namespace code [list readit $s 2]] vwait [namespace which -variable x] } incr x } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] # We need to delay on some systems until the creation of the server socket # completes. set done 0 for {set i 0} {$i < 10} {incr i} { if {![catch { set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]] }]} { set done 1 break } after 100 } if {$done == 0} { chan close $ss error "failed to connect to server" } variable result {} variable x 0 variable as vwait [namespace which -variable as] chan configure $cs -translation lf lappend result [chan gets $cs] chan configure $cs -blocking off chan event $cs readable [namespace code [list readit $cs 1]] set a [after 2000 [namespace code { set x failure }]] vwait [namespace which -variable x] after cancel $a chan close $as chan close $ss chan close $cs list $result $x } {{{line 1} 1 2} 2} test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup { set accept {} set after {} variable done 0 } -constraints {socket fileevent} -body { variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] proc accept {s a p} { variable counter 0 variable accept $s chan configure $s -blocking off -buffering line -translation lf chan event $s readable [namespace code "doit $s"] } proc doit {s} { variable counter variable after incr counter if {[chan gets $s] eq ""} { chan event $s readable [namespace code "doit1 $s"] set after [after 1000 [namespace code { chan puts $writer hello chan flush $writer set done 1 }]] } } proc doit1 {s} { variable counter variable accept incr counter chan gets $s chan close $s set accept {} } proc producer {} { variable s variable writer set writer [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]] chan configure $writer -buffering line chan puts -nonewline $writer hello chan flush $writer } producer vwait [namespace which -variable done] chan close $writer chan close $s after cancel $after set counter } -cleanup { if {$accept ne {}} {chan close $accept} } -result 1 set path(fooBar) [makeFile {} fooBar] test chan-io-55.1 {ChannelEventScriptInvoker: deletion} -constraints { fileevent } -setup { variable x proc eventScript {fd} { variable x chan close $fd error "planned error" set x whoops } proc myHandler args { variable x got_error } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { set f [open $path(fooBar) w] chan event $f writable [namespace code [list eventScript $f]] variable x not_done vwait [namespace which -variable x] set x } -cleanup { interp bgerror {} $handler } -result {got_error} test chan-io-56.1 {ChannelTimerProc} {testchannelevent} { set f [open $path(fooBar) w] chan puts $f "this is a test" chan close $f set f [open $path(fooBar) r] testchannelevent $f add readable [namespace code { chan read $f 1 incr x }] variable x 0 vwait [namespace which -variable x] vwait [namespace which -variable x] set result $x testchannelevent $f set 0 none after idle [namespace code {set y done}] variable y vwait [namespace which -variable y] chan close $f lappend result $y } {2 done} test chan-io-57.1 {buffered data and file events, gets} -setup { variable s2 } -constraints {fileevent} -body { proc accept {sock args} { variable s2 set s2 $sock } set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]] vwait [namespace which -variable s2] update chan event $s2 readable [namespace code {lappend result readable}] chan puts $s "12\n34567890" chan flush $s variable result [chan gets $s2] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [chan gets $s2] vwait [namespace which -variable result] set result } -cleanup { chan close $s chan close $s2 chan close $server } -result {12 readable 34567890 timer} test chan-io-57.2 {buffered data and file events, read} -setup { variable s2 } -constraints {fileevent} -body { proc accept {sock args} { variable s2 set s2 $sock } set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]] vwait [namespace which -variable s2] update chan event $s2 readable [namespace code {lappend result readable}] chan puts -nonewline $s "1234567890" chan flush $s variable result [chan read $s2 1] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [chan read $s2 9] vwait [namespace which -variable result] set result } -cleanup { chan close $s chan close $s2 chan close $server } -result {1 readable 234567890 timer} test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} { set out [open $path(script) w] chan puts $out { chan puts "normal message from pipe" chan puts stderr "error message from pipe" exit 1 } proc readit {pipe} { variable x variable result if {[chan eof $pipe]} { set x [catch {chan close $pipe} line] lappend result catch $line } else { chan gets $pipe line lappend result chan gets $line } } chan close $out set pipe [openpipe r $path(script)] chan event $pipe readable [namespace code [list readit $pipe]] variable x "" set result "" vwait [namespace which -variable x] list $x $result } {1 {chan gets {normal message from pipe} chan gets {} catch {error message from pipe}}} test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} { # TIP #10 # More complicated tests (like that the reference changes as a channel is # moved from thread to thread) can be done only in the extension which # fully implements the moving of channels between threads, i.e. 'Threads'. set f [open $path(longfile) r] set result [testchannel mthread $f] chan close $f string equal $result [testmainthread] } {1} test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} { # This test will hang in older revisions of the core. set out [open $path(script) w] chan puts $out "catch {load $::tcltestlib Tcltest}" chan puts $out { chan puts [testbytestring \xE2] exit 1 } proc readit {pipe} { variable x variable result if {[chan eof $pipe]} { set x [catch {chan close $pipe} line] lappend result catch $line } else { chan gets $pipe line lappend result gets $line } } chan close $out set pipe [openpipe r $path(script)] chan event $pipe readable [namespace code [list readit $pipe]] variable x "" set result "" vwait [namespace which -variable x] # cut of the remainder of the error stack, especially the filename set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]] list $x $result } {1 {gets {} catch {error writing "stdout": invalid argument}}} test chan-io-61.1 {Reset eof state after changing the eof char} -setup { set datafile [makeFile {} eofchar] set f [open $datafile w] chan configure $f -translation binary chan puts -nonewline $f [string repeat "Ho hum\n" 11] chan puts $f = set line [string repeat "Ge gla " 4] chan puts -nonewline $f [string repeat [string trimright $line]\n 834] chan close $f } -body { set f [open $datafile r] chan configure $f -eofchar = set res {} lappend res [chan read $f; chan tell $f] chan configure $f -eofchar {} lappend res [chan read $f 1] lappend res [chan read $f; chan tell $f] # Any seek zaps the internals into a good state. #chan seek $f 0 start #chan seek $f 0 current #lappend res [chan read $f; chan tell $f] } -cleanup { chan close $f removeFile eofchar } -result {77 = 23431} # Test the cutting and splicing of channels, this is incidentally the # attach/detach facility of package Thread, but __without any safeguards__. It # can also be used to emulate transfer of channels between threads, and is # used for that here. test chan-io-70.0 {Cutting & Splicing channels} -setup { set f [makeFile {... dummy ...} cutsplice] set res {} } -constraints {testchannel} -body { set c [open $f r] lappend res [catch {chan seek $c 0 start}] testchannel cut $c lappend res [catch {chan seek $c 0 start}] testchannel splice $c lappend res [catch {chan seek $c 0 start}] } -cleanup { chan close $c removeFile cutsplice } -result {0 1 0} test chan-io-70.1 {Transfer channel} -setup { set f [makeFile {... dummy ...} cutsplice] set res {} } -constraints {testchannel thread} -body { set c [open $f r] lappend res [catch {chan seek $c 0 start}] testchannel cut $c lappend res [catch {chan seek $c 0 start}] set tid [thread::create -preserved] thread::send $tid [list set c $c] thread::send $tid {load {} Tcltest} lappend res [thread::send $tid { testchannel splice $c set res [catch {chan seek $c 0 start}] chan close $c set res }] } -cleanup { thread::release $tid removeFile cutsplice } -result {0 1 0} # ### ### ### ######### ######### ######### foreach {n msg expected} { 0 {} {} 1 {{message only}} {{message only}} 2 {-options x} {-options x} 3 {-options {x y} {the message}} {-options {x y} {the message}} 4 {-code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 5 {-code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 6 {-code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 7 {-code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 8 {-code error -level 0 -f ba snarf} {-code error -level 0 -f ba snarf} 9 {-code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 10 {-code error -level 5 -f ba snarf} {-code error -level 0 -f ba snarf} 11 {-code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 12 {-code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 13 {-code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 14 {-code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} 15 {-code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} 16 {-code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} 17 {-code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} 18 {-code error -level 0 -f ba} {-code error -level 0 -f ba} 19 {-code ok -level 0 -f ba} {-code 1 -level 0 -f ba} 20 {-code error -level 5 -f ba} {-code error -level 0 -f ba} 21 {-code ok -level 5 -f ba} {-code 1 -level 0 -f ba} 22 {-code boss -level 0 -f ba} {-code 1 -level 0 -f ba} 23 {-code boss -level 5 -f ba} {-code 1 -level 0 -f ba} 24 {-code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 25 {-code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 26 {-code error -level X -f ba snarf} {-code error -level 0 -f ba snarf} 27 {-code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 28 {-code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 29 {-code 1 -level X -f ba} {-code 1 -level 0 -f ba} 30 {-code 0 -level X -f ba} {-code 1 -level 0 -f ba} 31 {-code error -level X -f ba} {-code error -level 0 -f ba} 32 {-code ok -level X -f ba} {-code 1 -level 0 -f ba} 33 {-code boss -level X -f ba} {-code 1 -level 0 -f ba} 34 {-code 1 -code 1 -level 0 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 35 {-code 1 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 36 {-code 1 -code 1 -level 5 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 37 {-code 1 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 38 {-code 1 -code error -level 0 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} 39 {-code 1 -code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 40 {-code 1 -code error -level 5 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} 41 {-code 1 -code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 42 {-code 1 -code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 43 {-code 1 -code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 44 {-code 1 -code 1 -level 0 -f ba} {-code 1 -code 1 -level 0 -f ba} 45 {-code 1 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} 46 {-code 1 -code 1 -level 5 -f ba} {-code 1 -code 1 -level 0 -f ba} 47 {-code 1 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} 48 {-code 1 -code error -level 0 -f ba} {-code 1 -code error -level 0 -f ba} 49 {-code 1 -code ok -level 0 -f ba} {-code 1 -level 0 -f ba} 50 {-code 1 -code error -level 5 -f ba} {-code 1 -code error -level 0 -f ba} 51 {-code 1 -code ok -level 5 -f ba} {-code 1 -level 0 -f ba} 52 {-code 1 -code boss -level 0 -f ba} {-code 1 -level 0 -f ba} 53 {-code 1 -code boss -level 5 -f ba} {-code 1 -level 0 -f ba} 54 {-code 1 -code 1 -level X -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 55 {-code 1 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 56 {-code 1 -code error -level X -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} 57 {-code 1 -code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 58 {-code 1 -code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 59 {-code 1 -code 1 -level X -f ba} {-code 1 -code 1 -level 0 -f ba} 60 {-code 1 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} 61 {-code 1 -code error -level X -f ba} {-code 1 -code error -level 0 -f ba} 62 {-code 1 -code ok -level X -f ba} {-code 1 -level 0 -f ba} 63 {-code 1 -code boss -level X -f ba} {-code 1 -level 0 -f ba} 64 {-code 0 -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 65 {-code 0 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 66 {-code 0 -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 67 {-code 0 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 68 {-code 0 -code error -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 69 {-code 0 -code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 70 {-code 0 -code error -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 71 {-code 0 -code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 72 {-code 0 -code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 73 {-code 0 -code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 74 {-code 0 -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} 75 {-code 0 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} 76 {-code 0 -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} 77 {-code 0 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} 78 {-code 0 -code error -level 0 -f ba} {-code 1 -level 0 -f ba} 79 {-code 0 -code ok -level 0 -f ba} {-code 1 -level 0 -f ba} 80 {-code 0 -code error -level 5 -f ba} {-code 1 -level 0 -f ba} 81 {-code 0 -code ok -level 5 -f ba} {-code 1 -level 0 -f ba} 82 {-code 0 -code boss -level 0 -f ba} {-code 1 -level 0 -f ba} 83 {-code 0 -code boss -level 5 -f ba} {-code 1 -level 0 -f ba} 84 {-code 0 -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 85 {-code 0 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 86 {-code 0 -code error -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 87 {-code 0 -code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 88 {-code 0 -code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 89 {-code 0 -code 1 -level X -f ba} {-code 1 -level 0 -f ba} 90 {-code 0 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} 91 {-code 0 -code error -level X -f ba} {-code 1 -level 0 -f ba} 92 {-code 0 -code ok -level X -f ba} {-code 1 -level 0 -f ba} 93 {-code 0 -code boss -level X -f ba} {-code 1 -level 0 -f ba} 94 {-code 1 -code 1 -level 0 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 95 {-code 0 -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 96 {-code 1 -code 1 -level 5 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 97 {-code 0 -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 98 {-code error -code 1 -level 0 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} 99 {-code ok -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} a0 {-code error -code 1 -level 5 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} a1 {-code ok -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} a2 {-code boss -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} a3 {-code boss -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} a4 {-code 1 -code 1 -level 0 -f ba} {-code 1 -code 1 -level 0 -f ba} a5 {-code 0 -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} a6 {-code 1 -code 1 -level 5 -f ba} {-code 1 -code 1 -level 0 -f ba} a7 {-code 0 -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} a8 {-code error -code 1 -level 0 -f ba} {-code error -code 1 -level 0 -f ba} a9 {-code ok -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} b0 {-code error -code 1 -level 5 -f ba} {-code error -code 1 -level 0 -f ba} b1 {-code ok -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} b2 {-code boss -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} b3 {-code boss -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} b4 {-code 1 -code 1 -level X -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} b5 {-code 0 -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} b6 {-code error -code 1 -level X -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} b7 {-code ok -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} b8 {-code boss -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} b9 {-code 1 -code 1 -level X -f ba} {-code 1 -code 1 -level 0 -f ba} c0 {-code 0 -code 1 -level X -f ba} {-code 1 -level 0 -f ba} c1 {-code error -code 1 -level X -f ba} {-code error -code 1 -level 0 -f ba} c2 {-code ok -code 1 -level X -f ba} {-code 1 -level 0 -f ba} c3 {-code boss -code 1 -level X -f ba} {-code 1 -level 0 -f ba} c4 {-code 1 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} c5 {-code 0 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} c6 {-code 1 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} c7 {-code 0 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} c8 {-code error -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} c9 {-code ok -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} d0 {-code error -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} d1 {-code ok -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} d2 {-code boss -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} d3 {-code boss -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} d4 {-code 1 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} d5 {-code 0 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} d6 {-code 1 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} d7 {-code 0 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} d8 {-code error -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} d9 {-code ok -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} e0 {-code error -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} e1 {-code ok -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} e2 {-code boss -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} e3 {-code boss -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} e4 {-code 1 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e5 {-code 0 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e6 {-code error -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e7 {-code ok -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e8 {-code boss -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e9 {-code 1 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} f0 {-code 0 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} f1 {-code error -code 0 -level X -f ba} {-code 1 -level 0 -f ba} f2 {-code ok -code 0 -level X -f ba} {-code 1 -level 0 -f ba} f3 {-code boss -code 0 -level X -f ba} {-code 1 -level 0 -f ba} } { test chan-io-71.$n {Tcl_SetChannelError} -setup { set f [makeFile {... dummy ...} cutsplice] } -constraints {testchannel} -body { set c [open $f r] testchannel setchannelerror $c [lrange $msg 0 end] } -cleanup { chan close $c removeFile cutsplice } -result [lrange $expected 0 end] test chan-io-72.$n {Tcl_SetChannelErrorInterp} -setup { set f [makeFile {... dummy ...} cutsplice] } -constraints {testchannel} -body { set c [open $f r] testchannel setchannelerrorinterp $c [lrange $msg 0 end] } -cleanup { chan close $c removeFile cutsplice } -result [lrange $expected 0 end] } test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} -body { # Test for Bug 1847044 - don't spoil type unless we have a valid channel chan close [lreplace [list a] 0 end] } -returnCodes error -match glob -result * # ### ### ### ######### ######### ######### # cleanup foreach file [list fooBar longfile script output test1 pipe my_script \ test2 test3 cat kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } cleanupTests } namespace delete ::tcl::test::io tcl8.6.14/tests/chan.test0000644000175000017500000002360514554262142014624 0ustar sergeisergei# This file contains a collection of tests for the Tcl built-in 'chan' # command. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright (c) 2005 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # # Note: The tests for the chan methods "create" and "postevent" # currently reside in the file "ioCmd.test". # test chan-1.1 {chan command general syntax} -body { chan } -returnCodes error -result "wrong # args: should be \"chan subcommand ?arg ...?\"" test chan-1.2 {chan command general syntax} -body { chan FOOBAR } -returnCodes error -match glob -result "unknown or ambiguous subcommand \"FOOBAR\": must be *" test chan-2.1 {chan command: blocked subcommand} -body { chan blocked foo bar } -returnCodes error -result "wrong # args: should be \"chan blocked channelId\"" test chan-3.1 {chan command: close subcommand} -body { chan close foo bar zet } -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\"" test chan-3.2 {chan command: close subcommand} -setup { set chan [open [info script] r] } -body { chan close $chan bar } -cleanup { close $chan } -returnCodes error -result "bad direction \"bar\": must be read or write" test chan-3.3 {chan command: close subcommand} -setup { set chan [open [info script] r] } -body { chan close $chan write } -cleanup { close $chan } -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" test chan-4.1 {chan command: configure subcommand} -body { chan configure } -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\"" test chan-4.2 {chan command: [Bug 800753]} -body { chan configure stdout -eofchar \u0100 } -returnCodes error -match glob -result {bad value*} test chan-4.3 {chan command: [Bug 800753]} -body { chan configure stdout -eofchar \u0000 } -returnCodes error -match glob -result {bad value*} test chan-4.4 {chan command: check valid inValue, no outValue} -body { chan configure stdout -eofchar [list \x27 {}] } -returnCodes ok -result {} test chan-4.5 {chan command: check valid inValue, invalid outValue} -body { chan configure stdout -eofchar [list \x27 \x80] } -returnCodes error -match glob -result {bad value for -eofchar:*} test chan-4.6 {chan command: check no inValue, valid outValue} -body { chan configure stdout -eofchar [list {} \x27] } -returnCodes ok -result {} -cleanup {chan configure stdout -eofchar [list {} {}]} test chan-5.1 {chan command: copy subcommand} -body { chan copy foo } -returnCodes error -result "wrong # args: should be \"chan copy input output ?-size size? ?-command callback?\"" test chan-6.1 {chan command: eof subcommand} -body { chan eof foo bar } -returnCodes error -result "wrong # args: should be \"chan eof channelId\"" test chan-7.1 {chan command: event subcommand} -body { chan event foo } -returnCodes error -result "wrong # args: should be \"chan event channelId event ?script?\"" test chan-8.1 {chan command: flush subcommand} -body { chan flush foo bar } -returnCodes error -result "wrong # args: should be \"chan flush channelId\"" test chan-9.1 {chan command: gets subcommand} -body { chan gets } -returnCodes error -result "wrong # args: should be \"chan gets channelId ?varName?\"" test chan-10.1 {chan command: names subcommand} -body { chan names foo bar } -returnCodes error -result "wrong # args: should be \"chan names ?pattern?\"" test chan-11.1 {chan command: puts subcommand} -body { chan puts foo bar foo bar } -returnCodes error -result "wrong # args: should be \"chan puts ?-nonewline? ?channelId? string\"" test chan-12.1 {chan command: read subcommand} -body { chan read } -returnCodes error -result "wrong # args: should be \"chan read channelId ?numChars?\" or \"chan read ?-nonewline? channelId\"" test chan-13.1 {chan command: seek subcommand} -body { chan seek foo bar foo bar } -returnCodes error -result "wrong # args: should be \"chan seek channelId offset ?origin?\"" test chan-14.1 {chan command: tell subcommand} -body { chan tell foo bar } -returnCodes error -result "wrong # args: should be \"chan tell channelId\"" test chan-15.1 {chan command: truncate subcommand} -body { chan truncate foo bar foo bar } -returnCodes error -result "wrong \# args: should be \"chan truncate channelId ?length?\"" test chan-15.2 {chan command: truncate subcommand} -setup { set file [makeFile {} testTruncate] set f [open $file w+] fconfigure $f -translation binary } -body { seek $f 0 puts -nonewline $f 12345 seek $f 0 chan truncate $f 2 read $f } -result 12 -cleanup { catch {close $f} catch {removeFile $file} } # TIP 287: chan pending test chan-16.1 {chan command: pending subcommand} -body { chan pending } -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" test chan-16.2 {chan command: pending subcommand} -body { chan pending stdin } -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" test chan-16.3 {chan command: pending subcommand} -body { chan pending stdin stdout stderr } -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" test chan-16.4 {chan command: pending subcommand} -body { chan pending {input output} stdout } -returnCodes error -result "bad mode \"input output\": must be input or output" test chan-16.5 {chan command: pending input subcommand} -body { chan pending input stdout } -result -1 test chan-16.6 {chan command: pending input subcommand} -body { chan pending input stdin } -result 0 test chan-16.7 {chan command: pending input subcommand} -body { chan pending input FOOBAR } -returnCodes error -result "can not find channel named \"FOOBAR\"" test chan-16.8 {chan command: pending input subcommand} -setup { set file [makeFile {} testAvailable] set f [open $file w+] chan configure $f -translation lf -buffering line } -body { chan puts $f foo chan puts $f bar chan puts $f baz chan seek $f 0 chan gets $f chan pending input $f } -result 8 -cleanup { catch {chan close $f} catch {removeFile $file} } test chan-16.9 {chan command: pending input subcommand} -setup { proc chan-16.9-accept {sock addr port} { chan configure $sock -blocking 0 -buffering line -buffersize 32 chan event $sock readable [list chan-16.9-readable $sock] } proc chan-16.9-readable {sock} { set r [chan gets $sock line] set l [string length $line] set e [chan eof $sock] set b [chan blocked $sock] set i [chan pending input $sock] lappend ::chan-16.9-data $r $l $e $b $i if {$r >= 0 || $e || $l || !$b || $i > 128} { set data [read $sock $i] lappend ::chan-16.9-data [string range $data 0 2] lappend ::chan-16.9-data [string range $data end-2 end] set ::chan-16.9-done 1 chan event $sock readable {} } else { after idle chan-16.9-client } } proc chan-16.9-client {} { chan puts -nonewline $::client ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 chan flush $::client } set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0] set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]] set ::chan-16.9-data [list] set ::chan-16.9-done 0 } -body { after idle chan-16.9-client vwait ::chan-16.9-done set ::chan-16.9-data } -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup { catch {chan close $client} catch {chan close $server} rename chan-16.9-accept {} rename chan-16.9-readable {} rename chan-16.9-client {} unset -nocomplain ::chan-16.9-data unset -nocomplain ::chan-16.9-done unset -nocomplain ::server unset -nocomplain ::client } test chan-16.10 {chan command: pending output subcommand} -body { chan pending output stdin } -result -1 test chan-16.11 {chan command: pending output subcommand} -body { chan pending output stdout } -result 0 test chan-16.12 {chan command: pending output subcommand} -body { chan pending output FOOBAR } -returnCodes error -result "can not find channel named \"FOOBAR\"" test chan-16.13 {chan command: pending output subcommand} -setup { set file [makeFile {} testPendingOutput] set f [open $file w+] chan configure $f -translation lf -buffering full -buffersize 1024 } -body { set result [list] chan puts $f [string repeat x 512] lappend result [chan pending output $f] chan flush $f lappend result [chan pending output $f] } -result [list 513 0] -cleanup { unset -nocomplain result catch {chan close $f} catch {removeFile $file} } # TIP 304: chan pipe test chan-17.1 {chan command: pipe subcommand} -body { chan pipe foo } -returnCodes error -result "wrong # args: should be \"chan pipe \"" test chan-17.2 {chan command: pipe subcommand} -body { chan pipe foo bar } -returnCodes error -result "wrong # args: should be \"chan pipe \"" test chan-17.3 {chan command: pipe subcommand} -body { set l [chan pipe] foreach {pr pw} $l break list [llength $l] [fconfigure $pr -blocking] [fconfigure $pw -blocking] } -result [list 2 1 1] -cleanup { close $pw close $pr } test chan-17.4 {chan command: pipe subcommand} -body { set ::done 0 foreach {::pr ::pw} [chan pipe] break after 100 {puts $::pw foo;flush $::pw} fileevent $::pr readable {set ::done 1} after 500 {set ::done -1} vwait ::done set out nope if {$::done==1} {gets $::pr out} list $::done $out } -result [list 1 foo] -cleanup { close $::pw close $::pr } cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/clock.test0000644000175000017500000725676514554262142015034 0ustar sergeisergei# clock.test -- # # This test file covers the 'clock' command that manipulates time. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } if {[testConstraint win]} { if {[catch { ::tcltest::loadTestedCommands package require registry }]} { namespace eval ::tcl::clock {variable NoRegistry {}} } } package require msgcat 1.4 testConstraint detroit \ [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}] testConstraint y2038 \ [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}] if {[namespace which -command ::tcl::unsupported::timerate] ne ""} { namespace import ::tcl::unsupported::timerate } # TEST PLAN # clock-1: # [clock format] - tests of bad and empty arguments # # clock-2 # formatting of year, month and day of month # # clock-3 # formatting of fiscal year, fiscal week and day of week. # # clock-4 # formatting of time of day. # # clock-5 # handling of Daylight Saving Time in a known locale, formatting of # %z and %Z # # clock-6 # input conversion - seconds # # clock-7 # input conversion - Julian Day # # clock-8 # input conversion - ccyymmdd # # clock-9 # input conversion - ccyymmdd (test that %s and %J take precedence) # # clock-10 # input conversion - ccyyddd # # clock-11 # input conversion - relative precedence of ccyyddd and ccyymmdd # (tests the 'rightmost field' comparison) # # clock-12 # input conversion - ccyyWwwd # # clock-13 # input conversion - ccyyWwwd (test that %s and %J take precedence, # and that invalid days are rejected). # # clock-14 # input conversion - yymmdd # # clock-15 # precedence - yymmdd # # clock-16 # input conversion and precedence - yyddd # # clock-17 # input conversion - yyWwwd # # clock-18 # precedence - yyWwwd # # clock-19 # input conversion - mmdd # # clock-20 # precedence - mmdd # # clock-21 # input conversion and precedence - ddd # # clock-22 # input conversion - Wwwd # # clock-23 # precedence - Wwwd # # clock-24 # input conversion - naked day of month # # clock-25 # precedence - naked day of month # # clock-26 # input conversion - naked day of week # # clock-27 # precedence - day of week # # clock-28 # scan with empty -format is midnight of base date # # clock-29 # scanning of all time-of-day formats # # clock-30 # [clock add] # # clock-31 # Use of -locale system on Windows # # clock-32 # Handling of the Julian-Gregorian transition # # clock-33 # Legacy tests - [clock clicks] # # clock-34 # Legacy tests - [clock scan] without -format # # clock-35 # Legacy tests - [clock seconds] # # clock-36 # Legacy tests - [clock scan] with 'next monthname' # # clock-37 # Test that -gmt does not affect the value of %s # # clock-38 # Regression test to verify that changes in TZ work # both east and west of Greenwich # Note that all code between comments '# BEGIN' and '# END' is # autogenerated by 'tools/makeTestCases.tcl'. DO NOT EDIT CODE BETWEEN # '# BEGIN' and '# END'. # Define a fictitious locale, 'en_US_roman', for formatting of clock # strings with localized numerics and eras. This locale will be used # in testing the 'clock' command. namespace eval ::tcl::clock { ::msgcat::mcmset en_US_roman { LOCALE_ERAS { {-62164627200 {} 0} {-59008867200 c 100} {-55853107200 cc 200} {-52697347200 ccc 300} {-49541587200 cd 400} {-46385827200 d 500} {-43230067200 dc 600} {-40074307200 dcc 700} {-36918547200 dccc 800} {-33762787200 cm 900} {-30607027200 m 1000} {-27451267200 mc 1100} {-24295507200 mcc 1200} {-21139747200 mccc 1300} {-17983987200 mcd 1400} {-14828227200 md 1500} {-11672467200 mdc 1600} {-8516707200 mdcc 1700} {-5364662400 mdccc 1800} {-2208988800 mcm 1900} {946684800 mm 2000} } LOCALE_NUMERALS { ? i ii iii iv v vi vii viii ix x xi xii xiii xiv xv xvi xvii xviii xix xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix l li lii liii liv lv lvi lvii lviii lix lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii lxxxix xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix c } DATE_FORMAT {%m/%d/%Y} TIME_FORMAT {%H:%M:%S} DATE_TIME_FORMAT {%x %X} LOCALE_DATE_FORMAT {die %Od mensis %Om annoque %EY} LOCALE_TIME_FORMAT {%OH h %OM m %OS s} LOCALE_DATE_TIME_FORMAT {%Ex %EX} BCE {Before Christ} CE {Anno Domini} } } #---------------------------------------------------------------------- # # The tests for the Windows platform are careful *not* to muck with # the system registry. Instead, the 'registry' command is overridden # in the '::tcl::clock' namespace. # #---------------------------------------------------------------------- namespace eval ::testClock { namespace export registry set reg \ [dict create \ HKEY_CURRENT_USER\\Control\ Panel\\International \ [dict create \ locale 0409 \ sShortDate dd-MMM-yyyy \ sLongDate "'the' dd''' day of' MMMM yyyy" \ sTimeFormat "h:mm:ss tt"] \ HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation \ [dict create \ Bias 300 \ StandardBias 0 \ DaylightBias -60 \ StandardStart \x00\x00\x0b\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \ DaylightStart \x00\x00\x03\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]] } proc ::testClock::registry { cmd path key } { variable reg if { $cmd ne {get} } { return -code error "test case attempts to write/query the registry" } if { ![dict exists $reg $path $key] } { return -code error "test case attempts to read unknown registry entry $path $key" } return [dict get $reg $path $key] } # Test some of the basics of [clock format] test clock-1.0 "clock format - wrong # args" { list [catch {clock format} msg] $msg $::errorCode } {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}} test clock-1.1 "clock format - bad time" { list [catch {clock format foo} msg] $msg } {1 {expected integer but got "foo"}} test clock-1.2 "clock format - bad gmt val" { list [catch {clock format 0 -gmt foo} msg] $msg } {1 {expected boolean value but got "foo"}} test clock-1.3 "clock format - empty val" { clock format 0 -gmt 1 -format "" } {} test clock-1.4 "clock format - bad flag" {*}{ -body { list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode } -match glob -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}} } test clock-1.5 "clock format - bad timezone" { list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode } {1 {time zone ":NOWHERE" not found} {CLOCK badTimeZone :NOWHERE}} test clock-1.6 "clock format - gmt + timezone" { list [catch {clock format 0 -timezone :GMT -gmt true} msg] $msg $::errorCode } {1 {cannot use -gmt and -timezone in same call} {CLOCK gmtWithTimezone}} test clock-1.7 "clock format - option abbreviations" { clock format 0 -g true -f "%Y-%m-%d" } 1970-01-01 # BEGIN testcases2 # Test formatting of Gregorian year, month, day, all formats # Formats tested: %b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y %EY test clock-2.1 {conversion of 1872-01-01} { clock format -3092556304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1872 12:34:56 die i mensis i annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2404794 01 i 1 01/01/1872 die i mensis i annoque mdccclxxii 72 lxxii 1872} test clock-2.2 {conversion of 1872-01-31} { clock format -3089964304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1872 12:34:56 die xxxi mensis i annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2404824 01 i 1 01/31/1872 die xxxi mensis i annoque mdccclxxii 72 lxxii 1872} test clock-2.3 {conversion of 1872-02-01} { clock format -3089877904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1872 12:34:56 die i mensis ii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2404825 02 ii 2 02/01/1872 die i mensis ii annoque mdccclxxii 72 lxxii 1872} test clock-2.4 {conversion of 1872-02-29} { clock format -3087458704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1872 12:34:56 die xxix mensis ii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 29 xxix 29 xxix Feb 060 2404853 02 ii 2 02/29/1872 die xxix mensis ii annoque mdccclxxii 72 lxxii 1872} test clock-2.5 {conversion of 1872-03-01} { clock format -3087372304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1872 12:34:56 die i mensis iii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 061 2404854 03 iii 3 03/01/1872 die i mensis iii annoque mdccclxxii 72 lxxii 1872} test clock-2.6 {conversion of 1872-03-31} { clock format -3084780304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1872 12:34:56 die xxxi mensis iii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 091 2404884 03 iii 3 03/31/1872 die xxxi mensis iii annoque mdccclxxii 72 lxxii 1872} test clock-2.7 {conversion of 1872-04-01} { clock format -3084693904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1872 12:34:56 die i mensis iv annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 092 2404885 04 iv 4 04/01/1872 die i mensis iv annoque mdccclxxii 72 lxxii 1872} test clock-2.8 {conversion of 1872-04-30} { clock format -3082188304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1872 12:34:56 die xxx mensis iv annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 121 2404914 04 iv 4 04/30/1872 die xxx mensis iv annoque mdccclxxii 72 lxxii 1872} test clock-2.9 {conversion of 1872-05-01} { clock format -3082101904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1872 12:34:56 die i mensis v annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 122 2404915 05 v 5 05/01/1872 die i mensis v annoque mdccclxxii 72 lxxii 1872} test clock-2.10 {conversion of 1872-05-31} { clock format -3079509904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1872 12:34:56 die xxxi mensis v annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 152 2404945 05 v 5 05/31/1872 die xxxi mensis v annoque mdccclxxii 72 lxxii 1872} test clock-2.11 {conversion of 1872-06-01} { clock format -3079423504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1872 12:34:56 die i mensis vi annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 153 2404946 06 vi 6 06/01/1872 die i mensis vi annoque mdccclxxii 72 lxxii 1872} test clock-2.12 {conversion of 1872-06-30} { clock format -3076917904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1872 12:34:56 die xxx mensis vi annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 182 2404975 06 vi 6 06/30/1872 die xxx mensis vi annoque mdccclxxii 72 lxxii 1872} test clock-2.13 {conversion of 1872-07-01} { clock format -3076831504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1872 12:34:56 die i mensis vii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 183 2404976 07 vii 7 07/01/1872 die i mensis vii annoque mdccclxxii 72 lxxii 1872} test clock-2.14 {conversion of 1872-07-31} { clock format -3074239504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1872 12:34:56 die xxxi mensis vii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 213 2405006 07 vii 7 07/31/1872 die xxxi mensis vii annoque mdccclxxii 72 lxxii 1872} test clock-2.15 {conversion of 1872-08-01} { clock format -3074153104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1872 12:34:56 die i mensis viii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 214 2405007 08 viii 8 08/01/1872 die i mensis viii annoque mdccclxxii 72 lxxii 1872} test clock-2.16 {conversion of 1872-08-31} { clock format -3071561104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1872 12:34:56 die xxxi mensis viii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 244 2405037 08 viii 8 08/31/1872 die xxxi mensis viii annoque mdccclxxii 72 lxxii 1872} test clock-2.17 {conversion of 1872-09-01} { clock format -3071474704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1872 12:34:56 die i mensis ix annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 245 2405038 09 ix 9 09/01/1872 die i mensis ix annoque mdccclxxii 72 lxxii 1872} test clock-2.18 {conversion of 1872-09-30} { clock format -3068969104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1872 12:34:56 die xxx mensis ix annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 274 2405067 09 ix 9 09/30/1872 die xxx mensis ix annoque mdccclxxii 72 lxxii 1872} test clock-2.19 {conversion of 1872-10-01} { clock format -3068882704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1872 12:34:56 die i mensis x annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 275 2405068 10 x 10 10/01/1872 die i mensis x annoque mdccclxxii 72 lxxii 1872} test clock-2.20 {conversion of 1872-10-31} { clock format -3066290704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1872 12:34:56 die xxxi mensis x annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 305 2405098 10 x 10 10/31/1872 die xxxi mensis x annoque mdccclxxii 72 lxxii 1872} test clock-2.21 {conversion of 1872-11-01} { clock format -3066204304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1872 12:34:56 die i mensis xi annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 306 2405099 11 xi 11 11/01/1872 die i mensis xi annoque mdccclxxii 72 lxxii 1872} test clock-2.22 {conversion of 1872-11-30} { clock format -3063698704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1872 12:34:56 die xxx mensis xi annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 335 2405128 11 xi 11 11/30/1872 die xxx mensis xi annoque mdccclxxii 72 lxxii 1872} test clock-2.23 {conversion of 1872-12-01} { clock format -3063612304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1872 12:34:56 die i mensis xii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 336 2405129 12 xii 12 12/01/1872 die i mensis xii annoque mdccclxxii 72 lxxii 1872} test clock-2.24 {conversion of 1872-12-31} { clock format -3061020304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1872 12:34:56 die xxxi mensis xii annoque mdccclxxii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 366 2405159 12 xii 12 12/31/1872 die xxxi mensis xii annoque mdccclxxii 72 lxxii 1872} test clock-2.25 {conversion of 1873-01-01} { clock format -3060933904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1873 12:34:56 die i mensis i annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2405160 01 i 1 01/01/1873 die i mensis i annoque mdccclxxiii 73 lxxiii 1873} test clock-2.26 {conversion of 1873-01-31} { clock format -3058341904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1873 12:34:56 die xxxi mensis i annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2405190 01 i 1 01/31/1873 die xxxi mensis i annoque mdccclxxiii 73 lxxiii 1873} test clock-2.27 {conversion of 1873-02-01} { clock format -3058255504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1873 12:34:56 die i mensis ii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2405191 02 ii 2 02/01/1873 die i mensis ii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.28 {conversion of 1873-02-28} { clock format -3055922704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1873 12:34:56 die xxviii mensis ii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2405218 02 ii 2 02/28/1873 die xxviii mensis ii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.29 {conversion of 1873-03-01} { clock format -3055836304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1873 12:34:56 die i mensis iii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2405219 03 iii 3 03/01/1873 die i mensis iii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.30 {conversion of 1873-03-31} { clock format -3053244304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1873 12:34:56 die xxxi mensis iii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2405249 03 iii 3 03/31/1873 die xxxi mensis iii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.31 {conversion of 1873-04-01} { clock format -3053157904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1873 12:34:56 die i mensis iv annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2405250 04 iv 4 04/01/1873 die i mensis iv annoque mdccclxxiii 73 lxxiii 1873} test clock-2.32 {conversion of 1873-04-30} { clock format -3050652304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1873 12:34:56 die xxx mensis iv annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2405279 04 iv 4 04/30/1873 die xxx mensis iv annoque mdccclxxiii 73 lxxiii 1873} test clock-2.33 {conversion of 1873-05-01} { clock format -3050565904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1873 12:34:56 die i mensis v annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2405280 05 v 5 05/01/1873 die i mensis v annoque mdccclxxiii 73 lxxiii 1873} test clock-2.34 {conversion of 1873-05-31} { clock format -3047973904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1873 12:34:56 die xxxi mensis v annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2405310 05 v 5 05/31/1873 die xxxi mensis v annoque mdccclxxiii 73 lxxiii 1873} test clock-2.35 {conversion of 1873-06-01} { clock format -3047887504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1873 12:34:56 die i mensis vi annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2405311 06 vi 6 06/01/1873 die i mensis vi annoque mdccclxxiii 73 lxxiii 1873} test clock-2.36 {conversion of 1873-06-30} { clock format -3045381904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1873 12:34:56 die xxx mensis vi annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2405340 06 vi 6 06/30/1873 die xxx mensis vi annoque mdccclxxiii 73 lxxiii 1873} test clock-2.37 {conversion of 1873-07-01} { clock format -3045295504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1873 12:34:56 die i mensis vii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2405341 07 vii 7 07/01/1873 die i mensis vii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.38 {conversion of 1873-07-31} { clock format -3042703504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1873 12:34:56 die xxxi mensis vii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2405371 07 vii 7 07/31/1873 die xxxi mensis vii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.39 {conversion of 1873-08-01} { clock format -3042617104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1873 12:34:56 die i mensis viii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2405372 08 viii 8 08/01/1873 die i mensis viii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.40 {conversion of 1873-08-31} { clock format -3040025104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1873 12:34:56 die xxxi mensis viii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2405402 08 viii 8 08/31/1873 die xxxi mensis viii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.41 {conversion of 1873-09-01} { clock format -3039938704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1873 12:34:56 die i mensis ix annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2405403 09 ix 9 09/01/1873 die i mensis ix annoque mdccclxxiii 73 lxxiii 1873} test clock-2.42 {conversion of 1873-09-30} { clock format -3037433104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1873 12:34:56 die xxx mensis ix annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2405432 09 ix 9 09/30/1873 die xxx mensis ix annoque mdccclxxiii 73 lxxiii 1873} test clock-2.43 {conversion of 1873-10-01} { clock format -3037346704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1873 12:34:56 die i mensis x annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2405433 10 x 10 10/01/1873 die i mensis x annoque mdccclxxiii 73 lxxiii 1873} test clock-2.44 {conversion of 1873-10-31} { clock format -3034754704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1873 12:34:56 die xxxi mensis x annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2405463 10 x 10 10/31/1873 die xxxi mensis x annoque mdccclxxiii 73 lxxiii 1873} test clock-2.45 {conversion of 1873-11-01} { clock format -3034668304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1873 12:34:56 die i mensis xi annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2405464 11 xi 11 11/01/1873 die i mensis xi annoque mdccclxxiii 73 lxxiii 1873} test clock-2.46 {conversion of 1873-11-30} { clock format -3032162704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1873 12:34:56 die xxx mensis xi annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2405493 11 xi 11 11/30/1873 die xxx mensis xi annoque mdccclxxiii 73 lxxiii 1873} test clock-2.47 {conversion of 1873-12-01} { clock format -3032076304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1873 12:34:56 die i mensis xii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2405494 12 xii 12 12/01/1873 die i mensis xii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.48 {conversion of 1873-12-31} { clock format -3029484304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1873 12:34:56 die xxxi mensis xii annoque mdccclxxiii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2405524 12 xii 12 12/31/1873 die xxxi mensis xii annoque mdccclxxiii 73 lxxiii 1873} test clock-2.49 {conversion of 1876-01-01} { clock format -2966325904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1876 12:34:56 die i mensis i annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2406255 01 i 1 01/01/1876 die i mensis i annoque mdccclxxvi 76 lxxvi 1876} test clock-2.50 {conversion of 1876-01-31} { clock format -2963733904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1876 12:34:56 die xxxi mensis i annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2406285 01 i 1 01/31/1876 die xxxi mensis i annoque mdccclxxvi 76 lxxvi 1876} test clock-2.51 {conversion of 1876-02-01} { clock format -2963647504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1876 12:34:56 die i mensis ii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2406286 02 ii 2 02/01/1876 die i mensis ii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.52 {conversion of 1876-02-29} { clock format -2961228304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1876 12:34:56 die xxix mensis ii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 29 xxix 29 xxix Feb 060 2406314 02 ii 2 02/29/1876 die xxix mensis ii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.53 {conversion of 1876-03-01} { clock format -2961141904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1876 12:34:56 die i mensis iii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 061 2406315 03 iii 3 03/01/1876 die i mensis iii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.54 {conversion of 1876-03-31} { clock format -2958549904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1876 12:34:56 die xxxi mensis iii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 091 2406345 03 iii 3 03/31/1876 die xxxi mensis iii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.55 {conversion of 1876-04-01} { clock format -2958463504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1876 12:34:56 die i mensis iv annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 092 2406346 04 iv 4 04/01/1876 die i mensis iv annoque mdccclxxvi 76 lxxvi 1876} test clock-2.56 {conversion of 1876-04-30} { clock format -2955957904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1876 12:34:56 die xxx mensis iv annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 121 2406375 04 iv 4 04/30/1876 die xxx mensis iv annoque mdccclxxvi 76 lxxvi 1876} test clock-2.57 {conversion of 1876-05-01} { clock format -2955871504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1876 12:34:56 die i mensis v annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 122 2406376 05 v 5 05/01/1876 die i mensis v annoque mdccclxxvi 76 lxxvi 1876} test clock-2.58 {conversion of 1876-05-31} { clock format -2953279504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1876 12:34:56 die xxxi mensis v annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 152 2406406 05 v 5 05/31/1876 die xxxi mensis v annoque mdccclxxvi 76 lxxvi 1876} test clock-2.59 {conversion of 1876-06-01} { clock format -2953193104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1876 12:34:56 die i mensis vi annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 153 2406407 06 vi 6 06/01/1876 die i mensis vi annoque mdccclxxvi 76 lxxvi 1876} test clock-2.60 {conversion of 1876-06-30} { clock format -2950687504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1876 12:34:56 die xxx mensis vi annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 182 2406436 06 vi 6 06/30/1876 die xxx mensis vi annoque mdccclxxvi 76 lxxvi 1876} test clock-2.61 {conversion of 1876-07-01} { clock format -2950601104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1876 12:34:56 die i mensis vii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 183 2406437 07 vii 7 07/01/1876 die i mensis vii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.62 {conversion of 1876-07-31} { clock format -2948009104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1876 12:34:56 die xxxi mensis vii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 213 2406467 07 vii 7 07/31/1876 die xxxi mensis vii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.63 {conversion of 1876-08-01} { clock format -2947922704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1876 12:34:56 die i mensis viii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 214 2406468 08 viii 8 08/01/1876 die i mensis viii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.64 {conversion of 1876-08-31} { clock format -2945330704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1876 12:34:56 die xxxi mensis viii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 244 2406498 08 viii 8 08/31/1876 die xxxi mensis viii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.65 {conversion of 1876-09-01} { clock format -2945244304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1876 12:34:56 die i mensis ix annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 245 2406499 09 ix 9 09/01/1876 die i mensis ix annoque mdccclxxvi 76 lxxvi 1876} test clock-2.66 {conversion of 1876-09-30} { clock format -2942738704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1876 12:34:56 die xxx mensis ix annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 274 2406528 09 ix 9 09/30/1876 die xxx mensis ix annoque mdccclxxvi 76 lxxvi 1876} test clock-2.67 {conversion of 1876-10-01} { clock format -2942652304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1876 12:34:56 die i mensis x annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 275 2406529 10 x 10 10/01/1876 die i mensis x annoque mdccclxxvi 76 lxxvi 1876} test clock-2.68 {conversion of 1876-10-31} { clock format -2940060304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1876 12:34:56 die xxxi mensis x annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 305 2406559 10 x 10 10/31/1876 die xxxi mensis x annoque mdccclxxvi 76 lxxvi 1876} test clock-2.69 {conversion of 1876-11-01} { clock format -2939973904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1876 12:34:56 die i mensis xi annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 306 2406560 11 xi 11 11/01/1876 die i mensis xi annoque mdccclxxvi 76 lxxvi 1876} test clock-2.70 {conversion of 1876-11-30} { clock format -2937468304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1876 12:34:56 die xxx mensis xi annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 335 2406589 11 xi 11 11/30/1876 die xxx mensis xi annoque mdccclxxvi 76 lxxvi 1876} test clock-2.71 {conversion of 1876-12-01} { clock format -2937381904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1876 12:34:56 die i mensis xii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 336 2406590 12 xii 12 12/01/1876 die i mensis xii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.72 {conversion of 1876-12-31} { clock format -2934789904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1876 12:34:56 die xxxi mensis xii annoque mdccclxxvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 366 2406620 12 xii 12 12/31/1876 die xxxi mensis xii annoque mdccclxxvi 76 lxxvi 1876} test clock-2.73 {conversion of 1877-01-01} { clock format -2934703504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1877 12:34:56 die i mensis i annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2406621 01 i 1 01/01/1877 die i mensis i annoque mdccclxxvii 77 lxxvii 1877} test clock-2.74 {conversion of 1877-01-31} { clock format -2932111504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1877 12:34:56 die xxxi mensis i annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2406651 01 i 1 01/31/1877 die xxxi mensis i annoque mdccclxxvii 77 lxxvii 1877} test clock-2.75 {conversion of 1877-02-01} { clock format -2932025104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1877 12:34:56 die i mensis ii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2406652 02 ii 2 02/01/1877 die i mensis ii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.76 {conversion of 1877-02-28} { clock format -2929692304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1877 12:34:56 die xxviii mensis ii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2406679 02 ii 2 02/28/1877 die xxviii mensis ii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.77 {conversion of 1877-03-01} { clock format -2929605904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1877 12:34:56 die i mensis iii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2406680 03 iii 3 03/01/1877 die i mensis iii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.78 {conversion of 1877-03-31} { clock format -2927013904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1877 12:34:56 die xxxi mensis iii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2406710 03 iii 3 03/31/1877 die xxxi mensis iii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.79 {conversion of 1877-04-01} { clock format -2926927504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1877 12:34:56 die i mensis iv annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2406711 04 iv 4 04/01/1877 die i mensis iv annoque mdccclxxvii 77 lxxvii 1877} test clock-2.80 {conversion of 1877-04-30} { clock format -2924421904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1877 12:34:56 die xxx mensis iv annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2406740 04 iv 4 04/30/1877 die xxx mensis iv annoque mdccclxxvii 77 lxxvii 1877} test clock-2.81 {conversion of 1877-05-01} { clock format -2924335504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1877 12:34:56 die i mensis v annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2406741 05 v 5 05/01/1877 die i mensis v annoque mdccclxxvii 77 lxxvii 1877} test clock-2.82 {conversion of 1877-05-31} { clock format -2921743504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1877 12:34:56 die xxxi mensis v annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2406771 05 v 5 05/31/1877 die xxxi mensis v annoque mdccclxxvii 77 lxxvii 1877} test clock-2.83 {conversion of 1877-06-01} { clock format -2921657104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1877 12:34:56 die i mensis vi annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2406772 06 vi 6 06/01/1877 die i mensis vi annoque mdccclxxvii 77 lxxvii 1877} test clock-2.84 {conversion of 1877-06-30} { clock format -2919151504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1877 12:34:56 die xxx mensis vi annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2406801 06 vi 6 06/30/1877 die xxx mensis vi annoque mdccclxxvii 77 lxxvii 1877} test clock-2.85 {conversion of 1877-07-01} { clock format -2919065104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1877 12:34:56 die i mensis vii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2406802 07 vii 7 07/01/1877 die i mensis vii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.86 {conversion of 1877-07-31} { clock format -2916473104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1877 12:34:56 die xxxi mensis vii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2406832 07 vii 7 07/31/1877 die xxxi mensis vii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.87 {conversion of 1877-08-01} { clock format -2916386704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1877 12:34:56 die i mensis viii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2406833 08 viii 8 08/01/1877 die i mensis viii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.88 {conversion of 1877-08-31} { clock format -2913794704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1877 12:34:56 die xxxi mensis viii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2406863 08 viii 8 08/31/1877 die xxxi mensis viii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.89 {conversion of 1877-09-01} { clock format -2913708304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1877 12:34:56 die i mensis ix annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2406864 09 ix 9 09/01/1877 die i mensis ix annoque mdccclxxvii 77 lxxvii 1877} test clock-2.90 {conversion of 1877-09-30} { clock format -2911202704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1877 12:34:56 die xxx mensis ix annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2406893 09 ix 9 09/30/1877 die xxx mensis ix annoque mdccclxxvii 77 lxxvii 1877} test clock-2.91 {conversion of 1877-10-01} { clock format -2911116304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1877 12:34:56 die i mensis x annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2406894 10 x 10 10/01/1877 die i mensis x annoque mdccclxxvii 77 lxxvii 1877} test clock-2.92 {conversion of 1877-10-31} { clock format -2908524304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1877 12:34:56 die xxxi mensis x annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2406924 10 x 10 10/31/1877 die xxxi mensis x annoque mdccclxxvii 77 lxxvii 1877} test clock-2.93 {conversion of 1877-11-01} { clock format -2908437904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1877 12:34:56 die i mensis xi annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2406925 11 xi 11 11/01/1877 die i mensis xi annoque mdccclxxvii 77 lxxvii 1877} test clock-2.94 {conversion of 1877-11-30} { clock format -2905932304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1877 12:34:56 die xxx mensis xi annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2406954 11 xi 11 11/30/1877 die xxx mensis xi annoque mdccclxxvii 77 lxxvii 1877} test clock-2.95 {conversion of 1877-12-01} { clock format -2905845904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1877 12:34:56 die i mensis xii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2406955 12 xii 12 12/01/1877 die i mensis xii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.96 {conversion of 1877-12-31} { clock format -2903253904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1877 12:34:56 die xxxi mensis xii annoque mdccclxxvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2406985 12 xii 12 12/31/1877 die xxxi mensis xii annoque mdccclxxvii 77 lxxvii 1877} test clock-2.97 {conversion of 1880-01-01} { clock format -2840095504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1880 12:34:56 die i mensis i annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2407716 01 i 1 01/01/1880 die i mensis i annoque mdccclxxx 80 lxxx 1880} test clock-2.98 {conversion of 1880-01-31} { clock format -2837503504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1880 12:34:56 die xxxi mensis i annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2407746 01 i 1 01/31/1880 die xxxi mensis i annoque mdccclxxx 80 lxxx 1880} test clock-2.99 {conversion of 1880-02-01} { clock format -2837417104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1880 12:34:56 die i mensis ii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2407747 02 ii 2 02/01/1880 die i mensis ii annoque mdccclxxx 80 lxxx 1880} test clock-2.100 {conversion of 1880-02-29} { clock format -2834997904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1880 12:34:56 die xxix mensis ii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 29 xxix 29 xxix Feb 060 2407775 02 ii 2 02/29/1880 die xxix mensis ii annoque mdccclxxx 80 lxxx 1880} test clock-2.101 {conversion of 1880-03-01} { clock format -2834911504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1880 12:34:56 die i mensis iii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 061 2407776 03 iii 3 03/01/1880 die i mensis iii annoque mdccclxxx 80 lxxx 1880} test clock-2.102 {conversion of 1880-03-31} { clock format -2832319504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1880 12:34:56 die xxxi mensis iii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 091 2407806 03 iii 3 03/31/1880 die xxxi mensis iii annoque mdccclxxx 80 lxxx 1880} test clock-2.103 {conversion of 1880-04-01} { clock format -2832233104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1880 12:34:56 die i mensis iv annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 092 2407807 04 iv 4 04/01/1880 die i mensis iv annoque mdccclxxx 80 lxxx 1880} test clock-2.104 {conversion of 1880-04-30} { clock format -2829727504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1880 12:34:56 die xxx mensis iv annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 121 2407836 04 iv 4 04/30/1880 die xxx mensis iv annoque mdccclxxx 80 lxxx 1880} test clock-2.105 {conversion of 1880-05-01} { clock format -2829641104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1880 12:34:56 die i mensis v annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 122 2407837 05 v 5 05/01/1880 die i mensis v annoque mdccclxxx 80 lxxx 1880} test clock-2.106 {conversion of 1880-05-31} { clock format -2827049104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1880 12:34:56 die xxxi mensis v annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 152 2407867 05 v 5 05/31/1880 die xxxi mensis v annoque mdccclxxx 80 lxxx 1880} test clock-2.107 {conversion of 1880-06-01} { clock format -2826962704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1880 12:34:56 die i mensis vi annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 153 2407868 06 vi 6 06/01/1880 die i mensis vi annoque mdccclxxx 80 lxxx 1880} test clock-2.108 {conversion of 1880-06-30} { clock format -2824457104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1880 12:34:56 die xxx mensis vi annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 182 2407897 06 vi 6 06/30/1880 die xxx mensis vi annoque mdccclxxx 80 lxxx 1880} test clock-2.109 {conversion of 1880-07-01} { clock format -2824370704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1880 12:34:56 die i mensis vii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 183 2407898 07 vii 7 07/01/1880 die i mensis vii annoque mdccclxxx 80 lxxx 1880} test clock-2.110 {conversion of 1880-07-31} { clock format -2821778704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1880 12:34:56 die xxxi mensis vii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 213 2407928 07 vii 7 07/31/1880 die xxxi mensis vii annoque mdccclxxx 80 lxxx 1880} test clock-2.111 {conversion of 1880-08-01} { clock format -2821692304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1880 12:34:56 die i mensis viii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 214 2407929 08 viii 8 08/01/1880 die i mensis viii annoque mdccclxxx 80 lxxx 1880} test clock-2.112 {conversion of 1880-08-31} { clock format -2819100304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1880 12:34:56 die xxxi mensis viii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 244 2407959 08 viii 8 08/31/1880 die xxxi mensis viii annoque mdccclxxx 80 lxxx 1880} test clock-2.113 {conversion of 1880-09-01} { clock format -2819013904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1880 12:34:56 die i mensis ix annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 245 2407960 09 ix 9 09/01/1880 die i mensis ix annoque mdccclxxx 80 lxxx 1880} test clock-2.114 {conversion of 1880-09-30} { clock format -2816508304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1880 12:34:56 die xxx mensis ix annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 274 2407989 09 ix 9 09/30/1880 die xxx mensis ix annoque mdccclxxx 80 lxxx 1880} test clock-2.115 {conversion of 1880-10-01} { clock format -2816421904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1880 12:34:56 die i mensis x annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 275 2407990 10 x 10 10/01/1880 die i mensis x annoque mdccclxxx 80 lxxx 1880} test clock-2.116 {conversion of 1880-10-31} { clock format -2813829904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1880 12:34:56 die xxxi mensis x annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 305 2408020 10 x 10 10/31/1880 die xxxi mensis x annoque mdccclxxx 80 lxxx 1880} test clock-2.117 {conversion of 1880-11-01} { clock format -2813743504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1880 12:34:56 die i mensis xi annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 306 2408021 11 xi 11 11/01/1880 die i mensis xi annoque mdccclxxx 80 lxxx 1880} test clock-2.118 {conversion of 1880-11-30} { clock format -2811237904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1880 12:34:56 die xxx mensis xi annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 335 2408050 11 xi 11 11/30/1880 die xxx mensis xi annoque mdccclxxx 80 lxxx 1880} test clock-2.119 {conversion of 1880-12-01} { clock format -2811151504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1880 12:34:56 die i mensis xii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 336 2408051 12 xii 12 12/01/1880 die i mensis xii annoque mdccclxxx 80 lxxx 1880} test clock-2.120 {conversion of 1880-12-31} { clock format -2808559504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1880 12:34:56 die xxxi mensis xii annoque mdccclxxx xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 366 2408081 12 xii 12 12/31/1880 die xxxi mensis xii annoque mdccclxxx 80 lxxx 1880} test clock-2.121 {conversion of 1881-01-01} { clock format -2808473104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1881 12:34:56 die i mensis i annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2408082 01 i 1 01/01/1881 die i mensis i annoque mdccclxxxi 81 lxxxi 1881} test clock-2.122 {conversion of 1881-01-31} { clock format -2805881104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1881 12:34:56 die xxxi mensis i annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2408112 01 i 1 01/31/1881 die xxxi mensis i annoque mdccclxxxi 81 lxxxi 1881} test clock-2.123 {conversion of 1881-02-01} { clock format -2805794704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1881 12:34:56 die i mensis ii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2408113 02 ii 2 02/01/1881 die i mensis ii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.124 {conversion of 1881-02-28} { clock format -2803461904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1881 12:34:56 die xxviii mensis ii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2408140 02 ii 2 02/28/1881 die xxviii mensis ii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.125 {conversion of 1881-03-01} { clock format -2803375504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1881 12:34:56 die i mensis iii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2408141 03 iii 3 03/01/1881 die i mensis iii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.126 {conversion of 1881-03-31} { clock format -2800783504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1881 12:34:56 die xxxi mensis iii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2408171 03 iii 3 03/31/1881 die xxxi mensis iii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.127 {conversion of 1881-04-01} { clock format -2800697104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1881 12:34:56 die i mensis iv annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2408172 04 iv 4 04/01/1881 die i mensis iv annoque mdccclxxxi 81 lxxxi 1881} test clock-2.128 {conversion of 1881-04-30} { clock format -2798191504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1881 12:34:56 die xxx mensis iv annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2408201 04 iv 4 04/30/1881 die xxx mensis iv annoque mdccclxxxi 81 lxxxi 1881} test clock-2.129 {conversion of 1881-05-01} { clock format -2798105104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1881 12:34:56 die i mensis v annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2408202 05 v 5 05/01/1881 die i mensis v annoque mdccclxxxi 81 lxxxi 1881} test clock-2.130 {conversion of 1881-05-31} { clock format -2795513104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1881 12:34:56 die xxxi mensis v annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2408232 05 v 5 05/31/1881 die xxxi mensis v annoque mdccclxxxi 81 lxxxi 1881} test clock-2.131 {conversion of 1881-06-01} { clock format -2795426704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1881 12:34:56 die i mensis vi annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2408233 06 vi 6 06/01/1881 die i mensis vi annoque mdccclxxxi 81 lxxxi 1881} test clock-2.132 {conversion of 1881-06-30} { clock format -2792921104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1881 12:34:56 die xxx mensis vi annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2408262 06 vi 6 06/30/1881 die xxx mensis vi annoque mdccclxxxi 81 lxxxi 1881} test clock-2.133 {conversion of 1881-07-01} { clock format -2792834704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1881 12:34:56 die i mensis vii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2408263 07 vii 7 07/01/1881 die i mensis vii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.134 {conversion of 1881-07-31} { clock format -2790242704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1881 12:34:56 die xxxi mensis vii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2408293 07 vii 7 07/31/1881 die xxxi mensis vii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.135 {conversion of 1881-08-01} { clock format -2790156304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1881 12:34:56 die i mensis viii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2408294 08 viii 8 08/01/1881 die i mensis viii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.136 {conversion of 1881-08-31} { clock format -2787564304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1881 12:34:56 die xxxi mensis viii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2408324 08 viii 8 08/31/1881 die xxxi mensis viii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.137 {conversion of 1881-09-01} { clock format -2787477904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1881 12:34:56 die i mensis ix annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2408325 09 ix 9 09/01/1881 die i mensis ix annoque mdccclxxxi 81 lxxxi 1881} test clock-2.138 {conversion of 1881-09-30} { clock format -2784972304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1881 12:34:56 die xxx mensis ix annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2408354 09 ix 9 09/30/1881 die xxx mensis ix annoque mdccclxxxi 81 lxxxi 1881} test clock-2.139 {conversion of 1881-10-01} { clock format -2784885904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1881 12:34:56 die i mensis x annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2408355 10 x 10 10/01/1881 die i mensis x annoque mdccclxxxi 81 lxxxi 1881} test clock-2.140 {conversion of 1881-10-31} { clock format -2782293904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1881 12:34:56 die xxxi mensis x annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2408385 10 x 10 10/31/1881 die xxxi mensis x annoque mdccclxxxi 81 lxxxi 1881} test clock-2.141 {conversion of 1881-11-01} { clock format -2782207504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1881 12:34:56 die i mensis xi annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2408386 11 xi 11 11/01/1881 die i mensis xi annoque mdccclxxxi 81 lxxxi 1881} test clock-2.142 {conversion of 1881-11-30} { clock format -2779701904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1881 12:34:56 die xxx mensis xi annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2408415 11 xi 11 11/30/1881 die xxx mensis xi annoque mdccclxxxi 81 lxxxi 1881} test clock-2.143 {conversion of 1881-12-01} { clock format -2779615504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1881 12:34:56 die i mensis xii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2408416 12 xii 12 12/01/1881 die i mensis xii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.144 {conversion of 1881-12-31} { clock format -2777023504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1881 12:34:56 die xxxi mensis xii annoque mdccclxxxi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2408446 12 xii 12 12/31/1881 die xxxi mensis xii annoque mdccclxxxi 81 lxxxi 1881} test clock-2.145 {conversion of 1884-01-01} { clock format -2713865104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1884 12:34:56 die i mensis i annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2409177 01 i 1 01/01/1884 die i mensis i annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.146 {conversion of 1884-01-31} { clock format -2711273104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1884 12:34:56 die xxxi mensis i annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2409207 01 i 1 01/31/1884 die xxxi mensis i annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.147 {conversion of 1884-02-01} { clock format -2711186704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1884 12:34:56 die i mensis ii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2409208 02 ii 2 02/01/1884 die i mensis ii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.148 {conversion of 1884-02-29} { clock format -2708767504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1884 12:34:56 die xxix mensis ii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 29 xxix 29 xxix Feb 060 2409236 02 ii 2 02/29/1884 die xxix mensis ii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.149 {conversion of 1884-03-01} { clock format -2708681104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1884 12:34:56 die i mensis iii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 061 2409237 03 iii 3 03/01/1884 die i mensis iii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.150 {conversion of 1884-03-31} { clock format -2706089104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1884 12:34:56 die xxxi mensis iii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 091 2409267 03 iii 3 03/31/1884 die xxxi mensis iii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.151 {conversion of 1884-04-01} { clock format -2706002704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1884 12:34:56 die i mensis iv annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 092 2409268 04 iv 4 04/01/1884 die i mensis iv annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.152 {conversion of 1884-04-30} { clock format -2703497104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1884 12:34:56 die xxx mensis iv annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 121 2409297 04 iv 4 04/30/1884 die xxx mensis iv annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.153 {conversion of 1884-05-01} { clock format -2703410704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1884 12:34:56 die i mensis v annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 122 2409298 05 v 5 05/01/1884 die i mensis v annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.154 {conversion of 1884-05-31} { clock format -2700818704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1884 12:34:56 die xxxi mensis v annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 152 2409328 05 v 5 05/31/1884 die xxxi mensis v annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.155 {conversion of 1884-06-01} { clock format -2700732304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1884 12:34:56 die i mensis vi annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 153 2409329 06 vi 6 06/01/1884 die i mensis vi annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.156 {conversion of 1884-06-30} { clock format -2698226704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1884 12:34:56 die xxx mensis vi annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 182 2409358 06 vi 6 06/30/1884 die xxx mensis vi annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.157 {conversion of 1884-07-01} { clock format -2698140304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1884 12:34:56 die i mensis vii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 183 2409359 07 vii 7 07/01/1884 die i mensis vii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.158 {conversion of 1884-07-31} { clock format -2695548304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1884 12:34:56 die xxxi mensis vii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 213 2409389 07 vii 7 07/31/1884 die xxxi mensis vii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.159 {conversion of 1884-08-01} { clock format -2695461904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1884 12:34:56 die i mensis viii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 214 2409390 08 viii 8 08/01/1884 die i mensis viii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.160 {conversion of 1884-08-31} { clock format -2692869904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1884 12:34:56 die xxxi mensis viii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 244 2409420 08 viii 8 08/31/1884 die xxxi mensis viii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.161 {conversion of 1884-09-01} { clock format -2692783504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1884 12:34:56 die i mensis ix annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 245 2409421 09 ix 9 09/01/1884 die i mensis ix annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.162 {conversion of 1884-09-30} { clock format -2690277904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1884 12:34:56 die xxx mensis ix annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 274 2409450 09 ix 9 09/30/1884 die xxx mensis ix annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.163 {conversion of 1884-10-01} { clock format -2690191504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1884 12:34:56 die i mensis x annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 275 2409451 10 x 10 10/01/1884 die i mensis x annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.164 {conversion of 1884-10-31} { clock format -2687599504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1884 12:34:56 die xxxi mensis x annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 305 2409481 10 x 10 10/31/1884 die xxxi mensis x annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.165 {conversion of 1884-11-01} { clock format -2687513104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1884 12:34:56 die i mensis xi annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 306 2409482 11 xi 11 11/01/1884 die i mensis xi annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.166 {conversion of 1884-11-30} { clock format -2685007504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1884 12:34:56 die xxx mensis xi annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 335 2409511 11 xi 11 11/30/1884 die xxx mensis xi annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.167 {conversion of 1884-12-01} { clock format -2684921104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1884 12:34:56 die i mensis xii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 336 2409512 12 xii 12 12/01/1884 die i mensis xii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.168 {conversion of 1884-12-31} { clock format -2682329104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1884 12:34:56 die xxxi mensis xii annoque mdccclxxxiv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 366 2409542 12 xii 12 12/31/1884 die xxxi mensis xii annoque mdccclxxxiv 84 lxxxiv 1884} test clock-2.169 {conversion of 1885-01-01} { clock format -2682242704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1885 12:34:56 die i mensis i annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2409543 01 i 1 01/01/1885 die i mensis i annoque mdccclxxxv 85 lxxxv 1885} test clock-2.170 {conversion of 1885-01-31} { clock format -2679650704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1885 12:34:56 die xxxi mensis i annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2409573 01 i 1 01/31/1885 die xxxi mensis i annoque mdccclxxxv 85 lxxxv 1885} test clock-2.171 {conversion of 1885-02-01} { clock format -2679564304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1885 12:34:56 die i mensis ii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2409574 02 ii 2 02/01/1885 die i mensis ii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.172 {conversion of 1885-02-28} { clock format -2677231504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1885 12:34:56 die xxviii mensis ii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2409601 02 ii 2 02/28/1885 die xxviii mensis ii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.173 {conversion of 1885-03-01} { clock format -2677145104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1885 12:34:56 die i mensis iii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2409602 03 iii 3 03/01/1885 die i mensis iii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.174 {conversion of 1885-03-31} { clock format -2674553104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1885 12:34:56 die xxxi mensis iii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2409632 03 iii 3 03/31/1885 die xxxi mensis iii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.175 {conversion of 1885-04-01} { clock format -2674466704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1885 12:34:56 die i mensis iv annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2409633 04 iv 4 04/01/1885 die i mensis iv annoque mdccclxxxv 85 lxxxv 1885} test clock-2.176 {conversion of 1885-04-30} { clock format -2671961104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1885 12:34:56 die xxx mensis iv annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2409662 04 iv 4 04/30/1885 die xxx mensis iv annoque mdccclxxxv 85 lxxxv 1885} test clock-2.177 {conversion of 1885-05-01} { clock format -2671874704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1885 12:34:56 die i mensis v annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2409663 05 v 5 05/01/1885 die i mensis v annoque mdccclxxxv 85 lxxxv 1885} test clock-2.178 {conversion of 1885-05-31} { clock format -2669282704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1885 12:34:56 die xxxi mensis v annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2409693 05 v 5 05/31/1885 die xxxi mensis v annoque mdccclxxxv 85 lxxxv 1885} test clock-2.179 {conversion of 1885-06-01} { clock format -2669196304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1885 12:34:56 die i mensis vi annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2409694 06 vi 6 06/01/1885 die i mensis vi annoque mdccclxxxv 85 lxxxv 1885} test clock-2.180 {conversion of 1885-06-30} { clock format -2666690704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1885 12:34:56 die xxx mensis vi annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2409723 06 vi 6 06/30/1885 die xxx mensis vi annoque mdccclxxxv 85 lxxxv 1885} test clock-2.181 {conversion of 1885-07-01} { clock format -2666604304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1885 12:34:56 die i mensis vii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2409724 07 vii 7 07/01/1885 die i mensis vii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.182 {conversion of 1885-07-31} { clock format -2664012304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1885 12:34:56 die xxxi mensis vii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2409754 07 vii 7 07/31/1885 die xxxi mensis vii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.183 {conversion of 1885-08-01} { clock format -2663925904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1885 12:34:56 die i mensis viii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2409755 08 viii 8 08/01/1885 die i mensis viii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.184 {conversion of 1885-08-31} { clock format -2661333904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1885 12:34:56 die xxxi mensis viii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2409785 08 viii 8 08/31/1885 die xxxi mensis viii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.185 {conversion of 1885-09-01} { clock format -2661247504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1885 12:34:56 die i mensis ix annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2409786 09 ix 9 09/01/1885 die i mensis ix annoque mdccclxxxv 85 lxxxv 1885} test clock-2.186 {conversion of 1885-09-30} { clock format -2658741904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1885 12:34:56 die xxx mensis ix annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2409815 09 ix 9 09/30/1885 die xxx mensis ix annoque mdccclxxxv 85 lxxxv 1885} test clock-2.187 {conversion of 1885-10-01} { clock format -2658655504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1885 12:34:56 die i mensis x annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2409816 10 x 10 10/01/1885 die i mensis x annoque mdccclxxxv 85 lxxxv 1885} test clock-2.188 {conversion of 1885-10-31} { clock format -2656063504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1885 12:34:56 die xxxi mensis x annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2409846 10 x 10 10/31/1885 die xxxi mensis x annoque mdccclxxxv 85 lxxxv 1885} test clock-2.189 {conversion of 1885-11-01} { clock format -2655977104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1885 12:34:56 die i mensis xi annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2409847 11 xi 11 11/01/1885 die i mensis xi annoque mdccclxxxv 85 lxxxv 1885} test clock-2.190 {conversion of 1885-11-30} { clock format -2653471504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1885 12:34:56 die xxx mensis xi annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2409876 11 xi 11 11/30/1885 die xxx mensis xi annoque mdccclxxxv 85 lxxxv 1885} test clock-2.191 {conversion of 1885-12-01} { clock format -2653385104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1885 12:34:56 die i mensis xii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2409877 12 xii 12 12/01/1885 die i mensis xii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.192 {conversion of 1885-12-31} { clock format -2650793104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1885 12:34:56 die xxxi mensis xii annoque mdccclxxxv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2409907 12 xii 12 12/31/1885 die xxxi mensis xii annoque mdccclxxxv 85 lxxxv 1885} test clock-2.193 {conversion of 1888-01-01} { clock format -2587634704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1888 12:34:56 die i mensis i annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2410638 01 i 1 01/01/1888 die i mensis i annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.194 {conversion of 1888-01-31} { clock format -2585042704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1888 12:34:56 die xxxi mensis i annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2410668 01 i 1 01/31/1888 die xxxi mensis i annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.195 {conversion of 1888-02-01} { clock format -2584956304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1888 12:34:56 die i mensis ii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2410669 02 ii 2 02/01/1888 die i mensis ii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.196 {conversion of 1888-02-29} { clock format -2582537104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1888 12:34:56 die xxix mensis ii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 29 xxix 29 xxix Feb 060 2410697 02 ii 2 02/29/1888 die xxix mensis ii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.197 {conversion of 1888-03-01} { clock format -2582450704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1888 12:34:56 die i mensis iii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 061 2410698 03 iii 3 03/01/1888 die i mensis iii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.198 {conversion of 1888-03-31} { clock format -2579858704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1888 12:34:56 die xxxi mensis iii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 091 2410728 03 iii 3 03/31/1888 die xxxi mensis iii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.199 {conversion of 1888-04-01} { clock format -2579772304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1888 12:34:56 die i mensis iv annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 092 2410729 04 iv 4 04/01/1888 die i mensis iv annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.200 {conversion of 1888-04-30} { clock format -2577266704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1888 12:34:56 die xxx mensis iv annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 121 2410758 04 iv 4 04/30/1888 die xxx mensis iv annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.201 {conversion of 1888-05-01} { clock format -2577180304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1888 12:34:56 die i mensis v annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 122 2410759 05 v 5 05/01/1888 die i mensis v annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.202 {conversion of 1888-05-31} { clock format -2574588304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1888 12:34:56 die xxxi mensis v annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 152 2410789 05 v 5 05/31/1888 die xxxi mensis v annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.203 {conversion of 1888-06-01} { clock format -2574501904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1888 12:34:56 die i mensis vi annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 153 2410790 06 vi 6 06/01/1888 die i mensis vi annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.204 {conversion of 1888-06-30} { clock format -2571996304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1888 12:34:56 die xxx mensis vi annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 182 2410819 06 vi 6 06/30/1888 die xxx mensis vi annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.205 {conversion of 1888-07-01} { clock format -2571909904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1888 12:34:56 die i mensis vii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 183 2410820 07 vii 7 07/01/1888 die i mensis vii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.206 {conversion of 1888-07-31} { clock format -2569317904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1888 12:34:56 die xxxi mensis vii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 213 2410850 07 vii 7 07/31/1888 die xxxi mensis vii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.207 {conversion of 1888-08-01} { clock format -2569231504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1888 12:34:56 die i mensis viii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 214 2410851 08 viii 8 08/01/1888 die i mensis viii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.208 {conversion of 1888-08-31} { clock format -2566639504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1888 12:34:56 die xxxi mensis viii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 244 2410881 08 viii 8 08/31/1888 die xxxi mensis viii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.209 {conversion of 1888-09-01} { clock format -2566553104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1888 12:34:56 die i mensis ix annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 245 2410882 09 ix 9 09/01/1888 die i mensis ix annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.210 {conversion of 1888-09-30} { clock format -2564047504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1888 12:34:56 die xxx mensis ix annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 274 2410911 09 ix 9 09/30/1888 die xxx mensis ix annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.211 {conversion of 1888-10-01} { clock format -2563961104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1888 12:34:56 die i mensis x annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 275 2410912 10 x 10 10/01/1888 die i mensis x annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.212 {conversion of 1888-10-31} { clock format -2561369104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1888 12:34:56 die xxxi mensis x annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 305 2410942 10 x 10 10/31/1888 die xxxi mensis x annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.213 {conversion of 1888-11-01} { clock format -2561282704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1888 12:34:56 die i mensis xi annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 306 2410943 11 xi 11 11/01/1888 die i mensis xi annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.214 {conversion of 1888-11-30} { clock format -2558777104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1888 12:34:56 die xxx mensis xi annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 335 2410972 11 xi 11 11/30/1888 die xxx mensis xi annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.215 {conversion of 1888-12-01} { clock format -2558690704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1888 12:34:56 die i mensis xii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 336 2410973 12 xii 12 12/01/1888 die i mensis xii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.216 {conversion of 1888-12-31} { clock format -2556098704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1888 12:34:56 die xxxi mensis xii annoque mdccclxxxviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 366 2411003 12 xii 12 12/31/1888 die xxxi mensis xii annoque mdccclxxxviii 88 lxxxviii 1888} test clock-2.217 {conversion of 1889-01-01} { clock format -2556012304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1889 12:34:56 die i mensis i annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2411004 01 i 1 01/01/1889 die i mensis i annoque mdccclxxxix 89 lxxxix 1889} test clock-2.218 {conversion of 1889-01-31} { clock format -2553420304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1889 12:34:56 die xxxi mensis i annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2411034 01 i 1 01/31/1889 die xxxi mensis i annoque mdccclxxxix 89 lxxxix 1889} test clock-2.219 {conversion of 1889-02-01} { clock format -2553333904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1889 12:34:56 die i mensis ii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2411035 02 ii 2 02/01/1889 die i mensis ii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.220 {conversion of 1889-02-28} { clock format -2551001104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1889 12:34:56 die xxviii mensis ii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2411062 02 ii 2 02/28/1889 die xxviii mensis ii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.221 {conversion of 1889-03-01} { clock format -2550914704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1889 12:34:56 die i mensis iii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2411063 03 iii 3 03/01/1889 die i mensis iii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.222 {conversion of 1889-03-31} { clock format -2548322704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1889 12:34:56 die xxxi mensis iii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2411093 03 iii 3 03/31/1889 die xxxi mensis iii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.223 {conversion of 1889-04-01} { clock format -2548236304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1889 12:34:56 die i mensis iv annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2411094 04 iv 4 04/01/1889 die i mensis iv annoque mdccclxxxix 89 lxxxix 1889} test clock-2.224 {conversion of 1889-04-30} { clock format -2545730704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1889 12:34:56 die xxx mensis iv annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2411123 04 iv 4 04/30/1889 die xxx mensis iv annoque mdccclxxxix 89 lxxxix 1889} test clock-2.225 {conversion of 1889-05-01} { clock format -2545644304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1889 12:34:56 die i mensis v annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2411124 05 v 5 05/01/1889 die i mensis v annoque mdccclxxxix 89 lxxxix 1889} test clock-2.226 {conversion of 1889-05-31} { clock format -2543052304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1889 12:34:56 die xxxi mensis v annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2411154 05 v 5 05/31/1889 die xxxi mensis v annoque mdccclxxxix 89 lxxxix 1889} test clock-2.227 {conversion of 1889-06-01} { clock format -2542965904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1889 12:34:56 die i mensis vi annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2411155 06 vi 6 06/01/1889 die i mensis vi annoque mdccclxxxix 89 lxxxix 1889} test clock-2.228 {conversion of 1889-06-30} { clock format -2540460304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1889 12:34:56 die xxx mensis vi annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2411184 06 vi 6 06/30/1889 die xxx mensis vi annoque mdccclxxxix 89 lxxxix 1889} test clock-2.229 {conversion of 1889-07-01} { clock format -2540373904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1889 12:34:56 die i mensis vii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2411185 07 vii 7 07/01/1889 die i mensis vii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.230 {conversion of 1889-07-31} { clock format -2537781904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1889 12:34:56 die xxxi mensis vii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2411215 07 vii 7 07/31/1889 die xxxi mensis vii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.231 {conversion of 1889-08-01} { clock format -2537695504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1889 12:34:56 die i mensis viii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2411216 08 viii 8 08/01/1889 die i mensis viii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.232 {conversion of 1889-08-31} { clock format -2535103504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1889 12:34:56 die xxxi mensis viii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2411246 08 viii 8 08/31/1889 die xxxi mensis viii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.233 {conversion of 1889-09-01} { clock format -2535017104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1889 12:34:56 die i mensis ix annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2411247 09 ix 9 09/01/1889 die i mensis ix annoque mdccclxxxix 89 lxxxix 1889} test clock-2.234 {conversion of 1889-09-30} { clock format -2532511504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1889 12:34:56 die xxx mensis ix annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2411276 09 ix 9 09/30/1889 die xxx mensis ix annoque mdccclxxxix 89 lxxxix 1889} test clock-2.235 {conversion of 1889-10-01} { clock format -2532425104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1889 12:34:56 die i mensis x annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2411277 10 x 10 10/01/1889 die i mensis x annoque mdccclxxxix 89 lxxxix 1889} test clock-2.236 {conversion of 1889-10-31} { clock format -2529833104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1889 12:34:56 die xxxi mensis x annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2411307 10 x 10 10/31/1889 die xxxi mensis x annoque mdccclxxxix 89 lxxxix 1889} test clock-2.237 {conversion of 1889-11-01} { clock format -2529746704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1889 12:34:56 die i mensis xi annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2411308 11 xi 11 11/01/1889 die i mensis xi annoque mdccclxxxix 89 lxxxix 1889} test clock-2.238 {conversion of 1889-11-30} { clock format -2527241104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1889 12:34:56 die xxx mensis xi annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2411337 11 xi 11 11/30/1889 die xxx mensis xi annoque mdccclxxxix 89 lxxxix 1889} test clock-2.239 {conversion of 1889-12-01} { clock format -2527154704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1889 12:34:56 die i mensis xii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2411338 12 xii 12 12/01/1889 die i mensis xii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.240 {conversion of 1889-12-31} { clock format -2524562704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1889 12:34:56 die xxxi mensis xii annoque mdccclxxxix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2411368 12 xii 12 12/31/1889 die xxxi mensis xii annoque mdccclxxxix 89 lxxxix 1889} test clock-2.241 {conversion of 1890-01-01} { clock format -2524476304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1890 12:34:56 die i mensis i annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2411369 01 i 1 01/01/1890 die i mensis i annoque mdcccxc 90 xc 1890} test clock-2.242 {conversion of 1890-01-31} { clock format -2521884304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1890 12:34:56 die xxxi mensis i annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2411399 01 i 1 01/31/1890 die xxxi mensis i annoque mdcccxc 90 xc 1890} test clock-2.243 {conversion of 1890-02-01} { clock format -2521797904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1890 12:34:56 die i mensis ii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2411400 02 ii 2 02/01/1890 die i mensis ii annoque mdcccxc 90 xc 1890} test clock-2.244 {conversion of 1890-02-28} { clock format -2519465104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1890 12:34:56 die xxviii mensis ii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2411427 02 ii 2 02/28/1890 die xxviii mensis ii annoque mdcccxc 90 xc 1890} test clock-2.245 {conversion of 1890-03-01} { clock format -2519378704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1890 12:34:56 die i mensis iii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2411428 03 iii 3 03/01/1890 die i mensis iii annoque mdcccxc 90 xc 1890} test clock-2.246 {conversion of 1890-03-31} { clock format -2516786704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1890 12:34:56 die xxxi mensis iii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2411458 03 iii 3 03/31/1890 die xxxi mensis iii annoque mdcccxc 90 xc 1890} test clock-2.247 {conversion of 1890-04-01} { clock format -2516700304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1890 12:34:56 die i mensis iv annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2411459 04 iv 4 04/01/1890 die i mensis iv annoque mdcccxc 90 xc 1890} test clock-2.248 {conversion of 1890-04-30} { clock format -2514194704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1890 12:34:56 die xxx mensis iv annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2411488 04 iv 4 04/30/1890 die xxx mensis iv annoque mdcccxc 90 xc 1890} test clock-2.249 {conversion of 1890-05-01} { clock format -2514108304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1890 12:34:56 die i mensis v annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2411489 05 v 5 05/01/1890 die i mensis v annoque mdcccxc 90 xc 1890} test clock-2.250 {conversion of 1890-05-31} { clock format -2511516304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1890 12:34:56 die xxxi mensis v annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2411519 05 v 5 05/31/1890 die xxxi mensis v annoque mdcccxc 90 xc 1890} test clock-2.251 {conversion of 1890-06-01} { clock format -2511429904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1890 12:34:56 die i mensis vi annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2411520 06 vi 6 06/01/1890 die i mensis vi annoque mdcccxc 90 xc 1890} test clock-2.252 {conversion of 1890-06-30} { clock format -2508924304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1890 12:34:56 die xxx mensis vi annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2411549 06 vi 6 06/30/1890 die xxx mensis vi annoque mdcccxc 90 xc 1890} test clock-2.253 {conversion of 1890-07-01} { clock format -2508837904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1890 12:34:56 die i mensis vii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2411550 07 vii 7 07/01/1890 die i mensis vii annoque mdcccxc 90 xc 1890} test clock-2.254 {conversion of 1890-07-31} { clock format -2506245904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1890 12:34:56 die xxxi mensis vii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2411580 07 vii 7 07/31/1890 die xxxi mensis vii annoque mdcccxc 90 xc 1890} test clock-2.255 {conversion of 1890-08-01} { clock format -2506159504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1890 12:34:56 die i mensis viii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2411581 08 viii 8 08/01/1890 die i mensis viii annoque mdcccxc 90 xc 1890} test clock-2.256 {conversion of 1890-08-31} { clock format -2503567504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1890 12:34:56 die xxxi mensis viii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2411611 08 viii 8 08/31/1890 die xxxi mensis viii annoque mdcccxc 90 xc 1890} test clock-2.257 {conversion of 1890-09-01} { clock format -2503481104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1890 12:34:56 die i mensis ix annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2411612 09 ix 9 09/01/1890 die i mensis ix annoque mdcccxc 90 xc 1890} test clock-2.258 {conversion of 1890-09-30} { clock format -2500975504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1890 12:34:56 die xxx mensis ix annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2411641 09 ix 9 09/30/1890 die xxx mensis ix annoque mdcccxc 90 xc 1890} test clock-2.259 {conversion of 1890-10-01} { clock format -2500889104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1890 12:34:56 die i mensis x annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2411642 10 x 10 10/01/1890 die i mensis x annoque mdcccxc 90 xc 1890} test clock-2.260 {conversion of 1890-10-31} { clock format -2498297104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1890 12:34:56 die xxxi mensis x annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2411672 10 x 10 10/31/1890 die xxxi mensis x annoque mdcccxc 90 xc 1890} test clock-2.261 {conversion of 1890-11-01} { clock format -2498210704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1890 12:34:56 die i mensis xi annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2411673 11 xi 11 11/01/1890 die i mensis xi annoque mdcccxc 90 xc 1890} test clock-2.262 {conversion of 1890-11-30} { clock format -2495705104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1890 12:34:56 die xxx mensis xi annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2411702 11 xi 11 11/30/1890 die xxx mensis xi annoque mdcccxc 90 xc 1890} test clock-2.263 {conversion of 1890-12-01} { clock format -2495618704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1890 12:34:56 die i mensis xii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2411703 12 xii 12 12/01/1890 die i mensis xii annoque mdcccxc 90 xc 1890} test clock-2.264 {conversion of 1890-12-31} { clock format -2493026704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1890 12:34:56 die xxxi mensis xii annoque mdcccxc xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2411733 12 xii 12 12/31/1890 die xxxi mensis xii annoque mdcccxc 90 xc 1890} test clock-2.265 {conversion of 1891-01-01} { clock format -2492940304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1891 12:34:56 die i mensis i annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2411734 01 i 1 01/01/1891 die i mensis i annoque mdcccxci 91 xci 1891} test clock-2.266 {conversion of 1891-01-31} { clock format -2490348304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1891 12:34:56 die xxxi mensis i annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2411764 01 i 1 01/31/1891 die xxxi mensis i annoque mdcccxci 91 xci 1891} test clock-2.267 {conversion of 1891-02-01} { clock format -2490261904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1891 12:34:56 die i mensis ii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2411765 02 ii 2 02/01/1891 die i mensis ii annoque mdcccxci 91 xci 1891} test clock-2.268 {conversion of 1891-02-28} { clock format -2487929104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1891 12:34:56 die xxviii mensis ii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2411792 02 ii 2 02/28/1891 die xxviii mensis ii annoque mdcccxci 91 xci 1891} test clock-2.269 {conversion of 1891-03-01} { clock format -2487842704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1891 12:34:56 die i mensis iii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2411793 03 iii 3 03/01/1891 die i mensis iii annoque mdcccxci 91 xci 1891} test clock-2.270 {conversion of 1891-03-31} { clock format -2485250704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1891 12:34:56 die xxxi mensis iii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2411823 03 iii 3 03/31/1891 die xxxi mensis iii annoque mdcccxci 91 xci 1891} test clock-2.271 {conversion of 1891-04-01} { clock format -2485164304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1891 12:34:56 die i mensis iv annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2411824 04 iv 4 04/01/1891 die i mensis iv annoque mdcccxci 91 xci 1891} test clock-2.272 {conversion of 1891-04-30} { clock format -2482658704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1891 12:34:56 die xxx mensis iv annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2411853 04 iv 4 04/30/1891 die xxx mensis iv annoque mdcccxci 91 xci 1891} test clock-2.273 {conversion of 1891-05-01} { clock format -2482572304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1891 12:34:56 die i mensis v annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2411854 05 v 5 05/01/1891 die i mensis v annoque mdcccxci 91 xci 1891} test clock-2.274 {conversion of 1891-05-31} { clock format -2479980304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1891 12:34:56 die xxxi mensis v annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2411884 05 v 5 05/31/1891 die xxxi mensis v annoque mdcccxci 91 xci 1891} test clock-2.275 {conversion of 1891-06-01} { clock format -2479893904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1891 12:34:56 die i mensis vi annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2411885 06 vi 6 06/01/1891 die i mensis vi annoque mdcccxci 91 xci 1891} test clock-2.276 {conversion of 1891-06-30} { clock format -2477388304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1891 12:34:56 die xxx mensis vi annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2411914 06 vi 6 06/30/1891 die xxx mensis vi annoque mdcccxci 91 xci 1891} test clock-2.277 {conversion of 1891-07-01} { clock format -2477301904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1891 12:34:56 die i mensis vii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2411915 07 vii 7 07/01/1891 die i mensis vii annoque mdcccxci 91 xci 1891} test clock-2.278 {conversion of 1891-07-31} { clock format -2474709904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1891 12:34:56 die xxxi mensis vii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2411945 07 vii 7 07/31/1891 die xxxi mensis vii annoque mdcccxci 91 xci 1891} test clock-2.279 {conversion of 1891-08-01} { clock format -2474623504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1891 12:34:56 die i mensis viii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2411946 08 viii 8 08/01/1891 die i mensis viii annoque mdcccxci 91 xci 1891} test clock-2.280 {conversion of 1891-08-31} { clock format -2472031504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1891 12:34:56 die xxxi mensis viii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2411976 08 viii 8 08/31/1891 die xxxi mensis viii annoque mdcccxci 91 xci 1891} test clock-2.281 {conversion of 1891-09-01} { clock format -2471945104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1891 12:34:56 die i mensis ix annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2411977 09 ix 9 09/01/1891 die i mensis ix annoque mdcccxci 91 xci 1891} test clock-2.282 {conversion of 1891-09-30} { clock format -2469439504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1891 12:34:56 die xxx mensis ix annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2412006 09 ix 9 09/30/1891 die xxx mensis ix annoque mdcccxci 91 xci 1891} test clock-2.283 {conversion of 1891-10-01} { clock format -2469353104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1891 12:34:56 die i mensis x annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2412007 10 x 10 10/01/1891 die i mensis x annoque mdcccxci 91 xci 1891} test clock-2.284 {conversion of 1891-10-31} { clock format -2466761104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1891 12:34:56 die xxxi mensis x annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2412037 10 x 10 10/31/1891 die xxxi mensis x annoque mdcccxci 91 xci 1891} test clock-2.285 {conversion of 1891-11-01} { clock format -2466674704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1891 12:34:56 die i mensis xi annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2412038 11 xi 11 11/01/1891 die i mensis xi annoque mdcccxci 91 xci 1891} test clock-2.286 {conversion of 1891-11-30} { clock format -2464169104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1891 12:34:56 die xxx mensis xi annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2412067 11 xi 11 11/30/1891 die xxx mensis xi annoque mdcccxci 91 xci 1891} test clock-2.287 {conversion of 1891-12-01} { clock format -2464082704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1891 12:34:56 die i mensis xii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2412068 12 xii 12 12/01/1891 die i mensis xii annoque mdcccxci 91 xci 1891} test clock-2.288 {conversion of 1891-12-31} { clock format -2461490704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1891 12:34:56 die xxxi mensis xii annoque mdcccxci xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2412098 12 xii 12 12/31/1891 die xxxi mensis xii annoque mdcccxci 91 xci 1891} test clock-2.289 {conversion of 1892-01-01} { clock format -2461404304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1892 12:34:56 die i mensis i annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2412099 01 i 1 01/01/1892 die i mensis i annoque mdcccxcii 92 xcii 1892} test clock-2.290 {conversion of 1892-01-31} { clock format -2458812304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1892 12:34:56 die xxxi mensis i annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2412129 01 i 1 01/31/1892 die xxxi mensis i annoque mdcccxcii 92 xcii 1892} test clock-2.291 {conversion of 1892-02-01} { clock format -2458725904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1892 12:34:56 die i mensis ii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2412130 02 ii 2 02/01/1892 die i mensis ii annoque mdcccxcii 92 xcii 1892} test clock-2.292 {conversion of 1892-02-29} { clock format -2456306704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1892 12:34:56 die xxix mensis ii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 29 xxix 29 xxix Feb 060 2412158 02 ii 2 02/29/1892 die xxix mensis ii annoque mdcccxcii 92 xcii 1892} test clock-2.293 {conversion of 1892-03-01} { clock format -2456220304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1892 12:34:56 die i mensis iii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 061 2412159 03 iii 3 03/01/1892 die i mensis iii annoque mdcccxcii 92 xcii 1892} test clock-2.294 {conversion of 1892-03-31} { clock format -2453628304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1892 12:34:56 die xxxi mensis iii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 091 2412189 03 iii 3 03/31/1892 die xxxi mensis iii annoque mdcccxcii 92 xcii 1892} test clock-2.295 {conversion of 1892-04-01} { clock format -2453541904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1892 12:34:56 die i mensis iv annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 092 2412190 04 iv 4 04/01/1892 die i mensis iv annoque mdcccxcii 92 xcii 1892} test clock-2.296 {conversion of 1892-04-30} { clock format -2451036304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1892 12:34:56 die xxx mensis iv annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 121 2412219 04 iv 4 04/30/1892 die xxx mensis iv annoque mdcccxcii 92 xcii 1892} test clock-2.297 {conversion of 1892-05-01} { clock format -2450949904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1892 12:34:56 die i mensis v annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 122 2412220 05 v 5 05/01/1892 die i mensis v annoque mdcccxcii 92 xcii 1892} test clock-2.298 {conversion of 1892-05-31} { clock format -2448357904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1892 12:34:56 die xxxi mensis v annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 152 2412250 05 v 5 05/31/1892 die xxxi mensis v annoque mdcccxcii 92 xcii 1892} test clock-2.299 {conversion of 1892-06-01} { clock format -2448271504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1892 12:34:56 die i mensis vi annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 153 2412251 06 vi 6 06/01/1892 die i mensis vi annoque mdcccxcii 92 xcii 1892} test clock-2.300 {conversion of 1892-06-30} { clock format -2445765904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1892 12:34:56 die xxx mensis vi annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 182 2412280 06 vi 6 06/30/1892 die xxx mensis vi annoque mdcccxcii 92 xcii 1892} test clock-2.301 {conversion of 1892-07-01} { clock format -2445679504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1892 12:34:56 die i mensis vii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 183 2412281 07 vii 7 07/01/1892 die i mensis vii annoque mdcccxcii 92 xcii 1892} test clock-2.302 {conversion of 1892-07-31} { clock format -2443087504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1892 12:34:56 die xxxi mensis vii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 213 2412311 07 vii 7 07/31/1892 die xxxi mensis vii annoque mdcccxcii 92 xcii 1892} test clock-2.303 {conversion of 1892-08-01} { clock format -2443001104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1892 12:34:56 die i mensis viii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 214 2412312 08 viii 8 08/01/1892 die i mensis viii annoque mdcccxcii 92 xcii 1892} test clock-2.304 {conversion of 1892-08-31} { clock format -2440409104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1892 12:34:56 die xxxi mensis viii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 244 2412342 08 viii 8 08/31/1892 die xxxi mensis viii annoque mdcccxcii 92 xcii 1892} test clock-2.305 {conversion of 1892-09-01} { clock format -2440322704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1892 12:34:56 die i mensis ix annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 245 2412343 09 ix 9 09/01/1892 die i mensis ix annoque mdcccxcii 92 xcii 1892} test clock-2.306 {conversion of 1892-09-30} { clock format -2437817104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1892 12:34:56 die xxx mensis ix annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 274 2412372 09 ix 9 09/30/1892 die xxx mensis ix annoque mdcccxcii 92 xcii 1892} test clock-2.307 {conversion of 1892-10-01} { clock format -2437730704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1892 12:34:56 die i mensis x annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 275 2412373 10 x 10 10/01/1892 die i mensis x annoque mdcccxcii 92 xcii 1892} test clock-2.308 {conversion of 1892-10-31} { clock format -2435138704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1892 12:34:56 die xxxi mensis x annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 305 2412403 10 x 10 10/31/1892 die xxxi mensis x annoque mdcccxcii 92 xcii 1892} test clock-2.309 {conversion of 1892-11-01} { clock format -2435052304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1892 12:34:56 die i mensis xi annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 306 2412404 11 xi 11 11/01/1892 die i mensis xi annoque mdcccxcii 92 xcii 1892} test clock-2.310 {conversion of 1892-11-30} { clock format -2432546704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1892 12:34:56 die xxx mensis xi annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 335 2412433 11 xi 11 11/30/1892 die xxx mensis xi annoque mdcccxcii 92 xcii 1892} test clock-2.311 {conversion of 1892-12-01} { clock format -2432460304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1892 12:34:56 die i mensis xii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 336 2412434 12 xii 12 12/01/1892 die i mensis xii annoque mdcccxcii 92 xcii 1892} test clock-2.312 {conversion of 1892-12-31} { clock format -2429868304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1892 12:34:56 die xxxi mensis xii annoque mdcccxcii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 366 2412464 12 xii 12 12/31/1892 die xxxi mensis xii annoque mdcccxcii 92 xcii 1892} test clock-2.313 {conversion of 1893-01-01} { clock format -2429781904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1893 12:34:56 die i mensis i annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2412465 01 i 1 01/01/1893 die i mensis i annoque mdcccxciii 93 xciii 1893} test clock-2.314 {conversion of 1893-01-31} { clock format -2427189904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1893 12:34:56 die xxxi mensis i annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2412495 01 i 1 01/31/1893 die xxxi mensis i annoque mdcccxciii 93 xciii 1893} test clock-2.315 {conversion of 1893-02-01} { clock format -2427103504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1893 12:34:56 die i mensis ii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2412496 02 ii 2 02/01/1893 die i mensis ii annoque mdcccxciii 93 xciii 1893} test clock-2.316 {conversion of 1893-02-28} { clock format -2424770704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1893 12:34:56 die xxviii mensis ii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2412523 02 ii 2 02/28/1893 die xxviii mensis ii annoque mdcccxciii 93 xciii 1893} test clock-2.317 {conversion of 1893-03-01} { clock format -2424684304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1893 12:34:56 die i mensis iii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2412524 03 iii 3 03/01/1893 die i mensis iii annoque mdcccxciii 93 xciii 1893} test clock-2.318 {conversion of 1893-03-31} { clock format -2422092304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1893 12:34:56 die xxxi mensis iii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2412554 03 iii 3 03/31/1893 die xxxi mensis iii annoque mdcccxciii 93 xciii 1893} test clock-2.319 {conversion of 1893-04-01} { clock format -2422005904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1893 12:34:56 die i mensis iv annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2412555 04 iv 4 04/01/1893 die i mensis iv annoque mdcccxciii 93 xciii 1893} test clock-2.320 {conversion of 1893-04-30} { clock format -2419500304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1893 12:34:56 die xxx mensis iv annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2412584 04 iv 4 04/30/1893 die xxx mensis iv annoque mdcccxciii 93 xciii 1893} test clock-2.321 {conversion of 1893-05-01} { clock format -2419413904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1893 12:34:56 die i mensis v annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2412585 05 v 5 05/01/1893 die i mensis v annoque mdcccxciii 93 xciii 1893} test clock-2.322 {conversion of 1893-05-31} { clock format -2416821904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1893 12:34:56 die xxxi mensis v annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2412615 05 v 5 05/31/1893 die xxxi mensis v annoque mdcccxciii 93 xciii 1893} test clock-2.323 {conversion of 1893-06-01} { clock format -2416735504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1893 12:34:56 die i mensis vi annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2412616 06 vi 6 06/01/1893 die i mensis vi annoque mdcccxciii 93 xciii 1893} test clock-2.324 {conversion of 1893-06-30} { clock format -2414229904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1893 12:34:56 die xxx mensis vi annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2412645 06 vi 6 06/30/1893 die xxx mensis vi annoque mdcccxciii 93 xciii 1893} test clock-2.325 {conversion of 1893-07-01} { clock format -2414143504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1893 12:34:56 die i mensis vii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2412646 07 vii 7 07/01/1893 die i mensis vii annoque mdcccxciii 93 xciii 1893} test clock-2.326 {conversion of 1893-07-31} { clock format -2411551504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1893 12:34:56 die xxxi mensis vii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2412676 07 vii 7 07/31/1893 die xxxi mensis vii annoque mdcccxciii 93 xciii 1893} test clock-2.327 {conversion of 1893-08-01} { clock format -2411465104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1893 12:34:56 die i mensis viii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2412677 08 viii 8 08/01/1893 die i mensis viii annoque mdcccxciii 93 xciii 1893} test clock-2.328 {conversion of 1893-08-31} { clock format -2408873104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1893 12:34:56 die xxxi mensis viii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2412707 08 viii 8 08/31/1893 die xxxi mensis viii annoque mdcccxciii 93 xciii 1893} test clock-2.329 {conversion of 1893-09-01} { clock format -2408786704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1893 12:34:56 die i mensis ix annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2412708 09 ix 9 09/01/1893 die i mensis ix annoque mdcccxciii 93 xciii 1893} test clock-2.330 {conversion of 1893-09-30} { clock format -2406281104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1893 12:34:56 die xxx mensis ix annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2412737 09 ix 9 09/30/1893 die xxx mensis ix annoque mdcccxciii 93 xciii 1893} test clock-2.331 {conversion of 1893-10-01} { clock format -2406194704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1893 12:34:56 die i mensis x annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2412738 10 x 10 10/01/1893 die i mensis x annoque mdcccxciii 93 xciii 1893} test clock-2.332 {conversion of 1893-10-31} { clock format -2403602704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1893 12:34:56 die xxxi mensis x annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2412768 10 x 10 10/31/1893 die xxxi mensis x annoque mdcccxciii 93 xciii 1893} test clock-2.333 {conversion of 1893-11-01} { clock format -2403516304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1893 12:34:56 die i mensis xi annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2412769 11 xi 11 11/01/1893 die i mensis xi annoque mdcccxciii 93 xciii 1893} test clock-2.334 {conversion of 1893-11-30} { clock format -2401010704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1893 12:34:56 die xxx mensis xi annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2412798 11 xi 11 11/30/1893 die xxx mensis xi annoque mdcccxciii 93 xciii 1893} test clock-2.335 {conversion of 1893-12-01} { clock format -2400924304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1893 12:34:56 die i mensis xii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2412799 12 xii 12 12/01/1893 die i mensis xii annoque mdcccxciii 93 xciii 1893} test clock-2.336 {conversion of 1893-12-31} { clock format -2398332304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1893 12:34:56 die xxxi mensis xii annoque mdcccxciii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2412829 12 xii 12 12/31/1893 die xxxi mensis xii annoque mdcccxciii 93 xciii 1893} test clock-2.337 {conversion of 1894-01-01} { clock format -2398245904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1894 12:34:56 die i mensis i annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2412830 01 i 1 01/01/1894 die i mensis i annoque mdcccxciv 94 xciv 1894} test clock-2.338 {conversion of 1894-01-31} { clock format -2395653904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1894 12:34:56 die xxxi mensis i annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2412860 01 i 1 01/31/1894 die xxxi mensis i annoque mdcccxciv 94 xciv 1894} test clock-2.339 {conversion of 1894-02-01} { clock format -2395567504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1894 12:34:56 die i mensis ii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2412861 02 ii 2 02/01/1894 die i mensis ii annoque mdcccxciv 94 xciv 1894} test clock-2.340 {conversion of 1894-02-28} { clock format -2393234704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1894 12:34:56 die xxviii mensis ii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2412888 02 ii 2 02/28/1894 die xxviii mensis ii annoque mdcccxciv 94 xciv 1894} test clock-2.341 {conversion of 1894-03-01} { clock format -2393148304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1894 12:34:56 die i mensis iii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2412889 03 iii 3 03/01/1894 die i mensis iii annoque mdcccxciv 94 xciv 1894} test clock-2.342 {conversion of 1894-03-31} { clock format -2390556304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1894 12:34:56 die xxxi mensis iii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2412919 03 iii 3 03/31/1894 die xxxi mensis iii annoque mdcccxciv 94 xciv 1894} test clock-2.343 {conversion of 1894-04-01} { clock format -2390469904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1894 12:34:56 die i mensis iv annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2412920 04 iv 4 04/01/1894 die i mensis iv annoque mdcccxciv 94 xciv 1894} test clock-2.344 {conversion of 1894-04-30} { clock format -2387964304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1894 12:34:56 die xxx mensis iv annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2412949 04 iv 4 04/30/1894 die xxx mensis iv annoque mdcccxciv 94 xciv 1894} test clock-2.345 {conversion of 1894-05-01} { clock format -2387877904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1894 12:34:56 die i mensis v annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2412950 05 v 5 05/01/1894 die i mensis v annoque mdcccxciv 94 xciv 1894} test clock-2.346 {conversion of 1894-05-31} { clock format -2385285904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1894 12:34:56 die xxxi mensis v annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2412980 05 v 5 05/31/1894 die xxxi mensis v annoque mdcccxciv 94 xciv 1894} test clock-2.347 {conversion of 1894-06-01} { clock format -2385199504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1894 12:34:56 die i mensis vi annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2412981 06 vi 6 06/01/1894 die i mensis vi annoque mdcccxciv 94 xciv 1894} test clock-2.348 {conversion of 1894-06-30} { clock format -2382693904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1894 12:34:56 die xxx mensis vi annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2413010 06 vi 6 06/30/1894 die xxx mensis vi annoque mdcccxciv 94 xciv 1894} test clock-2.349 {conversion of 1894-07-01} { clock format -2382607504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1894 12:34:56 die i mensis vii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2413011 07 vii 7 07/01/1894 die i mensis vii annoque mdcccxciv 94 xciv 1894} test clock-2.350 {conversion of 1894-07-31} { clock format -2380015504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1894 12:34:56 die xxxi mensis vii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2413041 07 vii 7 07/31/1894 die xxxi mensis vii annoque mdcccxciv 94 xciv 1894} test clock-2.351 {conversion of 1894-08-01} { clock format -2379929104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1894 12:34:56 die i mensis viii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2413042 08 viii 8 08/01/1894 die i mensis viii annoque mdcccxciv 94 xciv 1894} test clock-2.352 {conversion of 1894-08-31} { clock format -2377337104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1894 12:34:56 die xxxi mensis viii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2413072 08 viii 8 08/31/1894 die xxxi mensis viii annoque mdcccxciv 94 xciv 1894} test clock-2.353 {conversion of 1894-09-01} { clock format -2377250704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1894 12:34:56 die i mensis ix annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2413073 09 ix 9 09/01/1894 die i mensis ix annoque mdcccxciv 94 xciv 1894} test clock-2.354 {conversion of 1894-09-30} { clock format -2374745104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1894 12:34:56 die xxx mensis ix annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2413102 09 ix 9 09/30/1894 die xxx mensis ix annoque mdcccxciv 94 xciv 1894} test clock-2.355 {conversion of 1894-10-01} { clock format -2374658704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1894 12:34:56 die i mensis x annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2413103 10 x 10 10/01/1894 die i mensis x annoque mdcccxciv 94 xciv 1894} test clock-2.356 {conversion of 1894-10-31} { clock format -2372066704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1894 12:34:56 die xxxi mensis x annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2413133 10 x 10 10/31/1894 die xxxi mensis x annoque mdcccxciv 94 xciv 1894} test clock-2.357 {conversion of 1894-11-01} { clock format -2371980304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1894 12:34:56 die i mensis xi annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2413134 11 xi 11 11/01/1894 die i mensis xi annoque mdcccxciv 94 xciv 1894} test clock-2.358 {conversion of 1894-11-30} { clock format -2369474704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1894 12:34:56 die xxx mensis xi annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2413163 11 xi 11 11/30/1894 die xxx mensis xi annoque mdcccxciv 94 xciv 1894} test clock-2.359 {conversion of 1894-12-01} { clock format -2369388304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1894 12:34:56 die i mensis xii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2413164 12 xii 12 12/01/1894 die i mensis xii annoque mdcccxciv 94 xciv 1894} test clock-2.360 {conversion of 1894-12-31} { clock format -2366796304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1894 12:34:56 die xxxi mensis xii annoque mdcccxciv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2413194 12 xii 12 12/31/1894 die xxxi mensis xii annoque mdcccxciv 94 xciv 1894} test clock-2.361 {conversion of 1895-01-01} { clock format -2366709904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1895 12:34:56 die i mensis i annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2413195 01 i 1 01/01/1895 die i mensis i annoque mdcccxcv 95 xcv 1895} test clock-2.362 {conversion of 1895-01-31} { clock format -2364117904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1895 12:34:56 die xxxi mensis i annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2413225 01 i 1 01/31/1895 die xxxi mensis i annoque mdcccxcv 95 xcv 1895} test clock-2.363 {conversion of 1895-02-01} { clock format -2364031504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1895 12:34:56 die i mensis ii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2413226 02 ii 2 02/01/1895 die i mensis ii annoque mdcccxcv 95 xcv 1895} test clock-2.364 {conversion of 1895-02-28} { clock format -2361698704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1895 12:34:56 die xxviii mensis ii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2413253 02 ii 2 02/28/1895 die xxviii mensis ii annoque mdcccxcv 95 xcv 1895} test clock-2.365 {conversion of 1895-03-01} { clock format -2361612304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1895 12:34:56 die i mensis iii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2413254 03 iii 3 03/01/1895 die i mensis iii annoque mdcccxcv 95 xcv 1895} test clock-2.366 {conversion of 1895-03-31} { clock format -2359020304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1895 12:34:56 die xxxi mensis iii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2413284 03 iii 3 03/31/1895 die xxxi mensis iii annoque mdcccxcv 95 xcv 1895} test clock-2.367 {conversion of 1895-04-01} { clock format -2358933904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1895 12:34:56 die i mensis iv annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2413285 04 iv 4 04/01/1895 die i mensis iv annoque mdcccxcv 95 xcv 1895} test clock-2.368 {conversion of 1895-04-30} { clock format -2356428304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1895 12:34:56 die xxx mensis iv annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2413314 04 iv 4 04/30/1895 die xxx mensis iv annoque mdcccxcv 95 xcv 1895} test clock-2.369 {conversion of 1895-05-01} { clock format -2356341904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1895 12:34:56 die i mensis v annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2413315 05 v 5 05/01/1895 die i mensis v annoque mdcccxcv 95 xcv 1895} test clock-2.370 {conversion of 1895-05-31} { clock format -2353749904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1895 12:34:56 die xxxi mensis v annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2413345 05 v 5 05/31/1895 die xxxi mensis v annoque mdcccxcv 95 xcv 1895} test clock-2.371 {conversion of 1895-06-01} { clock format -2353663504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1895 12:34:56 die i mensis vi annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2413346 06 vi 6 06/01/1895 die i mensis vi annoque mdcccxcv 95 xcv 1895} test clock-2.372 {conversion of 1895-06-30} { clock format -2351157904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1895 12:34:56 die xxx mensis vi annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2413375 06 vi 6 06/30/1895 die xxx mensis vi annoque mdcccxcv 95 xcv 1895} test clock-2.373 {conversion of 1895-07-01} { clock format -2351071504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1895 12:34:56 die i mensis vii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2413376 07 vii 7 07/01/1895 die i mensis vii annoque mdcccxcv 95 xcv 1895} test clock-2.374 {conversion of 1895-07-31} { clock format -2348479504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1895 12:34:56 die xxxi mensis vii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2413406 07 vii 7 07/31/1895 die xxxi mensis vii annoque mdcccxcv 95 xcv 1895} test clock-2.375 {conversion of 1895-08-01} { clock format -2348393104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1895 12:34:56 die i mensis viii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2413407 08 viii 8 08/01/1895 die i mensis viii annoque mdcccxcv 95 xcv 1895} test clock-2.376 {conversion of 1895-08-31} { clock format -2345801104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1895 12:34:56 die xxxi mensis viii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2413437 08 viii 8 08/31/1895 die xxxi mensis viii annoque mdcccxcv 95 xcv 1895} test clock-2.377 {conversion of 1895-09-01} { clock format -2345714704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1895 12:34:56 die i mensis ix annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2413438 09 ix 9 09/01/1895 die i mensis ix annoque mdcccxcv 95 xcv 1895} test clock-2.378 {conversion of 1895-09-30} { clock format -2343209104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1895 12:34:56 die xxx mensis ix annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2413467 09 ix 9 09/30/1895 die xxx mensis ix annoque mdcccxcv 95 xcv 1895} test clock-2.379 {conversion of 1895-10-01} { clock format -2343122704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1895 12:34:56 die i mensis x annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2413468 10 x 10 10/01/1895 die i mensis x annoque mdcccxcv 95 xcv 1895} test clock-2.380 {conversion of 1895-10-31} { clock format -2340530704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1895 12:34:56 die xxxi mensis x annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2413498 10 x 10 10/31/1895 die xxxi mensis x annoque mdcccxcv 95 xcv 1895} test clock-2.381 {conversion of 1895-11-01} { clock format -2340444304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1895 12:34:56 die i mensis xi annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2413499 11 xi 11 11/01/1895 die i mensis xi annoque mdcccxcv 95 xcv 1895} test clock-2.382 {conversion of 1895-11-30} { clock format -2337938704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1895 12:34:56 die xxx mensis xi annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2413528 11 xi 11 11/30/1895 die xxx mensis xi annoque mdcccxcv 95 xcv 1895} test clock-2.383 {conversion of 1895-12-01} { clock format -2337852304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1895 12:34:56 die i mensis xii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2413529 12 xii 12 12/01/1895 die i mensis xii annoque mdcccxcv 95 xcv 1895} test clock-2.384 {conversion of 1895-12-31} { clock format -2335260304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1895 12:34:56 die xxxi mensis xii annoque mdcccxcv xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2413559 12 xii 12 12/31/1895 die xxxi mensis xii annoque mdcccxcv 95 xcv 1895} test clock-2.385 {conversion of 1896-01-01} { clock format -2335173904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1896 12:34:56 die i mensis i annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2413560 01 i 1 01/01/1896 die i mensis i annoque mdcccxcvi 96 xcvi 1896} test clock-2.386 {conversion of 1896-01-31} { clock format -2332581904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1896 12:34:56 die xxxi mensis i annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2413590 01 i 1 01/31/1896 die xxxi mensis i annoque mdcccxcvi 96 xcvi 1896} test clock-2.387 {conversion of 1896-02-01} { clock format -2332495504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1896 12:34:56 die i mensis ii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2413591 02 ii 2 02/01/1896 die i mensis ii annoque mdcccxcvi 96 xcvi 1896} test clock-2.388 {conversion of 1896-02-29} { clock format -2330076304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1896 12:34:56 die xxix mensis ii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 29 xxix 29 xxix Feb 060 2413619 02 ii 2 02/29/1896 die xxix mensis ii annoque mdcccxcvi 96 xcvi 1896} test clock-2.389 {conversion of 1896-03-01} { clock format -2329989904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1896 12:34:56 die i mensis iii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 061 2413620 03 iii 3 03/01/1896 die i mensis iii annoque mdcccxcvi 96 xcvi 1896} test clock-2.390 {conversion of 1896-03-31} { clock format -2327397904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1896 12:34:56 die xxxi mensis iii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 091 2413650 03 iii 3 03/31/1896 die xxxi mensis iii annoque mdcccxcvi 96 xcvi 1896} test clock-2.391 {conversion of 1896-04-01} { clock format -2327311504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1896 12:34:56 die i mensis iv annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 092 2413651 04 iv 4 04/01/1896 die i mensis iv annoque mdcccxcvi 96 xcvi 1896} test clock-2.392 {conversion of 1896-04-30} { clock format -2324805904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1896 12:34:56 die xxx mensis iv annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 121 2413680 04 iv 4 04/30/1896 die xxx mensis iv annoque mdcccxcvi 96 xcvi 1896} test clock-2.393 {conversion of 1896-05-01} { clock format -2324719504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1896 12:34:56 die i mensis v annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 122 2413681 05 v 5 05/01/1896 die i mensis v annoque mdcccxcvi 96 xcvi 1896} test clock-2.394 {conversion of 1896-05-31} { clock format -2322127504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1896 12:34:56 die xxxi mensis v annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 152 2413711 05 v 5 05/31/1896 die xxxi mensis v annoque mdcccxcvi 96 xcvi 1896} test clock-2.395 {conversion of 1896-06-01} { clock format -2322041104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1896 12:34:56 die i mensis vi annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 153 2413712 06 vi 6 06/01/1896 die i mensis vi annoque mdcccxcvi 96 xcvi 1896} test clock-2.396 {conversion of 1896-06-30} { clock format -2319535504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1896 12:34:56 die xxx mensis vi annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 182 2413741 06 vi 6 06/30/1896 die xxx mensis vi annoque mdcccxcvi 96 xcvi 1896} test clock-2.397 {conversion of 1896-07-01} { clock format -2319449104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1896 12:34:56 die i mensis vii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 183 2413742 07 vii 7 07/01/1896 die i mensis vii annoque mdcccxcvi 96 xcvi 1896} test clock-2.398 {conversion of 1896-07-31} { clock format -2316857104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1896 12:34:56 die xxxi mensis vii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 213 2413772 07 vii 7 07/31/1896 die xxxi mensis vii annoque mdcccxcvi 96 xcvi 1896} test clock-2.399 {conversion of 1896-08-01} { clock format -2316770704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1896 12:34:56 die i mensis viii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 214 2413773 08 viii 8 08/01/1896 die i mensis viii annoque mdcccxcvi 96 xcvi 1896} test clock-2.400 {conversion of 1896-08-31} { clock format -2314178704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1896 12:34:56 die xxxi mensis viii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 244 2413803 08 viii 8 08/31/1896 die xxxi mensis viii annoque mdcccxcvi 96 xcvi 1896} test clock-2.401 {conversion of 1896-09-01} { clock format -2314092304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1896 12:34:56 die i mensis ix annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 245 2413804 09 ix 9 09/01/1896 die i mensis ix annoque mdcccxcvi 96 xcvi 1896} test clock-2.402 {conversion of 1896-09-30} { clock format -2311586704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1896 12:34:56 die xxx mensis ix annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 274 2413833 09 ix 9 09/30/1896 die xxx mensis ix annoque mdcccxcvi 96 xcvi 1896} test clock-2.403 {conversion of 1896-10-01} { clock format -2311500304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1896 12:34:56 die i mensis x annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 275 2413834 10 x 10 10/01/1896 die i mensis x annoque mdcccxcvi 96 xcvi 1896} test clock-2.404 {conversion of 1896-10-31} { clock format -2308908304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1896 12:34:56 die xxxi mensis x annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 305 2413864 10 x 10 10/31/1896 die xxxi mensis x annoque mdcccxcvi 96 xcvi 1896} test clock-2.405 {conversion of 1896-11-01} { clock format -2308821904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1896 12:34:56 die i mensis xi annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 306 2413865 11 xi 11 11/01/1896 die i mensis xi annoque mdcccxcvi 96 xcvi 1896} test clock-2.406 {conversion of 1896-11-30} { clock format -2306316304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1896 12:34:56 die xxx mensis xi annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 335 2413894 11 xi 11 11/30/1896 die xxx mensis xi annoque mdcccxcvi 96 xcvi 1896} test clock-2.407 {conversion of 1896-12-01} { clock format -2306229904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1896 12:34:56 die i mensis xii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 336 2413895 12 xii 12 12/01/1896 die i mensis xii annoque mdcccxcvi 96 xcvi 1896} test clock-2.408 {conversion of 1896-12-31} { clock format -2303637904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1896 12:34:56 die xxxi mensis xii annoque mdcccxcvi xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 366 2413925 12 xii 12 12/31/1896 die xxxi mensis xii annoque mdcccxcvi 96 xcvi 1896} test clock-2.409 {conversion of 1897-01-01} { clock format -2303551504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1897 12:34:56 die i mensis i annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2413926 01 i 1 01/01/1897 die i mensis i annoque mdcccxcvii 97 xcvii 1897} test clock-2.410 {conversion of 1897-01-31} { clock format -2300959504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1897 12:34:56 die xxxi mensis i annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2413956 01 i 1 01/31/1897 die xxxi mensis i annoque mdcccxcvii 97 xcvii 1897} test clock-2.411 {conversion of 1897-02-01} { clock format -2300873104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1897 12:34:56 die i mensis ii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2413957 02 ii 2 02/01/1897 die i mensis ii annoque mdcccxcvii 97 xcvii 1897} test clock-2.412 {conversion of 1897-02-28} { clock format -2298540304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1897 12:34:56 die xxviii mensis ii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2413984 02 ii 2 02/28/1897 die xxviii mensis ii annoque mdcccxcvii 97 xcvii 1897} test clock-2.413 {conversion of 1897-03-01} { clock format -2298453904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1897 12:34:56 die i mensis iii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2413985 03 iii 3 03/01/1897 die i mensis iii annoque mdcccxcvii 97 xcvii 1897} test clock-2.414 {conversion of 1897-03-31} { clock format -2295861904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1897 12:34:56 die xxxi mensis iii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2414015 03 iii 3 03/31/1897 die xxxi mensis iii annoque mdcccxcvii 97 xcvii 1897} test clock-2.415 {conversion of 1897-04-01} { clock format -2295775504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1897 12:34:56 die i mensis iv annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2414016 04 iv 4 04/01/1897 die i mensis iv annoque mdcccxcvii 97 xcvii 1897} test clock-2.416 {conversion of 1897-04-30} { clock format -2293269904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1897 12:34:56 die xxx mensis iv annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2414045 04 iv 4 04/30/1897 die xxx mensis iv annoque mdcccxcvii 97 xcvii 1897} test clock-2.417 {conversion of 1897-05-01} { clock format -2293183504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1897 12:34:56 die i mensis v annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2414046 05 v 5 05/01/1897 die i mensis v annoque mdcccxcvii 97 xcvii 1897} test clock-2.418 {conversion of 1897-05-31} { clock format -2290591504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1897 12:34:56 die xxxi mensis v annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2414076 05 v 5 05/31/1897 die xxxi mensis v annoque mdcccxcvii 97 xcvii 1897} test clock-2.419 {conversion of 1897-06-01} { clock format -2290505104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1897 12:34:56 die i mensis vi annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2414077 06 vi 6 06/01/1897 die i mensis vi annoque mdcccxcvii 97 xcvii 1897} test clock-2.420 {conversion of 1897-06-30} { clock format -2287999504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1897 12:34:56 die xxx mensis vi annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2414106 06 vi 6 06/30/1897 die xxx mensis vi annoque mdcccxcvii 97 xcvii 1897} test clock-2.421 {conversion of 1897-07-01} { clock format -2287913104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1897 12:34:56 die i mensis vii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2414107 07 vii 7 07/01/1897 die i mensis vii annoque mdcccxcvii 97 xcvii 1897} test clock-2.422 {conversion of 1897-07-31} { clock format -2285321104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1897 12:34:56 die xxxi mensis vii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2414137 07 vii 7 07/31/1897 die xxxi mensis vii annoque mdcccxcvii 97 xcvii 1897} test clock-2.423 {conversion of 1897-08-01} { clock format -2285234704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1897 12:34:56 die i mensis viii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2414138 08 viii 8 08/01/1897 die i mensis viii annoque mdcccxcvii 97 xcvii 1897} test clock-2.424 {conversion of 1897-08-31} { clock format -2282642704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1897 12:34:56 die xxxi mensis viii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2414168 08 viii 8 08/31/1897 die xxxi mensis viii annoque mdcccxcvii 97 xcvii 1897} test clock-2.425 {conversion of 1897-09-01} { clock format -2282556304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1897 12:34:56 die i mensis ix annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2414169 09 ix 9 09/01/1897 die i mensis ix annoque mdcccxcvii 97 xcvii 1897} test clock-2.426 {conversion of 1897-09-30} { clock format -2280050704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1897 12:34:56 die xxx mensis ix annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2414198 09 ix 9 09/30/1897 die xxx mensis ix annoque mdcccxcvii 97 xcvii 1897} test clock-2.427 {conversion of 1897-10-01} { clock format -2279964304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1897 12:34:56 die i mensis x annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2414199 10 x 10 10/01/1897 die i mensis x annoque mdcccxcvii 97 xcvii 1897} test clock-2.428 {conversion of 1897-10-31} { clock format -2277372304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1897 12:34:56 die xxxi mensis x annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2414229 10 x 10 10/31/1897 die xxxi mensis x annoque mdcccxcvii 97 xcvii 1897} test clock-2.429 {conversion of 1897-11-01} { clock format -2277285904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1897 12:34:56 die i mensis xi annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2414230 11 xi 11 11/01/1897 die i mensis xi annoque mdcccxcvii 97 xcvii 1897} test clock-2.430 {conversion of 1897-11-30} { clock format -2274780304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1897 12:34:56 die xxx mensis xi annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2414259 11 xi 11 11/30/1897 die xxx mensis xi annoque mdcccxcvii 97 xcvii 1897} test clock-2.431 {conversion of 1897-12-01} { clock format -2274693904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1897 12:34:56 die i mensis xii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2414260 12 xii 12 12/01/1897 die i mensis xii annoque mdcccxcvii 97 xcvii 1897} test clock-2.432 {conversion of 1897-12-31} { clock format -2272101904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1897 12:34:56 die xxxi mensis xii annoque mdcccxcvii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2414290 12 xii 12 12/31/1897 die xxxi mensis xii annoque mdcccxcvii 97 xcvii 1897} test clock-2.433 {conversion of 1898-01-01} { clock format -2272015504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1898 12:34:56 die i mensis i annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2414291 01 i 1 01/01/1898 die i mensis i annoque mdcccxcviii 98 xcviii 1898} test clock-2.434 {conversion of 1898-01-31} { clock format -2269423504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1898 12:34:56 die xxxi mensis i annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2414321 01 i 1 01/31/1898 die xxxi mensis i annoque mdcccxcviii 98 xcviii 1898} test clock-2.435 {conversion of 1898-02-01} { clock format -2269337104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1898 12:34:56 die i mensis ii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2414322 02 ii 2 02/01/1898 die i mensis ii annoque mdcccxcviii 98 xcviii 1898} test clock-2.436 {conversion of 1898-02-28} { clock format -2267004304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1898 12:34:56 die xxviii mensis ii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2414349 02 ii 2 02/28/1898 die xxviii mensis ii annoque mdcccxcviii 98 xcviii 1898} test clock-2.437 {conversion of 1898-03-01} { clock format -2266917904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1898 12:34:56 die i mensis iii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2414350 03 iii 3 03/01/1898 die i mensis iii annoque mdcccxcviii 98 xcviii 1898} test clock-2.438 {conversion of 1898-03-31} { clock format -2264325904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1898 12:34:56 die xxxi mensis iii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2414380 03 iii 3 03/31/1898 die xxxi mensis iii annoque mdcccxcviii 98 xcviii 1898} test clock-2.439 {conversion of 1898-04-01} { clock format -2264239504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1898 12:34:56 die i mensis iv annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2414381 04 iv 4 04/01/1898 die i mensis iv annoque mdcccxcviii 98 xcviii 1898} test clock-2.440 {conversion of 1898-04-30} { clock format -2261733904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1898 12:34:56 die xxx mensis iv annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2414410 04 iv 4 04/30/1898 die xxx mensis iv annoque mdcccxcviii 98 xcviii 1898} test clock-2.441 {conversion of 1898-05-01} { clock format -2261647504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1898 12:34:56 die i mensis v annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2414411 05 v 5 05/01/1898 die i mensis v annoque mdcccxcviii 98 xcviii 1898} test clock-2.442 {conversion of 1898-05-31} { clock format -2259055504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1898 12:34:56 die xxxi mensis v annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2414441 05 v 5 05/31/1898 die xxxi mensis v annoque mdcccxcviii 98 xcviii 1898} test clock-2.443 {conversion of 1898-06-01} { clock format -2258969104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1898 12:34:56 die i mensis vi annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2414442 06 vi 6 06/01/1898 die i mensis vi annoque mdcccxcviii 98 xcviii 1898} test clock-2.444 {conversion of 1898-06-30} { clock format -2256463504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1898 12:34:56 die xxx mensis vi annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2414471 06 vi 6 06/30/1898 die xxx mensis vi annoque mdcccxcviii 98 xcviii 1898} test clock-2.445 {conversion of 1898-07-01} { clock format -2256377104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1898 12:34:56 die i mensis vii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2414472 07 vii 7 07/01/1898 die i mensis vii annoque mdcccxcviii 98 xcviii 1898} test clock-2.446 {conversion of 1898-07-31} { clock format -2253785104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1898 12:34:56 die xxxi mensis vii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2414502 07 vii 7 07/31/1898 die xxxi mensis vii annoque mdcccxcviii 98 xcviii 1898} test clock-2.447 {conversion of 1898-08-01} { clock format -2253698704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1898 12:34:56 die i mensis viii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2414503 08 viii 8 08/01/1898 die i mensis viii annoque mdcccxcviii 98 xcviii 1898} test clock-2.448 {conversion of 1898-08-31} { clock format -2251106704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1898 12:34:56 die xxxi mensis viii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2414533 08 viii 8 08/31/1898 die xxxi mensis viii annoque mdcccxcviii 98 xcviii 1898} test clock-2.449 {conversion of 1898-09-01} { clock format -2251020304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1898 12:34:56 die i mensis ix annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2414534 09 ix 9 09/01/1898 die i mensis ix annoque mdcccxcviii 98 xcviii 1898} test clock-2.450 {conversion of 1898-09-30} { clock format -2248514704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1898 12:34:56 die xxx mensis ix annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2414563 09 ix 9 09/30/1898 die xxx mensis ix annoque mdcccxcviii 98 xcviii 1898} test clock-2.451 {conversion of 1898-10-01} { clock format -2248428304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1898 12:34:56 die i mensis x annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2414564 10 x 10 10/01/1898 die i mensis x annoque mdcccxcviii 98 xcviii 1898} test clock-2.452 {conversion of 1898-10-31} { clock format -2245836304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1898 12:34:56 die xxxi mensis x annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2414594 10 x 10 10/31/1898 die xxxi mensis x annoque mdcccxcviii 98 xcviii 1898} test clock-2.453 {conversion of 1898-11-01} { clock format -2245749904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1898 12:34:56 die i mensis xi annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2414595 11 xi 11 11/01/1898 die i mensis xi annoque mdcccxcviii 98 xcviii 1898} test clock-2.454 {conversion of 1898-11-30} { clock format -2243244304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1898 12:34:56 die xxx mensis xi annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2414624 11 xi 11 11/30/1898 die xxx mensis xi annoque mdcccxcviii 98 xcviii 1898} test clock-2.455 {conversion of 1898-12-01} { clock format -2243157904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1898 12:34:56 die i mensis xii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2414625 12 xii 12 12/01/1898 die i mensis xii annoque mdcccxcviii 98 xcviii 1898} test clock-2.456 {conversion of 1898-12-31} { clock format -2240565904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1898 12:34:56 die xxxi mensis xii annoque mdcccxcviii xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2414655 12 xii 12 12/31/1898 die xxxi mensis xii annoque mdcccxcviii 98 xcviii 1898} test clock-2.457 {conversion of 1899-01-01} { clock format -2240479504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1899 12:34:56 die i mensis i annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jan 001 2414656 01 i 1 01/01/1899 die i mensis i annoque mdcccxcix 99 xcix 1899} test clock-2.458 {conversion of 1899-01-31} { clock format -2237887504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1899 12:34:56 die xxxi mensis i annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jan 031 2414686 01 i 1 01/31/1899 die xxxi mensis i annoque mdcccxcix 99 xcix 1899} test clock-2.459 {conversion of 1899-02-01} { clock format -2237801104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1899 12:34:56 die i mensis ii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Feb 032 2414687 02 ii 2 02/01/1899 die i mensis ii annoque mdcccxcix 99 xcix 1899} test clock-2.460 {conversion of 1899-02-28} { clock format -2235468304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1899 12:34:56 die xxviii mensis ii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 28 xxviii 28 xxviii Feb 059 2414714 02 ii 2 02/28/1899 die xxviii mensis ii annoque mdcccxcix 99 xcix 1899} test clock-2.461 {conversion of 1899-03-01} { clock format -2235381904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1899 12:34:56 die i mensis iii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Mar 060 2414715 03 iii 3 03/01/1899 die i mensis iii annoque mdcccxcix 99 xcix 1899} test clock-2.462 {conversion of 1899-03-31} { clock format -2232789904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1899 12:34:56 die xxxi mensis iii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Mar 090 2414745 03 iii 3 03/31/1899 die xxxi mensis iii annoque mdcccxcix 99 xcix 1899} test clock-2.463 {conversion of 1899-04-01} { clock format -2232703504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1899 12:34:56 die i mensis iv annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Apr 091 2414746 04 iv 4 04/01/1899 die i mensis iv annoque mdcccxcix 99 xcix 1899} test clock-2.464 {conversion of 1899-04-30} { clock format -2230197904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1899 12:34:56 die xxx mensis iv annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Apr 120 2414775 04 iv 4 04/30/1899 die xxx mensis iv annoque mdcccxcix 99 xcix 1899} test clock-2.465 {conversion of 1899-05-01} { clock format -2230111504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1899 12:34:56 die i mensis v annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i May 121 2414776 05 v 5 05/01/1899 die i mensis v annoque mdcccxcix 99 xcix 1899} test clock-2.466 {conversion of 1899-05-31} { clock format -2227519504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1899 12:34:56 die xxxi mensis v annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi May 151 2414806 05 v 5 05/31/1899 die xxxi mensis v annoque mdcccxcix 99 xcix 1899} test clock-2.467 {conversion of 1899-06-01} { clock format -2227433104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1899 12:34:56 die i mensis vi annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jun 152 2414807 06 vi 6 06/01/1899 die i mensis vi annoque mdcccxcix 99 xcix 1899} test clock-2.468 {conversion of 1899-06-30} { clock format -2224927504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1899 12:34:56 die xxx mensis vi annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Jun 181 2414836 06 vi 6 06/30/1899 die xxx mensis vi annoque mdcccxcix 99 xcix 1899} test clock-2.469 {conversion of 1899-07-01} { clock format -2224841104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1899 12:34:56 die i mensis vii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Jul 182 2414837 07 vii 7 07/01/1899 die i mensis vii annoque mdcccxcix 99 xcix 1899} test clock-2.470 {conversion of 1899-07-31} { clock format -2222249104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1899 12:34:56 die xxxi mensis vii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Jul 212 2414867 07 vii 7 07/31/1899 die xxxi mensis vii annoque mdcccxcix 99 xcix 1899} test clock-2.471 {conversion of 1899-08-01} { clock format -2222162704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1899 12:34:56 die i mensis viii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Aug 213 2414868 08 viii 8 08/01/1899 die i mensis viii annoque mdcccxcix 99 xcix 1899} test clock-2.472 {conversion of 1899-08-31} { clock format -2219570704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1899 12:34:56 die xxxi mensis viii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Aug 243 2414898 08 viii 8 08/31/1899 die xxxi mensis viii annoque mdcccxcix 99 xcix 1899} test clock-2.473 {conversion of 1899-09-01} { clock format -2219484304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1899 12:34:56 die i mensis ix annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Sep 244 2414899 09 ix 9 09/01/1899 die i mensis ix annoque mdcccxcix 99 xcix 1899} test clock-2.474 {conversion of 1899-09-30} { clock format -2216978704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1899 12:34:56 die xxx mensis ix annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Sep 273 2414928 09 ix 9 09/30/1899 die xxx mensis ix annoque mdcccxcix 99 xcix 1899} test clock-2.475 {conversion of 1899-10-01} { clock format -2216892304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1899 12:34:56 die i mensis x annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Oct 274 2414929 10 x 10 10/01/1899 die i mensis x annoque mdcccxcix 99 xcix 1899} test clock-2.476 {conversion of 1899-10-31} { clock format -2214300304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1899 12:34:56 die xxxi mensis x annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Oct 304 2414959 10 x 10 10/31/1899 die xxxi mensis x annoque mdcccxcix 99 xcix 1899} test clock-2.477 {conversion of 1899-11-01} { clock format -2214213904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1899 12:34:56 die i mensis xi annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Nov 305 2414960 11 xi 11 11/01/1899 die i mensis xi annoque mdcccxcix 99 xcix 1899} test clock-2.478 {conversion of 1899-11-30} { clock format -2211708304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1899 12:34:56 die xxx mensis xi annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 30 xxx 30 xxx Nov 334 2414989 11 xi 11 11/30/1899 die xxx mensis xi annoque mdcccxcix 99 xcix 1899} test clock-2.479 {conversion of 1899-12-01} { clock format -2211621904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1899 12:34:56 die i mensis xii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 01 i 1 i Dec 335 2414990 12 xii 12 12/01/1899 die i mensis xii annoque mdcccxcix 99 xcix 1899} test clock-2.480 {conversion of 1899-12-31} { clock format -2209029904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1899 12:34:56 die xxxi mensis xii annoque mdcccxcix xii h xxxiv m lvi s 18 mdccc 31 xxxi 31 xxxi Dec 365 2415020 12 xii 12 12/31/1899 die xxxi mensis xii annoque mdcccxcix 99 xcix 1899} test clock-2.481 {conversion of 1900-01-01} { clock format -2208943504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1900 12:34:56 die i mensis i annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2415021 01 i 1 01/01/1900 die i mensis i annoque mcm? 00 ? 1900} test clock-2.482 {conversion of 1900-01-31} { clock format -2206351504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1900 12:34:56 die xxxi mensis i annoque mcm? xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2415051 01 i 1 01/31/1900 die xxxi mensis i annoque mcm? 00 ? 1900} test clock-2.483 {conversion of 1900-02-01} { clock format -2206265104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1900 12:34:56 die i mensis ii annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2415052 02 ii 2 02/01/1900 die i mensis ii annoque mcm? 00 ? 1900} test clock-2.484 {conversion of 1900-02-28} { clock format -2203932304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1900 12:34:56 die xxviii mensis ii annoque mcm? xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2415079 02 ii 2 02/28/1900 die xxviii mensis ii annoque mcm? 00 ? 1900} test clock-2.485 {conversion of 1900-03-01} { clock format -2203845904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1900 12:34:56 die i mensis iii annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2415080 03 iii 3 03/01/1900 die i mensis iii annoque mcm? 00 ? 1900} test clock-2.486 {conversion of 1900-03-31} { clock format -2201253904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1900 12:34:56 die xxxi mensis iii annoque mcm? xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2415110 03 iii 3 03/31/1900 die xxxi mensis iii annoque mcm? 00 ? 1900} test clock-2.487 {conversion of 1900-04-01} { clock format -2201167504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1900 12:34:56 die i mensis iv annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2415111 04 iv 4 04/01/1900 die i mensis iv annoque mcm? 00 ? 1900} test clock-2.488 {conversion of 1900-04-30} { clock format -2198661904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1900 12:34:56 die xxx mensis iv annoque mcm? xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2415140 04 iv 4 04/30/1900 die xxx mensis iv annoque mcm? 00 ? 1900} test clock-2.489 {conversion of 1900-05-01} { clock format -2198575504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1900 12:34:56 die i mensis v annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2415141 05 v 5 05/01/1900 die i mensis v annoque mcm? 00 ? 1900} test clock-2.490 {conversion of 1900-05-31} { clock format -2195983504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1900 12:34:56 die xxxi mensis v annoque mcm? xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2415171 05 v 5 05/31/1900 die xxxi mensis v annoque mcm? 00 ? 1900} test clock-2.491 {conversion of 1900-06-01} { clock format -2195897104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1900 12:34:56 die i mensis vi annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2415172 06 vi 6 06/01/1900 die i mensis vi annoque mcm? 00 ? 1900} test clock-2.492 {conversion of 1900-06-30} { clock format -2193391504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1900 12:34:56 die xxx mensis vi annoque mcm? xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2415201 06 vi 6 06/30/1900 die xxx mensis vi annoque mcm? 00 ? 1900} test clock-2.493 {conversion of 1900-07-01} { clock format -2193305104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1900 12:34:56 die i mensis vii annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2415202 07 vii 7 07/01/1900 die i mensis vii annoque mcm? 00 ? 1900} test clock-2.494 {conversion of 1900-07-31} { clock format -2190713104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1900 12:34:56 die xxxi mensis vii annoque mcm? xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2415232 07 vii 7 07/31/1900 die xxxi mensis vii annoque mcm? 00 ? 1900} test clock-2.495 {conversion of 1900-08-01} { clock format -2190626704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1900 12:34:56 die i mensis viii annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2415233 08 viii 8 08/01/1900 die i mensis viii annoque mcm? 00 ? 1900} test clock-2.496 {conversion of 1900-08-31} { clock format -2188034704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1900 12:34:56 die xxxi mensis viii annoque mcm? xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2415263 08 viii 8 08/31/1900 die xxxi mensis viii annoque mcm? 00 ? 1900} test clock-2.497 {conversion of 1900-09-01} { clock format -2187948304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1900 12:34:56 die i mensis ix annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2415264 09 ix 9 09/01/1900 die i mensis ix annoque mcm? 00 ? 1900} test clock-2.498 {conversion of 1900-09-30} { clock format -2185442704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1900 12:34:56 die xxx mensis ix annoque mcm? xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2415293 09 ix 9 09/30/1900 die xxx mensis ix annoque mcm? 00 ? 1900} test clock-2.499 {conversion of 1900-10-01} { clock format -2185356304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1900 12:34:56 die i mensis x annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2415294 10 x 10 10/01/1900 die i mensis x annoque mcm? 00 ? 1900} test clock-2.500 {conversion of 1900-10-31} { clock format -2182764304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1900 12:34:56 die xxxi mensis x annoque mcm? xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2415324 10 x 10 10/31/1900 die xxxi mensis x annoque mcm? 00 ? 1900} test clock-2.501 {conversion of 1900-11-01} { clock format -2182677904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1900 12:34:56 die i mensis xi annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2415325 11 xi 11 11/01/1900 die i mensis xi annoque mcm? 00 ? 1900} test clock-2.502 {conversion of 1900-11-30} { clock format -2180172304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1900 12:34:56 die xxx mensis xi annoque mcm? xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2415354 11 xi 11 11/30/1900 die xxx mensis xi annoque mcm? 00 ? 1900} test clock-2.503 {conversion of 1900-12-01} { clock format -2180085904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1900 12:34:56 die i mensis xii annoque mcm? xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2415355 12 xii 12 12/01/1900 die i mensis xii annoque mcm? 00 ? 1900} test clock-2.504 {conversion of 1900-12-31} { clock format -2177493904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1900 12:34:56 die xxxi mensis xii annoque mcm? xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2415385 12 xii 12 12/31/1900 die xxxi mensis xii annoque mcm? 00 ? 1900} test clock-2.505 {conversion of 1944-01-01} { clock format -820495504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1944 12:34:56 die i mensis i annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2431091 01 i 1 01/01/1944 die i mensis i annoque mcmxliv 44 xliv 1944} test clock-2.506 {conversion of 1944-01-31} { clock format -817903504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1944 12:34:56 die xxxi mensis i annoque mcmxliv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2431121 01 i 1 01/31/1944 die xxxi mensis i annoque mcmxliv 44 xliv 1944} test clock-2.507 {conversion of 1944-02-01} { clock format -817817104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1944 12:34:56 die i mensis ii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2431122 02 ii 2 02/01/1944 die i mensis ii annoque mcmxliv 44 xliv 1944} test clock-2.508 {conversion of 1944-02-29} { clock format -815397904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1944 12:34:56 die xxix mensis ii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2431150 02 ii 2 02/29/1944 die xxix mensis ii annoque mcmxliv 44 xliv 1944} test clock-2.509 {conversion of 1944-03-01} { clock format -815311504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1944 12:34:56 die i mensis iii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2431151 03 iii 3 03/01/1944 die i mensis iii annoque mcmxliv 44 xliv 1944} test clock-2.510 {conversion of 1944-03-31} { clock format -812719504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1944 12:34:56 die xxxi mensis iii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2431181 03 iii 3 03/31/1944 die xxxi mensis iii annoque mcmxliv 44 xliv 1944} test clock-2.511 {conversion of 1944-04-01} { clock format -812633104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1944 12:34:56 die i mensis iv annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2431182 04 iv 4 04/01/1944 die i mensis iv annoque mcmxliv 44 xliv 1944} test clock-2.512 {conversion of 1944-04-30} { clock format -810127504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1944 12:34:56 die xxx mensis iv annoque mcmxliv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2431211 04 iv 4 04/30/1944 die xxx mensis iv annoque mcmxliv 44 xliv 1944} test clock-2.513 {conversion of 1944-05-01} { clock format -810041104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1944 12:34:56 die i mensis v annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2431212 05 v 5 05/01/1944 die i mensis v annoque mcmxliv 44 xliv 1944} test clock-2.514 {conversion of 1944-05-31} { clock format -807449104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1944 12:34:56 die xxxi mensis v annoque mcmxliv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2431242 05 v 5 05/31/1944 die xxxi mensis v annoque mcmxliv 44 xliv 1944} test clock-2.515 {conversion of 1944-06-01} { clock format -807362704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1944 12:34:56 die i mensis vi annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2431243 06 vi 6 06/01/1944 die i mensis vi annoque mcmxliv 44 xliv 1944} test clock-2.516 {conversion of 1944-06-30} { clock format -804857104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1944 12:34:56 die xxx mensis vi annoque mcmxliv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2431272 06 vi 6 06/30/1944 die xxx mensis vi annoque mcmxliv 44 xliv 1944} test clock-2.517 {conversion of 1944-07-01} { clock format -804770704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1944 12:34:56 die i mensis vii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2431273 07 vii 7 07/01/1944 die i mensis vii annoque mcmxliv 44 xliv 1944} test clock-2.518 {conversion of 1944-07-31} { clock format -802178704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1944 12:34:56 die xxxi mensis vii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2431303 07 vii 7 07/31/1944 die xxxi mensis vii annoque mcmxliv 44 xliv 1944} test clock-2.519 {conversion of 1944-08-01} { clock format -802092304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1944 12:34:56 die i mensis viii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2431304 08 viii 8 08/01/1944 die i mensis viii annoque mcmxliv 44 xliv 1944} test clock-2.520 {conversion of 1944-08-31} { clock format -799500304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1944 12:34:56 die xxxi mensis viii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2431334 08 viii 8 08/31/1944 die xxxi mensis viii annoque mcmxliv 44 xliv 1944} test clock-2.521 {conversion of 1944-09-01} { clock format -799413904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1944 12:34:56 die i mensis ix annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2431335 09 ix 9 09/01/1944 die i mensis ix annoque mcmxliv 44 xliv 1944} test clock-2.522 {conversion of 1944-09-30} { clock format -796908304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1944 12:34:56 die xxx mensis ix annoque mcmxliv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2431364 09 ix 9 09/30/1944 die xxx mensis ix annoque mcmxliv 44 xliv 1944} test clock-2.523 {conversion of 1944-10-01} { clock format -796821904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1944 12:34:56 die i mensis x annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2431365 10 x 10 10/01/1944 die i mensis x annoque mcmxliv 44 xliv 1944} test clock-2.524 {conversion of 1944-10-31} { clock format -794229904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1944 12:34:56 die xxxi mensis x annoque mcmxliv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2431395 10 x 10 10/31/1944 die xxxi mensis x annoque mcmxliv 44 xliv 1944} test clock-2.525 {conversion of 1944-11-01} { clock format -794143504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1944 12:34:56 die i mensis xi annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2431396 11 xi 11 11/01/1944 die i mensis xi annoque mcmxliv 44 xliv 1944} test clock-2.526 {conversion of 1944-11-30} { clock format -791637904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1944 12:34:56 die xxx mensis xi annoque mcmxliv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2431425 11 xi 11 11/30/1944 die xxx mensis xi annoque mcmxliv 44 xliv 1944} test clock-2.527 {conversion of 1944-12-01} { clock format -791551504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1944 12:34:56 die i mensis xii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2431426 12 xii 12 12/01/1944 die i mensis xii annoque mcmxliv 44 xliv 1944} test clock-2.528 {conversion of 1944-12-31} { clock format -788959504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1944 12:34:56 die xxxi mensis xii annoque mcmxliv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2431456 12 xii 12 12/31/1944 die xxxi mensis xii annoque mcmxliv 44 xliv 1944} test clock-2.529 {conversion of 1945-01-01} { clock format -788873104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1945 12:34:56 die i mensis i annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2431457 01 i 1 01/01/1945 die i mensis i annoque mcmxlv 45 xlv 1945} test clock-2.530 {conversion of 1945-01-31} { clock format -786281104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1945 12:34:56 die xxxi mensis i annoque mcmxlv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2431487 01 i 1 01/31/1945 die xxxi mensis i annoque mcmxlv 45 xlv 1945} test clock-2.531 {conversion of 1945-02-01} { clock format -786194704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1945 12:34:56 die i mensis ii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2431488 02 ii 2 02/01/1945 die i mensis ii annoque mcmxlv 45 xlv 1945} test clock-2.532 {conversion of 1945-02-28} { clock format -783861904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1945 12:34:56 die xxviii mensis ii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2431515 02 ii 2 02/28/1945 die xxviii mensis ii annoque mcmxlv 45 xlv 1945} test clock-2.533 {conversion of 1945-03-01} { clock format -783775504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1945 12:34:56 die i mensis iii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2431516 03 iii 3 03/01/1945 die i mensis iii annoque mcmxlv 45 xlv 1945} test clock-2.534 {conversion of 1945-03-31} { clock format -781183504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1945 12:34:56 die xxxi mensis iii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2431546 03 iii 3 03/31/1945 die xxxi mensis iii annoque mcmxlv 45 xlv 1945} test clock-2.535 {conversion of 1945-04-01} { clock format -781097104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1945 12:34:56 die i mensis iv annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2431547 04 iv 4 04/01/1945 die i mensis iv annoque mcmxlv 45 xlv 1945} test clock-2.536 {conversion of 1945-04-30} { clock format -778591504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1945 12:34:56 die xxx mensis iv annoque mcmxlv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2431576 04 iv 4 04/30/1945 die xxx mensis iv annoque mcmxlv 45 xlv 1945} test clock-2.537 {conversion of 1945-05-01} { clock format -778505104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1945 12:34:56 die i mensis v annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2431577 05 v 5 05/01/1945 die i mensis v annoque mcmxlv 45 xlv 1945} test clock-2.538 {conversion of 1945-05-31} { clock format -775913104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1945 12:34:56 die xxxi mensis v annoque mcmxlv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2431607 05 v 5 05/31/1945 die xxxi mensis v annoque mcmxlv 45 xlv 1945} test clock-2.539 {conversion of 1945-06-01} { clock format -775826704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1945 12:34:56 die i mensis vi annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2431608 06 vi 6 06/01/1945 die i mensis vi annoque mcmxlv 45 xlv 1945} test clock-2.540 {conversion of 1945-06-30} { clock format -773321104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1945 12:34:56 die xxx mensis vi annoque mcmxlv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2431637 06 vi 6 06/30/1945 die xxx mensis vi annoque mcmxlv 45 xlv 1945} test clock-2.541 {conversion of 1945-07-01} { clock format -773234704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1945 12:34:56 die i mensis vii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2431638 07 vii 7 07/01/1945 die i mensis vii annoque mcmxlv 45 xlv 1945} test clock-2.542 {conversion of 1945-07-31} { clock format -770642704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1945 12:34:56 die xxxi mensis vii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2431668 07 vii 7 07/31/1945 die xxxi mensis vii annoque mcmxlv 45 xlv 1945} test clock-2.543 {conversion of 1945-08-01} { clock format -770556304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1945 12:34:56 die i mensis viii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2431669 08 viii 8 08/01/1945 die i mensis viii annoque mcmxlv 45 xlv 1945} test clock-2.544 {conversion of 1945-08-31} { clock format -767964304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1945 12:34:56 die xxxi mensis viii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2431699 08 viii 8 08/31/1945 die xxxi mensis viii annoque mcmxlv 45 xlv 1945} test clock-2.545 {conversion of 1945-09-01} { clock format -767877904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1945 12:34:56 die i mensis ix annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2431700 09 ix 9 09/01/1945 die i mensis ix annoque mcmxlv 45 xlv 1945} test clock-2.546 {conversion of 1945-09-30} { clock format -765372304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1945 12:34:56 die xxx mensis ix annoque mcmxlv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2431729 09 ix 9 09/30/1945 die xxx mensis ix annoque mcmxlv 45 xlv 1945} test clock-2.547 {conversion of 1945-10-01} { clock format -765285904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1945 12:34:56 die i mensis x annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2431730 10 x 10 10/01/1945 die i mensis x annoque mcmxlv 45 xlv 1945} test clock-2.548 {conversion of 1945-10-31} { clock format -762693904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1945 12:34:56 die xxxi mensis x annoque mcmxlv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2431760 10 x 10 10/31/1945 die xxxi mensis x annoque mcmxlv 45 xlv 1945} test clock-2.549 {conversion of 1945-11-01} { clock format -762607504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1945 12:34:56 die i mensis xi annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2431761 11 xi 11 11/01/1945 die i mensis xi annoque mcmxlv 45 xlv 1945} test clock-2.550 {conversion of 1945-11-30} { clock format -760101904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1945 12:34:56 die xxx mensis xi annoque mcmxlv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2431790 11 xi 11 11/30/1945 die xxx mensis xi annoque mcmxlv 45 xlv 1945} test clock-2.551 {conversion of 1945-12-01} { clock format -760015504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1945 12:34:56 die i mensis xii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2431791 12 xii 12 12/01/1945 die i mensis xii annoque mcmxlv 45 xlv 1945} test clock-2.552 {conversion of 1945-12-31} { clock format -757423504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1945 12:34:56 die xxxi mensis xii annoque mcmxlv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2431821 12 xii 12 12/31/1945 die xxxi mensis xii annoque mcmxlv 45 xlv 1945} test clock-2.553 {conversion of 1948-01-01} { clock format -694265104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1948 12:34:56 die i mensis i annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2432552 01 i 1 01/01/1948 die i mensis i annoque mcmxlviii 48 xlviii 1948} test clock-2.554 {conversion of 1948-01-31} { clock format -691673104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1948 12:34:56 die xxxi mensis i annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2432582 01 i 1 01/31/1948 die xxxi mensis i annoque mcmxlviii 48 xlviii 1948} test clock-2.555 {conversion of 1948-02-01} { clock format -691586704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1948 12:34:56 die i mensis ii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2432583 02 ii 2 02/01/1948 die i mensis ii annoque mcmxlviii 48 xlviii 1948} test clock-2.556 {conversion of 1948-02-29} { clock format -689167504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1948 12:34:56 die xxix mensis ii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2432611 02 ii 2 02/29/1948 die xxix mensis ii annoque mcmxlviii 48 xlviii 1948} test clock-2.557 {conversion of 1948-03-01} { clock format -689081104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1948 12:34:56 die i mensis iii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2432612 03 iii 3 03/01/1948 die i mensis iii annoque mcmxlviii 48 xlviii 1948} test clock-2.558 {conversion of 1948-03-31} { clock format -686489104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1948 12:34:56 die xxxi mensis iii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2432642 03 iii 3 03/31/1948 die xxxi mensis iii annoque mcmxlviii 48 xlviii 1948} test clock-2.559 {conversion of 1948-04-01} { clock format -686402704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1948 12:34:56 die i mensis iv annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2432643 04 iv 4 04/01/1948 die i mensis iv annoque mcmxlviii 48 xlviii 1948} test clock-2.560 {conversion of 1948-04-30} { clock format -683897104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1948 12:34:56 die xxx mensis iv annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2432672 04 iv 4 04/30/1948 die xxx mensis iv annoque mcmxlviii 48 xlviii 1948} test clock-2.561 {conversion of 1948-05-01} { clock format -683810704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1948 12:34:56 die i mensis v annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2432673 05 v 5 05/01/1948 die i mensis v annoque mcmxlviii 48 xlviii 1948} test clock-2.562 {conversion of 1948-05-31} { clock format -681218704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1948 12:34:56 die xxxi mensis v annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2432703 05 v 5 05/31/1948 die xxxi mensis v annoque mcmxlviii 48 xlviii 1948} test clock-2.563 {conversion of 1948-06-01} { clock format -681132304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1948 12:34:56 die i mensis vi annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2432704 06 vi 6 06/01/1948 die i mensis vi annoque mcmxlviii 48 xlviii 1948} test clock-2.564 {conversion of 1948-06-30} { clock format -678626704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1948 12:34:56 die xxx mensis vi annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2432733 06 vi 6 06/30/1948 die xxx mensis vi annoque mcmxlviii 48 xlviii 1948} test clock-2.565 {conversion of 1948-07-01} { clock format -678540304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1948 12:34:56 die i mensis vii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2432734 07 vii 7 07/01/1948 die i mensis vii annoque mcmxlviii 48 xlviii 1948} test clock-2.566 {conversion of 1948-07-31} { clock format -675948304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1948 12:34:56 die xxxi mensis vii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2432764 07 vii 7 07/31/1948 die xxxi mensis vii annoque mcmxlviii 48 xlviii 1948} test clock-2.567 {conversion of 1948-08-01} { clock format -675861904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1948 12:34:56 die i mensis viii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2432765 08 viii 8 08/01/1948 die i mensis viii annoque mcmxlviii 48 xlviii 1948} test clock-2.568 {conversion of 1948-08-31} { clock format -673269904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1948 12:34:56 die xxxi mensis viii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2432795 08 viii 8 08/31/1948 die xxxi mensis viii annoque mcmxlviii 48 xlviii 1948} test clock-2.569 {conversion of 1948-09-01} { clock format -673183504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1948 12:34:56 die i mensis ix annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2432796 09 ix 9 09/01/1948 die i mensis ix annoque mcmxlviii 48 xlviii 1948} test clock-2.570 {conversion of 1948-09-30} { clock format -670677904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1948 12:34:56 die xxx mensis ix annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2432825 09 ix 9 09/30/1948 die xxx mensis ix annoque mcmxlviii 48 xlviii 1948} test clock-2.571 {conversion of 1948-10-01} { clock format -670591504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1948 12:34:56 die i mensis x annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2432826 10 x 10 10/01/1948 die i mensis x annoque mcmxlviii 48 xlviii 1948} test clock-2.572 {conversion of 1948-10-31} { clock format -667999504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1948 12:34:56 die xxxi mensis x annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2432856 10 x 10 10/31/1948 die xxxi mensis x annoque mcmxlviii 48 xlviii 1948} test clock-2.573 {conversion of 1948-11-01} { clock format -667913104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1948 12:34:56 die i mensis xi annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2432857 11 xi 11 11/01/1948 die i mensis xi annoque mcmxlviii 48 xlviii 1948} test clock-2.574 {conversion of 1948-11-30} { clock format -665407504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1948 12:34:56 die xxx mensis xi annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2432886 11 xi 11 11/30/1948 die xxx mensis xi annoque mcmxlviii 48 xlviii 1948} test clock-2.575 {conversion of 1948-12-01} { clock format -665321104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1948 12:34:56 die i mensis xii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2432887 12 xii 12 12/01/1948 die i mensis xii annoque mcmxlviii 48 xlviii 1948} test clock-2.576 {conversion of 1948-12-31} { clock format -662729104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1948 12:34:56 die xxxi mensis xii annoque mcmxlviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2432917 12 xii 12 12/31/1948 die xxxi mensis xii annoque mcmxlviii 48 xlviii 1948} test clock-2.577 {conversion of 1949-01-01} { clock format -662642704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1949 12:34:56 die i mensis i annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2432918 01 i 1 01/01/1949 die i mensis i annoque mcmxlix 49 xlix 1949} test clock-2.578 {conversion of 1949-01-31} { clock format -660050704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1949 12:34:56 die xxxi mensis i annoque mcmxlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2432948 01 i 1 01/31/1949 die xxxi mensis i annoque mcmxlix 49 xlix 1949} test clock-2.579 {conversion of 1949-02-01} { clock format -659964304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1949 12:34:56 die i mensis ii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2432949 02 ii 2 02/01/1949 die i mensis ii annoque mcmxlix 49 xlix 1949} test clock-2.580 {conversion of 1949-02-28} { clock format -657631504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1949 12:34:56 die xxviii mensis ii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2432976 02 ii 2 02/28/1949 die xxviii mensis ii annoque mcmxlix 49 xlix 1949} test clock-2.581 {conversion of 1949-03-01} { clock format -657545104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1949 12:34:56 die i mensis iii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2432977 03 iii 3 03/01/1949 die i mensis iii annoque mcmxlix 49 xlix 1949} test clock-2.582 {conversion of 1949-03-31} { clock format -654953104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1949 12:34:56 die xxxi mensis iii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2433007 03 iii 3 03/31/1949 die xxxi mensis iii annoque mcmxlix 49 xlix 1949} test clock-2.583 {conversion of 1949-04-01} { clock format -654866704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1949 12:34:56 die i mensis iv annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2433008 04 iv 4 04/01/1949 die i mensis iv annoque mcmxlix 49 xlix 1949} test clock-2.584 {conversion of 1949-04-30} { clock format -652361104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1949 12:34:56 die xxx mensis iv annoque mcmxlix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2433037 04 iv 4 04/30/1949 die xxx mensis iv annoque mcmxlix 49 xlix 1949} test clock-2.585 {conversion of 1949-05-01} { clock format -652274704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1949 12:34:56 die i mensis v annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2433038 05 v 5 05/01/1949 die i mensis v annoque mcmxlix 49 xlix 1949} test clock-2.586 {conversion of 1949-05-31} { clock format -649682704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1949 12:34:56 die xxxi mensis v annoque mcmxlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2433068 05 v 5 05/31/1949 die xxxi mensis v annoque mcmxlix 49 xlix 1949} test clock-2.587 {conversion of 1949-06-01} { clock format -649596304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1949 12:34:56 die i mensis vi annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2433069 06 vi 6 06/01/1949 die i mensis vi annoque mcmxlix 49 xlix 1949} test clock-2.588 {conversion of 1949-06-30} { clock format -647090704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1949 12:34:56 die xxx mensis vi annoque mcmxlix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2433098 06 vi 6 06/30/1949 die xxx mensis vi annoque mcmxlix 49 xlix 1949} test clock-2.589 {conversion of 1949-07-01} { clock format -647004304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1949 12:34:56 die i mensis vii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2433099 07 vii 7 07/01/1949 die i mensis vii annoque mcmxlix 49 xlix 1949} test clock-2.590 {conversion of 1949-07-31} { clock format -644412304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1949 12:34:56 die xxxi mensis vii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2433129 07 vii 7 07/31/1949 die xxxi mensis vii annoque mcmxlix 49 xlix 1949} test clock-2.591 {conversion of 1949-08-01} { clock format -644325904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1949 12:34:56 die i mensis viii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2433130 08 viii 8 08/01/1949 die i mensis viii annoque mcmxlix 49 xlix 1949} test clock-2.592 {conversion of 1949-08-31} { clock format -641733904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1949 12:34:56 die xxxi mensis viii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2433160 08 viii 8 08/31/1949 die xxxi mensis viii annoque mcmxlix 49 xlix 1949} test clock-2.593 {conversion of 1949-09-01} { clock format -641647504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1949 12:34:56 die i mensis ix annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2433161 09 ix 9 09/01/1949 die i mensis ix annoque mcmxlix 49 xlix 1949} test clock-2.594 {conversion of 1949-09-30} { clock format -639141904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1949 12:34:56 die xxx mensis ix annoque mcmxlix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2433190 09 ix 9 09/30/1949 die xxx mensis ix annoque mcmxlix 49 xlix 1949} test clock-2.595 {conversion of 1949-10-01} { clock format -639055504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1949 12:34:56 die i mensis x annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2433191 10 x 10 10/01/1949 die i mensis x annoque mcmxlix 49 xlix 1949} test clock-2.596 {conversion of 1949-10-31} { clock format -636463504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1949 12:34:56 die xxxi mensis x annoque mcmxlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2433221 10 x 10 10/31/1949 die xxxi mensis x annoque mcmxlix 49 xlix 1949} test clock-2.597 {conversion of 1949-11-01} { clock format -636377104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1949 12:34:56 die i mensis xi annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2433222 11 xi 11 11/01/1949 die i mensis xi annoque mcmxlix 49 xlix 1949} test clock-2.598 {conversion of 1949-11-30} { clock format -633871504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1949 12:34:56 die xxx mensis xi annoque mcmxlix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2433251 11 xi 11 11/30/1949 die xxx mensis xi annoque mcmxlix 49 xlix 1949} test clock-2.599 {conversion of 1949-12-01} { clock format -633785104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1949 12:34:56 die i mensis xii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2433252 12 xii 12 12/01/1949 die i mensis xii annoque mcmxlix 49 xlix 1949} test clock-2.600 {conversion of 1949-12-31} { clock format -631193104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1949 12:34:56 die xxxi mensis xii annoque mcmxlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2433282 12 xii 12 12/31/1949 die xxxi mensis xii annoque mcmxlix 49 xlix 1949} test clock-2.601 {conversion of 1952-01-01} { clock format -568034704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1952 12:34:56 die i mensis i annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2434013 01 i 1 01/01/1952 die i mensis i annoque mcmlii 52 lii 1952} test clock-2.602 {conversion of 1952-01-31} { clock format -565442704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1952 12:34:56 die xxxi mensis i annoque mcmlii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2434043 01 i 1 01/31/1952 die xxxi mensis i annoque mcmlii 52 lii 1952} test clock-2.603 {conversion of 1952-02-01} { clock format -565356304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1952 12:34:56 die i mensis ii annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2434044 02 ii 2 02/01/1952 die i mensis ii annoque mcmlii 52 lii 1952} test clock-2.604 {conversion of 1952-02-29} { clock format -562937104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1952 12:34:56 die xxix mensis ii annoque mcmlii xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2434072 02 ii 2 02/29/1952 die xxix mensis ii annoque mcmlii 52 lii 1952} test clock-2.605 {conversion of 1952-03-01} { clock format -562850704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1952 12:34:56 die i mensis iii annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2434073 03 iii 3 03/01/1952 die i mensis iii annoque mcmlii 52 lii 1952} test clock-2.606 {conversion of 1952-03-31} { clock format -560258704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1952 12:34:56 die xxxi mensis iii annoque mcmlii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2434103 03 iii 3 03/31/1952 die xxxi mensis iii annoque mcmlii 52 lii 1952} test clock-2.607 {conversion of 1952-04-01} { clock format -560172304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1952 12:34:56 die i mensis iv annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2434104 04 iv 4 04/01/1952 die i mensis iv annoque mcmlii 52 lii 1952} test clock-2.608 {conversion of 1952-04-30} { clock format -557666704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1952 12:34:56 die xxx mensis iv annoque mcmlii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2434133 04 iv 4 04/30/1952 die xxx mensis iv annoque mcmlii 52 lii 1952} test clock-2.609 {conversion of 1952-05-01} { clock format -557580304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1952 12:34:56 die i mensis v annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2434134 05 v 5 05/01/1952 die i mensis v annoque mcmlii 52 lii 1952} test clock-2.610 {conversion of 1952-05-31} { clock format -554988304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1952 12:34:56 die xxxi mensis v annoque mcmlii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2434164 05 v 5 05/31/1952 die xxxi mensis v annoque mcmlii 52 lii 1952} test clock-2.611 {conversion of 1952-06-01} { clock format -554901904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1952 12:34:56 die i mensis vi annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2434165 06 vi 6 06/01/1952 die i mensis vi annoque mcmlii 52 lii 1952} test clock-2.612 {conversion of 1952-06-30} { clock format -552396304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1952 12:34:56 die xxx mensis vi annoque mcmlii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2434194 06 vi 6 06/30/1952 die xxx mensis vi annoque mcmlii 52 lii 1952} test clock-2.613 {conversion of 1952-07-01} { clock format -552309904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1952 12:34:56 die i mensis vii annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2434195 07 vii 7 07/01/1952 die i mensis vii annoque mcmlii 52 lii 1952} test clock-2.614 {conversion of 1952-07-31} { clock format -549717904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1952 12:34:56 die xxxi mensis vii annoque mcmlii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2434225 07 vii 7 07/31/1952 die xxxi mensis vii annoque mcmlii 52 lii 1952} test clock-2.615 {conversion of 1952-08-01} { clock format -549631504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1952 12:34:56 die i mensis viii annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2434226 08 viii 8 08/01/1952 die i mensis viii annoque mcmlii 52 lii 1952} test clock-2.616 {conversion of 1952-08-31} { clock format -547039504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1952 12:34:56 die xxxi mensis viii annoque mcmlii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2434256 08 viii 8 08/31/1952 die xxxi mensis viii annoque mcmlii 52 lii 1952} test clock-2.617 {conversion of 1952-09-01} { clock format -546953104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1952 12:34:56 die i mensis ix annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2434257 09 ix 9 09/01/1952 die i mensis ix annoque mcmlii 52 lii 1952} test clock-2.618 {conversion of 1952-09-30} { clock format -544447504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1952 12:34:56 die xxx mensis ix annoque mcmlii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2434286 09 ix 9 09/30/1952 die xxx mensis ix annoque mcmlii 52 lii 1952} test clock-2.619 {conversion of 1952-10-01} { clock format -544361104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1952 12:34:56 die i mensis x annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2434287 10 x 10 10/01/1952 die i mensis x annoque mcmlii 52 lii 1952} test clock-2.620 {conversion of 1952-10-31} { clock format -541769104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1952 12:34:56 die xxxi mensis x annoque mcmlii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2434317 10 x 10 10/31/1952 die xxxi mensis x annoque mcmlii 52 lii 1952} test clock-2.621 {conversion of 1952-11-01} { clock format -541682704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1952 12:34:56 die i mensis xi annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2434318 11 xi 11 11/01/1952 die i mensis xi annoque mcmlii 52 lii 1952} test clock-2.622 {conversion of 1952-11-30} { clock format -539177104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1952 12:34:56 die xxx mensis xi annoque mcmlii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2434347 11 xi 11 11/30/1952 die xxx mensis xi annoque mcmlii 52 lii 1952} test clock-2.623 {conversion of 1952-12-01} { clock format -539090704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1952 12:34:56 die i mensis xii annoque mcmlii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2434348 12 xii 12 12/01/1952 die i mensis xii annoque mcmlii 52 lii 1952} test clock-2.624 {conversion of 1952-12-31} { clock format -536498704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1952 12:34:56 die xxxi mensis xii annoque mcmlii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2434378 12 xii 12 12/31/1952 die xxxi mensis xii annoque mcmlii 52 lii 1952} test clock-2.625 {conversion of 1953-01-01} { clock format -536412304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1953 12:34:56 die i mensis i annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2434379 01 i 1 01/01/1953 die i mensis i annoque mcmliii 53 liii 1953} test clock-2.626 {conversion of 1953-01-31} { clock format -533820304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1953 12:34:56 die xxxi mensis i annoque mcmliii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2434409 01 i 1 01/31/1953 die xxxi mensis i annoque mcmliii 53 liii 1953} test clock-2.627 {conversion of 1953-02-01} { clock format -533733904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1953 12:34:56 die i mensis ii annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2434410 02 ii 2 02/01/1953 die i mensis ii annoque mcmliii 53 liii 1953} test clock-2.628 {conversion of 1953-02-28} { clock format -531401104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1953 12:34:56 die xxviii mensis ii annoque mcmliii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2434437 02 ii 2 02/28/1953 die xxviii mensis ii annoque mcmliii 53 liii 1953} test clock-2.629 {conversion of 1953-03-01} { clock format -531314704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1953 12:34:56 die i mensis iii annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2434438 03 iii 3 03/01/1953 die i mensis iii annoque mcmliii 53 liii 1953} test clock-2.630 {conversion of 1953-03-31} { clock format -528722704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1953 12:34:56 die xxxi mensis iii annoque mcmliii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2434468 03 iii 3 03/31/1953 die xxxi mensis iii annoque mcmliii 53 liii 1953} test clock-2.631 {conversion of 1953-04-01} { clock format -528636304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1953 12:34:56 die i mensis iv annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2434469 04 iv 4 04/01/1953 die i mensis iv annoque mcmliii 53 liii 1953} test clock-2.632 {conversion of 1953-04-30} { clock format -526130704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1953 12:34:56 die xxx mensis iv annoque mcmliii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2434498 04 iv 4 04/30/1953 die xxx mensis iv annoque mcmliii 53 liii 1953} test clock-2.633 {conversion of 1953-05-01} { clock format -526044304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1953 12:34:56 die i mensis v annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2434499 05 v 5 05/01/1953 die i mensis v annoque mcmliii 53 liii 1953} test clock-2.634 {conversion of 1953-05-31} { clock format -523452304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1953 12:34:56 die xxxi mensis v annoque mcmliii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2434529 05 v 5 05/31/1953 die xxxi mensis v annoque mcmliii 53 liii 1953} test clock-2.635 {conversion of 1953-06-01} { clock format -523365904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1953 12:34:56 die i mensis vi annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2434530 06 vi 6 06/01/1953 die i mensis vi annoque mcmliii 53 liii 1953} test clock-2.636 {conversion of 1953-06-30} { clock format -520860304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1953 12:34:56 die xxx mensis vi annoque mcmliii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2434559 06 vi 6 06/30/1953 die xxx mensis vi annoque mcmliii 53 liii 1953} test clock-2.637 {conversion of 1953-07-01} { clock format -520773904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1953 12:34:56 die i mensis vii annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2434560 07 vii 7 07/01/1953 die i mensis vii annoque mcmliii 53 liii 1953} test clock-2.638 {conversion of 1953-07-31} { clock format -518181904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1953 12:34:56 die xxxi mensis vii annoque mcmliii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2434590 07 vii 7 07/31/1953 die xxxi mensis vii annoque mcmliii 53 liii 1953} test clock-2.639 {conversion of 1953-08-01} { clock format -518095504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1953 12:34:56 die i mensis viii annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2434591 08 viii 8 08/01/1953 die i mensis viii annoque mcmliii 53 liii 1953} test clock-2.640 {conversion of 1953-08-31} { clock format -515503504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1953 12:34:56 die xxxi mensis viii annoque mcmliii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2434621 08 viii 8 08/31/1953 die xxxi mensis viii annoque mcmliii 53 liii 1953} test clock-2.641 {conversion of 1953-09-01} { clock format -515417104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1953 12:34:56 die i mensis ix annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2434622 09 ix 9 09/01/1953 die i mensis ix annoque mcmliii 53 liii 1953} test clock-2.642 {conversion of 1953-09-30} { clock format -512911504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1953 12:34:56 die xxx mensis ix annoque mcmliii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2434651 09 ix 9 09/30/1953 die xxx mensis ix annoque mcmliii 53 liii 1953} test clock-2.643 {conversion of 1953-10-01} { clock format -512825104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1953 12:34:56 die i mensis x annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2434652 10 x 10 10/01/1953 die i mensis x annoque mcmliii 53 liii 1953} test clock-2.644 {conversion of 1953-10-31} { clock format -510233104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1953 12:34:56 die xxxi mensis x annoque mcmliii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2434682 10 x 10 10/31/1953 die xxxi mensis x annoque mcmliii 53 liii 1953} test clock-2.645 {conversion of 1953-11-01} { clock format -510146704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1953 12:34:56 die i mensis xi annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2434683 11 xi 11 11/01/1953 die i mensis xi annoque mcmliii 53 liii 1953} test clock-2.646 {conversion of 1953-11-30} { clock format -507641104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1953 12:34:56 die xxx mensis xi annoque mcmliii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2434712 11 xi 11 11/30/1953 die xxx mensis xi annoque mcmliii 53 liii 1953} test clock-2.647 {conversion of 1953-12-01} { clock format -507554704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1953 12:34:56 die i mensis xii annoque mcmliii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2434713 12 xii 12 12/01/1953 die i mensis xii annoque mcmliii 53 liii 1953} test clock-2.648 {conversion of 1953-12-31} { clock format -504962704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1953 12:34:56 die xxxi mensis xii annoque mcmliii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2434743 12 xii 12 12/31/1953 die xxxi mensis xii annoque mcmliii 53 liii 1953} test clock-2.649 {conversion of 1956-01-01} { clock format -441804304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1956 12:34:56 die i mensis i annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2435474 01 i 1 01/01/1956 die i mensis i annoque mcmlvi 56 lvi 1956} test clock-2.650 {conversion of 1956-01-31} { clock format -439212304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1956 12:34:56 die xxxi mensis i annoque mcmlvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2435504 01 i 1 01/31/1956 die xxxi mensis i annoque mcmlvi 56 lvi 1956} test clock-2.651 {conversion of 1956-02-01} { clock format -439125904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1956 12:34:56 die i mensis ii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2435505 02 ii 2 02/01/1956 die i mensis ii annoque mcmlvi 56 lvi 1956} test clock-2.652 {conversion of 1956-02-29} { clock format -436706704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1956 12:34:56 die xxix mensis ii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2435533 02 ii 2 02/29/1956 die xxix mensis ii annoque mcmlvi 56 lvi 1956} test clock-2.653 {conversion of 1956-03-01} { clock format -436620304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1956 12:34:56 die i mensis iii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2435534 03 iii 3 03/01/1956 die i mensis iii annoque mcmlvi 56 lvi 1956} test clock-2.654 {conversion of 1956-03-31} { clock format -434028304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1956 12:34:56 die xxxi mensis iii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2435564 03 iii 3 03/31/1956 die xxxi mensis iii annoque mcmlvi 56 lvi 1956} test clock-2.655 {conversion of 1956-04-01} { clock format -433941904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1956 12:34:56 die i mensis iv annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2435565 04 iv 4 04/01/1956 die i mensis iv annoque mcmlvi 56 lvi 1956} test clock-2.656 {conversion of 1956-04-30} { clock format -431436304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1956 12:34:56 die xxx mensis iv annoque mcmlvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2435594 04 iv 4 04/30/1956 die xxx mensis iv annoque mcmlvi 56 lvi 1956} test clock-2.657 {conversion of 1956-05-01} { clock format -431349904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1956 12:34:56 die i mensis v annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2435595 05 v 5 05/01/1956 die i mensis v annoque mcmlvi 56 lvi 1956} test clock-2.658 {conversion of 1956-05-31} { clock format -428757904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1956 12:34:56 die xxxi mensis v annoque mcmlvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2435625 05 v 5 05/31/1956 die xxxi mensis v annoque mcmlvi 56 lvi 1956} test clock-2.659 {conversion of 1956-06-01} { clock format -428671504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1956 12:34:56 die i mensis vi annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2435626 06 vi 6 06/01/1956 die i mensis vi annoque mcmlvi 56 lvi 1956} test clock-2.660 {conversion of 1956-06-30} { clock format -426165904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1956 12:34:56 die xxx mensis vi annoque mcmlvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2435655 06 vi 6 06/30/1956 die xxx mensis vi annoque mcmlvi 56 lvi 1956} test clock-2.661 {conversion of 1956-07-01} { clock format -426079504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1956 12:34:56 die i mensis vii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2435656 07 vii 7 07/01/1956 die i mensis vii annoque mcmlvi 56 lvi 1956} test clock-2.662 {conversion of 1956-07-31} { clock format -423487504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1956 12:34:56 die xxxi mensis vii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2435686 07 vii 7 07/31/1956 die xxxi mensis vii annoque mcmlvi 56 lvi 1956} test clock-2.663 {conversion of 1956-08-01} { clock format -423401104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1956 12:34:56 die i mensis viii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2435687 08 viii 8 08/01/1956 die i mensis viii annoque mcmlvi 56 lvi 1956} test clock-2.664 {conversion of 1956-08-31} { clock format -420809104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1956 12:34:56 die xxxi mensis viii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2435717 08 viii 8 08/31/1956 die xxxi mensis viii annoque mcmlvi 56 lvi 1956} test clock-2.665 {conversion of 1956-09-01} { clock format -420722704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1956 12:34:56 die i mensis ix annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2435718 09 ix 9 09/01/1956 die i mensis ix annoque mcmlvi 56 lvi 1956} test clock-2.666 {conversion of 1956-09-30} { clock format -418217104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1956 12:34:56 die xxx mensis ix annoque mcmlvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2435747 09 ix 9 09/30/1956 die xxx mensis ix annoque mcmlvi 56 lvi 1956} test clock-2.667 {conversion of 1956-10-01} { clock format -418130704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1956 12:34:56 die i mensis x annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2435748 10 x 10 10/01/1956 die i mensis x annoque mcmlvi 56 lvi 1956} test clock-2.668 {conversion of 1956-10-31} { clock format -415538704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1956 12:34:56 die xxxi mensis x annoque mcmlvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2435778 10 x 10 10/31/1956 die xxxi mensis x annoque mcmlvi 56 lvi 1956} test clock-2.669 {conversion of 1956-11-01} { clock format -415452304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1956 12:34:56 die i mensis xi annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2435779 11 xi 11 11/01/1956 die i mensis xi annoque mcmlvi 56 lvi 1956} test clock-2.670 {conversion of 1956-11-30} { clock format -412946704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1956 12:34:56 die xxx mensis xi annoque mcmlvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2435808 11 xi 11 11/30/1956 die xxx mensis xi annoque mcmlvi 56 lvi 1956} test clock-2.671 {conversion of 1956-12-01} { clock format -412860304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1956 12:34:56 die i mensis xii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2435809 12 xii 12 12/01/1956 die i mensis xii annoque mcmlvi 56 lvi 1956} test clock-2.672 {conversion of 1956-12-31} { clock format -410268304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1956 12:34:56 die xxxi mensis xii annoque mcmlvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2435839 12 xii 12 12/31/1956 die xxxi mensis xii annoque mcmlvi 56 lvi 1956} test clock-2.673 {conversion of 1957-01-01} { clock format -410181904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1957 12:34:56 die i mensis i annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2435840 01 i 1 01/01/1957 die i mensis i annoque mcmlvii 57 lvii 1957} test clock-2.674 {conversion of 1957-01-31} { clock format -407589904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1957 12:34:56 die xxxi mensis i annoque mcmlvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2435870 01 i 1 01/31/1957 die xxxi mensis i annoque mcmlvii 57 lvii 1957} test clock-2.675 {conversion of 1957-02-01} { clock format -407503504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1957 12:34:56 die i mensis ii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2435871 02 ii 2 02/01/1957 die i mensis ii annoque mcmlvii 57 lvii 1957} test clock-2.676 {conversion of 1957-02-28} { clock format -405170704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1957 12:34:56 die xxviii mensis ii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2435898 02 ii 2 02/28/1957 die xxviii mensis ii annoque mcmlvii 57 lvii 1957} test clock-2.677 {conversion of 1957-03-01} { clock format -405084304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1957 12:34:56 die i mensis iii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2435899 03 iii 3 03/01/1957 die i mensis iii annoque mcmlvii 57 lvii 1957} test clock-2.678 {conversion of 1957-03-31} { clock format -402492304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1957 12:34:56 die xxxi mensis iii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2435929 03 iii 3 03/31/1957 die xxxi mensis iii annoque mcmlvii 57 lvii 1957} test clock-2.679 {conversion of 1957-04-01} { clock format -402405904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1957 12:34:56 die i mensis iv annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2435930 04 iv 4 04/01/1957 die i mensis iv annoque mcmlvii 57 lvii 1957} test clock-2.680 {conversion of 1957-04-30} { clock format -399900304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1957 12:34:56 die xxx mensis iv annoque mcmlvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2435959 04 iv 4 04/30/1957 die xxx mensis iv annoque mcmlvii 57 lvii 1957} test clock-2.681 {conversion of 1957-05-01} { clock format -399813904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1957 12:34:56 die i mensis v annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2435960 05 v 5 05/01/1957 die i mensis v annoque mcmlvii 57 lvii 1957} test clock-2.682 {conversion of 1957-05-31} { clock format -397221904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1957 12:34:56 die xxxi mensis v annoque mcmlvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2435990 05 v 5 05/31/1957 die xxxi mensis v annoque mcmlvii 57 lvii 1957} test clock-2.683 {conversion of 1957-06-01} { clock format -397135504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1957 12:34:56 die i mensis vi annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2435991 06 vi 6 06/01/1957 die i mensis vi annoque mcmlvii 57 lvii 1957} test clock-2.684 {conversion of 1957-06-30} { clock format -394629904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1957 12:34:56 die xxx mensis vi annoque mcmlvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2436020 06 vi 6 06/30/1957 die xxx mensis vi annoque mcmlvii 57 lvii 1957} test clock-2.685 {conversion of 1957-07-01} { clock format -394543504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1957 12:34:56 die i mensis vii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2436021 07 vii 7 07/01/1957 die i mensis vii annoque mcmlvii 57 lvii 1957} test clock-2.686 {conversion of 1957-07-31} { clock format -391951504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1957 12:34:56 die xxxi mensis vii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2436051 07 vii 7 07/31/1957 die xxxi mensis vii annoque mcmlvii 57 lvii 1957} test clock-2.687 {conversion of 1957-08-01} { clock format -391865104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1957 12:34:56 die i mensis viii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2436052 08 viii 8 08/01/1957 die i mensis viii annoque mcmlvii 57 lvii 1957} test clock-2.688 {conversion of 1957-08-31} { clock format -389273104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1957 12:34:56 die xxxi mensis viii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2436082 08 viii 8 08/31/1957 die xxxi mensis viii annoque mcmlvii 57 lvii 1957} test clock-2.689 {conversion of 1957-09-01} { clock format -389186704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1957 12:34:56 die i mensis ix annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2436083 09 ix 9 09/01/1957 die i mensis ix annoque mcmlvii 57 lvii 1957} test clock-2.690 {conversion of 1957-09-30} { clock format -386681104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1957 12:34:56 die xxx mensis ix annoque mcmlvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2436112 09 ix 9 09/30/1957 die xxx mensis ix annoque mcmlvii 57 lvii 1957} test clock-2.691 {conversion of 1957-10-01} { clock format -386594704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1957 12:34:56 die i mensis x annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2436113 10 x 10 10/01/1957 die i mensis x annoque mcmlvii 57 lvii 1957} test clock-2.692 {conversion of 1957-10-31} { clock format -384002704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1957 12:34:56 die xxxi mensis x annoque mcmlvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2436143 10 x 10 10/31/1957 die xxxi mensis x annoque mcmlvii 57 lvii 1957} test clock-2.693 {conversion of 1957-11-01} { clock format -383916304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1957 12:34:56 die i mensis xi annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2436144 11 xi 11 11/01/1957 die i mensis xi annoque mcmlvii 57 lvii 1957} test clock-2.694 {conversion of 1957-11-30} { clock format -381410704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1957 12:34:56 die xxx mensis xi annoque mcmlvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2436173 11 xi 11 11/30/1957 die xxx mensis xi annoque mcmlvii 57 lvii 1957} test clock-2.695 {conversion of 1957-12-01} { clock format -381324304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1957 12:34:56 die i mensis xii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2436174 12 xii 12 12/01/1957 die i mensis xii annoque mcmlvii 57 lvii 1957} test clock-2.696 {conversion of 1957-12-31} { clock format -378732304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1957 12:34:56 die xxxi mensis xii annoque mcmlvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2436204 12 xii 12 12/31/1957 die xxxi mensis xii annoque mcmlvii 57 lvii 1957} test clock-2.697 {conversion of 1959-01-01} { clock format -347109904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1959 12:34:56 die i mensis i annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2436570 01 i 1 01/01/1959 die i mensis i annoque mcmlix 59 lix 1959} test clock-2.698 {conversion of 1959-01-31} { clock format -344517904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1959 12:34:56 die xxxi mensis i annoque mcmlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2436600 01 i 1 01/31/1959 die xxxi mensis i annoque mcmlix 59 lix 1959} test clock-2.699 {conversion of 1959-02-01} { clock format -344431504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1959 12:34:56 die i mensis ii annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2436601 02 ii 2 02/01/1959 die i mensis ii annoque mcmlix 59 lix 1959} test clock-2.700 {conversion of 1959-02-28} { clock format -342098704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1959 12:34:56 die xxviii mensis ii annoque mcmlix xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2436628 02 ii 2 02/28/1959 die xxviii mensis ii annoque mcmlix 59 lix 1959} test clock-2.701 {conversion of 1959-03-01} { clock format -342012304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1959 12:34:56 die i mensis iii annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2436629 03 iii 3 03/01/1959 die i mensis iii annoque mcmlix 59 lix 1959} test clock-2.702 {conversion of 1959-03-31} { clock format -339420304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1959 12:34:56 die xxxi mensis iii annoque mcmlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2436659 03 iii 3 03/31/1959 die xxxi mensis iii annoque mcmlix 59 lix 1959} test clock-2.703 {conversion of 1959-04-01} { clock format -339333904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1959 12:34:56 die i mensis iv annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2436660 04 iv 4 04/01/1959 die i mensis iv annoque mcmlix 59 lix 1959} test clock-2.704 {conversion of 1959-04-30} { clock format -336828304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1959 12:34:56 die xxx mensis iv annoque mcmlix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2436689 04 iv 4 04/30/1959 die xxx mensis iv annoque mcmlix 59 lix 1959} test clock-2.705 {conversion of 1959-05-01} { clock format -336741904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1959 12:34:56 die i mensis v annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2436690 05 v 5 05/01/1959 die i mensis v annoque mcmlix 59 lix 1959} test clock-2.706 {conversion of 1959-05-31} { clock format -334149904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1959 12:34:56 die xxxi mensis v annoque mcmlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2436720 05 v 5 05/31/1959 die xxxi mensis v annoque mcmlix 59 lix 1959} test clock-2.707 {conversion of 1959-06-01} { clock format -334063504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1959 12:34:56 die i mensis vi annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2436721 06 vi 6 06/01/1959 die i mensis vi annoque mcmlix 59 lix 1959} test clock-2.708 {conversion of 1959-06-30} { clock format -331557904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1959 12:34:56 die xxx mensis vi annoque mcmlix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2436750 06 vi 6 06/30/1959 die xxx mensis vi annoque mcmlix 59 lix 1959} test clock-2.709 {conversion of 1959-07-01} { clock format -331471504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1959 12:34:56 die i mensis vii annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2436751 07 vii 7 07/01/1959 die i mensis vii annoque mcmlix 59 lix 1959} test clock-2.710 {conversion of 1959-07-31} { clock format -328879504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1959 12:34:56 die xxxi mensis vii annoque mcmlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2436781 07 vii 7 07/31/1959 die xxxi mensis vii annoque mcmlix 59 lix 1959} test clock-2.711 {conversion of 1959-08-01} { clock format -328793104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1959 12:34:56 die i mensis viii annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2436782 08 viii 8 08/01/1959 die i mensis viii annoque mcmlix 59 lix 1959} test clock-2.712 {conversion of 1959-08-31} { clock format -326201104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1959 12:34:56 die xxxi mensis viii annoque mcmlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2436812 08 viii 8 08/31/1959 die xxxi mensis viii annoque mcmlix 59 lix 1959} test clock-2.713 {conversion of 1959-09-01} { clock format -326114704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1959 12:34:56 die i mensis ix annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2436813 09 ix 9 09/01/1959 die i mensis ix annoque mcmlix 59 lix 1959} test clock-2.714 {conversion of 1959-09-30} { clock format -323609104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1959 12:34:56 die xxx mensis ix annoque mcmlix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2436842 09 ix 9 09/30/1959 die xxx mensis ix annoque mcmlix 59 lix 1959} test clock-2.715 {conversion of 1959-10-01} { clock format -323522704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1959 12:34:56 die i mensis x annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2436843 10 x 10 10/01/1959 die i mensis x annoque mcmlix 59 lix 1959} test clock-2.716 {conversion of 1959-10-31} { clock format -320930704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1959 12:34:56 die xxxi mensis x annoque mcmlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2436873 10 x 10 10/31/1959 die xxxi mensis x annoque mcmlix 59 lix 1959} test clock-2.717 {conversion of 1959-11-01} { clock format -320844304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1959 12:34:56 die i mensis xi annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2436874 11 xi 11 11/01/1959 die i mensis xi annoque mcmlix 59 lix 1959} test clock-2.718 {conversion of 1959-11-30} { clock format -318338704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1959 12:34:56 die xxx mensis xi annoque mcmlix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2436903 11 xi 11 11/30/1959 die xxx mensis xi annoque mcmlix 59 lix 1959} test clock-2.719 {conversion of 1959-12-01} { clock format -318252304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1959 12:34:56 die i mensis xii annoque mcmlix xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2436904 12 xii 12 12/01/1959 die i mensis xii annoque mcmlix 59 lix 1959} test clock-2.720 {conversion of 1959-12-31} { clock format -315660304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1959 12:34:56 die xxxi mensis xii annoque mcmlix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2436934 12 xii 12 12/31/1959 die xxxi mensis xii annoque mcmlix 59 lix 1959} test clock-2.721 {conversion of 1960-01-01} { clock format -315573904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1960 12:34:56 die i mensis i annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2436935 01 i 1 01/01/1960 die i mensis i annoque mcmlx 60 lx 1960} test clock-2.722 {conversion of 1960-01-31} { clock format -312981904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1960 12:34:56 die xxxi mensis i annoque mcmlx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2436965 01 i 1 01/31/1960 die xxxi mensis i annoque mcmlx 60 lx 1960} test clock-2.723 {conversion of 1960-02-01} { clock format -312895504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1960 12:34:56 die i mensis ii annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2436966 02 ii 2 02/01/1960 die i mensis ii annoque mcmlx 60 lx 1960} test clock-2.724 {conversion of 1960-02-29} { clock format -310476304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1960 12:34:56 die xxix mensis ii annoque mcmlx xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2436994 02 ii 2 02/29/1960 die xxix mensis ii annoque mcmlx 60 lx 1960} test clock-2.725 {conversion of 1960-03-01} { clock format -310389904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1960 12:34:56 die i mensis iii annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2436995 03 iii 3 03/01/1960 die i mensis iii annoque mcmlx 60 lx 1960} test clock-2.726 {conversion of 1960-03-31} { clock format -307797904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1960 12:34:56 die xxxi mensis iii annoque mcmlx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2437025 03 iii 3 03/31/1960 die xxxi mensis iii annoque mcmlx 60 lx 1960} test clock-2.727 {conversion of 1960-04-01} { clock format -307711504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1960 12:34:56 die i mensis iv annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2437026 04 iv 4 04/01/1960 die i mensis iv annoque mcmlx 60 lx 1960} test clock-2.728 {conversion of 1960-04-30} { clock format -305205904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1960 12:34:56 die xxx mensis iv annoque mcmlx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2437055 04 iv 4 04/30/1960 die xxx mensis iv annoque mcmlx 60 lx 1960} test clock-2.729 {conversion of 1960-05-01} { clock format -305119504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1960 12:34:56 die i mensis v annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2437056 05 v 5 05/01/1960 die i mensis v annoque mcmlx 60 lx 1960} test clock-2.730 {conversion of 1960-05-31} { clock format -302527504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1960 12:34:56 die xxxi mensis v annoque mcmlx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2437086 05 v 5 05/31/1960 die xxxi mensis v annoque mcmlx 60 lx 1960} test clock-2.731 {conversion of 1960-06-01} { clock format -302441104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1960 12:34:56 die i mensis vi annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2437087 06 vi 6 06/01/1960 die i mensis vi annoque mcmlx 60 lx 1960} test clock-2.732 {conversion of 1960-06-30} { clock format -299935504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1960 12:34:56 die xxx mensis vi annoque mcmlx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2437116 06 vi 6 06/30/1960 die xxx mensis vi annoque mcmlx 60 lx 1960} test clock-2.733 {conversion of 1960-07-01} { clock format -299849104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1960 12:34:56 die i mensis vii annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2437117 07 vii 7 07/01/1960 die i mensis vii annoque mcmlx 60 lx 1960} test clock-2.734 {conversion of 1960-07-31} { clock format -297257104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1960 12:34:56 die xxxi mensis vii annoque mcmlx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2437147 07 vii 7 07/31/1960 die xxxi mensis vii annoque mcmlx 60 lx 1960} test clock-2.735 {conversion of 1960-08-01} { clock format -297170704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1960 12:34:56 die i mensis viii annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2437148 08 viii 8 08/01/1960 die i mensis viii annoque mcmlx 60 lx 1960} test clock-2.736 {conversion of 1960-08-31} { clock format -294578704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1960 12:34:56 die xxxi mensis viii annoque mcmlx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2437178 08 viii 8 08/31/1960 die xxxi mensis viii annoque mcmlx 60 lx 1960} test clock-2.737 {conversion of 1960-09-01} { clock format -294492304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1960 12:34:56 die i mensis ix annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2437179 09 ix 9 09/01/1960 die i mensis ix annoque mcmlx 60 lx 1960} test clock-2.738 {conversion of 1960-09-30} { clock format -291986704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1960 12:34:56 die xxx mensis ix annoque mcmlx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2437208 09 ix 9 09/30/1960 die xxx mensis ix annoque mcmlx 60 lx 1960} test clock-2.739 {conversion of 1960-10-01} { clock format -291900304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1960 12:34:56 die i mensis x annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2437209 10 x 10 10/01/1960 die i mensis x annoque mcmlx 60 lx 1960} test clock-2.740 {conversion of 1960-10-31} { clock format -289308304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1960 12:34:56 die xxxi mensis x annoque mcmlx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2437239 10 x 10 10/31/1960 die xxxi mensis x annoque mcmlx 60 lx 1960} test clock-2.741 {conversion of 1960-11-01} { clock format -289221904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1960 12:34:56 die i mensis xi annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2437240 11 xi 11 11/01/1960 die i mensis xi annoque mcmlx 60 lx 1960} test clock-2.742 {conversion of 1960-11-30} { clock format -286716304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1960 12:34:56 die xxx mensis xi annoque mcmlx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2437269 11 xi 11 11/30/1960 die xxx mensis xi annoque mcmlx 60 lx 1960} test clock-2.743 {conversion of 1960-12-01} { clock format -286629904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1960 12:34:56 die i mensis xii annoque mcmlx xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2437270 12 xii 12 12/01/1960 die i mensis xii annoque mcmlx 60 lx 1960} test clock-2.744 {conversion of 1960-12-31} { clock format -284037904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1960 12:34:56 die xxxi mensis xii annoque mcmlx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2437300 12 xii 12 12/31/1960 die xxxi mensis xii annoque mcmlx 60 lx 1960} test clock-2.745 {conversion of 1961-01-01} { clock format -283951504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1961 12:34:56 die i mensis i annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2437301 01 i 1 01/01/1961 die i mensis i annoque mcmlxi 61 lxi 1961} test clock-2.746 {conversion of 1961-01-31} { clock format -281359504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1961 12:34:56 die xxxi mensis i annoque mcmlxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2437331 01 i 1 01/31/1961 die xxxi mensis i annoque mcmlxi 61 lxi 1961} test clock-2.747 {conversion of 1961-02-01} { clock format -281273104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1961 12:34:56 die i mensis ii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2437332 02 ii 2 02/01/1961 die i mensis ii annoque mcmlxi 61 lxi 1961} test clock-2.748 {conversion of 1961-02-28} { clock format -278940304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1961 12:34:56 die xxviii mensis ii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2437359 02 ii 2 02/28/1961 die xxviii mensis ii annoque mcmlxi 61 lxi 1961} test clock-2.749 {conversion of 1961-03-01} { clock format -278853904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1961 12:34:56 die i mensis iii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2437360 03 iii 3 03/01/1961 die i mensis iii annoque mcmlxi 61 lxi 1961} test clock-2.750 {conversion of 1961-03-31} { clock format -276261904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1961 12:34:56 die xxxi mensis iii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2437390 03 iii 3 03/31/1961 die xxxi mensis iii annoque mcmlxi 61 lxi 1961} test clock-2.751 {conversion of 1961-04-01} { clock format -276175504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1961 12:34:56 die i mensis iv annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2437391 04 iv 4 04/01/1961 die i mensis iv annoque mcmlxi 61 lxi 1961} test clock-2.752 {conversion of 1961-04-30} { clock format -273669904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1961 12:34:56 die xxx mensis iv annoque mcmlxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2437420 04 iv 4 04/30/1961 die xxx mensis iv annoque mcmlxi 61 lxi 1961} test clock-2.753 {conversion of 1961-05-01} { clock format -273583504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1961 12:34:56 die i mensis v annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2437421 05 v 5 05/01/1961 die i mensis v annoque mcmlxi 61 lxi 1961} test clock-2.754 {conversion of 1961-05-31} { clock format -270991504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1961 12:34:56 die xxxi mensis v annoque mcmlxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2437451 05 v 5 05/31/1961 die xxxi mensis v annoque mcmlxi 61 lxi 1961} test clock-2.755 {conversion of 1961-06-01} { clock format -270905104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1961 12:34:56 die i mensis vi annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2437452 06 vi 6 06/01/1961 die i mensis vi annoque mcmlxi 61 lxi 1961} test clock-2.756 {conversion of 1961-06-30} { clock format -268399504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1961 12:34:56 die xxx mensis vi annoque mcmlxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2437481 06 vi 6 06/30/1961 die xxx mensis vi annoque mcmlxi 61 lxi 1961} test clock-2.757 {conversion of 1961-07-01} { clock format -268313104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1961 12:34:56 die i mensis vii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2437482 07 vii 7 07/01/1961 die i mensis vii annoque mcmlxi 61 lxi 1961} test clock-2.758 {conversion of 1961-07-31} { clock format -265721104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1961 12:34:56 die xxxi mensis vii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2437512 07 vii 7 07/31/1961 die xxxi mensis vii annoque mcmlxi 61 lxi 1961} test clock-2.759 {conversion of 1961-08-01} { clock format -265634704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1961 12:34:56 die i mensis viii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2437513 08 viii 8 08/01/1961 die i mensis viii annoque mcmlxi 61 lxi 1961} test clock-2.760 {conversion of 1961-08-31} { clock format -263042704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1961 12:34:56 die xxxi mensis viii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2437543 08 viii 8 08/31/1961 die xxxi mensis viii annoque mcmlxi 61 lxi 1961} test clock-2.761 {conversion of 1961-09-01} { clock format -262956304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1961 12:34:56 die i mensis ix annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2437544 09 ix 9 09/01/1961 die i mensis ix annoque mcmlxi 61 lxi 1961} test clock-2.762 {conversion of 1961-09-30} { clock format -260450704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1961 12:34:56 die xxx mensis ix annoque mcmlxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2437573 09 ix 9 09/30/1961 die xxx mensis ix annoque mcmlxi 61 lxi 1961} test clock-2.763 {conversion of 1961-10-01} { clock format -260364304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1961 12:34:56 die i mensis x annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2437574 10 x 10 10/01/1961 die i mensis x annoque mcmlxi 61 lxi 1961} test clock-2.764 {conversion of 1961-10-31} { clock format -257772304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1961 12:34:56 die xxxi mensis x annoque mcmlxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2437604 10 x 10 10/31/1961 die xxxi mensis x annoque mcmlxi 61 lxi 1961} test clock-2.765 {conversion of 1961-11-01} { clock format -257685904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1961 12:34:56 die i mensis xi annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2437605 11 xi 11 11/01/1961 die i mensis xi annoque mcmlxi 61 lxi 1961} test clock-2.766 {conversion of 1961-11-30} { clock format -255180304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1961 12:34:56 die xxx mensis xi annoque mcmlxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2437634 11 xi 11 11/30/1961 die xxx mensis xi annoque mcmlxi 61 lxi 1961} test clock-2.767 {conversion of 1961-12-01} { clock format -255093904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1961 12:34:56 die i mensis xii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2437635 12 xii 12 12/01/1961 die i mensis xii annoque mcmlxi 61 lxi 1961} test clock-2.768 {conversion of 1961-12-31} { clock format -252501904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1961 12:34:56 die xxxi mensis xii annoque mcmlxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2437665 12 xii 12 12/31/1961 die xxxi mensis xii annoque mcmlxi 61 lxi 1961} test clock-2.769 {conversion of 1962-01-01} { clock format -252415504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1962 12:34:56 die i mensis i annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2437666 01 i 1 01/01/1962 die i mensis i annoque mcmlxii 62 lxii 1962} test clock-2.770 {conversion of 1962-01-31} { clock format -249823504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1962 12:34:56 die xxxi mensis i annoque mcmlxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2437696 01 i 1 01/31/1962 die xxxi mensis i annoque mcmlxii 62 lxii 1962} test clock-2.771 {conversion of 1962-02-01} { clock format -249737104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1962 12:34:56 die i mensis ii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2437697 02 ii 2 02/01/1962 die i mensis ii annoque mcmlxii 62 lxii 1962} test clock-2.772 {conversion of 1962-02-28} { clock format -247404304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1962 12:34:56 die xxviii mensis ii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2437724 02 ii 2 02/28/1962 die xxviii mensis ii annoque mcmlxii 62 lxii 1962} test clock-2.773 {conversion of 1962-03-01} { clock format -247317904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1962 12:34:56 die i mensis iii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2437725 03 iii 3 03/01/1962 die i mensis iii annoque mcmlxii 62 lxii 1962} test clock-2.774 {conversion of 1962-03-31} { clock format -244725904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1962 12:34:56 die xxxi mensis iii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2437755 03 iii 3 03/31/1962 die xxxi mensis iii annoque mcmlxii 62 lxii 1962} test clock-2.775 {conversion of 1962-04-01} { clock format -244639504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1962 12:34:56 die i mensis iv annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2437756 04 iv 4 04/01/1962 die i mensis iv annoque mcmlxii 62 lxii 1962} test clock-2.776 {conversion of 1962-04-30} { clock format -242133904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1962 12:34:56 die xxx mensis iv annoque mcmlxii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2437785 04 iv 4 04/30/1962 die xxx mensis iv annoque mcmlxii 62 lxii 1962} test clock-2.777 {conversion of 1962-05-01} { clock format -242047504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1962 12:34:56 die i mensis v annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2437786 05 v 5 05/01/1962 die i mensis v annoque mcmlxii 62 lxii 1962} test clock-2.778 {conversion of 1962-05-31} { clock format -239455504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1962 12:34:56 die xxxi mensis v annoque mcmlxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2437816 05 v 5 05/31/1962 die xxxi mensis v annoque mcmlxii 62 lxii 1962} test clock-2.779 {conversion of 1962-06-01} { clock format -239369104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1962 12:34:56 die i mensis vi annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2437817 06 vi 6 06/01/1962 die i mensis vi annoque mcmlxii 62 lxii 1962} test clock-2.780 {conversion of 1962-06-30} { clock format -236863504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1962 12:34:56 die xxx mensis vi annoque mcmlxii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2437846 06 vi 6 06/30/1962 die xxx mensis vi annoque mcmlxii 62 lxii 1962} test clock-2.781 {conversion of 1962-07-01} { clock format -236777104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1962 12:34:56 die i mensis vii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2437847 07 vii 7 07/01/1962 die i mensis vii annoque mcmlxii 62 lxii 1962} test clock-2.782 {conversion of 1962-07-31} { clock format -234185104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1962 12:34:56 die xxxi mensis vii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2437877 07 vii 7 07/31/1962 die xxxi mensis vii annoque mcmlxii 62 lxii 1962} test clock-2.783 {conversion of 1962-08-01} { clock format -234098704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1962 12:34:56 die i mensis viii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2437878 08 viii 8 08/01/1962 die i mensis viii annoque mcmlxii 62 lxii 1962} test clock-2.784 {conversion of 1962-08-31} { clock format -231506704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1962 12:34:56 die xxxi mensis viii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2437908 08 viii 8 08/31/1962 die xxxi mensis viii annoque mcmlxii 62 lxii 1962} test clock-2.785 {conversion of 1962-09-01} { clock format -231420304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1962 12:34:56 die i mensis ix annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2437909 09 ix 9 09/01/1962 die i mensis ix annoque mcmlxii 62 lxii 1962} test clock-2.786 {conversion of 1962-09-30} { clock format -228914704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1962 12:34:56 die xxx mensis ix annoque mcmlxii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2437938 09 ix 9 09/30/1962 die xxx mensis ix annoque mcmlxii 62 lxii 1962} test clock-2.787 {conversion of 1962-10-01} { clock format -228828304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1962 12:34:56 die i mensis x annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2437939 10 x 10 10/01/1962 die i mensis x annoque mcmlxii 62 lxii 1962} test clock-2.788 {conversion of 1962-10-31} { clock format -226236304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1962 12:34:56 die xxxi mensis x annoque mcmlxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2437969 10 x 10 10/31/1962 die xxxi mensis x annoque mcmlxii 62 lxii 1962} test clock-2.789 {conversion of 1962-11-01} { clock format -226149904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1962 12:34:56 die i mensis xi annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2437970 11 xi 11 11/01/1962 die i mensis xi annoque mcmlxii 62 lxii 1962} test clock-2.790 {conversion of 1962-11-30} { clock format -223644304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1962 12:34:56 die xxx mensis xi annoque mcmlxii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2437999 11 xi 11 11/30/1962 die xxx mensis xi annoque mcmlxii 62 lxii 1962} test clock-2.791 {conversion of 1962-12-01} { clock format -223557904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1962 12:34:56 die i mensis xii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2438000 12 xii 12 12/01/1962 die i mensis xii annoque mcmlxii 62 lxii 1962} test clock-2.792 {conversion of 1962-12-31} { clock format -220965904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1962 12:34:56 die xxxi mensis xii annoque mcmlxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2438030 12 xii 12 12/31/1962 die xxxi mensis xii annoque mcmlxii 62 lxii 1962} test clock-2.793 {conversion of 1963-01-01} { clock format -220879504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1963 12:34:56 die i mensis i annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2438031 01 i 1 01/01/1963 die i mensis i annoque mcmlxiii 63 lxiii 1963} test clock-2.794 {conversion of 1963-01-31} { clock format -218287504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1963 12:34:56 die xxxi mensis i annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2438061 01 i 1 01/31/1963 die xxxi mensis i annoque mcmlxiii 63 lxiii 1963} test clock-2.795 {conversion of 1963-02-01} { clock format -218201104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1963 12:34:56 die i mensis ii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2438062 02 ii 2 02/01/1963 die i mensis ii annoque mcmlxiii 63 lxiii 1963} test clock-2.796 {conversion of 1963-02-28} { clock format -215868304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1963 12:34:56 die xxviii mensis ii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2438089 02 ii 2 02/28/1963 die xxviii mensis ii annoque mcmlxiii 63 lxiii 1963} test clock-2.797 {conversion of 1963-03-01} { clock format -215781904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1963 12:34:56 die i mensis iii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2438090 03 iii 3 03/01/1963 die i mensis iii annoque mcmlxiii 63 lxiii 1963} test clock-2.798 {conversion of 1963-03-31} { clock format -213189904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1963 12:34:56 die xxxi mensis iii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2438120 03 iii 3 03/31/1963 die xxxi mensis iii annoque mcmlxiii 63 lxiii 1963} test clock-2.799 {conversion of 1963-04-01} { clock format -213103504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1963 12:34:56 die i mensis iv annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2438121 04 iv 4 04/01/1963 die i mensis iv annoque mcmlxiii 63 lxiii 1963} test clock-2.800 {conversion of 1963-04-30} { clock format -210597904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1963 12:34:56 die xxx mensis iv annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2438150 04 iv 4 04/30/1963 die xxx mensis iv annoque mcmlxiii 63 lxiii 1963} test clock-2.801 {conversion of 1963-05-01} { clock format -210511504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1963 12:34:56 die i mensis v annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2438151 05 v 5 05/01/1963 die i mensis v annoque mcmlxiii 63 lxiii 1963} test clock-2.802 {conversion of 1963-05-31} { clock format -207919504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1963 12:34:56 die xxxi mensis v annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2438181 05 v 5 05/31/1963 die xxxi mensis v annoque mcmlxiii 63 lxiii 1963} test clock-2.803 {conversion of 1963-06-01} { clock format -207833104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1963 12:34:56 die i mensis vi annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2438182 06 vi 6 06/01/1963 die i mensis vi annoque mcmlxiii 63 lxiii 1963} test clock-2.804 {conversion of 1963-06-30} { clock format -205327504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1963 12:34:56 die xxx mensis vi annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2438211 06 vi 6 06/30/1963 die xxx mensis vi annoque mcmlxiii 63 lxiii 1963} test clock-2.805 {conversion of 1963-07-01} { clock format -205241104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1963 12:34:56 die i mensis vii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2438212 07 vii 7 07/01/1963 die i mensis vii annoque mcmlxiii 63 lxiii 1963} test clock-2.806 {conversion of 1963-07-31} { clock format -202649104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1963 12:34:56 die xxxi mensis vii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2438242 07 vii 7 07/31/1963 die xxxi mensis vii annoque mcmlxiii 63 lxiii 1963} test clock-2.807 {conversion of 1963-08-01} { clock format -202562704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1963 12:34:56 die i mensis viii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2438243 08 viii 8 08/01/1963 die i mensis viii annoque mcmlxiii 63 lxiii 1963} test clock-2.808 {conversion of 1963-08-31} { clock format -199970704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1963 12:34:56 die xxxi mensis viii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2438273 08 viii 8 08/31/1963 die xxxi mensis viii annoque mcmlxiii 63 lxiii 1963} test clock-2.809 {conversion of 1963-09-01} { clock format -199884304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1963 12:34:56 die i mensis ix annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2438274 09 ix 9 09/01/1963 die i mensis ix annoque mcmlxiii 63 lxiii 1963} test clock-2.810 {conversion of 1963-09-30} { clock format -197378704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1963 12:34:56 die xxx mensis ix annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2438303 09 ix 9 09/30/1963 die xxx mensis ix annoque mcmlxiii 63 lxiii 1963} test clock-2.811 {conversion of 1963-10-01} { clock format -197292304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1963 12:34:56 die i mensis x annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2438304 10 x 10 10/01/1963 die i mensis x annoque mcmlxiii 63 lxiii 1963} test clock-2.812 {conversion of 1963-10-31} { clock format -194700304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1963 12:34:56 die xxxi mensis x annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2438334 10 x 10 10/31/1963 die xxxi mensis x annoque mcmlxiii 63 lxiii 1963} test clock-2.813 {conversion of 1963-11-01} { clock format -194613904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1963 12:34:56 die i mensis xi annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2438335 11 xi 11 11/01/1963 die i mensis xi annoque mcmlxiii 63 lxiii 1963} test clock-2.814 {conversion of 1963-11-30} { clock format -192108304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1963 12:34:56 die xxx mensis xi annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2438364 11 xi 11 11/30/1963 die xxx mensis xi annoque mcmlxiii 63 lxiii 1963} test clock-2.815 {conversion of 1963-12-01} { clock format -192021904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1963 12:34:56 die i mensis xii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2438365 12 xii 12 12/01/1963 die i mensis xii annoque mcmlxiii 63 lxiii 1963} test clock-2.816 {conversion of 1963-12-31} { clock format -189429904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1963 12:34:56 die xxxi mensis xii annoque mcmlxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2438395 12 xii 12 12/31/1963 die xxxi mensis xii annoque mcmlxiii 63 lxiii 1963} test clock-2.817 {conversion of 1964-01-01} { clock format -189343504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1964 12:34:56 die i mensis i annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2438396 01 i 1 01/01/1964 die i mensis i annoque mcmlxiv 64 lxiv 1964} test clock-2.818 {conversion of 1964-01-31} { clock format -186751504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1964 12:34:56 die xxxi mensis i annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2438426 01 i 1 01/31/1964 die xxxi mensis i annoque mcmlxiv 64 lxiv 1964} test clock-2.819 {conversion of 1964-02-01} { clock format -186665104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1964 12:34:56 die i mensis ii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2438427 02 ii 2 02/01/1964 die i mensis ii annoque mcmlxiv 64 lxiv 1964} test clock-2.820 {conversion of 1964-02-29} { clock format -184245904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1964 12:34:56 die xxix mensis ii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2438455 02 ii 2 02/29/1964 die xxix mensis ii annoque mcmlxiv 64 lxiv 1964} test clock-2.821 {conversion of 1964-03-01} { clock format -184159504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1964 12:34:56 die i mensis iii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2438456 03 iii 3 03/01/1964 die i mensis iii annoque mcmlxiv 64 lxiv 1964} test clock-2.822 {conversion of 1964-03-31} { clock format -181567504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1964 12:34:56 die xxxi mensis iii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2438486 03 iii 3 03/31/1964 die xxxi mensis iii annoque mcmlxiv 64 lxiv 1964} test clock-2.823 {conversion of 1964-04-01} { clock format -181481104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1964 12:34:56 die i mensis iv annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2438487 04 iv 4 04/01/1964 die i mensis iv annoque mcmlxiv 64 lxiv 1964} test clock-2.824 {conversion of 1964-04-30} { clock format -178975504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1964 12:34:56 die xxx mensis iv annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2438516 04 iv 4 04/30/1964 die xxx mensis iv annoque mcmlxiv 64 lxiv 1964} test clock-2.825 {conversion of 1964-05-01} { clock format -178889104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1964 12:34:56 die i mensis v annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2438517 05 v 5 05/01/1964 die i mensis v annoque mcmlxiv 64 lxiv 1964} test clock-2.826 {conversion of 1964-05-31} { clock format -176297104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1964 12:34:56 die xxxi mensis v annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2438547 05 v 5 05/31/1964 die xxxi mensis v annoque mcmlxiv 64 lxiv 1964} test clock-2.827 {conversion of 1964-06-01} { clock format -176210704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1964 12:34:56 die i mensis vi annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2438548 06 vi 6 06/01/1964 die i mensis vi annoque mcmlxiv 64 lxiv 1964} test clock-2.828 {conversion of 1964-06-30} { clock format -173705104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1964 12:34:56 die xxx mensis vi annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2438577 06 vi 6 06/30/1964 die xxx mensis vi annoque mcmlxiv 64 lxiv 1964} test clock-2.829 {conversion of 1964-07-01} { clock format -173618704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1964 12:34:56 die i mensis vii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2438578 07 vii 7 07/01/1964 die i mensis vii annoque mcmlxiv 64 lxiv 1964} test clock-2.830 {conversion of 1964-07-31} { clock format -171026704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1964 12:34:56 die xxxi mensis vii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2438608 07 vii 7 07/31/1964 die xxxi mensis vii annoque mcmlxiv 64 lxiv 1964} test clock-2.831 {conversion of 1964-08-01} { clock format -170940304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1964 12:34:56 die i mensis viii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2438609 08 viii 8 08/01/1964 die i mensis viii annoque mcmlxiv 64 lxiv 1964} test clock-2.832 {conversion of 1964-08-31} { clock format -168348304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1964 12:34:56 die xxxi mensis viii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2438639 08 viii 8 08/31/1964 die xxxi mensis viii annoque mcmlxiv 64 lxiv 1964} test clock-2.833 {conversion of 1964-09-01} { clock format -168261904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1964 12:34:56 die i mensis ix annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2438640 09 ix 9 09/01/1964 die i mensis ix annoque mcmlxiv 64 lxiv 1964} test clock-2.834 {conversion of 1964-09-30} { clock format -165756304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1964 12:34:56 die xxx mensis ix annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2438669 09 ix 9 09/30/1964 die xxx mensis ix annoque mcmlxiv 64 lxiv 1964} test clock-2.835 {conversion of 1964-10-01} { clock format -165669904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1964 12:34:56 die i mensis x annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2438670 10 x 10 10/01/1964 die i mensis x annoque mcmlxiv 64 lxiv 1964} test clock-2.836 {conversion of 1964-10-31} { clock format -163077904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1964 12:34:56 die xxxi mensis x annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2438700 10 x 10 10/31/1964 die xxxi mensis x annoque mcmlxiv 64 lxiv 1964} test clock-2.837 {conversion of 1964-11-01} { clock format -162991504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1964 12:34:56 die i mensis xi annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2438701 11 xi 11 11/01/1964 die i mensis xi annoque mcmlxiv 64 lxiv 1964} test clock-2.838 {conversion of 1964-11-30} { clock format -160485904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1964 12:34:56 die xxx mensis xi annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2438730 11 xi 11 11/30/1964 die xxx mensis xi annoque mcmlxiv 64 lxiv 1964} test clock-2.839 {conversion of 1964-12-01} { clock format -160399504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1964 12:34:56 die i mensis xii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2438731 12 xii 12 12/01/1964 die i mensis xii annoque mcmlxiv 64 lxiv 1964} test clock-2.840 {conversion of 1964-12-31} { clock format -157807504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1964 12:34:56 die xxxi mensis xii annoque mcmlxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2438761 12 xii 12 12/31/1964 die xxxi mensis xii annoque mcmlxiv 64 lxiv 1964} test clock-2.841 {conversion of 1965-01-01} { clock format -157721104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1965 12:34:56 die i mensis i annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2438762 01 i 1 01/01/1965 die i mensis i annoque mcmlxv 65 lxv 1965} test clock-2.842 {conversion of 1965-01-31} { clock format -155129104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1965 12:34:56 die xxxi mensis i annoque mcmlxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2438792 01 i 1 01/31/1965 die xxxi mensis i annoque mcmlxv 65 lxv 1965} test clock-2.843 {conversion of 1965-02-01} { clock format -155042704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1965 12:34:56 die i mensis ii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2438793 02 ii 2 02/01/1965 die i mensis ii annoque mcmlxv 65 lxv 1965} test clock-2.844 {conversion of 1965-02-28} { clock format -152709904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1965 12:34:56 die xxviii mensis ii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2438820 02 ii 2 02/28/1965 die xxviii mensis ii annoque mcmlxv 65 lxv 1965} test clock-2.845 {conversion of 1965-03-01} { clock format -152623504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1965 12:34:56 die i mensis iii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2438821 03 iii 3 03/01/1965 die i mensis iii annoque mcmlxv 65 lxv 1965} test clock-2.846 {conversion of 1965-03-31} { clock format -150031504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1965 12:34:56 die xxxi mensis iii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2438851 03 iii 3 03/31/1965 die xxxi mensis iii annoque mcmlxv 65 lxv 1965} test clock-2.847 {conversion of 1965-04-01} { clock format -149945104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1965 12:34:56 die i mensis iv annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2438852 04 iv 4 04/01/1965 die i mensis iv annoque mcmlxv 65 lxv 1965} test clock-2.848 {conversion of 1965-04-30} { clock format -147439504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1965 12:34:56 die xxx mensis iv annoque mcmlxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2438881 04 iv 4 04/30/1965 die xxx mensis iv annoque mcmlxv 65 lxv 1965} test clock-2.849 {conversion of 1965-05-01} { clock format -147353104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1965 12:34:56 die i mensis v annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2438882 05 v 5 05/01/1965 die i mensis v annoque mcmlxv 65 lxv 1965} test clock-2.850 {conversion of 1965-05-31} { clock format -144761104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1965 12:34:56 die xxxi mensis v annoque mcmlxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2438912 05 v 5 05/31/1965 die xxxi mensis v annoque mcmlxv 65 lxv 1965} test clock-2.851 {conversion of 1965-06-01} { clock format -144674704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1965 12:34:56 die i mensis vi annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2438913 06 vi 6 06/01/1965 die i mensis vi annoque mcmlxv 65 lxv 1965} test clock-2.852 {conversion of 1965-06-30} { clock format -142169104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1965 12:34:56 die xxx mensis vi annoque mcmlxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2438942 06 vi 6 06/30/1965 die xxx mensis vi annoque mcmlxv 65 lxv 1965} test clock-2.853 {conversion of 1965-07-01} { clock format -142082704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1965 12:34:56 die i mensis vii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2438943 07 vii 7 07/01/1965 die i mensis vii annoque mcmlxv 65 lxv 1965} test clock-2.854 {conversion of 1965-07-31} { clock format -139490704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1965 12:34:56 die xxxi mensis vii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2438973 07 vii 7 07/31/1965 die xxxi mensis vii annoque mcmlxv 65 lxv 1965} test clock-2.855 {conversion of 1965-08-01} { clock format -139404304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1965 12:34:56 die i mensis viii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2438974 08 viii 8 08/01/1965 die i mensis viii annoque mcmlxv 65 lxv 1965} test clock-2.856 {conversion of 1965-08-31} { clock format -136812304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1965 12:34:56 die xxxi mensis viii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2439004 08 viii 8 08/31/1965 die xxxi mensis viii annoque mcmlxv 65 lxv 1965} test clock-2.857 {conversion of 1965-09-01} { clock format -136725904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1965 12:34:56 die i mensis ix annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2439005 09 ix 9 09/01/1965 die i mensis ix annoque mcmlxv 65 lxv 1965} test clock-2.858 {conversion of 1965-09-30} { clock format -134220304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1965 12:34:56 die xxx mensis ix annoque mcmlxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2439034 09 ix 9 09/30/1965 die xxx mensis ix annoque mcmlxv 65 lxv 1965} test clock-2.859 {conversion of 1965-10-01} { clock format -134133904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1965 12:34:56 die i mensis x annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2439035 10 x 10 10/01/1965 die i mensis x annoque mcmlxv 65 lxv 1965} test clock-2.860 {conversion of 1965-10-31} { clock format -131541904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1965 12:34:56 die xxxi mensis x annoque mcmlxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2439065 10 x 10 10/31/1965 die xxxi mensis x annoque mcmlxv 65 lxv 1965} test clock-2.861 {conversion of 1965-11-01} { clock format -131455504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1965 12:34:56 die i mensis xi annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2439066 11 xi 11 11/01/1965 die i mensis xi annoque mcmlxv 65 lxv 1965} test clock-2.862 {conversion of 1965-11-30} { clock format -128949904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1965 12:34:56 die xxx mensis xi annoque mcmlxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2439095 11 xi 11 11/30/1965 die xxx mensis xi annoque mcmlxv 65 lxv 1965} test clock-2.863 {conversion of 1965-12-01} { clock format -128863504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1965 12:34:56 die i mensis xii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2439096 12 xii 12 12/01/1965 die i mensis xii annoque mcmlxv 65 lxv 1965} test clock-2.864 {conversion of 1965-12-31} { clock format -126271504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1965 12:34:56 die xxxi mensis xii annoque mcmlxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2439126 12 xii 12 12/31/1965 die xxxi mensis xii annoque mcmlxv 65 lxv 1965} test clock-2.865 {conversion of 1966-01-01} { clock format -126185104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1966 12:34:56 die i mensis i annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2439127 01 i 1 01/01/1966 die i mensis i annoque mcmlxvi 66 lxvi 1966} test clock-2.866 {conversion of 1966-01-31} { clock format -123593104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1966 12:34:56 die xxxi mensis i annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2439157 01 i 1 01/31/1966 die xxxi mensis i annoque mcmlxvi 66 lxvi 1966} test clock-2.867 {conversion of 1966-02-01} { clock format -123506704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1966 12:34:56 die i mensis ii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2439158 02 ii 2 02/01/1966 die i mensis ii annoque mcmlxvi 66 lxvi 1966} test clock-2.868 {conversion of 1966-02-28} { clock format -121173904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1966 12:34:56 die xxviii mensis ii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2439185 02 ii 2 02/28/1966 die xxviii mensis ii annoque mcmlxvi 66 lxvi 1966} test clock-2.869 {conversion of 1966-03-01} { clock format -121087504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1966 12:34:56 die i mensis iii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2439186 03 iii 3 03/01/1966 die i mensis iii annoque mcmlxvi 66 lxvi 1966} test clock-2.870 {conversion of 1966-03-31} { clock format -118495504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1966 12:34:56 die xxxi mensis iii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2439216 03 iii 3 03/31/1966 die xxxi mensis iii annoque mcmlxvi 66 lxvi 1966} test clock-2.871 {conversion of 1966-04-01} { clock format -118409104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1966 12:34:56 die i mensis iv annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2439217 04 iv 4 04/01/1966 die i mensis iv annoque mcmlxvi 66 lxvi 1966} test clock-2.872 {conversion of 1966-04-30} { clock format -115903504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1966 12:34:56 die xxx mensis iv annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2439246 04 iv 4 04/30/1966 die xxx mensis iv annoque mcmlxvi 66 lxvi 1966} test clock-2.873 {conversion of 1966-05-01} { clock format -115817104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1966 12:34:56 die i mensis v annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2439247 05 v 5 05/01/1966 die i mensis v annoque mcmlxvi 66 lxvi 1966} test clock-2.874 {conversion of 1966-05-31} { clock format -113225104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1966 12:34:56 die xxxi mensis v annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2439277 05 v 5 05/31/1966 die xxxi mensis v annoque mcmlxvi 66 lxvi 1966} test clock-2.875 {conversion of 1966-06-01} { clock format -113138704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1966 12:34:56 die i mensis vi annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2439278 06 vi 6 06/01/1966 die i mensis vi annoque mcmlxvi 66 lxvi 1966} test clock-2.876 {conversion of 1966-06-30} { clock format -110633104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1966 12:34:56 die xxx mensis vi annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2439307 06 vi 6 06/30/1966 die xxx mensis vi annoque mcmlxvi 66 lxvi 1966} test clock-2.877 {conversion of 1966-07-01} { clock format -110546704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1966 12:34:56 die i mensis vii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2439308 07 vii 7 07/01/1966 die i mensis vii annoque mcmlxvi 66 lxvi 1966} test clock-2.878 {conversion of 1966-07-31} { clock format -107954704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1966 12:34:56 die xxxi mensis vii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2439338 07 vii 7 07/31/1966 die xxxi mensis vii annoque mcmlxvi 66 lxvi 1966} test clock-2.879 {conversion of 1966-08-01} { clock format -107868304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1966 12:34:56 die i mensis viii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2439339 08 viii 8 08/01/1966 die i mensis viii annoque mcmlxvi 66 lxvi 1966} test clock-2.880 {conversion of 1966-08-31} { clock format -105276304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1966 12:34:56 die xxxi mensis viii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2439369 08 viii 8 08/31/1966 die xxxi mensis viii annoque mcmlxvi 66 lxvi 1966} test clock-2.881 {conversion of 1966-09-01} { clock format -105189904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1966 12:34:56 die i mensis ix annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2439370 09 ix 9 09/01/1966 die i mensis ix annoque mcmlxvi 66 lxvi 1966} test clock-2.882 {conversion of 1966-09-30} { clock format -102684304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1966 12:34:56 die xxx mensis ix annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2439399 09 ix 9 09/30/1966 die xxx mensis ix annoque mcmlxvi 66 lxvi 1966} test clock-2.883 {conversion of 1966-10-01} { clock format -102597904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1966 12:34:56 die i mensis x annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2439400 10 x 10 10/01/1966 die i mensis x annoque mcmlxvi 66 lxvi 1966} test clock-2.884 {conversion of 1966-10-31} { clock format -100005904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1966 12:34:56 die xxxi mensis x annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2439430 10 x 10 10/31/1966 die xxxi mensis x annoque mcmlxvi 66 lxvi 1966} test clock-2.885 {conversion of 1966-11-01} { clock format -99919504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1966 12:34:56 die i mensis xi annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2439431 11 xi 11 11/01/1966 die i mensis xi annoque mcmlxvi 66 lxvi 1966} test clock-2.886 {conversion of 1966-11-30} { clock format -97413904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1966 12:34:56 die xxx mensis xi annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2439460 11 xi 11 11/30/1966 die xxx mensis xi annoque mcmlxvi 66 lxvi 1966} test clock-2.887 {conversion of 1966-12-01} { clock format -97327504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1966 12:34:56 die i mensis xii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2439461 12 xii 12 12/01/1966 die i mensis xii annoque mcmlxvi 66 lxvi 1966} test clock-2.888 {conversion of 1966-12-31} { clock format -94735504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1966 12:34:56 die xxxi mensis xii annoque mcmlxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2439491 12 xii 12 12/31/1966 die xxxi mensis xii annoque mcmlxvi 66 lxvi 1966} test clock-2.889 {conversion of 1967-01-01} { clock format -94649104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1967 12:34:56 die i mensis i annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2439492 01 i 1 01/01/1967 die i mensis i annoque mcmlxvii 67 lxvii 1967} test clock-2.890 {conversion of 1967-01-31} { clock format -92057104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1967 12:34:56 die xxxi mensis i annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2439522 01 i 1 01/31/1967 die xxxi mensis i annoque mcmlxvii 67 lxvii 1967} test clock-2.891 {conversion of 1967-02-01} { clock format -91970704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1967 12:34:56 die i mensis ii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2439523 02 ii 2 02/01/1967 die i mensis ii annoque mcmlxvii 67 lxvii 1967} test clock-2.892 {conversion of 1967-02-28} { clock format -89637904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1967 12:34:56 die xxviii mensis ii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2439550 02 ii 2 02/28/1967 die xxviii mensis ii annoque mcmlxvii 67 lxvii 1967} test clock-2.893 {conversion of 1967-03-01} { clock format -89551504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1967 12:34:56 die i mensis iii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2439551 03 iii 3 03/01/1967 die i mensis iii annoque mcmlxvii 67 lxvii 1967} test clock-2.894 {conversion of 1967-03-31} { clock format -86959504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1967 12:34:56 die xxxi mensis iii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2439581 03 iii 3 03/31/1967 die xxxi mensis iii annoque mcmlxvii 67 lxvii 1967} test clock-2.895 {conversion of 1967-04-01} { clock format -86873104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1967 12:34:56 die i mensis iv annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2439582 04 iv 4 04/01/1967 die i mensis iv annoque mcmlxvii 67 lxvii 1967} test clock-2.896 {conversion of 1967-04-30} { clock format -84367504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1967 12:34:56 die xxx mensis iv annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2439611 04 iv 4 04/30/1967 die xxx mensis iv annoque mcmlxvii 67 lxvii 1967} test clock-2.897 {conversion of 1967-05-01} { clock format -84281104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1967 12:34:56 die i mensis v annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2439612 05 v 5 05/01/1967 die i mensis v annoque mcmlxvii 67 lxvii 1967} test clock-2.898 {conversion of 1967-05-31} { clock format -81689104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1967 12:34:56 die xxxi mensis v annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2439642 05 v 5 05/31/1967 die xxxi mensis v annoque mcmlxvii 67 lxvii 1967} test clock-2.899 {conversion of 1967-06-01} { clock format -81602704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1967 12:34:56 die i mensis vi annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2439643 06 vi 6 06/01/1967 die i mensis vi annoque mcmlxvii 67 lxvii 1967} test clock-2.900 {conversion of 1967-06-30} { clock format -79097104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1967 12:34:56 die xxx mensis vi annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2439672 06 vi 6 06/30/1967 die xxx mensis vi annoque mcmlxvii 67 lxvii 1967} test clock-2.901 {conversion of 1967-07-01} { clock format -79010704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1967 12:34:56 die i mensis vii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2439673 07 vii 7 07/01/1967 die i mensis vii annoque mcmlxvii 67 lxvii 1967} test clock-2.902 {conversion of 1967-07-31} { clock format -76418704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1967 12:34:56 die xxxi mensis vii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2439703 07 vii 7 07/31/1967 die xxxi mensis vii annoque mcmlxvii 67 lxvii 1967} test clock-2.903 {conversion of 1967-08-01} { clock format -76332304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1967 12:34:56 die i mensis viii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2439704 08 viii 8 08/01/1967 die i mensis viii annoque mcmlxvii 67 lxvii 1967} test clock-2.904 {conversion of 1967-08-31} { clock format -73740304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1967 12:34:56 die xxxi mensis viii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2439734 08 viii 8 08/31/1967 die xxxi mensis viii annoque mcmlxvii 67 lxvii 1967} test clock-2.905 {conversion of 1967-09-01} { clock format -73653904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1967 12:34:56 die i mensis ix annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2439735 09 ix 9 09/01/1967 die i mensis ix annoque mcmlxvii 67 lxvii 1967} test clock-2.906 {conversion of 1967-09-30} { clock format -71148304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1967 12:34:56 die xxx mensis ix annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2439764 09 ix 9 09/30/1967 die xxx mensis ix annoque mcmlxvii 67 lxvii 1967} test clock-2.907 {conversion of 1967-10-01} { clock format -71061904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1967 12:34:56 die i mensis x annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2439765 10 x 10 10/01/1967 die i mensis x annoque mcmlxvii 67 lxvii 1967} test clock-2.908 {conversion of 1967-10-31} { clock format -68469904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1967 12:34:56 die xxxi mensis x annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2439795 10 x 10 10/31/1967 die xxxi mensis x annoque mcmlxvii 67 lxvii 1967} test clock-2.909 {conversion of 1967-11-01} { clock format -68383504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1967 12:34:56 die i mensis xi annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2439796 11 xi 11 11/01/1967 die i mensis xi annoque mcmlxvii 67 lxvii 1967} test clock-2.910 {conversion of 1967-11-30} { clock format -65877904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1967 12:34:56 die xxx mensis xi annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2439825 11 xi 11 11/30/1967 die xxx mensis xi annoque mcmlxvii 67 lxvii 1967} test clock-2.911 {conversion of 1967-12-01} { clock format -65791504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1967 12:34:56 die i mensis xii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2439826 12 xii 12 12/01/1967 die i mensis xii annoque mcmlxvii 67 lxvii 1967} test clock-2.912 {conversion of 1967-12-31} { clock format -63199504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1967 12:34:56 die xxxi mensis xii annoque mcmlxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2439856 12 xii 12 12/31/1967 die xxxi mensis xii annoque mcmlxvii 67 lxvii 1967} test clock-2.913 {conversion of 1968-01-01} { clock format -63113104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1968 12:34:56 die i mensis i annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2439857 01 i 1 01/01/1968 die i mensis i annoque mcmlxviii 68 lxviii 1968} test clock-2.914 {conversion of 1968-01-31} { clock format -60521104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1968 12:34:56 die xxxi mensis i annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2439887 01 i 1 01/31/1968 die xxxi mensis i annoque mcmlxviii 68 lxviii 1968} test clock-2.915 {conversion of 1968-02-01} { clock format -60434704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1968 12:34:56 die i mensis ii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2439888 02 ii 2 02/01/1968 die i mensis ii annoque mcmlxviii 68 lxviii 1968} test clock-2.916 {conversion of 1968-02-29} { clock format -58015504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1968 12:34:56 die xxix mensis ii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2439916 02 ii 2 02/29/1968 die xxix mensis ii annoque mcmlxviii 68 lxviii 1968} test clock-2.917 {conversion of 1968-03-01} { clock format -57929104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1968 12:34:56 die i mensis iii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2439917 03 iii 3 03/01/1968 die i mensis iii annoque mcmlxviii 68 lxviii 1968} test clock-2.918 {conversion of 1968-03-31} { clock format -55337104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1968 12:34:56 die xxxi mensis iii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2439947 03 iii 3 03/31/1968 die xxxi mensis iii annoque mcmlxviii 68 lxviii 1968} test clock-2.919 {conversion of 1968-04-01} { clock format -55250704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1968 12:34:56 die i mensis iv annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2439948 04 iv 4 04/01/1968 die i mensis iv annoque mcmlxviii 68 lxviii 1968} test clock-2.920 {conversion of 1968-04-30} { clock format -52745104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1968 12:34:56 die xxx mensis iv annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2439977 04 iv 4 04/30/1968 die xxx mensis iv annoque mcmlxviii 68 lxviii 1968} test clock-2.921 {conversion of 1968-05-01} { clock format -52658704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1968 12:34:56 die i mensis v annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2439978 05 v 5 05/01/1968 die i mensis v annoque mcmlxviii 68 lxviii 1968} test clock-2.922 {conversion of 1968-05-31} { clock format -50066704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1968 12:34:56 die xxxi mensis v annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2440008 05 v 5 05/31/1968 die xxxi mensis v annoque mcmlxviii 68 lxviii 1968} test clock-2.923 {conversion of 1968-06-01} { clock format -49980304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1968 12:34:56 die i mensis vi annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2440009 06 vi 6 06/01/1968 die i mensis vi annoque mcmlxviii 68 lxviii 1968} test clock-2.924 {conversion of 1968-06-30} { clock format -47474704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1968 12:34:56 die xxx mensis vi annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2440038 06 vi 6 06/30/1968 die xxx mensis vi annoque mcmlxviii 68 lxviii 1968} test clock-2.925 {conversion of 1968-07-01} { clock format -47388304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1968 12:34:56 die i mensis vii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2440039 07 vii 7 07/01/1968 die i mensis vii annoque mcmlxviii 68 lxviii 1968} test clock-2.926 {conversion of 1968-07-31} { clock format -44796304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1968 12:34:56 die xxxi mensis vii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2440069 07 vii 7 07/31/1968 die xxxi mensis vii annoque mcmlxviii 68 lxviii 1968} test clock-2.927 {conversion of 1968-08-01} { clock format -44709904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1968 12:34:56 die i mensis viii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2440070 08 viii 8 08/01/1968 die i mensis viii annoque mcmlxviii 68 lxviii 1968} test clock-2.928 {conversion of 1968-08-31} { clock format -42117904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1968 12:34:56 die xxxi mensis viii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2440100 08 viii 8 08/31/1968 die xxxi mensis viii annoque mcmlxviii 68 lxviii 1968} test clock-2.929 {conversion of 1968-09-01} { clock format -42031504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1968 12:34:56 die i mensis ix annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2440101 09 ix 9 09/01/1968 die i mensis ix annoque mcmlxviii 68 lxviii 1968} test clock-2.930 {conversion of 1968-09-30} { clock format -39525904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1968 12:34:56 die xxx mensis ix annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2440130 09 ix 9 09/30/1968 die xxx mensis ix annoque mcmlxviii 68 lxviii 1968} test clock-2.931 {conversion of 1968-10-01} { clock format -39439504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1968 12:34:56 die i mensis x annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2440131 10 x 10 10/01/1968 die i mensis x annoque mcmlxviii 68 lxviii 1968} test clock-2.932 {conversion of 1968-10-31} { clock format -36847504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1968 12:34:56 die xxxi mensis x annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2440161 10 x 10 10/31/1968 die xxxi mensis x annoque mcmlxviii 68 lxviii 1968} test clock-2.933 {conversion of 1968-11-01} { clock format -36761104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1968 12:34:56 die i mensis xi annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2440162 11 xi 11 11/01/1968 die i mensis xi annoque mcmlxviii 68 lxviii 1968} test clock-2.934 {conversion of 1968-11-30} { clock format -34255504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1968 12:34:56 die xxx mensis xi annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2440191 11 xi 11 11/30/1968 die xxx mensis xi annoque mcmlxviii 68 lxviii 1968} test clock-2.935 {conversion of 1968-12-01} { clock format -34169104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1968 12:34:56 die i mensis xii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2440192 12 xii 12 12/01/1968 die i mensis xii annoque mcmlxviii 68 lxviii 1968} test clock-2.936 {conversion of 1968-12-31} { clock format -31577104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1968 12:34:56 die xxxi mensis xii annoque mcmlxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2440222 12 xii 12 12/31/1968 die xxxi mensis xii annoque mcmlxviii 68 lxviii 1968} test clock-2.937 {conversion of 1969-01-01} { clock format -31490704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1969 12:34:56 die i mensis i annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2440223 01 i 1 01/01/1969 die i mensis i annoque mcmlxix 69 lxix 1969} test clock-2.938 {conversion of 1969-01-31} { clock format -28898704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1969 12:34:56 die xxxi mensis i annoque mcmlxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2440253 01 i 1 01/31/1969 die xxxi mensis i annoque mcmlxix 69 lxix 1969} test clock-2.939 {conversion of 1969-02-01} { clock format -28812304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1969 12:34:56 die i mensis ii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2440254 02 ii 2 02/01/1969 die i mensis ii annoque mcmlxix 69 lxix 1969} test clock-2.940 {conversion of 1969-02-28} { clock format -26479504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1969 12:34:56 die xxviii mensis ii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2440281 02 ii 2 02/28/1969 die xxviii mensis ii annoque mcmlxix 69 lxix 1969} test clock-2.941 {conversion of 1969-03-01} { clock format -26393104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1969 12:34:56 die i mensis iii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2440282 03 iii 3 03/01/1969 die i mensis iii annoque mcmlxix 69 lxix 1969} test clock-2.942 {conversion of 1969-03-31} { clock format -23801104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1969 12:34:56 die xxxi mensis iii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2440312 03 iii 3 03/31/1969 die xxxi mensis iii annoque mcmlxix 69 lxix 1969} test clock-2.943 {conversion of 1969-04-01} { clock format -23714704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1969 12:34:56 die i mensis iv annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2440313 04 iv 4 04/01/1969 die i mensis iv annoque mcmlxix 69 lxix 1969} test clock-2.944 {conversion of 1969-04-30} { clock format -21209104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1969 12:34:56 die xxx mensis iv annoque mcmlxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2440342 04 iv 4 04/30/1969 die xxx mensis iv annoque mcmlxix 69 lxix 1969} test clock-2.945 {conversion of 1969-05-01} { clock format -21122704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1969 12:34:56 die i mensis v annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2440343 05 v 5 05/01/1969 die i mensis v annoque mcmlxix 69 lxix 1969} test clock-2.946 {conversion of 1969-05-31} { clock format -18530704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1969 12:34:56 die xxxi mensis v annoque mcmlxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2440373 05 v 5 05/31/1969 die xxxi mensis v annoque mcmlxix 69 lxix 1969} test clock-2.947 {conversion of 1969-06-01} { clock format -18444304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1969 12:34:56 die i mensis vi annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2440374 06 vi 6 06/01/1969 die i mensis vi annoque mcmlxix 69 lxix 1969} test clock-2.948 {conversion of 1969-06-30} { clock format -15938704 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1969 12:34:56 die xxx mensis vi annoque mcmlxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2440403 06 vi 6 06/30/1969 die xxx mensis vi annoque mcmlxix 69 lxix 1969} test clock-2.949 {conversion of 1969-07-01} { clock format -15852304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1969 12:34:56 die i mensis vii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2440404 07 vii 7 07/01/1969 die i mensis vii annoque mcmlxix 69 lxix 1969} test clock-2.950 {conversion of 1969-07-31} { clock format -13260304 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1969 12:34:56 die xxxi mensis vii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2440434 07 vii 7 07/31/1969 die xxxi mensis vii annoque mcmlxix 69 lxix 1969} test clock-2.951 {conversion of 1969-08-01} { clock format -13173904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1969 12:34:56 die i mensis viii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2440435 08 viii 8 08/01/1969 die i mensis viii annoque mcmlxix 69 lxix 1969} test clock-2.952 {conversion of 1969-08-31} { clock format -10581904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1969 12:34:56 die xxxi mensis viii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2440465 08 viii 8 08/31/1969 die xxxi mensis viii annoque mcmlxix 69 lxix 1969} test clock-2.953 {conversion of 1969-09-01} { clock format -10495504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1969 12:34:56 die i mensis ix annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2440466 09 ix 9 09/01/1969 die i mensis ix annoque mcmlxix 69 lxix 1969} test clock-2.954 {conversion of 1969-09-30} { clock format -7989904 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1969 12:34:56 die xxx mensis ix annoque mcmlxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2440495 09 ix 9 09/30/1969 die xxx mensis ix annoque mcmlxix 69 lxix 1969} test clock-2.955 {conversion of 1969-10-01} { clock format -7903504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1969 12:34:56 die i mensis x annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2440496 10 x 10 10/01/1969 die i mensis x annoque mcmlxix 69 lxix 1969} test clock-2.956 {conversion of 1969-10-31} { clock format -5311504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1969 12:34:56 die xxxi mensis x annoque mcmlxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2440526 10 x 10 10/31/1969 die xxxi mensis x annoque mcmlxix 69 lxix 1969} test clock-2.957 {conversion of 1969-11-01} { clock format -5225104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1969 12:34:56 die i mensis xi annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2440527 11 xi 11 11/01/1969 die i mensis xi annoque mcmlxix 69 lxix 1969} test clock-2.958 {conversion of 1969-11-30} { clock format -2719504 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1969 12:34:56 die xxx mensis xi annoque mcmlxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2440556 11 xi 11 11/30/1969 die xxx mensis xi annoque mcmlxix 69 lxix 1969} test clock-2.959 {conversion of 1969-12-01} { clock format -2633104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1969 12:34:56 die i mensis xii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2440557 12 xii 12 12/01/1969 die i mensis xii annoque mcmlxix 69 lxix 1969} test clock-2.960 {conversion of 1969-12-31} { clock format -41104 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1969 12:34:56 die xxxi mensis xii annoque mcmlxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2440587 12 xii 12 12/31/1969 die xxxi mensis xii annoque mcmlxix 69 lxix 1969} test clock-2.961 {conversion of 1970-01-01} { clock format 45296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1970 12:34:56 die i mensis i annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2440588 01 i 1 01/01/1970 die i mensis i annoque mcmlxx 70 lxx 1970} test clock-2.962 {conversion of 1970-01-31} { clock format 2637296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1970 12:34:56 die xxxi mensis i annoque mcmlxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2440618 01 i 1 01/31/1970 die xxxi mensis i annoque mcmlxx 70 lxx 1970} test clock-2.963 {conversion of 1970-02-01} { clock format 2723696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1970 12:34:56 die i mensis ii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2440619 02 ii 2 02/01/1970 die i mensis ii annoque mcmlxx 70 lxx 1970} test clock-2.964 {conversion of 1970-02-28} { clock format 5056496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1970 12:34:56 die xxviii mensis ii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2440646 02 ii 2 02/28/1970 die xxviii mensis ii annoque mcmlxx 70 lxx 1970} test clock-2.965 {conversion of 1970-03-01} { clock format 5142896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1970 12:34:56 die i mensis iii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2440647 03 iii 3 03/01/1970 die i mensis iii annoque mcmlxx 70 lxx 1970} test clock-2.966 {conversion of 1970-03-31} { clock format 7734896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1970 12:34:56 die xxxi mensis iii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2440677 03 iii 3 03/31/1970 die xxxi mensis iii annoque mcmlxx 70 lxx 1970} test clock-2.967 {conversion of 1970-04-01} { clock format 7821296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1970 12:34:56 die i mensis iv annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2440678 04 iv 4 04/01/1970 die i mensis iv annoque mcmlxx 70 lxx 1970} test clock-2.968 {conversion of 1970-04-30} { clock format 10326896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1970 12:34:56 die xxx mensis iv annoque mcmlxx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2440707 04 iv 4 04/30/1970 die xxx mensis iv annoque mcmlxx 70 lxx 1970} test clock-2.969 {conversion of 1970-05-01} { clock format 10413296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1970 12:34:56 die i mensis v annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2440708 05 v 5 05/01/1970 die i mensis v annoque mcmlxx 70 lxx 1970} test clock-2.970 {conversion of 1970-05-31} { clock format 13005296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1970 12:34:56 die xxxi mensis v annoque mcmlxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2440738 05 v 5 05/31/1970 die xxxi mensis v annoque mcmlxx 70 lxx 1970} test clock-2.971 {conversion of 1970-06-01} { clock format 13091696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1970 12:34:56 die i mensis vi annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2440739 06 vi 6 06/01/1970 die i mensis vi annoque mcmlxx 70 lxx 1970} test clock-2.972 {conversion of 1970-06-30} { clock format 15597296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1970 12:34:56 die xxx mensis vi annoque mcmlxx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2440768 06 vi 6 06/30/1970 die xxx mensis vi annoque mcmlxx 70 lxx 1970} test clock-2.973 {conversion of 1970-07-01} { clock format 15683696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1970 12:34:56 die i mensis vii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2440769 07 vii 7 07/01/1970 die i mensis vii annoque mcmlxx 70 lxx 1970} test clock-2.974 {conversion of 1970-07-31} { clock format 18275696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1970 12:34:56 die xxxi mensis vii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2440799 07 vii 7 07/31/1970 die xxxi mensis vii annoque mcmlxx 70 lxx 1970} test clock-2.975 {conversion of 1970-08-01} { clock format 18362096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1970 12:34:56 die i mensis viii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2440800 08 viii 8 08/01/1970 die i mensis viii annoque mcmlxx 70 lxx 1970} test clock-2.976 {conversion of 1970-08-31} { clock format 20954096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1970 12:34:56 die xxxi mensis viii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2440830 08 viii 8 08/31/1970 die xxxi mensis viii annoque mcmlxx 70 lxx 1970} test clock-2.977 {conversion of 1970-09-01} { clock format 21040496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1970 12:34:56 die i mensis ix annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2440831 09 ix 9 09/01/1970 die i mensis ix annoque mcmlxx 70 lxx 1970} test clock-2.978 {conversion of 1970-09-30} { clock format 23546096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1970 12:34:56 die xxx mensis ix annoque mcmlxx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2440860 09 ix 9 09/30/1970 die xxx mensis ix annoque mcmlxx 70 lxx 1970} test clock-2.979 {conversion of 1970-10-01} { clock format 23632496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1970 12:34:56 die i mensis x annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2440861 10 x 10 10/01/1970 die i mensis x annoque mcmlxx 70 lxx 1970} test clock-2.980 {conversion of 1970-10-31} { clock format 26224496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1970 12:34:56 die xxxi mensis x annoque mcmlxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2440891 10 x 10 10/31/1970 die xxxi mensis x annoque mcmlxx 70 lxx 1970} test clock-2.981 {conversion of 1970-11-01} { clock format 26310896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1970 12:34:56 die i mensis xi annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2440892 11 xi 11 11/01/1970 die i mensis xi annoque mcmlxx 70 lxx 1970} test clock-2.982 {conversion of 1970-11-30} { clock format 28816496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1970 12:34:56 die xxx mensis xi annoque mcmlxx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2440921 11 xi 11 11/30/1970 die xxx mensis xi annoque mcmlxx 70 lxx 1970} test clock-2.983 {conversion of 1970-12-01} { clock format 28902896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1970 12:34:56 die i mensis xii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2440922 12 xii 12 12/01/1970 die i mensis xii annoque mcmlxx 70 lxx 1970} test clock-2.984 {conversion of 1970-12-31} { clock format 31494896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1970 12:34:56 die xxxi mensis xii annoque mcmlxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2440952 12 xii 12 12/31/1970 die xxxi mensis xii annoque mcmlxx 70 lxx 1970} test clock-2.985 {conversion of 1971-01-01} { clock format 31581296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1971 12:34:56 die i mensis i annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2440953 01 i 1 01/01/1971 die i mensis i annoque mcmlxxi 71 lxxi 1971} test clock-2.986 {conversion of 1971-01-31} { clock format 34173296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1971 12:34:56 die xxxi mensis i annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2440983 01 i 1 01/31/1971 die xxxi mensis i annoque mcmlxxi 71 lxxi 1971} test clock-2.987 {conversion of 1971-02-01} { clock format 34259696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1971 12:34:56 die i mensis ii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2440984 02 ii 2 02/01/1971 die i mensis ii annoque mcmlxxi 71 lxxi 1971} test clock-2.988 {conversion of 1971-02-28} { clock format 36592496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1971 12:34:56 die xxviii mensis ii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2441011 02 ii 2 02/28/1971 die xxviii mensis ii annoque mcmlxxi 71 lxxi 1971} test clock-2.989 {conversion of 1971-03-01} { clock format 36678896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1971 12:34:56 die i mensis iii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2441012 03 iii 3 03/01/1971 die i mensis iii annoque mcmlxxi 71 lxxi 1971} test clock-2.990 {conversion of 1971-03-31} { clock format 39270896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1971 12:34:56 die xxxi mensis iii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2441042 03 iii 3 03/31/1971 die xxxi mensis iii annoque mcmlxxi 71 lxxi 1971} test clock-2.991 {conversion of 1971-04-01} { clock format 39357296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1971 12:34:56 die i mensis iv annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2441043 04 iv 4 04/01/1971 die i mensis iv annoque mcmlxxi 71 lxxi 1971} test clock-2.992 {conversion of 1971-04-30} { clock format 41862896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1971 12:34:56 die xxx mensis iv annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2441072 04 iv 4 04/30/1971 die xxx mensis iv annoque mcmlxxi 71 lxxi 1971} test clock-2.993 {conversion of 1971-05-01} { clock format 41949296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1971 12:34:56 die i mensis v annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2441073 05 v 5 05/01/1971 die i mensis v annoque mcmlxxi 71 lxxi 1971} test clock-2.994 {conversion of 1971-05-31} { clock format 44541296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1971 12:34:56 die xxxi mensis v annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2441103 05 v 5 05/31/1971 die xxxi mensis v annoque mcmlxxi 71 lxxi 1971} test clock-2.995 {conversion of 1971-06-01} { clock format 44627696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1971 12:34:56 die i mensis vi annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2441104 06 vi 6 06/01/1971 die i mensis vi annoque mcmlxxi 71 lxxi 1971} test clock-2.996 {conversion of 1971-06-30} { clock format 47133296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1971 12:34:56 die xxx mensis vi annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2441133 06 vi 6 06/30/1971 die xxx mensis vi annoque mcmlxxi 71 lxxi 1971} test clock-2.997 {conversion of 1971-07-01} { clock format 47219696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1971 12:34:56 die i mensis vii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2441134 07 vii 7 07/01/1971 die i mensis vii annoque mcmlxxi 71 lxxi 1971} test clock-2.998 {conversion of 1971-07-31} { clock format 49811696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1971 12:34:56 die xxxi mensis vii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2441164 07 vii 7 07/31/1971 die xxxi mensis vii annoque mcmlxxi 71 lxxi 1971} test clock-2.999 {conversion of 1971-08-01} { clock format 49898096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1971 12:34:56 die i mensis viii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2441165 08 viii 8 08/01/1971 die i mensis viii annoque mcmlxxi 71 lxxi 1971} test clock-2.1000 {conversion of 1971-08-31} { clock format 52490096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1971 12:34:56 die xxxi mensis viii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2441195 08 viii 8 08/31/1971 die xxxi mensis viii annoque mcmlxxi 71 lxxi 1971} test clock-2.1001 {conversion of 1971-09-01} { clock format 52576496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1971 12:34:56 die i mensis ix annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2441196 09 ix 9 09/01/1971 die i mensis ix annoque mcmlxxi 71 lxxi 1971} test clock-2.1002 {conversion of 1971-09-30} { clock format 55082096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1971 12:34:56 die xxx mensis ix annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2441225 09 ix 9 09/30/1971 die xxx mensis ix annoque mcmlxxi 71 lxxi 1971} test clock-2.1003 {conversion of 1971-10-01} { clock format 55168496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1971 12:34:56 die i mensis x annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2441226 10 x 10 10/01/1971 die i mensis x annoque mcmlxxi 71 lxxi 1971} test clock-2.1004 {conversion of 1971-10-31} { clock format 57760496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1971 12:34:56 die xxxi mensis x annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2441256 10 x 10 10/31/1971 die xxxi mensis x annoque mcmlxxi 71 lxxi 1971} test clock-2.1005 {conversion of 1971-11-01} { clock format 57846896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1971 12:34:56 die i mensis xi annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2441257 11 xi 11 11/01/1971 die i mensis xi annoque mcmlxxi 71 lxxi 1971} test clock-2.1006 {conversion of 1971-11-30} { clock format 60352496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1971 12:34:56 die xxx mensis xi annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2441286 11 xi 11 11/30/1971 die xxx mensis xi annoque mcmlxxi 71 lxxi 1971} test clock-2.1007 {conversion of 1971-12-01} { clock format 60438896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1971 12:34:56 die i mensis xii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2441287 12 xii 12 12/01/1971 die i mensis xii annoque mcmlxxi 71 lxxi 1971} test clock-2.1008 {conversion of 1971-12-31} { clock format 63030896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1971 12:34:56 die xxxi mensis xii annoque mcmlxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2441317 12 xii 12 12/31/1971 die xxxi mensis xii annoque mcmlxxi 71 lxxi 1971} test clock-2.1009 {conversion of 1972-01-01} { clock format 63117296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1972 12:34:56 die i mensis i annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2441318 01 i 1 01/01/1972 die i mensis i annoque mcmlxxii 72 lxxii 1972} test clock-2.1010 {conversion of 1972-01-31} { clock format 65709296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1972 12:34:56 die xxxi mensis i annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2441348 01 i 1 01/31/1972 die xxxi mensis i annoque mcmlxxii 72 lxxii 1972} test clock-2.1011 {conversion of 1972-02-01} { clock format 65795696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1972 12:34:56 die i mensis ii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2441349 02 ii 2 02/01/1972 die i mensis ii annoque mcmlxxii 72 lxxii 1972} test clock-2.1012 {conversion of 1972-02-29} { clock format 68214896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1972 12:34:56 die xxix mensis ii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2441377 02 ii 2 02/29/1972 die xxix mensis ii annoque mcmlxxii 72 lxxii 1972} test clock-2.1013 {conversion of 1972-03-01} { clock format 68301296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1972 12:34:56 die i mensis iii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2441378 03 iii 3 03/01/1972 die i mensis iii annoque mcmlxxii 72 lxxii 1972} test clock-2.1014 {conversion of 1972-03-31} { clock format 70893296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1972 12:34:56 die xxxi mensis iii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2441408 03 iii 3 03/31/1972 die xxxi mensis iii annoque mcmlxxii 72 lxxii 1972} test clock-2.1015 {conversion of 1972-04-01} { clock format 70979696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1972 12:34:56 die i mensis iv annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2441409 04 iv 4 04/01/1972 die i mensis iv annoque mcmlxxii 72 lxxii 1972} test clock-2.1016 {conversion of 1972-04-30} { clock format 73485296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1972 12:34:56 die xxx mensis iv annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2441438 04 iv 4 04/30/1972 die xxx mensis iv annoque mcmlxxii 72 lxxii 1972} test clock-2.1017 {conversion of 1972-05-01} { clock format 73571696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1972 12:34:56 die i mensis v annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2441439 05 v 5 05/01/1972 die i mensis v annoque mcmlxxii 72 lxxii 1972} test clock-2.1018 {conversion of 1972-05-31} { clock format 76163696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1972 12:34:56 die xxxi mensis v annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2441469 05 v 5 05/31/1972 die xxxi mensis v annoque mcmlxxii 72 lxxii 1972} test clock-2.1019 {conversion of 1972-06-01} { clock format 76250096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1972 12:34:56 die i mensis vi annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2441470 06 vi 6 06/01/1972 die i mensis vi annoque mcmlxxii 72 lxxii 1972} test clock-2.1020 {conversion of 1972-06-30} { clock format 78755696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1972 12:34:56 die xxx mensis vi annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2441499 06 vi 6 06/30/1972 die xxx mensis vi annoque mcmlxxii 72 lxxii 1972} test clock-2.1021 {conversion of 1972-07-01} { clock format 78842096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1972 12:34:56 die i mensis vii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2441500 07 vii 7 07/01/1972 die i mensis vii annoque mcmlxxii 72 lxxii 1972} test clock-2.1022 {conversion of 1972-07-31} { clock format 81434096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1972 12:34:56 die xxxi mensis vii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2441530 07 vii 7 07/31/1972 die xxxi mensis vii annoque mcmlxxii 72 lxxii 1972} test clock-2.1023 {conversion of 1972-08-01} { clock format 81520496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1972 12:34:56 die i mensis viii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2441531 08 viii 8 08/01/1972 die i mensis viii annoque mcmlxxii 72 lxxii 1972} test clock-2.1024 {conversion of 1972-08-31} { clock format 84112496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1972 12:34:56 die xxxi mensis viii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2441561 08 viii 8 08/31/1972 die xxxi mensis viii annoque mcmlxxii 72 lxxii 1972} test clock-2.1025 {conversion of 1972-09-01} { clock format 84198896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1972 12:34:56 die i mensis ix annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2441562 09 ix 9 09/01/1972 die i mensis ix annoque mcmlxxii 72 lxxii 1972} test clock-2.1026 {conversion of 1972-09-30} { clock format 86704496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1972 12:34:56 die xxx mensis ix annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2441591 09 ix 9 09/30/1972 die xxx mensis ix annoque mcmlxxii 72 lxxii 1972} test clock-2.1027 {conversion of 1972-10-01} { clock format 86790896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1972 12:34:56 die i mensis x annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2441592 10 x 10 10/01/1972 die i mensis x annoque mcmlxxii 72 lxxii 1972} test clock-2.1028 {conversion of 1972-10-31} { clock format 89382896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1972 12:34:56 die xxxi mensis x annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2441622 10 x 10 10/31/1972 die xxxi mensis x annoque mcmlxxii 72 lxxii 1972} test clock-2.1029 {conversion of 1972-11-01} { clock format 89469296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1972 12:34:56 die i mensis xi annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2441623 11 xi 11 11/01/1972 die i mensis xi annoque mcmlxxii 72 lxxii 1972} test clock-2.1030 {conversion of 1972-11-30} { clock format 91974896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1972 12:34:56 die xxx mensis xi annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2441652 11 xi 11 11/30/1972 die xxx mensis xi annoque mcmlxxii 72 lxxii 1972} test clock-2.1031 {conversion of 1972-12-01} { clock format 92061296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1972 12:34:56 die i mensis xii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2441653 12 xii 12 12/01/1972 die i mensis xii annoque mcmlxxii 72 lxxii 1972} test clock-2.1032 {conversion of 1972-12-31} { clock format 94653296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1972 12:34:56 die xxxi mensis xii annoque mcmlxxii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2441683 12 xii 12 12/31/1972 die xxxi mensis xii annoque mcmlxxii 72 lxxii 1972} test clock-2.1033 {conversion of 1973-01-01} { clock format 94739696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1973 12:34:56 die i mensis i annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2441684 01 i 1 01/01/1973 die i mensis i annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1034 {conversion of 1973-01-31} { clock format 97331696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1973 12:34:56 die xxxi mensis i annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2441714 01 i 1 01/31/1973 die xxxi mensis i annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1035 {conversion of 1973-02-01} { clock format 97418096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1973 12:34:56 die i mensis ii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2441715 02 ii 2 02/01/1973 die i mensis ii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1036 {conversion of 1973-02-28} { clock format 99750896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1973 12:34:56 die xxviii mensis ii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2441742 02 ii 2 02/28/1973 die xxviii mensis ii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1037 {conversion of 1973-03-01} { clock format 99837296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1973 12:34:56 die i mensis iii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2441743 03 iii 3 03/01/1973 die i mensis iii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1038 {conversion of 1973-03-31} { clock format 102429296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1973 12:34:56 die xxxi mensis iii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2441773 03 iii 3 03/31/1973 die xxxi mensis iii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1039 {conversion of 1973-04-01} { clock format 102515696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1973 12:34:56 die i mensis iv annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2441774 04 iv 4 04/01/1973 die i mensis iv annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1040 {conversion of 1973-04-30} { clock format 105021296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1973 12:34:56 die xxx mensis iv annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2441803 04 iv 4 04/30/1973 die xxx mensis iv annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1041 {conversion of 1973-05-01} { clock format 105107696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1973 12:34:56 die i mensis v annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2441804 05 v 5 05/01/1973 die i mensis v annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1042 {conversion of 1973-05-31} { clock format 107699696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1973 12:34:56 die xxxi mensis v annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2441834 05 v 5 05/31/1973 die xxxi mensis v annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1043 {conversion of 1973-06-01} { clock format 107786096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1973 12:34:56 die i mensis vi annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2441835 06 vi 6 06/01/1973 die i mensis vi annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1044 {conversion of 1973-06-30} { clock format 110291696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1973 12:34:56 die xxx mensis vi annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2441864 06 vi 6 06/30/1973 die xxx mensis vi annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1045 {conversion of 1973-07-01} { clock format 110378096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1973 12:34:56 die i mensis vii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2441865 07 vii 7 07/01/1973 die i mensis vii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1046 {conversion of 1973-07-31} { clock format 112970096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1973 12:34:56 die xxxi mensis vii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2441895 07 vii 7 07/31/1973 die xxxi mensis vii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1047 {conversion of 1973-08-01} { clock format 113056496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1973 12:34:56 die i mensis viii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2441896 08 viii 8 08/01/1973 die i mensis viii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1048 {conversion of 1973-08-31} { clock format 115648496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1973 12:34:56 die xxxi mensis viii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2441926 08 viii 8 08/31/1973 die xxxi mensis viii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1049 {conversion of 1973-09-01} { clock format 115734896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1973 12:34:56 die i mensis ix annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2441927 09 ix 9 09/01/1973 die i mensis ix annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1050 {conversion of 1973-09-30} { clock format 118240496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1973 12:34:56 die xxx mensis ix annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2441956 09 ix 9 09/30/1973 die xxx mensis ix annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1051 {conversion of 1973-10-01} { clock format 118326896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1973 12:34:56 die i mensis x annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2441957 10 x 10 10/01/1973 die i mensis x annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1052 {conversion of 1973-10-31} { clock format 120918896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1973 12:34:56 die xxxi mensis x annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2441987 10 x 10 10/31/1973 die xxxi mensis x annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1053 {conversion of 1973-11-01} { clock format 121005296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1973 12:34:56 die i mensis xi annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2441988 11 xi 11 11/01/1973 die i mensis xi annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1054 {conversion of 1973-11-30} { clock format 123510896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1973 12:34:56 die xxx mensis xi annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2442017 11 xi 11 11/30/1973 die xxx mensis xi annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1055 {conversion of 1973-12-01} { clock format 123597296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1973 12:34:56 die i mensis xii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2442018 12 xii 12 12/01/1973 die i mensis xii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1056 {conversion of 1973-12-31} { clock format 126189296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1973 12:34:56 die xxxi mensis xii annoque mcmlxxiii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2442048 12 xii 12 12/31/1973 die xxxi mensis xii annoque mcmlxxiii 73 lxxiii 1973} test clock-2.1057 {conversion of 1974-01-01} { clock format 126275696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1974 12:34:56 die i mensis i annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2442049 01 i 1 01/01/1974 die i mensis i annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1058 {conversion of 1974-01-31} { clock format 128867696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1974 12:34:56 die xxxi mensis i annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2442079 01 i 1 01/31/1974 die xxxi mensis i annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1059 {conversion of 1974-02-01} { clock format 128954096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1974 12:34:56 die i mensis ii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2442080 02 ii 2 02/01/1974 die i mensis ii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1060 {conversion of 1974-02-28} { clock format 131286896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1974 12:34:56 die xxviii mensis ii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2442107 02 ii 2 02/28/1974 die xxviii mensis ii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1061 {conversion of 1974-03-01} { clock format 131373296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1974 12:34:56 die i mensis iii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2442108 03 iii 3 03/01/1974 die i mensis iii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1062 {conversion of 1974-03-31} { clock format 133965296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1974 12:34:56 die xxxi mensis iii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2442138 03 iii 3 03/31/1974 die xxxi mensis iii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1063 {conversion of 1974-04-01} { clock format 134051696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1974 12:34:56 die i mensis iv annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2442139 04 iv 4 04/01/1974 die i mensis iv annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1064 {conversion of 1974-04-30} { clock format 136557296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1974 12:34:56 die xxx mensis iv annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2442168 04 iv 4 04/30/1974 die xxx mensis iv annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1065 {conversion of 1974-05-01} { clock format 136643696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1974 12:34:56 die i mensis v annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2442169 05 v 5 05/01/1974 die i mensis v annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1066 {conversion of 1974-05-31} { clock format 139235696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1974 12:34:56 die xxxi mensis v annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2442199 05 v 5 05/31/1974 die xxxi mensis v annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1067 {conversion of 1974-06-01} { clock format 139322096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1974 12:34:56 die i mensis vi annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2442200 06 vi 6 06/01/1974 die i mensis vi annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1068 {conversion of 1974-06-30} { clock format 141827696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1974 12:34:56 die xxx mensis vi annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2442229 06 vi 6 06/30/1974 die xxx mensis vi annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1069 {conversion of 1974-07-01} { clock format 141914096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1974 12:34:56 die i mensis vii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2442230 07 vii 7 07/01/1974 die i mensis vii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1070 {conversion of 1974-07-31} { clock format 144506096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1974 12:34:56 die xxxi mensis vii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2442260 07 vii 7 07/31/1974 die xxxi mensis vii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1071 {conversion of 1974-08-01} { clock format 144592496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1974 12:34:56 die i mensis viii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2442261 08 viii 8 08/01/1974 die i mensis viii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1072 {conversion of 1974-08-31} { clock format 147184496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1974 12:34:56 die xxxi mensis viii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2442291 08 viii 8 08/31/1974 die xxxi mensis viii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1073 {conversion of 1974-09-01} { clock format 147270896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1974 12:34:56 die i mensis ix annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2442292 09 ix 9 09/01/1974 die i mensis ix annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1074 {conversion of 1974-09-30} { clock format 149776496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1974 12:34:56 die xxx mensis ix annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2442321 09 ix 9 09/30/1974 die xxx mensis ix annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1075 {conversion of 1974-10-01} { clock format 149862896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1974 12:34:56 die i mensis x annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2442322 10 x 10 10/01/1974 die i mensis x annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1076 {conversion of 1974-10-31} { clock format 152454896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1974 12:34:56 die xxxi mensis x annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2442352 10 x 10 10/31/1974 die xxxi mensis x annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1077 {conversion of 1974-11-01} { clock format 152541296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1974 12:34:56 die i mensis xi annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2442353 11 xi 11 11/01/1974 die i mensis xi annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1078 {conversion of 1974-11-30} { clock format 155046896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1974 12:34:56 die xxx mensis xi annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2442382 11 xi 11 11/30/1974 die xxx mensis xi annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1079 {conversion of 1974-12-01} { clock format 155133296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1974 12:34:56 die i mensis xii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2442383 12 xii 12 12/01/1974 die i mensis xii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1080 {conversion of 1974-12-31} { clock format 157725296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1974 12:34:56 die xxxi mensis xii annoque mcmlxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2442413 12 xii 12 12/31/1974 die xxxi mensis xii annoque mcmlxxiv 74 lxxiv 1974} test clock-2.1081 {conversion of 1975-01-01} { clock format 157811696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1975 12:34:56 die i mensis i annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2442414 01 i 1 01/01/1975 die i mensis i annoque mcmlxxv 75 lxxv 1975} test clock-2.1082 {conversion of 1975-01-31} { clock format 160403696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1975 12:34:56 die xxxi mensis i annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2442444 01 i 1 01/31/1975 die xxxi mensis i annoque mcmlxxv 75 lxxv 1975} test clock-2.1083 {conversion of 1975-02-01} { clock format 160490096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1975 12:34:56 die i mensis ii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2442445 02 ii 2 02/01/1975 die i mensis ii annoque mcmlxxv 75 lxxv 1975} test clock-2.1084 {conversion of 1975-02-28} { clock format 162822896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1975 12:34:56 die xxviii mensis ii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2442472 02 ii 2 02/28/1975 die xxviii mensis ii annoque mcmlxxv 75 lxxv 1975} test clock-2.1085 {conversion of 1975-03-01} { clock format 162909296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1975 12:34:56 die i mensis iii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2442473 03 iii 3 03/01/1975 die i mensis iii annoque mcmlxxv 75 lxxv 1975} test clock-2.1086 {conversion of 1975-03-31} { clock format 165501296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1975 12:34:56 die xxxi mensis iii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2442503 03 iii 3 03/31/1975 die xxxi mensis iii annoque mcmlxxv 75 lxxv 1975} test clock-2.1087 {conversion of 1975-04-01} { clock format 165587696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1975 12:34:56 die i mensis iv annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2442504 04 iv 4 04/01/1975 die i mensis iv annoque mcmlxxv 75 lxxv 1975} test clock-2.1088 {conversion of 1975-04-30} { clock format 168093296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1975 12:34:56 die xxx mensis iv annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2442533 04 iv 4 04/30/1975 die xxx mensis iv annoque mcmlxxv 75 lxxv 1975} test clock-2.1089 {conversion of 1975-05-01} { clock format 168179696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1975 12:34:56 die i mensis v annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2442534 05 v 5 05/01/1975 die i mensis v annoque mcmlxxv 75 lxxv 1975} test clock-2.1090 {conversion of 1975-05-31} { clock format 170771696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1975 12:34:56 die xxxi mensis v annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2442564 05 v 5 05/31/1975 die xxxi mensis v annoque mcmlxxv 75 lxxv 1975} test clock-2.1091 {conversion of 1975-06-01} { clock format 170858096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1975 12:34:56 die i mensis vi annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2442565 06 vi 6 06/01/1975 die i mensis vi annoque mcmlxxv 75 lxxv 1975} test clock-2.1092 {conversion of 1975-06-30} { clock format 173363696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1975 12:34:56 die xxx mensis vi annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2442594 06 vi 6 06/30/1975 die xxx mensis vi annoque mcmlxxv 75 lxxv 1975} test clock-2.1093 {conversion of 1975-07-01} { clock format 173450096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1975 12:34:56 die i mensis vii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2442595 07 vii 7 07/01/1975 die i mensis vii annoque mcmlxxv 75 lxxv 1975} test clock-2.1094 {conversion of 1975-07-31} { clock format 176042096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1975 12:34:56 die xxxi mensis vii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2442625 07 vii 7 07/31/1975 die xxxi mensis vii annoque mcmlxxv 75 lxxv 1975} test clock-2.1095 {conversion of 1975-08-01} { clock format 176128496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1975 12:34:56 die i mensis viii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2442626 08 viii 8 08/01/1975 die i mensis viii annoque mcmlxxv 75 lxxv 1975} test clock-2.1096 {conversion of 1975-08-31} { clock format 178720496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1975 12:34:56 die xxxi mensis viii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2442656 08 viii 8 08/31/1975 die xxxi mensis viii annoque mcmlxxv 75 lxxv 1975} test clock-2.1097 {conversion of 1975-09-01} { clock format 178806896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1975 12:34:56 die i mensis ix annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2442657 09 ix 9 09/01/1975 die i mensis ix annoque mcmlxxv 75 lxxv 1975} test clock-2.1098 {conversion of 1975-09-30} { clock format 181312496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1975 12:34:56 die xxx mensis ix annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2442686 09 ix 9 09/30/1975 die xxx mensis ix annoque mcmlxxv 75 lxxv 1975} test clock-2.1099 {conversion of 1975-10-01} { clock format 181398896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1975 12:34:56 die i mensis x annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2442687 10 x 10 10/01/1975 die i mensis x annoque mcmlxxv 75 lxxv 1975} test clock-2.1100 {conversion of 1975-10-31} { clock format 183990896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1975 12:34:56 die xxxi mensis x annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2442717 10 x 10 10/31/1975 die xxxi mensis x annoque mcmlxxv 75 lxxv 1975} test clock-2.1101 {conversion of 1975-11-01} { clock format 184077296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1975 12:34:56 die i mensis xi annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2442718 11 xi 11 11/01/1975 die i mensis xi annoque mcmlxxv 75 lxxv 1975} test clock-2.1102 {conversion of 1975-11-30} { clock format 186582896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1975 12:34:56 die xxx mensis xi annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2442747 11 xi 11 11/30/1975 die xxx mensis xi annoque mcmlxxv 75 lxxv 1975} test clock-2.1103 {conversion of 1975-12-01} { clock format 186669296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1975 12:34:56 die i mensis xii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2442748 12 xii 12 12/01/1975 die i mensis xii annoque mcmlxxv 75 lxxv 1975} test clock-2.1104 {conversion of 1975-12-31} { clock format 189261296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1975 12:34:56 die xxxi mensis xii annoque mcmlxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2442778 12 xii 12 12/31/1975 die xxxi mensis xii annoque mcmlxxv 75 lxxv 1975} test clock-2.1105 {conversion of 1976-01-01} { clock format 189347696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1976 12:34:56 die i mensis i annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2442779 01 i 1 01/01/1976 die i mensis i annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1106 {conversion of 1976-01-31} { clock format 191939696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1976 12:34:56 die xxxi mensis i annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2442809 01 i 1 01/31/1976 die xxxi mensis i annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1107 {conversion of 1976-02-01} { clock format 192026096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1976 12:34:56 die i mensis ii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2442810 02 ii 2 02/01/1976 die i mensis ii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1108 {conversion of 1976-02-29} { clock format 194445296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1976 12:34:56 die xxix mensis ii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2442838 02 ii 2 02/29/1976 die xxix mensis ii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1109 {conversion of 1976-03-01} { clock format 194531696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1976 12:34:56 die i mensis iii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2442839 03 iii 3 03/01/1976 die i mensis iii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1110 {conversion of 1976-03-31} { clock format 197123696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1976 12:34:56 die xxxi mensis iii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2442869 03 iii 3 03/31/1976 die xxxi mensis iii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1111 {conversion of 1976-04-01} { clock format 197210096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1976 12:34:56 die i mensis iv annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2442870 04 iv 4 04/01/1976 die i mensis iv annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1112 {conversion of 1976-04-30} { clock format 199715696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1976 12:34:56 die xxx mensis iv annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2442899 04 iv 4 04/30/1976 die xxx mensis iv annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1113 {conversion of 1976-05-01} { clock format 199802096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1976 12:34:56 die i mensis v annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2442900 05 v 5 05/01/1976 die i mensis v annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1114 {conversion of 1976-05-31} { clock format 202394096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1976 12:34:56 die xxxi mensis v annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2442930 05 v 5 05/31/1976 die xxxi mensis v annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1115 {conversion of 1976-06-01} { clock format 202480496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1976 12:34:56 die i mensis vi annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2442931 06 vi 6 06/01/1976 die i mensis vi annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1116 {conversion of 1976-06-30} { clock format 204986096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1976 12:34:56 die xxx mensis vi annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2442960 06 vi 6 06/30/1976 die xxx mensis vi annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1117 {conversion of 1976-07-01} { clock format 205072496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1976 12:34:56 die i mensis vii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2442961 07 vii 7 07/01/1976 die i mensis vii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1118 {conversion of 1976-07-31} { clock format 207664496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1976 12:34:56 die xxxi mensis vii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2442991 07 vii 7 07/31/1976 die xxxi mensis vii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1119 {conversion of 1976-08-01} { clock format 207750896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1976 12:34:56 die i mensis viii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2442992 08 viii 8 08/01/1976 die i mensis viii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1120 {conversion of 1976-08-31} { clock format 210342896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1976 12:34:56 die xxxi mensis viii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2443022 08 viii 8 08/31/1976 die xxxi mensis viii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1121 {conversion of 1976-09-01} { clock format 210429296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1976 12:34:56 die i mensis ix annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2443023 09 ix 9 09/01/1976 die i mensis ix annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1122 {conversion of 1976-09-30} { clock format 212934896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1976 12:34:56 die xxx mensis ix annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2443052 09 ix 9 09/30/1976 die xxx mensis ix annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1123 {conversion of 1976-10-01} { clock format 213021296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1976 12:34:56 die i mensis x annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2443053 10 x 10 10/01/1976 die i mensis x annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1124 {conversion of 1976-10-31} { clock format 215613296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1976 12:34:56 die xxxi mensis x annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2443083 10 x 10 10/31/1976 die xxxi mensis x annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1125 {conversion of 1976-11-01} { clock format 215699696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1976 12:34:56 die i mensis xi annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2443084 11 xi 11 11/01/1976 die i mensis xi annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1126 {conversion of 1976-11-30} { clock format 218205296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1976 12:34:56 die xxx mensis xi annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2443113 11 xi 11 11/30/1976 die xxx mensis xi annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1127 {conversion of 1976-12-01} { clock format 218291696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1976 12:34:56 die i mensis xii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2443114 12 xii 12 12/01/1976 die i mensis xii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1128 {conversion of 1976-12-31} { clock format 220883696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1976 12:34:56 die xxxi mensis xii annoque mcmlxxvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2443144 12 xii 12 12/31/1976 die xxxi mensis xii annoque mcmlxxvi 76 lxxvi 1976} test clock-2.1129 {conversion of 1977-01-01} { clock format 220970096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1977 12:34:56 die i mensis i annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2443145 01 i 1 01/01/1977 die i mensis i annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1130 {conversion of 1977-01-31} { clock format 223562096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1977 12:34:56 die xxxi mensis i annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2443175 01 i 1 01/31/1977 die xxxi mensis i annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1131 {conversion of 1977-02-01} { clock format 223648496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1977 12:34:56 die i mensis ii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2443176 02 ii 2 02/01/1977 die i mensis ii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1132 {conversion of 1977-02-28} { clock format 225981296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1977 12:34:56 die xxviii mensis ii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2443203 02 ii 2 02/28/1977 die xxviii mensis ii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1133 {conversion of 1977-03-01} { clock format 226067696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1977 12:34:56 die i mensis iii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2443204 03 iii 3 03/01/1977 die i mensis iii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1134 {conversion of 1977-03-31} { clock format 228659696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1977 12:34:56 die xxxi mensis iii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2443234 03 iii 3 03/31/1977 die xxxi mensis iii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1135 {conversion of 1977-04-01} { clock format 228746096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1977 12:34:56 die i mensis iv annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2443235 04 iv 4 04/01/1977 die i mensis iv annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1136 {conversion of 1977-04-30} { clock format 231251696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1977 12:34:56 die xxx mensis iv annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2443264 04 iv 4 04/30/1977 die xxx mensis iv annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1137 {conversion of 1977-05-01} { clock format 231338096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1977 12:34:56 die i mensis v annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2443265 05 v 5 05/01/1977 die i mensis v annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1138 {conversion of 1977-05-31} { clock format 233930096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1977 12:34:56 die xxxi mensis v annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2443295 05 v 5 05/31/1977 die xxxi mensis v annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1139 {conversion of 1977-06-01} { clock format 234016496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1977 12:34:56 die i mensis vi annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2443296 06 vi 6 06/01/1977 die i mensis vi annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1140 {conversion of 1977-06-30} { clock format 236522096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1977 12:34:56 die xxx mensis vi annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2443325 06 vi 6 06/30/1977 die xxx mensis vi annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1141 {conversion of 1977-07-01} { clock format 236608496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1977 12:34:56 die i mensis vii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2443326 07 vii 7 07/01/1977 die i mensis vii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1142 {conversion of 1977-07-31} { clock format 239200496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1977 12:34:56 die xxxi mensis vii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2443356 07 vii 7 07/31/1977 die xxxi mensis vii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1143 {conversion of 1977-08-01} { clock format 239286896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1977 12:34:56 die i mensis viii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2443357 08 viii 8 08/01/1977 die i mensis viii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1144 {conversion of 1977-08-31} { clock format 241878896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1977 12:34:56 die xxxi mensis viii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2443387 08 viii 8 08/31/1977 die xxxi mensis viii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1145 {conversion of 1977-09-01} { clock format 241965296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1977 12:34:56 die i mensis ix annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2443388 09 ix 9 09/01/1977 die i mensis ix annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1146 {conversion of 1977-09-30} { clock format 244470896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1977 12:34:56 die xxx mensis ix annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2443417 09 ix 9 09/30/1977 die xxx mensis ix annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1147 {conversion of 1977-10-01} { clock format 244557296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1977 12:34:56 die i mensis x annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2443418 10 x 10 10/01/1977 die i mensis x annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1148 {conversion of 1977-10-31} { clock format 247149296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1977 12:34:56 die xxxi mensis x annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2443448 10 x 10 10/31/1977 die xxxi mensis x annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1149 {conversion of 1977-11-01} { clock format 247235696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1977 12:34:56 die i mensis xi annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2443449 11 xi 11 11/01/1977 die i mensis xi annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1150 {conversion of 1977-11-30} { clock format 249741296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1977 12:34:56 die xxx mensis xi annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2443478 11 xi 11 11/30/1977 die xxx mensis xi annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1151 {conversion of 1977-12-01} { clock format 249827696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1977 12:34:56 die i mensis xii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2443479 12 xii 12 12/01/1977 die i mensis xii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1152 {conversion of 1977-12-31} { clock format 252419696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1977 12:34:56 die xxxi mensis xii annoque mcmlxxvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2443509 12 xii 12 12/31/1977 die xxxi mensis xii annoque mcmlxxvii 77 lxxvii 1977} test clock-2.1153 {conversion of 1978-01-01} { clock format 252506096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1978 12:34:56 die i mensis i annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2443510 01 i 1 01/01/1978 die i mensis i annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1154 {conversion of 1978-01-31} { clock format 255098096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1978 12:34:56 die xxxi mensis i annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2443540 01 i 1 01/31/1978 die xxxi mensis i annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1155 {conversion of 1978-02-01} { clock format 255184496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1978 12:34:56 die i mensis ii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2443541 02 ii 2 02/01/1978 die i mensis ii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1156 {conversion of 1978-02-28} { clock format 257517296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1978 12:34:56 die xxviii mensis ii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2443568 02 ii 2 02/28/1978 die xxviii mensis ii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1157 {conversion of 1978-03-01} { clock format 257603696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1978 12:34:56 die i mensis iii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2443569 03 iii 3 03/01/1978 die i mensis iii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1158 {conversion of 1978-03-31} { clock format 260195696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1978 12:34:56 die xxxi mensis iii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2443599 03 iii 3 03/31/1978 die xxxi mensis iii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1159 {conversion of 1978-04-01} { clock format 260282096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1978 12:34:56 die i mensis iv annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2443600 04 iv 4 04/01/1978 die i mensis iv annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1160 {conversion of 1978-04-30} { clock format 262787696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1978 12:34:56 die xxx mensis iv annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2443629 04 iv 4 04/30/1978 die xxx mensis iv annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1161 {conversion of 1978-05-01} { clock format 262874096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1978 12:34:56 die i mensis v annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2443630 05 v 5 05/01/1978 die i mensis v annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1162 {conversion of 1978-05-31} { clock format 265466096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1978 12:34:56 die xxxi mensis v annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2443660 05 v 5 05/31/1978 die xxxi mensis v annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1163 {conversion of 1978-06-01} { clock format 265552496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1978 12:34:56 die i mensis vi annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2443661 06 vi 6 06/01/1978 die i mensis vi annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1164 {conversion of 1978-06-30} { clock format 268058096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1978 12:34:56 die xxx mensis vi annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2443690 06 vi 6 06/30/1978 die xxx mensis vi annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1165 {conversion of 1978-07-01} { clock format 268144496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1978 12:34:56 die i mensis vii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2443691 07 vii 7 07/01/1978 die i mensis vii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1166 {conversion of 1978-07-31} { clock format 270736496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1978 12:34:56 die xxxi mensis vii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2443721 07 vii 7 07/31/1978 die xxxi mensis vii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1167 {conversion of 1978-08-01} { clock format 270822896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1978 12:34:56 die i mensis viii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2443722 08 viii 8 08/01/1978 die i mensis viii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1168 {conversion of 1978-08-31} { clock format 273414896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1978 12:34:56 die xxxi mensis viii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2443752 08 viii 8 08/31/1978 die xxxi mensis viii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1169 {conversion of 1978-09-01} { clock format 273501296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1978 12:34:56 die i mensis ix annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2443753 09 ix 9 09/01/1978 die i mensis ix annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1170 {conversion of 1978-09-30} { clock format 276006896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1978 12:34:56 die xxx mensis ix annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2443782 09 ix 9 09/30/1978 die xxx mensis ix annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1171 {conversion of 1978-10-01} { clock format 276093296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1978 12:34:56 die i mensis x annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2443783 10 x 10 10/01/1978 die i mensis x annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1172 {conversion of 1978-10-31} { clock format 278685296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1978 12:34:56 die xxxi mensis x annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2443813 10 x 10 10/31/1978 die xxxi mensis x annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1173 {conversion of 1978-11-01} { clock format 278771696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1978 12:34:56 die i mensis xi annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2443814 11 xi 11 11/01/1978 die i mensis xi annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1174 {conversion of 1978-11-30} { clock format 281277296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1978 12:34:56 die xxx mensis xi annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2443843 11 xi 11 11/30/1978 die xxx mensis xi annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1175 {conversion of 1978-12-01} { clock format 281363696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1978 12:34:56 die i mensis xii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2443844 12 xii 12 12/01/1978 die i mensis xii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1176 {conversion of 1978-12-31} { clock format 283955696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1978 12:34:56 die xxxi mensis xii annoque mcmlxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2443874 12 xii 12 12/31/1978 die xxxi mensis xii annoque mcmlxxviii 78 lxxviii 1978} test clock-2.1177 {conversion of 1979-01-01} { clock format 284042096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1979 12:34:56 die i mensis i annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2443875 01 i 1 01/01/1979 die i mensis i annoque mcmlxxix 79 lxxix 1979} test clock-2.1178 {conversion of 1979-01-31} { clock format 286634096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1979 12:34:56 die xxxi mensis i annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2443905 01 i 1 01/31/1979 die xxxi mensis i annoque mcmlxxix 79 lxxix 1979} test clock-2.1179 {conversion of 1979-02-01} { clock format 286720496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1979 12:34:56 die i mensis ii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2443906 02 ii 2 02/01/1979 die i mensis ii annoque mcmlxxix 79 lxxix 1979} test clock-2.1180 {conversion of 1979-02-28} { clock format 289053296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1979 12:34:56 die xxviii mensis ii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2443933 02 ii 2 02/28/1979 die xxviii mensis ii annoque mcmlxxix 79 lxxix 1979} test clock-2.1181 {conversion of 1979-03-01} { clock format 289139696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1979 12:34:56 die i mensis iii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2443934 03 iii 3 03/01/1979 die i mensis iii annoque mcmlxxix 79 lxxix 1979} test clock-2.1182 {conversion of 1979-03-31} { clock format 291731696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1979 12:34:56 die xxxi mensis iii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2443964 03 iii 3 03/31/1979 die xxxi mensis iii annoque mcmlxxix 79 lxxix 1979} test clock-2.1183 {conversion of 1979-04-01} { clock format 291818096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1979 12:34:56 die i mensis iv annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2443965 04 iv 4 04/01/1979 die i mensis iv annoque mcmlxxix 79 lxxix 1979} test clock-2.1184 {conversion of 1979-04-30} { clock format 294323696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1979 12:34:56 die xxx mensis iv annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2443994 04 iv 4 04/30/1979 die xxx mensis iv annoque mcmlxxix 79 lxxix 1979} test clock-2.1185 {conversion of 1979-05-01} { clock format 294410096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1979 12:34:56 die i mensis v annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2443995 05 v 5 05/01/1979 die i mensis v annoque mcmlxxix 79 lxxix 1979} test clock-2.1186 {conversion of 1979-05-31} { clock format 297002096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1979 12:34:56 die xxxi mensis v annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2444025 05 v 5 05/31/1979 die xxxi mensis v annoque mcmlxxix 79 lxxix 1979} test clock-2.1187 {conversion of 1979-06-01} { clock format 297088496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1979 12:34:56 die i mensis vi annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2444026 06 vi 6 06/01/1979 die i mensis vi annoque mcmlxxix 79 lxxix 1979} test clock-2.1188 {conversion of 1979-06-30} { clock format 299594096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1979 12:34:56 die xxx mensis vi annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2444055 06 vi 6 06/30/1979 die xxx mensis vi annoque mcmlxxix 79 lxxix 1979} test clock-2.1189 {conversion of 1979-07-01} { clock format 299680496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1979 12:34:56 die i mensis vii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2444056 07 vii 7 07/01/1979 die i mensis vii annoque mcmlxxix 79 lxxix 1979} test clock-2.1190 {conversion of 1979-07-31} { clock format 302272496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1979 12:34:56 die xxxi mensis vii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2444086 07 vii 7 07/31/1979 die xxxi mensis vii annoque mcmlxxix 79 lxxix 1979} test clock-2.1191 {conversion of 1979-08-01} { clock format 302358896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1979 12:34:56 die i mensis viii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2444087 08 viii 8 08/01/1979 die i mensis viii annoque mcmlxxix 79 lxxix 1979} test clock-2.1192 {conversion of 1979-08-31} { clock format 304950896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1979 12:34:56 die xxxi mensis viii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2444117 08 viii 8 08/31/1979 die xxxi mensis viii annoque mcmlxxix 79 lxxix 1979} test clock-2.1193 {conversion of 1979-09-01} { clock format 305037296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1979 12:34:56 die i mensis ix annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2444118 09 ix 9 09/01/1979 die i mensis ix annoque mcmlxxix 79 lxxix 1979} test clock-2.1194 {conversion of 1979-09-30} { clock format 307542896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1979 12:34:56 die xxx mensis ix annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2444147 09 ix 9 09/30/1979 die xxx mensis ix annoque mcmlxxix 79 lxxix 1979} test clock-2.1195 {conversion of 1979-10-01} { clock format 307629296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1979 12:34:56 die i mensis x annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2444148 10 x 10 10/01/1979 die i mensis x annoque mcmlxxix 79 lxxix 1979} test clock-2.1196 {conversion of 1979-10-31} { clock format 310221296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1979 12:34:56 die xxxi mensis x annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2444178 10 x 10 10/31/1979 die xxxi mensis x annoque mcmlxxix 79 lxxix 1979} test clock-2.1197 {conversion of 1979-11-01} { clock format 310307696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1979 12:34:56 die i mensis xi annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2444179 11 xi 11 11/01/1979 die i mensis xi annoque mcmlxxix 79 lxxix 1979} test clock-2.1198 {conversion of 1979-11-30} { clock format 312813296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1979 12:34:56 die xxx mensis xi annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2444208 11 xi 11 11/30/1979 die xxx mensis xi annoque mcmlxxix 79 lxxix 1979} test clock-2.1199 {conversion of 1979-12-01} { clock format 312899696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1979 12:34:56 die i mensis xii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2444209 12 xii 12 12/01/1979 die i mensis xii annoque mcmlxxix 79 lxxix 1979} test clock-2.1200 {conversion of 1979-12-31} { clock format 315491696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1979 12:34:56 die xxxi mensis xii annoque mcmlxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2444239 12 xii 12 12/31/1979 die xxxi mensis xii annoque mcmlxxix 79 lxxix 1979} test clock-2.1201 {conversion of 1980-01-01} { clock format 315578096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1980 12:34:56 die i mensis i annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2444240 01 i 1 01/01/1980 die i mensis i annoque mcmlxxx 80 lxxx 1980} test clock-2.1202 {conversion of 1980-01-31} { clock format 318170096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1980 12:34:56 die xxxi mensis i annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2444270 01 i 1 01/31/1980 die xxxi mensis i annoque mcmlxxx 80 lxxx 1980} test clock-2.1203 {conversion of 1980-02-01} { clock format 318256496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1980 12:34:56 die i mensis ii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2444271 02 ii 2 02/01/1980 die i mensis ii annoque mcmlxxx 80 lxxx 1980} test clock-2.1204 {conversion of 1980-02-29} { clock format 320675696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1980 12:34:56 die xxix mensis ii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2444299 02 ii 2 02/29/1980 die xxix mensis ii annoque mcmlxxx 80 lxxx 1980} test clock-2.1205 {conversion of 1980-03-01} { clock format 320762096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1980 12:34:56 die i mensis iii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2444300 03 iii 3 03/01/1980 die i mensis iii annoque mcmlxxx 80 lxxx 1980} test clock-2.1206 {conversion of 1980-03-31} { clock format 323354096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1980 12:34:56 die xxxi mensis iii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2444330 03 iii 3 03/31/1980 die xxxi mensis iii annoque mcmlxxx 80 lxxx 1980} test clock-2.1207 {conversion of 1980-04-01} { clock format 323440496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1980 12:34:56 die i mensis iv annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2444331 04 iv 4 04/01/1980 die i mensis iv annoque mcmlxxx 80 lxxx 1980} test clock-2.1208 {conversion of 1980-04-30} { clock format 325946096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1980 12:34:56 die xxx mensis iv annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2444360 04 iv 4 04/30/1980 die xxx mensis iv annoque mcmlxxx 80 lxxx 1980} test clock-2.1209 {conversion of 1980-05-01} { clock format 326032496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1980 12:34:56 die i mensis v annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2444361 05 v 5 05/01/1980 die i mensis v annoque mcmlxxx 80 lxxx 1980} test clock-2.1210 {conversion of 1980-05-31} { clock format 328624496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1980 12:34:56 die xxxi mensis v annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2444391 05 v 5 05/31/1980 die xxxi mensis v annoque mcmlxxx 80 lxxx 1980} test clock-2.1211 {conversion of 1980-06-01} { clock format 328710896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1980 12:34:56 die i mensis vi annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2444392 06 vi 6 06/01/1980 die i mensis vi annoque mcmlxxx 80 lxxx 1980} test clock-2.1212 {conversion of 1980-06-30} { clock format 331216496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1980 12:34:56 die xxx mensis vi annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2444421 06 vi 6 06/30/1980 die xxx mensis vi annoque mcmlxxx 80 lxxx 1980} test clock-2.1213 {conversion of 1980-07-01} { clock format 331302896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1980 12:34:56 die i mensis vii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2444422 07 vii 7 07/01/1980 die i mensis vii annoque mcmlxxx 80 lxxx 1980} test clock-2.1214 {conversion of 1980-07-31} { clock format 333894896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1980 12:34:56 die xxxi mensis vii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2444452 07 vii 7 07/31/1980 die xxxi mensis vii annoque mcmlxxx 80 lxxx 1980} test clock-2.1215 {conversion of 1980-08-01} { clock format 333981296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1980 12:34:56 die i mensis viii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2444453 08 viii 8 08/01/1980 die i mensis viii annoque mcmlxxx 80 lxxx 1980} test clock-2.1216 {conversion of 1980-08-31} { clock format 336573296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1980 12:34:56 die xxxi mensis viii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2444483 08 viii 8 08/31/1980 die xxxi mensis viii annoque mcmlxxx 80 lxxx 1980} test clock-2.1217 {conversion of 1980-09-01} { clock format 336659696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1980 12:34:56 die i mensis ix annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2444484 09 ix 9 09/01/1980 die i mensis ix annoque mcmlxxx 80 lxxx 1980} test clock-2.1218 {conversion of 1980-09-30} { clock format 339165296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1980 12:34:56 die xxx mensis ix annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2444513 09 ix 9 09/30/1980 die xxx mensis ix annoque mcmlxxx 80 lxxx 1980} test clock-2.1219 {conversion of 1980-10-01} { clock format 339251696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1980 12:34:56 die i mensis x annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2444514 10 x 10 10/01/1980 die i mensis x annoque mcmlxxx 80 lxxx 1980} test clock-2.1220 {conversion of 1980-10-31} { clock format 341843696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1980 12:34:56 die xxxi mensis x annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2444544 10 x 10 10/31/1980 die xxxi mensis x annoque mcmlxxx 80 lxxx 1980} test clock-2.1221 {conversion of 1980-11-01} { clock format 341930096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1980 12:34:56 die i mensis xi annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2444545 11 xi 11 11/01/1980 die i mensis xi annoque mcmlxxx 80 lxxx 1980} test clock-2.1222 {conversion of 1980-11-30} { clock format 344435696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1980 12:34:56 die xxx mensis xi annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2444574 11 xi 11 11/30/1980 die xxx mensis xi annoque mcmlxxx 80 lxxx 1980} test clock-2.1223 {conversion of 1980-12-01} { clock format 344522096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1980 12:34:56 die i mensis xii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2444575 12 xii 12 12/01/1980 die i mensis xii annoque mcmlxxx 80 lxxx 1980} test clock-2.1224 {conversion of 1980-12-31} { clock format 347114096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1980 12:34:56 die xxxi mensis xii annoque mcmlxxx xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2444605 12 xii 12 12/31/1980 die xxxi mensis xii annoque mcmlxxx 80 lxxx 1980} test clock-2.1225 {conversion of 1981-01-01} { clock format 347200496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1981 12:34:56 die i mensis i annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2444606 01 i 1 01/01/1981 die i mensis i annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1226 {conversion of 1981-01-31} { clock format 349792496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1981 12:34:56 die xxxi mensis i annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2444636 01 i 1 01/31/1981 die xxxi mensis i annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1227 {conversion of 1981-02-01} { clock format 349878896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1981 12:34:56 die i mensis ii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2444637 02 ii 2 02/01/1981 die i mensis ii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1228 {conversion of 1981-02-28} { clock format 352211696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1981 12:34:56 die xxviii mensis ii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2444664 02 ii 2 02/28/1981 die xxviii mensis ii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1229 {conversion of 1981-03-01} { clock format 352298096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1981 12:34:56 die i mensis iii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2444665 03 iii 3 03/01/1981 die i mensis iii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1230 {conversion of 1981-03-31} { clock format 354890096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1981 12:34:56 die xxxi mensis iii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2444695 03 iii 3 03/31/1981 die xxxi mensis iii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1231 {conversion of 1981-04-01} { clock format 354976496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1981 12:34:56 die i mensis iv annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2444696 04 iv 4 04/01/1981 die i mensis iv annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1232 {conversion of 1981-04-30} { clock format 357482096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1981 12:34:56 die xxx mensis iv annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2444725 04 iv 4 04/30/1981 die xxx mensis iv annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1233 {conversion of 1981-05-01} { clock format 357568496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1981 12:34:56 die i mensis v annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2444726 05 v 5 05/01/1981 die i mensis v annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1234 {conversion of 1981-05-31} { clock format 360160496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1981 12:34:56 die xxxi mensis v annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2444756 05 v 5 05/31/1981 die xxxi mensis v annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1235 {conversion of 1981-06-01} { clock format 360246896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1981 12:34:56 die i mensis vi annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2444757 06 vi 6 06/01/1981 die i mensis vi annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1236 {conversion of 1981-06-30} { clock format 362752496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1981 12:34:56 die xxx mensis vi annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2444786 06 vi 6 06/30/1981 die xxx mensis vi annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1237 {conversion of 1981-07-01} { clock format 362838896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1981 12:34:56 die i mensis vii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2444787 07 vii 7 07/01/1981 die i mensis vii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1238 {conversion of 1981-07-31} { clock format 365430896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1981 12:34:56 die xxxi mensis vii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2444817 07 vii 7 07/31/1981 die xxxi mensis vii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1239 {conversion of 1981-08-01} { clock format 365517296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1981 12:34:56 die i mensis viii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2444818 08 viii 8 08/01/1981 die i mensis viii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1240 {conversion of 1981-08-31} { clock format 368109296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1981 12:34:56 die xxxi mensis viii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2444848 08 viii 8 08/31/1981 die xxxi mensis viii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1241 {conversion of 1981-09-01} { clock format 368195696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1981 12:34:56 die i mensis ix annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2444849 09 ix 9 09/01/1981 die i mensis ix annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1242 {conversion of 1981-09-30} { clock format 370701296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1981 12:34:56 die xxx mensis ix annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2444878 09 ix 9 09/30/1981 die xxx mensis ix annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1243 {conversion of 1981-10-01} { clock format 370787696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1981 12:34:56 die i mensis x annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2444879 10 x 10 10/01/1981 die i mensis x annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1244 {conversion of 1981-10-31} { clock format 373379696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1981 12:34:56 die xxxi mensis x annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2444909 10 x 10 10/31/1981 die xxxi mensis x annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1245 {conversion of 1981-11-01} { clock format 373466096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1981 12:34:56 die i mensis xi annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2444910 11 xi 11 11/01/1981 die i mensis xi annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1246 {conversion of 1981-11-30} { clock format 375971696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1981 12:34:56 die xxx mensis xi annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2444939 11 xi 11 11/30/1981 die xxx mensis xi annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1247 {conversion of 1981-12-01} { clock format 376058096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1981 12:34:56 die i mensis xii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2444940 12 xii 12 12/01/1981 die i mensis xii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1248 {conversion of 1981-12-31} { clock format 378650096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1981 12:34:56 die xxxi mensis xii annoque mcmlxxxi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2444970 12 xii 12 12/31/1981 die xxxi mensis xii annoque mcmlxxxi 81 lxxxi 1981} test clock-2.1249 {conversion of 1984-01-01} { clock format 441808496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1984 12:34:56 die i mensis i annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2445701 01 i 1 01/01/1984 die i mensis i annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1250 {conversion of 1984-01-31} { clock format 444400496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1984 12:34:56 die xxxi mensis i annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2445731 01 i 1 01/31/1984 die xxxi mensis i annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1251 {conversion of 1984-02-01} { clock format 444486896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1984 12:34:56 die i mensis ii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2445732 02 ii 2 02/01/1984 die i mensis ii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1252 {conversion of 1984-02-29} { clock format 446906096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1984 12:34:56 die xxix mensis ii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2445760 02 ii 2 02/29/1984 die xxix mensis ii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1253 {conversion of 1984-03-01} { clock format 446992496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1984 12:34:56 die i mensis iii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2445761 03 iii 3 03/01/1984 die i mensis iii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1254 {conversion of 1984-03-31} { clock format 449584496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1984 12:34:56 die xxxi mensis iii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2445791 03 iii 3 03/31/1984 die xxxi mensis iii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1255 {conversion of 1984-04-01} { clock format 449670896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1984 12:34:56 die i mensis iv annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2445792 04 iv 4 04/01/1984 die i mensis iv annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1256 {conversion of 1984-04-30} { clock format 452176496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1984 12:34:56 die xxx mensis iv annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2445821 04 iv 4 04/30/1984 die xxx mensis iv annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1257 {conversion of 1984-05-01} { clock format 452262896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1984 12:34:56 die i mensis v annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2445822 05 v 5 05/01/1984 die i mensis v annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1258 {conversion of 1984-05-31} { clock format 454854896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1984 12:34:56 die xxxi mensis v annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2445852 05 v 5 05/31/1984 die xxxi mensis v annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1259 {conversion of 1984-06-01} { clock format 454941296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1984 12:34:56 die i mensis vi annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2445853 06 vi 6 06/01/1984 die i mensis vi annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1260 {conversion of 1984-06-30} { clock format 457446896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1984 12:34:56 die xxx mensis vi annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2445882 06 vi 6 06/30/1984 die xxx mensis vi annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1261 {conversion of 1984-07-01} { clock format 457533296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1984 12:34:56 die i mensis vii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2445883 07 vii 7 07/01/1984 die i mensis vii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1262 {conversion of 1984-07-31} { clock format 460125296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1984 12:34:56 die xxxi mensis vii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2445913 07 vii 7 07/31/1984 die xxxi mensis vii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1263 {conversion of 1984-08-01} { clock format 460211696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1984 12:34:56 die i mensis viii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2445914 08 viii 8 08/01/1984 die i mensis viii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1264 {conversion of 1984-08-31} { clock format 462803696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1984 12:34:56 die xxxi mensis viii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2445944 08 viii 8 08/31/1984 die xxxi mensis viii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1265 {conversion of 1984-09-01} { clock format 462890096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1984 12:34:56 die i mensis ix annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2445945 09 ix 9 09/01/1984 die i mensis ix annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1266 {conversion of 1984-09-30} { clock format 465395696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1984 12:34:56 die xxx mensis ix annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2445974 09 ix 9 09/30/1984 die xxx mensis ix annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1267 {conversion of 1984-10-01} { clock format 465482096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1984 12:34:56 die i mensis x annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2445975 10 x 10 10/01/1984 die i mensis x annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1268 {conversion of 1984-10-31} { clock format 468074096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1984 12:34:56 die xxxi mensis x annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2446005 10 x 10 10/31/1984 die xxxi mensis x annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1269 {conversion of 1984-11-01} { clock format 468160496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1984 12:34:56 die i mensis xi annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2446006 11 xi 11 11/01/1984 die i mensis xi annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1270 {conversion of 1984-11-30} { clock format 470666096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1984 12:34:56 die xxx mensis xi annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2446035 11 xi 11 11/30/1984 die xxx mensis xi annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1271 {conversion of 1984-12-01} { clock format 470752496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1984 12:34:56 die i mensis xii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2446036 12 xii 12 12/01/1984 die i mensis xii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1272 {conversion of 1984-12-31} { clock format 473344496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1984 12:34:56 die xxxi mensis xii annoque mcmlxxxiv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2446066 12 xii 12 12/31/1984 die xxxi mensis xii annoque mcmlxxxiv 84 lxxxiv 1984} test clock-2.1273 {conversion of 1985-01-01} { clock format 473430896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1985 12:34:56 die i mensis i annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2446067 01 i 1 01/01/1985 die i mensis i annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1274 {conversion of 1985-01-31} { clock format 476022896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1985 12:34:56 die xxxi mensis i annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2446097 01 i 1 01/31/1985 die xxxi mensis i annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1275 {conversion of 1985-02-01} { clock format 476109296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1985 12:34:56 die i mensis ii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2446098 02 ii 2 02/01/1985 die i mensis ii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1276 {conversion of 1985-02-28} { clock format 478442096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1985 12:34:56 die xxviii mensis ii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2446125 02 ii 2 02/28/1985 die xxviii mensis ii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1277 {conversion of 1985-03-01} { clock format 478528496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1985 12:34:56 die i mensis iii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2446126 03 iii 3 03/01/1985 die i mensis iii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1278 {conversion of 1985-03-31} { clock format 481120496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1985 12:34:56 die xxxi mensis iii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2446156 03 iii 3 03/31/1985 die xxxi mensis iii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1279 {conversion of 1985-04-01} { clock format 481206896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1985 12:34:56 die i mensis iv annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2446157 04 iv 4 04/01/1985 die i mensis iv annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1280 {conversion of 1985-04-30} { clock format 483712496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1985 12:34:56 die xxx mensis iv annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2446186 04 iv 4 04/30/1985 die xxx mensis iv annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1281 {conversion of 1985-05-01} { clock format 483798896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1985 12:34:56 die i mensis v annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2446187 05 v 5 05/01/1985 die i mensis v annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1282 {conversion of 1985-05-31} { clock format 486390896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1985 12:34:56 die xxxi mensis v annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2446217 05 v 5 05/31/1985 die xxxi mensis v annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1283 {conversion of 1985-06-01} { clock format 486477296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1985 12:34:56 die i mensis vi annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2446218 06 vi 6 06/01/1985 die i mensis vi annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1284 {conversion of 1985-06-30} { clock format 488982896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1985 12:34:56 die xxx mensis vi annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2446247 06 vi 6 06/30/1985 die xxx mensis vi annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1285 {conversion of 1985-07-01} { clock format 489069296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1985 12:34:56 die i mensis vii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2446248 07 vii 7 07/01/1985 die i mensis vii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1286 {conversion of 1985-07-31} { clock format 491661296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1985 12:34:56 die xxxi mensis vii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2446278 07 vii 7 07/31/1985 die xxxi mensis vii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1287 {conversion of 1985-08-01} { clock format 491747696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1985 12:34:56 die i mensis viii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2446279 08 viii 8 08/01/1985 die i mensis viii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1288 {conversion of 1985-08-31} { clock format 494339696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1985 12:34:56 die xxxi mensis viii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2446309 08 viii 8 08/31/1985 die xxxi mensis viii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1289 {conversion of 1985-09-01} { clock format 494426096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1985 12:34:56 die i mensis ix annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2446310 09 ix 9 09/01/1985 die i mensis ix annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1290 {conversion of 1985-09-30} { clock format 496931696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1985 12:34:56 die xxx mensis ix annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2446339 09 ix 9 09/30/1985 die xxx mensis ix annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1291 {conversion of 1985-10-01} { clock format 497018096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1985 12:34:56 die i mensis x annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2446340 10 x 10 10/01/1985 die i mensis x annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1292 {conversion of 1985-10-31} { clock format 499610096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1985 12:34:56 die xxxi mensis x annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2446370 10 x 10 10/31/1985 die xxxi mensis x annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1293 {conversion of 1985-11-01} { clock format 499696496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1985 12:34:56 die i mensis xi annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2446371 11 xi 11 11/01/1985 die i mensis xi annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1294 {conversion of 1985-11-30} { clock format 502202096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1985 12:34:56 die xxx mensis xi annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2446400 11 xi 11 11/30/1985 die xxx mensis xi annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1295 {conversion of 1985-12-01} { clock format 502288496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1985 12:34:56 die i mensis xii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2446401 12 xii 12 12/01/1985 die i mensis xii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1296 {conversion of 1985-12-31} { clock format 504880496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1985 12:34:56 die xxxi mensis xii annoque mcmlxxxv xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2446431 12 xii 12 12/31/1985 die xxxi mensis xii annoque mcmlxxxv 85 lxxxv 1985} test clock-2.1297 {conversion of 1988-01-01} { clock format 568038896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1988 12:34:56 die i mensis i annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2447162 01 i 1 01/01/1988 die i mensis i annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1298 {conversion of 1988-01-31} { clock format 570630896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1988 12:34:56 die xxxi mensis i annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2447192 01 i 1 01/31/1988 die xxxi mensis i annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1299 {conversion of 1988-02-01} { clock format 570717296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1988 12:34:56 die i mensis ii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2447193 02 ii 2 02/01/1988 die i mensis ii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1300 {conversion of 1988-02-29} { clock format 573136496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1988 12:34:56 die xxix mensis ii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2447221 02 ii 2 02/29/1988 die xxix mensis ii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1301 {conversion of 1988-03-01} { clock format 573222896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1988 12:34:56 die i mensis iii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2447222 03 iii 3 03/01/1988 die i mensis iii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1302 {conversion of 1988-03-31} { clock format 575814896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1988 12:34:56 die xxxi mensis iii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2447252 03 iii 3 03/31/1988 die xxxi mensis iii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1303 {conversion of 1988-04-01} { clock format 575901296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1988 12:34:56 die i mensis iv annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2447253 04 iv 4 04/01/1988 die i mensis iv annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1304 {conversion of 1988-04-30} { clock format 578406896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1988 12:34:56 die xxx mensis iv annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2447282 04 iv 4 04/30/1988 die xxx mensis iv annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1305 {conversion of 1988-05-01} { clock format 578493296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1988 12:34:56 die i mensis v annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2447283 05 v 5 05/01/1988 die i mensis v annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1306 {conversion of 1988-05-31} { clock format 581085296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1988 12:34:56 die xxxi mensis v annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2447313 05 v 5 05/31/1988 die xxxi mensis v annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1307 {conversion of 1988-06-01} { clock format 581171696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1988 12:34:56 die i mensis vi annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2447314 06 vi 6 06/01/1988 die i mensis vi annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1308 {conversion of 1988-06-30} { clock format 583677296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1988 12:34:56 die xxx mensis vi annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2447343 06 vi 6 06/30/1988 die xxx mensis vi annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1309 {conversion of 1988-07-01} { clock format 583763696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1988 12:34:56 die i mensis vii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2447344 07 vii 7 07/01/1988 die i mensis vii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1310 {conversion of 1988-07-31} { clock format 586355696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1988 12:34:56 die xxxi mensis vii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2447374 07 vii 7 07/31/1988 die xxxi mensis vii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1311 {conversion of 1988-08-01} { clock format 586442096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1988 12:34:56 die i mensis viii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2447375 08 viii 8 08/01/1988 die i mensis viii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1312 {conversion of 1988-08-31} { clock format 589034096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1988 12:34:56 die xxxi mensis viii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2447405 08 viii 8 08/31/1988 die xxxi mensis viii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1313 {conversion of 1988-09-01} { clock format 589120496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1988 12:34:56 die i mensis ix annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2447406 09 ix 9 09/01/1988 die i mensis ix annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1314 {conversion of 1988-09-30} { clock format 591626096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1988 12:34:56 die xxx mensis ix annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2447435 09 ix 9 09/30/1988 die xxx mensis ix annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1315 {conversion of 1988-10-01} { clock format 591712496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1988 12:34:56 die i mensis x annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2447436 10 x 10 10/01/1988 die i mensis x annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1316 {conversion of 1988-10-31} { clock format 594304496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1988 12:34:56 die xxxi mensis x annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2447466 10 x 10 10/31/1988 die xxxi mensis x annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1317 {conversion of 1988-11-01} { clock format 594390896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1988 12:34:56 die i mensis xi annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2447467 11 xi 11 11/01/1988 die i mensis xi annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1318 {conversion of 1988-11-30} { clock format 596896496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1988 12:34:56 die xxx mensis xi annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2447496 11 xi 11 11/30/1988 die xxx mensis xi annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1319 {conversion of 1988-12-01} { clock format 596982896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1988 12:34:56 die i mensis xii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2447497 12 xii 12 12/01/1988 die i mensis xii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1320 {conversion of 1988-12-31} { clock format 599574896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1988 12:34:56 die xxxi mensis xii annoque mcmlxxxviii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2447527 12 xii 12 12/31/1988 die xxxi mensis xii annoque mcmlxxxviii 88 lxxxviii 1988} test clock-2.1321 {conversion of 1989-01-01} { clock format 599661296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1989 12:34:56 die i mensis i annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2447528 01 i 1 01/01/1989 die i mensis i annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1322 {conversion of 1989-01-31} { clock format 602253296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1989 12:34:56 die xxxi mensis i annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2447558 01 i 1 01/31/1989 die xxxi mensis i annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1323 {conversion of 1989-02-01} { clock format 602339696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1989 12:34:56 die i mensis ii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2447559 02 ii 2 02/01/1989 die i mensis ii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1324 {conversion of 1989-02-28} { clock format 604672496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1989 12:34:56 die xxviii mensis ii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2447586 02 ii 2 02/28/1989 die xxviii mensis ii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1325 {conversion of 1989-03-01} { clock format 604758896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1989 12:34:56 die i mensis iii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2447587 03 iii 3 03/01/1989 die i mensis iii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1326 {conversion of 1989-03-31} { clock format 607350896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1989 12:34:56 die xxxi mensis iii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2447617 03 iii 3 03/31/1989 die xxxi mensis iii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1327 {conversion of 1989-04-01} { clock format 607437296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1989 12:34:56 die i mensis iv annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2447618 04 iv 4 04/01/1989 die i mensis iv annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1328 {conversion of 1989-04-30} { clock format 609942896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1989 12:34:56 die xxx mensis iv annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2447647 04 iv 4 04/30/1989 die xxx mensis iv annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1329 {conversion of 1989-05-01} { clock format 610029296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1989 12:34:56 die i mensis v annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2447648 05 v 5 05/01/1989 die i mensis v annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1330 {conversion of 1989-05-31} { clock format 612621296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1989 12:34:56 die xxxi mensis v annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2447678 05 v 5 05/31/1989 die xxxi mensis v annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1331 {conversion of 1989-06-01} { clock format 612707696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1989 12:34:56 die i mensis vi annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2447679 06 vi 6 06/01/1989 die i mensis vi annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1332 {conversion of 1989-06-30} { clock format 615213296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1989 12:34:56 die xxx mensis vi annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2447708 06 vi 6 06/30/1989 die xxx mensis vi annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1333 {conversion of 1989-07-01} { clock format 615299696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1989 12:34:56 die i mensis vii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2447709 07 vii 7 07/01/1989 die i mensis vii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1334 {conversion of 1989-07-31} { clock format 617891696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1989 12:34:56 die xxxi mensis vii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2447739 07 vii 7 07/31/1989 die xxxi mensis vii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1335 {conversion of 1989-08-01} { clock format 617978096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1989 12:34:56 die i mensis viii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2447740 08 viii 8 08/01/1989 die i mensis viii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1336 {conversion of 1989-08-31} { clock format 620570096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1989 12:34:56 die xxxi mensis viii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2447770 08 viii 8 08/31/1989 die xxxi mensis viii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1337 {conversion of 1989-09-01} { clock format 620656496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1989 12:34:56 die i mensis ix annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2447771 09 ix 9 09/01/1989 die i mensis ix annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1338 {conversion of 1989-09-30} { clock format 623162096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1989 12:34:56 die xxx mensis ix annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2447800 09 ix 9 09/30/1989 die xxx mensis ix annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1339 {conversion of 1989-10-01} { clock format 623248496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1989 12:34:56 die i mensis x annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2447801 10 x 10 10/01/1989 die i mensis x annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1340 {conversion of 1989-10-31} { clock format 625840496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1989 12:34:56 die xxxi mensis x annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2447831 10 x 10 10/31/1989 die xxxi mensis x annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1341 {conversion of 1989-11-01} { clock format 625926896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1989 12:34:56 die i mensis xi annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2447832 11 xi 11 11/01/1989 die i mensis xi annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1342 {conversion of 1989-11-30} { clock format 628432496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1989 12:34:56 die xxx mensis xi annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2447861 11 xi 11 11/30/1989 die xxx mensis xi annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1343 {conversion of 1989-12-01} { clock format 628518896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1989 12:34:56 die i mensis xii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2447862 12 xii 12 12/01/1989 die i mensis xii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1344 {conversion of 1989-12-31} { clock format 631110896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1989 12:34:56 die xxxi mensis xii annoque mcmlxxxix xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2447892 12 xii 12 12/31/1989 die xxxi mensis xii annoque mcmlxxxix 89 lxxxix 1989} test clock-2.1345 {conversion of 1992-01-01} { clock format 694269296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1992 12:34:56 die i mensis i annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2448623 01 i 1 01/01/1992 die i mensis i annoque mcmxcii 92 xcii 1992} test clock-2.1346 {conversion of 1992-01-31} { clock format 696861296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1992 12:34:56 die xxxi mensis i annoque mcmxcii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2448653 01 i 1 01/31/1992 die xxxi mensis i annoque mcmxcii 92 xcii 1992} test clock-2.1347 {conversion of 1992-02-01} { clock format 696947696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1992 12:34:56 die i mensis ii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2448654 02 ii 2 02/01/1992 die i mensis ii annoque mcmxcii 92 xcii 1992} test clock-2.1348 {conversion of 1992-02-29} { clock format 699366896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1992 12:34:56 die xxix mensis ii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2448682 02 ii 2 02/29/1992 die xxix mensis ii annoque mcmxcii 92 xcii 1992} test clock-2.1349 {conversion of 1992-03-01} { clock format 699453296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1992 12:34:56 die i mensis iii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2448683 03 iii 3 03/01/1992 die i mensis iii annoque mcmxcii 92 xcii 1992} test clock-2.1350 {conversion of 1992-03-31} { clock format 702045296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1992 12:34:56 die xxxi mensis iii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2448713 03 iii 3 03/31/1992 die xxxi mensis iii annoque mcmxcii 92 xcii 1992} test clock-2.1351 {conversion of 1992-04-01} { clock format 702131696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1992 12:34:56 die i mensis iv annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2448714 04 iv 4 04/01/1992 die i mensis iv annoque mcmxcii 92 xcii 1992} test clock-2.1352 {conversion of 1992-04-30} { clock format 704637296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1992 12:34:56 die xxx mensis iv annoque mcmxcii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2448743 04 iv 4 04/30/1992 die xxx mensis iv annoque mcmxcii 92 xcii 1992} test clock-2.1353 {conversion of 1992-05-01} { clock format 704723696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1992 12:34:56 die i mensis v annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2448744 05 v 5 05/01/1992 die i mensis v annoque mcmxcii 92 xcii 1992} test clock-2.1354 {conversion of 1992-05-31} { clock format 707315696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1992 12:34:56 die xxxi mensis v annoque mcmxcii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2448774 05 v 5 05/31/1992 die xxxi mensis v annoque mcmxcii 92 xcii 1992} test clock-2.1355 {conversion of 1992-06-01} { clock format 707402096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1992 12:34:56 die i mensis vi annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2448775 06 vi 6 06/01/1992 die i mensis vi annoque mcmxcii 92 xcii 1992} test clock-2.1356 {conversion of 1992-06-30} { clock format 709907696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1992 12:34:56 die xxx mensis vi annoque mcmxcii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2448804 06 vi 6 06/30/1992 die xxx mensis vi annoque mcmxcii 92 xcii 1992} test clock-2.1357 {conversion of 1992-07-01} { clock format 709994096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1992 12:34:56 die i mensis vii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2448805 07 vii 7 07/01/1992 die i mensis vii annoque mcmxcii 92 xcii 1992} test clock-2.1358 {conversion of 1992-07-31} { clock format 712586096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1992 12:34:56 die xxxi mensis vii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2448835 07 vii 7 07/31/1992 die xxxi mensis vii annoque mcmxcii 92 xcii 1992} test clock-2.1359 {conversion of 1992-08-01} { clock format 712672496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1992 12:34:56 die i mensis viii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2448836 08 viii 8 08/01/1992 die i mensis viii annoque mcmxcii 92 xcii 1992} test clock-2.1360 {conversion of 1992-08-31} { clock format 715264496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1992 12:34:56 die xxxi mensis viii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2448866 08 viii 8 08/31/1992 die xxxi mensis viii annoque mcmxcii 92 xcii 1992} test clock-2.1361 {conversion of 1992-09-01} { clock format 715350896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1992 12:34:56 die i mensis ix annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2448867 09 ix 9 09/01/1992 die i mensis ix annoque mcmxcii 92 xcii 1992} test clock-2.1362 {conversion of 1992-09-30} { clock format 717856496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1992 12:34:56 die xxx mensis ix annoque mcmxcii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2448896 09 ix 9 09/30/1992 die xxx mensis ix annoque mcmxcii 92 xcii 1992} test clock-2.1363 {conversion of 1992-10-01} { clock format 717942896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1992 12:34:56 die i mensis x annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2448897 10 x 10 10/01/1992 die i mensis x annoque mcmxcii 92 xcii 1992} test clock-2.1364 {conversion of 1992-10-31} { clock format 720534896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1992 12:34:56 die xxxi mensis x annoque mcmxcii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2448927 10 x 10 10/31/1992 die xxxi mensis x annoque mcmxcii 92 xcii 1992} test clock-2.1365 {conversion of 1992-11-01} { clock format 720621296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1992 12:34:56 die i mensis xi annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2448928 11 xi 11 11/01/1992 die i mensis xi annoque mcmxcii 92 xcii 1992} test clock-2.1366 {conversion of 1992-11-30} { clock format 723126896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1992 12:34:56 die xxx mensis xi annoque mcmxcii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2448957 11 xi 11 11/30/1992 die xxx mensis xi annoque mcmxcii 92 xcii 1992} test clock-2.1367 {conversion of 1992-12-01} { clock format 723213296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1992 12:34:56 die i mensis xii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2448958 12 xii 12 12/01/1992 die i mensis xii annoque mcmxcii 92 xcii 1992} test clock-2.1368 {conversion of 1992-12-31} { clock format 725805296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1992 12:34:56 die xxxi mensis xii annoque mcmxcii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2448988 12 xii 12 12/31/1992 die xxxi mensis xii annoque mcmxcii 92 xcii 1992} test clock-2.1369 {conversion of 1993-01-01} { clock format 725891696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1993 12:34:56 die i mensis i annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2448989 01 i 1 01/01/1993 die i mensis i annoque mcmxciii 93 xciii 1993} test clock-2.1370 {conversion of 1993-01-31} { clock format 728483696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1993 12:34:56 die xxxi mensis i annoque mcmxciii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2449019 01 i 1 01/31/1993 die xxxi mensis i annoque mcmxciii 93 xciii 1993} test clock-2.1371 {conversion of 1993-02-01} { clock format 728570096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1993 12:34:56 die i mensis ii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2449020 02 ii 2 02/01/1993 die i mensis ii annoque mcmxciii 93 xciii 1993} test clock-2.1372 {conversion of 1993-02-28} { clock format 730902896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1993 12:34:56 die xxviii mensis ii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2449047 02 ii 2 02/28/1993 die xxviii mensis ii annoque mcmxciii 93 xciii 1993} test clock-2.1373 {conversion of 1993-03-01} { clock format 730989296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1993 12:34:56 die i mensis iii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2449048 03 iii 3 03/01/1993 die i mensis iii annoque mcmxciii 93 xciii 1993} test clock-2.1374 {conversion of 1993-03-31} { clock format 733581296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1993 12:34:56 die xxxi mensis iii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2449078 03 iii 3 03/31/1993 die xxxi mensis iii annoque mcmxciii 93 xciii 1993} test clock-2.1375 {conversion of 1993-04-01} { clock format 733667696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1993 12:34:56 die i mensis iv annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2449079 04 iv 4 04/01/1993 die i mensis iv annoque mcmxciii 93 xciii 1993} test clock-2.1376 {conversion of 1993-04-30} { clock format 736173296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1993 12:34:56 die xxx mensis iv annoque mcmxciii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2449108 04 iv 4 04/30/1993 die xxx mensis iv annoque mcmxciii 93 xciii 1993} test clock-2.1377 {conversion of 1993-05-01} { clock format 736259696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1993 12:34:56 die i mensis v annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2449109 05 v 5 05/01/1993 die i mensis v annoque mcmxciii 93 xciii 1993} test clock-2.1378 {conversion of 1993-05-31} { clock format 738851696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1993 12:34:56 die xxxi mensis v annoque mcmxciii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2449139 05 v 5 05/31/1993 die xxxi mensis v annoque mcmxciii 93 xciii 1993} test clock-2.1379 {conversion of 1993-06-01} { clock format 738938096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1993 12:34:56 die i mensis vi annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2449140 06 vi 6 06/01/1993 die i mensis vi annoque mcmxciii 93 xciii 1993} test clock-2.1380 {conversion of 1993-06-30} { clock format 741443696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1993 12:34:56 die xxx mensis vi annoque mcmxciii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2449169 06 vi 6 06/30/1993 die xxx mensis vi annoque mcmxciii 93 xciii 1993} test clock-2.1381 {conversion of 1993-07-01} { clock format 741530096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1993 12:34:56 die i mensis vii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2449170 07 vii 7 07/01/1993 die i mensis vii annoque mcmxciii 93 xciii 1993} test clock-2.1382 {conversion of 1993-07-31} { clock format 744122096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1993 12:34:56 die xxxi mensis vii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2449200 07 vii 7 07/31/1993 die xxxi mensis vii annoque mcmxciii 93 xciii 1993} test clock-2.1383 {conversion of 1993-08-01} { clock format 744208496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1993 12:34:56 die i mensis viii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2449201 08 viii 8 08/01/1993 die i mensis viii annoque mcmxciii 93 xciii 1993} test clock-2.1384 {conversion of 1993-08-31} { clock format 746800496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1993 12:34:56 die xxxi mensis viii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2449231 08 viii 8 08/31/1993 die xxxi mensis viii annoque mcmxciii 93 xciii 1993} test clock-2.1385 {conversion of 1993-09-01} { clock format 746886896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1993 12:34:56 die i mensis ix annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2449232 09 ix 9 09/01/1993 die i mensis ix annoque mcmxciii 93 xciii 1993} test clock-2.1386 {conversion of 1993-09-30} { clock format 749392496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1993 12:34:56 die xxx mensis ix annoque mcmxciii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2449261 09 ix 9 09/30/1993 die xxx mensis ix annoque mcmxciii 93 xciii 1993} test clock-2.1387 {conversion of 1993-10-01} { clock format 749478896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1993 12:34:56 die i mensis x annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2449262 10 x 10 10/01/1993 die i mensis x annoque mcmxciii 93 xciii 1993} test clock-2.1388 {conversion of 1993-10-31} { clock format 752070896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1993 12:34:56 die xxxi mensis x annoque mcmxciii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2449292 10 x 10 10/31/1993 die xxxi mensis x annoque mcmxciii 93 xciii 1993} test clock-2.1389 {conversion of 1993-11-01} { clock format 752157296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1993 12:34:56 die i mensis xi annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2449293 11 xi 11 11/01/1993 die i mensis xi annoque mcmxciii 93 xciii 1993} test clock-2.1390 {conversion of 1993-11-30} { clock format 754662896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1993 12:34:56 die xxx mensis xi annoque mcmxciii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2449322 11 xi 11 11/30/1993 die xxx mensis xi annoque mcmxciii 93 xciii 1993} test clock-2.1391 {conversion of 1993-12-01} { clock format 754749296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1993 12:34:56 die i mensis xii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2449323 12 xii 12 12/01/1993 die i mensis xii annoque mcmxciii 93 xciii 1993} test clock-2.1392 {conversion of 1993-12-31} { clock format 757341296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1993 12:34:56 die xxxi mensis xii annoque mcmxciii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2449353 12 xii 12 12/31/1993 die xxxi mensis xii annoque mcmxciii 93 xciii 1993} test clock-2.1393 {conversion of 1996-01-01} { clock format 820499696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1996 12:34:56 die i mensis i annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2450084 01 i 1 01/01/1996 die i mensis i annoque mcmxcvi 96 xcvi 1996} test clock-2.1394 {conversion of 1996-01-31} { clock format 823091696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1996 12:34:56 die xxxi mensis i annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2450114 01 i 1 01/31/1996 die xxxi mensis i annoque mcmxcvi 96 xcvi 1996} test clock-2.1395 {conversion of 1996-02-01} { clock format 823178096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1996 12:34:56 die i mensis ii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2450115 02 ii 2 02/01/1996 die i mensis ii annoque mcmxcvi 96 xcvi 1996} test clock-2.1396 {conversion of 1996-02-29} { clock format 825597296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/1996 12:34:56 die xxix mensis ii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 29 xxix 29 xxix Feb 060 2450143 02 ii 2 02/29/1996 die xxix mensis ii annoque mcmxcvi 96 xcvi 1996} test clock-2.1397 {conversion of 1996-03-01} { clock format 825683696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1996 12:34:56 die i mensis iii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 061 2450144 03 iii 3 03/01/1996 die i mensis iii annoque mcmxcvi 96 xcvi 1996} test clock-2.1398 {conversion of 1996-03-31} { clock format 828275696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1996 12:34:56 die xxxi mensis iii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 091 2450174 03 iii 3 03/31/1996 die xxxi mensis iii annoque mcmxcvi 96 xcvi 1996} test clock-2.1399 {conversion of 1996-04-01} { clock format 828362096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1996 12:34:56 die i mensis iv annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 092 2450175 04 iv 4 04/01/1996 die i mensis iv annoque mcmxcvi 96 xcvi 1996} test clock-2.1400 {conversion of 1996-04-30} { clock format 830867696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1996 12:34:56 die xxx mensis iv annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 121 2450204 04 iv 4 04/30/1996 die xxx mensis iv annoque mcmxcvi 96 xcvi 1996} test clock-2.1401 {conversion of 1996-05-01} { clock format 830954096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1996 12:34:56 die i mensis v annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i May 122 2450205 05 v 5 05/01/1996 die i mensis v annoque mcmxcvi 96 xcvi 1996} test clock-2.1402 {conversion of 1996-05-31} { clock format 833546096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1996 12:34:56 die xxxi mensis v annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 152 2450235 05 v 5 05/31/1996 die xxxi mensis v annoque mcmxcvi 96 xcvi 1996} test clock-2.1403 {conversion of 1996-06-01} { clock format 833632496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1996 12:34:56 die i mensis vi annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 153 2450236 06 vi 6 06/01/1996 die i mensis vi annoque mcmxcvi 96 xcvi 1996} test clock-2.1404 {conversion of 1996-06-30} { clock format 836138096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1996 12:34:56 die xxx mensis vi annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 182 2450265 06 vi 6 06/30/1996 die xxx mensis vi annoque mcmxcvi 96 xcvi 1996} test clock-2.1405 {conversion of 1996-07-01} { clock format 836224496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1996 12:34:56 die i mensis vii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 183 2450266 07 vii 7 07/01/1996 die i mensis vii annoque mcmxcvi 96 xcvi 1996} test clock-2.1406 {conversion of 1996-07-31} { clock format 838816496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1996 12:34:56 die xxxi mensis vii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 213 2450296 07 vii 7 07/31/1996 die xxxi mensis vii annoque mcmxcvi 96 xcvi 1996} test clock-2.1407 {conversion of 1996-08-01} { clock format 838902896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1996 12:34:56 die i mensis viii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 214 2450297 08 viii 8 08/01/1996 die i mensis viii annoque mcmxcvi 96 xcvi 1996} test clock-2.1408 {conversion of 1996-08-31} { clock format 841494896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1996 12:34:56 die xxxi mensis viii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 244 2450327 08 viii 8 08/31/1996 die xxxi mensis viii annoque mcmxcvi 96 xcvi 1996} test clock-2.1409 {conversion of 1996-09-01} { clock format 841581296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1996 12:34:56 die i mensis ix annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 245 2450328 09 ix 9 09/01/1996 die i mensis ix annoque mcmxcvi 96 xcvi 1996} test clock-2.1410 {conversion of 1996-09-30} { clock format 844086896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1996 12:34:56 die xxx mensis ix annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 274 2450357 09 ix 9 09/30/1996 die xxx mensis ix annoque mcmxcvi 96 xcvi 1996} test clock-2.1411 {conversion of 1996-10-01} { clock format 844173296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1996 12:34:56 die i mensis x annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 275 2450358 10 x 10 10/01/1996 die i mensis x annoque mcmxcvi 96 xcvi 1996} test clock-2.1412 {conversion of 1996-10-31} { clock format 846765296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1996 12:34:56 die xxxi mensis x annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 305 2450388 10 x 10 10/31/1996 die xxxi mensis x annoque mcmxcvi 96 xcvi 1996} test clock-2.1413 {conversion of 1996-11-01} { clock format 846851696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1996 12:34:56 die i mensis xi annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 306 2450389 11 xi 11 11/01/1996 die i mensis xi annoque mcmxcvi 96 xcvi 1996} test clock-2.1414 {conversion of 1996-11-30} { clock format 849357296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1996 12:34:56 die xxx mensis xi annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 335 2450418 11 xi 11 11/30/1996 die xxx mensis xi annoque mcmxcvi 96 xcvi 1996} test clock-2.1415 {conversion of 1996-12-01} { clock format 849443696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1996 12:34:56 die i mensis xii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 336 2450419 12 xii 12 12/01/1996 die i mensis xii annoque mcmxcvi 96 xcvi 1996} test clock-2.1416 {conversion of 1996-12-31} { clock format 852035696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1996 12:34:56 die xxxi mensis xii annoque mcmxcvi xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 366 2450449 12 xii 12 12/31/1996 die xxxi mensis xii annoque mcmxcvi 96 xcvi 1996} test clock-2.1417 {conversion of 1997-01-01} { clock format 852122096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/1997 12:34:56 die i mensis i annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jan 001 2450450 01 i 1 01/01/1997 die i mensis i annoque mcmxcvii 97 xcvii 1997} test clock-2.1418 {conversion of 1997-01-31} { clock format 854714096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/1997 12:34:56 die xxxi mensis i annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jan 031 2450480 01 i 1 01/31/1997 die xxxi mensis i annoque mcmxcvii 97 xcvii 1997} test clock-2.1419 {conversion of 1997-02-01} { clock format 854800496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/1997 12:34:56 die i mensis ii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Feb 032 2450481 02 ii 2 02/01/1997 die i mensis ii annoque mcmxcvii 97 xcvii 1997} test clock-2.1420 {conversion of 1997-02-28} { clock format 857133296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/1997 12:34:56 die xxviii mensis ii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 28 xxviii 28 xxviii Feb 059 2450508 02 ii 2 02/28/1997 die xxviii mensis ii annoque mcmxcvii 97 xcvii 1997} test clock-2.1421 {conversion of 1997-03-01} { clock format 857219696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/1997 12:34:56 die i mensis iii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Mar 060 2450509 03 iii 3 03/01/1997 die i mensis iii annoque mcmxcvii 97 xcvii 1997} test clock-2.1422 {conversion of 1997-03-31} { clock format 859811696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/1997 12:34:56 die xxxi mensis iii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Mar 090 2450539 03 iii 3 03/31/1997 die xxxi mensis iii annoque mcmxcvii 97 xcvii 1997} test clock-2.1423 {conversion of 1997-04-01} { clock format 859898096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/1997 12:34:56 die i mensis iv annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Apr 091 2450540 04 iv 4 04/01/1997 die i mensis iv annoque mcmxcvii 97 xcvii 1997} test clock-2.1424 {conversion of 1997-04-30} { clock format 862403696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/1997 12:34:56 die xxx mensis iv annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Apr 120 2450569 04 iv 4 04/30/1997 die xxx mensis iv annoque mcmxcvii 97 xcvii 1997} test clock-2.1425 {conversion of 1997-05-01} { clock format 862490096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/1997 12:34:56 die i mensis v annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i May 121 2450570 05 v 5 05/01/1997 die i mensis v annoque mcmxcvii 97 xcvii 1997} test clock-2.1426 {conversion of 1997-05-31} { clock format 865082096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/1997 12:34:56 die xxxi mensis v annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi May 151 2450600 05 v 5 05/31/1997 die xxxi mensis v annoque mcmxcvii 97 xcvii 1997} test clock-2.1427 {conversion of 1997-06-01} { clock format 865168496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/1997 12:34:56 die i mensis vi annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jun 152 2450601 06 vi 6 06/01/1997 die i mensis vi annoque mcmxcvii 97 xcvii 1997} test clock-2.1428 {conversion of 1997-06-30} { clock format 867674096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/1997 12:34:56 die xxx mensis vi annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Jun 181 2450630 06 vi 6 06/30/1997 die xxx mensis vi annoque mcmxcvii 97 xcvii 1997} test clock-2.1429 {conversion of 1997-07-01} { clock format 867760496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/1997 12:34:56 die i mensis vii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Jul 182 2450631 07 vii 7 07/01/1997 die i mensis vii annoque mcmxcvii 97 xcvii 1997} test clock-2.1430 {conversion of 1997-07-31} { clock format 870352496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/1997 12:34:56 die xxxi mensis vii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Jul 212 2450661 07 vii 7 07/31/1997 die xxxi mensis vii annoque mcmxcvii 97 xcvii 1997} test clock-2.1431 {conversion of 1997-08-01} { clock format 870438896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/1997 12:34:56 die i mensis viii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Aug 213 2450662 08 viii 8 08/01/1997 die i mensis viii annoque mcmxcvii 97 xcvii 1997} test clock-2.1432 {conversion of 1997-08-31} { clock format 873030896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/1997 12:34:56 die xxxi mensis viii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Aug 243 2450692 08 viii 8 08/31/1997 die xxxi mensis viii annoque mcmxcvii 97 xcvii 1997} test clock-2.1433 {conversion of 1997-09-01} { clock format 873117296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/1997 12:34:56 die i mensis ix annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Sep 244 2450693 09 ix 9 09/01/1997 die i mensis ix annoque mcmxcvii 97 xcvii 1997} test clock-2.1434 {conversion of 1997-09-30} { clock format 875622896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/1997 12:34:56 die xxx mensis ix annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Sep 273 2450722 09 ix 9 09/30/1997 die xxx mensis ix annoque mcmxcvii 97 xcvii 1997} test clock-2.1435 {conversion of 1997-10-01} { clock format 875709296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/1997 12:34:56 die i mensis x annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Oct 274 2450723 10 x 10 10/01/1997 die i mensis x annoque mcmxcvii 97 xcvii 1997} test clock-2.1436 {conversion of 1997-10-31} { clock format 878301296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/1997 12:34:56 die xxxi mensis x annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Oct 304 2450753 10 x 10 10/31/1997 die xxxi mensis x annoque mcmxcvii 97 xcvii 1997} test clock-2.1437 {conversion of 1997-11-01} { clock format 878387696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/1997 12:34:56 die i mensis xi annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Nov 305 2450754 11 xi 11 11/01/1997 die i mensis xi annoque mcmxcvii 97 xcvii 1997} test clock-2.1438 {conversion of 1997-11-30} { clock format 880893296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/1997 12:34:56 die xxx mensis xi annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 30 xxx 30 xxx Nov 334 2450783 11 xi 11 11/30/1997 die xxx mensis xi annoque mcmxcvii 97 xcvii 1997} test clock-2.1439 {conversion of 1997-12-01} { clock format 880979696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/1997 12:34:56 die i mensis xii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 01 i 1 i Dec 335 2450784 12 xii 12 12/01/1997 die i mensis xii annoque mcmxcvii 97 xcvii 1997} test clock-2.1440 {conversion of 1997-12-31} { clock format 883571696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/1997 12:34:56 die xxxi mensis xii annoque mcmxcvii xii h xxxiv m lvi s 19 mcm 31 xxxi 31 xxxi Dec 365 2450814 12 xii 12 12/31/1997 die xxxi mensis xii annoque mcmxcvii 97 xcvii 1997} test clock-2.1441 {conversion of 2000-01-01} { clock format 946730096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2000 12:34:56 die i mensis i annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2451545 01 i 1 01/01/2000 die i mensis i annoque mm? 00 ? 2000} test clock-2.1442 {conversion of 2000-01-31} { clock format 949322096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2000 12:34:56 die xxxi mensis i annoque mm? xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2451575 01 i 1 01/31/2000 die xxxi mensis i annoque mm? 00 ? 2000} test clock-2.1443 {conversion of 2000-02-01} { clock format 949408496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2000 12:34:56 die i mensis ii annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2451576 02 ii 2 02/01/2000 die i mensis ii annoque mm? 00 ? 2000} test clock-2.1444 {conversion of 2000-02-29} { clock format 951827696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2000 12:34:56 die xxix mensis ii annoque mm? xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2451604 02 ii 2 02/29/2000 die xxix mensis ii annoque mm? 00 ? 2000} test clock-2.1445 {conversion of 2000-03-01} { clock format 951914096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2000 12:34:56 die i mensis iii annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2451605 03 iii 3 03/01/2000 die i mensis iii annoque mm? 00 ? 2000} test clock-2.1446 {conversion of 2000-03-31} { clock format 954506096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2000 12:34:56 die xxxi mensis iii annoque mm? xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2451635 03 iii 3 03/31/2000 die xxxi mensis iii annoque mm? 00 ? 2000} test clock-2.1447 {conversion of 2000-04-01} { clock format 954592496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2000 12:34:56 die i mensis iv annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2451636 04 iv 4 04/01/2000 die i mensis iv annoque mm? 00 ? 2000} test clock-2.1448 {conversion of 2000-04-30} { clock format 957098096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2000 12:34:56 die xxx mensis iv annoque mm? xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2451665 04 iv 4 04/30/2000 die xxx mensis iv annoque mm? 00 ? 2000} test clock-2.1449 {conversion of 2000-05-01} { clock format 957184496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2000 12:34:56 die i mensis v annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2451666 05 v 5 05/01/2000 die i mensis v annoque mm? 00 ? 2000} test clock-2.1450 {conversion of 2000-05-31} { clock format 959776496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2000 12:34:56 die xxxi mensis v annoque mm? xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2451696 05 v 5 05/31/2000 die xxxi mensis v annoque mm? 00 ? 2000} test clock-2.1451 {conversion of 2000-06-01} { clock format 959862896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2000 12:34:56 die i mensis vi annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2451697 06 vi 6 06/01/2000 die i mensis vi annoque mm? 00 ? 2000} test clock-2.1452 {conversion of 2000-06-30} { clock format 962368496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2000 12:34:56 die xxx mensis vi annoque mm? xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2451726 06 vi 6 06/30/2000 die xxx mensis vi annoque mm? 00 ? 2000} test clock-2.1453 {conversion of 2000-07-01} { clock format 962454896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2000 12:34:56 die i mensis vii annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2451727 07 vii 7 07/01/2000 die i mensis vii annoque mm? 00 ? 2000} test clock-2.1454 {conversion of 2000-07-31} { clock format 965046896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2000 12:34:56 die xxxi mensis vii annoque mm? xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2451757 07 vii 7 07/31/2000 die xxxi mensis vii annoque mm? 00 ? 2000} test clock-2.1455 {conversion of 2000-08-01} { clock format 965133296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2000 12:34:56 die i mensis viii annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2451758 08 viii 8 08/01/2000 die i mensis viii annoque mm? 00 ? 2000} test clock-2.1456 {conversion of 2000-08-31} { clock format 967725296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2000 12:34:56 die xxxi mensis viii annoque mm? xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2451788 08 viii 8 08/31/2000 die xxxi mensis viii annoque mm? 00 ? 2000} test clock-2.1457 {conversion of 2000-09-01} { clock format 967811696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2000 12:34:56 die i mensis ix annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2451789 09 ix 9 09/01/2000 die i mensis ix annoque mm? 00 ? 2000} test clock-2.1458 {conversion of 2000-09-30} { clock format 970317296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2000 12:34:56 die xxx mensis ix annoque mm? xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2451818 09 ix 9 09/30/2000 die xxx mensis ix annoque mm? 00 ? 2000} test clock-2.1459 {conversion of 2000-10-01} { clock format 970403696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2000 12:34:56 die i mensis x annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2451819 10 x 10 10/01/2000 die i mensis x annoque mm? 00 ? 2000} test clock-2.1460 {conversion of 2000-10-31} { clock format 972995696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2000 12:34:56 die xxxi mensis x annoque mm? xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2451849 10 x 10 10/31/2000 die xxxi mensis x annoque mm? 00 ? 2000} test clock-2.1461 {conversion of 2000-11-01} { clock format 973082096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2000 12:34:56 die i mensis xi annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2451850 11 xi 11 11/01/2000 die i mensis xi annoque mm? 00 ? 2000} test clock-2.1462 {conversion of 2000-11-30} { clock format 975587696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2000 12:34:56 die xxx mensis xi annoque mm? xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2451879 11 xi 11 11/30/2000 die xxx mensis xi annoque mm? 00 ? 2000} test clock-2.1463 {conversion of 2000-12-01} { clock format 975674096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2000 12:34:56 die i mensis xii annoque mm? xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2451880 12 xii 12 12/01/2000 die i mensis xii annoque mm? 00 ? 2000} test clock-2.1464 {conversion of 2000-12-31} { clock format 978266096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2000 12:34:56 die xxxi mensis xii annoque mm? xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2451910 12 xii 12 12/31/2000 die xxxi mensis xii annoque mm? 00 ? 2000} test clock-2.1465 {conversion of 2001-01-01} { clock format 978352496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2001 12:34:56 die i mensis i annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2451911 01 i 1 01/01/2001 die i mensis i annoque mmi 01 i 2001} test clock-2.1466 {conversion of 2001-01-31} { clock format 980944496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2001 12:34:56 die xxxi mensis i annoque mmi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2451941 01 i 1 01/31/2001 die xxxi mensis i annoque mmi 01 i 2001} test clock-2.1467 {conversion of 2001-02-01} { clock format 981030896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2001 12:34:56 die i mensis ii annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2451942 02 ii 2 02/01/2001 die i mensis ii annoque mmi 01 i 2001} test clock-2.1468 {conversion of 2001-02-28} { clock format 983363696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2001 12:34:56 die xxviii mensis ii annoque mmi xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2451969 02 ii 2 02/28/2001 die xxviii mensis ii annoque mmi 01 i 2001} test clock-2.1469 {conversion of 2001-03-01} { clock format 983450096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2001 12:34:56 die i mensis iii annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2451970 03 iii 3 03/01/2001 die i mensis iii annoque mmi 01 i 2001} test clock-2.1470 {conversion of 2001-03-31} { clock format 986042096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2001 12:34:56 die xxxi mensis iii annoque mmi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2452000 03 iii 3 03/31/2001 die xxxi mensis iii annoque mmi 01 i 2001} test clock-2.1471 {conversion of 2001-04-01} { clock format 986128496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2001 12:34:56 die i mensis iv annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2452001 04 iv 4 04/01/2001 die i mensis iv annoque mmi 01 i 2001} test clock-2.1472 {conversion of 2001-04-30} { clock format 988634096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2001 12:34:56 die xxx mensis iv annoque mmi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2452030 04 iv 4 04/30/2001 die xxx mensis iv annoque mmi 01 i 2001} test clock-2.1473 {conversion of 2001-05-01} { clock format 988720496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2001 12:34:56 die i mensis v annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2452031 05 v 5 05/01/2001 die i mensis v annoque mmi 01 i 2001} test clock-2.1474 {conversion of 2001-05-31} { clock format 991312496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2001 12:34:56 die xxxi mensis v annoque mmi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2452061 05 v 5 05/31/2001 die xxxi mensis v annoque mmi 01 i 2001} test clock-2.1475 {conversion of 2001-06-01} { clock format 991398896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2001 12:34:56 die i mensis vi annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2452062 06 vi 6 06/01/2001 die i mensis vi annoque mmi 01 i 2001} test clock-2.1476 {conversion of 2001-06-30} { clock format 993904496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2001 12:34:56 die xxx mensis vi annoque mmi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2452091 06 vi 6 06/30/2001 die xxx mensis vi annoque mmi 01 i 2001} test clock-2.1477 {conversion of 2001-07-01} { clock format 993990896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2001 12:34:56 die i mensis vii annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2452092 07 vii 7 07/01/2001 die i mensis vii annoque mmi 01 i 2001} test clock-2.1478 {conversion of 2001-07-31} { clock format 996582896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2001 12:34:56 die xxxi mensis vii annoque mmi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2452122 07 vii 7 07/31/2001 die xxxi mensis vii annoque mmi 01 i 2001} test clock-2.1479 {conversion of 2001-08-01} { clock format 996669296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2001 12:34:56 die i mensis viii annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2452123 08 viii 8 08/01/2001 die i mensis viii annoque mmi 01 i 2001} test clock-2.1480 {conversion of 2001-08-31} { clock format 999261296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2001 12:34:56 die xxxi mensis viii annoque mmi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2452153 08 viii 8 08/31/2001 die xxxi mensis viii annoque mmi 01 i 2001} test clock-2.1481 {conversion of 2001-09-01} { clock format 999347696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2001 12:34:56 die i mensis ix annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2452154 09 ix 9 09/01/2001 die i mensis ix annoque mmi 01 i 2001} test clock-2.1482 {conversion of 2001-09-30} { clock format 1001853296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2001 12:34:56 die xxx mensis ix annoque mmi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2452183 09 ix 9 09/30/2001 die xxx mensis ix annoque mmi 01 i 2001} test clock-2.1483 {conversion of 2001-10-01} { clock format 1001939696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2001 12:34:56 die i mensis x annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2452184 10 x 10 10/01/2001 die i mensis x annoque mmi 01 i 2001} test clock-2.1484 {conversion of 2001-10-31} { clock format 1004531696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2001 12:34:56 die xxxi mensis x annoque mmi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2452214 10 x 10 10/31/2001 die xxxi mensis x annoque mmi 01 i 2001} test clock-2.1485 {conversion of 2001-11-01} { clock format 1004618096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2001 12:34:56 die i mensis xi annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2452215 11 xi 11 11/01/2001 die i mensis xi annoque mmi 01 i 2001} test clock-2.1486 {conversion of 2001-11-30} { clock format 1007123696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2001 12:34:56 die xxx mensis xi annoque mmi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2452244 11 xi 11 11/30/2001 die xxx mensis xi annoque mmi 01 i 2001} test clock-2.1487 {conversion of 2001-12-01} { clock format 1007210096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2001 12:34:56 die i mensis xii annoque mmi xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2452245 12 xii 12 12/01/2001 die i mensis xii annoque mmi 01 i 2001} test clock-2.1488 {conversion of 2001-12-31} { clock format 1009802096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2001 12:34:56 die xxxi mensis xii annoque mmi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2452275 12 xii 12 12/31/2001 die xxxi mensis xii annoque mmi 01 i 2001} test clock-2.1489 {conversion of 2002-01-01} { clock format 1009888496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2002 12:34:56 die i mensis i annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2452276 01 i 1 01/01/2002 die i mensis i annoque mmii 02 ii 2002} test clock-2.1490 {conversion of 2002-01-31} { clock format 1012480496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2002 12:34:56 die xxxi mensis i annoque mmii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2452306 01 i 1 01/31/2002 die xxxi mensis i annoque mmii 02 ii 2002} test clock-2.1491 {conversion of 2002-02-01} { clock format 1012566896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2002 12:34:56 die i mensis ii annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2452307 02 ii 2 02/01/2002 die i mensis ii annoque mmii 02 ii 2002} test clock-2.1492 {conversion of 2002-02-28} { clock format 1014899696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2002 12:34:56 die xxviii mensis ii annoque mmii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2452334 02 ii 2 02/28/2002 die xxviii mensis ii annoque mmii 02 ii 2002} test clock-2.1493 {conversion of 2002-03-01} { clock format 1014986096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2002 12:34:56 die i mensis iii annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2452335 03 iii 3 03/01/2002 die i mensis iii annoque mmii 02 ii 2002} test clock-2.1494 {conversion of 2002-03-31} { clock format 1017578096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2002 12:34:56 die xxxi mensis iii annoque mmii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2452365 03 iii 3 03/31/2002 die xxxi mensis iii annoque mmii 02 ii 2002} test clock-2.1495 {conversion of 2002-04-01} { clock format 1017664496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2002 12:34:56 die i mensis iv annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2452366 04 iv 4 04/01/2002 die i mensis iv annoque mmii 02 ii 2002} test clock-2.1496 {conversion of 2002-04-30} { clock format 1020170096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2002 12:34:56 die xxx mensis iv annoque mmii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2452395 04 iv 4 04/30/2002 die xxx mensis iv annoque mmii 02 ii 2002} test clock-2.1497 {conversion of 2002-05-01} { clock format 1020256496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2002 12:34:56 die i mensis v annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2452396 05 v 5 05/01/2002 die i mensis v annoque mmii 02 ii 2002} test clock-2.1498 {conversion of 2002-05-31} { clock format 1022848496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2002 12:34:56 die xxxi mensis v annoque mmii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2452426 05 v 5 05/31/2002 die xxxi mensis v annoque mmii 02 ii 2002} test clock-2.1499 {conversion of 2002-06-01} { clock format 1022934896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2002 12:34:56 die i mensis vi annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2452427 06 vi 6 06/01/2002 die i mensis vi annoque mmii 02 ii 2002} test clock-2.1500 {conversion of 2002-06-30} { clock format 1025440496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2002 12:34:56 die xxx mensis vi annoque mmii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2452456 06 vi 6 06/30/2002 die xxx mensis vi annoque mmii 02 ii 2002} test clock-2.1501 {conversion of 2002-07-01} { clock format 1025526896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2002 12:34:56 die i mensis vii annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2452457 07 vii 7 07/01/2002 die i mensis vii annoque mmii 02 ii 2002} test clock-2.1502 {conversion of 2002-07-31} { clock format 1028118896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2002 12:34:56 die xxxi mensis vii annoque mmii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2452487 07 vii 7 07/31/2002 die xxxi mensis vii annoque mmii 02 ii 2002} test clock-2.1503 {conversion of 2002-08-01} { clock format 1028205296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2002 12:34:56 die i mensis viii annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2452488 08 viii 8 08/01/2002 die i mensis viii annoque mmii 02 ii 2002} test clock-2.1504 {conversion of 2002-08-31} { clock format 1030797296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2002 12:34:56 die xxxi mensis viii annoque mmii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2452518 08 viii 8 08/31/2002 die xxxi mensis viii annoque mmii 02 ii 2002} test clock-2.1505 {conversion of 2002-09-01} { clock format 1030883696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2002 12:34:56 die i mensis ix annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2452519 09 ix 9 09/01/2002 die i mensis ix annoque mmii 02 ii 2002} test clock-2.1506 {conversion of 2002-09-30} { clock format 1033389296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2002 12:34:56 die xxx mensis ix annoque mmii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2452548 09 ix 9 09/30/2002 die xxx mensis ix annoque mmii 02 ii 2002} test clock-2.1507 {conversion of 2002-10-01} { clock format 1033475696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2002 12:34:56 die i mensis x annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2452549 10 x 10 10/01/2002 die i mensis x annoque mmii 02 ii 2002} test clock-2.1508 {conversion of 2002-10-31} { clock format 1036067696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2002 12:34:56 die xxxi mensis x annoque mmii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2452579 10 x 10 10/31/2002 die xxxi mensis x annoque mmii 02 ii 2002} test clock-2.1509 {conversion of 2002-11-01} { clock format 1036154096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2002 12:34:56 die i mensis xi annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2452580 11 xi 11 11/01/2002 die i mensis xi annoque mmii 02 ii 2002} test clock-2.1510 {conversion of 2002-11-30} { clock format 1038659696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2002 12:34:56 die xxx mensis xi annoque mmii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2452609 11 xi 11 11/30/2002 die xxx mensis xi annoque mmii 02 ii 2002} test clock-2.1511 {conversion of 2002-12-01} { clock format 1038746096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2002 12:34:56 die i mensis xii annoque mmii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2452610 12 xii 12 12/01/2002 die i mensis xii annoque mmii 02 ii 2002} test clock-2.1512 {conversion of 2002-12-31} { clock format 1041338096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2002 12:34:56 die xxxi mensis xii annoque mmii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2452640 12 xii 12 12/31/2002 die xxxi mensis xii annoque mmii 02 ii 2002} test clock-2.1513 {conversion of 2003-01-01} { clock format 1041424496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2003 12:34:56 die i mensis i annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2452641 01 i 1 01/01/2003 die i mensis i annoque mmiii 03 iii 2003} test clock-2.1514 {conversion of 2003-01-31} { clock format 1044016496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2003 12:34:56 die xxxi mensis i annoque mmiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2452671 01 i 1 01/31/2003 die xxxi mensis i annoque mmiii 03 iii 2003} test clock-2.1515 {conversion of 2003-02-01} { clock format 1044102896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2003 12:34:56 die i mensis ii annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2452672 02 ii 2 02/01/2003 die i mensis ii annoque mmiii 03 iii 2003} test clock-2.1516 {conversion of 2003-02-28} { clock format 1046435696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2003 12:34:56 die xxviii mensis ii annoque mmiii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2452699 02 ii 2 02/28/2003 die xxviii mensis ii annoque mmiii 03 iii 2003} test clock-2.1517 {conversion of 2003-03-01} { clock format 1046522096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2003 12:34:56 die i mensis iii annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2452700 03 iii 3 03/01/2003 die i mensis iii annoque mmiii 03 iii 2003} test clock-2.1518 {conversion of 2003-03-31} { clock format 1049114096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2003 12:34:56 die xxxi mensis iii annoque mmiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2452730 03 iii 3 03/31/2003 die xxxi mensis iii annoque mmiii 03 iii 2003} test clock-2.1519 {conversion of 2003-04-01} { clock format 1049200496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2003 12:34:56 die i mensis iv annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2452731 04 iv 4 04/01/2003 die i mensis iv annoque mmiii 03 iii 2003} test clock-2.1520 {conversion of 2003-04-30} { clock format 1051706096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2003 12:34:56 die xxx mensis iv annoque mmiii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2452760 04 iv 4 04/30/2003 die xxx mensis iv annoque mmiii 03 iii 2003} test clock-2.1521 {conversion of 2003-05-01} { clock format 1051792496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2003 12:34:56 die i mensis v annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2452761 05 v 5 05/01/2003 die i mensis v annoque mmiii 03 iii 2003} test clock-2.1522 {conversion of 2003-05-31} { clock format 1054384496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2003 12:34:56 die xxxi mensis v annoque mmiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2452791 05 v 5 05/31/2003 die xxxi mensis v annoque mmiii 03 iii 2003} test clock-2.1523 {conversion of 2003-06-01} { clock format 1054470896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2003 12:34:56 die i mensis vi annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2452792 06 vi 6 06/01/2003 die i mensis vi annoque mmiii 03 iii 2003} test clock-2.1524 {conversion of 2003-06-30} { clock format 1056976496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2003 12:34:56 die xxx mensis vi annoque mmiii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2452821 06 vi 6 06/30/2003 die xxx mensis vi annoque mmiii 03 iii 2003} test clock-2.1525 {conversion of 2003-07-01} { clock format 1057062896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2003 12:34:56 die i mensis vii annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2452822 07 vii 7 07/01/2003 die i mensis vii annoque mmiii 03 iii 2003} test clock-2.1526 {conversion of 2003-07-31} { clock format 1059654896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2003 12:34:56 die xxxi mensis vii annoque mmiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2452852 07 vii 7 07/31/2003 die xxxi mensis vii annoque mmiii 03 iii 2003} test clock-2.1527 {conversion of 2003-08-01} { clock format 1059741296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2003 12:34:56 die i mensis viii annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2452853 08 viii 8 08/01/2003 die i mensis viii annoque mmiii 03 iii 2003} test clock-2.1528 {conversion of 2003-08-31} { clock format 1062333296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2003 12:34:56 die xxxi mensis viii annoque mmiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2452883 08 viii 8 08/31/2003 die xxxi mensis viii annoque mmiii 03 iii 2003} test clock-2.1529 {conversion of 2003-09-01} { clock format 1062419696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2003 12:34:56 die i mensis ix annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2452884 09 ix 9 09/01/2003 die i mensis ix annoque mmiii 03 iii 2003} test clock-2.1530 {conversion of 2003-09-30} { clock format 1064925296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2003 12:34:56 die xxx mensis ix annoque mmiii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2452913 09 ix 9 09/30/2003 die xxx mensis ix annoque mmiii 03 iii 2003} test clock-2.1531 {conversion of 2003-10-01} { clock format 1065011696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2003 12:34:56 die i mensis x annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2452914 10 x 10 10/01/2003 die i mensis x annoque mmiii 03 iii 2003} test clock-2.1532 {conversion of 2003-10-31} { clock format 1067603696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2003 12:34:56 die xxxi mensis x annoque mmiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2452944 10 x 10 10/31/2003 die xxxi mensis x annoque mmiii 03 iii 2003} test clock-2.1533 {conversion of 2003-11-01} { clock format 1067690096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2003 12:34:56 die i mensis xi annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2452945 11 xi 11 11/01/2003 die i mensis xi annoque mmiii 03 iii 2003} test clock-2.1534 {conversion of 2003-11-30} { clock format 1070195696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2003 12:34:56 die xxx mensis xi annoque mmiii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2452974 11 xi 11 11/30/2003 die xxx mensis xi annoque mmiii 03 iii 2003} test clock-2.1535 {conversion of 2003-12-01} { clock format 1070282096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2003 12:34:56 die i mensis xii annoque mmiii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2452975 12 xii 12 12/01/2003 die i mensis xii annoque mmiii 03 iii 2003} test clock-2.1536 {conversion of 2003-12-31} { clock format 1072874096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2003 12:34:56 die xxxi mensis xii annoque mmiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2453005 12 xii 12 12/31/2003 die xxxi mensis xii annoque mmiii 03 iii 2003} test clock-2.1537 {conversion of 2004-01-01} { clock format 1072960496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2004 12:34:56 die i mensis i annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2453006 01 i 1 01/01/2004 die i mensis i annoque mmiv 04 iv 2004} test clock-2.1538 {conversion of 2004-01-31} { clock format 1075552496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2004 12:34:56 die xxxi mensis i annoque mmiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2453036 01 i 1 01/31/2004 die xxxi mensis i annoque mmiv 04 iv 2004} test clock-2.1539 {conversion of 2004-02-01} { clock format 1075638896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2004 12:34:56 die i mensis ii annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2453037 02 ii 2 02/01/2004 die i mensis ii annoque mmiv 04 iv 2004} test clock-2.1540 {conversion of 2004-02-29} { clock format 1078058096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2004 12:34:56 die xxix mensis ii annoque mmiv xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2453065 02 ii 2 02/29/2004 die xxix mensis ii annoque mmiv 04 iv 2004} test clock-2.1541 {conversion of 2004-03-01} { clock format 1078144496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2004 12:34:56 die i mensis iii annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2453066 03 iii 3 03/01/2004 die i mensis iii annoque mmiv 04 iv 2004} test clock-2.1542 {conversion of 2004-03-31} { clock format 1080736496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2004 12:34:56 die xxxi mensis iii annoque mmiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2453096 03 iii 3 03/31/2004 die xxxi mensis iii annoque mmiv 04 iv 2004} test clock-2.1543 {conversion of 2004-04-01} { clock format 1080822896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2004 12:34:56 die i mensis iv annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2453097 04 iv 4 04/01/2004 die i mensis iv annoque mmiv 04 iv 2004} test clock-2.1544 {conversion of 2004-04-30} { clock format 1083328496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2004 12:34:56 die xxx mensis iv annoque mmiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2453126 04 iv 4 04/30/2004 die xxx mensis iv annoque mmiv 04 iv 2004} test clock-2.1545 {conversion of 2004-05-01} { clock format 1083414896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2004 12:34:56 die i mensis v annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2453127 05 v 5 05/01/2004 die i mensis v annoque mmiv 04 iv 2004} test clock-2.1546 {conversion of 2004-05-31} { clock format 1086006896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2004 12:34:56 die xxxi mensis v annoque mmiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2453157 05 v 5 05/31/2004 die xxxi mensis v annoque mmiv 04 iv 2004} test clock-2.1547 {conversion of 2004-06-01} { clock format 1086093296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2004 12:34:56 die i mensis vi annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2453158 06 vi 6 06/01/2004 die i mensis vi annoque mmiv 04 iv 2004} test clock-2.1548 {conversion of 2004-06-30} { clock format 1088598896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2004 12:34:56 die xxx mensis vi annoque mmiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2453187 06 vi 6 06/30/2004 die xxx mensis vi annoque mmiv 04 iv 2004} test clock-2.1549 {conversion of 2004-07-01} { clock format 1088685296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2004 12:34:56 die i mensis vii annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2453188 07 vii 7 07/01/2004 die i mensis vii annoque mmiv 04 iv 2004} test clock-2.1550 {conversion of 2004-07-31} { clock format 1091277296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2004 12:34:56 die xxxi mensis vii annoque mmiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2453218 07 vii 7 07/31/2004 die xxxi mensis vii annoque mmiv 04 iv 2004} test clock-2.1551 {conversion of 2004-08-01} { clock format 1091363696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2004 12:34:56 die i mensis viii annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2453219 08 viii 8 08/01/2004 die i mensis viii annoque mmiv 04 iv 2004} test clock-2.1552 {conversion of 2004-08-31} { clock format 1093955696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2004 12:34:56 die xxxi mensis viii annoque mmiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2453249 08 viii 8 08/31/2004 die xxxi mensis viii annoque mmiv 04 iv 2004} test clock-2.1553 {conversion of 2004-09-01} { clock format 1094042096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2004 12:34:56 die i mensis ix annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2453250 09 ix 9 09/01/2004 die i mensis ix annoque mmiv 04 iv 2004} test clock-2.1554 {conversion of 2004-09-30} { clock format 1096547696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2004 12:34:56 die xxx mensis ix annoque mmiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2453279 09 ix 9 09/30/2004 die xxx mensis ix annoque mmiv 04 iv 2004} test clock-2.1555 {conversion of 2004-10-01} { clock format 1096634096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2004 12:34:56 die i mensis x annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2453280 10 x 10 10/01/2004 die i mensis x annoque mmiv 04 iv 2004} test clock-2.1556 {conversion of 2004-10-31} { clock format 1099226096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2004 12:34:56 die xxxi mensis x annoque mmiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2453310 10 x 10 10/31/2004 die xxxi mensis x annoque mmiv 04 iv 2004} test clock-2.1557 {conversion of 2004-11-01} { clock format 1099312496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2004 12:34:56 die i mensis xi annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2453311 11 xi 11 11/01/2004 die i mensis xi annoque mmiv 04 iv 2004} test clock-2.1558 {conversion of 2004-11-30} { clock format 1101818096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2004 12:34:56 die xxx mensis xi annoque mmiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2453340 11 xi 11 11/30/2004 die xxx mensis xi annoque mmiv 04 iv 2004} test clock-2.1559 {conversion of 2004-12-01} { clock format 1101904496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2004 12:34:56 die i mensis xii annoque mmiv xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2453341 12 xii 12 12/01/2004 die i mensis xii annoque mmiv 04 iv 2004} test clock-2.1560 {conversion of 2004-12-31} { clock format 1104496496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2004 12:34:56 die xxxi mensis xii annoque mmiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2453371 12 xii 12 12/31/2004 die xxxi mensis xii annoque mmiv 04 iv 2004} test clock-2.1561 {conversion of 2005-01-01} { clock format 1104582896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2005 12:34:56 die i mensis i annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2453372 01 i 1 01/01/2005 die i mensis i annoque mmv 05 v 2005} test clock-2.1562 {conversion of 2005-01-31} { clock format 1107174896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2005 12:34:56 die xxxi mensis i annoque mmv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2453402 01 i 1 01/31/2005 die xxxi mensis i annoque mmv 05 v 2005} test clock-2.1563 {conversion of 2005-02-01} { clock format 1107261296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2005 12:34:56 die i mensis ii annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2453403 02 ii 2 02/01/2005 die i mensis ii annoque mmv 05 v 2005} test clock-2.1564 {conversion of 2005-02-28} { clock format 1109594096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2005 12:34:56 die xxviii mensis ii annoque mmv xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2453430 02 ii 2 02/28/2005 die xxviii mensis ii annoque mmv 05 v 2005} test clock-2.1565 {conversion of 2005-03-01} { clock format 1109680496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2005 12:34:56 die i mensis iii annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2453431 03 iii 3 03/01/2005 die i mensis iii annoque mmv 05 v 2005} test clock-2.1566 {conversion of 2005-03-31} { clock format 1112272496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2005 12:34:56 die xxxi mensis iii annoque mmv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2453461 03 iii 3 03/31/2005 die xxxi mensis iii annoque mmv 05 v 2005} test clock-2.1567 {conversion of 2005-04-01} { clock format 1112358896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2005 12:34:56 die i mensis iv annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2453462 04 iv 4 04/01/2005 die i mensis iv annoque mmv 05 v 2005} test clock-2.1568 {conversion of 2005-04-30} { clock format 1114864496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2005 12:34:56 die xxx mensis iv annoque mmv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2453491 04 iv 4 04/30/2005 die xxx mensis iv annoque mmv 05 v 2005} test clock-2.1569 {conversion of 2005-05-01} { clock format 1114950896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2005 12:34:56 die i mensis v annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2453492 05 v 5 05/01/2005 die i mensis v annoque mmv 05 v 2005} test clock-2.1570 {conversion of 2005-05-31} { clock format 1117542896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2005 12:34:56 die xxxi mensis v annoque mmv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2453522 05 v 5 05/31/2005 die xxxi mensis v annoque mmv 05 v 2005} test clock-2.1571 {conversion of 2005-06-01} { clock format 1117629296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2005 12:34:56 die i mensis vi annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2453523 06 vi 6 06/01/2005 die i mensis vi annoque mmv 05 v 2005} test clock-2.1572 {conversion of 2005-06-30} { clock format 1120134896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2005 12:34:56 die xxx mensis vi annoque mmv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2453552 06 vi 6 06/30/2005 die xxx mensis vi annoque mmv 05 v 2005} test clock-2.1573 {conversion of 2005-07-01} { clock format 1120221296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2005 12:34:56 die i mensis vii annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2453553 07 vii 7 07/01/2005 die i mensis vii annoque mmv 05 v 2005} test clock-2.1574 {conversion of 2005-07-31} { clock format 1122813296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2005 12:34:56 die xxxi mensis vii annoque mmv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2453583 07 vii 7 07/31/2005 die xxxi mensis vii annoque mmv 05 v 2005} test clock-2.1575 {conversion of 2005-08-01} { clock format 1122899696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2005 12:34:56 die i mensis viii annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2453584 08 viii 8 08/01/2005 die i mensis viii annoque mmv 05 v 2005} test clock-2.1576 {conversion of 2005-08-31} { clock format 1125491696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2005 12:34:56 die xxxi mensis viii annoque mmv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2453614 08 viii 8 08/31/2005 die xxxi mensis viii annoque mmv 05 v 2005} test clock-2.1577 {conversion of 2005-09-01} { clock format 1125578096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2005 12:34:56 die i mensis ix annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2453615 09 ix 9 09/01/2005 die i mensis ix annoque mmv 05 v 2005} test clock-2.1578 {conversion of 2005-09-30} { clock format 1128083696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2005 12:34:56 die xxx mensis ix annoque mmv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2453644 09 ix 9 09/30/2005 die xxx mensis ix annoque mmv 05 v 2005} test clock-2.1579 {conversion of 2005-10-01} { clock format 1128170096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2005 12:34:56 die i mensis x annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2453645 10 x 10 10/01/2005 die i mensis x annoque mmv 05 v 2005} test clock-2.1580 {conversion of 2005-10-31} { clock format 1130762096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2005 12:34:56 die xxxi mensis x annoque mmv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2453675 10 x 10 10/31/2005 die xxxi mensis x annoque mmv 05 v 2005} test clock-2.1581 {conversion of 2005-11-01} { clock format 1130848496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2005 12:34:56 die i mensis xi annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2453676 11 xi 11 11/01/2005 die i mensis xi annoque mmv 05 v 2005} test clock-2.1582 {conversion of 2005-11-30} { clock format 1133354096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2005 12:34:56 die xxx mensis xi annoque mmv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2453705 11 xi 11 11/30/2005 die xxx mensis xi annoque mmv 05 v 2005} test clock-2.1583 {conversion of 2005-12-01} { clock format 1133440496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2005 12:34:56 die i mensis xii annoque mmv xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2453706 12 xii 12 12/01/2005 die i mensis xii annoque mmv 05 v 2005} test clock-2.1584 {conversion of 2005-12-31} { clock format 1136032496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2005 12:34:56 die xxxi mensis xii annoque mmv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2453736 12 xii 12 12/31/2005 die xxxi mensis xii annoque mmv 05 v 2005} test clock-2.1585 {conversion of 2006-01-01} { clock format 1136118896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2006 12:34:56 die i mensis i annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2453737 01 i 1 01/01/2006 die i mensis i annoque mmvi 06 vi 2006} test clock-2.1586 {conversion of 2006-01-31} { clock format 1138710896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2006 12:34:56 die xxxi mensis i annoque mmvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2453767 01 i 1 01/31/2006 die xxxi mensis i annoque mmvi 06 vi 2006} test clock-2.1587 {conversion of 2006-02-01} { clock format 1138797296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2006 12:34:56 die i mensis ii annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2453768 02 ii 2 02/01/2006 die i mensis ii annoque mmvi 06 vi 2006} test clock-2.1588 {conversion of 2006-02-28} { clock format 1141130096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2006 12:34:56 die xxviii mensis ii annoque mmvi xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2453795 02 ii 2 02/28/2006 die xxviii mensis ii annoque mmvi 06 vi 2006} test clock-2.1589 {conversion of 2006-03-01} { clock format 1141216496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2006 12:34:56 die i mensis iii annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2453796 03 iii 3 03/01/2006 die i mensis iii annoque mmvi 06 vi 2006} test clock-2.1590 {conversion of 2006-03-31} { clock format 1143808496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2006 12:34:56 die xxxi mensis iii annoque mmvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2453826 03 iii 3 03/31/2006 die xxxi mensis iii annoque mmvi 06 vi 2006} test clock-2.1591 {conversion of 2006-04-01} { clock format 1143894896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2006 12:34:56 die i mensis iv annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2453827 04 iv 4 04/01/2006 die i mensis iv annoque mmvi 06 vi 2006} test clock-2.1592 {conversion of 2006-04-30} { clock format 1146400496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2006 12:34:56 die xxx mensis iv annoque mmvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2453856 04 iv 4 04/30/2006 die xxx mensis iv annoque mmvi 06 vi 2006} test clock-2.1593 {conversion of 2006-05-01} { clock format 1146486896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2006 12:34:56 die i mensis v annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2453857 05 v 5 05/01/2006 die i mensis v annoque mmvi 06 vi 2006} test clock-2.1594 {conversion of 2006-05-31} { clock format 1149078896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2006 12:34:56 die xxxi mensis v annoque mmvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2453887 05 v 5 05/31/2006 die xxxi mensis v annoque mmvi 06 vi 2006} test clock-2.1595 {conversion of 2006-06-01} { clock format 1149165296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2006 12:34:56 die i mensis vi annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2453888 06 vi 6 06/01/2006 die i mensis vi annoque mmvi 06 vi 2006} test clock-2.1596 {conversion of 2006-06-30} { clock format 1151670896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2006 12:34:56 die xxx mensis vi annoque mmvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2453917 06 vi 6 06/30/2006 die xxx mensis vi annoque mmvi 06 vi 2006} test clock-2.1597 {conversion of 2006-07-01} { clock format 1151757296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2006 12:34:56 die i mensis vii annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2453918 07 vii 7 07/01/2006 die i mensis vii annoque mmvi 06 vi 2006} test clock-2.1598 {conversion of 2006-07-31} { clock format 1154349296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2006 12:34:56 die xxxi mensis vii annoque mmvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2453948 07 vii 7 07/31/2006 die xxxi mensis vii annoque mmvi 06 vi 2006} test clock-2.1599 {conversion of 2006-08-01} { clock format 1154435696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2006 12:34:56 die i mensis viii annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2453949 08 viii 8 08/01/2006 die i mensis viii annoque mmvi 06 vi 2006} test clock-2.1600 {conversion of 2006-08-31} { clock format 1157027696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2006 12:34:56 die xxxi mensis viii annoque mmvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2453979 08 viii 8 08/31/2006 die xxxi mensis viii annoque mmvi 06 vi 2006} test clock-2.1601 {conversion of 2006-09-01} { clock format 1157114096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2006 12:34:56 die i mensis ix annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2453980 09 ix 9 09/01/2006 die i mensis ix annoque mmvi 06 vi 2006} test clock-2.1602 {conversion of 2006-09-30} { clock format 1159619696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2006 12:34:56 die xxx mensis ix annoque mmvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2454009 09 ix 9 09/30/2006 die xxx mensis ix annoque mmvi 06 vi 2006} test clock-2.1603 {conversion of 2006-10-01} { clock format 1159706096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2006 12:34:56 die i mensis x annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2454010 10 x 10 10/01/2006 die i mensis x annoque mmvi 06 vi 2006} test clock-2.1604 {conversion of 2006-10-31} { clock format 1162298096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2006 12:34:56 die xxxi mensis x annoque mmvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2454040 10 x 10 10/31/2006 die xxxi mensis x annoque mmvi 06 vi 2006} test clock-2.1605 {conversion of 2006-11-01} { clock format 1162384496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2006 12:34:56 die i mensis xi annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2454041 11 xi 11 11/01/2006 die i mensis xi annoque mmvi 06 vi 2006} test clock-2.1606 {conversion of 2006-11-30} { clock format 1164890096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2006 12:34:56 die xxx mensis xi annoque mmvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2454070 11 xi 11 11/30/2006 die xxx mensis xi annoque mmvi 06 vi 2006} test clock-2.1607 {conversion of 2006-12-01} { clock format 1164976496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2006 12:34:56 die i mensis xii annoque mmvi xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2454071 12 xii 12 12/01/2006 die i mensis xii annoque mmvi 06 vi 2006} test clock-2.1608 {conversion of 2006-12-31} { clock format 1167568496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2006 12:34:56 die xxxi mensis xii annoque mmvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2454101 12 xii 12 12/31/2006 die xxxi mensis xii annoque mmvi 06 vi 2006} test clock-2.1609 {conversion of 2007-01-01} { clock format 1167654896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2007 12:34:56 die i mensis i annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2454102 01 i 1 01/01/2007 die i mensis i annoque mmvii 07 vii 2007} test clock-2.1610 {conversion of 2007-01-31} { clock format 1170246896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2007 12:34:56 die xxxi mensis i annoque mmvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2454132 01 i 1 01/31/2007 die xxxi mensis i annoque mmvii 07 vii 2007} test clock-2.1611 {conversion of 2007-02-01} { clock format 1170333296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2007 12:34:56 die i mensis ii annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2454133 02 ii 2 02/01/2007 die i mensis ii annoque mmvii 07 vii 2007} test clock-2.1612 {conversion of 2007-02-28} { clock format 1172666096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2007 12:34:56 die xxviii mensis ii annoque mmvii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2454160 02 ii 2 02/28/2007 die xxviii mensis ii annoque mmvii 07 vii 2007} test clock-2.1613 {conversion of 2007-03-01} { clock format 1172752496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2007 12:34:56 die i mensis iii annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2454161 03 iii 3 03/01/2007 die i mensis iii annoque mmvii 07 vii 2007} test clock-2.1614 {conversion of 2007-03-31} { clock format 1175344496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2007 12:34:56 die xxxi mensis iii annoque mmvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2454191 03 iii 3 03/31/2007 die xxxi mensis iii annoque mmvii 07 vii 2007} test clock-2.1615 {conversion of 2007-04-01} { clock format 1175430896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2007 12:34:56 die i mensis iv annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2454192 04 iv 4 04/01/2007 die i mensis iv annoque mmvii 07 vii 2007} test clock-2.1616 {conversion of 2007-04-30} { clock format 1177936496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2007 12:34:56 die xxx mensis iv annoque mmvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2454221 04 iv 4 04/30/2007 die xxx mensis iv annoque mmvii 07 vii 2007} test clock-2.1617 {conversion of 2007-05-01} { clock format 1178022896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2007 12:34:56 die i mensis v annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2454222 05 v 5 05/01/2007 die i mensis v annoque mmvii 07 vii 2007} test clock-2.1618 {conversion of 2007-05-31} { clock format 1180614896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2007 12:34:56 die xxxi mensis v annoque mmvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2454252 05 v 5 05/31/2007 die xxxi mensis v annoque mmvii 07 vii 2007} test clock-2.1619 {conversion of 2007-06-01} { clock format 1180701296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2007 12:34:56 die i mensis vi annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2454253 06 vi 6 06/01/2007 die i mensis vi annoque mmvii 07 vii 2007} test clock-2.1620 {conversion of 2007-06-30} { clock format 1183206896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2007 12:34:56 die xxx mensis vi annoque mmvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2454282 06 vi 6 06/30/2007 die xxx mensis vi annoque mmvii 07 vii 2007} test clock-2.1621 {conversion of 2007-07-01} { clock format 1183293296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2007 12:34:56 die i mensis vii annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2454283 07 vii 7 07/01/2007 die i mensis vii annoque mmvii 07 vii 2007} test clock-2.1622 {conversion of 2007-07-31} { clock format 1185885296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2007 12:34:56 die xxxi mensis vii annoque mmvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2454313 07 vii 7 07/31/2007 die xxxi mensis vii annoque mmvii 07 vii 2007} test clock-2.1623 {conversion of 2007-08-01} { clock format 1185971696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2007 12:34:56 die i mensis viii annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2454314 08 viii 8 08/01/2007 die i mensis viii annoque mmvii 07 vii 2007} test clock-2.1624 {conversion of 2007-08-31} { clock format 1188563696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2007 12:34:56 die xxxi mensis viii annoque mmvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2454344 08 viii 8 08/31/2007 die xxxi mensis viii annoque mmvii 07 vii 2007} test clock-2.1625 {conversion of 2007-09-01} { clock format 1188650096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2007 12:34:56 die i mensis ix annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2454345 09 ix 9 09/01/2007 die i mensis ix annoque mmvii 07 vii 2007} test clock-2.1626 {conversion of 2007-09-30} { clock format 1191155696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2007 12:34:56 die xxx mensis ix annoque mmvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2454374 09 ix 9 09/30/2007 die xxx mensis ix annoque mmvii 07 vii 2007} test clock-2.1627 {conversion of 2007-10-01} { clock format 1191242096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2007 12:34:56 die i mensis x annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2454375 10 x 10 10/01/2007 die i mensis x annoque mmvii 07 vii 2007} test clock-2.1628 {conversion of 2007-10-31} { clock format 1193834096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2007 12:34:56 die xxxi mensis x annoque mmvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2454405 10 x 10 10/31/2007 die xxxi mensis x annoque mmvii 07 vii 2007} test clock-2.1629 {conversion of 2007-11-01} { clock format 1193920496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2007 12:34:56 die i mensis xi annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2454406 11 xi 11 11/01/2007 die i mensis xi annoque mmvii 07 vii 2007} test clock-2.1630 {conversion of 2007-11-30} { clock format 1196426096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2007 12:34:56 die xxx mensis xi annoque mmvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2454435 11 xi 11 11/30/2007 die xxx mensis xi annoque mmvii 07 vii 2007} test clock-2.1631 {conversion of 2007-12-01} { clock format 1196512496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2007 12:34:56 die i mensis xii annoque mmvii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2454436 12 xii 12 12/01/2007 die i mensis xii annoque mmvii 07 vii 2007} test clock-2.1632 {conversion of 2007-12-31} { clock format 1199104496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2007 12:34:56 die xxxi mensis xii annoque mmvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2454466 12 xii 12 12/31/2007 die xxxi mensis xii annoque mmvii 07 vii 2007} test clock-2.1633 {conversion of 2008-01-01} { clock format 1199190896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2008 12:34:56 die i mensis i annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2454467 01 i 1 01/01/2008 die i mensis i annoque mmviii 08 viii 2008} test clock-2.1634 {conversion of 2008-01-31} { clock format 1201782896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2008 12:34:56 die xxxi mensis i annoque mmviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2454497 01 i 1 01/31/2008 die xxxi mensis i annoque mmviii 08 viii 2008} test clock-2.1635 {conversion of 2008-02-01} { clock format 1201869296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2008 12:34:56 die i mensis ii annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2454498 02 ii 2 02/01/2008 die i mensis ii annoque mmviii 08 viii 2008} test clock-2.1636 {conversion of 2008-02-29} { clock format 1204288496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2008 12:34:56 die xxix mensis ii annoque mmviii xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2454526 02 ii 2 02/29/2008 die xxix mensis ii annoque mmviii 08 viii 2008} test clock-2.1637 {conversion of 2008-03-01} { clock format 1204374896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2008 12:34:56 die i mensis iii annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2454527 03 iii 3 03/01/2008 die i mensis iii annoque mmviii 08 viii 2008} test clock-2.1638 {conversion of 2008-03-31} { clock format 1206966896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2008 12:34:56 die xxxi mensis iii annoque mmviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2454557 03 iii 3 03/31/2008 die xxxi mensis iii annoque mmviii 08 viii 2008} test clock-2.1639 {conversion of 2008-04-01} { clock format 1207053296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2008 12:34:56 die i mensis iv annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2454558 04 iv 4 04/01/2008 die i mensis iv annoque mmviii 08 viii 2008} test clock-2.1640 {conversion of 2008-04-30} { clock format 1209558896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2008 12:34:56 die xxx mensis iv annoque mmviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2454587 04 iv 4 04/30/2008 die xxx mensis iv annoque mmviii 08 viii 2008} test clock-2.1641 {conversion of 2008-05-01} { clock format 1209645296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2008 12:34:56 die i mensis v annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2454588 05 v 5 05/01/2008 die i mensis v annoque mmviii 08 viii 2008} test clock-2.1642 {conversion of 2008-05-31} { clock format 1212237296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2008 12:34:56 die xxxi mensis v annoque mmviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2454618 05 v 5 05/31/2008 die xxxi mensis v annoque mmviii 08 viii 2008} test clock-2.1643 {conversion of 2008-06-01} { clock format 1212323696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2008 12:34:56 die i mensis vi annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2454619 06 vi 6 06/01/2008 die i mensis vi annoque mmviii 08 viii 2008} test clock-2.1644 {conversion of 2008-06-30} { clock format 1214829296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2008 12:34:56 die xxx mensis vi annoque mmviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2454648 06 vi 6 06/30/2008 die xxx mensis vi annoque mmviii 08 viii 2008} test clock-2.1645 {conversion of 2008-07-01} { clock format 1214915696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2008 12:34:56 die i mensis vii annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2454649 07 vii 7 07/01/2008 die i mensis vii annoque mmviii 08 viii 2008} test clock-2.1646 {conversion of 2008-07-31} { clock format 1217507696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2008 12:34:56 die xxxi mensis vii annoque mmviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2454679 07 vii 7 07/31/2008 die xxxi mensis vii annoque mmviii 08 viii 2008} test clock-2.1647 {conversion of 2008-08-01} { clock format 1217594096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2008 12:34:56 die i mensis viii annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2454680 08 viii 8 08/01/2008 die i mensis viii annoque mmviii 08 viii 2008} test clock-2.1648 {conversion of 2008-08-31} { clock format 1220186096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2008 12:34:56 die xxxi mensis viii annoque mmviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2454710 08 viii 8 08/31/2008 die xxxi mensis viii annoque mmviii 08 viii 2008} test clock-2.1649 {conversion of 2008-09-01} { clock format 1220272496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2008 12:34:56 die i mensis ix annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2454711 09 ix 9 09/01/2008 die i mensis ix annoque mmviii 08 viii 2008} test clock-2.1650 {conversion of 2008-09-30} { clock format 1222778096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2008 12:34:56 die xxx mensis ix annoque mmviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2454740 09 ix 9 09/30/2008 die xxx mensis ix annoque mmviii 08 viii 2008} test clock-2.1651 {conversion of 2008-10-01} { clock format 1222864496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2008 12:34:56 die i mensis x annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2454741 10 x 10 10/01/2008 die i mensis x annoque mmviii 08 viii 2008} test clock-2.1652 {conversion of 2008-10-31} { clock format 1225456496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2008 12:34:56 die xxxi mensis x annoque mmviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2454771 10 x 10 10/31/2008 die xxxi mensis x annoque mmviii 08 viii 2008} test clock-2.1653 {conversion of 2008-11-01} { clock format 1225542896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2008 12:34:56 die i mensis xi annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2454772 11 xi 11 11/01/2008 die i mensis xi annoque mmviii 08 viii 2008} test clock-2.1654 {conversion of 2008-11-30} { clock format 1228048496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2008 12:34:56 die xxx mensis xi annoque mmviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2454801 11 xi 11 11/30/2008 die xxx mensis xi annoque mmviii 08 viii 2008} test clock-2.1655 {conversion of 2008-12-01} { clock format 1228134896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2008 12:34:56 die i mensis xii annoque mmviii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2454802 12 xii 12 12/01/2008 die i mensis xii annoque mmviii 08 viii 2008} test clock-2.1656 {conversion of 2008-12-31} { clock format 1230726896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2008 12:34:56 die xxxi mensis xii annoque mmviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2454832 12 xii 12 12/31/2008 die xxxi mensis xii annoque mmviii 08 viii 2008} test clock-2.1657 {conversion of 2009-01-01} { clock format 1230813296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2009 12:34:56 die i mensis i annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2454833 01 i 1 01/01/2009 die i mensis i annoque mmix 09 ix 2009} test clock-2.1658 {conversion of 2009-01-31} { clock format 1233405296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2009 12:34:56 die xxxi mensis i annoque mmix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2454863 01 i 1 01/31/2009 die xxxi mensis i annoque mmix 09 ix 2009} test clock-2.1659 {conversion of 2009-02-01} { clock format 1233491696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2009 12:34:56 die i mensis ii annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2454864 02 ii 2 02/01/2009 die i mensis ii annoque mmix 09 ix 2009} test clock-2.1660 {conversion of 2009-02-28} { clock format 1235824496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2009 12:34:56 die xxviii mensis ii annoque mmix xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2454891 02 ii 2 02/28/2009 die xxviii mensis ii annoque mmix 09 ix 2009} test clock-2.1661 {conversion of 2009-03-01} { clock format 1235910896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2009 12:34:56 die i mensis iii annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2454892 03 iii 3 03/01/2009 die i mensis iii annoque mmix 09 ix 2009} test clock-2.1662 {conversion of 2009-03-31} { clock format 1238502896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2009 12:34:56 die xxxi mensis iii annoque mmix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2454922 03 iii 3 03/31/2009 die xxxi mensis iii annoque mmix 09 ix 2009} test clock-2.1663 {conversion of 2009-04-01} { clock format 1238589296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2009 12:34:56 die i mensis iv annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2454923 04 iv 4 04/01/2009 die i mensis iv annoque mmix 09 ix 2009} test clock-2.1664 {conversion of 2009-04-30} { clock format 1241094896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2009 12:34:56 die xxx mensis iv annoque mmix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2454952 04 iv 4 04/30/2009 die xxx mensis iv annoque mmix 09 ix 2009} test clock-2.1665 {conversion of 2009-05-01} { clock format 1241181296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2009 12:34:56 die i mensis v annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2454953 05 v 5 05/01/2009 die i mensis v annoque mmix 09 ix 2009} test clock-2.1666 {conversion of 2009-05-31} { clock format 1243773296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2009 12:34:56 die xxxi mensis v annoque mmix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2454983 05 v 5 05/31/2009 die xxxi mensis v annoque mmix 09 ix 2009} test clock-2.1667 {conversion of 2009-06-01} { clock format 1243859696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2009 12:34:56 die i mensis vi annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2454984 06 vi 6 06/01/2009 die i mensis vi annoque mmix 09 ix 2009} test clock-2.1668 {conversion of 2009-06-30} { clock format 1246365296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2009 12:34:56 die xxx mensis vi annoque mmix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2455013 06 vi 6 06/30/2009 die xxx mensis vi annoque mmix 09 ix 2009} test clock-2.1669 {conversion of 2009-07-01} { clock format 1246451696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2009 12:34:56 die i mensis vii annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2455014 07 vii 7 07/01/2009 die i mensis vii annoque mmix 09 ix 2009} test clock-2.1670 {conversion of 2009-07-31} { clock format 1249043696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2009 12:34:56 die xxxi mensis vii annoque mmix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2455044 07 vii 7 07/31/2009 die xxxi mensis vii annoque mmix 09 ix 2009} test clock-2.1671 {conversion of 2009-08-01} { clock format 1249130096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2009 12:34:56 die i mensis viii annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2455045 08 viii 8 08/01/2009 die i mensis viii annoque mmix 09 ix 2009} test clock-2.1672 {conversion of 2009-08-31} { clock format 1251722096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2009 12:34:56 die xxxi mensis viii annoque mmix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2455075 08 viii 8 08/31/2009 die xxxi mensis viii annoque mmix 09 ix 2009} test clock-2.1673 {conversion of 2009-09-01} { clock format 1251808496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2009 12:34:56 die i mensis ix annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2455076 09 ix 9 09/01/2009 die i mensis ix annoque mmix 09 ix 2009} test clock-2.1674 {conversion of 2009-09-30} { clock format 1254314096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2009 12:34:56 die xxx mensis ix annoque mmix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2455105 09 ix 9 09/30/2009 die xxx mensis ix annoque mmix 09 ix 2009} test clock-2.1675 {conversion of 2009-10-01} { clock format 1254400496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2009 12:34:56 die i mensis x annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2455106 10 x 10 10/01/2009 die i mensis x annoque mmix 09 ix 2009} test clock-2.1676 {conversion of 2009-10-31} { clock format 1256992496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2009 12:34:56 die xxxi mensis x annoque mmix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2455136 10 x 10 10/31/2009 die xxxi mensis x annoque mmix 09 ix 2009} test clock-2.1677 {conversion of 2009-11-01} { clock format 1257078896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2009 12:34:56 die i mensis xi annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2455137 11 xi 11 11/01/2009 die i mensis xi annoque mmix 09 ix 2009} test clock-2.1678 {conversion of 2009-11-30} { clock format 1259584496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2009 12:34:56 die xxx mensis xi annoque mmix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2455166 11 xi 11 11/30/2009 die xxx mensis xi annoque mmix 09 ix 2009} test clock-2.1679 {conversion of 2009-12-01} { clock format 1259670896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2009 12:34:56 die i mensis xii annoque mmix xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2455167 12 xii 12 12/01/2009 die i mensis xii annoque mmix 09 ix 2009} test clock-2.1680 {conversion of 2009-12-31} { clock format 1262262896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2009 12:34:56 die xxxi mensis xii annoque mmix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2455197 12 xii 12 12/31/2009 die xxxi mensis xii annoque mmix 09 ix 2009} test clock-2.1681 {conversion of 2010-01-01} { clock format 1262349296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2010 12:34:56 die i mensis i annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2455198 01 i 1 01/01/2010 die i mensis i annoque mmx 10 x 2010} test clock-2.1682 {conversion of 2010-01-31} { clock format 1264941296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2010 12:34:56 die xxxi mensis i annoque mmx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2455228 01 i 1 01/31/2010 die xxxi mensis i annoque mmx 10 x 2010} test clock-2.1683 {conversion of 2010-02-01} { clock format 1265027696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2010 12:34:56 die i mensis ii annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2455229 02 ii 2 02/01/2010 die i mensis ii annoque mmx 10 x 2010} test clock-2.1684 {conversion of 2010-02-28} { clock format 1267360496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2010 12:34:56 die xxviii mensis ii annoque mmx xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2455256 02 ii 2 02/28/2010 die xxviii mensis ii annoque mmx 10 x 2010} test clock-2.1685 {conversion of 2010-03-01} { clock format 1267446896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2010 12:34:56 die i mensis iii annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2455257 03 iii 3 03/01/2010 die i mensis iii annoque mmx 10 x 2010} test clock-2.1686 {conversion of 2010-03-31} { clock format 1270038896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2010 12:34:56 die xxxi mensis iii annoque mmx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2455287 03 iii 3 03/31/2010 die xxxi mensis iii annoque mmx 10 x 2010} test clock-2.1687 {conversion of 2010-04-01} { clock format 1270125296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2010 12:34:56 die i mensis iv annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2455288 04 iv 4 04/01/2010 die i mensis iv annoque mmx 10 x 2010} test clock-2.1688 {conversion of 2010-04-30} { clock format 1272630896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2010 12:34:56 die xxx mensis iv annoque mmx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2455317 04 iv 4 04/30/2010 die xxx mensis iv annoque mmx 10 x 2010} test clock-2.1689 {conversion of 2010-05-01} { clock format 1272717296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2010 12:34:56 die i mensis v annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2455318 05 v 5 05/01/2010 die i mensis v annoque mmx 10 x 2010} test clock-2.1690 {conversion of 2010-05-31} { clock format 1275309296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2010 12:34:56 die xxxi mensis v annoque mmx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2455348 05 v 5 05/31/2010 die xxxi mensis v annoque mmx 10 x 2010} test clock-2.1691 {conversion of 2010-06-01} { clock format 1275395696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2010 12:34:56 die i mensis vi annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2455349 06 vi 6 06/01/2010 die i mensis vi annoque mmx 10 x 2010} test clock-2.1692 {conversion of 2010-06-30} { clock format 1277901296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2010 12:34:56 die xxx mensis vi annoque mmx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2455378 06 vi 6 06/30/2010 die xxx mensis vi annoque mmx 10 x 2010} test clock-2.1693 {conversion of 2010-07-01} { clock format 1277987696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2010 12:34:56 die i mensis vii annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2455379 07 vii 7 07/01/2010 die i mensis vii annoque mmx 10 x 2010} test clock-2.1694 {conversion of 2010-07-31} { clock format 1280579696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2010 12:34:56 die xxxi mensis vii annoque mmx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2455409 07 vii 7 07/31/2010 die xxxi mensis vii annoque mmx 10 x 2010} test clock-2.1695 {conversion of 2010-08-01} { clock format 1280666096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2010 12:34:56 die i mensis viii annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2455410 08 viii 8 08/01/2010 die i mensis viii annoque mmx 10 x 2010} test clock-2.1696 {conversion of 2010-08-31} { clock format 1283258096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2010 12:34:56 die xxxi mensis viii annoque mmx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2455440 08 viii 8 08/31/2010 die xxxi mensis viii annoque mmx 10 x 2010} test clock-2.1697 {conversion of 2010-09-01} { clock format 1283344496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2010 12:34:56 die i mensis ix annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2455441 09 ix 9 09/01/2010 die i mensis ix annoque mmx 10 x 2010} test clock-2.1698 {conversion of 2010-09-30} { clock format 1285850096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2010 12:34:56 die xxx mensis ix annoque mmx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2455470 09 ix 9 09/30/2010 die xxx mensis ix annoque mmx 10 x 2010} test clock-2.1699 {conversion of 2010-10-01} { clock format 1285936496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2010 12:34:56 die i mensis x annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2455471 10 x 10 10/01/2010 die i mensis x annoque mmx 10 x 2010} test clock-2.1700 {conversion of 2010-10-31} { clock format 1288528496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2010 12:34:56 die xxxi mensis x annoque mmx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2455501 10 x 10 10/31/2010 die xxxi mensis x annoque mmx 10 x 2010} test clock-2.1701 {conversion of 2010-11-01} { clock format 1288614896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2010 12:34:56 die i mensis xi annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2455502 11 xi 11 11/01/2010 die i mensis xi annoque mmx 10 x 2010} test clock-2.1702 {conversion of 2010-11-30} { clock format 1291120496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2010 12:34:56 die xxx mensis xi annoque mmx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2455531 11 xi 11 11/30/2010 die xxx mensis xi annoque mmx 10 x 2010} test clock-2.1703 {conversion of 2010-12-01} { clock format 1291206896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2010 12:34:56 die i mensis xii annoque mmx xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2455532 12 xii 12 12/01/2010 die i mensis xii annoque mmx 10 x 2010} test clock-2.1704 {conversion of 2010-12-31} { clock format 1293798896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2010 12:34:56 die xxxi mensis xii annoque mmx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2455562 12 xii 12 12/31/2010 die xxxi mensis xii annoque mmx 10 x 2010} test clock-2.1705 {conversion of 2011-01-01} { clock format 1293885296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2011 12:34:56 die i mensis i annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2455563 01 i 1 01/01/2011 die i mensis i annoque mmxi 11 xi 2011} test clock-2.1706 {conversion of 2011-01-31} { clock format 1296477296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2011 12:34:56 die xxxi mensis i annoque mmxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2455593 01 i 1 01/31/2011 die xxxi mensis i annoque mmxi 11 xi 2011} test clock-2.1707 {conversion of 2011-02-01} { clock format 1296563696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2011 12:34:56 die i mensis ii annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2455594 02 ii 2 02/01/2011 die i mensis ii annoque mmxi 11 xi 2011} test clock-2.1708 {conversion of 2011-02-28} { clock format 1298896496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2011 12:34:56 die xxviii mensis ii annoque mmxi xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2455621 02 ii 2 02/28/2011 die xxviii mensis ii annoque mmxi 11 xi 2011} test clock-2.1709 {conversion of 2011-03-01} { clock format 1298982896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2011 12:34:56 die i mensis iii annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2455622 03 iii 3 03/01/2011 die i mensis iii annoque mmxi 11 xi 2011} test clock-2.1710 {conversion of 2011-03-31} { clock format 1301574896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2011 12:34:56 die xxxi mensis iii annoque mmxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2455652 03 iii 3 03/31/2011 die xxxi mensis iii annoque mmxi 11 xi 2011} test clock-2.1711 {conversion of 2011-04-01} { clock format 1301661296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2011 12:34:56 die i mensis iv annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2455653 04 iv 4 04/01/2011 die i mensis iv annoque mmxi 11 xi 2011} test clock-2.1712 {conversion of 2011-04-30} { clock format 1304166896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2011 12:34:56 die xxx mensis iv annoque mmxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2455682 04 iv 4 04/30/2011 die xxx mensis iv annoque mmxi 11 xi 2011} test clock-2.1713 {conversion of 2011-05-01} { clock format 1304253296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2011 12:34:56 die i mensis v annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2455683 05 v 5 05/01/2011 die i mensis v annoque mmxi 11 xi 2011} test clock-2.1714 {conversion of 2011-05-31} { clock format 1306845296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2011 12:34:56 die xxxi mensis v annoque mmxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2455713 05 v 5 05/31/2011 die xxxi mensis v annoque mmxi 11 xi 2011} test clock-2.1715 {conversion of 2011-06-01} { clock format 1306931696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2011 12:34:56 die i mensis vi annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2455714 06 vi 6 06/01/2011 die i mensis vi annoque mmxi 11 xi 2011} test clock-2.1716 {conversion of 2011-06-30} { clock format 1309437296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2011 12:34:56 die xxx mensis vi annoque mmxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2455743 06 vi 6 06/30/2011 die xxx mensis vi annoque mmxi 11 xi 2011} test clock-2.1717 {conversion of 2011-07-01} { clock format 1309523696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2011 12:34:56 die i mensis vii annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2455744 07 vii 7 07/01/2011 die i mensis vii annoque mmxi 11 xi 2011} test clock-2.1718 {conversion of 2011-07-31} { clock format 1312115696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2011 12:34:56 die xxxi mensis vii annoque mmxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2455774 07 vii 7 07/31/2011 die xxxi mensis vii annoque mmxi 11 xi 2011} test clock-2.1719 {conversion of 2011-08-01} { clock format 1312202096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2011 12:34:56 die i mensis viii annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2455775 08 viii 8 08/01/2011 die i mensis viii annoque mmxi 11 xi 2011} test clock-2.1720 {conversion of 2011-08-31} { clock format 1314794096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2011 12:34:56 die xxxi mensis viii annoque mmxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2455805 08 viii 8 08/31/2011 die xxxi mensis viii annoque mmxi 11 xi 2011} test clock-2.1721 {conversion of 2011-09-01} { clock format 1314880496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2011 12:34:56 die i mensis ix annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2455806 09 ix 9 09/01/2011 die i mensis ix annoque mmxi 11 xi 2011} test clock-2.1722 {conversion of 2011-09-30} { clock format 1317386096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2011 12:34:56 die xxx mensis ix annoque mmxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2455835 09 ix 9 09/30/2011 die xxx mensis ix annoque mmxi 11 xi 2011} test clock-2.1723 {conversion of 2011-10-01} { clock format 1317472496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2011 12:34:56 die i mensis x annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2455836 10 x 10 10/01/2011 die i mensis x annoque mmxi 11 xi 2011} test clock-2.1724 {conversion of 2011-10-31} { clock format 1320064496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2011 12:34:56 die xxxi mensis x annoque mmxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2455866 10 x 10 10/31/2011 die xxxi mensis x annoque mmxi 11 xi 2011} test clock-2.1725 {conversion of 2011-11-01} { clock format 1320150896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2011 12:34:56 die i mensis xi annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2455867 11 xi 11 11/01/2011 die i mensis xi annoque mmxi 11 xi 2011} test clock-2.1726 {conversion of 2011-11-30} { clock format 1322656496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2011 12:34:56 die xxx mensis xi annoque mmxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2455896 11 xi 11 11/30/2011 die xxx mensis xi annoque mmxi 11 xi 2011} test clock-2.1727 {conversion of 2011-12-01} { clock format 1322742896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2011 12:34:56 die i mensis xii annoque mmxi xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2455897 12 xii 12 12/01/2011 die i mensis xii annoque mmxi 11 xi 2011} test clock-2.1728 {conversion of 2011-12-31} { clock format 1325334896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2011 12:34:56 die xxxi mensis xii annoque mmxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2455927 12 xii 12 12/31/2011 die xxxi mensis xii annoque mmxi 11 xi 2011} test clock-2.1729 {conversion of 2012-01-01} { clock format 1325421296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2012 12:34:56 die i mensis i annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2455928 01 i 1 01/01/2012 die i mensis i annoque mmxii 12 xii 2012} test clock-2.1730 {conversion of 2012-01-31} { clock format 1328013296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2012 12:34:56 die xxxi mensis i annoque mmxii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2455958 01 i 1 01/31/2012 die xxxi mensis i annoque mmxii 12 xii 2012} test clock-2.1731 {conversion of 2012-02-01} { clock format 1328099696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2012 12:34:56 die i mensis ii annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2455959 02 ii 2 02/01/2012 die i mensis ii annoque mmxii 12 xii 2012} test clock-2.1732 {conversion of 2012-02-29} { clock format 1330518896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2012 12:34:56 die xxix mensis ii annoque mmxii xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2455987 02 ii 2 02/29/2012 die xxix mensis ii annoque mmxii 12 xii 2012} test clock-2.1733 {conversion of 2012-03-01} { clock format 1330605296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2012 12:34:56 die i mensis iii annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2455988 03 iii 3 03/01/2012 die i mensis iii annoque mmxii 12 xii 2012} test clock-2.1734 {conversion of 2012-03-31} { clock format 1333197296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2012 12:34:56 die xxxi mensis iii annoque mmxii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2456018 03 iii 3 03/31/2012 die xxxi mensis iii annoque mmxii 12 xii 2012} test clock-2.1735 {conversion of 2012-04-01} { clock format 1333283696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2012 12:34:56 die i mensis iv annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2456019 04 iv 4 04/01/2012 die i mensis iv annoque mmxii 12 xii 2012} test clock-2.1736 {conversion of 2012-04-30} { clock format 1335789296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2012 12:34:56 die xxx mensis iv annoque mmxii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2456048 04 iv 4 04/30/2012 die xxx mensis iv annoque mmxii 12 xii 2012} test clock-2.1737 {conversion of 2012-05-01} { clock format 1335875696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2012 12:34:56 die i mensis v annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2456049 05 v 5 05/01/2012 die i mensis v annoque mmxii 12 xii 2012} test clock-2.1738 {conversion of 2012-05-31} { clock format 1338467696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2012 12:34:56 die xxxi mensis v annoque mmxii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2456079 05 v 5 05/31/2012 die xxxi mensis v annoque mmxii 12 xii 2012} test clock-2.1739 {conversion of 2012-06-01} { clock format 1338554096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2012 12:34:56 die i mensis vi annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2456080 06 vi 6 06/01/2012 die i mensis vi annoque mmxii 12 xii 2012} test clock-2.1740 {conversion of 2012-06-30} { clock format 1341059696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2012 12:34:56 die xxx mensis vi annoque mmxii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2456109 06 vi 6 06/30/2012 die xxx mensis vi annoque mmxii 12 xii 2012} test clock-2.1741 {conversion of 2012-07-01} { clock format 1341146096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2012 12:34:56 die i mensis vii annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2456110 07 vii 7 07/01/2012 die i mensis vii annoque mmxii 12 xii 2012} test clock-2.1742 {conversion of 2012-07-31} { clock format 1343738096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2012 12:34:56 die xxxi mensis vii annoque mmxii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2456140 07 vii 7 07/31/2012 die xxxi mensis vii annoque mmxii 12 xii 2012} test clock-2.1743 {conversion of 2012-08-01} { clock format 1343824496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2012 12:34:56 die i mensis viii annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2456141 08 viii 8 08/01/2012 die i mensis viii annoque mmxii 12 xii 2012} test clock-2.1744 {conversion of 2012-08-31} { clock format 1346416496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2012 12:34:56 die xxxi mensis viii annoque mmxii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2456171 08 viii 8 08/31/2012 die xxxi mensis viii annoque mmxii 12 xii 2012} test clock-2.1745 {conversion of 2012-09-01} { clock format 1346502896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2012 12:34:56 die i mensis ix annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2456172 09 ix 9 09/01/2012 die i mensis ix annoque mmxii 12 xii 2012} test clock-2.1746 {conversion of 2012-09-30} { clock format 1349008496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2012 12:34:56 die xxx mensis ix annoque mmxii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2456201 09 ix 9 09/30/2012 die xxx mensis ix annoque mmxii 12 xii 2012} test clock-2.1747 {conversion of 2012-10-01} { clock format 1349094896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2012 12:34:56 die i mensis x annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2456202 10 x 10 10/01/2012 die i mensis x annoque mmxii 12 xii 2012} test clock-2.1748 {conversion of 2012-10-31} { clock format 1351686896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2012 12:34:56 die xxxi mensis x annoque mmxii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2456232 10 x 10 10/31/2012 die xxxi mensis x annoque mmxii 12 xii 2012} test clock-2.1749 {conversion of 2012-11-01} { clock format 1351773296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2012 12:34:56 die i mensis xi annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2456233 11 xi 11 11/01/2012 die i mensis xi annoque mmxii 12 xii 2012} test clock-2.1750 {conversion of 2012-11-30} { clock format 1354278896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2012 12:34:56 die xxx mensis xi annoque mmxii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2456262 11 xi 11 11/30/2012 die xxx mensis xi annoque mmxii 12 xii 2012} test clock-2.1751 {conversion of 2012-12-01} { clock format 1354365296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2012 12:34:56 die i mensis xii annoque mmxii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2456263 12 xii 12 12/01/2012 die i mensis xii annoque mmxii 12 xii 2012} test clock-2.1752 {conversion of 2012-12-31} { clock format 1356957296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2012 12:34:56 die xxxi mensis xii annoque mmxii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2456293 12 xii 12 12/31/2012 die xxxi mensis xii annoque mmxii 12 xii 2012} test clock-2.1753 {conversion of 2013-01-01} { clock format 1357043696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2013 12:34:56 die i mensis i annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2456294 01 i 1 01/01/2013 die i mensis i annoque mmxiii 13 xiii 2013} test clock-2.1754 {conversion of 2013-01-31} { clock format 1359635696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2013 12:34:56 die xxxi mensis i annoque mmxiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2456324 01 i 1 01/31/2013 die xxxi mensis i annoque mmxiii 13 xiii 2013} test clock-2.1755 {conversion of 2013-02-01} { clock format 1359722096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2013 12:34:56 die i mensis ii annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2456325 02 ii 2 02/01/2013 die i mensis ii annoque mmxiii 13 xiii 2013} test clock-2.1756 {conversion of 2013-02-28} { clock format 1362054896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2013 12:34:56 die xxviii mensis ii annoque mmxiii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2456352 02 ii 2 02/28/2013 die xxviii mensis ii annoque mmxiii 13 xiii 2013} test clock-2.1757 {conversion of 2013-03-01} { clock format 1362141296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2013 12:34:56 die i mensis iii annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2456353 03 iii 3 03/01/2013 die i mensis iii annoque mmxiii 13 xiii 2013} test clock-2.1758 {conversion of 2013-03-31} { clock format 1364733296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2013 12:34:56 die xxxi mensis iii annoque mmxiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2456383 03 iii 3 03/31/2013 die xxxi mensis iii annoque mmxiii 13 xiii 2013} test clock-2.1759 {conversion of 2013-04-01} { clock format 1364819696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2013 12:34:56 die i mensis iv annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2456384 04 iv 4 04/01/2013 die i mensis iv annoque mmxiii 13 xiii 2013} test clock-2.1760 {conversion of 2013-04-30} { clock format 1367325296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2013 12:34:56 die xxx mensis iv annoque mmxiii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2456413 04 iv 4 04/30/2013 die xxx mensis iv annoque mmxiii 13 xiii 2013} test clock-2.1761 {conversion of 2013-05-01} { clock format 1367411696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2013 12:34:56 die i mensis v annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2456414 05 v 5 05/01/2013 die i mensis v annoque mmxiii 13 xiii 2013} test clock-2.1762 {conversion of 2013-05-31} { clock format 1370003696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2013 12:34:56 die xxxi mensis v annoque mmxiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2456444 05 v 5 05/31/2013 die xxxi mensis v annoque mmxiii 13 xiii 2013} test clock-2.1763 {conversion of 2013-06-01} { clock format 1370090096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2013 12:34:56 die i mensis vi annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2456445 06 vi 6 06/01/2013 die i mensis vi annoque mmxiii 13 xiii 2013} test clock-2.1764 {conversion of 2013-06-30} { clock format 1372595696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2013 12:34:56 die xxx mensis vi annoque mmxiii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2456474 06 vi 6 06/30/2013 die xxx mensis vi annoque mmxiii 13 xiii 2013} test clock-2.1765 {conversion of 2013-07-01} { clock format 1372682096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2013 12:34:56 die i mensis vii annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2456475 07 vii 7 07/01/2013 die i mensis vii annoque mmxiii 13 xiii 2013} test clock-2.1766 {conversion of 2013-07-31} { clock format 1375274096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2013 12:34:56 die xxxi mensis vii annoque mmxiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2456505 07 vii 7 07/31/2013 die xxxi mensis vii annoque mmxiii 13 xiii 2013} test clock-2.1767 {conversion of 2013-08-01} { clock format 1375360496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2013 12:34:56 die i mensis viii annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2456506 08 viii 8 08/01/2013 die i mensis viii annoque mmxiii 13 xiii 2013} test clock-2.1768 {conversion of 2013-08-31} { clock format 1377952496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2013 12:34:56 die xxxi mensis viii annoque mmxiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2456536 08 viii 8 08/31/2013 die xxxi mensis viii annoque mmxiii 13 xiii 2013} test clock-2.1769 {conversion of 2013-09-01} { clock format 1378038896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2013 12:34:56 die i mensis ix annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2456537 09 ix 9 09/01/2013 die i mensis ix annoque mmxiii 13 xiii 2013} test clock-2.1770 {conversion of 2013-09-30} { clock format 1380544496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2013 12:34:56 die xxx mensis ix annoque mmxiii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2456566 09 ix 9 09/30/2013 die xxx mensis ix annoque mmxiii 13 xiii 2013} test clock-2.1771 {conversion of 2013-10-01} { clock format 1380630896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2013 12:34:56 die i mensis x annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2456567 10 x 10 10/01/2013 die i mensis x annoque mmxiii 13 xiii 2013} test clock-2.1772 {conversion of 2013-10-31} { clock format 1383222896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2013 12:34:56 die xxxi mensis x annoque mmxiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2456597 10 x 10 10/31/2013 die xxxi mensis x annoque mmxiii 13 xiii 2013} test clock-2.1773 {conversion of 2013-11-01} { clock format 1383309296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2013 12:34:56 die i mensis xi annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2456598 11 xi 11 11/01/2013 die i mensis xi annoque mmxiii 13 xiii 2013} test clock-2.1774 {conversion of 2013-11-30} { clock format 1385814896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2013 12:34:56 die xxx mensis xi annoque mmxiii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2456627 11 xi 11 11/30/2013 die xxx mensis xi annoque mmxiii 13 xiii 2013} test clock-2.1775 {conversion of 2013-12-01} { clock format 1385901296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2013 12:34:56 die i mensis xii annoque mmxiii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2456628 12 xii 12 12/01/2013 die i mensis xii annoque mmxiii 13 xiii 2013} test clock-2.1776 {conversion of 2013-12-31} { clock format 1388493296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2013 12:34:56 die xxxi mensis xii annoque mmxiii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2456658 12 xii 12 12/31/2013 die xxxi mensis xii annoque mmxiii 13 xiii 2013} test clock-2.1777 {conversion of 2016-01-01} { clock format 1451651696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2016 12:34:56 die i mensis i annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2457389 01 i 1 01/01/2016 die i mensis i annoque mmxvi 16 xvi 2016} test clock-2.1778 {conversion of 2016-01-31} { clock format 1454243696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2016 12:34:56 die xxxi mensis i annoque mmxvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2457419 01 i 1 01/31/2016 die xxxi mensis i annoque mmxvi 16 xvi 2016} test clock-2.1779 {conversion of 2016-02-01} { clock format 1454330096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2016 12:34:56 die i mensis ii annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2457420 02 ii 2 02/01/2016 die i mensis ii annoque mmxvi 16 xvi 2016} test clock-2.1780 {conversion of 2016-02-29} { clock format 1456749296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2016 12:34:56 die xxix mensis ii annoque mmxvi xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2457448 02 ii 2 02/29/2016 die xxix mensis ii annoque mmxvi 16 xvi 2016} test clock-2.1781 {conversion of 2016-03-01} { clock format 1456835696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2016 12:34:56 die i mensis iii annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2457449 03 iii 3 03/01/2016 die i mensis iii annoque mmxvi 16 xvi 2016} test clock-2.1782 {conversion of 2016-03-31} { clock format 1459427696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2016 12:34:56 die xxxi mensis iii annoque mmxvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2457479 03 iii 3 03/31/2016 die xxxi mensis iii annoque mmxvi 16 xvi 2016} test clock-2.1783 {conversion of 2016-04-01} { clock format 1459514096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2016 12:34:56 die i mensis iv annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2457480 04 iv 4 04/01/2016 die i mensis iv annoque mmxvi 16 xvi 2016} test clock-2.1784 {conversion of 2016-04-30} { clock format 1462019696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2016 12:34:56 die xxx mensis iv annoque mmxvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2457509 04 iv 4 04/30/2016 die xxx mensis iv annoque mmxvi 16 xvi 2016} test clock-2.1785 {conversion of 2016-05-01} { clock format 1462106096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2016 12:34:56 die i mensis v annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2457510 05 v 5 05/01/2016 die i mensis v annoque mmxvi 16 xvi 2016} test clock-2.1786 {conversion of 2016-05-31} { clock format 1464698096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2016 12:34:56 die xxxi mensis v annoque mmxvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2457540 05 v 5 05/31/2016 die xxxi mensis v annoque mmxvi 16 xvi 2016} test clock-2.1787 {conversion of 2016-06-01} { clock format 1464784496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2016 12:34:56 die i mensis vi annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2457541 06 vi 6 06/01/2016 die i mensis vi annoque mmxvi 16 xvi 2016} test clock-2.1788 {conversion of 2016-06-30} { clock format 1467290096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2016 12:34:56 die xxx mensis vi annoque mmxvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2457570 06 vi 6 06/30/2016 die xxx mensis vi annoque mmxvi 16 xvi 2016} test clock-2.1789 {conversion of 2016-07-01} { clock format 1467376496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2016 12:34:56 die i mensis vii annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2457571 07 vii 7 07/01/2016 die i mensis vii annoque mmxvi 16 xvi 2016} test clock-2.1790 {conversion of 2016-07-31} { clock format 1469968496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2016 12:34:56 die xxxi mensis vii annoque mmxvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2457601 07 vii 7 07/31/2016 die xxxi mensis vii annoque mmxvi 16 xvi 2016} test clock-2.1791 {conversion of 2016-08-01} { clock format 1470054896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2016 12:34:56 die i mensis viii annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2457602 08 viii 8 08/01/2016 die i mensis viii annoque mmxvi 16 xvi 2016} test clock-2.1792 {conversion of 2016-08-31} { clock format 1472646896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2016 12:34:56 die xxxi mensis viii annoque mmxvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2457632 08 viii 8 08/31/2016 die xxxi mensis viii annoque mmxvi 16 xvi 2016} test clock-2.1793 {conversion of 2016-09-01} { clock format 1472733296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2016 12:34:56 die i mensis ix annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2457633 09 ix 9 09/01/2016 die i mensis ix annoque mmxvi 16 xvi 2016} test clock-2.1794 {conversion of 2016-09-30} { clock format 1475238896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2016 12:34:56 die xxx mensis ix annoque mmxvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2457662 09 ix 9 09/30/2016 die xxx mensis ix annoque mmxvi 16 xvi 2016} test clock-2.1795 {conversion of 2016-10-01} { clock format 1475325296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2016 12:34:56 die i mensis x annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2457663 10 x 10 10/01/2016 die i mensis x annoque mmxvi 16 xvi 2016} test clock-2.1796 {conversion of 2016-10-31} { clock format 1477917296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2016 12:34:56 die xxxi mensis x annoque mmxvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2457693 10 x 10 10/31/2016 die xxxi mensis x annoque mmxvi 16 xvi 2016} test clock-2.1797 {conversion of 2016-11-01} { clock format 1478003696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2016 12:34:56 die i mensis xi annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2457694 11 xi 11 11/01/2016 die i mensis xi annoque mmxvi 16 xvi 2016} test clock-2.1798 {conversion of 2016-11-30} { clock format 1480509296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2016 12:34:56 die xxx mensis xi annoque mmxvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2457723 11 xi 11 11/30/2016 die xxx mensis xi annoque mmxvi 16 xvi 2016} test clock-2.1799 {conversion of 2016-12-01} { clock format 1480595696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2016 12:34:56 die i mensis xii annoque mmxvi xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2457724 12 xii 12 12/01/2016 die i mensis xii annoque mmxvi 16 xvi 2016} test clock-2.1800 {conversion of 2016-12-31} { clock format 1483187696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2016 12:34:56 die xxxi mensis xii annoque mmxvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2457754 12 xii 12 12/31/2016 die xxxi mensis xii annoque mmxvi 16 xvi 2016} test clock-2.1801 {conversion of 2017-01-01} { clock format 1483274096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2017 12:34:56 die i mensis i annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2457755 01 i 1 01/01/2017 die i mensis i annoque mmxvii 17 xvii 2017} test clock-2.1802 {conversion of 2017-01-31} { clock format 1485866096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2017 12:34:56 die xxxi mensis i annoque mmxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2457785 01 i 1 01/31/2017 die xxxi mensis i annoque mmxvii 17 xvii 2017} test clock-2.1803 {conversion of 2017-02-01} { clock format 1485952496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2017 12:34:56 die i mensis ii annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2457786 02 ii 2 02/01/2017 die i mensis ii annoque mmxvii 17 xvii 2017} test clock-2.1804 {conversion of 2017-02-28} { clock format 1488285296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2017 12:34:56 die xxviii mensis ii annoque mmxvii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2457813 02 ii 2 02/28/2017 die xxviii mensis ii annoque mmxvii 17 xvii 2017} test clock-2.1805 {conversion of 2017-03-01} { clock format 1488371696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2017 12:34:56 die i mensis iii annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2457814 03 iii 3 03/01/2017 die i mensis iii annoque mmxvii 17 xvii 2017} test clock-2.1806 {conversion of 2017-03-31} { clock format 1490963696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2017 12:34:56 die xxxi mensis iii annoque mmxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2457844 03 iii 3 03/31/2017 die xxxi mensis iii annoque mmxvii 17 xvii 2017} test clock-2.1807 {conversion of 2017-04-01} { clock format 1491050096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2017 12:34:56 die i mensis iv annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2457845 04 iv 4 04/01/2017 die i mensis iv annoque mmxvii 17 xvii 2017} test clock-2.1808 {conversion of 2017-04-30} { clock format 1493555696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2017 12:34:56 die xxx mensis iv annoque mmxvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2457874 04 iv 4 04/30/2017 die xxx mensis iv annoque mmxvii 17 xvii 2017} test clock-2.1809 {conversion of 2017-05-01} { clock format 1493642096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2017 12:34:56 die i mensis v annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2457875 05 v 5 05/01/2017 die i mensis v annoque mmxvii 17 xvii 2017} test clock-2.1810 {conversion of 2017-05-31} { clock format 1496234096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2017 12:34:56 die xxxi mensis v annoque mmxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2457905 05 v 5 05/31/2017 die xxxi mensis v annoque mmxvii 17 xvii 2017} test clock-2.1811 {conversion of 2017-06-01} { clock format 1496320496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2017 12:34:56 die i mensis vi annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2457906 06 vi 6 06/01/2017 die i mensis vi annoque mmxvii 17 xvii 2017} test clock-2.1812 {conversion of 2017-06-30} { clock format 1498826096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2017 12:34:56 die xxx mensis vi annoque mmxvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2457935 06 vi 6 06/30/2017 die xxx mensis vi annoque mmxvii 17 xvii 2017} test clock-2.1813 {conversion of 2017-07-01} { clock format 1498912496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2017 12:34:56 die i mensis vii annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2457936 07 vii 7 07/01/2017 die i mensis vii annoque mmxvii 17 xvii 2017} test clock-2.1814 {conversion of 2017-07-31} { clock format 1501504496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2017 12:34:56 die xxxi mensis vii annoque mmxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2457966 07 vii 7 07/31/2017 die xxxi mensis vii annoque mmxvii 17 xvii 2017} test clock-2.1815 {conversion of 2017-08-01} { clock format 1501590896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2017 12:34:56 die i mensis viii annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2457967 08 viii 8 08/01/2017 die i mensis viii annoque mmxvii 17 xvii 2017} test clock-2.1816 {conversion of 2017-08-31} { clock format 1504182896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2017 12:34:56 die xxxi mensis viii annoque mmxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2457997 08 viii 8 08/31/2017 die xxxi mensis viii annoque mmxvii 17 xvii 2017} test clock-2.1817 {conversion of 2017-09-01} { clock format 1504269296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2017 12:34:56 die i mensis ix annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2457998 09 ix 9 09/01/2017 die i mensis ix annoque mmxvii 17 xvii 2017} test clock-2.1818 {conversion of 2017-09-30} { clock format 1506774896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2017 12:34:56 die xxx mensis ix annoque mmxvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2458027 09 ix 9 09/30/2017 die xxx mensis ix annoque mmxvii 17 xvii 2017} test clock-2.1819 {conversion of 2017-10-01} { clock format 1506861296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2017 12:34:56 die i mensis x annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2458028 10 x 10 10/01/2017 die i mensis x annoque mmxvii 17 xvii 2017} test clock-2.1820 {conversion of 2017-10-31} { clock format 1509453296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2017 12:34:56 die xxxi mensis x annoque mmxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2458058 10 x 10 10/31/2017 die xxxi mensis x annoque mmxvii 17 xvii 2017} test clock-2.1821 {conversion of 2017-11-01} { clock format 1509539696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2017 12:34:56 die i mensis xi annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2458059 11 xi 11 11/01/2017 die i mensis xi annoque mmxvii 17 xvii 2017} test clock-2.1822 {conversion of 2017-11-30} { clock format 1512045296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2017 12:34:56 die xxx mensis xi annoque mmxvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2458088 11 xi 11 11/30/2017 die xxx mensis xi annoque mmxvii 17 xvii 2017} test clock-2.1823 {conversion of 2017-12-01} { clock format 1512131696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2017 12:34:56 die i mensis xii annoque mmxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2458089 12 xii 12 12/01/2017 die i mensis xii annoque mmxvii 17 xvii 2017} test clock-2.1824 {conversion of 2017-12-31} { clock format 1514723696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2017 12:34:56 die xxxi mensis xii annoque mmxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2458119 12 xii 12 12/31/2017 die xxxi mensis xii annoque mmxvii 17 xvii 2017} test clock-2.1825 {conversion of 2020-01-01} { clock format 1577882096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2020 12:34:56 die i mensis i annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2458850 01 i 1 01/01/2020 die i mensis i annoque mmxx 20 xx 2020} test clock-2.1826 {conversion of 2020-01-31} { clock format 1580474096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2020 12:34:56 die xxxi mensis i annoque mmxx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2458880 01 i 1 01/31/2020 die xxxi mensis i annoque mmxx 20 xx 2020} test clock-2.1827 {conversion of 2020-02-01} { clock format 1580560496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2020 12:34:56 die i mensis ii annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2458881 02 ii 2 02/01/2020 die i mensis ii annoque mmxx 20 xx 2020} test clock-2.1828 {conversion of 2020-02-29} { clock format 1582979696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2020 12:34:56 die xxix mensis ii annoque mmxx xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2458909 02 ii 2 02/29/2020 die xxix mensis ii annoque mmxx 20 xx 2020} test clock-2.1829 {conversion of 2020-03-01} { clock format 1583066096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2020 12:34:56 die i mensis iii annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2458910 03 iii 3 03/01/2020 die i mensis iii annoque mmxx 20 xx 2020} test clock-2.1830 {conversion of 2020-03-31} { clock format 1585658096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2020 12:34:56 die xxxi mensis iii annoque mmxx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2458940 03 iii 3 03/31/2020 die xxxi mensis iii annoque mmxx 20 xx 2020} test clock-2.1831 {conversion of 2020-04-01} { clock format 1585744496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2020 12:34:56 die i mensis iv annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2458941 04 iv 4 04/01/2020 die i mensis iv annoque mmxx 20 xx 2020} test clock-2.1832 {conversion of 2020-04-30} { clock format 1588250096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2020 12:34:56 die xxx mensis iv annoque mmxx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2458970 04 iv 4 04/30/2020 die xxx mensis iv annoque mmxx 20 xx 2020} test clock-2.1833 {conversion of 2020-05-01} { clock format 1588336496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2020 12:34:56 die i mensis v annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2458971 05 v 5 05/01/2020 die i mensis v annoque mmxx 20 xx 2020} test clock-2.1834 {conversion of 2020-05-31} { clock format 1590928496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2020 12:34:56 die xxxi mensis v annoque mmxx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2459001 05 v 5 05/31/2020 die xxxi mensis v annoque mmxx 20 xx 2020} test clock-2.1835 {conversion of 2020-06-01} { clock format 1591014896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2020 12:34:56 die i mensis vi annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2459002 06 vi 6 06/01/2020 die i mensis vi annoque mmxx 20 xx 2020} test clock-2.1836 {conversion of 2020-06-30} { clock format 1593520496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2020 12:34:56 die xxx mensis vi annoque mmxx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2459031 06 vi 6 06/30/2020 die xxx mensis vi annoque mmxx 20 xx 2020} test clock-2.1837 {conversion of 2020-07-01} { clock format 1593606896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2020 12:34:56 die i mensis vii annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2459032 07 vii 7 07/01/2020 die i mensis vii annoque mmxx 20 xx 2020} test clock-2.1838 {conversion of 2020-07-31} { clock format 1596198896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2020 12:34:56 die xxxi mensis vii annoque mmxx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2459062 07 vii 7 07/31/2020 die xxxi mensis vii annoque mmxx 20 xx 2020} test clock-2.1839 {conversion of 2020-08-01} { clock format 1596285296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2020 12:34:56 die i mensis viii annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2459063 08 viii 8 08/01/2020 die i mensis viii annoque mmxx 20 xx 2020} test clock-2.1840 {conversion of 2020-08-31} { clock format 1598877296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2020 12:34:56 die xxxi mensis viii annoque mmxx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2459093 08 viii 8 08/31/2020 die xxxi mensis viii annoque mmxx 20 xx 2020} test clock-2.1841 {conversion of 2020-09-01} { clock format 1598963696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2020 12:34:56 die i mensis ix annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2459094 09 ix 9 09/01/2020 die i mensis ix annoque mmxx 20 xx 2020} test clock-2.1842 {conversion of 2020-09-30} { clock format 1601469296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2020 12:34:56 die xxx mensis ix annoque mmxx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2459123 09 ix 9 09/30/2020 die xxx mensis ix annoque mmxx 20 xx 2020} test clock-2.1843 {conversion of 2020-10-01} { clock format 1601555696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2020 12:34:56 die i mensis x annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2459124 10 x 10 10/01/2020 die i mensis x annoque mmxx 20 xx 2020} test clock-2.1844 {conversion of 2020-10-31} { clock format 1604147696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2020 12:34:56 die xxxi mensis x annoque mmxx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2459154 10 x 10 10/31/2020 die xxxi mensis x annoque mmxx 20 xx 2020} test clock-2.1845 {conversion of 2020-11-01} { clock format 1604234096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2020 12:34:56 die i mensis xi annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2459155 11 xi 11 11/01/2020 die i mensis xi annoque mmxx 20 xx 2020} test clock-2.1846 {conversion of 2020-11-30} { clock format 1606739696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2020 12:34:56 die xxx mensis xi annoque mmxx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2459184 11 xi 11 11/30/2020 die xxx mensis xi annoque mmxx 20 xx 2020} test clock-2.1847 {conversion of 2020-12-01} { clock format 1606826096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2020 12:34:56 die i mensis xii annoque mmxx xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2459185 12 xii 12 12/01/2020 die i mensis xii annoque mmxx 20 xx 2020} test clock-2.1848 {conversion of 2020-12-31} { clock format 1609418096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2020 12:34:56 die xxxi mensis xii annoque mmxx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2459215 12 xii 12 12/31/2020 die xxxi mensis xii annoque mmxx 20 xx 2020} test clock-2.1849 {conversion of 2021-01-01} { clock format 1609504496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2021 12:34:56 die i mensis i annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2459216 01 i 1 01/01/2021 die i mensis i annoque mmxxi 21 xxi 2021} test clock-2.1850 {conversion of 2021-01-31} { clock format 1612096496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2021 12:34:56 die xxxi mensis i annoque mmxxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2459246 01 i 1 01/31/2021 die xxxi mensis i annoque mmxxi 21 xxi 2021} test clock-2.1851 {conversion of 2021-02-01} { clock format 1612182896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2021 12:34:56 die i mensis ii annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2459247 02 ii 2 02/01/2021 die i mensis ii annoque mmxxi 21 xxi 2021} test clock-2.1852 {conversion of 2021-02-28} { clock format 1614515696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2021 12:34:56 die xxviii mensis ii annoque mmxxi xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2459274 02 ii 2 02/28/2021 die xxviii mensis ii annoque mmxxi 21 xxi 2021} test clock-2.1853 {conversion of 2021-03-01} { clock format 1614602096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2021 12:34:56 die i mensis iii annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2459275 03 iii 3 03/01/2021 die i mensis iii annoque mmxxi 21 xxi 2021} test clock-2.1854 {conversion of 2021-03-31} { clock format 1617194096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2021 12:34:56 die xxxi mensis iii annoque mmxxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2459305 03 iii 3 03/31/2021 die xxxi mensis iii annoque mmxxi 21 xxi 2021} test clock-2.1855 {conversion of 2021-04-01} { clock format 1617280496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2021 12:34:56 die i mensis iv annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2459306 04 iv 4 04/01/2021 die i mensis iv annoque mmxxi 21 xxi 2021} test clock-2.1856 {conversion of 2021-04-30} { clock format 1619786096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2021 12:34:56 die xxx mensis iv annoque mmxxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2459335 04 iv 4 04/30/2021 die xxx mensis iv annoque mmxxi 21 xxi 2021} test clock-2.1857 {conversion of 2021-05-01} { clock format 1619872496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2021 12:34:56 die i mensis v annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2459336 05 v 5 05/01/2021 die i mensis v annoque mmxxi 21 xxi 2021} test clock-2.1858 {conversion of 2021-05-31} { clock format 1622464496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2021 12:34:56 die xxxi mensis v annoque mmxxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2459366 05 v 5 05/31/2021 die xxxi mensis v annoque mmxxi 21 xxi 2021} test clock-2.1859 {conversion of 2021-06-01} { clock format 1622550896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2021 12:34:56 die i mensis vi annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2459367 06 vi 6 06/01/2021 die i mensis vi annoque mmxxi 21 xxi 2021} test clock-2.1860 {conversion of 2021-06-30} { clock format 1625056496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2021 12:34:56 die xxx mensis vi annoque mmxxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2459396 06 vi 6 06/30/2021 die xxx mensis vi annoque mmxxi 21 xxi 2021} test clock-2.1861 {conversion of 2021-07-01} { clock format 1625142896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2021 12:34:56 die i mensis vii annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2459397 07 vii 7 07/01/2021 die i mensis vii annoque mmxxi 21 xxi 2021} test clock-2.1862 {conversion of 2021-07-31} { clock format 1627734896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2021 12:34:56 die xxxi mensis vii annoque mmxxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2459427 07 vii 7 07/31/2021 die xxxi mensis vii annoque mmxxi 21 xxi 2021} test clock-2.1863 {conversion of 2021-08-01} { clock format 1627821296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2021 12:34:56 die i mensis viii annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2459428 08 viii 8 08/01/2021 die i mensis viii annoque mmxxi 21 xxi 2021} test clock-2.1864 {conversion of 2021-08-31} { clock format 1630413296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2021 12:34:56 die xxxi mensis viii annoque mmxxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2459458 08 viii 8 08/31/2021 die xxxi mensis viii annoque mmxxi 21 xxi 2021} test clock-2.1865 {conversion of 2021-09-01} { clock format 1630499696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2021 12:34:56 die i mensis ix annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2459459 09 ix 9 09/01/2021 die i mensis ix annoque mmxxi 21 xxi 2021} test clock-2.1866 {conversion of 2021-09-30} { clock format 1633005296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2021 12:34:56 die xxx mensis ix annoque mmxxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2459488 09 ix 9 09/30/2021 die xxx mensis ix annoque mmxxi 21 xxi 2021} test clock-2.1867 {conversion of 2021-10-01} { clock format 1633091696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2021 12:34:56 die i mensis x annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2459489 10 x 10 10/01/2021 die i mensis x annoque mmxxi 21 xxi 2021} test clock-2.1868 {conversion of 2021-10-31} { clock format 1635683696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2021 12:34:56 die xxxi mensis x annoque mmxxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2459519 10 x 10 10/31/2021 die xxxi mensis x annoque mmxxi 21 xxi 2021} test clock-2.1869 {conversion of 2021-11-01} { clock format 1635770096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2021 12:34:56 die i mensis xi annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2459520 11 xi 11 11/01/2021 die i mensis xi annoque mmxxi 21 xxi 2021} test clock-2.1870 {conversion of 2021-11-30} { clock format 1638275696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2021 12:34:56 die xxx mensis xi annoque mmxxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2459549 11 xi 11 11/30/2021 die xxx mensis xi annoque mmxxi 21 xxi 2021} test clock-2.1871 {conversion of 2021-12-01} { clock format 1638362096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2021 12:34:56 die i mensis xii annoque mmxxi xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2459550 12 xii 12 12/01/2021 die i mensis xii annoque mmxxi 21 xxi 2021} test clock-2.1872 {conversion of 2021-12-31} { clock format 1640954096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2021 12:34:56 die xxxi mensis xii annoque mmxxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2459580 12 xii 12 12/31/2021 die xxxi mensis xii annoque mmxxi 21 xxi 2021} test clock-2.1873 {conversion of 2024-01-01} { clock format 1704112496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2024 12:34:56 die i mensis i annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2460311 01 i 1 01/01/2024 die i mensis i annoque mmxxiv 24 xxiv 2024} test clock-2.1874 {conversion of 2024-01-31} { clock format 1706704496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2024 12:34:56 die xxxi mensis i annoque mmxxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2460341 01 i 1 01/31/2024 die xxxi mensis i annoque mmxxiv 24 xxiv 2024} test clock-2.1875 {conversion of 2024-02-01} { clock format 1706790896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2024 12:34:56 die i mensis ii annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2460342 02 ii 2 02/01/2024 die i mensis ii annoque mmxxiv 24 xxiv 2024} test clock-2.1876 {conversion of 2024-02-29} { clock format 1709210096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2024 12:34:56 die xxix mensis ii annoque mmxxiv xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2460370 02 ii 2 02/29/2024 die xxix mensis ii annoque mmxxiv 24 xxiv 2024} test clock-2.1877 {conversion of 2024-03-01} { clock format 1709296496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2024 12:34:56 die i mensis iii annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2460371 03 iii 3 03/01/2024 die i mensis iii annoque mmxxiv 24 xxiv 2024} test clock-2.1878 {conversion of 2024-03-31} { clock format 1711888496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2024 12:34:56 die xxxi mensis iii annoque mmxxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2460401 03 iii 3 03/31/2024 die xxxi mensis iii annoque mmxxiv 24 xxiv 2024} test clock-2.1879 {conversion of 2024-04-01} { clock format 1711974896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2024 12:34:56 die i mensis iv annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2460402 04 iv 4 04/01/2024 die i mensis iv annoque mmxxiv 24 xxiv 2024} test clock-2.1880 {conversion of 2024-04-30} { clock format 1714480496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2024 12:34:56 die xxx mensis iv annoque mmxxiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2460431 04 iv 4 04/30/2024 die xxx mensis iv annoque mmxxiv 24 xxiv 2024} test clock-2.1881 {conversion of 2024-05-01} { clock format 1714566896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2024 12:34:56 die i mensis v annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2460432 05 v 5 05/01/2024 die i mensis v annoque mmxxiv 24 xxiv 2024} test clock-2.1882 {conversion of 2024-05-31} { clock format 1717158896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2024 12:34:56 die xxxi mensis v annoque mmxxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2460462 05 v 5 05/31/2024 die xxxi mensis v annoque mmxxiv 24 xxiv 2024} test clock-2.1883 {conversion of 2024-06-01} { clock format 1717245296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2024 12:34:56 die i mensis vi annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2460463 06 vi 6 06/01/2024 die i mensis vi annoque mmxxiv 24 xxiv 2024} test clock-2.1884 {conversion of 2024-06-30} { clock format 1719750896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2024 12:34:56 die xxx mensis vi annoque mmxxiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2460492 06 vi 6 06/30/2024 die xxx mensis vi annoque mmxxiv 24 xxiv 2024} test clock-2.1885 {conversion of 2024-07-01} { clock format 1719837296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2024 12:34:56 die i mensis vii annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2460493 07 vii 7 07/01/2024 die i mensis vii annoque mmxxiv 24 xxiv 2024} test clock-2.1886 {conversion of 2024-07-31} { clock format 1722429296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2024 12:34:56 die xxxi mensis vii annoque mmxxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2460523 07 vii 7 07/31/2024 die xxxi mensis vii annoque mmxxiv 24 xxiv 2024} test clock-2.1887 {conversion of 2024-08-01} { clock format 1722515696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2024 12:34:56 die i mensis viii annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2460524 08 viii 8 08/01/2024 die i mensis viii annoque mmxxiv 24 xxiv 2024} test clock-2.1888 {conversion of 2024-08-31} { clock format 1725107696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2024 12:34:56 die xxxi mensis viii annoque mmxxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2460554 08 viii 8 08/31/2024 die xxxi mensis viii annoque mmxxiv 24 xxiv 2024} test clock-2.1889 {conversion of 2024-09-01} { clock format 1725194096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2024 12:34:56 die i mensis ix annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2460555 09 ix 9 09/01/2024 die i mensis ix annoque mmxxiv 24 xxiv 2024} test clock-2.1890 {conversion of 2024-09-30} { clock format 1727699696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2024 12:34:56 die xxx mensis ix annoque mmxxiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2460584 09 ix 9 09/30/2024 die xxx mensis ix annoque mmxxiv 24 xxiv 2024} test clock-2.1891 {conversion of 2024-10-01} { clock format 1727786096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2024 12:34:56 die i mensis x annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2460585 10 x 10 10/01/2024 die i mensis x annoque mmxxiv 24 xxiv 2024} test clock-2.1892 {conversion of 2024-10-31} { clock format 1730378096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2024 12:34:56 die xxxi mensis x annoque mmxxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2460615 10 x 10 10/31/2024 die xxxi mensis x annoque mmxxiv 24 xxiv 2024} test clock-2.1893 {conversion of 2024-11-01} { clock format 1730464496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2024 12:34:56 die i mensis xi annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2460616 11 xi 11 11/01/2024 die i mensis xi annoque mmxxiv 24 xxiv 2024} test clock-2.1894 {conversion of 2024-11-30} { clock format 1732970096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2024 12:34:56 die xxx mensis xi annoque mmxxiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2460645 11 xi 11 11/30/2024 die xxx mensis xi annoque mmxxiv 24 xxiv 2024} test clock-2.1895 {conversion of 2024-12-01} { clock format 1733056496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2024 12:34:56 die i mensis xii annoque mmxxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2460646 12 xii 12 12/01/2024 die i mensis xii annoque mmxxiv 24 xxiv 2024} test clock-2.1896 {conversion of 2024-12-31} { clock format 1735648496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2024 12:34:56 die xxxi mensis xii annoque mmxxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2460676 12 xii 12 12/31/2024 die xxxi mensis xii annoque mmxxiv 24 xxiv 2024} test clock-2.1897 {conversion of 2025-01-01} { clock format 1735734896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2025 12:34:56 die i mensis i annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2460677 01 i 1 01/01/2025 die i mensis i annoque mmxxv 25 xxv 2025} test clock-2.1898 {conversion of 2025-01-31} { clock format 1738326896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2025 12:34:56 die xxxi mensis i annoque mmxxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2460707 01 i 1 01/31/2025 die xxxi mensis i annoque mmxxv 25 xxv 2025} test clock-2.1899 {conversion of 2025-02-01} { clock format 1738413296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2025 12:34:56 die i mensis ii annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2460708 02 ii 2 02/01/2025 die i mensis ii annoque mmxxv 25 xxv 2025} test clock-2.1900 {conversion of 2025-02-28} { clock format 1740746096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2025 12:34:56 die xxviii mensis ii annoque mmxxv xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2460735 02 ii 2 02/28/2025 die xxviii mensis ii annoque mmxxv 25 xxv 2025} test clock-2.1901 {conversion of 2025-03-01} { clock format 1740832496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2025 12:34:56 die i mensis iii annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2460736 03 iii 3 03/01/2025 die i mensis iii annoque mmxxv 25 xxv 2025} test clock-2.1902 {conversion of 2025-03-31} { clock format 1743424496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2025 12:34:56 die xxxi mensis iii annoque mmxxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2460766 03 iii 3 03/31/2025 die xxxi mensis iii annoque mmxxv 25 xxv 2025} test clock-2.1903 {conversion of 2025-04-01} { clock format 1743510896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2025 12:34:56 die i mensis iv annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2460767 04 iv 4 04/01/2025 die i mensis iv annoque mmxxv 25 xxv 2025} test clock-2.1904 {conversion of 2025-04-30} { clock format 1746016496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2025 12:34:56 die xxx mensis iv annoque mmxxv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2460796 04 iv 4 04/30/2025 die xxx mensis iv annoque mmxxv 25 xxv 2025} test clock-2.1905 {conversion of 2025-05-01} { clock format 1746102896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2025 12:34:56 die i mensis v annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2460797 05 v 5 05/01/2025 die i mensis v annoque mmxxv 25 xxv 2025} test clock-2.1906 {conversion of 2025-05-31} { clock format 1748694896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2025 12:34:56 die xxxi mensis v annoque mmxxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2460827 05 v 5 05/31/2025 die xxxi mensis v annoque mmxxv 25 xxv 2025} test clock-2.1907 {conversion of 2025-06-01} { clock format 1748781296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2025 12:34:56 die i mensis vi annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2460828 06 vi 6 06/01/2025 die i mensis vi annoque mmxxv 25 xxv 2025} test clock-2.1908 {conversion of 2025-06-30} { clock format 1751286896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2025 12:34:56 die xxx mensis vi annoque mmxxv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2460857 06 vi 6 06/30/2025 die xxx mensis vi annoque mmxxv 25 xxv 2025} test clock-2.1909 {conversion of 2025-07-01} { clock format 1751373296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2025 12:34:56 die i mensis vii annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2460858 07 vii 7 07/01/2025 die i mensis vii annoque mmxxv 25 xxv 2025} test clock-2.1910 {conversion of 2025-07-31} { clock format 1753965296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2025 12:34:56 die xxxi mensis vii annoque mmxxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2460888 07 vii 7 07/31/2025 die xxxi mensis vii annoque mmxxv 25 xxv 2025} test clock-2.1911 {conversion of 2025-08-01} { clock format 1754051696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2025 12:34:56 die i mensis viii annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2460889 08 viii 8 08/01/2025 die i mensis viii annoque mmxxv 25 xxv 2025} test clock-2.1912 {conversion of 2025-08-31} { clock format 1756643696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2025 12:34:56 die xxxi mensis viii annoque mmxxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2460919 08 viii 8 08/31/2025 die xxxi mensis viii annoque mmxxv 25 xxv 2025} test clock-2.1913 {conversion of 2025-09-01} { clock format 1756730096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2025 12:34:56 die i mensis ix annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2460920 09 ix 9 09/01/2025 die i mensis ix annoque mmxxv 25 xxv 2025} test clock-2.1914 {conversion of 2025-09-30} { clock format 1759235696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2025 12:34:56 die xxx mensis ix annoque mmxxv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2460949 09 ix 9 09/30/2025 die xxx mensis ix annoque mmxxv 25 xxv 2025} test clock-2.1915 {conversion of 2025-10-01} { clock format 1759322096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2025 12:34:56 die i mensis x annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2460950 10 x 10 10/01/2025 die i mensis x annoque mmxxv 25 xxv 2025} test clock-2.1916 {conversion of 2025-10-31} { clock format 1761914096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2025 12:34:56 die xxxi mensis x annoque mmxxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2460980 10 x 10 10/31/2025 die xxxi mensis x annoque mmxxv 25 xxv 2025} test clock-2.1917 {conversion of 2025-11-01} { clock format 1762000496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2025 12:34:56 die i mensis xi annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2460981 11 xi 11 11/01/2025 die i mensis xi annoque mmxxv 25 xxv 2025} test clock-2.1918 {conversion of 2025-11-30} { clock format 1764506096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2025 12:34:56 die xxx mensis xi annoque mmxxv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2461010 11 xi 11 11/30/2025 die xxx mensis xi annoque mmxxv 25 xxv 2025} test clock-2.1919 {conversion of 2025-12-01} { clock format 1764592496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2025 12:34:56 die i mensis xii annoque mmxxv xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2461011 12 xii 12 12/01/2025 die i mensis xii annoque mmxxv 25 xxv 2025} test clock-2.1920 {conversion of 2025-12-31} { clock format 1767184496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2025 12:34:56 die xxxi mensis xii annoque mmxxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2461041 12 xii 12 12/31/2025 die xxxi mensis xii annoque mmxxv 25 xxv 2025} test clock-2.1921 {conversion of 2037-01-01} { clock format 2114426096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2037 12:34:56 die i mensis i annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2465060 01 i 1 01/01/2037 die i mensis i annoque mmxxxvii 37 xxxvii 2037} test clock-2.1922 {conversion of 2037-01-31} { clock format 2117018096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2037 12:34:56 die xxxi mensis i annoque mmxxxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2465090 01 i 1 01/31/2037 die xxxi mensis i annoque mmxxxvii 37 xxxvii 2037} test clock-2.1923 {conversion of 2037-02-01} { clock format 2117104496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2037 12:34:56 die i mensis ii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2465091 02 ii 2 02/01/2037 die i mensis ii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1924 {conversion of 2037-02-28} { clock format 2119437296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2037 12:34:56 die xxviii mensis ii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2465118 02 ii 2 02/28/2037 die xxviii mensis ii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1925 {conversion of 2037-03-01} { clock format 2119523696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2037 12:34:56 die i mensis iii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2465119 03 iii 3 03/01/2037 die i mensis iii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1926 {conversion of 2037-03-31} { clock format 2122115696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2037 12:34:56 die xxxi mensis iii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2465149 03 iii 3 03/31/2037 die xxxi mensis iii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1927 {conversion of 2037-04-01} { clock format 2122202096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2037 12:34:56 die i mensis iv annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2465150 04 iv 4 04/01/2037 die i mensis iv annoque mmxxxvii 37 xxxvii 2037} test clock-2.1928 {conversion of 2037-04-30} { clock format 2124707696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2037 12:34:56 die xxx mensis iv annoque mmxxxvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2465179 04 iv 4 04/30/2037 die xxx mensis iv annoque mmxxxvii 37 xxxvii 2037} test clock-2.1929 {conversion of 2037-05-01} { clock format 2124794096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2037 12:34:56 die i mensis v annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2465180 05 v 5 05/01/2037 die i mensis v annoque mmxxxvii 37 xxxvii 2037} test clock-2.1930 {conversion of 2037-05-31} { clock format 2127386096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2037 12:34:56 die xxxi mensis v annoque mmxxxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2465210 05 v 5 05/31/2037 die xxxi mensis v annoque mmxxxvii 37 xxxvii 2037} test clock-2.1931 {conversion of 2037-06-01} { clock format 2127472496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2037 12:34:56 die i mensis vi annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2465211 06 vi 6 06/01/2037 die i mensis vi annoque mmxxxvii 37 xxxvii 2037} test clock-2.1932 {conversion of 2037-06-30} { clock format 2129978096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2037 12:34:56 die xxx mensis vi annoque mmxxxvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2465240 06 vi 6 06/30/2037 die xxx mensis vi annoque mmxxxvii 37 xxxvii 2037} test clock-2.1933 {conversion of 2037-07-01} { clock format 2130064496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2037 12:34:56 die i mensis vii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2465241 07 vii 7 07/01/2037 die i mensis vii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1934 {conversion of 2037-07-31} { clock format 2132656496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2037 12:34:56 die xxxi mensis vii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2465271 07 vii 7 07/31/2037 die xxxi mensis vii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1935 {conversion of 2037-08-01} { clock format 2132742896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2037 12:34:56 die i mensis viii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2465272 08 viii 8 08/01/2037 die i mensis viii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1936 {conversion of 2037-08-31} { clock format 2135334896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2037 12:34:56 die xxxi mensis viii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2465302 08 viii 8 08/31/2037 die xxxi mensis viii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1937 {conversion of 2037-09-01} { clock format 2135421296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2037 12:34:56 die i mensis ix annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2465303 09 ix 9 09/01/2037 die i mensis ix annoque mmxxxvii 37 xxxvii 2037} test clock-2.1938 {conversion of 2037-09-30} { clock format 2137926896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2037 12:34:56 die xxx mensis ix annoque mmxxxvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2465332 09 ix 9 09/30/2037 die xxx mensis ix annoque mmxxxvii 37 xxxvii 2037} test clock-2.1939 {conversion of 2037-10-01} { clock format 2138013296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2037 12:34:56 die i mensis x annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2465333 10 x 10 10/01/2037 die i mensis x annoque mmxxxvii 37 xxxvii 2037} test clock-2.1940 {conversion of 2037-10-31} { clock format 2140605296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2037 12:34:56 die xxxi mensis x annoque mmxxxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2465363 10 x 10 10/31/2037 die xxxi mensis x annoque mmxxxvii 37 xxxvii 2037} test clock-2.1941 {conversion of 2037-11-01} { clock format 2140691696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2037 12:34:56 die i mensis xi annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2465364 11 xi 11 11/01/2037 die i mensis xi annoque mmxxxvii 37 xxxvii 2037} test clock-2.1942 {conversion of 2037-11-30} { clock format 2143197296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2037 12:34:56 die xxx mensis xi annoque mmxxxvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2465393 11 xi 11 11/30/2037 die xxx mensis xi annoque mmxxxvii 37 xxxvii 2037} test clock-2.1943 {conversion of 2037-12-01} { clock format 2143283696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2037 12:34:56 die i mensis xii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2465394 12 xii 12 12/01/2037 die i mensis xii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1944 {conversion of 2037-12-31} { clock format 2145875696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2037 12:34:56 die xxxi mensis xii annoque mmxxxvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2465424 12 xii 12 12/31/2037 die xxxi mensis xii annoque mmxxxvii 37 xxxvii 2037} test clock-2.1945 {conversion of 2038-01-01} { clock format 2145962096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2038 12:34:56 die i mensis i annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2465425 01 i 1 01/01/2038 die i mensis i annoque mmxxxviii 38 xxxviii 2038} test clock-2.1946 {conversion of 2038-01-31} { clock format 2148554096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2038 12:34:56 die xxxi mensis i annoque mmxxxviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2465455 01 i 1 01/31/2038 die xxxi mensis i annoque mmxxxviii 38 xxxviii 2038} test clock-2.1947 {conversion of 2038-02-01} { clock format 2148640496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2038 12:34:56 die i mensis ii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2465456 02 ii 2 02/01/2038 die i mensis ii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1948 {conversion of 2038-02-28} { clock format 2150973296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2038 12:34:56 die xxviii mensis ii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2465483 02 ii 2 02/28/2038 die xxviii mensis ii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1949 {conversion of 2038-03-01} { clock format 2151059696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2038 12:34:56 die i mensis iii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2465484 03 iii 3 03/01/2038 die i mensis iii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1950 {conversion of 2038-03-31} { clock format 2153651696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2038 12:34:56 die xxxi mensis iii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2465514 03 iii 3 03/31/2038 die xxxi mensis iii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1951 {conversion of 2038-04-01} { clock format 2153738096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2038 12:34:56 die i mensis iv annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2465515 04 iv 4 04/01/2038 die i mensis iv annoque mmxxxviii 38 xxxviii 2038} test clock-2.1952 {conversion of 2038-04-30} { clock format 2156243696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2038 12:34:56 die xxx mensis iv annoque mmxxxviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2465544 04 iv 4 04/30/2038 die xxx mensis iv annoque mmxxxviii 38 xxxviii 2038} test clock-2.1953 {conversion of 2038-05-01} { clock format 2156330096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2038 12:34:56 die i mensis v annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2465545 05 v 5 05/01/2038 die i mensis v annoque mmxxxviii 38 xxxviii 2038} test clock-2.1954 {conversion of 2038-05-31} { clock format 2158922096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2038 12:34:56 die xxxi mensis v annoque mmxxxviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2465575 05 v 5 05/31/2038 die xxxi mensis v annoque mmxxxviii 38 xxxviii 2038} test clock-2.1955 {conversion of 2038-06-01} { clock format 2159008496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2038 12:34:56 die i mensis vi annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2465576 06 vi 6 06/01/2038 die i mensis vi annoque mmxxxviii 38 xxxviii 2038} test clock-2.1956 {conversion of 2038-06-30} { clock format 2161514096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2038 12:34:56 die xxx mensis vi annoque mmxxxviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2465605 06 vi 6 06/30/2038 die xxx mensis vi annoque mmxxxviii 38 xxxviii 2038} test clock-2.1957 {conversion of 2038-07-01} { clock format 2161600496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2038 12:34:56 die i mensis vii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2465606 07 vii 7 07/01/2038 die i mensis vii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1958 {conversion of 2038-07-31} { clock format 2164192496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2038 12:34:56 die xxxi mensis vii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2465636 07 vii 7 07/31/2038 die xxxi mensis vii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1959 {conversion of 2038-08-01} { clock format 2164278896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2038 12:34:56 die i mensis viii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2465637 08 viii 8 08/01/2038 die i mensis viii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1960 {conversion of 2038-08-31} { clock format 2166870896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2038 12:34:56 die xxxi mensis viii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2465667 08 viii 8 08/31/2038 die xxxi mensis viii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1961 {conversion of 2038-09-01} { clock format 2166957296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2038 12:34:56 die i mensis ix annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2465668 09 ix 9 09/01/2038 die i mensis ix annoque mmxxxviii 38 xxxviii 2038} test clock-2.1962 {conversion of 2038-09-30} { clock format 2169462896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2038 12:34:56 die xxx mensis ix annoque mmxxxviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2465697 09 ix 9 09/30/2038 die xxx mensis ix annoque mmxxxviii 38 xxxviii 2038} test clock-2.1963 {conversion of 2038-10-01} { clock format 2169549296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2038 12:34:56 die i mensis x annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2465698 10 x 10 10/01/2038 die i mensis x annoque mmxxxviii 38 xxxviii 2038} test clock-2.1964 {conversion of 2038-10-31} { clock format 2172141296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2038 12:34:56 die xxxi mensis x annoque mmxxxviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2465728 10 x 10 10/31/2038 die xxxi mensis x annoque mmxxxviii 38 xxxviii 2038} test clock-2.1965 {conversion of 2038-11-01} { clock format 2172227696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2038 12:34:56 die i mensis xi annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2465729 11 xi 11 11/01/2038 die i mensis xi annoque mmxxxviii 38 xxxviii 2038} test clock-2.1966 {conversion of 2038-11-30} { clock format 2174733296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2038 12:34:56 die xxx mensis xi annoque mmxxxviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2465758 11 xi 11 11/30/2038 die xxx mensis xi annoque mmxxxviii 38 xxxviii 2038} test clock-2.1967 {conversion of 2038-12-01} { clock format 2174819696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2038 12:34:56 die i mensis xii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2465759 12 xii 12 12/01/2038 die i mensis xii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1968 {conversion of 2038-12-31} { clock format 2177411696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2038 12:34:56 die xxxi mensis xii annoque mmxxxviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2465789 12 xii 12 12/31/2038 die xxxi mensis xii annoque mmxxxviii 38 xxxviii 2038} test clock-2.1969 {conversion of 2039-01-01} { clock format 2177498096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2039 12:34:56 die i mensis i annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2465790 01 i 1 01/01/2039 die i mensis i annoque mmxxxix 39 xxxix 2039} test clock-2.1970 {conversion of 2039-01-31} { clock format 2180090096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2039 12:34:56 die xxxi mensis i annoque mmxxxix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2465820 01 i 1 01/31/2039 die xxxi mensis i annoque mmxxxix 39 xxxix 2039} test clock-2.1971 {conversion of 2039-02-01} { clock format 2180176496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2039 12:34:56 die i mensis ii annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2465821 02 ii 2 02/01/2039 die i mensis ii annoque mmxxxix 39 xxxix 2039} test clock-2.1972 {conversion of 2039-02-28} { clock format 2182509296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2039 12:34:56 die xxviii mensis ii annoque mmxxxix xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2465848 02 ii 2 02/28/2039 die xxviii mensis ii annoque mmxxxix 39 xxxix 2039} test clock-2.1973 {conversion of 2039-03-01} { clock format 2182595696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2039 12:34:56 die i mensis iii annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2465849 03 iii 3 03/01/2039 die i mensis iii annoque mmxxxix 39 xxxix 2039} test clock-2.1974 {conversion of 2039-03-31} { clock format 2185187696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2039 12:34:56 die xxxi mensis iii annoque mmxxxix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2465879 03 iii 3 03/31/2039 die xxxi mensis iii annoque mmxxxix 39 xxxix 2039} test clock-2.1975 {conversion of 2039-04-01} { clock format 2185274096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2039 12:34:56 die i mensis iv annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2465880 04 iv 4 04/01/2039 die i mensis iv annoque mmxxxix 39 xxxix 2039} test clock-2.1976 {conversion of 2039-04-30} { clock format 2187779696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2039 12:34:56 die xxx mensis iv annoque mmxxxix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2465909 04 iv 4 04/30/2039 die xxx mensis iv annoque mmxxxix 39 xxxix 2039} test clock-2.1977 {conversion of 2039-05-01} { clock format 2187866096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2039 12:34:56 die i mensis v annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2465910 05 v 5 05/01/2039 die i mensis v annoque mmxxxix 39 xxxix 2039} test clock-2.1978 {conversion of 2039-05-31} { clock format 2190458096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2039 12:34:56 die xxxi mensis v annoque mmxxxix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2465940 05 v 5 05/31/2039 die xxxi mensis v annoque mmxxxix 39 xxxix 2039} test clock-2.1979 {conversion of 2039-06-01} { clock format 2190544496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2039 12:34:56 die i mensis vi annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2465941 06 vi 6 06/01/2039 die i mensis vi annoque mmxxxix 39 xxxix 2039} test clock-2.1980 {conversion of 2039-06-30} { clock format 2193050096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2039 12:34:56 die xxx mensis vi annoque mmxxxix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2465970 06 vi 6 06/30/2039 die xxx mensis vi annoque mmxxxix 39 xxxix 2039} test clock-2.1981 {conversion of 2039-07-01} { clock format 2193136496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2039 12:34:56 die i mensis vii annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2465971 07 vii 7 07/01/2039 die i mensis vii annoque mmxxxix 39 xxxix 2039} test clock-2.1982 {conversion of 2039-07-31} { clock format 2195728496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2039 12:34:56 die xxxi mensis vii annoque mmxxxix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2466001 07 vii 7 07/31/2039 die xxxi mensis vii annoque mmxxxix 39 xxxix 2039} test clock-2.1983 {conversion of 2039-08-01} { clock format 2195814896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2039 12:34:56 die i mensis viii annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2466002 08 viii 8 08/01/2039 die i mensis viii annoque mmxxxix 39 xxxix 2039} test clock-2.1984 {conversion of 2039-08-31} { clock format 2198406896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2039 12:34:56 die xxxi mensis viii annoque mmxxxix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2466032 08 viii 8 08/31/2039 die xxxi mensis viii annoque mmxxxix 39 xxxix 2039} test clock-2.1985 {conversion of 2039-09-01} { clock format 2198493296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2039 12:34:56 die i mensis ix annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2466033 09 ix 9 09/01/2039 die i mensis ix annoque mmxxxix 39 xxxix 2039} test clock-2.1986 {conversion of 2039-09-30} { clock format 2200998896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2039 12:34:56 die xxx mensis ix annoque mmxxxix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2466062 09 ix 9 09/30/2039 die xxx mensis ix annoque mmxxxix 39 xxxix 2039} test clock-2.1987 {conversion of 2039-10-01} { clock format 2201085296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2039 12:34:56 die i mensis x annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2466063 10 x 10 10/01/2039 die i mensis x annoque mmxxxix 39 xxxix 2039} test clock-2.1988 {conversion of 2039-10-31} { clock format 2203677296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2039 12:34:56 die xxxi mensis x annoque mmxxxix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2466093 10 x 10 10/31/2039 die xxxi mensis x annoque mmxxxix 39 xxxix 2039} test clock-2.1989 {conversion of 2039-11-01} { clock format 2203763696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2039 12:34:56 die i mensis xi annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2466094 11 xi 11 11/01/2039 die i mensis xi annoque mmxxxix 39 xxxix 2039} test clock-2.1990 {conversion of 2039-11-30} { clock format 2206269296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2039 12:34:56 die xxx mensis xi annoque mmxxxix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2466123 11 xi 11 11/30/2039 die xxx mensis xi annoque mmxxxix 39 xxxix 2039} test clock-2.1991 {conversion of 2039-12-01} { clock format 2206355696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2039 12:34:56 die i mensis xii annoque mmxxxix xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2466124 12 xii 12 12/01/2039 die i mensis xii annoque mmxxxix 39 xxxix 2039} test clock-2.1992 {conversion of 2039-12-31} { clock format 2208947696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2039 12:34:56 die xxxi mensis xii annoque mmxxxix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2466154 12 xii 12 12/31/2039 die xxxi mensis xii annoque mmxxxix 39 xxxix 2039} test clock-2.1993 {conversion of 2040-01-01} { clock format 2209034096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2040 12:34:56 die i mensis i annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2466155 01 i 1 01/01/2040 die i mensis i annoque mmxl 40 xl 2040} test clock-2.1994 {conversion of 2040-01-31} { clock format 2211626096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2040 12:34:56 die xxxi mensis i annoque mmxl xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2466185 01 i 1 01/31/2040 die xxxi mensis i annoque mmxl 40 xl 2040} test clock-2.1995 {conversion of 2040-02-01} { clock format 2211712496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2040 12:34:56 die i mensis ii annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2466186 02 ii 2 02/01/2040 die i mensis ii annoque mmxl 40 xl 2040} test clock-2.1996 {conversion of 2040-02-29} { clock format 2214131696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2040 12:34:56 die xxix mensis ii annoque mmxl xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2466214 02 ii 2 02/29/2040 die xxix mensis ii annoque mmxl 40 xl 2040} test clock-2.1997 {conversion of 2040-03-01} { clock format 2214218096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2040 12:34:56 die i mensis iii annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2466215 03 iii 3 03/01/2040 die i mensis iii annoque mmxl 40 xl 2040} test clock-2.1998 {conversion of 2040-03-31} { clock format 2216810096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2040 12:34:56 die xxxi mensis iii annoque mmxl xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2466245 03 iii 3 03/31/2040 die xxxi mensis iii annoque mmxl 40 xl 2040} test clock-2.1999 {conversion of 2040-04-01} { clock format 2216896496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2040 12:34:56 die i mensis iv annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2466246 04 iv 4 04/01/2040 die i mensis iv annoque mmxl 40 xl 2040} test clock-2.2000 {conversion of 2040-04-30} { clock format 2219402096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2040 12:34:56 die xxx mensis iv annoque mmxl xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2466275 04 iv 4 04/30/2040 die xxx mensis iv annoque mmxl 40 xl 2040} test clock-2.2001 {conversion of 2040-05-01} { clock format 2219488496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2040 12:34:56 die i mensis v annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2466276 05 v 5 05/01/2040 die i mensis v annoque mmxl 40 xl 2040} test clock-2.2002 {conversion of 2040-05-31} { clock format 2222080496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2040 12:34:56 die xxxi mensis v annoque mmxl xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2466306 05 v 5 05/31/2040 die xxxi mensis v annoque mmxl 40 xl 2040} test clock-2.2003 {conversion of 2040-06-01} { clock format 2222166896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2040 12:34:56 die i mensis vi annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2466307 06 vi 6 06/01/2040 die i mensis vi annoque mmxl 40 xl 2040} test clock-2.2004 {conversion of 2040-06-30} { clock format 2224672496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2040 12:34:56 die xxx mensis vi annoque mmxl xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2466336 06 vi 6 06/30/2040 die xxx mensis vi annoque mmxl 40 xl 2040} test clock-2.2005 {conversion of 2040-07-01} { clock format 2224758896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2040 12:34:56 die i mensis vii annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2466337 07 vii 7 07/01/2040 die i mensis vii annoque mmxl 40 xl 2040} test clock-2.2006 {conversion of 2040-07-31} { clock format 2227350896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2040 12:34:56 die xxxi mensis vii annoque mmxl xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2466367 07 vii 7 07/31/2040 die xxxi mensis vii annoque mmxl 40 xl 2040} test clock-2.2007 {conversion of 2040-08-01} { clock format 2227437296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2040 12:34:56 die i mensis viii annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2466368 08 viii 8 08/01/2040 die i mensis viii annoque mmxl 40 xl 2040} test clock-2.2008 {conversion of 2040-08-31} { clock format 2230029296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2040 12:34:56 die xxxi mensis viii annoque mmxl xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2466398 08 viii 8 08/31/2040 die xxxi mensis viii annoque mmxl 40 xl 2040} test clock-2.2009 {conversion of 2040-09-01} { clock format 2230115696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2040 12:34:56 die i mensis ix annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2466399 09 ix 9 09/01/2040 die i mensis ix annoque mmxl 40 xl 2040} test clock-2.2010 {conversion of 2040-09-30} { clock format 2232621296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2040 12:34:56 die xxx mensis ix annoque mmxl xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2466428 09 ix 9 09/30/2040 die xxx mensis ix annoque mmxl 40 xl 2040} test clock-2.2011 {conversion of 2040-10-01} { clock format 2232707696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2040 12:34:56 die i mensis x annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2466429 10 x 10 10/01/2040 die i mensis x annoque mmxl 40 xl 2040} test clock-2.2012 {conversion of 2040-10-31} { clock format 2235299696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2040 12:34:56 die xxxi mensis x annoque mmxl xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2466459 10 x 10 10/31/2040 die xxxi mensis x annoque mmxl 40 xl 2040} test clock-2.2013 {conversion of 2040-11-01} { clock format 2235386096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2040 12:34:56 die i mensis xi annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2466460 11 xi 11 11/01/2040 die i mensis xi annoque mmxl 40 xl 2040} test clock-2.2014 {conversion of 2040-11-30} { clock format 2237891696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2040 12:34:56 die xxx mensis xi annoque mmxl xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2466489 11 xi 11 11/30/2040 die xxx mensis xi annoque mmxl 40 xl 2040} test clock-2.2015 {conversion of 2040-12-01} { clock format 2237978096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2040 12:34:56 die i mensis xii annoque mmxl xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2466490 12 xii 12 12/01/2040 die i mensis xii annoque mmxl 40 xl 2040} test clock-2.2016 {conversion of 2040-12-31} { clock format 2240570096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2040 12:34:56 die xxxi mensis xii annoque mmxl xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2466520 12 xii 12 12/31/2040 die xxxi mensis xii annoque mmxl 40 xl 2040} test clock-2.2017 {conversion of 2041-01-01} { clock format 2240656496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2041 12:34:56 die i mensis i annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2466521 01 i 1 01/01/2041 die i mensis i annoque mmxli 41 xli 2041} test clock-2.2018 {conversion of 2041-01-31} { clock format 2243248496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2041 12:34:56 die xxxi mensis i annoque mmxli xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2466551 01 i 1 01/31/2041 die xxxi mensis i annoque mmxli 41 xli 2041} test clock-2.2019 {conversion of 2041-02-01} { clock format 2243334896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2041 12:34:56 die i mensis ii annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2466552 02 ii 2 02/01/2041 die i mensis ii annoque mmxli 41 xli 2041} test clock-2.2020 {conversion of 2041-02-28} { clock format 2245667696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2041 12:34:56 die xxviii mensis ii annoque mmxli xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2466579 02 ii 2 02/28/2041 die xxviii mensis ii annoque mmxli 41 xli 2041} test clock-2.2021 {conversion of 2041-03-01} { clock format 2245754096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2041 12:34:56 die i mensis iii annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2466580 03 iii 3 03/01/2041 die i mensis iii annoque mmxli 41 xli 2041} test clock-2.2022 {conversion of 2041-03-31} { clock format 2248346096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2041 12:34:56 die xxxi mensis iii annoque mmxli xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2466610 03 iii 3 03/31/2041 die xxxi mensis iii annoque mmxli 41 xli 2041} test clock-2.2023 {conversion of 2041-04-01} { clock format 2248432496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2041 12:34:56 die i mensis iv annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2466611 04 iv 4 04/01/2041 die i mensis iv annoque mmxli 41 xli 2041} test clock-2.2024 {conversion of 2041-04-30} { clock format 2250938096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2041 12:34:56 die xxx mensis iv annoque mmxli xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2466640 04 iv 4 04/30/2041 die xxx mensis iv annoque mmxli 41 xli 2041} test clock-2.2025 {conversion of 2041-05-01} { clock format 2251024496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2041 12:34:56 die i mensis v annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2466641 05 v 5 05/01/2041 die i mensis v annoque mmxli 41 xli 2041} test clock-2.2026 {conversion of 2041-05-31} { clock format 2253616496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2041 12:34:56 die xxxi mensis v annoque mmxli xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2466671 05 v 5 05/31/2041 die xxxi mensis v annoque mmxli 41 xli 2041} test clock-2.2027 {conversion of 2041-06-01} { clock format 2253702896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2041 12:34:56 die i mensis vi annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2466672 06 vi 6 06/01/2041 die i mensis vi annoque mmxli 41 xli 2041} test clock-2.2028 {conversion of 2041-06-30} { clock format 2256208496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2041 12:34:56 die xxx mensis vi annoque mmxli xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2466701 06 vi 6 06/30/2041 die xxx mensis vi annoque mmxli 41 xli 2041} test clock-2.2029 {conversion of 2041-07-01} { clock format 2256294896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2041 12:34:56 die i mensis vii annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2466702 07 vii 7 07/01/2041 die i mensis vii annoque mmxli 41 xli 2041} test clock-2.2030 {conversion of 2041-07-31} { clock format 2258886896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2041 12:34:56 die xxxi mensis vii annoque mmxli xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2466732 07 vii 7 07/31/2041 die xxxi mensis vii annoque mmxli 41 xli 2041} test clock-2.2031 {conversion of 2041-08-01} { clock format 2258973296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2041 12:34:56 die i mensis viii annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2466733 08 viii 8 08/01/2041 die i mensis viii annoque mmxli 41 xli 2041} test clock-2.2032 {conversion of 2041-08-31} { clock format 2261565296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2041 12:34:56 die xxxi mensis viii annoque mmxli xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2466763 08 viii 8 08/31/2041 die xxxi mensis viii annoque mmxli 41 xli 2041} test clock-2.2033 {conversion of 2041-09-01} { clock format 2261651696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2041 12:34:56 die i mensis ix annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2466764 09 ix 9 09/01/2041 die i mensis ix annoque mmxli 41 xli 2041} test clock-2.2034 {conversion of 2041-09-30} { clock format 2264157296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2041 12:34:56 die xxx mensis ix annoque mmxli xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2466793 09 ix 9 09/30/2041 die xxx mensis ix annoque mmxli 41 xli 2041} test clock-2.2035 {conversion of 2041-10-01} { clock format 2264243696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2041 12:34:56 die i mensis x annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2466794 10 x 10 10/01/2041 die i mensis x annoque mmxli 41 xli 2041} test clock-2.2036 {conversion of 2041-10-31} { clock format 2266835696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2041 12:34:56 die xxxi mensis x annoque mmxli xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2466824 10 x 10 10/31/2041 die xxxi mensis x annoque mmxli 41 xli 2041} test clock-2.2037 {conversion of 2041-11-01} { clock format 2266922096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2041 12:34:56 die i mensis xi annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2466825 11 xi 11 11/01/2041 die i mensis xi annoque mmxli 41 xli 2041} test clock-2.2038 {conversion of 2041-11-30} { clock format 2269427696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2041 12:34:56 die xxx mensis xi annoque mmxli xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2466854 11 xi 11 11/30/2041 die xxx mensis xi annoque mmxli 41 xli 2041} test clock-2.2039 {conversion of 2041-12-01} { clock format 2269514096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2041 12:34:56 die i mensis xii annoque mmxli xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2466855 12 xii 12 12/01/2041 die i mensis xii annoque mmxli 41 xli 2041} test clock-2.2040 {conversion of 2041-12-31} { clock format 2272106096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2041 12:34:56 die xxxi mensis xii annoque mmxli xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2466885 12 xii 12 12/31/2041 die xxxi mensis xii annoque mmxli 41 xli 2041} test clock-2.2041 {conversion of 2042-01-01} { clock format 2272192496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2042 12:34:56 die i mensis i annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2466886 01 i 1 01/01/2042 die i mensis i annoque mmxlii 42 xlii 2042} test clock-2.2042 {conversion of 2042-01-31} { clock format 2274784496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2042 12:34:56 die xxxi mensis i annoque mmxlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2466916 01 i 1 01/31/2042 die xxxi mensis i annoque mmxlii 42 xlii 2042} test clock-2.2043 {conversion of 2042-02-01} { clock format 2274870896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2042 12:34:56 die i mensis ii annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2466917 02 ii 2 02/01/2042 die i mensis ii annoque mmxlii 42 xlii 2042} test clock-2.2044 {conversion of 2042-02-28} { clock format 2277203696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2042 12:34:56 die xxviii mensis ii annoque mmxlii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2466944 02 ii 2 02/28/2042 die xxviii mensis ii annoque mmxlii 42 xlii 2042} test clock-2.2045 {conversion of 2042-03-01} { clock format 2277290096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2042 12:34:56 die i mensis iii annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2466945 03 iii 3 03/01/2042 die i mensis iii annoque mmxlii 42 xlii 2042} test clock-2.2046 {conversion of 2042-03-31} { clock format 2279882096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2042 12:34:56 die xxxi mensis iii annoque mmxlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2466975 03 iii 3 03/31/2042 die xxxi mensis iii annoque mmxlii 42 xlii 2042} test clock-2.2047 {conversion of 2042-04-01} { clock format 2279968496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2042 12:34:56 die i mensis iv annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2466976 04 iv 4 04/01/2042 die i mensis iv annoque mmxlii 42 xlii 2042} test clock-2.2048 {conversion of 2042-04-30} { clock format 2282474096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2042 12:34:56 die xxx mensis iv annoque mmxlii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2467005 04 iv 4 04/30/2042 die xxx mensis iv annoque mmxlii 42 xlii 2042} test clock-2.2049 {conversion of 2042-05-01} { clock format 2282560496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2042 12:34:56 die i mensis v annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2467006 05 v 5 05/01/2042 die i mensis v annoque mmxlii 42 xlii 2042} test clock-2.2050 {conversion of 2042-05-31} { clock format 2285152496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2042 12:34:56 die xxxi mensis v annoque mmxlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2467036 05 v 5 05/31/2042 die xxxi mensis v annoque mmxlii 42 xlii 2042} test clock-2.2051 {conversion of 2042-06-01} { clock format 2285238896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2042 12:34:56 die i mensis vi annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2467037 06 vi 6 06/01/2042 die i mensis vi annoque mmxlii 42 xlii 2042} test clock-2.2052 {conversion of 2042-06-30} { clock format 2287744496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2042 12:34:56 die xxx mensis vi annoque mmxlii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2467066 06 vi 6 06/30/2042 die xxx mensis vi annoque mmxlii 42 xlii 2042} test clock-2.2053 {conversion of 2042-07-01} { clock format 2287830896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2042 12:34:56 die i mensis vii annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2467067 07 vii 7 07/01/2042 die i mensis vii annoque mmxlii 42 xlii 2042} test clock-2.2054 {conversion of 2042-07-31} { clock format 2290422896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2042 12:34:56 die xxxi mensis vii annoque mmxlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2467097 07 vii 7 07/31/2042 die xxxi mensis vii annoque mmxlii 42 xlii 2042} test clock-2.2055 {conversion of 2042-08-01} { clock format 2290509296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2042 12:34:56 die i mensis viii annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2467098 08 viii 8 08/01/2042 die i mensis viii annoque mmxlii 42 xlii 2042} test clock-2.2056 {conversion of 2042-08-31} { clock format 2293101296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2042 12:34:56 die xxxi mensis viii annoque mmxlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2467128 08 viii 8 08/31/2042 die xxxi mensis viii annoque mmxlii 42 xlii 2042} test clock-2.2057 {conversion of 2042-09-01} { clock format 2293187696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2042 12:34:56 die i mensis ix annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2467129 09 ix 9 09/01/2042 die i mensis ix annoque mmxlii 42 xlii 2042} test clock-2.2058 {conversion of 2042-09-30} { clock format 2295693296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2042 12:34:56 die xxx mensis ix annoque mmxlii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2467158 09 ix 9 09/30/2042 die xxx mensis ix annoque mmxlii 42 xlii 2042} test clock-2.2059 {conversion of 2042-10-01} { clock format 2295779696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2042 12:34:56 die i mensis x annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2467159 10 x 10 10/01/2042 die i mensis x annoque mmxlii 42 xlii 2042} test clock-2.2060 {conversion of 2042-10-31} { clock format 2298371696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2042 12:34:56 die xxxi mensis x annoque mmxlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2467189 10 x 10 10/31/2042 die xxxi mensis x annoque mmxlii 42 xlii 2042} test clock-2.2061 {conversion of 2042-11-01} { clock format 2298458096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2042 12:34:56 die i mensis xi annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2467190 11 xi 11 11/01/2042 die i mensis xi annoque mmxlii 42 xlii 2042} test clock-2.2062 {conversion of 2042-11-30} { clock format 2300963696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2042 12:34:56 die xxx mensis xi annoque mmxlii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2467219 11 xi 11 11/30/2042 die xxx mensis xi annoque mmxlii 42 xlii 2042} test clock-2.2063 {conversion of 2042-12-01} { clock format 2301050096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2042 12:34:56 die i mensis xii annoque mmxlii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2467220 12 xii 12 12/01/2042 die i mensis xii annoque mmxlii 42 xlii 2042} test clock-2.2064 {conversion of 2042-12-31} { clock format 2303642096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2042 12:34:56 die xxxi mensis xii annoque mmxlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2467250 12 xii 12 12/31/2042 die xxxi mensis xii annoque mmxlii 42 xlii 2042} test clock-2.2065 {conversion of 2043-01-01} { clock format 2303728496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2043 12:34:56 die i mensis i annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2467251 01 i 1 01/01/2043 die i mensis i annoque mmxliii 43 xliii 2043} test clock-2.2066 {conversion of 2043-01-31} { clock format 2306320496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2043 12:34:56 die xxxi mensis i annoque mmxliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2467281 01 i 1 01/31/2043 die xxxi mensis i annoque mmxliii 43 xliii 2043} test clock-2.2067 {conversion of 2043-02-01} { clock format 2306406896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2043 12:34:56 die i mensis ii annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2467282 02 ii 2 02/01/2043 die i mensis ii annoque mmxliii 43 xliii 2043} test clock-2.2068 {conversion of 2043-02-28} { clock format 2308739696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2043 12:34:56 die xxviii mensis ii annoque mmxliii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2467309 02 ii 2 02/28/2043 die xxviii mensis ii annoque mmxliii 43 xliii 2043} test clock-2.2069 {conversion of 2043-03-01} { clock format 2308826096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2043 12:34:56 die i mensis iii annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2467310 03 iii 3 03/01/2043 die i mensis iii annoque mmxliii 43 xliii 2043} test clock-2.2070 {conversion of 2043-03-31} { clock format 2311418096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2043 12:34:56 die xxxi mensis iii annoque mmxliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2467340 03 iii 3 03/31/2043 die xxxi mensis iii annoque mmxliii 43 xliii 2043} test clock-2.2071 {conversion of 2043-04-01} { clock format 2311504496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2043 12:34:56 die i mensis iv annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2467341 04 iv 4 04/01/2043 die i mensis iv annoque mmxliii 43 xliii 2043} test clock-2.2072 {conversion of 2043-04-30} { clock format 2314010096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2043 12:34:56 die xxx mensis iv annoque mmxliii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2467370 04 iv 4 04/30/2043 die xxx mensis iv annoque mmxliii 43 xliii 2043} test clock-2.2073 {conversion of 2043-05-01} { clock format 2314096496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2043 12:34:56 die i mensis v annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2467371 05 v 5 05/01/2043 die i mensis v annoque mmxliii 43 xliii 2043} test clock-2.2074 {conversion of 2043-05-31} { clock format 2316688496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2043 12:34:56 die xxxi mensis v annoque mmxliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2467401 05 v 5 05/31/2043 die xxxi mensis v annoque mmxliii 43 xliii 2043} test clock-2.2075 {conversion of 2043-06-01} { clock format 2316774896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2043 12:34:56 die i mensis vi annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2467402 06 vi 6 06/01/2043 die i mensis vi annoque mmxliii 43 xliii 2043} test clock-2.2076 {conversion of 2043-06-30} { clock format 2319280496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2043 12:34:56 die xxx mensis vi annoque mmxliii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2467431 06 vi 6 06/30/2043 die xxx mensis vi annoque mmxliii 43 xliii 2043} test clock-2.2077 {conversion of 2043-07-01} { clock format 2319366896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2043 12:34:56 die i mensis vii annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2467432 07 vii 7 07/01/2043 die i mensis vii annoque mmxliii 43 xliii 2043} test clock-2.2078 {conversion of 2043-07-31} { clock format 2321958896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2043 12:34:56 die xxxi mensis vii annoque mmxliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2467462 07 vii 7 07/31/2043 die xxxi mensis vii annoque mmxliii 43 xliii 2043} test clock-2.2079 {conversion of 2043-08-01} { clock format 2322045296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2043 12:34:56 die i mensis viii annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2467463 08 viii 8 08/01/2043 die i mensis viii annoque mmxliii 43 xliii 2043} test clock-2.2080 {conversion of 2043-08-31} { clock format 2324637296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2043 12:34:56 die xxxi mensis viii annoque mmxliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2467493 08 viii 8 08/31/2043 die xxxi mensis viii annoque mmxliii 43 xliii 2043} test clock-2.2081 {conversion of 2043-09-01} { clock format 2324723696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2043 12:34:56 die i mensis ix annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2467494 09 ix 9 09/01/2043 die i mensis ix annoque mmxliii 43 xliii 2043} test clock-2.2082 {conversion of 2043-09-30} { clock format 2327229296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2043 12:34:56 die xxx mensis ix annoque mmxliii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2467523 09 ix 9 09/30/2043 die xxx mensis ix annoque mmxliii 43 xliii 2043} test clock-2.2083 {conversion of 2043-10-01} { clock format 2327315696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2043 12:34:56 die i mensis x annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2467524 10 x 10 10/01/2043 die i mensis x annoque mmxliii 43 xliii 2043} test clock-2.2084 {conversion of 2043-10-31} { clock format 2329907696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2043 12:34:56 die xxxi mensis x annoque mmxliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2467554 10 x 10 10/31/2043 die xxxi mensis x annoque mmxliii 43 xliii 2043} test clock-2.2085 {conversion of 2043-11-01} { clock format 2329994096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2043 12:34:56 die i mensis xi annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2467555 11 xi 11 11/01/2043 die i mensis xi annoque mmxliii 43 xliii 2043} test clock-2.2086 {conversion of 2043-11-30} { clock format 2332499696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2043 12:34:56 die xxx mensis xi annoque mmxliii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2467584 11 xi 11 11/30/2043 die xxx mensis xi annoque mmxliii 43 xliii 2043} test clock-2.2087 {conversion of 2043-12-01} { clock format 2332586096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2043 12:34:56 die i mensis xii annoque mmxliii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2467585 12 xii 12 12/01/2043 die i mensis xii annoque mmxliii 43 xliii 2043} test clock-2.2088 {conversion of 2043-12-31} { clock format 2335178096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2043 12:34:56 die xxxi mensis xii annoque mmxliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2467615 12 xii 12 12/31/2043 die xxxi mensis xii annoque mmxliii 43 xliii 2043} test clock-2.2089 {conversion of 2044-01-01} { clock format 2335264496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2044 12:34:56 die i mensis i annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2467616 01 i 1 01/01/2044 die i mensis i annoque mmxliv 44 xliv 2044} test clock-2.2090 {conversion of 2044-01-31} { clock format 2337856496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2044 12:34:56 die xxxi mensis i annoque mmxliv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2467646 01 i 1 01/31/2044 die xxxi mensis i annoque mmxliv 44 xliv 2044} test clock-2.2091 {conversion of 2044-02-01} { clock format 2337942896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2044 12:34:56 die i mensis ii annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2467647 02 ii 2 02/01/2044 die i mensis ii annoque mmxliv 44 xliv 2044} test clock-2.2092 {conversion of 2044-02-29} { clock format 2340362096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2044 12:34:56 die xxix mensis ii annoque mmxliv xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2467675 02 ii 2 02/29/2044 die xxix mensis ii annoque mmxliv 44 xliv 2044} test clock-2.2093 {conversion of 2044-03-01} { clock format 2340448496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2044 12:34:56 die i mensis iii annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2467676 03 iii 3 03/01/2044 die i mensis iii annoque mmxliv 44 xliv 2044} test clock-2.2094 {conversion of 2044-03-31} { clock format 2343040496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2044 12:34:56 die xxxi mensis iii annoque mmxliv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2467706 03 iii 3 03/31/2044 die xxxi mensis iii annoque mmxliv 44 xliv 2044} test clock-2.2095 {conversion of 2044-04-01} { clock format 2343126896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2044 12:34:56 die i mensis iv annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2467707 04 iv 4 04/01/2044 die i mensis iv annoque mmxliv 44 xliv 2044} test clock-2.2096 {conversion of 2044-04-30} { clock format 2345632496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2044 12:34:56 die xxx mensis iv annoque mmxliv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2467736 04 iv 4 04/30/2044 die xxx mensis iv annoque mmxliv 44 xliv 2044} test clock-2.2097 {conversion of 2044-05-01} { clock format 2345718896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2044 12:34:56 die i mensis v annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2467737 05 v 5 05/01/2044 die i mensis v annoque mmxliv 44 xliv 2044} test clock-2.2098 {conversion of 2044-05-31} { clock format 2348310896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2044 12:34:56 die xxxi mensis v annoque mmxliv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2467767 05 v 5 05/31/2044 die xxxi mensis v annoque mmxliv 44 xliv 2044} test clock-2.2099 {conversion of 2044-06-01} { clock format 2348397296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2044 12:34:56 die i mensis vi annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2467768 06 vi 6 06/01/2044 die i mensis vi annoque mmxliv 44 xliv 2044} test clock-2.2100 {conversion of 2044-06-30} { clock format 2350902896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2044 12:34:56 die xxx mensis vi annoque mmxliv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2467797 06 vi 6 06/30/2044 die xxx mensis vi annoque mmxliv 44 xliv 2044} test clock-2.2101 {conversion of 2044-07-01} { clock format 2350989296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2044 12:34:56 die i mensis vii annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2467798 07 vii 7 07/01/2044 die i mensis vii annoque mmxliv 44 xliv 2044} test clock-2.2102 {conversion of 2044-07-31} { clock format 2353581296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2044 12:34:56 die xxxi mensis vii annoque mmxliv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2467828 07 vii 7 07/31/2044 die xxxi mensis vii annoque mmxliv 44 xliv 2044} test clock-2.2103 {conversion of 2044-08-01} { clock format 2353667696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2044 12:34:56 die i mensis viii annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2467829 08 viii 8 08/01/2044 die i mensis viii annoque mmxliv 44 xliv 2044} test clock-2.2104 {conversion of 2044-08-31} { clock format 2356259696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2044 12:34:56 die xxxi mensis viii annoque mmxliv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2467859 08 viii 8 08/31/2044 die xxxi mensis viii annoque mmxliv 44 xliv 2044} test clock-2.2105 {conversion of 2044-09-01} { clock format 2356346096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2044 12:34:56 die i mensis ix annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2467860 09 ix 9 09/01/2044 die i mensis ix annoque mmxliv 44 xliv 2044} test clock-2.2106 {conversion of 2044-09-30} { clock format 2358851696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2044 12:34:56 die xxx mensis ix annoque mmxliv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2467889 09 ix 9 09/30/2044 die xxx mensis ix annoque mmxliv 44 xliv 2044} test clock-2.2107 {conversion of 2044-10-01} { clock format 2358938096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2044 12:34:56 die i mensis x annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2467890 10 x 10 10/01/2044 die i mensis x annoque mmxliv 44 xliv 2044} test clock-2.2108 {conversion of 2044-10-31} { clock format 2361530096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2044 12:34:56 die xxxi mensis x annoque mmxliv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2467920 10 x 10 10/31/2044 die xxxi mensis x annoque mmxliv 44 xliv 2044} test clock-2.2109 {conversion of 2044-11-01} { clock format 2361616496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2044 12:34:56 die i mensis xi annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2467921 11 xi 11 11/01/2044 die i mensis xi annoque mmxliv 44 xliv 2044} test clock-2.2110 {conversion of 2044-11-30} { clock format 2364122096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2044 12:34:56 die xxx mensis xi annoque mmxliv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2467950 11 xi 11 11/30/2044 die xxx mensis xi annoque mmxliv 44 xliv 2044} test clock-2.2111 {conversion of 2044-12-01} { clock format 2364208496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2044 12:34:56 die i mensis xii annoque mmxliv xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2467951 12 xii 12 12/01/2044 die i mensis xii annoque mmxliv 44 xliv 2044} test clock-2.2112 {conversion of 2044-12-31} { clock format 2366800496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2044 12:34:56 die xxxi mensis xii annoque mmxliv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2467981 12 xii 12 12/31/2044 die xxxi mensis xii annoque mmxliv 44 xliv 2044} test clock-2.2113 {conversion of 2045-01-01} { clock format 2366886896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2045 12:34:56 die i mensis i annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2467982 01 i 1 01/01/2045 die i mensis i annoque mmxlv 45 xlv 2045} test clock-2.2114 {conversion of 2045-01-31} { clock format 2369478896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2045 12:34:56 die xxxi mensis i annoque mmxlv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2468012 01 i 1 01/31/2045 die xxxi mensis i annoque mmxlv 45 xlv 2045} test clock-2.2115 {conversion of 2045-02-01} { clock format 2369565296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2045 12:34:56 die i mensis ii annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2468013 02 ii 2 02/01/2045 die i mensis ii annoque mmxlv 45 xlv 2045} test clock-2.2116 {conversion of 2045-02-28} { clock format 2371898096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2045 12:34:56 die xxviii mensis ii annoque mmxlv xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2468040 02 ii 2 02/28/2045 die xxviii mensis ii annoque mmxlv 45 xlv 2045} test clock-2.2117 {conversion of 2045-03-01} { clock format 2371984496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2045 12:34:56 die i mensis iii annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2468041 03 iii 3 03/01/2045 die i mensis iii annoque mmxlv 45 xlv 2045} test clock-2.2118 {conversion of 2045-03-31} { clock format 2374576496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2045 12:34:56 die xxxi mensis iii annoque mmxlv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2468071 03 iii 3 03/31/2045 die xxxi mensis iii annoque mmxlv 45 xlv 2045} test clock-2.2119 {conversion of 2045-04-01} { clock format 2374662896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2045 12:34:56 die i mensis iv annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2468072 04 iv 4 04/01/2045 die i mensis iv annoque mmxlv 45 xlv 2045} test clock-2.2120 {conversion of 2045-04-30} { clock format 2377168496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2045 12:34:56 die xxx mensis iv annoque mmxlv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2468101 04 iv 4 04/30/2045 die xxx mensis iv annoque mmxlv 45 xlv 2045} test clock-2.2121 {conversion of 2045-05-01} { clock format 2377254896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2045 12:34:56 die i mensis v annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2468102 05 v 5 05/01/2045 die i mensis v annoque mmxlv 45 xlv 2045} test clock-2.2122 {conversion of 2045-05-31} { clock format 2379846896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2045 12:34:56 die xxxi mensis v annoque mmxlv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2468132 05 v 5 05/31/2045 die xxxi mensis v annoque mmxlv 45 xlv 2045} test clock-2.2123 {conversion of 2045-06-01} { clock format 2379933296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2045 12:34:56 die i mensis vi annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2468133 06 vi 6 06/01/2045 die i mensis vi annoque mmxlv 45 xlv 2045} test clock-2.2124 {conversion of 2045-06-30} { clock format 2382438896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2045 12:34:56 die xxx mensis vi annoque mmxlv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2468162 06 vi 6 06/30/2045 die xxx mensis vi annoque mmxlv 45 xlv 2045} test clock-2.2125 {conversion of 2045-07-01} { clock format 2382525296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2045 12:34:56 die i mensis vii annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2468163 07 vii 7 07/01/2045 die i mensis vii annoque mmxlv 45 xlv 2045} test clock-2.2126 {conversion of 2045-07-31} { clock format 2385117296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2045 12:34:56 die xxxi mensis vii annoque mmxlv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2468193 07 vii 7 07/31/2045 die xxxi mensis vii annoque mmxlv 45 xlv 2045} test clock-2.2127 {conversion of 2045-08-01} { clock format 2385203696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2045 12:34:56 die i mensis viii annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2468194 08 viii 8 08/01/2045 die i mensis viii annoque mmxlv 45 xlv 2045} test clock-2.2128 {conversion of 2045-08-31} { clock format 2387795696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2045 12:34:56 die xxxi mensis viii annoque mmxlv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2468224 08 viii 8 08/31/2045 die xxxi mensis viii annoque mmxlv 45 xlv 2045} test clock-2.2129 {conversion of 2045-09-01} { clock format 2387882096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2045 12:34:56 die i mensis ix annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2468225 09 ix 9 09/01/2045 die i mensis ix annoque mmxlv 45 xlv 2045} test clock-2.2130 {conversion of 2045-09-30} { clock format 2390387696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2045 12:34:56 die xxx mensis ix annoque mmxlv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2468254 09 ix 9 09/30/2045 die xxx mensis ix annoque mmxlv 45 xlv 2045} test clock-2.2131 {conversion of 2045-10-01} { clock format 2390474096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2045 12:34:56 die i mensis x annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2468255 10 x 10 10/01/2045 die i mensis x annoque mmxlv 45 xlv 2045} test clock-2.2132 {conversion of 2045-10-31} { clock format 2393066096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2045 12:34:56 die xxxi mensis x annoque mmxlv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2468285 10 x 10 10/31/2045 die xxxi mensis x annoque mmxlv 45 xlv 2045} test clock-2.2133 {conversion of 2045-11-01} { clock format 2393152496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2045 12:34:56 die i mensis xi annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2468286 11 xi 11 11/01/2045 die i mensis xi annoque mmxlv 45 xlv 2045} test clock-2.2134 {conversion of 2045-11-30} { clock format 2395658096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2045 12:34:56 die xxx mensis xi annoque mmxlv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2468315 11 xi 11 11/30/2045 die xxx mensis xi annoque mmxlv 45 xlv 2045} test clock-2.2135 {conversion of 2045-12-01} { clock format 2395744496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2045 12:34:56 die i mensis xii annoque mmxlv xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2468316 12 xii 12 12/01/2045 die i mensis xii annoque mmxlv 45 xlv 2045} test clock-2.2136 {conversion of 2045-12-31} { clock format 2398336496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2045 12:34:56 die xxxi mensis xii annoque mmxlv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2468346 12 xii 12 12/31/2045 die xxxi mensis xii annoque mmxlv 45 xlv 2045} test clock-2.2137 {conversion of 2046-01-01} { clock format 2398422896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2046 12:34:56 die i mensis i annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2468347 01 i 1 01/01/2046 die i mensis i annoque mmxlvi 46 xlvi 2046} test clock-2.2138 {conversion of 2046-01-31} { clock format 2401014896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2046 12:34:56 die xxxi mensis i annoque mmxlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2468377 01 i 1 01/31/2046 die xxxi mensis i annoque mmxlvi 46 xlvi 2046} test clock-2.2139 {conversion of 2046-02-01} { clock format 2401101296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2046 12:34:56 die i mensis ii annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2468378 02 ii 2 02/01/2046 die i mensis ii annoque mmxlvi 46 xlvi 2046} test clock-2.2140 {conversion of 2046-02-28} { clock format 2403434096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2046 12:34:56 die xxviii mensis ii annoque mmxlvi xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2468405 02 ii 2 02/28/2046 die xxviii mensis ii annoque mmxlvi 46 xlvi 2046} test clock-2.2141 {conversion of 2046-03-01} { clock format 2403520496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2046 12:34:56 die i mensis iii annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2468406 03 iii 3 03/01/2046 die i mensis iii annoque mmxlvi 46 xlvi 2046} test clock-2.2142 {conversion of 2046-03-31} { clock format 2406112496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2046 12:34:56 die xxxi mensis iii annoque mmxlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2468436 03 iii 3 03/31/2046 die xxxi mensis iii annoque mmxlvi 46 xlvi 2046} test clock-2.2143 {conversion of 2046-04-01} { clock format 2406198896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2046 12:34:56 die i mensis iv annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2468437 04 iv 4 04/01/2046 die i mensis iv annoque mmxlvi 46 xlvi 2046} test clock-2.2144 {conversion of 2046-04-30} { clock format 2408704496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2046 12:34:56 die xxx mensis iv annoque mmxlvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2468466 04 iv 4 04/30/2046 die xxx mensis iv annoque mmxlvi 46 xlvi 2046} test clock-2.2145 {conversion of 2046-05-01} { clock format 2408790896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2046 12:34:56 die i mensis v annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2468467 05 v 5 05/01/2046 die i mensis v annoque mmxlvi 46 xlvi 2046} test clock-2.2146 {conversion of 2046-05-31} { clock format 2411382896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2046 12:34:56 die xxxi mensis v annoque mmxlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2468497 05 v 5 05/31/2046 die xxxi mensis v annoque mmxlvi 46 xlvi 2046} test clock-2.2147 {conversion of 2046-06-01} { clock format 2411469296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2046 12:34:56 die i mensis vi annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2468498 06 vi 6 06/01/2046 die i mensis vi annoque mmxlvi 46 xlvi 2046} test clock-2.2148 {conversion of 2046-06-30} { clock format 2413974896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2046 12:34:56 die xxx mensis vi annoque mmxlvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2468527 06 vi 6 06/30/2046 die xxx mensis vi annoque mmxlvi 46 xlvi 2046} test clock-2.2149 {conversion of 2046-07-01} { clock format 2414061296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2046 12:34:56 die i mensis vii annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2468528 07 vii 7 07/01/2046 die i mensis vii annoque mmxlvi 46 xlvi 2046} test clock-2.2150 {conversion of 2046-07-31} { clock format 2416653296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2046 12:34:56 die xxxi mensis vii annoque mmxlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2468558 07 vii 7 07/31/2046 die xxxi mensis vii annoque mmxlvi 46 xlvi 2046} test clock-2.2151 {conversion of 2046-08-01} { clock format 2416739696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2046 12:34:56 die i mensis viii annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2468559 08 viii 8 08/01/2046 die i mensis viii annoque mmxlvi 46 xlvi 2046} test clock-2.2152 {conversion of 2046-08-31} { clock format 2419331696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2046 12:34:56 die xxxi mensis viii annoque mmxlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2468589 08 viii 8 08/31/2046 die xxxi mensis viii annoque mmxlvi 46 xlvi 2046} test clock-2.2153 {conversion of 2046-09-01} { clock format 2419418096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2046 12:34:56 die i mensis ix annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2468590 09 ix 9 09/01/2046 die i mensis ix annoque mmxlvi 46 xlvi 2046} test clock-2.2154 {conversion of 2046-09-30} { clock format 2421923696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2046 12:34:56 die xxx mensis ix annoque mmxlvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2468619 09 ix 9 09/30/2046 die xxx mensis ix annoque mmxlvi 46 xlvi 2046} test clock-2.2155 {conversion of 2046-10-01} { clock format 2422010096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2046 12:34:56 die i mensis x annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2468620 10 x 10 10/01/2046 die i mensis x annoque mmxlvi 46 xlvi 2046} test clock-2.2156 {conversion of 2046-10-31} { clock format 2424602096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2046 12:34:56 die xxxi mensis x annoque mmxlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2468650 10 x 10 10/31/2046 die xxxi mensis x annoque mmxlvi 46 xlvi 2046} test clock-2.2157 {conversion of 2046-11-01} { clock format 2424688496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2046 12:34:56 die i mensis xi annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2468651 11 xi 11 11/01/2046 die i mensis xi annoque mmxlvi 46 xlvi 2046} test clock-2.2158 {conversion of 2046-11-30} { clock format 2427194096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2046 12:34:56 die xxx mensis xi annoque mmxlvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2468680 11 xi 11 11/30/2046 die xxx mensis xi annoque mmxlvi 46 xlvi 2046} test clock-2.2159 {conversion of 2046-12-01} { clock format 2427280496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2046 12:34:56 die i mensis xii annoque mmxlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2468681 12 xii 12 12/01/2046 die i mensis xii annoque mmxlvi 46 xlvi 2046} test clock-2.2160 {conversion of 2046-12-31} { clock format 2429872496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2046 12:34:56 die xxxi mensis xii annoque mmxlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2468711 12 xii 12 12/31/2046 die xxxi mensis xii annoque mmxlvi 46 xlvi 2046} test clock-2.2161 {conversion of 2047-01-01} { clock format 2429958896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2047 12:34:56 die i mensis i annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2468712 01 i 1 01/01/2047 die i mensis i annoque mmxlvii 47 xlvii 2047} test clock-2.2162 {conversion of 2047-01-31} { clock format 2432550896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2047 12:34:56 die xxxi mensis i annoque mmxlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2468742 01 i 1 01/31/2047 die xxxi mensis i annoque mmxlvii 47 xlvii 2047} test clock-2.2163 {conversion of 2047-02-01} { clock format 2432637296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2047 12:34:56 die i mensis ii annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2468743 02 ii 2 02/01/2047 die i mensis ii annoque mmxlvii 47 xlvii 2047} test clock-2.2164 {conversion of 2047-02-28} { clock format 2434970096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2047 12:34:56 die xxviii mensis ii annoque mmxlvii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2468770 02 ii 2 02/28/2047 die xxviii mensis ii annoque mmxlvii 47 xlvii 2047} test clock-2.2165 {conversion of 2047-03-01} { clock format 2435056496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2047 12:34:56 die i mensis iii annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2468771 03 iii 3 03/01/2047 die i mensis iii annoque mmxlvii 47 xlvii 2047} test clock-2.2166 {conversion of 2047-03-31} { clock format 2437648496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2047 12:34:56 die xxxi mensis iii annoque mmxlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2468801 03 iii 3 03/31/2047 die xxxi mensis iii annoque mmxlvii 47 xlvii 2047} test clock-2.2167 {conversion of 2047-04-01} { clock format 2437734896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2047 12:34:56 die i mensis iv annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2468802 04 iv 4 04/01/2047 die i mensis iv annoque mmxlvii 47 xlvii 2047} test clock-2.2168 {conversion of 2047-04-30} { clock format 2440240496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2047 12:34:56 die xxx mensis iv annoque mmxlvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2468831 04 iv 4 04/30/2047 die xxx mensis iv annoque mmxlvii 47 xlvii 2047} test clock-2.2169 {conversion of 2047-05-01} { clock format 2440326896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2047 12:34:56 die i mensis v annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2468832 05 v 5 05/01/2047 die i mensis v annoque mmxlvii 47 xlvii 2047} test clock-2.2170 {conversion of 2047-05-31} { clock format 2442918896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2047 12:34:56 die xxxi mensis v annoque mmxlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2468862 05 v 5 05/31/2047 die xxxi mensis v annoque mmxlvii 47 xlvii 2047} test clock-2.2171 {conversion of 2047-06-01} { clock format 2443005296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2047 12:34:56 die i mensis vi annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2468863 06 vi 6 06/01/2047 die i mensis vi annoque mmxlvii 47 xlvii 2047} test clock-2.2172 {conversion of 2047-06-30} { clock format 2445510896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2047 12:34:56 die xxx mensis vi annoque mmxlvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2468892 06 vi 6 06/30/2047 die xxx mensis vi annoque mmxlvii 47 xlvii 2047} test clock-2.2173 {conversion of 2047-07-01} { clock format 2445597296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2047 12:34:56 die i mensis vii annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2468893 07 vii 7 07/01/2047 die i mensis vii annoque mmxlvii 47 xlvii 2047} test clock-2.2174 {conversion of 2047-07-31} { clock format 2448189296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2047 12:34:56 die xxxi mensis vii annoque mmxlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2468923 07 vii 7 07/31/2047 die xxxi mensis vii annoque mmxlvii 47 xlvii 2047} test clock-2.2175 {conversion of 2047-08-01} { clock format 2448275696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2047 12:34:56 die i mensis viii annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2468924 08 viii 8 08/01/2047 die i mensis viii annoque mmxlvii 47 xlvii 2047} test clock-2.2176 {conversion of 2047-08-31} { clock format 2450867696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2047 12:34:56 die xxxi mensis viii annoque mmxlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2468954 08 viii 8 08/31/2047 die xxxi mensis viii annoque mmxlvii 47 xlvii 2047} test clock-2.2177 {conversion of 2047-09-01} { clock format 2450954096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2047 12:34:56 die i mensis ix annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2468955 09 ix 9 09/01/2047 die i mensis ix annoque mmxlvii 47 xlvii 2047} test clock-2.2178 {conversion of 2047-09-30} { clock format 2453459696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2047 12:34:56 die xxx mensis ix annoque mmxlvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2468984 09 ix 9 09/30/2047 die xxx mensis ix annoque mmxlvii 47 xlvii 2047} test clock-2.2179 {conversion of 2047-10-01} { clock format 2453546096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2047 12:34:56 die i mensis x annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2468985 10 x 10 10/01/2047 die i mensis x annoque mmxlvii 47 xlvii 2047} test clock-2.2180 {conversion of 2047-10-31} { clock format 2456138096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2047 12:34:56 die xxxi mensis x annoque mmxlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2469015 10 x 10 10/31/2047 die xxxi mensis x annoque mmxlvii 47 xlvii 2047} test clock-2.2181 {conversion of 2047-11-01} { clock format 2456224496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2047 12:34:56 die i mensis xi annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2469016 11 xi 11 11/01/2047 die i mensis xi annoque mmxlvii 47 xlvii 2047} test clock-2.2182 {conversion of 2047-11-30} { clock format 2458730096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2047 12:34:56 die xxx mensis xi annoque mmxlvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2469045 11 xi 11 11/30/2047 die xxx mensis xi annoque mmxlvii 47 xlvii 2047} test clock-2.2183 {conversion of 2047-12-01} { clock format 2458816496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2047 12:34:56 die i mensis xii annoque mmxlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2469046 12 xii 12 12/01/2047 die i mensis xii annoque mmxlvii 47 xlvii 2047} test clock-2.2184 {conversion of 2047-12-31} { clock format 2461408496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2047 12:34:56 die xxxi mensis xii annoque mmxlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2469076 12 xii 12 12/31/2047 die xxxi mensis xii annoque mmxlvii 47 xlvii 2047} test clock-2.2185 {conversion of 2048-01-01} { clock format 2461494896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2048 12:34:56 die i mensis i annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2469077 01 i 1 01/01/2048 die i mensis i annoque mmxlviii 48 xlviii 2048} test clock-2.2186 {conversion of 2048-01-31} { clock format 2464086896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2048 12:34:56 die xxxi mensis i annoque mmxlviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2469107 01 i 1 01/31/2048 die xxxi mensis i annoque mmxlviii 48 xlviii 2048} test clock-2.2187 {conversion of 2048-02-01} { clock format 2464173296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2048 12:34:56 die i mensis ii annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2469108 02 ii 2 02/01/2048 die i mensis ii annoque mmxlviii 48 xlviii 2048} test clock-2.2188 {conversion of 2048-02-29} { clock format 2466592496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2048 12:34:56 die xxix mensis ii annoque mmxlviii xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2469136 02 ii 2 02/29/2048 die xxix mensis ii annoque mmxlviii 48 xlviii 2048} test clock-2.2189 {conversion of 2048-03-01} { clock format 2466678896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2048 12:34:56 die i mensis iii annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2469137 03 iii 3 03/01/2048 die i mensis iii annoque mmxlviii 48 xlviii 2048} test clock-2.2190 {conversion of 2048-03-31} { clock format 2469270896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2048 12:34:56 die xxxi mensis iii annoque mmxlviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2469167 03 iii 3 03/31/2048 die xxxi mensis iii annoque mmxlviii 48 xlviii 2048} test clock-2.2191 {conversion of 2048-04-01} { clock format 2469357296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2048 12:34:56 die i mensis iv annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2469168 04 iv 4 04/01/2048 die i mensis iv annoque mmxlviii 48 xlviii 2048} test clock-2.2192 {conversion of 2048-04-30} { clock format 2471862896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2048 12:34:56 die xxx mensis iv annoque mmxlviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2469197 04 iv 4 04/30/2048 die xxx mensis iv annoque mmxlviii 48 xlviii 2048} test clock-2.2193 {conversion of 2048-05-01} { clock format 2471949296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2048 12:34:56 die i mensis v annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2469198 05 v 5 05/01/2048 die i mensis v annoque mmxlviii 48 xlviii 2048} test clock-2.2194 {conversion of 2048-05-31} { clock format 2474541296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2048 12:34:56 die xxxi mensis v annoque mmxlviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2469228 05 v 5 05/31/2048 die xxxi mensis v annoque mmxlviii 48 xlviii 2048} test clock-2.2195 {conversion of 2048-06-01} { clock format 2474627696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2048 12:34:56 die i mensis vi annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2469229 06 vi 6 06/01/2048 die i mensis vi annoque mmxlviii 48 xlviii 2048} test clock-2.2196 {conversion of 2048-06-30} { clock format 2477133296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2048 12:34:56 die xxx mensis vi annoque mmxlviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2469258 06 vi 6 06/30/2048 die xxx mensis vi annoque mmxlviii 48 xlviii 2048} test clock-2.2197 {conversion of 2048-07-01} { clock format 2477219696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2048 12:34:56 die i mensis vii annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2469259 07 vii 7 07/01/2048 die i mensis vii annoque mmxlviii 48 xlviii 2048} test clock-2.2198 {conversion of 2048-07-31} { clock format 2479811696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2048 12:34:56 die xxxi mensis vii annoque mmxlviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2469289 07 vii 7 07/31/2048 die xxxi mensis vii annoque mmxlviii 48 xlviii 2048} test clock-2.2199 {conversion of 2048-08-01} { clock format 2479898096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2048 12:34:56 die i mensis viii annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2469290 08 viii 8 08/01/2048 die i mensis viii annoque mmxlviii 48 xlviii 2048} test clock-2.2200 {conversion of 2048-08-31} { clock format 2482490096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2048 12:34:56 die xxxi mensis viii annoque mmxlviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2469320 08 viii 8 08/31/2048 die xxxi mensis viii annoque mmxlviii 48 xlviii 2048} test clock-2.2201 {conversion of 2048-09-01} { clock format 2482576496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2048 12:34:56 die i mensis ix annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2469321 09 ix 9 09/01/2048 die i mensis ix annoque mmxlviii 48 xlviii 2048} test clock-2.2202 {conversion of 2048-09-30} { clock format 2485082096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2048 12:34:56 die xxx mensis ix annoque mmxlviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2469350 09 ix 9 09/30/2048 die xxx mensis ix annoque mmxlviii 48 xlviii 2048} test clock-2.2203 {conversion of 2048-10-01} { clock format 2485168496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2048 12:34:56 die i mensis x annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2469351 10 x 10 10/01/2048 die i mensis x annoque mmxlviii 48 xlviii 2048} test clock-2.2204 {conversion of 2048-10-31} { clock format 2487760496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2048 12:34:56 die xxxi mensis x annoque mmxlviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2469381 10 x 10 10/31/2048 die xxxi mensis x annoque mmxlviii 48 xlviii 2048} test clock-2.2205 {conversion of 2048-11-01} { clock format 2487846896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2048 12:34:56 die i mensis xi annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2469382 11 xi 11 11/01/2048 die i mensis xi annoque mmxlviii 48 xlviii 2048} test clock-2.2206 {conversion of 2048-11-30} { clock format 2490352496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2048 12:34:56 die xxx mensis xi annoque mmxlviii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2469411 11 xi 11 11/30/2048 die xxx mensis xi annoque mmxlviii 48 xlviii 2048} test clock-2.2207 {conversion of 2048-12-01} { clock format 2490438896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2048 12:34:56 die i mensis xii annoque mmxlviii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2469412 12 xii 12 12/01/2048 die i mensis xii annoque mmxlviii 48 xlviii 2048} test clock-2.2208 {conversion of 2048-12-31} { clock format 2493030896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2048 12:34:56 die xxxi mensis xii annoque mmxlviii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2469442 12 xii 12 12/31/2048 die xxxi mensis xii annoque mmxlviii 48 xlviii 2048} test clock-2.2209 {conversion of 2049-01-01} { clock format 2493117296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2049 12:34:56 die i mensis i annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2469443 01 i 1 01/01/2049 die i mensis i annoque mmxlix 49 xlix 2049} test clock-2.2210 {conversion of 2049-01-31} { clock format 2495709296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2049 12:34:56 die xxxi mensis i annoque mmxlix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2469473 01 i 1 01/31/2049 die xxxi mensis i annoque mmxlix 49 xlix 2049} test clock-2.2211 {conversion of 2049-02-01} { clock format 2495795696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2049 12:34:56 die i mensis ii annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2469474 02 ii 2 02/01/2049 die i mensis ii annoque mmxlix 49 xlix 2049} test clock-2.2212 {conversion of 2049-02-28} { clock format 2498128496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2049 12:34:56 die xxviii mensis ii annoque mmxlix xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2469501 02 ii 2 02/28/2049 die xxviii mensis ii annoque mmxlix 49 xlix 2049} test clock-2.2213 {conversion of 2049-03-01} { clock format 2498214896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2049 12:34:56 die i mensis iii annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2469502 03 iii 3 03/01/2049 die i mensis iii annoque mmxlix 49 xlix 2049} test clock-2.2214 {conversion of 2049-03-31} { clock format 2500806896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2049 12:34:56 die xxxi mensis iii annoque mmxlix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2469532 03 iii 3 03/31/2049 die xxxi mensis iii annoque mmxlix 49 xlix 2049} test clock-2.2215 {conversion of 2049-04-01} { clock format 2500893296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2049 12:34:56 die i mensis iv annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2469533 04 iv 4 04/01/2049 die i mensis iv annoque mmxlix 49 xlix 2049} test clock-2.2216 {conversion of 2049-04-30} { clock format 2503398896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2049 12:34:56 die xxx mensis iv annoque mmxlix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2469562 04 iv 4 04/30/2049 die xxx mensis iv annoque mmxlix 49 xlix 2049} test clock-2.2217 {conversion of 2049-05-01} { clock format 2503485296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2049 12:34:56 die i mensis v annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2469563 05 v 5 05/01/2049 die i mensis v annoque mmxlix 49 xlix 2049} test clock-2.2218 {conversion of 2049-05-31} { clock format 2506077296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2049 12:34:56 die xxxi mensis v annoque mmxlix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2469593 05 v 5 05/31/2049 die xxxi mensis v annoque mmxlix 49 xlix 2049} test clock-2.2219 {conversion of 2049-06-01} { clock format 2506163696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2049 12:34:56 die i mensis vi annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2469594 06 vi 6 06/01/2049 die i mensis vi annoque mmxlix 49 xlix 2049} test clock-2.2220 {conversion of 2049-06-30} { clock format 2508669296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2049 12:34:56 die xxx mensis vi annoque mmxlix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2469623 06 vi 6 06/30/2049 die xxx mensis vi annoque mmxlix 49 xlix 2049} test clock-2.2221 {conversion of 2049-07-01} { clock format 2508755696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2049 12:34:56 die i mensis vii annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2469624 07 vii 7 07/01/2049 die i mensis vii annoque mmxlix 49 xlix 2049} test clock-2.2222 {conversion of 2049-07-31} { clock format 2511347696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2049 12:34:56 die xxxi mensis vii annoque mmxlix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2469654 07 vii 7 07/31/2049 die xxxi mensis vii annoque mmxlix 49 xlix 2049} test clock-2.2223 {conversion of 2049-08-01} { clock format 2511434096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2049 12:34:56 die i mensis viii annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2469655 08 viii 8 08/01/2049 die i mensis viii annoque mmxlix 49 xlix 2049} test clock-2.2224 {conversion of 2049-08-31} { clock format 2514026096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2049 12:34:56 die xxxi mensis viii annoque mmxlix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2469685 08 viii 8 08/31/2049 die xxxi mensis viii annoque mmxlix 49 xlix 2049} test clock-2.2225 {conversion of 2049-09-01} { clock format 2514112496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2049 12:34:56 die i mensis ix annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2469686 09 ix 9 09/01/2049 die i mensis ix annoque mmxlix 49 xlix 2049} test clock-2.2226 {conversion of 2049-09-30} { clock format 2516618096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2049 12:34:56 die xxx mensis ix annoque mmxlix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2469715 09 ix 9 09/30/2049 die xxx mensis ix annoque mmxlix 49 xlix 2049} test clock-2.2227 {conversion of 2049-10-01} { clock format 2516704496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2049 12:34:56 die i mensis x annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2469716 10 x 10 10/01/2049 die i mensis x annoque mmxlix 49 xlix 2049} test clock-2.2228 {conversion of 2049-10-31} { clock format 2519296496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2049 12:34:56 die xxxi mensis x annoque mmxlix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2469746 10 x 10 10/31/2049 die xxxi mensis x annoque mmxlix 49 xlix 2049} test clock-2.2229 {conversion of 2049-11-01} { clock format 2519382896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2049 12:34:56 die i mensis xi annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2469747 11 xi 11 11/01/2049 die i mensis xi annoque mmxlix 49 xlix 2049} test clock-2.2230 {conversion of 2049-11-30} { clock format 2521888496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2049 12:34:56 die xxx mensis xi annoque mmxlix xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2469776 11 xi 11 11/30/2049 die xxx mensis xi annoque mmxlix 49 xlix 2049} test clock-2.2231 {conversion of 2049-12-01} { clock format 2521974896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2049 12:34:56 die i mensis xii annoque mmxlix xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2469777 12 xii 12 12/01/2049 die i mensis xii annoque mmxlix 49 xlix 2049} test clock-2.2232 {conversion of 2049-12-31} { clock format 2524566896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2049 12:34:56 die xxxi mensis xii annoque mmxlix xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2469807 12 xii 12 12/31/2049 die xxxi mensis xii annoque mmxlix 49 xlix 2049} test clock-2.2233 {conversion of 2052-01-01} { clock format 2587725296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2052 12:34:56 die i mensis i annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2470538 01 i 1 01/01/2052 die i mensis i annoque mmlii 52 lii 2052} test clock-2.2234 {conversion of 2052-01-31} { clock format 2590317296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2052 12:34:56 die xxxi mensis i annoque mmlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2470568 01 i 1 01/31/2052 die xxxi mensis i annoque mmlii 52 lii 2052} test clock-2.2235 {conversion of 2052-02-01} { clock format 2590403696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2052 12:34:56 die i mensis ii annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2470569 02 ii 2 02/01/2052 die i mensis ii annoque mmlii 52 lii 2052} test clock-2.2236 {conversion of 2052-02-29} { clock format 2592822896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2052 12:34:56 die xxix mensis ii annoque mmlii xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2470597 02 ii 2 02/29/2052 die xxix mensis ii annoque mmlii 52 lii 2052} test clock-2.2237 {conversion of 2052-03-01} { clock format 2592909296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2052 12:34:56 die i mensis iii annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2470598 03 iii 3 03/01/2052 die i mensis iii annoque mmlii 52 lii 2052} test clock-2.2238 {conversion of 2052-03-31} { clock format 2595501296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2052 12:34:56 die xxxi mensis iii annoque mmlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2470628 03 iii 3 03/31/2052 die xxxi mensis iii annoque mmlii 52 lii 2052} test clock-2.2239 {conversion of 2052-04-01} { clock format 2595587696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2052 12:34:56 die i mensis iv annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2470629 04 iv 4 04/01/2052 die i mensis iv annoque mmlii 52 lii 2052} test clock-2.2240 {conversion of 2052-04-30} { clock format 2598093296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2052 12:34:56 die xxx mensis iv annoque mmlii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2470658 04 iv 4 04/30/2052 die xxx mensis iv annoque mmlii 52 lii 2052} test clock-2.2241 {conversion of 2052-05-01} { clock format 2598179696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2052 12:34:56 die i mensis v annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2470659 05 v 5 05/01/2052 die i mensis v annoque mmlii 52 lii 2052} test clock-2.2242 {conversion of 2052-05-31} { clock format 2600771696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2052 12:34:56 die xxxi mensis v annoque mmlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2470689 05 v 5 05/31/2052 die xxxi mensis v annoque mmlii 52 lii 2052} test clock-2.2243 {conversion of 2052-06-01} { clock format 2600858096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2052 12:34:56 die i mensis vi annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2470690 06 vi 6 06/01/2052 die i mensis vi annoque mmlii 52 lii 2052} test clock-2.2244 {conversion of 2052-06-30} { clock format 2603363696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2052 12:34:56 die xxx mensis vi annoque mmlii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2470719 06 vi 6 06/30/2052 die xxx mensis vi annoque mmlii 52 lii 2052} test clock-2.2245 {conversion of 2052-07-01} { clock format 2603450096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2052 12:34:56 die i mensis vii annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2470720 07 vii 7 07/01/2052 die i mensis vii annoque mmlii 52 lii 2052} test clock-2.2246 {conversion of 2052-07-31} { clock format 2606042096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2052 12:34:56 die xxxi mensis vii annoque mmlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2470750 07 vii 7 07/31/2052 die xxxi mensis vii annoque mmlii 52 lii 2052} test clock-2.2247 {conversion of 2052-08-01} { clock format 2606128496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2052 12:34:56 die i mensis viii annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2470751 08 viii 8 08/01/2052 die i mensis viii annoque mmlii 52 lii 2052} test clock-2.2248 {conversion of 2052-08-31} { clock format 2608720496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2052 12:34:56 die xxxi mensis viii annoque mmlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2470781 08 viii 8 08/31/2052 die xxxi mensis viii annoque mmlii 52 lii 2052} test clock-2.2249 {conversion of 2052-09-01} { clock format 2608806896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2052 12:34:56 die i mensis ix annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2470782 09 ix 9 09/01/2052 die i mensis ix annoque mmlii 52 lii 2052} test clock-2.2250 {conversion of 2052-09-30} { clock format 2611312496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2052 12:34:56 die xxx mensis ix annoque mmlii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2470811 09 ix 9 09/30/2052 die xxx mensis ix annoque mmlii 52 lii 2052} test clock-2.2251 {conversion of 2052-10-01} { clock format 2611398896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2052 12:34:56 die i mensis x annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2470812 10 x 10 10/01/2052 die i mensis x annoque mmlii 52 lii 2052} test clock-2.2252 {conversion of 2052-10-31} { clock format 2613990896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2052 12:34:56 die xxxi mensis x annoque mmlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2470842 10 x 10 10/31/2052 die xxxi mensis x annoque mmlii 52 lii 2052} test clock-2.2253 {conversion of 2052-11-01} { clock format 2614077296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2052 12:34:56 die i mensis xi annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2470843 11 xi 11 11/01/2052 die i mensis xi annoque mmlii 52 lii 2052} test clock-2.2254 {conversion of 2052-11-30} { clock format 2616582896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2052 12:34:56 die xxx mensis xi annoque mmlii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2470872 11 xi 11 11/30/2052 die xxx mensis xi annoque mmlii 52 lii 2052} test clock-2.2255 {conversion of 2052-12-01} { clock format 2616669296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2052 12:34:56 die i mensis xii annoque mmlii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2470873 12 xii 12 12/01/2052 die i mensis xii annoque mmlii 52 lii 2052} test clock-2.2256 {conversion of 2052-12-31} { clock format 2619261296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2052 12:34:56 die xxxi mensis xii annoque mmlii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2470903 12 xii 12 12/31/2052 die xxxi mensis xii annoque mmlii 52 lii 2052} test clock-2.2257 {conversion of 2053-01-01} { clock format 2619347696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2053 12:34:56 die i mensis i annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2470904 01 i 1 01/01/2053 die i mensis i annoque mmliii 53 liii 2053} test clock-2.2258 {conversion of 2053-01-31} { clock format 2621939696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2053 12:34:56 die xxxi mensis i annoque mmliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2470934 01 i 1 01/31/2053 die xxxi mensis i annoque mmliii 53 liii 2053} test clock-2.2259 {conversion of 2053-02-01} { clock format 2622026096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2053 12:34:56 die i mensis ii annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2470935 02 ii 2 02/01/2053 die i mensis ii annoque mmliii 53 liii 2053} test clock-2.2260 {conversion of 2053-02-28} { clock format 2624358896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2053 12:34:56 die xxviii mensis ii annoque mmliii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2470962 02 ii 2 02/28/2053 die xxviii mensis ii annoque mmliii 53 liii 2053} test clock-2.2261 {conversion of 2053-03-01} { clock format 2624445296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2053 12:34:56 die i mensis iii annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2470963 03 iii 3 03/01/2053 die i mensis iii annoque mmliii 53 liii 2053} test clock-2.2262 {conversion of 2053-03-31} { clock format 2627037296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2053 12:34:56 die xxxi mensis iii annoque mmliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2470993 03 iii 3 03/31/2053 die xxxi mensis iii annoque mmliii 53 liii 2053} test clock-2.2263 {conversion of 2053-04-01} { clock format 2627123696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2053 12:34:56 die i mensis iv annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2470994 04 iv 4 04/01/2053 die i mensis iv annoque mmliii 53 liii 2053} test clock-2.2264 {conversion of 2053-04-30} { clock format 2629629296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2053 12:34:56 die xxx mensis iv annoque mmliii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2471023 04 iv 4 04/30/2053 die xxx mensis iv annoque mmliii 53 liii 2053} test clock-2.2265 {conversion of 2053-05-01} { clock format 2629715696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2053 12:34:56 die i mensis v annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2471024 05 v 5 05/01/2053 die i mensis v annoque mmliii 53 liii 2053} test clock-2.2266 {conversion of 2053-05-31} { clock format 2632307696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2053 12:34:56 die xxxi mensis v annoque mmliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2471054 05 v 5 05/31/2053 die xxxi mensis v annoque mmliii 53 liii 2053} test clock-2.2267 {conversion of 2053-06-01} { clock format 2632394096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2053 12:34:56 die i mensis vi annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2471055 06 vi 6 06/01/2053 die i mensis vi annoque mmliii 53 liii 2053} test clock-2.2268 {conversion of 2053-06-30} { clock format 2634899696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2053 12:34:56 die xxx mensis vi annoque mmliii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2471084 06 vi 6 06/30/2053 die xxx mensis vi annoque mmliii 53 liii 2053} test clock-2.2269 {conversion of 2053-07-01} { clock format 2634986096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2053 12:34:56 die i mensis vii annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2471085 07 vii 7 07/01/2053 die i mensis vii annoque mmliii 53 liii 2053} test clock-2.2270 {conversion of 2053-07-31} { clock format 2637578096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2053 12:34:56 die xxxi mensis vii annoque mmliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2471115 07 vii 7 07/31/2053 die xxxi mensis vii annoque mmliii 53 liii 2053} test clock-2.2271 {conversion of 2053-08-01} { clock format 2637664496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2053 12:34:56 die i mensis viii annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2471116 08 viii 8 08/01/2053 die i mensis viii annoque mmliii 53 liii 2053} test clock-2.2272 {conversion of 2053-08-31} { clock format 2640256496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2053 12:34:56 die xxxi mensis viii annoque mmliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2471146 08 viii 8 08/31/2053 die xxxi mensis viii annoque mmliii 53 liii 2053} test clock-2.2273 {conversion of 2053-09-01} { clock format 2640342896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2053 12:34:56 die i mensis ix annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2471147 09 ix 9 09/01/2053 die i mensis ix annoque mmliii 53 liii 2053} test clock-2.2274 {conversion of 2053-09-30} { clock format 2642848496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2053 12:34:56 die xxx mensis ix annoque mmliii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2471176 09 ix 9 09/30/2053 die xxx mensis ix annoque mmliii 53 liii 2053} test clock-2.2275 {conversion of 2053-10-01} { clock format 2642934896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2053 12:34:56 die i mensis x annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2471177 10 x 10 10/01/2053 die i mensis x annoque mmliii 53 liii 2053} test clock-2.2276 {conversion of 2053-10-31} { clock format 2645526896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2053 12:34:56 die xxxi mensis x annoque mmliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2471207 10 x 10 10/31/2053 die xxxi mensis x annoque mmliii 53 liii 2053} test clock-2.2277 {conversion of 2053-11-01} { clock format 2645613296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2053 12:34:56 die i mensis xi annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2471208 11 xi 11 11/01/2053 die i mensis xi annoque mmliii 53 liii 2053} test clock-2.2278 {conversion of 2053-11-30} { clock format 2648118896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2053 12:34:56 die xxx mensis xi annoque mmliii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2471237 11 xi 11 11/30/2053 die xxx mensis xi annoque mmliii 53 liii 2053} test clock-2.2279 {conversion of 2053-12-01} { clock format 2648205296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2053 12:34:56 die i mensis xii annoque mmliii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2471238 12 xii 12 12/01/2053 die i mensis xii annoque mmliii 53 liii 2053} test clock-2.2280 {conversion of 2053-12-31} { clock format 2650797296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2053 12:34:56 die xxxi mensis xii annoque mmliii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2471268 12 xii 12 12/31/2053 die xxxi mensis xii annoque mmliii 53 liii 2053} test clock-2.2281 {conversion of 2056-01-01} { clock format 2713955696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2056 12:34:56 die i mensis i annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2471999 01 i 1 01/01/2056 die i mensis i annoque mmlvi 56 lvi 2056} test clock-2.2282 {conversion of 2056-01-31} { clock format 2716547696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2056 12:34:56 die xxxi mensis i annoque mmlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2472029 01 i 1 01/31/2056 die xxxi mensis i annoque mmlvi 56 lvi 2056} test clock-2.2283 {conversion of 2056-02-01} { clock format 2716634096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2056 12:34:56 die i mensis ii annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2472030 02 ii 2 02/01/2056 die i mensis ii annoque mmlvi 56 lvi 2056} test clock-2.2284 {conversion of 2056-02-29} { clock format 2719053296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2056 12:34:56 die xxix mensis ii annoque mmlvi xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2472058 02 ii 2 02/29/2056 die xxix mensis ii annoque mmlvi 56 lvi 2056} test clock-2.2285 {conversion of 2056-03-01} { clock format 2719139696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2056 12:34:56 die i mensis iii annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2472059 03 iii 3 03/01/2056 die i mensis iii annoque mmlvi 56 lvi 2056} test clock-2.2286 {conversion of 2056-03-31} { clock format 2721731696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2056 12:34:56 die xxxi mensis iii annoque mmlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2472089 03 iii 3 03/31/2056 die xxxi mensis iii annoque mmlvi 56 lvi 2056} test clock-2.2287 {conversion of 2056-04-01} { clock format 2721818096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2056 12:34:56 die i mensis iv annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2472090 04 iv 4 04/01/2056 die i mensis iv annoque mmlvi 56 lvi 2056} test clock-2.2288 {conversion of 2056-04-30} { clock format 2724323696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2056 12:34:56 die xxx mensis iv annoque mmlvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2472119 04 iv 4 04/30/2056 die xxx mensis iv annoque mmlvi 56 lvi 2056} test clock-2.2289 {conversion of 2056-05-01} { clock format 2724410096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2056 12:34:56 die i mensis v annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2472120 05 v 5 05/01/2056 die i mensis v annoque mmlvi 56 lvi 2056} test clock-2.2290 {conversion of 2056-05-31} { clock format 2727002096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2056 12:34:56 die xxxi mensis v annoque mmlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2472150 05 v 5 05/31/2056 die xxxi mensis v annoque mmlvi 56 lvi 2056} test clock-2.2291 {conversion of 2056-06-01} { clock format 2727088496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2056 12:34:56 die i mensis vi annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2472151 06 vi 6 06/01/2056 die i mensis vi annoque mmlvi 56 lvi 2056} test clock-2.2292 {conversion of 2056-06-30} { clock format 2729594096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2056 12:34:56 die xxx mensis vi annoque mmlvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2472180 06 vi 6 06/30/2056 die xxx mensis vi annoque mmlvi 56 lvi 2056} test clock-2.2293 {conversion of 2056-07-01} { clock format 2729680496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2056 12:34:56 die i mensis vii annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2472181 07 vii 7 07/01/2056 die i mensis vii annoque mmlvi 56 lvi 2056} test clock-2.2294 {conversion of 2056-07-31} { clock format 2732272496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2056 12:34:56 die xxxi mensis vii annoque mmlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2472211 07 vii 7 07/31/2056 die xxxi mensis vii annoque mmlvi 56 lvi 2056} test clock-2.2295 {conversion of 2056-08-01} { clock format 2732358896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2056 12:34:56 die i mensis viii annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2472212 08 viii 8 08/01/2056 die i mensis viii annoque mmlvi 56 lvi 2056} test clock-2.2296 {conversion of 2056-08-31} { clock format 2734950896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2056 12:34:56 die xxxi mensis viii annoque mmlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2472242 08 viii 8 08/31/2056 die xxxi mensis viii annoque mmlvi 56 lvi 2056} test clock-2.2297 {conversion of 2056-09-01} { clock format 2735037296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2056 12:34:56 die i mensis ix annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2472243 09 ix 9 09/01/2056 die i mensis ix annoque mmlvi 56 lvi 2056} test clock-2.2298 {conversion of 2056-09-30} { clock format 2737542896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2056 12:34:56 die xxx mensis ix annoque mmlvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2472272 09 ix 9 09/30/2056 die xxx mensis ix annoque mmlvi 56 lvi 2056} test clock-2.2299 {conversion of 2056-10-01} { clock format 2737629296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2056 12:34:56 die i mensis x annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2472273 10 x 10 10/01/2056 die i mensis x annoque mmlvi 56 lvi 2056} test clock-2.2300 {conversion of 2056-10-31} { clock format 2740221296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2056 12:34:56 die xxxi mensis x annoque mmlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2472303 10 x 10 10/31/2056 die xxxi mensis x annoque mmlvi 56 lvi 2056} test clock-2.2301 {conversion of 2056-11-01} { clock format 2740307696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2056 12:34:56 die i mensis xi annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2472304 11 xi 11 11/01/2056 die i mensis xi annoque mmlvi 56 lvi 2056} test clock-2.2302 {conversion of 2056-11-30} { clock format 2742813296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2056 12:34:56 die xxx mensis xi annoque mmlvi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2472333 11 xi 11 11/30/2056 die xxx mensis xi annoque mmlvi 56 lvi 2056} test clock-2.2303 {conversion of 2056-12-01} { clock format 2742899696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2056 12:34:56 die i mensis xii annoque mmlvi xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2472334 12 xii 12 12/01/2056 die i mensis xii annoque mmlvi 56 lvi 2056} test clock-2.2304 {conversion of 2056-12-31} { clock format 2745491696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2056 12:34:56 die xxxi mensis xii annoque mmlvi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2472364 12 xii 12 12/31/2056 die xxxi mensis xii annoque mmlvi 56 lvi 2056} test clock-2.2305 {conversion of 2057-01-01} { clock format 2745578096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2057 12:34:56 die i mensis i annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2472365 01 i 1 01/01/2057 die i mensis i annoque mmlvii 57 lvii 2057} test clock-2.2306 {conversion of 2057-01-31} { clock format 2748170096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2057 12:34:56 die xxxi mensis i annoque mmlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2472395 01 i 1 01/31/2057 die xxxi mensis i annoque mmlvii 57 lvii 2057} test clock-2.2307 {conversion of 2057-02-01} { clock format 2748256496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2057 12:34:56 die i mensis ii annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2472396 02 ii 2 02/01/2057 die i mensis ii annoque mmlvii 57 lvii 2057} test clock-2.2308 {conversion of 2057-02-28} { clock format 2750589296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2057 12:34:56 die xxviii mensis ii annoque mmlvii xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2472423 02 ii 2 02/28/2057 die xxviii mensis ii annoque mmlvii 57 lvii 2057} test clock-2.2309 {conversion of 2057-03-01} { clock format 2750675696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2057 12:34:56 die i mensis iii annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2472424 03 iii 3 03/01/2057 die i mensis iii annoque mmlvii 57 lvii 2057} test clock-2.2310 {conversion of 2057-03-31} { clock format 2753267696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2057 12:34:56 die xxxi mensis iii annoque mmlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2472454 03 iii 3 03/31/2057 die xxxi mensis iii annoque mmlvii 57 lvii 2057} test clock-2.2311 {conversion of 2057-04-01} { clock format 2753354096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2057 12:34:56 die i mensis iv annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2472455 04 iv 4 04/01/2057 die i mensis iv annoque mmlvii 57 lvii 2057} test clock-2.2312 {conversion of 2057-04-30} { clock format 2755859696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2057 12:34:56 die xxx mensis iv annoque mmlvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2472484 04 iv 4 04/30/2057 die xxx mensis iv annoque mmlvii 57 lvii 2057} test clock-2.2313 {conversion of 2057-05-01} { clock format 2755946096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2057 12:34:56 die i mensis v annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2472485 05 v 5 05/01/2057 die i mensis v annoque mmlvii 57 lvii 2057} test clock-2.2314 {conversion of 2057-05-31} { clock format 2758538096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2057 12:34:56 die xxxi mensis v annoque mmlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2472515 05 v 5 05/31/2057 die xxxi mensis v annoque mmlvii 57 lvii 2057} test clock-2.2315 {conversion of 2057-06-01} { clock format 2758624496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2057 12:34:56 die i mensis vi annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2472516 06 vi 6 06/01/2057 die i mensis vi annoque mmlvii 57 lvii 2057} test clock-2.2316 {conversion of 2057-06-30} { clock format 2761130096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2057 12:34:56 die xxx mensis vi annoque mmlvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2472545 06 vi 6 06/30/2057 die xxx mensis vi annoque mmlvii 57 lvii 2057} test clock-2.2317 {conversion of 2057-07-01} { clock format 2761216496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2057 12:34:56 die i mensis vii annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2472546 07 vii 7 07/01/2057 die i mensis vii annoque mmlvii 57 lvii 2057} test clock-2.2318 {conversion of 2057-07-31} { clock format 2763808496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2057 12:34:56 die xxxi mensis vii annoque mmlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2472576 07 vii 7 07/31/2057 die xxxi mensis vii annoque mmlvii 57 lvii 2057} test clock-2.2319 {conversion of 2057-08-01} { clock format 2763894896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2057 12:34:56 die i mensis viii annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2472577 08 viii 8 08/01/2057 die i mensis viii annoque mmlvii 57 lvii 2057} test clock-2.2320 {conversion of 2057-08-31} { clock format 2766486896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2057 12:34:56 die xxxi mensis viii annoque mmlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2472607 08 viii 8 08/31/2057 die xxxi mensis viii annoque mmlvii 57 lvii 2057} test clock-2.2321 {conversion of 2057-09-01} { clock format 2766573296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2057 12:34:56 die i mensis ix annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2472608 09 ix 9 09/01/2057 die i mensis ix annoque mmlvii 57 lvii 2057} test clock-2.2322 {conversion of 2057-09-30} { clock format 2769078896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2057 12:34:56 die xxx mensis ix annoque mmlvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2472637 09 ix 9 09/30/2057 die xxx mensis ix annoque mmlvii 57 lvii 2057} test clock-2.2323 {conversion of 2057-10-01} { clock format 2769165296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2057 12:34:56 die i mensis x annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2472638 10 x 10 10/01/2057 die i mensis x annoque mmlvii 57 lvii 2057} test clock-2.2324 {conversion of 2057-10-31} { clock format 2771757296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2057 12:34:56 die xxxi mensis x annoque mmlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2472668 10 x 10 10/31/2057 die xxxi mensis x annoque mmlvii 57 lvii 2057} test clock-2.2325 {conversion of 2057-11-01} { clock format 2771843696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2057 12:34:56 die i mensis xi annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2472669 11 xi 11 11/01/2057 die i mensis xi annoque mmlvii 57 lvii 2057} test clock-2.2326 {conversion of 2057-11-30} { clock format 2774349296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2057 12:34:56 die xxx mensis xi annoque mmlvii xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2472698 11 xi 11 11/30/2057 die xxx mensis xi annoque mmlvii 57 lvii 2057} test clock-2.2327 {conversion of 2057-12-01} { clock format 2774435696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2057 12:34:56 die i mensis xii annoque mmlvii xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2472699 12 xii 12 12/01/2057 die i mensis xii annoque mmlvii 57 lvii 2057} test clock-2.2328 {conversion of 2057-12-31} { clock format 2777027696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2057 12:34:56 die xxxi mensis xii annoque mmlvii xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2472729 12 xii 12 12/31/2057 die xxxi mensis xii annoque mmlvii 57 lvii 2057} test clock-2.2329 {conversion of 2060-01-01} { clock format 2840186096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2060 12:34:56 die i mensis i annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2473460 01 i 1 01/01/2060 die i mensis i annoque mmlx 60 lx 2060} test clock-2.2330 {conversion of 2060-01-31} { clock format 2842778096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2060 12:34:56 die xxxi mensis i annoque mmlx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2473490 01 i 1 01/31/2060 die xxxi mensis i annoque mmlx 60 lx 2060} test clock-2.2331 {conversion of 2060-02-01} { clock format 2842864496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2060 12:34:56 die i mensis ii annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2473491 02 ii 2 02/01/2060 die i mensis ii annoque mmlx 60 lx 2060} test clock-2.2332 {conversion of 2060-02-29} { clock format 2845283696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2060 12:34:56 die xxix mensis ii annoque mmlx xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2473519 02 ii 2 02/29/2060 die xxix mensis ii annoque mmlx 60 lx 2060} test clock-2.2333 {conversion of 2060-03-01} { clock format 2845370096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2060 12:34:56 die i mensis iii annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2473520 03 iii 3 03/01/2060 die i mensis iii annoque mmlx 60 lx 2060} test clock-2.2334 {conversion of 2060-03-31} { clock format 2847962096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2060 12:34:56 die xxxi mensis iii annoque mmlx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2473550 03 iii 3 03/31/2060 die xxxi mensis iii annoque mmlx 60 lx 2060} test clock-2.2335 {conversion of 2060-04-01} { clock format 2848048496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2060 12:34:56 die i mensis iv annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2473551 04 iv 4 04/01/2060 die i mensis iv annoque mmlx 60 lx 2060} test clock-2.2336 {conversion of 2060-04-30} { clock format 2850554096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2060 12:34:56 die xxx mensis iv annoque mmlx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2473580 04 iv 4 04/30/2060 die xxx mensis iv annoque mmlx 60 lx 2060} test clock-2.2337 {conversion of 2060-05-01} { clock format 2850640496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2060 12:34:56 die i mensis v annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2473581 05 v 5 05/01/2060 die i mensis v annoque mmlx 60 lx 2060} test clock-2.2338 {conversion of 2060-05-31} { clock format 2853232496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2060 12:34:56 die xxxi mensis v annoque mmlx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2473611 05 v 5 05/31/2060 die xxxi mensis v annoque mmlx 60 lx 2060} test clock-2.2339 {conversion of 2060-06-01} { clock format 2853318896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2060 12:34:56 die i mensis vi annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2473612 06 vi 6 06/01/2060 die i mensis vi annoque mmlx 60 lx 2060} test clock-2.2340 {conversion of 2060-06-30} { clock format 2855824496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2060 12:34:56 die xxx mensis vi annoque mmlx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2473641 06 vi 6 06/30/2060 die xxx mensis vi annoque mmlx 60 lx 2060} test clock-2.2341 {conversion of 2060-07-01} { clock format 2855910896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2060 12:34:56 die i mensis vii annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2473642 07 vii 7 07/01/2060 die i mensis vii annoque mmlx 60 lx 2060} test clock-2.2342 {conversion of 2060-07-31} { clock format 2858502896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2060 12:34:56 die xxxi mensis vii annoque mmlx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2473672 07 vii 7 07/31/2060 die xxxi mensis vii annoque mmlx 60 lx 2060} test clock-2.2343 {conversion of 2060-08-01} { clock format 2858589296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2060 12:34:56 die i mensis viii annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2473673 08 viii 8 08/01/2060 die i mensis viii annoque mmlx 60 lx 2060} test clock-2.2344 {conversion of 2060-08-31} { clock format 2861181296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2060 12:34:56 die xxxi mensis viii annoque mmlx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2473703 08 viii 8 08/31/2060 die xxxi mensis viii annoque mmlx 60 lx 2060} test clock-2.2345 {conversion of 2060-09-01} { clock format 2861267696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2060 12:34:56 die i mensis ix annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2473704 09 ix 9 09/01/2060 die i mensis ix annoque mmlx 60 lx 2060} test clock-2.2346 {conversion of 2060-09-30} { clock format 2863773296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2060 12:34:56 die xxx mensis ix annoque mmlx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2473733 09 ix 9 09/30/2060 die xxx mensis ix annoque mmlx 60 lx 2060} test clock-2.2347 {conversion of 2060-10-01} { clock format 2863859696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2060 12:34:56 die i mensis x annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2473734 10 x 10 10/01/2060 die i mensis x annoque mmlx 60 lx 2060} test clock-2.2348 {conversion of 2060-10-31} { clock format 2866451696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2060 12:34:56 die xxxi mensis x annoque mmlx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2473764 10 x 10 10/31/2060 die xxxi mensis x annoque mmlx 60 lx 2060} test clock-2.2349 {conversion of 2060-11-01} { clock format 2866538096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2060 12:34:56 die i mensis xi annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2473765 11 xi 11 11/01/2060 die i mensis xi annoque mmlx 60 lx 2060} test clock-2.2350 {conversion of 2060-11-30} { clock format 2869043696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2060 12:34:56 die xxx mensis xi annoque mmlx xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2473794 11 xi 11 11/30/2060 die xxx mensis xi annoque mmlx 60 lx 2060} test clock-2.2351 {conversion of 2060-12-01} { clock format 2869130096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2060 12:34:56 die i mensis xii annoque mmlx xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2473795 12 xii 12 12/01/2060 die i mensis xii annoque mmlx 60 lx 2060} test clock-2.2352 {conversion of 2060-12-31} { clock format 2871722096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2060 12:34:56 die xxxi mensis xii annoque mmlx xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2473825 12 xii 12 12/31/2060 die xxxi mensis xii annoque mmlx 60 lx 2060} test clock-2.2353 {conversion of 2061-01-01} { clock format 2871808496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2061 12:34:56 die i mensis i annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2473826 01 i 1 01/01/2061 die i mensis i annoque mmlxi 61 lxi 2061} test clock-2.2354 {conversion of 2061-01-31} { clock format 2874400496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2061 12:34:56 die xxxi mensis i annoque mmlxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2473856 01 i 1 01/31/2061 die xxxi mensis i annoque mmlxi 61 lxi 2061} test clock-2.2355 {conversion of 2061-02-01} { clock format 2874486896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2061 12:34:56 die i mensis ii annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2473857 02 ii 2 02/01/2061 die i mensis ii annoque mmlxi 61 lxi 2061} test clock-2.2356 {conversion of 2061-02-28} { clock format 2876819696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2061 12:34:56 die xxviii mensis ii annoque mmlxi xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2473884 02 ii 2 02/28/2061 die xxviii mensis ii annoque mmlxi 61 lxi 2061} test clock-2.2357 {conversion of 2061-03-01} { clock format 2876906096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2061 12:34:56 die i mensis iii annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2473885 03 iii 3 03/01/2061 die i mensis iii annoque mmlxi 61 lxi 2061} test clock-2.2358 {conversion of 2061-03-31} { clock format 2879498096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2061 12:34:56 die xxxi mensis iii annoque mmlxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2473915 03 iii 3 03/31/2061 die xxxi mensis iii annoque mmlxi 61 lxi 2061} test clock-2.2359 {conversion of 2061-04-01} { clock format 2879584496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2061 12:34:56 die i mensis iv annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2473916 04 iv 4 04/01/2061 die i mensis iv annoque mmlxi 61 lxi 2061} test clock-2.2360 {conversion of 2061-04-30} { clock format 2882090096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2061 12:34:56 die xxx mensis iv annoque mmlxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2473945 04 iv 4 04/30/2061 die xxx mensis iv annoque mmlxi 61 lxi 2061} test clock-2.2361 {conversion of 2061-05-01} { clock format 2882176496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2061 12:34:56 die i mensis v annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2473946 05 v 5 05/01/2061 die i mensis v annoque mmlxi 61 lxi 2061} test clock-2.2362 {conversion of 2061-05-31} { clock format 2884768496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2061 12:34:56 die xxxi mensis v annoque mmlxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2473976 05 v 5 05/31/2061 die xxxi mensis v annoque mmlxi 61 lxi 2061} test clock-2.2363 {conversion of 2061-06-01} { clock format 2884854896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2061 12:34:56 die i mensis vi annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2473977 06 vi 6 06/01/2061 die i mensis vi annoque mmlxi 61 lxi 2061} test clock-2.2364 {conversion of 2061-06-30} { clock format 2887360496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2061 12:34:56 die xxx mensis vi annoque mmlxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2474006 06 vi 6 06/30/2061 die xxx mensis vi annoque mmlxi 61 lxi 2061} test clock-2.2365 {conversion of 2061-07-01} { clock format 2887446896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2061 12:34:56 die i mensis vii annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2474007 07 vii 7 07/01/2061 die i mensis vii annoque mmlxi 61 lxi 2061} test clock-2.2366 {conversion of 2061-07-31} { clock format 2890038896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2061 12:34:56 die xxxi mensis vii annoque mmlxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2474037 07 vii 7 07/31/2061 die xxxi mensis vii annoque mmlxi 61 lxi 2061} test clock-2.2367 {conversion of 2061-08-01} { clock format 2890125296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2061 12:34:56 die i mensis viii annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2474038 08 viii 8 08/01/2061 die i mensis viii annoque mmlxi 61 lxi 2061} test clock-2.2368 {conversion of 2061-08-31} { clock format 2892717296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2061 12:34:56 die xxxi mensis viii annoque mmlxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2474068 08 viii 8 08/31/2061 die xxxi mensis viii annoque mmlxi 61 lxi 2061} test clock-2.2369 {conversion of 2061-09-01} { clock format 2892803696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2061 12:34:56 die i mensis ix annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2474069 09 ix 9 09/01/2061 die i mensis ix annoque mmlxi 61 lxi 2061} test clock-2.2370 {conversion of 2061-09-30} { clock format 2895309296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2061 12:34:56 die xxx mensis ix annoque mmlxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2474098 09 ix 9 09/30/2061 die xxx mensis ix annoque mmlxi 61 lxi 2061} test clock-2.2371 {conversion of 2061-10-01} { clock format 2895395696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2061 12:34:56 die i mensis x annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2474099 10 x 10 10/01/2061 die i mensis x annoque mmlxi 61 lxi 2061} test clock-2.2372 {conversion of 2061-10-31} { clock format 2897987696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2061 12:34:56 die xxxi mensis x annoque mmlxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2474129 10 x 10 10/31/2061 die xxxi mensis x annoque mmlxi 61 lxi 2061} test clock-2.2373 {conversion of 2061-11-01} { clock format 2898074096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2061 12:34:56 die i mensis xi annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2474130 11 xi 11 11/01/2061 die i mensis xi annoque mmlxi 61 lxi 2061} test clock-2.2374 {conversion of 2061-11-30} { clock format 2900579696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2061 12:34:56 die xxx mensis xi annoque mmlxi xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2474159 11 xi 11 11/30/2061 die xxx mensis xi annoque mmlxi 61 lxi 2061} test clock-2.2375 {conversion of 2061-12-01} { clock format 2900666096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2061 12:34:56 die i mensis xii annoque mmlxi xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2474160 12 xii 12 12/01/2061 die i mensis xii annoque mmlxi 61 lxi 2061} test clock-2.2376 {conversion of 2061-12-31} { clock format 2903258096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2061 12:34:56 die xxxi mensis xii annoque mmlxi xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2474190 12 xii 12 12/31/2061 die xxxi mensis xii annoque mmlxi 61 lxi 2061} test clock-2.2377 {conversion of 2064-01-01} { clock format 2966416496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2064 12:34:56 die i mensis i annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2474921 01 i 1 01/01/2064 die i mensis i annoque mmlxiv 64 lxiv 2064} test clock-2.2378 {conversion of 2064-01-31} { clock format 2969008496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2064 12:34:56 die xxxi mensis i annoque mmlxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2474951 01 i 1 01/31/2064 die xxxi mensis i annoque mmlxiv 64 lxiv 2064} test clock-2.2379 {conversion of 2064-02-01} { clock format 2969094896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2064 12:34:56 die i mensis ii annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2474952 02 ii 2 02/01/2064 die i mensis ii annoque mmlxiv 64 lxiv 2064} test clock-2.2380 {conversion of 2064-02-29} { clock format 2971514096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/29/2064 12:34:56 die xxix mensis ii annoque mmlxiv xii h xxxiv m lvi s 20 mm 29 xxix 29 xxix Feb 060 2474980 02 ii 2 02/29/2064 die xxix mensis ii annoque mmlxiv 64 lxiv 2064} test clock-2.2381 {conversion of 2064-03-01} { clock format 2971600496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2064 12:34:56 die i mensis iii annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 061 2474981 03 iii 3 03/01/2064 die i mensis iii annoque mmlxiv 64 lxiv 2064} test clock-2.2382 {conversion of 2064-03-31} { clock format 2974192496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2064 12:34:56 die xxxi mensis iii annoque mmlxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 091 2475011 03 iii 3 03/31/2064 die xxxi mensis iii annoque mmlxiv 64 lxiv 2064} test clock-2.2383 {conversion of 2064-04-01} { clock format 2974278896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2064 12:34:56 die i mensis iv annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 092 2475012 04 iv 4 04/01/2064 die i mensis iv annoque mmlxiv 64 lxiv 2064} test clock-2.2384 {conversion of 2064-04-30} { clock format 2976784496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2064 12:34:56 die xxx mensis iv annoque mmlxiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 121 2475041 04 iv 4 04/30/2064 die xxx mensis iv annoque mmlxiv 64 lxiv 2064} test clock-2.2385 {conversion of 2064-05-01} { clock format 2976870896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2064 12:34:56 die i mensis v annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i May 122 2475042 05 v 5 05/01/2064 die i mensis v annoque mmlxiv 64 lxiv 2064} test clock-2.2386 {conversion of 2064-05-31} { clock format 2979462896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2064 12:34:56 die xxxi mensis v annoque mmlxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 152 2475072 05 v 5 05/31/2064 die xxxi mensis v annoque mmlxiv 64 lxiv 2064} test clock-2.2387 {conversion of 2064-06-01} { clock format 2979549296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2064 12:34:56 die i mensis vi annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 153 2475073 06 vi 6 06/01/2064 die i mensis vi annoque mmlxiv 64 lxiv 2064} test clock-2.2388 {conversion of 2064-06-30} { clock format 2982054896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2064 12:34:56 die xxx mensis vi annoque mmlxiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 182 2475102 06 vi 6 06/30/2064 die xxx mensis vi annoque mmlxiv 64 lxiv 2064} test clock-2.2389 {conversion of 2064-07-01} { clock format 2982141296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2064 12:34:56 die i mensis vii annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 183 2475103 07 vii 7 07/01/2064 die i mensis vii annoque mmlxiv 64 lxiv 2064} test clock-2.2390 {conversion of 2064-07-31} { clock format 2984733296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2064 12:34:56 die xxxi mensis vii annoque mmlxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 213 2475133 07 vii 7 07/31/2064 die xxxi mensis vii annoque mmlxiv 64 lxiv 2064} test clock-2.2391 {conversion of 2064-08-01} { clock format 2984819696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2064 12:34:56 die i mensis viii annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 214 2475134 08 viii 8 08/01/2064 die i mensis viii annoque mmlxiv 64 lxiv 2064} test clock-2.2392 {conversion of 2064-08-31} { clock format 2987411696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2064 12:34:56 die xxxi mensis viii annoque mmlxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 244 2475164 08 viii 8 08/31/2064 die xxxi mensis viii annoque mmlxiv 64 lxiv 2064} test clock-2.2393 {conversion of 2064-09-01} { clock format 2987498096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2064 12:34:56 die i mensis ix annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 245 2475165 09 ix 9 09/01/2064 die i mensis ix annoque mmlxiv 64 lxiv 2064} test clock-2.2394 {conversion of 2064-09-30} { clock format 2990003696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2064 12:34:56 die xxx mensis ix annoque mmlxiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 274 2475194 09 ix 9 09/30/2064 die xxx mensis ix annoque mmlxiv 64 lxiv 2064} test clock-2.2395 {conversion of 2064-10-01} { clock format 2990090096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2064 12:34:56 die i mensis x annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 275 2475195 10 x 10 10/01/2064 die i mensis x annoque mmlxiv 64 lxiv 2064} test clock-2.2396 {conversion of 2064-10-31} { clock format 2992682096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2064 12:34:56 die xxxi mensis x annoque mmlxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 305 2475225 10 x 10 10/31/2064 die xxxi mensis x annoque mmlxiv 64 lxiv 2064} test clock-2.2397 {conversion of 2064-11-01} { clock format 2992768496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2064 12:34:56 die i mensis xi annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 306 2475226 11 xi 11 11/01/2064 die i mensis xi annoque mmlxiv 64 lxiv 2064} test clock-2.2398 {conversion of 2064-11-30} { clock format 2995274096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2064 12:34:56 die xxx mensis xi annoque mmlxiv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 335 2475255 11 xi 11 11/30/2064 die xxx mensis xi annoque mmlxiv 64 lxiv 2064} test clock-2.2399 {conversion of 2064-12-01} { clock format 2995360496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2064 12:34:56 die i mensis xii annoque mmlxiv xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 336 2475256 12 xii 12 12/01/2064 die i mensis xii annoque mmlxiv 64 lxiv 2064} test clock-2.2400 {conversion of 2064-12-31} { clock format 2997952496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2064 12:34:56 die xxxi mensis xii annoque mmlxiv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 366 2475286 12 xii 12 12/31/2064 die xxxi mensis xii annoque mmlxiv 64 lxiv 2064} test clock-2.2401 {conversion of 2065-01-01} { clock format 2998038896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/01/2065 12:34:56 die i mensis i annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Jan 001 2475287 01 i 1 01/01/2065 die i mensis i annoque mmlxv 65 lxv 2065} test clock-2.2402 {conversion of 2065-01-31} { clock format 3000630896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jan January 01/31/2065 12:34:56 die xxxi mensis i annoque mmlxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jan 031 2475317 01 i 1 01/31/2065 die xxxi mensis i annoque mmlxv 65 lxv 2065} test clock-2.2403 {conversion of 2065-02-01} { clock format 3000717296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/01/2065 12:34:56 die i mensis ii annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Feb 032 2475318 02 ii 2 02/01/2065 die i mensis ii annoque mmlxv 65 lxv 2065} test clock-2.2404 {conversion of 2065-02-28} { clock format 3003050096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Feb February 02/28/2065 12:34:56 die xxviii mensis ii annoque mmlxv xii h xxxiv m lvi s 20 mm 28 xxviii 28 xxviii Feb 059 2475345 02 ii 2 02/28/2065 die xxviii mensis ii annoque mmlxv 65 lxv 2065} test clock-2.2405 {conversion of 2065-03-01} { clock format 3003136496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/01/2065 12:34:56 die i mensis iii annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Mar 060 2475346 03 iii 3 03/01/2065 die i mensis iii annoque mmlxv 65 lxv 2065} test clock-2.2406 {conversion of 2065-03-31} { clock format 3005728496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Mar March 03/31/2065 12:34:56 die xxxi mensis iii annoque mmlxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Mar 090 2475376 03 iii 3 03/31/2065 die xxxi mensis iii annoque mmlxv 65 lxv 2065} test clock-2.2407 {conversion of 2065-04-01} { clock format 3005814896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/01/2065 12:34:56 die i mensis iv annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Apr 091 2475377 04 iv 4 04/01/2065 die i mensis iv annoque mmlxv 65 lxv 2065} test clock-2.2408 {conversion of 2065-04-30} { clock format 3008320496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Apr April 04/30/2065 12:34:56 die xxx mensis iv annoque mmlxv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Apr 120 2475406 04 iv 4 04/30/2065 die xxx mensis iv annoque mmlxv 65 lxv 2065} test clock-2.2409 {conversion of 2065-05-01} { clock format 3008406896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/01/2065 12:34:56 die i mensis v annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i May 121 2475407 05 v 5 05/01/2065 die i mensis v annoque mmlxv 65 lxv 2065} test clock-2.2410 {conversion of 2065-05-31} { clock format 3010998896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {May May 05/31/2065 12:34:56 die xxxi mensis v annoque mmlxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi May 151 2475437 05 v 5 05/31/2065 die xxxi mensis v annoque mmlxv 65 lxv 2065} test clock-2.2411 {conversion of 2065-06-01} { clock format 3011085296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/01/2065 12:34:56 die i mensis vi annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Jun 152 2475438 06 vi 6 06/01/2065 die i mensis vi annoque mmlxv 65 lxv 2065} test clock-2.2412 {conversion of 2065-06-30} { clock format 3013590896 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jun June 06/30/2065 12:34:56 die xxx mensis vi annoque mmlxv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Jun 181 2475467 06 vi 6 06/30/2065 die xxx mensis vi annoque mmlxv 65 lxv 2065} test clock-2.2413 {conversion of 2065-07-01} { clock format 3013677296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/01/2065 12:34:56 die i mensis vii annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Jul 182 2475468 07 vii 7 07/01/2065 die i mensis vii annoque mmlxv 65 lxv 2065} test clock-2.2414 {conversion of 2065-07-31} { clock format 3016269296 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Jul July 07/31/2065 12:34:56 die xxxi mensis vii annoque mmlxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Jul 212 2475498 07 vii 7 07/31/2065 die xxxi mensis vii annoque mmlxv 65 lxv 2065} test clock-2.2415 {conversion of 2065-08-01} { clock format 3016355696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/01/2065 12:34:56 die i mensis viii annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Aug 213 2475499 08 viii 8 08/01/2065 die i mensis viii annoque mmlxv 65 lxv 2065} test clock-2.2416 {conversion of 2065-08-31} { clock format 3018947696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Aug August 08/31/2065 12:34:56 die xxxi mensis viii annoque mmlxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Aug 243 2475529 08 viii 8 08/31/2065 die xxxi mensis viii annoque mmlxv 65 lxv 2065} test clock-2.2417 {conversion of 2065-09-01} { clock format 3019034096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/01/2065 12:34:56 die i mensis ix annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Sep 244 2475530 09 ix 9 09/01/2065 die i mensis ix annoque mmlxv 65 lxv 2065} test clock-2.2418 {conversion of 2065-09-30} { clock format 3021539696 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Sep September 09/30/2065 12:34:56 die xxx mensis ix annoque mmlxv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Sep 273 2475559 09 ix 9 09/30/2065 die xxx mensis ix annoque mmlxv 65 lxv 2065} test clock-2.2419 {conversion of 2065-10-01} { clock format 3021626096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/01/2065 12:34:56 die i mensis x annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Oct 274 2475560 10 x 10 10/01/2065 die i mensis x annoque mmlxv 65 lxv 2065} test clock-2.2420 {conversion of 2065-10-31} { clock format 3024218096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Oct October 10/31/2065 12:34:56 die xxxi mensis x annoque mmlxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Oct 304 2475590 10 x 10 10/31/2065 die xxxi mensis x annoque mmlxv 65 lxv 2065} test clock-2.2421 {conversion of 2065-11-01} { clock format 3024304496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/01/2065 12:34:56 die i mensis xi annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Nov 305 2475591 11 xi 11 11/01/2065 die i mensis xi annoque mmlxv 65 lxv 2065} test clock-2.2422 {conversion of 2065-11-30} { clock format 3026810096 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Nov November 11/30/2065 12:34:56 die xxx mensis xi annoque mmlxv xii h xxxiv m lvi s 20 mm 30 xxx 30 xxx Nov 334 2475620 11 xi 11 11/30/2065 die xxx mensis xi annoque mmlxv 65 lxv 2065} test clock-2.2423 {conversion of 2065-12-01} { clock format 3026896496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/01/2065 12:34:56 die i mensis xii annoque mmlxv xii h xxxiv m lvi s 20 mm 01 i 1 i Dec 335 2475621 12 xii 12 12/01/2065 die i mensis xii annoque mmlxv 65 lxv 2065} test clock-2.2424 {conversion of 2065-12-31} { clock format 3029488496 \ -format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \ -gmt true -locale en_US_roman } {Dec December 12/31/2065 12:34:56 die xxxi mensis xii annoque mmlxv xii h xxxiv m lvi s 20 mm 31 xxxi 31 xxxi Dec 365 2475651 12 xii 12 12/31/2065 die xxxi mensis xii annoque mmlxv 65 lxv 2065} # END testcases2 # BEGIN testcases3 test clock-3.1 {ISO week-based calendar 1871-W52-1} { clock format -3093206400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-1 } {Mon Monday 71 1871 1 52 52 1 52} test clock-3.2 {ISO week-based calendar 1871-W52-6} { clock format -3092774400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-6 } {Sat Saturday 71 1871 6 52 52 6 52} test clock-3.3 {ISO week-based calendar 1871-W52-7} { clock format -3092688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-7 } {Sun Sunday 71 1871 7 53 52 0 52} test clock-3.4 {ISO week-based calendar 1872-W01-1} { clock format -3092601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-1 } {Mon Monday 72 1872 1 00 01 1 01} test clock-3.5 {ISO week-based calendar 1872-W01-6} { clock format -3092169600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-6 } {Sat Saturday 72 1872 6 00 01 6 01} test clock-3.6 {ISO week-based calendar 1872-W01-7} { clock format -3092083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-7 } {Sun Sunday 72 1872 7 01 01 0 01} test clock-3.7 {ISO week-based calendar 1872-W02-1} { clock format -3091996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W02-1 } {Mon Monday 72 1872 1 01 02 1 02} test clock-3.8 {ISO week-based calendar 1872-W52-1} { clock format -3061756800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-1 } {Mon Monday 72 1872 1 51 52 1 52} test clock-3.9 {ISO week-based calendar 1872-W52-6} { clock format -3061324800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-6 } {Sat Saturday 72 1872 6 51 52 6 52} test clock-3.10 {ISO week-based calendar 1872-W52-7} { clock format -3061238400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-7 } {Sun Sunday 72 1872 7 52 52 0 52} test clock-3.11 {ISO week-based calendar 1873-W01-1} { clock format -3061152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-1 } {Mon Monday 73 1873 1 52 01 1 53} test clock-3.12 {ISO week-based calendar 1873-W01-3} { clock format -3060979200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-3 } {Wed Wednesday 73 1873 3 00 01 3 00} test clock-3.13 {ISO week-based calendar 1873-W01-6} { clock format -3060720000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-6 } {Sat Saturday 73 1873 6 00 01 6 00} test clock-3.14 {ISO week-based calendar 1873-W01-7} { clock format -3060633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-7 } {Sun Sunday 73 1873 7 01 01 0 00} test clock-3.15 {ISO week-based calendar 1873-W02-1} { clock format -3060547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W02-1 } {Mon Monday 73 1873 1 01 02 1 01} test clock-3.16 {ISO week-based calendar 1875-W52-1} { clock format -2966803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-1 } {Mon Monday 75 1875 1 52 52 1 52} test clock-3.17 {ISO week-based calendar 1875-W52-6} { clock format -2966371200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-6 } {Sat Saturday 75 1875 6 00 52 6 00} test clock-3.18 {ISO week-based calendar 1875-W52-7} { clock format -2966284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-7 } {Sun Sunday 75 1875 7 01 52 0 00} test clock-3.19 {ISO week-based calendar 1876-W01-1} { clock format -2966198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-1 } {Mon Monday 76 1876 1 01 01 1 01} test clock-3.20 {ISO week-based calendar 1876-W01-6} { clock format -2965766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-6 } {Sat Saturday 76 1876 6 01 01 6 01} test clock-3.21 {ISO week-based calendar 1876-W01-7} { clock format -2965680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-7 } {Sun Sunday 76 1876 7 02 01 0 01} test clock-3.22 {ISO week-based calendar 1876-W02-1} { clock format -2965593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W02-1 } {Mon Monday 76 1876 1 02 02 1 02} test clock-3.23 {ISO week-based calendar 1876-W52-1} { clock format -2935353600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-1 } {Mon Monday 76 1876 1 52 52 1 52} test clock-3.24 {ISO week-based calendar 1876-W52-6} { clock format -2934921600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-6 } {Sat Saturday 76 1876 6 52 52 6 52} test clock-3.25 {ISO week-based calendar 1876-W52-7} { clock format -2934835200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-7 } {Sun Sunday 76 1876 7 53 52 0 52} test clock-3.26 {ISO week-based calendar 1877-W01-1} { clock format -2934748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-1 } {Mon Monday 77 1877 1 00 01 1 01} test clock-3.27 {ISO week-based calendar 1877-W01-6} { clock format -2934316800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-6 } {Sat Saturday 77 1877 6 00 01 6 01} test clock-3.28 {ISO week-based calendar 1877-W01-7} { clock format -2934230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-7 } {Sun Sunday 77 1877 7 01 01 0 01} test clock-3.29 {ISO week-based calendar 1877-W02-1} { clock format -2934144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W02-1 } {Mon Monday 77 1877 1 01 02 1 02} test clock-3.30 {ISO week-based calendar 1879-W52-1} { clock format -2841004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-1 } {Mon Monday 79 1879 1 51 52 1 51} test clock-3.31 {ISO week-based calendar 1879-W52-6} { clock format -2840572800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-6 } {Sat Saturday 79 1879 6 51 52 6 51} test clock-3.32 {ISO week-based calendar 1879-W52-7} { clock format -2840486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-7 } {Sun Sunday 79 1879 7 52 52 0 51} test clock-3.33 {ISO week-based calendar 1880-W01-1} { clock format -2840400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-1 } {Mon Monday 80 1880 1 52 01 1 52} test clock-3.34 {ISO week-based calendar 1880-W01-4} { clock format -2840140800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-4 } {Thu Thursday 80 1880 4 00 01 4 00} test clock-3.35 {ISO week-based calendar 1880-W01-6} { clock format -2839968000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-6 } {Sat Saturday 80 1880 6 00 01 6 00} test clock-3.36 {ISO week-based calendar 1880-W01-7} { clock format -2839881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-7 } {Sun Sunday 80 1880 7 01 01 0 00} test clock-3.37 {ISO week-based calendar 1880-W02-1} { clock format -2839795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W02-1 } {Mon Monday 80 1880 1 01 02 1 01} test clock-3.38 {ISO week-based calendar 1880-W53-1} { clock format -2808950400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-1 } {Mon Monday 80 1880 1 52 53 1 52} test clock-3.39 {ISO week-based calendar 1880-W53-6} { clock format -2808518400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-6 } {Sat Saturday 80 1880 6 00 53 6 00} test clock-3.40 {ISO week-based calendar 1880-W53-7} { clock format -2808432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-7 } {Sun Sunday 80 1880 7 01 53 0 00} test clock-3.41 {ISO week-based calendar 1881-W01-1} { clock format -2808345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-1 } {Mon Monday 81 1881 1 01 01 1 01} test clock-3.42 {ISO week-based calendar 1881-W01-6} { clock format -2807913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-6 } {Sat Saturday 81 1881 6 01 01 6 01} test clock-3.43 {ISO week-based calendar 1881-W01-7} { clock format -2807827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-7 } {Sun Sunday 81 1881 7 02 01 0 01} test clock-3.44 {ISO week-based calendar 1881-W02-1} { clock format -2807740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W02-1 } {Mon Monday 81 1881 1 02 02 1 02} test clock-3.45 {ISO week-based calendar 1883-W52-1} { clock format -2714601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-1 } {Mon Monday 83 1883 1 51 52 1 52} test clock-3.46 {ISO week-based calendar 1883-W52-6} { clock format -2714169600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-6 } {Sat Saturday 83 1883 6 51 52 6 52} test clock-3.47 {ISO week-based calendar 1883-W52-7} { clock format -2714083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-7 } {Sun Sunday 83 1883 7 52 52 0 52} test clock-3.48 {ISO week-based calendar 1884-W01-1} { clock format -2713996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-1 } {Mon Monday 84 1884 1 52 01 1 53} test clock-3.49 {ISO week-based calendar 1884-W01-2} { clock format -2713910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-2 } {Tue Tuesday 84 1884 2 00 01 2 00} test clock-3.50 {ISO week-based calendar 1884-W01-6} { clock format -2713564800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-6 } {Sat Saturday 84 1884 6 00 01 6 00} test clock-3.51 {ISO week-based calendar 1884-W01-7} { clock format -2713478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-7 } {Sun Sunday 84 1884 7 01 01 0 00} test clock-3.52 {ISO week-based calendar 1884-W02-1} { clock format -2713392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W02-1 } {Mon Monday 84 1884 1 01 02 1 01} test clock-3.53 {ISO week-based calendar 1884-W52-1} { clock format -2683152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-1 } {Mon Monday 84 1884 1 51 52 1 51} test clock-3.54 {ISO week-based calendar 1884-W52-6} { clock format -2682720000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-6 } {Sat Saturday 84 1884 6 51 52 6 51} test clock-3.55 {ISO week-based calendar 1884-W52-7} { clock format -2682633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-7 } {Sun Sunday 84 1884 7 52 52 0 51} test clock-3.56 {ISO week-based calendar 1885-W01-1} { clock format -2682547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-1 } {Mon Monday 85 1885 1 52 01 1 52} test clock-3.57 {ISO week-based calendar 1885-W01-4} { clock format -2682288000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-4 } {Thu Thursday 85 1885 4 00 01 4 00} test clock-3.58 {ISO week-based calendar 1885-W01-6} { clock format -2682115200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-6 } {Sat Saturday 85 1885 6 00 01 6 00} test clock-3.59 {ISO week-based calendar 1885-W01-7} { clock format -2682028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-7 } {Sun Sunday 85 1885 7 01 01 0 00} test clock-3.60 {ISO week-based calendar 1885-W02-1} { clock format -2681942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W02-1 } {Mon Monday 85 1885 1 01 02 1 01} test clock-3.61 {ISO week-based calendar 1887-W52-1} { clock format -2588198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-1 } {Mon Monday 87 1887 1 52 52 1 52} test clock-3.62 {ISO week-based calendar 1887-W52-6} { clock format -2587766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-6 } {Sat Saturday 87 1887 6 52 52 6 52} test clock-3.63 {ISO week-based calendar 1887-W52-7} { clock format -2587680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-7 } {Sun Sunday 87 1887 7 01 52 0 00} test clock-3.64 {ISO week-based calendar 1888-W01-1} { clock format -2587593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-1 } {Mon Monday 88 1888 1 01 01 1 01} test clock-3.65 {ISO week-based calendar 1888-W01-6} { clock format -2587161600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-6 } {Sat Saturday 88 1888 6 01 01 6 01} test clock-3.66 {ISO week-based calendar 1888-W01-7} { clock format -2587075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-7 } {Sun Sunday 88 1888 7 02 01 0 01} test clock-3.67 {ISO week-based calendar 1888-W02-1} { clock format -2586988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W02-1 } {Mon Monday 88 1888 1 02 02 1 02} test clock-3.68 {ISO week-based calendar 1888-W52-1} { clock format -2556748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-1 } {Mon Monday 88 1888 1 52 52 1 52} test clock-3.69 {ISO week-based calendar 1888-W52-6} { clock format -2556316800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-6 } {Sat Saturday 88 1888 6 52 52 6 52} test clock-3.70 {ISO week-based calendar 1888-W52-7} { clock format -2556230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-7 } {Sun Sunday 88 1888 7 53 52 0 52} test clock-3.71 {ISO week-based calendar 1889-W01-1} { clock format -2556144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-1 } {Mon Monday 89 1889 1 53 01 1 53} test clock-3.72 {ISO week-based calendar 1889-W01-2} { clock format -2556057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-2 } {Tue Tuesday 89 1889 2 00 01 2 00} test clock-3.73 {ISO week-based calendar 1889-W01-6} { clock format -2555712000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-6 } {Sat Saturday 89 1889 6 00 01 6 00} test clock-3.74 {ISO week-based calendar 1889-W01-7} { clock format -2555625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-7 } {Sun Sunday 89 1889 7 01 01 0 00} test clock-3.75 {ISO week-based calendar 1889-W02-1} { clock format -2555539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W02-1 } {Mon Monday 89 1889 1 01 02 1 01} test clock-3.76 {ISO week-based calendar 1889-W52-1} { clock format -2525299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-1 } {Mon Monday 89 1889 1 51 52 1 51} test clock-3.77 {ISO week-based calendar 1889-W52-6} { clock format -2524867200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-6 } {Sat Saturday 89 1889 6 51 52 6 51} test clock-3.78 {ISO week-based calendar 1889-W52-7} { clock format -2524780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-7 } {Sun Sunday 89 1889 7 52 52 0 51} test clock-3.79 {ISO week-based calendar 1890-W01-1} { clock format -2524694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-1 } {Mon Monday 90 1890 1 52 01 1 52} test clock-3.80 {ISO week-based calendar 1890-W01-3} { clock format -2524521600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-3 } {Wed Wednesday 90 1890 3 00 01 3 00} test clock-3.81 {ISO week-based calendar 1890-W01-6} { clock format -2524262400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-6 } {Sat Saturday 90 1890 6 00 01 6 00} test clock-3.82 {ISO week-based calendar 1890-W01-7} { clock format -2524176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-7 } {Sun Sunday 90 1890 7 01 01 0 00} test clock-3.83 {ISO week-based calendar 1890-W02-1} { clock format -2524089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W02-1 } {Mon Monday 90 1890 1 01 02 1 01} test clock-3.84 {ISO week-based calendar 1890-W52-1} { clock format -2493849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-1 } {Mon Monday 90 1890 1 51 52 1 51} test clock-3.85 {ISO week-based calendar 1890-W52-6} { clock format -2493417600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-6 } {Sat Saturday 90 1890 6 51 52 6 51} test clock-3.86 {ISO week-based calendar 1890-W52-7} { clock format -2493331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-7 } {Sun Sunday 90 1890 7 52 52 0 51} test clock-3.87 {ISO week-based calendar 1891-W01-1} { clock format -2493244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-1 } {Mon Monday 91 1891 1 52 01 1 52} test clock-3.88 {ISO week-based calendar 1891-W01-4} { clock format -2492985600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-4 } {Thu Thursday 91 1891 4 00 01 4 00} test clock-3.89 {ISO week-based calendar 1891-W01-6} { clock format -2492812800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-6 } {Sat Saturday 91 1891 6 00 01 6 00} test clock-3.90 {ISO week-based calendar 1891-W01-7} { clock format -2492726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-7 } {Sun Sunday 91 1891 7 01 01 0 00} test clock-3.91 {ISO week-based calendar 1891-W02-1} { clock format -2492640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W02-1 } {Mon Monday 91 1891 1 01 02 1 01} test clock-3.92 {ISO week-based calendar 1891-W53-1} { clock format -2461795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-1 } {Mon Monday 91 1891 1 52 53 1 52} test clock-3.93 {ISO week-based calendar 1891-W53-5} { clock format -2461449600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-5 } {Fri Friday 91 1891 5 00 53 5 00} test clock-3.94 {ISO week-based calendar 1891-W53-6} { clock format -2461363200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-6 } {Sat Saturday 91 1891 6 00 53 6 00} test clock-3.95 {ISO week-based calendar 1891-W53-7} { clock format -2461276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-7 } {Sun Sunday 91 1891 7 01 53 0 00} test clock-3.96 {ISO week-based calendar 1892-W01-1} { clock format -2461190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-1 } {Mon Monday 92 1892 1 01 01 1 01} test clock-3.97 {ISO week-based calendar 1892-W01-6} { clock format -2460758400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-6 } {Sat Saturday 92 1892 6 01 01 6 01} test clock-3.98 {ISO week-based calendar 1892-W01-7} { clock format -2460672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-7 } {Sun Sunday 92 1892 7 02 01 0 01} test clock-3.99 {ISO week-based calendar 1892-W02-1} { clock format -2460585600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W02-1 } {Mon Monday 92 1892 1 02 02 1 02} test clock-3.100 {ISO week-based calendar 1892-W52-1} { clock format -2430345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-1 } {Mon Monday 92 1892 1 52 52 1 52} test clock-3.101 {ISO week-based calendar 1892-W52-6} { clock format -2429913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-6 } {Sat Saturday 92 1892 6 52 52 6 52} test clock-3.102 {ISO week-based calendar 1892-W52-7} { clock format -2429827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-7 } {Sun Sunday 92 1892 7 01 52 0 00} test clock-3.103 {ISO week-based calendar 1893-W01-1} { clock format -2429740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-1 } {Mon Monday 93 1893 1 01 01 1 01} test clock-3.104 {ISO week-based calendar 1893-W01-6} { clock format -2429308800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-6 } {Sat Saturday 93 1893 6 01 01 6 01} test clock-3.105 {ISO week-based calendar 1893-W01-7} { clock format -2429222400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-7 } {Sun Sunday 93 1893 7 02 01 0 01} test clock-3.106 {ISO week-based calendar 1893-W02-1} { clock format -2429136000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W02-1 } {Mon Monday 93 1893 1 02 02 1 02} test clock-3.107 {ISO week-based calendar 1893-W52-1} { clock format -2398896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-1 } {Mon Monday 93 1893 1 52 52 1 52} test clock-3.108 {ISO week-based calendar 1893-W52-6} { clock format -2398464000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-6 } {Sat Saturday 93 1893 6 52 52 6 52} test clock-3.109 {ISO week-based calendar 1893-W52-7} { clock format -2398377600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-7 } {Sun Sunday 93 1893 7 53 52 0 52} test clock-3.110 {ISO week-based calendar 1894-W01-1} { clock format -2398291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-1 } {Mon Monday 94 1894 1 00 01 1 01} test clock-3.111 {ISO week-based calendar 1894-W01-6} { clock format -2397859200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-6 } {Sat Saturday 94 1894 6 00 01 6 01} test clock-3.112 {ISO week-based calendar 1894-W01-7} { clock format -2397772800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-7 } {Sun Sunday 94 1894 7 01 01 0 01} test clock-3.113 {ISO week-based calendar 1894-W02-1} { clock format -2397686400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W02-1 } {Mon Monday 94 1894 1 01 02 1 02} test clock-3.114 {ISO week-based calendar 1894-W52-1} { clock format -2367446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-1 } {Mon Monday 94 1894 1 51 52 1 52} test clock-3.115 {ISO week-based calendar 1894-W52-6} { clock format -2367014400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-6 } {Sat Saturday 94 1894 6 51 52 6 52} test clock-3.116 {ISO week-based calendar 1894-W52-7} { clock format -2366928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-7 } {Sun Sunday 94 1894 7 52 52 0 52} test clock-3.117 {ISO week-based calendar 1895-W01-1} { clock format -2366841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-1 } {Mon Monday 95 1895 1 52 01 1 53} test clock-3.118 {ISO week-based calendar 1895-W01-2} { clock format -2366755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-2 } {Tue Tuesday 95 1895 2 00 01 2 00} test clock-3.119 {ISO week-based calendar 1895-W01-6} { clock format -2366409600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-6 } {Sat Saturday 95 1895 6 00 01 6 00} test clock-3.120 {ISO week-based calendar 1895-W01-7} { clock format -2366323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-7 } {Sun Sunday 95 1895 7 01 01 0 00} test clock-3.121 {ISO week-based calendar 1895-W02-1} { clock format -2366236800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W02-1 } {Mon Monday 95 1895 1 01 02 1 01} test clock-3.122 {ISO week-based calendar 1895-W52-1} { clock format -2335996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-1 } {Mon Monday 95 1895 1 51 52 1 51} test clock-3.123 {ISO week-based calendar 1895-W52-6} { clock format -2335564800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-6 } {Sat Saturday 95 1895 6 51 52 6 51} test clock-3.124 {ISO week-based calendar 1895-W52-7} { clock format -2335478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-7 } {Sun Sunday 95 1895 7 52 52 0 51} test clock-3.125 {ISO week-based calendar 1896-W01-1} { clock format -2335392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-1 } {Mon Monday 96 1896 1 52 01 1 52} test clock-3.126 {ISO week-based calendar 1896-W01-3} { clock format -2335219200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-3 } {Wed Wednesday 96 1896 3 00 01 3 00} test clock-3.127 {ISO week-based calendar 1896-W01-6} { clock format -2334960000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-6 } {Sat Saturday 96 1896 6 00 01 6 00} test clock-3.128 {ISO week-based calendar 1896-W01-7} { clock format -2334873600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-7 } {Sun Sunday 96 1896 7 01 01 0 00} test clock-3.129 {ISO week-based calendar 1896-W02-1} { clock format -2334787200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W02-1 } {Mon Monday 96 1896 1 01 02 1 01} test clock-3.130 {ISO week-based calendar 1896-W53-1} { clock format -2303942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-1 } {Mon Monday 96 1896 1 52 53 1 52} test clock-3.131 {ISO week-based calendar 1896-W53-5} { clock format -2303596800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-5 } {Fri Friday 96 1896 5 00 53 5 00} test clock-3.132 {ISO week-based calendar 1896-W53-6} { clock format -2303510400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-6 } {Sat Saturday 96 1896 6 00 53 6 00} test clock-3.133 {ISO week-based calendar 1896-W53-7} { clock format -2303424000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-7 } {Sun Sunday 96 1896 7 01 53 0 00} test clock-3.134 {ISO week-based calendar 1897-W01-1} { clock format -2303337600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-1 } {Mon Monday 97 1897 1 01 01 1 01} test clock-3.135 {ISO week-based calendar 1897-W01-6} { clock format -2302905600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-6 } {Sat Saturday 97 1897 6 01 01 6 01} test clock-3.136 {ISO week-based calendar 1897-W01-7} { clock format -2302819200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-7 } {Sun Sunday 97 1897 7 02 01 0 01} test clock-3.137 {ISO week-based calendar 1897-W02-1} { clock format -2302732800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W02-1 } {Mon Monday 97 1897 1 02 02 1 02} test clock-3.138 {ISO week-based calendar 1897-W52-1} { clock format -2272492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-1 } {Mon Monday 97 1897 1 52 52 1 52} test clock-3.139 {ISO week-based calendar 1897-W52-6} { clock format -2272060800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-6 } {Sat Saturday 97 1897 6 00 52 6 00} test clock-3.140 {ISO week-based calendar 1897-W52-7} { clock format -2271974400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-7 } {Sun Sunday 97 1897 7 01 52 0 00} test clock-3.141 {ISO week-based calendar 1898-W01-1} { clock format -2271888000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-1 } {Mon Monday 98 1898 1 01 01 1 01} test clock-3.142 {ISO week-based calendar 1898-W01-6} { clock format -2271456000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-6 } {Sat Saturday 98 1898 6 01 01 6 01} test clock-3.143 {ISO week-based calendar 1898-W01-7} { clock format -2271369600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-7 } {Sun Sunday 98 1898 7 02 01 0 01} test clock-3.144 {ISO week-based calendar 1898-W02-1} { clock format -2271283200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W02-1 } {Mon Monday 98 1898 1 02 02 1 02} test clock-3.145 {ISO week-based calendar 1898-W52-1} { clock format -2241043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-1 } {Mon Monday 98 1898 1 52 52 1 52} test clock-3.146 {ISO week-based calendar 1898-W52-6} { clock format -2240611200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-6 } {Sat Saturday 98 1898 6 52 52 6 52} test clock-3.147 {ISO week-based calendar 1898-W52-7} { clock format -2240524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-7 } {Sun Sunday 98 1898 7 01 52 0 00} test clock-3.148 {ISO week-based calendar 1899-W01-1} { clock format -2240438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-1 } {Mon Monday 99 1899 1 01 01 1 01} test clock-3.149 {ISO week-based calendar 1899-W01-6} { clock format -2240006400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-6 } {Sat Saturday 99 1899 6 01 01 6 01} test clock-3.150 {ISO week-based calendar 1899-W01-7} { clock format -2239920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-7 } {Sun Sunday 99 1899 7 02 01 0 01} test clock-3.151 {ISO week-based calendar 1899-W02-1} { clock format -2239833600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W02-1 } {Mon Monday 99 1899 1 02 02 1 02} test clock-3.152 {ISO week-based calendar 1899-W52-1} { clock format -2209593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-1 } {Mon Monday 99 1899 1 52 52 1 52} test clock-3.153 {ISO week-based calendar 1899-W52-6} { clock format -2209161600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-6 } {Sat Saturday 99 1899 6 52 52 6 52} test clock-3.154 {ISO week-based calendar 1899-W52-7} { clock format -2209075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-7 } {Sun Sunday 99 1899 7 53 52 0 52} test clock-3.155 {ISO week-based calendar 1900-W01-1} { clock format -2208988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-1 } {Mon Monday 00 1900 1 00 01 1 01} test clock-3.156 {ISO week-based calendar 1900-W01-6} { clock format -2208556800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-6 } {Sat Saturday 00 1900 6 00 01 6 01} test clock-3.157 {ISO week-based calendar 1900-W01-7} { clock format -2208470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-7 } {Sun Sunday 00 1900 7 01 01 0 01} test clock-3.158 {ISO week-based calendar 1900-W02-1} { clock format -2208384000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W02-1 } {Mon Monday 00 1900 1 01 02 1 02} test clock-3.159 {ISO week-based calendar 1943-W52-1} { clock format -820972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-1 } {Mon Monday 43 1943 1 52 52 1 52} test clock-3.160 {ISO week-based calendar 1943-W52-6} { clock format -820540800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-6 } {Sat Saturday 43 1943 6 00 52 6 00} test clock-3.161 {ISO week-based calendar 1943-W52-7} { clock format -820454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-7 } {Sun Sunday 43 1943 7 01 52 0 00} test clock-3.162 {ISO week-based calendar 1944-W01-1} { clock format -820368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-1 } {Mon Monday 44 1944 1 01 01 1 01} test clock-3.163 {ISO week-based calendar 1944-W01-6} { clock format -819936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-6 } {Sat Saturday 44 1944 6 01 01 6 01} test clock-3.164 {ISO week-based calendar 1944-W01-7} { clock format -819849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-7 } {Sun Sunday 44 1944 7 02 01 0 01} test clock-3.165 {ISO week-based calendar 1944-W02-1} { clock format -819763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W02-1 } {Mon Monday 44 1944 1 02 02 1 02} test clock-3.166 {ISO week-based calendar 1944-W52-1} { clock format -789523200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-1 } {Mon Monday 44 1944 1 52 52 1 52} test clock-3.167 {ISO week-based calendar 1944-W52-6} { clock format -789091200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-6 } {Sat Saturday 44 1944 6 52 52 6 52} test clock-3.168 {ISO week-based calendar 1944-W52-7} { clock format -789004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-7 } {Sun Sunday 44 1944 7 53 52 0 52} test clock-3.169 {ISO week-based calendar 1945-W01-1} { clock format -788918400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-1 } {Mon Monday 45 1945 1 00 01 1 01} test clock-3.170 {ISO week-based calendar 1945-W01-6} { clock format -788486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-6 } {Sat Saturday 45 1945 6 00 01 6 01} test clock-3.171 {ISO week-based calendar 1945-W01-7} { clock format -788400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-7 } {Sun Sunday 45 1945 7 01 01 0 01} test clock-3.172 {ISO week-based calendar 1945-W02-1} { clock format -788313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W02-1 } {Mon Monday 45 1945 1 01 02 1 02} test clock-3.173 {ISO week-based calendar 1947-W52-1} { clock format -695174400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-1 } {Mon Monday 47 1947 1 51 52 1 51} test clock-3.174 {ISO week-based calendar 1947-W52-6} { clock format -694742400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-6 } {Sat Saturday 47 1947 6 51 52 6 51} test clock-3.175 {ISO week-based calendar 1947-W52-7} { clock format -694656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-7 } {Sun Sunday 47 1947 7 52 52 0 51} test clock-3.176 {ISO week-based calendar 1948-W01-1} { clock format -694569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-1 } {Mon Monday 48 1948 1 52 01 1 52} test clock-3.177 {ISO week-based calendar 1948-W01-4} { clock format -694310400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-4 } {Thu Thursday 48 1948 4 00 01 4 00} test clock-3.178 {ISO week-based calendar 1948-W01-6} { clock format -694137600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-6 } {Sat Saturday 48 1948 6 00 01 6 00} test clock-3.179 {ISO week-based calendar 1948-W01-7} { clock format -694051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-7 } {Sun Sunday 48 1948 7 01 01 0 00} test clock-3.180 {ISO week-based calendar 1948-W02-1} { clock format -693964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W02-1 } {Mon Monday 48 1948 1 01 02 1 01} test clock-3.181 {ISO week-based calendar 1948-W53-1} { clock format -663120000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-1 } {Mon Monday 48 1948 1 52 53 1 52} test clock-3.182 {ISO week-based calendar 1948-W53-6} { clock format -662688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-6 } {Sat Saturday 48 1948 6 00 53 6 00} test clock-3.183 {ISO week-based calendar 1948-W53-7} { clock format -662601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-7 } {Sun Sunday 48 1948 7 01 53 0 00} test clock-3.184 {ISO week-based calendar 1949-W01-1} { clock format -662515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-1 } {Mon Monday 49 1949 1 01 01 1 01} test clock-3.185 {ISO week-based calendar 1949-W01-6} { clock format -662083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-6 } {Sat Saturday 49 1949 6 01 01 6 01} test clock-3.186 {ISO week-based calendar 1949-W01-7} { clock format -661996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-7 } {Sun Sunday 49 1949 7 02 01 0 01} test clock-3.187 {ISO week-based calendar 1949-W02-1} { clock format -661910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W02-1 } {Mon Monday 49 1949 1 02 02 1 02} test clock-3.188 {ISO week-based calendar 1951-W52-1} { clock format -568771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-1 } {Mon Monday 51 1951 1 51 52 1 52} test clock-3.189 {ISO week-based calendar 1951-W52-6} { clock format -568339200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-6 } {Sat Saturday 51 1951 6 51 52 6 52} test clock-3.190 {ISO week-based calendar 1951-W52-7} { clock format -568252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-7 } {Sun Sunday 51 1951 7 52 52 0 52} test clock-3.191 {ISO week-based calendar 1952-W01-1} { clock format -568166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-1 } {Mon Monday 52 1952 1 52 01 1 53} test clock-3.192 {ISO week-based calendar 1952-W01-2} { clock format -568080000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-2 } {Tue Tuesday 52 1952 2 00 01 2 00} test clock-3.193 {ISO week-based calendar 1952-W01-6} { clock format -567734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-6 } {Sat Saturday 52 1952 6 00 01 6 00} test clock-3.194 {ISO week-based calendar 1952-W01-7} { clock format -567648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-7 } {Sun Sunday 52 1952 7 01 01 0 00} test clock-3.195 {ISO week-based calendar 1952-W02-1} { clock format -567561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W02-1 } {Mon Monday 52 1952 1 01 02 1 01} test clock-3.196 {ISO week-based calendar 1952-W52-1} { clock format -537321600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-1 } {Mon Monday 52 1952 1 51 52 1 51} test clock-3.197 {ISO week-based calendar 1952-W52-6} { clock format -536889600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-6 } {Sat Saturday 52 1952 6 51 52 6 51} test clock-3.198 {ISO week-based calendar 1952-W52-7} { clock format -536803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-7 } {Sun Sunday 52 1952 7 52 52 0 51} test clock-3.199 {ISO week-based calendar 1953-W01-1} { clock format -536716800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-1 } {Mon Monday 53 1953 1 52 01 1 52} test clock-3.200 {ISO week-based calendar 1953-W01-4} { clock format -536457600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-4 } {Thu Thursday 53 1953 4 00 01 4 00} test clock-3.201 {ISO week-based calendar 1953-W01-6} { clock format -536284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-6 } {Sat Saturday 53 1953 6 00 01 6 00} test clock-3.202 {ISO week-based calendar 1953-W01-7} { clock format -536198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-7 } {Sun Sunday 53 1953 7 01 01 0 00} test clock-3.203 {ISO week-based calendar 1953-W02-1} { clock format -536112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W02-1 } {Mon Monday 53 1953 1 01 02 1 01} test clock-3.204 {ISO week-based calendar 1955-W52-1} { clock format -442368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-1 } {Mon Monday 55 1955 1 52 52 1 52} test clock-3.205 {ISO week-based calendar 1955-W52-6} { clock format -441936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-6 } {Sat Saturday 55 1955 6 52 52 6 52} test clock-3.206 {ISO week-based calendar 1955-W52-7} { clock format -441849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-7 } {Sun Sunday 55 1955 7 01 52 0 00} test clock-3.207 {ISO week-based calendar 1956-W01-1} { clock format -441763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-1 } {Mon Monday 56 1956 1 01 01 1 01} test clock-3.208 {ISO week-based calendar 1956-W01-6} { clock format -441331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-6 } {Sat Saturday 56 1956 6 01 01 6 01} test clock-3.209 {ISO week-based calendar 1956-W01-7} { clock format -441244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-7 } {Sun Sunday 56 1956 7 02 01 0 01} test clock-3.210 {ISO week-based calendar 1956-W02-1} { clock format -441158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W02-1 } {Mon Monday 56 1956 1 02 02 1 02} test clock-3.211 {ISO week-based calendar 1956-W52-1} { clock format -410918400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-1 } {Mon Monday 56 1956 1 52 52 1 52} test clock-3.212 {ISO week-based calendar 1956-W52-6} { clock format -410486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-6 } {Sat Saturday 56 1956 6 52 52 6 52} test clock-3.213 {ISO week-based calendar 1956-W52-7} { clock format -410400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-7 } {Sun Sunday 56 1956 7 53 52 0 52} test clock-3.214 {ISO week-based calendar 1957-W01-1} { clock format -410313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-1 } {Mon Monday 57 1957 1 53 01 1 53} test clock-3.215 {ISO week-based calendar 1957-W01-2} { clock format -410227200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-2 } {Tue Tuesday 57 1957 2 00 01 2 00} test clock-3.216 {ISO week-based calendar 1957-W01-6} { clock format -409881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-6 } {Sat Saturday 57 1957 6 00 01 6 00} test clock-3.217 {ISO week-based calendar 1957-W01-7} { clock format -409795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-7 } {Sun Sunday 57 1957 7 01 01 0 00} test clock-3.218 {ISO week-based calendar 1957-W02-1} { clock format -409708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W02-1 } {Mon Monday 57 1957 1 01 02 1 01} test clock-3.219 {ISO week-based calendar 1958-W52-1} { clock format -348019200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-1 } {Mon Monday 58 1958 1 51 52 1 51} test clock-3.220 {ISO week-based calendar 1958-W52-6} { clock format -347587200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-6 } {Sat Saturday 58 1958 6 51 52 6 51} test clock-3.221 {ISO week-based calendar 1958-W52-7} { clock format -347500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-7 } {Sun Sunday 58 1958 7 52 52 0 51} test clock-3.222 {ISO week-based calendar 1959-W01-1} { clock format -347414400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-1 } {Mon Monday 59 1959 1 52 01 1 52} test clock-3.223 {ISO week-based calendar 1959-W01-4} { clock format -347155200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-4 } {Thu Thursday 59 1959 4 00 01 4 00} test clock-3.224 {ISO week-based calendar 1959-W01-6} { clock format -346982400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-6 } {Sat Saturday 59 1959 6 00 01 6 00} test clock-3.225 {ISO week-based calendar 1959-W01-7} { clock format -346896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-7 } {Sun Sunday 59 1959 7 01 01 0 00} test clock-3.226 {ISO week-based calendar 1959-W02-1} { clock format -346809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W02-1 } {Mon Monday 59 1959 1 01 02 1 01} test clock-3.227 {ISO week-based calendar 1959-W53-1} { clock format -315964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-1 } {Mon Monday 59 1959 1 52 53 1 52} test clock-3.228 {ISO week-based calendar 1959-W53-5} { clock format -315619200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-5 } {Fri Friday 59 1959 5 00 53 5 00} test clock-3.229 {ISO week-based calendar 1959-W53-6} { clock format -315532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-6 } {Sat Saturday 59 1959 6 00 53 6 00} test clock-3.230 {ISO week-based calendar 1959-W53-7} { clock format -315446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-7 } {Sun Sunday 59 1959 7 01 53 0 00} test clock-3.231 {ISO week-based calendar 1960-W01-1} { clock format -315360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-1 } {Mon Monday 60 1960 1 01 01 1 01} test clock-3.232 {ISO week-based calendar 1960-W01-6} { clock format -314928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-6 } {Sat Saturday 60 1960 6 01 01 6 01} test clock-3.233 {ISO week-based calendar 1960-W01-7} { clock format -314841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-7 } {Sun Sunday 60 1960 7 02 01 0 01} test clock-3.234 {ISO week-based calendar 1960-W02-1} { clock format -314755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W02-1 } {Mon Monday 60 1960 1 02 02 1 02} test clock-3.235 {ISO week-based calendar 1960-W52-1} { clock format -284515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-1 } {Mon Monday 60 1960 1 52 52 1 52} test clock-3.236 {ISO week-based calendar 1960-W52-6} { clock format -284083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-6 } {Sat Saturday 60 1960 6 52 52 6 52} test clock-3.237 {ISO week-based calendar 1960-W52-7} { clock format -283996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-7 } {Sun Sunday 60 1960 7 01 52 0 00} test clock-3.238 {ISO week-based calendar 1961-W01-1} { clock format -283910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-1 } {Mon Monday 61 1961 1 01 01 1 01} test clock-3.239 {ISO week-based calendar 1961-W01-6} { clock format -283478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-6 } {Sat Saturday 61 1961 6 01 01 6 01} test clock-3.240 {ISO week-based calendar 1961-W01-7} { clock format -283392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-7 } {Sun Sunday 61 1961 7 02 01 0 01} test clock-3.241 {ISO week-based calendar 1961-W02-1} { clock format -283305600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W02-1 } {Mon Monday 61 1961 1 02 02 1 02} test clock-3.242 {ISO week-based calendar 1961-W52-1} { clock format -253065600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-1 } {Mon Monday 61 1961 1 52 52 1 52} test clock-3.243 {ISO week-based calendar 1961-W52-6} { clock format -252633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-6 } {Sat Saturday 61 1961 6 52 52 6 52} test clock-3.244 {ISO week-based calendar 1961-W52-7} { clock format -252547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-7 } {Sun Sunday 61 1961 7 53 52 0 52} test clock-3.245 {ISO week-based calendar 1962-W01-1} { clock format -252460800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-1 } {Mon Monday 62 1962 1 00 01 1 01} test clock-3.246 {ISO week-based calendar 1962-W01-6} { clock format -252028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-6 } {Sat Saturday 62 1962 6 00 01 6 01} test clock-3.247 {ISO week-based calendar 1962-W01-7} { clock format -251942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-7 } {Sun Sunday 62 1962 7 01 01 0 01} test clock-3.248 {ISO week-based calendar 1962-W02-1} { clock format -251856000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W02-1 } {Mon Monday 62 1962 1 01 02 1 02} test clock-3.249 {ISO week-based calendar 1962-W52-1} { clock format -221616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-1 } {Mon Monday 62 1962 1 51 52 1 52} test clock-3.250 {ISO week-based calendar 1962-W52-6} { clock format -221184000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-6 } {Sat Saturday 62 1962 6 51 52 6 52} test clock-3.251 {ISO week-based calendar 1962-W52-7} { clock format -221097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-7 } {Sun Sunday 62 1962 7 52 52 0 52} test clock-3.252 {ISO week-based calendar 1963-W01-1} { clock format -221011200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-1 } {Mon Monday 63 1963 1 52 01 1 53} test clock-3.253 {ISO week-based calendar 1963-W01-2} { clock format -220924800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-2 } {Tue Tuesday 63 1963 2 00 01 2 00} test clock-3.254 {ISO week-based calendar 1963-W01-6} { clock format -220579200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-6 } {Sat Saturday 63 1963 6 00 01 6 00} test clock-3.255 {ISO week-based calendar 1963-W01-7} { clock format -220492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-7 } {Sun Sunday 63 1963 7 01 01 0 00} test clock-3.256 {ISO week-based calendar 1963-W02-1} { clock format -220406400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W02-1 } {Mon Monday 63 1963 1 01 02 1 01} test clock-3.257 {ISO week-based calendar 1963-W52-1} { clock format -190166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-1 } {Mon Monday 63 1963 1 51 52 1 51} test clock-3.258 {ISO week-based calendar 1963-W52-6} { clock format -189734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-6 } {Sat Saturday 63 1963 6 51 52 6 51} test clock-3.259 {ISO week-based calendar 1963-W52-7} { clock format -189648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-7 } {Sun Sunday 63 1963 7 52 52 0 51} test clock-3.260 {ISO week-based calendar 1964-W01-1} { clock format -189561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-1 } {Mon Monday 64 1964 1 52 01 1 52} test clock-3.261 {ISO week-based calendar 1964-W01-3} { clock format -189388800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-3 } {Wed Wednesday 64 1964 3 00 01 3 00} test clock-3.262 {ISO week-based calendar 1964-W01-6} { clock format -189129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-6 } {Sat Saturday 64 1964 6 00 01 6 00} test clock-3.263 {ISO week-based calendar 1964-W01-7} { clock format -189043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-7 } {Sun Sunday 64 1964 7 01 01 0 00} test clock-3.264 {ISO week-based calendar 1964-W02-1} { clock format -188956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W02-1 } {Mon Monday 64 1964 1 01 02 1 01} test clock-3.265 {ISO week-based calendar 1964-W53-1} { clock format -158112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-1 } {Mon Monday 64 1964 1 52 53 1 52} test clock-3.266 {ISO week-based calendar 1964-W53-5} { clock format -157766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-5 } {Fri Friday 64 1964 5 00 53 5 00} test clock-3.267 {ISO week-based calendar 1964-W53-6} { clock format -157680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-6 } {Sat Saturday 64 1964 6 00 53 6 00} test clock-3.268 {ISO week-based calendar 1964-W53-7} { clock format -157593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-7 } {Sun Sunday 64 1964 7 01 53 0 00} test clock-3.269 {ISO week-based calendar 1965-W01-1} { clock format -157507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-1 } {Mon Monday 65 1965 1 01 01 1 01} test clock-3.270 {ISO week-based calendar 1965-W01-6} { clock format -157075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-6 } {Sat Saturday 65 1965 6 01 01 6 01} test clock-3.271 {ISO week-based calendar 1965-W01-7} { clock format -156988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-7 } {Sun Sunday 65 1965 7 02 01 0 01} test clock-3.272 {ISO week-based calendar 1965-W02-1} { clock format -156902400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W02-1 } {Mon Monday 65 1965 1 02 02 1 02} test clock-3.273 {ISO week-based calendar 1965-W52-1} { clock format -126662400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-1 } {Mon Monday 65 1965 1 52 52 1 52} test clock-3.274 {ISO week-based calendar 1965-W52-6} { clock format -126230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-6 } {Sat Saturday 65 1965 6 00 52 6 00} test clock-3.275 {ISO week-based calendar 1965-W52-7} { clock format -126144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-7 } {Sun Sunday 65 1965 7 01 52 0 00} test clock-3.276 {ISO week-based calendar 1966-W01-1} { clock format -126057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-1 } {Mon Monday 66 1966 1 01 01 1 01} test clock-3.277 {ISO week-based calendar 1966-W01-6} { clock format -125625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-6 } {Sat Saturday 66 1966 6 01 01 6 01} test clock-3.278 {ISO week-based calendar 1966-W01-7} { clock format -125539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-7 } {Sun Sunday 66 1966 7 02 01 0 01} test clock-3.279 {ISO week-based calendar 1966-W02-1} { clock format -125452800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W02-1 } {Mon Monday 66 1966 1 02 02 1 02} test clock-3.280 {ISO week-based calendar 1966-W52-1} { clock format -95212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-1 } {Mon Monday 66 1966 1 52 52 1 52} test clock-3.281 {ISO week-based calendar 1966-W52-6} { clock format -94780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-6 } {Sat Saturday 66 1966 6 52 52 6 52} test clock-3.282 {ISO week-based calendar 1966-W52-7} { clock format -94694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-7 } {Sun Sunday 66 1966 7 01 52 0 00} test clock-3.283 {ISO week-based calendar 1967-W01-1} { clock format -94608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-1 } {Mon Monday 67 1967 1 01 01 1 01} test clock-3.284 {ISO week-based calendar 1967-W01-6} { clock format -94176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-6 } {Sat Saturday 67 1967 6 01 01 6 01} test clock-3.285 {ISO week-based calendar 1967-W01-7} { clock format -94089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-7 } {Sun Sunday 67 1967 7 02 01 0 01} test clock-3.286 {ISO week-based calendar 1967-W02-1} { clock format -94003200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W02-1 } {Mon Monday 67 1967 1 02 02 1 02} test clock-3.287 {ISO week-based calendar 1967-W52-1} { clock format -63763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-1 } {Mon Monday 67 1967 1 52 52 1 52} test clock-3.288 {ISO week-based calendar 1967-W52-6} { clock format -63331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-6 } {Sat Saturday 67 1967 6 52 52 6 52} test clock-3.289 {ISO week-based calendar 1967-W52-7} { clock format -63244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-7 } {Sun Sunday 67 1967 7 53 52 0 52} test clock-3.290 {ISO week-based calendar 1968-W01-1} { clock format -63158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-1 } {Mon Monday 68 1968 1 00 01 1 01} test clock-3.291 {ISO week-based calendar 1968-W01-6} { clock format -62726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-6 } {Sat Saturday 68 1968 6 00 01 6 01} test clock-3.292 {ISO week-based calendar 1968-W01-7} { clock format -62640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-7 } {Sun Sunday 68 1968 7 01 01 0 01} test clock-3.293 {ISO week-based calendar 1968-W02-1} { clock format -62553600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W02-1 } {Mon Monday 68 1968 1 01 02 1 02} test clock-3.294 {ISO week-based calendar 1968-W52-1} { clock format -32313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-1 } {Mon Monday 68 1968 1 51 52 1 52} test clock-3.295 {ISO week-based calendar 1968-W52-6} { clock format -31881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-6 } {Sat Saturday 68 1968 6 51 52 6 52} test clock-3.296 {ISO week-based calendar 1968-W52-7} { clock format -31795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-7 } {Sun Sunday 68 1968 7 52 52 0 52} test clock-3.297 {ISO week-based calendar 1969-W01-1} { clock format -31708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-1 } {Mon Monday 69 1969 1 52 01 1 53} test clock-3.298 {ISO week-based calendar 1969-W01-3} { clock format -31536000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-3 } {Wed Wednesday 69 1969 3 00 01 3 00} test clock-3.299 {ISO week-based calendar 1969-W01-6} { clock format -31276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-6 } {Sat Saturday 69 1969 6 00 01 6 00} test clock-3.300 {ISO week-based calendar 1969-W01-7} { clock format -31190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-7 } {Sun Sunday 69 1969 7 01 01 0 00} test clock-3.301 {ISO week-based calendar 1969-W02-1} { clock format -31104000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W02-1 } {Mon Monday 69 1969 1 01 02 1 01} test clock-3.302 {ISO week-based calendar 1969-W52-1} { clock format -864000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-1 } {Mon Monday 69 1969 1 51 52 1 51} test clock-3.303 {ISO week-based calendar 1969-W52-6} { clock format -432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-6 } {Sat Saturday 69 1969 6 51 52 6 51} test clock-3.304 {ISO week-based calendar 1969-W52-7} { clock format -345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-7 } {Sun Sunday 69 1969 7 52 52 0 51} test clock-3.305 {ISO week-based calendar 1970-W01-1} { clock format -259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-1 } {Mon Monday 70 1970 1 52 01 1 52} test clock-3.306 {ISO week-based calendar 1970-W01-4} { clock format 0 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-4 } {Thu Thursday 70 1970 4 00 01 4 00} test clock-3.307 {ISO week-based calendar 1970-W01-6} { clock format 172800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-6 } {Sat Saturday 70 1970 6 00 01 6 00} test clock-3.308 {ISO week-based calendar 1970-W01-7} { clock format 259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-7 } {Sun Sunday 70 1970 7 01 01 0 00} test clock-3.309 {ISO week-based calendar 1970-W02-1} { clock format 345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W02-1 } {Mon Monday 70 1970 1 01 02 1 01} test clock-3.310 {ISO week-based calendar 1970-W53-1} { clock format 31190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-1 } {Mon Monday 70 1970 1 52 53 1 52} test clock-3.311 {ISO week-based calendar 1970-W53-5} { clock format 31536000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-5 } {Fri Friday 70 1970 5 00 53 5 00} test clock-3.312 {ISO week-based calendar 1970-W53-6} { clock format 31622400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-6 } {Sat Saturday 70 1970 6 00 53 6 00} test clock-3.313 {ISO week-based calendar 1970-W53-7} { clock format 31708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-7 } {Sun Sunday 70 1970 7 01 53 0 00} test clock-3.314 {ISO week-based calendar 1971-W01-1} { clock format 31795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-1 } {Mon Monday 71 1971 1 01 01 1 01} test clock-3.315 {ISO week-based calendar 1971-W01-6} { clock format 32227200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-6 } {Sat Saturday 71 1971 6 01 01 6 01} test clock-3.316 {ISO week-based calendar 1971-W01-7} { clock format 32313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-7 } {Sun Sunday 71 1971 7 02 01 0 01} test clock-3.317 {ISO week-based calendar 1971-W02-1} { clock format 32400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W02-1 } {Mon Monday 71 1971 1 02 02 1 02} test clock-3.318 {ISO week-based calendar 1971-W52-1} { clock format 62640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-1 } {Mon Monday 71 1971 1 52 52 1 52} test clock-3.319 {ISO week-based calendar 1971-W52-6} { clock format 63072000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-6 } {Sat Saturday 71 1971 6 00 52 6 00} test clock-3.320 {ISO week-based calendar 1971-W52-7} { clock format 63158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-7 } {Sun Sunday 71 1971 7 01 52 0 00} test clock-3.321 {ISO week-based calendar 1972-W01-1} { clock format 63244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-1 } {Mon Monday 72 1972 1 01 01 1 01} test clock-3.322 {ISO week-based calendar 1972-W01-6} { clock format 63676800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-6 } {Sat Saturday 72 1972 6 01 01 6 01} test clock-3.323 {ISO week-based calendar 1972-W01-7} { clock format 63763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-7 } {Sun Sunday 72 1972 7 02 01 0 01} test clock-3.324 {ISO week-based calendar 1972-W02-1} { clock format 63849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W02-1 } {Mon Monday 72 1972 1 02 02 1 02} test clock-3.325 {ISO week-based calendar 1972-W52-1} { clock format 94089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-1 } {Mon Monday 72 1972 1 52 52 1 52} test clock-3.326 {ISO week-based calendar 1972-W52-6} { clock format 94521600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-6 } {Sat Saturday 72 1972 6 52 52 6 52} test clock-3.327 {ISO week-based calendar 1972-W52-7} { clock format 94608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-7 } {Sun Sunday 72 1972 7 53 52 0 52} test clock-3.328 {ISO week-based calendar 1973-W01-1} { clock format 94694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-1 } {Mon Monday 73 1973 1 00 01 1 01} test clock-3.329 {ISO week-based calendar 1973-W01-6} { clock format 95126400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-6 } {Sat Saturday 73 1973 6 00 01 6 01} test clock-3.330 {ISO week-based calendar 1973-W01-7} { clock format 95212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-7 } {Sun Sunday 73 1973 7 01 01 0 01} test clock-3.331 {ISO week-based calendar 1973-W02-1} { clock format 95299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W02-1 } {Mon Monday 73 1973 1 01 02 1 02} test clock-3.332 {ISO week-based calendar 1973-W52-1} { clock format 125539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-1 } {Mon Monday 73 1973 1 51 52 1 52} test clock-3.333 {ISO week-based calendar 1973-W52-6} { clock format 125971200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-6 } {Sat Saturday 73 1973 6 51 52 6 52} test clock-3.334 {ISO week-based calendar 1973-W52-7} { clock format 126057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-7 } {Sun Sunday 73 1973 7 52 52 0 52} test clock-3.335 {ISO week-based calendar 1974-W01-1} { clock format 126144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-1 } {Mon Monday 74 1974 1 52 01 1 53} test clock-3.336 {ISO week-based calendar 1974-W01-2} { clock format 126230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-2 } {Tue Tuesday 74 1974 2 00 01 2 00} test clock-3.337 {ISO week-based calendar 1974-W01-6} { clock format 126576000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-6 } {Sat Saturday 74 1974 6 00 01 6 00} test clock-3.338 {ISO week-based calendar 1974-W01-7} { clock format 126662400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-7 } {Sun Sunday 74 1974 7 01 01 0 00} test clock-3.339 {ISO week-based calendar 1974-W02-1} { clock format 126748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W02-1 } {Mon Monday 74 1974 1 01 02 1 01} test clock-3.340 {ISO week-based calendar 1974-W52-1} { clock format 156988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-1 } {Mon Monday 74 1974 1 51 52 1 51} test clock-3.341 {ISO week-based calendar 1974-W52-6} { clock format 157420800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-6 } {Sat Saturday 74 1974 6 51 52 6 51} test clock-3.342 {ISO week-based calendar 1974-W52-7} { clock format 157507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-7 } {Sun Sunday 74 1974 7 52 52 0 51} test clock-3.343 {ISO week-based calendar 1975-W01-1} { clock format 157593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-1 } {Mon Monday 75 1975 1 52 01 1 52} test clock-3.344 {ISO week-based calendar 1975-W01-3} { clock format 157766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-3 } {Wed Wednesday 75 1975 3 00 01 3 00} test clock-3.345 {ISO week-based calendar 1975-W01-6} { clock format 158025600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-6 } {Sat Saturday 75 1975 6 00 01 6 00} test clock-3.346 {ISO week-based calendar 1975-W01-7} { clock format 158112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-7 } {Sun Sunday 75 1975 7 01 01 0 00} test clock-3.347 {ISO week-based calendar 1975-W02-1} { clock format 158198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W02-1 } {Mon Monday 75 1975 1 01 02 1 01} test clock-3.348 {ISO week-based calendar 1975-W52-1} { clock format 188438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-1 } {Mon Monday 75 1975 1 51 52 1 51} test clock-3.349 {ISO week-based calendar 1975-W52-6} { clock format 188870400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-6 } {Sat Saturday 75 1975 6 51 52 6 51} test clock-3.350 {ISO week-based calendar 1975-W52-7} { clock format 188956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-7 } {Sun Sunday 75 1975 7 52 52 0 51} test clock-3.351 {ISO week-based calendar 1976-W01-1} { clock format 189043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-1 } {Mon Monday 76 1976 1 52 01 1 52} test clock-3.352 {ISO week-based calendar 1976-W01-4} { clock format 189302400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-4 } {Thu Thursday 76 1976 4 00 01 4 00} test clock-3.353 {ISO week-based calendar 1976-W01-6} { clock format 189475200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-6 } {Sat Saturday 76 1976 6 00 01 6 00} test clock-3.354 {ISO week-based calendar 1976-W01-7} { clock format 189561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-7 } {Sun Sunday 76 1976 7 01 01 0 00} test clock-3.355 {ISO week-based calendar 1976-W02-1} { clock format 189648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W02-1 } {Mon Monday 76 1976 1 01 02 1 01} test clock-3.356 {ISO week-based calendar 1976-W53-1} { clock format 220492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-1 } {Mon Monday 76 1976 1 52 53 1 52} test clock-3.357 {ISO week-based calendar 1976-W53-6} { clock format 220924800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-6 } {Sat Saturday 76 1976 6 00 53 6 00} test clock-3.358 {ISO week-based calendar 1976-W53-7} { clock format 221011200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-7 } {Sun Sunday 76 1976 7 01 53 0 00} test clock-3.359 {ISO week-based calendar 1977-W01-1} { clock format 221097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-1 } {Mon Monday 77 1977 1 01 01 1 01} test clock-3.360 {ISO week-based calendar 1977-W01-6} { clock format 221529600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-6 } {Sat Saturday 77 1977 6 01 01 6 01} test clock-3.361 {ISO week-based calendar 1977-W01-7} { clock format 221616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-7 } {Sun Sunday 77 1977 7 02 01 0 01} test clock-3.362 {ISO week-based calendar 1977-W02-1} { clock format 221702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W02-1 } {Mon Monday 77 1977 1 02 02 1 02} test clock-3.363 {ISO week-based calendar 1977-W52-1} { clock format 251942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-1 } {Mon Monday 77 1977 1 52 52 1 52} test clock-3.364 {ISO week-based calendar 1977-W52-6} { clock format 252374400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-6 } {Sat Saturday 77 1977 6 52 52 6 52} test clock-3.365 {ISO week-based calendar 1977-W52-7} { clock format 252460800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-7 } {Sun Sunday 77 1977 7 01 52 0 00} test clock-3.366 {ISO week-based calendar 1978-W01-1} { clock format 252547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-1 } {Mon Monday 78 1978 1 01 01 1 01} test clock-3.367 {ISO week-based calendar 1978-W01-6} { clock format 252979200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-6 } {Sat Saturday 78 1978 6 01 01 6 01} test clock-3.368 {ISO week-based calendar 1978-W01-7} { clock format 253065600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-7 } {Sun Sunday 78 1978 7 02 01 0 01} test clock-3.369 {ISO week-based calendar 1978-W02-1} { clock format 253152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W02-1 } {Mon Monday 78 1978 1 02 02 1 02} test clock-3.370 {ISO week-based calendar 1978-W52-1} { clock format 283392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-1 } {Mon Monday 78 1978 1 52 52 1 52} test clock-3.371 {ISO week-based calendar 1978-W52-6} { clock format 283824000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-6 } {Sat Saturday 78 1978 6 52 52 6 52} test clock-3.372 {ISO week-based calendar 1978-W52-7} { clock format 283910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-7 } {Sun Sunday 78 1978 7 53 52 0 52} test clock-3.373 {ISO week-based calendar 1979-W01-1} { clock format 283996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-1 } {Mon Monday 79 1979 1 00 01 1 01} test clock-3.374 {ISO week-based calendar 1979-W01-6} { clock format 284428800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-6 } {Sat Saturday 79 1979 6 00 01 6 01} test clock-3.375 {ISO week-based calendar 1979-W01-7} { clock format 284515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-7 } {Sun Sunday 79 1979 7 01 01 0 01} test clock-3.376 {ISO week-based calendar 1979-W02-1} { clock format 284601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W02-1 } {Mon Monday 79 1979 1 01 02 1 02} test clock-3.377 {ISO week-based calendar 1979-W52-1} { clock format 314841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-1 } {Mon Monday 79 1979 1 51 52 1 52} test clock-3.378 {ISO week-based calendar 1979-W52-6} { clock format 315273600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-6 } {Sat Saturday 79 1979 6 51 52 6 52} test clock-3.379 {ISO week-based calendar 1979-W52-7} { clock format 315360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-7 } {Sun Sunday 79 1979 7 52 52 0 52} test clock-3.380 {ISO week-based calendar 1980-W01-1} { clock format 315446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-1 } {Mon Monday 80 1980 1 52 01 1 53} test clock-3.381 {ISO week-based calendar 1980-W01-2} { clock format 315532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-2 } {Tue Tuesday 80 1980 2 00 01 2 00} test clock-3.382 {ISO week-based calendar 1980-W01-6} { clock format 315878400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-6 } {Sat Saturday 80 1980 6 00 01 6 00} test clock-3.383 {ISO week-based calendar 1980-W01-7} { clock format 315964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-7 } {Sun Sunday 80 1980 7 01 01 0 00} test clock-3.384 {ISO week-based calendar 1980-W02-1} { clock format 316051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W02-1 } {Mon Monday 80 1980 1 01 02 1 01} test clock-3.385 {ISO week-based calendar 1980-W52-1} { clock format 346291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-1 } {Mon Monday 80 1980 1 51 52 1 51} test clock-3.386 {ISO week-based calendar 1980-W52-6} { clock format 346723200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-6 } {Sat Saturday 80 1980 6 51 52 6 51} test clock-3.387 {ISO week-based calendar 1980-W52-7} { clock format 346809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-7 } {Sun Sunday 80 1980 7 52 52 0 51} test clock-3.388 {ISO week-based calendar 1981-W01-1} { clock format 346896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-1 } {Mon Monday 81 1981 1 52 01 1 52} test clock-3.389 {ISO week-based calendar 1981-W01-4} { clock format 347155200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-4 } {Thu Thursday 81 1981 4 00 01 4 00} test clock-3.390 {ISO week-based calendar 1981-W01-6} { clock format 347328000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-6 } {Sat Saturday 81 1981 6 00 01 6 00} test clock-3.391 {ISO week-based calendar 1981-W01-7} { clock format 347414400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-7 } {Sun Sunday 81 1981 7 01 01 0 00} test clock-3.392 {ISO week-based calendar 1981-W02-1} { clock format 347500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W02-1 } {Mon Monday 81 1981 1 01 02 1 01} test clock-3.393 {ISO week-based calendar 1983-W52-1} { clock format 441244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-1 } {Mon Monday 83 1983 1 52 52 1 52} test clock-3.394 {ISO week-based calendar 1983-W52-6} { clock format 441676800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-6 } {Sat Saturday 83 1983 6 52 52 6 52} test clock-3.395 {ISO week-based calendar 1983-W52-7} { clock format 441763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-7 } {Sun Sunday 83 1983 7 01 52 0 00} test clock-3.396 {ISO week-based calendar 1984-W01-1} { clock format 441849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-1 } {Mon Monday 84 1984 1 01 01 1 01} test clock-3.397 {ISO week-based calendar 1984-W01-6} { clock format 442281600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-6 } {Sat Saturday 84 1984 6 01 01 6 01} test clock-3.398 {ISO week-based calendar 1984-W01-7} { clock format 442368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-7 } {Sun Sunday 84 1984 7 02 01 0 01} test clock-3.399 {ISO week-based calendar 1984-W02-1} { clock format 442454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W02-1 } {Mon Monday 84 1984 1 02 02 1 02} test clock-3.400 {ISO week-based calendar 1984-W52-1} { clock format 472694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-1 } {Mon Monday 84 1984 1 52 52 1 52} test clock-3.401 {ISO week-based calendar 1984-W52-6} { clock format 473126400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-6 } {Sat Saturday 84 1984 6 52 52 6 52} test clock-3.402 {ISO week-based calendar 1984-W52-7} { clock format 473212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-7 } {Sun Sunday 84 1984 7 53 52 0 52} test clock-3.403 {ISO week-based calendar 1985-W01-1} { clock format 473299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-1 } {Mon Monday 85 1985 1 53 01 1 53} test clock-3.404 {ISO week-based calendar 1985-W01-2} { clock format 473385600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-2 } {Tue Tuesday 85 1985 2 00 01 2 00} test clock-3.405 {ISO week-based calendar 1985-W01-6} { clock format 473731200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-6 } {Sat Saturday 85 1985 6 00 01 6 00} test clock-3.406 {ISO week-based calendar 1985-W01-7} { clock format 473817600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-7 } {Sun Sunday 85 1985 7 01 01 0 00} test clock-3.407 {ISO week-based calendar 1985-W02-1} { clock format 473904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W02-1 } {Mon Monday 85 1985 1 01 02 1 01} test clock-3.408 {ISO week-based calendar 1987-W53-1} { clock format 567648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-1 } {Mon Monday 87 1987 1 52 53 1 52} test clock-3.409 {ISO week-based calendar 1987-W53-5} { clock format 567993600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-5 } {Fri Friday 87 1987 5 00 53 5 00} test clock-3.410 {ISO week-based calendar 1987-W53-6} { clock format 568080000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-6 } {Sat Saturday 87 1987 6 00 53 6 00} test clock-3.411 {ISO week-based calendar 1987-W53-7} { clock format 568166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-7 } {Sun Sunday 87 1987 7 01 53 0 00} test clock-3.412 {ISO week-based calendar 1988-W01-1} { clock format 568252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-1 } {Mon Monday 88 1988 1 01 01 1 01} test clock-3.413 {ISO week-based calendar 1988-W01-6} { clock format 568684800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-6 } {Sat Saturday 88 1988 6 01 01 6 01} test clock-3.414 {ISO week-based calendar 1988-W01-7} { clock format 568771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-7 } {Sun Sunday 88 1988 7 02 01 0 01} test clock-3.415 {ISO week-based calendar 1988-W02-1} { clock format 568857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W02-1 } {Mon Monday 88 1988 1 02 02 1 02} test clock-3.416 {ISO week-based calendar 1988-W52-1} { clock format 599097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-1 } {Mon Monday 88 1988 1 52 52 1 52} test clock-3.417 {ISO week-based calendar 1988-W52-6} { clock format 599529600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-6 } {Sat Saturday 88 1988 6 52 52 6 52} test clock-3.418 {ISO week-based calendar 1988-W52-7} { clock format 599616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-7 } {Sun Sunday 88 1988 7 01 52 0 00} test clock-3.419 {ISO week-based calendar 1989-W01-1} { clock format 599702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-1 } {Mon Monday 89 1989 1 01 01 1 01} test clock-3.420 {ISO week-based calendar 1989-W01-6} { clock format 600134400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-6 } {Sat Saturday 89 1989 6 01 01 6 01} test clock-3.421 {ISO week-based calendar 1989-W01-7} { clock format 600220800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-7 } {Sun Sunday 89 1989 7 02 01 0 01} test clock-3.422 {ISO week-based calendar 1989-W02-1} { clock format 600307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W02-1 } {Mon Monday 89 1989 1 02 02 1 02} test clock-3.423 {ISO week-based calendar 1991-W52-1} { clock format 693446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-1 } {Mon Monday 91 1991 1 51 52 1 51} test clock-3.424 {ISO week-based calendar 1991-W52-6} { clock format 693878400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-6 } {Sat Saturday 91 1991 6 51 52 6 51} test clock-3.425 {ISO week-based calendar 1991-W52-7} { clock format 693964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-7 } {Sun Sunday 91 1991 7 52 52 0 51} test clock-3.426 {ISO week-based calendar 1992-W01-1} { clock format 694051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-1 } {Mon Monday 92 1992 1 52 01 1 52} test clock-3.427 {ISO week-based calendar 1992-W01-3} { clock format 694224000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-3 } {Wed Wednesday 92 1992 3 00 01 3 00} test clock-3.428 {ISO week-based calendar 1992-W01-6} { clock format 694483200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-6 } {Sat Saturday 92 1992 6 00 01 6 00} test clock-3.429 {ISO week-based calendar 1992-W01-7} { clock format 694569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-7 } {Sun Sunday 92 1992 7 01 01 0 00} test clock-3.430 {ISO week-based calendar 1992-W02-1} { clock format 694656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W02-1 } {Mon Monday 92 1992 1 01 02 1 01} test clock-3.431 {ISO week-based calendar 1992-W53-1} { clock format 725500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-1 } {Mon Monday 92 1992 1 52 53 1 52} test clock-3.432 {ISO week-based calendar 1992-W53-5} { clock format 725846400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-5 } {Fri Friday 92 1992 5 00 53 5 00} test clock-3.433 {ISO week-based calendar 1992-W53-6} { clock format 725932800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-6 } {Sat Saturday 92 1992 6 00 53 6 00} test clock-3.434 {ISO week-based calendar 1992-W53-7} { clock format 726019200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-7 } {Sun Sunday 92 1992 7 01 53 0 00} test clock-3.435 {ISO week-based calendar 1993-W01-1} { clock format 726105600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-1 } {Mon Monday 93 1993 1 01 01 1 01} test clock-3.436 {ISO week-based calendar 1993-W01-6} { clock format 726537600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-6 } {Sat Saturday 93 1993 6 01 01 6 01} test clock-3.437 {ISO week-based calendar 1993-W01-7} { clock format 726624000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-7 } {Sun Sunday 93 1993 7 02 01 0 01} test clock-3.438 {ISO week-based calendar 1993-W02-1} { clock format 726710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W02-1 } {Mon Monday 93 1993 1 02 02 1 02} test clock-3.439 {ISO week-based calendar 1995-W52-1} { clock format 819849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-1 } {Mon Monday 95 1995 1 52 52 1 52} test clock-3.440 {ISO week-based calendar 1995-W52-6} { clock format 820281600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-6 } {Sat Saturday 95 1995 6 52 52 6 52} test clock-3.441 {ISO week-based calendar 1995-W52-7} { clock format 820368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-7 } {Sun Sunday 95 1995 7 53 52 0 52} test clock-3.442 {ISO week-based calendar 1996-W01-1} { clock format 820454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-1 } {Mon Monday 96 1996 1 00 01 1 01} test clock-3.443 {ISO week-based calendar 1996-W01-6} { clock format 820886400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-6 } {Sat Saturday 96 1996 6 00 01 6 01} test clock-3.444 {ISO week-based calendar 1996-W01-7} { clock format 820972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-7 } {Sun Sunday 96 1996 7 01 01 0 01} test clock-3.445 {ISO week-based calendar 1996-W02-1} { clock format 821059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W02-1 } {Mon Monday 96 1996 1 01 02 1 02} test clock-3.446 {ISO week-based calendar 1996-W52-1} { clock format 851299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-1 } {Mon Monday 96 1996 1 51 52 1 52} test clock-3.447 {ISO week-based calendar 1996-W52-6} { clock format 851731200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-6 } {Sat Saturday 96 1996 6 51 52 6 52} test clock-3.448 {ISO week-based calendar 1996-W52-7} { clock format 851817600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-7 } {Sun Sunday 96 1996 7 52 52 0 52} test clock-3.449 {ISO week-based calendar 1997-W01-1} { clock format 851904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-1 } {Mon Monday 97 1997 1 52 01 1 53} test clock-3.450 {ISO week-based calendar 1997-W01-3} { clock format 852076800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-3 } {Wed Wednesday 97 1997 3 00 01 3 00} test clock-3.451 {ISO week-based calendar 1997-W01-6} { clock format 852336000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-6 } {Sat Saturday 97 1997 6 00 01 6 00} test clock-3.452 {ISO week-based calendar 1997-W01-7} { clock format 852422400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-7 } {Sun Sunday 97 1997 7 01 01 0 00} test clock-3.453 {ISO week-based calendar 1997-W02-1} { clock format 852508800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W02-1 } {Mon Monday 97 1997 1 01 02 1 01} test clock-3.454 {ISO week-based calendar 1999-W52-1} { clock format 946252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-1 } {Mon Monday 99 1999 1 52 52 1 52} test clock-3.455 {ISO week-based calendar 1999-W52-6} { clock format 946684800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-6 } {Sat Saturday 99 1999 6 00 52 6 00} test clock-3.456 {ISO week-based calendar 1999-W52-7} { clock format 946771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-7 } {Sun Sunday 99 1999 7 01 52 0 00} test clock-3.457 {ISO week-based calendar 2000-W01-1} { clock format 946857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-1 } {Mon Monday 00 2000 1 01 01 1 01} test clock-3.458 {ISO week-based calendar 2000-W01-6} { clock format 947289600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-6 } {Sat Saturday 00 2000 6 01 01 6 01} test clock-3.459 {ISO week-based calendar 2000-W01-7} { clock format 947376000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-7 } {Sun Sunday 00 2000 7 02 01 0 01} test clock-3.460 {ISO week-based calendar 2000-W02-1} { clock format 947462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W02-1 } {Mon Monday 00 2000 1 02 02 1 02} test clock-3.461 {ISO week-based calendar 2000-W52-1} { clock format 977702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-1 } {Mon Monday 00 2000 1 52 52 1 52} test clock-3.462 {ISO week-based calendar 2000-W52-6} { clock format 978134400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-6 } {Sat Saturday 00 2000 6 52 52 6 52} test clock-3.463 {ISO week-based calendar 2000-W52-7} { clock format 978220800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-7 } {Sun Sunday 00 2000 7 53 52 0 52} test clock-3.464 {ISO week-based calendar 2001-W01-1} { clock format 978307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-1 } {Mon Monday 01 2001 1 00 01 1 01} test clock-3.465 {ISO week-based calendar 2001-W01-6} { clock format 978739200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-6 } {Sat Saturday 01 2001 6 00 01 6 01} test clock-3.466 {ISO week-based calendar 2001-W01-7} { clock format 978825600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-7 } {Sun Sunday 01 2001 7 01 01 0 01} test clock-3.467 {ISO week-based calendar 2001-W02-1} { clock format 978912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W02-1 } {Mon Monday 01 2001 1 01 02 1 02} test clock-3.468 {ISO week-based calendar 2001-W52-1} { clock format 1009152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-1 } {Mon Monday 01 2001 1 51 52 1 52} test clock-3.469 {ISO week-based calendar 2001-W52-6} { clock format 1009584000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-6 } {Sat Saturday 01 2001 6 51 52 6 52} test clock-3.470 {ISO week-based calendar 2001-W52-7} { clock format 1009670400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-7 } {Sun Sunday 01 2001 7 52 52 0 52} test clock-3.471 {ISO week-based calendar 2002-W01-1} { clock format 1009756800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-1 } {Mon Monday 02 2002 1 52 01 1 53} test clock-3.472 {ISO week-based calendar 2002-W01-2} { clock format 1009843200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-2 } {Tue Tuesday 02 2002 2 00 01 2 00} test clock-3.473 {ISO week-based calendar 2002-W01-6} { clock format 1010188800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-6 } {Sat Saturday 02 2002 6 00 01 6 00} test clock-3.474 {ISO week-based calendar 2002-W01-7} { clock format 1010275200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-7 } {Sun Sunday 02 2002 7 01 01 0 00} test clock-3.475 {ISO week-based calendar 2002-W02-1} { clock format 1010361600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W02-1 } {Mon Monday 02 2002 1 01 02 1 01} test clock-3.476 {ISO week-based calendar 2002-W52-1} { clock format 1040601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-1 } {Mon Monday 02 2002 1 51 52 1 51} test clock-3.477 {ISO week-based calendar 2002-W52-6} { clock format 1041033600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-6 } {Sat Saturday 02 2002 6 51 52 6 51} test clock-3.478 {ISO week-based calendar 2002-W52-7} { clock format 1041120000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-7 } {Sun Sunday 02 2002 7 52 52 0 51} test clock-3.479 {ISO week-based calendar 2003-W01-1} { clock format 1041206400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-1 } {Mon Monday 03 2003 1 52 01 1 52} test clock-3.480 {ISO week-based calendar 2003-W01-3} { clock format 1041379200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-3 } {Wed Wednesday 03 2003 3 00 01 3 00} test clock-3.481 {ISO week-based calendar 2003-W01-6} { clock format 1041638400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-6 } {Sat Saturday 03 2003 6 00 01 6 00} test clock-3.482 {ISO week-based calendar 2003-W01-7} { clock format 1041724800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-7 } {Sun Sunday 03 2003 7 01 01 0 00} test clock-3.483 {ISO week-based calendar 2003-W02-1} { clock format 1041811200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W02-1 } {Mon Monday 03 2003 1 01 02 1 01} test clock-3.484 {ISO week-based calendar 2003-W52-1} { clock format 1072051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-1 } {Mon Monday 03 2003 1 51 52 1 51} test clock-3.485 {ISO week-based calendar 2003-W52-6} { clock format 1072483200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-6 } {Sat Saturday 03 2003 6 51 52 6 51} test clock-3.486 {ISO week-based calendar 2003-W52-7} { clock format 1072569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-7 } {Sun Sunday 03 2003 7 52 52 0 51} test clock-3.487 {ISO week-based calendar 2004-W01-1} { clock format 1072656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-1 } {Mon Monday 04 2004 1 52 01 1 52} test clock-3.488 {ISO week-based calendar 2004-W01-4} { clock format 1072915200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-4 } {Thu Thursday 04 2004 4 00 01 4 00} test clock-3.489 {ISO week-based calendar 2004-W01-6} { clock format 1073088000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-6 } {Sat Saturday 04 2004 6 00 01 6 00} test clock-3.490 {ISO week-based calendar 2004-W01-7} { clock format 1073174400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-7 } {Sun Sunday 04 2004 7 01 01 0 00} test clock-3.491 {ISO week-based calendar 2004-W02-1} { clock format 1073260800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W02-1 } {Mon Monday 04 2004 1 01 02 1 01} test clock-3.492 {ISO week-based calendar 2004-W53-1} { clock format 1104105600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-1 } {Mon Monday 04 2004 1 52 53 1 52} test clock-3.493 {ISO week-based calendar 2004-W53-6} { clock format 1104537600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-6 } {Sat Saturday 04 2004 6 00 53 6 00} test clock-3.494 {ISO week-based calendar 2004-W53-7} { clock format 1104624000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-7 } {Sun Sunday 04 2004 7 01 53 0 00} test clock-3.495 {ISO week-based calendar 2005-W01-1} { clock format 1104710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-1 } {Mon Monday 05 2005 1 01 01 1 01} test clock-3.496 {ISO week-based calendar 2005-W01-6} { clock format 1105142400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-6 } {Sat Saturday 05 2005 6 01 01 6 01} test clock-3.497 {ISO week-based calendar 2005-W01-7} { clock format 1105228800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-7 } {Sun Sunday 05 2005 7 02 01 0 01} test clock-3.498 {ISO week-based calendar 2005-W02-1} { clock format 1105315200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W02-1 } {Mon Monday 05 2005 1 02 02 1 02} test clock-3.499 {ISO week-based calendar 2005-W52-1} { clock format 1135555200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-1 } {Mon Monday 05 2005 1 52 52 1 52} test clock-3.500 {ISO week-based calendar 2005-W52-6} { clock format 1135987200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-6 } {Sat Saturday 05 2005 6 52 52 6 52} test clock-3.501 {ISO week-based calendar 2005-W52-7} { clock format 1136073600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-7 } {Sun Sunday 05 2005 7 01 52 0 00} test clock-3.502 {ISO week-based calendar 2006-W01-1} { clock format 1136160000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-1 } {Mon Monday 06 2006 1 01 01 1 01} test clock-3.503 {ISO week-based calendar 2006-W01-6} { clock format 1136592000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-6 } {Sat Saturday 06 2006 6 01 01 6 01} test clock-3.504 {ISO week-based calendar 2006-W01-7} { clock format 1136678400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-7 } {Sun Sunday 06 2006 7 02 01 0 01} test clock-3.505 {ISO week-based calendar 2006-W02-1} { clock format 1136764800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W02-1 } {Mon Monday 06 2006 1 02 02 1 02} test clock-3.506 {ISO week-based calendar 2006-W52-1} { clock format 1167004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-1 } {Mon Monday 06 2006 1 52 52 1 52} test clock-3.507 {ISO week-based calendar 2006-W52-6} { clock format 1167436800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-6 } {Sat Saturday 06 2006 6 52 52 6 52} test clock-3.508 {ISO week-based calendar 2006-W52-7} { clock format 1167523200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-7 } {Sun Sunday 06 2006 7 53 52 0 52} test clock-3.509 {ISO week-based calendar 2007-W01-1} { clock format 1167609600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-1 } {Mon Monday 07 2007 1 00 01 1 01} test clock-3.510 {ISO week-based calendar 2007-W01-6} { clock format 1168041600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-6 } {Sat Saturday 07 2007 6 00 01 6 01} test clock-3.511 {ISO week-based calendar 2007-W01-7} { clock format 1168128000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-7 } {Sun Sunday 07 2007 7 01 01 0 01} test clock-3.512 {ISO week-based calendar 2007-W02-1} { clock format 1168214400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W02-1 } {Mon Monday 07 2007 1 01 02 1 02} test clock-3.513 {ISO week-based calendar 2007-W52-1} { clock format 1198454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-1 } {Mon Monday 07 2007 1 51 52 1 52} test clock-3.514 {ISO week-based calendar 2007-W52-6} { clock format 1198886400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-6 } {Sat Saturday 07 2007 6 51 52 6 52} test clock-3.515 {ISO week-based calendar 2007-W52-7} { clock format 1198972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-7 } {Sun Sunday 07 2007 7 52 52 0 52} test clock-3.516 {ISO week-based calendar 2008-W01-1} { clock format 1199059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-1 } {Mon Monday 08 2008 1 52 01 1 53} test clock-3.517 {ISO week-based calendar 2008-W01-2} { clock format 1199145600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-2 } {Tue Tuesday 08 2008 2 00 01 2 00} test clock-3.518 {ISO week-based calendar 2008-W01-6} { clock format 1199491200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-6 } {Sat Saturday 08 2008 6 00 01 6 00} test clock-3.519 {ISO week-based calendar 2008-W01-7} { clock format 1199577600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-7 } {Sun Sunday 08 2008 7 01 01 0 00} test clock-3.520 {ISO week-based calendar 2008-W02-1} { clock format 1199664000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W02-1 } {Mon Monday 08 2008 1 01 02 1 01} test clock-3.521 {ISO week-based calendar 2008-W52-1} { clock format 1229904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-1 } {Mon Monday 08 2008 1 51 52 1 51} test clock-3.522 {ISO week-based calendar 2008-W52-6} { clock format 1230336000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-6 } {Sat Saturday 08 2008 6 51 52 6 51} test clock-3.523 {ISO week-based calendar 2008-W52-7} { clock format 1230422400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-7 } {Sun Sunday 08 2008 7 52 52 0 51} test clock-3.524 {ISO week-based calendar 2009-W01-1} { clock format 1230508800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-1 } {Mon Monday 09 2009 1 52 01 1 52} test clock-3.525 {ISO week-based calendar 2009-W01-4} { clock format 1230768000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-4 } {Thu Thursday 09 2009 4 00 01 4 00} test clock-3.526 {ISO week-based calendar 2009-W01-6} { clock format 1230940800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-6 } {Sat Saturday 09 2009 6 00 01 6 00} test clock-3.527 {ISO week-based calendar 2009-W01-7} { clock format 1231027200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-7 } {Sun Sunday 09 2009 7 01 01 0 00} test clock-3.528 {ISO week-based calendar 2009-W02-1} { clock format 1231113600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W02-1 } {Mon Monday 09 2009 1 01 02 1 01} test clock-3.529 {ISO week-based calendar 2009-W53-1} { clock format 1261958400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-1 } {Mon Monday 09 2009 1 52 53 1 52} test clock-3.530 {ISO week-based calendar 2009-W53-5} { clock format 1262304000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-5 } {Fri Friday 09 2009 5 00 53 5 00} test clock-3.531 {ISO week-based calendar 2009-W53-6} { clock format 1262390400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-6 } {Sat Saturday 09 2009 6 00 53 6 00} test clock-3.532 {ISO week-based calendar 2009-W53-7} { clock format 1262476800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-7 } {Sun Sunday 09 2009 7 01 53 0 00} test clock-3.533 {ISO week-based calendar 2010-W01-1} { clock format 1262563200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-1 } {Mon Monday 10 2010 1 01 01 1 01} test clock-3.534 {ISO week-based calendar 2010-W01-6} { clock format 1262995200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-6 } {Sat Saturday 10 2010 6 01 01 6 01} test clock-3.535 {ISO week-based calendar 2010-W01-7} { clock format 1263081600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-7 } {Sun Sunday 10 2010 7 02 01 0 01} test clock-3.536 {ISO week-based calendar 2010-W02-1} { clock format 1263168000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W02-1 } {Mon Monday 10 2010 1 02 02 1 02} test clock-3.537 {ISO week-based calendar 2010-W52-1} { clock format 1293408000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-1 } {Mon Monday 10 2010 1 52 52 1 52} test clock-3.538 {ISO week-based calendar 2010-W52-6} { clock format 1293840000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-6 } {Sat Saturday 10 2010 6 00 52 6 00} test clock-3.539 {ISO week-based calendar 2010-W52-7} { clock format 1293926400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-7 } {Sun Sunday 10 2010 7 01 52 0 00} test clock-3.540 {ISO week-based calendar 2011-W01-1} { clock format 1294012800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-1 } {Mon Monday 11 2011 1 01 01 1 01} test clock-3.541 {ISO week-based calendar 2011-W01-6} { clock format 1294444800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-6 } {Sat Saturday 11 2011 6 01 01 6 01} test clock-3.542 {ISO week-based calendar 2011-W01-7} { clock format 1294531200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-7 } {Sun Sunday 11 2011 7 02 01 0 01} test clock-3.543 {ISO week-based calendar 2011-W02-1} { clock format 1294617600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W02-1 } {Mon Monday 11 2011 1 02 02 1 02} test clock-3.544 {ISO week-based calendar 2011-W52-1} { clock format 1324857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-1 } {Mon Monday 11 2011 1 52 52 1 52} test clock-3.545 {ISO week-based calendar 2011-W52-6} { clock format 1325289600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-6 } {Sat Saturday 11 2011 6 52 52 6 52} test clock-3.546 {ISO week-based calendar 2011-W52-7} { clock format 1325376000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-7 } {Sun Sunday 11 2011 7 01 52 0 00} test clock-3.547 {ISO week-based calendar 2012-W01-1} { clock format 1325462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-1 } {Mon Monday 12 2012 1 01 01 1 01} test clock-3.548 {ISO week-based calendar 2012-W01-6} { clock format 1325894400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-6 } {Sat Saturday 12 2012 6 01 01 6 01} test clock-3.549 {ISO week-based calendar 2012-W01-7} { clock format 1325980800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-7 } {Sun Sunday 12 2012 7 02 01 0 01} test clock-3.550 {ISO week-based calendar 2012-W02-1} { clock format 1326067200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W02-1 } {Mon Monday 12 2012 1 02 02 1 02} test clock-3.551 {ISO week-based calendar 2012-W52-1} { clock format 1356307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-1 } {Mon Monday 12 2012 1 52 52 1 52} test clock-3.552 {ISO week-based calendar 2012-W52-6} { clock format 1356739200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-6 } {Sat Saturday 12 2012 6 52 52 6 52} test clock-3.553 {ISO week-based calendar 2012-W52-7} { clock format 1356825600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-7 } {Sun Sunday 12 2012 7 53 52 0 52} test clock-3.554 {ISO week-based calendar 2013-W01-1} { clock format 1356912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-1 } {Mon Monday 13 2013 1 53 01 1 53} test clock-3.555 {ISO week-based calendar 2013-W01-2} { clock format 1356998400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-2 } {Tue Tuesday 13 2013 2 00 01 2 00} test clock-3.556 {ISO week-based calendar 2013-W01-6} { clock format 1357344000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-6 } {Sat Saturday 13 2013 6 00 01 6 00} test clock-3.557 {ISO week-based calendar 2013-W01-7} { clock format 1357430400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-7 } {Sun Sunday 13 2013 7 01 01 0 00} test clock-3.558 {ISO week-based calendar 2013-W02-1} { clock format 1357516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W02-1 } {Mon Monday 13 2013 1 01 02 1 01} test clock-3.559 {ISO week-based calendar 2015-W53-1} { clock format 1451260800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-1 } {Mon Monday 15 2015 1 52 53 1 52} test clock-3.560 {ISO week-based calendar 2015-W53-5} { clock format 1451606400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-5 } {Fri Friday 15 2015 5 00 53 5 00} test clock-3.561 {ISO week-based calendar 2015-W53-6} { clock format 1451692800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-6 } {Sat Saturday 15 2015 6 00 53 6 00} test clock-3.562 {ISO week-based calendar 2015-W53-7} { clock format 1451779200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-7 } {Sun Sunday 15 2015 7 01 53 0 00} test clock-3.563 {ISO week-based calendar 2016-W01-1} { clock format 1451865600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-1 } {Mon Monday 16 2016 1 01 01 1 01} test clock-3.564 {ISO week-based calendar 2016-W01-6} { clock format 1452297600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-6 } {Sat Saturday 16 2016 6 01 01 6 01} test clock-3.565 {ISO week-based calendar 2016-W01-7} { clock format 1452384000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-7 } {Sun Sunday 16 2016 7 02 01 0 01} test clock-3.566 {ISO week-based calendar 2016-W02-1} { clock format 1452470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W02-1 } {Mon Monday 16 2016 1 02 02 1 02} test clock-3.567 {ISO week-based calendar 2016-W52-1} { clock format 1482710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-1 } {Mon Monday 16 2016 1 52 52 1 52} test clock-3.568 {ISO week-based calendar 2016-W52-6} { clock format 1483142400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-6 } {Sat Saturday 16 2016 6 52 52 6 52} test clock-3.569 {ISO week-based calendar 2016-W52-7} { clock format 1483228800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-7 } {Sun Sunday 16 2016 7 01 52 0 00} test clock-3.570 {ISO week-based calendar 2017-W01-1} { clock format 1483315200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-1 } {Mon Monday 17 2017 1 01 01 1 01} test clock-3.571 {ISO week-based calendar 2017-W01-6} { clock format 1483747200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-6 } {Sat Saturday 17 2017 6 01 01 6 01} test clock-3.572 {ISO week-based calendar 2017-W01-7} { clock format 1483833600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-7 } {Sun Sunday 17 2017 7 02 01 0 01} test clock-3.573 {ISO week-based calendar 2017-W02-1} { clock format 1483920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W02-1 } {Mon Monday 17 2017 1 02 02 1 02} test clock-3.574 {ISO week-based calendar 2019-W52-1} { clock format 1577059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-1 } {Mon Monday 19 2019 1 51 52 1 51} test clock-3.575 {ISO week-based calendar 2019-W52-6} { clock format 1577491200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-6 } {Sat Saturday 19 2019 6 51 52 6 51} test clock-3.576 {ISO week-based calendar 2019-W52-7} { clock format 1577577600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-7 } {Sun Sunday 19 2019 7 52 52 0 51} test clock-3.577 {ISO week-based calendar 2020-W01-1} { clock format 1577664000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-1 } {Mon Monday 20 2020 1 52 01 1 52} test clock-3.578 {ISO week-based calendar 2020-W01-3} { clock format 1577836800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-3 } {Wed Wednesday 20 2020 3 00 01 3 00} test clock-3.579 {ISO week-based calendar 2020-W01-6} { clock format 1578096000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-6 } {Sat Saturday 20 2020 6 00 01 6 00} test clock-3.580 {ISO week-based calendar 2020-W01-7} { clock format 1578182400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-7 } {Sun Sunday 20 2020 7 01 01 0 00} test clock-3.581 {ISO week-based calendar 2020-W02-1} { clock format 1578268800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W02-1 } {Mon Monday 20 2020 1 01 02 1 01} test clock-3.582 {ISO week-based calendar 2020-W53-1} { clock format 1609113600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-1 } {Mon Monday 20 2020 1 52 53 1 52} test clock-3.583 {ISO week-based calendar 2020-W53-5} { clock format 1609459200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-5 } {Fri Friday 20 2020 5 00 53 5 00} test clock-3.584 {ISO week-based calendar 2020-W53-6} { clock format 1609545600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-6 } {Sat Saturday 20 2020 6 00 53 6 00} test clock-3.585 {ISO week-based calendar 2020-W53-7} { clock format 1609632000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-7 } {Sun Sunday 20 2020 7 01 53 0 00} test clock-3.586 {ISO week-based calendar 2021-W01-1} { clock format 1609718400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-1 } {Mon Monday 21 2021 1 01 01 1 01} test clock-3.587 {ISO week-based calendar 2021-W01-6} { clock format 1610150400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-6 } {Sat Saturday 21 2021 6 01 01 6 01} test clock-3.588 {ISO week-based calendar 2021-W01-7} { clock format 1610236800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-7 } {Sun Sunday 21 2021 7 02 01 0 01} test clock-3.589 {ISO week-based calendar 2021-W02-1} { clock format 1610323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W02-1 } {Mon Monday 21 2021 1 02 02 1 02} test clock-3.590 {ISO week-based calendar 2023-W52-1} { clock format 1703462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-1 } {Mon Monday 23 2023 1 52 52 1 52} test clock-3.591 {ISO week-based calendar 2023-W52-6} { clock format 1703894400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-6 } {Sat Saturday 23 2023 6 52 52 6 52} test clock-3.592 {ISO week-based calendar 2023-W52-7} { clock format 1703980800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-7 } {Sun Sunday 23 2023 7 53 52 0 52} test clock-3.593 {ISO week-based calendar 2024-W01-1} { clock format 1704067200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-1 } {Mon Monday 24 2024 1 00 01 1 01} test clock-3.594 {ISO week-based calendar 2024-W01-6} { clock format 1704499200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-6 } {Sat Saturday 24 2024 6 00 01 6 01} test clock-3.595 {ISO week-based calendar 2024-W01-7} { clock format 1704585600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-7 } {Sun Sunday 24 2024 7 01 01 0 01} test clock-3.596 {ISO week-based calendar 2024-W02-1} { clock format 1704672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W02-1 } {Mon Monday 24 2024 1 01 02 1 02} test clock-3.597 {ISO week-based calendar 2024-W52-1} { clock format 1734912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-1 } {Mon Monday 24 2024 1 51 52 1 52} test clock-3.598 {ISO week-based calendar 2024-W52-6} { clock format 1735344000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-6 } {Sat Saturday 24 2024 6 51 52 6 52} test clock-3.599 {ISO week-based calendar 2024-W52-7} { clock format 1735430400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-7 } {Sun Sunday 24 2024 7 52 52 0 52} test clock-3.600 {ISO week-based calendar 2025-W01-1} { clock format 1735516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-1 } {Mon Monday 25 2025 1 52 01 1 53} test clock-3.601 {ISO week-based calendar 2025-W01-3} { clock format 1735689600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-3 } {Wed Wednesday 25 2025 3 00 01 3 00} test clock-3.602 {ISO week-based calendar 2025-W01-6} { clock format 1735948800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-6 } {Sat Saturday 25 2025 6 00 01 6 00} test clock-3.603 {ISO week-based calendar 2025-W01-7} { clock format 1736035200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-7 } {Sun Sunday 25 2025 7 01 01 0 00} test clock-3.604 {ISO week-based calendar 2025-W02-1} { clock format 1736121600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W02-1 } {Mon Monday 25 2025 1 01 02 1 01} test clock-3.605 {ISO week-based calendar 2036-W52-1} { clock format 2113516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-1 } {Mon Monday 36 2036 1 51 52 1 51} test clock-3.606 {ISO week-based calendar 2036-W52-6} { clock format 2113948800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-6 } {Sat Saturday 36 2036 6 51 52 6 51} test clock-3.607 {ISO week-based calendar 2036-W52-7} { clock format 2114035200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-7 } {Sun Sunday 36 2036 7 52 52 0 51} test clock-3.608 {ISO week-based calendar 2037-W01-1} { clock format 2114121600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-1 } {Mon Monday 37 2037 1 52 01 1 52} test clock-3.609 {ISO week-based calendar 2037-W01-4} { clock format 2114380800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-4 } {Thu Thursday 37 2037 4 00 01 4 00} test clock-3.610 {ISO week-based calendar 2037-W01-6} { clock format 2114553600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-6 } {Sat Saturday 37 2037 6 00 01 6 00} test clock-3.611 {ISO week-based calendar 2037-W01-7} { clock format 2114640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-7 } {Sun Sunday 37 2037 7 01 01 0 00} test clock-3.612 {ISO week-based calendar 2037-W02-1} { clock format 2114726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W02-1 } {Mon Monday 37 2037 1 01 02 1 01} test clock-3.613 {ISO week-based calendar 2037-W53-1} { clock format 2145571200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-1 } {Mon Monday 37 2037 1 52 53 1 52} test clock-3.614 {ISO week-based calendar 2037-W53-5} { clock format 2145916800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-5 } {Fri Friday 37 2037 5 00 53 5 00} test clock-3.615 {ISO week-based calendar 2037-W53-6} { clock format 2146003200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-6 } {Sat Saturday 37 2037 6 00 53 6 00} test clock-3.616 {ISO week-based calendar 2037-W53-7} { clock format 2146089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-7 } {Sun Sunday 37 2037 7 01 53 0 00} test clock-3.617 {ISO week-based calendar 2038-W01-1} { clock format 2146176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-1 } {Mon Monday 38 2038 1 01 01 1 01} test clock-3.618 {ISO week-based calendar 2038-W01-6} { clock format 2146608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-6 } {Sat Saturday 38 2038 6 01 01 6 01} test clock-3.619 {ISO week-based calendar 2038-W01-7} { clock format 2146694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-7 } {Sun Sunday 38 2038 7 02 01 0 01} test clock-3.620 {ISO week-based calendar 2038-W02-1} { clock format 2146780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W02-1 } {Mon Monday 38 2038 1 02 02 1 02} test clock-3.621 {ISO week-based calendar 2038-W52-1} { clock format 2177020800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-1 } {Mon Monday 38 2038 1 52 52 1 52} test clock-3.622 {ISO week-based calendar 2038-W52-6} { clock format 2177452800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-6 } {Sat Saturday 38 2038 6 00 52 6 00} test clock-3.623 {ISO week-based calendar 2038-W52-7} { clock format 2177539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-7 } {Sun Sunday 38 2038 7 01 52 0 00} test clock-3.624 {ISO week-based calendar 2039-W01-1} { clock format 2177625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-1 } {Mon Monday 39 2039 1 01 01 1 01} test clock-3.625 {ISO week-based calendar 2039-W01-6} { clock format 2178057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-6 } {Sat Saturday 39 2039 6 01 01 6 01} test clock-3.626 {ISO week-based calendar 2039-W01-7} { clock format 2178144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-7 } {Sun Sunday 39 2039 7 02 01 0 01} test clock-3.627 {ISO week-based calendar 2039-W02-1} { clock format 2178230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W02-1 } {Mon Monday 39 2039 1 02 02 1 02} test clock-3.628 {ISO week-based calendar 2039-W52-1} { clock format 2208470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-1 } {Mon Monday 39 2039 1 52 52 1 52} test clock-3.629 {ISO week-based calendar 2039-W52-6} { clock format 2208902400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-6 } {Sat Saturday 39 2039 6 52 52 6 52} test clock-3.630 {ISO week-based calendar 2039-W52-7} { clock format 2208988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-7 } {Sun Sunday 39 2039 7 01 52 0 00} test clock-3.631 {ISO week-based calendar 2040-W01-1} { clock format 2209075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-1 } {Mon Monday 40 2040 1 01 01 1 01} test clock-3.632 {ISO week-based calendar 2040-W01-6} { clock format 2209507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-6 } {Sat Saturday 40 2040 6 01 01 6 01} test clock-3.633 {ISO week-based calendar 2040-W01-7} { clock format 2209593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-7 } {Sun Sunday 40 2040 7 02 01 0 01} test clock-3.634 {ISO week-based calendar 2040-W02-1} { clock format 2209680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W02-1 } {Mon Monday 40 2040 1 02 02 1 02} test clock-3.635 {ISO week-based calendar 2040-W52-1} { clock format 2239920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-1 } {Mon Monday 40 2040 1 52 52 1 52} test clock-3.636 {ISO week-based calendar 2040-W52-6} { clock format 2240352000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-6 } {Sat Saturday 40 2040 6 52 52 6 52} test clock-3.637 {ISO week-based calendar 2040-W52-7} { clock format 2240438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-7 } {Sun Sunday 40 2040 7 53 52 0 52} test clock-3.638 {ISO week-based calendar 2041-W01-1} { clock format 2240524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-1 } {Mon Monday 41 2041 1 53 01 1 53} test clock-3.639 {ISO week-based calendar 2041-W01-2} { clock format 2240611200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-2 } {Tue Tuesday 41 2041 2 00 01 2 00} test clock-3.640 {ISO week-based calendar 2041-W01-6} { clock format 2240956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-6 } {Sat Saturday 41 2041 6 00 01 6 00} test clock-3.641 {ISO week-based calendar 2041-W01-7} { clock format 2241043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-7 } {Sun Sunday 41 2041 7 01 01 0 00} test clock-3.642 {ISO week-based calendar 2041-W02-1} { clock format 2241129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W02-1 } {Mon Monday 41 2041 1 01 02 1 01} test clock-3.643 {ISO week-based calendar 2041-W52-1} { clock format 2271369600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-1 } {Mon Monday 41 2041 1 51 52 1 51} test clock-3.644 {ISO week-based calendar 2041-W52-6} { clock format 2271801600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-6 } {Sat Saturday 41 2041 6 51 52 6 51} test clock-3.645 {ISO week-based calendar 2041-W52-7} { clock format 2271888000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-7 } {Sun Sunday 41 2041 7 52 52 0 51} test clock-3.646 {ISO week-based calendar 2042-W01-1} { clock format 2271974400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-1 } {Mon Monday 42 2042 1 52 01 1 52} test clock-3.647 {ISO week-based calendar 2042-W01-3} { clock format 2272147200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-3 } {Wed Wednesday 42 2042 3 00 01 3 00} test clock-3.648 {ISO week-based calendar 2042-W01-6} { clock format 2272406400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-6 } {Sat Saturday 42 2042 6 00 01 6 00} test clock-3.649 {ISO week-based calendar 2042-W01-7} { clock format 2272492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-7 } {Sun Sunday 42 2042 7 01 01 0 00} test clock-3.650 {ISO week-based calendar 2042-W02-1} { clock format 2272579200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W02-1 } {Mon Monday 42 2042 1 01 02 1 01} test clock-3.651 {ISO week-based calendar 2042-W52-1} { clock format 2302819200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-1 } {Mon Monday 42 2042 1 51 52 1 51} test clock-3.652 {ISO week-based calendar 2042-W52-6} { clock format 2303251200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-6 } {Sat Saturday 42 2042 6 51 52 6 51} test clock-3.653 {ISO week-based calendar 2042-W52-7} { clock format 2303337600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-7 } {Sun Sunday 42 2042 7 52 52 0 51} test clock-3.654 {ISO week-based calendar 2043-W01-1} { clock format 2303424000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-1 } {Mon Monday 43 2043 1 52 01 1 52} test clock-3.655 {ISO week-based calendar 2043-W01-4} { clock format 2303683200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-4 } {Thu Thursday 43 2043 4 00 01 4 00} test clock-3.656 {ISO week-based calendar 2043-W01-6} { clock format 2303856000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-6 } {Sat Saturday 43 2043 6 00 01 6 00} test clock-3.657 {ISO week-based calendar 2043-W01-7} { clock format 2303942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-7 } {Sun Sunday 43 2043 7 01 01 0 00} test clock-3.658 {ISO week-based calendar 2043-W02-1} { clock format 2304028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W02-1 } {Mon Monday 43 2043 1 01 02 1 01} test clock-3.659 {ISO week-based calendar 2043-W53-1} { clock format 2334873600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-1 } {Mon Monday 43 2043 1 52 53 1 52} test clock-3.660 {ISO week-based calendar 2043-W53-5} { clock format 2335219200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-5 } {Fri Friday 43 2043 5 00 53 5 00} test clock-3.661 {ISO week-based calendar 2043-W53-6} { clock format 2335305600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-6 } {Sat Saturday 43 2043 6 00 53 6 00} test clock-3.662 {ISO week-based calendar 2043-W53-7} { clock format 2335392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-7 } {Sun Sunday 43 2043 7 01 53 0 00} test clock-3.663 {ISO week-based calendar 2044-W01-1} { clock format 2335478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-1 } {Mon Monday 44 2044 1 01 01 1 01} test clock-3.664 {ISO week-based calendar 2044-W01-6} { clock format 2335910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-6 } {Sat Saturday 44 2044 6 01 01 6 01} test clock-3.665 {ISO week-based calendar 2044-W01-7} { clock format 2335996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-7 } {Sun Sunday 44 2044 7 02 01 0 01} test clock-3.666 {ISO week-based calendar 2044-W02-1} { clock format 2336083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W02-1 } {Mon Monday 44 2044 1 02 02 1 02} test clock-3.667 {ISO week-based calendar 2044-W52-1} { clock format 2366323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-1 } {Mon Monday 44 2044 1 52 52 1 52} test clock-3.668 {ISO week-based calendar 2044-W52-6} { clock format 2366755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-6 } {Sat Saturday 44 2044 6 52 52 6 52} test clock-3.669 {ISO week-based calendar 2044-W52-7} { clock format 2366841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-7 } {Sun Sunday 44 2044 7 01 52 0 00} test clock-3.670 {ISO week-based calendar 2045-W01-1} { clock format 2366928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-1 } {Mon Monday 45 2045 1 01 01 1 01} test clock-3.671 {ISO week-based calendar 2045-W01-6} { clock format 2367360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-6 } {Sat Saturday 45 2045 6 01 01 6 01} test clock-3.672 {ISO week-based calendar 2045-W01-7} { clock format 2367446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-7 } {Sun Sunday 45 2045 7 02 01 0 01} test clock-3.673 {ISO week-based calendar 2045-W02-1} { clock format 2367532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W02-1 } {Mon Monday 45 2045 1 02 02 1 02} test clock-3.674 {ISO week-based calendar 2045-W52-1} { clock format 2397772800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-1 } {Mon Monday 45 2045 1 52 52 1 52} test clock-3.675 {ISO week-based calendar 2045-W52-6} { clock format 2398204800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-6 } {Sat Saturday 45 2045 6 52 52 6 52} test clock-3.676 {ISO week-based calendar 2045-W52-7} { clock format 2398291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-7 } {Sun Sunday 45 2045 7 53 52 0 52} test clock-3.677 {ISO week-based calendar 2046-W01-1} { clock format 2398377600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-1 } {Mon Monday 46 2046 1 00 01 1 01} test clock-3.678 {ISO week-based calendar 2046-W01-6} { clock format 2398809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-6 } {Sat Saturday 46 2046 6 00 01 6 01} test clock-3.679 {ISO week-based calendar 2046-W01-7} { clock format 2398896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-7 } {Sun Sunday 46 2046 7 01 01 0 01} test clock-3.680 {ISO week-based calendar 2046-W02-1} { clock format 2398982400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W02-1 } {Mon Monday 46 2046 1 01 02 1 02} test clock-3.681 {ISO week-based calendar 2046-W52-1} { clock format 2429222400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-1 } {Mon Monday 46 2046 1 51 52 1 52} test clock-3.682 {ISO week-based calendar 2046-W52-6} { clock format 2429654400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-6 } {Sat Saturday 46 2046 6 51 52 6 52} test clock-3.683 {ISO week-based calendar 2046-W52-7} { clock format 2429740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-7 } {Sun Sunday 46 2046 7 52 52 0 52} test clock-3.684 {ISO week-based calendar 2047-W01-1} { clock format 2429827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-1 } {Mon Monday 47 2047 1 52 01 1 53} test clock-3.685 {ISO week-based calendar 2047-W01-2} { clock format 2429913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-2 } {Tue Tuesday 47 2047 2 00 01 2 00} test clock-3.686 {ISO week-based calendar 2047-W01-6} { clock format 2430259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-6 } {Sat Saturday 47 2047 6 00 01 6 00} test clock-3.687 {ISO week-based calendar 2047-W01-7} { clock format 2430345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-7 } {Sun Sunday 47 2047 7 01 01 0 00} test clock-3.688 {ISO week-based calendar 2047-W02-1} { clock format 2430432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W02-1 } {Mon Monday 47 2047 1 01 02 1 01} test clock-3.689 {ISO week-based calendar 2047-W52-1} { clock format 2460672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-1 } {Mon Monday 47 2047 1 51 52 1 51} test clock-3.690 {ISO week-based calendar 2047-W52-6} { clock format 2461104000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-6 } {Sat Saturday 47 2047 6 51 52 6 51} test clock-3.691 {ISO week-based calendar 2047-W52-7} { clock format 2461190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-7 } {Sun Sunday 47 2047 7 52 52 0 51} test clock-3.692 {ISO week-based calendar 2048-W01-1} { clock format 2461276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-1 } {Mon Monday 48 2048 1 52 01 1 52} test clock-3.693 {ISO week-based calendar 2048-W01-3} { clock format 2461449600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-3 } {Wed Wednesday 48 2048 3 00 01 3 00} test clock-3.694 {ISO week-based calendar 2048-W01-6} { clock format 2461708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-6 } {Sat Saturday 48 2048 6 00 01 6 00} test clock-3.695 {ISO week-based calendar 2048-W01-7} { clock format 2461795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-7 } {Sun Sunday 48 2048 7 01 01 0 00} test clock-3.696 {ISO week-based calendar 2048-W02-1} { clock format 2461881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W02-1 } {Mon Monday 48 2048 1 01 02 1 01} test clock-3.697 {ISO week-based calendar 2048-W53-1} { clock format 2492726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-1 } {Mon Monday 48 2048 1 52 53 1 52} test clock-3.698 {ISO week-based calendar 2048-W53-5} { clock format 2493072000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-5 } {Fri Friday 48 2048 5 00 53 5 00} test clock-3.699 {ISO week-based calendar 2048-W53-6} { clock format 2493158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-6 } {Sat Saturday 48 2048 6 00 53 6 00} test clock-3.700 {ISO week-based calendar 2048-W53-7} { clock format 2493244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-7 } {Sun Sunday 48 2048 7 01 53 0 00} test clock-3.701 {ISO week-based calendar 2049-W01-1} { clock format 2493331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-1 } {Mon Monday 49 2049 1 01 01 1 01} test clock-3.702 {ISO week-based calendar 2049-W01-6} { clock format 2493763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-6 } {Sat Saturday 49 2049 6 01 01 6 01} test clock-3.703 {ISO week-based calendar 2049-W01-7} { clock format 2493849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-7 } {Sun Sunday 49 2049 7 02 01 0 01} test clock-3.704 {ISO week-based calendar 2049-W02-1} { clock format 2493936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W02-1 } {Mon Monday 49 2049 1 02 02 1 02} test clock-3.705 {ISO week-based calendar 2051-W52-1} { clock format 2587075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-1 } {Mon Monday 51 2051 1 52 52 1 52} test clock-3.706 {ISO week-based calendar 2051-W52-6} { clock format 2587507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-6 } {Sat Saturday 51 2051 6 52 52 6 52} test clock-3.707 {ISO week-based calendar 2051-W52-7} { clock format 2587593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-7 } {Sun Sunday 51 2051 7 53 52 0 52} test clock-3.708 {ISO week-based calendar 2052-W01-1} { clock format 2587680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-1 } {Mon Monday 52 2052 1 00 01 1 01} test clock-3.709 {ISO week-based calendar 2052-W01-6} { clock format 2588112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-6 } {Sat Saturday 52 2052 6 00 01 6 01} test clock-3.710 {ISO week-based calendar 2052-W01-7} { clock format 2588198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-7 } {Sun Sunday 52 2052 7 01 01 0 01} test clock-3.711 {ISO week-based calendar 2052-W02-1} { clock format 2588284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W02-1 } {Mon Monday 52 2052 1 01 02 1 02} test clock-3.712 {ISO week-based calendar 2052-W52-1} { clock format 2618524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-1 } {Mon Monday 52 2052 1 51 52 1 52} test clock-3.713 {ISO week-based calendar 2052-W52-6} { clock format 2618956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-6 } {Sat Saturday 52 2052 6 51 52 6 52} test clock-3.714 {ISO week-based calendar 2052-W52-7} { clock format 2619043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-7 } {Sun Sunday 52 2052 7 52 52 0 52} test clock-3.715 {ISO week-based calendar 2053-W01-1} { clock format 2619129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-1 } {Mon Monday 53 2053 1 52 01 1 53} test clock-3.716 {ISO week-based calendar 2053-W01-3} { clock format 2619302400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-3 } {Wed Wednesday 53 2053 3 00 01 3 00} test clock-3.717 {ISO week-based calendar 2053-W01-6} { clock format 2619561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-6 } {Sat Saturday 53 2053 6 00 01 6 00} test clock-3.718 {ISO week-based calendar 2053-W01-7} { clock format 2619648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-7 } {Sun Sunday 53 2053 7 01 01 0 00} test clock-3.719 {ISO week-based calendar 2053-W02-1} { clock format 2619734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W02-1 } {Mon Monday 53 2053 1 01 02 1 01} test clock-3.720 {ISO week-based calendar 2055-W52-1} { clock format 2713478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-1 } {Mon Monday 55 2055 1 52 52 1 52} test clock-3.721 {ISO week-based calendar 2055-W52-6} { clock format 2713910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-6 } {Sat Saturday 55 2055 6 00 52 6 00} test clock-3.722 {ISO week-based calendar 2055-W52-7} { clock format 2713996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-7 } {Sun Sunday 55 2055 7 01 52 0 00} test clock-3.723 {ISO week-based calendar 2056-W01-1} { clock format 2714083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-1 } {Mon Monday 56 2056 1 01 01 1 01} test clock-3.724 {ISO week-based calendar 2056-W01-6} { clock format 2714515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-6 } {Sat Saturday 56 2056 6 01 01 6 01} test clock-3.725 {ISO week-based calendar 2056-W01-7} { clock format 2714601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-7 } {Sun Sunday 56 2056 7 02 01 0 01} test clock-3.726 {ISO week-based calendar 2056-W02-1} { clock format 2714688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W02-1 } {Mon Monday 56 2056 1 02 02 1 02} test clock-3.727 {ISO week-based calendar 2056-W52-1} { clock format 2744928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-1 } {Mon Monday 56 2056 1 52 52 1 52} test clock-3.728 {ISO week-based calendar 2056-W52-6} { clock format 2745360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-6 } {Sat Saturday 56 2056 6 52 52 6 52} test clock-3.729 {ISO week-based calendar 2056-W52-7} { clock format 2745446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-7 } {Sun Sunday 56 2056 7 53 52 0 52} test clock-3.730 {ISO week-based calendar 2057-W01-1} { clock format 2745532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-1 } {Mon Monday 57 2057 1 00 01 1 01} test clock-3.731 {ISO week-based calendar 2057-W01-6} { clock format 2745964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-6 } {Sat Saturday 57 2057 6 00 01 6 01} test clock-3.732 {ISO week-based calendar 2057-W01-7} { clock format 2746051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-7 } {Sun Sunday 57 2057 7 01 01 0 01} test clock-3.733 {ISO week-based calendar 2057-W02-1} { clock format 2746137600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W02-1 } {Mon Monday 57 2057 1 01 02 1 02} test clock-3.734 {ISO week-based calendar 2059-W52-1} { clock format 2839276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-1 } {Mon Monday 59 2059 1 51 52 1 51} test clock-3.735 {ISO week-based calendar 2059-W52-6} { clock format 2839708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-6 } {Sat Saturday 59 2059 6 51 52 6 51} test clock-3.736 {ISO week-based calendar 2059-W52-7} { clock format 2839795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-7 } {Sun Sunday 59 2059 7 52 52 0 51} test clock-3.737 {ISO week-based calendar 2060-W01-1} { clock format 2839881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-1 } {Mon Monday 60 2060 1 52 01 1 52} test clock-3.738 {ISO week-based calendar 2060-W01-4} { clock format 2840140800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-4 } {Thu Thursday 60 2060 4 00 01 4 00} test clock-3.739 {ISO week-based calendar 2060-W01-6} { clock format 2840313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-6 } {Sat Saturday 60 2060 6 00 01 6 00} test clock-3.740 {ISO week-based calendar 2060-W01-7} { clock format 2840400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-7 } {Sun Sunday 60 2060 7 01 01 0 00} test clock-3.741 {ISO week-based calendar 2060-W02-1} { clock format 2840486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W02-1 } {Mon Monday 60 2060 1 01 02 1 01} test clock-3.742 {ISO week-based calendar 2060-W53-1} { clock format 2871331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-1 } {Mon Monday 60 2060 1 52 53 1 52} test clock-3.743 {ISO week-based calendar 2060-W53-6} { clock format 2871763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-6 } {Sat Saturday 60 2060 6 00 53 6 00} test clock-3.744 {ISO week-based calendar 2060-W53-7} { clock format 2871849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-7 } {Sun Sunday 60 2060 7 01 53 0 00} test clock-3.745 {ISO week-based calendar 2061-W01-1} { clock format 2871936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-1 } {Mon Monday 61 2061 1 01 01 1 01} test clock-3.746 {ISO week-based calendar 2061-W01-6} { clock format 2872368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-6 } {Sat Saturday 61 2061 6 01 01 6 01} test clock-3.747 {ISO week-based calendar 2061-W01-7} { clock format 2872454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-7 } {Sun Sunday 61 2061 7 02 01 0 01} test clock-3.748 {ISO week-based calendar 2061-W02-1} { clock format 2872540800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W02-1 } {Mon Monday 61 2061 1 02 02 1 02} test clock-3.749 {ISO week-based calendar 2063-W52-1} { clock format 2965680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-1 } {Mon Monday 63 2063 1 51 52 1 52} test clock-3.750 {ISO week-based calendar 2063-W52-6} { clock format 2966112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-6 } {Sat Saturday 63 2063 6 51 52 6 52} test clock-3.751 {ISO week-based calendar 2063-W52-7} { clock format 2966198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-7 } {Sun Sunday 63 2063 7 52 52 0 52} test clock-3.752 {ISO week-based calendar 2064-W01-1} { clock format 2966284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-1 } {Mon Monday 64 2064 1 52 01 1 53} test clock-3.753 {ISO week-based calendar 2064-W01-2} { clock format 2966371200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-2 } {Tue Tuesday 64 2064 2 00 01 2 00} test clock-3.754 {ISO week-based calendar 2064-W01-6} { clock format 2966716800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-6 } {Sat Saturday 64 2064 6 00 01 6 00} test clock-3.755 {ISO week-based calendar 2064-W01-7} { clock format 2966803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-7 } {Sun Sunday 64 2064 7 01 01 0 00} test clock-3.756 {ISO week-based calendar 2064-W02-1} { clock format 2966889600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W02-1 } {Mon Monday 64 2064 1 01 02 1 01} test clock-3.757 {ISO week-based calendar 2064-W52-1} { clock format 2997129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-1 } {Mon Monday 64 2064 1 51 52 1 51} test clock-3.758 {ISO week-based calendar 2064-W52-6} { clock format 2997561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-6 } {Sat Saturday 64 2064 6 51 52 6 51} test clock-3.759 {ISO week-based calendar 2064-W52-7} { clock format 2997648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-7 } {Sun Sunday 64 2064 7 52 52 0 51} test clock-3.760 {ISO week-based calendar 2065-W01-1} { clock format 2997734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-1 } {Mon Monday 65 2065 1 52 01 1 52} test clock-3.761 {ISO week-based calendar 2065-W01-4} { clock format 2997993600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-4 } {Thu Thursday 65 2065 4 00 01 4 00} test clock-3.762 {ISO week-based calendar 2065-W01-6} { clock format 2998166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-6 } {Sat Saturday 65 2065 6 00 01 6 00} test clock-3.763 {ISO week-based calendar 2065-W01-7} { clock format 2998252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-7 } {Sun Sunday 65 2065 7 01 01 0 00} test clock-3.764 {ISO week-based calendar 2065-W02-1} { clock format 2998339200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W02-1 } {Mon Monday 65 2065 1 01 02 1 01} # END testcases3 # BEGIN testcases4 # Test formatting of time of day # Format groups tested: %H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+ test clock-4.1 { format time of day 00:00:00 } { clock format 0 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 00 ? AM am 12:00:00 am 00:00 00 ? 00:00:00 00:00:00 ? h ? m ? s Thu Jan 1 00:00:00 GMT 1970} test clock-4.2 { format time of day 00:00:01 } { clock format 1 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 00 ? AM am 12:00:01 am 00:00 01 i 00:00:01 00:00:01 ? h ? m i s Thu Jan 1 00:00:01 GMT 1970} test clock-4.3 { format time of day 00:00:58 } { clock format 58 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 00 ? AM am 12:00:58 am 00:00 58 lviii 00:00:58 00:00:58 ? h ? m lviii s Thu Jan 1 00:00:58 GMT 1970} test clock-4.4 { format time of day 00:00:59 } { clock format 59 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 00 ? AM am 12:00:59 am 00:00 59 lix 00:00:59 00:00:59 ? h ? m lix s Thu Jan 1 00:00:59 GMT 1970} test clock-4.5 { format time of day 00:01:00 } { clock format 60 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 01 i AM am 12:01:00 am 00:01 00 ? 00:01:00 00:01:00 ? h i m ? s Thu Jan 1 00:01:00 GMT 1970} test clock-4.6 { format time of day 00:01:01 } { clock format 61 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 01 i AM am 12:01:01 am 00:01 01 i 00:01:01 00:01:01 ? h i m i s Thu Jan 1 00:01:01 GMT 1970} test clock-4.7 { format time of day 00:01:58 } { clock format 118 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 01 i AM am 12:01:58 am 00:01 58 lviii 00:01:58 00:01:58 ? h i m lviii s Thu Jan 1 00:01:58 GMT 1970} test clock-4.8 { format time of day 00:01:59 } { clock format 119 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 01 i AM am 12:01:59 am 00:01 59 lix 00:01:59 00:01:59 ? h i m lix s Thu Jan 1 00:01:59 GMT 1970} test clock-4.9 { format time of day 00:58:00 } { clock format 3480 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 58 lviii AM am 12:58:00 am 00:58 00 ? 00:58:00 00:58:00 ? h lviii m ? s Thu Jan 1 00:58:00 GMT 1970} test clock-4.10 { format time of day 00:58:01 } { clock format 3481 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 58 lviii AM am 12:58:01 am 00:58 01 i 00:58:01 00:58:01 ? h lviii m i s Thu Jan 1 00:58:01 GMT 1970} test clock-4.11 { format time of day 00:58:58 } { clock format 3538 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 58 lviii AM am 12:58:58 am 00:58 58 lviii 00:58:58 00:58:58 ? h lviii m lviii s Thu Jan 1 00:58:58 GMT 1970} test clock-4.12 { format time of day 00:58:59 } { clock format 3539 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 58 lviii AM am 12:58:59 am 00:58 59 lix 00:58:59 00:58:59 ? h lviii m lix s Thu Jan 1 00:58:59 GMT 1970} test clock-4.13 { format time of day 00:59:00 } { clock format 3540 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 59 lix AM am 12:59:00 am 00:59 00 ? 00:59:00 00:59:00 ? h lix m ? s Thu Jan 1 00:59:00 GMT 1970} test clock-4.14 { format time of day 00:59:01 } { clock format 3541 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 59 lix AM am 12:59:01 am 00:59 01 i 00:59:01 00:59:01 ? h lix m i s Thu Jan 1 00:59:01 GMT 1970} test clock-4.15 { format time of day 00:59:58 } { clock format 3598 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 59 lix AM am 12:59:58 am 00:59 58 lviii 00:59:58 00:59:58 ? h lix m lviii s Thu Jan 1 00:59:58 GMT 1970} test clock-4.16 { format time of day 00:59:59 } { clock format 3599 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {00 ? 12 xii 0 ? 12 xii 59 lix AM am 12:59:59 am 00:59 59 lix 00:59:59 00:59:59 ? h lix m lix s Thu Jan 1 00:59:59 GMT 1970} test clock-4.17 { format time of day 01:00:00 } { clock format 3600 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 00 ? AM am 01:00:00 am 01:00 00 ? 01:00:00 01:00:00 i h ? m ? s Thu Jan 1 01:00:00 GMT 1970} test clock-4.18 { format time of day 01:00:01 } { clock format 3601 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 00 ? AM am 01:00:01 am 01:00 01 i 01:00:01 01:00:01 i h ? m i s Thu Jan 1 01:00:01 GMT 1970} test clock-4.19 { format time of day 01:00:58 } { clock format 3658 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 00 ? AM am 01:00:58 am 01:00 58 lviii 01:00:58 01:00:58 i h ? m lviii s Thu Jan 1 01:00:58 GMT 1970} test clock-4.20 { format time of day 01:00:59 } { clock format 3659 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 00 ? AM am 01:00:59 am 01:00 59 lix 01:00:59 01:00:59 i h ? m lix s Thu Jan 1 01:00:59 GMT 1970} test clock-4.21 { format time of day 01:01:00 } { clock format 3660 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 01 i AM am 01:01:00 am 01:01 00 ? 01:01:00 01:01:00 i h i m ? s Thu Jan 1 01:01:00 GMT 1970} test clock-4.22 { format time of day 01:01:01 } { clock format 3661 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 01 i AM am 01:01:01 am 01:01 01 i 01:01:01 01:01:01 i h i m i s Thu Jan 1 01:01:01 GMT 1970} test clock-4.23 { format time of day 01:01:58 } { clock format 3718 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 01 i AM am 01:01:58 am 01:01 58 lviii 01:01:58 01:01:58 i h i m lviii s Thu Jan 1 01:01:58 GMT 1970} test clock-4.24 { format time of day 01:01:59 } { clock format 3719 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 01 i AM am 01:01:59 am 01:01 59 lix 01:01:59 01:01:59 i h i m lix s Thu Jan 1 01:01:59 GMT 1970} test clock-4.25 { format time of day 01:58:00 } { clock format 7080 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 58 lviii AM am 01:58:00 am 01:58 00 ? 01:58:00 01:58:00 i h lviii m ? s Thu Jan 1 01:58:00 GMT 1970} test clock-4.26 { format time of day 01:58:01 } { clock format 7081 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 58 lviii AM am 01:58:01 am 01:58 01 i 01:58:01 01:58:01 i h lviii m i s Thu Jan 1 01:58:01 GMT 1970} test clock-4.27 { format time of day 01:58:58 } { clock format 7138 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 58 lviii AM am 01:58:58 am 01:58 58 lviii 01:58:58 01:58:58 i h lviii m lviii s Thu Jan 1 01:58:58 GMT 1970} test clock-4.28 { format time of day 01:58:59 } { clock format 7139 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 58 lviii AM am 01:58:59 am 01:58 59 lix 01:58:59 01:58:59 i h lviii m lix s Thu Jan 1 01:58:59 GMT 1970} test clock-4.29 { format time of day 01:59:00 } { clock format 7140 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 59 lix AM am 01:59:00 am 01:59 00 ? 01:59:00 01:59:00 i h lix m ? s Thu Jan 1 01:59:00 GMT 1970} test clock-4.30 { format time of day 01:59:01 } { clock format 7141 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 59 lix AM am 01:59:01 am 01:59 01 i 01:59:01 01:59:01 i h lix m i s Thu Jan 1 01:59:01 GMT 1970} test clock-4.31 { format time of day 01:59:58 } { clock format 7198 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 59 lix AM am 01:59:58 am 01:59 58 lviii 01:59:58 01:59:58 i h lix m lviii s Thu Jan 1 01:59:58 GMT 1970} test clock-4.32 { format time of day 01:59:59 } { clock format 7199 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {01 i 01 i 1 i 1 i 59 lix AM am 01:59:59 am 01:59 59 lix 01:59:59 01:59:59 i h lix m lix s Thu Jan 1 01:59:59 GMT 1970} test clock-4.33 { format time of day 11:00:00 } { clock format 39600 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 00 ? AM am 11:00:00 am 11:00 00 ? 11:00:00 11:00:00 xi h ? m ? s Thu Jan 1 11:00:00 GMT 1970} test clock-4.34 { format time of day 11:00:01 } { clock format 39601 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 00 ? AM am 11:00:01 am 11:00 01 i 11:00:01 11:00:01 xi h ? m i s Thu Jan 1 11:00:01 GMT 1970} test clock-4.35 { format time of day 11:00:58 } { clock format 39658 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 00 ? AM am 11:00:58 am 11:00 58 lviii 11:00:58 11:00:58 xi h ? m lviii s Thu Jan 1 11:00:58 GMT 1970} test clock-4.36 { format time of day 11:00:59 } { clock format 39659 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 00 ? AM am 11:00:59 am 11:00 59 lix 11:00:59 11:00:59 xi h ? m lix s Thu Jan 1 11:00:59 GMT 1970} test clock-4.37 { format time of day 11:01:00 } { clock format 39660 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 01 i AM am 11:01:00 am 11:01 00 ? 11:01:00 11:01:00 xi h i m ? s Thu Jan 1 11:01:00 GMT 1970} test clock-4.38 { format time of day 11:01:01 } { clock format 39661 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 01 i AM am 11:01:01 am 11:01 01 i 11:01:01 11:01:01 xi h i m i s Thu Jan 1 11:01:01 GMT 1970} test clock-4.39 { format time of day 11:01:58 } { clock format 39718 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 01 i AM am 11:01:58 am 11:01 58 lviii 11:01:58 11:01:58 xi h i m lviii s Thu Jan 1 11:01:58 GMT 1970} test clock-4.40 { format time of day 11:01:59 } { clock format 39719 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 01 i AM am 11:01:59 am 11:01 59 lix 11:01:59 11:01:59 xi h i m lix s Thu Jan 1 11:01:59 GMT 1970} test clock-4.41 { format time of day 11:58:00 } { clock format 43080 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 58 lviii AM am 11:58:00 am 11:58 00 ? 11:58:00 11:58:00 xi h lviii m ? s Thu Jan 1 11:58:00 GMT 1970} test clock-4.42 { format time of day 11:58:01 } { clock format 43081 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 58 lviii AM am 11:58:01 am 11:58 01 i 11:58:01 11:58:01 xi h lviii m i s Thu Jan 1 11:58:01 GMT 1970} test clock-4.43 { format time of day 11:58:58 } { clock format 43138 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 58 lviii AM am 11:58:58 am 11:58 58 lviii 11:58:58 11:58:58 xi h lviii m lviii s Thu Jan 1 11:58:58 GMT 1970} test clock-4.44 { format time of day 11:58:59 } { clock format 43139 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 58 lviii AM am 11:58:59 am 11:58 59 lix 11:58:59 11:58:59 xi h lviii m lix s Thu Jan 1 11:58:59 GMT 1970} test clock-4.45 { format time of day 11:59:00 } { clock format 43140 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 59 lix AM am 11:59:00 am 11:59 00 ? 11:59:00 11:59:00 xi h lix m ? s Thu Jan 1 11:59:00 GMT 1970} test clock-4.46 { format time of day 11:59:01 } { clock format 43141 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 59 lix AM am 11:59:01 am 11:59 01 i 11:59:01 11:59:01 xi h lix m i s Thu Jan 1 11:59:01 GMT 1970} test clock-4.47 { format time of day 11:59:58 } { clock format 43198 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 59 lix AM am 11:59:58 am 11:59 58 lviii 11:59:58 11:59:58 xi h lix m lviii s Thu Jan 1 11:59:58 GMT 1970} test clock-4.48 { format time of day 11:59:59 } { clock format 43199 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {11 xi 11 xi 11 xi 11 xi 59 lix AM am 11:59:59 am 11:59 59 lix 11:59:59 11:59:59 xi h lix m lix s Thu Jan 1 11:59:59 GMT 1970} test clock-4.49 { format time of day 12:00:00 } { clock format 43200 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 00 ? PM pm 12:00:00 pm 12:00 00 ? 12:00:00 12:00:00 xii h ? m ? s Thu Jan 1 12:00:00 GMT 1970} test clock-4.50 { format time of day 12:00:01 } { clock format 43201 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 00 ? PM pm 12:00:01 pm 12:00 01 i 12:00:01 12:00:01 xii h ? m i s Thu Jan 1 12:00:01 GMT 1970} test clock-4.51 { format time of day 12:00:58 } { clock format 43258 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 00 ? PM pm 12:00:58 pm 12:00 58 lviii 12:00:58 12:00:58 xii h ? m lviii s Thu Jan 1 12:00:58 GMT 1970} test clock-4.52 { format time of day 12:00:59 } { clock format 43259 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 00 ? PM pm 12:00:59 pm 12:00 59 lix 12:00:59 12:00:59 xii h ? m lix s Thu Jan 1 12:00:59 GMT 1970} test clock-4.53 { format time of day 12:01:00 } { clock format 43260 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 01 i PM pm 12:01:00 pm 12:01 00 ? 12:01:00 12:01:00 xii h i m ? s Thu Jan 1 12:01:00 GMT 1970} test clock-4.54 { format time of day 12:01:01 } { clock format 43261 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 01 i PM pm 12:01:01 pm 12:01 01 i 12:01:01 12:01:01 xii h i m i s Thu Jan 1 12:01:01 GMT 1970} test clock-4.55 { format time of day 12:01:58 } { clock format 43318 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 01 i PM pm 12:01:58 pm 12:01 58 lviii 12:01:58 12:01:58 xii h i m lviii s Thu Jan 1 12:01:58 GMT 1970} test clock-4.56 { format time of day 12:01:59 } { clock format 43319 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 01 i PM pm 12:01:59 pm 12:01 59 lix 12:01:59 12:01:59 xii h i m lix s Thu Jan 1 12:01:59 GMT 1970} test clock-4.57 { format time of day 12:58:00 } { clock format 46680 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 58 lviii PM pm 12:58:00 pm 12:58 00 ? 12:58:00 12:58:00 xii h lviii m ? s Thu Jan 1 12:58:00 GMT 1970} test clock-4.58 { format time of day 12:58:01 } { clock format 46681 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 58 lviii PM pm 12:58:01 pm 12:58 01 i 12:58:01 12:58:01 xii h lviii m i s Thu Jan 1 12:58:01 GMT 1970} test clock-4.59 { format time of day 12:58:58 } { clock format 46738 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 58 lviii PM pm 12:58:58 pm 12:58 58 lviii 12:58:58 12:58:58 xii h lviii m lviii s Thu Jan 1 12:58:58 GMT 1970} test clock-4.60 { format time of day 12:58:59 } { clock format 46739 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 58 lviii PM pm 12:58:59 pm 12:58 59 lix 12:58:59 12:58:59 xii h lviii m lix s Thu Jan 1 12:58:59 GMT 1970} test clock-4.61 { format time of day 12:59:00 } { clock format 46740 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 59 lix PM pm 12:59:00 pm 12:59 00 ? 12:59:00 12:59:00 xii h lix m ? s Thu Jan 1 12:59:00 GMT 1970} test clock-4.62 { format time of day 12:59:01 } { clock format 46741 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 59 lix PM pm 12:59:01 pm 12:59 01 i 12:59:01 12:59:01 xii h lix m i s Thu Jan 1 12:59:01 GMT 1970} test clock-4.63 { format time of day 12:59:58 } { clock format 46798 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 59 lix PM pm 12:59:58 pm 12:59 58 lviii 12:59:58 12:59:58 xii h lix m lviii s Thu Jan 1 12:59:58 GMT 1970} test clock-4.64 { format time of day 12:59:59 } { clock format 46799 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {12 xii 12 xii 12 xii 12 xii 59 lix PM pm 12:59:59 pm 12:59 59 lix 12:59:59 12:59:59 xii h lix m lix s Thu Jan 1 12:59:59 GMT 1970} test clock-4.65 { format time of day 13:00:00 } { clock format 46800 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 00 ? PM pm 01:00:00 pm 13:00 00 ? 13:00:00 13:00:00 xiii h ? m ? s Thu Jan 1 13:00:00 GMT 1970} test clock-4.66 { format time of day 13:00:01 } { clock format 46801 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 00 ? PM pm 01:00:01 pm 13:00 01 i 13:00:01 13:00:01 xiii h ? m i s Thu Jan 1 13:00:01 GMT 1970} test clock-4.67 { format time of day 13:00:58 } { clock format 46858 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 00 ? PM pm 01:00:58 pm 13:00 58 lviii 13:00:58 13:00:58 xiii h ? m lviii s Thu Jan 1 13:00:58 GMT 1970} test clock-4.68 { format time of day 13:00:59 } { clock format 46859 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 00 ? PM pm 01:00:59 pm 13:00 59 lix 13:00:59 13:00:59 xiii h ? m lix s Thu Jan 1 13:00:59 GMT 1970} test clock-4.69 { format time of day 13:01:00 } { clock format 46860 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 01 i PM pm 01:01:00 pm 13:01 00 ? 13:01:00 13:01:00 xiii h i m ? s Thu Jan 1 13:01:00 GMT 1970} test clock-4.70 { format time of day 13:01:01 } { clock format 46861 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 01 i PM pm 01:01:01 pm 13:01 01 i 13:01:01 13:01:01 xiii h i m i s Thu Jan 1 13:01:01 GMT 1970} test clock-4.71 { format time of day 13:01:58 } { clock format 46918 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 01 i PM pm 01:01:58 pm 13:01 58 lviii 13:01:58 13:01:58 xiii h i m lviii s Thu Jan 1 13:01:58 GMT 1970} test clock-4.72 { format time of day 13:01:59 } { clock format 46919 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 01 i PM pm 01:01:59 pm 13:01 59 lix 13:01:59 13:01:59 xiii h i m lix s Thu Jan 1 13:01:59 GMT 1970} test clock-4.73 { format time of day 13:58:00 } { clock format 50280 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 58 lviii PM pm 01:58:00 pm 13:58 00 ? 13:58:00 13:58:00 xiii h lviii m ? s Thu Jan 1 13:58:00 GMT 1970} test clock-4.74 { format time of day 13:58:01 } { clock format 50281 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 58 lviii PM pm 01:58:01 pm 13:58 01 i 13:58:01 13:58:01 xiii h lviii m i s Thu Jan 1 13:58:01 GMT 1970} test clock-4.75 { format time of day 13:58:58 } { clock format 50338 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 58 lviii PM pm 01:58:58 pm 13:58 58 lviii 13:58:58 13:58:58 xiii h lviii m lviii s Thu Jan 1 13:58:58 GMT 1970} test clock-4.76 { format time of day 13:58:59 } { clock format 50339 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 58 lviii PM pm 01:58:59 pm 13:58 59 lix 13:58:59 13:58:59 xiii h lviii m lix s Thu Jan 1 13:58:59 GMT 1970} test clock-4.77 { format time of day 13:59:00 } { clock format 50340 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 59 lix PM pm 01:59:00 pm 13:59 00 ? 13:59:00 13:59:00 xiii h lix m ? s Thu Jan 1 13:59:00 GMT 1970} test clock-4.78 { format time of day 13:59:01 } { clock format 50341 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 59 lix PM pm 01:59:01 pm 13:59 01 i 13:59:01 13:59:01 xiii h lix m i s Thu Jan 1 13:59:01 GMT 1970} test clock-4.79 { format time of day 13:59:58 } { clock format 50398 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 59 lix PM pm 01:59:58 pm 13:59 58 lviii 13:59:58 13:59:58 xiii h lix m lviii s Thu Jan 1 13:59:58 GMT 1970} test clock-4.80 { format time of day 13:59:59 } { clock format 50399 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {13 xiii 01 i 13 xiii 1 i 59 lix PM pm 01:59:59 pm 13:59 59 lix 13:59:59 13:59:59 xiii h lix m lix s Thu Jan 1 13:59:59 GMT 1970} test clock-4.81 { format time of day 23:00:00 } { clock format 82800 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 00 ? PM pm 11:00:00 pm 23:00 00 ? 23:00:00 23:00:00 xxiii h ? m ? s Thu Jan 1 23:00:00 GMT 1970} test clock-4.82 { format time of day 23:00:01 } { clock format 82801 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 00 ? PM pm 11:00:01 pm 23:00 01 i 23:00:01 23:00:01 xxiii h ? m i s Thu Jan 1 23:00:01 GMT 1970} test clock-4.83 { format time of day 23:00:58 } { clock format 82858 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 00 ? PM pm 11:00:58 pm 23:00 58 lviii 23:00:58 23:00:58 xxiii h ? m lviii s Thu Jan 1 23:00:58 GMT 1970} test clock-4.84 { format time of day 23:00:59 } { clock format 82859 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 00 ? PM pm 11:00:59 pm 23:00 59 lix 23:00:59 23:00:59 xxiii h ? m lix s Thu Jan 1 23:00:59 GMT 1970} test clock-4.85 { format time of day 23:01:00 } { clock format 82860 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 01 i PM pm 11:01:00 pm 23:01 00 ? 23:01:00 23:01:00 xxiii h i m ? s Thu Jan 1 23:01:00 GMT 1970} test clock-4.86 { format time of day 23:01:01 } { clock format 82861 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 01 i PM pm 11:01:01 pm 23:01 01 i 23:01:01 23:01:01 xxiii h i m i s Thu Jan 1 23:01:01 GMT 1970} test clock-4.87 { format time of day 23:01:58 } { clock format 82918 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 01 i PM pm 11:01:58 pm 23:01 58 lviii 23:01:58 23:01:58 xxiii h i m lviii s Thu Jan 1 23:01:58 GMT 1970} test clock-4.88 { format time of day 23:01:59 } { clock format 82919 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 01 i PM pm 11:01:59 pm 23:01 59 lix 23:01:59 23:01:59 xxiii h i m lix s Thu Jan 1 23:01:59 GMT 1970} test clock-4.89 { format time of day 23:58:00 } { clock format 86280 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 58 lviii PM pm 11:58:00 pm 23:58 00 ? 23:58:00 23:58:00 xxiii h lviii m ? s Thu Jan 1 23:58:00 GMT 1970} test clock-4.90 { format time of day 23:58:01 } { clock format 86281 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 58 lviii PM pm 11:58:01 pm 23:58 01 i 23:58:01 23:58:01 xxiii h lviii m i s Thu Jan 1 23:58:01 GMT 1970} test clock-4.91 { format time of day 23:58:58 } { clock format 86338 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 58 lviii PM pm 11:58:58 pm 23:58 58 lviii 23:58:58 23:58:58 xxiii h lviii m lviii s Thu Jan 1 23:58:58 GMT 1970} test clock-4.92 { format time of day 23:58:59 } { clock format 86339 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 58 lviii PM pm 11:58:59 pm 23:58 59 lix 23:58:59 23:58:59 xxiii h lviii m lix s Thu Jan 1 23:58:59 GMT 1970} test clock-4.93 { format time of day 23:59:00 } { clock format 86340 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 59 lix PM pm 11:59:00 pm 23:59 00 ? 23:59:00 23:59:00 xxiii h lix m ? s Thu Jan 1 23:59:00 GMT 1970} test clock-4.94 { format time of day 23:59:01 } { clock format 86341 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 59 lix PM pm 11:59:01 pm 23:59 01 i 23:59:01 23:59:01 xxiii h lix m i s Thu Jan 1 23:59:01 GMT 1970} test clock-4.95 { format time of day 23:59:58 } { clock format 86398 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 59 lix PM pm 11:59:58 pm 23:59 58 lviii 23:59:58 23:59:58 xxiii h lix m lviii s Thu Jan 1 23:59:58 GMT 1970} test clock-4.96 { format time of day 23:59:59 } { clock format 86399 \ -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \ -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 59 lix PM pm 11:59:59 pm 23:59 59 lix 23:59:59 23:59:59 xxiii h lix m lix s Thu Jan 1 23:59:59 GMT 1970} # END testcases4 # BEGIN testcases5 # Test formatting of Daylight Saving Time test clock-5.1 {does Detroit exist} { clock format 0 -format {} -timezone :America/Detroit concat } {} test clock-5.2 {does Detroit have a Y2038 problem} detroit { if { [clock format 2158894800 -format %z -timezone :America/Detroit] ne {-0400} } { concat {y2038 problem} } else { concat {ok} } } ok test clock-5.3 {time zone boundary case 1904-12-31 23:59:59} detroit { clock format -2051202470 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {23:59:59 -053211 LMT} test clock-5.4 {time zone boundary case 1904-12-31 23:32:11} detroit { clock format -2051202469 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {23:32:11 -0600 CST} test clock-5.5 {time zone boundary case 1904-12-31 23:32:12} detroit { clock format -2051202468 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {23:32:12 -0600 CST} test clock-5.6 {time zone boundary case 1915-05-15 01:59:59} detroit { clock format -1724083201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0600 CST} test clock-5.7 {time zone boundary case 1915-05-15 03:00:00} detroit { clock format -1724083200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0500 EST} test clock-5.8 {time zone boundary case 1915-05-15 03:00:01} detroit { clock format -1724083199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0500 EST} test clock-5.9 {time zone boundary case 1941-12-31 23:59:59} detroit { clock format -883594801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {23:59:59 -0500 EST} test clock-5.10 {time zone boundary case 1942-01-01 00:00:00} detroit { clock format -883594800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {00:00:00 -0500 EST} test clock-5.11 {time zone boundary case 1942-01-01 00:00:01} detroit { clock format -883594799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {00:00:01 -0500 EST} test clock-5.12 {time zone boundary case 1942-02-09 01:59:59} detroit { clock format -880218001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.13 {time zone boundary case 1942-02-09 03:00:00} detroit { clock format -880218000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EWT} test clock-5.14 {time zone boundary case 1942-02-09 03:00:01} detroit { clock format -880217999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EWT} test clock-5.15 {time zone boundary case 1945-08-14 18:59:59} detroit { clock format -769395601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {18:59:59 -0400 EWT} test clock-5.16 {time zone boundary case 1945-08-14 19:00:00} detroit { clock format -769395600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {19:00:00 -0400 EPT} test clock-5.17 {time zone boundary case 1945-08-14 19:00:01} detroit { clock format -769395599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {19:00:01 -0400 EPT} test clock-5.18 {time zone boundary case 1945-09-30 01:59:59} detroit { clock format -765396001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EPT} test clock-5.19 {time zone boundary case 1945-09-30 01:00:00} detroit { clock format -765396000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.20 {time zone boundary case 1945-09-30 01:00:01} detroit { clock format -765395999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.21 {time zone boundary case 1945-12-31 23:59:59} detroit { clock format -757364401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {23:59:59 -0500 EST} test clock-5.22 {time zone boundary case 1946-01-01 00:00:00} detroit { clock format -757364400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {00:00:00 -0500 EST} test clock-5.23 {time zone boundary case 1946-01-01 00:00:01} detroit { clock format -757364399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {00:00:01 -0500 EST} test clock-5.24 {time zone boundary case 1948-04-25 01:59:59} detroit { clock format -684349201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.25 {time zone boundary case 1948-04-25 03:00:00} detroit { clock format -684349200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.26 {time zone boundary case 1948-04-25 03:00:01} detroit { clock format -684349199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.27 {time zone boundary case 1948-09-26 01:59:59} detroit { clock format -671047201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.28 {time zone boundary case 1948-09-26 01:00:00} detroit { clock format -671047200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.29 {time zone boundary case 1948-09-26 01:00:01} detroit { clock format -671047199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} # Detroit did not observe Daylight Saving Time in 1967 test clock-5.36 {time zone boundary case 1972-12-31 23:59:59} detroit { clock format 94712399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {23:59:59 -0500 EST} test clock-5.37 {time zone boundary case 1973-01-01 00:00:00} detroit { clock format 94712400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {00:00:00 -0500 EST} test clock-5.38 {time zone boundary case 1973-01-01 00:00:01} detroit { clock format 94712401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {00:00:01 -0500 EST} test clock-5.39 {time zone boundary case 1973-04-29 01:59:59} detroit { clock format 104914799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.40 {time zone boundary case 1973-04-29 03:00:00} detroit { clock format 104914800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.41 {time zone boundary case 1973-04-29 03:00:01} detroit { clock format 104914801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.42 {time zone boundary case 1973-10-28 01:59:59} detroit { clock format 120635999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.43 {time zone boundary case 1973-10-28 01:00:00} detroit { clock format 120636000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.44 {time zone boundary case 1973-10-28 01:00:01} detroit { clock format 120636001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.45 {time zone boundary case 1974-01-06 01:59:59} detroit { clock format 126687599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.46 {time zone boundary case 1974-01-06 03:00:00} detroit { clock format 126687600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.47 {time zone boundary case 1974-01-06 03:00:01} detroit { clock format 126687601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.48 {time zone boundary case 1974-10-27 01:59:59} detroit { clock format 152085599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.49 {time zone boundary case 1974-10-27 01:00:00} detroit { clock format 152085600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.50 {time zone boundary case 1974-10-27 01:00:01} detroit { clock format 152085601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.51 {time zone boundary case 1974-12-31 23:59:59} detroit { clock format 157784399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {23:59:59 -0500 EST} test clock-5.52 {time zone boundary case 1975-01-01 00:00:00} detroit { clock format 157784400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {00:00:00 -0500 EST} test clock-5.53 {time zone boundary case 1975-01-01 00:00:01} detroit { clock format 157784401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {00:00:01 -0500 EST} test clock-5.54 {time zone boundary case 1975-04-27 01:59:59} detroit { clock format 167813999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.55 {time zone boundary case 1975-04-27 03:00:00} detroit { clock format 167814000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.56 {time zone boundary case 1975-04-27 03:00:01} detroit { clock format 167814001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.57 {time zone boundary case 1975-10-26 01:59:59} detroit { clock format 183535199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.58 {time zone boundary case 1975-10-26 01:00:00} detroit { clock format 183535200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.59 {time zone boundary case 1975-10-26 01:00:01} detroit { clock format 183535201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.60 {time zone boundary case 1976-04-25 01:59:59} detroit { clock format 199263599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.61 {time zone boundary case 1976-04-25 03:00:00} detroit { clock format 199263600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.62 {time zone boundary case 1976-04-25 03:00:01} detroit { clock format 199263601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.63 {time zone boundary case 1976-10-31 01:59:59} detroit { clock format 215589599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.64 {time zone boundary case 1976-10-31 01:00:00} detroit { clock format 215589600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.65 {time zone boundary case 1976-10-31 01:00:01} detroit { clock format 215589601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.66 {time zone boundary case 1977-04-24 01:59:59} detroit { clock format 230713199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.67 {time zone boundary case 1977-04-24 03:00:00} detroit { clock format 230713200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.68 {time zone boundary case 1977-04-24 03:00:01} detroit { clock format 230713201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.69 {time zone boundary case 1977-10-30 01:59:59} detroit { clock format 247039199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.70 {time zone boundary case 1977-10-30 01:00:00} detroit { clock format 247039200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.71 {time zone boundary case 1977-10-30 01:00:01} detroit { clock format 247039201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.72 {time zone boundary case 1978-04-30 01:59:59} detroit { clock format 262767599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.73 {time zone boundary case 1978-04-30 03:00:00} detroit { clock format 262767600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.74 {time zone boundary case 1978-04-30 03:00:01} detroit { clock format 262767601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.75 {time zone boundary case 1978-10-29 01:59:59} detroit { clock format 278488799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.76 {time zone boundary case 1978-10-29 01:00:00} detroit { clock format 278488800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.77 {time zone boundary case 1978-10-29 01:00:01} detroit { clock format 278488801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.78 {time zone boundary case 1979-04-29 01:59:59} detroit { clock format 294217199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.79 {time zone boundary case 1979-04-29 03:00:00} detroit { clock format 294217200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.80 {time zone boundary case 1979-04-29 03:00:01} detroit { clock format 294217201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.81 {time zone boundary case 1979-10-28 01:59:59} detroit { clock format 309938399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.82 {time zone boundary case 1979-10-28 01:00:00} detroit { clock format 309938400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.83 {time zone boundary case 1979-10-28 01:00:01} detroit { clock format 309938401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.84 {time zone boundary case 1980-04-27 01:59:59} detroit { clock format 325666799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.85 {time zone boundary case 1980-04-27 03:00:00} detroit { clock format 325666800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.86 {time zone boundary case 1980-04-27 03:00:01} detroit { clock format 325666801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.87 {time zone boundary case 1980-10-26 01:59:59} detroit { clock format 341387999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.88 {time zone boundary case 1980-10-26 01:00:00} detroit { clock format 341388000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.89 {time zone boundary case 1980-10-26 01:00:01} detroit { clock format 341388001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.90 {time zone boundary case 1981-04-26 01:59:59} detroit { clock format 357116399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.91 {time zone boundary case 1981-04-26 03:00:00} detroit { clock format 357116400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.92 {time zone boundary case 1981-04-26 03:00:01} detroit { clock format 357116401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.93 {time zone boundary case 1981-10-25 01:59:59} detroit { clock format 372837599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.94 {time zone boundary case 1981-10-25 01:00:00} detroit { clock format 372837600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.95 {time zone boundary case 1981-10-25 01:00:01} detroit { clock format 372837601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.96 {time zone boundary case 1982-04-25 01:59:59} detroit { clock format 388565999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.97 {time zone boundary case 1982-04-25 03:00:00} detroit { clock format 388566000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.98 {time zone boundary case 1982-04-25 03:00:01} detroit { clock format 388566001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.99 {time zone boundary case 1982-10-31 01:59:59} detroit { clock format 404891999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.100 {time zone boundary case 1982-10-31 01:00:00} detroit { clock format 404892000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.101 {time zone boundary case 1982-10-31 01:00:01} detroit { clock format 404892001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.102 {time zone boundary case 1983-04-24 01:59:59} detroit { clock format 420015599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.103 {time zone boundary case 1983-04-24 03:00:00} detroit { clock format 420015600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.104 {time zone boundary case 1983-04-24 03:00:01} detroit { clock format 420015601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.105 {time zone boundary case 1983-10-30 01:59:59} detroit { clock format 436341599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.106 {time zone boundary case 1983-10-30 01:00:00} detroit { clock format 436341600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.107 {time zone boundary case 1983-10-30 01:00:01} detroit { clock format 436341601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.108 {time zone boundary case 1984-04-29 01:59:59} detroit { clock format 452069999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.109 {time zone boundary case 1984-04-29 03:00:00} detroit { clock format 452070000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.110 {time zone boundary case 1984-04-29 03:00:01} detroit { clock format 452070001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.111 {time zone boundary case 1984-10-28 01:59:59} detroit { clock format 467791199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.112 {time zone boundary case 1984-10-28 01:00:00} detroit { clock format 467791200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.113 {time zone boundary case 1984-10-28 01:00:01} detroit { clock format 467791201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.114 {time zone boundary case 1985-04-28 01:59:59} detroit { clock format 483519599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.115 {time zone boundary case 1985-04-28 03:00:00} detroit { clock format 483519600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.116 {time zone boundary case 1985-04-28 03:00:01} detroit { clock format 483519601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.117 {time zone boundary case 1985-10-27 01:59:59} detroit { clock format 499240799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.118 {time zone boundary case 1985-10-27 01:00:00} detroit { clock format 499240800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.119 {time zone boundary case 1985-10-27 01:00:01} detroit { clock format 499240801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.120 {time zone boundary case 1986-04-27 01:59:59} detroit { clock format 514969199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.121 {time zone boundary case 1986-04-27 03:00:00} detroit { clock format 514969200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.122 {time zone boundary case 1986-04-27 03:00:01} detroit { clock format 514969201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.123 {time zone boundary case 1986-10-26 01:59:59} detroit { clock format 530690399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.124 {time zone boundary case 1986-10-26 01:00:00} detroit { clock format 530690400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.125 {time zone boundary case 1986-10-26 01:00:01} detroit { clock format 530690401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.126 {time zone boundary case 1987-04-05 01:59:59} detroit { clock format 544604399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.127 {time zone boundary case 1987-04-05 03:00:00} detroit { clock format 544604400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.128 {time zone boundary case 1987-04-05 03:00:01} detroit { clock format 544604401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.129 {time zone boundary case 1987-10-25 01:59:59} detroit { clock format 562139999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.130 {time zone boundary case 1987-10-25 01:00:00} detroit { clock format 562140000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.131 {time zone boundary case 1987-10-25 01:00:01} detroit { clock format 562140001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.132 {time zone boundary case 1988-04-03 01:59:59} detroit { clock format 576053999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.133 {time zone boundary case 1988-04-03 03:00:00} detroit { clock format 576054000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.134 {time zone boundary case 1988-04-03 03:00:01} detroit { clock format 576054001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.135 {time zone boundary case 1988-10-30 01:59:59} detroit { clock format 594194399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.136 {time zone boundary case 1988-10-30 01:00:00} detroit { clock format 594194400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.137 {time zone boundary case 1988-10-30 01:00:01} detroit { clock format 594194401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.138 {time zone boundary case 1989-04-02 01:59:59} detroit { clock format 607503599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.139 {time zone boundary case 1989-04-02 03:00:00} detroit { clock format 607503600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.140 {time zone boundary case 1989-04-02 03:00:01} detroit { clock format 607503601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.141 {time zone boundary case 1989-10-29 01:59:59} detroit { clock format 625643999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.142 {time zone boundary case 1989-10-29 01:00:00} detroit { clock format 625644000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.143 {time zone boundary case 1989-10-29 01:00:01} detroit { clock format 625644001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.144 {time zone boundary case 1990-04-01 01:59:59} detroit { clock format 638953199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.145 {time zone boundary case 1990-04-01 03:00:00} detroit { clock format 638953200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.146 {time zone boundary case 1990-04-01 03:00:01} detroit { clock format 638953201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.147 {time zone boundary case 1990-10-28 01:59:59} detroit { clock format 657093599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.148 {time zone boundary case 1990-10-28 01:00:00} detroit { clock format 657093600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.149 {time zone boundary case 1990-10-28 01:00:01} detroit { clock format 657093601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.150 {time zone boundary case 1991-04-07 01:59:59} detroit { clock format 671007599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.151 {time zone boundary case 1991-04-07 03:00:00} detroit { clock format 671007600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.152 {time zone boundary case 1991-04-07 03:00:01} detroit { clock format 671007601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.153 {time zone boundary case 1991-10-27 01:59:59} detroit { clock format 688543199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.154 {time zone boundary case 1991-10-27 01:00:00} detroit { clock format 688543200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.155 {time zone boundary case 1991-10-27 01:00:01} detroit { clock format 688543201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.156 {time zone boundary case 1992-04-05 01:59:59} detroit { clock format 702457199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.157 {time zone boundary case 1992-04-05 03:00:00} detroit { clock format 702457200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.158 {time zone boundary case 1992-04-05 03:00:01} detroit { clock format 702457201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.159 {time zone boundary case 1992-10-25 01:59:59} detroit { clock format 719992799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.160 {time zone boundary case 1992-10-25 01:00:00} detroit { clock format 719992800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.161 {time zone boundary case 1992-10-25 01:00:01} detroit { clock format 719992801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.162 {time zone boundary case 1993-04-04 01:59:59} detroit { clock format 733906799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.163 {time zone boundary case 1993-04-04 03:00:00} detroit { clock format 733906800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.164 {time zone boundary case 1993-04-04 03:00:01} detroit { clock format 733906801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.165 {time zone boundary case 1993-10-31 01:59:59} detroit { clock format 752047199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.166 {time zone boundary case 1993-10-31 01:00:00} detroit { clock format 752047200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.167 {time zone boundary case 1993-10-31 01:00:01} detroit { clock format 752047201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.168 {time zone boundary case 1994-04-03 01:59:59} detroit { clock format 765356399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.169 {time zone boundary case 1994-04-03 03:00:00} detroit { clock format 765356400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.170 {time zone boundary case 1994-04-03 03:00:01} detroit { clock format 765356401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.171 {time zone boundary case 1994-10-30 01:59:59} detroit { clock format 783496799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.172 {time zone boundary case 1994-10-30 01:00:00} detroit { clock format 783496800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.173 {time zone boundary case 1994-10-30 01:00:01} detroit { clock format 783496801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.174 {time zone boundary case 1995-04-02 01:59:59} detroit { clock format 796805999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.175 {time zone boundary case 1995-04-02 03:00:00} detroit { clock format 796806000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.176 {time zone boundary case 1995-04-02 03:00:01} detroit { clock format 796806001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.177 {time zone boundary case 1995-10-29 01:59:59} detroit { clock format 814946399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.178 {time zone boundary case 1995-10-29 01:00:00} detroit { clock format 814946400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.179 {time zone boundary case 1995-10-29 01:00:01} detroit { clock format 814946401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.180 {time zone boundary case 1996-04-07 01:59:59} detroit { clock format 828860399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.181 {time zone boundary case 1996-04-07 03:00:00} detroit { clock format 828860400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.182 {time zone boundary case 1996-04-07 03:00:01} detroit { clock format 828860401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.183 {time zone boundary case 1996-10-27 01:59:59} detroit { clock format 846395999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.184 {time zone boundary case 1996-10-27 01:00:00} detroit { clock format 846396000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.185 {time zone boundary case 1996-10-27 01:00:01} detroit { clock format 846396001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.186 {time zone boundary case 1997-04-06 01:59:59} detroit { clock format 860309999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.187 {time zone boundary case 1997-04-06 03:00:00} detroit { clock format 860310000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.188 {time zone boundary case 1997-04-06 03:00:01} detroit { clock format 860310001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.189 {time zone boundary case 1997-10-26 01:59:59} detroit { clock format 877845599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.190 {time zone boundary case 1997-10-26 01:00:00} detroit { clock format 877845600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.191 {time zone boundary case 1997-10-26 01:00:01} detroit { clock format 877845601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.192 {time zone boundary case 1998-04-05 01:59:59} detroit { clock format 891759599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.193 {time zone boundary case 1998-04-05 03:00:00} detroit { clock format 891759600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.194 {time zone boundary case 1998-04-05 03:00:01} detroit { clock format 891759601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.195 {time zone boundary case 1998-10-25 01:59:59} detroit { clock format 909295199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.196 {time zone boundary case 1998-10-25 01:00:00} detroit { clock format 909295200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.197 {time zone boundary case 1998-10-25 01:00:01} detroit { clock format 909295201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.198 {time zone boundary case 1999-04-04 01:59:59} detroit { clock format 923209199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.199 {time zone boundary case 1999-04-04 03:00:00} detroit { clock format 923209200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.200 {time zone boundary case 1999-04-04 03:00:01} detroit { clock format 923209201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.201 {time zone boundary case 1999-10-31 01:59:59} detroit { clock format 941349599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.202 {time zone boundary case 1999-10-31 01:00:00} detroit { clock format 941349600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.203 {time zone boundary case 1999-10-31 01:00:01} detroit { clock format 941349601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.204 {time zone boundary case 2000-04-02 01:59:59} detroit { clock format 954658799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.205 {time zone boundary case 2000-04-02 03:00:00} detroit { clock format 954658800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.206 {time zone boundary case 2000-04-02 03:00:01} detroit { clock format 954658801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.207 {time zone boundary case 2000-10-29 01:59:59} detroit { clock format 972799199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.208 {time zone boundary case 2000-10-29 01:00:00} detroit { clock format 972799200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.209 {time zone boundary case 2000-10-29 01:00:01} detroit { clock format 972799201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.210 {time zone boundary case 2001-04-01 01:59:59} detroit { clock format 986108399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.211 {time zone boundary case 2001-04-01 03:00:00} detroit { clock format 986108400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.212 {time zone boundary case 2001-04-01 03:00:01} detroit { clock format 986108401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.213 {time zone boundary case 2001-10-28 01:59:59} detroit { clock format 1004248799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.214 {time zone boundary case 2001-10-28 01:00:00} detroit { clock format 1004248800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.215 {time zone boundary case 2001-10-28 01:00:01} detroit { clock format 1004248801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.216 {time zone boundary case 2002-04-07 01:59:59} detroit { clock format 1018162799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.217 {time zone boundary case 2002-04-07 03:00:00} detroit { clock format 1018162800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.218 {time zone boundary case 2002-04-07 03:00:01} detroit { clock format 1018162801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.219 {time zone boundary case 2002-10-27 01:59:59} detroit { clock format 1035698399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.220 {time zone boundary case 2002-10-27 01:00:00} detroit { clock format 1035698400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.221 {time zone boundary case 2002-10-27 01:00:01} detroit { clock format 1035698401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.222 {time zone boundary case 2003-04-06 01:59:59} detroit { clock format 1049612399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.223 {time zone boundary case 2003-04-06 03:00:00} detroit { clock format 1049612400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.224 {time zone boundary case 2003-04-06 03:00:01} detroit { clock format 1049612401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.225 {time zone boundary case 2003-10-26 01:59:59} detroit { clock format 1067147999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.226 {time zone boundary case 2003-10-26 01:00:00} detroit { clock format 1067148000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.227 {time zone boundary case 2003-10-26 01:00:01} detroit { clock format 1067148001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.228 {time zone boundary case 2004-04-04 01:59:59} detroit { clock format 1081061999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.229 {time zone boundary case 2004-04-04 03:00:00} detroit { clock format 1081062000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.230 {time zone boundary case 2004-04-04 03:00:01} detroit { clock format 1081062001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.231 {time zone boundary case 2004-10-31 01:59:59} detroit { clock format 1099202399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.232 {time zone boundary case 2004-10-31 01:00:00} detroit { clock format 1099202400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.233 {time zone boundary case 2004-10-31 01:00:01} detroit { clock format 1099202401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.234 {time zone boundary case 2005-04-03 01:59:59} detroit { clock format 1112511599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.235 {time zone boundary case 2005-04-03 03:00:00} detroit { clock format 1112511600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.236 {time zone boundary case 2005-04-03 03:00:01} detroit { clock format 1112511601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.237 {time zone boundary case 2005-10-30 01:59:59} detroit { clock format 1130651999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.238 {time zone boundary case 2005-10-30 01:00:00} detroit { clock format 1130652000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.239 {time zone boundary case 2005-10-30 01:00:01} detroit { clock format 1130652001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.240 {time zone boundary case 2006-04-02 01:59:59} detroit { clock format 1143961199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.241 {time zone boundary case 2006-04-02 03:00:00} detroit { clock format 1143961200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.242 {time zone boundary case 2006-04-02 03:00:01} detroit { clock format 1143961201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.243 {time zone boundary case 2006-10-29 01:59:59} detroit { clock format 1162101599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.244 {time zone boundary case 2006-10-29 01:00:00} detroit { clock format 1162101600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.245 {time zone boundary case 2006-10-29 01:00:01} detroit { clock format 1162101601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.246 {time zone boundary case 2007-03-11 01:59:59} detroit { clock format 1173596399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.247 {time zone boundary case 2007-03-11 03:00:00} detroit { clock format 1173596400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.248 {time zone boundary case 2007-03-11 03:00:01} detroit { clock format 1173596401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.249 {time zone boundary case 2007-11-04 01:59:59} detroit { clock format 1194155999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.250 {time zone boundary case 2007-11-04 01:00:00} detroit { clock format 1194156000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.251 {time zone boundary case 2007-11-04 01:00:01} detroit { clock format 1194156001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.252 {time zone boundary case 2008-03-09 01:59:59} detroit { clock format 1205045999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.253 {time zone boundary case 2008-03-09 03:00:00} detroit { clock format 1205046000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.254 {time zone boundary case 2008-03-09 03:00:01} detroit { clock format 1205046001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.255 {time zone boundary case 2008-11-02 01:59:59} detroit { clock format 1225605599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.256 {time zone boundary case 2008-11-02 01:00:00} detroit { clock format 1225605600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.257 {time zone boundary case 2008-11-02 01:00:01} detroit { clock format 1225605601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.258 {time zone boundary case 2009-03-08 01:59:59} detroit { clock format 1236495599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.259 {time zone boundary case 2009-03-08 03:00:00} detroit { clock format 1236495600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.260 {time zone boundary case 2009-03-08 03:00:01} detroit { clock format 1236495601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.261 {time zone boundary case 2009-11-01 01:59:59} detroit { clock format 1257055199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.262 {time zone boundary case 2009-11-01 01:00:00} detroit { clock format 1257055200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.263 {time zone boundary case 2009-11-01 01:00:01} detroit { clock format 1257055201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.264 {time zone boundary case 2010-03-14 01:59:59} detroit { clock format 1268549999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.265 {time zone boundary case 2010-03-14 03:00:00} detroit { clock format 1268550000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.266 {time zone boundary case 2010-03-14 03:00:01} detroit { clock format 1268550001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.267 {time zone boundary case 2010-11-07 01:59:59} detroit { clock format 1289109599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.268 {time zone boundary case 2010-11-07 01:00:00} detroit { clock format 1289109600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.269 {time zone boundary case 2010-11-07 01:00:01} detroit { clock format 1289109601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.270 {time zone boundary case 2011-03-13 01:59:59} detroit { clock format 1299999599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.271 {time zone boundary case 2011-03-13 03:00:00} detroit { clock format 1299999600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.272 {time zone boundary case 2011-03-13 03:00:01} detroit { clock format 1299999601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.273 {time zone boundary case 2011-11-06 01:59:59} detroit { clock format 1320559199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.274 {time zone boundary case 2011-11-06 01:00:00} detroit { clock format 1320559200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.275 {time zone boundary case 2011-11-06 01:00:01} detroit { clock format 1320559201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.276 {time zone boundary case 2012-03-11 01:59:59} detroit { clock format 1331449199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.277 {time zone boundary case 2012-03-11 03:00:00} detroit { clock format 1331449200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.278 {time zone boundary case 2012-03-11 03:00:01} detroit { clock format 1331449201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.279 {time zone boundary case 2012-11-04 01:59:59} detroit { clock format 1352008799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.280 {time zone boundary case 2012-11-04 01:00:00} detroit { clock format 1352008800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.281 {time zone boundary case 2012-11-04 01:00:01} detroit { clock format 1352008801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.282 {time zone boundary case 2013-03-10 01:59:59} detroit { clock format 1362898799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.283 {time zone boundary case 2013-03-10 03:00:00} detroit { clock format 1362898800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.284 {time zone boundary case 2013-03-10 03:00:01} detroit { clock format 1362898801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.285 {time zone boundary case 2013-11-03 01:59:59} detroit { clock format 1383458399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.286 {time zone boundary case 2013-11-03 01:00:00} detroit { clock format 1383458400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.287 {time zone boundary case 2013-11-03 01:00:01} detroit { clock format 1383458401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.288 {time zone boundary case 2014-03-09 01:59:59} detroit { clock format 1394348399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.289 {time zone boundary case 2014-03-09 03:00:00} detroit { clock format 1394348400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.290 {time zone boundary case 2014-03-09 03:00:01} detroit { clock format 1394348401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.291 {time zone boundary case 2014-11-02 01:59:59} detroit { clock format 1414907999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.292 {time zone boundary case 2014-11-02 01:00:00} detroit { clock format 1414908000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.293 {time zone boundary case 2014-11-02 01:00:01} detroit { clock format 1414908001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.294 {time zone boundary case 2015-03-08 01:59:59} detroit { clock format 1425797999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.295 {time zone boundary case 2015-03-08 03:00:00} detroit { clock format 1425798000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.296 {time zone boundary case 2015-03-08 03:00:01} detroit { clock format 1425798001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.297 {time zone boundary case 2015-11-01 01:59:59} detroit { clock format 1446357599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.298 {time zone boundary case 2015-11-01 01:00:00} detroit { clock format 1446357600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.299 {time zone boundary case 2015-11-01 01:00:01} detroit { clock format 1446357601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.300 {time zone boundary case 2016-03-13 01:59:59} detroit { clock format 1457852399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.301 {time zone boundary case 2016-03-13 03:00:00} detroit { clock format 1457852400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.302 {time zone boundary case 2016-03-13 03:00:01} detroit { clock format 1457852401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.303 {time zone boundary case 2016-11-06 01:59:59} detroit { clock format 1478411999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.304 {time zone boundary case 2016-11-06 01:00:00} detroit { clock format 1478412000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.305 {time zone boundary case 2016-11-06 01:00:01} detroit { clock format 1478412001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.306 {time zone boundary case 2017-03-12 01:59:59} detroit { clock format 1489301999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.307 {time zone boundary case 2017-03-12 03:00:00} detroit { clock format 1489302000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.308 {time zone boundary case 2017-03-12 03:00:01} detroit { clock format 1489302001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.309 {time zone boundary case 2017-11-05 01:59:59} detroit { clock format 1509861599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.310 {time zone boundary case 2017-11-05 01:00:00} detroit { clock format 1509861600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.311 {time zone boundary case 2017-11-05 01:00:01} detroit { clock format 1509861601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.312 {time zone boundary case 2018-03-11 01:59:59} detroit { clock format 1520751599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.313 {time zone boundary case 2018-03-11 03:00:00} detroit { clock format 1520751600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.314 {time zone boundary case 2018-03-11 03:00:01} detroit { clock format 1520751601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.315 {time zone boundary case 2018-11-04 01:59:59} detroit { clock format 1541311199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.316 {time zone boundary case 2018-11-04 01:00:00} detroit { clock format 1541311200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.317 {time zone boundary case 2018-11-04 01:00:01} detroit { clock format 1541311201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.318 {time zone boundary case 2019-03-10 01:59:59} detroit { clock format 1552201199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.319 {time zone boundary case 2019-03-10 03:00:00} detroit { clock format 1552201200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.320 {time zone boundary case 2019-03-10 03:00:01} detroit { clock format 1552201201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.321 {time zone boundary case 2019-11-03 01:59:59} detroit { clock format 1572760799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.322 {time zone boundary case 2019-11-03 01:00:00} detroit { clock format 1572760800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.323 {time zone boundary case 2019-11-03 01:00:01} detroit { clock format 1572760801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.324 {time zone boundary case 2020-03-08 01:59:59} detroit { clock format 1583650799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.325 {time zone boundary case 2020-03-08 03:00:00} detroit { clock format 1583650800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.326 {time zone boundary case 2020-03-08 03:00:01} detroit { clock format 1583650801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.327 {time zone boundary case 2020-11-01 01:59:59} detroit { clock format 1604210399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.328 {time zone boundary case 2020-11-01 01:00:00} detroit { clock format 1604210400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.329 {time zone boundary case 2020-11-01 01:00:01} detroit { clock format 1604210401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.330 {time zone boundary case 2021-03-14 01:59:59} detroit { clock format 1615705199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.331 {time zone boundary case 2021-03-14 03:00:00} detroit { clock format 1615705200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.332 {time zone boundary case 2021-03-14 03:00:01} detroit { clock format 1615705201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.333 {time zone boundary case 2021-11-07 01:59:59} detroit { clock format 1636264799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.334 {time zone boundary case 2021-11-07 01:00:00} detroit { clock format 1636264800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.335 {time zone boundary case 2021-11-07 01:00:01} detroit { clock format 1636264801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.336 {time zone boundary case 2022-03-13 01:59:59} detroit { clock format 1647154799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.337 {time zone boundary case 2022-03-13 03:00:00} detroit { clock format 1647154800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.338 {time zone boundary case 2022-03-13 03:00:01} detroit { clock format 1647154801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.339 {time zone boundary case 2022-11-06 01:59:59} detroit { clock format 1667714399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.340 {time zone boundary case 2022-11-06 01:00:00} detroit { clock format 1667714400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.341 {time zone boundary case 2022-11-06 01:00:01} detroit { clock format 1667714401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.342 {time zone boundary case 2023-03-12 01:59:59} detroit { clock format 1678604399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.343 {time zone boundary case 2023-03-12 03:00:00} detroit { clock format 1678604400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.344 {time zone boundary case 2023-03-12 03:00:01} detroit { clock format 1678604401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.345 {time zone boundary case 2023-11-05 01:59:59} detroit { clock format 1699163999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.346 {time zone boundary case 2023-11-05 01:00:00} detroit { clock format 1699164000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.347 {time zone boundary case 2023-11-05 01:00:01} detroit { clock format 1699164001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.348 {time zone boundary case 2024-03-10 01:59:59} detroit { clock format 1710053999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.349 {time zone boundary case 2024-03-10 03:00:00} detroit { clock format 1710054000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.350 {time zone boundary case 2024-03-10 03:00:01} detroit { clock format 1710054001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.351 {time zone boundary case 2024-11-03 01:59:59} detroit { clock format 1730613599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.352 {time zone boundary case 2024-11-03 01:00:00} detroit { clock format 1730613600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.353 {time zone boundary case 2024-11-03 01:00:01} detroit { clock format 1730613601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.354 {time zone boundary case 2025-03-09 01:59:59} detroit { clock format 1741503599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.355 {time zone boundary case 2025-03-09 03:00:00} detroit { clock format 1741503600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.356 {time zone boundary case 2025-03-09 03:00:01} detroit { clock format 1741503601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.357 {time zone boundary case 2025-11-02 01:59:59} detroit { clock format 1762063199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.358 {time zone boundary case 2025-11-02 01:00:00} detroit { clock format 1762063200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.359 {time zone boundary case 2025-11-02 01:00:01} detroit { clock format 1762063201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.360 {time zone boundary case 2026-03-08 01:59:59} detroit { clock format 1772953199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.361 {time zone boundary case 2026-03-08 03:00:00} detroit { clock format 1772953200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.362 {time zone boundary case 2026-03-08 03:00:01} detroit { clock format 1772953201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.363 {time zone boundary case 2026-11-01 01:59:59} detroit { clock format 1793512799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.364 {time zone boundary case 2026-11-01 01:00:00} detroit { clock format 1793512800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.365 {time zone boundary case 2026-11-01 01:00:01} detroit { clock format 1793512801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.366 {time zone boundary case 2027-03-14 01:59:59} detroit { clock format 1805007599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.367 {time zone boundary case 2027-03-14 03:00:00} detroit { clock format 1805007600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.368 {time zone boundary case 2027-03-14 03:00:01} detroit { clock format 1805007601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.369 {time zone boundary case 2027-11-07 01:59:59} detroit { clock format 1825567199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.370 {time zone boundary case 2027-11-07 01:00:00} detroit { clock format 1825567200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.371 {time zone boundary case 2027-11-07 01:00:01} detroit { clock format 1825567201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.372 {time zone boundary case 2028-03-12 01:59:59} detroit { clock format 1836457199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.373 {time zone boundary case 2028-03-12 03:00:00} detroit { clock format 1836457200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.374 {time zone boundary case 2028-03-12 03:00:01} detroit { clock format 1836457201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.375 {time zone boundary case 2028-11-05 01:59:59} detroit { clock format 1857016799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.376 {time zone boundary case 2028-11-05 01:00:00} detroit { clock format 1857016800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.377 {time zone boundary case 2028-11-05 01:00:01} detroit { clock format 1857016801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.378 {time zone boundary case 2029-03-11 01:59:59} detroit { clock format 1867906799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.379 {time zone boundary case 2029-03-11 03:00:00} detroit { clock format 1867906800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.380 {time zone boundary case 2029-03-11 03:00:01} detroit { clock format 1867906801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.381 {time zone boundary case 2029-11-04 01:59:59} detroit { clock format 1888466399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.382 {time zone boundary case 2029-11-04 01:00:00} detroit { clock format 1888466400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.383 {time zone boundary case 2029-11-04 01:00:01} detroit { clock format 1888466401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.384 {time zone boundary case 2030-03-10 01:59:59} detroit { clock format 1899356399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.385 {time zone boundary case 2030-03-10 03:00:00} detroit { clock format 1899356400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.386 {time zone boundary case 2030-03-10 03:00:01} detroit { clock format 1899356401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.387 {time zone boundary case 2030-11-03 01:59:59} detroit { clock format 1919915999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.388 {time zone boundary case 2030-11-03 01:00:00} detroit { clock format 1919916000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.389 {time zone boundary case 2030-11-03 01:00:01} detroit { clock format 1919916001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.390 {time zone boundary case 2031-03-09 01:59:59} detroit { clock format 1930805999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.391 {time zone boundary case 2031-03-09 03:00:00} detroit { clock format 1930806000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.392 {time zone boundary case 2031-03-09 03:00:01} detroit { clock format 1930806001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.393 {time zone boundary case 2031-11-02 01:59:59} detroit { clock format 1951365599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.394 {time zone boundary case 2031-11-02 01:00:00} detroit { clock format 1951365600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.395 {time zone boundary case 2031-11-02 01:00:01} detroit { clock format 1951365601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.396 {time zone boundary case 2032-03-14 01:59:59} detroit { clock format 1962860399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.397 {time zone boundary case 2032-03-14 03:00:00} detroit { clock format 1962860400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.398 {time zone boundary case 2032-03-14 03:00:01} detroit { clock format 1962860401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.399 {time zone boundary case 2032-11-07 01:59:59} detroit { clock format 1983419999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.400 {time zone boundary case 2032-11-07 01:00:00} detroit { clock format 1983420000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.401 {time zone boundary case 2032-11-07 01:00:01} detroit { clock format 1983420001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.402 {time zone boundary case 2033-03-13 01:59:59} detroit { clock format 1994309999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.403 {time zone boundary case 2033-03-13 03:00:00} detroit { clock format 1994310000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.404 {time zone boundary case 2033-03-13 03:00:01} detroit { clock format 1994310001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.405 {time zone boundary case 2033-11-06 01:59:59} detroit { clock format 2014869599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.406 {time zone boundary case 2033-11-06 01:00:00} detroit { clock format 2014869600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.407 {time zone boundary case 2033-11-06 01:00:01} detroit { clock format 2014869601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.408 {time zone boundary case 2034-03-12 01:59:59} detroit { clock format 2025759599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.409 {time zone boundary case 2034-03-12 03:00:00} detroit { clock format 2025759600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.410 {time zone boundary case 2034-03-12 03:00:01} detroit { clock format 2025759601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.411 {time zone boundary case 2034-11-05 01:59:59} detroit { clock format 2046319199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.412 {time zone boundary case 2034-11-05 01:00:00} detroit { clock format 2046319200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.413 {time zone boundary case 2034-11-05 01:00:01} detroit { clock format 2046319201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.414 {time zone boundary case 2035-03-11 01:59:59} detroit { clock format 2057209199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.415 {time zone boundary case 2035-03-11 03:00:00} detroit { clock format 2057209200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.416 {time zone boundary case 2035-03-11 03:00:01} detroit { clock format 2057209201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.417 {time zone boundary case 2035-11-04 01:59:59} detroit { clock format 2077768799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.418 {time zone boundary case 2035-11-04 01:00:00} detroit { clock format 2077768800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.419 {time zone boundary case 2035-11-04 01:00:01} detroit { clock format 2077768801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.420 {time zone boundary case 2036-03-09 01:59:59} detroit { clock format 2088658799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.421 {time zone boundary case 2036-03-09 03:00:00} detroit { clock format 2088658800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.422 {time zone boundary case 2036-03-09 03:00:01} detroit { clock format 2088658801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.423 {time zone boundary case 2036-11-02 01:59:59} detroit { clock format 2109218399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.424 {time zone boundary case 2036-11-02 01:00:00} detroit { clock format 2109218400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.425 {time zone boundary case 2036-11-02 01:00:01} detroit { clock format 2109218401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.426 {time zone boundary case 2037-03-08 01:59:59} detroit { clock format 2120108399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.427 {time zone boundary case 2037-03-08 03:00:00} detroit { clock format 2120108400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.428 {time zone boundary case 2037-03-08 03:00:01} detroit { clock format 2120108401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.429 {time zone boundary case 2037-11-01 01:59:59} detroit { clock format 2140667999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.430 {time zone boundary case 2037-11-01 01:00:00} detroit { clock format 2140668000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.431 {time zone boundary case 2037-11-01 01:00:01} detroit { clock format 2140668001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.432 {time zone boundary case 2038-03-14 01:59:59} {detroit y2038} { clock format 2152162799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.433 {time zone boundary case 2038-03-14 03:00:00} {detroit y2038} { clock format 2152162800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.434 {time zone boundary case 2038-03-14 03:00:01} {detroit y2038} { clock format 2152162801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.435 {time zone boundary case 2038-11-07 01:59:59} {detroit y2038} { clock format 2172722399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.436 {time zone boundary case 2038-11-07 01:00:00} {detroit y2038} { clock format 2172722400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.437 {time zone boundary case 2038-11-07 01:00:01} {detroit y2038} { clock format 2172722401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.438 {time zone boundary case 2039-03-13 01:59:59} {detroit y2038} { clock format 2183612399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.439 {time zone boundary case 2039-03-13 03:00:00} {detroit y2038} { clock format 2183612400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.440 {time zone boundary case 2039-03-13 03:00:01} {detroit y2038} { clock format 2183612401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.441 {time zone boundary case 2039-11-06 01:59:59} {detroit y2038} { clock format 2204171999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.442 {time zone boundary case 2039-11-06 01:00:00} {detroit y2038} { clock format 2204172000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.443 {time zone boundary case 2039-11-06 01:00:01} {detroit y2038} { clock format 2204172001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.444 {time zone boundary case 2040-03-11 01:59:59} {detroit y2038} { clock format 2215061999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.445 {time zone boundary case 2040-03-11 03:00:00} {detroit y2038} { clock format 2215062000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.446 {time zone boundary case 2040-03-11 03:00:01} {detroit y2038} { clock format 2215062001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.447 {time zone boundary case 2040-11-04 01:59:59} {detroit y2038} { clock format 2235621599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.448 {time zone boundary case 2040-11-04 01:00:00} {detroit y2038} { clock format 2235621600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.449 {time zone boundary case 2040-11-04 01:00:01} {detroit y2038} { clock format 2235621601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.450 {time zone boundary case 2041-03-10 01:59:59} {detroit y2038} { clock format 2246511599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.451 {time zone boundary case 2041-03-10 03:00:00} {detroit y2038} { clock format 2246511600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.452 {time zone boundary case 2041-03-10 03:00:01} {detroit y2038} { clock format 2246511601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.453 {time zone boundary case 2041-11-03 01:59:59} {detroit y2038} { clock format 2267071199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.454 {time zone boundary case 2041-11-03 01:00:00} {detroit y2038} { clock format 2267071200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.455 {time zone boundary case 2041-11-03 01:00:01} {detroit y2038} { clock format 2267071201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.456 {time zone boundary case 2042-03-09 01:59:59} {detroit y2038} { clock format 2277961199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.457 {time zone boundary case 2042-03-09 03:00:00} {detroit y2038} { clock format 2277961200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.458 {time zone boundary case 2042-03-09 03:00:01} {detroit y2038} { clock format 2277961201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.459 {time zone boundary case 2042-11-02 01:59:59} {detroit y2038} { clock format 2298520799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.460 {time zone boundary case 2042-11-02 01:00:00} {detroit y2038} { clock format 2298520800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.461 {time zone boundary case 2042-11-02 01:00:01} {detroit y2038} { clock format 2298520801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.462 {time zone boundary case 2043-03-08 01:59:59} {detroit y2038} { clock format 2309410799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.463 {time zone boundary case 2043-03-08 03:00:00} {detroit y2038} { clock format 2309410800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.464 {time zone boundary case 2043-03-08 03:00:01} {detroit y2038} { clock format 2309410801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.465 {time zone boundary case 2043-11-01 01:59:59} {detroit y2038} { clock format 2329970399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.466 {time zone boundary case 2043-11-01 01:00:00} {detroit y2038} { clock format 2329970400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.467 {time zone boundary case 2043-11-01 01:00:01} {detroit y2038} { clock format 2329970401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.468 {time zone boundary case 2044-03-13 01:59:59} {detroit y2038} { clock format 2341465199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.469 {time zone boundary case 2044-03-13 03:00:00} {detroit y2038} { clock format 2341465200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.470 {time zone boundary case 2044-03-13 03:00:01} {detroit y2038} { clock format 2341465201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.471 {time zone boundary case 2044-11-06 01:59:59} {detroit y2038} { clock format 2362024799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.472 {time zone boundary case 2044-11-06 01:00:00} {detroit y2038} { clock format 2362024800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.473 {time zone boundary case 2044-11-06 01:00:01} {detroit y2038} { clock format 2362024801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.474 {time zone boundary case 2045-03-12 01:59:59} {detroit y2038} { clock format 2372914799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.475 {time zone boundary case 2045-03-12 03:00:00} {detroit y2038} { clock format 2372914800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.476 {time zone boundary case 2045-03-12 03:00:01} {detroit y2038} { clock format 2372914801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.477 {time zone boundary case 2045-11-05 01:59:59} {detroit y2038} { clock format 2393474399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.478 {time zone boundary case 2045-11-05 01:00:00} {detroit y2038} { clock format 2393474400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.479 {time zone boundary case 2045-11-05 01:00:01} {detroit y2038} { clock format 2393474401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.480 {time zone boundary case 2046-03-11 01:59:59} {detroit y2038} { clock format 2404364399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.481 {time zone boundary case 2046-03-11 03:00:00} {detroit y2038} { clock format 2404364400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.482 {time zone boundary case 2046-03-11 03:00:01} {detroit y2038} { clock format 2404364401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.483 {time zone boundary case 2046-11-04 01:59:59} {detroit y2038} { clock format 2424923999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.484 {time zone boundary case 2046-11-04 01:00:00} {detroit y2038} { clock format 2424924000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.485 {time zone boundary case 2046-11-04 01:00:01} {detroit y2038} { clock format 2424924001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.486 {time zone boundary case 2047-03-10 01:59:59} {detroit y2038} { clock format 2435813999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.487 {time zone boundary case 2047-03-10 03:00:00} {detroit y2038} { clock format 2435814000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.488 {time zone boundary case 2047-03-10 03:00:01} {detroit y2038} { clock format 2435814001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.489 {time zone boundary case 2047-11-03 01:59:59} {detroit y2038} { clock format 2456373599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.490 {time zone boundary case 2047-11-03 01:00:00} {detroit y2038} { clock format 2456373600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.491 {time zone boundary case 2047-11-03 01:00:01} {detroit y2038} { clock format 2456373601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.492 {time zone boundary case 2048-03-08 01:59:59} {detroit y2038} { clock format 2467263599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.493 {time zone boundary case 2048-03-08 03:00:00} {detroit y2038} { clock format 2467263600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.494 {time zone boundary case 2048-03-08 03:00:01} {detroit y2038} { clock format 2467263601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.495 {time zone boundary case 2048-11-01 01:59:59} {detroit y2038} { clock format 2487823199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.496 {time zone boundary case 2048-11-01 01:00:00} {detroit y2038} { clock format 2487823200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.497 {time zone boundary case 2048-11-01 01:00:01} {detroit y2038} { clock format 2487823201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.498 {time zone boundary case 2049-03-14 01:59:59} {detroit y2038} { clock format 2499317999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.499 {time zone boundary case 2049-03-14 03:00:00} {detroit y2038} { clock format 2499318000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.500 {time zone boundary case 2049-03-14 03:00:01} {detroit y2038} { clock format 2499318001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.501 {time zone boundary case 2049-11-07 01:59:59} {detroit y2038} { clock format 2519877599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.502 {time zone boundary case 2049-11-07 01:00:00} {detroit y2038} { clock format 2519877600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.503 {time zone boundary case 2049-11-07 01:00:01} {detroit y2038} { clock format 2519877601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.504 {time zone boundary case 2050-03-13 01:59:59} {detroit y2038} { clock format 2530767599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.505 {time zone boundary case 2050-03-13 03:00:00} {detroit y2038} { clock format 2530767600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.506 {time zone boundary case 2050-03-13 03:00:01} {detroit y2038} { clock format 2530767601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.507 {time zone boundary case 2050-11-06 01:59:59} {detroit y2038} { clock format 2551327199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.508 {time zone boundary case 2050-11-06 01:00:00} {detroit y2038} { clock format 2551327200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.509 {time zone boundary case 2050-11-06 01:00:01} {detroit y2038} { clock format 2551327201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.510 {time zone boundary case 2051-03-12 01:59:59} {detroit y2038} { clock format 2562217199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.511 {time zone boundary case 2051-03-12 03:00:00} {detroit y2038} { clock format 2562217200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.512 {time zone boundary case 2051-03-12 03:00:01} {detroit y2038} { clock format 2562217201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.513 {time zone boundary case 2051-11-05 01:59:59} {detroit y2038} { clock format 2582776799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.514 {time zone boundary case 2051-11-05 01:00:00} {detroit y2038} { clock format 2582776800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.515 {time zone boundary case 2051-11-05 01:00:01} {detroit y2038} { clock format 2582776801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.516 {time zone boundary case 2052-03-10 01:59:59} {detroit y2038} { clock format 2593666799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.517 {time zone boundary case 2052-03-10 03:00:00} {detroit y2038} { clock format 2593666800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.518 {time zone boundary case 2052-03-10 03:00:01} {detroit y2038} { clock format 2593666801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.519 {time zone boundary case 2052-11-03 01:59:59} {detroit y2038} { clock format 2614226399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.520 {time zone boundary case 2052-11-03 01:00:00} {detroit y2038} { clock format 2614226400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.521 {time zone boundary case 2052-11-03 01:00:01} {detroit y2038} { clock format 2614226401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.522 {time zone boundary case 2053-03-09 01:59:59} {detroit y2038} { clock format 2625116399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.523 {time zone boundary case 2053-03-09 03:00:00} {detroit y2038} { clock format 2625116400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.524 {time zone boundary case 2053-03-09 03:00:01} {detroit y2038} { clock format 2625116401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.525 {time zone boundary case 2053-11-02 01:59:59} {detroit y2038} { clock format 2645675999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.526 {time zone boundary case 2053-11-02 01:00:00} {detroit y2038} { clock format 2645676000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.527 {time zone boundary case 2053-11-02 01:00:01} {detroit y2038} { clock format 2645676001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.528 {time zone boundary case 2054-03-08 01:59:59} {detroit y2038} { clock format 2656565999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.529 {time zone boundary case 2054-03-08 03:00:00} {detroit y2038} { clock format 2656566000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.530 {time zone boundary case 2054-03-08 03:00:01} {detroit y2038} { clock format 2656566001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.531 {time zone boundary case 2054-11-01 01:59:59} {detroit y2038} { clock format 2677125599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.532 {time zone boundary case 2054-11-01 01:00:00} {detroit y2038} { clock format 2677125600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.533 {time zone boundary case 2054-11-01 01:00:01} {detroit y2038} { clock format 2677125601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.534 {time zone boundary case 2055-03-14 01:59:59} {detroit y2038} { clock format 2688620399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.535 {time zone boundary case 2055-03-14 03:00:00} {detroit y2038} { clock format 2688620400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.536 {time zone boundary case 2055-03-14 03:00:01} {detroit y2038} { clock format 2688620401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.537 {time zone boundary case 2055-11-07 01:59:59} {detroit y2038} { clock format 2709179999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.538 {time zone boundary case 2055-11-07 01:00:00} {detroit y2038} { clock format 2709180000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.539 {time zone boundary case 2055-11-07 01:00:01} {detroit y2038} { clock format 2709180001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.540 {time zone boundary case 2056-03-12 01:59:59} {detroit y2038} { clock format 2720069999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.541 {time zone boundary case 2056-03-12 03:00:00} {detroit y2038} { clock format 2720070000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.542 {time zone boundary case 2056-03-12 03:00:01} {detroit y2038} { clock format 2720070001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.543 {time zone boundary case 2056-11-05 01:59:59} {detroit y2038} { clock format 2740629599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.544 {time zone boundary case 2056-11-05 01:00:00} {detroit y2038} { clock format 2740629600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.545 {time zone boundary case 2056-11-05 01:00:01} {detroit y2038} { clock format 2740629601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.546 {time zone boundary case 2057-03-11 01:59:59} {detroit y2038} { clock format 2751519599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.547 {time zone boundary case 2057-03-11 03:00:00} {detroit y2038} { clock format 2751519600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.548 {time zone boundary case 2057-03-11 03:00:01} {detroit y2038} { clock format 2751519601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.549 {time zone boundary case 2057-11-04 01:59:59} {detroit y2038} { clock format 2772079199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.550 {time zone boundary case 2057-11-04 01:00:00} {detroit y2038} { clock format 2772079200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.551 {time zone boundary case 2057-11-04 01:00:01} {detroit y2038} { clock format 2772079201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.552 {time zone boundary case 2058-03-10 01:59:59} {detroit y2038} { clock format 2782969199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.553 {time zone boundary case 2058-03-10 03:00:00} {detroit y2038} { clock format 2782969200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.554 {time zone boundary case 2058-03-10 03:00:01} {detroit y2038} { clock format 2782969201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.555 {time zone boundary case 2058-11-03 01:59:59} {detroit y2038} { clock format 2803528799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.556 {time zone boundary case 2058-11-03 01:00:00} {detroit y2038} { clock format 2803528800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.557 {time zone boundary case 2058-11-03 01:00:01} {detroit y2038} { clock format 2803528801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.558 {time zone boundary case 2059-03-09 01:59:59} {detroit y2038} { clock format 2814418799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.559 {time zone boundary case 2059-03-09 03:00:00} {detroit y2038} { clock format 2814418800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.560 {time zone boundary case 2059-03-09 03:00:01} {detroit y2038} { clock format 2814418801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.561 {time zone boundary case 2059-11-02 01:59:59} {detroit y2038} { clock format 2834978399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.562 {time zone boundary case 2059-11-02 01:00:00} {detroit y2038} { clock format 2834978400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.563 {time zone boundary case 2059-11-02 01:00:01} {detroit y2038} { clock format 2834978401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.564 {time zone boundary case 2060-03-14 01:59:59} {detroit y2038} { clock format 2846473199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.565 {time zone boundary case 2060-03-14 03:00:00} {detroit y2038} { clock format 2846473200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.566 {time zone boundary case 2060-03-14 03:00:01} {detroit y2038} { clock format 2846473201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.567 {time zone boundary case 2060-11-07 01:59:59} {detroit y2038} { clock format 2867032799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.568 {time zone boundary case 2060-11-07 01:00:00} {detroit y2038} { clock format 2867032800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.569 {time zone boundary case 2060-11-07 01:00:01} {detroit y2038} { clock format 2867032801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.570 {time zone boundary case 2061-03-13 01:59:59} {detroit y2038} { clock format 2877922799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.571 {time zone boundary case 2061-03-13 03:00:00} {detroit y2038} { clock format 2877922800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.572 {time zone boundary case 2061-03-13 03:00:01} {detroit y2038} { clock format 2877922801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.573 {time zone boundary case 2061-11-06 01:59:59} {detroit y2038} { clock format 2898482399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.574 {time zone boundary case 2061-11-06 01:00:00} {detroit y2038} { clock format 2898482400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.575 {time zone boundary case 2061-11-06 01:00:01} {detroit y2038} { clock format 2898482401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.576 {time zone boundary case 2062-03-12 01:59:59} {detroit y2038} { clock format 2909372399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.577 {time zone boundary case 2062-03-12 03:00:00} {detroit y2038} { clock format 2909372400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.578 {time zone boundary case 2062-03-12 03:00:01} {detroit y2038} { clock format 2909372401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.579 {time zone boundary case 2062-11-05 01:59:59} {detroit y2038} { clock format 2929931999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.580 {time zone boundary case 2062-11-05 01:00:00} {detroit y2038} { clock format 2929932000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.581 {time zone boundary case 2062-11-05 01:00:01} {detroit y2038} { clock format 2929932001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.582 {time zone boundary case 2063-03-11 01:59:59} {detroit y2038} { clock format 2940821999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.583 {time zone boundary case 2063-03-11 03:00:00} {detroit y2038} { clock format 2940822000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.584 {time zone boundary case 2063-03-11 03:00:01} {detroit y2038} { clock format 2940822001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.585 {time zone boundary case 2063-11-04 01:59:59} {detroit y2038} { clock format 2961381599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.586 {time zone boundary case 2063-11-04 01:00:00} {detroit y2038} { clock format 2961381600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.587 {time zone boundary case 2063-11-04 01:00:01} {detroit y2038} { clock format 2961381601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.588 {time zone boundary case 2064-03-09 01:59:59} {detroit y2038} { clock format 2972271599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.589 {time zone boundary case 2064-03-09 03:00:00} {detroit y2038} { clock format 2972271600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.590 {time zone boundary case 2064-03-09 03:00:01} {detroit y2038} { clock format 2972271601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.591 {time zone boundary case 2064-11-02 01:59:59} {detroit y2038} { clock format 2992831199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.592 {time zone boundary case 2064-11-02 01:00:00} {detroit y2038} { clock format 2992831200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.593 {time zone boundary case 2064-11-02 01:00:01} {detroit y2038} { clock format 2992831201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.594 {time zone boundary case 2065-03-08 01:59:59} {detroit y2038} { clock format 3003721199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.595 {time zone boundary case 2065-03-08 03:00:00} {detroit y2038} { clock format 3003721200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.596 {time zone boundary case 2065-03-08 03:00:01} {detroit y2038} { clock format 3003721201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.597 {time zone boundary case 2065-11-01 01:59:59} {detroit y2038} { clock format 3024280799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.598 {time zone boundary case 2065-11-01 01:00:00} {detroit y2038} { clock format 3024280800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.599 {time zone boundary case 2065-11-01 01:00:01} {detroit y2038} { clock format 3024280801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.600 {time zone boundary case 2066-03-14 01:59:59} {detroit y2038} { clock format 3035775599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.601 {time zone boundary case 2066-03-14 03:00:00} {detroit y2038} { clock format 3035775600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.602 {time zone boundary case 2066-03-14 03:00:01} {detroit y2038} { clock format 3035775601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.603 {time zone boundary case 2066-11-07 01:59:59} {detroit y2038} { clock format 3056335199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.604 {time zone boundary case 2066-11-07 01:00:00} {detroit y2038} { clock format 3056335200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.605 {time zone boundary case 2066-11-07 01:00:01} {detroit y2038} { clock format 3056335201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.606 {time zone boundary case 2067-03-13 01:59:59} {detroit y2038} { clock format 3067225199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.607 {time zone boundary case 2067-03-13 03:00:00} {detroit y2038} { clock format 3067225200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.608 {time zone boundary case 2067-03-13 03:00:01} {detroit y2038} { clock format 3067225201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.609 {time zone boundary case 2067-11-06 01:59:59} {detroit y2038} { clock format 3087784799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.610 {time zone boundary case 2067-11-06 01:00:00} {detroit y2038} { clock format 3087784800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.611 {time zone boundary case 2067-11-06 01:00:01} {detroit y2038} { clock format 3087784801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.612 {time zone boundary case 2068-03-11 01:59:59} {detroit y2038} { clock format 3098674799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.613 {time zone boundary case 2068-03-11 03:00:00} {detroit y2038} { clock format 3098674800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.614 {time zone boundary case 2068-03-11 03:00:01} {detroit y2038} { clock format 3098674801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.615 {time zone boundary case 2068-11-04 01:59:59} {detroit y2038} { clock format 3119234399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.616 {time zone boundary case 2068-11-04 01:00:00} {detroit y2038} { clock format 3119234400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.617 {time zone boundary case 2068-11-04 01:00:01} {detroit y2038} { clock format 3119234401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.618 {time zone boundary case 2069-03-10 01:59:59} {detroit y2038} { clock format 3130124399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.619 {time zone boundary case 2069-03-10 03:00:00} {detroit y2038} { clock format 3130124400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.620 {time zone boundary case 2069-03-10 03:00:01} {detroit y2038} { clock format 3130124401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.621 {time zone boundary case 2069-11-03 01:59:59} {detroit y2038} { clock format 3150683999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.622 {time zone boundary case 2069-11-03 01:00:00} {detroit y2038} { clock format 3150684000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.623 {time zone boundary case 2069-11-03 01:00:01} {detroit y2038} { clock format 3150684001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.624 {time zone boundary case 2070-03-09 01:59:59} {detroit y2038} { clock format 3161573999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.625 {time zone boundary case 2070-03-09 03:00:00} {detroit y2038} { clock format 3161574000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.626 {time zone boundary case 2070-03-09 03:00:01} {detroit y2038} { clock format 3161574001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.627 {time zone boundary case 2070-11-02 01:59:59} {detroit y2038} { clock format 3182133599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.628 {time zone boundary case 2070-11-02 01:00:00} {detroit y2038} { clock format 3182133600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.629 {time zone boundary case 2070-11-02 01:00:01} {detroit y2038} { clock format 3182133601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.630 {time zone boundary case 2071-03-08 01:59:59} {detroit y2038} { clock format 3193023599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.631 {time zone boundary case 2071-03-08 03:00:00} {detroit y2038} { clock format 3193023600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.632 {time zone boundary case 2071-03-08 03:00:01} {detroit y2038} { clock format 3193023601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.633 {time zone boundary case 2071-11-01 01:59:59} {detroit y2038} { clock format 3213583199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.634 {time zone boundary case 2071-11-01 01:00:00} {detroit y2038} { clock format 3213583200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.635 {time zone boundary case 2071-11-01 01:00:01} {detroit y2038} { clock format 3213583201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.636 {time zone boundary case 2072-03-13 01:59:59} {detroit y2038} { clock format 3225077999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.637 {time zone boundary case 2072-03-13 03:00:00} {detroit y2038} { clock format 3225078000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.638 {time zone boundary case 2072-03-13 03:00:01} {detroit y2038} { clock format 3225078001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.639 {time zone boundary case 2072-11-06 01:59:59} {detroit y2038} { clock format 3245637599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.640 {time zone boundary case 2072-11-06 01:00:00} {detroit y2038} { clock format 3245637600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.641 {time zone boundary case 2072-11-06 01:00:01} {detroit y2038} { clock format 3245637601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.642 {time zone boundary case 2073-03-12 01:59:59} {detroit y2038} { clock format 3256527599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.643 {time zone boundary case 2073-03-12 03:00:00} {detroit y2038} { clock format 3256527600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.644 {time zone boundary case 2073-03-12 03:00:01} {detroit y2038} { clock format 3256527601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.645 {time zone boundary case 2073-11-05 01:59:59} {detroit y2038} { clock format 3277087199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.646 {time zone boundary case 2073-11-05 01:00:00} {detroit y2038} { clock format 3277087200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.647 {time zone boundary case 2073-11-05 01:00:01} {detroit y2038} { clock format 3277087201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.648 {time zone boundary case 2074-03-11 01:59:59} {detroit y2038} { clock format 3287977199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.649 {time zone boundary case 2074-03-11 03:00:00} {detroit y2038} { clock format 3287977200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.650 {time zone boundary case 2074-03-11 03:00:01} {detroit y2038} { clock format 3287977201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.651 {time zone boundary case 2074-11-04 01:59:59} {detroit y2038} { clock format 3308536799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.652 {time zone boundary case 2074-11-04 01:00:00} {detroit y2038} { clock format 3308536800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.653 {time zone boundary case 2074-11-04 01:00:01} {detroit y2038} { clock format 3308536801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.654 {time zone boundary case 2075-03-10 01:59:59} {detroit y2038} { clock format 3319426799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.655 {time zone boundary case 2075-03-10 03:00:00} {detroit y2038} { clock format 3319426800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.656 {time zone boundary case 2075-03-10 03:00:01} {detroit y2038} { clock format 3319426801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.657 {time zone boundary case 2075-11-03 01:59:59} {detroit y2038} { clock format 3339986399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.658 {time zone boundary case 2075-11-03 01:00:00} {detroit y2038} { clock format 3339986400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.659 {time zone boundary case 2075-11-03 01:00:01} {detroit y2038} { clock format 3339986401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.660 {time zone boundary case 2076-03-08 01:59:59} {detroit y2038} { clock format 3350876399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.661 {time zone boundary case 2076-03-08 03:00:00} {detroit y2038} { clock format 3350876400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.662 {time zone boundary case 2076-03-08 03:00:01} {detroit y2038} { clock format 3350876401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.663 {time zone boundary case 2076-11-01 01:59:59} {detroit y2038} { clock format 3371435999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.664 {time zone boundary case 2076-11-01 01:00:00} {detroit y2038} { clock format 3371436000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.665 {time zone boundary case 2076-11-01 01:00:01} {detroit y2038} { clock format 3371436001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.666 {time zone boundary case 2077-03-14 01:59:59} {detroit y2038} { clock format 3382930799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.667 {time zone boundary case 2077-03-14 03:00:00} {detroit y2038} { clock format 3382930800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.668 {time zone boundary case 2077-03-14 03:00:01} {detroit y2038} { clock format 3382930801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.669 {time zone boundary case 2077-11-07 01:59:59} {detroit y2038} { clock format 3403490399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.670 {time zone boundary case 2077-11-07 01:00:00} {detroit y2038} { clock format 3403490400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.671 {time zone boundary case 2077-11-07 01:00:01} {detroit y2038} { clock format 3403490401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.672 {time zone boundary case 2078-03-13 01:59:59} {detroit y2038} { clock format 3414380399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.673 {time zone boundary case 2078-03-13 03:00:00} {detroit y2038} { clock format 3414380400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.674 {time zone boundary case 2078-03-13 03:00:01} {detroit y2038} { clock format 3414380401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.675 {time zone boundary case 2078-11-06 01:59:59} {detroit y2038} { clock format 3434939999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.676 {time zone boundary case 2078-11-06 01:00:00} {detroit y2038} { clock format 3434940000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.677 {time zone boundary case 2078-11-06 01:00:01} {detroit y2038} { clock format 3434940001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.678 {time zone boundary case 2079-03-12 01:59:59} {detroit y2038} { clock format 3445829999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.679 {time zone boundary case 2079-03-12 03:00:00} {detroit y2038} { clock format 3445830000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.680 {time zone boundary case 2079-03-12 03:00:01} {detroit y2038} { clock format 3445830001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.681 {time zone boundary case 2079-11-05 01:59:59} {detroit y2038} { clock format 3466389599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.682 {time zone boundary case 2079-11-05 01:00:00} {detroit y2038} { clock format 3466389600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.683 {time zone boundary case 2079-11-05 01:00:01} {detroit y2038} { clock format 3466389601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.684 {time zone boundary case 2080-03-10 01:59:59} {detroit y2038} { clock format 3477279599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.685 {time zone boundary case 2080-03-10 03:00:00} {detroit y2038} { clock format 3477279600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.686 {time zone boundary case 2080-03-10 03:00:01} {detroit y2038} { clock format 3477279601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.687 {time zone boundary case 2080-11-03 01:59:59} {detroit y2038} { clock format 3497839199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.688 {time zone boundary case 2080-11-03 01:00:00} {detroit y2038} { clock format 3497839200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.689 {time zone boundary case 2080-11-03 01:00:01} {detroit y2038} { clock format 3497839201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.690 {time zone boundary case 2081-03-09 01:59:59} {detroit y2038} { clock format 3508729199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.691 {time zone boundary case 2081-03-09 03:00:00} {detroit y2038} { clock format 3508729200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.692 {time zone boundary case 2081-03-09 03:00:01} {detroit y2038} { clock format 3508729201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.693 {time zone boundary case 2081-11-02 01:59:59} {detroit y2038} { clock format 3529288799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.694 {time zone boundary case 2081-11-02 01:00:00} {detroit y2038} { clock format 3529288800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.695 {time zone boundary case 2081-11-02 01:00:01} {detroit y2038} { clock format 3529288801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.696 {time zone boundary case 2082-03-08 01:59:59} {detroit y2038} { clock format 3540178799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.697 {time zone boundary case 2082-03-08 03:00:00} {detroit y2038} { clock format 3540178800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.698 {time zone boundary case 2082-03-08 03:00:01} {detroit y2038} { clock format 3540178801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.699 {time zone boundary case 2082-11-01 01:59:59} {detroit y2038} { clock format 3560738399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.700 {time zone boundary case 2082-11-01 01:00:00} {detroit y2038} { clock format 3560738400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.701 {time zone boundary case 2082-11-01 01:00:01} {detroit y2038} { clock format 3560738401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.702 {time zone boundary case 2083-03-14 01:59:59} {detroit y2038} { clock format 3572233199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.703 {time zone boundary case 2083-03-14 03:00:00} {detroit y2038} { clock format 3572233200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.704 {time zone boundary case 2083-03-14 03:00:01} {detroit y2038} { clock format 3572233201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.705 {time zone boundary case 2083-11-07 01:59:59} {detroit y2038} { clock format 3592792799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.706 {time zone boundary case 2083-11-07 01:00:00} {detroit y2038} { clock format 3592792800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.707 {time zone boundary case 2083-11-07 01:00:01} {detroit y2038} { clock format 3592792801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.708 {time zone boundary case 2084-03-12 01:59:59} {detroit y2038} { clock format 3603682799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.709 {time zone boundary case 2084-03-12 03:00:00} {detroit y2038} { clock format 3603682800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.710 {time zone boundary case 2084-03-12 03:00:01} {detroit y2038} { clock format 3603682801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.711 {time zone boundary case 2084-11-05 01:59:59} {detroit y2038} { clock format 3624242399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.712 {time zone boundary case 2084-11-05 01:00:00} {detroit y2038} { clock format 3624242400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.713 {time zone boundary case 2084-11-05 01:00:01} {detroit y2038} { clock format 3624242401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.714 {time zone boundary case 2085-03-11 01:59:59} {detroit y2038} { clock format 3635132399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.715 {time zone boundary case 2085-03-11 03:00:00} {detroit y2038} { clock format 3635132400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.716 {time zone boundary case 2085-03-11 03:00:01} {detroit y2038} { clock format 3635132401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.717 {time zone boundary case 2085-11-04 01:59:59} {detroit y2038} { clock format 3655691999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.718 {time zone boundary case 2085-11-04 01:00:00} {detroit y2038} { clock format 3655692000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.719 {time zone boundary case 2085-11-04 01:00:01} {detroit y2038} { clock format 3655692001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.720 {time zone boundary case 2086-03-10 01:59:59} {detroit y2038} { clock format 3666581999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.721 {time zone boundary case 2086-03-10 03:00:00} {detroit y2038} { clock format 3666582000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.722 {time zone boundary case 2086-03-10 03:00:01} {detroit y2038} { clock format 3666582001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.723 {time zone boundary case 2086-11-03 01:59:59} {detroit y2038} { clock format 3687141599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.724 {time zone boundary case 2086-11-03 01:00:00} {detroit y2038} { clock format 3687141600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.725 {time zone boundary case 2086-11-03 01:00:01} {detroit y2038} { clock format 3687141601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.726 {time zone boundary case 2087-03-09 01:59:59} {detroit y2038} { clock format 3698031599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.727 {time zone boundary case 2087-03-09 03:00:00} {detroit y2038} { clock format 3698031600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.728 {time zone boundary case 2087-03-09 03:00:01} {detroit y2038} { clock format 3698031601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.729 {time zone boundary case 2087-11-02 01:59:59} {detroit y2038} { clock format 3718591199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.730 {time zone boundary case 2087-11-02 01:00:00} {detroit y2038} { clock format 3718591200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.731 {time zone boundary case 2087-11-02 01:00:01} {detroit y2038} { clock format 3718591201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.732 {time zone boundary case 2088-03-14 01:59:59} {detroit y2038} { clock format 3730085999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.733 {time zone boundary case 2088-03-14 03:00:00} {detroit y2038} { clock format 3730086000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.734 {time zone boundary case 2088-03-14 03:00:01} {detroit y2038} { clock format 3730086001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.735 {time zone boundary case 2088-11-07 01:59:59} {detroit y2038} { clock format 3750645599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.736 {time zone boundary case 2088-11-07 01:00:00} {detroit y2038} { clock format 3750645600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.737 {time zone boundary case 2088-11-07 01:00:01} {detroit y2038} { clock format 3750645601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.738 {time zone boundary case 2089-03-13 01:59:59} {detroit y2038} { clock format 3761535599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.739 {time zone boundary case 2089-03-13 03:00:00} {detroit y2038} { clock format 3761535600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.740 {time zone boundary case 2089-03-13 03:00:01} {detroit y2038} { clock format 3761535601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.741 {time zone boundary case 2089-11-06 01:59:59} {detroit y2038} { clock format 3782095199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.742 {time zone boundary case 2089-11-06 01:00:00} {detroit y2038} { clock format 3782095200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.743 {time zone boundary case 2089-11-06 01:00:01} {detroit y2038} { clock format 3782095201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.744 {time zone boundary case 2090-03-12 01:59:59} {detroit y2038} { clock format 3792985199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.745 {time zone boundary case 2090-03-12 03:00:00} {detroit y2038} { clock format 3792985200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.746 {time zone boundary case 2090-03-12 03:00:01} {detroit y2038} { clock format 3792985201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.747 {time zone boundary case 2090-11-05 01:59:59} {detroit y2038} { clock format 3813544799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.748 {time zone boundary case 2090-11-05 01:00:00} {detroit y2038} { clock format 3813544800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.749 {time zone boundary case 2090-11-05 01:00:01} {detroit y2038} { clock format 3813544801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.750 {time zone boundary case 2091-03-11 01:59:59} {detroit y2038} { clock format 3824434799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.751 {time zone boundary case 2091-03-11 03:00:00} {detroit y2038} { clock format 3824434800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.752 {time zone boundary case 2091-03-11 03:00:01} {detroit y2038} { clock format 3824434801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.753 {time zone boundary case 2091-11-04 01:59:59} {detroit y2038} { clock format 3844994399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.754 {time zone boundary case 2091-11-04 01:00:00} {detroit y2038} { clock format 3844994400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.755 {time zone boundary case 2091-11-04 01:00:01} {detroit y2038} { clock format 3844994401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.756 {time zone boundary case 2092-03-09 01:59:59} {detroit y2038} { clock format 3855884399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.757 {time zone boundary case 2092-03-09 03:00:00} {detroit y2038} { clock format 3855884400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.758 {time zone boundary case 2092-03-09 03:00:01} {detroit y2038} { clock format 3855884401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.759 {time zone boundary case 2092-11-02 01:59:59} {detroit y2038} { clock format 3876443999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.760 {time zone boundary case 2092-11-02 01:00:00} {detroit y2038} { clock format 3876444000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.761 {time zone boundary case 2092-11-02 01:00:01} {detroit y2038} { clock format 3876444001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.762 {time zone boundary case 2093-03-08 01:59:59} {detroit y2038} { clock format 3887333999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.763 {time zone boundary case 2093-03-08 03:00:00} {detroit y2038} { clock format 3887334000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.764 {time zone boundary case 2093-03-08 03:00:01} {detroit y2038} { clock format 3887334001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.765 {time zone boundary case 2093-11-01 01:59:59} {detroit y2038} { clock format 3907893599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.766 {time zone boundary case 2093-11-01 01:00:00} {detroit y2038} { clock format 3907893600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.767 {time zone boundary case 2093-11-01 01:00:01} {detroit y2038} { clock format 3907893601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.768 {time zone boundary case 2094-03-14 01:59:59} {detroit y2038} { clock format 3919388399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.769 {time zone boundary case 2094-03-14 03:00:00} {detroit y2038} { clock format 3919388400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.770 {time zone boundary case 2094-03-14 03:00:01} {detroit y2038} { clock format 3919388401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.771 {time zone boundary case 2094-11-07 01:59:59} {detroit y2038} { clock format 3939947999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.772 {time zone boundary case 2094-11-07 01:00:00} {detroit y2038} { clock format 3939948000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.773 {time zone boundary case 2094-11-07 01:00:01} {detroit y2038} { clock format 3939948001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.774 {time zone boundary case 2095-03-13 01:59:59} {detroit y2038} { clock format 3950837999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.775 {time zone boundary case 2095-03-13 03:00:00} {detroit y2038} { clock format 3950838000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.776 {time zone boundary case 2095-03-13 03:00:01} {detroit y2038} { clock format 3950838001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.777 {time zone boundary case 2095-11-06 01:59:59} {detroit y2038} { clock format 3971397599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.778 {time zone boundary case 2095-11-06 01:00:00} {detroit y2038} { clock format 3971397600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.779 {time zone boundary case 2095-11-06 01:00:01} {detroit y2038} { clock format 3971397601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.780 {time zone boundary case 2096-03-11 01:59:59} {detroit y2038} { clock format 3982287599 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.781 {time zone boundary case 2096-03-11 03:00:00} {detroit y2038} { clock format 3982287600 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.782 {time zone boundary case 2096-03-11 03:00:01} {detroit y2038} { clock format 3982287601 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.783 {time zone boundary case 2096-11-04 01:59:59} {detroit y2038} { clock format 4002847199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.784 {time zone boundary case 2096-11-04 01:00:00} {detroit y2038} { clock format 4002847200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.785 {time zone boundary case 2096-11-04 01:00:01} {detroit y2038} { clock format 4002847201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.786 {time zone boundary case 2097-03-10 01:59:59} {detroit y2038} { clock format 4013737199 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.787 {time zone boundary case 2097-03-10 03:00:00} {detroit y2038} { clock format 4013737200 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.788 {time zone boundary case 2097-03-10 03:00:01} {detroit y2038} { clock format 4013737201 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.789 {time zone boundary case 2097-11-03 01:59:59} {detroit y2038} { clock format 4034296799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.790 {time zone boundary case 2097-11-03 01:00:00} {detroit y2038} { clock format 4034296800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.791 {time zone boundary case 2097-11-03 01:00:01} {detroit y2038} { clock format 4034296801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.792 {time zone boundary case 2098-03-09 01:59:59} {detroit y2038} { clock format 4045186799 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.793 {time zone boundary case 2098-03-09 03:00:00} {detroit y2038} { clock format 4045186800 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.794 {time zone boundary case 2098-03-09 03:00:01} {detroit y2038} { clock format 4045186801 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.795 {time zone boundary case 2098-11-02 01:59:59} {detroit y2038} { clock format 4065746399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.796 {time zone boundary case 2098-11-02 01:00:00} {detroit y2038} { clock format 4065746400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.797 {time zone boundary case 2098-11-02 01:00:01} {detroit y2038} { clock format 4065746401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} test clock-5.798 {time zone boundary case 2099-03-08 01:59:59} {detroit y2038} { clock format 4076636399 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0500 EST} test clock-5.799 {time zone boundary case 2099-03-08 03:00:00} {detroit y2038} { clock format 4076636400 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:00 -0400 EDT} test clock-5.800 {time zone boundary case 2099-03-08 03:00:01} {detroit y2038} { clock format 4076636401 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {03:00:01 -0400 EDT} test clock-5.801 {time zone boundary case 2099-11-01 01:59:59} {detroit y2038} { clock format 4097195999 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:59:59 -0400 EDT} test clock-5.802 {time zone boundary case 2099-11-01 01:00:00} {detroit y2038} { clock format 4097196000 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:00 -0500 EST} test clock-5.803 {time zone boundary case 2099-11-01 01:00:01} {detroit y2038} { clock format 4097196001 -format {%H:%M:%S %z %Z} \ -timezone :America/Detroit } {01:00:01 -0500 EST} # END testcases5 # Test input conversions. test clock-6.0 {input of seconds} { clock scan {-9223372036854775808} -format %s -gmt true } -9223372036854775808 test clock-6.1 {input of seconds} { clock scan {-2147483649} -format %s -gmt true } -2147483649 test clock-6.2 {input of seconds} { clock scan {-2147483648} -format %s -gmt true } -2147483648 test clock-6.3 {input of seconds} { clock scan {-1} -format %s -gmt true } -1 test clock-6.4 {input of seconds} { clock scan {0} -format %s -gmt true } 0 test clock-6.5 {input of seconds} { clock scan {1} -format %s -gmt true } 1 test clock-6.6 {input of seconds} { clock scan {2147483647} -format %s -gmt true } 2147483647 test clock-6.7 {input of seconds} { clock scan {2147483648} -format %s -gmt true } 2147483648 test clock-6.8 {input of seconds} { clock scan {9223372036854775807} -format %s -gmt true } 9223372036854775807 test clock-6.9 {input of seconds - overflow} { list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result } {1 {integer value too large to represent}} test clock-6.10 {input of seconds - overflow} { list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result } {1 {integer value too large to represent}} test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true } 2 test clock-7.1 {Julian Day} { clock scan 0 -format %J -gmt true } -210866803200 test clock-7.2 {Julian Day} { clock format [clock scan 2440588 -format %J -gmt true] \ -format %Y-%m-%d -gmt true } 1970-01-01 test clock-7.3 {Julian Day} { clock format [clock scan 2451545 -format %J -gmt true] \ -format %Y-%m-%d -gmt true } 2000-01-01 test clock-7.3.1 {Julian Day} { clock format [clock scan 2488070 -format %J -gmt true] \ -format %Y-%m-%d -gmt true } 2100-01-01 test clock-7.4 {Julian Day} { clock format [clock scan 5373484 -format %J -gmt true] \ -format %Y-%m-%d -gmt true } 9999-12-31 test clock-7.5 {Julian Day, bad} { list [catch { clock scan bogus -format %J } result] $result $errorCode } {1 {input string does not match supplied format} {CLOCK badInputString}} test clock-7.6 {Julian Day, overflow} { list [catch { clock scan 5373485 -format %J } result] $result $errorCode } {1 {requested date too large to represent} {CLOCK dateTooLarge}} test clock-7.7 {Julian Day, overflow} { list [catch { clock scan 2147483648 -format %J } result] $result $errorCode } {1 {requested date too large to represent} {CLOCK dateTooLarge}} test clock-7.8 {Julian Day, precedence below seconds} { list [clock scan {2440588 86400} -format {%J %s} -gmt true] \ [clock scan {2440589 0} -format {%J %s} -gmt true] \ [clock scan {86400 2440588} -format {%s %J} -gmt true] \ [clock scan {0 2440589} -format {%s %J} -gmt true] } {86400 0 86400 0} test clock-7.9 {Julian Day, two values} { clock scan {2440588 2440589} -format {%J %J} -gmt true } 86400 test clock-7.10 {Julian Day, negative amount} { # Note: %J does not accept negative input; # add negative amounts to Julian day 0 instead set s0 [clock scan 0 -format %J -gmt true] set J0 [scan [clock format $s0 -format %J -gmt true] %lld] set s0m1d [clock add $s0 -1 days -timezone :UTC] set s0m24h [clock add $s0 -24 hours -timezone :UTC] set J0m24h [scan [clock format $s0m24h -format %J -gmt true] %lld] set s0m1s [clock add $s0 -1 seconds -timezone :UTC] set J0m1s [scan [clock format $s0m1s -format %J -gmt true] %lld] list $s0m1d $s0m24h $J0m24h $s0m1s $J0m1s $s0 $J0 \ [::tcl::mathop::== $s0m1d $s0m24h] [::tcl::mathop::== $J0m24h $J0m1s] } [list -210866889600 -210866889600 -1 -210866803201 -1 -210866803200 0 1 1] # BEGIN testcases8 # Test parsing of ccyymmdd test clock-8.1 {parse ccyymmdd} { clock scan {1970 Jan 02} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.2 {parse ccyymmdd} { clock scan {1970 Jan ii} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.3 {parse ccyymmdd} { clock scan {1970 Jan 2} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.4 {parse ccyymmdd} { clock scan {1970 Jan ii} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.5 {parse ccyymmdd} { clock scan {1970 January 02} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.6 {parse ccyymmdd} { clock scan {1970 January ii} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.7 {parse ccyymmdd} { clock scan {1970 January 2} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.8 {parse ccyymmdd} { clock scan {1970 January ii} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.9 {parse ccyymmdd} { clock scan {1970 Jan 02} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.10 {parse ccyymmdd} { clock scan {1970 Jan ii} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.11 {parse ccyymmdd} { clock scan {1970 Jan 2} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.12 {parse ccyymmdd} { clock scan {1970 Jan ii} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.13 {parse ccyymmdd} { clock scan {1970 01 02} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.14 {parse ccyymmdd} { clock scan {1970 01 ii} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.15 {parse ccyymmdd} { clock scan {1970 01 2} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.16 {parse ccyymmdd} { clock scan {1970 01 ii} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.17 {parse ccyymmdd} { clock scan {1970 i 02} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.18 {parse ccyymmdd} { clock scan {1970 i ii} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.19 {parse ccyymmdd} { clock scan {1970 i 2} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.20 {parse ccyymmdd} { clock scan {1970 i ii} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.21 {parse ccyymmdd} { clock scan {1970 1 02} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.22 {parse ccyymmdd} { clock scan {1970 1 ii} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.23 {parse ccyymmdd} { clock scan {1970 1 2} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.24 {parse ccyymmdd} { clock scan {1970 1 ii} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.25 {parse ccyymmdd} { clock scan {1970 Jan 02} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.26 {parse ccyymmdd} { clock scan {1970 Jan ii} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.27 {parse ccyymmdd} { clock scan {1970 Jan 2} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.28 {parse ccyymmdd} { clock scan {1970 Jan ii} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.29 {parse ccyymmdd} { clock scan {1970 January 02} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.30 {parse ccyymmdd} { clock scan {1970 January ii} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.31 {parse ccyymmdd} { clock scan {1970 January 2} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.32 {parse ccyymmdd} { clock scan {1970 January ii} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.33 {parse ccyymmdd} { clock scan {1970 Jan 02} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.34 {parse ccyymmdd} { clock scan {1970 Jan ii} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.35 {parse ccyymmdd} { clock scan {1970 Jan 2} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.36 {parse ccyymmdd} { clock scan {1970 Jan ii} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.37 {parse ccyymmdd} { clock scan {1970 01 02} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.38 {parse ccyymmdd} { clock scan {1970 01 ii} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.39 {parse ccyymmdd} { clock scan {1970 01 2} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.40 {parse ccyymmdd} { clock scan {1970 01 ii} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.41 {parse ccyymmdd} { clock scan {1970 i 02} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.42 {parse ccyymmdd} { clock scan {1970 i ii} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.43 {parse ccyymmdd} { clock scan {1970 i 2} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.44 {parse ccyymmdd} { clock scan {1970 i ii} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.45 {parse ccyymmdd} { clock scan {1970 1 02} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 86400 test clock-8.46 {parse ccyymmdd} { clock scan {1970 1 ii} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 86400 test clock-8.47 {parse ccyymmdd} { clock scan {1970 1 2} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 86400 test clock-8.48 {parse ccyymmdd} { clock scan {1970 1 ii} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-8.49 {parse ccyymmdd} { clock scan 01/02/1970 -format %x -locale en_US_roman -gmt 1 } 86400 test clock-8.50 {parse ccyymmdd} { clock scan 01/02/1970 -format %D -locale en_US_roman -gmt 1 } 86400 test clock-8.51 {parse ccyymmdd} { clock scan {1970 Jan 31} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.52 {parse ccyymmdd} { clock scan {1970 Jan xxxi} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.53 {parse ccyymmdd} { clock scan {1970 Jan 31} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.54 {parse ccyymmdd} { clock scan {1970 Jan xxxi} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.55 {parse ccyymmdd} { clock scan {1970 January 31} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.56 {parse ccyymmdd} { clock scan {1970 January xxxi} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.57 {parse ccyymmdd} { clock scan {1970 January 31} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.58 {parse ccyymmdd} { clock scan {1970 January xxxi} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.59 {parse ccyymmdd} { clock scan {1970 Jan 31} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.60 {parse ccyymmdd} { clock scan {1970 Jan xxxi} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.61 {parse ccyymmdd} { clock scan {1970 Jan 31} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.62 {parse ccyymmdd} { clock scan {1970 Jan xxxi} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.63 {parse ccyymmdd} { clock scan {1970 01 31} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.64 {parse ccyymmdd} { clock scan {1970 01 xxxi} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.65 {parse ccyymmdd} { clock scan {1970 01 31} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.66 {parse ccyymmdd} { clock scan {1970 01 xxxi} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.67 {parse ccyymmdd} { clock scan {1970 i 31} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.68 {parse ccyymmdd} { clock scan {1970 i xxxi} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.69 {parse ccyymmdd} { clock scan {1970 i 31} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.70 {parse ccyymmdd} { clock scan {1970 i xxxi} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.71 {parse ccyymmdd} { clock scan {1970 1 31} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.72 {parse ccyymmdd} { clock scan {1970 1 xxxi} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.73 {parse ccyymmdd} { clock scan {1970 1 31} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.74 {parse ccyymmdd} { clock scan {1970 1 xxxi} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.75 {parse ccyymmdd} { clock scan {1970 Jan 31} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.76 {parse ccyymmdd} { clock scan {1970 Jan xxxi} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.77 {parse ccyymmdd} { clock scan {1970 Jan 31} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.78 {parse ccyymmdd} { clock scan {1970 Jan xxxi} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.79 {parse ccyymmdd} { clock scan {1970 January 31} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.80 {parse ccyymmdd} { clock scan {1970 January xxxi} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.81 {parse ccyymmdd} { clock scan {1970 January 31} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.82 {parse ccyymmdd} { clock scan {1970 January xxxi} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.83 {parse ccyymmdd} { clock scan {1970 Jan 31} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.84 {parse ccyymmdd} { clock scan {1970 Jan xxxi} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.85 {parse ccyymmdd} { clock scan {1970 Jan 31} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.86 {parse ccyymmdd} { clock scan {1970 Jan xxxi} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.87 {parse ccyymmdd} { clock scan {1970 01 31} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.88 {parse ccyymmdd} { clock scan {1970 01 xxxi} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.89 {parse ccyymmdd} { clock scan {1970 01 31} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.90 {parse ccyymmdd} { clock scan {1970 01 xxxi} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.91 {parse ccyymmdd} { clock scan {1970 i 31} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.92 {parse ccyymmdd} { clock scan {1970 i xxxi} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.93 {parse ccyymmdd} { clock scan {1970 i 31} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.94 {parse ccyymmdd} { clock scan {1970 i xxxi} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.95 {parse ccyymmdd} { clock scan {1970 1 31} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 2592000 test clock-8.96 {parse ccyymmdd} { clock scan {1970 1 xxxi} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-8.97 {parse ccyymmdd} { clock scan {1970 1 31} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 2592000 test clock-8.98 {parse ccyymmdd} { clock scan {1970 1 xxxi} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-8.99 {parse ccyymmdd} { clock scan 01/31/1970 -format %x -locale en_US_roman -gmt 1 } 2592000 test clock-8.100 {parse ccyymmdd} { clock scan 01/31/1970 -format %D -locale en_US_roman -gmt 1 } 2592000 test clock-8.101 {parse ccyymmdd} { clock scan {1970 Dec 02} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.102 {parse ccyymmdd} { clock scan {1970 Dec ii} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.103 {parse ccyymmdd} { clock scan {1970 Dec 2} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.104 {parse ccyymmdd} { clock scan {1970 Dec ii} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.105 {parse ccyymmdd} { clock scan {1970 December 02} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.106 {parse ccyymmdd} { clock scan {1970 December ii} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.107 {parse ccyymmdd} { clock scan {1970 December 2} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.108 {parse ccyymmdd} { clock scan {1970 December ii} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.109 {parse ccyymmdd} { clock scan {1970 Dec 02} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.110 {parse ccyymmdd} { clock scan {1970 Dec ii} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.111 {parse ccyymmdd} { clock scan {1970 Dec 2} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.112 {parse ccyymmdd} { clock scan {1970 Dec ii} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.113 {parse ccyymmdd} { clock scan {1970 12 02} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.114 {parse ccyymmdd} { clock scan {1970 12 ii} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.115 {parse ccyymmdd} { clock scan {1970 12 2} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.116 {parse ccyymmdd} { clock scan {1970 12 ii} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.117 {parse ccyymmdd} { clock scan {1970 xii 02} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.118 {parse ccyymmdd} { clock scan {1970 xii ii} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.119 {parse ccyymmdd} { clock scan {1970 xii 2} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.120 {parse ccyymmdd} { clock scan {1970 xii ii} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.121 {parse ccyymmdd} { clock scan {1970 12 02} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.122 {parse ccyymmdd} { clock scan {1970 12 ii} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.123 {parse ccyymmdd} { clock scan {1970 12 2} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.124 {parse ccyymmdd} { clock scan {1970 12 ii} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.125 {parse ccyymmdd} { clock scan {1970 Dec 02} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.126 {parse ccyymmdd} { clock scan {1970 Dec ii} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.127 {parse ccyymmdd} { clock scan {1970 Dec 2} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.128 {parse ccyymmdd} { clock scan {1970 Dec ii} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.129 {parse ccyymmdd} { clock scan {1970 December 02} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.130 {parse ccyymmdd} { clock scan {1970 December ii} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.131 {parse ccyymmdd} { clock scan {1970 December 2} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.132 {parse ccyymmdd} { clock scan {1970 December ii} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.133 {parse ccyymmdd} { clock scan {1970 Dec 02} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.134 {parse ccyymmdd} { clock scan {1970 Dec ii} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.135 {parse ccyymmdd} { clock scan {1970 Dec 2} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.136 {parse ccyymmdd} { clock scan {1970 Dec ii} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.137 {parse ccyymmdd} { clock scan {1970 12 02} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.138 {parse ccyymmdd} { clock scan {1970 12 ii} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.139 {parse ccyymmdd} { clock scan {1970 12 2} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.140 {parse ccyymmdd} { clock scan {1970 12 ii} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.141 {parse ccyymmdd} { clock scan {1970 xii 02} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.142 {parse ccyymmdd} { clock scan {1970 xii ii} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.143 {parse ccyymmdd} { clock scan {1970 xii 2} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.144 {parse ccyymmdd} { clock scan {1970 xii ii} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.145 {parse ccyymmdd} { clock scan {1970 12 02} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 28944000 test clock-8.146 {parse ccyymmdd} { clock scan {1970 12 ii} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-8.147 {parse ccyymmdd} { clock scan {1970 12 2} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 28944000 test clock-8.148 {parse ccyymmdd} { clock scan {1970 12 ii} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-8.149 {parse ccyymmdd} { clock scan 12/02/1970 -format %x -locale en_US_roman -gmt 1 } 28944000 test clock-8.150 {parse ccyymmdd} { clock scan 12/02/1970 -format %D -locale en_US_roman -gmt 1 } 28944000 test clock-8.151 {parse ccyymmdd} { clock scan {1970 Dec 31} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.152 {parse ccyymmdd} { clock scan {1970 Dec xxxi} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.153 {parse ccyymmdd} { clock scan {1970 Dec 31} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.154 {parse ccyymmdd} { clock scan {1970 Dec xxxi} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.155 {parse ccyymmdd} { clock scan {1970 December 31} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.156 {parse ccyymmdd} { clock scan {1970 December xxxi} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.157 {parse ccyymmdd} { clock scan {1970 December 31} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.158 {parse ccyymmdd} { clock scan {1970 December xxxi} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.159 {parse ccyymmdd} { clock scan {1970 Dec 31} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.160 {parse ccyymmdd} { clock scan {1970 Dec xxxi} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.161 {parse ccyymmdd} { clock scan {1970 Dec 31} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.162 {parse ccyymmdd} { clock scan {1970 Dec xxxi} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.163 {parse ccyymmdd} { clock scan {1970 12 31} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.164 {parse ccyymmdd} { clock scan {1970 12 xxxi} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.165 {parse ccyymmdd} { clock scan {1970 12 31} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.166 {parse ccyymmdd} { clock scan {1970 12 xxxi} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.167 {parse ccyymmdd} { clock scan {1970 xii 31} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.168 {parse ccyymmdd} { clock scan {1970 xii xxxi} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.169 {parse ccyymmdd} { clock scan {1970 xii 31} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.170 {parse ccyymmdd} { clock scan {1970 xii xxxi} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.171 {parse ccyymmdd} { clock scan {1970 12 31} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.172 {parse ccyymmdd} { clock scan {1970 12 xxxi} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.173 {parse ccyymmdd} { clock scan {1970 12 31} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.174 {parse ccyymmdd} { clock scan {1970 12 xxxi} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.175 {parse ccyymmdd} { clock scan {1970 Dec 31} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.176 {parse ccyymmdd} { clock scan {1970 Dec xxxi} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.177 {parse ccyymmdd} { clock scan {1970 Dec 31} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.178 {parse ccyymmdd} { clock scan {1970 Dec xxxi} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.179 {parse ccyymmdd} { clock scan {1970 December 31} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.180 {parse ccyymmdd} { clock scan {1970 December xxxi} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.181 {parse ccyymmdd} { clock scan {1970 December 31} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.182 {parse ccyymmdd} { clock scan {1970 December xxxi} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.183 {parse ccyymmdd} { clock scan {1970 Dec 31} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.184 {parse ccyymmdd} { clock scan {1970 Dec xxxi} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.185 {parse ccyymmdd} { clock scan {1970 Dec 31} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.186 {parse ccyymmdd} { clock scan {1970 Dec xxxi} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.187 {parse ccyymmdd} { clock scan {1970 12 31} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.188 {parse ccyymmdd} { clock scan {1970 12 xxxi} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.189 {parse ccyymmdd} { clock scan {1970 12 31} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.190 {parse ccyymmdd} { clock scan {1970 12 xxxi} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.191 {parse ccyymmdd} { clock scan {1970 xii 31} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.192 {parse ccyymmdd} { clock scan {1970 xii xxxi} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.193 {parse ccyymmdd} { clock scan {1970 xii 31} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.194 {parse ccyymmdd} { clock scan {1970 xii xxxi} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.195 {parse ccyymmdd} { clock scan {1970 12 31} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 31449600 test clock-8.196 {parse ccyymmdd} { clock scan {1970 12 xxxi} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-8.197 {parse ccyymmdd} { clock scan {1970 12 31} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 31449600 test clock-8.198 {parse ccyymmdd} { clock scan {1970 12 xxxi} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-8.199 {parse ccyymmdd} { clock scan 12/31/1970 -format %x -locale en_US_roman -gmt 1 } 31449600 test clock-8.200 {parse ccyymmdd} { clock scan 12/31/1970 -format %D -locale en_US_roman -gmt 1 } 31449600 test clock-8.201 {parse ccyymmdd} { clock scan {1971 Jan 02} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.202 {parse ccyymmdd} { clock scan {1971 Jan ii} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.203 {parse ccyymmdd} { clock scan {1971 Jan 2} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.204 {parse ccyymmdd} { clock scan {1971 Jan ii} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.205 {parse ccyymmdd} { clock scan {1971 January 02} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.206 {parse ccyymmdd} { clock scan {1971 January ii} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.207 {parse ccyymmdd} { clock scan {1971 January 2} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.208 {parse ccyymmdd} { clock scan {1971 January ii} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.209 {parse ccyymmdd} { clock scan {1971 Jan 02} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.210 {parse ccyymmdd} { clock scan {1971 Jan ii} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.211 {parse ccyymmdd} { clock scan {1971 Jan 2} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.212 {parse ccyymmdd} { clock scan {1971 Jan ii} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.213 {parse ccyymmdd} { clock scan {1971 01 02} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.214 {parse ccyymmdd} { clock scan {1971 01 ii} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.215 {parse ccyymmdd} { clock scan {1971 01 2} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.216 {parse ccyymmdd} { clock scan {1971 01 ii} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.217 {parse ccyymmdd} { clock scan {1971 i 02} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.218 {parse ccyymmdd} { clock scan {1971 i ii} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.219 {parse ccyymmdd} { clock scan {1971 i 2} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.220 {parse ccyymmdd} { clock scan {1971 i ii} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.221 {parse ccyymmdd} { clock scan {1971 1 02} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.222 {parse ccyymmdd} { clock scan {1971 1 ii} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.223 {parse ccyymmdd} { clock scan {1971 1 2} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.224 {parse ccyymmdd} { clock scan {1971 1 ii} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.225 {parse ccyymmdd} { clock scan {1971 Jan 02} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.226 {parse ccyymmdd} { clock scan {1971 Jan ii} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.227 {parse ccyymmdd} { clock scan {1971 Jan 2} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.228 {parse ccyymmdd} { clock scan {1971 Jan ii} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.229 {parse ccyymmdd} { clock scan {1971 January 02} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.230 {parse ccyymmdd} { clock scan {1971 January ii} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.231 {parse ccyymmdd} { clock scan {1971 January 2} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.232 {parse ccyymmdd} { clock scan {1971 January ii} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.233 {parse ccyymmdd} { clock scan {1971 Jan 02} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.234 {parse ccyymmdd} { clock scan {1971 Jan ii} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.235 {parse ccyymmdd} { clock scan {1971 Jan 2} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.236 {parse ccyymmdd} { clock scan {1971 Jan ii} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.237 {parse ccyymmdd} { clock scan {1971 01 02} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.238 {parse ccyymmdd} { clock scan {1971 01 ii} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.239 {parse ccyymmdd} { clock scan {1971 01 2} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.240 {parse ccyymmdd} { clock scan {1971 01 ii} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.241 {parse ccyymmdd} { clock scan {1971 i 02} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.242 {parse ccyymmdd} { clock scan {1971 i ii} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.243 {parse ccyymmdd} { clock scan {1971 i 2} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.244 {parse ccyymmdd} { clock scan {1971 i ii} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.245 {parse ccyymmdd} { clock scan {1971 1 02} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 31622400 test clock-8.246 {parse ccyymmdd} { clock scan {1971 1 ii} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 31622400 test clock-8.247 {parse ccyymmdd} { clock scan {1971 1 2} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 31622400 test clock-8.248 {parse ccyymmdd} { clock scan {1971 1 ii} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 31622400 test clock-8.249 {parse ccyymmdd} { clock scan 01/02/1971 -format %x -locale en_US_roman -gmt 1 } 31622400 test clock-8.250 {parse ccyymmdd} { clock scan 01/02/1971 -format %D -locale en_US_roman -gmt 1 } 31622400 test clock-8.251 {parse ccyymmdd} { clock scan {1971 Jan 31} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.252 {parse ccyymmdd} { clock scan {1971 Jan xxxi} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.253 {parse ccyymmdd} { clock scan {1971 Jan 31} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.254 {parse ccyymmdd} { clock scan {1971 Jan xxxi} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.255 {parse ccyymmdd} { clock scan {1971 January 31} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.256 {parse ccyymmdd} { clock scan {1971 January xxxi} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.257 {parse ccyymmdd} { clock scan {1971 January 31} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.258 {parse ccyymmdd} { clock scan {1971 January xxxi} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.259 {parse ccyymmdd} { clock scan {1971 Jan 31} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.260 {parse ccyymmdd} { clock scan {1971 Jan xxxi} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.261 {parse ccyymmdd} { clock scan {1971 Jan 31} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.262 {parse ccyymmdd} { clock scan {1971 Jan xxxi} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.263 {parse ccyymmdd} { clock scan {1971 01 31} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.264 {parse ccyymmdd} { clock scan {1971 01 xxxi} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.265 {parse ccyymmdd} { clock scan {1971 01 31} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.266 {parse ccyymmdd} { clock scan {1971 01 xxxi} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.267 {parse ccyymmdd} { clock scan {1971 i 31} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.268 {parse ccyymmdd} { clock scan {1971 i xxxi} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.269 {parse ccyymmdd} { clock scan {1971 i 31} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.270 {parse ccyymmdd} { clock scan {1971 i xxxi} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.271 {parse ccyymmdd} { clock scan {1971 1 31} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.272 {parse ccyymmdd} { clock scan {1971 1 xxxi} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.273 {parse ccyymmdd} { clock scan {1971 1 31} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.274 {parse ccyymmdd} { clock scan {1971 1 xxxi} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.275 {parse ccyymmdd} { clock scan {1971 Jan 31} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.276 {parse ccyymmdd} { clock scan {1971 Jan xxxi} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.277 {parse ccyymmdd} { clock scan {1971 Jan 31} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.278 {parse ccyymmdd} { clock scan {1971 Jan xxxi} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.279 {parse ccyymmdd} { clock scan {1971 January 31} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.280 {parse ccyymmdd} { clock scan {1971 January xxxi} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.281 {parse ccyymmdd} { clock scan {1971 January 31} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.282 {parse ccyymmdd} { clock scan {1971 January xxxi} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.283 {parse ccyymmdd} { clock scan {1971 Jan 31} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.284 {parse ccyymmdd} { clock scan {1971 Jan xxxi} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.285 {parse ccyymmdd} { clock scan {1971 Jan 31} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.286 {parse ccyymmdd} { clock scan {1971 Jan xxxi} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.287 {parse ccyymmdd} { clock scan {1971 01 31} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.288 {parse ccyymmdd} { clock scan {1971 01 xxxi} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.289 {parse ccyymmdd} { clock scan {1971 01 31} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.290 {parse ccyymmdd} { clock scan {1971 01 xxxi} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.291 {parse ccyymmdd} { clock scan {1971 i 31} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.292 {parse ccyymmdd} { clock scan {1971 i xxxi} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.293 {parse ccyymmdd} { clock scan {1971 i 31} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.294 {parse ccyymmdd} { clock scan {1971 i xxxi} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.295 {parse ccyymmdd} { clock scan {1971 1 31} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 34128000 test clock-8.296 {parse ccyymmdd} { clock scan {1971 1 xxxi} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 34128000 test clock-8.297 {parse ccyymmdd} { clock scan {1971 1 31} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 34128000 test clock-8.298 {parse ccyymmdd} { clock scan {1971 1 xxxi} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 34128000 test clock-8.299 {parse ccyymmdd} { clock scan 01/31/1971 -format %x -locale en_US_roman -gmt 1 } 34128000 test clock-8.300 {parse ccyymmdd} { clock scan 01/31/1971 -format %D -locale en_US_roman -gmt 1 } 34128000 test clock-8.301 {parse ccyymmdd} { clock scan {1971 Dec 02} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.302 {parse ccyymmdd} { clock scan {1971 Dec ii} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.303 {parse ccyymmdd} { clock scan {1971 Dec 2} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.304 {parse ccyymmdd} { clock scan {1971 Dec ii} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.305 {parse ccyymmdd} { clock scan {1971 December 02} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.306 {parse ccyymmdd} { clock scan {1971 December ii} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.307 {parse ccyymmdd} { clock scan {1971 December 2} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.308 {parse ccyymmdd} { clock scan {1971 December ii} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.309 {parse ccyymmdd} { clock scan {1971 Dec 02} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.310 {parse ccyymmdd} { clock scan {1971 Dec ii} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.311 {parse ccyymmdd} { clock scan {1971 Dec 2} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.312 {parse ccyymmdd} { clock scan {1971 Dec ii} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.313 {parse ccyymmdd} { clock scan {1971 12 02} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.314 {parse ccyymmdd} { clock scan {1971 12 ii} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.315 {parse ccyymmdd} { clock scan {1971 12 2} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.316 {parse ccyymmdd} { clock scan {1971 12 ii} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.317 {parse ccyymmdd} { clock scan {1971 xii 02} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.318 {parse ccyymmdd} { clock scan {1971 xii ii} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.319 {parse ccyymmdd} { clock scan {1971 xii 2} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.320 {parse ccyymmdd} { clock scan {1971 xii ii} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.321 {parse ccyymmdd} { clock scan {1971 12 02} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.322 {parse ccyymmdd} { clock scan {1971 12 ii} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.323 {parse ccyymmdd} { clock scan {1971 12 2} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.324 {parse ccyymmdd} { clock scan {1971 12 ii} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.325 {parse ccyymmdd} { clock scan {1971 Dec 02} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.326 {parse ccyymmdd} { clock scan {1971 Dec ii} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.327 {parse ccyymmdd} { clock scan {1971 Dec 2} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.328 {parse ccyymmdd} { clock scan {1971 Dec ii} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.329 {parse ccyymmdd} { clock scan {1971 December 02} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.330 {parse ccyymmdd} { clock scan {1971 December ii} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.331 {parse ccyymmdd} { clock scan {1971 December 2} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.332 {parse ccyymmdd} { clock scan {1971 December ii} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.333 {parse ccyymmdd} { clock scan {1971 Dec 02} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.334 {parse ccyymmdd} { clock scan {1971 Dec ii} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.335 {parse ccyymmdd} { clock scan {1971 Dec 2} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.336 {parse ccyymmdd} { clock scan {1971 Dec ii} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.337 {parse ccyymmdd} { clock scan {1971 12 02} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.338 {parse ccyymmdd} { clock scan {1971 12 ii} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.339 {parse ccyymmdd} { clock scan {1971 12 2} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.340 {parse ccyymmdd} { clock scan {1971 12 ii} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.341 {parse ccyymmdd} { clock scan {1971 xii 02} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.342 {parse ccyymmdd} { clock scan {1971 xii ii} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.343 {parse ccyymmdd} { clock scan {1971 xii 2} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.344 {parse ccyymmdd} { clock scan {1971 xii ii} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.345 {parse ccyymmdd} { clock scan {1971 12 02} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 60480000 test clock-8.346 {parse ccyymmdd} { clock scan {1971 12 ii} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 60480000 test clock-8.347 {parse ccyymmdd} { clock scan {1971 12 2} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 60480000 test clock-8.348 {parse ccyymmdd} { clock scan {1971 12 ii} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 60480000 test clock-8.349 {parse ccyymmdd} { clock scan 12/02/1971 -format %x -locale en_US_roman -gmt 1 } 60480000 test clock-8.350 {parse ccyymmdd} { clock scan 12/02/1971 -format %D -locale en_US_roman -gmt 1 } 60480000 test clock-8.351 {parse ccyymmdd} { clock scan {1971 Dec 31} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.352 {parse ccyymmdd} { clock scan {1971 Dec xxxi} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.353 {parse ccyymmdd} { clock scan {1971 Dec 31} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.354 {parse ccyymmdd} { clock scan {1971 Dec xxxi} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.355 {parse ccyymmdd} { clock scan {1971 December 31} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.356 {parse ccyymmdd} { clock scan {1971 December xxxi} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.357 {parse ccyymmdd} { clock scan {1971 December 31} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.358 {parse ccyymmdd} { clock scan {1971 December xxxi} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.359 {parse ccyymmdd} { clock scan {1971 Dec 31} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.360 {parse ccyymmdd} { clock scan {1971 Dec xxxi} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.361 {parse ccyymmdd} { clock scan {1971 Dec 31} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.362 {parse ccyymmdd} { clock scan {1971 Dec xxxi} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.363 {parse ccyymmdd} { clock scan {1971 12 31} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.364 {parse ccyymmdd} { clock scan {1971 12 xxxi} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.365 {parse ccyymmdd} { clock scan {1971 12 31} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.366 {parse ccyymmdd} { clock scan {1971 12 xxxi} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.367 {parse ccyymmdd} { clock scan {1971 xii 31} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.368 {parse ccyymmdd} { clock scan {1971 xii xxxi} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.369 {parse ccyymmdd} { clock scan {1971 xii 31} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.370 {parse ccyymmdd} { clock scan {1971 xii xxxi} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.371 {parse ccyymmdd} { clock scan {1971 12 31} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.372 {parse ccyymmdd} { clock scan {1971 12 xxxi} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.373 {parse ccyymmdd} { clock scan {1971 12 31} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.374 {parse ccyymmdd} { clock scan {1971 12 xxxi} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.375 {parse ccyymmdd} { clock scan {1971 Dec 31} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.376 {parse ccyymmdd} { clock scan {1971 Dec xxxi} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.377 {parse ccyymmdd} { clock scan {1971 Dec 31} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.378 {parse ccyymmdd} { clock scan {1971 Dec xxxi} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.379 {parse ccyymmdd} { clock scan {1971 December 31} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.380 {parse ccyymmdd} { clock scan {1971 December xxxi} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.381 {parse ccyymmdd} { clock scan {1971 December 31} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.382 {parse ccyymmdd} { clock scan {1971 December xxxi} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.383 {parse ccyymmdd} { clock scan {1971 Dec 31} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.384 {parse ccyymmdd} { clock scan {1971 Dec xxxi} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.385 {parse ccyymmdd} { clock scan {1971 Dec 31} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.386 {parse ccyymmdd} { clock scan {1971 Dec xxxi} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.387 {parse ccyymmdd} { clock scan {1971 12 31} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.388 {parse ccyymmdd} { clock scan {1971 12 xxxi} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.389 {parse ccyymmdd} { clock scan {1971 12 31} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.390 {parse ccyymmdd} { clock scan {1971 12 xxxi} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.391 {parse ccyymmdd} { clock scan {1971 xii 31} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.392 {parse ccyymmdd} { clock scan {1971 xii xxxi} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.393 {parse ccyymmdd} { clock scan {1971 xii 31} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.394 {parse ccyymmdd} { clock scan {1971 xii xxxi} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.395 {parse ccyymmdd} { clock scan {1971 12 31} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 62985600 test clock-8.396 {parse ccyymmdd} { clock scan {1971 12 xxxi} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 62985600 test clock-8.397 {parse ccyymmdd} { clock scan {1971 12 31} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 62985600 test clock-8.398 {parse ccyymmdd} { clock scan {1971 12 xxxi} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 62985600 test clock-8.399 {parse ccyymmdd} { clock scan 12/31/1971 -format %x -locale en_US_roman -gmt 1 } 62985600 test clock-8.400 {parse ccyymmdd} { clock scan 12/31/1971 -format %D -locale en_US_roman -gmt 1 } 62985600 test clock-8.401 {parse ccyymmdd} { clock scan {2000 Jan 02} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.402 {parse ccyymmdd} { clock scan {2000 Jan ii} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.403 {parse ccyymmdd} { clock scan {2000 Jan 2} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.404 {parse ccyymmdd} { clock scan {2000 Jan ii} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.405 {parse ccyymmdd} { clock scan {2000 January 02} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.406 {parse ccyymmdd} { clock scan {2000 January ii} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.407 {parse ccyymmdd} { clock scan {2000 January 2} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.408 {parse ccyymmdd} { clock scan {2000 January ii} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.409 {parse ccyymmdd} { clock scan {2000 Jan 02} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.410 {parse ccyymmdd} { clock scan {2000 Jan ii} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.411 {parse ccyymmdd} { clock scan {2000 Jan 2} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.412 {parse ccyymmdd} { clock scan {2000 Jan ii} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.413 {parse ccyymmdd} { clock scan {2000 01 02} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.414 {parse ccyymmdd} { clock scan {2000 01 ii} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.415 {parse ccyymmdd} { clock scan {2000 01 2} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.416 {parse ccyymmdd} { clock scan {2000 01 ii} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.417 {parse ccyymmdd} { clock scan {2000 i 02} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.418 {parse ccyymmdd} { clock scan {2000 i ii} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.419 {parse ccyymmdd} { clock scan {2000 i 2} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.420 {parse ccyymmdd} { clock scan {2000 i ii} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.421 {parse ccyymmdd} { clock scan {2000 1 02} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.422 {parse ccyymmdd} { clock scan {2000 1 ii} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.423 {parse ccyymmdd} { clock scan {2000 1 2} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.424 {parse ccyymmdd} { clock scan {2000 1 ii} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.425 {parse ccyymmdd} { clock scan {2000 Jan 02} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.426 {parse ccyymmdd} { clock scan {2000 Jan ii} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.427 {parse ccyymmdd} { clock scan {2000 Jan 2} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.428 {parse ccyymmdd} { clock scan {2000 Jan ii} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.429 {parse ccyymmdd} { clock scan {2000 January 02} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.430 {parse ccyymmdd} { clock scan {2000 January ii} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.431 {parse ccyymmdd} { clock scan {2000 January 2} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.432 {parse ccyymmdd} { clock scan {2000 January ii} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.433 {parse ccyymmdd} { clock scan {2000 Jan 02} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.434 {parse ccyymmdd} { clock scan {2000 Jan ii} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.435 {parse ccyymmdd} { clock scan {2000 Jan 2} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.436 {parse ccyymmdd} { clock scan {2000 Jan ii} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.437 {parse ccyymmdd} { clock scan {2000 01 02} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.438 {parse ccyymmdd} { clock scan {2000 01 ii} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.439 {parse ccyymmdd} { clock scan {2000 01 2} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.440 {parse ccyymmdd} { clock scan {2000 01 ii} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.441 {parse ccyymmdd} { clock scan {2000 i 02} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.442 {parse ccyymmdd} { clock scan {2000 i ii} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.443 {parse ccyymmdd} { clock scan {2000 i 2} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.444 {parse ccyymmdd} { clock scan {2000 i ii} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.445 {parse ccyymmdd} { clock scan {2000 1 02} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 946771200 test clock-8.446 {parse ccyymmdd} { clock scan {2000 1 ii} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-8.447 {parse ccyymmdd} { clock scan {2000 1 2} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 946771200 test clock-8.448 {parse ccyymmdd} { clock scan {2000 1 ii} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-8.449 {parse ccyymmdd} { clock scan 01/02/2000 -format %x -locale en_US_roman -gmt 1 } 946771200 test clock-8.450 {parse ccyymmdd} { clock scan 01/02/2000 -format %D -locale en_US_roman -gmt 1 } 946771200 test clock-8.451 {parse ccyymmdd} { clock scan {2000 Jan 31} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.452 {parse ccyymmdd} { clock scan {2000 Jan xxxi} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.453 {parse ccyymmdd} { clock scan {2000 Jan 31} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.454 {parse ccyymmdd} { clock scan {2000 Jan xxxi} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.455 {parse ccyymmdd} { clock scan {2000 January 31} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.456 {parse ccyymmdd} { clock scan {2000 January xxxi} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.457 {parse ccyymmdd} { clock scan {2000 January 31} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.458 {parse ccyymmdd} { clock scan {2000 January xxxi} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.459 {parse ccyymmdd} { clock scan {2000 Jan 31} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.460 {parse ccyymmdd} { clock scan {2000 Jan xxxi} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.461 {parse ccyymmdd} { clock scan {2000 Jan 31} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.462 {parse ccyymmdd} { clock scan {2000 Jan xxxi} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.463 {parse ccyymmdd} { clock scan {2000 01 31} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.464 {parse ccyymmdd} { clock scan {2000 01 xxxi} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.465 {parse ccyymmdd} { clock scan {2000 01 31} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.466 {parse ccyymmdd} { clock scan {2000 01 xxxi} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.467 {parse ccyymmdd} { clock scan {2000 i 31} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.468 {parse ccyymmdd} { clock scan {2000 i xxxi} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.469 {parse ccyymmdd} { clock scan {2000 i 31} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.470 {parse ccyymmdd} { clock scan {2000 i xxxi} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.471 {parse ccyymmdd} { clock scan {2000 1 31} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.472 {parse ccyymmdd} { clock scan {2000 1 xxxi} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.473 {parse ccyymmdd} { clock scan {2000 1 31} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.474 {parse ccyymmdd} { clock scan {2000 1 xxxi} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.475 {parse ccyymmdd} { clock scan {2000 Jan 31} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.476 {parse ccyymmdd} { clock scan {2000 Jan xxxi} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.477 {parse ccyymmdd} { clock scan {2000 Jan 31} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.478 {parse ccyymmdd} { clock scan {2000 Jan xxxi} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.479 {parse ccyymmdd} { clock scan {2000 January 31} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.480 {parse ccyymmdd} { clock scan {2000 January xxxi} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.481 {parse ccyymmdd} { clock scan {2000 January 31} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.482 {parse ccyymmdd} { clock scan {2000 January xxxi} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.483 {parse ccyymmdd} { clock scan {2000 Jan 31} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.484 {parse ccyymmdd} { clock scan {2000 Jan xxxi} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.485 {parse ccyymmdd} { clock scan {2000 Jan 31} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.486 {parse ccyymmdd} { clock scan {2000 Jan xxxi} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.487 {parse ccyymmdd} { clock scan {2000 01 31} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.488 {parse ccyymmdd} { clock scan {2000 01 xxxi} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.489 {parse ccyymmdd} { clock scan {2000 01 31} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.490 {parse ccyymmdd} { clock scan {2000 01 xxxi} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.491 {parse ccyymmdd} { clock scan {2000 i 31} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.492 {parse ccyymmdd} { clock scan {2000 i xxxi} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.493 {parse ccyymmdd} { clock scan {2000 i 31} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.494 {parse ccyymmdd} { clock scan {2000 i xxxi} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.495 {parse ccyymmdd} { clock scan {2000 1 31} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 949276800 test clock-8.496 {parse ccyymmdd} { clock scan {2000 1 xxxi} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-8.497 {parse ccyymmdd} { clock scan {2000 1 31} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 949276800 test clock-8.498 {parse ccyymmdd} { clock scan {2000 1 xxxi} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-8.499 {parse ccyymmdd} { clock scan 01/31/2000 -format %x -locale en_US_roman -gmt 1 } 949276800 test clock-8.500 {parse ccyymmdd} { clock scan 01/31/2000 -format %D -locale en_US_roman -gmt 1 } 949276800 test clock-8.501 {parse ccyymmdd} { clock scan {2000 Dec 02} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.502 {parse ccyymmdd} { clock scan {2000 Dec ii} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.503 {parse ccyymmdd} { clock scan {2000 Dec 2} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.504 {parse ccyymmdd} { clock scan {2000 Dec ii} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.505 {parse ccyymmdd} { clock scan {2000 December 02} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.506 {parse ccyymmdd} { clock scan {2000 December ii} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.507 {parse ccyymmdd} { clock scan {2000 December 2} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.508 {parse ccyymmdd} { clock scan {2000 December ii} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.509 {parse ccyymmdd} { clock scan {2000 Dec 02} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.510 {parse ccyymmdd} { clock scan {2000 Dec ii} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.511 {parse ccyymmdd} { clock scan {2000 Dec 2} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.512 {parse ccyymmdd} { clock scan {2000 Dec ii} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.513 {parse ccyymmdd} { clock scan {2000 12 02} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.514 {parse ccyymmdd} { clock scan {2000 12 ii} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.515 {parse ccyymmdd} { clock scan {2000 12 2} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.516 {parse ccyymmdd} { clock scan {2000 12 ii} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.517 {parse ccyymmdd} { clock scan {2000 xii 02} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.518 {parse ccyymmdd} { clock scan {2000 xii ii} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.519 {parse ccyymmdd} { clock scan {2000 xii 2} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.520 {parse ccyymmdd} { clock scan {2000 xii ii} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.521 {parse ccyymmdd} { clock scan {2000 12 02} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.522 {parse ccyymmdd} { clock scan {2000 12 ii} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.523 {parse ccyymmdd} { clock scan {2000 12 2} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.524 {parse ccyymmdd} { clock scan {2000 12 ii} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.525 {parse ccyymmdd} { clock scan {2000 Dec 02} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.526 {parse ccyymmdd} { clock scan {2000 Dec ii} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.527 {parse ccyymmdd} { clock scan {2000 Dec 2} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.528 {parse ccyymmdd} { clock scan {2000 Dec ii} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.529 {parse ccyymmdd} { clock scan {2000 December 02} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.530 {parse ccyymmdd} { clock scan {2000 December ii} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.531 {parse ccyymmdd} { clock scan {2000 December 2} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.532 {parse ccyymmdd} { clock scan {2000 December ii} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.533 {parse ccyymmdd} { clock scan {2000 Dec 02} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.534 {parse ccyymmdd} { clock scan {2000 Dec ii} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.535 {parse ccyymmdd} { clock scan {2000 Dec 2} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.536 {parse ccyymmdd} { clock scan {2000 Dec ii} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.537 {parse ccyymmdd} { clock scan {2000 12 02} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.538 {parse ccyymmdd} { clock scan {2000 12 ii} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.539 {parse ccyymmdd} { clock scan {2000 12 2} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.540 {parse ccyymmdd} { clock scan {2000 12 ii} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.541 {parse ccyymmdd} { clock scan {2000 xii 02} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.542 {parse ccyymmdd} { clock scan {2000 xii ii} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.543 {parse ccyymmdd} { clock scan {2000 xii 2} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.544 {parse ccyymmdd} { clock scan {2000 xii ii} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.545 {parse ccyymmdd} { clock scan {2000 12 02} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 975715200 test clock-8.546 {parse ccyymmdd} { clock scan {2000 12 ii} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-8.547 {parse ccyymmdd} { clock scan {2000 12 2} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 975715200 test clock-8.548 {parse ccyymmdd} { clock scan {2000 12 ii} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-8.549 {parse ccyymmdd} { clock scan 12/02/2000 -format %x -locale en_US_roman -gmt 1 } 975715200 test clock-8.550 {parse ccyymmdd} { clock scan 12/02/2000 -format %D -locale en_US_roman -gmt 1 } 975715200 test clock-8.551 {parse ccyymmdd} { clock scan {2000 Dec 31} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.552 {parse ccyymmdd} { clock scan {2000 Dec xxxi} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.553 {parse ccyymmdd} { clock scan {2000 Dec 31} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.554 {parse ccyymmdd} { clock scan {2000 Dec xxxi} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.555 {parse ccyymmdd} { clock scan {2000 December 31} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.556 {parse ccyymmdd} { clock scan {2000 December xxxi} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.557 {parse ccyymmdd} { clock scan {2000 December 31} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.558 {parse ccyymmdd} { clock scan {2000 December xxxi} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.559 {parse ccyymmdd} { clock scan {2000 Dec 31} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.560 {parse ccyymmdd} { clock scan {2000 Dec xxxi} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.561 {parse ccyymmdd} { clock scan {2000 Dec 31} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.562 {parse ccyymmdd} { clock scan {2000 Dec xxxi} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.563 {parse ccyymmdd} { clock scan {2000 12 31} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.564 {parse ccyymmdd} { clock scan {2000 12 xxxi} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.565 {parse ccyymmdd} { clock scan {2000 12 31} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.566 {parse ccyymmdd} { clock scan {2000 12 xxxi} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.567 {parse ccyymmdd} { clock scan {2000 xii 31} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.568 {parse ccyymmdd} { clock scan {2000 xii xxxi} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.569 {parse ccyymmdd} { clock scan {2000 xii 31} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.570 {parse ccyymmdd} { clock scan {2000 xii xxxi} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.571 {parse ccyymmdd} { clock scan {2000 12 31} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.572 {parse ccyymmdd} { clock scan {2000 12 xxxi} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.573 {parse ccyymmdd} { clock scan {2000 12 31} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.574 {parse ccyymmdd} { clock scan {2000 12 xxxi} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.575 {parse ccyymmdd} { clock scan {2000 Dec 31} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.576 {parse ccyymmdd} { clock scan {2000 Dec xxxi} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.577 {parse ccyymmdd} { clock scan {2000 Dec 31} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.578 {parse ccyymmdd} { clock scan {2000 Dec xxxi} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.579 {parse ccyymmdd} { clock scan {2000 December 31} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.580 {parse ccyymmdd} { clock scan {2000 December xxxi} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.581 {parse ccyymmdd} { clock scan {2000 December 31} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.582 {parse ccyymmdd} { clock scan {2000 December xxxi} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.583 {parse ccyymmdd} { clock scan {2000 Dec 31} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.584 {parse ccyymmdd} { clock scan {2000 Dec xxxi} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.585 {parse ccyymmdd} { clock scan {2000 Dec 31} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.586 {parse ccyymmdd} { clock scan {2000 Dec xxxi} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.587 {parse ccyymmdd} { clock scan {2000 12 31} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.588 {parse ccyymmdd} { clock scan {2000 12 xxxi} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.589 {parse ccyymmdd} { clock scan {2000 12 31} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.590 {parse ccyymmdd} { clock scan {2000 12 xxxi} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.591 {parse ccyymmdd} { clock scan {2000 xii 31} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.592 {parse ccyymmdd} { clock scan {2000 xii xxxi} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.593 {parse ccyymmdd} { clock scan {2000 xii 31} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.594 {parse ccyymmdd} { clock scan {2000 xii xxxi} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.595 {parse ccyymmdd} { clock scan {2000 12 31} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 978220800 test clock-8.596 {parse ccyymmdd} { clock scan {2000 12 xxxi} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-8.597 {parse ccyymmdd} { clock scan {2000 12 31} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 978220800 test clock-8.598 {parse ccyymmdd} { clock scan {2000 12 xxxi} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-8.599 {parse ccyymmdd} { clock scan 12/31/2000 -format %x -locale en_US_roman -gmt 1 } 978220800 test clock-8.600 {parse ccyymmdd} { clock scan 12/31/2000 -format %D -locale en_US_roman -gmt 1 } 978220800 test clock-8.601 {parse ccyymmdd} { clock scan {2001 Jan 02} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.602 {parse ccyymmdd} { clock scan {2001 Jan ii} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.603 {parse ccyymmdd} { clock scan {2001 Jan 2} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.604 {parse ccyymmdd} { clock scan {2001 Jan ii} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.605 {parse ccyymmdd} { clock scan {2001 January 02} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.606 {parse ccyymmdd} { clock scan {2001 January ii} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.607 {parse ccyymmdd} { clock scan {2001 January 2} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.608 {parse ccyymmdd} { clock scan {2001 January ii} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.609 {parse ccyymmdd} { clock scan {2001 Jan 02} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.610 {parse ccyymmdd} { clock scan {2001 Jan ii} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.611 {parse ccyymmdd} { clock scan {2001 Jan 2} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.612 {parse ccyymmdd} { clock scan {2001 Jan ii} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.613 {parse ccyymmdd} { clock scan {2001 01 02} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.614 {parse ccyymmdd} { clock scan {2001 01 ii} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.615 {parse ccyymmdd} { clock scan {2001 01 2} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.616 {parse ccyymmdd} { clock scan {2001 01 ii} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.617 {parse ccyymmdd} { clock scan {2001 i 02} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.618 {parse ccyymmdd} { clock scan {2001 i ii} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.619 {parse ccyymmdd} { clock scan {2001 i 2} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.620 {parse ccyymmdd} { clock scan {2001 i ii} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.621 {parse ccyymmdd} { clock scan {2001 1 02} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.622 {parse ccyymmdd} { clock scan {2001 1 ii} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.623 {parse ccyymmdd} { clock scan {2001 1 2} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.624 {parse ccyymmdd} { clock scan {2001 1 ii} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.625 {parse ccyymmdd} { clock scan {2001 Jan 02} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.626 {parse ccyymmdd} { clock scan {2001 Jan ii} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.627 {parse ccyymmdd} { clock scan {2001 Jan 2} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.628 {parse ccyymmdd} { clock scan {2001 Jan ii} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.629 {parse ccyymmdd} { clock scan {2001 January 02} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.630 {parse ccyymmdd} { clock scan {2001 January ii} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.631 {parse ccyymmdd} { clock scan {2001 January 2} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.632 {parse ccyymmdd} { clock scan {2001 January ii} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.633 {parse ccyymmdd} { clock scan {2001 Jan 02} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.634 {parse ccyymmdd} { clock scan {2001 Jan ii} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.635 {parse ccyymmdd} { clock scan {2001 Jan 2} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.636 {parse ccyymmdd} { clock scan {2001 Jan ii} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.637 {parse ccyymmdd} { clock scan {2001 01 02} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.638 {parse ccyymmdd} { clock scan {2001 01 ii} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.639 {parse ccyymmdd} { clock scan {2001 01 2} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.640 {parse ccyymmdd} { clock scan {2001 01 ii} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.641 {parse ccyymmdd} { clock scan {2001 i 02} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.642 {parse ccyymmdd} { clock scan {2001 i ii} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.643 {parse ccyymmdd} { clock scan {2001 i 2} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.644 {parse ccyymmdd} { clock scan {2001 i ii} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.645 {parse ccyymmdd} { clock scan {2001 1 02} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 978393600 test clock-8.646 {parse ccyymmdd} { clock scan {2001 1 ii} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 978393600 test clock-8.647 {parse ccyymmdd} { clock scan {2001 1 2} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 978393600 test clock-8.648 {parse ccyymmdd} { clock scan {2001 1 ii} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 978393600 test clock-8.649 {parse ccyymmdd} { clock scan 01/02/2001 -format %x -locale en_US_roman -gmt 1 } 978393600 test clock-8.650 {parse ccyymmdd} { clock scan 01/02/2001 -format %D -locale en_US_roman -gmt 1 } 978393600 test clock-8.651 {parse ccyymmdd} { clock scan {2001 Jan 31} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.652 {parse ccyymmdd} { clock scan {2001 Jan xxxi} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.653 {parse ccyymmdd} { clock scan {2001 Jan 31} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.654 {parse ccyymmdd} { clock scan {2001 Jan xxxi} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.655 {parse ccyymmdd} { clock scan {2001 January 31} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.656 {parse ccyymmdd} { clock scan {2001 January xxxi} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.657 {parse ccyymmdd} { clock scan {2001 January 31} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.658 {parse ccyymmdd} { clock scan {2001 January xxxi} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.659 {parse ccyymmdd} { clock scan {2001 Jan 31} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.660 {parse ccyymmdd} { clock scan {2001 Jan xxxi} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.661 {parse ccyymmdd} { clock scan {2001 Jan 31} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.662 {parse ccyymmdd} { clock scan {2001 Jan xxxi} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.663 {parse ccyymmdd} { clock scan {2001 01 31} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.664 {parse ccyymmdd} { clock scan {2001 01 xxxi} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.665 {parse ccyymmdd} { clock scan {2001 01 31} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.666 {parse ccyymmdd} { clock scan {2001 01 xxxi} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.667 {parse ccyymmdd} { clock scan {2001 i 31} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.668 {parse ccyymmdd} { clock scan {2001 i xxxi} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.669 {parse ccyymmdd} { clock scan {2001 i 31} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.670 {parse ccyymmdd} { clock scan {2001 i xxxi} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.671 {parse ccyymmdd} { clock scan {2001 1 31} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.672 {parse ccyymmdd} { clock scan {2001 1 xxxi} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.673 {parse ccyymmdd} { clock scan {2001 1 31} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.674 {parse ccyymmdd} { clock scan {2001 1 xxxi} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.675 {parse ccyymmdd} { clock scan {2001 Jan 31} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.676 {parse ccyymmdd} { clock scan {2001 Jan xxxi} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.677 {parse ccyymmdd} { clock scan {2001 Jan 31} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.678 {parse ccyymmdd} { clock scan {2001 Jan xxxi} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.679 {parse ccyymmdd} { clock scan {2001 January 31} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.680 {parse ccyymmdd} { clock scan {2001 January xxxi} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.681 {parse ccyymmdd} { clock scan {2001 January 31} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.682 {parse ccyymmdd} { clock scan {2001 January xxxi} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.683 {parse ccyymmdd} { clock scan {2001 Jan 31} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.684 {parse ccyymmdd} { clock scan {2001 Jan xxxi} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.685 {parse ccyymmdd} { clock scan {2001 Jan 31} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.686 {parse ccyymmdd} { clock scan {2001 Jan xxxi} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.687 {parse ccyymmdd} { clock scan {2001 01 31} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.688 {parse ccyymmdd} { clock scan {2001 01 xxxi} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.689 {parse ccyymmdd} { clock scan {2001 01 31} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.690 {parse ccyymmdd} { clock scan {2001 01 xxxi} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.691 {parse ccyymmdd} { clock scan {2001 i 31} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.692 {parse ccyymmdd} { clock scan {2001 i xxxi} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.693 {parse ccyymmdd} { clock scan {2001 i 31} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.694 {parse ccyymmdd} { clock scan {2001 i xxxi} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.695 {parse ccyymmdd} { clock scan {2001 1 31} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 980899200 test clock-8.696 {parse ccyymmdd} { clock scan {2001 1 xxxi} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 980899200 test clock-8.697 {parse ccyymmdd} { clock scan {2001 1 31} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 980899200 test clock-8.698 {parse ccyymmdd} { clock scan {2001 1 xxxi} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 980899200 test clock-8.699 {parse ccyymmdd} { clock scan 01/31/2001 -format %x -locale en_US_roman -gmt 1 } 980899200 test clock-8.700 {parse ccyymmdd} { clock scan 01/31/2001 -format %D -locale en_US_roman -gmt 1 } 980899200 test clock-8.701 {parse ccyymmdd} { clock scan {2001 Dec 02} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.702 {parse ccyymmdd} { clock scan {2001 Dec ii} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.703 {parse ccyymmdd} { clock scan {2001 Dec 2} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.704 {parse ccyymmdd} { clock scan {2001 Dec ii} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.705 {parse ccyymmdd} { clock scan {2001 December 02} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.706 {parse ccyymmdd} { clock scan {2001 December ii} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.707 {parse ccyymmdd} { clock scan {2001 December 2} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.708 {parse ccyymmdd} { clock scan {2001 December ii} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.709 {parse ccyymmdd} { clock scan {2001 Dec 02} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.710 {parse ccyymmdd} { clock scan {2001 Dec ii} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.711 {parse ccyymmdd} { clock scan {2001 Dec 2} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.712 {parse ccyymmdd} { clock scan {2001 Dec ii} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.713 {parse ccyymmdd} { clock scan {2001 12 02} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.714 {parse ccyymmdd} { clock scan {2001 12 ii} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.715 {parse ccyymmdd} { clock scan {2001 12 2} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.716 {parse ccyymmdd} { clock scan {2001 12 ii} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.717 {parse ccyymmdd} { clock scan {2001 xii 02} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.718 {parse ccyymmdd} { clock scan {2001 xii ii} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.719 {parse ccyymmdd} { clock scan {2001 xii 2} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.720 {parse ccyymmdd} { clock scan {2001 xii ii} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.721 {parse ccyymmdd} { clock scan {2001 12 02} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.722 {parse ccyymmdd} { clock scan {2001 12 ii} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.723 {parse ccyymmdd} { clock scan {2001 12 2} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.724 {parse ccyymmdd} { clock scan {2001 12 ii} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.725 {parse ccyymmdd} { clock scan {2001 Dec 02} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.726 {parse ccyymmdd} { clock scan {2001 Dec ii} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.727 {parse ccyymmdd} { clock scan {2001 Dec 2} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.728 {parse ccyymmdd} { clock scan {2001 Dec ii} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.729 {parse ccyymmdd} { clock scan {2001 December 02} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.730 {parse ccyymmdd} { clock scan {2001 December ii} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.731 {parse ccyymmdd} { clock scan {2001 December 2} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.732 {parse ccyymmdd} { clock scan {2001 December ii} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.733 {parse ccyymmdd} { clock scan {2001 Dec 02} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.734 {parse ccyymmdd} { clock scan {2001 Dec ii} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.735 {parse ccyymmdd} { clock scan {2001 Dec 2} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.736 {parse ccyymmdd} { clock scan {2001 Dec ii} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.737 {parse ccyymmdd} { clock scan {2001 12 02} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.738 {parse ccyymmdd} { clock scan {2001 12 ii} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.739 {parse ccyymmdd} { clock scan {2001 12 2} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.740 {parse ccyymmdd} { clock scan {2001 12 ii} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.741 {parse ccyymmdd} { clock scan {2001 xii 02} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.742 {parse ccyymmdd} { clock scan {2001 xii ii} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.743 {parse ccyymmdd} { clock scan {2001 xii 2} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.744 {parse ccyymmdd} { clock scan {2001 xii ii} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.745 {parse ccyymmdd} { clock scan {2001 12 02} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.746 {parse ccyymmdd} { clock scan {2001 12 ii} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.747 {parse ccyymmdd} { clock scan {2001 12 2} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.748 {parse ccyymmdd} { clock scan {2001 12 ii} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 1007251200 test clock-8.749 {parse ccyymmdd} { clock scan 12/02/2001 -format %x -locale en_US_roman -gmt 1 } 1007251200 test clock-8.750 {parse ccyymmdd} { clock scan 12/02/2001 -format %D -locale en_US_roman -gmt 1 } 1007251200 test clock-8.751 {parse ccyymmdd} { clock scan {2001 Dec 31} -format {%C%y %b %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.752 {parse ccyymmdd} { clock scan {2001 Dec xxxi} -format {%C%y %b %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.753 {parse ccyymmdd} { clock scan {2001 Dec 31} -format {%C%y %b %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.754 {parse ccyymmdd} { clock scan {2001 Dec xxxi} -format {%C%y %b %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.755 {parse ccyymmdd} { clock scan {2001 December 31} -format {%C%y %B %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.756 {parse ccyymmdd} { clock scan {2001 December xxxi} -format {%C%y %B %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.757 {parse ccyymmdd} { clock scan {2001 December 31} -format {%C%y %B %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.758 {parse ccyymmdd} { clock scan {2001 December xxxi} -format {%C%y %B %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.759 {parse ccyymmdd} { clock scan {2001 Dec 31} -format {%C%y %h %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.760 {parse ccyymmdd} { clock scan {2001 Dec xxxi} -format {%C%y %h %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.761 {parse ccyymmdd} { clock scan {2001 Dec 31} -format {%C%y %h %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.762 {parse ccyymmdd} { clock scan {2001 Dec xxxi} -format {%C%y %h %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.763 {parse ccyymmdd} { clock scan {2001 12 31} -format {%C%y %m %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.764 {parse ccyymmdd} { clock scan {2001 12 xxxi} -format {%C%y %m %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.765 {parse ccyymmdd} { clock scan {2001 12 31} -format {%C%y %m %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.766 {parse ccyymmdd} { clock scan {2001 12 xxxi} -format {%C%y %m %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.767 {parse ccyymmdd} { clock scan {2001 xii 31} -format {%C%y %Om %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.768 {parse ccyymmdd} { clock scan {2001 xii xxxi} -format {%C%y %Om %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.769 {parse ccyymmdd} { clock scan {2001 xii 31} -format {%C%y %Om %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.770 {parse ccyymmdd} { clock scan {2001 xii xxxi} -format {%C%y %Om %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.771 {parse ccyymmdd} { clock scan {2001 12 31} -format {%C%y %N %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.772 {parse ccyymmdd} { clock scan {2001 12 xxxi} -format {%C%y %N %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.773 {parse ccyymmdd} { clock scan {2001 12 31} -format {%C%y %N %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.774 {parse ccyymmdd} { clock scan {2001 12 xxxi} -format {%C%y %N %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.775 {parse ccyymmdd} { clock scan {2001 Dec 31} -format {%Y %b %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.776 {parse ccyymmdd} { clock scan {2001 Dec xxxi} -format {%Y %b %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.777 {parse ccyymmdd} { clock scan {2001 Dec 31} -format {%Y %b %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.778 {parse ccyymmdd} { clock scan {2001 Dec xxxi} -format {%Y %b %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.779 {parse ccyymmdd} { clock scan {2001 December 31} -format {%Y %B %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.780 {parse ccyymmdd} { clock scan {2001 December xxxi} -format {%Y %B %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.781 {parse ccyymmdd} { clock scan {2001 December 31} -format {%Y %B %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.782 {parse ccyymmdd} { clock scan {2001 December xxxi} -format {%Y %B %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.783 {parse ccyymmdd} { clock scan {2001 Dec 31} -format {%Y %h %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.784 {parse ccyymmdd} { clock scan {2001 Dec xxxi} -format {%Y %h %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.785 {parse ccyymmdd} { clock scan {2001 Dec 31} -format {%Y %h %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.786 {parse ccyymmdd} { clock scan {2001 Dec xxxi} -format {%Y %h %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.787 {parse ccyymmdd} { clock scan {2001 12 31} -format {%Y %m %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.788 {parse ccyymmdd} { clock scan {2001 12 xxxi} -format {%Y %m %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.789 {parse ccyymmdd} { clock scan {2001 12 31} -format {%Y %m %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.790 {parse ccyymmdd} { clock scan {2001 12 xxxi} -format {%Y %m %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.791 {parse ccyymmdd} { clock scan {2001 xii 31} -format {%Y %Om %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.792 {parse ccyymmdd} { clock scan {2001 xii xxxi} -format {%Y %Om %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.793 {parse ccyymmdd} { clock scan {2001 xii 31} -format {%Y %Om %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.794 {parse ccyymmdd} { clock scan {2001 xii xxxi} -format {%Y %Om %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.795 {parse ccyymmdd} { clock scan {2001 12 31} -format {%Y %N %d} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.796 {parse ccyymmdd} { clock scan {2001 12 xxxi} -format {%Y %N %Od} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.797 {parse ccyymmdd} { clock scan {2001 12 31} -format {%Y %N %e} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.798 {parse ccyymmdd} { clock scan {2001 12 xxxi} -format {%Y %N %Oe} -locale en_US_roman -gmt 1 } 1009756800 test clock-8.799 {parse ccyymmdd} { clock scan 12/31/2001 -format %x -locale en_US_roman -gmt 1 } 1009756800 test clock-8.800 {parse ccyymmdd} { clock scan 12/31/2001 -format %D -locale en_US_roman -gmt 1 } 1009756800 # END testcases8 test clock-9.1 {seconds take precedence over ccyymmdd} { clock scan {0 20000101} -format {%s %Y%m%d} -gmt true } 0 test clock-9.2 {Julian day takes precedence over ccyymmdd} { clock scan {2440588 20000101} -format {%J %Y%m%d} -gmt true } 0 # Test parsing of ccyyddd test clock-10.1 {parse ccyyddd} { clock scan {1970 001} -format {%Y %j} -locale en_US_roman -gmt 1 } 0 test clock-10.2 {parse ccyyddd} { clock scan {1970 365} -format {%Y %j} -locale en_US_roman -gmt 1 } 31449600 test clock-10.3 {parse ccyyddd} { clock scan {1971 001} -format {%Y %j} -locale en_US_roman -gmt 1 } 31536000 test clock-10.4 {parse ccyyddd} { clock scan {1971 365} -format {%Y %j} -locale en_US_roman -gmt 1 } 62985600 test clock-10.5 {parse ccyyddd} { clock scan {2000 001} -format {%Y %j} -locale en_US_roman -gmt 1 } 946684800 test clock-10.6 {parse ccyyddd} { clock scan {2000 365} -format {%Y %j} -locale en_US_roman -gmt 1 } 978134400 test clock-10.7 {parse ccyyddd} { clock scan {2001 001} -format {%Y %j} -locale en_US_roman -gmt 1 } 978307200 test clock-10.8 {parse ccyyddd} { clock scan {2001 365} -format {%Y %j} -locale en_US_roman -gmt 1 } 1009756800 test clock-10.9 {seconds take precedence over ccyyddd} { list [clock scan {0 2000001} -format {%s %Y%j} -gmt true] \ [clock scan {2000001 0} -format {%Y%j %s} -gmt true] } {0 0} test clock-10.10 {julian day takes precedence over ccyyddd} { list [clock scan {2440588 2000001} -format {%J %Y%j} -gmt true] \ [clock scan {2000001 2440588} -format {%Y%j %J} -gmt true] } {0 0} # BEGIN testcases11 # Test precedence among yyyymmdd and yyyyddd test clock-11.1 {precedence of ccyyddd and ccyymmdd} { clock scan 19700101002 -format %Y%m%d%j -gmt 1 } 86400 test clock-11.2 {precedence of ccyyddd and ccyymmdd} { clock scan 01197001002 -format %m%Y%d%j -gmt 1 } 86400 test clock-11.3 {precedence of ccyyddd and ccyymmdd} { clock scan 01197001002 -format %d%Y%m%j -gmt 1 } 86400 test clock-11.4 {precedence of ccyyddd and ccyymmdd} { clock scan 00219700101 -format %j%Y%m%d -gmt 1 } 0 test clock-11.5 {precedence of ccyyddd and ccyymmdd} { clock scan 19700100201 -format %Y%m%j%d -gmt 1 } 0 test clock-11.6 {precedence of ccyyddd and ccyymmdd} { clock scan 01197000201 -format %m%Y%j%d -gmt 1 } 0 test clock-11.7 {precedence of ccyyddd and ccyymmdd} { clock scan 01197000201 -format %d%Y%j%m -gmt 1 } 0 test clock-11.8 {precedence of ccyyddd and ccyymmdd} { clock scan 00219700101 -format %j%Y%d%m -gmt 1 } 0 test clock-11.9 {precedence of ccyyddd and ccyymmdd} { clock scan 19700101002 -format %Y%d%m%j -gmt 1 } 86400 test clock-11.10 {precedence of ccyyddd and ccyymmdd} { clock scan 01011970002 -format %m%d%Y%j -gmt 1 } 86400 test clock-11.11 {precedence of ccyyddd and ccyymmdd} { clock scan 01011970002 -format %d%m%Y%j -gmt 1 } 86400 test clock-11.12 {precedence of ccyyddd and ccyymmdd} { clock scan 00201197001 -format %j%m%Y%d -gmt 1 } 0 test clock-11.13 {precedence of ccyyddd and ccyymmdd} { clock scan 19700100201 -format %Y%d%j%m -gmt 1 } 0 test clock-11.14 {precedence of ccyyddd and ccyymmdd} { clock scan 01010021970 -format %m%d%j%Y -gmt 1 } 86400 test clock-11.15 {precedence of ccyyddd and ccyymmdd} { clock scan 01010021970 -format %d%m%j%Y -gmt 1 } 86400 test clock-11.16 {precedence of ccyyddd and ccyymmdd} { clock scan 00201011970 -format %j%m%d%Y -gmt 1 } 0 test clock-11.17 {precedence of ccyyddd and ccyymmdd} { clock scan 19700020101 -format %Y%j%m%d -gmt 1 } 0 test clock-11.18 {precedence of ccyyddd and ccyymmdd} { clock scan 01002197001 -format %m%j%Y%d -gmt 1 } 0 test clock-11.19 {precedence of ccyyddd and ccyymmdd} { clock scan 01002197001 -format %d%j%Y%m -gmt 1 } 0 test clock-11.20 {precedence of ccyyddd and ccyymmdd} { clock scan 00201197001 -format %j%d%Y%m -gmt 1 } 0 test clock-11.21 {precedence of ccyyddd and ccyymmdd} { clock scan 19700020101 -format %Y%j%d%m -gmt 1 } 0 test clock-11.22 {precedence of ccyyddd and ccyymmdd} { clock scan 01002011970 -format %m%j%d%Y -gmt 1 } 0 test clock-11.23 {precedence of ccyyddd and ccyymmdd} { clock scan 01002011970 -format %d%j%m%Y -gmt 1 } 0 test clock-11.24 {precedence of ccyyddd and ccyymmdd} { clock scan 00201011970 -format %j%d%m%Y -gmt 1 } 0 # END testcases11 # BEGIN testcases12 # Test parsing of ccyyWwwd test clock-12.1 {parse ccyyWwwd} { clock scan {1970 W01 Fri} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 86400 test clock-12.2 {parse ccyyWwwd} { clock scan {1970 W01 Friday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 86400 test clock-12.3 {parse ccyyWwwd} { clock scan {1970 W01 5} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 86400 test clock-12.4 {parse ccyyWwwd} { clock scan {1970 W01 5} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 86400 test clock-12.5 {parse ccyyWwwd} { clock scan {1970 W01 v} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 86400 test clock-12.6 {parse ccyyWwwd} { clock scan {1970 W01 v} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 86400 test clock-12.7 {parse ccyyWwwd} { clock scan {1970 W05 Sat} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 2592000 test clock-12.8 {parse ccyyWwwd} { clock scan {1970 W05 Saturday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 2592000 test clock-12.9 {parse ccyyWwwd} { clock scan {1970 W05 6} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 2592000 test clock-12.10 {parse ccyyWwwd} { clock scan {1970 W05 6} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 2592000 test clock-12.11 {parse ccyyWwwd} { clock scan {1970 W05 vi} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 2592000 test clock-12.12 {parse ccyyWwwd} { clock scan {1970 W05 vi} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 2592000 test clock-12.13 {parse ccyyWwwd} { clock scan {1970 W49 Wed} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 28944000 test clock-12.14 {parse ccyyWwwd} { clock scan {1970 W49 Wednesday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 28944000 test clock-12.15 {parse ccyyWwwd} { clock scan {1970 W49 3} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 28944000 test clock-12.16 {parse ccyyWwwd} { clock scan {1970 W49 3} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 28944000 test clock-12.17 {parse ccyyWwwd} { clock scan {1970 W49 iii} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 28944000 test clock-12.18 {parse ccyyWwwd} { clock scan {1970 W49 iii} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 28944000 test clock-12.19 {parse ccyyWwwd} { clock scan {1970 W53 Thu} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 31449600 test clock-12.20 {parse ccyyWwwd} { clock scan {1970 W53 Thursday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 31449600 test clock-12.21 {parse ccyyWwwd} { clock scan {1970 W53 4} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 31449600 test clock-12.22 {parse ccyyWwwd} { clock scan {1970 W53 4} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 31449600 test clock-12.23 {parse ccyyWwwd} { clock scan {1970 W53 iv} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 31449600 test clock-12.24 {parse ccyyWwwd} { clock scan {1970 W53 iv} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 31449600 test clock-12.25 {parse ccyyWwwd} { clock scan {1970 W53 Sat} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 31622400 test clock-12.26 {parse ccyyWwwd} { clock scan {1970 W53 Saturday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 31622400 test clock-12.27 {parse ccyyWwwd} { clock scan {1970 W53 6} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 31622400 test clock-12.28 {parse ccyyWwwd} { clock scan {1970 W53 6} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 31622400 test clock-12.29 {parse ccyyWwwd} { clock scan {1970 W53 vi} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 31622400 test clock-12.30 {parse ccyyWwwd} { clock scan {1970 W53 vi} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 31622400 test clock-12.31 {parse ccyyWwwd} { clock scan {1971 W04 Sun} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 34128000 test clock-12.32 {parse ccyyWwwd} { clock scan {1971 W04 Sunday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 34128000 test clock-12.33 {parse ccyyWwwd} { clock scan {1971 W04 7} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 34128000 test clock-12.34 {parse ccyyWwwd} { clock scan {1971 W04 0} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 34128000 test clock-12.35 {parse ccyyWwwd} { clock scan {1971 W04 vii} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 34128000 test clock-12.36 {parse ccyyWwwd} { clock scan {1971 W04 ?} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 34128000 test clock-12.37 {parse ccyyWwwd} { clock scan {1971 W48 Thu} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 60480000 test clock-12.38 {parse ccyyWwwd} { clock scan {1971 W48 Thursday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 60480000 test clock-12.39 {parse ccyyWwwd} { clock scan {1971 W48 4} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 60480000 test clock-12.40 {parse ccyyWwwd} { clock scan {1971 W48 4} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 60480000 test clock-12.41 {parse ccyyWwwd} { clock scan {1971 W48 iv} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 60480000 test clock-12.42 {parse ccyyWwwd} { clock scan {1971 W48 iv} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 60480000 test clock-12.43 {parse ccyyWwwd} { clock scan {1971 W52 Fri} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 62985600 test clock-12.44 {parse ccyyWwwd} { clock scan {1971 W52 Friday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 62985600 test clock-12.45 {parse ccyyWwwd} { clock scan {1971 W52 5} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 62985600 test clock-12.46 {parse ccyyWwwd} { clock scan {1971 W52 5} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 62985600 test clock-12.47 {parse ccyyWwwd} { clock scan {1971 W52 v} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 62985600 test clock-12.48 {parse ccyyWwwd} { clock scan {1971 W52 v} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 62985600 test clock-12.49 {parse ccyyWwwd} { clock scan {1999 W52 Sun} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 946771200 test clock-12.50 {parse ccyyWwwd} { clock scan {1999 W52 Sunday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 946771200 test clock-12.51 {parse ccyyWwwd} { clock scan {1999 W52 7} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 946771200 test clock-12.52 {parse ccyyWwwd} { clock scan {1999 W52 0} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 946771200 test clock-12.53 {parse ccyyWwwd} { clock scan {1999 W52 vii} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 946771200 test clock-12.54 {parse ccyyWwwd} { clock scan {1999 W52 ?} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 946771200 test clock-12.55 {parse ccyyWwwd} { clock scan {2000 W05 Mon} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 949276800 test clock-12.56 {parse ccyyWwwd} { clock scan {2000 W05 Monday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 949276800 test clock-12.57 {parse ccyyWwwd} { clock scan {2000 W05 1} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 949276800 test clock-12.58 {parse ccyyWwwd} { clock scan {2000 W05 1} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 949276800 test clock-12.59 {parse ccyyWwwd} { clock scan {2000 W05 i} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 949276800 test clock-12.60 {parse ccyyWwwd} { clock scan {2000 W05 i} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 949276800 test clock-12.61 {parse ccyyWwwd} { clock scan {2000 W48 Sat} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 975715200 test clock-12.62 {parse ccyyWwwd} { clock scan {2000 W48 Saturday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 975715200 test clock-12.63 {parse ccyyWwwd} { clock scan {2000 W48 6} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 975715200 test clock-12.64 {parse ccyyWwwd} { clock scan {2000 W48 6} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 975715200 test clock-12.65 {parse ccyyWwwd} { clock scan {2000 W48 vi} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 975715200 test clock-12.66 {parse ccyyWwwd} { clock scan {2000 W48 vi} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 975715200 test clock-12.67 {parse ccyyWwwd} { clock scan {2000 W52 Sun} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 978220800 test clock-12.68 {parse ccyyWwwd} { clock scan {2000 W52 Sunday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 978220800 test clock-12.69 {parse ccyyWwwd} { clock scan {2000 W52 7} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 978220800 test clock-12.70 {parse ccyyWwwd} { clock scan {2000 W52 0} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 978220800 test clock-12.71 {parse ccyyWwwd} { clock scan {2000 W52 vii} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 978220800 test clock-12.72 {parse ccyyWwwd} { clock scan {2000 W52 ?} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 978220800 test clock-12.73 {parse ccyyWwwd} { clock scan {2001 W01 Tue} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 978393600 test clock-12.74 {parse ccyyWwwd} { clock scan {2001 W01 Tuesday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 978393600 test clock-12.75 {parse ccyyWwwd} { clock scan {2001 W01 2} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 978393600 test clock-12.76 {parse ccyyWwwd} { clock scan {2001 W01 2} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 978393600 test clock-12.77 {parse ccyyWwwd} { clock scan {2001 W01 ii} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 978393600 test clock-12.78 {parse ccyyWwwd} { clock scan {2001 W01 ii} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 978393600 test clock-12.79 {parse ccyyWwwd} { clock scan {2001 W05 Wed} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 980899200 test clock-12.80 {parse ccyyWwwd} { clock scan {2001 W05 Wednesday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 980899200 test clock-12.81 {parse ccyyWwwd} { clock scan {2001 W05 3} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 980899200 test clock-12.82 {parse ccyyWwwd} { clock scan {2001 W05 3} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 980899200 test clock-12.83 {parse ccyyWwwd} { clock scan {2001 W05 iii} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 980899200 test clock-12.84 {parse ccyyWwwd} { clock scan {2001 W05 iii} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 980899200 test clock-12.85 {parse ccyyWwwd} { clock scan {2001 W48 Sun} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 1007251200 test clock-12.86 {parse ccyyWwwd} { clock scan {2001 W48 Sunday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 1007251200 test clock-12.87 {parse ccyyWwwd} { clock scan {2001 W48 7} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 1007251200 test clock-12.88 {parse ccyyWwwd} { clock scan {2001 W48 0} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 1007251200 test clock-12.89 {parse ccyyWwwd} { clock scan {2001 W48 vii} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 1007251200 test clock-12.90 {parse ccyyWwwd} { clock scan {2001 W48 ?} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 1007251200 test clock-12.91 {parse ccyyWwwd} { clock scan {2002 W01 Mon} -format {%G W%V %a} -locale en_US_roman -gmt 1 } 1009756800 test clock-12.92 {parse ccyyWwwd} { clock scan {2002 W01 Monday} -format {%G W%V %A} -locale en_US_roman -gmt 1 } 1009756800 test clock-12.93 {parse ccyyWwwd} { clock scan {2002 W01 1} -format {%G W%V %u} -locale en_US_roman -gmt 1 } 1009756800 test clock-12.94 {parse ccyyWwwd} { clock scan {2002 W01 1} -format {%G W%V %w} -locale en_US_roman -gmt 1 } 1009756800 test clock-12.95 {parse ccyyWwwd} { clock scan {2002 W01 i} -format {%G W%V %Ou} -locale en_US_roman -gmt 1 } 1009756800 test clock-12.96 {parse ccyyWwwd} { clock scan {2002 W01 i} -format {%G W%V %Ow} -locale en_US_roman -gmt 1 } 1009756800 # END testcases12 test clock-13.1 {test that %s takes precedence over ccyyWwwd} { list [clock scan {0 2000W011} -format {%s %GW%V%u} -gmt true] \ [clock scan {2000W011 0} -format {%GW%V%u %s} -gmt true] } {0 0} test clock-13.2 {test that %J takes precedence over ccyyWwwd} { list [clock scan {2440588 2000W011} -format {%J %GW%V%u} -gmt true] \ [clock scan {2000W011 2440588} -format {%GW%V%u %J} -gmt true] } {0 0} test clock-13.3 {invalid weekday} { catch {clock scan 2000W018 -format %GW%V%u -gmt true} result list $result $::errorCode } {{day of week is greater than 7} {CLOCK badDayOfWeek}} test clock-13.4 {invalid weekday} { catch { clock scan {2000 W01 viii} \ -format {%G W%V %Ou} -gmt true -locale en_US_roman } result list $result $::errorCode } {{day of week is greater than 7} {CLOCK badDayOfWeek}} # BEGIN testcases14 # Test parsing of yymmdd test clock-14.1 {parse yymmdd} { clock scan {38 Jan 02} -format {%y %b %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.2 {parse yymmdd} { clock scan {38 Jan ii} -format {%y %b %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.3 {parse yymmdd} { clock scan {38 Jan 2} -format {%y %b %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.4 {parse yymmdd} { clock scan {38 Jan ii} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.5 {parse yymmdd} { clock scan {38 January 02} -format {%y %B %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.6 {parse yymmdd} { clock scan {38 January ii} -format {%y %B %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.7 {parse yymmdd} { clock scan {38 January 2} -format {%y %B %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.8 {parse yymmdd} { clock scan {38 January ii} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.9 {parse yymmdd} { clock scan {38 Jan 02} -format {%y %h %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.10 {parse yymmdd} { clock scan {38 Jan ii} -format {%y %h %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.11 {parse yymmdd} { clock scan {38 Jan 2} -format {%y %h %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.12 {parse yymmdd} { clock scan {38 Jan ii} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.13 {parse yymmdd} { clock scan {38 01 02} -format {%y %m %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.14 {parse yymmdd} { clock scan {38 01 ii} -format {%y %m %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.15 {parse yymmdd} { clock scan {38 01 2} -format {%y %m %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.16 {parse yymmdd} { clock scan {38 01 ii} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.17 {parse yymmdd} { clock scan {38 i 02} -format {%y %Om %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.18 {parse yymmdd} { clock scan {38 i ii} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.19 {parse yymmdd} { clock scan {38 i 2} -format {%y %Om %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.20 {parse yymmdd} { clock scan {38 i ii} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.21 {parse yymmdd} { clock scan {38 1 02} -format {%y %N %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.22 {parse yymmdd} { clock scan {38 1 ii} -format {%y %N %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.23 {parse yymmdd} { clock scan {38 1 2} -format {%y %N %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.24 {parse yymmdd} { clock scan {38 1 ii} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.25 {parse yymmdd} { clock scan {xxxviii Jan 02} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.26 {parse yymmdd} { clock scan {xxxviii Jan ii} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.27 {parse yymmdd} { clock scan {xxxviii Jan 2} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.28 {parse yymmdd} { clock scan {xxxviii Jan ii} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.29 {parse yymmdd} { clock scan {xxxviii January 02} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.30 {parse yymmdd} { clock scan {xxxviii January ii} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.31 {parse yymmdd} { clock scan {xxxviii January 2} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.32 {parse yymmdd} { clock scan {xxxviii January ii} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.33 {parse yymmdd} { clock scan {xxxviii Jan 02} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.34 {parse yymmdd} { clock scan {xxxviii Jan ii} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.35 {parse yymmdd} { clock scan {xxxviii Jan 2} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.36 {parse yymmdd} { clock scan {xxxviii Jan ii} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.37 {parse yymmdd} { clock scan {xxxviii 01 02} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.38 {parse yymmdd} { clock scan {xxxviii 01 ii} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.39 {parse yymmdd} { clock scan {xxxviii 01 2} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.40 {parse yymmdd} { clock scan {xxxviii 01 ii} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.41 {parse yymmdd} { clock scan {xxxviii i 02} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.42 {parse yymmdd} { clock scan {xxxviii i ii} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.43 {parse yymmdd} { clock scan {xxxviii i 2} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.44 {parse yymmdd} { clock scan {xxxviii i ii} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.45 {parse yymmdd} { clock scan {xxxviii 1 02} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.46 {parse yymmdd} { clock scan {xxxviii 1 ii} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.47 {parse yymmdd} { clock scan {xxxviii 1 2} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.48 {parse yymmdd} { clock scan {xxxviii 1 ii} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } -1009756800 test clock-14.49 {parse yymmdd} { clock scan {38 Jan 31} -format {%y %b %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.50 {parse yymmdd} { clock scan {38 Jan xxxi} -format {%y %b %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.51 {parse yymmdd} { clock scan {38 Jan 31} -format {%y %b %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.52 {parse yymmdd} { clock scan {38 Jan xxxi} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.53 {parse yymmdd} { clock scan {38 January 31} -format {%y %B %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.54 {parse yymmdd} { clock scan {38 January xxxi} -format {%y %B %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.55 {parse yymmdd} { clock scan {38 January 31} -format {%y %B %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.56 {parse yymmdd} { clock scan {38 January xxxi} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.57 {parse yymmdd} { clock scan {38 Jan 31} -format {%y %h %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.58 {parse yymmdd} { clock scan {38 Jan xxxi} -format {%y %h %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.59 {parse yymmdd} { clock scan {38 Jan 31} -format {%y %h %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.60 {parse yymmdd} { clock scan {38 Jan xxxi} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.61 {parse yymmdd} { clock scan {38 01 31} -format {%y %m %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.62 {parse yymmdd} { clock scan {38 01 xxxi} -format {%y %m %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.63 {parse yymmdd} { clock scan {38 01 31} -format {%y %m %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.64 {parse yymmdd} { clock scan {38 01 xxxi} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.65 {parse yymmdd} { clock scan {38 i 31} -format {%y %Om %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.66 {parse yymmdd} { clock scan {38 i xxxi} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.67 {parse yymmdd} { clock scan {38 i 31} -format {%y %Om %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.68 {parse yymmdd} { clock scan {38 i xxxi} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.69 {parse yymmdd} { clock scan {38 1 31} -format {%y %N %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.70 {parse yymmdd} { clock scan {38 1 xxxi} -format {%y %N %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.71 {parse yymmdd} { clock scan {38 1 31} -format {%y %N %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.72 {parse yymmdd} { clock scan {38 1 xxxi} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.73 {parse yymmdd} { clock scan {xxxviii Jan 31} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.74 {parse yymmdd} { clock scan {xxxviii Jan xxxi} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.75 {parse yymmdd} { clock scan {xxxviii Jan 31} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.76 {parse yymmdd} { clock scan {xxxviii Jan xxxi} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.77 {parse yymmdd} { clock scan {xxxviii January 31} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.78 {parse yymmdd} { clock scan {xxxviii January xxxi} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.79 {parse yymmdd} { clock scan {xxxviii January 31} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.80 {parse yymmdd} { clock scan {xxxviii January xxxi} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.81 {parse yymmdd} { clock scan {xxxviii Jan 31} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.82 {parse yymmdd} { clock scan {xxxviii Jan xxxi} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.83 {parse yymmdd} { clock scan {xxxviii Jan 31} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.84 {parse yymmdd} { clock scan {xxxviii Jan xxxi} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.85 {parse yymmdd} { clock scan {xxxviii 01 31} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.86 {parse yymmdd} { clock scan {xxxviii 01 xxxi} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.87 {parse yymmdd} { clock scan {xxxviii 01 31} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.88 {parse yymmdd} { clock scan {xxxviii 01 xxxi} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.89 {parse yymmdd} { clock scan {xxxviii i 31} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.90 {parse yymmdd} { clock scan {xxxviii i xxxi} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.91 {parse yymmdd} { clock scan {xxxviii i 31} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.92 {parse yymmdd} { clock scan {xxxviii i xxxi} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.93 {parse yymmdd} { clock scan {xxxviii 1 31} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.94 {parse yymmdd} { clock scan {xxxviii 1 xxxi} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.95 {parse yymmdd} { clock scan {xxxviii 1 31} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.96 {parse yymmdd} { clock scan {xxxviii 1 xxxi} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } -1007251200 test clock-14.97 {parse yymmdd} { clock scan {38 Dec 02} -format {%y %b %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.98 {parse yymmdd} { clock scan {38 Dec ii} -format {%y %b %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.99 {parse yymmdd} { clock scan {38 Dec 2} -format {%y %b %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.100 {parse yymmdd} { clock scan {38 Dec ii} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.101 {parse yymmdd} { clock scan {38 December 02} -format {%y %B %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.102 {parse yymmdd} { clock scan {38 December ii} -format {%y %B %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.103 {parse yymmdd} { clock scan {38 December 2} -format {%y %B %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.104 {parse yymmdd} { clock scan {38 December ii} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.105 {parse yymmdd} { clock scan {38 Dec 02} -format {%y %h %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.106 {parse yymmdd} { clock scan {38 Dec ii} -format {%y %h %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.107 {parse yymmdd} { clock scan {38 Dec 2} -format {%y %h %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.108 {parse yymmdd} { clock scan {38 Dec ii} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.109 {parse yymmdd} { clock scan {38 12 02} -format {%y %m %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.110 {parse yymmdd} { clock scan {38 12 ii} -format {%y %m %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.111 {parse yymmdd} { clock scan {38 12 2} -format {%y %m %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.112 {parse yymmdd} { clock scan {38 12 ii} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.113 {parse yymmdd} { clock scan {38 xii 02} -format {%y %Om %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.114 {parse yymmdd} { clock scan {38 xii ii} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.115 {parse yymmdd} { clock scan {38 xii 2} -format {%y %Om %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.116 {parse yymmdd} { clock scan {38 xii ii} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.117 {parse yymmdd} { clock scan {38 12 02} -format {%y %N %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.118 {parse yymmdd} { clock scan {38 12 ii} -format {%y %N %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.119 {parse yymmdd} { clock scan {38 12 2} -format {%y %N %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.120 {parse yymmdd} { clock scan {38 12 ii} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.121 {parse yymmdd} { clock scan {xxxviii Dec 02} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.122 {parse yymmdd} { clock scan {xxxviii Dec ii} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.123 {parse yymmdd} { clock scan {xxxviii Dec 2} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.124 {parse yymmdd} { clock scan {xxxviii Dec ii} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.125 {parse yymmdd} { clock scan {xxxviii December 02} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.126 {parse yymmdd} { clock scan {xxxviii December ii} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.127 {parse yymmdd} { clock scan {xxxviii December 2} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.128 {parse yymmdd} { clock scan {xxxviii December ii} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.129 {parse yymmdd} { clock scan {xxxviii Dec 02} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.130 {parse yymmdd} { clock scan {xxxviii Dec ii} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.131 {parse yymmdd} { clock scan {xxxviii Dec 2} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.132 {parse yymmdd} { clock scan {xxxviii Dec ii} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.133 {parse yymmdd} { clock scan {xxxviii 12 02} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.134 {parse yymmdd} { clock scan {xxxviii 12 ii} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.135 {parse yymmdd} { clock scan {xxxviii 12 2} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.136 {parse yymmdd} { clock scan {xxxviii 12 ii} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.137 {parse yymmdd} { clock scan {xxxviii xii 02} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.138 {parse yymmdd} { clock scan {xxxviii xii ii} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.139 {parse yymmdd} { clock scan {xxxviii xii 2} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.140 {parse yymmdd} { clock scan {xxxviii xii ii} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.141 {parse yymmdd} { clock scan {xxxviii 12 02} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } -980899200 test clock-14.142 {parse yymmdd} { clock scan {xxxviii 12 ii} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } -980899200 test clock-14.143 {parse yymmdd} { clock scan {xxxviii 12 2} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } -980899200 test clock-14.144 {parse yymmdd} { clock scan {xxxviii 12 ii} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } -980899200 test clock-14.145 {parse yymmdd} { clock scan {38 Dec 31} -format {%y %b %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.146 {parse yymmdd} { clock scan {38 Dec xxxi} -format {%y %b %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.147 {parse yymmdd} { clock scan {38 Dec 31} -format {%y %b %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.148 {parse yymmdd} { clock scan {38 Dec xxxi} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.149 {parse yymmdd} { clock scan {38 December 31} -format {%y %B %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.150 {parse yymmdd} { clock scan {38 December xxxi} -format {%y %B %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.151 {parse yymmdd} { clock scan {38 December 31} -format {%y %B %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.152 {parse yymmdd} { clock scan {38 December xxxi} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.153 {parse yymmdd} { clock scan {38 Dec 31} -format {%y %h %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.154 {parse yymmdd} { clock scan {38 Dec xxxi} -format {%y %h %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.155 {parse yymmdd} { clock scan {38 Dec 31} -format {%y %h %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.156 {parse yymmdd} { clock scan {38 Dec xxxi} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.157 {parse yymmdd} { clock scan {38 12 31} -format {%y %m %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.158 {parse yymmdd} { clock scan {38 12 xxxi} -format {%y %m %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.159 {parse yymmdd} { clock scan {38 12 31} -format {%y %m %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.160 {parse yymmdd} { clock scan {38 12 xxxi} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.161 {parse yymmdd} { clock scan {38 xii 31} -format {%y %Om %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.162 {parse yymmdd} { clock scan {38 xii xxxi} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.163 {parse yymmdd} { clock scan {38 xii 31} -format {%y %Om %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.164 {parse yymmdd} { clock scan {38 xii xxxi} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.165 {parse yymmdd} { clock scan {38 12 31} -format {%y %N %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.166 {parse yymmdd} { clock scan {38 12 xxxi} -format {%y %N %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.167 {parse yymmdd} { clock scan {38 12 31} -format {%y %N %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.168 {parse yymmdd} { clock scan {38 12 xxxi} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.169 {parse yymmdd} { clock scan {xxxviii Dec 31} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.170 {parse yymmdd} { clock scan {xxxviii Dec xxxi} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.171 {parse yymmdd} { clock scan {xxxviii Dec 31} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.172 {parse yymmdd} { clock scan {xxxviii Dec xxxi} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.173 {parse yymmdd} { clock scan {xxxviii December 31} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.174 {parse yymmdd} { clock scan {xxxviii December xxxi} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.175 {parse yymmdd} { clock scan {xxxviii December 31} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.176 {parse yymmdd} { clock scan {xxxviii December xxxi} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.177 {parse yymmdd} { clock scan {xxxviii Dec 31} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.178 {parse yymmdd} { clock scan {xxxviii Dec xxxi} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.179 {parse yymmdd} { clock scan {xxxviii Dec 31} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.180 {parse yymmdd} { clock scan {xxxviii Dec xxxi} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.181 {parse yymmdd} { clock scan {xxxviii 12 31} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.182 {parse yymmdd} { clock scan {xxxviii 12 xxxi} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.183 {parse yymmdd} { clock scan {xxxviii 12 31} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.184 {parse yymmdd} { clock scan {xxxviii 12 xxxi} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.185 {parse yymmdd} { clock scan {xxxviii xii 31} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.186 {parse yymmdd} { clock scan {xxxviii xii xxxi} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.187 {parse yymmdd} { clock scan {xxxviii xii 31} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.188 {parse yymmdd} { clock scan {xxxviii xii xxxi} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.189 {parse yymmdd} { clock scan {xxxviii 12 31} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } -978393600 test clock-14.190 {parse yymmdd} { clock scan {xxxviii 12 xxxi} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } -978393600 test clock-14.191 {parse yymmdd} { clock scan {xxxviii 12 31} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } -978393600 test clock-14.192 {parse yymmdd} { clock scan {xxxviii 12 xxxi} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } -978393600 test clock-14.193 {parse yymmdd} { clock scan {70 Jan 02} -format {%y %b %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.194 {parse yymmdd} { clock scan {70 Jan ii} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.195 {parse yymmdd} { clock scan {70 Jan 2} -format {%y %b %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.196 {parse yymmdd} { clock scan {70 Jan ii} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.197 {parse yymmdd} { clock scan {70 January 02} -format {%y %B %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.198 {parse yymmdd} { clock scan {70 January ii} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.199 {parse yymmdd} { clock scan {70 January 2} -format {%y %B %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.200 {parse yymmdd} { clock scan {70 January ii} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.201 {parse yymmdd} { clock scan {70 Jan 02} -format {%y %h %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.202 {parse yymmdd} { clock scan {70 Jan ii} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.203 {parse yymmdd} { clock scan {70 Jan 2} -format {%y %h %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.204 {parse yymmdd} { clock scan {70 Jan ii} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.205 {parse yymmdd} { clock scan {70 01 02} -format {%y %m %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.206 {parse yymmdd} { clock scan {70 01 ii} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.207 {parse yymmdd} { clock scan {70 01 2} -format {%y %m %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.208 {parse yymmdd} { clock scan {70 01 ii} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.209 {parse yymmdd} { clock scan {70 i 02} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.210 {parse yymmdd} { clock scan {70 i ii} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.211 {parse yymmdd} { clock scan {70 i 2} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.212 {parse yymmdd} { clock scan {70 i ii} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.213 {parse yymmdd} { clock scan {70 1 02} -format {%y %N %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.214 {parse yymmdd} { clock scan {70 1 ii} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.215 {parse yymmdd} { clock scan {70 1 2} -format {%y %N %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.216 {parse yymmdd} { clock scan {70 1 ii} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.217 {parse yymmdd} { clock scan {lxx Jan 02} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.218 {parse yymmdd} { clock scan {lxx Jan ii} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.219 {parse yymmdd} { clock scan {lxx Jan 2} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.220 {parse yymmdd} { clock scan {lxx Jan ii} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.221 {parse yymmdd} { clock scan {lxx January 02} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.222 {parse yymmdd} { clock scan {lxx January ii} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.223 {parse yymmdd} { clock scan {lxx January 2} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.224 {parse yymmdd} { clock scan {lxx January ii} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.225 {parse yymmdd} { clock scan {lxx Jan 02} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.226 {parse yymmdd} { clock scan {lxx Jan ii} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.227 {parse yymmdd} { clock scan {lxx Jan 2} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.228 {parse yymmdd} { clock scan {lxx Jan ii} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.229 {parse yymmdd} { clock scan {lxx 01 02} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.230 {parse yymmdd} { clock scan {lxx 01 ii} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.231 {parse yymmdd} { clock scan {lxx 01 2} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.232 {parse yymmdd} { clock scan {lxx 01 ii} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.233 {parse yymmdd} { clock scan {lxx i 02} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.234 {parse yymmdd} { clock scan {lxx i ii} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.235 {parse yymmdd} { clock scan {lxx i 2} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.236 {parse yymmdd} { clock scan {lxx i ii} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.237 {parse yymmdd} { clock scan {lxx 1 02} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 86400 test clock-14.238 {parse yymmdd} { clock scan {lxx 1 ii} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 86400 test clock-14.239 {parse yymmdd} { clock scan {lxx 1 2} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 86400 test clock-14.240 {parse yymmdd} { clock scan {lxx 1 ii} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 86400 test clock-14.241 {parse yymmdd} { clock scan {70 Jan 31} -format {%y %b %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.242 {parse yymmdd} { clock scan {70 Jan xxxi} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.243 {parse yymmdd} { clock scan {70 Jan 31} -format {%y %b %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.244 {parse yymmdd} { clock scan {70 Jan xxxi} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.245 {parse yymmdd} { clock scan {70 January 31} -format {%y %B %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.246 {parse yymmdd} { clock scan {70 January xxxi} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.247 {parse yymmdd} { clock scan {70 January 31} -format {%y %B %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.248 {parse yymmdd} { clock scan {70 January xxxi} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.249 {parse yymmdd} { clock scan {70 Jan 31} -format {%y %h %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.250 {parse yymmdd} { clock scan {70 Jan xxxi} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.251 {parse yymmdd} { clock scan {70 Jan 31} -format {%y %h %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.252 {parse yymmdd} { clock scan {70 Jan xxxi} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.253 {parse yymmdd} { clock scan {70 01 31} -format {%y %m %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.254 {parse yymmdd} { clock scan {70 01 xxxi} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.255 {parse yymmdd} { clock scan {70 01 31} -format {%y %m %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.256 {parse yymmdd} { clock scan {70 01 xxxi} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.257 {parse yymmdd} { clock scan {70 i 31} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.258 {parse yymmdd} { clock scan {70 i xxxi} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.259 {parse yymmdd} { clock scan {70 i 31} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.260 {parse yymmdd} { clock scan {70 i xxxi} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.261 {parse yymmdd} { clock scan {70 1 31} -format {%y %N %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.262 {parse yymmdd} { clock scan {70 1 xxxi} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.263 {parse yymmdd} { clock scan {70 1 31} -format {%y %N %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.264 {parse yymmdd} { clock scan {70 1 xxxi} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.265 {parse yymmdd} { clock scan {lxx Jan 31} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.266 {parse yymmdd} { clock scan {lxx Jan xxxi} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.267 {parse yymmdd} { clock scan {lxx Jan 31} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.268 {parse yymmdd} { clock scan {lxx Jan xxxi} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.269 {parse yymmdd} { clock scan {lxx January 31} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.270 {parse yymmdd} { clock scan {lxx January xxxi} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.271 {parse yymmdd} { clock scan {lxx January 31} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.272 {parse yymmdd} { clock scan {lxx January xxxi} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.273 {parse yymmdd} { clock scan {lxx Jan 31} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.274 {parse yymmdd} { clock scan {lxx Jan xxxi} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.275 {parse yymmdd} { clock scan {lxx Jan 31} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.276 {parse yymmdd} { clock scan {lxx Jan xxxi} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.277 {parse yymmdd} { clock scan {lxx 01 31} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.278 {parse yymmdd} { clock scan {lxx 01 xxxi} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.279 {parse yymmdd} { clock scan {lxx 01 31} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.280 {parse yymmdd} { clock scan {lxx 01 xxxi} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.281 {parse yymmdd} { clock scan {lxx i 31} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.282 {parse yymmdd} { clock scan {lxx i xxxi} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.283 {parse yymmdd} { clock scan {lxx i 31} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.284 {parse yymmdd} { clock scan {lxx i xxxi} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.285 {parse yymmdd} { clock scan {lxx 1 31} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 2592000 test clock-14.286 {parse yymmdd} { clock scan {lxx 1 xxxi} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 2592000 test clock-14.287 {parse yymmdd} { clock scan {lxx 1 31} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 2592000 test clock-14.288 {parse yymmdd} { clock scan {lxx 1 xxxi} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 2592000 test clock-14.289 {parse yymmdd} { clock scan {70 Dec 02} -format {%y %b %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.290 {parse yymmdd} { clock scan {70 Dec ii} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.291 {parse yymmdd} { clock scan {70 Dec 2} -format {%y %b %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.292 {parse yymmdd} { clock scan {70 Dec ii} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.293 {parse yymmdd} { clock scan {70 December 02} -format {%y %B %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.294 {parse yymmdd} { clock scan {70 December ii} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.295 {parse yymmdd} { clock scan {70 December 2} -format {%y %B %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.296 {parse yymmdd} { clock scan {70 December ii} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.297 {parse yymmdd} { clock scan {70 Dec 02} -format {%y %h %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.298 {parse yymmdd} { clock scan {70 Dec ii} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.299 {parse yymmdd} { clock scan {70 Dec 2} -format {%y %h %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.300 {parse yymmdd} { clock scan {70 Dec ii} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.301 {parse yymmdd} { clock scan {70 12 02} -format {%y %m %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.302 {parse yymmdd} { clock scan {70 12 ii} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.303 {parse yymmdd} { clock scan {70 12 2} -format {%y %m %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.304 {parse yymmdd} { clock scan {70 12 ii} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.305 {parse yymmdd} { clock scan {70 xii 02} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.306 {parse yymmdd} { clock scan {70 xii ii} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.307 {parse yymmdd} { clock scan {70 xii 2} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.308 {parse yymmdd} { clock scan {70 xii ii} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.309 {parse yymmdd} { clock scan {70 12 02} -format {%y %N %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.310 {parse yymmdd} { clock scan {70 12 ii} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.311 {parse yymmdd} { clock scan {70 12 2} -format {%y %N %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.312 {parse yymmdd} { clock scan {70 12 ii} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.313 {parse yymmdd} { clock scan {lxx Dec 02} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.314 {parse yymmdd} { clock scan {lxx Dec ii} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.315 {parse yymmdd} { clock scan {lxx Dec 2} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.316 {parse yymmdd} { clock scan {lxx Dec ii} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.317 {parse yymmdd} { clock scan {lxx December 02} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.318 {parse yymmdd} { clock scan {lxx December ii} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.319 {parse yymmdd} { clock scan {lxx December 2} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.320 {parse yymmdd} { clock scan {lxx December ii} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.321 {parse yymmdd} { clock scan {lxx Dec 02} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.322 {parse yymmdd} { clock scan {lxx Dec ii} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.323 {parse yymmdd} { clock scan {lxx Dec 2} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.324 {parse yymmdd} { clock scan {lxx Dec ii} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.325 {parse yymmdd} { clock scan {lxx 12 02} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.326 {parse yymmdd} { clock scan {lxx 12 ii} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.327 {parse yymmdd} { clock scan {lxx 12 2} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.328 {parse yymmdd} { clock scan {lxx 12 ii} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.329 {parse yymmdd} { clock scan {lxx xii 02} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.330 {parse yymmdd} { clock scan {lxx xii ii} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.331 {parse yymmdd} { clock scan {lxx xii 2} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.332 {parse yymmdd} { clock scan {lxx xii ii} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.333 {parse yymmdd} { clock scan {lxx 12 02} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 28944000 test clock-14.334 {parse yymmdd} { clock scan {lxx 12 ii} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 28944000 test clock-14.335 {parse yymmdd} { clock scan {lxx 12 2} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 28944000 test clock-14.336 {parse yymmdd} { clock scan {lxx 12 ii} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 28944000 test clock-14.337 {parse yymmdd} { clock scan {70 Dec 31} -format {%y %b %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.338 {parse yymmdd} { clock scan {70 Dec xxxi} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.339 {parse yymmdd} { clock scan {70 Dec 31} -format {%y %b %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.340 {parse yymmdd} { clock scan {70 Dec xxxi} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.341 {parse yymmdd} { clock scan {70 December 31} -format {%y %B %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.342 {parse yymmdd} { clock scan {70 December xxxi} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.343 {parse yymmdd} { clock scan {70 December 31} -format {%y %B %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.344 {parse yymmdd} { clock scan {70 December xxxi} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.345 {parse yymmdd} { clock scan {70 Dec 31} -format {%y %h %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.346 {parse yymmdd} { clock scan {70 Dec xxxi} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.347 {parse yymmdd} { clock scan {70 Dec 31} -format {%y %h %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.348 {parse yymmdd} { clock scan {70 Dec xxxi} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.349 {parse yymmdd} { clock scan {70 12 31} -format {%y %m %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.350 {parse yymmdd} { clock scan {70 12 xxxi} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.351 {parse yymmdd} { clock scan {70 12 31} -format {%y %m %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.352 {parse yymmdd} { clock scan {70 12 xxxi} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.353 {parse yymmdd} { clock scan {70 xii 31} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.354 {parse yymmdd} { clock scan {70 xii xxxi} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.355 {parse yymmdd} { clock scan {70 xii 31} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.356 {parse yymmdd} { clock scan {70 xii xxxi} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.357 {parse yymmdd} { clock scan {70 12 31} -format {%y %N %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.358 {parse yymmdd} { clock scan {70 12 xxxi} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.359 {parse yymmdd} { clock scan {70 12 31} -format {%y %N %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.360 {parse yymmdd} { clock scan {70 12 xxxi} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.361 {parse yymmdd} { clock scan {lxx Dec 31} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.362 {parse yymmdd} { clock scan {lxx Dec xxxi} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.363 {parse yymmdd} { clock scan {lxx Dec 31} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.364 {parse yymmdd} { clock scan {lxx Dec xxxi} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.365 {parse yymmdd} { clock scan {lxx December 31} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.366 {parse yymmdd} { clock scan {lxx December xxxi} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.367 {parse yymmdd} { clock scan {lxx December 31} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.368 {parse yymmdd} { clock scan {lxx December xxxi} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.369 {parse yymmdd} { clock scan {lxx Dec 31} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.370 {parse yymmdd} { clock scan {lxx Dec xxxi} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.371 {parse yymmdd} { clock scan {lxx Dec 31} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.372 {parse yymmdd} { clock scan {lxx Dec xxxi} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.373 {parse yymmdd} { clock scan {lxx 12 31} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.374 {parse yymmdd} { clock scan {lxx 12 xxxi} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.375 {parse yymmdd} { clock scan {lxx 12 31} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.376 {parse yymmdd} { clock scan {lxx 12 xxxi} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.377 {parse yymmdd} { clock scan {lxx xii 31} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.378 {parse yymmdd} { clock scan {lxx xii xxxi} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.379 {parse yymmdd} { clock scan {lxx xii 31} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.380 {parse yymmdd} { clock scan {lxx xii xxxi} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.381 {parse yymmdd} { clock scan {lxx 12 31} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 31449600 test clock-14.382 {parse yymmdd} { clock scan {lxx 12 xxxi} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 31449600 test clock-14.383 {parse yymmdd} { clock scan {lxx 12 31} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 31449600 test clock-14.384 {parse yymmdd} { clock scan {lxx 12 xxxi} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 31449600 test clock-14.385 {parse yymmdd} { clock scan {00 Jan 02} -format {%y %b %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.386 {parse yymmdd} { clock scan {00 Jan ii} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.387 {parse yymmdd} { clock scan {00 Jan 2} -format {%y %b %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.388 {parse yymmdd} { clock scan {00 Jan ii} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.389 {parse yymmdd} { clock scan {00 January 02} -format {%y %B %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.390 {parse yymmdd} { clock scan {00 January ii} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.391 {parse yymmdd} { clock scan {00 January 2} -format {%y %B %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.392 {parse yymmdd} { clock scan {00 January ii} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.393 {parse yymmdd} { clock scan {00 Jan 02} -format {%y %h %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.394 {parse yymmdd} { clock scan {00 Jan ii} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.395 {parse yymmdd} { clock scan {00 Jan 2} -format {%y %h %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.396 {parse yymmdd} { clock scan {00 Jan ii} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.397 {parse yymmdd} { clock scan {00 01 02} -format {%y %m %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.398 {parse yymmdd} { clock scan {00 01 ii} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.399 {parse yymmdd} { clock scan {00 01 2} -format {%y %m %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.400 {parse yymmdd} { clock scan {00 01 ii} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.401 {parse yymmdd} { clock scan {00 i 02} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.402 {parse yymmdd} { clock scan {00 i ii} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.403 {parse yymmdd} { clock scan {00 i 2} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.404 {parse yymmdd} { clock scan {00 i ii} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.405 {parse yymmdd} { clock scan {00 1 02} -format {%y %N %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.406 {parse yymmdd} { clock scan {00 1 ii} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.407 {parse yymmdd} { clock scan {00 1 2} -format {%y %N %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.408 {parse yymmdd} { clock scan {00 1 ii} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.409 {parse yymmdd} { clock scan {? Jan 02} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.410 {parse yymmdd} { clock scan {? Jan ii} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.411 {parse yymmdd} { clock scan {? Jan 2} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.412 {parse yymmdd} { clock scan {? Jan ii} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.413 {parse yymmdd} { clock scan {? January 02} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.414 {parse yymmdd} { clock scan {? January ii} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.415 {parse yymmdd} { clock scan {? January 2} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.416 {parse yymmdd} { clock scan {? January ii} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.417 {parse yymmdd} { clock scan {? Jan 02} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.418 {parse yymmdd} { clock scan {? Jan ii} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.419 {parse yymmdd} { clock scan {? Jan 2} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.420 {parse yymmdd} { clock scan {? Jan ii} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.421 {parse yymmdd} { clock scan {? 01 02} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.422 {parse yymmdd} { clock scan {? 01 ii} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.423 {parse yymmdd} { clock scan {? 01 2} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.424 {parse yymmdd} { clock scan {? 01 ii} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.425 {parse yymmdd} { clock scan {? i 02} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.426 {parse yymmdd} { clock scan {? i ii} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.427 {parse yymmdd} { clock scan {? i 2} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.428 {parse yymmdd} { clock scan {? i ii} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.429 {parse yymmdd} { clock scan {? 1 02} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 946771200 test clock-14.430 {parse yymmdd} { clock scan {? 1 ii} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 946771200 test clock-14.431 {parse yymmdd} { clock scan {? 1 2} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 946771200 test clock-14.432 {parse yymmdd} { clock scan {? 1 ii} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 946771200 test clock-14.433 {parse yymmdd} { clock scan {00 Jan 31} -format {%y %b %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.434 {parse yymmdd} { clock scan {00 Jan xxxi} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.435 {parse yymmdd} { clock scan {00 Jan 31} -format {%y %b %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.436 {parse yymmdd} { clock scan {00 Jan xxxi} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.437 {parse yymmdd} { clock scan {00 January 31} -format {%y %B %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.438 {parse yymmdd} { clock scan {00 January xxxi} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.439 {parse yymmdd} { clock scan {00 January 31} -format {%y %B %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.440 {parse yymmdd} { clock scan {00 January xxxi} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.441 {parse yymmdd} { clock scan {00 Jan 31} -format {%y %h %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.442 {parse yymmdd} { clock scan {00 Jan xxxi} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.443 {parse yymmdd} { clock scan {00 Jan 31} -format {%y %h %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.444 {parse yymmdd} { clock scan {00 Jan xxxi} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.445 {parse yymmdd} { clock scan {00 01 31} -format {%y %m %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.446 {parse yymmdd} { clock scan {00 01 xxxi} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.447 {parse yymmdd} { clock scan {00 01 31} -format {%y %m %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.448 {parse yymmdd} { clock scan {00 01 xxxi} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.449 {parse yymmdd} { clock scan {00 i 31} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.450 {parse yymmdd} { clock scan {00 i xxxi} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.451 {parse yymmdd} { clock scan {00 i 31} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.452 {parse yymmdd} { clock scan {00 i xxxi} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.453 {parse yymmdd} { clock scan {00 1 31} -format {%y %N %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.454 {parse yymmdd} { clock scan {00 1 xxxi} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.455 {parse yymmdd} { clock scan {00 1 31} -format {%y %N %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.456 {parse yymmdd} { clock scan {00 1 xxxi} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.457 {parse yymmdd} { clock scan {? Jan 31} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.458 {parse yymmdd} { clock scan {? Jan xxxi} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.459 {parse yymmdd} { clock scan {? Jan 31} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.460 {parse yymmdd} { clock scan {? Jan xxxi} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.461 {parse yymmdd} { clock scan {? January 31} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.462 {parse yymmdd} { clock scan {? January xxxi} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.463 {parse yymmdd} { clock scan {? January 31} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.464 {parse yymmdd} { clock scan {? January xxxi} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.465 {parse yymmdd} { clock scan {? Jan 31} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.466 {parse yymmdd} { clock scan {? Jan xxxi} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.467 {parse yymmdd} { clock scan {? Jan 31} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.468 {parse yymmdd} { clock scan {? Jan xxxi} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.469 {parse yymmdd} { clock scan {? 01 31} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.470 {parse yymmdd} { clock scan {? 01 xxxi} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.471 {parse yymmdd} { clock scan {? 01 31} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.472 {parse yymmdd} { clock scan {? 01 xxxi} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.473 {parse yymmdd} { clock scan {? i 31} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.474 {parse yymmdd} { clock scan {? i xxxi} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.475 {parse yymmdd} { clock scan {? i 31} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.476 {parse yymmdd} { clock scan {? i xxxi} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.477 {parse yymmdd} { clock scan {? 1 31} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 949276800 test clock-14.478 {parse yymmdd} { clock scan {? 1 xxxi} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 949276800 test clock-14.479 {parse yymmdd} { clock scan {? 1 31} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 949276800 test clock-14.480 {parse yymmdd} { clock scan {? 1 xxxi} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 949276800 test clock-14.481 {parse yymmdd} { clock scan {00 Dec 02} -format {%y %b %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.482 {parse yymmdd} { clock scan {00 Dec ii} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.483 {parse yymmdd} { clock scan {00 Dec 2} -format {%y %b %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.484 {parse yymmdd} { clock scan {00 Dec ii} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.485 {parse yymmdd} { clock scan {00 December 02} -format {%y %B %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.486 {parse yymmdd} { clock scan {00 December ii} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.487 {parse yymmdd} { clock scan {00 December 2} -format {%y %B %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.488 {parse yymmdd} { clock scan {00 December ii} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.489 {parse yymmdd} { clock scan {00 Dec 02} -format {%y %h %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.490 {parse yymmdd} { clock scan {00 Dec ii} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.491 {parse yymmdd} { clock scan {00 Dec 2} -format {%y %h %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.492 {parse yymmdd} { clock scan {00 Dec ii} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.493 {parse yymmdd} { clock scan {00 12 02} -format {%y %m %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.494 {parse yymmdd} { clock scan {00 12 ii} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.495 {parse yymmdd} { clock scan {00 12 2} -format {%y %m %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.496 {parse yymmdd} { clock scan {00 12 ii} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.497 {parse yymmdd} { clock scan {00 xii 02} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.498 {parse yymmdd} { clock scan {00 xii ii} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.499 {parse yymmdd} { clock scan {00 xii 2} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.500 {parse yymmdd} { clock scan {00 xii ii} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.501 {parse yymmdd} { clock scan {00 12 02} -format {%y %N %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.502 {parse yymmdd} { clock scan {00 12 ii} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.503 {parse yymmdd} { clock scan {00 12 2} -format {%y %N %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.504 {parse yymmdd} { clock scan {00 12 ii} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.505 {parse yymmdd} { clock scan {? Dec 02} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.506 {parse yymmdd} { clock scan {? Dec ii} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.507 {parse yymmdd} { clock scan {? Dec 2} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.508 {parse yymmdd} { clock scan {? Dec ii} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.509 {parse yymmdd} { clock scan {? December 02} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.510 {parse yymmdd} { clock scan {? December ii} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.511 {parse yymmdd} { clock scan {? December 2} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.512 {parse yymmdd} { clock scan {? December ii} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.513 {parse yymmdd} { clock scan {? Dec 02} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.514 {parse yymmdd} { clock scan {? Dec ii} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.515 {parse yymmdd} { clock scan {? Dec 2} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.516 {parse yymmdd} { clock scan {? Dec ii} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.517 {parse yymmdd} { clock scan {? 12 02} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.518 {parse yymmdd} { clock scan {? 12 ii} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.519 {parse yymmdd} { clock scan {? 12 2} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.520 {parse yymmdd} { clock scan {? 12 ii} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.521 {parse yymmdd} { clock scan {? xii 02} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.522 {parse yymmdd} { clock scan {? xii ii} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.523 {parse yymmdd} { clock scan {? xii 2} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.524 {parse yymmdd} { clock scan {? xii ii} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.525 {parse yymmdd} { clock scan {? 12 02} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 975715200 test clock-14.526 {parse yymmdd} { clock scan {? 12 ii} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 975715200 test clock-14.527 {parse yymmdd} { clock scan {? 12 2} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 975715200 test clock-14.528 {parse yymmdd} { clock scan {? 12 ii} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 975715200 test clock-14.529 {parse yymmdd} { clock scan {00 Dec 31} -format {%y %b %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.530 {parse yymmdd} { clock scan {00 Dec xxxi} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.531 {parse yymmdd} { clock scan {00 Dec 31} -format {%y %b %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.532 {parse yymmdd} { clock scan {00 Dec xxxi} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.533 {parse yymmdd} { clock scan {00 December 31} -format {%y %B %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.534 {parse yymmdd} { clock scan {00 December xxxi} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.535 {parse yymmdd} { clock scan {00 December 31} -format {%y %B %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.536 {parse yymmdd} { clock scan {00 December xxxi} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.537 {parse yymmdd} { clock scan {00 Dec 31} -format {%y %h %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.538 {parse yymmdd} { clock scan {00 Dec xxxi} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.539 {parse yymmdd} { clock scan {00 Dec 31} -format {%y %h %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.540 {parse yymmdd} { clock scan {00 Dec xxxi} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.541 {parse yymmdd} { clock scan {00 12 31} -format {%y %m %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.542 {parse yymmdd} { clock scan {00 12 xxxi} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.543 {parse yymmdd} { clock scan {00 12 31} -format {%y %m %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.544 {parse yymmdd} { clock scan {00 12 xxxi} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.545 {parse yymmdd} { clock scan {00 xii 31} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.546 {parse yymmdd} { clock scan {00 xii xxxi} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.547 {parse yymmdd} { clock scan {00 xii 31} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.548 {parse yymmdd} { clock scan {00 xii xxxi} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.549 {parse yymmdd} { clock scan {00 12 31} -format {%y %N %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.550 {parse yymmdd} { clock scan {00 12 xxxi} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.551 {parse yymmdd} { clock scan {00 12 31} -format {%y %N %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.552 {parse yymmdd} { clock scan {00 12 xxxi} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.553 {parse yymmdd} { clock scan {? Dec 31} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.554 {parse yymmdd} { clock scan {? Dec xxxi} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.555 {parse yymmdd} { clock scan {? Dec 31} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.556 {parse yymmdd} { clock scan {? Dec xxxi} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.557 {parse yymmdd} { clock scan {? December 31} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.558 {parse yymmdd} { clock scan {? December xxxi} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.559 {parse yymmdd} { clock scan {? December 31} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.560 {parse yymmdd} { clock scan {? December xxxi} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.561 {parse yymmdd} { clock scan {? Dec 31} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.562 {parse yymmdd} { clock scan {? Dec xxxi} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.563 {parse yymmdd} { clock scan {? Dec 31} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.564 {parse yymmdd} { clock scan {? Dec xxxi} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.565 {parse yymmdd} { clock scan {? 12 31} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.566 {parse yymmdd} { clock scan {? 12 xxxi} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.567 {parse yymmdd} { clock scan {? 12 31} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.568 {parse yymmdd} { clock scan {? 12 xxxi} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.569 {parse yymmdd} { clock scan {? xii 31} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.570 {parse yymmdd} { clock scan {? xii xxxi} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.571 {parse yymmdd} { clock scan {? xii 31} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.572 {parse yymmdd} { clock scan {? xii xxxi} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.573 {parse yymmdd} { clock scan {? 12 31} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 978220800 test clock-14.574 {parse yymmdd} { clock scan {? 12 xxxi} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 978220800 test clock-14.575 {parse yymmdd} { clock scan {? 12 31} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 978220800 test clock-14.576 {parse yymmdd} { clock scan {? 12 xxxi} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 978220800 test clock-14.577 {parse yymmdd} { clock scan {37 Jan 02} -format {%y %b %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.578 {parse yymmdd} { clock scan {37 Jan ii} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.579 {parse yymmdd} { clock scan {37 Jan 2} -format {%y %b %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.580 {parse yymmdd} { clock scan {37 Jan ii} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.581 {parse yymmdd} { clock scan {37 January 02} -format {%y %B %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.582 {parse yymmdd} { clock scan {37 January ii} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.583 {parse yymmdd} { clock scan {37 January 2} -format {%y %B %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.584 {parse yymmdd} { clock scan {37 January ii} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.585 {parse yymmdd} { clock scan {37 Jan 02} -format {%y %h %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.586 {parse yymmdd} { clock scan {37 Jan ii} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.587 {parse yymmdd} { clock scan {37 Jan 2} -format {%y %h %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.588 {parse yymmdd} { clock scan {37 Jan ii} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.589 {parse yymmdd} { clock scan {37 01 02} -format {%y %m %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.590 {parse yymmdd} { clock scan {37 01 ii} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.591 {parse yymmdd} { clock scan {37 01 2} -format {%y %m %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.592 {parse yymmdd} { clock scan {37 01 ii} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.593 {parse yymmdd} { clock scan {37 i 02} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.594 {parse yymmdd} { clock scan {37 i ii} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.595 {parse yymmdd} { clock scan {37 i 2} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.596 {parse yymmdd} { clock scan {37 i ii} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.597 {parse yymmdd} { clock scan {37 1 02} -format {%y %N %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.598 {parse yymmdd} { clock scan {37 1 ii} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.599 {parse yymmdd} { clock scan {37 1 2} -format {%y %N %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.600 {parse yymmdd} { clock scan {37 1 ii} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.601 {parse yymmdd} { clock scan {xxxvii Jan 02} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.602 {parse yymmdd} { clock scan {xxxvii Jan ii} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.603 {parse yymmdd} { clock scan {xxxvii Jan 2} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.604 {parse yymmdd} { clock scan {xxxvii Jan ii} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.605 {parse yymmdd} { clock scan {xxxvii January 02} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.606 {parse yymmdd} { clock scan {xxxvii January ii} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.607 {parse yymmdd} { clock scan {xxxvii January 2} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.608 {parse yymmdd} { clock scan {xxxvii January ii} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.609 {parse yymmdd} { clock scan {xxxvii Jan 02} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.610 {parse yymmdd} { clock scan {xxxvii Jan ii} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.611 {parse yymmdd} { clock scan {xxxvii Jan 2} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.612 {parse yymmdd} { clock scan {xxxvii Jan ii} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.613 {parse yymmdd} { clock scan {xxxvii 01 02} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.614 {parse yymmdd} { clock scan {xxxvii 01 ii} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.615 {parse yymmdd} { clock scan {xxxvii 01 2} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.616 {parse yymmdd} { clock scan {xxxvii 01 ii} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.617 {parse yymmdd} { clock scan {xxxvii i 02} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.618 {parse yymmdd} { clock scan {xxxvii i ii} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.619 {parse yymmdd} { clock scan {xxxvii i 2} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.620 {parse yymmdd} { clock scan {xxxvii i ii} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.621 {parse yymmdd} { clock scan {xxxvii 1 02} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.622 {parse yymmdd} { clock scan {xxxvii 1 ii} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.623 {parse yymmdd} { clock scan {xxxvii 1 2} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.624 {parse yymmdd} { clock scan {xxxvii 1 ii} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 2114467200 test clock-14.625 {parse yymmdd} { clock scan {37 Jan 31} -format {%y %b %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.626 {parse yymmdd} { clock scan {37 Jan xxxi} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.627 {parse yymmdd} { clock scan {37 Jan 31} -format {%y %b %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.628 {parse yymmdd} { clock scan {37 Jan xxxi} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.629 {parse yymmdd} { clock scan {37 January 31} -format {%y %B %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.630 {parse yymmdd} { clock scan {37 January xxxi} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.631 {parse yymmdd} { clock scan {37 January 31} -format {%y %B %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.632 {parse yymmdd} { clock scan {37 January xxxi} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.633 {parse yymmdd} { clock scan {37 Jan 31} -format {%y %h %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.634 {parse yymmdd} { clock scan {37 Jan xxxi} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.635 {parse yymmdd} { clock scan {37 Jan 31} -format {%y %h %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.636 {parse yymmdd} { clock scan {37 Jan xxxi} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.637 {parse yymmdd} { clock scan {37 01 31} -format {%y %m %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.638 {parse yymmdd} { clock scan {37 01 xxxi} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.639 {parse yymmdd} { clock scan {37 01 31} -format {%y %m %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.640 {parse yymmdd} { clock scan {37 01 xxxi} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.641 {parse yymmdd} { clock scan {37 i 31} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.642 {parse yymmdd} { clock scan {37 i xxxi} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.643 {parse yymmdd} { clock scan {37 i 31} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.644 {parse yymmdd} { clock scan {37 i xxxi} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.645 {parse yymmdd} { clock scan {37 1 31} -format {%y %N %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.646 {parse yymmdd} { clock scan {37 1 xxxi} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.647 {parse yymmdd} { clock scan {37 1 31} -format {%y %N %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.648 {parse yymmdd} { clock scan {37 1 xxxi} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.649 {parse yymmdd} { clock scan {xxxvii Jan 31} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.650 {parse yymmdd} { clock scan {xxxvii Jan xxxi} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.651 {parse yymmdd} { clock scan {xxxvii Jan 31} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.652 {parse yymmdd} { clock scan {xxxvii Jan xxxi} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.653 {parse yymmdd} { clock scan {xxxvii January 31} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.654 {parse yymmdd} { clock scan {xxxvii January xxxi} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.655 {parse yymmdd} { clock scan {xxxvii January 31} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.656 {parse yymmdd} { clock scan {xxxvii January xxxi} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.657 {parse yymmdd} { clock scan {xxxvii Jan 31} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.658 {parse yymmdd} { clock scan {xxxvii Jan xxxi} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.659 {parse yymmdd} { clock scan {xxxvii Jan 31} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.660 {parse yymmdd} { clock scan {xxxvii Jan xxxi} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.661 {parse yymmdd} { clock scan {xxxvii 01 31} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.662 {parse yymmdd} { clock scan {xxxvii 01 xxxi} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.663 {parse yymmdd} { clock scan {xxxvii 01 31} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.664 {parse yymmdd} { clock scan {xxxvii 01 xxxi} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.665 {parse yymmdd} { clock scan {xxxvii i 31} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.666 {parse yymmdd} { clock scan {xxxvii i xxxi} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.667 {parse yymmdd} { clock scan {xxxvii i 31} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.668 {parse yymmdd} { clock scan {xxxvii i xxxi} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.669 {parse yymmdd} { clock scan {xxxvii 1 31} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.670 {parse yymmdd} { clock scan {xxxvii 1 xxxi} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.671 {parse yymmdd} { clock scan {xxxvii 1 31} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.672 {parse yymmdd} { clock scan {xxxvii 1 xxxi} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 2116972800 test clock-14.673 {parse yymmdd} { clock scan {37 Dec 02} -format {%y %b %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.674 {parse yymmdd} { clock scan {37 Dec ii} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.675 {parse yymmdd} { clock scan {37 Dec 2} -format {%y %b %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.676 {parse yymmdd} { clock scan {37 Dec ii} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.677 {parse yymmdd} { clock scan {37 December 02} -format {%y %B %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.678 {parse yymmdd} { clock scan {37 December ii} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.679 {parse yymmdd} { clock scan {37 December 2} -format {%y %B %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.680 {parse yymmdd} { clock scan {37 December ii} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.681 {parse yymmdd} { clock scan {37 Dec 02} -format {%y %h %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.682 {parse yymmdd} { clock scan {37 Dec ii} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.683 {parse yymmdd} { clock scan {37 Dec 2} -format {%y %h %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.684 {parse yymmdd} { clock scan {37 Dec ii} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.685 {parse yymmdd} { clock scan {37 12 02} -format {%y %m %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.686 {parse yymmdd} { clock scan {37 12 ii} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.687 {parse yymmdd} { clock scan {37 12 2} -format {%y %m %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.688 {parse yymmdd} { clock scan {37 12 ii} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.689 {parse yymmdd} { clock scan {37 xii 02} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.690 {parse yymmdd} { clock scan {37 xii ii} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.691 {parse yymmdd} { clock scan {37 xii 2} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.692 {parse yymmdd} { clock scan {37 xii ii} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.693 {parse yymmdd} { clock scan {37 12 02} -format {%y %N %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.694 {parse yymmdd} { clock scan {37 12 ii} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.695 {parse yymmdd} { clock scan {37 12 2} -format {%y %N %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.696 {parse yymmdd} { clock scan {37 12 ii} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.697 {parse yymmdd} { clock scan {xxxvii Dec 02} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.698 {parse yymmdd} { clock scan {xxxvii Dec ii} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.699 {parse yymmdd} { clock scan {xxxvii Dec 2} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.700 {parse yymmdd} { clock scan {xxxvii Dec ii} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.701 {parse yymmdd} { clock scan {xxxvii December 02} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.702 {parse yymmdd} { clock scan {xxxvii December ii} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.703 {parse yymmdd} { clock scan {xxxvii December 2} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.704 {parse yymmdd} { clock scan {xxxvii December ii} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.705 {parse yymmdd} { clock scan {xxxvii Dec 02} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.706 {parse yymmdd} { clock scan {xxxvii Dec ii} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.707 {parse yymmdd} { clock scan {xxxvii Dec 2} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.708 {parse yymmdd} { clock scan {xxxvii Dec ii} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.709 {parse yymmdd} { clock scan {xxxvii 12 02} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.710 {parse yymmdd} { clock scan {xxxvii 12 ii} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.711 {parse yymmdd} { clock scan {xxxvii 12 2} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.712 {parse yymmdd} { clock scan {xxxvii 12 ii} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.713 {parse yymmdd} { clock scan {xxxvii xii 02} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.714 {parse yymmdd} { clock scan {xxxvii xii ii} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.715 {parse yymmdd} { clock scan {xxxvii xii 2} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.716 {parse yymmdd} { clock scan {xxxvii xii ii} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.717 {parse yymmdd} { clock scan {xxxvii 12 02} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.718 {parse yymmdd} { clock scan {xxxvii 12 ii} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.719 {parse yymmdd} { clock scan {xxxvii 12 2} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.720 {parse yymmdd} { clock scan {xxxvii 12 ii} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 2143324800 test clock-14.721 {parse yymmdd} { clock scan {37 Dec 31} -format {%y %b %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.722 {parse yymmdd} { clock scan {37 Dec xxxi} -format {%y %b %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.723 {parse yymmdd} { clock scan {37 Dec 31} -format {%y %b %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.724 {parse yymmdd} { clock scan {37 Dec xxxi} -format {%y %b %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.725 {parse yymmdd} { clock scan {37 December 31} -format {%y %B %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.726 {parse yymmdd} { clock scan {37 December xxxi} -format {%y %B %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.727 {parse yymmdd} { clock scan {37 December 31} -format {%y %B %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.728 {parse yymmdd} { clock scan {37 December xxxi} -format {%y %B %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.729 {parse yymmdd} { clock scan {37 Dec 31} -format {%y %h %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.730 {parse yymmdd} { clock scan {37 Dec xxxi} -format {%y %h %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.731 {parse yymmdd} { clock scan {37 Dec 31} -format {%y %h %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.732 {parse yymmdd} { clock scan {37 Dec xxxi} -format {%y %h %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.733 {parse yymmdd} { clock scan {37 12 31} -format {%y %m %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.734 {parse yymmdd} { clock scan {37 12 xxxi} -format {%y %m %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.735 {parse yymmdd} { clock scan {37 12 31} -format {%y %m %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.736 {parse yymmdd} { clock scan {37 12 xxxi} -format {%y %m %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.737 {parse yymmdd} { clock scan {37 xii 31} -format {%y %Om %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.738 {parse yymmdd} { clock scan {37 xii xxxi} -format {%y %Om %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.739 {parse yymmdd} { clock scan {37 xii 31} -format {%y %Om %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.740 {parse yymmdd} { clock scan {37 xii xxxi} -format {%y %Om %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.741 {parse yymmdd} { clock scan {37 12 31} -format {%y %N %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.742 {parse yymmdd} { clock scan {37 12 xxxi} -format {%y %N %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.743 {parse yymmdd} { clock scan {37 12 31} -format {%y %N %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.744 {parse yymmdd} { clock scan {37 12 xxxi} -format {%y %N %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.745 {parse yymmdd} { clock scan {xxxvii Dec 31} -format {%Oy %b %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.746 {parse yymmdd} { clock scan {xxxvii Dec xxxi} -format {%Oy %b %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.747 {parse yymmdd} { clock scan {xxxvii Dec 31} -format {%Oy %b %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.748 {parse yymmdd} { clock scan {xxxvii Dec xxxi} -format {%Oy %b %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.749 {parse yymmdd} { clock scan {xxxvii December 31} -format {%Oy %B %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.750 {parse yymmdd} { clock scan {xxxvii December xxxi} -format {%Oy %B %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.751 {parse yymmdd} { clock scan {xxxvii December 31} -format {%Oy %B %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.752 {parse yymmdd} { clock scan {xxxvii December xxxi} -format {%Oy %B %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.753 {parse yymmdd} { clock scan {xxxvii Dec 31} -format {%Oy %h %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.754 {parse yymmdd} { clock scan {xxxvii Dec xxxi} -format {%Oy %h %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.755 {parse yymmdd} { clock scan {xxxvii Dec 31} -format {%Oy %h %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.756 {parse yymmdd} { clock scan {xxxvii Dec xxxi} -format {%Oy %h %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.757 {parse yymmdd} { clock scan {xxxvii 12 31} -format {%Oy %m %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.758 {parse yymmdd} { clock scan {xxxvii 12 xxxi} -format {%Oy %m %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.759 {parse yymmdd} { clock scan {xxxvii 12 31} -format {%Oy %m %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.760 {parse yymmdd} { clock scan {xxxvii 12 xxxi} -format {%Oy %m %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.761 {parse yymmdd} { clock scan {xxxvii xii 31} -format {%Oy %Om %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.762 {parse yymmdd} { clock scan {xxxvii xii xxxi} -format {%Oy %Om %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.763 {parse yymmdd} { clock scan {xxxvii xii 31} -format {%Oy %Om %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.764 {parse yymmdd} { clock scan {xxxvii xii xxxi} -format {%Oy %Om %Oe} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.765 {parse yymmdd} { clock scan {xxxvii 12 31} -format {%Oy %N %d} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.766 {parse yymmdd} { clock scan {xxxvii 12 xxxi} -format {%Oy %N %Od} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.767 {parse yymmdd} { clock scan {xxxvii 12 31} -format {%Oy %N %e} -locale en_US_roman -gmt 1 } 2145830400 test clock-14.768 {parse yymmdd} { clock scan {xxxvii 12 xxxi} -format {%Oy %N %Oe} -locale en_US_roman -gmt 1 } 2145830400 # END testcases14 test clock-15.1 {yymmdd precedence below seconds} { list [clock scan {0 000101} -format {%s %y%m%d} -gmt true] \ [clock scan {000101 0} -format {%y%m%d %s} -gmt true] } {0 0} test clock-15.2 {yymmdd precedence below julian day} { list [clock scan {2440588 000101} -format {%J %y%m%d} -gmt true] \ [clock scan {000101 2440588} -format {%y%m%d %J} -gmt true] } {0 0} test clock-15.3 {yymmdd precedence below yyyyWwwd} { list [clock scan {1970W014000101} -format {%GW%V%u%y%m%d} -gmt true] \ [clock scan {0001011970W014} -format {%y%m%d%GW%V%u} -gmt true] } {0 0} # Test parsing of yyddd test clock-16.1 {parse yyddd} { clock scan {70 001} -format {%y %j} -locale en_US_roman -gmt 1 } 0 test clock-16.2 {parse yyddd} { clock scan {70 365} -format {%y %j} -locale en_US_roman -gmt 1 } 31449600 test clock-16.3 {parse yyddd} { clock scan {71 001} -format {%y %j} -locale en_US_roman -gmt 1 } 31536000 test clock-16.4 {parse yyddd} { clock scan {71 365} -format {%y %j} -locale en_US_roman -gmt 1 } 62985600 test clock-16.5 {parse yyddd} { clock scan {00 001} -format {%y %j} -locale en_US_roman -gmt 1 } 946684800 test clock-16.6 {parse yyddd} { clock scan {00 365} -format {%y %j} -locale en_US_roman -gmt 1 } 978134400 test clock-16.7 {parse yyddd} { clock scan {01 001} -format {%y %j} -locale en_US_roman -gmt 1 } 978307200 test clock-16.8 {parse yyddd} { clock scan {01 365} -format {%y %j} -locale en_US_roman -gmt 1 } 1009756800 test clock-16.9 {seconds take precedence over yyddd} { list [clock scan {0 00001} -format {%s %y%j} -gmt true] \ [clock scan {00001 0} -format {%y%j %s} -gmt true] } {0 0} test clock-16.10 {julian day takes precedence over yyddd} { list [clock scan {2440588 00001} -format {%J %y%j} -gmt true] \ [clock scan {00001 2440588} -format {%Y%j %J} -gmt true] } {0 0} test clock-16.11 {yyddd precedence below yyyyWwwd} { list [clock scan {1970W01400001} -format {%GW%V%u%y%j} -gmt true] \ [clock scan {000011970W014} -format {%y%j%GW%V%u} -gmt true] } {0 0} # BEGIN testcases17 # Test parsing of yyWwwd test clock-17.1 {parse yyWwwd} { clock scan {70 W01 Fri} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 86400 test clock-17.2 {parse yyWwwd} { clock scan {70 W01 Friday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 86400 test clock-17.3 {parse yyWwwd} { clock scan {70 W01 5} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 86400 test clock-17.4 {parse yyWwwd} { clock scan {70 W01 5} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 86400 test clock-17.5 {parse yyWwwd} { clock scan {70 W01 v} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 86400 test clock-17.6 {parse yyWwwd} { clock scan {70 W01 v} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 86400 test clock-17.7 {parse yyWwwd} { clock scan {70 W05 Sat} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 2592000 test clock-17.8 {parse yyWwwd} { clock scan {70 W05 Saturday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 2592000 test clock-17.9 {parse yyWwwd} { clock scan {70 W05 6} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 2592000 test clock-17.10 {parse yyWwwd} { clock scan {70 W05 6} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 2592000 test clock-17.11 {parse yyWwwd} { clock scan {70 W05 vi} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 2592000 test clock-17.12 {parse yyWwwd} { clock scan {70 W05 vi} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 2592000 test clock-17.13 {parse yyWwwd} { clock scan {70 W49 Wed} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 28944000 test clock-17.14 {parse yyWwwd} { clock scan {70 W49 Wednesday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 28944000 test clock-17.15 {parse yyWwwd} { clock scan {70 W49 3} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 28944000 test clock-17.16 {parse yyWwwd} { clock scan {70 W49 3} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 28944000 test clock-17.17 {parse yyWwwd} { clock scan {70 W49 iii} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 28944000 test clock-17.18 {parse yyWwwd} { clock scan {70 W49 iii} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 28944000 test clock-17.19 {parse yyWwwd} { clock scan {70 W53 Thu} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 31449600 test clock-17.20 {parse yyWwwd} { clock scan {70 W53 Thursday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 31449600 test clock-17.21 {parse yyWwwd} { clock scan {70 W53 4} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 31449600 test clock-17.22 {parse yyWwwd} { clock scan {70 W53 4} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 31449600 test clock-17.23 {parse yyWwwd} { clock scan {70 W53 iv} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 31449600 test clock-17.24 {parse yyWwwd} { clock scan {70 W53 iv} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 31449600 test clock-17.25 {parse yyWwwd} { clock scan {70 W53 Sat} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 31622400 test clock-17.26 {parse yyWwwd} { clock scan {70 W53 Saturday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 31622400 test clock-17.27 {parse yyWwwd} { clock scan {70 W53 6} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 31622400 test clock-17.28 {parse yyWwwd} { clock scan {70 W53 6} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 31622400 test clock-17.29 {parse yyWwwd} { clock scan {70 W53 vi} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 31622400 test clock-17.30 {parse yyWwwd} { clock scan {70 W53 vi} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 31622400 test clock-17.31 {parse yyWwwd} { clock scan {71 W04 Sun} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 34128000 test clock-17.32 {parse yyWwwd} { clock scan {71 W04 Sunday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 34128000 test clock-17.33 {parse yyWwwd} { clock scan {71 W04 7} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 34128000 test clock-17.34 {parse yyWwwd} { clock scan {71 W04 0} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 34128000 test clock-17.35 {parse yyWwwd} { clock scan {71 W04 vii} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 34128000 test clock-17.36 {parse yyWwwd} { clock scan {71 W04 ?} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 34128000 test clock-17.37 {parse yyWwwd} { clock scan {71 W48 Thu} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 60480000 test clock-17.38 {parse yyWwwd} { clock scan {71 W48 Thursday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 60480000 test clock-17.39 {parse yyWwwd} { clock scan {71 W48 4} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 60480000 test clock-17.40 {parse yyWwwd} { clock scan {71 W48 4} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 60480000 test clock-17.41 {parse yyWwwd} { clock scan {71 W48 iv} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 60480000 test clock-17.42 {parse yyWwwd} { clock scan {71 W48 iv} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 60480000 test clock-17.43 {parse yyWwwd} { clock scan {71 W52 Fri} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 62985600 test clock-17.44 {parse yyWwwd} { clock scan {71 W52 Friday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 62985600 test clock-17.45 {parse yyWwwd} { clock scan {71 W52 5} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 62985600 test clock-17.46 {parse yyWwwd} { clock scan {71 W52 5} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 62985600 test clock-17.47 {parse yyWwwd} { clock scan {71 W52 v} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 62985600 test clock-17.48 {parse yyWwwd} { clock scan {71 W52 v} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 62985600 test clock-17.49 {parse yyWwwd} { clock scan {99 W52 Sun} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 946771200 test clock-17.50 {parse yyWwwd} { clock scan {99 W52 Sunday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 946771200 test clock-17.51 {parse yyWwwd} { clock scan {99 W52 7} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 946771200 test clock-17.52 {parse yyWwwd} { clock scan {99 W52 0} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 946771200 test clock-17.53 {parse yyWwwd} { clock scan {99 W52 vii} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 946771200 test clock-17.54 {parse yyWwwd} { clock scan {99 W52 ?} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 946771200 test clock-17.55 {parse yyWwwd} { clock scan {00 W05 Mon} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 949276800 test clock-17.56 {parse yyWwwd} { clock scan {00 W05 Monday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 949276800 test clock-17.57 {parse yyWwwd} { clock scan {00 W05 1} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 949276800 test clock-17.58 {parse yyWwwd} { clock scan {00 W05 1} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 949276800 test clock-17.59 {parse yyWwwd} { clock scan {00 W05 i} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 949276800 test clock-17.60 {parse yyWwwd} { clock scan {00 W05 i} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 949276800 test clock-17.61 {parse yyWwwd} { clock scan {00 W48 Sat} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 975715200 test clock-17.62 {parse yyWwwd} { clock scan {00 W48 Saturday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 975715200 test clock-17.63 {parse yyWwwd} { clock scan {00 W48 6} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 975715200 test clock-17.64 {parse yyWwwd} { clock scan {00 W48 6} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 975715200 test clock-17.65 {parse yyWwwd} { clock scan {00 W48 vi} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 975715200 test clock-17.66 {parse yyWwwd} { clock scan {00 W48 vi} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 975715200 test clock-17.67 {parse yyWwwd} { clock scan {00 W52 Sun} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 978220800 test clock-17.68 {parse yyWwwd} { clock scan {00 W52 Sunday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 978220800 test clock-17.69 {parse yyWwwd} { clock scan {00 W52 7} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 978220800 test clock-17.70 {parse yyWwwd} { clock scan {00 W52 0} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 978220800 test clock-17.71 {parse yyWwwd} { clock scan {00 W52 vii} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 978220800 test clock-17.72 {parse yyWwwd} { clock scan {00 W52 ?} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 978220800 test clock-17.73 {parse yyWwwd} { clock scan {01 W01 Tue} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 978393600 test clock-17.74 {parse yyWwwd} { clock scan {01 W01 Tuesday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 978393600 test clock-17.75 {parse yyWwwd} { clock scan {01 W01 2} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 978393600 test clock-17.76 {parse yyWwwd} { clock scan {01 W01 2} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 978393600 test clock-17.77 {parse yyWwwd} { clock scan {01 W01 ii} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 978393600 test clock-17.78 {parse yyWwwd} { clock scan {01 W01 ii} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 978393600 test clock-17.79 {parse yyWwwd} { clock scan {01 W05 Wed} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 980899200 test clock-17.80 {parse yyWwwd} { clock scan {01 W05 Wednesday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 980899200 test clock-17.81 {parse yyWwwd} { clock scan {01 W05 3} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 980899200 test clock-17.82 {parse yyWwwd} { clock scan {01 W05 3} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 980899200 test clock-17.83 {parse yyWwwd} { clock scan {01 W05 iii} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 980899200 test clock-17.84 {parse yyWwwd} { clock scan {01 W05 iii} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 980899200 test clock-17.85 {parse yyWwwd} { clock scan {01 W48 Sun} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 1007251200 test clock-17.86 {parse yyWwwd} { clock scan {01 W48 Sunday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 1007251200 test clock-17.87 {parse yyWwwd} { clock scan {01 W48 7} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 1007251200 test clock-17.88 {parse yyWwwd} { clock scan {01 W48 0} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 1007251200 test clock-17.89 {parse yyWwwd} { clock scan {01 W48 vii} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 1007251200 test clock-17.90 {parse yyWwwd} { clock scan {01 W48 ?} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 1007251200 test clock-17.91 {parse yyWwwd} { clock scan {02 W01 Mon} -format {%g W%V %a} -locale en_US_roman -gmt 1 } 1009756800 test clock-17.92 {parse yyWwwd} { clock scan {02 W01 Monday} -format {%g W%V %A} -locale en_US_roman -gmt 1 } 1009756800 test clock-17.93 {parse yyWwwd} { clock scan {02 W01 1} -format {%g W%V %u} -locale en_US_roman -gmt 1 } 1009756800 test clock-17.94 {parse yyWwwd} { clock scan {02 W01 1} -format {%g W%V %w} -locale en_US_roman -gmt 1 } 1009756800 test clock-17.95 {parse yyWwwd} { clock scan {02 W01 i} -format {%g W%V %Ou} -locale en_US_roman -gmt 1 } 1009756800 test clock-17.96 {parse yyWwwd} { clock scan {02 W01 i} -format {%g W%V %Ow} -locale en_US_roman -gmt 1 } 1009756800 # END testcases17 # Test precedence of yyWwwd test clock-18.1 {seconds take precedence over yyWwwd} { list [clock scan {0 00W014} -format {%s %gW%V%u} -gmt true] \ [clock scan {00W014 0} -format {%gW%V%u %s} -gmt true] } {0 0} test clock-18.2 {julian day takes precedence over yyddd} { list [clock scan {2440588 00W014} -format {%J %gW%V%u} -gmt true] \ [clock scan {00W014 2440588} -format {%gW%V%u %J} -gmt true] } {0 0} test clock-18.3 {yyWwwd precedence below yyyymmdd} { list [clock scan {19700101 00W014} -format {%Y%m%d %gW%V%u} -gmt true] \ [clock scan {00W014 19700101} -format {%gW%V%u %Y%m%d} -gmt true] } {0 0} test clock-18.4 {yyWwwd precedence below yyyyddd} { list [clock scan {1970001 00W014} -format {%Y%j %gW%V%u} -gmt true] \ [clock scan {00W014 1970001} -format {%gW%V%u %Y%j} -gmt true] } {0 0} # BEGIN testcases19 # Test parsing of mmdd test clock-19.1 {parse mmdd} { clock scan {Jan 02} -format {%b %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.2 {parse mmdd} { clock scan {Jan ii} -format {%b %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.3 {parse mmdd} { clock scan {Jan 2} -format {%b %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.4 {parse mmdd} { clock scan {Jan ii} -format {%b %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.5 {parse mmdd} { clock scan {January 02} -format {%B %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.6 {parse mmdd} { clock scan {January ii} -format {%B %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.7 {parse mmdd} { clock scan {January 2} -format {%B %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.8 {parse mmdd} { clock scan {January ii} -format {%B %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.9 {parse mmdd} { clock scan {Jan 02} -format {%h %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.10 {parse mmdd} { clock scan {Jan ii} -format {%h %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.11 {parse mmdd} { clock scan {Jan 2} -format {%h %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.12 {parse mmdd} { clock scan {Jan ii} -format {%h %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.13 {parse mmdd} { clock scan {01 02} -format {%m %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.14 {parse mmdd} { clock scan {01 ii} -format {%m %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.15 {parse mmdd} { clock scan {01 2} -format {%m %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.16 {parse mmdd} { clock scan {01 ii} -format {%m %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.17 {parse mmdd} { clock scan {i 02} -format {%Om %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.18 {parse mmdd} { clock scan {i ii} -format {%Om %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.19 {parse mmdd} { clock scan {i 2} -format {%Om %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.20 {parse mmdd} { clock scan {i ii} -format {%Om %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.21 {parse mmdd} { clock scan { 1 02} -format {%N %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.22 {parse mmdd} { clock scan { 1 ii} -format {%N %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.23 {parse mmdd} { clock scan { 1 2} -format {%N %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.24 {parse mmdd} { clock scan { 1 ii} -format {%N %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1009756800 test clock-19.25 {parse mmdd} { clock scan {Jan 31} -format {%b %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.26 {parse mmdd} { clock scan {Jan xxxi} -format {%b %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.27 {parse mmdd} { clock scan {Jan 31} -format {%b %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.28 {parse mmdd} { clock scan {Jan xxxi} -format {%b %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.29 {parse mmdd} { clock scan {January 31} -format {%B %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.30 {parse mmdd} { clock scan {January xxxi} -format {%B %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.31 {parse mmdd} { clock scan {January 31} -format {%B %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.32 {parse mmdd} { clock scan {January xxxi} -format {%B %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.33 {parse mmdd} { clock scan {Jan 31} -format {%h %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.34 {parse mmdd} { clock scan {Jan xxxi} -format {%h %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.35 {parse mmdd} { clock scan {Jan 31} -format {%h %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.36 {parse mmdd} { clock scan {Jan xxxi} -format {%h %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.37 {parse mmdd} { clock scan {01 31} -format {%m %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.38 {parse mmdd} { clock scan {01 xxxi} -format {%m %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.39 {parse mmdd} { clock scan {01 31} -format {%m %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.40 {parse mmdd} { clock scan {01 xxxi} -format {%m %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.41 {parse mmdd} { clock scan {i 31} -format {%Om %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.42 {parse mmdd} { clock scan {i xxxi} -format {%Om %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.43 {parse mmdd} { clock scan {i 31} -format {%Om %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.44 {parse mmdd} { clock scan {i xxxi} -format {%Om %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.45 {parse mmdd} { clock scan { 1 31} -format {%N %d} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.46 {parse mmdd} { clock scan { 1 xxxi} -format {%N %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.47 {parse mmdd} { clock scan { 1 31} -format {%N %e} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.48 {parse mmdd} { clock scan { 1 xxxi} -format {%N %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -1007251200 test clock-19.49 {parse mmdd} { clock scan {Dec 02} -format {%b %d} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.50 {parse mmdd} { clock scan {Dec ii} -format {%b %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.51 {parse mmdd} { clock scan {Dec 2} -format {%b %e} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.52 {parse mmdd} { clock scan {Dec ii} -format {%b %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.53 {parse mmdd} { clock scan {December 02} -format {%B %d} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.54 {parse mmdd} { clock scan {December ii} -format {%B %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.55 {parse mmdd} { clock scan {December 2} -format {%B %e} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.56 {parse mmdd} { clock scan {December ii} -format {%B %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.57 {parse mmdd} { clock scan {Dec 02} -format {%h %d} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.58 {parse mmdd} { clock scan {Dec ii} -format {%h %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.59 {parse mmdd} { clock scan {Dec 2} -format {%h %e} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.60 {parse mmdd} { clock scan {Dec ii} -format {%h %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.61 {parse mmdd} { clock scan {12 02} -format {%m %d} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.62 {parse mmdd} { clock scan {12 ii} -format {%m %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.63 {parse mmdd} { clock scan {12 2} -format {%m %e} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.64 {parse mmdd} { clock scan {12 ii} -format {%m %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.65 {parse mmdd} { clock scan {xii 02} -format {%Om %d} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.66 {parse mmdd} { clock scan {xii ii} -format {%Om %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.67 {parse mmdd} { clock scan {xii 2} -format {%Om %e} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.68 {parse mmdd} { clock scan {xii ii} -format {%Om %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.69 {parse mmdd} { clock scan {12 02} -format {%N %d} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.70 {parse mmdd} { clock scan {12 ii} -format {%N %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.71 {parse mmdd} { clock scan {12 2} -format {%N %e} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.72 {parse mmdd} { clock scan {12 ii} -format {%N %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -980899200 test clock-19.73 {parse mmdd} { clock scan {Dec 31} -format {%b %d} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.74 {parse mmdd} { clock scan {Dec xxxi} -format {%b %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.75 {parse mmdd} { clock scan {Dec 31} -format {%b %e} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.76 {parse mmdd} { clock scan {Dec xxxi} -format {%b %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.77 {parse mmdd} { clock scan {December 31} -format {%B %d} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.78 {parse mmdd} { clock scan {December xxxi} -format {%B %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.79 {parse mmdd} { clock scan {December 31} -format {%B %e} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.80 {parse mmdd} { clock scan {December xxxi} -format {%B %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.81 {parse mmdd} { clock scan {Dec 31} -format {%h %d} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.82 {parse mmdd} { clock scan {Dec xxxi} -format {%h %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.83 {parse mmdd} { clock scan {Dec 31} -format {%h %e} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.84 {parse mmdd} { clock scan {Dec xxxi} -format {%h %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.85 {parse mmdd} { clock scan {12 31} -format {%m %d} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.86 {parse mmdd} { clock scan {12 xxxi} -format {%m %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.87 {parse mmdd} { clock scan {12 31} -format {%m %e} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.88 {parse mmdd} { clock scan {12 xxxi} -format {%m %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.89 {parse mmdd} { clock scan {xii 31} -format {%Om %d} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.90 {parse mmdd} { clock scan {xii xxxi} -format {%Om %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.91 {parse mmdd} { clock scan {xii 31} -format {%Om %e} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.92 {parse mmdd} { clock scan {xii xxxi} -format {%Om %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.93 {parse mmdd} { clock scan {12 31} -format {%N %d} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.94 {parse mmdd} { clock scan {12 xxxi} -format {%N %Od} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.95 {parse mmdd} { clock scan {12 31} -format {%N %e} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.96 {parse mmdd} { clock scan {12 xxxi} -format {%N %Oe} -locale en_US_roman -base -1009843200 -gmt 1 } -978393600 test clock-19.97 {parse mmdd} { clock scan {Jan 02} -format {%b %d} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.98 {parse mmdd} { clock scan {Jan ii} -format {%b %Od} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.99 {parse mmdd} { clock scan {Jan 2} -format {%b %e} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.100 {parse mmdd} { clock scan {Jan ii} -format {%b %Oe} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.101 {parse mmdd} { clock scan {January 02} -format {%B %d} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.102 {parse mmdd} { clock scan {January ii} -format {%B %Od} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.103 {parse mmdd} { clock scan {January 2} -format {%B %e} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.104 {parse mmdd} { clock scan {January ii} -format {%B %Oe} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.105 {parse mmdd} { clock scan {Jan 02} -format {%h %d} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.106 {parse mmdd} { clock scan {Jan ii} -format {%h %Od} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.107 {parse mmdd} { clock scan {Jan 2} -format {%h %e} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.108 {parse mmdd} { clock scan {Jan ii} -format {%h %Oe} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.109 {parse mmdd} { clock scan {01 02} -format {%m %d} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.110 {parse mmdd} { clock scan {01 ii} -format {%m %Od} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.111 {parse mmdd} { clock scan {01 2} -format {%m %e} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.112 {parse mmdd} { clock scan {01 ii} -format {%m %Oe} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.113 {parse mmdd} { clock scan {i 02} -format {%Om %d} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.114 {parse mmdd} { clock scan {i ii} -format {%Om %Od} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.115 {parse mmdd} { clock scan {i 2} -format {%Om %e} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.116 {parse mmdd} { clock scan {i ii} -format {%Om %Oe} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.117 {parse mmdd} { clock scan { 1 02} -format {%N %d} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.118 {parse mmdd} { clock scan { 1 ii} -format {%N %Od} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.119 {parse mmdd} { clock scan { 1 2} -format {%N %e} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.120 {parse mmdd} { clock scan { 1 ii} -format {%N %Oe} -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-19.121 {parse mmdd} { clock scan {Jan 31} -format {%b %d} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.122 {parse mmdd} { clock scan {Jan xxxi} -format {%b %Od} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.123 {parse mmdd} { clock scan {Jan 31} -format {%b %e} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.124 {parse mmdd} { clock scan {Jan xxxi} -format {%b %Oe} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.125 {parse mmdd} { clock scan {January 31} -format {%B %d} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.126 {parse mmdd} { clock scan {January xxxi} -format {%B %Od} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.127 {parse mmdd} { clock scan {January 31} -format {%B %e} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.128 {parse mmdd} { clock scan {January xxxi} -format {%B %Oe} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.129 {parse mmdd} { clock scan {Jan 31} -format {%h %d} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.130 {parse mmdd} { clock scan {Jan xxxi} -format {%h %Od} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.131 {parse mmdd} { clock scan {Jan 31} -format {%h %e} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.132 {parse mmdd} { clock scan {Jan xxxi} -format {%h %Oe} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.133 {parse mmdd} { clock scan {01 31} -format {%m %d} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.134 {parse mmdd} { clock scan {01 xxxi} -format {%m %Od} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.135 {parse mmdd} { clock scan {01 31} -format {%m %e} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.136 {parse mmdd} { clock scan {01 xxxi} -format {%m %Oe} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.137 {parse mmdd} { clock scan {i 31} -format {%Om %d} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.138 {parse mmdd} { clock scan {i xxxi} -format {%Om %Od} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.139 {parse mmdd} { clock scan {i 31} -format {%Om %e} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.140 {parse mmdd} { clock scan {i xxxi} -format {%Om %Oe} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.141 {parse mmdd} { clock scan { 1 31} -format {%N %d} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.142 {parse mmdd} { clock scan { 1 xxxi} -format {%N %Od} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.143 {parse mmdd} { clock scan { 1 31} -format {%N %e} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.144 {parse mmdd} { clock scan { 1 xxxi} -format {%N %Oe} -locale en_US_roman -base 0 -gmt 1 } 2592000 test clock-19.145 {parse mmdd} { clock scan {Dec 02} -format {%b %d} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.146 {parse mmdd} { clock scan {Dec ii} -format {%b %Od} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.147 {parse mmdd} { clock scan {Dec 2} -format {%b %e} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.148 {parse mmdd} { clock scan {Dec ii} -format {%b %Oe} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.149 {parse mmdd} { clock scan {December 02} -format {%B %d} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.150 {parse mmdd} { clock scan {December ii} -format {%B %Od} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.151 {parse mmdd} { clock scan {December 2} -format {%B %e} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.152 {parse mmdd} { clock scan {December ii} -format {%B %Oe} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.153 {parse mmdd} { clock scan {Dec 02} -format {%h %d} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.154 {parse mmdd} { clock scan {Dec ii} -format {%h %Od} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.155 {parse mmdd} { clock scan {Dec 2} -format {%h %e} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.156 {parse mmdd} { clock scan {Dec ii} -format {%h %Oe} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.157 {parse mmdd} { clock scan {12 02} -format {%m %d} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.158 {parse mmdd} { clock scan {12 ii} -format {%m %Od} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.159 {parse mmdd} { clock scan {12 2} -format {%m %e} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.160 {parse mmdd} { clock scan {12 ii} -format {%m %Oe} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.161 {parse mmdd} { clock scan {xii 02} -format {%Om %d} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.162 {parse mmdd} { clock scan {xii ii} -format {%Om %Od} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.163 {parse mmdd} { clock scan {xii 2} -format {%Om %e} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.164 {parse mmdd} { clock scan {xii ii} -format {%Om %Oe} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.165 {parse mmdd} { clock scan {12 02} -format {%N %d} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.166 {parse mmdd} { clock scan {12 ii} -format {%N %Od} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.167 {parse mmdd} { clock scan {12 2} -format {%N %e} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.168 {parse mmdd} { clock scan {12 ii} -format {%N %Oe} -locale en_US_roman -base 0 -gmt 1 } 28944000 test clock-19.169 {parse mmdd} { clock scan {Dec 31} -format {%b %d} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.170 {parse mmdd} { clock scan {Dec xxxi} -format {%b %Od} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.171 {parse mmdd} { clock scan {Dec 31} -format {%b %e} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.172 {parse mmdd} { clock scan {Dec xxxi} -format {%b %Oe} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.173 {parse mmdd} { clock scan {December 31} -format {%B %d} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.174 {parse mmdd} { clock scan {December xxxi} -format {%B %Od} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.175 {parse mmdd} { clock scan {December 31} -format {%B %e} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.176 {parse mmdd} { clock scan {December xxxi} -format {%B %Oe} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.177 {parse mmdd} { clock scan {Dec 31} -format {%h %d} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.178 {parse mmdd} { clock scan {Dec xxxi} -format {%h %Od} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.179 {parse mmdd} { clock scan {Dec 31} -format {%h %e} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.180 {parse mmdd} { clock scan {Dec xxxi} -format {%h %Oe} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.181 {parse mmdd} { clock scan {12 31} -format {%m %d} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.182 {parse mmdd} { clock scan {12 xxxi} -format {%m %Od} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.183 {parse mmdd} { clock scan {12 31} -format {%m %e} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.184 {parse mmdd} { clock scan {12 xxxi} -format {%m %Oe} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.185 {parse mmdd} { clock scan {xii 31} -format {%Om %d} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.186 {parse mmdd} { clock scan {xii xxxi} -format {%Om %Od} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.187 {parse mmdd} { clock scan {xii 31} -format {%Om %e} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.188 {parse mmdd} { clock scan {xii xxxi} -format {%Om %Oe} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.189 {parse mmdd} { clock scan {12 31} -format {%N %d} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.190 {parse mmdd} { clock scan {12 xxxi} -format {%N %Od} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.191 {parse mmdd} { clock scan {12 31} -format {%N %e} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.192 {parse mmdd} { clock scan {12 xxxi} -format {%N %Oe} -locale en_US_roman -base 0 -gmt 1 } 31449600 test clock-19.193 {parse mmdd} { clock scan {Jan 02} -format {%b %d} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.194 {parse mmdd} { clock scan {Jan ii} -format {%b %Od} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.195 {parse mmdd} { clock scan {Jan 2} -format {%b %e} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.196 {parse mmdd} { clock scan {Jan ii} -format {%b %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.197 {parse mmdd} { clock scan {January 02} -format {%B %d} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.198 {parse mmdd} { clock scan {January ii} -format {%B %Od} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.199 {parse mmdd} { clock scan {January 2} -format {%B %e} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.200 {parse mmdd} { clock scan {January ii} -format {%B %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.201 {parse mmdd} { clock scan {Jan 02} -format {%h %d} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.202 {parse mmdd} { clock scan {Jan ii} -format {%h %Od} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.203 {parse mmdd} { clock scan {Jan 2} -format {%h %e} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.204 {parse mmdd} { clock scan {Jan ii} -format {%h %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.205 {parse mmdd} { clock scan {01 02} -format {%m %d} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.206 {parse mmdd} { clock scan {01 ii} -format {%m %Od} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.207 {parse mmdd} { clock scan {01 2} -format {%m %e} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.208 {parse mmdd} { clock scan {01 ii} -format {%m %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.209 {parse mmdd} { clock scan {i 02} -format {%Om %d} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.210 {parse mmdd} { clock scan {i ii} -format {%Om %Od} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.211 {parse mmdd} { clock scan {i 2} -format {%Om %e} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.212 {parse mmdd} { clock scan {i ii} -format {%Om %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.213 {parse mmdd} { clock scan { 1 02} -format {%N %d} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.214 {parse mmdd} { clock scan { 1 ii} -format {%N %Od} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.215 {parse mmdd} { clock scan { 1 2} -format {%N %e} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.216 {parse mmdd} { clock scan { 1 ii} -format {%N %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-19.217 {parse mmdd} { clock scan {Jan 31} -format {%b %d} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.218 {parse mmdd} { clock scan {Jan xxxi} -format {%b %Od} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.219 {parse mmdd} { clock scan {Jan 31} -format {%b %e} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.220 {parse mmdd} { clock scan {Jan xxxi} -format {%b %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.221 {parse mmdd} { clock scan {January 31} -format {%B %d} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.222 {parse mmdd} { clock scan {January xxxi} -format {%B %Od} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.223 {parse mmdd} { clock scan {January 31} -format {%B %e} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.224 {parse mmdd} { clock scan {January xxxi} -format {%B %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.225 {parse mmdd} { clock scan {Jan 31} -format {%h %d} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.226 {parse mmdd} { clock scan {Jan xxxi} -format {%h %Od} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.227 {parse mmdd} { clock scan {Jan 31} -format {%h %e} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.228 {parse mmdd} { clock scan {Jan xxxi} -format {%h %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.229 {parse mmdd} { clock scan {01 31} -format {%m %d} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.230 {parse mmdd} { clock scan {01 xxxi} -format {%m %Od} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.231 {parse mmdd} { clock scan {01 31} -format {%m %e} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.232 {parse mmdd} { clock scan {01 xxxi} -format {%m %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.233 {parse mmdd} { clock scan {i 31} -format {%Om %d} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.234 {parse mmdd} { clock scan {i xxxi} -format {%Om %Od} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.235 {parse mmdd} { clock scan {i 31} -format {%Om %e} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.236 {parse mmdd} { clock scan {i xxxi} -format {%Om %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.237 {parse mmdd} { clock scan { 1 31} -format {%N %d} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.238 {parse mmdd} { clock scan { 1 xxxi} -format {%N %Od} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.239 {parse mmdd} { clock scan { 1 31} -format {%N %e} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.240 {parse mmdd} { clock scan { 1 xxxi} -format {%N %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 949276800 test clock-19.241 {parse mmdd} { clock scan {Dec 02} -format {%b %d} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.242 {parse mmdd} { clock scan {Dec ii} -format {%b %Od} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.243 {parse mmdd} { clock scan {Dec 2} -format {%b %e} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.244 {parse mmdd} { clock scan {Dec ii} -format {%b %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.245 {parse mmdd} { clock scan {December 02} -format {%B %d} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.246 {parse mmdd} { clock scan {December ii} -format {%B %Od} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.247 {parse mmdd} { clock scan {December 2} -format {%B %e} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.248 {parse mmdd} { clock scan {December ii} -format {%B %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.249 {parse mmdd} { clock scan {Dec 02} -format {%h %d} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.250 {parse mmdd} { clock scan {Dec ii} -format {%h %Od} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.251 {parse mmdd} { clock scan {Dec 2} -format {%h %e} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.252 {parse mmdd} { clock scan {Dec ii} -format {%h %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.253 {parse mmdd} { clock scan {12 02} -format {%m %d} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.254 {parse mmdd} { clock scan {12 ii} -format {%m %Od} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.255 {parse mmdd} { clock scan {12 2} -format {%m %e} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.256 {parse mmdd} { clock scan {12 ii} -format {%m %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.257 {parse mmdd} { clock scan {xii 02} -format {%Om %d} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.258 {parse mmdd} { clock scan {xii ii} -format {%Om %Od} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.259 {parse mmdd} { clock scan {xii 2} -format {%Om %e} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.260 {parse mmdd} { clock scan {xii ii} -format {%Om %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.261 {parse mmdd} { clock scan {12 02} -format {%N %d} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.262 {parse mmdd} { clock scan {12 ii} -format {%N %Od} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.263 {parse mmdd} { clock scan {12 2} -format {%N %e} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.264 {parse mmdd} { clock scan {12 ii} -format {%N %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 975715200 test clock-19.265 {parse mmdd} { clock scan {Dec 31} -format {%b %d} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.266 {parse mmdd} { clock scan {Dec xxxi} -format {%b %Od} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.267 {parse mmdd} { clock scan {Dec 31} -format {%b %e} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.268 {parse mmdd} { clock scan {Dec xxxi} -format {%b %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.269 {parse mmdd} { clock scan {December 31} -format {%B %d} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.270 {parse mmdd} { clock scan {December xxxi} -format {%B %Od} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.271 {parse mmdd} { clock scan {December 31} -format {%B %e} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.272 {parse mmdd} { clock scan {December xxxi} -format {%B %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.273 {parse mmdd} { clock scan {Dec 31} -format {%h %d} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.274 {parse mmdd} { clock scan {Dec xxxi} -format {%h %Od} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.275 {parse mmdd} { clock scan {Dec 31} -format {%h %e} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.276 {parse mmdd} { clock scan {Dec xxxi} -format {%h %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.277 {parse mmdd} { clock scan {12 31} -format {%m %d} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.278 {parse mmdd} { clock scan {12 xxxi} -format {%m %Od} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.279 {parse mmdd} { clock scan {12 31} -format {%m %e} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.280 {parse mmdd} { clock scan {12 xxxi} -format {%m %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.281 {parse mmdd} { clock scan {xii 31} -format {%Om %d} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.282 {parse mmdd} { clock scan {xii xxxi} -format {%Om %Od} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.283 {parse mmdd} { clock scan {xii 31} -format {%Om %e} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.284 {parse mmdd} { clock scan {xii xxxi} -format {%Om %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.285 {parse mmdd} { clock scan {12 31} -format {%N %d} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.286 {parse mmdd} { clock scan {12 xxxi} -format {%N %Od} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.287 {parse mmdd} { clock scan {12 31} -format {%N %e} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.288 {parse mmdd} { clock scan {12 xxxi} -format {%N %Oe} -locale en_US_roman -base 946684800 -gmt 1 } 978220800 test clock-19.289 {parse mmdd} { clock scan {Jan 02} -format {%b %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.290 {parse mmdd} { clock scan {Jan ii} -format {%b %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.291 {parse mmdd} { clock scan {Jan 2} -format {%b %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.292 {parse mmdd} { clock scan {Jan ii} -format {%b %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.293 {parse mmdd} { clock scan {January 02} -format {%B %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.294 {parse mmdd} { clock scan {January ii} -format {%B %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.295 {parse mmdd} { clock scan {January 2} -format {%B %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.296 {parse mmdd} { clock scan {January ii} -format {%B %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.297 {parse mmdd} { clock scan {Jan 02} -format {%h %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.298 {parse mmdd} { clock scan {Jan ii} -format {%h %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.299 {parse mmdd} { clock scan {Jan 2} -format {%h %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.300 {parse mmdd} { clock scan {Jan ii} -format {%h %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.301 {parse mmdd} { clock scan {01 02} -format {%m %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.302 {parse mmdd} { clock scan {01 ii} -format {%m %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.303 {parse mmdd} { clock scan {01 2} -format {%m %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.304 {parse mmdd} { clock scan {01 ii} -format {%m %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.305 {parse mmdd} { clock scan {i 02} -format {%Om %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.306 {parse mmdd} { clock scan {i ii} -format {%Om %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.307 {parse mmdd} { clock scan {i 2} -format {%Om %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.308 {parse mmdd} { clock scan {i ii} -format {%Om %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.309 {parse mmdd} { clock scan { 1 02} -format {%N %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.310 {parse mmdd} { clock scan { 1 ii} -format {%N %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.311 {parse mmdd} { clock scan { 1 2} -format {%N %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.312 {parse mmdd} { clock scan { 1 ii} -format {%N %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2114467200 test clock-19.313 {parse mmdd} { clock scan {Jan 31} -format {%b %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.314 {parse mmdd} { clock scan {Jan xxxi} -format {%b %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.315 {parse mmdd} { clock scan {Jan 31} -format {%b %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.316 {parse mmdd} { clock scan {Jan xxxi} -format {%b %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.317 {parse mmdd} { clock scan {January 31} -format {%B %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.318 {parse mmdd} { clock scan {January xxxi} -format {%B %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.319 {parse mmdd} { clock scan {January 31} -format {%B %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.320 {parse mmdd} { clock scan {January xxxi} -format {%B %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.321 {parse mmdd} { clock scan {Jan 31} -format {%h %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.322 {parse mmdd} { clock scan {Jan xxxi} -format {%h %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.323 {parse mmdd} { clock scan {Jan 31} -format {%h %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.324 {parse mmdd} { clock scan {Jan xxxi} -format {%h %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.325 {parse mmdd} { clock scan {01 31} -format {%m %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.326 {parse mmdd} { clock scan {01 xxxi} -format {%m %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.327 {parse mmdd} { clock scan {01 31} -format {%m %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.328 {parse mmdd} { clock scan {01 xxxi} -format {%m %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.329 {parse mmdd} { clock scan {i 31} -format {%Om %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.330 {parse mmdd} { clock scan {i xxxi} -format {%Om %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.331 {parse mmdd} { clock scan {i 31} -format {%Om %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.332 {parse mmdd} { clock scan {i xxxi} -format {%Om %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.333 {parse mmdd} { clock scan { 1 31} -format {%N %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.334 {parse mmdd} { clock scan { 1 xxxi} -format {%N %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.335 {parse mmdd} { clock scan { 1 31} -format {%N %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.336 {parse mmdd} { clock scan { 1 xxxi} -format {%N %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2116972800 test clock-19.337 {parse mmdd} { clock scan {Dec 02} -format {%b %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.338 {parse mmdd} { clock scan {Dec ii} -format {%b %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.339 {parse mmdd} { clock scan {Dec 2} -format {%b %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.340 {parse mmdd} { clock scan {Dec ii} -format {%b %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.341 {parse mmdd} { clock scan {December 02} -format {%B %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.342 {parse mmdd} { clock scan {December ii} -format {%B %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.343 {parse mmdd} { clock scan {December 2} -format {%B %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.344 {parse mmdd} { clock scan {December ii} -format {%B %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.345 {parse mmdd} { clock scan {Dec 02} -format {%h %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.346 {parse mmdd} { clock scan {Dec ii} -format {%h %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.347 {parse mmdd} { clock scan {Dec 2} -format {%h %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.348 {parse mmdd} { clock scan {Dec ii} -format {%h %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.349 {parse mmdd} { clock scan {12 02} -format {%m %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.350 {parse mmdd} { clock scan {12 ii} -format {%m %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.351 {parse mmdd} { clock scan {12 2} -format {%m %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.352 {parse mmdd} { clock scan {12 ii} -format {%m %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.353 {parse mmdd} { clock scan {xii 02} -format {%Om %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.354 {parse mmdd} { clock scan {xii ii} -format {%Om %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.355 {parse mmdd} { clock scan {xii 2} -format {%Om %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.356 {parse mmdd} { clock scan {xii ii} -format {%Om %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.357 {parse mmdd} { clock scan {12 02} -format {%N %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.358 {parse mmdd} { clock scan {12 ii} -format {%N %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.359 {parse mmdd} { clock scan {12 2} -format {%N %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.360 {parse mmdd} { clock scan {12 ii} -format {%N %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2143324800 test clock-19.361 {parse mmdd} { clock scan {Dec 31} -format {%b %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.362 {parse mmdd} { clock scan {Dec xxxi} -format {%b %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.363 {parse mmdd} { clock scan {Dec 31} -format {%b %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.364 {parse mmdd} { clock scan {Dec xxxi} -format {%b %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.365 {parse mmdd} { clock scan {December 31} -format {%B %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.366 {parse mmdd} { clock scan {December xxxi} -format {%B %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.367 {parse mmdd} { clock scan {December 31} -format {%B %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.368 {parse mmdd} { clock scan {December xxxi} -format {%B %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.369 {parse mmdd} { clock scan {Dec 31} -format {%h %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.370 {parse mmdd} { clock scan {Dec xxxi} -format {%h %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.371 {parse mmdd} { clock scan {Dec 31} -format {%h %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.372 {parse mmdd} { clock scan {Dec xxxi} -format {%h %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.373 {parse mmdd} { clock scan {12 31} -format {%m %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.374 {parse mmdd} { clock scan {12 xxxi} -format {%m %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.375 {parse mmdd} { clock scan {12 31} -format {%m %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.376 {parse mmdd} { clock scan {12 xxxi} -format {%m %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.377 {parse mmdd} { clock scan {xii 31} -format {%Om %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.378 {parse mmdd} { clock scan {xii xxxi} -format {%Om %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.379 {parse mmdd} { clock scan {xii 31} -format {%Om %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.380 {parse mmdd} { clock scan {xii xxxi} -format {%Om %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.381 {parse mmdd} { clock scan {12 31} -format {%N %d} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.382 {parse mmdd} { clock scan {12 xxxi} -format {%N %Od} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.383 {parse mmdd} { clock scan {12 31} -format {%N %e} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 test clock-19.384 {parse mmdd} { clock scan {12 xxxi} -format {%N %Oe} -locale en_US_roman -base 2114380800 -gmt 1 } 2145830400 # END testcases19 test clock-20.1 {seconds take precedence over mmdd} { list [clock scan {0 0201} -format {%s %m%d} -gmt true -base 0] \ [clock scan {0201 0} -format {%m%d %s} -gmt true -base 0] } {0 0} test clock-20.2 {julian day takes precedence over yyddd} { list [clock scan {2440588 0201} -format {%J %m%d} -gmt true -base 0] \ [clock scan {0201 2440588} -format {%m%d %J} -gmt true -base 0] } {0 0} test clock-20.3 {yyyyWwwd over mmdd} { list [clock scan {1970W014 0201} -format {%GW%V%u %m%d} -gmt true -base 0] \ [clock scan {0201 1970W014} -format {%m%d %GW%V%u} -gmt true -base 0] } {0 0} test clock-20.4 {yyWwwd over mmdd} { list [clock scan {70W014 0201} -format {%gW%V%u %m%d} -gmt true -base 0] \ [clock scan {0201 70W014} -format {%m%d %gW%V%u} -gmt true -base 0] } {0 0} # Test parsing of ddd test clock-21.1 {parse ddd} { clock scan {001} -format {%j} -locale en_US_roman -gmt 1 -base 0 } 0 test clock-21.2 {parse ddd} { clock scan {365} -format {%j} -locale en_US_roman -gmt 1 -base 0 } 31449600 test clock-21.3 {parse ddd} { clock scan {001} -format {%j} -locale en_US_roman -gmt 1 -base 31536000 } 31536000 test clock-21.4 {parse ddd} { clock scan {365} -format {%j} -locale en_US_roman -gmt 1 -base 31536000 } 62985600 test clock-21.5 {seconds take precedence over ddd} { list [clock scan {0 002} -format {%s %j} -gmt true -base 0] \ [clock scan {002 0} -format {%j %s} -gmt true -base 0] } {0 0} test clock-21.6 {julian day takes precedence over yyddd} { list [clock scan {2440588 002} -format {%J %j} -gmt true -base 0] \ [clock scan {002 2440588} -format {%j %J} -gmt true -base 0] } {0 0} test clock-21.7 {yyyyWwwd over ddd} { list [clock scan {1970W014 002} -format {%GW%V%u %j} -gmt true -base 0] \ [clock scan {002 1970W014} -format {%j %GW%V%u} -gmt true -base 0] } {0 0} test clock-21.8 {yyWwwd over ddd} { list [clock scan {70W014 002} -format {%gW%V%u %j} -gmt true -base 0] \ [clock scan {002 70W014} -format {%j %gW%V%u} -gmt true -base 0] } {0 0} # BEGIN testcases22 # Test parsing of Wwwd test clock-22.1 {parse Wwwd} { clock scan {W09 Sun} -format {W%V %a} -locale en_US_roman -gmt 1 -base 259200 } 5097600 test clock-22.2 {parse Wwwd} { clock scan {W09 Sunday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 259200 } 5097600 test clock-22.3 {parse Wwwd} { clock scan {W09 7} -format {W%V %u} -locale en_US_roman -gmt 1 -base 259200 } 5097600 test clock-22.4 {parse Wwwd} { clock scan {W09 0} -format {W%V %w} -locale en_US_roman -gmt 1 -base 259200 } 5097600 test clock-22.5 {parse Wwwd} { clock scan {W09 vii} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 259200 } 5097600 test clock-22.6 {parse Wwwd} { clock scan {W09 ?} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 259200 } 5097600 test clock-22.7 {parse Wwwd} { clock scan {W14 Tue} -format {W%V %a} -locale en_US_roman -gmt 1 -base 259200 } 7689600 test clock-22.8 {parse Wwwd} { clock scan {W14 Tuesday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 259200 } 7689600 test clock-22.9 {parse Wwwd} { clock scan {W14 2} -format {W%V %u} -locale en_US_roman -gmt 1 -base 259200 } 7689600 test clock-22.10 {parse Wwwd} { clock scan {W14 2} -format {W%V %w} -locale en_US_roman -gmt 1 -base 259200 } 7689600 test clock-22.11 {parse Wwwd} { clock scan {W14 ii} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 259200 } 7689600 test clock-22.12 {parse Wwwd} { clock scan {W14 ii} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 259200 } 7689600 test clock-22.13 {parse Wwwd} { clock scan {W40 Thu} -format {W%V %a} -locale en_US_roman -gmt 1 -base 259200 } 23587200 test clock-22.14 {parse Wwwd} { clock scan {W40 Thursday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 259200 } 23587200 test clock-22.15 {parse Wwwd} { clock scan {W40 4} -format {W%V %u} -locale en_US_roman -gmt 1 -base 259200 } 23587200 test clock-22.16 {parse Wwwd} { clock scan {W40 4} -format {W%V %w} -locale en_US_roman -gmt 1 -base 259200 } 23587200 test clock-22.17 {parse Wwwd} { clock scan {W40 iv} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 259200 } 23587200 test clock-22.18 {parse Wwwd} { clock scan {W40 iv} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 259200 } 23587200 test clock-22.19 {parse Wwwd} { clock scan {W44 Sat} -format {W%V %a} -locale en_US_roman -gmt 1 -base 259200 } 26179200 test clock-22.20 {parse Wwwd} { clock scan {W44 Saturday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 259200 } 26179200 test clock-22.21 {parse Wwwd} { clock scan {W44 6} -format {W%V %u} -locale en_US_roman -gmt 1 -base 259200 } 26179200 test clock-22.22 {parse Wwwd} { clock scan {W44 6} -format {W%V %w} -locale en_US_roman -gmt 1 -base 259200 } 26179200 test clock-22.23 {parse Wwwd} { clock scan {W44 vi} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 259200 } 26179200 test clock-22.24 {parse Wwwd} { clock scan {W44 vi} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 259200 } 26179200 test clock-22.25 {parse Wwwd} { clock scan {W09 Mon} -format {W%V %a} -locale en_US_roman -gmt 1 -base 31795200 } 36633600 test clock-22.26 {parse Wwwd} { clock scan {W09 Monday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 31795200 } 36633600 test clock-22.27 {parse Wwwd} { clock scan {W09 1} -format {W%V %u} -locale en_US_roman -gmt 1 -base 31795200 } 36633600 test clock-22.28 {parse Wwwd} { clock scan {W09 1} -format {W%V %w} -locale en_US_roman -gmt 1 -base 31795200 } 36633600 test clock-22.29 {parse Wwwd} { clock scan {W09 i} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 31795200 } 36633600 test clock-22.30 {parse Wwwd} { clock scan {W09 i} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 31795200 } 36633600 test clock-22.31 {parse Wwwd} { clock scan {W13 Wed} -format {W%V %a} -locale en_US_roman -gmt 1 -base 31795200 } 39225600 test clock-22.32 {parse Wwwd} { clock scan {W13 Wednesday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 31795200 } 39225600 test clock-22.33 {parse Wwwd} { clock scan {W13 3} -format {W%V %u} -locale en_US_roman -gmt 1 -base 31795200 } 39225600 test clock-22.34 {parse Wwwd} { clock scan {W13 3} -format {W%V %w} -locale en_US_roman -gmt 1 -base 31795200 } 39225600 test clock-22.35 {parse Wwwd} { clock scan {W13 iii} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 31795200 } 39225600 test clock-22.36 {parse Wwwd} { clock scan {W13 iii} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 31795200 } 39225600 test clock-22.37 {parse Wwwd} { clock scan {W39 Fri} -format {W%V %a} -locale en_US_roman -gmt 1 -base 31795200 } 55123200 test clock-22.38 {parse Wwwd} { clock scan {W39 Friday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 31795200 } 55123200 test clock-22.39 {parse Wwwd} { clock scan {W39 5} -format {W%V %u} -locale en_US_roman -gmt 1 -base 31795200 } 55123200 test clock-22.40 {parse Wwwd} { clock scan {W39 5} -format {W%V %w} -locale en_US_roman -gmt 1 -base 31795200 } 55123200 test clock-22.41 {parse Wwwd} { clock scan {W39 v} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 31795200 } 55123200 test clock-22.42 {parse Wwwd} { clock scan {W39 v} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 31795200 } 55123200 test clock-22.43 {parse Wwwd} { clock scan {W43 Sun} -format {W%V %a} -locale en_US_roman -gmt 1 -base 31795200 } 57715200 test clock-22.44 {parse Wwwd} { clock scan {W43 Sunday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 31795200 } 57715200 test clock-22.45 {parse Wwwd} { clock scan {W43 7} -format {W%V %u} -locale en_US_roman -gmt 1 -base 31795200 } 57715200 test clock-22.46 {parse Wwwd} { clock scan {W43 0} -format {W%V %w} -locale en_US_roman -gmt 1 -base 31795200 } 57715200 test clock-22.47 {parse Wwwd} { clock scan {W43 vii} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 31795200 } 57715200 test clock-22.48 {parse Wwwd} { clock scan {W43 ?} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 31795200 } 57715200 test clock-22.49 {parse Wwwd} { clock scan {W09 Wed} -format {W%V %a} -locale en_US_roman -gmt 1 -base 946944000 } 951868800 test clock-22.50 {parse Wwwd} { clock scan {W09 Wednesday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 946944000 } 951868800 test clock-22.51 {parse Wwwd} { clock scan {W09 3} -format {W%V %u} -locale en_US_roman -gmt 1 -base 946944000 } 951868800 test clock-22.52 {parse Wwwd} { clock scan {W09 3} -format {W%V %w} -locale en_US_roman -gmt 1 -base 946944000 } 951868800 test clock-22.53 {parse Wwwd} { clock scan {W09 iii} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 946944000 } 951868800 test clock-22.54 {parse Wwwd} { clock scan {W09 iii} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 946944000 } 951868800 test clock-22.55 {parse Wwwd} { clock scan {W13 Fri} -format {W%V %a} -locale en_US_roman -gmt 1 -base 946944000 } 954460800 test clock-22.56 {parse Wwwd} { clock scan {W13 Friday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 946944000 } 954460800 test clock-22.57 {parse Wwwd} { clock scan {W13 5} -format {W%V %u} -locale en_US_roman -gmt 1 -base 946944000 } 954460800 test clock-22.58 {parse Wwwd} { clock scan {W13 5} -format {W%V %w} -locale en_US_roman -gmt 1 -base 946944000 } 954460800 test clock-22.59 {parse Wwwd} { clock scan {W13 v} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 946944000 } 954460800 test clock-22.60 {parse Wwwd} { clock scan {W13 v} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 946944000 } 954460800 test clock-22.61 {parse Wwwd} { clock scan {W39 Sun} -format {W%V %a} -locale en_US_roman -gmt 1 -base 946944000 } 970358400 test clock-22.62 {parse Wwwd} { clock scan {W39 Sunday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 946944000 } 970358400 test clock-22.63 {parse Wwwd} { clock scan {W39 7} -format {W%V %u} -locale en_US_roman -gmt 1 -base 946944000 } 970358400 test clock-22.64 {parse Wwwd} { clock scan {W39 0} -format {W%V %w} -locale en_US_roman -gmt 1 -base 946944000 } 970358400 test clock-22.65 {parse Wwwd} { clock scan {W39 vii} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 946944000 } 970358400 test clock-22.66 {parse Wwwd} { clock scan {W39 ?} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 946944000 } 970358400 test clock-22.67 {parse Wwwd} { clock scan {W44 Tue} -format {W%V %a} -locale en_US_roman -gmt 1 -base 946944000 } 972950400 test clock-22.68 {parse Wwwd} { clock scan {W44 Tuesday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 946944000 } 972950400 test clock-22.69 {parse Wwwd} { clock scan {W44 2} -format {W%V %u} -locale en_US_roman -gmt 1 -base 946944000 } 972950400 test clock-22.70 {parse Wwwd} { clock scan {W44 2} -format {W%V %w} -locale en_US_roman -gmt 1 -base 946944000 } 972950400 test clock-22.71 {parse Wwwd} { clock scan {W44 ii} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 946944000 } 972950400 test clock-22.72 {parse Wwwd} { clock scan {W44 ii} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 946944000 } 972950400 test clock-22.73 {parse Wwwd} { clock scan {W09 Thu} -format {W%V %a} -locale en_US_roman -gmt 1 -base 978566400 } 983404800 test clock-22.74 {parse Wwwd} { clock scan {W09 Thursday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 978566400 } 983404800 test clock-22.75 {parse Wwwd} { clock scan {W09 4} -format {W%V %u} -locale en_US_roman -gmt 1 -base 978566400 } 983404800 test clock-22.76 {parse Wwwd} { clock scan {W09 4} -format {W%V %w} -locale en_US_roman -gmt 1 -base 978566400 } 983404800 test clock-22.77 {parse Wwwd} { clock scan {W09 iv} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 978566400 } 983404800 test clock-22.78 {parse Wwwd} { clock scan {W09 iv} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 978566400 } 983404800 test clock-22.79 {parse Wwwd} { clock scan {W13 Sat} -format {W%V %a} -locale en_US_roman -gmt 1 -base 978566400 } 985996800 test clock-22.80 {parse Wwwd} { clock scan {W13 Saturday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 978566400 } 985996800 test clock-22.81 {parse Wwwd} { clock scan {W13 6} -format {W%V %u} -locale en_US_roman -gmt 1 -base 978566400 } 985996800 test clock-22.82 {parse Wwwd} { clock scan {W13 6} -format {W%V %w} -locale en_US_roman -gmt 1 -base 978566400 } 985996800 test clock-22.83 {parse Wwwd} { clock scan {W13 vi} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 978566400 } 985996800 test clock-22.84 {parse Wwwd} { clock scan {W13 vi} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 978566400 } 985996800 test clock-22.85 {parse Wwwd} { clock scan {W40 Mon} -format {W%V %a} -locale en_US_roman -gmt 1 -base 978566400 } 1001894400 test clock-22.86 {parse Wwwd} { clock scan {W40 Monday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 978566400 } 1001894400 test clock-22.87 {parse Wwwd} { clock scan {W40 1} -format {W%V %u} -locale en_US_roman -gmt 1 -base 978566400 } 1001894400 test clock-22.88 {parse Wwwd} { clock scan {W40 1} -format {W%V %w} -locale en_US_roman -gmt 1 -base 978566400 } 1001894400 test clock-22.89 {parse Wwwd} { clock scan {W40 i} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 978566400 } 1001894400 test clock-22.90 {parse Wwwd} { clock scan {W40 i} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 978566400 } 1001894400 test clock-22.91 {parse Wwwd} { clock scan {W44 Wed} -format {W%V %a} -locale en_US_roman -gmt 1 -base 978566400 } 1004486400 test clock-22.92 {parse Wwwd} { clock scan {W44 Wednesday} -format {W%V %A} -locale en_US_roman -gmt 1 -base 978566400 } 1004486400 test clock-22.93 {parse Wwwd} { clock scan {W44 3} -format {W%V %u} -locale en_US_roman -gmt 1 -base 978566400 } 1004486400 test clock-22.94 {parse Wwwd} { clock scan {W44 3} -format {W%V %w} -locale en_US_roman -gmt 1 -base 978566400 } 1004486400 test clock-22.95 {parse Wwwd} { clock scan {W44 iii} -format {W%V %Ou} -locale en_US_roman -gmt 1 -base 978566400 } 1004486400 test clock-22.96 {parse Wwwd} { clock scan {W44 iii} -format {W%V %Ow} -locale en_US_roman -gmt 1 -base 978566400 } 1004486400 # END testcases22 # Test precedence of Wwwd test clock-23.1 {seconds take precedence over Wwwd} { list [clock scan {0 W024} -format {%s W%V%u} -gmt true -base 0] \ [clock scan {W024 0} -format {W%V%u %s} -gmt true -base 0] } {0 0} test clock-23.2 {julian day takes precedence over Wwwd} { list [clock scan {2440588 W024} -format {%J W%V%u} -gmt true -base 0] \ [clock scan {W024 2440588} -format {W%V%u %J} -gmt true -base 0] } {0 0} test clock-23.3 {Wwwd precedence below yyyymmdd} { list [clock scan {19700101 W014} -format {%Y%m%d W%V%u} -gmt true -base 0] \ [clock scan {W014 19700101} -format {W%V%u %Y%m%d} -gmt true -base 0] } {0 0} test clock-23.4 {Wwwd precedence below yyyyddd} { list [clock scan {1970001 W014} -format {%Y%j W%V%u} -gmt true -base 0] \ [clock scan {W014 1970001} -format {W%V%u %Y%j} -gmt true -base 0] } {0 0} test clock-23.5 {Wwwd precedence below yymmdd} { list [clock scan {700101 W014} -format {%y%m%d W%V%u} -gmt true -base 0] \ [clock scan {W014 700101} -format {W%V%u %y%m%d} -gmt true -base 0] } {0 0} test clock-23.6 {Wwwd precedence below yyddd} { list [clock scan {70001 W014} -format {%y%j W%V%u} -gmt true -base 0] \ [clock scan {W014 70001} -format {W%V%u %y%j} -gmt true -base 0] } {0 0} # BEGIN testcases24 # Test parsing of naked day-of-month test clock-24.1 {parse naked day of month} { clock scan 02 -format %d -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-24.2 {parse naked day of month} { clock scan ii -format %Od -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-24.3 {parse naked day of month} { clock scan { 2} -format %e -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-24.4 {parse naked day of month} { clock scan ii -format %Oe -locale en_US_roman -base 0 -gmt 1 } 86400 test clock-24.5 {parse naked day of month} { clock scan 28 -format %d -locale en_US_roman -base 0 -gmt 1 } 2332800 test clock-24.6 {parse naked day of month} { clock scan xxviii -format %Od -locale en_US_roman -base 0 -gmt 1 } 2332800 test clock-24.7 {parse naked day of month} { clock scan 28 -format %e -locale en_US_roman -base 0 -gmt 1 } 2332800 test clock-24.8 {parse naked day of month} { clock scan xxviii -format %Oe -locale en_US_roman -base 0 -gmt 1 } 2332800 test clock-24.9 {parse naked day of month} { clock scan 02 -format %d -locale en_US_roman -base 28857600 -gmt 1 } 28944000 test clock-24.10 {parse naked day of month} { clock scan ii -format %Od -locale en_US_roman -base 28857600 -gmt 1 } 28944000 test clock-24.11 {parse naked day of month} { clock scan { 2} -format %e -locale en_US_roman -base 28857600 -gmt 1 } 28944000 test clock-24.12 {parse naked day of month} { clock scan ii -format %Oe -locale en_US_roman -base 28857600 -gmt 1 } 28944000 test clock-24.13 {parse naked day of month} { clock scan 28 -format %d -locale en_US_roman -base 28857600 -gmt 1 } 31190400 test clock-24.14 {parse naked day of month} { clock scan xxviii -format %Od -locale en_US_roman -base 28857600 -gmt 1 } 31190400 test clock-24.15 {parse naked day of month} { clock scan 28 -format %e -locale en_US_roman -base 28857600 -gmt 1 } 31190400 test clock-24.16 {parse naked day of month} { clock scan xxviii -format %Oe -locale en_US_roman -base 28857600 -gmt 1 } 31190400 test clock-24.17 {parse naked day of month} { clock scan 02 -format %d -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-24.18 {parse naked day of month} { clock scan ii -format %Od -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-24.19 {parse naked day of month} { clock scan { 2} -format %e -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-24.20 {parse naked day of month} { clock scan ii -format %Oe -locale en_US_roman -base 946684800 -gmt 1 } 946771200 test clock-24.21 {parse naked day of month} { clock scan 28 -format %d -locale en_US_roman -base 946684800 -gmt 1 } 949017600 test clock-24.22 {parse naked day of month} { clock scan xxviii -format %Od -locale en_US_roman -base 946684800 -gmt 1 } 949017600 test clock-24.23 {parse naked day of month} { clock scan 28 -format %e -locale en_US_roman -base 946684800 -gmt 1 } 949017600 test clock-24.24 {parse naked day of month} { clock scan xxviii -format %Oe -locale en_US_roman -base 946684800 -gmt 1 } 949017600 test clock-24.25 {parse naked day of month} { clock scan 02 -format %d -locale en_US_roman -base 975628800 -gmt 1 } 975715200 test clock-24.26 {parse naked day of month} { clock scan ii -format %Od -locale en_US_roman -base 975628800 -gmt 1 } 975715200 test clock-24.27 {parse naked day of month} { clock scan { 2} -format %e -locale en_US_roman -base 975628800 -gmt 1 } 975715200 test clock-24.28 {parse naked day of month} { clock scan ii -format %Oe -locale en_US_roman -base 975628800 -gmt 1 } 975715200 test clock-24.29 {parse naked day of month} { clock scan 28 -format %d -locale en_US_roman -base 975628800 -gmt 1 } 977961600 test clock-24.30 {parse naked day of month} { clock scan xxviii -format %Od -locale en_US_roman -base 975628800 -gmt 1 } 977961600 test clock-24.31 {parse naked day of month} { clock scan 28 -format %e -locale en_US_roman -base 975628800 -gmt 1 } 977961600 test clock-24.32 {parse naked day of month} { clock scan xxviii -format %Oe -locale en_US_roman -base 975628800 -gmt 1 } 977961600 # END testcases24 test clock-25.1 {seconds take precedence over dd} { list [clock scan {0 02} -format {%s %d} -gmt true -base 0] \ [clock scan {02 0} -format {%d %s} -gmt true -base 0] } {0 0} test clock-25.2 {julian day takes precedence over dd} { list [clock scan {2440588 02} -format {%J %d} -gmt true -base 0] \ [clock scan {02 2440588} -format {%d %J} -gmt true -base 0] } {0 0} test clock-25.3 {yyyyddd over dd} { list [clock scan {1970001 02} -format {%Y%j %d} -gmt true -base 0] \ [clock scan {02 1970001} -format {%d %Y%j} -gmt true -base 0] } {0 0} test clock-25.4 {yyyyWwwd over dd} { list [clock scan {1970W014 02} -format {%GW%V%u %d} -gmt true -base 0] \ [clock scan {02 1970W014} -format {%d %GW%V%u} -gmt true -base 0] } {0 0} test clock-25.5 {yyWwwd over dd} { list [clock scan {70W014 02} -format {%gW%V%u %d} -gmt true -base 0] \ [clock scan {02 70W014} -format {%d %gW%V%u} -gmt true -base 0] } {0 0} test clock-25.6 {yyddd over dd} { list [clock scan {70001 02} -format {%y%j %d} -gmt true -base 0] \ [clock scan {02 70001} -format {%d %y%j} -gmt true -base 0] } {0 0} test clock-25.7 {ddd over dd} { list [clock scan {001 02} -format {%j %d} -gmt true -base 0] \ [clock scan {02 001} -format {%d %j} -gmt true -base 0] } {0 0} # BEGIN testcases26 # Test parsing of naked day of week test clock-26.1 {parse naked day of week} { clock scan Mon -format %a -locale en_US_roman -gmt 1 -base 0 } -259200 test clock-26.2 {parse naked day of week} { clock scan Monday -format %A -locale en_US_roman -gmt 1 -base 0 } -259200 test clock-26.3 {parse naked day of week} { clock scan 1 -format %u -locale en_US_roman -gmt 1 -base 0 } -259200 test clock-26.4 {parse naked day of week} { clock scan 1 -format %w -locale en_US_roman -gmt 1 -base 0 } -259200 test clock-26.5 {parse naked day of week} { clock scan i -format %Ou -locale en_US_roman -gmt 1 -base 0 } -259200 test clock-26.6 {parse naked day of week} { clock scan i -format %Ow -locale en_US_roman -gmt 1 -base 0 } -259200 test clock-26.7 {parse naked day of week} { clock scan Sun -format %a -locale en_US_roman -gmt 1 -base 0 } 259200 test clock-26.8 {parse naked day of week} { clock scan Sunday -format %A -locale en_US_roman -gmt 1 -base 0 } 259200 test clock-26.9 {parse naked day of week} { clock scan 7 -format %u -locale en_US_roman -gmt 1 -base 0 } 259200 test clock-26.10 {parse naked day of week} { clock scan 0 -format %w -locale en_US_roman -gmt 1 -base 0 } 259200 test clock-26.11 {parse naked day of week} { clock scan vii -format %Ou -locale en_US_roman -gmt 1 -base 0 } 259200 test clock-26.12 {parse naked day of week} { clock scan ? -format %Ow -locale en_US_roman -gmt 1 -base 0 } 259200 test clock-26.13 {parse naked day of week} { clock scan Mon -format %a -locale en_US_roman -gmt 1 -base 30844800 } 30585600 test clock-26.14 {parse naked day of week} { clock scan Monday -format %A -locale en_US_roman -gmt 1 -base 30844800 } 30585600 test clock-26.15 {parse naked day of week} { clock scan 1 -format %u -locale en_US_roman -gmt 1 -base 30844800 } 30585600 test clock-26.16 {parse naked day of week} { clock scan 1 -format %w -locale en_US_roman -gmt 1 -base 30844800 } 30585600 test clock-26.17 {parse naked day of week} { clock scan i -format %Ou -locale en_US_roman -gmt 1 -base 30844800 } 30585600 test clock-26.18 {parse naked day of week} { clock scan i -format %Ow -locale en_US_roman -gmt 1 -base 30844800 } 30585600 test clock-26.19 {parse naked day of week} { clock scan Sun -format %a -locale en_US_roman -gmt 1 -base 30844800 } 31104000 test clock-26.20 {parse naked day of week} { clock scan Sunday -format %A -locale en_US_roman -gmt 1 -base 30844800 } 31104000 test clock-26.21 {parse naked day of week} { clock scan 7 -format %u -locale en_US_roman -gmt 1 -base 30844800 } 31104000 test clock-26.22 {parse naked day of week} { clock scan 0 -format %w -locale en_US_roman -gmt 1 -base 30844800 } 31104000 test clock-26.23 {parse naked day of week} { clock scan vii -format %Ou -locale en_US_roman -gmt 1 -base 30844800 } 31104000 test clock-26.24 {parse naked day of week} { clock scan ? -format %Ow -locale en_US_roman -gmt 1 -base 30844800 } 31104000 test clock-26.25 {parse naked day of week} { clock scan Mon -format %a -locale en_US_roman -gmt 1 -base 978566400 } 978307200 test clock-26.26 {parse naked day of week} { clock scan Monday -format %A -locale en_US_roman -gmt 1 -base 978566400 } 978307200 test clock-26.27 {parse naked day of week} { clock scan 1 -format %u -locale en_US_roman -gmt 1 -base 978566400 } 978307200 test clock-26.28 {parse naked day of week} { clock scan 1 -format %w -locale en_US_roman -gmt 1 -base 978566400 } 978307200 test clock-26.29 {parse naked day of week} { clock scan i -format %Ou -locale en_US_roman -gmt 1 -base 978566400 } 978307200 test clock-26.30 {parse naked day of week} { clock scan i -format %Ow -locale en_US_roman -gmt 1 -base 978566400 } 978307200 test clock-26.31 {parse naked day of week} { clock scan Sun -format %a -locale en_US_roman -gmt 1 -base 978566400 } 978825600 test clock-26.32 {parse naked day of week} { clock scan Sunday -format %A -locale en_US_roman -gmt 1 -base 978566400 } 978825600 test clock-26.33 {parse naked day of week} { clock scan 7 -format %u -locale en_US_roman -gmt 1 -base 978566400 } 978825600 test clock-26.34 {parse naked day of week} { clock scan 0 -format %w -locale en_US_roman -gmt 1 -base 978566400 } 978825600 test clock-26.35 {parse naked day of week} { clock scan vii -format %Ou -locale en_US_roman -gmt 1 -base 978566400 } 978825600 test clock-26.36 {parse naked day of week} { clock scan ? -format %Ow -locale en_US_roman -gmt 1 -base 978566400 } 978825600 test clock-26.37 {parse naked day of week} { clock scan Mon -format %a -locale en_US_roman -gmt 1 -base 1009411200 } 1009152000 test clock-26.38 {parse naked day of week} { clock scan Monday -format %A -locale en_US_roman -gmt 1 -base 1009411200 } 1009152000 test clock-26.39 {parse naked day of week} { clock scan 1 -format %u -locale en_US_roman -gmt 1 -base 1009411200 } 1009152000 test clock-26.40 {parse naked day of week} { clock scan 1 -format %w -locale en_US_roman -gmt 1 -base 1009411200 } 1009152000 test clock-26.41 {parse naked day of week} { clock scan i -format %Ou -locale en_US_roman -gmt 1 -base 1009411200 } 1009152000 test clock-26.42 {parse naked day of week} { clock scan i -format %Ow -locale en_US_roman -gmt 1 -base 1009411200 } 1009152000 test clock-26.43 {parse naked day of week} { clock scan Sun -format %a -locale en_US_roman -gmt 1 -base 1009411200 } 1009670400 test clock-26.44 {parse naked day of week} { clock scan Sunday -format %A -locale en_US_roman -gmt 1 -base 1009411200 } 1009670400 test clock-26.45 {parse naked day of week} { clock scan 7 -format %u -locale en_US_roman -gmt 1 -base 1009411200 } 1009670400 test clock-26.46 {parse naked day of week} { clock scan 0 -format %w -locale en_US_roman -gmt 1 -base 1009411200 } 1009670400 test clock-26.47 {parse naked day of week} { clock scan vii -format %Ou -locale en_US_roman -gmt 1 -base 1009411200 } 1009670400 test clock-26.48 {parse naked day of week} { clock scan ? -format %Ow -locale en_US_roman -gmt 1 -base 1009411200 } 1009670400 # END testcases26 test clock-27.1 {seconds take precedence over naked weekday} { list [clock scan {0 1} -format {%s %u} -gmt true -base 0] \ [clock scan {1 0} -format {%u %s} -gmt true -base 0] } {0 0} test clock-27.2 {julian day takes precedence over naked weekday} { list [clock scan {2440588 1} -format {%J %u} -gmt true -base 0] \ [clock scan {1 2440588} -format {%u %J} -gmt true -base 0] } {0 0} test clock-27.3 {yyyymmdd over naked weekday} { list [clock scan {19700101 1} -format {%Y%m%d %u} -gmt true -base 0] \ [clock scan {1 19700101} -format {%u %Y%m%d} -gmt true -base 0] } {0 0} test clock-27.4 {yyyyddd over naked weekday} { list [clock scan {1970001 1} -format {%Y%j %u} -gmt true -base 0] \ [clock scan {1 1970001} -format {%u %Y%j} -gmt true -base 0] } {0 0} test clock-27.5 {yymmdd over naked weekday} { list [clock scan {700101 1} -format {%y%m%d %u} -gmt true -base 0] \ [clock scan {1 700101} -format {%u %y%m%d} -gmt true -base 0] } {0 0} test clock-27.6 {yyddd over naked weekday} { list [clock scan {70001 1} -format {%y%j %u} -gmt true -base 0] \ [clock scan {1 70001} -format {%u %y%j} -gmt true -base 0] } {0 0} test clock-27.7 {mmdd over naked weekday} { list [clock scan {0101 1} -format {%m%d %u} -gmt true -base 0] \ [clock scan {1 0101} -format {%u %m%d} -gmt true -base 0] } {0 0} test clock-27.8 {ddd over naked weekday} { list [clock scan {001 1} -format {%j %u} -gmt true -base 0] \ [clock scan {1 001} -format {%u %j} -gmt true -base 0] } {0 0} test clock-27.9 {naked day of month over naked weekday} { list [clock scan {01 1} -format {%d %u} -gmt true -base 0] \ [clock scan {1 01} -format {%u %d} -gmt true -base 0] } {0 0} test clock-28.1 {base date} { clock scan {} -format {} -gmt true -base 1234567890 } 1234483200 # BEGIN testcases29 # Test parsing of time of day test clock-29.1 {time parsing} { clock scan {2440588 00 } \ -gmt true -locale en_US_roman \ -format {%J %H } } 0 test clock-29.2 {time parsing} { clock scan {2440588 00:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 0 test clock-29.3 {time parsing} { clock scan {2440588 00:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 0 test clock-29.4 {time parsing} { clock scan {2440588 00:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 0 test clock-29.5 {time parsing} { clock scan {2440588 00:?:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 0 test clock-29.6 {time parsing} { clock scan {2440588 0 } \ -gmt true -locale en_US_roman \ -format {%J %k } } 0 test clock-29.7 {time parsing} { clock scan {2440588 0:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 0 test clock-29.8 {time parsing} { clock scan {2440588 0:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 0 test clock-29.9 {time parsing} { clock scan {2440588 0:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 0 test clock-29.10 {time parsing} { clock scan {2440588 0:?:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 0 test clock-29.11 {time parsing} { clock scan {2440588 ? } \ -gmt true -locale en_US_roman \ -format {%J %OH } } 0 test clock-29.12 {time parsing} { clock scan {2440588 ?:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 0 test clock-29.13 {time parsing} { clock scan {2440588 ?:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 0 test clock-29.14 {time parsing} { clock scan {2440588 ?:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 0 test clock-29.15 {time parsing} { clock scan {2440588 ?:?:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 0 test clock-29.16 {time parsing} { clock scan {2440588 ? } \ -gmt true -locale en_US_roman \ -format {%J %Ok } } 0 test clock-29.17 {time parsing} { clock scan {2440588 ?:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 0 test clock-29.18 {time parsing} { clock scan {2440588 ?:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 0 test clock-29.19 {time parsing} { clock scan {2440588 ?:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 0 test clock-29.20 {time parsing} { clock scan {2440588 ?:?:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 0 test clock-29.21 {time parsing} { clock scan {2440588 12 AM} \ -gmt true -locale en_US_roman \ -format {%J %I %p} } 0 test clock-29.22 {time parsing} { clock scan {2440588 12:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 0 test clock-29.23 {time parsing} { clock scan {2440588 12:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 0 test clock-29.24 {time parsing} { clock scan {2440588 12:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 0 test clock-29.25 {time parsing} { clock scan {2440588 12:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 0 test clock-29.26 {time parsing} { clock scan {2440588 12 AM} \ -gmt true -locale en_US_roman \ -format {%J %l %p} } 0 test clock-29.27 {time parsing} { clock scan {2440588 12:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 0 test clock-29.28 {time parsing} { clock scan {2440588 12:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 0 test clock-29.29 {time parsing} { clock scan {2440588 12:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 0 test clock-29.30 {time parsing} { clock scan {2440588 12:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 0 test clock-29.31 {time parsing} { clock scan {2440588 xii AM} \ -gmt true -locale en_US_roman \ -format {%J %OI %p} } 0 test clock-29.32 {time parsing} { clock scan {2440588 xii:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 0 test clock-29.33 {time parsing} { clock scan {2440588 xii:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 0 test clock-29.34 {time parsing} { clock scan {2440588 xii:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 0 test clock-29.35 {time parsing} { clock scan {2440588 xii:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 0 test clock-29.36 {time parsing} { clock scan {2440588 xii AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol %p} } 0 test clock-29.37 {time parsing} { clock scan {2440588 xii:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 0 test clock-29.38 {time parsing} { clock scan {2440588 xii:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 0 test clock-29.39 {time parsing} { clock scan {2440588 xii:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 0 test clock-29.40 {time parsing} { clock scan {2440588 xii:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 0 test clock-29.41 {time parsing} { clock scan {2440588 12 am} \ -gmt true -locale en_US_roman \ -format {%J %I %P} } 0 test clock-29.42 {time parsing} { clock scan {2440588 12:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 0 test clock-29.43 {time parsing} { clock scan {2440588 12:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 0 test clock-29.44 {time parsing} { clock scan {2440588 12:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 0 test clock-29.45 {time parsing} { clock scan {2440588 12:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 0 test clock-29.46 {time parsing} { clock scan {2440588 12 am} \ -gmt true -locale en_US_roman \ -format {%J %l %P} } 0 test clock-29.47 {time parsing} { clock scan {2440588 12:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 0 test clock-29.48 {time parsing} { clock scan {2440588 12:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 0 test clock-29.49 {time parsing} { clock scan {2440588 12:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 0 test clock-29.50 {time parsing} { clock scan {2440588 12:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 0 test clock-29.51 {time parsing} { clock scan {2440588 xii am} \ -gmt true -locale en_US_roman \ -format {%J %OI %P} } 0 test clock-29.52 {time parsing} { clock scan {2440588 xii:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 0 test clock-29.53 {time parsing} { clock scan {2440588 xii:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 0 test clock-29.54 {time parsing} { clock scan {2440588 xii:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 0 test clock-29.55 {time parsing} { clock scan {2440588 xii:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 0 test clock-29.56 {time parsing} { clock scan {2440588 xii am} \ -gmt true -locale en_US_roman \ -format {%J %Ol %P} } 0 test clock-29.57 {time parsing} { clock scan {2440588 xii:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 0 test clock-29.58 {time parsing} { clock scan {2440588 xii:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 0 test clock-29.59 {time parsing} { clock scan {2440588 xii:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 0 test clock-29.60 {time parsing} { clock scan {2440588 xii:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 0 test clock-29.61 {time parsing} { clock scan {2440588 00:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 1 test clock-29.62 {time parsing} { clock scan {2440588 00:?:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 1 test clock-29.63 {time parsing} { clock scan {2440588 0:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 1 test clock-29.64 {time parsing} { clock scan {2440588 0:?:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 1 test clock-29.65 {time parsing} { clock scan {2440588 ?:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 1 test clock-29.66 {time parsing} { clock scan {2440588 ?:?:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 1 test clock-29.67 {time parsing} { clock scan {2440588 ?:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 1 test clock-29.68 {time parsing} { clock scan {2440588 ?:?:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 1 test clock-29.69 {time parsing} { clock scan {2440588 12:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 1 test clock-29.70 {time parsing} { clock scan {2440588 12:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 1 test clock-29.71 {time parsing} { clock scan {2440588 12:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 1 test clock-29.72 {time parsing} { clock scan {2440588 12:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 1 test clock-29.73 {time parsing} { clock scan {2440588 xii:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 1 test clock-29.74 {time parsing} { clock scan {2440588 xii:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 1 test clock-29.75 {time parsing} { clock scan {2440588 xii:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 1 test clock-29.76 {time parsing} { clock scan {2440588 xii:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 1 test clock-29.77 {time parsing} { clock scan {2440588 12:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 1 test clock-29.78 {time parsing} { clock scan {2440588 12:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 1 test clock-29.79 {time parsing} { clock scan {2440588 12:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 1 test clock-29.80 {time parsing} { clock scan {2440588 12:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 1 test clock-29.81 {time parsing} { clock scan {2440588 xii:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 1 test clock-29.82 {time parsing} { clock scan {2440588 xii:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 1 test clock-29.83 {time parsing} { clock scan {2440588 xii:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 1 test clock-29.84 {time parsing} { clock scan {2440588 xii:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 1 test clock-29.85 {time parsing} { clock scan {2440588 00:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 59 test clock-29.86 {time parsing} { clock scan {2440588 00:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 59 test clock-29.87 {time parsing} { clock scan {2440588 0:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 59 test clock-29.88 {time parsing} { clock scan {2440588 0:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 59 test clock-29.89 {time parsing} { clock scan {2440588 ?:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 59 test clock-29.90 {time parsing} { clock scan {2440588 ?:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 59 test clock-29.91 {time parsing} { clock scan {2440588 ?:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 59 test clock-29.92 {time parsing} { clock scan {2440588 ?:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 59 test clock-29.93 {time parsing} { clock scan {2440588 12:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 59 test clock-29.94 {time parsing} { clock scan {2440588 12:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 59 test clock-29.95 {time parsing} { clock scan {2440588 12:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 59 test clock-29.96 {time parsing} { clock scan {2440588 12:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 59 test clock-29.97 {time parsing} { clock scan {2440588 xii:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 59 test clock-29.98 {time parsing} { clock scan {2440588 xii:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 59 test clock-29.99 {time parsing} { clock scan {2440588 xii:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 59 test clock-29.100 {time parsing} { clock scan {2440588 xii:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 59 test clock-29.101 {time parsing} { clock scan {2440588 12:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 59 test clock-29.102 {time parsing} { clock scan {2440588 12:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 59 test clock-29.103 {time parsing} { clock scan {2440588 12:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 59 test clock-29.104 {time parsing} { clock scan {2440588 12:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 59 test clock-29.105 {time parsing} { clock scan {2440588 xii:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 59 test clock-29.106 {time parsing} { clock scan {2440588 xii:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 59 test clock-29.107 {time parsing} { clock scan {2440588 xii:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 59 test clock-29.108 {time parsing} { clock scan {2440588 xii:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 59 test clock-29.109 {time parsing} { clock scan {2440588 00:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 60 test clock-29.110 {time parsing} { clock scan {2440588 00:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 60 test clock-29.111 {time parsing} { clock scan {2440588 00:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 60 test clock-29.112 {time parsing} { clock scan {2440588 00:i:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 60 test clock-29.113 {time parsing} { clock scan {2440588 0:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 60 test clock-29.114 {time parsing} { clock scan {2440588 0:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 60 test clock-29.115 {time parsing} { clock scan {2440588 0:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 60 test clock-29.116 {time parsing} { clock scan {2440588 0:i:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 60 test clock-29.117 {time parsing} { clock scan {2440588 ?:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 60 test clock-29.118 {time parsing} { clock scan {2440588 ?:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 60 test clock-29.119 {time parsing} { clock scan {2440588 ?:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 60 test clock-29.120 {time parsing} { clock scan {2440588 ?:i:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 60 test clock-29.121 {time parsing} { clock scan {2440588 ?:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 60 test clock-29.122 {time parsing} { clock scan {2440588 ?:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 60 test clock-29.123 {time parsing} { clock scan {2440588 ?:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 60 test clock-29.124 {time parsing} { clock scan {2440588 ?:i:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 60 test clock-29.125 {time parsing} { clock scan {2440588 12:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 60 test clock-29.126 {time parsing} { clock scan {2440588 12:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 60 test clock-29.127 {time parsing} { clock scan {2440588 12:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 60 test clock-29.128 {time parsing} { clock scan {2440588 12:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 60 test clock-29.129 {time parsing} { clock scan {2440588 12:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 60 test clock-29.130 {time parsing} { clock scan {2440588 12:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 60 test clock-29.131 {time parsing} { clock scan {2440588 12:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 60 test clock-29.132 {time parsing} { clock scan {2440588 12:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 60 test clock-29.133 {time parsing} { clock scan {2440588 xii:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 60 test clock-29.134 {time parsing} { clock scan {2440588 xii:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 60 test clock-29.135 {time parsing} { clock scan {2440588 xii:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 60 test clock-29.136 {time parsing} { clock scan {2440588 xii:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 60 test clock-29.137 {time parsing} { clock scan {2440588 xii:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 60 test clock-29.138 {time parsing} { clock scan {2440588 xii:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 60 test clock-29.139 {time parsing} { clock scan {2440588 xii:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 60 test clock-29.140 {time parsing} { clock scan {2440588 xii:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 60 test clock-29.141 {time parsing} { clock scan {2440588 12:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 60 test clock-29.142 {time parsing} { clock scan {2440588 12:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 60 test clock-29.143 {time parsing} { clock scan {2440588 12:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 60 test clock-29.144 {time parsing} { clock scan {2440588 12:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 60 test clock-29.145 {time parsing} { clock scan {2440588 12:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 60 test clock-29.146 {time parsing} { clock scan {2440588 12:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 60 test clock-29.147 {time parsing} { clock scan {2440588 12:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 60 test clock-29.148 {time parsing} { clock scan {2440588 12:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 60 test clock-29.149 {time parsing} { clock scan {2440588 xii:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 60 test clock-29.150 {time parsing} { clock scan {2440588 xii:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 60 test clock-29.151 {time parsing} { clock scan {2440588 xii:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 60 test clock-29.152 {time parsing} { clock scan {2440588 xii:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 60 test clock-29.153 {time parsing} { clock scan {2440588 xii:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 60 test clock-29.154 {time parsing} { clock scan {2440588 xii:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 60 test clock-29.155 {time parsing} { clock scan {2440588 xii:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 60 test clock-29.156 {time parsing} { clock scan {2440588 xii:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 60 test clock-29.157 {time parsing} { clock scan {2440588 00:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 61 test clock-29.158 {time parsing} { clock scan {2440588 00:i:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 61 test clock-29.159 {time parsing} { clock scan {2440588 0:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 61 test clock-29.160 {time parsing} { clock scan {2440588 0:i:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 61 test clock-29.161 {time parsing} { clock scan {2440588 ?:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 61 test clock-29.162 {time parsing} { clock scan {2440588 ?:i:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 61 test clock-29.163 {time parsing} { clock scan {2440588 ?:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 61 test clock-29.164 {time parsing} { clock scan {2440588 ?:i:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 61 test clock-29.165 {time parsing} { clock scan {2440588 12:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 61 test clock-29.166 {time parsing} { clock scan {2440588 12:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 61 test clock-29.167 {time parsing} { clock scan {2440588 12:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 61 test clock-29.168 {time parsing} { clock scan {2440588 12:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 61 test clock-29.169 {time parsing} { clock scan {2440588 xii:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 61 test clock-29.170 {time parsing} { clock scan {2440588 xii:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 61 test clock-29.171 {time parsing} { clock scan {2440588 xii:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 61 test clock-29.172 {time parsing} { clock scan {2440588 xii:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 61 test clock-29.173 {time parsing} { clock scan {2440588 12:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 61 test clock-29.174 {time parsing} { clock scan {2440588 12:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 61 test clock-29.175 {time parsing} { clock scan {2440588 12:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 61 test clock-29.176 {time parsing} { clock scan {2440588 12:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 61 test clock-29.177 {time parsing} { clock scan {2440588 xii:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 61 test clock-29.178 {time parsing} { clock scan {2440588 xii:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 61 test clock-29.179 {time parsing} { clock scan {2440588 xii:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 61 test clock-29.180 {time parsing} { clock scan {2440588 xii:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 61 test clock-29.181 {time parsing} { clock scan {2440588 00:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 119 test clock-29.182 {time parsing} { clock scan {2440588 00:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 119 test clock-29.183 {time parsing} { clock scan {2440588 0:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 119 test clock-29.184 {time parsing} { clock scan {2440588 0:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 119 test clock-29.185 {time parsing} { clock scan {2440588 ?:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 119 test clock-29.186 {time parsing} { clock scan {2440588 ?:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 119 test clock-29.187 {time parsing} { clock scan {2440588 ?:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 119 test clock-29.188 {time parsing} { clock scan {2440588 ?:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 119 test clock-29.189 {time parsing} { clock scan {2440588 12:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 119 test clock-29.190 {time parsing} { clock scan {2440588 12:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 119 test clock-29.191 {time parsing} { clock scan {2440588 12:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 119 test clock-29.192 {time parsing} { clock scan {2440588 12:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 119 test clock-29.193 {time parsing} { clock scan {2440588 xii:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 119 test clock-29.194 {time parsing} { clock scan {2440588 xii:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 119 test clock-29.195 {time parsing} { clock scan {2440588 xii:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 119 test clock-29.196 {time parsing} { clock scan {2440588 xii:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 119 test clock-29.197 {time parsing} { clock scan {2440588 12:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 119 test clock-29.198 {time parsing} { clock scan {2440588 12:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 119 test clock-29.199 {time parsing} { clock scan {2440588 12:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 119 test clock-29.200 {time parsing} { clock scan {2440588 12:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 119 test clock-29.201 {time parsing} { clock scan {2440588 xii:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 119 test clock-29.202 {time parsing} { clock scan {2440588 xii:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 119 test clock-29.203 {time parsing} { clock scan {2440588 xii:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 119 test clock-29.204 {time parsing} { clock scan {2440588 xii:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 119 test clock-29.205 {time parsing} { clock scan {2440588 00:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 3540 test clock-29.206 {time parsing} { clock scan {2440588 00:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 3540 test clock-29.207 {time parsing} { clock scan {2440588 00:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3540 test clock-29.208 {time parsing} { clock scan {2440588 00:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3540 test clock-29.209 {time parsing} { clock scan {2440588 0:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 3540 test clock-29.210 {time parsing} { clock scan {2440588 0:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 3540 test clock-29.211 {time parsing} { clock scan {2440588 0:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3540 test clock-29.212 {time parsing} { clock scan {2440588 0:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3540 test clock-29.213 {time parsing} { clock scan {2440588 ?:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 3540 test clock-29.214 {time parsing} { clock scan {2440588 ?:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 3540 test clock-29.215 {time parsing} { clock scan {2440588 ?:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3540 test clock-29.216 {time parsing} { clock scan {2440588 ?:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3540 test clock-29.217 {time parsing} { clock scan {2440588 ?:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 3540 test clock-29.218 {time parsing} { clock scan {2440588 ?:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 3540 test clock-29.219 {time parsing} { clock scan {2440588 ?:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3540 test clock-29.220 {time parsing} { clock scan {2440588 ?:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3540 test clock-29.221 {time parsing} { clock scan {2440588 12:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 3540 test clock-29.222 {time parsing} { clock scan {2440588 12:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 3540 test clock-29.223 {time parsing} { clock scan {2440588 12:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3540 test clock-29.224 {time parsing} { clock scan {2440588 12:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3540 test clock-29.225 {time parsing} { clock scan {2440588 12:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 3540 test clock-29.226 {time parsing} { clock scan {2440588 12:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 3540 test clock-29.227 {time parsing} { clock scan {2440588 12:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3540 test clock-29.228 {time parsing} { clock scan {2440588 12:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3540 test clock-29.229 {time parsing} { clock scan {2440588 xii:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 3540 test clock-29.230 {time parsing} { clock scan {2440588 xii:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 3540 test clock-29.231 {time parsing} { clock scan {2440588 xii:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3540 test clock-29.232 {time parsing} { clock scan {2440588 xii:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3540 test clock-29.233 {time parsing} { clock scan {2440588 xii:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 3540 test clock-29.234 {time parsing} { clock scan {2440588 xii:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 3540 test clock-29.235 {time parsing} { clock scan {2440588 xii:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3540 test clock-29.236 {time parsing} { clock scan {2440588 xii:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3540 test clock-29.237 {time parsing} { clock scan {2440588 12:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 3540 test clock-29.238 {time parsing} { clock scan {2440588 12:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 3540 test clock-29.239 {time parsing} { clock scan {2440588 12:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3540 test clock-29.240 {time parsing} { clock scan {2440588 12:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3540 test clock-29.241 {time parsing} { clock scan {2440588 12:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 3540 test clock-29.242 {time parsing} { clock scan {2440588 12:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 3540 test clock-29.243 {time parsing} { clock scan {2440588 12:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3540 test clock-29.244 {time parsing} { clock scan {2440588 12:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3540 test clock-29.245 {time parsing} { clock scan {2440588 xii:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 3540 test clock-29.246 {time parsing} { clock scan {2440588 xii:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 3540 test clock-29.247 {time parsing} { clock scan {2440588 xii:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3540 test clock-29.248 {time parsing} { clock scan {2440588 xii:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3540 test clock-29.249 {time parsing} { clock scan {2440588 xii:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 3540 test clock-29.250 {time parsing} { clock scan {2440588 xii:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 3540 test clock-29.251 {time parsing} { clock scan {2440588 xii:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3540 test clock-29.252 {time parsing} { clock scan {2440588 xii:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3540 test clock-29.253 {time parsing} { clock scan {2440588 00:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3541 test clock-29.254 {time parsing} { clock scan {2440588 00:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3541 test clock-29.255 {time parsing} { clock scan {2440588 0:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3541 test clock-29.256 {time parsing} { clock scan {2440588 0:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3541 test clock-29.257 {time parsing} { clock scan {2440588 ?:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3541 test clock-29.258 {time parsing} { clock scan {2440588 ?:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3541 test clock-29.259 {time parsing} { clock scan {2440588 ?:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3541 test clock-29.260 {time parsing} { clock scan {2440588 ?:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3541 test clock-29.261 {time parsing} { clock scan {2440588 12:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3541 test clock-29.262 {time parsing} { clock scan {2440588 12:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3541 test clock-29.263 {time parsing} { clock scan {2440588 12:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3541 test clock-29.264 {time parsing} { clock scan {2440588 12:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3541 test clock-29.265 {time parsing} { clock scan {2440588 xii:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3541 test clock-29.266 {time parsing} { clock scan {2440588 xii:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3541 test clock-29.267 {time parsing} { clock scan {2440588 xii:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3541 test clock-29.268 {time parsing} { clock scan {2440588 xii:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3541 test clock-29.269 {time parsing} { clock scan {2440588 12:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3541 test clock-29.270 {time parsing} { clock scan {2440588 12:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3541 test clock-29.271 {time parsing} { clock scan {2440588 12:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3541 test clock-29.272 {time parsing} { clock scan {2440588 12:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3541 test clock-29.273 {time parsing} { clock scan {2440588 xii:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3541 test clock-29.274 {time parsing} { clock scan {2440588 xii:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3541 test clock-29.275 {time parsing} { clock scan {2440588 xii:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3541 test clock-29.276 {time parsing} { clock scan {2440588 xii:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3541 test clock-29.277 {time parsing} { clock scan {2440588 00:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3599 test clock-29.278 {time parsing} { clock scan {2440588 00:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3599 test clock-29.279 {time parsing} { clock scan {2440588 0:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3599 test clock-29.280 {time parsing} { clock scan {2440588 0:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3599 test clock-29.281 {time parsing} { clock scan {2440588 ?:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3599 test clock-29.282 {time parsing} { clock scan {2440588 ?:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3599 test clock-29.283 {time parsing} { clock scan {2440588 ?:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3599 test clock-29.284 {time parsing} { clock scan {2440588 ?:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3599 test clock-29.285 {time parsing} { clock scan {2440588 12:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3599 test clock-29.286 {time parsing} { clock scan {2440588 12:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3599 test clock-29.287 {time parsing} { clock scan {2440588 12:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3599 test clock-29.288 {time parsing} { clock scan {2440588 12:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3599 test clock-29.289 {time parsing} { clock scan {2440588 xii:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3599 test clock-29.290 {time parsing} { clock scan {2440588 xii:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3599 test clock-29.291 {time parsing} { clock scan {2440588 xii:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3599 test clock-29.292 {time parsing} { clock scan {2440588 xii:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3599 test clock-29.293 {time parsing} { clock scan {2440588 12:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3599 test clock-29.294 {time parsing} { clock scan {2440588 12:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3599 test clock-29.295 {time parsing} { clock scan {2440588 12:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3599 test clock-29.296 {time parsing} { clock scan {2440588 12:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3599 test clock-29.297 {time parsing} { clock scan {2440588 xii:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3599 test clock-29.298 {time parsing} { clock scan {2440588 xii:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3599 test clock-29.299 {time parsing} { clock scan {2440588 xii:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3599 test clock-29.300 {time parsing} { clock scan {2440588 xii:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3599 test clock-29.301 {time parsing} { clock scan {2440588 01 } \ -gmt true -locale en_US_roman \ -format {%J %H } } 3600 test clock-29.302 {time parsing} { clock scan {2440588 01:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 3600 test clock-29.303 {time parsing} { clock scan {2440588 01:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 3600 test clock-29.304 {time parsing} { clock scan {2440588 01:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3600 test clock-29.305 {time parsing} { clock scan {2440588 01:?:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3600 test clock-29.306 {time parsing} { clock scan {2440588 1 } \ -gmt true -locale en_US_roman \ -format {%J %k } } 3600 test clock-29.307 {time parsing} { clock scan {2440588 1:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 3600 test clock-29.308 {time parsing} { clock scan {2440588 1:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 3600 test clock-29.309 {time parsing} { clock scan {2440588 1:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3600 test clock-29.310 {time parsing} { clock scan {2440588 1:?:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3600 test clock-29.311 {time parsing} { clock scan {2440588 i } \ -gmt true -locale en_US_roman \ -format {%J %OH } } 3600 test clock-29.312 {time parsing} { clock scan {2440588 i:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 3600 test clock-29.313 {time parsing} { clock scan {2440588 i:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 3600 test clock-29.314 {time parsing} { clock scan {2440588 i:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3600 test clock-29.315 {time parsing} { clock scan {2440588 i:?:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3600 test clock-29.316 {time parsing} { clock scan {2440588 i } \ -gmt true -locale en_US_roman \ -format {%J %Ok } } 3600 test clock-29.317 {time parsing} { clock scan {2440588 i:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 3600 test clock-29.318 {time parsing} { clock scan {2440588 i:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 3600 test clock-29.319 {time parsing} { clock scan {2440588 i:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3600 test clock-29.320 {time parsing} { clock scan {2440588 i:?:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3600 test clock-29.321 {time parsing} { clock scan {2440588 01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I %p} } 3600 test clock-29.322 {time parsing} { clock scan {2440588 01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 3600 test clock-29.323 {time parsing} { clock scan {2440588 01:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 3600 test clock-29.324 {time parsing} { clock scan {2440588 01:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3600 test clock-29.325 {time parsing} { clock scan {2440588 01:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3600 test clock-29.326 {time parsing} { clock scan {2440588 1 AM} \ -gmt true -locale en_US_roman \ -format {%J %l %p} } 3600 test clock-29.327 {time parsing} { clock scan {2440588 1:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 3600 test clock-29.328 {time parsing} { clock scan {2440588 1:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 3600 test clock-29.329 {time parsing} { clock scan {2440588 1:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3600 test clock-29.330 {time parsing} { clock scan {2440588 1:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3600 test clock-29.331 {time parsing} { clock scan {2440588 i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI %p} } 3600 test clock-29.332 {time parsing} { clock scan {2440588 i:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 3600 test clock-29.333 {time parsing} { clock scan {2440588 i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 3600 test clock-29.334 {time parsing} { clock scan {2440588 i:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3600 test clock-29.335 {time parsing} { clock scan {2440588 i:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3600 test clock-29.336 {time parsing} { clock scan {2440588 i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol %p} } 3600 test clock-29.337 {time parsing} { clock scan {2440588 i:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 3600 test clock-29.338 {time parsing} { clock scan {2440588 i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 3600 test clock-29.339 {time parsing} { clock scan {2440588 i:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3600 test clock-29.340 {time parsing} { clock scan {2440588 i:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3600 test clock-29.341 {time parsing} { clock scan {2440588 01 am} \ -gmt true -locale en_US_roman \ -format {%J %I %P} } 3600 test clock-29.342 {time parsing} { clock scan {2440588 01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 3600 test clock-29.343 {time parsing} { clock scan {2440588 01:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 3600 test clock-29.344 {time parsing} { clock scan {2440588 01:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3600 test clock-29.345 {time parsing} { clock scan {2440588 01:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3600 test clock-29.346 {time parsing} { clock scan {2440588 1 am} \ -gmt true -locale en_US_roman \ -format {%J %l %P} } 3600 test clock-29.347 {time parsing} { clock scan {2440588 1:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 3600 test clock-29.348 {time parsing} { clock scan {2440588 1:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 3600 test clock-29.349 {time parsing} { clock scan {2440588 1:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3600 test clock-29.350 {time parsing} { clock scan {2440588 1:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3600 test clock-29.351 {time parsing} { clock scan {2440588 i am} \ -gmt true -locale en_US_roman \ -format {%J %OI %P} } 3600 test clock-29.352 {time parsing} { clock scan {2440588 i:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 3600 test clock-29.353 {time parsing} { clock scan {2440588 i:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 3600 test clock-29.354 {time parsing} { clock scan {2440588 i:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3600 test clock-29.355 {time parsing} { clock scan {2440588 i:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3600 test clock-29.356 {time parsing} { clock scan {2440588 i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol %P} } 3600 test clock-29.357 {time parsing} { clock scan {2440588 i:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 3600 test clock-29.358 {time parsing} { clock scan {2440588 i:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 3600 test clock-29.359 {time parsing} { clock scan {2440588 i:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3600 test clock-29.360 {time parsing} { clock scan {2440588 i:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3600 test clock-29.361 {time parsing} { clock scan {2440588 01:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3601 test clock-29.362 {time parsing} { clock scan {2440588 01:?:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3601 test clock-29.363 {time parsing} { clock scan {2440588 1:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3601 test clock-29.364 {time parsing} { clock scan {2440588 1:?:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3601 test clock-29.365 {time parsing} { clock scan {2440588 i:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3601 test clock-29.366 {time parsing} { clock scan {2440588 i:?:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3601 test clock-29.367 {time parsing} { clock scan {2440588 i:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3601 test clock-29.368 {time parsing} { clock scan {2440588 i:?:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3601 test clock-29.369 {time parsing} { clock scan {2440588 01:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3601 test clock-29.370 {time parsing} { clock scan {2440588 01:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3601 test clock-29.371 {time parsing} { clock scan {2440588 1:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3601 test clock-29.372 {time parsing} { clock scan {2440588 1:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3601 test clock-29.373 {time parsing} { clock scan {2440588 i:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3601 test clock-29.374 {time parsing} { clock scan {2440588 i:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3601 test clock-29.375 {time parsing} { clock scan {2440588 i:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3601 test clock-29.376 {time parsing} { clock scan {2440588 i:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3601 test clock-29.377 {time parsing} { clock scan {2440588 01:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3601 test clock-29.378 {time parsing} { clock scan {2440588 01:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3601 test clock-29.379 {time parsing} { clock scan {2440588 1:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3601 test clock-29.380 {time parsing} { clock scan {2440588 1:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3601 test clock-29.381 {time parsing} { clock scan {2440588 i:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3601 test clock-29.382 {time parsing} { clock scan {2440588 i:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3601 test clock-29.383 {time parsing} { clock scan {2440588 i:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3601 test clock-29.384 {time parsing} { clock scan {2440588 i:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3601 test clock-29.385 {time parsing} { clock scan {2440588 01:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3659 test clock-29.386 {time parsing} { clock scan {2440588 01:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3659 test clock-29.387 {time parsing} { clock scan {2440588 1:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3659 test clock-29.388 {time parsing} { clock scan {2440588 1:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3659 test clock-29.389 {time parsing} { clock scan {2440588 i:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3659 test clock-29.390 {time parsing} { clock scan {2440588 i:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3659 test clock-29.391 {time parsing} { clock scan {2440588 i:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3659 test clock-29.392 {time parsing} { clock scan {2440588 i:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3659 test clock-29.393 {time parsing} { clock scan {2440588 01:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3659 test clock-29.394 {time parsing} { clock scan {2440588 01:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3659 test clock-29.395 {time parsing} { clock scan {2440588 1:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3659 test clock-29.396 {time parsing} { clock scan {2440588 1:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3659 test clock-29.397 {time parsing} { clock scan {2440588 i:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3659 test clock-29.398 {time parsing} { clock scan {2440588 i:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3659 test clock-29.399 {time parsing} { clock scan {2440588 i:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3659 test clock-29.400 {time parsing} { clock scan {2440588 i:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3659 test clock-29.401 {time parsing} { clock scan {2440588 01:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3659 test clock-29.402 {time parsing} { clock scan {2440588 01:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3659 test clock-29.403 {time parsing} { clock scan {2440588 1:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3659 test clock-29.404 {time parsing} { clock scan {2440588 1:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3659 test clock-29.405 {time parsing} { clock scan {2440588 i:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3659 test clock-29.406 {time parsing} { clock scan {2440588 i:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3659 test clock-29.407 {time parsing} { clock scan {2440588 i:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3659 test clock-29.408 {time parsing} { clock scan {2440588 i:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3659 test clock-29.409 {time parsing} { clock scan {2440588 01:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 3660 test clock-29.410 {time parsing} { clock scan {2440588 01:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 3660 test clock-29.411 {time parsing} { clock scan {2440588 01:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3660 test clock-29.412 {time parsing} { clock scan {2440588 01:i:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3660 test clock-29.413 {time parsing} { clock scan {2440588 1:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 3660 test clock-29.414 {time parsing} { clock scan {2440588 1:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 3660 test clock-29.415 {time parsing} { clock scan {2440588 1:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3660 test clock-29.416 {time parsing} { clock scan {2440588 1:i:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3660 test clock-29.417 {time parsing} { clock scan {2440588 i:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 3660 test clock-29.418 {time parsing} { clock scan {2440588 i:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 3660 test clock-29.419 {time parsing} { clock scan {2440588 i:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3660 test clock-29.420 {time parsing} { clock scan {2440588 i:i:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3660 test clock-29.421 {time parsing} { clock scan {2440588 i:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 3660 test clock-29.422 {time parsing} { clock scan {2440588 i:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 3660 test clock-29.423 {time parsing} { clock scan {2440588 i:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3660 test clock-29.424 {time parsing} { clock scan {2440588 i:i:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3660 test clock-29.425 {time parsing} { clock scan {2440588 01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 3660 test clock-29.426 {time parsing} { clock scan {2440588 01:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 3660 test clock-29.427 {time parsing} { clock scan {2440588 01:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3660 test clock-29.428 {time parsing} { clock scan {2440588 01:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3660 test clock-29.429 {time parsing} { clock scan {2440588 1:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 3660 test clock-29.430 {time parsing} { clock scan {2440588 1:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 3660 test clock-29.431 {time parsing} { clock scan {2440588 1:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3660 test clock-29.432 {time parsing} { clock scan {2440588 1:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3660 test clock-29.433 {time parsing} { clock scan {2440588 i:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 3660 test clock-29.434 {time parsing} { clock scan {2440588 i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 3660 test clock-29.435 {time parsing} { clock scan {2440588 i:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3660 test clock-29.436 {time parsing} { clock scan {2440588 i:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3660 test clock-29.437 {time parsing} { clock scan {2440588 i:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 3660 test clock-29.438 {time parsing} { clock scan {2440588 i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 3660 test clock-29.439 {time parsing} { clock scan {2440588 i:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3660 test clock-29.440 {time parsing} { clock scan {2440588 i:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3660 test clock-29.441 {time parsing} { clock scan {2440588 01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 3660 test clock-29.442 {time parsing} { clock scan {2440588 01:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 3660 test clock-29.443 {time parsing} { clock scan {2440588 01:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3660 test clock-29.444 {time parsing} { clock scan {2440588 01:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3660 test clock-29.445 {time parsing} { clock scan {2440588 1:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 3660 test clock-29.446 {time parsing} { clock scan {2440588 1:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 3660 test clock-29.447 {time parsing} { clock scan {2440588 1:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3660 test clock-29.448 {time parsing} { clock scan {2440588 1:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3660 test clock-29.449 {time parsing} { clock scan {2440588 i:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 3660 test clock-29.450 {time parsing} { clock scan {2440588 i:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 3660 test clock-29.451 {time parsing} { clock scan {2440588 i:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3660 test clock-29.452 {time parsing} { clock scan {2440588 i:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3660 test clock-29.453 {time parsing} { clock scan {2440588 i:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 3660 test clock-29.454 {time parsing} { clock scan {2440588 i:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 3660 test clock-29.455 {time parsing} { clock scan {2440588 i:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3660 test clock-29.456 {time parsing} { clock scan {2440588 i:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3660 test clock-29.457 {time parsing} { clock scan {2440588 01:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3661 test clock-29.458 {time parsing} { clock scan {2440588 01:i:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3661 test clock-29.459 {time parsing} { clock scan {2440588 1:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3661 test clock-29.460 {time parsing} { clock scan {2440588 1:i:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3661 test clock-29.461 {time parsing} { clock scan {2440588 i:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3661 test clock-29.462 {time parsing} { clock scan {2440588 i:i:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3661 test clock-29.463 {time parsing} { clock scan {2440588 i:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3661 test clock-29.464 {time parsing} { clock scan {2440588 i:i:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3661 test clock-29.465 {time parsing} { clock scan {2440588 01:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3661 test clock-29.466 {time parsing} { clock scan {2440588 01:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3661 test clock-29.467 {time parsing} { clock scan {2440588 1:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3661 test clock-29.468 {time parsing} { clock scan {2440588 1:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3661 test clock-29.469 {time parsing} { clock scan {2440588 i:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3661 test clock-29.470 {time parsing} { clock scan {2440588 i:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3661 test clock-29.471 {time parsing} { clock scan {2440588 i:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3661 test clock-29.472 {time parsing} { clock scan {2440588 i:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3661 test clock-29.473 {time parsing} { clock scan {2440588 01:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3661 test clock-29.474 {time parsing} { clock scan {2440588 01:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3661 test clock-29.475 {time parsing} { clock scan {2440588 1:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3661 test clock-29.476 {time parsing} { clock scan {2440588 1:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3661 test clock-29.477 {time parsing} { clock scan {2440588 i:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3661 test clock-29.478 {time parsing} { clock scan {2440588 i:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3661 test clock-29.479 {time parsing} { clock scan {2440588 i:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3661 test clock-29.480 {time parsing} { clock scan {2440588 i:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3661 test clock-29.481 {time parsing} { clock scan {2440588 01:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 3719 test clock-29.482 {time parsing} { clock scan {2440588 01:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 3719 test clock-29.483 {time parsing} { clock scan {2440588 1:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 3719 test clock-29.484 {time parsing} { clock scan {2440588 1:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 3719 test clock-29.485 {time parsing} { clock scan {2440588 i:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 3719 test clock-29.486 {time parsing} { clock scan {2440588 i:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 3719 test clock-29.487 {time parsing} { clock scan {2440588 i:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 3719 test clock-29.488 {time parsing} { clock scan {2440588 i:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 3719 test clock-29.489 {time parsing} { clock scan {2440588 01:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 3719 test clock-29.490 {time parsing} { clock scan {2440588 01:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 3719 test clock-29.491 {time parsing} { clock scan {2440588 1:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 3719 test clock-29.492 {time parsing} { clock scan {2440588 1:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 3719 test clock-29.493 {time parsing} { clock scan {2440588 i:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 3719 test clock-29.494 {time parsing} { clock scan {2440588 i:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 3719 test clock-29.495 {time parsing} { clock scan {2440588 i:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 3719 test clock-29.496 {time parsing} { clock scan {2440588 i:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 3719 test clock-29.497 {time parsing} { clock scan {2440588 01:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 3719 test clock-29.498 {time parsing} { clock scan {2440588 01:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 3719 test clock-29.499 {time parsing} { clock scan {2440588 1:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 3719 test clock-29.500 {time parsing} { clock scan {2440588 1:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 3719 test clock-29.501 {time parsing} { clock scan {2440588 i:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 3719 test clock-29.502 {time parsing} { clock scan {2440588 i:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 3719 test clock-29.503 {time parsing} { clock scan {2440588 i:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 3719 test clock-29.504 {time parsing} { clock scan {2440588 i:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 3719 test clock-29.505 {time parsing} { clock scan {2440588 01:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 7140 test clock-29.506 {time parsing} { clock scan {2440588 01:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 7140 test clock-29.507 {time parsing} { clock scan {2440588 01:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 7140 test clock-29.508 {time parsing} { clock scan {2440588 01:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 7140 test clock-29.509 {time parsing} { clock scan {2440588 1:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 7140 test clock-29.510 {time parsing} { clock scan {2440588 1:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 7140 test clock-29.511 {time parsing} { clock scan {2440588 1:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 7140 test clock-29.512 {time parsing} { clock scan {2440588 1:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 7140 test clock-29.513 {time parsing} { clock scan {2440588 i:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 7140 test clock-29.514 {time parsing} { clock scan {2440588 i:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 7140 test clock-29.515 {time parsing} { clock scan {2440588 i:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 7140 test clock-29.516 {time parsing} { clock scan {2440588 i:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 7140 test clock-29.517 {time parsing} { clock scan {2440588 i:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 7140 test clock-29.518 {time parsing} { clock scan {2440588 i:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 7140 test clock-29.519 {time parsing} { clock scan {2440588 i:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 7140 test clock-29.520 {time parsing} { clock scan {2440588 i:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 7140 test clock-29.521 {time parsing} { clock scan {2440588 01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 7140 test clock-29.522 {time parsing} { clock scan {2440588 01:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 7140 test clock-29.523 {time parsing} { clock scan {2440588 01:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 7140 test clock-29.524 {time parsing} { clock scan {2440588 01:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 7140 test clock-29.525 {time parsing} { clock scan {2440588 1:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 7140 test clock-29.526 {time parsing} { clock scan {2440588 1:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 7140 test clock-29.527 {time parsing} { clock scan {2440588 1:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 7140 test clock-29.528 {time parsing} { clock scan {2440588 1:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 7140 test clock-29.529 {time parsing} { clock scan {2440588 i:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 7140 test clock-29.530 {time parsing} { clock scan {2440588 i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 7140 test clock-29.531 {time parsing} { clock scan {2440588 i:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 7140 test clock-29.532 {time parsing} { clock scan {2440588 i:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 7140 test clock-29.533 {time parsing} { clock scan {2440588 i:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 7140 test clock-29.534 {time parsing} { clock scan {2440588 i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 7140 test clock-29.535 {time parsing} { clock scan {2440588 i:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 7140 test clock-29.536 {time parsing} { clock scan {2440588 i:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 7140 test clock-29.537 {time parsing} { clock scan {2440588 01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 7140 test clock-29.538 {time parsing} { clock scan {2440588 01:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 7140 test clock-29.539 {time parsing} { clock scan {2440588 01:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 7140 test clock-29.540 {time parsing} { clock scan {2440588 01:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 7140 test clock-29.541 {time parsing} { clock scan {2440588 1:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 7140 test clock-29.542 {time parsing} { clock scan {2440588 1:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 7140 test clock-29.543 {time parsing} { clock scan {2440588 1:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 7140 test clock-29.544 {time parsing} { clock scan {2440588 1:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 7140 test clock-29.545 {time parsing} { clock scan {2440588 i:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 7140 test clock-29.546 {time parsing} { clock scan {2440588 i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 7140 test clock-29.547 {time parsing} { clock scan {2440588 i:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 7140 test clock-29.548 {time parsing} { clock scan {2440588 i:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 7140 test clock-29.549 {time parsing} { clock scan {2440588 i:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 7140 test clock-29.550 {time parsing} { clock scan {2440588 i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 7140 test clock-29.551 {time parsing} { clock scan {2440588 i:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 7140 test clock-29.552 {time parsing} { clock scan {2440588 i:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 7140 test clock-29.553 {time parsing} { clock scan {2440588 01:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 7141 test clock-29.554 {time parsing} { clock scan {2440588 01:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 7141 test clock-29.555 {time parsing} { clock scan {2440588 1:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 7141 test clock-29.556 {time parsing} { clock scan {2440588 1:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 7141 test clock-29.557 {time parsing} { clock scan {2440588 i:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 7141 test clock-29.558 {time parsing} { clock scan {2440588 i:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 7141 test clock-29.559 {time parsing} { clock scan {2440588 i:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 7141 test clock-29.560 {time parsing} { clock scan {2440588 i:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 7141 test clock-29.561 {time parsing} { clock scan {2440588 01:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 7141 test clock-29.562 {time parsing} { clock scan {2440588 01:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 7141 test clock-29.563 {time parsing} { clock scan {2440588 1:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 7141 test clock-29.564 {time parsing} { clock scan {2440588 1:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 7141 test clock-29.565 {time parsing} { clock scan {2440588 i:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 7141 test clock-29.566 {time parsing} { clock scan {2440588 i:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 7141 test clock-29.567 {time parsing} { clock scan {2440588 i:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 7141 test clock-29.568 {time parsing} { clock scan {2440588 i:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 7141 test clock-29.569 {time parsing} { clock scan {2440588 01:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 7141 test clock-29.570 {time parsing} { clock scan {2440588 01:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 7141 test clock-29.571 {time parsing} { clock scan {2440588 1:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 7141 test clock-29.572 {time parsing} { clock scan {2440588 1:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 7141 test clock-29.573 {time parsing} { clock scan {2440588 i:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 7141 test clock-29.574 {time parsing} { clock scan {2440588 i:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 7141 test clock-29.575 {time parsing} { clock scan {2440588 i:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 7141 test clock-29.576 {time parsing} { clock scan {2440588 i:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 7141 test clock-29.577 {time parsing} { clock scan {2440588 01:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 7199 test clock-29.578 {time parsing} { clock scan {2440588 01:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 7199 test clock-29.579 {time parsing} { clock scan {2440588 1:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 7199 test clock-29.580 {time parsing} { clock scan {2440588 1:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 7199 test clock-29.581 {time parsing} { clock scan {2440588 i:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 7199 test clock-29.582 {time parsing} { clock scan {2440588 i:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 7199 test clock-29.583 {time parsing} { clock scan {2440588 i:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 7199 test clock-29.584 {time parsing} { clock scan {2440588 i:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 7199 test clock-29.585 {time parsing} { clock scan {2440588 01:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 7199 test clock-29.586 {time parsing} { clock scan {2440588 01:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 7199 test clock-29.587 {time parsing} { clock scan {2440588 1:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 7199 test clock-29.588 {time parsing} { clock scan {2440588 1:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 7199 test clock-29.589 {time parsing} { clock scan {2440588 i:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 7199 test clock-29.590 {time parsing} { clock scan {2440588 i:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 7199 test clock-29.591 {time parsing} { clock scan {2440588 i:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 7199 test clock-29.592 {time parsing} { clock scan {2440588 i:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 7199 test clock-29.593 {time parsing} { clock scan {2440588 01:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 7199 test clock-29.594 {time parsing} { clock scan {2440588 01:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 7199 test clock-29.595 {time parsing} { clock scan {2440588 1:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 7199 test clock-29.596 {time parsing} { clock scan {2440588 1:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 7199 test clock-29.597 {time parsing} { clock scan {2440588 i:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 7199 test clock-29.598 {time parsing} { clock scan {2440588 i:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 7199 test clock-29.599 {time parsing} { clock scan {2440588 i:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 7199 test clock-29.600 {time parsing} { clock scan {2440588 i:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 7199 test clock-29.601 {time parsing} { clock scan {2440588 11 } \ -gmt true -locale en_US_roman \ -format {%J %H } } 39600 test clock-29.602 {time parsing} { clock scan {2440588 11:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 39600 test clock-29.603 {time parsing} { clock scan {2440588 11:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 39600 test clock-29.604 {time parsing} { clock scan {2440588 11:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 39600 test clock-29.605 {time parsing} { clock scan {2440588 11:?:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 39600 test clock-29.606 {time parsing} { clock scan {2440588 11 } \ -gmt true -locale en_US_roman \ -format {%J %k } } 39600 test clock-29.607 {time parsing} { clock scan {2440588 11:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 39600 test clock-29.608 {time parsing} { clock scan {2440588 11:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 39600 test clock-29.609 {time parsing} { clock scan {2440588 11:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 39600 test clock-29.610 {time parsing} { clock scan {2440588 11:?:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 39600 test clock-29.611 {time parsing} { clock scan {2440588 xi } \ -gmt true -locale en_US_roman \ -format {%J %OH } } 39600 test clock-29.612 {time parsing} { clock scan {2440588 xi:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 39600 test clock-29.613 {time parsing} { clock scan {2440588 xi:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 39600 test clock-29.614 {time parsing} { clock scan {2440588 xi:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 39600 test clock-29.615 {time parsing} { clock scan {2440588 xi:?:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 39600 test clock-29.616 {time parsing} { clock scan {2440588 xi } \ -gmt true -locale en_US_roman \ -format {%J %Ok } } 39600 test clock-29.617 {time parsing} { clock scan {2440588 xi:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 39600 test clock-29.618 {time parsing} { clock scan {2440588 xi:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 39600 test clock-29.619 {time parsing} { clock scan {2440588 xi:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 39600 test clock-29.620 {time parsing} { clock scan {2440588 xi:?:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 39600 test clock-29.621 {time parsing} { clock scan {2440588 11 AM} \ -gmt true -locale en_US_roman \ -format {%J %I %p} } 39600 test clock-29.622 {time parsing} { clock scan {2440588 11:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 39600 test clock-29.623 {time parsing} { clock scan {2440588 11:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 39600 test clock-29.624 {time parsing} { clock scan {2440588 11:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 39600 test clock-29.625 {time parsing} { clock scan {2440588 11:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 39600 test clock-29.626 {time parsing} { clock scan {2440588 11 AM} \ -gmt true -locale en_US_roman \ -format {%J %l %p} } 39600 test clock-29.627 {time parsing} { clock scan {2440588 11:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 39600 test clock-29.628 {time parsing} { clock scan {2440588 11:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 39600 test clock-29.629 {time parsing} { clock scan {2440588 11:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 39600 test clock-29.630 {time parsing} { clock scan {2440588 11:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 39600 test clock-29.631 {time parsing} { clock scan {2440588 xi AM} \ -gmt true -locale en_US_roman \ -format {%J %OI %p} } 39600 test clock-29.632 {time parsing} { clock scan {2440588 xi:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 39600 test clock-29.633 {time parsing} { clock scan {2440588 xi:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 39600 test clock-29.634 {time parsing} { clock scan {2440588 xi:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 39600 test clock-29.635 {time parsing} { clock scan {2440588 xi:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 39600 test clock-29.636 {time parsing} { clock scan {2440588 xi AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol %p} } 39600 test clock-29.637 {time parsing} { clock scan {2440588 xi:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 39600 test clock-29.638 {time parsing} { clock scan {2440588 xi:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 39600 test clock-29.639 {time parsing} { clock scan {2440588 xi:00:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 39600 test clock-29.640 {time parsing} { clock scan {2440588 xi:?:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 39600 test clock-29.641 {time parsing} { clock scan {2440588 11 am} \ -gmt true -locale en_US_roman \ -format {%J %I %P} } 39600 test clock-29.642 {time parsing} { clock scan {2440588 11:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 39600 test clock-29.643 {time parsing} { clock scan {2440588 11:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 39600 test clock-29.644 {time parsing} { clock scan {2440588 11:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 39600 test clock-29.645 {time parsing} { clock scan {2440588 11:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 39600 test clock-29.646 {time parsing} { clock scan {2440588 11 am} \ -gmt true -locale en_US_roman \ -format {%J %l %P} } 39600 test clock-29.647 {time parsing} { clock scan {2440588 11:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 39600 test clock-29.648 {time parsing} { clock scan {2440588 11:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 39600 test clock-29.649 {time parsing} { clock scan {2440588 11:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 39600 test clock-29.650 {time parsing} { clock scan {2440588 11:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 39600 test clock-29.651 {time parsing} { clock scan {2440588 xi am} \ -gmt true -locale en_US_roman \ -format {%J %OI %P} } 39600 test clock-29.652 {time parsing} { clock scan {2440588 xi:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 39600 test clock-29.653 {time parsing} { clock scan {2440588 xi:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 39600 test clock-29.654 {time parsing} { clock scan {2440588 xi:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 39600 test clock-29.655 {time parsing} { clock scan {2440588 xi:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 39600 test clock-29.656 {time parsing} { clock scan {2440588 xi am} \ -gmt true -locale en_US_roman \ -format {%J %Ol %P} } 39600 test clock-29.657 {time parsing} { clock scan {2440588 xi:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 39600 test clock-29.658 {time parsing} { clock scan {2440588 xi:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 39600 test clock-29.659 {time parsing} { clock scan {2440588 xi:00:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 39600 test clock-29.660 {time parsing} { clock scan {2440588 xi:?:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 39600 test clock-29.661 {time parsing} { clock scan {2440588 11:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 39601 test clock-29.662 {time parsing} { clock scan {2440588 11:?:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 39601 test clock-29.663 {time parsing} { clock scan {2440588 11:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 39601 test clock-29.664 {time parsing} { clock scan {2440588 11:?:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 39601 test clock-29.665 {time parsing} { clock scan {2440588 xi:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 39601 test clock-29.666 {time parsing} { clock scan {2440588 xi:?:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 39601 test clock-29.667 {time parsing} { clock scan {2440588 xi:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 39601 test clock-29.668 {time parsing} { clock scan {2440588 xi:?:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 39601 test clock-29.669 {time parsing} { clock scan {2440588 11:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 39601 test clock-29.670 {time parsing} { clock scan {2440588 11:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 39601 test clock-29.671 {time parsing} { clock scan {2440588 11:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 39601 test clock-29.672 {time parsing} { clock scan {2440588 11:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 39601 test clock-29.673 {time parsing} { clock scan {2440588 xi:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 39601 test clock-29.674 {time parsing} { clock scan {2440588 xi:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 39601 test clock-29.675 {time parsing} { clock scan {2440588 xi:00:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 39601 test clock-29.676 {time parsing} { clock scan {2440588 xi:?:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 39601 test clock-29.677 {time parsing} { clock scan {2440588 11:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 39601 test clock-29.678 {time parsing} { clock scan {2440588 11:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 39601 test clock-29.679 {time parsing} { clock scan {2440588 11:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 39601 test clock-29.680 {time parsing} { clock scan {2440588 11:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 39601 test clock-29.681 {time parsing} { clock scan {2440588 xi:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 39601 test clock-29.682 {time parsing} { clock scan {2440588 xi:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 39601 test clock-29.683 {time parsing} { clock scan {2440588 xi:00:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 39601 test clock-29.684 {time parsing} { clock scan {2440588 xi:?:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 39601 test clock-29.685 {time parsing} { clock scan {2440588 11:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 39659 test clock-29.686 {time parsing} { clock scan {2440588 11:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 39659 test clock-29.687 {time parsing} { clock scan {2440588 11:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 39659 test clock-29.688 {time parsing} { clock scan {2440588 11:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 39659 test clock-29.689 {time parsing} { clock scan {2440588 xi:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 39659 test clock-29.690 {time parsing} { clock scan {2440588 xi:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 39659 test clock-29.691 {time parsing} { clock scan {2440588 xi:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 39659 test clock-29.692 {time parsing} { clock scan {2440588 xi:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 39659 test clock-29.693 {time parsing} { clock scan {2440588 11:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 39659 test clock-29.694 {time parsing} { clock scan {2440588 11:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 39659 test clock-29.695 {time parsing} { clock scan {2440588 11:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 39659 test clock-29.696 {time parsing} { clock scan {2440588 11:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 39659 test clock-29.697 {time parsing} { clock scan {2440588 xi:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 39659 test clock-29.698 {time parsing} { clock scan {2440588 xi:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 39659 test clock-29.699 {time parsing} { clock scan {2440588 xi:00:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 39659 test clock-29.700 {time parsing} { clock scan {2440588 xi:?:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 39659 test clock-29.701 {time parsing} { clock scan {2440588 11:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 39659 test clock-29.702 {time parsing} { clock scan {2440588 11:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 39659 test clock-29.703 {time parsing} { clock scan {2440588 11:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 39659 test clock-29.704 {time parsing} { clock scan {2440588 11:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 39659 test clock-29.705 {time parsing} { clock scan {2440588 xi:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 39659 test clock-29.706 {time parsing} { clock scan {2440588 xi:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 39659 test clock-29.707 {time parsing} { clock scan {2440588 xi:00:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 39659 test clock-29.708 {time parsing} { clock scan {2440588 xi:?:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 39659 test clock-29.709 {time parsing} { clock scan {2440588 11:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 39660 test clock-29.710 {time parsing} { clock scan {2440588 11:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 39660 test clock-29.711 {time parsing} { clock scan {2440588 11:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 39660 test clock-29.712 {time parsing} { clock scan {2440588 11:i:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 39660 test clock-29.713 {time parsing} { clock scan {2440588 11:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 39660 test clock-29.714 {time parsing} { clock scan {2440588 11:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 39660 test clock-29.715 {time parsing} { clock scan {2440588 11:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 39660 test clock-29.716 {time parsing} { clock scan {2440588 11:i:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 39660 test clock-29.717 {time parsing} { clock scan {2440588 xi:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 39660 test clock-29.718 {time parsing} { clock scan {2440588 xi:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 39660 test clock-29.719 {time parsing} { clock scan {2440588 xi:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 39660 test clock-29.720 {time parsing} { clock scan {2440588 xi:i:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 39660 test clock-29.721 {time parsing} { clock scan {2440588 xi:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 39660 test clock-29.722 {time parsing} { clock scan {2440588 xi:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 39660 test clock-29.723 {time parsing} { clock scan {2440588 xi:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 39660 test clock-29.724 {time parsing} { clock scan {2440588 xi:i:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 39660 test clock-29.725 {time parsing} { clock scan {2440588 11:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 39660 test clock-29.726 {time parsing} { clock scan {2440588 11:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 39660 test clock-29.727 {time parsing} { clock scan {2440588 11:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 39660 test clock-29.728 {time parsing} { clock scan {2440588 11:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 39660 test clock-29.729 {time parsing} { clock scan {2440588 11:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 39660 test clock-29.730 {time parsing} { clock scan {2440588 11:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 39660 test clock-29.731 {time parsing} { clock scan {2440588 11:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 39660 test clock-29.732 {time parsing} { clock scan {2440588 11:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 39660 test clock-29.733 {time parsing} { clock scan {2440588 xi:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 39660 test clock-29.734 {time parsing} { clock scan {2440588 xi:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 39660 test clock-29.735 {time parsing} { clock scan {2440588 xi:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 39660 test clock-29.736 {time parsing} { clock scan {2440588 xi:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 39660 test clock-29.737 {time parsing} { clock scan {2440588 xi:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 39660 test clock-29.738 {time parsing} { clock scan {2440588 xi:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 39660 test clock-29.739 {time parsing} { clock scan {2440588 xi:01:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 39660 test clock-29.740 {time parsing} { clock scan {2440588 xi:i:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 39660 test clock-29.741 {time parsing} { clock scan {2440588 11:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 39660 test clock-29.742 {time parsing} { clock scan {2440588 11:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 39660 test clock-29.743 {time parsing} { clock scan {2440588 11:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 39660 test clock-29.744 {time parsing} { clock scan {2440588 11:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 39660 test clock-29.745 {time parsing} { clock scan {2440588 11:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 39660 test clock-29.746 {time parsing} { clock scan {2440588 11:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 39660 test clock-29.747 {time parsing} { clock scan {2440588 11:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 39660 test clock-29.748 {time parsing} { clock scan {2440588 11:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 39660 test clock-29.749 {time parsing} { clock scan {2440588 xi:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 39660 test clock-29.750 {time parsing} { clock scan {2440588 xi:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 39660 test clock-29.751 {time parsing} { clock scan {2440588 xi:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 39660 test clock-29.752 {time parsing} { clock scan {2440588 xi:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 39660 test clock-29.753 {time parsing} { clock scan {2440588 xi:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 39660 test clock-29.754 {time parsing} { clock scan {2440588 xi:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 39660 test clock-29.755 {time parsing} { clock scan {2440588 xi:01:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 39660 test clock-29.756 {time parsing} { clock scan {2440588 xi:i:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 39660 test clock-29.757 {time parsing} { clock scan {2440588 11:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 39661 test clock-29.758 {time parsing} { clock scan {2440588 11:i:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 39661 test clock-29.759 {time parsing} { clock scan {2440588 11:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 39661 test clock-29.760 {time parsing} { clock scan {2440588 11:i:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 39661 test clock-29.761 {time parsing} { clock scan {2440588 xi:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 39661 test clock-29.762 {time parsing} { clock scan {2440588 xi:i:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 39661 test clock-29.763 {time parsing} { clock scan {2440588 xi:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 39661 test clock-29.764 {time parsing} { clock scan {2440588 xi:i:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 39661 test clock-29.765 {time parsing} { clock scan {2440588 11:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 39661 test clock-29.766 {time parsing} { clock scan {2440588 11:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 39661 test clock-29.767 {time parsing} { clock scan {2440588 11:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 39661 test clock-29.768 {time parsing} { clock scan {2440588 11:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 39661 test clock-29.769 {time parsing} { clock scan {2440588 xi:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 39661 test clock-29.770 {time parsing} { clock scan {2440588 xi:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 39661 test clock-29.771 {time parsing} { clock scan {2440588 xi:01:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 39661 test clock-29.772 {time parsing} { clock scan {2440588 xi:i:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 39661 test clock-29.773 {time parsing} { clock scan {2440588 11:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 39661 test clock-29.774 {time parsing} { clock scan {2440588 11:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 39661 test clock-29.775 {time parsing} { clock scan {2440588 11:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 39661 test clock-29.776 {time parsing} { clock scan {2440588 11:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 39661 test clock-29.777 {time parsing} { clock scan {2440588 xi:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 39661 test clock-29.778 {time parsing} { clock scan {2440588 xi:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 39661 test clock-29.779 {time parsing} { clock scan {2440588 xi:01:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 39661 test clock-29.780 {time parsing} { clock scan {2440588 xi:i:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 39661 test clock-29.781 {time parsing} { clock scan {2440588 11:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 39719 test clock-29.782 {time parsing} { clock scan {2440588 11:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 39719 test clock-29.783 {time parsing} { clock scan {2440588 11:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 39719 test clock-29.784 {time parsing} { clock scan {2440588 11:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 39719 test clock-29.785 {time parsing} { clock scan {2440588 xi:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 39719 test clock-29.786 {time parsing} { clock scan {2440588 xi:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 39719 test clock-29.787 {time parsing} { clock scan {2440588 xi:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 39719 test clock-29.788 {time parsing} { clock scan {2440588 xi:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 39719 test clock-29.789 {time parsing} { clock scan {2440588 11:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 39719 test clock-29.790 {time parsing} { clock scan {2440588 11:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 39719 test clock-29.791 {time parsing} { clock scan {2440588 11:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 39719 test clock-29.792 {time parsing} { clock scan {2440588 11:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 39719 test clock-29.793 {time parsing} { clock scan {2440588 xi:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 39719 test clock-29.794 {time parsing} { clock scan {2440588 xi:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 39719 test clock-29.795 {time parsing} { clock scan {2440588 xi:01:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 39719 test clock-29.796 {time parsing} { clock scan {2440588 xi:i:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 39719 test clock-29.797 {time parsing} { clock scan {2440588 11:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 39719 test clock-29.798 {time parsing} { clock scan {2440588 11:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 39719 test clock-29.799 {time parsing} { clock scan {2440588 11:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 39719 test clock-29.800 {time parsing} { clock scan {2440588 11:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 39719 test clock-29.801 {time parsing} { clock scan {2440588 xi:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 39719 test clock-29.802 {time parsing} { clock scan {2440588 xi:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 39719 test clock-29.803 {time parsing} { clock scan {2440588 xi:01:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 39719 test clock-29.804 {time parsing} { clock scan {2440588 xi:i:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 39719 test clock-29.805 {time parsing} { clock scan {2440588 11:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 43140 test clock-29.806 {time parsing} { clock scan {2440588 11:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 43140 test clock-29.807 {time parsing} { clock scan {2440588 11:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43140 test clock-29.808 {time parsing} { clock scan {2440588 11:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43140 test clock-29.809 {time parsing} { clock scan {2440588 11:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 43140 test clock-29.810 {time parsing} { clock scan {2440588 11:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 43140 test clock-29.811 {time parsing} { clock scan {2440588 11:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43140 test clock-29.812 {time parsing} { clock scan {2440588 11:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43140 test clock-29.813 {time parsing} { clock scan {2440588 xi:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 43140 test clock-29.814 {time parsing} { clock scan {2440588 xi:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 43140 test clock-29.815 {time parsing} { clock scan {2440588 xi:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43140 test clock-29.816 {time parsing} { clock scan {2440588 xi:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43140 test clock-29.817 {time parsing} { clock scan {2440588 xi:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 43140 test clock-29.818 {time parsing} { clock scan {2440588 xi:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 43140 test clock-29.819 {time parsing} { clock scan {2440588 xi:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43140 test clock-29.820 {time parsing} { clock scan {2440588 xi:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43140 test clock-29.821 {time parsing} { clock scan {2440588 11:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 43140 test clock-29.822 {time parsing} { clock scan {2440588 11:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 43140 test clock-29.823 {time parsing} { clock scan {2440588 11:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43140 test clock-29.824 {time parsing} { clock scan {2440588 11:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43140 test clock-29.825 {time parsing} { clock scan {2440588 11:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 43140 test clock-29.826 {time parsing} { clock scan {2440588 11:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 43140 test clock-29.827 {time parsing} { clock scan {2440588 11:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43140 test clock-29.828 {time parsing} { clock scan {2440588 11:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43140 test clock-29.829 {time parsing} { clock scan {2440588 xi:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 43140 test clock-29.830 {time parsing} { clock scan {2440588 xi:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 43140 test clock-29.831 {time parsing} { clock scan {2440588 xi:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43140 test clock-29.832 {time parsing} { clock scan {2440588 xi:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43140 test clock-29.833 {time parsing} { clock scan {2440588 xi:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 43140 test clock-29.834 {time parsing} { clock scan {2440588 xi:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 43140 test clock-29.835 {time parsing} { clock scan {2440588 xi:59:00 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43140 test clock-29.836 {time parsing} { clock scan {2440588 xi:lix:? AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43140 test clock-29.837 {time parsing} { clock scan {2440588 11:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 43140 test clock-29.838 {time parsing} { clock scan {2440588 11:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 43140 test clock-29.839 {time parsing} { clock scan {2440588 11:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43140 test clock-29.840 {time parsing} { clock scan {2440588 11:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43140 test clock-29.841 {time parsing} { clock scan {2440588 11:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 43140 test clock-29.842 {time parsing} { clock scan {2440588 11:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 43140 test clock-29.843 {time parsing} { clock scan {2440588 11:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43140 test clock-29.844 {time parsing} { clock scan {2440588 11:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43140 test clock-29.845 {time parsing} { clock scan {2440588 xi:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 43140 test clock-29.846 {time parsing} { clock scan {2440588 xi:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 43140 test clock-29.847 {time parsing} { clock scan {2440588 xi:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43140 test clock-29.848 {time parsing} { clock scan {2440588 xi:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43140 test clock-29.849 {time parsing} { clock scan {2440588 xi:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 43140 test clock-29.850 {time parsing} { clock scan {2440588 xi:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 43140 test clock-29.851 {time parsing} { clock scan {2440588 xi:59:00 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43140 test clock-29.852 {time parsing} { clock scan {2440588 xi:lix:? am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43140 test clock-29.853 {time parsing} { clock scan {2440588 11:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43141 test clock-29.854 {time parsing} { clock scan {2440588 11:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43141 test clock-29.855 {time parsing} { clock scan {2440588 11:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43141 test clock-29.856 {time parsing} { clock scan {2440588 11:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43141 test clock-29.857 {time parsing} { clock scan {2440588 xi:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43141 test clock-29.858 {time parsing} { clock scan {2440588 xi:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43141 test clock-29.859 {time parsing} { clock scan {2440588 xi:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43141 test clock-29.860 {time parsing} { clock scan {2440588 xi:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43141 test clock-29.861 {time parsing} { clock scan {2440588 11:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43141 test clock-29.862 {time parsing} { clock scan {2440588 11:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43141 test clock-29.863 {time parsing} { clock scan {2440588 11:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43141 test clock-29.864 {time parsing} { clock scan {2440588 11:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43141 test clock-29.865 {time parsing} { clock scan {2440588 xi:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43141 test clock-29.866 {time parsing} { clock scan {2440588 xi:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43141 test clock-29.867 {time parsing} { clock scan {2440588 xi:59:01 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43141 test clock-29.868 {time parsing} { clock scan {2440588 xi:lix:i AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43141 test clock-29.869 {time parsing} { clock scan {2440588 11:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43141 test clock-29.870 {time parsing} { clock scan {2440588 11:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43141 test clock-29.871 {time parsing} { clock scan {2440588 11:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43141 test clock-29.872 {time parsing} { clock scan {2440588 11:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43141 test clock-29.873 {time parsing} { clock scan {2440588 xi:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43141 test clock-29.874 {time parsing} { clock scan {2440588 xi:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43141 test clock-29.875 {time parsing} { clock scan {2440588 xi:59:01 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43141 test clock-29.876 {time parsing} { clock scan {2440588 xi:lix:i am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43141 test clock-29.877 {time parsing} { clock scan {2440588 11:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43199 test clock-29.878 {time parsing} { clock scan {2440588 11:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43199 test clock-29.879 {time parsing} { clock scan {2440588 11:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43199 test clock-29.880 {time parsing} { clock scan {2440588 11:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43199 test clock-29.881 {time parsing} { clock scan {2440588 xi:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43199 test clock-29.882 {time parsing} { clock scan {2440588 xi:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43199 test clock-29.883 {time parsing} { clock scan {2440588 xi:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43199 test clock-29.884 {time parsing} { clock scan {2440588 xi:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43199 test clock-29.885 {time parsing} { clock scan {2440588 11:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43199 test clock-29.886 {time parsing} { clock scan {2440588 11:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43199 test clock-29.887 {time parsing} { clock scan {2440588 11:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43199 test clock-29.888 {time parsing} { clock scan {2440588 11:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43199 test clock-29.889 {time parsing} { clock scan {2440588 xi:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43199 test clock-29.890 {time parsing} { clock scan {2440588 xi:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43199 test clock-29.891 {time parsing} { clock scan {2440588 xi:59:59 AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43199 test clock-29.892 {time parsing} { clock scan {2440588 xi:lix:lix AM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43199 test clock-29.893 {time parsing} { clock scan {2440588 11:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43199 test clock-29.894 {time parsing} { clock scan {2440588 11:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43199 test clock-29.895 {time parsing} { clock scan {2440588 11:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43199 test clock-29.896 {time parsing} { clock scan {2440588 11:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43199 test clock-29.897 {time parsing} { clock scan {2440588 xi:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43199 test clock-29.898 {time parsing} { clock scan {2440588 xi:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43199 test clock-29.899 {time parsing} { clock scan {2440588 xi:59:59 am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43199 test clock-29.900 {time parsing} { clock scan {2440588 xi:lix:lix am} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43199 test clock-29.901 {time parsing} { clock scan {2440588 12 } \ -gmt true -locale en_US_roman \ -format {%J %H } } 43200 test clock-29.902 {time parsing} { clock scan {2440588 12:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 43200 test clock-29.903 {time parsing} { clock scan {2440588 12:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 43200 test clock-29.904 {time parsing} { clock scan {2440588 12:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43200 test clock-29.905 {time parsing} { clock scan {2440588 12:?:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43200 test clock-29.906 {time parsing} { clock scan {2440588 12 } \ -gmt true -locale en_US_roman \ -format {%J %k } } 43200 test clock-29.907 {time parsing} { clock scan {2440588 12:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 43200 test clock-29.908 {time parsing} { clock scan {2440588 12:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 43200 test clock-29.909 {time parsing} { clock scan {2440588 12:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43200 test clock-29.910 {time parsing} { clock scan {2440588 12:?:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43200 test clock-29.911 {time parsing} { clock scan {2440588 xii } \ -gmt true -locale en_US_roman \ -format {%J %OH } } 43200 test clock-29.912 {time parsing} { clock scan {2440588 xii:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 43200 test clock-29.913 {time parsing} { clock scan {2440588 xii:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 43200 test clock-29.914 {time parsing} { clock scan {2440588 xii:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43200 test clock-29.915 {time parsing} { clock scan {2440588 xii:?:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43200 test clock-29.916 {time parsing} { clock scan {2440588 xii } \ -gmt true -locale en_US_roman \ -format {%J %Ok } } 43200 test clock-29.917 {time parsing} { clock scan {2440588 xii:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 43200 test clock-29.918 {time parsing} { clock scan {2440588 xii:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 43200 test clock-29.919 {time parsing} { clock scan {2440588 xii:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43200 test clock-29.920 {time parsing} { clock scan {2440588 xii:?:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43200 test clock-29.921 {time parsing} { clock scan {2440588 12 PM} \ -gmt true -locale en_US_roman \ -format {%J %I %p} } 43200 test clock-29.922 {time parsing} { clock scan {2440588 12:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 43200 test clock-29.923 {time parsing} { clock scan {2440588 12:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 43200 test clock-29.924 {time parsing} { clock scan {2440588 12:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43200 test clock-29.925 {time parsing} { clock scan {2440588 12:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43200 test clock-29.926 {time parsing} { clock scan {2440588 12 PM} \ -gmt true -locale en_US_roman \ -format {%J %l %p} } 43200 test clock-29.927 {time parsing} { clock scan {2440588 12:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 43200 test clock-29.928 {time parsing} { clock scan {2440588 12:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 43200 test clock-29.929 {time parsing} { clock scan {2440588 12:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43200 test clock-29.930 {time parsing} { clock scan {2440588 12:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43200 test clock-29.931 {time parsing} { clock scan {2440588 xii PM} \ -gmt true -locale en_US_roman \ -format {%J %OI %p} } 43200 test clock-29.932 {time parsing} { clock scan {2440588 xii:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 43200 test clock-29.933 {time parsing} { clock scan {2440588 xii:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 43200 test clock-29.934 {time parsing} { clock scan {2440588 xii:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43200 test clock-29.935 {time parsing} { clock scan {2440588 xii:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43200 test clock-29.936 {time parsing} { clock scan {2440588 xii PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol %p} } 43200 test clock-29.937 {time parsing} { clock scan {2440588 xii:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 43200 test clock-29.938 {time parsing} { clock scan {2440588 xii:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 43200 test clock-29.939 {time parsing} { clock scan {2440588 xii:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43200 test clock-29.940 {time parsing} { clock scan {2440588 xii:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43200 test clock-29.941 {time parsing} { clock scan {2440588 12 pm} \ -gmt true -locale en_US_roman \ -format {%J %I %P} } 43200 test clock-29.942 {time parsing} { clock scan {2440588 12:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 43200 test clock-29.943 {time parsing} { clock scan {2440588 12:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 43200 test clock-29.944 {time parsing} { clock scan {2440588 12:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43200 test clock-29.945 {time parsing} { clock scan {2440588 12:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43200 test clock-29.946 {time parsing} { clock scan {2440588 12 pm} \ -gmt true -locale en_US_roman \ -format {%J %l %P} } 43200 test clock-29.947 {time parsing} { clock scan {2440588 12:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 43200 test clock-29.948 {time parsing} { clock scan {2440588 12:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 43200 test clock-29.949 {time parsing} { clock scan {2440588 12:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43200 test clock-29.950 {time parsing} { clock scan {2440588 12:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43200 test clock-29.951 {time parsing} { clock scan {2440588 xii pm} \ -gmt true -locale en_US_roman \ -format {%J %OI %P} } 43200 test clock-29.952 {time parsing} { clock scan {2440588 xii:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 43200 test clock-29.953 {time parsing} { clock scan {2440588 xii:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 43200 test clock-29.954 {time parsing} { clock scan {2440588 xii:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43200 test clock-29.955 {time parsing} { clock scan {2440588 xii:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43200 test clock-29.956 {time parsing} { clock scan {2440588 xii pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol %P} } 43200 test clock-29.957 {time parsing} { clock scan {2440588 xii:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 43200 test clock-29.958 {time parsing} { clock scan {2440588 xii:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 43200 test clock-29.959 {time parsing} { clock scan {2440588 xii:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43200 test clock-29.960 {time parsing} { clock scan {2440588 xii:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43200 test clock-29.961 {time parsing} { clock scan {2440588 12:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43201 test clock-29.962 {time parsing} { clock scan {2440588 12:?:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43201 test clock-29.963 {time parsing} { clock scan {2440588 12:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43201 test clock-29.964 {time parsing} { clock scan {2440588 12:?:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43201 test clock-29.965 {time parsing} { clock scan {2440588 xii:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43201 test clock-29.966 {time parsing} { clock scan {2440588 xii:?:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43201 test clock-29.967 {time parsing} { clock scan {2440588 xii:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43201 test clock-29.968 {time parsing} { clock scan {2440588 xii:?:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43201 test clock-29.969 {time parsing} { clock scan {2440588 12:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43201 test clock-29.970 {time parsing} { clock scan {2440588 12:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43201 test clock-29.971 {time parsing} { clock scan {2440588 12:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43201 test clock-29.972 {time parsing} { clock scan {2440588 12:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43201 test clock-29.973 {time parsing} { clock scan {2440588 xii:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43201 test clock-29.974 {time parsing} { clock scan {2440588 xii:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43201 test clock-29.975 {time parsing} { clock scan {2440588 xii:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43201 test clock-29.976 {time parsing} { clock scan {2440588 xii:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43201 test clock-29.977 {time parsing} { clock scan {2440588 12:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43201 test clock-29.978 {time parsing} { clock scan {2440588 12:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43201 test clock-29.979 {time parsing} { clock scan {2440588 12:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43201 test clock-29.980 {time parsing} { clock scan {2440588 12:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43201 test clock-29.981 {time parsing} { clock scan {2440588 xii:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43201 test clock-29.982 {time parsing} { clock scan {2440588 xii:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43201 test clock-29.983 {time parsing} { clock scan {2440588 xii:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43201 test clock-29.984 {time parsing} { clock scan {2440588 xii:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43201 test clock-29.985 {time parsing} { clock scan {2440588 12:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43259 test clock-29.986 {time parsing} { clock scan {2440588 12:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43259 test clock-29.987 {time parsing} { clock scan {2440588 12:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43259 test clock-29.988 {time parsing} { clock scan {2440588 12:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43259 test clock-29.989 {time parsing} { clock scan {2440588 xii:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43259 test clock-29.990 {time parsing} { clock scan {2440588 xii:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43259 test clock-29.991 {time parsing} { clock scan {2440588 xii:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43259 test clock-29.992 {time parsing} { clock scan {2440588 xii:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43259 test clock-29.993 {time parsing} { clock scan {2440588 12:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43259 test clock-29.994 {time parsing} { clock scan {2440588 12:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43259 test clock-29.995 {time parsing} { clock scan {2440588 12:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43259 test clock-29.996 {time parsing} { clock scan {2440588 12:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43259 test clock-29.997 {time parsing} { clock scan {2440588 xii:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43259 test clock-29.998 {time parsing} { clock scan {2440588 xii:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43259 test clock-29.999 {time parsing} { clock scan {2440588 xii:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43259 test clock-29.1000 {time parsing} { clock scan {2440588 xii:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43259 test clock-29.1001 {time parsing} { clock scan {2440588 12:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43259 test clock-29.1002 {time parsing} { clock scan {2440588 12:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43259 test clock-29.1003 {time parsing} { clock scan {2440588 12:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43259 test clock-29.1004 {time parsing} { clock scan {2440588 12:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43259 test clock-29.1005 {time parsing} { clock scan {2440588 xii:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43259 test clock-29.1006 {time parsing} { clock scan {2440588 xii:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43259 test clock-29.1007 {time parsing} { clock scan {2440588 xii:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43259 test clock-29.1008 {time parsing} { clock scan {2440588 xii:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43259 test clock-29.1009 {time parsing} { clock scan {2440588 12:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 43260 test clock-29.1010 {time parsing} { clock scan {2440588 12:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 43260 test clock-29.1011 {time parsing} { clock scan {2440588 12:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43260 test clock-29.1012 {time parsing} { clock scan {2440588 12:i:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43260 test clock-29.1013 {time parsing} { clock scan {2440588 12:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 43260 test clock-29.1014 {time parsing} { clock scan {2440588 12:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 43260 test clock-29.1015 {time parsing} { clock scan {2440588 12:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43260 test clock-29.1016 {time parsing} { clock scan {2440588 12:i:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43260 test clock-29.1017 {time parsing} { clock scan {2440588 xii:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 43260 test clock-29.1018 {time parsing} { clock scan {2440588 xii:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 43260 test clock-29.1019 {time parsing} { clock scan {2440588 xii:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43260 test clock-29.1020 {time parsing} { clock scan {2440588 xii:i:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43260 test clock-29.1021 {time parsing} { clock scan {2440588 xii:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 43260 test clock-29.1022 {time parsing} { clock scan {2440588 xii:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 43260 test clock-29.1023 {time parsing} { clock scan {2440588 xii:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43260 test clock-29.1024 {time parsing} { clock scan {2440588 xii:i:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43260 test clock-29.1025 {time parsing} { clock scan {2440588 12:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 43260 test clock-29.1026 {time parsing} { clock scan {2440588 12:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 43260 test clock-29.1027 {time parsing} { clock scan {2440588 12:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43260 test clock-29.1028 {time parsing} { clock scan {2440588 12:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43260 test clock-29.1029 {time parsing} { clock scan {2440588 12:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 43260 test clock-29.1030 {time parsing} { clock scan {2440588 12:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 43260 test clock-29.1031 {time parsing} { clock scan {2440588 12:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43260 test clock-29.1032 {time parsing} { clock scan {2440588 12:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43260 test clock-29.1033 {time parsing} { clock scan {2440588 xii:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 43260 test clock-29.1034 {time parsing} { clock scan {2440588 xii:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 43260 test clock-29.1035 {time parsing} { clock scan {2440588 xii:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43260 test clock-29.1036 {time parsing} { clock scan {2440588 xii:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43260 test clock-29.1037 {time parsing} { clock scan {2440588 xii:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 43260 test clock-29.1038 {time parsing} { clock scan {2440588 xii:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 43260 test clock-29.1039 {time parsing} { clock scan {2440588 xii:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43260 test clock-29.1040 {time parsing} { clock scan {2440588 xii:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43260 test clock-29.1041 {time parsing} { clock scan {2440588 12:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 43260 test clock-29.1042 {time parsing} { clock scan {2440588 12:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 43260 test clock-29.1043 {time parsing} { clock scan {2440588 12:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43260 test clock-29.1044 {time parsing} { clock scan {2440588 12:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43260 test clock-29.1045 {time parsing} { clock scan {2440588 12:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 43260 test clock-29.1046 {time parsing} { clock scan {2440588 12:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 43260 test clock-29.1047 {time parsing} { clock scan {2440588 12:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43260 test clock-29.1048 {time parsing} { clock scan {2440588 12:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43260 test clock-29.1049 {time parsing} { clock scan {2440588 xii:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 43260 test clock-29.1050 {time parsing} { clock scan {2440588 xii:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 43260 test clock-29.1051 {time parsing} { clock scan {2440588 xii:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43260 test clock-29.1052 {time parsing} { clock scan {2440588 xii:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43260 test clock-29.1053 {time parsing} { clock scan {2440588 xii:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 43260 test clock-29.1054 {time parsing} { clock scan {2440588 xii:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 43260 test clock-29.1055 {time parsing} { clock scan {2440588 xii:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43260 test clock-29.1056 {time parsing} { clock scan {2440588 xii:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43260 test clock-29.1057 {time parsing} { clock scan {2440588 12:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43261 test clock-29.1058 {time parsing} { clock scan {2440588 12:i:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43261 test clock-29.1059 {time parsing} { clock scan {2440588 12:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43261 test clock-29.1060 {time parsing} { clock scan {2440588 12:i:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43261 test clock-29.1061 {time parsing} { clock scan {2440588 xii:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43261 test clock-29.1062 {time parsing} { clock scan {2440588 xii:i:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43261 test clock-29.1063 {time parsing} { clock scan {2440588 xii:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43261 test clock-29.1064 {time parsing} { clock scan {2440588 xii:i:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43261 test clock-29.1065 {time parsing} { clock scan {2440588 12:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43261 test clock-29.1066 {time parsing} { clock scan {2440588 12:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43261 test clock-29.1067 {time parsing} { clock scan {2440588 12:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43261 test clock-29.1068 {time parsing} { clock scan {2440588 12:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43261 test clock-29.1069 {time parsing} { clock scan {2440588 xii:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43261 test clock-29.1070 {time parsing} { clock scan {2440588 xii:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43261 test clock-29.1071 {time parsing} { clock scan {2440588 xii:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43261 test clock-29.1072 {time parsing} { clock scan {2440588 xii:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43261 test clock-29.1073 {time parsing} { clock scan {2440588 12:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43261 test clock-29.1074 {time parsing} { clock scan {2440588 12:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43261 test clock-29.1075 {time parsing} { clock scan {2440588 12:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43261 test clock-29.1076 {time parsing} { clock scan {2440588 12:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43261 test clock-29.1077 {time parsing} { clock scan {2440588 xii:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43261 test clock-29.1078 {time parsing} { clock scan {2440588 xii:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43261 test clock-29.1079 {time parsing} { clock scan {2440588 xii:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43261 test clock-29.1080 {time parsing} { clock scan {2440588 xii:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43261 test clock-29.1081 {time parsing} { clock scan {2440588 12:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 43319 test clock-29.1082 {time parsing} { clock scan {2440588 12:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 43319 test clock-29.1083 {time parsing} { clock scan {2440588 12:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 43319 test clock-29.1084 {time parsing} { clock scan {2440588 12:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 43319 test clock-29.1085 {time parsing} { clock scan {2440588 xii:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 43319 test clock-29.1086 {time parsing} { clock scan {2440588 xii:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 43319 test clock-29.1087 {time parsing} { clock scan {2440588 xii:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 43319 test clock-29.1088 {time parsing} { clock scan {2440588 xii:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 43319 test clock-29.1089 {time parsing} { clock scan {2440588 12:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 43319 test clock-29.1090 {time parsing} { clock scan {2440588 12:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 43319 test clock-29.1091 {time parsing} { clock scan {2440588 12:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 43319 test clock-29.1092 {time parsing} { clock scan {2440588 12:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 43319 test clock-29.1093 {time parsing} { clock scan {2440588 xii:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 43319 test clock-29.1094 {time parsing} { clock scan {2440588 xii:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 43319 test clock-29.1095 {time parsing} { clock scan {2440588 xii:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 43319 test clock-29.1096 {time parsing} { clock scan {2440588 xii:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 43319 test clock-29.1097 {time parsing} { clock scan {2440588 12:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 43319 test clock-29.1098 {time parsing} { clock scan {2440588 12:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 43319 test clock-29.1099 {time parsing} { clock scan {2440588 12:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 43319 test clock-29.1100 {time parsing} { clock scan {2440588 12:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 43319 test clock-29.1101 {time parsing} { clock scan {2440588 xii:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 43319 test clock-29.1102 {time parsing} { clock scan {2440588 xii:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 43319 test clock-29.1103 {time parsing} { clock scan {2440588 xii:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 43319 test clock-29.1104 {time parsing} { clock scan {2440588 xii:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 43319 test clock-29.1105 {time parsing} { clock scan {2440588 12:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 46740 test clock-29.1106 {time parsing} { clock scan {2440588 12:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 46740 test clock-29.1107 {time parsing} { clock scan {2440588 12:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46740 test clock-29.1108 {time parsing} { clock scan {2440588 12:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46740 test clock-29.1109 {time parsing} { clock scan {2440588 12:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 46740 test clock-29.1110 {time parsing} { clock scan {2440588 12:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 46740 test clock-29.1111 {time parsing} { clock scan {2440588 12:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46740 test clock-29.1112 {time parsing} { clock scan {2440588 12:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46740 test clock-29.1113 {time parsing} { clock scan {2440588 xii:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 46740 test clock-29.1114 {time parsing} { clock scan {2440588 xii:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 46740 test clock-29.1115 {time parsing} { clock scan {2440588 xii:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46740 test clock-29.1116 {time parsing} { clock scan {2440588 xii:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46740 test clock-29.1117 {time parsing} { clock scan {2440588 xii:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 46740 test clock-29.1118 {time parsing} { clock scan {2440588 xii:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 46740 test clock-29.1119 {time parsing} { clock scan {2440588 xii:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46740 test clock-29.1120 {time parsing} { clock scan {2440588 xii:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46740 test clock-29.1121 {time parsing} { clock scan {2440588 12:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 46740 test clock-29.1122 {time parsing} { clock scan {2440588 12:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 46740 test clock-29.1123 {time parsing} { clock scan {2440588 12:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46740 test clock-29.1124 {time parsing} { clock scan {2440588 12:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46740 test clock-29.1125 {time parsing} { clock scan {2440588 12:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 46740 test clock-29.1126 {time parsing} { clock scan {2440588 12:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 46740 test clock-29.1127 {time parsing} { clock scan {2440588 12:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46740 test clock-29.1128 {time parsing} { clock scan {2440588 12:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46740 test clock-29.1129 {time parsing} { clock scan {2440588 xii:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 46740 test clock-29.1130 {time parsing} { clock scan {2440588 xii:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 46740 test clock-29.1131 {time parsing} { clock scan {2440588 xii:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46740 test clock-29.1132 {time parsing} { clock scan {2440588 xii:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46740 test clock-29.1133 {time parsing} { clock scan {2440588 xii:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 46740 test clock-29.1134 {time parsing} { clock scan {2440588 xii:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 46740 test clock-29.1135 {time parsing} { clock scan {2440588 xii:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46740 test clock-29.1136 {time parsing} { clock scan {2440588 xii:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46740 test clock-29.1137 {time parsing} { clock scan {2440588 12:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 46740 test clock-29.1138 {time parsing} { clock scan {2440588 12:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 46740 test clock-29.1139 {time parsing} { clock scan {2440588 12:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46740 test clock-29.1140 {time parsing} { clock scan {2440588 12:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46740 test clock-29.1141 {time parsing} { clock scan {2440588 12:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 46740 test clock-29.1142 {time parsing} { clock scan {2440588 12:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 46740 test clock-29.1143 {time parsing} { clock scan {2440588 12:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46740 test clock-29.1144 {time parsing} { clock scan {2440588 12:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46740 test clock-29.1145 {time parsing} { clock scan {2440588 xii:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 46740 test clock-29.1146 {time parsing} { clock scan {2440588 xii:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 46740 test clock-29.1147 {time parsing} { clock scan {2440588 xii:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46740 test clock-29.1148 {time parsing} { clock scan {2440588 xii:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46740 test clock-29.1149 {time parsing} { clock scan {2440588 xii:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 46740 test clock-29.1150 {time parsing} { clock scan {2440588 xii:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 46740 test clock-29.1151 {time parsing} { clock scan {2440588 xii:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46740 test clock-29.1152 {time parsing} { clock scan {2440588 xii:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46740 test clock-29.1153 {time parsing} { clock scan {2440588 12:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46741 test clock-29.1154 {time parsing} { clock scan {2440588 12:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46741 test clock-29.1155 {time parsing} { clock scan {2440588 12:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46741 test clock-29.1156 {time parsing} { clock scan {2440588 12:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46741 test clock-29.1157 {time parsing} { clock scan {2440588 xii:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46741 test clock-29.1158 {time parsing} { clock scan {2440588 xii:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46741 test clock-29.1159 {time parsing} { clock scan {2440588 xii:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46741 test clock-29.1160 {time parsing} { clock scan {2440588 xii:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46741 test clock-29.1161 {time parsing} { clock scan {2440588 12:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46741 test clock-29.1162 {time parsing} { clock scan {2440588 12:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46741 test clock-29.1163 {time parsing} { clock scan {2440588 12:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46741 test clock-29.1164 {time parsing} { clock scan {2440588 12:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46741 test clock-29.1165 {time parsing} { clock scan {2440588 xii:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46741 test clock-29.1166 {time parsing} { clock scan {2440588 xii:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46741 test clock-29.1167 {time parsing} { clock scan {2440588 xii:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46741 test clock-29.1168 {time parsing} { clock scan {2440588 xii:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46741 test clock-29.1169 {time parsing} { clock scan {2440588 12:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46741 test clock-29.1170 {time parsing} { clock scan {2440588 12:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46741 test clock-29.1171 {time parsing} { clock scan {2440588 12:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46741 test clock-29.1172 {time parsing} { clock scan {2440588 12:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46741 test clock-29.1173 {time parsing} { clock scan {2440588 xii:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46741 test clock-29.1174 {time parsing} { clock scan {2440588 xii:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46741 test clock-29.1175 {time parsing} { clock scan {2440588 xii:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46741 test clock-29.1176 {time parsing} { clock scan {2440588 xii:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46741 test clock-29.1177 {time parsing} { clock scan {2440588 12:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46799 test clock-29.1178 {time parsing} { clock scan {2440588 12:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46799 test clock-29.1179 {time parsing} { clock scan {2440588 12:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46799 test clock-29.1180 {time parsing} { clock scan {2440588 12:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46799 test clock-29.1181 {time parsing} { clock scan {2440588 xii:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46799 test clock-29.1182 {time parsing} { clock scan {2440588 xii:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46799 test clock-29.1183 {time parsing} { clock scan {2440588 xii:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46799 test clock-29.1184 {time parsing} { clock scan {2440588 xii:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46799 test clock-29.1185 {time parsing} { clock scan {2440588 12:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46799 test clock-29.1186 {time parsing} { clock scan {2440588 12:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46799 test clock-29.1187 {time parsing} { clock scan {2440588 12:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46799 test clock-29.1188 {time parsing} { clock scan {2440588 12:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46799 test clock-29.1189 {time parsing} { clock scan {2440588 xii:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46799 test clock-29.1190 {time parsing} { clock scan {2440588 xii:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46799 test clock-29.1191 {time parsing} { clock scan {2440588 xii:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46799 test clock-29.1192 {time parsing} { clock scan {2440588 xii:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46799 test clock-29.1193 {time parsing} { clock scan {2440588 12:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46799 test clock-29.1194 {time parsing} { clock scan {2440588 12:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46799 test clock-29.1195 {time parsing} { clock scan {2440588 12:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46799 test clock-29.1196 {time parsing} { clock scan {2440588 12:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46799 test clock-29.1197 {time parsing} { clock scan {2440588 xii:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46799 test clock-29.1198 {time parsing} { clock scan {2440588 xii:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46799 test clock-29.1199 {time parsing} { clock scan {2440588 xii:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46799 test clock-29.1200 {time parsing} { clock scan {2440588 xii:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46799 test clock-29.1201 {time parsing} { clock scan {2440588 13 } \ -gmt true -locale en_US_roman \ -format {%J %H } } 46800 test clock-29.1202 {time parsing} { clock scan {2440588 13:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 46800 test clock-29.1203 {time parsing} { clock scan {2440588 13:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 46800 test clock-29.1204 {time parsing} { clock scan {2440588 13:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46800 test clock-29.1205 {time parsing} { clock scan {2440588 13:?:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46800 test clock-29.1206 {time parsing} { clock scan {2440588 13 } \ -gmt true -locale en_US_roman \ -format {%J %k } } 46800 test clock-29.1207 {time parsing} { clock scan {2440588 13:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 46800 test clock-29.1208 {time parsing} { clock scan {2440588 13:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 46800 test clock-29.1209 {time parsing} { clock scan {2440588 13:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46800 test clock-29.1210 {time parsing} { clock scan {2440588 13:?:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46800 test clock-29.1211 {time parsing} { clock scan {2440588 xiii } \ -gmt true -locale en_US_roman \ -format {%J %OH } } 46800 test clock-29.1212 {time parsing} { clock scan {2440588 xiii:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 46800 test clock-29.1213 {time parsing} { clock scan {2440588 xiii:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 46800 test clock-29.1214 {time parsing} { clock scan {2440588 xiii:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46800 test clock-29.1215 {time parsing} { clock scan {2440588 xiii:?:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46800 test clock-29.1216 {time parsing} { clock scan {2440588 xiii } \ -gmt true -locale en_US_roman \ -format {%J %Ok } } 46800 test clock-29.1217 {time parsing} { clock scan {2440588 xiii:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 46800 test clock-29.1218 {time parsing} { clock scan {2440588 xiii:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 46800 test clock-29.1219 {time parsing} { clock scan {2440588 xiii:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46800 test clock-29.1220 {time parsing} { clock scan {2440588 xiii:?:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46800 test clock-29.1221 {time parsing} { clock scan {2440588 01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I %p} } 46800 test clock-29.1222 {time parsing} { clock scan {2440588 01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 46800 test clock-29.1223 {time parsing} { clock scan {2440588 01:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 46800 test clock-29.1224 {time parsing} { clock scan {2440588 01:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46800 test clock-29.1225 {time parsing} { clock scan {2440588 01:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46800 test clock-29.1226 {time parsing} { clock scan {2440588 1 PM} \ -gmt true -locale en_US_roman \ -format {%J %l %p} } 46800 test clock-29.1227 {time parsing} { clock scan {2440588 1:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 46800 test clock-29.1228 {time parsing} { clock scan {2440588 1:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 46800 test clock-29.1229 {time parsing} { clock scan {2440588 1:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46800 test clock-29.1230 {time parsing} { clock scan {2440588 1:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46800 test clock-29.1231 {time parsing} { clock scan {2440588 i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI %p} } 46800 test clock-29.1232 {time parsing} { clock scan {2440588 i:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 46800 test clock-29.1233 {time parsing} { clock scan {2440588 i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 46800 test clock-29.1234 {time parsing} { clock scan {2440588 i:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46800 test clock-29.1235 {time parsing} { clock scan {2440588 i:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46800 test clock-29.1236 {time parsing} { clock scan {2440588 i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol %p} } 46800 test clock-29.1237 {time parsing} { clock scan {2440588 i:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 46800 test clock-29.1238 {time parsing} { clock scan {2440588 i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 46800 test clock-29.1239 {time parsing} { clock scan {2440588 i:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46800 test clock-29.1240 {time parsing} { clock scan {2440588 i:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46800 test clock-29.1241 {time parsing} { clock scan {2440588 01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I %P} } 46800 test clock-29.1242 {time parsing} { clock scan {2440588 01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 46800 test clock-29.1243 {time parsing} { clock scan {2440588 01:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 46800 test clock-29.1244 {time parsing} { clock scan {2440588 01:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46800 test clock-29.1245 {time parsing} { clock scan {2440588 01:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46800 test clock-29.1246 {time parsing} { clock scan {2440588 1 pm} \ -gmt true -locale en_US_roman \ -format {%J %l %P} } 46800 test clock-29.1247 {time parsing} { clock scan {2440588 1:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 46800 test clock-29.1248 {time parsing} { clock scan {2440588 1:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 46800 test clock-29.1249 {time parsing} { clock scan {2440588 1:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46800 test clock-29.1250 {time parsing} { clock scan {2440588 1:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46800 test clock-29.1251 {time parsing} { clock scan {2440588 i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI %P} } 46800 test clock-29.1252 {time parsing} { clock scan {2440588 i:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 46800 test clock-29.1253 {time parsing} { clock scan {2440588 i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 46800 test clock-29.1254 {time parsing} { clock scan {2440588 i:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46800 test clock-29.1255 {time parsing} { clock scan {2440588 i:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46800 test clock-29.1256 {time parsing} { clock scan {2440588 i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol %P} } 46800 test clock-29.1257 {time parsing} { clock scan {2440588 i:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 46800 test clock-29.1258 {time parsing} { clock scan {2440588 i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 46800 test clock-29.1259 {time parsing} { clock scan {2440588 i:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46800 test clock-29.1260 {time parsing} { clock scan {2440588 i:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46800 test clock-29.1261 {time parsing} { clock scan {2440588 13:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46801 test clock-29.1262 {time parsing} { clock scan {2440588 13:?:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46801 test clock-29.1263 {time parsing} { clock scan {2440588 13:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46801 test clock-29.1264 {time parsing} { clock scan {2440588 13:?:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46801 test clock-29.1265 {time parsing} { clock scan {2440588 xiii:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46801 test clock-29.1266 {time parsing} { clock scan {2440588 xiii:?:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46801 test clock-29.1267 {time parsing} { clock scan {2440588 xiii:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46801 test clock-29.1268 {time parsing} { clock scan {2440588 xiii:?:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46801 test clock-29.1269 {time parsing} { clock scan {2440588 01:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46801 test clock-29.1270 {time parsing} { clock scan {2440588 01:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46801 test clock-29.1271 {time parsing} { clock scan {2440588 1:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46801 test clock-29.1272 {time parsing} { clock scan {2440588 1:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46801 test clock-29.1273 {time parsing} { clock scan {2440588 i:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46801 test clock-29.1274 {time parsing} { clock scan {2440588 i:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46801 test clock-29.1275 {time parsing} { clock scan {2440588 i:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46801 test clock-29.1276 {time parsing} { clock scan {2440588 i:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46801 test clock-29.1277 {time parsing} { clock scan {2440588 01:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46801 test clock-29.1278 {time parsing} { clock scan {2440588 01:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46801 test clock-29.1279 {time parsing} { clock scan {2440588 1:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46801 test clock-29.1280 {time parsing} { clock scan {2440588 1:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46801 test clock-29.1281 {time parsing} { clock scan {2440588 i:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46801 test clock-29.1282 {time parsing} { clock scan {2440588 i:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46801 test clock-29.1283 {time parsing} { clock scan {2440588 i:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46801 test clock-29.1284 {time parsing} { clock scan {2440588 i:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46801 test clock-29.1285 {time parsing} { clock scan {2440588 13:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46859 test clock-29.1286 {time parsing} { clock scan {2440588 13:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46859 test clock-29.1287 {time parsing} { clock scan {2440588 13:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46859 test clock-29.1288 {time parsing} { clock scan {2440588 13:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46859 test clock-29.1289 {time parsing} { clock scan {2440588 xiii:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46859 test clock-29.1290 {time parsing} { clock scan {2440588 xiii:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46859 test clock-29.1291 {time parsing} { clock scan {2440588 xiii:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46859 test clock-29.1292 {time parsing} { clock scan {2440588 xiii:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46859 test clock-29.1293 {time parsing} { clock scan {2440588 01:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46859 test clock-29.1294 {time parsing} { clock scan {2440588 01:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46859 test clock-29.1295 {time parsing} { clock scan {2440588 1:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46859 test clock-29.1296 {time parsing} { clock scan {2440588 1:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46859 test clock-29.1297 {time parsing} { clock scan {2440588 i:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46859 test clock-29.1298 {time parsing} { clock scan {2440588 i:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46859 test clock-29.1299 {time parsing} { clock scan {2440588 i:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46859 test clock-29.1300 {time parsing} { clock scan {2440588 i:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46859 test clock-29.1301 {time parsing} { clock scan {2440588 01:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46859 test clock-29.1302 {time parsing} { clock scan {2440588 01:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46859 test clock-29.1303 {time parsing} { clock scan {2440588 1:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46859 test clock-29.1304 {time parsing} { clock scan {2440588 1:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46859 test clock-29.1305 {time parsing} { clock scan {2440588 i:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46859 test clock-29.1306 {time parsing} { clock scan {2440588 i:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46859 test clock-29.1307 {time parsing} { clock scan {2440588 i:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46859 test clock-29.1308 {time parsing} { clock scan {2440588 i:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46859 test clock-29.1309 {time parsing} { clock scan {2440588 13:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 46860 test clock-29.1310 {time parsing} { clock scan {2440588 13:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 46860 test clock-29.1311 {time parsing} { clock scan {2440588 13:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46860 test clock-29.1312 {time parsing} { clock scan {2440588 13:i:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46860 test clock-29.1313 {time parsing} { clock scan {2440588 13:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 46860 test clock-29.1314 {time parsing} { clock scan {2440588 13:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 46860 test clock-29.1315 {time parsing} { clock scan {2440588 13:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46860 test clock-29.1316 {time parsing} { clock scan {2440588 13:i:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46860 test clock-29.1317 {time parsing} { clock scan {2440588 xiii:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 46860 test clock-29.1318 {time parsing} { clock scan {2440588 xiii:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 46860 test clock-29.1319 {time parsing} { clock scan {2440588 xiii:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46860 test clock-29.1320 {time parsing} { clock scan {2440588 xiii:i:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46860 test clock-29.1321 {time parsing} { clock scan {2440588 xiii:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 46860 test clock-29.1322 {time parsing} { clock scan {2440588 xiii:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 46860 test clock-29.1323 {time parsing} { clock scan {2440588 xiii:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46860 test clock-29.1324 {time parsing} { clock scan {2440588 xiii:i:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46860 test clock-29.1325 {time parsing} { clock scan {2440588 01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 46860 test clock-29.1326 {time parsing} { clock scan {2440588 01:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 46860 test clock-29.1327 {time parsing} { clock scan {2440588 01:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46860 test clock-29.1328 {time parsing} { clock scan {2440588 01:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46860 test clock-29.1329 {time parsing} { clock scan {2440588 1:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 46860 test clock-29.1330 {time parsing} { clock scan {2440588 1:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 46860 test clock-29.1331 {time parsing} { clock scan {2440588 1:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46860 test clock-29.1332 {time parsing} { clock scan {2440588 1:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46860 test clock-29.1333 {time parsing} { clock scan {2440588 i:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 46860 test clock-29.1334 {time parsing} { clock scan {2440588 i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 46860 test clock-29.1335 {time parsing} { clock scan {2440588 i:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46860 test clock-29.1336 {time parsing} { clock scan {2440588 i:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46860 test clock-29.1337 {time parsing} { clock scan {2440588 i:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 46860 test clock-29.1338 {time parsing} { clock scan {2440588 i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 46860 test clock-29.1339 {time parsing} { clock scan {2440588 i:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46860 test clock-29.1340 {time parsing} { clock scan {2440588 i:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46860 test clock-29.1341 {time parsing} { clock scan {2440588 01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 46860 test clock-29.1342 {time parsing} { clock scan {2440588 01:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 46860 test clock-29.1343 {time parsing} { clock scan {2440588 01:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46860 test clock-29.1344 {time parsing} { clock scan {2440588 01:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46860 test clock-29.1345 {time parsing} { clock scan {2440588 1:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 46860 test clock-29.1346 {time parsing} { clock scan {2440588 1:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 46860 test clock-29.1347 {time parsing} { clock scan {2440588 1:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46860 test clock-29.1348 {time parsing} { clock scan {2440588 1:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46860 test clock-29.1349 {time parsing} { clock scan {2440588 i:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 46860 test clock-29.1350 {time parsing} { clock scan {2440588 i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 46860 test clock-29.1351 {time parsing} { clock scan {2440588 i:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46860 test clock-29.1352 {time parsing} { clock scan {2440588 i:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46860 test clock-29.1353 {time parsing} { clock scan {2440588 i:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 46860 test clock-29.1354 {time parsing} { clock scan {2440588 i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 46860 test clock-29.1355 {time parsing} { clock scan {2440588 i:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46860 test clock-29.1356 {time parsing} { clock scan {2440588 i:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46860 test clock-29.1357 {time parsing} { clock scan {2440588 13:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46861 test clock-29.1358 {time parsing} { clock scan {2440588 13:i:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46861 test clock-29.1359 {time parsing} { clock scan {2440588 13:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46861 test clock-29.1360 {time parsing} { clock scan {2440588 13:i:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46861 test clock-29.1361 {time parsing} { clock scan {2440588 xiii:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46861 test clock-29.1362 {time parsing} { clock scan {2440588 xiii:i:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46861 test clock-29.1363 {time parsing} { clock scan {2440588 xiii:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46861 test clock-29.1364 {time parsing} { clock scan {2440588 xiii:i:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46861 test clock-29.1365 {time parsing} { clock scan {2440588 01:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46861 test clock-29.1366 {time parsing} { clock scan {2440588 01:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46861 test clock-29.1367 {time parsing} { clock scan {2440588 1:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46861 test clock-29.1368 {time parsing} { clock scan {2440588 1:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46861 test clock-29.1369 {time parsing} { clock scan {2440588 i:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46861 test clock-29.1370 {time parsing} { clock scan {2440588 i:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46861 test clock-29.1371 {time parsing} { clock scan {2440588 i:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46861 test clock-29.1372 {time parsing} { clock scan {2440588 i:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46861 test clock-29.1373 {time parsing} { clock scan {2440588 01:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46861 test clock-29.1374 {time parsing} { clock scan {2440588 01:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46861 test clock-29.1375 {time parsing} { clock scan {2440588 1:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46861 test clock-29.1376 {time parsing} { clock scan {2440588 1:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46861 test clock-29.1377 {time parsing} { clock scan {2440588 i:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46861 test clock-29.1378 {time parsing} { clock scan {2440588 i:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46861 test clock-29.1379 {time parsing} { clock scan {2440588 i:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46861 test clock-29.1380 {time parsing} { clock scan {2440588 i:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46861 test clock-29.1381 {time parsing} { clock scan {2440588 13:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 46919 test clock-29.1382 {time parsing} { clock scan {2440588 13:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 46919 test clock-29.1383 {time parsing} { clock scan {2440588 13:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 46919 test clock-29.1384 {time parsing} { clock scan {2440588 13:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 46919 test clock-29.1385 {time parsing} { clock scan {2440588 xiii:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 46919 test clock-29.1386 {time parsing} { clock scan {2440588 xiii:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 46919 test clock-29.1387 {time parsing} { clock scan {2440588 xiii:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 46919 test clock-29.1388 {time parsing} { clock scan {2440588 xiii:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 46919 test clock-29.1389 {time parsing} { clock scan {2440588 01:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 46919 test clock-29.1390 {time parsing} { clock scan {2440588 01:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 46919 test clock-29.1391 {time parsing} { clock scan {2440588 1:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 46919 test clock-29.1392 {time parsing} { clock scan {2440588 1:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 46919 test clock-29.1393 {time parsing} { clock scan {2440588 i:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 46919 test clock-29.1394 {time parsing} { clock scan {2440588 i:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 46919 test clock-29.1395 {time parsing} { clock scan {2440588 i:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 46919 test clock-29.1396 {time parsing} { clock scan {2440588 i:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 46919 test clock-29.1397 {time parsing} { clock scan {2440588 01:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 46919 test clock-29.1398 {time parsing} { clock scan {2440588 01:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 46919 test clock-29.1399 {time parsing} { clock scan {2440588 1:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 46919 test clock-29.1400 {time parsing} { clock scan {2440588 1:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 46919 test clock-29.1401 {time parsing} { clock scan {2440588 i:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 46919 test clock-29.1402 {time parsing} { clock scan {2440588 i:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 46919 test clock-29.1403 {time parsing} { clock scan {2440588 i:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 46919 test clock-29.1404 {time parsing} { clock scan {2440588 i:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 46919 test clock-29.1405 {time parsing} { clock scan {2440588 13:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 50340 test clock-29.1406 {time parsing} { clock scan {2440588 13:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 50340 test clock-29.1407 {time parsing} { clock scan {2440588 13:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 50340 test clock-29.1408 {time parsing} { clock scan {2440588 13:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 50340 test clock-29.1409 {time parsing} { clock scan {2440588 13:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 50340 test clock-29.1410 {time parsing} { clock scan {2440588 13:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 50340 test clock-29.1411 {time parsing} { clock scan {2440588 13:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 50340 test clock-29.1412 {time parsing} { clock scan {2440588 13:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 50340 test clock-29.1413 {time parsing} { clock scan {2440588 xiii:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 50340 test clock-29.1414 {time parsing} { clock scan {2440588 xiii:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 50340 test clock-29.1415 {time parsing} { clock scan {2440588 xiii:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 50340 test clock-29.1416 {time parsing} { clock scan {2440588 xiii:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 50340 test clock-29.1417 {time parsing} { clock scan {2440588 xiii:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 50340 test clock-29.1418 {time parsing} { clock scan {2440588 xiii:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 50340 test clock-29.1419 {time parsing} { clock scan {2440588 xiii:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 50340 test clock-29.1420 {time parsing} { clock scan {2440588 xiii:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 50340 test clock-29.1421 {time parsing} { clock scan {2440588 01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 50340 test clock-29.1422 {time parsing} { clock scan {2440588 01:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 50340 test clock-29.1423 {time parsing} { clock scan {2440588 01:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 50340 test clock-29.1424 {time parsing} { clock scan {2440588 01:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 50340 test clock-29.1425 {time parsing} { clock scan {2440588 1:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 50340 test clock-29.1426 {time parsing} { clock scan {2440588 1:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 50340 test clock-29.1427 {time parsing} { clock scan {2440588 1:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 50340 test clock-29.1428 {time parsing} { clock scan {2440588 1:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 50340 test clock-29.1429 {time parsing} { clock scan {2440588 i:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 50340 test clock-29.1430 {time parsing} { clock scan {2440588 i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 50340 test clock-29.1431 {time parsing} { clock scan {2440588 i:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 50340 test clock-29.1432 {time parsing} { clock scan {2440588 i:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 50340 test clock-29.1433 {time parsing} { clock scan {2440588 i:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 50340 test clock-29.1434 {time parsing} { clock scan {2440588 i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 50340 test clock-29.1435 {time parsing} { clock scan {2440588 i:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 50340 test clock-29.1436 {time parsing} { clock scan {2440588 i:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 50340 test clock-29.1437 {time parsing} { clock scan {2440588 01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 50340 test clock-29.1438 {time parsing} { clock scan {2440588 01:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 50340 test clock-29.1439 {time parsing} { clock scan {2440588 01:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 50340 test clock-29.1440 {time parsing} { clock scan {2440588 01:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 50340 test clock-29.1441 {time parsing} { clock scan {2440588 1:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 50340 test clock-29.1442 {time parsing} { clock scan {2440588 1:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 50340 test clock-29.1443 {time parsing} { clock scan {2440588 1:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 50340 test clock-29.1444 {time parsing} { clock scan {2440588 1:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 50340 test clock-29.1445 {time parsing} { clock scan {2440588 i:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 50340 test clock-29.1446 {time parsing} { clock scan {2440588 i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 50340 test clock-29.1447 {time parsing} { clock scan {2440588 i:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 50340 test clock-29.1448 {time parsing} { clock scan {2440588 i:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 50340 test clock-29.1449 {time parsing} { clock scan {2440588 i:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 50340 test clock-29.1450 {time parsing} { clock scan {2440588 i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 50340 test clock-29.1451 {time parsing} { clock scan {2440588 i:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 50340 test clock-29.1452 {time parsing} { clock scan {2440588 i:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 50340 test clock-29.1453 {time parsing} { clock scan {2440588 13:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 50341 test clock-29.1454 {time parsing} { clock scan {2440588 13:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 50341 test clock-29.1455 {time parsing} { clock scan {2440588 13:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 50341 test clock-29.1456 {time parsing} { clock scan {2440588 13:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 50341 test clock-29.1457 {time parsing} { clock scan {2440588 xiii:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 50341 test clock-29.1458 {time parsing} { clock scan {2440588 xiii:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 50341 test clock-29.1459 {time parsing} { clock scan {2440588 xiii:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 50341 test clock-29.1460 {time parsing} { clock scan {2440588 xiii:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 50341 test clock-29.1461 {time parsing} { clock scan {2440588 01:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 50341 test clock-29.1462 {time parsing} { clock scan {2440588 01:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 50341 test clock-29.1463 {time parsing} { clock scan {2440588 1:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 50341 test clock-29.1464 {time parsing} { clock scan {2440588 1:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 50341 test clock-29.1465 {time parsing} { clock scan {2440588 i:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 50341 test clock-29.1466 {time parsing} { clock scan {2440588 i:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 50341 test clock-29.1467 {time parsing} { clock scan {2440588 i:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 50341 test clock-29.1468 {time parsing} { clock scan {2440588 i:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 50341 test clock-29.1469 {time parsing} { clock scan {2440588 01:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 50341 test clock-29.1470 {time parsing} { clock scan {2440588 01:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 50341 test clock-29.1471 {time parsing} { clock scan {2440588 1:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 50341 test clock-29.1472 {time parsing} { clock scan {2440588 1:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 50341 test clock-29.1473 {time parsing} { clock scan {2440588 i:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 50341 test clock-29.1474 {time parsing} { clock scan {2440588 i:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 50341 test clock-29.1475 {time parsing} { clock scan {2440588 i:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 50341 test clock-29.1476 {time parsing} { clock scan {2440588 i:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 50341 test clock-29.1477 {time parsing} { clock scan {2440588 13:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 50399 test clock-29.1478 {time parsing} { clock scan {2440588 13:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 50399 test clock-29.1479 {time parsing} { clock scan {2440588 13:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 50399 test clock-29.1480 {time parsing} { clock scan {2440588 13:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 50399 test clock-29.1481 {time parsing} { clock scan {2440588 xiii:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 50399 test clock-29.1482 {time parsing} { clock scan {2440588 xiii:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 50399 test clock-29.1483 {time parsing} { clock scan {2440588 xiii:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 50399 test clock-29.1484 {time parsing} { clock scan {2440588 xiii:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 50399 test clock-29.1485 {time parsing} { clock scan {2440588 01:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 50399 test clock-29.1486 {time parsing} { clock scan {2440588 01:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 50399 test clock-29.1487 {time parsing} { clock scan {2440588 1:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 50399 test clock-29.1488 {time parsing} { clock scan {2440588 1:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 50399 test clock-29.1489 {time parsing} { clock scan {2440588 i:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 50399 test clock-29.1490 {time parsing} { clock scan {2440588 i:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 50399 test clock-29.1491 {time parsing} { clock scan {2440588 i:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 50399 test clock-29.1492 {time parsing} { clock scan {2440588 i:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 50399 test clock-29.1493 {time parsing} { clock scan {2440588 01:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 50399 test clock-29.1494 {time parsing} { clock scan {2440588 01:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 50399 test clock-29.1495 {time parsing} { clock scan {2440588 1:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 50399 test clock-29.1496 {time parsing} { clock scan {2440588 1:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 50399 test clock-29.1497 {time parsing} { clock scan {2440588 i:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 50399 test clock-29.1498 {time parsing} { clock scan {2440588 i:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 50399 test clock-29.1499 {time parsing} { clock scan {2440588 i:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 50399 test clock-29.1500 {time parsing} { clock scan {2440588 i:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 50399 test clock-29.1501 {time parsing} { clock scan {2440588 23 } \ -gmt true -locale en_US_roman \ -format {%J %H } } 82800 test clock-29.1502 {time parsing} { clock scan {2440588 23:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 82800 test clock-29.1503 {time parsing} { clock scan {2440588 23:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 82800 test clock-29.1504 {time parsing} { clock scan {2440588 23:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 82800 test clock-29.1505 {time parsing} { clock scan {2440588 23:?:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 82800 test clock-29.1506 {time parsing} { clock scan {2440588 23 } \ -gmt true -locale en_US_roman \ -format {%J %k } } 82800 test clock-29.1507 {time parsing} { clock scan {2440588 23:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 82800 test clock-29.1508 {time parsing} { clock scan {2440588 23:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 82800 test clock-29.1509 {time parsing} { clock scan {2440588 23:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 82800 test clock-29.1510 {time parsing} { clock scan {2440588 23:?:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 82800 test clock-29.1511 {time parsing} { clock scan {2440588 xxiii } \ -gmt true -locale en_US_roman \ -format {%J %OH } } 82800 test clock-29.1512 {time parsing} { clock scan {2440588 xxiii:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 82800 test clock-29.1513 {time parsing} { clock scan {2440588 xxiii:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 82800 test clock-29.1514 {time parsing} { clock scan {2440588 xxiii:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 82800 test clock-29.1515 {time parsing} { clock scan {2440588 xxiii:?:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 82800 test clock-29.1516 {time parsing} { clock scan {2440588 xxiii } \ -gmt true -locale en_US_roman \ -format {%J %Ok } } 82800 test clock-29.1517 {time parsing} { clock scan {2440588 xxiii:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 82800 test clock-29.1518 {time parsing} { clock scan {2440588 xxiii:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 82800 test clock-29.1519 {time parsing} { clock scan {2440588 xxiii:00:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 82800 test clock-29.1520 {time parsing} { clock scan {2440588 xxiii:?:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 82800 test clock-29.1521 {time parsing} { clock scan {2440588 11 PM} \ -gmt true -locale en_US_roman \ -format {%J %I %p} } 82800 test clock-29.1522 {time parsing} { clock scan {2440588 11:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 82800 test clock-29.1523 {time parsing} { clock scan {2440588 11:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 82800 test clock-29.1524 {time parsing} { clock scan {2440588 11:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 82800 test clock-29.1525 {time parsing} { clock scan {2440588 11:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 82800 test clock-29.1526 {time parsing} { clock scan {2440588 11 PM} \ -gmt true -locale en_US_roman \ -format {%J %l %p} } 82800 test clock-29.1527 {time parsing} { clock scan {2440588 11:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 82800 test clock-29.1528 {time parsing} { clock scan {2440588 11:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 82800 test clock-29.1529 {time parsing} { clock scan {2440588 11:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 82800 test clock-29.1530 {time parsing} { clock scan {2440588 11:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 82800 test clock-29.1531 {time parsing} { clock scan {2440588 xi PM} \ -gmt true -locale en_US_roman \ -format {%J %OI %p} } 82800 test clock-29.1532 {time parsing} { clock scan {2440588 xi:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 82800 test clock-29.1533 {time parsing} { clock scan {2440588 xi:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 82800 test clock-29.1534 {time parsing} { clock scan {2440588 xi:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 82800 test clock-29.1535 {time parsing} { clock scan {2440588 xi:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 82800 test clock-29.1536 {time parsing} { clock scan {2440588 xi PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol %p} } 82800 test clock-29.1537 {time parsing} { clock scan {2440588 xi:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 82800 test clock-29.1538 {time parsing} { clock scan {2440588 xi:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 82800 test clock-29.1539 {time parsing} { clock scan {2440588 xi:00:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 82800 test clock-29.1540 {time parsing} { clock scan {2440588 xi:?:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 82800 test clock-29.1541 {time parsing} { clock scan {2440588 11 pm} \ -gmt true -locale en_US_roman \ -format {%J %I %P} } 82800 test clock-29.1542 {time parsing} { clock scan {2440588 11:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 82800 test clock-29.1543 {time parsing} { clock scan {2440588 11:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 82800 test clock-29.1544 {time parsing} { clock scan {2440588 11:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 82800 test clock-29.1545 {time parsing} { clock scan {2440588 11:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 82800 test clock-29.1546 {time parsing} { clock scan {2440588 11 pm} \ -gmt true -locale en_US_roman \ -format {%J %l %P} } 82800 test clock-29.1547 {time parsing} { clock scan {2440588 11:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 82800 test clock-29.1548 {time parsing} { clock scan {2440588 11:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 82800 test clock-29.1549 {time parsing} { clock scan {2440588 11:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 82800 test clock-29.1550 {time parsing} { clock scan {2440588 11:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 82800 test clock-29.1551 {time parsing} { clock scan {2440588 xi pm} \ -gmt true -locale en_US_roman \ -format {%J %OI %P} } 82800 test clock-29.1552 {time parsing} { clock scan {2440588 xi:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 82800 test clock-29.1553 {time parsing} { clock scan {2440588 xi:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 82800 test clock-29.1554 {time parsing} { clock scan {2440588 xi:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 82800 test clock-29.1555 {time parsing} { clock scan {2440588 xi:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 82800 test clock-29.1556 {time parsing} { clock scan {2440588 xi pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol %P} } 82800 test clock-29.1557 {time parsing} { clock scan {2440588 xi:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 82800 test clock-29.1558 {time parsing} { clock scan {2440588 xi:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 82800 test clock-29.1559 {time parsing} { clock scan {2440588 xi:00:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 82800 test clock-29.1560 {time parsing} { clock scan {2440588 xi:?:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 82800 test clock-29.1561 {time parsing} { clock scan {2440588 23:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 82801 test clock-29.1562 {time parsing} { clock scan {2440588 23:?:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 82801 test clock-29.1563 {time parsing} { clock scan {2440588 23:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 82801 test clock-29.1564 {time parsing} { clock scan {2440588 23:?:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 82801 test clock-29.1565 {time parsing} { clock scan {2440588 xxiii:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 82801 test clock-29.1566 {time parsing} { clock scan {2440588 xxiii:?:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 82801 test clock-29.1567 {time parsing} { clock scan {2440588 xxiii:00:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 82801 test clock-29.1568 {time parsing} { clock scan {2440588 xxiii:?:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 82801 test clock-29.1569 {time parsing} { clock scan {2440588 11:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 82801 test clock-29.1570 {time parsing} { clock scan {2440588 11:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 82801 test clock-29.1571 {time parsing} { clock scan {2440588 11:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 82801 test clock-29.1572 {time parsing} { clock scan {2440588 11:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 82801 test clock-29.1573 {time parsing} { clock scan {2440588 xi:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 82801 test clock-29.1574 {time parsing} { clock scan {2440588 xi:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 82801 test clock-29.1575 {time parsing} { clock scan {2440588 xi:00:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 82801 test clock-29.1576 {time parsing} { clock scan {2440588 xi:?:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 82801 test clock-29.1577 {time parsing} { clock scan {2440588 11:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 82801 test clock-29.1578 {time parsing} { clock scan {2440588 11:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 82801 test clock-29.1579 {time parsing} { clock scan {2440588 11:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 82801 test clock-29.1580 {time parsing} { clock scan {2440588 11:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 82801 test clock-29.1581 {time parsing} { clock scan {2440588 xi:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 82801 test clock-29.1582 {time parsing} { clock scan {2440588 xi:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 82801 test clock-29.1583 {time parsing} { clock scan {2440588 xi:00:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 82801 test clock-29.1584 {time parsing} { clock scan {2440588 xi:?:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 82801 test clock-29.1585 {time parsing} { clock scan {2440588 23:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 82859 test clock-29.1586 {time parsing} { clock scan {2440588 23:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 82859 test clock-29.1587 {time parsing} { clock scan {2440588 23:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 82859 test clock-29.1588 {time parsing} { clock scan {2440588 23:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 82859 test clock-29.1589 {time parsing} { clock scan {2440588 xxiii:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 82859 test clock-29.1590 {time parsing} { clock scan {2440588 xxiii:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 82859 test clock-29.1591 {time parsing} { clock scan {2440588 xxiii:00:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 82859 test clock-29.1592 {time parsing} { clock scan {2440588 xxiii:?:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 82859 test clock-29.1593 {time parsing} { clock scan {2440588 11:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 82859 test clock-29.1594 {time parsing} { clock scan {2440588 11:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 82859 test clock-29.1595 {time parsing} { clock scan {2440588 11:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 82859 test clock-29.1596 {time parsing} { clock scan {2440588 11:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 82859 test clock-29.1597 {time parsing} { clock scan {2440588 xi:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 82859 test clock-29.1598 {time parsing} { clock scan {2440588 xi:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 82859 test clock-29.1599 {time parsing} { clock scan {2440588 xi:00:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 82859 test clock-29.1600 {time parsing} { clock scan {2440588 xi:?:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 82859 test clock-29.1601 {time parsing} { clock scan {2440588 11:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 82859 test clock-29.1602 {time parsing} { clock scan {2440588 11:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 82859 test clock-29.1603 {time parsing} { clock scan {2440588 11:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 82859 test clock-29.1604 {time parsing} { clock scan {2440588 11:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 82859 test clock-29.1605 {time parsing} { clock scan {2440588 xi:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 82859 test clock-29.1606 {time parsing} { clock scan {2440588 xi:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 82859 test clock-29.1607 {time parsing} { clock scan {2440588 xi:00:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 82859 test clock-29.1608 {time parsing} { clock scan {2440588 xi:?:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 82859 test clock-29.1609 {time parsing} { clock scan {2440588 23:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 82860 test clock-29.1610 {time parsing} { clock scan {2440588 23:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 82860 test clock-29.1611 {time parsing} { clock scan {2440588 23:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 82860 test clock-29.1612 {time parsing} { clock scan {2440588 23:i:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 82860 test clock-29.1613 {time parsing} { clock scan {2440588 23:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 82860 test clock-29.1614 {time parsing} { clock scan {2440588 23:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 82860 test clock-29.1615 {time parsing} { clock scan {2440588 23:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 82860 test clock-29.1616 {time parsing} { clock scan {2440588 23:i:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 82860 test clock-29.1617 {time parsing} { clock scan {2440588 xxiii:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 82860 test clock-29.1618 {time parsing} { clock scan {2440588 xxiii:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 82860 test clock-29.1619 {time parsing} { clock scan {2440588 xxiii:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 82860 test clock-29.1620 {time parsing} { clock scan {2440588 xxiii:i:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 82860 test clock-29.1621 {time parsing} { clock scan {2440588 xxiii:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 82860 test clock-29.1622 {time parsing} { clock scan {2440588 xxiii:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 82860 test clock-29.1623 {time parsing} { clock scan {2440588 xxiii:01:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 82860 test clock-29.1624 {time parsing} { clock scan {2440588 xxiii:i:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 82860 test clock-29.1625 {time parsing} { clock scan {2440588 11:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 82860 test clock-29.1626 {time parsing} { clock scan {2440588 11:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 82860 test clock-29.1627 {time parsing} { clock scan {2440588 11:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 82860 test clock-29.1628 {time parsing} { clock scan {2440588 11:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 82860 test clock-29.1629 {time parsing} { clock scan {2440588 11:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 82860 test clock-29.1630 {time parsing} { clock scan {2440588 11:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 82860 test clock-29.1631 {time parsing} { clock scan {2440588 11:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 82860 test clock-29.1632 {time parsing} { clock scan {2440588 11:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 82860 test clock-29.1633 {time parsing} { clock scan {2440588 xi:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 82860 test clock-29.1634 {time parsing} { clock scan {2440588 xi:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 82860 test clock-29.1635 {time parsing} { clock scan {2440588 xi:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 82860 test clock-29.1636 {time parsing} { clock scan {2440588 xi:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 82860 test clock-29.1637 {time parsing} { clock scan {2440588 xi:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 82860 test clock-29.1638 {time parsing} { clock scan {2440588 xi:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 82860 test clock-29.1639 {time parsing} { clock scan {2440588 xi:01:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 82860 test clock-29.1640 {time parsing} { clock scan {2440588 xi:i:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 82860 test clock-29.1641 {time parsing} { clock scan {2440588 11:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 82860 test clock-29.1642 {time parsing} { clock scan {2440588 11:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 82860 test clock-29.1643 {time parsing} { clock scan {2440588 11:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 82860 test clock-29.1644 {time parsing} { clock scan {2440588 11:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 82860 test clock-29.1645 {time parsing} { clock scan {2440588 11:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 82860 test clock-29.1646 {time parsing} { clock scan {2440588 11:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 82860 test clock-29.1647 {time parsing} { clock scan {2440588 11:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 82860 test clock-29.1648 {time parsing} { clock scan {2440588 11:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 82860 test clock-29.1649 {time parsing} { clock scan {2440588 xi:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 82860 test clock-29.1650 {time parsing} { clock scan {2440588 xi:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 82860 test clock-29.1651 {time parsing} { clock scan {2440588 xi:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 82860 test clock-29.1652 {time parsing} { clock scan {2440588 xi:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 82860 test clock-29.1653 {time parsing} { clock scan {2440588 xi:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 82860 test clock-29.1654 {time parsing} { clock scan {2440588 xi:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 82860 test clock-29.1655 {time parsing} { clock scan {2440588 xi:01:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 82860 test clock-29.1656 {time parsing} { clock scan {2440588 xi:i:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 82860 test clock-29.1657 {time parsing} { clock scan {2440588 23:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 82861 test clock-29.1658 {time parsing} { clock scan {2440588 23:i:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 82861 test clock-29.1659 {time parsing} { clock scan {2440588 23:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 82861 test clock-29.1660 {time parsing} { clock scan {2440588 23:i:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 82861 test clock-29.1661 {time parsing} { clock scan {2440588 xxiii:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 82861 test clock-29.1662 {time parsing} { clock scan {2440588 xxiii:i:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 82861 test clock-29.1663 {time parsing} { clock scan {2440588 xxiii:01:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 82861 test clock-29.1664 {time parsing} { clock scan {2440588 xxiii:i:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 82861 test clock-29.1665 {time parsing} { clock scan {2440588 11:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 82861 test clock-29.1666 {time parsing} { clock scan {2440588 11:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 82861 test clock-29.1667 {time parsing} { clock scan {2440588 11:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 82861 test clock-29.1668 {time parsing} { clock scan {2440588 11:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 82861 test clock-29.1669 {time parsing} { clock scan {2440588 xi:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 82861 test clock-29.1670 {time parsing} { clock scan {2440588 xi:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 82861 test clock-29.1671 {time parsing} { clock scan {2440588 xi:01:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 82861 test clock-29.1672 {time parsing} { clock scan {2440588 xi:i:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 82861 test clock-29.1673 {time parsing} { clock scan {2440588 11:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 82861 test clock-29.1674 {time parsing} { clock scan {2440588 11:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 82861 test clock-29.1675 {time parsing} { clock scan {2440588 11:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 82861 test clock-29.1676 {time parsing} { clock scan {2440588 11:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 82861 test clock-29.1677 {time parsing} { clock scan {2440588 xi:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 82861 test clock-29.1678 {time parsing} { clock scan {2440588 xi:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 82861 test clock-29.1679 {time parsing} { clock scan {2440588 xi:01:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 82861 test clock-29.1680 {time parsing} { clock scan {2440588 xi:i:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 82861 test clock-29.1681 {time parsing} { clock scan {2440588 23:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 82919 test clock-29.1682 {time parsing} { clock scan {2440588 23:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 82919 test clock-29.1683 {time parsing} { clock scan {2440588 23:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 82919 test clock-29.1684 {time parsing} { clock scan {2440588 23:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 82919 test clock-29.1685 {time parsing} { clock scan {2440588 xxiii:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 82919 test clock-29.1686 {time parsing} { clock scan {2440588 xxiii:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 82919 test clock-29.1687 {time parsing} { clock scan {2440588 xxiii:01:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 82919 test clock-29.1688 {time parsing} { clock scan {2440588 xxiii:i:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 82919 test clock-29.1689 {time parsing} { clock scan {2440588 11:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 82919 test clock-29.1690 {time parsing} { clock scan {2440588 11:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 82919 test clock-29.1691 {time parsing} { clock scan {2440588 11:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 82919 test clock-29.1692 {time parsing} { clock scan {2440588 11:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 82919 test clock-29.1693 {time parsing} { clock scan {2440588 xi:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 82919 test clock-29.1694 {time parsing} { clock scan {2440588 xi:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 82919 test clock-29.1695 {time parsing} { clock scan {2440588 xi:01:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 82919 test clock-29.1696 {time parsing} { clock scan {2440588 xi:i:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 82919 test clock-29.1697 {time parsing} { clock scan {2440588 11:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 82919 test clock-29.1698 {time parsing} { clock scan {2440588 11:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 82919 test clock-29.1699 {time parsing} { clock scan {2440588 11:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 82919 test clock-29.1700 {time parsing} { clock scan {2440588 11:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 82919 test clock-29.1701 {time parsing} { clock scan {2440588 xi:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 82919 test clock-29.1702 {time parsing} { clock scan {2440588 xi:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 82919 test clock-29.1703 {time parsing} { clock scan {2440588 xi:01:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 82919 test clock-29.1704 {time parsing} { clock scan {2440588 xi:i:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 82919 test clock-29.1705 {time parsing} { clock scan {2440588 23:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M } } 86340 test clock-29.1706 {time parsing} { clock scan {2440588 23:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM } } 86340 test clock-29.1707 {time parsing} { clock scan {2440588 23:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 86340 test clock-29.1708 {time parsing} { clock scan {2440588 23:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 86340 test clock-29.1709 {time parsing} { clock scan {2440588 23:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M } } 86340 test clock-29.1710 {time parsing} { clock scan {2440588 23:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM } } 86340 test clock-29.1711 {time parsing} { clock scan {2440588 23:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 86340 test clock-29.1712 {time parsing} { clock scan {2440588 23:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 86340 test clock-29.1713 {time parsing} { clock scan {2440588 xxiii:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M } } 86340 test clock-29.1714 {time parsing} { clock scan {2440588 xxiii:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM } } 86340 test clock-29.1715 {time parsing} { clock scan {2440588 xxiii:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 86340 test clock-29.1716 {time parsing} { clock scan {2440588 xxiii:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 86340 test clock-29.1717 {time parsing} { clock scan {2440588 xxiii:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M } } 86340 test clock-29.1718 {time parsing} { clock scan {2440588 xxiii:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM } } 86340 test clock-29.1719 {time parsing} { clock scan {2440588 xxiii:59:00 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 86340 test clock-29.1720 {time parsing} { clock scan {2440588 xxiii:lix:? } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 86340 test clock-29.1721 {time parsing} { clock scan {2440588 11:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %p} } 86340 test clock-29.1722 {time parsing} { clock scan {2440588 11:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %p} } 86340 test clock-29.1723 {time parsing} { clock scan {2440588 11:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 86340 test clock-29.1724 {time parsing} { clock scan {2440588 11:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 86340 test clock-29.1725 {time parsing} { clock scan {2440588 11:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %p} } 86340 test clock-29.1726 {time parsing} { clock scan {2440588 11:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %p} } 86340 test clock-29.1727 {time parsing} { clock scan {2440588 11:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 86340 test clock-29.1728 {time parsing} { clock scan {2440588 11:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 86340 test clock-29.1729 {time parsing} { clock scan {2440588 xi:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %p} } 86340 test clock-29.1730 {time parsing} { clock scan {2440588 xi:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %p} } 86340 test clock-29.1731 {time parsing} { clock scan {2440588 xi:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 86340 test clock-29.1732 {time parsing} { clock scan {2440588 xi:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 86340 test clock-29.1733 {time parsing} { clock scan {2440588 xi:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %p} } 86340 test clock-29.1734 {time parsing} { clock scan {2440588 xi:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %p} } 86340 test clock-29.1735 {time parsing} { clock scan {2440588 xi:59:00 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 86340 test clock-29.1736 {time parsing} { clock scan {2440588 xi:lix:? PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 86340 test clock-29.1737 {time parsing} { clock scan {2440588 11:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M %P} } 86340 test clock-29.1738 {time parsing} { clock scan {2440588 11:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM %P} } 86340 test clock-29.1739 {time parsing} { clock scan {2440588 11:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 86340 test clock-29.1740 {time parsing} { clock scan {2440588 11:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 86340 test clock-29.1741 {time parsing} { clock scan {2440588 11:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M %P} } 86340 test clock-29.1742 {time parsing} { clock scan {2440588 11:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM %P} } 86340 test clock-29.1743 {time parsing} { clock scan {2440588 11:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 86340 test clock-29.1744 {time parsing} { clock scan {2440588 11:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 86340 test clock-29.1745 {time parsing} { clock scan {2440588 xi:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M %P} } 86340 test clock-29.1746 {time parsing} { clock scan {2440588 xi:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM %P} } 86340 test clock-29.1747 {time parsing} { clock scan {2440588 xi:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 86340 test clock-29.1748 {time parsing} { clock scan {2440588 xi:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 86340 test clock-29.1749 {time parsing} { clock scan {2440588 xi:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M %P} } 86340 test clock-29.1750 {time parsing} { clock scan {2440588 xi:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM %P} } 86340 test clock-29.1751 {time parsing} { clock scan {2440588 xi:59:00 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 86340 test clock-29.1752 {time parsing} { clock scan {2440588 xi:lix:? pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 86340 test clock-29.1753 {time parsing} { clock scan {2440588 23:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 86341 test clock-29.1754 {time parsing} { clock scan {2440588 23:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 86341 test clock-29.1755 {time parsing} { clock scan {2440588 23:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 86341 test clock-29.1756 {time parsing} { clock scan {2440588 23:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 86341 test clock-29.1757 {time parsing} { clock scan {2440588 xxiii:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 86341 test clock-29.1758 {time parsing} { clock scan {2440588 xxiii:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 86341 test clock-29.1759 {time parsing} { clock scan {2440588 xxiii:59:01 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 86341 test clock-29.1760 {time parsing} { clock scan {2440588 xxiii:lix:i } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 86341 test clock-29.1761 {time parsing} { clock scan {2440588 11:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 86341 test clock-29.1762 {time parsing} { clock scan {2440588 11:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 86341 test clock-29.1763 {time parsing} { clock scan {2440588 11:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 86341 test clock-29.1764 {time parsing} { clock scan {2440588 11:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 86341 test clock-29.1765 {time parsing} { clock scan {2440588 xi:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 86341 test clock-29.1766 {time parsing} { clock scan {2440588 xi:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 86341 test clock-29.1767 {time parsing} { clock scan {2440588 xi:59:01 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 86341 test clock-29.1768 {time parsing} { clock scan {2440588 xi:lix:i PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 86341 test clock-29.1769 {time parsing} { clock scan {2440588 11:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 86341 test clock-29.1770 {time parsing} { clock scan {2440588 11:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 86341 test clock-29.1771 {time parsing} { clock scan {2440588 11:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 86341 test clock-29.1772 {time parsing} { clock scan {2440588 11:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 86341 test clock-29.1773 {time parsing} { clock scan {2440588 xi:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 86341 test clock-29.1774 {time parsing} { clock scan {2440588 xi:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 86341 test clock-29.1775 {time parsing} { clock scan {2440588 xi:59:01 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 86341 test clock-29.1776 {time parsing} { clock scan {2440588 xi:lix:i pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 86341 test clock-29.1777 {time parsing} { clock scan {2440588 23:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %H:%M:%S } } 86399 test clock-29.1778 {time parsing} { clock scan {2440588 23:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %H:%OM:%OS } } 86399 test clock-29.1779 {time parsing} { clock scan {2440588 23:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %k:%M:%S } } 86399 test clock-29.1780 {time parsing} { clock scan {2440588 23:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %k:%OM:%OS } } 86399 test clock-29.1781 {time parsing} { clock scan {2440588 xxiii:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %OH:%M:%S } } 86399 test clock-29.1782 {time parsing} { clock scan {2440588 xxiii:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %OH:%OM:%OS } } 86399 test clock-29.1783 {time parsing} { clock scan {2440588 xxiii:59:59 } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%M:%S } } 86399 test clock-29.1784 {time parsing} { clock scan {2440588 xxiii:lix:lix } \ -gmt true -locale en_US_roman \ -format {%J %Ok:%OM:%OS } } 86399 test clock-29.1785 {time parsing} { clock scan {2440588 11:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %p} } 86399 test clock-29.1786 {time parsing} { clock scan {2440588 11:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %p} } 86399 test clock-29.1787 {time parsing} { clock scan {2440588 11:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %p} } 86399 test clock-29.1788 {time parsing} { clock scan {2440588 11:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %p} } 86399 test clock-29.1789 {time parsing} { clock scan {2440588 xi:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %p} } 86399 test clock-29.1790 {time parsing} { clock scan {2440588 xi:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %p} } 86399 test clock-29.1791 {time parsing} { clock scan {2440588 xi:59:59 PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %p} } 86399 test clock-29.1792 {time parsing} { clock scan {2440588 xi:lix:lix PM} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %p} } 86399 test clock-29.1793 {time parsing} { clock scan {2440588 11:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%M:%S %P} } 86399 test clock-29.1794 {time parsing} { clock scan {2440588 11:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %I:%OM:%OS %P} } 86399 test clock-29.1795 {time parsing} { clock scan {2440588 11:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%M:%S %P} } 86399 test clock-29.1796 {time parsing} { clock scan {2440588 11:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %l:%OM:%OS %P} } 86399 test clock-29.1797 {time parsing} { clock scan {2440588 xi:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%M:%S %P} } 86399 test clock-29.1798 {time parsing} { clock scan {2440588 xi:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %OI:%OM:%OS %P} } 86399 test clock-29.1799 {time parsing} { clock scan {2440588 xi:59:59 pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%M:%S %P} } 86399 test clock-29.1800 {time parsing} { clock scan {2440588 xi:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 86399 # END testcases29 test clock-30.1 {clock add years} { set t [clock scan 2000-01-01 -format %Y-%m-%d -timezone :UTC] set f [clock add $t 1 year -timezone :UTC] clock format $f -format %Y-%m-%d -timezone :UTC } {2001-01-01} test clock-30.2 {clock add years - leap day} { set t [clock scan 2000-02-29 -format %Y-%m-%d -timezone :UTC] set f [clock add $t 1 years -timezone :UTC] clock format $f -format %Y-%m-%d -timezone :UTC } {2001-02-28} test clock-30.3 {clock add months} { set t [clock scan 2000-01-01 -format %Y-%m-%d -timezone :UTC] set f [clock add $t 1 month -timezone :UTC] clock format $f -format %Y-%m-%d -timezone :UTC } {2000-02-01} test clock-30.4 {clock add months, short month} { set t [clock scan 2000-01-31 -format %Y-%m-%d -timezone :UTC] set f [clock add $t 1 months -timezone :UTC] clock format $f -format %Y-%m-%d -timezone :UTC } {2000-02-29} test clock-30.5 {clock add months, end of year} { set t [clock scan 2000-12-01 -format %Y-%m-%d -timezone :UTC] set f [clock add $t 1 month -timezone :UTC] clock format $f -format %Y-%m-%d -timezone :UTC } {2001-01-01} test clock-30.6 {clock add months, one year one month vs 13 months} { set t [clock scan 2000-02-29 -format %Y-%m-%d -timezone :UTC] set f1 [clock add $t 1 year 1 month -timezone :UTC] set f2 [clock add $t 13 months -timezone :UTC] set x1 [clock format $f1 -format %Y-%m-%d -timezone :UTC] set x2 [clock format $f2 -format %Y-%m-%d -timezone :UTC] list $x1 $x2 } {2001-03-28 2001-03-29} test clock-30.7 {clock add months, 1 year 1 month vs 1 month 1 year} { set t [clock scan 2000-02-29 -format %Y-%m-%d -timezone :UTC] set f1 [clock add $t 1 year 1 month -timezone :UTC] set f2 [clock add $t 1 month 1 year -timezone :UTC] set x1 [clock format $f1 -format %Y-%m-%d -timezone :UTC] set x2 [clock format $f2 -format %Y-%m-%d -timezone :UTC] list $x1 $x2 } {2001-03-28 2001-03-29} test clock-30.8 {clock add months, negative} { set t [clock scan 2000-03-31 -format %Y-%m-%d -timezone :UTC] set f1 [clock add $t -1 month -timezone :UTC] set f2 [clock add $t -2 month -timezone :UTC] set f3 [clock add $t -3 month -timezone :UTC] set f4 [clock add $t -4 month -timezone :UTC] set x1 [clock format $f1 -format %Y-%m-%d -timezone :UTC] set x2 [clock format $f2 -format %Y-%m-%d -timezone :UTC] set x3 [clock format $f3 -format %Y-%m-%d -timezone :UTC] set x4 [clock format $f4 -format %Y-%m-%d -timezone :UTC] list $x1 $x2 $x3 $x4 } {2000-02-29 2000-01-31 1999-12-31 1999-11-30} test clock-30.8a {clock add months, negative, over threshold of a year} { set t [clock scan 2019-01-31 -format %Y-%m-%d -gmt 1] list [clock format [clock add $t -1 month -gmt 1] -format %Y-%m-%d -gmt 1] \ [clock format [clock add $t -2 month -gmt 1] -format %Y-%m-%d -gmt 1] \ [clock format [clock add $t -3 month -gmt 1] -format %Y-%m-%d -gmt 1] \ [clock format [clock add $t -4 month -gmt 1] -format %Y-%m-%d -gmt 1] } {2018-12-31 2018-11-30 2018-10-31 2018-09-30} test clock-30.8b {clock add months, negative, over threshold of a year} { set t [clock scan 2000-01-28 -format %Y-%m-%d -gmt 1] for {set i 1} {$i < 24} {incr i 1} { set f1 [clock add $t -$i month -gmt 1] set f2 [clock add $f1 $i month -gmt 1] if {$f2 != $t} { error "\[clock add $t -$i month -gmt 1\] does not consider\ \[clock add $f1 $i month -gmt 1\] != $t" } } } {} test clock-30.9 {clock add days} { set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \ -timezone :UTC] set f1 [clock add $t 1 day -timezone :UTC] set f2 [clock add $t -1 day -timezone :UTC] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] list $x1 $x2 } {{2000-01-02 12:34:56} {1999-12-31 12:34:56}} test clock-30.10 {clock add days, spring DST conversion, before} { set t [clock scan {2004-04-03 01:59:59} -format {%Y-%m-%d %H:%M:%S} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 1 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f2 [clock add $t 2 days \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] list $x1 $x2 } {{2004-04-04 01:59:59 -0500} {2004-04-05 01:59:59 -0400}} test clock-30.11 {clock add days, spring DST conversion, bad case} { set t [clock scan {2004-04-03 02:30:00} -format {%Y-%m-%d %H:%M:%S} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 1 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f2 [clock add $t 2 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] list $x1 $x2 } {{2004-04-04 03:30:00 -0400} {2004-04-05 02:30:00 -0400}} test clock-30.12 {clock add days, spring DST conversion, after} { set t [clock scan {2004-04-03 03:00:00} -format {%Y-%m-%d %H:%M:%S} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 1 day -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f2 [clock add $t 2 day -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] list $x1 $x2 } {{2004-04-04 03:00:00 -0400} {2004-04-05 03:00:00 -0400}} test clock-30.13 {clock add days, fall DST conversion, before} { set t [clock scan {2004-10-30 00:59:59} -format {%Y-%m-%d %H:%M:%S} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 1 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f2 [clock add $t 2 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] list $x1 $x2 } {{2004-10-31 00:59:59 -0400} {2004-11-01 00:59:59 -0500}} test clock-30.14 {clock add days, fall DST conversion, bad case} { set t [clock scan {2004-10-30 01:30:00} -format {%Y-%m-%d %H:%M:%S} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 1 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f2 [clock add $t 2 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] list $x1 $x2 } {{2004-10-31 01:30:00 -0400} {2004-11-01 01:30:00 -0500}} test clock-30.15 {clock add days, fall DST conversion, after} { set t [clock scan {2004-10-30 02:30:00} -format {%Y-%m-%d %H:%M:%S} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 1 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f2 [clock add $t 2 day \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] list $x1 $x2 } {{2004-10-31 02:30:00 -0500} {2004-11-01 02:30:00 -0500}} test clock-30.16 {clock add weeks} { set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \ -timezone :UTC] set f1 [clock add $t 1 week -timezone :UTC] set f2 [clock add $t -1 weeks -timezone :UTC] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] list $x1 $x2 } {{2000-01-08 12:34:56} {1999-12-25 12:34:56}} test clock-30.17 {clock add hours} { set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \ -timezone :UTC] set f1 [clock add $t 1 hour -timezone :UTC] set f2 [clock add $t -1 hours -timezone :UTC] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] list $x1 $x2 } {{2000-01-01 13:34:56} {2000-01-01 11:34:56}} test clock-30.18 {clock add hours at DST conversion} { set t [clock scan {2004-04-04 01:00:00 -0500} \ -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 1 hour -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] } {2004-04-04 03:00:00 -0400} test clock-30.19 {clock add hours at DST conversion} { set t [clock scan {2004-10-31 01:00:00 -0400} \ -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 1 hour \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] } {2004-10-31 01:00:00 -0500} test clock-30.20 {clock add minutes} { set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \ -timezone :UTC] set f1 [clock add $t 60 minute -timezone :UTC] set f2 [clock add $t -60 minutes -timezone :UTC] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] list $x1 $x2 } {{2000-01-01 13:34:56} {2000-01-01 11:34:56}} test clock-30.21 {clock add minutes at DST conversion} { set t [clock scan {2004-04-04 01:00:00 -0500} \ -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 60 minutes \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] } {2004-04-04 03:00:00 -0400} test clock-30.22 {clock add minutes at DST conversion} { set t [clock scan {2004-10-31 01:00:00 -0400} \ -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 60 minutes \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] } {2004-10-31 01:00:00 -0500} test clock-30.23 {clock add seconds} { set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \ -timezone :UTC] set f1 [clock add $t 3600 second -timezone :UTC] set f2 [clock add $t -3600 seconds -timezone :UTC] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S} -timezone :UTC] list $x1 $x2 } {{2000-01-01 13:34:56} {2000-01-01 11:34:56}} test clock-30.24 {clock add seconds at DST conversion} { set t [clock scan {2004-04-04 01:00:00 -0500} \ -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 3600 seconds \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] } {2004-04-04 03:00:00 -0400} test clock-30.25 {clock add seconds at DST conversion} { set t [clock scan {2004-10-31 01:00:00 -0400} \ -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set f1 [clock add $t 3600 seconds -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] } {2004-10-31 01:00:00 -0500} test clock-31.1 {system locale} \ -constraints win \ -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } set noreg [info exists ::tcl::clock::NoRegistry] if {$noreg} {unset ::tcl::clock::NoRegistry} ::tcl::clock::ClearCaches } \ -body { clock format 0 -timezone :UTC -locale system -format %x } \ -cleanup { namespace eval ::tcl::clock { rename registry {} } if {$noreg} {set ::tcl::clock::NoRegistry {}} ::tcl::clock::ClearCaches } \ -result [clock format 0 -timezone :UTC -locale current \ -format {%d-%b-%Y}] test clock-31.2 {system locale} \ -constraints win \ -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } set noreg [info exists ::tcl::clock::NoRegistry] if {$noreg} {unset ::tcl::clock::NoRegistry} ::tcl::clock::ClearCaches } \ -body { clock format 0 -timezone :UTC -locale system -format %Ex } \ -cleanup { namespace eval ::tcl::clock { rename registry {} } if {$noreg} {set ::tcl::clock::NoRegistry {}} ::tcl::clock::ClearCaches } \ -result [clock format 0 -timezone :UTC -locale current \ -format {the %d' day of %B %Y}] test clock-31.3 {system locale} \ -constraints win \ -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } set noreg [info exists ::tcl::clock::NoRegistry] if {$noreg} {unset ::tcl::clock::NoRegistry} ::tcl::clock::ClearCaches } \ -body { clock format 0 -timezone :UTC -locale system -format %X } \ -cleanup { namespace eval ::tcl::clock { rename registry {} } if {$noreg} {set ::tcl::clock::NoRegistry {}} ::tcl::clock::ClearCaches } \ -result [clock format 0 -timezone :UTC -locale current \ -format {%l:%M:%S %p}] test clock-31.4 {system locale} \ -constraints win \ -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } set noreg [info exists ::tcl::clock::NoRegistry] if {$noreg} {unset ::tcl::clock::NoRegistry} if { [info exists env(TZ)] } { set oldTZ $env(TZ) unset env(TZ) } if { [info exists env(TCL_TZ)] } { set oldTclTZ $env(TCL_TZ) unset env(TCL_TZ) } ::tcl::clock::ClearCaches } \ -body { clock format 0 -locale system -format %x } \ -cleanup { namespace eval ::tcl::clock { rename registry {} } if { [info exists oldTclTZ] } { set env(TCL_TZ) $oldTclTZ } if { [info exists oldTZ] } { set env(TZ) $oldTZ } if {$noreg} {set ::tcl::clock::NoRegistry {}} ::tcl::clock::ClearCaches } \ -result [clock format 0 -locale current -timezone EST5 \ -format {%d-%b-%Y}] test clock-31.5 {system locale} \ -constraints win \ -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } set noreg [info exists ::tcl::clock::NoRegistry] if {$noreg} {unset ::tcl::clock::NoRegistry} if { [info exists env(TZ)] } { set oldTZ $env(TZ) unset env(TZ) } if { [info exists env(TCL_TZ)] } { set oldTclTZ $env(TCL_TZ) unset env(TCL_TZ) } ::tcl::clock::ClearCaches } \ -body { clock format 0 -locale system -format %Ex } \ -cleanup { namespace eval ::tcl::clock { rename registry {} } if {$noreg} {set ::tcl::clock::NoRegistry {}} if { [info exists oldTclTZ] } { set env(TCL_TZ) $oldTclTZ } if { [info exists oldTZ] } { set env(TZ) $oldTZ } ::tcl::clock::ClearCaches } \ -result [clock format 0 -locale current -timezone EST5 \ -format {the %d' day of %B %Y}] test clock-31.6 {system locale} \ -constraints win \ -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } set noreg [info exists ::tcl::clock::NoRegistry] if {$noreg} {unset ::tcl::clock::NoRegistry} if { [info exists env(TZ)] } { set oldTZ $env(TZ) unset env(TZ) } if { [info exists env(TCL_TZ)] } { set oldTclTZ $env(TCL_TZ) unset env(TCL_TZ) } ::tcl::clock::ClearCaches } \ -body { clock format 0 -locale system -format "%X %Z" } \ -cleanup { namespace eval ::tcl::clock { rename registry {} } if {$noreg} {set ::tcl::clock::NoRegistry {}} if { [info exists oldTclTZ] } { set env(TCL_TZ) $oldTclTZ } if { [info exists oldTZ] } { set env(TZ) $oldTZ } ::tcl::clock::ClearCaches } \ -result [clock format 0 -locale current -timezone EST5 \ -format {%l:%M:%S %p %Z}] test clock-32.1 {scan/format across the Gregorian change} { set problems {} set t [expr { wide(-6857395200) }] foreach d { 1 2 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 } \ j { 245 246 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 } { set u [format 1752-09-%02d $d] set s [clock format $t -format %Y-%m-%d \ -locale en_US_roman -timezone :UTC] if { $s ne $u } { append problems "formatting $t: $s should be $u\n" } set v [clock scan $u -format %Y-%m-%d \ -locale en_US_roman -timezone :UTC] if { $t ne $v } { append problems "scanning $u: $t should be $v\n" } set u [format 1752-%03d $j] set s [clock format $t -format %Y-%j \ -locale en_US_roman -timezone :UTC] if { $s ne $u } { append problems "formatting $t: $s should be $u\n" } set v [clock scan $u -format %Y-%j \ -locale en_US_roman -timezone :UTC] if { $t ne $v } { append problems "scanning $u: $t should be $v\n" } incr t 86400 } set problems } {} # Legacy tests # clock clicks test clock-33.1 {clock clicks tests} { expr {[clock clicks] + 1} concat {} } {} test clock-33.2 {clock clicks tests} { set start [clock clicks] after 10 set end [clock clicks] expr {$end > $start} } {1} test clock-33.3 {clock clicks tests} { list [catch {clock clicks foo} msg] $msg } {1 {bad option "foo": must be -milliseconds or -microseconds}} test clock-33.4 {clock clicks tests} { expr {[clock clicks -milliseconds] + 1} concat {} } {} test clock-33.4a {clock milliseconds} { expr { [clock milliseconds] + 1 } concat {} } {} test clock-33.5 {clock clicks tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. if {[lindex [timerate { set start [clock clicks -milli] timerate {} 10; # short but precise busy wait set end [clock clicks -milli] } 1 1] 0] > 60000} { ::tcltest::Skip "timing issue" } # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end > $start) && (($end - $start) <= 60) ? "ok" : "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} test clock-33.5a {clock tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. if {[lindex [timerate { set start [clock milliseconds] timerate {} 10; # short but precise busy wait set end [clock milliseconds] } 1 1] 0] > 60000} { ::tcltest::Skip "timing issue" } # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end > $start) && (($end - $start) <= 60) ? "ok" : "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} test clock-33.6 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks ? } msg] $msg } {1 {bad option "?": must be -milliseconds or -microseconds}} test clock-33.7 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks - } msg] $msg } {1 {ambiguous option "-": must be -milliseconds or -microseconds}} test clock-33.8 {clock clicks test, microsecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. if {[lindex [timerate { set start [clock clicks -micro] timerate {} 10; # short but precise busy wait set end [clock clicks -micro] } 1 1] 0] > 60000} { ::tcltest::Skip "timing issue" } expr {($end > $start) && (($end - $start) <= 60000)} } {1} test clock-33.8a {clock test, microsecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. if {[lindex [timerate { set start [clock microseconds] timerate {} 10; # short but precise busy wait set end [clock microseconds] } 1 1] 0] > 60000} { ::tcltest::Skip "timing issue" } expr {($end > $start) && (($end - $start) <= 60000)} } {1} test clock-33.9 {clock clicks test, millis align with seconds} { set t1 [clock seconds] while { 1 } { set t2 [clock clicks -millis] set t3 [clock seconds] if { $t3 == $t1 } break set t1 $t3 } expr { $t2 / 1000 == $t3 } } {1} test clock-33.9a {clock test, millis align with seconds} { set t1 [clock seconds] while { 1 } { set t2 [clock milliseconds] set t3 [clock seconds] if { $t3 == $t1 } break set t1 $t3 } expr { $t2 / 1000 == $t3 } } {1} test clock-33.10 {clock clicks test, micros align with seconds} { set t1 [clock seconds] while { 1 } { set t2 [clock clicks -micros] set t3 [clock seconds] if { $t3 == $t1 } break set t1 $t3 } expr { $t2 / 1000000 == $t3 } } {1} test clock-33.10a {clock test, micros align with seconds} { set t1 [clock seconds] while { 1 } { set t2 [clock microseconds] set t3 [clock seconds] if { $t3 == $t1 } break set t1 $t3 } expr { $t2 / 1000000 == $t3 } } {1} test clock-33.11 {clock clicks test, millis align with micros} { set t1 [clock clicks -millis] while { 1 } { set t2 [clock clicks -micros] set t3 [clock clicks -millis] if { $t3 == $t1 } break set t1 $t3 } expr { $t2 / 1000 == $t3 } } {1} test clock-33.11a {clock test, millis align with micros} { set t1 [clock milliseconds] while { 1 } { set t2 [clock microseconds] set t3 [clock milliseconds] if { $t3 == $t1 } break set t1 $t3 } expr { $t2 / 1000 == $t3 } } {1} # clock scan test clock-34.1 {clock scan tests} { list [catch {clock scan} msg] $msg } {1 {wrong # args: should be "clock scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}} test clock-34.2 {clock scan tests} {*}{ -body {clock scan "bad-string"} -returnCodes error -match glob -result {unable to convert date-time string "bad-string"*} } test clock-34.3 {clock scan tests} { clock format [clock scan "14 Feb 92" -gmt true] \ -format {%m/%d/%y %I:%M:%S %p} -gmt true } {02/14/92 12:00:00 AM} test clock-34.4 {clock scan tests} { clock format [clock scan "Feb 14, 1992 12:20 PM" -gmt true] \ -format {%m/%d/%y %I:%M:%S %p} -gmt true } {02/14/92 12:20:00 PM} test clock-34.5 {clock scan tests} { clock format \ [clock scan "Feb 14, 1992 12:20 PM" -base 319363200 -gmt true] \ -format {%m/%d/%y %I:%M:%S %p} -gmt true } {02/14/92 12:20:00 PM} test clock-34.6 {clock scan tests} { set time [clock scan "Oct 23,1992 15:00"] clock format $time -format {%b %d,%Y %H:%M} } {Oct 23,1992 15:00} test clock-34.7 {clock scan tests} { set time [clock scan "Oct 23,1992 15:00 GMT"] clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true } {Oct 23,1992 15:00 GMT} test clock-34.8 {clock scan tests} { set time [clock scan "Oct 23,1992 15:00" -gmt true] clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true } {Oct 23,1992 15:00 GMT} test clock-34.9 {clock scan tests} { list [catch {clock scan "Jan 12" -bad arg} msg] $msg } {1 {bad option "-bad", must be -base, -format, -gmt, -locale or -timezone}} # The following two two tests test the two year date policy test clock-34.10 {clock scan tests} { set time [clock scan "1/1/71" -gmt true] clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true } {Jan 01,1971 00:00 GMT} test clock-34.11 {clock scan tests} { set time [clock scan "1/1/37" -gmt true] clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true } {Jan 01,2037 00:00 GMT} test clock-34.12 {clock scan, relative times} { set time [clock scan "Oct 23, 1992 -1 day"] clock format $time -format {%b %d, %Y} } "Oct 22, 1992" test clock-34.13 {clock scan, ISO 8601 base date format} { set time [clock scan "19921023"] clock format $time -format {%b %d, %Y} } "Oct 23, 1992" test clock-34.14 {clock scan, ISO 8601 expanded date format} { set time [clock scan "1992-10-23"] clock format $time -format {%b %d, %Y} } "Oct 23, 1992" test clock-34.15 {clock scan, DD-Mon-YYYY format} { set time [clock scan "23-Oct-1992"] clock format $time -format {%b %d, %Y} } "Oct 23, 1992" test clock-34.16 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T235959"] clock format $time -format {%b %d, %Y %H:%M:%S} } "Oct 23, 1992 23:59:59" test clock-34.17 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023 235959"] clock format $time -format {%b %d, %Y %H:%M:%S} } "Oct 23, 1992 23:59:59" test clock-34.18 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T000000"] clock format $time -format {%b %d, %Y %H:%M:%S} } "Oct 23, 1992 00:00:00" # CLOCK SCAN REAL TESTS # We use 5am PST, 31-12-1999 as the base for these scans because irrespective # of your local timezone it should always give us times on December 31, 1999 set 5amPST 946645200 test clock-34.19 {clock scan, number meridian} { set t1 [clock scan "5 am" -base $5amPST -gmt true] set t2 [clock scan "5 pm" -base $5amPST -gmt true] set t3 [clock scan "5 a.m." -base $5amPST -gmt true] set t4 [clock scan "5 p.m." -base $5amPST -gmt true] list \ [clock format $t1 -format {%b %d, %Y %H:%M:%S} -gmt true] \ [clock format $t2 -format {%b %d, %Y %H:%M:%S} -gmt true] \ [clock format $t3 -format {%b %d, %Y %H:%M:%S} -gmt true] \ [clock format $t4 -format {%b %d, %Y %H:%M:%S} -gmt true] } [list "Dec 31, 1999 05:00:00" "Dec 31, 1999 17:00:00" \ "Dec 31, 1999 05:00:00" "Dec 31, 1999 17:00:00"] test clock-34.20 {clock scan, number:number meridian} { clock format [clock scan "5:30 pm" -base $5amPST -gmt true] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 17:30:00" test clock-34.21 {clock scan, number:number-timezone} { clock format [clock scan "00:00-0800" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 08:00:00" test clock-34.22 {clock scan, number:number:number o_merid} { clock format [clock scan "8:00:00" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 08:00:00" test clock-34.23 {clock scan, number:number:number o_merid} { clock format [clock scan "8:00:00 am" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 08:00:00" test clock-34.24 {clock scan, number:number:number o_merid} { clock format [clock scan "8:00:00 pm" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 20:00:00" test clock-34.25 {clock scan, number:number:number-timezone} { clock format [clock scan "00:00:30-0800" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 08:00:30" test clock-34.26 {clock scan, DST for days} { clock scan "tomorrow" -base [clock scan "19991031 00:00:00"] } [clock scan "19991101 00:00:00"] test clock-34.27 {clock scan, DST for days} { clock scan "yesterday" -base [clock scan "19991101 00:00:00"] } [clock scan "19991031 00:00:00"] test clock-34.28 {clock scan, day} { clock format [clock scan "Monday" -gmt true -base 946627200] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Jan 03, 2000 00:00:00" test clock-34.29 {clock scan, number/number} { clock format [clock scan "1/1" -gmt true -base 946627200] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Jan 01, 1999 00:00:00" test clock-34.30 {clock scan, number/number} { clock format [clock scan "1/1/1999" -gmt true -base 946627200] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Jan 01, 1999 00:00:00" test clock-34.31 {clock scan, number/number} { clock format [clock scan "19990101" -gmt true -base 946627200] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Jan 01, 1999 00:00:00" test clock-34.32 {clock scan, relative minutes} { clock scan "now + 1 minute" -base 946627200 } 946627260 test clock-34.33 {clock scan, relative minutes} { clock scan "now +1 minute" -base 946627200 } 946627260 test clock-34.34 {clock scan, relative minutes} { clock scan "now 1 minute" -base 946627200 } 946627260 test clock-34.35 {clock scan, relative minutes} { clock scan "now - 1 minute" -base 946627200 } 946627140 test clock-34.36 {clock scan, relative minutes} { clock scan "now -1 minute" -base 946627200 } 946627140 test clock-34.37 {clock scan, day of week} { clock format [clock scan "wednesday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 12, 2000" test clock-34.38 {clock scan, next day of week} { clock format [clock scan "next wednesday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 19, 2000" test clock-34.39 {clock scan, day of week} { clock format [clock scan "thursday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 13, 2000" test clock-34.40 {clock scan, next day of week} { clock format [clock scan "next thursday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 20, 2000" # weekday specification and base. test clock-34.41 {2nd monday in november} { set res {} foreach i {91 92 93 94 95 96} { set nov8th [clock scan 11/8/$i] set monday [clock scan monday -base $nov8th] lappend res [clock format $monday -format %Y-%m-%d] } set res } {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11} test clock-34.42 {2nd monday in november (2nd try)} { set res {} foreach i {91 92 93 94 95 96} { set nov1th [clock scan 11/1/$i] set monday [clock scan "2 monday" -base $nov1th] lappend res [clock format $monday -format %Y-%m-%d] } set res } {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11} test clock-34.43 {last monday in november} { set res {} foreach i {91 92 93 94 95 96} { set dec1th [clock scan 12/1/$i] set monday [clock scan "monday 1 week ago" -base $dec1th] lappend res [clock format $monday -format %Y-%m-%d] } set res } {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25} test clock-34.44 {2nd monday in november} { set res {} foreach i {91 92 93 94 95 96} { set nov8th [clock scan 11/8/$i -gmt 1] set monday [clock scan monday -base $nov8th -gmt 1] lappend res [clock format $monday -format %Y-%m-%d -gmt 1] } set res } {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11} test clock-34.45 {2nd monday in november (2nd try)} { set res {} foreach i {91 92 93 94 95 96} { set nov1th [clock scan 11/1/$i -gmt 1] set monday [clock scan "2 monday" -base $nov1th -gmt 1] lappend res [clock format $monday -format %Y-%m-%d -gmt 1] } set res } {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11} test clock-34.46 {last monday in november} { set res {} foreach i {91 92 93 94 95 96} { set dec1th [clock scan 12/1/$i -gmt 1] set monday [clock scan "monday 1 week ago" -base $dec1th -gmt 1] lappend res [clock format $monday -format %Y-%m-%d -gmt 1] } set res } {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25} test clock-34.47 {ago with multiple relative units} { set base [clock scan "12/31/1999 00:00:00"] set res [clock scan "2 days 2 hours ago" -base $base] expr {$base - $res} } 180000 test clock-34.48 {more than one ToD} {*}{ -body {clock scan {10:00 11:00}} -returnCodes error -result {unable to convert date-time string "10:00 11:00": more than one time of day in string} } test clock-34.49 {more than one date} {*}{ -body {clock scan {1/1/2001 2/2/2002}} -returnCodes error -result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string} } test clock-34.50 {more than one time zone} {*}{ -body {clock scan {10:00 EST CST}} -returnCodes error -result {unable to convert date-time string "10:00 EST CST": more than one time zone in string} } test clock-34.51 {more than one weekday} {*}{ -body {clock scan {Monday Tuesday}} -returnCodes error -result {unable to convert date-time string "Monday Tuesday": more than one weekday in string} } test clock-34.52 {more than one ordinal month} {*}{ -body {clock scan {next January next March}} -returnCodes error -result {unable to convert date-time string "next January next March": more than one ordinal month in string} } test clock-34.53 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T00:00:00"] clock format $time -format {%b %d, %Y %H:%M:%S} } "Oct 23, 1992 00:00:00" test clock-34.54 {clock scan, ISO 8601 point in time format} { set time [clock scan "1992-10-23T00:00:00"] clock format $time -format {%b %d, %Y %H:%M:%S} } "Oct 23, 1992 00:00:00" test clock-34.55 {clock scan, ISO 8601 invalid TZ} -body { set time [clock scan "19921023MST000000"] clock format $time -format {%b %d, %Y %H:%M:%S} } -returnCodes error -match glob -result {unable to convert date-time string*} test clock-34.56 {clock scan, ISO 8601 invalid TZ} -body { set time [clock scan "19921023M000000"] clock format $time -format {%b %d, %Y %H:%M:%S} } -returnCodes error -match glob -result {unable to convert date-time string*} test clock-34.57 {clock scan, ISO 8601 invalid TZ} -body { set time [clock scan "1992-10-23M00:00:00"] clock format $time -format {%b %d, %Y %H:%M:%S} } -returnCodes error -match glob -result {unable to convert date-time string*} test clock-34.58 {clock scan, ISO 8601 invalid TZ} -body { set time [clock scan "1992-10-23MST00:00:00"] clock format $time -format {%b %d, %Y %H:%M:%S} } -returnCodes error -match glob -result {unable to convert date-time string*} test clock-34.59 {clock scan tests (-TZ)} { set time [clock scan "31 Jan 14 23:59:59 -0100"] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Feb 01,2014 00:59:59 GMT} test clock-34.60 {clock scan tests (+TZ)} { set time [clock scan "31 Jan 14 23:59:59 +0100"] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 31,2014 22:59:59 GMT} test clock-34.61 {clock scan tests (-TZ)} { set time [clock scan "23:59:59 -0100" -base 0 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 02,1970 00:59:59 GMT} test clock-34.62 {clock scan tests (+TZ)} { set time [clock scan "23:59:59 +0100" -base 0 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 01,1970 22:59:59 GMT} test clock-34.63 {clock scan tests (TZ)} { set time [clock scan "Mon, 30 Jun 2014 23:59:59 CEST"] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jun 30,2014 21:59:59 GMT} test clock-34.64 {clock scan tests (TZ)} { set time [clock scan "Fri, 31 Jan 2014 23:59:59 CET"] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 31,2014 22:59:59 GMT} test clock-34.65 {clock scan tests (relspec, day unit not TZ)} { set time [clock scan "23:59:59 +15 day" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Feb 08,1970 23:59:59 GMT} test clock-34.66 {clock scan tests (relspec, day unit not TZ)} { set time [clock scan "23:59:59 -15 day" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 09,1970 23:59:59 GMT} test clock-34.67 {clock scan tests (merid and TZ)} { set time [clock scan "10:59 pm CET" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 24,1970 21:59:00 GMT} test clock-34.68 {clock scan tests (merid and TZ)} { set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 24,1970 21:59:00 GMT} # clock seconds test clock-35.1 {clock seconds tests} { expr {[clock seconds] + 1} concat {} } {} test clock-35.2 {clock seconds tests} { list [catch {clock seconds foo} msg] $msg } {1 {wrong # args: should be "clock seconds"}} test clock-35.3 {clock seconds tests} { set start [clock seconds] after 2000 set end [clock seconds] expr {$end > $start} } {1} test clock-36.1 {clock scan next monthname} { clock format [clock scan "next june" -base [clock scan "june 1, 2000"]] \ -format %m.%Y } "06.2001" test clock-36.2 {clock scan next monthname} { clock format [clock scan "next july" -base [clock scan "june 1, 2000"]] \ -format %m.%Y } "07.2000" test clock-36.3 {clock scan next monthname} { clock format [clock scan "next may" -base [clock scan "june 1, 2000"]] \ -format %m.%Y } "05.2001" test clock-37.1 {%s gmt testing} { set s [clock seconds] set a [clock format $s -format %s -gmt 0] set b [clock format $s -format %s -gmt 1] # %s, being the difference between local and Greenwich, does not # depend on the time zone. set c [expr {$b-$a}] } {0} test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \ -setup { if { [info exists env(TZ)] } { set oldTZ $env(TZ) } set env(TZ) CET-01:00CEST-02:00,M3.5.0/02:00,M10.5.0/03:00 } \ -body { clock format 0 -format %H:%M:%S -timezone :localtime } \ -cleanup { if { [info exists oldTZ] } { set env(TZ) $oldTZ unset oldTZ } else { unset env(TZ) } } \ -result {01:00:00} test clock-38.2 {make sure TZ is not cached after unset} \ -setup { if { [info exists env(TZ)] } { set oldTZ $env(TZ) unset env(TZ) } if { [info exists env(TCL_TZ)] } { set oldTCLTZ $env(TCL_TZ) unset env(TCL_TZ) } } \ -body { set t1 [clock format 0] # a time zone that is unlikely to anywhere set env(TZ) "+04:20" set t2 [clock format 0] unset env(TZ) set t3 [clock format 0] expr {$t1 eq $t3 && $t1 ne $t2} } \ -cleanup { if { [info exists oldTZ] } { set env(TZ) $oldTZ unset oldTZ } if { [info exists oldTclTZ] } { set env(TCL_TZ) $oldTclTZ unset oldTclTZ } } \ -result 1 test clock-39.1 {regression - synonym timezones} { clock format 0 -format {%H:%M:%S} -timezone :US/Eastern } {19:00:00} test clock-40.1 {regression - bad month with -timezone :localtime} \ -setup { if { [info exists env(TZ)] } { set oldTZ $env(TZ) } set env(TZ) UTC0 } \ -body { clock scan 2000-01-01T00:00:00 -timezone :localtime \ -format %Y-%m-%dT%H:%M:%S } \ -cleanup { if { [info exists oldTZ] } { set env(TZ) $oldTZ unset oldTZ } else { unset env(TZ) } } \ -result 946684800 test clock-41.1 {regression test - format group %k when hour is 0 } { clock format 0 -format %k -gmt true } { 0} test clock-42.1 {regression test - %z in :localtime when west of Greenwich } \ -setup { if { [info exists env(TZ)] } { set oldTZ $env(TZ) } set env(TZ) EST5 } \ -body { clock format 0 -format %z -timezone :localtime } \ -cleanup { if { [info exists oldTZ] } { set env(TZ) $oldTZ unset oldTZ } else { unset env(TZ) } } \ -result {-0500} # 43.1 was a bad test - mktime returning -1 is an error according to Posix. test clock-44.1 {regression test - time zone name containing hyphen } \ -setup { if { [info exists env(TZ)] } { set oldTZ $env(TZ) } set env(TZ) US/East-Indiana } \ -body { clock format 1098466496 -format %H:%M:%S%z -timezone US/East-Indiana } \ -cleanup { if { [info exists oldTZ] } { set env(TZ) $oldTZ unset oldTZ } else { unset env(TZ) } } \ -result {12:34:56-0500} test clock-45.1 {regression test - time zone containing only two digits} \ -body { clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z } \ -result 482134530 test clock-46.1 {regression test - month zero} \ -body { clock scan 2004-00-00 -format %Y-%m-%d } -result [clock scan 2003-11-30 -format %Y-%m-%d] test clock-46.2 {regression test - month zero} \ -body { clock scan 20040000 } -result [clock scan 2003-11-30 -format %Y-%m-%d] test clock-46.3 {regression test - month thirteen} \ -body { clock scan 2004-13-01 -format %Y-%m-%d } -result [clock scan 2005-01-01 -format %Y-%m-%d] test clock-46.4 {regression test - month thirteen} \ -body { clock scan 20041301 } -result [clock scan 2005-01-01 -format %Y-%m-%d] test clock-47.1 {regression test - four-digit time} { clock scan 0012 } [clock scan 0012 -format %H%M] test clock-47.2 {regression test - four digit time} { clock scan 0039 } [clock scan 0039 -format %H%M] test clock-48.1 {Bug 1185933: 'i' destroyed by clock init} -setup { interp create child } -body { interp eval child { set i 12345 clock format 0 list [catch { set i } result] $result } } -cleanup { interp delete child } -result {0 12345} test clock-49.1 {regression test - localtime with negative arg (Bug 1237907)} \ -body { list [catch { clock format -86400 -timezone :localtime -format %Y } result] $result } \ -match regexp \ -result {0 1969|1 {localtime failed \(clock value may be too large/small to represent\)}} test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \ -constraints win \ -setup { # override the registry so that the test takes place in New York time namespace eval ::tcl::clock { namespace import -force ::testClock::registry } set noreg [info exists ::tcl::clock::NoRegistry] if {$noreg} {unset ::tcl::clock::NoRegistry} if { [info exists env(TZ)] } { set oldTZ $env(TZ) unset env(TZ) } if { [info exists env(TCL_TZ)] } { set oldTclTZ $env(TCL_TZ) unset env(TCL_TZ) } # make it so New York time is a missing file dict set ::tcl::clock::WinZoneInfo \ {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \ :No/Such/File ::tcl::clock::ClearCaches } \ -body { list [::tcl::clock::GuessWindowsTimeZone] \ [clock format 0 -locale system -format "%H:%M:%S %Z"] \ [clock format -86400 -format "%Y"] } \ -cleanup { # restore the registry and environment namespace eval ::tcl::clock { rename registry {} } if {$noreg} {set ::tcl::clock::NoRegistry {}} if { [info exists oldTclTZ] } { set env(TCL_TZ) $oldTclTZ } if { [info exists oldTZ] } { set env(TZ) $oldTZ } # put New York back on the map dict set ::tcl::clock::WinZoneInfo \ {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \ :America/New_York ::tcl::clock::ClearCaches } \ -result {<-0500>+05:00:00<-0400>+04:00:00,M3.2.0/02:00:00,M11.1.0/02:00:00 {19:00:00 -0500} 1969} test clock-50.1 {format / scan -1 as a local time} { if {[catch { clock scan \ [clock format -1 -format %Y%m%d%H%M%S -timezone :localtime] \ -format %Y%m%d%H%M%S -timezone :localtime } result]} { if { [regexp " too large" $result] } { set result -1 } } set result } -1 test clock-50.2 {format / scan -2 as a local time} { if {[catch { clock scan \ [clock format -2 -format %Y%m%d%H%M%S -timezone :localtime] \ -format %Y%m%d%H%M%S -timezone :localtime } result]} { if { [regexp " too large" $result] } { set result -2 } } set result } -2 test clock-51.1 {correct conversion of times in Sydney} { # Paul Mackerras reported a bug where DST rollover in New South Wales # was miscalculated. The problem was that tclZIC.tcl had a # typo in the switch case where DST begins/ends at a given time # Standard Time (that is, winter time). set result {} foreach t {1130601599 1130601600 1130637599 1130637600} { lappend result [clock format $t -format %H:%M:%S \ -timezone :Australia/Sydney] } set result } {01:59:59 03:00:00 12:59:59 13:00:00} test clock-52.1 {Posix timezone and conversion on last Sunday} { # Martin Lemburg reported a bug where if tzdata is missing, then # times are converted incorrectly in locales where DST conversion # happens in the last (nominal 5th) week of a month. set result {} set timezone -01:00:00-02:00:00,M3.5.0/02:00:00,M10.5.0/01:00:00 foreach t {1143334799 1143334800} { lappend result [clock format $t -format %H:%M:%S -timezone $timezone] \ [clock format $t -format %H:%M:%S -timezone :Europe/Berlin] } set result } {01:59:59 01:59:59 03:00:00 03:00:00} test clock-52.2 {correct conversion of times in Europe} { # [Bug 2207436] set result {} foreach t [list 1206838799 1206838800 1224982799 1224982800] { lappend result [clock format $t -format %H:%M:%S \ -timezone MET-1METDST] lappend result [clock format $t -format %H:%M:%S \ -timezone MET0METDST] } set result } {01:59:59 00:59:59 03:00:00 02:00:00 02:59:59 01:59:59 02:00:00 01:00:00} test clock-52.3 {correct conversion of times in Russia} { # [Bug 2207436] set result {} foreach t [list 1206799199 1206799200 1224943199 1224943200] { lappend result [clock format $t -format %H:%M:%S \ -timezone WST-12WSTDST] } set result } {01:59:59 03:00:00 02:59:59 02:00:00} test clock-52.4 {correct conversion of times in USA} { # [Bug 2207436] set result {} foreach t [list 1268549999 1268550000 1257055199 1257055200] { lappend result [clock format $t -format %H:%M:%S \ -timezone EST5EDT] } set result } {01:59:59 03:00:00 01:59:59 01:00:00} # Regression test for Bug # 1505383 test clock-53.1 {%EC %Ey} { clock format 0 -gmt true -locale en_US_roman -format %EC%Ey } mcmlxx # Test that glob-special characters can be handled in [clock] test clock-54.1 {glob specials in [clock format]} \ -setup { clock format 0 -gmt 1 -format %Y } \ -body { clock format 0 -gmt 1 -format {*[%Y%m%d]*} } \ -result {*[19700101]*} test clock-54.2 {glob specials in [clock scan]} \ -setup { clock scan 1970 -gmt 1 -format %Y } \ -body { clock scan {*[19700101]*} -format {*[%Y%m%d]*} -gmt 1 } \ -result 0 test clock-55.1 {Common Era} { clock format -62135769600 -gmt 1 -format {%d %m %Y %EE} } {01 01 0001 C.E.} test clock-55.2 {Common Era} { clock format -62135769600 -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman } {01 01 0001 Anno Domini} test clock-55.3 {Before the Common Era} { clock format -62135769601 -gmt 1 -format {%d %m %Y %EE} } {31 12 0001 B.C.E.} test clock-55.4 {Before the Common Era} { clock format -62135769601 -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman } {31 12 0001 Before Christ} test clock-55.5 {Common Era} { clock scan {01 01 0001 C.E.} \ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman } -62135769600 test clock-55.6 {Common Era} { clock scan {01 01 0001 A.D.} \ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman } -62135769600 test clock-55.7 {Common Era} { clock scan {01 01 0001 Anno Domini} \ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman } -62135769600 test clock-55.8 {Before the Common Era} { clock scan {31 12 0001 B.C.E.} \ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman } -62135856000 test clock-55.9 {Common Era} { clock scan {31 12 0001 B.C.} \ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman } -62135856000 test clock-55.10 {Common Era} { clock scan {31 12 0001 Before Christ} \ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman } -62135856000 test clock-56.1 {use of zoneinfo, version 1} {*}{ -setup { clock format [clock seconds] set tzdir [makeDirectory zoneinfo] set tzdir2 [makeDirectory Test $tzdir] set tzfile [makeFile {} PhoenixOne $tzdir2] set f [open $tzfile wb] puts -nonewline $f [binary format c* { 0x54 0x5a 0x69 0x66 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x0c 0x9e 0xa6 0x3a 0x90 0x9f 0xbb 0x07 0x80 0xa0 0x86 0x1c 0x90 0xa1 0x9a 0xe9 0x80 0xcb 0x89 0x0c 0x90 0xcf 0x17 0xdf 0x1c 0xcf 0x8f 0xe5 0xac 0xd0 0x81 0x1a 0x1c 0xfa 0xf8 0x75 0x10 0xfb 0xe8 0x58 0x00 0x00 0x01 0x00 0x01 0x02 0x01 0x02 0x01 0x00 0x01 0xff 0xff 0xab 0xa0 0x01 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff 0xab 0xa0 0x01 0x08 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00 0x4d 0x57 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00 }] close $f set ::tcl::clock::ZoneinfoPaths \ [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir] ::tcl::clock::ClearCaches } -cleanup { set ::tcl::clock::ZoneinfoPaths \ [lrange $::tcl::clock::ZoneinfoPaths 1 end] ::tcl::clock::ClearCaches removeFile PhoenixOne $tzdir2 removeDirectory Test $tzdir removeDirectory zoneinfo } -body { clock format 1072940400 -timezone :Test/PhoenixOne \ -format {%Y-%m-%d %H:%M:%S %Z} } -result {2004-01-01 00:00:00 MST} } test clock-56.2 {use of zoneinfo, version 2} {*}{ -setup { clock format [clock seconds] set tzdir [makeDirectory zoneinfo] set tzdir2 [makeDirectory Test $tzdir] set tzfile [makeFile {} PhoenixTwo $tzdir2] set f [open $tzfile wb] puts -nonewline $f [binary format c* { 0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x0c 0x9e 0xa6 0x3a 0x90 0x9f 0xbb 0x07 0x80 0xa0 0x86 0x1c 0x90 0xa1 0x9a 0xe9 0x80 0xcb 0x89 0x0c 0x90 0xcf 0x17 0xdf 0x1c 0xcf 0x8f 0xe5 0xac 0xd0 0x81 0x1a 0x1c 0xfa 0xf8 0x75 0x10 0xfb 0xe8 0x58 0x00 0x00 0x01 0x00 0x01 0x02 0x01 0x02 0x01 0x00 0x01 0xff 0xff 0xab 0xa0 0x01 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff 0xab 0xa0 0x01 0x08 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00 0x4d 0x57 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x04 0x00 0x00 0x00 0x04 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0b 0x00 0x00 0x00 0x04 0x00 0x00 0x00 0x10 0xff 0xff 0xff 0xff 0x5e 0x04 0x0c 0xb0 0xff 0xff 0xff 0xff 0x9e 0xa6 0x3a 0x90 0xff 0xff 0xff 0xff 0x9f 0xbb 0x07 0x80 0xff 0xff 0xff 0xff 0xa0 0x86 0x1c 0x90 0xff 0xff 0xff 0xff 0xa1 0x9a 0xe9 0x80 0xff 0xff 0xff 0xff 0xcb 0x89 0x0c 0x90 0xff 0xff 0xff 0xff 0xcf 0x17 0xdf 0x1c 0xff 0xff 0xff 0xff 0xcf 0x8f 0xe5 0xac 0xff 0xff 0xff 0xff 0xd0 0x81 0x1a 0x1c 0xff 0xff 0xff 0xff 0xfa 0xf8 0x75 0x10 0xff 0xff 0xff 0xff 0xfb 0xe8 0x58 0x00 0x02 0x01 0x02 0x01 0x02 0x03 0x02 0x03 0x02 0x01 0x02 0xff 0xff 0x96 0xee 0x00 0x00 0xff 0xff 0xab 0xa0 0x01 0x04 0xff 0xff 0x9d 0x90 0x00 0x08 0xff 0xff 0xab 0xa0 0x01 0x0c 0x4c 0x4d 0x54 0x00 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00 0x4d 0x57 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x4d 0x53 0x54 0x37 0x0a }] close $f set ::tcl::clock::ZoneinfoPaths \ [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir] ::tcl::clock::ClearCaches } -cleanup { set ::tcl::clock::ZoneinfoPaths \ [lrange $::tcl::clock::ZoneinfoPaths 1 end] ::tcl::clock::ClearCaches removeFile PhoenixTwo $tzdir2 removeDirectory Test $tzdir removeDirectory zoneinfo } -body { clock format 1072940400 -timezone :Test/PhoenixTwo \ -format {%Y-%m-%d %H:%M:%S %Z} } -result {2004-01-01 00:00:00 MST} } test clock-56.3 {use of zoneinfo, version 2, Y2038 compliance} {*}{ -setup { clock format [clock seconds] set tzdir [makeDirectory zoneinfo] set tzdir2 [makeDirectory Test $tzdir] set tzfile [makeFile {} TijuanaTwo $tzdir2] set f [open $tzfile wb] puts -nonewline $f [binary format c* { 0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x95 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x18 0xa5 0xb6 0xf6 0x80 0xa9 0x79 0x4f 0x70 0xaf 0xf2 0x7c 0xf0 0xb6 0x66 0x64 0x70 0xb7 0x1b 0x10 0x00 0xb8 0x0a 0xf2 0xf0 0xcb 0xea 0x8d 0x80 0xd2 0x23 0xf4 0x70 0xd2 0x99 0xba 0x70 0xd7 0x1b 0x59 0x00 0xd8 0x91 0xb4 0xf0 0xe2 0x7e 0x59 0xa0 0xe3 0x49 0x52 0x90 0xe4 0x5e 0x3b 0xa0 0xe5 0x29 0x34 0x90 0xe6 0x47 0x58 0x20 0xe7 0x12 0x51 0x10 0xe8 0x27 0x3a 0x20 0xe8 0xf2 0x33 0x10 0xea 0x07 0x1c 0x20 0xea 0xd2 0x15 0x10 0xeb 0xe6 0xfe 0x20 0xec 0xb1 0xf7 0x10 0xed 0xc6 0xe0 0x20 0xee 0x91 0xd9 0x10 0x0b 0xe0 0xaf 0xa0 0x0c 0xd9 0xcd 0x10 0x0d 0xc0 0x91 0xa0 0x0e 0xb9 0xaf 0x10 0x0f 0xa9 0xae 0x20 0x10 0x99 0x91 0x10 0x11 0x89 0x90 0x20 0x12 0x79 0x73 0x10 0x13 0x69 0x72 0x20 0x14 0x59 0x55 0x10 0x15 0x49 0x54 0x20 0x16 0x39 0x37 0x10 0x17 0x29 0x36 0x20 0x18 0x22 0x53 0x90 0x19 0x09 0x18 0x20 0x1a 0x02 0x35 0x90 0x1a 0xf2 0x34 0xa0 0x1b 0xe2 0x17 0x90 0x1c 0xd2 0x16 0xa0 0x1d 0xc1 0xf9 0x90 0x1e 0xb1 0xf8 0xa0 0x1f 0xa1 0xdb 0x90 0x20 0x76 0x2b 0x20 0x21 0x81 0xbd 0x90 0x22 0x56 0x0d 0x20 0x23 0x6a 0xda 0x10 0x24 0x35 0xef 0x20 0x25 0x4a 0xbc 0x10 0x26 0x15 0xd1 0x20 0x27 0x2a 0x9e 0x10 0x27 0xfe 0xed 0xa0 0x29 0x0a 0x80 0x10 0x29 0xde 0xcf 0xa0 0x2a 0xea 0x62 0x10 0x2b 0xbe 0xb1 0xa0 0x2c 0xd3 0x7e 0x90 0x2d 0x9e 0x93 0xa0 0x2e 0xb3 0x60 0x90 0x2f 0x7e 0x75 0xa0 0x30 0x93 0x42 0x90 0x31 0x67 0x92 0x20 0x32 0x73 0x24 0x90 0x33 0x47 0x74 0x20 0x34 0x53 0x06 0x90 0x35 0x27 0x56 0x20 0x36 0x32 0xe8 0x90 0x37 0x07 0x38 0x20 0x38 0x1c 0x05 0x10 0x38 0xe7 0x1a 0x20 0x39 0xfb 0xe7 0x10 0x3a 0xc6 0xfc 0x20 0x3b 0xdb 0xc9 0x10 0x3c 0xb0 0x18 0xa0 0x3d 0xbb 0xab 0x10 0x3e 0x8f 0xfa 0xa0 0x3f 0x9b 0x8d 0x10 0x40 0x6f 0xdc 0xa0 0x41 0x84 0xa9 0x90 0x42 0x4f 0xbe 0xa0 0x43 0x64 0x8b 0x90 0x44 0x2f 0xa0 0xa0 0x45 0x44 0x6d 0x90 0x46 0x0f 0x82 0xa0 0x47 0x24 0x4f 0x90 0x47 0xf8 0x9f 0x20 0x49 0x04 0x31 0x90 0x49 0xd8 0x81 0x20 0x4a 0xe4 0x13 0x90 0x4b 0xb8 0x63 0x20 0x4c 0xcd 0x30 0x10 0x4d 0x98 0x45 0x20 0x4e 0xad 0x12 0x10 0x4f 0x78 0x27 0x20 0x50 0x8c 0xf4 0x10 0x51 0x61 0x43 0xa0 0x52 0x6c 0xd6 0x10 0x53 0x41 0x25 0xa0 0x54 0x4c 0xb8 0x10 0x55 0x21 0x07 0xa0 0x56 0x2c 0x9a 0x10 0x57 0x00 0xe9 0xa0 0x58 0x15 0xb6 0x90 0x58 0xe0 0xcb 0xa0 0x59 0xf5 0x98 0x90 0x5a 0xc0 0xad 0xa0 0x5b 0xd5 0x7a 0x90 0x5c 0xa9 0xca 0x20 0x5d 0xb5 0x5c 0x90 0x5e 0x89 0xac 0x20 0x5f 0x95 0x3e 0x90 0x60 0x69 0x8e 0x20 0x61 0x7e 0x5b 0x10 0x62 0x49 0x70 0x20 0x63 0x5e 0x3d 0x10 0x64 0x29 0x52 0x20 0x65 0x3e 0x1f 0x10 0x66 0x12 0x6e 0xa0 0x67 0x1e 0x01 0x10 0x67 0xf2 0x50 0xa0 0x68 0xfd 0xe3 0x10 0x69 0xd2 0x32 0xa0 0x6a 0xdd 0xc5 0x10 0x6b 0xb2 0x14 0xa0 0x6c 0xc6 0xe1 0x90 0x6d 0x91 0xf6 0xa0 0x6e 0xa6 0xc3 0x90 0x6f 0x71 0xd8 0xa0 0x70 0x86 0xa5 0x90 0x71 0x5a 0xf5 0x20 0x72 0x66 0x87 0x90 0x73 0x3a 0xd7 0x20 0x74 0x46 0x69 0x90 0x75 0x1a 0xb9 0x20 0x76 0x2f 0x86 0x10 0x76 0xfa 0x9b 0x20 0x78 0x0f 0x68 0x10 0x78 0xda 0x7d 0x20 0x79 0xef 0x4a 0x10 0x7a 0xba 0x5f 0x20 0x7b 0xcf 0x2c 0x10 0x7c 0xa3 0x7b 0xa0 0x7d 0xaf 0x0e 0x10 0x7e 0x83 0x5d 0xa0 0x7f 0x8e 0xf0 0x10 0x01 0x02 0x01 0x02 0x03 0x02 0x04 0x05 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0xff 0xff 0x92 0x4c 0x00 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff 0x8f 0x80 0x00 0x08 0xff 0xff 0x9d 0x90 0x01 0x0c 0xff 0xff 0x9d 0x90 0x01 0x10 0xff 0xff 0x9d 0x90 0x01 0x14 0x4c 0x4d 0x54 0x00 0x4d 0x53 0x54 0x00 0x50 0x53 0x54 0x00 0x50 0x44 0x54 0x00 0x50 0x57 0x54 0x00 0x50 0x50 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x01 0x00 0x00 0x00 0x00 0x00 0x01 0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x95 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x18 0xff 0xff 0xff 0xff 0xa5 0xb6 0xf6 0x80 0xff 0xff 0xff 0xff 0xa9 0x79 0x4f 0x70 0xff 0xff 0xff 0xff 0xaf 0xf2 0x7c 0xf0 0xff 0xff 0xff 0xff 0xb6 0x66 0x64 0x70 0xff 0xff 0xff 0xff 0xb7 0x1b 0x10 0x00 0xff 0xff 0xff 0xff 0xb8 0x0a 0xf2 0xf0 0xff 0xff 0xff 0xff 0xcb 0xea 0x8d 0x80 0xff 0xff 0xff 0xff 0xd2 0x23 0xf4 0x70 0xff 0xff 0xff 0xff 0xd2 0x99 0xba 0x70 0xff 0xff 0xff 0xff 0xd7 0x1b 0x59 0x00 0xff 0xff 0xff 0xff 0xd8 0x91 0xb4 0xf0 0xff 0xff 0xff 0xff 0xe2 0x7e 0x59 0xa0 0xff 0xff 0xff 0xff 0xe3 0x49 0x52 0x90 0xff 0xff 0xff 0xff 0xe4 0x5e 0x3b 0xa0 0xff 0xff 0xff 0xff 0xe5 0x29 0x34 0x90 0xff 0xff 0xff 0xff 0xe6 0x47 0x58 0x20 0xff 0xff 0xff 0xff 0xe7 0x12 0x51 0x10 0xff 0xff 0xff 0xff 0xe8 0x27 0x3a 0x20 0xff 0xff 0xff 0xff 0xe8 0xf2 0x33 0x10 0xff 0xff 0xff 0xff 0xea 0x07 0x1c 0x20 0xff 0xff 0xff 0xff 0xea 0xd2 0x15 0x10 0xff 0xff 0xff 0xff 0xeb 0xe6 0xfe 0x20 0xff 0xff 0xff 0xff 0xec 0xb1 0xf7 0x10 0xff 0xff 0xff 0xff 0xed 0xc6 0xe0 0x20 0xff 0xff 0xff 0xff 0xee 0x91 0xd9 0x10 0x00 0x00 0x00 0x00 0x0b 0xe0 0xaf 0xa0 0x00 0x00 0x00 0x00 0x0c 0xd9 0xcd 0x10 0x00 0x00 0x00 0x00 0x0d 0xc0 0x91 0xa0 0x00 0x00 0x00 0x00 0x0e 0xb9 0xaf 0x10 0x00 0x00 0x00 0x00 0x0f 0xa9 0xae 0x20 0x00 0x00 0x00 0x00 0x10 0x99 0x91 0x10 0x00 0x00 0x00 0x00 0x11 0x89 0x90 0x20 0x00 0x00 0x00 0x00 0x12 0x79 0x73 0x10 0x00 0x00 0x00 0x00 0x13 0x69 0x72 0x20 0x00 0x00 0x00 0x00 0x14 0x59 0x55 0x10 0x00 0x00 0x00 0x00 0x15 0x49 0x54 0x20 0x00 0x00 0x00 0x00 0x16 0x39 0x37 0x10 0x00 0x00 0x00 0x00 0x17 0x29 0x36 0x20 0x00 0x00 0x00 0x00 0x18 0x22 0x53 0x90 0x00 0x00 0x00 0x00 0x19 0x09 0x18 0x20 0x00 0x00 0x00 0x00 0x1a 0x02 0x35 0x90 0x00 0x00 0x00 0x00 0x1a 0xf2 0x34 0xa0 0x00 0x00 0x00 0x00 0x1b 0xe2 0x17 0x90 0x00 0x00 0x00 0x00 0x1c 0xd2 0x16 0xa0 0x00 0x00 0x00 0x00 0x1d 0xc1 0xf9 0x90 0x00 0x00 0x00 0x00 0x1e 0xb1 0xf8 0xa0 0x00 0x00 0x00 0x00 0x1f 0xa1 0xdb 0x90 0x00 0x00 0x00 0x00 0x20 0x76 0x2b 0x20 0x00 0x00 0x00 0x00 0x21 0x81 0xbd 0x90 0x00 0x00 0x00 0x00 0x22 0x56 0x0d 0x20 0x00 0x00 0x00 0x00 0x23 0x6a 0xda 0x10 0x00 0x00 0x00 0x00 0x24 0x35 0xef 0x20 0x00 0x00 0x00 0x00 0x25 0x4a 0xbc 0x10 0x00 0x00 0x00 0x00 0x26 0x15 0xd1 0x20 0x00 0x00 0x00 0x00 0x27 0x2a 0x9e 0x10 0x00 0x00 0x00 0x00 0x27 0xfe 0xed 0xa0 0x00 0x00 0x00 0x00 0x29 0x0a 0x80 0x10 0x00 0x00 0x00 0x00 0x29 0xde 0xcf 0xa0 0x00 0x00 0x00 0x00 0x2a 0xea 0x62 0x10 0x00 0x00 0x00 0x00 0x2b 0xbe 0xb1 0xa0 0x00 0x00 0x00 0x00 0x2c 0xd3 0x7e 0x90 0x00 0x00 0x00 0x00 0x2d 0x9e 0x93 0xa0 0x00 0x00 0x00 0x00 0x2e 0xb3 0x60 0x90 0x00 0x00 0x00 0x00 0x2f 0x7e 0x75 0xa0 0x00 0x00 0x00 0x00 0x30 0x93 0x42 0x90 0x00 0x00 0x00 0x00 0x31 0x67 0x92 0x20 0x00 0x00 0x00 0x00 0x32 0x73 0x24 0x90 0x00 0x00 0x00 0x00 0x33 0x47 0x74 0x20 0x00 0x00 0x00 0x00 0x34 0x53 0x06 0x90 0x00 0x00 0x00 0x00 0x35 0x27 0x56 0x20 0x00 0x00 0x00 0x00 0x36 0x32 0xe8 0x90 0x00 0x00 0x00 0x00 0x37 0x07 0x38 0x20 0x00 0x00 0x00 0x00 0x38 0x1c 0x05 0x10 0x00 0x00 0x00 0x00 0x38 0xe7 0x1a 0x20 0x00 0x00 0x00 0x00 0x39 0xfb 0xe7 0x10 0x00 0x00 0x00 0x00 0x3a 0xc6 0xfc 0x20 0x00 0x00 0x00 0x00 0x3b 0xdb 0xc9 0x10 0x00 0x00 0x00 0x00 0x3c 0xb0 0x18 0xa0 0x00 0x00 0x00 0x00 0x3d 0xbb 0xab 0x10 0x00 0x00 0x00 0x00 0x3e 0x8f 0xfa 0xa0 0x00 0x00 0x00 0x00 0x3f 0x9b 0x8d 0x10 0x00 0x00 0x00 0x00 0x40 0x6f 0xdc 0xa0 0x00 0x00 0x00 0x00 0x41 0x84 0xa9 0x90 0x00 0x00 0x00 0x00 0x42 0x4f 0xbe 0xa0 0x00 0x00 0x00 0x00 0x43 0x64 0x8b 0x90 0x00 0x00 0x00 0x00 0x44 0x2f 0xa0 0xa0 0x00 0x00 0x00 0x00 0x45 0x44 0x6d 0x90 0x00 0x00 0x00 0x00 0x46 0x0f 0x82 0xa0 0x00 0x00 0x00 0x00 0x47 0x24 0x4f 0x90 0x00 0x00 0x00 0x00 0x47 0xf8 0x9f 0x20 0x00 0x00 0x00 0x00 0x49 0x04 0x31 0x90 0x00 0x00 0x00 0x00 0x49 0xd8 0x81 0x20 0x00 0x00 0x00 0x00 0x4a 0xe4 0x13 0x90 0x00 0x00 0x00 0x00 0x4b 0xb8 0x63 0x20 0x00 0x00 0x00 0x00 0x4c 0xcd 0x30 0x10 0x00 0x00 0x00 0x00 0x4d 0x98 0x45 0x20 0x00 0x00 0x00 0x00 0x4e 0xad 0x12 0x10 0x00 0x00 0x00 0x00 0x4f 0x78 0x27 0x20 0x00 0x00 0x00 0x00 0x50 0x8c 0xf4 0x10 0x00 0x00 0x00 0x00 0x51 0x61 0x43 0xa0 0x00 0x00 0x00 0x00 0x52 0x6c 0xd6 0x10 0x00 0x00 0x00 0x00 0x53 0x41 0x25 0xa0 0x00 0x00 0x00 0x00 0x54 0x4c 0xb8 0x10 0x00 0x00 0x00 0x00 0x55 0x21 0x07 0xa0 0x00 0x00 0x00 0x00 0x56 0x2c 0x9a 0x10 0x00 0x00 0x00 0x00 0x57 0x00 0xe9 0xa0 0x00 0x00 0x00 0x00 0x58 0x15 0xb6 0x90 0x00 0x00 0x00 0x00 0x58 0xe0 0xcb 0xa0 0x00 0x00 0x00 0x00 0x59 0xf5 0x98 0x90 0x00 0x00 0x00 0x00 0x5a 0xc0 0xad 0xa0 0x00 0x00 0x00 0x00 0x5b 0xd5 0x7a 0x90 0x00 0x00 0x00 0x00 0x5c 0xa9 0xca 0x20 0x00 0x00 0x00 0x00 0x5d 0xb5 0x5c 0x90 0x00 0x00 0x00 0x00 0x5e 0x89 0xac 0x20 0x00 0x00 0x00 0x00 0x5f 0x95 0x3e 0x90 0x00 0x00 0x00 0x00 0x60 0x69 0x8e 0x20 0x00 0x00 0x00 0x00 0x61 0x7e 0x5b 0x10 0x00 0x00 0x00 0x00 0x62 0x49 0x70 0x20 0x00 0x00 0x00 0x00 0x63 0x5e 0x3d 0x10 0x00 0x00 0x00 0x00 0x64 0x29 0x52 0x20 0x00 0x00 0x00 0x00 0x65 0x3e 0x1f 0x10 0x00 0x00 0x00 0x00 0x66 0x12 0x6e 0xa0 0x00 0x00 0x00 0x00 0x67 0x1e 0x01 0x10 0x00 0x00 0x00 0x00 0x67 0xf2 0x50 0xa0 0x00 0x00 0x00 0x00 0x68 0xfd 0xe3 0x10 0x00 0x00 0x00 0x00 0x69 0xd2 0x32 0xa0 0x00 0x00 0x00 0x00 0x6a 0xdd 0xc5 0x10 0x00 0x00 0x00 0x00 0x6b 0xb2 0x14 0xa0 0x00 0x00 0x00 0x00 0x6c 0xc6 0xe1 0x90 0x00 0x00 0x00 0x00 0x6d 0x91 0xf6 0xa0 0x00 0x00 0x00 0x00 0x6e 0xa6 0xc3 0x90 0x00 0x00 0x00 0x00 0x6f 0x71 0xd8 0xa0 0x00 0x00 0x00 0x00 0x70 0x86 0xa5 0x90 0x00 0x00 0x00 0x00 0x71 0x5a 0xf5 0x20 0x00 0x00 0x00 0x00 0x72 0x66 0x87 0x90 0x00 0x00 0x00 0x00 0x73 0x3a 0xd7 0x20 0x00 0x00 0x00 0x00 0x74 0x46 0x69 0x90 0x00 0x00 0x00 0x00 0x75 0x1a 0xb9 0x20 0x00 0x00 0x00 0x00 0x76 0x2f 0x86 0x10 0x00 0x00 0x00 0x00 0x76 0xfa 0x9b 0x20 0x00 0x00 0x00 0x00 0x78 0x0f 0x68 0x10 0x00 0x00 0x00 0x00 0x78 0xda 0x7d 0x20 0x00 0x00 0x00 0x00 0x79 0xef 0x4a 0x10 0x00 0x00 0x00 0x00 0x7a 0xba 0x5f 0x20 0x00 0x00 0x00 0x00 0x7b 0xcf 0x2c 0x10 0x00 0x00 0x00 0x00 0x7c 0xa3 0x7b 0xa0 0x00 0x00 0x00 0x00 0x7d 0xaf 0x0e 0x10 0x00 0x00 0x00 0x00 0x7e 0x83 0x5d 0xa0 0x00 0x00 0x00 0x00 0x7f 0x8e 0xf0 0x10 0x01 0x02 0x01 0x02 0x03 0x02 0x04 0x05 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0xff 0xff 0x92 0x4c 0x00 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff 0x8f 0x80 0x00 0x08 0xff 0xff 0x9d 0x90 0x01 0x0c 0xff 0xff 0x9d 0x90 0x01 0x10 0xff 0xff 0x9d 0x90 0x01 0x14 0x4c 0x4d 0x54 0x00 0x4d 0x53 0x54 0x00 0x50 0x53 0x54 0x00 0x50 0x44 0x54 0x00 0x50 0x57 0x54 0x00 0x50 0x50 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x01 0x00 0x00 0x00 0x00 0x00 0x01 0x0a 0x50 0x53 0x54 0x38 0x50 0x44 0x54 0x2c 0x4d 0x34 0x2e 0x31 0x2e 0x30 0x2c 0x4d 0x31 0x30 0x2e 0x35 0x2e 0x30 0x0a }] close $f set ::tcl::clock::ZoneinfoPaths \ [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir] ::tcl::clock::ClearCaches } -cleanup { set ::tcl::clock::ZoneinfoPaths \ [lrange $::tcl::clock::ZoneinfoPaths 1 end] ::tcl::clock::ClearCaches removeFile TijuanaTwo $tzdir2 removeDirectory Test $tzdir removeDirectory zoneinfo } -body { clock format 2224738800 -timezone :Test/TijuanaTwo \ -format {%Y-%m-%d %H:%M:%S %Z} } -result {2040-07-01 00:00:00 PDT} } test clock-56.4 {Bug 3470928} {*}{ -setup { clock format [clock seconds] set tzdir [makeDirectory zoneinfo] set tzdir2 [makeDirectory Test $tzdir] set tzfile [makeFile {} Windhoek $tzdir2] set f [open $tzfile wb] puts -nonewline $f [binary format c* { 0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x5c 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x13 0x82 0x46 0xcf 0x68 0xcc 0xae 0x8c 0x80 0xcd 0x9e 0x6f 0x70 0x26 0x06 0xa7 0xe0 0x2d 0x9d 0xea 0xe0 0x2e 0x69 0x1c 0x10 0x2f 0x7d 0xe9 0x00 0x30 0x48 0xfe 0x10 0x31 0x67 0x05 0x80 0x32 0x28 0xe0 0x10 0x33 0x46 0xe7 0x80 0x34 0x11 0xfc 0x90 0x35 0x26 0xc9 0x80 0x35 0xf1 0xde 0x90 0x37 0x06 0xab 0x80 0x37 0xd1 0xc0 0x90 0x38 0xe6 0x8d 0x80 0x39 0xb1 0xa2 0x90 0x3a 0xc6 0x6f 0x80 0x3b 0x91 0x84 0x90 0x3c 0xaf 0x8c 0x00 0x3d 0x71 0x66 0x90 0x3e 0x8f 0x6e 0x00 0x3f 0x5a 0x83 0x10 0x40 0x6f 0x50 0x00 0x41 0x3a 0x65 0x10 0x42 0x4f 0x32 0x00 0x43 0x1a 0x47 0x10 0x44 0x2f 0x14 0x00 0x44 0xfa 0x29 0x10 0x46 0x0e 0xf6 0x00 0x46 0xda 0x0b 0x10 0x47 0xf8 0x12 0x80 0x48 0xc3 0x27 0x90 0x49 0xd7 0xf4 0x80 0x4a 0xa3 0x09 0x90 0x4b 0xb7 0xd6 0x80 0x4c 0x82 0xeb 0x90 0x4d 0x97 0xb8 0x80 0x4e 0x62 0xcd 0x90 0x4f 0x77 0x9a 0x80 0x50 0x42 0xaf 0x90 0x51 0x60 0xb7 0x00 0x52 0x22 0x91 0x90 0x53 0x40 0x99 0x00 0x54 0x0b 0xae 0x10 0x55 0x20 0x7b 0x00 0x55 0xeb 0x90 0x10 0x57 0x00 0x5d 0x00 0x57 0xcb 0x72 0x10 0x58 0xe0 0x3f 0x00 0x59 0xab 0x54 0x10 0x5a 0xc0 0x21 0x00 0x5b 0x8b 0x36 0x10 0x5c 0xa9 0x3d 0x80 0x5d 0x6b 0x18 0x10 0x5e 0x89 0x1f 0x80 0x5f 0x54 0x34 0x90 0x60 0x69 0x01 0x80 0x61 0x34 0x16 0x90 0x62 0x48 0xe3 0x80 0x63 0x13 0xf8 0x90 0x64 0x28 0xc5 0x80 0x64 0xf3 0xda 0x90 0x66 0x11 0xe2 0x00 0x66 0xd3 0xbc 0x90 0x67 0xf1 0xc4 0x00 0x68 0xbc 0xd9 0x10 0x69 0xd1 0xa6 0x00 0x6a 0x9c 0xbb 0x10 0x6b 0xb1 0x88 0x00 0x6c 0x7c 0x9d 0x10 0x6d 0x91 0x6a 0x00 0x6e 0x5c 0x7f 0x10 0x6f 0x71 0x4c 0x00 0x70 0x3c 0x61 0x10 0x71 0x5a 0x68 0x80 0x72 0x1c 0x43 0x10 0x73 0x3a 0x4a 0x80 0x74 0x05 0x5f 0x90 0x75 0x1a 0x2c 0x80 0x75 0xe5 0x41 0x90 0x76 0xfa 0x0e 0x80 0x77 0xc5 0x23 0x90 0x78 0xd9 0xf0 0x80 0x79 0xa5 0x05 0x90 0x7a 0xb9 0xd2 0x80 0x7b 0x84 0xe7 0x90 0x7c 0xa2 0xef 0x00 0x7d 0x6e 0x04 0x10 0x7e 0x82 0xd1 0x00 0x7f 0x4d 0xe6 0x10 0x01 0x02 0x01 0x03 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x00 0x00 0x15 0x18 0x00 0x00 0x00 0x00 0x1c 0x20 0x00 0x05 0x00 0x00 0x2a 0x30 0x01 0x05 0x00 0x00 0x1c 0x20 0x00 0x0a 0x00 0x00 0x1c 0x20 0x01 0x0e 0x00 0x00 0x0e 0x10 0x00 0x01 0x53 0x57 0x41 0x54 0x00 0x53 0x41 0x53 0x54 0x00 0x43 0x41 0x54 0x00 0x57 0x41 0x53 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x07 0x00 0x00 0x00 0x07 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x5d 0x00 0x00 0x00 0x07 0x00 0x00 0x00 0x17 0xff 0xff 0xff 0xff 0x6d 0x7b 0x4b 0x78 0xff 0xff 0xff 0xff 0x82 0x46 0xcf 0x68 0xff 0xff 0xff 0xff 0xcc 0xae 0x8c 0x80 0xff 0xff 0xff 0xff 0xcd 0x9e 0x6f 0x70 0x00 0x00 0x00 0x00 0x26 0x06 0xa7 0xe0 0x00 0x00 0x00 0x00 0x2d 0x9d 0xea 0xe0 0x00 0x00 0x00 0x00 0x2e 0x69 0x1c 0x10 0x00 0x00 0x00 0x00 0x2f 0x7d 0xe9 0x00 0x00 0x00 0x00 0x00 0x30 0x48 0xfe 0x10 0x00 0x00 0x00 0x00 0x31 0x67 0x05 0x80 0x00 0x00 0x00 0x00 0x32 0x28 0xe0 0x10 0x00 0x00 0x00 0x00 0x33 0x46 0xe7 0x80 0x00 0x00 0x00 0x00 0x34 0x11 0xfc 0x90 0x00 0x00 0x00 0x00 0x35 0x26 0xc9 0x80 0x00 0x00 0x00 0x00 0x35 0xf1 0xde 0x90 0x00 0x00 0x00 0x00 0x37 0x06 0xab 0x80 0x00 0x00 0x00 0x00 0x37 0xd1 0xc0 0x90 0x00 0x00 0x00 0x00 0x38 0xe6 0x8d 0x80 0x00 0x00 0x00 0x00 0x39 0xb1 0xa2 0x90 0x00 0x00 0x00 0x00 0x3a 0xc6 0x6f 0x80 0x00 0x00 0x00 0x00 0x3b 0x91 0x84 0x90 0x00 0x00 0x00 0x00 0x3c 0xaf 0x8c 0x00 0x00 0x00 0x00 0x00 0x3d 0x71 0x66 0x90 0x00 0x00 0x00 0x00 0x3e 0x8f 0x6e 0x00 0x00 0x00 0x00 0x00 0x3f 0x5a 0x83 0x10 0x00 0x00 0x00 0x00 0x40 0x6f 0x50 0x00 0x00 0x00 0x00 0x00 0x41 0x3a 0x65 0x10 0x00 0x00 0x00 0x00 0x42 0x4f 0x32 0x00 0x00 0x00 0x00 0x00 0x43 0x1a 0x47 0x10 0x00 0x00 0x00 0x00 0x44 0x2f 0x14 0x00 0x00 0x00 0x00 0x00 0x44 0xfa 0x29 0x10 0x00 0x00 0x00 0x00 0x46 0x0e 0xf6 0x00 0x00 0x00 0x00 0x00 0x46 0xda 0x0b 0x10 0x00 0x00 0x00 0x00 0x47 0xf8 0x12 0x80 0x00 0x00 0x00 0x00 0x48 0xc3 0x27 0x90 0x00 0x00 0x00 0x00 0x49 0xd7 0xf4 0x80 0x00 0x00 0x00 0x00 0x4a 0xa3 0x09 0x90 0x00 0x00 0x00 0x00 0x4b 0xb7 0xd6 0x80 0x00 0x00 0x00 0x00 0x4c 0x82 0xeb 0x90 0x00 0x00 0x00 0x00 0x4d 0x97 0xb8 0x80 0x00 0x00 0x00 0x00 0x4e 0x62 0xcd 0x90 0x00 0x00 0x00 0x00 0x4f 0x77 0x9a 0x80 0x00 0x00 0x00 0x00 0x50 0x42 0xaf 0x90 0x00 0x00 0x00 0x00 0x51 0x60 0xb7 0x00 0x00 0x00 0x00 0x00 0x52 0x22 0x91 0x90 0x00 0x00 0x00 0x00 0x53 0x40 0x99 0x00 0x00 0x00 0x00 0x00 0x54 0x0b 0xae 0x10 0x00 0x00 0x00 0x00 0x55 0x20 0x7b 0x00 0x00 0x00 0x00 0x00 0x55 0xeb 0x90 0x10 0x00 0x00 0x00 0x00 0x57 0x00 0x5d 0x00 0x00 0x00 0x00 0x00 0x57 0xcb 0x72 0x10 0x00 0x00 0x00 0x00 0x58 0xe0 0x3f 0x00 0x00 0x00 0x00 0x00 0x59 0xab 0x54 0x10 0x00 0x00 0x00 0x00 0x5a 0xc0 0x21 0x00 0x00 0x00 0x00 0x00 0x5b 0x8b 0x36 0x10 0x00 0x00 0x00 0x00 0x5c 0xa9 0x3d 0x80 0x00 0x00 0x00 0x00 0x5d 0x6b 0x18 0x10 0x00 0x00 0x00 0x00 0x5e 0x89 0x1f 0x80 0x00 0x00 0x00 0x00 0x5f 0x54 0x34 0x90 0x00 0x00 0x00 0x00 0x60 0x69 0x01 0x80 0x00 0x00 0x00 0x00 0x61 0x34 0x16 0x90 0x00 0x00 0x00 0x00 0x62 0x48 0xe3 0x80 0x00 0x00 0x00 0x00 0x63 0x13 0xf8 0x90 0x00 0x00 0x00 0x00 0x64 0x28 0xc5 0x80 0x00 0x00 0x00 0x00 0x64 0xf3 0xda 0x90 0x00 0x00 0x00 0x00 0x66 0x11 0xe2 0x00 0x00 0x00 0x00 0x00 0x66 0xd3 0xbc 0x90 0x00 0x00 0x00 0x00 0x67 0xf1 0xc4 0x00 0x00 0x00 0x00 0x00 0x68 0xbc 0xd9 0x10 0x00 0x00 0x00 0x00 0x69 0xd1 0xa6 0x00 0x00 0x00 0x00 0x00 0x6a 0x9c 0xbb 0x10 0x00 0x00 0x00 0x00 0x6b 0xb1 0x88 0x00 0x00 0x00 0x00 0x00 0x6c 0x7c 0x9d 0x10 0x00 0x00 0x00 0x00 0x6d 0x91 0x6a 0x00 0x00 0x00 0x00 0x00 0x6e 0x5c 0x7f 0x10 0x00 0x00 0x00 0x00 0x6f 0x71 0x4c 0x00 0x00 0x00 0x00 0x00 0x70 0x3c 0x61 0x10 0x00 0x00 0x00 0x00 0x71 0x5a 0x68 0x80 0x00 0x00 0x00 0x00 0x72 0x1c 0x43 0x10 0x00 0x00 0x00 0x00 0x73 0x3a 0x4a 0x80 0x00 0x00 0x00 0x00 0x74 0x05 0x5f 0x90 0x00 0x00 0x00 0x00 0x75 0x1a 0x2c 0x80 0x00 0x00 0x00 0x00 0x75 0xe5 0x41 0x90 0x00 0x00 0x00 0x00 0x76 0xfa 0x0e 0x80 0x00 0x00 0x00 0x00 0x77 0xc5 0x23 0x90 0x00 0x00 0x00 0x00 0x78 0xd9 0xf0 0x80 0x00 0x00 0x00 0x00 0x79 0xa5 0x05 0x90 0x00 0x00 0x00 0x00 0x7a 0xb9 0xd2 0x80 0x00 0x00 0x00 0x00 0x7b 0x84 0xe7 0x90 0x00 0x00 0x00 0x00 0x7c 0xa2 0xef 0x00 0x00 0x00 0x00 0x00 0x7d 0x6e 0x04 0x10 0x00 0x00 0x00 0x00 0x7e 0x82 0xd1 0x00 0x00 0x00 0x00 0x00 0x7f 0x4d 0xe6 0x10 0x01 0x02 0x03 0x02 0x04 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x00 0x00 0x10 0x08 0x00 0x00 0x00 0x00 0x15 0x18 0x00 0x04 0x00 0x00 0x1c 0x20 0x00 0x09 0x00 0x00 0x2a 0x30 0x01 0x09 0x00 0x00 0x1c 0x20 0x00 0x0e 0x00 0x00 0x1c 0x20 0x01 0x12 0x00 0x00 0x0e 0x10 0x00 0x05 0x4c 0x4d 0x54 0x00 0x53 0x57 0x41 0x54 0x00 0x53 0x41 0x53 0x54 0x00 0x43 0x41 0x54 0x00 0x57 0x41 0x53 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x57 0x41 0x54 0x2d 0x31 0x57 0x41 0x53 0x54 0x2c 0x4d 0x39 0x2e 0x31 0x2e 0x30 0x2c 0x4d 0x34 0x2e 0x31 0x2e 0x30 0x0a }] close $f set ::tcl::clock::ZoneinfoPaths \ [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir] ::tcl::clock::ClearCaches } -body { clock format 1326054606 -timezone :Test/Windhoek } -cleanup { set ::tcl::clock::ZoneinfoPaths \ [lrange $::tcl::clock::ZoneinfoPaths 1 end] ::tcl::clock::ClearCaches removeFile Windhoek $tzdir2 removeDirectory Test $tzdir removeDirectory zoneinfo } -result {Sun Jan 08 22:30:06 WAST 2012} } test clock-57.1 {clock scan - abbreviated options} { clock scan 1970-01-01 -f %Y-%m-%d -g true } 0 test clock-57.2 {clock scan - not -gmt and -timezone in the same call} { catch {clock scan 1970-01-01 -format %Y-%m-%d -gmt true -timezone :Europe/Berlin} } 1 test clock-57.3 {clock scan - not -g and -timezone in the same call} { catch {clock scan 1970-01-01 -format %Y-%m-%d -g true -timezone :Europe/Berlin} } 1 test clock-58.1 {clock l10n - Japanese localisation} {*}{ -setup { proc backslashify { string } { set retval {} foreach char [split $string {}] { scan $char %c ccode if { $ccode >= 0x0020 && $ccode < 0x007f && $char ne "\{" && $char ne "\}" && $char ne "\[" && $char ne "\]" && $char ne "\\" && $char ne "\$" } { append retval $char } else { append retval \\u [format %04x $ccode] } } return $retval } } -body { set trouble {} foreach {date jdate} { 1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5 1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5 1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5 1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5 1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5 1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5 1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5 1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5 2019-04-30 \u5e73\u621031\u5e7404\u670830\u65e5 2019-05-01 \u4ee4\u548c01\u5e7405\u670801\u65e5 } { set status [catch { set secs [clock scan $date \ -timezone +0900 \ -locale ja_JP \ -format %Y-%m-%d] set jda [clock format $secs \ -timezone +0900 \ -locale ja_JP \ -format %Ex] } result] if {$status != 0} { append trouble \n $date " gives error " $result } elseif {$jda ne $jdate} { append trouble \n $date " converts to " \ [backslashify $jda] " and should be " \ [backslashify $jdate] } # There is no code for scanning dates on the locale's # alternative calendar. continue set status [catch { set secs [clock scan $jdate \ -timezone +0900 \ -locale ja_JP \ -format %Ex] set da [clock format $secs \ -timezone +0900 \ -locale ja_JP \ -format %Y-%m-%d] } result] if {$status != 0} { append trouble \n [backslashify $jdate] " gives error " $result } elseif {$da ne $date} { append trouble \n [backslashify $jdate] " converts to " \ $da " and should be " $date } } set trouble } -cleanup { rename backslashify {} } -result {} } test clock-59.1 {military time zones} { set hour 0 set base [clock scan "20000101 000000" -format "%Y%m%d %H%M%S" -gmt 1] set trouble {} foreach {pzone mzone} { Z Z A N B O C P D Q E R F S G T H U I V K W L X M Y } { catch {clock scan "20000101 000000 $pzone" \ -format "%Y%m%d %H%M%S %Z"} ps1 catch {clock scan "20000101 000000 $pzone"} ps2 catch {clock scan "20000101 000000 $mzone" \ -format "%Y%m%d %H%M%S %Z"} ms1 catch {clock scan "20000101 000000 $mzone"} ms2 if {$ps1 != $base - 3600 * $hour} { lappend trouble [list pzone $pzone hour $hour ps1 is $ps1] } if {$ps2 != $base - 3600 * $hour} { lappend trouble [list pzone $pzone ps2 is $ps2] } if {$ms1 != $base + 3600 * $hour} { lappend trouble [list mzone $mzone ms1 is $ms1] } if {$ms2 != $base + 3600 * $hour} { lappend trouble [list mzone $mzone ms2 is $ms2] } incr hour } join $trouble \n } {} # case-insensitive matching of weekday and month names [Bug 1781282] test clock-60.1 {case insensitive weekday names} { clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a" } [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] test clock-60.2 {case insensitive weekday names} { clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a" } [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] test clock-60.3 {case insensitive weekday names} { clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a" } [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] test clock-60.4 {case insensitive weekday names} { clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a" } [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] test clock-60.5 {case insensitive weekday names} { clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a" } [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] test clock-60.6 {case insensitive weekday names} { clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a" } [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] test clock-60.7 {case insensitive month names} { clock scan "1 january 2000" -gmt true -format "%d %b %Y" } [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] test clock-60.8 {case insensitive month names} { clock scan "1 January 2000" -gmt true -format "%d %b %Y" } [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] test clock-60.9 {case insensitive month names} { clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y" } [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] test clock-60.10 {case insensitive month names} { clock scan "1 december 2000" -gmt true -format "%d %b %Y" } [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] test clock-60.11 {case insensitive month names} { clock scan "1 December 2000" -gmt true -format "%d %b %Y" } [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] test clock-60.12 {case insensitive month names} { clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y" } [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] test clock-61.1 {overflow of a wide integer on output} {*}{ -body { clock format 0x8000000000000000 -format %s -gmt true } -result {integer value too large to represent} -returnCodes error } test clock-61.2 {overflow of a wide integer on output} {*}{ -body { clock format -0x8000000000000001 -format %s -gmt true } -result {integer value too large to represent} -returnCodes error } test clock-61.3 {near-miss overflow of a wide integer on output} { clock format 0x7fffffffffffffff -format %s -gmt true } [expr 0x7fffffffffffffff] test clock-61.4 {near-miss overflow of a wide integer on output} { clock format -0x8000000000000000 -format %s -gmt true } [expr -0x8000000000000000] test clock-62.1 {Bug 1902423} {*}{ -setup {::tcl::clock::ClearCaches} -body { set s 1204049747 set f1 [clock format $s -format {%Y-%m-%d %T} -locale C] set f2 [clock format $s -format {%Y-%m-%d %H:%M:%S} -locale C] if {$f1 ne $f2} { subst "$f2 is not $f1" } else { subst "ok" } } -result ok } test clock-63.1 {Incorrect use of internal ConvertLocalToUTC command} {*}{ -body { ::tcl::clock::ConvertLocalToUTC {immaterial stuff} {} 12345 } -returnCodes error -result {key "localseconds" not found in dictionary} } test clock-64.1 {:: in format string [Bug 2362156]} {*}{ -body { clock scan 2001-02-03::04:05:06 -gmt 1 -format %Y-%m-%d::%H:%M:%S } -result 981173106 } test clock-64.2 {:: in format string [Bug 2362156]} {*}{ -body { clock format 981173106 -gmt 1 -format %Y-%m-%d::%H:%M:%S } -result 2001-02-03::04:05:06 } test clock-65.1 {clock add, bad option [Bug 2481670]} {*}{ -body { clock add 0 1 year -foo bar } -match glob -returnCodes error -result {bad option "-foo"*} } test clock-65.2 {clock add with both -timezone and -gmt} {*}{ -body { clock add 0 1 year -timezone :CET -gmt true } -match glob -returnCodes error -result {cannot use -gmt and -timezone in same call} } test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{ -setup { ::tcl::clock::ClearCaches } -body { clock scan 1200 \ -timezone {+05:00:00+04:00:00,M3.2.0/02:00:00,M11.1.0/02:00:00} \ -base 1256529600 \ -format %H%M } -result 1256572800 } test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} { clock format [clock seconds] -format %%r } %r test clock-67.2 {Bug d19a30db57} -body { # error, not segfault tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222 } -returnCodes error -match glob -result * test clock-67.3 {Bug d19a30db57} -body { # error, not segfault tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222 } -returnCodes error -match glob -result * test clock-67.4 {Change format %x output on global locale change [Bug 4a0c163d24]} -setup { package require msgcat set current [msgcat::mclocale] } -body { msgcat::mclocale de_de set res [regexp {^\d{2}\.\d{2}\.\d{4}$} [clock format 1 -locale current -format %x]] msgcat::mclocale en_uk lappend res [regexp {^\d{2}/\d{2}/\d{4}$} [clock format 1 -locale current -format %x]] } -cleanup { msgcat::mclocale $current } -result {1 1} test clock-67.5 {Change scan %x output on global locale change [Bug 4a0c163d24]} -setup { package require msgcat set current [msgcat::mclocale] } -body { msgcat::mclocale de_de set res [clock scan "01.01.1970" -locale current -format %x -gmt 1] msgcat::mclocale en_uk # This will fail without the bug fix, as still de_de is active expr {$res == [clock scan "01/01/1970" -locale current -format %x -gmt 1]} } -cleanup { msgcat::mclocale $current } -result {1} # cleanup namespace delete ::testClock ::tcl::clock::ClearCaches ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/cmdAH.test0000644000175000017500000016051714554262142014673 0ustar sergeisergei# The file tests the tclCmdAH.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1996-1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.1 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint time64bit [expr { $::tcl_platform(pointerSize) >= 8 || [llength [info command testsize]] && [testsize st_mtime] >= 8 }] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] global env set cmdAHwd [pwd] catch {set platform [testgetplatform]} proc waitForEvenSecondForFAT {} { # Windows 9x uses filesystems (the FAT* family of FSes) without enough # data in its timestamps for even per-second-accurate timings. :^( # This procedure based on work by Helmut Giese if { [testConstraint win] && [lindex [file system [temporaryDirectory]] 1] ne "NTFS" } then { # Assume non-NTFS means FAT{12,16,32} and hence in need of special # help... set start [clock seconds] while {1} { set now [clock seconds] if {$now!=$start && !($now & 1)} { break } after 50 } } } test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body { break foo } -returnCodes error -result {wrong # args: should be "break"} test cmdAH-0.2 {Tcl_BreakObjCmd, success} { list [catch {break} msg] $msg } {3 {}} # Tcl_CaseObjCmd is tested in case.test test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body { catch } -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} test cmdAH-1.2 {Tcl_CatchObjCmd, errors} { list [catch {catch foo bar baz} msg] $msg } {0 1} test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body { catch foo bar baz spaz } -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} test cmdAH-1.4 {Bug 3595576} { catch {catch {} -> noSuchNs::var} } 1 test cmdAH-1.5 {Bug 3595576} { catch {catch error -> noSuchNs::var} } 1 test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body { cd foo bar } -result {wrong # args: should be "cd ?dirName?"} set foodir [file join [temporaryDirectory] foo] test cmdAH-2.2 {Tcl_CdObjCmd} -setup { file delete -force $foodir set oldpwd [pwd] } -body { file mkdir $foodir cd $foodir file tail [pwd] } -cleanup { cd $oldpwd file delete $foodir } -result foo test cmdAH-2.3 {Tcl_CdObjCmd} -setup { global env set oldpwd [pwd] set temp $env(HOME) file delete -force $foodir } -body { set env(HOME) $oldpwd file mkdir $foodir cd $foodir cd ~ string equal [pwd] $oldpwd } -cleanup { cd $oldpwd file delete $foodir set env(HOME) $temp } -result 1 test cmdAH-2.4 {Tcl_CdObjCmd} -setup { global env set oldpwd [pwd] set temp $env(HOME) file delete -force $foodir } -body { set env(HOME) $oldpwd file mkdir $foodir cd $foodir cd string equal [pwd] $oldpwd } -cleanup { cd $oldpwd file delete $foodir set env(HOME) $temp } -result 1 test cmdAH-2.5 {Tcl_CdObjCmd} -returnCodes error -body { cd ~~ } -result {user "~" doesn't exist} test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body { cd _foobar } -result {couldn't change working directory to "_foobar": no such file or directory} test cmdAH-2.6.1 {Tcl_CdObjCmd} -returnCodes error -body { cd "" } -result {couldn't change working directory to "": no such file or directory} test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup { set dir [pwd] } -body { cd / pwd } -cleanup { cd $dir } -result {/} test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup { set dir [pwd] } -returnCodes error -body { cd .\x00 } -cleanup { cd $dir } -match glob -result "couldn't change working directory to \".\x00\": *" test cmdAH-2.7 {Tcl_ConcatObjCmd} { concat } {} test cmdAH-2.8 {Tcl_ConcatObjCmd} { concat a } a test cmdAH-2.9 {Tcl_ConcatObjCmd} { concat a {b c} } {a b c} test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} -returnCodes error -body { continue foo } -result {wrong # args: should be "continue"} test cmdAH-3.2 {Tcl_ContinueObjCmd, success} { list [catch {continue} msg] $msg } {4 {}} test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding } -result {wrong # args: should be "encoding subcommand ?arg ...?"} test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding foo } -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system} test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertto } -result {wrong # args: should be "encoding convertto ?encoding? data"} test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertto foo bar } -result {unknown encoding "foo"} test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { encoding system jis0208 encoding convertto \u4e4e } -cleanup { encoding system $system } -result 8C test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { encoding system iso8859-1 encoding convertto jis0208 \u4e4e } -cleanup { encoding system $system } -result 8C test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertfrom } -result {wrong # args: should be "encoding convertfrom ?encoding? data"} test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertfrom foo bar } -result {unknown encoding "foo"} test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { encoding system jis0208 encoding convertfrom 8C } -cleanup { encoding system $system } -result \u4e4e test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { encoding system iso8859-1 encoding convertfrom jis0208 8C } -cleanup { encoding system $system } -result \u4e4e test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding names foo } -result {wrong # args: should be "encoding names"} test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding system foo bar } -result {wrong # args: should be "encoding system ?encoding?"} test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { encoding system iso8859-1 encoding system } -cleanup { encoding system $system } -result iso8859-1 test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body { file } -result {wrong # args: should be "file subcommand ?arg ...?"} test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body { file x } -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable} test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body { file exists } -result {wrong # args: should be "file exists name"} test cmdAH-5.4 {Tcl_FileObjCmd} { file exists "" } 0 # volume test cmdAH-6.1 {Tcl_FileObjCmd: volumes} -returnCodes error -body { file volumes x } -result {wrong # args: should be "file volumes"} test cmdAH-6.2 {Tcl_FileObjCmd: volumes} -body { lindex [file volumes] 0 } -match glob -result ?* test cmdAH-6.3 {Tcl_FileObjCmd: volumes} -constraints unix -body { set volumeList [file volumes] glob -nocomplain [lindex $volumeList 0]* } -match glob -result * test cmdAH-6.4 {Tcl_FileObjCmd: volumes} -constraints win -body { set volumeList [string tolower [file volumes]] set element [lsearch -exact $volumeList "c:/"] list [expr {$element>=0}] [glob -nocomplain [lindex $volumeList $element]*] } -match glob -result {1 *} # attributes test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup { set foofile [makeFile abcde foo.file] catch {file delete -force $foofile} } -body { close [open $foofile w] file attributes $foofile } -cleanup { # We used [makeFile] so we undo with [removeFile] removeFile $foofile } -match glob -result * # dirname test cmdAH-8.1 {Tcl_FileObjCmd: dirname} -returnCodes error -body { file dirname a b } -result {wrong # args: should be "file dirname name"} test cmdAH-8.2 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname /a/b } /a test cmdAH-8.3 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname {} } . test cmdAH-8.5 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform win file dirname {} } . test cmdAH-8.6 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname .def } . test cmdAH-8.8 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform win file dirname a } . test cmdAH-8.9 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname a/b/c.d } a/b test cmdAH-8.10 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname a/b.c/d } a/b.c test cmdAH-8.11 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname /. } / test cmdAH-8.12 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname / } / test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname /foo } / test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname //foo } / test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname //foo/bar } /foo test cmdAH-8.16 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname {//foo\/bar/baz} } {/foo\/bar} test cmdAH-8.17 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname {//foo\/bar/baz/blat} } {/foo\/bar/baz} test cmdAH-8.18 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname /foo// } / test cmdAH-8.19 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname ./a } . test cmdAH-8.20 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname a/.a } a test cmdAH-8.21 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows file dirname c:foo } c: test cmdAH-8.22 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows file dirname c: } c: test cmdAH-8.23 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows file dirname c:/ } c:/ test cmdAH-8.24 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows file dirname {c:\foo} } c:/ test cmdAH-8.25 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows file dirname {//foo/bar/baz} } //foo/bar test cmdAH-8.26 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows file dirname {//foo/bar} } //foo/bar test cmdAH-8.38 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname ~/foo } ~ test cmdAH-8.39 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname ~bar/foo } ~bar test cmdAH-8.43 {Tcl_FileObjCmd: dirname} -setup { global env set temp $env(HOME) } -constraints testsetplatform -body { set env(HOME) "/homewontexist/test" testsetplatform unix file dirname ~ } -cleanup { set env(HOME) $temp } -result /homewontexist test cmdAH-8.44 {Tcl_FileObjCmd: dirname} -setup { global env set temp $env(HOME) } -constraints testsetplatform -body { set env(HOME) "~" testsetplatform unix file dirname ~ } -cleanup { set env(HOME) $temp } -result ~ test cmdAH-8.45 {Tcl_FileObjCmd: dirname} -setup { set temp $::env(HOME) } -constraints {win testsetplatform} -match regexp -body { set ::env(HOME) "/homewontexist/test" testsetplatform windows file dirname ~ } -cleanup { set ::env(HOME) $temp } -result {([a-zA-Z]:?)/homewontexist} test cmdAH-8.46 {Tcl_FileObjCmd: dirname} { set f [file normalize [info nameof]] file exists $f set res1 [file dirname [file join $f foo/bar]] set res2 [file dirname "${f}/foo/bar"] if {$res1 eq $res2} { return "ok" } return "file dirname problem, $res1, $res2 not equal" } {ok} # tail test cmdAH-9.1 {Tcl_FileObjCmd: tail} -returnCodes error -body { file tail a b } -result {wrong # args: should be "file tail name"} test cmdAH-9.2 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail /a/b } b test cmdAH-9.3 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {} } {} test cmdAH-9.5 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform win file tail {} } {} test cmdAH-9.6 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail .def } .def test cmdAH-9.8 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform win file tail a } a test cmdAH-9.9 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file ta a/b/c.d } c.d test cmdAH-9.10 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail a/b.c/d } d test cmdAH-9.11 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail /. } . test cmdAH-9.12 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail / } {} test cmdAH-9.13 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail /foo } foo test cmdAH-9.14 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail //foo } foo test cmdAH-9.15 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail //foo/bar } bar test cmdAH-9.16 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {//foo\/bar/baz} } baz test cmdAH-9.17 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {//foo\/bar/baz/blat} } blat test cmdAH-9.18 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail /foo// } foo test cmdAH-9.19 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail ./a } a test cmdAH-9.20 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail a/.a } .a test cmdAH-9.21 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c:foo } foo test cmdAH-9.22 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c: } {} test cmdAH-9.23 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c:/ } {} test cmdAH-9.24 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {c:\foo} } foo test cmdAH-9.25 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {//foo/bar/baz} } baz test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {//foo/bar} } {} test cmdAH-9.42 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { global env set temp $env(HOME) } -body { set env(HOME) "/home/test" testsetplatform unix file tail ~ } -cleanup { set env(HOME) $temp } -result test test cmdAH-9.43 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { global env set temp $env(HOME) } -body { set env(HOME) "~" testsetplatform unix file tail ~ } -cleanup { set env(HOME) $temp } -result {} test cmdAH-9.44 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { global env set temp $env(HOME) } -body { set env(HOME) "/home/test" testsetplatform windows file tail ~ } -cleanup { set env(HOME) $temp } -result test test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {f.oo\bar/baz.bat} } baz.bat test cmdAH-9.47 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c:foo } foo test cmdAH-9.48 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c: } {} test cmdAH-9.49 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c:/foo } foo test cmdAH-9.50 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {c:/foo\bar} } bar test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {foo\bar} } bar test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} { list \ [file tail {~/~foo}] \ [file tail {~/test/~foo}] \ [file tail [file normalize {~/~foo}]] \ [file tail [file normalize {~/test/~foo}]] } [lrepeat 4 ./~foo] # rootname test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body { file rootname a b } -result {wrong # args: should be "file rootname name"} test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname {} } {} test cmdAH-10.3 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file ro foo } foo test cmdAH-10.4 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname foo. } foo test cmdAH-10.5 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname .foo } {} test cmdAH-10.6 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname abc.def } abc test cmdAH-10.7 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname abc.def.ghi } abc.def test cmdAH-10.8 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname a/b/c.d } a/b/c test cmdAH-10.9 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname a/b.c/d } a/b.c/d test cmdAH-10.10 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname a/b.c/ } a/b.c/ test cmdAH-10.23 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname {} } {} test cmdAH-10.24 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file ro foo } foo test cmdAH-10.25 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname foo. } foo test cmdAH-10.26 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname .foo } {} test cmdAH-10.27 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname abc.def } abc test cmdAH-10.28 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname abc.def.ghi } abc.def test cmdAH-10.29 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a/b/c.d } a/b/c test cmdAH-10.30 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a/b.c/d } a/b.c/d test cmdAH-10.31 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a\\b.c\\ } a\\b.c\\ test cmdAH-10.32 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a\\b\\c.d } a\\b\\c test cmdAH-10.33 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a\\b.c\\d } a\\b.c\\d test cmdAH-10.34 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a\\b.c\\ } a\\b.c\\ set num 35 foreach outer { {} a .a a. a.a } { foreach inner { {} a .a a. a.a } { set thing [format %s/%s $outer $inner] ;test cmdAH-10.$num {Tcl_FileObjCmd: rootname and extension options} testsetplatform " testsetplatform unix [list format %s%s [file rootname $thing] [file ext $thing]] " $thing incr num } } # extension test cmdAH-11.1 {Tcl_FileObjCmd: extension} -returnCodes error -body { file extension a b } -result {wrong # args: should be "file extension name"} test cmdAH-11.2 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension {} } {} test cmdAH-11.3 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file ext foo } {} test cmdAH-11.4 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension foo. } . test cmdAH-11.5 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension .foo } .foo test cmdAH-11.6 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension abc.def } .def test cmdAH-11.7 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension abc.def.ghi } .ghi test cmdAH-11.8 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension a/b/c.d } .d test cmdAH-11.9 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension a/b.c/d } {} test cmdAH-11.10 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension a/b.c/ } {} test cmdAH-11.23 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension {} } {} test cmdAH-11.24 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file ext foo } {} test cmdAH-11.25 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension foo. } . test cmdAH-11.26 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension .foo } .foo test cmdAH-11.27 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension abc.def } .def test cmdAH-11.28 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension abc.def.ghi } .ghi test cmdAH-11.29 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a/b/c.d } .d test cmdAH-11.30 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a/b.c/d } {} test cmdAH-11.31 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a\\b.c\\ } {} test cmdAH-11.32 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a\\b\\c.d } .d test cmdAH-11.33 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a\\b.c\\d } {} test cmdAH-11.34 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a\\b.c\\ } {} foreach {test onPlatform value result} { cmdAH-11.35 unix a..b .b cmdAH-11.36 windows a..b .b cmdAH-11.37 unix a...b .b cmdAH-11.38 windows a...b .b cmdAH-11.39 unix a.c..b .b cmdAH-11.40 windows a.c..b .b cmdAH-11.41 unix ..b .b cmdAH-11.42 windows ..b .b } { test $test {Tcl_FileObjCmd: extension} testsetplatform " testsetplatform $onPlatform file extension $value " $result } # pathtype test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} -returnCodes error -body { file pathtype a b } -result {wrong # args: should be "file pathtype name"} test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} testsetplatform { testsetplatform unix file pathtype /a } absolute test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} testsetplatform { testsetplatform unix file p a } relative test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} testsetplatform { testsetplatform windows file pathtype c:a } volumerelative # split test cmdAH-13.1 {Tcl_FileObjCmd: split} -returnCodes error -body { file split a b } -result {wrong # args: should be "file split name"} test cmdAH-13.2 {Tcl_FileObjCmd: split} testsetplatform { testsetplatform unix file split a } a test cmdAH-13.3 {Tcl_FileObjCmd: split} testsetplatform { testsetplatform unix file split a/b } {a b} # join test cmdAH-14.1 {Tcl_FileObjCmd: join} testsetplatform { testsetplatform unix file join a } a test cmdAH-14.2 {Tcl_FileObjCmd: join} testsetplatform { testsetplatform unix file join a b } a/b test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform { testsetplatform unix file join a b c d } a/b/c/d # error handling of Tcl_TranslateFileName test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body { testsetplatform unix file atime ~_bad_user } -returnCodes error -result {user "_bad_user" doesn't exist} catch {testsetplatform $platform} # readable set gorpfile [makeFile abcde gorp.file] set dirfile [makeDirectory dir.file] test cmdAH-16.1 {Tcl_FileObjCmd: readable} { -returnCodes error -body {file readable a b} -result {wrong # args: should be "file readable name"} } test cmdAH-16.2 {Tcl_FileObjCmd: readable} { -constraints testchmod -setup {testchmod 0o444 $gorpfile} -body {file readable $gorpfile} -result 1 } test cmdAH-16.3 {Tcl_FileObjCmd: readable} { -constraints {unix notRoot testchmod notWsl} -setup {testchmod 0o333 $gorpfile} -body {file readable $gorpfile} -result 0 } # writable test cmdAH-17.1 {Tcl_FileObjCmd: writable} { -returnCodes error -body {file writable a b} -result {wrong # args: should be "file writable name"} } test cmdAH-17.2 {Tcl_FileObjCmd: writable} { -constraints {notRoot testchmod} -setup {testchmod 0o555 $gorpfile} -body {file writable $gorpfile} -result 0 } test cmdAH-17.3 {Tcl_FileObjCmd: writable} { -constraints testchmod -setup {testchmod 0o222 $gorpfile} -body {file writable $gorpfile} -result 1 } # executable removeFile $gorpfile removeDirectory $dirfile set dirfile [makeDirectory dir.file] set gorpfile [makeFile abcde gorp.file] test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body { file executable a b } -result {wrong # args: should be "file executable name"} test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot notWsl} { file executable $gorpfile } 0 test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} { # Only on unix will setting the execute bit on a regular file cause that # file to be executable. testchmod 0o775 $gorpfile file exe $gorpfile } 1 test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body { # On windows, must be a .exe, .com, etc. set x {} set gorpexes {} foreach ext {exe com cmd bat} { lappend x [file exe nosuchfile.$ext] set gorpexe [makeFile foo gorp.$ext] lappend gorpexes $gorpexe lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]] } set x } -cleanup { foreach gorpexe $gorpexes { removeFile $gorpexe } } -result {0 1 1 0 1 1 0 1 1 0 1 1} test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} { # Directories are always executable. file exe $dirfile } 1 removeDirectory $dirfile removeFile $gorpfile set linkfile [file join [temporaryDirectory] link.file] file delete $linkfile # exists test cmdAH-19.1 {Tcl_FileObjCmd: exists} -returnCodes error -body { file exists a b } -result {wrong # args: should be "file exists name"} test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists $gorpfile} 0 test cmdAH-19.3 {Tcl_FileObjCmd: exists} { file exists [file join [temporaryDirectory] dir.file gorp.file] } 0 catch { set gorpfile [makeFile abcde gorp.file] set dirfile [makeDirectory dir.file] set subgorp [makeFile 12345 [file join $dirfile gorp.file]] } test cmdAH-19.4 {Tcl_FileObjCmd: exists} { file exists $gorpfile } 1 test cmdAH-19.5 {Tcl_FileObjCmd: exists} { file exists $subgorp } 1 # nativename test cmdAH-19.6 {Tcl_FileObjCmd: nativename} -body { testsetplatform unix file nativename a/b } -constraints testsetplatform -cleanup { testsetplatform $platform } -result a/b test cmdAH-19.7 {Tcl_FileObjCmd: nativename} -body { testsetplatform windows file nativename a/b } -constraints testsetplatform -cleanup { testsetplatform $platform } -result {a\b} test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} { file exists ~nOsUcHuSeR } 0 test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} -body { # should probably be a non-error in fact... file nativename ~nOsUcHuSeR } -returnCodes error -match glob -result * # The test below has to be done in /tmp rather than the current directory in # order to guarantee (?) a local file system: some NFS file systems won't do # the stuff below correctly. test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup { file delete -force /tmp/tcl.foo.dir/file file delete -force /tmp/tcl.foo.dir } -body { makeDirectory /tmp/tcl.foo.dir makeFile 12345 /tmp/tcl.foo.dir/file file attributes /tmp/tcl.foo.dir -permissions 0o000 file exists /tmp/tcl.foo.dir/file } -cleanup { file attributes /tmp/tcl.foo.dir -permissions 0o775 removeFile /tmp/tcl.foo.dir/file removeDirectory /tmp/tcl.foo.dir } -result 0 test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup { set newdirfile [makeDirectory newdir.file] set cwd [pwd] cd $newdirfile # Content of file is totally unimportant; name is *not* set innocentBystander [makeFile "abc" [file join $newdirfile foo.bar]] } -body { list [file exists foo.bar] [file exists *.bar] } -cleanup { cd $cwd removeFile $innocentBystander removeDirectory $newdirfile } -result {1 0} # Stat related commands catch {testsetplatform $platform} removeFile $gorpfile set gorpfile [makeFile "Test string" gorp.file] catch {file attributes $gorpfile -permissions 0o765} # avoid problems with non-local filesystems if {[testConstraint unix] && [file exists /tmp]} { set file [makeFile "data" touch.me /tmp] } else { set file [makeFile "data" touch.me] } # atime test cmdAH-20.1 {Tcl_FileObjCmd: atime} -returnCodes error -body { file atime a b c } -result {wrong # args: should be "file atime name ?time?"} test cmdAH-20.2 {Tcl_FileObjCmd: atime} -setup { unset -nocomplain stat } -body { file stat $gorpfile stat list [expr {[file mtime $gorpfile] == $stat(mtime)}] \ [expr {[file atime $gorpfile] == $stat(atime)}] } -result {1 1} test cmdAH-20.3 {Tcl_FileObjCmd: atime} { list [catch {file atime _bogus_} msg] [string tolower $msg] $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-20.4 {Tcl_FileObjCmd: atime} -returnCodes error -body { file atime $file notint } -result {expected integer but got "notint"} test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} { set atime [file atime $file] after 1100; # pause a sec to notice change in atime set newatime [clock seconds] set modatime [file atime $file $newatime] expr {$newatime == $modatime ? 1 : "$newatime != $modatime"} } 1 test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup { set old [pwd] cd $::tcltest::temporaryDirectory set volumetype [testvolumetype] cd $old } -constraints {win testvolumetype} -body { if {"NTFS" ne $volumetype} { # Windows FAT doesn't understand atime, but NTFS does. May also fail # for Windows on NFS mounted disks. return 1 } cd $old set atime [file atime $file] after 1100; # pause a sec to notice change in atime set newatime [clock seconds] set modatime [file atime $file $newatime] expr {$newatime == $modatime ? 1 : "$newatime != $modatime"} } -result 1 test cmdAH-20.7 { Tcl_FileObjCmd: atime (built-in Windows names) } -constraints {win} -body { file atime con } -result "could not get access time for file \"con\"" -returnCodes error test cmdAH-20.7.1 { Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension) } -constraints {win} -body { file atime [file join [temporaryDirectory] CON.txt] } -match regexp -result {could not (?:get access time|read)} -returnCodes error if {[testConstraint unix] && [file exists /tmp]} { removeFile touch.me /tmp } else { removeFile touch.me } # isdirectory test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} -returnCodes error -body { file isdirectory a b } -result {wrong # args: should be "file isdirectory name"} test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {file isdirectory $gorpfile} 0 test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {file isdirectory $dirfile} 1 # isfile test cmdAH-22.1 {Tcl_FileObjCmd: isfile} -returnCodes error -body { file isfile a b } -result {wrong # args: should be "file isfile name"} test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile $gorpfile} 1 test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0 # lstat and readlink: don't run these tests everywhere, since not all sites # will have symbolic links catch {file link -symbolic $linkfile $gorpfile} test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body { file lstat a } -result {wrong # args: should be "file lstat name varName"} test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body { file lstat a b c } -result {wrong # args: should be "file lstat name varName"} test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup { unset -nocomplain stat } -constraints {unix nonPortable} -body { file lstat $linkfile stat lsort [array names stat] } -result {atime ctime dev gid ino mode mtime nlink size type uid} test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup { unset -nocomplain stat } -constraints {unix nonPortable} -body { file lstat $linkfile stat list $stat(nlink) [expr {$stat(mode) & 0o777}] $stat(type) } -result {1 511 link} test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} { list [catch {file lstat _bogus_ stat} msg] [string tolower $msg] \ $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup { unset -nocomplain x } -body { set x 44 list [catch {file lstat $gorpfile x} msg] $msg $errorCode } -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}} unset -nocomplain stat # mkdir set dirA [file join [temporaryDirectory] a] set dirB [file join [temporaryDirectory] a] test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} -setup { catch {file delete -force $dirA} } -body { file mkdir $dirA file isdirectory $dirA } -cleanup { file delete $dirA } -result {1} test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} -setup { catch {file delete -force $dirA} } -body { file mkdir $dirA/b file isdirectory $dirA/b } -cleanup { file delete -force $dirA } -result {1} test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} -setup { catch {file delete -force $dirA} } -body { file mkdir $dirA/b/c file isdirectory $dirA/b/c } -cleanup { file delete -force $dirA } -result {1} test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} -setup { catch {file delete -force $dirA} catch {file delete -force $dirB} } -body { file mkdir $dirA/b $dirB/a/c list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c] } -cleanup { file delete -force $dirA file delete -force $dirB } -result {1 1} test cmdAH-23.11 {Tcl_FileObjCmd: mkdir} { # Allow zero arguments (TIP 323) file mkdir } {} set file [makeFile "data" touch.me] # mtime test cmdAH-24.1 {Tcl_FileObjCmd: mtime} -returnCodes error -body { file mtime a b c } -result {wrong # args: should be "file mtime name ?time?"} test cmdAH-24.2 {Tcl_FileObjCmd: mtime} -setup { # Check (allowing for clock-skew and OS interrupts as best we can) that # the change in mtime on a file being written is the time elapsed between # writes. Note that this can still fail on very busy systems if there are # long preemptions between the writes and the reading of the clock, but # there's not much you can do about that other than the completely # horrible "keep on trying to write until you managed to do it all in less # than a second." - DKF waitForEvenSecondForFAT } -body { set f [open $gorpfile w] puts $f "More text" close $f set clockOld [clock seconds] set fileOld [file mtime $gorpfile] after 2000 set f [open $gorpfile w] puts $f "More text" close $f set clockNew [clock seconds] set fileNew [file mtime $gorpfile] expr { (($fileNew > $fileOld) && ($clockNew > $clockOld) && (abs(($fileNew-$fileOld) - ($clockNew-$clockOld)) <= 1)) ? "1" : "file:($fileOld=>$fileNew) clock:($clockOld=>$clockNew)" } } -result {1} test cmdAH-24.3 {Tcl_FileObjCmd: mtime} -setup { unset -nocomplain stat } -body { file stat $gorpfile stat list [expr {[file mtime $gorpfile] == $stat(mtime)}] \ [expr {[file atime $gorpfile] == $stat(atime)}] } -result {1 1} test cmdAH-24.4 {Tcl_FileObjCmd: mtime} { list [catch {file mtime _bogus_} msg] [string tolower $msg] $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-24.5 {Tcl_FileObjCmd: mtime} -setup { # Under Unix, use a file in /tmp to avoid clock skew due to NFS. On other # platforms, just use a file in the local directory. if {[testConstraint unix]} { set name /tmp/tcl.test.[pid] } else { set name [file join [temporaryDirectory] tf] } } -body { # Make sure that a new file's time is correct. 10 seconds variance is # allowed used due to slow networks or clock skew on a network drive. file delete -force $name close [open $name w] expr {abs([clock seconds]-[file mtime $name])<10} } -cleanup { file delete $name } -result {1} test cmdAH-24.7 {Tcl_FileObjCmd: mtime} -returnCodes error -body { file mtime $file notint } -result {expected integer but got "notint"} test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} unix { set mtime [file mtime $file] after 1100; # pause a sec to notice change in mtime set newmtime [clock seconds] set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup { set oldfile $file } -constraints unix -body { # introduce some non-ascii characters. append file \u2022 file delete -force $file file rename $oldfile $file set mtime [file mtime $file] after 1100; # pause a sec to notice change in mtime set newmtime [clock seconds] set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } -cleanup { file rename $file $oldfile } -result 1 test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} -constraints win -setup { waitForEvenSecondForFAT } -body { set mtime [file mtime $file] after 2100; # pause two secs to notice change in mtime on FAT fs'es set newmtime [clock seconds] set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } -result 1 test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup { waitForEvenSecondForFAT set oldfile $file } -constraints win -body { # introduce some non-ascii characters. append file \u2022 file delete -force $file file rename $oldfile $file set mtime [file mtime $file] after 2100; # pause two secs to notice change in mtime on FAT fs'es set newmtime [clock seconds] set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } -cleanup { file rename $file $oldfile } -result 1 removeFile touch.me rename waitForEvenSecondForFAT {} test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} -setup { set name [file join [temporaryDirectory] clockchange] file delete -force $name close [open $name w] } -body { set time [clock scan "21:00:00 October 30 2004 GMT"] file mtime $name $time set newmtime [file mtime $name] expr {$newmtime == $time ? 1 : "$newmtime != $time"} } -cleanup { file delete $name } -result {1} # bug 1420432: setting mtime fails for directories on windows. test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup { set dirname [file join [temporaryDirectory] tmp[pid]] file delete -force $dirname } -constraints tempNotWin -body { file mkdir $dirname set old [file mtime $dirname] file mtime $dirname 0 set new [file mtime $dirname] list $new [expr {$old != $new}] } -cleanup { file delete -force $dirname } -result {0 1} test cmdAH-24.14 { Tcl_FileObjCmd: mtime (built-in Windows names) } -constraints {win} -body { file mtime con } -result "could not get modification time for file \"con\"" -returnCodes error test cmdAH-24.14.1 { Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension) } -constraints {win} -body { file mtime [file join [temporaryDirectory] CON.txt] } -match regexp -result {could not (?:get modification time|read)} -returnCodes error # 3155760000 is 64-bit Unix time, Wed Jan 01 00:00:00 GMT 2070: test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { set filename [makeFile "" foo.text] } -body { list [file atime $filename 3155760000] [file atime $filename] } -cleanup { removeFile $filename } -result {3155760000 3155760000} test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { set filename [makeFile "" foo.text] } -body { list [file mtime $filename 3155760000] [file mtime $filename] } -cleanup { file delete -force $filename } -result {3155760000 3155760000} # owned test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body { file owned a b } -result {wrong # args: should be "file owned name"} test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup { set fn $gorpfile # prefer temp file to check owner (try to avoid bug [7de2d722bd]): if { [info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] && [file dirname $fn] ne [file normalize $::env(TEMP)] } { set fn [file join $::env(TEMP)/test-owner-from-tcl.txt] set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)] } # be sure we have really owned this file before trying to check that # (avoid dependency on admin with UAC and the setting "System objects: # Default owner for objects created by members of the Administrators group"): catch { exec takeown /F [file nativename $fn] } } -body { file owned $fn } -cleanup { if {$fn ne $gorpfile} { removeFile $fn } } -result 1 test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup { # Avoid problems with AFS set tmpfile [makeFile "data" touch.me /tmp] } -body { file owned $tmpfile } -cleanup { removeFile touch.me /tmp } -result 1 test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} { file owned / } 0 test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body { if {[info exists env(SystemRoot)]} { file owned $env(SystemRoot) } else { file owned $env(windir) } } -result 0 test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body { file owned nosuchfile } -result 0 # readlink test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body { file readlink a b } -result {wrong # args: should be "file readlink name"} test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unix nonPortable} { file readlink $linkfile } $gorpfile test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unix nonPortable} { list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode } {1 {could not readlink "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {win nonPortable} { list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode } {1 {could not readlink "_bogus_": invalid argument} {POSIX EINVAL {invalid argument}}} # size test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body { file size a b } -result {wrong # args: should be "file size name"} test cmdAH-27.2 {Tcl_FileObjCmd: size} { set oldsize [file size $gorpfile] set f [open $gorpfile a] fconfigure $f -translation lf -eofchar {} puts $f "More text" close $f expr {[file size $gorpfile] - $oldsize} } {10} test cmdAH-27.3 {Tcl_FileObjCmd: size} { list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-27.4 { Tcl_FileObjCmd: size (built-in Windows names) } -constraints {win} -body { file size con } -result 0 test cmdAH-27.4.1 { Tcl_FileObjCmd: size (built-in Windows names with dir path and extension) } -constraints {win} -body { try { set res [file size [file join [temporaryDirectory] con.txt]] } trap {POSIX ENOENT} {} { set res 0 } set res } -result 0 catch {testsetplatform $platform} removeFile $gorpfile set gorpfile [makeFile "Test string" gorp.file] catch {file attributes $gorpfile -permissions 0o765} # stat test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body { file stat _bogus_ } -result {wrong # args: should be "file stat name varName"} test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body { file stat _bogus_ a b } -result {wrong # args: should be "file stat name varName"} test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup { unset -nocomplain stat set stat(blocks) [set stat(blksize) {}] } -body { file stat $gorpfile stat unset stat(blocks) stat(blksize); # Ignore these fields; not always set lsort [array names stat] } -result {atime ctime dev gid ino mode mtime nlink size type uid} test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup { unset -nocomplain stat } -body { file stat $gorpfile stat list $stat(nlink) $stat(size) $stat(type) } -result {1 12 file} test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix notWsl} -setup { unset -nocomplain stat } -body { file stat $gorpfile stat format 0o%03o [expr {$stat(mode) & 0o777}] } -result 0o765 test cmdAH-28.6 {Tcl_FileObjCmd: stat} { list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup { unset -nocomplain x } -returnCodes error -body { set x 44 file stat $gorpfile x } -result {can't set "x(dev)": variable isn't array} test cmdAH-28.8 {Tcl_FileObjCmd: stat} -setup { set filename [makeFile "" foo.text] } -body { # Sign extension of purported unsigned short to int. file stat $filename stat expr {$stat(mode) > 0} } -cleanup { removeFile $filename } -result 1 test cmdAH-28.9 {Tcl_FileObjCmd: stat} win { # stat of root directory was failing. Don't care about answer, just that # test runs. Relative paths that resolve to root set old [pwd] cd c:/ file stat c: stat file stat c:. stat file stat . stat cd $old file stat / stat file stat c:/ stat file stat c:/. stat } {} test cmdAH-28.10 {Tcl_FileObjCmd: stat} {win nonPortable} { # stat of root directory was failing. Don't care about answer, just that # test runs. file stat //pop/$env(USERNAME) stat file stat //pop/$env(USERNAME)/ stat file stat //pop/$env(USERNAME)/. stat } {} test cmdAH-28.11 {Tcl_FileObjCmd: stat} -setup { set old [pwd] } -constraints {win nonPortable} -body { # stat of network directory was returning id of current local drive. cd c:/ file stat //pop/$env(USERNAME) stat expr {$stat(dev) == 2} } -cleanup { cd $old } -result 0 test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup { set filename [makeFile "" foo.test] } -body { # stat(mode) with S_IFREG flag was returned as a negative number if mode_t # was a short instead of an unsigned short. file stat $filename stat expr {$stat(mode) > 0} } -cleanup { removeFile $filename } -result 1 test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup { unset -nocomplain stat } -body { file stat con stat lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)} } -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0} test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup { unset -nocomplain stat } -body { try { file stat [file join [temporaryDirectory] CON.txt] stat set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}] } trap {POSIX ENOENT} {} { set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0} } set res } -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0} unset -nocomplain stat # type test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body { file type a b } -result {wrong # args: should be "file type name"} test cmdAH-29.2 {Tcl_FileObjCmd: type} { file type $dirfile } directory test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unix nonPortable} { set exists [list [file exists $linkfile] [file exists $gorpfile]] file delete $linkfile set exists2 [list [file exists $linkfile] [file exists $gorpfile]] list $exists $exists2 } {{1 1} {0 1}} test cmdAH-29.3 {Tcl_FileObjCmd: type} { file type $gorpfile } file test cmdAH-29.4 {Tcl_FileObjCmd: type} -constraints {unix} -setup { catch {file delete $linkfile} } -body { # Unlike [exec ln -s], [file link] requires an existing target file link -symbolic $linkfile $gorpfile file type $linkfile } -cleanup { file delete $linkfile } -result link test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup { set tempdir [makeDirectory temp] } -body { set linkdir [file join [temporaryDirectory] link.dir] file link -symbolic $linkdir $tempdir file type $linkdir } -cleanup { file delete $linkdir removeDirectory $tempdir } -result link test cmdAH-29.5 {Tcl_FileObjCmd: type} { list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-29.6 { Tcl_FileObjCmd: type (built-in Windows names) } -constraints {win} -body { file type con } -result "characterSpecial" test cmdAH-29.6.1 { Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension) } -constraints {win} -body { try { set res [file type [file join [temporaryDirectory] CON.txt]] } trap {POSIX ENOENT} {} { set res {characterSpecial} } set res } -result "characterSpecial" # Error conditions test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file gorp x } -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable} test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file ex x } -match glob -result {unknown or ambiguous subcommand "ex": must be *} test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file is x } -match glob -result {unknown or ambiguous subcommand "is": must be *} test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file z x } -match glob -result {unknown or ambiguous subcommand "z": must be *} test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file read x } -match glob -result {unknown or ambiguous subcommand "read": must be *} test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file s x } -match glob -result {unknown or ambiguous subcommand "s": must be *} test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file t x } -match glob -result {unknown or ambiguous subcommand "t": must be *} test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file dirname ~woohgy } -result {user "woohgy" doesn't exist} # channels # In testing 'file channels', we need to make sure that a channel created in # one interp isn't visible in another. interp create simpleInterp interp create -safe safeInterp interp create catch {safeInterp expose file file} test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} -body { file channels a b } -returnCodes error -result {wrong # args: should be "file channels ?pattern?"} test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} { # Normal interps start out with only the standard channels lsort [simpleInterp eval [list file chan]] } {stderr stdin stdout} test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} { string equal [file channels] [file channels *] } {1} test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} { lsort [file channels std*] } {stderr stdin stdout} set newFileId [open $gorpfile w] test cmdAH-31.5 {Tcl_FileObjCmd: channels} { set res [file channels $newFileId] string equal $newFileId $res } {1} test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} { # Safe interps start out with no channels safeInterp eval [list file channels] } {} test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} -body { safeInterp eval [list puts $newFileId "hello"] } -returnCodes error -result "can not find channel named \"$newFileId\"" interp share {} $newFileId safeInterp interp share {} stdout safeInterp test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} { # $newFileId should now be visible in both interps list [file channels $newFileId] \ [safeInterp eval [list file channels $newFileId]] } [list $newFileId $newFileId] test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} { lsort [safeInterp eval [list file channels]] } [lsort [list stdout $newFileId]] test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} { # we can now write to $newFileId from child safeInterp eval [list puts $newFileId "hello"] } {} interp transfer {} $newFileId safeInterp test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} { # $newFileId should now be visible only in safeInterp list [file channels $newFileId] \ [safeInterp eval [list file channels $newFileId]] } [list {} $newFileId] test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} { lsort [safeInterp eval [list file channels]] } [lsort [list stdout $newFileId]] test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} { safeInterp eval [list close $newFileId] safeInterp eval [list file channels] } {stdout} # Temp files (TIP#210) test cmdAH-32.1 {file tempfile - usage} -returnCodes error -body { file tempfile a b c } -result {wrong # args: should be "file tempfile ?nameVar? ?template?"} test cmdAH-32.2 {file tempfile - returns a read/write channel} -body { set f [file tempfile] puts $f ok seek $f 0 gets $f } -cleanup { catch {close $f} } -result ok test cmdAH-32.3 {file tempfile - makes filenames} -setup { unset -nocomplain name } -body { set result [info exists name] set f [file tempfile name] lappend result [info exists name] [file exists $name] close $f lappend result [file exists $name] } -cleanup { catch {close $f} catch {file delete $name} } -result {0 1 1 1} # We try to obey the template on Unix, but don't (currently) bother on Win test cmdAH-32.4 {file tempfile - templates} -constraints unix -body { close [file tempfile name foo] expr {[string match foo* [file tail $name]] ? "ok" : "foo produced $name"} } -cleanup { catch {file delete $name} } -result ok test cmdAH-32.5 {file tempfile - templates} -constraints unix -body { set template [file join $dirfile foo] close [file tempfile name $template] expr {[string match $template* $name] ? "ok" : "$template produced $name"} } -cleanup { catch {file delete $name} } -result ok # Not portable; not all Unix systems have mkstemps() test cmdAH-32.6 {file tempfile - templates} -body { set template [file join $dirfile foo] close [file tempfile name $template.bar] expr {[string match $template*.bar $name] ? "ok" : "$template.bar produced $name"} } -constraints {unix nonPortable} -cleanup { catch {file delete $name} } -result ok # This shouldn't work, but just in case a test above failed... catch {close $newFileId} interp delete safeInterp interp delete simpleInterp # cleanup catch {testsetplatform $platform} unset -nocomplain platform # Tcl_ForObjCmd is tested in for.test catch {file attributes $dirfile -permissions 0o777} removeDirectory $dirfile removeFile $gorpfile # No idea how well [removeFile] copes with links... file delete $linkfile cd $cmdAHwd ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/cmdIL.test0000644000175000017500000007035714554262142014711 0ustar sergeisergei# This file contains a collection of tests for the procedures in the file # tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] source [file join [file dirname [info script]] internals.tcl] namespace import -force ::tcltest::internals::* test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort } -result {wrong # args: should be "lsort ?-option value ...? list"} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort -foo {1 3 2 5} } -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique} test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} { lsort {d e c b a \{ d35 d300} } {a b c d d300 d35 e \{} test cmdIL-1.4 {Tcl_LsortObjCmd procedure, -ascii option} { lsort -integer -ascii {d e c b a d35 d300} } {a b c d d300 d35 e} test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} -body { lsort -command {1 3 2 5} } -returnCodes error -result {"-command" option must be followed by comparison command} test cmdIL-1.6 {Tcl_LsortObjCmd procedure, -command option} -setup { proc cmp {a b} { expr {[string match x* $b] - [string match x* $a]} } } -body { lsort -command cmp {x1 abc x2 def x3 x4} } -result {x1 x2 x3 x4 abc def} -cleanup { rename cmp "" } test cmdIL-1.7 {Tcl_LsortObjCmd procedure, -decreasing option} { lsort -decreasing {d e c b a d35 d300} } {e d35 d300 d c b a} test cmdIL-1.8 {Tcl_LsortObjCmd procedure, -dictionary option} { lsort -dictionary {d e c b a d35 d300} } {a b c d d35 d300 e} test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} { lsort -dictionary {1k 0k 10k} } {0k 1k 10k} test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -increasing option} { lsort -decreasing -increasing {d e c b a d35 d300} } {a b c d d300 d35 e} test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} -body { lsort -index {1 3 2 5} } -returnCodes error -result {"-index" option must be followed by list index} test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} -body { lsort -index foo {1 3 2 5} } -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?} test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} { lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1} } {1 {2 25} {3 16 42} {10 20 50 100}} test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} { lsort -index 1 -integer {{1 25 100} {3 16 42} {10 20 50}} } {{3 16 42} {10 20 50} {1 25 100}} test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} { lsort -integer {24 6 300 18} } {6 18 24 300} test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} -body { lsort -integer {1 3 2.4} } -returnCodes error -result {expected integer but got "2.4"} test cmdIL-1.17 {Tcl_LsortObjCmd procedure, -real option} { lsort -real {24.2 6e3 150e-1} } {150e-1 24.2 6e3} test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} -body { lsort "1 2 3 \{ 4" } -returnCodes error -result {unmatched open brace in list} test cmdIL-1.19 {Tcl_LsortObjCmd procedure, empty list} { lsort {} } {} test cmdIL-1.22 {Tcl_LsortObjCmd procedure, unique sort} { lsort -integer -unique {3 1 2 3 1 4 3} } {1 2 3 4} test cmdIL-1.23 {Tcl_LsortObjCmd procedure, unique sort with index} { # lsort -unique should return the last unique item lsort -unique -index 0 {{a b} {c b} {a c} {d a}} } {{a c} {c b} {d a}} test cmdIL-1.24 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup { catch {rename 1 ""} proc testcmp {a b} {return [string compare $a $b]} } -body { set l [list [list a b] [list c d]] lsort -command testcmp -index 1 $l } -cleanup { rename testcmp "" } -result [list [list a b] [list c d]] test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup { catch {rename 1 ""} proc testcmp {a b} {return [string compare $a $b]} } -body { set l [list [list a b] [list c d]] lsort -index 1 -command testcmp $l } -cleanup { rename testcmp "" } -result [list [list a b] [list c d]] # Note that the required order only exists in the end-1'th element; indexing # using the end element or any fixed offset from the start will not work... test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} { lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}} } {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}} test cmdIL-1.27 {Tcl_LsortObjCmd procedure, returning indices} { lsort -indices {a c b} } {0 2 1} test cmdIL-1.28 {Tcl_LsortObjCmd procedure, returning indices} { lsort -indices -unique -decreasing -real {1.2 34.5 34.5 5.6} } {2 3 0} test cmdIL-1.29 {Tcl_LsortObjCmd procedure, loss of list rep during sorting} { set l {1 2 3} string length [lsort -command {apply {args {string length $::l}}} $l] } 5 test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} { lsort -stride 2 {f e d c b a} } {b a d c f e} test cmdIL-1.31 {Tcl_LsortObjCmd procedure, -stride option} { lsort -stride 3 {f e d c b a} } {c b a f e d} test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body { lsort -stride foo bar } -result {expected integer but got "foo"} test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body { lsort -stride 1 bar } -result {stride length must be at least 2} test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body { lsort -stride 2 {a b c} } -result {list size must be a multiple of the stride length} test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body { lsort -stride 2 -index 3 {a b c d} } -result {when used with "-stride", the leading "-index" value must be within the group} test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} { lsort -stride 2 -index {0 1} { {{c o d e} 54321} {{b l a h} 94729} {{b i g} 12345} {{d e m o} 34512} } } {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}} test cmdIL-1.41 {lsort -stride and -index} -body { lsort -stride 2 -index -2 {a 2 b 1} } -returnCodes error -result {index "-2" cannot select an element from any list} test cmdIL-1.42 {lsort -stride and-index} -body { lsort -stride 2 -index -1-1 {a 2 b 1} } -returnCodes error -result {index "-1-1" cannot select an element from any list} # Can't think of any good tests for the MergeSort and MergeLists procedures, # except a bunch of random lists to sort. test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup { set result {} set r 1435753299 proc rand {} { global r set r [expr {(16807 * $r) % (0x7fffffff)}] } } -body { for {set i 0} {$i < 150} {incr i} { set x {} for {set j 0} {$j < $i} {incr j} { lappend x [expr {[rand] & 0xfff}] } set y [lsort -integer $x] set old -1 foreach el $y { if {$el < $old} { append result "list {$x} sorted to {$y}, element $el out of order\n" break } set old $el } } string trim $result } -cleanup { rename rand "" } -result {} test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -body { set ::x 0 list [catch { lsort -integer -command {apply {{a b} { incr ::x error "error #$::x" }}} {48 6 28 190 16 2 3 6 1} } msg] $msg $::x } -result {1 {error #1} 1} test cmdIL-3.2 {SortCompare procedure, -index option} -body { lsort -integer -index 2 "\\\{ {30 40 50}" } -returnCodes error -result {unmatched open brace in list} test cmdIL-3.3 {SortCompare procedure, -index option} -body { lsort -integer -index 2 {{20 10} {15 30 40}} } -returnCodes error -result {element 2 missing from sublist "20 10"} test cmdIL-3.4 {SortCompare procedure, -index option} -body { lsort -integer -index 2 "{a b c} \\\{" } -returnCodes error -result {expected integer but got "c"} test cmdIL-3.4.1 {SortCompare procedure, -index option} -body { lsort -integer -index 2 "{1 2 3} \\\{" } -returnCodes error -result {unmatched open brace in list} test cmdIL-3.5 {SortCompare procedure, -index option} -body { lsort -integer -index 2 {{20 10 13} {15}} } -returnCodes error -result {element 2 missing from sublist "15"} test cmdIL-3.5.1 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index 1+3 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {element 4 missing from sublist "1 . c"} test cmdIL-3.5.2 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index -1-1 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {index "-1-1" cannot select an element from any list} test cmdIL-3.5.3 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index -2 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {index "-2" cannot select an element from any list} test cmdIL-3.5.4 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index end-4 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {element -2 missing from sublist "1 . c"} test cmdIL-3.5.5 {SortCompare procedure, -index option} { lsort -index {} {a b} } {a b} test cmdIL-3.5.6 {SortCompare procedure, -index option} { lsort -index {} [list a \{] } {a \{} test cmdIL-3.5.7 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index end--1 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {index "end--1" cannot select an element from any list} test cmdIL-3.5.8 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index end+1 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {index "end+1" cannot select an element from any list} test cmdIL-3.5.9 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index end+2 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {index "end+2" cannot select an element from any list} test cmdIL-3.6 {SortCompare procedure, -index option} { lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}} } {{3 25 20} {2 5 25} {1 15 30}} test cmdIL-3.7 {SortCompare procedure, -ascii option} { lsort -ascii {d e c b a d35 d300 100 20} } {100 20 a b c d d300 d35 e} test cmdIL-3.8 {SortCompare procedure, -dictionary option} { lsort -dictionary {d e c b a d35 d300 100 20} } {20 100 a b c d d35 d300 e} test cmdIL-3.9 {SortCompare procedure, -integer option} -body { lsort -integer {x 3} } -returnCodes error -result {expected integer but got "x"} test cmdIL-3.10 {SortCompare procedure, -integer option} -body { lsort -integer {3 q} } -returnCodes error -result {expected integer but got "q"} test cmdIL-3.11 {SortCompare procedure, -integer option} { lsort -integer {35 21 0x20 30 0o23 100 8} } {8 0o23 21 30 0x20 35 100} test cmdIL-3.12 {SortCompare procedure, -real option} -body { lsort -real {6...4 3} } -returnCodes error -result {expected floating-point number but got "6...4"} test cmdIL-3.13 {SortCompare procedure, -real option} -body { lsort -real {3 1x7} } -returnCodes error -result {expected floating-point number but got "1x7"} test cmdIL-3.14 {SortCompare procedure, -real option} { lsort -real {24 2.5e01 16.7 85e-1 10.004} } {85e-1 10.004 16.7 24 2.5e01} test cmdIL-3.15 {SortCompare procedure, -command option} -body { proc cmp {a b} { error "comparison error" } list [catch {lsort -command cmp {48 6}} msg] $msg $::errorInfo } -cleanup { rename cmp "" } -result {1 {comparison error} {comparison error while executing "error "comparison error"" (procedure "cmp" line 2) invoked from within "cmp 48 6" (-compare command) invoked from within "lsort -command cmp {48 6}"}} test cmdIL-3.16 {SortCompare procedure, -command option, long command} -body { proc cmp {dummy a b} { string compare $a $b } lsort -command {cmp {this argument is very very long in order to make the dstring overflow its statically allocated space}} {{this first element is also long in order to help expand the dstring} {the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring}} } -cleanup { rename cmp "" } -result {{the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring} {this first element is also long in order to help expand the dstring}} test cmdIL-3.17 {SortCompare procedure, -command option, non-integer result} -body { proc cmp {a b} { return foow } lsort -command cmp {48 6} } -returnCodes error -cleanup { rename cmp "" } -result {-compare command returned non-integer result} test cmdIL-3.18 {SortCompare procedure, -command option} -body { proc cmp {a b} { expr {$b - $a} } lsort -command cmp {48 6 18 22 21 35 36} } -cleanup { rename cmp "" } -result {48 36 35 22 21 18 6} test cmdIL-3.19 {SortCompare procedure, -decreasing option} { lsort -decreasing -integer {35 21 0x20 30 0o23 100 8} } {100 35 0x20 30 21 0o23 8} test cmdIL-4.1 {DictionaryCompare procedure, numerics, leading zeros} { lsort -dictionary {a003b a03b} } {a03b a003b} test cmdIL-4.2 {DictionaryCompare procedure, numerics, leading zeros} { lsort -dictionary {a3b a03b} } {a3b a03b} test cmdIL-4.3 {DictionaryCompare procedure, numerics, leading zeros} { lsort -dictionary {a3b A03b} } {A03b a3b} test cmdIL-4.4 {DictionaryCompare procedure, numerics, leading zeros} { lsort -dictionary {a3b a03B} } {a3b a03B} test cmdIL-4.5 {DictionaryCompare procedure, numerics, leading zeros} { lsort -dictionary {00000 000} } {000 00000} test cmdIL-4.6 {DictionaryCompare procedure, numerics, different lengths} { lsort -dictionary {a321b a03210b} } {a321b a03210b} test cmdIL-4.7 {DictionaryCompare procedure, numerics, different lengths} { lsort -dictionary {a03210b a321b} } {a321b a03210b} test cmdIL-4.8 {DictionaryCompare procedure, numerics} { lsort -dictionary {48 6a 18b 22a 21aa 35 36} } {6a 18b 21aa 22a 35 36 48} test cmdIL-4.9 {DictionaryCompare procedure, numerics} { lsort -dictionary {a123x a123b} } {a123b a123x} test cmdIL-4.10 {DictionaryCompare procedure, numerics} { lsort -dictionary {a123b a123x} } {a123b a123x} test cmdIL-4.11 {DictionaryCompare procedure, numerics} { lsort -dictionary {a1b aab} } {a1b aab} test cmdIL-4.12 {DictionaryCompare procedure, numerics} { lsort -dictionary {a1b a!b} } {a!b a1b} test cmdIL-4.13 {DictionaryCompare procedure, numerics} { lsort -dictionary {a1b2c a1b1c} } {a1b1c a1b2c} test cmdIL-4.14 {DictionaryCompare procedure, numerics} { lsort -dictionary {a1b2c a1b3c} } {a1b2c a1b3c} test cmdIL-4.15 {DictionaryCompare procedure, long numbers} { lsort -dictionary {a7654884321988762b a7654884321988761b} } {a7654884321988761b a7654884321988762b} test cmdIL-4.16 {DictionaryCompare procedure, long numbers} { lsort -dictionary {a8765488432198876b a7654884321988761b} } {a7654884321988761b a8765488432198876b} test cmdIL-4.17 {DictionaryCompare procedure, case} { lsort -dictionary {aBCd abcc} } {abcc aBCd} test cmdIL-4.18 {DictionaryCompare procedure, case} { lsort -dictionary {aBCd abce} } {aBCd abce} test cmdIL-4.19 {DictionaryCompare procedure, case} { lsort -dictionary {abcd ABcc} } {ABcc abcd} test cmdIL-4.20 {DictionaryCompare procedure, case} { lsort -dictionary {abcd ABce} } {abcd ABce} test cmdIL-4.21 {DictionaryCompare procedure, case} { lsort -dictionary {abCD ABcd} } {ABcd abCD} test cmdIL-4.22 {DictionaryCompare procedure, case} { lsort -dictionary {ABcd aBCd} } {ABcd aBCd} test cmdIL-4.23 {DictionaryCompare procedure, case} { lsort -dictionary {ABcd AbCd} } {ABcd AbCd} test cmdIL-4.24 {DictionaryCompare procedure, international characters} {hasIsoLocale} { ::tcltest::set_iso8859_1_locale set result [lsort -dictionary "a b c A B C \xe3 \xc4"] ::tcltest::restore_locale set result } "A a B b C c \xe3 \xc4" test cmdIL-4.25 {DictionaryCompare procedure, international characters} {hasIsoLocale} { ::tcltest::set_iso8859_1_locale set result [lsort -dictionary "a23\xe3 a23\xc5 a23\xe4"] ::tcltest::restore_locale set result } "a23\xe3 a23\xe4 a23\xc5" test cmdIL-4.26 {DefaultCompare procedure, signed characters} { set l [lsort [list "abc\200" "abc"]] set viewlist {} foreach s $l { set viewelem "" set len [string length $s] for {set i 0} {$i < $len} {incr i} { set c [string index $s $i] scan $c %c d if {$d > 0 && $d < 128} { append viewelem $c } else { append viewelem "\\[format %03o $d]" } } lappend viewlist $viewelem } set viewlist } [list "abc" "abc\\200"] test cmdIL-4.27 {DictionaryCompare procedure, signed characters} { set l [lsort -dictionary [list "abc\200" "abc"]] set viewlist {} foreach s $l { set viewelem "" set len [string length $s] for {set i 0} {$i < $len} {incr i} { set c [string index $s $i] scan $c %c d if {$d > 0 && $d < 128} { append viewelem $c } else { append viewelem "\\[format %03o $d]" } } lappend viewlist $viewelem } set viewlist } [list "abc" "abc\\200"] test cmdIL-4.28 {DictionaryCompare procedure, chars between Z and a in ASCII} { lsort -dictionary [list AA ` c CC] } [list ` AA c CC] test cmdIL-4.29 {DictionaryCompare procedure, chars between Z and a in ASCII} { lsort -dictionary [list AA ` c ^ \\ CC \[ \]] } [list \[ \\ \] ^ ` AA c CC] test cmdIL-4.30 {DictionaryCompare procedure, chars between Z and a in ASCII} { lsort -dictionary [list AA ` c ^ _ \\ CC \[ dude \] funky] } [list \[ \\ \] ^ _ ` AA c CC dude funky] test cmdIL-4.31 {DictionaryCompare procedure, chars between Z and a in ASCII} { lsort -dictionary [list AA c ` CC] } [list ` AA c CC] test cmdIL-4.32 {DictionaryCompare procedure, chars between Z and a in ASCII} { lsort -dictionary [list AA c CC `] } [list ` AA c CC] test cmdIL-4.33 {DictionaryCompare procedure, chars between Z and a in ASCII} { lsort -dictionary [list AA ! c CC `] } [list ! ` AA c CC] test cmdIL-4.34 {SortCompare procedure, -ascii option with -nocase option} { lsort -ascii -nocase {d e c b a d35 d300 100 20} } {100 20 a b c d d300 d35 e} test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} { lsort -ascii -nocase {d E c B a D35 d300 100 20} } {100 20 a B c d d300 D35 E} test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} { scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c } {257 32 256} test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} { scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c } {97 32 97 0 97} test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} { scan [lsort -ascii -nocase [list a a\u0000a]] %c%c%c%c%c } {97 32 97 0 97} test cmdIL-5.1 {lsort with list style index} { lsort -ascii -decreasing -index {0 1} { {{Jim Alpha} 20000410} {{Joe Bravo} 19990320} {{Jacky Charlie} 19390911} } } {{{Jacky Charlie} 19390911} {{Joe Bravo} 19990320} {{Jim Alpha} 20000410}} test cmdIL-5.2 {lsort with list style index} { lsort -decreasing -index {0 1} { {{Jim Alpha} 20000410} {{Joe Bravo} 19990320} {{Jacky Charlie} 19390911} } } {{{Jacky Charlie} 19390911} {{Joe Bravo} 19990320} {{Jim Alpha} 20000410}} test cmdIL-5.3 {lsort with list style index} { lsort -integer -increasing -index {1 end} { {{Jim Alpha} 20000410} {{Joe Bravo} 19990320} {{Jacky Charlie} 19390911} } } {{{Jacky Charlie} 19390911} {{Joe Bravo} 19990320} {{Jim Alpha} 20000410}} test cmdIL-5.4 {lsort with list style index} { lsort -integer -index {1 end-1} { {the {0 1 2 3 4 5} quick} {brown {0 1 2 3 4} fox} {jumps {30 31 2 33} over} {the {0 1 2} lazy} {dogs {0 1}} } } {{dogs {0 1}} {the {0 1 2} lazy} {jumps {30 31 2 33} over} {brown {0 1 2 3 4} fox} {the {0 1 2 3 4 5} quick}} test cmdIL-5.5 {lsort with list style index and sharing} -body { proc test_lsort {l} { set n $l foreach e $l {lappend n [list [expr {rand()}] $e]} lindex [lsort -real -index $l $n] 1 1 } expr {srand(1)} test_lsort 0 } -result 0 -cleanup { rename test_lsort "" } test cmdIL-5.6 {lsort with multiple list-style index options} { lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}} } {{a b} {b e} {c d}} test cmdIL-5.7 {lsort memory exhaustion} -constraints {testWithLimit} -body { # test it in child process (with limited address space) ca. 80MB extra memory # on x64 system it would be not enough to sort 4M items (the half 2M only), # warn and skip if no error (enough memory) or error by list creation: testWithLimit \ -warn-on-code 0 -warn-on-alloc-error 1 \ -addmem [expr {$tcl_platform(pointerSize)*4000000 + $tcl_platform(pointerSize)*3*2000000}] \ { # create list and get length (avoid too long output in interactive shells): llength [set l [lrepeat 4000000 ""]] # test OOM: llength [lsort $l] } # expecting error no memory by sort } -returnCodes 1 -result {no enough memory to proccess sort of 4000000 items} # Compiled version test cmdIL-6.1 {lassign command syntax} -returnCodes error -body { apply {{} { lassign }} } -result {wrong # args: should be "lassign list ?varName ...?"} test cmdIL-6.2 {lassign command syntax} { apply {{} { lassign x }} } x test cmdIL-6.3 {lassign command} -body { apply {{} { set x FAIL list [lassign a x] $x }} } -result {{} a} test cmdIL-6.4 {lassign command} -body { apply {{} { set x FAIL set y FAIL list [lassign a x y] $x $y }} } -result {{} a {}} test cmdIL-6.5 {lassign command} -body { apply {{} { set x FAIL set y FAIL list [lassign {a b} x y] $x $y }} } -result {{} a b} test cmdIL-6.6 {lassign command} -body { apply {{} { set x FAIL set y FAIL list [lassign {a b c} x y] $x $y }} } -result {c a b} test cmdIL-6.7 {lassign command} -body { apply {{} { set x FAIL set y FAIL list [lassign {a b c d} x y] $x $y }} } -result {{c d} a b} test cmdIL-6.8 {lassign command - list format error} -body { apply {{} { set x FAIL set y FAIL list [catch {lassign {a {b}c d} x y} msg] $msg $x $y }} } -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} test cmdIL-6.9 {lassign command - assignment to arrays} -body { apply {{} { list [lassign {a b} x(x)] $x(x) }} } -result {b a} test cmdIL-6.10 {lassign command - variable update error} -body { apply {{} { set x(x) {} lassign a x }} } -returnCodes error -result {can't set "x": variable is array} test cmdIL-6.11 {lassign command - variable update error} -body { apply {{} { set x(x) {} set y FAIL list [catch {lassign a y x} msg] $msg $y }} } -result {1 {can't set "x": variable is array} a} test cmdIL-6.12 {lassign command - memory leak testing} -setup { unset -nocomplain x y set x(x) {} set y FAIL proc getbytes {} { set lines [split [memory info] "\n"] lindex [lindex $lines 3] 3 } proc stress {} { global x y lassign {} y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y catch {lassign {} y y y y y y y y y y y y y y y y y y y y y y y y y x} catch {lassign {} x} } } -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { stress set tmp $end set end [getbytes] } expr {$end - $tmp} } -result 0 -cleanup { unset -nocomplain x y i tmp end rename getbytes {} rename stress {} } # Force non-compiled version test cmdIL-6.13 {lassign command syntax} -returnCodes error -body { apply {{} { set lassign lassign $lassign }} } -result {wrong # args: should be "lassign list ?varName ...?"} test cmdIL-6.14 {lassign command syntax} { apply {{} { set lassign lassign $lassign x }} } x test cmdIL-6.15 {lassign command} -body { apply {{} { set lassign lassign set x FAIL list [$lassign a x] $x }} } -result {{} a} test cmdIL-6.16 {lassign command} -body { apply {{} { set lassign lassign set x FAIL set y FAIL list [$lassign a x y] $x $y }} } -result {{} a {}} test cmdIL-6.17 {lassign command} -body { apply {{} { set lassign lassign set x FAIL set y FAIL list [$lassign {a b} x y] $x $y }} } -result {{} a b} test cmdIL-6.18 {lassign command} -body { apply {{} { set lassign lassign set x FAIL set y FAIL list [$lassign {a b c} x y] $x $y }} } -result {c a b} test cmdIL-6.19 {lassign command} -body { apply {{} { set lassign lassign set x FAIL set y FAIL list [$lassign {a b c d} x y] $x $y }} } -result {{c d} a b} test cmdIL-6.20 {lassign command - list format error} -body { apply {{} { set lassign lassign set x FAIL set y FAIL list [catch {$lassign {a {b}c d} x y} msg] $msg $x $y }} } -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} test cmdIL-6.21 {lassign command - assignment to arrays} -body { apply {{} { set lassign lassign list [$lassign {a b} x(x)] $x(x) }} } -result {b a} test cmdIL-6.22 {lassign command - variable update error} -body { apply {{} { set lassign lassign set x(x) {} $lassign a x }} } -returnCodes 1 -result {can't set "x": variable is array} test cmdIL-6.23 {lassign command - variable update error} -body { apply {{} { set lassign lassign set x(x) {} set y FAIL list [catch {$lassign a y x} msg] $msg $y }} } -result {1 {can't set "x": variable is array} a} test cmdIL-6.24 {lassign command - memory leak testing} -setup { set x(x) {} set y FAIL proc getbytes {} { set lines [split [memory info] "\n"] lindex [lindex $lines 3] 3 } proc stress {} { global x y set lassign lassign $lassign {} y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y catch {$lassign {} y y y y y y y y y y y y y y y y y y y y y y y y y x} catch {$lassign {} x} } } -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { stress set tmp $end set end [getbytes] } expr {$end - $tmp} } -result 0 -cleanup { unset -nocomplain x y i tmp end rename getbytes {} rename stress {} } # Assorted shimmering problems test cmdIL-6.25 {lassign command - shimmering protection} -body { apply {{} { set x {a b c} list [lassign $x $x y] $x [set $x] $y }} } -result {c {a b c} a b} test cmdIL-6.26 {lassign command - shimmering protection} -body { apply {{} { set x {a b c} set lassign lassign list [$lassign $x $x y] $x [set $x] $y }} } -result {c {a b c} a b} test cmdIL-7.1 {lreverse command} -body { lreverse } -returnCodes error -result "wrong # args: should be \"lreverse list\"" test cmdIL-7.2 {lreverse command} -body { lreverse a b } -returnCodes error -result "wrong # args: should be \"lreverse list\"" test cmdIL-7.3 {lreverse command} -body { lreverse "not \{a list" } -returnCodes error -result {unmatched open brace in list} test cmdIL-7.4 {lreverse command - shared object} { set x {a b {c d} e f} lreverse $x } {f e {c d} b a} test cmdIL-7.5 {lreverse command - unshared object} { lreverse [list a b {c d} e f] } {f e {c d} b a} test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} { lreverse [set x {1 2 3}][unset x] } {3 2 1} test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} { lreverse [list] } {} test cmdIL-7.8 {lreverse command - shared internalrep [Bug 1675044]} -setup { teststringobj set 1 {1 2 3} testobj convert 1 list testobj duplicate 1 2 variable x [teststringobj get 1] variable y [teststringobj get 2] testobj freeallvars proc K {a b} {return $a} } -constraints testobj -body { lreverse [K $y [unset y]] lindex $x 0 } -cleanup { unset -nocomplain x y rename K {} } -result 1 # This belongs in info test, but adding tests there breaks tests # that compute source file line numbers. test info-20.6 {Bug 3587651} -setup { namespace eval my {namespace eval tcl {namespace eval mathfunc { proc demo x {return 42} }}}} -body { namespace eval my {expr {"demo" in [info functions]}}} -cleanup { namespace delete my } -result 1 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/cmdInfo.test0000644000175000017500000000715614554262142015275 0ustar sergeisergei# Commands covered: none # # This file contains a collection of tests for Tcl_GetCommandInfo, # Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and # Tcl_NameOfCommand. Sourcing this file into Tcl runs the tests # and generates output for errors. No output means no errors were # found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testcmdinfo [llength [info commands testcmdinfo]] testConstraint testcmdtoken [llength [info commands testcmdtoken]] test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 testcmdinfo get x1 } {CmdProc1 original CmdDelProc1 original :: stringProc} test cmdinfo-1.2 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 x1 } {CmdProc1 original} test cmdinfo-1.3 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 testcmdinfo modify x1 testcmdinfo get x1 } {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc} test cmdinfo-1.4 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 testcmdinfo modify x1 x1 } {CmdProc2 new_command_data} test cmdinfo-2.1 {command deletion callbacks} {testcmdinfo} { testcmdinfo create x1 testcmdinfo delete x1 } {CmdDelProc1 original} test cmdinfo-2.2 {command deletion callbacks} {testcmdinfo} { testcmdinfo create x1 testcmdinfo modify x1 testcmdinfo delete x1 } {CmdDelProc2 new_delete_data} test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} { testcmdinfo get non_existent } {??} test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} { testcmdinfo create x1 testcmdinfo modify x1 } 1 test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} { testcmdinfo modify non_existent } 0 test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \ {testcmdtoken} { set x [testcmdtoken create x1] rename x1 newName set y [testcmdtoken name $x] rename newName x1 lappend y {*}[testcmdtoken name $x] } {newName ::newName x1 ::x1} catch {rename newTestCmd {}} catch {rename newTestCmd2 {}} test cmdinfo-5.1 {Names for commands created when inside namespaces} \ {testcmdtoken} { # create namespace cmdInfoNs1 namespace eval cmdInfoNs1 {} ;# creates namespace cmdInfoNs1 # create namespace cmdInfoNs1::cmdInfoNs2 and execute a script in it set x [namespace eval cmdInfoNs1::cmdInfoNs2 { # the following creates a cmd in the global namespace testcmdtoken create testCmd }] set y [testcmdtoken name $x] rename ::testCmd newTestCmd lappend y {*}[testcmdtoken name $x] } {testCmd ::testCmd newTestCmd ::newTestCmd} test cmdinfo-6.1 {Names for commands created when outside namespaces} \ {testcmdtoken} { set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd] set y [testcmdtoken name $x] rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 lappend y {*}[testcmdtoken name $x] } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2} # cleanup catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1} catch {rename x1 ""} cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/cmdMZ.test0000644000175000017500000004376514565156356014751 0ustar sergeisergei# The tests in this file cover the procedures in tclCmdMZ.c. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." return } namespace eval ::tcl::test::cmdMZ { namespace import ::tcltest::cleanupTests namespace import ::tcltest::customMatch namespace import ::tcltest::makeFile namespace import ::tcltest::removeFile namespace import ::tcltest::temporaryDirectory namespace import ::tcltest::testConstraint namespace import ::tcltest::test if {[namespace which -command ::tcl::unsupported::timerate] ne ""} { namespace import ::tcl::unsupported::timerate } proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 } foreach e $expected a $actual { if {![string match $e $a]} { return 0 } } return 1 } customMatch listGlob [namespace which ListGlobMatch] # Tcl_PwdObjCmd test cmdMZ-1.1 {Tcl_PwdObjCmd} -returnCodes error -body { pwd a } -result {wrong # args: should be "pwd"} test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} { catch pwd } 0 test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} -body { pwd } -match glob -result {?*} test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} -setup { set cwd [pwd] set foodir [file join [temporaryDirectory] foo] file delete -force $foodir file mkdir $foodir cd $foodir } -constraints {Unix nonPortable} -body { # This test fails on various Unix platforms (eg Linux) where permissions # caching causes this to fail. The caching is strictly incorrect, but we # have no control over that. file attr . -permissions 0o000 pwd } -returnCodes error -cleanup { cd $cwd file delete -force $foodir } -result {error getting working directory name: permission denied} # The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test # Tcl_RenameObjCmd test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body { rename r1 } -result {wrong # args: should be "rename oldName newName"} test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body { rename r1 r2 r3 } -result {wrong # args: should be "rename oldName newName"} test cmdMZ-2.3 {Tcl_RenameObjCmd: success} -setup { catch {rename r2 {}} } -body { proc r1 {} {return "r1"} rename r1 r2 r2 } -result {r1} test cmdMZ-2.4 {Tcl_RenameObjCmd: success} { proc r1 {} {return "r1"} rename r1 {} list [catch {r1} msg] $msg } {1 {invalid command name "r1"}} # Some tests for Tcl_ReturnObjCmd are in proc-old.test test cmdMZ-return-1.0 {return checks for bad option values} -body { return -options foo } -returnCodes error -match glob -result {bad -options value:*} test cmdMZ-return-1.1 {return checks for bad option values} -body { return -code err } -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} test cmdMZ-return-1.2 {return checks for bad option values} -body { return -code 0x100000000 } -returnCodes error -match glob -result {bad completion code "0x100000000": must be ok, error, return, break, continue*, or an integer} test cmdMZ-return-1.3 {return checks for bad option values} -body { return -level foo } -returnCodes error -match glob -result {bad -level value: *} test cmdMZ-return-1.4 {return checks for bad option values} -body { return -level -1 } -returnCodes error -match glob -result {bad -level value: *} test cmdMZ-return-1.5 {return checks for bad option values} -body { return -level 3.1415926 } -returnCodes error -match glob -result {bad -level value: *} proc dictSort {d} { set result {} foreach k [lsort [dict keys $d]] { dict set result $k [dict get $d $k] } return $result } test cmdMZ-return-2.0 {return option handling} { list [catch return -> foo] [dictSort $foo] } {2 {-code 0 -level 1}} test cmdMZ-return-2.1 {return option handling} { list [catch {return -bar soom} -> foo] [dictSort $foo] } {2 {-bar soom -code 0 -level 1}} test cmdMZ-return-2.2 {return option handling} { list [catch {return -code return} -> foo] [dictSort $foo] } {2 {-code 0 -level 2}} test cmdMZ-return-2.3 {return option handling} { list [catch {return -code return -level 10} -> foo] [dictSort $foo] } {2 {-code 0 -level 11}} test cmdMZ-return-2.4 {return option handling} -body { return -level 0 -code error } -returnCodes error -result {} test cmdMZ-return-2.5 {return option handling} -body { return -level 0 -code return } -returnCodes return -result {} test cmdMZ-return-2.6 {return option handling} -body { return -level 0 -code break } -returnCodes break -result {} test cmdMZ-return-2.7 {return option handling} -body { return -level 0 -code continue } -returnCodes continue -result {} test cmdMZ-return-2.8 {return option handling} -body { return -level 0 -code -1 } -returnCodes -1 -result {} test cmdMZ-return-2.9 {return option handling} -body { return -level 0 -code 10 } -returnCodes 10 -result {} test cmdMZ-return-2.10 {return option handling} -body { list [catch {return -level 0 -code error} -> foo] [dictSort $foo] } -match glob -result {1 {-code 1 -errorcode NONE -errorinfo { while executing "return -level 0 -code error"} -errorline 1 -errorstack * -level 0}} test cmdMZ-return-2.11 {return option handling} { list [catch {return -level 0 -code break} -> foo] [dictSort $foo] } {3 {-code 3 -level 0}} test cmdMZ-return-2.12 {return option handling} -body { return -level 0 -code error -options {-code ok} } -returnCodes ok -result {} test cmdMZ-return-2.13 {return option handling} -body { return -level 0 -code error -options {-code err} } -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} test cmdMZ-return-2.14 {return option handling} -body { return -level 0 -code error -options {-code foo -options {-code break}} } -returnCodes break -result {} test cmdMZ-return-2.15 {return opton handling} { list [catch { apply {{} { return -code error -errorcode {a b} c }} } result] $result $::errorCode } {1 c {a b}} test cmdMZ-return-2.16 {return opton handling} { list [catch { apply {{} { return -code error -errorcode [list a b] c }} } result] $result $::errorCode } {1 c {a b}} test cmdMZ-return-2.17 {return opton handling} { list [catch { apply {{} { return -code error -errorcode a\ b c }} } result] $result $::errorCode } {1 c {a b}} test cmdMZ-return-2.18 {return option handling} { list [catch { return -code error -errorstack [list CALL a CALL b] yo } -> foo] [dictSort $foo] [info errorstack] } {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}} # Check that the result of a [return -options $opts $result] is # indistinguishable from that of the originally caught script, no matter what # the script is/does. (TIP 90) foreach {testid script} { cmdMZ-return-3.0 {} cmdMZ-return-3.1 {format x} cmdMZ-return-3.2 {set} cmdMZ-return-3.3 {set a 1} cmdMZ-return-3.4 {error} cmdMZ-return-3.5 {error foo} cmdMZ-return-3.6 {error foo bar} cmdMZ-return-3.7 {error foo bar baz} cmdMZ-return-3.8 {return -level 0} cmdMZ-return-3.9 {return -code error} cmdMZ-return-3.10 {return -code error -errorinfo foo} cmdMZ-return-3.11 {return -code error -errorinfo foo -errorcode bar} cmdMZ-return-3.12 {return -code error -errorinfo foo -errorcode bar -errorline 10} cmdMZ-return-3.12.1 {return -code error -errorinfo foo -errorcode bar -errorline 10 -errorstack baz} cmdMZ-return-3.13 {return -options {x y z 2}} cmdMZ-return-3.14 {return -level 3 -code break sdf} } { test $testid "check that return after a catch is same:\n$script" { set one [list [catch $script foo bar] $foo [dictSort $bar] \ $::errorCode $::errorInfo] set two [list [catch {return -options $bar $foo} foo2 bar2] \ $foo2 [dictSort $bar2] $::errorCode $::errorInfo] string equal $one $two } 1 } # The tests for Tcl_ScanObjCmd are in scan.test # Tcl_SourceObjCmd # More tests of Tcl_SourceObjCmd are in source.test test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints { unixOrWin } -returnCodes error -body { source } -match glob -result {wrong # args: should be "source*fileName"} test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints { unixOrWin } -returnCodes error -body { source a b } -match glob -result {wrong # args: should be "source*fileName"} test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body { set file [makeFile { set x 146 error "error in sourced file" set y $x } source.file] list [catch {source $file} msg] $msg $::errorInfo } -cleanup { removeFile source.file } -match listGlob -result {1 {error in sourced file} {error in sourced file while executing "error "error in sourced file"" (file "*" line 3) invoked from within "source $file"}} test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} -body { set file [makeFile {list ok} source.file] source $file } -cleanup { removeFile source.file } -result ok # Tcl_SplitObjCmd test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} -returnCodes error -body { split } -result {wrong # args: should be "split string ?splitChars?"} test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} -returnCodes error -body { split a b c } -result {wrong # args: should be "split string ?splitChars?"} test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} { split "a\n b\t\r c\n " } {a {} b {} {} c {} {}} test cmdMZ-4.4 {Tcl_SplitObjCmd: basic split commands} { split "word 1xyzword 2zword 3" xyz } {{word 1} {} {} {word 2} {word 3}} test cmdMZ-4.5 {Tcl_SplitObjCmd: basic split commands} { split "12345" {} } {1 2 3 4 5} test cmdMZ-4.6 {Tcl_SplitObjCmd: basic split commands} { split "a\}b\[c\{\]\$" } "a\\\}b\\\[c\\\{\\\]\\\$" test cmdMZ-4.7 {Tcl_SplitObjCmd: basic split commands} { split {} {} } {} test cmdMZ-4.8 {Tcl_SplitObjCmd: basic split commands} { split {} } {} test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} { split { } } {{} {} {} {}} test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} { apply {{} { set x {} foreach f [split {]\n} {}] { append x $f } return $x }} } {]\n} test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} { apply {{} { set x ab\000c set y [split $x {}] binary scan $y c* z return $z }} } {97 32 98 32 0 32 99} test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} { split "a0ab1b2bbb3\000c4" ab\000c } {{} 0 {} 1 2 {} {} 3 {} 4} test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} { # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq" split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e" } "a b qw\u5e4eN wq" # The tests for Tcl_StringObjCmd are in string.test # The tests for Tcl_SubstObjCmd are in subst.test # The tests for Tcl_SwitchObjCmd are in switch.test # todo: rewrite this if monotonic clock is provided resp. command "after" # gets microsecond accuracy (RFE [fdfbd5e10] gets merged): proc _nrt_sleep {msec} { set usec [expr {$msec * 1000}] set stime [clock microseconds] while {abs([clock microseconds] - $stime) < $usec} { # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise): # after 0 } } _nrt_sleep 0; # warm up (clock, compile, etc) test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body { time } -returnCodes error -result {wrong # args: should be "time command ?count?"} test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body { time a b c } -returnCodes error -result {wrong # args: should be "time command ?count?"} test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} -body { time a b } -returnCodes error -result {expected integer but got "b"} test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} { time bogusCmd -12456 } {0 microseconds per iteration} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body { time {format 1} } -match regexp -result {^\d+ microseconds per iteration} test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} -body { set m1 [lindex [time {_nrt_sleep 0.01}] 0] set m2 [lindex [time {_nrt_sleep 10.0}] 0] list \ [expr {$m1 < $m2}] \ $m1 $m2; # interesting only in error case. } -match glob -result [list 1 *] test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "time {error foo}"}} test cmdMZ-5.7.1 {Tcl_TimeObjCmd: return from time} { set x 0 proc r1 {} {upvar x x; time {incr x; return "r1"; incr x} 10} list [r1] $x } {r1 1} test cmdMZ-5.8 {Tcl_TimeObjCmd: done optimization: nested call of self inside time (if compiled)} { set x [set y 0] set m1 { if {[incr x] <= 5} { # nested call should return result, so covering that: if {![string is integer -strict [eval $m1]]} {error unexpected} } # increase again (no "continue" from nested call): incr x } time {incr y; eval $m1} 5 list $y $x } {5 20} test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate} msg] $msg } {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} test cmdMZ-6.2.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b c d} msg] $msg } {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} test cmdMZ-6.2.2 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b c} msg] $msg } {1 {expected integer but got "b"}} test cmdMZ-6.2.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b} msg] $msg } {1 {expected integer but got "b"}} test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate -overhead b {} a b} msg] $msg } {1 {expected floating-point number but got "b"}} test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} { list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg } {1 {missing close-brace}} test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? net-ms$} [timerate {} 0] } 1 test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measurement} -body { set m1 [timerate {_nrt_sleep 0.01} 50] set m2 [timerate {_nrt_sleep 1.00} 50] list [list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ [expr {[lindex $m2 0] > 100}] \ [expr {[lindex $m1 2] > 500}] \ [expr {[lindex $m2 2] < 500}] \ [expr {[lindex $m1 4] > 10000}] \ [expr {[lindex $m2 4] < 10000}] \ [expr {[lindex $m1 6] > 5 && [lindex $m1 6] < 100}] \ [expr {[lindex $m2 6] > 5 && [lindex $m2 6] < 100}] \ ] $m1 $m2; # interesting only in error case. } -match glob -result [list [lrepeat 9 1] *] test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { list [catch {timerate {error foo} 1} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "timerate {error foo} 1"}} test cmdMZ-6.7.1 {Tcl_TimeRateObjCmd: return from timerate} { set x 0 proc r1 {} {upvar x x; timerate {incr x; return "r1"; incr x} 1000 10} list [r1] $x } {r1 1} test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} -body { set m1 [timerate {break}] list [list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 10}] \ ] $m1; # interesting only in error case. } -match glob -result [list {1 1 1 1} *] test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} -body { set m1 [timerate {continue; return -code error "unexpected"} 1000 10] list [list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 10}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 100}] \ ] $m1; # interesting only in error case. } -match glob -result [list {1 1 1 1} *] test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} -body { set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1] list [list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] == 1000000}] \ [expr {[lindex $m1 6] <= 0.001}] \ ] $m1; # interesting only in error case. } -match glob -result [list {1 1 1 1} *] test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} { set m1 {set m2 ok} if 1 $m1 timerate $m1 1000 10 if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop } ok test cmdMZ-6.12 {Tcl_TimeRateObjCmd: done optimization: nested call of self inside timerate} { set x 0 set m1 { if {[incr x] <= 5} { # nested call should return result, so covering that: if {![string is integer -strict [eval $m1]]} {error unexpected} } # increase again (no "continue" from nested call): incr x } list [lindex [timerate $m1 1000 5] 2] $x } {5 20} # The tests for Tcl_WhileObjCmd are in while.test # cleanup cleanupTests } namespace delete ::tcl::test::cmdMZ return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/compExpr-old.test0000644000175000017500000011034614554262142016263 0ustar sergeisergei# Commands covered: expr # # This file contains the original set of tests for the compilation (and # indirectly execution) of Tcl's expr command. A new set of tests covering # the new implementation are in the files "parseExpr.test" and # "compExpr.test". Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { testConstraint testmathfunctions 0 } else { testConstraint testmathfunctions 1 } # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues binary scan [binary format dd -1.0 1.0] c* c switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ ieeeValues(-Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ ieeeValues(+Normal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ ieeeValues(+Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 } default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] # procedures used below proc put_hello_char {c} { global a append a [format %c $c] return $c } proc hello_world {} { global a set a "" set L1 [set l0 [set h_1 [set q 0]]] for {put_hello_char [expr [put_hello_char [expr [set h 7]*10+2]]+29]} {$l0?[put_hello_char $l0] :!$h_1} {put_hello_char $ll;expr {$L1==2?[set ll [expr 32+0-0+[set bar 0]]]:0}} {expr {[incr L1]==[expr 1+([string length "abc"]-[string length "abc"])] ?[set ll [set l0 [expr 54<<1]]]:$ll==108&&$L1<3? [incr ll [expr 1|1<<1]; set ll $ll; set ll $ll; set ll $ll; set ll $ll; set l0 [expr ([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])]; set l0; set l0 $l0; set l0; set l0]:$L1==4&&$ll==32?[set ll [expr 19+$h1+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+[set foo [expr ([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])]]]] :[set q [expr $q-$h1+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])]]};expr {$L1==5?[incr ll -8; set ll $ll; set ll]:$q&&$h1&&1};expr {$L1==4+2 ?[incr ll 3]:[expr ([string length "abc"]-[string length "abc"])+1]};expr {$ll==($h<<4)+2+0&&$L1!=6?[incr ll -6]:[set h1 [expr 100+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])]]} expr {$L1!=1<<3?[incr q [expr ([string length "abc"]-[string length "abc"])-1]]:[set h_1 [set ll $h1]]} } set a } proc 12days {a b c} { global xxx expr {1<$a?[expr {$a<3?[12days -79 -13 [string range $c [12days -87 \ [expr 1-$b] [string range $c [12days -86 0 [string range $c 1 end]] \ end]] end]]:1};expr {$a<$b?[12days [expr $a+1] $b $c]:3};expr {[12days \ -94 [expr $a-27] $c]&&$a==2?$b<13?[12days 2 [expr $b+1] "%s %d %d\n"]:9 :16}]:$a<0?$a<-72?[12days $b $a "@n'+,#'/*\{\}w+/w#cdnr/+,\{\}r/*de\}+,/*\{*+,/w\{%+,/w#q#n+,/#\{l+,/n\{n+,/+#n+,/#;#q#n+,/+k#;*+,/'r :'d*'3,\}\{w+K w'K:'+\}e#';dq#'l q#'+d'K#!/+k#;q#'r\}eKK#\}w'r\}eKK\{nl\]'/#;#q#n')\{)#\}w')\{)\{nl\]'/+#n';d\}rw' i;# )\{nl\]!/n\{n#'; r\{#w'r nc\{nl\]'/#\{l,+'K \{rw' iK\{;\[\{nl\]'/w#q#n'wk nw' iwk\{KK\{nl\]!/w\{%'l##w#' i; :\{nl\]'/*\{q#'ld;r'\}\{nlwb!/*de\}'c ;;\{nl'-\{\}rw\]'/+,\}##'*\}#nc,',#nw\]'/+kd'+e\}+;#'rdq#w! nr'/ ') \}+\}\{rl#'\{n' ')# \}'+\}##(!!/"] :$a<-50?[string compare [format %c $b] [string index $c 0]]==0?[append \ xxx [string index $c 31];scan [string index $c 31] %c x;set x] :[12days -65 $b [string range $c 1 end]]:[12days [expr ([string compare \ [string index $c 0] "/"]==0)+$a] $b [string range $c 1 end]]:0<$a ?[12days 2 2 "%s"]:[string compare [string index $c 0] "/"]==0|| [12days 0 [12days -61 [scan [string index $c 0] %c x; set x] \ "!ek;dc i@bK'(q)-\[w\]*%n+r3#l,\{\}:\nuwloca-O;m .vpbks,fxntdCeghiry"] \ [string range $c 1 end]]} } proc do_twelve_days {} { global xxx set xxx "" 12days 1 1 1 set result [string length $xxx] unset xxx return $result } # start of tests catch {unset a b i x} test compExpr-old-1.1 {TclCompileExprCmd: no expression} { list [catch {expr } msg] $msg } {1 {wrong # args: should be "expr arg ?arg ...?"}} test compExpr-old-1.2 {TclCompileExprCmd: one expression word} { expr -25 } -25 test compExpr-old-1.3 {TclCompileExprCmd: two expression words} { expr -8.2 -6 } -14.2 test compExpr-old-1.4 {TclCompileExprCmd: five expression words} { expr 20 - 5 +10 -7 } 18 test compExpr-old-1.5 {TclCompileExprCmd: quoted expression word} { expr "0005" } 5 test compExpr-old-1.6 {TclCompileExprCmd: quoted expression word} { catch {expr "0005"zxy} msg set msg } {extra characters after close-quote} test compExpr-old-1.7 {TclCompileExprCmd: expression word in braces} { expr {-0005} } -5 test compExpr-old-1.8 {TclCompileExprCmd: expression word in braces} { expr {{-0x1234}} } -4660 test compExpr-old-1.9 {TclCompileExprCmd: expression word in braces} { catch {expr {-0005}foo} msg set msg } {extra characters after close-brace} test compExpr-old-1.10 {TclCompileExprCmd: other expression word in braces} { expr 4*[llength "6 2"] } 8 test compExpr-old-1.11 {TclCompileExprCmd: expression word terminated by ;} { expr 4*[llength "6 2"]; } 8 test compExpr-old-1.12 {TclCompileExprCmd: inlined expr (in "catch") inside other catch} { set a xxx catch { # Might not be a number set a [expr 10*$a] } } 1 test compExpr-old-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} { set a xxx set x 27; set bool {$x}; if $bool {set a foo} set a } foo test compExpr-old-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} { set a xxx set x 2; set b {$x}; set a [expr $b == 2] set a } 1 test compExpr-old-2.1 {TclCompileExpr: are builtin functions registered?} { expr double(5*[llength "6 2"]) } 10.0 test compExpr-old-2.2 {TclCompileExpr: error in expr} -body { expr 2***3 } -returnCodes error -match glob -result * test compExpr-old-2.3 {TclCompileExpr: junk after legal expr} -body { expr 7*[llength "a b"]foo } -returnCodes error -match glob -result * test compExpr-old-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} { expr {0001} } 1 test compExpr-old-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1 test compExpr-old-3.2 {CompileCondExpr: error in lor expr} -body { expr x||3 } -returnCodes error -match glob -result * test compExpr-old-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44 test compExpr-old-3.4 {CompileCondExpr: error compiling true arm} -body { expr 3>2?2***3:66 } -returnCodes error -match glob -result * test compExpr-old-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66 test compExpr-old-3.6 {CompileCondExpr: error compiling false arm} -body { expr 2>3?44:2***3 } -returnCodes error -match glob -result * test compExpr-old-3.7 {CompileCondExpr: long arms & nested cond exprs} { hello_world } {Hello world} test compExpr-old-3.8 {CompileCondExpr: long arms & nested cond exprs} unix { # Fails with a stack overflow on threaded Windows builds do_twelve_days } 2358 test compExpr-old-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1 test compExpr-old-4.2 {CompileLorExpr: error in land expr} -body { expr x&&3 } -returnCodes error -match glob -result * test compExpr-old-4.3 {CompileLorExpr: simple lor exprs} {expr 0||1.0} 1 test compExpr-old-4.4 {CompileLorExpr: simple lor exprs} {expr 3.0||0.0} 1 test compExpr-old-4.5 {CompileLorExpr: simple lor exprs} {expr 0||0||1} 1 test compExpr-old-4.6 {CompileLorExpr: error compiling lor arm} -body { expr 2***3||4.0 } -returnCodes error -match glob -result * test compExpr-old-4.7 {CompileLorExpr: error compiling lor arm} -body { expr 1.3||2***3 } -returnCodes error -match glob -result * test compExpr-old-4.8 {CompileLorExpr: error compiling lor arms} { list [catch {expr {"a"||"b"}} msg] $msg } {1 {expected boolean value but got "a"}} test compExpr-old-4.9 {CompileLorExpr: long lor arm} { set a "abcdefghijkl" set i 7 expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} } 1 test compExpr-old-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23 test compExpr-old-5.2 {CompileLandExpr: error in bitor expr} -body { expr x|3 } -returnCodes error -match glob -result * test compExpr-old-5.3 {CompileLandExpr: simple land exprs} {expr 0&&1.0} 0 test compExpr-old-5.4 {CompileLandExpr: simple land exprs} {expr 0&&0} 0 test compExpr-old-5.5 {CompileLandExpr: simple land exprs} {expr 3.0&&1.2} 1 test compExpr-old-5.6 {CompileLandExpr: simple land exprs} {expr 1&&1&&2} 1 test compExpr-old-5.7 {CompileLandExpr: error compiling land arm} -body { expr 2***3&&4.0 } -returnCodes error -match glob -result * test compExpr-old-5.8 {CompileLandExpr: error compiling land arm} -body { expr 1.3&&2***3 } -returnCodes error -match glob -result * test compExpr-old-5.9 {CompileLandExpr: error compiling land arm} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} test compExpr-old-5.10 {CompileLandExpr: long land arms} { set a "abcdefghijkl" set i 7 expr {[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]} } 1 test compExpr-old-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3 test compExpr-old-6.2 {CompileBitXorExpr: error in bitand expr} -body { expr x|3 } -returnCodes error -match glob -result * test compExpr-old-6.3 {CompileBitXorExpr: simple bitxor exprs} {expr 7^0x13} 20 test compExpr-old-6.4 {CompileBitXorExpr: simple bitxor exprs} {expr 3^0x10} 19 test compExpr-old-6.5 {CompileBitXorExpr: simple bitxor exprs} {expr 0^7} 7 test compExpr-old-6.6 {CompileBitXorExpr: simple bitxor exprs} {expr -1^7} -8 test compExpr-old-6.7 {CompileBitXorExpr: error compiling bitxor arm} -body { expr 2***3|6 } -returnCodes error -match glob -result * test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { expr 2^x } -returnCodes error -match glob -result * test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg } {1 {can't use floating-point value as operand of "^"}} test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "^"}} test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 test compExpr-old-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1 test compExpr-old-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0 test compExpr-old-7.5 {CompileBitAndExpr: error in equality expr} -body { expr x==3 } -returnCodes error -match glob -result * test compExpr-old-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3 test compExpr-old-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82 test compExpr-old-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2 test compExpr-old-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7 test compExpr-old-7.10 {CompileBitAndExpr: error compiling bitand arm} -body { expr 2***3&6 } -returnCodes error -match glob -result * test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { expr 2&x } -returnCodes error -match glob -result * test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg } {1 {can't use floating-point value as operand of "&"}} test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "&"}} test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1 test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1 test compExpr-old-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1 test compExpr-old-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0 test compExpr-old-8.5 {CompileEqualityExpr: error in relational expr} -body { expr x>3 } -returnCodes error -match glob -result * test compExpr-old-8.6 {CompileEqualityExpr: simple equality exprs} {expr 7==0x13} 0 test compExpr-old-8.7 {CompileEqualityExpr: simple equality exprs} {expr -0xf2!=0x53} 1 test compExpr-old-8.8 {CompileEqualityExpr: simple equality exprs} {expr {"12398712938788234-1298379" != ""}} 1 test compExpr-old-8.9 {CompileEqualityExpr: simple equality exprs} {expr -1!="abc"} 1 test compExpr-old-8.10 {CompileEqualityExpr: error compiling equality arm} -body { expr 2***3==6 } -returnCodes error -match glob -result * test compExpr-old-8.11 {CompileEqualityExpr: error compiling equality arm} -body { expr 2!=x } -returnCodes error -match glob -result * test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12 test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63 test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1 test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8 # The following test is different for 32-bit versus 64-bit # architectures because LONG_MIN is different test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { expr {int(1<<63)} } -9223372036854775808 test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { expr {int(1<<31)} } -2147483648 test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 } -returnCodes error -match glob -result * test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1 test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1 test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body { expr 2***3>6 } -returnCodes error -match glob -result * test compExpr-old-9.10 {CompileRelationalExpr: error compiling relational arm} -body { expr 2>0x3} 31 test compExpr-old-10.7 {CompileShiftExpr: simple shift exprs} {expr -0xf2<<0x3} -1936 test compExpr-old-10.8 {CompileShiftExpr: error compiling shift arm} -body { expr 2***3>>6 } -returnCodes error -match glob -result * test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body { expr 2<>43}} msg] $msg } {1 {can't use floating-point value as operand of ">>"}} test compExpr-old-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "<<"}} test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 test compExpr-old-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1 test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6 test compExpr-old-11.5 {CompileAddExpr: error in multiply expr} -body { expr x*3 } -returnCodes error -match glob -result * test compExpr-old-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258 test compExpr-old-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239 test compExpr-old-11.8 {CompileAddExpr: error compiling add arm} -body { expr 2***3+6 } -returnCodes error -match glob -result * test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body { expr 2-x } -returnCodes error -match glob -result * test compExpr-old-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test compExpr-old-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} test compExpr-old-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} test compExpr-old-11.13a {CompileAddExpr: runtime error} ieeeFloatingPoint { list [catch {expr {2.3/0.0}} msg] $msg } {0 Inf} test compExpr-old-11.13b {CompileAddExpr: runtime error} !ieeeFloatingPoint { list [catch {expr {2.3/0.0}} msg] $msg } {1 {divide by zero}} test compExpr-old-12.1 {CompileMultiplyExpr: just unary expr} {expr ~4} -5 test compExpr-old-12.2 {CompileMultiplyExpr: just unary expr} {expr --5} 5 test compExpr-old-12.3 {CompileMultiplyExpr: just unary expr} {expr !27} 0 test compExpr-old-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936 test compExpr-old-12.5 {CompileMultiplyExpr: error in unary expr} -body { expr ~x } -returnCodes error -match glob -result * test compExpr-old-12.6 {CompileMultiplyExpr: simple multiply exprs} {expr 0xff*0x3} 765 test compExpr-old-12.7 {CompileMultiplyExpr: simple multiply exprs} {expr -0xf2%-0x3} -2 test compExpr-old-12.8 {CompileMultiplyExpr: error compiling multiply arm} -body { expr 2*3%%6 } -returnCodes error -match glob -result * test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { expr 2*x } -returnCodes error -match glob -result * test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg } {1 {can't use non-numeric string as operand of "*"}} test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "/"}} test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 test compExpr-old-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36 test compExpr-old-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0 test compExpr-old-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0 test compExpr-old-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1 test compExpr-old-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0 test compExpr-old-13.8 {CompileUnaryExpr: error compiling unary expr} -body { expr ~x } -returnCodes error -match glob -result * test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body { expr !1.x set msg } -returnCodes error -match glob -result * test compExpr-old-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg } {1 {can't use non-numeric string as operand of "~"}} test compExpr-old-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg } {1 {can't use floating-point value as operand of "~"}} test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} { set a 27 expr $a } 27 test compExpr-old-13.14 {CompileUnaryExpr: just primary expr} { expr double(27) } 27.0 test compExpr-old-13.15 {CompileUnaryExpr: just primary expr} {expr "123"} 123 test compExpr-old-13.16 {CompileUnaryExpr: error in primary expr} { catch {expr [set]} msg set msg } {wrong # args: should be "set varName ?newValue?"} test compExpr-old-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1 test compExpr-old-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123 test compExpr-old-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255 test compExpr-old-14.4 {CompilePrimaryExpr: literal primary} {expr 0o0010} 8 test compExpr-old-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0 test compExpr-old-14.6 {CompilePrimaryExpr: literal primary} { expr 3.1400000 } 3.14 test compExpr-old-14.7 {CompilePrimaryExpr: literal primary} {expr {{abcde}<{abcdef}}} 1 test compExpr-old-14.8 {CompilePrimaryExpr: literal primary} {expr {{abc\ def} < {abcdef}}} 1 test compExpr-old-14.9 {CompilePrimaryExpr: literal primary} {expr {{abc\tde} > {abc\tdef}}} 0 test compExpr-old-14.10 {CompilePrimaryExpr: literal primary} {expr {{123}}} 123 test compExpr-old-14.11 {CompilePrimaryExpr: var reference primary} { set i 789 list [expr {$i}] [expr $i] } {789 789} test compExpr-old-14.12 {CompilePrimaryExpr: var reference primary} { set i {789} ;# test expr's aggressive conversion to numeric semantics list [expr {$i}] [expr $i] } {789 789} test compExpr-old-14.13 {CompilePrimaryExpr: var reference primary} { catch {unset a} set a(foo) foo set a(bar) bar set a(123) 123 set result "" lappend result [expr $a(123)] [expr {$a(bar)<$a(foo)}] catch {unset a} set result } {123 1} test compExpr-old-14.14 {CompilePrimaryExpr: var reference primary} { set i 123 ;# test "$var.0" floating point conversion hack list [expr $i] [expr $i.0] [expr $i.0/12.0] } {123 123.0 10.25} test compExpr-old-14.15 {CompilePrimaryExpr: var reference primary} { set i 123 catch {expr $i.2} msg set msg } 123.2 test compExpr-old-14.16 {CompilePrimaryExpr: error compiling var reference primary} -body { expr {$a(foo} } -returnCodes error -match glob -result * test compExpr-old-14.17 {CompilePrimaryExpr: string primary that looks like var ref} -body { expr $ } -returnCodes error -match glob -result * test compExpr-old-14.18 {CompilePrimaryExpr: quoted string primary} { expr "21" } 21 test compExpr-old-14.19 {CompilePrimaryExpr: quoted string primary} { set i 123 set x 456 expr "$i+$x" } 579 test compExpr-old-14.20 {CompilePrimaryExpr: quoted string primary} { set i 3 set x 6 expr 2+"$i.$x" } 5.6 test compExpr-old-14.21 {CompilePrimaryExpr: error in quoted string primary} { catch {expr "[set]"} msg set msg } {wrong # args: should be "set varName ?newValue?"} test compExpr-old-14.22 {CompilePrimaryExpr: subcommand primary} { expr {[set i 123; set i]} } 123 test compExpr-old-14.23 {CompilePrimaryExpr: error in subcommand primary} -body { catch {expr {[set]}} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test compExpr-old-14.24 {CompilePrimaryExpr: error in subcommand primary} -body { expr {[set i} } -returnCodes error -match glob -result * test compExpr-old-14.25 {CompilePrimaryExpr: math function primary} { format %.6g [expr exp(1.0)] } 2.71828 test compExpr-old-14.26 {CompilePrimaryExpr: math function primary} { format %.6g [expr pow(2.0+0.1,3.0+0.1)] } 9.97424 test compExpr-old-14.27 {CompilePrimaryExpr: error in math function primary} -body { expr sinh::(2.0) } -returnCodes error -match glob -result * test compExpr-old-14.28 {CompilePrimaryExpr: subexpression primary} { expr 2+(3*4) } 14 test compExpr-old-14.29 {CompilePrimaryExpr: error in subexpression primary} -body { catch {expr 2+(3*[set])} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test compExpr-old-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} -body { expr 2+(3*(4+5) } -returnCodes error -match glob -result * test compExpr-old-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} { set i "5+10" list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15" } {{15 == 15} {15 == 15} {15 == 15}} test compExpr-old-14.32 {CompilePrimaryExpr: unexpected token} -body { expr @ } -returnCodes error -match glob -result * test compExpr-old-15.1 {CompileMathFuncCall: missing parenthesis} -body { expr sinh2.0) } -returnCodes error -match glob -result * test compExpr-old-15.2 {CompileMathFuncCall: unknown math function} -body { catch {expr whazzathuh(1)} msg set ::errorInfo } -match glob -result {* "*whazzathuh" while *ing "expr whazzathuh(1)"} test compExpr-old-15.3 {CompileMathFuncCall: too many arguments} -body { catch {expr sin(1,2,3)} msg set ::errorInfo } -match glob -result {too many arguments for math function* while *ing "expr sin(1,2,3)"} test compExpr-old-15.4 {CompileMathFuncCall: ')' found before last required arg} -body { catch {expr sin()} msg set ::errorInfo } -match glob -result {not enough arguments for math function* while *ing "expr sin()"} test compExpr-old-15.5 {CompileMathFuncCall: not enough arguments} -body { catch {expr pow(1)} msg set ::errorInfo } -match glob -result {not enough arguments for math function* while *ing "expr pow(1)"} test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions { expr 2*T1() } 246 test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions { expr T2()*3 } 1035 test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions { expr T3(21, 37) } 37 test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions { expr T3(21.2, 37) } 37.0 test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions { expr T3(-21.2, -17.5) } -17.5 test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { catch {unset a} set a(VALUE) ff15 set i 123 if {[expr 0x$a(VALUE)] & 16} { set i {} } set i } {} test compExpr-old-16.2 {GetToken: check for string literal in braces} { expr {{1}} } {1} # Check "expr" and computed command names. test compExpr-old-17.1 {expr and computed command names} { set i 0 set z expr $z 1+2 } 3 # Check correct conversion of operands to numbers: If the string looks like # an integer, convert to integer. Otherwise, if the string looks like a # double, convert to double. test compExpr-old-18.1 {expr and conversion of operands to numbers} { set x [lindex 11 0] catch {expr int($x)} expr {$x} } 11 # Check "expr" and interpreter result object resetting before appending # an error msg during evaluation of exprs not in {}s test compExpr-old-19.1 {expr and interpreter result object resetting} { proc p {} { set t 10.0 set x 2.0 set dx 0.2 set f {$dx-$x/10} set g {-$x/5} set center 1.0 set x [expr $x-$center] set dx [expr $dx+$g] set x [expr $x+$f+$center] set x [expr $x+$f+$center] set y [expr round($x)] } p } 3 # cleanup if {[info exists a]} { unset a } ::tcltest::cleanupTests return tcl8.6.14/tests/compExpr.test0000644000175000017500000004165014554262142015510 0ustar sergeisergei# This file contains a collection of tests for the procedures in the file # tclCompExpr.c. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { testConstraint testmathfunctions 0 } else { testConstraint testmathfunctions 1 } # Constrain memory leak tests testConstraint memory [llength [info commands memory]] catch {unset a} test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} { expr 1+2 } 3 test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} -body { expr 1+2+ } -returnCodes error -match glob -result * test compExpr-1.3 {TclCompileExpr procedure, error compiling expr} -body { list [catch {expr "foo(123)"} msg] $msg } -match glob -result {1 {* "*foo"}} test compExpr-1.4 {TclCompileExpr procedure, expr has no operators} { set a {0o00123} expr {$a} } 83 test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} -setup { unset -nocomplain a } -body { set a 27 expr {"foo$a" < "bar"} } -result 0 test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} -body { expr {"00[expr 1+]" + 17} } -returnCodes error -match glob -result * test compExpr-2.3 {CompileSubExpr procedure, TCL_TOKEN_TEXT parse token} { expr {{12345}} } 12345 test compExpr-2.4 {CompileSubExpr procedure, empty TCL_TOKEN_TEXT parse token} { expr {{}} } {} test compExpr-2.5 {CompileSubExpr procedure, TCL_TOKEN_BS parse token} { expr "\{ \\ +123 \}" } 123 test compExpr-2.6 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} { expr {[info tclversion] != ""} } 1 test compExpr-2.7 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} { expr {[]} } {} test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} -body { expr {[foo "bar"xxx] + 17} } -returnCodes error -match glob -result * test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup { unset -nocomplain a } -body { set a 123 expr {$a*2} } -result 246 test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup { unset -nocomplain a unset -nocomplain b } -body { set a(george) martha set b geo expr {$a(${b}rge)} } -result martha test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} -body { unset -nocomplain a expr {$a + 17} } -returnCodes error -result {can't read "a": no such variable} test compExpr-2.12 {CompileSubExpr procedure, TCL_TOKEN_SUB_EXPR parse token} { expr {27||3? 3<<(1+4) : 4&&9} } 96 test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { unset -nocomplain a } -body { set a 15 list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg } -result {0 1} test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} { expr {5*6} } 30 test compExpr-2.15 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, math function found} { format %.6g [expr {sin(2.0)}] } 0.909297 test compExpr-2.16 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, math function not found} -body { list [catch {expr {fred(2.0)}} msg] $msg } -match glob -result {1 {* "*fred"}} test compExpr-2.17 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4*2} } 8 test compExpr-2.18 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4/2} } 2 test compExpr-2.19 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4%2} } 0 test compExpr-2.20 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4<<2} } 16 test compExpr-2.21 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4>>2} } 1 test compExpr-2.22 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4<2} } 0 test compExpr-2.23 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4>2} } 1 test compExpr-2.24 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4<=2} } 0 test compExpr-2.25 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4>=2} } 1 test compExpr-2.26 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4==2} } 0 test compExpr-2.27 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4!=2} } 1 test compExpr-2.28 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4&2} } 0 test compExpr-2.29 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4^2} } 6 test compExpr-2.30 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { expr {4|2} } 6 test compExpr-2.31 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} { expr {!4} } 0 test compExpr-2.32 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} { expr {~4} } -5 test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} -setup { unset -nocomplain a } -body { set a 15 expr {$a==15} ;# compiled out-of-line to runtime call on Tcl_ExprObjCmd } -result 1 test compExpr-2.34 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { expr {+2} } 2 test compExpr-2.35 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body { expr {+[expr 1+]} } -returnCodes error -match glob -result * test compExpr-2.36 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { expr {4+2} } 6 test compExpr-2.37 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body { expr {[expr 1+]+5} } -returnCodes error -match glob -result * test compExpr-2.38 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body { expr {5+[expr 1+]} } -returnCodes error -match glob -result * test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { expr {-2} } -2 test compExpr-2.40 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { expr {4-2} } 2 test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { unset -nocomplain a } -body { set a true expr {0||$a} } -result 1 test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { unset -nocomplain a } -body { set a 15 list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg } -result {0 1} test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { unset -nocomplain a } -body { set a false expr {3&&$a} } -result 0 test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { unset -nocomplain a } -body { set a false expr {$a||1? 1 : 0} } -result 1 test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { unset -nocomplain a } -body { set a 15 list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg } -result {0 54} test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} -setup { unset -nocomplain a } -body { set a 2 expr {[set a]||0} } -result 1 test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} -setup { unset -nocomplain a } -body { set a no expr {$a&&1} } -result 0 test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} -body { expr {[expr *2]||0} } -returnCodes error -match glob -result * test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} -setup { unset -nocomplain a unset -nocomplain b } -body { set a no set b true expr {$a || $b} } -result 1 test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup { unset -nocomplain a } -body { set a yes expr {$a || [exit]} } -result 1 test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup { unset -nocomplain a } -body { set a no expr {$a && [exit]} } -result 0 test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} -setup { unset -nocomplain a } -body { set a 2 expr {0||[set a]} } -result 1 test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} -setup { unset -nocomplain a } -body { set a no expr {1&&$a} } -result 0 test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} -body { expr {0||[expr %2]} } -returnCodes error -match glob -result * test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} { set a "abcdefghijkl" set i 7 expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} } 1 test compExpr-4.1 {CompileCondExpr procedure, simple test} -setup { unset -nocomplain a } -body { set a 2 expr {($a > 1)? "ok" : "nope"} } -result ok test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} -setup { unset -nocomplain a } -body { set a no expr {[set a]? 27 : -54} } -result -54 test compExpr-4.3 {CompileCondExpr procedure, error in test} -body { expr {[expr *2]? +1 : -1} } -returnCodes error -match glob -result * test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} -setup { unset -nocomplain a } -body { set a no expr {1? (27-2) : -54} } -result 25 test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} -setup { unset -nocomplain a } -body { set a no expr {1? $a : -54} } -result no test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} -body { expr {1? [expr *2] : -127} } -returnCodes error -match glob -result * test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} -setup { unset -nocomplain a } -body { set a no expr {(2-2)? -3.14159 : "nope"} } -result nope test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} -setup { unset -nocomplain a } -body { set a 0o0123 expr {0? 42 : $a} } -result 83 test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} { list [catch {expr {1? 15 : [expr *2]}} msg] $msg } {0 15} test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { format %.6g [expr {atan2(1.0, 2.0)}] } 0.463648 test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body { expr {do_it()} } -returnCodes error -match glob -result {* "*do_it"} test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions { expr 3*T1()-1 } 368 test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions { expr T2()*3 } 1035 test compExpr-5.5 {CompileMathFuncCall procedure, not enough arguments} -body { expr {atan2(1.0)} } -returnCodes error -match glob -result {not enough arguments for math function*} test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} { format %.6g [expr {pow(2.1, 27.5-(24.4*(5%2)))}] } 9.97424 test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body { expr {sinh(2.*)} } -returnCodes error -match glob -result * test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body { expr {sinh(2.0, 3.0)} } -returnCodes error -match glob -result {too many arguments for math function*} test compExpr-5.9 {CompileMathFuncCall procedure, too many arguments} -body { expr {0 <= rand(5.2)} } -returnCodes error -match glob -result {too many arguments for math function*} test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -body { expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3 } -returnCodes error -match glob -result * test compExpr-7.1 {Memory Leak} -constraints memory -setup { proc getbytes {} { set lines [split [memory info] \n] lindex $lines 3 3 } } -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { interp create child child eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13 interp delete child set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { unset end i tmp rename getbytes {} } -result 0 test compExpr-7.2 {[Bug 1869989]: expr parser memleak} -constraints memory -setup { proc getbytes {} { set lines [split [memory info] \n] lindex $lines 3 3 } } -body { set i 5 set end [getbytes] while {[incr i -1]} { expr ${i}000 set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { unset end i tmp rename getbytes {} } -result 0 # cleanup catch {unset a} catch {unset b} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/compile.test0000644000175000017500000011514714554262142015346 0ustar sergeisergei# This file contains tests for the files tclCompile.c, tclCompCmds.c and # tclLiteral.c # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint exec [llength [info commands exec]] testConstraint memory [llength [info commands memory]] testConstraint testevalex [llength [info commands testevalex]] # The following tests are very incomplete, although the rest of the # test suite covers this file fairly well. catch {rename p ""} catch {namespace delete test_ns_compile} catch {unset x} catch {unset y} catch {unset a} test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} -setup { catch {namespace delete test_ns_compile} catch {unset x} } -body { set x 123 namespace eval test_ns_compile { proc set {args} { global x lappend x test_ns_compile::set } proc p {} { set 0 } } list [test_ns_compile::p] [set x] } -result {{123 test_ns_compile::set} {123 test_ns_compile::set}} test compile-1.2 {TclCompileString, error result is reset if TclGetLong determines word isn't an integer} { proc p {x} {info commands 3m} list [catch {p} msg] $msg } {1 {wrong # args: should be "p x"}} test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} -setup { catch {unset x} } -body { set x 123 list $::x [expr {"x" in [info globals]}] } -result {123 1} test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} -setup { catch {unset y} } -body { proc p {} { set ::y 789 return $::y } list [p] $::y [expr {"y" in [info globals]}] } -result {789 789 1} test compile-2.3 {TclCompileDollarVar: global array name with ::s} -setup { catch {unset a} } -body { set ::a(1) 2 list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {"a" in [info globals]}] } -result {2 3 3 1} test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} -setup { catch {unset a} } -body { proc p {} { set ::a(1) 1 return $::a($::a(1)) } list [p] $::a(1) [expr {"a" in [info globals]}] } -result {1 1 1} test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} -setup { catch {unset a} } -body { proc p {} { global a set a(1) 1 return ${a(1)}$::a(1)$a(1) } list [p] $::a(1) [expr {"a" in [info globals]}] } -result {111 1 1} test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} -setup { catch {unset a} } -body { set a(1) xyzzyx proc p {} { global a catch {set x 123} a(1) } list [p] $a(1) } -result {0 123} test compile-3.2 {TclCompileCatchCmd: non-local variables} { set ::foo 1 proc catch-test {} { catch {set x 3} ::foo } catch-test return $::foo } 3 test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} { proc catch-test {str} { catch [eval $str GOOD] error BAD } catch {catch-test error} ::foo return $::foo } {GOOD} test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} { proc foo {} { set fail [catch { return 1 }] ; # {} return 2 } foo } {2} test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} { proc foo {} { catch { if {[a]} { if b {} } } } list [catch foo msg] $msg } {0 1} test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*}{ -setup { namespace eval catchtest { variable result1 {} } trace add variable catchtest::result1 write catchtest::failtrace proc catchtest::failtrace {n1 n2 op} { return -code error "trace on $n1 fails by request" } } -body { proc catchtest::x {} { variable result1 set count 0 for {set i 0} {$i < 10} {incr i} { set status2 [catch { set status1 [catch { return -code error -level 0 "original failure" } result1 options1] } result2 options2] incr count } list $count $result2 } catchtest::x } -result {10 {can't set "result1": trace on result1 fails by request}} -cleanup {namespace delete catchtest} } test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{ -setup { namespace eval catchtest { variable options1 {} } trace add variable catchtest::options1 write catchtest::failtrace proc catchtest::failtrace {n1 n2 op} { return -code error "trace on $n1 fails by request" } } -body { proc catchtest::x {} { variable options1 set count 0 for {set i 0} {$i < 10} {incr i} { set status2 [catch { set status1 [catch { return -code error -level 0 "original failure" } result1 options1] } result2 options2] incr count } list $count $result2 } catchtest::x } -result {10 {can't set "options1": trace on options1 fails by request}} -cleanup {namespace delete catchtest} } test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 set j 0 # Should be "forever" for {} [expr {$i < 3}] {} { set j [incr i] if {$j > 3} break } set j } {4} test compile-5.1 {TclCompileForeachCmd: exception stack} { proc foreach-exception-test {} { foreach array(index) [list 1 2 3] break foreach array(index) [list 1 2 3] break foreach scalar [list 1 2 3] break } list [catch foreach-exception-test result] $result } {0 {}} test compile-5.2 {TclCompileForeachCmd: non-local variables} { set ::foo 1 proc foreach-test {} { foreach ::foo {1 2 3} {} } foreach-test set ::foo } 3 test compile-5.3 {TclCompileForeachCmd: [Bug b9b2079e6d]} -setup { proc demo {} { foreach x y { if 1 break else } } } -body { demo } -cleanup { rename demo {} } -returnCodes error -result {wrong # args: no script following "else" argument} test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} -setup { catch {unset x} catch {unset y} } -body { set x 123 proc p {} { set ::y 789 return $::y } list $::x [expr {"x" in [info globals]}] \ [p] $::y [expr {"y" in [info globals]}] } -result {123 1 789 789 1} test compile-6.2 {TclCompileSetCmd: global array names with ::s} -setup { catch {unset a} } -body { set ::a(1) 2 proc p {} { set ::a(1) 1 return $::a($::a(1)) } list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {"a" in [info globals]}] } -result {2 1 3 3 1} test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} -setup { catch {namespace delete test_ns_compile} catch {unset x} } -body { namespace eval test_ns_compile { variable v hello variable arr set ::x $::test_ns_compile::v set ::test_ns_compile::arr(1) 123 } list $::x $::test_ns_compile::arr(1) } -result {hello 123} test compile-7.1 {TclCompileWhileCmd: command substituted test expression} { set i 0 set j 0 # Should be "forever" while [expr {$i < 3}] { set j [incr i] if {$j > 3} break } set j } {4} test compile-8.1 {CollectArgInfo: binary data} { list [catch "string length \000foo" msg] $msg } {0 4} test compile-8.2 {CollectArgInfo: binary data} { list [catch "string length foo\000" msg] $msg } {0 4} test compile-8.3 {CollectArgInfo: handle "]" at end of command properly} { set x ] } {]} test compile-9.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} { proc p {} { set x {} eval $x append x { } eval $x } p } {} test compile-10.1 {BLACKBOX: exception stack overflow} { set x {{0}} set y 0 while {$y < 100} { if !$x {incr y} } } {} test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { # shared object - Interp result && Var 'r' set r [list foobar] # command that will add error to result lindex a bogus }} } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a bogus }} } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a 0o9 }} } -returnCodes error -match glob -result {*invalid octal number*} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; array set var {one two many} }} } -returnCodes error -result {list must have an even number of elements} test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; incr foo bar baz}} } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; incr}} } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; expr [concat !a] }} } -returnCodes error -match glob -result * test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; expr {!a} }} } -returnCodes error -match glob -result * test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; llength "\{" }} list [catch {p} msg] $msg } -returnCodes error -result {unmatched open brace in list} # # Special section for tests of tclLiteral.c # The following tests check for incorrect memory handling in # TclReleaseLiteral. They are only effective when tcl is compiled with # TCL_MEM_DEBUG # # Special test for leak on interp delete [Bug 467523]. test compile-12.1 {testing literal leak on interp delete} -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex $lines 3 3 } } -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { interp create foo foo eval { namespace eval bar {} } interp delete foo set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { rename getbytes {} unset -nocomplain end i tmp leakedBytes } -result 0 # Special test for a memory error in a preliminary fix of [Bug 467523]. It # requires executing a helpfile. Presumably the child process is used because # when this test fails, it crashes. test compile-12.2 {testing error on literal deletion} -constraints {memory exec} -body { set sourceFile [makeFile { for {set i 0} {$i < 5} {incr i} { namespace eval bar {} namespace delete bar } puts 0 } source.file] exec [interpreter] $sourceFile } -cleanup { catch {removeFile $sourceFile} } -result 0 # Test to catch buffer overrun in TclCompileTokens from buf 530320 test compile-12.3 {check for a buffer overrun} -body { proc crash {} { puts $array([expr {a+2}]) } crash } -returnCodes error -cleanup { rename crash {} } -match glob -result * test compile-12.4 {TclCleanupLiteralTable segfault} -body { # Tcl Bug 1001997 # Here, we're trying to test a case that causes a crash in # TclCleanupLiteralTable. The conditions that we're trying to establish # are: # - TclCleanupLiteralTable is attempting to clean up a bytecode object in # the literal table. # - The bytecode object in question contains the only reference to another # literal. # - The literal in question is in the same hash bucket as the bytecode # object, and immediately follows it in the chain. # Since newly registered literals are added at the FRONT of the bucket # chains, and since the bytecode object is registered before its literals, # this is difficult to achieve. What we do is: # (a) do a [namespace eval] of a string that's calculated to hash into # the same bucket as a literal that it contains. In this case, the # script and the variable 'bugbug' land in the same bucket. # (b) do a [namespace eval] of a string that contains enough literals to # force TclRegisterLiteral to rebuild the global literal table. The # newly created hash buckets will contain the literals, IN REVERSE # ORDER, thus putting the bytecode immediately ahead of 'bugbug' and # 'bug4345bug'. The bytecode object will contain the only references # to those two literals. # (c) Delete the interpreter to invoke TclCleanupLiteralTable and tickle # the bug. proc foo {} { set i [interp create] $i eval { namespace eval ::w {concat 4649; variable bugbug} namespace eval ::w { concat x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 \ x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 \ x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 \ x31 x32 X33 X34 X35 X36 X37 X38 X39 X40 \ x41 x42 x43 x44 x45 x46 x47 x48 x49 x50 \ x51 x52 x53 x54 x55 x56 x57 x58 x59 x60 \ x61 x62 x63 x64 concat y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 \ y11 y12 y13 y14 y15 y16 y17 y18 y19 y20 \ y21 y22 y23 y24 y25 y26 y27 y28 y29 y30 \ y31 y32 Y33 Y34 Y35 Y36 Y37 Y38 Y39 Y40 \ y41 y42 y43 y44 y45 y46 y47 y48 y49 y50 \ y51 y52 y53 y54 y55 y56 y57 y58 y59 y60 \ y61 y62 y63 y64 concat z1 z2 z3 z4 z5 z6 z7 z8 z9 z10 \ z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 \ z21 z22 z23 z24 z25 z26 z27 z28 z29 z30 \ z31 z32 } } interp delete $i; # must not crash return ok } foo } -cleanup { rename foo {} } -result ok # Special test for underestimating the maxStackSize required for a compiled # command. A failure will cause a segfault in the child process. test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { set body {set x [list} for {set i 0} {$i < 3000} {incr i} { append body " $i" } append body {]; puts OK} regsub BODY {proc crash {} {BODY}; crash} $body script list [catch {exec [interpreter] << $script} msg] $msg } {0 OK} # Tests of nested compile (body in body compilation), should not generate stack overflow # (with abnormal program termination), bug [fec0c17d39]: proc _ti_gencode {} { # creates test interpreter on demand with [gencode] generator: if {[interp exists ti]} { return } interp create ti ti eval {proc gencode {nr {cmd eval} {nl 0}} { set code "" set e ""; if {$nl} {set e "\n"} for {set i 0} {$i < $nr} {incr i} { append code "$cmd \{$e" } append code "lappend result 1$e" for {set i 0} {$i < $nr} {incr i} { append code "\}$e" } #puts [format "%% %.40s ... %d bytes" $code [string length $code]] return $code }} } test compile-13.2 {TclCompileScript: testing expected nested scripts compilation} -setup { _ti_gencode interp recursionlimit ti [expr {10000+50}] ti eval {set result {}} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), # with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) ti eval {foreach cmd {eval "if 1" try catch} { set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 1000}] $cmd] if 1 $c }} ti eval {set result} } -result {1 1 1 1} test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup { _ti_gencode interp recursionlimit ti 100 ti eval {set result {}} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), # with 500 nested scripts (bodies). It must generate "too many nested compilations" # error for any variant we're testing here: ti eval {foreach cmd {eval "if 1" try catch} { set c [gencode 500 $cmd] lappend errors [catch $c e] $e }} #puts $errors # all of nested calls exceed the limit, so must end with "too many nested compilations" # (or evaluations, depending on compile method/instruction and "mixed" compile within # evaluation), so no one succeeds, the result must be empty: ti eval {set result} } -result {} # # clean up: if {[interp exists ti]} { interp delete ti } rename _ti_gencode {} # Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { catch {set a([error])} msg1 catch {set bubba([join $abba $jubba]) $vol} msg2 list $msg1 $msg2 } {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}} test compile-14.2 {testing element name "$"} -body { unset -nocomplain a set a() 1 set a(1) 2 set a($) 3 list [set a()] [set a(1)] [set a($)] [unset a() a(1); lindex [array names a] 0] } -cleanup {unset a} -result [list 1 2 3 {$}] # Tests compile-15.* cover Tcl Bug 633204 test compile-15.1 {proper TCL_RETURN code from [return]} { apply {{} {catch return}} } 2 test compile-15.2 {proper TCL_RETURN code from [return]} { apply {{} {catch {return foo}}} } 2 test compile-15.3 {proper TCL_RETURN code from [return]} { apply {{} {catch {return $::tcl_library}}} } 2 test compile-15.4 {proper TCL_RETURN code from [return]} { apply {{} {catch {return [info library]}}} } 2 test compile-15.5 {proper TCL_RETURN code from [return]} { apply {{} {catch {set a 1}; return}} } "" for {set noComp 0} {$noComp <= 1} {incr noComp} { if {$noComp} { interp alias {} run {} testevalex set constraints testevalex } else { interp alias {} run {} if 1 set constraints {} } test compile-16.1.$noComp {TclCompileScript: word expansion} $constraints { run "list [string repeat {{*}a } 255]" } [lrepeat 255 a] test compile-16.2.$noComp {TclCompileScript: word expansion} $constraints { run "list [string repeat {{*}a } 256]" } [lrepeat 256 a] test compile-16.3.$noComp {TclCompileScript: word expansion} $constraints { run "list [string repeat {{*}a } 257]" } [lrepeat 257 a] test compile-16.4.$noComp {TclCompileScript: word expansion} $constraints { run {{*}list} } {} test compile-16.5.$noComp {TclCompileScript: word expansion} $constraints { run {{*}list {*}{x y z}} } {x y z} test compile-16.6.$noComp {TclCompileScript: word expansion} $constraints { run {{*}list {*}[list x y z]} } {x y z} test compile-16.7.$noComp {TclCompileScript: word expansion} $constraints { run {{*}list {*}[list x y z][list x y z]} } {x y zx y z} test compile-16.8.$noComp {TclCompileScript: word expansion} -body { set l {x y z} run {{*}list {*}$l} } -constraints $constraints -cleanup { unset l } -result {x y z} test compile-16.9.$noComp {TclCompileScript: word expansion} -body { set l {x y z} run {{*}list {*}$l$l} } -constraints $constraints -cleanup { unset l } -result {x y zx y z} test compile-16.10.$noComp {TclCompileScript: word expansion} -body { run {{*}\{} } -constraints $constraints -returnCodes error \ -result {unmatched open brace in list} test compile-16.11.$noComp {TclCompileScript: word expansion} -body { proc badList {} {return \{} run {{*}[badList]} } -constraints $constraints -cleanup { rename badList {} } -returnCodes error -result {unmatched open brace in list} test compile-16.12.$noComp {TclCompileScript: word expansion} $constraints { run {{*}list x y z} } {x y z} test compile-16.13.$noComp {TclCompileScript: word expansion} $constraints { run {{*}list x y {*}z} } {x y z} test compile-16.14.$noComp {TclCompileScript: word expansion} $constraints { run {{*}list x {*}y z} } {x y z} test compile-16.15.$noComp {TclCompileScript: word expansion} $constraints { run {list x y {*}z} } {x y z} test compile-16.16.$noComp {TclCompileScript: word expansion} $constraints { run {list x {*}y z} } {x y z} test compile-16.17.$noComp {TclCompileScript: word expansion} $constraints { run {list {*}x y z} } {x y z} # These tests note that expansion can in theory cause the number of arguments # to a command to exceed INT_MAX, which is as big as objc is allowed to get. # # In practice, it seems we will run out of memory before we confront this # issue. Note that compiled operations run out of memory at smaller objc # values than direct string evaluation. # # These tests are constrained as knownBug because they are likely to cause # memory allocation panics somewhere, and we don't want panics in the test # suite. # test compile-16.18.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<10}] x]} llength [run "list [string repeat {{*}[LongList] } [expr {1<<10}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} } -returnCodes ok -result [expr {1<<20}] test compile-16.19.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<11}] x]} llength [run "list [string repeat {{*}[LongList] } [expr {1<<11}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} } -returnCodes ok -result [expr {1<<22}] test compile-16.20.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<12}] x]} llength [run "list [string repeat {{*}[LongList] } [expr {1<<12}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} } -returnCodes ok -result [expr {1<<24}] # This is the one that should cause overflow test compile-16.21.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<16}] x]} llength [run "list [string repeat {{*}[LongList] } [expr {1<<16}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} } -returnCodes ok -result [expr {wide(1)<<32}] test compile-16.22.$noComp { Bug 845412: TclCompileScript: word expansion not mandatory } -body { # This test may crash and will fail unless Bug 845412 is fixed. proc ReturnResults args {return $args} run "ReturnResults [string repeat {x } 260]" } -constraints $constraints -cleanup { rename ReturnResults {} } -returnCodes ok -result [string trim [string repeat {x } 260]] test compile-16.23.$noComp { Bug 1032805: defer parse error until run time } -constraints $constraints -body { namespace eval x { run { proc if {a b} {uplevel 1 [list set $a $b]} if 1 {syntax {}{}} } } } -cleanup { namespace delete x } -returnCodes ok -result {syntax {}{}} test compile-16.24.$noComp { Bug 1638414: bad list constant as first expanded term } -constraints $constraints -body { run "{*}\"\{foo bar\"" } -returnCodes error -result {unmatched open brace in list} test compile-16.25.$noComp {TclCompileScript: word expansion, naked backslashes} $constraints { run {list {*}{a \n b}} } {a { } b} test compile-16.26.$noComp {TclCompileScript: word expansion, protected backslashes} $constraints { run {list {*}{a {\n} b}} } {a {\n} b} } ;# End of noComp loop # These tests are messy because it wrecks the interpreter it runs in! They # demonstrate issues arising from [FRQ 1101710] test compile-17.1 {Command interpretation binding for compiled code} -constraints knownBug -setup { set i [interp create] } -body { $i eval { if 1 { expr [ proc expr args {return substituted} format {[subst compiled]} ] } } } -cleanup { interp delete $i } -result substituted test compile-17.2 {Command interpretation binding for non-compiled code} -setup { set i [interp create] } -body { $i eval { if 1 { [subst expr] [ proc expr args {return substituted} format {[subst compiled]} ] } } } -cleanup { interp delete $i } -result substituted # This tests the supported parts of the unsupported [disassemble] command. It # does not check the format of disassembled bytecode though; that's liable to # change without warning. set disassemblables [linsert [join { constructor destructor lambda method objmethod proc script } ", "] end-1 or] test compile-18.1 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble } -match glob -result {wrong # args: should be "*"} test compile-18.2 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble ? } -result "bad type \"?\": must be $disassemblables" test compile-18.3 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble lambda } -match glob -result {wrong # args: should be "* lambda lambdaTerm"} test compile-18.4 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble lambda \{ } -result "can't interpret \"\{\" as a lambda expression" test compile-18.5 {disassembler - basics} -body { # Allow any string: the result format is not defined anywhere! tcl::unsupported::disassemble lambda {{} {}} } -match glob -result * test compile-18.6 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble proc } -match glob -result {wrong # args: should be "* proc procName"} test compile-18.7 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble proc nosuchproc } -result {"nosuchproc" isn't a procedure} test compile-18.8 {disassembler - basics} -setup { proc chewonthis {} {} } -body { # Allow any string: the result format is not defined anywhere! tcl::unsupported::disassemble proc chewonthis } -cleanup { rename chewonthis {} } -match glob -result * test compile-18.9 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble script } -match glob -result {wrong # args: should be "* script script"} test compile-18.10 {disassembler - basics} -body { # Allow any string: the result format is not defined anywhere! tcl::unsupported::disassemble script {} } -match glob -result * test compile-18.11 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble method } -match glob -result {wrong # args: should be "* method className methodName"} test compile-18.12 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble method nosuchclass foo } -result {nosuchclass does not refer to an object} test compile-18.13 {disassembler - basics} -returnCodes error -setup { oo::object create justanobject } -body { tcl::unsupported::disassemble method justanobject foo } -cleanup { justanobject destroy } -result {"justanobject" is not a class} test compile-18.14 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble method oo::object nosuchmethod } -result {unknown method "nosuchmethod"} test compile-18.15 {disassembler - basics} -setup { oo::class create foo {method bar {} {}} } -body { # Allow any string: the result format is not defined anywhere! tcl::unsupported::disassemble method foo bar } -cleanup { foo destroy } -match glob -result * test compile-18.16 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble objmethod } -match glob -result {wrong # args: should be "* objmethod objectName methodName"} test compile-18.17 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble objmethod nosuchobject foo } -result {nosuchobject does not refer to an object} test compile-18.18 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble objmethod oo::object nosuchmethod } -result {unknown method "nosuchmethod"} test compile-18.19 {disassembler - basics} -setup { oo::object create foo oo::objdefine foo {method bar {} {}} } -body { # Allow any string: the result format is not defined anywhere! tcl::unsupported::disassemble objmethod foo bar } -cleanup { foo destroy } -match glob -result * # There never was a compile-18.20. # The keys of the dictionary produced by [getbytecode] are defined. set bytecodekeys {literals variables exception instructions auxiliary commands script namespace stackdepth exceptdepth} test compile-18.21 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode } -match glob -result {wrong # args: should be "*"} test compile-18.22 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode ? } -result "bad type \"?\": must be $disassemblables" test compile-18.23 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode lambda } -match glob -result {wrong # args: should be "* lambda lambdaTerm"} test compile-18.24 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode lambda \{ } -result "can't interpret \"\{\" as a lambda expression" test compile-18.25 {disassembler - basics} -body { dict keys [tcl::unsupported::getbytecode lambda {{} {}}] } -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.26 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode proc } -match glob -result {wrong # args: should be "* proc procName"} test compile-18.27 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode proc nosuchproc } -result {"nosuchproc" isn't a procedure} test compile-18.28 {disassembler - basics} -setup { proc chewonthis {} {} } -body { dict keys [tcl::unsupported::getbytecode proc chewonthis] } -cleanup { rename chewonthis {} } -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.28.1 {disassembler - tricky bit} -setup { eval [list proc chewonthis {} {}] } -body { dict keys [tcl::unsupported::getbytecode proc chewonthis] } -cleanup { rename chewonthis {} } -result $bytecodekeys test compile-18.28.2 {disassembler - tricky bit} -setup { eval {proc chewonthis {} {}} } -body { dict keys [tcl::unsupported::getbytecode proc chewonthis] } -cleanup { rename chewonthis {} } -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.28.3 {disassembler - tricky bit} -setup { proc Proc {n a b} { proc $n $a $b } Proc chewonthis {} {} } -body { dict keys [tcl::unsupported::getbytecode proc chewonthis] } -cleanup { rename Proc {} rename chewonthis {} } -result $bytecodekeys test compile-18.28.4 {disassembler - tricky bit} -setup { proc Proc {n a b} { tailcall proc $n $a $b } Proc chewonthis {} {} } -body { dict keys [tcl::unsupported::getbytecode proc chewonthis] } -cleanup { rename Proc {} rename chewonthis {} } -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.29 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode script } -match glob -result {wrong # args: should be "* script script"} test compile-18.30 {disassembler - basics} -body { dict keys [tcl::unsupported::getbytecode script {}] } -result $bytecodekeys test compile-18.31 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode method } -match glob -result {wrong # args: should be "* method className methodName"} test compile-18.32 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode method nosuchclass foo } -result {nosuchclass does not refer to an object} test compile-18.33 {disassembler - basics} -returnCodes error -setup { oo::object create justanobject } -body { tcl::unsupported::getbytecode method justanobject foo } -cleanup { justanobject destroy } -result {"justanobject" is not a class} test compile-18.34 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode method oo::object nosuchmethod } -result {unknown method "nosuchmethod"} test compile-18.35 {disassembler - basics} -setup { oo::class create foo {method bar {} {}} } -body { dict keys [tcl::unsupported::getbytecode method foo bar] } -cleanup { foo destroy } -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.36 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode objmethod } -match glob -result {wrong # args: should be "* objmethod objectName methodName"} test compile-18.37 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode objmethod nosuchobject foo } -result {nosuchobject does not refer to an object} test compile-18.38 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode objmethod oo::object nosuchmethod } -result {unknown method "nosuchmethod"} test compile-18.39 {disassembler - basics} -setup { oo::object create foo oo::objdefine foo {method bar {} {}} } -body { dict keys [tcl::unsupported::getbytecode objmethod foo bar] } -cleanup { foo destroy } -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.40 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble constructor } -match glob -result {wrong # args: should be "* constructor className"} test compile-18.41 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble constructor nosuchclass } -result {nosuchclass does not refer to an object} test compile-18.42 {disassembler - basics} -returnCodes error -setup { oo::object create justanobject } -body { tcl::unsupported::disassemble constructor justanobject } -cleanup { justanobject destroy } -result {"justanobject" is not a class} test compile-18.43 {disassembler - basics} -returnCodes error -setup { oo::class create constructorless } -body { tcl::unsupported::disassemble constructor constructorless } -cleanup { constructorless destroy } -result {"constructorless" has no defined constructor} test compile-18.44 {disassembler - basics} -setup { oo::class create foo {constructor {} {set x 1}} } -body { # Allow any string: the result format is not defined anywhere! tcl::unsupported::disassemble constructor foo } -cleanup { foo destroy } -match glob -result * test compile-18.45 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode constructor } -match glob -result {wrong # args: should be "* constructor className"} test compile-18.46 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode constructor nosuchobject } -result {nosuchobject does not refer to an object} test compile-18.47 {disassembler - basics} -returnCodes error -setup { oo::class create constructorless } -body { tcl::unsupported::getbytecode constructor constructorless } -cleanup { constructorless destroy } -result {"constructorless" has no defined constructor} test compile-18.48 {disassembler - basics} -setup { oo::class create foo {constructor {} {set x 1}} } -body { dict keys [tcl::unsupported::getbytecode constructor foo] } -cleanup { foo destroy } -result "$bytecodekeys" # There is no compile-18.49 test compile-18.50 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble destructor } -match glob -result {wrong # args: should be "* destructor className"} test compile-18.51 {disassembler - basics} -returnCodes error -body { tcl::unsupported::disassemble destructor nosuchclass } -result {nosuchclass does not refer to an object} test compile-18.52 {disassembler - basics} -returnCodes error -setup { oo::object create justanobject } -body { tcl::unsupported::disassemble destructor justanobject } -cleanup { justanobject destroy } -result {"justanobject" is not a class} test compile-18.53 {disassembler - basics} -returnCodes error -setup { oo::class create constructorless } -body { tcl::unsupported::disassemble destructor constructorless } -cleanup { constructorless destroy } -result {"constructorless" has no defined destructor} test compile-18.54 {disassembler - basics} -setup { oo::class create foo {destructor {set x 1}} } -body { # Allow any string: the result format is not defined anywhere! tcl::unsupported::disassemble destructor foo } -cleanup { foo destroy } -match glob -result * test compile-18.55 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode destructor } -match glob -result {wrong # args: should be "* destructor className"} test compile-18.56 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode destructor nosuchobject } -result {nosuchobject does not refer to an object} test compile-18.57 {disassembler - basics} -returnCodes error -setup { oo::class create constructorless } -body { tcl::unsupported::getbytecode destructor constructorless } -cleanup { constructorless destroy } -result {"constructorless" has no defined destructor} test compile-18.58 {disassembler - basics} -setup { oo::class create foo {destructor {set x 1}} } -body { dict keys [tcl::unsupported::getbytecode destructor foo] } -cleanup { foo destroy } -result "$bytecodekeys" test compile-19.0 {Bug 3614102: reset stack housekeeping} -body { # This will panic in a --enable-symbols=compile build, unless bug is fixed. apply {{} {list [if 1]}} } -returnCodes error -match glob -result * test compile-20.1 {ensure there are no infinite loops in optimizing} { tcl::unsupported::disassemble script { while 1 { return -code continue -level 0 } } return } {} test compile-20.2 {ensure there are no infinite loops in optimizing} { tcl::unsupported::disassemble script { while 1 { while 1 { return -code break -level 0 } } } return } {} test compile-21.1 {stack balance management} { apply {{} { set result {} while 1 { lappend result a lappend result [list b [break]] lappend result c } return $result }} } a test compile-21.2 {stack balance management} { apply {{} { set result {} while {[incr i] <= 10} { lappend result $i lappend result [list b [continue] c] lappend result c } return $result }} } {1 2 3 4 5 6 7 8 9 10} test compile-21.3 {stack balance management} { apply {args { set result {} while 1 { lappend result a lappend result [concat {*}$args [break]] lappend result c } return $result }} P Q R S T } a test compile-21.4 {stack balance management} { apply {args { set result {} while {[incr i] <= 10} { lappend result $i lappend result [concat {*}$args [continue] c] lappend result c } return $result }} P Q R S T } {1 2 3 4 5 6 7 8 9 10} # TODO sometime - check that bytecode from tbcload is *not* disassembled. # cleanup catch {rename p ""} catch {namespace delete test_ns_compile} catch {unset x} catch {unset y} catch {unset a} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/concat.test0000644000175000017500000000307314554262142015157 0ustar sergeisergei# Commands covered: concat # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test concat-1.1 {simple concatenation} { concat a b c d e f g } {a b c d e f g} test concat-1.2 {merging lists together} { concat a {b c d} {e f g h} } {a b c d e f g h} test concat-1.3 {merge lists, retain sub-lists} { concat a {b {c d}} {{e f}} g h } {a b {c d} {e f} g h} test concat-1.4 {special characters} { concat a\{ {b \{c d} \{d } "a{ b \\{c d {d" test concat-2.1 {error: one empty argument} { concat {} } {} test concat-3.1 {error: no arguments} { list [catch concat msg] $msg } {0 {}} test concat-4.1 {pruning off extra white space} { concat {} {a b c} } {a b c} test concat-4.2 {pruning off extra white space} { concat x y " a b c \n\t " " " " def " } {x y a b c def} test concat-4.3 {pruning off extra white space sets length correctly} { llength [concat { {{a}} }] } 1 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/config.test0000644000175000017500000000427514554262142015162 0ustar sergeisergei# -*- tcl -*- # Commands covered: pkgconfig # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test pkgconfig-1.1 {query keys} { lsort [::tcl::pkgconfig list] } {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded} test pkgconfig-1.2 {query keys multiple times} { string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list] } 0 test pkgconfig-1.3 {query value multiple times} { string compare \ [::tcl::pkgconfig get bindir,install] \ [::tcl::pkgconfig get bindir,install] } 0 test pkgconfig-2.0 {error: missing subcommand} { catch {::tcl::pkgconfig} msg set msg } {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"} test pkgconfig-2.1 {error: illegal subcommand} { catch {::tcl::pkgconfig foo} msg set msg } {bad subcommand "foo": must be get or list} test pkgconfig-2.2 {error: list with arguments} { catch {::tcl::pkgconfig list foo} msg set msg } {wrong # args: should be "::tcl::pkgconfig list"} test pkgconfig-2.3 {error: get without arguments} { catch {::tcl::pkgconfig get} msg set msg } {wrong # args: should be "::tcl::pkgconfig get key"} test pkgconfig-2.4 {error: query unknown key} { catch {::tcl::pkgconfig get foo} msg set msg } {key not known} test pkgconfig-2.5 {error: query with to many arguments} { catch {::tcl::pkgconfig get foo bar} msg set msg } {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/coroutine.test0000644000175000017500000005231414554262142015721 0ustar sergeisergei# Commands covered: coroutine, yield, yieldto, [info coroutine] # # This file contains a collection of tests for experimental commands that are # found in ::tcl::unsupported. The tests will migrate to normal test files # if/when the commands find their way into the core. # # Copyright (c) 2008 by Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testnrelevels [llength [info commands testnrelevels]] testConstraint memory [llength [info commands memory]] set lambda [list {{start 0} {stop 10}} { # init set i $start set imax $stop yield while {$i < $imax} { yield [expr {$i*$stop}] incr i } }] test coroutine-1.1 {coroutine basic} -setup { coroutine foo ::apply $lambda set res {} } -body { for {set k 1} {$k < 4} {incr k} { lappend res [foo] } set res } -cleanup { rename foo {} unset res } -result {0 10 20} test coroutine-1.2 {coroutine basic} -setup { coroutine foo ::apply $lambda 2 8 set res {} } -body { for {set k 1} {$k < 4} {incr k} { lappend res [foo] } set res } -cleanup { rename foo {} unset res } -result {16 24 32} test coroutine-1.3 {yield returns new arg} -setup { set body { # init set i $start set imax $stop yield while {$i < $imax} { set stop [yield [expr {$i*$stop}]] incr i } } coroutine foo ::apply [list {{start 2} {stop 10}} $body] set res {} } -body { for {set k 1} {$k < 4} {incr k} { lappend res [foo $k] } set res } -cleanup { rename foo {} unset res } -result {20 6 12} test coroutine-1.4 {yield in nested proc} -setup { proc moo {} { upvar 1 i i stop stop yield [expr {$i*$stop}] } set body { # init set i $start set imax $stop yield while {$i < $imax} { moo incr i } } coroutine foo ::apply [list {{start 0} {stop 10}} $body] set res {} } -body { for {set k 1} {$k < 4} {incr k} { lappend res [foo $k] } set res } -cleanup { rename foo {} rename moo {} unset body res } -result {0 10 20} test coroutine-1.5 {just yield} -body { coroutine foo yield list [foo] [catch foo msg] $msg } -cleanup { unset msg } -result {{} 1 {invalid command name "foo"}} test coroutine-1.6 {just yield} -body { coroutine foo [list yield] list [foo] [catch foo msg] $msg } -cleanup { unset msg } -result {{} 1 {invalid command name "foo"}} test coroutine-1.7 {yield in nested uplevel} -setup { set body { # init set i $start set imax $stop yield while {$i < $imax} { uplevel 0 [list yield [expr {$i*$stop}]] incr i } } coroutine foo ::apply [list {{start 0} {stop 10}} $body] set res {} } -body { for {set k 1} {$k < 4} {incr k} { lappend res [eval foo $k] } set res } -cleanup { rename foo {} unset body res } -result {0 10 20} test coroutine-1.8 {yield in nested uplevel} -setup { set body { # init set i $start set imax $stop yield while {$i < $imax} { uplevel 0 yield [expr {$i*$stop}] incr i } } coroutine foo ::apply [list {{start 0} {stop 10}} $body] set res {} } -body { for {set k 1} {$k < 4} {incr k} { lappend res [eval foo $k] } set res } -cleanup { rename foo {} unset body res } -result {0 10 20} test coroutine-1.9 {yield in nested eval} -setup { proc moo {} { upvar 1 i i stop stop yield [expr {$i*$stop}] } set body { # init set i $start set imax $stop yield while {$i < $imax} { eval moo incr i } } coroutine foo ::apply [list {{start 0} {stop 10}} $body] set res {} } -body { for {set k 1} {$k < 4} {incr k} { lappend res [foo $k] } set res } -cleanup { rename moo {} unset body res } -result {0 10 20} test coroutine-1.10 {yield in nested eval} -setup { set body { # init set i $start set imax $stop yield while {$i < $imax} { eval yield [expr {$i*$stop}] incr i } } coroutine foo ::apply [list {{start 0} {stop 10}} $body] set res {} } -body { for {set k 1} {$k < 4} {incr k} { lappend res [eval foo $k] } set res } -cleanup { unset body res } -result {0 10 20} test coroutine-1.11 {yield outside coroutine} -setup { proc moo {} { upvar 1 i i stop stop yield [expr {$i*$stop}] } } -body { variable i 5 stop 6 moo } -cleanup { rename moo {} unset i stop } -returnCodes error -result {yield can only be called in a coroutine} test coroutine-1.12 {proc as coroutine} -setup { set body { # init set i $start set imax $stop yield while {$i < $imax} { uplevel 0 [list yield [expr {$i*$stop}]] incr i } } proc moo {{start 0} {stop 10}} $body coroutine foo moo 2 8 } -body { list [foo] [foo] } -cleanup { unset body rename moo {} rename foo {} } -result {16 24} test coroutine-1.13 {subst as coroutine: literal} { list [coroutine foo eval {subst {>>[yield a],[yield b]<<}}] [foo x] [foo y] } {a b >>x,y<<} test coroutine-1.14 {subst as coroutine: in variable} { set pattern {>>[yield c],[yield d]<<} list [coroutine foo eval {subst $pattern}] [foo p] [foo q] } {c d >>p,q<<} test coroutine-2.1 {self deletion on return} -body { coroutine foo set x 3 foo } -returnCodes error -result {invalid command name "foo"} test coroutine-2.2 {self deletion on return} -body { coroutine foo ::apply [list {} {yield; yield 1; return 2}] list [foo] [foo] [catch foo msg] $msg } -result {1 2 1 {invalid command name "foo"}} test coroutine-2.3 {self deletion on error return} -body { coroutine foo ::apply [list {} {yield;yield 1; error ouch!}] list [foo] [catch foo msg] $msg [catch foo msg] $msg } -result {1 1 ouch! 1 {invalid command name "foo"}} test coroutine-2.4 {self deletion on other return} -body { coroutine foo ::apply [list {} {yield;yield 1; return -code 100 ouch!}] list [foo] [catch foo msg] $msg [catch foo msg] $msg } -result {1 100 ouch! 1 {invalid command name "foo"}} test coroutine-2.5 {deletion of suspended coroutine} -body { coroutine foo ::apply [list {} {yield; yield 1; return 2}] list [foo] [rename foo {}] [catch foo msg] $msg } -result {1 {} 1 {invalid command name "foo"}} test coroutine-2.6 {deletion of running coroutine} -body { coroutine foo ::apply [list {} {yield; rename foo {}; yield 1; return 2}] list [foo] [catch foo msg] $msg } -result {1 1 {invalid command name "foo"}} test coroutine-3.1 {info level computation} -setup { proc a {} {while 1 {yield [info level]}} proc b {} foo } -body { # note that coroutines execute in uplevel #0 set l0 [coroutine foo a] set l1 [foo] set l2 [b] list $l0 $l1 $l2 } -cleanup { rename a {} rename b {} } -result {1 1 1} test coroutine-3.2 {info frame computation} -setup { proc a {} {while 1 {yield [info frame]}} proc b {} foo } -body { set l0 [coroutine foo a] set l1 [foo] set l2 [b] expr {$l2 - $l1} } -cleanup { rename a {} rename b {} } -result 1 test coroutine-3.3 {info coroutine} -setup { proc a {} {info coroutine} proc b {} a } -body { b } -cleanup { rename a {} rename b {} } -result {} test coroutine-3.4 {info coroutine} -setup { proc a {} {info coroutine} proc b {} a } -body { coroutine foo b } -cleanup { rename a {} rename b {} } -result ::foo test coroutine-3.5 {info coroutine} -setup { proc a {} {info coroutine} proc b {} {rename [info coroutine] {}; a} } -body { coroutine foo b } -cleanup { rename a {} rename b {} } -result {} test coroutine-3.6 {info frame, bug #2910094} -setup { proc stack {} { set res [list "LEVEL:[set lev [info frame]]"] for {set i 1} {$i < $lev} {incr i} { lappend res [info frame $i] } set res # the precise command depends on line numbers and such, is likely not # to be stable: just check that the test completes! return } proc a {} stack } -body { coroutine aa a } -cleanup { rename stack {} rename a {} } -result {} test coroutine-3.7 {bug 0b874c344d} { dict get [coroutine X coroutine Y info frame 0] cmd } {coroutine X coroutine Y info frame 0} test coroutine-4.1 {bug #2093188} -setup { proc foo {} { set v 1 trace add variable v {write unset} bar yield set v 2 yield set v 3 } proc bar args {lappend ::res $args} coroutine a foo } -body { list [a] [a] $::res } -cleanup { rename foo {} rename bar {} unset ::res } -result {{} 3 {{v {} write} {v {} write} {v {} unset}}} test coroutine-4.2 {bug #2093188} -setup { proc foo {} { set v 1 trace add variable v {read unset} bar yield set v 2 set v yield set v 3 } proc bar args {lappend ::res $args} coroutine a foo } -body { list [a] [a] $::res } -cleanup { rename foo {} rename bar {} unset ::res } -result {{} 3 {{v {} read} {v {} unset}}} test coroutine-4.3 {bug #2093947} -setup { proc foo {} { set v 1 trace add variable v {write unset} bar yield set v 2 yield set v 3 } proc bar args {lappend ::res $args} } -body { coroutine a foo a a coroutine a foo a rename a {} set ::res } -cleanup { rename foo {} rename bar {} unset ::res } -result {{v {} write} {v {} write} {v {} unset} {v {} write} {v {} unset}} test coroutine-4.4 {bug #2917627: cmd resolution} -setup { proc a {} {return global} namespace eval b {proc a {} {return local}} } -body { namespace eval b {coroutine foo a} } -cleanup { rename a {} namespace delete b } -result local test coroutine-4.5 {bug #2724403} -constraints {memory} \ -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex $lines 3 3 } } -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { set ns ::y$i namespace eval $ns {} proc ${ns}::start {} {yield; puts hello} coroutine ${ns}::run ${ns}::start namespace delete $ns set start $end set end [getbytes] } set leakedBytes [expr {$end - $start}] } -cleanup { rename getbytes {} unset i ns start end } -result 0 test coroutine-4.6 {compile context, bug #3282869} -setup { unset -nocomplain ::x proc f x { coroutine D eval {yield X$x;yield Y} } } -body { f 12 } -cleanup { rename f {} } -returnCodes error -match glob -result {can't read *} test coroutine-4.7 {compile context, bug #3282869} -setup { proc f x { coroutine D eval {yield X$x;yield Y$x} } } -body { set ::x 15 set ::x [f 12] D } -cleanup { D unset ::x rename f {} } -result YX15 test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \ -setup { proc nestedYield {{val {}}} { yield $val } proc getNumLevel {} { # remove the level for this proc's call expr {[lindex [testnrelevels] 1] - 1} } proc relativeLevel base { # remove the level for this proc's call expr {[getNumLevel] - $base - 1} } proc foo {} { while 1 { nestedYield } } set res {} } -body { set base [getNumLevel] lappend res [relativeLevel $base] eval {coroutine a foo} # back to base level lappend res [relativeLevel $base] a lappend res [relativeLevel $base] eval a lappend res [relativeLevel $base] eval {eval a} lappend res [relativeLevel $base] rename a {} lappend res [relativeLevel $base] set res } -cleanup { rename foo {} rename nestedYield {} rename getNumLevel {} rename relativeLevel {} unset res } -result {0 0 0 0 0 0} test coroutine-5.2 {right numLevels within coro} -constraints {testnrelevels} \ -setup { proc nestedYield {{val {}}} { yield $val } proc getNumLevel {} { # remove the level for this proc's call expr {[lindex [testnrelevels] 1] - 1} } proc relativeLevel base { # remove the level for this proc's call expr {[getNumLevel] - $base - 1} } proc foo base { while 1 { set base [nestedYield [relativeLevel $base]] } } set res {} } -body { lappend res [eval {coroutine a foo [getNumLevel]}] lappend res [a [getNumLevel]] lappend res [eval {a [getNumLevel]}] lappend res [eval {eval {a [getNumLevel]}}] set base [lindex $res 0] foreach x $res[set res {}] { lappend res [expr {$x-$base}] } set res } -cleanup { rename a {} rename foo {} rename nestedYield {} rename getNumLevel {} rename relativeLevel {} unset res } -result {0 0 0 0} test coroutine-6.1 {coroutine nargs} -body { coroutine a ::apply $lambda a } -cleanup { rename a {} } -result 0 test coroutine-6.2 {coroutine nargs} -body { coroutine a ::apply $lambda a a } -cleanup { rename a {} } -result 0 test coroutine-6.3 {coroutine nargs} -body { coroutine a ::apply $lambda a a a } -cleanup { rename a {} } -returnCodes error -result {wrong # args: should be "a ?arg?"} test coroutine-7.1 {yieldto} -body { coroutine c apply {{} { yield yieldto return -level 0 -code 1 quux return quuy }} set res [list [catch c msg] $msg] lappend res [catch c msg] $msg lappend res [catch c msg] $msg } -cleanup { unset res } -result [list 1 quux 0 quuy 1 {invalid command name "c"}] test coroutine-7.2 {multi-argument yielding with yieldto} -body { proc corobody {} { set a 1 while 1 { set a [yield $a] set a [yieldto return -level 0 $a] lappend a [llength $a] } } coroutine a corobody coroutine b corobody list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \ [b ok] [rename b {}] } -cleanup { rename corobody {} } -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}} test coroutine-7.3 {yielding between coroutines} -body { proc juggler {target {value ""}} { if {$value eq ""} { set value [yield [info coroutine]] } while {[llength $value]} { lappend ::result $value [info coroutine] set value [lrange $value 0 end-1] lassign [yieldto $target $value] value } # Clear nested collection of coroutines catch $target } set result "" coroutine j1 juggler [coroutine j2 juggler [coroutine j3 juggler j1]]\ {a b c d e} list $result [info command j1] [info command j2] [info command j3] } -cleanup { catch {rename juggler ""} } -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}} test coroutine-7.4 {Bug 8ff0cb9fe1} -setup { proc foo {a b} {catch yield; return 1} } -cleanup { rename foo {} } -body { coroutine demo lsort -command foo {a b} } -result {b a} test coroutine-7.5 {return codes} { set result {} foreach code {0 1 2 3 4 5} { lappend result [catch {coroutine demo return -level 0 -code $code}] } set result } {0 1 2 3 4 5} test coroutine-7.6 {Early yield crashes} -setup { set i [interp create] } -body { # Force into a child interpreter [bug 60559fd4a6] $i eval { proc foo args {} trace add execution foo enter {catch yield} coroutine demo foo rename foo {} return ok } } -cleanup { interp delete $i } -result ok test coroutine-7.7 {Bug 2486550} -setup { set i [interp create] $i hide yield } -body { # Force into a child interpreter [bug 60559fd4a6] $i eval { coroutine demo interp invokehidden {} yield ok } } -cleanup { $i eval demo interp delete $i } -result ok test coroutine-7.8 {yieldto context nuke: Bug a90d9331bc} -setup { namespace eval cotest {} set ::result "" } -body { proc cotest::body {} { lappend ::result a yield OUT lappend ::result b yieldto ::return -level 0 123 lappend ::result c return } lappend ::result [coroutine cotest cotest::body] namespace delete cotest namespace eval cotest {} lappend ::result [cotest] cotest return $result } -returnCodes error -cleanup { catch {namespace delete ::cotest} catch {rename cotest ""} } -result {yieldto called in deleted namespace} test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup { namespace eval cotest {} set ::result "" } -body { proc cotest::body {} { set y ::yieldto lappend ::result a yield OUT lappend ::result b $y ::return -level 0 123 lappend ::result c return } lappend ::result [coroutine cotest cotest::body] namespace delete cotest namespace eval cotest {} lappend ::result [cotest] cotest return $result } -returnCodes error -cleanup { catch {namespace delete ::cotest} catch {rename cotest ""} } -result {yieldto called in deleted namespace} test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup { namespace eval cotest {} set ::result "" } -body { proc cotest::body {} { lappend ::result a yield OUT lappend ::result b yieldto ::return -level 0 -cotest [namespace delete ::cotest] 123 lappend ::result c return } lappend ::result [coroutine cotest cotest::body] lappend ::result [cotest] cotest return $result } -returnCodes error -cleanup { catch {namespace delete ::cotest} catch {rename cotest ""} } -result {yieldto called in deleted namespace} test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup { namespace eval cotest {} set ::result "" } -body { proc cotest::body {} { set y ::yieldto lappend ::result a yield OUT lappend ::result b $y ::return -level 0 -cotest [namespace delete ::cotest] 123 lappend ::result c return } lappend ::result [coroutine cotest cotest::body] lappend ::result [cotest] cotest return $result } -returnCodes error -cleanup { catch {namespace delete ::cotest} catch {rename cotest ""} } -result {yieldto called in deleted namespace} test coroutine-7.12 {coro floor above street level #3008307} -body { proc c {} { yield } proc cc {} { coroutine C c } proc boom {} { cc ; # coro created at level 2 C ; # and called at level 1 } boom ; # does not crash: the coro floor is a good insulator list } -cleanup { rename boom {}; rename cc {}; rename c {} } -result {} test coroutine-8.0.0 {coro inject executed} -body { coroutine demo apply {{} { foreach i {1 2} yield }} demo set ::result none tcl::unsupported::inject demo set ::result inject-executed demo set ::result } -result {inject-executed} test coroutine-8.0.1 {coro inject after error} -body { coroutine demo apply {{} { foreach i {1 2} yield; error test }} demo set ::result none tcl::unsupported::inject demo set ::result inject-executed lappend ::result [catch {demo} err] $err } -result {inject-executed 1 test} test coroutine-8.1.1 {coro inject, ticket 42202ba1e5ff566e} -body { interp create child child eval { coroutine demo apply {{} { while {1} yield }} demo tcl::unsupported::inject demo set ::result inject-executed } interp delete child } -result {} test coroutine-8.1.2 {coro inject with result, ticket 42202ba1e5ff566e} -body { interp create child child eval { coroutine demo apply {{} { while {1} yield }} demo tcl::unsupported::inject demo set ::result inject-executed } child eval demo set result [child eval {set ::result}] interp delete child set result } -result {inject-executed} test coroutine-9.1 {coro type} { coroutine demo eval { yield yield "PHASE 1" yieldto string cat "PHASE 2" ::tcl::unsupported::corotype [info coroutine] } list [demo] [::tcl::unsupported::corotype demo] \ [demo] [::tcl::unsupported::corotype demo] [demo] } {{PHASE 1} yield {PHASE 2} yieldto active} test coroutine-9.2 {coro type} -setup { catch {rename nosuchcommand ""} } -returnCodes error -body { ::tcl::unsupported::corotype nosuchcommand } -result {can only get coroutine type of a coroutine} test coroutine-9.3 {coro type} -returnCodes error -body { proc notacoroutine {} {} ::tcl::unsupported::corotype notacoroutine } -returnCodes error -cleanup { rename notacoroutine {} } -result {can only get coroutine type of a coroutine} test coroutine-10.1 {coroutine general introspection} -setup { set i [interp create] } -body { $i eval { # Make the introspection code namespace path tcl::unsupported proc probe {type var} { upvar 1 $var v set f [info frame] incr f -1 set result [list $v [dict get [info frame $f] proc]] if {$type eq "yield"} { tailcall yield $result } else { tailcall yieldto string cat $result } } proc pokecoro {c var} { inject $c probe [corotype $c] $var $c } # Coroutine implementations proc cbody1 {} { set val [info coroutine] set accum {} while {[set val [yield $val]] ne ""} { lappend accum $val set val ok } return $accum } proc cbody2 {} { set val [info coroutine] set accum {} while {[llength [set val [yieldto string cat $val]]]} { lappend accum {*}$val set val ok } return $accum } # Make the coroutines coroutine c1 cbody1 coroutine c2 cbody2 list [c1 abc] [c2 1 2 3] [pokecoro c1 accum] [pokecoro c2 accum] \ [c1 def] [c2 4 5 6] [pokecoro c1 accum] [pokecoro c2 accum] \ [c1] [c2] } } -cleanup { interp delete $i } -result {ok ok {abc ::cbody1} {{1 2 3} ::cbody2} ok ok {{abc def} ::cbody1} {{1 2 3 4 5 6} ::cbody2} {abc def} {1 2 3 4 5 6}} # cleanup unset lambda ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/dcall.test0000644000175000017500000000257614554262142014776 0ustar sergeisergei# Commands covered: none # # This file contains a collection of tests for Tcl_CallWhenDeleted. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testdcall [llength [info commands testdcall]] test dcall-1.1 {deletion callbacks} testdcall { lsort -increasing [testdcall 1 2 3] } {1 2 3} test dcall-1.2 {deletion callbacks} testdcall { testdcall } {} test dcall-1.3 {deletion callbacks} testdcall { lsort -increasing [testdcall 20 21 22 -22] } {20 21} test dcall-1.4 {deletion callbacks} testdcall { lsort -increasing [testdcall 20 21 22 -20] } {21 22} test dcall-1.5 {deletion callbacks} testdcall { lsort -increasing [testdcall 20 21 22 -21] } {20 22} test dcall-1.6 {deletion callbacks} testdcall { lsort -increasing [testdcall 20 21 22 -21 -22 -20] } {} # cleanup cleanupTests return tcl8.6.14/tests/dict.test0000644000175000017500000016757614554262142014656 0ustar sergeisergei# This test file covers the dictionary object type and the dict command used # to work with values of that type. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 2003-2009 Donal K. Fellows # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc memtest script { set end [lindex [split [memory info] \n] 3 3] for {set i 0} {$i < 5} {incr i} { uplevel 1 $script set tmp $end set end [lindex [split [memory info] \n] 3 3] } expr {$end - $tmp} } } test dict-1.1 {dict command basic syntax} -returnCodes error -body { dict } -result {wrong # args: should be "dict subcommand ?arg ...?"} test dict-1.2 {dict command basic syntax} -returnCodes error -body { dict ? } -match glob -result {unknown or ambiguous subcommand "?": must be *} test dict-2.1 {dict create command} { dict create } {} test dict-2.2 {dict create command} { dict create a b } {a b} test dict-2.3 {dict create command} -body { set result {} set dict [dict create a b c d] # Can't compare directly as ordering of values is undefined foreach key {a c} { set idx [lsearch -exact $dict $key] if {$idx & 1} { error "found $key at odd index $idx in $dict" } lappend result [lindex $dict [expr {$idx+1}]] } return $result } -cleanup { unset result dict key idx } -result {b d} test dict-2.4 {dict create command} -returnCodes error -body { dict create a } -result {wrong # args: should be "dict create ?key value ...?"} test dict-2.5 {dict create command} -returnCodes error -body { dict create a b c } -result {wrong # args: should be "dict create ?key value ...?"} test dict-2.6 {dict create command - initialse refcount field!} -body { # Bug 715751 will show up in memory debuggers like purify for {set i 0} {$i<10} {incr i} { set dictv [dict create a 0] set share [dict values $dictv] list [dict incr dictv a] } } -cleanup { unset i dictv share } -result {} test dict-2.7 {dict create command - #-quoting in string rep} { dict create # #comment } {{#} #comment} test dict-2.8 {dict create command - #-quoting in string rep} -body { dict create #a x #b x } -match glob -result {{#?} x #? x} test dict-2.9 {dict create command: compilation} { apply {{} {dict create [format a] b}} } {a b} test dict-2.10 {dict create command: compilation} { apply {{} {dict create [format a] b c d}} } {a b c d} test dict-2.11 {dict create command: compilation} { apply {{} {dict create [format a] b c d a x}} } {a x c d} test dict-2.12 {dict create command: non-compilation} { dict create [format a] b } {a b} test dict-2.13 {dict create command: non-compilation} { dict create [format a] b c d } {a b c d} test dict-2.14 {dict create command: non-compilation} { dict create [format a] b c d a x } {a x c d} test dict-3.1 {dict get command} {dict get {a b} a} b test dict-3.2 {dict get command} {dict get {a b c d} a} b test dict-3.3 {dict get command} {dict get {a b c d} c} d test dict-3.4 {dict get command} -returnCodes error -body { dict get {a b c d} b } -result {key "b" not known in dictionary} test dict-3.5 {dict get command} {dict get {a {p q r s} b {u v x y}} a p} q test dict-3.6 {dict get command} {dict get {a {p q r s} b {u v x y}} a r} s test dict-3.7 {dict get command} {dict get {a {p q r s} b {u v x y}} b u} v test dict-3.8 {dict get command} {dict get {a {p q r s} b {u v x y}} b x} y test dict-3.9 {dict get command} -returnCodes error -body { dict get {a {p q r s} b {u v x y}} a z } -result {key "z" not known in dictionary} test dict-3.10 {dict get command} -returnCodes error -body { dict get {a {p q r s} b {u v x y}} c z } -result {key "c" not known in dictionary} test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b test dict-3.12 {dict get command} -returnCodes error -body { dict get } -result {wrong # args: should be "dict get dictionary ?key ...?"} test dict-3.13 {dict get command} -body { set dict [dict get {a b c d}] if {$dict eq "a b c d"} { return OK } elseif {$dict eq "c d a b"} { return reordered } else { return $dict } } -cleanup { unset dict } -result OK test dict-3.14 {dict get command} -returnCodes error -body { dict get {a b c d} a c } -result {missing value to go with key} test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body { apply {{} { dict set a(z) b c dict get $a(z) d }} } -returnCodes error -result {key "d" not known in dictionary} test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3} test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6 test dict-4.1 {dict replace command} { dict replace {a b c d} } {a b c d} test dict-4.2 {dict replace command} { dict replace {a b c d} e f } {a b c d e f} test dict-4.3 {dict replace command} { dict replace {a b c d} c f } {a b c f} test dict-4.4 {dict replace command} { dict replace {a b c d} c x a y } {a y c x} test dict-4.5 {dict replace command} -returnCodes error -body { dict replace } -result {wrong # args: should be "dict replace dictionary ?key value ...?"} test dict-4.6 {dict replace command} -returnCodes error -body { dict replace {a a} a } -result {wrong # args: should be "dict replace dictionary ?key value ...?"} test dict-4.7 {dict replace command} -returnCodes error -body { dict replace {a a a} a b } -result {missing value to go with key} test dict-4.8 {dict replace command} -returnCodes error -body { dict replace [list a a a] a b } -result {missing value to go with key} test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b} test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c} test dict-4.11 {dict replace command: canonicality is forced} { dict replace { a b c d } } {a b c d} test dict-4.12 {dict replace command: canonicality is forced} { dict replace {a b c d a e} } {a e c d} test dict-4.13 {dict replace command: type check is mandatory} -body { dict replace { a b c d e } } -returnCodes error -result {missing value to go with key} test dict-4.13a {dict replace command: type check is mandatory} { catch {dict replace { a b c d e }} -> opt dict get $opt -errorcode } {TCL VALUE DICTIONARY} test dict-4.14 {dict replace command: type check is mandatory} -body { dict replace { a b {}c d } } -returnCodes error -result {dict element in braces followed by "c" instead of space} test dict-4.14a {dict replace command: type check is mandatory} { catch {dict replace { a b {}c d }} -> opt dict get $opt -errorcode } {TCL VALUE DICTIONARY JUNK} test dict-4.15 {dict replace command: type check is mandatory} -body { dict replace { a b ""c d } } -returnCodes error -result {dict element in quotes followed by "c" instead of space} test dict-4.15a {dict replace command: type check is mandatory} { catch {dict replace { a b ""c d }} -> opt dict get $opt -errorcode } {TCL VALUE DICTIONARY JUNK} test dict-4.16 {dict replace command: type check is mandatory} -body { dict replace " a b \"c d " } -returnCodes error -result {unmatched open quote in dict} test dict-4.16a {dict replace command: type check is mandatory} { catch {dict replace " a b \"c d "} -> opt dict get $opt -errorcode } {TCL VALUE DICTIONARY QUOTE} test dict-4.17 {dict replace command: type check is mandatory} -body { dict replace " a b \{c d " } -returnCodes error -result {unmatched open brace in dict} test dict-4.17a {dict replace command: type check is mandatory} { catch {dict replace " a b \{c d "} -> opt dict get $opt -errorcode } {TCL VALUE DICTIONARY BRACE} test dict-4.18 {dict replace command: canonicality forcing doesn't leak} { set example { a b c d } list $example [dict replace $example] } {{ a b c d } {a b c d}} test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d} test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b} test dict-5.3 {dict remove command} {dict remove {a b c d} a c} {} test dict-5.4 {dict remove command} {dict remove {a b c d} c a} {} test dict-5.5 {dict remove command} { dict remove {a b c d} } {a b c d} test dict-5.6 {dict remove command} {dict remove {a b} c} {a b} test dict-5.7 {dict remove command} -returnCodes error -body { dict remove } -result {wrong # args: should be "dict remove dictionary ?key ...?"} test dict-5.8 {dict remove command: canonicality is forced} { dict remove { a b c d } } {a b c d} test dict-5.9 {dict remove command: canonicality is forced} { dict remove {a b c d a e} } {a e c d} test dict-5.10 {dict remove command: canonicality forced by update} { dict remove { a b c d } c } {a b} test dict-5.11 {dict remove command: type check is mandatory} -body { dict remove { a b c d e } } -returnCodes error -result {missing value to go with key} test dict-5.12 {dict remove command: type check is mandatory} -body { dict remove { a b {}c d } } -returnCodes error -result {dict element in braces followed by "c" instead of space} test dict-5.13 {dict remove command: canonicality forcing doesn't leak} { set example { a b c d } list $example [dict remove $example] } {{ a b c d } {a b c d}} test dict-6.1 {dict keys command} {dict keys {a b}} a test dict-6.2 {dict keys command} {dict keys {c d}} c test dict-6.3 {dict keys command} {lsort [dict keys {a b c d}]} {a c} test dict-6.4 {dict keys command} {dict keys {a b c d} a} a test dict-6.5 {dict keys command} {dict keys {a b c d} c} c test dict-6.6 {dict keys command} {dict keys {a b c d} e} {} test dict-6.7 {dict keys command} {lsort [dict keys {a b c d ca da} c*]} {c ca} test dict-6.8 {dict keys command} -returnCodes error -body { dict keys } -result {wrong # args: should be "dict keys dictionary ?pattern?"} test dict-6.9 {dict keys command} -returnCodes error -body { dict keys {} a b } -result {wrong # args: should be "dict keys dictionary ?pattern?"} test dict-6.10 {dict keys command} -returnCodes error -body { dict keys a } -result {missing value to go with key} test dict-7.1 {dict values command} {dict values {a b}} b test dict-7.2 {dict values command} {dict values {c d}} d test dict-7.3 {dict values command} {lsort [dict values {a b c d}]} {b d} test dict-7.4 {dict values command} {dict values {a b c d} b} b test dict-7.5 {dict values command} {dict values {a b c d} d} d test dict-7.6 {dict values command} {dict values {a b c d} e} {} test dict-7.7 {dict values command} {lsort [dict values {a b c d ca da} d*]} {d da} test dict-7.8 {dict values command} -returnCodes error -body { dict values } -result {wrong # args: should be "dict values dictionary ?pattern?"} test dict-7.9 {dict values command} -returnCodes error -body { dict values {} a b } -result {wrong # args: should be "dict values dictionary ?pattern?"} test dict-7.10 {dict values command} -returnCodes error -body { dict values a } -result {missing value to go with key} test dict-8.1 {dict size command} {dict size {}} 0 test dict-8.2 {dict size command} {dict size {a b}} 1 test dict-8.3 {dict size command} {dict size {a b c d}} 2 test dict-8.4 {dict size command} -returnCodes error -body { dict size } -result {wrong # args: should be "dict size dictionary"} test dict-8.5 {dict size command} -returnCodes error -body { dict size a b } -result {wrong # args: should be "dict size dictionary"} test dict-8.6 {dict size command} -returnCodes error -body { dict size a } -result {missing value to go with key} test dict-9.1 {dict exists command} {dict exists {a b} a} 1 test dict-9.2 {dict exists command} {dict exists {a b} b} 0 test dict-9.3 {dict exists command} {dict exists {a {b c}} a b} 1 test dict-9.4 {dict exists command} {dict exists {a {b c}} a c} 0 test dict-9.5 {dict exists command} {dict exists {a {b c}} b c} 0 test dict-9.6 {dict exists command} {dict exists {a {b c d}} a c} 0 test dict-9.7 {dict exists command} -returnCodes error -body { dict exists } -result {wrong # args: should be "dict exists dictionary key ?key ...?"} test dict-9.8 {dict exists command} -returnCodes error -body { dict exists {} } -result {wrong # args: should be "dict exists dictionary key ?key ...?"} test dict-10.1 {dict info command} -body { # Actual string returned by this command is undefined; it is # intended for human consumption and not for use by scripts. dict info {} } -match glob -result * test dict-10.2 {dict info command} -returnCodes error -body { dict info } -result {wrong # args: should be "dict info dictionary"} test dict-10.3 {dict info command} -returnCodes error -body { dict info {} x } -result {wrong # args: should be "dict info dictionary"} test dict-10.4 {dict info command} -returnCodes error -body { dict info x } -result {missing value to go with key} test dict-11.1 {dict incr command: unshared value} -body { set dictv [dict create \ a [string index "=0=" 1] \ b [expr {1+2}] \ c [expr {wide(0x80000000)+1}]] dict incr dictv a } -cleanup { unset dictv } -result {a 1 b 3 c 2147483649} test dict-11.2 {dict incr command: unshared value} -body { set dictv [dict create \ a [string index "=0=" 1] \ b [expr {1+2}] \ c [expr {wide(0x80000000)+1}]] dict incr dictv b } -cleanup { unset dictv } -result {a 0 b 4 c 2147483649} test dict-11.3 {dict incr command: unshared value} -body { set dictv [dict create \ a [string index "=0=" 1] \ b [expr {1+2}] \ c [expr {wide(0x80000000)+1}]] dict incr dictv c } -cleanup { unset dictv } -result {a 0 b 3 c 2147483650} test dict-11.4 {dict incr command: shared value} -body { set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]] set sharing [dict values $dictv] dict incr dictv a } -cleanup { unset dictv sharing } -result {a 1 b 3 c 2147483649} test dict-11.5 {dict incr command: shared value} -body { set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]] set sharing [dict values $dictv] dict incr dictv b } -cleanup { unset dictv sharing } -result {a 0 b 4 c 2147483649} test dict-11.6 {dict incr command: shared value} -body { set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]] set sharing [dict values $dictv] dict incr dictv c } -cleanup { unset dictv sharing } -result {a 0 b 3 c 2147483650} test dict-11.7 {dict incr command: unknown values} -body { set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]] dict incr dictv d } -cleanup { unset dictv } -result {a 0 b 3 c 2147483649 d 1} test dict-11.8 {dict incr command} -body { set dictv {a 1} dict incr dictv a 2 } -cleanup { unset dictv } -result {a 3} test dict-11.9 {dict incr command} -returnCodes error -body { set dictv {a dummy} dict incr dictv a } -cleanup { unset dictv } -result {expected integer but got "dummy"} test dict-11.10 {dict incr command} -returnCodes error -body { set dictv {a 1} dict incr dictv a dummy } -cleanup { unset dictv } -result {expected integer but got "dummy"} test dict-11.11 {dict incr command} -setup { unset -nocomplain dictv } -body { dict incr dictv a } -cleanup { unset dictv } -result {a 1} test dict-11.12 {dict incr command} -returnCodes error -body { set dictv a dict incr dictv a } -cleanup { unset dictv } -result {missing value to go with key} test dict-11.13 {dict incr command} -returnCodes error -body { set dictv a dict incr dictv a a a } -cleanup { unset dictv } -result {wrong # args: should be "dict incr dictVarName key ?increment?"} test dict-11.14 {dict incr command} -returnCodes error -body { set dictv a dict incr dictv } -cleanup { unset dictv } -result {wrong # args: should be "dict incr dictVarName key ?increment?"} test dict-11.15 {dict incr command: write failure} -setup { unset -nocomplain dictVar } -body { set dictVar(block) {} dict incr dictVar a } -returnCodes error -cleanup { unset dictVar } -result {can't set "dictVar": variable is array} test dict-11.16 {dict incr command: compilation} { apply {{} { set v {a 0 b 0 c 0} dict incr v a dict incr v b 1 dict incr v c 2 dict incr v d 3 list [dict get $v a] [dict get $v b] [dict get $v c] [dict get $v d] }} } {1 1 2 3} test dict-11.17 {dict incr command: compilation} { apply {{} { set dictv {a 1} dict incr dictv a 2 }} } {a 3} test dict-12.1 {dict lappend command} -body { set dictv {a a} dict lappend dictv a } -cleanup { unset dictv } -result {a a} test dict-12.2 {dict lappend command} -body { set dictv {a a} set sharing [dict values $dictv] dict lappend dictv a b } -cleanup { unset dictv sharing } -result {a {a b}} test dict-12.3 {dict lappend command} -body { set dictv {a a} dict lappend dictv a b c } -cleanup { unset dictv } -result {a {a b c}} test dict-12.2.1 {dict lappend command} -body { set dictv [dict create a [string index =a= 1]] dict lappend dictv a b } -cleanup { unset dictv } -result {a {a b}} test dict-12.4 {dict lappend command} -body { set dictv {} dict lappend dictv a x y z } -cleanup { unset dictv } -result {a {x y z}} test dict-12.5 {dict lappend command} -body { unset -nocomplain dictv dict lappend dictv a b } -cleanup { unset dictv } -result {a b} test dict-12.6 {dict lappend command} -returnCodes error -body { set dictv a dict lappend dictv a a } -cleanup { unset dictv } -result {missing value to go with key} test dict-12.7 {dict lappend command} -returnCodes error -body { dict lappend } -result {wrong # args: should be "dict lappend dictVarName key ?value ...?"} test dict-12.8 {dict lappend command} -returnCodes error -body { dict lappend dictv } -result {wrong # args: should be "dict lappend dictVarName key ?value ...?"} test dict-12.9 {dict lappend command} -returnCodes error -body { set dictv [dict create a "\{"] dict lappend dictv a a } -cleanup { unset dictv } -result {unmatched open brace in list} test dict-12.10 {dict lappend command: write failure} -setup { unset -nocomplain dictVar } -body { set dictVar(block) {} dict lappend dictVar a x } -returnCodes error -cleanup { unset dictVar } -result {can't set "dictVar": variable is array} test dict-12.11 {compiled dict append: invalidate string rep - Bug 3079830} { apply {{} {set d {a 1 b 2 c 3}; dict lappend d b 22}} } {a 1 b {2 22} c 3} test dict-13.1 {dict append command} -body { set dictv {a a} dict append dictv a } -cleanup { unset dictv } -result {a a} test dict-13.2 {dict append command} -body { set dictv {a a} set sharing [dict values $dictv] dict append dictv a b } -cleanup { unset dictv sharing } -result {a ab} test dict-13.3 {dict append command} -body { set dictv {a a} dict append dictv a b c } -cleanup { unset dictv } -result {a abc} test dict-13.2.1 {dict append command} -body { set dictv [dict create a [string index =a= 1]] dict append dictv a b } -cleanup { unset dictv } -result {a ab} test dict-13.4 {dict append command} -body { set dictv {} dict append dictv a x y z } -cleanup { unset dictv } -result {a xyz} test dict-13.5 {dict append command} -body { unset -nocomplain dictv dict append dictv a b } -cleanup { unset dictv } -result {a b} test dict-13.6 {dict append command} -returnCodes error -body { set dictv a dict append dictv a a } -cleanup { unset dictv } -result {missing value to go with key} test dict-13.7 {dict append command} -returnCodes error -body { dict append } -result {wrong # args: should be "dict append dictVarName key ?value ...?"} test dict-13.8 {dict append command} -returnCodes error -body { dict append dictv } -result {wrong # args: should be "dict append dictVarName key ?value ...?"} test dict-13.9 {dict append command: write failure} -setup { unset -nocomplain dictVar } -body { set dictVar(block) {} dict append dictVar a x } -returnCodes error -cleanup { unset dictVar } -result {can't set "dictVar": variable is array} test dict-13.10 {compiled dict append: crash case} { apply {{} {dict append dictVar a o k}} } {a ok} test dict-13.11 {compiled dict append: invalidate string rep - Bug 3079830} { apply {{} {set d {a 1 b 2 c 3}; dict append d b 22}} } {a 1 b 222 c 3} test dict-14.1 {dict for command: syntax} -returnCodes error -body { dict for } -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"} test dict-14.2 {dict for command: syntax} -returnCodes error -body { dict for x } -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"} test dict-14.3 {dict for command: syntax} -returnCodes error -body { dict for x x } -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"} test dict-14.4 {dict for command: syntax} -returnCodes error -body { dict for x x x x } -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"} test dict-14.5 {dict for command: syntax} -returnCodes error -body { dict for x x x } -result {must have exactly two variable names} test dict-14.6 {dict for command: syntax} -returnCodes error -body { dict for {x x x} x x } -result {must have exactly two variable names} test dict-14.7 {dict for command: syntax} -returnCodes error -body { dict for "\{x" x x } -result {unmatched open brace in list} test dict-14.8 {dict for command} -body { # This test confirms that [dict keys], [dict values] and [dict for] # all traverse a dictionary in the same order. set dictv {a A b B c C} set keys {} set values {} dict for {k v} $dictv { lappend keys $k lappend values $v } set result [expr { $keys eq [dict keys $dictv] && $values eq [dict values $dictv] }] expr {$result ? "YES" : [list "NO" $dictv $keys $values]} } -cleanup { unset result keys values k v dictv } -result YES test dict-14.9 {dict for command} { dict for {k v} {} { error "unexpected execution of 'dict for' body" } } {} test dict-14.10 {dict for command: script results} -body { set times 0 dict for {k v} {a a b b} { incr times continue error "shouldn't get here" } return $times } -cleanup { unset times k v } -result 2 test dict-14.11 {dict for command: script results} -body { set times 0 dict for {k v} {a a b b} { incr times break error "shouldn't get here" } return $times } -cleanup { unset times k v } -result 1 test dict-14.12 {dict for command: script results} -body { set times 0 list [catch { dict for {k v} {a a b b} { incr times error test } } msg] $msg $times $::errorInfo } -cleanup { unset times k v msg } -result {1 test 1 {test while executing "error test" ("dict for" body line 3) invoked from within "dict for {k v} {a a b b} { incr times error test }"}} test dict-14.13 {dict for command: script results} { apply {{} { dict for {k v} {a b} { return ok,$k,$v error "skipped return completely" } error "return didn't go far enough" }} } ok,a,b test dict-14.14 {dict for command: handle representation loss} -body { set dictVar {a b c d e f g h} set keys {} set values {} dict for {k v} $dictVar { if {[llength $dictVar]} { lappend keys $k lappend values $v } } list [lsort $keys] [lsort $values] } -cleanup { unset dictVar keys values k v } -result {{a c e g} {b d f h}} test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup { unset -nocomplain accum array set accum {} } -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict for {k v} $dictVar { append accum($k) $v, } set result [lsort [array names accum]] lappend result : foreach k $result { catch {lappend result $accum($k)} } return $result } -cleanup { unset dictVar k v result accum } -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,} test dict-14.16 {dict for command in compilation context} { apply {{} { set res {x x x x x x} dict for {k v} {a 0 b 1 c 2 d 3 e 4 f 5} { lset res $v $k continue } return $res }} } {a b c d e f} test dict-14.17 {dict for command in compilation context} { # Bug 1379349 apply {{} { set d [dict create a 1] ;# Dict must be unshared! dict for {k v} $d { dict set d $k 0 ;# Any modification will do } return $d }} } {a 0} test dict-14.18 {dict for command in compilation context} { # Bug 1382528 apply {{} { dict for {k v} {} {} ;# Note empty dict catch { error foo } ;# Note compiled [catch] }} } 1 test dict-14.19 {dict for and invalid dicts: bug 1531184} -body { di[list]ct for {k v} x {} } -returnCodes 1 -result {missing value to go with key} test dict-14.20 {dict for stack space compilation: bug 1903325} { apply {{x y args} { dict for {a b} $x {} concat "c=$y,$args" }} {} 1 2 3 } {c=1,2 3} test dict-14.21 {compiled dict for and break} { apply {{} { dict for {a b} {c d e f} { lappend result $a,$b break } return $result }} } c,d test dict-14.22 {dict for and exception range depths: Bug 3614382} { apply {{} { dict for {a b} {c d} { dict for {e f} {g h} { return 5 } } }} } 5 # There's probably a lot more tests to add here. Really ought to use a # coverage tool for this job... test dict-15.1 {dict set command} -body { set dictVar {} dict set dictVar a x } -cleanup { unset dictVar } -result {a x} test dict-15.2 {dict set command} -body { set dictvar {a {}} dict set dictvar a b x } -cleanup { unset dictvar } -result {a {b x}} test dict-15.3 {dict set command} -body { set dictvar {a {b {}}} dict set dictvar a b c x } -cleanup { unset dictvar } -result {a {b {c x}}} test dict-15.4 {dict set command} -body { set dictVar {a y} dict set dictVar a x } -cleanup { unset dictVar } -result {a x} test dict-15.5 {dict set command} -body { set dictVar {a {b y}} dict set dictVar a b x } -cleanup { unset dictVar } -result {a {b x}} test dict-15.6 {dict set command} -body { set dictVar {a {b {c y}}} dict set dictVar a b c x } -cleanup { unset dictVar } -result {a {b {c x}}} test dict-15.7 {dict set command: path creation} -body { set dictVar {} dict set dictVar a b x } -cleanup { unset dictVar } -result {a {b x}} test dict-15.8 {dict set command: creates variables} -setup { unset -nocomplain dictVar } -body { dict set dictVar a x return $dictVar } -cleanup { unset dictVar } -result {a x} test dict-15.9 {dict set command: write failure} -setup { unset -nocomplain dictVar } -body { set dictVar(block) {} dict set dictVar a x } -returnCodes error -cleanup { unset dictVar } -result {can't set "dictVar": variable is array} test dict-15.10 {dict set command: syntax} -returnCodes error -body { dict set } -result {wrong # args: should be "dict set dictVarName key ?key ...? value"} test dict-15.11 {dict set command: syntax} -returnCodes error -body { dict set a } -result {wrong # args: should be "dict set dictVarName key ?key ...? value"} test dict-15.12 {dict set command: syntax} -returnCodes error -body { dict set a a } -result {wrong # args: should be "dict set dictVarName key ?key ...? value"} test dict-15.13 {dict set command} -returnCodes error -body { set dictVar a dict set dictVar b c } -cleanup { unset dictVar } -result {missing value to go with key} test dict-16.1 {dict unset command} -body { set dictVar {a b c d} dict unset dictVar a } -cleanup { unset dictVar } -result {c d} test dict-16.2 {dict unset command} -body { set dictVar {a b c d} dict unset dictVar c } -cleanup { unset dictVar } -result {a b} test dict-16.3 {dict unset command} -body { set dictVar {a b} dict unset dictVar c } -cleanup { unset dictVar } -result {a b} test dict-16.4 {dict unset command} -body { set dictVar {a {b c d e}} dict unset dictVar a b } -cleanup { unset dictVar } -result {a {d e}} test dict-16.5 {dict unset command} -returnCodes error -body { set dictVar a dict unset dictVar a } -cleanup { unset dictVar } -result {missing value to go with key} test dict-16.6 {dict unset command} -returnCodes error -body { set dictVar {a b} dict unset dictVar c d } -cleanup { unset dictVar } -result {key "c" not known in dictionary} test dict-16.7 {dict unset command} -setup { unset -nocomplain dictVar } -body { list [info exists dictVar] [dict unset dictVar a] [info exists dictVar] } -cleanup { unset dictVar } -result {0 {} 1} test dict-16.8 {dict unset command} -returnCodes error -body { dict unset dictVar } -result {wrong # args: should be "dict unset dictVarName key ?key ...?"} test dict-16.9 {dict unset command: write failure} -setup { unset -nocomplain dictVar } -body { set dictVar(block) {} dict unset dictVar a } -returnCodes error -cleanup { unset dictVar } -result {can't set "dictVar": variable is array} # Now test with an LVT present (i.e., the bytecoded version). test dict-16.10 {dict unset command} -body { apply {{} { set dictVar {a b c d} dict unset dictVar a }} } -result {c d} test dict-16.11 {dict unset command} -body { apply {{} { set dictVar {a b c d} dict unset dictVar c }} } -result {a b} test dict-16.12 {dict unset command} -body { apply {{} { set dictVar {a b} dict unset dictVar c }} } -result {a b} test dict-16.13 {dict unset command} -body { apply {{} { set dictVar {a {b c d e}} dict unset dictVar a b }} } -result {a {d e}} test dict-16.14 {dict unset command} -returnCodes error -body { apply {{} { set dictVar a dict unset dictVar a }} } -result {missing value to go with key} test dict-16.15 {dict unset command} -returnCodes error -body { apply {{} { set dictVar {a b} dict unset dictVar c d }} } -result {key "c" not known in dictionary} test dict-16.16 {dict unset command} -body { apply {{} {list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]}} } -result {0 {} 1} test dict-16.17 {dict unset command} -returnCodes error -body { apply {{} {dict unset dictVar}} } -result {wrong # args: should be "dict unset dictVarName key ?key ...?"} test dict-16.18 {dict unset command: write failure} -body { apply {{} { set dictVar(block) {} dict unset dictVar a }} } -returnCodes error -result {can't set "dictVar": variable is array} test dict-17.1 {dict filter command: key} -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict filter $dictVar key a2 } -cleanup { unset dictVar } -result {a2 b} test dict-17.2 {dict filter command: key} -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict size [dict filter $dictVar key *] } -cleanup { unset dictVar } -result 6 test dict-17.3 {dict filter command: key} -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict filter $dictVar key ??? } -cleanup { unset dictVar } -result {foo bar bar foo} test dict-17.4 {dict filter command: key - no patterns} { dict filter {a b c d} key } {} test dict-17.4.1 {dict filter command: key - many patterns} { dict filter {a1 a a2 b b1 c b2 d foo bar bar foo} key a? b? } {a1 a a2 b b1 c b2 d} test dict-17.5 {dict filter command: key - bad dict} -returnCodes error -body { dict filter {a b c} key } -result {missing value to go with key} test dict-17.6 {dict filter command: value} -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict filter $dictVar value c } -cleanup { unset dictVar } -result {b1 c} test dict-17.7 {dict filter command: value} -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict size [dict filter $dictVar value *] } -cleanup { unset dictVar } -result 6 test dict-17.8 {dict filter command: value} -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict filter $dictVar value ??? } -cleanup { unset dictVar } -result {foo bar bar foo} test dict-17.9 {dict filter command: value - no patterns} { dict filter {a b c d} value } {} test dict-17.9.1 {dict filter command: value - many patterns} { dict filter {a a1 b a2 c b1 foo bar bar foo d b2} value a? b? } {a a1 b a2 c b1 d b2} test dict-17.10 {dict filter command: value - bad dict} -body { dict filter {a b c} value a } -returnCodes error -result {missing value to go with key} test dict-17.11 {dict filter command: script} -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} set n 0 list [dict filter $dictVar script {k v} { incr n expr {[string length $k] == [string length $v]} }] $n } -cleanup { unset dictVar n k v } -result {{foo bar bar foo} 6} test dict-17.12 {dict filter command: script} -returnCodes error -body { dict filter {a b} script {k v} { concat $k $v } } -cleanup { unset k v } -result {expected boolean value but got "a b"} test dict-17.13 {dict filter command: script} -body { list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \ $::errorInfo } -cleanup { unset k v msg } -result {1 x {x while executing "error x" ("dict filter" script line 1) invoked from within "dict filter {a b} script {k v} {error x}"}} test dict-17.14 {dict filter command: script} -setup { set n 0 } -body { list [dict filter {a b c d} script {k v} { incr n break error boom! }] $n } -cleanup { unset n k v } -result {{} 1} test dict-17.15 {dict filter command: script} -setup { set n 0 } -body { list [dict filter {a b c d} script {k v} { incr n continue error boom! }] $n } -cleanup { unset n k v } -result {{} 2} test dict-17.16 {dict filter command: script} { apply {{} { dict filter {a b} script {k v} { return ok,$k,$v error "skipped return completely" } error "return didn't go far enough" }} } ok,a,b test dict-17.17 {dict filter command: script} -body { dict filter {a b} script {k k} {continue} return $k } -cleanup { unset k } -result b test dict-17.18 {dict filter command: script} -returnCodes error -body { dict filter {a b} script {k k} } -result {wrong # args: should be "dict filter dictionary script {keyVarName valueVarName} filterScript"} test dict-17.19 {dict filter command: script} -returnCodes error -body { dict filter {a b} script k {continue} } -result {must have exactly two variable names} test dict-17.20 {dict filter command: script} -returnCodes error -body { dict filter {a b} script "\{k v" {continue} } -result {unmatched open brace in list} test dict-17.21 {dict filter command} -returnCodes error -body { dict filter {a b} } -result {wrong # args: should be "dict filter dictionary filterType ?arg ...?"} test dict-17.22 {dict filter command} -returnCodes error -body { dict filter {a b} JUNK } -result {bad filterType "JUNK": must be key, script, or value} test dict-17.23 {dict filter command} -returnCodes error -body { dict filter a key * } -result {missing value to go with key} test dict-18.1 {dict-list relationship} -body { # Test that any internal conversion between list and dict does not change # the object set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y] dict values $l return $l } -cleanup { unset l } -result {1 2 3 4 5 6 7 8 9 0 q w e r t y} test dict-18.2 {dict-list relationship} -body { # Test that the dictionary is a valid list set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2] for {set t 0} {$t < 5} {incr t} { llength $d dict lappend d "abc def" "\}\{" dict append d "a\{b" "\}" dict incr d "c\}d" 1 } llength $d } -cleanup { unset d t } -result 6 test dict-18.3 {dict-list relationship} -body { set ld [list a b c d c e f g] list [string length $ld] [dict size $ld] [llength $ld] } -cleanup { unset ld } -result {15 3 8} test dict-18.4 {dict-list relationship} -body { set ld [list a b c d c e f g] list [llength $ld] [dict size $ld] [llength $ld] } -cleanup { unset ld } -result {8 3 8} # This is a test for a specific bug. # It shows a bad ref counter when running with memdebug on. test dict-19.1 {memory bug} { apply {{} { set successors [dict create x {c d}] dict set successors x a b dict get $successors x }} } [dict create c d a b] test dict-19.2 {dict: testing for leaks} -constraints memory -body { # This test is made to stress object reference management memtest { apply {{} { # A shared invalid dictionary set apa {a {}b c d} set bepa $apa catch {dict replace $apa e f} catch {dict remove $apa c d} catch {dict incr apa a 5} catch {dict lappend apa a 5} catch {dict append apa a 5} catch {dict set apa a 5} catch {dict unset apa a} # A shared valid dictionary, invalid incr set apa {a b c d} set bepa $apa catch {dict incr bepa a 5} # An error during write to an unshared object, incr set apa {a 1 b 2} set bepa [lrange $apa 0 end] trace add variable bepa write {error hej} catch {dict incr bepa a 5} trace remove variable bepa write {error hej} unset bepa # An error during write to a shared object, incr set apa {a 1 b 2} set bepa $apa trace add variable bepa write {error hej} catch {dict incr bepa a 5} trace remove variable bepa write {error hej} unset bepa # A shared valid dictionary, invalid lappend set apa [list a {{}b} c d] set bepa $apa catch {dict lappend bepa a 5} # An error during write to an unshared object, lappend set apa {a 1 b 2} set bepa [lrange $apa 0 end] trace add variable bepa write {error hej} catch {dict lappend bepa a 5} trace remove variable bepa write {error hej} unset bepa # An error during write to a shared object, lappend set apa {a 1 b 2} set bepa $apa trace add variable bepa write {error hej} catch {dict lappend bepa a 5} trace remove variable bepa write {error hej} unset bepa # An error during write to an unshared object, append set apa {a 1 b 2} set bepa [lrange $apa 0 end] trace add variable bepa write {error hej} catch {dict append bepa a 5} trace remove variable bepa write {error hej} unset bepa # An error during write to a shared object, append set apa {a 1 b 2} set bepa $apa trace add variable bepa write {error hej} catch {dict append bepa a 5} trace remove variable bepa write {error hej} unset bepa # An error during write to an unshared object, set set apa {a 1 b 2} set bepa [lrange $apa 0 end] trace add variable bepa write {error hej} catch {dict set bepa a 5} trace remove variable bepa write {error hej} unset bepa # An error during write to a shared object, set set apa {a 1 b 2} set bepa $apa trace add variable bepa write {error hej} catch {dict set bepa a 5} trace remove variable bepa write {error hej} unset bepa # An error during write to an unshared object, unset set apa {a 1 b 2} set bepa [lrange $apa 0 end] trace add variable bepa write {error hej} catch {dict unset bepa a} trace remove variable bepa write {error hej} unset bepa # An error during write to a shared object, unset set apa {a 1 b 2} set bepa $apa trace add variable bepa write {error hej} catch {dict unset bepa a} trace remove variable bepa write {error hej} unset bepa }} } } -result 0 test dict-19.3 {testing for leaks - Bug 2874678} -constraints memory -body { set d aDictVar; # Force interpreted [dict incr] memtest { dict incr $d aKey 0 unset $d } } -cleanup { unset d } -result 0 test dict-20.1 {dict merge command} { dict merge } {} test dict-20.2 {dict merge command} { dict merge {a b c d e f} } {a b c d e f} test dict-20.3 {dict merge command} -body { dict merge {a b c d e} } -result {missing value to go with key} -returnCodes error test dict-20.4 {dict merge command} { dict merge {a b c d} {e f g h} } {a b c d e f g h} test dict-20.5 {dict merge command} -body { dict merge {a b c d e} {e f g h} } -result {missing value to go with key} -returnCodes error test dict-20.6 {dict merge command} -body { dict merge {a b c d} {e f g h i} } -result {missing value to go with key} -returnCodes error test dict-20.7 {dict merge command} { dict merge {a b c d e f} {e x g h} } {a b c d e x g h} test dict-20.8 {dict merge command} { dict merge {a b c d} {a x c y} } {a x c y} test dict-20.9 {dict merge command} { dict merge {a b c d} {c y a x} } {a x c y} test dict-20.10 {dict merge command} { dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -} } {a - c d e f 1 - 3 4} test dict-20.11 {dict merge command} { apply {{} {dict merge}} } {} test dict-20.12 {dict merge command} { apply {{} {dict merge {a b c d e f}}} } {a b c d e f} test dict-20.13 {dict merge command} -body { apply {{} {dict merge {a b c d e}}} } -result {missing value to go with key} -returnCodes error test dict-20.14 {dict merge command} { apply {{} {dict merge {a b c d} {e f g h}}} } {a b c d e f g h} test dict-20.15 {dict merge command} -body { apply {{} {dict merge {a b c d e} {e f g h}}} } -result {missing value to go with key} -returnCodes error test dict-20.16 {dict merge command} -body { apply {{} {dict merge {a b c d} {e f g h i}}} } -result {missing value to go with key} -returnCodes error test dict-20.17 {dict merge command} { apply {{} {dict merge {a b c d e f} {e x g h}}} } {a b c d e x g h} test dict-20.18 {dict merge command} { apply {{} {dict merge {a b c d} {a x c y}}} } {a x c y} test dict-20.19 {dict merge command} { apply {{} {dict merge {a b c d} {c y a x}}} } {a x c y} test dict-20.20 {dict merge command} { apply {{} {dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}}} } {a - c d e f 1 - 3 4} test dict-20.21 {dict merge command: canonicality not forced} { dict merge { a b c d } } { a b c d } test dict-20.22 {dict merge command: canonicality not forced} { dict merge { a b c d } {} } { a b c d } test dict-20.23 {dict merge command: canonicality forced by update} { dict merge { a b c d } {a b} } {a b c d} test dict-20.24 {dict merge command: type check is mandatory} -body { dict merge { a b c d e } } -returnCodes error -result {missing value to go with key} test dict-20.25 {dict merge command: type check is mandatory} -body { dict merge { a b {}c d } } -returnCodes error -result {dict element in braces followed by "c" instead of space} test dict-21.1 {dict update command} -returnCodes 1 -body { dict update } -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"} test dict-21.2 {dict update command} -returnCodes 1 -body { dict update v } -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"} test dict-21.3 {dict update command} -returnCodes 1 -body { dict update v k } -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"} test dict-21.4 {dict update command} -returnCodes 1 -body { dict update v k v } -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"} test dict-21.5 {dict update command} -body { set a {b c} set result {} set bb {} dict update a b bb { lappend result $a $bb } lappend result $a } -cleanup { unset a result bb } -result {{b c} c {b c}} test dict-21.6 {dict update command} -body { set a {b c} set result {} set bb {} dict update a b bb { lappend result $a $bb [set bb d] } lappend result $a } -cleanup { unset a result bb } -result {{b c} c d {b d}} test dict-21.7 {dict update command} -body { set a {b c} set result {} set bb {} dict update a b bb { lappend result $a $bb [unset bb] } lappend result $a } -cleanup { unset a result } -result {{b c} c {} {}} test dict-21.8 {dict update command} -body { set a {b c d e} dict update a b v1 d v2 { lassign "$v1 $v2" v2 v1 } return $a } -cleanup { unset a v1 v2 } -result {b e d c} test dict-21.9 {dict update command} -body { set a {b c d e} dict update a b v1 d v2 {unset a} info exist a } -cleanup { unset v1 v2 } -result 0 test dict-21.10 {dict update command} -body { set a {b {c d}} dict update a b v1 { dict update v1 c v2 { set v2 foo } } return $a } -cleanup { unset a v1 v2 } -result {b {c foo}} test dict-21.11 {dict update command} -body { set a {b c d e} dict update a b v1 d v2 { dict set a f g } return $a } -cleanup { unset a v1 v2 } -result {b c d e f g} test dict-21.12 {dict update command} -body { set a {b c d e} dict update a b v1 d v2 f v3 { set v3 g } return $a } -cleanup { unset a v1 v2 v3 } -result {b c d e f g} test dict-21.13 {dict update command: compilation} { apply {d { while 1 { dict update d a alpha b beta { set beta $alpha unset alpha break } } return $d }} {a 1 c 2} } {c 2 b 1} test dict-21.14 {dict update command: compilation} { apply {x { set indices {2 3} trace add variable aa write "string length \$indices ;#" dict update x k aa l bb {} }} {k 1 l 2} } {} test dict-21.15 {dict update command: compilation} { apply {x { set indices {2 3} trace add variable aa read "string length \$indices ;#" dict update x k aa l bb {} }} {k 1 l 2} } {} test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} -body { set foo {a {b {c {d {e 1}}}}} dict update foo a t { dict update t b t { dict update t c t { dict update t d t { dict incr t e } } } } string range [append foo OK] end-1 end } -cleanup { unset foo t } -result OK test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} { apply {{} { set foo {a {b {c {d {e 1}}}}} dict update foo a t { dict update t b t { dict update t c t { dict update t d t { dict incr t e } } } } string range [append foo OK] end-1 end }} } OK test dict-22.1 {dict with command} -body { dict with } -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"} test dict-22.2 {dict with command} -body { dict with v } -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"} test dict-22.3 {dict with command} -body { unset -nocomplain v dict with v {error "in body"} } -returnCodes 1 -result {can't read "v": no such variable} test dict-22.4 {dict with command} -body { set a {b c d e} unset -nocomplain b d set result [list [info exist b] [info exist d]] dict with a { lappend result [info exist b] [info exist d] $b $d } return $result } -cleanup { unset a b d result } -result {0 0 1 1 c e} test dict-22.5 {dict with command} -body { set a {b c d e} dict with a { lassign "$b $d" d b } return $a } -cleanup { unset a b d } -result {b e d c} test dict-22.6 {dict with command} -body { set a {b c d e} dict with a { unset b # This *won't* go into the dict... set f g } return $a } -cleanup { unset a d f } -result {d e} test dict-22.7 {dict with command} -body { set a {b c d e} dict with a { dict unset a b } return $a } -cleanup { unset a } -result {d e b c} test dict-22.8 {dict with command} -body { set a [dict create b c] dict with a { set b $a } return $a } -cleanup { unset a b } -result {b {b c}} test dict-22.9 {dict with command} -body { set a {b {c d}} dict with a b { set c $c$c } return $a } -cleanup { unset a c } -result {b {c dd}} test dict-22.10 {dict with command: result handling tricky case} -body { set a {b {c d}} foreach i {0 1} { if {$i} break dict with a b { set a {} # We're checking to see if we lose this break break } } list $i $a } -cleanup { unset a i c } -result {0 {}} test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} -body { set foo {t {t {t {inner 1}}}} dict with foo { dict with t { dict with t { dict with t { incr inner } } } } string range [append foo OK] end-1 end } -cleanup { unset foo t inner } -result OK test dict-22.12 {dict with: compiled} { apply {{} { set d {a 1 b 2} list [dict with d { set a $b unset b dict set d c 3 list ok }] $d }} } {ok {a 2 c 3}} test dict-22.13 {dict with: compiled} { apply {i { set d($i) {a 1 b 2} list [dict with d($i) { set a $b unset b dict set d($i) c 3 list ok }] [array get d] }} e } {ok {e {a 2 c 3}}} test dict-22.14 {dict with: compiled} { apply {{} { set d {a 1 b 2} foreach x {1 2 3} { dict with d { incr a $b if {$x == 2} break } unset a b } list $a $b $x $d }} } {5 2 2 {a 5 b 2}} test dict-22.15 {dict with: compiled} { apply {i { set d($i) {a 1 b 2} foreach x {1 2 3} { dict with d($i) { incr a $b if {$x == 2} break } unset a b } list $a $b $x [array get d] }} e } {5 2 2 {e {a 5 b 2}}} test dict-22.16 {dict with: compiled} { apply {{} { set d {p {q {a 1 b 2}}} dict with d p q { set a $b.$a } return $d }} } {p {q {a 2.1 b 2}}} test dict-22.17 {dict with: compiled} { apply {i { set d($i) {p {q {a 1 b 2}}} dict with d($i) p q { set a $b.$a } array get d }} e } {e {p {q {a 2.1 b 2}}}} test dict-22.18 {dict with: compiled} { set ::d {a 1 b 2} apply {{} { dict with ::d { set a $b.$a } return $::d }} } {a 2.1 b 2} test dict-22.19 {dict with: compiled} { set ::d {p {q {r {a 1 b 2}}}} apply {{} { dict with ::d p q r { set a $b.$a } return $::d }} } {p {q {r {a 2.1 b 2}}}} test dict-22.20 {dict with: compiled} { apply {d { dict with d { } return $a,$b }} {a 1 b 2} } 1,2 test dict-22.21 {dict with: compiled} { apply {d { dict with d p q { } return $a,$b }} {p {q {a 1 b 2}}} } 1,2 test dict-22.22 {dict with: compiled} { set ::d {a 1 b 2} apply {{} { dict with ::d { } return $a,$b }} } 1,2 test dict-22.23 {dict with: compiled} { set ::d {p {q {a 1 b 2}}} apply {{} { dict with ::d p q { } return $a,$b }} } 1,2 proc linenumber {} { dict get [info frame -1] line } test dict-23.1 {dict compilation crash: Bug 3487626} { apply {{} {apply {n { set e {} set k {} dict for {a b} {c {d {e {f g}}}} { ::tcl::dict::for {h i} $b { dict update i e j { ::tcl::dict::update j f k { return [expr {$n - [linenumber]}] } } } } }} [linenumber]}} } 5 test dict-23.2 {dict compilation crash: Bug 3487626} { # Something isn't quite right in line number and continuation line # tracking; at time of writing, this test produces 7, not 5, which # indicates that the extra newlines in the non-script argument are # confusing things. apply {{} {apply {n { set e {} set k {} dict for {a { b }} {c {d {e {f g}}}} { ::tcl::dict::for {h { i }} ${ b } { dict update { i } e { j } { ::tcl::dict::update { j } f k { return [expr {$n - [linenumber]}] } } } } }} [linenumber]}} } 5 rename linenumber {} test dict-24.1 {dict map command: syntax} -returnCodes error -body { dict map } -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"} test dict-24.2 {dict map command: syntax} -returnCodes error -body { dict map x } -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"} test dict-24.3 {dict map command: syntax} -returnCodes error -body { dict map x x } -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"} test dict-24.4 {dict map command: syntax} -returnCodes error -body { dict map x x x x } -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"} test dict-24.5 {dict map command: syntax} -returnCodes error -body { dict map x x x } -result {must have exactly two variable names} test dict-24.6 {dict map command: syntax} -returnCodes error -body { dict map {x x x} x x } -result {must have exactly two variable names} test dict-24.7 {dict map command: syntax} -returnCodes error -body { dict map "\{x" x x } -result {unmatched open brace in list} test dict-24.8 {dict map command} -setup { set values {} set keys {} } -body { # This test confirms that [dict keys], [dict values] and [dict map] # all traverse a dictionary in the same order. set dictv {a A b B c C} dict map {k v} $dictv { lappend keys $k lappend values $v } set result [expr { $keys eq [dict keys $dictv] && $values eq [dict values $dictv] }] expr {$result ? "YES" : [list "NO" $dictv $keys $values]} } -cleanup { unset result keys values k v dictv } -result YES test dict-24.9 {dict map command} { dict map {k v} {} { error "unexpected execution of 'dict map' body" } } {} test dict-24.10 {dict map command: script results} -body { set times 0 dict map {k v} {a a b b} { incr times continue error "shouldn't get here" } return $times } -cleanup { unset times k v } -result 2 test dict-24.11 {dict map command: script results} -body { set times 0 dict map {k v} {a a b b} { incr times break error "shouldn't get here" } return $times } -cleanup { unset times k v } -result 1 test dict-24.12 {dict map command: script results} -body { set times 0 list [catch { dict map {k v} {a a b b} { incr times error test } } msg] $msg $times $::errorInfo } -cleanup { unset times k v msg } -result {1 test 1 {test while executing "error test" ("dict map" body line 3) invoked from within "dict map {k v} {a a b b} { incr times error test }"}} test dict-24.13 {dict map command: script results} { apply {{} { dict map {k v} {a b} { return ok,$k,$v error "skipped return completely" } error "return didn't go far enough" }} } ok,a,b test dict-24.14 {dict map command: handle representation loss} -setup { set keys {} set values {} } -body { set dictVar {a b c d e f g h} list [dict size [dict map {k v} $dictVar { if {[llength $dictVar]} { lappend keys $k lappend values $v return -level 0 $k } }]] [lsort $keys] [lsort $values] } -cleanup { unset dictVar keys values k v } -result {4 {a c e g} {b d f h}} test dict-24.14a {dict map command: handle representation loss} -body { apply {{} { set dictVar {a b c d e f g h} list [dict size [dict map {k v} $dictVar { if {[llength $dictVar]} { lappend keys $k lappend values $v return -level 0 $k } }]] [lsort $keys] [lsort $values] }} } -result {4 {a c e g} {b d f h}} test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup { unset -nocomplain accum array set accum {} } -body { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict map {k v} $dictVar { append accum($k) $v, } set result [lsort [array names accum]] lappend result : foreach k $result { catch {lappend result $accum($k)} } return $result } -cleanup { unset dictVar k v result accum } -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,} test dict-24.16 {dict map command in compilation context} { apply {{} { set res {x x x x x x} dict map {k v} {a 0 b 1 c 2 d 3 e 4 f 5} { lset res $v $k continue } return $res }} } {a b c d e f} test dict-24.17 {dict map command in compilation context} { # Bug 1379349 (dict for) apply {{} { set d [dict create a 1] ;# Dict must be unshared! dict map {k v} $d { dict set d $k 0 ;# Any modification will do } return $d }} } {a 0} test dict-24.17a {dict map command in compilation context} { # Bug 1379349 (dict for) apply {{} { set d [dict create a 1] ;# Dict must be unshared! dict map {k v} $d { dict set d $k 0 ;# Any modification will do } }} } {a {a 0}} test dict-24.18 {dict map command in compilation context} { # Bug 1382528 (dict for) apply {{} { dict map {k v} {} {} ;# Note empty dict catch { error foo } ;# Note compiled [catch] }} } 1 test dict-24.19 {dict map and invalid dicts: 'dict for' bug 1531184} -body { di[list]ct map {k v} x {} } -returnCodes 1 -result {missing value to go with key} test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} { apply {{x y args} { dict map {a b} $x {} concat "c=$y,$args" }} {} 1 2 3 } {c=1,2 3} proc linenumber {} { dict get [info frame -1] line } test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} { apply {{} {apply {n { set e {} set k {} dict map {a b} {c {d {e {f g}}}} { ::tcl::dict::map {h i} $b { dict update i e j { ::tcl::dict::update j f k { return [expr {$n - [linenumber]}] } } } } }} [linenumber]}} } 5 test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} { apply {{} {apply {n { set e {} set k {} dict map {a { b }} {c {d {e {f g}}}} { ::tcl::dict::map {h { i }} ${ b } { dict update { i } e { j } { ::tcl::dict::update { j } f k { return [expr {$n - [linenumber]}] } } } } }} [linenumber]}} } 5 test dict-23.3 {CompileWord OBOE} { # segfault when buggy apply {{} {tcl::dict::lappend foo bar \ [format baz]}} } {bar baz} test dict-23.4 {CompileWord OBOE} { apply {n { dict set foo {*}{ } [return [incr n -[linenumber]]] val }} [linenumber] } 1 test dict-23.5 {CompileWord OBOE} { # segfault when buggy apply {{} {tcl::dict::incr foo \ [format bar]}} } {bar 1} test dict-23.6 {CompileWord OBOE} { apply {n { dict get {a b} {*}{ } [return [incr n -[linenumber]]] }} [linenumber] } 1 test dict-23.7 {CompileWord OBOE} { apply {n { dict for {a b} [return [incr n -[linenumber]]] {*}{ } {} }} [linenumber] } 2 test dict-23.8 {CompileWord OBOE} { apply {n { dict update foo {*}{ } [return [incr n -[linenumber]]] x {} }} [linenumber] } 1 test dict-23.9 {CompileWord OBOE} { apply {n { dict exists {} {*}{ } [return [incr n -[linenumber]]] }} [linenumber] } 1 test dict-23.10 {CompileWord OBOE} { apply {n { dict with foo {*}{ } [return [incr n -[linenumber]]] {} }} [linenumber] } 1 test dict-23.11 {CompileWord OBOE} { apply {n { dict with ::foo {*}{ } [return [incr n -[linenumber]]] {} }} [linenumber] } 1 test dict-23.12 {CompileWord OBOE} { apply {n { dict with {*}{ } [return [incr n -[linenumber]]] {} }} [linenumber] } 1 test dict-23.13 {CompileWord OBOE} { apply {n { dict with {*}{ } [return [incr n -[linenumber]]] {bar} }} [linenumber] } 1 test dict-23.14 {CompileWord OBOE} { apply {n { dict with foo {*}{ } [return [incr n -[linenumber]]] {bar} }} [linenumber] } 1 rename linenumber {} test dict-24.22 {dict map results (non-compiled)} { dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] { return -level 0 "$k,$v" } } {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}} test dict-24.23 {dict map results (compiled)} { apply {{} { dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] { return -level 0 "$k,$v" } }} } {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}} test dict-24.23a {dict map results (compiled)} { apply {{list} { dict map {k v} [dict map {k v} $list { list $v $k }] { return -level 0 "$k,$v" } }} {a 1 b 2 c 3 d 4} } {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}} test dict-24.24 {dict map with huge dict (non-compiled)} { tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat 100000 x] x] { expr { $k * $v } }] } 166666666600000 test dict-24.25 {dict map with huge dict (compiled)} { apply {{n} { tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat $n y] y] { expr { $k * $v } }] }} 100000 } 166666666600000 test dict-25.1 {compiled dict update with low-refcount values [Bug d553228d9f]} { # Test crashes on failure apply {{} { lassign {} item dict update item item item two two {} }} } {} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/dstring.test0000644000175000017500000003665214554262142015373 0ustar sergeisergei# Commands covered: none # # This file contains a collection of tests for Tcl's dynamic string library # procedures. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testdstring [llength [info commands testdstring]] if {[testConstraint testdstring]} { testdstring free } test dstring-1.1 {appending and retrieving} -constraints testdstring -setup { testdstring free } -body { testdstring append "abc" -1 list [testdstring get] [testdstring length] } -cleanup { testdstring free } -result {abc 3} test dstring-1.2 {appending and retrieving} -constraints testdstring -setup { testdstring free } -body { testdstring append "abc" -1 testdstring append " xyzzy" 3 testdstring append " 12345" -1 list [testdstring get] [testdstring length] } -cleanup { testdstring free } -result {{abc xy 12345} 12} test dstring-1.3 {appending and retrieving} -constraints testdstring -setup { testdstring free } -body { foreach l {a b c d e f g h i j k l m n o p} { testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 } list [testdstring get] [testdstring length] } -cleanup { testdstring free } -result {{aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp } 352} test dstring-2.1 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring element "abc" testdstring element "d e f" list [testdstring get] [testdstring length] } -cleanup { testdstring free } -result {{abc {d e f}} 11} test dstring-2.2 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring element "x" testdstring element "\{" testdstring element "ab\}" testdstring get } -cleanup { testdstring free } -result {x \{ ab\}} test dstring-2.3 {appending list elements} -constraints testdstring -setup { testdstring free } -body { foreach l {a b c d e f g h i j k l m n o p} { testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l } testdstring get } -cleanup { testdstring free } -result {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp} test dstring-2.4 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append "a\{" -1 testdstring element abc testdstring append " \{" -1 testdstring element xyzzy testdstring get } -cleanup { testdstring free } -result "a{ abc {xyzzy" test dstring-2.5 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append " \{" -1 testdstring element abc testdstring get } -cleanup { testdstring free } -result " {abc" test dstring-2.6 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append " " -1 testdstring element abc testdstring get } -cleanup { testdstring free } -result { abc} test dstring-2.7 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append "\\ " -1 testdstring element abc testdstring get } -cleanup { testdstring free } -result "\\ abc" test dstring-2.8 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append "x " -1 testdstring element abc testdstring get } -cleanup { testdstring free } -result {x abc} test dstring-2.9 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring element # testdstring get } -cleanup { testdstring free } -result {{#}} test dstring-2.10 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append " " -1 testdstring element # testdstring get } -cleanup { testdstring free } -result { {#}} test dstring-2.11 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append \t -1 testdstring element # testdstring get } -cleanup { testdstring free } -result \t{#} test dstring-2.12 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append x -1 testdstring element # testdstring get } -cleanup { testdstring free } -result {x #} test dstring-2.13 {appending list elements} -constraints testdstring -setup { testdstring free } -body { # This test checks the sophistication in Tcl_DStringAppendElement's # decision about whether #-quoting can be disabled. testdstring append "x " -1 testdstring element # testdstring get } -cleanup { testdstring free } -result {x #} test dstring-2.14 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append " " -1 testdstring element # testdstring get } -cleanup { testdstring free } -result { {#}} test dstring-2.15 {appending list elements} -constraints testdstring -setup { testdstring free } -body { # This test checks the sophistication in Tcl_DStringAppendElement's # decision about whether #-quoting can be disabled. testdstring append "x " -1 testdstring element # testdstring get } -cleanup { testdstring free } -result {x #} test dstring-2.16 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup { testdstring free } -body { testdstring element "\\\n"; # Will setfault testdstring get } -cleanup { testdstring free } -result \\\\\\n test dstring-2.17 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup { testdstring free } -body { testdstring element "\\\{"; # Will setfault testdstring get } -cleanup { testdstring free } -result [list [list \{]] test dstring-2.18 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup { testdstring free } -body { testdstring element "\\\}"; # Will setfault testdstring get } -cleanup { testdstring free } -result [list [list \}]] test dstring-2.19 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup { testdstring free } -body { testdstring element "\\\\"; # Will setfault testdstring get } -cleanup { testdstring free } -result [list [list \\]] test dstring-3.1 {nested sublists} -constraints testdstring -setup { testdstring free } -body { testdstring start testdstring element foo testdstring element bar testdstring end testdstring element another testdstring get } -cleanup { testdstring free } -result {{foo bar} another} test dstring-3.2 {nested sublists} -constraints testdstring -setup { testdstring free } -body { testdstring start testdstring start testdstring element abc testdstring element def testdstring end testdstring end testdstring element ghi testdstring get } -cleanup { testdstring free } -result {{{abc def}} ghi} test dstring-3.3 {nested sublists} -constraints testdstring -setup { testdstring free } -body { testdstring start testdstring start testdstring start testdstring element foo testdstring element foo2 testdstring end testdstring end testdstring element foo3 testdstring end testdstring element foo4 testdstring get } -cleanup { testdstring free } -result {{{{foo foo2}} foo3} foo4} test dstring-3.4 {nested sublists} -constraints testdstring -setup { testdstring free } -body { testdstring element before testdstring start testdstring element during testdstring element more testdstring end testdstring element last testdstring get } -cleanup { testdstring free } -result {before {during more} last} test dstring-3.5 {nested sublists} -constraints testdstring -setup { testdstring free } -body { testdstring element "\{" testdstring start testdstring element first testdstring element second testdstring end testdstring get } -cleanup { testdstring free } -result {\{ {first second}} test dstring-3.6 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append x -1 testdstring start testdstring element # testdstring end testdstring get } -cleanup { testdstring free } -result {x {{#}}} test dstring-3.7 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append x -1 testdstring start testdstring append " " -1 testdstring element # testdstring end testdstring get } -cleanup { testdstring free } -result {x { {#}}} test dstring-3.8 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append x -1 testdstring start testdstring append \t -1 testdstring element # testdstring end testdstring get } -cleanup { testdstring free } -result "x {\t{#}}" test dstring-3.9 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append x -1 testdstring start testdstring append x -1 testdstring element # testdstring end testdstring get } -cleanup { testdstring free } -result {x {x #}} test dstring-3.10 {appending list elements} -constraints testdstring -setup { testdstring free } -body { # This test checks the sophistication in Tcl_DStringAppendElement's # decision about whether #-quoting can be disabled. testdstring append x -1 testdstring start testdstring append "x " -1 testdstring element # testdstring end testdstring get } -cleanup { testdstring free } -result {x {x #}} test dstring-3.11 {appending list elements} -constraints testdstring -setup { testdstring free } -body { testdstring append x -1 testdstring start testdstring append " " -1 testdstring element # testdstring end testdstring get } -cleanup { testdstring free } -result {x { {#}}} test dstring-3.12 {appending list elements} -constraints testdstring -setup { testdstring free } -body { # This test checks the sophistication in Tcl_DStringAppendElement's # decision about whether #-quoting can be disabled. testdstring append x -1 testdstring start testdstring append "x " -1 testdstring element # testdstring end testdstring get } -cleanup { testdstring free } -result {x {x #}} test dstring-4.1 {truncation} -constraints testdstring -setup { testdstring free } -body { testdstring append "abcdefg" -1 testdstring trunc 3 list [testdstring get] [testdstring length] } -cleanup { testdstring free } -result {abc 3} test dstring-4.2 {truncation} -constraints testdstring -setup { testdstring free } -body { testdstring append "xyzzy" -1 testdstring trunc 0 list [testdstring get] [testdstring length] } -cleanup { testdstring free } -result {{} 0} test dstring-4.3 {truncation} -constraints testdstring -setup { testdstring free } -body { testdstring append "xwvut" -1 # Pass a negative length to Tcl_DStringSetLength(); # if not caught, causing '\0' to be written out-of-bounds, # try corrupting dsPtr->length which begins # 2*sizeof(int) bytes before dsPtr->staticSpace[], # so that the result is -256 (on little endian systems) # rather than e.g. -8. testdstring trunc -8 list [testdstring get] [testdstring length] } -cleanup { testdstring free } -result {{} 0} test dstring-5.1 {copying to result} -constraints testdstring -setup { testdstring free } -body { testdstring append xyz -1 testdstring result } -cleanup { testdstring free } -result xyz test dstring-5.2 {copying to result} -constraints testdstring -setup { testdstring free unset -nocomplain a } -body { foreach l {a b c d e f g h i j k l m n o p} { testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 } set a [testdstring result] testdstring append abc -1 list $a [testdstring get] } -cleanup { testdstring free } -result {{aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp } abc} test dstring-6.1 {Tcl_DStringGetResult} -constraints testdstring -setup { testdstring free } -body { list [testdstring gresult staticsmall] [testdstring get] } -cleanup { testdstring free } -result {{} short} test dstring-6.2 {Tcl_DStringGetResult} -constraints testdstring -setup { testdstring free } -body { foreach l {a b c d e f g h i j k l m n o p} { testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 } list [testdstring gresult staticsmall] [testdstring get] } -cleanup { testdstring free } -result {{} short} test dstring-6.3 {Tcl_DStringGetResult} -constraints testdstring -body { set result {} lappend result [testdstring gresult staticlarge] testdstring append x 1 lappend result [testdstring get] } -cleanup { testdstring free } -result {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9 second0 second1 second2 second3 second4 second5 second6 second7 second8 second9 third0 third1 third2 third3 third4 third5 third6 third7 third8 third9 fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9 fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9 sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9 seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9 x}} test dstring-6.4 {Tcl_DStringGetResult} -constraints testdstring -body { set result {} lappend result [testdstring gresult free] testdstring append y 1 lappend result [testdstring get] } -cleanup { testdstring free } -result {{} {This is a malloc-ed stringy}} test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body { set result {} lappend result [testdstring gresult special] testdstring append z 1 lappend result [testdstring get] } -cleanup { testdstring free } -result {{} {This is a specially-allocated stringz}} # cleanup if {[testConstraint testdstring]} { testdstring free } ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/encoding.test0000644000175000017500000006330514554262142015502 0ustar sergeisergei# This file contains a collection of tests for tclEncoding.c # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } namespace eval ::tcl::test::encoding { variable x catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] } proc toutf {args} { variable x lappend x "toutf $args" } proc fromutf {args} { variable x lappend x "fromutf $args" } proc runtests {} { variable x # Some tests require the testencoding command testConstraint testencoding [llength [info commands testencoding]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint teststringbytes [llength [info commands teststringbytes]] testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}] testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] testConstraint exec [llength [info commands exec]] testConstraint testgetdefenc [llength [info commands testgetdefenc]] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup { set old [encoding system] } -constraints {testencoding} -body { testencoding create foo [namespace origin toutf] [namespace origin fromutf] encoding system foo set x {} encoding convertto abcd return $x } -cleanup { encoding system $old testencoding delete foo } -result {{fromutf }} test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} { testencoding create foo [namespace origin toutf] [namespace origin fromutf] set x {} encoding convertto foo abcd testencoding delete foo return $x } {{fromutf }} test encoding-1.3 {Tcl_GetEncoding: load encoding} { list [encoding convertto jis0208 \u4E4E] \ [encoding convertfrom jis0208 8C] } "8C \u4E4E" test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} { encoding convertto jis0208 \u4E4E } {8C} test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup { set system [encoding system] set path [encoding dirs] } -constraints {testencoding} -body { encoding system shiftjis ;# incr ref count encoding dirs [list [pwd]] set x [encoding convertto shiftjis \u4E4E] ;# old one found encoding system iso8859-1 llength shiftjis ;# Shimmer away any cache of Tcl_Encoding lappend x [catch {encoding convertto shiftjis \u4E4E} msg] $msg } -cleanup { encoding system iso8859-1 encoding dirs $path encoding system $system } -result "\x8C\xC1 1 {unknown encoding \"shiftjis\"}" test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup { set old [encoding system] } -body { encoding system shiftjis encoding system } -cleanup { encoding system $old } -result {shiftjis} test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup { set old [fconfigure stdout -encoding] } -body { fconfigure stdout -encoding jis0208 fconfigure stdout -encoding } -cleanup { fconfigure stdout -encoding $old } -result {jis0208} test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup { cd [makeDirectory tmp] makeDirectory [file join tmp encoding] set path [encoding dirs] encoding dirs {} catch {unset encodings} catch {unset x} } -body { foreach encoding [encoding names] { set encodings($encoding) 1 } makeFile {} [file join tmp encoding junk.enc] makeFile {} [file join tmp encoding junk2.enc] encoding dirs [list [file join [pwd] encoding]] foreach encoding [encoding names] { if {![info exists encodings($encoding)]} { lappend x $encoding } } lsort $x } -cleanup { encoding dirs $path cd [workingDirectory] removeFile [file join tmp encoding junk2.enc] removeFile [file join tmp encoding junk.enc] removeDirectory [file join tmp encoding] removeDirectory tmp } -result {junk junk2} test encoding-5.1 {Tcl_SetSystemEncoding} -setup { set old [encoding system] } -body { encoding system jis0208 encoding convertto \u4E4E } -cleanup { encoding system iso8859-1 encoding system $old } -result {8C} test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} { set old [encoding system] encoding system $old string compare $old [encoding system] } {0} test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} { testencoding create foo [namespace code {toutf 1}] \ [namespace code {fromutf 2}] set x {} encoding convertfrom foo abcd encoding convertto foo abcd testencoding delete foo return $x } {{toutf 1} {fromutf 2}} test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} { testencoding create foo [namespace code {toutf a}] \ [namespace code {fromutf b}] set x {} encoding convertfrom foo abcd encoding convertto foo abcd testencoding delete foo return $x } {{toutf a} {fromutf b}} test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} { encoding convertfrom jis0208 8c8c8c8c } "\u543E\u543E\u543E\u543E" test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} { set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C append a $a append a $a append a $a append a $a set x [encoding convertfrom jis0208 $a] list [string length $x] [string index $x 0] } "512 \u4E4E" test encoding-8.1 {Tcl_ExternalToUtf} { set f [open [file join [temporaryDirectory] dummy] w] fconfigure $f -translation binary -encoding iso8859-1 puts -nonewline $f "ab\x8C\xC1g" close $f set f [open [file join [temporaryDirectory] dummy] r] fconfigure $f -translation binary -encoding shiftjis set x [read $f] close $f file delete [file join [temporaryDirectory] dummy] return $x } "ab\u4E4Eg" test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} { encoding convertto jis0208 "\u543E\u543E\u543E\u543E" } {8c8c8c8c} test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} { set a \u4E4E\u4E4E\u4E4E\u4E4E\u4E4E\u4E4E\u4E4E\u4E4E append a $a append a $a append a $a append a $a append a $a append a $a set x [encoding convertto jis0208 $a] list [string length $x] [string range $x 0 1] } "1024 8C" test encoding-10.1 {Tcl_UtfToExternal} { set f [open [file join [temporaryDirectory] dummy] w] fconfigure $f -translation binary -encoding shiftjis puts -nonewline $f "ab\u4E4Eg" close $f set f [open [file join [temporaryDirectory] dummy] r] fconfigure $f -translation binary -encoding iso8859-1 set x [read $f] close $f file delete [file join [temporaryDirectory] dummy] return $x } "ab\x8C\xC1g" proc viewable {str} { set res "" foreach c [split $str {}] { if {[string is print $c] && [string is ascii $c]} { append res $c } else { append res "\\u[format %4.4X [scan $c %c]]" } } return "$str ($res)" } test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} { set system [encoding system] set path [encoding dirs] encoding system iso8859-1 encoding dirs {} llength jis0208 ;# Shimmer any cached Tcl_Encoding in shared literal set x [list [catch {encoding convertto jis0208 \u4E4E} msg] $msg] encoding dirs $path encoding system $system lappend x [encoding convertto jis0208 \u4E4E] } {1 {unknown encoding "jis0208"} 8C} test encoding-11.2 {LoadEncodingFile: single-byte} { encoding convertfrom jis0201 \xA1 } \uFF61 test encoding-11.3 {LoadEncodingFile: double-byte} { encoding convertfrom jis0208 8C } \u4E4E test encoding-11.4 {LoadEncodingFile: multi-byte} { encoding convertfrom shiftjis \x8C\xC1 } \u4E4E test encoding-11.5 {LoadEncodingFile: escape file} { viewable [encoding convertto iso2022 \u4E4E] } [viewable "\x1B\$B8C\x1B(B"] test encoding-11.5.1 {LoadEncodingFile: escape file} { viewable [encoding convertto iso2022-jp \u4E4E] } [viewable "\x1B\$B8C\x1B(B"] test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup { set system [encoding system] set path [encoding dirs] encoding system iso8859-1 } -body { cd [temporaryDirectory] encoding dirs [file join tmp encoding] makeDirectory tmp makeDirectory [file join tmp encoding] set f [open [file join tmp encoding splat.enc] w] fconfigure $f -translation binary puts $f "abcdefghijklmnop" close $f encoding convertto splat \u4E4E } -returnCodes error -cleanup { file delete [file join [temporaryDirectory] tmp encoding splat.enc] removeDirectory [file join tmp encoding] removeDirectory tmp cd [workingDirectory] encoding dirs $path encoding system $system } -result {invalid encoding file "splat"} # OpenEncodingFile is fully tested by the rest of the tests in this file. test encoding-12.1 {LoadTableEncoding: normal encoding} { set x [encoding convertto iso8859-3 \u0120] append x [encoding convertto iso8859-3 \xD5] append x [encoding convertfrom iso8859-3 \xD5] } \xD5?\u0120 test encoding-12.2 {LoadTableEncoding: single-byte encoding} { set x [encoding convertto iso8859-3 ab\u0120g] append x [encoding convertfrom iso8859-3 ab\xD5g] } ab\xD5gab\u0120g test encoding-12.3 {LoadTableEncoding: multi-byte encoding} { set x [encoding convertto shiftjis ab\u4E4Eg] append x [encoding convertfrom shiftjis ab\x8C\xC1g] } ab\x8C\xC1gab\u4E4Eg test encoding-12.4 {LoadTableEncoding: double-byte encoding} { set x [encoding convertto jis0208 \u4E4E\u03B1] append x [encoding convertfrom jis0208 8C&A] } 8C&A\u4E4E\u03B1 test encoding-12.5 {LoadTableEncoding: symbol encoding} { set x [encoding convertto symbol \u03B3] append x [encoding convertto symbol g] append x [encoding convertfrom symbol g] } gg\u03B3 test encoding-12.6 {LoadTableEncoding: overflow in char value} ucs2 { encoding convertto iso8859-3 \U010000 } ? test encoding-13.1 {LoadEscapeTable} { viewable [set x [encoding convertto iso2022 ab\u4E4E\u68D9g]] } [viewable "ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg"] test encoding-14.1 {BinaryProc} { encoding convertto identity \x12\x34\x56\xff\x69 } "\x12\x34\x56\xc3\xbf\x69" test encoding-15.1 {UtfToUtfProc} { encoding convertto utf-8 \xA3 } "\xC2\xA3" test encoding-15.2 {UtfToUtfProc null character output} testbytestring { binary scan [testbytestring [encoding convertto utf-8 \x00]] H* z set z } 00 test encoding-15.3 {UtfToUtfProc null character input} teststringbytes { set y [encoding convertfrom utf-8 [encoding convertto utf-8 \x00]] binary scan [teststringbytes $y] H* z set z } c080 test encoding-15.4 {UtfToUtfProc emoji character input} -body { set x \xED\xA0\xBD\xED\xB8\x82 set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82] list [string length $x] $y } -result "6 \uD83D\uDE02" test encoding-15.5 {UtfToUtfProc emoji character input} { set x \xF0\x9F\x98\x82 set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82] list [string length $x] $y } "4 \uD83D\uDE02" test encoding-15.6 {UtfToUtfProc emoji character output} { set x \uDE02\uD83D\uDE02\uD83D set y [encoding convertto utf-8 \uDE02\uD83D\uDE02\uD83D] binary scan $y H* z list [string length $y] $z } {10 edb882f09f9882eda0bd} test encoding-15.7 {UtfToUtfProc emoji character output} { set x \uDE02\uD83D\uD83D set y [encoding convertto utf-8 \uDE02\uD83D\uD83D] binary scan $y H* z list [string length $x] [string length $y] $z } {3 9 edb882eda0bdeda0bd} test encoding-15.8 {UtfToUtfProc emoji character output} { set x \uDE02\uD83D\xE9 set y [encoding convertto utf-8 \uDE02\uD83D\xE9] binary scan $y H* z list [string length $x] [string length $y] $z } {3 8 edb882eda0bdc3a9} test encoding-15.9 {UtfToUtfProc emoji character output} { set x \uDE02\uD83DX set y [encoding convertto utf-8 \uDE02\uD83DX] binary scan $y H* z list [string length $x] [string length $y] $z } {3 7 edb882eda0bd58} test encoding-15.10 {UtfToUtfProc high surrogate character output} { set x \uDE02\xE9 set y [encoding convertto utf-8 \uDE02\xE9] binary scan $y H* z list [string length $x] [string length $y] $z } {2 5 edb882c3a9} test encoding-15.11 {UtfToUtfProc low surrogate character output} { set x \uDA02\xE9 set y [encoding convertto utf-8 \uDA02\xE9] binary scan $y H* z list [string length $x] [string length $y] $z } {2 5 eda882c3a9} test encoding-15.12 {UtfToUtfProc high surrogate character output} { set x \uDE02Y set y [encoding convertto utf-8 \uDE02Y] binary scan $y H* z list [string length $x] [string length $y] $z } {2 4 edb88259} test encoding-15.13 {UtfToUtfProc low surrogate character output} { set x \uDA02Y set y [encoding convertto utf-8 \uDA02Y] binary scan $y H* z list [string length $x] [string length $y] $z } {2 4 eda88259} test encoding-15.14 {UtfToUtfProc high surrogate character output} { set x \uDE02 set y [encoding convertto utf-8 \uDE02] binary scan $y H* z list [string length $x] [string length $y] $z } {1 3 edb882} test encoding-15.15 {UtfToUtfProc low surrogate character output} { set x \uDA02 set y [encoding convertto utf-8 \uDA02] binary scan $y H* z list [string length $x] [string length $y] $z } {1 3 eda882} test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} { set x \xF0\xA0\xA1\xC2 set y [encoding convertfrom utf-8 \xF0\xA0\xA1\xC2] list [string length $x] $y } "4 \xF0\xA0\xA1\xC2" test encoding-16.1 {UnicodeToUtfProc} -body { set val [encoding convertfrom unicode NN] list $val [format %X [scan $val %c]] } -result "\u4E4E 4E4E" test encoding-16.2 {UnicodeToUtfProc} -constraints fullutf -body { set val [encoding convertfrom unicode "\xD8\xD8\xDC\xDC"] list $val [format %x [scan $val %c]] } -result "\U460DC 460dc" test encoding-16.3 {UnicodeToUtfProc} -body { set val [encoding convertfrom unicode "\xDC\xDC"] list $val [format %X [scan $val %c]] } -result "\uDCDC DCDC" test encoding-16.4 {UnicodeToUtfProc, bug [d19fe0a5b]} -body { encoding convertfrom unicode "\x41\x41\x41" } -result \u4141\uFFFD test encoding-16.5 {UnicodeToUtfProc, bug [d19fe0a5b]} -constraints ucs2 -body { encoding convertfrom unicode "\xD8\xD8" } -result \uD8D8 test encoding-17.1 {UtfToUnicodeProc} -constraints fullutf -body { encoding convertto unicode "\U460DC" } -result "\xD8\xD8\xDC\xDC" test encoding-17.2 {UtfToUnicodeProc} -body { encoding convertto unicode "\uDCDC" } -result "\xDC\xDC" test encoding-17.3 {UtfToUnicodeProc} -body { encoding convertto unicode "\uD8D8" } -result "\xD8\xD8" test encoding-18.1 {TableToUtfProc on invalid input} -body { list [catch {encoding convertto jis0208 \\} res] $res } -result {0 !)} test encoding-19.1 {TableFromUtfProc} { } {} test encoding-20.1 {TableFreefProc} { } {} test encoding-21.1 {EscapeToUtfProc} { } {} test encoding-22.1 {EscapeFromUtfProc} { } {} set iso2022encData "\x1B\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\x1B(B \x1B\$B>.@Z= 0} { if {$count} { incr count 1 ; # account for newline append out \n } append out $line incr count $num } close $fid if {[string compare $iso2022uniData $out]} { return -code error "iso2022-jp read in doesn't match original" } list $count $out } [list [string length $iso2022uniData] $iso2022uniData] test encoding-23.3 {iso2022-jp escape encoding test} { # read $fis reads size in chars, not raw bytes. set fid [open iso2022.txt r] fconfigure $fid -encoding iso2022-jp set data [read $fid 50] close $fid return $data } [string range $iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50 cd [workingDirectory] # Code to make the next few tests more intelligible; the code being tested # should be in the body of the test! proc runInSubprocess {contents {filename iso2022.tcl}} { set theFile [makeFile $contents $filename] try { exec [interpreter] $theFile } finally { removeFile $theFile } } test encoding-24.1 {EscapeFreeProc on open channels} exec { runInSubprocess { set f [open [file join [file dirname [info script]] iso2022.txt]] fconfigure $f -encoding iso2022-jp gets $f } } {} test encoding-24.2 {EscapeFreeProc on open channels} {exec} { # Bug #524674 output viewable [runInSubprocess { encoding system cp1252; # Bug #2891556 crash revelator fconfigure stdout -encoding iso2022-jp puts ab\u4E4E\u68D9g set env(TCL_FINALIZE_ON_EXIT) 1 exit }] } "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001B\$B8C\\u001B\$(DD%\\u001B(Bg)" test encoding-24.3 {EscapeFreeProc on open channels} {stdio} { # Bug #219314 - if we don't free escape encodings correctly on channel # closure, we go boom set file [makeFile { encoding system iso2022-jp set a \u4E4E\u4E5E\u4E5F; # 3 Japanese Kanji letters puts $a } iso2022.tcl] set f [open "|[list [interpreter] $file]"] fconfigure $f -encoding iso2022-jp set count [gets $f line] close $f removeFile iso2022.tcl list $count [viewable $line] } [list 3 "\u4E4E\u4E5E\u4E5F (\\u4E4E\\u4E5E\\u4E5F)"] test encoding-24.4 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC0\x80"] } 1 test encoding-24.5 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC0\x81"] } 2 test encoding-24.6 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC1\xBF"] } 2 test encoding-24.7 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC2\x80"] } 1 test encoding-24.8 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xE0\x80\x80"] } 3 test encoding-24.9 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xE0\x9F\xBF"] } 3 test encoding-24.10 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xE0\xA0\x80"] } 1 test encoding-24.11 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xEF\xBF\xBF"] } 1 file delete [file join [temporaryDirectory] iso2022.txt] # # Begin jajp encoding round-trip conformity tests # proc foreach-jisx0208 {varName command} { upvar 1 $varName code foreach range { {2121 217E} {2221 222E} {223A 2241} {224A 2250} {225C 226A} {2272 2279} {227E 227E} {2330 2339} {2421 2473} {2521 2576} {2821 2821} {282C 282C} {2837 2837} {30 21 4E 7E} {4F21 4F53} {50 21 73 7E} {7421 7426} } { if {[llength $range] == 2} { # for adhoc range. simple {first last}. inclusive. scan $range %x%x first last for {set i $first} {$i <= $last} {incr i} { set code $i uplevel 1 $command } } elseif {[llength $range] == 4} { # for uniform range. scan $range %x%x%x%x h0 l0 hend lend for {set hi $h0} {$hi <= $hend} {incr hi} { for {set lo $l0} {$lo <= $lend} {incr lo} { set code [expr {$hi << 8 | ($lo & 0xff)}] uplevel 1 $command } } } else { error "really?" } } } proc gen-jisx0208-euc-jp {code} { binary format cc \ [expr {($code >> 8) | 0x80}] [expr {($code & 0xFF) | 0x80}] } proc gen-jisx0208-iso2022-jp {code} { binary format a3cca3 \ "\x1B\$B" [expr {$code >> 8}] [expr {$code & 0xFF}] "\x1B(B" } proc gen-jisx0208-cp932 {code} { set c1 [expr {($code >> 8) | 0x80}] set c2 [expr {($code & 0xff)| 0x80}] if {$c1 % 2} { set c1 [expr {($c1 >> 1) + ($c1 < 0xDF ? 0x31 : 0x71)}] incr c2 [expr {- (0x60 + ($c2 < 0xE0))}] } else { set c1 [expr {($c1 >> 1) + ($c1 < 0xDF ? 0x30 : 0x70)}] incr c2 -2 } binary format cc $c1 $c2 } proc channel-diff {fa fb} { set diff {} while {[gets $fa la] >= 0 && [gets $fb lb] >= 0} { if {[string compare $la $lb] == 0} continue # lappend diff $la $lb # For more readable (easy to analyze) output. set code [lindex $la 0] binary scan [lindex $la 1] H* expected binary scan [lindex $lb 1] H* got lappend diff [list $code $expected $got] } return $diff } # Create char tables. cd [temporaryDirectory] foreach enc {cp932 euc-jp iso2022-jp} { set f [open $enc.chars w] fconfigure $f -encoding binary foreach-jisx0208 code { puts $f [format "%04X %s" $code [gen-jisx0208-$enc $code]] } close $f } # shiftjis == cp932 for jisx0208. file copy -force cp932.chars shiftjis.chars set NUM 0 foreach from {cp932 shiftjis euc-jp iso2022-jp} { foreach to {cp932 shiftjis euc-jp iso2022-jp} { test encoding-25.[incr NUM] "jisx0208 $from => $to" -setup { cd [temporaryDirectory] } -body { set f [open $from.chars] fconfigure $f -encoding $from set out [open $from.$to.tcltestout w] fconfigure $out -encoding $to puts -nonewline $out [read $f] close $out close $f # then compare $to.chars <=> $from.to.tcltestout as binary. set fa [open $to.chars rb] set fb [open $from.$to.tcltestout rb] channel-diff $fa $fb # Difference should be empty. } -cleanup { close $fa close $fb } -result {} } } test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints { testgetdefenc } -setup { set origDir [testgetdefenc] testsetdefenc slappy } -body { testgetdefenc } -cleanup { testsetdefenc $origDir } -result slappy file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout] # ===> Cut here <=== # EscapeFreeProc, GetTableEncoding, unilen are fully tested by the rest of # this file. test encoding-27.1 {encoding dirs basic behavior} -returnCodes error -body { encoding dirs ? ? } -result {wrong # args: should be "encoding dirs ?dirList?"} test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body { encoding dirs "\{not a list" } -result "expected directory list but got \"\{not a list\"" } test encoding-28.0 {all encodings load} -body { set string hello foreach name [encoding names] { incr count encoding convertto $name $string # discard the cached internal representation of Tcl_Encoding # Unfortunately, without this, encoding 2-1 fails. llength $name } return $count } -result 83 runtests test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding } -body { # Note - buffers are initialized to \xff list [catch {testencoding Tcl_UtfToExternal unicode A {start end} {} 1} result] $result } -result [list 0 [list nospace {} \xff]] test encoding-bug-183a1adcc0-2 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding } -body { # Note - buffers are initialized to \xff list [catch {testencoding Tcl_UtfToExternal unicode A {start end} {} 0} result] $result } -result [list 0 [list nospace {} {}]] test encoding-bug-183a1adcc0-3 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding } -body { # Note - buffers are initialized to \xff list [catch {testencoding Tcl_UtfToExternal unicode A {start end} {} 2} result] $result } -result [list 0 [list nospace {} \x00\x00]] test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding } -body { # Note - buffers are initialized to \xff list [catch {testencoding Tcl_UtfToExternal unicode A {start end} {} 3} result] $result } -result [list 0 [list nospace {} \x00\x00\xff]] test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding ucs2 } -body { # Note - buffers are initialized to \xff list [catch {testencoding Tcl_UtfToExternal unicode A {start end} {} 4} result] $result } -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]] } # cleanup namespace delete ::tcl::test::encoding ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/env.test0000644000175000017500000002714314554262142014504 0ustar sergeisergei# Commands covered: none (tests environment variable implementation) # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } source [file join [file dirname [info script]] tcltests.tcl] # [exec] is required here to see the actual environment received by child # processes. proc getenv {} { global printenvScript catch {exec [interpreter] $printenvScript} out if {$out eq "child process exited abnormally"} { set out {} } return $out } proc envrestore {} { # Restore the environment variables at the end of the test. global env variable env2 foreach name [array names env] { unset env($name) } array set env $env2 return } proc envprep {} { # Save the current environment variables at the start of the test. global env variable keep variable env2 set env2 [array get env] foreach name [array names env] { # Keep some environment variables that support operation of the tcltest # package. if {[string toupper $name] ni [string toupper $keep]} { unset env($name) } } return } proc encodingrestore {} { variable sysenc encoding system $sysenc return } proc encodingswitch encoding { variable sysenc # Need to run [getenv] in known encoding, so save the current one here... set sysenc [encoding system] encoding system $encoding return } proc setup1 {} { global env envprep encodingswitch iso8859-1 } proc setup2 {} { global env setup1 set env(NAME1) {test string} set env(NAME2) {new value} set env(XYZZY) {garbage} } proc cleanup1 {} { encodingrestore envrestore } variable keep { TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM CommonProgramFiles CommonProgramFiles(x86) ProgramFiles ProgramFiles(x86) CommonProgramW6432 ProgramW6432 PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITEW6432 USERPROFILE WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR } variable printenvScript [makeFile [string map [list @keep@ [list $keep]] { encoding system iso8859-1 proc lrem {listname name} { upvar $listname list set i [lsearch -nocase $list $name] if {$i >= 0} { set list [lreplace $list $i $i] } return $list } proc mangle s { regsub -all {\[|\\|\]} $s {\\&} s regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar {&}]} s return [subst -novariables $s] } proc manglechar c { return [format {\u%04x} [scan $c %c]] } set names [lsort [array names env]] if {$tcl_platform(platform) eq "windows"} { lrem names HOME lrem names COMSPEC lrem names ComSpec lrem names "" } foreach name @keep@ { lrem names $name } foreach p $names { puts [mangle $p]=[mangle $env($p)] } exit }] printenv] test env-1.1 {propagation of env values to child interpreters} -setup { catch {interp delete child} catch {unset env(test)} } -body { interp create child set env(test) garbage child eval {set env(test)} } -cleanup { interp delete child unset env(test) } -result {garbage} # This one crashed on Solaris under Tcl8.0, so we only want to make sure it # runs. test env-1.2 {lappend to env value} -setup { catch {unset env(test)} } -body { set env(test) aaaaaaaaaaaaaaaa append env(test) bbbbbbbbbbbbbb unset env(test) } test env-1.3 {reflection of env by "array names"} -setup { catch {interp delete child} catch {unset env(test)} } -body { interp create child child eval {set env(test) garbage} expr {"test" in [array names env]} } -cleanup { interp delete child catch {unset env(test)} } -result 1 test env-2.1 { adding environment variables } -constraints exec -setup setup1 -body { getenv } -cleanup cleanup1 -result {} test env-2.2 { adding environment variables } -constraints exec -setup setup1 -body { set env(NAME1) "test string" getenv } -cleanup cleanup1 -result {NAME1=test string} test env-2.3 {adding environment variables} -constraints exec -setup { setup1 set env(NAME1) "test string" } -body { set env(NAME2) "more" getenv } -cleanup cleanup1 -result {NAME1=test string NAME2=more} test env-2.4 { adding environment variables } -constraints exec -setup { setup1 set env(NAME1) "test string" set env(NAME2) "more" } -body { set env(XYZZY) "garbage" getenv } -cleanup { cleanup1 } -result {NAME1=test string NAME2=more XYZZY=garbage} test env-2.5 {different encoding (wide chars)} -constraints {win exec} -setup { # be sure set of (Unicode) environment occurs if single-byte encoding is used: encodingswitch cp1252 # German (cp1252) and Russian (cp1251) characters together encoded as utf-8: set val 2d2dc3a4c3b6c3bcc39f2dd182d0b5d181d1822d2d set env(XYZZY) [encoding convertfrom utf-8 [binary decode hex $val]] # now switch to utf-8 (to see correct values from test): encoding system utf-8 } -body { exec [interpreter] << [string map [list \$val $val] { encoding system utf-8; fconfigure stdout -encoding utf-8 set test [encoding convertfrom utf-8 [binary decode hex $val]] puts "[expr {$env(XYZZY) eq $test}] \ngot:\t\ $env(XYZZY) ([binary encode hex [encoding convertto $env(XYZZY)]]) \nexp:\t\ $test ([binary encode hex [encoding convertto $test]])" }] } -cleanup { encodingrestore unset -nocomplain val f env(XYZZY) } -match glob -result {1 *} test env-3.1 { changing environment variables } -constraints exec -setup setup2 -body { set result [getenv] unset env(NAME2) set result } -cleanup { cleanup1 } -result {NAME1=test string NAME2=new value XYZZY=garbage} test env-4.1 { unsetting environment variables } -constraints exec -setup setup2 -body { unset -nocomplain env(NAME2) getenv } -cleanup cleanup1 -result {NAME1=test string XYZZY=garbage} # env-4.2 is deleted test env-4.3 { setting international environment variables } -constraints exec -setup setup1 -body { set env(\ua7) \ub6 getenv } -cleanup cleanup1 -result {\u00a7=\u00b6} test env-4.4 { changing international environment variables } -constraints exec -setup setup1 -body { set env(\ua7) \ua7 getenv } -cleanup cleanup1 -result {\u00a7=\u00a7} test env-4.5 { unsetting international environment variables } -constraints exec -setup { setup1 set env(\ua7) \ua7 } -body { set env(\ub6) \ua7 unset env(\ua7) getenv } -cleanup cleanup1 -result {\u00b6=\u00a7} test env-5.0 { corner cases - set a value, it should exist } -setup setup1 -body { set env(temp) a set env(temp) } -cleanup cleanup1 -result a test env-5.1 { corner cases - remove one elem at a time } -setup setup1 -body { # When no environment variables exist, the env var will contain no # entries. The "array names" call syncs up the C-level environ array with # the Tcl level env array. Make sure an empty Tcl array is created. foreach e [array names env] { unset env($e) } array size env } -cleanup cleanup1 -result 0 test env-5.2 {corner cases - unset the env array} -setup { interp create i } -body { # Unsetting a variable in an interp detaches the C-level traces from the # Tcl "env" variable. i eval { unset env set env(THIS_SHOULDNT_EXIST) a } info exists env(THIS_SHOULDNT_EXIST) } -cleanup { interp delete i } -result {0} test env-5.3 {corner cases: unset the env in parent should unset child} -setup { setup1 interp create i } -body { # Variables deleted in a parent interp should be deleted in child interp # too. i eval {set env(THIS_SHOULD_EXIST) a} set result [set env(THIS_SHOULD_EXIST)] unset env(THIS_SHOULD_EXIST) lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}] } -cleanup { cleanup1 interp delete i } -result {a 1} test env-5.4 {corner cases - unset the env array} -setup { setup1 interp create i } -body { # The info exists command should be in sync with the env array. # Know Bug: 1737 i eval {set env(THIS_SHOULD_EXIST) a} set result [info exists env(THIS_SHOULD_EXIST)] lappend result [set env(THIS_SHOULD_EXIST)] lappend result [info exists env(THIS_SHOULD_EXIST)] } -cleanup { cleanup1 interp delete i } -result {1 a 1} test env-5.5 { corner cases - cannot have null entries on Windows } -constraints win -body { set env() a catch {set env()} } -cleanup cleanup1 -result 1 test env-6.1 {corner cases - add lots of env variables} -setup setup1 -body { set size [array size env] for {set i 0} {$i < 100} {incr i} { set env(BOGUS$i) $i } expr {[array size env] - $size} } -cleanup cleanup1 -result 100 test env-7.1 {[219226]: whole env array should not be unset by read} -body { set n [array size env] set s [array startsearch env] while {[array anymore env $s]} { array nextelement env $s incr n -1 } array donesearch env $s return $n } -result 0 test env-7.2 { [219226]: links to env elements should not be removed by read } -setup setup1 -body { apply {{} { set ::env(test7_2) ok upvar env(test7_2) elem set ::env(PATH) return $elem }} } -cleanup cleanup1 -result ok test env-7.3 { [9b4702]: testing existence of env(some_thing) should not destroy trace } -setup setup1 -body { apply {{} { catch {unset ::env(test7_3)} proc foo args { set ::env(test7_3) ok } trace add variable ::env(not_yet_existent) write foo info exists ::env(not_yet_existent) set ::env(not_yet_existent) "Now I'm here"; return [info exists ::env(test7_3)] }} } -cleanup cleanup1 -result 1 test env-8.0 { memory usage - valgrind does not report reachable memory } -body { set res [set env(__DUMMY__) {i'm with dummy}] unset env(__DUMMY__) return $res } -result {i'm with dummy} test env-9.0 { Initialization of HOME from HOMEDRIVE and HOMEPATH } -constraints win -setup { setup1 unset -nocomplain ::env(HOME) set ::env(HOMEDRIVE) X: set ::env(HOMEPATH) \\home\\path } -cleanup { cleanup1 } -body { set pipe [open |[list [interpreter]] r+] puts $pipe {puts $::env(HOME); flush stdout; exit} flush $pipe set result [gets $pipe] close $pipe set result } -result {X:\home\path} test env-9.1 { Initialization of HOME from USERPROFILE } -constraints win -setup { setup1 unset -nocomplain ::env(HOME) unset -nocomplain ::env(HOMEDRIVE) unset -nocomplain ::env(HOMEPATH) } -cleanup { cleanup1 } -body { set pipe [open |[list [interpreter]] r+] puts $pipe {puts $::env(HOME); flush stdout; exit} flush $pipe set result [gets $pipe] close $pipe if {$result ne $::env(USERPROFILE)} { list ERROR $result ne $::env(USERPROFILE) } } -result {} # cleanup rename getenv {} rename envrestore {} rename envprep {} rename encodingrestore {} rename encodingswitch {} removeFile $printenvScript ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/error.test0000644000175000017500000011153614554262142015045 0ustar sergeisergei# Commands covered: error, catch, throw, try # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint memory [llength [info commands memory]] customMatch pairwise {apply {{a b} { string equal [lindex $b 0] [lindex $b 1] }}} namespace eval ::tcl::test::error { if {[testConstraint memory]} { proc getbytes {} { set lines [split [memory info] \n] return [lindex $lines 3 3] } proc leaktest {script {iterations 3}} { set end [getbytes] for {set i 0} {$i < $iterations} {incr i} { uplevel 1 $script set tmp $end set end [getbytes] } return [expr {$end - $tmp}] } } proc foo {} { global errorInfo set a [catch {format [error glorp2]} b] error {Human-generated} } proc foo2 {} { global errorInfo set a [catch {format [error glorp2]} b] error {Human-generated} $errorInfo } # Catch errors occurring in commands and errors from "error" command test error-1.1 {simple errors from commands} { catch {format [string index]} b } 1 test error-1.2 {simple errors from commands} { catch {format [string index]} b set b } {wrong # args: should be "string index string charIndex"} test error-1.3 {simple errors from commands} { catch {format [string index]} b set ::errorInfo # This used to return '... while executing ...', but string index is fully # compiled as of 8.4a3 } {wrong # args: should be "string index string charIndex" while executing "string index"} test error-1.4 {simple errors from commands} { catch {error glorp} b } 1 test error-1.5 {simple errors from commands} { catch {error glorp} b set b } glorp test error-1.6 {simple errors from commands} { catch {catch a b c d} b } 1 test error-1.7 {simple errors from commands} { catch {catch a b c d} b set b } {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} test error-1.8 {simple errors from commands} { # This test is non-portable: it generates a memory fault on machines like # DEC Alphas (infinite recursion overflows stack?) # # That claims sounds like a bug to be fixed rather than a portability # problem. Anyhow, I believe it's out of date (bug's been fixed) so this # test is re-enabled. proc p {} { uplevel 1 catch p error } p } 0 # Check errors nested in procedures. Also check the optional argument to # "error" to generate a new error trace. test error-2.1 {errors in nested procedures} { catch foo b } 1 test error-2.2 {errors in nested procedures} { catch foo b set b } {Human-generated} test error-2.3 {errors in nested procedures} { catch foo b set ::errorInfo } {Human-generated while executing "error {Human-generated}" (procedure "foo" line 4) invoked from within "foo"} test error-2.4 {errors in nested procedures} { catch foo2 b } 1 test error-2.5 {errors in nested procedures} { catch foo2 b set b } {Human-generated} test error-2.6 {errors in nested procedures} { catch foo2 b set ::errorInfo } {glorp2 while executing "error glorp2" (procedure "foo2" line 3) invoked from within "foo2"} # Error conditions related to "catch". test error-3.1 {errors in catch command} { list [catch {catch} msg] $msg } {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}} test error-3.2 {errors in catch command} { list [catch {catch a b c} msg] $msg } {0 1} test error-3.3 {errors in catch command} { catch {unset a} set a(0) 22 list [catch {catch {format 44} a} msg] $msg } {1 {can't set "a": variable is array}} catch {unset a} # More tests related to errorInfo and errorCode test error-4.1 {errorInfo and errorCode variables} { list [catch {error msg1 msg2 msg3} msg] $msg $::errorInfo $::errorCode } {1 msg1 msg2 msg3} test error-4.2 {errorInfo and errorCode variables} { list [catch {error msg1 {} msg3} msg] $msg $::errorInfo $::errorCode } {1 msg1 {msg1 while executing "error msg1 {} msg3"} msg3} test error-4.3 {errorInfo and errorCode variables} { list [catch {error msg1 {}} msg] $msg $::errorInfo $::errorCode } {1 msg1 {msg1 while executing "error msg1 {}"} NONE} test error-4.4 {errorInfo and errorCode variables} { set ::errorCode bogus list [catch {error msg1} msg] $msg $::errorInfo $::errorCode } {1 msg1 {msg1 while executing "error msg1"} NONE} test error-4.5 {errorInfo and errorCode variables} { set ::errorCode bogus list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode } {1 msg1 msg2 {}} test error-4.6 {errorstack via info } -body { proc f x {g $x$x} proc g x {error G:$x} catch {f 12} info errorstack } -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1} test error-4.7 {errorstack via options dict } -body { proc f x {g $x$x} proc g x {error G:$x} catch {f 12} m d dict get $d -errorstack } -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1} test error-4.8 {errorstack from exec traces} -body { proc foo args {} proc goo {} foo trace add execution foo enter {error bar;#} catch goo m d dict get $d -errorstack } -cleanup { rename goo {}; rename foo {} unset -nocomplain m d } -result {INNER {error bar} CALL goo UP 1} # Errors in error command itself test error-5.1 {errors in error command} { list [catch {error} msg] $msg } {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}} test error-5.2 {errors in error command} { list [catch {error a b c d} msg] $msg } {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}} # Make sure that catch resets error information test error-6.1 {catch must reset error state} { catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]} list $::errorCode $::errorInfo } {NONE 1} test error-6.2 {catch must reset error state} { catch {error outer [catch {return -level 0 -code error -errorcode BUG}]} list $::errorCode $::errorInfo } {NONE 1} test error-6.3 {catch must reset error state} { set ::errorCode BUG catch {error outer [catch set]} list $::errorCode $::errorInfo } {NONE 1} test error-6.4 {catch must reset error state} { catch {error [catch {error foo bar baz}] 1} list $::errorCode $::errorInfo } {NONE 1} test error-6.5 {catch must reset error state} { catch {error [catch {return -level 0 -code error -errorcode BUG}] 1} list $::errorCode $::errorInfo } {NONE 1} test error-6.6 {catch must reset error state} { catch {return -level 0 -code error -errorinfo [catch {error foo bar baz}]} list $::errorCode $::errorInfo } {NONE 1} test error-6.7 {catch must reset error state} { proc foo {} { return -code error -errorinfo [catch {error foo bar baz}] } catch foo list $::errorCode } {NONE} test error-6.8 {catch must reset error state} { catch {return -level 0 -code error [catch {error foo bar baz}]} list $::errorCode } {NONE} test error-6.9 {catch must reset error state} { proc foo {} { return -code error [catch {error foo bar baz}] } catch foo list $::errorCode } {NONE} test error-6.10 {catch must reset errorstack} -body { proc f x {g $x$x} proc g x {error G:$x} catch {f 12} set e1 [info errorstack] catch {f 13} set e2 [info errorstack] list $e1 $e2 } -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}} test error-7.1 {Bug 1397843} -body { variable cmds proc EIWrite args { variable cmds lappend cmds [lindex [info level -2] 0] } proc BadProc {} { set i a incr i } trace add variable ::errorInfo write [namespace code EIWrite] catch BadProc trace remove variable ::errorInfo write [namespace code EIWrite] set cmds } -match glob -result {*BadProc*} # throw tests test error-8.1 {throw produces error 1 at level 0} { catch { throw FOO bar } } {1} test error-8.2 {throw behaves as error does at level 0} { catch { throw FOO bar } em1 opts1 catch { error bar {} FOO } em2 opts2 dict set opts1 -result $em1 dict set opts2 -result $em2 foreach key {-code -level -result -errorcode} { if { [dict get $opts1 $key] ne [dict get $opts2 $key] } { error "error/throw outcome differs on '$key'" } } } {} test error-8.3 {throw produces error 1 at level > 0} { proc throw_foo {} { throw FOO bar } catch { throw_foo } } {1} test error-8.4 {throw behaves as error does at level > 0} { proc throw_foo {} { throw FOO bar } proc error_foo {} { error bar {} FOO } catch { throw_foo } em1 opts1 catch { error_foo } em2 opts2 dict set opts1 -result $em1 dict set opts2 -result $em2 foreach key {-code -level -result -errorcode} { if { [dict get $opts1 $key] ne [dict get $opts2 $key] } { error "error/throw outcome differs on '$key'" } } } {} test error-8.5 {throw syntax checks} -returnCodes error -body { throw } -result {wrong # args: should be "throw type message"} test error-8.6 {throw syntax checks} -returnCodes error -body { throw a } -result {wrong # args: should be "throw type message"} test error-8.7 {throw syntax checks} -returnCodes error -body { throw a b c } -result {wrong # args: should be "throw type message"} test error-8.8 {throw syntax checks} -returnCodes error -body { throw "not a \{ list" foo } -result {unmatched open brace in list} test error-8.9 {throw syntax checks} -returnCodes error -body { throw {} foo } -result {type must be non-empty list} test error-8.10 {Bug 33b7abb8a2: throw stack usage} -returnCodes error -body { apply {code {throw $code foo}} {} } -result {type must be non-empty list} test error-8.11 {Bug 7174354ecb: throw error message} -returnCodes error -body { throw {not {}a list} x[]y } -result {list element in braces followed by "a" instead of space} # simple try tests: body completes with code ok test error-9.1 {try (ok, empty result) with no handlers} { try list } {} test error-9.2 {try (ok, non-empty result) with no handlers} { try { list a b c } } {a b c} test error-9.3 {try (ok, non-empty result) with trap handler} { try { list a b c } trap {} {} { list d e f } } {a b c} test error-9.4 {try (ok, non-empty result) with on handler} { try { list a b c } on break {} { list d e f } } {a b c} test error-9.5 {try (ok, non-empty result) with on ok handler} { try { list a b c } on ok {} { list d e f } } {d e f} test error-9.6 {try (compilation of simple finaly token only, bug [27520c9b17])} -body { set b {}; set l {} try {lappend l error} finally [lappend l set b] list $l $b } -cleanup { unset -nocomplain b l } -result {{set b error} {}} # simple try tests - "on" handler matching test error-10.1 {try with on ok} { try { list a b c } on ok {} { list d e f } } {d e f} test error-10.2 {try with on 0} { try { list a b c } on 0 {} { list d e f } } {d e f} test error-10.3 {try with on error (using error)} { try { error a b c } on error {} { list d e f } } {d e f} test error-10.4 {try with on error (using return -code)} { try { return -level 0 -code 1 a } on error {} { list d e f } } {d e f} test error-10.5 {try with on error (using throw)} { try { throw c a } on error {} { list d e f } } {d e f} test error-10.6 {try with on 1 (using error)} { try { error a b c } on 1 {} { list d e f } } {d e f} test error-10.7 {try with on return} { try { return [list a b c] } on return {} { list d e f } } {d e f} test error-10.8 {try with on break} { try { break } on break {} { list d e f } } {d e f} test error-10.9 {try with on continue} { try { continue } on continue {} { list d e f } } {d e f} test error-10.10 {try with on for arbitrary (decimal) return code} { try { return -level 0 -code 123456 } on 123456 {} { list d e f } } {d e f} test error-10.11 {try with on for arbitrary (hex) return code} { try { return -level 0 -code 0x123456 } on 0x123456 {} { list d e f } } {d e f} test error-10.12 {try with on for arbitrary return code (mixed number representations)} { try { return -level 0 -code 0x10 } on 16 {} { list d e f } } {d e f} # simple try tests - "trap" handler matching test error-11.1 {try with trap all} { try { throw FOO bar } trap {} {} { list d e f } } {d e f} test error-11.2 {try with trap (exact)} { try { throw FOO bar } trap {FOO} {} { list d e f } } {d e f} test error-11.3 {try with trap (prefix 1)} { try { throw [list FOO A B C D] bar } trap {FOO} {} { list d e f } } {d e f} test error-11.4 {try with trap (prefix 2)} { try { throw [list FOO A B C D] bar } trap {FOO A} {} { list d e f } } {d e f} test error-11.5 {try with trap (prefix 3)} { try { throw [list FOO A B C D] bar } trap {FOO A B} {} { list d e f } } {d e f} test error-11.6 {try with trap (prefix 4)} { try { throw [list FOO A B C D] bar } trap {FOO A B C} {} { list d e f } } {d e f} test error-11.7 {try with trap (exact, 5 elements)} { try { throw [list FOO A B C D] bar } trap {FOO A B C D} {} { list d e f } } {d e f} # simple try tests - variable assignment and result handling test error-12.1 {try with no variable assignment in on handler} { try { throw FOO bar } on error {} { list d e f } } {d e f} test error-12.2 {try with result variable assignment in on handler} { try { throw FOO bar } on error {res} { set res } } {bar} test error-12.3 {try with result variable assignment in on handler, var remains in scope} { try { throw FOO bar } on error {res} { list d e f } set res } {bar} test error-12.4 {try with result/opts variable assignment in on handler} { try { throw FOO bar } on error {res opts} { set r "$res,[dict get $opts -errorcode]" } } {bar,FOO} test error-12.5 {try with result/opts variable assignment in on handler, vars remain in scope} { try { throw FOO bar } on error {res opts} { list d e f } set r "$res,[dict get $opts -errorcode]" } {bar,FOO} test error-12.6 {try result is propagated if no matching handler} { try { list a b c } on error {} { list d e f } } {a b c} test error-12.7 {handler result is propagated if handler executes} { try { throw FOO bar } on error {} { list d e f } } {d e f} # negative case try tests - bad args to try test error-13.1 {try with no arguments} -body { # warning: error message may change try } -returnCodes error -match glob -result {wrong # args: *} test error-13.2 {try with body only (ok)} { try list } {} test error-13.3 {try with missing finally body} -body { # warning: error message may change try list finally } -returnCodes error -match glob -result {wrong # args to finally clause: *} test error-13.4 {try with bad handler keyword} -body { # warning: error message may change try list then a b c } -returnCodes error -match glob -result {bad handler *} test error-13.5 {try with partial handler #1} -body { # warning: error message may change try list on } -returnCodes error -match glob -result {wrong # args to on clause: *} test error-13.6 {try with partial handler #2} -body { # warning: error message may change try list on error } -returnCodes error -match glob -result {wrong # args to on clause: *} test error-13.7 {try with partial handler #3} -body { # warning: error message may change try list on error {em opts} } -returnCodes error -match glob -result {wrong # args to on clause: *} test error-13.8 {try with multiple handlers and finally (ok)} { try list on error {} {} trap {} {} {} finally {} } {} test error-13.9 {last handler body can't be a fallthrough #1} -body { try list on error {} {} on break {} - } -returnCodes error -result {last non-finally clause must not have a body of "-"} test error-13.10 {last handler body can't be a fallthrough #2} -body { try list on error {} {} on break {} - finally { list d e f } } -returnCodes error -result {last non-finally clause must not have a body of "-"} # try tests - multiple handlers (left-to-right matching, only one runs) test error-14.1 {try with multiple handlers (only one matches) #1} { try { throw FOO bar } on ok {} { list a b c } trap FOO {} { list d e f } } {d e f} test error-14.2 {try with multiple handlers (only one matches) #2} { try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c } } {d e f} test error-14.3 {try with multiple handlers (only one matches) #3} { try { throw FOO bar } on break {} { list x y z } trap FOO {} { list d e f } on ok {} { list a b c } } {d e f} test error-14.4 {try with multiple matching handlers (only the first in left-to-right order runs) #1} { try { throw FOO bar } on error {} { list a b c } trap FOO {} { list d e f } } {a b c} test error-14.5 {try with multiple matching handlers (only the first in left-to-right order runs) #2} { try { throw FOO bar } trap FOO {} { list d e f } on error {} { list a b c } } {d e f} test error-14.6 {try with multiple matching handlers (only the first in left-to-right order runs) #3} { try { throw FOO bar } trap {} {} { list d e f } on 1 {} { list a b c } } {d e f} test error-14.7 {try with multiple matching handlers (only the first in left-to-right order runs) #4} { try { throw FOO bar } on 1 {} { list a b c } trap {} {} { list d e f } } {a b c} test error-14.8 {try with handler-of-last-resort "trap {}"} { try { throw FOO bar } trap FOX {} { list a b c } trap {} {} { list d e f } } {d e f} test error-14.9 {try with handler-of-last-resort "on error"} { try { foo } trap FOX {} { list a b c } on error {} { list d e f } } {d e f} # try tests - propagation (no matching handlers) test error-15.1 {try with no handler (ok result propagates)} { try { list a b c } } {a b c} test error-15.2 {try with no matching handler (ok result propagates)} { try { list a b c } on error {} { list d e f } } {a b c} test error-15.3 {try with no handler (error result propagates)} -body { try { throw FOO bar } } -returnCodes error -result {bar} test error-15.4 {try with no matching handler (error result propagates)} -body { try { throw FOO bar } trap FOX {} { list a b c } } -returnCodes error -result {bar} test error-15.5 {try with no handler (return result propagates)} -body { try { return bar } } -returnCodes 2 -result {bar} test error-15.6 {try with no matching handler (break result propagates)} -body { try { if {1} break } on error {} { list a b c } } -returnCodes 3 -result {} test error-15.7 {try with no matching handler (unknown integer result propagates)} -body { try { return -level 0 -code 123456 } trap {} {} { list a b c } } -returnCodes 123456 -result {} foreach level {0 1 2 3} { foreach code {0 1 2 3 4 5} { # Following cases have different -errorinfo; avoid false alarms # TODO: examine whether these difference are as they ought to be. if {$level == 0 && $code == 1} continue foreach extras {{} {-bar soom}} { test error-15.8.$level.$code.[llength $extras] {[try] coverage} { set script {return -level $level -code $code {*}$extras foo} catch $script m1 o1 catch {try $script} m2 o2 set o1 [lsort -stride 2 $o1] set o2 [lsort -stride 2 $o2] expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"} } ok test error-15.9.$level.$code.[llength $extras] {[try] coverage} { set script {return -level $level -code $code {*}$extras foo} catch $script m1 o1 catch {try $script finally {}} m2 o2 set o1 [lsort -stride 2 $o1] set o2 [lsort -stride 2 $o2] expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"} } ok test error-15.10.$level.$code.[llength $extras] {[try] coverage} { set script {return -level $level -code $code {*}$extras foo} catch $script m1 o1 catch {try $script on $code {x y} {return -options $y $x}} m2 o2 set o1 [lsort -stride 2 $o1] set o2 [lsort -stride 2 $o2] expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"} } ok } } } # try tests - propagation (exceptions in handlers, exception chaining) test error-16.1 {try with successfully executed handler} { try { throw FOO bar } trap FOO {} { list a b c } } {a b c} test error-16.2 {try with exception (error) in handler} -body { try { throw FOO bar } trap FOO {} { throw BAR foo } } -returnCodes error -result {foo} test error-16.3 {try with exception (return) in handler} -body { try { throw FOO bar } trap FOO {} { return BAR } } -returnCodes 2 -result {BAR} test error-16.4 {try with exception (break) in handler #1} -body { try { throw FOO bar } trap FOO {} { break } } -returnCodes 3 -result {} test error-16.5 {try with exception (break) in handler #2} { for { set i 5 } { $i < 10 } { incr i } { try { throw FOO bar } trap FOO {} { break } } set i } {5} test error-16.6 {try with variable assignment and propagation #1} { # Ensure that the handler variables preserve the exception off the # try-body, and are not modified by the exception off the handler catch { try { throw FOO bar } trap FOO {em} { throw BAR baz } } set em } {bar} test error-16.7 {try with variable assignment and propagation #2} { catch { try { throw FOO bar } trap FOO {em opts} { throw BAR baz } } list $em [dict get $opts -errorcode] } {bar FOO} test error-16.8 {exception chaining (try=ok, handler=error)} -body { #FIXME is the intent of this test correct? catch { try { list a b c } on ok {em opts} { throw BAR baz } } tryem tryopts list $opts [dict get $tryopts -during] } -match pairwise -result equal test error-16.9 {exception chaining (try=error, handler=error)} -body { # The exception off the handler should chain to the exception off the # try-body (using the -during option) catch { try { throw FOO bar } trap {} {em opts} { throw BAR baz } } tryem tryopts list $opts [dict get $tryopts -during] } -match pairwise -result equal test error-16.10 {no exception chaining when handler is successful} { catch { try { throw FOO bar } trap {} {em opts} { list d e f } } tryem tryopts dict exists $tryopts -during } {0} test error-16.11 {no exception chaining when handler is a non-error exception} { catch { try { throw FOO bar } trap {} {em opts} { break } } tryem tryopts dict exists $tryopts -during } {0} test error-16.12 {compiled try with successfully executed handler} { apply {{} { try { throw FOO bar } trap FOO {} { list a b c } }} } {a b c} test error-16.13 {compiled try with exception (error) in handler} -body { apply {{} { try { throw FOO bar } trap FOO {} { throw BAR foo } }} } -returnCodes error -result {foo} test error-16.14 {compiled try with exception (return) in handler} -body { apply {{} { list [catch { try { throw FOO bar } trap FOO {} { return BAR } } msg] $msg }} } -result {2 BAR} test error-16.15 {compiled try with exception (break) in handler} { apply {{} { for { set i 5 } { $i < 10 } { incr i } { try { throw FOO bar } trap FOO {} { break } } return $i }} } {5} test error-16.16 {compiled try with exception (continue) in handler} { apply {{} { for { set i 5 } { $i < 10 } { incr i } { try { throw FOO bar } trap FOO {} { continue } incr i 20 } return $i }} } {10} test error-16.17 {compiled try with variable assignment and propagation #1} { # Ensure that the handler variables preserve the exception off the # try-body, and are not modified by the exception off the handler apply {{} { catch { try { throw FOO bar } trap FOO {em} { throw BAR baz } } return $em }} } {bar} test error-16.18 {compiled try with variable assignment and propagation #2} { apply {{} { catch { try { throw FOO bar } trap FOO {em opts} { throw BAR baz } } list $em [dict get $opts -errorcode] }} } {bar FOO} test error-16.19 {compiled try exception chaining (try=ok, handler=error)} -body { #FIXME is the intent of this test correct? apply {{} { catch { try { list a b c } on ok {em opts} { throw BAR baz } } tryem tryopts list $opts [dict get $tryopts -during] }} } -match pairwise -result equal test error-16.20 {compiled try exception chaining (try=error, handler=error)} -body { # The exception off the handler should chain to the exception off the # try-body (using the -during option) apply {{} { catch { try { throw FOO bar } trap {} {em opts} { throw BAR baz } } tryem tryopts list $opts [dict get $tryopts -during] }} } -match pairwise -result equal test error-16.21 {compiled try exception chaining (try=error, finally=error)} { # The exception off the handler should chain to the exception off the # try-body (using the -during option) apply {{} { catch { try { throw FOO bar } finally { throw BAR baz } } tryem tryopts dict get $tryopts -during -errorcode }} } FOO test error-16.22 {compiled try: no exception chaining when handler is successful} { apply {{} { catch { try { throw FOO bar } trap {} {em opts} { list d e f } } tryem tryopts dict exists $tryopts -during }} } {0} test error-16.23 {compiled try: no exception chaining when handler is a non-error exception} { apply {{} { catch { try { throw FOO bar } trap {} {em opts} { break } } tryem tryopts dict exists $tryopts -during }} } {0} test error-16.24 {compiled try exception chaining (try=ok, handler=error, finally=error)} -body { apply {{} { catch { try { list a b c } on ok {em opts} { throw BAR baz } finally { throw DING dong } } tryem tryopts list $opts [dict get $tryopts -during -during] }} } -match pairwise -result equal test error-16.25 {compiled try exception chaining (all errors)} -body { apply {{} { catch { try { throw FOO bar } on error {em opts} { throw BAR baz } finally { throw DING dong } } tryem tryopts list $opts [dict get $tryopts -during -during] }} } -match pairwise -result equal # try tests - finally test error-17.1 {finally always runs (try with ok result)} { set RES {} try { list a b c } finally { set RES done } set RES } {done} test error-17.2 {finally always runs (try with error result)} { set RES {} catch { try { throw FOO bar } finally { set RES done } } set RES } {done} test error-17.3 {finally always runs (try with matching handler)} { set RES {} try { throw FOO bar } trap FOO {} { list a b c } finally { set RES done } set RES } {done} test error-17.4 {finally always runs (try with exception in handler)} { set RES {} catch { try { throw FOO bar } trap FOO {} { throw BAR baz } finally { set RES done } } set RES } {done} test error-17.5 {successful finally doesn't modify try outcome (try=ok)} { try { list a b c } finally { list d e f } } {a b c} test error-17.6 {successful finally doesn't modify try outcome (try=return)} -body { try { return c } finally { list d e f } } -returnCodes 2 -result {c} test error-17.7 {successful finally doesn't modify try outcome (try=error)} -body { try { error bar } finally { list d e f } } -returnCodes 1 -result {bar} test error-17.8 {successful finally doesn't modify handler outcome (handler=ok)} { try { throw FOO bar } trap FOO {} { list a b c } finally { list d e f } } {a b c} test error-17.9 {successful finally doesn't modify handler outcome (handler=error)} -body { try { throw FOO bar } trap FOO {} { throw BAR baz } finally { list d e f } } -returnCodes error -result {baz} test error-17.10 {successful finally doesn't affect variable assignment} { catch { try { throw FOO bar } trap FOO {em opts} { list d e f } finally { list d e f } } result list $em $result } {bar {d e f}} test error-17.11 {successful finally doesn't affect variable assignment or propagation} { catch { try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { list d e f } } list $em [dict get $opts -errorcode] } {bar FOO} # try tests - propagation (exceptions in finally, exception chaining) test error-18.1 {try (ok) with exception in finally (error)} -body { try { list a b c } finally { throw BAR foo } } -returnCodes error -result {foo} test error-18.2 {try (error) with exception in finally (break)} -body { try { throw FOO bar } finally { break } } -returnCodes 3 -result {} test error-18.3 {try (ok) with handler (ok) and exception in finally (error)} -body { try { list a b c } on ok {} { list d e f } finally { throw BAR foo } } -returnCodes error -result {foo} test error-18.4 {try (error) with exception in handler (error) and in finally (arb code)} -body { try { throw FOO bar } on error {} { throw BAR baz } finally { return -level 0 -code 99 zing } } -returnCodes 99 -result {zing} test error-18.5 {exception in finally doesn't affect variable assignment} { catch { try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { throw BAZ zing } } list $em [dict get $opts -errorcode] } {bar FOO} test error-18.6 {exception chaining in finally (try=ok)} -body { catch { list a b c } em expopts catch { try { list a b c } finally { throw BAR foo } } em opts list $expopts [dict get $opts -during] } -match pairwise -result equal test error-18.7 {exception chaining in finally (try=error)} { catch { try { throw FOO bar } finally { throw BAR baz } } em opts dict get $opts -during -errorcode } {FOO} test error-18.8 {exception chaining in finally (try=ok, handler=ok)} { catch { try { list a b c } on ok {} { list d e f } finally { throw BAR baz } } em opts list [dict get $opts -during -code] [dict exists $opts -during -during] } {0 0} test error-18.9 {exception chaining in finally (try=error, handler=ok)} { catch { try { throw FOO bar } on error {} { list d e f } finally { throw BAR baz } } em opts list [dict get $opts -during -code] [dict exists $opts -during -during] } {0 0} test error-18.10 {exception chaining in finally (try=error, handler=error)} { catch { try { throw FOO bar } on error {} { throw BAR baz } finally { throw BAR baz } } em opts list [dict get $opts -during -errorcode] [dict get $opts -during -during -errorcode] } {BAR FOO} test error-18.11 {no exception chaining if finally produces a non-error exception} { catch { try { throw FOO bar } on error {} { throw BAR baz } finally { break } } em opts dict exists $opts -during } {0} test error-18.12 {variable assignment unaffected by exception in finally} { catch { try { throw FOO bar } on error {em opts} { list a b c } finally { throw BAR baz } } list $em [dict get $opts -errorcode] } {bar FOO} # try tests - fall-through body cases test error-19.1 {try with fallthrough body #1} { set RES {} try { list a b c } on ok { set RES 0 } - on error {} { set RES 1 } set RES } {1} test error-19.2 {try with fallthrough body #2} { set RES {} try { throw FOO bar } trap BAR {} { } trap FOO {} - trap {} {} { set RES foo } on error {} { set RES err } set RES } {foo} test error-19.3 {try with cascade fallthrough} { set RES {} try { throw FOO bar } trap FOO {} - trap BAR {} - trap {} {} { set RES trap } on error {} { set RES err } set RES } {trap} test error-19.4 {multiple unrelated fallthroughs #1} { set RES {} try { throw FOO bar } trap FOO {} - trap BAR {} { set RES foo } trap {} {} - on error {} { set RES err } set RES } {foo} test error-19.5 {multiple unrelated fallthroughs #2} { set RES {} try { throw BAZ zing } trap FOO {} - trap BAR {} { set RES foo } trap {} {} - on error {} { set RES err } set RES } {err} proc addmsg msg { variable RES lappend RES $msg } test error-19.6 {compiled try executes all clauses} -setup { set RES {} } -body { apply {{} { try { addmsg a throw bar hello } trap bar {res opt} { addmsg b } finally { addmsg c } addmsg d } ::tcl::test::error} } -cleanup { unset RES } -result {a b c d} test error-19.7 {compiled try executes all clauses} -setup { set RES {} } -body { apply {{} { try { addmsg a } on error {res opt} { addmsg b } on ok {} { addmsg c } finally { addmsg d } addmsg e } ::tcl::test::error} } -cleanup { unset RES } -result {a c d e} test error-19.8 {compiled try executes all clauses} -setup { set RES {} } -body { apply {{} { try { addmsg a throw bar hello } trap bar {res opt} { addmsg b } addmsg c } ::tcl::test::error} } -cleanup { unset RES } -result {a b c} test error-19.9 {compiled try executes all clauses} -setup { set RES {} } -body { apply {{} { try { addmsg a } on error {res opt} { addmsg b } on ok {} { addmsg c } addmsg d } ::tcl::test::error} } -cleanup { unset RES } -result {a c d} test error-19.10 {compiled try with chained clauses} -setup { set RES {} } -body { list [apply {{} { try { return good } on return {res} - on ok {res} { addmsg ok addmsg $res return handler } finally { addmsg finally } } ::tcl::test::error}] $RES } -cleanup { unset RES } -result {handler {ok good finally}} test error-19.11 {compiled try and errors on variable write} -setup { set RES {} } -body { apply {{} { array set foo {bar boo} set bar unset catch { try { addmsg body return a } on return {bar foo} { addmsg handler return b } finally { addmsg finally,$bar } } msg addmsg $msg } ::tcl::test::error} } -cleanup { unset RES } -result {body finally,a {can't set "foo": variable is array}} test error-19.12 {interpreted try and errors on variable write} -setup { set RES {} } -body { apply {try { array set foo {bar boo} set bar unset catch { $try { addmsg body return a } on return {bar foo} { addmsg handler return b } finally { addmsg finally,$bar } } msg addmsg $msg } ::tcl::test::error} try } -cleanup { unset RES } -result {body finally,a {can't set "foo": variable is array}} test error-19.13 {compiled try and errors on variable write} -setup { set RES {} } -body { apply {{} { array set foo {bar boo} set bar unset catch { try { addmsg body return a } on return {bar foo} - on error {bar foo} { addmsg handler return b } finally { addmsg finally,$bar } } msg addmsg $msg } ::tcl::test::error} } -cleanup { unset RES } -result {body finally,a {can't set "foo": variable is array}} rename addmsg {} # FIXME test what vars get set on fallthough ... what is the correct behavior? # It would seem appropriate to set at least those for the matching handler and # the executed body; possibly for each handler we fall through as well? # negative case try tests - bad "on" handler test error-20.1 {bad code name in on handler} -body { try { list a b c } on err {} {} } -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} test error-20.2 {bad code value in on handler} -body { try { list a b c } on 34985723094872345 {} {} } -returnCodes error -match glob -result {bad completion code "34985723094872345": must be ok, error, return, break, continue*, or an integer} test error-21.1 {memory leaks in try: Bug 2910044} memory { leaktest { try {string repeat x 10} on ok {} {} } } 0 test error-21.2 {memory leaks in try: Bug 2910044} memory { leaktest { try {error [string repeat x 10]} on error {} {} } } 0 test error-21.3 {memory leaks in try: Bug 2910044} memory { leaktest { try {throw FOO [string repeat x 10]} trap FOO {} {} } } 0 test error-21.4 {memory leaks in try: Bug 2910044} memory { leaktest { try {string repeat x 10} } } 0 test error-21.5 {memory leaks in try: Bug 2910044} memory { leaktest { try {string repeat x 10} on ok {} {} finally {string repeat y 10} } } 0 test error-21.6 {memory leaks in try: Bug 2910044} memory { leaktest { try { error [string repeat x 10] } on error {} {} finally { string repeat y 10 } } } 0 test error-21.7 {memory leaks in try: Bug 2910044} memory { leaktest { try { throw FOO [string repeat x 10] } trap FOO {} {} finally { string repeat y 10 } } } 0 test error-21.8 {memory leaks in try: Bug 2910044} memory { leaktest { try {string repeat x 10} finally {string repeat y 10} } } 0 test error-21.9 {Bug cee90e4e88} { # Just don't panic. apply {{} {try {} on ok {} - on return {} {}}} } {} # negative case try tests - bad "trap" handler # what is the effect if we attempt to trap an errorcode that is not a list? # nested try # catch inside try # no tests for bad varslist? # -errorcode but code!=1 doesn't trap # throw negative case tests (no args, too many args, etc) } namespace delete ::tcl::test::error # cleanup catch {rename p ""} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/eval.test0000644000175000017500000000437114554262142014641 0ustar sergeisergei# Commands covered: eval # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test eval-1.1 {single argument} { eval {format 22} } 22 test eval-1.2 {multiple arguments} { set a {$b} set b xyzzy eval format $a } xyzzy test eval-1.3 {single argument} { eval concat a b c d e f g } {a b c d e f g} test eval-2.1 {error: not enough arguments} {catch eval} 1 test eval-2.2 {error: not enough arguments} { catch eval msg set msg } {wrong # args: should be "eval arg ?arg ...?"} test eval-2.3 {error in eval'ed command} { catch {eval {error "test error"}} } 1 test eval-2.4 {error in eval'ed command} { catch {eval {error "test error"}} msg set msg } {test error} test eval-2.5 {error in eval'ed command: setting errorInfo} { catch {eval { set a 1 error "test error" }} msg set ::errorInfo } "test error while executing \"error \"test error\"\" (\"eval\" body line 3) invoked from within \"eval { set a 1 error \"test error\" }\"" test eval-3.1 {eval and pure lists} { eval [list list 1 2 3 4 5] } {1 2 3 4 5} test eval-3.2 {concatenating eval and pure lists} { eval [list list 1] [list 2 3 4 5] } {1 2 3 4 5} test eval-3.3 {eval and canonical lists} { set cmd [list list 1 2 3 4 5] # Force existence of utf-8 rep set dummy($cmd) $cmd unset dummy eval $cmd } {1 2 3 4 5} test eval-3.4 {concatenating eval and canonical lists} { set cmd [list list 1] set cmd2 [list 2 3 4 5] # Force existence of utf-8 rep set dummy($cmd) $cmd set dummy($cmd2) $cmd2 unset dummy eval $cmd $cmd2 } {1 2 3 4 5} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/event.test0000644000175000017500000007030414554262142015032 0ustar sergeisergei# This file contains a collection of tests for the procedures in the file # tclEvent.c, which includes the "update", and "vwait" Tcl commands. Sourcing # this file into Tcl runs the tests and generates output for errors. No # output means no errors were found. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] } testConstraint testfilehandler [llength [info commands testfilehandler]] testConstraint testexithandler [llength [info commands testexithandler]] testConstraint testfilewait [llength [info commands testfilewait]] testConstraint exec [llength [info commands exec]] testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] test event-1.1 {Tcl_CreateFileHandler, reading} -setup { testfilehandler close set result "" } -constraints {testfilehandler notOSX} -body { testfilehandler create 0 readable off testfilehandler clear 0 testfilehandler oneevent lappend result [testfilehandler counts 0] testfilehandler fillpartial 0 update idletasks testfilehandler oneevent lappend result [testfilehandler counts 0] testfilehandler oneevent lappend result [testfilehandler counts 0] } -cleanup { testfilehandler close } -result {{0 0} {1 0} {2 0}} test event-1.2 {Tcl_CreateFileHandler, writing} -setup { testfilehandler close set result "" } -constraints {testfilehandler nonPortable} -body { # This test is non-portable because on some systems (e.g., SunOS 4.1.3) # pipes seem to be writable always. testfilehandler create 0 off writable testfilehandler clear 0 testfilehandler oneevent lappend result [testfilehandler counts 0] testfilehandler fillpartial 0 testfilehandler oneevent lappend result [testfilehandler counts 0] testfilehandler fill 0 testfilehandler oneevent lappend result [testfilehandler counts 0] } -cleanup { testfilehandler close } -result {{0 1} {0 2} {0 2}} test event-1.3 {Tcl_DeleteFileHandler} -setup { testfilehandler close set result "" } -constraints {testfilehandler nonPortable} -body { testfilehandler create 2 disabled disabled testfilehandler create 1 readable writable testfilehandler create 0 disabled disabled testfilehandler fillpartial 1 testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler create 1 off off testfilehandler oneevent lappend result [testfilehandler counts 1] } -cleanup { testfilehandler close } -result {{0 1} {1 1} {1 2} {0 0}} test event-2.1 {Tcl_DeleteFileHandler} -setup { testfilehandler close set result "" } -constraints {testfilehandler nonPortable} -body { testfilehandler create 2 disabled disabled testfilehandler create 1 readable writable testfilehandler fillpartial 1 testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler create 1 off off testfilehandler oneevent lappend result [testfilehandler counts 1] } -cleanup { testfilehandler close } -result {{0 1} {1 1} {1 2} {0 0}} test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} -setup { testfilehandler close set result "" } -constraints {testfilehandler nonPortable} -body { testfilehandler create 0 readable writable testfilehandler fillpartial 0 testfilehandler oneevent lappend result [testfilehandler counts 0] testfilehandler close testfilehandler create 0 readable writable testfilehandler oneevent lappend result [testfilehandler counts 0] } -cleanup { testfilehandler close } -result {{0 1} {0 0}} test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off} -setup { testfilehandler close } -constraints {testfilehandler} -body { testfilehandler create 1 readable writable testfilehandler fillpartial 1 testfilehandler windowevent testfilehandler counts 1 } -cleanup { testfilehandler close } -result {0 0} test event-4.1 {FileHandlerEventProc, race between event and disabling} -setup { update testfilehandler close set result "" } -constraints {testfilehandler nonPortable} -body { testfilehandler create 2 disabled disabled testfilehandler create 1 readable writable testfilehandler fillpartial 1 testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler create 1 disabled disabled testfilehandler oneevent lappend result [testfilehandler counts 1] } -cleanup { testfilehandler close } -result {{0 1} {1 1} {1 2} {0 0}} test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} -setup { update testfilehandler close } -constraints {testfilehandler nonPortable} -body { testfilehandler create 1 readable writable testfilehandler create 2 readable writable testfilehandler fillpartial 1 testfilehandler fillpartial 2 testfilehandler oneevent set result "" lappend result [testfilehandler counts 1] [testfilehandler counts 2] testfilehandler windowevent lappend result [testfilehandler counts 1] [testfilehandler counts 2] } -cleanup { testfilehandler close } -result {{0 0} {0 1} {0 0} {0 1}} update test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} -setup { catch {rename bgerror {}} } -body { proc bgerror msg { global errorInfo errorCode x lappend x [list $msg $errorInfo $errorCode] } after idle {error "a simple error"} after idle {open non_existent} after idle {set errorInfo foobar; set errorCode xyzzy} set x {} update idletasks regsub -all [file join {} non_existent] $x "non_existent" } -cleanup { rename bgerror {} } -result {{{a simple error} {a simple error while executing "error "a simple error"" ("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory while executing "open non_existent" ("after" script)} {POSIX ENOENT {no such file or directory}}}} test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} -setup { catch {rename bgerror {}} } -body { proc bgerror msg { global x lappend x $msg return -code break } after idle {error "a simple error"} after idle {open non_existent} set x {} update idletasks return $x } -cleanup { rename bgerror {} } -result {{a simple error}} test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup { variable x proc demo args {variable x done} variable target [list [namespace which demo] x] proc trial args {variable target; string length $target} trace add execution demo enter [namespace code trial] variable save [interp bgerror {}] interp bgerror {} $target } -body { after 0 {error bar} vwait [namespace which -variable x] } -cleanup { interp bgerror {} $save unset x target save rename demo {} rename trial {} } -result {} test event-5.3.1 {Default [interp bgerror] handler} -body { ::tcl::Bgerror } -returnCodes error -match glob -result {*msg options*} test event-5.4 {Default [interp bgerror] handler} -body { ::tcl::Bgerror {} } -returnCodes error -match glob -result {*msg options*} test event-5.5 {Default [interp bgerror] handler} -body { ::tcl::Bgerror {} {} {} } -returnCodes error -match glob -result {*msg options*} test event-5.6 {Default [interp bgerror] handler} -body { ::tcl::Bgerror {} {} } -returnCodes error -match glob -result {*-level*} test event-5.7 {Default [interp bgerror] handler} -body { ::tcl::Bgerror {} {-level foo} } -returnCodes error -match glob -result {*expected integer*} test event-5.8 {Default [interp bgerror] handler} -body { ::tcl::Bgerror {} {-level 0} } -returnCodes error -match glob -result {*-code*} test event-5.9 {Default [interp bgerror] handler} -body { ::tcl::Bgerror {} {-level 0 -code ok} } -returnCodes error -match glob -result {*expected integer*} test event-5.10 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror {} {-level 0 -code 0} return $::res } -cleanup { rename bgerror {} } -result {} test event-5.11 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 1} return $::res } -cleanup { rename bgerror {} } -result {msg} test event-5.12 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 2} return $::res } -cleanup { rename bgerror {} } -result {command returned bad code: 2} test event-5.13 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 3} return $::res } -cleanup { rename bgerror {} } -result {invoked "break" outside of a loop} test event-5.14 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 4} return $::res } -cleanup { rename bgerror {} } -result {invoked "continue" outside of a loop} test event-5.15 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 5} return $::res } -cleanup { rename bgerror {} } -result {command returned bad code: 5} test event-6.1 {BgErrorDeleteProc procedure} -setup { catch {interp delete foo} interp create foo set erroutfile [makeFile Unmodified err.out] } -body { foo eval [list set erroutfile $erroutfile] foo eval { proc bgerror args { global errorInfo erroutfile set f [open $erroutfile r+] seek $f 0 end puts $f "$args $errorInfo" close $f } after 100 {error "first error"} after 100 {error "second error"} } after 100 {interp delete foo} after 200 update set f [open $erroutfile r] set result [read $f] close $f return $result } -cleanup { removeFile $erroutfile } -result {Unmodified } test event-7.1 {bgerror / regular} { set errRes {} proc bgerror {err} { global errRes set errRes $err } after 0 {error err1} vwait errRes return $errRes } err1 test event-7.2 {bgerror / accumulation} { set errRes {} proc bgerror {err} { global errRes lappend errRes $err } after 0 {error err1} after 0 {error err2} after 0 {error err3} update return $errRes } {err1 err2 err3} test event-7.3 {bgerror / accumulation / break} { set errRes {} proc bgerror {err} { global errRes lappend errRes $err return -code break "skip!" } after 0 {error err1} after 0 {error err2} after 0 {error err3} update return $errRes } err1 test event-7.4 {tkerror is nothing special anymore to tcl} -body { set errRes {} # we don't just rename bgerror to empty because it could then # be autoloaded... proc bgerror {err} { global errRes lappend errRes "bg:$err" } proc tkerror {err} { global errRes lappend errRes "tk:$err" } after 0 {error err1} update return $errRes } -cleanup { rename tkerror {} } -result bg:err1 test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} -body { exec [interpreter] << { after 1000 error hello after 2000 set a 0 vwait a } } -constraints {exec} -returnCodes error -result {hello while executing "error hello" ("after" script)} test event-7.6 {safe hidden bgerror fallback} -setup { variable result {} interp create -safe safe } -body { safe alias puts puts safe alias result ::append [namespace which -variable result] safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}} safe hide bgerror safe eval after 0 error foo update return $result } -cleanup { interp delete safe } -result {foo NONE foo while executing "error foo" ("after" script) } test event-7.7 {safe hidden bgerror fallback} -setup { variable result {} interp create -safe safe } -body { safe alias puts puts safe alias result ::append [namespace which -variable result] safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}} safe hide bgerror safe eval {proc bgerror m {error bar soom baz}} safe eval after 0 error foo update return $result } -cleanup { interp delete safe } -result {foo NONE foo while executing "error foo" ("after" script) } # someday : add a test checking that when there is no bgerror, an error msg # goes to stderr ideally one would use sub interp and transfer a fake stderr # to it, unfortunately the current interp tcl API does not allow that. The # other option would be to use fork a test but it then becomes more a # file/exec test than a bgerror test. # end of bgerror tests catch {rename bgerror {}} test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; exit" flush $child set result [read $child] close $child return $result } {even 6 even 4 odd 41 } test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 41" puts $child "testexithandler create 16; exit" flush $child set result [read $child] close $child return $result } {even 16 even 6 even 4 } test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 4" puts $child "testexithandler create 16; exit" flush $child set result [read $child] close $child return $result } {even 16 even 6 odd 41 } test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 6" puts $child "testexithandler create 16; exit" flush $child set result [read $child] close $child return $result } {even 16 even 4 odd 41 } test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler delete 41" puts $child "testexithandler create 16; exit" flush $child set result [read $child] close $child return $result } {even 16 } test event-10.1 {Tcl_Exit procedure} {stdio} { set child [open |[list [interpreter]] r+] puts $child "exit 3" list [catch {close $child} msg] $msg [lindex $::errorCode 0] \ [lindex $::errorCode 2] } {1 {child process exited abnormally} CHILDSTATUS 3} test event-11.1 {Tcl_VwaitCmd procedure} -returnCodes error -body { vwait } -result {wrong # args: should be "vwait name"} test event-11.2 {Tcl_VwaitCmd procedure} -returnCodes error -body { vwait a b } -result {wrong # args: should be "vwait name"} test event-11.3 {Tcl_VwaitCmd procedure} -setup { catch {unset x} } -body { set x 1 vwait x(1) } -returnCodes error -result {can't trace "x(1)": variable isn't array} test event-11.4 {Tcl_VwaitCmd procedure} -setup { foreach i [after info] { after cancel $i } after 10; update; # On Mac make sure update won't take long } -body { after 100 {set x x-done} after 200 {set y y-done} after 400 {set z z-done} after idle {set q q-done} set x before set y before set z before set q before list [vwait y] $x $y $z $q } -cleanup { foreach i [after info] { after cancel $i } } -result {{} x-done y-done before q-done} test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -setup { set test1file [makeFile "" test1] } -constraints {socket} -body { set f1 [open $test1file w] proc accept {s args} { puts $s foobar close $s } set s1 [socket -server accept -myaddr 127.0.0.1 0] after 1000 set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]] close $s1 set x 0 set y 0 set z 0 fileevent $s2 readable {incr z} vwait z fileevent $f1 writable {incr x; if {$y == 3} {set z done}} fileevent $s2 readable {incr y; if {$x == 3} {set z done}} vwait z close $f1 close $s2 list $x $y $z } -cleanup { removeFile $test1file } -result {3 3 done} test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} { set test1file [makeFile "" test1] set test2file [makeFile "" test2] set f1 [open $test1file w] set f2 [open $test2file w] set x 0 set y 0 set z 0 update fileevent $f1 writable {incr x; if {$y == 3} {set z done}} fileevent $f2 writable {incr y; if {$x == 3} {set z done}} vwait z close $f1 close $f2 removeFile $test1file removeFile $test2file list $x $y $z } {3 3 done} test event-11.7 {Bug 16828b3744} { after idle { set ::t::v 1 namespace delete ::t } namespace eval ::t { vwait ::t::v } } {} test event-11.8 {Bug 16828b3744} -setup { oo::class create A { variable continue method start {} { after idle [self] destroy set continue 0 vwait [namespace current]::continue } destructor { set continue 1 } } } -body { [A new] start } -cleanup { A destroy } -result {} test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body { update a b } -result {wrong # args: should be "update ?idletasks?"} test event-12.2 {Tcl_UpdateCmd procedure} -returnCodes error -body { update bogus } -result {bad option "bogus": must be idletasks} test event-12.3 {Tcl_UpdateCmd procedure} -setup { foreach i [after info] { after cancel $i } } -body { after 500 {set x after} after idle {set y after} after idle {set z "after, y = $y"} set x before set y before set z before update idletasks list $x $y $z } -cleanup { foreach i [after info] { after cancel $i } } -result {before after {after, y = after}} test event-12.4 {Tcl_UpdateCmd procedure} -setup { foreach i [after info] { after cancel $i } } -body { after 10; update; # On Mac make sure update won't take long after 200 {set x x-done} after 600 {set y y-done} after idle {set z z-done} set x before set y before set z before after 300 update list $x $y $z } -cleanup { foreach i [after info] { after cancel $i } } -result {x-done before z-done} test event-13.1 {Tcl_WaitForFile procedure, readable} -setup { foreach i [after info] { after cancel $i } testfilehandler close } -constraints {testfilehandler} -body { after 100 set x timeout testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 readable 0] update list $result $x } -cleanup { testfilehandler close foreach i [after info] { after cancel $i } } -result {{} {no timeout}} test event-13.2 {Tcl_WaitForFile procedure, readable} -setup { foreach i [after info] { after cancel $i } testfilehandler close } -constraints testfilehandler -body { after 100 set x timeout testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 readable 100] update list $result $x } -cleanup { testfilehandler close foreach i [after info] { after cancel $i } } -result {{} timeout} test event-13.3 {Tcl_WaitForFile procedure, readable} -setup { foreach i [after info] { after cancel $i } testfilehandler close } -constraints testfilehandler -body { after 100 set x timeout testfilehandler create 1 off off testfilehandler fillpartial 1 set x "no timeout" set result [testfilehandler wait 1 readable 100] update list $result $x } -cleanup { testfilehandler close foreach i [after info] { after cancel $i } } -result {readable {no timeout}} test event-13.4 {Tcl_WaitForFile procedure, writable} -setup { foreach i [after info] { after cancel $i } testfilehandler close } -constraints {testfilehandler nonPortable} -body { after 100 set x timeout testfilehandler create 1 off off testfilehandler fill 1 set x "no timeout" set result [testfilehandler wait 1 writable 0] update list $result $x } -cleanup { testfilehandler close foreach i [after info] { after cancel $i } } -result {{} {no timeout}} test event-13.5 {Tcl_WaitForFile procedure, writable} -setup { foreach i [after info] { after cancel $i } testfilehandler close } -constraints {testfilehandler nonPortable} -body { after 100 set x timeout testfilehandler create 1 off off testfilehandler fill 1 set x "no timeout" set result [testfilehandler wait 1 writable 100] update list $result $x } -cleanup { testfilehandler close foreach i [after info] { after cancel $i } } -result {{} timeout} test event-13.6 {Tcl_WaitForFile procedure, writable} -setup { foreach i [after info] { after cancel $i } testfilehandler close } -constraints testfilehandler -body { after 100 set x timeout testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 writable 100] update list $result $x } -cleanup { testfilehandler close foreach i [after info] { after cancel $i } } -result {writable {no timeout}} test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} -setup { foreach i [after info] { after cancel $i } testfilehandler close } -constraints testfilehandler -body { after 100 lappend x timeout after idle lappend x idle testfilehandler create 1 off off set x "" set result [list [testfilehandler wait 1 readable 200] $x] update lappend result $x } -cleanup { testfilehandler close foreach i [after info] { after cancel $i } } -result {{} {} {timeout idle}} test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait { set f [open "|sleep 2" r] set result "" lappend result [testfilewait $f readable 100] lappend result [testfilewait $f readable -1] close $f return $result } {{} readable} test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } foreach i [after info] {after cancel $i} testfilehandler close } -constraints {testfilehandler unix} -body { after 100 set x timeout testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 readable 0] update list $result $x } -cleanup { testfilehandler close foreach chan $chanList {close $chan} foreach i [after info] {after cancel $i} } -result {{} {no timeout}} test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } foreach i [after info] {after cancel $i} testfilehandler close } -constraints {testfilehandler unix} -body { after 100 set x timeout testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 readable 100] update list $result $x } -cleanup { testfilehandler close foreach chan $chanList {close $chan} foreach i [after info] {after cancel $i} } -result {{} timeout} test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } foreach i [after info] {after cancel $i} testfilehandler close } -constraints {testfilehandler unix} -body { after 100 set x timeout testfilehandler create 1 off off testfilehandler fillpartial 1 set x "no timeout" set result [testfilehandler wait 1 readable 100] update list $result $x } -cleanup { testfilehandler close foreach chan $chanList {close $chan} foreach i [after info] {after cancel $i} } -result {readable {no timeout}} test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } foreach i [after info] {after cancel $i} testfilehandler close } -constraints {testfilehandler unix nonPortable} -body { after 100 set x timeout testfilehandler create 1 off off testfilehandler fill 1 set x "no timeout" set result [testfilehandler wait 1 writable 0] update list $result $x } -cleanup { testfilehandler close foreach chan $chanList {close $chan} foreach i [after info] {after cancel $i} } -result {{} {no timeout}} test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } foreach i [after info] {after cancel $i} testfilehandler close } -constraints {testfilehandler unix nonPortable} -body { after 100 set x timeout testfilehandler create 1 off off testfilehandler fill 1 set x "no timeout" set result [testfilehandler wait 1 writable 100] update list $result $x } -cleanup { testfilehandler close foreach chan $chanList {close $chan} foreach i [after info] {after cancel $i} } -result {{} timeout} test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } foreach i [after info] {after cancel $i} testfilehandler close } -constraints {testfilehandler unix} -body { after 100 set x timeout testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 writable 100] update list $result $x } -cleanup { testfilehandler close foreach chan $chanList {close $chan} foreach i [after info] {after cancel $i} } -result {writable {no timeout}} test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } foreach i [after info] {after cancel $i} testfilehandler close } -constraints {testfilehandler unix} -body { after 100 lappend x timeout after idle lappend x idle testfilehandler create 1 off off set x "" set result [list [testfilehandler wait 1 readable 200] $x] update lappend result $x } -cleanup { testfilehandler close foreach chan $chanList {close $chan} foreach i [after info] {after cancel $i} } -result {{} {} {timeout idle}} test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } -constraints {testfilewait unix} -body { set f [open "|sleep 2" r] set result "" lappend result [testfilewait $f readable 100] lappend result [testfilewait $f readable -1] close $f return $result } -cleanup { foreach chan $chanList {close $chan} } -result {{} readable} # cleanup foreach i [after info] { after cancel $i } ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/exec.test0000644000175000017500000006727114554262142014646 0ustar sergeisergei# Commands covered: exec # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # There is no point in running Valgrind on cases where [exec] forks but then # fails and the child process doesn't go through full cleanup. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } source [file join [file dirname [info script]] tcltests.tcl] # Some skips when running in a macOS CI environment testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}] unset -nocomplain path # Utilities that are like Bourne shell stalwarts, but cross-platform. set path(echo) [makeFile { puts -nonewline [lindex $argv 0] foreach str [lrange $argv 1 end] { puts -nonewline " $str" } puts {} exit } echo] set path(echo2) [makeFile { puts stdout [join $argv] puts stderr [lindex $argv 1] exit } echo2] set path(cat) [makeFile { if {$argv eq ""} { set argv - } fconfigure stdout -translation binary foreach name $argv { if {$name eq "-"} { set f stdin } elseif {[catch {open $name r} f] != 0} { puts stderr $f continue } fconfigure $f -translation binary while {[eof $f] == 0} { puts -nonewline [read $f] } if {$f ne "stdin"} { close $f } } exit } cat] set path(wc) [makeFile { set data [read stdin] set lines [regsub -all "\n" $data {} dummy] set words [regsub -all "\[^ \t\n]+" $data {} dummy] set chars [string length $data] puts [format "%8.d%8.d%8.d" $lines $words $chars] exit } wc] set path(sh) [makeFile { if {[lindex $argv 0] ne "-c"} { error "sh: unexpected arguments $argv" } set cmd [lindex $argv 1] lappend cmd ";" set newcmd {} foreach arg $cmd { if {$arg eq ";"} { exec >@stdout 2>@stderr [info nameofexecutable] {*}$newcmd set newcmd {} continue } if {$arg eq "1>&2"} { set arg >@stderr } lappend newcmd $arg } exit } sh] set path(sh2) [makeFile { if {[lindex $argv 0] ne "-c"} { error "sh: unexpected arguments $argv" } set cmd [lindex $argv 1] lappend cmd ";" set newcmd {} foreach arg $cmd { if {$arg eq ";"} { exec -ignorestderr >@stdout [info nameofexecutable] {*}$newcmd set newcmd {} continue } lappend newcmd $arg } exit } sh2] set path(sleep) [makeFile { after [expr {$argv*1000}] exit } sleep] set path(exit) [makeFile { exit $argv } exit] proc readfile filename { set f [open $filename] set d [read $f] close $f return [string trimright $d \n] } # ---------------------------------------------------------------------- # Basic operations. test exec-1.1 {basic exec operation} {exec} { exec [interpreter] $path(echo) a b c } "a b c" test exec-1.2 {pipelining} {exec stdio} { exec [interpreter] $path(echo) a b c d | [interpreter] $path(cat) | [interpreter] $path(cat) } "a b c d" test exec-1.3 {pipelining} {exec stdio} { set a [exec [interpreter] $path(echo) a b c d | [interpreter] $path(cat) | [interpreter] $path(wc)] list [scan $a "%d %d %d" b c d] $b $c } {3 1 4} set arg {12345678901234567890123456789012345678901234567890} set arg "$arg$arg$arg$arg$arg$arg" test exec-1.4 {long command lines} {exec} { exec [interpreter] $path(echo) $arg } $arg set arg {} # I/O redirection: input from Tcl command. test exec-2.1 {redirecting input from immediate source} {exec stdio} { exec [interpreter] $path(cat) << "Sample text" } {Sample text} test exec-2.2 {redirecting input from immediate source} {exec stdio} { exec << "Sample text" [interpreter] $path(cat) | [interpreter] $path(cat) } {Sample text} test exec-2.3 {redirecting input from immediate source} {exec stdio} { exec [interpreter] $path(cat) << "Sample text" | [interpreter] $path(cat) } {Sample text} test exec-2.4 {redirecting input from immediate source} {exec stdio} { exec [interpreter] $path(cat) | [interpreter] $path(cat) << "Sample text" } {Sample text} test exec-2.5 {redirecting input from immediate source} {exec} { exec [interpreter] $path(cat) "< external conversion did not occur # before writing out the temp file. quotenonascii [exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"] } -cleanup { encoding system $sysenc rename quotenonascii {} } -result {\u00e9\u00e0\u00fc\u00f1} # I/O redirection: output to file. set path(gorp.file) [makeFile {} gorp.file] file delete $path(gorp.file) test exec-3.1 {redirecting output to file} {exec} { exec [interpreter] $path(echo) "Some simple words" > $path(gorp.file) exec [interpreter] $path(cat) $path(gorp.file) } "Some simple words" test exec-3.2 {redirecting output to file} {exec stdio} { exec [interpreter] $path(echo) "More simple words" | >$path(gorp.file) [interpreter] $path(cat) | [interpreter] $path(cat) exec [interpreter] $path(cat) $path(gorp.file) } "More simple words" test exec-3.3 {redirecting output to file} {exec stdio} { exec > $path(gorp.file) [interpreter] $path(echo) "Different simple words" | [interpreter] $path(cat) | [interpreter] $path(cat) exec [interpreter] $path(cat) $path(gorp.file) } "Different simple words" test exec-3.4 {redirecting output to file} {exec} { exec [interpreter] $path(echo) "Some simple words" >$path(gorp.file) exec [interpreter] $path(cat) $path(gorp.file) } "Some simple words" test exec-3.5 {redirecting output to file} {exec} { exec [interpreter] $path(echo) "First line" >$path(gorp.file) exec [interpreter] $path(echo) "Second line" >> $path(gorp.file) exec [interpreter] $path(cat) $path(gorp.file) } "First line\nSecond line" test exec-3.6 {redirecting output to file} {exec} { exec [interpreter] $path(echo) "First line" >$path(gorp.file) exec [interpreter] $path(echo) "Second line" >>$path(gorp.file) exec [interpreter] $path(cat) $path(gorp.file) } "First line\nSecond line" test exec-3.7 {redirecting output to file} {exec} { set f [open $path(gorp.file) w] puts $f "Line 1" flush $f exec [interpreter] $path(echo) "More text" >@ $f exec [interpreter] $path(echo) >@$f "Even more" puts $f "Line 3" close $f exec [interpreter] $path(cat) $path(gorp.file) } "Line 1\nMore text\nEven more\nLine 3" # I/O redirection: output and stderr to file. file delete $path(gorp.file) test exec-4.1 {redirecting output and stderr to file} {exec} { exec [interpreter] $path(echo) "test output" >& $path(gorp.file) exec [interpreter] $path(cat) $path(gorp.file) } "test output" test exec-4.2 {redirecting output and stderr to file} {exec} { list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" >&$path(gorp.file)] \ [exec [interpreter] $path(cat) $path(gorp.file)] } {{} {foo bar}} test exec-4.3 {redirecting output and stderr to file} {exec} { exec [interpreter] $path(echo) "first line" > $path(gorp.file) list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" >>&$path(gorp.file)] \ [exec [interpreter] $path(cat) $path(gorp.file)] } "{} {first line\nfoo bar}" test exec-4.4 {redirecting output and stderr to file} {exec} { set f [open $path(gorp.file) w] puts $f "Line 1" flush $f exec [interpreter] $path(echo) "More text" >&@ $f exec [interpreter] $path(echo) >&@$f "Even more" puts $f "Line 3" close $f exec [interpreter] $path(cat) $path(gorp.file) } "Line 1\nMore text\nEven more\nLine 3" test exec-4.5 {redirecting output and stderr to file} {exec} { set f [open $path(gorp.file) w] puts $f "Line 1" flush $f exec >&@ $f [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" exec >&@$f [interpreter] $path(sh) -c "\"$path(echo)\" xyzzy 1>&2" puts $f "Line 3" close $f exec [interpreter] $path(cat) $path(gorp.file) } "Line 1\nfoo bar\nxyzzy\nLine 3" # I/O redirection: input from file. if {[testConstraint exec]} { exec [interpreter] $path(echo) "Just a few thoughts" > $path(gorp.file) } test exec-5.1 {redirecting input from file} {exec} { exec [interpreter] $path(cat) < $path(gorp.file) } {Just a few thoughts} test exec-5.2 {redirecting input from file} {exec stdio} { exec [interpreter] $path(cat) | [interpreter] $path(cat) < $path(gorp.file) } {Just a few thoughts} test exec-5.3 {redirecting input from file} {exec stdio} { exec [interpreter] $path(cat) < $path(gorp.file) | [interpreter] $path(cat) } {Just a few thoughts} test exec-5.4 {redirecting input from file} {exec stdio} { exec < $path(gorp.file) [interpreter] $path(cat) | [interpreter] $path(cat) } {Just a few thoughts} test exec-5.5 {redirecting input from file} {exec} { exec [interpreter] $path(cat) <$path(gorp.file) } {Just a few thoughts} test exec-5.6 {redirecting input from file} -constraints {exec} -body { set f [open $path(gorp.file) r] exec [interpreter] $path(cat) <@ $f } -cleanup { close $f } -result {Just a few thoughts} test exec-5.7 {redirecting input from file} -constraints {exec} -body { set f [open $path(gorp.file) r] exec <@$f [interpreter] $path(cat) } -cleanup { close $f } -result {Just a few thoughts} # I/O redirection: standard error through a pipeline. test exec-6.1 {redirecting stderr through a pipeline} {exec stdio} { exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar" |& [interpreter] $path(cat) } "foo bar" test exec-6.2 {redirecting stderr through a pipeline} {exec stdio} { exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" |& [interpreter] $path(cat) } "foo bar" test exec-6.3 {redirecting stderr through a pipeline} {exec stdio} { exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \ |& [interpreter] $path(sh) -c "\"$path(echo)\" second msg 1>&2 ; \"$path(cat)\"" |& [interpreter] $path(cat) } "second msg\nfoo bar" # I/O redirection: combinations. set path(gorp.file2) [makeFile {} gorp.file2] test exec-7.1 {multiple I/O redirections} {exec} { exec << "command input" > $path(gorp.file2) [interpreter] $path(cat) < $path(gorp.file) exec [interpreter] $path(cat) $path(gorp.file2) } {Just a few thoughts} test exec-7.2 {multiple I/O redirections} {exec} { exec < $path(gorp.file) << "command input" [interpreter] $path(cat) } {command input} # Long input to command and output from command. set a "0123456789 xxxxxxxxx abcdefghi ABCDEFGHIJK\n" set a [concat $a $a $a $a] set a [concat $a $a $a $a] set a [concat $a $a $a $a] set a [concat $a $a $a $a] test exec-8.1 {long input and output} {exec} { exec [interpreter] $path(cat) << $a } $a # More than 20 arguments to exec. test exec-8.2 {long input and output} {exec} { exec [interpreter] $path(echo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 } {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23} # Commands that return errors. test exec-9.1 {commands returning errors} {exec notValgrind} { set x [catch {exec gorp456} msg] list $x [string tolower $msg] [string tolower $errorCode] } {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}} test exec-9.2 {commands returning errors} {exec notValgrind} { string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode] } {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}} test exec-9.3 {commands returning errors} -constraints {exec stdio} -body { exec [interpreter] $path(sleep) 1 | [interpreter] $path(exit) 43 | [interpreter] $path(sleep) 1 } -returnCodes error -result {child process exited abnormally} test exec-9.4 {commands returning errors} -constraints {exec stdio} -body { exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar" } -returnCodes error -result {foo bar child process exited abnormally} test exec-9.5 {commands returning errors} -constraints {exec stdio notValgrind} -body { exec gorp456 | [interpreter] echo a b c } -returnCodes error -result {couldn't execute "gorp456": no such file or directory} test exec-9.6 {commands returning errors} -constraints {exec} -body { exec [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2" } -returnCodes error -result {error msg} test exec-9.7 {commands returning errors} -constraints {exec stdio nonPortable} -body { # This test can fail easily on multiprocessor machines exec [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2 ; \"$path(sleep)\" 1" \ | [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2 ; \"$path(sleep)\" 1" } -returnCodes error -result {error msg error msg} set path(err) [makeFile {} err] test exec-9.8 {commands returning errors} -constraints {exec} -setup { set f [open $path(err) w] puts $f { puts stdout out puts stderr err } close $f } -body { exec [interpreter] $path(err) } -returnCodes error -result {out err} # Errors in executing the Tcl command, as opposed to errors in the processes # that are invoked. test exec-10.1 {errors in exec invocation} -constraints {exec} -body { exec } -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"} test exec-10.2 {errors in exec invocation} -constraints {exec} -body { exec | cat } -returnCodes error -result {illegal use of | or |& in command} test exec-10.3 {errors in exec invocation} -constraints {exec} -body { exec cat | } -returnCodes error -result {illegal use of | or |& in command} test exec-10.4 {errors in exec invocation} -constraints {exec} -body { exec cat | | cat } -returnCodes error -result {illegal use of | or |& in command} test exec-10.5 {errors in exec invocation} -constraints {exec} -body { exec cat | |& cat } -returnCodes error -result {illegal use of | or |& in command} test exec-10.6 {errors in exec invocation} -constraints {exec} -body { exec cat |& } -returnCodes error -result {illegal use of | or |& in command} test exec-10.7 {errors in exec invocation} -constraints {exec} -body { exec cat < } -returnCodes error -result {can't specify "<" as last word in command} test exec-10.8 {errors in exec invocation} -constraints {exec} -body { exec cat > } -returnCodes error -result {can't specify ">" as last word in command} test exec-10.9 {errors in exec invocation} -constraints {exec} -body { exec cat << } -returnCodes error -result {can't specify "<<" as last word in command} test exec-10.10 {errors in exec invocation} -constraints {exec} -body { exec cat >> } -returnCodes error -result {can't specify ">>" as last word in command} test exec-10.11 {errors in exec invocation} -constraints {exec} -body { exec cat >& } -returnCodes error -result {can't specify ">&" as last word in command} test exec-10.12 {errors in exec invocation} -constraints {exec} -body { exec cat >>& } -returnCodes error -result {can't specify ">>&" as last word in command} test exec-10.13 {errors in exec invocation} -constraints {exec} -body { exec cat >@ } -returnCodes error -result {can't specify ">@" as last word in command} test exec-10.14 {errors in exec invocation} -constraints {exec} -body { exec cat <@ } -returnCodes error -result {can't specify "<@" as last word in command} test exec-10.15 {errors in exec invocation} -constraints {exec} -body { exec cat < a/b/c } -returnCodes error -result {couldn't read file "a/b/c": no such file or directory} test exec-10.16 {errors in exec invocation} -constraints {exec} -body { exec cat << foo > a/b/c } -returnCodes error -result {couldn't write file "a/b/c": no such file or directory} test exec-10.17 {errors in exec invocation} -constraints {exec} -body { exec cat << foo > a/b/c } -returnCodes error -result {couldn't write file "a/b/c": no such file or directory} set f [open $path(gorp.file) w] test exec-10.18 {errors in exec invocation} -constraints {exec} -body { exec cat <@ $f } -returnCodes error -result "channel \"$f\" wasn't opened for reading" close $f set f [open $path(gorp.file) r] test exec-10.19 {errors in exec invocation} -constraints {exec} -body { exec cat >@ $f } -returnCodes error -result "channel \"$f\" wasn't opened for writing" close $f test exec-10.20 {errors in exec invocation} -constraints {exec notValgrind} -body { exec ~non_existent_user/foo/bar } -returnCodes error -result {user "non_existent_user" doesn't exist} test exec-10.21 {errors in exec invocation} -constraints {exec notValgrind} -body { exec [interpreter] true | ~xyzzy_bad_user/x | false } -returnCodes error -result {user "xyzzy_bad_user" doesn't exist} test exec-10.22 {errors in exec invocation} -constraints {exec notValgrind} -body { exec echo test > ~non_existent_user/foo/bar } -returnCodes error -result {user "non_existent_user" doesn't exist} # Commands in background. test exec-11.1 {commands in background} {exec} { set time [time {exec [interpreter] $path(sleep) 2 &}] expr {[lindex $time 0] < 1000000} } 1 test exec-11.2 {commands in background} -constraints {exec} -body { exec [interpreter] $path(echo) a &b } -result {a &b} test exec-11.3 {commands in background} {exec} { llength [exec [interpreter] $path(sleep) 1 &] } 1 test exec-11.4 {commands in background} {exec stdio} { llength [exec [interpreter] $path(sleep) 1 | [interpreter] $path(sleep) 1 | [interpreter] $path(sleep) 1 &] } 3 test exec-11.5 {commands in background} {exec} { set f [open $path(gorp.file) w] puts $f [list catch [list exec [info nameofexecutable] $path(echo) foo &]] close $f exec [interpreter] $path(gorp.file) } foo # Make sure that background commands are properly reaped when they # eventually die. if {[testConstraint exec] && [testConstraint nonPortable]} { after 1300 exec [interpreter] $path(sleep) 1 } test exec-12.1 {reaping background processes} {exec unix nonPortable} { for {set i 0} {$i < 20} {incr i} { exec echo foo > /dev/null & } after 1000 catch {exec ps | fgrep "echo foo" | fgrep -v fgrep | wc} msg lindex $msg 0 } 0 test exec-12.2 {reaping background processes} {exec unix nonPortable} { exec sleep 2 | sleep 2 | sleep 2 & catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg set x [lindex $msg 0] after 3000 catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg list $x [lindex $msg 0] } {3 0} test exec-12.3 {reaping background processes} {exec unix nonPortable} { exec sleep 1000 & exec sleep 1000 & set x [exec ps | fgrep "sleep" | fgrep -v fgrep] set pids {} foreach i [split $x \n] { lappend pids [lindex $i 0] } foreach i $pids { catch {exec kill -STOP $i} } catch {exec ps | fgrep "sleep" | fgrep -v fgrep | wc} msg set x [lindex $msg 0] foreach i $pids { catch {exec kill -KILL $i} } catch {exec ps | fgrep "sleep" | fgrep -v fgrep | wc} msg list $x [lindex $msg 0] } {2 0} # Make sure "errorCode" is set correctly. test exec-13.1 {setting errorCode variable} {exec} { list [catch {exec [interpreter] $path(cat) < a/b/c} msg] [string tolower $errorCode] } {1 {posix enoent {no such file or directory}}} test exec-13.2 {setting errorCode variable} {exec} { list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode] } {1 {posix enoent {no such file or directory}}} test exec-13.3 {setting errorCode variable} {exec notValgrind} { set x [catch {exec _weird_cmd_} msg] list $x [string tolower $msg] [lindex $errorCode 0] \ [string tolower [lrange $errorCode 2 end]] } {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}} test exec-13.4 {extended exit result codes} -setup { set tmp [makeFile {exit 0x00000101} tmpfile.exec-13.4] } -constraints {win} -body { list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}] } -cleanup { removeFile $tmp } -result {1 {CHILDSTATUS {} 257}} test exec-13.5 {extended exit result codes: max value} -setup { set tmp [makeFile {exit 0x3fffffff} tmpfile.exec-13.5] } -constraints {win} -body { list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}] } -cleanup { removeFile $tmp } -result {1 {CHILDSTATUS {} 1073741823}} test exec-13.6 {extended exit result codes: signalled} -setup { set tmp [makeFile {exit 0xC0000016} tmpfile.exec-13.6] } -constraints {win} -body { list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}] } -cleanup { removeFile $tmp } -result {1 {CHILDKILLED {} SIGABRT SIGABRT}} # Switches before the first argument test exec-14.1 {-keepnewline switch} {exec} { exec -keepnewline [interpreter] $path(echo) foo } "foo\n" test exec-14.2 {-keepnewline switch} -constraints {exec} -body { exec -keepnewline } -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"} test exec-14.3 {unknown switch} -constraints {exec} -body { exec -gorp } -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, or --} test exec-14.4 {-- switch} -constraints {exec notValgrind} -body { exec -- -gorp } -returnCodes error -result {couldn't execute "-gorp": no such file or directory} test exec-14.5 {-ignorestderr switch} {exec} { # Alas, the use of -ignorestderr is buried here :-( exec [interpreter] $path(sh2) -c [list $path(echo2) foo bar] 2>@1 } "foo bar\nbar" # Redirecting standard error separately from standard output test exec-15.1 {standard error redirection} {exec} { exec [interpreter] $path(echo) "First line" > $path(gorp.file) list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" 2> $path(gorp.file)] \ [exec [interpreter] $path(cat) $path(gorp.file)] } {{} {foo bar}} test exec-15.2 {standard error redirection} {exec stdio} { list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \ | [interpreter] $path(echo) biz baz >$path(gorp.file) 2> $path(gorp.file2)] \ [exec [interpreter] $path(cat) $path(gorp.file)] \ [exec [interpreter] $path(cat) $path(gorp.file2)] } {{} {biz baz} {foo bar}} test exec-15.3 {standard error redirection} {exec stdio} { list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \ | [interpreter] $path(echo) biz baz 2>$path(gorp.file) > $path(gorp.file2)] \ [exec [interpreter] $path(cat) $path(gorp.file)] \ [exec [interpreter] $path(cat) $path(gorp.file2)] } {{} {foo bar} {biz baz}} test exec-15.4 {standard error redirection} {exec} { set f [open $path(gorp.file) w] puts $f "Line 1" flush $f exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" 2>@ $f puts $f "Line 3" close $f readfile $path(gorp.file) } {Line 1 foo bar Line 3} test exec-15.5 {standard error redirection} {exec} { exec [interpreter] $path(echo) "First line" > "$path(gorp.file)" exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>> "$path(gorp.file)" readfile $path(gorp.file) } {First line foo bar} test exec-15.6 {standard error redirection} {exec stdio} { exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" > "$path(gorp.file2)" 2> "$path(gorp.file)" \ >& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] $path(echo) biz baz list [readfile $path(gorp.file)] [readfile $path(gorp.file2)] } {{biz baz} {foo bar}} test exec-15.7 {standard error redirection 2>@1} {exec stdio} { # This redirects stderr output into normal result output from exec exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>@1 } {foo bar} test exec-16.1 {flush output before exec} {exec} { set f [open $path(gorp.file) w] puts $f "First line" exec [interpreter] $path(echo) "Second line" >@ $f puts $f "Third line" close $f readfile $path(gorp.file) } {First line Second line Third line} test exec-16.2 {flush output before exec} {exec} { set f [open $path(gorp.file) w] puts $f "First line" exec [interpreter] << {puts stderr {Second line}} >&@ $f > $path(gorp.file2) puts $f "Third line" close $f readfile $path(gorp.file) } {First line Second line Third line} test exec-17.1 {inheriting standard I/O} -constraints {exec} -setup { set path(script) [makeFile {} script] set f [open $path(script) w] puts $f [list lassign [list \ [info nameofexecutable] $path(gorp.file) $path(echo) $path(sleep) \ ] exe file echo sleep] puts $f { close stdout set f [open $file w] catch {exec $exe $echo foobar &} exec $exe $sleep 2 close $f } close $f } -body { catch {exec [interpreter] $path(script)} result list $result [readfile $path(gorp.file)] } -cleanup { removeFile $path(script) } -result {{} foobar} test exec-18.1 {exec deals with weird file names} -body { set path(fooblah) [makeFile {contents} "foo\[\{blah"] exec [interpreter] $path(cat) $path(fooblah) } -constraints {exec} -cleanup { removeFile $path(fooblah) } -result contents test exec-18.2 {exec cat deals with weird file names} -body { # This is cross-platform, but the cat isn't predictably correct on # Windows. set path(fooblah) [makeFile {contents} "foo\[\{blah"] exec cat $path(fooblah) } -constraints {exec tempNotWin} -cleanup { removeFile $path(fooblah) } -result contents # Note that this test cannot be adapted to work on Windows; that platform has # no kernel support for an analog of O_APPEND. OTOH, that means we can assume # that there is a POSIX shell... # # This test also fails in some cases when building with macOS test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosxCI} -setup { set tmpfile [makeFile {0} tmpfile.exec-19.1] } -body { # Note that we have to allow for the current contents of the temporary # file, which is why the result is 14 and not 12 exec /bin/sh -c \ {for a in 1 2 3; do sleep 1; echo $a; done} >>$tmpfile & exec /bin/sh -c \ {for a in 4 5 6; do sleep 1; echo $a >&2; done} 2>>$tmpfile & exec /bin/sh -c \ {for a in a b c; do sleep 1; echo $a; done} >>$tmpfile & exec /bin/sh -c \ {for a in d e f; do sleep 1; echo $a >&2; done} 2>>$tmpfile & # The above four shell invocations take about 3 seconds to finish, so allow # 5s (in case the machine is busy) after 5000 # Check that no bytes have got lost through mixups with overlapping # appends, which is only guaranteed to work when we set O_APPEND on the # file descriptor in the [exec >>...] file size $tmpfile } -cleanup { removeFile $tmpfile } -result 26 # Tests to ensure batch files and .CMD (Bug 9ece99d58b) # can be executed on Windows test exec-20.0 {exec .bat file} -constraints {win} -body { set log [makeFile {} exec20.log] exec [makeFile "echo %1> $log" exec20.bat] "Testing exec-20.0" viewFile $log } -result "\"Testing exec-20.0\"" test exec-20.1 {exec .CMD file} -constraints {win} -body { set log [makeFile {} exec201.log] exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1" viewFile $log } -result "\"Testing exec-20.1\"" # ---------------------------------------------------------------------- # cleanup foreach file {gorp.file gorp.file2 echo echo2 cat wc sh sh2 sleep exit err} { removeFile $file } unset -nocomplain path ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/execute.test0000644000175000017500000010767014554262142015362 0ustar sergeisergei# This file contains tests for the tclExecute.c source file. Tests appear in # the same order as the C code that they test. The set of tests is currently # incomplete since it currently includes only new tests for code changed for # the addition of Tcl namespaces. Other execution-related tests appear in # several other test files including namespace.test, basic.test, eval.test, # for.test, etc. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} catch {unset x} catch {unset y} catch {unset msg} testConstraint testobj [expr { [llength [info commands testobj]] && [llength [info commands testdoubleobj]] && [llength [info commands teststringobj]] }] testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint testexprlongobj [llength [info commands testexprlongobj]] if {[namespace which -command testbumpinterpepoch] eq ""} { proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } } # Tests for the omnibus TclExecuteByteCode function: # INST_DONE not tested # INST_PUSH1 not tested # INST_PUSH4 not tested # INST_POP not tested # INST_DUP not tested # INST_INVOKE_STK4 not tested # INST_INVOKE_STK1 not tested # INST_EVAL_STK not tested # INST_EXPR_STK not tested # INST_LOAD_SCALAR1 test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} { proc foo {} { set x 1 return $x } foo } 1 test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} { # Bug: 2243 set body {} for {set i 0} {$i < 129} {incr i} { append body "set x$i x\n" } append body { set y 1 return $y } proc foo {} $body foo } 1 test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} { proc foo {} { set x 1 unset x return $x } list [catch {foo} msg] $msg } {1 {can't read "x": no such variable}} # INST_LOAD_SCALAR4 test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} { set body {} for {set i 0} {$i < 256} {incr i} { append body "set x$i x\n" } append body { set y 1 return $y } proc foo {} $body foo } 1 test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} { set body {} for {set i 0} {$i < 256} {incr i} { append body "set x$i x\n" } append body { set y 1 unset y return $y } proc foo {} $body list [catch {foo} msg] $msg } {1 {can't read "y": no such variable}} # INST_LOAD_SCALAR_STK not tested # INST_LOAD_ARRAY4 not tested # INST_LOAD_ARRAY1 not tested # INST_LOAD_ARRAY_STK not tested # INST_LOAD_STK not tested # INST_STORE_SCALAR4 not tested # INST_STORE_SCALAR1 not tested # INST_STORE_SCALAR_STK not tested # INST_STORE_ARRAY4 not tested # INST_STORE_ARRAY1 not tested # INST_STORE_ARRAY_STK not tested # INST_STORE_STK not tested # INST_INCR_SCALAR1 not tested # INST_INCR_SCALAR_STK not tested # INST_INCR_STK not tested # INST_INCR_ARRAY1 not tested # INST_INCR_ARRAY_STK not tested # INST_INCR_SCALAR1_IMM not tested # INST_INCR_SCALAR_STK_IMM not tested # INST_INCR_STK_IMM not tested # INST_INCR_ARRAY1_IMM not tested # INST_INCR_ARRAY_STK_IMM not tested # INST_JUMP1 not tested # INST_JUMP4 not tested # INST_JUMP_TRUE4 not tested # INST_JUMP_TRUE1 not tested # INST_JUMP_FALSE4 not tested # INST_JUMP_FALSE1 not tested # INST_LOR not tested # INST_LAND not tested # INST_EQ not tested # INST_NEQ not tested # INST_LT not tested # INST_GT not tested # INST_LE not tested # INST_GE not tested # INST_MOD not tested # INST_LSHIFT not tested # INST_RSHIFT not tested # INST_BITOR not tested # INST_BITXOR not tested # INST_BITAND not tested # INST_ADD is partially tested: test execute-3.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} { set x [testintobj set 0 1] expr {$x + 1} } 2 test execute-3.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} { set x [testdoubleobj set 0 1] expr {$x + 1} } 2.0 test execute-3.3 {TclExecuteByteCode, INST_ADD, op1 is double with string} {testobj} { set x [testintobj set 0 1] testobj convert 0 double expr {$x + 1} } 2 test execute-3.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} { set x [teststringobj set 0 1] expr {$x + 1} } 2 test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {$x + 1} } 2.0 test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 + $x} } 2 test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} { set x [testdoubleobj set 0 1] expr {1 + $x} } 2.0 test execute-3.9 {TclExecuteByteCode, INST_ADD, op2 is double with string} {testobj} { set x [testintobj set 0 1] testobj convert 0 double expr {1 + $x} } 2 test execute-3.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} { set x [teststringobj set 0 1] expr {1 + $x} } 2 test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {1 + $x} } 2.0 test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} # INST_SUB is partially tested: test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} { set x [testintobj set 0 1] expr {$x - 1} } 0 test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} { set x [testdoubleobj set 0 1] expr {$x - 1} } 0.0 test execute-3.15 {TclExecuteByteCode, INST_SUB, op1 is double with string} {testobj} { set x [testintobj set 0 1] testobj convert 0 double expr {$x - 1} } 0 test execute-3.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} { set x [teststringobj set 0 1] expr {$x - 1} } 0 test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {$x - 1} } 0.0 test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 - $x} } 0 test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} { set x [testdoubleobj set 0 1] expr {1 - $x} } 0.0 test execute-3.21 {TclExecuteByteCode, INST_SUB, op2 is double with string} {testobj} { set x [testintobj set 0 1] testobj convert 0 double expr {1 - $x} } 0 test execute-3.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} { set x [teststringobj set 0 1] expr {1 - $x} } 0 test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {1 - $x} } 0.0 test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} # INST_MULT is partially tested: test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} { set x [testintobj set 1 1] expr {$x * 1} } 1 test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} { set x [testdoubleobj set 1 2.0] expr {$x * 1} } 2.0 test execute-3.27 {TclExecuteByteCode, INST_MULT, op1 is double with string} {testobj} { set x [testintobj set 1 2] testobj convert 1 double expr {$x * 1} } 2 test execute-3.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} { set x [teststringobj set 1 1] expr {$x * 1} } 1 test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {$x * 1} } 1.0 test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg } {1 {can't use non-numeric string as operand of "*"}} test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} { set x [testintobj set 1 1] expr {1 * $x} } 1 test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} { set x [testdoubleobj set 1 2.0] expr {1 * $x} } 2.0 test execute-3.33 {TclExecuteByteCode, INST_MULT, op2 is double with string} {testobj} { set x [testintobj set 1 2] testobj convert 1 double expr {1 * $x} } 2 test execute-3.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} { set x [teststringobj set 1 1] expr {1 * $x} } 1 test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {1 * $x} } 1.0 test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg } {1 {can't use non-numeric string as operand of "*"}} # INST_DIV is partially tested: test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} { set x [testintobj set 1 1] expr {$x / 1} } 1 test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} { set x [testdoubleobj set 1 2.0] expr {$x / 1} } 2.0 test execute-3.39 {TclExecuteByteCode, INST_DIV, op1 is double with string} {testobj} { set x [testintobj set 1 2] testobj convert 1 double expr {$x / 1} } 2 test execute-3.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} { set x [teststringobj set 1 1] expr {$x / 1} } 1 test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {$x / 1} } 1.0 test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg } {1 {can't use non-numeric string as operand of "/"}} test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} { set x [testintobj set 1 1] expr {2 / $x} } 2 test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {2 / $x} } 2.0 test execute-3.45 {TclExecuteByteCode, INST_DIV, op2 is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {2 / $x} } 2 test execute-3.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} { set x [teststringobj set 1 1] expr {2 / $x} } 2 test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {2 / $x} } 2.0 test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg } {1 {can't use non-numeric string as operand of "/"}} # INST_UPLUS is partially tested: test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} { set x [testintobj set 1 1] expr {+ $x} } 1 test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {+ $x} } 1.0 test execute-3.51 {TclExecuteByteCode, INST_UPLUS, op is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {+ $x} } 1 test execute-3.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} { set x [teststringobj set 1 1] expr {+ $x} } 1 test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {+ $x} } 1.0 test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} # INST_UMINUS is partially tested: test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} { set x [testintobj set 1 1] expr {- $x} } -1 test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {- $x} } -1.0 test execute-3.57 {TclExecuteByteCode, INST_UMINUS, op is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {- $x} } -1 test execute-3.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} { set x [teststringobj set 1 1] expr {- $x} } -1 test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {- $x} } -1.0 test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} # INST_LNOT is partially tested: test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { set x [testintobj set 1 2] expr {! $x} } 0 test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { set x [testintobj set 1 0] expr {! $x} } 1 test execute-3.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {! $x} } 0 test execute-3.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} { set x [testdoubleobj set 1 0.0] expr {! $x} } 1 test execute-3.65 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {! $x} } 0 test execute-3.66 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} { set x [testintobj set 1 0] testobj convert 1 double expr {! $x} } 1 test execute-3.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} { set x [teststringobj set 1 1] expr {! $x} } 0 test execute-3.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} { set x [teststringobj set 1 0] expr {! $x} } 1 test execute-3.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {! $x} } 0 test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} { set x [teststringobj set 1 0.0] expr {! $x} } 1 test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg } {1 {can't use non-numeric string as operand of "!"}} # INST_BITNOT not tested # INST_CALL_BUILTIN_FUNC1 not tested # INST_CALL_FUNC1 not tested # INST_TRY_CVT_TO_NUMERIC is partially tested: test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} { set x [testintobj set 1 1] expr {$x} } 1 test execute-3.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {$x} } 1.0 test execute-3.74 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {$x} } 1 test execute-3.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} { set x [teststringobj set 1 1] expr {$x} } 1 test execute-3.76 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {$x} } 1.0 test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] expr {$x} } foo # INST_BREAK not tested # INST_CONTINUE not tested # INST_FOREACH_START4 not tested # INST_FOREACH_STEP4 not tested # INST_BEGIN_CATCH4 not tested # INST_END_CATCH not tested # INST_PUSH_RESULT not tested # INST_PUSH_RETURN_CODE not tested test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} unset -nocomplain x unset -nocomplain y } -body { namespace eval test_ns_1 { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_1::test_ns_2 { namespace import ::test_ns_1::* } set x "test_ns_1::" set y "test_ns_2::" list [namespace which -command ${x}${y}cmd1] \ [catch {namespace which -command ${x}${y}cmd2} msg] $msg \ [catch {namespace which -command ${x}${y}:cmd2} msg] $msg } -result {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}} test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} unset -nocomplain l } -body { proc foo {} { return "global foo" } namespace eval test_ns_1 { proc whichFoo {} { return [namespace which -command foo] } } set l "" lappend l [test_ns_1::whichFoo] namespace eval test_ns_1 { proc foo {} { return "namespace foo" } } lappend l [test_ns_1::whichFoo] } -result {::foo ::test_ns_1::foo} test execute-4.3 {Tcl_GetCommandFromObj, command never found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} } -body { namespace eval test_ns_1 { proc foo {} { return "namespace foo" } } namespace eval test_ns_1 { proc foo {} { return "namespace foo" } } list [namespace eval test_ns_1 {namespace which -command foo}] \ [rename test_ns_1::foo ""] \ [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg } -result {::test_ns_1::foo {} 0 {}} test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} unset -nocomplain l } -body { proc {} {} {return {}} {} set l {} lindex {} 0 {} } -result {} test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} { proc {} {} {} proc { } {} {} proc p {} { set x {} $x append x { } $x } p } {} test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} { set w {3*5} proc a {obj} {expr $obj} set res "[a $w]:[a $w]" } {15:15} test execute-6.3 {Tcl_ExprObj: don't use cached script bytecode [Bug 1899164]} -setup { proc 0+0 {} {return SCRIPT} } -body { set e { 0+0 } if 1 $e if 1 {expr $e} } -cleanup { rename 0+0 {} } -result 0 test execute-6.4 {TclCompEvalObj: don't use cached expr bytecode [Bug 1899164]} -setup { proc 0+0 {} {return SCRIPT} } -body { set e { 0+0 } if 1 {expr $e} if 1 $e } -cleanup { rename 0+0 {} } -result SCRIPT test execute-6.5 {TclCompEvalObj: bytecode epoch validation} -body { set script { llength {} } set result {} lappend result [if 1 $script] set origName [namespace which llength] rename $origName llength.orig proc $origName {args} {return AHA!} lappend result [if 1 $script] } -cleanup { rename $origName {} rename llength.orig $origName } -result {0 AHA!} test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} -body { proc foo {} {set a 1} set a untouched set result {} lappend result [foo] $a lappend result [if 1 [info body foo]] $a } -cleanup { rename foo {} } -result {1 untouched 1 1} test execute-6.7 {TclCompEvalObj: bytecode context validation} -setup { namespace eval foo {} } -body { set script { llength {} } namespace eval foo { proc llength {args} {return AHA!} } set result {} lappend result [if 1 $script] lappend result [namespace eval foo $script] } -cleanup { namespace delete foo } -result {0 AHA!} test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} -setup { namespace eval foo {} } -body { set script { llength {} } set result {} lappend result [namespace eval foo $script] namespace eval foo { proc llength {args} {return AHA!} } lappend result [namespace eval foo $script] } -cleanup { namespace delete foo } -result {0 AHA!} test execute-6.9 {TclCompEvalObj: bytecode interp validation} -setup { interp create child } -body { set script { llength {} } child eval {proc llength args {return AHA!}} set result {} lappend result [if 1 $script] lappend result [child eval $script] } -cleanup { interp delete child } -result {0 AHA!} test execute-6.10 {TclCompEvalObj: bytecode interp validation} -body { set script { llength {} } interp create child set result {} lappend result [child eval $script] interp delete child interp create child lappend result [child eval $script] } -cleanup { catch {interp delete child} } -result {0 0} test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup { interp create child } -constraints testexprlongobj -body { set e { [llength {}]+1 } set result {} load {} Tcltest child interp alias {} e child testexprlongobj lappend result [e $e] interp delete child interp create child load {} Tcltest child interp alias {} e child testexprlongobj lappend result [e $e] } -cleanup { interp delete child } -result {{This is a result: 1} {This is a result: 1}} test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup { interp create child } -body { set e { [llength {}]+1 } set result {} interp alias {} e child expr lappend result [e $e] interp delete child interp create child interp alias {} e child expr lappend result [e $e] } -cleanup { interp delete child } -result {1 1} test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body { set e { [llength {}]+1 } set result {} lappend result [expr $e] set origName [namespace which llength] rename $origName llength.orig proc $origName {args} {return 1} lappend result [expr $e] } -cleanup { rename $origName {} rename llength.orig $origName } -result {1 2} test execute-6.14 {Tcl_ExprObj: exprcode context validation} -setup { namespace eval foo {} } -body { set e { [llength {}]+1 } namespace eval foo { proc llength {args} {return 1} } set result {} lappend result [expr $e] lappend result [namespace eval foo [list expr $e]] } -cleanup { namespace delete foo } -result {1 2} test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} -setup { namespace eval foo {} } -body { set e { [llength {}]+1 } set result {} lappend result [namespace eval foo [list expr $e]] namespace eval foo { proc llength {args} {return 1} } lappend result [namespace eval foo [list expr $e]] } -cleanup { namespace delete foo } -result {1 2} test execute-6.16 {Tcl_ExprObj: exprcode interp validation} -setup { interp create child } -body { set e { [llength {}]+1 } interp alias {} e child expr child eval {proc llength args {return 1}} set result {} lappend result [expr $e] lappend result [e $e] } -cleanup { interp delete child } -result {1 2} test execute-6.17 {Tcl_ExprObj: exprcode context validation} -body { proc foo e {set v 0; expr $e} proc bar e {set v 1; expr $e} set e { $v } set result {} lappend result [foo $e] lappend result [bar $e] } -cleanup { rename foo {} rename bar {} } -result {0 1} test execute-6.18 {Tcl_ExprObj: exprcode context validation} -body { proc foo e {set v {}; expr $e} proc bar e {set v v; expr $e} set e { [llength $v] } set result {} lappend result [foo $e] lappend result [bar $e] } -cleanup { rename foo {} rename bar {} } -result {0 1} test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} { set x 0x100000000 expr {$x && 1} } 1 test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} { expr {0x100000000 && 1} } 1 test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} { expr {1 && 0x100000000} } 1 test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} { expr {wide(0x100000000) && 1} } 1 test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} { expr {1 && wide(0x100000000)} } 1 test execute-7.5 {Wide int handling in INST_EQ} { expr {4 == (wide(1)+wide(3))} } 1 test execute-7.6 {Wide int handling in INST_EQ and [incr]} { set x 399999999999 expr {400000000000 == [incr x]} } 1 # wide ints have more bits of precision than doubles, but we convert anyway test execute-7.7 {Wide int handling in INST_EQ and [incr]} { set x [expr {wide(1)<<62}] set y [expr {$x+1}] expr {double($x) == double($y)} } 1 test execute-7.8 {Wide int conversions can change sign} longIs32bit { set x 0x80000000 expr {int($x) < wide($x)} } 1 test execute-7.9 {Wide int handling in INST_MOD} { expr {(wide(1)<<60) % ((wide(47)<<45)-1)} } 316659348800185 test execute-7.10 {Wide int handling in INST_MOD} { expr {((wide(1)<<60)-1) % 0x400000000} } 17179869183 test execute-7.11 {Wide int handling in INST_LSHIFT} { expr {wide(42) << 30} } 45097156608 test execute-7.12 {Wide int handling in INST_LSHIFT} { expr {12345678901 << 3} } 98765431208 test execute-7.13 {Wide int handling in INST_RSHIFT} { expr {0x543210febcda9876 >> 7} } 47397893236700464 test execute-7.14 {Wide int handling in INST_RSHIFT} { expr {wide(0x9876543210febcda) >> 7} } -58286587177206407 test execute-7.15 {Wide int handling in INST_BITOR} { expr {wide(0x9876543210febcda) | 0x543210febcda9876} } -2560765885044310786 test execute-7.16 {Wide int handling in INST_BITXOR} { expr {wide(0x9876543210febcda) ^ 0x543210febcda9876} } -3727778945703861076 test execute-7.17 {Wide int handling in INST_BITAND} { expr {wide(0x9876543210febcda) & 0x543210febcda9876} } 1167013060659550290 test execute-7.18 {Wide int handling in INST_ADD} { expr {wide(0x7fffffff) + wide(0x7fffffff)} } 4294967294 test execute-7.19 {Wide int handling in INST_ADD} { expr {0x7fffffff + wide(0x7fffffff)} } 4294967294 test execute-7.20 {Wide int handling in INST_ADD} { expr {wide(0x7fffffff) + 0x7fffffff} } 4294967294 test execute-7.21 {Wide int handling in INST_ADD} { expr {double(0x7fffffff) + wide(0x7fffffff)} } 4294967294.0 test execute-7.22 {Wide int handling in INST_ADD} { expr {wide(0x7fffffff) + double(0x7fffffff)} } 4294967294.0 test execute-7.23 {Wide int handling in INST_SUB} { expr {0x123456789a - 0x20406080a} } 69530054800 test execute-7.24 {Wide int handling in INST_MULT} { expr {0x123456789a * 193} } 15090186251290 test execute-7.25 {Wide int handling in INST_DIV} { expr {0x123456789a / 193} } 405116546 test execute-7.26 {Wide int handling in INST_UPLUS} { set x 0x123456871234568 expr {+ $x} } 81985533099853160 test execute-7.27 {Wide int handling in INST_UMINUS} { set x 0x123456871234568 expr {- $x} } -81985533099853160 test execute-7.28 {Wide int handling in INST_LNOT} { set x 0x123456871234568 expr {! $x} } 0 test execute-7.29 {Wide int handling in INST_BITNOT} { set x 0x123456871234568 expr {~ $x} } -81985533099853161 test execute-7.30 {Wide int handling in function call} { set x 0x12345687123456 incr x expr {log($x) == log(double($x))} } 1 test execute-7.31 {Wide int handling in abs()} { set x 0xa23456871234568 incr x set y 0x123456871234568 concat [expr {abs($x)}] [expr {abs($y)}] } {730503879441204585 81985533099853160} test execute-7.32 {Wide int handling} longIs32bit { expr {int(1024 * 1024 * 1024 * 1024)} } 0 test execute-7.33 {Wide int handling} longIs32bit { expr {int(0x1 * 1024 * 1024 * 1024 * 1024)} } 0 test execute-7.34 {Wide int handling} { expr {wide(0x1) * 1024 * 1024 * 1024 * 1024} } 1099511627776 test execute-8.1 {Stack protection} -setup { # If [Bug #804681] has not been properly taken care of, this should # segfault proc whatever args {llength $args} trace add variable ::errorInfo {write unset} whatever } -body { expr {1+9/0} } -cleanup { trace remove variable ::errorInfo {write unset} whatever rename whatever {} } -returnCodes error -match glob -result * test execute-8.2 {Stack restoration} -setup { # Avoid crashes when system stack size is limited (thread-enabled!) set limit [interp recursionlimit {}] interp recursionlimit {} 100 } -body { # Test for [Bug #816641], correct restoration of the stack top after the # stack is grown proc f {args} { f bee bop } catch f msg set msg } -cleanup { interp recursionlimit {} $limit } -result {too many nested evaluations (infinite loop?)} test execute-8.3 {Stack restoration} -setup { # Avoid crashes when system stack size is limited (thread-enabled!) set limit [interp recursionlimit {}] interp recursionlimit {} 100 } -body { # Test for [Bug #1055676], correct restoration of the stack top after the # epoch is bumped and the stack is grown in a call from a nested # evaluation set arglst [string repeat "a " 1000] proc f {args} "f $arglst" proc run {} { # bump the interp's epoch testbumpinterpepoch catch f msg set msg } run } -cleanup { interp recursionlimit {} $limit } -result {too many nested evaluations (infinite loop?)} test execute-8.4 {Compile epoch bump effect on stack trace} -setup { proc foo {} { error bar } proc FOO {} { catch {error bar} m o testbumpinterpepoch return -options $o $m } } -body { catch foo m o set stack1 [dict get $o -errorinfo] catch FOO m o set stack2 [string map {FOO foo} [dict get $o -errorinfo]] expr {$stack1 eq $stack2 ? {} : "These differ:\n$stack1\n$stack2"} } -cleanup { rename foo {} rename FOO {} unset -nocomplain m o stack1 stack2 } -result {} test execute-8.5 {Bug 2038069} -setup { proc demo {} { catch [list error FOO] m o return $o } } -body { demo } -cleanup { rename demo {} } -match glob -result {-code 1 -level 0 -errorstack * -errorcode NONE -errorinfo {FOO while executing "error FOO" invoked from within "catch \[list error FOO\] m o"} -errorline 2} test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup { interp create child child eval { package require tcltest 2.5 catch [list package require -exact Tcltest [info patchlevel]] ::tcltest::loadTestedCommands if {[namespace which -command testbumpinterpepoch] eq ""} { proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } } } } -body { child eval { lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C; } child eval { set i 0; while {[incr i] < 3} { lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C; } } child eval { set i 0; while {[incr i] < 3} { lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; } } child eval { catch { lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C; } } child eval {set res} } -cleanup { interp delete child } -result [lrepeat 4 A B] test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup { interp create child child eval { package require tcltest 2.5 catch [list package require -exact Tcltest [info patchlevel]] ::tcltest::loadTestedCommands if {[namespace which -command testbumpinterpepoch] eq ""} { proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } } } } -body { set res {} lappend res [catch { child eval { lappend res A; testbumpinterpepoch; lappend res B; return -code error test; lappend res C; } } e] $e lappend res [catch { child eval { lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C; } } e] $e lappend res [catch { child eval { lappend res A; testbumpinterpepoch; lappend res B; return -code return test; lappend res C; } } e] $e lappend res [catch { child eval { lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; } } e] $e list $res [child eval {set res}] } -cleanup { interp delete child } -result [list {1 test 1 test 2 test 3 {}} [lrepeat 4 A B]] test execute-9.1 {Interp result resetting [Bug 1522803]} { set c 0 catch { catch {error foo} expr {1/$c} } if {[string match *foo* $::errorInfo]} { set result "Bad errorInfo: $::errorInfo" } else { set result SUCCESS } set result } SUCCESS test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130 } {48 {304 304}} test execute-10.2 {Bug 2802881} -setup { interp create child } -body { # If [Bug 2802881] is not fixed, this will segfault child eval { trace add variable ::errorInfo write {expr {$foo} ;#} proc demo {} {a {}{}} demo } } -cleanup { interp delete child } -returnCodes error -match glob -result * test execute-10.3 {Bug 3072640} -setup { proc generate {n} { for {set i 0} {$i < $n} {incr i} { yield $i } } proc t {args} { incr ::foo } set ::foo 0 trace add execution ::generate enterstep ::t } -body { coroutine coro generate 5 trace remove execution ::generate enterstep ::t set ::foo } -cleanup { unset ::foo rename generate {} rename t {} rename coro {} } -result 4 test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup { interp create child } -body { child eval { set x [lrepeat 1320 199] for {set i 0} {$i < 20} {incr i} { lappend x $i lsort -integer $x } # Crashes on failure return ok } } -cleanup { interp delete child } -result ok test execute-11.2 {Bug 268b23df11} -setup { proc zero {} {return 0} proc crash {} {expr {abs([zero])}} proc noop args {} trace add execution crash enterstep noop } -body { crash } -cleanup { trace remove execution crash enterstep noop rename noop {} rename crash {} rename zero {} } -result 0 test execute-11.3 {Bug a0ece9d6d4} -setup { proc crash {} {expr {rand()}} trace add execution crash enterstep {apply {args {info frame -2}}} } -body { string is double [crash] } -cleanup { trace remove execution crash enterstep {apply {args {info frame -2}}} rename crash {} } -result 1 test execute-12.1 {failing multi-lappend to unshared} -setup { unset -nocomplain x y } -body { set x 1 lappend x 2 3 trace add variable x write {apply {args {error boo}}} lappend x 4 5 } -cleanup { unset -nocomplain x y } -returnCodes error -result {can't set "x": boo} test execute-12.2 {failing multi-lappend to shared} -setup { unset -nocomplain x y } -body { set x 1 lappend x 2 3 set y $x trace add variable x write {apply {args {error boo}}} lappend x 4 5 } -cleanup { unset -nocomplain x y } -returnCodes error -result {can't set "x": boo} test execute-12.3 {failing multi-lappend to unshared: LVT} -body { apply {{} { set x 1 lappend x 2 3 trace add variable x write {apply {args {error boo}}} lappend x 4 5 }} } -returnCodes error -result {can't set "x": boo} test execute-12.4 {failing multi-lappend to shared: LVT} -body { apply {{} { set x 1 lappend x 2 3 set y $x trace add variable x write {apply {args {error boo}}} lappend x 4 5 }} } -returnCodes error -result {can't set "x": boo} # cleanup if {[info commands testobj] != {}} { testobj freeallvars } catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} catch {rename p ""} catch {rename {} ""} catch {rename { } ""} catch {unset x} catch {unset y} catch {unset msg} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/expr-old.test0000644000175000017500000013425014554262142015444 0ustar sergeisergei# Commands covered: expr # # This file contains the original set of tests for Tcl's expr command. # Since the expr command is now compiled, a new set of tests covering # the new implementation are in the files "parseExpr.test" and # "compExpr.test". Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.1 namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testexprlong [llength [info commands testexprlong]] testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { testConstraint testmathfunctions 0 } else { testConstraint testmathfunctions 1 } # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues binary scan [binary format dd -1.0 1.0] c* c switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ ieeeValues(-Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ ieeeValues(+Normal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ ieeeValues(+Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 } default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] # First, test all of the integer operators individually. test expr-old-1.1 {integer operators} {expr -4} -4 test expr-old-1.2 {integer operators} {expr -(1+4)} -5 test expr-old-1.3 {integer operators} {expr ~3} -4 test expr-old-1.4 {integer operators} {expr !2} 0 test expr-old-1.5 {integer operators} {expr !0} 1 test expr-old-1.6 {integer operators} {expr 4*6} 24 test expr-old-1.7 {integer operators} {expr 36/12} 3 test expr-old-1.8 {integer operators} {expr 27/4} 6 test expr-old-1.9 {integer operators} {expr 27%4} 3 test expr-old-1.10 {integer operators} {expr 2+2} 4 test expr-old-1.11 {integer operators} {expr 2-6} -4 test expr-old-1.12 {integer operators} {expr 1<<3} 8 test expr-old-1.13 {integer operators} {expr 0xff>>2} 63 test expr-old-1.14 {integer operators} {expr -1>>2} -1 test expr-old-1.15 {integer operators} {expr 3>2} 1 test expr-old-1.16 {integer operators} {expr 2>2} 0 test expr-old-1.17 {integer operators} {expr 1>2} 0 test expr-old-1.18 {integer operators} {expr 3<2} 0 test expr-old-1.19 {integer operators} {expr 2<2} 0 test expr-old-1.20 {integer operators} {expr 1<2} 1 test expr-old-1.21 {integer operators} {expr 3>=2} 1 test expr-old-1.22 {integer operators} {expr 2>=2} 1 test expr-old-1.23 {integer operators} {expr 1>=2} 0 test expr-old-1.24 {integer operators} {expr 3<=2} 0 test expr-old-1.25 {integer operators} {expr 2<=2} 1 test expr-old-1.26 {integer operators} {expr 1<=2} 1 test expr-old-1.27 {integer operators} {expr 3==2} 0 test expr-old-1.28 {integer operators} {expr 2==2} 1 test expr-old-1.29 {integer operators} {expr 3!=2} 1 test expr-old-1.30 {integer operators} {expr 2!=2} 0 test expr-old-1.31 {integer operators} {expr 7&0x13} 3 test expr-old-1.32 {integer operators} {expr 7^0x13} 20 test expr-old-1.33 {integer operators} {expr 7|0x13} 23 test expr-old-1.34 {integer operators} {expr 0&&1} 0 test expr-old-1.35 {integer operators} {expr 0&&0} 0 test expr-old-1.36 {integer operators} {expr 1&&3} 1 test expr-old-1.37 {integer operators} {expr 0||1} 1 test expr-old-1.38 {integer operators} {expr 3||0} 1 test expr-old-1.39 {integer operators} {expr 0||0} 0 test expr-old-1.40 {integer operators} {expr 3>2?44:66} 44 test expr-old-1.41 {integer operators} {expr 2>3?44:66} 66 test expr-old-1.42 {integer operators} {expr 36/5} 7 test expr-old-1.43 {integer operators} {expr 36%5} 1 test expr-old-1.44 {integer operators} {expr -36/5} -8 test expr-old-1.45 {integer operators} {expr -36%5} 4 test expr-old-1.46 {integer operators} {expr 36/-5} -8 test expr-old-1.47 {integer operators} {expr 36%-5} -4 test expr-old-1.48 {integer operators} {expr -36/-5} 7 test expr-old-1.49 {integer operators} {expr -36%-5} -1 test expr-old-1.50 {integer operators} {expr +36} 36 test expr-old-1.51 {integer operators} {expr +--++36} 36 test expr-old-1.52 {integer operators} {expr +36%+5} 1 test expr-old-1.53 {integer operators} { unset -nocomplain x set x yes list [expr {1 && $x}] [expr {$x && 1}] \ [expr {0 || $x}] [expr {$x || 0}] } {1 1 1 1} # Check the floating-point operators individually, along with # automatic conversion to integers where needed. test expr-old-2.1 {floating-point operators} {expr -4.2} -4.2 test expr-old-2.2 {floating-point operators} {expr -(1.125+4.25)} -5.375 test expr-old-2.3 {floating-point operators} {expr +5.7} 5.7 test expr-old-2.4 {floating-point operators} {expr +--+-62.0} -62.0 test expr-old-2.5 {floating-point operators} {expr !2.1} 0 test expr-old-2.6 {floating-point operators} {expr !0.0} 1 test expr-old-2.7 {floating-point operators} {expr 4.2*6.3} 26.46 test expr-old-2.8 {floating-point operators} {expr 36.0/12.0} 3.0 test expr-old-2.9 {floating-point operators} {expr 27/4.0} 6.75 test expr-old-2.10 {floating-point operators} {expr 2.3+2.1} 4.4 test expr-old-2.11 {floating-point operators} {expr 2.3-6.5} -4.2 test expr-old-2.12 {floating-point operators} {expr 3.1>2.1} 1 test expr-old-2.13 {floating-point operators} {expr {2.1 > 2.1}} 0 test expr-old-2.14 {floating-point operators} {expr 1.23>2.34e+1} 0 test expr-old-2.15 {floating-point operators} {expr 3.45<2.34} 0 test expr-old-2.16 {floating-point operators} {expr 0.002e3<--200e-2} 0 test expr-old-2.17 {floating-point operators} {expr 1.1<2.1} 1 test expr-old-2.18 {floating-point operators} {expr 3.1>=2.2} 1 test expr-old-2.19 {floating-point operators} {expr 2.345>=2.345} 1 test expr-old-2.20 {floating-point operators} {expr 1.1>=2.2} 0 test expr-old-2.21 {floating-point operators} {expr 3.0<=2.0} 0 test expr-old-2.22 {floating-point operators} {expr 2.2<=2.2} 1 test expr-old-2.23 {floating-point operators} {expr 2.2<=2.2001} 1 test expr-old-2.24 {floating-point operators} {expr 3.2==2.2} 0 test expr-old-2.25 {floating-point operators} {expr 2.2==2.2} 1 test expr-old-2.26 {floating-point operators} {expr 3.2!=2.2} 1 test expr-old-2.27 {floating-point operators} {expr 2.2!=2.2} 0 test expr-old-2.28 {floating-point operators} {expr 0.0&&0.0} 0 test expr-old-2.29 {floating-point operators} {expr 0.0&&1.3} 0 test expr-old-2.30 {floating-point operators} {expr 1.3&&0.0} 0 test expr-old-2.31 {floating-point operators} {expr 1.3&&3.3} 1 test expr-old-2.32 {floating-point operators} {expr 0.0||0.0} 0 test expr-old-2.33 {floating-point operators} {expr 0.0||1.3} 1 test expr-old-2.34 {floating-point operators} {expr 1.3||0.0} 1 test expr-old-2.35 {floating-point operators} {expr 3.3||0.0} 1 test expr-old-2.36 {floating-point operators} {expr 3.3>2.3?44.3:66.3} 44.3 test expr-old-2.37 {floating-point operators} {expr 2.3>3.3?44.3:66.3} 66.3 test expr-old-2.38 {floating-point operators} { list [catch {expr 028.1 + 09.2} msg] $msg } {0 37.3} # Operators that aren't legal on floating-point numbers test expr-old-3.1 {illegal floating-point operations} { list [catch {expr ~4.0} msg] $msg } {1 {can't use floating-point value as operand of "~"}} test expr-old-3.2 {illegal floating-point operations} { list [catch {expr 27%4.0} msg] $msg } {1 {can't use floating-point value as operand of "%"}} test expr-old-3.3 {illegal floating-point operations} { list [catch {expr 27.0%4} msg] $msg } {1 {can't use floating-point value as operand of "%"}} test expr-old-3.4 {illegal floating-point operations} { list [catch {expr 1.0<<3} msg] $msg } {1 {can't use floating-point value as operand of "<<"}} test expr-old-3.5 {illegal floating-point operations} { list [catch {expr 3<<1.0} msg] $msg } {1 {can't use floating-point value as operand of "<<"}} test expr-old-3.6 {illegal floating-point operations} { list [catch {expr 24.0>>3} msg] $msg } {1 {can't use floating-point value as operand of ">>"}} test expr-old-3.7 {illegal floating-point operations} { list [catch {expr 24>>3.0} msg] $msg } {1 {can't use floating-point value as operand of ">>"}} test expr-old-3.8 {illegal floating-point operations} { list [catch {expr 24&3.0} msg] $msg } {1 {can't use floating-point value as operand of "&"}} test expr-old-3.9 {illegal floating-point operations} { list [catch {expr 24.0|3} msg] $msg } {1 {can't use floating-point value as operand of "|"}} test expr-old-3.10 {illegal floating-point operations} { list [catch {expr 24.0^3} msg] $msg } {1 {can't use floating-point value as operand of "^"}} # Check the string operators individually. test expr-old-4.1 {string operators} {expr {"abc" > "def"}} 0 test expr-old-4.2 {string operators} {expr {"def" > "def"}} 0 test expr-old-4.3 {string operators} {expr {"g" > "def"}} 1 test expr-old-4.4 {string operators} {expr {"abc" < "abd"}} 1 test expr-old-4.5 {string operators} {expr {"abd" < "abd"}} 0 test expr-old-4.6 {string operators} {expr {"abe" < "abd"}} 0 test expr-old-4.7 {string operators} {expr {"abc" >= "def"}} 0 test expr-old-4.8 {string operators} {expr {"def" >= "def"}} 1 test expr-old-4.9 {string operators} {expr {"g" >= "def"}} 1 test expr-old-4.10 {string operators} {expr {"abc" <= "abd"}} 1 test expr-old-4.11 {string operators} {expr {"abd" <= "abd"}} 1 test expr-old-4.12 {string operators} {expr {"abe" <= "abd"}} 0 test expr-old-4.13 {string operators} {expr {"abc" == "abd"}} 0 test expr-old-4.14 {string operators} {expr {"abd" == "abd"}} 1 test expr-old-4.15 {string operators} {expr {"abc" != "abd"}} 1 test expr-old-4.16 {string operators} {expr {"abd" != "abd"}} 0 test expr-old-4.17 {string operators} {expr {"0y" < "0x12"}} 0 test expr-old-4.18 {string operators} {expr {"." < " "}} 0 test expr-old-4.19 {string operators} {expr {"abc" eq "abd"}} 0 test expr-old-4.20 {string operators} {expr {"abd" eq "abd"}} 1 test expr-old-4.21 {string operators} {expr {"abc" ne "abd"}} 1 test expr-old-4.22 {string operators} {expr {"abd" ne "abd"}} 0 test expr-old-4.23 {string operators} {expr {"" eq "abd"}} 0 test expr-old-4.24 {string operators} {expr {"" eq ""}} 1 test expr-old-4.25 {string operators} {expr {"abd" ne ""}} 1 test expr-old-4.26 {string operators} {expr {"" ne ""}} 0 test expr-old-4.27 {string operators} {expr {"longerstring" eq "shorter"}} 0 test expr-old-4.28 {string operators} {expr {"longerstring" ne "shorter"}} 1 test expr-old-4.29 {string operators} {expr {"0" == "+"}} 0 test expr-old-4.30 {string operators} {expr {"0" == "-"}} 0 test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar # Operators that aren't legal on string operands. test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} test expr-old-5.2 {illegal string operations} { list [catch {expr {+"a"}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test expr-old-5.3 {illegal string operations} { list [catch {expr {~"a"}} msg] $msg } {1 {can't use non-numeric string as operand of "~"}} test expr-old-5.4 {illegal string operations} { list [catch {expr {!"a"}} msg] $msg } {1 {can't use non-numeric string as operand of "!"}} test expr-old-5.5 {illegal string operations} { list [catch {expr {"a"*"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "*"}} test expr-old-5.6 {illegal string operations} { list [catch {expr {"a"/"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "/"}} test expr-old-5.7 {illegal string operations} { list [catch {expr {"a"%"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "%"}} test expr-old-5.8 {illegal string operations} { list [catch {expr {"a"+"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test expr-old-5.9 {illegal string operations} { list [catch {expr {"a"-"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} test expr-old-5.10 {illegal string operations} { list [catch {expr {"a"<<"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "<<"}} test expr-old-5.11 {illegal string operations} { list [catch {expr {"a">>"b"}} msg] $msg } {1 {can't use non-numeric string as operand of ">>"}} test expr-old-5.12 {illegal string operations} { list [catch {expr {"a"&"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "&"}} test expr-old-5.13 {illegal string operations} { list [catch {expr {"a"^"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "^"}} test expr-old-5.14 {illegal string operations} { list [catch {expr {"a"|"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "|"}} test expr-old-5.15 {illegal string operations} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} test expr-old-5.16 {illegal string operations} { list [catch {expr {"a"||"b"}} msg] $msg } {1 {expected boolean value but got "a"}} test expr-old-5.17 {illegal string operations} { list [catch {expr {"a"?4:2}} msg] $msg } {1 {expected boolean value but got "a"}} # Check precedence pairwise. test expr-old-6.1 {precedence checks} {expr -~3} 4 test expr-old-6.2 {precedence checks} {expr -!3} 0 test expr-old-6.3 {precedence checks} {expr -~0} 1 test expr-old-7.1 {precedence checks} {expr 2*4/6} 1 test expr-old-7.2 {precedence checks} {expr 24/6*3} 12 test expr-old-7.3 {precedence checks} {expr 24/6/2} 2 test expr-old-8.1 {precedence checks} {expr -2+4} 2 test expr-old-8.2 {precedence checks} {expr -2-4} -6 test expr-old-8.3 {precedence checks} {expr +2-4} -2 test expr-old-9.1 {precedence checks} {expr 2*3+4} 10 test expr-old-9.2 {precedence checks} {expr 8/2+4} 8 test expr-old-9.3 {precedence checks} {expr 8%3+4} 6 test expr-old-9.4 {precedence checks} {expr 2*3-1} 5 test expr-old-9.5 {precedence checks} {expr 8/2-1} 3 test expr-old-9.6 {precedence checks} {expr 8%3-1} 1 test expr-old-10.1 {precedence checks} {expr 6-3-2} 1 test expr-old-11.1 {precedence checks} {expr 7+1>>2} 2 test expr-old-11.2 {precedence checks} {expr 7+1<<2} 32 test expr-old-11.3 {precedence checks} {expr 7>>3-2} 3 test expr-old-11.4 {precedence checks} {expr 7<<3-2} 14 test expr-old-12.1 {precedence checks} {expr 6>>1>4} 0 test expr-old-12.2 {precedence checks} {expr 6>>1<2} 0 test expr-old-12.3 {precedence checks} {expr 6>>1>=3} 1 test expr-old-12.4 {precedence checks} {expr 6>>1<=2} 0 test expr-old-12.5 {precedence checks} {expr 6<<1>5} 1 test expr-old-12.6 {precedence checks} {expr 6<<1<5} 0 test expr-old-12.7 {precedence checks} {expr 5<=6<<1} 1 test expr-old-12.8 {precedence checks} {expr 5>=6<<1} 0 test expr-old-13.1 {precedence checks} {expr 2<3<4} 1 test expr-old-13.2 {precedence checks} {expr 0<4>2} 0 test expr-old-13.3 {precedence checks} {expr 4>2<1} 0 test expr-old-13.4 {precedence checks} {expr 4>3>2} 0 test expr-old-13.5 {precedence checks} {expr 4>3>=2} 0 test expr-old-13.6 {precedence checks} {expr 4>=3>2} 0 test expr-old-13.7 {precedence checks} {expr 4>=3>=2} 0 test expr-old-13.8 {precedence checks} {expr 0<=4>=2} 0 test expr-old-13.9 {precedence checks} {expr 4>=2<=0} 0 test expr-old-13.10 {precedence checks} {expr 2<=3<=4} 1 test expr-old-14.1 {precedence checks} {expr 1==4>3} 1 test expr-old-14.2 {precedence checks} {expr 0!=4>3} 1 test expr-old-14.3 {precedence checks} {expr 1==3<4} 1 test expr-old-14.4 {precedence checks} {expr 0!=3<4} 1 test expr-old-14.5 {precedence checks} {expr 1==4>=3} 1 test expr-old-14.6 {precedence checks} {expr 0!=4>=3} 1 test expr-old-14.7 {precedence checks} {expr 1==3<=4} 1 test expr-old-14.8 {precedence checks} {expr 0!=3<=4} 1 test expr-old-14.9 {precedence checks} {expr 1eq4>3} 1 test expr-old-14.10 {precedence checks} {expr 0ne4>3} 1 test expr-old-14.11 {precedence checks} {expr 1eq3<4} 1 test expr-old-14.12 {precedence checks} {expr 0ne3<4} 1 test expr-old-14.13 {precedence checks} {expr 1eq4>=3} 1 test expr-old-14.14 {precedence checks} {expr 0ne4>=3} 1 test expr-old-14.15 {precedence checks} {expr 1eq3<=4} 1 test expr-old-14.16 {precedence checks} {expr 0ne3<=4} 1 test expr-old-15.1 {precedence checks} {expr 1==3==3} 0 test expr-old-15.2 {precedence checks} {expr 3==3!=2} 1 test expr-old-15.3 {precedence checks} {expr 2!=3==3} 0 test expr-old-15.4 {precedence checks} {expr 2!=1!=1} 0 test expr-old-15.5 {precedence checks} {expr 1eq3eq3} 0 test expr-old-15.6 {precedence checks} {expr 3eq3ne2} 1 test expr-old-15.7 {precedence checks} {expr 2ne3eq3} 0 test expr-old-15.8 {precedence checks} {expr 2ne1ne1} 0 test expr-old-16.1 {precedence checks} {expr 2&3eq2} 0 test expr-old-16.2 {precedence checks} {expr 1&3ne3} 0 test expr-old-16.3 {precedence checks} {expr 2&3eq2} 0 test expr-old-16.4 {precedence checks} {expr 1&3ne3} 0 test expr-old-17.1 {precedence checks} {expr 7&3^0x10} 19 test expr-old-17.2 {precedence checks} {expr 7^0x10&3} 7 test expr-old-18.1 {precedence checks} {expr 7^0x10|3} 23 test expr-old-18.2 {precedence checks} {expr 7|0x10^3} 23 test expr-old-19.1 {precedence checks} {expr 7|3&&1} 1 test expr-old-19.2 {precedence checks} {expr 1&&3|7} 1 test expr-old-19.3 {precedence checks} {expr 0&&1||1} 1 test expr-old-19.4 {precedence checks} {expr 1||1&&0} 1 test expr-old-20.1 {precedence checks} {expr 1||0?3:4} 3 test expr-old-20.2 {precedence checks} {expr 1?0:4||1} 0 test expr-old-20.3 {precedence checks} {expr 1?2:0?3:4} 2 test expr-old-20.4 {precedence checks} {expr 0?2:0?3:4} 4 test expr-old-20.5 {precedence checks} {expr 1?2?3:4:0} 3 test expr-old-20.6 {precedence checks} {expr 0?2?3:4:0} 0 # Parentheses. test expr-old-21.1 {parenthesization} {expr (2+4)*6} 36 test expr-old-21.2 {parenthesization} {expr (1?0:4)||1} 1 test expr-old-21.3 {parenthesization} {expr +(3-4)} -1 # Embedded commands and variable names. set a 16 test expr-old-22.1 {embedded variables} {expr {2*$a}} 32 test expr-old-22.2 {embedded variables} { set x -5 set y 10 expr {$x + $y} } {5} test expr-old-22.3 {embedded variables} { set x " -5" set y " +10" expr {$x + $y} } {5} test expr-old-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2 test expr-old-22.5 {embedded commands and variables} { list [catch {expr {12 - [bad_command_name]}} msg] $msg } {1 {invalid command name "bad_command_name"}} # Double-quotes and things inside them. test expr-old-23.1 {double quotes} {expr {"abc"}} abc test expr-old-23.2 {double quotes} { set a 189 expr {"$a.bc"} } 189.bc test expr-old-23.3 {double quotes} { set b2 xyx expr {"$b2$b2$b2.[set b2].[set b2]"} } xyxxyxxyx.xyx.xyx test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22 test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc} test expr-old-23.6 {double quotes} { unset -nocomplain bogus__ list [catch {expr {"$bogus__"}} msg] $msg } {1 {can't read "bogus__": no such variable}} test expr-old-23.7 {double quotes} { list [catch {expr {"a[error Testing]bc"}} msg] $msg } {1 Testing} test expr-old-23.8 {double quotes} { list [catch {expr {"12398712938788234-1298379" != ""}} msg] $msg } {0 1} # Numbers in various bases. test expr-old-24.1 {numbers in different bases} {expr 0x20} 32 test expr-old-24.2 {numbers in different bases} {expr 0o15} 13 # Conversions between various data types. test expr-old-25.1 {type conversions} {expr 2+2.5} 4.5 test expr-old-25.2 {type conversions} {expr 2.5+2} 4.5 test expr-old-25.3 {type conversions} {expr 2-2.5} -0.5 test expr-old-25.4 {type conversions} {expr 2/2.5} 0.8 test expr-old-25.5 {type conversions} {expr 2>2.5} 0 test expr-old-25.6 {type conversions} {expr 2.5>2} 1 test expr-old-25.7 {type conversions} {expr 2<2.5} 1 test expr-old-25.8 {type conversions} {expr 2>=2.5} 0 test expr-old-25.9 {type conversions} {expr 2<=2.5} 1 test expr-old-25.10 {type conversions} {expr 2==2.5} 0 test expr-old-25.11 {type conversions} {expr 2!=2.5} 1 test expr-old-25.12 {type conversions} {expr 2>"ab"} 0 test expr-old-25.13 {type conversions} {expr {2>" "}} 1 test expr-old-25.14 {type conversions} {expr {"24.1a" > 24.1}} 1 test expr-old-25.15 {type conversions} {expr {24.1 > "24.1a"}} 0 test expr-old-25.16 {type conversions} {expr 2+2.5} 4.5 test expr-old-25.17 {type conversions} {expr 2+2.5} 4.5 test expr-old-25.18 {type conversions} {expr 2.0e2} 200.0 test expr-old-25.19 {type conversions} {expr 2.0e15} 2000000000000000.0 test expr-old-25.20 {type conversions} {expr 10.0} 10.0 # Various error conditions. test expr-old-26.1 {error conditions} { list [catch {expr 2+"a"} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * test expr-old-26.3 {error conditions} -body { expr 2+4*( } -returnCodes error -match glob -result * unset -nocomplain _non_existent_ test expr-old-26.4 {error conditions} { list [catch {expr 2+$_non_existent_} msg] $msg } {1 {can't read "_non_existent_": no such variable}} set a xx test expr-old-26.5 {error conditions} { list [catch {expr {2+$a}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test expr-old-26.6 {error conditions} { list [catch {expr {2+[set a]}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test expr-old-26.7 {error conditions} -body { expr {2+(4} } -returnCodes error -match glob -result * test expr-old-26.8 {error conditions} { list [catch {expr 2/0} msg] $msg $errorCode } {1 {divide by zero} {ARITH DIVZERO {divide by zero}}} test expr-old-26.9 {error conditions} { list [catch {expr 2%0} msg] $msg $errorCode } {1 {divide by zero} {ARITH DIVZERO {divide by zero}}} test expr-old-26.10a {error conditions} !ieeeFloatingPoint { list [catch {expr 2.0/0.0} msg] $msg $errorCode } {1 {divide by zero} {ARITH DIVZERO {divide by zero}}} test expr-old-26.10b {error conditions} ieeeFloatingPoint { list [catch {expr 2.0/0.0} msg] $msg } {0 Inf} test expr-old-26.11 {error conditions} -body { expr 2# } -returnCodes error -match glob -result * test expr-old-26.12 {error conditions} -body { expr a.b } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "/"}} test expr-old-26.14 {error conditions} -body { expr 2:3 } -returnCodes error -match glob -result * test expr-old-26.15 {error conditions} -body { expr a@b } -returnCodes error -match glob -result * test expr-old-26.16 {error conditions} { list [catch {expr a[b} msg] $msg } {1 {missing close-bracket}} test expr-old-26.17 {error conditions} -body { expr a`b } -returnCodes error -match glob -result * test expr-old-26.18 {error conditions} -body { expr \"a\"\{b } -returnCodes error -match glob -result * test expr-old-26.19 {error conditions} -body { expr a } -returnCodes error -match glob -result * test expr-old-26.20 {error conditions} { list [catch expr msg] $msg } {1 {wrong # args: should be "expr arg ?arg ...?"}} # Cancelled evaluation. test expr-old-27.1 {cancelled evaluation} { set a 1 expr {0&&[set a 2]} set a } 1 test expr-old-27.2 {cancelled evaluation} { set a 1 expr {1||[set a 2]} set a } 1 test expr-old-27.3 {cancelled evaluation} { set a 1 expr {0?[set a 2]:1} set a } 1 test expr-old-27.4 {cancelled evaluation} { set a 1 expr {1?2:[set a 2]} set a } 1 unset -nocomplain x test expr-old-27.5 {cancelled evaluation} { list [catch {expr {[info exists x] && $x}} msg] $msg } {0 0} test expr-old-27.6 {cancelled evaluation} { list [catch {expr {0 && [concat $x]}} msg] $msg } {0 0} test expr-old-27.7 {cancelled evaluation} { set one 1 list [catch {expr {1 || 1/$one}} msg] $msg } {0 1} test expr-old-27.8 {cancelled evaluation} { list [catch {expr {1 || -"string"}} msg] $msg } {0 1} test expr-old-27.9 {cancelled evaluation} { list [catch {expr {1 || ("string" * ("x" && "y"))}} msg] $msg } {0 1} test expr-old-27.10 {cancelled evaluation} { set x -1.0 list [catch {expr {($x > 0) ? round(log($x)) : 0}} msg] $msg } {0 0} test expr-old-27.11 {cancelled evaluation} -body { expr {0 && foo} } -returnCodes error -match glob -result * test expr-old-27.12 {cancelled evaluation} -body { expr {0 ? 1 : foo} } -returnCodes error -match glob -result * # Tcl_ExprBool as used in "if" statements test expr-old-28.1 {Tcl_ExprBoolean usage} { set a 1 if {2} {set a 2} set a } 2 test expr-old-28.2 {Tcl_ExprBoolean usage} { set a 1 if {0} {set a 2} set a } 1 test expr-old-28.3 {Tcl_ExprBoolean usage} { set a 1 if {1.2} {set a 2} set a } 2 test expr-old-28.4 {Tcl_ExprBoolean usage} { set a 1 if {-1.1} {set a 2} set a } 2 test expr-old-28.5 {Tcl_ExprBoolean usage} { set a 1 if {0.0} {set a 2} set a } 1 test expr-old-28.6 {Tcl_ExprBoolean usage} { set a 1 if {"YES"} {set a 2} set a } 2 test expr-old-28.7 {Tcl_ExprBoolean usage} { set a 1 if {"no"} {set a 2} set a } 1 test expr-old-28.8 {Tcl_ExprBoolean usage} { set a 1 if {"true"} {set a 2} set a } 2 test expr-old-28.9 {Tcl_ExprBoolean usage} { set a 1 if {"fAlse"} {set a 2} set a } 1 test expr-old-28.10 {Tcl_ExprBoolean usage} { set a 1 if {"on"} {set a 2} set a } 2 test expr-old-28.11 {Tcl_ExprBoolean usage} { set a 1 if {"Off"} {set a 2} set a } 1 test expr-old-28.12 {Tcl_ExprBool usage} { list [catch {if {"abc"} {}} msg] $msg } {1 {expected boolean value but got "abc"}} test expr-old-28.13 {Tcl_ExprBool usage} { list [catch {if {"ogle"} {}} msg] $msg } {1 {expected boolean value but got "ogle"}} test expr-old-28.14 {Tcl_ExprBool usage} { list [catch {if {"o"} {}} msg] $msg } {1 {expected boolean value but got "o"}} # Operands enclosed in braces test expr-old-29.1 {braces} {expr {{abc}}} abc test expr-old-29.2 {braces} {expr {{0o0010}}} 8 test expr-old-29.3 {braces} {expr {{3.1200000}}} 3.12 test expr-old-29.4 {braces} {expr {{a{b}{1 {2 3}}c}}} "a{b}{1 {2 3}}c" test expr-old-29.5 {braces} -body { expr "\{abc" } -returnCodes error -match glob -result * # Very long values test expr-old-30.1 {long values} { set a "0000 1111 2222 3333 4444" set a "$a | $a | $a | $a | $a" set a "$a || $a || $a || $a || $a" expr {$a} } {0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444} test expr-old-30.2 {long values} { set a "000000000000000000000000000000" set a "$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a${a}5" expr $a } 5 # Expressions spanning multiple arguments test expr-old-31.1 {multiple arguments to expr command} { expr 4 + ( 6 *12) -3 } 73 test expr-old-31.2 {multiple arguments to expr command} -body { expr 2 + (3 + 4 } -returnCodes error -match glob -result * test expr-old-31.3 {multiple arguments to expr command} -body { expr 2 + 3 + } -returnCodes error -match glob -result * test expr-old-31.4 {multiple arguments to expr command} -body { expr 2 + 3 ) } -returnCodes error -match glob -result * # Math functions test expr-old-32.1 {math functions in expressions} { format %.6g [expr acos(0.5)] } {1.0472} test expr-old-32.2 {math functions in expressions} { format %.6g [expr asin(0.5)] } {0.523599} test expr-old-32.3 {math functions in expressions} { format %.6g [expr atan(1.0)] } {0.785398} test expr-old-32.4 {math functions in expressions} { format %.6g [expr atan2(2.0, 2.0)] } {0.785398} test expr-old-32.5 {math functions in expressions} { format %.6g [expr ceil(1.999)] } {2} test expr-old-32.6 {math functions in expressions} { format %.6g [expr cos(.1)] } {0.995004} test expr-old-32.7 {math functions in expressions} { format %.6g [expr cosh(.1)] } {1.005} test expr-old-32.8 {math functions in expressions} { format %.6g [expr exp(1.0)] } {2.71828} test expr-old-32.9 {math functions in expressions} { format %.6g [expr floor(2.000)] } {2} test expr-old-32.10 {math functions in expressions} { format %.6g [expr floor(2.001)] } {2} test expr-old-32.11 {math functions in expressions} { format %.6g [expr fmod(7.3, 3.2)] } {0.9} test expr-old-32.12 {math functions in expressions} { format %.6g [expr hypot(3.0, 4.0)] } {5} test expr-old-32.13 {math functions in expressions} { format %.6g [expr log(2.8)] } {1.02962} test expr-old-32.14 {math functions in expressions} { format %.6g [expr log10(2.8)] } {0.447158} test expr-old-32.15 {math functions in expressions} { format %.6g [expr pow(2.1, 3.1)] } {9.97424} test expr-old-32.16 {math functions in expressions} { format %.6g [expr sin(.1)] } {0.0998334} test expr-old-32.17 {math functions in expressions} { format %.6g [expr sinh(.1)] } {0.100167} test expr-old-32.18 {math functions in expressions} { format %.6g [expr sqrt(2.0)] } {1.41421} test expr-old-32.19 {math functions in expressions} { format %.6g [expr tan(0.8)] } {1.02964} test expr-old-32.20 {math functions in expressions} { format %.6g [expr tanh(0.8)] } {0.664037} test expr-old-32.21 {math functions in expressions} { format %.6g [expr abs(-1.8)] } {1.8} test expr-old-32.22 {math functions in expressions} { expr abs(10.0) } {10.0} test expr-old-32.23 {math functions in expressions} { format %.6g [expr abs(-4)] } {4} test expr-old-32.24 {math functions in expressions} { format %.6g [expr abs(66)] } {66} test expr-old-32.25a {math functions in expressions} { expr abs(0x8000000000000000) } [expr 1<<63] test expr-old-32.25b {math functions in expressions} { expr abs(0x80000000) } 2147483648 test expr-old-32.26 {math functions in expressions} { expr double(1) } {1.0} test expr-old-32.27 {math functions in expressions} { expr double(1.1) } {1.1} test expr-old-32.28 {math functions in expressions} { expr int(1) } {1} test expr-old-32.29 {math functions in expressions} { expr int(1.4) } {1} test expr-old-32.30 {math functions in expressions} { expr int(1.6) } {1} test expr-old-32.31 {math functions in expressions} { expr int(-1.4) } {-1} test expr-old-32.32 {math functions in expressions} { expr int(-1.6) } {-1} test expr-old-32.33 {math functions in expressions} { expr int(1e60) } 0 test expr-old-32.34 {math functions in expressions} { expr int(-1e60) } 0 test expr-old-32.35 {math functions in expressions} { expr round(1.49) } {1} test expr-old-32.36 {math functions in expressions} { expr round(1.51) } {2} test expr-old-32.37 {math functions in expressions} { expr round(-1.49) } {-1} test expr-old-32.38 {math functions in expressions} { expr round(-1.51) } {-2} test expr-old-32.39 {math functions in expressions} { expr round(1e60) } 999999999999999949387135297074018866963645011013410073083904 test expr-old-32.40 {math functions in expressions} { expr round(-1e60) } -999999999999999949387135297074018866963645011013410073083904 test expr-old-32.41 {math functions in expressions} { list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg } {0 16.0} test expr-old-32.42 {math functions in expressions} { list [catch {expr hypot(5*.8,3)} msg] $msg } {0 5.0} test expr-old-32.43 {math functions in expressions} testmathfunctions { expr 2*T1() } 246 test expr-old-32.44 {math functions in expressions} testmathfunctions { expr T2()*3 } 1035 test expr-old-32.45 {math functions in expressions} { expr (0 <= rand()) && (rand() < 1) } {1} test expr-old-32.46 {math functions in expressions} -body { list [catch {expr rand(24)} msg] $msg } -match glob -result {1 {too many arguments for math function*}} test expr-old-32.47 {math functions in expressions} -body { list [catch {expr srand()} msg] $msg } -match glob -result {1 {not enough arguments for math function*}} test expr-old-32.48 {math functions in expressions} -body { expr srand(3.79) } -returnCodes error -match glob -result * test expr-old-32.49 {math functions in expressions} -body { expr srand("") } -returnCodes error -match glob -result * test expr-old-32.50 {math functions in expressions} { set result [expr round(srand(12345) * 1000)] for {set i 0} {$i < 10} {incr i} { lappend result [expr round(rand() * 1000)] } set result } {97 834 948 36 12 51 766 585 914 784 333} test expr-old-32.51 {math functions in expressions} -body { expr {srand([lindex "6ty" 0])} } -returnCodes error -match glob -result * test expr-old-32.52 {math functions in expressions} { expr {srand(int(1<<37)) < 1} } {1} test expr-old-32.53 {math functions in expressions} { expr {srand((1<<31) - 1) > 0} } {1} test expr-old-33.1 {conversions and fancy args to math functions} { expr hypot ( 3 , 4 ) } 5.0 test expr-old-33.2 {conversions and fancy args to math functions} { expr hypot ( (2.0+1.0) , 4 ) } 5.0 test expr-old-33.3 {conversions and fancy args to math functions} { expr hypot ( 3 , (3.0 + 1.0) ) } 5.0 test expr-old-33.4 {conversions and fancy args to math functions} { format %.6g [expr cos(acos(0.1))] } 0.1 test expr-old-34.1 {errors in math functions} -body { list [catch {expr func_2(1.0)} msg] $msg } -match glob -result {1 {* "*func_2"}} test expr-old-34.2 {errors in math functions} -body { expr func|(1.0) } -returnCodes error -match glob -result * test expr-old-34.3 {errors in math functions} { list [catch {expr {hypot("a b", 2.0)}} msg] $msg } {1 {expected floating-point number but got "a b"}} test expr-old-34.4 {errors in math functions} -body { expr hypot(1.0 2.0) } -returnCodes error -match glob -result * test expr-old-34.5 {errors in math functions} -body { expr hypot(1.0, 2.0 } -returnCodes error -match glob -result * test expr-old-34.6 {errors in math functions} -body { expr hypot(1.0 , } -returnCodes error -match glob -result * test expr-old-34.7 {errors in math functions} -body { list [catch {expr hypot(1.0)} msg] $msg } -match glob -result {1 {not enough arguments for math function*}} test expr-old-34.8 {errors in math functions} -body { list [catch {expr hypot(1.0, 2.0, 3.0)} msg] $msg } -match glob -result {1 {too many arguments for math function*}} test expr-old-34.9 {errors in math functions} { list [catch {expr acos(-2.0)} msg] $msg $errorCode } {1 {domain error: argument not in valid range} {ARITH DOMAIN {domain error: argument not in valid range}}} test expr-old-34.10 {errors in math functions} { list [catch {expr pow(-3, 1000001)} msg] $msg } {0 -Inf} test expr-old-34.11a {errors in math functions} !ieeeFloatingPoint { list [catch {expr pow(3, 1000001)} msg] $msg $errorCode } {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}} test expr-old-34.11b {errors in math functions} ieeeFloatingPoint { list [catch {expr pow(3, 1000001)} msg] $msg } {0 Inf} test expr-old-34.12a {errors in math functions} !ieeeFloatingPoint { list [catch {expr -14.0*exp(100000)} msg] $msg $errorCode } {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}} test expr-old-34.12b {errors in math functions} ieeeFloatingPoint { list [catch {expr -14.0*exp(100000)} msg] $msg } {0 -Inf} test expr-old-34.13 {errors in math functions} { expr wide(1.0e30) } 5076964154930102272 test expr-old-34.14 {errors in math functions} { expr wide(-1.0e30) } -5076964154930102272 test expr-old-34.15 {errors in math functions} { expr round(1.0e30) } 1000000000000000019884624838656 test expr-old-34.16 {errors in math functions} { expr round(-1.0e30) } -1000000000000000019884624838656 test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \ -body { list [catch {expr T1(4)} msg] $msg } -match glob -result {1 {too many arguments for math function*}} test expr-old-36.1 {ExprLooksLikeInt procedure} -body { expr 0o289 } -returnCodes error -match glob -result {*invalid octal number*} test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0o289 list [catch {expr {$x+1}} msg] $msg } {1 {can't use invalid octal number as operand of "+"}} test expr-old-36.3 {ExprLooksLikeInt procedure} { list [catch {expr 0289.1} msg] $msg } {0 289.1} test expr-old-36.4 {ExprLooksLikeInt procedure} { set x 0289.1 list [catch {expr {$x+1}} msg] $msg } {0 290.1} test expr-old-36.5 {ExprLooksLikeInt procedure} { set x { +22} list [catch {expr {$x+1}} msg] $msg } {0 23} test expr-old-36.6 {ExprLooksLikeInt procedure} { set x { -22} list [catch {expr {$x+1}} msg] $msg } {0 -21} test expr-old-36.7 {ExprLooksLikeInt procedure} { list [catch {expr nan} msg] $msg } {1 {domain error: argument not in valid range}} test expr-old-36.8 {ExprLooksLikeInt procedure} { list [catch {expr 78e1} msg] $msg } {0 780.0} test expr-old-36.9 {ExprLooksLikeInt procedure} { list [catch {expr 24E1} msg] $msg } {0 240.0} test expr-old-36.10 {ExprLooksLikeInt procedure} -body { expr 78e } -returnCodes error -match glob -result * # test for [Bug #542588] test expr-old-36.11 {ExprLooksLikeInt procedure} { # define a "too large integer"; this one works also for 64bit arith set x 665802003400000000000000 expr {$x+1} } 665802003400000000000001 # tests for [Bug #587140] test expr-old-36.12 {ExprLooksLikeInt procedure} { set x "10;" list [catch {expr {$x+1}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test expr-old-36.13 {ExprLooksLikeInt procedure} { set x " +" list [catch {expr {$x+1}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test expr-old-36.14 {ExprLooksLikeInt procedure} { set x "123456789012345678901234567890 " expr {$x+1} } 123456789012345678901234567891 test expr-old-36.15 {ExprLooksLikeInt procedure} { set x "0o99 " list [catch {expr {$x+1}} msg] $msg } {1 {can't use invalid octal number as operand of "+"}} test expr-old-36.16 {ExprLooksLikeInt procedure} { set x " 0xffffffffffffffffffffffffffffffffffffff " expr {$x+1} } [expr 0x100000000000000000000000000000000000000] test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong { testexprlong 4+1 } {This is a result: 5} #Check for [Bug 1109484] test expr-old-37.2 {Tcl_ExprLong handles wide ints gracefully} testexprlong { testexprlong wide(1)+2 } {This is a result: 3} test expr-old-37.3 {Tcl_ExprLong on the empty string} testexprlong { testexprlong "" } {This is a result: 0} test expr-old-37.4 {Tcl_ExprLong coerces doubles} testexprlong { testexprlong 3+.14159 } {This is a result: 3} test expr-old-37.5 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} { testexprlong 0x80000000 } {This is a result: -2147483648} test expr-old-37.6 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} { testexprlong 0xffffffff } {This is a result: -1} test expr-old-37.7 {Tcl_ExprLong handles overflows} \ -constraints {testexprlong longIs32bit} \ -match glob \ -body { list [catch {testexprlong 0x100000000} result] $result } \ -result {1 {integer value too large to represent*}} test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong { testexprlong -0x80000000 } {This is a result: -2147483648} test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} { testexprlong -0xffffffff } {This is a result: 1} test expr-old-37.10 {Tcl_ExprLong handles overflows} \ -constraints {testexprlong longIs32bit} \ -match glob \ -body { list [catch {testexprlong -0x100000000} result] $result } \ -result {1 {integer value too large to represent*}} test expr-old-37.11 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} { testexprlong 2147483648. } {This is a result: -2147483648} test expr-old-37.12 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} { testexprlong 4294967295. } {This is a result: -1} test expr-old-37.13 {Tcl_ExprLong handles overflows} \ -constraints {testexprlong longIs32bit} \ -match glob \ -body { list [catch {testexprlong 4294967296.} result] $result } \ -result {1 {integer value too large to represent*}} test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong { testexprlong -2147483648. } {This is a result: -2147483648} test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} { testexprlong -4294967295. } {This is a result: 1} test expr-old-37.16 {Tcl_ExprLong handles overflows} \ -constraints {testexprlong longIs32bit} \ -match glob \ -body { list [catch {testexprlong 4294967296.} result] $result } \ -result {1 {integer value too large to represent*}} test expr-old-37.17 {Check that Tcl_ExprDouble doesn't modify interpreter result if no error} testexprdouble { testexprdouble 4.+1. } {This is a result: 5.0} #Check for [Bug 1109484] test expr-old-37.18 {Tcl_ExprDouble on the empty string} testexprdouble { testexprdouble "" } {This is a result: 0.0} test expr-old-37.19 {Tcl_ExprDouble coerces wides} testexprdouble { testexprdouble 1[string repeat 0 17] } {This is a result: 1e+17} test expr-old-37.20 {Tcl_ExprDouble coerces bignums} testexprdouble { testexprdouble 1[string repeat 0 38] } {This is a result: 1e+38} test expr-old-37.21 {Tcl_ExprDouble handles overflows} testexprdouble { testexprdouble 17976931348623157[string repeat 0 292]. } {This is a result: 1.7976931348623157e+308} test expr-old-37.22 {Tcl_ExprDouble handles overflows that look like int} \ testexprdouble { testexprdouble 17976931348623157[string repeat 0 292] } {This is a result: 1.7976931348623157e+308} test expr-old-37.23 {Tcl_ExprDouble handles overflows} \ ieeeFloatingPoint&&testexprdouble { testexprdouble 17976931348623165[string repeat 0 292]. } {This is a result: Inf} test expr-old-37.24 {Tcl_ExprDouble handles overflows that look like int} \ ieeeFloatingPoint&&testexprdouble { testexprdouble 17976931348623165[string repeat 0 292] } {This is a result: Inf} test expr-old-37.25 {Tcl_ExprDouble and NaN} \ {ieeeFloatingPoint testexprdouble} { list [catch {testexprdouble 0.0/0.0} result] $result } {1 {domain error: argument not in valid range}} test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body { list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \ [catch {testexprstring "1+"} msg] $msg } -match glob -result {5 10.2 1 *} test expr-old-38.2 {Tcl_ExprString} testexprstring { # This one is "magical" testexprstring {} } 0 test expr-old-38.3 {Tcl_ExprString} -constraints testexprstring -body { testexprstring { } } -returnCodes error -match glob -result * # # Test for bug #908375: rounding numbers that do not fit in a # long but do fit in a wide # test expr-old-39.1 {Rounding with wide result} { set x 1.0e10 set y [expr $x + 0.1] catch { set x [list [expr {$x == round($y)}] [expr $x == -round(-$y)]] } set x } {1 1} unset -nocomplain x y # # TIP #255 min and max math functions # test expr-old-40.1 {min math function} -body { expr {min(0)} } -result 0 test expr-old-40.2 {min math function} -body { expr {min(0.0)} } -result 0.0 test expr-old-40.3 {min math function} -body { list [catch {expr {min()}} msg] $msg } -result {1 {not enough arguments to math function "min"}} test expr-old-40.4 {min math function} -body { expr {min(wide(-1) << 30, 4.5, -10)} } -result [expr {wide(-1) << 30}] test expr-old-40.5 {min math function} -body { expr {min("a", 0)} } -returnCodes error -match glob -result * test expr-old-40.6 {min math function} -body { expr {min(300, "0xFF")} } -result 255 test expr-old-41.1 {max math function} -body { expr {max(0)} } -result 0 test expr-old-41.2 {max math function} -body { expr {max(0.0)} } -result 0.0 test expr-old-41.3 {max math function} -body { list [catch {expr {max()}} msg] $msg } -result {1 {not enough arguments to math function "max"}} test expr-old-41.4 {max math function} -body { expr {max(wide(1) << 30, 4.5, -10)} } -result [expr {wide(1) << 30}] test expr-old-41.5 {max math function} -body { expr {max("a", 0)} } -returnCodes error -match glob -result * test expr-old-41.6 {max math function} -body { expr {max(200, "0xFF")} } -result 255 # Special test for Pentium arithmetic bug of 1994: if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} { puts "Warning: this machine contains a defective Pentium processor" puts "that performs arithmetic incorrectly. I recommend that you" puts "call Intel customer service immediately at 1-800-628-8686" puts "to request a replacement processor." } # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/expr.test0000644000175000017500000124210514554262142014670 0ustar sergeisergei# Commands covered: expr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testmathfunctions [expr { ([catch {expr {T1()}} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"}) }] # Determine if "long int" type is a 32 bit number and if the wide # type is a 64 bit number on this machine. testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] testConstraint wideIs64bit \ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues binary scan [binary format dd -1.0 1.0] c* c switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ ieeeValues(-Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ ieeeValues(+Normal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ ieeeValues(+Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ ieeeValues(NaN) binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \ ieeeValues(-NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-NaN) set ieeeValues(littleEndian) 0 return 1 } default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] # procedures used below proc put_hello_char {c} { global a append a [format %c $c] return $c } proc hello_world {} { global a set a "" set L1 [set l0 [set h_1 [set q 0]]] for {put_hello_char [expr [put_hello_char [expr [set h 7]*10+2]]+29]} {$l0?[put_hello_char $l0] :!$h_1} {put_hello_char $ll;expr {$L1==2?[set ll [expr 32+0-0+[set bar 0]]]:0}} {expr {[incr L1]==[expr 1+([string length "abc"]-[string length "abc"])] ?[set ll [set l0 [expr 54<<1]]]:$ll==108&&$L1<3? [incr ll [expr 1|1<<1]; set ll $ll; set ll $ll; set ll $ll; set ll $ll; set l0 [expr ([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])]; set l0; set l0 $l0; set l0; set l0]:$L1==4&&$ll==32?[set ll [expr 19+$h1+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+[set foo [expr ([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])]]]] :[set q [expr $q-$h1+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])]]};expr {$L1==5?[incr ll -8; set ll $ll; set ll]:$q&&$h1&&1};expr {$L1==4+2 ?[incr ll 3]:[expr ([string length "abc"]-[string length "abc"])+1]};expr {$ll==($h<<4)+2+0&&$L1!=6?[incr ll -6]:[set h1 [expr 100+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])]]} expr {$L1!=1<<3?[incr q [expr ([string length "abc"]-[string length "abc"])-1]]:[set h_1 [set ll $h1]]} } set a } proc 12days {a b c} { global xxx expr {1<$a?[expr {$a<3?[12days -79 -13 [string range $c [12days -87 \ [expr 1-$b] [string range $c [12days -86 0 [string range $c 1 end]] \ end]] end]]:1};expr {$a<$b?[12days [expr $a+1] $b $c]:3};expr {[12days \ -94 [expr $a-27] $c]&&$a==2?$b<13?[12days 2 [expr $b+1] "%s %d %d\n"]:9 :16}]:$a<0?$a<-72?[12days $b $a "@n'+,#'/*\{\}w+/w#cdnr/+,\{\}r/*de\}+,/*\{*+,/w\{%+,/w#q#n+,/#\{l+,/n\{n+,/+#n+,/#;#q#n+,/+k#;*+,/'r :'d*'3,\}\{w+K w'K:'+\}e#';dq#'l q#'+d'K#!/+k#;q#'r\}eKK#\}w'r\}eKK\{nl\]'/#;#q#n')\{)#\}w')\{)\{nl\]'/+#n';d\}rw' i;# )\{nl\]!/n\{n#'; r\{#w'r nc\{nl\]'/#\{l,+'K \{rw' iK\{;\[\{nl\]'/w#q#n'wk nw' iwk\{KK\{nl\]!/w\{%'l##w#' i; :\{nl\]'/*\{q#'ld;r'\}\{nlwb!/*de\}'c ;;\{nl'-\{\}rw\]'/+,\}##'*\}#nc,',#nw\]'/+kd'+e\}+;#'rdq#w! nr'/ ') \}+\}\{rl#'\{n' ')# \}'+\}##(!!/"] :$a<-50?[string compare [format %c $b] [string index $c 0]]==0?[append \ xxx [string index $c 31];scan [string index $c 31] %c x;set x] :[12days -65 $b [string range $c 1 end]]:[12days [expr ([string compare \ [string index $c 0] "/"]==0)+$a] $b [string range $c 1 end]]:0<$a ?[12days 2 2 "%s"]:[string compare [string index $c 0] "/"]==0|| [12days 0 [12days -61 [scan [string index $c 0] %c x; set x] \ "!ek;dc i@bK'(q)-\[w\]*%n+r3#l,\{\}:\nuwloca-O;m .vpbks,fxntdCeghiry"] \ [string range $c 1 end]]} } proc do_twelve_days {} { global xxx set xxx "" 12days 1 1 1 set result [string length $xxx] unset xxx return $result } # start of tests catch {unset a b i x} test expr-1.1 {TclCompileExprCmd: no expression} { list [catch {expr } msg] $msg } {1 {wrong # args: should be "expr arg ?arg ...?"}} test expr-1.2 {TclCompileExprCmd: one expression word} { expr -25 } -25 test expr-1.3 {TclCompileExprCmd: two expression words} { expr -8.2 -6 } -14.2 test expr-1.4 {TclCompileExprCmd: five expression words} { expr 20 - 5 +10 -7 } 18 test expr-1.5 {TclCompileExprCmd: quoted expression word} { expr "0005" } 5 test expr-1.6 {TclCompileExprCmd: quoted expression word} { catch {expr "0005"zxy} msg set msg } {extra characters after close-quote} test expr-1.7 {TclCompileExprCmd: expression word in braces} { expr {-0005} } -5 test expr-1.8 {TclCompileExprCmd: expression word in braces} { expr {{-0x1234}} } -4660 test expr-1.9 {TclCompileExprCmd: expression word in braces} { catch {expr {-0005}foo} msg set msg } {extra characters after close-brace} test expr-1.10 {TclCompileExprCmd: other expression word in braces} { expr 4*[llength "6 2"] } 8 test expr-1.11 {TclCompileExprCmd: expression word terminated by ;} { expr 4*[llength "6 2"]; } 8 test expr-1.12 {TclCompileExprCmd: inlined expr (in "catch") inside other catch} { set a xxx catch { # Might not be a number set a [expr 10*$a] } } 1 test expr-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} { set a xxx set x 27; set bool {$x}; if $bool {set a foo} set a } foo test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} { set a xxx set x 2; set b {$x}; set a [expr $b == 2] set a } 1 test expr-1.15 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} { set a xxx set x 2; set b {$x}; set a [expr $b eq 2] set a } 1 test expr-2.1 {TclCompileExpr: are builtin functions registered?} { expr double(5*[llength "6 2"]) } 10.0 test expr-2.2 {TclCompileExpr: error in expr} -body { expr 2***3 } -returnCodes error -match glob -result * test expr-2.3 {TclCompileExpr: junk after legal expr} -body { expr 7*[llength "a b"]foo } -returnCodes error -match glob -result * test expr-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} { expr {0001} } 1 test expr-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1 test expr-3.2 {CompileCondExpr: error in lor expr} -body { expr x||3 } -returnCodes error -match glob -result * test expr-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44 test expr-3.4 {CompileCondExpr: error compiling true arm} -body { expr 3>2?2***3:66 } -returnCodes error -match glob -result * test expr-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66 test expr-3.6 {CompileCondExpr: error compiling false arm} -body { expr 2>3?44:2***3 } -returnCodes error -match glob -result * test expr-3.7 {CompileCondExpr: long arms & nested cond exprs} { hello_world } {Hello world} test expr-3.8 {CompileCondExpr: long arms & nested cond exprs} unix { # Fails with a stack overflow on threaded Windows builds do_twelve_days } 2358 test expr-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1 test expr-4.2 {CompileLorExpr: error in land expr} -body { expr x&&3 } -returnCodes error -match glob -result * test expr-4.3 {CompileLorExpr: simple lor exprs} {expr 0||1.0} 1 test expr-4.4 {CompileLorExpr: simple lor exprs} {expr 3.0||0.0} 1 test expr-4.5 {CompileLorExpr: simple lor exprs} {expr 0||0||1} 1 test expr-4.6 {CompileLorExpr: error compiling lor arm} -body { expr 2***3||4.0 } -returnCodes error -match glob -result * test expr-4.7 {CompileLorExpr: error compiling lor arm} -body { expr 1.3||2***3 } -returnCodes error -match glob -result * test expr-4.8 {CompileLorExpr: error compiling lor arms} { list [catch {expr {"a"||"b"}} msg] $msg } {1 {expected boolean value but got "a"}} test expr-4.9 {CompileLorExpr: long lor arm} { set a "abcdefghijkl" set i 7 expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} } 1 test expr-4.10 {CompileLorExpr: error compiling ! operand} { list [catch {expr {!"a"}} msg] $msg } {1 {can't use non-numeric string as operand of "!"}} test expr-4.11 {CompileLorExpr: error compiling land arms} { list [catch {expr {"a"||0}} msg] $msg } {1 {expected boolean value but got "a"}} test expr-4.12 {CompileLorExpr: error compiling land arms} { list [catch {expr {0||"a"}} msg] $msg } {1 {expected boolean value but got "a"}} test expr-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23 test expr-5.2 {CompileLandExpr: error in bitor expr} -body { expr x|3 } -returnCodes error -match glob -result * test expr-5.3 {CompileLandExpr: simple land exprs} {expr 0&&1.0} 0 test expr-5.4 {CompileLandExpr: simple land exprs} {expr 0&&0} 0 test expr-5.5 {CompileLandExpr: simple land exprs} {expr 3.0&&1.2} 1 test expr-5.6 {CompileLandExpr: simple land exprs} {expr 1&&1&&2} 1 test expr-5.7 {CompileLandExpr: error compiling land arm} -body { expr 2***3&&4.0 } -returnCodes error -match glob -result * test expr-5.8 {CompileLandExpr: error compiling land arm} -body { expr 1.3&&2***3 } -returnCodes error -match glob -result * test expr-5.9 {CompileLandExpr: error compiling land arm} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} test expr-5.10 {CompileLandExpr: long land arms} { set a "abcdefghijkl" set i 7 expr {[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]} } 1 test expr-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3 test expr-6.2 {CompileBitXorExpr: error in bitand expr} -body { expr x|3 } -returnCodes error -match glob -result * test expr-6.3 {CompileBitXorExpr: simple bitxor exprs} {expr 7^0x13} 20 test expr-6.4 {CompileBitXorExpr: simple bitxor exprs} {expr 3^0x10} 19 test expr-6.5 {CompileBitXorExpr: simple bitxor exprs} {expr 0^7} 7 test expr-6.6 {CompileBitXorExpr: simple bitxor exprs} {expr -1^7} -8 test expr-6.7 {CompileBitXorExpr: error compiling bitxor arm} -body { expr 2***3|6 } -returnCodes error -match glob -result * test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { expr 2^x } -returnCodes error -match glob -result * test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg } {1 {can't use floating-point value as operand of "^"}} test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "^"}} test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1 test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0 test expr-7.5 {CompileBitAndExpr: error in equality expr} -body { expr x==3 } -returnCodes error -match glob -result * test expr-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3 test expr-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82 test expr-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2 test expr-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7 test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} -body { expr 2***3&6 } -returnCodes error -match glob -result * test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { expr 2&x } -returnCodes error -match glob -result * test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg } {1 {can't use floating-point value as operand of "&"}} test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "&"}} test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-7.20 {CompileBitAndExpr: error in equality expr} -body { expr xne3 } -returnCodes error -match glob -result * test expr-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1 test expr-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1 test expr-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1 test expr-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0 test expr-8.5 {CompileEqualityExpr: error in relational expr} -body { expr x>3 } -returnCodes error -match glob -result * test expr-8.6 {CompileEqualityExpr: simple equality exprs} {expr 7==0x13} 0 test expr-8.7 {CompileEqualityExpr: simple equality exprs} {expr -0xf2!=0x53} 1 test expr-8.8 {CompileEqualityExpr: simple equality exprs} {expr {"12398712938788234-1298379" != ""}} 1 test expr-8.9 {CompileEqualityExpr: simple equality exprs} {expr -1!="abc"} 1 test expr-8.10 {CompileEqualityExpr: error compiling equality arm} -body { expr 2***3==6 } -returnCodes error -match glob -result * test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body { expr 2!=x } -returnCodes error -match glob -result * test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1 test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \xFC]}} 1 test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0 test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1 test expr-8.17 {CompileBitAndExpr: equality expr} {expr 01eq1} 0 test expr-8.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-8.19 {CompileBitAndExpr: equality expr} {expr {"abc" ne "abd"}} 1 test expr-8.20 {CompileBitAndExpr: error in equality expr} -body { expr x ne3 } -returnCodes error -match glob -result * test expr-8.21 {CompileBitAndExpr: error in equality expr} -body { # These should be ""ed to avoid the error expr a eq b } -returnCodes error -match glob -result * test expr-8.22 {CompileBitAndExpr: error in equality expr} -body { expr {false eqfalse} } -returnCodes error -match glob -result * test expr-8.23 {CompileBitAndExpr: error in equality expr} -body { expr {false nefalse} } -returnCodes error -match glob -result * test expr-8.24 {CompileEqualityExpr: simple equality exprs} { set x 12398712938788234 expr {$x == 100} } 0 test expr-8.25 {CompileEqualityExpr: simple equality exprs} { expr {"0x12 " == "0x12"} } 1 test expr-8.26 {CompileEqualityExpr: simple equality exprs} { expr {"0x12 " eq "0x12"} } 0 test expr-8.27 {CompileEqualityExpr: simple equality exprs} { expr {"1.0e100000000" == "0.0"} } 0 test expr-8.28 {CompileEqualityExpr: just relational expr} { expr {"0y" == "0x0"} } 0 test expr-8.29 {CompileEqualityExpr: just relational expr} { # Compare original strings from variables. set v1 "0y" set v2 "0x12" expr {$v1 < $v2} } 0 test expr-8.30 {CompileEqualityExpr: simple equality exprs} { expr {"fake" != "bob"} } 1 test expr-8.31 {expr edge cases} -body { expr {1e} } -returnCodes error -match glob -result * test expr-8.32 {expr edge cases} -body { expr {1E} } -returnCodes error -match glob -result * test expr-8.33 {expr edge cases} -body { expr {1e+} } -returnCodes error -match glob -result * test expr-8.34 {expr edge cases} -body { expr {1E+} } -returnCodes error -match glob -result * test expr-8.35 {expr edge cases} -body { expr {1ea} } -returnCodes error -match glob -result * test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63 test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1 test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8 test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit { expr {int(1<<63)} } -9223372036854775808 test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit { expr {int(1<<31)} } -2147483648 test expr-9.6 {CompileRelationalExpr: error in shift expr} -body { expr x>>3 } -returnCodes error -match glob -result * test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1 test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1 test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body { expr 2***3>6 } -returnCodes error -match glob -result * test expr-9.10 {CompileRelationalExpr: error compiling relational arm} -body { expr 2>0x3} 31 test expr-10.7 {CompileShiftExpr: simple shift exprs} {expr -0xf2<<0x3} -1936 test expr-10.8 {CompileShiftExpr: error compiling shift arm} -body { expr 2***3>>6 } -returnCodes error -match glob -result * test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body { expr 2<>43}} msg] $msg } {1 {can't use floating-point value as operand of ">>"}} test expr-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "<<"}} test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1 test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6 test expr-11.5 {CompileAddExpr: error in multiply expr} -body { expr x*3 } -returnCodes error -match glob -result * test expr-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258 test expr-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239 test expr-11.8 {CompileAddExpr: error compiling add arm} -body { expr 2***3+6 } -returnCodes error -match glob -result * test expr-11.9 {CompileAddExpr: error compiling add arm} -body { expr 2-x } -returnCodes error -match glob -result * test expr-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test expr-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} test expr-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} test expr-11.13a {CompileAddExpr: runtime error} !ieeeFloatingPoint { list [catch {expr {2.3/0.0}} msg] $msg } {1 {divide by zero}} test expr-11.13b {CompileAddExpr: runtime error} ieeeFloatingPoint { list [catch {expr {2.3/0.0}} msg] $msg } {0 Inf} test expr-12.1 {CompileMultiplyExpr: just unary expr} {expr ~4} -5 test expr-12.2 {CompileMultiplyExpr: just unary expr} {expr --5} 5 test expr-12.3 {CompileMultiplyExpr: just unary expr} {expr !27} 0 test expr-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936 test expr-12.5 {CompileMultiplyExpr: error in unary expr} -body { expr ~x } -returnCodes error -match glob -result * test expr-12.6 {CompileMultiplyExpr: simple multiply exprs} {expr 0xff*0x3} 765 test expr-12.7 {CompileMultiplyExpr: simple multiply exprs} {expr -0xf2%-0x3} -2 test expr-12.8 {CompileMultiplyExpr: error compiling multiply arm} -body { expr 2*3%%6 } -returnCodes error -match glob -result * test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { expr 2*x } -returnCodes error -match glob -result * test expr-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg } {1 {can't use non-numeric string as operand of "*"}} test expr-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg } {1 {can't use non-numeric string as operand of "/"}} test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36 test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0 test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0 test expr-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1 test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0 test expr-13.8 {CompileUnaryExpr: error compiling unary expr} -body { expr ~x } -returnCodes error -match glob -result * test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body { expr !1.x } -returnCodes error -match glob -result * test expr-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg } {1 {can't use non-numeric string as operand of "~"}} test expr-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg } {1 {can't use floating-point value as operand of "~"}} test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test expr-13.13 {CompileUnaryExpr: just primary expr} { set a 27 expr $a } 27 test expr-13.14 {CompileUnaryExpr: just primary expr} { expr double(27) } 27.0 test expr-13.15 {CompileUnaryExpr: just primary expr} {expr "123"} 123 test expr-13.16 {CompileUnaryExpr: error in primary expr} { catch {expr [set]} msg set msg } {wrong # args: should be "set varName ?newValue?"} test expr-13.17 {CompileUnaryExpr: negating non-numeric boolean literals} { set a1 yes; set a0 no; set b1 true; set b0 false list [expr {!$a1}] [expr {!$a0}] [expr {!$b1}] [expr {!$b0}] } {0 1 0 1} test expr-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1 test expr-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123 test expr-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255 test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 0o0010} 8 test expr-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0 test expr-14.6 {CompilePrimaryExpr: literal primary} { expr 3.1400000 } 3.14 test expr-14.7 {CompilePrimaryExpr: literal primary} {expr {{abcde}<{abcdef}}} 1 test expr-14.8 {CompilePrimaryExpr: literal primary} {expr {{abc\ def} < {abcdef}}} 1 test expr-14.9 {CompilePrimaryExpr: literal primary} {expr {{abc\tde} > {abc\tdef}}} 0 test expr-14.10 {CompilePrimaryExpr: literal primary} {expr {{123}}} 123 test expr-14.11 {CompilePrimaryExpr: var reference primary} { set i 789 list [expr {$i}] [expr $i] } {789 789} test expr-14.12 {CompilePrimaryExpr: var reference primary} { set i {789} ;# test expr's aggressive conversion to numeric semantics list [expr {$i}] [expr $i] } {789 789} test expr-14.13 {CompilePrimaryExpr: var reference primary} { catch {unset a} set a(foo) foo set a(bar) bar set a(123) 123 set result "" lappend result [expr $a(123)] [expr {$a(bar)<$a(foo)}] catch {unset a} set result } {123 1} test expr-14.14 {CompilePrimaryExpr: var reference primary} { set i 123 ;# test "$var.0" floating point conversion hack list [expr $i] [expr $i.0] [expr $i.0/12.0] } {123 123.0 10.25} test expr-14.15 {CompilePrimaryExpr: var reference primary} { set i 123 catch {expr $i.2} msg set msg } 123.2 test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} -body { expr {$a(foo} } -returnCodes error -match glob -result * test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} -body { expr $ } -returnCodes error -match glob -result * test expr-14.18 {CompilePrimaryExpr: quoted string primary} { expr "21" } 21 test expr-14.19 {CompilePrimaryExpr: quoted string primary} { set i 123 set x 456 expr "$i+$x" } 579 test expr-14.20 {CompilePrimaryExpr: quoted string primary} { set i 3 set x 6 expr 2+"$i.$x" } 5.6 test expr-14.21 {CompilePrimaryExpr: error in quoted string primary} { catch {expr "[set]"} msg set msg } {wrong # args: should be "set varName ?newValue?"} test expr-14.22 {CompilePrimaryExpr: subcommand primary} { expr {[set i 123; set i]} } 123 test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} -body { catch {expr {[set]}} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} -body { expr {[set i} } -returnCodes error -match glob -result * test expr-14.25 {CompilePrimaryExpr: math function primary} { format %.6g [expr exp(1.0)] } 2.71828 test expr-14.26 {CompilePrimaryExpr: math function primary} { format %.6g [expr pow(2.0+0.1,3.0+0.1)] } 9.97424 test expr-14.27 {CompilePrimaryExpr: error in math function primary} -body { expr sinh::(2.0) } -returnCodes error -match glob -result * test expr-14.28 {CompilePrimaryExpr: subexpression primary} { expr 2+(3*4) } 14 test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} -body { catch {expr 2+(3*[set])} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} -body { expr 2+(3*(4+5) } -returnCodes error -match glob -result * test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} { set i "5+10" list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15" } {{15 == 15} {15 == 15} {15 == 15}} test expr-14.32 {CompilePrimaryExpr: unexpected token} -body { expr @ } -returnCodes error -match glob -result * test expr-15.1 {CompileMathFuncCall: missing parenthesis} -body { expr sinh2.0) } -returnCodes error -match glob -result * test expr-15.2 {CompileMathFuncCall: unknown math function} -body { catch {expr whazzathuh(1)} msg set ::errorInfo } -match glob -result {* "*whazzathuh" while *ing "expr whazzathuh(1)"} test expr-15.3 {CompileMathFuncCall: too many arguments} -body { catch {expr sin(1,2,3)} msg set ::errorInfo } -match glob -result {too many arguments for math function* while *ing "expr sin(1,2,3)"} test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} -body { catch {expr sin()} msg set ::errorInfo } -match glob -result {not enough arguments for math function* while *ing "expr sin()"} test expr-15.5 {CompileMathFuncCall: not enough arguments} -body { catch {expr pow(1)} msg set ::errorInfo } -match glob -result {not enough arguments for math function* while *ing "expr pow(1)"} test expr-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} { expr 2*T1() } 246 test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} { expr T2()*3 } 1035 test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} { expr T3(21, 37) } 37 test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} { expr T3(21.2, 37) } 37.0 test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} { expr T3(-21.2, -17.5) } -17.5 test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} { expr T3(21, wide(37)) } 37 test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} { expr T3(wide(21), 37) } 37 test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} { expr T3(wide(21), wide(37)) } 37 test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} { expr T3(21.0, wide(37)) } 37.0 test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} { expr T3(wide(21), 37.0) } 37.0 test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints { testmathfunctions } -body { expr T3(0,"a") } -returnCodes error -result {argument to math function didn't have numeric value} test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { catch {unset a} set a(VALUE) ff15 set i 123 if {[expr 0x$a(VALUE)] & 16} { set i {} } set i } {} test expr-16.2 {GetToken: check for string literal in braces} { expr {{1}} } {1} # Check "expr" and computed command names. test expr-17.1 {expr and computed command names} { set i 0 set z expr $z 1+2 } 3 # Check correct conversion of operands to numbers: If the string looks like # an integer, convert to integer. Otherwise, if the string looks like a # double, convert to double. test expr-18.1 {expr and conversion of operands to numbers} { set x [lindex 11 0] catch {expr int($x)} expr {$x} } 11 test expr-18.2 {whitespace strings should not be == 0 (buggy strtod)} { expr {" "} } { } # Check "expr" and interpreter result object resetting before appending # an error msg during evaluation of exprs not in {}s test expr-19.1 {expr and interpreter result object resetting} { proc p {} { set t 10.0 set x 2.0 set dx 0.2 set f {$dx-$x/10} set g {-$x/5} set center 1.0 set x [expr $x-$center] set dx [expr $dx+$g] set x [expr $x+$f+$center] set x [expr $x+$f+$center] set y [expr round($x)] } p } 3 # Test for incorrect "double evaluation" semantics test expr-20.1 {wrong brace matching} { catch {unset l} catch {unset r} catch {unset q} catch {unset cmd} catch {unset a} set l "\{"; set r "\}"; set q "\"" set cmd "expr $l$q|$q == $q$r$q$r" list [catch $cmd a] $a } {1 {extra characters after close-brace}} test expr-20.2 {double invocation of variable traces} -body { set exprtracecounter 0 proc exprtraceproc {args} { upvar #0 exprtracecounter counter set argc [llength $args] set extraargs [lrange $args 0 [expr {$argc - 4}]] set name [lindex $args [expr {$argc - 3}]] upvar 1 $name var if {[incr counter] % 2 == 1} { set var "$counter oops [concat $extraargs]" } else { set var "$counter + [concat $extraargs]" } } trace add variable exprtracevar read [list exprtraceproc 10] list [catch {expr "$exprtracevar + 20"} a] $a \ [catch {expr "$exprtracevar + 20"} b] $b \ [unset exprtracevar exprtracecounter] } -match glob -result {1 * 0 32 {}} test expr-20.3 {broken substitution of integer digits} { # fails with 8.0.x, but not 8.1b2 list [set a 000; expr 0x1$a] [set a 1; expr ${a}000] } {4096 1000} test expr-20.4 {proper double evaluation compilation, error case} { catch {unset a}; # make sure $a doesn't exist list [catch {expr 1?{$a}:0} msg] $msg } {1 {can't read "a": no such variable}} test expr-20.5 {proper double evaluation compilation, working case} { set a yellow expr 1?{$a}:0 } yellow test expr-20.6 {handling of compile error in trial compile} { list [catch {expr + {[incr]}} msg] $msg } {1 {wrong # args: should be "incr varName ?increment?"}} test expr-20.7 {handling of compile error in runtime case} { list [catch {expr + {[error foo]}} msg] $msg } {1 foo} # Test for non-numeric boolean literal handling test expr-21.1 {non-numeric boolean literals} {expr false } false test expr-21.2 {non-numeric boolean literals} {expr true } true test expr-21.3 {non-numeric boolean literals} {expr off } off test expr-21.4 {non-numeric boolean literals} {expr on } on test expr-21.5 {non-numeric boolean literals} {expr no } no test expr-21.6 {non-numeric boolean literals} {expr yes } yes test expr-21.7 {non-numeric boolean literals} {expr !false} 1 test expr-21.8 {non-numeric boolean literals} {expr !true } 0 test expr-21.9 {non-numeric boolean literals} {expr !off } 1 test expr-21.10 {non-numeric boolean literals} {expr !on } 0 test expr-21.11 {non-numeric boolean literals} {expr !no } 1 test expr-21.12 {non-numeric boolean literals} {expr !yes } 0 test expr-21.13 {non-numeric boolean literals} -body { expr !truef } -returnCodes error -match glob -result * test expr-21.14 {non-numeric boolean literals} { list [catch {expr !"truef"} err] $err } {1 {can't use non-numeric string as operand of "!"}} test expr-21.15 {non-numeric boolean variables} { set v truef list [catch {expr {!$v}} err] $err } {1 {can't use non-numeric string as operand of "!"}} test expr-21.16 {non-numeric boolean variables} { set v "true " list [catch {expr {!$v}} err] $err } {1 {can't use non-numeric string as operand of "!"}} test expr-21.17 {non-numeric boolean variables} { set v "tru" list [catch {expr {!$v}} err] $err } {0 0} test expr-21.18 {non-numeric boolean variables} { set v "fal" list [catch {expr {!$v}} err] $err } {0 1} test expr-21.19 {non-numeric boolean variables} { set v "y" list [catch {expr {!$v}} err] $err } {0 0} test expr-21.20 {non-numeric boolean variables} { set v "of" list [catch {expr {!$v}} err] $err } {0 1} test expr-21.21 {non-numeric boolean variables} { set v "o" list [catch {expr {!$v}} err] $err } {1 {can't use non-numeric string as operand of "!"}} test expr-21.22 {non-numeric boolean variables} { set v "" list [catch {expr {!$v}} err] $err } {1 {can't use empty string as operand of "!"}} # Test for non-numeric float handling. test expr-22.1 {non-numeric floats} { list [catch {expr {NaN + 1}} msg] $msg } {1 {can't use non-numeric floating-point value as operand of "+"}} test expr-22.2 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {Inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.3 {non-numeric floats} { set nan NaN list [catch {expr {$nan + 1}} msg] $msg } {1 {can't use non-numeric floating-point value as operand of "+"}} test expr-22.4 {non-numeric floats} !ieeeFloatingPoint { set inf Inf list [catch {expr {$inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.5 {non-numeric floats} { list [catch {expr NaN} msg] $msg } {1 {domain error: argument not in valid range}} test expr-22.6 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr Inf} msg] $msg } {1 {floating-point value too large to represent}} test expr-22.7 {non-numeric floats} { list [catch {expr {1 / NaN}} msg] $msg } {1 {can't use non-numeric floating-point value as operand of "/"}} test expr-22.8 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {1 / Inf}} msg] $msg } {1 {can't use infinite floating-point value as operand of "/"}} # Make sure [Bug 761471] stays fixed. test expr-22.9 {non-numeric floats: shared object equality and NaN} { set x NaN expr {$x == $x} } 0 # Make sure [Bug d0f7ba56f0] stays fixed. test expr-22.10 {non-numeric arguments: equality and NaN} { set x NaN expr {$x > "Gran"} } 1 test expr-22.11 {non-numeric arguments: equality and NaN} { set x NaN expr {"Gran" < $x} } 1 # Tests for exponentiation handling test expr-23.1 {CompileExponentialExpr: just exponential expr} {expr 4**2} 16 test expr-23.2 {CompileExponentialExpr: just exponential expr} {expr 0xff**2} 65025 test expr-23.3 {CompileExponentialExpr: just exponential expr} {expr -1**2} 1 test expr-23.4 {CompileExponentialExpr: just exponential expr} {expr 18**07} 612220032 test expr-23.5 {CompileExponentialExpr: error in exponential expr} -body { expr x**3 } -returnCodes error -match glob -result * test expr-23.6 {CompileExponentialExpr: simple expo exprs} {expr 0xff**0x3} 16581375 test expr-23.7 {CompileExponentialExpr: error compiling expo arm} -body { expr (-3-)**6 } -returnCodes error -match glob -result * test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body { expr 2**x } -returnCodes error -match glob -result * test expr-23.9 {CompileExponentialExpr: runtime error} { list [catch {expr {24.0**"xx"}} msg] $msg } {1 {can't use non-numeric string as operand of "**"}} test expr-23.10 {CompileExponentialExpr: runtime error} { list [catch {expr {"a"**2}} msg] $msg } {1 {can't use non-numeric string as operand of "**"}} test expr-23.11 {CompileExponentialExpr: runtime error} { list [catch {expr {0**-1}} msg] $msg } {1 {exponentiation of zero by negative power}} test expr-23.12 {CompileExponentialExpr: runtime error} { list [catch {expr {0.0**-1.0}} msg] $msg } {1 {exponentiation of zero by negative power}} test expr-23.13 {CompileExponentialExpr: runtime error} { list [catch {expr {wide(0)**wide(-1)}} msg] $msg } {1 {exponentiation of zero by negative power}} test expr-23.14 {INST_EXPON: special cases} {expr {0**1}} 0 test expr-23.15 {INST_EXPON: special cases} {expr {0**0}} 1 test expr-23.16 {INST_EXPON: special cases} {expr {-2**-1}} 0 test expr-23.17 {INST_EXPON: special cases} {expr {-2**0}} 1 test expr-23.18 {INST_EXPON: special cases} {expr {-1**1}} -1 test expr-23.19 {INST_EXPON: special cases} {expr {-1**0}} 1 test expr-23.20 {INST_EXPON: special cases} {expr {-1**2}} 1 test expr-23.21 {INST_EXPON: special cases} {expr {-1**-1}} -1 test expr-23.22 {INST_EXPON: special cases} {expr {1**1234567}} 1 test expr-23.23 {INST_EXPON: special cases} {expr {2**-2}} 0 test expr-23.24 {INST_EXPON: special cases} {expr {wide(0)**wide(1)}} 0 test expr-23.25 {INST_EXPON: special cases} {expr {wide(0)**wide(0)}} 1 test expr-23.26 {INST_EXPON: special cases} {expr {wide(-2)**wide(-1)}} 0 test expr-23.27 {INST_EXPON: special cases} {expr {wide(-2)**wide(0)}} 1 test expr-23.28 {INST_EXPON: special cases} {expr {wide(-1)**wide(1)}} -1 test expr-23.29 {INST_EXPON: special cases} {expr {wide(-1)**wide(0)}} 1 test expr-23.30 {INST_EXPON: special cases} {expr {wide(-1)**wide(2)}} 1 test expr-23.31 {INST_EXPON: special cases} {expr {wide(-1)**wide(-1)}} -1 test expr-23.32 {INST_EXPON: special cases} {expr {wide(1)**wide(1234567)}} 1 test expr-23.33 {INST_EXPON: special cases} {expr {wide(2)**wide(-2)}} 0 test expr-23.34 {INST_EXPON: special cases} {expr {2**0}} 1 test expr-23.35 {INST_EXPON: special cases} {expr {wide(2)**0}} 1 test expr-23.36 {INST_EXPON: big integer} {expr {10**17}} 1[string repeat 0 17] test expr-23.37 {INST_EXPON: big integer} {expr {10**18}} 1[string repeat 0 18] test expr-23.38 {INST_EXPON: big integer} {expr {10**19}} 1[string repeat 0 19] test expr-23.39 {INST_EXPON: big integer} { expr 1[string repeat 0 30]**2 } 1[string repeat 0 60] test expr-23.40 {INST_EXPON: overflow to big integer} {expr {(-10)**3}} -1000 test expr-23.41 {INST_EXPON: overflow to big integer} {expr 2**64} [expr 1<<64] test expr-23.42 {INST_EXPON: overflow to big integer} {expr 4**32} [expr 1<<64] test expr-23.43 {INST_EXPON: overflow to big integer} {expr 16**16} [expr 1<<64] test expr-23.44 {INST_EXPON: overflow to big integer} {expr 256**8} [expr 1<<64] test expr-23.45 {INST_EXPON: Bug 1555371} {expr 2**1} 2 test expr-23.46 {INST_EXPON: Bug 1561260} -body { expr 5**28 } -match glob -result *5 test expr-23.47 {INST_EXPON: Bug 1561260} { expr 2**32*5**32 } 1[string repeat 0 32] test expr-23.48 {INST_EXPON: TIP 274: right assoc} { expr 2**3**4 } 2417851639229258349412352 test expr-23.49 {INST_EXPON: optimize powers of 2} { set trouble {test powers of 2} for {set tval 0} {$tval <= 66} {incr tval} { set is [expr {2 ** $tval}] set sb [expr {1 << $tval}] if {$is != $sb} { append trouble \n "2**" $tval " is " $is " should be " $sb } if {$tval >= 1} { set is [expr {-2 ** $tval}] set sb [expr {1 << $tval}] if {$tval & 1} { set sb [expr {-$sb}] } if {$is != $sb} { append trouble \n "-2**" $tval " is " $is " should be " $sb } } } set trouble } {test powers of 2} test expr-23.50 {INST_EXPON: small powers of 32-bit integers} { set trouble {test small powers of 32-bit ints} for {set base 3} {$base <= 45} {incr base} { set sb $base set sbm [expr {-$base}] for {set expt 2} {$expt <= 8} {incr expt} { set sb [expr {$sb * $base}] set is [expr {$base ** $expt}] if {$sb != $is} { append trouble \n $base ** $expt " is " $is " should be " $sb } set sbm [expr {-$sbm * $base}] set ism [expr {(-$base) ** $expt}] if {$sbm != $ism} { append trouble \n - $base ** $expt " is " $ism \ " should be " $sbm } } } set trouble } {test small powers of 32-bit ints} test expr-23.51 {INST_EXPON: intermediate powers of 32-bit integers} { set trouble {test intermediate powers of 32-bit ints} for {set base 3} {$base <= 11} {incr base} { set sb [expr {$base ** 8}] set sbm $sb for {set expt 9} {$expt <= 21} {incr expt} { set sb [expr {$sb * $base}] set sbm [expr {$sbm * -$base}] set is [expr {$base ** $expt}] set ism [expr {-$base ** $expt}] if {$sb != $is} { append trouble \n $base ** $expt " is " $is " should be " $sb } if {$sbm != $ism} { append trouble \n - $base ** $expt " is " $ism \ " should be " $sbm } } } set trouble } {test intermediate powers of 32-bit ints} test expr-23.52 {INST_EXPON: small integer powers with 64-bit results} { set trouble {test small int powers with 64-bit results} for {set exp 2} {$exp <= 16} {incr exp} { set base [expr {entier(pow(double(0x7fffffffffffffff),(1.0/$exp)))}] set sb 1 set sbm 1 for {set i 0} {$i < $exp} {incr i} { set sb [expr {$sb * $base}] set sbm [expr {$sbm * -$base}] } set is [expr {$base ** $exp}] set ism [expr {-$base ** $exp}] if {$sb != $is} { append trouble \n $base ** $exp " is " $is " should be " $sb } if {$sbm != $ism} { append trouble \n - $base ** $exp " is " $ism " should be " $sbm } incr base set sb 1 set sbm 1 for {set i 0} {$i < $exp} {incr i} { set sb [expr {$sb * $base}] set sbm [expr {$sbm * -$base}] } set is [expr {$base ** $exp}] set ism [expr {-$base ** $exp}] if {$sb != $is} { append trouble \n $base ** $exp " is " $is " should be " $sb } if {$sbm != $ism} { append trouble \n - $base ** $exp " is " $ism " should be " $sbm } } set trouble } {test small int powers with 64-bit results} test expr-23.53 {INST_EXPON: intermediate powers of 64-bit integers} { set trouble {test intermediate powers of 64-bit ints} for {set base 3} {$base <= 13} {incr base} { set sb [expr {$base ** 15}] set sbm [expr {-$sb}] for {set expt 16} {$expt <= 39} {incr expt} { set sb [expr {$sb * $base}] set sbm [expr {$sbm * -$base}] set is [expr {$base ** $expt}] set ism [expr {-$base ** $expt}] if {$sb != $is} { append trouble \n $base ** $expt " is " $is " should be " $sb } if {$sbm != $ism} { append trouble \n - $base ** $expt " is " $ism \ " should be " $sbm } } } set trouble } {test intermediate powers of 64-bit ints} test expr-23.54.0 {INST_EXPON: Bug 2798543} { expr {3**9 == 3**65545} } 0 test expr-23.54.1 {INST_EXPON: Bug 2798543} { expr {3**10 == 3**65546} } 0 test expr-23.54.2 {INST_EXPON: Bug 2798543} { expr {3**11 == 3**65547} } 0 test expr-23.54.3 {INST_EXPON: Bug 2798543} { expr {3**12 == 3**65548} } 0 test expr-23.54.4 {INST_EXPON: Bug 2798543} { expr {3**13 == 3**65549} } 0 test expr-23.54.5 {INST_EXPON: Bug 2798543} { expr {3**14 == 3**65550} } 0 test expr-23.54.6 {INST_EXPON: Bug 2798543} { expr {3**15 == 3**65551} } 0 test expr-23.54.7 {INST_EXPON: Bug 2798543} { expr {3**16 == 3**65552} } 0 test expr-23.54.8 {INST_EXPON: Bug 2798543} { expr {3**17 == 3**65553} } 0 test expr-23.54.9 {INST_EXPON: Bug 2798543} { expr {3**18 == 3**65554} } 0 test expr-23.54.10 {INST_EXPON: Bug 2798543} { expr {3**19 == 3**65555} } 0 test expr-23.54.11 {INST_EXPON: Bug 2798543} { expr {3**9 == 3**131081} } 0 test expr-23.54.12 {INST_EXPON: Bug 2798543} -body { expr {3**268435456} } -returnCodes error -result {exponent too large} test expr-23.54.13 {INST_EXPON: Bug 2798543} { expr {(-3)**9 == (-3)**65545} } 0 test expr-23.55.0 {INST_EXPON: Bug 2798543} { expr {4**9 == 4**65545} } 0 test expr-23.55.1 {INST_EXPON: Bug 2798543} { expr {4**15 == 4**65551} } 0 test expr-23.55.2 {INST_EXPON: Bug 2798543} { expr {4**9 == 4**131081} } 0 test expr-23.55.3 {INST_EXPON: Bug 2798543} -body { expr {4**268435456} } -returnCodes error -result {exponent too large} test expr-23.55.4 {INST_EXPON: Bug 2798543} { expr {(-4)**9 == (-4)**65545} } 0 test expr-23.56.0 {INST_EXPON: Bug 2798543} { expr {5**9 == 5**65545} } 0 test expr-23.56.1 {INST_EXPON: Bug 2798543} { expr {5**13 == 5**65549} } 0 test expr-23.56.2 {INST_EXPON: Bug 2798543} { expr {5**9 == 5**131081} } 0 test expr-23.56.3 {INST_EXPON: Bug 2798543} -body { expr {5**268435456} } -returnCodes error -result {exponent too large} test expr-23.56.4 {INST_EXPON: Bug 2798543} { expr {(-5)**9 == (-5)**65545} } 0 test expr-23.57.0 {INST_EXPON: Bug 2798543} { expr {6**9 == 6**65545} } 0 test expr-23.57.1 {INST_EXPON: Bug 2798543} { expr {6**11 == 6**65547} } 0 test expr-23.57.2 {INST_EXPON: Bug 2798543} { expr {6**9 == 6**131081} } 0 test expr-23.57.3 {INST_EXPON: Bug 2798543} -body { expr {6**268435456} } -returnCodes error -result {exponent too large} test expr-23.57.4 {INST_EXPON: Bug 2798543} { expr {(-6)**9 == (-6)**65545} } 0 test expr-23.58.0 {INST_EXPON: Bug 2798543} { expr {7**9 == 7**65545} } 0 test expr-23.58.1 {INST_EXPON: Bug 2798543} { expr {7**11 == 7**65547} } 0 test expr-23.58.2 {INST_EXPON: Bug 2798543} { expr {7**9 == 7**131081} } 0 test expr-23.58.3 {INST_EXPON: Bug 2798543} -body { expr {7**268435456} } -returnCodes error -result {exponent too large} test expr-23.58.4 {INST_EXPON: Bug 2798543} { expr {(-7)**9 == (-7)**65545} } 0 test expr-23.59.0 {INST_EXPON: Bug 2798543} { expr {8**9 == 8**65545} } 0 test expr-23.59.1 {INST_EXPON: Bug 2798543} { expr {8**10 == 8**65546} } 0 test expr-23.59.2 {INST_EXPON: Bug 2798543} { expr {8**9 == 8**131081} } 0 test expr-23.59.3 {INST_EXPON: Bug 2798543} -body { expr {8**268435456} } -returnCodes error -result {exponent too large} test expr-23.59.4 {INST_EXPON: Bug 2798543} { expr {(-8)**9 == (-8)**65545} } 0 test expr-23.60.0 {INST_EXPON: Bug 2798543} { expr {9**9 == 9**65545} } 0 test expr-23.60.1 {INST_EXPON: Bug 2798543} { expr {9**9 == 9**131081} } 0 test expr-23.60.2 {INST_EXPON: Bug 2798543} -body { expr {9**268435456} } -returnCodes error -result {exponent too large} test expr-23.60.3 {INST_EXPON: Bug 2798543} { expr {(-9)**9 == (-9)**65545} } 0 test expr-23.61.0 {INST_EXPON: Bug 2798543} { expr {10**9 == 10**65545} } 0 test expr-23.61.1 {INST_EXPON: Bug 2798543} { expr {10**9 == 10**131081} } 0 test expr-23.61.2 {INST_EXPON: Bug 2798543} -body { expr {10**268435456} } -returnCodes error -result {exponent too large} test expr-23.61.3 {INST_EXPON: Bug 2798543} { expr {(-10)**9 == (-10)**65545} } 0 test expr-23.62.0 {INST_EXPON: Bug 2798543} { expr {11**9 == 11**65545} } 0 test expr-23.62.1 {INST_EXPON: Bug 2798543} { expr {11**9 == 11**131081} } 0 test expr-23.62.2 {INST_EXPON: Bug 2798543} -body { expr {11**268435456} } -returnCodes error -result {exponent too large} test expr-23.62.3 {INST_EXPON: Bug 2798543} { expr {(-11)**9 == (-11)**65545} } 0 test expr-23.63.0 {INST_EXPON: Bug 2798543} { expr {3**20 == 3**65556} } 0 test expr-23.63.1 {INST_EXPON: Bug 2798543} { expr {3**39 == 3**65575} } 0 test expr-23.63.2 {INST_EXPON: Bug 2798543} { expr {3**20 == 3**131092} } 0 test expr-23.63.3 {INST_EXPON: Bug 2798543} -body { expr {3**268435456} } -returnCodes error -result {exponent too large} test expr-23.63.4 {INST_EXPON: Bug 2798543} { expr {(-3)**20 == (-3)**65556} } 0 test expr-23.64.0 {INST_EXPON: Bug 2798543} { expr {4**17 == 4**65553} } 0 test expr-23.64.1 {INST_EXPON: Bug 2798543} { expr {4**31 == 4**65567} } 0 test expr-23.64.2 {INST_EXPON: Bug 2798543} { expr {4**17 == 4**131089} } 0 test expr-23.64.3 {INST_EXPON: Bug 2798543} -body { expr {4**268435456} } -returnCodes error -result {exponent too large} test expr-23.64.4 {INST_EXPON: Bug 2798543} { expr {(-4)**17 == (-4)**65553} } 0 test expr-23.65.0 {INST_EXPON: Bug 2798543} { expr {5**17 == 5**65553} } 0 test expr-23.65.1 {INST_EXPON: Bug 2798543} { expr {5**27 == 5**65563} } 0 test expr-23.65.2 {INST_EXPON: Bug 2798543} { expr {5**17 == 5**131089} } 0 test expr-23.65.3 {INST_EXPON: Bug 2798543} -body { expr {5**268435456} } -returnCodes error -result {exponent too large} test expr-23.65.4 {INST_EXPON: Bug 2798543} { expr {(-5)**17 == (-5)**65553} } 0 test expr-23.66.0 {INST_EXPON: Bug 2798543} { expr {6**17 == 6**65553} } 0 test expr-23.66.1 {INST_EXPON: Bug 2798543} { expr {6**24 == 6**65560} } 0 test expr-23.66.2 {INST_EXPON: Bug 2798543} { expr {6**17 == 6**131089} } 0 test expr-23.66.3 {INST_EXPON: Bug 2798543} -body { expr {6**268435456} } -returnCodes error -result {exponent too large} test expr-23.66.4 {INST_EXPON: Bug 2798543} { expr {(-6)**17 == (-6)**65553} } 0 test expr-23.67.0 {INST_EXPON: Bug 2798543} { expr {7**17 == 7**65553} } 0 test expr-23.67.1 {INST_EXPON: Bug 2798543} { expr {7**22 == 7**65558} } 0 test expr-23.67.2 {INST_EXPON: Bug 2798543} { expr {7**17 == 7**131089} } 0 test expr-23.67.3 {INST_EXPON: Bug 2798543} -body { expr {7**268435456} } -returnCodes error -result {exponent too large} test expr-23.67.4 {INST_EXPON: Bug 2798543} { expr {(-7)**17 == (-7)**65553} } 0 test expr-23.68.0 {INST_EXPON: Bug 2798543} { expr {8**17 == 8**65553} } 0 test expr-23.68.1 {INST_EXPON: Bug 2798543} { expr {8**20 == 8**65556} } 0 test expr-23.68.2 {INST_EXPON: Bug 2798543} { expr {8**17 == 8**131089} } 0 test expr-23.68.3 {INST_EXPON: Bug 2798543} -body { expr {8**268435456} } -returnCodes error -result {exponent too large} test expr-23.68.4 {INST_EXPON: Bug 2798543} { expr {(-8)**17 == (-8)**65553} } 0 test expr-23.69.0 {INST_EXPON: Bug 2798543} { expr {9**17 == 9**65553} } 0 test expr-23.69.1 {INST_EXPON: Bug 2798543} { expr {9**19 == 9**65555} } 0 test expr-23.69.2 {INST_EXPON: Bug 2798543} { expr {9**17 == 9**131089} } 0 test expr-23.69.3 {INST_EXPON: Bug 2798543} -body { expr {9**268435456} } -returnCodes error -result {exponent too large} test expr-23.69.4 {INST_EXPON: Bug 2798543} { expr {(-9)**17 == (-9)**65553} } 0 test expr-23.70.0 {INST_EXPON: Bug 2798543} { expr {10**17 == 10**65553} } 0 test expr-23.70.1 {INST_EXPON: Bug 2798543} { expr {10**18 == 10**65554} } 0 test expr-23.70.2 {INST_EXPON: Bug 2798543} { expr {10**17 == 10**131089} } 0 test expr-23.70.3 {INST_EXPON: Bug 2798543} -body { expr {10**268435456} } -returnCodes error -result {exponent too large} test expr-23.70.4 {INST_EXPON: Bug 2798543} { expr {(-10)**17 == (-10)**65553} } 0 test expr-23.71.0 {INST_EXPON: Bug 2798543} { expr {11**17 == 11**65553} } 0 test expr-23.71.1 {INST_EXPON: Bug 2798543} { expr {11**18 == 11**65554} } 0 test expr-23.71.2 {INST_EXPON: Bug 2798543} { expr {11**17 == 11**131089} } 0 test expr-23.71.3 {INST_EXPON: Bug 2798543} -body { expr {11**268435456} } -returnCodes error -result {exponent too large} test expr-23.71.4 {INST_EXPON: Bug 2798543} { expr {(-11)**17 == (-11)**65553} } 0 test expr-23.72.0 {INST_EXPON: Bug 2798543} { expr {12**17 == 12**65553} } 0 test expr-23.72.1 {INST_EXPON: Bug 2798543} { expr {12**17 == 12**131089} } 0 test expr-23.72.2 {INST_EXPON: Bug 2798543} -body { expr {12**268435456} } -returnCodes error -result {exponent too large} test expr-23.72.3 {INST_EXPON: Bug 2798543} { expr {(-12)**17 == (-12)**65553} } 0 test expr-23.73.0 {INST_EXPON: Bug 2798543} { expr {13**17 == 13**65553} } 0 test expr-23.73.1 {INST_EXPON: Bug 2798543} { expr {13**17 == 13**131089} } 0 test expr-23.73.2 {INST_EXPON: Bug 2798543} -body { expr {13**268435456} } -returnCodes error -result {exponent too large} test expr-23.73.3 {INST_EXPON: Bug 2798543} { expr {(-13)**17 == (-13)**65553} } 0 test expr-23.74.0 {INST_EXPON: Bug 2798543} { expr {14**17 == 14**65553} } 0 test expr-23.74.1 {INST_EXPON: Bug 2798543} { expr {14**17 == 14**131089} } 0 test expr-23.74.2 {INST_EXPON: Bug 2798543} -body { expr {14**268435456} } -returnCodes error -result {exponent too large} test expr-23.74.3 {INST_EXPON: Bug 2798543} { expr {(-14)**17 == (-14)**65553} } 0 # Some compilers get this wrong; ensure that we work around it correctly test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0 test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0 test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0 test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0 test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0 test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0 test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480 test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0 test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0 test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000 test expr-24.11 {INST_LSHIFT: Bug 84a5355235} {expr -549755813888>>32} -128 # List membership tests test expr-25.1 {'in' operator} {expr {"a" in "a b c"}} 1 test expr-25.2 {'in' operator} {expr {"a" in "b a c"}} 1 test expr-25.3 {'in' operator} {expr {"a" in "b c a"}} 1 test expr-25.4 {'in' operator} {expr {"a" in ""}} 0 test expr-25.5 {'in' operator} {expr {"" in {a b c ""}}} 1 test expr-25.6 {'in' operator} {expr {"" in "a b c"}} 0 test expr-25.7 {'in' operator} {expr {"" in ""}} 0 test expr-26.1 {'ni' operator} {expr {"a" ni "a b c"}} 0 test expr-26.2 {'ni' operator} {expr {"a" ni "b a c"}} 0 test expr-26.3 {'ni' operator} {expr {"a" ni "b c a"}} 0 test expr-26.4 {'ni' operator} {expr {"a" ni ""}} 1 test expr-26.5 {'ni' operator} {expr {"" ni {a b c ""}}} 0 test expr-26.6 {'ni' operator} {expr {"" ni "a b c"}} 1 test expr-26.7 {'ni' operator} {expr {"" ni ""}} 1 foreach op {< <= == != > >=} { proc test$op {a b} [list expr "\$a $op \$b"] } test expr-27.1 {expr - correct ordering - not compiled} ieeeFloatingPoint { set problems {} # Ordering should be: -Infinity < -Normal < Subnormal < -0 # < +0 < +Subnormal < +Normal < +Infinity # with equality within each class. set names { -Infinity -Normal -Subnormal -0 +0 +Subnormal +Normal +Infinity } set weights { -3 -2 -1 0 0 1 2 3 } foreach name1 $names weight1 $weights { foreach name2 $names weight2 $weights { foreach op {< <= == != >= >} { set shouldBe [expr "$weight1 $op $weight2"] set is [expr "\$ieeeValues($name1) $op \$ieeeValues($name2)"] if { $is != $shouldBe } { append problems $name1 { } $op { } $name2 \ ":result is " $is ", should be $shouldBe" \n } } } } set problems } {} test expr-27.2 {expr - correct ordering - compiled} ieeeFloatingPoint { set problems {} # Ordering should be: -Infinity < -Normal < Subnormal < -0 # < +0 < +Subnormal < +Normal < +Infinity # with equality within each class. set names { -Infinity -Normal -Subnormal -0 +0 +Subnormal +Normal +Infinity } set weights { -3 -2 -1 0 0 1 2 3 } foreach name1 $names weight1 $weights { foreach name2 $names weight2 $weights { foreach op {< <= == != >= >} { set shouldBe [expr "$weight1 $op $weight2"] set is [test$op $ieeeValues($name1) $ieeeValues($name2)] if { $is != $shouldBe } { append problems $name1 { } $op { } $name2 \ ":result is " $is ", should be $shouldBe" \n } } } } set problems } {} test expr-27.3 {expr - NaN is unordered - not compiled} { set problems {} set names { -Infinity -Normal -Subnormal -0 +0 +Subnormal +Normal +Infinity NaN } foreach name1 $names { foreach op {< <= == != >= >} sb {0 0 0 1 0 0} { if "(\$ieeeValues($name1) $op \$ieeeValues(NaN)) != $sb " { append problems $name1 { } $op { } NaN \ ": result is 1, should be $sb" \n } if "(\$ieeeValues(NaN) $op \$ieeeValues($name1)) != $sb" { append problems NaN { } $op { } $name1 \ ": result is 1, should be $sb" \n } } } set problems } {} test expr-27.4 {expr - NaN is unordered - compiled} { set problems {} set names { -Infinity -Normal -Subnormal -0 +0 +Subnormal +Normal +Infinity NaN } foreach name1 $names { foreach op {< <= == != >= >} sb {0 0 0 1 0 0} { if { [test$op $ieeeValues($name1) $ieeeValues(NaN)] != $sb } { append problems $ieeeValues($name1) { } $op { } $ieeeValues(NaN) \ ": result is 1, should be $sb" \n } if { [test$op $ieeeValues(NaN) $ieeeValues($name1)] != $sb } { append problems NaN { } $op { } $ieeeValues($name1) \ ": result is 1, should be $sb" \n } } } set problems } {} proc convertToDouble { x } { variable ieeeValues binary scan [binary format d $x] c* bytes set result 0x if { $ieeeValues(littleEndian) } { for { set i 7 } { $i >= 0 } { incr i -1 } { append result [format %02x [expr { [lindex $bytes $i] & 0xff }]] } } else { foreach byte $bytes { append result [format %02x [expr { $byte & 0xff }]] } } return $result } test expr-28.1 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 0 E0 OK 00000000000000 E-1023 convertToDouble 0E0 } 0x0000000000000000 test expr-28.2 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL -0 E0 OK -0000000000000 E-1023 convertToDouble -0E0 } 0x8000000000000000 test expr-28.3 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 1 E0 OK 10000000000000 E0 convertToDouble 1E0 } 0x3ff0000000000000 test expr-28.4 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 15 E-1 OK 18000000000000 E0 convertToDouble 15E-1 } 0x3ff8000000000000 test expr-28.5 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 125 E-2 OK 14000000000000 E0 convertToDouble 125E-2 } 0x3ff4000000000000 test expr-28.6 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 1125 E-3 OK 12000000000000 E0 convertToDouble 1125E-3 } 0x3ff2000000000000 test expr-28.7 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 10625 E-4 OK 11000000000000 E0 convertToDouble 10625E-4 } 0x3ff1000000000000 test expr-28.8 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 103125 E-5 OK 10800000000000 E0 convertToDouble 103125E-5 } 0x3ff0800000000000 test expr-28.9 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 1015625 E-6 OK 10400000000000 E0 convertToDouble 1015625E-6 } 0x3ff0400000000000 test expr-28.10 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 10078125 E-7 OK 10200000000000 E0 convertToDouble 10078125E-7 } 0x3ff0200000000000 test expr-28.11 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d ALL 100390625 E-8 OK 10100000000000 E0 convertToDouble 100390625E-8 } 0x3ff0100000000000 test expr-28.12 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee ALL 1001953125 E-9 OK 10080000000000 E0 convertToDouble 1001953125E-9 } 0x3ff0080000000000 test expr-28.13 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee ALL 10009765625 E-10 OK 10040000000000 E0 convertToDouble 10009765625E-10 } 0x3ff0040000000000 test expr-28.14 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee ALL 100048828125 E-11 OK 10020000000000 E0 convertToDouble 100048828125E-11 } 0x3ff0020000000000 test expr-28.15 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee ALL 1000244140625 E-12 OK 10010000000000 E0 convertToDouble 1000244140625E-12 } 0x3ff0010000000000 test expr-28.16 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee ALL 10001220703125 E-13 OK 10008000000000 E0 convertToDouble 10001220703125E-13 } 0x3ff0008000000000 test expr-28.17 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee ALL 100006103515625 E-14 OK 10004000000000 E0 convertToDouble 100006103515625E-14 } 0x3ff0004000000000 test expr-28.18 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee ALL 1000030517578125 E-15 OK 10002000000000 E0 convertToDouble 1000030517578125E-15 } 0x3ff0002000000000 test expr-28.19 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee ALL 10000152587890625 E-16 OK 10001000000000 E0 convertToDouble 10000152587890625E-16 } 0x3ff0001000000000 test expr-28.20 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8 E153 x 1317e5ef3ab327_0000000001& E511 convertToDouble +8E153 } 0x5fe317e5ef3ab327 test expr-28.21 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1 E153 x -1317e5ef3ab327_0000000001& E508 convertToDouble -1E153 } 0xdfb317e5ef3ab327 test expr-28.22 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9 E306 x 19a2028368022e_00000000001& E1019 convertToDouble +9E306 } 0x7fa9a2028368022e test expr-28.23 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -2 E153 x -1317e5ef3ab327_0000000001& E509 convertToDouble -2E153 } 0xdfc317e5ef3ab327 test expr-28.24 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7 E-304 x 1eb8e84fa0b278_00000000001& E-1008 convertToDouble +7E-304 } 0x00feb8e84fa0b278 test expr-28.25 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3 E-49 x -1c0f92a6276c9d_000000001& E-162 convertToDouble -3E-49 } 0xb5dc0f92a6276c9d test expr-28.26 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7 E-303 x 13339131c46f8b_00000000001& E-1004 convertToDouble +7E-303 } 0x0133339131c46f8b test expr-28.27 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -6 E-49 x -1c0f92a6276c9d_000000001& E-161 convertToDouble -6E-49 } 0xb5ec0f92a6276c9d test expr-28.28 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9 E43 x 102498ea6df0c3_11111111110& E146 convertToDouble +9E43 } 0x49102498ea6df0c4 test expr-28.29 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9 E44 x -142dbf25096cf4_1111111110& E149 convertToDouble -9E44 } 0xc9442dbf25096cf5 test expr-28.30 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8 E303 x 1754e31cd072d9_1111111110& E1009 convertToDouble +8E303 } 0x7f0754e31cd072da test expr-28.31 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1 E303 x -1754e31cd072d9_1111111110& E1006 convertToDouble -1E303 } 0xfed754e31cd072da test expr-28.32 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7 E-287 x 1551603777f798_111111110& E-951 convertToDouble +7E-287 } 0x048551603777f799 test expr-28.33 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -2 E-204 x -1410d9f9b2f7f2_11111110& E-677 convertToDouble -2E-204 } 0x95a410d9f9b2f7f3 test expr-28.34 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2 E-205 x 100d7b2e28c65b_11111110& E-680 convertToDouble +2E-205 } 0x15700d7b2e28c65c test expr-28.35 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9 E-47 x -10711fed5b19a3_11111110& E-153 convertToDouble -9E-47 } 0xb660711fed5b19a4 test expr-28.36 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +34 E195 x 1d1c26db7d0dae_000000000001& E652 convertToDouble +34E195 } 0x68bd1c26db7d0dae test expr-28.37 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -68 E195 x -1d1c26db7d0dae_000000000001& E653 convertToDouble -68E195 } 0xe8cd1c26db7d0dae test expr-28.38 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +85 E194 x 1d1c26db7d0dae_000000000001& E650 convertToDouble +85E194 } 0x689d1c26db7d0dae test expr-28.39 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -67 E97 x -139ac1ce2cc95f_000000000001& E328 convertToDouble -67E97 } 0xd4739ac1ce2cc95f test expr-28.40 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +93 E-234 x 127b2e4f210075_0000000000000001& E-771 convertToDouble +93E-234 } 0x0fc27b2e4f210075 test expr-28.41 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -19 E-87 x -12e5f5dfa4fe9d_00000000000001& E-285 convertToDouble -19E-87 } 0xae22e5f5dfa4fe9d test expr-28.42 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +38 E-87 x 12e5f5dfa4fe9d_00000000000001& E-284 convertToDouble +38E-87 } 0x2e32e5f5dfa4fe9d test expr-28.43 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -38 E-88 x -1e3cbc9907fdc8_00000000000001& E-288 convertToDouble -38E-88 } 0xadfe3cbc9907fdc8 test expr-28.44 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -69 E220 x -1e8aa8823a5db3_11111111110& E736 convertToDouble -69E220 } 0xedfe8aa8823a5db4 test expr-28.45 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +18 E43 x 102498ea6df0c3_11111111110& E147 convertToDouble +18E43 } 0x49202498ea6df0c4 test expr-28.46 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -36 E43 x -102498ea6df0c3_11111111110& E148 convertToDouble -36E43 } 0xc9302498ea6df0c4 test expr-28.47 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +61 E-99 x 10ad836f269a16_11111111111110& E-323 convertToDouble +61E-99 } 0x2bc0ad836f269a17 test expr-28.48 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -43 E-92 x -1c0794d9d40e95_111111111111110& E-301 convertToDouble -43E-92 } 0xad2c0794d9d40e96 test expr-28.49 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +86 E-92 x 1c0794d9d40e95_111111111111110& E-300 convertToDouble +86E-92 } 0x2d3c0794d9d40e96 test expr-28.50 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -51 E-74 x -1cd5bee57763e5_1111111111111110& E-241 convertToDouble -51E-74 } 0xb0ecd5bee57763e6 test expr-28.51 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +283 E85 x 16c309024bab4b_00000000000000001& E290 convertToDouble +283E85 } 0x5216c309024bab4b test expr-28.52 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -566 E85 x -16c309024bab4b_00000000000000001& E291 convertToDouble -566E85 } 0xd226c309024bab4b test expr-28.53 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +589 E187 x 1526be9c22eb17_00000000000000001& E630 convertToDouble +589E187 } 0x675526be9c22eb17 test expr-28.54 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -839 E143 x -1ae03f245703e2_000000000000001& E484 convertToDouble -839E143 } 0xde3ae03f245703e2 test expr-28.55 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -744 E-234 x -127b2e4f210075_0000000000000001& E-768 convertToDouble -744E-234 } 0x8ff27b2e4f210075 test expr-28.56 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +930 E-235 x 127b2e4f210075_0000000000000001& E-771 convertToDouble +930E-235 } 0x0fc27b2e4f210075 test expr-28.57 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -186 E-234 x -127b2e4f210075_0000000000000001& E-770 convertToDouble -186E-234 } 0x8fd27b2e4f210075 test expr-28.58 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +604 E175 x 17d93193f78fc5_1111111111111111110& E590 convertToDouble +604E175 } 0x64d7d93193f78fc6 test expr-28.59 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -302 E175 x -17d93193f78fc5_1111111111111111110& E589 convertToDouble -302E175 } 0xe4c7d93193f78fc6 test expr-28.60 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +755 E174 x 17d93193f78fc5_1111111111111111110& E587 convertToDouble +755E174 } 0x64a7d93193f78fc6 test expr-28.61 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -151 E175 x -17d93193f78fc5_1111111111111111110& E588 convertToDouble -151E175 } 0xe4b7d93193f78fc6 test expr-28.62 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +662 E-213 x 1bdb90e62a8cbc_1111111111111110& E-699 convertToDouble +662E-213 } 0x144bdb90e62a8cbd test expr-28.63 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -408 E-74 x -1cd5bee57763e5_1111111111111110& E-238 convertToDouble -408E-74 } 0xb11cd5bee57763e6 test expr-28.64 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +510 E-75 x 1cd5bee57763e5_1111111111111110& E-241 convertToDouble +510E-75 } 0x30ecd5bee57763e6 test expr-28.65 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6782 E55 x 159bd3ad46e346_0000000000000000001& E195 convertToDouble +6782E55 } 0x4c259bd3ad46e346 test expr-28.66 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -2309 E92 x -1bac6f7d64d119_000000000000000001& E316 convertToDouble -2309E92 } 0xd3bbac6f7d64d119 test expr-28.67 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7963 E34 x 1df4170f0fdecc_00000000000000000001& E125 convertToDouble +7963E34 } 0x47cdf4170f0fdecc test expr-28.68 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3391 E55 x -159bd3ad46e346_0000000000000000001& E194 convertToDouble -3391E55 } 0xcc159bd3ad46e346 test expr-28.69 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7903 E-96 x 107c2d27a5b989_0000000000000000001& E-306 convertToDouble +7903E-96 } 0x2cd07c2d27a5b989 test expr-28.70 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7611 E-226 x -119b8744033457_0000000000000000001& E-738 convertToDouble -7611E-226 } 0x91d19b8744033457 test expr-28.71 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +4907 E-196 x 11e90a8711440f_000000000000000001& E-639 convertToDouble +4907E-196 } 0x1801e90a8711440f test expr-28.72 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5547 E-311 x -13f190452a29f4_000000000000000001& E-1021 convertToDouble -5547E-311 } 0x8023f190452a29f4 test expr-28.73 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +5311 E241 x 1f1ce3c887c25f_11111111111111111110& E812 convertToDouble +5311E241 } 0x72bf1ce3c887c260 test expr-28.74 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5311 E243 x -184e91f4aa0fda_11111111111111111110& E819 convertToDouble -5311E243 } 0xf3284e91f4aa0fdb test expr-28.75 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +5311 E242 x 13720e5d54d97b_11111111111111111110& E816 convertToDouble +5311E242 } 0x72f3720e5d54d97c test expr-28.76 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9269 E-45 x 19d69455a53bd8_111111111111111111110& E-137 convertToDouble +9269E-45 } 0x3769d69455a53bd9 test expr-28.77 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8559 E-289 x -104a81d35952fe_11111111111111111110& E-947 convertToDouble -8559E-289 } 0x84c04a81d35952ff test expr-28.78 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8699 E-276 x 12d2df246ecd2c_1111111111111111111110& E-904 convertToDouble +8699E-276 } 0x0772d2df246ecd2d test expr-28.79 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8085 E-64 x -14c98fce16152d_1111111111111111110& E-200 convertToDouble -8085E-64 } 0xb374c98fce16152e test expr-28.80 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +74819 E201 x 1dd455061eb3f1_0000000000000000000001& E683 convertToDouble +74819E201 } 0x6aadd455061eb3f1 test expr-28.81 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -82081 E41 x -170105df3d47cb_000000000000000000000000001& E152 convertToDouble -82081E41 } 0xc9770105df3d47cb test expr-28.82 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +51881 E37 x 17d2950dc76da4_000000000000000000001& E138 convertToDouble +51881E37 } 0x4897d2950dc76da4 test expr-28.83 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -55061 E157 x -1394fc0f33536c_000000000000000000001& E537 convertToDouble -55061E157 } 0xe18394fc0f33536c test expr-28.84 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +77402 E-215 x 10492a4a8a37fd_0000000000000000000000001& E-698 convertToDouble +77402E-215 } 0x1450492a4a8a37fd test expr-28.85 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -33891 E-92 x -1592f9932c06bd_00000000000000000000001& E-291 convertToDouble -33891E-92 } 0xadc592f9932c06bd test expr-28.86 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +38701 E-215 x 10492a4a8a37fd_0000000000000000000000001& E-699 convertToDouble +38701E-215 } 0x1440492a4a8a37fd test expr-28.87 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -82139 E-76 x -1d0681489839d5_00000000000000000000001& E-237 convertToDouble -82139E-76 } 0xb12d0681489839d5 test expr-28.88 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +75859 E25 x 132645e1ba93ef_11111111111111111111110& E99 convertToDouble +75859E25 } 0x46232645e1ba93f0 test expr-28.89 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +89509 E140 x 16f02bee68670c_1111111111111111111110& E481 convertToDouble +89509E140 } 0x5e06f02bee68670d test expr-28.90 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -57533 E287 x -1272ed2307f569_1111111111111111111110& E969 convertToDouble -57533E287 } 0xfc8272ed2307f56a test expr-28.91 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +46073 E-32 x 12405b773fbdf2_11111111111111111111110& E-91 convertToDouble +46073E-32 } 0x3a42405b773fbdf3 test expr-28.92 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -92146 E-32 x -12405b773fbdf2_11111111111111111111110& E-90 convertToDouble -92146E-32 } 0xba52405b773fbdf3 test expr-28.93 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +83771 E-74 x 17206bfc4ccabd_11111111111111111111110& E-230 convertToDouble +83771E-74 } 0x3197206bfc4ccabe test expr-28.94 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -34796 E-276 x -12d2df246ecd2c_1111111111111111111110& E-902 convertToDouble -34796E-276 } 0x8792d2df246ecd2d test expr-28.95 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +584169 E229 x 1d657059dc79aa_00000000000000000000000000001& E779 convertToDouble +584169E229 } 0x70ad657059dc79aa test expr-28.96 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +164162 E41 x 170105df3d47cb_000000000000000000000000001& E153 convertToDouble +164162E41 } 0x49870105df3d47cb test expr-28.97 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -328324 E41 x -170105df3d47cb_000000000000000000000000001& E154 convertToDouble -328324E41 } 0xc9970105df3d47cb test expr-28.98 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +209901 E-11 x 119b96f36ec68b_00000000000000000000000001& E-19 convertToDouble +209901E-11 } 0x3ec19b96f36ec68b test expr-28.99 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -419802 E-11 x -119b96f36ec68b_00000000000000000000000001& E-18 convertToDouble -419802E-11 } 0xbed19b96f36ec68b test expr-28.100 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +940189 E-112 x 1b99d6240c1a28_00000000000000000000000001& E-353 convertToDouble +940189E-112 } 0x29eb99d6240c1a28 test expr-28.101 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -892771 E-213 x -125818c7294f27_0000000000000000000000000001& E-688 convertToDouble -892771E-213 } 0x94f25818c7294f27 test expr-28.102 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +757803 E120 x 11e968b555bb80_11111111111111111111111111110& E418 convertToDouble +757803E120 } 0x5a11e968b555bb81 test expr-28.103 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -252601 E120 x -17e1e0f1c7a4ab_11111111111111111111111111110& E416 convertToDouble -252601E120 } 0xd9f7e1e0f1c7a4ac test expr-28.104 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +252601 E121 x 1dda592e398dd6_1111111111111111111111111110& E419 convertToDouble +252601E121 } 0x5a2dda592e398dd7 test expr-28.105 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -505202 E120 x -17e1e0f1c7a4ab_11111111111111111111111111110& E417 convertToDouble -505202E120 } 0xda07e1e0f1c7a4ac test expr-28.106 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +970811 E-264 x 1dda6b965c9629_11111111111111111111111110& E-858 convertToDouble +970811E-264 } 0x0a5dda6b965c962a test expr-28.107 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -654839 E-60 x -100e7db3b3f241_111111111111111111111111110& E-180 convertToDouble -654839E-60 } 0xb4b00e7db3b3f242 test expr-28.108 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +289767 E-178 x 1caad28f23a100_11111111111111111111111110& E-574 convertToDouble +289767E-178 } 0x1c1caad28f23a101 test expr-28.109 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -579534 E-178 x -1caad28f23a100_11111111111111111111111110& E-573 convertToDouble -579534E-178 } 0x9c2caad28f23a101 test expr-28.110 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8823691 E130 x -1e597c0b94b7ae_00000000000000000000000000000001& E454 convertToDouble -8823691E130 } 0xdc5e597c0b94b7ae test expr-28.111 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9346704 E229 x 1d657059dc79aa_00000000000000000000000000001& E783 convertToDouble +9346704E229 } 0x70ed657059dc79aa test expr-28.112 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1168338 E229 x -1d657059dc79aa_00000000000000000000000000001& E780 convertToDouble -1168338E229 } 0xf0bd657059dc79aa test expr-28.113 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -6063369 E-136 x -1ae6148e3902b3_000000000000000000000000000001& E-430 convertToDouble -6063369E-136 } 0xa51ae6148e3902b3 test expr-28.114 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3865421 E-225 x 15d4fe53afec65_00000000000000000000000000001& E-726 convertToDouble +3865421E-225 } 0x1295d4fe53afec65 test expr-28.115 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5783893 E-127 x -17e5902ce0e151_000000000000000000000000000000001& E-400 convertToDouble -5783893E-127 } 0xa6f7e5902ce0e151 test expr-28.116 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2572231 E223 x 10f73be1dff9ac_111111111111111111111111111110& E762 convertToDouble +2572231E223 } 0x6f90f73be1dff9ad test expr-28.117 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5144462 E223 x -10f73be1dff9ac_111111111111111111111111111110& E763 convertToDouble -5144462E223 } 0xefa0f73be1dff9ad test expr-28.118 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +1817623 E109 x 1d85f96f3fe659_11111111111111111111111111110& E382 convertToDouble +1817623E109 } 0x57dd85f96f3fe65a test expr-28.119 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6431543 E-97 x 14f6493f34a0bc_11111111111111111111111111110& E-300 convertToDouble +6431543E-97 } 0x2d34f6493f34a0bd test expr-28.120 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -5444097 E-21 x -18849dd33c95ae_11111111111111111111111111110& E-48 convertToDouble -5444097E-21 } 0xbcf8849dd33c95af test expr-28.121 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8076999 E-121 x 1fd332f7e2e3b2_11111111111111111111111111110& E-380 convertToDouble +8076999E-121 } 0x283fd332f7e2e3b3 test expr-28.122 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9997649 E-270 x -1425e9d29e558d_1111111111111111111111111110& E-874 convertToDouble -9997649E-270 } 0x895425e9d29e558e test expr-28.123 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +50609263 E157 x 1193aff1f1c8e3_000000000000000000000000000000001& E547 convertToDouble +50609263E157 } 0x622193aff1f1c8e3 test expr-28.124 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +70589528 E130 x 1e597c0b94b7ae_00000000000000000000000000000001& E457 convertToDouble +70589528E130 } 0x5c8e597c0b94b7ae test expr-28.125 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -88236910 E129 x -1e597c0b94b7ae_00000000000000000000000000000001& E454 convertToDouble -88236910E129 } 0xdc5e597c0b94b7ae test expr-28.126 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +87575437 E-310 x 1805c19e680456_0000000000000000000000000000000000001& E-1004 convertToDouble +87575437E-310 } 0x013805c19e680456 test expr-28.127 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -23135572 E-127 x -17e5902ce0e151_000000000000000000000000000000001& E-398 convertToDouble -23135572E-127 } 0xa717e5902ce0e151 test expr-28.128 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +85900881 E177 x 14375b2214e1b4_111111111111111111111111111111110& E614 convertToDouble +85900881E177 } 0x6654375b2214e1b5 test expr-28.129 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -84863171 E113 x -1a4a8e56474b8b_111111111111111111111111111111110& E401 convertToDouble -84863171E113 } 0xd90a4a8e56474b8c test expr-28.130 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +68761586 E232 x 1a662c350f37f2_1111111111111111111111111111110& E796 convertToDouble +68761586E232 } 0x71ba662c350f37f3 test expr-28.131 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -50464069 E286 x -1948dd06de561e_1111111111111111111111111111110& E975 convertToDouble -50464069E286 } 0xfce948dd06de561f test expr-28.132 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +27869147 E-248 x 1dbbac6f83a820_111111111111111111111111111111111110& E-800 convertToDouble +27869147E-248 } 0x0dfdbbac6f83a821 test expr-28.133 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -55738294 E-248 x -1dbbac6f83a820_111111111111111111111111111111111110& E-799 convertToDouble -55738294E-248 } 0x8e0dbbac6f83a821 test expr-28.134 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +70176353 E-53 x 100683a21de854_1111111111111111111111111111111110& E-150 convertToDouble +70176353E-53 } 0x36900683a21de855 test expr-28.135 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -80555086 E-32 x -1f29ca0ff893b0_111111111111111111111111111111110& E-81 convertToDouble -80555086E-32 } 0xbaef29ca0ff893b1 test expr-28.136 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -491080654 E121 x -1c569e968e0944_00000000000000000000000000000000000000001& E430 convertToDouble -491080654E121 } 0xdadc569e968e0944 test expr-28.137 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +526250918 E287 x 14997a298b2f2e_0000000000000000000000000000000000001& E982 convertToDouble +526250918E287 } 0x7d54997a298b2f2e test expr-28.138 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -245540327 E121 x -1c569e968e0944_00000000000000000000000000000000000000001& E429 convertToDouble -245540327E121 } 0xdacc569e968e0944 test expr-28.139 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -175150874 E-310 x -1805c19e680456_0000000000000000000000000000000000001& E-1003 convertToDouble -175150874E-310 } 0x814805c19e680456 test expr-28.140 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +350301748 E-310 x 1805c19e680456_0000000000000000000000000000000000001& E-1002 convertToDouble +350301748E-310 } 0x015805c19e680456 test expr-28.141 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -437877185 E-311 x -1805c19e680456_0000000000000000000000000000000000001& E-1005 convertToDouble -437877185E-311 } 0x812805c19e680456 test expr-28.142 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +458117166 E52 x 16ce94febdc7a4_1111111111111111111111111111111111110& E201 convertToDouble +458117166E52 } 0x4c86ce94febdc7a5 test expr-28.143 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -916234332 E52 x -16ce94febdc7a4_1111111111111111111111111111111111110& E202 convertToDouble -916234332E52 } 0xcc96ce94febdc7a5 test expr-28.144 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +229058583 E52 x 16ce94febdc7a4_1111111111111111111111111111111111110& E200 convertToDouble +229058583E52 } 0x4c76ce94febdc7a5 test expr-28.145 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -525789935 E98 x -16ecdc2a58fc64_11111111111111111111111111111111110& E354 convertToDouble -525789935E98 } 0xd616ecdc2a58fc65 test expr-28.146 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +282926897 E-227 x 1ff5a70d3d2fee_1111111111111111111111111111111111110& E-727 convertToDouble +282926897E-227 } 0x128ff5a70d3d2fef test expr-28.147 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -565853794 E-227 x -1ff5a70d3d2fee_1111111111111111111111111111111111110& E-726 convertToDouble -565853794E-227 } 0x929ff5a70d3d2fef test expr-28.148 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +667284113 E-240 x 109355f8050c01_111111111111111111111111111111111110& E-768 convertToDouble +667284113E-240 } 0x0ff09355f8050c02 test expr-28.149 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -971212611 E-126 x -1397d3c9745d2e_111111111111111111111111111111111111110& E-389 convertToDouble -971212611E-126 } 0xa7a397d3c9745d2f test expr-28.150 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9981396317 E-182 x 18afe10a2a66aa_0000000000000000000000000000000000000001& E-572 convertToDouble +9981396317E-182 } 0x1c38afe10a2a66aa test expr-28.151 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5035231965 E-156 x -101891fc4717fd_00000000000000000000000000000000000001& E-486 convertToDouble -5035231965E-156 } 0xa1901891fc4717fd test expr-28.152 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8336960483 E-153 x 1a06a1024b95e1_000000000000000000000000000000000000001& E-476 convertToDouble +8336960483E-153 } 0x223a06a1024b95e1 test expr-28.153 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8056371144 E-155 x -101891fc4717fd_00000000000000000000000000000000000001& E-482 convertToDouble -8056371144E-155 } 0xa1d01891fc4717fd test expr-28.154 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6418488827 E79 x 1021f14ed7b3f9_11111111111111111111111111111111111111110& E295 convertToDouble +6418488827E79 } 0x526021f14ed7b3fa test expr-28.155 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3981006983 E252 x -102ebaf189d5f1_1111111111111111111111111111111111111110& E869 convertToDouble -3981006983E252 } 0xf6402ebaf189d5f2 test expr-28.156 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7962013966 E252 x 102ebaf189d5f1_1111111111111111111111111111111111111110& E870 convertToDouble +7962013966E252 } 0x76502ebaf189d5f2 test expr-28.157 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -4713898551 E261 x -11d8813536e0df_11111111111111111111111111111111111110& E899 convertToDouble -4713898551E261 } 0xf821d8813536e0e0 test expr-28.158 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8715380633 E-58 x 14614c3219891e_11111111111111111111111111111111111111110& E-160 convertToDouble +8715380633E-58 } 0x35f4614c3219891f test expr-28.159 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9078555839 E-109 x -1fc575867314ed_111111111111111111111111111111111111111111110& E-330 convertToDouble -9078555839E-109 } 0xab5fc575867314ee test expr-28.160 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9712126110 E-127 x 1397d3c9745d2e_111111111111111111111111111111111111110& E-389 convertToDouble +9712126110E-127 } 0x27a397d3c9745d2f test expr-28.161 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +42333842451 E201 x 10189a26df575f_000000000000000000000000000000000000000000001& E703 convertToDouble +42333842451E201 } 0x6be0189a26df575f test expr-28.162 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -84667684902 E201 x -10189a26df575f_000000000000000000000000000000000000000000001& E704 convertToDouble -84667684902E201 } 0xebf0189a26df575f test expr-28.163 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +23792120709 E-315 x 10b517dc5d3212_00000000000000000000000000000000000000001& E-1012 convertToDouble +23792120709E-315 } 0x00b0b517dc5d3212 test expr-28.164 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -78564021519 E-227 x -1155515fd37265_00000000000000000000000000000000000000000001& E-718 convertToDouble -78564021519E-227 } 0x931155515fd37265 test expr-28.165 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +71812054883 E-188 x 1747b46d78c6fe_00000000000000000000000000000000000000001& E-589 convertToDouble +71812054883E-188 } 0x1b2747b46d78c6fe test expr-28.166 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -30311163631 E-116 x -163ef6f560afe7_00000000000000000000000000000000000000001& E-351 convertToDouble -30311163631E-116 } 0xaa063ef6f560afe7 test expr-28.167 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +71803914657 E292 x 10c0c44cdc2c05_11111111111111111111111111111111111111111110& E1006 convertToDouble +71803914657E292 } 0x7ed0c0c44cdc2c06 test expr-28.168 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +36314223356 E-109 x 1fc575867314ed_111111111111111111111111111111111111111111110& E-328 convertToDouble +36314223356E-109 } 0x2b7fc575867314ee test expr-28.169 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +18157111678 E-109 x 1fc575867314ed_111111111111111111111111111111111111111111110& E-329 convertToDouble +18157111678E-109 } 0x2b6fc575867314ee test expr-28.170 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -45392779195 E-110 x -1fc575867314ed_111111111111111111111111111111111111111111110& E-331 convertToDouble -45392779195E-110 } 0xab4fc575867314ee test expr-28.171 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +778380362293 E218 x 19ab8261990292_0000000000000000000000000000000000000000000000000001& E763 convertToDouble +778380362293E218 } 0x6fa9ab8261990292 test expr-28.172 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -685763015669 E280 x -15fd7aa44d9477_000000000000000000000000000000000000000000000001& E969 convertToDouble -685763015669E280 } 0xfc85fd7aa44d9477 test expr-28.173 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +952918668151 E70 x 14177a9915fbf8_00000000000000000000000000000000000000000000001& E272 convertToDouble +952918668151E70 } 0x50f4177a9915fbf8 test expr-28.174 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -548357443505 E32 x -13abde2775e9b5_0000000000000000000000000000000000000000000001& E145 convertToDouble -548357443505E32 } 0xc903abde2775e9b5 test expr-28.175 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +384865004907 E-285 x 1aa65b58639e69_00000000000000000000000000000000000000000000001& E-909 convertToDouble +384865004907E-285 } 0x072aa65b58639e69 test expr-28.176 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -769730009814 E-285 x -1aa65b58639e69_00000000000000000000000000000000000000000000001& E-908 convertToDouble -769730009814E-285 } 0x873aa65b58639e69 test expr-28.177 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +697015418417 E-93 x 152847dad80453_0000000000000000000000000000000000000000000001& E-270 convertToDouble +697015418417E-93 } 0x2f152847dad80453 test expr-28.178 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -915654049301 E-28 x -1a645598d05989_0000000000000000000000000000000000000000000001& E-54 convertToDouble -915654049301E-28 } 0xbc9a645598d05989 test expr-28.179 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +178548656339 E169 x 1b89d67c5b6d24_111111111111111111111111111111111111111111110& E598 convertToDouble +178548656339E169 } 0x655b89d67c5b6d25 test expr-28.180 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -742522891517 E259 x -1c1c352fc3c308_11111111111111111111111111111111111111111111110& E899 convertToDouble -742522891517E259 } 0xf82c1c352fc3c309 test expr-28.181 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +742522891517 E258 x 167cf7596968d3_11111111111111111111111111111111111111111111110& E896 convertToDouble +742522891517E258 } 0x77f67cf7596968d4 test expr-28.182 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -357097312678 E169 x -1b89d67c5b6d24_111111111111111111111111111111111111111111110& E599 convertToDouble -357097312678E169 } 0xe56b89d67c5b6d25 test expr-28.183 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3113521449172 E218 x -19ab8261990292_0000000000000000000000000000000000000000000000000001& E765 convertToDouble -3113521449172E218 } 0xefc9ab8261990292 test expr-28.184 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3891901811465 E217 x 19ab8261990292_0000000000000000000000000000000000000000000000000001& E762 convertToDouble +3891901811465E217 } 0x6f99ab8261990292 test expr-28.185 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1556760724586 E218 x -19ab8261990292_0000000000000000000000000000000000000000000000000001& E764 convertToDouble -1556760724586E218 } 0xefb9ab8261990292 test expr-28.186 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9997878507563 E-195 x 153db2fea1ea31_0000000000000000000000000000000000000000000000001& E-605 convertToDouble +9997878507563E-195 } 0x1a253db2fea1ea31 test expr-28.187 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7247563029154 E-319 x -10493f056e9ef3_0000000000000000000000000000000000000000000000001& E-1017 convertToDouble -7247563029154E-319 } 0x8060493f056e9ef3 test expr-28.188 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3623781514577 E-319 x 10493f056e9ef3_0000000000000000000000000000000000000000000000001& E-1018 convertToDouble +3623781514577E-319 } 0x0050493f056e9ef3 test expr-28.189 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3092446298323 E-200 x -113918353bbc47_0000000000000000000000000000000000000000000000001& E-623 convertToDouble -3092446298323E-200 } 0x99013918353bbc47 test expr-28.190 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6363857920591 E145 x 128a61cf9483b6_1111111111111111111111111111111111111111111111111110& E524 convertToDouble +6363857920591E145 } 0x60b28a61cf9483b7 test expr-28.191 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8233559360849 E94 x -11f324d11d4861_1111111111111111111111111111111111111111111111110& E355 convertToDouble -8233559360849E94 } 0xd621f324d11d4862 test expr-28.192 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2689845954547 E49 x 10bd2bfd34f98a_1111111111111111111111111111111111111111111111110& E204 convertToDouble +2689845954547E49 } 0x4cb0bd2bfd34f98b test expr-28.193 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5379691909094 E49 x -10bd2bfd34f98a_1111111111111111111111111111111111111111111111110& E205 convertToDouble -5379691909094E49 } 0xccc0bd2bfd34f98b test expr-28.194 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +5560322501926 E-301 x 15acc2053064c1_11111111111111111111111111111111111111111111111110& E-958 convertToDouble +5560322501926E-301 } 0x0415acc2053064c2 test expr-28.195 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7812878489261 E-179 x -126dae7bbeda74_11111111111111111111111111111111111111111111111111110& E-552 convertToDouble -7812878489261E-179 } 0x9d726dae7bbeda75 test expr-28.196 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8439398533053 E-256 x 170cc285f2d209_1111111111111111111111111111111111111111111111110& E-808 convertToDouble +8439398533053E-256 } 0x0d770cc285f2d20a test expr-28.197 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -2780161250963 E-301 x -15acc2053064c1_11111111111111111111111111111111111111111111111110& E-959 convertToDouble -2780161250963E-301 } 0x8405acc2053064c2 test expr-28.198 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -87605699161665 E155 x -12920f96e7f9ef_00000000000000000000000000000000000000000000000000001& E561 convertToDouble -87605699161665E155 } 0xe302920f96e7f9ef test expr-28.199 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -17521139832333 E156 x -12920f96e7f9ef_00000000000000000000000000000000000000000000000000001& E562 convertToDouble -17521139832333E156 } 0xe312920f96e7f9ef test expr-28.200 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -88218101363513 E-170 x -18395688592faf_0000000000000000000000000000000000000000000000000001& E-519 convertToDouble -88218101363513E-170 } 0x9f88395688592faf test expr-28.201 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +38639244311627 E-115 x 114ef3e205c817_0000000000000000000000000000000000000000000000000001& E-337 convertToDouble +38639244311627E-115 } 0x2ae14ef3e205c817 test expr-28.202 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +35593959807306 E261 x 1072f3819c1320_11111111111111111111111111111111111111111111111111110& E912 convertToDouble +35593959807306E261 } 0x78f072f3819c1321 test expr-28.203 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -53390939710959 E260 x -13bd243521b08d_11111111111111111111111111111111111111111111111111110& E909 convertToDouble -53390939710959E260 } 0xf8c3bd243521b08e test expr-28.204 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +71187919614612 E261 x 1072f3819c1320_11111111111111111111111111111111111111111111111111110& E913 convertToDouble +71187919614612E261 } 0x790072f3819c1321 test expr-28.205 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -88984899518265 E260 x -1072f3819c1320_11111111111111111111111111111111111111111111111111110& E910 convertToDouble -88984899518265E260 } 0xf8d072f3819c1321 test expr-28.206 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +77003665618895 E-73 x 18bf7e7fa6f029_111111111111111111111111111111111111111111111111111111110& E-197 convertToDouble +77003665618895E-73 } 0x33a8bf7e7fa6f02a test expr-28.207 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -15400733123779 E-72 x -18bf7e7fa6f029_111111111111111111111111111111111111111111111111111111110& E-196 convertToDouble -15400733123779E-72 } 0xb3b8bf7e7fa6f02a test expr-28.208 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +61602932495116 E-72 x 18bf7e7fa6f029_111111111111111111111111111111111111111111111111111111110& E-194 convertToDouble +61602932495116E-72 } 0x33d8bf7e7fa6f02a test expr-28.209 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -30801466247558 E-72 x -18bf7e7fa6f029_111111111111111111111111111111111111111111111111111111110& E-195 convertToDouble -30801466247558E-72 } 0xb3c8bf7e7fa6f02a test expr-28.210 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +834735494917063 E-300 x 1fc6c26f899dd1_0000000000000000000000000000000000000000000000000000000001& E-948 convertToDouble +834735494917063E-300 } 0x04bfc6c26f899dd1 test expr-28.211 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -589795149206434 E-151 x -15f2df5e675a0f_0000000000000000000000000000000000000000000000000000000001& E-453 convertToDouble -589795149206434E-151 } 0xa3a5f2df5e675a0f test expr-28.212 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +475603213226859 E-42 x 12d73088f4050a_000000000000000000000000000000000000000000000000000000001& E-91 convertToDouble +475603213226859E-42 } 0x3a42d73088f4050a test expr-28.213 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -294897574603217 E-151 x -15f2df5e675a0f_0000000000000000000000000000000000000000000000000000000001& E-454 convertToDouble -294897574603217E-151 } 0xa395f2df5e675a0f test expr-28.214 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +850813008001913 E93 x 172f7a1831ad70_11111111111111111111111111111111111111111111111111111110& E358 convertToDouble +850813008001913E93 } 0x56572f7a1831ad71 test expr-28.215 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -203449172043339 E185 x -1102b47e4af987_11111111111111111111111111111111111111111111111111111110& E662 convertToDouble -203449172043339E185 } 0xe95102b47e4af988 test expr-28.216 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +406898344086678 E185 x 1102b47e4af987_11111111111111111111111111111111111111111111111111111110& E663 convertToDouble +406898344086678E185 } 0x696102b47e4af988 test expr-28.217 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -813796688173356 E185 x -1102b47e4af987_11111111111111111111111111111111111111111111111111111110& E664 convertToDouble -813796688173356E185 } 0xe97102b47e4af988 test expr-28.218 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6045338514609393 E244 x 1f746182e6cd5d_00000000000000000000000000000000000000000000000000000000001& E862 convertToDouble +6045338514609393E244 } 0x75df746182e6cd5d test expr-28.219 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5145963778954906 E142 x -1dfc11fbf46087_00000000000000000000000000000000000000000000000000000000001& E523 convertToDouble -5145963778954906E142 } 0xe0adfc11fbf46087 test expr-28.220 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2572981889477453 E142 x 1dfc11fbf46087_00000000000000000000000000000000000000000000000000000000001& E522 convertToDouble +2572981889477453E142 } 0x609dfc11fbf46087 test expr-28.221 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -6965949469487146 E74 x -15e2c10ad970b0_0000000000000000000000000000000000000000000000000000000001& E298 convertToDouble -6965949469487146E74 } 0xd295e2c10ad970b0 test expr-28.222 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6182410494241627 E-119 x 11b96458445d07_0000000000000000000000000000000000000000000000000000000000001& E-343 convertToDouble +6182410494241627E-119 } 0x2a81b96458445d07 test expr-28.223 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8510309498186985 E-277 x -1acc46749dccfe_000000000000000000000000000000000000000000000000000000000001& E-868 convertToDouble -8510309498186985E-277 } 0x89bacc46749dccfe test expr-28.224 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6647704637273331 E-212 x 13e07d2c0cb1e9_0000000000000000000000000000000000000000000000000000000000001& E-652 convertToDouble +6647704637273331E-212 } 0x1733e07d2c0cb1e9 test expr-28.225 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -2215901545757777 E-212 x -1a80a6e566428c_000000000000000000000000000000000000000000000000000000000001& E-654 convertToDouble -2215901545757777E-212 } 0x971a80a6e566428c test expr-28.226 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3771476185376383 E276 x 183010aba78a53_111111111111111111111111111111111111111111111111111111111110& E968 convertToDouble +3771476185376383E276 } 0x7c783010aba78a54 test expr-28.227 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3729901848043846 E212 x -1f7d6721f7f143_111111111111111111111111111111111111111111111111111111111110& E755 convertToDouble -3729901848043846E212 } 0xef2f7d6721f7f144 test expr-28.228 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3771476185376383 E277 x 1e3c14d6916ce8_111111111111111111111111111111111111111111111111111111111110& E971 convertToDouble +3771476185376383E277 } 0x7cae3c14d6916ce9 test expr-28.229 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9977830465649166 E119 x -15f6de9d5d6b5a_111111111111111111111111111111111111111111111111111111111110& E448 convertToDouble -9977830465649166E119 } 0xdbf5f6de9d5d6b5b test expr-28.230 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8439928496349319 E-142 x 12483a0f125699_111111111111111111111111111111111111111111111111111111111110& E-419 convertToDouble +8439928496349319E-142 } 0x25c2483a0f12569a test expr-28.231 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8204230082070882 E-59 x -1d460f4fca1d36_1111111111111111111111111111111111111111111111111111111110& E-144 convertToDouble -8204230082070882E-59 } 0xb6fd460f4fca1d37 test expr-28.232 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8853686434843997 E-244 x 157a340eb5d4f0_11111111111111111111111111111111111111111111111111111111110& E-758 convertToDouble +8853686434843997E-244 } 0x10957a340eb5d4f1 test expr-28.233 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5553274272288559 E-104 x -1c47d20a19d1ed_1111111111111111111111111111111111111111111111111111111110& E-294 convertToDouble -5553274272288559E-104 } 0xad9c47d20a19d1ee test expr-28.234 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +36149023611096162 E144 x 1491daad0ba280_0000000000000000000000000000000000000000000000000000000000000001& E533 convertToDouble +36149023611096162E144 } 0x614491daad0ba280 test expr-28.235 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -36149023611096162 E147 x -14166f8cfd5cb1_0000000000000000000000000000000000000000000000000000000000000001& E543 convertToDouble -36149023611096162E147 } 0xe1e4166f8cfd5cb1 test expr-28.236 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +18074511805548081 E146 x 1011f2d73116f4_0000000000000000000000000000000000000000000000000000000000000001& E539 convertToDouble +18074511805548081E146 } 0x61a011f2d73116f4 test expr-28.237 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -18074511805548081 E147 x -14166f8cfd5cb1_0000000000000000000000000000000000000000000000000000000000000001& E542 convertToDouble -18074511805548081E147 } 0xe1d4166f8cfd5cb1 test expr-28.238 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +97338774138954421 E-290 x 10d9b828199006_0000000000000000000000000000000000000000000000000000000000000001& E-907 convertToDouble +97338774138954421E-290 } 0x0740d9b828199006 test expr-28.239 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -88133809804950961 E-308 x -119710dc581911_000000000000000000000000000000000000000000000000000000000000001& E-967 convertToDouble -88133809804950961E-308 } 0x83819710dc581911 test expr-28.240 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +94080055902682397 E-243 x 11d467e94b856e_0000000000000000000000000000000000000000000000000000000000000001& E-751 convertToDouble +94080055902682397E-243 } 0x1101d467e94b856e test expr-28.241 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -24691002732654881 E-115 x -159a2783ce70ab_000000000000000000000000000000000000000000000000000000000000001& E-328 convertToDouble -24691002732654881E-115 } 0xab759a2783ce70ab test expr-28.242 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +52306490527514614 E49 x 13de005bd620de_111111111111111111111111111111111111111111111111111111111111111110& E218 convertToDouble +52306490527514614E49 } 0x4d93de005bd620df test expr-28.243 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -26153245263757307 E49 x -13de005bd620de_111111111111111111111111111111111111111111111111111111111111111110& E217 convertToDouble -26153245263757307E49 } 0xcd83de005bd620df test expr-28.244 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +55188692254193604 E165 x 1a999ddec72ac9_11111111111111111111111111111111111111111111111111111111111110& E603 convertToDouble +55188692254193604E165 } 0x65aa999ddec72aca test expr-28.245 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -68985865317742005 E164 x -1a999ddec72ac9_11111111111111111111111111111111111111111111111111111111111110& E600 convertToDouble -68985865317742005E164 } 0xe57a999ddec72aca test expr-28.246 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +27176258005319167 E-261 x 17c0747bd76fa0_11111111111111111111111111111111111111111111111111111111111111110& E-813 convertToDouble +27176258005319167E-261 } 0x0d27c0747bd76fa1 test expr-28.247 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -73169230107256116 E-248 x -122cea327fa99c_1111111111111111111111111111111111111111111111111111111111110& E-768 convertToDouble -73169230107256116E-248 } 0x8ff22cea327fa99d test expr-28.248 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +91461537634070145 E-249 x 122cea327fa99c_1111111111111111111111111111111111111111111111111111111111110& E-771 convertToDouble +91461537634070145E-249 } 0x0fc22cea327fa99d test expr-28.249 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -54352516010638334 E-261 x -17c0747bd76fa0_11111111111111111111111111111111111111111111111111111111111111110& E-812 convertToDouble -54352516010638334E-261 } 0x8d37c0747bd76fa1 test expr-28.250 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +586144289638535878 E280 x 11eccbd6f62709_0000000000000000000000000000000000000000000000000000000000000000001& E989 convertToDouble +586144289638535878E280 } 0x7dc1eccbd6f62709 test expr-28.251 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -601117006785295431 E245 x -1e8b3525b3737e_000000000000000000000000000000000000000000000000000000000000000001& E872 convertToDouble -601117006785295431E245 } 0xf67e8b3525b3737e test expr-28.252 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +293072144819267939 E280 x 11eccbd6f62709_0000000000000000000000000000000000000000000000000000000000000000001& E988 convertToDouble +293072144819267939E280 } 0x7db1eccbd6f62709 test expr-28.253 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -953184713238516652 E272 x -138fd93f1f5342_00000000000000000000000000000000000000000000000000000000000000001& E963 convertToDouble -953184713238516652E272 } 0xfc238fd93f1f5342 test expr-28.254 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +902042358290366539 E-281 x 122dc01ca1cb8c_0000000000000000000000000000000000000000000000000000000000000000001& E-874 convertToDouble +902042358290366539E-281 } 0x09522dc01ca1cb8c test expr-28.255 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -557035730189854663 E-294 x -13bfac6bc4767b_00000000000000000000000000000000000000000000000000000000000000000001& E-918 convertToDouble -557035730189854663E-294 } 0x8693bfac6bc4767b test expr-28.256 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +902042358290366539 E-280 x 16b93023ca3e6f_0000000000000000000000000000000000000000000000000000000000000000001& E-871 convertToDouble +902042358290366539E-280 } 0x0986b93023ca3e6f test expr-28.257 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -354944100507554393 E-238 x -19a91cece6ad07_000000000000000000000000000000000000000000000000000000000000000001& E-733 convertToDouble -354944100507554393E-238 } 0x9229a91cece6ad07 test expr-28.258 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +272104041512242479 E199 x 1f92bacb3cb40b_11111111111111111111111111111111111111111111111111111111111111111111110& E718 convertToDouble +272104041512242479E199 } 0x6cdf92bacb3cb40c test expr-28.259 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -816312124536727437 E199 x -17ae0c186d8708_11111111111111111111111111111111111111111111111111111111111111111111110& E720 convertToDouble -816312124536727437E199 } 0xecf7ae0c186d8709 test expr-28.260 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +544208083024484958 E199 x 1f92bacb3cb40b_11111111111111111111111111111111111111111111111111111111111111111111110& E719 convertToDouble +544208083024484958E199 } 0x6cef92bacb3cb40c test expr-28.261 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -792644927852378159 E78 x -17bff336d8ff05_111111111111111111111111111111111111111111111111111111111111111111110& E318 convertToDouble -792644927852378159E78 } 0xd3d7bff336d8ff06 test expr-28.262 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -679406450132979175 E-263 x -17c0747bd76fa0_11111111111111111111111111111111111111111111111111111111111111110& E-815 convertToDouble -679406450132979175E-263 } 0x8d07c0747bd76fa1 test expr-28.263 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +543525160106383340 E-262 x 17c0747bd76fa0_11111111111111111111111111111111111111111111111111111111111111110& E-812 convertToDouble +543525160106383340E-262 } 0x0d37c0747bd76fa1 test expr-28.264 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7400253695682920196 E215 x 1dca94e3990085_00000000000000000000000000000000000000000000000000000000000000000000001& E776 convertToDouble +7400253695682920196E215 } 0x707dca94e3990085 test expr-28.265 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1850063423920730049 E215 x -1dca94e3990085_00000000000000000000000000000000000000000000000000000000000000000000001& E774 convertToDouble -1850063423920730049E215 } 0xf05dca94e3990085 test expr-28.266 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3700126847841460098 E215 x 1dca94e3990085_00000000000000000000000000000000000000000000000000000000000000000000001& E775 convertToDouble +3700126847841460098E215 } 0x706dca94e3990085 test expr-28.267 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9250317119603650245 E214 x -1dca94e3990085_00000000000000000000000000000000000000000000000000000000000000000000001& E773 convertToDouble -9250317119603650245E214 } 0xf04dca94e3990085 test expr-28.268 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8396094300569779681 E-252 x 1ab223efcee35a_0000000000000000000000000000000000000000000000000000000000000000000000001& E-775 convertToDouble +8396094300569779681E-252 } 0x0f8ab223efcee35a test expr-28.269 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3507665085003296281 E-75 x -160499b881ea50_00000000000000000000000000000000000000000000000000000000000000000000001& E-188 convertToDouble -3507665085003296281E-75 } 0xb4360499b881ea50 test expr-28.270 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7015330170006592562 E-75 x 160499b881ea50_00000000000000000000000000000000000000000000000000000000000000000000001& E-187 convertToDouble +7015330170006592562E-75 } 0x34460499b881ea50 test expr-28.271 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7015330170006592562 E-74 x -1b85c026a264e4_00000000000000000000000000000000000000000000000000000000000000000000001& E-184 convertToDouble -7015330170006592562E-74 } 0xb47b85c026a264e4 test expr-28.272 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7185620434951919351 E205 x 18d92d2bcc7a80_1111111111111111111111111111111111111111111111111111111111111111111111110& E743 convertToDouble +7185620434951919351E205 } 0x6e68d92d2bcc7a81 test expr-28.273 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1360520207561212395 E198 x -1f92bacb3cb40b_11111111111111111111111111111111111111111111111111111111111111111111110& E717 convertToDouble -1360520207561212395E198 } 0xeccf92bacb3cb40c test expr-28.274 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2178999185345151731 E-184 x 19b2c4d2a82335_1111111111111111111111111111111111111111111111111111111111111111111110& E-551 convertToDouble +2178999185345151731E-184 } 0x1d89b2c4d2a82336 test expr-28.275 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8691089486201567102 E-218 x -1a9c42e5b6d89e_1111111111111111111111111111111111111111111111111111111111111111111110& E-662 convertToDouble -8691089486201567102E-218 } 0x969a9c42e5b6d89f test expr-28.276 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +4345544743100783551 E-218 x 1a9c42e5b6d89e_1111111111111111111111111111111111111111111111111111111111111111111110& E-663 convertToDouble +4345544743100783551E-218 } 0x168a9c42e5b6d89f test expr-28.277 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -4357998370690303462 E-184 x -19b2c4d2a82335_1111111111111111111111111111111111111111111111111111111111111111111110& E-550 convertToDouble -4357998370690303462E-184 } 0x9d99b2c4d2a82336 test expr-28.278 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +59825267349106892461 E177 x 199c476d7868df_000000000000000000000000000000000000000000000000000000000000000000000001& E653 convertToDouble +59825267349106892461E177 } 0x68c99c476d7868df test expr-28.279 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -62259110684423957791 E47 x -1d8f2cfc20d6e8_0000000000000000000000000000000000000000000000000000000000000000000000001& E221 convertToDouble -62259110684423957791E47 } 0xcdcd8f2cfc20d6e8 test expr-28.280 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +58380168477038565599 E265 x 1f686e9efbe48d_00000000000000000000000000000000000000000000000000000000000000000000000001& E945 convertToDouble +58380168477038565599E265 } 0x7b0f686e9efbe48d test expr-28.281 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -62259110684423957791 E48 x -12797c1d948651_0000000000000000000000000000000000000000000000000000000000000000000000001& E225 convertToDouble -62259110684423957791E48 } 0xce02797c1d948651 test expr-28.282 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -33584377202279118724 E-252 x -1ab223efcee35a_0000000000000000000000000000000000000000000000000000000000000000000000001& E-773 convertToDouble -33584377202279118724E-252 } 0x8faab223efcee35a test expr-28.283 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -57484963479615354808 E205 x -18d92d2bcc7a80_1111111111111111111111111111111111111111111111111111111111111111111111110& E746 convertToDouble -57484963479615354808E205 } 0xee98d92d2bcc7a81 test expr-28.284 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +71856204349519193510 E204 x 18d92d2bcc7a80_1111111111111111111111111111111111111111111111111111111111111111111111110& E743 convertToDouble +71856204349519193510E204 } 0x6e68d92d2bcc7a81 test expr-28.285 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -14371240869903838702 E205 x -18d92d2bcc7a80_1111111111111111111111111111111111111111111111111111111111111111111111110& E744 convertToDouble -14371240869903838702E205 } 0xee78d92d2bcc7a81 test expr-28.286 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +36992084760177624177 E-318 x 18c5f9551c2f99_111111111111111111111111111111111111111111111111111111111111111111111110& E-992 convertToDouble +36992084760177624177E-318 } 0x01f8c5f9551c2f9a test expr-28.287 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -73984169520355248354 E-318 x -18c5f9551c2f99_111111111111111111111111111111111111111111111111111111111111111111111110& E-991 convertToDouble -73984169520355248354E-318 } 0x8208c5f9551c2f9a test expr-28.288 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +99257763227713890244 E-115 x 15338a554b9ce0_11111111111111111111111111111111111111111111111111111111111111111111110& E-316 convertToDouble +99257763227713890244E-115 } 0x2c35338a554b9ce1 test expr-28.289 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -87336362425182547697 E-280 x -1130304e7d9c32_11111111111111111111111111111111111111111111111111111111111111111111110& E-864 convertToDouble -87336362425182547697E-280 } 0x89f130304e7d9c33 test expr-28.290 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7 E289 x 1cbb547777a284_10000000001& E962 convertToDouble +7E289 } 0x7c1cbb547777a285 test expr-28.291 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3 E153 x -1ca3d8e6d80cba_100000001& E509 convertToDouble -3E153 } 0xdfcca3d8e6d80cbb test expr-28.292 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6 E153 x 1ca3d8e6d80cba_100000001& E510 convertToDouble +6E153 } 0x5fdca3d8e6d80cbb test expr-28.293 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5 E243 x -176ec98994f488_10000001& E809 convertToDouble -5E243 } 0xf2876ec98994f489 test expr-28.294 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7 E-161 x 1f7e0db3799aa2_10000000001& E-533 convertToDouble +7E-161 } 0x1eaf7e0db3799aa3 test expr-28.295 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7 E-172 x -15a4337446ef2a_1000000001& E-569 convertToDouble -7E-172 } 0x9c65a4337446ef2b test expr-28.296 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8 E-63 x 1a53fc9631d10c_10000001& E-207 convertToDouble +8E-63 } 0x330a53fc9631d10d test expr-28.297 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7 E-113 x -158c47e6eea282_10000001& E-373 convertToDouble -7E-113 } 0xa8a58c47e6eea283 test expr-28.298 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8 E126 x 17a2ecc414a03f_0111111111110& E421 convertToDouble +8E126 } 0x5a47a2ecc414a03f test expr-28.299 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -4 E126 x -17a2ecc414a03f_0111111111110& E420 convertToDouble -4E126 } 0xda37a2ecc414a03f test expr-28.300 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +5 E125 x 17a2ecc414a03f_0111111111110& E417 convertToDouble +5E125 } 0x5a07a2ecc414a03f test expr-28.301 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1 E126 x -17a2ecc414a03f_0111111111110& E418 convertToDouble -1E126 } 0xda17a2ecc414a03f test expr-28.302 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8 E-163 x 1708d0f84d3de7_011111110& E-539 convertToDouble +8E-163 } 0x1e4708d0f84d3de7 test expr-28.303 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1 E-163 x -1708d0f84d3de7_011111110& E-542 convertToDouble -1E-163 } 0x9e1708d0f84d3de7 test expr-28.304 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2 E-163 x 1708d0f84d3de7_011111110& E-541 convertToDouble +2E-163 } 0x1e2708d0f84d3de7 test expr-28.305 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -4 E-163 x -1708d0f84d3de7_011111110& E-540 convertToDouble -4E-163 } 0x9e3708d0f84d3de7 test expr-28.306 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +51 E195 x 15d51d249dca42_1000000000001& E653 convertToDouble +51E195 } 0x68c5d51d249dca43 test expr-28.307 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -37 E46 x -1033d7eca0adee_100000000000001& E158 convertToDouble -37E46 } 0xc9d033d7eca0adef test expr-28.308 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +74 E46 x 1033d7eca0adee_100000000000001& E159 convertToDouble +74E46 } 0x49e033d7eca0adef test expr-28.309 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -56 E289 x -1cbb547777a284_10000000001& E965 convertToDouble -56E289 } 0xfc4cbb547777a285 test expr-28.310 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +69 E-145 x 158a41b31c9a9a_100000000001& E-476 convertToDouble +69E-145 } 0x22358a41b31c9a9b test expr-28.311 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -70 E-162 x -1f7e0db3799aa2_10000000001& E-533 convertToDouble -70E-162 } 0x9eaf7e0db3799aa3 test expr-28.312 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +56 E-161 x 1f7e0db3799aa2_10000000001& E-530 convertToDouble +56E-161 } 0x1edf7e0db3799aa3 test expr-28.313 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -21 E-303 x -1ccd59caa6a750_10000000001& E-1003 convertToDouble -21E-303 } 0x814ccd59caa6a751 test expr-28.314 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +34 E-276 x 12d5a4350d30ff_011111111110& E-912 convertToDouble +34E-276 } 0x06f2d5a4350d30ff test expr-28.315 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -68 E-276 x -12d5a4350d30ff_011111111110& E-911 convertToDouble -68E-276 } 0x8702d5a4350d30ff test expr-28.316 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +85 E-277 x 12d5a4350d30ff_011111111110& E-914 convertToDouble +85E-277 } 0x06d2d5a4350d30ff test expr-28.317 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -87 E-274 x -12d36cf48e7abd_011111111111110& E-904 convertToDouble -87E-274 } 0x8772d36cf48e7abd test expr-28.318 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +829 E102 x 17221a79cdd1d8_1000000000000001& E348 convertToDouble +829E102 } 0x55b7221a79cdd1d9 test expr-28.319 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -623 E100 x -1640a62f3a83de_10000000000000000001& E341 convertToDouble -623E100 } 0xd54640a62f3a83df test expr-28.320 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +723 E-162 x 145457ee24abd2_1000000000000001& E-529 convertToDouble +723E-162 } 0x1ee45457ee24abd3 test expr-28.321 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -457 E-102 x -1ffc81bc29f02a_100000000000000001& E-331 convertToDouble -457E-102 } 0xab4ffc81bc29f02b test expr-28.322 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +914 E-102 x 1ffc81bc29f02a_100000000000000001& E-330 convertToDouble +914E-102 } 0x2b5ffc81bc29f02b test expr-28.323 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -323 E-135 x -1d589ae4d70218_10000000000001& E-441 convertToDouble -323E-135 } 0xa46d589ae4d70219 test expr-28.324 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +151 E176 x 1dcf7df8f573b7_0111111111111111110& E591 convertToDouble +151E176 } 0x64edcf7df8f573b7 test expr-28.325 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -302 E176 x -1dcf7df8f573b7_0111111111111111110& E592 convertToDouble -302E176 } 0xe4fdcf7df8f573b7 test expr-28.326 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +921 E90 x 1c420a45fd70ff_0111111111111110& E308 convertToDouble +921E90 } 0x533c420a45fd70ff test expr-28.327 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -604 E176 x -1dcf7df8f573b7_0111111111111111110& E593 convertToDouble -604E176 } 0xe50dcf7df8f573b7 test expr-28.328 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +823 E-206 x 14a48933c208ad_0111111111111110& E-675 convertToDouble +823E-206 } 0x15c4a48933c208ad test expr-28.329 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -463 E-114 x -11d0c83f6378a5_011111111111110& E-370 convertToDouble -463E-114 } 0xa8d1d0c83f6378a5 test expr-28.330 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +348 E-274 x 12d36cf48e7abd_011111111111110& E-902 convertToDouble +348E-274 } 0x0792d36cf48e7abd test expr-28.331 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9968 E100 x 1640a62f3a83de_10000000000000000001& E345 convertToDouble +9968E100 } 0x558640a62f3a83df test expr-28.332 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -6230 E99 x -1640a62f3a83de_10000000000000000001& E341 convertToDouble -6230E99 } 0xd54640a62f3a83df test expr-28.333 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +1246 E100 x 1640a62f3a83de_10000000000000000001& E342 convertToDouble +1246E100 } 0x555640a62f3a83df test expr-28.334 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6676 E-296 x 15519ac5142aaa_1000000000000000000001& E-971 convertToDouble +6676E-296 } 0x0345519ac5142aab test expr-28.335 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8345 E-297 x -15519ac5142aaa_1000000000000000000001& E-974 convertToDouble -8345E-297 } 0x8315519ac5142aab test expr-28.336 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +1669 E-296 x 15519ac5142aaa_1000000000000000000001& E-973 convertToDouble +1669E-296 } 0x0325519ac5142aab test expr-28.337 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3338 E-296 x -15519ac5142aaa_1000000000000000000001& E-972 convertToDouble -3338E-296 } 0x8335519ac5142aab test expr-28.338 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3257 E58 x 1444b34a6fb3eb_01111111111111111110& E204 convertToDouble +3257E58 } 0x4cb444b34a6fb3eb test expr-28.339 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -6514 E58 x -1444b34a6fb3eb_01111111111111111110& E205 convertToDouble -6514E58 } 0xccc444b34a6fb3eb test expr-28.340 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2416 E176 x 1dcf7df8f573b7_0111111111111111110& E595 convertToDouble +2416E176 } 0x652dcf7df8f573b7 test expr-28.341 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8085 E-63 x 19fbf3c19b9a79_0111111111111111110& E-197 convertToDouble +8085E-63 } 0x33a9fbf3c19b9a79 test expr-28.342 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3234 E-62 x -19fbf3c19b9a79_0111111111111111110& E-195 convertToDouble -3234E-62 } 0xb3c9fbf3c19b9a79 test expr-28.343 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +1617 E-62 x 19fbf3c19b9a79_0111111111111111110& E-196 convertToDouble +1617E-62 } 0x33b9fbf3c19b9a79 test expr-28.344 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -6468 E-62 x -19fbf3c19b9a79_0111111111111111110& E-194 convertToDouble -6468E-62 } 0xb3d9fbf3c19b9a79 test expr-28.345 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +53418 E111 x 15b1051df943a8_1000000000000000000001& E384 convertToDouble +53418E111 } 0x57f5b1051df943a9 test expr-28.346 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -60513 E160 x -15043b64e56c72_1000000000000000000001& E547 convertToDouble -60513E160 } 0xe225043b64e56c73 test expr-28.347 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +26709 E111 x 15b1051df943a8_1000000000000000000001& E383 convertToDouble +26709E111 } 0x57e5b1051df943a9 test expr-28.348 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -99447 E166 x -10782189b336ae_1000000000000000000001& E568 convertToDouble -99447E166 } 0xe370782189b336af test expr-28.349 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +12549 E48 x 10c52fe6dc6a1b_011111111111111111111110& E173 convertToDouble +12549E48 } 0x4ac0c52fe6dc6a1b test expr-28.350 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -25098 E48 x -10c52fe6dc6a1b_011111111111111111111110& E174 convertToDouble -25098E48 } 0xcad0c52fe6dc6a1b test expr-28.351 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +50196 E48 x 10c52fe6dc6a1b_011111111111111111111110& E175 convertToDouble +50196E48 } 0x4ae0c52fe6dc6a1b test expr-28.352 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -62745 E47 x -10c52fe6dc6a1b_011111111111111111111110& E172 convertToDouble -62745E47 } 0xcab0c52fe6dc6a1b test expr-28.353 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +83771 E-73 x 1ce886fb5ffd6d_0111111111111111111110& E-227 convertToDouble +83771E-73 } 0x31cce886fb5ffd6d test expr-28.354 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -97451 E-167 x -1c0f220fb1c70d_01111111111111111111110& E-539 convertToDouble -97451E-167 } 0x9e4c0f220fb1c70d test expr-28.355 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +86637 E-203 x 10943edb4e81db_0111111111111111111110& E-658 convertToDouble +86637E-203 } 0x16d0943edb4e81db test expr-28.356 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -75569 E-254 x -15a462d91c6ab3_0111111111111111111111111110& E-828 convertToDouble -75569E-254 } 0x8c35a462d91c6ab3 test expr-28.357 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +473806 E83 x 17d15bf3186080_1000000000000000000000001& E294 convertToDouble +473806E83 } 0x5257d15bf3186081 test expr-28.358 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -947612 E83 x -17d15bf3186080_1000000000000000000000001& E295 convertToDouble -947612E83 } 0xd267d15bf3186081 test expr-28.359 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +292369 E76 x 18a85eb277e644_100000000000000000000000001& E270 convertToDouble +292369E76 } 0x50d8a85eb277e645 test expr-28.360 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -584738 E76 x -18a85eb277e644_100000000000000000000000001& E271 convertToDouble -584738E76 } 0xd0e8a85eb277e645 test expr-28.361 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +933587 E-140 x 1b248728b9c116_100000000000000000000000001& E-446 convertToDouble +933587E-140 } 0x241b248728b9c117 test expr-28.362 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -720919 E-14 x -1ef696965cbf04_10000000000000000000000001& E-28 convertToDouble -720919E-14 } 0xbe3ef696965cbf05 test expr-28.363 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +535001 E-149 x 10b38e07c745ae_1000000000000000000000001& E-476 convertToDouble +535001E-149 } 0x2230b38e07c745af test expr-28.364 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -890521 E-235 x -114828ee39c852_1000000000000000000000001& E-761 convertToDouble -890521E-235 } 0x90614828ee39c853 test expr-28.365 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +548057 E81 x 11a1d9135cca53_0111111111111111111111110& E288 convertToDouble +548057E81 } 0x51f1a1d9135cca53 test expr-28.366 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -706181 E88 x -1b156ac4c2d1e5_0111111111111111111111110& E311 convertToDouble -706181E88 } 0xd36b156ac4c2d1e5 test expr-28.367 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +820997 E106 x 1b4f8b64fa125d_0111111111111111111111110& E371 convertToDouble +820997E106 } 0x572b4f8b64fa125d test expr-28.368 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -320681 E63 x -17ca18a876c5ef_0111111111111111111111110& E227 convertToDouble -320681E63 } 0xce27ca18a876c5ef test expr-28.369 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +928609 E-261 x 1be2dd66200bef_011111111111111111111111111110& E-848 convertToDouble +928609E-261 } 0x0afbe2dd66200bef test expr-28.370 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -302276 E-254 x -15a462d91c6ab3_0111111111111111111111111110& E-826 convertToDouble -302276E-254 } 0x8c55a462d91c6ab3 test expr-28.371 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +151138 E-254 x 15a462d91c6ab3_0111111111111111111111111110& E-827 convertToDouble +151138E-254 } 0x0c45a462d91c6ab3 test expr-28.372 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +4691773 E45 x 19147b9330eaae_1000000000000000000000000001& E171 convertToDouble +4691773E45 } 0x4aa9147b9330eaaf test expr-28.373 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9383546 E45 x -19147b9330eaae_1000000000000000000000000001& E172 convertToDouble -9383546E45 } 0xcab9147b9330eaaf test expr-28.374 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3059949 E-243 x 13ecf22ea07862_10000000000000000000000000001& E-786 convertToDouble +3059949E-243 } 0x0ed3ecf22ea07863 test expr-28.375 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -6119898 E-243 x -13ecf22ea07862_10000000000000000000000000001& E-785 convertToDouble -6119898E-243 } 0x8ee3ecf22ea07863 test expr-28.376 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +5356626 E-213 x 1b84252abdf6ba_100000000000000000000000001& E-686 convertToDouble +5356626E-213 } 0x151b84252abdf6bb test expr-28.377 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -4877378 E-199 x -11cd5cd90cb200_100000000000000000000000001& E-639 convertToDouble -4877378E-199 } 0x9801cd5cd90cb201 test expr-28.378 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7716693 E223 x 1972d9d2cff683_01111111111111111111111111110& E763 convertToDouble +7716693E223 } 0x6fa972d9d2cff683 test expr-28.379 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5452869 E109 x -16247b136fecc3_01111111111111111111111111110& E384 convertToDouble -5452869E109 } 0xd7f6247b136fecc3 test expr-28.380 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +4590831 E156 x 14689b4a5fa201_011111111111111111111111111110& E540 convertToDouble +4590831E156 } 0x61b4689b4a5fa201 test expr-28.381 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9181662 E156 x -14689b4a5fa201_011111111111111111111111111110& E541 convertToDouble -9181662E156 } 0xe1c4689b4a5fa201 test expr-28.382 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3714436 E-261 x -1be2dd66200bef_011111111111111111111111111110& E-846 convertToDouble -3714436E-261 } 0x8b1be2dd66200bef test expr-28.383 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +4643045 E-262 x 1be2dd66200bef_011111111111111111111111111110& E-849 convertToDouble +4643045E-262 } 0x0aebe2dd66200bef test expr-28.384 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7428872 E-261 x -1be2dd66200bef_011111111111111111111111111110& E-845 convertToDouble -7428872E-261 } 0x8b2be2dd66200bef test expr-28.385 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +52942146 E130 x 16c31d08af89c2_10000000000000000000000000000001& E457 convertToDouble +52942146E130 } 0x5c86c31d08af89c3 test expr-28.386 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -27966061 E145 x -155bcf72fd10f8_1000000000000000000000000000000001& E506 convertToDouble -27966061E145 } 0xdf955bcf72fd10f9 test expr-28.387 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +26471073 E130 x 16c31d08af89c2_10000000000000000000000000000001& E456 convertToDouble +26471073E130 } 0x5c76c31d08af89c3 test expr-28.388 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -55932122 E145 x -155bcf72fd10f8_1000000000000000000000000000000001& E507 convertToDouble -55932122E145 } 0xdfa55bcf72fd10f9 test expr-28.389 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +95412548 E-99 x 18e0bfb98864c8_100000000000000000000000000000001& E-303 convertToDouble +95412548E-99 } 0x2d08e0bfb98864c9 test expr-28.390 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -47706274 E-99 x -18e0bfb98864c8_100000000000000000000000000000001& E-304 convertToDouble -47706274E-99 } 0xacf8e0bfb98864c9 test expr-28.391 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +23853137 E-99 x 18e0bfb98864c8_100000000000000000000000000000001& E-305 convertToDouble +23853137E-99 } 0x2ce8e0bfb98864c9 test expr-28.392 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -78493654 E-301 x -140d76077b648e_10000000000000000000000000000001& E-974 convertToDouble -78493654E-301 } 0x83140d76077b648f test expr-28.393 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +65346417 E29 x 13aa1ad778f23b_0111111111111111111111111111110& E122 convertToDouble +65346417E29 } 0x4793aa1ad778f23b test expr-28.394 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -51083099 E167 x -14a75eb58df47b_0111111111111111111111111111110& E580 convertToDouble -51083099E167 } 0xe434a75eb58df47b test expr-28.395 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +89396333 E264 x 1526f061ca9053_0111111111111111111111111111111110& E903 convertToDouble +89396333E264 } 0x786526f061ca9053 test expr-28.396 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -84863171 E114 x -106e98f5ec8f37_0111111111111111111111111111111110& E405 convertToDouble -84863171E114 } 0xd9406e98f5ec8f37 test expr-28.397 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +59540836 E-251 x 10430c2d075c07_011111111111111111111111111111110& E-808 convertToDouble +59540836E-251 } 0x0d70430c2d075c07 test expr-28.398 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -74426045 E-252 x -10430c2d075c07_011111111111111111111111111111110& E-811 convertToDouble -74426045E-252 } 0x8d40430c2d075c07 test expr-28.399 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +14885209 E-251 x 10430c2d075c07_011111111111111111111111111111110& E-810 convertToDouble +14885209E-251 } 0x0d50430c2d075c07 test expr-28.400 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -29770418 E-251 x -10430c2d075c07_011111111111111111111111111111110& E-809 convertToDouble -29770418E-251 } 0x8d60430c2d075c07 test expr-28.401 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +982161308 E122 x 11b6231e18c5ca_100000000000000000000000000000000000000001& E435 convertToDouble +982161308E122 } 0x5b21b6231e18c5cb test expr-28.402 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -245540327 E122 x -11b6231e18c5ca_100000000000000000000000000000000000000001& E433 convertToDouble -245540327E122 } 0xdb01b6231e18c5cb test expr-28.403 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +491080654 E122 x 11b6231e18c5ca_100000000000000000000000000000000000000001& E434 convertToDouble +491080654E122 } 0x5b11b6231e18c5cb test expr-28.404 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +525452622 E-310 x 12045136ce0340_1000000000000000000000000000000000001& E-1001 convertToDouble +525452622E-310 } 0x0162045136ce0341 test expr-28.405 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -771837113 E-134 x -14e61f991c4ed0_100000000000000000000000000000000001& E-416 convertToDouble -771837113E-134 } 0xa5f4e61f991c4ed1 test expr-28.406 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +820858081 E-150 x 14050669985a86_10000000000000000000000000000000001& E-469 convertToDouble +820858081E-150 } 0x22a4050669985a87 test expr-28.407 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -262726311 E-310 x -12045136ce0340_1000000000000000000000000000000000001& E-1002 convertToDouble -262726311E-310 } 0x8152045136ce0341 test expr-28.408 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +923091487 E209 x 10bc60e6896717_011111111111111111111111111111111110& E724 convertToDouble +923091487E209 } 0x6d30bc60e6896717 test expr-28.409 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -653777767 E273 x -120223f2b3a881_0111111111111111111111111111111111111110& E936 convertToDouble -653777767E273 } 0xfa720223f2b3a881 test expr-28.410 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +842116236 E-53 x 1809c5732cdc7f_0111111111111111111111111111111110& E-147 convertToDouble +842116236E-53 } 0x36c809c5732cdc7f test expr-28.411 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -741111169 E-202 x -15a3e1d1b73099_01111111111111111111111111111111110& E-642 convertToDouble -741111169E-202 } 0x97d5a3e1d1b73099 test expr-28.412 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +839507247 E-284 x 129a1effc50859_0111111111111111111111111111111110& E-914 convertToDouble +839507247E-284 } 0x06d29a1effc50859 test expr-28.413 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -951487269 E-264 x -1c92befccb5f59_0111111111111111111111111111111110& E-848 convertToDouble -951487269E-264 } 0x8afc92befccb5f59 test expr-28.414 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9821613080 E121 x -11b6231e18c5ca_100000000000000000000000000000000000000001& E435 convertToDouble -9821613080E121 } 0xdb21b6231e18c5cb test expr-28.415 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6677856011 E-31 x 193a6d11077292_100000000000000000000000000000000000001& E-71 convertToDouble +6677856011E-31 } 0x3b893a6d11077293 test expr-28.416 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3573796826 E-266 x -112be2041a79fc_100000000000000000000000000000000000001& E-852 convertToDouble -3573796826E-266 } 0x8ab12be2041a79fd test expr-28.417 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7147593652 E-266 x 112be2041a79fc_100000000000000000000000000000000000001& E-851 convertToDouble +7147593652E-266 } 0x0ac12be2041a79fd test expr-28.418 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9981396317 E-181 x -1edbd94cb50054_100000000000000000000000000000000000001& E-569 convertToDouble -9981396317E-181 } 0x9c6edbd94cb50055 test expr-28.419 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3268888835 E272 x 120223f2b3a881_0111111111111111111111111111111111111110& E935 convertToDouble +3268888835E272 } 0x7a620223f2b3a881 test expr-28.420 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -2615111068 E273 x -120223f2b3a881_0111111111111111111111111111111111111110& E938 convertToDouble -2615111068E273 } 0xfa920223f2b3a881 test expr-28.421 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +1307555534 E273 x 120223f2b3a881_0111111111111111111111111111111111111110& E937 convertToDouble +1307555534E273 } 0x7a820223f2b3a881 test expr-28.422 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2990671154 E-190 x 13db11ac608107_01111111111111111111111111111111111111110& E-600 convertToDouble +2990671154E-190 } 0x1a73db11ac608107 test expr-28.423 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1495335577 E-190 x -13db11ac608107_01111111111111111111111111111111111111110& E-601 convertToDouble -1495335577E-190 } 0x9a63db11ac608107 test expr-28.424 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +5981342308 E-190 x 13db11ac608107_01111111111111111111111111111111111111110& E-599 convertToDouble +5981342308E-190 } 0x1a83db11ac608107 test expr-28.425 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7476677885 E-191 x -13db11ac608107_01111111111111111111111111111111111111110& E-602 convertToDouble -7476677885E-191 } 0x9a53db11ac608107 test expr-28.426 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +82259684194 E-202 x 12c3e72d179606_1000000000000000000000000000000000000000001& E-635 convertToDouble +82259684194E-202 } 0x1842c3e72d179607 test expr-28.427 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -93227267727 E-49 x -1960fe08d5847e_100000000000000000000000000000000000000001& E-127 convertToDouble -93227267727E-49 } 0xb80960fe08d5847f test expr-28.428 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +41129842097 E-202 x 12c3e72d179606_1000000000000000000000000000000000000000001& E-636 convertToDouble +41129842097E-202 } 0x1832c3e72d179607 test expr-28.429 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -47584241418 E-314 x -14e25dd3747e96_10000000000000000000000000000000000000001& E-1008 convertToDouble -47584241418E-314 } 0x80f4e25dd3747e97 test expr-28.430 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -79360293406 E92 x -1c58a00bb31863_01111111111111111111111111111111111111110& E341 convertToDouble -79360293406E92 } 0xd54c58a00bb31863 test expr-28.431 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +57332259349 E225 x 120811f528378b_01111111111111111111111111111111111111110& E783 convertToDouble +57332259349E225 } 0x70e20811f528378b test expr-28.432 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -57202326162 E111 x -1626f1c480545b_01111111111111111111111111111111111111110& E404 convertToDouble -57202326162E111 } 0xd93626f1c480545b test expr-28.433 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +86860597053 E-206 x 103b77d2b969d9_0111111111111111111111111111111111111111110& E-648 convertToDouble +86860597053E-206 } 0x17703b77d2b969d9 test expr-28.434 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -53827010643 E-200 x -132fa69a69bd6d_0111111111111111111111111111111111111111110& E-629 convertToDouble -53827010643E-200 } 0x98a32fa69a69bd6d test expr-28.435 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +53587107423 E-61 x 100a19a3ffd981_011111111111111111111111111111111111111111110& E-167 convertToDouble +53587107423E-61 } 0x35800a19a3ffd981 test expr-28.436 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +635007636765 E200 x 1824e73a4f030e_100000000000000000000000000000000000000000001& E703 convertToDouble +635007636765E200 } 0x6be824e73a4f030f test expr-28.437 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +508006109412 E201 x 1824e73a4f030e_100000000000000000000000000000000000000000001& E706 convertToDouble +508006109412E201 } 0x6c1824e73a4f030f test expr-28.438 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -254003054706 E201 x -1824e73a4f030e_100000000000000000000000000000000000000000001& E705 convertToDouble -254003054706E201 } 0xec0824e73a4f030f test expr-28.439 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +561029718715 E-72 x 1cd96a6972a14a_100000000000000000000000000000000000000000001& E-201 convertToDouble +561029718715E-72 } 0x336cd96a6972a14b test expr-28.440 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -897647549944 E-71 x -1cd96a6972a14a_100000000000000000000000000000000000000000001& E-197 convertToDouble -897647549944E-71 } 0xb3acd96a6972a14b test expr-28.441 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +112205943743 E-71 x 1cd96a6972a14a_100000000000000000000000000000000000000000001& E-200 convertToDouble +112205943743E-71 } 0x337cd96a6972a14b test expr-28.442 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -873947086081 E-236 x -19e117541d04e6_1000000000000000000000000000000000000000000001& E-745 convertToDouble -873947086081E-236 } 0x9169e117541d04e7 test expr-28.443 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +809184709177 E116 x 1de27e59fb0679_011111111111111111111111111111111111111111110& E424 convertToDouble +809184709177E116 } 0x5a7de27e59fb0679 test expr-28.444 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -573112917422 E81 x -11958b36c5102b_01111111111111111111111111111111111111111111110& E308 convertToDouble -573112917422E81 } 0xd331958b36c5102b test expr-28.445 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +286556458711 E81 x 11958b36c5102b_01111111111111111111111111111111111111111111110& E307 convertToDouble +286556458711E81 } 0x5321958b36c5102b test expr-28.446 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +952805821491 E-259 x 1551767ef8a9a3_011111111111111111111111111111111111111111110& E-821 convertToDouble +952805821491E-259 } 0x0ca551767ef8a9a3 test expr-28.447 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -132189992873 E-44 x -1b746cf242410b_011111111111111111111111111111111111111111110& E-110 convertToDouble -132189992873E-44 } 0xb91b746cf242410b test expr-28.448 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -173696038493 E-144 x -1f8fefbb3249d3_011111111111111111111111111111111111111111110& E-442 convertToDouble -173696038493E-144 } 0xa45f8fefbb3249d3 test expr-28.449 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +1831132757599 E-107 x 138e6edd48f2a2_1000000000000000000000000000000000000000000000001& E-315 convertToDouble +1831132757599E-107 } 0x2c438e6edd48f2a3 test expr-28.450 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9155663787995 E-108 x -138e6edd48f2a2_1000000000000000000000000000000000000000000000001& E-316 convertToDouble -9155663787995E-108 } 0xac338e6edd48f2a3 test expr-28.451 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7324531030396 E-107 x 138e6edd48f2a2_1000000000000000000000000000000000000000000000001& E-313 convertToDouble +7324531030396E-107 } 0x2c638e6edd48f2a3 test expr-28.452 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9277338894969 E-200 x -19d5a44fd99a6a_1000000000000000000000000000000000000000000000001& E-622 convertToDouble -9277338894969E-200 } 0x9919d5a44fd99a6b test expr-28.453 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8188292423973 E287 x 1390273bf8f983_0111111111111111111111111111111111111111111111110& E996 convertToDouble +8188292423973E287 } 0x7e3390273bf8f983 test expr-28.454 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5672557437938 E59 x -148c2bd60a1523_011111111111111111111111111111111111111111111110& E238 convertToDouble -5672557437938E59 } 0xced48c2bd60a1523 test expr-28.455 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2836278718969 E59 x 148c2bd60a1523_011111111111111111111111111111111111111111111110& E237 convertToDouble +2836278718969E59 } 0x4ec48c2bd60a1523 test expr-28.456 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -9995153153494 E54 x -17ba37c4fbe993_01111111111111111111111111111111111111111111110& E222 convertToDouble -9995153153494E54 } 0xcdd7ba37c4fbe993 test expr-28.457 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9224786422069 E-291 x 14ee5d56b32957_011111111111111111111111111111111111111111111111110& E-924 convertToDouble +9224786422069E-291 } 0x0634ee5d56b32957 test expr-28.458 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3142213164987 E-294 x -1d3409dfbca26f_011111111111111111111111111111111111111111111111110& E-936 convertToDouble -3142213164987E-294 } 0x857d3409dfbca26f test expr-28.459 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +6284426329974 E-294 x 1d3409dfbca26f_011111111111111111111111111111111111111111111111110& E-935 convertToDouble +6284426329974E-294 } 0x058d3409dfbca26f test expr-28.460 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8340483752889 E-301 x -10419183e44b91_01111111111111111111111111111111111111111111111110& E-957 convertToDouble -8340483752889E-301 } 0x8420419183e44b91 test expr-28.461 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +67039371486466 E89 x 17f203339c9628_10000000000000000000000000000000000000000000000000001& E341 convertToDouble +67039371486466E89 } 0x5547f203339c9629 test expr-28.462 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -62150786615239 E197 x -12e79a035b9714_1000000000000000000000000000000000000000000000000001& E700 convertToDouble -62150786615239E197 } 0xebb2e79a035b9715 test expr-28.463 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +33519685743233 E89 x 17f203339c9628_10000000000000000000000000000000000000000000000000001& E340 convertToDouble +33519685743233E89 } 0x5537f203339c9629 test expr-28.464 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -52563419496999 E156 x -1bdb17625bf6e6_1000000000000000000000000000000000000000000000000001& E563 convertToDouble -52563419496999E156 } 0xe32bdb17625bf6e7 test expr-28.465 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +32599460466991 E-65 x 1f395d4c779d8e_1000000000000000000000000000000000000000000000000001& E-172 convertToDouble +32599460466991E-65 } 0x353f395d4c779d8f test expr-28.466 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -41010988798007 E-133 x -152e1c9e04ee06_100000000000000000000000000000000000000000000000001& E-397 convertToDouble -41010988798007E-133 } 0xa7252e1c9e04ee07 test expr-28.467 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +65198920933982 E-65 x 1f395d4c779d8e_1000000000000000000000000000000000000000000000000001& E-171 convertToDouble +65198920933982E-65 } 0x354f395d4c779d8f test expr-28.468 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -82021977596014 E-133 x -152e1c9e04ee06_100000000000000000000000000000000000000000000000001& E-396 convertToDouble -82021977596014E-133 } 0xa7352e1c9e04ee07 test expr-28.469 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +80527976643809 E61 x 1c7c5aea080a49_0111111111111111111111111111111111111111111111111110& E248 convertToDouble +80527976643809E61 } 0x4f7c7c5aea080a49 test expr-28.470 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -74712611505209 E158 x -1eeebe9ea010f3_011111111111111111111111111111111111111111111111110& E570 convertToDouble -74712611505209E158 } 0xe39eeebe9ea010f3 test expr-28.471 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +53390939710959 E261 x 18ac6d426a1cb1_0111111111111111111111111111111111111111111111111110& E912 convertToDouble +53390939710959E261 } 0x78f8ac6d426a1cb1 test expr-28.472 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -69277302659155 E225 x -1547166a3a2b0f_011111111111111111111111111111111111111111111111110& E793 convertToDouble -69277302659155E225 } 0xf18547166a3a2b0f test expr-28.473 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +46202199371337 E-72 x 128f9edfbd341f_0111111111111111111111111111111111111111111111111111111110& E-194 convertToDouble +46202199371337E-72 } 0x33d28f9edfbd341f test expr-28.474 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -23438635467783 E-179 x -1ba485b99e47af_0111111111111111111111111111111111111111111111111110& E-551 convertToDouble -23438635467783E-179 } 0x9d8ba485b99e47af test expr-28.475 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +41921560615349 E-67 x 19b2a5c4041e4b_0111111111111111111111111111111111111111111111111110& E-178 convertToDouble +41921560615349E-67 } 0x34d9b2a5c4041e4b test expr-28.476 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -92404398742674 E-72 x -128f9edfbd341f_0111111111111111111111111111111111111111111111111111111110& E-193 convertToDouble -92404398742674E-72 } 0xb3e28f9edfbd341f test expr-28.477 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +738545606647197 E124 x 13d8886a766a20_100000000000000000000000000000000000000000000000000001& E461 convertToDouble +738545606647197E124 } 0x5cc3d8886a766a21 test expr-28.478 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -972708181182949 E117 x -15ed1f039cebfe_1000000000000000000000000000000000000000000000000000001& E438 convertToDouble -972708181182949E117 } 0xdb55ed1f039cebff test expr-28.479 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -837992143580825 E87 x -17f203339c9628_10000000000000000000000000000000000000000000000000001& E338 convertToDouble -837992143580825E87 } 0xd517f203339c9629 test expr-28.480 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +609610927149051 E-255 x 104273b18918b0_100000000000000000000000000000000000000000000000000000001& E-798 convertToDouble +609610927149051E-255 } 0x0e104273b18918b1 test expr-28.481 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -475603213226859 E-41 x -178cfcab31064c_10000000000000000000000000000000000000000000000000000001& E-88 convertToDouble -475603213226859E-41 } 0xba778cfcab31064d test expr-28.482 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +563002800671023 E-177 x 1035e7b5183922_10000000000000000000000000000000000000000000000000000001& E-539 convertToDouble +563002800671023E-177 } 0x1e4035e7b5183923 test expr-28.483 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -951206426453718 E-41 x -178cfcab31064c_10000000000000000000000000000000000000000000000000000001& E-87 convertToDouble -951206426453718E-41 } 0xba878cfcab31064d test expr-28.484 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +805416432656519 E202 x 175d226331d039_01111111111111111111111111111111111111111111111111111110& E720 convertToDouble +805416432656519E202 } 0x6cf75d226331d039 test expr-28.485 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -530658674694337 E159 x -112a13daa46fe3_0111111111111111111111111111111111111111111111111111110& E577 convertToDouble -530658674694337E159 } 0xe4012a13daa46fe3 test expr-28.486 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +946574173863918 E208 x 1a2fbffdb7580b_011111111111111111111111111111111111111111111111111110& E740 convertToDouble +946574173863918E208 } 0x6e3a2fbffdb7580b test expr-28.487 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -318329953318553 E113 x -178358811cbc95_011111111111111111111111111111111111111111111111111110& E423 convertToDouble -318329953318553E113 } 0xda678358811cbc95 test expr-28.488 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -462021993713370 E-73 x -128f9edfbd341f_0111111111111111111111111111111111111111111111111111111110& E-194 convertToDouble -462021993713370E-73 } 0xb3d28f9edfbd341f test expr-28.489 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +369617594970696 E-72 x 128f9edfbd341f_0111111111111111111111111111111111111111111111111111111110& E-191 convertToDouble +369617594970696E-72 } 0x34028f9edfbd341f test expr-28.490 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3666156212014994 E233 x 1a37935f3b71c8_100000000000000000000000000000000000000000000000000000001& E825 convertToDouble +3666156212014994E233 } 0x738a37935f3b71c9 test expr-28.491 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1833078106007497 E233 x -1a37935f3b71c8_100000000000000000000000000000000000000000000000000000001& E824 convertToDouble -1833078106007497E233 } 0xf37a37935f3b71c9 test expr-28.492 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +8301790508624232 E174 x 1dcfee6690ffc6_100000000000000000000000000000000000000000000000000000001& E630 convertToDouble +8301790508624232E174 } 0x675dcfee6690ffc7 test expr-28.493 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1037723813578029 E174 x -1dcfee6690ffc6_100000000000000000000000000000000000000000000000000000001& E627 convertToDouble -1037723813578029E174 } 0xe72dcfee6690ffc7 test expr-28.494 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7297662880581139 E-286 x 18ac8c79e1ff18_1000000000000000000000000000000000000000000000000000000000001& E-898 convertToDouble +7297662880581139E-286 } 0x07d8ac8c79e1ff19 test expr-28.495 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -5106185698912191 E-276 x -141934d77659be_1000000000000000000000000000000000000000000000000000000000001& E-865 convertToDouble -5106185698912191E-276 } 0x89e41934d77659bf test expr-28.496 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7487252720986826 E-165 x 18823a57adbef8_100000000000000000000000000000000000000000000000000000000000001& E-496 convertToDouble +7487252720986826E-165 } 0x20f8823a57adbef9 test expr-28.497 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3743626360493413 E-165 x -18823a57adbef8_100000000000000000000000000000000000000000000000000000000000001& E-497 convertToDouble -3743626360493413E-165 } 0xa0e8823a57adbef9 test expr-28.498 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3773057430100257 E230 x 1ba10d818fdafd_0111111111111111111111111111111111111111111111111111111110& E815 convertToDouble +3773057430100257E230 } 0x72eba10d818fdafd test expr-28.499 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7546114860200514 E230 x -1ba10d818fdafd_0111111111111111111111111111111111111111111111111111111110& E816 convertToDouble -7546114860200514E230 } 0xf2fba10d818fdafd test expr-28.500 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +4321222892463822 E58 x 18750ea732fdad_011111111111111111111111111111111111111111111111111111110& E244 convertToDouble +4321222892463822E58 } 0x4f38750ea732fdad test expr-28.501 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7793560217139653 E51 x -1280461b856ec5_0111111111111111111111111111111111111111111111111111111110& E222 convertToDouble -7793560217139653E51 } 0xcdd280461b856ec5 test expr-28.502 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +26525993941010681 E112 x 187dcbf6ad5cf8_10000000000000000000000000000000000000000000000000000000000001& E426 convertToDouble +26525993941010681E112 } 0x5a987dcbf6ad5cf9 test expr-28.503 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -53051987882021362 E112 x -187dcbf6ad5cf8_10000000000000000000000000000000000000000000000000000000000001& E427 convertToDouble -53051987882021362E112 } 0xdaa87dcbf6ad5cf9 test expr-28.504 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +72844871414247907 E77 x 1bf00baf60b70c_100000000000000000000000000000000000000000000000000000000001& E311 convertToDouble +72844871414247907E77 } 0x536bf00baf60b70d test expr-28.505 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -88839359596763261 E105 x -1133b1a33a1108_100000000000000000000000000000000000000000000000000000000001& E405 convertToDouble -88839359596763261E105 } 0xd94133b1a33a1109 test expr-28.506 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +18718131802467065 E-166 x 18823a57adbef8_100000000000000000000000000000000000000000000000000000000000001& E-498 convertToDouble +18718131802467065E-166 } 0x20d8823a57adbef9 test expr-28.507 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -14974505441973652 E-165 x -18823a57adbef8_100000000000000000000000000000000000000000000000000000000000001& E-495 convertToDouble -14974505441973652E-165 } 0xa108823a57adbef9 test expr-28.508 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +73429396004640239 E106 x 11c5cb19ef3451_01111111111111111111111111111111111111111111111111111111111110& E408 convertToDouble +73429396004640239E106 } 0x5971c5cb19ef3451 test expr-28.509 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -58483921078398283 E57 x -108ce499519ce3_0111111111111111111111111111111111111111111111111111111111111110& E245 convertToDouble -58483921078398283E57 } 0xcf408ce499519ce3 test expr-28.510 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +41391519190645203 E165 x 13f33667156017_011111111111111111111111111111111111111111111111111111111111110& E603 convertToDouble +41391519190645203E165 } 0x65a3f33667156017 test expr-28.511 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -82783038381290406 E165 x -13f33667156017_011111111111111111111111111111111111111111111111111111111111110& E604 convertToDouble -82783038381290406E165 } 0xe5b3f33667156017 test expr-28.512 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +58767043776702677 E-163 x 12c92fee3a3867_0111111111111111111111111111111111111111111111111111111111110& E-486 convertToDouble +58767043776702677E-163 } 0x2192c92fee3a3867 test expr-28.513 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -90506231831231999 E-129 x -1bdc4114397ff3_01111111111111111111111111111111111111111111111111111111111110& E-373 convertToDouble -90506231831231999E-129 } 0xa8abdc4114397ff3 test expr-28.514 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +64409240769861689 E-159 x 192238f7987779_011111111111111111111111111111111111111111111111111111111111110& E-473 convertToDouble +64409240769861689E-159 } 0x22692238f7987779 test expr-28.515 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -77305427432277771 E-190 x -1e978b7780b613_0111111111111111111111111111111111111111111111111111111111110& E-576 convertToDouble -77305427432277771E-190 } 0x9bfe978b7780b613 test expr-28.516 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +476592356619258326 E273 x 1873cf8ee72812_10000000000000000000000000000000000000000000000000000000000000001& E965 convertToDouble +476592356619258326E273 } 0x7c4873cf8ee72813 test expr-28.517 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -953184713238516652 E273 x -1873cf8ee72812_10000000000000000000000000000000000000000000000000000000000000001& E966 convertToDouble -953184713238516652E273 } 0xfc5873cf8ee72813 test expr-28.518 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +899810892172646163 E283 x 1adf51fa055e02_100000000000000000000000000000000000000000000000000000000000000000001& E999 convertToDouble +899810892172646163E283 } 0x7e6adf51fa055e03 test expr-28.519 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -929167076892018333 E187 x -1da2c42fce2bc4_10000000000000000000000000000000000000000000000000000000000000000001& E680 convertToDouble -929167076892018333E187 } 0xea7da2c42fce2bc5 test expr-28.520 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +647761278967534239 E-312 x 1a7a2476ec0b3e_10000000000000000000000000000000000000000000000000000000000000001& E-978 convertToDouble +647761278967534239E-312 } 0x02da7a2476ec0b3f test expr-28.521 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -644290479820542942 E-180 x -128d1407dfa832_10000000000000000000000000000000000000000000000000000000000000001& E-539 convertToDouble -644290479820542942E-180 } 0x9e428d1407dfa833 test expr-28.522 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +926145344610700019 E-225 x 1307a67f1f69fe_10000000000000000000000000000000000000000000000000000000000000000001& E-688 convertToDouble +926145344610700019E-225 } 0x14f307a67f1f69ff test expr-28.523 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -958507931896511964 E-246 x -17406753df2f0c_10000000000000000000000000000000000000000000000000000000000000001& E-758 convertToDouble -958507931896511964E-246 } 0x9097406753df2f0d test expr-28.524 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +272104041512242479 E200 x 13bbb4bf05f087_011111111111111111111111111111111111111111111111111111111111111111111110& E722 convertToDouble +272104041512242479E200 } 0x6d13bbb4bf05f087 test expr-28.525 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -792644927852378159 E79 x -1daff0048f3ec7_011111111111111111111111111111111111111111111111111111111111111111110& E321 convertToDouble -792644927852378159E79 } 0xd40daff0048f3ec7 test expr-28.526 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +544208083024484958 E200 x 13bbb4bf05f087_011111111111111111111111111111111111111111111111111111111111111111111110& E723 convertToDouble +544208083024484958E200 } 0x6d23bbb4bf05f087 test expr-28.527 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -929963218616126365 E290 x -108dcc0c505461_01111111111111111111111111111111111111111111111111111111111111110& E1023 convertToDouble -929963218616126365E290 } 0xffe08dcc0c505461 test expr-28.528 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +305574339166810102 E-219 x 17f399fe02c4b9_011111111111111111111111111111111111111111111111111111111111111110& E-670 convertToDouble +305574339166810102E-219 } 0x1617f399fe02c4b9 test expr-28.529 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -152787169583405051 E-219 x -17f399fe02c4b9_011111111111111111111111111111111111111111111111111111111111111110& E-671 convertToDouble -152787169583405051E-219 } 0x9607f399fe02c4b9 test expr-28.530 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +611148678333620204 E-219 x 17f399fe02c4b9_011111111111111111111111111111111111111111111111111111111111111110& E-669 convertToDouble +611148678333620204E-219 } 0x1627f399fe02c4b9 test expr-28.531 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -763935847917025255 E-220 x -17f399fe02c4b9_011111111111111111111111111111111111111111111111111111111111111110& E-672 convertToDouble -763935847917025255E-220 } 0x95f7f399fe02c4b9 test expr-28.532 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +7439550220920798612 E158 x 177fe14f40159a_10000000000000000000000000000000000000000000000000000000000000000000001& E587 convertToDouble +7439550220920798612E158 } 0x64a77fe14f40159b test expr-28.533 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -3719775110460399306 E158 x -177fe14f40159a_10000000000000000000000000000000000000000000000000000000000000000000001& E586 convertToDouble -3719775110460399306E158 } 0xe4977fe14f40159b test expr-28.534 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +9299437776150998265 E157 x 177fe14f40159a_10000000000000000000000000000000000000000000000000000000000000000000001& E584 convertToDouble +9299437776150998265E157 } 0x64777fe14f40159b test expr-28.535 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7120190517612959703 E120 x -13220dcd5899fc_1000000000000000000000000000000000000000000000000000000000000000000000001& E461 convertToDouble -7120190517612959703E120 } 0xdcc3220dcd5899fd test expr-28.536 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +3507665085003296281 E-73 x 11339818257f0e_100000000000000000000000000000000000000000000000000000000000000000000001& E-181 convertToDouble +3507665085003296281E-73 } 0x34a1339818257f0f test expr-28.537 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -7015330170006592562 E-73 x -11339818257f0e_100000000000000000000000000000000000000000000000000000000000000000000001& E-180 convertToDouble -7015330170006592562E-73 } 0xb4b1339818257f0f test expr-28.538 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -6684428762278255956 E-294 x -1d9f82a1a6b1b8_10000000000000000000000000000000000000000000000000000000000000000001& E-915 convertToDouble -6684428762278255956E-294 } 0x86cd9f82a1a6b1b9 test expr-28.539 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -1088416166048969916 E200 x -13bbb4bf05f087_011111111111111111111111111111111111111111111111111111111111111111111110& E724 convertToDouble -1088416166048969916E200 } 0xed33bbb4bf05f087 test expr-28.540 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8707329328391759328 E200 x -13bbb4bf05f087_011111111111111111111111111111111111111111111111111111111111111111111110& E727 convertToDouble -8707329328391759328E200 } 0xed63bbb4bf05f087 test expr-28.541 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +4439021781608558002 E-65 x 1038168b71e2c9_01111111111111111111111111111111111111111111111111111111111111111110& E-154 convertToDouble +4439021781608558002E-65 } 0x365038168b71e2c9 test expr-28.542 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -8878043563217116004 E-65 x -1038168b71e2c9_01111111111111111111111111111111111111111111111111111111111111111110& E-153 convertToDouble -8878043563217116004E-65 } 0xb66038168b71e2c9 test expr-28.543 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +2219510890804279001 E-65 x 1038168b71e2c9_01111111111111111111111111111111111111111111111111111111111111111110& E-155 convertToDouble +2219510890804279001E-65 } 0x364038168b71e2c9 test expr-28.544 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +33051223951904955802 E55 x 1762068a24fd54_1000000000000000000000000000000000000000000000000000000000000000000000001& E247 convertToDouble +33051223951904955802E55 } 0x4f6762068a24fd55 test expr-28.545 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -56961524140903677624 E120 x -13220dcd5899fc_1000000000000000000000000000000000000000000000000000000000000000000000001& E464 convertToDouble -56961524140903677624E120 } 0xdcf3220dcd5899fd test expr-28.546 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +71201905176129597030 E119 x 13220dcd5899fc_1000000000000000000000000000000000000000000000000000000000000000000000001& E461 convertToDouble +71201905176129597030E119 } 0x5cc3220dcd5899fd test expr-28.547 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +14030660340013185124 E-73 x 11339818257f0e_100000000000000000000000000000000000000000000000000000000000000000000001& E-179 convertToDouble +14030660340013185124E-73 } 0x34c1339818257f0f test expr-28.548 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -17538325425016481405 E-74 x -11339818257f0e_100000000000000000000000000000000000000000000000000000000000000000000001& E-182 convertToDouble -17538325425016481405E-74 } 0xb491339818257f0f test expr-28.549 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +67536228609141569109 E-133 x 10a1b35cf2a635_01111111111111111111111111111111111111111111111111111111111111111111110& E-376 convertToDouble +67536228609141569109E-133 } 0x2870a1b35cf2a635 test expr-28.550 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -35620497849450218807 E-306 x -15b22082529425_0111111111111111111111111111111111111111111111111111111111111111111111110& E-952 convertToDouble -35620497849450218807E-306 } 0x8475b22082529425 test expr-28.551 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN +66550376797582521751 E-126 x 13897c0ede6c69_01111111111111111111111111111111111111111111111111111111111111111111110& E-353 convertToDouble +66550376797582521751E-126 } 0x29e3897c0ede6c69 test expr-28.552 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b d UN -71240995698900437614 E-306 x -15b22082529425_0111111111111111111111111111111111111111111111111111111111111111111111110& E-951 convertToDouble -71240995698900437614E-306 } 0x8485b22082529425 test expr-28.553 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +3 E24 x 13da329b633647_0001& E81 convertToDouble +3E24 } 0x4503da329b633647 test expr-28.554 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -6 E24 x -13da329b633647_0001& E82 convertToDouble -6E24 } 0xc513da329b633647 test expr-28.555 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6 E26 x 1f04ef12cb04cf_0001& E88 convertToDouble +6E26 } 0x457f04ef12cb04cf test expr-28.556 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -7 E25 x -1cf389cd46047d_0000001& E85 convertToDouble -7E25 } 0xc54cf389cd46047d test expr-28.557 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +1 E-14 x 16849b86a12b9b_00000001& E-47 convertToDouble +1E-14 } 0x3d06849b86a12b9b test expr-28.558 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2 E-14 x -16849b86a12b9b_00000001& E-46 convertToDouble -2E-14 } 0xbd16849b86a12b9b test expr-28.559 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4 E-14 x 16849b86a12b9b_00000001& E-45 convertToDouble +4E-14 } 0x3d26849b86a12b9b test expr-28.560 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8 E-14 x -16849b86a12b9b_00000001& E-44 convertToDouble -8E-14 } 0xbd36849b86a12b9b test expr-28.561 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +5 E26 x 19d971e4fe8401_1110& E88 convertToDouble +5E26 } 0x4579d971e4fe8402 test expr-28.562 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8 E27 x -19d971e4fe8401_1110& E92 convertToDouble -8E27 } 0xc5b9d971e4fe8402 test expr-28.563 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +1 E27 x 19d971e4fe8401_1110& E89 convertToDouble +1E27 } 0x4589d971e4fe8402 test expr-28.564 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4 E27 x -19d971e4fe8401_1110& E91 convertToDouble -4E27 } 0xc5a9d971e4fe8402 test expr-28.565 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9 E-13 x 1faa7ab552a551_111110& E-41 convertToDouble +9E-13 } 0x3d6faa7ab552a552 test expr-28.566 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -7 E-20 x -14a90ceafff9de_11110& E-64 convertToDouble -7E-20 } 0xbbf4a90ceafff9df test expr-28.567 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +56 E25 x 1cf389cd46047d_0000001& E88 convertToDouble +56E25 } 0x457cf389cd46047d test expr-28.568 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -70 E24 x -1cf389cd46047d_0000001& E85 convertToDouble -70E24 } 0xc54cf389cd46047d test expr-28.569 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +51 E26 x 107a9f01fbda8e_0000001& E92 convertToDouble +51E26 } 0x45b07a9f01fbda8e test expr-28.570 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +71 E-17 x 19949819f693d7_00000000001& E-51 convertToDouble +71E-17 } 0x3cc9949819f693d7 test expr-28.571 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -31 E-5 x -1450efdc9c4da9_00000000001& E-12 convertToDouble -31E-5 } 0xbf3450efdc9c4da9 test expr-28.572 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +62 E-5 x 1450efdc9c4da9_00000000001& E-11 convertToDouble +62E-5 } 0x3f4450efdc9c4da9 test expr-28.573 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -94 E-8 x -1f8a89dc374df5_0000000001& E-21 convertToDouble -94E-8 } 0xbeaf8a89dc374df5 test expr-28.574 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +67 E27 x 1b0fa33bba7231_11111110& E95 convertToDouble +67E27 } 0x45eb0fa33bba7232 test expr-28.575 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -81 E24 x -10c01ab31bb5cb_1111110& E86 convertToDouble -81E24 } 0xc550c01ab31bb5cc test expr-28.576 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +54 E23 x 11ddfa58a6173f_111110& E82 convertToDouble +54E23 } 0x4511ddfa58a61740 test expr-28.577 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -54 E25 x -1bead72a838453_111110& E88 convertToDouble -54E25 } 0xc57bead72a838454 test expr-28.578 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +63 E-22 x 1dc03b8fd70169_11111111110& E-68 convertToDouble +63E-22 } 0x3bbdc03b8fd7016a test expr-28.579 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -63 E-23 x -17ccfc73126787_11111111110& E-71 convertToDouble -63E-23 } 0xbb87ccfc73126788 test expr-28.580 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +43 E-4 x 119ce075f6fd21_111111110& E-8 convertToDouble +43E-4 } 0x3f719ce075f6fd22 test expr-28.581 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -86 E-4 x -119ce075f6fd21_111111110& E-7 convertToDouble -86E-4 } 0xbf819ce075f6fd22 test expr-28.582 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +942 E26 x 1306069e8681f3_00000000001& E96 convertToDouble +942E26 } 0x45f306069e8681f3 test expr-28.583 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -471 E25 x -1e700a973d9cb8_0000000001& E91 convertToDouble -471E25 } 0xc5ae700a973d9cb8 test expr-28.584 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +803 E24 x 14c1cee9cd666b_000000000001& E89 convertToDouble +803E24 } 0x4584c1cee9cd666b test expr-28.585 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -471 E26 x -1306069e8681f3_00000000001& E95 convertToDouble -471E26 } 0xc5e306069e8681f3 test expr-28.586 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -409 E-21 x -1e2dcaa4115622_000000000001& E-62 convertToDouble -409E-21 } 0xbc1e2dcaa4115622 test expr-28.587 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +818 E-21 x 1e2dcaa4115622_000000000001& E-61 convertToDouble +818E-21 } 0x3c2e2dcaa4115622 test expr-28.588 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -867 E-8 x -122eabba029aba_000000000001& E-17 convertToDouble -867E-8 } 0xbee22eabba029aba test expr-28.589 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +538 E27 x 1b297cad9f70b5_1111111111111110& E98 convertToDouble +538E27 } 0x461b297cad9f70b6 test expr-28.590 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -857 E24 x -16272678ba603b_11111111110& E89 convertToDouble -857E24 } 0xc586272678ba603c test expr-28.591 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +269 E27 x 1b297cad9f70b5_1111111111111110& E97 convertToDouble +269E27 } 0x460b297cad9f70b6 test expr-28.592 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -403 E26 x -1046ec1e31dd85_1111111110& E95 convertToDouble -403E26 } 0xc5e046ec1e31dd86 test expr-28.593 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +959 E-7 x 1923bd746a3527_11111111111110& E-14 convertToDouble +959E-7 } 0x3f1923bd746a3528 test expr-28.594 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -959 E-6 x -1f6cacd184c271_1111111111110& E-11 convertToDouble -959E-6 } 0xbf4f6cacd184c272 test expr-28.595 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +373 E-27 x 1cdc06b20ef182_1111111111110& E-82 convertToDouble +373E-27 } 0x3adcdc06b20ef183 test expr-28.596 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -746 E-27 x -1cdc06b20ef182_1111111111110& E-81 convertToDouble -746E-27 } 0xbaecdc06b20ef183 test expr-28.597 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4069 E24 x 1a4b9887fbfe7a_0000000000001& E91 convertToDouble +4069E24 } 0x45aa4b9887fbfe7a test expr-28.598 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4069 E23 x -150946d32ffec8_0000000000001& E88 convertToDouble -4069E23 } 0xc5750946d32ffec8 test expr-28.599 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8138 E24 x -1a4b9887fbfe7a_0000000000001& E92 convertToDouble -8138E24 } 0xc5ba4b9887fbfe7a test expr-28.600 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8294 E-15 x 123d1b5eb1d778_000000000000000001& E-37 convertToDouble +8294E-15 } 0x3da23d1b5eb1d778 test expr-28.601 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4147 E-14 x -16cc62365e4d56_00000000000000001& E-35 convertToDouble -4147E-14 } 0xbdc6cc62365e4d56 test expr-28.602 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4147 E-15 x 123d1b5eb1d778_000000000000000001& E-38 convertToDouble +4147E-15 } 0x3d923d1b5eb1d778 test expr-28.603 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8294 E-14 x -16cc62365e4d56_00000000000000001& E-34 convertToDouble -8294E-14 } 0xbdd6cc62365e4d56 test expr-28.604 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +538 E27 x 1b297cad9f70b5_1111111111111110& E98 convertToDouble +538E27 } 0x461b297cad9f70b6 test expr-28.605 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2690 E26 x -1b297cad9f70b5_1111111111111110& E97 convertToDouble -2690E26 } 0xc60b297cad9f70b6 test expr-28.606 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +269 E27 x 1b297cad9f70b5_1111111111111110& E97 convertToDouble +269E27 } 0x460b297cad9f70b6 test expr-28.607 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2152 E27 x -1b297cad9f70b5_1111111111111110& E100 convertToDouble -2152E27 } 0xc63b297cad9f70b6 test expr-28.608 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +1721 E-17 x 136071dcae4564_111111111111110& E-46 convertToDouble +1721E-17 } 0x3d136071dcae4565 test expr-28.609 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -7979 E-27 x -134ac304747faf_111111111111110& E-77 convertToDouble -7979E-27 } 0xbb234ac304747fb0 test expr-28.610 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6884 E-17 x 136071dcae4564_111111111111110& E-44 convertToDouble +6884E-17 } 0x3d336071dcae4565 test expr-28.611 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8605 E-18 x -136071dcae4564_111111111111110& E-47 convertToDouble -8605E-18 } 0xbd036071dcae4565 test expr-28.612 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +82854 E27 x 10570ed9e3cecc_00000000000000001& E106 convertToDouble +82854E27 } 0x4690570ed9e3cecc test expr-28.613 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -55684 E24 x -167d9735144ae3_00000000000000001& E95 convertToDouble -55684E24 } 0xc5e67d9735144ae3 test expr-28.614 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +27842 E24 x 167d9735144ae3_00000000000000001& E94 convertToDouble +27842E24 } 0x45d67d9735144ae3 test expr-28.615 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -48959 E25 x -18b7cd6ca56f85_00000000000000001& E98 convertToDouble -48959E25 } 0xc618b7cd6ca56f85 test expr-28.616 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +81921 E-17 x 1cd2c9a6cdd003_000000000000000000001& E-41 convertToDouble +81921E-17 } 0x3d6cd2c9a6cdd003 test expr-28.617 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -76207 E-8 x -18f8b4dd16f1df_0000000000000000001& E-11 convertToDouble -76207E-8 } 0xbf48f8b4dd16f1df test expr-28.618 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4147 E-15 x 123d1b5eb1d778_000000000000000001& E-38 convertToDouble +4147E-15 } 0x3d923d1b5eb1d778 test expr-28.619 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -41470 E-16 x -123d1b5eb1d778_000000000000000001& E-38 convertToDouble -41470E-16 } 0xbd923d1b5eb1d778 test expr-28.620 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +89309 E24 x 12092ac5f2019e_1111111111111111110& E96 convertToDouble +89309E24 } 0x45f2092ac5f2019f test expr-28.621 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +75859 E26 x 17efd75a2938eb_1111111111111111111110& E102 convertToDouble +75859E26 } 0x4657efd75a2938ec test expr-28.622 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -75859 E25 x -132645e1ba93ef_1111111111111111111110& E99 convertToDouble -75859E25 } 0xc6232645e1ba93f0 test expr-28.623 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +14257 E-23 x 150a246ecd44f2_1111111111111111110& E-63 convertToDouble +14257E-23 } 0x3c050a246ecd44f3 test expr-28.624 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -28514 E-23 x -150a246ecd44f2_1111111111111111110& E-62 convertToDouble -28514E-23 } 0xbc150a246ecd44f3 test expr-28.625 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +57028 E-23 x 150a246ecd44f2_1111111111111111110& E-61 convertToDouble +57028E-23 } 0x3c250a246ecd44f3 test expr-28.626 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -71285 E-24 x -150a246ecd44f2_1111111111111111110& E-64 convertToDouble -71285E-24 } 0xbbf50a246ecd44f3 test expr-28.627 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +344863 E27 x 1100c873963d6d_00000000000000000001& E108 convertToDouble +344863E27 } 0x46b100c873963d6d test expr-28.628 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -951735 E27 x -17764ad224e24a_000000000000000000001& E109 convertToDouble -951735E27 } 0xc6c7764ad224e24a test expr-28.629 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +200677 E23 x 1035e73135b834_0000000000000000001& E94 convertToDouble +200677E23 } 0x45d035e73135b834 test expr-28.630 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -401354 E24 x -144360fd832641_0000000000000000001& E98 convertToDouble -401354E24 } 0xc6144360fd832641 test expr-28.631 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +839604 E-11 x 119b96f36ec68b_00000000000000000000000001& E-17 convertToDouble +839604E-11 } 0x3ee19b96f36ec68b test expr-28.632 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -209901 E-11 x -119b96f36ec68b_00000000000000000000000001& E-19 convertToDouble -209901E-11 } 0xbec19b96f36ec68b test expr-28.633 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +419802 E-11 x 119b96f36ec68b_00000000000000000000000001& E-18 convertToDouble +419802E-11 } 0x3ed19b96f36ec68b test expr-28.634 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -537734 E-24 x -13d6c1088ae40e_0000000000000000000001& E-61 convertToDouble -537734E-24 } 0xbc23d6c1088ae40e test expr-28.635 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +910308 E26 x 11f3e1839eeab0_11111111111111111111110& E106 convertToDouble +910308E26 } 0x4691f3e1839eeab1 test expr-28.636 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -227577 E26 x -11f3e1839eeab0_11111111111111111111110& E104 convertToDouble -227577E26 } 0xc671f3e1839eeab1 test expr-28.637 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +455154 E26 x 11f3e1839eeab0_11111111111111111111110& E105 convertToDouble +455154E26 } 0x4681f3e1839eeab1 test expr-28.638 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -531013 E25 x -10c17d25834171_11111111111111111111110& E102 convertToDouble -531013E25 } 0xc650c17d25834172 test expr-28.639 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +963019 E-21 x 11592429784914_11111111111111111111110& E-50 convertToDouble +963019E-21 } 0x3cd1592429784915 test expr-28.640 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -519827 E-13 x -1be872a8b30d7c_11111111111111111111110& E-25 convertToDouble -519827E-13 } 0xbe6be872a8b30d7d test expr-28.641 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +623402 E-27 x 178d2c97bde2a0_11111111111111111111110& E-71 convertToDouble +623402E-27 } 0x3b878d2c97bde2a1 test expr-28.642 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -311701 E-27 x -178d2c97bde2a0_11111111111111111111110& E-72 convertToDouble -311701E-27 } 0xbb778d2c97bde2a1 test expr-28.643 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9613651 E26 x 17b31116270d9b_000000000000000000000001& E109 convertToDouble +9613651E26 } 0x46c7b31116270d9b test expr-28.644 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -9191316 E23 x -1733bfae0801fd_0000000000000000000001& E99 convertToDouble -9191316E23 } 0xc62733bfae0801fd test expr-28.645 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4595658 E23 x 1733bfae0801fd_0000000000000000000001& E98 convertToDouble +4595658E23 } 0x461733bfae0801fd test expr-28.646 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2297829 E23 x -1733bfae0801fd_0000000000000000000001& E97 convertToDouble -2297829E23 } 0xc60733bfae0801fd test expr-28.647 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -1679208 E-11 x -119b96f36ec68b_00000000000000000000000001& E-16 convertToDouble -1679208E-11 } 0xbef19b96f36ec68b test expr-28.648 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +3379223 E27 x 14d3794ce2fc25_1111111111111111111111110& E111 convertToDouble +3379223E27 } 0x46e4d3794ce2fc26 test expr-28.649 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -6758446 E27 x -14d3794ce2fc25_1111111111111111111111110& E112 convertToDouble -6758446E27 } 0xc6f4d3794ce2fc26 test expr-28.650 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +5444097 E-21 x 18849dd33c95ae_11111111111111111111111111110& E-48 convertToDouble +5444097E-21 } 0x3cf8849dd33c95af test expr-28.651 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8399969 E-27 x -13d5783e85fcf7_1111111111111111111111110& E-67 convertToDouble -8399969E-27 } 0xbbc3d5783e85fcf8 test expr-28.652 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8366487 E-16 x 1cbf3d630403af_1111111111111111111111110& E-31 convertToDouble +8366487E-16 } 0x3e0cbf3d630403b0 test expr-28.653 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8366487 E-15 x -11f7865de2824d_11111111111111111111111110& E-27 convertToDouble -8366487E-15 } 0xbe41f7865de2824e test expr-28.654 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +65060671 E25 x 1009e7d474572a_0000000000000000000000000001& E109 convertToDouble +65060671E25 } 0x46c009e7d474572a test expr-28.655 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +65212389 E23 x 1493d098d37657_000000000000000000000000001& E102 convertToDouble +65212389E23 } 0x465493d098d37657 test expr-28.656 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +55544957 E-13 x 174c1826f3010c_00000000000000000000000000001& E-18 convertToDouble +55544957E-13 } 0x3ed74c1826f3010c test expr-28.657 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -51040905 E-20 x -11f55b23c8bf2d_0000000000000000000000000001& E-41 convertToDouble -51040905E-20 } 0xbd61f55b23c8bf2d test expr-28.658 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +99585767 E-22 x 166cba8699f0f2_0000000000000000000000000001& E-47 convertToDouble +99585767E-22 } 0x3d066cba8699f0f2 test expr-28.659 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -99585767 E-23 x -11f095387b2728_0000000000000000000000000001& E-50 convertToDouble -99585767E-23 } 0xbcd1f095387b2728 test expr-28.660 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +40978393 E26 x 1941401cca2bfd_1111111111111111111111111110& E111 convertToDouble +40978393E26 } 0x46e941401cca2bfe test expr-28.661 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -67488159 E24 x -1a9e90059d12db_11111111111111111111111111110& E105 convertToDouble -67488159E24 } 0xc68a9e90059d12dc test expr-28.662 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +69005339 E23 x 15c634f6ef1f95_111111111111111111111111110& E102 convertToDouble +69005339E23 } 0x4655c634f6ef1f96 test expr-28.663 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -81956786 E26 x -1941401cca2bfd_1111111111111111111111111110& E112 convertToDouble -81956786E26 } 0xc6f941401cca2bfe test expr-28.664 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -87105552 E-21 x -18849dd33c95ae_11111111111111111111111111110& E-44 convertToDouble -87105552E-21 } 0xbd38849dd33c95af test expr-28.665 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +10888194 E-21 x 18849dd33c95ae_11111111111111111111111111110& E-47 convertToDouble +10888194E-21 } 0x3d08849dd33c95af test expr-28.666 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -21776388 E-21 x -18849dd33c95ae_11111111111111111111111111110& E-46 convertToDouble -21776388E-21 } 0xbd18849dd33c95af test expr-28.667 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +635806667 E27 x 1e9cec176c96f8_000000000000000000000000000000001& E118 convertToDouble +635806667E27 } 0x475e9cec176c96f8 test expr-28.668 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -670026614 E25 x -14a593f89f4194_00000000000000000000000000000001& E112 convertToDouble -670026614E25 } 0xc6f4a593f89f4194 test expr-28.669 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +335013307 E26 x 19cef8f6c711f9_0000000000000000000000000000001& E114 convertToDouble +335013307E26 } 0x4719cef8f6c711f9 test expr-28.670 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -335013307 E25 x -14a593f89f4194_00000000000000000000000000000001& E111 convertToDouble -335013307E25 } 0xc6e4a593f89f4194 test expr-28.671 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +371790617 E-24 x 1aca538c61ba9c_000000000000000000000000000000001& E-52 convertToDouble +371790617E-24 } 0x3cbaca538c61ba9c test expr-28.672 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -371790617 E-25 x -156ea93d1afbb0_0000000000000000000000000000000001& E-55 convertToDouble -371790617E-25 } 0xbc856ea93d1afbb0 test expr-28.673 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +743581234 E-24 x 1aca538c61ba9c_000000000000000000000000000000001& E-51 convertToDouble +743581234E-24 } 0x3ccaca538c61ba9c test expr-28.674 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -743581234 E-25 x -156ea93d1afbb0_0000000000000000000000000000000001& E-54 convertToDouble -743581234E-25 } 0xbc956ea93d1afbb0 test expr-28.675 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +202464477 E24 x 13f6ec0435ce24_111111111111111111111111111110& E107 convertToDouble +202464477E24 } 0x46a3f6ec0435ce25 test expr-28.676 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -404928954 E24 x -13f6ec0435ce24_111111111111111111111111111110& E108 convertToDouble -404928954E24 } 0xc6b3f6ec0435ce25 test expr-28.677 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +997853758 E27 x 1805bfa33b98fa_111111111111111111111111111110& E119 convertToDouble +997853758E27 } 0x476805bfa33b98fb test expr-28.678 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -997853758 E26 x -1337cc829613fb_111111111111111111111111111110& E116 convertToDouble -997853758E26 } 0xc73337cc829613fc test expr-28.679 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +405498418 E-17 x 116a8093df66a6_111111111111111111111111111111110& E-28 convertToDouble +405498418E-17 } 0x3e316a8093df66a7 test expr-28.680 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -582579084 E-14 x -186f653140a658_111111111111111111111111111111110& E-18 convertToDouble -582579084E-14 } 0xbed86f653140a659 test expr-28.681 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +608247627 E-18 x 14e633e4a5ae61_111111111111111111111111111111110& E-31 convertToDouble +608247627E-18 } 0x3e04e633e4a5ae62 test expr-28.682 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -291289542 E-14 x -186f653140a658_111111111111111111111111111111110& E-19 convertToDouble -291289542E-14 } 0xbec86f653140a659 test expr-28.683 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -9537100005 E26 x -16f5b11191713a_000000000000000000000000000000001& E119 convertToDouble -9537100005E26 } 0xc766f5b11191713a test expr-28.684 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6358066670 E27 x 1322138ea3de5b_000000000000000000000000000000001& E122 convertToDouble +6358066670E27 } 0x479322138ea3de5b test expr-28.685 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -1271613334 E27 x -1e9cec176c96f8_000000000000000000000000000000001& E119 convertToDouble -1271613334E27 } 0xc76e9cec176c96f8 test expr-28.686 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +5229646999 E-16 x 118c3b89731f3d_000000000000000000000000000000000001& E-21 convertToDouble +5229646999E-16 } 0x3ea18c3b89731f3d test expr-28.687 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +5229646999 E-17 x 1c13927584fec8_00000000000000000000000000000000001& E-25 convertToDouble +5229646999E-17 } 0x3e6c13927584fec8 test expr-28.688 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4429943614 E24 x 1b4d37fa06864a_1111111111111111111111111111111110& E111 convertToDouble +4429943614E24 } 0x46eb4d37fa06864b test expr-28.689 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8859887228 E24 x -1b4d37fa06864a_1111111111111111111111111111111110& E112 convertToDouble -8859887228E24 } 0xc6fb4d37fa06864b test expr-28.690 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +2214971807 E24 x 1b4d37fa06864a_1111111111111111111111111111111110& E110 convertToDouble +2214971807E24 } 0x46db4d37fa06864b test expr-28.691 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4176887093 E26 x -141c692c5bd07a_111111111111111111111111111111110& E118 convertToDouble -4176887093E26 } 0xc7541c692c5bd07b test expr-28.692 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4003495257 E-20 x 16026b2e07ec06_111111111111111111111111111111111110& E-35 convertToDouble +4003495257E-20 } 0x3dc6026b2e07ec07 test expr-28.693 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4361901637 E-23 x -188e29a9d7c5b8_11111111111111111111111111111111110& E-45 convertToDouble -4361901637E-23 } 0xbd288e29a9d7c5b9 test expr-28.694 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8723803274 E-23 x 188e29a9d7c5b8_11111111111111111111111111111111110& E-44 convertToDouble +8723803274E-23 } 0x3d388e29a9d7c5b9 test expr-28.695 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8006990514 E-20 x -16026b2e07ec06_111111111111111111111111111111111110& E-34 convertToDouble -8006990514E-20 } 0xbdd6026b2e07ec07 test expr-28.696 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +72835110098 E27 x 1b65c41711fb6d_0000000000000000000000000000000000001& E125 convertToDouble +72835110098E27 } 0x47cb65c41711fb6d test expr-28.697 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -36417555049 E27 x -1b65c41711fb6d_0000000000000000000000000000000000001& E124 convertToDouble -36417555049E27 } 0xc7bb65c41711fb6d test expr-28.698 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +84279630104 E25 x 144a221b1cf62e_000000000000000000000000000000000001& E119 convertToDouble +84279630104E25 } 0x47644a221b1cf62e test expr-28.699 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -84279630104 E24 x -103b4e7c172b58_000000000000000000000000000000000001& E116 convertToDouble -84279630104E24 } 0xc7303b4e7c172b58 test expr-28.700 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +21206176437 E-27 x 1872f563ae0cc9_0000000000000000000000000000000000001& E-56 convertToDouble +21206176437E-27 } 0x3c7872f563ae0cc9 test expr-28.701 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -66461566917 E-22 x -1d3ae83e4322b3_00000000000000000000000000000000000001& E-38 convertToDouble -66461566917E-22 } 0xbd9d3ae83e4322b3 test expr-28.702 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +64808355539 E-16 x 1b2ebe83265fbf_00000000000000000000000000000000000001& E-18 convertToDouble +64808355539E-16 } 0x3edb2ebe83265fbf test expr-28.703 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -84932679673 E-19 x -123d39339f1bf6_00000000000000000000000000000000000001& E-27 convertToDouble -84932679673E-19 } 0xbe423d39339f1bf6 test expr-28.704 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +65205430094 E26 x 139f3e5d7fd76a_1111111111111111111111111111111111110& E122 convertToDouble +65205430094E26 } 0x47939f3e5d7fd76b test expr-28.705 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -68384463429 E25 x -107684982f634e_1111111111111111111111111111111111111110& E119 convertToDouble -68384463429E25 } 0xc7607684982f634f test expr-28.706 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +32602715047 E26 x 139f3e5d7fd76a_1111111111111111111111111111111111110& E121 convertToDouble +32602715047E26 } 0x47839f3e5d7fd76b test expr-28.707 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -62662203426 E27 x -1792269424688d_111111111111111111111111111111111110& E125 convertToDouble -62662203426E27 } 0xc7c792269424688e test expr-28.708 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +58784444678 E-18 x 1f8f45c64b4682_111111111111111111111111111111111111110& E-25 convertToDouble +58784444678E-18 } 0x3e6f8f45c64b4683 test expr-28.709 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -50980203373 E-21 x -1c06d366394440_11111111111111111111111111111111111111111110& E-35 convertToDouble -50980203373E-21 } 0xbdcc06d366394441 test expr-28.710 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +29392222339 E-18 x 1f8f45c64b4682_111111111111111111111111111111111111110& E-26 convertToDouble +29392222339E-18 } 0x3e5f8f45c64b4683 test expr-28.711 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -75529940323 E-27 x -15c5203c0aad52_1111111111111111111111111111111111111110& E-54 convertToDouble -75529940323E-27 } 0xbc95c5203c0aad53 test expr-28.712 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -937495906299 E26 x -11a1e0ebb6af11_000000000000000000000000000000000000000001& E126 convertToDouble -937495906299E26 } 0xc7d1a1e0ebb6af11 test expr-28.713 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +842642485799 E-20 x 121879decdd7cb_000000000000000000000000000000000000000001& E-27 convertToDouble +842642485799E-20 } 0x3e421879decdd7cb test expr-28.714 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -387824150699 E-23 x -110e8302245571_00000000000000000000000000000000000000001& E-38 convertToDouble -387824150699E-23 } 0xbd910e8302245571 test expr-28.715 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +924948814726 E-27 x 10a992d1fc6ded_00000000000000000000000000000000000000001& E-50 convertToDouble +924948814726E-27 } 0x3cd0a992d1fc6ded test expr-28.716 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -775648301398 E-23 x -110e8302245571_00000000000000000000000000000000000000001& E-37 convertToDouble -775648301398E-23 } 0xbda10e8302245571 test expr-28.717 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +547075707432 E25 x 107684982f634e_1111111111111111111111111111111111111110& E122 convertToDouble +547075707432E25 } 0x47907684982f634f test expr-28.718 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +683844634290 E24 x 107684982f634e_1111111111111111111111111111111111111110& E119 convertToDouble +683844634290E24 } 0x47607684982f634f test expr-28.719 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -136768926858 E25 x -107684982f634e_1111111111111111111111111111111111111110& E120 convertToDouble -136768926858E25 } 0xc7707684982f634f test expr-28.720 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +509802033730 E-22 x 1c06d366394440_11111111111111111111111111111111111111111110& E-35 convertToDouble +509802033730E-22 } 0x3dcc06d366394441 test expr-28.721 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +101960406746 E-21 x 1c06d366394440_11111111111111111111111111111111111111111110& E-34 convertToDouble +101960406746E-21 } 0x3ddc06d366394441 test expr-28.722 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -815683253968 E-21 x -1c06d366394440_11111111111111111111111111111111111111111110& E-31 convertToDouble -815683253968E-21 } 0xbe0c06d366394441 test expr-28.723 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +7344124123524 E24 x 1619b519dd6833_00000000000000000000000000000000000000000001& E122 convertToDouble +7344124123524E24 } 0x479619b519dd6833 test expr-28.724 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -9180155154405 E23 x -1619b519dd6833_00000000000000000000000000000000000000000001& E119 convertToDouble -9180155154405E23 } 0xc76619b519dd6833 test expr-28.725 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6479463327323 E27 x 130a9b3e9bd05e_00000000000000000000000000000000000000000001& E132 convertToDouble +6479463327323E27 } 0x48330a9b3e9bd05e test expr-28.726 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -1836031030881 E24 x -1619b519dd6833_00000000000000000000000000000000000000000001& E120 convertToDouble -1836031030881E24 } 0xc77619b519dd6833 test expr-28.727 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4337269293039 E-19 x 1d1b5f354c63d6_00000000000000000000000000000000000000000001& E-22 convertToDouble +4337269293039E-19 } 0x3e9d1b5f354c63d6 test expr-28.728 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4599163554373 E-23 x -1948bf4d34088d_00000000000000000000000000000000000000000001& E-35 convertToDouble -4599163554373E-23 } 0xbdc948bf4d34088d test expr-28.729 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9198327108746 E-23 x 1948bf4d34088d_00000000000000000000000000000000000000000001& E-34 convertToDouble +9198327108746E-23 } 0x3dd948bf4d34088d test expr-28.730 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4812803938347 E27 x 1c4980a4ee94ce_111111111111111111111111111111111111111111110& E131 convertToDouble +4812803938347E27 } 0x482c4980a4ee94cf test expr-28.731 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8412030890011 E23 x -14405075e52db9_11111111111111111111111111111111111111111110& E119 convertToDouble -8412030890011E23 } 0xc764405075e52dba test expr-28.732 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9625607876694 E27 x 1c4980a4ee94ce_111111111111111111111111111111111111111111110& E132 convertToDouble +9625607876694E27 } 0x483c4980a4ee94cf test expr-28.733 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4739968828249 E24 x -1c87140cdf8a1d_1111111111111111111111111111111111111111110& E121 convertToDouble -4739968828249E24 } 0xc78c87140cdf8a1e test expr-28.734 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9697183891673 E-23 x 1aa7c959b6a666_11111111111111111111111111111111111111111111110& E-34 convertToDouble +9697183891673E-23 } 0x3ddaa7c959b6a667 test expr-28.735 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -7368108517543 E-20 x -13c7535bbd85a1_1111111111111111111111111111111111111111111110& E-24 convertToDouble -7368108517543E-20 } 0xbe73c7535bbd85a2 test expr-28.736 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +51461358161422 E25 x 18326f87d4cae0_0000000000000000000000000000000000000000000000001& E128 convertToDouble +51461358161422E25 } 0x47f8326f87d4cae0 test expr-28.737 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -77192037242133 E26 x -16af488f577e32_0000000000000000000000000000000000000000000000001& E132 convertToDouble -77192037242133E26 } 0xc836af488f577e32 test expr-28.738 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +77192037242133 E25 x 1225d3a5df9828_0000000000000000000000000000000000000000000000001& E129 convertToDouble +77192037242133E25 } 0x480225d3a5df9828 test expr-28.739 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -51461358161422 E27 x -12e767221e3e7f_0000000000000000000000000000000000000000000000001& E135 convertToDouble -51461358161422E27 } 0xc862e767221e3e7f test expr-28.740 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +43999661561541 E-21 x 179f4476d372a3_0000000000000000000000000000000000000000000000001& E-25 convertToDouble +43999661561541E-21 } 0x3e679f4476d372a3 test expr-28.741 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -87999323123082 E-21 x -179f4476d372a3_0000000000000000000000000000000000000000000000001& E-24 convertToDouble -87999323123082E-21 } 0xbe779f4476d372a3 test expr-28.742 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +48374886826137 E-26 x 110538f23350d5_00000000000000000000000000000000000000000000001& E-41 convertToDouble +48374886826137E-26 } 0x3d610538f23350d5 test expr-28.743 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -57684246567111 E-23 x -13d1f5c1b8a912_00000000000000000000000000000000000000000000001& E-31 convertToDouble -57684246567111E-23 } 0xbe03d1f5c1b8a912 test expr-28.744 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +87192805957686 E23 x 1a3d16e55a9664_1111111111111111111111111111111111111111111110& E122 convertToDouble +87192805957686E23 } 0x479a3d16e55a9665 test expr-28.745 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -75108713005913 E24 x -1c40b4baa79655_11111111111111111111111111111111111111111111110& E125 convertToDouble -75108713005913E24 } 0xc7cc40b4baa79656 test expr-28.746 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +64233110587487 E27 x 179873e38669a6_1111111111111111111111111111111111111111111110& E135 convertToDouble +64233110587487E27 } 0x48679873e38669a7 test expr-28.747 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -77577471133384 E-23 x -1aa7c959b6a666_11111111111111111111111111111111111111111111110& E-31 convertToDouble -77577471133384E-23 } 0xbe0aa7c959b6a667 test expr-28.748 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +48485919458365 E-24 x 1aa7c959b6a666_11111111111111111111111111111111111111111111110& E-35 convertToDouble +48485919458365E-24 } 0x3dcaa7c959b6a667 test expr-28.749 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -56908598265713 E-26 x -1405deef4bdef5_111111111111111111111111111111111111111111111110& E-41 convertToDouble -56908598265713E-26 } 0xbd6405deef4bdef6 test expr-28.750 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +589722294620133 E23 x 162ed1b287caef_00000000000000000000000000000000000000000000000001& E125 convertToDouble +589722294620133E23 } 0x47c62ed1b287caef test expr-28.751 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +652835804449289 E-22 x 118640e490b087_0000000000000000000000000000000000000000000000000001& E-24 convertToDouble +652835804449289E-22 } 0x3e718640e490b087 test expr-28.752 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -656415363936202 E-23 x -1c315cfe25d201_00000000000000000000000000000000000000000000000001& E-28 convertToDouble -656415363936202E-23 } 0xbe3c315cfe25d201 test expr-28.753 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +579336749585745 E-25 x 1fd9709d9aeb19_00000000000000000000000000000000000000000000000001& E-35 convertToDouble +579336749585745E-25 } 0x3dcfd9709d9aeb19 test expr-28.754 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -381292764980839 E-26 x -10c4f9921c3f8f_00000000000000000000000000000000000000000000000001& E-38 convertToDouble -381292764980839E-26 } 0xbd90c4f9921c3f8f test expr-28.755 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +965265859649698 E23 x 12279607edcb0c_1111111111111111111111111111111111111111111111110& E126 convertToDouble +965265859649698E23 } 0x47d2279607edcb0d test expr-28.756 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -848925235434882 E27 x -137d88ba4b43e3_1111111111111111111111111111111111111111111111111110& E139 convertToDouble -848925235434882E27 } 0xc8a37d88ba4b43e4 test expr-28.757 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +536177612222491 E23 x 142b33dd3acafd_11111111111111111111111111111111111111111111111110& E125 convertToDouble +536177612222491E23 } 0x47c42b33dd3acafe test expr-28.758 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -424462617717441 E27 x -137d88ba4b43e3_1111111111111111111111111111111111111111111111111110& E138 convertToDouble -424462617717441E27 } 0xc8937d88ba4b43e4 test expr-28.759 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +276009279888989 E-27 x 136c242313c288_111111111111111111111111111111111111111111111111110& E-42 convertToDouble +276009279888989E-27 } 0x3d536c242313c289 test expr-28.760 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -608927158043691 E-26 x -1ac7e909c22f09_11111111111111111111111111111111111111111111111110& E-38 convertToDouble -608927158043691E-26 } 0xbd9ac7e909c22f0a test expr-28.761 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +552018559777978 E-27 x 136c242313c288_111111111111111111111111111111111111111111111111110& E-41 convertToDouble +552018559777978E-27 } 0x3d636c242313c289 test expr-28.762 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -425678377667758 E-22 x -16da7aa49bdcd5_1111111111111111111111111111111111111111111111110& E-25 convertToDouble -425678377667758E-22 } 0xbe66da7aa49bdcd6 test expr-28.763 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8013702726927119 E26 x 126607f8f1b29e_00000000000000000000000000000000000000000000000000001& E139 convertToDouble +8013702726927119E26 } 0x48a26607f8f1b29e test expr-28.764 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8862627962362001 E27 x 196f3b0e7787c2_00000000000000000000000000000000000000000000000000001& E142 convertToDouble +8862627962362001E27 } 0x48d96f3b0e7787c2 test expr-28.765 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -5068007907757162 E26 x -17456a27848397_00000000000000000000000000000000000000000000000000001& E138 convertToDouble -5068007907757162E26 } 0xc897456a27848397 test expr-28.766 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -7379714799828406 E-23 x -13cf4d2839e036_00000000000000000000000000000000000000000000000000001& E-24 convertToDouble -7379714799828406E-23 } 0xbe73cf4d2839e036 test expr-28.767 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4114538064016107 E-27 x 12188eda98010c_0000000000000000000000000000000000000000000000000001& E-38 convertToDouble +4114538064016107E-27 } 0x3d92188eda98010c test expr-28.768 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -3689857399914203 E-23 x -13cf4d2839e036_00000000000000000000000000000000000000000000000000001& E-25 convertToDouble -3689857399914203E-23 } 0xbe63cf4d2839e036 test expr-28.769 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +5575954851815478 E23 x 1a37cfbf2ffdb5_1111111111111111111111111111111111111111111111111110& E128 convertToDouble +5575954851815478E23 } 0x47fa37cfbf2ffdb6 test expr-28.770 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +3395700941739528 E27 x 137d88ba4b43e3_1111111111111111111111111111111111111111111111111110& E141 convertToDouble +3395700941739528E27 } 0x48c37d88ba4b43e4 test expr-28.771 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4115535777581961 E-23 x 1618596be30fe4_111111111111111111111111111111111111111111111111111110& E-25 convertToDouble +4115535777581961E-23 } 0x3e6618596be30fe5 test expr-28.772 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8231071555163922 E-23 x -1618596be30fe4_111111111111111111111111111111111111111111111111111110& E-24 convertToDouble -8231071555163922E-23 } 0xbe7618596be30fe5 test expr-28.773 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6550246696190871 E-26 x 1201538b0f8c69_111111111111111111111111111111111111111111111111111110& E-34 convertToDouble +6550246696190871E-26 } 0x3dd201538b0f8c6a test expr-28.774 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -68083046403986701 E27 x -186c70ba8ba28d_000000000000000000000000000000000000000000000000000000001& E145 convertToDouble -68083046403986701E27 } 0xc9086c70ba8ba28d test expr-28.775 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +43566388595783643 E27 x 1f41e1bf48b03f_111111111111111111111111111111111111111111111111111111110& E144 convertToDouble +43566388595783643E27 } 0x48ff41e1bf48b040 test expr-28.776 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -87132777191567286 E27 x -1f41e1bf48b03f_111111111111111111111111111111111111111111111111111111110& E145 convertToDouble -87132777191567286E27 } 0xc90f41e1bf48b040 test expr-28.777 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +59644881059342141 E25 x 1b6338d9d8ae38_11111111111111111111111111111111111111111111111111111110& E138 convertToDouble +59644881059342141E25 } 0x489b6338d9d8ae39 test expr-28.778 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -83852770718576667 E23 x -18a4619ed6f442_111111111111111111111111111111111111111111111111111111110& E132 convertToDouble -83852770718576667E23 } 0xc838a4619ed6f443 test expr-28.779 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +99482967418206961 E-25 x 155d224bfed7ac_11111111111111111111111111111111111111111111111111111111110& E-27 convertToDouble +99482967418206961E-25 } 0x3e455d224bfed7ad test expr-28.780 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -99482967418206961 E-26 x -11174ea3324623_11111111111111111111111111111111111111111111111111111111110& E-30 convertToDouble -99482967418206961E-26 } 0xbe11174ea3324624 test expr-28.781 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +87446669969994614 E-27 x 1809832942376d_11111111111111111111111111111111111111111111111111111110& E-34 convertToDouble +87446669969994614E-27 } 0x3dd809832942376e test expr-28.782 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -43723334984997307 E-27 x -1809832942376d_11111111111111111111111111111111111111111111111111111110& E-35 convertToDouble -43723334984997307E-27 } 0xbdc809832942376e test expr-28.783 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +5 E24 x 108b2a2c280290_1001& E82 convertToDouble +5E24 } 0x45108b2a2c280291 test expr-28.784 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8 E25 x -108b2a2c280290_1001& E86 convertToDouble -8E25 } 0xc5508b2a2c280291 test expr-28.785 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +1 E25 x 108b2a2c280290_1001& E83 convertToDouble +1E25 } 0x45208b2a2c280291 test expr-28.786 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4 E25 x -108b2a2c280290_1001& E85 convertToDouble -4E25 } 0xc5408b2a2c280291 test expr-28.787 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +2 E-5 x 14f8b588e368f0_100001& E-16 convertToDouble +2E-5 } 0x3ef4f8b588e368f1 test expr-28.788 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -5 E-6 x -14f8b588e368f0_100001& E-18 convertToDouble -5E-6 } 0xbed4f8b588e368f1 test expr-28.789 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4 E-5 x 14f8b588e368f0_100001& E-15 convertToDouble +4E-5 } 0x3f04f8b588e368f1 test expr-28.790 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -3 E-20 x -11b578c96db19a_100001& E-65 convertToDouble -3E-20 } 0xbbe1b578c96db19b test expr-28.791 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +3 E27 x 1363156bbee301_0110& E91 convertToDouble +3E27 } 0x45a363156bbee301 test expr-28.792 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -9 E26 x -1743b34e18439b_010& E89 convertToDouble -9E26 } 0xc58743b34e18439b test expr-28.793 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +7 E25 x 1cf389cd46047d_00& E85 convertToDouble +7E25 } 0x454cf389cd46047d test expr-28.794 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -6 E27 x -1363156bbee301_0110& E92 convertToDouble -6E27 } 0xc5b363156bbee301 test expr-28.795 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +2 E-21 x 12e3b40a0e9b4f_0111110& E-69 convertToDouble +2E-21 } 0x3ba2e3b40a0e9b4f test expr-28.796 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -5 E-22 x -12e3b40a0e9b4f_0111110& E-71 convertToDouble -5E-22 } 0xbb82e3b40a0e9b4f test expr-28.797 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4 E-21 x -12e3b40a0e9b4f_0111110& E-68 convertToDouble -4E-21 } 0xbbb2e3b40a0e9b4f test expr-28.798 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +87 E25 x 167d2d5406637c_10001& E89 convertToDouble +87E25 } 0x45867d2d5406637d test expr-28.799 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -97 E24 x -140f232256e982_1000000001& E86 convertToDouble -97E24 } 0xc5540f232256e983 test expr-28.800 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +82 E-24 x 18c87154dff6c6_1000000001& E-74 convertToDouble +82E-24 } 0x3b58c87154dff6c7 test expr-28.801 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -41 E-24 x -18c87154dff6c6_1000000001& E-75 convertToDouble -41E-24 } 0xbb48c87154dff6c7 test expr-28.802 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +76 E-23 x 1cb644dc1633c0_10000001& E-71 convertToDouble +76E-23 } 0x3b8cb644dc1633c1 test expr-28.803 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +83 E25 x 15747ab143e353_011111111110& E89 convertToDouble +83E25 } 0x4585747ab143e353 test expr-28.804 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -50 E27 x -1431e0fae6d721_0111110& E95 convertToDouble -50E27 } 0xc5e431e0fae6d721 test expr-28.805 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +25 E27 x 1431e0fae6d721_0111110& E94 convertToDouble +25E27 } 0x45d431e0fae6d721 test expr-28.806 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -99 E27 x -13fe2e171cda19_011110& E96 convertToDouble -99E27 } 0xc5f3fe2e171cda19 test expr-28.807 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +97 E-10 x 14d4a1a3157dc7_011111110& E-27 convertToDouble +97E-10 } 0x3e44d4a1a3157dc7 test expr-28.808 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -57 E-20 x -15077f6f3242e7_011111110& E-61 convertToDouble -57E-20 } 0xbc25077f6f3242e7 test expr-28.809 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +997 E23 x 149e12f51c1a3c_10000000001& E86 convertToDouble +997E23 } 0x45549e12f51c1a3d test expr-28.810 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +776 E24 x 140f232256e982_1000000001& E89 convertToDouble +776E24 } 0x45840f232256e983 test expr-28.811 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -388 E24 x -140f232256e982_1000000001& E88 convertToDouble -388E24 } 0xc5740f232256e983 test expr-28.812 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +521 E-10 x 1bf891c92c0890_100000000001& E-25 convertToDouble +521E-10 } 0x3e6bf891c92c0891 test expr-28.813 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -506 E-26 x -1877fa0260beb2_10000000001& E-78 convertToDouble -506E-26 } 0xbb1877fa0260beb3 test expr-28.814 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +739 E-10 x 13d65e8c76722c_10000000001& E-24 convertToDouble +739E-10 } 0x3e73d65e8c76722d test expr-28.815 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -867 E-7 x -16ba56a8834168_100000000001& E-14 convertToDouble -867E-7 } 0xbf16ba56a8834169 test expr-28.816 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -415 E24 x -15747ab143e353_011111111110& E88 convertToDouble -415E24 } 0xc575747ab143e353 test expr-28.817 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +332 E25 x 15747ab143e353_011111111110& E91 convertToDouble +332E25 } 0x45a5747ab143e353 test expr-28.818 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -664 E25 x -15747ab143e353_011111111110& E92 convertToDouble -664E25 } 0xc5b5747ab143e353 test expr-28.819 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +291 E-13 x 1ffeebfc8b81b5_01111111111110& E-36 convertToDouble +291E-13 } 0x3dbffeebfc8b81b5 test expr-28.820 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -982 E-8 x -14981285e98e79_0111111111110& E-17 convertToDouble -982E-8 } 0xbee4981285e98e79 test expr-28.821 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +582 E-13 x 1ffeebfc8b81b5_01111111111110& E-35 convertToDouble +582E-13 } 0x3dcffeebfc8b81b5 test expr-28.822 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -491 E-8 x -14981285e98e79_0111111111110& E-18 convertToDouble -491E-8 } 0xbed4981285e98e79 test expr-28.823 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4574 E26 x 1717c1a612f954_100000000001& E98 convertToDouble +4574E26 } 0x461717c1a612f955 test expr-28.824 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8609 E26 x -15bb6f942546ee_1000000000001& E99 convertToDouble -8609E26 } 0xc625bb6f942546ef test expr-28.825 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +2287 E26 x 1717c1a612f954_100000000001& E97 convertToDouble +2287E26 } 0x460717c1a612f955 test expr-28.826 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4818 E24 x -1f22b65eb419a0_10000000001& E91 convertToDouble -4818E24 } 0xc5af22b65eb419a1 test expr-28.827 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6529 E-8 x 111d89a8b5c142_100000000000001& E-14 convertToDouble +6529E-8 } 0x3f111d89a8b5c143 test expr-28.828 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8151 E-21 x -12cb804b61b898_1000000000000001& E-57 convertToDouble -8151E-21 } 0xbc62cb804b61b899 test expr-28.829 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +1557 E-12 x 1abfc227ab1026_10000000000001& E-30 convertToDouble +1557E-12 } 0x3e1abfc227ab1027 test expr-28.830 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2573 E-18 x -172cef1ebbca44_10000000000001& E-49 convertToDouble -2573E-18 } 0xbce72cef1ebbca45 test expr-28.831 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4929 E-16 x 1157a604ed019f_0111111111111110& E-41 convertToDouble +4929E-16 } 0x3d6157a604ed019f test expr-28.832 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -3053 E-22 x -1686f435fe6b6b_011111111111110& E-62 convertToDouble -3053E-22 } 0xbc1686f435fe6b6b test expr-28.833 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9858 E-16 x 1157a604ed019f_0111111111111110& E-40 convertToDouble +9858E-16 } 0x3d7157a604ed019f test expr-28.834 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -7767 E-11 x -14d971170ed055_011111111111110& E-24 convertToDouble -7767E-11 } 0xbe74d971170ed055 test expr-28.835 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +54339 E26 x 1125782ec15cbe_100000000000000001& E102 convertToDouble +54339E26 } 0x465125782ec15cbf test expr-28.836 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -62409 E25 x -1f822c980d4bb2_100000000000000001& E98 convertToDouble -62409E25 } 0xc61f822c980d4bb3 test expr-28.837 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +32819 E27 x 19e3be885fc16a_100000000000001& E104 convertToDouble +32819E27 } 0x4679e3be885fc16b test expr-28.838 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -89849 E27 x -11b8371b6dda04_1000000000000001& E106 convertToDouble -89849E27 } 0xc691b8371b6dda05 test expr-28.839 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +63876 E-20 x 1703856844bdbe_1000000000000000000001& E-51 convertToDouble +63876E-20 } 0x3cc703856844bdbf test expr-28.840 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -15969 E-20 x -1703856844bdbe_1000000000000000000001& E-53 convertToDouble -15969E-20 } 0xbca703856844bdbf test expr-28.841 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +31938 E-20 x 1703856844bdbe_1000000000000000000001& E-52 convertToDouble +31938E-20 } 0x3cb703856844bdbf test expr-28.842 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -79845 E-21 x -1703856844bdbe_1000000000000000000001& E-54 convertToDouble -79845E-21 } 0xbc9703856844bdbf test expr-28.843 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +89306 E27 x 119cccff237e17_011111111111110& E106 convertToDouble +89306E27 } 0x46919cccff237e17 test expr-28.844 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -25487 E24 x -1496968ba07117_01111111111110& E94 convertToDouble -25487E24 } 0xc5d496968ba07117 test expr-28.845 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +79889 E24 x 10222a1c7e27d3_01111111111110& E96 convertToDouble +79889E24 } 0x45f0222a1c7e27d3 test expr-28.846 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -97379 E26 x -1eba3685911519_011111111111111110& E102 convertToDouble -97379E26 } 0xc65eba3685911519 test expr-28.847 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +81002 E-8 x 1a8af0b45d9531_0111111111111111110& E-11 convertToDouble +81002E-8 } 0x3f4a8af0b45d9531 test expr-28.848 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -43149 E-25 x -146064de6ecbed_011111111111111110& E-68 convertToDouble -43149E-25 } 0xbbb46064de6ecbed test expr-28.849 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +40501 E-8 x 1a8af0b45d9531_0111111111111111110& E-12 convertToDouble +40501E-8 } 0x3f3a8af0b45d9531 test expr-28.850 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -60318 E-10 x -194c988f217e51_011111111111111110& E-18 convertToDouble -60318E-10 } 0xbed94c988f217e51 test expr-28.851 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -648299 E27 x -1ff6af0bf00100_10000000000000000001& E108 convertToDouble -648299E27 } 0xc6bff6af0bf00101 test expr-28.852 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +780649 E24 x 13b4d36f9edd18_10000000000000000001& E99 convertToDouble +780649E24 } 0x4623b4d36f9edd19 test expr-28.853 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +720919 E-14 x 1ef696965cbf04_10000000000000000000000001& E-28 convertToDouble +720919E-14 } 0x3e3ef696965cbf05 test expr-28.854 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -629703 E-11 x -1a69626d2629d0_1000000000000000000000001& E-18 convertToDouble -629703E-11 } 0xbeda69626d2629d1 test expr-28.855 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +557913 E24 x 1c2adb44b394bf_01111111111111111110& E98 convertToDouble +557913E24 } 0x461c2adb44b394bf test expr-28.856 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -847899 E23 x -111f88fb93dce9_011111111111111111110& E96 convertToDouble -847899E23 } 0xc5f11f88fb93dce9 test expr-28.857 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +565445 E27 x 1be0eb55770d4d_0111111111111111110& E108 convertToDouble +565445E27 } 0x46bbe0eb55770d4d test expr-28.858 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -736531 E24 x -1297b853d64ac7_01111111111111111110& E99 convertToDouble -736531E24 } 0xc62297b853d64ac7 test expr-28.859 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +680013 E-19 x 13240293e95c3b_01111111111111111111110& E-44 convertToDouble +680013E-19 } 0x3d33240293e95c3b test expr-28.860 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -529981 E-10 x -1bc948d999ac11_011111111111111111110& E-15 convertToDouble -529981E-10 } 0xbf0bc948d999ac11 test expr-28.861 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +382923 E-23 x 11a8c1c10a1fc5_011111111111111111110& E-58 convertToDouble +382923E-23 } 0x3c51a8c1c10a1fc5 test expr-28.862 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -633614 E-18 x -164b166995a9b7_011111111111111111110& E-41 convertToDouble -633614E-18 } 0xbd664b166995a9b7 test expr-28.863 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +2165479 E27 x 1ab10c016c34b8_100000000000000000000001& E110 convertToDouble +2165479E27 } 0x46dab10c016c34b9 test expr-28.864 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8661916 E27 x -1ab10c016c34b8_100000000000000000000001& E112 convertToDouble -8661916E27 } 0xc6fab10c016c34b9 test expr-28.865 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4330958 E27 x 1ab10c016c34b8_100000000000000000000001& E111 convertToDouble +4330958E27 } 0x46eab10c016c34b9 test expr-28.866 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -9391993 E22 x -12f78bec748c98_1000000000000000000001& E96 convertToDouble -9391993E22 } 0xc5f2f78bec748c99 test expr-28.867 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -5767352 E-14 x -1ef696965cbf04_10000000000000000000000001& E-25 convertToDouble -5767352E-14 } 0xbe6ef696965cbf05 test expr-28.868 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +7209190 E-15 x 1ef696965cbf04_10000000000000000000000001& E-28 convertToDouble +7209190E-15 } 0x3e3ef696965cbf05 test expr-28.869 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -1441838 E-14 x -1ef696965cbf04_10000000000000000000000001& E-27 convertToDouble -1441838E-14 } 0xbe4ef696965cbf05 test expr-28.870 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8478990 E22 x 111f88fb93dce9_011111111111111111110& E96 convertToDouble +8478990E22 } 0x45f11f88fb93dce9 test expr-28.871 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +1473062 E24 x 1297b853d64ac7_01111111111111111110& E100 convertToDouble +1473062E24 } 0x463297b853d64ac7 test expr-28.872 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8366487 E-14 x 167567f55b22e1_0111111111111111111111110& E-24 convertToDouble +8366487E-14 } 0x3e767567f55b22e1 test expr-28.873 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8399969 E-25 x -1efd8be1b15b43_011111111111111111111110& E-61 convertToDouble -8399969E-25 } 0xbc2efd8be1b15b43 test expr-28.874 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9366737 E-12 x 13a4ba87ddc13f_011111111111111111111110& E-17 convertToDouble +9366737E-12 } 0x3ee3a4ba87ddc13f test expr-28.875 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -9406141 E-13 x -1f8fd047c84d49_0111111111111111111111110& E-21 convertToDouble -9406141E-13 } 0xbeaf8fd047c84d49 test expr-28.876 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +65970979 E24 x 1a055dd68f3e3c_1000000000000000000000000001& E105 convertToDouble +65970979E24 } 0x468a055dd68f3e3d test expr-28.877 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -65060671 E26 x -140c61c9916cf4_100000000000000000000000001& E112 convertToDouble -65060671E26 } 0xc6f40c61c9916cf5 test expr-28.878 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +54923002 E27 x 1527d37d8b38ea_10000000000000000000000001& E115 convertToDouble +54923002E27 } 0x472527d37d8b38eb test expr-28.879 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -63846927 E25 x -1f7a9d79dad9b4_10000000000000000000000001& E108 convertToDouble -63846927E25 } 0xc6bf7a9d79dad9b5 test expr-28.880 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +99585767 E-21 x 1c07e928406d2e_100000000000000000000000001& E-44 convertToDouble +99585767E-21 } 0x3d3c07e928406d2f test expr-28.881 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +67488159 E25 x 10a31a03822bc9_011111111111111111111111111110& E109 convertToDouble +67488159E25 } 0x46c0a31a03822bc9 test expr-28.882 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -69005339 E24 x -1b37c234aae77b_011111111111111111111111110& E105 convertToDouble -69005339E24 } 0xc68b37c234aae77b test expr-28.883 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +81956786 E27 x 1f919023fcb6fd_0111111111111111111111111110& E115 convertToDouble +81956786E27 } 0x472f919023fcb6fd test expr-28.884 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -40978393 E27 x -1f919023fcb6fd_0111111111111111111111111110& E114 convertToDouble -40978393E27 } 0xc71f919023fcb6fd test expr-28.885 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +77505754 E-12 x 145152b6f85e09_0111111111111111111111111110& E-14 convertToDouble +77505754E-12 } 0x3f145152b6f85e09 test expr-28.886 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -38752877 E-12 x -145152b6f85e09_0111111111111111111111111110& E-15 convertToDouble -38752877E-12 } 0xbf045152b6f85e09 test expr-28.887 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +82772981 E-15 x 16381dae63505f_0111111111111111111111111111110& E-24 convertToDouble +82772981E-15 } 0x3e76381dae63505f test expr-28.888 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -95593517 E-25 x -160ad862d8537d_0111111111111111111111111110& E-57 convertToDouble -95593517E-25 } 0xbc660ad862d8537d test expr-28.889 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +200036989 E25 x 18a80dedbc575e_10000000000000000000000000001& E110 convertToDouble +200036989E25 } 0x46d8a80dedbc575f test expr-28.890 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -772686455 E27 x -129a0c45ceca7a_1000000000000000000000000000001& E119 convertToDouble -772686455E27 } 0xc7629a0c45ceca7b test expr-28.891 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +859139907 E23 x 10f18c4dd0ffe2_10000000000000000000000000001& E106 convertToDouble +859139907E23 } 0x4690f18c4dd0ffe3 test expr-28.892 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -400073978 E25 x -18a80dedbc575e_10000000000000000000000000001& E111 convertToDouble -400073978E25 } 0xc6e8a80dedbc575f test expr-28.893 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +569014327 E-14 x 17ddbeac19d3b2_100000000000000000000000000001& E-18 convertToDouble +569014327E-14 } 0x3ed7ddbeac19d3b3 test expr-28.894 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -794263862 E-15 x -1aa6acb41dfc52_1000000000000000000000000000001& E-21 convertToDouble -794263862E-15 } 0xbeaaa6acb41dfc53 test expr-28.895 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +397131931 E-15 x 1aa6acb41dfc52_1000000000000000000000000000001& E-22 convertToDouble +397131931E-15 } 0x3e9aa6acb41dfc53 test expr-28.896 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -380398957 E-16 x -146c29d8331024_100000000000000000000000000001& E-25 convertToDouble -380398957E-16 } 0xbe646c29d8331025 test expr-28.897 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +567366773 E27 x 1b5155dd5417f9_0111111111111111111111111111110& E118 convertToDouble +567366773E27 } 0x475b5155dd5417f9 test expr-28.898 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -337440795 E24 x -10a31a03822bc9_011111111111111111111111111110& E108 convertToDouble -337440795E24 } 0xc6b0a31a03822bc9 test expr-28.899 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +134976318 E25 x 10a31a03822bc9_011111111111111111111111111110& E110 convertToDouble +134976318E25 } 0x46d0a31a03822bc9 test expr-28.900 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -269952636 E25 x -10a31a03822bc9_011111111111111111111111111110& E111 convertToDouble -269952636E25 } 0xc6e0a31a03822bc9 test expr-28.901 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +932080597 E-20 x 147f25b4941e5b_0111111111111111111111111111110& E-37 convertToDouble +932080597E-20 } 0x3da47f25b4941e5b test expr-28.902 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -331091924 E-15 x -16381dae63505f_0111111111111111111111111111110& E-22 convertToDouble -331091924E-15 } 0xbe96381dae63505f test expr-28.903 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -413864905 E-16 x -16381dae63505f_0111111111111111111111111111110& E-25 convertToDouble -413864905E-16 } 0xbe66381dae63505f test expr-28.904 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8539246247 E26 x 148eb7813eaeba_10000000000000000000000000000001& E119 convertToDouble +8539246247E26 } 0x47648eb7813eaebb test expr-28.905 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -5859139791 E26 x -1c35f28719d478_10000000000000000000000000000001& E118 convertToDouble -5859139791E26 } 0xc75c35f28719d479 test expr-28.906 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6105010149 E24 x 12d000fb2b138a_1000000000000000000000000000000001& E112 convertToDouble +6105010149E24 } 0x46f2d000fb2b138b test expr-28.907 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -3090745820 E27 x -129a0c45ceca7a_1000000000000000000000000000001& E121 convertToDouble -3090745820E27 } 0xc7829a0c45ceca7b test expr-28.908 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +3470877773 E-20 x 1314d381f2c31e_1000000000000000000000000000000001& E-35 convertToDouble +3470877773E-20 } 0x3dc314d381f2c31f test expr-28.909 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -6136309089 E-27 x -1c4c799fab4328_1000000000000000000000000000000001& E-58 convertToDouble -6136309089E-27 } 0xbc5c4c799fab4329 test expr-28.910 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8917758713 E-19 x 1ea424bda7d7f4_100000000000000000000000000000001& E-31 convertToDouble +8917758713E-19 } 0x3e0ea424bda7d7f5 test expr-28.911 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -6941755546 E-20 x -1314d381f2c31e_1000000000000000000000000000000001& E-34 convertToDouble -6941755546E-20 } 0xbdd314d381f2c31f test expr-28.912 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9194900535 E25 x 11b56f9c090dfb_011111111111111111111111111111111110& E116 convertToDouble +9194900535E25 } 0x4731b56f9c090dfb test expr-28.913 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -1838980107 E26 x -11b56f9c090dfb_011111111111111111111111111111111110& E117 convertToDouble -1838980107E26 } 0xc741b56f9c090dfb test expr-28.914 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +7355920428 E26 x 11b56f9c090dfb_011111111111111111111111111111111110& E119 convertToDouble +7355920428E26 } 0x4761b56f9c090dfb test expr-28.915 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -3677960214 E26 x -11b56f9c090dfb_011111111111111111111111111111111110& E118 convertToDouble -3677960214E26 } 0xc751b56f9c090dfb test expr-28.916 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8473634343 E-17 x 16bf0984b232b7_0111111111111111111111111111111110& E-24 convertToDouble +8473634343E-17 } 0x3e76bf0984b232b7 test expr-28.917 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8870766274 E-16 x -1dc3ee22137269_0111111111111111111111111111111110& E-21 convertToDouble -8870766274E-16 } 0xbeadc3ee22137269 test expr-28.918 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +4435383137 E-16 x 1dc3ee22137269_0111111111111111111111111111111110& E-22 convertToDouble +4435383137E-16 } 0x3e9dc3ee22137269 test expr-28.919 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -9598990129 E-15 x -14216b286031e7_01111111111111111111111111111111110& E-17 convertToDouble -9598990129E-15 } 0xbee4216b286031e7 test expr-28.920 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +71563496764 E26 x 15890d1ef6a0da_10000000000000000000000000000000000001& E122 convertToDouble +71563496764E26 } 0x4795890d1ef6a0db test expr-28.921 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -89454370955 E25 x -15890d1ef6a0da_10000000000000000000000000000000000001& E119 convertToDouble -89454370955E25 } 0xc765890d1ef6a0db test expr-28.922 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +17890874191 E26 x 15890d1ef6a0da_10000000000000000000000000000000000001& E120 convertToDouble +17890874191E26 } 0x4775890d1ef6a0db test expr-28.923 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -35781748382 E26 x -15890d1ef6a0da_10000000000000000000000000000000000001& E121 convertToDouble -35781748382E26 } 0xc785890d1ef6a0db test expr-28.924 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +57973447842 E-19 x 18e63f7cf5313c_1000000000000000000000000000000000000001& E-28 convertToDouble +57973447842E-19 } 0x3e38e63f7cf5313d test expr-28.925 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -28986723921 E-19 x -18e63f7cf5313c_1000000000000000000000000000000000000001& E-29 convertToDouble -28986723921E-19 } 0xbe28e63f7cf5313d test expr-28.926 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +76822711313 E-19 x 107f5f8b3bf818_100000000000000000000000000000000001& E-27 convertToDouble +76822711313E-19 } 0x3e407f5f8b3bf819 test expr-28.927 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -97699466874 E-20 x -10c8de34de806e_10000000000000000000000000000000001& E-30 convertToDouble -97699466874E-20 } 0xbe10c8de34de806f test expr-28.928 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +67748656762 E27 x 197bf5559b31fd_01111111111111111111111111111111111110& E125 convertToDouble +67748656762E27 } 0x47c97bf5559b31fd test expr-28.929 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -19394840991 E24 x -1de1ea791a6e7d_0111111111111111111111111111111111110& E113 convertToDouble -19394840991E24 } 0xc70de1ea791a6e7d test expr-28.930 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +38789681982 E24 x 1de1ea791a6e7d_0111111111111111111111111111111111110& E114 convertToDouble +38789681982E24 } 0x471de1ea791a6e7d test expr-28.931 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -33874328381 E27 x -197bf5559b31fd_01111111111111111111111111111111111110& E124 convertToDouble -33874328381E27 } 0xc7b97bf5559b31fd test expr-28.932 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +54323763886 E-27 x 1f50c5c63e5441_0111111111111111111111111111111111110& E-55 convertToDouble +54323763886E-27 } 0x3c8f50c5c63e5441 test expr-28.933 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -58987193887 E-20 x -14449185a4c829_011111111111111111111111111111111111110& E-31 convertToDouble -58987193887E-20 } 0xbe04449185a4c829 test expr-28.934 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +27161881943 E-27 x 1f50c5c63e5441_0111111111111111111111111111111111110& E-56 convertToDouble +27161881943E-27 } 0x3c7f50c5c63e5441 test expr-28.935 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -93042648033 E-19 x -13fb12dc023fd3_0111111111111111111111111111111111110& E-27 convertToDouble -93042648033E-19 } 0xbe43fb12dc023fd3 test expr-28.936 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +520831059055 E27 x 187d469cb69dd0_10000000000000000000000000000000000000001& E128 convertToDouble +520831059055E27 } 0x47f87d469cb69dd1 test expr-28.937 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -768124264394 E25 x -171d6a019edae8_1000000000000000000000000000000000000001& E122 convertToDouble -768124264394E25 } 0xc7971d6a019edae9 test expr-28.938 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +384062132197 E25 x 171d6a019edae8_1000000000000000000000000000000000000001& E121 convertToDouble +384062132197E25 } 0x47871d6a019edae9 test expr-28.939 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +765337749889 E-25 x 158ad6f5d0a854_100000000000000000000000000000000000000001& E-44 convertToDouble +765337749889E-25 } 0x3d358ad6f5d0a855 test expr-28.940 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +794368912771 E25 x 17e79872f2f7ef_01111111111111111111111111111111111111110& E122 convertToDouble +794368912771E25 } 0x4797e79872f2f7ef test expr-28.941 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -994162090146 E23 x -132598f85e658b_011111111111111111111111111111111111110& E116 convertToDouble -994162090146E23 } 0xc7332598f85e658b test expr-28.942 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +781652779431 E26 x 1d670adf52038f_01111111111111111111111111111111111110& E125 convertToDouble +781652779431E26 } 0x47cd670adf52038f test expr-28.943 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +910077190046 E-26 x 147e3ce1871d79_01111111111111111111111111111111111111110& E-47 convertToDouble +910077190046E-26 } 0x3d047e3ce1871d79 test expr-28.944 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -455038595023 E-26 x -147e3ce1871d79_01111111111111111111111111111111111111110& E-48 convertToDouble -455038595023E-26 } 0xbcf47e3ce1871d79 test expr-28.945 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +471897551096 E-20 x 14449185a4c829_011111111111111111111111111111111111110& E-28 convertToDouble +471897551096E-20 } 0x3e34449185a4c829 test expr-28.946 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -906698409911 E-21 x -1f27674f7d5745_0111111111111111111111111111111111111110& E-31 convertToDouble -906698409911E-21 } 0xbe0f27674f7d5745 test expr-28.947 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8854128003935 E25 x 10a71b8948faac_100000000000000000000000000000000000000001& E126 convertToDouble +8854128003935E25 } 0x47d0a71b8948faad test expr-28.948 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8146122716299 E27 x -17f0762ac05654_1000000000000000000000000000000000000000001& E132 convertToDouble -8146122716299E27 } 0xc837f0762ac05655 test expr-28.949 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +7083302403148 E26 x 10a71b8948faac_100000000000000000000000000000000000000001& E129 convertToDouble +7083302403148E26 } 0x4800a71b8948faad test expr-28.950 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -3541651201574 E26 x -10a71b8948faac_100000000000000000000000000000000000000001& E128 convertToDouble -3541651201574E26 } 0xc7f0a71b8948faad test expr-28.951 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8394920649291 E-25 x 1d8978e8c1cc78_100000000000000000000000000000000000000000001& E-41 convertToDouble +8394920649291E-25 } 0x3d6d8978e8c1cc79 test expr-28.952 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -7657975756753 E-22 x -1a5006d695fef0_1000000000000000000000000000000000000000000001& E-31 convertToDouble -7657975756753E-22 } 0xbe0a5006d695fef1 test expr-28.953 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +5473834002228 E-20 x 1d632e1f745624_100000000000000000000000000000000000000000001& E-25 convertToDouble +5473834002228E-20 } 0x3e6d632e1f745625 test expr-28.954 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -6842292502785 E-21 x -1d632e1f745624_100000000000000000000000000000000000000000001& E-28 convertToDouble -6842292502785E-21 } 0xbe3d632e1f745625 test expr-28.955 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2109568884597 E25 x -1fbdc386609b13_011111111111111111111111111111111111111110& E123 convertToDouble -2109568884597E25 } 0xc7afbdc386609b13 test expr-28.956 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +8438275538388 E25 x 1fbdc386609b13_011111111111111111111111111111111111111110& E125 convertToDouble +8438275538388E25 } 0x47cfbdc386609b13 test expr-28.957 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -4219137769194 E25 x -1fbdc386609b13_011111111111111111111111111111111111111110& E124 convertToDouble -4219137769194E25 } 0xc7bfbdc386609b13 test expr-28.958 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +3200141789841 E-25 x 1684dcea3829f7_0111111111111111111111111111111111111111110& E-42 convertToDouble +3200141789841E-25 } 0x3d5684dcea3829f7 test expr-28.959 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8655689322607 E-22 x -1dbd9ff5dc8991_011111111111111111111111111111111111111110& E-31 convertToDouble -8655689322607E-22 } 0xbe0dbd9ff5dc8991 test expr-28.960 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6400283579682 E-25 x 1684dcea3829f7_0111111111111111111111111111111111111111110& E-41 convertToDouble +6400283579682E-25 } 0x3d6684dcea3829f7 test expr-28.961 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -8837719634493 E-21 x -12fa9676d2585b_011111111111111111111111111111111111111110& E-27 convertToDouble -8837719634493E-21 } 0xbe42fa9676d2585b test expr-28.962 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +19428217075297 E24 x 1d3b7a1d154aba_10000000000000000000000000000000000000000000001& E123 convertToDouble +19428217075297E24 } 0x47ad3b7a1d154abb test expr-28.963 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -38856434150594 E24 x -1d3b7a1d154aba_10000000000000000000000000000000000000000000001& E124 convertToDouble -38856434150594E24 } 0xc7bd3b7a1d154abb test expr-28.964 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +77712868301188 E24 x 1d3b7a1d154aba_10000000000000000000000000000000000000000000001& E125 convertToDouble +77712868301188E24 } 0x47cd3b7a1d154abb test expr-28.965 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -77192037242133 E27 x -1c5b1ab32d5dbe_1000000000000000000000000000000000000000000000001& E135 convertToDouble -77192037242133E27 } 0xc86c5b1ab32d5dbf test expr-28.966 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +76579757567530 E-23 x 1a5006d695fef0_1000000000000000000000000000000000000000000001& E-31 convertToDouble +76579757567530E-23 } 0x3e0a5006d695fef1 test expr-28.967 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +15315951513506 E-22 x 1a5006d695fef0_1000000000000000000000000000000000000000000001& E-30 convertToDouble +15315951513506E-22 } 0x3e1a5006d695fef1 test expr-28.968 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -38289878783765 E-23 x -1a5006d695fef0_1000000000000000000000000000000000000000000001& E-32 convertToDouble -38289878783765E-23 } 0xbdfa5006d695fef1 test expr-28.969 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +49378033925202 E25 x 1737aa2567167b_0111111111111111111111111111111111111111111110& E128 convertToDouble +49378033925202E25 } 0x47f737aa2567167b test expr-28.970 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -50940527102367 E24 x -132964f2944b05_0111111111111111111111111111111111111111111111110& E125 convertToDouble -50940527102367E24 } 0xc7c32964f2944b05 test expr-28.971 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +98756067850404 E25 x 1737aa2567167b_0111111111111111111111111111111111111111111110& E129 convertToDouble +98756067850404E25 } 0x480737aa2567167b test expr-28.972 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -99589397544892 E26 x -1d4446075c4933_0111111111111111111111111111111111111111111110& E132 convertToDouble -99589397544892E26 } 0xc83d4446075c4933 test expr-28.973 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -56908598265713 E-25 x -190756ab1ed6b3_011111111111111111111111111111111111111111111110& E-38 convertToDouble -56908598265713E-25 } 0xbd990756ab1ed6b3 test expr-28.974 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +97470695699657 E-22 x 14ee821710e655_01111111111111111111111111111111111111111111110& E-27 convertToDouble +97470695699657E-22 } 0x3e44ee821710e655 test expr-28.975 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -35851901247343 E-25 x -1f8921657e1581_0111111111111111111111111111111111111111111110& E-39 convertToDouble -35851901247343E-25 } 0xbd8f8921657e1581 test expr-28.976 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +154384074484266 E27 x 1c5b1ab32d5dbe_1000000000000000000000000000000000000000000000001& E136 convertToDouble +154384074484266E27 } 0x487c5b1ab32d5dbf test expr-28.977 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -308768148968532 E27 x -1c5b1ab32d5dbe_1000000000000000000000000000000000000000000000001& E137 convertToDouble -308768148968532E27 } 0xc88c5b1ab32d5dbf test expr-28.978 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +910990389005985 E23 x 112242592ae54a_100000000000000000000000000000000000000000000001& E126 convertToDouble +910990389005985E23 } 0x47d12242592ae54b test expr-28.979 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +271742424169201 E-27 x 131f46bcf7b452_10000000000000000000000000000000000000000000000001& E-42 convertToDouble +271742424169201E-27 } 0x3d531f46bcf7b453 test expr-28.980 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -543484848338402 E-27 x -131f46bcf7b452_10000000000000000000000000000000000000000000000001& E-41 convertToDouble -543484848338402E-27 } 0xbd631f46bcf7b453 test expr-28.981 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +162192083357563 E-26 x 1c887b68658760_1000000000000000000000000000000000000000000000001& E-40 convertToDouble +162192083357563E-26 } 0x3d7c887b68658761 test expr-28.982 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -869254552770081 E-23 x -12aac70665485e_1000000000000000000000000000000000000000000000000001& E-27 convertToDouble -869254552770081E-23 } 0xbe42aac70665485f test expr-28.983 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +664831007626046 E24 x 1f429cb67eb075_011111111111111111111111111111111111111111111111110& E128 convertToDouble +664831007626046E24 } 0x47ff429cb67eb075 test expr-28.984 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -332415503813023 E24 x -1f429cb67eb075_011111111111111111111111111111111111111111111111110& E127 convertToDouble -332415503813023E24 } 0xc7ef429cb67eb075 test expr-28.985 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +943701829041427 E24 x 162fb2e38ee461_01111111111111111111111111111111111111111111111110& E129 convertToDouble +943701829041427E24 } 0x48062fb2e38ee461 test expr-28.986 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -101881054204734 E24 x -132964f2944b05_0111111111111111111111111111111111111111111111110& E126 convertToDouble -101881054204734E24 } 0xc7d32964f2944b05 test expr-28.987 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +828027839666967 E-27 x 1d2236349da3cd_011111111111111111111111111111111111111111111111110& E-41 convertToDouble +828027839666967E-27 } 0x3d6d2236349da3cd test expr-28.988 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -280276135608777 E-27 x -13b901892fd0bf_0111111111111111111111111111111111111111111111110& E-42 convertToDouble -280276135608777E-27 } 0xbd53b901892fd0bf test expr-28.989 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +212839188833879 E-21 x 1c91194dc2d40b_0111111111111111111111111111111111111111111111110& E-23 convertToDouble +212839188833879E-21 } 0x3e8c91194dc2d40b test expr-28.990 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -113817196531426 E-25 x -190756ab1ed6b3_011111111111111111111111111111111111111111111110& E-37 convertToDouble -113817196531426E-25 } 0xbda90756ab1ed6b3 test expr-28.991 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +9711553197796883 E27 x 1bdeec25c0f03e_10000000000000000000000000000000000000000000000000001& E142 convertToDouble +9711553197796883E27 } 0x48dbdeec25c0f03f test expr-28.992 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2739849386524269 E26 x -19295ade212370_1000000000000000000000000000000000000000000000000001& E137 convertToDouble -2739849386524269E26 } 0xc889295ade212371 test expr-28.993 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +5479698773048538 E26 x 19295ade212370_1000000000000000000000000000000000000000000000000001& E138 convertToDouble +5479698773048538E26 } 0x4899295ade212371 test expr-28.994 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6124568318523113 E-25 x 150b3a2e0aff14_1000000000000000000000000000000000000000000000000000001& E-31 convertToDouble +6124568318523113E-25 } 0x3e050b3a2e0aff15 test expr-28.995 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -1139777988171071 E-24 x -1394cbee428ea4_10000000000000000000000000000000000000000000000000001& E-30 convertToDouble -1139777988171071E-24 } 0xbe1394cbee428ea5 test expr-28.996 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +6322612303128019 E-27 x 1bcea0ec21e250_1000000000000000000000000000000000000000000000000000001& E-38 convertToDouble +6322612303128019E-27 } 0x3d9bcea0ec21e251 test expr-28.997 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2955864564844617 E-25 x -1450030e26c6dc_10000000000000000000000000000000000000000000000000001& E-32 convertToDouble -2955864564844617E-25 } 0xbdf450030e26c6dd test expr-28.998 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -9994029144998961 E25 x -125b2b7fed4a61_0111111111111111111111111111111111111111111111111110& E136 convertToDouble -9994029144998961E25 } 0xc8725b2b7fed4a61 test expr-28.999 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -2971238324022087 E27 x -110dd7a301db67_0111111111111111111111111111111111111111111111111110& E141 convertToDouble -2971238324022087E27 } 0xc8c10dd7a301db67 test expr-28.1000 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -1656055679333934 E-27 x -1d2236349da3cd_011111111111111111111111111111111111111111111111110& E-40 convertToDouble -1656055679333934E-27 } 0xbd7d2236349da3cd test expr-28.1001 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -1445488709150234 E-26 x -1fc960c59526c7_0111111111111111111111111111111111111111111111110& E-37 convertToDouble -1445488709150234E-26 } 0xbdafc960c59526c7 test expr-28.1002 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +55824717499885172 E27 x 1406b0cd17fd56_1000000000000000000000000000000000000000000000000000000001& E145 convertToDouble +55824717499885172E27 } 0x490406b0cd17fd57 test expr-28.1003 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -69780896874856465 E26 x -1406b0cd17fd56_1000000000000000000000000000000000000000000000000000000001& E142 convertToDouble -69780896874856465E26 } 0xc8d406b0cd17fd57 test expr-28.1004 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +84161538867545199 E25 x 13529217bdce6c_10000000000000000000000000000000000000000000000000000000001& E139 convertToDouble +84161538867545199E25 } 0x48a3529217bdce6d test expr-28.1005 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -27912358749942586 E27 x -1406b0cd17fd56_1000000000000000000000000000000000000000000000000000000001& E144 convertToDouble -27912358749942586E27 } 0xc8f406b0cd17fd57 test expr-28.1006 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +24711112462926331 E-25 x 153a07f6040d22_100000000000000000000000000000000000000000000000000000001& E-29 convertToDouble +24711112462926331E-25 } 0x3e253a07f6040d23 test expr-28.1007 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -12645224606256038 E-27 x -1bcea0ec21e250_1000000000000000000000000000000000000000000000000000001& E-37 convertToDouble -12645224606256038E-27 } 0xbdabcea0ec21e251 test expr-28.1008 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -12249136637046226 E-25 x -150b3a2e0aff14_1000000000000000000000000000000000000000000000000000001& E-30 convertToDouble -12249136637046226E-25 } 0xbe150b3a2e0aff15 test expr-28.1009 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +74874448287465757 E27 x 1adc21d1d50b09_01111111111111111111111111111111111111111111111111111110& E145 convertToDouble +74874448287465757E27 } 0x490adc21d1d50b09 test expr-28.1010 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -35642836832753303 E24 x -1a2fac2b421f53_0111111111111111111111111111111111111111111111111111110& E134 convertToDouble -35642836832753303E24 } 0xc85a2fac2b421f53 test expr-28.1011 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -71285673665506606 E24 x -1a2fac2b421f53_0111111111111111111111111111111111111111111111111111110& E135 convertToDouble -71285673665506606E24 } 0xc86a2fac2b421f53 test expr-28.1012 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +43723334984997307 E-26 x 1e0be3f392c549_01111111111111111111111111111111111111111111111111111110& E-32 convertToDouble +43723334984997307E-26 } 0x3dfe0be3f392c549 test expr-28.1013 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN +10182419849537963 E-24 x 15ddd831ebbe53_011111111111111111111111111111111111111111111111111110& E-27 convertToDouble +10182419849537963E-24 } 0x3e45ddd831ebbe53 test expr-28.1014 {input floating-point conversion} {ieeeFloatingPoint} { # Ad2b dieee UN -93501703572661982 E-26 x -10103f97ea6e13_0111111111111111111111111111111111111111111111111110& E-30 convertToDouble -93501703572661982E-26 } 0xbe10103f97ea6e13 test expr-29.1 {smallest representible number} {ieeeFloatingPoint} { list [catch {convertToDouble 4.9406564584124654e-324} result] \ $result \ [catch {convertToDouble 2.4703282292062327e-324} result] \ $result \ [catch {convertToDouble 2.47032822920623e-324} result] \ $result } {0 0x0000000000000001 0 0x0000000000000001 0 0x0000000000000000} test expr-29.2 {smallest representible number} {ieeeFloatingPoint} { list [catch {convertToDouble -4.9406564584124654e-324} result] \ $result \ [catch {convertToDouble -2.4703282292062327e-324} result] \ $result \ [catch {convertToDouble -2.47032822920623e-324} result] \ $result } {0 0x8000000000000001 0 0x8000000000000001 0 0x8000000000000000} test expr-29.3 {silent underflow on input conversion} {ieeeFloatingPoint} { set v ? list [scan 2.47032822920623e-324 %g v] $v } {1 0.0} test expr-29.4 {silent underflow on input conversion} {ieeeFloatingPoint} { set v ? list [scan -2.47032822920623e-324 %g v] $v } {1 -0.0} test expr-30.1 {largest representible number} {ieeeFloatingPoint} { list [catch {convertToDouble 1.7976931348623155e+308} result] \ $result \ [catch {convertToDouble 1.7976931348623157e+308} result] \ $result \ [catch {convertToDouble 1.7976931348623159e+308} result] \ $result } {0 0x7feffffffffffffe 0 0x7fefffffffffffff 0 0x7ff0000000000000} test expr-30.2 {largest representible number} {ieeeFloatingPoint} { list [catch {convertToDouble -1.7976931348623155e+308} result] \ $result \ [catch {convertToDouble -1.7976931348623157e+308} result] \ $result \ [catch {convertToDouble -1.7976931348623159e+308} result] \ $result } {0 0xffeffffffffffffe 0 0xffefffffffffffff 0 0xfff0000000000000} test expr-30.3 {silent overflow on input conversion} {ieeeFloatingPoint} { set v ? list [scan 1.7976931348623159e+308 %f v] $v } {1 Inf} test expr-30.4 {silent overflow on input conversion} {ieeeFloatingPoint} { set v ? list [scan -1.7976931348623159e+308 %f v] $v } {1 -Inf} # bool() tests (TIP #182) set i 0 foreach s {yes true on} { test expr-31.$i.0 {boolean conversion} {expr bool($s)} 1 test expr-31.$i.1 {boolean conversion} {expr bool(!$s)} 0 test expr-31.$i.2 {boolean conversion} {expr bool("$s")} 1 test expr-31.$i.3 {boolean conversion} {expr bool(!"$s")} 0 set j 1 while {$j < [string length $s]-1} { test expr-31.$i.4.$j {boolean conversion} { expr bool([string range $s 0 $j]) } 1 test expr-31.$i.5.$j {boolean conversion} { expr bool("[string range $s 0 $j]") } 1 incr j } incr i } test expr-31.0.4.0 {boolean conversion} {expr bool(y)} 1 test expr-31.0.5.0 {boolean conversion} {expr bool("y")} 1 test expr-31.1.4.0 {boolean conversion} {expr bool(t)} 1 test expr-31.1.5.0 {boolean conversion} {expr bool("t")} 1 test expr-31.2.4.0 {boolean conversion} -body { expr bool(o) } -returnCodes error -match glob -result * test expr-31.2.5.0 {boolean conversion} -body { expr bool("o") } -returnCodes error -match glob -result * foreach s {no false off} { test expr-31.$i.0 {boolean conversion} {expr bool($s)} 0 test expr-31.$i.1 {boolean conversion} {expr bool(!$s)} 1 test expr-31.$i.2 {boolean conversion} {expr bool("$s")} 0 test expr-31.$i.3 {boolean conversion} {expr bool(!"$s")} 1 set j 1 while {$j < [string length $s]-1} { test expr-31.$i.4.$j {boolean conversion} { expr bool([string range $s 0 $j]) } 0 test expr-31.$i.5.$j {boolean conversion} { expr bool("[string range $s 0 $j]") } 0 incr j } incr i } test expr-31.3.4.0 {boolean conversion} {expr bool(n)} 0 test expr-31.3.5.0 {boolean conversion} {expr bool("n")} 0 test expr-31.4.4.0 {boolean conversion} {expr bool(f)} 0 test expr-31.4.5.0 {boolean conversion} {expr bool("f")} 0 test expr-31.6 {boolean conversion} {expr bool(-1 + 1)} 0 test expr-31.7 {boolean conversion} {expr bool(0 + 1)} 1 test expr-31.8 {boolean conversion} {expr bool(0.0)} 0 test expr-31.9 {boolean conversion} {expr bool(0x0)} 0 test expr-31.10 {boolean conversion} {expr bool(wide(0))} 0 test expr-31.11 {boolean conversion} {expr bool(5.0)} 1 test expr-31.12 {boolean conversion} {expr bool(5)} 1 test expr-31.13 {boolean conversion} {expr bool(0x5)} 1 test expr-31.14 {boolean conversion} {expr bool(wide(5))} 1 test expr-31.15 {boolean conversion} -body { expr bool("fred") } -returnCodes error -match glob -result * test expr-32.1 {expr mod basics} { set mod_nums [list \ {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \ {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \ {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \ {-2 -1} {-2 -2} {-2 -3} {-2 -4} {-2 -5} \ {-1 1} {-1 2} {-1 3} {-1 4} {-1 5} \ {-1 -1} {-1 -2} {-1 -3} {-1 -4} {-1 -5} \ {0 -100} {0 -1} {0 1} {0 100} \ {1 1} {1 2} {1 3} {1 4} {1 5} \ {1 -1} {1 -2} {1 -3} {1 -4} {1 -5} \ {2 1} {2 2} {2 3} {2 4} {2 5} \ {2 -1} {2 -2} {2 -3} {2 -4} {2 -5} \ {3 1} {3 2} {3 3} {3 4} {3 5} \ {3 -1} {3 -2} {3 -3} {3 -4} {3 -5} \ ] set results [list] foreach pair $mod_nums { set dividend [lindex $pair 0] set divisor [lindex $pair 1] lappend results [expr {$dividend % $divisor}] } set results } [list \ 0 1 0 1 2 \ 0 -1 0 -3 -3 \ 0 0 1 2 3 \ 0 0 -2 -2 -2 \ 0 1 2 3 4 \ 0 -1 -1 -1 -1 \ 0 0 0 0 \ 0 1 1 1 1 \ 0 -1 -2 -3 -4 \ 0 0 2 2 2 \ 0 0 -1 -2 -3 \ 0 1 0 3 3 \ 0 -1 0 -1 -2 \ ] test expr-32.2 {expr div basics} { set mod_nums [list \ {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \ {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \ {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \ {-2 -1} {-2 -2} {-2 -3} {-2 -4} {-2 -5} \ {-1 1} {-1 2} {-1 3} {-1 4} {-1 5} \ {-1 -1} {-1 -2} {-1 -3} {-1 -4} {-1 -5} \ {0 -100} {0 -1} {0 1} {0 100} \ {1 1} {1 2} {1 3} {1 4} {1 5} \ {1 -1} {1 -2} {1 -3} {1 -4} {1 -5} \ {2 1} {2 2} {2 3} {2 4} {2 5} \ {2 -1} {2 -2} {2 -3} {2 -4} {2 -5} \ {3 1} {3 2} {3 3} {3 4} {3 5} \ {3 -1} {3 -2} {3 -3} {3 -4} {3 -5} \ ] set results [list] foreach pair $mod_nums { set dividend [lindex $pair 0] set divisor [lindex $pair 1] lappend results [expr {$dividend / $divisor}] } set results } [list \ -3 -2 -1 -1 -1 \ 3 1 1 0 0 \ -2 -1 -1 -1 -1 \ 2 1 0 0 0 \ -1 -1 -1 -1 -1 \ 1 0 0 0 0 \ 0 0 0 0 \ 1 0 0 0 0 \ -1 -1 -1 -1 -1 \ 2 1 0 0 0 \ -2 -1 -1 -1 -1 \ 3 1 1 0 0 \ -3 -2 -1 -1 -1 \ ] test expr-32.3 {Bug 1585704} { expr 1%(1<<63) } 1 test expr-32.4 {Bug 1585704} { expr -1%(1<<63) } [expr (1<<63)-1] test expr-32.5 {Bug 1585704} { expr (1<<32)%(1<<63) } [expr 1<<32] test expr-32.6 {Bug 1585704} { expr -(1<<32)%(1<<63) } [expr (1<<63)-(1<<32)] test expr-32.7 {bignum regression} { expr {0%(1<<63)} } 0 test expr-32.8 {bignum regression} { expr {0%-(1<<63)} } 0 test expr-32.9 {bignum regression} { expr {0%-(1+(1<<63))} } 0 test expr-33.1 {parse largest long value} longIs32bit { set max_long_str 2147483647 set max_long_hex "0x7FFFFFFF " # Convert to integer (long, not wide) internal rep set max_long 2147483647 string is integer $max_long list \ [expr {" $max_long_str "}] \ [expr {$max_long_str + 0}] \ [expr {$max_long + 0}] \ [expr {2147483647 + 0}] \ [expr {$max_long == $max_long_hex}] \ [expr {int(2147483647 + 1) < 0}] \ } {2147483647 2147483647 2147483647 2147483647 1 1} test expr-33.2 {parse smallest long value} longIs32bit { set min_long_str -2147483648 set min_long_hex "-0x80000000 " set min_long -2147483648 # This will convert to integer (not wide) internal rep string is integer $min_long # Note: If the final expression returns 0 then the # expression literal is being promoted to a wide type # when it should be parsed as a long type. list \ [expr {" $min_long_str "}] \ [expr {$min_long_str + 0}] \ [expr {$min_long + 0}] \ [expr {-2147483648 + 0}] \ [expr {$min_long == $min_long_hex}] \ [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \ } {-2147483648 -2147483648 -2147483648 -2147483648 1 1} test expr-33.3 {parse largest wide value} wideIs64bit { set max_wide_str 9223372036854775807 set max_wide_hex "0x7FFFFFFFFFFFFFFF " # Convert to wide integer set max_wide 9223372036854775807 string is integer $max_wide list \ [expr {" $max_wide_str "}] \ [expr {$max_wide_str + 0}] \ [expr {$max_wide + 0}] \ [expr {9223372036854775807 + 0}] \ [expr {$max_wide == $max_wide_hex}] \ [expr {wide(9223372036854775807 + 1) < 0}] \ } {9223372036854775807 9223372036854775807 9223372036854775807 9223372036854775807 1 1} test expr-33.4 {parse smallest wide value} wideIs64bit { set min_wide_str -9223372036854775808 set min_wide_hex "-0x8000000000000000 " set min_wide -9223372036854775808 # Convert to wide integer string is integer $min_wide # Note: If the final expression returns 0 then the # wide integer is not being parsed correctly with # the leading - sign. list \ [expr {" $min_wide_str "}] \ [expr {$min_wide_str + 0}] \ [expr {$min_wide + 0}] \ [expr {-9223372036854775808 + 0}] \ [expr {$min_wide == $min_wide_hex}] \ [expr {wide(-9223372036854775808 - 1) == 0x7FFFFFFFFFFFFFFF}] \ } {-9223372036854775808 -9223372036854775808 -9223372036854775808 -9223372036854775808 1 1} set min -2147483648 set max 2147483647 test expr-34.1 {expr edge cases} { expr {$min / $min} } {1} test expr-34.2 {expr edge cases} { expr {$min % $min} } {0} test expr-34.3 {expr edge cases} { expr {$min / ($min + 1)} } {1} test expr-34.4 {expr edge cases} { expr {$min % ($min + 1)} } {-1} test expr-34.5 {expr edge cases} { expr {$min / ($min + 2)} } {1} test expr-34.6 {expr edge cases} { expr {$min % ($min + 2)} } {-2} test expr-34.7 {expr edge cases} { expr {$min / ($min + 3)} } {1} test expr-34.8 {expr edge cases} { expr {$min % ($min + 3)} } {-3} test expr-34.9 {expr edge cases} { expr {$min / -3} } {715827882} test expr-34.10 {expr edge cases} { expr {$min % -3} } {-2} test expr-34.11 {expr edge cases} { expr {$min / -2} } {1073741824} test expr-34.12 {expr edge cases} { expr {$min % -2} } {0} test expr-34.13 {expr edge cases} longIs32bit { expr {int($min / -1)} } {-2147483648} test expr-34.14 {expr edge cases} { expr {$min % -1} } {0} test expr-34.15 {expr edge cases} longIs32bit { expr {int($min * -1)} } $min test expr-34.16 {expr edge cases} longIs32bit { expr {int(-$min)} } $min test expr-34.17 {expr edge cases} { expr {$min / 1} } $min test expr-34.18 {expr edge cases} { expr {$min % 1} } {0} test expr-34.19 {expr edge cases} { expr {$min / 2} } {-1073741824} test expr-34.20 {expr edge cases} { expr {$min % 2} } {0} test expr-34.21 {expr edge cases} { expr {$min / 3} } {-715827883} test expr-34.22 {expr edge cases} { expr {$min % 3} } {1} test expr-34.23 {expr edge cases} { expr {$min / ($max - 3)} } {-2} test expr-34.24 {expr edge cases} { expr {$min % ($max - 3)} } {2147483640} test expr-34.25 {expr edge cases} { expr {$min / ($max - 2)} } {-2} test expr-34.26 {expr edge cases} { expr {$min % ($max - 2)} } {2147483642} test expr-34.27 {expr edge cases} { expr {$min / ($max - 1)} } {-2} test expr-34.28 {expr edge cases} { expr {$min % ($max - 1)} } {2147483644} test expr-34.29 {expr edge cases} { expr {$min / $max} } {-2} test expr-34.30 {expr edge cases} { expr {$min % $max} } {2147483646} test expr-34.31 {expr edge cases} { expr {$max / $max} } {1} test expr-34.32 {expr edge cases} { expr {$max % $max} } {0} test expr-34.33 {expr edge cases} { expr {$max / ($max - 1)} } {1} test expr-34.34 {expr edge cases} { expr {$max % ($max - 1)} } {1} test expr-34.35 {expr edge cases} { expr {$max / ($max - 2)} } {1} test expr-34.36 {expr edge cases} { expr {$max % ($max - 2)} } {2} test expr-34.37 {expr edge cases} { expr {$max / ($max - 3)} } {1} test expr-34.38 {expr edge cases} { expr {$max % ($max - 3)} } {3} test expr-34.39 {expr edge cases} { expr {$max / 3} } {715827882} test expr-34.40 {expr edge cases} { expr {$max % 3} } {1} test expr-34.41 {expr edge cases} { expr {$max / 2} } {1073741823} test expr-34.42 {expr edge cases} { expr {$max % 2} } {1} test expr-34.43 {expr edge cases} { expr {$max / 1} } $max test expr-34.44 {expr edge cases} { expr {$max % 1} } {0} test expr-34.45 {expr edge cases} { expr {$max / -1} } "-$max" test expr-34.46 {expr edge cases} { expr {$max % -1} } {0} test expr-34.47 {expr edge cases} { expr {$max / -2} } {-1073741824} test expr-34.48 {expr edge cases} { expr {$max % -2} } {-1} test expr-34.49 {expr edge cases} { expr {$max / -3} } {-715827883} test expr-34.50 {expr edge cases} { expr {$max % -3} } {-2} test expr-34.51 {expr edge cases} { expr {$max / ($min + 3)} } {-2} test expr-34.52 {expr edge cases} { expr {$max % ($min + 3)} } {-2147483643} test expr-34.53 {expr edge cases} { expr {$max / ($min + 2)} } {-2} test expr-34.54 {expr edge cases} { expr {$max % ($min + 2)} } {-2147483645} test expr-34.55 {expr edge cases} { expr {$max / ($min + 1)} } {-1} test expr-34.56 {expr edge cases} { expr {$max % ($min + 1)} } {0} test expr-34.57 {expr edge cases} { expr {$max / $min} } {-1} test expr-34.58 {expr edge cases} { expr {$max % $min} } {-1} test expr-34.59 {expr edge cases} { expr {($min + 1) / ($max - 1)} } {-2} test expr-34.60 {expr edge cases} { expr {($min + 1) % ($max - 1)} } {2147483645} test expr-34.61 {expr edge cases} { expr {($max - 1) / ($min + 1)} } {-1} test expr-34.62 {expr edge cases} { expr {($max - 1) % ($min + 1)} } {-1} test expr-34.63 {expr edge cases} { expr {($max - 1) / $min} } {-1} test expr-34.64 {expr edge cases} { expr {($max - 1) % $min} } {-2} test expr-34.65 {expr edge cases} { expr {($max - 2) / $min} } {-1} test expr-34.66 {expr edge cases} { expr {($max - 2) % $min} } {-3} test expr-34.67 {expr edge cases} { expr {($max - 3) / $min} } {-1} test expr-34.68 {expr edge cases} { expr {($max - 3) % $min} } {-4} test expr-34.69 {expr edge cases} { expr {-3 / $min} } {0} test expr-34.70 {expr edge cases} { expr {-3 % $min} } {-3} test expr-34.71 {expr edge cases} { expr {-2 / $min} } {0} test expr-34.72 {expr edge cases} { expr {-2 % $min} } {-2} test expr-34.73 {expr edge cases} { expr {-1 / $min} } {0} test expr-34.74 {expr edge cases} { expr {-1 % $min} } {-1} test expr-34.75 {expr edge cases} { expr {0 / $min} } {0} test expr-34.76 {expr edge cases} { expr {0 % $min} } {0} test expr-34.77 {expr edge cases} { expr {0 / ($min + 1)} } {0} test expr-34.78 {expr edge cases} { expr {0 % ($min + 1)} } {0} test expr-34.79 {expr edge cases} { expr {1 / $min} } {-1} test expr-34.80 {expr edge cases} { expr {1 % $min} } {-2147483647} test expr-34.81 {expr edge cases} { expr {1 / ($min + 1)} } {-1} test expr-34.82 {expr edge cases} { expr {1 % ($min + 1)} } {-2147483646} test expr-34.83 {expr edge cases} { expr {2 / $min} } {-1} test expr-34.84 {expr edge cases} { expr {2 % $min} } {-2147483646} test expr-34.85 {expr edge cases} { expr {2 / ($min + 1)} } {-1} test expr-34.86 {expr edge cases} { expr {2 % ($min + 1)} } {-2147483645} test expr-34.87 {expr edge cases} { expr {3 / $min} } {-1} test expr-34.88 {expr edge cases} { expr {3 % $min} } {-2147483645} test expr-34.89 {expr edge cases} { expr {3 / ($min + 1)} } {-1} test expr-34.90 {expr edge cases} { expr {3 % ($min + 1)} } {-2147483644} # Euclidean property: # quotient * divisor + remainder = dividend test expr-35.1 {expr edge cases} { set dividend $max set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($divisor * $q) + $r}] } {1073741823 * 2 + 1 = 2147483647} test expr-35.2 {expr edge cases} { set dividend [expr {$max - 1}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1073741823 * 2 + 0 = 2147483646} test expr-35.3 {expr edge cases} { set dividend [expr {$max - 2}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1073741822 * 2 + 1 = 2147483645} test expr-35.4 {expr edge cases} { set dividend $max set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {715827882 * 3 + 1 = 2147483647} test expr-35.5 {expr edge cases} { set dividend [expr {$max - 1}] set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {715827882 * 3 + 0 = 2147483646} test expr-35.6 {expr edge cases} { set dividend [expr {$max - 2}] set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {715827881 * 3 + 2 = 2147483645} test expr-35.7 {expr edge cases} { set dividend $min set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-1073741824 * 2 + 0 = -2147483648} test expr-35.8 {expr edge cases} { set dividend [expr {$min + 1}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-1073741824 * 2 + 1 = -2147483647} test expr-35.9 {expr edge cases} { set dividend [expr {$min + 2}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-1073741823 * 2 + 0 = -2147483646} test expr-35.10 {expr edge cases} { # Two things could happen here. The multiplication # could overflow a 32 bit type, so that when # 1 is added it overflows again back to min. # The multiplication could also use a wide type # to hold ($min - 1) until 1 is added and # the number becomes $min again. set dividend $min set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-715827883 * 3 + 1 = -2147483648} test expr-35.11 {expr edge cases} { set dividend $min set divisor -3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {715827882 * -3 + -2 = -2147483648} test expr-35.12 {expr edge cases} { set dividend $min set divisor $min set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -2147483648 + 0 = -2147483648} test expr-35.13 {expr edge cases} { set dividend $min set divisor [expr {$min + 1}] set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -2147483647 + -1 = -2147483648} test expr-35.14 {expr edge cases} { set dividend $min set divisor [expr {$min + 2}] set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -2147483646 + -2 = -2147483648} # 64bit wide integer checks set min -9223372036854775808 set max 9223372036854775807 test expr-36.1 {expr edge cases} {wideIs64bit} { expr {$min / $min} } {1} test expr-36.2 {expr edge cases} {wideIs64bit} { expr {$min % $min} } {0} test expr-36.3 {expr edge cases} {wideIs64bit} { expr {$min / ($min + 1)} } {1} test expr-36.4 {expr edge cases} {wideIs64bit} { expr {$min % ($min + 1)} } {-1} test expr-36.5 {expr edge cases} {wideIs64bit} { expr {$min / ($min + 2)} } {1} test expr-36.6 {expr edge cases} {wideIs64bit} { expr {$min % ($min + 2)} } {-2} test expr-36.7 {expr edge cases} {wideIs64bit} { expr {$min / ($min + 3)} } {1} test expr-36.8 {expr edge cases} {wideIs64bit} { expr {$min % ($min + 3)} } {-3} test expr-36.9 {expr edge cases} {wideIs64bit} { expr {$min / -3} } {3074457345618258602} test expr-36.10 {expr edge cases} {wideIs64bit} { expr {$min % -3} } {-2} test expr-36.11 {expr edge cases} {wideIs64bit} { expr {$min / -2} } {4611686018427387904} test expr-36.12 {expr edge cases} {wideIs64bit} { expr {$min % -2} } {0} test expr-36.13 {expr edge cases} wideIs64bit { expr {wide($min / -1)} } $min test expr-36.14 {expr edge cases} {wideIs64bit} { expr {$min % -1} } {0} test expr-36.15 {expr edge cases} wideIs64bit { expr {wide($min * -1)} } $min test expr-36.16 {expr edge cases} wideIs64bit { expr {wide(-$min)} } $min test expr-36.17 {expr edge cases} {wideIs64bit} { expr {$min / 1} } $min test expr-36.18 {expr edge cases} {wideIs64bit} { expr {$min % 1} } {0} test expr-36.19 {expr edge cases} {wideIs64bit} { expr {$min / 2} } {-4611686018427387904} test expr-36.20 {expr edge cases} {wideIs64bit} { expr {$min % 2} } {0} test expr-36.21 {expr edge cases} {wideIs64bit} { expr {$min / 3} } {-3074457345618258603} test expr-36.22 {expr edge cases} {wideIs64bit} { expr {$min % 3} } {1} test expr-36.23 {expr edge cases} {wideIs64bit} { expr {$min / ($max - 3)} } {-2} test expr-36.24 {expr edge cases} {wideIs64bit} { expr {$min % ($max - 3)} } {9223372036854775800} test expr-36.25 {expr edge cases} {wideIs64bit} { expr {$min / ($max - 2)} } {-2} test expr-36.26 {expr edge cases} {wideIs64bit} { expr {$min % ($max - 2)} } {9223372036854775802} test expr-36.27 {expr edge cases} {wideIs64bit} { expr {$min / ($max - 1)} } {-2} test expr-36.28 {expr edge cases} {wideIs64bit} { expr {$min % ($max - 1)} } {9223372036854775804} test expr-36.29 {expr edge cases} {wideIs64bit} { expr {$min / $max} } {-2} test expr-36.30 {expr edge cases} {wideIs64bit} { expr {$min % $max} } {9223372036854775806} test expr-36.31 {expr edge cases} {wideIs64bit} { expr {$max / $max} } {1} test expr-36.32 {expr edge cases} {wideIs64bit} { expr {$max % $max} } {0} test expr-36.33 {expr edge cases} {wideIs64bit} { expr {$max / ($max - 1)} } {1} test expr-36.34 {expr edge cases} {wideIs64bit} { expr {$max % ($max - 1)} } {1} test expr-36.35 {expr edge cases} {wideIs64bit} { expr {$max / ($max - 2)} } {1} test expr-36.36 {expr edge cases} {wideIs64bit} { expr {$max % ($max - 2)} } {2} test expr-36.37 {expr edge cases} {wideIs64bit} { expr {$max / ($max - 3)} } {1} test expr-36.38 {expr edge cases} {wideIs64bit} { expr {$max % ($max - 3)} } {3} test expr-36.39 {expr edge cases} {wideIs64bit} { expr {$max / 3} } {3074457345618258602} test expr-36.40 {expr edge cases} {wideIs64bit} { expr {$max % 3} } {1} test expr-36.41 {expr edge cases} {wideIs64bit} { expr {$max / 2} } {4611686018427387903} test expr-36.42 {expr edge cases} {wideIs64bit} { expr {$max % 2} } {1} test expr-36.43 {expr edge cases} {wideIs64bit} { expr {$max / 1} } $max test expr-36.44 {expr edge cases} {wideIs64bit} { expr {$max % 1} } {0} test expr-36.45 {expr edge cases} {wideIs64bit} { expr {$max / -1} } "-$max" test expr-36.46 {expr edge cases} {wideIs64bit} { expr {$max % -1} } {0} test expr-36.47 {expr edge cases} {wideIs64bit} { expr {$max / -2} } {-4611686018427387904} test expr-36.48 {expr edge cases} {wideIs64bit} { expr {$max % -2} } {-1} test expr-36.49 {expr edge cases} {wideIs64bit} { expr {$max / -3} } {-3074457345618258603} test expr-36.50 {expr edge cases} {wideIs64bit} { expr {$max % -3} } {-2} test expr-36.51 {expr edge cases} {wideIs64bit} { expr {$max / ($min + 3)} } {-2} test expr-36.52 {expr edge cases} {wideIs64bit} { expr {$max % ($min + 3)} } {-9223372036854775803} test expr-36.53 {expr edge cases} {wideIs64bit} { expr {$max / ($min + 2)} } {-2} test expr-36.54 {expr edge cases} {wideIs64bit} { expr {$max % ($min + 2)} } {-9223372036854775805} test expr-36.55 {expr edge cases} {wideIs64bit} { expr {$max / ($min + 1)} } {-1} test expr-36.56 {expr edge cases} {wideIs64bit} { expr {$max % ($min + 1)} } {0} test expr-36.57 {expr edge cases} {wideIs64bit} { expr {$max / $min} } {-1} test expr-36.58 {expr edge cases} {wideIs64bit} { expr {$max % $min} } {-1} test expr-36.59 {expr edge cases} {wideIs64bit} { expr {($min + 1) / ($max - 1)} } {-2} test expr-36.60 {expr edge cases} {wideIs64bit} { expr {($min + 1) % ($max - 1)} } {9223372036854775805} test expr-36.61 {expr edge cases} {wideIs64bit} { expr {($max - 1) / ($min + 1)} } {-1} test expr-36.62 {expr edge cases} {wideIs64bit} { expr {($max - 1) % ($min + 1)} } {-1} test expr-36.63 {expr edge cases} {wideIs64bit} { expr {($max - 1) / $min} } {-1} test expr-36.64 {expr edge cases} {wideIs64bit} { expr {($max - 1) % $min} } {-2} test expr-36.65 {expr edge cases} {wideIs64bit} { expr {($max - 2) / $min} } {-1} test expr-36.66 {expr edge cases} {wideIs64bit} { expr {($max - 2) % $min} } {-3} test expr-36.67 {expr edge cases} {wideIs64bit} { expr {($max - 3) / $min} } {-1} test expr-36.68 {expr edge cases} {wideIs64bit} { expr {($max - 3) % $min} } {-4} test expr-36.69 {expr edge cases} {wideIs64bit} { expr {-3 / $min} } {0} test expr-36.70 {expr edge cases} {wideIs64bit} { expr {-3 % $min} } {-3} test expr-36.71 {expr edge cases} {wideIs64bit} { expr {-2 / $min} } {0} test expr-36.72 {expr edge cases} {wideIs64bit} { expr {-2 % $min} } {-2} test expr-36.73 {expr edge cases} {wideIs64bit} { expr {-1 / $min} } {0} test expr-36.74 {expr edge cases} {wideIs64bit} { expr {-1 % $min} } {-1} test expr-36.75 {expr edge cases} {wideIs64bit} { expr {0 / $min} } {0} test expr-36.76 {expr edge cases} {wideIs64bit} { expr {0 % $min} } {0} test expr-36.77 {expr edge cases} {wideIs64bit} { expr {0 / ($min + 1)} } {0} test expr-36.78 {expr edge cases} {wideIs64bit} { expr {0 % ($min + 1)} } {0} test expr-36.79 {expr edge cases} {wideIs64bit} { expr {1 / $min} } {-1} test expr-36.80 {expr edge cases} {wideIs64bit} { expr {1 % $min} } {-9223372036854775807} test expr-36.81 {expr edge cases} {wideIs64bit} { expr {1 / ($min + 1)} } {-1} test expr-36.82 {expr edge cases} {wideIs64bit} { expr {1 % ($min + 1)} } {-9223372036854775806} test expr-36.83 {expr edge cases} {wideIs64bit} { expr {2 / $min} } {-1} test expr-36.84 {expr edge cases} {wideIs64bit} { expr {2 % $min} } {-9223372036854775806} test expr-36.85 {expr edge cases} {wideIs64bit} { expr {2 / ($min + 1)} } {-1} test expr-36.86 {expr edge cases} {wideIs64bit} { expr {2 % ($min + 1)} } {-9223372036854775805} test expr-36.87 {expr edge cases} {wideIs64bit} { expr {3 / $min} } {-1} test expr-36.88 {expr edge cases} {wideIs64bit} { expr {3 % $min} } {-9223372036854775805} test expr-36.89 {expr edge cases} {wideIs64bit} { expr {3 / ($min + 1)} } {-1} test expr-36.90 {expr edge cases} {wideIs64bit} { expr {3 % ($min + 1)} } {-9223372036854775804} test expr-37.1 {expr edge cases} {wideIs64bit} { set dividend $max set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($divisor * $q) + $r}] } {4611686018427387903 * 2 + 1 = 9223372036854775807} test expr-37.2 {expr edge cases} {wideIs64bit} { set dividend [expr {$max - 1}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {4611686018427387903 * 2 + 0 = 9223372036854775806} test expr-37.3 {expr edge cases} {wideIs64bit} { set dividend [expr {$max - 2}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {4611686018427387902 * 2 + 1 = 9223372036854775805} test expr-37.4 {expr edge cases} {wideIs64bit} { set dividend $max set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * 3 + 1 = 9223372036854775807} test expr-37.5 {expr edge cases} {wideIs64bit} { set dividend [expr {$max - 1}] set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * 3 + 0 = 9223372036854775806} test expr-37.6 {expr edge cases} {wideIs64bit} { set dividend [expr {$max - 2}] set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258601 * 3 + 2 = 9223372036854775805} test expr-37.7 {expr edge cases} {wideIs64bit} { set dividend $min set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387904 * 2 + 0 = -9223372036854775808} test expr-37.8 {expr edge cases} {wideIs64bit} { set dividend [expr {$min + 1}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387904 * 2 + 1 = -9223372036854775807} test expr-37.9 {expr edge cases} {wideIs64bit} { set dividend [expr {$min + 2}] set divisor 2 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-4611686018427387903 * 2 + 0 = -9223372036854775806} test expr-37.10 {expr edge cases} {wideIs64bit} { # Multiplication overflows 64 bit type here, # so when the 1 is added it overflows # again and we end up back at min. set dividend $min set divisor 3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {-3074457345618258603 * 3 + 1 = -9223372036854775808} test expr-37.11 {expr edge cases} {wideIs64bit} { set dividend $min set divisor -3 set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {3074457345618258602 * -3 + -2 = -9223372036854775808} test expr-37.12 {expr edge cases} {wideIs64bit} { set dividend $min set divisor $min set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775808 + 0 = -9223372036854775808} test expr-37.13 {expr edge cases} {wideIs64bit} { set dividend $min set divisor [expr {$min + 1}] set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775807 + -1 = -9223372036854775808} test expr-37.14 {expr edge cases} {wideIs64bit} { set dividend $min set divisor [expr {$min + 2}] set q [expr {$dividend / $divisor}] set r [expr {$dividend % $divisor}] list $q * $divisor + $r = [expr {($q * $divisor) + $r}] } {1 * -9223372036854775806 + -2 = -9223372036854775808} test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} { expr {abs(-2147483648)} } 2147483648 test expr-38.2 {abs and -0 [Bug 1893815]} { expr {abs(-0)} } 0 test expr-38.3 {abs and -0 [Bug 1893815]} { expr {abs(-0.0)} } 0.0 test expr-38.4 {abs and -0 [Bug 1893815]} { expr {abs(-1e-324)} } 0.0 test expr-38.5 {abs and -0 [Bug 1893815]} { ::tcl::mathfunc::abs -0 } 0 test expr-38.6 {abs and -0 [Bug 1893815]} { ::tcl::mathfunc::abs -0.0 } 0.0 test expr-38.7 {abs and -0 [Bug 1893815]} { ::tcl::mathfunc::abs -1e-324 } 0.0 test expr-38.8 {abs and 0.0 [Bug 2954959]} { ::tcl::mathfunc::abs 0.0 } 0.0 test expr-38.9 {abs and 0.0 [Bug 2954959]} { expr {abs(0.0)} } 0.0 test expr-38.10 {abs and -0x0 [Bug 2954959]} { expr {abs(-0x0)} } 0 test expr-38.11 {abs and 0x0 [Bug 2954959]} { ::tcl::mathfunc::abs { 0x0} } { 0x0} test expr-38.12 {abs and -0x0 [Bug 2954959]} { ::tcl::mathfunc::abs { -0x0} } 0 test expr-38.13 {abs and 0.0 [Bug 2954959]} { ::tcl::mathfunc::abs 1e-324 } 1e-324 test expr-38.14 {abs and INT64_MIN special-case} { ::tcl::mathfunc::abs -9223372036854775808 } 9223372036854775808 test expr-38.15 {abs and INT128_MIN special-case} { ::tcl::mathfunc::abs -170141183460469231731687303715884105728 } 170141183460469231731687303715884105728 testConstraint testexprlongobj [llength [info commands testexprlongobj]] testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]] test expr-39.1 {Check that Tcl_ExprLongObj doesn't modify interpreter result if no error} testexprlongobj { testexprlongobj 4+1 } {This is a result: 5} #Check for [Bug 1109484] test expr-39.2 {Tcl_ExprLongObj handles wide ints gracefully} testexprlongobj { testexprlongobj wide(1)+2 } {This is a result: 3} test expr-39.3 {Tcl_ExprLongObj on the empty string} \ -constraints {testexprlongobj}\ -body {testexprlongobj ""} \ -match glob \ -returnCodes error -result * test expr-39.4 {Tcl_ExprLongObj coerces doubles} testexprlongobj { testexprlongobj 3+.14159 } {This is a result: 3} test expr-39.5 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} { testexprlongobj 0x80000000 } {This is a result: -2147483648} test expr-39.6 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} { testexprlongobj 0xffffffff } {This is a result: -1} test expr-39.7 {Tcl_ExprLongObj handles overflows} \ -constraints {testexprlongobj longIs32bit} \ -match glob \ -body { list [catch {testexprlongobj 0x100000000} result] $result } \ -result {1 {integer value too large to represent*}} test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj { testexprlongobj -0x80000000 } {This is a result: -2147483648} test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} { testexprlongobj -0xffffffff } {This is a result: 1} test expr-39.10 {Tcl_ExprLongObj handles overflows} \ -constraints {testexprlongobj longIs32bit} \ -match glob \ -body { list [catch {testexprlongobj -0x100000000} result] $result } \ -result {1 {integer value too large to represent*}} test expr-39.11 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} { testexprlongobj 2147483648. } {This is a result: -2147483648} test expr-39.12 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} { testexprlongobj 4294967295. } {This is a result: -1} test expr-39.13 {Tcl_ExprLongObj handles overflows} \ -constraints {testexprlongobj longIs32bit} \ -match glob \ -body { list [catch {testexprlongobj 4294967296.} result] $result } \ -result {1 {integer value too large to represent*}} test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj { testexprlongobj -2147483648. } {This is a result: -2147483648} test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} { testexprlongobj -4294967295. } {This is a result: 1} test expr-39.16 {Tcl_ExprLongObj handles overflows} \ -constraints {testexprlongobj longIs32bit} \ -match glob \ -body { list [catch {testexprlongobj 4294967296.} result] $result } \ -result {1 {integer value too large to represent*}} test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj { testexprdoubleobj 4.+1. } {This is a result: 5.0} #Check for [Bug 1109484] test expr-39.18 {Tcl_ExprDoubleObj on the empty string} \ -constraints {testexprdoubleobj} \ -match glob \ -body {testexprdoubleobj ""} \ -returnCodes error -result * test expr-39.19 {Tcl_ExprDoubleObj coerces wides} testexprdoubleobj { testexprdoubleobj 1[string repeat 0 17] } {This is a result: 1e+17} test expr-39.20 {Tcl_ExprDoubleObj coerces bignums} testexprdoubleobj { testexprdoubleobj 1[string repeat 0 38] } {This is a result: 1e+38} test expr-39.21 {Tcl_ExprDoubleObj handles overflows} \ testexprdoubleobj&&ieeeFloatingPoint { testexprdoubleobj 17976931348623157[string repeat 0 292]. } {This is a result: 1.7976931348623157e+308} test expr-39.22 {Tcl_ExprDoubleObj handles overflows that look like int} \ testexprdoubleobj&&ieeeFloatingPoint { testexprdoubleobj 17976931348623157[string repeat 0 292] } {This is a result: 1.7976931348623157e+308} test expr-39.23 {Tcl_ExprDoubleObj handles overflows} \ testexprdoubleobj&&ieeeFloatingPoint { testexprdoubleobj 17976931348623165[string repeat 0 292]. } {This is a result: Inf} test expr-39.24 {Tcl_ExprDoubleObj handles overflows that look like int} \ testexprdoubleobj&&ieeeFloatingPoint { testexprdoubleobj 17976931348623165[string repeat 0 292] } {This is a result: Inf} test expr-39.25 {Tcl_ExprDoubleObj and NaN} \ {testexprdoubleobj ieeeFloatingPoint} { list [catch {testexprdoubleobj 0.0/0.0} result] $result } {1 {domain error: argument not in valid range}} test expr-40.1 {large octal shift} { expr 0o100000000000000000000000000000000 } [expr 0x1000000000000000000000000] test expr-40.2 {large octal shift} { expr 0o100000000000000000000000000000001 } [expr 0x1000000000000000000000001] test expr-41.1 {exponent overflow} { expr 1.0e2147483630 } Inf test expr-41.2 {exponent underflow} { expr 1.0e-2147483630 } 0.0 test expr-41.3 {exponent overflow} { expr 1e2147483647 } Inf test expr-41.4 {exponent overflow} { expr 1e2147483648 } Inf test expr-41.5 {exponent overflow} { expr 100e2147483645 } Inf test expr-41.6 {exponent overflow} { expr 100e2147483646 } Inf test expr-41.7 {exponent overflow} { expr 1.0e2147483647 } Inf test expr-41.8 {exponent overflow} { expr 1.0e2147483648 } Inf test expr-41.9 {exponent overflow} { expr 1.2e2147483647 } Inf test expr-41.10 {exponent overflow} { expr 1.2e2147483648 } Inf test expr-41.11 {exponent overflow} { expr 1e-2147483648 } 0.0 test expr-41.12 {exponent overflow} { expr 1e-2147483649 } 0.0 test expr-41.13 {exponent overflow} { expr 100e-2147483650 } 0.0 test expr-41.14 {exponent overflow} { expr 100e-2147483651 } 0.0 test expr-41.15 {exponent overflow} { expr 1.0e-2147483648 } 0.0 test expr-41.16 {exponent overflow} { expr 1.0e-2147483649 } 0.0 test expr-41.17 {exponent overflow} { expr 1.23e-2147483646 } 0.0 test expr-41.18 {exponent overflow} { expr 1.23e-2147483647 } 0.0 test expr-41.19 {numSigDigs == 0} { expr 0e309 } 0.0 test expr-41.20 {numSigDigs == 0} { expr 0e310 } 0.0 test expr-41.21 {negative zero, large exponent} { expr -0e309 } -0.0 test expr-41.22 {negative zero, large exponent} { expr -0e310 } -0.0 test expr-41.23 {floating point overflow on significand (Bug 1de6b0629e)} { expr 123[string repeat 0 309]1e-310 } 123.0 test expr-42.1 {denormals} ieeeFloatingPoint { expr 7e-324 } 5e-324 # TIP 114 test expr-43.1 {0b notation} { expr 0b0 } 0 test expr-43.2 {0b notation} { expr 0b1 } 1 test expr-43.3 {0b notation} { expr 0b10 } 2 test expr-43.4 {0b notation} { expr 0b11 } 3 test expr-43.5 {0b notation} { expr 0b100 } 4 test expr-43.6 {0b notation} { expr 0b101 } 5 test expr-43.7 {0b notation} { expr 0b1000 } 8 test expr-43.8 {0b notation} { expr 0b1001 } 9 test expr-43.9 {0b notation} { expr 0b1[string repeat 0 31] } 2147483648 test expr-43.10 {0b notation} { expr 0b1[string repeat 0 30]1 } 2147483649 test expr-43.11 {0b notation} { expr 0b[string repeat 1 64] } 18446744073709551615 test expr-43.12 {0b notation} { expr 0b1[string repeat 0 64] } 18446744073709551616 test expr-43.13 {0b notation} { expr 0b1[string repeat 0 63]1 } 18446744073709551617 test expr-44.1 {0o notation} { expr 0o0 } 0 test expr-44.2 {0o notation} { expr 0o1 } 1 test expr-44.3 {0o notation} { expr 0o7 } 7 test expr-44.4 {0o notation} { expr 0o10 } 8 test expr-44.5 {0o notation} { expr 0o11 } 9 test expr-44.6 {0o notation} { expr 0o100 } 64 test expr-44.7 {0o notation} { expr 0o101 } 65 test expr-44.8 {0o notation} { expr 0o1000 } 512 test expr-44.9 {0o notation} { expr 0o1001 } 513 test expr-44.10 {0o notation} { expr 0o1[string repeat 7 21] } 18446744073709551615 test expr-44.11 {0o notation} { expr 0o2[string repeat 0 21] } 18446744073709551616 test expr-44.12 {0o notation} { expr 0o2[string repeat 0 20]1 } 18446744073709551617 # TIP 237 again test expr-45.1 {entier} { expr entier(0) } 0 test expr-45.2 {entier} { expr entier(0.5) } 0 test expr-45.3 {entier} { expr entier(1.0) } 1 test expr-45.4 {entier} { expr entier(1.5) } 1 test expr-45.5 {entier} { expr entier(2.0) } 2 test expr-45.6 {entier} { expr entier(1e+22) } 10000000000000000000000 test expr-45.7 {entier} { list [catch {expr entier(Inf)} result] $result } {1 {integer value too large to represent}} test expr-45.8 {entier} ieeeFloatingPoint { list [catch {expr {entier($ieeeValues(NaN))}} result] $result } {1 {floating point value is Not a Number}} test expr-45.9 {entier} ieeeFloatingPoint { list [catch {expr {entier($ieeeValues(-NaN))}} result] $result } {1 {floating point value is Not a Number}} test expr-46.1 {round() rounds to +-infinity} { expr round(0.5) } 1 test expr-46.2 {round() rounds to +-infinity} { expr round(1.5) } 2 test expr-46.3 {round() rounds to +-infinity} { expr round(-0.5) } -1 test expr-46.4 {round() rounds to +-infinity} { expr round(-1.5) } -2 test expr-46.5 {round() overflow} { expr round(9.2233720368547758e+018) } 9223372036854775808 test expr-46.6 {round() overflow} { expr round(-9.2233720368547758e+018) } -9223372036854775808 test expr-46.7 {round() bad value} -body { set x trash expr {round($x)} } -returnCodes error -match glob -result * test expr-46.8 {round() already an integer} { set x 123456789012 incr x expr round($x) } 123456789013 test expr-46.9 {round() boundary case - 1/2 - 1 ulp} { set x 0.25 set bit 0.125 while 1 { set newx [expr {$x + $bit}] if { $newx == $x || $newx == 0.5 } break set x $newx set bit [expr { $bit / 2.0 }] } expr {round($x)} } 0 test expr-46.10 {round() boundary case - 1/2 + 1 ulp} { set x 0.75 set bit 0.125 while 1 { set newx [expr {$x - $bit}] if { $newx == $x || $newx == 0.5 } break set x $newx set bit [expr { $bit / 2.0 }] } expr {round($x)} } 1 test expr-46.11 {round() boundary case - -1/2 - 1 ulp} { set x -0.75 set bit 0.125 while 1 { set newx [expr {$x + $bit}] if { $newx == $x || $newx == -0.5 } break set x $newx set bit [expr { $bit / 2.0 }] } expr {round($x)} } -1 test expr-46.12 {round() boundary case - -1/2 + 1 ulp} { set x -0.25 set bit 0.125 while 1 { set newx [expr {$x - $bit}] if { $newx == $x || $newx == -0.5 } break set x $newx set bit [expr { $bit / 2.0 }] } expr {round($x)} } 0 test expr-46.13 {round() boundary case - round down} { expr {round(2147483647 - 0.51)} } 2147483646 test expr-46.14 {round() boundary case - round up} { expr {round(2147483647 - 0.50)} } 2147483647 test expr-46.15 {round() boundary case - round up to wide} { expr {round(2147483647 + 0.50)} } [expr {wide(2147483647) + 1}] test expr-46.16 {round() boundary case - round up} { expr {round(-2147483648 + 0.51)} } -2147483647 test expr-46.17 {round() boundary case - round down} { expr {round(-2147483648 + 0.50)} } -2147483648 test expr-46.18 {round() boundary case - round down to wide} { expr {round(-2147483648 - 0.50)} } [expr {wide(-2147483648) - 1}] test expr-46.19 {round() handling of long/bignum boundary} { expr {round(double(0x7fffffffffffffff))} } 9223372036854775808 test expr-47.1 {isqrt() - arg count} { list [catch {expr {isqrt(1,2)}} result] $result } {1 {too many arguments for math function "isqrt"}} test expr-47.2 {isqrt() - non-number} { list [catch {expr {isqrt({rubbish})}} result] $result } {1 {expected number but got "rubbish"}} test expr-47.3 {isqrt() - NaN} ieeeFloatingPoint { list [catch {expr {isqrt(NaN)}} result] $result } {1 {floating point value is Not a Number}} test expr-47.4 {isqrt() of negative floating point number} { list [catch {expr {isqrt(-1.0)}} result] $result } {1 {square root of negative argument}} test expr-47.5 {isqrt() of floating point zero} { expr isqrt(0.0) } 0 test expr-47.6 {isqrt() of exact floating point numbers} { set trouble {} for {set i 0} {$i < 16} {incr i} { set root [expr {1 << $i}] set rm1 [expr {$root - 1}] set arg [expr {pow(2., (2 * $i))}] if {isqrt($arg-1) != $rm1} { append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n" } if {isqrt($arg) != $root} { append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n" } if {isqrt($arg+1) != $root} { append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n" } } set trouble } {} test expr-47.7 {isqrt() of exact floating point numbers} ieeeFloatingPoint { set trouble {} for {set i 17} {$i < 27} {incr i} { set root [expr {1 << $i}] set rm1 [expr {$root - 1}] set arg [expr {pow(2., (2 * $i))}] if {isqrt($arg-1.0) != $rm1} { append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n" } if {isqrt($arg) != $root} { append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n" } if {isqrt($arg+1.0) != $root} { append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n" } } set trouble } {} test expr-47.8 {isqrt of inexact floating point number} ieeeFloatingPoint { expr isqrt(2[string repeat 0 34]) } 141421356237309504 test expr-47.9 {isqrt of negative int} { list [catch {expr isqrt(-1)} result] $result } {1 {square root of negative argument}} test expr-47.10 {isqrt of negative bignum} { list [catch {expr isqrt(-1[string repeat 0 1000])} result] $result } {1 {square root of negative argument}} test expr-47.11 {isqrt of zero} { expr {isqrt(0)} } 0 test expr-47.12 {isqrt of various sizes of integer} { set faults 0 set trouble {} for {set i 0} {$faults < 10 && $i <= 1024} {incr i} { set root [expr {1 << $i}] set rm1 [expr {$root - 1}] set arg [expr {1 << (2 * $i)}] set tval [expr {isqrt($arg-1)}] if {$tval != $rm1} { append trouble "i = " $i ": isqrt(" $arg "-1) == " $tval \ " != " $rm1 "\n" incr faults } set tval [expr {isqrt($arg)}] if {$tval != $root} { append trouble "i = " $i ": isqrt(" $arg ") == " $tval \ " != " $root "\n" incr faults } set tval [expr {isqrt($arg+1)}] if {$tval != $root} { append trouble "i = " $i ": isqrt(" $arg "+1) == " $tval \ " != " $root "\n" incr faults } } set trouble } {} test expr-47.13 {isqrt and floating point rounding (Bug 2143288)} { set trouble {} set faults 0 for {set i 0} {$i < 29 && $faults < 10} {incr i} { for {set j 0} {$j <= $i} {incr j} { set k [expr {isqrt((1<<56)+(1<<$i)+(1<<$j))}] if {$k != (1<<28)} { append trouble "i = $i, j = $j, k = $k\n" incr faults } } set k [expr {isqrt((1<<56)+(1<<29)+(1<<$i))}] if {$k != (1<<28)+1} { append trouble "i = $i, k = $k\n" incr faults } } set trouble } {} test expr-48.1 {Bug 1770224} { expr {-0x8000000000000001 >> 0x8000000000000000} } -1 test expr-49.1 {Bug 2823282} { coroutine foo apply {{} {set expr expr; $expr {[yield]}}} foo 1 } 1 test expr-50.1 {test sqrt() of bignums with non-Inf answer} { expr {sqrt("1[string repeat 0 616]") == 1e308} } 1 test expr-51.1 {test round-to-even on input} { expr 6.9294956446009195e15 } 6929495644600920.0 test expr-52.1 { comparison with empty string does not generate string representation } { set a [list one two three] list [expr {$a eq {}}] [expr {$a < {}}] [expr {$a > {}}] [ string match {*no string representation*} [ ::tcl::unsupported::representation $a]] } {0 0 1 1} # Bug e3dcab1d14 proc do-one-test-expr-63 {e p float athreshold} { # e - power of 2 to test # p - tcl_precision to test with # float - floating point value 2**-$p # athreshold - tolerable absolute error (1/2 decimal digit in # least significant place plus 1/2 least significant bit) set trouble {} set ::tcl_precision $p set xfmt x[expr $float] set ::tcl_precision 0 set fmt [string range $xfmt 1 end] set aerror [expr {abs($fmt - $float)}] if {$aerror > $athreshold} { return "Result $fmt is more than $athreshold away from $float" } else { return {} } } proc run-test-expr-63 {} { for {set e 0} {$e <= 1023} {incr e} { set pt [expr {floor($e*log(2)/log(10))}] for {set p 6} {$p <= 17} {incr p} { set athreshold [expr {0.5*10.0**-($pt+$p) + 2.0**-($e+53)}] set numer [expr {5**$e}] set xfloat x[expr {2.**-$e}] set float [string range $xfloat 1 end] test expr-63.$p.$e "convert 2**-$e to decimal at precision $p" { do-one-test-expr-63 $e $p $float $athreshold } {} } } rename do-one-test-expr-63 {} rename run-test-expr-63 {} } run-test-expr-63 # cleanup if {[info exists a]} { unset a } catch {unset min} catch {unset max} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/fCmd.test0000644000175000017500000025724014554262142014570 0ustar sergeisergei# This file tests the tclFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] cd [temporaryDirectory] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testchmod [llength [info commands testchmod]] testConstraint winVista 0 testConstraint win2000orXP 0 testConstraint winLessThan10 0 # Don't know how to determine this constraint correctly testConstraint notNetworkFilesystem 0 testConstraint reg 0 if {[testConstraint win]} { if {[catch { # Is the registry extension already static to this shell? try { load {} Registry set ::reglib {} } on error {} { # try the location given to use on the commandline to tcltest ::tcltest::loadTestedCommands load $::reglib Registry } testConstraint reg 1 } regError]} { catch {package require registry; testConstraint reg 1} } } # File permissions broken on wsl without some "exotic" wsl configuration testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] set tmpspace /tmp;# default value # Find a group that exists on this Unix system, or else skip tests that # require Unix groups. testConstraint foundGroup [expr {![testConstraint unix]}] if {[testConstraint unix]} { catch { set groupList [exec groups] set group [lindex $groupList 0] testConstraint foundGroup 1 } proc dev dir { file stat $dir stat return $stat(dev) } if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] } } # Also used in winFCmd... if {[testConstraint win] && [testConstraint nt]} { if {$::tcl_platform(osVersion) >= 5.0} { if {$::tcl_platform(osVersion) < 10.0} { testConstraint winLessThan10 1 } if {$::tcl_platform(osVersion) >= 6.0} { testConstraint winVista 1 } else { testConstraint win2000orXP 1 } } } testConstraint darwin9 [expr { [testConstraint unix] && $tcl_platform(os) eq "Darwin" && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9] }] testConstraint notDarwin9 [expr {![testConstraint darwin9]}] testConstraint notContinuousIntegration [expr {![info exists ::env(CI)]}] testConstraint fileSharing 0 testConstraint notFileSharing 1 testConstraint linkFile 1 testConstraint linkDirectory 1 # Several tests require need to match results against the Unix username set user {} if {[testConstraint unix]} { catch { set user [exec whoami] } if {$user eq ""} { catch { regexp {^[^(]*\(([^)]*)\)} [exec id] -> user } } if {$user eq ""} { set user "root" } } proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string close $f return $string } # # checkcontent -- # # Ensures that file "file" contains only the string "matchString" returns 0 # if the file does not exist, or has a different content # proc checkcontent {file matchString} { try { set f [open $file] set fileString [read $f] close $f } on error {} { return 0 } return [string match $matchString $fileString] } proc openup {path} { testchmod 0o777 $path if {[file isdirectory $path]} { catch { foreach p [glob -directory $path *] { openup $p } } } } proc cleanup {args} { set wd [list .] foreach p [concat $wd $args] { set x "" catch { set x [glob -directory $p tf* td*] } foreach file $x { if { [catch {file delete -force -- $file}] && [testConstraint testchmod] } then { catch {openup $file} catch {file delete -force -- $file} } } } } proc contents {file} { set f [open $file] set r [read $f] close $f return $r } set root [lindex [file split [pwd]] 0] # A really long file name. # Length of long is 1216 chars, which should be greater than any static buffer # or allowable filename. set long "abcdefghihjllmnopqrstuvwxyz01234567890" append long $long append long $long append long $long append long $long append long $long test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup { cleanup } -body { createfile tf1 file rename tf1 tf2 glob tf* } -result {tf2} test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup { cleanup } -body { createfile tf1 file copy tf1 tf2 lsort [glob tf*] } -result {tf1 tf2} test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body { file rename -xyz } -returnCodes error -result {bad option "-xyz": must be -force or --} test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body { file rename xyz } -returnCodes error -result {wrong # args: should be "file rename ?-option value ...? source ?source ...? target"} test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body { file rename xyz ~_totally_bogus_user } -returnCodes error -result {user "_totally_bogus_user" doesn't exist} test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file copy tf1 ~ } -result {error copying "tf1": no such file or directory} test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file rename tf1 tf2 tf3 } -result {error renaming: target "tf3" is not a directory} test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf3 file rename tf1 tf2 tf3 } -result {error renaming: target "tf3" is not a directory} test fCmd-3.7 {FileCopyRename: target exists & is directory} -setup { cleanup } -constraints {notRoot} -body { file mkdir td1 createfile tf1 tf1 file rename tf1 td1 contents [file join td1 tf1] } -result {tf1} test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file rename tf1 tf2 tf3 } -result {error renaming: target "tf3" is not a directory} test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file copy -force -- tf1 tf2 tf3 } -result {error copying: target "tf3" is not a directory} test fCmd-3.10 {FileCopyRename: just 2 arguments} -constraints notRoot -setup { cleanup } -body { createfile tf1 tf1 file rename tf1 tf2 contents tf2 } -result {tf1} test fCmd-3.11 {FileCopyRename: just 2 arguments} -constraints notRoot -setup { cleanup } -body { createfile tf1 tf1 file rename -force -force -- tf1 tf2 contents tf2 } -result {tf1} test fCmd-3.12 {FileCopyRename: move each source: 1 source} -setup { cleanup } -constraints {notRoot} -body { createfile tf1 tf1 file mkdir td1 file rename tf1 td1 contents [file join td1 tf1] } -result {tf1} test fCmd-3.13 {FileCopyRename: move each source: multiple sources} -setup { cleanup } -constraints {notRoot} -body { createfile tf1 tf1 createfile tf2 tf2 createfile tf3 tf3 createfile tf4 tf4 file mkdir td1 file rename tf1 tf2 tf3 tf4 td1 list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \ [contents [file join td1 tf3]] [contents [file join td1 tf4]] } -result {tf1 tf2 tf3 tf4} test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir td1 file rename ~_totally_bogus_user td1 } -result {user "_totally_bogus_user" doesn't exist} test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup { cleanup } -constraints {notRoot unixOrWin} -returnCodes error -body { file mkdir td1 file rename / td1 } -result {error renaming "/" to "td1": file already exists} test fCmd-3.16 {FileCopyRename: break on first error} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 createfile tf2 createfile tf3 createfile tf4 file mkdir td1 createfile [file join td1 tf3] file rename tf1 tf2 tf3 tf4 td1 } -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}] test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup { cleanup } -constraints {notRoot} -body { file mkdir td1 glob td* } -result {td1} test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} -setup { cleanup } -constraints {notRoot} -body { file mkdir td1 td2 td3 lsort [glob td*] } -result {td1 td2 td3} test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} -setup { cleanup } -constraints {notRoot} -body { createfile tf1 catch {file mkdir td1 td2 tf1 td3 td4} glob td1 td2 tf1 td3 td4 } -result {td1 td2 tf1} test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir ~_totally_bogus_user } -result {user "_totally_bogus_user" doesn't exist} test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\x00'} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir "" } -result {can't create directory "": no such file or directory} test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} -setup { cleanup } -constraints {notRoot} -body { file mkdir td1 glob td1 } -result {td1} test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} -setup { cleanup } -constraints {notRoot} -body { file mkdir [file join td1 td2 td3 td4] glob td1 [file join td1 td2] } -result "td1 [file join td1 td2]" test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} -setup { cleanup } -constraints {notRoot} -body { file mkdir td1 set x [file exists td1] file mkdir td1 list $x [file exists td1] } -result {1 1} test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 file mkdir tf1 } -result [subst {can't create directory "[file join tf1]": file already exists}] test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup { cleanup } -constraints {notRoot} -body { file mkdir td1 set x [file exists td1] file mkdir td1 list $x [file exists td1] } -result {1 1} test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup { cleanup } -constraints {unix notRoot testchmod notWsl} -returnCodes error -body { file mkdir td1/td2/td3 testchmod 0 td1/td2 file mkdir td1/td2/td3/td4 } -cleanup { testchmod 0o755 td1/td2 cleanup } -result {can't create directory "td1/td2/td3": permission denied} test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup { cleanup } -constraints {notRoot} -body { set x [file exists td1] file mkdir td1 list $x [file exists td1] } -result {0 1} test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup { cleanup file delete -force foo } -constraints {unix notRoot notWsl} -body { file mkdir foo file attr foo -perm 0o40000 file mkdir foo/tf1 } -returnCodes error -cleanup { file delete -force foo } -result {can't create directory "foo/tf1": permission denied} test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup { cleanup } -constraints {notRoot} -body { file mkdir tf1 file exists tf1 } -result 1 test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body { file delete -xyz } -returnCodes error -result {bad option "-xyz": must be -force or --} test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body { file delete -force -force } -result {} test fCmd-5.3 {TclFileDeleteCmd: 1 file} -constraints {notRoot} -setup { cleanup } -body { createfile tf1 createfile tf2 file mkdir td1 file delete tf2 glob tf* td* } -result {tf1 td1} test fCmd-5.4 {TclFileDeleteCmd: multiple files} -constraints notRoot -setup { cleanup } -body { createfile tf1 createfile tf2 file mkdir td1 set x [list [file exists tf1] [file exists tf2] [file exists td1]] file delete tf1 td1 tf2 lappend x [file exists tf1] [file exists tf2] [file exists tf3] } -cleanup {cleanup} -result {1 1 1 0 0 0} test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup { cleanup } -constraints {notRoot unixOrWin} -body { createfile tf1 createfile tf2 file mkdir td1 catch {file delete tf1 td1 $root tf2} list [file exists tf1] [file exists tf2] [file exists td1] } -cleanup {cleanup} -result {0 1 0} test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body { file delete ~_totally_bogus_user } -returnCodes error -result {user "_totally_bogus_user" doesn't exist} test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} -setup { catch {file delete ~/tf1} } -constraints {notRoot} -body { createfile ~/tf1 file delete ~/tf1 } -result {} test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} -setup { cleanup } -constraints {notRoot} -body { set x [file exists tf1] file delete tf1 list $x [file exists tf1] } -result {0 0} test fCmd-5.9 {TclFileDeleteCmd: is directory} -constraints {notRoot} -setup { cleanup } -body { file mkdir td1 file delete td1 file exists td1 } -result {0} test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir [file join td1 td2] file delete td1 } -result {error deleting "td1": directory not empty} test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup { cleanup set dir [pwd] } -constraints {notRoot} -body { file mkdir [file join td1 td2] cd [file join td1 td2] set res [list [catch {file delete -force [file dirname [pwd]]} msg]] cd $dir lappend res [file exists td1] $msg } -cleanup { cd $dir } -result {0 0 {}} test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} -setup { cleanup } -constraints {unix} -body { file mkdir [file join td1 td2] file attributes [file join td1 td2] -permissions u+rwx set res [list [catch {file delete -force td1} msg]] lappend res [file exists td1] $msg } -result {0 0 {}} test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} { # can't test this, because it's caught by FileCopyRename } {} test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot emptyTest} { # can't test this, because it's caught by FileCopyRename } {} test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file rename tf1 tf2 } -result {error renaming "tf1": no such file or directory} test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} -setup { cleanup } -constraints {notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* } -result {tf2} test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} -setup { cleanup } -constraints {notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* } -result {tf2} test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup { cleanup } -constraints {unix notRoot testchmod notWsl} -body { file mkdir td1 testchmod 0 td1 createfile tf1 file rename tf1 td1 } -returnCodes error -cleanup { testchmod 0o755 td1 } -result {error renaming "tf1" to "td1/tf1": permission denied} test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup { cleanup } -constraints {unix notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* } -result {tf2} test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 createfile tf2 file rename tf1 tf2 } -result {error renaming "tf1" to "tf2": file already exists} test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 createfile tf2 file rename tf1 tf2 } -result {error renaming "tf1" to "tf2": file already exists} test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup { cleanup } -constraints {notRoot} -body { createfile tf1 createfile tf2 file rename -force tf1 tf2 glob tf* } -result {tf2} test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir td1 file mkdir td2 createfile [file join td2 td1] file rename -force td1 td2 } -result [subst {can't overwrite file "[file join td2 td1]" with directory "td1"}] test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 file mkdir [file join td1 tf1] file rename -force tf1 td1 } -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}] test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} -setup { cleanup } -constraints {notRoot notNetworkFilesystem} -body { file mkdir [file join td1 td2] file mkdir td2 createfile [file join td2 tf1] file rename -force td2 td1 file exists [file join td1 td2 tf1] } -result 1 test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup { cleanup } -constraints {notRoot} -body { file mkdir [file join td1 td2] createfile [file join td1 td2 tf1] file mkdir td2 file rename -force td2 td1 } -returnCodes error -match glob -result \ [subst {error renaming "td2" to "[file join td1 td2]": file *}] test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file rename -force $root tf1 } -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}] test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup { cleanup } -constraints {notRoot} -body { file mkdir [file join td1 td2] createfile [file join td1 td2 tf1] file mkdir td2 file rename -force td2 td1 } -returnCodes error -match glob -result \ [subst {error renaming "td2" to "[file join td1 td2]": file *}] test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup { cleanup $tmpspace } -constraints {unix notRoot} -body { createfile tf1 file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf1] } -result [file join $tmpspace tf1] test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { catch {file delete -force c:/tcl8975@ d:/tcl8975@} } -body { file mkdir c:/tcl8975@ if {[catch {file rename c:/tcl8975@ d:/}]} { return d:/tcl8975@ } glob c:/tcl8975@ d:/tcl8975@ } -cleanup { file delete -force c:/tcl8975@ catch {file delete -force d:/tcl8975@} } -result {d:/tcl8975@} test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup { cleanup $tmpspace } -constraints {unix notRoot} -body { file mkdir td1 file rename td1 $tmpspace glob -nocomplain td* [file join $tmpspace td*] } -result [file join $tmpspace td1] test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup { cleanup $tmpspace } -constraints {unix notRoot} -body { createfile tf1 file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf*] } -result [file join $tmpspace tf1] test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {xdev notRoot notWsl} -body { file mkdir td1/td2/td3 file attributes td1 -permissions 0o000 file rename td1 $tmpspace } -returnCodes error -cleanup { file attributes td1 -permissions 0o755 cleanup } -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$} test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir ~/td1/td2 set td1name [file join [file dirname ~] [file tail ~] td1] file attributes $td1name -permissions 0o000 file copy ~/td1 td1 } -returnCodes error -cleanup { file attributes $td1name -permissions 0o755 file delete -force ~/td1 } -result {error copying "~/td1": permission denied} test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td2 file mkdir ~/td1 set td1name [file join [file dirname ~] [file tail ~] td1] file attributes $td1name -permissions 0o000 file copy td2 ~/td1 } -returnCodes error -cleanup { file attributes $td1name -permissions 0o755 file delete -force ~/td1 } -result {error copying "td2" to "~/td1/td2": permission denied} test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir ~/td1/td2 set td2name [file join [file dirname ~] [file tail ~] td1 td2] file attributes $td2name -permissions 0o000 file copy ~/td1 td1 } -returnCodes error -cleanup { file attributes $td2name -permissions 0o755 file delete -force ~/td1 } -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {notRoot xdev} -returnCodes error -body { file mkdir td1/td2/td3 file mkdir [file join $tmpspace td1] createfile [file join $tmpspace td1 tf1] file rename -force td1 $tmpspace } -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists} test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {notRoot xdev notWsl} -body { file mkdir td1/td2/td3 file attributes td1/td2/td3 -permissions 0o000 file rename td1 $tmpspace } -returnCodes error -cleanup { file attributes td1/td2/td3 -permissions 0o755 cleanup $tmpspace } -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied} test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { cleanup $tmpspace } -constraints {notRoot xdev} -body { file mkdir td1/td2/td3 file rename td1 $tmpspace glob td* [file join $tmpspace td1 t*] } -result [file join $tmpspace td1 td2] test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup { cleanup $tmpspace } -constraints {unix notRoot notWsl} -body { file mkdir foo/bar file attr foo -perm 0o40555 file rename foo/bar $tmpspace } -returnCodes error -cleanup { catch {file delete [file join $tmpspace bar]} catch {file attr foo -perm 0o40777} catch {file delete -force foo} } -match glob -result {*: permission denied} test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup { cleanup $tmpspace } -constraints {notRoot xdev} -body { file mkdir [file join $tmpspace td1] createfile [file join $tmpspace td1 tf1] file rename [file join $tmpspace td1 tf1] tf1 list [file exists [file join $tmpspace td1 tf1]] [file exists tf1] } -result {0 1} test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup { cleanup } -returnCodes error -body { file copy tf1 tf2 } -result {error copying "tf1": no such file or directory} test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup { cleanup } -returnCodes error -body { file mkdir [file join tf1 tf2] file delete tf1 } -result {error deleting "tf1": directory not empty} test fCmd-7.2 {FileForceOption: -force} -constraints {notRoot} -setup { cleanup } -body { file mkdir [file join tf1 tf2] file delete -force tf1 } -result {} test fCmd-7.3 {FileForceOption: --} -constraints {notRoot} -body { createfile -tf1 file delete -- -tf1 } -result {} test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup { createfile -tf1 } -body { file delete -tf1 } -returnCodes error -cleanup { file delete -- -tf1 } -result {bad option "-tf1": must be -force or --} test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile -- createfile -force file delete -force -force -- -- -force glob -- -- -force } -result {no files matched glob patterns "-- -force"} test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ -constraints {unix notRoot knownBug} -body { # Labeled knownBug because it is dangerous [Bug: 3881] file mkdir td1 file attr td1 -perm 0o40000 file rename ~$user td1 } -returnCodes error -cleanup { file delete -force td1 } -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied" test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ -constraints {unix notRoot} -body { string equal [file tail ~$user] ~$user } -result 0 test fCmd-8.3 {file copy and path translation: ensure correct error} -body { file copy ~ [file join this file doesnt exist] } -returnCodes error -result [subst \ {error copying "~" to "[file join this file doesnt exist]": no such file or directory}] test fCmd-9.1 {file rename: comprehensive: EACCES} -setup { cleanup } -constraints {unix notRoot notWsl} -body { file mkdir td1 file mkdir td2 file attr td2 -perm 0o40000 file rename td1 td2/ } -returnCodes error -cleanup { file delete -force td2 file delete -force td1 } -result {error renaming "td1" to "td2/td1": permission denied} test fCmd-9.2 {file rename: comprehensive: source doesn't exist} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file rename tf1 tf2 } -result {error renaming "tf1": no such file or directory} test fCmd-9.3 {file rename: comprehensive: file to new name} -setup { cleanup } -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 testchmod 0o444 tf2 file rename tf1 tf3 file rename tf2 tf4 list [lsort [glob tf*]] [file writable tf3] [file writable tf4] } -result {{tf3 tf4} 1 0} test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup { cleanup } -constraints {win win2000orXP testchmod} -body { file mkdir td1 td2 testchmod 0o555 td2 file rename td1 td3 file rename td2 td4 list [lsort [glob td*]] [file writable td3] [file writable td4] } -cleanup { cleanup } -result {{td3 td4} 1 0} test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup { cleanup } -constraints {unix notRoot testchmod notDarwin9 notWsl} -body { file mkdir td1 td2 testchmod 0o555 td2 file rename td1 td3 file rename td2 td4 list [lsort [glob td*]] [file writable td3] [file writable td4] } -cleanup { cleanup } -result {{td3 td4} 1 0} test fCmd-9.5 {file rename: comprehensive: file to self} -setup { cleanup } -constraints {notRoot testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 testchmod 0o444 tf2 file rename -force tf1 tf1 file rename -force tf2 tf2 list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2] } -result {tf1 tf2 1 0} test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup { cleanup } -constraints {win win2000orXP testchmod} -body { file mkdir td1 file mkdir td2 testchmod 0o555 td2 file rename -force td1 . file rename -force td2 . list [lsort [glob td*]] [file writable td1] [file writable td2] } -result {{td1 td2} 1 0} test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup { cleanup } -constraints {unix notRoot testchmod notWsl} -body { file mkdir td1 file mkdir td2 testchmod 0o555 td2 file rename -force td1 . file rename -force td2 . list [lsort [glob td*]] [file writable td1] [file writable td2] } -result {{td1 td2} 1 0} test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup { cleanup } -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 createfile tfs1 createfile tfs2 createfile tfs3 createfile tfs4 createfile tfd1 createfile tfd2 createfile tfd3 createfile tfd4 testchmod 0o444 tfs3 testchmod 0o444 tfs4 testchmod 0o444 tfd2 testchmod 0o444 tfd4 set msg [list [catch {file rename tf1 tf2} msg] $msg] file rename -force tfs1 tfd1 file rename -force tfs2 tfd2 file rename -force tfs3 tfd3 file rename -force tfs4 tfd4 list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] } -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0} test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup { cleanup } -constraints {notRoot testchmod notNetworkFilesystem} -body { # Under Unix you can rename a read-only directory, but you can't move it # into another directory. file mkdir td1 file mkdir [file join td2 td1] file mkdir tds1 file mkdir tds2 file mkdir tds3 file mkdir tds4 file mkdir [file join tdd1 tds1] file mkdir [file join tdd2 tds2] file mkdir [file join tdd3 tds3] file mkdir [file join tdd4 tds4] if {![testConstraint unix]} { testchmod 0o555 tds3 testchmod 0o555 tds4 } testchmod 0o555 [file join tdd2 tds2] testchmod 0o555 [file join tdd4 tds4] set msg [list [catch {file rename td1 td2} msg] $msg] file rename -force tds1 tdd1 file rename -force tds2 tdd2 file rename -force tds3 tdd3 file rename -force tds4 tdd4 if {[testConstraint unix]} { set w3 0 set w4 0 } else { set w3 [file writable [file join tdd3 tds3]] set w4 [file writable [file join tdd4 tds4]] } list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \ [file writable [file join tdd2 tds2]] $w3 $w4 } -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}] # Test can hit EEXIST or EBUSY, depending on underlying filesystem test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup { cleanup } -constraints {notRoot testchmod} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] if {!([testConstraint unix] || [testConstraint winVista])} { testchmod 0o555 tds2 } set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg] set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg] if {[testConstraint unix] || [testConstraint winVista]} { set w2 0 } else { set w2 [file writable tds2] } list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2 } -match glob -result \ [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file *}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file *}} 1 0}] test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 file mkdir td1 testchmod 0o444 tf2 file rename tf1 [file join td1 tf3] file rename tf2 [file join td1 tf4] list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] } -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { file mkdir td1 file mkdir td2 file mkdir td3 if {!([testConstraint unix] || [testConstraint winVista])} { testchmod 0o555 td2 } file rename td1 [file join td3 td3] file rename td2 [file join td3 td4] if {[testConstraint unix] || [testConstraint winVista]} { set w4 0 } else { set w4 [file writable [file join td3 td4]] } list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] $w4 } -result [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] test fCmd-9.12 {file rename: comprehensive: target exists} -setup { cleanup } -constraints {notRoot testchmod notNetworkFilesystem} -body { file mkdir [file join td1 td2] [file join td2 td1] testchmod 0o555 [file join td2 td1] file mkdir [file join td3 td4] [file join td4 td3] file rename -force td3 td4 list [file exists td3] [file exists [file join td4 td3 td4]] \ [catch {file rename td1 td2} msg] $msg } -cleanup { testchmod 0o755 [file join td2 td1] } -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}] # Test can hit EEXIST or EBUSY, depending on underlying filesystem test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup { cleanup } -constraints {notRoot} -body { file mkdir [file join td1 td2] [file join td2 td1 td4] file rename -force td1 td2 } -returnCodes error -match glob -result \ [subst {error renaming "td1" to "[file join td2 td1]": file *}] test fCmd-9.14 {file rename: comprehensive: dir into self} -setup { cleanup } -constraints {notRoot} -body { file mkdir td1 list [glob td*] [list [catch {file rename td1 td1} msg] $msg] } -result [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}] test fCmd-9.14.1 {file rename: comprehensive: dir into self} -setup { cleanup } -constraints {notRoot} -body { file mkdir td1 file rename td1 td1x file rename td1x td1 set msg "ok" } -result {ok} test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup { cleanup set dir [pwd] } -constraints {nonPortable notRoot} -body { file mkdir td1 cd td1 file rename [file join .. td1] [file join .. td1x] } -returnCodes error -cleanup { cd $dir } -result [subst {error renaming "[file join .. td1]" to "[file join .. td1x]": permission denied}] test fCmd-9.14.3 {file rename: comprehensive: dir into self} -setup { cleanup set dir [pwd] } -constraints {notRoot} -body { file mkdir td1 cd td1 file rename [file join .. td1] [file join .. td1 foo] } -returnCodes error -cleanup { cd $dir } -result [subst {error renaming "[file join .. td1]" to "[file join .. td1 foo]": trying to rename a volume or move a directory into itself}] test fCmd-9.15 {file rename: comprehensive: source and target incompatible} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir td1 createfile tf1 file rename -force td1 tf1 } -cleanup { cleanup } -result {can't overwrite file "tf1" with directory "td1"} test fCmd-9.16 {file rename: comprehensive: source and target incompatible} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir td1/tf1 createfile tf1 file rename -force tf1 td1 } -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}] test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file copy tf1 tf2 } -result {error copying "tf1": no such file or directory} test fCmd-10.2 {file copy: comprehensive: file to new name} -setup { cleanup } -constraints {notRoot testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 testchmod 0o444 tf2 file copy tf1 tf3 file copy tf2 tf4 list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] } -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup { cleanup } -constraints {unix notRoot testchmod notWsl} -body { file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 0o555 td2 file copy td1 td3 file copy td2 td4 list [lsort [glob td*]] [glob -directory td3 t*] \ [glob -directory td4 t*] [file writable td3] [file writable td4] } -cleanup { testchmod 0o755 td2 testchmod 0o755 td4 } -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0] test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup { cleanup } -constraints {win notRoot testchmod} -body { # On Windows with ACLs, copying a directory is defined like this file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 0o555 td2 testchmod 0o555 td2/tdy; # Above line removes inherited perms. So restore. file copy td1 td3 file copy td2 td4 list [lsort [glob td*]] [glob -directory td3 t*] \ [glob -directory td4 t*] [file writable td3] [file writable td4] } -cleanup { testchmod 0o755 td2 testchmod 0o755 td4 } -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1] test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup { cleanup } -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 createfile tfs1 createfile tfs2 createfile tfs3 createfile tfs4 createfile tfd1 createfile tfd2 createfile tfd3 createfile tfd4 if {$::tcl_platform(platform) eq "windows"} { # On Windows testchmode will attach an ACL which file copy cannot handle # so use good old attributes which file copy does understand file attribute tfs3 -readonly 1 file attribute tfs4 -readonly 1 file attribute tfd2 -readonly 1 file attribute tfd4 -readonly 1 } else { testchmod 0o444 tfs3 testchmod 0o444 tfs4 testchmod 0o444 tfd2 testchmod 0o444 tfd4 } set msg [list [catch {file copy tf1 tf2} msg] $msg] file copy -force tfs1 tfd1 file copy -force tfs2 tfd2 file copy -force tfs3 tfd3 file copy -force tfs4 tfd4 list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] } -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0} test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup { cleanup } -constraints {notRoot testchmod} -body { file mkdir td1 file mkdir [file join td2 td1] file mkdir tds1 file mkdir tds2 file mkdir tds3 file mkdir tds4 file mkdir [file join tdd1 tds1] file mkdir [file join tdd2 tds2] file mkdir [file join tdd3 tds3] file mkdir [file join tdd4 tds4] testchmod 0o555 tds3 testchmod 0o555 tds4 testchmod 0o555 [file join tdd2 tds2] testchmod 0o555 [file join tdd4 tds4] set a1 [list [catch {file copy td1 td2} msg] $msg] set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg] set a3 [catch {file copy -force tds2 tdd2}] set a4 [catch {file copy -force tds3 tdd3}] set a5 [catch {file copy -force tds4 tdd4}] list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 } -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}] test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { cleanup } -constraints {notRoot unixOrWin testchmod notWsl} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] testchmod 0o555 tds2 set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg] set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg] list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2] } -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}] test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 file mkdir td1 testchmod 0o444 tf2 file copy tf1 [file join td1 tf3] file copy tf2 [file join td1 tf4] list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] } -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup { cleanup } -constraints {unix notRoot testchmod notWsl} -body { file mkdir td1 file mkdir td2 file mkdir td3 testchmod 0o555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] [file writable [file join td3 td4]] } -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}] test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup { cleanup } -constraints {win notRoot testchmod} -body { # On Windows with ACLs, copying a directory is defined like this file mkdir td1 file mkdir td2 file mkdir td3 testchmod 0o555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] [file writable [file join td3 td4]] } -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}] test fCmd-10.9 {file copy: comprehensive: source and target incompatible} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir td1 createfile tf1 file copy -force td1 tf1 } -result {can't overwrite file "tf1" with directory "td1"} test fCmd-10.10 {file copy: comprehensive: source and target incompatible} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir [file join td1 tf1] createfile tf1 file copy -force tf1 td1 } -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}] test fCmd-10.11 {file copy: copy to empty file name} -setup { cleanup } -returnCodes error -body { createfile tf1 file copy tf1 "" } -result {error copying "tf1" to "": no such file or directory} test fCmd-10.12 {file rename: rename to empty file name} -setup { cleanup } -returnCodes error -body { createfile tf1 file rename tf1 "" } -result {error renaming "tf1" to "": no such file or directory} cleanup # old tests test fCmd-11.1 {TclFileRenameCmd: -- option} -constraints notRoot -setup { catch {file delete -force -- -tfa1} } -body { set s [createfile -tfa1] file rename -- -tfa1 tfa2 list [checkcontent tfa2 $s] [file exists -tfa1] } -cleanup { file delete tfa2 } -result {1 0} test fCmd-11.2 {TclFileRenameCmd: bad option} -constraints notRoot -setup { catch {file delete -force -- tfa1} } -body { set s [createfile tfa1] list [catch {file rename -x tfa1 tfa2}] \ [checkcontent tfa1 $s] [file exists tfa2] } -cleanup { file delete tfa1 } -result {1 1 0} test fCmd-11.3 {TclFileRenameCmd: bad \# args} -returnCodes error -body { file rename -- } -match glob -result * test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} -setup { set temp $::env(HOME) } -constraints notRoot -body { global env unset env(HOME) catch { file rename tfa ~/foobar } } -cleanup { set ::env(HOME) $temp } -result 1 test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} } -constraints {notRoot} -body { createfile tfa1 createfile tfa2 createfile tfa3 catch {file rename tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 } -result 1 test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup { catch {file delete -force -- tfa1 tfad} } -constraints {notRoot} -body { set s [createfile tfa1] file mkdir tfad file rename tfa1 tfad list [checkcontent tfad/tfa1 $s] [file exists tfa1] } -cleanup { file delete -force tfad } -result {1 0} test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} -setup { catch {file delete -force -- tfa1 tfa2 tfad} } -constraints {notRoot} -body { set s1 [createfile tfa1] set s2 [createfile tfa2] file mkdir tfad file rename tfa1 tfa2 tfad list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \ [file exists tfa1] [file exists tfa2] } -cleanup { file delete -force tfad } -result {1 1 0 0} test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { set s [createfile tfa] file mkdir tfad file mkdir tfad/tfa list [catch {file rename tfa tfad}] [checkcontent tfa $s] [file isdir tfad] } -cleanup { file delete -force tfa tfad } -result {1 1 1} # # Coverage tests for renamefile() ; # test fCmd-12.1 {renamefile: source filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { global env unset env(HOME) catch {file rename ~/tfa1 tfa2} } -cleanup { set ::env(HOME) $temp } -result 1 test fCmd-12.2 {renamefile: src filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { global env unset env(HOME) set s [createfile tfa1] file mkdir tfad catch {file rename tfa1 ~/tfa2 tfad} } -cleanup { set ::env(HOME) $temp file delete -force tfad } -result 1 test fCmd-12.3 {renamefile: stat failing on source} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2] } -result {1 0 0} test fCmd-12.4 {renamefile: error renaming file to directory} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { set s1 [createfile tfa] file mkdir tfad file mkdir tfad/tfa list [catch {file rename tfa tfad}] [checkcontent tfa $s1] \ [file isdir tfad/tfa] } -cleanup { file delete -force tfa tfad } -result {1 1 1} test fCmd-12.5 {renamefile: error renaming directory to file} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { file mkdir tfa file mkdir tfad set s [createfile tfad/tfa] list [catch {file rename tfa tfad}] [checkcontent tfad/tfa $s] \ [file isdir tfad] [file isdir tfa] } -cleanup { file delete -force tfa tfad } -result {1 1 1 1} test fCmd-12.6 {renamefile: TclRenameFile succeeding} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { set s [createfile tfa1] file rename tfa1 tfa2 list [checkcontent tfa2 $s] [file exists tfa1] } -cleanup { file delete tfa2 } -result {1 0} test fCmd-12.7 {renamefile: renaming directory into offspring} -setup { catch {file delete -force -- tfad} } -constraints {notRoot} -body { file mkdir tfad file mkdir tfad/dir catch {file rename tfad tfad/dir} } -cleanup { file delete -force tfad } -result 1 test fCmd-12.8 {renamefile: generic error} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot notWsl} -body { file mkdir tfa file mkdir tfa/dir file attributes tfa -permissions 0o555 catch {file rename tfa/dir tfa2} } -cleanup { catch {file attributes tfa -permissions 0o777} file delete -force tfa } -result 1 test fCmd-12.9 {renamefile: moving a file across volumes} -setup { cleanup $tmpspace } -constraints {unix notRoot} -body { set s [createfile tfa] file rename tfa $tmpspace list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa] } -cleanup { cleanup $tmpspace } -result {1 0} test fCmd-12.10 {renamefile: moving a directory across volumes} -setup { cleanup $tmpspace } -constraints {xdev notRoot} -body { file mkdir tfad set s [createfile tfad/a] file rename tfad $tmpspace list [checkcontent [file join $tmpspace tfad a] $s] [file exists tfad] } -cleanup { cleanup $tmpspace } -result {1 0} # # Coverage tests for TclCopyFilesCmd() # test fCmd-13.1 {TclCopyFilesCmd: -force option} -constraints notRoot -setup { catch {file delete -force -- tfa1} } -body { set s [createfile tfa1] file copy -force tfa1 tfa2 list [checkcontent tfa2 $s] [checkcontent tfa1 $s] } -cleanup { file delete tfa1 tfa2 } -result {1 1} test fCmd-13.2 {TclCopyFilesCmd: -- option} -constraints {notRoot} -setup { catch {file delete -force -- tfa1} } -body { set s [createfile -tfa1] file copy -- -tfa1 tfa2 list [checkcontent tfa2 $s] [checkcontent -tfa1 $s] } -cleanup { file delete -- -tfa1 tfa2 } -result {1 1} test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup { catch {file delete -force -- tfa1} } -body { set s [createfile tfa1] list [catch {file copy -x tfa1 tfa2}] \ [checkcontent tfa1 $s] [file exists tfa2] } -cleanup { file delete tfa1 } -result {1 1 0} test fCmd-13.4 {TclCopyFilesCmd: bad \# args} -constraints {notRoot} -body { file copy -- } -returnCodes error -match glob -result * test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup { set temp $::env(HOME) } -body { global env unset env(HOME) catch { file copy tfa ~/foobar } } -cleanup { set ::env(HOME) $temp } -result 1 test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} } -constraints {notRoot} -body { createfile tfa1 createfile tfa2 createfile tfa3 catch {file copy tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 } -result 1 test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup { catch {file delete -force -- tfa1 tfad} } -constraints {notRoot} -body { set s [createfile tfa1] file mkdir tfad file copy tfa1 tfad list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s] } -cleanup { file delete -force tfad tfa1 } -result {1 1} test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} -setup { catch {file delete -force -- tfa1 tfa2 tfad} } -constraints {notRoot} -body { set s1 [createfile tfa1] set s2 [createfile tfa2] file mkdir tfad file copy tfa1 tfa2 tfad list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \ [checkcontent tfa1 $s1] [checkcontent tfa2 $s2] } -cleanup { file delete -force tfad tfa1 tfa2 } -result {1 1 1 1} test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { set s [createfile tfa] file mkdir tfad file mkdir tfad/tfa list [catch {file copy tfa tfad}] [checkcontent tfa $s] \ [file isdir tfad/tfa] [file isdir tfad] } -cleanup { file delete -force tfa tfad } -result {1 1 1 1} # # Coverage tests for copyfile() # test fCmd-14.1 {copyfile: source filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { global env unset env(HOME) catch {file copy ~/tfa1 tfa2} } -cleanup { set ::env(HOME) $temp } -result 1 test fCmd-14.2 {copyfile: dst filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { global env unset env(HOME) set s [createfile tfa1] file mkdir tfad list [catch {file copy tfa1 ~/tfa2 tfad}] [checkcontent tfad/tfa1 $s] } -cleanup { set ::env(HOME) $temp file delete -force tfa1 tfad } -result {1 1} test fCmd-14.3 {copyfile: stat failing on source} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints notRoot -body { list [catch {file copy tfa1 tfa2}] [file exists tfa1] [file exists tfa2] } -result {1 0 0} test fCmd-14.4 {copyfile: error copying file to directory} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { set s1 [createfile tfa] file mkdir tfad file mkdir tfad/tfa list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \ [file isdir tfad] [file isdir tfad/tfa] } -cleanup { file delete -force tfa tfad } -result {1 1 1 1} test fCmd-14.5 {copyfile: error copying directory to file} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { file mkdir tfa file mkdir tfad set s [createfile tfad/tfa] list [catch {file copy tfa tfad}] [checkcontent tfad/tfa $s] \ [file isdir tfad] [file isdir tfa] } -cleanup { file delete -force tfa tfad } -result {1 1 1 1} test fCmd-14.6 {copyfile: copy file succeeding} -constraints notRoot -setup { catch {file delete -force -- tfa tfa2} } -body { set s [createfile tfa] file copy tfa tfa2 list [checkcontent tfa $s] [checkcontent tfa2 $s] } -cleanup { file delete tfa tfa2 } -result {1 1} test fCmd-14.7 {copyfile: copy directory succeeding} -setup { catch {file delete -force -- tfa tfa2} } -constraints {notRoot} -body { file mkdir tfa set s [createfile tfa/file] file copy tfa tfa2 list [checkcontent tfa/file $s] [checkcontent tfa2/file $s] } -cleanup { file delete -force tfa tfa2 } -result {1 1} test fCmd-14.8 {copyfile: copy directory failing} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot notWsl} -body { file mkdir tfa/dir/a/b/c file attributes tfa/dir -permissions 0o000 catch {file copy tfa tfa2} } -cleanup { file attributes tfa/dir -permissions 0o777 file delete -force tfa tfa2 } -result 1 # # Coverage tests for TclMkdirCmd() # test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { global env unset env(HOME) catch {file mkdir ~/tfa} } -cleanup { set ::env(HOME) $temp } -result 1 # # Can Tcl_SplitPath return argc == 0? If so them we need a test for that code. # test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file mkdir tfa file isdirectory tfa } -cleanup { file delete tfa } -result 1 test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { file mkdir tfa1 tfa2 list [file isdirectory tfa1] [file isdirectory tfa2] } -cleanup { file delete tfa1 tfa2 } -result {1 1} test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/file file attributes tfa -permissions 0o000 catch {file mkdir tfa/file} } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa } -result 1 test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file mkdir tfa/a/b/c file isdir tfa/a/b/c } -cleanup { file delete -force tfa } -result 1 test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { set s [createfile tfa] list [catch {file mkdir tfa}] [file isdir tfa] [file exists tfa] \ [checkcontent tfa $s] } -cleanup { file delete tfa } -result {1 0 1 1} test fCmd-15.7 {TclMakeDirsCmd - making several directories} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { file mkdir tfa1 tfa2/a/b/c list [file isdir tfa1] [file isdir tfa2/a/b/c] } -cleanup { file delete -force tfa1 tfa2 } -result {1 1} test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body { file mkdir tfa file mkdir tfa file isdir tfa } -constraints {notRoot} -cleanup { file delete tfa } -result 1 # Coverage tests for TclDeleteFilesCommand() test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { createfile tfa file delete -- tfa file exists tfa } -result 0 test fCmd-16.2 {test the -force and -- arguments} -constraints notRoot -setup { catch {file delete -force -- tfa} } -body { createfile tfa file delete -force -- tfa file exists tfa } -result 0 test fCmd-16.3 {test bad option} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { createfile tfa catch {file delete -dog tfa} } -cleanup { file delete tfa } -result 1 test fCmd-16.4 {accept zero files (TIP 323)} -body { file delete } -result {} test fCmd-16.5 {accept zero files (TIP 323)} -body { file delete -- } -result {} test fCmd-16.6 {delete: source filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { global env unset env(HOME) catch {file delete ~/tfa} } -cleanup { set ::env(HOME) $temp } -result 1 test fCmd-16.7 {remove a non-empty directory without -force} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file mkdir tfa createfile tfa/a catch {file delete tfa} } -cleanup { file delete -force tfa } -result 1 test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { file mkdir tfa createfile tfa/a catch {file delete tfa} } -cleanup { file delete -force tfa } -result 1 test fCmd-16.9 {error while deleting file} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot notWsl} -body { file mkdir tfa createfile tfa/a file attributes tfa -permissions 0o555 catch {file delete tfa/a} ####### ####### If any directory in a tree that is being removed does not have ####### write permission, the process will fail! This is also the case ####### with "rm -rf" ####### } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa } -result 1 test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2} } -body { createfile tfa1 createfile tfa2 file delete tfa1 tfa2 list [file exists tfa1] [file exists tfa2] } -result {0 0} test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file delete tfa } -result {} # More coverage tests for mkpath() test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup { catch {file delete -force -- tfa1} } -constraints {unix notRoot notWsl} -body { file mkdir tfa1 file attributes tfa1 -permissions 0o555 catch {file mkdir tfa1/tfa2} } -cleanup { file attributes tfa1 -permissions 0o777 file delete -force tfa1 } -result 1 test fCmd-17.2 {mkdir several levels deep - relative} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file mkdir tfa/a/b file isdir tfa/a/b } -cleanup { file delete tfa/a/b tfa/a tfa } -result 1 test fCmd-17.3 {mkdir several levels deep - absolute} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { set f [file join [pwd] tfa a] file mkdir $f file isdir $f } -cleanup { file delete $f [file join [pwd] tfa] } -result 1 # # Functionality tests for TclFileRenameCmd() # test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \ -setup { catch {file delete -force -- tfad} set savedDir [pwd] } -constraints {notRoot} -body { file mkdir tfad/dir cd tfad/dir set s [createfile foo] file rename foo bar file rename bar ./foo file rename ./foo bar file rename ./bar ./foo file rename foo ../dir/bar file rename ../dir/bar ./foo file rename ../../tfad/dir/foo ../../tfad/dir/bar file rename [file join [pwd] bar] foo file rename foo [file join [pwd] bar] list [checkcontent bar $s] [file exists foo] } -cleanup { cd $savedDir file delete -force tfad } -result {1 0} test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { file mkdir tfa1 file rename tfa1 tfa2 list [file exists tfa2] [file exists tfa1] } -cleanup { file delete tfa2 } -result {1 0} test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} -setup { catch {file delete -force -- tfa1 tfad1 tfad2} } -constraints {notRoot} -body { set s [createfile tfa1] file mkdir tfad1 tfad2 file rename tfa1 tfad1 tfad2 list [checkcontent tfad2/tfa1 $s] [file isdir tfad2/tfad1] \ [file exists tfa1] [file exists tfad1] } -cleanup { file delete tfad2/tfa1 file delete -force tfad2 } -result {1 1 0 0} test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { set s [createfile tfa] file mkdir tfad list [catch {file rename tfad tfa}] [checkcontent tfa $s] [file isdir tfad] } -cleanup { file delete tfa tfad } -result {1 1 1} test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { set s [createfile tfa] file mkdir tfad/tfa list [catch {file rename tfa tfad}] [checkcontent tfa $s] \ [file isdir tfad/tfa] } -cleanup { file delete -force tfa tfad } -result {1 1 1} # # On Windows there is no easy way to determine if two files are the same # test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { set s [createfile tfa] list [catch {file rename tfa tfa}] [checkcontent tfa $s] } -cleanup { file delete tfa } -result {1 1} test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { file mkdir tfa tfad/tfa list [catch {file rename tfa tfad}] [file isdir tfa] } -cleanup { file delete -force tfa tfad } -result {1 1} test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot notNetworkFilesystem} -body { file mkdir tfa tfad/tfa file rename -force tfa tfad file isdir tfa } -cleanup { file delete -force tfad } -result 0 test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { file mkdir tfa tfad/tfa/file list [catch {file rename tfa tfad}] [file isdir tfa] \ [file isdir tfad/tfa/file] } -cleanup { file delete -force tfa tfad } -result {1 1 1} test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot notNetworkFilesystem} -body { file mkdir tfa tfad/tfa/file list [catch {file rename -force tfa tfad}] [file isdir tfa] \ [file isdir tfad/tfa/file] } -cleanup { file delete -force tfa tfad } -result {1 1 1} test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} -setup { catch {file delete -force -- tfa1} } -constraints {notRoot} -body { list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2] } -result {1 0 0} test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} } -constraints {unix notRoot} -body { set s [createfile tfa1] file link -symbolic tfa2 tfa1 file rename tfa2 tfa3 file type tfa3 } -cleanup { file delete tfa1 tfa3 } -result link test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} } -constraints {unix notRoot} -body { file mkdir tfa1 file link -symbolic tfa2 tfa1 file rename tfa2 tfa3 file type tfa3 } -cleanup { file delete tfa1 tfa3 } -result link test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} } -constraints {unix notRoot} -body { file mkdir tfa1/a/b/c/d file mkdir tfa2 set f [file join [pwd] tfa1/a/b] set f2 [file join [pwd] {tfa2/b alias}] file link -symbolic $f2 $f file rename {tfa2/b alias/c} tfa3 list [file isdir tfa3] [file exists tfa1/a/b/c] } -cleanup { file delete -force tfa1 tfa2 tfa3 } -result {1 0} test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup { catch {file delete -force -- tfa1 tfa2 tfalink} } -constraints {unix notRoot} -body { file mkdir tfa1 set s [createfile tfa2] file link -symbolic tfalink tfa1 file rename tfa2 tfalink checkcontent tfa1/tfa2 $s } -cleanup { file delete -force tfa1 tfalink } -result 1 test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup { catch {file delete -force -- tfa1 tfalink} } -constraints {unix notRoot} -body { file mkdir tfa1 file link -symbolic tfalink tfa1 file delete tfa1 file rename tfalink tfa2 file type tfa2 } -cleanup { file delete tfa2 } -result link # # Coverage tests for TclUnixRmdir # test fCmd-19.1 {remove empty directory} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { file mkdir tfa file delete tfa file exists tfa } -result {0} test fCmd-19.2 {rmdir error besides EEXIST} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot notWsl} -body { file mkdir tfa file mkdir tfa/a file attributes tfa -permissions 0o555 catch {file delete tfa/a} } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa } -result 1 test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { file mkdir tfa file mkdir tfa/a file delete -force tfa file exists tfa } -result {0} # # TclUnixDeleteFile and TraversalDelete are covered by tests from the # TclDeleteFilesCmd suite # # # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd # test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot notWsl} -body { file mkdir tfa file mkdir tfa/a file attributes tfa/a -permissions 0o000 catch {file delete -force tfa} } -cleanup { file attributes tfa/a -permissions 0o777 file delete -force tfa } -result 1 test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa for {set i 1} {$i <= 300} {incr i} { createfile tfa/testfile_$i } file delete -force tfa } -cleanup { while {[catch {file delete -force tfa}]} {} } -result {} # # Feature testing for TclCopyFilesCmd # test fCmd-21.1 {copy : single file to nonexistant} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { set s [createfile tfa1] file copy tfa1 tfa2 list [checkcontent tfa2 $s] [checkcontent tfa1 $s] } -cleanup { file delete tfa1 tfa2 } -result {1 1} test fCmd-21.2 {copy : single dir to nonexistant} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { file mkdir tfa1 file copy tfa1 tfa2 list [file isdir tfa2] [file isdir tfa1] } -cleanup { file delete tfa1 tfa2 } -result {1 1} test fCmd-21.3 {copy : single file into directory} -setup { catch {file delete -force -- tfa1 tfad} } -constraints {notRoot} -body { set s [createfile tfa1] file mkdir tfad file copy tfa1 tfad list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s] } -cleanup { file delete -force tfa1 tfad } -result {1 1} test fCmd-21.4 {copy : more than one source and target is not a directory} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} } -constraints {notRoot} -body { createfile tfa1 createfile tfa2 createfile tfa3 catch {file copy tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 } -result 1 test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2 tfad} } -body { set s1 [createfile tfa1] set s2 [createfile tfa2] file mkdir tfad file copy tfa1 tfa2 tfad list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \ [checkcontent tfa1 $s1] [checkcontent tfa2 $s2] } -cleanup { file delete -force tfa1 tfa2 tfad } -result {1 1 1 1} test fCmd-21.6 {copy: mixed dirs and files into directory} -setup { catch {file delete -force -- tfa1 tfad1 tfad2} } -constraints {notRoot notFileSharing} -body { set s [createfile tfa1] file mkdir tfad1 tfad2 file copy tfa1 tfad1 tfad2 list [checkcontent [file join tfad2 tfa1] $s] \ [file isdir [file join tfad2 tfad1]] \ [checkcontent tfa1 $s] [file isdir tfad1] } -cleanup { file delete -force tfa1 tfad1 tfad2 } -result {1 1 1 1} test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} -setup { catch {file delete -force tfad1 tfalink tfalink2} } -constraints {unix notRoot dontCopyLinks} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file delete tfad1 file copy tfalink tfalink2 } -returnCodes error -cleanup { file delete -force tfalink tfalink2 } -result {error copying "tfalink": the target of this link doesn't exist} test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} -setup { catch {file delete -force tfad1 tfalink tfalink2} } -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file delete tfad1 file copy tfalink tfalink2 file type tfalink2 } -cleanup { file delete tfalink tfalink2 } -result link test fCmd-21.8.1 {TclCopyFilesCmd: copy a link} -setup { catch {file delete -force tfad1 tfalink tfalink2} } -constraints {unix notRoot dontCopyLinks} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file copy tfalink tfalink2 list [file type tfalink] [file type tfalink2] [file isdir tfad1] } -cleanup { file delete -force tfad1 tfalink tfalink2 } -result {link directory 1} test fCmd-21.8.2 {TclCopyFilesCmd: copy a link} -setup { catch {file delete -force tfad1 tfalink tfalink2} } -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file copy tfalink tfalink2 list [file type tfalink] [file type tfalink2] [file isdir tfad1] } -cleanup { file delete -force tfad1 tfalink tfalink2 } -result {link link 1} test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} -setup { catch {file delete -force tfad1 tfad2} } -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfad1/tfalink "[pwd]/tfad1" file copy tfad1 tfad2 file type tfad2/tfalink } -cleanup { file delete -force tfad1 tfad2 } -result link test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { file mkdir tfa [file join tfad tfa] list [catch {file copy tfa tfad}] [file isdir tfa] } -cleanup { file delete -force tfa tfad } -result {1 1} test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { file mkdir tfa [file join tfad tfa file] list [catch {file copy tfa tfad}] [file isdir tfa] \ [file isdir [file join tfad tfa file]] } -cleanup { file delete -force tfa tfad } -result {1 1 1} test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { file mkdir tfa [file join tfad tfa file] list [catch {file copy -force tfa tfad}] [file isdir tfa] \ [file isdir [file join tfad tfa file]] } -cleanup { file delete -force tfa tfad } -result {1 1 1} # # Coverage testing for TclpRenameFile # test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { set s [createfile tfa1] set s2 [createfile tfa2 q] set result [catch {file rename tfa1 tfa2}] file rename -force tfa1 tfa2 lappend result [checkcontent tfa2 $s] } -cleanup { file delete [glob tfa1 tfa2] } -result {1 1} test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup { catch {file delete -force -- tfa1} } -constraints {unix notRoot} -body { set s [createfile tfa1] file rename -force tfa1 tfa1 checkcontent tfa1 $s } -cleanup { file delete tfa1 } -result 1 test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup { catch {file delete -force -- d1 tfad} } -constraints {notRoot} -body { file mkdir d1 [file join tfad d1] list [catch {file rename d1 tfad}] [file isdir d1] \ [file isdir [file join tfad d1]] } -cleanup { file delete -force d1 tfad } -result {1 1 1} test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} -setup { catch {file delete -force -- d1 tfad} } -constraints {notRoot} -body { file mkdir d1 [file join tfad a b c] file rename d1 [file join tfad a b c d1] list [file isdir d1] [file isdir [file join tfad a b c d1]] } -cleanup { file delete -force [glob d1 tfad] } -result {0 1} # # TclMacCopyFile needs to be redone. # test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { set s [createfile tfa1] set s2 [createfile tfa2 q] set result [catch {file copy tfa1 tfa2}] file copy -force tfa1 tfa2 lappend result [checkcontent tfa2 $s] [checkcontent tfa1 $s] } -cleanup { file delete tfa1 tfa2 } -result {1 1 1} # # TclMacMkdir - basic cases are covered elsewhere. # Error cases are not covered. # # # TclMacRmdir # Error cases are not covered. # test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup { catch {file delete -force -- tfad} } -constraints {notRoot} -body { file mkdir [file join tfad dir] list [catch {file delete tfad}] [file delete -force tfad] } -cleanup { catch {file delete -force tfad} } -result {1 {}} # # TclMacDeleteFile # Error cases are not covered. # test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} -setup { catch {file delete -force -- tfa1} } -constraints {notRoot} -body { createfile tfa1 file delete tfa1 file exists tfa1 } -cleanup { catch {file delete -force tfa1} } -result {0} # # TclMacCopyDirectory # Error cases are not covered. # test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} -setup { catch {file delete -force -- tfad1 tfad2} } -constraints {notRoot notFileSharing} -body { file mkdir [file join tfad1 a b c] file copy tfad1 tfad2 list [file isdir [file join tfad1 a b c]] \ [file isdir [file join tfad2 a b c]] } -cleanup { file delete -force tfad1 tfad2 } -result {1 1} test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} -setup { catch {file delete -force -- tfad1 tfad2} } -constraints {notRoot notFileSharing} -body { file mkdir tfad1 file copy tfad1 tfad2 list [file isdir tfad1] [file isdir tfad2] } -cleanup { file delete tfad1 tfad2 } -result {1 1} test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup { catch {file delete -force -- tfad1 tfad2} } -constraints {notRoot notFileSharing} -body { file mkdir [file join tfad1 x y z] file mkdir [file join tfad2 dir] file copy tfad1 [file join tfad2 dir] list [file isdir [file join tfad1 x y z]] \ [file isdir [file join tfad2 dir tfad1 x y z]] } -cleanup { file delete -force tfad1 tfad2 } -result {1 1} # # Functionality tests for TclDeleteFilesCmd # test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup { catch {file delete -force -- tfad1 tfad2} } -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file delete tfalink list [file isdir tfad1] [file exists tfalink] } -cleanup { file delete tfad1 catch {file delete tfalink} } -result {1 0} test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} -setup { catch {file delete -force -- tfad1 tfad2} } -constraints {unix notRoot} -body { file mkdir tfad1 file mkdir tfad2 file link -symbolic [file join tfad2 link] [file join .. tfad1] file delete -force tfad2 list [file isdir tfad1] [file exists tfad2] } -cleanup { file delete tfad1 } -result {1 0} test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} -setup { catch {file delete -force -- tfad1 tfad2} } -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfad2 tfad1 file delete tfad1 file delete tfad2 list [file exists tfad1] [file exists tfad2] } -result {0 0} # There is no fCmd-27.1 test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup { set platform [testgetplatform] } -constraints {testsetplatform} -body { testsetplatform unix file attributes ~_totally_bogus_user } -returnCodes error -cleanup { testsetplatform $platform } -result {user "_totally_bogus_user" doesn't exist} test fCmd-27.3 {TclFileAttrsCmd - all attributes} -setup { catch {file delete -force -- foo.tmp} } -body { createfile foo.tmp file attributes foo.tmp # Must be non-empty result } -cleanup { file delete -force -- foo.tmp } -match glob -result {?*} test fCmd-27.4 {TclFileAttrsCmd - getting one option} -setup { catch {file delete -force -- foo.tmp} } -body { createfile foo.tmp set attrs [file attributes foo.tmp] file attributes foo.tmp {*}[lindex $attrs 0] # Any successful result will do } -cleanup { file delete -force -- foo.tmp } -match glob -result * test fCmd-27.5 {TclFileAttrsCmd - setting one option} -setup { catch {file delete -force -- foo.tmp} } -constraints {foundGroup} -body { createfile foo.tmp set attrs [file attributes foo.tmp] file attributes foo.tmp {*}[lrange $attrs 0 1] } -cleanup { file delete -force -- foo.tmp } -result {} test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup { catch {file delete -force -- foo.tmp} } -constraints {foundGroup} -body { createfile foo.tmp set attrs [file attributes foo.tmp] file attributes foo.tmp {*}[lrange $attrs 0 3] } -cleanup { file delete -force -- foo.tmp } -result {} if { [testConstraint win] && ($::tcl_platform(osVersion) < 5.0 || [lindex [file system [temporaryDirectory]] 1] ne "NTFS") } then { testConstraint linkDirectory 0 testConstraint linkFile 0 } test fCmd-28.1 {file link} -returnCodes error -body { file link } -result {wrong # args: should be "file link ?-linktype? linkname ?target?"} test fCmd-28.2 {file link} -returnCodes error -body { file link a b c d } -result {wrong # args: should be "file link ?-linktype? linkname ?target?"} test fCmd-28.3 {file link} -returnCodes error -body { file link abc b c } -result {bad option "abc": must be -symbolic or -hard} test fCmd-28.4 {file link} -returnCodes error -body { file link -abc b c } -result {bad option "-abc": must be -symbolic or -hard} cd [workingDirectory] makeDirectory abc.dir makeDirectory abc2.dir makeFile contents abc.file makeFile contents abc2.file cd [temporaryDirectory] test fCmd-28.5 {file link: source already exists} -setup { cd [temporaryDirectory] } -constraints {linkDirectory} -body { file link abc.dir abc2.dir } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "abc.dir": that path already exists} test fCmd-28.6 {file link: unsupported operation} -setup { cd [temporaryDirectory] } -constraints {linkDirectory win} -body { file link -hard abc.link abc.dir } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory} test fCmd-28.7 {file link: source already exists} -setup { cd [temporaryDirectory] } -constraints {linkFile} -body { file link abc.file abc2.file } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "abc.file": that path already exists} # In Windows 10 developer mode, we _can_ create symbolic links to files! test fCmd-28.8 {file link} -constraints {linkFile winLessThan10} -setup { cd [temporaryDirectory] } -body { file link -symbolic abc.link abc.file } -cleanup { file delete -force abc.link cd [workingDirectory] } -returnCodes error -result {could not create new link "abc.link" pointing to "abc.file": invalid argument} test fCmd-28.9 {file link: success with file} -constraints {linkFile} -setup { cd [temporaryDirectory] file delete -force abc.link } -body { file link abc.link abc.file } -cleanup { cd [workingDirectory] } -result abc.file test fCmd-28.9.1 {file link: success with file} -setup { cd [temporaryDirectory] file delete -force abc.link } -constraints {linkFile win} -body { file stat abc.file arr set res $arr(nlink) lappend res [catch {file link abc.link abc.file} msg] $msg file stat abc.file arr lappend res $arr(nlink) } -cleanup { cd [workingDirectory] } -result {1 0 abc.file 2} cd [temporaryDirectory] catch {file delete -force abc.link} cd [workingDirectory] test fCmd-28.10 {file link: linking to nonexistent path} -setup { cd [temporaryDirectory] file delete -force abc.link } -constraints {linkDirectory} -body { file link abc.link abc2.doesnt } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "abc.link": target "abc2.doesnt" doesn't exist} test fCmd-28.10.1 {file link: linking to nonexistent path} -setup { cd [temporaryDirectory] file delete -force abc.link } -constraints {linkDirectory} -body { file link doesnt/abc.link abc.dir } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "doesnt/abc.link": no such file or directory} test fCmd-28.11 {file link: success with directory} -setup { cd [temporaryDirectory] file delete -force abc.link } -constraints {linkDirectory} -body { file link abc.link abc.dir } -cleanup { cd [workingDirectory] } -result abc.dir test fCmd-28.12 {file link: cd into a link} -setup { cd [temporaryDirectory] file delete -force abc.link } -constraints {linkDirectory} -body { file link abc.link abc.dir set orig [pwd] cd abc.link set dir [pwd] cd .. set up [pwd] cd $orig # Now '$up' should be either $orig or [file dirname abc.dir], depending on # whether 'cd' actually moves to the destination of a link, or simply # treats the link as a directory. (On windows the former, on Unix the # latter, I believe) if { ([file normalize $up] ne [file normalize $orig]) && ([file normalize $up] ne [file normalize [file dirname abc.dir]]) } then { return "wrong directory with 'cd abc.link ; cd ..': \ \"[file normalize $up]\" should be \"[file normalize $orig]\"\ or \"[file normalize [file dirname abc.dir]]\"" } else { return "ok" } } -cleanup { file delete -force abc.link cd [workingDirectory] } -result ok test fCmd-28.13 {file link} -constraints {linkDirectory} -setup { cd [temporaryDirectory] file link abc.link abc.dir } -body { # duplicate link throws error file link abc.link abc.dir } -returnCodes error -cleanup { file delete -force abc.link cd [workingDirectory] } -result {could not create new link "abc.link": that path already exists} test fCmd-28.14 {file link: deletes link not dir} -setup { cd [temporaryDirectory] } -constraints {linkDirectory} -body { file delete -force abc.link list [file exists abc.link] [file exists abc.dir] } -cleanup { cd [workingDirectory] } -result {0 1} test fCmd-28.15.1 {file link: copies link not dir} -setup { cd [temporaryDirectory] file delete -force abc.link } -constraints {linkDirectory dontCopyLinks} -body { file link abc.link abc.dir file copy abc.link abc2.link # abc2.linkdir was a copy of a link to a dir, so it should end up as a # directory, not a link (links trace to endpoint). list [file type abc2.link] [file tail [file link abc.link]] } -cleanup { file delete -force abc.link cd [workingDirectory] } -result {directory abc.dir} test fCmd-28.15.2 {file link: copies link not dir} -setup { cd [temporaryDirectory] file delete -force abc.link } -constraints {linkDirectory} -body { file link abc.link abc.dir file copy abc.link abc2.link list [file type abc2.link] [file tail [file link abc2.link]] } -cleanup { file delete -force abc.link cd [workingDirectory] } -result {link abc.dir} cd [temporaryDirectory] file delete -force abc.link file delete -force abc2.link cd abc.dir file delete -force abc.file file delete -force abc2.file cd .. file copy abc.file abc.dir file copy abc2.file abc.dir cd [workingDirectory] test fCmd-28.16 {file link: glob inside link} -setup { cd [temporaryDirectory] file delete -force abc.link } -constraints {linkDirectory} -body { file link abc.link abc.dir lsort [glob -dir abc.link -tails *] } -cleanup { file delete -force abc.link cd [workingDirectory] } -result {abc.file abc2.file} test fCmd-28.17 {file link: glob -type l} -setup { cd [temporaryDirectory] file link abc.link abc.dir } -constraints {linkDirectory} -body { glob -dir [pwd] -type l -tails abc* } -cleanup { file delete -force abc.link cd [workingDirectory] } -result {abc.link} test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup { cd [temporaryDirectory] file link abc.link abc.dir } -body { lsort [glob -dir [pwd] -type d -tails abc*] } -cleanup { file delete -force abc.link cd [workingDirectory] } -result [lsort [list abc.link abc.dir abc2.dir]] test fCmd-28.19 {file link: relative paths} -setup { cd [temporaryDirectory] } -constraints {win linkDirectory} -body { file mkdir d1/d2/d3 file link d1/l2 d1/d2 } -cleanup { catch {file delete -force d1} cd [workingDirectory] } -result d1/d2 test fCmd-28.20 {file link: relative paths} -setup { cd [temporaryDirectory] } -constraints {unix linkDirectory} -body { file mkdir d1/d2/d3 file link d1/l2 d1/d2 } -returnCodes error -cleanup { catch {file delete -force d1} cd [workingDirectory] } -result {could not create new link "d1/l2": target "d1/d2" doesn't exist} test fCmd-28.21 {file link: relative paths} -setup { cd [temporaryDirectory] } -constraints {unix linkDirectory} -body { file mkdir d1/d2/d3 file link d1/l2 d2 } -cleanup { catch {file delete -force d1} cd [workingDirectory] } -result d2 test fCmd-28.22 {file link: relative paths} -setup { cd [temporaryDirectory] } -constraints {unix linkDirectory} -body { file mkdir d1/d2/d3 catch {file delete -force d1/l2} file link d1/l2 d2/d3 } -cleanup { catch {file delete -force d1} cd [workingDirectory] } -result d2/d3 try { cd [temporaryDirectory] file delete -force abc.link file delete -force d1/d2 file delete -force d1 } finally { cd [workingDirectory] } removeFile abc2.file removeFile abc.file removeDirectory abc2.dir removeDirectory abc.dir test fCmd-29.1 {weird memory corruption fault} -body { open [file join ~a_totally_bogus_user_id/foo bar] } -returnCodes error -match glob -result * test fCmd-30.1 {file writable on 'My Documents'} -setup { # Get the localized version of the folder name by looking in the registry. set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal] } -constraints {win reg} -body { file writable $mydocsname } -result 1 test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body { expr {[info exists env(USERPROFILE)] && [file exists $env(USERPROFILE)/NTUSER.DAT] && [file readable $env(USERPROFILE)/NTUSER.DAT]} } -result 1 # At least one CI environment (GitHub Actions) is set up with the page file in # an unusual location; skip the test if that is so. test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints { win notContinuousIntegration } -body { set r {} if {[info exists env(SystemDrive)]} { set path $env(SystemDrive)/pagefile.sys lappend r exists [file exists $path] lappend r readable [file readable $path] lappend r stat [catch {file stat $path a} e] $e } return $r } -result {exists 1 readable 0 stat 0 {}} # cleanup cleanup if {[testConstraint unix]} { removeDirectory tcl[pid] /tmp } ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/fileName.test0000644000175000017500000015676714554262142015453 0ustar sergeisergei# This file tests the filename manipulation routines. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testtranslatefilename [llength [info commands testtranslatefilename]] testConstraint linkDirectory 1 testConstraint symbolicLinkFile 1 if {[testConstraint win]} { if {$::tcl_platform(osVersion) < 5.0 \ || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} { testConstraint linkDirectory 0 } testConstraint symbolicLinkFile 0 testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}] } # This match compares the first two words of the result. If the wanted result # is "equal", then this is successful if the words are equal. If the wanted # result is "not equal", then this is successful if the words are different. customMatch compareWords {apply {{a b} { lassign $b w1 w2 expr {$a eq "equal" ? $w1 eq $w2 : $w1 ne $w2} }}} proc touch filename {catch {close [open $filename w]}} global env if {[testConstraint testsetplatform]} { set platform [testgetplatform] } # Caution: when using 'testsetplatform' to test different file name platform # descriptions in this file, one must be very careful not to combine such # platform manipulation with commands like 'cd', 'pwd'. That is because the # latter commands operate on the real filesystem but will potentially have # their logic routed through the wrong generic code paths if we've used # 'testsetplatform'. This can lead to serious problems, even crashes. test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype / } absolute test filename-1.2 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype /foo } absolute test filename-1.3 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype foo } relative test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype c:/foo } relative test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~ } absolute test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~/foo } absolute test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~foo } absolute test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ./~foo } relative test filename-3.1 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype / } volumerelative test filename-3.2 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype \\ } volumerelative test filename-3.3 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype /foo } volumerelative test filename-3.4 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype \\foo } volumerelative test filename-3.5 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:/ } absolute test filename-3.6 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:\\ } absolute test filename-3.7 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:/foo } absolute test filename-3.8 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:\\foo } absolute test filename-3.9 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c: } volumerelative test filename-3.10 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:foo } volumerelative test filename-3.11 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype foo } relative test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype //foo/bar } absolute test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~foo } absolute test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~ } absolute test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~/foo } absolute test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ./~foo } relative test filename-4.1 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split / } {/} test filename-4.2 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo } {/ foo} test filename-4.3 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/bar } {/ foo bar} test filename-4.4 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/bar/baz } {/ foo bar baz} test filename-4.5 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar } {foo bar} test filename-4.6 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ./foo/bar } {. foo bar} test filename-4.7 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/../././foo/bar } {/ foo .. . . foo bar} test filename-4.8 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../foo/bar } {.. foo bar} test filename-4.9 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split {} } {} test filename-4.10 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split . } {.} test filename-4.11 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../ } {..} test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../.. } {.. ..} test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split //foo } "/ foo" test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo//bar } {foo bar} test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo } {~foo} test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar } {~foo ./~bar} test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar/~baz } {~foo ./~bar ./~baz} test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar~/baz } {foo bar~ baz} if {[testConstraint testsetplatform]} { testsetplatform $platform } test filename-4.19 {Tcl_SplitPath} -setup { set oldDir [pwd] cd [temporaryDirectory] } -body { file mkdir tildetmp set nastydir [file join tildetmp ./~tilde] file mkdir $nastydir set norm [file normalize $nastydir] cd tildetmp cd ./~tilde glob -nocomplain * set idx [string first tildetmp $norm] set norm [string range $norm $idx end] # fix path away so all platforms are the same regsub {(.*):$} $norm {\1} norm regsub -all ":" $norm "/" norm # make sure we can delete the directory we created cd $oldDir file delete -force $nastydir return $norm } -cleanup { cd $oldDir catch {file delete -force [file join [temporaryDirectory] tildetmp]} } -result {tildetmp/~tilde} test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split / } {/} test filename-6.2 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo } {/ foo} test filename-6.3 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/bar } {/ foo bar} test filename-6.4 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/bar/baz } {/ foo bar baz} test filename-6.5 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo/bar } {foo bar} test filename-6.6 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ./foo/bar } {. foo bar} test filename-6.7 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/../././foo/bar } {/ foo .. . . foo bar} test filename-6.8 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../foo/bar } {.. foo bar} test filename-6.9 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split {} } {} test filename-6.10 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split . } {.} test filename-6.11 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../ } {..} test filename-6.12 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../.. } {.. ..} test filename-6.13 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split //foo } {/ foo} test filename-6.14 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo//bar } {foo bar} test filename-6.15 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} test filename-6.16 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} test filename-6.17 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} test filename-6.18 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split \\\\foo\\bar } {//foo/bar} test filename-6.19 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split \\\\foo\\bar/baz } {//foo/bar baz} test filename-6.20 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/foo } {c:/ foo} test filename-6.21 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:foo } {c: foo} test filename-6.22 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c: } {c:} test filename-6.23 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:\\ } {c:/} test filename-6.24 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/ } {c:/} test filename-6.25 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/./.. } {c:/ . ..} test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo } {~foo} test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar } {~foo ./~bar} test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar/~baz } {~foo ./~bar ./~baz} test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo/bar~/baz } {foo bar~ baz} test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:~foo } {c: ./~foo} test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join / a } {/a} test filename-7.2 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a b } {a/b} test filename-7.3 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a c /b d } {/b/d} test filename-7.4 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join / } {/} test filename-7.5 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a } {a} test filename-7.6 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join {} } {} test filename-7.7 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a/ b } {/a/b} test filename-7.8 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a// b } {/a/b} test filename-7.9 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a/./../. b } {/a/./.././b} test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ~ a } {~/a} test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ~a ~b } {~b} test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a b } {./~a/b} test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ~b } {~b} test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ./~b } {./~a/~b} test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . b } {a/./b} test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . ./~b } {a/./~b} test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join //a b } "/a/b" test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /// a b } "/a/b" test filename-7.19 {[Bug f34cf83dd0]} { file join foo //bar } /bar test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join a b } {a/b} test filename-9.2 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /a b } {/a/b} test filename-9.3 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /a /b } {/b} test filename-9.4 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c: foo } {c:foo} test filename-9.5 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c:/ foo } {c:/foo} test filename-9.6 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c:\\bar foo } {c:/bar/foo} test filename-9.7 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /foo c:bar } {c:bar} test filename-9.8 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ///host//share dir } {//host/share/dir} test filename-9.9 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~ foo } {~/foo} test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~/~foo } {~/~foo} test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~ ./~foo } {~/~foo} test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join / ~foo } {~foo} test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ./a/ b c } {./a/b/c} test filename-9.14 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ./~a/ b c } {./~a/b/c} test filename-9.15 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join // host share path } {/host/share/path} test filename-9.16 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo . bar } {foo/./bar} test filename-9.17 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo .. bar } {foo/../bar} test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo/./bar } {foo/./bar} test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win set res {} lappend res \ [file join {C:\foo\bar}] \ [file join C:/blah {C:\foo\bar}] \ [file join C:/blah C:/blah {C:\foo\bar}] } {C:/foo/bar C:/foo/bar C:/foo/bar} test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win set res {} lappend res \ [file join {foo\bar}] \ [file join C:/blah {foo\bar}] \ [file join C:/blah C:/blah {foo\bar}] } {foo/bar C:/blah/foo/bar C:/blah/foo/bar} test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform win} { testsetplatform win set res {} lappend res \ [file join {foo\bar}] \ [file join [pwd] {foo\bar}] \ [file join [pwd] [pwd] {foo\bar}] set nres {} foreach elt $res { lappend nres [string map [list [pwd] pwd] $elt] } set nres } {foo/bar pwd/foo/bar pwd/foo/bar} test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix set res {} lappend res \ [file join {/foo/bar}] \ [file join /x {/foo/bar}] \ [file join /x /x {/foo/bar}] } {/foo/bar /foo/bar /foo/bar} test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win set res {} lappend res \ [file join {foo\bar}] \ [file join C:/blah {foo\bar}] \ [file join C:/blah C:/blah {foo\bar}] string map [list C:/blah ""] $res } {foo/bar /foo/bar /foo/bar} test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix set res {} lappend res \ [file join {foo/bar}] \ [file join /x {foo/bar}] \ [file join /x /x {foo/bar}] string map [list /x ""] $res } {foo/bar /foo/bar /foo/bar} test filename-10.1 {Tcl_TranslateFileName} -body { testsetplatform unix testtranslatefilename foo } -result {foo} -constraints {testsetplatform testtranslatefilename} test filename-10.2 {Tcl_TranslateFileName} -body { testsetplatform windows testtranslatefilename {c:/foo} } -result {c:\foo} -constraints {testsetplatform testtranslatefilename} test filename-10.3 {Tcl_TranslateFileName} -body { testsetplatform windows testtranslatefilename {c:/\\foo/} } -result {c:\foo} -constraints {testsetplatform testtranslatefilename} test filename-10.3.1 {Tcl_TranslateFileName} -body { testsetplatform windows testtranslatefilename {c://///} } -result c:\\ -constraints {testsetplatform testtranslatefilename} test filename-10.6 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { set env(HOME) "/home/test" testsetplatform unix testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp } -result {/home/test/foo} test filename-10.7 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { unset env(HOME) testsetplatform unix testtranslatefilename ~/foo } -returnCodes error -cleanup { set env(HOME) $temp } -result {couldn't find HOME environment variable to expand path} test filename-10.8 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { set env(HOME) "/home/test" testsetplatform unix testtranslatefilename ~ } -cleanup { set env(HOME) $temp } -result {/home/test} test filename-10.9 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { set env(HOME) "/home/test/" testsetplatform unix testtranslatefilename ~ } -cleanup { set env(HOME) $temp } -result {/home/test} test filename-10.10 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { set env(HOME) "/home/test/" testsetplatform unix testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp } -result {/home/test/foo} test filename-10.17 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { set env(HOME) "\\home\\" testsetplatform windows testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp } -result {\home\foo} test filename-10.18 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { set env(HOME) "\\home\\" testsetplatform windows testtranslatefilename ~/foo\\bar } -cleanup { set env(HOME) $temp } -result {\home\foo\bar} test filename-10.19 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { set env(HOME) "c:" testsetplatform windows testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp } -result {c:foo} test filename-10.20 {Tcl_TranslateFileName} -returnCodes error -body { testtranslatefilename ~blorp/foo } -constraints {testtranslatefilename testtranslatefilename} \ -result {user "blorp" doesn't exist} test filename-10.21 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) } -constraints {testsetplatform testtranslatefilename} -body { set env(HOME) "c:\\" testsetplatform windows testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp } -result {c:\foo} test filename-10.22 {Tcl_TranslateFileName} -body { testsetplatform windows testtranslatefilename foo//bar } -constraints {testsetplatform testtranslatefilename} -result {foo\bar} if {[testConstraint testsetplatform]} { testsetplatform $platform } test filename-10.23 {Tcl_TranslateFileName} -body { # this test fails if ~ouster is not /home/ouster testtranslatefilename ~ouster } -constraints {nonPortable testtranslatefilename} -result {/home/ouster} test filename-10.24 {Tcl_TranslateFileName} -body { # this test fails if ~ouster is not /home/ouster testtranslatefilename ~ouster/foo } -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename} test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body { glob } -result {no files matched glob patterns ""} test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body { glob -gorp } -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --} test filename-11.3 {Tcl_GlobCmd} -body { glob -nocomplai } -result {} test filename-11.4 {Tcl_GlobCmd} -body { glob -nocomplain } -result {} test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body { glob -nocomplain * ~xyqrszzz } -result {user "xyqrszzz" doesn't exist} test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body { glob ~xyqrszzz } -result {user "xyqrszzz" doesn't exist} test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body { glob -- -nocomplain } -result {no files matched glob pattern "-nocomplain"} test filename-11.8 {Tcl_GlobCmd} -body { glob -nocomplain -- -nocomplain } -result {} test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob ~\\xyqrszzz/bar } -returnCodes error -result {user "\xyqrszzz" doesn't exist} test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob -nocomplain ~\\xyqrszzz/bar } -returnCodes error -result {user "\xyqrszzz" doesn't exist} test filename-11.11 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob ~xyqrszzz\\/\\bar } -returnCodes error -result {user "xyqrszzz" doesn't exist} test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup { testsetplatform unix set home $env(HOME) } -body { unset env(HOME) glob ~/* } -returnCodes error -cleanup { set env(HOME) $home } -result {couldn't find HOME environment variable to expand path} if {[testConstraint testsetplatform]} { testsetplatform $platform } test filename-11.13 {Tcl_GlobCmd} { file join [lindex [glob ~] 0] } [file join $env(HOME)] set oldpwd [pwd] set oldhome $env(HOME) catch {cd [makeDirectory tcl[pid]]} set env(HOME) [pwd] file delete -force globTest file mkdir globTest/a1/b1 file mkdir globTest/a1/b2 file mkdir globTest/a2/b3 file mkdir globTest/a3 touch globTest/x1.c touch globTest/y1.c touch globTest/z1.c touch "globTest/weird name.c" touch globTest/a1/b1/x2.c touch globTest/a1/b2/y2.c touch globTest/.1 touch globTest/x,z1.c test filename-11.14 {Tcl_GlobCmd} { glob ~/globTest } [list [file join $env(HOME) globTest]] test filename-11.15 {Tcl_GlobCmd} { glob ~\\/globTest } [list [file join $env(HOME) globTest]] test filename-11.16 {Tcl_GlobCmd} { glob globTest } {globTest} set globname "globTest" set horribleglobname "glob\[\{Test" set tildeglobname "./~test.txt" test filename-11.17 {Tcl_GlobCmd} {unix} { lsort [glob -directory $globname *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.17.1 {Tcl_GlobCmd} {win} { lsort [glob -directory $globname *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.17.2 {Tcl_GlobCmd} -setup { set dir [pwd] } -constraints {notRoot linkDirectory} -body { cd $globname file link -symbolic link a1 cd $dir lsort [glob -directory $globname -join * b1] } -cleanup { cd $dir file delete [file join $globname link] } -result [list [file join $globname a1 b1] \ [file join $globname link b1]] # Simpler version of the above test to illustrate a given bug. test filename-11.17.3 {Tcl_GlobCmd} -setup { set dir [pwd] } -constraints {notRoot linkDirectory} -body { cd $globname file link -symbolic link a1 cd $dir lsort [glob -directory $globname -type d *] } -cleanup { cd $dir file delete [file join $globname link] } -result [list [file join $globname a1] \ [file join $globname a2] \ [file join $globname a3] \ [file join $globname link]] # Make sure the bugfix isn't too simple. We don't want to break 'glob -type l' test filename-11.17.4 {Tcl_GlobCmd} -setup { set dir [pwd] } -constraints {notRoot linkDirectory} -body { cd $globname file link -symbolic link a1 cd $dir lsort [glob -directory $globname -type l *] } -cleanup { cd $dir file delete [file join $globname link] } -result [list [file join $globname link]] test filename-11.17.5 {Tcl_GlobCmd} { lsort [glob -directory $globname -tails *.c] } [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]] test filename-11.17.6 {Tcl_GlobCmd} { lsort [glob -directory $globname -tails *.c *.c] } [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \ [list "weird name.c" x,z1.c x1.c y1.c z1.c]]] test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} -setup { set dir [pwd] } -constraints {linkDirectory} -body { cd $globname file mkdir nonexistent file link -symbolic link nonexistent file delete nonexistent cd $dir lsort [glob -nocomplain -directory $globname -type l *] } -cleanup { cd $dir file delete [file join $globname link] } -result [list [file join $globname link]] test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} -setup { set dir [pwd] } -constraints {symbolicLinkFile} -body { cd $globname touch "nonexistent" file link -symbolic link nonexistent file delete nonexistent cd $dir lsort [glob -nocomplain -directory $globname -type l *] } -cleanup { cd $dir file delete [file join $globname link] } -result [list [file join $globname link]] test filename-11.18 {Tcl_GlobCmd} {unix} { lsort [glob -path $globname/ *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.18.1 {Tcl_GlobCmd} {win} { lsort [glob -path $globname/ *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.19 {Tcl_GlobCmd} {unix} { lsort [glob -join -path [string range $globname 0 5] * *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.19.1 {Tcl_GlobCmd} {win} { lsort [glob -join -path [string range $globname 0 5] * *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.20 {Tcl_GlobCmd} { lsort [glob -type d -dir $globname *] } [lsort [list [file join $globname a1]\ [file join $globname a2]\ [file join $globname a3]]] test filename-11.21 {Tcl_GlobCmd} { lsort [glob -type d -path $globname *] } [list $globname] test filename-11.21.1 {Tcl_GlobCmd} -body { touch {[tcl].testremains} lsort [glob -path {[tcl]} *] } -cleanup { file delete -force {[tcl].testremains} } -result {{[tcl].testremains}} # Get rid of file/dir if it exists, since it will have been left behind by a # previous failed run. file delete -force $horribleglobname file rename globTest $horribleglobname set globname $horribleglobname file delete -force $tildeglobname close [open $tildeglobname w] test filename-11.22 {Tcl_GlobCmd} {unix} { lsort [glob -dir $globname *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.22.1 {Tcl_GlobCmd} {win} { lsort [glob -dir $globname *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.23 {Tcl_GlobCmd} {unix} { lsort [glob -path $globname/ *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.23.1 {Tcl_GlobCmd} {win} { lsort [glob -path $globname/ *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.24 {Tcl_GlobCmd} {unix} { lsort [glob -join -path [string range $globname 0 5] * *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.24.1 {Tcl_GlobCmd} {win} { lsort [glob -join -path [string range $globname 0 5] * *] } [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-11.25 {Tcl_GlobCmd} { lsort [glob -type d -dir $globname *] } [lsort [list [file join $globname a1]\ [file join $globname a2]\ [file join $globname a3]]] test filename-11.25.1 {Tcl_GlobCmd} { lsort [glob -type {d r} -dir $globname *] } [lsort [list [file join $globname a1]\ [file join $globname a2]\ [file join $globname a3]]] test filename-11.25.2 {Tcl_GlobCmd} { lsort [glob -type {d r w} -dir $globname *] } [lsort [list [file join $globname a1]\ [file join $globname a2]\ [file join $globname a3]]] test filename-11.26 {Tcl_GlobCmd} { glob -type d -path $globname * } [list $globname] test filename-11.27 {Tcl_GlobCmd} -returnCodes error -body { glob -types abcde * } -result {bad argument to "-types": abcde} test filename-11.28 {Tcl_GlobCmd} -returnCodes error -body { glob -types z * } -result {bad argument to "-types": z} test filename-11.29 {Tcl_GlobCmd} -returnCodes error -body { glob -types {abcd efgh} * } -result {only one MacOS type or creator argument to "-types" allowed} test filename-11.30 {Tcl_GlobCmd} -returnCodes error -body { glob -types {{macintosh type TEXT} {macintosh creator ALFA} efgh} * } -result {only one MacOS type or creator argument to "-types" allowed} test filename-11.31 {Tcl_GlobCmd} -returnCodes error -body { glob -types } -result {missing argument to "-types"} test filename-11.32 {Tcl_GlobCmd} -returnCodes error -body { glob -path hello -dir hello * } -result {"-directory" cannot be used with "-path"} test filename-11.33 {Tcl_GlobCmd} -returnCodes error -body { glob -path } -result {missing argument to "-path"} test filename-11.34 {Tcl_GlobCmd} -returnCodes error -body { glob -direct } -result {missing argument to "-directory"} test filename-11.35 {Tcl_GlobCmd} -returnCodes error -body { glob -paths * } -result {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --} # Test '-tails' flag to glob. test filename-11.36 {Tcl_GlobCmd} -returnCodes error -body { glob -tails * } -result {"-tails" must be used with either "-directory" or "-path"} test filename-11.37 {Tcl_GlobCmd} { glob -type d -tails -path $globname * } [list $globname] test filename-11.38 {Tcl_GlobCmd} { glob -tails -path $globname * } [list $globname] test filename-11.39 {Tcl_GlobCmd} { glob -tails -join -path $globname * } [list $globname] test filename-11.40 {Tcl_GlobCmd} -body { list [glob -dir [pwd] -tails *] [glob *] } -match compareWords -result equal test filename-11.41 {Tcl_GlobCmd} -body { list [glob -dir [pwd] -tails *] [glob -dir [pwd] *] } -match compareWords -result "not equal" test filename-11.42 {Tcl_GlobCmd} -body { set res [list] foreach f [glob -dir [pwd] *] { set f [file tail $f] regsub {^./} $f {} f; # until glob bug [2511011fff] don't fixed (tilde expansion prevention). lappend res $f } list $res [glob *] } -match compareWords -result equal test filename-11.43 {Tcl_GlobCmd} -returnCodes error -body { glob -t * } -result {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --} test filename-11.44 {Tcl_GlobCmd} -returnCodes error -body { glob -tails -path hello -directory hello * } -result {"-directory" cannot be used with "-path"} test filename-11.45 {Tcl_GlobCmd on root volume} -setup { set res1 "" set res2 "" set tmpd [pwd] } -body { catch { set res1 [glob -dir [lindex [file volumes] end] -tails *] } catch { cd [lindex [file volumes] end] set res2 [glob *] } list $res1 $res2 } -cleanup { cd $tmpd } -match compareWords -result equal test filename-11.46 {Tcl_GlobCmd} -returnCodes error -body { glob -types abcde -dir foo * } -result {bad argument to "-types": abcde} test filename-11.47 {Tcl_GlobCmd} -returnCodes error -body { glob -types abcde -path foo * } -result {bad argument to "-types": abcde} test filename-11.48 {Tcl_GlobCmd} -returnCodes error -body { glob -types abcde -dir foo -join * * } -result {bad argument to "-types": abcde} test filename-11.49 {Tcl_GlobCmd} -returnCodes error -body { glob -types abcde -path foo -join * * } -result {bad argument to "-types": abcde} test filename-11.50 {Tcl_GlobCmd} -returnCodes error -body { glob -path hello -path salut * } -result {"-path" may only be used once} test filename-11.51 {Tcl_GlobCmd} -returnCodes error -body { glob -dir hello -dir salut * } -result {"-directory" may only be used once} file rename $horribleglobname globTest file delete -force $tildeglobname set globname globTest unset horribleglobname tildeglobname test filename-12.1 {simple globbing} {unixOrWin} { glob {} } {.} test filename-12.1.1 {simple globbing} -constraints {unixOrWin} -body { glob -types f {} } -returnCodes error -result {no files matched glob pattern ""} test filename-12.1.2 {simple globbing} {unixOrWin} { glob -types d {} } {.} test filename-12.1.3 {simple globbing} {unix} { glob -types hidden {} } {.} test filename-12.1.4 {simple globbing} -constraints {win} -body { glob -types hidden {} } -returnCodes error -result {no files matched glob pattern ""} test filename-12.1.5 {simple globbing} -constraints {win} -body { glob -types hidden c:/ } -returnCodes error -result {no files matched glob pattern "c:/"} test filename-12.1.6 {simple globbing} {win} { glob c:/ } {c:/} test filename-12.3 {simple globbing} { glob -nocomplain \{a1,a2\} } {} set globPreResult globTest/ set x1 x1.c set y1 y1.c test filename-12.4 {simple globbing} {unixOrWin} { lsort [glob globTest/x1.c globTest/y1.c globTest/foo] } "$globPreResult$x1 $globPreResult$y1" test filename-12.5 {simple globbing} { glob globTest\\/x1.c } "$globPreResult$x1" test filename-12.6 {simple globbing} { glob globTest\\/\\x1.c } "$globPreResult$x1" test filename-12.7 {globbing at filesystem root} -constraints {unix} -body { list [glob -nocomplain /*] [glob -path / *] } -match compareWords -result equal test filename-12.8 {globbing at filesystem root} -constraints {unix} -body { set first [string range [lindex [glob -type d /*] 0] 0 1] list [glob -nocomplain ${first}*] [glob -path $first *] } -match compareWords -result equal test filename-12.9 {globbing at filesystem root} -constraints {win} -body { # Can't grab just anything from 'file volumes' because we need a dir that # has subdirs - assume that C:/ exists across Windows machines. set first [string range [lindex [glob -type d C:/*] 0] 0 3] list [glob -nocomplain ${first}*] [glob -path $first *] } -match compareWords -result equal test filename-12.10 {globbing with volume relative paths} -setup { set pwd [pwd] } -body { set dir [lindex [glob -type d C:/*] 0] cd C:/ list [glob -nocomplain [string range $dir 2 end]] [list $dir] } -cleanup { cd $pwd } -constraints {win} -match compareWords -result equal test filename-13.1 {globbing with brace substitution} { glob globTest/\{\} } "$globPreResult" test filename-13.2 {globbing with brace substitution} -body { glob globTest/\{ } -returnCodes error -result {unmatched open-brace in file name} test filename-13.3 {globbing with brace substitution} -body { glob globTest/\{\\\} } -returnCodes error -result {unmatched open-brace in file name} test filename-13.4 {globbing with brace substitution} -body { glob globTest/\{\\ } -returnCodes error -result {unmatched open-brace in file name} test filename-13.5 {globbing with brace substitution} -body { glob globTest/\} } -returnCodes error -result {unmatched close-brace in file name} test filename-13.6 {globbing with brace substitution} { glob globTest/\{\}x1.c } "$globPreResult$x1" test filename-13.7 {globbing with brace substitution} { glob globTest/\{x\}1.c } "$globPreResult$x1" test filename-13.8 {globbing with brace substitution} { glob globTest/\{x\{\}\}1.c } "$globPreResult$x1" test filename-13.9 {globbing with brace substitution} { lsort [glob globTest/\{x,y\}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.10 {globbing with brace substitution} { lsort [glob globTest/\{x,,y\}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.11 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/\{x,x\\,z,z\}1.c] } [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}] test filename-13.13 {globbing with brace substitution} { lsort [glob globTest/{a,b,x,y}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.14 {globbing with brace substitution} {unixOrWin} { lsort [glob {globTest/{x1,y2,weird name}.c}] } {{globTest/weird name.c} globTest/x1.c} test filename-13.16 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{x1.c,a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} test filename-13.18 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{x1.c,{a},a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} test filename-13.20 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{a,x}1/*/{x,y}*] } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} test filename-13.22 {globbing with brace substitution} -body { glob globTest/\{a,x\}1/*/\{ } -returnCodes error -result {unmatched open-brace in file name} test filename-14.1 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob glo*/*.c] } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.3 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/?1.c] } {globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.5 {asterisks, question marks, and brackets} -setup { # The current directory could be anywhere; do this to stop spurious # matches file mkdir globTestContext file rename globTest [file join globTestContext globTest] set savepwd [pwd] cd globTestContext } -constraints {unixOrWin} -body { lsort [glob */*/*/*.c] } -cleanup { # Reset to where we were cd $savepwd file rename [file join globTestContext globTest] globTest file delete globTestContext } -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} test filename-14.7 {asterisks, question marks, and brackets} {unix} { lsort [glob globTest/*] } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.7.1 {asterisks, question marks, and brackets} {win} { lsort [glob globTest/*] } {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/.*] } {globTest/. globTest/.. globTest/.1} test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*/*] } {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3} test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob {globTest/[xyab]1.*}] } {globTest/x1.c globTest/y1.c} test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*/] } {globTest/a1/ globTest/a2/ globTest/a3/} test filename-14.17 {asterisks, question marks, and brackets} -setup { global env set temp $env(HOME) } -body { set env(HOME) [file join $env(HOME) globTest] glob ~/z* } -cleanup { set env(HOME) $temp } -result [list [file join $env(HOME) globTest z1.c]] test filename-14.18 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*.c goo/*] } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.20 {asterisks, question marks, and brackets} { glob -nocomplain goo/* } {} test filename-14.21 {asterisks, question marks, and brackets} -body { glob globTest/*/gorp } -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"} test filename-14.22 {asterisks, question marks, and brackets} -body { glob goo/* x*z foo?q } -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"} test filename-14.23 {slash globbing} {unix} { glob / } / test filename-14.23.2 {slash globbing} {win} { glob / } [file norm /] test filename-14.24 {slash globbing} {win} { glob {\\} } [file norm /] test filename-14.25 {type specific globbing} {unix} { lsort [glob -dir globTest -types f *] } [lsort [list \ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-14.25.1 {type specific globbing} {win} { lsort [glob -dir globTest -types f *] } [lsort [list \ [file join $globname .1]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-14.26 {type specific globbing} { glob -nocomplain -dir globTest -types {readonly} * } {} test filename-14.27 {Bug 2710920} {unixOrWin} { file tail [lindex [lsort [glob globTest/*/]] 0] } a1 test filename-14.28 {Bug 2710920} {unixOrWin} { file dirname [lindex [lsort [glob globTest/*/]] 0] } globTest test filename-14.29 {Bug 2710920} {unixOrWin} { file extension [lindex [lsort [glob globTest/*/]] 0] } {} test filename-14.30 {Bug 2710920} {unixOrWin} { file rootname [lindex [lsort [glob globTest/*/]] 0] } globTest/a1/ test filename-14.31 {Bug 2918610} -setup { set d [makeDirectory foo] makeFile {} bar.soom $d } -body { foreach fn [glob $d/bar.soom] { set root [file rootname $fn] close [open $root {WRONLY CREAT}] } llength [glob -directory $d *] } -cleanup { file delete -force $d/bar removeFile bar.soom $d removeDirectory foo } -result 2 unset globname # The following tests are only valid for Unix systems. On some systems, like # AFS, "000" protection doesn't prevent access by owner, so the following test # is not portable. catch {file attributes globTest/a1 -permissions 0o000} test filename-15.1 {unix specific globbing} {unix nonPortable} { string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode] } {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}} test filename-15.2 {unix specific no complain: no errors} {unix nonPortable} { glob -nocomplain globTest/a1/* } {} test filename-15.3 {unix specific no complain: no errors, good result} \ {unix nonPortable} { # test fails because if an error occurs, the interp's result is reset... glob -nocomplain globTest/a2 globTest/a1/* globTest/a3 } {globTest/a2 globTest/a3} catch {file attributes globTest/a1 -permissions 0o755} test filename-15.4 {unix specific no complain: no errors, good result} \ {unix nonPortable} { # test fails because if an error occurs, the interp's result is reset... # or you don't run at scriptics where the ouster and welch users exists glob -nocomplain ~ouster ~foo ~welch } {/home/ouster /home/welch} test filename-15.4.1 {no complain: errors, sequencing} { # test used to fail because if an error occurs, the interp's result is # reset... But, the sequence means we throw a different error first. list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1 \ [catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2 } {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}} test filename-15.4.2 {no complain: errors, sequencing} -body { # test used to fail because if an error occurs, the interp's result is # reset... list [list [catch {glob -nocomplain ~wontexist *} res1] $res1] \ [list [catch {glob -nocomplain * ~wontexist} res2] $res2] } -match compareWords -result equal test filename-15.5 {unix specific globbing} {unix nonPortable} { glob ~ouster/.csh* } "/home/ouster/.cshrc" touch globTest/odd\\\[\]*?\{\}name test filename-15.6 {unix specific globbing} -constraints {unix} -setup { global env set temp $env(HOME) } -body { set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name glob ~ } -cleanup { set env(HOME) $temp } -result [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name] catch {file delete -force globTest/odd\\\[\]*?\{\}name} test filename-15.7 {win specific globbing} -constraints {win} -body { glob ~ } -match regexp -result {[^/]$} test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -setup { global env set temp $env(HOME) } -body { touch $env(HOME)/globTest/anyname set env(HOME) $env(HOME)/globTest/anyname glob ~ } -cleanup { set env(HOME) $temp catch {file delete -force $env(HOME)/globTest/anyname} } -result [list [lindex [glob ~] 0]/globTest/anyname] # The following tests are only valid for Windows systems. set oldDir [pwd] if {[testConstraint win]} { cd c:/ file delete -force globTest file mkdir globTest touch globTest/x1.BAT touch globTest/y1.Bat touch globTest/z1.bat } test filename-16.1 {windows specific globbing} {win} { lsort [glob globTest/*.bat] } {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat} test filename-16.2 {windows specific globbing} {win} { glob c: } c: test filename-16.2.1 {windows specific globbing} -constraints {win} -setup { set dir [pwd] } -body { cd C:/ glob c: } -cleanup { cd $dir } -result c: test filename-16.3 {windows specific globbing} {win} { glob -nocomplain c:\\\\ } c:/ test filename-16.4 {windows specific globbing} {win} { glob -nocomplain c:/ } c:/ test filename-16.5 {windows specific globbing} {win} { glob -nocomplain c:*bTest } c:globTest test filename-16.6 {windows specific globbing} {win} { glob -nocomplain c:\\\\*bTest } c:/globTest test filename-16.7 {windows specific globbing} {win} { glob -nocomplain c:/*bTest } c:/globTest test filename-16.8 {windows specific globbing} {win} { lsort [glob -nocomplain c:globTest/*.bat] } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat} test filename-16.9 {windows specific globbing} {win} { lsort [glob -nocomplain c:/globTest/*.bat] } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat} test filename-16.10 {windows specific globbing} {win} { lsort [glob -nocomplain c:globTest\\\\*.bat] } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat} test filename-16.11 {windows specific globbing} {win} { lsort [glob -nocomplain c:\\\\globTest\\\\*.bat] } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat} # some tests require a shared C drive test filename-16.12 {windows specific globbing} {win sharedCdrive} { cd //[info hostname]/c glob //[info hostname]/c/*Test } //[info hostname]/c/globTest test filename-16.13 {windows specific globbing} {win sharedCdrive} { cd //[info hostname]/c glob "\\\\\\\\[info hostname]\\\\c\\\\*Test" } //[info hostname]/c/globTest test filename-16.14 {windows specific globbing} {win} { cd [lindex [glob -types d -dir C:/ *] 0] expr {".." in [glob {{.,*}*}]} } {1} test filename-16.15 {windows specific globbing} {win} { cd [lindex [glob -types d -dir C:/ *] 0] glob .. } {..} test filename-16.16 {windows specific globbing} {win} { file tail [lindex [glob -nocomplain "[lindex [glob -types d -dir C:/ *] 0]/.."] 0] } {..} test filename-16.17 {windows specific globbing} -constraints {win} -body { cd C:/ # Ensure correct trimming of tails with absolute and volume relative # globbing. list [glob -nocomplain -tails -dir C:/ *] \ [glob -nocomplain -tails -dir C: *] } -match compareWords -result equal # Put the working directory back now that we're done with globbing in C:/ if {[testConstraint win]} { cd $oldDir } test filename-17.1 {windows specific special files} {testsetplatform} { testsetplatform win list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \ [file pathtype prn] [file pathtype nul] [file pathtype aux] \ [file pathtype foo] } {absolute absolute absolute absolute absolute absolute relative} if {[testConstraint testsetplatform]} { testsetplatform $platform } test filename-17.2 {windows specific glob with executable} -body { makeDirectory execglob foreach ext {exe com cmd bat notexecutable} { makeFile contents execglob/abc.$ext } lsort [glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *] } -constraints {win} -cleanup { foreach ext {exe com cmd bat ps1 notexecutable} { removeFile execglob/abc.$ext } removeDirectory execglob } -result {abc.bat abc.cmd abc.com abc.exe} test filename-17.3 {Bug 2571597} win { set p /a file pathtype $p file normalize $p file pathtype $p } volumerelative test fileName-18.1 {windows - split ADS name correctly} {win} { # bug 1194458 set x [file split c:/c:d] list $x [file join {*}$x] } {{c:/ ./c:d} c:/c:d} test fileName-19.1 {ensure that [Bug 1325099] stays fixed} { # Any non-crashing result is OK list [file exists ~//.nonexistant_file] [file exists ~///.nonexistant_file] } {0 0} test fileName-20.1 {Bug 1750300} -setup { set d [makeDirectory foo] makeFile {} TAGS $d } -body { llength [glob -nocomplain -directory $d -- TAGS one two] } -cleanup { removeFile TAGS $d removeDirectory foo } -result 1 test fileName-20.2 {Bug 1750300} -setup { set d [makeDirectory foo] makeFile {} TAGS $d } -body { llength [glob -nocomplain -directory $d -types {} -- TAGS one two] } -cleanup { removeFile TAGS $d removeDirectory foo } -result 1 test fileName-20.3 {Bug 1750300} -setup { set d [makeDirectory foo] makeFile {} TAGS $d } -body { llength [glob -nocomplain -directory $d -types {} -- *U*] } -cleanup { removeFile TAGS $d removeDirectory foo } -result 0 test fileName-20.4 {Bug 1750300} -setup { set d [makeDirectory foo] makeFile {} TAGS $d } -body { llength [glob -nocomplain -directory $d -types {} -- URGENT Urkle] } -cleanup { removeFile TAGS $d removeDirectory foo } -result 0 test fileName-20.5 {Bug 2837800} -setup { set dd [makeDirectory isolate] set d [makeDirectory ./~foo $dd] makeFile {} test $d set savewd [pwd] cd $dd } -body { glob -nocomplain */test } -cleanup { cd $savewd removeFile test $d removeDirectory ./~foo $dd removeDirectory isolate } -result ~foo/test test fileName-20.6 {Bug 2837800} -setup { # Recall that we have $env(HOME) set so that references # to ~ point to [temporaryDirectory] makeFile {} test ~ set dd [makeDirectory isolate] set d [makeDirectory ./~ $dd] set savewd [pwd] cd $dd } -body { glob -nocomplain */test } -cleanup { cd $savewd removeDirectory ./~ $dd removeDirectory isolate removeFile test ~ } -result {} test fileName-20.7 {Bug 2806250} -setup { set savewd [pwd] cd [temporaryDirectory] set d [makeDirectory isolate] makeFile {} ./~test $d } -body { file exists [lindex [glob -nocomplain isolate/*] 0] } -cleanup { removeFile ./~test $d removeDirectory isolate cd $savewd } -result 1 test fileName-20.8 {Bug 2806250} -setup { set savewd [pwd] cd [temporaryDirectory] set d [makeDirectory isolate] makeFile {} ./~test $d } -body { file tail [lindex [glob -nocomplain isolate/*] 0] } -cleanup { removeFile ./~test $d removeDirectory isolate cd $savewd } -result ./~test test fileName-20.9 {globbing for special chars} -setup { makeFile {} test ~ set d [makeDirectory isolate] set savewd [pwd] cd $d } -body { glob -nocomplain -directory ~ test } -cleanup { cd $savewd removeDirectory isolate removeFile test ~ } -result ~/test test fileName-20.10 {globbing for special chars} -setup { set s [makeDirectory sub ~] makeFile {} fileName-20.10 $s set d [makeDirectory isolate] set savewd [pwd] cd $d } -body { glob -nocomplain -directory ~ -join * fileName-20.10 } -cleanup { cd $savewd removeDirectory isolate removeFile fileName-20.10 $s removeDirectory sub ~ } -result ~/sub/fileName-20.10 # cleanup catch {file delete -force C:/globTest} cd [temporaryDirectory] file delete -force globTest cd $oldpwd catch {removeDirectory tcl[pid]} set env(HOME) $oldhome if {[testConstraint testsetplatform]} { testsetplatform $platform catch {unset platform} } catch {unset oldhome temp result globPreResult} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/fileSystemEncoding.test0000644000175000017500000000171314554262142017502 0ustar sergeisergei#! /usr/bin/env tclsh # Copyright (c) 2019 Poor Yorick if {[string equal $::tcl_platform(os) "Windows NT"]} { return } namespace eval ::tcl::test::fileSystemEncoding { if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } variable fname1 \u767b\u9e1b\u9d72\u6a13 source [file join [file dirname [info script]] tcltests.tcl] test filesystemEncoding-1.0 { issue bcd100410465 } -body { set dir [tcltests::tempdir] set saved [encoding system] encoding system iso8859-1 set fname1a $dir/$fname1 set utf8name [encoding convertto utf-8 $fname1a] makeFile {} $utf8name set globbed [lindex [glob -directory $dir *] 0] encoding system utf-8 set res [file exists $globbed] encoding system iso8859-1 lappend res [file exists $globbed] return $res } -cleanup { removeFile $utf8name file delete -force $dir encoding system $saved } -result {0 1} cleanupTests } tcl8.6.14/tests/fileSystem.test0000644000175000017500000010657714554262142016051 0ustar sergeisergei# This file tests the filesystem and vfs internals. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 2002 Vincent Darley. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } namespace eval ::tcl::test::fileSystem { namespace import ::tcltest::* catch { file delete -force link.file file delete -force dir.link file delete -force [file join dir.dir linkinside.file] } testConstraint loaddll 0 catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] set ::ddever [package require dde] set ::ddelib [lindex [package ifneeded dde $::ddever] 1] set ::regver [package require registry] set ::reglib [lindex [package ifneeded registry $::regver] 1] if {[file extension $::reglib] eq ".dll"} { testConstraint loaddll 1 } } # Test for commands defined in Tcltest executable testConstraint testfilesystem [llength [info commands ::testfilesystem]] testConstraint testsetplatform [llength [info commands ::testsetplatform]] testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]] # Some things fail under all Continuous Integration systems for subtle reasons # such as CI often running with elevated privileges in a container. testConstraint notInCIenv [expr {![info exists ::env(CI)]}] cd [tcltest::temporaryDirectory] makeFile "test file" gorp.file makeDirectory dir.dir makeDirectory [file join dir.dir dirinside.dir] makeFile "test file in directory" [file join dir.dir inside.file] testConstraint unusedDrive 0 testConstraint moreThanOneDrive 0 apply {{} { # The variables 'drive' and 'drives' will be used below. variable drive {} drives {} if {[testConstraint win]} { set vols [string map [list :/ {}] [file volumes]] for {set i 0} {$i < 26} {incr i} { set drive [format %c [expr {$i + 65}]] if {$drive ni $vols} { testConstraint unusedDrive 1 break } } set dir [pwd] try { foreach vol [file volumes] { if {![catch {cd $vol}]} { lappend drives $vol } } testConstraint moreThanOneDrive [expr {[llength $drives] > 1}] } finally { cd $dir } } } ::tcl::test::fileSystem} proc testPathEqual {one two} { if {$one eq $two} { return "ok" } return "not equal: $one $two" } testConstraint hasLinks [expr {![catch { file link link.file gorp.file cd dir.dir file link \ [file join linkinside.file] \ [file join inside.file] cd .. file link dir.link dir.dir cd dir.dir file link [file join dirinside.link] \ [file join dirinside.dir] cd .. }]}] if {[testConstraint testsetplatform]} { set platform [testgetplatform] } # ---------------------------------------------------------------------- test filesystem-1.0 {link normalisation} {hasLinks} { string equal [file normalize gorp.file] [file normalize link.file] } {0} test filesystem-1.1 {link normalisation} {hasLinks} { string equal [file normalize dir.dir] [file normalize dir.link] } {0} test filesystem-1.2 {link normalisation} {hasLinks unix} { testPathEqual [file normalize [file join gorp.file foo]] \ [file normalize [file join link.file foo]] } ok test filesystem-1.3 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir foo]] \ [file normalize [file join dir.link foo]] } ok test filesystem-1.4 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir inside.file]] \ [file normalize [file join dir.link inside.file]] } ok test filesystem-1.5 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir linkinside.file]] \ [file normalize [file join dir.dir linkinside.file]] } ok test filesystem-1.6 {link normalisation} {hasLinks} { string equal [file normalize [file join dir.dir linkinside.file]] \ [file normalize [file join dir.link inside.file]] } {0} test filesystem-1.7 {link normalisation} {hasLinks unix} { testPathEqual [file normalize [file join dir.link linkinside.file foo]] \ [file normalize [file join dir.dir inside.file foo]] } ok test filesystem-1.8 {link normalisation} {hasLinks} { string equal [file normalize [file join dir.dir linkinside.filefoo]] \ [file normalize [file join dir.link inside.filefoo]] } {0} test filesystem-1.9 {link normalisation} -setup { file delete -force dir.link } -constraints {unix hasLinks} -body { file link dir.link [file nativename dir.dir] testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir.link inside.file foo]] } -result ok test filesystem-1.10 {link normalisation: double link} -constraints { unix hasLinks } -body { file link dir2.link dir.link testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir2.link inside.file foo]] } -cleanup { file delete dir2.link } -result ok makeDirectory dir2.file test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} { file link dir2.link dir.link file link [file join dir2.file dir2.link] [file join .. dir2.link] testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir2.file dir2.link inside.file foo]] } ok test filesystem-1.12 {file new native path} {} { for {set i 0} {$i < 10} {incr i} { foreach f [lsort [glob -nocomplain -type l *]] { catch {file readlink $f} } } # If we reach here we've succeeded. We used to crash above. expr {1} } {1} test filesystem-1.13 {file normalisation} {win} { # This used to be broken file normalize C:/thislongnamedoesntexist } {C:/thislongnamedoesntexist} test filesystem-1.14 {file normalisation} {win} { # This used to be broken file normalize c:/ } {C:/} test filesystem-1.15 {file normalisation} {win} { file normalize c:/../ } {C:/} test filesystem-1.16 {file normalisation} {win} { file normalize c:/. } {C:/} test filesystem-1.17 {file normalisation} {win} { file normalize c:/.. } {C:/} test filesystem-1.17.1 {file normalisation} {win} { file normalize c:\\.. } {C:/} test filesystem-1.18 {file normalisation} {win} { file normalize c:/./ } {C:/} test filesystem-1.19 {file normalisation} {win unusedDrive} { file normalize ${drive}:/./../../.. } "${drive}:/" test filesystem-1.20 {file normalisation} {win} { file normalize //name/foo/../ } {//name/foo} test filesystem-1.21 {file normalisation} {win} { file normalize C:///foo/./ } {C:/foo} test filesystem-1.22 {file normalisation} {win} { file normalize //name/foo/. } {//name/foo} test filesystem-1.23 {file normalisation} {win} { file normalize c:/./foo } {C:/foo} test filesystem-1.24 {file normalisation} {win unusedDrive} { file normalize ${drive}:/./../../../a } "${drive}:/a" test filesystem-1.25 {file normalisation} {win unusedDrive} { file normalize ${drive}:/./.././../../a } "${drive}:/a" test filesystem-1.25.1 {file normalisation} {win unusedDrive} { file normalize ${drive}:/./.././..\\..\\a\\bb } "${drive}:/a/bb" test filesystem-1.26 {link normalisation: link and ..} -setup { file delete -force dir2.link } -constraints {hasLinks} -body { set dir [file join dir2 foo bar] file mkdir $dir file link dir2.link [file join dir2 foo bar] testPathEqual [file normalize [file join dir2 foo x]] \ [file normalize [file join dir2.link .. x]] } -result ok test filesystem-1.27 {file normalisation: up and down with ..} { set dir [file join dir2 foo bar] file mkdir $dir set dir2 [file join dir2 .. dir2 foo .. foo bar] list [testPathEqual [file normalize $dir] [file normalize $dir2]] \ [file exists $dir] [file exists $dir2] } {ok 1 1} test filesystem-1.28 {link normalisation: link with .. and ..} -setup { file delete -force dir2.link } -constraints {hasLinks} -body { set dir [file join dir2 foo bar] file mkdir $dir set to [file join dir2 .. dir2 foo .. foo bar] file link dir2.link $to testPathEqual [file normalize [file join dir2 foo x]] \ [file normalize [file join dir2.link .. x]] } -result ok test filesystem-1.29 {link normalisation: link with ..} -setup { file delete -force dir2.link } -constraints {hasLinks} -body { set dir [file join dir2 foo bar] file mkdir $dir set to [file join dir2 .. dir2 foo .. foo bar] file link dir2.link $to set res [file normalize [file join dir2.link x yyy z]] if {[string match *..* $res]} { return "$res must not contain '..'" } return "ok" } -result {ok} test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} { testPathEqual [file normalize [file join dir.link dirinside.link abc]] \ [file normalize [file join dir.dir dirinside.dir abc]] } ok file delete -force dir2.file file delete -force dir2.link file delete -force link.file dir.link file delete -force dir2 file delete -force [file join dir.dir dirinside.link] removeFile [file join dir.dir inside.file] removeDirectory [file join dir.dir dirinside.dir] removeDirectory dir.dir test filesystem-1.30 {normalisation of nonexistent user} -body { file normalize ~noonewiththisname } -returnCodes error -result {user "noonewiththisname" doesn't exist} test filesystem-1.30.1 {normalisation of existing user} -body { catch {file normalize ~$::tcl_platform(user)} } -result {0} test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body { file normalize ~nonexistentuser@nonexistentdomain } -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist} test filesystem-1.30.3 {file normalization should distinguish between ~ and ~user} -setup { set oldhome $::env(HOME) set olduserhome [file normalize ~$::tcl_platform(user)] set ::env(HOME) [file join $oldhome temp] } -cleanup { set ::env(HOME) $oldhome } -body { list [string equal [file normalize ~] $::env(HOME)] \ [string equal $olduserhome [file normalize ~$::tcl_platform(user)]] } -result {1 1} test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} { testsetplatform unix file normalize /foo/../bar } {/bar} test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} { testsetplatform unix file normalize /../bar } {/bar} test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} { testsetplatform windows set res [file normalize C:/../bar] if {[testConstraint unix]} { # Some Unices go further in normalizing this -- not really a problem # since this is a Windows test. regexp {C:/bar$} $res res } set res } {C:/bar} if {[testConstraint testsetplatform]} { testsetplatform $platform } test filesystem-1.34 {file normalisation with '/./'} -body { file normalize /foo/bar/anc/./.tml } -match regexp -result {^(?:(?!/\./).)*$} test filesystem-1.35a {file normalisation with '/./'} -body { file normalize /ffo/bar/anc/./foo/.tml } -match regexp -result {^(?:(?!/\./).)*$} test filesystem-1.35b {file normalisation with '/./'} { llength [regexp -all foo [file normalize /ffo/bar/anc/./foo/.tml]] } 1 test filesystem-1.36a {file normalisation with '/./'} -body { file normalize /foo/bar/anc/././asdasd/.tml } -match regexp -result {^(?:(?!/\./).)*$} test filesystem-1.36b {file normalisation with '/./'} { llength [regexp -all asdasd [file normalize /foo/bar/anc/././asdasd/.tml]] } 1 test filesystem-1.37 {file normalisation with '/./'} -body { set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....." file norm $fname } -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} test filesystem-1.38 {file normalisation with volume relative} -setup { set dir [pwd] } -constraints {win moreThanOneDrive notInCIenv} -body { set path "[string range [lindex $drives 0] 0 1]foo" cd [lindex $drives 1] file norm $path } -cleanup { cd $dir } -result "[lindex $drives 0]foo" test filesystem-1.39 {file normalisation with volume relative} -setup { set old [pwd] } -constraints {win} -body { set drv C:/ cd [lindex [glob -type d -dir $drv *] 0] file norm [string range $drv 0 1] } -cleanup { cd $old } -match regexp -result {.*[^/]} test filesystem-1.40 {file normalisation with repeated separators} { testPathEqual [file norm foo////bar] [file norm foo/bar] } ok test filesystem-1.41 {file normalisation with repeated separators} {win} { testPathEqual [file norm foo\\\\\\bar] [file norm foo/bar] } ok test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /xxx/..] [file norm /] } ok test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /xxx/../] [file norm /] } ok test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /xxx/foo/../..] [file norm /] } ok test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /xxx/foo/../../] [file norm /] } ok test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar] } ok test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /xxx/../../bar] [file norm /bar] } ok test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /xxx/../bar] [file norm /bar] } ok test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /..] [file norm /] } ok test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /../] [file norm /] } ok test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /.] [file norm /] } ok test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /./] [file norm /] } ok test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /../..] [file norm /] } ok test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /../../] [file norm /] } ok test filesystem-1.52 {bug f9f390d0fa: file join where strep is not canonical} -constraints unix -body { set x //foo file normalize $x file join $x bar } -result /foo/bar test filesystem-1.52.1 {bug f9f390d0fa: file join where strep is not canonical} -body { set x //foo file normalize $x file join $x } -result /foo test filesystem-1.53 {[Bug 3559678] - normalize when tail is empty} { string match */ [file normalize [lindex [glob -dir [pwd] {{}}] 0]] } 0 test filesystem-1.54 {[Bug ce3a211dcb] - normalize when tail is empty} -setup { set save [pwd] cd [set home [makeDirectory ce3a211dcb]] makeDirectory A $home cd [lindex [glob */] 0] } -body { string match */A [pwd] } -cleanup { cd $home removeDirectory A $home cd $save removeDirectory ce3a211dcb } -result 1 test filesystem-2.0 {new native path} {unix} { foreach f [lsort [glob -nocomplain /usr/bin/c*]] { catch {file readlink $f} } # If we reach here we've succeeded. We used to crash above. return ok } ok # Make sure the testfilesystem hasn't been registered. if {[testConstraint testfilesystem]} { proc resetfs {} { while {![catch {testfilesystem 0}]} {} } } test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem { set result {} lappend result [testfilesystem 1] lappend result [testfilesystem 0] lappend result [catch {testfilesystem 0} msg] $msg } {registered unregistered 1 failed} test filesystem-3.3 {Tcl_FSRegister} testfilesystem { testfilesystem 1 testfilesystem 1 testfilesystem 0 testfilesystem 0 } {unregistered} test filesystem-3.4 {Tcl_FSRegister} -constraints testfilesystem -body { testfilesystem 1 file system bar } -cleanup { testfilesystem 0 } -result {reporting} test filesystem-3.5 {Tcl_FSUnregister} testfilesystem { resetfs lindex [file system bar] 0 } {native} test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body { testfilesystem 1 set filesystemReport {} file exists foo testfilesystem 0 return $filesystemReport } -match glob -result {*{access foo}} test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body { testfilesystem 1 set filesystemReport {} catch {file stat foo bar} testfilesystem 0 return $filesystemReport } -match glob -result {*{stat foo}} test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body { testfilesystem 1 set filesystemReport {} catch {file lstat foo bar} testfilesystem 0 return $filesystemReport } -match glob -result {*{lstat foo}} test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body { testfilesystem 1 set filesystemReport {} catch {glob *} testfilesystem 0 return $filesystemReport } -match glob -result {*{matchindirectory *}*} test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup { set orig $::env(HOME) } -body { set ::env(HOME) /foo/bar/blah set testdir ~ set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]" set ::env(HOME) /a/b/c set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]" list $res1 $res2 } -cleanup { set ::env(HOME) $orig } -match regexp -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/cygwin)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/cygwin)?(/a/b|a:b)}} test filesystem-6.1 {empty file name} -returnCodes error -body { open "" } -result {couldn't open "": no such file or directory} test filesystem-6.2 {empty file name} -returnCodes error -body { file stat "" arr } -result {could not read "": no such file or directory} test filesystem-6.3 {empty file name} -returnCodes error -body { file atime "" } -result {could not read "": no such file or directory} test filesystem-6.4 {empty file name} -returnCodes error -body { file attributes "" } -result {could not read "": no such file or directory} test filesystem-6.5 {empty file name} -returnCodes error -body { file copy "" "" } -result {error copying "": no such file or directory} test filesystem-6.6 {empty file name} {file delete ""} {} test filesystem-6.7 {empty file name} {file dirname ""} . test filesystem-6.8 {empty file name} {file executable ""} 0 test filesystem-6.9 {empty file name} {file exists ""} 0 test filesystem-6.10 {empty file name} {file extension ""} {} test filesystem-6.11 {empty file name} {file isdirectory ""} 0 test filesystem-6.12 {empty file name} {file isfile ""} 0 test filesystem-6.13 {empty file name} {file join ""} {} test filesystem-6.14 {empty file name} -returnCodes error -body { file link "" } -result {could not read link "": no such file or directory} test filesystem-6.15 {empty file name} -returnCodes error -body { file lstat "" arr } -result {could not read "": no such file or directory} test filesystem-6.16 {empty file name} -returnCodes error -body { file mtime "" } -result {could not read "": no such file or directory} test filesystem-6.17 {empty file name} -returnCodes error -body { file mtime "" 0 } -result {could not read "": no such file or directory} test filesystem-6.18 {empty file name} -returnCodes error -body { file mkdir "" } -result {can't create directory "": no such file or directory} test filesystem-6.19 {empty file name} {file nativename ""} {} test filesystem-6.20 {empty file name} {file normalize ""} {} test filesystem-6.21 {empty file name} {file owned ""} 0 test filesystem-6.22 {empty file name} {file pathtype ""} relative test filesystem-6.23 {empty file name} {file readable ""} 0 test filesystem-6.24 {empty file name} -returnCodes error -body { file readlink "" } -result {could not read link "": no such file or directory} test filesystem-6.25 {empty file name} -returnCodes error -body { file rename "" "" } -result {error renaming "": no such file or directory} test filesystem-6.26 {empty file name} {file rootname ""} {} test filesystem-6.27 {empty file name} -returnCodes error -body { file separator "" } -result {unrecognised path} test filesystem-6.28 {empty file name} -returnCodes error -body { file size "" } -result {could not read "": no such file or directory} test filesystem-6.29 {empty file name} {file split ""} {} test filesystem-6.30 {empty file name} -returnCodes error -body { file system "" } -result {unrecognised path} test filesystem-6.31 {empty file name} {file tail ""} {} test filesystem-6.32 {empty file name} -returnCodes error -body { file type "" } -result {could not read "": no such file or directory} test filesystem-6.33 {empty file name} {file writable ""} 0 test filesystem-6.34 {file name with (invalid) nul character} { list [catch "open foo\x00" msg] $msg } [list 1 "couldn't open \"foo\x00\": filename is invalid on this platform"] # Make sure the testfilesystem hasn't been registered. if {[testConstraint testfilesystem]} { while {![catch {testfilesystem 0}]} {} } test filesystem-7.1.1 {load from vfs} -setup { set dir [pwd] } -constraints {win testsimplefilesystem loaddll} -body { # This may cause a crash on exit cd [file dirname $::ddelib] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation load simplefs:/[file tail $::ddelib] Dde testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. } -cleanup { cd $dir } -result ok test filesystem-7.1.2 {load from vfs, and then unload again} -setup { set dir [pwd] } -constraints {win testsimplefilesystem loaddll} -body { # This may cause a crash on exit cd [file dirname $::reglib] testsimplefilesystem 1 # This loads reg via a complex copy-to-temp operation load simplefs:/[file tail $::reglib] Registry unload simplefs:/[file tail $::reglib] testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. } -cleanup { cd $dir } -result ok test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] } -constraints testsimplefilesystem -body { # We created this file several tests ago. set origtime [file mtime gorp.file] set res [file exists gorp.file] testsimplefilesystem 1 file delete -force theCopy file copy simplefs:/gorp.file theCopy testsimplefilesystem 0 set newtime [file mtime theCopy] lappend res [expr {$origtime == $newtime ? 1 : "$origtime != $newtime"}] } -cleanup { catch {file delete theCopy} cd $dir } -result {1 1} test filesystem-7.3 {glob in simplefs} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] } -constraints testsimplefilesystem -body { file mkdir simpledir close [open [file join simpledir simplefile] w] testsimplefilesystem 1 glob -nocomplain -dir simplefs:/simpledir * } -cleanup { catch {testsimplefilesystem 0} file delete -force simpledir cd $dir } -result {simplefs:/simpledir/simplefile} test filesystem-7.3.1 {glob in simplefs: no path/dir} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] } -constraints testsimplefilesystem -body { file mkdir simpledir close [open [file join simpledir simplefile] w] testsimplefilesystem 1 set res [glob -nocomplain simplefs:/simpledir/*] lappend res {*}[glob -nocomplain simplefs:/simpledir] } -cleanup { catch {testsimplefilesystem 0} file delete -force simpledir cd $dir } -result {simplefs:/simpledir/simplefile simplefs:/simpledir} test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] } -constraints testsimplefilesystem -body { file mkdir simpledir close [open [file join simpledir simplefile] w] testsimplefilesystem 1 glob -nocomplain simplefs:/s* } -cleanup { catch {testsimplefilesystem 0} file delete -force simpledir cd $dir } -match glob -result ?* test filesystem-7.3.3 {glob in simplefs: pattern is a volume} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] } -constraints testsimplefilesystem -body { file mkdir simpledir close [open [file join simpledir simplefile] w] testsimplefilesystem 1 glob -nocomplain simplefs:/* } -cleanup { testsimplefilesystem 0 file delete -force simpledir cd $dir } -match glob -result ?* test filesystem-7.4 {cross-filesystem file copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] set fout [open [file join simplefile] w] puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 } -constraints testsimplefilesystem -body { # First copy should succeed set res [catch {file copy simplefs:/simplefile file2} err] lappend res $err # Second copy should fail (no -force) lappend res [catch {file copy simplefs:/simplefile file2} err] lappend res $err # Third copy should succeed (-force) lappend res [catch {file copy -force simplefs:/simplefile file2} err] lappend res $err lappend res [file exists file2] } -cleanup { catch {testsimplefilesystem 0} file delete -force simplefile file delete -force file2 cd $dir } -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} test filesystem-7.5 {cross-filesystem file copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] set fout [open [file join simplefile] w] puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 } -constraints {testsimplefilesystem unix} -body { # First copy should succeed set res [catch {file copy simplefs:/simplefile file2} err] lappend res $err file attributes file2 -permissions 0o000 # Second copy should fail (no -force) lappend res [catch {file copy simplefs:/simplefile file2} err] lappend res $err # Third copy should succeed (-force) lappend res [catch {file copy -force simplefs:/simplefile file2} err] lappend res $err lappend res [file exists file2] } -cleanup { testsimplefilesystem 0 file delete -force simplefile file delete -force file2 cd $dir } -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} test filesystem-7.6 {cross-filesystem dir copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir file mkdir simpledir file mkdir dir2 set fout [open [file join simpledir simplefile] w] puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 } -constraints testsimplefilesystem -body { # First copy should succeed set res [catch {file copy simplefs:/simpledir dir2} err] lappend res $err # Second copy should fail (no -force) lappend res [catch {file copy simplefs:/simpledir dir2} err] lappend res $err # Third copy should succeed (-force) lappend res [catch {file copy -force simplefs:/simpledir dir2} err] lappend res $err lappend res [file exists [file join dir2 simpledir]] \ [file exists [file join dir2 simpledir simplefile]] } -cleanup { testsimplefilesystem 0 file delete -force simpledir file delete -force dir2 cd $dir } -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} test filesystem-7.7 {cross-filesystem dir copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir file mkdir simpledir file mkdir dir2 set fout [open [file join simpledir simplefile] w] puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 } -constraints {testsimplefilesystem unix} -body { # First copy should succeed set res [catch {file copy simplefs:/simpledir dir2} err] lappend res $err # Second copy should fail (no -force) lappend res [catch {file copy simplefs:/simpledir dir2} err] lappend res $err # Third copy should succeed (-force) # I've noticed on some Unices that this only succeeds intermittently (some # runs work, some fail). This needs examining further. lappend res [catch {file copy -force simplefs:/simpledir dir2} err] lappend res $err lappend res [file exists [file join dir2 simpledir]] \ [file exists [file join dir2 simpledir simplefile]] } -cleanup { testsimplefilesystem 0 file delete -force simpledir file delete -force dir2 cd $dir } -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} removeFile gorp.file test filesystem-7.8 {vfs cd} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir file mkdir simpledir testsimplefilesystem 1 } -constraints testsimplefilesystem -body { # This can variously cause an infinite loop or simply have no effect at # all (before certain bugs were fixed, of course). cd simplefs:/simpledir pwd } -cleanup { cd [tcltest::temporaryDirectory] testsimplefilesystem 0 file delete -force simpledir cd $dir } -result {simplefs:/simpledir} test filesystem-8.1 {relative path objects and caching of pwd} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] } -body { makeDirectory abc makeDirectory def makeFile "contents" [file join abc foo] cd abc set f "foo" set res {} lappend res [file exists $f] lappend res [file exists $f] cd .. cd def # If we haven't cleared the object's cwd cache, Tcl will think it still # exists. lappend res [file exists $f] lappend res [file exists $f] } -cleanup { removeFile [file join abc foo] removeDirectory abc removeDirectory def cd $dir } -result {1 1 0 0} test filesystem-8.2 {relative path objects and use of pwd} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { set dir "abc" makeDirectory $dir makeFile "contents" [file join abc foo] cd $dir file exists [lindex [glob *] 0] } -cleanup { cd [tcltest::temporaryDirectory] removeFile [file join abc foo] removeDirectory abc cd $origdir } -result 1 test filesystem-8.3 {path objects and empty string} { set anchor "" set dst foo set res $dst set yyy [file split $anchor] set dst [file join $anchor $dst] lappend res $dst $yyy } {foo foo {}} proc TestFind1 {d f} { set r1 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r1" lappend res "is dir a dir? [file isdirectory $d]" set r2 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r2" return $res } proc TestFind2 {d f} { set r1 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r1" lappend res "is dir a dir? [file isdirectory [file join $d]]" set r2 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r2" return $res } test filesystem-9.1 {path objects and join and object rep} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir [file join a b c] TestFind1 a [file join b . c] } -cleanup { file delete -force a cd $origdir } -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}} test filesystem-9.2 {path objects and join and object rep} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir [file join a b c] TestFind2 a [file join b . c] } -cleanup { file delete -force a cd $origdir } -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}} test filesystem-9.2.1 {path objects and join and object rep} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir [file join a b c] TestFind2 a [file join b .] } -cleanup { file delete -force a cd $origdir } -result {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}} test filesystem-9.3 {path objects and join and object rep} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir [file join a b c] TestFind1 a [file join b .. b c] } -cleanup { file delete -force a cd $origdir } -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}} test filesystem-9.4 {path objects and join and object rep} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir [file join a b c] TestFind2 a [file join b .. b c] } -cleanup { file delete -force a cd $origdir } -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}} test filesystem-9.5 {path objects and file tail and object rep} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir dgp close [open dgp/test w] foreach relative [glob -nocomplain [file join * test]] { set absolute [file join [pwd] $relative] set res [list [file tail $absolute] "test"] } return $res } -cleanup { file delete -force dgp cd $origdir } -result {test test} test filesystem-9.6 {path objects and file tail and object rep} win { set res {} set p "C:\\toto" lappend res [file join $p toto] file isdirectory $p lappend res [file join $p toto] } {C:/toto/toto C:/toto/toto} test filesystem-9.7 {path objects and glob and file tail and tilde} -setup { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde set file [lindex [glob *test*] 0] lappend res [file exists $file] [catch {file tail $file} r] $r lappend res $file lappend res [file exists $file] [catch {file tail $file} r] $r lappend res [catch {file tail $file} r] $r } -cleanup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir } -result {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} test filesystem-9.8 {path objects and glob and file tail and tilde} -setup { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde set file1 [lindex [glob *test*] 0] set file2 "~testNotExist" lappend res $file1 $file2 lappend res [catch {file tail $file1} r] $r lappend res [catch {file tail $file2} r] $r } -cleanup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir } -result {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} test filesystem-9.9 {path objects and glob and file tail and tilde} -setup { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] } -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde set file1 [lindex [glob *test*] 0] set file2 "~testNotExist" lappend res [catch {file exists $file1} r] $r lappend res [catch {file exists $file2} r] $r lappend res [string equal $file1 $file2] } -cleanup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir } -result {0 0 0 0 1} # ---------------------------------------------------------------------- test filesystem-10.1 {Bug 3414754} { string match */ [file join [pwd] foo/] } 0 cleanupTests unset -nocomplain drive drives } namespace delete ::tcl::test::fileSystem return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/foreach.test0000644000175000017500000001666314554262142015330 0ustar sergeisergei# Commands covered: foreach, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } catch {unset a} catch {unset x} # Basic "foreach" operation. test foreach-1.1 {basic foreach tests} { set a {} foreach i {a b c d} { set a [concat $a $i] } set a } {a b c d} test foreach-1.2 {basic foreach tests} { set a {} foreach i {a b {{c d} e} {123 {{x}}}} { set a [concat $a $i] } set a } {a b {c d} e 123 {{x}}} test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1 test foreach-1.4 {basic foreach tests} { catch {foreach} msg set msg } {wrong # args: should be "foreach varList list ?varList list ...? command"} test foreach-1.5 {basic foreach tests} {catch {foreach i} msg} 1 test foreach-1.6 {basic foreach tests} { catch {foreach i} msg set msg } {wrong # args: should be "foreach varList list ?varList list ...? command"} test foreach-1.7 {basic foreach tests} {catch {foreach i j} msg} 1 test foreach-1.8 {basic foreach tests} { catch {foreach i j} msg set msg } {wrong # args: should be "foreach varList list ?varList list ...? command"} test foreach-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1 test foreach-1.10 {basic foreach tests} { catch {foreach i j k l} msg set msg } {wrong # args: should be "foreach varList list ?varList list ...? command"} test foreach-1.11 {basic foreach tests} { set a {} foreach i {} { set a [concat $a $i] } set a } {} test foreach-1.12 {foreach errors} { list [catch {foreach {{a}{b}} {1 2 3} {}} msg] $msg } {1 {list element in braces followed by "{b}" instead of space}} test foreach-1.13 {foreach errors} { list [catch {foreach a {{1 2}3} {}} msg] $msg } {1 {list element in braces followed by "3" instead of space}} catch {unset a} test foreach-1.14 {foreach errors} { catch {unset a} set a(0) 44 list [catch {foreach a {1 2 3} {}} msg o] $msg $::errorInfo } {1 {can't set "a": variable is array} {can't set "a": variable is array (setting foreach loop variable "a") invoked from within "foreach a {1 2 3} {}"}} test foreach-1.15 {foreach errors} { list [catch {foreach {} {} {}} msg] $msg } {1 {foreach varlist is empty}} catch {unset a} test foreach-2.1 {parallel foreach tests} { set x {} foreach {a b} {1 2 3 4} { append x $b $a } set x } {2143} test foreach-2.2 {parallel foreach tests} { set x {} foreach {a b} {1 2 3 4 5} { append x $b $a } set x } {21435} test foreach-2.3 {parallel foreach tests} { set x {} foreach a {1 2 3} b {4 5 6} { append x $b $a } set x } {415263} test foreach-2.4 {parallel foreach tests} { set x {} foreach a {1 2 3} b {4 5 6 7 8} { append x $b $a } set x } {41526378} test foreach-2.5 {parallel foreach tests} { set x {} foreach {a b} {a b A B aa bb} c {c C cc CC} { append x $a $b $c } set x } {abcABCaabbccCC} test foreach-2.6 {parallel foreach tests} { set x {} foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} { append x $a $b $c $d $e } set x } {111112222233333} test foreach-2.7 {parallel foreach tests} { set x {} foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { append x $a $b $c $d $e } set x } {1111 2222334} test foreach-2.8 {foreach only sets vars if repeating loop} { proc foo {} { set rgb {65535 0 0} foreach {r g b} [set rgb] {} return "r=$r, g=$g, b=$b" } foo } {r=65535, g=0, b=0} test foreach-2.9 {foreach only supports local scalar variables} { proc foo {} { set x {} foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]} set x } foo } {1 2 3 4} test foreach-3.1 {compiled foreach backward jump works correctly} { catch {unset x} proc foo {arrayName} { upvar 1 $arrayName a set l {} foreach member [array names a] { lappend l [list $member [set a($member)]] } return $l } array set x {0 zero 1 one 2 two 3 three} lsort [foo x] } [lsort {{0 zero} {1 one} {2 two} {3 three}}] test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} { catch {unset x} foreach {12.0} {a b c} { set x 12.0 set x [expr {$x + 1}] } set x } 13.0 # Check "continue". test foreach-5.1 {continue tests} {catch continue} 4 test foreach-5.2 {continue tests} { set a {} foreach i {a b c d} { if {[string compare $i "b"] == 0} continue set a [concat $a $i] } set a } {a c d} test foreach-5.3 {continue tests} { set a {} foreach i {a b c d} { if {[string compare $i "b"] != 0} continue set a [concat $a $i] } set a } {b} test foreach-5.4 {continue tests} {catch {continue foo} msg} 1 test foreach-5.5 {continue tests} { catch {continue foo} msg set msg } {wrong # args: should be "continue"} # Check "break". test foreach-6.1 {break tests} {catch break} 3 test foreach-6.2 {break tests} { set a {} foreach i {a b c d} { if {[string compare $i "c"] == 0} break set a [concat $a $i] } set a } {a b} test foreach-6.3 {break tests} {catch {break foo} msg} 1 test foreach-6.4 {break tests} { catch {break foo} msg set msg } {wrong # args: should be "break"} # Check for bug #406709 test foreach-6.5 {break tests} -body { proc a {} { set a 1 foreach b b {list [concat a; break]; incr a} incr a } a } -cleanup { rename a {} } -result {2} # Test for incorrect "double evaluation" semantics test foreach-7.1 {delayed substitution of body} { proc foo {} { set a 0 foreach a [list 1 2 3] " set x $a " set x } foo } {0} # Test for [Bug 1189274]; crash on failure test foreach-8.1 {empty list handling} { proc crash {} { rename crash {} set a "x y z" set b "" foreach aa $a bb $b { set x "aa = $aa bb = $bb" } } crash } {} # [Bug 1671138]; infinite loop with empty var list in bytecompiled version test foreach-9.1 {compiled empty var list} { proc foo {} { foreach {} x { error "reached body" } } list [catch { foo } msg] $msg } {1 {foreach varlist is empty}} test foreach-9.2 {line numbers} -setup { proc linenumber {} {dict get [info frame -1] line} } -body { apply {n { foreach x y {*}{ } {return [incr n -[linenumber]]} }} [linenumber] } -cleanup { rename linenumber {} } -result 1 test foreach-10.1 {foreach: [Bug 1671087]} -setup { proc demo {} { set vals {1 2 3 4} trace add variable x write {string length $vals ;# } foreach {x y} $vals {format $y} } } -body { demo } -cleanup { rename demo {} } -result {} test foreach-11.1 {error then dereference loop var (dev bug)} { catch { foreach a 0 b {1 2 3} { error x } } set a } 0 test foreach-11.2 {error then dereference loop var (dev bug)} { catch { foreach a 0 b {1 2 3} { incr a $b; error x } } set a } 1 # cleanup catch {unset a} catch {unset x} catch {rename foo {}} ::tcltest::cleanupTests return tcl8.6.14/tests/format.test0000644000175000017500000005520714554262142015206 0ustar sergeisergei# Commands covered: format # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # %u output depends on word length, so this test is not portable. testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] testConstraint wideIs64bit [expr { (wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] # MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain # particularly in Continuous Integration, and there isn't anything much we can # do about it. testConstraint notWinCI [expr { ($::tcl_platform(platform) ne "windows") || ![info exists ::env(CI)]}] test format-1.1 {integer formatting} { format "%*d %d %d %d" 6 34 16923 -12 -1 } { 34 16923 -12 -1} test format-1.2 {integer formatting} { format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12 } { 6 34 16923 -12 -1 0xe 0XC} test format-1.3 {integer formatting} longIs32bit { format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0 } { 6 34 16923 4294967284 -1 0} test format-1.3.1 {integer formatting} longIs64bit { format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0 } { 6 34 16923 18446744073709551604 -1 0} test format-1.4 {integer formatting} { format "%-4d %-4i %-4d %-4ld" 6 34 16923 -12 -1 } {6 34 16923 -12 } test format-1.5 {integer formatting} { format "%04d %04d %04d %04i" 6 34 16923 -12 -1 } {0006 0034 16923 -012} test format-1.6 {integer formatting} { format "%00*d" 6 34 } {000034} # Printing negative numbers in hex or octal format depends on word # length, so these tests are not portable. test format-1.7 {integer formatting} longIs32bit { format "%4x %4x %4x %4x" 6 34 16923 -12 -1 } { 6 22 421b fffffff4} test format-1.7.1 {integer formatting} longIs64bit { format "%4x %4x %4x %4x" 6 34 16923 -12 -1 } { 6 22 421b fffffffffffffff4} test format-1.8 {integer formatting} longIs32bit { format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 } {0x0 0x6 0X22 0X421B 0xfffffff4} test format-1.8.1 {integer formatting} longIs64bit { format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 } {0x0 0x6 0X22 0X421B 0xfffffffffffffff4} test format-1.9 {integer formatting} longIs32bit { format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 } { 0x0 0x6 0x22 0x421b 0xfffffff4} test format-1.9.1 {integer formatting} longIs64bit { format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 } { 0x0 0x6 0x22 0x421b 0xfffffffffffffff4} test format-1.10 {integer formatting} longIs32bit { format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 } {0x0 0x6 0x22 0x421b 0xfffffff4 } test format-1.10.1 {integer formatting} longIs64bit { format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 } {0x0 0x6 0x22 0x421b 0xfffffffffffffff4 } test format-1.11 {integer formatting} longIs32bit { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 } {0 06 042 041033 037777777764 } test format-1.11.1 {integer formatting} longIs64bit { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 } {0 06 042 041033 01777777777777777777764} test format-1.12 {integer formatting} { format "%b %#b %#b %llb" 5 0 5 [expr {2**100}] } {101 0b0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} test format-1.13 {integer formatting} { format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1 } {0 6 34 16923 -12} test format-1.14 {integer formatting} { format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1 } { 0 6 34 16923 -12} test format-1.15 {integer formatting} { format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1 } {0 6 34 16923 -12 } test format-2.1 {string formatting} { format "%s %s %c %s" abcd {This is a very long test string.} 120 x } {abcd This is a very long test string. x x} test format-2.2 {string formatting} { format "%20s %20s %20c %20s" abcd {This is a very long test string.} 120 x } { abcd This is a very long test string. x x} test format-2.3 {string formatting} { format "%.10s %.10s %c %.10s" abcd {This is a very long test string.} 120 x } {abcd This is a x x} test format-2.4 {string formatting} { format "%s %s %% %c %s" abcd {This is a very long test string.} 120 x } {abcd This is a very long test string. % x x} test format-2.5 {string formatting, embedded nulls} { format "%10s" abc\0def } " abc\0def" test format-2.6 {string formatting, international chars} { format "%10s" abc\uFEFFdef } " abc\uFEFFdef" test format-2.7 {string formatting, international chars} { format "%.5s" abc\uFEFFdef } "abc\uFEFFd" test format-2.8 {string formatting, international chars} { format "foo\uFEFFbar%s" baz } "foo\uFEFFbarbaz" test format-2.9 {string formatting, width} { format "a%5sa" f } "a fa" test format-2.10 {string formatting, width} { format "a%-5sa" f } "af a" test format-2.11 {string formatting, width} { format "a%2sa" foo } "afooa" test format-2.12 {string formatting, width} { format "a%0sa" foo } "afooa" test format-2.13 {string formatting, precision} { format "a%.2sa" foobarbaz } "afoa" test format-2.14 {string formatting, precision} { format "a%.sa" foobarbaz } "aa" test format-2.15 {string formatting, precision} { list [catch {format "a%.-2sa" foobarbaz} msg] $msg } {1 {bad field specifier "-"}} test format-2.16 {string formatting, width and precision} { format "a%5.2sa" foobarbaz } "a foa" test format-2.17 {string formatting, width and precision} { format "a%5.7sa" foobarbaz } "afoobarba" test format-3.1 {Tcl_FormatObjCmd: character formatting} { format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65 } "|A|A|A|A|A | A| A|A |" test format-3.2 {Tcl_FormatObjCmd: international character formatting} { format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xa2 0x4e4e 0x25a 0xc3 0xff08 0 3 0x6575 -4 0x4e4f } "|\ua2|\u4e4e|\u25a|\uc3|\uff08 | \0| \u6575|\u4e4f |" test format-4.1 {e and f formats} {eformat} { format "%e %e %e %e" 34.2e12 68.514 -.125 -16000. .000053 } {3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04} test format-4.2 {e and f formats} {eformat} { format "%20e %20e %20e %20e" 34.2e12 68.514 -.125 -16000. .000053 } { 3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04} test format-4.3 {e and f formats} {eformat} { format "%.1e %.1e %.1e %.1e" 34.2e12 68.514 -.126 -16000. .000053 } {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04} test format-4.4 {e and f formats} {eformat} { format "%020e %020e %020e %020e" 34.2e12 68.514 -.126 -16000. .000053 } {000000003.420000e+13 000000006.851400e+01 -00000001.260000e-01 -00000001.600000e+04} test format-4.5 {e and f formats} {eformat} { format "%7.1e %7.1e %7.1e %7.1e" 34.2e12 68.514 -.126 -16000. .000053 } {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04} test format-4.6 {e and f formats} { format "%f %f %f %f" 34.2e12 68.514 -.125 -16000. .000053 } {34200000000000.000000 68.514000 -0.125000 -16000.000000} test format-4.7 {e and f formats} { format "%.4f %.4f %.4f %.4f %.4f" 34.2e12 68.514 -.125 -16000. .000053 } {34200000000000.0000 68.5140 -0.1250 -16000.0000 0.0001} test format-4.8 {e and f formats} {eformat} { format "%.4e %.5e %.6e" -9.99996 -9.99996 9.99996 } {-1.0000e+01 -9.99996e+00 9.999960e+00} test format-4.9 {e and f formats} { format "%.4f %.5f %.6f" -9.99996 -9.99996 9.99996 } {-10.0000 -9.99996 9.999960} test format-4.10 {e and f formats} { format "%20f %-20f %020f" -9.99996 -9.99996 9.99996 } { -9.999960 -9.999960 0000000000009.999960} test format-4.11 {e and f formats} { format "%-020f %020f" -9.99996 -9.99996 9.99996 } {-9.999960 -000000000009.999960} test format-4.12 {e and f formats} {eformat} { format "%.0e %#.0e" -9.99996 -9.99996 9.99996 } {-1e+01 -1.e+01} test format-4.13 {e and f formats} { format "%.0f %#.0f" -9.99996 -9.99996 9.99996 } {-10 -10.} test format-4.14 {e and f formats} { format "%.4f %.5f %.6f" -9.99996 -9.99996 9.99996 } {-10.0000 -9.99996 9.999960} test format-4.15 {e and f formats} { format "%3.0f %3.0f %3.0f %3.0f" 1.0 1.1 1.01 1.001 } { 1 1 1 1} test format-4.16 {e and f formats} { format "%3.1f %3.1f %3.1f %3.1f" 0.0 0.1 0.01 0.001 } {0.0 0.1 0.0 0.0} test format-5.1 {g-format} {eformat} { format "%.3g" 12341.0 } {1.23e+04} test format-5.2 {g-format} {eformat} { format "%.3G" 1234.12345 } {1.23E+03} test format-5.3 {g-format} { format "%.3g" 123.412345 } {123} test format-5.4 {g-format} { format "%.3g" 12.3412345 } {12.3} test format-5.5 {g-format} { format "%.3g" 1.23412345 } {1.23} test format-5.6 {g-format} { format "%.3g" 1.23412345 } {1.23} test format-5.7 {g-format} { format "%.3g" .123412345 } {0.123} test format-5.8 {g-format} { format "%.3g" .012341 } {0.0123} test format-5.9 {g-format} { format "%.3g" .0012341 } {0.00123} test format-5.10 {g-format} { format "%.3g" .00012341 } {0.000123} test format-5.11 {g-format} {eformat} { format "%.3g" .00001234 } {1.23e-05} test format-5.12 {g-format} {eformat} { format "%.4g" 9999.6 } {1e+04} test format-5.13 {g-format} { format "%.4g" 999.96 } {1000} test format-5.14 {g-format} { format "%.3g" 1.0 } {1} test format-5.15 {g-format} { format "%.3g" .1 } {0.1} test format-5.16 {g-format} { format "%.3g" .01 } {0.01} test format-5.17 {g-format} { format "%.3g" .001 } {0.001} test format-5.18 {g-format} {eformat} { format "%.3g" .00001 } {1e-05} test format-5.19 {g-format} {eformat} { format "%#.3g" 1234.0 } {1.23e+03} test format-5.20 {g-format} {eformat} { format "%#.3G" 9999.5 } {1.00E+04} test format-6.1 {floating-point zeroes} {eformat} { format "%e %f %g" 0.0 0.0 0.0 0.0 } {0.000000e+00 0.000000 0} test format-6.2 {floating-point zeroes} {eformat} { format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0} test format-6.3 {floating-point zeroes} {eformat notWinCI} { format "%#.4e %#.4f %#.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0.000} test format-6.4 {floating-point zeroes} {eformat} { format "%.0e %.0f %.0g" 0.0 0.0 0.0 0.0 } {0e+00 0 0} test format-6.5 {floating-point zeroes} {eformat notWinCI} { format "%#.0e %#.0f %#.0g" 0.0 0.0 0.0 0.0 } {0.e+00 0. 0.} test format-6.6 {floating-point zeroes} { format "%3.0f %3.0f %3.0f %3.0f" 0.0 0.0 0.0 0.0 } { 0 0 0 0} test format-6.7 {floating-point zeroes} { format "%3.0f %3.0f %3.0f %3.0f" 1.0 1.1 1.01 1.001 } { 1 1 1 1} test format-6.8 {floating-point zeroes} { format "%3.1f %3.1f %3.1f %3.1f" 0.0 0.1 0.01 0.001 } {0.0 0.1 0.0 0.0} test format-7.1 {various syntax features} { format "%*.*f" 12 3 12.345678901 } { 12.346} test format-7.2 {various syntax features} { format "%0*.*f" 12 3 12.345678901 } {00000012.346} test format-7.3 {various syntax features} { format "\*\t\\n" } {* \n} test format-8.1 {error conditions} { catch format } 1 test format-8.2 {error conditions} { catch format msg set msg } {wrong # args: should be "format formatString ?arg ...?"} test format-8.3 {error conditions} { catch {format %*d} } 1 test format-8.4 {error conditions} { catch {format %*d} msg set msg } {not enough arguments for all format specifiers} test format-8.5 {error conditions} { catch {format %*.*f 12} } 1 test format-8.6 {error conditions} { catch {format %*.*f 12} msg set msg } {not enough arguments for all format specifiers} test format-8.7 {error conditions} { catch {format %*.*f 12 3} } 1 test format-8.8 {error conditions} { catch {format %*.*f 12 3} msg set msg } {not enough arguments for all format specifiers} test format-8.9 {error conditions} { list [catch {format %*d x 3} msg] $msg } {1 {expected integer but got "x"}} test format-8.10 {error conditions} { list [catch {format %*.*f 2 xyz 3} msg] $msg } {1 {expected integer but got "xyz"}} test format-8.11 {error conditions} { catch {format %d 2a} } 1 test format-8.12 {error conditions} { catch {format %d 2a} msg set msg } {expected integer but got "2a"} test format-8.13 {error conditions} { catch {format %c 2x} } 1 test format-8.14 {error conditions} { catch {format %c 2x} msg set msg } {expected integer but got "2x"} test format-8.15 {error conditions} { catch {format %f 2.1z} } 1 test format-8.16 {error conditions} { catch {format %f 2.1z} msg set msg } {expected floating-point number but got "2.1z"} test format-8.17 {error conditions} { catch {format ab%} } 1 test format-8.18 {error conditions} { catch {format ab% 12} msg set msg } {format string ended in middle of field specifier} test format-8.19 {error conditions} { catch {format %q x} } 1 test format-8.20 {error conditions} { catch {format %r x} msg set msg } {bad field specifier "r"} test format-8.21 {error conditions} { catch {format %d} } 1 test format-8.22 {error conditions} { catch {format %d} msg set msg } {not enough arguments for all format specifiers} test format-8.23 {error conditions} { catch {format "%d %d" 24 xyz} msg set msg } {expected integer but got "xyz"} test format-9.1 {long result} { set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} format {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG %s %s} $a $a } {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} test format-10.1 {"h" format specifier} { format %hd 0xffff } -1 test format-10.2 {"h" format specifier} { format %hx 0x10fff } fff test format-10.3 {"h" format specifier} { format %hd 0x10000 } 0 test format-10.4 {"h" format specifier} { # Bug 1154163: This is minimal behaviour for %hx specifier! format %hx 1 } 1 test format-10.5 {"h" format specifier} { # Bug 1284178: Highly out-of-range values shouldn't cause errors format %hu 0x100000000 } 0 test format-11.1 {XPG3 %$n specifiers} { format {%2$d %1$d} 4 5 } {5 4} test format-11.2 {XPG3 %$n specifiers} { format {%2$d %1$d %1$d %3$d} 4 5 6 } {5 4 4 6} test format-11.3 {XPG3 %$n specifiers} { list [catch {format {%2$d %3$d} 4 5} msg] $msg } {1 {"%n$" argument index out of range}} test format-11.4 {XPG3 %$n specifiers} { list [catch {format {%2$d %0$d} 4 5 6} msg] $msg } {1 {"%n$" argument index out of range}} test format-11.5 {XPG3 %$n specifiers} { list [catch {format {%d %1$d} 4 5 6} msg] $msg } {1 {cannot mix "%" and "%n$" conversion specifiers}} test format-11.6 {XPG3 %$n specifiers} { list [catch {format {%2$d %d} 4 5 6} msg] $msg } {1 {cannot mix "%" and "%n$" conversion specifiers}} test format-11.7 {XPG3 %$n specifiers} { list [catch {format {%2$d %3d} 4 5 6} msg] $msg } {1 {cannot mix "%" and "%n$" conversion specifiers}} test format-11.8 {XPG3 %$n specifiers} { format {%2$*d %3$d} 1 10 4 } { 4 4} test format-11.9 {XPG3 %$n specifiers} { format {%2$.*s %4$d} 1 5 abcdefghijklmnop 44 } {abcde 44} test format-11.10 {XPG3 %$n specifiers} { list [catch {format {%2$*d} 4} msg] $msg } {1 {"%n$" argument index out of range}} test format-11.11 {XPG3 %$n specifiers} { list [catch {format {%2$*d} 4 5} msg] $msg } {1 {"%n$" argument index out of range}} test format-11.12 {XPG3 %$n specifiers} { list [catch {format {%2$*d} 4 5 6} msg] $msg } {0 { 6}} test format-12.1 {negative width specifiers} { format "%*d" -47 25 } {25 } test format-13.1 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} catch {unset d} set a 0.0000000000001 set b 0.00000000000001 set c 0.00000000000000001 set d [expr {$a + $b + $c}] format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d } {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001} test format-13.2 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} catch {unset d} set a 0.000000000001 set b 0.000000000000005 set c 0.0000000000000008 set d [expr {$a + $b + $c}] format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d } {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580} test format-13.3 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} set a 0.00000000000099 set b 0.000000000000011 set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c } {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100} test format-13.4 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} set a 0.444444444444 set b 0.33333333333333 set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c } {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300} test format-13.5 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} set a 0.444444444444 set b 0.99999999999999 set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f} $c $c $c } {1.4444444444 1.444444444444 1.444444444443990} test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} { format {%s} "" } {} test format-14.2 {testing MAX_FLOAT_SIZE for 0 and 1} { format {%s} "a" } {a} test format-15.1 {testing %0..s 0 padding for chars/strings} { format %05s a } {0000a} test format-15.2 {testing %0..s 0 padding for chars/strings} { format "% 5s" a } { a} test format-15.3 {testing %0..s 0 padding for chars/strings} { format %5s a } { a} test format-15.4 {testing %0..s 0 padding for chars/strings} { format %05c 61 } {0000=} test format-15.5 {testing %d space padding for integers} { format "(% 1d) (% 1d)" 10 -10 } {( 10) (-10)} test format-15.6 {testing %d plus padding for integers} { format "(%+1d) (%+1d)" 10 -10 } {(+10) (-10)} set a "0123456789" set b "" for {set i 0} {$i < 290} {incr i} { append b $a } for {set i 290} {$i < 400} {incr i} { test format-16.[expr {$i -289}] {testing MAX_FLOAT_SIZE} { format {%s} $b } $b append b "x" } test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} { format %d 7810179016327718216 } 1819043144 test format-17.2 {testing %ld with wide} {wideIs64bit} { format %ld 7810179016327718216 } 7810179016327718216 test format-17.3 {testing %ld with non-wide} {wideIs64bit} { format %ld 42 } 42 test format-17.4 {testing %l with non-integer} { format %lf 1 } 1.000000 test format-17.5 {testing %llu with positive bignum} -body { format %llu 0xabcdef0123456789abcdef } -returnCodes 1 -result {unsigned bignum format is invalid} test format-17.6 {testing %llu with negative number} -body { format %llu -1 } -returnCodes 1 -result {unsigned bignum format is invalid} test format-18.1 {do not demote existing numeric values} { set a 0xaaaaaaaa # Ensure $a and $b are separate objects set b 0xaaaa append b aaaa set result [expr {$a == $b}] format %08lx $b lappend result [expr {$a == $b}] set b 0xaaaa append b aaaa lappend result [expr {$a == $b}] format %08x $b lappend result [expr {$a == $b}] } {1 1 1 1} test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] } {aaaaaaab 1} test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body { set x 0x8fedc654 list [expr { ~ $x }] [format %08x [expr { ~$x }]] } -match regexp -result {-2414724693 f*701239ab} test format-19.2 {Bug 1867855} { format %llx 0 } 0 test format-19.3 {Bug 2830354} { string length [format %340f 0] } 340 test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} \ -constraints {longIs32bit} -body { # in case of overflow into negative, it produces width -2 (and limit exceeded), # in case of width will be unsigned, it will be outside limit (2GB for 32bit)... # and it don't throw an error in case the bug is not fixed (and probably no segfault). format %[expr {0xffffffff - 1}]g 0 } -returnCodes error -result "max size for a Tcl value exceeded" test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body { # limit should exceeds in any case, # and it don't throw an error in case the bug is not fixed (and probably no segfault). format %[expr {0xffffffffffffffff - 1}]g 0 } -returnCodes error -result "max size for a Tcl value exceeded" # Note that this test may fail in future versions test format-20.1 {Bug 2932421: plain %s caused internalrep change of args} -body { set x [dict create a b c d] format %s $x # After this, obj in $x should be a dict # We are testing to make sure it has not been shimmered to a # different internalrep when that is not necessary. # Whether or not there is a string rep - we should not care! tcl::unsupported::representation $x } -match glob -result {value is a dict *} # cleanup catch {unset a} catch {unset b} catch {unset c} catch {unset d} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/for-old.test0000644000175000017500000000353514554262142015255 0ustar sergeisergei# Commands covered: for, continue, break # # This file contains the original set of tests for Tcl's for command. # Since the for command is now compiled, a new set of tests covering # the new implementation is in the file "for.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Check "for" and its use of continue and break. catch {unset a i} test for-old-1.1 {for tests} { set a {} for {set i 1} {$i<6} {incr i} { set a [concat $a $i] } set a } {1 2 3 4 5} test for-old-1.2 {for tests} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==4} continue set a [concat $a $i] } set a } {1 2 3 5} test for-old-1.3 {for tests} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==4} break set a [concat $a $i] } set a } {1 2 3} test for-old-1.4 {for tests} {catch {for 1 2 3} msg} 1 test for-old-1.5 {for tests} { catch {for 1 2 3} msg set msg } {wrong # args: should be "for start test next command"} test for-old-1.6 {for tests} {catch {for 1 2 3 4 5} msg} 1 test for-old-1.7 {for tests} { catch {for 1 2 3 4 5} msg set msg } {wrong # args: should be "for start test next command"} test for-old-1.8 {for tests} { set a {xyz} for {set i 1} {$i<6} {incr i} {} set a } xyz test for-old-1.9 {for tests} { set a {} for {set i 1} {$i<6} {incr i; if {$i==4} break} { set a [concat $a $i] } set a } {1 2 3} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/for.test0000644000175000017500000011470114554262142014477 0ustar sergeisergei# Commands covered: for, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc meminfo {} {lindex [split [memory info] "\n"] 3 3} } # Basic "for" operation. test for-1.1 {TclCompileForCmd: missing initial command} { list [catch {for} msg] $msg } {1 {wrong # args: should be "for start test next command"}} test for-1.2 {TclCompileForCmd: error in initial command} -body { list [catch {for {set}} msg] $msg $::errorInfo } -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command" while *ing "for {set}"}} catch {unset i} test for-1.3 {TclCompileForCmd: missing test expression} { catch {for {set i 0}} msg set msg } {wrong # args: should be "for start test next command"} test for-1.4 {TclCompileForCmd: error in test expression} -body { catch {for {set i 0} {$i<}} msg set ::errorInfo } -match glob -result {wrong # args: should be "for start test next command" while *ing "for {set i 0} {$i<}"} test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} { set i 0 for {} "$i > 5" {incr i} {} } {} test for-1.6 {TclCompileForCmd: missing "next" command} { catch {for {set i 0} {$i < 5}} msg set msg } {wrong # args: should be "for start test next command"} test for-1.7 {TclCompileForCmd: missing command body} { catch {for {set i 0} {$i < 5} {incr i}} msg set msg } {wrong # args: should be "for start test next command"} test for-1.8 {TclCompileForCmd: error compiling command body} -body { catch {for {set i 0} {$i < 5} {incr i} {set}} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} catch {unset a} test for-1.9 {TclCompileForCmd: simple command body} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==4} break set a [concat $a $i] } set a } {1 2 3} test for-1.10 {TclCompileForCmd: command body in quotes} { set a {} for {set i 1} {$i<6} {incr i} "append a x" set a } {xxxxx} test for-1.11 {TclCompileForCmd: computed command body} { catch {unset x1} catch {unset bb} catch {unset x2} set x1 {append a x1; } set bb {break} set x2 {; append a x2} set a {} for {set i 1} {$i<6} {incr i} $x1$bb$x2 set a } {x1} test for-1.12 {TclCompileForCmd: error in "next" command} -body { catch {for {set i 0} {$i < 5} {set} {format $i}} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test for-1.13 {TclCompileForCmd: long command body} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] } set a } {1 2 3} test for-1.14 {TclCompileForCmd: for command result} { set a [for {set i 0} {$i < 5} {incr i} {}] set a } {} test for-1.15 {TclCompileForCmd: for command result} { set a [for {set i 0} {$i < 5} {incr i} {if {$i==3} break}] set a } {} # Check "for" and "continue". test for-2.1 {TclCompileContinueCmd: arguments after "continue"} { catch {continue foo} msg set msg } {wrong # args: should be "continue"} test for-2.2 {TclCompileContinueCmd: continue result} { catch continue } 4 test for-2.3 {continue tests} { set a {} for {set i 1} {$i <= 4} {incr i} { if {$i == 2} continue set a [concat $a $i] } set a } {1 3 4} test for-2.4 {continue tests} { set a {} for {set i 1} {$i <= 4} {incr i} { if {$i != 2} continue set a [concat $a $i] } set a } {2} test for-2.5 {continue tests, nested loops} { set msg {} for {set i 1} {$i <= 4} {incr i} { for {set a 1} {$a <= 2} {incr a} { if {$i>=2 && $a>=2} continue set msg [concat $msg "$i.$a"] } } set msg } {1.1 1.2 2.1 3.1 4.1} test for-2.6 {continue tests, long command body} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==2} continue if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] } set a } {1 3} test for-2.7 {continue tests, uncompiled [for]} -body { set file [makeFile { set guard 0 for {set i 20} {$i > 0} {incr i -1} { if {[incr guard]>30} {return BAD} continue } return GOOD } source.file] source $file } -cleanup { removeFile source.file } -result GOOD # Check "for" and "break". test for-3.1 {TclCompileBreakCmd: arguments after "break"} { catch {break foo} msg set msg } {wrong # args: should be "break"} test for-3.2 {TclCompileBreakCmd: break result} { catch break } 3 test for-3.3 {break tests} { set a {} for {set i 1} {$i <= 4} {incr i} { if {$i == 3} break set a [concat $a $i] } set a } {1 2} test for-3.4 {break tests, nested loops} { set msg {} for {set i 1} {$i <= 4} {incr i} { for {set a 1} {$a <= 2} {incr a} { if {$i>=2 && $a>=2} break set msg [concat $msg "$i.$a"] } } set msg } {1.1 1.2 2.1 3.1 4.1} test for-3.5 {break tests, long command body} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==2} continue if {$i==5} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i==4} break if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] } set a } {1 3} # A simplified version of exmh's mail formatting routine to stress "for", # "break", "while", and "if". proc formatMail {} { array set lines { 0 {Return-path: george@tcl} \ 1 {Return-path: } \ 2 {Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)} \ 3 { id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700} \ 4 {Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>} \ 5 {X-mailer: exmh version 1.6.9 8/22/96} \ 6 {Mime-version: 1.0} \ 7 {Content-type: text/plain; charset=iso-8859-1} \ 8 {Content-transfer-encoding: quoted-printable} \ 9 {Content-length: 2162} \ 10 {To: fred} \ 11 {Subject: tcl7.6} \ 12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \ 13 {From: George } \ 14 {The Tcl 7.6 and Tk 4.2 releases} \ 15 {} \ 16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \ 17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \ 18 {releases were released on August 30, 1996. These releases contain only minor changes,} \ 19 {so we hope to have only a single beta release and to go final in early October, 1996.} \ 20 {} \ 21 {} \ 22 {What's new} \ 23 {} \ 24 {The most important changes in the releases are summarized below. See the README} \ 25 {and changes files in the distributions for more complete information on what has} \ 26 {changed, including both feature changes and bug fixes.} \ 27 {} \ 28 { There are new options to the file command for copying files (file copy),} \ 29 { deleting files and directories (file delete), creating directories (file} \ 30 { mkdir), and renaming files (file rename).} \ 31 { The implementation of exec has been improved greatly for Windows 95 and} \ 32 { Windows NT.} \ 33 { There is a new memory allocator for the Macintosh version, which should be} \ 34 { more efficient than the old one.} \ 35 { Tk's grid geometry manager has been completely rewritten. The layout} \ 36 { algorithm produces much better layouts than before, especially where rows or} \ 37 { columns were stretchable.} \ 38 { There are new commands for creating common dialog boxes:} \ 39 { tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \ 40 { tk_messageBox. These use native dialog boxes if they are available.} \ 41 { There is a new virtual event mechanism for handling events in a more portable} \ 42 { way. See the new command event. It also allows events (both physical and} \ 43 { virtual) to be generated dynamically.} \ 44 {} \ 45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \ 46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \ 47 {should work on these new releases as well.} \ 48 {} \ 49 {Obtaining The Releases} \ 50 {} \ 51 {Binary Releases} \ 52 {} \ 53 {Precompiled releases are available for the following platforms: } \ 54 {} \ 55 { Windows 3.1, Windows 95, and Windows NT: Fetch} \ 56 { ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \ 57 { self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \ 58 { tclsh programs, and documentation.} \ 59 { Macintosh (both 68K and PowerPC): Fetch} \ 60 { ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \ 61 { which is understood by Fetch, StuffIt, and many other Mac utilities. The} \ 62 { unpacked file is a self-installing executable: double-click on it and it will create a} \ 63 { folder containing all that you need to run Tcl and Tk. } \ 64 { UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \ 65 { binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \ } set result "" set NL " " set tag {level= type=text/plain part=0 sel Charset} set ix [lsearch -regexp $tag text/enriched] if {$ix < 0} { set ranges {} set quote 0 } set breakrange {6.42 78.0} set F1 [lindex $breakrange 0] set F2 [lindex $breakrange 1] set breakrange [lrange $breakrange 2 end] if {[string length $F1] == 0} { set F1 -1 set break 0 } else { set break 1 } set xmailer 0 set inheaders 1 set last [array size lines] set plen 2 for {set L 1} {$L < $last} {incr L} { set line $lines($L) if {$inheaders} { # Blank or empty line terminates headers # Leading --- terminates headers if {[regexp {^[ ]*$} $line] || [regexp {^--+} $line]} { set inheaders 0 } if {[regexp -nocase {^x-mailer:} $line]} { continue } } if {$inheaders} { set limit 55 } else { set limit 55 # Decide whether or not to break the body line if {$plen > 0} { if {[string first {> } $line] == 0} { # This is quoted text from previous message, don't reformat append result $line $NL if {$quote && !$inheaders} { # Fix from to handle text/enriched if {$L > $L1 && $L < $L2 && $line != {}} { # enriched requires two newlines for each one. append result $NL } elseif {$L > $L2} { set L1 [lindex $ranges 0] set L2 [lindex $ranges 1] set ranges [lrange $ranges 2 end] set quote [llength $L1] } } continue } } if {$F1 < 0} { # Nothing left to format append result $line $NL continue } elseif {$L < $F1} { # Not yet to formatted block append result $line $NL continue } elseif {$L > $F2} { # Past formatted block set F1 [lindex $breakrange 0] set F2 [lindex $breakrange 1] set breakrange [lrange $breakrange 2 end] append result $line $NL if {[string length $F1] == 0} { set F1 -1 } continue } } set climit [expr {$limit-1}] set cutoff 50 set continuation 0 while {[string length $line] > $limit} { for {set c [expr {$limit-1}]} {$c >= $cutoff} {incr c -1} { set char [string index $line $c] if {$char == " " || $char == "\t"} { break } if {$char == ">"} { ;# Hack for enriched formatting break } } if {$c < $cutoff} { if {! $inheaders} { set c [expr {$limit-1}] } else { set c [string length $line] } } set newline [string trimright [string range $line 0 $c]] if {! $continuation} { append result $newline $NL } else { append result \ $newline $NL } incr c set line [string trimright [string range $line $c end]] if {$inheaders} { set continuation 1 set limit $climit } } if {$continuation} { if {[string length $line] != 0} { append result \ $line $NL } } else { append result $line $NL if {$quote && !$inheaders} { if {$L > $L1 && $L < $L2 && $line != {}} { # enriched requires two newlines for each one. append result "" $NL } elseif {$L > $L2} { set L1 [lindex $ranges 0] set L2 [lindex $ranges 1] set ranges [lrange $ranges 2 end] set quote [llength $L1] } } } } return $result } test for-3.6 {break tests} { formatMail } {Return-path: Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4) id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700 Message-id: <199609111814.LAA10027@tcl.Somewhere.COM> Mime-version: 1.0 Content-type: text/plain; charset=iso-8859-1 Content-transfer-encoding: quoted-printable Content-length: 2162 To: fred Subject: tcl7.6 Date: Wed, 11 Sep 1996 11:14:53 -0700 From: George The Tcl 7.6 and Tk 4.2 releases This page contains information about Tcl 7.6 and Tk4.2, which are the most recent releases of the Tcl scripting language and the Tk toolk it. The first beta versions of these releases were released on August 30, 1996. These releas es contain only minor changes, so we hope to have only a single beta release and to go final in early October, 1996. What's new The most important changes in the releases are summariz ed below. See the README and changes files in the distributions for more complet e information on what has changed, including both feature changes and bug fixes. There are new options to the file command for copying files (file copy), deleting files and directories (file delete), creating directories (file mkdir), and renaming files (file rename). The implementation of exec has been improved great ly for Windows 95 and Windows NT. There is a new memory allocator for the Macintosh version, which should be more efficient than the old one. Tk's grid geometry manager has been completely rewritten. The layout algorithm produces much better layouts than before , especially where rows or columns were stretchable. There are new commands for creating common dialog boxes: tk_chooseColor, tk_getOpenFile, tk_getSaveFile and tk_messageBox. These use native dialog boxes if they are available. There is a new virtual event mechanism for handlin g events in a more portable way. See the new command event. It also allows events (both physical and virtual) to be generated dynamically. Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for changes in the C APIs for custom channel drivers. Scrip ts written for earlier releases should work on these new releases as well. Obtaining The Releases Binary Releases Precompiled releases are available for the following platforms: Windows 3.1, Windows 95, and Windows NT: Fetch ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a self-extracting executable. It will install the Tcl and Tk libraries, the wish and tclsh programs, and documentation. Macintosh (both 68K and PowerPC): Fetch ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format, which is understood by Fetch, StuffIt, and many other Mac utilities. The unpacked file is a self-installing executable: double-click on it and it will create a folder containing all that you need to run Tcl and Tk. UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out! } # Check that "break" resets the interpreter's result test for-4.1 {break must reset the interp result} { catch { set z GLOBTESTDIR/dir2/file2.c if {[string match GLOBTESTDIR/dir2/* $z]} { break } } j set j } {} # Test for incorrect "double evaluation" semantics test for-5.1 {possible delayed substitution of increment command} { # Increment should be 5, and lappend should always append $a catch {unset a} catch {unset i} set a 5 set i {} for {set a 1} {$a < 12} "incr a $a" {lappend i $a} set i } {1 6 11} test for-5.2 {possible delayed substitution of increment command} { # Increment should be 5, and lappend should always append $a catch {rename p ""} proc p {} { set a 5 set i {} for {set a 1} {$a < 12} "incr a $a" {lappend i $a} set i } p } {1 6 11} test for-5.3 {possible delayed substitution of body command} { # Increment should be $a, and lappend should always append 5 set a 5 set i {} for {set a 1} {$a < 12} {incr a $a} "lappend i $a" set i } {5 5 5 5} test for-5.4 {possible delayed substitution of body command} { # Increment should be $a, and lappend should always append 5 catch {rename p ""} proc p {} { set a 5 set i {} for {set a 1} {$a < 12} {incr a $a} "lappend i $a" set i } p } {5 5 5 5} # In the following tests we need to bypass the bytecode compiler by # substituting the command from a variable. This ensures that command # procedure is invoked directly. test for-6.1 {Tcl_ForObjCmd: number of args} { set z for catch {$z} msg set msg } {wrong # args: should be "for start test next command"} test for-6.2 {Tcl_ForObjCmd: number of args} { set z for catch {$z {set i 0}} msg set msg } {wrong # args: should be "for start test next command"} test for-6.3 {Tcl_ForObjCmd: number of args} { set z for catch {$z {set i 0} {$i < 5}} msg set msg } {wrong # args: should be "for start test next command"} test for-6.4 {Tcl_ForObjCmd: number of args} { set z for catch {$z {set i 0} {$i < 5} {incr i}} msg set msg } {wrong # args: should be "for start test next command"} test for-6.5 {Tcl_ForObjCmd: number of args} { set z for catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg set msg } {wrong # args: should be "for start test next command"} test for-6.6 {Tcl_ForObjCmd: error in initial command} -body { set z for list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $::errorInfo } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" while *ing "set" ("for" initial command) invoked from within "$z {set} {$i < 5} {incr i} {body}"}} test for-6.7 {Tcl_ForObjCmd: error in test expression} -body { set z for catch {$z {set i 0} {i < 5} {incr i} {body}} set ::errorInfo } -match glob -result {*"$z {set i 0} {i < 5} {incr i} {body}"} test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} { set z for set i 0 $z {set i 6} "$i > 5" {incr i} {set y $i} set i } 6 test for-6.9 {Tcl_ForObjCmd: error executing command body} -body { set z for catch {$z {set i 0} {$i < 5} {incr i} {set}} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set" ("for" body line 1) invoked from within "$z {set i 0} {$i < 5} {incr i} {set}"} test for-6.10 {Tcl_ForObjCmd: simple command body} { set z for set a {} $z {set i 1} {$i<6} {incr i} { if {$i==4} break set a [concat $a $i] } set a } {1 2 3} test for-6.11 {Tcl_ForObjCmd: command body in quotes} { set z for set a {} $z {set i 1} {$i<6} {incr i} "append a x" set a } {xxxxx} test for-6.12 {Tcl_ForObjCmd: computed command body} { set z for catch {unset x1} catch {unset bb} catch {unset x2} set x1 {append a x1; } set bb {break} set x2 {; append a x2} set a {} $z {set i 1} {$i<6} {incr i} $x1$bb$x2 set a } {x1} test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body { set z for catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set" ("for" loop-end command) invoked from within "$z {set i 0} {$i < 5} {set} {set j 4}"} test for-6.14 {Tcl_ForObjCmd: long command body} { set z for set a {} $z {set i 1} {$i<6} {incr i} { if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] } set a } {1 2 3} test for-6.15 {Tcl_ForObjCmd: for command result} { set z for set a [$z {set i 0} {$i < 5} {incr i} {}] set a } {} test for-6.16 {Tcl_ForObjCmd: for command result} { set z for set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] set a } {} test for-6.17 {Tcl_ForObjCmd: for command result} { list \ [catch {for {break} {1} {} {}} err] $err \ [catch {for {continue} {1} {} {}} err] $err \ [catch {for {} {[break]} {} {}} err] $err \ [catch {for {} {[continue]} {} {}} err] $err \ [catch {for {} {1} {break} {}} err] $err \ [catch {for {} {1} {continue} {}} err] $err \ } [list \ 3 {} \ 4 {} \ 3 {} \ 4 {} \ 0 {} \ 4 {} \ ] test for-6.18 {Tcl_ForObjCmd: for command result} { proc p6181 {} { for {break} {1} {} {} } proc p6182 {} { for {continue} {1} {} {} } proc p6183 {} { for {} {[break]} {} {} } proc p6184 {} { for {} {[continue]} {} {} } proc p6185 {} { for {} {1} {break} {} } proc p6186 {} { for {} {1} {continue} {} } list \ [catch {p6181} err] $err \ [catch {p6182} err] $err \ [catch {p6183} err] $err \ [catch {p6184} err] $err \ [catch {p6185} err] $err \ [catch {p6186} err] $err } [list \ 1 {invoked "break" outside of a loop} \ 1 {invoked "continue" outside of a loop} \ 1 {invoked "break" outside of a loop} \ 1 {invoked "continue" outside of a loop} \ 0 {} \ 1 {invoked "continue" outside of a loop} \ ] test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {$x < 5} {incr x} { list a b c [break] d e f } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {$x < 5} {incr x} { list a b c [continue] d e f } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts {*}[puts a b c {*}[break] d e f] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts {*}[puts a b c {*}[continue] d e f] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory { apply {{} { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory { apply {{} { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory { apply {{} { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] }] set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory { apply {{} { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] }] set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {$x < 5} {incr x} { list a b c [apply {{} {return -code break}}] d e f } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {$x < 5} {incr x} { list a b c [apply {{} {return -code continue}}] d e f } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts {*}[puts a b c {*}[apply {{} { return -code continue }}] d e f] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory { apply {{} { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { return -code break }}] d e f]] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory { apply {{} { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { return -code continue }}] d e f]] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory { apply {{} { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { return -code break }}] d e f]] }] set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory { apply {{} { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { return -code continue }}] d e f]] }] set tmp $end set end [meminfo] } expr {$end - $tmp} }} } 0 test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory { apply {op { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {$x < 5} {incr x} { list a b c [{*}$op] d e f } set tmp $end set end [meminfo] } expr {$end - $tmp} }} {return -level 0 -code break} } 0 test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory { apply {op { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {$x < 5} {incr x} { list a b c [{*}$op] d e f } set tmp $end set end [meminfo] } expr {$end - $tmp} }} {return -level 0 -code continue} } 0 test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory { apply {op { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts {*}[puts a b c {*}[{*}$op] d e f] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} {return -level 0 -code break} } 0 test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory { apply {op { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts {*}[puts a b c {*}[{*}$op] d e f] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} {return -level 0 -code continue} } 0 test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory { apply {op { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} {return -level 0 -code break} } 0 test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory { apply {op { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] } set tmp $end set end [meminfo] } expr {$end - $tmp} }} {return -level 0 -code continue} } 0 test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory { apply {op { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] }] set tmp $end set end [meminfo] } expr {$end - $tmp} }} {return -level 0 -code break} } 0 test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory { apply {op { set l [lrepeat 50 p q r] # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] }] set tmp $end set end [meminfo] } expr {$end - $tmp} }} {return -level 0 -code continue} } 0 test for-8.0 {Coverity CID 1251203: break vs continue in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i; list a [eval {}]} { incr j }] incr i } list $i $j $k }} } {6 5 3} test for-8.1 {Coverity CID 1251203: break vs continue in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i;list a [eval break]} { incr j }] incr i } list $i $j $k }} } {2 1 3} test for-8.2 {Coverity CID 1251203: break vs continue in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i;list a [eval continue]} { incr j }] incr i } list $i $j $k }} } {1 1 3} test for-8.3 {break in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i; break} { incr j }] incr i } list $i $j $k }} } {2 1 3} test for-8.4 {continue in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i; continue} { incr j }] incr i } list $i $j $k }} } {1 1 3} test for-8.5 {break in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i; list a [break]} { incr j }] incr i } list $i $j $k }} } {2 1 3} test for-8.6 {continue in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i; list a [continue]} { incr j }] incr i } list $i $j $k }} } {1 1 3} test for-8.7 {break in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i;eval break} { incr j }] incr i } list $i $j $k }} } {2 1 3} test for-8.8 {continue in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 list a [\ for {set i 0} {$i < 5} {incr i;eval continue} { incr j }] incr i } list $i $j $k }} } {1 1 3} test for-8.9 {break in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 for {set i 0} {$i < 5} {incr i;eval break} { incr j } incr i } list $i $j $k }} } {2 1 3} test for-8.10 {continue in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 for {set i 0} {$i < 5} {incr i;eval continue} { incr j } incr i } list $i $j $k }} } {1 1 3} test for-8.11 {break in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 for {set i 0} {$i < 5} {incr i;break} { incr j } incr i } list $i $j $k }} } {2 1 3} test for-8.12 {continue in for-step clause} { apply {{} { for {set k 0} {$k < 3} {incr k} { set j 0 for {set i 0} {$i < 5} {incr i;continue} { incr j } incr i } list $i $j $k }} } {1 1 3} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/get.test0000644000175000017500000001221714554262142014467 0ustar sergeisergei# Commands covered: none # # This file contains a collection of tests for the procedures in the # file tclGet.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testgetint [llength [info commands testgetint]] testConstraint testdoubleobj [llength [info commands testdoubleobj]] test get-1.1 {Tcl_GetInt procedure} testgetint { testgetint 44 { 22} } {66} test get-1.2 {Tcl_GetInt procedure} testgetint { testgetint 44 -3 } {41} test get-1.3 {Tcl_GetInt procedure} testgetint { testgetint 44 +8 } {52} test get-1.4 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 44 foo} msg] $msg } {1 {expected integer but got "foo"}} test get-1.5 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 44 {16 }} msg] $msg } {0 60} test get-1.6 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 44 {16 x}} msg] $msg } {1 {expected integer but got "16 x"}} test get-1.7 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.8 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 18446744073709551614} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.9 {Tcl_GetInt procedure} testgetint { list [catch {testgetint +18446744073709551614} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.10 {Tcl_GetInt procedure} testgetint { list [catch {testgetint -18446744073709551614} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.11 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 44 4294967296} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.12 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 4294967294} msg] $msg } {0 -2} test get-1.13 {Tcl_GetInt procedure} testgetint { list [catch {testgetint +4294967294} msg] $msg } {0 -2} test get-1.14 {Tcl_GetInt procedure} testgetint { list [catch {testgetint -4294967294} msg] $msg } {0 2} test get-2.1 {Tcl_GetInt procedure} { format %g 1.23 } {1.23} test get-2.2 {Tcl_GetInt procedure} { format %g { 1.23 } } {1.23} test get-2.3 {Tcl_GetInt procedure} { list [catch {format %g clip} msg] $msg } {1 {expected floating-point number but got "clip"}} test get-2.4 {Tcl_GetInt procedure} { format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 } 0 test get-3.1 {Tcl_GetInt(FromObj), bad numbers} { # SF bug #634856 set result "" set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1" "+12345678987654321" "++12345678987654321"] foreach num $numbers { lappend result [catch {format %ld $num} msg] $msg } set result } {0 1 0 1 1 {expected integer but got "++1"} 1 {expected integer but got "+-1"} 1 {expected integer but got "-+1"} 0 -1 1 {expected integer but got "--1"} 1 {expected integer but got "- +1"} 0 12345678987654321 1 {expected integer but got "++12345678987654321"}} test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} { set result "" set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"] foreach num $numbers { lappend result [catch {format %g $num} msg] $msg } set result } {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}} # Bug 7114ac6141 test get-3.3 {tcl_GetInt with iffy numbers} testgetint { lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} { catch {testgetint 44 $x} x set x } } {44 44 44 44 54 52 52 46} test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { catch {testdoubleobj set 1 $x} x set x } } {0.0 0.0 0.0 0.0 0.0 {expected floating-point number but got "09" (looks like invalid octal number)} {expected floating-point number but got "- 0"} 0.0 10.0 2.0} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/history.test0000644000175000017500000002332514560736524015422 0ustar sergeisergei# Commands covered: history # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # The history command might be autoloaded... if {[catch {history}]} { testConstraint history 0 } else { testConstraint history 1 } if {[testConstraint history]} { set num [history nextid] history keep 3 history add {set a 12345} history add {set b [format {A test %s} string]} history add {Another test} } else { # Dummy value, must be numeric set num 0 } # "history event" test history-1.1 {event option} history {history event -1} \ {set b [format {A test %s} string]} test history-1.2 {event option} history {history event $num} \ {set a 12345} test history-1.3 {event option} history {history event [expr {$num+2}]} \ {Another test} test history-1.4 {event option} history {history event set} \ {set b [format {A test %s} string]} test history-1.5 {event option} history {history e "* a*"} \ {set a 12345} test history-1.6 {event option} history {catch {history event *gorp} msg} 1 test history-1.7 {event option} history { catch {history event *gorp} msg set msg } {no event matches "*gorp"} test history-1.8 {event option} history {history event} \ {set b [format {A test %s} string]} test history-1.9 {event option} history {catch {history event 123 456} msg} 1 test history-1.10 {event option} -constraints history -body { catch {history event 123 456} msg set msg } -match glob -result {wrong # args: should be "*history event \?event\?"} # "history redo" if {[testConstraint history]} { set a 0 history redo -2 } test history-2.1 {redo option} history {set a} 12345 if {[testConstraint history]} { set b 0 history redo } test history-2.2 {redo option} history {set b} {A test string} test history-2.3 {redo option} history {catch {history redo -3 -4}} 1 test history-2.4 {redo option} -constraints history -body { catch {history redo -3 -4} msg set msg } -match glob -result {wrong # args: should be "*history redo \?event\?"} # "history add" if {[testConstraint history]} { history add "set a 444" exec } test history-3.1 {add option} history {set a} 444 test history-3.2 {add option} history {catch {history add "set a 444" execGorp}} 1 test history-3.3 {add option} history { catch {history add "set a 444" execGorp} msg set msg } {bad argument "execGorp": should be "exec"} test history-3.4 {add option} history {catch {history add "set a 444" a} msg} 1 test history-3.5 {add option} history { catch {history add "set a 444" a} msg set msg } {bad argument "a": should be "exec"} if {[testConstraint history]} { history add "set a 555" e } test history-3.6 {add option} history {set a} 555 if {[testConstraint history]} { history add "set a 666" } test history-3.7 {add option} history {set a} 555 test history-3.8 {add option} history {catch {history add "set a 666" e f} msg} 1 test history-3.9 {add option} -constraints history -body { catch {history add "set a 666" e f} msg set msg } -match glob -result {wrong # args: should be "*history add event \?exec\?"} # "history change" if {[testConstraint history]} { history change "A test value" } test history-4.1 {change option} history {history event [expr {[history n]-1}]} \ "A test value" if {[testConstraint history]} { history ch "Another test" -1 } test history-4.2 {change option} history {history e} "Another test" test history-4.3 {change option} history {history event [expr {[history n]-1}]} \ "A test value" test history-4.4 {change option} history {catch {history change Foo 4 10}} 1 test history-4.5 {change option} -constraints history -body { catch {history change Foo 4 10} msg set msg } -match glob -result {wrong # args: should be "*history change newValue \?event\?"} test history-4.6 {change option} history { catch {history change Foo [expr {[history n]-4}]} } 1 if {[testConstraint history]} { set num [expr {[history n]-4}] } test history-4.7 {change option} history { catch {history change Foo $num} msg set msg } "event \"$num\" is too far in the past" # "history info" if {[testConstraint history]} { set num [history n] history add set\ a\ {b\nc\ d\ e} history add {set b 1234} history add set\ c\ {a\nb\nc} } test history-5.1 {info option} history {history info} [format {%6d set a {b c d e} %6d set b 1234 %6d set c {a b c}} $num [expr {$num+1}] [expr {$num+2}]] test history-5.2 {info option} history {history i 2} [format {%6d set b 1234 %6d set c {a b c}} [expr {$num+1}] [expr {$num+2}]] test history-5.3 {info option} history {catch {history i 2 3}} 1 test history-5.4 {info option} -constraints history -body { catch {history i 2 3} msg set msg } -match glob -result {wrong # args: should be "*history info \?count\?"} test history-5.5 {info option} history {history} [format {%6d set a {b c d e} %6d set b 1234 %6d set c {a b c}} $num [expr {$num+1}] [expr {$num+2}]] # "history keep" if {[testConstraint history]} { history add "foo1" history add "foo2" history add "foo3" history keep 2 } test history-6.1 {keep option} history { history event [expr {[history n]-1}] } foo3 test history-6.2 {keep option} history {history event -1} foo2 test history-6.3 {keep option} history {catch {history event -3}} 1 test history-6.4 {keep option} history { catch {history event -3} msg set msg } {event "-3" is too far in the past} if {[testConstraint history]} { history k 5 } test history-6.5 {keep option} history {history event -1} foo2 test history-6.6 {keep option} history {history event -2} {} test history-6.7 {keep option} history {history event -3} {} test history-6.8 {keep option} history {history event -4} {} test history-6.9 {keep option} history {catch {history event -5}} 1 test history-6.10 {keep option} history {catch {history keep 4 6}} 1 test history-6.11 {keep option} -constraints history -body { catch {history keep 4 6} msg set msg } -match glob -result {wrong # args: should be "*history keep \?count\?"} test history-6.12 {keep option} history {catch {history keep}} 0 test history-6.13 {keep option} history { history keep } {5} test history-6.14 {keep option} history {catch {history keep -3}} 1 test history-6.15 {keep option} history { catch {history keep -3} msg set msg } {illegal keep count "-3"} test history-6.16 {keep option} history { catch {history keep butter} msg set msg } {illegal keep count "butter"} # "history nextid" if {[testConstraint history]} { set num [history n] history add "Testing" history add "Testing2" } test history-7.1 {nextid option} history {history event} "Testing" test history-7.2 {nextid option} history {history next} [expr {$num+2}] test history-7.3 {nextid option} history {catch {history nextid garbage}} 1 test history-7.4 {nextid option} -constraints history -body { catch {history nextid garbage} msg set msg } -match glob -result {wrong # args: should be "*history nextid"} # "history clear" if {[testConstraint history]} { set num [history n] history add "Testing" history add "Testing2" } test history-8.1 {clear option} history {catch {history clear junk}} 1 test history-8.2 {clear option} history {history clear} {} if {[testConstraint history]} { history clear history add "Testing" } test history-8.3 {clear option} history {history} { 1 Testing} # miscellaneous test history-9.1 {miscellaneous} history {catch {history gorp} msg} 1 test history-9.2 {miscellaneous} history { catch {history gorp} msg set msg } {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, nextid, or redo} # History retains references; Bug 1ae12987cb test history-10.1 {references kept by history} -constraints history -setup { interp create histtest histtest eval { # Trigger any autoloading that might be present catch {history} proc refcount {x} { set rep [::tcl::unsupported::representation $x] regexp {with a refcount of (\d+)} $rep -> rc # Ignore the references due to calling this procedure return [expr {$rc - 3}] } } } -body { histtest eval { # A fresh object, refcount 1 from the variable we write it to set obj [expr {rand()}] set baseline [refcount $obj] lappend result [refcount $obj] history add [list list $obj] lappend result [refcount $obj] history clear lappend result [refcount $obj] } } -cleanup { interp delete histtest } -result {1 2 1} test history-10.2 {references kept by history} -constraints history -setup { interp create histtest histtest eval { # Trigger any autoloading that might be present catch {history} proc refcount {x} { set rep [::tcl::unsupported::representation $x] regexp {with a refcount of (\d+)} $rep -> rc # Ignore the references due to calling this procedure return [expr {$rc - 3}] } } } -body { histtest eval { # A fresh object, refcount 1 from the variable we write it to set obj [expr {rand()}] set baseline [refcount $obj] lappend result [refcount $obj] history add [list list $obj] lappend result [refcount $obj] rename history {} lappend result [refcount $obj] } } -cleanup { interp delete histtest } -result {1 2 1} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/http11.test0000644000175000017500000010356014554262142015033 0ustar sergeisergei# http11.test -- -*- tcl-*- # # Test HTTP/1.1 features. # # Copyright (C) 2009 Pat Thoyts # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } package require http 2.9 # start the server variable httpd_output proc create_httpd {} { proc httpd_read {chan} { variable httpd_output if {[gets $chan line] >= 0} { #puts stderr "read '$line'" set httpd_output $line } if {[eof $chan]} { puts stderr "eof from httpd" fileevent $chan readable {} close $chan } } variable httpd_output set httpd_script [file join [pwd] [file dirname [info script]] httpd11.tcl] set httpd [open "|[list [interpreter] -encoding utf-8 $httpd_script]" r+] fconfigure $httpd -buffering line -blocking 0 fileevent $httpd readable [list httpd_read $httpd] vwait httpd_output variable httpd_port [lindex $httpd_output 2] return $httpd } proc halt_httpd {} { variable httpd_output variable httpd if {[info exists httpd]} { puts $httpd "quit" vwait httpd_output close $httpd } unset -nocomplain httpd_output httpd } proc meta {tok {key ""}} { set meta [http::meta $tok] if {$key ne ""} { if {[dict exists $meta $key]} { return [dict get $meta $key] } else { return "" } } return $meta } proc state {tok {key ""}} { upvar 1 $tok state if {$key ne ""} { if {[array names state -exact $key] ne {}} { return $state($key) } else { return "" } } set res [array get state] dict set res body return $res } proc check_crc {tok args} { set crc [meta $tok x-crc32] set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}] set chk [format %x [zlib crc32 $data]] if {$crc ne $chk} { return "crc32 mismatch: $crc ne $chk" } return "ok" } makeFile "test

this is a test

\n[string repeat {

This is a tcl test file.

} 4192]\n" testdoc.html # ------------------------------------------------------------------------- test http11-1.0 "normal request for document " -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html -timeout 10000] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] [meta $tok connection] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close} test http11-1.1 "normal,gzip,non-chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -headers {accept-encoding gzip}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok gzip {}} test http11-1.2 "normal,deflated,non-chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -headers {accept-encoding deflate}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate {}} test http11-1.3 "normal,compressed,non-chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -headers {accept-encoding compress}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok compress {}} test http11-1.4 "normal,identity,non-chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -headers {accept-encoding identity}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} {}} test http11-1.5 "normal request for document, unsupported coding" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 10000 -headers {accept-encoding unsupported}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {}} test http11-1.6 "normal, specify 1.1 " -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -protocol 1.1 -timeout 10000] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok connection] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close chunked} test http11-1.7 "normal, 1.1 and keepalive " -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -protocol 1.1 -keepalive 1 -timeout 10000] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok connection] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} chunked} test http11-1.8 "normal, 1.1 and keepalive, server close" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -protocol 1.1 -keepalive 1 -timeout 10000] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok connection] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {}} test http11-1.9 "normal,gzip,chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 10000 -headers {accept-encoding gzip}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok gzip chunked} test http11-1.10 "normal,deflate,chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 10000 -headers {accept-encoding deflate}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate chunked} test http11-1.11 "normal,compress,chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 10000 -headers {accept-encoding compress}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok compress chunked} test http11-1.12 "normal,identity,chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 10000 -headers {accept-encoding identity}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} chunked} test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup { variable httpd [create_httpd] set zipTmp [http::config -zip] http::config -zip 0 } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \ -protocol 1.1 -keepalive 1 -timeout 10000] http::wait $tok set res1 [list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok connection] [meta $tok transfer-encoding] [state $tok reusing] [state $tok connection]] set toj [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \ -protocol 1.1 -keepalive 1 -timeout 10000] http::wait $toj set res2 [list [http::status $toj] [http::code $toj] [check_crc $toj] \ [meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]] concat $res1 -- $res2 } -cleanup { http::cleanup $tok http::cleanup $toj halt_httpd http::config -zip $zipTmp } -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive} # ------------------------------------------------------------------------- proc progress {var token total current} { upvar #0 $var log set log [list $current $total] return } proc progressPause {var token total current} { upvar #0 $var log set log [list $current $total] after 100 set ::WaitHere 0 vwait ::WaitHere return } test http11-2.0 "-channel" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close chunked} test http11-2.1 "-channel, encoding gzip" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan -headers {accept-encoding gzip}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close gzip chunked} test http11-2.2 "-channel, encoding deflate" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan -headers {accept-encoding deflate}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close deflate chunked} test http11-2.3 "-channel,encoding compress" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan \ -headers {accept-encoding compress}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close compress chunked} test http11-2.4 "-channel,encoding identity" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan \ -headers {accept-encoding identity}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} chunked} test http11-2.4.1 "-channel,encoding identity with -progress" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] set logdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan \ -headers {accept-encoding identity} \ -progress [namespace code [list progress logdata]]] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] \ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length $data]}] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd unset -nocomplain logdata data } -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0} test http11-2.4.2 "-channel,encoding identity with -progress progressPause enters event loop" -constraints knownBug -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] set logdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan \ -headers {accept-encoding identity} \ -progress [namespace code [list progressPause logdata]]] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] \ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length $data]}] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd unset -nocomplain logdata data ::WaitHere } -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0} test http11-2.5 "-channel,encoding unsupported" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan \ -headers {accept-encoding unsupported}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} chunked} test http11-2.6 "-channel,encoding gzip,non-chunked" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 5000 -channel $chan -headers {accept-encoding gzip}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close gzip {} 0} test http11-2.7 "-channel,encoding deflate,non-chunked" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 5000 -channel $chan -headers {accept-encoding deflate}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0} test http11-2.8 "-channel,encoding compress,non-chunked" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 5000 -channel $chan -headers {accept-encoding compress}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close compress {} 0} test http11-2.9 "-channel,encoding identity,non-chunked" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 5000 -channel $chan -headers {accept-encoding identity}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0} test http11-2.10 "-channel,deflate,keepalive" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan -keepalive 1 \ -headers {accept-encoding deflate}] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0} test http11-2.11 "-channel,identity,keepalive" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -headers {accept-encoding identity} \ -timeout 5000 -channel $chan -keepalive 1] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} {} chunked} test http11-2.12 "-channel,negotiate,keepalive" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 5000 -channel $chan -keepalive 1] http::wait $tok seek $chan 0 set data [read $chan] list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] [meta $tok x-requested-encodings]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} gzip chunked gzip,deflate,compress 0} # ------------------------------------------------------------------------- # # The following tests for the -handler option will require changes in # the future. At the moment we cannot handler chunked data with this # option. Therefore we currently force HTTP/1.0 protocol version. # # Once this is solved, these tests should be fixed to assume chunked # returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1 proc handler {var sock token} { upvar #0 $var data set chunk [read $sock] append data $chunk #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])" return [string length $chunk] } proc handlerPause {var sock token} { upvar #0 $var data set chunk [read $sock] append data $chunk #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])" after 100 set ::WaitHere 0 vwait ::WaitHere return [string length $chunk] } test http11-3.0 "-handler,close,identity" -setup { variable httpd [create_httpd] set testdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -handler [namespace code [list handler testdata]]] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { http::cleanup $tok unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} test http11-3.1 "-handler,protocol1.0" -setup { variable httpd [create_httpd] set testdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -protocol 1.0 \ -handler [namespace code [list handler testdata]]] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { http::cleanup $tok unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} test http11-3.2 "-handler,close,chunked" -setup { variable httpd [create_httpd] set testdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 10000 -keepalive 0 -binary 1\ -handler [namespace code [list handler testdata]]] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { http::cleanup $tok unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} test http11-3.3 "-handler,keepalive,chunked" -setup { variable httpd [create_httpd] set testdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -timeout 10000 -keepalive 1 -binary 1\ -handler [namespace code [list handler testdata]]] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { http::cleanup $tok unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} # http11-3.4 # This test is a blatant attempt to confuse the client by instructing the server # to send neither "Connection: close" nor "Content-Length" when in non-chunked # mode. # The client has no way to know the response-body is complete unless the # server signals this by closing the connection. # In an HTTP/1.1 response the absence of "Connection: close" means # "Connection: keep-alive", i.e. the server will keep the connection # open. In HTTP/1.0 this is not the case, and this is a test that # the Tcl client assumes "Connection: close" by default in HTTP/1.0. test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup { variable httpd [create_httpd] set testdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1&nosendclose=any \ -timeout 10000 -handler [namespace code [list handler testdata]]] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { http::cleanup $tok unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0} # It is not forbidden for a handler to enter the event loop. test http11-3.5 "-handler,close,identity as http11-3.0 but handlerPause enters event loop" -setup { variable httpd [create_httpd] set testdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -handler [namespace code [list handlerPause testdata]]] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { http::cleanup $tok unset -nocomplain testdata ::WaitHere halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} test http11-3.6 "-handler,close,identity as http11-3.0 but with -progress" -setup { variable httpd [create_httpd] set testdata "" set logdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -handler [namespace code [list handler testdata]] \ -progress [namespace code [list progress logdata]]] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] \ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length $testdata]}] } -cleanup { http::cleanup $tok unset -nocomplain testdata logdata ::WaitHere halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0} test http11-3.7 "-handler,close,identity as http11-3.0 but with -progress progressPause enters event loop" -setup { variable httpd [create_httpd] set testdata "" set logdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 -handler [namespace code [list handler testdata]] \ -progress [namespace code [list progressPause logdata]]] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] \ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length $testdata]}] } -cleanup { http::cleanup $tok unset -nocomplain testdata logdata ::WaitHere halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0} test http11-3.8 "close,identity no -handler but with -progress" -setup { variable httpd [create_httpd] set logdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 \ -progress [namespace code [list progress logdata]] \ -headers {accept-encoding {}}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length [http::data $tok]]}] } -cleanup { http::cleanup $tok unset -nocomplain logdata ::WaitHere halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0} test http11-3.9 "close,identity no -handler but with -progress progressPause enters event loop" -setup { variable httpd [create_httpd] set logdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ -timeout 10000 \ -progress [namespace code [list progressPause logdata]] \ -headers {accept-encoding {}}] http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok]\ [meta $tok connection] [meta $tok content-encoding] \ [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length [http::data $tok]]}] } -cleanup { http::cleanup $tok unset -nocomplain logdata ::WaitHere halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0} test http11-4.0 "normal post request" -setup { variable httpd [create_httpd] } -body { set query [http::formatQuery q 1 z 2] set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -query $query -timeout 10000] http::wait $tok list status [http::status $tok] code [http::code $tok]\ crc [check_crc $tok]\ connection [meta $tok connection]\ query-length [meta $tok x-query-length] } -cleanup { http::cleanup $tok halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7} test http11-4.1 "normal post request, check query length" -setup { variable httpd [create_httpd] } -body { set query [http::formatQuery q 1 z 2] set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ -headers [list x-check-query yes] \ -query $query -timeout 10000] http::wait $tok list status [http::status $tok] code [http::code $tok]\ crc [check_crc $tok]\ connection [meta $tok connection]\ query-length [meta $tok x-query-length] } -cleanup { http::cleanup $tok halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7} test http11-4.2 "normal post request, check long query length" -setup { variable httpd [create_httpd] } -body { set query [string repeat a 24576] set tok [http::geturl http://localhost:$httpd_port/testdoc.html\ -headers [list x-check-query yes]\ -query $query -timeout 10000] http::wait $tok list status [http::status $tok] code [http::code $tok]\ crc [check_crc $tok]\ connection [meta $tok connection]\ query-length [meta $tok x-query-length] } -cleanup { http::cleanup $tok halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 24576} test http11-4.3 "normal post request, check channel query length" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] puts -nonewline $chan [string repeat [encoding convertto utf-8 "This is a test\n"] 8192] flush $chan seek $chan 0 } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html\ -headers [list x-check-query yes]\ -querychannel $chan -timeout 10000] http::wait $tok list status [http::status $tok] code [http::code $tok]\ crc [check_crc $tok]\ connection [meta $tok connection]\ query-length [meta $tok x-query-length] } -cleanup { http::cleanup $tok close $chan removeFile testfile.tmp halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 122880} # ------------------------------------------------------------------------- # Eliminate valgrind "still reachable" reports on outstanding "Detached" # structures in the detached list which stem from PipeClose2Proc not waiting # around for background processes to complete, meaning that previous calls to # Tcl_ReapDetachedProcs might not have had a chance to reap all processes. after 10 exec [info nameofexecutable] << {} foreach p {create_httpd httpd_read halt_httpd meta check_crc} { if {[llength [info proc $p]]} {rename $p {}} } removeFile testdoc.html unset -nocomplain httpd_port httpd p ::tcltest::cleanupTests tcl8.6.14/tests/httpold.test0000644000175000017500000002007714554262142015371 0ustar sergeisergei# Commands covered: http_config, http_get, http_wait, http_reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } if {[catch {package require http 1.0}]} { if {[info exists httpold]} { catch {puts "Cannot load http 1.0 package"} ::tcltest::cleanupTests return } else { catch {puts "Running http 1.0 tests in child interp"} set interp [interp create httpold] $interp eval [list set httpold "running"] $interp eval [list set argv $argv] $interp eval [list source [info script]] interp delete $interp ::tcltest::cleanupTests return } } # Do not use [info hostname]. # Name resolution is often a problem on OSX; not focus of HTTP package anyway. # Also a problem on other platforms for http-4.14 (test with bad port number). set HOST localhost set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" catch {unset data} ## ## The httpd script implement a stub http server ## Sourcing httpd overwrites the value of HOST. ## source [file join [file dirname [info script]] httpd] set port 8010 if {[catch {httpd_init $port} listen]} { puts "Cannot start http server, http test skipped" unset port ::tcltest::cleanupTests return } test httpold-1.1 {http_config} { http_config } {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}} test httpold-1.2 {http_config} { http_config -proxyfilter } httpProxyRequired test httpold-1.3 {http_config} { catch {http_config -junk} } 1 test httpold-1.4 {http_config} { http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite" set x [http_config] http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \ -useragent "Tcl http client package 1.0" set x } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}} test httpold-1.5 {http_config} { catch {http_config -proxyhost {} -junk 8080} } 1 test httpold-2.1 {http_reset} { catch {http_reset http#1} } 0 test httpold-3.1 {http_get} { catch {http_get -bogus flag} } 1 test httpold-3.2 {http_get} { catch {http_get http:junk} err set err } {Unsupported URL: http:junk} set url ${::HOST}:$port test httpold-3.3 {http_get} { set token [http_get $url] http_data $token } "HTTP/1.0 TEST

Hello, World!

GET /

" set tail /a/b/c set url ${::HOST}:$port/a/b/c set binurl ${::HOST}:$port/binary test httpold-3.4 {http_get} { set token [http_get $url] http_data $token } "HTTP/1.0 TEST

Hello, World!

GET $tail

" proc selfproxy {host} { global port return [list ${::HOST} $port] } test httpold-3.5 {http_get} { http_config -proxyfilter selfproxy set token [http_get $url] http_config -proxyfilter httpProxyRequired http_data $token } "HTTP/1.0 TEST

Hello, World!

GET http://$url

" test httpold-3.6 {http_get} { http_config -proxyfilter bogus set token [http_get $url] http_config -proxyfilter httpProxyRequired http_data $token } "HTTP/1.0 TEST

Hello, World!

GET $tail

" test httpold-3.7 {http_get} { set token [http_get $url -headers {Pragma no-cache}] http_data $token } "HTTP/1.0 TEST

Hello, World!

GET $tail

" test httpold-3.8 {http_get} { set token [http_get $url -query Name=Value&Foo=Bar] http_data $token } "HTTP/1.0 TEST

Hello, World!

POST $tail

Query

Name
Value
Foo
Bar
" test httpold-3.9 {http_get} { set token [http_get $url -validate 1] http_code $token } "HTTP/1.0 200 OK" test httpold-4.1 {httpEvent} { set token [http_get $url] upvar #0 $token data array set meta $data(meta) expr {$data(totalsize) == $meta(Content-Length)} } 1 test httpold-4.2 {httpEvent} { set token [http_get $url] upvar #0 $token data array set meta $data(meta) string compare $data(type) [string trim $meta(Content-Type)] } 0 test httpold-4.3 {httpEvent} { set token [http_get $url] http_code $token } {HTTP/1.0 200 Data follows} test httpold-4.4 {httpEvent} { set testfile [makeFile "" testfile] set out [open $testfile w] set token [http_get $url -channel $out] close $out set in [open $testfile] set x [read $in] close $in removeFile $testfile set x } "HTTP/1.0 TEST

Hello, World!

GET $tail

" test httpold-4.5 {httpEvent} { set testfile [makeFile "" testfile] set out [open $testfile w] set token [http_get $url -channel $out] close $out upvar #0 $token data removeFile $testfile expr {$data(currentsize) == $data(totalsize)} } 1 test httpold-4.6 {httpEvent} { set testfile [makeFile "" testfile] set out [open $testfile w] set token [http_get $binurl -channel $out] close $out set in [open $testfile] fconfigure $in -translation binary set x [read $in] close $in removeFile $testfile set x } "$bindata$binurl" proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { puts "progress $total $current" } set progress [list $total $current] } if 0 { # This test hangs on Windows95 because the client never gets EOF set httpLog 1 test httpold-4.6 {httpEvent} { set token [http_get $url -blocksize 50 -progress myProgress] set progress } {111 111} } test httpold-4.7 {httpEvent} { set token [http_get $url -progress myProgress] set progress } {111 111} test httpold-4.8 {httpEvent} { set token [http_get $url] http_status $token } {ok} test httpold-4.9 {httpEvent} { set token [http_get $url -progress myProgress] http_code $token } {HTTP/1.0 200 Data follows} test httpold-4.10 {httpEvent} { set token [http_get $url -progress myProgress] http_size $token } {111} test httpold-4.11 {httpEvent} { set token [http_get $url -timeout 1 -command {#}] http_reset $token http_status $token } {reset} test httpold-4.12 {httpEvent} -body { set tout {} update set x {} set token [http_get $url?delay=500 -timeout 1 -command {lappend x fail}] set i 0; while {$x eq {} && [incr i] < 50} { set tout [after 20 {set x progress}] vwait x if {$x ne "progress"} break set x [http_status $token] } set x } -cleanup { if {$tout ne {}} {after cancel $tout} } -result timeout test httpold-5.1 {http_formatQuery} { http_formatQuery name1 value1 name2 "value two" } {name1=value1&name2=value+two} test httpold-5.2 {http_formatQuery} { http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 } {name1=%7ebwelch&name2=%a1%a2%a2} test httpold-5.3 {http_formatQuery} { http_formatQuery lines "line1\nline2\nline3" } {lines=line1%0d%0aline2%0d%0aline3} test httpold-6.1 {httpProxyRequired} { update http_config -proxyhost ${::HOST} -proxyport $port set token [http_get $url] http_wait $token http_config -proxyhost {} -proxyport {} upvar #0 $token data set data(body) } "HTTP/1.0 TEST

Hello, World!

GET http://$url

" # cleanup catch {unset url} catch {unset port} catch {unset data} close $listen ::tcltest::cleanupTests return tcl8.6.14/tests/httpPipeline.test0000644000175000017500000005662414554262142016367 0ustar sergeisergei# httpPipeline.test # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # # Copyright (C) 2018 Keith Nash # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } package require http 2.9 set sourcedir [file normalize [file dirname [info script]]] source [file join $sourcedir httpTest.tcl] source [file join $sourcedir httpTestScript.tcl] # ------------------------------------------------------------------------------ # (1) Define the test scripts that will be used to generate logs for analysis - # and also define the "correct" results. # ------------------------------------------------------------------------------ proc ReturnTestScriptAndResult {ca cb delay te} { switch -- $ca { 1 {set start { START KEEPALIVE 0 PIPELINE 0 }} 2 {set start { START KEEPALIVE 0 PIPELINE 1 }} 3 {set start { START KEEPALIVE 1 PIPELINE 0 }} 4 {set start { START KEEPALIVE 1 PIPELINE 1 }} default { return -code error {no matching script} } } set middle " [list DELAY $delay] " switch -- $cb { 1 {set end { GET a GET b GET c GET a STOP } set resShort {1 ? ? ?} set resLong {1 2 3 4} } 2 {set end { GET a HEAD b GET c HEAD a HEAD c STOP } set resShort {1 ? ? ? ?} set resLong {1 2 3 4 5} } 3 {set end { HEAD a GET b HEAD c HEAD b GET a GET b STOP } set resShort {1 ? ? ? ? ?} set resLong {1 2 3 4 5 6} } 4 {set end { GET a GET b GET c GET a POST b address=home code=brief paid=yes GET c GET a GET b GET c STOP } set resShort {1 ? ? ? 5 ? ? ? ?} set resLong {1 2 3 4 5 6 7 8 9} } 5 {set end { POST a address=home code=brief paid=yes POST b address=home code=brief paid=yes POST c address=home code=brief paid=yes POST a address=home code=brief paid=yes POST b address=home code=brief paid=yes POST c address=home code=brief paid=yes POST a address=home code=brief paid=yes POST b address=home code=brief paid=yes POST c address=home code=brief paid=yes STOP } set resShort {1 2 3 4 5 6 7 8 9} set resLong {1 2 3 4 5 6 7 8 9} } 6 {set end { POST a address=home code=brief paid=yes GET b address=home code=brief paid=yes POST c address=home code=brief paid=yes GET a address=home code=brief paid=yes GET b address=home code=brief paid=yes POST c address=home code=brief paid=yes POST a address=home code=brief paid=yes HEAD b address=home code=brief paid=yes GET c address=home code=brief paid=yes STOP } set resShort {1 ? 3 ? ? 6 7 ? ?} set resLong {1 2 3 4 5 6 7 8 9} } 7 {set end { GET b address=home code=brief paid=yes POST a address=home code=brief paid=yes GET a address=home code=brief paid=yes POST c address=home code=brief paid=yes GET b address=home code=brief paid=yes HEAD b address=home code=brief paid=yes POST c address=home code=brief paid=yes POST a address=home code=brief paid=yes GET c address=home code=brief paid=yes STOP } set resShort {1 2 ? 4 ? ? 7 8 ?} set resLong {1 2 3 4 5 6 7 8 9} } 8 {set end { # Telling the server to close the connection. GET a GET b close=y GET c GET a GET b GET c GET a GET b GET c STOP } set resShort {1 ? 3 ? ? ? ? ? ?} set resLong {1 2 3 4 5 6 7 8 9} } 9 {set end { # Telling the server to close the connection. GET a POST b close=y address=home code=brief paid=yes GET c GET a GET b GET c GET a GET b GET c STOP } set resShort {1 2 3 ? ? ? ? ? ?} set resLong {1 2 3 4 5 6 7 8 9} } 10 {set end { # Telling the server to close the connection. GET a GET b close=y POST c address=home code=brief paid=yes GET a GET b GET c GET a GET b GET c STOP } set resShort {1 ? 3 ? ? ? ? ? ?} set resLong {1 2 3 4 5 6 7 8 9} } 11 {set end { # Telling the server to close the connection twice. GET a GET b close=y GET c GET a GET b close=y GET c GET a GET b GET c STOP } set resShort {1 ? 3 ? ? 6 ? ? ?} set resLong {1 2 3 4 5 6 7 8 9} } 12 {set end { # Telling the server to delay before sending the response. GET a GET b delay=1 GET c GET a GET b STOP } set resShort {1 ? ? ? ?} set resLong {1 2 3 4 5} } 13 {set end { # Making the server close the connection (time out). GET a WAIT 2000 GET b GET c GET a GET b STOP } set resShort {1 2 ? ? ?} set resLong {1 2 3 4 5} } 14 {set end { # Making the server close the connection (time out) twice. GET a WAIT 2000 GET b GET c GET a WAIT 2000 GET b GET c GET a GET b GET c STOP } set resShort {1 2 ? ? 5 ? ? ? ?} set resLong {1 2 3 4 5 6 7 8 9} } 15 {set end { POST a address=home code=brief paid=yes POST b address=home code=brief paid=yes close=y delay=1 POST c address=home code=brief paid=yes delay=1 POST a address=home code=brief paid=yes close=y WAIT 2000 POST b address=home code=brief paid=yes delay=1 POST c address=home code=brief paid=yes close=y POST a address=home code=brief paid=yes POST b address=home code=brief paid=yes close=y POST c address=home code=brief paid=yes STOP } set resShort {1 2 3 4 5 6 7 8 9} set resLong {1 2 3 4 5 6 7 8 9} } 16 {set end { POST a address=home code=brief paid=yes GET b address=home code=brief paid=yes POST c address=home code=brief paid=yes close=y GET a address=home code=brief paid=yes GET b address=home code=brief paid=yes close=y POST c address=home code=brief paid=yes WAIT 2000 POST a address=home code=brief paid=yes HEAD b address=home code=brief paid=yes close=y GET c address=home code=brief paid=yes STOP } set resShort {1 ? 3 4 ? 6 7 ? 9} set resLong {1 2 3 4 5 6 7 8 9} } 17 {set end { GET b address=home code=brief paid=yes POST a address=home code=brief paid=yes GET a address=home code=brief paid=yes POST c address=home code=brief paid=yes close=y GET b address=home code=brief paid=yes HEAD b address=home code=brief paid=yes close=y POST c address=home code=brief paid=yes WAIT 2000 POST a address=home code=brief paid=yes WAIT 2000 GET c address=home code=brief paid=yes STOP } set resShort {1 2 3 4 5 ? 7 8 9} set resLong {1 2 3 4 5 6 7 8 9} } 18 {set end { REPOST 0 GET a WAIT 2000 POST b address=home code=brief paid=yes GET c GET a STOP } set resShort {1 2 ? ?} set resLong {1 2 3 4} # resShort is overwritten below for the case ($te == 1). } 19 {set end { REPOST 0 GET a WAIT 2000 GET b address=home code=brief paid=yes GET c GET a STOP } set resShort {1 2 ? ?} set resLong {1 2 3 4} } 20 {set end { POSTFRESH 1 GET a WAIT 2000 POST b address=home code=brief paid=yes GET c GET a STOP } set resShort {1 3 ?} set resLong {1 3 4} } 21 {set end { POSTFRESH 1 GET a WAIT 2000 GET b address=home code=brief paid=yes GET c GET a STOP } set resShort {1 2 ? ?} set resLong {1 2 3 4} } 22 {set end { GET a WAIT 2000 KEEPALIVE 0 POST b address=home code=brief paid=yes KEEPALIVE 1 GET c GET a STOP } set resShort {1 3 ?} set resLong {1 3 4} } 23 {set end { GET a WAIT 2000 KEEPALIVE 0 GET b address=home code=brief paid=yes KEEPALIVE 1 GET c GET a STOP } set resShort {1 3 ?} set resLong {1 3 4} } 24 {set end { GET a KEEPALIVE 0 POST b address=home code=brief paid=yes KEEPALIVE 1 GET c GET a STOP } set resShort {1 ? ?} set resLong {1 3 4} } 25 {set end { GET a KEEPALIVE 0 GET b address=home code=brief paid=yes KEEPALIVE 1 GET c GET a STOP } set resShort {1 ? ?} set resLong {1 3 4} } default { return -code error {no matching script} } } if {$ca < 3} { # Not Keep-Alive. set result "Passed all sanity checks." } elseif {$ca == 3} { # Keep-Alive, not pipelined. set result {} append result "Passed all sanity checks.\n" append result "Have overlaps including response body:\n" } else { # Keep-Alive, pipelined: ($ca == 4) set result {} append result "Passed all sanity checks.\n" append result "Overlap-free without response body:\n" append result "$resShort" } # - The special case of test *.18*-testEof needs test results to be # individually written. # - These test -repost 0 when there is a POST to apply it to, and the server # timeout has not been detected. if {($cb == 18) && ($te == 1)} { if {$ca < 3} { # Not Keep-Alive. set result "Passed all sanity checks." } elseif {$ca == 3 && $delay == 0} { # Keep-Alive, not pipelined. set result [MakeMessage { |Problems with sanity checks: |Wrong sequence for token ::http::2 - {A B C D X X X} |- and error(s) X |Wrong sequence for token ::http::3 - {A X X} |- and error(s) X |Wrong sequence for token ::http::4 - {A X X X} |- and error(s) X | |Have overlaps including response body: | }] } elseif {$ca == 3} { # Keep-Alive, not pipelined. set result [MakeMessage { |Problems with sanity checks: |Wrong sequence for token ::http::2 - {A B C D X X X} |- and error(s) X | |Have overlaps including response body: | }] } elseif {$delay == 0} { # Keep-Alive, pipelined: ($ca == 4) set result [MakeMessage { |Problems with sanity checks: |Wrong sequence for token ::http::2 - {A B C D X X X} |- and error(s) X |Wrong sequence for token ::http::3 - {A X X} |- and error(s) X |Wrong sequence for token ::http::4 - {A X X X} |- and error(s) X | |Overlap-free without response body: | }] } else { set result [MakeMessage { |Problems with sanity checks: |Wrong sequence for token ::http::2 - {A B C D X X X} |- and error(s) X | |Overlap-free without response body: | }] } } return [list "$start$middle$end" $result] } # ------------------------------------------------------------------------------ # Proc MakeMessage # ------------------------------------------------------------------------------ # WHD's one-line command to generate multi-line strings from readable code. # # Example: # set blurb [MakeMessage { # |This command allows multi-line strings to be created with readable # |code, and without breaking the rules for indentation. # | # |The command shifts the entire block of text to the left, omitting # |the pipe character and the spaces to its left. # }] # ------------------------------------------------------------------------------ proc MakeMessage {in} { regsub -all -line {^\s*\|} [string trim $in] {} # N.B. Implicit Return. } proc ReturnTestScript {ca cb delay te} { lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result return $script } proc ReturnTestResult {ca cb delay te} { lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result return $result } # ------------------------------------------------------------------------------ # (2) Command to run a test script and use httpTest to analyse the logs. # ------------------------------------------------------------------------------ namespace import httpTestScript::runHttpTestScript namespace import httpTestScript::cleanupHttpTestScript namespace import httpTest::cleanupHttpTest namespace import httpTest::logAnalyse namespace import httpTest::setHttpTestOptions proc RunTest {header footer delay te} { set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]] set skipOverlaps 0 set notPiped {} set notIncluded {} # -------------------------------------------------------------------------- # Custom code for specific tests # -------------------------------------------------------------------------- if {$header < 3} { set skipOverlaps 1 for {set i 1} {$i <= $num} {incr i} { lappend notPiped $i } } elseif {$header > 2 && $footer == 18 && $te == 1} { set skipOverlaps 1 if {$delay == 0} { # Transaction 1 is conventional. # Check that transactions 2,3,4 are cancelled. set notPiped {1} set notIncluded $notPiped } else { # Transaction 1 is conventional. # Check that transaction 2 is cancelled. # The timing of transactions 3 and 4 is uncertain. set notPiped {1 3 4} set notIncluded $notPiped } } elseif {$footer in {20 22 23 24 25}} { # Transaction 2 uses its own socket. set notPiped 2 set notIncluded $notPiped } else { } # -------------------------------------------------------------------------- # End of custom code for specific tests # -------------------------------------------------------------------------- set Results [logAnalyse $num $skipOverlaps $notIncluded $notPiped] lassign $Results msg cleanE cleanF dirtyE dirtyF if {$msg eq {}} { set msg "Passed all sanity checks." } else { set msg "Problems with sanity checks:\n$msg" } if 0 { puts $msg puts "Overlap-free including response body:\n$cleanF" puts "Have overlaps including response body:\n$dirtyF" puts "Overlap-free without response body:\n$cleanE" puts "Have overlaps without response body:\n$dirtyE" } if {$header < 3} { # No ordering, just check that transactions all finish set result $msg } elseif {$header == 3} { # Not pipelined - check overlaps with response body. set result "$msg\nHave overlaps including response body:\n$dirtyF" } else { # Pipelined - check overlaps without response body. Check that the # first request, the first requests after replay, and POSTs are clean. set result "$msg\nOverlap-free without response body:\n$cleanE" } set ::nTokens $num return $result } # ------------------------------------------------------------------------------ # (3) VERBOSITY CONTROL # ------------------------------------------------------------------------------ # If tests fail, run an individual test with -verbose 1 or 2 for diagnosis. # If still obscure, uncomment #Log and ##Log lines in the http package. # ------------------------------------------------------------------------------ setHttpTestOptions -verbose 0 # ------------------------------------------------------------------------------ # (4) Define the base URLs used for testing. Each must have a query string. # ------------------------------------------------------------------------------ # - A HTTP/1.1 server is required. It should be configured to provide # persistent connections when requested to do so, and to close these # connections if they are idle for one second. # - The resource must be served with status 200 in response to a valid GET or # POST. # - The value of "page" is always specified in the query-string. Different # resources for the three values of "page" allow testing of both chunked and # unchunked transfer encoding. # - The variables "close" and "delay" may be specified in the query-string (for # a GET) or the request body (for a POST). # - "delay" is a numerical value in seconds, and causes the server to delay # the response, including headers. # - "close", if it has the value "y", instructs the server to close the # connection ater the current request. # - Any other variables should be ignored. # ------------------------------------------------------------------------------ namespace eval ::httpTestScript { variable URL array set URL { a http://test-tcl-http.kerlin.org/index.html?page=privacy b http://test-tcl-http.kerlin.org/index.html?page=conditions c http://test-tcl-http.kerlin.org/index.html?page=welcome } } # ------------------------------------------------------------------------------ # (5) Define the tests # ------------------------------------------------------------------------------ # Constraints: # - serverNeeded - the URLs defined at (4) must be available, and must have the # properties specified there. # - duplicate - the value of -pipeline does not matter if -keepalive 0 # - timeout1s - tests that work correctly only if the server closes # persistent connections after one second. # # Server timeout of persistent connections should be 1s. Delays of 2s are # intended to cause timeout. # Servers are usually configured to use a longer timeout: this will cause the # tests to fail. The "2000" could be replaced with a larger number, but the # tests will then be inconveniently slow. # ------------------------------------------------------------------------------ #testConstraint serverNeeded 1 #testConstraint timeout1s 1 #testConstraint duplicate 1 # ------------------------------------------------------------------------------ # Proc SetTestEof - to edit the command ::http::KeepSocket # ------------------------------------------------------------------------------ # The usual line in command ::http::KeepSocket is " set TEST_EOF 0". # Whether the value set in the file is 0 or 1, change it here to the value # specified by the argument. # # It is worth doing all tests for both values of the argument. # # test 0 - ::http::KeepSocket is unchanged, detects server eof where possible # and closes the connection. # test 1 - ::http::KeepSocket is edited, does not detect server eof, so the # reaction to finding server eof can be tested without the difficulty # of testing in the few milliseconds of an asynchronous close event. # ------------------------------------------------------------------------------ proc SetTestEof {test} { set body [info body ::http::KeepSocket] set subs " set TEST_EOF $test" set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody] if {$count != 1} { return -code error {proc ::http::KeepSocket has unexpected form} } proc ::http::KeepSocket {token} $newBody return } for {set header 1} {$header <= 4} {incr header} { if {$header == 4} { setHttpTestOptions -dotted 1 set match glob } else { setHttpTestOptions -dotted 0 set match exact } if {$header == 2} { set cons0 {serverNeeded duplicate} } else { set cons0 serverNeeded } for {set footer 1} {$footer <= 25} {incr footer} { foreach {delay label} { 0 a 1 b 2 c 3 d 5 e 8 f 12 g 100 h 500 i 2000 j } { foreach te {0 1} { if {$te} { set tag testEof } else { set tag normal } set suffix {} set cons $cons0 # ------------------------------------------------------------------ # Custom code for individual tests # ------------------------------------------------------------------ if {$footer in {18}} { # Custom code: if {($label eq "j") && ($te == 1)} { continue } if {$te == 1} { # The test (of REPOST 0) is useful if tag is "testEof" # (server timeout without client reaction). The same test # has a different result if tag is "normal". set suffix " - extra test for -repost 0 - ::http::2 must be" append suffix " cancelled" if {($delay == 0)} { append suffix ", along with ::http::3 ::http::4 if" append suffix " the test creates these before ::http::2" append suffix " is cancelled" } } else { } } elseif {$footer in {19}} { set suffix " - extra test for -repost 0" } elseif {$footer in {20 21}} { set suffix " - extra test for -postfresh 1" if {($footer == 20)} { append suffix " - ::http::2 uses a separate socket" append suffix ", other requests use a persistent connection" } } elseif {$footer in {22 23 24 25}} { append suffix " - ::http::2 uses a separate socket" append suffix ", other requests use a persistent connection" } else { } if {($footer >= 13 && $footer <= 23)} { # Test use WAIT and depend on server timeout before this time. lappend cons timeout1s } # ------------------------------------------------------------------ # End of custom code. # ------------------------------------------------------------------ set name "pipeline test header $header footer $footer delay $delay $tag$suffix" # Here's the test: test httpPipeline-${header}.${footer}${label}-${tag} $name \ -constraints $cons \ -setup [string map [list TE $te] { # Restore default values for tests: http::config -pipeline 1 -postfresh 0 -repost 1 http::init set http::http(uid) 0 SetTestEof {TE} }] -body [list RunTest $header $footer $delay $te] -cleanup { # Restore default values for tests: http::config -pipeline 1 -postfresh 0 -repost 1 cleanupHttpTestScript SetTestEof 0 cleanupHttpTest after 2000 # Wait for persistent sockets on the server to time out. } -result [ReturnTestResult $header $footer $delay $te] -match $match } } } } # ------------------------------------------------------------------------------ # (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0 # ------------------------------------------------------------------------------ # These tests are a bit awkward because the main test kit analyses whether all # requests are satisfied, with retries if necessary, and it has result analysis # for processing retry logs. # - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis # is a one-off. # - Tests *.18a-testEof depend on client/server timing - the test needs to call # http::geturl for all requests before the POST (request 2) is cancelled. # We test that requests 2, 3, 4 are all cancelled. # - Other tests *.18*-testEof may not request 3 and 4 in time for the to be # added to the write queue before request 2 is completed. We simply check that # request 2 is cancelled. # - The behaviour is different if all connections are allowed to time out # (label "j"). This case is not needed to test -repost 0, and is omitted. # - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no # effect). # ------------------------------------------------------------------------------ unset header footer delay label suffix match cons name te namespace delete ::httpTest namespace delete ::httpTestScript ::tcltest::cleanupTests tcl8.6.14/tests/http.test0000644000175000017500000005715414554262142014700 0ustar sergeisergei# Commands covered: http::config, http::geturl, http::wait, http::reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } if {[catch {package require http 2} version]} { if {[info exists http2]} { catch {puts "Cannot load http 2.* package"} return } else { catch {puts "Running http 2.* tests in child interp"} set interp [interp create http2] $interp eval [list set http2 "running"] $interp eval [list set argv $argv] $interp eval [list source [info script]] interp delete $interp return } } testConstraint http2.9.7 [package vsatisfies [package provide http] 2.9.7] testConstraint http2.9.8 [package vsatisfies [package provide http] 2.9.8] proc bgerror {args} { global errorInfo puts stderr "http.test bgerror" puts stderr [join $args] puts stderr $errorInfo } # Do not use [info hostname]. # Name resolution is often a problem on OSX; not focus of HTTP package anyway. # Also a problem on other platforms for http-4.14 (test with bad port number). set HOST localhost set port 8010 set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" catch {unset data} # Ensure httpd file exists set origFile [file join [pwd] [file dirname [info script]] httpd] set httpdFile [file join [temporaryDirectory] httpd_[pid]] if {![file exists $httpdFile]} { makeFile "" $httpdFile file delete $httpdFile file copy $origFile $httpdFile set removeHttpd 1 } catch {package require Thread 2.7-} if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} { set httpthread [thread::create -preserved] thread::send $httpthread [list source $httpdFile] thread::send $httpthread [list set port $port] thread::send $httpthread [list set bindata $bindata] thread::send $httpthread {httpd_init $port} puts "Running httpd in thread $httpthread" } else { if {![file exists $httpdFile]} { puts "Cannot read $httpdFile script, http test skipped" unset port return } source $httpdFile # Let the OS pick the port; that's much more flexible if {[catch {httpd_init 0} listen]} { puts "Cannot start http server, http test skipped" unset port return } else { # Running httpd in the current thread overwrites the values of port # (here) and HOST (in the sourced server file). set port [lindex [fconfigure $listen -sockname] 2] } } test http-1.1 {http::config} { http::config -useragent UserAgent http::config } [list -accept */* -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1] test http-1.2 {http::config} { http::config -proxyfilter } http::ProxyRequired test http-1.3 {http::config} { catch {http::config -junk} } 1 test http-1.4 {http::config} { set savedconf [http::config] http::config -proxyhost nowhere.come -proxyport 8080 \ -proxyfilter myFilter -useragent "Tcl Test Suite" \ -urlencoding iso8859-1 set x [http::config] http::config {*}$savedconf set x } {-accept */* -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1} test http-1.5 {http::config} -returnCodes error -body { http::config -proxyhost {} -junk 8080 } -result {Unknown option -junk, must be: -accept, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip} test http-1.6 {http::config} -setup { set oldenc [http::config -urlencoding] } -body { set enc [list [http::config -urlencoding]] http::config -urlencoding iso8859-1 lappend enc [http::config -urlencoding] } -cleanup { http::config -urlencoding $oldenc } -result {utf-8 iso8859-1} test http-2.1 {http::reset} { catch {http::reset http#1} } 0 test http-2.2 {http::CharsetToEncoding} http2.9.7 { http::CharsetToEncoding iso-8859-11 } iso8859-11 test http-2.3 {http::CharsetToEncoding} http2.9.7 { http::CharsetToEncoding iso-2022-kr } iso2022-kr test http-2.4 {http::CharsetToEncoding} http2.9.7 { http::CharsetToEncoding shift-jis } shiftjis test http-2.5 {http::CharsetToEncoding} http2.9.7 { http::CharsetToEncoding windows-437 } cp437 test http-2.6 {http::CharsetToEncoding} http2.9.7 { http::CharsetToEncoding latin5 } iso8859-9 test http-2.7 {http::CharsetToEncoding} http2.9.7 { http::CharsetToEncoding latin1 } iso8859-1 test http-2.8 {http::CharsetToEncoding} http2.9.7 { http::CharsetToEncoding latin4 } binary test http-3.1 {http::geturl} -returnCodes error -body { http::geturl -bogus flag } -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate} test http-3.2 {http::geturl} -returnCodes error -body { http::geturl http:junk } -result {Unsupported URL: http:junk} set url //${::HOST}:$port set badurl //${::HOST}:[expr {$port+1}] test http-3.3 {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET /

" set tail /a/b/c set url //${::HOST}:$port/a/b/c set fullurl HTTP://user:pass@${::HOST}:$port/a/b/c set binurl //${::HOST}:$port/binary set xmlurl //${::HOST}:$port/xml set posturl //${::HOST}:$port/post set badposturl //${::HOST}:$port/droppost set authorityurl //${::HOST}:$port set ipv6url http://\[::1\]:$port/ test http-3.4 {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

" proc selfproxy {host} { global port return [list ${::HOST} $port] } test http-3.5 {http::geturl} -body { http::config -proxyfilter selfproxy set token [http::geturl $url] http::data $token } -cleanup { http::config -proxyfilter http::ProxyRequired http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET http:$url

" test http-3.6 {http::geturl} -body { http::config -proxyfilter bogus set token [http::geturl $url] http::data $token } -cleanup { http::config -proxyfilter http::ProxyRequired http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

" test http-3.7 {http::geturl} -body { set token [http::geturl $url -headers {Pragma no-cache}] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

" test http-3.8 {http::geturl} -body { set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

POST $tail

Query

Name
Value
Foo
Bar
" test http-3.9 {http::geturl} -body { set token [http::geturl $url -validate 1] http::code $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 200 OK" test http-3.10 {http::geturl queryprogress} -setup { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i append query $sep$query set sep & } } -body { proc postProgress {token x y} { global postProgress lappend postProgress $y } set postProgress {} set t [http::geturl $posturl -keepalive 0 -query $query \ -queryprogress postProgress -queryblocksize 16384] http::wait $t list [http::status $t] [string length $query] $postProgress [http::data $t] } -cleanup { http::cleanup $t } -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}} test http-3.11 {http::geturl querychannel with -command} -setup { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i append query $sep$query set sep & } set file [makeFile $query outdata] } -body { set fp [open $file] proc asyncCB {token} { global postResult lappend postResult [http::data $token] } set postResult [list ] set t [http::geturl $posturl -querychannel $fp] http::wait $t set testRes [list [http::status $t] [string length $query] [http::data $t]] # Now do async http::cleanup $t close $fp set fp [open $file] set t [http::geturl $posturl -querychannel $fp -command asyncCB] set postResult [list PostStart] http::wait $t close $fp lappend testRes [http::status $t] $postResult } -cleanup { removeFile outdata http::cleanup $t } -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}} # On Linux platforms when the client and server are on the same host, the # client is unable to read the server's response one it hits the write error. # The status is "eof". # On Windows, the http::wait procedure gets a "connection reset by peer" error # while reading the reply. test http-3.12 {http::geturl querychannel with aborted request} -setup { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i append query $sep$query set sep & } set file [makeFile $query outdata] } -constraints {nonPortable} -body { set fp [open $file] proc asyncCB {token} { global postResult lappend postResult [http::data $token] } proc postProgress {token x y} { global postProgress lappend postProgress $y } set postProgress {} # Now do async set postResult [list PostStart] if {[catch { set t [http::geturl $badposturl -querychannel $fp -command asyncCB \ -queryprogress postProgress] http::wait $t upvar #0 $t state } err]} { puts $::errorInfo error $err } list [http::status $t] [http::code $t] } -cleanup { removeFile outdata http::cleanup $t } -result {ok {HTTP/1.0 200 Data follows}} test http-3.13 {http::geturl socket leak test} { set chanCount [llength [file channels]] for {set i 0} {$i < 3} {incr i} { catch {http::geturl $badurl -timeout 5000} } # No extra channels should be taken expr {[llength [file channels]] == $chanCount} } 1 test http-3.14 "http::geturl $fullurl" -body { set token [http::geturl $fullurl -validate 1] http::code $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 200 OK" test http-3.15 {http::geturl parse failures} -body { http::geturl "{invalid}:url" } -returnCodes error -result {Unsupported URL: {invalid}:url} test http-3.16 {http::geturl parse failures} -body { http::geturl http:relative/url } -returnCodes error -result {Unsupported URL: http:relative/url} test http-3.17 {http::geturl parse failures} -body { http::geturl /absolute/url } -returnCodes error -result {Missing host part: /absolute/url} test http-3.18 {http::geturl parse failures} -body { http::geturl http://somewhere:123456789/ } -returnCodes error -result {Invalid port number: 123456789} test http-3.19 {http::geturl parse failures} -body { http::geturl http://{user}@somewhere } -returnCodes error -result {Illegal characters in URL user} test http-3.20 {http::geturl parse failures} -body { http::geturl http://%user@somewhere } -returnCodes error -result {Illegal encoding character usage "%us" in URL user} test http-3.21 {http::geturl parse failures} -body { http::geturl http://somewhere/{path} } -returnCodes error -result {Illegal characters in URL path} test http-3.22 {http::geturl parse failures} -body { http::geturl http://somewhere/%path } -returnCodes error -result {Illegal encoding character usage "%pa" in URL path} test http-3.23 {http::geturl parse failures} -body { http::geturl http://somewhere/path?{query}? } -returnCodes error -result {Illegal characters in URL path} test http-3.24 {http::geturl parse failures} -body { http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} test http-3.25 {http::meta} -setup { unset -nocomplain m token } -body { set token [http::geturl $url -timeout 3000] array set m [http::meta $token] lsort [array names m] } -cleanup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date} test http-3.26 {http::meta} -setup { unset -nocomplain m token } -body { set token [http::geturl $url -headers {X-Check 1} -timeout 3000] array set m [http::meta $token] lsort [array names m] } -cleanup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date X-Check} test http-3.27 {http::geturl: -headers override -type} -body { set token [http::geturl $url/headers -type "text/plain" -query dummy \ -headers [list "Content-Type" "text/plain;charset=utf-8"]] http::data $token } -cleanup { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* Connection close Content-Type {text/plain;charset=utf-8} Accept \*/\* Accept-Encoding .* Content-Length 5} test http-3.28 {http::geturl: -headers override -type default} -body { set token [http::geturl $url/headers -query dummy \ -headers [list "Content-Type" "text/plain;charset=utf-8"]] http::data $token } -cleanup { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* Connection close Content-Type {text/plain;charset=utf-8} Accept \*/\* Accept-Encoding .* Content-Length 5} test http-3.29 {http::geturl IPv6 address} -body { # We only want to see if the URL gets parsed correctly. This is # the case if http::geturl succeeds or returns a socket related # error. If the parsing is wrong, we'll get a parse error. # It'd be better to separate the URL parser from http::geturl, so # that it can be tested without also trying to make a connection. set error [catch {http::geturl $ipv6url -validate 1} token] if {$error && [string match "couldn't open socket: *" $token]} { set error 0 } set error } -cleanup { catch { http::cleanup $token } } -result 0 test http-3.30 {http::geturl query without path} -body { set token [http::geturl $authorityurl?var=val] http::ncode $token } -cleanup { catch { http::cleanup $token } } -result 200 test http-3.31 {http::geturl fragment without path} -body { set token [http::geturl "$authorityurl#fragment42"] http::ncode $token } -cleanup { catch { http::cleanup $token } } -result 200 # Bug c11a51c482 test http-3.32 {http::geturl: -headers override -accept default} -body { set token [http::geturl $url/headers -query dummy \ -headers [list "Accept" "text/plain,application/tcl-test-value"]] http::data $token } -cleanup { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* Connection close Accept text/plain,application/tcl-test-value Accept-Encoding .* Content-Type application/x-www-form-urlencoded Content-Length 5} # Bug 838e99a76d test http-3.33 {http::geturl application/xml is text} -body { set token [http::geturl "$xmlurl"] scan [http::data $token] "<%\[^>]>%c<%\[^>]>" } -cleanup { catch { http::cleanup $token } } -result {test 4660 /test} test http-3.34 {http::geturl -headers not a list} -returnCodes error -body { http::geturl http://test/t -headers \" } -constraints http2.9.8 -result {Bad value for -headers ("), must be list} test http-3.35 {http::geturl -headers not even number of elements} -returnCodes error -body { http::geturl http://test/t -headers {List Length 3} } -constraints http2.9.8 -result {Bad value for -headers (List Length 3), number of list elements must be even} test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] upvar #0 $token data array set meta $data(meta) expr {($data(totalsize) == $meta(Content-Length))} } -cleanup { http::cleanup $token } -result 1 test http-4.2 {http::Event} -body { set token [http::geturl $url] upvar #0 $token data array set meta $data(meta) string compare $data(type) [string trim $meta(Content-Type)] } -cleanup { http::cleanup $token } -result 0 test http-4.3 {http::Event} -body { set token [http::geturl $url] http::code $token } -cleanup { http::cleanup $token } -result {HTTP/1.0 200 Data follows} test http-4.4 {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] set token [http::geturl $url -channel $out] close $out set in [open $testfile] set x [read $in] } -cleanup { catch {close $in} catch {close $out} removeFile $testfile http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

" test http-4.5 {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] fconfigure $out -translation lf set token [http::geturl $url -channel $out] close $out upvar #0 $token data expr {$data(currentsize) == $data(totalsize)} } -cleanup { removeFile $testfile http::cleanup $token } -result 1 test http-4.6 {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] set token [http::geturl $binurl -channel $out] close $out set in [open $testfile] fconfigure $in -translation binary read $in } -cleanup { catch {close $in} catch {close $out} removeFile $testfile http::cleanup $token } -result "$bindata[string trimleft $binurl /]" proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { puts "progress $total $current" } set progress [list $total $current] } test http-4.6.1 {http::Event} knownBug { set token [http::geturl $url -blocksize 50 -progress myProgress] return $progress } {111 111} test http-4.7 {http::Event} -body { set token [http::geturl $url -keepalive 0 -progress myProgress] return $progress } -cleanup { http::cleanup $token } -result {111 111} test http-4.8 {http::Event} -body { set token [http::geturl $url] http::status $token } -cleanup { http::cleanup $token } -result {ok} test http-4.9 {http::Event} -body { set token [http::geturl $url -progress myProgress] http::code $token } -cleanup { http::cleanup $token } -result {HTTP/1.0 200 Data follows} test http-4.10 {http::Event} -body { set token [http::geturl $url -progress myProgress] http::size $token } -cleanup { http::cleanup $token } -result {111} # Timeout cases # Short timeout to working server (the test server). This lets us try a # reset during the connection. test http-4.11 {http::Event} -body { set token [http::geturl $url -timeout 1 -keepalive 0 -command \#] http::reset $token http::status $token } -cleanup { http::cleanup $token } -result {reset} # Longer timeout with reset. test http-4.12 {http::Event} -body { set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#] http::reset $token http::status $token } -cleanup { http::cleanup $token } -result {reset} # Medium timeout to working server that waits even longer. The timeout # hits while waiting for a reply. test http-4.13 {http::Event} -body { set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#] http::wait $token http::status $token } -cleanup { http::cleanup $token } -result {timeout} # Longer timeout to good host, bad port, gets an error after the # connection "completes" but the socket is bad. test http-4.14 {http::Event} -body { set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#] if {$token eq ""} { error "bogus return from http::geturl" } http::wait $token lindex [http::error $token] 0 } -cleanup { catch {http::cleanup $token} } -result {connect failed connection refused} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. set token [http::geturl //not_a_host.tcl.tk -timeout 3000 -command \#] http::wait $token http::status $token # error codes vary among platforms. } -cleanup { catch {http::cleanup $token} } -returnCodes 1 -match glob -result "couldn't open socket*" test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup { proc list-difference {l1 l2} { lmap item $l2 {if {$item in $l1} continue; set item} } } -body { set before [chan names] set token [http::geturl $url -headers {X-Connection keep-alive}] http::cleanup $token update # Compute what channels have been unexpectedly leaked past cleanup list-difference $before [chan names] } -cleanup { rename list-difference {} } -result {} test http-5.1 {http::formatQuery} { http::formatQuery name1 value1 name2 "value two" } {name1=value1&name2=value%20two} # test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5 test http-5.3 {http::formatQuery} { http::formatQuery lines "line1\nline2\nline3" } {lines=line1%0D%0Aline2%0D%0Aline3} test http-5.4 {http::formatQuery} { http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 } {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2} test http-5.5 {http::formatQuery} { set enc [http::config -urlencoding] http::config -urlencoding iso8859-1 set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2] http::config -urlencoding $enc set res } {name1=~bwelch&name2=%A1%A2%A2} test http-6.1 {http::ProxyRequired} -body { http::config -proxyhost ${::HOST} -proxyport $port set token [http::geturl $url] http::wait $token upvar #0 $token data set data(body) } -cleanup { http::config -proxyhost {} -proxyport {} http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET http:$url

" test http-7.1 {http::mapReply} { http::mapReply "abc\$\[\]\"\\()\}\{" } {abc%24%5B%5D%22%5C%28%29%7D%7B} test http-7.2 {http::mapReply} { # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default, # so make sure this gets converted to utf-8 then urlencoded. http::mapReply "\u2208" } {%E2%88%88} test http-7.3 {http::formatQuery} -setup { set enc [http::config -urlencoding] } -returnCodes error -body { # this would be reverting to http <=2.4 behavior http::config -urlencoding "" http::mapReply "\u2208" } -cleanup { http::config -urlencoding $enc } -result "can't read \"formMap(\u2208)\": no such element in array" test http-7.4 {http::formatQuery} -setup { set enc [http::config -urlencoding] } -body { # this would be reverting to http <=2.4 behavior w/o errors # (unknown chars become '?') http::config -urlencoding "iso8859-1" http::mapReply "\u2208" } -cleanup { http::config -urlencoding $enc } -result {%3F} # cleanup catch {unset url} catch {unset badurl} catch {unset port} catch {unset data} if {[info exists httpthread]} { thread::release $httpthread } else { close $listen } if {[info exists removeHttpd]} { removeFile $httpdFile } rename bgerror {} ::tcltest::cleanupTests # Local variables: # mode: tcl # End: tcl8.6.14/tests/if-old.test0000644000175000017500000001123214554262142015056 0ustar sergeisergei# Commands covered: if # # This file contains the original set of tests for Tcl's if command. # Since the if command is now compiled, a new set of tests covering # the new implementation is in the file "if.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test if-old-1.1 {taking proper branch} { set a {} if 0 {set a 1} else {set a 2} set a } 2 test if-old-1.2 {taking proper branch} { set a {} if 1 {set a 1} else {set a 2} set a } 1 test if-old-1.3 {taking proper branch} { set a {} if 1<2 {set a 1} set a } 1 test if-old-1.4 {taking proper branch} { set a {} if 1>2 {set a 1} set a } {} test if-old-1.5 {taking proper branch} { set a {} if 0 {set a 1} else {} set a } {} test if-old-1.6 {taking proper branch} { set a {} if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4} set a } {2} test if-old-1.7 {taking proper branch} { set a {} if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4} set a } {3} test if-old-1.8 {taking proper branch} { set a {} if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4} set a } {4} test if-old-1.9 {taking proper branch, multiline test expr} { set a {} if {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4} set a } {3} test if-old-2.1 {optional then-else args} { set a 44 if 0 then {set a 1} elseif 0 then {set a 3} else {set a 2} set a } 2 test if-old-2.2 {optional then-else args} { set a 44 if 1 then {set a 1} else {set a 2} set a } 1 test if-old-2.3 {optional then-else args} { set a 44 if 0 {set a 1} else {set a 2} set a } 2 test if-old-2.4 {optional then-else args} { set a 44 if 1 {set a 1} else {set a 2} set a } 1 test if-old-2.5 {optional then-else args} { set a 44 if 0 then {set a 1} {set a 2} set a } 2 test if-old-2.6 {optional then-else args} { set a 44 if 1 then {set a 1} {set a 2} set a } 1 test if-old-2.7 {optional then-else args} { set a 44 if 0 then {set a 1} else {set a 2} set a } 2 test if-old-2.8 {optional then-else args} { set a 44 if 0 then {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} {set a 4} set a } 4 test if-old-3.1 {return value} { if 1 then {set a 22; concat abc} } abc test if-old-3.2 {return value} { if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi} } def test if-old-3.3 {return value} { if 0 then {set a 22; concat abc} else {concat def} } def test if-old-3.4 {return value} { if 0 then {set a 22; concat abc} } {} test if-old-3.5 {return value} { if 0 then {set a 22; concat abc} elseif 0 {concat def} } {} test if-old-4.1 {error conditions} { list [catch {if} msg] $msg } {1 {wrong # args: no expression after "if" argument}} test if-old-4.2 {error conditions} { list [catch {if {[error "error in condition"]} foo} msg] $msg } {1 {error in condition}} test if-old-4.3 {error conditions} { list [catch {if 2} msg] $msg } {1 {wrong # args: no script following "2" argument}} test if-old-4.4 {error conditions} { list [catch {if 2 then} msg] $msg } {1 {wrong # args: no script following "then" argument}} test if-old-4.5 {error conditions} { list [catch {if 2 the} msg] $msg } {1 {invalid command name "the"}} test if-old-4.6 {error conditions} { list [catch {if 2 then {[error "error in then clause"]}} msg] $msg } {1 {error in then clause}} test if-old-4.7 {error conditions} { list [catch {if 0 then foo elseif} msg] $msg } {1 {wrong # args: no expression after "elseif" argument}} test if-old-4.8 {error conditions} { list [catch {if 0 then foo elsei} msg] $msg } {1 {invalid command name "elsei"}} test if-old-4.9 {error conditions} { list [catch {if 0 then foo elseif 0 bar else} msg] $msg } {1 {wrong # args: no script following "else" argument}} test if-old-4.10 {error conditions} { list [catch {if 0 then foo elseif 0 bar els} msg] $msg } {1 {invalid command name "els"}} test if-old-4.11 {error conditions} { list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg } {1 {error in else clause}} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/if.test0000644000175000017500000007301114554262142014305 0ustar sergeisergei# Commands covered: if # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Basic "if" operation. catch {unset a} test if-1.1 {TclCompileIfCmd: missing if/elseif test} -body { if } -returnCodes error -result {wrong # args: no expression after "if" argument} test if-1.2 {TclCompileIfCmd: error in if/elseif test} -body { if {[error "error in condition"]} foo } -returnCodes error -result {error in condition} test if-1.3 {TclCompileIfCmd: error in if/elseif test} -body { list [catch {if {1+}} msg] $msg $::errorInfo } -match glob -cleanup { unset msg } -result {1 * {*"if {1+}"}} test if-1.4 {TclCompileIfCmd: if/elseif test in braces} -body { set a {} if {1<2} {set a 1} return $a } -cleanup { unset a } -result {1} test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} -body { set a {} if 1<2 {set a 1} return $a } -cleanup { unset a } -result {1} test if-1.6 {TclCompileIfCmd: multiline test expr} -setup { set a {} } -body { if {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4} return $a } -cleanup { unset a } -result 3 test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} -body { set a {} if 4>3 then {set a 1} return $a } -cleanup { unset a } -result {1} test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} -setup { set a {} } -body { if 1<2 therefore {set a 1} } -cleanup { unset a } -returnCodes error -result {invalid command name "therefore"} test if-1.9 {TclCompileIfCmd: missing "then" body} -setup { set a {} } -body { if 1<2 then } -cleanup { unset a } -returnCodes error -result {wrong # args: no script following "then" argument} test if-1.10 {TclCompileIfCmd: error in "then" body} -body { set a {} list [catch {if {$a!="xxx"} then {set}} msg] $msg $::errorInfo } -match glob -cleanup { unset a msg } -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" while *ing "set"*}} test if-1.11 {TclCompileIfCmd: error in "then" body} -body { if 2 then {[error "error in then clause"]} } -returnCodes error -result {error in then clause} test if-1.12 {TclCompileIfCmd: "then" body in quotes} -body { set a {} if 27>17 "append a x" return $a } -cleanup { unset a } -result {x} test if-1.13 {TclCompileIfCmd: computed "then" body} -setup { catch {unset x1} catch {unset x2} } -body { set x1 {append a x1} set x2 {; append a x2} set a {} if 1 $x1$x2 return $a } -cleanup { unset a x1 x2 } -result {x1x2} test if-1.14 {TclCompileIfCmd: taking proper branch} -body { set a {} if 1<2 {set a 1} return $a } -cleanup { unset a } -result 1 test if-1.15 {TclCompileIfCmd: taking proper branch} -body { set a {} if 1>2 {set a 1} return $a } -cleanup { unset a } -result {} test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} -setup { catch {unset i} set a {} } -body { if 1<2 { set a 1 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } return $a } -cleanup { unset a unset -nocomplain i } -result 3 test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} -setup { set a {} } -body { if {"0 < 3"} {set a 1} } -returnCodes error -cleanup { unset a } -result {expected boolean value but got "0 < 3"} test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} -setup { set a {} } -body { if 3>4 {set a 1} elseif 1 {set a 2} return $a } -cleanup { unset a } -result {2} # Since "else" is optional, the "elwood" below is treated as a command. # But then there shouldn't be any additional argument words for the "if". test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} -setup { set a {} } -body { if 1<2 {set a 1} elwood {set a 2} } -returnCodes error -cleanup { unset a } -result {wrong # args: extra words after "else" clause in "if" command} test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} -setup { set a {} } -body { if 1<2 {set a 1} elseif } -returnCodes error -cleanup { unset a } -result {wrong # args: no expression after "elseif" argument} test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -setup { set a {} } -body { list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo } -match glob -cleanup { unset a msg } -result {1 * {*"if 3>4 {set a 1} elseif {1>}"}} test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} -setup { catch {unset i} set a {} } -body { if 1>2 { set a 1 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } elseif 1<2 then { #; this if arm should be taken set a 4 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 5 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 6 } return $a } -cleanup { unset a unset -nocomplain i } -result 6 test if-3.1 {TclCompileIfCmd: "else" clause} -body { set a {} if 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3} return $a } -cleanup { unset a } -result 3 # Since "else" is optional, the "elsex" below is treated as a command. # But then there shouldn't be any additional argument words for the "if". test if-3.2 {TclCompileIfCmd: keyword other than "else"} -setup { set a {} } -body { if 1<2 then {set a 1} elsex {set a 2} } -returnCodes error -cleanup { unset a } -result {wrong # args: extra words after "else" clause in "if" command} test if-3.3 {TclCompileIfCmd: missing body after "else"} -setup { set a {} } -body { if 2<1 {set a 1} else } -returnCodes error -cleanup { unset a } -result {wrong # args: no script following "else" argument} test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -setup { set a {} } -body { catch {if 2<1 {set a 1} else {set}} set ::errorInfo } -match glob -cleanup { unset a } -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} -setup { set a {} } -body { if 2<1 {set a 1} else {set a 2} or something } -returnCodes error -cleanup { unset a } -result {wrong # args: extra words after "else" clause in "if" command} # The following test also checks whether contained loops and other # commands are properly relocated because a short jump must be replaced # by a "long distance" one. test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} -setup { catch {unset i} set a {} } -body { if 1>2 { set a 1 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } elseif 1==2 then { #; this if arm should be taken set a 4 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 5 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 6 } else { set a 7 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 8 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 9 } return $a } -cleanup { unset a unset -nocomplain i } -result 9 test if-4.1 {TclCompileIfCmd: "if" command result} -setup { set a {} } -body { set a [if 3<4 {set i 27}] return $a } -cleanup { unset a unset -nocomplain i } -result 27 test if-4.2 {TclCompileIfCmd: "if" command result} -setup { set a {} } -body { set a [if 3>4 {set i 27}] return $a } -cleanup { unset a unset -nocomplain i } -result {} test if-4.3 {TclCompileIfCmd: "if" command result} -setup { set a {} } -body { set a [if 0 {set i 1} elseif 1 {set i 2}] return $a } -cleanup { unset a unset -nocomplain i } -result 2 test if-4.4 {TclCompileIfCmd: "if" command result} -setup { set a {} } -body { set a [if 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}] return $a } -cleanup { unset a i } -result 4 test if-4.5 {TclCompileIfCmd: return value} -body { if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi} } -cleanup { unset -nocomplain a } -result def # Check "if" and computed command names. test if-5.1 {if cmd with computed command names: missing if/elseif test} -body { set z if $z } -returnCodes error -cleanup { unset z } -result {wrong # args: no expression after "if" argument} test if-5.2 {if cmd with computed command names: error in if/elseif test} -body { set z if $z {[error "error in condition"]} foo } -returnCodes error -cleanup { unset z } -result {error in condition} test if-5.3 {if cmd with computed command names: error in if/elseif test} -body { set z if list [catch {$z {1+}}] $::errorInfo } -match glob -cleanup { unset z } -result {1 {*"$z {1+}"}} test if-5.4 {if cmd with computed command names: if/elseif test in braces} -setup { set a {} } -body { set z if $z {1<2} {set a 1} return $a } -cleanup { unset a z } -result {1} test if-5.5 {if cmd with computed command names: if/elseif test not in braces} -setup { set a {} } -body { set z if $z 1<2 {set a 1} return $a } -cleanup { unset a z } -result {1} test if-5.6 {if cmd with computed command names: multiline test expr} -body { set z if $z {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4} return $a } -cleanup { unset a z } -result 3 test if-5.7 {if cmd with computed command names: "then" after if/elseif test} -setup { set a {} } -body { set z if $z 4>3 then {set a 1} return $a } -cleanup { unset a z } -result {1} test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} -setup { set a {} } -body { set z if $z 1<2 therefore {set a 1} } -returnCodes error -cleanup { unset a z } -result {invalid command name "therefore"} test if-5.9 {if cmd with computed command names: missing "then" body} -setup { set a {} } -body { set z if $z 1<2 then } -returnCodes error -cleanup { unset a z } -result {wrong # args: no script following "then" argument} test if-5.10 {if cmd with computed command names: error in "then" body} -body { set z if set a {} list [catch {$z {$a!="xxx"} then {set}} msg] $msg $::errorInfo } -match glob -cleanup { unset a z msg } -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" while *ing "set" invoked from within "$z {$a!="xxx"} then {set}"}} test if-5.11 {if cmd with computed command names: error in "then" body} -body { set z if $z 2 then {[error "error in then clause"]} } -returnCodes error -cleanup { unset z } -result {error in then clause} test if-5.12 {if cmd with computed command names: "then" body in quotes} -setup { set a {} } -body { set z if $z 27>17 "append a x" return $a } -cleanup { unset a z } -result {x} test if-5.13 {if cmd with computed command names: computed "then" body} -setup { catch {unset x1} catch {unset x2} } -body { set z if set x1 {append a x1} set x2 {; append a x2} set a {} $z 1 $x1$x2 return $a } -cleanup { unset a z x1 x2 } -result {x1x2} test if-5.14 {if cmd with computed command names: taking proper branch} -setup { set a {} } -body { set z if $z 1<2 {set a 1} return $a } -cleanup { unset a z } -result 1 test if-5.15 {if cmd with computed command names: taking proper branch} -body { set a {} set z if $z 1>2 {set a 1} return $a } -cleanup { unset a z } -result {} test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} -setup { catch {unset i} set a {} } -body { set z if $z 1<2 { set a 1 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } return $a } -cleanup { unset a z unset -nocomplain i } -result 3 test if-5.17 {if cmd with computed command names: if/elseif test in quotes} -setup { set a {} } -body { set z if $z {"0 < 3"} {set a 1} } -returnCodes error -cleanup { unset a z } -result {expected boolean value but got "0 < 3"} test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} -setup { set a {} } -body { set z if $z 3>4 {set a 1} elseif 1 {set a 2} return $a } -cleanup { unset a z } -result {2} # Since "else" is optional, the "elwood" below is treated as a command. # But then there shouldn't be any additional argument words for the "if". test if-6.2 {if cmd with computed command names: keyword other than "elseif"} -setup { set a {} } -body { set z if $z 1<2 {set a 1} elwood {set a 2} } -returnCodes error -cleanup { unset a z } -result {wrong # args: extra words after "else" clause in "if" command} test if-6.3 {if cmd with computed command names: missing expression after "elseif"} -setup { set a {} } -body { set z if $z 1<2 {set a 1} elseif } -returnCodes error -cleanup { unset a z } -result {wrong # args: no expression after "elseif" argument} test if-6.4 {if cmd with computed command names: error in expression after "elseif"} -setup { set a {} } -body { set z if list [catch {$z 3>4 {set a 1} elseif {1>}}] $::errorInfo } -match glob -cleanup { unset a z } -result {1 {*"$z 3>4 {set a 1} elseif {1>}"}} test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} -setup { catch {unset i} set a {} } -body { set z if $z 1>2 { set a 1 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } elseif 1<2 then { #; this if arm should be taken set a 4 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 5 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 6 } return $a } -cleanup { unset a z unset -nocomplain i } -result 6 test if-7.1 {if cmd with computed command names: "else" clause} -setup { set a {} } -body { set z if $z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3} return $a } -cleanup { unset a z } -result 3 # Since "else" is optional, the "elsex" below is treated as a command. # But then there shouldn't be any additional argument words for the "if". test if-7.2 {if cmd with computed command names: keyword other than "else"} -setup { set a {} } -body { set z if $z 1<2 then {set a 1} elsex {set a 2} } -returnCodes error -cleanup { unset a z } -result {wrong # args: extra words after "else" clause in "if" command} test if-7.3 {if cmd with computed command names: missing body after "else"} -setup { set a {} } -body { set z if $z 2<1 {set a 1} else } -returnCodes error -cleanup { unset a z } -result {wrong # args: no script following "else" argument} test if-7.4 {if cmd with computed command names: error compiling body after "else"} -setup { set a {} } -body { set z if catch {$z 2<1 {set a 1} else {set}} return $::errorInfo } -match glob -cleanup { unset a z } -result {wrong # args: should be "set varName ?newValue?" while *ing "set" invoked from within "$z 2<1 {set a 1} else {set}"} test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} -setup { set a {} } -body { set z if $z 2<1 {set a 1} else {set a 2} or something } -returnCodes error -cleanup { unset a z } -result {wrong # args: extra words after "else" clause in "if" command} # The following test also checks whether contained loops and other # commands are properly relocated because a short jump must be replaced # by a "long distance" one. test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} -setup { catch {unset i} set a {} } -body { set z if $z 1>2 { set a 1 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } elseif 1==2 then { #; this if arm should be taken set a 4 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 5 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 6 } else { set a 7 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 8 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 9 } return $a } -cleanup { unset a z unset -nocomplain i } -result 9 test if-8.1 {if cmd with computed command names: "if" command result} -setup { set a {} } -body { set z if set a [$z 3<4 {set i 27}] return $a } -cleanup { unset a z unset -nocomplain i } -result 27 test if-8.2 {if cmd with computed command names: "if" command result} -setup { set a {} } -body { set z if set a [$z 3>4 {set i 27}] return $a } -cleanup { unset a z unset -nocomplain i } -result {} test if-8.3 {if cmd with computed command names: "if" command result} -setup { set a {} } -body { set z if set a [$z 0 {set i 1} elseif 1 {set i 2}] return $a } -cleanup { unset a z unset -nocomplain i } -result 2 test if-8.4 {if cmd with computed command names: "if" command result} -setup { set a {} } -body { set z if set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}] return $a } -cleanup { unset a z unset -nocomplain i } -result 4 test if-8.5 {if cmd with computed command names: return value} -body { set z if $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi} } -cleanup { unset z unset -nocomplain a } -result def test if-9.1 {if cmd with namespace qualifiers} -body { ::if {1} {set x 4} } -cleanup { unset x } -result 4 # Test for incorrect "double evaluation semantics" test if-10.1 {delayed substitution of then body} -body { set j 0 set if if # this is not compiled $if {[incr j] == 1} " set result $j " # this will be compiled proc p {} { set j 0 if {[incr j]} " set result $j " set result } append result [p] } -cleanup { unset j if result rename p {} } -result {00} test if-10.2 {delayed substitution of elseif expression} -body { set j 0 set if if # this is not compiled $if {[incr j] == 0} { set result badthen } elseif "$j == 1" { set result badelseif } else { set result 0 } # this will be compiled proc p {} { set j 0 if {[incr j] == 0} { set result badthen } elseif "$j == 1" { set result badelseif } else { set result 0 } set result } append result [p] } -cleanup { unset j if result rename p {} } -result {00} test if-10.3 {delayed substitution of elseif body} -body { set j 0 set if if # this is not compiled $if {[incr j] == 0} { set result badthen } elseif {1} " set result $j " # this will be compiled proc p {} { set j 0 if {[incr j] == 0} { set result badthen } elseif {1} " set result $j " } append result [p] } -cleanup { unset j if result rename p {} } -result {00} test if-10.4 {delayed substitution of else body} -body { set j 0 if {[incr j] == 0} { set result badthen } else " set result $j " return $result } -cleanup { unset j result } -result {0} test if-10.5 {substituted control words} -body { set then then; proc then {} {return badthen} set else else; proc else {} {return badelse} set elseif elseif; proc elseif {} {return badelseif} list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a } -cleanup { unset then else elseif a } -result {0 ok} test if-10.6 {double invocation of variable traces} -body { set iftracecounter 0 proc iftraceproc {args} { upvar #0 iftracecounter counter set argc [llength $args] set extraargs [lrange $args 0 [expr {$argc - 4}]] set name [lindex $args [expr {$argc - 3}]] upvar 1 $name var if {[incr counter] % 2 == 1} { set var "$counter oops [concat $extraargs]" } else { set var "$counter + [concat $extraargs]" } } trace add variable iftracevar read [list iftraceproc 10] list [catch {if "$iftracevar + 20" {}} a] $a \ [catch {if "$iftracevar + 20" {}} b] $b } -cleanup { unset iftracevar iftracecounter a b } -match glob -result {1 {*} 0 {}} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/incr-old.test0000644000175000017500000000533214554262142015417 0ustar sergeisergei# Commands covered: incr # # This file contains the original set of tests for Tcl's incr command. # Since the incr command is now compiled, a new set of tests covering # the new implementation is in the file "incr.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } catch {unset x} test incr-old-1.1 {basic incr operation} { set x 23 list [incr x] $x } {24 24} test incr-old-1.2 {basic incr operation} { set x 106 list [incr x -5] $x } {101 101} test incr-old-1.3 {basic incr operation} { set x " -106" list [incr x 1] $x } {-105 -105} test incr-old-1.4 {basic incr operation} { set x " +106" list [incr x 1] $x } {107 107} test incr-old-2.1 {incr errors} { list [catch incr msg] $msg } {1 {wrong # args: should be "incr varName ?increment?"}} test incr-old-2.2 {incr errors} { list [catch {incr a b c} msg] $msg } {1 {wrong # args: should be "incr varName ?increment?"}} test incr-old-2.3 {incr errors} { catch {unset x} incr x } 1 test incr-old-2.4 {incr errors} { set x abc list [catch {incr x} msg] $msg $::errorInfo } {1 {expected integer but got "abc"} {expected integer but got "abc" while executing "incr x"}} test incr-old-2.5 {incr errors} { set x 123 list [catch {incr x 1a} msg] $msg $::errorInfo } {1 {expected integer but got "1a"} {expected integer but got "1a" (reading increment) invoked from within "incr x 1a"}} test incr-old-2.6 {incr errors} -body { proc readonly args {error "variable is read-only"} set x 123 trace var x w readonly list [catch {incr x 1} msg] $msg $::errorInfo } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing * "incr x 1"}} catch {unset x} test incr-old-2.7 {incr errors} { set x - list [catch {incr x 1} msg] $msg } {1 {expected integer but got "-"}} test incr-old-2.8 {incr errors} { set x { - } list [catch {incr x 1} msg] $msg } {1 {expected integer but got " - "}} test incr-old-2.9 {incr errors} { set x + list [catch {incr x 1} msg] $msg } {1 {expected integer but got "+"}} test incr-old-2.10 {incr errors} { set x {20 x} list [catch {incr x 1} msg] $msg } {1 {expected integer but got "20 x"}} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/incr.test0000644000175000017500000004261514554262142014650 0ustar sergeisergei# Commands covered: incr # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } unset -nocomplain x i proc readonly varName { upvar 1 $varName var trace add variable var write \ {apply {{args} {error "variable is read-only"}}} } # Basic "incr" operation. test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body { incr } -result {wrong # args: should be "incr varName ?increment?"} test incr-1.2 {TclCompileIncrCmd: simple variable name} { set i 10 list [incr i] $i } {11 11} test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body { set i 10 incr "i"xxx } -returnCodes error -result {extra characters after close-quote} test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} { set i 17 list [incr "i"] $i } {18 18} test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} -setup { unset -nocomplain {a simple var} } -body { set {a simple var} 27 list [incr {a simple var}] ${a simple var} } -result {28 28} test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup { unset -nocomplain a } -body { set a(foo) 37 list [incr a(foo)] $a(foo) } -result {38 38} test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} { set x "i" set i 77 list [incr $x 2] $i } {79 79} test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} { set x "i" set i 77 list [incr [set x] +2] $i } {79 79} test incr-1.9 {TclCompileIncrCmd: increment given} { set i 10 list [incr i +07] $i } {17 17} test incr-1.10 {TclCompileIncrCmd: no increment given} { set i 10 list [incr i] $i } {11 11} test incr-1.11 {TclCompileIncrCmd: simple global name} { proc p {} { global i set i 54 incr i } p } {55} test incr-1.12 {TclCompileIncrCmd: simple local name} { proc p {} { set foo 100 incr foo } p } {101} test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} { proc p {} { incr bar } p } 1 test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} { proc 260locals {} { # create 260 locals set a0 0; set a1 0; set a2 0; set a3 0; set a4 0 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0 set z5 0; set z6 0; set z7 0; set z8 0; set z9 0 # now increment the last one (local var index > 255) incr z9 } 260locals } {1} test incr-1.15 {TclCompileIncrCmd: variable is array} -setup { unset -nocomplain a } -body { set a(foo) 27 incr a(foo) 11 } -cleanup { unset -nocomplain a } -result 38 test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} -setup { unset -nocomplain a } -body { set i 5 set a(foo5) 27 incr a(foo$i) 11 } -cleanup { unset -nocomplain a } -result 38 test incr-1.17 {TclCompileIncrCmd: increment given, simple int} { set i 5 incr i 123 } 128 test incr-1.18 {TclCompileIncrCmd: increment given, simple int} { set i 5 incr i -100 } -95 test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body { set i 5 catch {incr i [set]} -> opts dict get $opts -errorinfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} { set i 25 incr i "-100" } -75 test incr-1.21 {TclCompileIncrCmd: increment given, in braces} { set i 24 incr i {126} } 150 test incr-1.22 {TclCompileIncrCmd: increment given, large int} { set i 5 incr i 200000 } 200005 test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} { set i 25 incr i 0o00012345 ;# an octal literal } 5374 test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body { set i 25 incr i 1a } -returnCodes error -result {expected integer but got "1a"} test incr-1.25 {TclCompileIncrCmd: too many arguments} -body { set i 10 incr i 10 20 } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} { unset -nocomplain {"foo} incr {"foo} } 1 test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body { list [catch {incr [set]} msg] $msg $::errorInfo } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" while *ing "set"*}} test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body { set x 123 readonly x list [catch {incr x 1} msg] $msg $::errorInfo } -match glob -cleanup { unset -nocomplain x } -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing * "incr x 1"}} test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body { set x " - " incr x 1 } -returnCodes error -result {expected integer but got " - "} test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup { catch {unset array} } -body { set array(\$foo) 4 incr {array($foo)} } -result 5 # Check "incr" and computed command names. unset -nocomplain x i test incr-2.0 {incr and computed command names} { set i 5 set z incr $z i -1 return $i } 4 test incr-2.1 {incr command (not compiled): missing variable name} -body { set z incr $z } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test incr-2.2 {incr command (not compiled): simple variable name} { set z incr set i 10 list [$z i] $i } {11 11} test incr-2.3 {incr command (not compiled): error compiling variable name} -body { set z incr set i 10 $z "i"xxx } -returnCodes error -result {extra characters after close-quote} test incr-2.4 {incr command (not compiled): simple variable name in quotes} { set z incr set i 17 list [$z "i"] $i } {18 18} test incr-2.5 {incr command (not compiled): simple variable name in braces} -setup { unset -nocomplain {a simple var} } -body { set z incr set {a simple var} 27 list [$z {a simple var}] ${a simple var} } -result {28 28} test incr-2.6 {incr command (not compiled): simple array variable name} -setup { unset -nocomplain a } -body { set z incr set a(foo) 37 list [$z a(foo)] $a(foo) } -result {38 38} test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} { set z incr set x "i" set i 77 list [$z $x 2] $i } {79 79} test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} { set z incr set x "i" set i 77 list [$z [set x] +2] $i } {79 79} test incr-2.9 {incr command (not compiled): increment given} { set z incr set i 10 list [$z i +07] $i } {17 17} test incr-2.10 {incr command (not compiled): no increment given} { set z incr set i 10 list [$z i] $i } {11 11} test incr-2.11 {incr command (not compiled): simple global name} { proc p {} { set z incr global i set i 54 $z i } p } {55} test incr-2.12 {incr command (not compiled): simple local name} { proc p {} { set z incr set foo 100 $z foo } p } {101} test incr-2.13 {incr command (not compiled): simple but new (unknown) local name} { proc p {} { set z incr $z bar } p } 1 test incr-2.14 {incr command (not compiled): simple local name, >255 locals} { proc 260locals {} { set z incr # create 260 locals set a0 0; set a1 0; set a2 0; set a3 0; set a4 0 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0 set z5 0; set z6 0; set z7 0; set z8 0; set z9 0 # now increment the last one (local var index > 255) $z z9 } 260locals } {1} test incr-2.15 {incr command (not compiled): variable is array} -setup { unset -nocomplain a } -body { set z incr set a(foo) 27 $z a(foo) 11 } -cleanup { unset -nocomplain a } -result 38 test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} -setup { unset -nocomplain a } -body { set z incr set i 5 set a(foo5) 27 $z a(foo$i) 11 } -cleanup { unset -nocomplain a } -result 38 test incr-2.17 {incr command (not compiled): increment given, simple int} { set z incr set i 5 $z i 123 } 128 test incr-2.18 {incr command (not compiled): increment given, simple int} { set z incr set i 5 $z i -100 } -95 test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body { set z incr set i 5 catch {$z i [set]} -> opts dict get $opts -errorinfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test incr-2.20 {incr command (not compiled): increment given, in quotes} { set z incr set i 25 $z i "-100" } -75 test incr-2.21 {incr command (not compiled): increment given, in braces} { set z incr set i 24 $z i {126} } 150 test incr-2.22 {incr command (not compiled): increment given, large int} { set z incr set i 5 $z i 200000 } 200005 test incr-2.23 {incr command (not compiled): increment given, formatted int != int} { set z incr set i 25 $z i 0o00012345 ;# an octal literal } 5374 test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body { set z incr set i 25 $z i 1a } -returnCodes error -result {expected integer but got "1a"} test incr-2.25 {incr command (not compiled): too many arguments} -body { set z incr set i 10 $z i 10 20 } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test incr-2.26 {incr command (not compiled): runtime error, bad variable name} -setup { unset -nocomplain {"foo} } -body { set z incr $z {"foo} } -result 1 test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body { set z incr list [catch {$z [set]} msg] $msg $::errorInfo } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" while *ing "set"*}} test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body { set z incr set x 123 readonly x list [catch {$z x 1} msg] $msg $::errorInfo } -match glob -cleanup { unset -nocomplain x } -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing * "$z x 1"}} test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body { set z incr set x " - " $z x 1 } -returnCodes error -result {expected integer but got " - "} test incr-2.30 {incr command (not compiled): bad increment} { set z incr set x 0 list [catch {$z x 1a} msg] $msg $::errorInfo } {1 {expected integer but got "1a"} {expected integer but got "1a" (reading increment) invoked from within "$z x 1a"}} test incr-2.31 {incr command (compiled): bad increment} { list [catch {incr x 1a} msg] $msg $::errorInfo } {1 {expected integer but got "1a"} {expected integer but got "1a" (reading increment) invoked from within "incr x 1a"}} test incr-3.1 {increment by wide amount: bytecode route} { set x 0 incr x 123123123123 } 123123123123 test incr-3.2 {increment by wide amount: command route} { set z incr set x 0 $z x 123123123123 } 123123123123 test incr-4.1 {increment non-existing array element [Bug 1445454]} -body { proc x {} {incr a(1)} x } -cleanup { rename x {} } -result 1 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/indexObj.test0000644000175000017500000001546414554262142015461 0ustar sergeisergei# This file is a Tcl script to test out the procedures in file # tkIndexObj.c, which implement indexed table lookups. The tests here are # organized in the standard fashion for Tcl tests. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testindexobj [llength [info commands testindexobj]] testConstraint testparseargs [llength [info commands testparseargs]] test indexObj-1.1 {exact match} testindexobj { testindexobj 1 1 xyz abc def xyz alm } {2} test indexObj-1.2 {exact match} testindexobj { testindexobj 1 1 abc abc def xyz alm } {0} test indexObj-1.3 {exact match} testindexobj { testindexobj 1 1 alm abc def xyz alm } {3} test indexObj-1.4 {unique abbreviation} testindexobj { testindexobj 1 1 xy abc def xalb xyz alm } {3} test indexObj-1.5 {multiple abbreviations and exact match} testindexobj { testindexobj 1 1 x abc def xalb xyz alm x } {5} test indexObj-1.6 {forced exact match} testindexobj { testindexobj 1 0 xy abc def xalb xy alm } {3} test indexObj-1.7 {forced exact match} testindexobj { testindexobj 1 0 x abc def xalb xyz alm x } {5} test indexObj-1.8 {exact match of empty values} testindexobj { testindexobj 1 1 {} a aa aaa {} b bb bbb } 3 test indexObj-1.9 {exact match of empty values} testindexobj { testindexobj 1 0 {} a aa aaa {} b bb bbb } 3 test indexObj-2.1 {no match} testindexobj { list [catch {testindexobj 1 1 dddd abc def xalb xyz alm x} msg] $msg } {1 {bad token "dddd": must be abc, def, xalb, xyz, alm, or x}} test indexObj-2.2 {no match} testindexobj { list [catch {testindexobj 1 1 dddd abc} msg] $msg } {1 {bad token "dddd": must be abc}} test indexObj-2.3 {no match: no abbreviations} testindexobj { list [catch {testindexobj 1 0 xy abc def xalb xyz alm} msg] $msg } {1 {bad token "xy": must be abc, def, xalb, xyz, or alm}} test indexObj-2.4 {ambiguous value} testindexobj { list [catch {testindexobj 1 1 d dumb daughter a c} msg] $msg } {1 {ambiguous token "d": must be dumb, daughter, a, or c}} test indexObj-2.5 {omit error message} testindexobj { list [catch {testindexobj 0 1 d x} msg] $msg } {1 {}} test indexObj-2.6 {TCL_EXACT => no "ambiguous" error message} testindexobj { list [catch {testindexobj 1 0 d dumb daughter a c} msg] $msg } {1 {bad token "d": must be dumb, daughter, a, or c}} test indexObj-2.7 {exact match of empty values} testindexobj { list [catch {testindexobj 1 1 {} a b c} msg] $msg } {1 {ambiguous token "": must be a, b, or c}} test indexObj-2.8 {exact match of empty values: singleton case} testindexobj { list [catch {testindexobj 1 0 {} a} msg] $msg } {1 {bad token "": must be a}} test indexObj-2.9 {non-exact match of empty values: singleton case} testindexobj { # NOTE this is a special case. Although the empty string is a # unique prefix, we have an established history of rejecting # empty lookup keys, requiring any unique prefix match to have # at least one character. list [catch {testindexobj 1 1 {} a} msg] $msg } {1 {bad token "": must be a}} test indexObj-3.1 {cache result to skip next lookup} testindexobj { testindexobj check 42 } {42} test indexObj-4.1 {free old internal representation} testindexobj { set x {a b} lindex $x 1 testindexobj 1 1 $x abc def {a b} zzz } {2} test indexObj-5.1 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 1 "?-switch?" mycmd } {wrong # args: should be "mycmd ?-switch?"} test indexObj-5.2 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 2 "bar" mycmd foo } {wrong # args: should be "mycmd foo bar"} test indexObj-5.3 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 0 "bar" mycmd foo } {wrong # args: should be "bar"} test indexObj-5.4 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 0 "" mycmd foo } {wrong # args: should be ""} test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 1 "" mycmd foo } {wrong # args: should be "mycmd"} test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 2 "" mycmd foo } {wrong # args: should be "mycmd foo"} # Contrast this with test proc-3.6; they have to be like this because # of [Bug 1066837] so Itcl won't break. test indexObj-5.7 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 2 "fee fi" "fo fum" foo bar } {wrong # args: should be "fo fum foo fee fi"} test indexObj-6.1 {Tcl_GetIndexFromObjStruct} testindexobj { set x a testgetindexfromobjstruct $x 0 } {wrong # args: should be "testgetindexfromobjstruct a 0"} test indexObj-6.2 {Tcl_GetIndexFromObjStruct} testindexobj { set x a testgetindexfromobjstruct $x 0 testgetindexfromobjstruct $x 0 } {wrong # args: should be "testgetindexfromobjstruct a 0"} test indexObj-6.3 {Tcl_GetIndexFromObjStruct} testindexobj { set x c testgetindexfromobjstruct $x 1 } {wrong # args: should be "testgetindexfromobjstruct c 1"} test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj { set x c testgetindexfromobjstruct $x 1 testgetindexfromobjstruct $x 1 } {wrong # args: should be "testgetindexfromobjstruct c 1"} test indexObj-6.5 {Tcl_GetIndexFromObjStruct with TCL_EXACT flag} -constraints testindexobj -body { set x e testgetindexfromobjstruct $x 0 1 } -returnCodes error -result {bad dummy "e": must be a, c, or ee} test indexObj-6.6 {Tcl_GetIndexFromObjStruct with NULL input} -constraints testindexobj -body { set x "" testgetindexfromobjstruct $x 0 } -returnCodes error -result {ambiguous dummy "": must be a, c, or ee} test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs { testparseargs } {0 1 testparseargs} test indexObj-7.2 {Tcl_ParseArgsObjv} testparseargs { testparseargs -bool } {1 1 testparseargs} test indexObj-7.3 {Tcl_ParseArgsObjv} testparseargs { testparseargs -bool bar } {1 2 {testparseargs bar}} test indexObj-7.4 {Tcl_ParseArgsObjv} testparseargs { testparseargs bar } {0 2 {testparseargs bar}} test indexObj-7.5 {Tcl_ParseArgsObjv} -constraints testparseargs -body { testparseargs -help } -returnCodes error -result {Command-specific options: -bool: booltest --: Marks the end of the options -help: Print summary of command-line options and abort} test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs { testparseargs -- -bool -help } {0 3 {testparseargs -bool -help}} test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs { testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0 } {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/info.test0000644000175000017500000022357014554262142014651 0ustar sergeisergei# -*- tcl -*- # Commands covered: info # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2006 ActiveState # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # DO NOT DELETE THIS LINE if {{::tcltest} ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Set up namespaces needed to test operation of "info args", "info body", # "info default", and "info procs" with imported procedures. catch {namespace delete test_ns_info1 test_ns_info2} namespace eval test_ns_info1 { namespace export * proc p {x} {return "x=$x"} proc q {{y 27} {z {}}} {return "y=$y"} } test info-1.1 {info args option} { proc t1 {a bbb c} {return foo} info args t1 } {a bbb c} test info-1.2 {info args option} { proc t1 {{a default1} {bbb default2} {c default3} args} {return foo} info a t1 } {a bbb c args} test info-1.3 {info args option} { proc t1 "" {return foo} info args t1 } {} test info-1.4 {info args option} -body { catch {rename t1 {}} info args t1 } -returnCodes error -result {"t1" isn't a procedure} test info-1.5 {info args option} -body { info args set } -returnCodes error -result {"set" isn't a procedure} test info-1.6 {info args option} { proc t1 {a b} {set c 123; set d $c} t1 1 2 info args t1 } {a b} test info-1.7 {info args option} { catch {namespace delete test_ns_info2} namespace eval test_ns_info2 { namespace import ::test_ns_info1::* list [info args p] [info args q] } } {x {y z}} test info-2.1 {info body option} { proc t1 {} {body of t1} info body t1 } {body of t1} test info-2.2 {info body option} -body { info body set } -returnCodes error -result {"set" isn't a procedure} test info-2.3 {info body option} -body { info args set 1 } -returnCodes error -result {wrong # args: should be "info args procname"} test info-2.4 {info body option} { catch {namespace delete test_ns_info2} namespace eval test_ns_info2 { namespace import ::test_ns_info1::* list [info body p] [info body q] } } {{return "x=$x"} {return "y=$y"}} # Prior to 8.3.0 this would cause a crash because [info body] # would return the bytecompiled version of foo, which the catch # would then try and eval out of the foo context, accessing # compiled local indices test info-2.5 {info body option, returning bytecompiled bodies} -body { catch {unset args} proc foo {args} { foreach v $args { upvar $v var return "variable $v existence: [info exists var]" } } foo a eval [info body foo] } -returnCodes error -result {can't read "args": no such variable} # Fix for problem tested for in info-2.5 caused problems when # procedure body had no string rep (i.e. was not yet bytecode) # causing an empty string to be returned [Bug #545644] test info-2.6 {info body option, returning list bodies} { proc foo args [list subst bar] list [string bytelength [info body foo]] \ [foo; string bytelength [info body foo]] } {9 9} proc testinfocmdcount {} { set x [info cmdcount] set y 12345 set z [info cm] expr {$z-$x} } test info-3.1 {info cmdcount compiled} { testinfocmdcount } 4 test info-3.2 {info cmdcount evaled} -body { set x [info cmdcount] set y 12345 set z [info cm] expr {$z-$x} } -cleanup {unset x y z} -result 4 test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4 test info-3.4 {info cmdcount option} -body { info cmdcount 1 } -returnCodes error -result {wrong # args: should be "info cmdcount"} test info-4.1 {info commands option} -body { proc t1 {} {} proc t2 {} {} set x " [info commands] " list [string match {* t1 *} $x] [string match {* t2 *} $x] \ [string match {* set *} $x] [string match {* list *} $x] } -cleanup {unset x} -result {1 1 1 1} test info-4.2 {info commands option} -body { proc t1 {} {} rename t1 {} string match {* t1 *} \ [info comm] } -result 0 test info-4.3 {info commands option} { proc _t1_ {} {} proc _t2_ {} {} info commands _t1_ } _t1_ test info-4.4 {info commands option} { proc _t1_ {} {} proc _t2_ {} {} lsort [info commands _t*] } {_t1_ _t2_} catch {rename _t1_ {}} catch {rename _t2_ {}} test info-4.5 {info commands option} -returnCodes error -body { info commands a b } -result {wrong # args: should be "info commands ?pattern?"} # Also some tests in namespace.test test info-5.1 {info complete option} -body { info complete } -returnCodes error -result {wrong # args: should be "info complete command"} test info-5.2 {info complete option} { info complete abc } 1 test info-5.3 {info complete option} { info complete "\{abcd " } 0 test info-5.4 {info complete option} { info complete {# Comment should be complete command} } 1 test info-5.5 {info complete option} { info complete {[a [b] } } 0 test info-5.6 {info complete option} { info complete {[a [b]} } 0 test info-6.1 {info default option} { proc t1 {a b {c d} {e "long default value"}} {} info default t1 a value } 0 test info-6.2 {info default option} -body { proc t1 {a b {c d} {e "long default value"}} {} set value 12345 info d t1 a value return $value } -cleanup {unset value} -result {} test info-6.3 {info default option} -body { proc t1 {a b {c d} {e "long default value"}} {} info default t1 c value } -cleanup {unset value} -result 1 test info-6.4 {info default option} -body { proc t1 {a b {c d} {e "long default value"}} {} set value 12345 info default t1 c value return $value } -cleanup {unset value} -result d test info-6.5 {info default option} -body { proc t1 {a b {c d} {e "long default value"}} {} set value 12345 set x [info default t1 e value] list $x $value } -cleanup {unset x value} -result {1 {long default value}} test info-6.6 {info default option} -returnCodes error -body { info default a b } -result {wrong # args: should be "info default procname arg varname"} test info-6.7 {info default option} -returnCodes error -body { info default _nonexistent_ a b } -result {"_nonexistent_" isn't a procedure} test info-6.8 {info default option} -returnCodes error -body { proc t1 {a b} {} info default t1 x value } -result {procedure "t1" doesn't have an argument "x"} test info-6.9 {info default option} -returnCodes error -setup { catch {unset a} } -cleanup {unset a} -body { set a(0) 88 proc t1 {a b} {} info default t1 a a } -returnCodes error -result {can't set "a": variable is array} test info-6.10 {info default option} -setup { catch {unset a} } -cleanup {unset a} -body { set a(0) 88 proc t1 {{a 18} b} {} info default t1 a a } -returnCodes error -result {can't set "a": variable is array} test info-6.11 {info default option} { catch {namespace delete test_ns_info2} namespace eval test_ns_info2 { namespace import ::test_ns_info1::* list [info default p x foo] $foo [info default q y bar] $bar } } {0 {} 1 27} test info-7.1 {info exists option} -body { set value foo info exists value } -cleanup {unset value} -result 1 test info-7.2 {info exists option} -setup {catch {unset _nonexistent_}} -body { info exists _nonexistent_ } -result 0 test info-7.3 {info exists option} { proc t1 {x} {return [info exists x]} t1 2 } 1 test info-7.4 {info exists option} -body { proc t1 {x} { global _nonexistent_ return [info exists _nonexistent_] } t1 2 } -setup {unset -nocomplain _nonexistent_} -result 0 test info-7.5 {info exists option} { proc t1 {x} { set y 47 return [info exists y] } t1 2 } 1 test info-7.6 {info exists option} { proc t1 {x} {return [info exists value]} t1 2 } 0 test info-7.7 {info exists option} -setup { catch {unset x} } -body { set x(2) 44 list [info exists x] [info exists x(1)] [info exists x(2)] } -result {1 0 1} catch {unset x} test info-7.8 {info exists option} -body { info exists } -returnCodes error -result {wrong # args: should be "info exists varName"} test info-7.9 {info exists option} -body { info exists 1 2 } -returnCodes error -result {wrong # args: should be "info exists varName"} test info-8.1 {info globals option} -body { set x 1 set y 2 set value 23 set a " [info globals] " list [string match {* x *} $a] [string match {* y *} $a] \ [string match {* value *} $a] [string match {* _foobar_ *} $a] } -cleanup {unset x y value a} -result {1 1 1 0} test info-8.2 {info globals option} -body { set _xxx1 1 set _xxx2 2 lsort [info g _xxx*] } -cleanup {unset _xxx1 _xxx2} -result {_xxx1 _xxx2} test info-8.3 {info globals option} -returnCodes error -body { info globals 1 2 } -result {wrong # args: should be "info globals ?pattern?"} test info-8.4 {info globals option: may have leading namespace qualifiers} -body { set x 0 list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x] } -cleanup {unset x} -result {x {} x x x} test info-8.5 {info globals option: only return existing global variables} { -setup { unset -nocomplain ::NO_SUCH_VAR proc evalInProc script {eval $script} } -body { evalInProc {global NO_SUCH_VAR; info globals NO_SUCH_VAR} } -cleanup { rename evalInProc {} } -result {} } test info-9.1 {info level option} { info level } 0 test info-9.2 {info level option} { proc t1 {a b} { set x [info le] set y [info level 1] list $x $y } t1 146 testString } {1 {t1 146 testString}} test info-9.3 {info level option} { proc t1 {a b} { t2 [expr {$a*2}] $b } proc t2 {x y} { list [info level] [info level 1] [info level 2] [info level -1] \ [info level 0] } t1 146 {a {b c} {{{c}}}} } {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}} test info-9.4 {info level option} { proc t1 {} { set x [info level] set y [info level 1] list $x $y } t1 } {1 t1} test info-9.5 {info level option} -body { info level 1 2 } -returnCodes error -result {wrong # args: should be "info level ?number?"} test info-9.6 {info level option} -body { info level 123a } -returnCodes error -result {expected integer but got "123a"} test info-9.7 {info level option} -body { info level 0 } -returnCodes error -result {bad level "0"} test info-9.8 {info level option} -body { proc t1 {} {info level -1} t1 } -returnCodes error -result {bad level "-1"} test info-9.9 {info level option} -body { proc t1 {x} {info level $x} t1 -3 } -returnCodes error -result {bad level "-3"} test info-9.10 {info level option, namespaces} -body { namespace eval t {info level 0} } -cleanup { namespace delete t } -result {namespace eval t {info level 0}} test info-9.11 {info level option, aliases} -constraints knownBug -setup { proc w {x y z} {info level 0} interp alias {} a {} w a b } -body { a c } -cleanup { rename a {} rename w {} } -result {a c} test info-9.12 {info level option, ensembles} -constraints knownBug -setup { proc w {x y z} {info level 0} namespace ensemble create -command a -map {foo ::w} } -body { a foo 1 2 3 } -cleanup { rename a {} rename w {} } -result {a foo 1 2 3} set savedLibrary $tcl_library test info-10.1 {info library option} -body { info library x } -returnCodes error -result {wrong # args: should be "info library"} test info-10.2 {info library option} { set tcl_library 12345 info library } {12345} test info-10.3 {info library option} -body { unset tcl_library info library } -returnCodes error -result {no library has been specified for Tcl} set tcl_library $savedLibrary; unset savedLibrary test info-11.1 {info loaded option} -body { info loaded a b } -returnCodes error -result {wrong # args: should be "info loaded ?interp?"} test info-11.2 {info loaded option} -body { info loaded {}; info loaded gorp } -returnCodes error -result {could not find interpreter "gorp"} test info-12.1 {info locals option} -body { set a 22 proc t1 {x y} { set b 13 set c testing global a global aa set aa 23 return [info locals] } lsort [t1 23 24] } -cleanup {unset a aa} -result {b c x y} test info-12.2 {info locals option} { proc t1 {x y} { set xx1 2 set xx2 3 set y 4 return [info loc x*] } lsort [t1 2 3] } {x xx1 xx2} test info-12.3 {info locals option} -body { info locals 1 2 } -returnCodes error -result {wrong # args: should be "info locals ?pattern?"} test info-12.4 {info locals option} { info locals } {} test info-12.5 {info locals option} { proc t1 {} {return [info locals]} t1 } {} test info-12.6 {info locals vs unset compiled locals} { proc t1 {lst} { foreach $lst $lst {} unset lst return [info locals] } lsort [t1 {a b c c d e f}] } {a b c d e f} test info-12.7 {info locals with temporary variables} { proc t1 {} { foreach a {b c} {} info locals } t1 } {a} test info-13.1 {info nameofexecutable option} -returnCodes error -body { info nameofexecutable foo } -result {wrong # args: should be "info nameofexecutable"} test info-14.1 {info patchlevel option} -body { set a [info patchlevel] regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a } -cleanup {unset a} -result 1 test info-14.2 {info patchlevel option} -returnCodes error -body { info patchlevel a } -result {wrong # args: should be "info patchlevel"} test info-14.3 {info patchlevel option} -setup { set t $tcl_patchLevel } -body { unset tcl_patchLevel info patchlevel } -cleanup { set tcl_patchLevel $t; unset t } -returnCodes error -result {can't read "tcl_patchLevel": no such variable} test info-15.1 {info procs option} -body { proc t1 {} {} proc t2 {} {} set x " [info procs] " list [string match {* t1 *} $x] [string match {* t2 *} $x] \ [string match {* _undefined_ *} $x] } -cleanup {unset x} -result {1 1 0} test info-15.2 {info procs option} { proc _tt1 {} {} proc _tt2 {} {} lsort [info pr _tt*] } {_tt1 _tt2} catch {rename _tt1 {}} catch {rename _tt2 {}} test info-15.3 {info procs option} -body { info procs 2 3 } -returnCodes error -result {wrong # args: should be "info procs ?pattern?"} test info-15.4 {info procs option} -setup { catch {namespace delete test_ns_info2} } -body { namespace eval test_ns_info2 { namespace import ::test_ns_info1::* proc r {} {} list [lsort [info procs]] [info procs p*] } } -result {{p q r} p} test info-15.5 {info procs option with a proc in a namespace} -setup { catch {namespace delete test_ns_info2} } -body { namespace eval test_ns_info2 { proc p1 { arg } { puts cmd } proc p2 { arg } { puts cmd } } info procs ::test_ns_info2::p1 } -result {::test_ns_info2::p1} test info-15.6 {info procs option with a pattern in a namespace} -setup { catch {namespace delete test_ns_info2} } -body { namespace eval test_ns_info2 { proc p1 { arg } { puts cmd } proc p2 { arg } { puts cmd } } lsort [info procs ::test_ns_info2::p*] } -result [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]] test info-15.7 {info procs option with a global shadowing proc} -setup { catch {namespace delete test_ns_info2} } -body { proc string_cmd { arg } { puts cmd } namespace eval test_ns_info2 { proc string_cmd { arg } { puts cmd } } info procs test_ns_info2::string* } -result {::test_ns_info2::string_cmd} # This regression test is currently commented out because it requires # that the implementation of "info procs" looks into the global namespace, # which it does not (in contrast to "info commands") test info-15.8 {info procs option with a global shadowing proc} -setup { catch {namespace delete test_ns_info2} } -constraints knownBug -body { proc string_cmd { arg } { puts cmd } proc string_cmd2 { arg } { puts cmd } namespace eval test_ns_info2 { proc string_cmd { arg } { puts cmd } } namespace eval test_ns_info2 { lsort [info procs string*] } } -result [lsort [list string_cmd string_cmd2]] test info-16.1 {info script option} -returnCodes error -body { info script x x } -result {wrong # args: should be "info script ?filename?"} test info-16.2 {info script option} { file tail [info sc] } "info.test" set gorpfile [makeFile "info script\n" gorp.info] test info-16.3 {info script option} { list [source $gorpfile] [file tail [info script]] } [list $gorpfile info.test] test info-16.4 {resetting "info script" after errors} { catch {source ~_nobody_/foo} file tail [info script] } "info.test" test info-16.5 {resetting "info script" after errors} { catch {source _nonexistent_} file tail [info script] } "info.test" test info-16.6 {info script option} -body { set script [info script] list [file tail [info script]] \ [info script newname.txt] \ [file tail [info script $script]] } -result [list info.test newname.txt info.test] -cleanup {unset script} test info-16.7 {info script option} -body { set script [info script] info script newname.txt list [source $gorpfile] [file tail [info script]] \ [file tail [info script $script]] } -result [list $gorpfile newname.txt info.test] -cleanup {unset script} removeFile gorp.info set gorpfile [makeFile {list [info script] [info script foo.bar]} gorp.info] test info-16.8 {info script option} { list [source $gorpfile] [file tail [info script]] } [list [list $gorpfile foo.bar] info.test] removeFile gorp.info; unset gorpfile test info-17.1 {info sharedlibextension option} -returnCodes error -body { info sharedlibextension foo } -result {wrong # args: should be "info sharedlibextension"} test info-18.1 {info tclversion option} -body { scan [info tclversion] "%d.%d%c" a b c } -cleanup {unset -nocomplain a b c} -result 2 test info-18.2 {info tclversion option} -body { info t 2 } -returnCodes error -result {wrong # args: should be "info tclversion"} test info-18.3 {info tclversion option} -body { unset tcl_version info tclversion } -returnCodes error -setup { set t $tcl_version } -cleanup { set tcl_version $t; unset t } -result {can't read "tcl_version": no such variable} test info-19.1 {info vars option} -body { set a 1 set b 2 proc t1 {x y} { global a b set c 33 return [info vars] } lsort [t1 18 19] } -cleanup {unset a b} -result {a b c x y} test info-19.2 {info vars option} -body { set xxx1 1 set xxx2 2 proc t1 {xxa y} { global xxx1 xxx2 set c 33 return [info vars x*] } lsort [t1 18 19] } -cleanup {unset xxx1 xxx2} -result {xxa xxx1 xxx2} test info-19.3 {info vars option} { lsort [info vars] } [lsort [info globals]] test info-19.4 {info vars option} -returnCodes error -body { info vars a b } -result {wrong # args: should be "info vars ?pattern?"} test info-19.5 {info vars with temporary variables} { proc t1 {} { foreach a {b c} {} info vars } t1 } {a} test info-19.6 {info vars: Bug 1072654} -setup { namespace eval :: unset -nocomplain foo catch {namespace delete x} } -body { namespace eval x info vars foo } -cleanup { namespace delete x } -result {} set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isqrt log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} # Check whether the extra testing functions are defined... if {!([catch {expr {T1()}} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} { set functions "T1 T2 T3 $functions" ;# A lazy way of prepending! } test info-20.1 {info functions option} {info functions sin} sin test info-20.2 {info functions option} {lsort [info functions]} $functions test info-20.3 {info functions option} { lsort [info functions a*] } {abs acos asin atan atan2} test info-20.4 {info functions option} { lsort [info functions *tan*] } {atan atan2 tan tanh} test info-20.5 {info functions option} -returnCodes error -body { info functions raise an error } -result {wrong # args: should be "info functions ?pattern?"} unset functions msg test info-21.1 {miscellaneous error conditions} -returnCodes error -body { info } -result {wrong # args: should be "info subcommand ?arg ...?"} test info-21.2 {miscellaneous error conditions} -returnCodes error -body { info gorp } -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.3 {miscellaneous error conditions} -returnCodes error -body { info c } -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.4 {miscellaneous error conditions} -returnCodes error -body { info l } -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.5 {miscellaneous error conditions} -returnCodes error -body { info s } -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} ## # ### ### ### ######### ######### ######### ## info frame ## Helper # For the more complex results we cut the file name down to remove path # dependencies, and we use only part of the first line of the reported # command. The latter is required because otherwise the whole test case may # appear in some results, but the result is part of the testcase. An infinite # string would be required to describe that. The cutting-down breaks this. proc reduce {frame} { set cmd [dict get $frame cmd] if {[regexp \n $cmd]} { dict set frame cmd \ [string range [lindex [split $cmd \n] 0] 0 end-4] } if {[dict exists $frame file]} { dict set frame file \ [file tail [dict get $frame file]] } return $frame } proc subinterp {} { interp create sub ; interp debug sub -frame 1; interp eval sub [list proc reduce [info args reduce] [info body reduce]] } ## Helper # Generate a stacktrace from the current location to top. This code # not only depends on the exact location of things, but also on the # implementation of tcltest. Any changes and these tests will have to # be updated. proc etrace {} { set res {} set level [info frame] while {$level} { lappend res [list $level [reduce [info frame $level]]] incr level -1 } return $res } test info-22.0 {info frame, levels} {!singleTestInterp} { info frame } 7 test info-22.1 {info frame, bad level relative} {!singleTestInterp} { # catch is another level!, i.e. we have 8, not 7 catch {info frame -8} msg set msg } {bad level "-8"} test info-22.2 {info frame, bad level absolute} {!singleTestInterp} { # catch is another level!, i.e. we have 8, not 7 catch {info frame 9} msg set msg } {bad level "9"} test info-22.3 {info frame, current, relative} -match glob -body { info frame 0 } -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-22.4 {info frame, current, relative, nested} -match glob -body { set res [info frame 0] } -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res} test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body { reduce [info frame 7] } -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest} test info-22.6 {info frame, global, relative} {!singleTestInterp} { reduce [info frame -6] } {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0} test info-22.7 {info frame, global, absolute} {!singleTestInterp} { reduce [info frame 1] } {type source line 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0} test info-22.8 {info frame, basic trace} -match glob -body { join [lrange [etrace] 0 2] \n } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest} * {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}} unset -nocomplain msg ## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0 test info-23.0 {eval'd info frame} -constraints {!singleTestInterp} -body { list [i eval {info frame}] [i eval {eval {info frame}}] } -setup {interp create i} -cleanup {interp delete i} -result {1 2} test info-23.1 {eval'd info frame, semi-dynamic} -constraints {!singleTestInterp} -body { i eval {eval info frame} } -setup {interp create i} -cleanup {interp delete i} -result 2 test info-23.2 {eval'd info frame, dynamic} -constraints {!singleTestInterp} -body { i eval { set script {info frame} eval $script} } -setup {interp create i} -cleanup {interp delete i} -result 2 test info-23.3 {eval'd info frame, literal} -match glob -body { eval { info frame 0 } } -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest} test info-23.4 {eval'd info frame, semi-dynamic} { eval info frame 0 } {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest} test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body { set script {info frame 0} eval $script } -result {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest} test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body { set script {etrace} join [lrange [eval $script] 0 2] \n } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 1 cmd etrace proc ::tcltest::RunTest} * {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}} # ------------------------------------------------------------------------- # Procedures defined in scripts which are arguments to control # structures (like 'namespace eval', 'interp eval', 'if', 'while', # 'switch', 'catch', 'for', 'foreach', etc.) have no absolute # location. The command implementations execute such scripts through # Tcl_EvalObjEx. Flag 0 causes it to use the bytecode compiler. This # causes the connection to the context to be lost. Currently only # procedure bodies are able to remember their context. # NOTE THAT THESE DO NOT USE THE -setup OPTION TO [test] # ------------------------------------------------------------------------- namespace eval foo { proc bar {} {info frame 0} } test info-24.0 {info frame, interaction, namespace eval} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 825 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- set flag 1 if {$flag} { namespace eval foo {} proc ::foo::bar {} {info frame 0} } test info-24.1 {info frame, interaction, if} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 839 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- set flag 1 while {$flag} { namespace eval foo {} proc ::foo::bar {} {info frame 0} set flag 0 };unset flag test info-24.2 {info frame, interaction, while} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 853 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- catch { namespace eval foo {} proc ::foo::bar {} {info frame 0} } test info-24.3 {info frame, interaction, catch} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 867 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- foreach var val { namespace eval foo {} proc ::foo::bar {} {info frame 0} break }; unset var test info-24.4 {info frame, interaction, foreach} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 880 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- for {} {1} {} { namespace eval foo {} proc ::foo::bar {} {info frame 0} break } test info-24.5 {info frame, interaction, for} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 894 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} set x foo switch -exact -- $x { foo { proc ::foo::bar {} {info frame 0} } } test info-24.6.0 {info frame, interaction, switch, list body} -body { reduce [foo::bar] } -cleanup { namespace delete foo unset x } -result {type source line 910 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} set x foo switch -exact -- $x foo { proc ::foo::bar {} {info frame 0} } test info-24.6.1 {info frame, interaction, switch, multi-body} -body { reduce [foo::bar] } -cleanup { namespace delete foo unset x } -result {type source line 926 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} set x foo switch -exact -- $x [list foo { proc ::foo::bar {} {info frame 0} }] test info-24.6.2 {info frame, interaction, switch, list body, dynamic} -body { reduce [foo::bar] } -cleanup { namespace delete foo unset x } -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} dict for {k v} {foo bar} { proc ::foo::bar {} {info frame 0} } test info-24.7 {info frame, interaction, dict for} { reduce [foo::bar] } {type source line 955 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo; unset k v # ------------------------------------------------------------------------- namespace eval foo {} set thedict {foo bar} dict with thedict { proc ::foo::bar {} {info frame 0} } test info-24.8 {info frame, interaction, dict with} { reduce [foo::bar] } {type source line 969 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo unset thedict foo # ------------------------------------------------------------------------- namespace eval foo {} dict filter {foo bar} script {k v} { proc ::foo::bar {} {info frame 0} set x 1 }; unset k v x test info-24.9 {info frame, interaction, dict filter} { reduce [foo::bar] } {type source line 983 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo #unset x # ------------------------------------------------------------------------- eval { proc bar {} {info frame 0} } test info-25.0 {info frame, proc in eval} { reduce [bar] } {type source line 997 file info.test cmd {info frame 0} proc ::bar level 0} # Don't need to clean up yet... proc bar {} {info frame 0} test info-25.1 {info frame, regular proc} { reduce [bar] } {type source line 1005 file info.test cmd {info frame 0} proc ::bar level 0} rename bar {} # ------------------------------------------------------------------------- # More info-30.x test cases at the end of the file. test info-30.0 {bs+nl in literal words} -cleanup {unset res} -body { if {1} { set res \ [reduce [info frame 0]];#1018 } return $res # This was reporting line 3 instead of the correct 4 because the # bs+nl combination is subst by the parser before the 'if' # command, and the bcc, see the word. Fixed by recording the # offsets of all bs+nl sequences in literal words, then using the # information in the bcc and other places to bump line numbers when # parsing over the location. Also affected: testcases 22.8 and 23.6. } -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest} # ------------------------------------------------------------------------- # See 24.0 - 24.5 for similar situations, using literal scripts. set body {set flag 0 set a c set res [info frame 0]} ;# line 3! test info-31.0 {ns eval, script in variable} -body {namespace eval foo {variable res {}} namespace eval foo $body return $foo::res } -result {type eval line 3 cmd {info frame 0} level 0} -cleanup { catch {namespace delete foo} } test info-31.1 {if, script in variable} -cleanup {unset res a flag} -body { if 1 $body return $res } -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} test info-31.1a {if, script in variable} -cleanup {unset res a flag} -body { if 1 then $body return $res } -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} test info-31.2 {while, script in variable} -cleanup {unset flag res a} -body { set flag 1 while {$flag} $body return $res } -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} # .3 - proc - scoping prevent return of result ... test info-31.4 {foreach, script in variable} -cleanup {unset var res a flag} -body { foreach var val $body set res } -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} test info-31.5 {for, script in variable} -cleanup {unset flag res a} -body { set flag 1 for {} {$flag} {} $body return $res } -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} test info-31.6 {eval, script in variable} -cleanup {unset res a flag} -body { eval $body return $res } -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} # ------------------------------------------------------------------------- set body { foo { proc ::foo::bar {} {info frame 0} } } namespace eval foo {} set x foo switch -exact -- $x $body; unset body test info-31.7 {info frame, interaction, switch, dynamic} -body { reduce [foo::bar] } -cleanup { namespace delete foo unset x } -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- set body { proc ::foo::bar {} {info frame 0} } namespace eval foo {} eval $body test info-32.0 {info frame, dynamic procedure} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace {*}{ eval foo {proc bar {} {info frame 0}} } test info-33.0 {{*}, literal, direct} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 1115 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { set flag 1 if {*}{ {$flag} {info frame 0} } } test info-33.1 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 1130 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace {*}" eval foo {proc bar {} {info frame 0}} " test info-33.2 {{*}, literal, direct} { reduce [foo::bar] } {type source line 1144 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- namespace {*}"eval\nfoo\n{proc bar {} {info frame 0}}\n" test info-33.2a {{*}, literal, not simple, direct} { reduce [foo::bar] } {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { set flag 1 if {*}" {1} {info frame 0} " } test info-33.3 {{*}, literal, simple, bytecompiled} { reduce [foo::bar] } {type source line 1169 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { set flag 1 if {*}"\n{1}\n{info frame 0}" } test info-33.3a {{*}, literal, not simple, bytecompiled} { reduce [foo::bar] } {type eval line 1 cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- set body { eval foo {proc bar {} { info frame 0 }} } namespace {*}$body test info-34.0 {{*}, dynamic, direct} { reduce [foo::bar] } {type proc line 2 cmd {info frame 0} proc ::foo::bar level 0} unset body namespace delete foo # ------------------------------------------------------------------------- namespace eval foo {} set body { {$flag} {info frame 0} } proc foo::bar {} { global body ; set flag 1 if {*}$body } test info-34.1 {{*}, literal, bytecompiled} { reduce [foo::bar] } {type eval line 1 cmd {info frame 0} proc ::foo::bar level 0} unset body namespace delete foo # ------------------------------------------------------------------------- proc foo {} { apply { {x y} {info frame 0} } 0 0 } test info-35.0 {apply, literal} { reduce [foo] } {type source line 1231 file info.test cmd {info frame 0} lambda { {x y} {info frame 0} } level 0} rename foo {} set lambda { {x y} {info frame 0} } test info-35.1 {apply, dynamic} { reduce [apply $lambda 0 0] } {type proc line 1 cmd {info frame 0} lambda { {x y} {info frame 0} } level 0} unset lambda # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { dict for {k v} {foo bar} { set x [info frame 0] } set x } test info-36.0 {info frame, dict for, bcc} -body { reduce [foo::bar] } -result {type source line 1259 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { set x foo switch -exact -- $x { foo {set y [info frame 0]} } set y } test info-36.1.0 {switch, list literal, bcc} -body { reduce [foo::bar] } -result {type source line 1275 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { set x foo switch -exact -- $x foo {set y [info frame 0]} set y } test info-36.1.1 {switch, multi-body literals, bcc} -body { reduce [foo::bar] } -result {type source line 1291 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- test info-37.0 {eval pure list, single line} -match glob -body { # Basically, counting the newline in the word seen through $foo # doesn't really make sense. It makes a bit of sense if the word # would have been a string literal in the command list. # # Problem: At the point where we see the list elements we cannot # distinguish the two cases, thus we cannot switch between # count/not-count, it is has to be one or the other for all # cases. Of the two possibilities miguel convinced me that 'not # counting' is the more proper. set foo {b c} set cmd [list foreach $foo {x y} { set res [join [lrange [etrace] 0 2] \n] break }] eval $cmd return $res } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 2 cmd etrace proc ::tcltest::RunTest} * {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c} # ------------------------------------------------------------------------- # 6 cases. ## DV. direct-var - unchanged ## DPV direct-proc-var - ditto ## PPV proc-proc-var - ditto ## DL. direct-literal - now tracking absolute location ## DPL direct-proc-literal - ditto ## PPL proc-proc-literal - ditto ## ### ### ### ######### ######### #########" proc control {vv script} { upvar 1 $vv var return [uplevel 1 $script] } proc datal {} { control y { set y PPL etrace } } proc datav {} { set script { set y PPV etrace } control y $script } test info-38.1 {location information for uplevel, dv, direct-var} -match glob -body { set script { set y DV. etrace } join [lrange [uplevel \#0 $script] 0 2] \n } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 3 cmd etrace proc ::tcltest::RunTest} * {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y} # 38.2 moved to bottom to not disturb other tests with the necessary changes to this one. test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match glob -body { set script { set y DPV etrace } join [lrange [control y $script] 0 3] \n } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 3 cmd etrace proc ::control} * {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control} * {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y} # 38.4 moved to bottom to not disturb other tests with the necessary changes to this one. test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glob -body { join [lrange [datav] 0 4] \n } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 3 cmd etrace proc ::control} * {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control} * {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1} * {type source line 1397 file info.test cmd datav proc ::tcltest::RunTest}} # 38.6 moved to bottom to not disturb other tests with the necessary changes to this one. testConstraint testevalex [llength [info commands testevalex]] test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body { join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n } -result {* {type source line 730 file info.test cmd {info frame \$level} proc ::etrace level 0} * {type eval line 1 cmd etrace proc ::tcltest::RunTest} * {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest} * {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}} # ------------------------------------------------------------------------- # literal sharing test info-39.0 {location information not confused by literal sharing} -body { namespace eval ::foo {} proc ::foo::bar {} { lappend res {} lappend res [reduce [eval {info frame 0}]] lappend res [reduce [eval {info frame 0}]] return $res } set res [::foo::bar] namespace delete ::foo join $res \n } -cleanup {unset res} -result { type source line 1427 file info.test cmd {info frame 0} proc ::foo::bar level 0 type source line 1428 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- # Additional tests for info-30.*, handling of continuation lines (bs+nl sequences). test info-30.1 {bs+nl in literal words, procedure body, compiled} -body { proc abra {} { if {1} \ { return \ [reduce [info frame 0]];# line 1446 } } abra } -cleanup { rename abra {} } -result {type source line 1446 file info.test cmd {info frame 0} proc ::abra level 0} test info-30.2 {bs+nl in literal words, namespace script} { namespace eval xxx { variable res \ [info frame 0];# line 1457 } return [reduce $xxx::res] } {type source line 1457 file info.test cmd {info frame 0} level 0} test info-30.3 {bs+nl in literal words, namespace multi-word script} { namespace eval xxx variable res \ [list [reduce [info frame 0]]];# line 1464 return $xxx::res } {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body { eval { set ::res \ [reduce [info frame 0]];# line 1471 } return $res } -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.5 {bs+nl in literal words, eval script, with nested words} -body { eval { if {1} \ { set ::res \ [reduce [info frame 0]];# line 1481 } } return $res } -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body { set res "\ [reduce [info frame 0]]";# line 1489 } -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.7 {bs+nl in computed word, in proc} -body { proc abra {} { return "\ [reduce [info frame 0]]";# line 1495 } abra } -cleanup { rename abra {} } -result { type source line 1495 file info.test cmd {info frame 0} proc ::abra level 0} test info-30.8 {bs+nl in computed word, nested eval} -body { eval { set \ res "\ [reduce [info frame 0]]";# line 1506 } } -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.9 {bs+nl in computed word, nested eval} -body { eval { set \ res "\ [reduce \ [info frame 0]]";# line 1515 } } -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.10 {bs+nl in computed word, key to array} -body { set tmp([set \ res "\ [reduce \ [info frame 0]]"]) x ; #1523 unset tmp set res } -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.11 {bs+nl in subst arguments} -body { subst {[set \ res "\ [reduce \ [info frame 0]]"]} ; #1532 } -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.12 {bs+nl in computed word, nested eval} -body { eval { set \ res "\ [set x {}] \ [reduce \ [info frame 0]]";# line 1541 } } -cleanup {unset res x} -result { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body { subinterp ; set res [interp eval sub { uplevel #0 { if {1} \ { set ::res \ [reduce [info frame 0]];# line 1550 } } set res }] ; interp delete sub ; set res } -cleanup {unset res} -result {type source line 1550 file info.test cmd {info frame 0} level 0} test info-30.14 {bs+nl, literal word, uplevel through proc} { subinterp ; set res [interp eval sub { proc abra {script} { uplevel 1 $script } set res [abra { return "\ [reduce [info frame 0]]";# line 1562 }] rename abra {} set res }] ; interp delete sub ; set res } { type source line 1562 file info.test cmd {info frame 0} proc ::abra} test info-30.15 {bs+nl in literal words, nested proc body, compiled} { proc a {} { proc b {} { if {1} \ { return \ [reduce [info frame 0]];# line 1574 } } } a ; set res [b] rename a {} rename b {} set res } {type source line 1574 file info.test cmd {info frame 0} proc ::b level 0} test info-30.16 {bs+nl in multi-body switch, compiled} { proc a {value} { switch -regexp -- $value \ ^key { info frame 0; # 1587 } \ \t### { info frame 0; # 1588 } \ {[0-9]*} { info frame 0; # 1589 } } set res {} lappend res [reduce [a {key }]] lappend res [reduce [a {1alpha}]] set res "\n[join $res \n]" } { type source line 1587 file info.test cmd {info frame 0} proc ::a level 0 type source line 1589 file info.test cmd {info frame 0} proc ::a level 0} test info-30.17 {bs+nl in multi-body switch, direct} { switch -regexp -- {key } \ ^key { reduce [info frame 0] ;# 1601 } \ \t### { } \ {[0-9]*} { } } {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} { proc abra {script} { append script "\n# end of script" uplevel 1 $script } set res [abra { return "\ [reduce [info frame 0]]";# line 1613, still line of 3 appended script }] rename abra {} set res } { type eval line 3 cmd {info frame 0} proc ::abra} # { type source line 1606 file info.test cmd {info frame 0} proc ::abra} test info-30.19 {bs+nl in single-body switch, compiled} { proc a {value} { switch -regexp -- $value { ^key { reduce \ [info frame 0] } \t { reduce \ [info frame 0] } {[0-9]*} { reduce \ [info frame 0] } } } set res {} lappend res [a {key }] lappend res [a {1alpha}] set res "\n[join $res \n]" } { type source line 1624 file info.test cmd {info frame 0} proc ::a level 0 type source line 1628 file info.test cmd {info frame 0} proc ::a level 0} test info-30.20 {bs+nl in single-body switch, direct} { switch -regexp -- {key } { \ ^key { reduce \ [info frame 0] } \t### { } {[0-9]*} { } } } {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.21 {bs+nl in if, full compiled} { proc a {value} { if {$value} \ {info frame 0} \ {info frame 0} ; # 1653 } set res {} lappend res [reduce [a 1]] lappend res [reduce [a 0]] set res "\n[join $res \n]" } { type source line 1652 file info.test cmd {info frame 0} proc ::a level 0 type source line 1653 file info.test cmd {info frame 0} proc ::a level 0} test info-30.22 {bs+nl in computed word, key to array, compiled} { proc a {} { set tmp([set \ res "\ [reduce \ [info frame 0]]"]) x ; #1668 unset tmp set res } set res [a] rename a {} set res } { type source line 1668 file info.test cmd {info frame 0} proc ::a level 0} test info-30.23 {bs+nl in multi-body switch, full compiled} { proc a {value} { switch -exact -- $value \ key { info frame 0; # 1680 } \ xxx { info frame 0; # 1681 } \ 000 { info frame 0; # 1682 } } set res {} lappend res [reduce [a key]] lappend res [reduce [a 000]] set res "\n[join $res \n]" } { type source line 1680 file info.test cmd {info frame 0} proc ::a level 0 type source line 1682 file info.test cmd {info frame 0} proc ::a level 0} test info-30.24 {bs+nl in single-body switch, full compiled} { proc a {value} { switch -exact -- $value { key { reduce \ [info frame 0] } xxx { reduce \ [info frame 0] } 000 { reduce \ [info frame 0] } } } set res {} lappend res [a key] lappend res [a 000] set res "\n[join $res \n]" } { type source line 1696 file info.test cmd {info frame 0} proc ::a level 0 type source line 1700 file info.test cmd {info frame 0} proc ::a level 0} test info-30.25 {TIP 280 for compiled [subst]} { subst {[reduce [info frame 0]]} ; # 1712 } {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.26 {TIP 280 for compiled [subst]} { subst \ {[reduce [info frame 0]]} ; # 1716 } {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.27 {TIP 280 for compiled [subst]} { subst { [reduce [info frame 0]]} ; # 1720 } { type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.28 {TIP 280 for compiled [subst]} { subst {\ [reduce [info frame 0]]} ; # 1725 } { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.29 {TIP 280 for compiled [subst]} { subst {foo\ [reduce [info frame 0]]} ; # 1729 } {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.30 {TIP 280 for compiled [subst]} { subst {foo [reduce [info frame 0]]} ; # 1733 } {foo type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.31 {TIP 280 for compiled [subst]} { subst {[][reduce [info frame 0]]} ; # 1737 } {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.32 {TIP 280 for compiled [subst]} { subst {[\ ][reduce [info frame 0]]} ; # 1741 } {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.33 {TIP 280 for compiled [subst]} { subst {[ ][reduce [info frame 0]]} ; # 1745 } {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.34 {TIP 280 for compiled [subst]} { subst {[format %s {} ][reduce [info frame 0]]} ; # 1749 } {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.35 {TIP 280 for compiled [subst]} { subst {[format %s {} ] [reduce [info frame 0]]} ; # 1754 } { type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.36 {TIP 280 for compiled [subst]} { subst { [format %s {}][reduce [info frame 0]]} ; # 1759 } { type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.37 {TIP 280 for compiled [subst]} { subst { [format %s {}] [reduce [info frame 0]]} ; # 1765 } { type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.38 {TIP 280 for compiled [subst]} { subst {\ [format %s {}][reduce [info frame 0]]} ; # 1771 } { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.39 {TIP 280 for compiled [subst]} { subst {\ [format %s {}]\ [reduce [info frame 0]]} ; # 1776 } { type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.40 {TIP 280 for compiled [subst]} -setup { unset -nocomplain empty } -body { set empty {} subst {$empty[reduce [info frame 0]]} ; # 1782 } -cleanup { unset empty } -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.41 {TIP 280 for compiled [subst]} -setup { unset -nocomplain empty } -body { set empty {} subst {$empty [reduce [info frame 0]]} ; # 1791 } -cleanup { unset empty } -result { type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.42 {TIP 280 for compiled [subst]} -setup { unset -nocomplain empty } -body { set empty {}; subst {$empty\ [reduce [info frame 0]]} ; # 1800 } -cleanup { unset empty } -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.43 {TIP 280 for compiled [subst]} -body { unset -nocomplain a\nb set a\nb {} subst {${a b}[reduce [info frame 0]]} ; # 1808 } -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.44 {TIP 280 for compiled [subst]} { unset -nocomplain a set a(\n) {} subst {$a( )[reduce [info frame 0]]} ; # 1814 } {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.45 {TIP 280 for compiled [subst]} { unset -nocomplain a set a() {} subst {$a([ return -level 0])[reduce [info frame 0]]} ; # 1820 } {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::RunTest} test info-30.46 {TIP 280 for compiled [subst]} { unset -nocomplain a set a(1825) YES; set a(1824) 1824; set a(1826) 1826 subst {$a([dict get [info frame 0] line])} ; # 1825 } YES test info-30.47 {TIP 280 for compiled [subst]} { unset -nocomplain a set a(\n1831) YES; set a(\n1830) 1830; set a(\n1832) 1832 subst {$a( [dict get [info frame 0] line])} ; # 1831 } YES unset -nocomplain a test info-30.48 {Bug 2850901} testevalex { testevalex {return -level 0 [format %s {} ][reduce [info frame 0]]} ; # line 2 of the eval } {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest} # ------------------------------------------------------------------------- # literal sharing 2, bug 2933089 test info-40.1 {location information not confused by literal sharing, bug 2933089} -setup { set result {} proc print_one {} {} proc test_info_frame {} { set x 1 set y x if "$x != 1" { } else { print_one } ;#line 1854^ if "$$y != 1" { } else { print_one } ;#line 1859^ # Do not put the comments listing the line numbers into the # branches. We need shared literals, and the comments would # make them different, thus unshared. } proc get_frame_info { cmd_str op } { lappend ::result [reduce [eval {info frame -3}]] } trace add execution print_one enter get_frame_info } -body { test_info_frame; join $result \n } -cleanup { trace remove execution print_one enter get_frame_info rename get_frame_info {} rename test_info_frame {} rename print_one {} } -result {type source line 1854 file info.test cmd print_one proc ::test_info_frame level 1 type source line 1859 file info.test cmd print_one proc ::test_info_frame level 1} # ------------------------------------------------------------------------- # Tests moved to the end to not disturb other tests and their locations. test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match glob -setup {subinterp} -body { interp eval sub { proc etrace {} { set res {} set level [info frame] while {$level} { lappend res [list $level [reduce [info frame $level]]] incr level -1 } return $res } proc control {vv script} { upvar 1 $vv var return [uplevel 1 $script] } proc datal {} { control y { set y PPL etrace } } join [lrange [datal] 0 4] \n } } -result {* {type source line 1890 file info.test cmd {info frame $level} proc ::etrace level 0} * {type source line 1902 file info.test cmd etrace proc ::control} * {type source line 1897 file info.test cmd {uplevel 1 $script} proc ::control} * {type source line 1900 file info.test cmd control proc ::datal level 1} * {type source line 1905 file info.test cmd datal level 2}} -cleanup {interp delete sub} test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -setup {subinterp} -body { interp eval sub { proc etrace {} { set res {} set level [info frame] while {$level} { lappend res [list $level [reduce [info frame $level]]] incr level -1 } return $res } proc control {vv script} { upvar 1 $vv var return [uplevel 1 $script] } join [lrange [control y { set y DPL etrace }] 0 3] \n } } -result {* {type source line 1919 file info.test cmd {info frame $level} proc ::etrace level 0} * {type source line 1930 file info.test cmd etrace proc ::control} * {type source line 1926 file info.test cmd {uplevel 1 $script} proc ::control} * {type source line 1928 file info.test cmd control level 1}} -cleanup {interp delete sub} test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -setup {subinterp} -body { interp eval sub { proc etrace {} { set res {} set level [info frame] while {$level} { lappend res [list $level [reduce [info frame $level]]] incr level -1 } return $res } join [lrange [uplevel \#0 { set y DL. etrace }] 0 2] \n } } -result {* {type source line 1944 file info.test cmd {info frame $level} proc ::etrace level 0} * {type source line 1951 file info.test cmd etrace level 1} * {type source line 1949 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub} # This test at the end of this file _only_ to avoid disturbing above line # numbers. It _belongs_ after info-9.12 test info-9.13 {info level option, value in global context} -body { uplevel #0 {info level 2} } -returnCodes error -result {bad level "2"} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { catch {*}{ {info frame 0} res } return $res } test info-33.4 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { dict for {a b} {c d} {*}{ {set res [info frame 0]} } return $res } test info-33.5 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { set d {a b} dict update d x y {*}{ {set res [info frame 0]} } return $res } test info-33.6 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { set d {} dict with d {*}{ {set res [info frame 0]} } return $res } test info-33.7 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { for {*}{ {set res [info frame 0]} {1} {} {break} } return $res } test info-33.8 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { for {*}{ {} {1} {} {set res [info frame 0]; break} } return $res } test info-33.9 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { for {*}{ {} {1} {return [info frame 0]} {} } } test info-33.10 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { for {*}{ {} {[return [info frame 0]]} {} {} } } test info-33.11 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { foreach {*}{ x } [return [info frame 0]] {} } test info-33.12 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { foreach {*}{ x y {set res [info frame 0]} } return $res } test info-33.13 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { if {*}{ {[return [info frame 0]]} {} } } test info-33.14 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { if 0 {*}{ {} else {return [info frame 0]} } } test info-33.15 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { incr {*}{ x } [return [info frame 0]] } test info-33.16 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { info level {*}{ } [return [info frame 0]] } test info-33.17 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { string match {*}{ } [return [info frame 0]] {} } test info-33.18 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { string match {*}{ {} } [return [info frame 0]] } test info-33.19 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { string length {*}{ } [return [info frame 0]] } test info-33.20 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { while {*}{ {[return [info frame 0]]} } {} } test info-33.21 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { switch -- {*}{ } [return [info frame 0]] {*}{ } x y } test info-33.22 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { try {*}{ {set res [info frame 0]} } return $res } test info-33.23 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { try {*}{ {set res [info frame 0]} } finally {} return $res } test info-33.24 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { try {*}{ {set res [info frame 0]} } on ok {} {} return $res } test info-33.25 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { try {*}{ {set res [info frame 0]} } on ok {} {} finally {} return $res } test info-33.26 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { while 1 {*}{ {return [info frame 0]} } } test info-33.27 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { try {} finally {*}{ {return [info frame 0]} } } test info-33.28 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { try {} on ok {} {} finally {*}{ {return [info frame 0]} } } test info-33.29 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { try {} on ok {} {*}{ {return [info frame 0]} } } test info-33.30 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { try {} on ok {} {*}{ {return [info frame 0]} } finally {} } test info-33.31 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { binary format {*}{ } [return [info frame 0]] } test info-33.32 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { set format format binary $format {*}{ } [return [info frame 0]] } test info-33.33 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { append x {*}{ } [return [info frame 0]] } test info-33.34 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- namespace eval foo {} proc foo::bar {} { append {*}{ } x([return [info frame 0]]) {*}{ } a } test info-33.35 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo } -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- unset -nocomplain res test info-39.2 {Bug 4b61afd660} -setup { proc probe {} { return [dict get [info frame -1] line] } set body { set cmd probe $cmd } proc demo {} $body } -body { demo } -cleanup { unset -nocomplain body rename demo {} rename probe {} } -result 3 # cleanup catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests return tcl8.6.14/tests/init.test0000644000175000017500000001561114554262142014654 0ustar sergeisergei# Functionality covered: this file contains a collection of tests for the auto # loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.3.4 namespace import -force ::tcltest::* } # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} test init-0.1 {no error on initialization phase (init.tcl)} -setup { interp create child } -body { child eval { list [set v [info exists ::errorInfo]] \ [if {$v} {set ::errorInfo}] \ [set v [info exists ::errorCode]] \ [if {$v} {set ::errorCode}] } } -cleanup { interp delete child } -result {0 {} 0 {}} # Six cases - white box testing test init-1.1 {auto_qualify - absolute cmd - namespace} { auto_qualify ::foo::bar ::blue } ::foo::bar test init-1.2 {auto_qualify - absolute cmd - global} { auto_qualify ::global ::sub } global test init-1.3 {auto_qualify - no colons cmd - global} { auto_qualify nocolons :: } nocolons test init-1.4 {auto_qualify - no colons cmd - namespace} { auto_qualify nocolons ::sub } {::sub::nocolons nocolons} test init-1.5 {auto_qualify - colons in cmd - global} { auto_qualify foo::bar :: } ::foo::bar test init-1.6 {auto_qualify - colons in cmd - namespace} { auto_qualify foo::bar ::sub } {::sub::foo::bar ::foo::bar} # Some additional tests test init-1.7 {auto_qualify - multiples colons 1} { auto_qualify :::foo::::bar ::blue } ::foo::bar test init-1.8 {auto_qualify - multiple colons 2} { auto_qualify :::foo ::bar } foo # We use a child interp and auto_reset and double the tests because there is 2 # places where auto_loading occur (before loading the indexes files and after) set testInterp [interp create] tcltest::loadIntoChildInterpreter $testInterp {*}$argv interp eval $testInterp { namespace import -force ::tcltest::* customMatch pairwise {apply {{mode pair} { if {[llength $pair] != 2} {error "need a pair of values to check"} string $mode [lindex $pair 0] [lindex $pair 1] }}} auto_reset catch {rename parray {}} test init-2.0 {load parray - stage 1} -body { parray } -returnCodes error -cleanup { rename parray {} ;# remove it, for the next test - that should not fail. } -result {wrong # args: should be "parray a ?pattern?"} test init-2.1 {load parray - stage 2} -body { parray } -returnCodes error -result {wrong # args: should be "parray a ?pattern?"} auto_reset catch {rename ::safe::setLogCmd {}} #unset -nocomplain auto_index(::safe::setLogCmd) auto_oldpath test init-2.2 {load ::safe::setLogCmd - stage 1} { ::safe::setLogCmd rename ::safe::setLogCmd {} ;# should not fail } {} test init-2.3 {load ::safe::setLogCmd - stage 2} { ::safe::setLogCmd rename ::safe::setLogCmd {} ;# should not fail } {} auto_reset catch {rename ::safe::setLogCmd {}} test init-2.4 {load safe:::setLogCmd - stage 1} { safe:::setLogCmd ;# intentionally 3 : rename ::safe::setLogCmd {} ;# should not fail } {} test init-2.5 {load safe:::setLogCmd - stage 2} { safe:::setLogCmd ;# intentionally 3 : rename ::safe::setLogCmd {} ;# should not fail } {} auto_reset catch {rename ::safe::setLogCmd {}} test init-2.6 {load setLogCmd from safe:: - stage 1} { namespace eval safe setLogCmd rename ::safe::setLogCmd {} ;# should not fail } {} test init-2.7 {oad setLogCmd from safe:: - stage 2} { namespace eval safe setLogCmd rename ::safe::setLogCmd {} ;# should not fail } {} test init-2.8 {load tcl::HistAdd} -setup { auto_reset catch {rename ::tcl::HistAdd {}} } -body { # 3 ':' on purpose tcl:::HistAdd } -returnCodes error -cleanup { rename ::tcl::HistAdd {} } -result {wrong # args: should be "tcl:::HistAdd event ?exec?"} test init-3.0 {random stuff in the auto_index, should still work} { set auto_index(foo:::bar::blah) { namespace eval foo {namespace eval bar {proc blah {} {return 1}}} } foo:::bar::blah } 1 # Tests that compare the error stack trace generated when autoloading with # that generated when no autoloading is necessary. Ideally they should be the # same. set count 0 foreach arg [subst -nocommands -novariables { c {argument which spans multiple lines} {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack} {argument which spans multiple lines and is long enough to be truncated and " <- includes a false lead in the prune point search and must be longer still to force truncation} {contrived example: rare circumstance where the point at which to prune the error stack cannot be uniquely determined. foo bar foo "} {contrived example: rare circumstance where the point at which to prune the error stack cannot be uniquely determined. foo bar "} {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library} }] { ;# emacs needs -> " test init-4.$count.0 {::errorInfo produced by [unknown]} -setup { auto_reset } -body { catch {parray a b $arg} set first $::errorInfo catch {parray a b $arg} list $first $::errorInfo } -match pairwise -result equal test init-4.$count.1 {::errorInfo produced by [unknown]} -setup { auto_reset } -body { namespace eval junk [list array set $arg [list 1 2 3 4]] trace add variable ::junk::$arg read \ "[list error [subst {Variable \"$arg\" is write-only}]] ;# " catch {parray ::junk::$arg} set first $::errorInfo catch {parray ::junk::$arg} list $first $::errorInfo } -match pairwise -result equal incr count } test init-4.$count {[Bug 46f801ed5a]} -setup { auto_reset array set auto_index {demo {proc demo {} {tailcall error foo}}} } -body { demo } -cleanup { array unset auto_index demo rename demo {} } -returnCodes error -result foo test init-5.0 {return options passed through ::unknown} -setup { catch {rename xxx {}} set ::auto_index(::xxx) {proc ::xxx {} { return -code error -level 2 xxx }} } -body { set code [catch {::xxx} foo bar] set code2 [catch {::xxx} foo2 bar2] list $code $foo $bar $code2 $foo2 $bar2 } -cleanup { unset ::auto_index(::xxx) } -match glob -result {2 xxx {-errorcode NONE -code 1 -level 1} 2 xxx {-code 1 -level 1 -errorcode NONE}} cleanupTests } ;# End of [interp eval $testInterp] # cleanup interp delete $testInterp ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/interp.test0000644000175000017500000031365114554262142015217 0ustar sergeisergei# This file tests the multiple interpreter facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.1 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testinterpdelete [llength [info commands testinterpdelete]] set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload} foreach i [interp children] { interp delete $i } # Part 0: Check out options for interp command test interp-1.1 {options for interp command} -returnCodes error -body { interp } -result {wrong # args: should be "interp cmd ?arg ...?"} test interp-1.2 {options for interp command} -returnCodes error -body { interp frobox } -result {bad option "frobox": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer} test interp-1.3 {options for interp command} { interp delete } "" test interp-1.4 {options for interp command} -returnCodes error -body { interp delete foo bar } -result {could not find interpreter "foo"} test interp-1.5 {options for interp command} -returnCodes error -body { interp exists foo bar } -result {wrong # args: should be "interp exists ?path?"} # # test interp-0.6 was removed # test interp-1.6 {options for interp command} -returnCodes error -body { interp children foo bar zop } -result {wrong # args: should be "interp children ?path?"} test interp-1.7 {options for interp command} -returnCodes error -body { interp hello } -result {bad option "hello": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer} test interp-1.8 {options for interp command} -returnCodes error -body { interp -froboz } -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer} test interp-1.9 {options for interp command} -returnCodes error -body { interp -froboz -safe } -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer} test interp-1.10 {options for interp command} -returnCodes error -body { interp target } -result {wrong # args: should be "interp target path alias"} # Part 1: Basic interpreter creation tests: test interp-2.1 {basic interpreter creation} { interp create a } a test interp-2.2 {basic interpreter creation} { catch {interp create} } 0 test interp-2.3 {basic interpreter creation} { catch {interp create -safe} } 0 test interp-2.4 {basic interpreter creation} -setup { catch {interp create a} } -returnCodes error -body { interp create a } -result {interpreter named "a" already exists, cannot create} test interp-2.5 {basic interpreter creation} { interp create b -safe } b test interp-2.6 {basic interpreter creation} { interp create d -safe } d test interp-2.7 {basic interpreter creation} { list [catch {interp create -froboz} msg] $msg } {1 {bad option "-froboz": must be -safe or --}} test interp-2.8 {basic interpreter creation} { interp create -- -froboz } -froboz test interp-2.9 {basic interpreter creation} { interp create -safe -- -froboz1 } -froboz1 test interp-2.10 {basic interpreter creation} -setup { catch {interp create a} } -body { interp create {a x1} interp create {a x2} interp create {a x3} -safe } -result {a x3} test interp-2.11 {anonymous interps vs existing procs} { set x [interp create] regexp "interp(\[0-9]+)" $x dummy thenum interp delete $x proc interp$thenum {} {} set x [interp create] regexp "interp(\[0-9]+)" $x dummy anothernum expr {$anothernum > $thenum} } 1 test interp-2.12 {anonymous interps vs existing procs} { set x [interp create -safe] regexp "interp(\[0-9]+)" $x dummy thenum interp delete $x proc interp$thenum {} {} set x [interp create -safe] regexp "interp(\[0-9]+)" $x dummy anothernum expr {$anothernum - $thenum} } 1 test interp-2.13 {correct default when no $path arg is given} -body { interp create -- } -match regexp -result {interp[0-9]+} foreach i [interp children] { interp delete $i } # Part 2: Testing "interp children" and "interp exists" test interp-3.1 {testing interp exists and interp children} { interp children } "" test interp-3.2 {testing interp exists and interp children} { interp create a interp exists a } 1 test interp-3.3 {testing interp exists and interp children} { interp exists nonexistent } 0 test interp-3.4 {testing interp exists and interp children} -body { interp children a b c } -returnCodes error -result {wrong # args: should be "interp children ?path?"} test interp-3.5 {testing interp exists and interp children} -body { interp exists a b c } -returnCodes error -result {wrong # args: should be "interp exists ?path?"} test interp-3.6 {testing interp exists and interp children} { interp exists } 1 test interp-3.7 {testing interp exists and interp children} -setup { catch {interp create a} } -body { interp children } -result a test interp-3.8 {testing interp exists and interp children} -body { interp children a b c } -returnCodes error -result {wrong # args: should be "interp children ?path?"} test interp-3.9 {testing interp exists and interp children} -setup { catch {interp create a} } -body { interp create {a a2} -safe expr {"a2" in [interp children a]} } -result 1 test interp-3.10 {testing interp exists and interp children} -setup { catch {interp create a} catch {interp create {a a2}} } -body { interp exists {a a2} } -result 1 # Part 3: Testing "interp delete" test interp-3.11 {testing interp delete} { interp delete } "" test interp-4.1 {testing interp delete} { catch {interp create a} interp delete a } "" test interp-4.2 {testing interp delete} -returnCodes error -body { interp delete nonexistent } -result {could not find interpreter "nonexistent"} test interp-4.3 {testing interp delete} -returnCodes error -body { interp delete x y z } -result {could not find interpreter "x"} test interp-4.4 {testing interp delete} { interp delete } "" test interp-4.5 {testing interp delete} { interp create a interp create {a x1} interp delete {a x1} expr {"x1" in [interp children a]} } 0 test interp-4.6 {testing interp delete} { interp create c1 interp create c2 interp create c3 interp delete c1 c2 c3 } "" test interp-4.7 {testing interp delete} -returnCodes error -body { interp create c1 interp create c2 interp delete c1 c2 c3 } -result {could not find interpreter "c3"} test interp-4.8 {testing interp delete} -returnCodes error -body { interp delete {} } -result {cannot delete the current interpreter} foreach i [interp children] { interp delete $i } # Part 4: Consistency checking - all nondeleted interpreters should be # there: test interp-5.1 {testing consistency} { interp children } "" test interp-5.2 {testing consistency} { interp exists a } 0 test interp-5.3 {testing consistency} { interp exists nonexistent } 0 # Recreate interpreter "a" interp create a # Part 5: Testing eval in interpreter object command and with interp command test interp-6.1 {testing eval} { a eval expr {{3 + 5}} } 8 test interp-6.2 {testing eval} -returnCodes error -body { a eval foo } -result {invalid command name "foo"} test interp-6.3 {testing eval} { a eval {proc foo {} {expr {3 + 5}}} a eval foo } 8 catch {a eval {proc foo {} {expr {3 + 5}}}} test interp-6.4 {testing eval} { interp eval a foo } 8 test interp-6.5 {testing eval} { interp create {a x2} interp eval {a x2} {proc frob {} {expr {4 * 9}}} interp eval {a x2} frob } 36 catch {interp create {a x2}} test interp-6.6 {testing eval} -returnCodes error -body { interp eval {a x2} foo } -result {invalid command name "foo"} # UTILITY PROCEDURE RUNNING IN PARENT INTERPRETER: proc in_parent {args} { return [list seen in parent: $args] } # Part 6: Testing basic alias creation test interp-7.1 {testing basic alias creation} { a alias foo in_parent } foo catch {a alias foo in_parent} test interp-7.2 {testing basic alias creation} { a alias bar in_parent a1 a2 a3 } bar catch {a alias bar in_parent a1 a2 a3} # Test 6.3 has been deleted. test interp-7.3 {testing basic alias creation} { a alias foo } in_parent test interp-7.4 {testing basic alias creation} { a alias bar } {in_parent a1 a2 a3} test interp-7.5 {testing basic alias creation} { lsort [a aliases] } {bar foo} test interp-7.6 {testing basic aliases arg checking} -returnCodes error -body { a aliases too many args } -result {wrong # args: should be "a aliases"} # Part 7: testing basic alias invocation test interp-8.1 {testing basic alias invocation} { catch {interp create a} a alias foo in_parent a eval foo s1 s2 s3 } {seen in parent: {s1 s2 s3}} test interp-8.2 {testing basic alias invocation} { catch {interp create a} a alias bar in_parent a1 a2 a3 a eval bar s1 s2 s3 } {seen in parent: {a1 a2 a3 s1 s2 s3}} test interp-8.3 {testing basic alias invocation} -returnCodes error -body { catch {interp create a} a alias } -result {wrong # args: should be "a alias aliasName ?targetName? ?arg ...?"} # Part 8: Testing aliases for non-existent or hidden targets test interp-9.1 {testing aliases for non-existent targets} { catch {interp create a} a alias zop nonexistent-command-in-parent list [catch {a eval zop} msg] $msg } {1 {invalid command name "nonexistent-command-in-parent"}} test interp-9.2 {testing aliases for non-existent targets} { catch {interp create a} a alias zop nonexistent-command-in-parent proc nonexistent-command-in-parent {} {return i_exist!} a eval zop } i_exist! test interp-9.3 {testing aliases for hidden commands} { catch {interp create a} a eval {proc p {} {return ENTER_A}} interp alias {} p a p set res {} lappend res [list [catch p msg] $msg] interp hide a p lappend res [list [catch p msg] $msg] rename p {} interp delete a set res } {{0 ENTER_A} {1 {invalid command name "p"}}} test interp-9.4 {testing aliases and namespace commands} { proc p {} {return GLOBAL} namespace eval tst { proc p {} {return NAMESPACE} } interp alias {} a {} p set res [a] lappend res [namespace eval tst a] rename p {} rename a {} namespace delete tst set res } {GLOBAL GLOBAL} if {[info command nonexistent-command-in-parent] != ""} { rename nonexistent-command-in-parent {} } # Part 9: Aliasing between interpreters test interp-10.1 {testing aliasing between interpreters} { catch {interp delete a} catch {interp delete b} interp create a interp create b interp alias a a_alias b b_alias 1 2 3 } a_alias test interp-10.2 {testing aliasing between interpreters} { catch {interp delete a} catch {interp delete b} interp create a interp create b b eval {proc b_alias {args} {return [list got $args]}} interp alias a a_alias b b_alias 1 2 3 a eval a_alias a b c } {got {1 2 3 a b c}} test interp-10.3 {testing aliasing between interpreters} { catch {interp delete a} catch {interp delete b} interp create a interp create b interp alias a a_alias b b_alias 1 2 3 list [catch {a eval a_alias a b c} msg] $msg } {1 {invalid command name "b_alias"}} test interp-10.4 {testing aliasing between interpreters} { catch {interp delete a} interp create a a alias a_alias puts a aliases } a_alias test interp-10.5 {testing aliasing between interpreters} { catch {interp delete a} catch {interp delete b} interp create a interp create b a alias a_alias puts interp alias a a_del b b_del interp delete b a aliases } a_alias test interp-10.6 {testing aliasing between interpreters} { catch {interp delete a} catch {interp delete b} interp create a interp create b interp alias a a_command b b_command a1 a2 a3 b alias b_command in_parent b1 b2 b3 a eval a_command m1 m2 m3 } {seen in parent: {b1 b2 b3 a1 a2 a3 m1 m2 m3}} test interp-10.7 {testing aliases between interpreters} { catch {interp delete a} interp create a interp alias "" foo a zoppo a eval {proc zoppo {x} {list $x $x $x}} set x [foo 33] a eval {rename zoppo {}} interp alias "" foo a {} return $x } {33 33 33} # Part 10: Testing "interp target" test interp-11.1 {testing interp target} { list [catch {interp target} msg] $msg } {1 {wrong # args: should be "interp target path alias"}} test interp-11.2 {testing interp target} { list [catch {interp target nosuchinterpreter foo} msg] $msg } {1 {could not find interpreter "nosuchinterpreter"}} test interp-11.3 {testing interp target} { catch {interp delete a} interp create a a alias boo no_command interp target a boo } "" test interp-11.4 {testing interp target} { catch {interp delete x1} interp create x1 x1 eval interp create x2 x1 eval x2 eval interp create x3 catch {interp delete y1} interp create y1 y1 eval interp create y2 y1 eval y2 eval interp create y3 interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand interp target {x1 x2 x3} xcommand } {y1 y2 y3} test interp-11.5 {testing interp target} { catch {interp delete x1} interp create x1 interp create {x1 x2} interp create {x1 x2 x3} catch {interp delete y1} interp create y1 interp create {y1 y2} interp create {y1 y2 y3} interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand list [catch {x1 eval {interp target {x2 x3} xcommand}} msg] $msg } {1 {target interpreter for alias "xcommand" in path "x2 x3" is not my descendant}} test interp-11.6 {testing interp target} { foreach a [interp aliases] { rename $a {} } list [catch {interp target {} foo} msg] $msg } {1 {alias "foo" in path "" not found}} test interp-11.7 {testing interp target} { catch {interp delete a} interp create a list [catch {interp target a foo} msg] $msg } {1 {alias "foo" in path "a" not found}} # Part 11: testing "interp issafe" test interp-12.1 {testing interp issafe} { interp issafe } 0 test interp-12.2 {testing interp issafe} { catch {interp delete a} interp create a interp issafe a } 0 test interp-12.3 {testing interp issafe} { catch {interp delete a} interp create a interp create {a x3} -safe interp issafe {a x3} } 1 test interp-12.4 {testing interp issafe} { catch {interp delete a} interp create a interp create {a x3} -safe interp create {a x3 foo} interp issafe {a x3 foo} } 1 # Part 12: testing interpreter object command "issafe" sub-command test interp-13.1 {testing foo issafe} { catch {interp delete a} interp create a a issafe } 0 test interp-13.2 {testing foo issafe} { catch {interp delete a} interp create a interp create {a x3} -safe a eval x3 issafe } 1 test interp-13.3 {testing foo issafe} { catch {interp delete a} interp create a interp create {a x3} -safe interp create {a x3 foo} a eval x3 eval foo issafe } 1 test interp-13.4 {testing issafe arg checking} { catch {interp create a} list [catch {a issafe too many args} msg] $msg } {1 {wrong # args: should be "a issafe"}} # part 14: testing interp aliases test interp-14.1 {testing interp aliases} -setup { interp create abc } -body { interp eval abc {interp aliases} } -cleanup { interp delete abc } -result "" test interp-14.2 {testing interp aliases} { catch {interp delete a} interp create a a alias a1 puts a alias a2 puts a alias a3 puts lsort [interp aliases a] } {a1 a2 a3} test interp-14.3 {testing interp aliases} { catch {interp delete a} interp create a interp create {a x3} interp alias {a x3} froboz "" puts interp aliases {a x3} } froboz test interp-14.4 {testing interp alias - alias over parent} { # SF Bug 641195 catch {interp delete a} interp create a list [catch {interp alias "" a a eval} msg] $msg [info commands a] } {1 {cannot define or rename alias "a": interpreter deleted} {}} test interp-14.5 {testing interp-alias: wrong # args} -body { proc setx x {set x} interp alias {} a {} setx catch {a 1 2} set ::errorInfo } -cleanup { rename setx {} rename a {} } -result {wrong # args: should be "a x" while executing "a 1 2"} test interp-14.6 {testing interp-alias: wrong # args} -setup { proc setx x {set x} catch {interp delete a} interp create a } -body { interp alias a a {} setx catch {a eval a 1 2} set ::errorInfo } -cleanup { rename setx {} interp delete a } -result {wrong # args: should be "a x" invoked from within "a 1 2" invoked from within "a eval a 1 2"} test interp-14.7 {testing interp-alias: wrong # args} -setup { proc setx x {set x} catch {interp delete a} interp create a } -body { interp alias a a {} setx a eval { catch {a 1 2} set ::errorInfo } } -cleanup { rename setx {} interp delete a } -result {wrong # args: should be "a x" invoked from within "a 1 2"} test interp-14.8 {testing interp-alias: error messages} -body { proc setx x {return -code error x} interp alias {} a {} setx catch {a 1} set ::errorInfo } -cleanup { rename setx {} rename a {} } -result {x while executing "a 1"} test interp-14.9 {testing interp-alias: error messages} -setup { proc setx x {return -code error x} catch {interp delete a} interp create a } -body { interp alias a a {} setx catch {a eval a 1} set ::errorInfo } -cleanup { rename setx {} interp delete a } -result {x invoked from within "a 1" invoked from within "a eval a 1"} test interp-14.10 {testing interp-alias: error messages} -setup { proc setx x {return -code error x} catch {interp delete a} interp create a } -body { interp alias a a {} setx a eval { catch {a 1} set ::errorInfo } } -cleanup { rename setx {} interp delete a } -result {x invoked from within "a 1"} test interp-14.11 {{interp alias} {target named the empty string} {bug 2bf56185}} -setup { set interp [interp create [info cmdcount]] interp eval $interp { proc {} args {return $args} } } -body { interp alias {} p1 $interp {} p1 one two three } -cleanup { interp delete $interp } -result {one two three} # part 15: testing file sharing test interp-15.1 {testing file sharing} { catch {interp delete z} interp create z z eval close stdout list [catch {z eval puts hello} msg] $msg } {1 {can not find channel named "stdout"}} test interp-15.2 {testing file sharing} -body { catch {interp delete z} interp create z set f [open [makeFile {} file-15.2] w] interp share "" $f z z eval puts $f hello z eval close $f close $f } -cleanup { removeFile file-15.2 } -result "" test interp-15.3 {testing file sharing} { catch {interp delete xsafe} interp create xsafe -safe list [catch {xsafe eval puts hello} msg] $msg } {1 {can not find channel named "stdout"}} test interp-15.4 {testing file sharing} -body { catch {interp delete xsafe} interp create xsafe -safe set f [open [makeFile {} file-15.4] w] interp share "" $f xsafe xsafe eval puts $f hello xsafe eval close $f close $f } -cleanup { removeFile file-15.4 } -result "" test interp-15.5 {testing file sharing} { catch {interp delete xsafe} interp create xsafe -safe interp share "" stdout xsafe list [catch {xsafe eval gets stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test interp-15.6 {testing file sharing} -body { catch {interp delete xsafe} interp create xsafe -safe set f [open [makeFile {} file-15.6] w] interp share "" $f xsafe set x [list [catch [list xsafe eval gets $f] msg] $msg] xsafe eval close $f close $f string compare [string tolower $x] \ [list 1 [format "channel \"%s\" wasn't opened for reading" $f]] } -cleanup { removeFile file-15.6 } -result 0 test interp-15.7 {testing file transferring} -body { catch {interp delete xsafe} interp create xsafe -safe set f [open [makeFile {} file-15.7] w] interp transfer "" $f xsafe xsafe eval puts $f hello xsafe eval close $f } -cleanup { removeFile file-15.7 } -result "" test interp-15.8 {testing file transferring} -body { catch {interp delete xsafe} interp create xsafe -safe set f [open [makeFile {} file-15.8] w] interp transfer "" $f xsafe xsafe eval close $f set x [list [catch {close $f} msg] $msg] string compare [string tolower $x] \ [list 1 [format "can not find channel named \"%s\"" $f]] } -cleanup { removeFile file-15.8 } -result 0 # # Torture tests for interpreter deletion order # proc kill {} {interp delete xxx} test interp-16.0 {testing deletion order} { catch {interp delete xxx} interp create xxx xxx alias kill kill list [catch {xxx eval kill} msg] $msg } {0 {}} test interp-16.1 {testing deletion order} { catch {interp delete xxx} interp create xxx interp create {xxx yyy} interp alias {xxx yyy} kill "" kill list [catch {interp eval {xxx yyy} kill} msg] $msg } {0 {}} test interp-16.2 {testing deletion order} { catch {interp delete xxx} interp create xxx interp create {xxx yyy} interp alias {xxx yyy} kill "" kill list [catch {xxx eval yyy eval kill} msg] $msg } {0 {}} test interp-16.3 {testing deletion order} { catch {interp delete xxx} interp create xxx interp create ddd xxx alias kill kill interp alias ddd kill xxx kill set x [ddd eval kill] interp delete ddd set x } "" test interp-16.4 {testing deletion order} { catch {interp delete xxx} interp create xxx interp create {xxx yyy} interp alias {xxx yyy} kill "" kill interp create ddd interp alias ddd kill {xxx yyy} kill set x [ddd eval kill] interp delete ddd set x } "" test interp-16.5 {testing deletion order, bgerror} { catch {interp delete xxx} interp create xxx xxx eval {proc bgerror {args} {exit}} xxx alias exit kill xxx proc kill {i} {interp delete $i} xxx eval after 100 expr {a + b} after 200 update interp exists xxx } 0 # # Alias loop prevention testing. # test interp-17.1 {alias loop prevention} { list [catch {interp alias {} a {} a} msg] $msg } {1 {cannot define or rename alias "a": would create a loop}} test interp-17.2 {alias loop prevention} { catch {interp delete x} interp create x x alias a loop list [catch {interp alias {} loop x a} msg] $msg } {1 {cannot define or rename alias "loop": would create a loop}} test interp-17.3 {alias loop prevention} { catch {interp delete x} interp create x interp alias x a x b list [catch {interp alias x b x a} msg] $msg } {1 {cannot define or rename alias "b": would create a loop}} test interp-17.4 {alias loop prevention} { catch {interp delete x} interp create x interp alias x b x a list [catch {x eval rename b a} msg] $msg } {1 {cannot define or rename alias "a": would create a loop}} test interp-17.5 {alias loop prevention} { catch {interp delete x} interp create x x alias z l1 interp alias {} l2 x z list [catch {rename l2 l1} msg] $msg } {1 {cannot define or rename alias "l1": would create a loop}} test interp-17.6 {alias loop prevention} { catch {interp delete x} interp create x interp alias x a x b x eval rename a c list [catch {x eval rename c b} msg] $msg } {1 {cannot define or rename alias "b": would create a loop}} # # Test robustness of Tcl_DeleteInterp when applied to a child interpreter. # If there are bugs in the implementation these tests are likely to expose # the bugs as a core dump. # test interp-18.1 {testing Tcl_DeleteInterp vs children} testinterpdelete { list [catch {testinterpdelete} msg] $msg } {1 {wrong # args: should be "testinterpdelete path"}} test interp-18.2 {testing Tcl_DeleteInterp vs children} testinterpdelete { catch {interp delete a} interp create a testinterpdelete a } "" test interp-18.3 {testing Tcl_DeleteInterp vs children} testinterpdelete { catch {interp delete a} interp create a interp create {a b} testinterpdelete {a b} } "" test interp-18.4 {testing Tcl_DeleteInterp vs children} testinterpdelete { catch {interp delete a} interp create a interp create {a b} testinterpdelete a } "" test interp-18.5 {testing Tcl_DeleteInterp vs children} testinterpdelete { catch {interp delete a} interp create a interp create {a b} interp alias {a b} dodel {} dodel proc dodel {x} {testinterpdelete $x} list [catch {interp eval {a b} {dodel {a b}}} msg] $msg } {0 {}} test interp-18.6 {testing Tcl_DeleteInterp vs children} testinterpdelete { catch {interp delete a} interp create a interp create {a b} interp alias {a b} dodel {} dodel proc dodel {x} {testinterpdelete $x} list [catch {interp eval {a b} {dodel a}} msg] $msg } {0 {}} test interp-18.7 {eval in deleted interp} { catch {interp delete a} interp create a a eval { proc dodel {} { delme dosomething else } proc dosomething args { puts "I should not have been called!!" } } a alias delme dela proc dela {} {interp delete a} list [catch {a eval dodel} msg] $msg } {1 {attempt to call eval in deleted interpreter}} test interp-18.8 {eval in deleted interp} { catch {interp delete a} interp create a a eval { interp create b b eval { proc dodel {} { dela } } proc foo {} { b eval dela dosomething else } proc dosomething args { puts "I should not have been called!!" } } interp alias {a b} dela {} dela proc dela {} {interp delete a} list [catch {a eval foo} msg] $msg } {1 {attempt to call eval in deleted interpreter}} test interp-18.9 {eval in deleted interp, bug 495830} { interp create tst interp alias tst suicide {} interp delete tst list [catch {tst eval {suicide; set a 5}} msg] $msg } {1 {attempt to call eval in deleted interpreter}} test interp-18.10 {eval in deleted interp, bug 495830} { interp create tst interp alias tst suicide {} interp delete tst list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg } {1 {attempt to call eval in deleted interpreter}} # Test alias deletion test interp-19.1 {alias deletion} { catch {interp delete a} interp create a interp alias a foo a bar set s [interp alias a foo {}] interp delete a set s } {} test interp-19.2 {alias deletion} { catch {interp delete a} interp create a catch {interp alias a foo {}} msg interp delete a set msg } {alias "foo" not found} test interp-19.3 {alias deletion} { catch {interp delete a} interp create a interp alias a foo a bar interp eval a {rename foo zop} interp alias a foo a zop catch {interp eval a foo} msg interp delete a set msg } {invalid command name "bar"} test interp-19.4 {alias deletion} { catch {interp delete a} interp create a interp alias a foo a bar interp eval a {rename foo zop} catch {interp eval a foo} msg interp delete a set msg } {invalid command name "foo"} test interp-19.5 {alias deletion} { catch {interp delete a} interp create a interp eval a {proc bar {} {return 1}} interp alias a foo a bar interp eval a {rename foo zop} catch {interp eval a zop} msg interp delete a set msg } 1 test interp-19.6 {alias deletion} { catch {interp delete a} interp create a interp alias a foo a bar interp eval a {rename foo zop} interp alias a foo a zop set s [interp aliases a] interp delete a set s } {::foo foo} test interp-19.7 {alias deletion, renaming} { catch {interp delete a} interp create a interp alias a foo a bar interp eval a rename foo blotz interp alias a foo {} set s [interp aliases a] interp delete a set s } {} test interp-19.8 {alias deletion, renaming} { catch {interp delete a} interp create a interp alias a foo a bar interp eval a rename foo blotz set l "" lappend l [interp aliases a] interp alias a foo {} lappend l [interp aliases a] interp delete a set l } {foo {}} test interp-19.9 {alias deletion, renaming} { catch {interp delete a} interp create a interp alias a foo a bar interp eval a rename foo blotz interp eval a {proc foo {} {expr {34 * 34}}} interp alias a foo {} set l [interp eval a foo] interp delete a set l } 1156 test interp-20.1 {interp hide, interp expose and interp invokehidden} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} $a eval {proc foo {} {}} $a hide foo catch {$a eval foo something} msg interp delete $a set msg } {invalid command name "foo"} test interp-20.2 {interp hide, interp expose and interp invokehidden} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} $a hide list set l "" lappend l [catch {$a eval {list 1 2 3}} msg] $msg $a expose list lappend l [catch {$a eval {list 1 2 3}} msg] $msg interp delete $a set l } {1 {invalid command name "list"} 0 {1 2 3}} test interp-20.3 {interp hide, interp expose and interp invokehidden} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} $a hide list set l "" lappend l [catch { $a eval {list 1 2 3} } msg] $msg lappend l [catch { $a invokehidden list 1 2 3 } msg] $msg $a expose list lappend l [catch { $a eval {list 1 2 3} } msg] $msg interp delete $a set l } {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}} test interp-20.4 {interp hide, interp expose and interp invokehidden -- passing {}} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} $a hide list set l "" lappend l [catch { $a eval {list 1 2 3} } msg] $msg lappend l [catch { $a invokehidden list {"" 1 2 3} } msg] $msg $a expose list lappend l [catch { $a eval {list 1 2 3} } msg] $msg interp delete $a set l } {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}} test interp-20.5 {interp hide, interp expose and interp invokehidden -- passing {}} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} $a hide list set l "" lappend l [catch { $a eval {list 1 2 3} } msg] $msg lappend l [catch { $a invokehidden list {{} 1 2 3} } msg] $msg $a expose list lappend l [catch { $a eval {list 1 2 3} } msg] $msg interp delete $a set l } {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}} test interp-20.6 {interp invokehidden -- eval args} { set a [interp create] $a hide list set l "" set z 45 lappend l [catch { $a invokehidden list $z 1 2 3 } msg] $msg $a expose list lappend l [catch { $a eval list $z 1 2 3 } msg] $msg interp delete $a set l } {0 {45 1 2 3} 0 {45 1 2 3}} test interp-20.7 {interp invokehidden vs variable eval} { set a [interp create] $a hide list set z 45 set l [list [catch {$a invokehidden list {$z a b c}} msg] $msg] interp delete $a set l } {0 {{$z a b c}}} test interp-20.8 {interp invokehidden vs variable eval} { set a [interp create] $a hide list $a eval set z 89 set z 45 set l [list [catch {$a invokehidden list {$z a b c}} msg] $msg] interp delete $a set l } {0 {{$z a b c}}} test interp-20.9 {interp invokehidden vs variable eval} { set a [interp create] $a hide list $a eval set z 89 set z 45 set l "" lappend l [catch {$a invokehidden list $z {$z a b c}} msg] $msg interp delete $a set l } {0 {45 {$z a b c}}} test interp-20.10 {interp hide, interp expose and interp invokehidden} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} $a eval {proc foo {} {}} interp hide $a foo catch {interp eval $a foo something} msg interp delete $a set msg } {invalid command name "foo"} test interp-20.11 {interp hide, interp expose and interp invokehidden} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} interp hide $a list set l "" lappend l [catch {interp eval $a {list 1 2 3}} msg] $msg interp expose $a list lappend l [catch {interp eval $a {list 1 2 3}} msg] $msg interp delete $a set l } {1 {invalid command name "list"} 0 {1 2 3}} test interp-20.12 {interp hide, interp expose and interp invokehidden} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} interp hide $a list set l "" lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg lappend l [catch {interp invokehidden $a list 1 2 3} msg] $msg interp expose $a list lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg interp delete $a set l } {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}} test interp-20.13 {interp hide, interp expose, interp invokehidden -- passing {}} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} interp hide $a list set l "" lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg lappend l [catch {interp invokehidden $a list {"" 1 2 3}} msg] $msg interp expose $a list lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg interp delete $a set l } {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}} test interp-20.14 {interp hide, interp expose, interp invokehidden -- passing {}} { set a [interp create] $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} interp hide $a list set l "" lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg lappend l [catch {interp invokehidden $a list {{} 1 2 3}} msg] $msg interp expose $a list lappend l [catch {$a eval {list 1 2 3} } msg] $msg interp delete $a set l } {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}} test interp-20.15 {interp invokehidden -- eval args} { catch {interp delete a} interp create a interp hide a list set l "" set z 45 lappend l [catch {interp invokehidden a list $z 1 2 3} msg] lappend l $msg a expose list lappend l [catch {interp eval a list $z 1 2 3} msg] lappend l $msg interp delete a set l } {0 {45 1 2 3} 0 {45 1 2 3}} test interp-20.16 {interp invokehidden vs variable eval} { catch {interp delete a} interp create a interp hide a list set z 45 set l "" lappend l [catch {interp invokehidden a list {$z a b c}} msg] lappend l $msg interp delete a set l } {0 {{$z a b c}}} test interp-20.17 {interp invokehidden vs variable eval} { catch {interp delete a} interp create a interp hide a list a eval set z 89 set z 45 set l "" lappend l [catch {interp invokehidden a list {$z a b c}} msg] lappend l $msg interp delete a set l } {0 {{$z a b c}}} test interp-20.18 {interp invokehidden vs variable eval} { catch {interp delete a} interp create a interp hide a list a eval set z 89 set z 45 set l "" lappend l [catch {interp invokehidden a list $z {$z a b c}} msg] lappend l $msg interp delete a set l } {0 {45 {$z a b c}}} test interp-20.19 {interp invokehidden vs nested commands} { catch {interp delete a} interp create a a hide list set l [a invokehidden list {[list x y z] f g h} z] interp delete a set l } {{[list x y z] f g h} z} test interp-20.20 {interp invokehidden vs nested commands} { catch {interp delete a} interp create a a hide list set l [interp invokehidden a list {[list x y z] f g h} z] interp delete a set l } {{[list x y z] f g h} z} test interp-20.21 {interp hide vs safety} { catch {interp delete a} interp create a -safe set l "" lappend l [catch {a hide list} msg] lappend l $msg interp delete a set l } {0 {}} test interp-20.22 {interp hide vs safety} { catch {interp delete a} interp create a -safe set l "" lappend l [catch {interp hide a list} msg] lappend l $msg interp delete a set l } {0 {}} test interp-20.23 {interp hide vs safety} { catch {interp delete a} interp create a -safe set l "" lappend l [catch {a eval {interp hide {} list}} msg] lappend l $msg interp delete a set l } {1 {permission denied: safe interpreter cannot hide commands}} test interp-20.24 {interp hide vs safety} { catch {interp delete a} interp create a -safe interp create {a b} set l "" lappend l [catch {a eval {interp hide b list}} msg] lappend l $msg interp delete a set l } {1 {permission denied: safe interpreter cannot hide commands}} test interp-20.25 {interp hide vs safety} { catch {interp delete a} interp create a -safe interp create {a b} set l "" lappend l [catch {interp hide {a b} list} msg] lappend l $msg interp delete a set l } {0 {}} test interp-20.26 {interp expoose vs safety} { catch {interp delete a} interp create a -safe set l "" lappend l [catch {a hide list} msg] lappend l $msg lappend l [catch {a expose list} msg] lappend l $msg interp delete a set l } {0 {} 0 {}} test interp-20.27 {interp expose vs safety} { catch {interp delete a} interp create a -safe set l "" lappend l [catch {interp hide a list} msg] lappend l $msg lappend l [catch {interp expose a list} msg] lappend l $msg interp delete a set l } {0 {} 0 {}} test interp-20.28 {interp expose vs safety} { catch {interp delete a} interp create a -safe set l "" lappend l [catch {a hide list} msg] lappend l $msg lappend l [catch {a eval {interp expose {} list}} msg] lappend l $msg interp delete a set l } {0 {} 1 {permission denied: safe interpreter cannot expose commands}} test interp-20.29 {interp expose vs safety} { catch {interp delete a} interp create a -safe set l "" lappend l [catch {interp hide a list} msg] lappend l $msg lappend l [catch {a eval {interp expose {} list}} msg] lappend l $msg interp delete a set l } {0 {} 1 {permission denied: safe interpreter cannot expose commands}} test interp-20.30 {interp expose vs safety} { catch {interp delete a} interp create a -safe interp create {a b} set l "" lappend l [catch {interp hide {a b} list} msg] lappend l $msg lappend l [catch {a eval {interp expose b list}} msg] lappend l $msg interp delete a set l } {0 {} 1 {permission denied: safe interpreter cannot expose commands}} test interp-20.31 {interp expose vs safety} { catch {interp delete a} interp create a -safe interp create {a b} set l "" lappend l [catch {interp hide {a b} list} msg] lappend l $msg lappend l [catch {interp expose {a b} list} msg] lappend l $msg interp delete a set l } {0 {} 0 {}} test interp-20.32 {interp invokehidden vs safety} { catch {interp delete a} interp create a -safe interp hide a list set l "" lappend l [catch {a eval {interp invokehidden {} list a b c}} msg] lappend l $msg interp delete a set l } {1 {not allowed to invoke hidden commands from safe interpreter}} test interp-20.33 {interp invokehidden vs safety} { catch {interp delete a} interp create a -safe interp hide a list set l "" lappend l [catch {a eval {interp invokehidden {} list a b c}} msg] lappend l $msg lappend l [catch {a invokehidden list a b c} msg] lappend l $msg interp delete a set l } {1 {not allowed to invoke hidden commands from safe interpreter}\ 0 {a b c}} test interp-20.34 {interp invokehidden vs safety} { catch {interp delete a} interp create a -safe interp create {a b} interp hide {a b} list set l "" lappend l [catch {a eval {interp invokehidden b list a b c}} msg] lappend l $msg lappend l [catch {interp invokehidden {a b} list a b c} msg] lappend l $msg interp delete a set l } {1 {not allowed to invoke hidden commands from safe interpreter}\ 0 {a b c}} test interp-20.35 {invokehidden at local level} { catch {interp delete a} interp create a a eval { proc p1 {} { set z 90 a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a h1 } set r [interp eval a p1] interp delete a set r } 91 test interp-20.36 {invokehidden at local level} { catch {interp delete a} interp create a a eval { set z 90 proc p1 {} { global z a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a h1 } set r [interp eval a p1] interp delete a set r } 91 test interp-20.37 {invokehidden at local level} { catch {interp delete a} interp create a a eval { proc p1 {} { a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a h1 } set r [interp eval a p1] interp delete a set r } 91 test interp-20.38 {invokehidden at global level} { catch {interp delete a} interp create a a eval { proc p1 {} { a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a -global h1 } set r [catch {interp eval a p1} msg] interp delete a list $r $msg } {1 {can't read "z": no such variable}} test interp-20.39 {invokehidden at global level} { catch {interp delete a} interp create a a eval { proc p1 {} { global z a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a -global h1 } set r [catch {interp eval a p1} msg] interp delete a list $r $msg } {0 91} test interp-20.40 {safe, invokehidden at local level} { catch {interp delete a} interp create a -safe a eval { proc p1 {} { set z 90 a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a h1 } set r [interp eval a p1] interp delete a set r } 91 test interp-20.41 {safe, invokehidden at local level} { catch {interp delete a} interp create a -safe a eval { set z 90 proc p1 {} { global z a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a h1 } set r [interp eval a p1] interp delete a set r } 91 test interp-20.42 {safe, invokehidden at local level} { catch {interp delete a} interp create a -safe a eval { proc p1 {} { a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a h1 } set r [interp eval a p1] interp delete a set r } 91 test interp-20.43 {invokehidden at global level} { catch {interp delete a} interp create a a eval { proc p1 {} { a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a -global h1 } set r [catch {interp eval a p1} msg] interp delete a list $r $msg } {1 {can't read "z": no such variable}} test interp-20.44 {invokehidden at global level} { catch {interp delete a} interp create a a eval { proc p1 {} { global z a1 set z } proc h1 {} { upvar z z set z 91 } } a hide h1 a alias a1 a1 proc a1 {} { interp invokehidden a -global h1 } set r [catch {interp eval a p1} msg] interp delete a list $r $msg } {0 91} test interp-20.45 {interp hide vs namespaces} { catch {interp delete a} interp create a a eval { namespace eval foo {} proc foo::x {} {} } set l [list [catch {interp hide a foo::x} msg] $msg] interp delete a set l } {1 {cannot use namespace qualifiers in hidden command token (rename)}} test interp-20.46 {interp hide vs namespaces} { catch {interp delete a} interp create a a eval { namespace eval foo {} proc foo::x {} {} } set l [list [catch {interp hide a foo::x x} msg] $msg] interp delete a set l } {1 {can only hide global namespace commands (use rename then hide)}} test interp-20.47 {interp hide vs namespaces} { catch {interp delete a} interp create a a eval { proc x {} {} } set l [list [catch {interp hide a x foo::x} msg] $msg] interp delete a set l } {1 {cannot use namespace qualifiers in hidden command token (rename)}} test interp-20.48 {interp hide vs namespaces} { catch {interp delete a} interp create a a eval { namespace eval foo {} proc foo::x {} {} } set l [list [catch {interp hide a foo::x bar::x} msg] $msg] interp delete a set l } {1 {cannot use namespace qualifiers in hidden command token (rename)}} test interp-20.49 {interp invokehidden -namespace} -setup { set script [makeFile { set x [namespace current] } script] interp create -safe child } -body { child invokehidden -namespace ::foo source $script child eval {set ::foo::x} } -cleanup { interp delete child removeFile script } -result ::foo test interp-20.50 {Bug 2486550} -setup { interp create child } -body { child hide coroutine child invokehidden coroutine } -cleanup { interp delete child } -returnCodes error -match glob -result * test interp-20.50.1 {Bug 2486550} -setup { interp create child } -body { child hide coroutine catch {child invokehidden coroutine} m o dict get $o -errorinfo } -cleanup { unset -nocomplain m 0 interp delete child } -returnCodes ok -result {wrong # args: should be "coroutine name cmd ?arg ...?" while executing "coroutine" invoked from within "child invokehidden coroutine"} test interp-21.1 {interp hidden} { interp hidden {} } "" test interp-21.2 {interp hidden} { interp hidden } "" test interp-21.3 {interp hidden vs interp hide, interp expose} -setup { set l "" } -body { lappend l [interp hidden] interp hide {} pwd lappend l [interp hidden] interp expose {} pwd lappend l [interp hidden] } -result {{} pwd {}} test interp-21.4 {interp hidden} -setup { catch {interp delete a} } -body { interp create a interp hidden a } -cleanup { interp delete a } -result "" test interp-21.5 {interp hidden} -setup { catch {interp delete a} } -body { interp create -safe a lsort [interp hidden a] } -cleanup { interp delete a } -result $hidden_cmds test interp-21.6 {interp hidden vs interp hide, interp expose} -setup { catch {interp delete a} set l "" } -body { interp create a lappend l [interp hidden a] interp hide a pwd lappend l [interp hidden a] interp expose a pwd lappend l [interp hidden a] } -cleanup { interp delete a } -result {{} pwd {}} test interp-21.7 {interp hidden} -setup { catch {interp delete a} } -body { interp create a a hidden } -cleanup { interp delete a } -result "" test interp-21.8 {interp hidden} -setup { catch {interp delete a} } -body { interp create a -safe lsort [a hidden] } -cleanup { interp delete a } -result $hidden_cmds test interp-21.9 {interp hidden vs interp hide, interp expose} -setup { catch {interp delete a} set l "" } -body { interp create a lappend l [a hidden] a hide pwd lappend l [a hidden] a expose pwd lappend l [a hidden] } -cleanup { interp delete a } -result {{} pwd {}} test interp-22.1 {testing interp marktrusted} { catch {interp delete a} interp create a set l "" lappend l [a issafe] lappend l [a marktrusted] lappend l [a issafe] interp delete a set l } {0 {} 0} test interp-22.2 {testing interp marktrusted} { catch {interp delete a} interp create a set l "" lappend l [interp issafe a] lappend l [interp marktrusted a] lappend l [interp issafe a] interp delete a set l } {0 {} 0} test interp-22.3 {testing interp marktrusted} { catch {interp delete a} interp create a -safe set l "" lappend l [a issafe] lappend l [a marktrusted] lappend l [a issafe] interp delete a set l } {1 {} 0} test interp-22.4 {testing interp marktrusted} { catch {interp delete a} interp create a -safe set l "" lappend l [interp issafe a] lappend l [interp marktrusted a] lappend l [interp issafe a] interp delete a set l } {1 {} 0} test interp-22.5 {testing interp marktrusted} { catch {interp delete a} interp create a -safe interp create {a b} catch {a eval {interp marktrusted b}} msg interp delete a set msg } {permission denied: safe interpreter cannot mark trusted} test interp-22.6 {testing interp marktrusted} { catch {interp delete a} interp create a -safe interp create {a b} catch {a eval {b marktrusted}} msg interp delete a set msg } {permission denied: safe interpreter cannot mark trusted} test interp-22.7 {testing interp marktrusted} { catch {interp delete a} interp create a -safe set l "" lappend l [interp issafe a] interp marktrusted a interp create {a b} lappend l [interp issafe a] lappend l [interp issafe {a b}] interp delete a set l } {1 0 0} test interp-22.8 {testing interp marktrusted} { catch {interp delete a} interp create a -safe set l "" lappend l [interp issafe a] interp create {a b} lappend l [interp issafe {a b}] interp marktrusted a interp create {a c} lappend l [interp issafe a] lappend l [interp issafe {a c}] interp delete a set l } {1 1 0 0} test interp-22.9 {testing interp marktrusted} { catch {interp delete a} interp create a -safe set l "" lappend l [interp issafe a] interp create {a b} lappend l [interp issafe {a b}] interp marktrusted {a b} lappend l [interp issafe a] lappend l [interp issafe {a b}] interp create {a b c} lappend l [interp issafe {a b c}] interp delete a set l } {1 1 1 0 0} test interp-23.1 {testing hiding vs aliases: unsafe interp} -setup { catch {interp delete a} set l "" } -body { interp create a lappend l [interp hidden a] a alias bar bar lappend l [interp aliases a] [interp hidden a] a hide bar lappend l [interp aliases a] [interp hidden a] a alias bar {} lappend l [interp aliases a] [interp hidden a] } -cleanup { interp delete a } -result {{} bar {} bar bar {} {}} test interp-23.2 {testing hiding vs aliases: safe interp} -setup { catch {interp delete a} set l "" } -constraints {unixOrWin} -body { interp create a -safe lappend l [lsort [interp hidden a]] a alias bar bar lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] a hide bar lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] a alias bar {} lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] } -cleanup { interp delete a } -result [list $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} [lsort [concat $hidden_cmds bar]] {::tcl::mathfunc::max ::tcl::mathfunc::min clock} $hidden_cmds] test interp-24.1 {result resetting on error} -setup { catch {interp delete a} } -body { interp create a interp alias a foo {} apply {args {error $args}} interp eval a { lappend l [catch {foo 1 2 3} msg] $msg lappend l [catch {foo 3 4 5} msg] $msg } } -cleanup { interp delete a } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.2 {result resetting on error} -setup { catch {interp delete a} } -body { interp create a -safe interp alias a foo {} apply {args {error $args}} interp eval a { lappend l [catch {foo 1 2 3} msg] $msg lappend l [catch {foo 3 4 5} msg] $msg } } -cleanup { interp delete a } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.3 {result resetting on error} -setup { catch {interp delete a} } -body { interp create a interp create {a b} interp eval a { proc foo args {error $args} } interp alias {a b} foo a foo interp eval {a b} { lappend l [catch {foo 1 2 3} msg] $msg lappend l [catch {foo 3 4 5} msg] $msg } } -cleanup { interp delete a } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.4 {result resetting on error} -setup { catch {interp delete a} } -body { interp create a -safe interp create {a b} interp eval a { proc foo args {error $args} } interp alias {a b} foo a foo interp eval {a b} { lappend l [catch {foo 1 2 3} msg] lappend l $msg lappend l [catch {foo 3 4 5} msg] lappend l $msg } } -cleanup { interp delete a } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.5 {result resetting on error} -setup { catch {interp delete a} catch {interp delete b} } -body { interp create a interp create b interp eval a { proc foo args {error $args} } interp alias b foo a foo interp eval b { lappend l [catch {foo 1 2 3} msg] $msg lappend l [catch {foo 3 4 5} msg] $msg } } -cleanup { interp delete a interp delete b } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.6 {result resetting on error} -setup { catch {interp delete a} catch {interp delete b} } -body { interp create a -safe interp create b -safe interp eval a { proc foo args {error $args} } interp alias b foo a foo interp eval b { lappend l [catch {foo 1 2 3} msg] $msg lappend l [catch {foo 3 4 5} msg] $msg } } -cleanup { interp delete a interp delete b } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.7 {result resetting on error} -setup { catch {interp delete a} set l {} } -body { interp create a interp eval a { proc foo args {error $args} } lappend l [catch {interp eval a foo 1 2 3} msg] $msg lappend l [catch {interp eval a foo 3 4 5} msg] $msg } -cleanup { interp delete a } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.8 {result resetting on error} -setup { catch {interp delete a} set l {} } -body { interp create a -safe interp eval a { proc foo args {error $args} } lappend l [catch {interp eval a foo 1 2 3} msg] $msg lappend l [catch {interp eval a foo 3 4 5} msg] $msg } -cleanup { interp delete a } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.9 {result resetting on error} -setup { catch {interp delete a} set l {} } -body { interp create a interp create {a b} interp eval {a b} { proc foo args {error $args} } interp eval a { proc foo args { eval interp eval b foo $args } } lappend l [catch {interp eval a foo 1 2 3} msg] $msg lappend l [catch {interp eval a foo 3 4 5} msg] $msg } -cleanup { interp delete a } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.10 {result resetting on error} -setup { catch {interp delete a} set l {} } -body { interp create a -safe interp create {a b} interp eval {a b} { proc foo args {error $args} } interp eval a { proc foo args { eval interp eval b foo $args } } lappend l [catch {interp eval a foo 1 2 3} msg] $msg lappend l [catch {interp eval a foo 3 4 5} msg] $msg } -cleanup { interp delete a } -result {1 {1 2 3} 1 {3 4 5}} test interp-24.11 {result resetting on error} -setup { catch {interp delete a} } -body { interp create a interp create {a b} interp eval {a b} { proc foo args {error $args} } interp eval a { proc foo args { lappend l [catch {eval interp eval b foo $args} msg] $msg lappend l [catch {eval interp eval b foo $args} msg] $msg } } interp eval a foo 1 2 3 } -cleanup { interp delete a } -result {1 {1 2 3} 1 {1 2 3}} test interp-24.12 {result resetting on error} -setup { catch {interp delete a} } -body { interp create a -safe interp create {a b} interp eval {a b} { proc foo args {error $args} } interp eval a { proc foo args { lappend l [catch {eval interp eval b foo $args} msg] $msg lappend l [catch {eval interp eval b foo $args} msg] $msg } } interp eval a foo 1 2 3 } -cleanup { interp delete a } -result {1 {1 2 3} 1 {1 2 3}} test interp-25.1 {testing aliasing of string commands} -setup { catch {interp delete a} } -body { interp create a a alias exec foo ;# Relies on exec being a string command! interp delete a } -result "" # # Interps result transmission # test interp-26.1 {result code transmission : interp eval direct} { # Test that all the possibles error codes from Tcl get passed up # from the child interp's context to the parent, even though the # child nominally thinks the command is running at the root level. catch {interp delete a} interp create a set res {} # use a for so if a return -code break 'escapes' we would notice for {set code -1} {$code<=5} {incr code} { lappend res [catch {interp eval a return -code $code} msg] } interp delete a set res } {-1 0 1 2 3 4 5} test interp-26.2 {result code transmission : interp eval indirect} { # retcode == 2 == return is special catch {interp delete a} interp create a interp eval a {proc retcode {code} {return -code $code ret$code}} set res {} # use a for so if a return -code break 'escapes' we would notice for {set code -1} {$code<=5} {incr code} { lappend res [catch {interp eval a retcode $code} msg] $msg } interp delete a set res } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5} test interp-26.3 {result code transmission : aliases} { # Test that all the possibles error codes from Tcl get passed up from the # child interp's context to the parent, even though the child nominally # thinks the command is running at the root level. catch {interp delete a} interp create a set res {} proc MyTestAlias {code} { return -code $code ret$code } interp alias a Test {} MyTestAlias for {set code -1} {$code<=5} {incr code} { lappend res [interp eval a [list catch [list Test $code] msg]] } interp delete a set res } {-1 0 1 2 3 4 5} test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \ {knownBug} { # The known bug is that code 2 is returned, not the -code argument catch {interp delete a} interp create a set res {} interp hide a return for {set code -1} {$code<=5} {incr code} { lappend res [catch {interp invokehidden a return -code $code ret$code}] } interp delete a set res } {-1 0 1 2 3 4 5} test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} -setup { catch {interp delete a} interp create a } -body { # The known bug is that the break and continue should raise errors that # they are used outside a loop. set res {} interp eval a {proc retcode {code} {return -code $code ret$code}} interp hide a retcode for {set code -1} {$code<=5} {incr code} { lappend res [catch {interp invokehidden a retcode $code} msg] $msg } return $res } -cleanup { interp delete a } -result {-1 ret-1 0 ret0 1 ret1 2 ret2 3 ret3 4 ret4 5 ret5} test interp-26.6 {result code transmission: all combined--bug 1637} -setup { set interp [interp create] } -constraints knownBug -body { # Test that all the possibles error codes from Tcl get passed in both # directions. This doesn't work. proc MyTestAlias {interp args} { global aliasTrace lappend aliasTrace $args interp invokehidden $interp {*}$args } foreach c {return} { interp hide $interp $c interp alias $interp $c {} MyTestAlias $interp $c } interp eval $interp {proc ret {code} {return -code $code ret$code}} set res {} set aliasTrace {} for {set code -1} {$code<=5} {incr code} { lappend res [catch {interp eval $interp ret $code} msg] $msg } return $res } -cleanup { interp delete $interp } -result {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5} # Some tests might need to be added to check for difference between toplevel # and non-toplevel evals. # End of return code transmission section test interp-26.7 {errorInfo transmission: regular interps} -setup { set interp [interp create] } -body { proc MyError {secret} { return -code error "msg" } proc MyTestAlias {interp args} { MyError "some secret" } interp alias $interp test {} MyTestAlias $interp interp eval $interp {catch test;set ::errorInfo} } -cleanup { interp delete $interp } -result {msg while executing "MyError "some secret"" (procedure "MyTestAlias" line 2) invoked from within "test"} test interp-26.8 {errorInfo transmission: safe interps--bug 1637} -setup { set interp [interp create -safe] } -constraints knownBug -body { # this test fails because the errorInfo is fully transmitted whether the # interp is safe or not. The errorInfo should never report data from the # parent interpreter because it could contain sensitive information. proc MyError {secret} { return -code error "msg" } proc MyTestAlias {interp args} { MyError "some secret" } interp alias $interp test {} MyTestAlias $interp interp eval $interp {catch test;set ::errorInfo} } -cleanup { interp delete $interp } -result {msg while executing "test"} # Interps & Namespaces test interp-27.1 {interp aliases & namespaces} -setup { set i [interp create] } -body { set aliasTrace {} proc tstAlias {args} { global aliasTrace lappend aliasTrace [list [namespace current] $args] } $i alias foo::bar tstAlias foo::bar $i eval foo::bar test return $aliasTrace } -cleanup { interp delete $i } -result {{:: {foo::bar test}}} test interp-27.2 {interp aliases & namespaces} -setup { set i [interp create] } -body { set aliasTrace {} proc tstAlias {args} { global aliasTrace lappend aliasTrace [list [namespace current] $args] } $i alias foo::bar tstAlias foo::bar $i eval namespace eval foo {bar test} return $aliasTrace } -cleanup { interp delete $i } -result {{:: {foo::bar test}}} test interp-27.3 {interp aliases & namespaces} -setup { set i [interp create] } -body { set aliasTrace {} proc tstAlias {args} { global aliasTrace lappend aliasTrace [list [namespace current] $args] } interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}} interp alias $i foo::bar {} tstAlias foo::bar interp eval $i {namespace eval foo {bar test}} return $aliasTrace } -cleanup { interp delete $i } -result {{:: {foo::bar test}}} test interp-27.4 {interp aliases & namespaces} -setup { set i [interp create] } -body { namespace eval foo2 { variable aliasTrace {} proc bar {args} { variable aliasTrace lappend aliasTrace [list [namespace current] $args] } } $i alias foo::bar foo2::bar foo::bar $i eval namespace eval foo {bar test} return $foo2::aliasTrace } -cleanup { namespace delete foo2 interp delete $i } -result {{::foo2 {foo::bar test}}} test interp-27.5 {interp hidden & namespaces} -setup { set i [interp create] } -constraints knownBug -body { interp eval $i { namespace eval foo { proc bar {args} { return "bar called ([namespace current]) ($args)" } } } set res [list [interp eval $i {namespace eval foo {bar test1}}]] interp hide $i foo::bar lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg] } -cleanup { interp delete $i } -result {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}} test interp-27.6 {interp hidden & aliases & namespaces} -setup { set i [interp create] } -constraints knownBug -body { set v root-parent namespace eval foo { variable v foo-parent proc bar {interp args} { variable v list "parent bar called ($v) ([namespace current]) ($args)"\ [interp invokehidden $interp foo::bar $args] } } interp eval $i { namespace eval foo { namespace export * variable v foo-child proc bar {args} { variable v return "child bar called ($v) ([namespace current]) ($args)" } } } set res [list [interp eval $i {namespace eval foo {bar test1}}]] $i hide foo::bar $i alias foo::bar foo::bar $i set res [concat $res [interp eval $i { set v root-child namespace eval test { variable v foo-test namespace import ::foo::* bar test2 } }]] } -cleanup { namespace delete foo interp delete $i } -result {{child bar called (foo-child) (::foo) (test1)} {parent bar called (foo-parent) (::foo) (test2)} {child bar called (foo-child) (::foo) (test2)}} test interp-27.7 {interp hidden & aliases & imports & namespaces} -setup { set i [interp create] } -constraints knownBug -body { set v root-parent namespace eval mfoo { variable v foo-parent proc bar {interp args} { variable v list "parent bar called ($v) ([namespace current]) ($args)"\ [interp invokehidden $interp test::bar $args] } } interp eval $i { namespace eval foo { namespace export * variable v foo-child proc bar {args} { variable v return "child bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)" } } set v root-child namespace eval test { variable v foo-test namespace import ::foo::* } } set res [list [interp eval $i {namespace eval test {bar test1}}]] $i hide test::bar $i alias test::bar mfoo::bar $i set res [concat $res [interp eval $i {test::bar test2}]] } -cleanup { namespace delete mfoo interp delete $i } -result {{child bar called (foo-child) (bar test1) (::tcltest) (::foo) (test1)} {parent bar called (foo-parent) (::mfoo) (test2)} {child bar called (foo-child) (test::bar test2) (::) (::foo) (test2)}} test interp-27.8 {hiding, namespaces and integrity} knownBug { namespace eval foo { variable v 3 proc bar {} {variable v; set v} # next command would currently generate an unknown command "bar" error. interp hide {} bar } namespace delete foo list [catch {interp invokehidden {} foo::bar} msg] $msg } {1 {invalid hidden command name "foo"}} test interp-28.1 {getting fooled by child's namespace ?} -setup { set i [interp create -safe] proc parent {interp args} {interp hide $interp list} } -body { $i alias parent parent $i set r [interp eval $i { namespace eval foo { proc list {args} { return "dummy foo::list" } parent } info commands list }] } -cleanup { rename parent {} interp delete $i } -result {} test interp-28.2 {parent's nsName cache should not cross} -setup { set i [interp create] $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}} } -body { $i eval { set x {namespace children ::} set y [list namespace children ::] namespace delete {*}[filter [{*}$y]] set j [interp create] $j alias filter filter $j eval {namespace delete {*}[filter [namespace children ::]]} namespace eval foo {} list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]] } } -cleanup { interp delete $i } -result {::foo ::foo {} {}} # Part 29: recursion limit # 29.1.* Argument checking # 29.2.* Reading and setting the recursion limit # 29.3.* Does the recursion limit work? # 29.4.* Recursion limit inheritance by sub-interpreters # 29.5.* Confirming the recursionlimit command does not affect the parent # 29.6.* Safe interpreter restriction test interp-29.1.1 {interp recursionlimit argument checking} { list [catch {interp recursionlimit} msg] $msg } {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}} test interp-29.1.2 {interp recursionlimit argument checking} { list [catch {interp recursionlimit foo bar} msg] $msg } {1 {could not find interpreter "foo"}} test interp-29.1.3 {interp recursionlimit argument checking} { list [catch {interp recursionlimit foo bar baz} msg] $msg } {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}} test interp-29.1.4 {interp recursionlimit argument checking} { interp create moo set result [catch {interp recursionlimit moo bar} msg] interp delete moo list $result $msg } {1 {expected integer but got "bar"}} test interp-29.1.5 {interp recursionlimit argument checking} { interp create moo set result [catch {interp recursionlimit moo 0} msg] interp delete moo list $result $msg } {1 {recursion limit must be > 0}} test interp-29.1.6 {interp recursionlimit argument checking} { interp create moo set result [catch {interp recursionlimit moo -1} msg] interp delete moo list $result $msg } {1 {recursion limit must be > 0}} test interp-29.1.7 {interp recursionlimit argument checking} { interp create moo set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg] interp delete moo list $result [string range $msg 0 35] } {1 {integer value too large to represent}} test interp-29.1.8 {child recursionlimit argument checking} { interp create moo set result [catch {moo recursionlimit foo bar} msg] interp delete moo list $result $msg } {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}} test interp-29.1.9 {child recursionlimit argument checking} { interp create moo set result [catch {moo recursionlimit foo} msg] interp delete moo list $result $msg } {1 {expected integer but got "foo"}} test interp-29.1.10 {child recursionlimit argument checking} { interp create moo set result [catch {moo recursionlimit 0} msg] interp delete moo list $result $msg } {1 {recursion limit must be > 0}} test interp-29.1.11 {child recursionlimit argument checking} { interp create moo set result [catch {moo recursionlimit -1} msg] interp delete moo list $result $msg } {1 {recursion limit must be > 0}} test interp-29.1.12 {child recursionlimit argument checking} { interp create moo set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg] interp delete moo list $result [string range $msg 0 35] } {1 {integer value too large to represent}} test interp-29.2.1 {query recursion limit} { interp recursionlimit {} } 1000 test interp-29.2.2 {query recursion limit} { set i [interp create] set n [interp recursionlimit $i] interp delete $i set n } 1000 test interp-29.2.3 {query recursion limit} { set i [interp create] set n [$i recursionlimit] interp delete $i set n } 1000 test interp-29.2.4 {query recursion limit} { set i [interp create] set r [$i eval { set n1 [interp recursionlimit {} 42] set n2 [interp recursionlimit {}] list $n1 $n2 }] interp delete $i set r } {42 42} test interp-29.2.5 {query recursion limit} { set i [interp create] set n1 [interp recursionlimit $i 42] set n2 [interp recursionlimit $i] interp delete $i list $n1 $n2 } {42 42} test interp-29.2.6 {query recursion limit} { set i [interp create] set n1 [interp recursionlimit $i 42] set n2 [$i recursionlimit] interp delete $i list $n1 $n2 } {42 42} test interp-29.2.7 {query recursion limit} { set i [interp create] set n1 [$i recursionlimit 42] set n2 [interp recursionlimit $i] interp delete $i list $n1 $n2 } {42 42} test interp-29.2.8 {query recursion limit} { set i [interp create] set n1 [$i recursionlimit 42] set n2 [$i recursionlimit] interp delete $i list $n1 $n2 } {42 42} test interp-29.3.1 {recursion limit} { set i [interp create] set r [interp eval $i { interp recursionlimit {} 50 proc p {} {incr ::i; p} set i 0 list [catch p msg] $msg $i }] interp delete $i set r } {1 {too many nested evaluations (infinite loop?)} 49} test interp-29.3.2 {recursion limit} { set i [interp create] interp recursionlimit $i 50 set r [interp eval $i { proc p {} {incr ::i; p} set i 0 list [catch p msg] $msg $i }] interp delete $i set r } {1 {too many nested evaluations (infinite loop?)} 49} test interp-29.3.3 {recursion limit} { set i [interp create] $i recursionlimit 50 set r [interp eval $i { proc p {} {incr ::i; p} set i 0 list [catch p msg] $msg $i }] interp delete $i set r } {1 {too many nested evaluations (infinite loop?)} 49} test interp-29.3.4 {recursion limit error reporting} { interp create child set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 interp recursionlimit {} 5 set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {1 {falling back due to new recursion limit}} test interp-29.3.5 {recursion limit error reporting} { interp create child set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 interp recursionlimit {} 4 set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {1 {falling back due to new recursion limit}} test interp-29.3.6 {recursion limit error reporting} { interp create child set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 interp recursionlimit {} 6 set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} # # Note that TEBC does not verify the interp's nesting level itself; the nesting # level will only be verified when it invokes a non-bcc'd command. # test interp-29.3.7a {recursion limit error reporting} { interp create child after 0 {interp recursionlimit child 5} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.3.7b {recursion limit error reporting} { interp create child after 0 {interp recursionlimit child 5} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 update eval { # 5 set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.3.7c {recursion limit error reporting} { interp create child after 0 {interp recursionlimit child 5} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set set set $set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {1 {too many nested evaluations (infinite loop?)}} test interp-29.3.8a {recursion limit error reporting} { interp create child after 0 {interp recursionlimit child 4} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.3.8b {recursion limit error reporting} { interp create child after 0 {interp recursionlimit child 4} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 update eval { # 5 set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {1 {too many nested evaluations (infinite loop?)}} test interp-29.3.9a {recursion limit error reporting} { interp create child after 0 {interp recursionlimit child 6} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.3.9b {recursion limit error reporting} { interp create child after 0 {interp recursionlimit child 6} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 set set set $set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.3.10a {recursion limit error reporting} { interp create child after 0 {child recursionlimit 4} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.3.10b {recursion limit error reporting} { interp create child after 0 {child recursionlimit 4} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 update eval { # 5 set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {1 {too many nested evaluations (infinite loop?)}} test interp-29.3.11a {recursion limit error reporting} { interp create child after 0 {child recursionlimit 5} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.3.11b {recursion limit error reporting} { interp create child after 0 {child recursionlimit 5} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set set set $set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {1 {too many nested evaluations (infinite loop?)}} test interp-29.3.12a {recursion limit error reporting} { interp create child after 0 {child recursionlimit 6} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.3.12b {recursion limit error reporting} { interp create child after 0 {child recursionlimit 6} set r1 [child eval { catch { # nesting level 1 eval { # 2 eval { # 3 eval { # 4 eval { # 5 update set set set $set x ok } } } } } msg }] set r2 [child eval { set msg }] interp delete child list $r1 $r2 } {0 ok} test interp-29.4.1 {recursion limit inheritance} { set i [interp create] set ii [interp eval $i { interp recursionlimit {} 50 interp create }] set r [interp eval [list $i $ii] { proc p {} {incr ::i; p} set i 0 catch p set i }] interp delete $i set r } 50 test interp-29.4.2 {recursion limit inheritance} { set i [interp create] $i recursionlimit 50 set ii [interp eval $i {interp create}] set r [interp eval [list $i $ii] { proc p {} {incr ::i; p} set i 0 catch p set i }] interp delete $i set r } 50 test interp-29.5.1 {does child recursion limit affect parent?} { set before [interp recursionlimit {}] set i [interp create] interp recursionlimit $i 20000 set after [interp recursionlimit {}] set childlimit [interp recursionlimit $i] interp delete $i list [expr {$before == $after}] $childlimit } {1 20000} test interp-29.5.2 {does child recursion limit affect parent?} { set before [interp recursionlimit {}] set i [interp create] interp recursionlimit $i 20000 set after [interp recursionlimit {}] set childlimit [$i recursionlimit] interp delete $i list [expr {$before == $after}] $childlimit } {1 20000} test interp-29.5.3 {does child recursion limit affect parent?} { set before [interp recursionlimit {}] set i [interp create] $i recursionlimit 20000 set after [interp recursionlimit {}] set childlimit [interp recursionlimit $i] interp delete $i list [expr {$before == $after}] $childlimit } {1 20000} test interp-29.5.4 {does child recursion limit affect parent?} { set before [interp recursionlimit {}] set i [interp create] $i recursionlimit 20000 set after [interp recursionlimit {}] set childlimit [$i recursionlimit] interp delete $i list [expr {$before == $after}] $childlimit } {1 20000} test interp-29.6.1 {safe interpreter recursion limit} { interp create child -safe set n [interp recursionlimit child] interp delete child set n } 1000 test interp-29.6.2 {safe interpreter recursion limit} { interp create child -safe set n [child recursionlimit] interp delete child set n } 1000 test interp-29.6.3 {safe interpreter recursion limit} { interp create child -safe set n1 [interp recursionlimit child 42] set n2 [interp recursionlimit child] interp delete child list $n1 $n2 } {42 42} test interp-29.6.4 {safe interpreter recursion limit} { interp create child -safe set n1 [child recursionlimit 42] set n2 [interp recursionlimit child] interp delete child list $n1 $n2 } {42 42} test interp-29.6.5 {safe interpreter recursion limit} { interp create child -safe set n1 [interp recursionlimit child 42] set n2 [child recursionlimit] interp delete child list $n1 $n2 } {42 42} test interp-29.6.6 {safe interpreter recursion limit} { interp create child -safe set n1 [child recursionlimit 42] set n2 [child recursionlimit] interp delete child list $n1 $n2 } {42 42} test interp-29.6.7 {safe interpreter recursion limit} { interp create child -safe set n1 [child recursionlimit 42] set n2 [child recursionlimit] interp delete child list $n1 $n2 } {42 42} test interp-29.6.8 {safe interpreter recursion limit} { interp create child -safe set n [catch {child eval {interp recursionlimit {} 42}} msg] interp delete child list $n $msg } {1 {permission denied: safe interpreters cannot change recursion limit}} test interp-29.6.9 {safe interpreter recursion limit} { interp create child -safe set result [ child eval { interp create child2 -safe set n [catch { interp recursionlimit child2 42 } msg] list $n $msg } ] interp delete child set result } {1 {permission denied: safe interpreters cannot change recursion limit}} test interp-29.6.10 {safe interpreter recursion limit} { interp create child -safe set result [ child eval { interp create child2 -safe set n [catch { child2 recursionlimit 42 } msg] list $n $msg } ] interp delete child set result } {1 {permission denied: safe interpreters cannot change recursion limit}} # # Deep recursion (into interps when the regular one fails): # # still crashes... # proc p {} { # if {[catch p ret]} { # catch { # set i [interp create] # interp eval $i [list proc p {} [info body p]] # interp eval $i p # } # interp delete $i # return ok # } # return $ret # } # p # more tests needed... # Interp & stack #test interp-29.1 {interp and stack (info level)} { #} {} # End of stack-recursion tests # This test dumps core in Tcl 8.0.3! test interp-30.1 {deletion of aliases inside namespaces} { set i [interp create] $i alias ns::cmd list $i alias ns::cmd {} } {} test interp-31.1 {alias invocation scope} { proc mySet {varName value} { upvar 1 $varName localVar set localVar $value } interp alias {} myNewSet {} mySet proc testMyNewSet {value} { myNewSet a $value return $a } unset -nocomplain a set result [testMyNewSet "ok"] rename testMyNewSet {} rename mySet {} rename myNewSet {} set result } ok test interp-32.1 {parent's working directory should be inherited by a child interp} -setup { cd [temporaryDirectory] } -body { set parent [pwd] set i [interp create] set child [$i eval pwd] interp delete $i file mkdir cwd_test cd cwd_test lappend parent [pwd] set i [interp create] lappend child [$i eval pwd] cd .. file delete cwd_test interp delete $i expr {[string equal $parent $child] ? 1 : "\{$parent\} != \{$child\}"} } -cleanup { cd [workingDirectory] } -result 1 test interp-33.1 {refCounting for target words of alias [Bug 730244]} { # This test will panic if Bug 730244 is not fixed. set i [interp create] proc testHelper args {rename testHelper {}; return $args} # Note: interp names are simple words by default trace add execution testHelper enter "interp alias $i alias {} ;#" interp alias $i alias {} testHelper this $i eval alias } this test interp-34.1 {basic test of limits - calling commands} -body { set i [interp create] $i eval { proc foobar {} { for {set x 0} {$x<1000000} {incr x} { # Calls to this are not bytecoded away pid } } } $i limit command -value 1000 $i eval foobar } -returnCodes error -result {command count limit exceeded} -cleanup { interp delete $i } test interp-34.2 {basic test of limits - bytecoded commands} -body { set i [interp create] $i eval { proc foobar {} { for {set x 0} {$x<1000000} {incr x} { # Calls to this *are* bytecoded away expr {1+2+3} } } } $i limit command -value 1000 $i eval foobar } -returnCodes error -result {command count limit exceeded} -cleanup { interp delete $i } test interp-34.3 {basic test of limits - pure bytecode loop} -body { set i [interp create] $i eval { proc foobar {} { while {1} { # No bytecode at all here... } } } # We use a time limit here; command limits don't trap this case $i limit time -seconds [expr {[clock seconds]+2}] $i eval foobar } -returnCodes error -result {time limit exceeded} -cleanup { interp delete $i } test interp-34.3.1 {basic test of limits - pure inside-command loop} -body { set i [interp create] $i eval { proc foobar {} { set while while $while {1} { # No bytecode at all here... } } } # We use a time limit here; command limits don't trap this case $i limit time -seconds [expr {[clock seconds] + 2}] $i eval foobar } -returnCodes error -result {time limit exceeded} -cleanup { interp delete $i } test interp-34.4 {limits with callbacks: extending limits} -setup { set i [interp create] set a 0 set b 0 set c a proc cb1 {} { global c incr ::$c } proc cb2 {newlimit args} { global c i set c b $i limit command -value $newlimit } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] $i limit command -command "cb2 [expr {$curlim + 100}]" \ -value [expr {$curlim + 10}] $i eval {for {set i 0} {$i<10} {incr i} {foo}} list $a $b $c } -result {6 4 b} -cleanup { interp delete $i rename cb1 {} rename cb2 {} } # The next three tests exercise all the three ways that limit handlers # can be deleted. Fully verifying this requires additional source # code instrumentation. test interp-34.5 {limits with callbacks: removing limits} -setup { set i [interp create] set a 0 set b 0 set c a proc cb1 {} { global c incr ::$c } proc cb2 {newlimit args} { global c i set c b $i limit command -value $newlimit } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] $i limit command -command "cb2 {}" -value [expr {$curlim + 10}] $i eval {for {set i 0} {$i<10} {incr i} {foo}} list $a $b $c } -result {6 4 b} -cleanup { interp delete $i rename cb1 {} rename cb2 {} } test interp-34.6 {limits with callbacks: removing limits and handlers} -setup { set i [interp create] set a 0 set b 0 set c a proc cb1 {} { global c incr ::$c } proc cb2 {args} { global c i set c b $i limit command -value {} -command {} } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] $i limit command -command cb2 -value [expr {$curlim + 10}] $i eval {for {set i 0} {$i<10} {incr i} {foo}} list $a $b $c } -result {6 4 b} -cleanup { interp delete $i rename cb1 {} rename cb2 {} } test interp-34.7 {limits with callbacks: deleting the handler interp} -setup { set i [interp create] $i eval { set i [interp create] proc cb1 {} { global c incr ::$c } proc cb2 {args} { global c i curlim set c b $i limit command -value [expr {$curlim + 1000}] trapToParent } } proc cb3 {} { global i subi interp alias [list $i $subi] foo {} cb4 interp delete $i } proc cb4 {} { global n incr n } } -body { set subi [$i eval set i] interp alias $i trapToParent {} cb3 set n 0 $i eval { set a 0 set b 0 set c a interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] $i limit command -command cb2 -value [expr {$curlim + 10}] } $i eval { $i eval { for {set i 0} {$i<10} {incr i} {foo} } } list $n [interp exists $i] } -result {4 0} -cleanup { rename cb3 {} rename cb4 {} } # Bug 1085023 test interp-34.8 {time limits trigger in vwaits} -body { set i [interp create] interp limit $i time -seconds [expr {[clock seconds] + 1}] -granularity 1 $i eval { set x {} vwait x } } -cleanup { interp delete $i } -returnCodes error -result {limit exceeded} test interp-34.9 {time limits trigger in blocking after} { set i [interp create] set t0 [clock seconds] interp limit $i time -seconds [expr {$t0 + 1}] -granularity 1 set code [catch { $i eval {after 10000} } msg] set t1 [clock seconds] interp delete $i list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}] } {1 {time limit exceeded} OK} test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body { set i [interp create] # Assume someone hasn't set the clock to early 1970! $i limit time -seconds 1 -granularity 4 interp alias $i log {} lappend result set result {} catch { $i eval { log 1 after 100 log 2 } } msg interp delete $i lappend result $msg } -result {1 {time limit exceeded}} test interp-34.11 {time limit extension in callbacks} -setup { proc cb1 {i t} { global result lappend result cb1 $i limit time -seconds $t -command cb2 } proc cb2 {} { global result lappend result cb2 } } -body { set i [interp create] set t0 [clock seconds] $i limit time -seconds [expr {$t0 + 1}] -granularity 1 \ -command "cb1 $i [expr {$t0 + 2}]" set ::result {} lappend ::result [catch { $i eval { for {set i 0} {$i<30} {incr i} { after 100 } } } msg] $msg set t1 [clock seconds] lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}] interp delete $i return $::result } -result {cb1 cb2 1 {time limit exceeded} ok} -cleanup { rename cb1 {} rename cb2 {} } test interp-34.12 {time limit extension in callbacks} -setup { proc cb1 {i} { global result times lappend result cb1 set times [lassign $times t] $i limit time -seconds $t } } -body { set i [interp create] set t0 [clock seconds] set ::times "[expr {$t0 + 2}] [expr {$t0 + 100}]" $i limit time -seconds [expr {$t0 + 1}] -granularity 1 -command "cb1 $i" set ::result {} lappend ::result [catch { $i eval { for {set i 0} {$i<30} {incr i} { after 100 } } } msg] $msg set t1 [clock seconds] lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}] interp delete $i return $::result } -result {cb1 cb1 0 {} ok} -cleanup { rename cb1 {} } test interp-34.13 {time limit granularity and vwait: Bug 2891362} -setup { set i [interp create -safe] } -body { $i limit time -seconds [clock add [clock seconds] 1 second] $i eval { after 2000 set x timeout vwait x return $x } } -cleanup { interp delete $i } -returnCodes error -result {limit exceeded} test interp-35.1 {interp limit syntax} -body { interp limit } -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"} test interp-35.2 {interp limit syntax} -body { interp limit {} } -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"} test interp-35.3 {interp limit syntax} -body { interp limit {} foo } -returnCodes error -result {bad limit type "foo": must be commands or time} test interp-35.4 {interp limit syntax} -body { set i [interp create] set dict [interp limit $i commands] set result {} foreach key [lsort [dict keys $dict]] { lappend result $key [dict get $dict $key] } set result } -cleanup { interp delete $i } -result {-command {} -granularity 1 -value {}} test interp-35.5 {interp limit syntax} -body { set i [interp create] interp limit $i commands -granularity } -cleanup { interp delete $i } -result 1 test interp-35.6 {interp limit syntax} -body { set i [interp create] interp limit $i commands -granularity 2 } -cleanup { interp delete $i } -result {} test interp-35.7 {interp limit syntax} -body { set i [interp create] interp limit $i commands -foobar } -cleanup { interp delete $i } -returnCodes error -result {bad option "-foobar": must be -command, -granularity, or -value} test interp-35.8 {interp limit syntax} -body { set i [interp create] interp limit $i commands -granularity foobar } -cleanup { interp delete $i } -returnCodes error -result {expected integer but got "foobar"} test interp-35.9 {interp limit syntax} -body { set i [interp create] interp limit $i commands -granularity 0 } -cleanup { interp delete $i } -returnCodes error -result {granularity must be at least 1} test interp-35.10 {interp limit syntax} -body { set i [interp create] interp limit $i commands -value foobar } -cleanup { interp delete $i } -returnCodes error -result {expected integer but got "foobar"} test interp-35.11 {interp limit syntax} -body { set i [interp create] interp limit $i commands -value -1 } -cleanup { interp delete $i } -returnCodes error -result {command limit value must be at least 0} test interp-35.12 {interp limit syntax} -body { set i [interp create] set dict [interp limit $i time] set result {} foreach key [lsort [dict keys $dict]] { lappend result $key [dict get $dict $key] } set result } -cleanup { interp delete $i } -result {-command {} -granularity 10 -milliseconds {} -seconds {}} test interp-35.13 {interp limit syntax} -body { set i [interp create] interp limit $i time -granularity } -cleanup { interp delete $i } -result 10 test interp-35.14 {interp limit syntax} -body { set i [interp create] interp limit $i time -granularity 2 } -cleanup { interp delete $i } -result {} test interp-35.15 {interp limit syntax} -body { set i [interp create] interp limit $i time -foobar } -cleanup { interp delete $i } -returnCodes error -result {bad option "-foobar": must be -command, -granularity, -milliseconds, or -seconds} test interp-35.16 {interp limit syntax} -body { set i [interp create] interp limit $i time -granularity foobar } -cleanup { interp delete $i } -returnCodes error -result {expected integer but got "foobar"} test interp-35.17 {interp limit syntax} -body { set i [interp create] interp limit $i time -granularity 0 } -cleanup { interp delete $i } -returnCodes error -result {granularity must be at least 1} test interp-35.18 {interp limit syntax} -body { set i [interp create] interp limit $i time -seconds foobar } -cleanup { interp delete $i } -returnCodes error -result {expected integer but got "foobar"} test interp-35.19 {interp limit syntax} -body { set i [interp create] interp limit $i time -seconds -1 } -cleanup { interp delete $i } -returnCodes error -result {seconds must be at least 0} test interp-35.20 {interp limit syntax} -body { set i [interp create] interp limit $i time -millis foobar } -cleanup { interp delete $i } -returnCodes error -result {expected integer but got "foobar"} test interp-35.21 {interp limit syntax} -body { set i [interp create] interp limit $i time -millis -1 } -cleanup { interp delete $i } -returnCodes error -result {milliseconds must be at least 0} test interp-35.22 {interp time limits normalize milliseconds} -body { set i [interp create] interp limit $i time -seconds 1 -millis 1500 list [$i limit time -seconds] [$i limit time -millis] } -cleanup { interp delete $i } -result {2 500} # Bug 3398794 test interp-35.23 {interp command limits can't touch current interp} -body { interp limit {} commands -value 10 } -returnCodes error -result {limits on current interpreter inaccessible} test interp-35.24 {interp time limits can't touch current interp} -body { interp limit {} time -seconds 2 } -returnCodes error -result {limits on current interpreter inaccessible} test interp-36.1 {interp bgerror syntax} -body { interp bgerror } -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"} test interp-36.2 {interp bgerror syntax} -body { interp bgerror x y z } -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"} test interp-36.3 {interp bgerror syntax} -setup { interp create child } -body { child bgerror x y } -cleanup { interp delete child } -returnCodes error -result {wrong # args: should be "child bgerror ?cmdPrefix?"} test interp-36.4 {ChildBgerror syntax} -setup { interp create child } -body { child bgerror \{ } -cleanup { interp delete child } -returnCodes error -result {cmdPrefix must be list of length >= 1} test interp-36.5 {ChildBgerror syntax} -setup { interp create child } -body { child bgerror {} } -cleanup { interp delete child } -returnCodes error -result {cmdPrefix must be list of length >= 1} test interp-36.6 {ChildBgerror returns handler} -setup { interp create child } -body { child bgerror {foo bar soom} } -cleanup { interp delete child } -result {foo bar soom} test interp-36.7 {ChildBgerror sets error handler of child [1999035]} -setup { interp create child child alias handler handler child bgerror handler variable result {untouched} proc handler {args} { variable result set result [lindex $args 0] } } -body { child eval { variable done {} after 0 error foo after 10 [list ::set [namespace which -variable done] {}] vwait [namespace which -variable done] } set result } -cleanup { variable result {} unset -nocomplain result interp delete child } -result foo test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup { catch {interp delete a} interp create a set result {} } -body { interp create {a b} -safe lappend result [interp eval a {expr {min(5,2,3)*max(7,13,11)}}] lappend result [interp eval {a b} {expr {min(5,2,3)*max(7,13,11)}}] } -cleanup { unset -nocomplain result interp delete a } -result {26 26} test interp-38.1 {interp debug one-way switch} -setup { catch {interp delete a} interp create a interp debug a -frame 1 } -body { # TIP #3xx interp debug frame is a one-way switch interp debug a -frame 0 } -cleanup { interp delete a } -result {1} test interp-38.2 {interp debug env var} -setup { catch {interp delete a} set ::env(TCL_INTERP_DEBUG_FRAME) 1 interp create a } -body { interp debug a } -cleanup { unset -nocomplain ::env(TCL_INTERP_DEBUG_FRAME) interp delete a } -result {-frame 1} test interp-38.3 {interp debug wrong args} -body { interp debug } -returnCodes { error } -result {wrong # args: should be "interp debug path ?-frame ?bool??"} test interp-38.4 {interp debug basic setup} -constraints {!singleTestInterp} -body { interp debug {} } -result {-frame 0} test interp-38.5 {interp debug basic setup} -constraints {!singleTestInterp} -body { interp debug {} -f } -result {0} test interp-38.6 {interp debug basic setup} -body { interp debug -frames } -returnCodes error -result {could not find interpreter "-frames"} test interp-38.7 {interp debug basic setup} -body { interp debug {} -frames } -returnCodes error -result {bad debug option "-frames": must be -frame} test interp-38.8 {interp debug basic setup} -body { interp debug {} -frame 0 bogus } -returnCodes { error } -result {wrong # args: should be "interp debug path ?-frame ?bool??"} # cleanup unset -nocomplain hidden_cmds foreach i [interp children] { interp delete $i } ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/ioCmd.test0000644000175000017500000036703214554262142014753 0ustar sergeisergei# -*- tcl -*- # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush, # fblocked, fconfigure, open, channel, fcopy # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } source [file join [file dirname [info script]] tcltests.tcl] ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] #---------------------------------------------------------------------- test iocmd-1.1 {puts command} { list [catch {puts} msg] $msg } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} test iocmd-1.2 {puts command} { list [catch {puts a b c d e f g} msg] $msg } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} test iocmd-1.3 {puts command} { list [catch {puts froboz -nonewline kablooie} msg] $msg } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} test iocmd-1.4 {puts command} { list [catch {puts froboz hello} msg] $msg } {1 {can not find channel named "froboz"}} test iocmd-1.5 {puts command} { list [catch {puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} set path(test1) [makeFile {} test1] test iocmd-1.6 {puts command} { set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} puts -nonewline $f foobar close $f file size $path(test1) } 6 test iocmd-1.7 {puts command} { set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} puts $f foobar close $f file size $path(test1) } 7 test iocmd-1.8 {puts command} { set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} -encoding iso8859-1 puts -nonewline $f [binary format a4a5 foo bar] close $f file size $path(test1) } 9 test iocmd-2.1 {flush command} { list [catch {flush} msg] $msg } {1 {wrong # args: should be "flush channelId"}} test iocmd-2.2 {flush command} { list [catch {flush a b c d e} msg] $msg } {1 {wrong # args: should be "flush channelId"}} test iocmd-2.3 {flush command} { list [catch {flush foo} msg] $msg } {1 {can not find channel named "foo"}} test iocmd-2.4 {flush command} { list [catch {flush stdin} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test iocmd-3.1 {gets command} { list [catch {gets} msg] $msg } {1 {wrong # args: should be "gets channelId ?varName?"}} test iocmd-3.2 {gets command} { list [catch {gets a b c d e f g} msg] $msg } {1 {wrong # args: should be "gets channelId ?varName?"}} test iocmd-3.3 {gets command} { list [catch {gets aaa} msg] $msg } {1 {can not find channel named "aaa"}} test iocmd-3.4 {gets command} { list [catch {gets stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test iocmd-3.5 {gets command} { set f [open $path(test1) w] puts $f [binary format a4a5 foo bar] close $f set f [open $path(test1) r] set result [gets $f] close $f set x foo\x00 set x "${x}bar\x00\x00" string compare $x $result } 0 test iocmd-4.1 {read command} { list [catch {read} msg] $msg } {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}} test iocmd-4.2 {read command} { list [catch {read a b c d e f g h} msg] $msg } {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}} test iocmd-4.3 {read command} { list [catch {read aaa} msg] $msg } {1 {can not find channel named "aaa"}} test iocmd-4.4 {read command} { list [catch {read -nonewline} msg] $msg } {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}} test iocmd-4.5 {read command} { list [catch {read -nonew file4} msg] $msg $::errorCode } {1 {can not find channel named "-nonew"} {TCL LOOKUP CHANNEL -nonew}} test iocmd-4.6 {read command} { list [catch {read stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test iocmd-4.7 {read command} { list [catch {read -nonewline stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test iocmd-4.8 {read command with incorrect combination of arguments} { file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1)] set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode] close $f set x } {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} {TCL WRONGARGS}} test iocmd-4.9 {read command} { list [catch {read stdin foo} msg] $msg $::errorCode } {1 {expected non-negative integer but got "foo"} {TCL VALUE NUMBER}} test iocmd-4.10 {read command} { list [catch {read file107} msg] $msg $::errorCode } {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}} set path(test3) [makeFile {} test3] test iocmd-4.11 {read command} { set f [open $path(test3) w] set x [list [catch {read $f} msg] $msg $::errorCode] close $f string compare [string tolower $x] \ [list 1 [format "channel \"%s\" wasn't opened for reading" $f] none] } 0 test iocmd-4.12 {read command} -setup { set f [open $path(test1)] } -body { list [catch {read $f 12z} msg] $msg $::errorCode } -cleanup { close $f } -result {1 {expected non-negative integer but got "12z"} {TCL VALUE NUMBER}} test iocmd-5.1 {seek command} -returnCodes error -body { seek } -result {wrong # args: should be "seek channelId offset ?origin?"} test iocmd-5.2 {seek command} -returnCodes error -body { seek a b c d e f g } -result {wrong # args: should be "seek channelId offset ?origin?"} test iocmd-5.3 {seek command} -returnCodes error -body { seek stdin gugu } -result {expected integer but got "gugu"} test iocmd-5.4 {seek command} -returnCodes error -body { seek stdin 100 gugu } -result {bad origin "gugu": must be start, current, or end} test iocmd-6.1 {tell command} { list [catch {tell} msg] $msg } {1 {wrong # args: should be "tell channelId"}} test iocmd-6.2 {tell command} { list [catch {tell a b c d e} msg] $msg } {1 {wrong # args: should be "tell channelId"}} test iocmd-6.3 {tell command} { list [catch {tell aaa} msg] $msg } {1 {can not find channel named "aaa"}} test iocmd-7.1 {close command} { list [catch {close} msg] $msg } {1 {wrong # args: should be "close channelId ?direction?"}} test iocmd-7.2 {close command} { list [catch {close a b c d e} msg] $msg } {1 {wrong # args: should be "close channelId ?direction?"}} test iocmd-7.3 {close command} { list [catch {close aaa} msg] $msg } {1 {can not find channel named "aaa"}} test iocmd-7.4 {close command} -setup { set chan [open [info script] r] } -body { chan close $chan bar } -cleanup { close $chan } -returnCodes error -result "bad direction \"bar\": must be read or write" test iocmd-7.5 {close command} -setup { set chan [open [info script] r] } -body { chan close $chan write } -cleanup { close $chan } -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" test iocmd-8.1 {fconfigure command} { list [catch {fconfigure} msg] $msg } {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}} test iocmd-8.2 {fconfigure command} { list [catch {fconfigure a b c d e f} msg] $msg } {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}} test iocmd-8.3 {fconfigure command} { list [catch {fconfigure a b} msg] $msg } {1 {can not find channel named "a"}} test iocmd-8.4 {fconfigure command} { file delete $path(test1) set f1 [open $path(test1) w] set x [list [catch {fconfigure $f1 froboz} msg] $msg] close $f1 set x } {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} test iocmd-8.5 {fconfigure command} { list [catch {fconfigure stdin -buffering froboz} msg] $msg } {1 {bad value for -buffering: must be one of full, line, or none}} test iocmd-8.6 {fconfigure command} { list [catch {fconfigure stdin -translation froboz} msg] $msg } {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}} test iocmd-8.7 {fconfigure command} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} -encoding unicode set x [fconfigure $f1] close $f1 set x } {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf} test iocmd-8.8 {fconfigure command} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ -eofchar {} -encoding unicode set x "" lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] close $f1 set x } {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}} test iocmd-8.9 {fconfigure command} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation binary -buffering none -buffersize 4040 \ -eofchar {} -encoding binary set x [fconfigure $f1] close $f1 set x } {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf} test iocmd-8.10 {fconfigure command} { list [catch {fconfigure a b} msg] $msg } {1 {can not find channel named "a"}} set path(fconfigure.dummy) [makeFile {} fconfigure.dummy] test iocmd-8.11 {fconfigure command} { set chan [open $path(fconfigure.dummy) r] set res [list [catch {fconfigure $chan -froboz blarfo} msg] $msg] close $chan set res } {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} test iocmd-8.12 {fconfigure command} { set chan [open $path(fconfigure.dummy) r] set res [list [catch {fconfigure $chan -b blarfo} msg] $msg] close $chan set res } {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} test iocmd-8.13 {fconfigure command} { set chan [open $path(fconfigure.dummy) r] set res [list [catch {fconfigure $chan -buffer blarfo} msg] $msg] close $chan set res } {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} set cli [socket 127.0.0.1 $port] } -body { fconfigure $cli -blah } -cleanup { close $cli close $srv unset cli srv port rename iocmdSRV {} } -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -connecting, -peername, or -sockname} test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} set cli [socket 127.0.0.1 $port] } -body { expr {[lindex [fconfigure $cli -peername] 2] == $port} } -cleanup { close $cli close $srv unset cli srv port rename iocmdSRV {} } -result 1 test iocmd-8.17 {fconfigure command / tcp channel} -constraints nonPortable -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} set cli [socket 127.0.0.1 $port] } -body { # It is possible that you don't get the connection reset by peer # error but rather a valid answer. Depends on the tcp implementation update puts $cli "blah" flush $cli; # that flush could/should fail too update regsub -all {can([^:])+: } [catch {fconfigure $cli -peername} msg] {} } -cleanup { close $cli close $srv unset cli srv port rename iocmdSRV {} } -result 1 test iocmd-8.18 {fconfigure command / unix tty channel} -constraints {nonPortable unix} -setup { set tty "" } -body { # might fail if /dev/ttya is unavailable set tty [open /dev/ttya] fconfigure $tty -blah blih } -cleanup { if {$tty ne ""} { close $tty } } -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode} test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable win} -setup { set tty "" } -body { # might fail early if com1 is unavailable set tty [open com1] fconfigure $tty -blah blih } -cleanup { if {$tty ne ""} { close $tty } } -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar} # TODO: Test parsing of serial channel options (nonPortable, since requires an # open channel to work with). test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $::errorCode } {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}} test iocmd-9.2 {eof command} { list [catch {eof a b} msg] $msg $::errorCode } {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}} test iocmd-9.3 {eof command} { catch {close file100} list [catch {eof file100} msg] $msg $::errorCode } {1 {can not find channel named "file100"} {TCL LOOKUP CHANNEL file100}} # The tests for Tcl_ExecObjCmd are in exec.test test iocmd-10.1 {fblocked command} { list [catch {fblocked} msg] $msg } {1 {wrong # args: should be "fblocked channelId"}} test iocmd-10.2 {fblocked command} { list [catch {fblocked a b c d e f g} msg] $msg } {1 {wrong # args: should be "fblocked channelId"}} test iocmd-10.3 {fblocked command} { list [catch {fblocked file1000} msg] $msg } {1 {can not find channel named "file1000"}} test iocmd-10.4 {fblocked command} { list [catch {fblocked stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test iocmd-10.5 {fblocked command} { fblocked stdin } 0 set path(test4) [makeFile {} test4] set path(test5) [makeFile {} test5] test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} { set f [open $path(test4) w] close $f list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode } {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrWin} { list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode } {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}} test iocmd-12.1 {POSIX open access modes: RDONLY} { file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1) RDONLY] set x [list [gets $f] [catch {puts $f Test} msg] $msg] close $f string compare $x \ "{Two lines: this one} 1 [list [format "channel \"%s\" wasn't opened for writing" $f]]" } 0 test iocmd-12.2 {POSIX open access modes: RDONLY} -match regexp -body { file delete $path(test3) open $path(test3) RDONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test iocmd-12.3 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} # # Test 13.4 relies on assigning the same channel name twice. # test iocmd-12.4 {POSIX open access modes: WRONLY} {unix} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f -eofchar {} puts $f xyzzy close $f set f [open $path(test3) WRONLY] fconfigure $f -eofchar {} puts -nonewline $f "ab" seek $f 0 current set x [list [catch {gets $f} msg] $msg] close $f set f [open $path(test3) r] fconfigure $f -eofchar {} lappend x [gets $f] close $f set y [list 1 [format "channel \"%s\" wasn't opened for reading" $f] abzzy] string compare $x $y } 0 test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body { file delete $path(test3) open $path(test3) RDWR } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test iocmd-12.6 {POSIX open access modes: errors} { concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$::errorInfo } "1 unmatched open brace in list unmatched open brace in list while processing open access modes \"FOO {BAR BAZ\" invoked from within \"open \$path(test3) \"FOO \\{BAR BAZ\"\"" test iocmd-12.7 {POSIX open access modes: errors} { list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg } {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC}} test iocmd-12.8 {POSIX open access modes: errors} { list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg } {1 {access mode must include either RDONLY, WRONLY, or RDWR}} close [open $path(test3) w] test iocmd-12.9 {POSIX open access modes: BINARY} { list [catch {open $path(test1) BINARY} msg] $msg } {1 {access mode must include either RDONLY, WRONLY, or RDWR}} test iocmd-12.10 {POSIX open access modes: BINARY} { set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f a puts $f b puts -nonewline $f c ;# contents are now 5 bytes: a\nb\nc close $f set f [open $path(test1) r] fconfigure $f -translation binary set result [string length [read $f]] close $f set result } 5 test iocmd-12.11 {POSIX open access modes: BINARY} { set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f \u0248 ;# gets truncated to \u0048 close $f set f [open $path(test1) r] fconfigure $f -translation binary set result [read -nonewline $f] close $f set result } \u0048 test iocmd-13.1 {errors in open command} { list [catch {open} msg] $msg } {1 {wrong # args: should be "open fileName ?access? ?permissions?"}} test iocmd-13.2 {errors in open command} { list [catch {open a b c d} msg] $msg } {1 {wrong # args: should be "open fileName ?access? ?permissions?"}} test iocmd-13.3 {errors in open command} { list [catch {open $path(test1) x} msg] $msg } {1 {illegal access mode "x"}} test iocmd-13.4 {errors in open command} { list [catch {open $path(test1) rw} msg] $msg } {1 {illegal access mode "rw"}} test iocmd-13.5 {errors in open command} { list [catch {open $path(test1) r+1} msg] $msg } {1 {illegal access mode "r+1"}} test iocmd-13.6 {errors in open command} { set msg [list [catch {open _non_existent_} msg] $msg $::errorCode] regsub [file join {} _non_existent_] $msg "_non_existent_" msg string tolower $msg } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}} test iocmd-13.7 {errors in open command} { list [catch {open $path(test1) b} msg] $msg } {1 {illegal access mode "b"}} test iocmd-13.8 {errors in open command} { list [catch {open $path(test1) rbb} msg] $msg } {1 {illegal access mode "rbb"}} test iocmd-13.9 {errors in open command} { list [catch {open $path(test1) r++} msg] $msg } {1 {illegal access mode "r++"}} test iocmd-13.10.1 {open for append, a mode} -setup { set log [makeFile {} out] set chans {} } -body { foreach i { 0 1 2 3 4 5 6 7 8 9 } { puts [set ch [open $log a]] $i lappend chans $ch } foreach ch $chans {catch {close $ch}} lsort [split [string trim [viewFile out]] \n] } -cleanup { removeFile out # Ensure that channels are gone, even if body failed to do so foreach ch $chans {catch {close $ch}} } -result {0 1 2 3 4 5 6 7 8 9} test iocmd-13.10.2 {open for append, O_APPEND} -setup { set log [makeFile {} out] set chans {} } -body { foreach i { 0 1 2 3 4 5 6 7 8 9 } { puts [set ch [open $log {WRONLY CREAT APPEND}]] $i lappend chans $ch } foreach ch $chans {catch {close $ch}} lsort [split [string trim [viewFile out]] \n] } -cleanup { removeFile out # Ensure that channels are gone, even if body failed to do so foreach ch $chans {catch {close $ch}} } -result {0 1 2 3 4 5 6 7 8 9} test ioCmd-13.11 {open ... a+ must not use O_APPEND: Bug 1773127} -setup { set f [makeFile {} ioutil41.tmp] set fid [open $f wb] puts -nonewline $fid 123 close $fid } -body { set fid [open $f ab+] puts -nonewline $fid 456 seek $fid 2 set d [read $fid 2] seek $fid 4 puts -nonewline $fid x close $fid set fid [open $f rb] append d [read $fid] close $fid return $d } -cleanup { removeFile $f } -result 341234x6 test iocmd-14.1 {file id parsing errors} { list [catch {eof gorp} msg] $msg $::errorCode } {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}} test iocmd-14.2 {file id parsing errors} { list [catch {eof filex} msg] $msg } {1 {can not find channel named "filex"}} test iocmd-14.3 {file id parsing errors} { list [catch {eof file12a} msg] $msg } {1 {can not find channel named "file12a"}} test iocmd-14.4 {file id parsing errors} { list [catch {eof file123} msg] $msg } {1 {can not find channel named "file123"}} test iocmd-14.5 {file id parsing errors} { list [catch {eof stdout} msg] $msg } {0 0} test iocmd-14.6 {file id parsing errors} { list [catch {eof stdin} msg] $msg } {0 0} test iocmd-14.7 {file id parsing errors} { list [catch {eof stdout} msg] $msg } {0 0} test iocmd-14.8 {file id parsing errors} { list [catch {eof stderr} msg] $msg } {0 0} test iocmd-14.9 {file id parsing errors} { list [catch {eof stderr1} msg] $msg } {1 {can not find channel named "stderr1"}} set f [open $path(test1) w] close $f set expect "1 {can not find channel named \"$f\"}" test iocmd-14.10 {file id parsing errors} { list [catch {eof $f} msg] $msg } $expect test iocmd-15.1 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} test iocmd-15.2 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy 1} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} test iocmd-15.3 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy 1 2 3 4 5 6 7} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} test iocmd-15.4 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy 1 2 3} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} test iocmd-15.5 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy 1 2 3 4 5} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} set path(test2) [makeFile {} test2] set f [open $path(test1) w] close $f set rfile [open $path(test1) r] set wfile [open $path(test2) w] test iocmd-15.6 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy foo $wfile} msg] $msg } {1 {can not find channel named "foo"}} test iocmd-15.7 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile foo} msg] $msg } {1 {can not find channel named "foo"}} test iocmd-15.8 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $wfile $wfile} msg] $msg } "1 {channel \"$wfile\" wasn't opened for reading}" test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $rfile} msg] $msg } "1 {channel \"$rfile\" wasn't opened for writing}" test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $wfile foo bar} msg] $msg } {1 {bad option "foo": must be -size or -command}} test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $wfile -size foo} msg] $msg } {1 {expected integer but got "foo"}} test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg } {1 {expected integer but got "foo"}} close $rfile close $wfile # ### ### ### ######### ######### ######### ## Testing the reflected channel. test iocmd-20.0 {chan, wrong#args} { catch {chan} msg set msg } {wrong # args: should be "chan subcommand ?arg ...?"} test iocmd-20.1 {chan, unknown method} -body { chan foo } -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *} # --- --- --- --------- --------- --------- # chan create, and method "initialize" test iocmd-21.0 {chan create, wrong#args, not enough} { catch {chan create} msg set msg } {wrong # args: should be "chan create mode cmdprefix"} test iocmd-21.1 {chan create, wrong#args, too many} { catch {chan create a b c} msg set msg } {wrong # args: should be "chan create mode cmdprefix"} test iocmd-21.2 {chan create, r/w mode empty} { proc foo {cmd args} { return {initialize finalize watch} } set chan [chan create {} foo] close $chan rename foo {} } {} test iocmd-21.3 {chan create, invalid r/w mode, bad string} { proc foo {} {} catch {chan create {c} foo} msg rename foo {} set msg } {bad mode "c": must be read or write} test iocmd-21.4 {chan create, bad handler, not a list} { catch {chan create {r w} "foo \{"} msg set msg } {unmatched open brace in list} test iocmd-21.5 {chan create, bad handler, not a command} { catch {chan create {r w} foo} msg set msg } {invalid command name "foo"} test iocmd-21.6 {chan create, initialize failed, bad signature} { proc foo {} {} catch {chan create {r w} foo} msg rename foo {} set msg } {wrong # args: should be "foo"} test iocmd-21.7 {chan create, initialize failed, bad signature} { proc foo {} {} catch {chan create {r w} ::foo} msg rename foo {} set msg } {wrong # args: should be "::foo"} test iocmd-21.8 {chan create, initialize failed, bad result, not a list} -body { proc foo {args} {return "\{"} catch {chan create {r w} foo} msg rename foo {} set ::errorInfo } -match glob -result {chan handler "foo initialize" returned non-list: *} test iocmd-21.9 {chan create, initialize failed, bad result, not a list} -body { proc foo {args} {return \{\{\}} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {chan handler "foo initialize" returned non-list: *} test iocmd-21.10 {chan create, initialize failed, bad result, empty list} -body { proc foo {args} {} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {*all required methods*} test iocmd-21.11 {chan create, initialize failed, bad result, bogus method name} -body { proc foo {args} {return 1} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {*bad method "1": must be *} test iocmd-21.12 {chan create, initialize failed, bad result, bogus method name} -body { proc foo {args} {return {a b c}} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {*bad method "c": must be *} test iocmd-21.13 {chan create, initialize failed, bad result, required methods missing} -body { proc foo {args} {return {initialize finalize}} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {*all required methods*} test iocmd-21.14 {chan create, initialize failed, bad result, mode/handler mismatch} -body { proc foo {args} {return {initialize finalize watch read}} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {*lacks a "write" method} test iocmd-21.15 {chan create, initialize failed, bad result, mode/handler mismatch} -body { proc foo {args} {return {initialize finalize watch write}} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {*lacks a "read" method} test iocmd-21.16 {chan create, initialize failed, bad result, cget(all) mismatch} -body { proc foo {args} {return {initialize finalize watch cget write read}} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {*supports "cget" but not "cgetall"} test iocmd-21.17 {chan create, initialize failed, bad result, cget(all) mismatch} -body { proc foo {args} {return {initialize finalize watch cgetall read write}} catch {chan create {r w} foo} msg rename foo {} set msg } -match glob -result {*supports "cgetall" but not "cget"} test iocmd-21.18 {chan create, initialize ok, creates channel} -match glob -body { proc foo {args} { global res lappend res $args if {[lindex $args 0] ne "initialize"} {return} return {initialize finalize watch read write} } set res {} lappend res [file channel rc*] lappend res [chan create {r w} foo] lappend res [close [lindex $res end]] lappend res [file channel rc*] rename foo {} set res } -result {{} {initialize rc* {read write}} rc* {finalize rc*} {} {}} test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match glob -body { proc foo {args} { global res lappend res $args return {} } set res {} lappend res [file channel rc*] lappend res [catch {chan create {r w} foo} msg] lappend res $msg lappend res [file channel rc*] rename foo {} set res } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}} test iocmd-21.20 {Bug 88aef05cda} -setup { proc foo {method chan args} { switch -- $method blocking { chan configure $chan -blocking [lindex $args 0] return } initialize { return {initialize finalize watch blocking read write configure cget cgetall} } finalize { return } } set ch [chan create {read write} foo] } -body { chan configure $ch -blocking 0 } -cleanup { close $ch rename foo {} } -match glob -returnCodes 1 -result {*(infinite loop?)*} test iocmd-21.21 {[close] in [read] segfaults} -setup { proc foo {method chan args} { switch -- $method initialize { return {initialize finalize watch read} } finalize {} watch {} read { close $chan return a } } set ch [chan create read foo] } -body { read $ch 0 } -cleanup { close $ch rename foo {} } -result {} test iocmd-21.22 {[close] in [read] segfaults} -setup { proc foo {method chan args} { switch -- $method initialize { return {initialize finalize watch read} } finalize {} watch {} read { catch {close $chan} return a } } set ch [chan create read foo] } -body { read $ch 1 } -returnCodes error -cleanup { catch {close $ch} rename foo {} } -match glob -result {*invalid argument*} test iocmd-21.23 {[close] in [gets] segfaults} -setup { proc foo {method chan args} { switch -- $method initialize { return {initialize finalize watch read} } finalize {} watch {} read { catch {close $chan} return \n } } set ch [chan create read foo] } -body { gets $ch } -cleanup { catch {close $ch} rename foo {} } -result {} test iocmd-21.24 {[close] in binary [gets] segfaults} -setup { proc foo {method chan args} { switch -- $method initialize { return {initialize finalize watch read} } finalize {} watch {} read { catch {close $chan} return \n } } set ch [chan create read foo] } -body { chan configure $ch -translation binary gets $ch } -cleanup { catch {close $ch} rename foo {} } -result {} # --- --- --- --------- --------- --------- # Helper commands to record the arguments to handler methods. # Stored in a script so that the threads and interpreters needing this # code do not need their own copy but can access this variable. set helperscript { proc note {item} {global res; lappend res $item; return} proc track {} {upvar args item; note $item; return} proc notes {items} {foreach i $items {note $i}} # This forces the return options to be in the order that the test expects! proc noteOpts opts {global res; lappend res [dict merge { -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?! } $opts]; return} # Helper command, canned result for 'initialize' method. # Gets the optional methods as arguments. Use return features # to post the result higher up. proc init {args} { lappend args initialize finalize watch read write return -code return $args } proc oninit {args} { upvar args hargs if {[lindex $hargs 0] ne "initialize"} {return} lappend args initialize finalize watch read write return -code return $args } proc onfinal {} { upvar args hargs if {[lindex $hargs 0] ne "finalize"} {return} return -code return "" } } # Set everything up in the main thread. eval $helperscript # --- --- --- --------- --------- --------- # method finalize test iocmd-22.1 {chan finalize, handler destruction has no effect on channel} -match glob -body { set res {} proc foo {args} {track; oninit; return} note [set c [chan create {r w} foo]] rename foo {} note [file channels rc*] note [catch {close $c} msg]; note $msg note [file channels rc*] set res } -result {{initialize rc* {read write}} rc* rc* 1 {invalid command name "foo"} {}} test iocmd-22.2 {chan finalize, for close} -match glob -body { set res {} proc foo {args} {track; oninit; return {}} note [set c [chan create {r w} foo]] close $c # Close deleted the channel. note [file channels rc*] # Channel destruction does not kill handler command! note [info command foo] rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo} test iocmd-22.3 {chan finalize, for close, error, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code error 5} note [set c [chan create {r w} foo]] note [catch {close $c} msg]; note $msg # Channel is gone despite error. note [file channels rc*] rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}} test iocmd-22.4 {chan finalize, for close, error, close error} -match glob -body { set res {} proc foo {args} {track; oninit; error FOO} note [set c [chan create {r w} foo]] note [catch {close $c} msg]; note $msg; note $::errorInfo rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO {FOO *"close $c"}} test iocmd-22.5 {chan finalize, for close, arbitrary result, ignored} -match glob -body { set res {} proc foo {args} {track; oninit; return SOMETHING} note [set c [chan create {r w} foo]] note [catch {close $c} msg]; note $msg rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}} test iocmd-22.6 {chan finalize, for close, break, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 3} note [set c [chan create {r w} foo]] note [catch {close $c} msg]; note $msg rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} test iocmd-22.7 {chan finalize, for close, continue, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 4} note [set c [chan create {r w} foo]] note [catch {close $c} msg]; note $msg rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} test iocmd-22.8 {chan finalize, for close, custom code, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 777 BANG} note [set c [chan create {r w} foo]] note [catch {close $c} msg]; note $msg rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -setup { set res {} } -body { proc foo {args} {track; oninit; return -level 5 -code 777 BANG} note [set c [chan create {r w} foo]] note [catch {close $c} msg opt]; note $msg; noteOpts $opt return $res } -cleanup { rename foo {} } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} # --- === *** ########################### # method read test iocmd-23.1 {chan read, regular data return} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return snarf } set c [chan create {r w} foo] note [read $c 10] close $c rename foo {} set res } -result {{read rc* 4096} {read rc* 4096} snarfsnarf} test iocmd-23.2 {chan read, bad data return, to much} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return [string repeat snarf 1000] } set c [chan create {r w} foo] note [catch {read $c 2} msg]; note $msg close $c rename foo {} set res } -result {{read rc* 4096} 1 {read delivered more than requested}} test iocmd-23.3 {chan read, for non-readable channel} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track; note MUST_NOT_HAPPEN } set c [chan create {w} foo] note [catch {read $c 2} msg]; note $msg close $c rename foo {} set res } -result {1 {channel "rc*" wasn't opened for reading}} test iocmd-23.4 {chan read, error return} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] note [catch {read $c 2} msg]; note $msg close $c rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} test iocmd-23.5 {chan read, break return is error} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] note [catch {read $c 2} msg]; note $msg close $c rename foo {} set res } -result {{read rc* 4096} 1 *bad code*} test iocmd-23.6 {chan read, continue return is error} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] note [catch {read $c 2} msg]; note $msg close $c rename foo {} set res } -result {{read rc* 4096} 1 *bad code*} test iocmd-23.7 {chan read, custom return is error} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -code 777 BOOM! } set c [chan create {r w} foo] note [catch {read $c 2} msg]; note $msg close $c rename foo {} set res } -result {{read rc* 4096} 1 *bad code*} test iocmd-23.8 {chan read, level is squashed} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -level 55 -code 777 BOOM! } set c [chan create {r w} foo] note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res } -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} test iocmd-23.9 {chan read, no data means eof} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track return "" } set c [chan create {r w} foo] } -body { note [read $c 2] note [eof $c] set res } -cleanup { close $c rename foo {} unset res } -result {{read rc* 4096} {} 1} test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track error EAGAIN } set c [chan create {r w} foo] } -body { note [read $c 2] note [eof $c] set res } -cleanup { close $c rename foo {} unset res } -result {{read rc* 4096} {} 0} test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track set args [lassign $args sub id] if {$sub ne "read"} {return} close $id return {} } set c [chan create {r} foo] note [read $c] rename foo {} set res } -result {{read rc* 4096} {}} # --- === *** ########################### # method write test iocmd-24.1 {chan write, regular write} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track set written [string length [lindex $args 2]] note $written return $written } set c [chan create {r w} foo] puts -nonewline $c snarf; flush $c close $c rename foo {} set res } -result {{write rc* snarf} 5} test iocmd-24.2 {chan write, partial write is ok} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track set written [string length [lindex $args 2]] if {$written > 10} {set written [expr {$written / 2}]} note $written return $written } set c [chan create {r w} foo] puts -nonewline $c snarfsnarfsnarf; flush $c close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8} test iocmd-24.3 {chan write, failed write} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note -1; return -1} set c [chan create {r w} foo] puts -nonewline $c snarfsnarfsnarf; flush $c close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} -1} test iocmd-24.4 {chan write, non-writable channel} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r} foo] note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]; note $msg close $c rename foo {} set res } -result {1 {channel "rc*" wasn't opened for writing}} test iocmd-24.5 {chan write, bad result, more written than data} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return 10000} set c [chan create {r w} foo] note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg close $c rename foo {} set res } -result {{write rc* snarf} 1 {write wrote more than requested}} test iocmd-24.6 {chan write, bad result, zero-length write} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return 0} set c [chan create {r w} foo] note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg close $c rename foo {} set res } -result {{write rc* snarf} 1 {write wrote nothing}} test iocmd-24.7 {chan write, failed write, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} test iocmd-24.8 {chan write, failed write, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; error BOOM!} set c [chan create {r w} foo] notes [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} test iocmd-24.9 {chan write, failed write, break return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} test iocmd-24.10 {chan write, failed write, continue return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} test iocmd-24.11 {chan write, failed write, custom return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!} set c [chan create {r w} foo] note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} test iocmd-24.12 {chan write, failed write, non-numeric return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return BANG} set c [chan create {r w} foo] note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!} set c [chan create {r w} foo] note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt] note $msg noteOpts $opt close $c rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} test iocmd-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track return 3 } set c [chan create {r w} foo] } -body { note [puts -nonewline $c ABC ; flush $c] set res } -cleanup { close $c rename foo {} unset res } -result {{write rc* ABC} {}} test iocmd-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track # Note: The EAGAIN signals that the channel cannot accept # write requests right now, this in turn causes the IO core to # request the generation of writable events (see expected # result below, and compare to case 24.14 above). error EAGAIN } set c [chan create {r w} foo] } -body { note [puts -nonewline $c ABC ; flush $c] set res } -cleanup { close $c rename foo {} unset res } -result {{write rc* ABC} {watch rc* write} {}} # --- === *** ########################### # method cgetall test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [fconfigure $c] close $c rename foo {} set res } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} set c [chan create {r w} foo] note [fconfigure $c] close $c rename foo {} set res } -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "-bar foo -snarf x" } set c [chan create {r w} foo] note [fconfigure $c] close $c rename foo {} set res } -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "-bar" } set c [chan create {r w} foo] note [catch {fconfigure $c} msg]; note $msg close $c rename foo {} set res } -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}} test iocmd-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "\{" } set c [chan create {r w} foo] note [catch {fconfigure $c} msg]; note $msg close $c rename foo {} set res } -result {{cgetall rc*} 1 {unmatched open brace in list}} test iocmd-25.6 {chan configure, cgetall, error return} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c} msg]; note $msg close $c rename foo {} set res } -result {{cgetall rc*} 1 BOOM!} test iocmd-25.7 {chan configure, cgetall, break return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c} msg]; note $msg close $c rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} test iocmd-25.8 {chan configure, cgetall, continue return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c} msg]; note $msg close $c rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} test iocmd-25.9 {chan configure, cgetall, custom return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code 777 BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c} msg]; note $msg close $c rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -level 55 -code 777 BANG } set c [chan create {r w} foo] note [catch {fconfigure $c} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res } -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}} # --- === *** ########################### # method configure test iocmd-26.1 {chan configure, set standard option} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return } set c [chan create {r w} foo] note [fconfigure $c -translation lf] close $c rename foo {} set res } -result {{}} test iocmd-26.2 {chan configure, set option, error return} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo bar} msg]; note $msg close $c rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BOOM!} test iocmd-26.3 {chan configure, set option, ok return} -match glob -body { set res {} proc foo {args} {oninit configure; onfinal; track; return} set c [chan create {r w} foo] note [fconfigure $c -rc-foo bar] close $c rename foo {} set res } -result {{configure rc* -rc-foo bar} {}} test iocmd-26.4 {chan configure, set option, break return is error} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo bar} msg]; note $msg close $c rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} test iocmd-26.5 {chan configure, set option, continue return is error} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo bar} msg]; note $msg close $c rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} test iocmd-26.6 {chan configure, set option, custom return is error} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -code 444 BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo bar} msg]; note $msg close $c rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -level 55 -code 444 BANG } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}} # --- === *** ########################### # method cget test iocmd-27.1 {chan configure, get option, ok return} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return foo} set c [chan create {r w} foo] note [fconfigure $c -rc-foo] close $c rename foo {} set res } -result {{cget rc* -rc-foo} foo} test iocmd-27.2 {chan configure, get option, error return} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo} msg]; note $msg close $c rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} test iocmd-27.3 {chan configure, get option, break return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo} msg]; note $msg close $c rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} test iocmd-27.4 {chan configure, get option, continue return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo} msg]; note $msg close $c rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code*} test iocmd-27.5 {chan configure, get option, custom return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code 333 BOOM! } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo} msg]; note $msg close $c rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code*} test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -level 77 -code 333 BANG } set c [chan create {r w} foo] note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}} # --- === *** ########################### # method seek test iocmd-28.1 {chan tell, not supported by handler} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [tell $c] close $c rename foo {} set res } -result {-1} test iocmd-28.2 {chan tell, error return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] note [catch {tell $c} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} test iocmd-28.3 {chan tell, break return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] note [catch {tell $c} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} test iocmd-28.4 {chan tell, continue return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] note [catch {tell $c} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} test iocmd-28.5 {chan tell, custom return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!} set c [chan create {r w} foo] note [catch {tell $c} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} test iocmd-28.6 {chan tell, level is ignored} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG} set c [chan create {r w} foo] note [catch {tell $c} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} test iocmd-28.7 {chan tell, regular return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return 88} set c [chan create {r w} foo] note [tell $c] close $c rename foo {} set res } -result {{seek rc* 0 current} 88} test iocmd-28.8 {chan tell, negative return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -1} set c [chan create {r w} foo] note [catch {tell $c} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 current} 1 {Tried to seek before origin}} test iocmd-28.9 {chan tell, string return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return BOGUS} set c [chan create {r w} foo] note [catch {tell $c} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} test iocmd-28.10 {chan seek, not supported by handler} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [catch {seek $c 0 start} msg]; note $msg close $c rename foo {} set res } -result {1 {error during seek on "rc*": invalid argument}} test iocmd-28.11 {chan seek, error return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] note [catch {seek $c 0 start} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} test iocmd-28.12 {chan seek, break return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] note [catch {seek $c 0 start} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} test iocmd-28.13 {chan seek, continue return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] note [catch {seek $c 0 start} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} test iocmd-28.14 {chan seek, custom return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!} set c [chan create {r w} foo] note [catch {seek $c 0 start} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} test iocmd-28.15 {chan seek, level is ignored} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG} set c [chan create {r w} foo] note [catch {seek $c 0 start} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} test iocmd-28.16 {chan seek, bogus return, negative location} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -45} set c [chan create {r w} foo] note [catch {seek $c 0 start} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 start} 1 {Tried to seek before origin}} test iocmd-28.17 {chan seek, bogus return, string return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return BOGUS} set c [chan create {r w} foo] note [catch {seek $c 0 start} msg]; note $msg close $c rename foo {} set res } -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} test iocmd-28.18 {chan seek, ok result} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return 23} set c [chan create {r w} foo] note [seek $c 0 current] close $c rename foo {} set res } -result {{seek rc* 0 current} {}} foreach {testname code} { iocmd-28.19.0 start iocmd-28.19.1 current iocmd-28.19.2 end } { test $testname "chan seek, base conversion, $code" -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return 0} set c [chan create {r w} foo] note [seek $c 0 $code] close $c rename foo {} set res } -result [list [list seek rc* 0 $code] {}] } # --- === *** ########################### # method blocking test iocmd-29.1 {chan blocking, no handler support} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [fconfigure $c -blocking] close $c rename foo {} set res } -result {1} test iocmd-29.2 {chan blocking, no handler support} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [fconfigure $c -blocking 0] note [fconfigure $c -blocking] close $c rename foo {} set res } -result {{} 0} test iocmd-29.3 {chan blocking, retrieval, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [fconfigure $c -blocking] close $c rename foo {} set res } -result {1} test iocmd-29.4 {chan blocking, resetting, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return} set c [chan create {r w} foo] note [fconfigure $c -blocking 0] note [fconfigure $c -blocking] close $c rename foo {} set res } -result {{blocking rc* 0} {} 0} test iocmd-29.5 {chan blocking, setting, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return} set c [chan create {r w} foo] note [fconfigure $c -blocking 1] note [fconfigure $c -blocking] close $c rename foo {} set res } -result {{blocking rc* 1} {} 1} test iocmd-29.6 {chan blocking, error return} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; error BOOM!} set c [chan create {r w} foo] note [catch {fconfigure $c -blocking 0} msg]; note $msg # Catch the close. It changes blocking mode internally, and runs into the error result. catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} test iocmd-29.7 {chan blocking, break return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] note [catch {fconfigure $c -blocking 0} msg]; note $msg catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} test iocmd-29.8 {chan blocking, continue return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] note [catch {fconfigure $c -blocking 0} msg]; note $msg catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} test iocmd-29.9 {chan blocking, custom return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!} set c [chan create {r w} foo] note [catch {fconfigure $c -blocking 0} msg]; note $msg catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} test iocmd-29.10 {chan blocking, level is ignored} -match glob -setup { set res {} } -body { proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG} set c [chan create {r w} foo] note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; noteOpts $opt catch {close $c} return $res } -cleanup { rename foo {} } -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return BOGUS} set c [chan create {r w} foo] note [catch {fconfigure $c -blocking 0} msg]; note $msg catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 0 {}} # --- === *** ########################### # method watch test iocmd-30.1 {chan watch, read interest, some return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return IGNORED} set c [chan create {r w} foo] note [fileevent $c readable {set tick $tick}] close $c ;# 2nd watch, interest zero. rename foo {} set res } -result {{watch rc* read} {} {watch rc* {}}} test iocmd-30.2 {chan watch, write interest, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED} set c [chan create {r w} foo] note [fileevent $c writable {set tick $tick}] note [fileevent $c writable {}] close $c rename foo {} set res } -result {{watch rc* write} {} {watch rc* {}} {}} test iocmd-30.3 {chan watch, accumulated interests} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] note [fileevent $c writable {set tick $tick}] note [fileevent $c readable {set tick $tick}] note [fileevent $c writable {}] note [fileevent $c readable {}] close $c rename foo {} set res } -result {{watch rc* write} {} {watch rc* {read write}} {} {watch rc* read} {} {watch rc* {}} {}} test iocmd-30.4 {chan watch, unchanged interest not forwarded} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] note [fileevent $c writable {set tick $tick}] note [fileevent $c readable {set tick $tick}] ;# Script is changing, note [fileevent $c readable {set tock $tock}] ;# interest does not. close $c ;# 3rd and 4th watch, removing the event handlers. rename foo {} set res } -result {{watch rc* write} {} {watch rc* {read write}} {} {} {watch rc* write} {watch rc* {}}} # --- === *** ########################### # chan postevent test iocmd-31.1 {chan postevent, restricted to reflected channels} -match glob -body { set c [open [makeFile {} goo] r] catch {chan postevent $c {r w}} msg close $c removeFile goo set msg } -result {can not find reflected channel named "file*"} test iocmd-31.2 {chan postevent, unwanted events} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] catch {chan postevent $c {r w}} msg; note $msg close $c rename foo {} set res } -result {{tried to post events channel "rc*" is not interested in}} test iocmd-31.3 {chan postevent, bad input, empty list} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] catch {chan postevent $c {}} msg; note $msg close $c rename foo {} set res } -result {{bad event list: is empty}} test iocmd-31.4 {chan postevent, bad input, illlegal keyword} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] catch {chan postevent $c goo} msg; note $msg close $c rename foo {} set res } -result {{bad event "goo": must be read or write}} test iocmd-31.5 {chan postevent, bad input, not a list} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] catch {chan postevent $c "\{"} msg; note $msg close $c rename foo {} set res } -result {{unmatched open brace in list}} test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] note [fileevent $c readable {note TOCK}] set stop [after 15000 {note TIMEOUT}] after 1000 {note [chan postevent $c r]} vwait ::res catch {after cancel $stop} close $c rename foo {} set res } -result {{watch rc* read} {} TOCK {} {watch rc* {}}} test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] note [fileevent $c writable {note TOCK}] set stop [after 15000 {note TIMEOUT}] after 1000 {note [chan postevent $c w]} vwait ::res catch {after cancel $stop} close $c rename foo {} set res } -result {{watch rc* write} {} TOCK {} {watch rc* {}}} test iocmd-31.8 {chan postevent after close throws error} -match glob -setup { proc foo {args} {oninit; onfinal; track; return} proc dummy args { return } set c [chan create {r w} foo] fileevent $c readable dummy } -body { close $c chan postevent $c read } -cleanup { rename foo {} rename dummy {} } -returnCodes error -result {can not find reflected channel named "rc*"} # --- === *** ########################### # 'Pull the rug' tests. Create channel in a interpreter A, move to # other interpreter B, destroy the origin interpreter (A) before or # during access from B. Must not crash, must return proper errors. test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body { set ida [interp create];#puts <<$ida>> set idb [interp create];#puts <<$idb>> # Magic to get the test* commands in the children load {} Tcltest $ida load {} Tcltest $idb # Set up channel in interpreter interp eval $ida $helperscript set chan [interp eval $ida { proc foo {args} {oninit seek; onfinal; track; return} set chan [chan create {r w} foo] fconfigure $chan -buffering none set chan }] # Move channel to 2nd interpreter. interp eval $ida [list testchannel cut $chan] interp eval $idb [list testchannel splice $chan] # Kill origin interpreter, then access channel from 2nd interpreter. interp delete $ida set res {} lappend res [catch {interp eval $idb [list puts $chan shoo]} msg] $msg lappend res [catch {interp eval $idb [list tell $chan]} msg] $msg lappend res [catch {interp eval $idb [list seek $chan 1]} msg] $msg lappend res [catch {interp eval $idb [list gets $chan]} msg] $msg lappend res [catch {interp eval $idb [list close $chan]} msg] $msg set res } -cleanup { interp delete $idb } -constraints {testchannel} \ -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body { set ida [interp create];#puts <<$ida>> set idb [interp create];#puts <<$idb>> # Magic to get the test* commands in the children load {} Tcltest $ida load {} Tcltest $idb # Set up channel in thread set chan [interp eval $ida $helperscript] set chan [interp eval $ida { proc foo {args} { oninit; onfinal; track; # destroy interpreter during channel access suicide } set chan [chan create {r w} foo] fconfigure $chan -buffering none set chan }] interp alias $ida suicide {} interp delete $ida # Move channel to 2nd thread. interp eval $ida [list testchannel cut $chan] interp eval $idb [list testchannel splice $chan] # Run access from interpreter B, this will give us a synchronous # response. interp eval $idb [list set chan $chan] set res [interp eval $idb { # wait a bit, give the main thread the time to start its event # loop to wait for the response from B after 2000 catch { puts $chan shoo } res set res }] set res } -cleanup { interp delete $idb } -constraints {testchannel} -result {Owner lost} test iocmd-32.2 {delete interp of reflected chan} { # Bug 3034840 # Run this test in an interp with memory debugging to panic # on the double free interp create child child eval { proc no-op args {} proc driver {sub args} {return {initialize finalize watch read}} chan event [chan create read driver] readable no-op } interp delete child } {} # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and ## receiving driver operations to the originator thread. # -*- tcl -*- # ### ### ### ######### ######### ######### ## Testing the reflected channel (Thread forwarding). # ## The id numbers refer to the original test without thread ## forwarding, and gaps due to tests not applicable to forwarding are ## left to keep this asociation. # ### ### ### ######### ######### ######### ## Helper command. Runs a script in a separate thread and returns the ## result. A channel is transfered into the thread as well, and list of ## configuation variables proc inthread {chan script args} { # Test thread. set tid [thread::create -preserved] thread::send $tid {load {} Tcltest} # Init thread configuration. # - Listed variables # - Id of main thread # - A number of helper commands foreach v $args { upvar 1 $v x thread::send $tid [list set $v $x] } thread::send $tid [list set mid [thread::id]] thread::send $tid { proc note {item} {global notes; lappend notes $item} proc notes {} {global notes; return $notes} proc noteOpts opts {global notes; lappend notes [dict merge { -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?! } $opts]} } thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*) # Transfer channel (cut/splice aka detach/attach) testchannel cut $chan thread::send $tid [list testchannel splice $chan] # Run test script, also run local event loop! # The local event loop waits for the result to come back. # It is also necessary for the execution of forwarded channel # operations. set ::tres "" thread::send -async $tid { after 500 catch {s} res; # This runs the script, 's' was defined at (*) thread::send -async $mid [list set ::tres $res] } vwait ::tres # Remove test thread, and return the captured result. thread::release $tid return $::tres } # ### ### ### ######### ######### ######### # ### ### ### ######### ######### ######### test iocmd.tf-22.2 {chan finalize, for close} -match glob -body { set res {} proc foo {args} {track; oninit; return {}} note [set c [chan create {r w} foo]] note [inthread $c { close $c # Close the deleted the channel. file channels rc* } c] # Channel destruction does not kill handler command! note [info command foo] rename foo {} set res } -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo} test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code error 5} note [set c [chan create {r w} foo]] notes [inthread $c { note [catch {close $c} msg]; note $msg # Channel is gone despite error. note [file channels rc*] notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}} test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -body { set res {} proc foo {args} {track; oninit; error FOO} note [set c [chan create {r w} foo]] notes [inthread $c { note [catch {close $c} msg]; note $msg notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO} test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -body { set res {} proc foo {args} {track; oninit; return SOMETHING} note [set c [chan create {r w} foo]] notes [inthread $c { note [catch {close $c} msg]; note $msg notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}} test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 3} note [set c [chan create {r w} foo]] notes [inthread $c { note [catch {close $c} msg]; note $msg notes } c] rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 4} note [set c [chan create {r w} foo]] notes [inthread $c { note [catch {close $c} msg]; note $msg notes } c] rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 777 BANG} note [set c [chan create {r w} foo]] notes [inthread $c { note [catch {close $c} msg]; note $msg notes } c] rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -level 5 -code 777 BANG} note [set c [chan create {r w} foo]] notes [inthread $c { note [catch {close $c} msg opt]; note $msg; noteOpts $opt notes } c] rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \ -constraints {testchannel thread} # --- === *** ########################### # method read test iocmd.tf-23.1 {chan read, regular data return} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return snarf } set c [chan create {r w} foo] notes [inthread $c { note [read $c 10] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf} test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return [string repeat snarf 1000] } set c [chan create {r w} foo] notes [inthread $c { note [catch {[read $c 2]} msg]; note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{read rc* 4096} 1 {read delivered more than requested}} test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track; note MUST_NOT_HAPPEN } set c [chan create {w} foo] notes [inthread $c { note [catch {[read $c 2]} msg]; note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for reading}} test iocmd.tf-23.4 {chan read, error return} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {read $c 2} msg]; note $msg close $c notes } c] rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} \ -constraints {testchannel thread} test iocmd.tf-23.5 {chan read, break return is error} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {read $c 2} msg]; note $msg close $c notes } c] rename foo {} set res } -result {{read rc* 4096} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {read $c 2} msg]; note $msg close $c notes } c] rename foo {} set res } -result {{read rc* 4096} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -code 777 BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {read $c 2} msg]; note $msg close $c notes } c] rename foo {} set res } -result {{read rc* 4096} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track return -level 55 -code 777 BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt close $c notes } c] rename foo {} set res } -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \ -constraints {testchannel thread} test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track return "" } set c [chan create {r w} foo] } -body { notes [inthread $c { note [read $c 2] note [eof $c] close $c notes } c] set res } -cleanup { rename foo {} unset res } -result {{read rc* 4096} {} 1} \ -constraints {testchannel thread} test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track error EAGAIN } set c [chan create {r w} foo] } -body { notes [inthread $c { note [read $c 2] note [eof $c] close $c notes } c] set res } -cleanup { rename foo {} unset res } -result {{read rc* 4096} {} 0} \ -constraints {testchannel thread} # --- === *** ########################### # method write test iocmd.tf-24.1 {chan write, regular write} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track set written [string length [lindex $args 2]] note $written return $written } set c [chan create {r w} foo] inthread $c { puts -nonewline $c snarf; flush $c close $c } c rename foo {} set res } -constraints {testchannel thread} -result {{write rc* snarf} 5} test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track set written [string length [lindex $args 2]] if {$written > 10} {set written [expr {$written / 2}]} note $written return $written } set c [chan create {r w} foo] inthread $c { puts -nonewline $c snarfsnarfsnarf; flush $c close $c } c rename foo {} set res } -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8} test iocmd.tf-24.3 {chan write, failed write} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note -1; return -1} set c [chan create {r w} foo] inthread $c { puts -nonewline $c snarfsnarfsnarf; flush $c close $c } c rename foo {} set res } -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} -1} test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r} foo] notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for writing}} test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return 10000} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}} test iocmd.tf-24.6 {chan write, zero writes} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return 0} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}} test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ -constraints {testchannel thread} test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; error BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ -constraints {testchannel thread} test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return BANG} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} \ -constraints {testchannel thread} test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt] note $msg noteOpts $opt close $c notes } c] rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \ -constraints {testchannel thread} test iocmd.tf-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track return 3 } set c [chan create {r w} foo] } -body { notes [inthread $c { note [puts -nonewline $c ABC ; flush $c] close $c notes } c] set res } -cleanup { rename foo {} unset res } -result {{write rc* ABC} {}} \ -constraints {testchannel thread} test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track # Note: The EAGAIN signals that the channel cannot accept # write requests right now, this in turn causes the IO core to # request the generation of writable events (see expected # result below, and compare to case 24.14 above). error EAGAIN } set c [chan create {r w} foo] } -body { notes [inthread $c { note [puts -nonewline $c ABC ; flush $c] close $c notes } c] set res } -cleanup { proc foo {args} {onfinal; set ::done-24.15 1; return 3} after 1000 {set ::done-24.15 2} vwait done-24.15 rename foo {} unset res } -result {{write rc* ABC} {watch rc* write} {}} \ -constraints {testchannel thread} test iocmd.tf-24.16 {chan write, note the background flush setup by close due to the EAGAIN leaving data in buffers.} -match glob -setup { set res {} proc foo {args} { oninit; onfinal; track # Note: The EAGAIN signals that the channel cannot accept # write requests right now, this in turn causes the IO core to # request the generation of writable events (see expected # result below, and compare to case 24.14 above). error EAGAIN } set c [chan create {r w} foo] } -body { notes [inthread $c { note [puts -nonewline $c ABC ; flush $c] close $c notes } c] # Replace handler with all-tracking one which doesn't error. # This will tell us if a write-due-flush is there. proc foo {args} { onfinal; note BG ; track ; set ::endbody-24.16 1} # Flush (sic!) the event-queue to capture the write from a # BG-flush. after 1000 {set ::endbody-24.16 2} vwait endbody-24.16 set res } -cleanup { proc foo {args} {onfinal; set ::done-24.16 1; return 3} after 1000 {set ::done-24.16 2} vwait done-24.16 rename foo {} unset res } -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \ -constraints {testchannel thread} test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \ -constraints {testchannel thread} -setup { # This test exposes how the execution of postevent in the handler thread causes # a crash if we are not properly injecting the events into the owning thread instead. # With the injection the test will simply complete without crash. set beat 10000 set drive 999 set data ...---... proc LOG {text} { #puts stderr "[thread::id]: $text" return } proc POST {hi} { LOG "-> [info level 0]" chan postevent $hi read LOG "<- [info level 0]" set ::timer [after $::drive [info level 0]] return } proc HANDLER {op ch args} { lappend ::res [lrange [info level 0] 1 end] LOG "-> [info level 0]" set ret {} switch -glob -- $op { init* {set ret {initialize finalize watch read}} watch { set l [lindex $args 0] catch {after cancel $::timer} if {[llength $l]} { set ::timer [after $::drive [list POST $ch]] } } finalize { catch { after cancel $::timer } after 500 {set ::forever now} } read { set ret $::data set ::data {} ; # Next is EOF. } } LOG "<- [info level 0] : $ret" return $ret } } -body { LOG BEGIN set ch [chan create {read} HANDLER] set tid [thread::create { proc LOG {text} { #puts stderr "\t\t\t\t\t\t[thread::id]: $text" return } LOG THREAD-STARTED load {} Tcltest proc bgerror s { LOG BGERROR:$s } vwait forever LOG THREAD-DONE }] testchannel cut $ch thread::send $tid [list set thech $ch] thread::send $tid [list set beat $beat] thread::send -async $tid { LOG SPLICE-BEG testchannel splice $thech LOG SPLICE-END proc PROCESS {ch} { LOG "-> [info level 0]" if {[eof $ch]} { close $ch set ::done 1 set c <> } else { set c [read $ch 1] } LOG "GOTCHAR: $c" LOG "<- [info level 0]" } LOG THREAD-FILEEVENT fconfigure $thech -translation binary -blocking 0 fileevent $thech readable [list PROCESS $thech] LOG THREAD-NOEVENT-LOOP set done 0 while {!$done} { after $beat LOG THREAD-HEARTBEAT update } LOG THREAD-LOOP-DONE #thread::exit # Thread exits cause leaks; Use clean thread shutdown set forever yourGirl } LOG MAIN_WAITING vwait forever LOG MAIN_DONE set res } -cleanup { after cancel $::timer rename LOG {} rename POST {} rename HANDLER {} unset beat drive data forever res tid ch timer } -match glob \ -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}} # --- === *** ########################### # method cgetall test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "-bar foo -snarf x" } set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "-bar" } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c} msg] note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}} test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "\{" } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c} msg] note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{cgetall rc*} 1 {unmatched open brace in list}} test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c} msg] note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{cgetall rc*} 1 BOOM!} test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code 777 BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -level 55 -code 777 BANG } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c} msg opt] note $msg noteOpts $opt close $c notes } c] rename foo {} set res } -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}} \ -constraints {testchannel thread} # --- === *** ########################### # method configure test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return } set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -translation lf] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{}} test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo bar} msg] note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} 1 BOOM!} test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body { set res {} proc foo {args} {oninit configure; onfinal; track; return} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -rc-foo bar] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} {}} test iocmd.tf-26.4 {chan configure, set option, break return is error} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo bar} msg] note $msg close $c notes } c] rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo bar} msg] note $msg close $c notes } c] rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -code 444 BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo bar} msg] note $msg close $c notes } c] rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body { set res {} proc foo {args} { oninit configure; onfinal; track return -level 55 -code 444 BANG } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo bar} msg opt] note $msg noteOpts $opt close $c notes } c] rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}} \ -constraints {testchannel thread} # --- === *** ########################### # method cget test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return foo} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -rc-foo] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{cget rc* -rc-foo} foo} test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo} msg] note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{cget rc* -rc-foo} 1 BOOM!} test iocmd.tf-27.3 {chan configure, get option, break return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo} msg] note $msg close $c notes } c] rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} \ -constraints {testchannel thread} test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo} msg] note $msg close $c notes } c] rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -code 333 BOOM! } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo} msg] note $msg close $c notes } c] rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return -level 77 -code 333 BANG } set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -rc-foo} msg opt] note $msg noteOpts $opt close $c notes } c] rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}} \ -constraints {testchannel thread} # --- === *** ########################### # method seek test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] notes [inthread $c { note [tell $c] close $c notes } c] rename foo {} set res } -result {-1} \ -constraints {testchannel thread} test iocmd.tf-28.2 {chan tell, error return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {tell $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} \ -constraints {testchannel thread} test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {tell $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {tell $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {tell $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG} set c [chan create {r w} foo] notes [inthread $c { note [catch {tell $c} msg opt] note $msg noteOpts $opt close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \ -constraints {testchannel thread} test iocmd.tf-28.7 {chan tell, regular return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return 88} set c [chan create {r w} foo] notes [inthread $c { note [tell $c] close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} 88} \ -constraints {testchannel thread} test iocmd.tf-28.8 {chan tell, negative return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -1} set c [chan create {r w} foo] notes [inthread $c { note [catch {tell $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} 1 {Tried to seek before origin}} \ -constraints {testchannel thread} test iocmd.tf-28.9 {chan tell, string return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return BOGUS} set c [chan create {r w} foo] notes [inthread $c { note [catch {tell $c} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} \ -constraints {testchannel thread} test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] notes [inthread $c { note [catch {seek $c 0 start} msg] note $msg close $c notes } c] rename foo {} set res } -result {1 {error during seek on "rc*": invalid argument}} \ -constraints {testchannel thread} test iocmd.tf-28.11 {chan seek, error return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {seek $c 0 start} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} \ -constraints {testchannel thread} test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {seek $c 0 start} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {seek $c 0 start} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {seek $c 0 start} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG} set c [chan create {r w} foo] notes [inthread $c { note [catch {seek $c 0 start} msg opt] note $msg noteOpts $opt close $c notes } c] rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \ -constraints {testchannel thread} test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -45} set c [chan create {r w} foo] notes [inthread $c { note [catch {seek $c 0 start} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 start} 1 {Tried to seek before origin}} \ -constraints {testchannel thread} test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return BOGUS} set c [chan create {r w} foo] notes [inthread $c { note [catch {seek $c 0 start} msg] note $msg close $c notes } c] rename foo {} set res } -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} \ -constraints {testchannel thread} test iocmd.tf-28.18 {chan seek, ok result} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return 23} set c [chan create {r w} foo] notes [inthread $c { note [seek $c 0 current] close $c notes } c] rename foo {} set res } -result {{seek rc* 0 current} {}} \ -constraints {testchannel thread} foreach {testname code} { iocmd.tf-28.19.0 start iocmd.tf-28.19.1 current iocmd.tf-28.19.2 end } { test $testname "chan seek, base conversion, $code" -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return 0} set c [chan create {r w} foo] notes [inthread $c { note [seek $c 0 $code] close $c notes } c code] rename foo {} set res } -result [list [list seek rc* 0 $code] {}] \ -constraints {testchannel thread} } # --- === *** ########################### # method blocking test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -blocking] close $c notes } c] rename foo {} set res } -result {1} \ -constraints {testchannel thread} test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -blocking 0] note [fconfigure $c -blocking] close $c notes } c] rename foo {} set res } -result {{} 0} \ -constraints {testchannel thread} test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -blocking] close $c notes } c] rename foo {} set res } -result {1} \ -constraints {testchannel thread} test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -blocking 0] note [fconfigure $c -blocking] close $c notes } c] rename foo {} set res } -result {{blocking rc* 0} {} 0} \ -constraints {testchannel thread} test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -blocking 1] note [fconfigure $c -blocking] close $c notes } c] rename foo {} set res } -result {{blocking rc* 1} {} 1} \ -constraints {testchannel thread} test iocmd.tf-29.6 {chan blocking, error return} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; error BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -blocking 0} msg] note $msg # Catch the close. It changes blocking mode internally, and runs into the error result. catch {close $c} notes } c] rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} \ -constraints {testchannel thread} test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -blocking 0} msg] note $msg catch {close $c} notes } c] rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -blocking 0} msg] note $msg catch {close $c} notes } c] rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!} set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -blocking 0} msg] note $msg catch {close $c} notes } c] rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} \ -constraints {testchannel thread} test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG} set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -blocking 0} msg opt] note $msg noteOpts $opt catch {close $c} notes } c] rename foo {} set res } -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} \ -constraints {testchannel thread} test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return BOGUS} set c [chan create {r w} foo] notes [inthread $c { note [catch {fconfigure $c -blocking 0} msg] note $msg catch {close $c} notes } c] rename foo {} set res } -result {{blocking rc* 0} 0 {}} \ -constraints {testchannel thread} # --- === *** ########################### # method watch test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return IGNORED} set c [chan create {r w} foo] notes [inthread $c { note [fileevent $c readable {set tick $tick}] close $c ;# 2nd watch, interest zero. notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{watch rc* read} {watch rc* {}} {}} test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED} set c [chan create {r w} foo] notes [inthread $c { note [fileevent $c writable {set tick $tick}] note [fileevent $c writable {}] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} -result {{watch rc* write} {watch rc* {}} {} {}} test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] notes [inthread $c { note [fileevent $c writable {set tick $tick}] note [fileevent $c readable {set tick $tick}] note [fileevent $c writable {}] note [fileevent $c readable {}] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{watch rc* write} {watch rc* {read write}} {watch rc* read} {watch rc* {}} {} {} {} {}} test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] notes [inthread $c { note [fileevent $c writable {set tick $tick}] note [fileevent $c readable {set tick $tick}] ;# Script is changing, note [fileevent $c readable {set tock $tock}] ;# interest does not. close $c ;# 3rd and 4th watch, removing the event handlers. notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}} # --- === *** ########################### # postevent # Not possible from a thread not containing the command handler. # Check that this is rejected. test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] notes [inthread $c { catch {chan postevent $c r} msg note $msg close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{can not find reflected channel named "rc*"}} # --- === *** ########################### # 'Pull the rug' tests. Create channel in a thread A, move to other # thread B, destroy the origin thread (A) before or during access from # B. Must not crash, must return proper errors. test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body { #puts <<$tcltest::mainThread>>main set tida [thread::create -preserved];#puts <<$tida>> thread::send $tida {load {} Tcltest} set tidb [thread::create -preserved];#puts <<$tidb>> thread::send $tidb {load {} Tcltest} # Set up channel in thread thread::send $tida $helperscript set chan [thread::send $tida { proc foo {args} {oninit seek; onfinal; track; return} set chan [chan create {r w} foo] fconfigure $chan -buffering none set chan }] # Move channel to 2nd thread. thread::send $tida [list testchannel cut $chan] thread::send $tidb [list testchannel splice $chan] # Kill origin thread, then access channel from 2nd thread. thread::release $tida set res {} lappend res [catch {thread::send $tidb [list puts $chan shoo]} msg] $msg lappend res [catch {thread::send $tidb [list tell $chan]} msg] $msg lappend res [catch {thread::send $tidb [list seek $chan 1]} msg] $msg lappend res [catch {thread::send $tidb [list gets $chan]} msg] $msg lappend res [catch {thread::send $tidb [list close $chan]} msg] $msg thread::release $tidb set res } -constraints {testchannel thread} \ -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} # The test iocmd.tf-32.1 unavoidably exhibits a memory leak. We are testing # the ability of the reflected channel system to react to the situation where # the thread in which the driver routines runs exits during driver operations. # In this case, thread exit handlers signal back to the owner thread so that the # channel operation does not hang. There's no way to test this without actually # exiting a thread in mid-operation, and that action is unavoidably leaky (which # is why [thread::exit] is advised against). # # Use constraints to skip this test while valgrinding so this expected leak # doesn't prevent a finding of "leak-free". # test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body { #puts <<$tcltest::mainThread>>main set tida [thread::create -preserved];#puts <<$tida>> thread::send $tida {load {} Tcltest} set tidb [thread::create -preserved];#puts <<$tidb>> thread::send $tidb {load {} Tcltest} # Set up channel in thread thread::send $tida $helperscript set chan [thread::send $tida { proc foo {args} { oninit; onfinal; track; # destroy thread during channel access thread::exit } set chan [chan create {r w} foo] fconfigure $chan -buffering none set chan }] # Move channel to 2nd thread. thread::send $tida [list testchannel cut $chan] thread::send $tidb [list testchannel splice $chan] # Run access from thread B, wait for response from A (A is not # using event loop at this point, so the event pile up in the # queue. thread::send $tidb [list set chan $chan] thread::send $tidb [list set mid [thread::id]] thread::send -async $tidb { # wait a bit, give the main thread the time to start its event # loop to wait for the response from B after 2000 catch { puts $chan shoo } res thread::send -async $mid [list set ::res $res] } vwait ::res catch {thread::release $tida} thread::release $tidb set res } -constraints {testchannel thread notValgrind} \ -result {Owner lost} # ### ### ### ######### ######### ######### # ### ### ### ######### ######### ######### rename track {} # cleanup # Eliminate valgrind "still reachable" reports on outstanding "Detached" # structures in the detached list which stem from PipeClose2Proc not waiting # around for background processes to complete, meaning that previous calls to # Tcl_ReapDetachedProcs might not have had a chance to reap all processes. after 10 exec [info nameofexecutable] << {} foreach file [list test1 test2 test3 test4] { removeFile $file } # delay long enough for background processes to finish after 500 removeFile test5 cleanupTests return tcl8.6.14/tests/iogt.test0000644000175000017500000006102714554262142014655 0ustar sergeisergei# -*- tcl -*- # Commands covered: transform, and stacking in general # # This file contains a collection of tests for Giot # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 2000 Ajuba Solutions. # Copyright (c) 2000 Andreas Kupries. # All rights reserved. if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." return } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] namespace eval ::tcl::test::iogt { namespace import ::tcltest::* testConstraint testchannel [llength [info commands testchannel]] set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-= } dummy] # " capture coloring of quotes set path(dummyout) [makeFile {} dummyout] set path(__echo_srv__.tcl) [makeFile { #!/usr/local/bin/tclsh # -*- tcl -*- # echo server # # arguments, options: port to listen on for connections. # delay till echo of first block # delay between blocks # blocksize ... set port [lindex $argv 0] set fdelay [lindex $argv 1] set idelay [lindex $argv 2] set bsizes [lrange $argv 3 end] set c 0 proc newconn {sock rhost rport} { variable fdelay variable c incr c namespace upvar [namespace current] c$c conn #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout set conn(after) {} set conn(state) 0 set conn(size) 0 set conn(data) "" set conn(delay) $fdelay fileevent $sock readable [list echoGet $c $sock] fconfigure $sock -translation binary -buffering none -blocking 0 } proc echoGet {c sock} { variable fdelay namespace upvar [namespace current] c$c conn if {[eof $sock]} { # one-shot echo exit } append conn(data) [read $sock] #puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout if {$conn(after) == {}} { set conn(after) [after $conn(delay) [list echoPut $c $sock]] } } proc echoPut {c sock} { variable idelay variable fdelay variable bsizes namespace upvar [namespace current] c$c conn if {[string length $conn(data)] == 0} { #puts stdout "C $c $sock" ; flush stdout # auto terminate close $sock exit #set conn(delay) $fdelay return } set conn(delay) $idelay set n [lindex $bsizes $conn(size)] #puts stdout "P $c $sock $n >>" ; flush stdout #puts __________________________________________ #parray conn #puts n=<$n> if {[string length $conn(data)] >= $n} { puts -nonewline $sock [string range $conn(data) 0 $n] set conn(data) [string range $conn(data) [incr n] end] } incr conn(size) if {$conn(size) >= [llength $bsizes]} { set conn(size) [expr {[llength $bsizes]-1}] } set conn(after) [after $conn(delay) [list echoPut $c $sock]] } #fileevent stdin readable {exit ;#cut} # main socket -server newconn -myaddr 127.0.0.1 $port vwait forever } __echo_srv__.tcl] ######################################################################## proc fevent {fdelay idelay blocks script data} { # Start and initialize an echo server, prepare data transmission, then # hand over to the test script. This has to start real transmission via # 'flush'. The server is stopped after completion of the test. upvar 1 sock sk # Fixed port, not so good. Lets hope for the best, for now. set port 4000 exec tclsh __echo_srv__.tcl $port $fdelay $idelay {*}$blocks >@stdout & after 500 #puts stdout "> $port"; flush stdout set sk [socket localhost $port] fconfigure $sk -blocking 0 -buffering full \ -buffersize [expr {10+[llength $data]}] puts -nonewline $sk $data # The channel is prepared to go off. #puts stdout ">>>>>"; flush stdout set res [uplevel 1 $script] catch {close $sk} return $res } # -------------------------------------------------------------- # utility transformations ... proc id {op data} { switch -- $op { create/write - create/read - delete/write - delete/read - clear_read { #ignore } flush/write - flush/read - write - read { return $data } query/maxRead { return -1 } } } proc id_optrail {var op data} { variable $var upvar 0 $var trail lappend trail $op switch -- $op { create/write - create/read - delete/write - delete/read - flush/read - clear/read { #ignore } flush/write - write - read { return $data } query/maxRead { return -1 } default { lappend trail "error $op" error $op } } } proc id_fulltrail {var op data} { namespace upvar [namespace current] $var trail #puts stdout ">> $var $op $data" ; flush stdout switch -- $op { create/write - create/read - delete/write - delete/read - clear_read { set res *ignored* } flush/write - flush/read - write - read { set res $data } query/maxRead { set res -1 } } #catch {puts stdout "\t>* $res" ; flush stdout} #catch {puts stdout "x$res"} msg lappend trail [list $op $data $res] return $res } proc id_torture {chan op data} { switch -- $op { create/write - create/read - delete/write - delete/read - clear_read {;#ignore} flush/write - flush/read {} write { global level if {$level} { return } incr level testchannel unstack $chan testchannel transform $chan \ -command [namespace code [list id_torture $chan]] return $data } read { testchannel unstack $chan testchannel transform $chan \ -command [namespace code [list id_torture $chan]] return $data } query/maxRead {return -1} } } proc counter {var op data} { namespace upvar [namespace current] $var n switch -- $op { create/write - create/read - delete/write - delete/read - clear_read { #ignore } flush/write - flush/read { return {} } write { return $data } read { if {$n > 0} { incr n -[string length $data] if {$n < 0} { set n 0 } } return $data } query/maxRead { return $n } } } proc counter_audit {var vtrail op data} { namespace upvar [namespace current] $var n $vtrail trail switch -- $op { create/write - create/read - delete/write - delete/read - clear_read { set res {} } flush/write - flush/read { set res {} } write { set res $data } read { if {$n > 0} { incr n -[string length $data] if {$n < 0} { set n 0 } } set res $data } query/maxRead { set res $n } } lappend trail [list counter:$op $data $res] return $res } proc rblocks {var vtrail n op data} { namespace upvar [namespace current] $var buf $vtrail trail set res {} switch -- $op { create/write - create/read - delete/write - delete/read - clear_read { set buf {} } flush/write { } flush/read { set res $buf set buf {} } write { set data } read { append buf $data set b [expr {$n * ([string length $buf] / $n)}] append op " $n [string length $buf] :- $b" set res [string range $buf 0 [incr b -1]] set buf [string range $buf [incr b] end] #return $res } query/maxRead { set res -1 } } lappend trail [list rblock | $op $data $res | $buf] return $res } # -------------------------------------------------------------- # ... and convenience procedures to stack them proc identity {-attach channel} { testchannel transform $channel -command [namespace code id] } proc audit_ops {var -attach channel} { testchannel transform $channel -command [namespace code [list id_optrail $var]] } proc audit_flow {var -attach channel} { testchannel transform $channel -command [namespace code [list id_fulltrail $var]] } proc torture {-attach channel} { testchannel transform $channel -command [namespace code [list id_torture $channel]] } proc stopafter {var n -attach channel} { namespace upvar [namespace current] $var vn set vn $n testchannel transform $channel -command [namespace code [list counter $var]] } proc stopafter_audit {var trail n -attach channel} { namespace upvar [namespace current] $var vn set vn $n testchannel transform $channel -command [namespace code [list counter_audit $var $trail]] } proc rblocks_t {var trail n -attach channel} { testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]] } # -------------------------------------------------------------- # serialize an array, with keys in sorted order. proc array_sget {v} { upvar $v a set res [list] foreach n [lsort [array names a]] { lappend res $n $a($n) } set res } proc asort {alist} { # sort a list of key/value pairs by key, removes duplicates too. array set a $alist array_sget a } ######################################################################## test iogt-1.1 {stack/unstack} testchannel { set fh [open $path(dummy) r] identity -attach $fh testchannel unstack $fh close $fh } {} test iogt-1.2 {stack/close} testchannel { set fh [open $path(dummy) r] identity -attach $fh close $fh } {} test iogt-1.3 {stack/unstack, configuration, options} testchannel { set fh [open $path(dummy) r] set ca [asort [fconfigure $fh]] identity -attach $fh set cb [asort [fconfigure $fh]] testchannel unstack $fh set cc [asort [fconfigure $fh]] close $fh # With this system none of the buffering, translation and encoding option # may change their values with channels stacked upon each other or not. # cb == ca == cc list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc] } {1 1 1} test iogt-1.4 {stack/unstack, configuration} -setup { set fh [open $path(dummy) r] } -constraints testchannel -body { set ca [asort [fconfigure $fh]] identity -attach $fh fconfigure $fh -buffering line -translation cr -encoding shiftjis testchannel unstack $fh set cc [asort [fconfigure $fh]] list [string equal $ca $cc] [fconfigure $fh -buffering] \ [fconfigure $fh -translation] [fconfigure $fh -encoding] } -cleanup { close $fh } -result {0 line cr shiftjis} test iogt-2.0 {basic I/O going through transform} -setup { set fin [open $path(dummy) r] set fout [open $path(dummyout) w] } -constraints testchannel -body { identity -attach $fin identity -attach $fout fcopy $fin $fout close $fin close $fout set fin [open $path(dummy) r] set fout [open $path(dummyout) r] list [string equal [set in [read $fin]] [set out [read $fout]]] \ [string length $in] [string length $out] } -cleanup { close $fin close $fout } -result {1 71 71} test iogt-2.1 {basic I/O, operation trail} {testchannel unix} { set fin [open $path(dummy) r] set fout [open $path(dummyout) w] set ain [list]; set aout [list] audit_ops ain -attach $fin audit_ops aout -attach $fout fconfigure $fin -buffersize 10 fconfigure $fout -buffersize 10 fcopy $fin $fout close $fin close $fout set res "[join $ain \n]\n--------\n[join $aout \n]" } {create/read query/maxRead read query/maxRead read query/maxRead read query/maxRead read query/maxRead read query/maxRead read query/maxRead read query/maxRead read query/maxRead flush/read query/maxRead delete/read -------- create/write write write write write write write write write flush/write delete/write} test iogt-2.2 {basic I/O, data trail} {testchannel unix} { set fin [open $path(dummy) r] set fout [open $path(dummyout) w] set ain [list]; set aout [list] audit_flow ain -attach $fin audit_flow aout -attach $fout fconfigure $fin -buffersize 10 fconfigure $fout -buffersize 10 fcopy $fin $fout close $fin close $fout set res "[join $ain \n]\n--------\n[join $aout \n]" } {create/read {} *ignored* query/maxRead {} -1 read abcdefghij abcdefghij query/maxRead {} -1 read klmnopqrst klmnopqrst query/maxRead {} -1 read uvwxyz0123 uvwxyz0123 query/maxRead {} -1 read 456789,./? 456789,./? query/maxRead {} -1 read {><;'\|":[]} {><;'\|":[]} query/maxRead {} -1 read {\}\{`~!@#$} {\}\{`~!@#$} query/maxRead {} -1 read %^&*()_+-= %^&*()_+-= query/maxRead {} -1 read { } { } query/maxRead {} -1 flush/read {} {} query/maxRead {} -1 delete/read {} *ignored* -------- create/write {} *ignored* write abcdefghij abcdefghij write klmnopqrst klmnopqrst write uvwxyz0123 uvwxyz0123 write 456789,./? 456789,./? write {><;'\|":[]} {><;'\|":[]} write {\}\{`~!@#$} {\}\{`~!@#$} write %^&*()_+-= %^&*()_+-= write { } { } flush/write {} {} delete/write {} *ignored*} test iogt-2.3 {basic I/O, mixed trail} {testchannel unix} { set fin [open $path(dummy) r] set fout [open $path(dummyout) w] set trail [list] audit_flow trail -attach $fin audit_flow trail -attach $fout fconfigure $fin -buffersize 20 fconfigure $fout -buffersize 10 fcopy $fin $fout close $fin close $fout join $trail \n } {create/read {} *ignored* create/write {} *ignored* query/maxRead {} -1 read abcdefghijklmnopqrst abcdefghijklmnopqrst write abcdefghij abcdefghij write klmnopqrst klmnopqrst query/maxRead {} -1 read uvwxyz0123456789,./? uvwxyz0123456789,./? write uvwxyz0123 uvwxyz0123 write 456789,./? 456789,./? query/maxRead {} -1 read {><;'\|":[]\}\{`~!@#$} {><;'\|":[]\}\{`~!@#$} write {><;'\|":[]} {><;'\|":[]} write {\}\{`~!@#$} {\}\{`~!@#$} query/maxRead {} -1 read {%^&*()_+-= } {%^&*()_+-= } query/maxRead {} -1 flush/read {} {} write %^&*()_+-= %^&*()_+-= write { } { } query/maxRead {} -1 delete/read {} *ignored* flush/write {} {} delete/write {} *ignored*} test iogt-2.4 {basic I/O, mixed trail} {testchannel} { set fh [open $path(dummy) r] torture -attach $fh chan configure $fh -buffersize 2 set x [read $fh] testchannel unstack $fh close $fh set x } {} test iogt-2.5 {basic I/O, mixed trail} {testchannel} { set ::level 0 set fh [open $path(dummyout) w] torture -attach $fh puts -nonewline $fh abcdef flush $fh testchannel unstack $fh close $fh } {} test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup { proc DoneCopy {n {err {}}} { variable copy 1 } } -constraints {testchannel knownBug} -body { # This test to check the validity of acquired Tcl_Channel references is not # possible because even a backgrounded fcopy will immediately start to # copy data, without waiting for the event loop. This is done only in case # of an underflow on the read size!. So stacking transforms after the # fcopy will miss information, or are not used at all. # # I was able to circumvent this by using the echo.tcl server with a big # delay, causing the fcopy to underflow immediately. set fin [open $path(dummy) r] fevent 1000 500 {20 20 20 10 1 1} { variable copy close $fin set fout [open dummyout w] flush $sock; # now, or fcopy will error us out # But the 1 second delay should be enough to initialize everything # else here. fcopy $sock $fout -command [namespace code DoneCopy] # Transform after fcopy got its handles! They should be still valid # for fcopy. set trail [list] audit_ops trail -attach $fout vwait [namespace which -variable copy] } [read $fin]; # {} close $fout # Check result of copy. set fin [open $path(dummy) r] set fout [open $path(dummyout) r] set res [string equal [read $fin] [read $fout]] close $fin close $fout list $res $trail } -cleanup { rename DoneCopy {} } -result {1 {create/write create/read write flush/write flush/read delete/write delete/read}} test iogt-4.0 {fileevent readable, after transform} -setup { set fin [open $path(dummy) r] set data [read $fin] close $fin set trail [list] set got [list] proc Done {args} { variable stop 1 } proc Get {sock} { variable trail variable got if {[eof $sock]} { Done lappend trail "xxxxxxxxxxxxx" close $sock return } lappend trail "vvvvvvvvvvvvv" lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]" lappend trail "=============" #puts stdout $__ ; flush stdout #read $sock } } -constraints {testchannel knownBug} -body { fevent 1000 500 {20 20 20 10 1} { variable stop audit_flow trail -attach $sock rblocks_t rbuf trail 23 -attach $sock fileevent $sock readable [namespace code [list Get $sock]] flush $sock; # Now, or fcopy will error us out # But the 1 second delay should be enough to initialize everything # else here. vwait [namespace which -variable stop] } $data join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n } -cleanup { rename Done {} rename Get {} } -result {[[]] [[abcdefghijklmnopqrstuvw]] [[xyz0123456789,./?><;'\|]] [[]] [[]] [[":[]\}\{`~!@#$%^&*()]] [[]] ~~~~~~~~ create/write {} *ignored* create/read {} *ignored* rblock | create/write {} {} | {} rblock | create/read {} {} | {} vvvvvvvvvvvvv rblock | query/maxRead {} -1 | {} query/maxRead {} -1 read abcdefghijklmnopqrstu abcdefghijklmnopqrstu query/maxRead {} -1 rblock | {read 23 21 :- 0} abcdefghijklmnopqrstu {} | abcdefghijklmnopqrstu rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu query/maxRead {} -1 got: {[[]]} ============= vvvvvvvvvvvvv rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu query/maxRead {} -1 read vwxyz0123456789,./?>< vwxyz0123456789,./?>< query/maxRead {} -1 rblock | {read 23 42 :- 23} vwxyz0123456789,./?>< abcdefghijklmnopqrstuvw | xyz0123456789,./?>< rblock | query/maxRead {} -1 | xyz0123456789,./?>< query/maxRead {} -1 got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} ============= vvvvvvvvvvvvv rblock | query/maxRead {} -1 | xyz0123456789,./?>< query/maxRead {} -1 read {;'\|":[]\}\{`~!@#$%^&} {;'\|":[]\}\{`~!@#$%^&} query/maxRead {} -1 rblock | {read 23 40 :- 23} {;'\|":[]\}\{`~!@#$%^&} {xyz0123456789,./?><;'\|} | {":[]\}\{`~!@#$%^&} rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&} query/maxRead {} -1 got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} ============= vvvvvvvvvvvvv rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&} query/maxRead {} -1 read *( *( query/maxRead {} -1 rblock | {read 23 19 :- 0} *( {} | {":[]\}\{`~!@#$%^&*(} rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(} query/maxRead {} -1 got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} ============= vvvvvvvvvvvvv rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(} query/maxRead {} -1 read ) ) query/maxRead {} -1 rblock | {read 23 20 :- 0} ) {} | {":[]\}\{`~!@#$%^&*()} rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()} query/maxRead {} -1 got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} ============= vvvvvvvvvvvvv rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()} query/maxRead {} -1 flush/read {} {} rblock | flush/read {} {":[]\}\{`~!@#$%^&*()} | {} rblock | query/maxRead {} -1 | {} query/maxRead {} -1 got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} ============= vvvvvvvvvvvvv rblock | query/maxRead {} -1 | {} query/maxRead {} -1 got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} {[[]]} xxxxxxxxxxxxx rblock | flush/write {} {} | {} rblock | delete/write {} {} | {} rblock | delete/read {} {} | {} flush/write {} {} delete/write {} *ignored* delete/read {} *ignored*}; # catch unescaped quote " test iogt-5.0 {EOF simulation} -setup { set fin [open $path(dummy) r] set fout [open $path(dummyout) w] set trail [list] } -constraints {testchannel knownBug} -result { audit_flow trail -attach $fin stopafter_audit d trail 20 -attach $fin audit_flow trail -attach $fout fconfigure $fin -buffersize 20 fconfigure $fout -buffersize 10 fcopy $fin $fout testchannel unstack $fin # now copy the rest in the channel lappend trail {**after unstack**} fcopy $fin $fout close $fin close $fout join $trail \n } -result {create/read {} *ignored* counter:create/read {} {} create/write {} *ignored* counter:query/maxRead {} 20 query/maxRead {} -1 read {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-= } {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-= } query/maxRead {} -1 flush/read {} {} counter:read abcdefghijklmnopqrst abcdefghijklmnopqrst write abcdefghij abcdefghij write klmnopqrst klmnopqrst counter:query/maxRead {} 0 counter:flush/read {} {} counter:delete/read {} {} **after unstack** query/maxRead {} -1 write uvwxyz0123 uvwxyz0123 write 456789,./? 456789,./? write {><;'\|":[]} {><;'\|":[]} write {\}\{`~!@#$} {\}\{`~!@#$} write %^&*()_+-= %^&*()_+-= write { } { } query/maxRead {} -1 delete/read {} *ignored* flush/write {} {} delete/write {} *ignored*} proc constX {op data} { # replace anything coming in with a same-length string of x'es. switch -- $op { create/write - create/read - delete/write - delete/read - clear_read { #ignore } flush/write - flush/read - write - read { return [string repeat x [string length $data]] } query/maxRead { return -1 } } } proc constx {-attach channel} { testchannel transform $channel -command [namespace code constX] } test iogt-6.0 {Push back} -constraints testchannel -body { set f [open $path(dummy) r] # contents of dummy = "abcdefghi..." read $f 3; # skip behind "abc" constx -attach $f # expect to get "xxx" from the transform because of unread "def" input to # transform which returns "xxx". # # Actually the IO layer preread the whole file and will read "def" # directly from the buffer without bothering to consult the newly stacked # transformation. This is wrong. read $f 3 } -cleanup { close $f } -result {xxx} test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body { # This test demonstrates the bug/misfeature in the stacked # channel implementation that data can be discarded if it is # read into the buffers of one channel in the stack, and then # that channel is popped before anything above it reads. # # This bug can be worked around by always setting -buffersize # to 1, but who wants to do that? set f [open $path(dummy) r] # contents of dummy = "abcdefghi..." read $f 3; # skip behind "abc" constx -attach $f set res [read $f 3] testchannel unstack $f append res [read $f 3] } -cleanup { close $f } -result {xxxghi} # Driver for a base channel that emits several short "files" # with each terminated by a fleeting EOF proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) ..... return {initialize finalize watch read} } finalize { if {![info exists index($chan)]} {return} unset index($chan) buffer($chan) return } watch {} read { set n [lindex $args 1] if {![info exists index($chan)]} { driver initialize $chan } set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new if {[string length $result] == 0} { driver finalize $chan } return $result } } } test iogt-7.0 {Handle fleeting EOF} -constraints {testchannel} -body { set chan [chan create read [namespace which driver]] identity -attach $chan list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} proc delay {op data} { variable store switch -- $op { create/write - create/read - delete/write - delete/read - flush/write - write - clear_read {;#ignore} flush/read - read { if {![info exists store]} {set store {}} set reply $store set store $data return $reply } query/maxRead {return -1} } } test iogt-7.1 {Handle fleeting EOF} -constraints {testchannel} -body { set chan [chan create read [namespace which driver]] testchannel transform $chan -command [namespace code delay] list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} rename delay {} rename driver {} # cleanup foreach file [list dummy dummyout __echo_srv__.tcl] { removeFile $file } cleanupTests } namespace delete ::tcl::test::iogt return tcl8.6.14/tests/io.test0000644000175000017500000100604614554262142014323 0ustar sergeisergei# -*- tcl -*- # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. namespace eval ::tcl::test::io { if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } variable umaskValue variable path variable f variable i variable n variable v variable msg variable expected catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] } source [file join [file dirname [info script]] tcltests.tcl] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] testConstraint testservicemode [llength [info commands testservicemode]] # Some things fail under Windows in Continuous Integration systems for subtle # reasons such as CI often running with elevated privileges in a container. testConstraint notWinCI [expr { $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}] testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] # File permissions broken on wsl without some "exotic" wsl configuration testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. set umaskValue 0 testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}] testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}] # set up a long data file for some of the following tests set path(longfile) [makeFile {} longfile] set f [open $path(longfile) w] fconfigure $f -eofchar {} -translation lf for { set i 0 } { $i < 100 } { incr i} { puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef \#123456789abcdef01 \#" } close $f set path(cat) [makeFile { set f stdin if {$argv != ""} { set f [open [lindex $argv 0]] } fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A fconfigure stdout -encoding binary -translation lf -buffering none fileevent $f readable "foo $f" proc foo {f} { set x [read $f] catch {puts -nonewline $x} if {[eof $f]} { close $f exit 0 } } vwait forever } cat] set thisScript [file join [pwd] [info script]] proc contents {file} { set f [open $file] fconfigure $f -translation binary set a [read $f] close $f return $a } test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} { # no test, need to cause an async error. } {} set path(test1) [makeFile {} test1] test io-1.6 {Tcl_WriteChars: WriteBytes} { set f [open $path(test1) w] fconfigure $f -encoding binary puts -nonewline $f "a\u4E4D\x00" close $f contents $path(test1) } "a\x4D\x00" test io-1.7 {Tcl_WriteChars: WriteChars} { set f [open $path(test1) w] fconfigure $f -encoding shiftjis puts -nonewline $f "a\u4E4D\x00" close $f contents $path(test1) } "a\x93\xE1\x00" set path(test2) [makeFile {} test2] test io-1.8 {Tcl_WriteChars: WriteChars} { # This test written for SF bug #506297. # # Executing this test without the fix for the referenced bug # applied to tcl will cause tcl, more specifically WriteChars, to # go into an infinite loop. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp puts -nonewline $f [format %s%c [string repeat " " 4] 12399] close $f contents $path(test2) } " \x1B\$B\$O\x1B(B" test io-1.9 {Tcl_WriteChars: WriteChars} { # When closing a channel with an encoding that appends # escape bytes, check for the case where the escape # bytes overflow the current IO buffer. The bytes # should be moved into a new buffer. set data "1234567890 [format %c 12399]" set sizes [list] # With default buffer size set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] # With buffer size equal to the length # of the data, the escape bytes would # go into the next buffer. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp -buffersize 16 puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] # With buffer size that is large enough # to hold 1 byte of escaped data, but # not all 3. This should not write # the escape bytes to the first buffer # and then again to the second buffer. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp -buffersize 17 puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] # With buffer size that can hold 2 out of # 3 bytes of escaped data. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp -buffersize 18 puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] # With buffer size that can hold all the # data and escape bytes. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp -buffersize 19 puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] set sizes } {19 19 19 19 19} test io-2.1 {WriteBytes} { # loop until all bytes are written set f [open $path(test1) w] fconfigure $f -encoding binary -buffersize 16 -translation crlf puts $f "abcdefghijklmnopqrstuvwxyz" close $f contents $path(test1) } "abcdefghijklmnopqrstuvwxyz\r\n" test io-2.2 {WriteBytes: savedLF > 0} { # After flushing buffer, there was a \n left over from the last # \n -> \r\n expansion. It gets stuck at beginning of this buffer. set f [open $path(test1) w] fconfigure $f -encoding binary -buffersize 16 -translation crlf puts -nonewline $f "123456789012345\n12" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "123456789012345\r" "123456789012345\r\n12"] test io-2.3 {WriteBytes: flush on line} { # Tcl "line" buffering has weird behavior: if current buffer contains # a \n, entire buffer gets flushed. Logical behavior would be to flush # only up to the \n. set f [open $path(test1) w] fconfigure $f -encoding binary -buffering line -translation crlf puts -nonewline $f "\n12" set x [contents $path(test1)] close $f set x } "\r\n12" test io-2.4 {WriteBytes: reset sawLF after each buffer} { set f [open $path(test1) w] fconfigure $f -encoding binary -buffering line -translation lf \ -buffersize 16 puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"] test io-3.1 {WriteChars: compatibility with WriteBytes} { # loop until all bytes are written set f [open $path(test1) w] fconfigure $f -encoding ascii -buffersize 16 -translation crlf puts $f "abcdefghijklmnopqrstuvwxyz" close $f contents $path(test1) } "abcdefghijklmnopqrstuvwxyz\r\n" test io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} { # After flushing buffer, there was a \n left over from the last # \n -> \r\n expansion. It gets stuck at beginning of this buffer. set f [open $path(test1) w] fconfigure $f -encoding ascii -buffersize 16 -translation crlf puts -nonewline $f "123456789012345\n12" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "123456789012345\r" "123456789012345\r\n12"] test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} { # Tcl "line" buffering has weird behavior: if current buffer contains # a \n, entire buffer gets flushed. Logical behavior would be to flush # only up to the \n. set f [open $path(test1) w] fconfigure $f -encoding ascii -buffering line -translation crlf puts -nonewline $f "\n12" set x [contents $path(test1)] close $f set x } "\r\n12" test io-3.4 {WriteChars: loop over stage buffer} -body { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] fconfigure $f -encoding jis0208 -buffersize 16 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } -cleanup { catch {close $f} } -result [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test io-3.5 {WriteChars: saved != 0} -body { # Bytes produced by UtfToExternal from end of last channel buffer # had to be moved to beginning of next channel buffer to preserve # requested buffersize. set f [open $path(test1) w] fconfigure $f -encoding jis0208 -buffersize 17 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } -cleanup { catch {close $f} } -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} { # One incomplete UTF-8 character at end of staging buffer. Backup # in src to the beginning of that UTF-8 character and try again. # # Translate the first 16 bytes, produce 14 bytes of output, 2 left over # (first two bytes of \uFF21 in UTF-8). Given those two bytes try # translating them again, find that no bytes are read produced, and break # to outer loop where those two bytes will have the remaining 4 bytes # (the last byte of \uFF21 plus the all of \uFF22) appended. set f [open $path(test1) w] fconfigure $f -encoding shiftjis -buffersize 16 puts -nonewline $f "12345678901234\uFF21\uFF22" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"] test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body { # When translating UTF-8 to external, the produced bytes went past end # of the channel buffer. This is done purpose -- we then truncate the # bytes at the end of the partial character to preserve the requested # blocksize on flush. The truncated bytes are moved to the beginning # of the next channel buffer. set f [open $path(test1) w] fconfigure $f -encoding jis0208 -buffersize 17 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } -cleanup { catch {close $f} } -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test io-3.8 {WriteChars: reset sawLF after each buffer} { set f [open $path(test1) w] fconfigure $f -encoding ascii -buffering line -translation lf \ -buffersize 16 puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"] test io-3.9 {Write: flush line-buffered channels when crlf is split over two buffers} -body { # https://core.tcl-lang.org/tcllib/tktedit?name=c9d8a52fe set f [open $path(test1) w] fconfigure $f -buffering line -translation crlf -buffersize 8 puts $f "1234567" string map {"\r" "" "\n" ""} [contents $path(test1)] } -cleanup { close $f } -result "1234567" test io-4.1 {TranslateOutputEOL: lf} { # search for \n set f [open $path(test1) w] fconfigure $f -buffering line -translation lf puts $f "abcde" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "abcde\n" "abcde\n"] test io-4.2 {TranslateOutputEOL: cr} { # search for \n, replace with \r set f [open $path(test1) w] fconfigure $f -buffering line -translation cr puts $f "abcde" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "abcde\r" "abcde\r"] test io-4.3 {TranslateOutputEOL: crlf} { # simple case: search for \n, replace with \r set f [open $path(test1) w] fconfigure $f -buffering line -translation crlf puts $f "abcde" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "abcde\r\n" "abcde\r\n"] test io-4.4 {TranslateOutputEOL: crlf} { # keep storing more bytes in output buffer until output buffer is full. # We have 13 bytes initially that would turn into 18 bytes. Fill # dest buffer while (dstEnd < dstMax). set f [open $path(test1) w] fconfigure $f -translation crlf -buffersize 16 puts -nonewline $f "1234567\n\n\n\n\nA" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"] test io-4.5 {TranslateOutputEOL: crlf} { # Check for overflow of the destination buffer set f [open $path(test1) w] fconfigure $f -translation crlf -buffersize 12 puts -nonewline $f "12345678901\n456789012345678901234" close $f set x [contents $path(test1)] } "12345678901\r\n456789012345678901234" test io-5.1 {CheckFlush: not full} { set f [open $path(test1) w] fconfigure $f puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "" "12345678901234567890"] test io-5.2 {CheckFlush: full} { set f [open $path(test1) w] fconfigure $f -buffersize 16 puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "1234567890123456" "12345678901234567890"] test io-5.3 {CheckFlush: not line} { set f [open $path(test1) w] fconfigure $f -buffering line puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "" "12345678901234567890"] test io-5.4 {CheckFlush: line} { set f [open $path(test1) w] fconfigure $f -buffering line -translation lf -encoding ascii puts -nonewline $f "1234567890\n1234567890" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "1234567890\n1234567890" "1234567890\n1234567890"] test io-5.5 {CheckFlush: none} { set f [open $path(test1) w] fconfigure $f -buffering none puts -nonewline $f "1234567890" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "1234567890" "1234567890"] test io-6.1 {Tcl_GetsObj: working} { set f [open $path(test1) w] puts $f "foo\nboo" close $f set f [open $path(test1)] set x [gets $f] close $f set x } {foo} test io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} emptyTest { # no test, need to cause an async error. } {} test io-6.3 {Tcl_GetsObj: how many have we used?} { # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved} set f [open $path(test1) w] fconfigure $f -translation crlf puts $f "abc\ndefg" close $f set f [open $path(test1)] set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line] close $f set x } {0 3 5 4 defg} test io-6.4 {Tcl_GetsObj: encoding == NULL} { set f [open $path(test1) w] fconfigure $f -translation binary puts $f "\x81\u1234\x00" close $f set f [open $path(test1)] fconfigure $f -translation binary set x [list [gets $f line] $line] close $f set x } [list 3 "\x81\x34\x00"] test io-6.5 {Tcl_GetsObj: encoding != NULL} { set f [open $path(test1) w] fconfigure $f -translation binary puts $f "\x88\xEA\x92\x9A" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis set x [list [gets $f line] $line] close $f set x } [list 2 "\u4E00\u4E01"] set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" append a $a append a $a test io-6.6 {Tcl_GetsObj: loop test} { # if (dst >= dstEnd) set f [open $path(test1) w] puts $f $a puts $f hi close $f set f [open $path(test1)] set x [list [gets $f line] $line] close $f set x } [list 256 $a] test io-6.7 {Tcl_GetsObj: error in input} stdio { # if (FilterInputBytes(chanPtr, &gs) != 0) set f [open "|[list [interpreter] $path(cat)]" w+] puts -nonewline $f "hi\nwould" flush $f gets $f fconfigure $f -blocking 0 set x [gets $f line] close $f set x } {-1} test io-6.8 {Tcl_GetsObj: remember if EOF is seen} { set f [open $path(test1) w] puts $f "abcdef\x1Aghijk\nwombat" close $f set f [open $path(test1)] fconfigure $f -eofchar \x1A set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {6 abcdef -1 {}} test io-6.9 {Tcl_GetsObj: remember if EOF is seen} { set f [open $path(test1) w] puts $f "abcdefghijk\nwom\u001Abat" close $f set f [open $path(test1)] fconfigure $f -eofchar \x1A set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {11 abcdefghijk 3 wom} # Comprehensive tests test io-6.10 {Tcl_GetsObj: lf mode: no chars} { set f [open $path(test1) w] close $f set f [open $path(test1)] fconfigure $f -translation lf set x [list [gets $f line] $line] close $f set x } {-1 {}} test io-6.11 {Tcl_GetsObj: lf mode: lone \n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\n" close $f set f [open $path(test1)] fconfigure $f -translation lf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {0 {} -1 {}} test io-6.12 {Tcl_GetsObj: lf mode: lone \r} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r" close $f set f [open $path(test1)] fconfigure $f -translation lf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 1 "\r" -1 ""] test io-6.13 {Tcl_GetsObj: lf mode: 1 char} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f a close $f set f [open $path(test1)] fconfigure $f -translation lf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {1 a -1 {}} test io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\n" close $f set f [open $path(test1)] fconfigure $f -translation lf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {1 a -1 {}} test io-6.15 {Tcl_GetsObj: lf mode: several chars} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop" close $f set f [open $path(test1)] fconfigure $f -translation lf set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line] close $f set x } [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""] test io-6.16 {Tcl_GetsObj: cr mode: no chars} { set f [open $path(test1) w] close $f set f [open $path(test1)] fconfigure $f -translation cr set x [list [gets $f line] $line] close $f set x } {-1 {}} test io-6.17 {Tcl_GetsObj: cr mode: lone \n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\n" close $f set f [open $path(test1)] fconfigure $f -translation cr set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 1 "\n" -1 ""] test io-6.18 {Tcl_GetsObj: cr mode: lone \r} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r" close $f set f [open $path(test1)] fconfigure $f -translation cr set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {0 {} -1 {}} test io-6.19 {Tcl_GetsObj: cr mode: 1 char} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f a close $f set f [open $path(test1)] fconfigure $f -translation cr set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {1 a -1 {}} test io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\r" close $f set f [open $path(test1)] fconfigure $f -translation cr set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {1 a -1 {}} test io-6.21 {Tcl_GetsObj: cr mode: several chars} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop" close $f set f [open $path(test1)] fconfigure $f -translation cr set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line] close $f set x } [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""] test io-6.22 {Tcl_GetsObj: crlf mode: no chars} { set f [open $path(test1) w] close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [list [gets $f line] $line] close $f set x } {-1 {}} test io-6.23 {Tcl_GetsObj: crlf mode: lone \n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\n" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 1 "\n" -1 ""] test io-6.24 {Tcl_GetsObj: crlf mode: lone \r} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 1 "\r" -1 ""] test io-6.25 {Tcl_GetsObj: crlf mode: \r\r} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r\r" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 2 "\r\r" -1 ""] test io-6.26 {Tcl_GetsObj: crlf mode: \r\n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r\n" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 0 "" -1 ""] test io-6.27 {Tcl_GetsObj: crlf mode: 1 char} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f a close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {1 a -1 {}} test io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\r\n" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {1 a -1 {}} test io-6.29 {Tcl_GetsObj: crlf mode: several chars} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line] close $f set x } [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""] test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} { # if (eol >= dstEnd) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz" close $f set f [open $path(test1)] fconfigure $f -translation crlf -buffersize 16 set x [list [gets $f line] $line [testchannel inputbuffered $f]] close $f set x } [list 15 "123456789012345" 15] test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel fileevent} { # (FilterInputBytes() != 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {crlf lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r" fconfigure $f -buffersize 16 set x [gets $f] fconfigure $f -blocking 0 lappend x [gets $f line] $line [fblocked $f] [testchannel inputbuffered $f] close $f set x } [list "bbbbbbbbbbbbbb" -1 "" 1 16] test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} { # not (FilterInputBytes() != 0) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r\n123" close $f set f [open $path(test1)] fconfigure $f -translation crlf -buffersize 16 set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]] close $f set x } [list 15 "123456789012345" 17 3] test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { # eol still equals dstEnd set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r" close $f set f [open $path(test1)] fconfigure $f -translation crlf -buffersize 16 set x [list [gets $f line] $line [eof $f]] close $f set x } [list 16 "123456789012345\r" 1] test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} { # not (*eol == '\n') set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\rabcd\r\nefg" close $f set f [open $path(test1)] fconfigure $f -translation crlf -buffersize 16 set x [list [gets $f line] $line [tell $f]] close $f set x } [list 20 "123456789012345\rabcd" 22] test io-6.35 {Tcl_GetsObj: auto mode: no chars} { set f [open $path(test1) w] close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line] close $f set x } {-1 {}} test io-6.36 {Tcl_GetsObj: auto mode: lone \n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\n" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 0 "" -1 ""] test io-6.37 {Tcl_GetsObj: auto mode: lone \r} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 0 "" -1 ""] test io-6.38 {Tcl_GetsObj: auto mode: \r\r} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r\r" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line] close $f set x } [list 0 "" 0 "" -1 ""] test io-6.39 {Tcl_GetsObj: auto mode: \r\n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r\n" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line [gets $f line] $line] close $f set x } [list 0 "" -1 ""] test io-6.40 {Tcl_GetsObj: auto mode: 1 char} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f a close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {1 a -1 {}} test io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\r\n" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {1 a -1 {}} test io-6.42 {Tcl_GetsObj: auto mode: several chars} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line [gets $f line] $line] lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line close $f set x } [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""] test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel fileevent} { # if (chanPtr->flags & INPUT_SAW_CR) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 puts -nonewline $f "\nabcd\refg\x1A" lappend x [gets $f line] $line [testchannel queuedcr $f] lappend x [gets $f line] $line close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fileevent} { # not (*eol == '\n') set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 puts -nonewline $f "abcd\refg\x1A" lappend x [gets $f line] $line [testchannel queuedcr $f] lappend x [gets $f line] $line close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel fileevent} { # Tcl_ExternalToUtf() set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none fconfigure $f -encoding unicode puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 gets $f fconfigure $f -blocking 0 set x [list [gets $f line] $line [testchannel queuedcr $f]] fconfigure $f -blocking 1 puts -nonewline $f "\nabcd\refg" lappend x [gets $f line] $line [testchannel queuedcr $f] close $f set x } [list 15 "123456789abcdef" 1 4 "abcd" 0] test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel fileevent} { # memmove() set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 gets $f fconfigure $f -blocking 0 set x [list [gets $f line] $line [testchannel queuedcr $f]] fconfigure $f -blocking 1 puts -nonewline $f "\n\x1A" lappend x [gets $f line] $line [testchannel queuedcr $f] close $f set x } [list 15 "123456789abcdef" 1 -1 "" 0] test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} { # (eol == dstEnd) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq" close $f set f [open $path(test1)] fconfigure $f -translation auto -buffersize 16 set x [list [gets $f] [testchannel inputbuffered $f]] close $f set x } [list "123456789012345" 15] test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} { # PeekAhead() did not get any, so (eol >= dstEnd) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r" close $f set f [open $path(test1)] fconfigure $f -translation auto -buffersize 16 set x [list [gets $f] [testchannel queuedcr $f]] close $f set x } [list "123456789012345" 1] test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { # if (*eol == '\n') {skip++} set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\r\n78901" close $f set f [open $path(test1)] set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]] close $f set x } [list "123456" 0 8 "78901"] test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} { # not (*eol == '\n') set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\r78901" close $f set f [open $path(test1)] set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]] close $f set x } [list "123456" 0 7 "78901"] test io-6.51 {Tcl_GetsObj: auto mode: \n} { # else if (*eol == '\n') {goto gotoeol;} set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\n78901" close $f set f [open $path(test1)] set x [list [gets $f] [tell $f] [gets $f]] close $f set x } [list "123456" 7 "78901"] test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { # if (eof != NULL) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\x1Ak9012345\r" close $f set f [open $path(test1)] fconfigure $f -eofchar \x1A set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]] close $f set x } [list "123456" 0 6 ""] test io-6.53 {Tcl_GetsObj: device EOF} { # didn't produce any bytes set f [open $path(test1) w] close $f set f [open $path(test1)] set x [list [gets $f line] $line [eof $f]] close $f set x } {-1 {} 1} test io-6.54 {Tcl_GetsObj: device EOF} { # got some bytes before EOF. set f [open $path(test1) w] puts -nonewline $f abc close $f set f [open $path(test1)] set x [list [gets $f line] $line [eof $f]] close $f set x } {3 abc 1} test io-6.55 {Tcl_GetsObj: overconverted} { # Tcl_ExternalToUtf(), make sure state updated set f [open $path(test1) w] fconfigure $f -encoding iso2022-jp puts $f "there\u4E00ok\n\u4E01more bytes\nhere" close $f set f [open $path(test1)] fconfigure $f -encoding iso2022-jp set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line] close $f set x } [list 8 "there\u4E00ok" 11 "\u4E01more bytes" 4 "here"] test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} { update set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -buffering none puts -nonewline $f "foobar" fconfigure $f -blocking 0 variable x {} after 500 [namespace code { lappend x timeout }] fileevent $f readable [namespace code { lappend x [gets $f] }] vwait [namespace which -variable x] vwait [namespace which -variable x] fconfigure $f -blocking 1 puts -nonewline $f "baz\n" after 500 [namespace code { lappend x timeout }] fconfigure $f -blocking 0 vwait [namespace which -variable x] vwait [namespace which -variable x] close $f set x } {{} timeout foobarbaz timeout} test io-7.1 {FilterInputBytes: split up character at end of buffer} { # (result == TCL_CONVERT_MULTIBYTE) set f [open $path(test1) w] fconfigure $f -encoding shiftjis puts $f "1234567890123\uFF10\uFF11\uFF12\uFF13\uFF14\nend" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis -buffersize 16 set x [gets $f] close $f set x } "1234567890123\uFF10\uFF11\uFF12\uFF13\uFF14" test io-7.2 {FilterInputBytes: split up character in middle of buffer} { # (bufPtr->nextAdded < bufPtr->bufLength) set f [open $path(test1) w] fconfigure $f -encoding binary puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis set x [list [gets $f line] $line [eof $f]] close $f set x } [list 10 "1234567890" 0] test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} { set f [open $path(test1) w] fconfigure $f -encoding binary puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis set x [list [gets $f line] $line] lappend x [tell $f] [testchannel inputbuffered $f] [eof $f] lappend x [gets $f line] $line close $f set x } [list 16 "1234567890123\uFF10\uFF11\x82" 18 0 1 -1 ""] test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} { set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -encoding binary -buffering none puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" fconfigure $f -encoding shiftjis -blocking 0 fileevent $f read [namespace code "ready $f"] variable x {} proc ready {f} { variable x lappend x [gets $f line] $line [fblocked $f] } vwait [namespace which -variable x] fconfigure $f -encoding binary -blocking 1 puts $f "\x51\x82\x52" fconfigure $f -encoding shiftjis vwait [namespace which -variable x] close $f set x } [list -1 "" 1 17 "1234567890123\uFF10\uFF11\uFF12\uFF13" 0] test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} { # (bufPtr->nextPtr == NULL) set f [open $path(test1) w] fconfigure $f -encoding ascii -translation lf puts -nonewline $f "123456789012345\r\n2345678" close $f set f [open $path(test1)] fconfigure $f -encoding ascii -translation auto -buffersize 16 # here gets $f set x [testchannel inputbuffered $f] close $f set x } "7" test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel fileevent} { # not (bufPtr->nextPtr == NULL) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation lf -encoding ascii -buffering none puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz" variable x {} fileevent $f read [namespace code "ready $f"] proc ready {f} { variable x lappend x [gets $f line] $line [testchannel inputbuffered $f] } fconfigure $f -encoding unicode -buffersize 16 -blocking 0 vwait [namespace which -variable x] fconfigure $f -translation auto -encoding ascii -blocking 1 # here vwait [namespace which -variable x] close $f set x } [list -1 "" 42 15 "123456789012345" 25] test io-8.3 {PeekAhead: no cached data available} {stdio testchannel fileevent} { # (bytesLeft == 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} puts -nonewline $f "abcdefghijklmno\r" flush $f set x [list [gets $f line] $line [testchannel queuedcr $f]] close $f set x } [list 15 "abcdefghijklmno" 1] set a "123456789012345678901234567890" append a "123456789012345678901234567890" append a "1234567890123456789012345678901" test io-8.4 {PeekAhead: cached data available in this buffer} { # not (bytesLeft == 0) set f [open $path(test1) w+] fconfigure $f -translation binary puts $f "${a}\r\nabcdef" close $f set f [open $path(test1)] fconfigure $f -encoding binary -translation auto # "${a}\r" was converted in one operation (because ENCODING_LINESIZE # is 30). To check if "\n" follows, calls PeekAhead and determines # that cached data is available in buffer w/o having to call driver. set x [gets $f] close $f set x } $a unset a test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel fileevent} { # (bufPtr->nextAdded < bufPtr->length) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} puts -nonewline $f "abcdefghijklmno\r" flush $f # here set x [list [gets $f line] $line [testchannel queuedcr $f]] close $f set x } {15 abcdefghijklmno 1} test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel fileevent} { # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} -buffersize 16 puts -nonewline $f "abcdefghijklmno\r" flush $f # here set x [list [gets $f line] $line [testchannel queuedcr $f]] close $f set x } {15 abcdefghijklmno 1} test io-8.7 {PeekAhead: cleanup} {stdio testchannel fileevent} { # Make sure bytes are removed from buffer. set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} -buffering none puts -nonewline $f "abcdefghijklmno\r" # here set x [list [gets $f line] $line [testchannel queuedcr $f]] puts -nonewline $f "\x1A" lappend x [gets $f line] $line close $f set x } {15 abcdefghijklmno 1 -1 {}} test io-9.1 {CommonGetsCleanup} emptyTest { } {} test io-10.1 {Tcl_ReadChars: CheckChannelErrors} emptyTest { # no test, need to cause an async error. } {} test io-10.2 {Tcl_ReadChars: loop until enough copied} { # one time # for (copied = 0; (unsigned) toRead > 0; ) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1)] set x [read $f 5] close $f set x } {abcde} test io-10.3 {Tcl_ReadChars: loop until enough copied} { # multiple times # for (copied = 0; (unsigned) toRead > 0; ) set f [open $path(test1) w] puts $f abcdefghijklmnopqrstuvwxyz close $f set f [open $path(test1)] fconfigure $f -buffersize 16 # here set x [read $f 19] close $f set x } {abcdefghijklmnopqrs} test io-10.4 {Tcl_ReadChars: no more in channel buffer} { # (copiedNow < 0) set f [open $path(test1) w] puts -nonewline $f abcdefghijkl close $f set f [open $path(test1)] # here set x [read $f 1000] close $f set x } {abcdefghijkl} test io-10.5 {Tcl_ReadChars: stop on EOF} { # (chanPtr->flags & CHANNEL_EOF) set f [open $path(test1) w] puts -nonewline $f abcdefghijkl close $f set f [open $path(test1)] # here set x [read $f 1000] close $f set x } {abcdefghijkl} test io-11.1 {ReadBytes: want to read a lot} { # ((unsigned) toRead > (unsigned) srcLen) set f [open $path(test1) w] puts -nonewline $f abcdefghijkl close $f set f [open $path(test1)] fconfigure $f -encoding binary # here set x [read $f 1000] close $f set x } {abcdefghijkl} test io-11.2 {ReadBytes: want to read all} { # ((unsigned) toRead > (unsigned) srcLen) set f [open $path(test1) w] puts -nonewline $f abcdefghijkl close $f set f [open $path(test1)] fconfigure $f -encoding binary # here set x [read $f] close $f set x } {abcdefghijkl} test io-11.3 {ReadBytes: allocate more space} { # (toRead > length - offset - 1) set f [open $path(test1) w] puts -nonewline $f abcdefghijklmnopqrstuvwxyz close $f set f [open $path(test1)] fconfigure $f -buffersize 16 -encoding binary # here set x [read $f] close $f set x } {abcdefghijklmnopqrstuvwxyz} test io-11.4 {ReadBytes: EOF char found} { # (TranslateInputEOL() != 0) set f [open $path(test1) w] puts $f abcdefghijklmnopqrstuvwxyz close $f set f [open $path(test1)] fconfigure $f -eofchar m -encoding binary # here set x [list [read $f] [eof $f] [read $f] [eof $f]] close $f set x } [list "abcdefghijkl" 1 "" 1] test io-12.1 {ReadChars: want to read a lot} { # ((unsigned) toRead > (unsigned) srcLen) set f [open $path(test1) w] puts -nonewline $f abcdefghijkl close $f set f [open $path(test1)] # here set x [read $f 1000] close $f set x } {abcdefghijkl} test io-12.2 {ReadChars: want to read all} { # ((unsigned) toRead > (unsigned) srcLen) set f [open $path(test1) w] puts -nonewline $f abcdefghijkl close $f set f [open $path(test1)] # here set x [read $f] close $f set x } {abcdefghijkl} test io-12.3 {ReadChars: allocate more space} { # (toRead > length - offset - 1) set f [open $path(test1) w] puts -nonewline $f abcdefghijklmnopqrstuvwxyz close $f set f [open $path(test1)] fconfigure $f -buffersize 16 # here set x [read $f] close $f set x } {abcdefghijklmnopqrstuvwxyz} test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} { # (srcRead == 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -encoding binary -buffering none -buffersize 16 puts -nonewline $f "123456789012345\x96" fconfigure $f -encoding shiftjis -blocking 0 fileevent $f read [namespace code "ready $f"] proc ready {f} { variable x lappend x [read $f] [testchannel inputbuffered $f] } variable x {} fconfigure $f -encoding shiftjis vwait [namespace which -variable x] fconfigure $f -encoding binary -blocking 1 puts -nonewline $f "\x7B" after 500 ;# Give the cat process time to catch up fconfigure $f -encoding shiftjis -blocking 0 vwait [namespace which -variable x] close $f set x } [list "123456789012345" 1 "\u672C" 0] test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} { set path(test1) [makeFile { fconfigure stdout -encoding binary -buffering none gets stdin; puts -nonewline "\xE7" gets stdin; puts -nonewline "\x89" gets stdin; puts -nonewline "\xA6" } test1] set f [open "|[list [interpreter] $path(test1)]" r+] fileevent $f readable [namespace code { lappend x [read $f] if {[eof $f]} { lappend x eof } }] puts $f "go1" flush $f fconfigure $f -blocking 0 -encoding utf-8 variable x {} vwait [namespace which -variable x] after 500 [namespace code { lappend x timeout }] vwait [namespace which -variable x] puts $f "go2" flush $f vwait [namespace which -variable x] after 500 [namespace code { lappend x timeout }] vwait [namespace which -variable x] puts $f "go3" flush $f vwait [namespace which -variable x] vwait [namespace which -variable x] lappend x [catch {close $f} msg] $msg set x } "{} timeout {} timeout \u7266 {} eof 0 {}" test io-12.6 {ReadChars: too many chars read} { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) [encoding convertto utf-8 \ [string repeat \uBEEF 20][string repeat . 20]] return {initialize finalize watch read} } finalize { unset index($chan) buffer($chan) return } watch {} read { set n [lindex $args 1] set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new return $result } } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 while {![eof $c]} { read $c 15 } close $c } {} test io-12.7 {ReadChars: too many chars read [bc5b790099]} { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) [encoding convertto utf-8 \ [string repeat \uBEEF 10]....\uBEEF] return {initialize finalize watch read} } finalize { unset index($chan) buffer($chan) return } watch {} read { set n [lindex $args 1] set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new return $result } } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 while {![eof $c]} { read $c 7 } close $c } {} test io-12.8 {ReadChars: multibyte chars split} { set f [open $path(test1) w] fconfigure $f -translation binary puts -nonewline $f [string repeat a 9]\xC2\xA0 close $f set f [open $path(test1)] fconfigure $f -encoding utf-8 -buffersize 10 set in [read $f] close $f scan [string index $in end] %c } 160 test io-12.9 {ReadChars: multibyte chars split} -body { set f [open $path(test1) w] fconfigure $f -translation binary puts -nonewline $f [string repeat a 9]\xC2 close $f set f [open $path(test1)] fconfigure $f -encoding utf-8 -buffersize 10 set in [read $f] close $f scan [string index $in end] %c } -cleanup { catch {close $f} } -result 194 test io-12.10 {ReadChars: multibyte chars split} -body { set f [open $path(test1) w] fconfigure $f -translation binary puts -nonewline $f [string repeat a 9]\xC2 close $f set f [open $path(test1)] fconfigure $f -encoding utf-8 -buffersize 11 set in [read $f] close $f scan [string index $in end] %c } -cleanup { catch {close $f} } -result 194 test io-13.1 {TranslateInputEOL: cr mode} {} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\rdef\r" close $f set f [open $path(test1)] fconfigure $f -translation cr set x [read $f] close $f set x } "abcd\ndef\n" test io-13.2 {TranslateInputEOL: crlf mode} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r\ndef\r\n" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [read $f] close $f set x } "abcd\ndef\n" test io-13.3 {TranslateInputEOL: crlf mode: naked cr} { # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r\ndef\r" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [read $f] close $f set x } "abcd\ndef\r" test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r\ndef\rfgh" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [read $f] close $f set x } "abcd\ndef\rfgh" test io-13.5 {TranslateInputEOL: crlf mode: naked lf} { # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r\ndef\nfgh" close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [read $f] close $f set x } "abcd\ndef\nfgh" test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel fileevent} { # (chanPtr->flags & INPUT_SAW_CR) # This test may fail on slower machines. set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -blocking 0 -buffering none -translation {auto lf} fileevent $f read [namespace code "ready $f"] proc ready {f} { variable x lappend x [read $f] [testchannel queuedcr $f] } variable x {} variable y {} puts -nonewline $f "abcdefghj\r" after 500 [namespace code {set y ok}] vwait [namespace which -variable y] puts -nonewline $f "\n01234" after 500 [namespace code {set y ok}] vwait [namespace which -variable y] close $f set x } [list "abcdefghj\n" 1 "01234" 0] test io-13.7 {TranslateInputEOL: auto mode: naked \r} testchannel { # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [list [read $f] [testchannel queuedcr $f]] close $f set x } [list "abcd\n" 1] test io-13.8 {TranslateInputEOL: auto mode: \r\n} { # (*src == '\n') set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r\ndef" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [read $f] close $f set x } "abcd\ndef" test io-13.8.1 {TranslateInputEOL: auto mode: \r\n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r\ndef" close $f set f [open $path(test1)] fconfigure $f -translation auto set x {} lappend x [read $f 5] lappend x [read $f] close $f set x } [list "abcd\n" "def"] test io-13.8.2 {TranslateInputEOL: auto mode: \r\n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r\ndef" close $f set f [open $path(test1)] fconfigure $f -translation auto -buffersize 6 set x {} lappend x [read $f 5] lappend x [read $f] close $f set x } [list "abcd\n" "def"] test io-13.8.3 {TranslateInputEOL: auto mode: \r\n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r\n\r\ndef" close $f set f [open $path(test1)] fconfigure $f -translation auto -buffersize 7 set x {} lappend x [read $f 5] lappend x [read $f] close $f set x } [list "abcd\n" "\ndef"] test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\rdef" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [read $f] close $f set x } "abcd\ndef" test io-13.10 {TranslateInputEOL: auto mode: \n} { # not (*src == '\r') set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\ndef" close $f set f [open $path(test1)] fconfigure $f -translation auto set x [read $f] close $f set x } "abcd\ndef" test io-13.11 {TranslateInputEOL: EOF char} { # (*chanPtr->inEofChar != '\x00') set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\ndefgh" close $f set f [open $path(test1)] fconfigure $f -translation auto -eofchar e set x [read $f] close $f set x } "abcd\nd" test io-13.12 {TranslateInputEOL: find EOF char in src} { # (*chanPtr->inEofChar != '\x00') set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n" close $f set f [open $path(test1)] fconfigure $f -translation auto -eofchar e set x [read $f] close $f set x } "\n\n\nab\n\nd" # Test standard handle management. The functions tested are # Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are # also testing channel table management. if {[info commands testchannel] != ""} { set consoleFileNames [lsort [testchannel open]] } else { # just to avoid an error set consoleFileNames [list] } test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} { set l "" lappend l [fconfigure stdin -buffering] lappend l [fconfigure stdout -buffering] lappend l [fconfigure stderr -buffering] lappend l [lsort [testchannel open]] set l } [list line line none $consoleFileNames] test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} { interp create x set l "" lappend l [x eval {fconfigure stdin -buffering}] lappend l [x eval {fconfigure stdout -buffering}] lappend l [x eval {fconfigure stderr -buffering}] interp delete x set l } {line line none} set path(test3) [makeFile {} test3] test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} exec { set f [open $path(test1) w] puts -nonewline $f { close stdin close stdout close stderr set f [} puts $f [list open $path(test1) r]] puts $f "set f2 \[[list open $path(test2) w]]" puts $f "set f3 \[[list open $path(test3) w]]" puts $f { puts stdout [gets stdin] puts stdout out puts stderr err close $f close $f2 close $f3 } close $f set result [exec [interpreter] $path(test1)] set f [open $path(test2) r] set f2 [open $path(test3) r] lappend result [read $f] [read $f2] close $f close $f2 set result } {{ out } {err }} # This test relies on the fact that stdout is used before stderr test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} { set f [open $path(test1) w] puts -nonewline $f { close stdin close stdout close stderr set f [} puts $f [list open $path(test1) r]] puts $f "set f2 \[[list open $path(test2) w]]" puts $f "set f3 \[[list open $path(test3) w]]" puts $f { puts stdout [gets stdin] puts stdout $f2 puts stderr $f3 close $f close $f2 close $f3 } close $f set result [exec [interpreter] $path(test1)] set f [open $path(test2) r] set f2 [open $path(test3) r] lappend result [read $f] [read $f2] close $f close $f2 set result } {{ close stdin stdout } {stderr }} catch {interp delete z} test io-14.5 {Tcl_GetChannel: stdio name translation} { interp create z eof stdin catch {z eval flush stdin} msg1 catch {z eval close stdin} msg2 catch {z eval flush stdin} msg3 set result [list $msg1 $msg2 $msg3] interp delete z set result } {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}} test io-14.6 {Tcl_GetChannel: stdio name translation} { interp create z eof stdout catch {z eval flush stdout} msg1 catch {z eval close stdout} msg2 catch {z eval flush stdout} msg3 set result [list $msg1 $msg2 $msg3] interp delete z set result } {{} {} {can not find channel named "stdout"}} test io-14.7 {Tcl_GetChannel: stdio name translation} { interp create z eof stderr catch {z eval flush stderr} msg1 catch {z eval close stderr} msg2 catch {z eval flush stderr} msg3 set result [list $msg1 $msg2 $msg3] interp delete z set result } {{} {} {can not find channel named "stderr"}} set path(script) [makeFile {} script] test io-14.8 {reuse of stdio special channels} stdio { file delete $path(script) file delete $path(test1) set f [open $path(script) w] puts -nonewline $f { close stderr set f [} puts $f [list open $path(test1) w]] puts -nonewline $f { puts stderr hello close $f set f [} puts $f [list open $path(test1) r]] puts $f { puts [gets $f] } close $f set f [open "|[list [interpreter] $path(script)]" r] set c [gets $f] close $f set c } hello test io-14.9 {reuse of stdio special channels} {stdio fileevent} { file delete $path(script) file delete $path(test1) set f [open $path(script) w] puts $f { array set path [lindex $argv 0] set f [open $path(test1) w] puts $f hello close $f close stderr set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r] puts [gets $f] } close $f set f [open "|[list [interpreter] $path(script) [array get path]]" r] set c [gets $f] close $f # Added delay to give Windows time to stop the spawned process and clean # up its grip on the file test1. Added delete as proper test cleanup. # The failing tests were 18.1 and 18.2 as first re-users of file "test1". after 10000 file delete $path(script) file delete $path(test1) set c } hello test io-15.1 {Tcl_CreateCloseHandler} emptyTest { } {} test io-16.1 {Tcl_DeleteCloseHandler} emptyTest { } {} # Test channel table management. The functions tested are # GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel, # Tcl_UnregisterChannel, Tcl_GetChannel and Tcl_CreateChannel. # # These functions use "eof stdin" to ensure that the standard # channels are added to the channel table of the interpreter. test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stdin] eof stdin interp create x set l "" lappend l [expr {[testchannel refcount stdin] - $l1}] x eval {eof stdin} lappend l [expr {[testchannel refcount stdin] - $l1}] interp delete x lappend l [expr {[testchannel refcount stdin] - $l1}] set l } {0 1 0} test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stdout] eof stdin interp create x set l "" lappend l [expr {[testchannel refcount stdout] - $l1}] x eval {eof stdout} lappend l [expr {[testchannel refcount stdout] - $l1}] interp delete x lappend l [expr {[testchannel refcount stdout] - $l1}] set l } {0 1 0} test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stderr] eof stdin interp create x set l "" lappend l [expr {[testchannel refcount stderr] - $l1}] x eval {eof stderr} lappend l [expr {[testchannel refcount stderr] - $l1}] interp delete x lappend l [expr {[testchannel refcount stderr] - $l1}] set l } {0 1 0} test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { file delete -force $path(test1) set l "" set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being closed" } string compare [string tolower $l] \ [list 1 [format "can not find channel named \"%s\"" $f]] } 0 test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { file delete -force $path(test1) set l "" set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] interp create x interp share "" $f x lappend l [lindex [testchannel info $f] 15] x eval close $f lappend l [lindex [testchannel info $f] 15] interp delete x lappend l [lindex [testchannel info $f] 15] close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being closed" } string compare [string tolower $l] \ [list 1 2 1 1 [format "can not find channel named \"%s\"" $f]] } 0 test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { file delete $path(test1) set l "" set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] interp create x interp share "" $f x lappend l [lindex [testchannel info $f] 15] interp delete x lappend l [lindex [testchannel info $f] 15] close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being closed" } string compare [string tolower $l] \ [list 1 2 1 [format "can not find channel named \"%s\"" $f]] } 0 test io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} { eof stdin } 0 test io-19.2 {testing Tcl_GetChannel, user opened handle} { file delete $path(test1) set f [open $path(test1) w] set x [eof $f] close $f set x } 0 test io-19.3 {Tcl_GetChannel, channel not found} { list [catch {eof file34} msg] $msg } {1 {can not find channel named "file34"}} test io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} { file delete $path(test1) set f [open $path(test1) w] set l "" lappend l [eof $f] close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being closed" } string compare [string tolower $l] \ [list 0 [format "can not find channel named \"%s\"" $f]] } 0 test io-20.1 {Tcl_CreateChannel: initial settings} { set a [open $path(test2) w] set old [encoding system] encoding system ascii set f [open $path(test1) w] set x [fconfigure $f -encoding] close $f encoding system $old close $a set x } {ascii} test io-20.2 {Tcl_CreateChannel: initial settings} {win} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x } [list [list \x1A ""] {auto crlf}] test io-20.3 {Tcl_CreateChannel: initial settings} {unix} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x } {{{} {}} {auto lf}} set path(stdout) [makeFile {} stdout] test io-20.5 {Tcl_CreateChannel: install channel in empty slot} stdio { set f [open $path(script) w] puts -nonewline $f { close stdout set f1 [} puts $f [list open $path(stdout) w]] puts $f { fconfigure $f1 -buffersize 777 puts stderr [fconfigure stdout -buffersize] } close $f set f [open "|[list [interpreter] $path(script)]"] catch {close $f} msg set msg } {777} test io-21.1 {CloseChannelsOnExit} emptyTest { } {} # Test management of attributes associated with a channel, such as # its default translation, its name and type, etc. The functions # tested in this group are Tcl_GetChannelName, # Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData # not tested because files do not use the instance data. test io-22.1 {Tcl_GetChannelMode} emptyTest { # Not used anywhere in Tcl. } {} test io-23.1 {Tcl_GetChannelName} {testchannel} { file delete $path(test1) set f [open $path(test1) w] set n [testchannel name $f] close $f string compare $n $f } 0 test io-24.1 {Tcl_GetChannelType} {testchannel} { file delete $path(test1) set f [open $path(test1) w] set t [testchannel type $f] close $f string compare $t file } 0 test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} { set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} puts $f "1234567890\n098765432" close $f set f [open $path(test1) r] gets $f set l "" lappend l [testchannel inputbuffered $f] lappend l [tell $f] close $f set l } {10 11} test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [tell $f] flush $f lappend l [testchannel outputbuffered $f] lappend l [tell $f] close $f file delete $path(test1) set l } {6 6 0 6} test io-26.1 {Tcl_GetChannelInstanceData} stdio { # "pid" command uses Tcl_GetChannelInstanceData # Don't care what pid is (but must be a number), just want to exercise it. set f [open "|[list [interpreter] << exit]"] expr {[pid $f]} close $f } {} # Test flushing. The functions tested here are FlushChannel. test io-27.1 {FlushChannel, no output buffered} { file delete $path(test1) set f [open $path(test1) w] flush $f set s [file size $path(test1)] close $f set s } 0 test io-27.2 {FlushChannel, some output buffered} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set l "" puts $f hello lappend l [file size $path(test1)] flush $f lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 6 6} test io-27.3 {FlushChannel, implicit flush on close} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set l "" puts $f hello lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 6} test io-27.4 {FlushChannel, implicit flush when buffer fills} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} fconfigure $f -buffersize 60 set l "" lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { puts $f hello } lappend l [file size $path(test1)] flush $f lappend l [file size $path(test1)] close $f set l } {0 60 72} test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ {unixOrWin} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffersize 60 -eofchar {} set l "" lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { puts $f hello } lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ {stdio asyncPipeClose notWinCI} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f { fconfigure $f -translation lf -buffering none -eofchar {} while {![eof stdin]} { after 20 puts -nonewline $f [read stdin 1024] } close $f } close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] close $f set f [open "|[list [interpreter] $path(pipe)]" w] fconfigure $f -blocking off puts -nonewline $f $x close $f set counter 0 while {([file size $path(output)] < 65536) && ($counter < 1000)} { after 20 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } if {$counter == 1000} { set result "file size only [file size $path(output)]" } else { set result ok } } ok # Tests closing a channel. The functions tested are CloseChannel and Tcl_Close. test io-28.1 {CloseChannel called when all references are dropped} {testchannel} { file delete $path(test1) set f [open $path(test1) w] interp create x interp share "" $f x set l "" lappend l [testchannel refcount $f] x eval close $f interp delete x lappend l [testchannel refcount $f] close $f set l } {2 1} test io-28.2 {CloseChannel called when all references are dropped} { file delete $path(test1) set f [open $path(test1) w] interp create x interp share "" $f x puts -nonewline $f abc close $f x eval puts $f def x eval close $f interp delete x set f [open $path(test1) r] set l [gets $f] close $f set l } abcdef test io-28.3 {CloseChannel, not called before output queue is empty} \ {stdio asyncPipeClose nonPortable} { file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f { # Need to not have eof char appended on close, because the other # side of the pipe already closed, so that writing would cause an # error "invalid file". fconfigure stdout -eofchar {} fconfigure stderr -eofchar {} set f [open $path(output) w] fconfigure $f -translation lf -buffering none for {set x 0} {$x < 20} {incr x} { after 20 puts -nonewline $f [read stdin 1024] } close $f } close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] close $f set f [open "|[list [interpreter] pipe]" r+] fconfigure $f -blocking off -eofchar {} puts -nonewline $f $x close $f set counter 0 while {([file size $path(output)] < 20480) && ($counter < 1000)} { after 20 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } if {$counter == 1000} { set result probably_broken } else { set result ok } } ok test io-28.4 Tcl_Close testchannel { file delete $path(test1) set l {} lappend l [lsort [testchannel open]] set f [open $path(test1) w] lappend l [lsort [testchannel open]] close $f lappend l [lsort [testchannel open]] set x [list $consoleFileNames \ [lsort [list {*}$consoleFileNames $f]] \ $consoleFileNames] string compare $l $x } 0 test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel} { file delete $path(script) set f [open $path(script) w] puts $f { close stdin puts [testchannel open] } close $f set f [open "|[list [interpreter] $path(script)]" r] set l [gets $f] close $f lsort $l } {file1 file2} test io-29.1 {Tcl_WriteChars, channel not writable} { list [catch {puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test io-29.2 {Tcl_WriteChars, empty string} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -eofchar {} puts -nonewline $f "" close $f file size $path(test1) } 0 test io-29.3 {Tcl_WriteChars, nonempty string} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -eofchar {} puts -nonewline $f hello close $f file size $path(test1) } 5 test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering full -eofchar {} puts $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {6 0 0 6} test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering line -eofchar {} puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {5 0 0 11} test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering none -eofchar {} puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {0 5 0 11} test io-29.7 {Tcl_Flush, full buffering} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering full -eofchar {} puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {5 0 11 0 0 11} test io-29.8 {Tcl_Flush, full buffering} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering line puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {5 0 0 5 0 11 0 11} test io-29.9 {Tcl_Flush, channel not writable} { list [catch {flush stdin} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test io-29.10 {Tcl_WriteChars, looping and buffering} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { puts $f1 [gets $f2] } close $f2 close $f1 file size $path(test1) } 387 test io-29.11 {Tcl_WriteChars, no newline, implicit flush} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -eofchar {} set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { puts -nonewline $f1 [gets $f2] } close $f1 close $f2 file size $path(test1) } 377 test io-29.12 {Tcl_WriteChars on a pipe} stdio { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 "set f1 \[[list open $path(longfile) r]]" puts $f1 { for {set x 0} {$x < 10} {incr x} { puts [gets $f1] } } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r] set f2 [open $path(longfile) r] set y ok for {set x 0} {$x < 10} {incr x} { set l1 [gets $f1] set l2 [gets $f2] if {"$l1" != "$l2"} { set y broken } } close $f1 close $f2 set y } ok test io-29.13 {Tcl_WriteChars to a pipe, line buffered} stdio { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { puts [gets stdin] puts [gets stdin] } close $f1 set y ok set f1 [open "|[list [interpreter] $path(pipe)]" r+] fconfigure $f1 -buffering line set f2 [open $path(longfile) r] set line [gets $f2] puts $f1 $line set backline [gets $f1] if {"$line" != "$backline"} { set y broken } set line [gets $f2] puts $f1 $line set backline [gets $f1] if {"$line" != "$backline"} { set y broken } close $f1 close $f2 set y } ok test io-29.14 {Tcl_WriteChars, buffering and implicit flush at close} { file delete $path(test3) set f [open $path(test3) w] puts -nonewline $f "Text1" puts -nonewline $f " Text 2" puts $f " Text 3" close $f set f [open $path(test3) r] set x [gets $f] close $f set x } {Text1 Text 2 Text 3} test io-29.15 {Tcl_Flush, channel not open for writing} { file delete $path(test1) set fd [open $path(test1) w] close $fd set fd [open $path(test1) r] set x [list [catch {flush $fd} msg] $msg] close $fd string compare $x \ [list 1 "channel \"$fd\" wasn't opened for writing"] } 0 test io-29.16 {Tcl_Flush on pipe opened only for reading} stdio { set fd [open "|[list [interpreter] cat longfile]" r] set x [list [catch {flush $fd} msg] $msg] catch {close $fd} string compare $x \ [list 1 "channel \"$fd\" wasn't opened for writing"] } 0 test io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 hello puts $f1 hello puts $f1 hello flush $f1 set x [file size $path(test1)] close $f1 set x } 18 test io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} { file delete $path(test1) set x "" set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 hello puts $f1 hello puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello flush $f1 lappend x [file size $path(test1)] close $f1 set x } {18 24 30} test io-29.19 {Explicit and implicit flushes} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} set x "" puts $f1 hello puts $f1 hello puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello close $f1 lappend x [file size $path(test1)] set x } {18 24 30} test io-29.20 {Implicit flush when buffer is full} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" for {set x 0} {$x < 100} {incr x} { puts $f1 $line } set z "" lappend z [file size $path(test1)] for {set x 0} {$x < 100} {incr x} { puts $f1 $line } lappend z [file size $path(test1)] close $f1 lappend z [file size $path(test1)] set z } {4096 12288 12600} test io-29.21 {Tcl_Flush to pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {set x [read stdin 6]} puts $f1 {set cnt [string length $x]} puts $f1 {puts "read $cnt characters"} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x [gets $f1] catch {close $f1} set x } "read 6 characters" test io-29.22 {Tcl_Flush called at other end of pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { fconfigure stdout -buffering full puts hello puts hello flush stdout gets stdin puts bye flush stdout } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] set x "" lappend x [gets $f1] lappend x [gets $f1] puts $f1 hello flush $f1 lappend x [gets $f1] close $f1 set x } {hello hello bye} test io-29.23 {Tcl_Flush and line buffering at end of pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { puts hello puts hello gets stdin puts bye } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] set x "" lappend x [gets $f1] lappend x [gets $f1] puts $f1 hello flush $f1 lappend x [gets $f1] close $f1 set x } {hello hello bye} test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} { set f [open $path(test3) w] puts $f "Line 1" puts $f "Line 2" set f2 [open $path(test3)] set x {} lappend x [read -nonewline $f2] close $f2 flush $f set f2 [open $path(test3)] lappend x [read -nonewline $f2] close $f2 close $f set x } "{} {Line 1\nLine 2}" test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio fileevent} { file delete $path(test3) set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w] puts $f "Line 1" puts $f "Line 2" close $f after 100 set f [open $path(test3) r] set x [read $f] close $f set x } "Line 1\nLine 2\n" test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} { set f [open "|[list cat -u]" r+] puts $f "Line1" flush $f set x [gets $f] close $f set x } {Line1} test io-29.27 {Tcl_Flush on closed pipeline} stdio { file delete $path(pipe) set f [open $path(pipe) w] puts $f {exit} close $f set f [open "|[list [interpreter] $path(pipe)]" r+] gets $f puts $f output after 50 # # The flush below will get a SIGPIPE. This is an expected part of # test and indicates that the test operates correctly. If you run # this test under a debugger, the signal will by intercepted unless # you disable the debugger's signal interception. # if {[catch {flush $f} msg]} { set x [list 1 $msg $::errorCode] catch {close $f} } else { if {[catch {close $f} msg]} { set x [list 1 $msg $::errorCode] } else { set x {this was supposed to fail and did not} } } regsub {".*":} $x {"":} x string tolower $x } {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}} test io-29.28 {Tcl_WriteChars, lf mode} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} puts $f hello\nthere\nand\nhere flush $f set s [file size $path(test1)] close $f set s } 21 test io-29.29 {Tcl_WriteChars, cr mode} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} puts $f hello\nthere\nand\nhere close $f file size $path(test1) } 21 test io-29.30 {Tcl_WriteChars, crlf mode} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} puts $f hello\nthere\nand\nhere close $f file size $path(test1) } 25 test io-29.31 {Tcl_WriteChars, background flush} stdio { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f {fconfigure $f -translation lf} set x [list while {![eof stdin]}] set x "$x {" puts $f $x puts $f { puts -nonewline $f [read stdin 4096]} puts $f { flush $f} puts $f "}" puts $f {close $f} close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] close $f set f [open "|[list [interpreter] $path(pipe)]" r+] fconfigure $f -blocking off puts -nonewline $f $x close $f set counter 0 while {([file size $path(output)] < 65536) && ($counter < 1000)} { after 10 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } if {$counter == 1000} { set result "file size only [file size $path(output)]" } else { set result ok } # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output)] # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ {stdio asyncPipeClose notWinCI} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f {fconfigure $f -translation lf} set x [list while {![eof stdin]}] set x "$x \{" puts $f $x puts $f { after 20} puts $f { puts -nonewline $f [read stdin 1024]} puts $f { flush $f} puts $f "\}" puts $f {close $f} close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] close $f set f [open "|[list [interpreter] $path(pipe)]" r+] fconfigure $f -blocking off puts -nonewline $f $x close $f set counter 0 while {([file size $path(output)] < 65536) && ($counter < 1000)} { after 20 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } if {$counter == 1000} { set result "file size only [file size $path(output)]" } else { set result ok } } ok test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} { set f [open $path(script) w] puts $f "set f \[[list open $path(test1) w]]" puts $f {fconfigure $f -translation lf puts $f hello puts $f bye puts $f strange } close $f exec [interpreter] $path(script) set f [open $path(test1) r] set r [read $f] close $f set r } "hello\nbye\nstrange\n" set path(script2) [makeFile {} script2] test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} { set f [open $path(script) w] puts $f { fconfigure stdout -blocking 0 puts -nonewline stdout [string repeat A 655360] flush stdout } close $f set f [open $path(script2) w] puts $f {after 2000} close $f set t1 [clock milliseconds] set ff [open "|[list [interpreter] $path(script2)]" w] catch {unset ::env(TCL_FLUSH_NONBLOCKING_ON_EXIT)} exec [interpreter] $path(script) >@ $ff set t2 [clock milliseconds] close $ff expr {($t2-$t1)/2000 ? $t2-$t1 : 0} } 0 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} { variable c 0 variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 9000} {incr i} { puts $s $l } } proc accept {s a p} { variable x fileevent $s readable [namespace code [list readit $s]] fconfigure $s -blocking off set x accepted } proc readit {s} { variable c variable x set l [gets $s] if {[eof $s]} { close $s set x done } elseif {([string length $l] > 0) || ![fblocked $s]} { incr c } } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set cs [socket 127.0.0.1 [lindex [fconfigure $ss -sockname] 2]] vwait [namespace which -variable x] fconfigure $cs -blocking off writelots $cs $l close $cs close $ss vwait [namespace which -variable x] set c } 9000 test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} { # On Mac, this test screws up sockets such that subsequent tests using port 2828 # either cause errors or panic(). catch {interp delete x} catch {interp delete y} interp create x interp create y set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] proc accept {s a p} { puts $s hello close $s } set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]] interp share {} $c x interp share {} $c y close $c x eval { proc readit {s} { gets $s if {[eof $s]} { close $s } } } y eval { proc readit {s} { gets $s if {[eof $s]} { close $s } } } x eval "fileevent $c readable \{readit $c\}" y eval "fileevent $c readable \{readit $c\}" y eval [list close $c] update close $s interp delete x interp delete y } "" test io-29.36.1 {gets on translation auto with "\r" in QA communication mode, possible regression, bug [b3977d199b]} -constraints { socket tempNotMac fileevent } -setup { set s [open "|[list [interpreter] << { proc accept {so args} { fconfigure $so -translation binary puts -nonewline $so "who are you?\r"; flush $so set a [gets $so] puts -nonewline $so "really $a?\r"; flush $so set a [gets $so] close $so set ::done $a } set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] puts [lindex [fconfigure $s -sockname] 2] foreach c {1 2} { vwait ::done puts $::done } }]" r] set c {} set result {} } -body { set port [gets $s] foreach t {{cr lf} {auto lf}} { set c [socket 127.0.0.1 $port] fconfigure $c -buffering line -translation $t lappend result $t while {1} { set q [gets $c] switch -- $q { "who are you?" {puts $c "client"} "really client?" {puts $c "yes"; lappend result $q; break} default {puts $c "wrong"; lappend result "unexpected input \"$q\""; break} } } lappend result [gets $s] close $c; set c {} } set result } -cleanup { close $s if {$c ne {}} { close $c } unset -nocomplain s c port t q } -result [list {cr lf} "really client?" yes {auto lf} "really client?" yes] test io-29.36.2 {gets on translation auto with "\r\n" in different buffers, bug [b3977d199b]} -constraints { socket tempNotMac fileevent } -setup { set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set c {} } -body { set ::cnt 0 proc accept {so args} { fconfigure $so -translation binary puts -nonewline $so "1 line\r" puts -nonewline $so "\n2 li" flush $so # now force separate packets puts -nonewline $so "ne\r" flush $so if {$::cnt & 1} { vwait ::cli; # simulate short delay (so client can process events, just wait for it) } else { # we don't have a delay, so client would get the lines as single chunk } # we'll try with "\r" and without "\r" (to cover both branches, where "\r" and "eof" causes exit from [gets] by 3rd line) puts -nonewline $so "\n3 line" if {!($::cnt % 3)} { puts -nonewline $so "\r" } flush $so close $so } while {$::cnt < 6} { incr ::cnt set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]] fconfigure $c -blocking 0 -buffering line -translation auto fileevent $c readable [list apply {c { if {[gets $c line] >= 0} { lappend ::cli <$line> } elseif {[eof $c]} { set ::done 1 } }} $c] vwait ::done close $c; set c {} } set ::cli } -cleanup { close $s if {$c ne {}} { close $c } unset -nocomplain ::done ::cli ::cnt s c } -result [lrepeat 6 {<1 line>} {<2 line>} {<3 line>}] # Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read. test io-30.1 {Tcl_Write lf, Tcl_Read lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.2 {Tcl_Write lf, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.3 {Tcl_Write lf, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.4 {Tcl_Write cr, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.5 {Tcl_Write cr, Tcl_Read lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set x [read $f] close $f set x } "hello\rthere\rand\rhere\r" test io-30.6 {Tcl_Write cr, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set x [read $f] close $f set x } "hello\rthere\rand\rhere\r" test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.8 {Tcl_Write crlf, Tcl_Read lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set x [read $f] close $f set x } "hello\r\nthere\r\nand\r\nhere\r\n" test io-30.9 {Tcl_Write crlf, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set x [read $f] close $f set x } "hello\n\nthere\n\nand\n\nhere\n\n" test io-30.10 {Tcl_Write lf, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set c [read $f] set x [fconfigure $f -translation] close $f list $c $x } {{hello there and here } auto} test io-30.11 {Tcl_Write cr, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set c [read $f] set x [fconfigure $f -translation] close $f list $c $x } {{hello there and here } auto} test io-30.12 {Tcl_Write crlf, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set c [read $f] set x [fconfigure $f -translation] close $f list $c $x } {{hello there and here } auto} test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation auto set c [read $f] close $f string length $c } [expr {700*15+1}] test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation crlf set c [read $f] close $f string length $c } [expr {700*15+1}] test io-30.15 {Tcl_Write mixed, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] fconfigure $f -translation auto set c [read $f] close $f set c } {hello there and here } test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f hello\nthere\nand\rhere\n\x1A close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set c [read $f] close $f set c } {hello there and here } test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar \x1A puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set c [read $f] close $f set c } {hello there and here } test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1 {} 1} test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1 {} 1} test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar {} set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1Aghi 0 qrs 0 {} 1" test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar {} set l "" set x [gets $f] lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {0 1 {} 1} test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar {} set l "" set x [gets $f] lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {0 1 {} 1} test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} # Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets. test io-31.1 {Tcl_Write lf, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] close $f set l } {hello 6 auto there 12 auto} test io-31.2 {Tcl_Write cr, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] close $f set l } {hello 6 auto there 12 auto} test io-31.3 {Tcl_Write crlf, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] close $f set l } {hello 7 auto there 14 auto} test io-31.4 {Tcl_Write lf, Tcl_Gets lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] close $f set l } {hello 6 lf there 12 lf} test io-31.5 {Tcl_Write lf, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {21 21 cr 1 {} 21 cr 1} test io-31.6 {Tcl_Write lf, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {21 21 crlf 1 {} 21 crlf 1} test io-31.7 {Tcl_Write cr, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {hello 6 cr 0 there 12 cr 0} test io-31.8 {Tcl_Write cr, Tcl_Gets lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {21 21 lf 1 {} 21 lf 1} test io-31.9 {Tcl_Write cr, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {21 21 crlf 1 {} 21 crlf 1} test io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {hello 7 crlf 0 there 14 crlf 0} test io-31.11 {Tcl_Write crlf, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {hello 6 cr 0 6 13 cr 0} test io-31.12 {Tcl_Write crlf, Tcl_Gets lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {6 7 lf 0 6 14 lf 0} test io-31.13 {binary mode is synonym of lf mode} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation binary set x [fconfigure $f -translation] close $f set x } lf # # Test io-9.14 has been removed because "auto" output translation mode is # not supported. # test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\rand\r\nhere close $f set f [open $path(test1) r] fconfigure $f -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.15 {Tcl_Write mixed, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f hello\nthere\rand\r\nhere\r close $f set f [open $path(test1) r] fconfigure $f -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.16 {Tcl_Write mixed, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f hello\nthere\rand\r\nhere\n close $f set f [open $path(test1) r] set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.17 {Tcl_Write mixed, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f hello\nthere\rand\r\nhere\r\n close $f set f [open $path(test1) r] fconfigure $f -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "hello\nthere\nand\rhere\n\%c" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar \x1A puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar {} set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar {} set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar {} set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation crlf set c "" while {[gets $f line] >= 0} { append c $line\n } close $f string length $c } [expr {700*15+1}] test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation auto set c "" while {[gets $f line] >= 0} { append c $line\n } close $f string length $c } [expr {700*15+1}] # Test Tcl_Read and buffering. test io-32.1 {Tcl_Read, channel not readable} { list [catch {read stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test io-32.2 {Tcl_Read, zero byte count} { read stdin 0 } "" test io-32.3 {Tcl_Read, negative byte count} { set f [open $path(longfile) r] set l [list [catch {read $f -1} msg] $msg] close $f set l } {1 {expected non-negative integer but got "-1"}} test io-32.4 {Tcl_Read, positive byte count} { set f [open $path(longfile) r] set x [read $f 1024] set s [string length $x] unset x close $f set s } 1024 test io-32.5 {Tcl_Read, multiple buffers} { set f [open $path(longfile) r] fconfigure $f -buffersize 100 set x [read $f 1024] set s [string length $x] unset x close $f set s } 1024 test io-32.6 {Tcl_Read, very large read} { set f1 [open $path(longfile) r] set z [read $f1 1000000] close $f1 set l [string length $z] set x ok set z [file size $path(longfile)] if {$z != $l} { set x broken } set x } ok test io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} { set f1 [open $path(longfile) r] fconfigure $f1 -blocking off set z [read $f1 20] close $f1 set l [string length $z] set x ok if {$l != 20} { set x broken } set x } ok test io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} { set f1 [open $path(longfile) r] fconfigure $f1 -blocking off set z [read $f1 1000000] close $f1 set x ok set l [string length $z] set z [file size $path(longfile)] if {$z != $l} { set x broken } set x } ok test io-32.9 {Tcl_Read, read to end of file} { set f1 [open $path(longfile) r] set z [read $f1] close $f1 set l [string length $z] set x ok set z [file size $path(longfile)] if {$z != $l} { set x broken } set x } ok test io-32.10 {Tcl_Read from a pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x [read $f1] close $f1 set x } "hello\n" test io-32.11 {Tcl_Read from a pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} puts $f1 {puts [gets stdin]} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x "" lappend x [read $f1 6] puts $f1 hello flush $f1 lappend x [read $f1] close $f1 set x } {{hello } {hello }} test io-32.11.1 {Tcl_Read from a pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {chan configure stdout -translation crlf} puts $f1 {puts [gets stdin]} puts $f1 {puts [gets stdin]} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x "" lappend x [read $f1 6] puts $f1 hello flush $f1 lappend x [read $f1] close $f1 set x } {{hello } {hello }} test io-32.11.2 {Tcl_Read from a pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {chan configure stdout -translation crlf} puts $f1 {puts [gets stdin]} puts $f1 {puts [gets stdin]} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x "" lappend x [read $f1 6] puts $f1 hello flush $f1 lappend x [read $f1] close $f1 set x } {{hello } {hello }} test io-32.12 {Tcl_Read, -nonewline} { file delete $path(test1) set f1 [open $path(test1) w] puts $f1 hello puts $f1 bye close $f1 set f1 [open $path(test1) r] set c [read -nonewline $f1] close $f1 set c } {hello bye} test io-32.13 {Tcl_Read, -nonewline} { file delete $path(test1) set f1 [open $path(test1) w] puts $f1 hello puts $f1 bye close $f1 set f1 [open $path(test1) r] set c [read -nonewline $f1] close $f1 list [string length $c] $c } {9 {hello bye}} test io-32.14 {Tcl_Read, reading in small chunks} { file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1)] set x [list [read $f 1] [read $f 2] [read $f]] close $f set x } {T wo { lines: this one and this one }} test io-32.15 {Tcl_Read, asking for more input than available} { file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1)] set x [read $f 100] close $f set x } {Two lines: this one and this one } test io-32.16 {Tcl_Read, read to end of file with -nonewline} { file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1)] set x [read -nonewline $f] close $f set x } {Two lines: this one and this one} # Test Tcl_Gets. test io-33.1 {Tcl_Gets, reading what was written} { file delete $path(test1) set f1 [open $path(test1) w] set y "first line" puts $f1 $y close $f1 set f1 [open $path(test1) r] set x [gets $f1] set z ok if {"$x" != "$y"} { set z broken } close $f1 set z } ok test io-33.2 {Tcl_Gets into variable} { set f1 [open $path(longfile) r] set c [gets $f1 x] set l [string length x] set z ok if {$l != $l} { set z broken } close $f1 set z } ok test io-33.3 {Tcl_Gets from pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x [gets $f1] close $f1 set z ok if {"$x" != "hello"} { set z broken } set z } ok test io-33.4 {Tcl_Gets with long line} { file delete $path(test3) set f [open $path(test3) w] puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f set f [open $path(test3)] set x [gets $f] close $f set x } {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} set f [open $path(test3) w] puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f test io-33.5 {Tcl_Gets with long line} { set f [open $path(test3)] set x [gets $f y] close $f list $x $y } {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} test io-33.6 {Tcl_Gets and end of file} { file delete $path(test3) set f [open $path(test3) w] puts -nonewline $f "Test1\nTest2" close $f set f [open $path(test3)] set x {} set y {} lappend x [gets $f y] $y set y {} lappend x [gets $f y] $y set y {} lappend x [gets $f y] $y close $f set x } {5 Test1 5 Test2 -1 {}} test io-33.7 {Tcl_Gets and bad variable} { set f [open $path(test3) w] puts $f "Line 1" puts $f "Line 2" close $f catch {unset x} set x 24 set f [open $path(test3) r] set result [list [catch {gets $f x(0)} msg] $msg] close $f set result } {1 {can't set "x(0)": variable isn't array}} test io-33.8 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] fconfigure $f -translation lf -eofchar {} set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 100} {incr y} {puts $f $x} close $f set f [open $path(test3) r] fconfigure $f -translation lf for {set y 0} {$y < 100} {incr y} {gets $f} close $f set y } 100 test io-33.9 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] fconfigure $f -translation lf -eofchar {} set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 200} {incr y} {puts $f $x} close $f set f [open $path(test3) r] fconfigure $f -translation lf for {set y 0} {$y < 200} {incr y} {gets $f} close $f set y } 200 test io-33.10 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] fconfigure $f -translation lf -eofchar {} set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 300} {incr y} {puts $f $x} close $f set f [open $path(test3) r] fconfigure $f -translation lf for {set y 0} {$y < 300} {incr y} {gets $f} close $f set y } 300 test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) ....... return {initialize finalize watch read} } finalize { unset index($chan) buffer($chan) return } watch {} read { set n [lindex $args 1] if {$n > 3} {set n 3} set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new return $result } } } } -body { set c [chan create read [namespace which driver]] chan configure $c -translation binary -blocking 0 list [gets $c] [gets $c] [gets $c] [gets $c] } -cleanup { close $c rename driver {} } -result {{} {} {} .......} test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) ....... return {initialize finalize watch read} } finalize { unset index($chan) buffer($chan) return } watch {} read { set n [lindex $args 1] if {$n > 3} {set n 3} set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new return $result } } } } -body { set c [chan create read [namespace which driver]] chan configure $c -blocking 0 list [gets $c] [gets $c] [gets $c] [gets $c] } -cleanup { close $c rename driver {} } -result {{} {} {} .......} test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) [string repeat \ [string repeat . 64]\n[string repeat . 25] 2] return {initialize finalize watch read} } finalize { unset index($chan) buffer($chan) return } watch {} read { set n [lindex $args 1] if {$n > 65} {set n 65} set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new return $result } } } } -body { set c [chan create read [namespace which driver]] chan configure $c -blocking 0 list [gets $c] [gets $c] [gets $c] [gets $c] [gets $c] } -cleanup { close $c rename driver {} } -result [list [string repeat . 64] {} [string repeat . 89] \ [string repeat . 25] {}] # Test Tcl_Seek and Tcl_Tell. test io-34.1 {Tcl_Seek to current position at start of file} { set f1 [open $path(longfile) r] seek $f1 0 current set c [tell $f1] close $f1 set c } 0 test io-34.2 {Tcl_Seek to offset from start} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 start set c [tell $f1] close $f1 set c } 10 test io-34.3 {Tcl_Seek to end of file} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 0 end set c [tell $f1] close $f1 set c } 54 test io-34.4 {Tcl_Seek to offset from end of file} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c [tell $f1] close $f1 set c } 44 test io-34.5 {Tcl_Seek to offset from current position} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 current seek $f1 10 current set c [tell $f1] close $f1 set c } 20 test io-34.6 {Tcl_Seek to offset from end of file} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c [tell $f1] set r [read $f1] close $f1 list $c $r } {44 {rstuvwxyz }} test io-34.7 {Tcl_Seek to offset from end of file, then to current position} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c1 [tell $f1] set r1 [read $f1 5] seek $f1 0 current set c2 [tell $f1] close $f1 list $c1 $r1 $c2 } {44 rstuv 49} test io-34.8 {Tcl_Seek on pipes: not supported} stdio { set f1 [open "|[list [interpreter]]" r+] set x [list [catch {seek $f1 0 current} msg] $msg] close $f1 regsub {".*":} $x {"":} x string tolower $x } {1 {error during seek on "": invalid argument}} test io-34.9 {Tcl_Seek, testing buffered input flushing} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f -eofchar {} puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f set f [open $path(test3) RDWR] set x [read $f 1] seek $f 3 lappend x [read $f 1] seek $f 0 start lappend x [read $f 1] seek $f 10 current lappend x [read $f 1] seek $f -2 end lappend x [read $f 1] seek $f 50 end lappend x [read $f 1] seek $f 1 lappend x [read $f 1] close $f set x } {a d a l Y {} b} set path(test3) [makeFile {} test3] test io-34.10 {Tcl_Seek testing flushing of buffered input} { set f [open $path(test3) w] fconfigure $f -translation lf puts $f xyz\n123 close $f set f [open $path(test3) r+] fconfigure $f -translation lf set x [gets $f] seek $f 0 current puts $f 456 close $f list $x [viewFile test3] } "xyz {xyz 456}" test io-34.11 {Tcl_Seek testing flushing of buffered output} { set f [open $path(test3) w] puts $f xyz\n123 close $f set f [open $path(test3) w+] puts $f xyzzy seek $f 2 set x [gets $f] close $f list $x [viewFile test3] } "zzy xyzzy" test io-34.12 {Tcl_Seek testing combination of write, seek back and read} { set f [open $path(test3) w] fconfigure $f -translation lf -eofchar {} puts $f xyz\n123 close $f set f [open $path(test3) a+] fconfigure $f -translation lf -eofchar {} puts $f xyzzy flush $f set x [tell $f] seek $f -4 cur set y [gets $f] close $f list $x [viewFile test3] $y } {14 {xyz 123 xyzzy} zzy} test io-34.13 {Tcl_Tell at start of file} { file delete $path(test1) set f1 [open $path(test1) w] set p [tell $f1] close $f1 set p } 0 test io-34.14 {Tcl_Tell after seek to end of file} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 0 end set c1 [tell $f1] close $f1 set c1 } 54 test io-34.15 {Tcl_Tell combined with seeking} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 start set c1 [tell $f1] seek $f1 10 current set c2 [tell $f1] close $f1 list $c1 $c2 } {10 20} test io-34.16 {Tcl_Tell on pipe: always -1} stdio { set f1 [open "|[list [interpreter]]" r+] set c [tell $f1] close $f1 set c } -1 test io-34.17 {Tcl_Tell on pipe: always -1} stdio { set f1 [open "|[list [interpreter]]" r+] puts $f1 {puts hello} flush $f1 set c [tell $f1] gets $f1 close $f1 set c } -1 test io-34.18 {Tcl_Tell combined with seeking and reading} { file delete $path(test2) set f [open $path(test2) w] fconfigure $f -translation lf -eofchar {} puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n" close $f set f [open $path(test2)] fconfigure $f -translation lf set x [tell $f] read $f 3 lappend x [tell $f] seek $f 2 lappend x [tell $f] seek $f 10 current lappend x [tell $f] seek $f 0 end lappend x [tell $f] close $f set x } {0 3 2 12 30} test io-34.19 {Tcl_Tell combined with opening in append mode} { set f [open $path(test3) w] fconfigure $f -translation lf -eofchar {} puts $f "abcdefghijklmnopqrstuvwxyz" puts $f "abcdefghijklmnopqrstuvwxyz" close $f set f [open $path(test3) a] set c [tell $f] close $f set c } 54 test io-34.20 {Tcl_Tell combined with writing} { set f [open $path(test3) w] set l "" seek $f 29 start lappend l [tell $f] puts -nonewline $f a seek $f 39 start lappend l [tell $f] puts -nonewline $f a lappend l [tell $f] seek $f 407 end lappend l [tell $f] close $f set l } {29 39 40 447} test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f -encoding binary set l "" lappend l [tell $f] puts -nonewline $f abcdef lappend l [tell $f] flush $f lappend l [tell $f] # 4GB offset! seek $f 0x100000000 lappend l [tell $f] puts -nonewline $f abcdef lappend l [tell $f] close $f lappend l [file size $path(test3)] # truncate... close [open $path(test3) w] lappend l [file size $path(test3)] set l } {0 6 6 4294967296 4294967302 4294967302 0} # Test Tcl_Eof test io-35.1 {Tcl_Eof} { file delete $path(test1) set f [open $path(test1) w] puts $f hello puts $f hello close $f set f [open $path(test1)] set x [eof $f] lappend x [eof $f] gets $f lappend x [eof $f] gets $f lappend x [eof $f] gets $f lappend x [eof $f] lappend x [eof $f] close $f set x } {0 0 0 0 1 1} test io-35.2 {Tcl_Eof with pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {gets stdin} puts $f1 {puts hello} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello set x [eof $f1] flush $f1 lappend x [eof $f1] gets $f1 lappend x [eof $f1] gets $f1 lappend x [eof $f1] close $f1 set x } {0 0 0 1} test io-35.3 {Tcl_Eof with pipe} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {gets stdin} puts $f1 {puts hello} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello set x [eof $f1] flush $f1 lappend x [eof $f1] gets $f1 lappend x [eof $f1] gets $f1 lappend x [eof $f1] gets $f1 lappend x [eof $f1] gets $f1 lappend x [eof $f1] close $f1 set x } {0 0 0 1 1 1} test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} { file delete $path(test1) set f [open $path(test1) w] close $f set f [open $path(test1) r] fconfigure $f -blocking off set l "" lappend l [gets $f] lappend l [eof $f] close $f set l } {{} 1} test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio { file delete $path(pipe) set f [open $path(pipe) w] puts $f { exit } close $f set f [open "|[list [interpreter] $path(pipe)]" r] set l "" lappend l [gets $f] lappend l [eof $f] close $f set l } {{} 1} test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.7 {Tcl_Eof, eof char, lf write, lf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.8 {Tcl_Eof, eof char, cr write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.9 {Tcl_Eof, eof char, cr write, cr read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {11 8 1} test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {11 8 1} test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {21 8 1} test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {21 8 1} test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf set l [string length [set in [read $f]]] set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {8 8 1 13} test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {9 8 1 13} test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1A puts $f {} close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {2 1 1 13} test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f {} close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf set l [string length [set in [read $f]]] set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {1 1 1 13} test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $c $l $e [scan [string index $in end] %c] } -result {17 8 1 13} test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format \n%cqrsuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $c $l $e [scan [string index $in end] %c] } {9 1 1 13} # Test Tcl_InputBlocked test io-36.1 {Tcl_InputBlocked on nonblocking pipe} stdio { set f1 [open "|[list [interpreter]]" r+] puts $f1 {puts hello_from_pipe} flush $f1 gets $f1 fconfigure $f1 -blocking off -buffering full puts $f1 {puts hello} set x "" lappend x [gets $f1] lappend x [fblocked $f1] flush $f1 after 200 lappend x [gets $f1] lappend x [fblocked $f1] lappend x [gets $f1] lappend x [fblocked $f1] close $f1 set x } {{} 1 hello 0 {} 1} test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio { set f1 [open "|[list [interpreter]]" r+] chan configure $f1 -encoding binary -translation lf -eofchar {} puts $f1 { chan configure stdout -encoding binary -translation lf -eofchar {} puts hello_from_pipe } flush $f1 gets $f1 fconfigure $f1 -blocking off -buffering full puts $f1 {puts hello} set x "" lappend x [gets $f1] lappend x [fblocked $f1] flush $f1 after 200 lappend x [gets $f1] lappend x [fblocked $f1] lappend x [gets $f1] lappend x [fblocked $f1] close $f1 set x } {{} 1 hello 0 {} 1} test io-36.2 {Tcl_InputBlocked on blocking pipe} stdio { set f1 [open "|[list [interpreter]]" r+] fconfigure $f1 -buffering line puts $f1 {puts hello_from_pipe} set x "" lappend x [gets $f1] lappend x [fblocked $f1] puts $f1 {exit} lappend x [gets $f1] lappend x [fblocked $f1] lappend x [eof $f1] close $f1 set x } {hello_from_pipe 0 {} 0 1} test io-36.3 {Tcl_InputBlocked vs files, short read} { file delete $path(test1) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1) r] set l "" lappend l [fblocked $f] lappend l [read $f 3] lappend l [fblocked $f] lappend l [read -nonewline $f] lappend l [fblocked $f] lappend l [eof $f] close $f set l } {0 abc 0 defghijklmnop 0 1} test io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} { proc in {f} { variable l variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } file delete $path(test1) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1) r] set l "" fileevent $f readable [namespace code [list in $f]] variable x vwait [namespace which -variable x] set l } {abc def ghi jkl mno {p } eof} test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} { file delete $path(test1) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1) r] fconfigure $f -blocking off set l "" lappend l [fblocked $f] lappend l [read $f 3] lappend l [fblocked $f] lappend l [read -nonewline $f] lappend l [fblocked $f] lappend l [eof $f] close $f set l } {0 abc 0 defghijklmnop 0 1} test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} { proc in {f} { variable l variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } file delete $path(test1) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1) r] fconfigure $f -blocking off set l "" fileevent $f readable [namespace code [list in $f]] variable x vwait [namespace which -variable x] set l } {abc def ghi jkl mno {p } eof} # Test Tcl_InputBuffered test io-37.1 {Tcl_InputBuffered} {testchannel} { set f [open $path(longfile) r] fconfigure $f -buffersize 4096 read $f 3 set l "" lappend l [testchannel inputbuffered $f] lappend l [tell $f] close $f set l } {4093 3} test io-37.2 {Tcl_InputBuffered, test input flushing on seek} {testchannel} { set f [open $path(longfile) r] fconfigure $f -buffersize 4096 read $f 3 set l "" lappend l [testchannel inputbuffered $f] lappend l [tell $f] seek $f 0 current lappend l [testchannel inputbuffered $f] lappend l [tell $f] close $f set l } {4093 3 0 3} # Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize test io-38.1 {Tcl_GetChannelBufferSize, default buffer size} { set f [open $path(longfile) r] set s [fconfigure $f -buffersize] close $f set s } 4096 test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} { set f [open $path(longfile) r] set l "" lappend l [fconfigure $f -buffersize] fconfigure $f -buffersize 10000 lappend l [fconfigure $f -buffersize] fconfigure $f -buffersize 1 lappend l [fconfigure $f -buffersize] fconfigure $f -buffersize -1 lappend l [fconfigure $f -buffersize] fconfigure $f -buffersize 0 lappend l [fconfigure $f -buffersize] fconfigure $f -buffersize 100000 lappend l [fconfigure $f -buffersize] fconfigure $f -buffersize 10000000 lappend l [fconfigure $f -buffersize] close $f set l } {4096 10000 1 1 1 100000 1048576} test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed set chan [open [info script] r] fconfigure $chan -buffersize 10 set var [read $chan 2] fconfigure $chan -buffersize 32 append var [read $chan] close $chan } {} # Test Tcl_SetChannelOption, Tcl_GetChannelOption test io-39.1 {Tcl_GetChannelOption} { file delete $path(test1) set f1 [open $path(test1) w] set x [fconfigure $f1 -blocking] close $f1 set x } 1 test io-39.2 {Tcl_GetChannelOption} { file delete $path(test1) set f1 [open $path(test1) w] set x [fconfigure $f1 -buffering] close $f1 set x } full test io-39.3 {Tcl_GetChannelOption} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -buffering line set x [fconfigure $f1 -buffering] close $f1 set x } line test io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} { file delete $path(test1) set f1 [open $path(test1) w] set l "" lappend l [fconfigure $f1 -buffering] fconfigure $f1 -buffering line lappend l [fconfigure $f1 -buffering] fconfigure $f1 -buffering none lappend l [fconfigure $f1 -buffering] fconfigure $f1 -buffering line lappend l [fconfigure $f1 -buffering] fconfigure $f1 -buffering full lappend l [fconfigure $f1 -buffering] close $f1 set l } {full line none line full} test io-39.5 {Tcl_GetChannelOption, invariance} { file delete $path(test1) set f1 [open $path(test1) w] set l "" lappend l [fconfigure $f1 -buffering] lappend l [list [catch {fconfigure $f1 -buffering green} msg] $msg] lappend l [fconfigure $f1 -buffering] close $f1 set l } {full {1 {bad value for -buffering: must be one of full, line, or none}} full} test io-39.6 {Tcl_SetChannelOption, multiple options} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line puts $f1 hello puts $f1 bye set x [file size $path(test1)] close $f1 set x } 10 test io-39.7 {Tcl_SetChannelOption, buffering, translation} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 hello puts $f1 bye set x "" fconfigure $f1 -buffering line lappend x [file size $path(test1)] puts $f1 really_bye lappend x [file size $path(test1)] close $f1 set x } {0 21} test io-39.8 {Tcl_SetChannelOption, different buffering options} { file delete $path(test1) set f1 [open $path(test1) w] set l "" fconfigure $f1 -translation lf -buffering none -eofchar {} puts -nonewline $f1 hello lappend l [file size $path(test1)] puts -nonewline $f1 hello lappend l [file size $path(test1)] fconfigure $f1 -buffering full puts -nonewline $f1 hello lappend l [file size $path(test1)] fconfigure $f1 -buffering none lappend l [file size $path(test1)] puts -nonewline $f1 hello lappend l [file size $path(test1)] close $f1 lappend l [file size $path(test1)] set l } {5 10 10 10 20 20} test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} { file delete $path(test1) set f1 [open $path(test1) w] close $f1 set f1 [open $path(test1) r] set x "" lappend x [fconfigure $f1 -blocking] fconfigure $f1 -blocking off lappend x [fconfigure $f1 -blocking] lappend x [gets $f1] lappend x [read $f1 1000] lappend x [fblocked $f1] lappend x [eof $f1] close $f1 set x } {1 0 {} {} 0 1} test io-39.10 {Tcl_SetChannelOption, blocking mode} stdio { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { gets stdin after 100 puts hi gets stdin } close $f1 set x "" set f1 [open "|[list [interpreter] $path(pipe)]" r+] fconfigure $f1 -blocking off -buffering line lappend x [fconfigure $f1 -blocking] lappend x [gets $f1] lappend x [fblocked $f1] fconfigure $f1 -blocking on puts $f1 hello fconfigure $f1 -blocking off lappend x [gets $f1] lappend x [fblocked $f1] fconfigure $f1 -blocking on puts $f1 bye fconfigure $f1 -blocking off lappend x [gets $f1] lappend x [fblocked $f1] fconfigure $f1 -blocking on lappend x [fconfigure $f1 -blocking] lappend x [gets $f1] lappend x [fblocked $f1] lappend x [eof $f1] lappend x [gets $f1] lappend x [eof $f1] close $f1 set x } {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1} test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize -10 set x [fconfigure $f -buffersize] close $f set x } 1 test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize 10000000 set x [fconfigure $f -buffersize] close $f set x } 1048576 test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize 40000 set x [fconfigure $f -buffersize] close $f set x } 40000 test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -encoding {} puts -nonewline $f \xE7\x89\xA6 close $f set f [open $path(test1) r] fconfigure $f -encoding utf-8 set x [read $f] close $f set x } \u7266 test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -encoding binary puts -nonewline $f \xE7\x89\xA6 close $f set f [open $path(test1) r] fconfigure $f -encoding utf-8 set x [read $f] close $f set x } \u7266 test io-39.16 {Tcl_SetChannelOption: -encoding (shortened to "-en"), errors} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -en foobar } -cleanup { close $f } -returnCodes 1 -result {unknown encoding "foobar"} test io-39.16a {Tcl_SetChannelOption: -encoding (invalid shortening to "-e"), errors} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -e foobar } -cleanup { close $f } -returnCodes 1 -match glob -result {bad option "-e": should be one of *} test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} { set f [open "|[list [interpreter] $path(cat)]" r+] fconfigure $f -encoding binary puts -nonewline $f "\xE7" flush $f fconfigure $f -encoding utf-8 -blocking 0 variable x {} fileevent $f readable [namespace code { lappend x [read $f] }] vwait [namespace which -variable x] after 300 [namespace code { lappend x timeout }] vwait [namespace which -variable x] fconfigure $f -encoding utf-8 vwait [namespace which -variable x] after 300 [namespace code { lappend x timeout }] vwait [namespace which -variable x] fconfigure $f -encoding binary vwait [namespace which -variable x] after 300 [namespace code { lappend x timeout }] vwait [namespace which -variable x] close $f set x } "{} timeout {} timeout \xE7 timeout" test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [fconfigure $s1 -sockname] 2] set s2 [socket 127.0.0.1 $port] update fconfigure $s2 -translation {auto lf} set modes [fconfigure $s2 -translation] close $s1 close $s2 set modes } {auto lf} test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [fconfigure $s1 -sockname] 2] set s2 [socket 127.0.0.1 $port] update fconfigure $s2 -translation {auto crlf} set modes [fconfigure $s2 -translation] close $s1 close $s2 set modes } {auto crlf} test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [fconfigure $s1 -sockname] 2] set s2 [socket 127.0.0.1 $port] update fconfigure $s2 -translation {auto cr} set modes [fconfigure $s2 -translation] close $s1 close $s2 set modes } {auto cr} test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [fconfigure $s1 -sockname] 2] set s2 [socket 127.0.0.1 $port] update fconfigure $s2 -translation {auto auto} set modes [fconfigure $s2 -translation] close $s1 close $s2 set modes } {auto crlf} test io-39.22 {Tcl_SetChannelOption, invariance} {unix} { file delete $path(test1) set f1 [open $path(test1) w+] set l "" lappend l [fconfigure $f1 -eofchar] fconfigure $f1 -eofchar {ON GO} lappend l [fconfigure $f1 -eofchar] fconfigure $f1 -eofchar D lappend l [fconfigure $f1 -eofchar] close $f1 set l } {{{} {}} {O G} {D D}} test io-39.22a {Tcl_SetChannelOption, invariance} { file delete $path(test1) set f1 [open $path(test1) w+] set l [list] fconfigure $f1 -eofchar {ON GO} lappend l [fconfigure $f1 -eofchar] fconfigure $f1 -eofchar D lappend l [fconfigure $f1 -eofchar] lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg] close $f1 set l } {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} test io-39.23 {Tcl_GetChannelOption, server socket is not readable or writable, it should still have valid -eofchar and -translation options } { set l [list] set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] close $sock set l } {{{}} auto} test io-39.24 {Tcl_SetChannelOption, server socket is not readable or writable so we can't change -eofchar or -translation } { set l [list] set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] fconfigure $sock -eofchar D -translation lf lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] close $sock set l } {{{}} auto} test io-40.1 {POSIX open access modes: RDWR} { file delete $path(test3) set f [open $path(test3) w] puts $f xyzzy close $f set f [open $path(test3) RDWR] puts -nonewline $f "ab" seek $f 0 current set x [gets $f] close $f set f [open $path(test3) r] lappend x [gets $f] close $f set x } {zzy abzzy} test io-40.2 {POSIX open access modes: CREAT} {unix notWsl} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats set x [format "0o%o" [expr {$stats(mode)&0o777}]] puts $f "line 1" close $f set f [open $path(test3) r] lappend x [gets $f] close $f set x } {0o600 {line 1}} test io-40.3 {POSIX open access modes: CREAT} {unix umask notWsl} { # This test only works if your umask is 2, like ouster's. file delete $path(test3) set f [open $path(test3) {WRONLY CREAT}] close $f file stat $path(test3) stats format 0o%03o [expr {$stats(mode)&0o777}] } [format 0o%03o [expr {0o666 & ~ $umaskValue}]] test io-40.4 {POSIX open access modes: CREAT} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f -eofchar {} puts $f xyzzy close $f set f [open $path(test3) {WRONLY CREAT}] fconfigure $f -eofchar {} puts -nonewline $f "ab" close $f set f [open $path(test3) r] set x [gets $f] close $f set x } abzzy test io-40.5 {POSIX open access modes: APPEND} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f -translation lf -eofchar {} puts $f xyzzy close $f set f [open $path(test3) {WRONLY APPEND}] fconfigure $f -translation lf puts $f "new line" seek $f 0 puts $f "abc" close $f set f [open $path(test3) r] fconfigure $f -translation lf set x "" seek $f 6 current lappend x [gets $f] lappend x [gets $f] close $f set x } {{new line} abc} test io-40.6 {POSIX open access modes: EXCL} -match regexp -body { file delete $path(test3) set f [open $path(test3) w] puts $f xyzzy close $f open $path(test3) {WRONLY CREAT EXCL} } -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists} test io-40.7 {POSIX open access modes: EXCL} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT EXCL}] fconfigure $f -eofchar {} puts $f "A test line" close $f viewFile test3 } {A test line} test io-40.8 {POSIX open access modes: TRUNC} { file delete $path(test3) set f [open $path(test3) w] puts $f xyzzy close $f set f [open $path(test3) {WRONLY TRUNC}] puts $f abc close $f set f [open $path(test3) r] set x [gets $f] close $f set x } abc test io-40.9 {POSIX open access modes: NONBLOCK} {nonPortable unix} { file delete $path(test3) set f [open $path(test3) {WRONLY NONBLOCK CREAT}] puts $f "NONBLOCK test" close $f set f [open $path(test3) r] set x [gets $f] close $f set x } {NONBLOCK test} test io-40.10 {POSIX open access modes: RDONLY} { set f [open $path(test1) w] puts $f "two lines: this one" puts $f "and this" close $f set f [open $path(test1) RDONLY] set x [list [gets $f] [catch {puts $f Test} msg] $msg] close $f string compare [string tolower $x] \ [list {two lines: this one} 1 \ [format "channel \"%s\" wasn't opened for writing" $f]] } 0 test io-40.11 {POSIX open access modes: RDONLY} -match regexp -body { file delete $path(test3) open $path(test3) RDONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test io-40.12 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test io-40.13 {POSIX open access modes: WRONLY} { makeFile xyzzy test3 set f [open $path(test3) WRONLY] fconfigure $f -eofchar {} puts -nonewline $f "ab" seek $f 0 current set x [list [catch {gets $f} msg] $msg] close $f lappend x [viewFile test3] string compare [string tolower $x] \ [list 1 "channel \"$f\" wasn't opened for reading" abzzy] } 0 test io-40.14 {POSIX open access modes: RDWR} -match regexp -body { file delete $path(test3) open $path(test3) RDWR } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test io-40.15 {POSIX open access modes: RDWR} { makeFile xyzzy test3 set f [open $path(test3) RDWR] puts -nonewline $f "ab" seek $f 0 current set x [gets $f] close $f lappend x [viewFile test3] } {zzy abzzy} test io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup { makeFile {Some text} _test_ ~ } -body { file exists [file join $::env(HOME) _test_] } -cleanup { removeFile _test_ ~ } -result 1 test io-40.17 {tilde substitution in open} { set home $::env(HOME) unset ::env(HOME) set x [list [catch {open ~/foo} msg] $msg] set ::env(HOME) $home set x } {1 {couldn't find HOME environment variable to expand path}} test io-41.1 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent foo} msg] $msg } {1 {wrong # args: should be "fileevent channelId event ?script?"}} test io-41.2 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent foo bar baz q} msg] $msg } {1 {wrong # args: should be "fileevent channelId event ?script?"}} test io-41.3 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent gorp readable} msg] $msg } {1 {can not find channel named "gorp"}} test io-41.4 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent gorp writable} msg] $msg } {1 {can not find channel named "gorp"}} test io-41.5 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent gorp who-knows} msg] $msg } {1 {bad event name "who-knows": must be readable or writable}} # # Test fileevent on a file # set path(foo) [makeFile {} foo] set f [open $path(foo) w+] test io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {fileevent} { list [fileevent $f readable] [fileevent $f writable] } {{} {}} test io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} { set result {} fileevent $f r "first script" lappend result [fileevent $f readable] fileevent $f r "new script" lappend result [fileevent $f readable] fileevent $f r "yet another" lappend result [fileevent $f readable] fileevent $f r "" lappend result [fileevent $f readable] } {{first script} {new script} {yet another} {}} test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} { set result {} fileevent $f r "first scr\x00ipt" lappend result [string length [fileevent $f readable]] fileevent $f r "new scr\x00ipt" lappend result [string length [fileevent $f readable]] fileevent $f r "yet ano\x00ther" lappend result [string length [fileevent $f readable]] fileevent $f r "" lappend result [fileevent $f readable] } {13 11 12 {}} test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} { set result {} fileevent $f readable "script 1" lappend result [fileevent $f readable] [fileevent $f writable] fileevent $f writable "write script" lappend result [fileevent $f readable] [fileevent $f writable] fileevent $f readable {} lappend result [fileevent $f readable] [fileevent $f writable] fileevent $f writable {} lappend result [fileevent $f readable] [fileevent $f writable] } {{script 1} {} {script 1} {write script} {} {write script} {} {}} test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent} -body { set result {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f r "read f" fileevent $f2 r "read f2" fileevent $f3 r "read f3" lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f2 r {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f3 r {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f r {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] } -cleanup { catch {close $f2} catch {close $f3} } -result {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}} test io-44.1 {FileEventProc procedure: normal read event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent} -body { fileevent $f2 readable [namespace code { set x [gets $f2]; fileevent $f2 readable {} }] puts $f2 text; flush $f2 variable x initial vwait [namespace which -variable x] set x } -cleanup { catch {close $f2} catch {close $f3} } -result {text} test io-44.2 {FileEventProc procedure: error in read event} -constraints { stdio unixExecs fileevent } -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] proc myHandler {msg options} { variable x $msg } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { fileevent $f2 readable {error bogus} puts $f2 text; flush $f2 variable x initial vwait [namespace which -variable x] list $x [fileevent $f2 readable] } -cleanup { interp bgerror {} $handler catch {close $f2} catch {close $f3} } -result {bogus {}} test io-44.3 {FileEventProc procedure: normal write event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent} -body { fileevent $f2 writable [namespace code { lappend x "triggered" incr count -1 if {$count <= 0} { fileevent $f2 writable {} } }] variable x initial set count 3 vwait [namespace which -variable x] vwait [namespace which -variable x] vwait [namespace which -variable x] set x } -cleanup { catch {close $f2} catch {close $f3} } -result {initial triggered triggered triggered} test io-44.4 {FileEventProc procedure: eror in write event} -constraints { stdio unixExecs fileevent } -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] proc myHandler {msg options} { variable x $msg } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { fileevent $f2 writable {error bad-write} variable x initial vwait [namespace which -variable x] list $x [fileevent $f2 writable] } -cleanup { interp bgerror {} $handler catch {close $f2} catch {close $f3} } -result {bad-write {}} test io-44.5 {FileEventProc procedure: end of file} -constraints { stdio unixExecs fileevent } -body { set f4 [open "|[list [interpreter] $path(cat) << foo]" r] fileevent $f4 readable [namespace code { if {[gets $f4 line] < 0} { lappend x eof fileevent $f4 readable {} } else { lappend x $line } }] variable x initial vwait [namespace which -variable x] vwait [namespace which -variable x] set x } -cleanup { close $f4 } -result {initial foo eof} close $f makeFile "foo bar" foo test io-45.1 {DeleteFileEvent, cleanup on close} {fileevent} { set f [open $path(foo) r] fileevent $f readable [namespace code { lappend x "binding triggered: \"[gets $f]\"" fileevent $f readable {} }] close $f set x initial after 100 [namespace code { set y done }] variable y vwait [namespace which -variable y] set x } {initial} test io-45.2 {DeleteFileEvent, cleanup on close} {fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] fileevent $f readable [namespace code { lappend x "f triggered: \"[gets $f]\"" fileevent $f readable {} }] fileevent $f2 readable [namespace code { lappend x "f2 triggered: \"[gets $f2]\"" fileevent $f2 readable {} }] close $f variable x initial vwait [namespace which -variable x] close $f2 set x } {initial {f2 triggered: "foo bar"}} test io-45.3 {DeleteFileEvent, cleanup on close} {fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] fileevent $f readable {f script} fileevent $f2 readable {f2 script} fileevent $f3 readable {f3 script} set x {} close $f2 lappend x [catch {fileevent $f readable} msg] $msg \ [catch {fileevent $f2 readable}] \ [catch {fileevent $f3 readable} msg] $msg close $f3 lappend x [catch {fileevent $f readable} msg] $msg \ [catch {fileevent $f2 readable}] \ [catch {fileevent $f3 readable}] close $f lappend x [catch {fileevent $f readable}] \ [catch {fileevent $f2 readable}] \ [catch {fileevent $f3 readable}] } {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1} # Execute these tests only if the "testfevent" command is present. test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent notOSX} { testfevent create set script "set f \[[list open $path(foo) r]]\n" append script { set x "no event" fileevent $f readable [namespace code { set x "f triggered: [gets $f]" fileevent $f readable {} }] } set timer [after 10 lappend x timeout] testfevent cmd $script vwait x after cancel $timer testfevent cmd {close $f} list [testfevent cmd {set x}] [testfevent cmd {info commands after}] } {{f triggered: foo bar} after} test io-46.2 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { variable x 0 after 100 {set x triggered} vwait [namespace which -variable x] set x } } {triggered} test io-46.3 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { set x 0 after 10 {lappend x timer} after 30 set result $x update idletasks lappend result $x update lappend result $x } } {0 0 {0 timer}} test io-47.1 {fileevent vs multiple interpreters} {testfevent fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] fileevent $f readable {script 1} testfevent create testfevent share $f2 testfevent cmd "fileevent $f2 readable {script 2}" fileevent $f3 readable {sript 3} set x {} lappend x [fileevent $f2 readable] testfevent delete lappend x [fileevent $f readable] [fileevent $f2 readable] \ [fileevent $f3 readable] close $f close $f2 close $f3 set x } {{} {script 1} {} {sript 3}} test io-47.2 {deleting fileevent on interpreter delete} {testfevent fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] set f4 [open $path(foo) r] fileevent $f readable {script 1} testfevent create testfevent share $f2 testfevent share $f3 testfevent cmd "fileevent $f2 readable {script 2} fileevent $f3 readable {script 3}" fileevent $f4 readable {script 4} testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 close $f4 set x } {{script 1} {} {} {script 4}} test io-47.3 {deleting fileevent on interpreter delete} {testfevent fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] set f4 [open $path(foo) r] testfevent create testfevent share $f3 testfevent share $f4 fileevent $f readable {script 1} fileevent $f2 readable {script 2} testfevent cmd "fileevent $f3 readable {script 3} fileevent $f4 readable {script 4}" testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 close $f4 set x } {{script 1} {script 2} {} {}} test io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] testfevent create testfevent share $f testfevent cmd "fileevent $f readable {script 1}" fileevent $f readable {script 2} fileevent $f2 readable {script 3} set x [list [fileevent $f2 readable] \ [testfevent cmd "fileevent $f readable"] \ [fileevent $f readable]] testfevent delete close $f close $f2 set x } {{script 3} {script 1} {script 2}} test io-47.5 {file events on shared files, deleting file events} {testfevent fileevent} { set f [open $path(foo) r] testfevent create testfevent share $f testfevent cmd "fileevent $f readable {script 1}" fileevent $f readable {script 2} testfevent cmd "fileevent $f readable {}" set x [list [testfevent cmd "fileevent $f readable"] \ [fileevent $f readable]] testfevent delete close $f set x } {{} {script 2}} test io-47.6 {file events on shared files, deleting file events} {testfevent fileevent} { set f [open $path(foo) r] testfevent create testfevent share $f testfevent cmd "fileevent $f readable {script 1}" fileevent $f readable {script 2} fileevent $f readable {} set x [list [testfevent cmd "fileevent $f readable"] \ [fileevent $f readable]] testfevent delete close $f set x } {{script 1} {}} unset path(foo) removeFile foo set path(bar) [makeFile {} bar] test io-48.1 {testing readability conditions} {fileevent} { set f [open $path(bar) w] puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg close $f set f [open $path(bar) r] fileevent $f readable [namespace code [list consume $f]] proc consume {f} { variable l variable x lappend l called if {[eof $f]} { close $f set x done } else { gets $f } } set l "" variable x not_done vwait [namespace which -variable x] list $x $l } {done {called called called called called called called}} test io-48.2 {testing readability conditions} {nonBlockFiles fileevent} { set f [open $path(bar) w] puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg close $f set f [open $path(bar) r] fileevent $f readable [namespace code [list consume $f]] fconfigure $f -blocking off proc consume {f} { variable x variable l lappend l called if {[eof $f]} { close $f set x done } else { gets $f } } set l "" variable x not_done vwait [namespace which -variable x] list $x $l } {done {called called called called called called called}} set path(my_script) [makeFile {} my_script] test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles fileevent} { set f [open $path(bar) w] puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg close $f set f [open $path(my_script) w] puts $f { proc copy_slowly {f} { while {![eof $f]} { puts [gets $f] after 200 } close $f } } close $f set f [open "|[list [interpreter]]" r+] fileevent $f readable [namespace code [list consume $f]] fconfigure $f -buffering line fconfigure $f -blocking off proc consume {f} { variable l variable x if {[eof $f]} { set x done } else { gets $f lappend l [fblocked $f] gets $f lappend l [fblocked $f] } } set l "" variable x not_done puts $f [list source $path(my_script)] puts $f "set f \[[list open $path(bar) r]]" puts $f {copy_slowly $f} puts $f {exit} vwait [namespace which -variable x] close $f list $x $l } {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}} unset path(bar) removeFile bar test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf variable c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable c variable x if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable x variable c if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable x variable c if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable c variable x if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable x variable c if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable c variable x if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable c variable x if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable x variable c if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable x variable c if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable c variable x variable l if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable c variable x variable l if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable c variable x variable l if {[eof $f]} { set x done close $f } else { lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-49.1 {testing crlf reading, leftover cr disgorgment} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)] fconfigure $f -translation crlf lappend l [read $f 1] lappend l [tell $f] lappend l [read $f 1] lappend l [tell $f] lappend l [read $f 1] lappend l [tell $f] lappend l [read $f 1] lappend l [tell $f] lappend l [read $f 1] lappend l [tell $f] lappend l [read $f 1] lappend l [tell $f] lappend l [eof $f] lappend l [read $f 1] lappend l [eof $f] close $f set l } "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 { } 7 0 {} 1" test io-49.2 {testing crlf reading, leftover cr disgorgment} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)] fconfigure $f -translation crlf lappend l [read $f 2] lappend l [tell $f] lappend l [read $f 2] lappend l [tell $f] lappend l [read $f 2] lappend l [tell $f] lappend l [eof $f] lappend l [read $f 2] lappend l [tell $f] lappend l [eof $f] close $f set l } "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1" test io-49.3 {testing crlf reading, leftover cr disgorgment} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)] fconfigure $f -translation crlf lappend l [read $f 3] lappend l [tell $f] lappend l [read $f 3] lappend l [tell $f] lappend l [eof $f] lappend l [read $f 3] lappend l [tell $f] lappend l [eof $f] close $f set l } "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1" test io-49.4 {testing crlf reading, leftover cr disgorgment} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)] fconfigure $f -translation crlf lappend l [read $f 3] lappend l [tell $f] lappend l [gets $f] lappend l [tell $f] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [eof $f] close $f set l } "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1" test io-49.5 {testing crlf reading, leftover cr disgorgment} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)] fconfigure $f -translation crlf lappend l [set x [gets $f]] lappend l [tell $f] lappend l [gets $f] lappend l [tell $f] lappend l [eof $f] close $f set l } [list 7 a\rb\rc 7 {} 7 1] test io-50.1 {testing handler deletion} -constraints {testchannelevent testservicemode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] close $f update proc delhandler {f} { variable z set z called testchannelevent $f delete 0 } set z not_called set timer [after 50 lappend z timeout] testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list delhandler $f]] testservicemode 1 vwait z after cancel $timer set z } -cleanup { close $f } -result called test io-50.2 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] close $f proc delhandler {f i} { variable z lappend z "called delhandler $i" testchannelevent $f delete 0 } set z "" testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list delhandler $f 1]] testchannelevent $f add readable [namespace code [list delhandler $f 0]] testservicemode 1 set timer [after 50 lappend z timeout] vwait z after cancel $timer set z } -cleanup { close $f } -result {{called delhandler 0} {called delhandler 1}} test io-50.3 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] close $f set z "" proc notcalled {f i} { variable z lappend z "notcalled was called!! $f $i" } proc delhandler {f i} { variable z testchannelevent $f delete 1 lappend z "delhandler $i called" testchannelevent $f delete 0 lappend z "delhandler $i deleted myself" } set z "" testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list notcalled $f 1]] testchannelevent $f add readable [namespace code [list delhandler $f 0]] testservicemode 1 set timer [after 50 lappend z timeout] vwait z after cancel $timer set z } -cleanup { close $f } -result {{delhandler 0 called} {delhandler 0 deleted myself}} test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup { file delete $path(test1) update } -body { set f [open $path(test1) w] close $f update proc delrecursive {f} { variable z variable u if {"$u" == "recursive"} { testchannelevent $f delete 0 lappend z "delrecursive deleting recursive" } else { lappend z "delrecursive calling recursive" set u recursive update } } variable u toplevel variable z "" testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list delrecursive $f]] testservicemode 1 set timer [after 50 lappend z timeout] vwait z after cancel $timer set z } -cleanup { close $f } -result {{delrecursive calling recursive} {delrecursive deleting recursive}} test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode notOSX} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] close $f proc notcalled {f} { variable z lappend z "notcalled was called!! $f" } proc del {f} { variable u variable z if {"$u" == "recursive"} { testchannelevent $f delete 1 lappend z "del deleted notcalled" testchannelevent $f delete 0 lappend z "del deleted myself" } else { set u recursive lappend z "del calling recursive" set timer [after 50 lappend z timeout] vwait z after cancel $timer lappend z "del after recursive" } } set z "" set u toplevel testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list notcalled $f]] testchannelevent $f add readable [namespace code [list del $f]] testservicemode 1 set timer [after 50 set z timeout] vwait z after cancel $timer set z } -cleanup { close $f } -result [list {del calling recursive} {del deleted notcalled} \ {del deleted myself} {del after recursive}] test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] close $f proc first {f} { variable u variable z variable done if {"$u" == "toplevel"} { lappend z "first called" set u first set timer [after 50 lappend z timeout] vwait z after cancel $timer lappend z "first after toplevel" set done 1 } else { lappend z "first called not toplevel" } } proc second {f} { variable u variable z if {"$u" == "first"} { lappend z "second called, first time" set u second testchannelevent $f delete 0 } elseif {"$u" == "second"} { lappend z "second called, second time" testchannelevent $f delete 0 } else { lappend z "second called, cannot happen!" testchannelevent $f removeall } } set z "" set u toplevel set done 0 testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list second $f]] testchannelevent $f add readable [namespace code [list first $f]] testservicemode 1 update if {!$done} { set timer2 [after 200 set done 1] vwait done after cancel $timer2 } set z } -cleanup { close $f } -result [list {first called} {first called not toplevel} \ {second called, first time} {second called, second time} \ {first after toplevel}] test io-51.1 {Test old socket deletion on Macintosh} {socket} { set x 0 set result "" proc accept {s a p} { variable x variable wait fconfigure $s -blocking off puts $s "sock[incr x]" close $s set wait done } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [fconfigure $ss -sockname] 2] variable wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [gets $cs] close $cs set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [gets $cs] close $cs set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [gets $cs] close $cs set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [gets $cs] close $cs close $ss set result } {sock1 sock2 sock3 sock4} test io-52.1 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fcopy $f1 $f2 -command { # } catch { fcopy $f1 $f2 } msg close $f1 close $f2 string compare $msg "channel \"$f1\" is busy" } {0} test io-52.2 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] set f3 [open $thisScript] fcopy $f1 $f2 -command { # } catch { fcopy $f3 $f2 } msg close $f1 close $f2 close $f3 string compare $msg "channel \"$f2\" is busy" } {0} test io-52.3 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation cr -blocking 0 set s0 [fcopy $f1 $f2] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { lappend result ok } set result } {0 0 ok} test io-52.4 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation cr -blocking 0 fcopy $f1 $f2 -size 40 set result [list [fblocked $f1] [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 lappend result [file size $path(test1)] } {0 0 0 40} test io-52.4.1 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 -buffersize 10000000 fconfigure $f2 -translation cr -blocking 0 fcopy $f1 $f2 -size 40 set result [list [fblocked $f1] [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 lappend result [file size $path(test1)] } {0 0 0 40} test io-52.5 {TclCopyChannel, all} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified. set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { lappend result ok } set result } {0 0 ok} test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { lappend result ok } set result } {0 0 ok} test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { lappend result ok } set result } {0 0 ok} test io-52.6 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { lappend result ok } set result } {0 0 ok} test io-52.7 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] set s1 [file size $thisScript] set s2 [file size $path(test1)] close $f1 close $f2 if {"$s1" == "$s2"} { lappend result ok } set result } {0 0 ok} test io-52.8 {TclCopyChannel} {stdio fcopy} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] fconfigure $f1 -translation lf puts $f1 " puts ready gets stdin set f1 \[open [list $thisScript] r\] fconfigure \$f1 -translation lf puts \[read \$f1 100\] close \$f1 " close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] fconfigure $f1 -translation lf gets $f1 puts $f1 ready flush $f1 set f2 [open $path(test1) w] fconfigure $f2 -translation lf set s0 [fcopy $f1 $f2 -size 40] catch {close $f1} close $f2 list $s0 [file size $path(test1)] } {40 40} # Empty files, to register them with the test facility set path(kyrillic.txt) [makeFile {} kyrillic.txt] set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt] set path(utf8-rp.txt) [makeFile {} utf8-rp.txt] # Create kyrillic file, use lf translation to avoid os eol issues set out [open $path(kyrillic.txt) w] fconfigure $out -encoding koi8-r -translation lf puts $out "\u0410\u0410" close $out test io-52.9 {TclCopyChannel & encodings} {fcopy} { # Copy kyrillic to UTF-8, using fcopy. set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] fconfigure $in -encoding koi8-r -translation lf fconfigure $out -encoding utf-8 -translation lf fcopy $in $out close $in close $out # Do the same again, but differently (read/puts). set in [open $path(kyrillic.txt) r] set out [open $path(utf8-rp.txt) w] fconfigure $in -encoding koi8-r -translation lf fconfigure $out -encoding utf-8 -translation lf puts -nonewline $out [read $in] close $in close $out list [file size $path(kyrillic.txt)] \ [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} test io-52.10 {TclCopyChannel & encodings} {fcopy} { # encoding to binary (=> implies that the # internal utf-8 is written) set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] fconfigure $in -encoding koi8-r -translation lf # -translation binary is also -encoding binary fconfigure $out -translation binary fcopy $in $out close $in close $out file size $path(utf8-fcopy.txt) } 5 test io-52.11 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf puts $out "\u0410\u0410" close $out } -constraints {fcopy} -body { # binary to encoding => the input has to be # in utf-8 to make sense to the encoder set in [open $path(utf8-fcopy.txt) r] set out [open $path(kyrillic.txt) w] # -translation binary is also -encoding binary fconfigure $in -translation binary fconfigure $out -encoding koi8-r -translation lf fcopy $in $out close $in close $out file size $path(kyrillic.txt) } -result 3 test io-52.12 {coverage of -translation auto} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -buffersize 8 set out [open $path(test2) w] chan configure $out -translation lf fcopy $in $out close $in close $out file size $path(test2) } 29 test io-52.13 {coverage of -translation cr} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -buffersize 8 -translation cr set out [open $path(test2) w] chan configure $out -translation lf fcopy $in $out close $in close $out file size $path(test2) } 30 test io-52.14 {coverage of -translation crlf} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -buffersize 8 -translation crlf set out [open $path(test2) w] chan configure $out -translation lf fcopy $in $out close $in close $out file size $path(test2) } 29 test io-52.14.1 {coverage of -translation crlf} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -buffersize 8 -translation crlf set out [open $path(test2) w] fcopy $in $out -size 2 close $in close $out file size $path(test2) } 2 test io-52.14.2 {coverage of -translation crlf} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -translation crlf set out [open $path(test2) w] fcopy $in $out -size 9 close $in close $out file size $path(test2) } 9 test io-52.15 {coverage of -translation crlf} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\r close $out set in [open $path(test1)] chan configure $in -buffersize 8 -translation crlf set out [open $path(test2) w] fcopy $in $out close $in close $out file size $path(test2) } 8 test io-52.16 {coverage of eofChar handling} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -buffersize 8 -translation lf -eofchar a set out [open $path(test2) w] fcopy $in $out close $in close $out file size $path(test2) } 0 test io-52.17 {coverage of eofChar handling} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -buffersize 8 -translation lf -eofchar d set out [open $path(test2) w] fcopy $in $out close $in close $out file size $path(test2) } 3 test io-52.18 {coverage of eofChar handling} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -buffersize 8 -translation crlf -eofchar h set out [open $path(test2) w] fcopy $in $out close $in close $out file size $path(test2) } 8 test io-52.19 {coverage of eofChar handling} { file delete $path(test1) $path(test2) set out [open $path(test1) wb] chan configure $out -translation lf puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz close $out set in [open $path(test1)] chan configure $in -buffersize 10 -translation crlf -eofchar h set out [open $path(test2) w] fcopy $in $out close $in close $out file size $path(test2) } 8 test io-53.1 {CopyData} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation cr -blocking 0 fcopy $f1 $f2 -size 0 set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 lappend result [file size $path(test1)] } {0 0 0} test io-53.2 {CopyData} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation cr -blocking 0 fcopy $f1 $f2 -command [namespace code {set s0}] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] variable s0 vwait [namespace which -variable s0] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { lappend result ok } set result } {0 0 ok} test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts -nonewline $f1 { puts ready flush stdout ;# Don't assume line buffered! fcopy stdin stdout -command { set x } vwait x set f [} puts $f1 [list open $path(test1) w]] puts $f1 { fconfigure $f -translation lf puts $f "done" close $f } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] set result [gets $f1] puts $f1 line1 flush $f1 lappend result [gets $f1] puts $f1 line2 flush $f1 lappend result [gets $f1] close $f1 after 500 set f [open $path(test1)] lappend result [read $f] close $f set result } "ready line1 line2 {done\n}" test io-53.4 {CopyData: background write overflow} {stdio fileevent fcopy} { set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n variable x for {set x 0} {$x < 12} {incr x} { append big $big } file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { puts ready fcopy stdin stdout -command { set x } vwait x } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] set result [gets $f1] fconfigure $f1 -blocking 0 puts $f1 $big flush $f1 set result "" fileevent $f1 read [namespace code { append result [read $f1 1024] if {[string length $result] >= [string length $big]+1} { set x done } }] vwait [namespace which -variable x] close $f1 set big {} set x } done test io-53.4.1 {Bug 894da183c8} {stdio fcopy} { set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n variable x for {set x 0} {$x < 12} {incr x} { append big $big } file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 [list file delete $path(test1)] puts $f1 { puts ready set f [open io-53.4.1 w] chan configure $f -translation lf fcopy stdin $f -command { set x } vwait x close $f } puts $f1 "close \[[list open $path(test1) w]]" close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] set result [gets $f1] fconfigure $f1 -blocking 0 -buffersize 125000 -translation lf puts $f1 $big fconfigure $f1 -blocking 1 close $f1 set big {} while {[catch {glob $path(test1)}]} {after 50} file delete $path(test1) set check [file size io-53.4.1] file delete io-53.4.1 set check } 266241 set result {} proc FcopyTestAccept {sock args} { after 1000 "close $sock" } proc FcopyTestDone {bytes {error {}}} { variable fcopyTestDone if {[string length $error]} { set fcopyTestDone 1 } else { set fcopyTestDone 0 } } test io-53.5 {CopyData: error during fcopy} {socket fcopy} { variable fcopyTestDone set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0] set in [open $thisScript] ;# 126 K set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]] catch {unset fcopyTestDone} close $listen ;# This means the socket open never really succeeds fcopy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g. } close $in close $out set fcopyTestDone ;# 1 for error condition } 1 test io-53.6 {CopyData: error during fcopy} {stdio fcopy} { variable fcopyTestDone file delete $path(pipe) file delete $path(test1) catch {unset fcopyTestDone} set f1 [open $path(pipe) w] puts $f1 "exit 1" close $f1 set in [open "|[list [interpreter] $path(pipe)]" r+] set out [open $path(test1) w] fcopy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } catch {close $in} close $out set fcopyTestDone ;# 0 for plain end of file } {0} proc doFcopy {in out {bytes 0} {error {}}} { variable fcopyTestDone variable fcopyTestCount incr fcopyTestCount $bytes if {[string length $error]} { set fcopyTestDone 1 } elseif {[eof $in]} { set fcopyTestDone 0 } else { # Delay next fcopy to wait for size>0 input bytes after 100 [list fcopy $in $out -size 1000 \ -command [namespace code [list doFcopy $in $out]]] } } test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} { variable fcopyTestDone file delete $path(pipe) catch {unset fcopyTestDone} set fcopyTestCount 0 set f1 [open $path(pipe) w] puts $f1 { # Write 10 bytes / 10 msec proc Write {count} { puts -nonewline "1234567890" if {[incr count -1]} { after 10 [list Write $count] } else { set ::ready 1 } } fconfigure stdout -buffering none Write 345 ;# 3450 bytes ~3.45 sec vwait ready exit 0 } close $f1 set in [open "|[list [interpreter] $path(pipe) &]" r+] set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } catch {close $in} close $out # -1=error 0=script error N=number of bytes expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1} } {3450} test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { # copy progress callback. errors out intentionally proc ::cmd args { lappend ::RES "CMD $args" error !STOP } # capture callback error here proc ::bgerror args { lappend ::RES "bgerror/OK $args" set ::forever has-been-reached return } # Files we use for our channels set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] set bar [makeFile {} bar] # Channels to copy between set f [open $foo r] ; fconfigure $f -translation binary set g [open $bar w] ; fconfigure $g -translation binary -buffering none } -constraints {stdio fcopy} -body { # Record input size, so that result is always defined lappend ::RES [file size $bar] # Run the copy. Should not invoke -command now. fcopy $f $g -size 2 -command ::cmd # Check that -command was not called synchronously set sbs [file size $bar] lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs # Now let the async part happen. Should capture the error in cmd # via bgerror. If not break the event loop via timer. set token [after 1000 { lappend ::RES {bgerror/FAIL timeout} set ::forever has-been-reached }] vwait ::forever catch {after cancel $token} # Report set ::RES } -cleanup { close $f close $g catch {unset ::RES} catch {unset ::forever} rename ::cmd {} rename ::bgerror {} removeFile foo removeFile bar } -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}} test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -setup { # copy progress callback. errors out intentionally proc ::cmd args { lappend ::RES "CMD $args" set ::forever has-been-reached return } # Files we use for our channels set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] set bar [makeFile {} bar] # Channels to copy between set f [open $foo r] ; fconfigure $f -translation binary set g [open $bar w] ; fconfigure $g -translation binary -buffering none } -constraints {stdio fcopy} -body { # Initialize and force eof on the input. seek $f 0 end ; read $f 1 set ::RES [eof $f] # Run the copy. Should not invoke -command now. fcopy $f $g -size 2 -command ::cmd # Check that -command was not called synchronously lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}] # Now let the async part happen. Should capture the eof in cmd # If not break the event loop via timer. set token [after 1000 { lappend ::RES {cmd/FAIL timeout} set ::forever has-been-reached }] vwait ::forever catch {after cancel $token} # Report set ::RES } -cleanup { close $f close $g catch {unset ::RES} catch {unset ::forever} rename ::cmd {} removeFile foo removeFile bar } -result {1 sync/OK {CMD 0}} test io-53.8b {CopyData: async callback and -size 0} -setup { # copy progress callback. errors out intentionally proc ::cmd args { lappend ::RES "CMD $args" set ::forever has-been-reached return } # Files we use for our channels set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] set bar [makeFile {} bar] # Channels to copy between set f [open $foo r] ; fconfigure $f -translation binary set g [open $bar w] ; fconfigure $g -translation binary -buffering none } -constraints {stdio fcopy} -body { set ::RES {} # Run the copy. Should not invoke -command now. fcopy $f $g -size 0 -command ::cmd # Check that -command was not called synchronously lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}] # Now let the async part happen. Should capture the eof in cmd # If not break the event loop via timer. set token [after 1000 { lappend ::RES {cmd/FAIL timeout} set ::forever has-been-reached }] vwait ::forever catch {after cancel $token} # Report set ::RES } -cleanup { close $f close $g catch {unset ::RES} catch {unset ::forever} rename ::cmd {} removeFile foo removeFile bar } -result {sync/OK {CMD 0}} test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup { set out [makeFile {} out] set err [makeFile {} err] set pipe [open "|[list [info nameofexecutable] 2> $err]" r+] fconfigure $pipe -translation binary -buffering line puts $pipe { fconfigure stdout -translation binary -buffering line puts stderr Waiting... after 1000 foreach x {a b c} { puts stderr Looping... puts $x after 500 } proc bye args { if {[gets stdin line]<0} { puts stderr "CHILD: EOF detected, exiting" exit } else { puts stderr "CHILD: ignoring line: $line" } } puts stderr Now-sleeping-forever fileevent stdin readable bye vwait forever } proc ::done args { set ::forever OK return } set ::forever {} set out [open $out w] } -constraints {stdio fcopy} -body { fcopy $pipe $out -size 6 -command ::done set token [after 5000 { set ::forever {fcopy hangs} }] vwait ::forever catch {after cancel $token} set ::forever } -cleanup { close $pipe rename ::done {} after 1000; # Give Windows time to kill the process catch {close $out} catch {removeFile out} catch {removeFile err} catch {unset ::forever} } -result OK test io-53.10 {Bug 1350564, multi-directional fcopy} -setup { set err [makeFile {} err] set pipe [open "|[list [info nameofexecutable] 2> $err]" r+] fconfigure $pipe -translation binary -buffering line puts $pipe { fconfigure stderr -buffering line # Kill server when pipe closed by invoker. proc bye args { if {![eof stdin]} { gets stdin ; return } puts stderr BYE exit } # Server code. Bi-directional copy between 2 sockets. proc geof {sok} { puts stderr DONE/$sok close $sok } proc new {sok args} { puts stderr NEW/$sok global l srv fconfigure $sok -translation binary -buffering none lappend l $sok if {[llength $l]==2} { close $srv foreach {a b} $l break fcopy $a $b -command [list geof $a] fcopy $b $a -command [list geof $b] puts stderr 2COPY } puts stderr ... } puts stderr SRV set l {} set srv [socket -server new -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] puts stderr WAITING fileevent stdin readable bye puts "OK $port" vwait forever } # wait for OK from server. lassign [gets $pipe] ok port # Now the two clients. proc ::done {sock} { if {[eof $sock]} { close $sock ; return } lappend ::forever [gets $sock] return } set a [socket 127.0.0.1 $port] set b [socket 127.0.0.1 $port] fconfigure $a -translation binary -buffering none fconfigure $b -translation binary -buffering none fileevent $a readable [list ::done $a] fileevent $b readable [list ::done $b] } -constraints {stdio fcopy} -body { # Now pass data through the server in both directions. set ::forever {} puts $a AB vwait ::forever puts $b BA vwait ::forever set ::forever } -cleanup { catch {close $a} catch {close $b} close $pipe rename ::done {} after 1000 ;# Give Windows time to kill the process removeFile err catch {unset ::forever} } -result {AB BA} test io-53.11 {Bug 2895565} -setup { set in [makeFile {} in] set f [open $in w] fconfigure $f -encoding utf-8 -translation binary puts -nonewline $f [string repeat "Ho hum\n" 11] close $f set inChan [open $in r] fconfigure $inChan -translation binary set out [makeFile {} out] set outChan [open $out w] fconfigure $outChan -encoding cp1252 -translation crlf proc CopyDone {bytes args} { variable done if {[llength $args]} { set done "Error: '[lindex $args 0]' after $bytes bytes copied" } else { set done "$bytes bytes copied" } } } -body { variable done after 2000 [list set [namespace which -variable done] timeout] fcopy $inChan $outChan -size 40 -command [namespace which CopyDone] vwait [namespace which -variable done] set done } -cleanup { close $outChan close $inChan removeFile out removeFile in } -result {40 bytes copied} test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} { file delete $path(pipe) set f1 [open $path(pipe) w] puts -nonewline $f1 { fconfigure stdin -translation binary -blocking 0 fconfigure stdout -buffering none -translation binary fcopy stdin stdout } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] fconfigure $f1 -translation binary -buffering none puts -nonewline $f1 A after 2000 {set ::done timeout} fileevent $f1 readable {set ::done ok} vwait ::done set ch [read $f1 1] close $f1 list $::done $ch } {ok A} test io-53.13 {TclCopyChannel: read error reporting} -setup { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { return {initialize finalize watch read} } finalize { return } watch {} read { error FAIL } } } set outFile [makeFile {} out] } -body { set in [chan create read [namespace which driver]] chan configure $in -translation binary set out [open $outFile wb] chan copy $in $out } -cleanup { catch {close $in} catch {close $out} removeFile out rename driver {} } -result {error reading "*": *} -returnCodes error -match glob test io-53.14 {TclCopyChannel: write error reporting} -setup { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { return {initialize finalize watch write} } finalize { return } watch {} write { error FAIL } } } set inFile [makeFile {aaa} in] } -body { set in [open $inFile rb] set out [chan create write [namespace which driver]] chan configure $out -translation binary chan copy $in $out } -cleanup { catch {close $in} catch {close $out} removeFile in rename driver {} } -result {error writing "*": *} -returnCodes error -match glob test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup { proc driver {cmd args} { variable buffer variable index variable blocked set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) [encoding convertto utf-8 \ [string repeat a 100]] set blocked($chan) 1 return {initialize finalize watch read} } finalize { unset index($chan) buffer($chan) blocked($chan) return } watch {} read { if {$blocked($chan)} { set blocked($chan) [expr {!$blocked($chan)}] return -code error EAGAIN } set n [lindex $args 1] set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new return $result } } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 set out [makeFile {} out] set outChan [open $out w] chan configure $outChan -encoding utf-8 } -body { chan copy $c $outChan } -cleanup { close $outChan close $c removeFile out } -result 100 test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup { proc driver {cmd args} { variable buffer variable index variable blocked set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) [encoding convertto utf-8 \ [string repeat a 100]] set blocked($chan) 1 return {initialize finalize watch read} } finalize { unset index($chan) buffer($chan) blocked($chan) return } watch {} read { if {$blocked($chan)} { set blocked($chan) [expr {!$blocked($chan)}] return -code error EAGAIN } set n [lindex $args 1] set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new return $result } } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 -translation lf set out [makeFile {} out] set outChan [open $out w] chan configure $outChan -encoding utf-8 -translation lf } -body { chan copy $c $outChan } -cleanup { close $outChan close $c removeFile out } -result 100 test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) [encoding convertto utf-8 \ line\n[string repeat a 100]line\n] return {initialize finalize watch read} } finalize { unset index($chan) buffer($chan) return } watch {} read { set n [lindex $args 1] set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new return $result } } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 -translation lf -buffersize 107 set out [makeFile {} out] set outChan [open $out w] chan configure $outChan -encoding utf-8 -translation lf } -body { list [gets $c] [chan copy $c $outChan -size 100] [gets $c] } -cleanup { close $outChan close $c removeFile out } -result {line 100 line} test io-54.1 {Recursive channel events} {socket fileevent notWinCI} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. proc accept {s a p} { variable as fconfigure $s -translation lf puts $s "line 1\nline2\nline3" flush $s set as $s } proc readit {s next} { variable x variable result lappend result $next if {$next == 1} { fileevent $s readable [namespace code [list readit $s 2]] vwait [namespace which -variable x] } incr x } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] # We need to delay on some systems until the creation of the # server socket completes. set done 0 for {set i 0} {$i < 10} {incr i} { if {![catch {set cs [socket 127.0.0.1 [lindex [fconfigure $ss -sockname] 2]]}]} { set done 1 break } after 100 } if {$done == 0} { close $ss error "failed to connect to server" } variable result {} variable x 0 variable as vwait [namespace which -variable as] fconfigure $cs -translation lf lappend result [gets $cs] fconfigure $cs -blocking off fileevent $cs readable [namespace code [list readit $cs 1]] set a [after 2000 [namespace code { set x failure }]] vwait [namespace which -variable x] after cancel $a close $as close $ss close $cs list $result $x } {{{line 1} 1 2} 2} test io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} { set accept {} set after {} variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] proc accept {s a p} { variable counter variable accept set accept $s set counter 0 fconfigure $s -blocking off -buffering line -translation lf fileevent $s readable [namespace code "doit $s"] } proc doit {s} { variable counter variable after incr counter set l [gets $s] if {"$l" == ""} { fileevent $s readable [namespace code "doit1 $s"] set after [after 1000 [namespace code newline]] } } proc doit1 {s} { variable counter variable accept incr counter set l [gets $s] close $s set accept {} } proc producer {} { variable s variable writer set writer [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]] fconfigure $writer -buffering line puts -nonewline $writer hello flush $writer } proc newline {} { variable done variable writer puts $writer hello flush $writer set done 1 } producer variable done vwait [namespace which -variable done] close $writer close $s after cancel $after if {$accept != {}} {close $accept} set counter } 1 set path(fooBar) [makeFile {} fooBar] test io-55.1 {ChannelEventScriptInvoker: deletion} -constraints { fileevent } -setup { variable x proc eventScript {fd} { variable x close $fd error "planned error" set x whoops } proc myHandler args { variable x got_error } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { set f [open $path(fooBar) w] fileevent $f writable [namespace code [list eventScript $f]] variable x not_done vwait [namespace which -variable x] set x } -cleanup { interp bgerror {} $handler } -result {got_error} test io-56.1 {ChannelTimerProc} {testchannelevent} { set f [open $path(fooBar) w] puts $f "this is a test" close $f set f [open $path(fooBar) r] testchannelevent $f add readable [namespace code { read $f 1 incr x }] variable x 0 vwait [namespace which -variable x] vwait [namespace which -variable x] set result $x testchannelevent $f set 0 none after idle [namespace code {set y done}] variable y vwait [namespace which -variable y] close $f lappend result $y } {2 done} test io-57.1 {buffered data and file events, gets} {fileevent} { proc accept {sock args} { variable s2 set s2 $sock } set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]] variable s2 vwait [namespace which -variable s2] update fileevent $s2 readable [namespace code {lappend result readable}] puts $s "12\n34567890" flush $s variable result [gets $s2] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [gets $s2] vwait [namespace which -variable result] close $s close $s2 close $server set result } {12 readable 34567890 timer} test io-57.2 {buffered data and file events, read} {fileevent} { proc accept {sock args} { variable s2 set s2 $sock } set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]] variable s2 vwait [namespace which -variable s2] update fileevent $s2 readable [namespace code {lappend result readable}] puts -nonewline $s "1234567890" flush $s variable result [read $s2 1] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [read $s2 9] vwait [namespace which -variable result] close $s close $s2 close $server set result } {1 readable 234567890 timer} test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} { set out [open $path(script) w] puts $out { puts "normal message from pipe" puts stderr "error message from pipe" exit 1 } proc readit {pipe} { variable x variable result if {[eof $pipe]} { set x [catch {close $pipe} line] lappend result catch $line } else { gets $pipe line lappend result gets $line } } close $out set pipe [open "|[list [interpreter] $path(script)]" r] fileevent $pipe readable [namespace code [list readit $pipe]] variable x "" set result "" vwait [namespace which -variable x] list $x $result } {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}} test io-59.1 {Thread reference of channels} {testmainthread testchannel} { # TIP #10 # More complicated tests (like that the reference changes as a # channel is moved from thread to thread) can be done only in the # extension which fully implements the moving of channels between # threads, i.e. 'Threads'. set f [open $path(longfile) r] set result [testchannel mthread $f] close $f string equal $result [testmainthread] } {1} test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} { # This test will hang in older revisions of the core. set out [open $path(script) w] puts $out "catch {load $::tcltestlib Tcltest}" puts $out { puts ABC[testbytestring \xE2] exit 1 } proc readit {pipe} { variable x variable result if {[eof $pipe]} { set x [catch {close $pipe} line] lappend result catch $line } else { gets $pipe line lappend result gets $line } } close $out set pipe [open "|[list [interpreter] $path(script)]" r] fileevent $pipe readable [namespace code [list readit $pipe]] variable x "" set result "" vwait [namespace which -variable x] # cut of the remainder of the error stack, especially the filename set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]] list $x $result } {1 {gets ABC catch {error writing "stdout": invalid argument}}} test io-61.1 {Reset eof state after changing the eof char} -setup { set datafile [makeFile {} eofchar] set f [open $datafile w] fconfigure $f -translation binary puts -nonewline $f [string repeat "Ho hum\n" 11] puts $f = set line [string repeat "Ge gla " 4] puts -nonewline $f [string repeat [string trimright $line]\n 834] close $f } -body { set f [open $datafile r] fconfigure $f -eofchar = set res {} lappend res [read $f; tell $f] fconfigure $f -eofchar {} lappend res [read $f 1] lappend res [read $f; tell $f] # Any seek zaps the internals into a good state. #seek $f 0 start #seek $f 0 current #lappend res [read $f; tell $f] close $f set res } -cleanup { removeFile eofchar } -result {77 = 23431} # Test the cutting and splicing of channels, this is incidentally the # attach/detach facility of package Thread, but __without any # safeguards__. It can also be used to emulate transfer of channels # between threads, and is used for that here. test io-70.0 {Cutting & Splicing channels} {testchannel} { set f [makeFile {... dummy ...} cutsplice] set c [open $f r] set res {} lappend res [catch {seek $c 0 start}] testchannel cut $c lappend res [catch {seek $c 0 start}] testchannel splice $c lappend res [catch {seek $c 0 start}] close $c removeFile cutsplice set res } {0 1 0} test io-70.1 {Transfer channel} {testchannel thread} { set f [makeFile {... dummy ...} cutsplice] set c [open $f r] set res {} lappend res [catch {seek $c 0 start}] testchannel cut $c lappend res [catch {seek $c 0 start}] set tid [thread::create -preserved] thread::send $tid [list set c $c] thread::send $tid {load {} Tcltest} lappend res [thread::send $tid { testchannel splice $c set res [catch {seek $c 0 start}] close $c set res }] thread::release $tid removeFile cutsplice set res } {0 1 0} # ### ### ### ######### ######### ######### foreach {n msg expected} { 0 {} {} 1 {{message only}} {{message only}} 2 {-options x} {-options x} 3 {-options {x y} {the message}} {-options {x y} {the message}} 4 {-code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 5 {-code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 6 {-code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 7 {-code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 8 {-code error -level 0 -f ba snarf} {-code error -level 0 -f ba snarf} 9 {-code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 10 {-code error -level 5 -f ba snarf} {-code error -level 0 -f ba snarf} 11 {-code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 12 {-code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 13 {-code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 14 {-code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} 15 {-code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} 16 {-code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} 17 {-code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} 18 {-code error -level 0 -f ba} {-code error -level 0 -f ba} 19 {-code ok -level 0 -f ba} {-code 1 -level 0 -f ba} 20 {-code error -level 5 -f ba} {-code error -level 0 -f ba} 21 {-code ok -level 5 -f ba} {-code 1 -level 0 -f ba} 22 {-code boss -level 0 -f ba} {-code 1 -level 0 -f ba} 23 {-code boss -level 5 -f ba} {-code 1 -level 0 -f ba} 24 {-code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 25 {-code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 26 {-code error -level X -f ba snarf} {-code error -level 0 -f ba snarf} 27 {-code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 28 {-code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 29 {-code 1 -level X -f ba} {-code 1 -level 0 -f ba} 30 {-code 0 -level X -f ba} {-code 1 -level 0 -f ba} 31 {-code error -level X -f ba} {-code error -level 0 -f ba} 32 {-code ok -level X -f ba} {-code 1 -level 0 -f ba} 33 {-code boss -level X -f ba} {-code 1 -level 0 -f ba} 34 {-code 1 -code 1 -level 0 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 35 {-code 1 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 36 {-code 1 -code 1 -level 5 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 37 {-code 1 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 38 {-code 1 -code error -level 0 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} 39 {-code 1 -code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 40 {-code 1 -code error -level 5 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} 41 {-code 1 -code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 42 {-code 1 -code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 43 {-code 1 -code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 44 {-code 1 -code 1 -level 0 -f ba} {-code 1 -code 1 -level 0 -f ba} 45 {-code 1 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} 46 {-code 1 -code 1 -level 5 -f ba} {-code 1 -code 1 -level 0 -f ba} 47 {-code 1 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} 48 {-code 1 -code error -level 0 -f ba} {-code 1 -code error -level 0 -f ba} 49 {-code 1 -code ok -level 0 -f ba} {-code 1 -level 0 -f ba} 50 {-code 1 -code error -level 5 -f ba} {-code 1 -code error -level 0 -f ba} 51 {-code 1 -code ok -level 5 -f ba} {-code 1 -level 0 -f ba} 52 {-code 1 -code boss -level 0 -f ba} {-code 1 -level 0 -f ba} 53 {-code 1 -code boss -level 5 -f ba} {-code 1 -level 0 -f ba} 54 {-code 1 -code 1 -level X -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 55 {-code 1 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 56 {-code 1 -code error -level X -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} 57 {-code 1 -code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 58 {-code 1 -code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 59 {-code 1 -code 1 -level X -f ba} {-code 1 -code 1 -level 0 -f ba} 60 {-code 1 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} 61 {-code 1 -code error -level X -f ba} {-code 1 -code error -level 0 -f ba} 62 {-code 1 -code ok -level X -f ba} {-code 1 -level 0 -f ba} 63 {-code 1 -code boss -level X -f ba} {-code 1 -level 0 -f ba} 64 {-code 0 -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 65 {-code 0 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 66 {-code 0 -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 67 {-code 0 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 68 {-code 0 -code error -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 69 {-code 0 -code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 70 {-code 0 -code error -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 71 {-code 0 -code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 72 {-code 0 -code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 73 {-code 0 -code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 74 {-code 0 -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} 75 {-code 0 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} 76 {-code 0 -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} 77 {-code 0 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} 78 {-code 0 -code error -level 0 -f ba} {-code 1 -level 0 -f ba} 79 {-code 0 -code ok -level 0 -f ba} {-code 1 -level 0 -f ba} 80 {-code 0 -code error -level 5 -f ba} {-code 1 -level 0 -f ba} 81 {-code 0 -code ok -level 5 -f ba} {-code 1 -level 0 -f ba} 82 {-code 0 -code boss -level 0 -f ba} {-code 1 -level 0 -f ba} 83 {-code 0 -code boss -level 5 -f ba} {-code 1 -level 0 -f ba} 84 {-code 0 -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 85 {-code 0 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 86 {-code 0 -code error -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 87 {-code 0 -code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 88 {-code 0 -code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} 89 {-code 0 -code 1 -level X -f ba} {-code 1 -level 0 -f ba} 90 {-code 0 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} 91 {-code 0 -code error -level X -f ba} {-code 1 -level 0 -f ba} 92 {-code 0 -code ok -level X -f ba} {-code 1 -level 0 -f ba} 93 {-code 0 -code boss -level X -f ba} {-code 1 -level 0 -f ba} 94 {-code 1 -code 1 -level 0 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 95 {-code 0 -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} 96 {-code 1 -code 1 -level 5 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} 97 {-code 0 -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} 98 {-code error -code 1 -level 0 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} 99 {-code ok -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} a0 {-code error -code 1 -level 5 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} a1 {-code ok -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} a2 {-code boss -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} a3 {-code boss -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} a4 {-code 1 -code 1 -level 0 -f ba} {-code 1 -code 1 -level 0 -f ba} a5 {-code 0 -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} a6 {-code 1 -code 1 -level 5 -f ba} {-code 1 -code 1 -level 0 -f ba} a7 {-code 0 -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} a8 {-code error -code 1 -level 0 -f ba} {-code error -code 1 -level 0 -f ba} a9 {-code ok -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} b0 {-code error -code 1 -level 5 -f ba} {-code error -code 1 -level 0 -f ba} b1 {-code ok -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} b2 {-code boss -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} b3 {-code boss -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} b4 {-code 1 -code 1 -level X -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} b5 {-code 0 -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} b6 {-code error -code 1 -level X -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} b7 {-code ok -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} b8 {-code boss -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} b9 {-code 1 -code 1 -level X -f ba} {-code 1 -code 1 -level 0 -f ba} c0 {-code 0 -code 1 -level X -f ba} {-code 1 -level 0 -f ba} c1 {-code error -code 1 -level X -f ba} {-code error -code 1 -level 0 -f ba} c2 {-code ok -code 1 -level X -f ba} {-code 1 -level 0 -f ba} c3 {-code boss -code 1 -level X -f ba} {-code 1 -level 0 -f ba} c4 {-code 1 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} c5 {-code 0 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} c6 {-code 1 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} c7 {-code 0 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} c8 {-code error -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} c9 {-code ok -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} d0 {-code error -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} d1 {-code ok -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} d2 {-code boss -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} d3 {-code boss -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} d4 {-code 1 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} d5 {-code 0 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} d6 {-code 1 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} d7 {-code 0 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} d8 {-code error -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} d9 {-code ok -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} e0 {-code error -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} e1 {-code ok -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} e2 {-code boss -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} e3 {-code boss -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} e4 {-code 1 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e5 {-code 0 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e6 {-code error -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e7 {-code ok -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e8 {-code boss -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} e9 {-code 1 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} f0 {-code 0 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} f1 {-code error -code 0 -level X -f ba} {-code 1 -level 0 -f ba} f2 {-code ok -code 0 -level X -f ba} {-code 1 -level 0 -f ba} f3 {-code boss -code 0 -level X -f ba} {-code 1 -level 0 -f ba} } { test io-71.$n {Tcl_SetChannelError} {testchannel} { set f [makeFile {... dummy ...} cutsplice] set c [open $f r] set res [testchannel setchannelerror $c [lrange $msg 0 end]] close $c removeFile cutsplice set res } [lrange $expected 0 end] test io-72.$n {Tcl_SetChannelErrorInterp} {testchannel} { set f [makeFile {... dummy ...} cutsplice] set c [open $f r] set res [testchannel setchannelerrorinterp $c [lrange $msg 0 end]] close $c removeFile cutsplice set res } [lrange $expected 0 end] } test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} { # Test for Bug 1847044 - don't spoil type unless we have a valid channel catch {close [lreplace [list a] 0 end]} } {1} test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup { # Invalidate internalrep of 'channel' Tcl_Obj when transiting between interpreters. set f [open [info script] r] } -body { interp create foo seek $f 0 set code [catch {interp eval foo [list seek $f 0]} msg] # The string map converts the changing channel handle to a fixed string list $code [string map [list $f @@] $msg] } -cleanup { close $f } -result {1 {can not find channel named "@@"}} test io-73.3 {[5adc350683] [gets] after EOF} -setup { set fn [makeFile {} io-73.3] set rfd [open $fn r] set wfd [open $fn a] chan configure $wfd -buffering line read $rfd } -body { set result [eof $rfd] puts $wfd "more data" lappend result [eof $rfd] lappend result [gets $rfd] lappend result [eof $rfd] lappend result [gets $rfd] lappend result [eof $rfd] } -cleanup { close $wfd close $rfd removeFile io-73.3 } -result {1 1 {more data} 0 {} 1} test io-73.4 {[5adc350683] [read] after EOF} -setup { set fn [makeFile {} io-73.4] set rfd [open $fn r] set wfd [open $fn a] chan configure $wfd -buffering line read $rfd } -body { set result [eof $rfd] puts $wfd "more data" lappend result [eof $rfd] lappend result [read $rfd] lappend result [eof $rfd] } -cleanup { close $wfd close $rfd removeFile io-73.4 } -result {1 1 {more data } 1} test io-73.5 {effect of eof on encoding end flags} -setup { set fn [makeFile {} io-73.5] set rfd [open $fn r] set wfd [open $fn a] chan configure $wfd -buffering none -translation binary chan configure $rfd -buffersize 5 -encoding utf-8 read $rfd } -body { set result [eof $rfd] puts -nonewline $wfd more\u00C2\u00A0data lappend result [eof $rfd] lappend result [read $rfd] lappend result [eof $rfd] } -cleanup { close $wfd close $rfd removeFile io-73.5 } -result [list 1 1 more\u00A0data 1] test io-74.1 {[104f2885bb] improper cache validity check} -setup { set fn [makeFile {} io-74.1] set rfd [open $fn r] testobj freeallvars interp create child } -constraints testobj -body { teststringobj set 1 [string range $rfd 0 end] read [teststringobj get 1] testobj duplicate 1 2 interp transfer {} $rfd child catch {read [teststringobj get 1]} read [teststringobj get 2] } -cleanup { interp delete child testobj freeallvars removeFile io-74.1 } -returnCodes error -match glob -result {can not find channel named "*"} # The following tests 75.1 to 75.5 exercise strict or tolerant channel # encoding. # TCL 8.6 only offers tolerant channel encoding, what is tested here. test io-75.1 {multibyte encoding error read results in raw bytes} -setup { set fn [makeFile {} io-75.1] set f [open $fn w+] fconfigure $f -encoding binary # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed # by a byte > 0x7F. This is violated to get an invalid sequence. puts -nonewline $f A\xC0\x40 flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none } -body { set d [read $f] binary scan $d H* hd set hd } -cleanup { close $f removeFile io-75.1 } -result 41c040 test io-75.2 {unrepresentable character write passes and is replaced by ?} -setup { set fn [makeFile {} io-75.2] set f [open $fn w+] fconfigure $f -encoding iso8859-1 } -body { puts -nonewline $f "A\u2022" flush $f seek $f 0 read $f } -cleanup { close $f removeFile io-75.2 } -result A? # Incomplete sequence test. # This error may IMHO only be detected with the close. # But the read already returns the incomplete sequence. test io-75.3 {incomplete multibyte encoding read is ignored} -setup { set fn [makeFile {} io-75.3] set f [open $fn w+] fconfigure $f -encoding binary puts -nonewline $f "A\xC0" flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none } -body { set d [read $f] binary scan $d H* hd set hd } -cleanup { close $f removeFile io-75.3 } -result 41c0 # As utf-8 has a special treatment in multi-byte decoding, also test another # one. test io-75.4 {shiftjis encoding error read results in raw bytes} -setup { set fn [makeFile {} io-75.4] set f [open $fn w+] fconfigure $f -encoding binary # In shiftjis, \x81 starts a two-byte sequence. # But 2nd byte \xFF is not allowed puts -nonewline $f A\x81\xFFA flush $f seek $f 0 fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf } -body { set d [read $f] binary scan $d H* hd set hd } -cleanup { close $f removeFile io-75.4 } -result 4181ff41 test io-75.5 {invalid utf-8 encoding read is ignored} -setup { set fn [makeFile {} io-75.5] set f [open $fn w+] fconfigure $f -encoding binary # \x81 announces a two byte sequence. puts -nonewline $f A\x81 flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf } -body { set d [read $f] binary scan $d H* hd set hd } -cleanup { close $f removeFile io-75.5 } -result 4181 # ### ### ### ######### ######### ######### # cleanup foreach file [list fooBar longfile script script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } cleanupTests } namespace delete ::tcl::test::io return tcl8.6.14/tests/ioTrans.test0000644000175000017500000017004714554262142015335 0ustar sergeisergei# -*- tcl -*- # Functionality covered: operation of the reflected transformation # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2007 Andreas Kupries # # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] # testchannel cut|splice Both needed to test the reflection in threads. # thread::send #---------------------------------------------------------------------- # ### ### ### ######### ######### ######### ## Testing the reflected transformation. # Helper commands to record the arguments to handler methods. Stored in a # script so that the tests needing this code do not need their own copy but # can access this variable. set helperscript { if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # This forces the return options to be in the order that the test expects! variable optorder { -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?! -errorstack !?! } proc noteOpts opts { variable optorder lappend ::res [dict merge $optorder $opts] } # Helper command, canned result for 'initialize' method. Gets the # optional methods as arguments. Use return features to post the result # higher up. proc handle.initialize {args} { upvar args hargs if {[lindex $hargs 0] eq "initialize"} { return -code return [list {*}$args initialize finalize read write] } } proc handle.finalize {} { upvar args hargs if {[lindex $hargs 0] eq "finalize"} { return -code return "" } } proc handle.read {} { upvar args hargs if {[lindex $hargs 0] eq "read"} { return -code return "@" } } proc handle.drain {} { upvar args hargs if {[lindex $hargs 0] eq "drain"} { return -code return "<>" } } proc handle.clear {} { upvar args hargs if {[lindex $hargs 0] eq "clear"} { return -code return "" } } proc tempchan {{mode r+}} { global tempchan return [set tempchan [open [makeFile {test data} tempchanfile] $mode]] } proc tempdone {} { global tempchan catch {close $tempchan} removeFile tempchanfile return } proc tempview {} { viewFile tempchanfile } } # Set everything up in the main thread. eval $helperscript #puts <<[file channels]>> # ### ### ### ######### ######### ######### test iortrans-1.0 {chan, wrong#args} -returnCodes error -body { chan } -result {wrong # args: should be "chan subcommand ?arg ...?"} test iortrans-1.1 {chan, unknown method} -returnCodes error -body { chan foo } -match glob -result {unknown or ambiguous subcommand "foo": must be*} # --- --- --- --------- --------- --------- # chan push, and method "initialize" test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body { chan push } -result {wrong # args: should be "chan push channel cmdprefix"} test iortrans-2.1 {chan push, wrong#args, too many} -returnCodes error -body { chan push a b c } -result {wrong # args: should be "chan push channel cmdprefix"} test iortrans-2.2 {chan push, invalid channel} -setup { proc foo {} {} } -returnCodes error -body { chan push {} foo } -cleanup { rename foo {} } -result {can not find channel named ""} test iortrans-2.3 {chan push, bad handler, not a list} -body { chan push [tempchan] "foo \{" } -returnCodes error -cleanup { tempdone } -result {unmatched open brace in list} test iortrans-2.4 {chan push, bad handler, not a command} -body { chan push [tempchan] foo } -returnCodes error -cleanup { tempdone } -result {invalid command name "foo"} test iortrans-2.5 {chan push, initialize failed, bad signature} -body { proc foo {} {} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -result {wrong # args: should be "foo"} test iortrans-2.6 {chan push, initialize failed, bad signature} -body { proc foo {} {} chan push [tempchan] ::foo } -returnCodes error -cleanup { tempdone rename foo {} } -result {wrong # args: should be "::foo"} test iortrans-2.7 {chan push, initialize failed, bad result, not a list} -body { proc foo {args} {return "\{"} catch {chan push [tempchan] foo} return $::errorInfo } -cleanup { tempdone rename foo {} } -match glob -result {chan handler "foo initialize" returned non-list: *} test iortrans-2.8 {chan push, initialize failed, bad result, not a list} -body { proc foo {args} {return \{\{\}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {chan handler "foo initialize" returned non-list: *} test iortrans-2.9 {chan push, initialize failed, bad result, empty list} -body { proc foo {args} {} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*all required methods*} test iortrans-2.10 {chan push, initialize failed, bad result, bogus method name} -body { proc foo {args} {return 1} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*bad method "1": must be *} test iortrans-2.11 {chan push, initialize failed, bad result, bogus method name} -body { proc foo {args} {return {a b c}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*bad method "c": must be *} test iortrans-2.12 {chan push, initialize failed, bad result, required methods missing} -body { # Required: initialize, and finalize. proc foo {args} {return {initialize}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*all required methods*} test iortrans-2.13 {chan push, initialize failed, bad result, illegal method name} -body { proc foo {args} {return {initialize finalize BOGUS}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*returned bad method "BOGUS": must be clear, drain, finalize, flush, initialize, limit?, read, or write} test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler mismatch} -body { proc foo {args} {return {initialize finalize}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*makes the channel inaccessible} # iortrans-2.15 event/watch methods elimimated, removed these tests. # iortrans-2.16 test iortrans-2.17 {chan push, initialize failed, bad result, drain/read mismatch} -body { proc foo {args} {return {initialize finalize drain write}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*supports "drain" but not "read"} test iortrans-2.18 {chan push, initialize failed, bad result, flush/write mismatch} -body { proc foo {args} {return {initialize finalize flush read}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*supports "flush" but not "write"} test iortrans-2.19 {chan push, initialize ok, creates channel} -setup { set res {} } -match glob -body { proc foo {args} { global res lappend res $args if {[lindex $args 0] ne "initialize"} {return} return {initialize finalize drain flush read write} } lappend res [file channel rt*] lappend res [chan push [tempchan] foo] lappend res [close [lindex $res end]] lappend res [file channel rt*] } -cleanup { tempdone rename foo {} } -result {{} {initialize rt* {read write}} file* {drain rt*} {flush rt*} {finalize rt*} {} {}} test iortrans-2.20 {chan push, init failure -> no channel, no finalize} -setup { set res {} } -match glob -body { proc foo {args} { global res lappend res $args return } lappend res [file channel rt*] lappend res [catch {chan push [tempchan] foo} msg] $msg lappend res [file channel rt*] } -cleanup { tempdone rename foo {} } -result {{} {initialize rt* {read write}} 1 {*all required methods*} {}} # --- --- --- --------- --------- --------- # method finalize (via close) # General note: file channels rt* finds the transform channel, however the # name reported will be that of the underlying base driver, fileXX here. This # actually allows us to see if the whole channel is gone, or only the # transformation, but not the base. test iortrans-3.1 {chan finalize, handler destruction has no effect on channel} -setup { set res {} } -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return } lappend res [set c [chan push [tempchan] foo]] rename foo {} lappend res [file channels file*] lappend res [file channels rt*] lappend res [catch {close $c} msg] $msg lappend res [file channels file*] lappend res [file channels rt*] } -cleanup { tempdone } -result {{initialize rt* {read write}} file* file* {} 1 {invalid command name "foo"} {} {}} test iortrans-3.2 {chan finalize, for close} -setup { set res {} } -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return } lappend res [set c [chan push [tempchan] foo]] close $c # Close deleted the channel. lappend res [file channels rt*] # Channel destruction does not kill handler command! lappend res [info command foo] } -cleanup { rename foo {} tempdone } -result {{initialize rt* {read write}} file* {finalize rt*} {} foo} test iortrans-3.3 {chan finalize, for close, error, close error} -setup { set res {} } -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -code error 5 } lappend res [set c [chan push [tempchan] foo]] lappend res [catch {close $c} msg] $msg # Channel is gone despite error. lappend res [file channels rt*] } -cleanup { rename foo {} tempdone } -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}} test iortrans-3.4 {chan finalize, for close, error, close error} -setup { set res {} } -match glob -body { proc foo {args} { lappend ::res $args handle.initialize error FOO } lappend res [set c [chan push [tempchan] foo]] lappend res [catch {close $c} msg] $msg $::errorInfo } -cleanup { rename foo {} tempdone } -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO {FOO *"close $c"}} test iortrans-3.5 {chan finalize, for close, arbitrary result, ignored} -setup { set res {} } -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return SOMETHING } lappend res [set c [chan push [tempchan] foo]] lappend res [catch {close $c} msg] $msg } -cleanup { rename foo {} tempdone } -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}} test iortrans-3.6 {chan finalize, for close, break, close error} -setup { set res {} } -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -code 3 } lappend res [set c [chan push [tempchan] foo]] lappend res [catch {close $c} msg] $msg } -cleanup { rename foo {} tempdone } -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} test iortrans-3.7 {chan finalize, for close, continue, close error} -setup { set res {} } -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -code 4 } lappend res [set c [chan push [tempchan] foo]] lappend res [catch {close $c} msg] $msg } -cleanup { rename foo {} tempdone } -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} test iortrans-3.8 {chan finalize, for close, custom code, close error} -setup { set res {} } -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -code 777 BANG } lappend res [set c [chan push [tempchan] foo]] lappend res [catch {close $c} msg] $msg } -cleanup { rename foo {} tempdone } -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} test iortrans-3.9 {chan finalize, for close, ignore level, close error} -setup { set res {} } -body { proc foo {args} { lappend ::res $args handle.initialize return -level 5 -code 777 BANG } lappend res [set c [chan push [tempchan] foo]] lappend res [catch {close $c} msg opt] $msg noteOpts $opt } -match glob -cleanup { rename foo {} tempdone } -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} # --- === *** ########################### # method read (via read) test iortrans-4.1 {chan read, transform call and return} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return snarf } set c [chan push [tempchan] foo] lappend res [read $c 10] } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} snarf} test iortrans-4.2 {chan read, for non-readable channel} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args MUST_NOT_HAPPEN } set c [chan push [tempchan w] foo] lappend res [catch {read $c 2} msg] $msg } -cleanup { tempdone rename foo {} } -result {1 {channel "file*" wasn't opened for reading}} test iortrans-4.3 {chan read, error return} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code error BOOM! } set c [chan push [tempchan] foo] lappend res [catch {read $c 2} msg] $msg } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} 1 BOOM!} test iortrans-4.4 {chan read, break return is error} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code break BOOM! } set c [chan push [tempchan] foo] lappend res [catch {read $c 2} msg] $msg } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} 1 *bad code*} test iortrans-4.5 {chan read, continue return is error} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code continue BOOM! } set c [chan push [tempchan] foo] lappend res [catch {read $c 2} msg] $msg } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} 1 *bad code*} test iortrans-4.6 {chan read, custom return is error} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code 777 BOOM! } set c [chan push [tempchan] foo] lappend res [catch {read $c 2} msg] $msg } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} 1 *bad code*} test iortrans-4.7 {chan read, level is squashed} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -level 55 -code 777 BOOM! } set c [chan push [tempchan] foo] lappend res [catch {read $c 2} msg opt] $msg noteOpts $opt } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} test iortrans-4.8 {chan read, read, bug 2921116} -setup { set res {} } -match glob -body { proc foo {fd args} { handle.initialize handle.finalize lappend ::res $args # Kill and recreate transform while it is operating chan pop $fd chan push $fd [list foo $fd] } set c [chan push [set c [tempchan]] [list foo $c]] lappend res [read $c] #lappend res [gets $c] } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} {}} test iortrans-4.8.1 {chan read, bug 721ec69271} -setup { set res {} } -match glob -body { proc foo {fd args} { handle.initialize handle.finalize lappend ::res $args # Kill and recreate transform while it is operating chan pop $fd chan push $fd [list foo $fd] } set c [chan push [set c [tempchan]] [list foo $c]] chan configure $c -buffersize 2 lappend res [read $c] } -cleanup { tempdone rename foo {} } -result {{read rt* te} {read rt* st} {read rt* { d}} {read rt* at} {read rt* {a }} {}} test iortrans-4.8.2 {chan read, bug 721ec69271} -setup { set res {} } -match glob -body { proc foo {fd args} { handle.initialize handle.finalize lappend ::res $args # Kill and recreate transform while it is operating chan pop $fd chan push $fd [list foo $fd] return x } set c [chan push [set c [tempchan]] [list foo $c]] chan configure $c -buffersize 1 lappend res [read $c] } -cleanup { tempdone rename foo {} } -result {{read rt* t} {read rt* e} {read rt* s} {read rt* t} {read rt* { }} {read rt* d} {read rt* a} {read rt* t} {read rt* a} {read rt* { }} {}} test iortrans-4.9 {chan read, gets, bug 2921116} -setup { set res {} } -match glob -body { proc foo {fd args} { handle.initialize handle.finalize lappend ::res $args # Kill and recreate transform while it is operating chan pop $fd chan push $fd [list foo $fd] } set c [chan push [set c [tempchan]] [list foo $c]] lappend res [gets $c] } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} {}} # Driver for a base channel that emits several short "files" # with each terminated by a fleeting EOF proc driver {cmd args} { variable ::tcl::buffer variable ::tcl::index set chan [lindex $args 0] switch -- $cmd { initialize { set index($chan) 0 set buffer($chan) ..... return {initialize finalize watch read} } finalize { if {![info exists index($chan)]} {return} unset index($chan) buffer($chan) array unset index array unset buffer return } watch {} read { set n [lindex $args 1] if {![info exists index($chan)]} { driver initialize $chan } set new [expr {$index($chan) + $n}] set result [string range $buffer($chan) $index($chan) $new-1] set index($chan) $new if {[string length $result] == 0} { driver finalize $chan } return $result } } } namespace eval reflector { proc initialize {_ chan mode} { return {initialize finalize watch read} } proc finalize {_ chan} { foreach id [after info] { after cancel $id } namespace delete $_ } proc read {_ chan count} { namespace upvar $_ source source set res [string range $source 0 $count-1] set source [string range $source $count end] return $res } proc watch {_ chan events} { after 0 [list chan postevent $chan read] return read } namespace ensemble create -parameters _ namespace export * } namespace eval inputfilter { proc initialize {chan mode} { return {initialize finalize read} } proc read {chan buffer} { return $buffer } proc finalize chan { namespace delete $chan } namespace ensemble create namespace export * } # Channel read transform that is just the identity - pass all through proc idxform {cmd handle args} { switch -- $cmd { initialize { return {initialize finalize read} } finalize { return } read { lassign $args buffer return $buffer } } } # Test that all EOFs pass through full xform stack. Proper data boundaries. # Check robustness against buffer sizes. test iortrans-4.10 {[5adbc350683] chan read, handle fleeting EOF} -body { set chan [chan push [chan create read driver] idxform] list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} test iortrans-4.10.1 {[5adbc350683] chan read, handle fleeting EOF} -body { set chan [chan push [chan create read driver] idxform] chan configure $chan -buffersize 3 list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} test iortrans-4.10.2 {[5adbc350683] chan read, handle fleeting EOF} -body { set chan [chan push [chan create read driver] idxform] chan configure $chan -buffersize 5 list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} rename idxform {} # Channel read transform that delays the data and always returns something proc delayxform {cmd handle args} { variable store switch -- $cmd { initialize { set store($handle) {} return {initialize finalize read drain} } finalize { unset store($handle) return } read { lassign $args buffer if {$store($handle) eq {}} { set reply [string index $buffer 0] set store($handle) [string range $buffer 1 end] } else { set reply $store($handle) set store($handle) $buffer } return $reply } drain { delayxform read $handle {} } } } # Test that all EOFs pass through full xform stack. Proper data boundaries. # Check robustness against buffer sizes. test iortrans-4.11 {[5adbc350683] chan read, handle fleeting EOF} -body { set chan [chan push [chan create read driver] delayxform] list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} test iortrans-4.11.1 {[5adbc350683] chan read, handle fleeting EOF} -body { set chan [chan push [chan create read driver] delayxform] chan configure $chan -buffersize 3 list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} test iortrans-4.11.2 {[5adbc350683] chan read, handle fleeting EOF} -body { set chan [chan push [chan create read driver] delayxform] chan configure $chan -buffersize 5 list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} rename delayxform {} # Channel read transform that delays the data and may return {} proc delay2xform {cmd handle args} { variable store switch -- $cmd { initialize { set store($handle) {} return {initialize finalize read drain} } finalize { unset store($handle) return } read { lassign $args buffer set reply $store($handle) set store($handle) $buffer return $reply } drain { delay2xform read $handle {} } } } test iortrans-4.12 {[5adbc350683] chan read, handle fleeting EOF} -body { set chan [chan push [chan create read driver] delay2xform] list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan } -result {0 ..... 1 {} 0 ..... 1} rename delay2xform {} rename driver {} # --- === *** ########################### # method write (via puts) test iortrans-5.1 {chan write, regular write} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return transformresult } set c [chan push [tempchan] foo] puts -nonewline $c snarf flush $c close $c lappend res [tempview] } -cleanup { tempdone rename foo {} } -result {{write rt* snarf} transformresult} test iortrans-5.2 {chan write, no write is ok, no change to file} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return } set c [chan push [tempchan] foo] puts -nonewline $c snarfsnarfsnarf flush $c close $c lappend res [tempview]; # This has to show the original data, as nothing was written } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} {test data}} test iortrans-5.3 {chan write, failed write} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code error FAIL! } set c [chan push [tempchan] foo] puts -nonewline $c snarfsnarfsnarf lappend res [catch {flush $c} msg] $msg } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 FAIL!} test iortrans-5.4 {chan write, non-writable channel} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args MUST_NOT_HAPPEN return } set c [chan push [tempchan r] foo] lappend res [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg } -cleanup { close $c tempdone rename foo {} } -result {1 {channel "file*" wasn't opened for writing}} test iortrans-5.5 {chan write, failed write, error return} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code error BOOM! } set c [chan push [tempchan] foo] lappend res [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 BOOM!} test iortrans-5.6 {chan write, failed write, error return} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args error BOOM! } set c [chan push [tempchan] foo] lappend res {*}[catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 BOOM!} test iortrans-5.7 {chan write, failed write, break return is error} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code break BOOM! } set c [chan push [tempchan] foo] lappend res [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 *bad code*} test iortrans-5.8 {chan write, failed write, continue return is error} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code continue BOOM! } set c [chan push [tempchan] foo] lappend res [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 *bad code*} test iortrans-5.9 {chan write, failed write, custom return is error} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code 777 BOOM! } set c [chan push [tempchan] foo] lappend res [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 *bad code*} test iortrans-5.10 {chan write, failed write, level is ignored} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -level 55 -code 777 BOOM! } set c [chan push [tempchan] foo] lappend res [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg opt] $msg noteOpts $opt } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}} test iortrans-5.11 {chan write, bug 2921116} -match glob -setup { set res {} set level 0 } -body { proc foo {fd args} { handle.initialize handle.finalize lappend ::res $args # pop - invokes flush - invokes 'foo write' - infinite recursion - stop it global level if {$level} { return } incr level # Kill and recreate transform while it is operating chan pop $fd chan push $fd [list foo $fd] } set c [chan push [set c [tempchan]] [list foo $c]] lappend res [puts -nonewline $c abcdef] lappend res [flush $c] } -cleanup { tempdone rename foo {} } -result {{} {write rt* abcdef} {write rt* abcdef} {}} # --- === *** ########################### # method limit?, drain (via read) test iortrans-6.1 {chan read, read limits} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize limit? handle.finalize lappend ::res $args handle.read return 6 } set c [chan push [tempchan] foo] lappend res [read $c 10] } -cleanup { tempdone rename foo {} } -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata }} {limit? rt*} @@} test iortrans-6.2 {chan read, read transform drain on eof} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize drain handle.finalize lappend ::res $args handle.read handle.drain return } set c [chan push [tempchan] foo] lappend res [read $c] lappend res [close $c] } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} {drain rt*} @<> {}} # --- === *** ########################### # method clear (via puts, seek) test iortrans-7.1 {chan write, write clears read buffers} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize clear handle.finalize lappend ::res $args handle.clear return transformresult } set c [chan push [tempchan] foo] puts -nonewline $c snarf flush $c return $res } -cleanup { tempdone rename foo {} } -result {{clear rt*} {write rt* snarf}} test iortrans-7.2 {seek clears read buffers} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize clear handle.finalize lappend ::res $args return } set c [chan push [tempchan] foo] seek $c 2 return $res } -cleanup { tempdone rename foo {} } -result {{clear rt*}} test iortrans-7.3 {clear, any result is ignored} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize clear handle.finalize lappend ::res $args return -code error "X" } set c [chan push [tempchan] foo] seek $c 2 return $res } -cleanup { tempdone rename foo {} } -result {{clear rt*}} test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup { set res {} } -body { proc foo {fd args} { handle.initialize clear handle.finalize lappend ::res $args # Kill and recreate transform while it is operating chan pop $fd chan push $fd [list foo $fd] } set c [chan push [set c [tempchan]] [list foo $c]] seek $c 2 return $res } -cleanup { tempdone rename foo {} } -result {{clear rt*}} # --- === *** ########################### # method flush (via seek, close) test iortrans-8.1 {seek flushes write buffers, ignores data} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize flush handle.finalize lappend ::res $args return X } set c [chan push [tempchan] foo] # Flush, no writing seek $c 2 # The close flushes again, this modifies the file! lappend res | lappend res [close $c] | [tempview] } -cleanup { tempdone rename foo {} } -result {{flush rt*} | {flush rt*} {} | {teXt data}} test iortrans-8.2 {close flushes write buffers, writes data} -setup { set res {} } -match glob -body { proc foo {args} { handle.initialize flush lappend ::res $args handle.finalize return .flushed. } set c [chan push [tempchan] foo] close $c lappend res [tempview] } -cleanup { tempdone rename foo {} } -result {{flush rt*} {finalize rt*} .flushed.} test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup { set res {} } -body { proc foo {fd args} { handle.initialize flush handle.finalize lappend ::res $args # Kill and recreate transform while it is operating chan pop $fd chan push $fd [list foo $fd] } set c [chan push [set c [tempchan]] [list foo $c]] seek $c 2 set res } -cleanup { tempdone rename foo {} } -result {{flush rt*}} # --- === *** ########################### # method watch - removed from TIP (rev 1.12+) # --- === *** ########################### # method event - removed from TIP (rev 1.12+) # --- === *** ########################### # 'Pull the rug' tests. Create channel in a interpreter A, move to other # interpreter B, destroy the origin interpreter (A) before or during access # from B. Must not crash, must return proper errors. test iortrans-11.0 {origin interpreter of moved transform gone} -setup { set ida [interp create]; #puts <<$ida>> set idb [interp create]; #puts <<$idb>> # Magic to get the test* commands in the children load {} Tcltest $ida load {} Tcltest $idb } -constraints {testchannel} -match glob -body { # Set up channel and transform in interpreter interp eval $ida $helperscript interp eval $ida [list ::variable tempchan [tempchan]] interp transfer {} $::tempchan $ida set chan [interp eval $ida { variable tempchan proc foo {args} { handle.initialize clear drain flush limit? read write handle.finalize lappend ::res $args return } set chan [chan push $tempchan foo] fconfigure $chan -buffering none set chan }] # Move channel to 2nd interpreter, transform goes with it. interp eval $ida [list testchannel cut $chan] interp eval $idb [list testchannel splice $chan] # Kill origin interpreter, then access channel from 2nd interpreter. interp delete $ida set res {} lappend res \ [catch {interp eval $idb [list puts $chan shoo]} msg] $msg \ [catch {interp eval $idb [list tell $chan]} msg] $msg \ [catch {interp eval $idb [list seek $chan 1]} msg] $msg \ [catch {interp eval $idb [list gets $chan]} msg] $msg \ [catch {interp eval $idb [list close $chan]} msg] $msg #lappend res [interp eval $ida {set res}] # actions: clear|write|clear|write|clear|flush|limit?|drain|flush # The 'tell' is ok, as it passed through the transform to the base channel # without invoking the transform handler. } -cleanup { tempdone interp delete $idb } -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -setup { set ida [interp create]; #puts <<$ida>> set idb [interp create]; #puts <<$idb>> # Magic to get the test* commands in the children load {} Tcltest $ida load {} Tcltest $idb } -constraints {testchannel} -match glob -body { # Set up channel in thread set chan [interp eval $ida $helperscript] interp eval $ida [list ::variable tempchan [tempchan]] interp transfer {} $::tempchan $ida set chan [interp eval $ida { proc foo {args} { handle.initialize clear drain flush limit? read write handle.finalize lappend ::res $args # Destroy interpreter during channel access. suicide } set chan [chan push $tempchan foo] fconfigure $chan -buffering none set chan }] interp alias $ida suicide {} interp delete $ida # Move channel to 2nd thread, transform goes with it. interp eval $ida [list testchannel cut $chan] interp eval $idb [list testchannel splice $chan] # Run access from interpreter B, this will give us a synchronous response. interp eval $idb [list set chan $chan] interp eval $idb [list set mid $tcltest::mainThread] set res [interp eval $idb { # Wait a bit, give the main thread the time to start its event loop to # wait for the response from B after 50 catch { puts $chan shoo } res set res }] } -cleanup { interp delete $idb tempdone } -result {Owner lost} test iortrans-11.2 {delete interp of reflected transform} -setup { interp create child # Magic to get the test* commands into the child load {} Tcltest child } -constraints {testchannel} -body { # Get base channel into the child set c [tempchan] testchannel cut $c interp eval child [list testchannel splice $c] interp eval child [list set c $c] child eval { proc no-op args {} proc driver {c sub args} { return {initialize finalize read write} } set t [chan push $c [list driver $c]] chan event $c readable no-op } interp delete child } -cleanup { tempdone } -result {} # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and receiving ## driver operations to the originator thread. # ### ### ### ######### ######### ######### ## Testing the reflected channel (Thread forwarding). # ## The id numbers refer to the original test without thread forwarding, and ## gaps due to tests not applicable to forwarding are left to keep this ## association. # ### ### ### ######### ######### ######### ## Helper command. Runs a script in a separate thread and returns the result. ## A channel is transferred into the thread as well, and a list of configuration ## variables proc inthread {chan script args} { # Test thread. set tid [thread::create -preserved] thread::send $tid {load {} Tcltest} # Init thread configuration. # - Listed variables # - Id of main thread # - A number of helper commands foreach v $args { upvar 1 $v x thread::send $tid [list set $v $x] } thread::send $tid [list set mid [thread::id]] thread::send $tid { proc notes {} { return $::notes } proc noteOpts opts { lappend ::notes [dict merge { -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?! -errorstack !?! } $opts] } } thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*) # Transfer channel (cut/splice aka detach/attach) testchannel cut $chan thread::send $tid [list testchannel splice $chan] # Run test script, also run local event loop! The local event loop waits # for the result to come back. It is also necessary for the execution of # forwarded channel operations. set ::tres "" thread::send -async $tid { after 50 catch {s} res; # This runs the script, 's' was defined at (*) thread::send -async $mid [list set ::tres $res] } vwait ::tres # Remove test thread, and return the captured result. thread::release $tid return $::tres } # ### ### ### ######### ######### ######### test iortrans.tf-3.2 {chan finalize, for close} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return {} } lappend res [set c [chan push [tempchan] foo]] lappend res [inthread $c { close $c # Close the deleted the channel. file channels rt* } c] # Channel destruction does not kill handler command! lappend res [info command foo] } -cleanup { rename foo {} } -result {{initialize rt* {read write}} file* {finalize rt*} {} foo} test iortrans.tf-3.3 {chan finalize, for close, error, close error} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -code error 5 } lappend res [set c [chan push [tempchan] foo]] lappend res {*}[inthread $c { lappend notes [catch {close $c} msg] $msg # Channel is gone despite error. lappend notes [file channels rt*] notes } c] } -cleanup { rename foo {} } -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}} test iortrans.tf-3.4 {chan finalize, for close, error, close errror} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { lappend ::res $args handle.initialize error FOO } lappend res [set c [chan push [tempchan] foo]] lappend res {*}[inthread $c { lappend notes [catch {close $c} msg] $msg notes } c] } -match glob -cleanup { rename foo {} } -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO} test iortrans.tf-3.5 {chan finalize, for close, arbitrary result} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return SOMETHING } lappend res [set c [chan push [tempchan] foo]] lappend res {*}[inthread $c { lappend notes [catch {close $c} msg] $msg notes } c] } -cleanup { rename foo {} } -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}} test iortrans.tf-3.6 {chan finalize, for close, break, close error} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -code 3 } lappend res [set c [chan push [tempchan] foo]] lappend res {*}[inthread $c { lappend notes [catch {close $c} msg] $msg notes } c] } -cleanup { rename foo {} } -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} test iortrans.tf-3.7 {chan finalize, for close, continue, close error} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -code 4 } lappend res [set c [chan push [tempchan] foo]] lappend res {*}[inthread $c { lappend notes [catch {close $c} msg] $msg notes } c] } -cleanup { rename foo {} } -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} test iortrans.tf-3.8 {chan finalize, for close, custom code, close error} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -code 777 BANG } lappend res [set c [chan push [tempchan] foo]] lappend res {*}[inthread $c { lappend notes [catch {close $c} msg] $msg notes } c] } -cleanup { rename foo {} } -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} test iortrans.tf-3.9 {chan finalize, for close, ignore level, close error} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { lappend ::res $args handle.initialize return -level 5 -code 777 BANG } lappend res [set c [chan push [tempchan] foo]] lappend res {*}[inthread $c { lappend notes [catch {close $c} msg opt] $msg noteOpts $opt notes } c] } -cleanup { rename foo {} } -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} # --- === *** ########################### # method read test iortrans.tf-4.1 {chan read, transform call and return} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return snarf } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [read $c 10] close $c notes } c] } -cleanup { tempdone rename foo {} } -match glob -result {{read rt* {test data }} snarf} test iortrans.tf-4.2 {chan read, for non-readable channel} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args MUST_NOT_HAPPEN } set c [chan push [tempchan w] foo] lappend res {*}[inthread $c { lappend notes [catch {[read $c 2]} msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -match glob -result {1 {channel "file*" wasn't opened for reading}} test iortrans.tf-4.3 {chan read, error return} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code error BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch {read $c 2} msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -match glob -result {{read rt* {test data }} 1 BOOM!} test iortrans.tf-4.4 {chan read, break return is error} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code break BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch {read $c 2} msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -match glob -result {{read rt* {test data }} 1 *bad code*} test iortrans.tf-4.5 {chan read, continue return is error} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code continue BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch {read $c 2} msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -match glob -result {{read rt* {test data }} 1 *bad code*} test iortrans.tf-4.6 {chan read, custom return is error} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code 777 BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch {read $c 2} msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -match glob -result {{read rt* {test data }} 1 *bad code*} test iortrans.tf-4.7 {chan read, level is squashed} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -level 55 -code 777 BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch {read $c 2} msg opt] $msg noteOpts $opt close $c notes } c] } -cleanup { tempdone rename foo {} } -match glob -result {{read rt* {test data }} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} # --- === *** ########################### # method write test iortrans.tf-5.1 {chan write, regular write} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return transformresult } set c [chan push [tempchan] foo] inthread $c { puts -nonewline $c snarf flush $c close $c } c lappend res [tempview] } -cleanup { tempdone rename foo {} } -result {{write rt* snarf} transformresult} test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return } set c [chan push [tempchan] foo] inthread $c { puts -nonewline $c snarfsnarfsnarf flush $c close $c } c lappend res [tempview]; # This has to show the original data, as nothing was written } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} {test data}} test iortrans.tf-5.3 {chan write, failed write} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code error FAIL! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { puts -nonewline $c snarfsnarfsnarf lappend notes [catch {flush $c} msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 FAIL!} test iortrans.tf-5.4 {chan write, non-writable channel} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args MUST_NOT_HAPPEN return } set c [chan push [tempchan r] foo] lappend res {*}[inthread $c { lappend notes [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -result {1 {channel "file*" wasn't opened for writing}} test iortrans.tf-5.5 {chan write, failed write, error return} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code error BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 BOOM!} test iortrans.tf-5.6 {chan write, failed write, error return} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args error BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 BOOM!} test iortrans.tf-5.7 {chan write, failed write, break return is error} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code break BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 *bad code*} test iortrans.tf-5.8 {chan write, failed write, continue return is error} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code continue BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg close $c notes } c] } -cleanup { rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 *bad code*} test iortrans.tf-5.9 {chan write, failed write, custom return is error} -setup { set res {} } -constraints {testchannel thread} -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -code 777 BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg] $msg close $c notes } c] } -cleanup { tempdone rename foo {} } -match glob -result {{write rt* snarfsnarfsnarf} 1 *bad code*} test iortrans.tf-5.10 {chan write, failed write, level is ignored} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize handle.finalize lappend ::res $args return -level 55 -code 777 BOOM! } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [catch { puts -nonewline $c snarfsnarfsnarf flush $c } msg opt] $msg noteOpts $opt close $c notes } c] } -cleanup { tempdone rename foo {} } -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}} # --- === *** ########################### # method limit?, drain (via read) test iortrans.tf-6.1 {chan read, read limits} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize limit? handle.finalize lappend ::res $args handle.read return 6 } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [read $c 10] close $c notes } c] } -cleanup { tempdone rename foo {} } -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata }} {limit? rt*} @@} test iortrans.tf-6.2 {chan read, read transform drain on eof} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize drain handle.finalize lappend ::res $args handle.read handle.drain return } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { lappend notes [read $c] lappend notes [close $c] } c] } -cleanup { tempdone rename foo {} } -result {{read rt* {test data }} {drain rt*} @<> {}} # --- === *** ########################### # method clear (via puts, seek) test iortrans.tf-7.1 {chan write, write clears read buffers} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize clear handle.finalize lappend ::res $args handle.clear return transformresult } set c [chan push [tempchan] foo] inthread $c { puts -nonewline $c snarf flush $c close $c } c return $res } -cleanup { tempdone rename foo {} } -result {{clear rt*} {write rt* snarf}} test iortrans.tf-7.2 {seek clears read buffers} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize clear handle.finalize lappend ::res $args return } set c [chan push [tempchan] foo] inthread $c { seek $c 2 close $c } c return $res } -cleanup { tempdone rename foo {} } -result {{clear rt*}} test iortrans.tf-7.3 {clear, any result is ignored} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize clear handle.finalize lappend ::res $args return -code error "X" } set c [chan push [tempchan] foo] inthread $c { seek $c 2 close $c } c return $res } -cleanup { tempdone rename foo {} } -result {{clear rt*}} # --- === *** ########################### # method flush (via seek, close) test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize flush handle.finalize lappend ::res $args return X } set c [chan push [tempchan] foo] lappend res {*}[inthread $c { # Flush, no writing seek $c 2 # The close flushes again, this modifies the file! lappend notes | [close $c] | # NOTE: The flush generated by the close is recorded immediately, the # other note's here are deferred until after the thread is done. This # changes the order of the result a bit from the non-threaded case # (The first | moves one to the right). This is an artifact of the # 'inthread' framework, not of the transformation itself. notes } c] lappend res [tempview] } -cleanup { tempdone rename foo {} } -result {{flush rt*} {flush rt*} | {} | {teXt data}} test iortrans.tf-8.2 {close flushes write buffers, writes data} -setup { set res {} } -constraints {testchannel thread} -match glob -body { proc foo {args} { handle.initialize flush lappend ::res $args handle.finalize return .flushed. } set c [chan push [tempchan] foo] inthread $c { close $c } c lappend res [tempview] } -cleanup { tempdone rename foo {} } -result {{flush rt*} {finalize rt*} .flushed.} # --- === *** ########################### # method watch - removed from TIP (rev 1.12+) # --- === *** ########################### # method event - removed from TIP (rev 1.12+) # --- === *** ########################### # 'Pull the rug' tests. Create channel in a thread A, move to other thread B, # destroy the origin thread (A) before or during access from B. Must not # crash, must return proper errors. test iortrans.tf-11.0 {origin thread of moved transform gone} -setup { #puts <<$tcltest::mainThread>>main set tida [thread::create -preserved]; #puts <<$tida>> thread::send $tida {load {} Tcltest} set tidb [thread::create -preserved]; #puts <<$tida>> thread::send $tidb {load {} Tcltest} } -constraints {testchannel thread} -match glob -body { # Set up channel in thread thread::send $tida $helperscript thread::send $tidb $helperscript set chan [thread::send $tida { proc foo {args} { handle.initialize clear drain flush limit? read write handle.finalize lappend ::res $args return } set chan [chan push [tempchan] foo] fconfigure $chan -buffering none set chan }] # Move channel to 2nd thread, transform goes with it. thread::send $tida [list testchannel cut $chan] thread::send $tidb [list testchannel splice $chan] # Kill origin thread, then access channel from 2nd thread. thread::release -wait $tida set res {} lappend res [catch {thread::send $tidb [list puts $chan shoo]} msg] $msg lappend res [catch {thread::send $tidb [list tell $chan]} msg] $msg lappend res [catch {thread::send $tidb [list seek $chan 1]} msg] $msg lappend res [catch {thread::send $tidb [list gets $chan]} msg] $msg lappend res [catch {thread::send $tidb [list close $chan]} msg] $msg # The 'tell' is ok, as it passed through the transform to the base # channel without invoking the transform handler. } -cleanup { thread::send $tidb tempdone thread::release $tidb } -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} testConstraint notValgrind [expr {![testConstraint valgrind]}] test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup { #puts <<$tcltest::mainThread>>main set tida [thread::create -preserved]; #puts <<$tida>> thread::send $tida {load {} Tcltest} set tidb [thread::create -preserved]; #puts <<$tidb>> thread::send $tidb {load {} Tcltest} } -constraints {testchannel thread notValgrind} -match glob -body { # Set up channel in thread thread::send $tida $helperscript thread::send $tidb $helperscript set chan [thread::send $tida { proc foo {args} { handle.initialize clear drain flush limit? read write handle.finalize lappend ::res $args # destroy thread during channel access thread::exit } set chan [chan push [tempchan] foo] fconfigure $chan -buffering none set chan }] # Move channel to 2nd thread, transform goes with it. thread::send $tida [list testchannel cut $chan] thread::send $tidb [list testchannel splice $chan] # Run access from thread B, wait for response from A (A is not using event # loop at this point, so the event pile up in the queue. thread::send $tidb [list set chan $chan] thread::send $tidb [list set mid [thread::id]] thread::send -async $tidb { # Wait a bit, give the main thread the time to start its event loop to # wait for the response from B after 50 catch { puts $chan shoo } res catch { close $chan } thread::send -async $mid [list set ::res $res] } vwait ::res set res } -cleanup { thread::send $tidb tempdone thread::release $tidb } -result {Owner lost} test iortrans-ea69b0258a9833cb { Crash when using a channel transformation on TCP client socket "line two" does not make it into result. This issue should probably be addressed, but it is outside the scope of this test. } -setup { set res {} set read 0 } -body { namespace eval reflector1 { variable source "line one\nline two" interp alias {} [namespace current]::dispatch {} [ namespace parent]::reflector [namespace current] } set chan [chan create read [namespace which reflector1::dispatch]] chan configure $chan -blocking 0 chan push $chan inputfilter chan event $chan read [list ::apply [list chan { variable res variable read set gets [gets $chan] append res $gets incr read } [namespace current]] $chan] vwait [namespace current]::read chan pop $chan vwait [namespace current]::read return $res } -cleanup { catch {unset read} close $chan } -result {line one} cleanupTests return tcl8.6.14/tests/join.test0000644000175000017500000000325114554262142014645 0ustar sergeisergei# Commands covered: join # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test join-1.1 {basic join commands} { join {a b c} xyz } axyzbxyzc test join-1.2 {basic join commands} { join {a b c} {} } abc test join-1.3 {basic join commands} { join {} xyz } {} test join-1.4 {basic join commands} { join {12 34 56} } {12 34 56} test join-2.1 {join errors} { list [catch join msg] $msg $errorCode } {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}} test join-2.2 {join errors} { list [catch {join a b c} msg] $msg $errorCode } {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}} test join-2.3 {join errors} { list [catch {join "a \{ c" 111} msg] $msg $errorCode } {1 {unmatched open brace in list} {TCL VALUE LIST BRACE}} test join-3.1 {joinString is binary ok} { string length [join {a b c} a\0b] } 9 test join-3.2 {join is binary ok} { string length [join "a\0b a\0b a\0b"] } 11 test join-4.1 {shimmer segfault prevention} { set l {0 0} join $l $l } {00 00} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/lindex.test0000644000175000017500000003227014554262142015174 0ustar sergeisergei# Commands covered: lindex # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] set minus - testConstraint testevalex [llength [info commands testevalex]] # Tests of Tcl_LindexObjCmd, NOT COMPILED test lindex-1.1 {wrong # args} testevalex { list [catch {testevalex lindex} result] $result } "1 {wrong # args: should be \"lindex list ?index ...?\"}" # Indices that are lists or convertible to lists test lindex-2.1 {empty index list} testevalex { set x {} list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {{a b c} {a b c}} test lindex-2.2 {singleton index list} testevalex { set x { 1 } list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {b b} test lindex-2.3 {multiple indices in list} testevalex { set x {1 2} list [testevalex {lindex {{a b c} {d e f}} $x}] \ [testevalex {lindex {{a b c} {d e f}} $x}] } {f f} test lindex-2.4 {malformed index list} testevalex { set x \{ list [catch { testevalex {lindex {a b c} $x} } result] $result } {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers test lindex-3.1 {integer -1} testevalex { set x ${minus}1 list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {{} {}} test lindex-3.2 {integer 0} testevalex { set x [string range 00 0 0] list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {a a} test lindex-3.3 {integer 2} testevalex { set x [string range 22 0 0] list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {c c} test lindex-3.4 {integer 3} testevalex { set x [string range 33 0 0] list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {{} {}} test lindex-3.5 {bad octal} -constraints testevalex -body { set x 0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result } -match glob -result {1 {*invalid octal number*}} test lindex-3.6 {bad octal} -constraints testevalex -body { set x -0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result } -match glob -result {1 {*invalid octal number*}} test lindex-3.7 {indexes don't shimmer wide ints} { set x [expr {(wide(1)<<31) - 2}] list $x [lindex {1 2 3} $x] [incr x] [incr x] } {2147483646 {} 2147483647 2147483648} test lindex-3.8 {compiled with static indices out of range, negative} { list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3] } [lrepeat 3 {}] test lindex-3.9 {compiled with calculated indices out of range, negative constant} { list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1] } [lrepeat 3 {}] test lindex-3.10 {compiled with calculated indices out of range, after end} { list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3] } [lrepeat 3 {}] # Indices relative to end test lindex-4.1 {index = end} testevalex { set x end list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {c c} test lindex-4.2 {index = end--1} testevalex { set x end--1 list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {{} {}} test lindex-4.3 {index = end-0} testevalex { set x end-0 list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {c c} test lindex-4.4 {index = end-2} testevalex { set x end-2 list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {a a} test lindex-4.5 {index = end-3} testevalex { set x end-3 list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {{} {}} test lindex-4.6 {bad octal} -constraints testevalex -body { set x end-0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result } -match glob -result {1 {*invalid octal number*}} test lindex-4.7 {bad octal} -constraints testevalex -body { set x end--0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result } -match glob -result {1 {*invalid octal number*}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-4.9 {obsolete test} testevalex { set x end list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {c c} test lindex-4.10 {incomplete end-} testevalex { set x end- list [catch { testevalex {lindex {a b c} $x} } result] $result } {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-5.1 {bad second index} testevalex { list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result } {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-5.2 {good second index} testevalex { testevalex {lindex {{a b c} {d e f} {g h i}} 1 2} } f test lindex-5.3 {three indices} testevalex { testevalex {lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1} } f test lindex-6.1 {error conditions in parsing list} testevalex { list [catch {testevalex {lindex "a \{" 2}} msg] $msg } {1 {unmatched open brace in list}} test lindex-6.2 {error conditions in parsing list} testevalex { list [catch {testevalex {lindex {a {b c}d e} 2}} msg] $msg } {1 {list element in braces followed by "d" instead of space}} test lindex-6.3 {error conditions in parsing list} testevalex { list [catch {testevalex {lindex {a "b c"def ghi} 2}} msg] $msg } {1 {list element in quotes followed by "def" instead of space}} test lindex-7.1 {quoted elements} testevalex { testevalex {lindex {a "b c" d} 1} } {b c} test lindex-7.2 {quoted elements} testevalex { testevalex {lindex {"{}" b c} 0} } {{}} test lindex-7.3 {quoted elements} testevalex { testevalex {lindex {ab "c d \" x" y} 1} } {c d " x} test lindex-7.4 {quoted elements} { lindex {a b {c d "e} {f g"}} 2 } {c d "e} test lindex-8.1 {data reuse} testevalex { set x 0 testevalex {lindex $x $x} } {0} test lindex-8.2 {data reuse} testevalex { set a 0 testevalex {lindex $a $a $a} } 0 test lindex-8.3 {data reuse} testevalex { set a 1 testevalex {lindex $a $a $a} } {} test lindex-8.4 {data reuse} testevalex { set x [list 0 0] testevalex {lindex $x $x} } {0} test lindex-8.5 {data reuse} testevalex { set x 0 testevalex {lindex $x [list $x $x]} } {0} test lindex-8.6 {data reuse} testevalex { set x [list 1 1] testevalex {lindex $x $x} } {} test lindex-8.7 {data reuse} testevalex { set x 1 testevalex {lindex $x [list $x $x]} } {} #---------------------------------------------------------------------- # Compilation tests for lindex test lindex-9.1 {wrong # args} { list [catch {lindex} result] $result } "1 {wrong # args: should be \"lindex list ?index ...?\"}" test lindex-9.2 {ensure that compilation works in the right order} { proc foo {} { rename foo {} lindex 1 0 } foo } 1 # Indices that are lists or convertible to lists test lindex-10.1 {empty index list} { set x {} catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {{a b c} {a b c}} test lindex-10.2 {singleton index list} { set x { 1 } catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {b b} test lindex-10.3 {multiple indices in list} { set x {1 2} catch { list [lindex {{a b c} {d e f}} $x] [lindex {{a b c} {d e f}} $x] } result set result } {f f} test lindex-10.4 {malformed index list} { set x \{ list [catch { lindex {a b c} $x } result] $result } {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers test lindex-11.1 {integer -1} { set x ${minus}1 catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {{} {}} test lindex-11.2 {integer 0} { set x [string range 00 0 0] catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {a a} test lindex-11.3 {integer 2} { set x [string range 22 0 0] catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {c c} test lindex-11.4 {integer 3} { set x [string range 33 0 0] catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {{} {}} test lindex-11.5 {bad octal} -body { set x 0o8 list [catch { lindex {a b c} $x } result] $result } -match glob -result {1 {*invalid octal number*}} test lindex-11.6 {bad octal} -body { set x -0o9 list [catch { lindex {a b c} $x } result] $result } -match glob -result {1 {*invalid octal number*}} # Indices relative to end test lindex-12.1 {index = end} { set x end catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {c c} test lindex-12.2 {index = end--1} { set x end--1 catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {{} {}} test lindex-12.3 {index = end-0} { set x end-0 catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {c c} test lindex-12.4 {index = end-2} { set x end-2 catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {a a} test lindex-12.5 {index = end-3} { set x end-3 catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {{} {}} test lindex-12.6 {bad octal} -body { set x end-0o8 list [catch { lindex {a b c} $x } result] $result } -match glob -result {1 {*invalid octal number*}} test lindex-12.7 {bad octal} -body { set x end--0o9 list [catch { lindex {a b c} $x } result] $result } -match glob -result {1 {*invalid octal number*}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-12.9 {obsolete test} { set x end catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {c c} test lindex-12.10 {incomplete end-} { set x end- list [catch { lindex {a b c} $x } result] $result } {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-13.1 {bad second index} { list [catch { lindex {a b c} 0 0a2 } result] $result } {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-13.2 {good second index} { catch { lindex {{a b c} {d e f} {g h i}} 1 2 } result set result } f test lindex-13.3 {three indices} { catch { lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1 } result set result } f test lindex-14.1 {error conditions in parsing list} { list [catch { lindex "a \{" 2 } msg] $msg } {1 {unmatched open brace in list}} test lindex-14.2 {error conditions in parsing list} { list [catch { lindex {a {b c}d e} 2 } msg] $msg } {1 {list element in braces followed by "d" instead of space}} test lindex-14.3 {error conditions in parsing list} { list [catch { lindex {a "b c"def ghi} 2 } msg] $msg } {1 {list element in quotes followed by "def" instead of space}} test lindex-15.1 {quoted elements} { catch { lindex {a "b c" d} 1 } result set result } {b c} test lindex-15.2 {quoted elements} { catch { lindex {"{}" b c} 0 } result set result } {{}} test lindex-15.3 {quoted elements} { catch { lindex {ab "c d \" x" y} 1 } result set result } {c d " x} test lindex-15.4 {quoted elements} { catch { lindex {a b {c d "e} {f g"}} 2 } result set result } {c d "e} test lindex-16.1 {data reuse} { set x 0 catch { lindex $x $x } result set result } {0} test lindex-16.2 {data reuse} { set a 0 catch { lindex $a $a $a } result set result } 0 test lindex-16.3 {data reuse} { set a 1 catch { lindex $a $a $a } result set result } {} test lindex-16.4 {data reuse} { set x [list 0 0] catch { lindex $x $x } result set result } {0} test lindex-16.5 {data reuse} { set x 0 catch { lindex $x [list $x $x] } result set result } {0} test lindex-16.6 {data reuse} { set x [list 1 1] catch { lindex $x $x } result set result } {} test lindex-16.7 {data reuse} { set x 1 catch { lindex $x [list $x $x] } result set result } {} test lindex-17.0 {Bug 1718580} {*}{ -body { lindex {} end foo } -match glob -result {bad index "foo"*} -returnCodes 1 } test lindex-17.1 {Bug 1718580} {*}{ -body { lindex a end foo } -match glob -result {bad index "foo"*} -returnCodes 1 } catch { unset minus } # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/link.test0000644000175000017500000003504014554262142014644 0ustar sergeisergei# Commands covered: none # # This file contains a collection of tests for Tcl_LinkVar and related library # procedures. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testlink [llength [info commands testlink]] foreach i {int real bool string} { unset -nocomplain $i } test link-0.1 {leak test} {testlink} { interp create i load {} Tcltest i i eval { testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0 namespace delete :: } interp delete i } {} test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list $int $real $bool $string $wide } -result {43 1.23 1 NULL 12341234} test link-1.2 {reading C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -3 2 0 "A long string with spaces" 43214321 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 list $int $real $bool $string $wide $int $real $bool $string $wide } -result {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321} test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 set int "0o0721" set real -10.5 set bool true set string abcdef set wide 135135 set char 79 set uchar 161 set short 8000 set ushort 40000 set uint 0xc001babe set long 34543 set ulong 567890 set float 1.0987654321 set uwide 357357357357 concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide } -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357} test link-2.2 {writing bad values into variables} -setup { testlink delete } -constraints {testlink} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list [catch {set int 09a} msg] $msg $int } -result {1 {can't set "int": variable must have integer value} 43} test link-2.3 {writing bad values into variables} -setup { testlink delete } -constraints {testlink} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list [catch {set real 1.x3} msg] $msg $real } -result {1 {can't set "real": variable must have real value} 1.23} test link-2.4 {writing bad values into variables} -setup { testlink delete } -constraints {testlink} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list [catch {set bool gorp} msg] $msg $bool } -result {1 {can't set "bool": variable must have boolean value} 1} test link-2.5 {writing bad values into variables} -setup { testlink delete } -constraints {testlink} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list [catch {set wide gorp} msg] $msg $bool } -result {1 {can't set "wide": variable must have integer value} 1} test link-2.6 {writing C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 set int "+" set real "+" set bool 1 set string "+" set wide "+" set char "+" set uchar "+" set short "+" set ushort "+" set uint "+" set long "+" set ulong "+" set float "+" set uwide "+" concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide } -result {1 1.0 1 + 1 1 1 1 1 1 1 1 1.0 1 | + + 1 + + + + + + + + + + +} test link-2.7 {writing C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 set int "-" set real "-" set bool 0 set string "-" set wide "-" set char "-" set uchar "-" set short "-" set ushort "-" set uint "-" set long "-" set ulong "-" set float "-" set uwide "-" concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide } -result {0 0.0 0 - 0 0 0 0 0 0 0 0 0.0 0 | - - 0 - - - - - - - - - - -} test link-2.8 {writing C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 set int "0x" set real "0b" set bool 0 set string "0" set wide "0O" set char "0X" set uchar "0B" set short "0O" set ushort "0x" set uint "0b" set long "0o" set ulong "0X" set float "0B" set uwide "0O" concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide } -result {0 0.0 0 0 0 0 0 0 0 0 0 0 0.0 0 | 0x 0b 0 0 0O 0X 0B 0O 0x 0b 0o 0X 0B 0O} test link-2.9 {writing C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 set int 0 set real 5000e set bool 0 set string 0 set wide 0 set char 0 set uchar 0 set short 0 set ushort 0 set uint 0 set long 0 set ulong 0 set float -60.00e+ set uwide 0 concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide } -result {0 5000.0 0 0 0 0 0 0 0 0 0 0 -60.0 0 | 0 5000e 0 0 0 0 0 0 0 0 0 0 -60.00e+ 0} test link-3.1 {read-only variables} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0 list [catch {set int 4} msg] $msg $int \ [catch {set real 10.6} msg] $msg $real \ [catch {set bool no} msg] $msg $bool \ [catch {set string "new value"} msg] $msg $string \ [catch {set wide 12341234} msg] $msg $wide } -result {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678} test link-3.2 {read-only variables} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0 list [catch {set int 4} msg] $msg $int \ [catch {set real 10.6} msg] $msg $real \ [catch {set bool no} msg] $msg $bool \ [catch {set string "new value"} msg] $msg $string\ [catch {set wide 12341234} msg] $msg $wide } -result {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234} test link-4.1 {unsetting linked variables} -constraints {testlink} -setup { testlink delete } -body { testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 unset int real bool string wide list [catch {set int} msg] $msg [catch {set real} msg] $msg \ [catch {set bool} msg] $msg [catch {set string} msg] $msg \ [catch {set wide} msg] $msg } -result {0 -6 0 -2.5 0 0 0 stringValue 0 13579} test link-4.2 {unsetting linked variables} -constraints {testlink} -setup { testlink delete } -body { testlink set -6 -2.1 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 unset int real bool string wide set int 102 set real 16 set bool true set string newValue set wide 333555 lrange [testlink get] 0 4 } -result {102 16.0 1 newValue 333555} test link-5.1 {unlinking variables} -constraints {testlink} -setup { testlink delete } -body { testlink set -6 -2.25 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink delete set int xx1 set real qrst set bool bogus set string 12345 set wide 875421 set char skjdf set uchar dslfjk set short slkf set ushort skrh set uint sfdkfkh set long srkjh set ulong sjkg set float dskjfbjfd set uwide isdfsngs testlink get } -result {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234} test link-5.2 {unlinking variables} -constraints {testlink} -setup { testlink delete } -body { testlink set -6 -2.25 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink delete testlink set 25 14.7 7 - 999999 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340 list $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide } -result {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234} test link-6.1 {errors in setting up link} -setup { testlink delete unset -nocomplain int } -constraints {testlink} -body { set int(44) 1 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 } -cleanup { unset -nocomplain int } -returnCodes error -result {can't set "int": variable is array} test link-7.1 {access to linked variables via upvar} -setup { testlink delete } -constraints {testlink} -body { proc x {} { upvar int y unset y } testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0 testlink set 14 {} {} {} {} {} {} {} {} {} {} {} {} {} x list [catch {set int} msg] $msg } -result {0 14} test link-7.2 {access to linked variables via upvar} -setup { testlink delete } -constraints {testlink} -body { proc x {} { upvar int y return [set y] } testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0 testlink set 0 {} {} {} {} {} {} {} {} {} {} {} {} {} set int testlink set 23 {} {} {} {} {} {} {} {} {} {} {} {} {} x list [x] $int } -result {23 23} test link-7.3 {access to linked variables via upvar} -setup { testlink delete } -constraints {testlink} -body { proc x {} { upvar int y set y 44 } testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0 testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $int } -result {1 {can't set "y": linked variable is read-only} 11} test link-7.4 {access to linked variables via upvar} -setup { testlink delete } -constraints {testlink} -body { proc x {} { upvar int y set y abc } testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $int } -result {1 {can't set "y": variable must have integer value} -4} test link-7.5 {access to linked variables via upvar} -setup { testlink delete } -constraints {testlink} -body { proc x {} { upvar real y set y abc } testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $real } -result {1 {can't set "y": variable must have real value} 16.75} test link-7.6 {access to linked variables via upvar} -setup { testlink delete } -constraints {testlink} -body { proc x {} { upvar bool y set y abc } testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $bool } -result {1 {can't set "y": variable must have boolean value} 1} test link-7.7 {access to linked variables via upvar} -setup { testlink delete } -constraints {testlink} -body { proc x {} { upvar wide y set y abc } testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $wide } -result {1 {can't set "y": variable must have integer value} 778899} test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} { proc x args { global x int real bool string wide lappend x $args $int $real $bool $string $wide } set x {} testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 trace var int w x testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340 trace remove variable int write x return $x } {{int {} w} 32 -2.0 0 xyzzy 995511} test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} { proc x args { global x int real bool string wide lappend x $args $int $real $bool $string $wide } set x {} testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink delete trace var int w x testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340 trace remove variable int write x return $x } {} test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} { testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0 list [catch { testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {} } msg] $msg $int } {0 {} 47} catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0} catch {testlink delete} foreach i {int real bool string wide} { unset -nocomplain $i } # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/linsert.test0000644000175000017500000000705314554262142015372 0ustar sergeisergei# Commands covered: linsert # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } catch {unset lis} catch {rename p ""} test linsert-1.1 {linsert command} { linsert {1 2 3 4 5} 0 a } {a 1 2 3 4 5} test linsert-1.2 {linsert command} { linsert {1 2 3 4 5} 1 a } {1 a 2 3 4 5} test linsert-1.3 {linsert command} { linsert {1 2 3 4 5} 2 a } {1 2 a 3 4 5} test linsert-1.4 {linsert command} { linsert {1 2 3 4 5} 3 a } {1 2 3 a 4 5} test linsert-1.5 {linsert command} { linsert {1 2 3 4 5} 4 a } {1 2 3 4 a 5} test linsert-1.6 {linsert command} { linsert {1 2 3 4 5} 5 a } {1 2 3 4 5 a} test linsert-1.7 {linsert command} { linsert {1 2 3 4 5} 2 one two \{three \$four } {1 2 one two \{three {$four} 3 4 5} test linsert-1.8 {linsert command} { linsert {\{one \$two \{three \ four \ five} 2 a b c } {\{one {$two} a b c \{three { four} { five}} test linsert-1.9 {linsert command} { linsert {{1 2} {3 4} {5 6} {7 8}} 2 {x y} {a b} } {{1 2} {3 4} {x y} {a b} {5 6} {7 8}} test linsert-1.10 {linsert command} { linsert {} 2 a b c } {a b c} test linsert-1.11 {linsert command} { linsert {} 2 {} } {{}} test linsert-1.12 {linsert command} { linsert {a b "c c" d e} 3 1 } {a b {c c} 1 d e} test linsert-1.13 {linsert command} { linsert { a b c d} 0 1 2 } {1 2 a b c d} test linsert-1.14 {linsert command} { linsert {a b c {d e f}} 4 1 2 } {a b c {d e f} 1 2} test linsert-1.15 {linsert command} { linsert {a b c \{\ abc} 4 q r } {a b c \{\ q r abc} test linsert-1.16 {linsert command} { linsert {a b c \{ abc} 4 q r } {a b c \{ q r abc} test linsert-1.17 {linsert command} { linsert {a b c} end q r } {a b c q r} test linsert-1.18 {linsert command} { linsert {a} end q r } {a q r} test linsert-1.19 {linsert command} { linsert {} end q r } {q r} test linsert-1.20 {linsert command, use of end-int index} { linsert {a b c d} end-2 e f } {a b e f c d} test linsert-2.1 {linsert errors} { list [catch linsert msg] $msg } {1 {wrong # args: should be "linsert list index ?element ...?"}} test linsert-2.2 {linsert errors} { list [catch {linsert a b} msg] $msg } {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test linsert-2.3 {linsert errors} { list [catch {linsert a 12x 2} msg] $msg } {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}} test linsert-2.4 {linsert errors} { list [catch {linsert \{ 12 2} msg] $msg } {1 {unmatched open brace in list}} test linsert-2.5 {syntax (TIP 323)} { linsert {a b c} 0 } [list a b c] test linsert-2.6 {syntax (TIP 323)} { linsert "a\nb\nc" 0 } [list a b c] test linsert-3.1 {linsert won't modify shared argument objects} { proc p {} { linsert "a b c" 1 "x y" return "a b c" } p } "a b c" test linsert-3.2 {linsert won't modify shared argument objects} { catch {unset lis} set lis [format "a \"%s\" c" "b"] linsert $lis 0 [string length $lis] } "7 a b c" # cleanup catch {unset lis} catch {rename p ""} ::tcltest::cleanupTests return tcl8.6.14/tests/listObj.test0000644000175000017500000001674414554262142015327 0ustar sergeisergei# Functionality covered: operation of the procedures in tclListObj.c that # implement the Tcl type manager for the list object type. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] catch {unset x} test listobj-1.1 {Tcl_GetListObjType} emptyTest { # Test removed; tested an internal detail # that's no longer correct, and duplicated test obj-1.1 } {} test listobj-2.1 {Tcl_SetListObj, use in lappend} { catch {unset x} list [lappend x 1 abc def] [lappend x 1 ghi jkl] $x } {{1 abc def} {1 abc def 1 ghi jkl} {1 abc def 1 ghi jkl}} test listobj-2.2 {Tcl_SetListObj, use in ObjInterpProc} { proc return_args {args} { return $args } list [return_args] [return_args x] [return_args x y] } {{} x {x y}} test listobj-2.3 {Tcl_SetListObj, zero element count} { list } {} test listobj-3.1 {Tcl_ListObjAppend, list conversion} { catch {unset x} list [lappend x 1 2 abc "long string"] $x } {{1 2 abc {long string}} {1 2 abc {long string}}} test listobj-3.2 {Tcl_ListObjAppend, list conversion} { set x "" list [lappend x first second] [lappend x third fourth] $x } {{first second} {first second third fourth} {first second third fourth}} test listobj-3.3 {Tcl_ListObjAppend, list conversion} { set x "abc def" list [lappend x first second] $x } {{abc def first second} {abc def first second}} test listobj-3.4 {Tcl_ListObjAppend, error in conversion} { set x " \{" list [catch {lappend x abc def} msg] $msg } {1 {unmatched open brace in list}} test listobj-3.5 {Tcl_ListObjAppend, force internal rep array to grow} { set x "" list [lappend x 1 1] [lappend x 2 2] [lappend x 3 3] [lappend x 4 4] \ [lappend x 5 5] [lappend x 6 6] [lappend x 7 7] [lappend x 8 8] $x } {{1 1} {1 1 2 2} {1 1 2 2 3 3} {1 1 2 2 3 3 4 4} {1 1 2 2 3 3 4 4 5 5} {1 1 2 2 3 3 4 4 5 5 6 6} {1 1 2 2 3 3 4 4 5 5 6 6 7 7} {1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8} {1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8}} test listobj-4.1 {Tcl_ListObjAppendElement, list conversion} { catch {unset x} list [lappend x 1] $x } {1 1} test listobj-4.2 {Tcl_ListObjAppendElement, list conversion} { set x "" list [lappend x first] [lappend x second] $x } {first {first second} {first second}} test listobj-4.3 {Tcl_ListObjAppendElement, list conversion} { set x "abc def" list [lappend x first] $x } {{abc def first} {abc def first}} test listobj-4.4 {Tcl_ListObjAppendElement, error in conversion} { set x " \{" list [catch {lappend x abc} msg] $msg } {1 {unmatched open brace in list}} test listobj-4.5 {Tcl_ListObjAppendElement, force internal rep array to grow} { set x "" list [lappend x 1] [lappend x 2] [lappend x 3] [lappend x 4] \ [lappend x 5] [lappend x 6] [lappend x 7] [lappend x 8] $x } {1 {1 2} {1 2 3} {1 2 3 4} {1 2 3 4 5} {1 2 3 4 5 6} {1 2 3 4 5 6 7} {1 2 3 4 5 6 7 8} {1 2 3 4 5 6 7 8}} test listobj-5.1 {Tcl_ListObjIndex, basic tests} { lindex {a b c} 0 } a test listobj-5.2 {Tcl_ListObjIndex, basic tests} { lindex a 0 } a test listobj-5.3 {Tcl_ListObjIndex, basic tests} { lindex {a {b c d} x} 1 } {b c d} test listobj-5.4 {Tcl_ListObjIndex, basic tests} { lindex {a b c} 3 } {} test listobj-5.5 {Tcl_ListObjIndex, basic tests} { lindex {a b c} 100 } {} test listobj-5.6 {Tcl_ListObjIndex, basic tests} { lindex a 100 } {} test listobj-5.7 {Tcl_ListObjIndex, basic tests} { lindex {} -1 } {} test listobj-5.8 {Tcl_ListObjIndex, error in conversion} { set x " \{" list [catch {lindex $x 0} msg] $msg } {1 {unmatched open brace in list}} test listobj-6.1 {Tcl_ListObjLength} { llength {a b c d} } 4 test listobj-6.2 {Tcl_ListObjLength} { llength {a b c {a b {c d}} d} } 5 test listobj-6.3 {Tcl_ListObjLength} { llength {} } 0 test listobj-6.4 {Tcl_ListObjLength, convert from non-list} { llength 123 } 1 test listobj-6.5 {Tcl_ListObjLength, error converting from non-list} { list [catch {llength "a b c \{"} msg] $msg } {1 {unmatched open brace in list}} test listobj-6.6 {Tcl_ListObjLength, error converting from non-list} { list [catch {llength "a {b}c"} msg] $msg } {1 {list element in braces followed by "c" instead of space}} test listobj-7.1 {Tcl_ListObjReplace, conversion from non-list} { lreplace 123 0 0 x } {x} test listobj-7.2 {Tcl_ListObjReplace, error converting from non-list} { list [catch {lreplace "a b c \{" 1 1 x} msg] $msg } {1 {unmatched open brace in list}} test listobj-7.3 {Tcl_ListObjReplace, error converting from non-list} { list [catch {lreplace "a {b}c" 1 2 x} msg] $msg } {1 {list element in braces followed by "c" instead of space}} test listobj-7.4 {Tcl_ListObjReplace, negative first element index} { lreplace {1 2 3 4 5} -1 1 a } {a 3 4 5} test listobj-7.5 {Tcl_ListObjReplace, last element index >= num elems} { lreplace {1 2 3 4 5} 3 7 a b c } {1 2 3 a b c} test listobj-7.6 {Tcl_ListObjReplace, first element index > last index} { lreplace {1 2 3 4 5} 3 1 a b c } {1 2 3 a b c 4 5} test listobj-7.7 {Tcl_ListObjReplace, no new elements} { lreplace {1 2 3 4 5} 1 1 } {1 3 4 5} test listobj-7.8 {Tcl_ListObjReplace, shrink array in place} { lreplace {1 2 3 4 5 6 7} 4 5 } {1 2 3 4 7} test listobj-7.9 {Tcl_ListObjReplace, grow array in place} { lreplace {1 2 3 4 5 6 7} 1 3 a b c d e } {1 a b c d e 5 6 7} test listobj-7.10 {Tcl_ListObjReplace, replace tail of array} { lreplace {1 2 3 4 5 6 7} 3 6 a } {1 2 3 a} test listobj-7.11 {Tcl_ListObjReplace, must grow internal array} { lreplace {1 2 3 4 5} 2 3 a b c d e f g h i j k l } {1 2 a b c d e f g h i j k l 5} test listobj-7.12 {Tcl_ListObjReplace, grow array, insert at start} { lreplace {1 2 3 4 5} -1 -1 a b c d e f g h i j k l } {a b c d e f g h i j k l 1 2 3 4 5} test listobj-7.13 {Tcl_ListObjReplace, grow array, insert at end} { lreplace {1 2 3 4 5} 4 1 a b c d e f g h i j k l } {1 2 3 4 a b c d e f g h i j k l 5} test listobj-8.1 {SetListFromAny} { lindex {0 foo\x00help 2} 1 } "foo\x00help" test listobj-9.1 {UpdateStringOfList} { string length [list foo\x00help] } 8 test listobj-10.1 {Bug [2971669]} {*}{ -constraints testobj -setup { testobj freeallvars } -body { set result {} lappend result \ [testlistobj set 1 a b c d e] \ [testlistobj replace 1 0x7fffffff 0x7fffffff f] \ [testlistobj get 1] } -cleanup { testobj freeallvars } -result {{a b c d e} {} {a b c d e f}} } test listobj-10.2 {Tcl_ListObjReplace with negative start value} testobj { testlistobj set 1 a b c d e testlistobj replace 1 -1 2 f testlistobj get 1 } {f c d e} test listobj-10.3 {Tcl_ListObjReplace with negative count value} testobj { testlistobj set 1 a b c d e testlistobj replace 1 1 -1 f testlistobj get 1 } {a f b c d e} test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj { testobj bug3598580 } 123 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/list.test0000644000175000017500000001223114554262142014657 0ustar sergeisergei# Commands covered: list # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # First, a bunch of individual tests test list-1.1 {basic tests} {list a b c} {a b c} test list-1.2 {basic tests} {list {a b} c} {{a b} c} test list-1.3 {basic tests} {list \{a b c} {\{a b c} test list-1.4 {basic tests} "list a{}} b{} c}" "a\\{\\}\\} b{} c\\}" test list-1.5 {basic tests} {list a\[ b\] } "{a\[} b\\]" test list-1.6 {basic tests} {list c\ d\t } "{c } {d\t}" test list-1.7 {basic tests} {list e\n f\$ } "{e\n} {f\$}" test list-1.8 {basic tests} {list g\; h\\} {{g;} h\\} test list-1.9 {basic tests} "list a\\\[} b\\\]} " "a\\\[\\\} b\\\]\\\}" test list-1.10 {basic tests} "list c\\\} d\\t} " "c\\} d\\t\\}" test list-1.11 {basic tests} "list e\\n} f\\$} " "e\\n\\} f\\$\\}" test list-1.12 {basic tests} "list g\\;} h\\\\} " "g\\;\\} {h\\}}" test list-1.13 {basic tests} {list a {{}} b} {a {{}} b} test list-1.14 {basic tests} {list a b xy\\} "a b xy\\\\" test list-1.15 {basic tests} "list a b\} e\\" "a b\\} e\\\\" test list-1.16 {basic tests} "list a b\}\\\$ e\\\$\\" "a b\\}\\\$ e\\\$\\\\" test list-1.17 {basic tests} {list a\f \{\f} "{a\f} \\\{\\f" test list-1.18 {basic tests} {list a\r \{\r} "{a\r} \\\{\\r" test list-1.19 {basic tests} {list a\v \{\v} "{a\v} \\\{\\v" test list-1.20 {basic tests} {list \"\}\{} "\\\"\\}\\{" test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd" test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\ test list-1.23 {basic tests} {list \{} "\\{" test list-1.24 {basic tests} {list} {} test list-1.25 {basic tests} {list # #} {{#} #} test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{} test list-1.27 {basic null treatment} { set l [list "" "\0" "\0\0"] set e "{} \0 \0\0" string equal $l $e } 1 test list-1.28 {basic null treatment} { set result "\0a\0b" list $result [string length $result] } "\0a\0b 4" test list-1.29 {basic null treatment} { set result "\0a\0b" set srep "$result 4" set lrep [list $result [string length $result]] string equal $srep $lrep } 1 test list-1.30 {basic null treatment} { set l [list "\0abc" "xyz"] set e "\0abc xyz" string equal $l $e } 1 # For the next round of tests create a list and then pick it apart # with "index" to make sure that we get back exactly what went in. set num 0 proc lcheck {testid a b c} { global num d set d [list $a $b $c] test ${testid}-0 {what goes in must come out} {lindex $d 0} $a test ${testid}-1 {what goes in must come out} {lindex $d 1} $b test ${testid}-2 {what goes in must come out} {lindex $d 2} $c } lcheck list-2.1 a b c lcheck list-2.2 "a b" c\td e\nf lcheck list-2.3 {{a b}} {} { } lcheck list-2.4 \$ \$ab ab\$ lcheck list-2.5 \; \;ab ab\; lcheck list-2.6 \[ \[ab ab\[ lcheck list-2.7 \\ \\ab ab\\ lcheck list-2.8 {"} {"ab} {ab"} ;#" Stupid emacs highlighting! lcheck list-2.9 {a b} { ab} {ab } lcheck list-2.10 a{ a{b \{ab lcheck list-2.11 a} a}b }ab lcheck list-2.12 a\\} {a \}b} {a \{c} lcheck list-2.13 xyz \\ 1\\\n2 lcheck list-2.14 "{ab}\\" "{ab}xy" abc concat {} # Check that tclListObj.c's SetListFromAny handles possible overlarge # string rep lengths in the source object. proc slowsort list { set result {} set last [expr {[llength $list] - 1}] while {$last > 0} { set minIndex [expr {[llength $list] - 1}] set min [lindex $list $last] set i [expr {$minIndex - 1}] while {$i >= 0} { if {[string compare [lindex $list $i] $min] < 0} { set minIndex $i set min [lindex $list $i] } incr i -1 } set result [concat $result [list $min]] if {$minIndex == 0} { set list [lrange $list 1 end] } else { set list [concat [lrange $list 0 [expr {$minIndex - 1}]] \ [lrange $list [expr {$minIndex + 1}] end]] } set last [expr {$last - 1}] } return [concat $result $list] } test list-3.1 {SetListFromAny and lrange/concat results} { slowsort {fred julie alex carol bill annie} } {alex annie bill carol fred julie} test list-4.1 {Bug 3173086} { string is list "{[list \\\\\}]}" } 1 test list-4.2 {Bug 35a8f1c04a, check correct str-rep} { set result {} foreach i { {#"} {#"""} {#"""""""""""""""} "#\"{" "#\"\"\"{" "#\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\{" "#\"}" "#\"\"\"}" "#\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\}" } { set list [list $i] set list [string trim " $list "] if {[llength $list] > 1 || $i ne [lindex $list 0]} { lappend result "wrong string-representation of list by '$i', length: [llength $list], list: '$list'" } } set result [join $result \n] } {} test list-4.3 {Bug 35a8f1c04a, check correct string length} { string length [list #""] } 5 # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/llength.test0000644000175000017500000000236214554262142015345 0ustar sergeisergei# Commands covered: llength # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test llength-1.1 {length of list} { llength {a b c d} } 4 test llength-1.2 {length of list} { llength {a b c {a b {c d}} d} } 5 test llength-1.3 {length of list} { llength {} } 0 test llength-2.1 {error conditions} { list [catch {llength} msg] $msg } {1 {wrong # args: should be "llength list"}} test llength-2.2 {error conditions} { list [catch {llength 123 2} msg] $msg } {1 {wrong # args: should be "llength list"}} test llength-2.3 {error conditions} { list [catch {llength "a b c \{"} msg] $msg } {1 {unmatched open brace in list}} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/lmap.test0000644000175000017500000003116414554262142014643 0ustar sergeisergei# Commands covered: lmap, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 2011 Trevor Davel # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } unset -nocomplain a b i x # ----- Non-compiled operation ----------------------------------------------- # Basic "lmap" operation (non-compiled) test lmap-1.1 {basic lmap tests} { set a {} lmap i {a b c d} { set a [concat $a $i] } } {a {a b} {a b c} {a b c d}} test lmap-1.2 {basic lmap tests} { lmap i {a b {{c d} e} {123 {{x}}}} { set i } } {a b {{c d} e} {123 {{x}}}} test lmap-1.2a {basic lmap tests} { lmap i {a b {{c d} e} {123 {{x}}}} { return -level 0 $i } } {a b {{c d} e} {123 {{x}}}} test lmap-1.4 {basic lmap tests} -returnCodes error -body { lmap } -result {wrong # args: should be "lmap varList list ?varList list ...? command"} test lmap-1.6 {basic lmap tests} -returnCodes error -body { lmap i } -result {wrong # args: should be "lmap varList list ?varList list ...? command"} test lmap-1.8 {basic lmap tests} -returnCodes error -body { lmap i j } -result {wrong # args: should be "lmap varList list ?varList list ...? command"} test lmap-1.10 {basic lmap tests} -returnCodes error -body { lmap i j k l } -result {wrong # args: should be "lmap varList list ?varList list ...? command"} test lmap-1.11 {basic lmap tests} { lmap i {} { set i } } {} test lmap-1.12 {basic lmap tests} { lmap i {} { return -level 0 x } } {} test lmap-1.13 {lmap errors} -returnCodes error -body { lmap {{a}{b}} {1 2 3} {} } -result {list element in braces followed by "{b}" instead of space} test lmap-1.14 {lmap errors} -returnCodes error -body { lmap a {{1 2}3} {} } -result {list element in braces followed by "3" instead of space} unset -nocomplain a test lmap-1.15 {lmap errors} -setup { unset -nocomplain a } -body { set a(0) 44 list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo } -result {1 {can't set "a": variable is array} {can't set "a": variable is array (setting lmap loop variable "a") invoked from within "lmap a {1 2 3} {}"}} test lmap-1.16 {lmap errors} -returnCodes error -body { lmap {} {} {} } -result {lmap varlist is empty} unset -nocomplain a # Parallel "lmap" operation (non-compiled) test lmap-2.1 {parallel lmap tests} { lmap {a b} {1 2 3 4} { list $b $a } } {{2 1} {4 3}} test lmap-2.2 {parallel lmap tests} { lmap {a b} {1 2 3 4 5} { list $b $a } } {{2 1} {4 3} {{} 5}} test lmap-2.3 {parallel lmap tests} { lmap a {1 2 3} b {4 5 6} { list $b $a } } {{4 1} {5 2} {6 3}} test lmap-2.4 {parallel lmap tests} { lmap a {1 2 3} b {4 5 6 7 8} { list $b $a } } {{4 1} {5 2} {6 3} {7 {}} {8 {}}} test lmap-2.5 {parallel lmap tests} { lmap {a b} {a b A B aa bb} c {c C cc CC} { list $a $b $c } } {{a b c} {A B C} {aa bb cc} {{} {} CC}} test lmap-2.6 {parallel lmap tests} { lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} { list $a$b$c$d$e } } {11111 22222 33333} test lmap-2.7 {parallel lmap tests} { lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { set x $a$b$c$d$e } } {{1111 2} 222 33 4} test lmap-2.8 {parallel lmap tests} { lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { join [list $a $b $c $d $e] . } } {{.1.1.1.1 2} .2.2.2. .3..3. ...4.} test lmap-2.9 {lmap only sets vars if repeating loop} { namespace eval ::lmap_test { set rgb {65535 0 0} lmap {r g b} [set rgb] {} set ::x "r=$r, g=$g, b=$b" } namespace delete ::lmap_test set x } {r=65535, g=0, b=0} test lmap-2.10 {lmap only supports local scalar variables} -setup { unset -nocomplain a } -body { lmap {a(3)} {1 2 3 4} {set {a(3)}} } -result {1 2 3 4} unset -nocomplain a # "lmap" with "continue" and "break" (non-compiled) test lmap-3.1 {continue tests} { lmap i {a b c d} { if {[string compare $i "b"] == 0} continue set i } } {a c d} test lmap-3.2 {continue tests} { set x 0 list [lmap i {a b c d} { incr x if {[string compare $i "b"] != 0} continue set i }] $x } {b 4} test lmap-3.3 {break tests} { set x 0 list [lmap i {a b c d} { incr x if {[string compare $i "c"] == 0} break set i }] $x } {{a b} 3} # Check for bug similar to #406709 test lmap-3.4 {break tests} { set a 1 lmap b b {list [concat a; break]; incr a} incr a } {2} # ----- Compiled operation --------------------------------------------------- # Basic "lmap" operation (compiled) test lmap-4.1 {basic lmap tests} { apply {{} { set a {} lmap i {a b c d} { set a [concat $a $i] } }} } {a {a b} {a b c} {a b c d}} test lmap-4.2 {basic lmap tests} { apply {{} { lmap i {a b {{c d} e} {123 {{x}}}} { set i } }} } {a b {{c d} e} {123 {{x}}}} test lmap-4.2a {basic lmap tests} { apply {{} { lmap i {a b {{c d} e} {123 {{x}}}} { return -level 0 $i } }} } {a b {{c d} e} {123 {{x}}}} test lmap-4.4 {basic lmap tests} -returnCodes error -body { apply {{} { lmap }} } -result {wrong # args: should be "lmap varList list ?varList list ...? command"} test lmap-4.6 {basic lmap tests} -returnCodes error -body { apply {{} { lmap i }} } -result {wrong # args: should be "lmap varList list ?varList list ...? command"} test lmap-4.8 {basic lmap tests} -returnCodes error -body { apply {{} { lmap i j }} } -result {wrong # args: should be "lmap varList list ?varList list ...? command"} test lmap-4.10 {basic lmap tests} -returnCodes error -body { apply {{} { lmap i j k l }} } -result {wrong # args: should be "lmap varList list ?varList list ...? command"} test lmap-4.11 {basic lmap tests} { apply {{} { lmap i {} { set i } }} } {} test lmap-4.12 {basic lmap tests} { apply {{} { lmap i {} { return -level 0 x } }} } {} test lmap-4.13 {lmap errors} -returnCodes error -body { apply {{} { lmap {{a}{b}} {1 2 3} {} }} } -result {list element in braces followed by "{b}" instead of space} test lmap-4.14 {lmap errors} -returnCodes error -body { apply {{} { lmap a {{1 2}3} {} }} } -result {list element in braces followed by "3" instead of space} unset -nocomplain a test lmap-4.15 {lmap errors} { apply {{} { set a(0) 44 list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo }} } {1 {can't set "a": variable is array} {can't set "a": variable is array while executing "lmap a {1 2 3} {}"}} test lmap-4.16 {lmap errors} -returnCodes error -body { apply {{} { lmap {} {} {} }} } -result {lmap varlist is empty} unset -nocomplain a # Parallel "lmap" operation (compiled) test lmap-5.1 {parallel lmap tests} { apply {{} { lmap {a b} {1 2 3 4} { list $b $a } }} } {{2 1} {4 3}} test lmap-5.2 {parallel lmap tests} { apply {{} { lmap {a b} {1 2 3 4 5} { list $b $a } }} } {{2 1} {4 3} {{} 5}} test lmap-5.3 {parallel lmap tests} { apply {{} { lmap a {1 2 3} b {4 5 6} { list $b $a } }} } {{4 1} {5 2} {6 3}} test lmap-5.4 {parallel lmap tests} { apply {{} { lmap a {1 2 3} b {4 5 6 7 8} { list $b $a } }} } {{4 1} {5 2} {6 3} {7 {}} {8 {}}} test lmap-5.5 {parallel lmap tests} { apply {{} { lmap {a b} {a b A B aa bb} c {c C cc CC} { list $a $b $c } }} } {{a b c} {A B C} {aa bb cc} {{} {} CC}} test lmap-5.6 {parallel lmap tests} { apply {{} { lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} { list $a$b$c$d$e } }} } {11111 22222 33333} test lmap-5.7 {parallel lmap tests} { apply {{} { lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { set x $a$b$c$d$e } }} } {{1111 2} 222 33 4} test lmap-5.8 {parallel lmap tests} { apply {{} { lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { join [list $a $b $c $d $e] . } }} } {{.1.1.1.1 2} .2.2.2. .3..3. ...4.} test lmap-5.9 {lmap only sets vars if repeating loop} { apply {{} { set rgb {65535 0 0} lmap {r g b} [set rgb] {} return "r=$r, g=$g, b=$b" }} } {r=65535, g=0, b=0} test lmap-5.10 {lmap only supports local scalar variables} { apply {{} { lmap {a(3)} {1 2 3 4} {set {a(3)}} }} } {1 2 3 4} # "lmap" with "continue" and "break" (compiled) test lmap-6.1 {continue tests} { apply {{} { lmap i {a b c d} { if {[string compare $i "b"] == 0} continue set i } }} } {a c d} test lmap-6.2 {continue tests} { apply {{} { list [lmap i {a b c d} { incr x if {[string compare $i "b"] != 0} continue set i }] $x }} } {b 4} test lmap-6.3 {break tests} { apply {{} { list [lmap i {a b c d} { incr x if {[string compare $i "c"] == 0} break set i }] $x }} } {{a b} 3} # Check for bug similar to #406709 test lmap-6.4 {break tests} { apply {{} { set a 1 lmap b b {list [concat a; break]; incr a} incr a }} } {2} # ----- Special cases and bugs ----------------------------------------------- test lmap-7.1 {compiled lmap backward jump works correctly} -setup { unset -nocomplain x } -body { array set x {0 zero 1 one 2 two 3 three} lsort [apply {{arrayName} { upvar 1 $arrayName a lmap member [array names a] { list $member [set a($member)] } }} x] } -result [lsort {{0 zero} {1 one} {2 two} {3 three}}] test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup { unset -nocomplain x } -body { lmap {12.0} {a b c} { set x 12.0 set x [expr {$x + 1}] } } -result {13.0 13.0 13.0} # Test for incorrect "double evaluation" semantics test lmap-7.3 {delayed substitution of body} { apply {{} { set a 0 lmap a [list 1 2 3] " set x $a " return $x }} } {0} # Related to "foreach" test for [Bug 1189274]; crash on failure test lmap-7.4 {empty list handling} { proc crash {} { rename crash {} set a "x y z" set b "" lmap aa $a bb $b { set x "aa = $aa bb = $bb" } } crash } {{aa = x bb = } {aa = y bb = } {aa = z bb = }} # Related to [Bug 1671138]; infinite loop with empty var list in bytecompiled # version. test lmap-7.5 {compiled empty var list} -returnCodes error -body { proc foo {} { lmap {} x { error "reached body" } } foo } -cleanup { catch {rename foo ""} } -result {lmap varlist is empty} test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup { proc demo {} { set vals {1 2 3 4} trace add variable x write {string length $vals ;# } lmap {x y} $vals {format $y} } } -body { demo } -cleanup { rename demo {} } -result {2 4} # Huge lists must not overflow the bytecode interpreter (development bug) test lmap-7.7 {huge list non-compiled} -setup { unset -nocomplain a b x } -body { set x [lmap a [lrepeat 1000000 x] { set b y$a }] list $b [llength $x] [string length $x] } -result {yx 1000000 2999999} test lmap-7.8 {huge list compiled} -setup { unset -nocomplain a b x } -body { set x [apply {{times} { global b lmap a [lrepeat $times x] { set b Y$a } }} 1000000] list $b [llength $x] [string length $x] } -result {Yx 1000000 2999999} test lmap-7.9 {error then dereference loop var (dev bug)} { catch { lmap a 0 b {1 2 3} { error x } } set a } 0 test lmap-7.9a {error then dereference loop var (dev bug)} { catch { lmap a 0 b {1 2 3} { incr a $b; error x } } set a } 1 # ----- Coroutines ----------------------------------------------------------- test lmap-8.1 {lmap non-compiled with coroutines} -body { coroutine coro apply {{} { set values [yield [info coroutine]] eval lmap i [list $values] {{ yield $i }} }} ;# returns 'coro' coro {a b c d e f} ;# -> a coro 1 ;# -> b coro 2 ;# -> c coro 3 ;# -> d coro 4 ;# -> e coro 5 ;# -> f list [coro 6] [info commands coro] } -cleanup { catch {rename coro ""} } -result {{1 2 3 4 5 6} {}} test lmap-8.2 {lmap compiled with coroutines} -body { coroutine coro apply {{} { set values [yield [info coroutine]] lmap i $values { yield $i } }} ;# returns 'coro' coro {a b c d e f} ;# -> a coro 1 ;# -> b coro 2 ;# -> c coro 3 ;# -> d coro 4 ;# -> e coro 5 ;# -> f list [coro 6] [info commands coro] } -cleanup { catch {rename coro ""} } -result {{1 2 3 4 5 6} {}} # cleanup unset -nocomplain a x catch {rename foo {}} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/load.test0000644000175000017500000002410014554262142014621 0ustar sergeisergei# Commands covered: load # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Figure out what extension is used for shared libraries on this # platform. if {![info exists ext]} { set ext [info sharedlibextension] } # Tests require the existence of one of the DLLs in the dltest directory. set testDir [file join [file dirname [info nameofexecutable]] dltest] set x [file join $testDir pkga$ext] set dll "[file tail $x]Required" testConstraint $dll [file readable $x] # Tests also require that this DLL has not already been loaded. set loaded "[file tail $x]Loaded" set alreadyLoaded [info loaded {}] testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] # Certain tests require the 'teststaticpkg' command from tcltest testConstraint teststaticpkg [llength [info commands teststaticpkg]] # Test load-10.1 requires the 'testsimplefilesystem' command from tcltest testConstraint testsimplefilesystem \ [llength [info commands testsimplefilesystem]] test load-1.1 {basic errors} -returnCodes error -body { load } -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"} test load-1.2 {basic errors} -returnCodes error -body { load a b c d } -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"} test load-1.3 {basic errors} -returnCodes error -body { load a b foobar } -result {could not find interpreter "foobar"} test load-1.4 {basic errors} -returnCodes error -body { load -global {} } -result {must specify either file name or package name} test load-1.5 {basic errors} -returnCodes error -body { load -lazy {} {} } -result {must specify either file name or package name} test load-1.6 {basic errors} -returnCodes error -body { load {} Unknown } -result {package "Unknown" isn't loaded statically} test load-1.7 {basic errors} -returnCodes error -body { load -abc foo } -result {bad option "-abc": must be -global, -lazy, or --} test load-1.8 {basic errors} -returnCodes error -body { load -global } -result {couldn't figure out package name for -global} test load-2.1 {basic loading, with guess for package name} \ [list $dll $loaded] { load -global [file join $testDir pkga$ext] list [pkga_eq abc def] [lsort [info commands pkga_*]] } {0 {pkga_eq pkga_quote}} interp create -safe child test load-2.2 {loading into a safe interpreter, with package name conversion} \ [list $dll $loaded] { load -lazy [file join $testDir pkgb$ext] Pkgb child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \ -body { list [catch {load [file join $testDir pkgc$ext] Foo} msg] $msg $errorCode } -match glob \ -result [list 1 {cannot find symbol "Foo_Init"*} \ {TCL LOOKUP LOAD_SYMBOL *Foo_Init}] test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg } {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}} test load-3.1 {error in _Init procedure, same interpreter} \ [list $dll $loaded] { list [catch {load [file join $testDir pkge$ext] Pkge} msg] \ $msg $::errorInfo $::errorCode } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory while executing "open non_existent" invoked from within "if 44 {open non_existent}" invoked from within "load [file join $testDir pkge$ext] Pkge"} {POSIX ENOENT {no such file or directory}}} test load-3.2 {error in _Init procedure, child interpreter} \ [list $dll $loaded] { catch {interp delete x} interp create x set ::errorCode foo set ::errorInfo bar set result [list [catch {load [file join $testDir pkge$ext] Pkge x} msg] \ $msg $::errorInfo $::errorCode] interp delete x set result } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory while executing "open non_existent" invoked from within "if 44 {open non_existent}" invoked from within "load [file join $testDir pkge$ext] Pkge x"} {POSIX ENOENT {no such file or directory}}} test load-4.1 {reloading package into same interpreter} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] Pkga} msg] $msg } {0 {}} test load-4.2 {reloading package into same interpreter} -setup { catch {load [file join $testDir pkga$ext] Pkga} } -constraints [list $dll $loaded] -returnCodes error -body { load [file join $testDir pkga$ext] Pkgb } -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\"" test load-5.1 {file name not specified and no static package: pick default} -setup { catch {interp delete x} interp create x } -constraints [list $dll $loaded] -body { load -global [file join $testDir pkga$ext] Pkga load {} Pkga x info loaded x } -cleanup { interp delete x } -result [list [list [file join $testDir pkga$ext] Pkga]] # On some platforms, like SunOS 4.1.3, these tests can't be run because # they cause the process to exit. # # As of 2005, such ancient broken systems no longer matter. test load-6.1 {errors loading file} [list $dll $loaded] { catch {load foo foo} } {1} test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] { set x "not loaded" teststaticpkg Test 1 0 load {} Test load {} Test child list [set x] [child eval set x] } {loaded loaded} test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] { set x "not loaded" teststaticpkg Another 0 0 load {} Another child eval {set x "not loaded"} list [catch {load {} Another child} msg] $msg \ [child eval set x] [set x] } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded} test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] { set x "not loaded" teststaticpkg More 0 1 load {} More set x } {not loaded} catch {load [file join $testDir pkga$ext] Pkga} catch {load [file join $testDir pkgb$ext] Pkgb} catch {load [file join $testDir pkge$ext] Pkge} set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup { teststaticpkg Test 1 0 teststaticpkg Another 0 0 teststaticpkg More 0 1 } -constraints [list teststaticpkg $dll $loaded] -body { teststaticpkg Double 0 1 teststaticpkg Double 0 1 info loaded } -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded] testConstraint teststaticpkg_8.x 0 if {[testConstraint teststaticpkg]} { catch { teststaticpkg Test 1 1 teststaticpkg Another 0 1 teststaticpkg More 0 1 teststaticpkg Double 0 1 testConstraint teststaticpkg_8.x 1 } } test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] { lsort -index 1 [info loaded] } [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]] test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body { info loaded gorp } -returnCodes error -result {could not find interpreter "gorp"} test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] { lsort -index 1 [info loaded {}] } [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]] test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] { lsort -index 1 [info loaded child] } [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]] test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] { load [file join $testDir pkgb$ext] Pkgb list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]] } [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}] interp delete child test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} -setup { interp create child1 interp create child2 load {} Tcltest child1 load {} Tcltest child2 } -constraints {teststaticpkg} -body { child1 eval { teststaticpkg Loadninepointone 0 1 } child2 eval { teststaticpkg Loadninepointone 0 1 } list [child1 eval { info loaded {} }] \ [child2 eval { info loaded {} }] } -match glob -cleanup { interp delete child1 interp delete child2 } -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} test load-10.1 {load from vfs} -setup { set dir [pwd] cd $testDir testsimplefilesystem 1 } -constraints [list $dll $loaded testsimplefilesystem] -body { list [catch {load simplefs:/pkgd$ext Pkgd} msg] $msg } -result {0 {}} -cleanup { testsimplefilesystem 0 cd $dir unset dir } test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \ [list $dll $loaded] { load [file join $testDir pkgooa$ext] list [pkgooa_stubsok] [lsort [info commands pkgooa_*]] } {1 pkgooa_stubsok} # cleanup unset ext ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/lrange.test0000644000175000017500000001450114554262142015156 0ustar sergeisergei# Commands covered: lrange # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testpurebytesobj [llength [info commands testpurebytesobj]] test lrange-1.1 {range of list elements} { lrange {a b c d} 1 2 } {b c} test lrange-1.2 {range of list elements} { lrange {a {bcd e {f g {}}} l14 l15 d} 1 1 } {{bcd e {f g {}}}} test lrange-1.3 {range of list elements} { lrange {a {bcd e {f g {}}} l14 l15 d} 3 end } {l15 d} test lrange-1.4 {range of list elements} { lrange {a {bcd e {f g {}}} l14 l15 d} 4 10000 } {d} test lrange-1.5 {range of list elements} { lrange {a {bcd e {f g {}}} l14 l15 d} 4 3 } {} test lrange-1.6 {range of list elements} { lrange {a {bcd e {f g {}}} l14 l15 d} 10 11 } {} test lrange-1.7 {range of list elements} { lrange {a b c d e} -1 2 } {a b c} test lrange-1.8 {range of list elements} { lrange {a b c d e} -2 -1 } {} test lrange-1.9 {range of list elements} { lrange {a b c d e} -2 end } {a b c d e} test lrange-1.10 {range of list elements} { lrange "a b\{c d" 1 2 } "b\\{c d" test lrange-1.11 {range of list elements} { lrange "a b c d" end end } d test lrange-1.12 {range of list elements} { lrange "a b c d" end 100000 } d test lrange-1.13 {range of list elements} { lrange "a b c d" end 3 } d test lrange-1.14 {range of list elements} { lrange "a b c d" end 2 } {} test lrange-1.15 {range of list elements} { concat \"[lrange {a b \{\ } 0 2]" } {"a b \{\ "} # emacs highlighting bug workaround --> " test lrange-1.16 {list element quoting} { lrange {[append a .b]} 0 end } {{[append} a .b\]} test lrange-2.1 {error conditions} { list [catch {lrange a b} msg] $msg } {1 {wrong # args: should be "lrange list first last"}} test lrange-2.2 {error conditions} { list [catch {lrange a b 6 7} msg] $msg } {1 {wrong # args: should be "lrange list first last"}} test lrange-2.3 {error conditions} { list [catch {lrange a b 6} msg] $msg } {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test lrange-2.4 {error conditions} { list [catch {lrange a 0 enigma} msg] $msg } {1 {bad index "enigma": must be integer?[+-]integer? or end?[+-]integer?}} test lrange-2.5 {error conditions} { list [catch {lrange "a \{b c" 3 4} msg] $msg } {1 {unmatched open brace in list}} test lrange-2.6 {error conditions} { list [catch {lrange "a b c \{ d e" 1 4} msg] $msg } {1 {unmatched open brace in list}} test lrange-3.1 {Bug 3588366: end-offsets before start} { apply {l { lrange $l 0 end-5 }} {1 2 3 4 5} } {} test lrange-3.2 {compiled with static indices out of range, negative} { list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3] } [lrepeat 4 {}] test lrange-3.3 {compiled with calculated indices out of range, negative constant} { list [lrange {a b c} 0-1 -1-1] [lrange {a b c} -2+0 0-1] [lrange {a b c} -2-1 -2+1] [lrange {a b c} -2+1 -2-1] } [lrepeat 4 {}] test lrange-3.4 {compiled with calculated indices out of range, after end} { list [lrange {a b c} end+1 end+2] [lrange {a b c} end+2 end+1] [lrange {a b c} end+2 end+3] [lrange {a b c} end+3 end+2] } [lrepeat 4 {}] test lrange-3.5 {compiled with calculated indices, start out of range (negative)} { list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1] } [lrepeat 4 {a b}] test lrange-3.6 {compiled with calculated indices, end out of range (after end)} { list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1] } [lrepeat 4 {b c}] test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} { list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \ [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1] } [lrepeat 6 {}] test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} { set cmd lrange list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \ [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1] } [lrepeat 6 {}] # following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep # (as before the fix [58c46e74b931d3a1]): test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} { list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \ [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1] } [lrepeat 6 {}] test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} { set cmd lrange list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \ [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1] } [lrepeat 6 {}] test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints { testpurebytesobj } -body { list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \ [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1] } -result [lrepeat 6 {}] test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints { testpurebytesobj } -body { set cmd lrange list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \ [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1] } -result [lrepeat 6 {}] # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/lrepeat.test0000644000175000017500000000362314554262142015345 0ustar sergeisergei# Commands covered: lrepeat # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2003 by Simon Geard. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ## Arg errors test lrepeat-1.1 {error cases} { -body { lrepeat } -returnCodes 1 -result {wrong # args: should be "lrepeat count ?value ...?"} } test lrepeat-1.2 {Accept zero elements(TIP 323)} { -body { lrepeat 1 } -result {} } test lrepeat-1.3 {error cases} { -body { lrepeat a 1 } -returnCodes 1 -result {expected integer but got "a"} } test lrepeat-1.4 {error cases} { -body { lrepeat -3 1 } -returnCodes 1 -result {bad count "-3": must be integer >= 0} } test lrepeat-1.5 {Accept zero repetitions (TIP 323)} { -body { lrepeat 0 } -result {} } test lrepeat-1.6 {error cases} { -body { lrepeat 3.5 1 } -returnCodes 1 -result {expected integer but got "3.5"} } test lrepeat-1.7 {Accept zero repetitions (TIP 323)} { -body { lrepeat 0 a b c } -result {} } test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body { lrepeat 0x10000000 a b c d e f g h } -returnCodes error -match glob -result * ## Okay test lrepeat-2.1 {normal cases} { lrepeat 10 a } {a a a a a a a a a a} test lrepeat-2.2 {normal cases} { lrepeat 3 [lrepeat 3 0] } {{0 0 0} {0 0 0} {0 0 0}} test lrepeat-2.3 {normal cases} { lrepeat 3 a b c } {a b c a b c a b c} test lrepeat-2.4 {normal cases} { lrepeat 3 [lrepeat 2 a] b c } {{a a} b c {a a} b c {a a} b c} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/lreplace.test0000644000175000017500000001657014554262142015505 0ustar sergeisergei# Commands covered: lreplace # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test lreplace-1.1 {lreplace command} { lreplace {1 2 3 4 5} 0 0 a } {a 2 3 4 5} test lreplace-1.2 {lreplace command} { lreplace {1 2 3 4 5} 1 1 a } {1 a 3 4 5} test lreplace-1.3 {lreplace command} { lreplace {1 2 3 4 5} 2 2 a } {1 2 a 4 5} test lreplace-1.4 {lreplace command} { lreplace {1 2 3 4 5} 3 3 a } {1 2 3 a 5} test lreplace-1.5 {lreplace command} { lreplace {1 2 3 4 5} 4 4 a } {1 2 3 4 a} test lreplace-1.6 {lreplace command} { lreplace {1 2 3 4 5} 4 5 a } {1 2 3 4 a} test lreplace-1.7 {lreplace command} { lreplace {1 2 3 4 5} -1 -1 a } {a 1 2 3 4 5} test lreplace-1.8 {lreplace command} { lreplace {1 2 3 4 5} 2 end a b c d } {1 2 a b c d} test lreplace-1.9 {lreplace command} { lreplace {1 2 3 4 5} 0 3 } {5} test lreplace-1.10 {lreplace command} { lreplace {1 2 3 4 5} 0 4 } {} test lreplace-1.11 {lreplace command} { lreplace {1 2 3 4 5} 0 1 } {3 4 5} test lreplace-1.12 {lreplace command} { lreplace {1 2 3 4 5} 2 3 } {1 2 5} test lreplace-1.13 {lreplace command} { lreplace {1 2 3 4 5} 3 end } {1 2 3} test lreplace-1.14 {lreplace command} { lreplace {1 2 3 4 5} -1 4 a b c } {a b c} test lreplace-1.15 {lreplace command} { lreplace {a b "c c" d e f} 3 3 } {a b {c c} e f} test lreplace-1.16 {lreplace command} { lreplace { 1 2 3 4 5} 0 0 a } {a 2 3 4 5} test lreplace-1.17 {lreplace command} { lreplace {1 2 3 4 "5 6"} 4 4 a } {1 2 3 4 a} test lreplace-1.18 {lreplace command} { lreplace {1 2 3 4 {5 6}} 4 4 a } {1 2 3 4 a} test lreplace-1.19 {lreplace command} { lreplace {1 2 3 4} 2 end x y z } {1 2 x y z} test lreplace-1.20 {lreplace command} { lreplace {1 2 3 4} end end a } {1 2 3 a} test lreplace-1.21 {lreplace command} { lreplace {1 2 3 4} end 3 a } {1 2 3 a} test lreplace-1.22 {lreplace command} { lreplace {1 2 3 4} end end } {1 2 3} test lreplace-1.23 {lreplace command} { lreplace {1 2 3 4} 2 -1 xy } {1 2 xy 3 4} test lreplace-1.24 {lreplace command} { lreplace {1 2 3 4} end -1 z } {1 2 3 z 4} test lreplace-1.25 {lreplace command} { concat \"[lreplace {\}\ hello} end end]\" } {"\}\ "} test lreplace-1.26 {lreplace command} { catch {unset foo} set foo {a b} list [set foo [lreplace $foo end end]] \ [set foo [lreplace $foo end end]] \ [set foo [lreplace $foo end end]] } {a {} {}} test lreplace-1.27 {lreplace command} -body { lreplace x 1 1 } -result x test lreplace-1.28 {lreplace command} -body { lreplace x 1 1 y } -result {x y} test lreplace-1.29 {lreplace command} -body { lreplace x 1 1 [error foo] } -returnCodes 1 -result {foo} test lreplace-1.30 {lreplace command} -body { lreplace {not {}alist} 0 0 [error foo] } -returnCodes 1 -result {foo} test lreplace-2.1 {lreplace errors} { list [catch lreplace msg] $msg } {1 {wrong # args: should be "lreplace list first last ?element ...?"}} test lreplace-2.2 {lreplace errors} { list [catch {lreplace a b} msg] $msg } {1 {wrong # args: should be "lreplace list first last ?element ...?"}} test lreplace-2.3 {lreplace errors} { list [catch {lreplace x a 10} msg] $msg } {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.4 {lreplace errors} { list [catch {lreplace x 10 x} msg] $msg } {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.5 {lreplace errors} { list [catch {lreplace x 10 1x} msg] $msg } {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.6 {lreplace errors} { list [catch {lreplace x 3 2} msg] $msg } {0 x} test lreplace-2.7 {lreplace errors} { list [catch {lreplace x 2 2} msg] $msg } {0 x} test lreplace-3.1 {lreplace won't modify shared argument objects} { proc p {} { lreplace "a b c" 1 1 "x y" return "a b c" } p } "a b c" test lreplace-4.1 {Bug ccc2c2cc98: lreplace edge case} { lreplace {} 1 1 } {} test lreplace-4.2 {Bug ccc2c2cc98: lreplace edge case} { lreplace { } 1 1 } {} test lreplace-4.3 {lreplace edge case} { lreplace {1 2 3} 2 0 } {1 2 3} test lreplace-4.4 {lreplace edge case} { lreplace {1 2 3 4 5} 3 1 } {1 2 3 4 5} test lreplace-4.5 {lreplace edge case} { lreplace {1 2 3 4 5} 3 0 _ } {1 2 3 _ 4 5} test lreplace-4.6 {lreplace end-x: bug a4cb3f06c4} { lreplace {0 1 2 3 4} 0 end-2 } {3 4} test lreplace-4.6.1 {lreplace end-x: bug a4cb3f06c4} { lreplace {0 1 2 3 4} 0 end-2 a b c } {a b c 3 4} test lreplace-4.7 {lreplace with two end-indexes: increasing} { lreplace {0 1 2 3 4} end-2 end-1 } {0 1 4} test lreplace-4.7.1 {lreplace with two end-indexes: increasing} { lreplace {0 1 2 3 4} end-2 end-1 a b c } {0 1 a b c 4} test lreplace-4.8 {lreplace with two end-indexes: equal} { lreplace {0 1 2 3 4} end-2 end-2 } {0 1 3 4} test lreplace-4.8.1 {lreplace with two end-indexes: equal} { lreplace {0 1 2 3 4} end-2 end-2 a b c } {0 1 a b c 3 4} test lreplace-4.9 {lreplace with two end-indexes: decreasing} { lreplace {0 1 2 3 4} end-2 end-3 } {0 1 2 3 4} test lreplace-4.9.1 {lreplace with two end-indexes: decreasing} { lreplace {0 1 2 3 4} end-2 end-3 a b c } {0 1 a b c 2 3 4} test lreplace-4.10 {lreplace with two equal indexes} { lreplace {0 1 2 3 4} 2 2 } {0 1 3 4} test lreplace-4.10.1 {lreplace with two equal indexes} { lreplace {0 1 2 3 4} 2 2 a b c } {0 1 a b c 3 4} test lreplace-4.11 {lreplace end index first} { lreplace {0 1 2 3 4} end-2 1 a b c } {0 1 a b c 2 3 4} test lreplace-4.12 {lreplace end index first} { lreplace {0 1 2 3 4} end-2 2 a b c } {0 1 a b c 3 4} test lreplace-4.13 {lreplace empty list} { lreplace {} 1 1 1 } 1 test lreplace-4.14 {lreplace empty list} { lreplace {} 2 2 2 } 2 test lreplace-5.1 {compiled lreplace: Bug 47ac84309b} { apply {x { lreplace $x end 0 }} {a b c} } {a b c} test lreplace-5.2 {compiled lreplace: Bug 47ac84309b} { apply {x { lreplace $x end 0 A }} {a b c} } {a b A c} # Testing for compiled behaviour. Far too many variations to check with # spelt-out tests. Note that this *just* checks whether the compiled version # and the interpreted version are the same, not whether the interpreted # version is correct. apply {{} { set lss {{} {a} {a b c} {a b c d}} set ins {{} A {A B}} set idxs {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2} set lreplace lreplace foreach ls $lss { foreach a $idxs { foreach b $idxs { foreach i $ins { set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m] set tester [list lreplace $ls $a $b {*}$i] set script [list catch $tester m] set script "list \[$script\] \$m" test lreplace-6.[incr n] {lreplace battery} \ [list apply [list {} $script]] $expected } } } } }} # cleanup catch {unset foo} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/lsearch.test0000644000175000017500000004555414554262142015343 0ustar sergeisergei# Commands covered: lsearch # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } set x {abcd bbcd 123 234 345} test lsearch-1.1 {lsearch command} { lsearch $x 123 } 2 test lsearch-1.2 {lsearch command} { lsearch $x 3456 } -1 test lsearch-1.3 {lsearch command} { lsearch $x *5 } 4 test lsearch-1.4 {lsearch command} { lsearch $x *bc* } 0 test lsearch-2.1 {search modes} { lsearch -exact {xyz bbcc *bc*} *bc* } 2 test lsearch-2.2 {search modes} { lsearch -exact {b.x ^bc xy bcx} ^bc } 1 test lsearch-2.3 {search modes} { lsearch -exact {foo bar cat} ba } -1 test lsearch-2.4 {search modes} { lsearch -exact {foo bar cat} bart } -1 test lsearch-2.5 {search modes} { lsearch -exact {foo bar cat} bar } 1 test lsearch-2.6 {search modes} -returnCodes error -body { lsearch -regexp {xyz bbcc *bc*} *bc* } -result {couldn't compile regular expression pattern: quantifier operand invalid} test lsearch-2.7 {search modes} { lsearch -regexp {b.x ^bc xy bcx} ^bc } 3 test lsearch-2.8 {search modes} { lsearch -glob {xyz bbcc *bc*} *bc* } 1 test lsearch-2.9 {search modes} { lsearch -glob {b.x ^bc xy bcx} ^bc } 1 test lsearch-2.10 {search modes} -returnCodes error -body { lsearch -glib {b.x bx xy bcx} b.x } -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} test lsearch-2.11 {search modes with -nocase} { lsearch -exact -nocase {a b c A B C} A } 0 test lsearch-2.12 {search modes with -nocase} { lsearch -glob -nocase {a b c A B C} A* } 0 test lsearch-2.13 {search modes with -nocase} { lsearch -regexp -nocase {a b c A B C} ^A\$ } 0 test lsearch-2.14 {search modes without -nocase} { lsearch -exact {a b c A B C} A } 3 test lsearch-2.15 {search modes without -nocase} { lsearch -glob {a b c A B C} A* } 3 test lsearch-2.16 {search modes without -nocase} { lsearch -regexp {a b c A B C} ^A\$ } 3 test lsearch-3.1 {lsearch errors} -returnCodes error -body { lsearch } -result {wrong # args: should be "lsearch ?-option value ...? list pattern"} test lsearch-3.2 {lsearch errors} -returnCodes error -body { lsearch a } -result {wrong # args: should be "lsearch ?-option value ...? list pattern"} test lsearch-3.3 {lsearch errors} -returnCodes error -body { lsearch a b c } -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} test lsearch-3.4 {lsearch errors} -returnCodes error -body { lsearch a b c d } -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} test lsearch-3.5 {lsearch errors} -returnCodes error -body { lsearch "\{" b } -result {unmatched open brace in list} test lsearch-3.6 {lsearch errors} -returnCodes error -body { lsearch -index a b } -result {"-index" option must be followed by list index} test lsearch-3.7 {lsearch errors} -returnCodes error -body { lsearch -subindices -exact a b } -result {-subindices cannot be used without -index option} test lsearch-4.1 {binary data} { lsearch -exact [list foo one\000two bar] bar } 2 test lsearch-4.2 {binary data} { set x one append x \x00 append x two lsearch -exact [list foo one\000two bar] $x } 1 # Make a sorted list set l {} set l2 {} for {set i 0} {$i < 100} {incr i} { lappend l $i lappend l2 [expr {double($i)/2}] } set increasingIntegers [lsort -integer $l] set decreasingIntegers [lsort -decreasing -integer $l] set increasingDoubles [lsort -real $l2] set decreasingDoubles [lsort -decreasing -real $l2] set increasingStrings [lsort {48 6a 18b 22a 21aa 35 36}] set decreasingStrings [lsort -decreasing {48 6a 18b 22a 21aa 35 36}] set increasingDictionary [lsort -dictionary {48 6a 18b 22a 21aa 35 36}] set decreasingDictionary [lsort -dictionary -decreasing $increasingDictionary] set l {} for {set i 0} {$i < 10} {incr i} { lappend l $i $i $i $i $i } set repeatingIncreasingIntegers [lsort -integer $l] set repeatingDecreasingIntegers [lsort -integer -decreasing $l] test lsearch-5.1 {binary search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -integer -sorted $increasingIntegers $i] } set res } $increasingIntegers test lsearch-5.2 {binary search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -integer -decreasing -sorted \ $decreasingIntegers $i] } set res } $decreasingIntegers test lsearch-5.3 {binary search finds leftmost occurrences} { set res {} for {set i 0} {$i < 10} {incr i} { lappend res [lsearch -integer -sorted $repeatingIncreasingIntegers $i] } set res } [list 0 5 10 15 20 25 30 35 40 45] test lsearch-5.4 {binary search -decreasing finds leftmost occurrences} { set res {} for {set i 9} {$i >= 0} {incr i -1} { lappend res [lsearch -sorted -integer -decreasing \ $repeatingDecreasingIntegers $i] } set res } [list 0 5 10 15 20 25 30 35 40 45] test lsearch-6.1 {integer search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -exact -integer $increasingIntegers $i] } set res } [lrange $increasingIntegers 0 99] test lsearch-6.2 {decreasing integer search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -exact -integer -decreasing \ $decreasingIntegers $i] } set res } [lrange $decreasingIntegers 0 99] test lsearch-6.3 {sorted integer search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -sorted -integer $increasingIntegers $i] } set res } [lrange $increasingIntegers 0 99] test lsearch-6.4 {sorted decreasing integer search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -integer -sorted -decreasing \ $decreasingIntegers $i] } set res } [lrange $decreasingIntegers 0 99] test lsearch-7.1 {double search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -exact -real $increasingDoubles \ [expr {double($i)/2}]] } set res } [lrange $increasingIntegers 0 99] test lsearch-7.2 {decreasing double search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -exact -real -decreasing \ $decreasingDoubles [expr {double($i)/2}]] } set res } [lrange $decreasingIntegers 0 99] test lsearch-7.3 {sorted double search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -sorted -real \ $increasingDoubles [expr {double($i)/2}]] } set res } [lrange $increasingIntegers 0 99] test lsearch-7.4 {sorted decreasing double search} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -sorted -real -decreasing \ $decreasingDoubles [expr {double($i)/2}]] } set res } [lrange $decreasingIntegers 0 99] test lsearch-8.1 {dictionary search} { set res {} foreach val {6a 18b 21aa 22a 35 36 48} { lappend res [lsearch -exact -dictionary $increasingDictionary $val] } set res } [list 0 1 2 3 4 5 6] test lsearch-8.2 {decreasing dictionary search} { set res {} foreach val {6a 18b 21aa 22a 35 36 48} { lappend res [lsearch -exact -dictionary $decreasingDictionary $val] } set res } [list 6 5 4 3 2 1 0] test lsearch-8.3 {sorted dictionary search} { set res {} foreach val {6a 18b 21aa 22a 35 36 48} { lappend res [lsearch -sorted -dictionary $increasingDictionary $val] } set res } [list 0 1 2 3 4 5 6] test lsearch-8.4 {decreasing sorted dictionary search} { set res {} foreach val {6a 18b 21aa 22a 35 36 48} { lappend res [lsearch -decreasing -sorted -dictionary \ $decreasingDictionary $val] } set res } [list 6 5 4 3 2 1 0] test lsearch-9.1 {ascii search} { set res {} foreach val {18b 21aa 22a 35 36 48 6a} { lappend res [lsearch -exact -ascii $increasingStrings $val] } set res } [list 0 1 2 3 4 5 6] test lsearch-9.2 {decreasing ascii search} { set res {} foreach val {18b 21aa 22a 35 36 48 6a} { lappend res [lsearch -exact -ascii $decreasingStrings $val] } set res } [list 6 5 4 3 2 1 0] test lsearch-9.3 {sorted ascii search} { set res {} foreach val {18b 21aa 22a 35 36 48 6a} { lappend res [lsearch -sorted -ascii $increasingStrings $val] } set res } [list 0 1 2 3 4 5 6] test lsearch-9.4 {decreasing sorted ascii search} { set res {} foreach val {18b 21aa 22a 35 36 48 6a} { lappend res [lsearch -decreasing -sorted -ascii \ $decreasingStrings $val] } set res } [list 6 5 4 3 2 1 0] test lsearch-10.1 {offset searching} { lsearch -start 2 {a b c a b c} a } 3 test lsearch-10.2 {offset searching} { lsearch -start 2 {a b c d e f} a } -1 test lsearch-10.3 {offset searching} { lsearch -start end-4 {a b c a b c} a } 3 test lsearch-10.4 {offset searching} -returnCodes error -body { lsearch -start foobar {a b c a b c} a } -result {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?} test lsearch-10.5 {offset searching} -returnCodes error -body { lsearch -start 1 2 } -result {missing starting index} test lsearch-10.6 {binary search with offset} { set res {} for {set i 0} {$i < 100} {incr i} { lappend res [lsearch -integer -start 2 -sorted $increasingIntegers $i] } set res } [concat -1 -1 [lrange $increasingIntegers 2 end]] test lsearch-10.7 {offset searching with an empty list} { # Stop bug #694232 from reocurring lsearch -start 0 {} x } -1 test lsearch-10.8 {offset searching past the end of the list} { # Stop [Bug 1374778] from reoccurring lsearch -start 10 {a b c} c } -1 test lsearch-10.9 {offset searching past the end of the list} { # Stop [Bug 1374778] from reoccurring lsearch -start 10 -all {a b c} c } {} test lsearch-10.10 {offset searching past the end of the list} { # Stop [Bug 1374778] from reoccurring lsearch -start 10 -inline {a b c} c } {} test lsearch-11.1 {negated searches} { lsearch -not {a a a b a a a} a } 3 test lsearch-11.2 {negated searches} { lsearch -not {a a a a a a a} a } -1 test lsearch-12.1 {return values instead of indices} { lsearch -glob -inline {a1 b2 c3 d4} c* } c3 test lsearch-12.2 {return values instead of indices} { lsearch -glob -inline {a1 b2 c3 d4} e* } {} test lsearch-13.1 {search for all matches} { lsearch -all {a b a c a d} 1 } {} test lsearch-13.2 {search for all matches} { lsearch -all {a b a c a d} a } {0 2 4} test lsearch-13.3 {search for all matches with -nocase} { lsearch -all -exact -nocase {a b c A B C} A } {0 3} test lsearch-13.4 {search for all matches with -nocase} { lsearch -all -glob -nocase {a b c A B C} A* } {0 3} test lsearch-13.5 {search for all matches with -nocase} { lsearch -all -regexp -nocase {a b c A B C} ^A\$ } {0 3} test lsearch-14.1 {combinations: -all and -inline} { lsearch -all -inline -glob {a1 b2 a3 c4 a5 d6} a* } {a1 a3 a5} test lsearch-14.2 {combinations: -all, -inline and -not} { lsearch -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {b2 c4 d6} test lsearch-14.3 {combinations: -all and -not} { lsearch -all -not -glob {a1 b2 a3 c4 a5 d6} a* } {1 3 5} test lsearch-14.4 {combinations: -inline and -not} { lsearch -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {b2} test lsearch-14.5 {combinations: -start, -all and -inline} { lsearch -start 2 -all -inline -glob {a1 b2 a3 c4 a5 d6} a* } {a3 a5} test lsearch-14.6 {combinations: -start, -all, -inline and -not} { lsearch -start 2 -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {c4 d6} test lsearch-14.7 {combinations: -start, -all and -not} { lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a* } {3 5} test lsearch-14.8 {combinations: -start, -inline and -not} { lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {c4} test lsearch-15.1 {make sure no shimmering occurs} { set x [expr {int(sin(0))}] lsearch -start $x $x $x } 0 test lsearch-16.1 {lsearch -regexp shared object} { set str a lsearch -regexp $str $str } 0 # Bug 1366683 test lsearch-16.2 {lsearch -regexp allows internal backrefs} { lsearch -regexp {a aa b} {(.)\1} } 1 test lsearch-17.1 {lsearch -index option, basic functionality} { lsearch -index 1 {{a c} {a b} {a a}} a } 2 test lsearch-17.2 {lsearch -index option, basic functionality} { lsearch -index 1 -exact {{a c} {a b} {a a}} a } 2 test lsearch-17.3 {lsearch -index option, basic functionality} { lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b* } 1 test lsearch-17.4 {lsearch -index option, basic functionality} { lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b} } 0 test lsearch-17.5 {lsearch -index option, basic functionality} { lsearch -all -index 0 -exact {{a c} {a b} {d a}} a } {0 1} test lsearch-17.6 {lsearch -index option, basic functionality} { lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b* } {1 2} test lsearch-17.7 {lsearch -index option, basic functionality} { lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b} } {0 1} test lsearch-17.8 {lsearch -index option, empty argument} { lsearch -index {} a a } 0 test lsearch-17.9 {lsearch -index option, empty argument} { lsearch -index {} a a } [lsearch a a] test lsearch-17.10 {lsearch -index option, empty argument} { lsearch -index {} [list \{] \{ } 0 test lsearch-17.11 {lsearch -index option, empty argument} { lsearch -index {} [list \{] \{ } [lsearch [list \{] \{] test lsearch-17.12 {lsearch -index option, encoding aliasing} -body { lsearch -index -2 a a } -returnCodes error -result {index "-2" cannot select an element from any list} test lsearch-17.13 {lsearch -index option, encoding aliasing} -body { lsearch -index -1-1 a a } -returnCodes error -result {index "-1-1" cannot select an element from any list} test lsearch-17.14 {lsearch -index option, encoding aliasing} -body { lsearch -index end--1 a a } -returnCodes error -result {index "end--1" cannot select an element from any list} test lsearch-17.15 {lsearch -index option, encoding aliasing} -body { lsearch -index end+1 a a } -returnCodes error -result {index "end+1" cannot select an element from any list} test lsearch-17.16 {lsearch -index option, encoding aliasing} -body { lsearch -index end+2 a a } -returnCodes error -result {index "end+2" cannot select an element from any list} test lsearch-18.1 {lsearch -index option, list as index basic functionality} { lsearch -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a } 1 test lsearch-18.2 {lsearch -index option, list as index basic functionality} { lsearch -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a } 0 test lsearch-18.3 {lsearch -index option, list as index basic functionality} { lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* } 0 test lsearch-18.4 {lsearch -index option, list as index basic functionality} { lsearch -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b} } 0 test lsearch-18.5 {lsearch -index option, list as index basic functionality} { lsearch -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a } {0 1} test lsearch-19.1 {lsearch -subindices option} { lsearch -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a } {1 0 0} test lsearch-19.2 {lsearch -subindices option} { lsearch -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a } {0 2 0} test lsearch-19.3 {lsearch -subindices option} { lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* } {0 1 1} test lsearch-19.4 {lsearch -subindices option} { lsearch -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b} } {0 0 1} test lsearch-19.5 {lsearch -subindices option} { lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a } {{0 0 0} {1 0 0}} test lsearch-19.7 {lsearch -subindices option} { lsearch -subindices -index end {{1 a}} a } {0 1} test lsearch-19.8 {lsearch -subindices option} { lsearch -subindices -all -index end {{1 a}} a } {{0 1}} test lsearch-20.1 {lsearch -index option, index larger than sublists} -body { lsearch -index 2 {{a c} {a b} {a a}} a } -returnCodes error -result {element 2 missing from sublist "a c"} test lsearch-20.2 {lsearch -index option, malformed index} -body { lsearch -index foo {{a c} {a b} {a a}} a } -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?} test lsearch-20.3 {lsearch -index option, malformed index} -body { lsearch -index \{ {{a c} {a b} {a a}} a } -returnCodes error -result {unmatched open brace in list} test lsearch-21.1 {lsearch shimmering crash} { set x 0 lsearch -exact -integer $x $x } 0 test lsearch-21.2 {lsearch shimmering crash} { set x 0.5 lsearch -exact -real $x $x } 0 test lsearch-22.1 {lsearch -bisect} -setup { set res {} } -body { foreach i {0 1 5 6 7 8 15 16} { lappend res [lsearch -bisect -integer {1 4 5 7 9 15} $i] } return $res } -result {-1 0 2 2 3 3 5 5} test lsearch-22.2 {lsearch -bisect, last of equals} -setup { set res {} } -body { foreach i {0 1 2 3} { lappend res [lsearch -bisect -integer {0 0 1 1 1 2 2 2 3 3 3} $i] } return $res } -result {1 4 7 10} test lsearch-22.3 {lsearch -bisect decreasing order} -setup { set res {} } -body { foreach i {0 1 5 6 7 8 15 16} { lappend res [lsearch -bisect -integer -decreasing {15 9 7 5 4 1} $i] } return $res } -result {5 5 3 2 2 1 0 -1} test lsearch-22.4 {lsearch -bisect, last of equals, decreasing} -setup { set res {} } -body { foreach i {0 1 2 3} { lappend res [lsearch -bisect -integer -decreasing \ {3 3 3 2 2 2 1 1 1 0 0} $i] } return $res } -result {10 8 5 2} test lsearch-22.5 {lsearch -bisect, all equal} { lsearch -bisect -integer {5 5 5 5} 5 } {3} test lsearch-22.6 {lsearch -sorted, all equal} { lsearch -sorted -integer {5 5 5 5} 5 } {0} # cleanup catch {unset res} catch {unset increasingIntegers} catch {unset decreasingIntegers} catch {unset increasingDoubles} catch {unset decreasingDoubles} catch {unset increasingStrings} catch {unset decreasingStrings} catch {unset increasingDictionary} catch {unset decreasingDictionary} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/lsetComp.test0000644000175000017500000003750714554262142015507 0ustar sergeisergei# This file is a -*- tcl -*- test script # Commands covered: lset # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Procedure to evaluate a script within a proc, to test compilation # functionality proc evalInProc { script } { proc testProc {} $script set status [catch { testProc } result] rename testProc {} return [list $status $result] } # Tests for the bytecode compilation of the 'lset' command test lsetComp-1.1 {lset, compiled, wrong \# args} { evalInProc { lset } } "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}" test lsetComp-2.1 {lset, compiled, list of args, not a simple var name} { evalInProc { set y x set x {{1 2} {3 4}} lset $y {1 1} 5 } } "0 {{1 2} {3 5}}" test lsetComp-2.2 {lset, compiled, list of args, scalar on stack} { evalInProc { set ::x {{1 2} {3 4}} lset ::x {1 1} 5 } } "0 {{1 2} {3 5}}" test lsetComp-2.3 {lset, compiled, list of args, scalar, one-byte offset} { evalInProc { set x {{1 2} {3 4}} lset x {1 1} 5 } } "0 {{1 2} {3 5}}" test lsetComp-2.4 {lset, compiled, list of args, scalar, four-byte offset} { evalInProc { set x0 0; set x1 0; set x2 0; set x3 0; set x4 0; set x5 0; set x6 0; set x7 0; set x8 0; set x9 0; set x10 0; set x11 0; set x12 0; set x13 0; set x14 0; set x15 0; set x16 0; set x17 0; set x18 0; set x19 0; set x20 0; set x21 0; set x22 0; set x23 0; set x24 0; set x25 0; set x26 0; set x27 0; set x28 0; set x29 0; set x30 0; set x31 0; set x32 0; set x33 0; set x34 0; set x35 0; set x36 0; set x37 0; set x38 0; set x39 0; set x40 0; set x41 0; set x42 0; set x43 0; set x44 0; set x45 0; set x46 0; set x47 0; set x48 0; set x49 0; set x50 0; set x51 0; set x52 0; set x53 0; set x54 0; set x55 0; set x56 0; set x57 0; set x58 0; set x59 0; set x60 0; set x61 0; set x62 0; set x63 0; set x64 0; set x65 0; set x66 0; set x67 0; set x68 0; set x69 0; set x70 0; set x71 0; set x72 0; set x73 0; set x74 0; set x75 0; set x76 0; set x77 0; set x78 0; set x79 0; set x80 0; set x81 0; set x82 0; set x83 0; set x84 0; set x85 0; set x86 0; set x87 0; set x88 0; set x89 0; set x90 0; set x91 0; set x92 0; set x93 0; set x94 0; set x95 0; set x96 0; set x97 0; set x98 0; set x99 0; set x100 0; set x101 0; set x102 0; set x103 0; set x104 0; set x105 0; set x106 0; set x107 0; set x108 0; set x109 0; set x110 0; set x111 0; set x112 0; set x113 0; set x114 0; set x115 0; set x116 0; set x117 0; set x118 0; set x119 0; set x120 0; set x121 0; set x122 0; set x123 0; set x124 0; set x125 0; set x126 0; set x127 0; set x128 0; set x129 0; set x130 0; set x131 0; set x132 0; set x133 0; set x134 0; set x135 0; set x136 0; set x137 0; set x138 0; set x139 0; set x140 0; set x141 0; set x142 0; set x143 0; set x144 0; set x145 0; set x146 0; set x147 0; set x148 0; set x149 0; set x150 0; set x151 0; set x152 0; set x153 0; set x154 0; set x155 0; set x156 0; set x157 0; set x158 0; set x159 0; set x160 0; set x161 0; set x162 0; set x163 0; set x164 0; set x165 0; set x166 0; set x167 0; set x168 0; set x169 0; set x170 0; set x171 0; set x172 0; set x173 0; set x174 0; set x175 0; set x176 0; set x177 0; set x178 0; set x179 0; set x180 0; set x181 0; set x182 0; set x183 0; set x184 0; set x185 0; set x186 0; set x187 0; set x188 0; set x189 0; set x190 0; set x191 0; set x192 0; set x193 0; set x194 0; set x195 0; set x196 0; set x197 0; set x198 0; set x199 0; set x200 0; set x201 0; set x202 0; set x203 0; set x204 0; set x205 0; set x206 0; set x207 0; set x208 0; set x209 0; set x210 0; set x211 0; set x212 0; set x213 0; set x214 0; set x215 0; set x216 0; set x217 0; set x218 0; set x219 0; set x220 0; set x221 0; set x222 0; set x223 0; set x224 0; set x225 0; set x226 0; set x227 0; set x228 0; set x229 0; set x230 0; set x231 0; set x232 0; set x233 0; set x234 0; set x235 0; set x236 0; set x237 0; set x238 0; set x239 0; set x240 0; set x241 0; set x242 0; set x243 0; set x244 0; set x245 0; set x246 0; set x247 0; set x248 0; set x249 0; set x250 0; set x251 0; set x252 0; set x253 0; set x254 0; set x255 0; set x {{1 2} {3 4}} lset x {1 1} 5 } } "0 {{1 2} {3 5}}" test lsetComp-2.5 {lset, compiled, list of args, array on stack} { evalInProc { set ::y(0) {{1 2} {3 4}} lset ::y(0) {1 1} 5 } } "0 {{1 2} {3 5}}" test lsetComp-2.6 {lset, compiled, list of args, array, one-byte offset} { evalInProc { set y(0) {{1 2} {3 4}} lset y(0) {1 1} 5 } } "0 {{1 2} {3 5}}" test lsetComp-2.7 {lset, compiled, list of args, array, four-byte offset} { evalInProc { set x0 0; set x1 0; set x2 0; set x3 0; set x4 0; set x5 0; set x6 0; set x7 0; set x8 0; set x9 0; set x10 0; set x11 0; set x12 0; set x13 0; set x14 0; set x15 0; set x16 0; set x17 0; set x18 0; set x19 0; set x20 0; set x21 0; set x22 0; set x23 0; set x24 0; set x25 0; set x26 0; set x27 0; set x28 0; set x29 0; set x30 0; set x31 0; set x32 0; set x33 0; set x34 0; set x35 0; set x36 0; set x37 0; set x38 0; set x39 0; set x40 0; set x41 0; set x42 0; set x43 0; set x44 0; set x45 0; set x46 0; set x47 0; set x48 0; set x49 0; set x50 0; set x51 0; set x52 0; set x53 0; set x54 0; set x55 0; set x56 0; set x57 0; set x58 0; set x59 0; set x60 0; set x61 0; set x62 0; set x63 0; set x64 0; set x65 0; set x66 0; set x67 0; set x68 0; set x69 0; set x70 0; set x71 0; set x72 0; set x73 0; set x74 0; set x75 0; set x76 0; set x77 0; set x78 0; set x79 0; set x80 0; set x81 0; set x82 0; set x83 0; set x84 0; set x85 0; set x86 0; set x87 0; set x88 0; set x89 0; set x90 0; set x91 0; set x92 0; set x93 0; set x94 0; set x95 0; set x96 0; set x97 0; set x98 0; set x99 0; set x100 0; set x101 0; set x102 0; set x103 0; set x104 0; set x105 0; set x106 0; set x107 0; set x108 0; set x109 0; set x110 0; set x111 0; set x112 0; set x113 0; set x114 0; set x115 0; set x116 0; set x117 0; set x118 0; set x119 0; set x120 0; set x121 0; set x122 0; set x123 0; set x124 0; set x125 0; set x126 0; set x127 0; set x128 0; set x129 0; set x130 0; set x131 0; set x132 0; set x133 0; set x134 0; set x135 0; set x136 0; set x137 0; set x138 0; set x139 0; set x140 0; set x141 0; set x142 0; set x143 0; set x144 0; set x145 0; set x146 0; set x147 0; set x148 0; set x149 0; set x150 0; set x151 0; set x152 0; set x153 0; set x154 0; set x155 0; set x156 0; set x157 0; set x158 0; set x159 0; set x160 0; set x161 0; set x162 0; set x163 0; set x164 0; set x165 0; set x166 0; set x167 0; set x168 0; set x169 0; set x170 0; set x171 0; set x172 0; set x173 0; set x174 0; set x175 0; set x176 0; set x177 0; set x178 0; set x179 0; set x180 0; set x181 0; set x182 0; set x183 0; set x184 0; set x185 0; set x186 0; set x187 0; set x188 0; set x189 0; set x190 0; set x191 0; set x192 0; set x193 0; set x194 0; set x195 0; set x196 0; set x197 0; set x198 0; set x199 0; set x200 0; set x201 0; set x202 0; set x203 0; set x204 0; set x205 0; set x206 0; set x207 0; set x208 0; set x209 0; set x210 0; set x211 0; set x212 0; set x213 0; set x214 0; set x215 0; set x216 0; set x217 0; set x218 0; set x219 0; set x220 0; set x221 0; set x222 0; set x223 0; set x224 0; set x225 0; set x226 0; set x227 0; set x228 0; set x229 0; set x230 0; set x231 0; set x232 0; set x233 0; set x234 0; set x235 0; set x236 0; set x237 0; set x238 0; set x239 0; set x240 0; set x241 0; set x242 0; set x243 0; set x244 0; set x245 0; set x246 0; set x247 0; set x248 0; set x249 0; set x250 0; set x251 0; set x252 0; set x253 0; set x254 0; set x255 0; set y(0) {{1 2} {3 4}} lset y(0) {1 1} 5 } } "0 {{1 2} {3 5}}" test lsetComp-2.8 {lset, compiled, list of args, error } { evalInProc { set x { {1 2} {3 4} } lset x {1 5} 5 } } "1 {list index out of range}" test lsetComp-2.9 {lset, compiled, list of args, error - is string preserved} { set ::x { { 1 2 } { 3 4 } } evalInProc { lset ::x { 1 5 } 5 } list $::x [lindex $::x 1] } "{ { 1 2 } { 3 4 } } { 3 4 }" test lsetComp-3.1 {lset, compiled, flat args, not a simple var name} { evalInProc { set y x set x {{1 2} {3 4}} lset $y 1 1 5 } } "0 {{1 2} {3 5}}" test lsetComp-3.2 {lset, compiled, flat args, scalar on stack} { evalInProc { set ::x {{1 2} {3 4}} lset ::x 1 1 5 } } "0 {{1 2} {3 5}}" test lsetComp-3.3 {lset, compiled, flat args, scalar, one-byte offset} { evalInProc { set x {{1 2} {3 4}} lset x 1 1 5 } } "0 {{1 2} {3 5}}" test lsetComp-3.4 {lset, compiled, scalar, four-byte offset} { evalInProc { set x0 0; set x1 0; set x2 0; set x3 0; set x4 0; set x5 0; set x6 0; set x7 0; set x8 0; set x9 0; set x10 0; set x11 0; set x12 0; set x13 0; set x14 0; set x15 0; set x16 0; set x17 0; set x18 0; set x19 0; set x20 0; set x21 0; set x22 0; set x23 0; set x24 0; set x25 0; set x26 0; set x27 0; set x28 0; set x29 0; set x30 0; set x31 0; set x32 0; set x33 0; set x34 0; set x35 0; set x36 0; set x37 0; set x38 0; set x39 0; set x40 0; set x41 0; set x42 0; set x43 0; set x44 0; set x45 0; set x46 0; set x47 0; set x48 0; set x49 0; set x50 0; set x51 0; set x52 0; set x53 0; set x54 0; set x55 0; set x56 0; set x57 0; set x58 0; set x59 0; set x60 0; set x61 0; set x62 0; set x63 0; set x64 0; set x65 0; set x66 0; set x67 0; set x68 0; set x69 0; set x70 0; set x71 0; set x72 0; set x73 0; set x74 0; set x75 0; set x76 0; set x77 0; set x78 0; set x79 0; set x80 0; set x81 0; set x82 0; set x83 0; set x84 0; set x85 0; set x86 0; set x87 0; set x88 0; set x89 0; set x90 0; set x91 0; set x92 0; set x93 0; set x94 0; set x95 0; set x96 0; set x97 0; set x98 0; set x99 0; set x100 0; set x101 0; set x102 0; set x103 0; set x104 0; set x105 0; set x106 0; set x107 0; set x108 0; set x109 0; set x110 0; set x111 0; set x112 0; set x113 0; set x114 0; set x115 0; set x116 0; set x117 0; set x118 0; set x119 0; set x120 0; set x121 0; set x122 0; set x123 0; set x124 0; set x125 0; set x126 0; set x127 0; set x128 0; set x129 0; set x130 0; set x131 0; set x132 0; set x133 0; set x134 0; set x135 0; set x136 0; set x137 0; set x138 0; set x139 0; set x140 0; set x141 0; set x142 0; set x143 0; set x144 0; set x145 0; set x146 0; set x147 0; set x148 0; set x149 0; set x150 0; set x151 0; set x152 0; set x153 0; set x154 0; set x155 0; set x156 0; set x157 0; set x158 0; set x159 0; set x160 0; set x161 0; set x162 0; set x163 0; set x164 0; set x165 0; set x166 0; set x167 0; set x168 0; set x169 0; set x170 0; set x171 0; set x172 0; set x173 0; set x174 0; set x175 0; set x176 0; set x177 0; set x178 0; set x179 0; set x180 0; set x181 0; set x182 0; set x183 0; set x184 0; set x185 0; set x186 0; set x187 0; set x188 0; set x189 0; set x190 0; set x191 0; set x192 0; set x193 0; set x194 0; set x195 0; set x196 0; set x197 0; set x198 0; set x199 0; set x200 0; set x201 0; set x202 0; set x203 0; set x204 0; set x205 0; set x206 0; set x207 0; set x208 0; set x209 0; set x210 0; set x211 0; set x212 0; set x213 0; set x214 0; set x215 0; set x216 0; set x217 0; set x218 0; set x219 0; set x220 0; set x221 0; set x222 0; set x223 0; set x224 0; set x225 0; set x226 0; set x227 0; set x228 0; set x229 0; set x230 0; set x231 0; set x232 0; set x233 0; set x234 0; set x235 0; set x236 0; set x237 0; set x238 0; set x239 0; set x240 0; set x241 0; set x242 0; set x243 0; set x244 0; set x245 0; set x246 0; set x247 0; set x248 0; set x249 0; set x250 0; set x251 0; set x252 0; set x253 0; set x254 0; set x255 0; set x {{1 2} {3 4}} lset x 1 1 5 } } "0 {{1 2} {3 5}}" test lsetComp-3.5 {lset, compiled, flat args, array on stack} { evalInProc { set ::y(0) {{1 2} {3 4}} lset ::y(0) 1 1 5 } } "0 {{1 2} {3 5}}" test lsetComp-3.6 {lset, compiled, flat args, array, one-byte offset} { evalInProc { set y(0) {{1 2} {3 4}} lset y(0) 1 1 5 } } "0 {{1 2} {3 5}}" test lsetComp-3.7 {lset, compiled, flat args, array, four-byte offset} { evalInProc { set x0 0; set x1 0; set x2 0; set x3 0; set x4 0; set x5 0; set x6 0; set x7 0; set x8 0; set x9 0; set x10 0; set x11 0; set x12 0; set x13 0; set x14 0; set x15 0; set x16 0; set x17 0; set x18 0; set x19 0; set x20 0; set x21 0; set x22 0; set x23 0; set x24 0; set x25 0; set x26 0; set x27 0; set x28 0; set x29 0; set x30 0; set x31 0; set x32 0; set x33 0; set x34 0; set x35 0; set x36 0; set x37 0; set x38 0; set x39 0; set x40 0; set x41 0; set x42 0; set x43 0; set x44 0; set x45 0; set x46 0; set x47 0; set x48 0; set x49 0; set x50 0; set x51 0; set x52 0; set x53 0; set x54 0; set x55 0; set x56 0; set x57 0; set x58 0; set x59 0; set x60 0; set x61 0; set x62 0; set x63 0; set x64 0; set x65 0; set x66 0; set x67 0; set x68 0; set x69 0; set x70 0; set x71 0; set x72 0; set x73 0; set x74 0; set x75 0; set x76 0; set x77 0; set x78 0; set x79 0; set x80 0; set x81 0; set x82 0; set x83 0; set x84 0; set x85 0; set x86 0; set x87 0; set x88 0; set x89 0; set x90 0; set x91 0; set x92 0; set x93 0; set x94 0; set x95 0; set x96 0; set x97 0; set x98 0; set x99 0; set x100 0; set x101 0; set x102 0; set x103 0; set x104 0; set x105 0; set x106 0; set x107 0; set x108 0; set x109 0; set x110 0; set x111 0; set x112 0; set x113 0; set x114 0; set x115 0; set x116 0; set x117 0; set x118 0; set x119 0; set x120 0; set x121 0; set x122 0; set x123 0; set x124 0; set x125 0; set x126 0; set x127 0; set x128 0; set x129 0; set x130 0; set x131 0; set x132 0; set x133 0; set x134 0; set x135 0; set x136 0; set x137 0; set x138 0; set x139 0; set x140 0; set x141 0; set x142 0; set x143 0; set x144 0; set x145 0; set x146 0; set x147 0; set x148 0; set x149 0; set x150 0; set x151 0; set x152 0; set x153 0; set x154 0; set x155 0; set x156 0; set x157 0; set x158 0; set x159 0; set x160 0; set x161 0; set x162 0; set x163 0; set x164 0; set x165 0; set x166 0; set x167 0; set x168 0; set x169 0; set x170 0; set x171 0; set x172 0; set x173 0; set x174 0; set x175 0; set x176 0; set x177 0; set x178 0; set x179 0; set x180 0; set x181 0; set x182 0; set x183 0; set x184 0; set x185 0; set x186 0; set x187 0; set x188 0; set x189 0; set x190 0; set x191 0; set x192 0; set x193 0; set x194 0; set x195 0; set x196 0; set x197 0; set x198 0; set x199 0; set x200 0; set x201 0; set x202 0; set x203 0; set x204 0; set x205 0; set x206 0; set x207 0; set x208 0; set x209 0; set x210 0; set x211 0; set x212 0; set x213 0; set x214 0; set x215 0; set x216 0; set x217 0; set x218 0; set x219 0; set x220 0; set x221 0; set x222 0; set x223 0; set x224 0; set x225 0; set x226 0; set x227 0; set x228 0; set x229 0; set x230 0; set x231 0; set x232 0; set x233 0; set x234 0; set x235 0; set x236 0; set x237 0; set x238 0; set x239 0; set x240 0; set x241 0; set x242 0; set x243 0; set x244 0; set x245 0; set x246 0; set x247 0; set x248 0; set x249 0; set x250 0; set x251 0; set x252 0; set x253 0; set x254 0; set x255 0; set y(0) {{1 2} {3 4}} lset y(0) 1 1 5 } } "0 {{1 2} {3 5}}" test lsetComp-3.8 {lset, compiled, flat args, error } { evalInProc { set x { {1 2} {3 4} } lset x 1 5 5 } } "1 {list index out of range}" test lsetComp-3.9 {lset, compiled, flat args, error - is string preserved} { set ::x { { 1 2 } { 3 4 } } evalInProc { lset ::x 1 5 5 } list $::x [lindex $::x 1] } "{ { 1 2 } { 3 4 } } { 3 4 }" catch { rename evalInProc {} } catch { unset ::x } catch { unset ::y } # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/lset.test0000644000175000017500000004113714554262142014662 0ustar sergeisergei# This file is a -*- tcl -*- test script # Commands covered: lset # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] proc failTrace {name1 name2 op} { error "trace failed" } testConstraint testevalex [llength [info commands testevalex]] set noRead {} trace add variable noRead read failTrace set noWrite {a b c} trace add variable noWrite write failTrace test lset-1.1 {lset, not compiled, arg count} testevalex { list [catch {testevalex lset} msg] $msg } "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}" test lset-1.2 {lset, not compiled, no such var} testevalex { list [catch {testevalex {lset noSuchVar 0 {}}} msg] $msg } "1 {can't read \"noSuchVar\": no such variable}" test lset-1.3 {lset, not compiled, var not readable} testevalex { list [catch {testevalex {lset noRead 0 {}}} msg] $msg } "1 {can't read \"noRead\": trace failed}" test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} testevalex { set x {0 1 2} list [testevalex {lset x 0 3}] $x } {{3 1 2} {3 1 2}} test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex { set x {0 1 2} list [catch { testevalex {lset x {{bad}1} 3} } msg] $msg } {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}} test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1 2} list [testevalex {lset x 0 $x}] $x } {{{0 1 2} 1 2} {{0 1 2} 1 2}} test lset-3.2 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1} set y $x list [testevalex {lset x 0 2}] $x $y } {{2 1} {2 1} {0 1}} test lset-3.3 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1} set y $x list [testevalex {lset x 0 $x}] $x $y } {{{0 1} 1} {{0 1} 1} {0 1}} test lset-3.4 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1 2} list [testevalex {lset x [list 0] $x}] $x } {{{0 1 2} 1 2} {{0 1 2} 1 2}} test lset-3.5 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1} set y $x list [testevalex {lset x [list 0] 2}] $x $y } {{2 1} {2 1} {0 1}} test lset-3.6 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1} set y $x list [testevalex {lset x [list 0] $x}] $x $y } {{{0 1} 1} {{0 1} 1} {0 1}} test lset-4.1 {lset, not compiled, 3 args, not a list} testevalex { set a "x \{" list [catch { testevalex {lset a [list 0] y} } msg] $msg } {1 {unmatched open brace in list}} test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex { set a {x y z} list [catch { testevalex {lset a [list 2a2] w} } msg] $msg } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list -1] w} } msg] $msg } {1 {list index out of range}} test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list 4] w} } msg] $msg } {1 {list index out of range}} test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list end--2] w} } msg] $msg } {1 {list index out of range}} test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list end+2] w} } msg] $msg } {1 {list index out of range}} test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list end-3] w} } msg] $msg } {1 {list index out of range}} test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex { set a "x \{" list [catch { testevalex {lset a 0 y} } msg] $msg } {1 {unmatched open brace in list}} test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex { set a {x y z} list [catch { testevalex {lset a 2a2 w} } msg] $msg } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a -1 w} } msg] $msg } {1 {list index out of range}} test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a 4 w} } msg] $msg } {1 {list index out of range}} test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a end--2 w} } msg] $msg } {1 {list index out of range}} test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a end+2 w} } msg] $msg } {1 {list index out of range}} test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a end-3 w} } msg] $msg } {1 {list index out of range}} test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex { list [catch { testevalex {lset noWrite 0 d} } msg] $msg $noWrite } {1 {can't set "noWrite": trace failed} {d b c}} test lset-5.2 {lset, not compiled, 3 args, can't set variable} testevalex { list [catch { testevalex {lset noWrite [list 0] d} } msg] $msg $noWrite } {1 {can't set "noWrite": trace failed} {d b c}} test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a 0 a}] $a } {{a y z} {a y z}} test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a [list 0] a}] $a } {{a y z} {a y z}} test lset-6.3 {lset, not compiled, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a 2 a}] $a } {{x y a} {x y a}} test lset-6.4 {lset, not compiled, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a [list 2] a}] $a } {{x y a} {x y a}} test lset-6.5 {lset, not compiled, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a end a}] $a } {{x y a} {x y a}} test lset-6.6 {lset, not compiled, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a [list end] a}] $a } {{x y a} {x y a}} test lset-6.7 {lset, not compiled, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a end-0 a}] $a } {{x y a} {x y a}} test lset-6.8 {lset, not compiled, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a [list end-0] a}] $a } {{x y a} {x y a}} test lset-6.9 {lset, not compiled, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a end-2 a}] $a } {{a y z} {a y z}} test lset-6.10 {lset, not compiled, 1-d list basics} testevalex { set a {x y z} list [testevalex {lset a [list end-2] a}] $a } {{a y z} {a y z}} test lset-7.1 {lset, not compiled, data sharing} testevalex { set a 0 list [testevalex {lset a $a {gag me}}] $a } {{{gag me}} {{gag me}}} test lset-7.2 {lset, not compiled, data sharing} testevalex { set a [list 0] list [testevalex {lset a $a {gag me}}] $a } {{{gag me}} {{gag me}}} test lset-7.3 {lset, not compiled, data sharing} testevalex { set a {x y} list [testevalex {lset a 0 $a}] $a } {{{x y} y} {{x y} y}} test lset-7.4 {lset, not compiled, data sharing} testevalex { set a {x y} list [testevalex {lset a [list 0] $a}] $a } {{{x y} y} {{x y} y}} test lset-7.5 {lset, not compiled, data sharing} testevalex { set n 0 set a {x y} list [testevalex {lset a $n $n}] $a $n } {{0 y} {0 y} 0} test lset-7.6 {lset, not compiled, data sharing} testevalex { set n [list 0] set a {x y} list [testevalex {lset a $n $n}] $a $n } {{0 y} {0 y} 0} test lset-7.7 {lset, not compiled, data sharing} testevalex { set n 0 set a [list $n $n] list [testevalex {lset a $n 1}] $a $n } {{1 0} {1 0} 0} test lset-7.8 {lset, not compiled, data sharing} testevalex { set n [list 0] set a [list $n $n] list [testevalex {lset a $n 1}] $a $n } {{1 0} {1 0} 0} test lset-7.9 {lset, not compiled, data sharing} testevalex { set a 0 list [testevalex {lset a $a $a}] $a } {0 0} test lset-7.10 {lset, not compiled, data sharing} testevalex { set a [list 0] list [testevalex {lset a $a $a}] $a } {0 0} test lset-8.1 {lset, not compiled, malformed sublist} testevalex { set a [list "a \{" b] list [catch {testevalex {lset a 0 1 c}} msg] $msg } {1 {unmatched open brace in list}} test lset-8.2 {lset, not compiled, malformed sublist} testevalex { set a [list "a \{" b] list [catch {testevalex {lset a {0 1} c}} msg] $msg } {1 {unmatched open brace in list}} test lset-8.3 {lset, not compiled, bad second index} testevalex { set a {{b c} {d e}} list [catch {testevalex {lset a 0 2a2 f}} msg] $msg } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.4 {lset, not compiled, bad second index} testevalex { set a {{b c} {d e}} list [catch {testevalex {lset a {0 2a2} f}} msg] $msg } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.5 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 -1 h}} msg] $msg } {1 {list index out of range}} test lset-8.6 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 -1} h}} msg] $msg } {1 {list index out of range}} test lset-8.7 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 3 h}} msg] $msg } {1 {list index out of range}} test lset-8.8 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 3} h}} msg] $msg } {1 {list index out of range}} test lset-8.9a {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 end--2 h}} msg] $msg } {1 {list index out of range}} test lset-8.9b {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 end+2 h}} msg] $msg } {1 {list index out of range}} test lset-8.10a {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 end--2} h}} msg] $msg } {1 {list index out of range}} test lset-8.10b {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 end+2} h}} msg] $msg } {1 {list index out of range}} test lset-8.11 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 end-2 h}} msg] $msg } {1 {list index out of range}} test lset-8.12 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 end-2} h}} msg] $msg } {1 {list index out of range}} test lset-9.1 {lset, not compiled, entire variable} testevalex { set a x list [testevalex {lset a y}] $a } {y y} test lset-9.2 {lset, not compiled, entire variable} testevalex { set a x list [testevalex {lset a {} y}] $a } {y y} test lset-10.1 {lset, not compiled, shared data} testevalex { set row {p q} set a [list $row $row] list [testevalex {lset a 0 0 x}] $a } {{{x q} {p q}} {{x q} {p q}}} test lset-10.2 {lset, not compiled, shared data} testevalex { set row {p q} set a [list $row $row] list [testevalex {lset a {0 0} x}] $a } {{{x q} {p q}} {{x q} {p q}}} test lset-10.3 {lset, not compiled, shared data, [Bug 1333036]} testevalex { set a [list [list p q] [list r s]] set b $a list [testevalex {lset b {0 0} x}] $a } {{{x q} {r s}} {{p q} {r s}}} test lset-11.1 {lset, not compiled, 2-d basics} testevalex { set a {{b c} {d e}} list [testevalex {lset a 0 0 f}] $a } {{{f c} {d e}} {{f c} {d e}}} test lset-11.2 {lset, not compiled, 2-d basics} testevalex { set a {{b c} {d e}} list [testevalex {lset a {0 0} f}] $a } {{{f c} {d e}} {{f c} {d e}}} test lset-11.3 {lset, not compiled, 2-d basics} testevalex { set a {{b c} {d e}} list [testevalex {lset a 0 1 f}] $a } {{{b f} {d e}} {{b f} {d e}}} test lset-11.4 {lset, not compiled, 2-d basics} testevalex { set a {{b c} {d e}} list [testevalex {lset a {0 1} f}] $a } {{{b f} {d e}} {{b f} {d e}}} test lset-11.5 {lset, not compiled, 2-d basics} testevalex { set a {{b c} {d e}} list [testevalex {lset a 1 0 f}] $a } {{{b c} {f e}} {{b c} {f e}}} test lset-11.6 {lset, not compiled, 2-d basics} testevalex { set a {{b c} {d e}} list [testevalex {lset a {1 0} f}] $a } {{{b c} {f e}} {{b c} {f e}}} test lset-11.7 {lset, not compiled, 2-d basics} testevalex { set a {{b c} {d e}} list [testevalex {lset a 1 1 f}] $a } {{{b c} {d f}} {{b c} {d f}}} test lset-11.8 {lset, not compiled, 2-d basics} testevalex { set a {{b c} {d e}} list [testevalex {lset a {1 1} f}] $a } {{{b c} {d f}} {{b c} {d f}}} test lset-12.0 {lset, not compiled, typical sharing pattern} testevalex { set zero 0 set row [list $zero $zero $zero $zero] set ident [list $row $row $row $row] for { set i 0 } { $i < 4 } { incr i } { testevalex {lset ident $i $i 1} } set ident } {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}} test lset-13.0 {lset, not compiled, shimmering hell} testevalex { set a 0 list [testevalex {lset a $a $a $a $a {gag me}}] $a } {{{{{{gag me}}}}} {{{{{gag me}}}}}} test lset-13.1 {lset, not compiled, shimmering hell} testevalex { set a [list 0] list [testevalex {lset a $a $a $a $a {gag me}}] $a } {{{{{{gag me}}}}} {{{{{gag me}}}}}} test lset-13.2 {lset, not compiled, shimmering hell} testevalex { set a [list 0 0 0 0] list [testevalex {lset a $a {gag me}}] $a } {{{{{{gag me}}}} 0 0 0} {{{{{gag me}}}} 0 0 0}} test lset-14.1 {lset, not compiled, list args, is string rep preserved?} testevalex { set a { { 1 2 } { 3 4 } } catch { testevalex {lset a {1 5} 5} } list $a [lindex $a 1] } "{ { 1 2 } { 3 4 } } { 3 4 }" test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex { set a { { 1 2 } { 3 4 } } catch { testevalex {lset a 1 5 5} } list $a [lindex $a 1] } "{ { 1 2 } { 3 4 } } { 3 4 }" testConstraint testobj [llength [info commands testobj]] test lset-15.1 {lset: shared internalrep [Bug 1677512]} -setup { teststringobj set 1 {{1 2} 3} testobj convert 1 list testobj duplicate 1 2 variable x [teststringobj get 1] variable y [teststringobj get 2] testobj freeallvars set l [list $y z] unset y } -constraints testobj -body { lset l 0 0 0 5 lindex $x 0 0 } -cleanup { unset -nocomplain x l } -result 1 test lset-16.1 {lset - grow a variable} testevalex { set x {} testevalex {lset x 0 {test 1}} testevalex {lset x 1 {test 2}} set x } {{test 1} {test 2}} test lset-16.2 {lset - multiple created sublists} testevalex { set x {} testevalex {lset x 0 0 {test 1}} } {{{test 1}}} test lset-16.3 {lset - sublists 3 deep} testevalex { set x {} testevalex {lset x 0 0 0 {test 1}} } {{{{test 1}}}} test lset-16.4 {lset - append to inner list} testevalex { set x {test 1} testevalex {lset x 1 1 2} testevalex {lset x 1 2 3} testevalex {lset x 1 2 1 4} } {test {1 2 {3 4}}} test lset-16.5 {lset - grow a variable} testevalex { set x {} testevalex {lset x end+1 {test 1}} testevalex {lset x end+1 {test 2}} set x } {{test 1} {test 2}} test lset-16.6 {lset - multiple created sublists} testevalex { set x {} testevalex {lset x end+1 end+1 {test 1}} } {{{test 1}}} test lset-16.7 {lset - sublists 3 deep} testevalex { set x {} testevalex {lset x end+1 end+1 end+1 {test 1}} } {{{{test 1}}}} test lset-16.8 {lset - append to inner list} testevalex { set x {test 1} testevalex {lset x end end+1 2} testevalex {lset x end end+1 3} testevalex {lset x end end end+1 4} } {test {1 2 {3 4}}} catch {unset noRead} catch {unset noWrite} catch {rename failTrace {}} catch {unset ::x} catch {unset ::y} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/macOSXFCmd.test0000644000175000017500000001625114554262142015576 0ustar sergeisergei# This file tests the tclMacOSXFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2003 Tcl Core Team. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # These tests really need to be run from a writable directory, which # it is assumed [temporaryDirectory] is. set oldcwd [pwd] cd [temporaryDirectory] # check whether macosx file attributes are supported testConstraint macosxFileAttr 0 if {[testConstraint unix] && $tcl_platform(os) eq "Darwin"} { catch {file delete -force -- foo.test} close [open foo.test w] catch { file attributes foo.test -creator testConstraint macosxFileAttr 1 } file delete -force -- foo.test } test macOSXFCmd-1.1 {MacOSXGetFileAttribute - file not found} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -creator} msg] $msg } {1 {could not read "foo.test": no such file or directory}} test macOSXFCmd-1.2 {MacOSXGetFileAttribute - creator} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -creator} msg] $msg \ [file delete -force -- foo.test] } {0 {} {}} test macOSXFCmd-1.3 {MacOSXGetFileAttribute - type} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -type} msg] $msg \ [file delete -force -- foo.test] } {0 {} {}} test macOSXFCmd-1.4 {MacOSXGetFileAttribute - hidden} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -hidden} msg] $msg \ [file delete -force -- foo.test] } {0 0 {}} test macOSXFCmd-1.5 {MacOSXGetFileAttribute - rsrclength} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -rsrclength} msg] $msg \ [file delete -force -- foo.test] } {0 0 {}} test macOSXFCmd-2.1 {MacOSXSetFileAttribute - file not found} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -creator FOOC} msg] $msg } {1 {could not read "foo.test": no such file or directory}} test macOSXFCmd-2.2 {MacOSXSetFileAttribute - creator} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -creator FOOC} msg] $msg \ [catch {file attributes foo.test -creator} msg] $msg \ [file delete -force -- foo.test] } {0 {} 0 FOOC {}} test macOSXFCmd-2.3 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -creator {}} msg] $msg \ [catch {file attributes foo.test -creator} msg] $msg \ [file delete -force -- foo.test] } {0 {} 0 {} {}} test macOSXFCmd-2.4 {MacOSXSetFileAttribute - type} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -type FOOT} msg] $msg \ [catch {file attributes foo.test -type} msg] $msg \ [file delete -force -- foo.test] } {0 {} 0 FOOT {}} test macOSXFCmd-2.5 {MacOSXSetFileAttribute - empty type} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -type {}} msg] $msg \ [catch {file attributes foo.test -type} msg] $msg \ [file delete -force -- foo.test] } {0 {} 0 {} {}} test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -hidden 1} msg] $msg \ [catch {file attributes foo.test -hidden} msg] $msg \ [file delete -force -- foo.test] } {0 {} 0 1 {}} test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} { catch {file delete -force -- foo.test} close [open foo.test w] catch { set f [open foo.test/..namedfork/rsrc w] fconfigure $f -translation lf -eofchar {} puts -nonewline $f "foo" close $f } list [catch {file attributes foo.test -rsrclength} msg] $msg \ [catch {file attributes foo.test -rsrclength 0} msg] $msg \ [catch {file attributes foo.test -rsrclength} msg] $msg \ [file delete -force -- foo.test] } {0 3 0 {} 0 0 {}} test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} catch {file delete -force -- bar.test} close [open foo.test w] catch { file attributes foo.test -creator FOOC -type FOOT -hidden 1 set f [open foo.test/..namedfork/rsrc w] fconfigure $f -translation lf -eofchar {} puts -nonewline $f "foo" close $f file copy foo.test bar.test } list [catch {file attributes bar.test -creator} msg] $msg \ [catch {file attributes bar.test -type} msg] $msg \ [catch {file attributes bar.test -hidden} msg] $msg \ [catch {file attributes bar.test -rsrclength} msg] $msg \ [file delete -force -- foo.test bar.test] } {0 FOOC 0 FOOT 0 1 0 3 {}} test macOSXFCmd-4.1 {TclMacOSXMatchType} {macosxFileAttr notRoot} { file mkdir globtest cd globtest foreach f {bar baz foo inv inw .nv reg} { catch {file delete -force -- $f.test} close [open $f.test w] } catch {file delete -force -- dir.test} file mkdir dir.test catch { file attributes bar.test -type FOOT file attributes baz.test -creator FOOC -type FOOT file attributes foo.test -creator FOOC file attributes inv.test -hidden 1 file attributes inw.test -hidden 1 -type FOOT file attributes dir.test -hidden 1 } set res [list \ [catch {lsort [glob *.test]} msg] $msg \ [catch {lsort [glob -types FOOT *.test]} msg] $msg \ [catch {lsort [glob -types {{macintosh type FOOT}} *.test]} msg] $msg \ [catch {lsort [glob -types FOOTT *.test]} msg] $msg \ [catch {lsort [glob -types {{macintosh type FOOTT}} *.test]} msg] $msg \ [catch {lsort [glob -types {{macintosh type {}}} *.test]} msg] $msg \ [catch {lsort [glob -types {{macintosh creator FOOC}} *.test]} msg] $msg \ [catch {lsort [glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test]} msg] $msg \ [catch {lsort [glob -types hidden *.test]} msg] $msg \ [catch {lsort [glob -types {hidden FOOT} *.test]} msg] $msg \ ] cd .. file delete -force globtest set res } [list \ 0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \ 0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \ 1 {bad argument to "-types": FOOTT} \ 1 {expected Macintosh OS type but got "FOOTT": } \ 0 {foo.test inv.test reg.test} 0 {baz.test foo.test} \ 0 baz.test 0 {.nv.test dir.test inv.test inw.test} \ 0 inw.test ] # cleanup cd $oldcwd ::tcltest::cleanupTests return tcl8.6.14/tests/macOSXLoad.test0000644000175000017500000000213214554262142015635 0ustar sergeisergei# Commands covered: load unload # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } set oldTSF $::tcltest::testSingleFile set ::tcltest::testSingleFile false if {[testConstraint unix] && $tcl_platform(os) eq "Darwin" && ![string match *pkga* [info loaded]]} { # On Darwin, test .bundle (un)loading in addition to .dylib set ext .bundle source [file join [file dirname [info script]] load.test] set ext .bundle source [file join [file dirname [info script]] unload.test] unset -nocomplain ext } set ::tcltest::testSingleFile $oldTSF unset oldTSF ::tcltest::cleanupTests return tcl8.6.14/tests/main.test0000644000175000017500000006767214554262142014653 0ustar sergeisergei# This file contains a collection of tests for generic/tclMain.c. if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." return } namespace eval ::tcl::test::main { namespace import ::tcltest::* # Is [exec] defined? testConstraint exec [llength [info commands exec]] # Is the Tcltest package loaded? # - that is, the special C-coded testing commands in tclTest.c # - tests use testing commands introduced in Tcltest 8.4 testConstraint Tcltest [expr { [llength [package provide Tcltest]] && [package vsatisfies [package provide Tcltest] 8.4]}] # Procedure to simulate interactive typing of commands, line by line proc type {chan script} { foreach line [split $script \n] { if {[catch { puts $chan $line flush $chan }]} { return } # Grrr... Behavior depends on this value. after 1000 } } cd [temporaryDirectory] # Tests Tcl_Main-1.*: variable initializations test Tcl_Main-1.1 { Tcl_Main: startup script - normal } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script catch {set f [open "|[list [interpreter] script]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script {} 0]\n test Tcl_Main-1.2 { Tcl_Main: startup script - can't begin with '-' } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} -script catch {set f [open "|[list [interpreter] -script]" w+]} } -body { puts $f {puts [list $argv0 $argv $tcl_interactive]; exit} flush $f read $f } -cleanup { close $f removeFile -script } -result [list [interpreter] -script 0]\n test Tcl_Main-1.3 { } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script catch {set f [open "|[list [interpreter] script \u00c0]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script [list [encoding convertfrom [encoding system] \ [encoding convertto [encoding system] \u00c0]]] 0]\n test Tcl_Main-1.4 { } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script catch {set f [open "|[list [interpreter] script \u20ac]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script [list [encoding convertfrom [encoding system] \ [encoding convertto [encoding system] \u20ac]]] 0]\n test Tcl_Main-1.5 { } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0 catch {set f [open "|[list [interpreter] \u00c0]" r]} } -body { read $f } -cleanup { close $f removeFile \u00c0 } -result [list [list [encoding convertfrom [encoding system] \ [encoding convertto [encoding system] \u00c0]]] {} 0]\n test Tcl_Main-1.6 { } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac catch {set f [open "|[list [interpreter] \u20ac]" r]} } -body { read $f } -cleanup { close $f removeFile \u20ac } -result [list [list [encoding convertfrom [encoding system] \ [encoding convertto [encoding system] \u20ac]]] {} 0]\n test Tcl_Main-1.7 { Tcl_Main: startup script - -encoding option } -constraints { stdio } -setup { set script [makeFile {} script] file delete $script set f [open $script w] chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" close $f catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script {} 0]\n1\n test Tcl_Main-1.8 { Tcl_Main: startup script - -encoding option - mismatched encodings } -constraints { stdio } -setup { set script [makeFile {} script] file delete $script set f [open $script w] chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" close $f catch {set f [open "|[list [interpreter] -encoding iso8859-1 script]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script {} 0]\n0\n test Tcl_Main-1.9 { Tcl_Main: startup script - -encoding option - no abbrevation } -constraints { stdio } -setup { set script [makeFile {} script] file delete $script set f [open $script w] chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" close $f catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} } -body { type $f { puts $argv } list [catch {gets $f} line] $line } -cleanup { close $f removeFile script } -result {0 {-enc utf-8 script}} # Tests Tcl_Main-2.*: application-initialization procedure test Tcl_Main-2.1 { Tcl_Main: appInitProc returns error } -constraints { exec Tcltest } -setup { makeFile {puts "In script"} script } -body { exec [interpreter] script -appinitprocerror >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result "application-specific initialization failed: \nIn script\n" test Tcl_Main-2.2 { Tcl_Main: appInitProc returns error } -constraints { exec Tcltest } -body { exec [interpreter] << {puts "In script"} -appinitprocerror >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "application-specific initialization failed: \nIn script\n" test Tcl_Main-2.3 { Tcl_Main: appInitProc deletes interp } -constraints { exec Tcltest } -setup { makeFile {puts "In script"} script } -body { exec [interpreter] script -appinitprocdeleteinterp >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result "application-specific initialization failed: \n" test Tcl_Main-2.4 { Tcl_Main: appInitProc deletes interp } -constraints { exec Tcltest } -body { exec [interpreter] << {puts "In script"} \ -appinitprocdeleteinterp >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "application-specific initialization failed: \n" test Tcl_Main-2.5 { Tcl_Main: appInitProc closes stderr } -constraints { exec Tcltest } -body { exec [interpreter] << {puts "In script"} \ -appinitprocclosestderr >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "In script\n" # Tests Tcl_Main-3.*: startup script evaluation test Tcl_Main-3.1 { Tcl_Main: startup script does not exist } -constraints { exec } -setup { if {[file exists no-such-file]} { error "Can't run test Tcl_Main-3.1\ where a file named \"no-such-file\" exists" } } -body { set code [catch {exec [interpreter] no-such-file >& result} result] set f [open result] list $code $result [read $f] } -cleanup { close $f file delete result } -match glob -result [list 1 {child process exited abnormally} \ {couldn't read file "no-such-file":*}] test Tcl_Main-3.2 { Tcl_Main: startup script raises error } -constraints { exec } -setup { makeFile {error ERROR} script } -body { set code [catch {exec [interpreter] script >& result} result] set f [open result] list $code $result [read $f] } -cleanup { close $f file delete result removeFile script } -match glob -result [list 1 {child process exited abnormally} \ "ERROR\n while executing*"] test Tcl_Main-3.3 { Tcl_Main: startup script closes stderr } -constraints { exec } -setup { makeFile {close stderr; error ERROR} script } -body { set code [catch {exec [interpreter] script >& result} result] set f [open result] list $code $result [read $f] } -cleanup { close $f file delete result removeFile script } -result [list 1 {child process exited abnormally} {}] test Tcl_Main-3.4 { Tcl_Main: startup script holds incomplete script } -constraints { exec } -setup { makeFile "if 1 \{" script } -body { set code [catch {exec [interpreter] script >& result} result] set f [open result] join [list $code $result [read $f]] \n } -cleanup { close $f file delete result removeFile script } -match glob -result [join [list 1 {child process exited abnormally}\ "missing close-brace\n while executing*"] \n] test Tcl_Main-3.5 { Tcl_Main: startup script sets main loop } -constraints { exec Tcltest } -setup { makeFile { rename exit _exit proc exit {code} { puts "In exit" _exit $code } after 0 { puts event testexitmainloop } testexithandler create 0 testsetmainloop } script } -body { exec [interpreter] script >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result "event\nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-3.6 { Tcl_Main: startup script sets main loop and closes stdin } -constraints { exec Tcltest } -setup { makeFile { close stdin testsetmainloop rename exit _exit proc exit {code} { puts "In exit" _exit $code } after 0 { puts event testexitmainloop } testexithandler create 0 } script } -body { exec [interpreter] script >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result "event\nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-3.7 { Tcl_Main: startup script deletes interp } -constraints { exec Tcltest } -setup { makeFile { rename exit _exit proc exit {code} { puts "In exit" _exit $code } testexithandler create 0 testinterpdelete {} } script } -body { exec [interpreter] script >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result "even 0\n" test Tcl_Main-3.8 { Tcl_Main: startup script deletes interp and sets mainloop } -constraints { exec Tcltest } -setup { makeFile { testsetmainloop rename exit _exit proc exit {code} { puts "In exit" _exit $code } testexitmainloop testexithandler create 0 testinterpdelete {} } script } -body { exec [interpreter] script >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result "Exit MainLoop\neven 0\n" test Tcl_Main-3.9 { Tcl_Main: startup script can set tcl_interactive without limit } -constraints { exec } -setup { makeFile {set tcl_interactive foo} script } -body { exec [interpreter] script >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result {} # Tests Tcl_Main-4.*: rc file evaluation test Tcl_Main-4.1 { Tcl_Main: rcFile evaluation deletes interp } -constraints { exec Tcltest } -setup { set rc [makeFile {testinterpdelete {}} rc] } -body { exec [interpreter] << {puts "In script"} \ -appinitprocsetrcfile $rc >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile rc } -result "application-specific initialization failed: \n" test Tcl_Main-4.2 { Tcl_Main: rcFile evaluation closes stdin } -constraints { exec Tcltest } -setup { set rc [makeFile {close stdin} rc] } -body { exec [interpreter] << {puts "In script"} \ -appinitprocsetrcfile $rc >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile rc } -result "application-specific initialization failed: \n" test Tcl_Main-4.3 { Tcl_Main: rcFile evaluation closes stdin and sets main loop } -constraints { exec Tcltest } -setup { set rc [makeFile { close stdin testsetmainloop after 0 testexitmainloop testexithandler create 0 rename exit _exit proc exit code { puts "In exit" _exit $code } } rc] } -body { exec [interpreter] << {puts "In script"} \ -appinitprocsetrcfile $rc >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile rc } -result "application-specific initialization failed:\ \nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-4.4 { Tcl_Main: rcFile evaluation sets main loop } -constraints { exec Tcltest } -setup { set rc [makeFile { testsetmainloop after 0 testexitmainloop testexithandler create 0 rename exit _exit proc exit code { puts "In exit" _exit $code } } rc] } -body { exec [interpreter] << {} \ -appinitprocsetrcfile $rc >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile rc } -result "application-specific initialization failed:\ \nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-4.5 { Tcl_Main: Bug 1481986 } -constraints { exec Tcltest } -setup { set rc [makeFile { testsetmainloop after 0 {puts "Event callback"} } rc] } -body { set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+] after 1000 type $f {puts {Interactive output} exit } read $f } -cleanup { catch {close $f} removeFile rc } -result "Event callback\nInteractive output\n" # Tests Tcl_Main-5.*: interactive operations test Tcl_Main-5.1 { Tcl_Main: tcl_interactive must be boolean } -constraints { exec } -body { exec [interpreter] << {set tcl_interactive foo} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "can't set \"tcl_interactive\":\ variable must have boolean value\n" test Tcl_Main-5.2 { Tcl_Main able to handle non-blocking stdin } -constraints { exec } -setup { catch {set f [open "|[list [interpreter]]" w+]} } -body { type $f { chan configure stdin -blocking 0 puts SUCCESS } list [catch {gets $f} line] $line } -cleanup { close $f } -result [list 0 SUCCESS] test Tcl_Main-5.3 { Tcl_Main handles stdin EOF in mid-command } -constraints { exec } -setup { catch {set f [open "|[list [interpreter]]" w+]} catch {chan configure $f -blocking 0} } -body { type $f "chan configure stdin -eofchar \\032 if 1 \{\n\032" variable wait chan event $f readable \ [list set [namespace which -variable wait] "child exit"] set id [after 5000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f } -result {child exit} test Tcl_Main-5.4 { Tcl_Main handles stdin EOF in mid-command } -constraints { exec } -setup { set cmd {makeFile "if 1 \{" script} catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]} catch {chan configure $f -blocking 0} } -body { variable wait chan event $f readable \ [list set [namespace which -variable wait] "child exit"] set id [after 5000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f removeFile script } -result {child exit} test Tcl_Main-5.5 { Tcl_Main: error raised in interactive mode } -constraints { exec } -body { exec [interpreter] << {error foo} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "foo\n" test Tcl_Main-5.6 { Tcl_Main: interactive mode: errors don't stop command loop } -constraints { exec } -body { exec [interpreter] << { error foo puts bar } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "foo\nbar\n" test Tcl_Main-5.7 { Tcl_Main: interactive mode: closed stderr } -constraints { exec } -body { exec [interpreter] << { close stderr error foo puts bar } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "bar\n" test Tcl_Main-5.8 { Tcl_Main: interactive mode: close stdin -> main loop & [exit] & exit handlers } -constraints { exec Tcltest } -body { exec [interpreter] << { rename exit _exit proc exit code { puts "In exit" _exit $code } testsetmainloop testexitmainloop testexithandler create 0 close stdin } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-5.9 { Tcl_Main: interactive mode: delete interp -> main loop & exit handlers, but no [exit] } -constraints { exec Tcltest } -body { exec [interpreter] << { rename exit _exit proc exit code { puts "In exit" _exit $code } testsetmainloop testexitmainloop testexithandler create 0 testinterpdelete {} } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\neven 0\n" test Tcl_Main-5.10 { Tcl_Main: exit main loop in mid-interactive command } -constraints { exec Tcltest } -setup { catch {set f [open "|[list [interpreter]]" w+]} catch {chan configure $f -blocking 0} } -body { type $f "testsetmainloop after 2000 testexitmainloop puts \{1 2" after 4000 type $f "3 4\}" set code1 [catch {gets $f} line1] set code2 [catch {gets $f} line2] set code3 [catch {gets $f} line3] list $code1 $line1 $code2 $line2 $code3 $line3 } -cleanup { close $f } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}] test Tcl_Main-5.11 { Tcl_Main: EOF in interactive main loop } -constraints { exec Tcltest } -body { exec [interpreter] << { rename exit _exit proc exit code { puts "In exit" _exit $code } testexithandler create 0 after 0 testexitmainloop testsetmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-5.12 { Tcl_Main: close stdin in interactive main loop } -constraints { exec Tcltest } -body { exec [interpreter] << { rename exit _exit proc exit code { puts "In exit" _exit $code } testexithandler create 0 after 100 testexitmainloop testsetmainloop close stdin puts "don't reach this" } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-5.13 { Bug 1775878 } -constraints { exec } -setup { catch {set f [open "|[list [interpreter]]" w+]} } -body { type $f "puts \\" type $f return list [catch {gets $f} line] $line } -cleanup { close $f } -result [list 0 return] # Tests Tcl_Main-6.*: interactive operations with prompts test Tcl_Main-6.1 { Tcl_Main: enable prompts with tcl_interactive } -constraints { exec } -body { exec [interpreter] << {set tcl_interactive 1} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% " test Tcl_Main-6.2 { Tcl_Main: prompt deletes interp } -constraints { exec Tcltest } -body { exec [interpreter] << { set tcl_prompt1 {testinterpdelete {}} set tcl_interactive 1 puts "not reached" } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n" test Tcl_Main-6.3 { Tcl_Main: prompt closes stdin } -constraints { exec } -body { exec [interpreter] << { set tcl_prompt1 {close stdin} set tcl_interactive 1 puts "not reached" } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n" test Tcl_Main-6.4 { Tcl_Main: interactive output, closed stdout } -constraints { exec } -body { exec [interpreter] << { set tcl_interactive 1 close stdout set a NO puts stderr YES } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% YES\n" test Tcl_Main-6.5 { Tcl_Main: interactive entry to main loop } -constraints { exec Tcltest } -body { exec [interpreter] << { set tcl_interactive 1 testsetmainloop testexitmainloop} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% % % Exit MainLoop\n" test Tcl_Main-6.6 { Tcl_Main: number of prompts during stdin close exit } -constraints { exec } -body { exec [interpreter] << { set tcl_interactive 1 close stdin} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% " test Tcl_Main-6.7 { [unknown]: interactive auto-completion. } -constraints { exec } -body { exec [interpreter] << { proc foo\{ x {} set ::auto_noexec xxx set tcl_interactive 1 foo y} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% % " # Tests Tcl_Main-7.*: exiting test Tcl_Main-7.1 { Tcl_Main: [exit] defined as no-op -> still have exithandlers } -constraints { exec Tcltest } -body { exec [interpreter] << { proc exit args {} testexithandler create 0 } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "even 0\n" test Tcl_Main-7.2 { Tcl_Main: [exit] defined as no-op -> still have exithandlers } -constraints { exec Tcltest } -body { exec [interpreter] << { proc exit args {} testexithandler create 0 after 0 testexitmainloop testsetmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\neven 0\n" # Tests Tcl_Main-8.*: StdinProc operations test Tcl_Main-8.1 { StdinProc: handles non-blocking stdin } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop chan configure stdin -blocking 0 testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\n" test Tcl_Main-8.2 { StdinProc: handles stdin EOF } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop testexithandler create 0 rename exit _exit proc exit code { puts "In exit" _exit $code } after 100 testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-8.3 { StdinProc: handles interactive stdin EOF } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop testexithandler create 0 rename exit _exit proc exit code { puts "In exit" _exit $code } set tcl_interactive 1} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% even 0\n" test Tcl_Main-8.4 { StdinProc: handles stdin close } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop rename exit _exit proc exit code { puts "In exit" _exit $code } after 100 testexitmainloop after 0 puts 1 close stdin } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\nExit MainLoop\nIn exit\n" test Tcl_Main-8.5 { StdinProc: handles interactive stdin close } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop set tcl_interactive 1 rename exit _exit proc exit code { puts "In exit" _exit $code } after 100 testexitmainloop after 0 puts 1 close stdin } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n" test Tcl_Main-8.6 { StdinProc: handles event loop re-entry } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop after 100 {puts 1; set delay 1} vwait delay puts 2 testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n2\nExit MainLoop\n" test Tcl_Main-8.7 { StdinProc: handling of errors } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop error foo testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "foo\nExit MainLoop\n" test Tcl_Main-8.8 { StdinProc: handling of errors, closed stderr } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop close stderr error foo testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\n" test Tcl_Main-8.9 { StdinProc: interactive output } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop set tcl_interactive 1 testexitmainloop} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% % Exit MainLoop\n" test Tcl_Main-8.10 { StdinProc: interactive output, closed stdout } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop close stdout set tcl_interactive 1 testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result {} test Tcl_Main-8.11 { StdinProc: prompt deletes interp } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop set tcl_prompt1 {testinterpdelete {}} set tcl_interactive 1} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n" test Tcl_Main-8.12 { StdinProc: prompt closes stdin } -constraints { exec Tcltest } -body { exec [interpreter] << { testsetmainloop set tcl_prompt1 {close stdin} after 100 testexitmainloop set tcl_interactive 1 puts "not reached" } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\nExit MainLoop\n" test Tcl_Main-8.13 { Bug 1775878 } -constraints { exec Tcltest } -body { exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "pwd\nExit MainLoop\n" # Tests Tcl_Main-9.*: Prompt operations test Tcl_Main-9.1 { Prompt: custom prompt variables } -constraints { exec } -body { exec [interpreter] << { set tcl_prompt1 {puts -nonewline stdout "one "} set tcl_prompt2 {puts -nonewline stdout "two "} set tcl_interactive 1 puts {This is a test}} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\none two This is\n\t\ta test\none " test Tcl_Main-9.2 { Prompt: error in custom prompt variables } -constraints { exec } -body { exec [interpreter] << { set tcl_prompt1 {error foo} set tcl_interactive 1 set errorInfo} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\nfoo\n% foo\n while executing\n\"error foo\"\n (script\ that generates prompt)\nfoo\n% " test Tcl_Main-9.3 { Prompt: error in custom prompt variables, closed stderr } -constraints { exec } -body { exec [interpreter] << { set tcl_prompt1 {close stderr; error foo} set tcl_interactive 1} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% " test Tcl_Main-9.4 { Prompt: error in custom prompt variables, closed stdout } -constraints { exec } -body { exec [interpreter] << { set tcl_prompt1 {close stdout; error foo} set tcl_interactive 1} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\nfoo\n" cd [workingDirectory] cleanupTests } namespace delete ::tcl::test::main return tcl8.6.14/tests/mathop.test0000644000175000017500000015560614554262142015212 0ustar sergeisergei# Commands covered: ::tcl::mathop::... # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 2006 Donal K. Fellows # Copyright (c) 2006 Peter Spjuth # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.1 namespace import -force ::tcltest::* } # A namespace to test that operators are exported and that they # work when imported namespace eval ::testmathop2 { namespace import ::tcl::mathop::* } # Helper to test math ops. # Test different invocation variants and see that they do the same thing. # Byte compiled / non byte compiled version # Shared / unshared arguments # Original / imported proc TestOp {op args} { set results {} # Non byte compiled version, shared args if {[catch {::tcl::mathop::$op {*}$args} res]} { append res " $::errorCode" } lappend results $res # Non byte compiled version, unshared args set cmd ::tcl::mathop::\$op foreach arg $args { append cmd " \[format %s [list $arg]\]" } if {[catch $cmd res]} { append res " $::errorCode" } lappend results $res # Non byte compiled imported if {[catch {::testmathop2::$op {*}$args} res]} { append res " $::errorCode" } lappend results [string map {testmathop2 tcl::mathop} $res] # BC version set argList1 {} set argList2 {} set argList3 {} for {set t 0} {$t < [llength $args]} {incr t} { lappend argList1 a$t lappend argList2 \$a$t lappend argList3 "\[format %s \$a$t\]" } # Shared args proc _TestOp $argList1 "::tcl::mathop::$op [join $argList2]" # Unshared args proc _TestOp2 $argList1 "::tcl::mathop::$op [join $argList3]" # Imported proc _TestOp3 $argList1 "::testmathop2::$op [join $argList2]" set ::tcl_traceCompile 0 ;# Set to 2 to help with debug if {[catch {_TestOp {*}$args} res]} { append res " $::errorCode" } set ::tcl_traceCompile 0 lappend results $res if {[catch {_TestOp2 {*}$args} res]} { append res " $::errorCode" } lappend results $res if {[catch {_TestOp3 {*}$args} res]} { append res " $::errorCode" } lappend results [string map {testmathop2 tcl::mathop} $res] # Check that they do the same set len [llength $results] for {set i 0} {$i < ($len - 1)} {incr i} { set res1 [lindex $results $i] set res2 [lindex $results $i+1] if {$res1 ne $res2} { return "$i:($res1 != $res2)" } } return [lindex $results 0] } # start of tests namespace eval ::testmathop { namespace path ::tcl::mathop variable op ;# stop surprises! test mathop-1.1 {compiled +} { + } 0 test mathop-1.2 {compiled +} { + 1 } 1 test mathop-1.3 {compiled +} { + 1 2 } 3 test mathop-1.4 {compiled +} { + 1 2 3 } 6 test mathop-1.5 {compiled +} { + 1.0 2 3 } 6.0 test mathop-1.6 {compiled +} { + 1 2 3.0 } 6.0 test mathop-1.7 {compiled +} { + 100000000000 2 3 } 100000000005 test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003 test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005 test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.11 {compiled +: errors} -returnCodes error -body { + x 0 } -result {can't use non-numeric string as operand of "+"} test mathop-1.12 {compiled +: errors} -returnCodes error -body { + nan 0 } -result {can't use non-numeric floating-point value as operand of "+"} test mathop-1.13 {compiled +: errors} -returnCodes error -body { + 0 x } -result {can't use non-numeric string as operand of "+"} test mathop-1.14 {compiled +: errors} -returnCodes error -body { + 0 nan } -result {can't use non-numeric floating-point value as operand of "+"} test mathop-1.15 {compiled +: errors} -returnCodes error -body { + 0o8 0 } -result {can't use invalid octal number as operand of "+"} test mathop-1.16 {compiled +: errors} -returnCodes error -body { + 0 0o8 } -result {can't use invalid octal number as operand of "+"} test mathop-1.17 {compiled +: errors} -returnCodes error -body { + 0 [error expectedError] } -result expectedError test mathop-1.18 {compiled +: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments list [catch { + [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} set op + test mathop-1.19 {interpreted +} { $op } 0 test mathop-1.20 {interpreted +} { $op 1 } 1 test mathop-1.21 {interpreted +} { $op 1 2 } 3 test mathop-1.22 {interpreted +} { $op 1 2 3 } 6 test mathop-1.23 {interpreted +} { $op 1.0 2 3 } 6.0 test mathop-1.24 {interpreted +} { $op 1 2 3.0 } 6.0 test mathop-1.25 {interpreted +} { $op 100000000000 2 3 } 100000000005 test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003 test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005 test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.29 {interpreted +: errors} -returnCodes error -body { $op x 0 } -result {can't use non-numeric string as operand of "+"} test mathop-1.30 {interpreted +: errors} -returnCodes error -body { $op nan 0 } -result {can't use non-numeric floating-point value as operand of "+"} test mathop-1.31 {interpreted +: errors} -returnCodes error -body { $op 0 x } -result {can't use non-numeric string as operand of "+"} test mathop-1.32 {interpreted +: errors} -returnCodes error -body { $op 0 nan } -result {can't use non-numeric floating-point value as operand of "+"} test mathop-1.33 {interpreted +: errors} -returnCodes error -body { $op 0o8 0 } -result {can't use invalid octal number as operand of "+"} test mathop-1.34 {interpreted +: errors} -returnCodes error -body { $op 0 0o8 } -result {can't use invalid octal number as operand of "+"} test mathop-1.35 {interpreted +: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-1.36 {interpreted +: argument processing order} -body { list [catch { $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} test mathop-2.1 {compiled *} { * } 1 test mathop-2.2 {compiled *} { * 2 } 2 test mathop-2.3 {compiled *} { * 2 3 } 6 test mathop-2.4 {compiled *} { * 2 3 4 } 24 test mathop-2.5 {compiled *} { * 1.0 2 3 } 6.0 test mathop-2.6 {compiled *} { * 1 2 3.0 } 6.0 test mathop-2.7 {compiled *} { * 100000000000 2 3 } 600000000000 test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000 test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000 test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.11 {compiled *: errors} -returnCodes error -body { * x 0 } -result {can't use non-numeric string as operand of "*"} test mathop-2.12 {compiled *: errors} -returnCodes error -body { * nan 0 } -result {can't use non-numeric floating-point value as operand of "*"} test mathop-2.13 {compiled *: errors} -returnCodes error -body { * 0 x } -result {can't use non-numeric string as operand of "*"} test mathop-2.14 {compiled *: errors} -returnCodes error -body { * 0 nan } -result {can't use non-numeric floating-point value as operand of "*"} test mathop-2.15 {compiled *: errors} -returnCodes error -body { * 0o8 0 } -result {can't use invalid octal number as operand of "*"} test mathop-2.16 {compiled *: errors} -returnCodes error -body { * 0 0o8 } -result {can't use invalid octal number as operand of "*"} test mathop-2.17 {compiled *: errors} -returnCodes error -body { * 0 [error expectedError] } -result expectedError test mathop-2.18 {compiled *: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments list [catch { * [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} set op * test mathop-2.19 {interpreted *} { $op } 1 test mathop-2.20 {interpreted *} { $op 2 } 2 test mathop-2.21 {interpreted *} { $op 2 3 } 6 test mathop-2.22 {interpreted *} { $op 2 3 4 } 24 test mathop-2.23 {interpreted *} { $op 1.0 2 3 } 6.0 test mathop-2.24 {interpreted *} { $op 1 2 3.0 } 6.0 test mathop-2.25 {interpreted *} { $op 100000000000 2 3 } 600000000000 test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000 test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000 test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.29 {interpreted *: errors} -returnCodes error -body { $op x 0 } -result {can't use non-numeric string as operand of "*"} test mathop-2.30 {interpreted *: errors} -returnCodes error -body { $op nan 0 } -result {can't use non-numeric floating-point value as operand of "*"} test mathop-2.31 {interpreted *: errors} -returnCodes error -body { $op 0 x } -result {can't use non-numeric string as operand of "*"} test mathop-2.32 {interpreted *: errors} -returnCodes error -body { $op 0 nan } -result {can't use non-numeric floating-point value as operand of "*"} test mathop-2.33 {interpreted *: errors} -returnCodes error -body { $op 0o8 0 } -result {can't use invalid octal number as operand of "*"} test mathop-2.34 {interpreted *: errors} -returnCodes error -body { $op 0 0o8 } -result {can't use invalid octal number as operand of "*"} test mathop-2.35 {interpreted *: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-2.36 {interpreted *: argument processing order} -body { list [catch { $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} test mathop-3.1 {compiled !} {! 0} 1 test mathop-3.2 {compiled !} {! 1} 0 test mathop-3.3 {compiled !} {! false} 1 test mathop-3.4 {compiled !} {! true} 0 test mathop-3.5 {compiled !} {! 0.0} 1 test mathop-3.6 {compiled !} {! 10000000000} 0 test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0 test mathop-3.8 {compiled !: errors} -body { ! foobar } -returnCodes error -result {can't use non-numeric string as operand of "!"} test mathop-3.9 {compiled !: errors} -body { ! 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.10 {compiled !: errors} -body { ! } -returnCodes error -result "wrong # args: should be \"! boolean\"" set op ! test mathop-3.11 {interpreted !} {$op 0} 1 test mathop-3.12 {interpreted !} {$op 1} 0 test mathop-3.13 {interpreted !} {$op false} 1 test mathop-3.14 {interpreted !} {$op true} 0 test mathop-3.15 {interpreted !} {$op 0.0} 1 test mathop-3.16 {interpreted !} {$op 10000000000} 0 test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0 test mathop-3.18 {interpreted !: errors} -body { $op foobar } -returnCodes error -result {can't use non-numeric string as operand of "!"} test mathop-3.19 {interpreted !: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.20 {interpreted !: errors} -body { $op } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.21 {compiled !: error} -returnCodes error -body { ! NaN } -result {can't use non-numeric floating-point value as operand of "!"} test mathop-3.22 {interpreted !: error} -returnCodes error -body { $op NaN } -result {can't use non-numeric floating-point value as operand of "!"} test mathop-4.1 {compiled ~} {~ 0} -1 test mathop-4.2 {compiled ~} {~ 1} -2 test mathop-4.3 {compiled ~} {~ 31} -32 test mathop-4.4 {compiled ~} {~ -127} 126 test mathop-4.5 {compiled ~} {~ -0} -1 test mathop-4.6 {compiled ~} {~ 10000000000} -10000000001 test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001 test mathop-4.8 {compiled ~: errors} -body { ~ foobar } -returnCodes error -result {can't use non-numeric string as operand of "~"} test mathop-4.9 {compiled ~: errors} -body { ~ 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.10 {compiled ~: errors} -body { ~ } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.11 {compiled ~: errors} -returnCodes error -body { ~ 0.0 } -result {can't use floating-point value as operand of "~"} test mathop-4.12 {compiled ~: errors} -returnCodes error -body { ~ NaN } -result {can't use non-numeric floating-point value as operand of "~"} set op ~ test mathop-4.13 {interpreted ~} {$op 0} -1 test mathop-4.14 {interpreted ~} {$op 1} -2 test mathop-4.15 {interpreted ~} {$op 31} -32 test mathop-4.16 {interpreted ~} {$op -127} 126 test mathop-4.17 {interpreted ~} {$op -0} -1 test mathop-4.18 {interpreted ~} {$op 10000000000} -10000000001 test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001 test mathop-4.20 {interpreted ~: errors} -body { $op foobar } -returnCodes error -result {can't use non-numeric string as operand of "~"} test mathop-4.21 {interpreted ~: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.22 {interpreted ~: errors} -body { $op } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.23 {interpreted ~: errors} -returnCodes error -body { $op 0.0 } -result {can't use floating-point value as operand of "~"} test mathop-4.24 {interpreted ~: errors} -returnCodes error -body { $op NaN } -result {can't use non-numeric floating-point value as operand of "~"} test mathop-5.1 {compiled eq} {eq {} a} 0 test mathop-5.2 {compiled eq} {eq a a} 1 test mathop-5.3 {compiled eq} {eq a {}} 0 test mathop-5.4 {compiled eq} {eq a b} 0 test mathop-5.5 {compiled eq} { eq } 1 test mathop-5.6 {compiled eq} {eq a} 1 test mathop-5.7 {compiled eq} {eq a a a} 1 test mathop-5.8 {compiled eq} {eq a a b} 0 test mathop-5.9 {compiled eq} -body { eq a b [error foobar] } -returnCodes error -result foobar test mathop-5.10 {compiled eq} {eq NaN Na NaN} 0 set op eq test mathop-5.11 {interpreted eq} {$op {} a} 0 test mathop-5.12 {interpreted eq} {$op a a} 1 test mathop-5.13 {interpreted eq} {$op a {}} 0 test mathop-5.14 {interpreted eq} {$op a b} 0 test mathop-5.15 {interpreted eq} { $op } 1 test mathop-5.16 {interpreted eq} {$op a} 1 test mathop-5.17 {interpreted eq} {$op a a a} 1 test mathop-5.18 {interpreted eq} {$op a a b} 0 test mathop-5.19 {interpreted eq} -body { $op a b [error foobar] } -returnCodes error -result foobar test mathop-5.20 {interpreted eq} {$op NaN Na NaN} 0 variable big1 12135435435354435435342423948763867876 variable big2 2746237174783836746262564892918327847 variable wide1 12345678912345 variable wide2 87321847232215 variable small1 87345 variable small2 16753 test mathop-6.1 {compiled &} { & } -1 test mathop-6.2 {compiled &} { & 1 } 1 test mathop-6.3 {compiled &} { & 1 2 } 0 test mathop-6.4 {compiled &} { & 3 7 6 } 2 test mathop-6.5 {compiled &} -returnCodes error -body { & 1.0 2 3 } -result {can't use floating-point value as operand of "&"} test mathop-6.6 {compiled &} -returnCodes error -body { & 1 2 3.0 } -result {can't use floating-point value as operand of "&"} test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2 test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85 test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2 test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85 test mathop-6.11 {compiled &: errors} -returnCodes error -body { & x 0 } -result {can't use non-numeric string as operand of "&"} test mathop-6.12 {compiled &: errors} -returnCodes error -body { & nan 0 } -result {can't use non-numeric floating-point value as operand of "&"} test mathop-6.13 {compiled &: errors} -returnCodes error -body { & 0 x } -result {can't use non-numeric string as operand of "&"} test mathop-6.14 {compiled &: errors} -returnCodes error -body { & 0 nan } -result {can't use non-numeric floating-point value as operand of "&"} test mathop-6.15 {compiled &: errors} -returnCodes error -body { & 0o8 0 } -result {can't use invalid octal number as operand of "&"} test mathop-6.16 {compiled &: errors} -returnCodes error -body { & 0 0o8 } -result {can't use invalid octal number as operand of "&"} test mathop-6.17 {compiled &: errors} -returnCodes error -body { & 0 [error expectedError] } -result expectedError test mathop-6.18 {compiled &: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments list [catch { & [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} set op & test mathop-6.19 {interpreted &} { $op } -1 test mathop-6.20 {interpreted &} { $op 1 } 1 test mathop-6.21 {interpreted &} { $op 1 2 } 0 test mathop-6.22 {interpreted &} { $op 3 7 6 } 2 test mathop-6.23 {interpreted &} -returnCodes error -body { $op 1.0 2 3 } -result {can't use floating-point value as operand of "&"} test mathop-6.24 {interpreted &} -returnCodes error -body { $op 1 2 3.0 } -result {can't use floating-point value as operand of "&"} test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2 test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85 test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2 test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85 test mathop-6.29 {interpreted &: errors} -returnCodes error -body { $op x 0 } -result {can't use non-numeric string as operand of "&"} test mathop-6.30 {interpreted &: errors} -returnCodes error -body { $op nan 0 } -result {can't use non-numeric floating-point value as operand of "&"} test mathop-6.31 {interpreted &: errors} -returnCodes error -body { $op 0 x } -result {can't use non-numeric string as operand of "&"} test mathop-6.32 {interpreted &: errors} -returnCodes error -body { $op 0 nan } -result {can't use non-numeric floating-point value as operand of "&"} test mathop-6.33 {interpreted &: errors} -returnCodes error -body { $op 0o8 0 } -result {can't use invalid octal number as operand of "&"} test mathop-6.34 {interpreted &: errors} -returnCodes error -body { $op 0 0o8 } -result {can't use invalid octal number as operand of "&"} test mathop-6.35 {interpreted &: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-6.36 {interpreted &: argument processing order} -body { list [catch { $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} test mathop-6.37 {& and bignums} { list [& $big1 $big2] [$op $big1 $big2] } {712439449294653815890598856501796 712439449294653815890598856501796} test mathop-6.38 {& and bignums} { list [& $big1 $wide2] [$op $big1 $wide2] } {78521450111684 78521450111684} test mathop-6.39 {& and bignums} { list [& $big1 $small2] [$op $big1 $small2] } {96 96} test mathop-6.40 {& and bignums} { list [& $wide1 $big2] [$op $wide1 $big2] } {2371422390785 2371422390785} test mathop-6.41 {& and bignums} { list [& $wide1 $wide2] [$op $wide1 $wide2] } {12275881497169 12275881497169} test mathop-6.42 {& and bignums} { list [& $wide1 $small2] [$op $wide1 $small2] } {16721 16721} test mathop-6.43 {& and bignums} { list [& $small1 $big2] [$op $small1 $big2] } {33 33} test mathop-6.44 {& and bignums} { list [& $small1 $wide2] [$op $small1 $wide2] } {87057 87057} test mathop-6.45 {& and bignums} { list [& $small1 $small2] [$op $small1 $small2] } {16689 16689} test mathop-7.1 {compiled |} { | } 0 test mathop-7.2 {compiled |} { | 1 } 1 test mathop-7.3 {compiled |} { | 1 2 } 3 test mathop-7.4 {compiled |} { | 3 7 6 } 7 test mathop-7.5 {compiled |} -returnCodes error -body { | 1.0 2 3 } -result {can't use floating-point value as operand of "|"} test mathop-7.6 {compiled |} -returnCodes error -body { | 1 2 3.0 } -result {can't use floating-point value as operand of "|"} test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110 test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503 test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110 test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.11 {compiled |: errors} -returnCodes error -body { | x 0 } -result {can't use non-numeric string as operand of "|"} test mathop-7.12 {compiled |: errors} -returnCodes error -body { | nan 0 } -result {can't use non-numeric floating-point value as operand of "|"} test mathop-7.13 {compiled |: errors} -returnCodes error -body { | 0 x } -result {can't use non-numeric string as operand of "|"} test mathop-7.14 {compiled |: errors} -returnCodes error -body { | 0 nan } -result {can't use non-numeric floating-point value as operand of "|"} test mathop-7.15 {compiled |: errors} -returnCodes error -body { | 0o8 0 } -result {can't use invalid octal number as operand of "|"} test mathop-7.16 {compiled |: errors} -returnCodes error -body { | 0 0o8 } -result {can't use invalid octal number as operand of "|"} test mathop-7.17 {compiled |: errors} -returnCodes error -body { | 0 [error expectedError] } -result expectedError test mathop-7.18 {compiled |: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments list [catch { | [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} set op | test mathop-7.19 {interpreted |} { $op } 0 test mathop-7.20 {interpreted |} { $op 1 } 1 test mathop-7.21 {interpreted |} { $op 1 2 } 3 test mathop-7.22 {interpreted |} { $op 3 7 6 } 7 test mathop-7.23 {interpreted |} -returnCodes error -body { $op 1.0 2 3 } -result {can't use floating-point value as operand of "|"} test mathop-7.24 {interpreted |} -returnCodes error -body { $op 1 2 3.0 } -result {can't use floating-point value as operand of "|"} test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110 test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503 test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110 test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.29 {interpreted |: errors} -returnCodes error -body { $op x 0 } -result {can't use non-numeric string as operand of "|"} test mathop-7.30 {interpreted |: errors} -returnCodes error -body { $op nan 0 } -result {can't use non-numeric floating-point value as operand of "|"} test mathop-7.31 {interpreted |: errors} -returnCodes error -body { $op 0 x } -result {can't use non-numeric string as operand of "|"} test mathop-7.32 {interpreted |: errors} -returnCodes error -body { $op 0 nan } -result {can't use non-numeric floating-point value as operand of "|"} test mathop-7.33 {interpreted |: errors} -returnCodes error -body { $op 0o8 0 } -result {can't use invalid octal number as operand of "|"} test mathop-7.34 {interpreted |: errors} -returnCodes error -body { $op 0 0o8 } -result {can't use invalid octal number as operand of "|"} test mathop-7.35 {interpreted |: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-7.36 {interpreted |: argument processing order} -body { list [catch { $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} test mathop-7.37 {| and bignums} { list [| $big1 $big2] [$op $big1 $big2] } {14880960170688977527789098242825693927 14880960170688977527789098242825693927} test mathop-7.38 {| and bignums} { list [| $big1 $wide2] [$op $big1 $wide2] } {12135435435354435435342432749160988407 12135435435354435435342432749160988407} test mathop-7.39 {| and bignums} { list [| $big1 $small2] [$op $big1 $small2] } {12135435435354435435342423948763884533 12135435435354435435342423948763884533} test mathop-7.40 {| and bignums} { list [| $wide1 $big2] [$op $wide1 $big2] } {2746237174783836746262574867174849407 2746237174783836746262574867174849407} test mathop-7.41 {| and bignums} { list [| $wide1 $wide2] [$op $wide1 $wide2] } {87391644647391 87391644647391} test mathop-7.42 {| and bignums} { list [| $wide1 $small2] [$op $wide1 $small2] } {12345678912377 12345678912377} test mathop-7.43 {| and bignums} { list [| $small1 $big2] [$op $small1 $big2] } {2746237174783836746262564892918415159 2746237174783836746262564892918415159} test mathop-7.44 {| and bignums} { list [| $small1 $wide2] [$op $small1 $wide2] } {87321847232503 87321847232503} test mathop-7.45 {| and bignums} { list [| $small1 $small2] [$op $small1 $small2] } {87409 87409} test mathop-8.1 {compiled ^} { ^ } 0 test mathop-8.2 {compiled ^} { ^ 1 } 1 test mathop-8.3 {compiled ^} { ^ 1 2 } 3 test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2 test mathop-8.5 {compiled ^} -returnCodes error -body { ^ 1.0 2 3 } -result {can't use floating-point value as operand of "^"} test mathop-8.6 {compiled ^} -returnCodes error -body { ^ 1 2 3.0 } -result {can't use floating-point value as operand of "^"} test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110 test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333 test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.11 {compiled ^: errors} -returnCodes error -body { ^ x 0 } -result {can't use non-numeric string as operand of "^"} test mathop-8.12 {compiled ^: errors} -returnCodes error -body { ^ nan 0 } -result {can't use non-numeric floating-point value as operand of "^"} test mathop-8.13 {compiled ^: errors} -returnCodes error -body { ^ 0 x } -result {can't use non-numeric string as operand of "^"} test mathop-8.14 {compiled ^: errors} -returnCodes error -body { ^ 0 nan } -result {can't use non-numeric floating-point value as operand of "^"} test mathop-8.15 {compiled ^: errors} -returnCodes error -body { ^ 0o8 0 } -result {can't use invalid octal number as operand of "^"} test mathop-8.16 {compiled ^: errors} -returnCodes error -body { ^ 0 0o8 } -result {can't use invalid octal number as operand of "^"} test mathop-8.17 {compiled ^: errors} -returnCodes error -body { ^ 0 [error expectedError] } -result expectedError test mathop-8.18 {compiled ^: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments list [catch { ^ [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} set op ^ test mathop-8.19 {interpreted ^} { $op } 0 test mathop-8.20 {interpreted ^} { $op 1 } 1 test mathop-8.21 {interpreted ^} { $op 1 2 } 3 test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2 test mathop-8.23 {interpreted ^} -returnCodes error -body { $op 1.0 2 3 } -result {can't use floating-point value as operand of "^"} test mathop-8.24 {interpreted ^} -returnCodes error -body { $op 1 2 3.0 } -result {can't use floating-point value as operand of "^"} test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110 test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333 test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.29 {interpreted ^: errors} -returnCodes error -body { $op x 0 } -result {can't use non-numeric string as operand of "^"} test mathop-8.30 {interpreted ^: errors} -returnCodes error -body { $op nan 0 } -result {can't use non-numeric floating-point value as operand of "^"} test mathop-8.31 {interpreted ^: errors} -returnCodes error -body { $op 0 x } -result {can't use non-numeric string as operand of "^"} test mathop-8.32 {interpreted ^: errors} -returnCodes error -body { $op 0 nan } -result {can't use non-numeric floating-point value as operand of "^"} test mathop-8.33 {interpreted ^: errors} -returnCodes error -body { $op 0o8 0 } -result {can't use invalid octal number as operand of "^"} test mathop-8.34 {interpreted ^: errors} -returnCodes error -body { $op 0 0o8 } -result {can't use invalid octal number as operand of "^"} test mathop-8.35 {interpreted ^: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-8.36 {interpreted ^: argument processing order} -body { list [catch { $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} test mathop-8.37 {^ and bignums} { list [^ $big1 $big2] [$op $big1 $big2] } {14880247731239682873973207643969192131 14880247731239682873973207643969192131} test mathop-8.38 {^ and bignums} { list [^ $big1 $wide2] [$op $big1 $wide2] } {12135435435354435435342354227710876723 12135435435354435435342354227710876723} test mathop-8.39 {^ and bignums} { list [^ $big1 $small2] [$op $big1 $small2] } {12135435435354435435342423948763884437 12135435435354435435342423948763884437} test mathop-8.40 {^ and bignums} { list [^ $wide1 $big2] [$op $wide1 $big2] } {2746237174783836746262572495752458622 2746237174783836746262572495752458622} test mathop-8.41 {^ and bignums} { list [^ $wide1 $wide2] [$op $wide1 $wide2] } {75115763150222 75115763150222} test mathop-8.42 {^ and bignums} { list [^ $wide1 $small2] [$op $wide1 $small2] } {12345678895656 12345678895656} test mathop-8.43 {^ and bignums} { list [^ $small1 $big2] [$op $small1 $big2] } {2746237174783836746262564892918415126 2746237174783836746262564892918415126} test mathop-8.44 {^ and bignums} { list [^ $small1 $wide2] [$op $small1 $wide2] } {87321847145446 87321847145446} test mathop-8.45 {^ and bignums} { list [^ $small1 $small2] [$op $small1 $small2] } {70720 70720} # TODO: % ** << >> - / == != < <= > >= ne in ni test mathop-13.100 {compiled -: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments list [catch { - [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} test mathop-14.100 {compiled /: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments list [catch { / [set x 0] [incr x] NaN [incr x] [error expected] [incr x] } msg] $msg $x } -result {1 expected 2} } test mathop-20.1 { zero args, return unit } { set res {} foreach op {+ * & ^ | ** < <= > >= == eq} { lappend res [TestOp $op] } set res } {0 1 -1 0 0 1 1 1 1 1 1 1} test mathop-20.2 { zero args, not allowed } { set exp {} foreach op {~ ! << >> % != ne in ni - /} { set res [TestOp $op] if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} { lappend exp 0 } else { lappend exp $res } } set exp } {0 0 0 0 0 0 0 0 0 0 0} test mathop-20.3 { one arg } { set res {} foreach val {7 8.3} { foreach op {+ ** - * / < <= > >= == eq !} { lappend res [TestOp $op $val] } } set res } [list 7 7 -7 7 [expr {1.0/7.0}] 1 1 1 1 1 1 0 \ 8.3 8.3 -8.3 8.3 [expr {1.0/8.3}] 1 1 1 1 1 1 0] test mathop-20.4 { one arg, integer only ops } { set res {} foreach val {23} { foreach op {& | ^ ~} { lappend res [TestOp $op $val] } } set res } [list 23 23 23 -24] test mathop-20.5 { one arg, not allowed } { set exp {} foreach op {% != ne in ni << >>} { set res [TestOp $op 1] if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} { lappend exp 0 } else { lappend exp $res } } set exp } {0 0 0 0 0 0 0} test mathop-20.6 { one arg, error } { set res {} set exp {} foreach vals {x {1 x} {1 1 x} {1 x 1}} { # skipping - for now, knownbug... foreach op {+ * / & | ^ **} { lappend res [TestOp $op {*}$vals] lappend exp "can't use non-numeric string as operand of \"$op\"\ ARITH DOMAIN {non-numeric string}" } } foreach op {+ * / & | ^ **} { lappend res [TestOp $op NaN 1] lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\ ARITH DOMAIN {non-numeric floating-point value}" } expr {$res eq $exp ? 0 : $res} } 0 test mathop-20.7 { multi arg } { set res {} foreach vals {{1 2} {3 4 5} {4 3 2 1}} { foreach op {+ - * /} { lappend res [TestOp $op {*}$vals] } } set res } [list 3 -1 2 0 12 -6 60 0 10 -2 24 0] test mathop-20.8 { multi arg, double } { set res {} foreach vals {{1.0 2} {3.0 4 5} {4 3.0 2 1} {1.0 -1.0 1e-18} {1.0 1.0 1e-18}} { foreach op {+ - * /} { lappend res [TestOp $op {*}$vals] } } set res } [list 3.0 -1.0 2.0 0.5 12.0 -6.0 60.0 0.15 10.0 -2.0 24.0 [expr {2.0/3}] 1e-18 2.0 -1e-18 [expr {-1.0/1e-18}] 2.0 -1e-18 1e-18 [expr {1.0/1e-18}]] test mathop-21.1 { unary ops, bitnot } { set res {} lappend res [TestOp ~ 7] lappend res [TestOp ~ -5] lappend res [TestOp ~ 354657483923456] lappend res [TestOp ~ 123456789123456789123456789] set res } [list -8 4 -354657483923457 -123456789123456789123456790] test mathop-21.2 { unary ops, logical not } { set res {} lappend res [TestOp ! 0] lappend res [TestOp ! 1] lappend res [TestOp ! true] lappend res [TestOp ! false] lappend res [TestOp ! 37] lappend res [TestOp ! 8.5] set res } [list 1 0 0 1 0 0] test mathop-21.3 { unary ops, negation } { set res {} lappend res [TestOp - 7.2] lappend res [TestOp - -5] lappend res [TestOp - -2147483648] ;# -2**31 lappend res [TestOp - -9223372036854775808] ;# -2**63 lappend res [TestOp - 354657483923456] ;# wide lappend res [TestOp - 123456789123456789123456789] ;# big set res } [list -7.2 5 2147483648 9223372036854775808 -354657483923456 \ -123456789123456789123456789] test mathop-21.4 { unary ops, inversion } { set res {} lappend res [TestOp / 1] lappend res [TestOp / 5] lappend res [TestOp / 5.6] lappend res [TestOp / -8] lappend res [TestOp / 354657483923456] ;# wide lappend res [TestOp / 123456789123456789123456789] ;# big set res } [list 1.0 0.2 0.17857142857142858 -0.125 \ 2.8196218755553604e-15 8.10000006561e-27] test mathop-21.5 { unary ops, bad values } { set res {} set exp {} lappend res [TestOp / x] lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp - x] lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ x] lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ! x] lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ 5.0] lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-21.6 { unary ops, too many } { set exp {} foreach op {~ !} { set res [TestOp $op 7 8] if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} { lappend exp 0 } else { lappend exp $res } } set exp } {0 0} test mathop-22.1 { bitwise ops } { set res {} foreach vals {5 {1 6} {1 2 3} {1 2 3 4}} { foreach op {& | ^} { lappend res [TestOp $op {*}$vals] } } set res } [list 5 5 5 0 7 7 0 3 0 0 7 4] test mathop-22.2 { bitwise ops on bignums } { set dig 50 set a 0x[string repeat 5 $dig] set b 0x[string repeat 7 $dig] set c 0x[string repeat 9 $dig] set bn [expr {~$b}] set cn [expr {~$c}] set res {} foreach vals [list [list $a $b] [list $a $c] [list $b $c] \ [list $a $bn] [list $bn $c] [list $bn $cn]] { foreach op {& | ^} { lappend res [TestOp $op {*}$vals] } } set exp {} foreach d {5 7 2 1 D C 1 F E 0 -D -D 8 -9 -1 -0 -E E} { if {[string match "-*" $d]} { set d [format %X [expr {15-"0x[string range $d 1 end]"}]] set val [expr {-"0x[string repeat $d $dig]"-1}] } else { set val [expr {"0x[string repeat $d $dig]"}] } lappend exp $val } expr {$exp eq $res ? 1 : "($res != $exp"} } 1 test mathop-22.3 { bitwise ops } { set big1 12135435435354435435342423948763867876 set big2 2746237174783836746262564892918327847 set wide1 12345678912345 set wide2 87321847232215 set small1 87345 set small2 16753 set res {} foreach op {& | ^} { lappend res [TestOp $op $big1 $big2] lappend res [TestOp $op $big1 $wide2] lappend res [TestOp $op $big1 $small2] lappend res [TestOp $op $wide1 $big2] lappend res [TestOp $op $wide1 $wide2] lappend res [TestOp $op $wide1 $small2] lappend res [TestOp $op $small1 $big2] lappend res [TestOp $op $small1 $wide2] lappend res [TestOp $op $small1 $small2] } set res } [list \ 712439449294653815890598856501796 \ 78521450111684 \ 96 \ 2371422390785 \ 12275881497169 \ 16721 \ 33 \ 87057 \ 16689 \ 14880960170688977527789098242825693927 \ 12135435435354435435342432749160988407 \ 12135435435354435435342423948763884533 \ 2746237174783836746262574867174849407 \ 87391644647391 \ 12345678912377 \ 2746237174783836746262564892918415159 \ 87321847232503 \ 87409 \ 14880247731239682873973207643969192131 \ 12135435435354435435342354227710876723 \ 12135435435354435435342423948763884437 \ 2746237174783836746262572495752458622 \ 75115763150222 \ 12345678895656 \ 2746237174783836746262564892918415126 \ 87321847145446 \ 70720 \ ] test mathop-22.4 { unary ops, bad values } { set res {} set exp {} foreach op {& | ^} { lappend res [TestOp $op x 5] lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 5 x] lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } expr {$res eq $exp ? 0 : $res} } 0 test mathop-23.1 { comparison ops, numerical } { set res {} set todo {5 {1 6} {1 2 2 3} {4 3 2 1} {5.0 5.0} {6 3 3 1} {5.0 5}} lappend todo [list 2342476234762482734623842342 234827463876473 3434] lappend todo [list 2653 453735910264536 453735910264537 2384762472634982746239847637] lappend todo [list 2653 2384762472634982746239847637] lappend todo [list 2653 -2384762472634982746239847637] lappend todo [list 3789253678212653 -2384762472634982746239847637] lappend todo [list 5.0 6 7.0 8 1e13 1945628567352654 1.1e20 \ 6734253647589123456784564378 2.3e50] set a 7 lappend todo [list $a $a] ;# Same object foreach vals $todo { foreach op {< <= > >= == eq} { lappend res [TestOp $op {*}$vals] } } set res } [list 1 1 1 1 1 1 \ 1 1 0 0 0 0 \ 0 1 0 0 0 0 \ 0 0 1 1 0 0 \ 0 1 0 1 1 1 \ 0 0 0 1 0 0 \ 0 1 0 1 1 0 \ 0 0 1 1 0 0 \ 1 1 0 0 0 0 \ 1 1 0 0 0 0 \ 0 0 1 1 0 0 \ 0 0 1 1 0 0 \ 1 1 0 0 0 0 \ 0 1 0 1 1 1 \ ] test mathop-23.2 { comparison ops, string } { set res {} set todo {a {a b} {5 b b c} {d c b a} {xy xy} {gy ef ef ab}} set a x lappend todo [list $a $a] foreach vals $todo { foreach op {< <= > >= == eq} { lappend res [TestOp $op {*}$vals] } } set res } [list 1 1 1 1 1 1 \ 1 1 0 0 0 0 \ 0 1 0 0 0 0 \ 0 0 1 1 0 0 \ 0 1 0 1 1 1 \ 0 0 0 1 0 0 \ 0 1 0 1 1 1 \ ] test mathop-23.3 { comparison ops, nonequal} { set res {} foreach vals {{a b} {17.0 0x11} {foo foo} {10 10}} { foreach op {!= ne} { lappend res [TestOp $op {*}$vals] } } set res } [list 1 1 0 1 0 0 0 0 ] test mathop-24.1 { binary ops } { set res {} foreach vals {{3 5} {17 7} {199 5} {293234675763434238476239486 17} \ {5 1} {0 7}} { foreach op {% << >> in ni} { lappend res [TestOp $op {*}$vals] } } set res } [list 3 96 0 0 1 3 2176 0 0 1 4 6368 6 0 1 \ 14 38434855421664852505557661908992 2237203031642412097749 0 1 \ 0 10 2 0 1 0 0 0 0 1] test mathop-24.2 { binary ops, modulo } { # Test different combinations to get all code paths set res {} set bigbig 14372423674564535234543545248972634923869 set big 12135435435354435435342423948763867876 set wide 12345678912345 set negwide -12345678912345 set small 5 set neg -5 lappend res [TestOp % $bigbig $big] lappend res [TestOp % $wide $big] lappend res [TestOp % $negwide $big] lappend res [TestOp % $small $big] lappend res [TestOp % $neg $big] lappend res [TestOp % $small $wide] lappend res [TestOp % $neg $wide] lappend res [TestOp % $wide $small] set res } [list 4068119104883679098115293636215358685 \ 12345678912345 \ 12135435435354435435342411603084955531 \ 5 \ 12135435435354435435342423948763867871 \ 5 \ 12345678912340 \ 0 \ ] test mathop-24.3 { binary ops, bad values } { set res {} set exp {} foreach op {% << >>} { lappend res [TestOp $op x 1] lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 1 x] lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } foreach op {% << >>} { lappend res [TestOp $op 5.0 1] lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" lappend res [TestOp $op 1 5.0] lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" } foreach op {in ni} { lappend res [TestOp $op 5 "a b \{ c"] lappend exp "unmatched open brace in list TCL VALUE LIST BRACE" } lappend res [TestOp % 5 0] lappend exp "divide by zero ARITH DIVZERO {divide by zero}" lappend res [TestOp % 9838923468297346238478737647637375 0] lappend exp "divide by zero ARITH DIVZERO {divide by zero}" lappend res [TestOp / 5 0] lappend exp "divide by zero ARITH DIVZERO {divide by zero}" lappend res [TestOp / 9838923468297346238478737647637375 0] lappend exp "divide by zero ARITH DIVZERO {divide by zero}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-24.4 { binary ops, negative shift } { set res {} set big -12135435435354435435342423948763867876 set wide -12345678912345 set small -1 lappend res [TestOp << 10 $big] lappend res [TestOp << 10 $wide] lappend res [TestOp << 10 $small] lappend res [TestOp >> 10 $big] lappend res [TestOp >> 10 $wide] lappend res [TestOp >> 10 $small] set exp [lrepeat 6 "negative shift argument NONE"] expr {$res eq $exp ? 0 : $res} } 0 test mathop-24.5 { binary ops, large shift } { set res {} set exp {} set big 12135435435354435435342423948763867876 set wide 12345678912345 set small 1 lappend res [TestOp << 1 2147483648] lappend exp "integer value too large to represent NONE" lappend res [TestOp << 1 4294967296] lappend exp "integer value too large to represent NONE" lappend res [TestOp << $small $wide] lappend exp "integer value too large to represent NONE" lappend res [TestOp << $small $big] lappend exp "integer value too large to represent NONE" lappend res [TestOp >> $big $wide] lappend exp 0 lappend res [TestOp >> $big $big] lappend exp 0 lappend res [TestOp >> $small 70] lappend exp 0 lappend res [TestOp >> $wide 70] lappend exp 0 lappend res [TestOp >> -$big $wide] lappend exp -1 lappend res [TestOp >> -$wide $wide] lappend exp -1 lappend res [TestOp >> -$small $wide] lappend exp -1 lappend res [TestOp >> -$small 70] lappend exp -1 lappend res [TestOp >> -$wide 70] lappend exp -1 expr {$res eq $exp ? 0 : $res} } 0 test mathop-24.6 { binary ops, shift } { # Test different combinations to get all code paths set res {} set bigbig 14372423674564535234543545248972634923869 set big 12135435435354435435342423948763867876 set wide 12345678912345 set negwide -12345678912345 set small 5 set neg -5 lappend res [TestOp << $wide $small] lappend res [TestOp >> $wide $small] set res } [list 395061725195040 \ 385802466010 \ ] test mathop-24.7 { binary ops, list search } { set res {} foreach op {in ni} { lappend res [TestOp $op 5 {7 5 8}] lappend res [TestOp $op hej {foo bar hej}] lappend res [TestOp $op 5 {7 0x5 8}] } set res } [list 1 1 0 0 0 1] test mathop-24.8 { binary ops, too many } { set exp {} foreach op {<< >> % != ne in ni ~ !} { set res [TestOp $op 7 8 9] if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} { lappend exp 0 } else { lappend exp $res } } set exp } {0 0 0 0 0 0 0 0 0} test mathop-25.1 { exp operator } {TestOp ** } 1 test mathop-25.2 { exp operator } {TestOp ** 0 } 0 test mathop-25.3 { exp operator } {TestOp ** 0 5} 0 test mathop-25.4 { exp operator } {TestOp ** 7.5 } 7.5 test mathop-25.5 { exp operator } {TestOp ** 1 5} 1 test mathop-25.6 { exp operator } {TestOp ** 5 1} 5 test mathop-25.7 { exp operator } {TestOp ** 4 3 2 1} 262144 test mathop-25.8 { exp operator } {TestOp ** 5.5 4} 915.0625 test mathop-25.8a { exp operator } {TestOp ** 4.0 -1} 0.25 test mathop-25.8b { exp operator } {TestOp ** 2.0 -2} 0.25 test mathop-25.9 { exp operator } {TestOp ** 16 3.5} 16384.0 test mathop-25.10 { exp operator } {TestOp ** 3.5 0} 1.0 test mathop-25.11 { exp operator } {TestOp ** 378 0} 1 test mathop-25.12 { exp operator } {TestOp ** 7.8 1} 7.8 test mathop-25.13 { exp operator } {TestOp ** 748 1} 748 test mathop-25.14 { exp operator } {TestOp ** 1.6 -1} 0.625 test mathop-25.15 { exp operator } {TestOp ** 683 -1} 0 test mathop-25.16 { exp operator } {TestOp ** 1 -1} 1 test mathop-25.17 { exp operator } {TestOp ** -1 -1} -1 test mathop-25.18 { exp operator } {TestOp ** -1 -2} 1 test mathop-25.19 { exp operator } {TestOp ** -1 3} -1 test mathop-25.20 { exp operator } {TestOp ** -1 4} 1 test mathop-25.21 { exp operator } {TestOp ** 2 63} 9223372036854775808 test mathop-25.22 { exp operator } {TestOp ** 2 256} 115792089237316195423570985008687907853269984665640564039457584007913129639936 set big 83756485763458746358734658473567847567473 test mathop-25.23 { exp operator } {TestOp ** $big 2} 7015148907444467657897585474493757781161998914521537835809623408157343003287605729 test mathop-25.24 { exp operator } {TestOp ** $big 0} 1 test mathop-25.25 { exp operator } {TestOp ** $big 1} $big test mathop-25.26 { exp operator } {TestOp ** $big -1} 0 test mathop-25.27 { exp operator } {TestOp ** $big -2} 0 test mathop-25.28 { exp operator } {TestOp ** $big -$big} 0 test mathop-25.29 { exp operator } {expr {[set res [TestOp ** $big -1.0]] > 0 && $res < 1.2e-41}} 1 test mathop-25.30 { exp operator } {expr {[set res [TestOp ** $big -1e-18]] > 0 && $res < 1}} 1 test mathop-25.31 { exp operator } {expr {[set res [TestOp ** -$big -1.0]] > -1 && $res < 0}} 1 test mathop-25.32 { exp operator } {expr {[set res [TestOp ** -$big -2.0]] > 0 && $res < 1}} 1 test mathop-25.33 { exp operator } {expr {[set res [TestOp ** -$big -3.0]] > -1 && $res < 0}} 1 test mathop-25.34 { exp operator } {TestOp ** $big -1e-30} 1.0 test mathop-25.35 { exp operator } {TestOp ** $big -1e+30} 0.0 test mathop-25.36 { exp operator } {TestOp ** 0 $big} 0 test mathop-25.37 { exp operator } {TestOp ** 1 $big} 1 test mathop-25.38 { exp operator } {TestOp ** -1 $big} -1 test mathop-25.39 { exp operator } {TestOp ** -1 [expr {$big+1}]} 1 test mathop-25.40 { exp operator (small exponent power helper and its boundaries) } { set pwr 0 set res 1 while {[incr pwr] <= 17 && [set i [TestOp ** 15 $pwr]] == [set res [expr {$res * 15}]]} {} list [incr pwr -1] $res } {17 98526125335693359375} test mathop-25.41 { exp operator errors } { set res {} set exp {} set huge [string repeat 145782 1000] set big 12135435435354435435342423948763867876 set wide 12345678912345 set small 2 lappend res [TestOp ** 0 -5] lappend exp "exponentiation of zero by negative power ARITH DOMAIN {exponentiation of zero by negative power}" lappend res [TestOp ** 0.0 -5.0] lappend exp "exponentiation of zero by negative power ARITH DOMAIN {exponentiation of zero by negative power}" lappend res [TestOp ** $small $wide] lappend exp "exponent too large NONE" lappend res [TestOp ** 2 $big] lappend exp "exponent too large NONE" lappend res [TestOp ** $huge 2.1] lappend exp "Inf" lappend res [TestOp ** 2 foo] lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ** foo 2] lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-26.1 { misc ops, size combinations } { set big1 12135435435354435435342423948763867876 set big2 2746237174783836746262564892918327847 set wide1 87321847232215 set wide2 12345678912345 set small1 87345 set small2 16753 set res {} foreach op {+ * - /} { lappend res [TestOp $op $big1 $big2] lappend res [TestOp $op $big1 $wide2] lappend res [TestOp $op $big1 $small2] lappend res [TestOp $op $wide1 $big2] lappend res [TestOp $op $wide1 $wide2] lappend res [TestOp $op $wide1 $small2] lappend res [TestOp $op $small1 $big2] lappend res [TestOp $op $small1 $wide2] lappend res [TestOp $op $small1 $small2] } set res } [list \ 14881672610138272181604988841682195723 \ 12135435435354435435342436294442780221 \ 12135435435354435435342423948763884629 \ 2746237174783836746262652214765560062 \ 99667526144560 \ 87321847248968 \ 2746237174783836746262564892918415192 \ 12345678999690 \ 104098 \ 33326783924759424684447891401270222910405366244661685890993770489959542972 \ 149820189346379518024969783068410988366610965329220 \ 203304949848492856848291628413641078526628 \ 239806503039903915972546163440347114360602909991105 \ 1078047487961768329845194175 \ 1462902906681297895 \ 239870086031494220602303730571951345796215 \ 1078333324598774025 \ 1463290785 \ 9389198260570598689079859055845540029 \ 12135435435354435435342411603084955531 \ 12135435435354435435342423948763851123 \ -2746237174783836746262477571071095632 \ 74976168319870 \ 87321847215462 \ -2746237174783836746262564892918240502 \ -12345678825000 \ 70592 \ 4 \ 982970278225822587257201 \ 724373869477373332259441529801460 \ 0 \ 7 \ 5212311062 \ 0 \ 0 \ 5 \ ] test mathop-26.2 { misc ops, corner cases } { set res {} lappend res [TestOp - 0 -2147483648] ;# -2**31 lappend res [TestOp - 0 -9223372036854775808] ;# -2**63 lappend res [TestOp / -9223372036854775808 -1] lappend res [TestOp * 2147483648 2] lappend res [TestOp * 9223372036854775808 2] set res } [list 2147483648 9223372036854775808 9223372036854775808 4294967296 18446744073709551616] if 0 { # Compare ops to expr bytecodes namespace import ::tcl::mathop::* proc _X {a b c} { set x [+ $a [- $b $c]] set y [expr {$a + ($b - $c)}] set z [< $a $b $c] } set ::tcl_traceCompile 2 _X 3 4 5 set ::tcl_traceCompile 0 } # cleanup namespace delete ::testmathop namespace delete ::testmathop2 ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/misc.test0000644000175000017500000000412214554262142014637 0ustar sergeisergei# Commands covered: various # # This file contains a collection of miscellaneous Tcl tests that # don't fit naturally in any of the other test files. Many of these # tests are pathological cases that caused bugs in earlier Tcl # releases. # # Copyright (c) 1992-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testhashsystemhash [llength [info commands testhashsystemhash]] test misc-1.1 {error in variable ref. in command in array reference} { proc tstProc {} { global a set tst $a([winfo name $zz]) # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment } set msg {} list [catch tstProc msg] $msg } {1 {can't read "zz": no such variable}} test misc-1.2 {error in variable ref. in command in array reference} { proc tstProc {} " global a set tst \$a(\[winfo name \$\{zz) # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment # this is a bogus comment " set msg {} join [list [catch tstProc msg] $msg $::errorInfo] \n } [subst -novariables -nocommands {1 missing close-brace for variable name missing close-brace for variable name while executing "set tst $a([winfo name $\{" (procedure "tstProc" line 4) invoked from within "tstProc"}] for {set i 1} {$i<300} {incr i} { test misc-2.$i {hash table with sys-alloc} testhashsystemhash \ "testhashsystemhash $i" OK } # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/msgcat.test0000644000175000017500000007041614554262142015173 0ustar sergeisergei# This file contains a collection of tests for the msgcat package. # Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998 Mark Harrison. # Copyright (c) 1998-1999 by Scriptics Corporation. # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } if {[catch {package require msgcat 1.6}]} { puts stderr "Skipping tests in [info script]. No msgcat 1.6 found to test." return } namespace eval ::msgcat::test { namespace import ::msgcat::* namespace import ::tcltest::test namespace import ::tcltest::cleanupTests namespace import ::tcltest::temporaryDirectory namespace import ::tcltest::make* namespace import ::tcltest::remove* # Tests msgcat-0.*: locale initialization # Calculate set of all permutations of a list # PowerSet {1 2 3} -> {1 2 3} {2 3} {1 3} 3 {1 2} 2 1 {} proc PowerSet {l} { if {[llength $l] == 0} {return [list [list]]} set element [lindex $l 0] set rest [lrange $l 1 end] set result [list] foreach x [PowerSet $rest] { lappend result [linsert $x 0 $element] lappend result $x } return $result } variable envVars {LC_ALL LC_MESSAGES LANG} variable count 0 variable body variable result variable setVars foreach setVars [PowerSet $envVars] { set result [string tolower [lindex $setVars 0]] if {[string length $result] == 0} { if {[info exists ::tcl::mac::locale]} { set result [string tolower \ [msgcat::ConvertLocale $::tcl::mac::locale]] } else { if {([info sharedlibextension] eq ".dll") && ![catch {package require registry}]} { # Windows and Cygwin have other ways to determine the # locale when the environment variables are missing # and the registry package is present continue } set result c } } test msgcat-0.$count [list \ locale initialization from environment variables $setVars \ ] -setup { variable var foreach var $envVars { catch {variable $var $::env($var)} unset -nocomplain ::env($var) } foreach var $setVars { set ::env($var) $var } interp create [namespace current]::i i eval [list package ifneeded msgcat [package provide msgcat] \ [package ifneeded msgcat [package provide msgcat]]] i eval package require msgcat } -cleanup { interp delete [namespace current]::i foreach var $envVars { unset -nocomplain ::env($var) catch {set ::env($var) [set [namespace current]::$var]} } } -body {i eval msgcat::mclocale} -result $result incr count } unset -nocomplain result # Could add tests of initialization from Windows registry here. # Use a fake registry package. # Tests msgcat-1.*: [mclocale], [mcpreferences] test msgcat-1.3 {mclocale set, single element} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale en } -result en test msgcat-1.4 {mclocale get, single element} -setup { variable locale [mclocale] mclocale en } -cleanup { mclocale $locale } -body { mclocale } -result en test msgcat-1.5 {mcpreferences, single element} -setup { variable locale [mclocale] mclocale en } -cleanup { mclocale $locale } -body { mcpreferences } -result {en {}} test msgcat-1.6 {mclocale set, two elements} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale en_US } -result en_us test msgcat-1.7 {mclocale get, two elements} -setup { variable locale [mclocale] mclocale en_US } -cleanup { mclocale $locale } -body { mclocale } -result en_us test msgcat-1.8 {mcpreferences, two elements} -setup { variable locale [mclocale] mclocale en_US } -cleanup { mclocale $locale } -body { mcpreferences } -result {en_us en {}} test msgcat-1.9 {mclocale set, three elements} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale en_US_funky } -result en_us_funky test msgcat-1.10 {mclocale get, three elements} -setup { variable locale [mclocale] mclocale en_US_funky } -cleanup { mclocale $locale } -body { mclocale } -result en_us_funky test msgcat-1.11 {mcpreferences, three elements} -setup { variable locale [mclocale] mclocale en_US_funky } -cleanup { mclocale $locale } -body { mcpreferences } -result {en_us_funky en_us en {}} test msgcat-1.12 {mclocale set, reject evil input} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale /path/to/evil/code } -returnCodes error -match glob -result {invalid newLocale value *} test msgcat-1.13 {mclocale set, reject evil input} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale looks/ok/../../../../but/is/path/to/evil/code } -returnCodes error -match glob -result {invalid newLocale value *} # Tests msgcat-2.*: [mcset], [mcmset], namespace partitioning test msgcat-2.1 {mcset, global scope} { namespace eval :: ::msgcat::mcset foo_BAR text1 text2 } {text2} test msgcat-2.2 {mcset, global scope, default} { namespace eval :: ::msgcat::mcset foo_BAR text3 } {text3} test msgcat-2.2.1 {mcset, namespace overlap} { namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz} } {con1baz} test msgcat-2.3 {mcset, namespace overlap} -setup { namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar} namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz} variable locale [mclocale] mclocale foo_BAR } -cleanup { mclocale $locale } -body { namespace eval bar {::msgcat::mc con1} } -result con1bar test msgcat-2.4 {mcset, namespace overlap} -setup { namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar} namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz} variable locale [mclocale] mclocale foo_BAR } -cleanup { mclocale $locale } -body { namespace eval baz {::msgcat::mc con1} } -result con1baz test msgcat-2.5 {mcmset, global scope} -setup { namespace eval :: { ::msgcat::mcmset foo_BAR { src1 trans1 src2 trans2 } } variable locale [mclocale] mclocale foo_BAR } -cleanup { mclocale $locale } -body { namespace eval :: { ::msgcat::mc src1 } } -result trans1 test msgcat-2.6 {mcmset, namespace overlap} -setup { namespace eval bar {::msgcat::mcmset foo_BAR {con2 con2bar}} namespace eval baz {::msgcat::mcmset foo_BAR {con2 con2baz}} variable locale [mclocale] mclocale foo_BAR } -cleanup { mclocale $locale } -body { namespace eval bar {::msgcat::mc con2} } -result con2bar test msgcat-2.7 {mcmset, namespace overlap} -setup { namespace eval bar {::msgcat::mcmset foo_BAR {con2 con2bar}} namespace eval baz {::msgcat::mcmset foo_BAR {con2 con2baz}} variable locale [mclocale] mclocale foo_BAR } -cleanup { mclocale $locale } -body { namespace eval baz {::msgcat::mc con2} } -result con2baz # Tests msgcat-3.*: [mcset], [mc], catalog "inheritance" # # Test mcset and mc, ensuring that more specific locales # (e.g. en_UK) will search less specific locales # (e.g. en) for translation strings. # # Do this for the 15 permutations of # locales: {foo foo_BAR foo_BAR_baz} # strings: {ov0 ov1 ov2 ov3 ov4} # locale ROOT defines ov0, ov1, ov2, ov3 # locale foo defines ov1, ov2, ov3 # locale foo_BAR defines ov2, ov3 # locale foo_BAR_BAZ defines ov3 # (ov4 is defined in none) # So, # ov3 should be resolved in foo, foo_BAR, foo_BAR_baz # ov2 should be resolved in foo, foo_BAR # ov2 should resolve to foo_BAR in foo_BAR_baz # ov1 should be resolved in foo # ov1 should resolve to foo in foo_BAR, foo_BAR_baz # ov4 should be resolved in none, and call mcunknown # variable count 2 variable result array set result { foo,ov0 ov0_ROOT foo,ov1 ov1_foo foo,ov2 ov2_foo foo,ov3 ov3_foo foo,ov4 ov4 foo_BAR,ov0 ov0_ROOT foo_BAR,ov1 ov1_foo foo_BAR,ov2 ov2_foo_BAR foo_BAR,ov3 ov3_foo_BAR foo_BAR,ov4 ov4 foo_BAR_baz,ov0 ov0_ROOT foo_BAR_baz,ov1 ov1_foo foo_BAR_baz,ov2 ov2_foo_BAR foo_BAR_baz,ov3 ov3_foo_BAR_baz foo_BAR_baz,ov4 ov4 } variable loc variable string foreach loc {foo foo_BAR foo_BAR_baz} { foreach string {ov0 ov1 ov2 ov3 ov4} { test msgcat-3.$count {mcset, overlap} -setup { mcset {} ov0 ov0_ROOT mcset {} ov1 ov1_ROOT mcset {} ov2 ov2_ROOT mcset {} ov3 ov3_ROOT mcset foo ov1 ov1_foo mcset foo ov2 ov2_foo mcset foo ov3 ov3_foo mcset foo_BAR ov2 ov2_foo_BAR mcset foo_BAR ov3 ov3_foo_BAR mcset foo_BAR_baz ov3 ov3_foo_BAR_baz variable locale [mclocale] mclocale $loc } -cleanup { mclocale $locale } -body { mc $string } -result $result($loc,$string) incr count } } unset -nocomplain result # Tests msgcat-4.*: [mcunknown] test msgcat-4.2 {mcunknown, default} -setup { mcset foo unk1 "unknown 1" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale } -body { mc unk1 } -result {unknown 1} test msgcat-4.3 {mcunknown, default} -setup { mcset foo unk1 "unknown 1" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale } -body { mc unk2 } -result unk2 test msgcat-4.4 {mcunknown, overridden} -setup { rename ::msgcat::mcunknown SavedMcunknown proc ::msgcat::mcunknown {dom s} { return unknown:$dom:$s } mcset foo unk1 "unknown 1" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale rename ::msgcat::mcunknown {} rename SavedMcunknown ::msgcat::mcunknown } -body { mc unk1 } -result {unknown 1} test msgcat-4.5 {mcunknown, overridden} -setup { rename ::msgcat::mcunknown SavedMcunknown proc ::msgcat::mcunknown {dom s} { return unknown:$dom:$s } mcset foo unk1 "unknown 1" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale rename ::msgcat::mcunknown {} rename SavedMcunknown ::msgcat::mcunknown } -body { mc unk2 } -result {unknown:foo:unk2} test msgcat-4.6 {mcunknown, uplevel context} -setup { rename ::msgcat::mcunknown SavedMcunknown proc ::msgcat::mcunknown {dom s} { return "unknown:$dom:$s:[expr {[info level] - 1}]" } mcset foo unk1 "unknown 1" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale rename ::msgcat::mcunknown {} rename SavedMcunknown ::msgcat::mcunknown } -body { mc unk2 } -result unknown:foo:unk2:[info level] # Tests msgcat-5.*: [mcload] variable locales {{} foo foo_BAR foo_BAR_baz} set msgdir [makeDirectory msgdir] foreach loc $locales { if { $loc eq {} } { set msg ROOT } else { set msg [string tolower $loc] } makeFile [list ::msgcat::mcset $loc abc abc-$loc] $msg.msg $msgdir } variable count 1 foreach loc {foo foo_BAR foo_BAR_baz} { test msgcat-5.$count {mcload} -setup { variable locale [mclocale] ::msgcat::mclocale "" ::msgcat::mcloadedlocales clear ::msgcat::mcpackageconfig unset mcfolder mclocale $loc } -cleanup { mclocale $locale ::msgcat::mcloadedlocales clear ::msgcat::mcpackageconfig unset mcfolder } -body { mcload $msgdir } -result [expr { $count+1 }] incr count } # Even though foo_BAR_notexist does not exist, # foo_BAR, foo and the root should be loaded. test msgcat-5.4 {mcload} -setup { variable locale [mclocale] mclocale foo_BAR_notexist } -cleanup { mclocale $locale mcloadedlocales clear mcpackageconfig unset mcfolder } -body { mcload $msgdir } -result 3 test msgcat-5.5 {mcload} -setup { variable locale [mclocale] mclocale no_FI_notexist } -cleanup { mclocale $locale mcloadedlocales clear mcpackageconfig unset mcfolder } -body { mcload $msgdir } -result 1 test msgcat-5.6 {mcload} -setup { variable locale [mclocale] mclocale foo mcload $msgdir } -cleanup { mclocale $locale } -body { mc abc } -result abc-foo test msgcat-5.7 {mcload} -setup { variable locale [mclocale] mclocale foo_BAR mcload $msgdir } -cleanup { mclocale $locale } -body { mc abc } -result abc-foo_BAR test msgcat-5.8 {mcload} -setup { variable locale [mclocale] mclocale foo_BAR_baz mcload $msgdir } -cleanup { mclocale $locale } -body { mc abc } -result abc-foo_BAR_baz test msgcat-5.9 {mcload} -setup { variable locale [mclocale] mclocale no_FI_notexist mcload $msgdir } -cleanup { mclocale $locale } -body { mc abc } -result abc- test msgcat-5.10 {mcload} -setup { rename ::msgcat::mcunknown SavedMcunknown proc ::msgcat::mcunknown {dom s} { return unknown:$dom:$s } variable locale [mclocale] mclocale no_FI_notexist mcload $msgdir } -cleanup { mclocale $locale rename ::msgcat::mcunknown {} rename SavedMcunknown ::msgcat::mcunknown } -body { mc def } -result unknown:no_fi_notexist:def test msgcat-5.11 {mcpackageconfig mcfolder} -setup { variable locale [mclocale] mclocale "" mcloadedlocales clear mcpackageconfig unset mcfolder } -cleanup { mclocale $locale mcloadedlocales clear mcpackageconfig unset mcfolder } -body { mclocale foo mcpackageconfig set mcfolder $msgdir } -result 2 foreach loc $locales { if { $loc eq {} } { set msg ROOT } else { set msg [string tolower $loc] } removeFile $msg.msg $msgdir } removeDirectory msgdir # Tests msgcat-6.*: [mcset], [mc] namespace inheritance # # Test mcset and mc, ensuring that resolution for messages # proceeds from the current ns to its parent and so on to the # global ns. # # Do this for the 12 permutations of # locales: foo # namespaces: foo foo::bar foo::bar::baz # strings: {ov1 ov2 ov3 ov4} # namespace ::foo defines ov1, ov2, ov3 # namespace ::foo::bar defines ov2, ov3 # namespace ::foo::bar::baz defines ov3 # # ov4 is not defined in any namespace. # # So, # ov3 should be resolved in ::foo::bar::baz, ::foo::bar, ::foo; # ov2 should be resolved in ::foo, ::foo::bar # ov1 should be resolved in ::foo # ov4 should be resolved in none, and call mcunknown # variable result array set result { foo,ov1 ov1_foo foo,ov2 ov2_foo foo,ov3 ov3_foo foo,ov4 ov4 foo::bar,ov1 ov1_foo foo::bar,ov2 ov2_foo_bar foo::bar,ov3 ov3_foo_bar foo::bar,ov4 ov4 foo::bar::baz,ov1 ov1_foo foo::bar::baz,ov2 ov2_foo_bar foo::bar::baz,ov3 ov3_foo_bar_baz foo::bar::baz,ov4 ov4 } variable count 1 variable ns foreach ns {foo foo::bar foo::bar::baz} { foreach string {ov1 ov2 ov3 ov4} { test msgcat-6.$count {mcset, overlap} -setup { namespace eval foo { ::msgcat::mcset foo ov1 ov1_foo ::msgcat::mcset foo ov2 ov2_foo ::msgcat::mcset foo ov3 ov3_foo namespace eval bar { ::msgcat::mcset foo ov2 ov2_foo_bar ::msgcat::mcset foo ov3 ov3_foo_bar namespace eval baz { ::msgcat::mcset foo ov3 "ov3_foo_bar_baz" } } } variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale namespace delete foo } -body { namespace eval $ns [list ::msgcat::mc $string] } -result $result($ns,$string) incr count } } # Tests msgcat-7.*: [mc] extra args processed by [format] test msgcat-7.1 {mc extra args go through to format} -setup { mcset foo format1 "this is a test" mcset foo format2 "this is a %s" mcset foo format3 "this is a %s %s" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale } -body { mc format1 "good test" } -result "this is a test" test msgcat-7.2 {mc extra args go through to format} -setup { mcset foo format1 "this is a test" mcset foo format2 "this is a %s" mcset foo format3 "this is a %s %s" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale } -body { mc format2 "good test" } -result "this is a good test" test msgcat-7.3 {mc errors from format are propagated} -setup { mcset foo format1 "this is a test" mcset foo format2 "this is a %s" mcset foo format3 "this is a %s %s" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale } -body { catch {mc format3 "good test"} } -result 1 test msgcat-7.4 {mc, extra args are given to unknown} -setup { mcset foo format1 "this is a test" mcset foo format2 "this is a %s" mcset foo format3 "this is a %s %s" variable locale [mclocale] mclocale foo } -cleanup { mclocale $locale } -body { mc "this is a %s" "good test" } -result "this is a good test" # Tests msgcat-8.*: [mcflset] set msgdir1 [makeDirectory msgdir1] makeFile {::msgcat::mcflset k1 v1} l1.msg $msgdir1 test msgcat-8.1 {mcflset} -setup { variable locale [mclocale] mclocale l1 mcload $msgdir1 } -cleanup { mclocale $locale } -body { mc k1 } -result v1 removeFile l1.msg $msgdir1 removeDirectory msgdir1 set msgdir2 [makeDirectory msgdir2] set msgdir3 [makeDirectory msgdir3] makeFile "::msgcat::mcflset k2 v2 ; ::msgcat::mcload [list $msgdir3]"\ l2.msg $msgdir2 makeFile {::msgcat::mcflset k3 v3} l2.msg $msgdir3 # chained mcload test msgcat-8.2 {mcflset} -setup { variable locale [mclocale] mclocale l2 mcload $msgdir2 } -cleanup { mclocale $locale } -body { return [mc k2][mc k3] } -result v2v3 removeFile l2.msg $msgdir2 removeDirectory msgdir2 removeDirectory msgdir3 # Tests msgcat-9.*: [mcexists] test msgcat-9.1 {mcexists no parameter} -body { mcexists } -returnCodes 1\ -result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"} test msgcat-9.2 {mcexists unknown option} -body { mcexists -unknown src } -returnCodes 1\ -result {unknown option "-unknown"} test msgcat-9.3 {mcexists} -setup { mcforgetpackage variable locale [mclocale] mclocale foo mcset foo k1 v1 } -cleanup { mclocale $locale } -body { list [mcexists k1] [mcexists k2] } -result {1 0} test msgcat-9.4 {mcexists descendent preference} -setup { mcforgetpackage variable locale [mclocale] mclocale foo_bar mcset foo k1 v1 } -cleanup { mclocale $locale } -body { list [mcexists k1] [mcexists -exactlocale k1] } -result {1 0} test msgcat-9.5 {mcexists parent namespace} -setup { mcforgetpackage variable locale [mclocale] mclocale foo_bar mcset foo k1 v1 } -cleanup { mclocale $locale } -body { namespace eval ::msgcat::test::sub { list [::msgcat::mcexists k1]\ [::msgcat::mcexists -exactnamespace k1] } } -result {1 0} # Tests msgcat-10.*: [mcloadedlocales] test msgcat-10.1 {mcloadedlocales no arg} -body { mcloadedlocales } -returnCodes 1\ -result {wrong # args: should be "mcloadedlocales subcommand"} test msgcat-10.2 {mcloadedlocales wrong subcommand} -body { mcloadedlocales junk } -returnCodes 1\ -result {unknown subcommand "junk": must be clear, or loaded} test msgcat-10.3 {mcloadedlocales loaded} -setup { mcforgetpackage variable locale [mclocale] mclocale {} mcloadedlocales clear } -cleanup { mclocale $locale } -body { mclocale foo_bar # The result is position independent so sort set resultlist [lsort [mcloadedlocales loaded]] } -result {{} foo foo_bar} test msgcat-10.4 {mcloadedlocales clear} -setup { mcforgetpackage variable locale [mclocale] mclocale {} mcloadedlocales clear } -cleanup { mclocale $locale } -body { mclocale foo mcset foo k1 v1 set res [mcexists k1] mclocale "" mcloadedlocales clear mclocale foo lappend res [mcexists k1] } -result {1 0} # Tests msgcat-11.*: [mcforgetpackage] test msgcat-11.1 {mcforgetpackage translation} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale foo mcset foo k1 v1 set res [mcexists k1] mcforgetpackage lappend res [mcexists k1] } -result {1 0} test msgcat-11.2 {mcforgetpackage locale} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale foo mcpackagelocale set bar set res [mcpackagelocale get] mcforgetpackage lappend res [mcpackagelocale get] } -result {bar foo} test msgcat-11.3 {mcforgetpackage options} -body { mcpackageconfig set loadcmd "" set res [mcpackageconfig isset loadcmd] mcforgetpackage lappend res [mcpackageconfig isset loadcmd] } -result {1 0} # Tests msgcat-12.*: [mcpackagelocale] test msgcat-12.1 {mcpackagelocale no subcommand} -body { mcpackagelocale } -returnCodes 1\ -result {wrong # args: should be "mcpackagelocale subcommand ?locale?"} test msgcat-12.2 {mclpackagelocale wrong subcommand} -body { mcpackagelocale junk } -returnCodes 1\ -result {unknown subcommand "junk": must be clear, get, isset, loaded, present, set, or unset} test msgcat-12.3 {mcpackagelocale set} -setup { variable locale [mclocale] } -cleanup { mclocale $locale mcforgetpackage } -body { mclocale foo mcpackagelocale set bar list [mcpackagelocale get] [mclocale] } -result {bar foo} test msgcat-12.4 {mcpackagelocale get} -setup { variable locale [mclocale] } -cleanup { mclocale $locale mcforgetpackage } -body { mclocale foo set res [mcpackagelocale get] mcpackagelocale set bar lappend res [mcpackagelocale get] } -result {foo bar} test msgcat-12.5 {mcpackagelocale preferences} -setup { variable locale [mclocale] } -cleanup { mclocale $locale mcforgetpackage } -body { mclocale foo set res [list [mcpackagelocale preferences]] mcpackagelocale set bar lappend res [mcpackagelocale preferences] } -result {{foo {}} {bar {}}} test msgcat-12.6 {mcpackagelocale loaded} -setup { variable locale [mclocale] } -cleanup { mclocale $locale mcforgetpackage } -body { mclocale "" mcloadedlocales clear mclocale foo # The result is position independent so sort set res [list [lsort [mcpackagelocale loaded]]] mcpackagelocale set bar lappend res [lsort [mcpackagelocale loaded]] } -result {{{} foo} {{} bar foo}} test msgcat-12.7 {mcpackagelocale isset} -setup { variable locale [mclocale] } -cleanup { mclocale $locale mcforgetpackage } -body { mclocale foo set res [mcpackagelocale isset] mcpackagelocale set bar lappend res [mcpackagelocale isset] } -result {0 1} test msgcat-12.8 {mcpackagelocale unset} -setup { variable locale [mclocale] } -cleanup { mclocale $locale mcforgetpackage } -body { mcpackagelocale set bar set res [mcpackagelocale isset] mcpackagelocale unset lappend res [mcpackagelocale isset] } -result {1 0} test msgcat-12.9 {mcpackagelocale present} -setup { variable locale [mclocale] } -cleanup { mclocale $locale mcforgetpackage } -body { mclocale "" mcloadedlocales clear mclocale foo set res [mcpackagelocale present foo] lappend res [mcpackagelocale present bar] mcpackagelocale set bar lappend res [mcpackagelocale present foo]\ [mcpackagelocale present bar] } -result {1 0 1 1} test msgcat-12.10 {mcpackagelocale clear} -setup { variable locale [mclocale] } -cleanup { mclocale $locale mcforgetpackage } -body { mclocale "" mcloadedlocales clear mclocale foo mcpackagelocale set bar mcpackagelocale clear list [mcpackagelocale present foo] [mcpackagelocale present bar] } -result {0 1} # Tests msgcat-13.*: [mcpackageconfig subcmds] test msgcat-13.1 {mcpackageconfig no subcommand} -body { mcpackageconfig } -returnCodes 1\ -result {wrong # args: should be "mcpackageconfig subcommand option ?value?"} test msgcat-13.2 {mclpackageconfig wrong subcommand} -body { mcpackageconfig junk mcfolder } -returnCodes 1\ -result {unknown subcommand "junk": must be get, isset, set, or unset} test msgcat-13.3 {mclpackageconfig wrong option} -body { mcpackageconfig get junk } -returnCodes 1\ -result {bad option "junk": must be mcfolder, loadcmd, changecmd, or unknowncmd} test msgcat-13.4 {mcpackageconfig get} -setup { mcforgetpackage } -cleanup { mcforgetpackage } -body { mcpackageconfig set loadcmd "" mcpackageconfig get loadcmd } -result {} test msgcat-13.5 {mcpackageconfig (is/un)set} -setup { mcforgetpackage } -cleanup { mcforgetpackage } -body { set res [mcpackageconfig isset loadcmd] lappend res [mcpackageconfig set loadcmd ""] lappend res [mcpackageconfig isset loadcmd] mcpackageconfig unset loadcmd lappend res [mcpackageconfig isset loadcmd] } -result {0 0 1 0} # option mcfolder is already tested with 5.11 # Tests msgcat-14.*: callbacks: loadcmd, changecmd, unknowncmd # This routine is used as bgerror and by direct callback invocation proc callbackproc args { variable resultvariable set resultvariable $args } proc callbackfailproc args { return -code error fail } set bgerrorsaved [interp bgerror {}] interp bgerror {} [namespace code callbackproc] variable locale if {![info exist locale]} { set locale [mclocale] } test msgcat-14.1 {invocation loadcmd} -setup { mcforgetpackage mclocale $locale mclocale "" mcloadedlocales clear set resultvariable "" } -cleanup { mcforgetpackage } -body { mcpackageconfig set loadcmd [namespace code callbackproc] mclocale foo_bar lsort $resultvariable } -result {foo foo_bar} test msgcat-14.2 {invocation failed in loadcmd} -setup { mcforgetpackage mclocale $locale mclocale "" mcloadedlocales clear } -cleanup { mcforgetpackage after cancel set [namespace current]::resultvariable timeout } -body { mcpackageconfig set loadcmd [namespace code callbackfailproc] mclocale foo_bar # let the bgerror run after 100 set [namespace current]::resultvariable timeout vwait [namespace current]::resultvariable lassign $resultvariable err errdict list $err [dict get $errdict -code] } -result {fail 1} test msgcat-14.3 {invocation changecmd} -setup { mcforgetpackage mclocale $locale mclocale "" set resultvariable "" } -cleanup { mcforgetpackage } -body { mcpackageconfig set changecmd [namespace code callbackproc] mclocale foo_bar set resultvariable } -result {foo_bar foo {}} test msgcat-14.4 {invocation unknowncmd} -setup { mcforgetpackage mclocale $locale mclocale "" mcloadedlocales clear set resultvariable "" } -cleanup { mcforgetpackage } -body { mcpackageconfig set unknowncmd [namespace code callbackproc] mclocale foo_bar mc k1 p1 set resultvariable } -result {foo_bar k1 p1} test msgcat-14.5 {disable global unknowncmd} -setup { mcforgetpackage mclocale $locale mclocale "" mcloadedlocales clear set resultvariable "" rename ::msgcat::mcunknown SavedMcunknown proc ::msgcat::mcunknown {dom s} { return unknown:$dom:$s } } -cleanup { mcforgetpackage rename ::msgcat::mcunknown {} rename SavedMcunknown ::msgcat::mcunknown } -body { mcpackageconfig set unknowncmd "" mclocale foo_bar mc k1%s p1 } -result {k1p1} test msgcat-14.6 {unknowncmd failing} -setup { mcforgetpackage mclocale $locale mclocale "" mcloadedlocales clear set resultvariable "" } -cleanup { mcforgetpackage } -body { mcpackageconfig set unknowncmd [namespace code callbackfailproc] mclocale foo_bar mc k1 } -returnCodes 1\ -result {fail} interp bgerror {} $bgerrorsaved cleanupTests } namespace delete ::msgcat::test return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/namespace-old.test0000644000175000017500000010736714554262142016433 0ustar sergeisergei# Functionality covered: this file contains slightly modified versions of # the original tests written by Mike McLennan of Lucent Technologies for # the procedures in tclNamesp.c that implement Tcl's basic support for # namespaces. Other namespace-related tests appear in namespace.test # and variable.test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1997 Lucent Technologies # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.2 namespace import -force ::tcltest::* } # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} test namespace-old-1.1 {usage for "namespace" command} { list [catch {namespace} msg] $msg } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} test namespace-old-1.2 {global namespace's name is "::" or {}} { list [namespace current] [namespace eval {} {namespace current}] } {:: ::} test namespace-old-1.3 {usage for "namespace eval"} { list [catch {namespace eval} msg] $msg } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-old-1.4 {create new namespaces} { list [lsort [namespace children :: test_ns_simple*]] \ [namespace eval test_ns_simple {}] \ [namespace eval test_ns_simple2 {}] \ [lsort [namespace children :: test_ns_simple*]] } {{} {} {} {::test_ns_simple ::test_ns_simple2}} test namespace-old-1.5 {access a new namespace} { namespace eval test_ns_simple { namespace current } } {::test_ns_simple} test namespace-old-1.6 {usage for "namespace eval"} { list [catch {namespace eval} msg] $msg } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-old-1.7 {usage for "namespace eval"} { list [catch {namespace eval test_ns_xyzzy} msg] $msg } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-old-1.8 {command "namespace eval" concatenates args} { namespace eval test_ns_simple namespace current } {::test_ns_simple} test namespace-old-1.9 {add elements to a namespace} { namespace eval test_ns_simple { variable test_ns_x 0 proc test {test_ns_x} { return "test: $test_ns_x" } } } {} namespace eval test_ns_simple { variable test_ns_x 0 proc test {test_ns_x} { return "test: $test_ns_x" } } test namespace-old-1.10 {commands in a namespace} { namespace eval test_ns_simple { info commands [namespace current]::*} } {::test_ns_simple::test} test namespace-old-1.11 {variables in a namespace} { namespace eval test_ns_simple { info vars [namespace current]::* } } {::test_ns_simple::test_ns_x} test namespace-old-1.12 {global vars are separate from locals vars} { list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x] } {{test: 123} 0} test namespace-old-1.13 {add to an existing namespace} { namespace eval test_ns_simple { variable test_ns_y 123 proc _backdoor {cmd} { eval $cmd } } } "" namespace eval test_ns_simple { variable test_ns_y 123 proc _backdoor {cmd} { eval $cmd } } test namespace-old-1.14 {commands in a namespace} { lsort [namespace eval test_ns_simple {info commands [namespace current]::*}] } {::test_ns_simple::_backdoor ::test_ns_simple::test} test namespace-old-1.15 {variables in a namespace} { lsort [namespace eval test_ns_simple {info vars [namespace current]::*}] } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y} test namespace-old-1.16 {variables in a namespace} { lsort [info vars test_ns_simple::*] } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y} test namespace-old-1.17 {commands in a namespace are hidden} { list [catch "_backdoor {return yes!}" msg] $msg } {1 {invalid command name "_backdoor"}} test namespace-old-1.18 {using namespace qualifiers} { list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg } {0 yes!} test namespace-old-1.19 {using absolute namespace qualifiers} { list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg } {0 yes!} test namespace-old-1.20 {variables in a namespace are hidden} { list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg } {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}} test namespace-old-1.21 {using namespace qualifiers} { list [catch "set test_ns_simple::test_ns_x" msg] $msg \ [catch "set test_ns_simple::test_ns_y" msg] $msg } {0 0 0 123} test namespace-old-1.22 {using absolute namespace qualifiers} { list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \ [catch "set ::test_ns_simple::test_ns_y" msg] $msg } {0 0 0 123} test namespace-old-1.23 {variables can be accessed within a namespace} { test_ns_simple::_backdoor { variable test_ns_x variable test_ns_y return "$test_ns_x $test_ns_y" } } {0 123} test namespace-old-1.24 {setting global variables} { test_ns_simple::_backdoor {variable test_ns_x; set test_ns_x "new val"} namespace eval test_ns_simple {set test_ns_x} } {new val} test namespace-old-1.25 {qualified variables don't need a global declaration} { namespace eval test_ns_another { variable test_ns_x 456 } set cmd {set ::test_ns_another::test_ns_x} list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \ [eval $cmd] } {0 some-value some-value} test namespace-old-1.26 {namespace qualifiers are okay after $'s} { namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 } set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y} list [test_ns_simple::_backdoor $cmd] [eval $cmd] } {{12 34} {12 34}} test namespace-old-1.27 {can create commands with null names} { proc test_ns_simple:: {args} {return $args} } {} # Redeclare; later tests depend on it proc test_ns_simple:: {args} {return $args} # ----------------------------------------------------------------------- # TEST: using "info" in namespace contexts # ----------------------------------------------------------------------- test namespace-old-2.1 {querying: info commands} { lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}] } {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test} test namespace-old-2.2 {querying: info procs} { lsort [test_ns_simple::_backdoor {info procs}] } {{} _backdoor test} test namespace-old-2.3 {querying: info vars} { lsort [info vars test_ns_simple::*] } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y} test namespace-old-2.4 {querying: info vars} { lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}] } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y} test namespace-old-2.5 {querying: info locals} { lsort [test_ns_simple::_backdoor {info locals}] } {cmd} test namespace-old-2.6 {querying: info exists} { test_ns_simple::_backdoor {info exists test_ns_x} } {0} test namespace-old-2.7 {querying: info exists} { test_ns_simple::_backdoor {info exists cmd} } {1} test namespace-old-2.8 {querying: info args} { info args test_ns_simple::_backdoor } {cmd} test namespace-old-2.9 {querying: info body} { string trim [info body test_ns_simple::test] } {return "test: $test_ns_x"} # ----------------------------------------------------------------------- # TEST: namespace qualifiers, namespace tail # ----------------------------------------------------------------------- test namespace-old-3.1 {usage for "namespace qualifiers"} { list [catch "namespace qualifiers" msg] $msg } {1 {wrong # args: should be "namespace qualifiers string"}} test namespace-old-3.2 {querying: namespace qualifiers} { list [namespace qualifiers ""] \ [namespace qualifiers ::] \ [namespace qualifiers x] \ [namespace qualifiers ::x] \ [namespace qualifiers foo::x] \ [namespace qualifiers ::foo::bar::xyz] } {{} {} {} {} foo ::foo::bar} test namespace-old-3.3 {usage for "namespace tail"} { list [catch "namespace tail" msg] $msg } {1 {wrong # args: should be "namespace tail string"}} test namespace-old-3.4 {querying: namespace tail} { list [namespace tail ""] \ [namespace tail ::] \ [namespace tail x] \ [namespace tail ::x] \ [namespace tail foo::x] \ [namespace tail ::foo::bar::xyz] } {{} {} x x x xyz} # ----------------------------------------------------------------------- # TEST: delete commands and namespaces # ----------------------------------------------------------------------- test namespace-old-4.1 {define test namespaces} { namespace eval test_ns_delete { namespace eval ns1 { variable var1 1 proc cmd1 {} {return "cmd1"} } namespace eval ns2 { variable var2 2 proc cmd2 {} {return "cmd2"} } namespace eval another {} lsort [namespace children] } } {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2} test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} { list [catch {namespace delete} msg] $msg } {0 {}} test namespace-old-4.3 {command "namespace delete" doesn't support patterns} { set cmd { namespace eval test_ns_delete {namespace delete ns*} } list [catch $cmd msg] $msg } {1 {unknown namespace "ns*" in namespace delete command}} namespace eval test_ns_delete { namespace eval ns1 {} namespace eval ns2 {} namespace eval another {} } test namespace-old-4.4 {command "namespace delete" handles multiple args} { set cmd { namespace eval test_ns_delete { namespace delete \ {*}[namespace children [namespace current] ns?] } } list [catch $cmd msg] $msg [namespace children test_ns_delete] } {0 {} ::test_ns_delete::another} # ----------------------------------------------------------------------- # TEST: namespace hierarchy # ----------------------------------------------------------------------- test namespace-old-5.1 {define nested namespaces} { set test_ns_var_global "var in ::" proc test_ns_cmd_global {} {return "cmd in ::"} namespace eval test_ns_hier1 { set test_ns_var_hier1 "particular to hier1" proc test_ns_cmd_hier1 {} {return "particular to hier1"} set test_ns_level 1 proc test_ns_show {} {return "[namespace current]: 1"} namespace eval test_ns_hier2 { set test_ns_var_hier2 "particular to hier2" proc test_ns_cmd_hier2 {} {return "particular to hier2"} set test_ns_level 2 proc test_ns_show {} {return "[namespace current]: 2"} namespace eval test_ns_hier3a {} namespace eval test_ns_hier3b {} } namespace eval test_ns_hier2a {} namespace eval test_ns_hier2b {} } } {} test namespace-old-5.2 {namespaces can be nested} { list [namespace eval test_ns_hier1 {namespace current}] \ [namespace eval test_ns_hier1 { namespace eval test_ns_hier2 {namespace current} }] } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2} test namespace-old-5.3 {namespace qualifiers work in namespace command} { list [namespace eval ::test_ns_hier1 {namespace current}] \ [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \ [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}] } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2} set ::test_ns_var_global "var in ::" proc test_ns_cmd_global {} {return "cmd in ::"} namespace eval test_ns_hier1 { variable test_ns_var_hier1 "particular to hier1" proc test_ns_cmd_hier1 {} {return "particular to hier1"} variable test_ns_level 1 proc test_ns_show {} {return "[namespace current]: 1"} namespace eval test_ns_hier2 { variable test_ns_var_hier2 "particular to hier2" proc test_ns_cmd_hier2 {} {return "particular to hier2"} variable test_ns_level 2 proc test_ns_show {} {return "[namespace current]: 2"} namespace eval test_ns_hier3a {} namespace eval test_ns_hier3b {} } namespace eval test_ns_hier2a {} namespace eval test_ns_hier2b {} } test namespace-old-5.4 {nested namespaces can access global namespace} { list [namespace eval test_ns_hier1 {set test_ns_var_global}] \ [namespace eval test_ns_hier1 {test_ns_cmd_global}] \ [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \ [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}] } {{var in ::} {cmd in ::} {var in ::} {cmd in ::}} test namespace-old-5.5 {variables in different namespaces don't conflict} { list [set test_ns_hier1::test_ns_level] \ [set test_ns_hier1::test_ns_hier2::test_ns_level] } {1 2} test namespace-old-5.6 {commands in different namespaces don't conflict} { list [test_ns_hier1::test_ns_show] \ [test_ns_hier1::test_ns_hier2::test_ns_show] } {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}} test namespace-old-5.7 {nested namespaces don't see variables in parent} { set cmd { namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1} } list [catch $cmd msg] $msg } {1 {can't read "test_ns_var_hier1": no such variable}} test namespace-old-5.8 {nested namespaces don't see commands in parent} { set cmd { namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1} } list [catch $cmd msg] $msg } {1 {invalid command name "test_ns_cmd_hier1"}} test namespace-old-5.9 {usage for "namespace children"} { list [catch {namespace children test_ns_hier1 y z} msg] $msg } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}} test namespace-old-5.10 {command "namespace children" must get valid namespace} -body { namespace children xyzzy } -returnCodes error -result {namespace "xyzzy" not found in "::"} test namespace-old-5.11 {querying namespace children} { lsort [namespace children :: test_ns_hier*] } {::test_ns_hier1} test namespace-old-5.12 {querying namespace children} { lsort [namespace children test_ns_hier1] } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b} test namespace-old-5.13 {querying namespace children} { lsort [namespace eval test_ns_hier1 {namespace children}] } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b} test namespace-old-5.14 {querying namespace children} { lsort [namespace children test_ns_hier1::test_ns_hier2] } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b} test namespace-old-5.15 {querying namespace children} { lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}] } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b} test namespace-old-5.16 {querying namespace children with patterns} { lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*] } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b} test namespace-old-5.17 {querying namespace children with patterns} { lsort [namespace children test_ns_hier1::test_ns_hier2 *b] } {::test_ns_hier1::test_ns_hier2::test_ns_hier3b} test namespace-old-5.18 {usage for "namespace parent"} { list [catch {namespace parent x y} msg] $msg } {1 {wrong # args: should be "namespace parent ?name?"}} test namespace-old-5.19 {command "namespace parent" must get valid namespace} -body { namespace parent xyzzy } -returnCodes error -result {namespace "xyzzy" not found in "::"} test namespace-old-5.20 {querying namespace parent} { list [namespace eval :: {namespace parent}] \ [namespace eval test_ns_hier1 {namespace parent}] \ [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \ [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \ } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2} test namespace-old-5.21 {querying namespace parent for explicit namespace} { list [namespace parent ::] \ [namespace parent test_ns_hier1] \ [namespace parent test_ns_hier1::test_ns_hier2] \ [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a] } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2} # ----------------------------------------------------------------------- # TEST: name resolution and caching # ----------------------------------------------------------------------- set trigger {namespace eval test_ns_cache2 {namespace current}} set trigger2 {namespace eval test_ns_cache2::test_ns_cache3 {namespace current}} test namespace-old-6.1 {relative ns names only looked up in current ns} { namespace eval test_ns_cache1 {} namespace eval test_ns_cache2 {} namespace eval test_ns_cache2::test_ns_cache3 {} list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 $trigger2] } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3} test namespace-old-6.2 {relative ns names only looked up in current ns} { namespace eval test_ns_cache1::test_ns_cache2 {} list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 $trigger2] } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3} test namespace-old-6.3 {relative ns names only looked up in current ns} { namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {} list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 $trigger2] } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3} namespace eval test_ns_cache1::test_ns_cache2 {} test namespace-old-6.4 {relative ns names only looked up in current ns} { namespace delete test_ns_cache1::test_ns_cache2 list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 $trigger2] } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3} namespace eval test_ns_cache1 { proc trigger {} {test_ns_cache_cmd} } test namespace-old-6.5 {define test commands} { proc test_ns_cache_cmd {} { return "global version" } test_ns_cache1::trigger } {global version} test namespace-old-6.6 {one-level check for command shadowing} { proc test_ns_cache1::test_ns_cache_cmd {} { return "cache1 version" } test_ns_cache1::trigger } {cache1 version} proc test_ns_cache_cmd {} { return "global version" } test namespace-old-6.7 {renaming commands changes command epoch} -setup { proc test_ns_cache1::test_ns_cache_cmd {} { return "cache1 version" } } -body { list [test_ns_cache1::trigger] \ [namespace eval test_ns_cache1 {rename test_ns_cache_cmd test_ns_new}]\ [test_ns_cache1::trigger] } -result {{cache1 version} {} {global version}} test namespace-old-6.8 {renaming back handles shadowing} -setup { proc test_ns_cache1::test_ns_new {} { return "cache1 version" } } -body { list [test_ns_cache1::trigger] \ [namespace eval test_ns_cache1 {rename test_ns_new test_ns_cache_cmd}]\ [test_ns_cache1::trigger] } -result {{global version} {} {cache1 version}} test namespace-old-6.9 {deleting commands changes command epoch} -setup { proc test_ns_cache1::test_ns_cache_cmd {} { return "cache1 version" } } -body { list [test_ns_cache1::trigger] \ [namespace eval test_ns_cache1 {rename test_ns_cache_cmd ""}] \ [test_ns_cache1::trigger] } -result {{cache1 version} {} {global version}} test namespace-old-6.10 {define test namespaces} { namespace eval test_ns_cache2 { proc test_ns_cache_cmd {} { return "global cache2 version" } } namespace eval test_ns_cache1 { proc trigger {} { test_ns_cache2::test_ns_cache_cmd } } namespace eval test_ns_cache1::test_ns_cache2 { proc trigger {} { test_ns_cache_cmd } } list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger] } {{global cache2 version} {global version}} namespace eval test_ns_cache1 { proc trigger {} { test_ns_cache2::test_ns_cache_cmd } namespace eval test_ns_cache2 { proc trigger {} { test_ns_cache_cmd } } } test namespace-old-6.11 {commands affect all parent namespaces} { proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} { return "cache2 version" } list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger] } {{cache2 version} {cache2 version}} test namespace-old-6.12 {define test variables} { variable test_ns_cache_var "global version" set trigger {set test_ns_cache_var} namespace eval test_ns_cache1 $trigger } {global version} set trigger {set test_ns_cache_var} test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 { variable test_ns_cache_var "cache1 version" } namespace eval test_ns_cache1 $trigger } {cache1 version} variable ::test_ns_cache_var "global version" test namespace-old-6.14 {deleting variables changes variable epoch} { namespace eval test_ns_cache1 { variable test_ns_cache_var "cache1 version" } list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 {unset test_ns_cache_var}] \ [namespace eval test_ns_cache1 $trigger] } {{cache1 version} {} {global version}} test namespace-old-6.15 {define test namespaces} { namespace eval test_ns_cache2 { variable test_ns_cache_var "global cache2 version" } set trigger2 {set test_ns_cache2::test_ns_cache_var} list [namespace eval test_ns_cache1 $trigger2] \ [namespace eval test_ns_cache1::test_ns_cache2 $trigger] } {{global cache2 version} {global version}} set trigger2 {set test_ns_cache2::test_ns_cache_var} test namespace-old-6.16 {public variables affect all parent namespaces} { variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version" list [namespace eval test_ns_cache1 $trigger2] \ [namespace eval test_ns_cache1::test_ns_cache2 $trigger] } {{cache2 version} {cache2 version}} test namespace-old-6.17 {usage for "namespace which"} { list [catch "namespace which -baz x" msg] $msg } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} test namespace-old-6.18 {usage for "namespace which"} { # Presume no imported command called -command ;^) namespace which -command } {} test namespace-old-6.19 {querying: namespace which -command} { proc test_ns_cache1::test_ns_cache_cmd {} { return "cache1 version" } list [namespace eval :: {namespace which test_ns_cache_cmd}] \ [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \ [namespace eval :: {namespace which -command test_ns_cache_cmd}] \ [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}] } {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd} test namespace-old-6.20 {command "namespace which" may not find commands} { namespace eval test_ns_cache1 {namespace which -command xyzzy} } {} variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version" test namespace-old-6.21 {querying: namespace which -variable} { namespace eval test_ns_cache1::test_ns_cache2 { namespace which -variable test_ns_cache_var } } {::test_ns_cache1::test_ns_cache2::test_ns_cache_var} test namespace-old-6.22 {command "namespace which" may not find variables} { namespace eval test_ns_cache1 {namespace which -variable xyzzy} } {} # ----------------------------------------------------------------------- # TEST: uplevel/upvar across namespace boundaries # ----------------------------------------------------------------------- test namespace-old-7.1 {define test namespace} { namespace eval test_ns_uplevel { variable x 0 variable y 1 proc show_vars {num} { return [uplevel $num {info vars}] } proc test_uplevel {num} { set a 0 set b 1 namespace eval ::test_ns_uplevel " return \[show_vars $num\] " } } } {} namespace eval test_ns_uplevel { variable x 0 variable y 1 proc show_vars {num} { return [uplevel $num {info vars}] } proc test_uplevel {num} { set a 0 set b 1 namespace eval ::test_ns_uplevel " return \[show_vars $num\] " } } test namespace-old-7.2 {uplevel can access namespace call frame} { list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \ [expr {"y" in [test_ns_uplevel::test_uplevel 1]}] } {1 1} test namespace-old-7.3 {uplevel can go beyond namespace call frame} { lsort [test_ns_uplevel::test_uplevel 2] } {a b num} test namespace-old-7.4 {uplevel can go up to global context} { expr {[test_ns_uplevel::test_uplevel 3] == [info globals]} } {1} test namespace-old-7.5 {absolute call frame references work too} { list [expr {"x" in [test_ns_uplevel::test_uplevel #2]}] \ [expr {"y" in [test_ns_uplevel::test_uplevel #2]}] } {1 1} test namespace-old-7.6 {absolute call frame references work too} { lsort [test_ns_uplevel::test_uplevel #1] } {a b num} test namespace-old-7.7 {absolute call frame references work too} { expr {[test_ns_uplevel::test_uplevel #0] == [info globals]} } {1} test namespace-old-7.8 {namespaces are included in the call stack} { namespace eval test_ns_upvar { variable scope "test_ns_upvar" proc show_val {var num} { upvar $num $var x return $x } proc test_upvar {num} { set scope "test_ns_upvar::test_upvar" namespace eval ::test_ns_upvar " return \[show_val scope $num\] " } } } {} namespace eval test_ns_upvar { variable scope "test_ns_upvar" proc show_val {var num} { upvar $num $var x return $x } proc test_upvar {num} { set scope "test_ns_upvar::test_upvar" namespace eval ::test_ns_upvar " return \[show_val scope $num\] " } } test namespace-old-7.9 {upvar can access namespace call frame} { test_ns_upvar::test_upvar 1 } {test_ns_upvar} test namespace-old-7.10 {upvar can go beyond namespace call frame} { test_ns_upvar::test_upvar 2 } {test_ns_upvar::test_upvar} test namespace-old-7.11 {absolute call frame references work too} { test_ns_upvar::test_upvar #2 } {test_ns_upvar} test namespace-old-7.12 {absolute call frame references work too} { test_ns_upvar::test_upvar #1 } {test_ns_upvar::test_upvar} # ----------------------------------------------------------------------- # TEST: variable traces across namespace boundaries # ----------------------------------------------------------------------- test namespace-old-8.1 {traces work across namespace boundaries} { namespace eval test_ns_trace { namespace eval foo { variable x "" } variable status "" proc monitor {name1 name2 op} { variable status lappend status "$op: $name1" } trace add variable foo::x {read write unset} [namespace code monitor] } set test_ns_trace::foo::x "yes!" set test_ns_trace::foo::x unset test_ns_trace::foo::x namespace eval test_ns_trace { set status } } {{write: test_ns_trace::foo::x} {read: test_ns_trace::foo::x} {unset: test_ns_trace::foo::x}} # ----------------------------------------------------------------------- # TEST: imported commands # ----------------------------------------------------------------------- test namespace-old-9.1 {empty "namespace export" list} { list [catch "namespace export" msg] $msg } {0 {}} test namespace-old-9.2 {usage for "namespace export" command} { list [catch "namespace export test_ns_trace::zzz" msg] $msg } {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}} test namespace-old-9.3 {define test namespaces for import} { namespace eval test_ns_export { namespace export cmd1 cmd2 cmd3 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} proc cmd3 {args} {return "cmd3: $args"} proc cmd4 {args} {return "cmd4: $args"} proc cmd5 {args} {return "cmd5: $args"} proc cmd6 {args} {return "cmd6: $args"} } lsort [info commands test_ns_export::*] } {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6} namespace eval test_ns_export { namespace export cmd1 cmd2 cmd3 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} proc cmd3 {args} {return "cmd3: $args"} proc cmd4 {args} {return "cmd4: $args"} proc cmd5 {args} {return "cmd5: $args"} proc cmd6 {args} {return "cmd6: $args"} } test namespace-old-9.4 {check export status} { set x "" namespace eval test_ns_import { namespace export cmd1 cmd2 namespace import ::test_ns_export::* } foreach cmd [lsort [info commands test_ns_import::*]] { lappend x $cmd } set x } {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3} namespace eval test_ns_import { namespace export cmd1 cmd2 namespace import ::test_ns_export::* } test namespace-old-9.5 {empty import list in "namespace import" command} { namespace eval test_ns_import_empty { namespace import ::test_ns_export::* try { lsort [namespace import] } finally { namespace delete [namespace current] } } } {cmd1 cmd2 cmd3} # there is no namespace-old-9.6 test namespace-old-9.7 {empty forget list for "namespace forget" command} { namespace forget } {} catch {rename cmd1 {}} catch {rename cmd2 {}} catch {rename ncmd {}} catch {rename ncmd1 {}} catch {rename ncmd2 {}} test namespace-old-9.8 {only exported commands are imported} { namespace import test_ns_import::cmd* set x [lsort [info commands cmd*]] } {cmd1 cmd2} namespace import test_ns_import::cmd* test namespace-old-9.9 {imported commands work just the same as original} { list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6] } {{cmd1: test 1 2 3} {cmd1: test 4 5 6}} test namespace-old-9.10 {commands can be imported from many namespaces} { namespace eval test_ns_import2 { namespace export ncmd ncmd1 ncmd2 proc ncmd {args} {return "ncmd: $args"} proc ncmd1 {args} {return "ncmd1: $args"} proc ncmd2 {args} {return "ncmd2: $args"} proc ncmd3 {args} {return "ncmd3: $args"} } namespace import test_ns_import2::* lsort [concat [info commands cmd*] [info commands ncmd*]] } {cmd1 cmd2 ncmd ncmd1 ncmd2} namespace eval test_ns_import2 { namespace export ncmd ncmd1 ncmd2 proc ncmd {args} {return "ncmd: $args"} proc ncmd1 {args} {return "ncmd1: $args"} proc ncmd2 {args} {return "ncmd2: $args"} proc ncmd3 {args} {return "ncmd3: $args"} } namespace import test_ns_import2::* test namespace-old-9.11 {imported commands can be removed by deleting them} { rename cmd1 "" lsort [concat [info commands cmd*] [info commands ncmd*]] } {cmd2 ncmd ncmd1 ncmd2} catch { rename cmd1 "" } test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} { list [catch {namespace forget xyzzy::*} msg] $msg } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}} test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} { list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \ [lsort [info commands cmd?]] } {0 {} cmd2} test namespace-old-9.14 {imported commands can be removed} { namespace forget test_ns_import::cmd? list [lsort [info commands cmd?]] \ [catch {cmd1 another test} msg] $msg } {{} 1 {invalid command name "cmd1"}} test namespace-old-9.15 {existing commands can't be overwritten} { proc cmd1 {x y} { return [expr {$x+$y}] } list [catch {namespace import test_ns_import::cmd?} msg] $msg \ [cmd1 3 5] } {1 {can't import command "cmd1": already exists} 8} test namespace-old-9.16 {use "-force" option to override existing commands} { proc cmd1 {x y} { return [expr {$x+$y}] } list [cmd1 3 5] \ [namespace import -force test_ns_import::cmd?] \ [cmd1 3 5] } {8 {} {cmd1: 3 5}} test namespace-old-9.17 {commands can be imported into many namespaces} { namespace eval test_ns_import_use { namespace import ::test_ns_import::* ::test_ns_import2::ncmd? lsort [concat [info commands ::test_ns_import_use::cmd*] \ [info commands ::test_ns_import_use::ncmd*]] } } {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2} test namespace-old-9.18 {when command is deleted, imported commands go away} { namespace eval test_ns_import { rename cmd1 "" } list [info commands cmd1] \ [namespace eval test_ns_import_use {info commands cmd1}] } {{} {}} test namespace-old-9.19 {when namesp is deleted, all imported commands go away} { namespace delete test_ns_import test_ns_import2 list [info commands cmd*] \ [info commands ncmd*] \ [namespace eval test_ns_import_use {info commands cmd*}] \ [namespace eval test_ns_import_use {info commands ncmd*}] \ } {{} {} {} {}} # ----------------------------------------------------------------------- # TEST: scoped values # ----------------------------------------------------------------------- test namespace-old-10.1 {define namespace for scope test} { namespace eval test_ns_inscope { variable x "x-value" proc show {args} { return "show: $args" } proc do {args} { return [eval $args] } list [set x] [show test] } } {x-value {show: test}} test namespace-old-10.2 {command "namespace code" requires one argument} { list [catch {namespace code} msg] $msg } {1 {wrong # args: should be "namespace code arg"}} test namespace-old-10.3 {command "namespace code" requires one argument} { list [catch {namespace code first "second arg" third} msg] $msg } {1 {wrong # args: should be "namespace code arg"}} test namespace-old-10.4 {command "namespace code" gets current namesp context} { namespace eval test_ns_inscope { namespace code {"1 2 3" "4 5" 6} } } {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}} test namespace-old-10.5 {with one arg, first "scope" sticks} { set sval [namespace eval test_ns_inscope {namespace code {one two}}] namespace code $sval } {::namespace inscope ::test_ns_inscope {one two}} test namespace-old-10.6 {with many args, each "scope" adds new args} { set sval [namespace eval test_ns_inscope {namespace code {one two}}] namespace code "$sval three" } {::namespace inscope ::test_ns_inscope {one two} three} namespace eval test_ns_inscope { proc show {args} { return "show: $args" } } test namespace-old-10.7 {scoped commands work with eval} { set cref [namespace eval test_ns_inscope {namespace code show}] list [eval $cref "a" "b c" "d e f"] } {{show: a b c d e f}} namespace eval test_ns_inscope { variable x "x-value" } test namespace-old-10.8 {scoped commands execute in namespace context} { set cref [namespace eval test_ns_inscope { namespace code {set x "some new value"} }] list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x] } {x-value {some new value} {some new value}} foreach cmd [info commands test_ns_*] { rename $cmd "" } catch {rename cmd {}} catch {rename cmd1 {}} catch {rename cmd2 {}} catch {rename ncmd {}} catch {rename ncmd1 {}} catch {rename ncmd2 {}} catch {unset cref} catch {unset trigger} catch {unset trigger2} catch {unset sval} catch {unset msg} catch {unset x} catch {unset test_ns_var_global} catch {unset cmd} eval namespace delete [namespace children :: test_ns_*] # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/namespace.test0000644000175000017500000034103414554262142015646 0ustar sergeisergei# Functionality covered: this file contains a collection of tests for the # procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic # support for namespaces. Other namespace-related tests appear in # variable.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint memory [llength [info commands memory]] ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # # REMARK: the tests for 'namespace upvar' are not done here. They are to be # found in the file 'upvar.test'. # # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} proc fq {ns} { if {[string match ::* $ns]} {return $ns} set current [uplevel 1 {namespace current}] return [string trimright $current :]::[string trimleft $ns :] } test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} { namespace children :: test_ns_* } {} catch {unset l} test namespace-2.1 {Tcl_GetCurrentNamespace} { list [namespace current] [namespace eval {} {namespace current}] \ [namespace eval {} {namespace current}] } {:: :: ::} test namespace-2.2 {Tcl_GetCurrentNamespace} { set l {} lappend l [namespace current] namespace eval test_ns_1 { lappend l [namespace current] namespace eval foo { lappend l [namespace current] } } lappend l [namespace current] } {:: ::test_ns_1 ::test_ns_1::foo ::} test namespace-3.1 {Tcl_GetGlobalNamespace} { namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } } # namespace children uses Tcl_GetGlobalNamespace namespace eval test_ns_1 {namespace children foo b*} } {::test_ns_1::foo::bar} test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} { namespace eval test_ns_1 { variable v 123 proc p {} { variable v return $v } } test_ns_1::p ;# does Tcl_PushCallFrame to push p's namespace } {123} test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} { namespace eval test_ns_1::baz {} ;# does Tcl_PushCallFrame to create baz proc test_ns_1::baz::p {} { variable v set v 789 set v} test_ns_1::baz::p } {789} test namespace-5.1 {Tcl_PopCallFrame, no vars} { namespace eval test_ns_1::blodge {} ;# pushes then pops frame } {} test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} -setup { namespace eval test_ns_1 {} } -body { proc test_ns_1::r {} { set a 123 } test_ns_1::r ;# pushes then pop's r's frame } -result {123} test namespace-6.1 {Tcl_CreateNamespace} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [lsort [namespace children :: test_ns_*]] \ [namespace eval test_ns_1 {namespace current}] \ [namespace eval test_ns_2 {namespace current}] \ [namespace eval ::test_ns_3 {namespace current}] \ [namespace eval ::test_ns_4 \ {namespace eval foo {namespace current}}] \ [namespace eval ::test_ns_5 \ {namespace eval ::test_ns_6 {namespace current}}] \ [lsort [namespace children :: test_ns_*]] } {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}} test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} { list [namespace eval :::test_ns_1::::foo {namespace current}] \ [namespace eval test_ns_2:::::foo {namespace current}] } {::test_ns_1::foo ::test_ns_2::foo} test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg } {0 ::test_ns_7} test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1:: { namespace eval test_ns_2:: {} namespace eval test_ns_3:: {} } lsort [namespace children ::test_ns_1] } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}] test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} { set trigger { namespace eval test_ns_2 {namespace current} } set l {} lappend l [namespace eval test_ns_1 $trigger] namespace eval test_ns_1::test_ns_2 {} lappend l [namespace eval test_ns_1 $trigger] } {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2} test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { proc p {} { namespace delete [namespace current] return [namespace current] } } list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg } {::test_ns_1 1 {invalid command name "test_ns_1::p"}} test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} { namespace eval test_ns_2 { proc p {} { return [namespace current] } } list [test_ns_2::p] [namespace delete test_ns_2] } {::test_ns_2 {}} test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} { # [Bug 1355942] namespace eval test_ns_2 { set x 1 trace add variable x unset "namespace delete [namespace current];#" namespace delete [namespace current] } } {} test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} { # [Bug 1355942] namespace eval test_ns_2 { proc x {} {} trace add command x delete "namespace delete [namespace current];#" namespace delete [namespace current] } } {} test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} { # [Bug 1355942] namespace eval test_ns_2 { set x 1 trace add variable x unset "namespace delete [namespace current];#" } namespace delete test_ns_2 } {} test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} { # [Bug 1355942] namespace eval test_ns_2 { proc x {} {} trace add command x delete "namespace delete [namespace current];#" } namespace delete test_ns_2 } {} test namespace-7.7 {Bug 1655305} -setup { interp create child # Can't invoke through the ensemble, since deleting the global namespace # (indirectly, via deleting ::tcl) deletes the ensemble. child eval {rename ::tcl::info::commands ::infocommands} child hide infocommands child eval { proc foo {} { namespace delete :: } } } -body { child eval foo child invokehidden infocommands } -cleanup { interp delete child } -result {} test namespace-7.8 {Bug ba1419303b4c} -setup { namespace eval ns1 { namespace ensemble create } trace add command ns1 delete { namespace delete ns1 } } -body { # No segmentation fault given --enable-symbols=mem. namespace delete ns1 } -result {} test namespace-8.1 {TclTeardownNamespace, delete global namespace} { catch {interp delete test_interp} interp create test_interp interp eval test_interp { namespace eval test_ns_1 { namespace export p proc p {} { return [namespace current] } } namespace eval test_ns_2 { namespace import ::test_ns_1::p variable v 27 proc q {} { variable v return "[p] $v" } } set x [test_ns_2::q] catch {set xxxx} } list [interp eval test_interp {test_ns_2::q}] \ [interp eval test_interp {namespace delete ::}] \ [catch {interp eval test_interp {set a 123}} msg] $msg \ [interp delete test_interp] } {{::test_ns_1 27} {} 1 {invalid command name "set"} {}} test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} list [namespace children test_ns_1] \ [namespace delete test_ns_1::test_ns_2] \ [namespace children test_ns_1] } {::test_ns_1::test_ns_2 {} {}} test namespace-8.3 {TclTeardownNamespace, delete child namespaces} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} list [namespace children test_ns_1] \ [namespace delete test_ns_1::test_ns_2] \ [namespace children test_ns_1] \ [catch {namespace children test_ns_1::test_ns_2} msg] $msg \ [info commands test_ns_1::test_ns_2::test_ns_3a::*] } {::test_ns_1::test_ns_2 {} {} 1 {namespace "test_ns_1::test_ns_2" not found in "::"} {}} test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 cmd2 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_import { namespace import ::test_ns_export::* proc p {} {return foo} } list [lsort [info commands test_ns_import::*]] \ [namespace delete test_ns_export] \ [info commands test_ns_import::*] } [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p] test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} { interp create child child eval {trace add execution error leave {namespace delete :: ;#}} catch {child eval error foo bar baz} interp delete child set ::errorInfo } {bar invoked from within "child eval error foo bar baz"} test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} { interp create child child eval {trace add variable errorCode write {namespace delete :: ;#}} catch {child eval error foo bar baz} interp delete child set ::errorInfo } {bar invoked from within "child eval error foo bar baz"} test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} { interp create child child eval {trace add execution error leave {namespace delete :: ;#}} catch {child eval error foo bar baz} interp delete child set ::errorCode } baz test namespace-9.1 {Tcl_Import, empty import pattern} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg } {1 {empty import pattern}} test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} { list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg } {1 {unknown namespace in import pattern "fred::x"}} test namespace-9.3 {Tcl_Import, import ns == export ns} { list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg } {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}} test namespace-9.4 {Tcl_Import, simple import} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_import { namespace import ::test_ns_export::* proc p {} {return [cmd1 123]} } test_ns_import::p } {cmd1: 123} test namespace-9.5 {Tcl_Import, RFE 1230597} -setup { namespace eval test_ns_import {} namespace eval test_ns_export {} } -body { list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg } -result {0 {}} test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} -setup { namespace eval test_ns_import {} namespace eval ::test_ns_export { proc cmd1 {args} {return "cmd1: $args"} namespace export cmd1 } } -body { namespace eval test_ns_import { namespace import -force ::test_ns_export::* cmd1 555 } } -result {cmd1: 555} test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} } namespace eval test_ns_import { namespace import -force ::test_ns_export::* } list [test_ns_import::cmd1 a b c] \ [test_ns_export::cmd1 d e f] \ [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \ [namespace origin test_ns_import::cmd1] \ [namespace origin test_ns_export::cmd1] \ [test_ns_import::cmd1 g h i] \ [test_ns_export::cmd1 j k l] } {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}} test namespace-9.8 {Tcl_Import: Bug 1017299} -setup { namespace eval one { namespace export cmd proc cmd {} {} } namespace eval two { namespace export cmd proc other args {} } namespace eval two \ [list namespace import [namespace current]::one::cmd] namespace eval three \ [list namespace import [namespace current]::two::cmd] namespace eval three { rename cmd other namespace export other } } -body { namespace eval two [list namespace import -force \ [namespace current]::three::other] namespace origin two::other } -cleanup { namespace delete one two three } -match glob -result *::one::cmd test namespace-9.9 {Tcl_Import: Bug 1017299} -setup { namespace eval one { namespace export cmd proc cmd {} {} } namespace eval two namespace export cmd namespace eval two \ [list namespace import [namespace current]::one::cmd] namespace eval three namespace export cmd namespace eval three \ [list namespace import [namespace current]::two::cmd] } -body { namespace eval two [list namespace import -force \ [namespace current]::three::cmd] namespace origin two::cmd } -cleanup { namespace delete one two three } -returnCodes error -match glob -result {import pattern * would create a loop*} test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace forget xyzzy::*} msg] $msg } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}} test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} { namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_import { namespace forget ::test_ns_export::wombat } } {} test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} -setup { namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } } -body { namespace eval test_ns_import { namespace import ::test_ns_export::* proc p {} {return [cmd1 123]} set l {} lappend l [lsort [info commands ::test_ns_import::*]] namespace forget ::test_ns_export::cmd1 lappend l [info commands ::test_ns_import::*] lappend l [catch {cmd1 777} msg] $msg } } -result [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}] test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval unrelated { proc cmd {} {} } namespace eval my \ [list namespace import [namespace current]::origin::cmd] } -body { namespace eval my \ [list namespace forget [namespace current]::unrelated::cmd] my::cmd } -cleanup { namespace delete origin unrelated my } test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval my \ [list namespace import [namespace current]::origin::cmd] namespace eval my rename cmd newname } -body { namespace eval my \ [list namespace forget [namespace current]::origin::cmd] my::newname } -cleanup { namespace delete origin my } -returnCodes error -match glob -result * test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval my \ [list namespace import [namespace current]::origin::cmd] namespace eval your {} namespace eval my \ [list rename cmd [namespace current]::your::newname] } -body { namespace eval your namespace forget newname your::newname } -cleanup { namespace delete origin my your } -returnCodes error -match glob -result * test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval link namespace export cmd namespace eval link \ [list namespace import [namespace current]::origin::cmd] namespace eval link2 namespace export cmd namespace eval link2 \ [list namespace import [namespace current]::link::cmd] namespace eval my \ [list namespace import [namespace current]::link2::cmd] } -body { namespace eval my \ [list namespace forget [namespace current]::origin::cmd] my::cmd } -cleanup { namespace delete origin link link2 my } -returnCodes error -match glob -result * test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval link namespace export cmd namespace eval link \ [list namespace import [namespace current]::origin::cmd] namespace eval link2 namespace export cmd namespace eval link2 \ [list namespace import [namespace current]::link::cmd] namespace eval my \ [list namespace import [namespace current]::link2::cmd] } -body { namespace eval my \ [list namespace forget [namespace current]::link::cmd] my::cmd } -cleanup { namespace delete origin link link2 my } test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval link namespace export cmd namespace eval link \ [list namespace import [namespace current]::origin::cmd] namespace eval link2 namespace export cmd namespace eval link2 \ [list namespace import [namespace current]::link::cmd] namespace eval my \ [list namespace import [namespace current]::link2::cmd] } -body { namespace eval my \ [list namespace forget [namespace current]::link2::cmd] my::cmd } -cleanup { namespace delete origin link link2 my } -returnCodes error -match glob -result * test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} } list [namespace origin set] [namespace origin test_ns_export::cmd1] } -result {::set ::test_ns_export::cmd1} test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} } } -body { namespace eval test_ns_import1 { namespace import ::test_ns_export::* namespace export * proc p {} {namespace origin cmd1} } list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1] } -result {::test_ns_export::cmd1 ::test_ns_export::cmd1} test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} } namespace eval test_ns_import1 { namespace import ::test_ns_export::* namespace export * proc p {} {namespace origin cmd1} } } -body { namespace eval test_ns_import2 { namespace import ::test_ns_import1::* proc q {} {return [cmd1 123]} } list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1] } -result {{cmd1: 123} ::test_ns_export::cmd1} test namespace-12.1 {InvokeImportedCmd} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {namespace current} } namespace eval test_ns_import { namespace import ::test_ns_export::* } list [test_ns_import::cmd1] } {::test_ns_export} test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {namespace current} } namespace eval test_ns_import { namespace import ::test_ns_export::* } } -body { namespace eval test_ns_import { set l {} lappend l [info commands ::test_ns_import::*] namespace forget ::test_ns_export::cmd1 lappend l [info commands ::test_ns_import::*] } } -result {::test_ns_import::cmd1 {}} test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} { # Will panic if still buggy namespace eval src {namespace export foo; proc foo {} {}} namespace eval dst {namespace import [namespace parent]::src::foo} trace add command src::foo delete \ "[list namespace delete [namespace current]::dst] ;#" proc src::foo {} {} namespace delete src } {} test namespace-14.1 {TclGetNamespaceForQualName, absolute names} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} variable v 10 namespace eval test_ns_1::test_ns_2 { variable v 20 } namespace eval test_ns_2 { variable v 30 } } -body { namespace eval test_ns_1 { list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \ [lsort [namespace children :: test_ns_*]] } } -result [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]] test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} variable v 10 namespace eval test_ns_1::test_ns_2 { variable v 20 } namespace eval test_ns_2 { variable v 30 } } -body { namespace eval test_ns_1 { list [catch {set ::test_ns_777::v} msg] $msg \ [catch {namespace children test_ns_777} msg] $msg } } -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}} test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} variable v 10 namespace eval test_ns_1::test_ns_2 { variable v 20 } namespace eval test_ns_2 { variable v 30 } } -body { namespace eval test_ns_1 { list $v $test_ns_2::v } } -result {10 20} test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval test_ns_1::test_ns_2 { namespace eval foo {} } namespace eval test_ns_1 { list [namespace children test_ns_2] \ [catch {namespace children test_ns_1} msg] $msg } } {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}} test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval ::test_ns_2 { namespace eval bar {} } namespace eval test_ns_1 { list [catch {namespace delete test_ns_2::bar} msg] $msg } } {1 {unknown namespace "test_ns_2::bar" in namespace delete command}} test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval test_ns_1::test_ns_2 { namespace eval foo {} } namespace eval test_ns_1 { list [namespace children test_ns_2] \ [catch {namespace children test_ns_1} msg] $msg } } {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}} test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup { namespace eval test_ns_1::test_ns_2::foo {} } -body { namespace children test_ns_1::: } -result {::test_ns_1::test_ns_2} test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup { namespace eval test_ns_1::test_ns_2::foo {} } -body { namespace children :::test_ns_1:::::test_ns_2::: } -result {::test_ns_1::test_ns_2::foo} test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} { set l {} lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg namespace eval test_ns_1::test_ns_2 {variable {} 2525} lappend l [set test_ns_1::test_ns_2::] } {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525} test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup { namespace eval test_ns_1::test_ns_2::foo {} unset -nocomplain test_ns_1::test_ns_2:: set l {} } -body { lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg set test_ns_1::test_ns_2:: 314159 lappend l [set test_ns_1::test_ns_2::] } -result {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159} test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} -setup { namespace eval test_ns_1::test_ns_2::foo {} catch {rename test_ns_1::test_ns_2:: {}} set l {} } -body { lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"} lappend l [test_ns_1::test_ns_2:: hello] } -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { variable {} set test_ns_1::(x) y } set test_ns_1::(x) } -result y test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -returnCodes error -body { namespace eval test_ns_1 { proc {} {} {} namespace eval {} {} {} } } -result {can't create namespace "": only global namespace can have empty name} test namespace-15.1 {Tcl_FindNamespace, absolute name found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_delete { namespace eval test_ns_delete2 {} proc cmd {args} {namespace current} } list [namespace delete ::test_ns_delete::test_ns_delete2] \ [namespace children ::test_ns_delete] } -result {{} {}} test namespace-15.2 {Tcl_FindNamespace, absolute name not found} -body { namespace delete ::test_ns_delete::test_ns_delete2 } -returnCodes error -result {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command} test namespace-15.3 {Tcl_FindNamespace, relative name found} { namespace eval test_ns_delete { namespace eval test_ns_delete2 {} namespace eval test_ns_delete3 {} list [namespace delete test_ns_delete2] \ [namespace children [namespace current]] } } {{} ::test_ns_delete::test_ns_delete3} test namespace-15.4 {Tcl_FindNamespace, relative name not found} { namespace eval test_ns_delete2 {} namespace eval test_ns_delete { list [catch {namespace delete test_ns_delete2} msg] $msg } } {1 {unknown namespace "test_ns_delete2" in namespace delete command}} test namespace-16.1 {Tcl_FindCommand, absolute name found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { proc cmd {args} {return "[namespace current]::cmd: $args"} variable v "::test_ns_1::cmd" eval $v one } } -result {::test_ns_1::cmd: one} test namespace-16.2 {Tcl_FindCommand, absolute name found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { proc cmd {args} {return "[namespace current]::cmd: $args"} variable v "::test_ns_1::cmd" } } -body { eval $test_ns_1::v two } -result {::test_ns_1::cmd: two} test namespace-16.3 {Tcl_FindCommand, absolute name not found} { namespace eval test_ns_1 { variable v2 "::test_ns_1::ladidah" list [catch {eval $v2} msg] $msg } } {1 {invalid command name "::test_ns_1::ladidah"}} # save the "unknown" proc, which is redefined by the following two tests catch {rename unknown unknown.old} proc unknown {args} { return "unknown: $args" } test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} { ::test_ns_1::foobar x y z } {unknown: ::test_ns_1::foobar x y z} test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} { ::foobar 1 2 3 4 5 } {unknown: ::foobar 1 2 3 4 5} test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} { test_ns_1::foobar x y z } {unknown: test_ns_1::foobar x y z} test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} { foobar 1 2 3 4 5 } {unknown: foobar 1 2 3 4 5} # restore the "unknown" proc saved previously catch {rename unknown {}} catch {rename unknown.old unknown} test namespace-16.8 {Tcl_FindCommand, relative name found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { proc cmd {args} {return "[namespace current]::cmd: $args"} } } -body { namespace eval test_ns_1 { cmd a b c } } -result {::test_ns_1::cmd: a b c} test namespace-16.9 {Tcl_FindCommand, relative name found} -body { proc cmd2 {args} {return "[namespace current]::cmd2: $args"} namespace eval test_ns_1 { cmd2 a b c } } -cleanup { catch {rename cmd2 {}} } -result {::::cmd2: a b c} test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} -body { proc cmd2 {args} {return "[namespace current]::cmd2: $args"} namespace eval test_ns_1 { proc cmd2 {args} { return "[namespace current]::cmd2 in test_ns_1: $args" } namespace eval test_ns_12 { cmd2 a b c } } } -cleanup { catch {rename cmd2 {}} } -result {::::cmd2: a b c} test namespace-16.11 {Tcl_FindCommand, relative name not found} -body { namespace eval test_ns_1 { cmd3 a b c } } -returnCodes error -result {invalid command name "cmd3"} unset -nocomplain x test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { set x 314159 namespace eval test_ns_1 { set ::x } } -result {314159} variable ::x 314159 test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} { namespace eval test_ns_1 { variable x 777 set ::test_ns_1::x } } {777} test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} { namespace eval test_ns_1 { namespace eval test_ns_2 { variable x 1111 } set ::test_ns_1::test_ns_2::x } } {1111} test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} -body { namespace eval test_ns_1 { namespace eval test_ns_2 { variable x 1111 } set ::test_ns_1::test_ns_2::y } } -returnCodes error -result {can't read "::test_ns_1::test_ns_2::y": no such variable} test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} -setup { namespace eval ::test_ns_1::test_ns_2 {} } -body { namespace eval test_ns_1 { namespace eval test_ns_3 { variable ::test_ns_1::test_ns_2::x 2222 } } set ::test_ns_1::test_ns_2::x } -result {2222} test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup { namespace eval test_ns_1 { variable x 777 } } -body { namespace eval test_ns_1 { set x } } -result {777} test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} { namespace eval test_ns_1 { variable x 777 unset x set x ;# must be global x now } } {314159} test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body { namespace eval test_ns_1 { set wuzzat } } -returnCodes error -result {can't read "wuzzat": no such variable} test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} { namespace eval test_ns_1 { variable a hello } set test_ns_1::a } {hello} test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup { namespace eval test_ns_1 {} } -body { proc test_ns {} { set ::test_ns_1::a 0 } test_ns rename test_ns {} namespace eval test_ns_1 unset a set a 0 namespace eval test_ns_1 set a 1 namespace delete test_ns_1 return $a } -result 1 catch {unset a} catch {unset x} catch {unset l} catch {rename foo {}} test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { proc foo {} {return "global foo"} namespace eval test_ns_1 { proc trigger {} { return [foo] } } set l "" lappend l [test_ns_1::trigger] namespace eval test_ns_1 { # force invalidation of cached ref to "foo" in proc trigger proc foo {} {return "foo in test_ns_1"} } lappend l [test_ns_1::trigger] } -result {{global foo} {foo in test_ns_1}} test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} { namespace eval test_ns_2 { proc foo {} {return "foo in ::test_ns_2"} } namespace eval test_ns_1 { namespace eval test_ns_2 {} proc trigger {} { return [test_ns_2::foo] } } set l "" lappend l [test_ns_1::trigger] namespace eval test_ns_1 { namespace eval test_ns_2 { # force invalidation of cached ref to "foo" in proc trigger proc foo {} {return "foo in ::test_ns_1::test_ns_2"} } } lappend l [test_ns_1::trigger] } {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}} catch {unset l} catch {rename foo {}} test namespace-19.1 {GetNamespaceFromObj, global name found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1::test_ns_2 {} namespace children ::test_ns_1 } -result {::test_ns_1::test_ns_2} test namespace-19.2 {GetNamespaceFromObj, relative name found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} } -body { namespace eval test_ns_1 { namespace children test_ns_2 } } -result {} test namespace-19.3 {GetNamespaceFromObj, name not found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { namespace children test_ns_99 } } -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"} test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} } -body { namespace eval test_ns_1 { proc foo {} { return [namespace children test_ns_2] } list [catch {namespace children test_ns_99} msg] $msg } set l {} lappend l [test_ns_1::foo] namespace delete test_ns_1::test_ns_2 namespace eval test_ns_1::test_ns_2::test_ns_3 {} lappend l [test_ns_1::foo] } -result {{} ::test_ns_1::test_ns_2::test_ns_3} test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace} msg] $msg } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body { namespace wombat {} } -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *} test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { namespace ch :: test_ns_* } {} test namespace-21.1 {NamespaceChildrenCmd, no args} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1::test_ns_2 {} expr {"::test_ns_1" in [namespace children]} } -result {1} test namespace-21.2 {NamespaceChildrenCmd, no args} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} } -body { namespace eval test_ns_1 { namespace children } } -result {::test_ns_1::test_ns_2} test namespace-21.3 {NamespaceChildrenCmd, ns name given} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} } -body { namespace children ::test_ns_1 } -result {::test_ns_1::test_ns_2} test namespace-21.4 {NamespaceChildrenCmd, ns name given} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} } -body { namespace eval test_ns_1 { namespace children test_ns_2 } } -result {} test namespace-21.5 {NamespaceChildrenCmd, too many args} { namespace eval test_ns_1 { list [catch {namespace children test_ns_2 xxx yyy} msg] $msg } } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}} test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} { namespace eval test_ns_1::test_ns_foo {} namespace children test_ns_1 *f* } {::test_ns_1::test_ns_foo} test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} } -body { namespace eval test_ns_1::test_ns_foo {} lsort [namespace children test_ns_1 test*] } -result {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo} test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} { namespace eval test_ns_1 {} namespace children [namespace current] [fq test_ns_1] } [fq test_ns_1] test namespace-22.1 {NamespaceCodeCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace code} msg] $msg \ [catch {namespace code xxx yyy} msg] $msg } {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}} test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} { namespace eval test_ns_1 { proc cmd {} {return "test_ns_1::cmd"} } namespace code {::namespace inscope ::test_ns_1 cmd} } {::namespace inscope ::test_ns_1 cmd} test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} { namespace code {namespace inscope ::test_ns_1 cmd} } {::namespace inscope :: {namespace inscope ::test_ns_1 cmd}} test namespace-22.4 {NamespaceCodeCmd, in :: namespace} { namespace code unknown } {::namespace inscope :: unknown} test namespace-22.5 {NamespaceCodeCmd, in other namespace} { namespace eval test_ns_1 { namespace code cmd } } {::namespace inscope ::test_ns_1 cmd} test namespace-22.6 {NamespaceCodeCmd, in other namespace} { namespace eval test_ns_1 { variable v 42 } namespace eval test_ns_2 { proc namespace args {} } namespace eval test_ns_2 [namespace eval test_ns_1 { namespace code {set v} }] } {42} test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} { namespace eval demo { proc namespace args {puts $args} ::namespace code {namespace inscope foo} } } [list ::namespace inscope [fq demo] {namespace inscope foo}] test namespace-23.1 {NamespaceCurrentCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace current xxx} msg] $msg \ [catch {namespace current xxx yyy} msg] $msg } {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}} test namespace-23.2 {NamespaceCurrentCmd, at global level} { namespace current } {::} test namespace-23.3 {NamespaceCurrentCmd, in nested ns} { namespace eval test_ns_1::test_ns_2 { namespace current } } {::test_ns_1::test_ns_2} test namespace-24.1 {NamespaceDeleteCmd, no args} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace delete } {} test namespace-24.2 {NamespaceDeleteCmd, one arg} { namespace eval test_ns_1::test_ns_2 {} namespace delete ::test_ns_1 } {} test namespace-24.3 {NamespaceDeleteCmd, two args} { namespace eval test_ns_1::test_ns_2 {} list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1] } {{} {}} test namespace-24.4 {NamespaceDeleteCmd, unknown ns} { list [catch {namespace delete ::test_ns_foo} msg] $msg } {1 {unknown namespace "::test_ns_foo" in namespace delete command}} test namespace-25.1 {NamespaceEvalCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace eval} msg] $msg } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-25.2 {NamespaceEvalCmd, bad args} -body { namespace test_ns_1 } -returnCodes error -match glob -result {unknown or ambiguous subcommand "test_ns_1": must be *} catch {unset v} test namespace-25.3 {NamespaceEvalCmd, new namespace} { set v 123 namespace eval test_ns_1 { variable v 314159 proc p {} { variable v return $v } } test_ns_1::p } {314159} test namespace-25.4 {NamespaceEvalCmd, existing namespace} -setup { namespace eval test_ns_1 { variable v 314159 proc p {} { variable v return $v } } } -body { namespace eval test_ns_1 { proc q {} {return [expr {[p]+1}]} } test_ns_1::q } -result {314160} test namespace-25.5 {NamespaceEvalCmd, multiple args} -setup { namespace eval test_ns_1 {variable v 314159} } -body { namespace eval test_ns_1 "set" "v" } -result {314159} test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} { list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo } {1 {invalid command name "xxxx"} {invalid command name "xxxx" while executing "xxxx" (in namespace eval "::test_ns_1" script line 1) invoked from within "namespace eval test_ns_1 {xxxx}"}} test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} { list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $::errorInfo } {1 foo {bar (in namespace eval "::test_ns_1" script line 1) invoked from within "namespace eval test_ns_1 {error foo bar baz}"}} test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} { list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $::errorInfo } {1 foo {bar (in namespace eval "::test_ns_1" script line 1) invoked from within "namespace eval test_ns_1 error foo bar baz"}} catch {unset v} test namespace-25.9 {NamespaceEvalCmd, 545325} { namespace eval test_ns_1 info level 0 } {namespace eval test_ns_1 info level 0} test namespace-26.1 {NamespaceExportCmd, no args and new ns} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace export } {} test namespace-26.2 {NamespaceExportCmd, just -clear arg} { namespace export -clear } {} test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} { namespace eval test_ns_1 { list [catch {namespace export ::zzz} msg] $msg } } {1 {invalid export pattern "::zzz": pattern can't specify a namespace}} test namespace-26.4 {NamespaceExportCmd, one pattern} { namespace eval test_ns_1 { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} proc cmd3 {args} {return "cmd3: $args"} proc cmd4 {args} {return "cmd4: $args"} } namespace eval test_ns_2 { namespace import ::test_ns_1::* } list [info commands test_ns_2::*] [test_ns_2::cmd1 hello] } {::test_ns_2::cmd1 {cmd1: hello}} test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} proc cmd3 {args} {return "cmd3: $args"} proc cmd4 {args} {return "cmd4: $args"} namespace export cmd1 cmd3 } } -body { namespace eval test_ns_2 { namespace import -force ::test_ns_1::* } list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello] } -result {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}} test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} proc cmd3 {args} {return "cmd3: $args"} proc cmd4 {args} {return "cmd4: $args"} namespace export cmd1 cmd3 } } -body { namespace eval test_ns_1 { namespace export } } -result {cmd1 cmd3} test namespace-26.7 {NamespaceExportCmd, -clear resets export list} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} proc cmd3 {args} {return "cmd3: $args"} proc cmd4 {args} {return "cmd4: $args"} } } -body { namespace eval test_ns_1 { namespace export cmd1 cmd3 } namespace eval test_ns_2 { namespace import ::test_ns_1::* } namespace eval test_ns_1 { namespace export -clear cmd4 } namespace eval test_ns_2 { namespace import ::test_ns_1::* } list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello] } -result [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}] test namespace-26.8 {NamespaceExportCmd, -clear resets export list} { catch {namespace delete foo} namespace eval foo { namespace export x namespace export -clear } list [namespace eval foo namespace export] [namespace delete foo] } {{} {}} test namespace-27.1 {NamespaceForgetCmd, no args} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace forget } {} test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} { list [catch {namespace forget ::test_ns_1::xxx} msg] $msg } {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}} test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} { namespace eval test_ns_1 { namespace export cmd* proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_2 { namespace import ::test_ns_1::* namespace forget ::test_ns_1::cmd1 } info commands ::test_ns_2::* } {::test_ns_2::cmd2} test namespace-28.1 {NamespaceImportCmd, no args} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval ::test_ns_1 { proc foo {} {} proc bar {} {} proc boo {} {} proc glorp {} {} namespace export foo b* } namespace eval ::test_ns_2 { namespace import ::test_ns_1::* lsort [namespace import] } } -cleanup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -result {bar boo foo} test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} { namespace import -force } {} test namespace-28.3 {NamespaceImportCmd, arg is imported} { namespace eval test_ns_1 { namespace export cmd2 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_2 { namespace import ::test_ns_1::* namespace forget ::test_ns_1::cmd1 } info commands test_ns_2::* } {::test_ns_2::cmd2} test namespace-29.1 {NamespaceInscopeCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace inscope} msg] $msg } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} test namespace-29.2 {NamespaceInscopeCmd, bad args} { list [catch {namespace inscope ::} msg] $msg } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} -body { namespace inscope test_ns_1 {set v} } -returnCodes error -result {namespace "test_ns_1" not found in "::"} test namespace-29.4 {NamespaceInscopeCmd, simple case} { namespace eval test_ns_1 { variable v 747 proc cmd {args} { variable v return "[namespace current]::cmd: v=$v, args=$args" } } namespace inscope test_ns_1 cmd } {::test_ns_1::cmd: v=747, args=} test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} -setup { namespace eval test_ns_1 { variable v 747 proc cmd {args} { variable v return "[namespace current]::cmd: v=$v, args=$args" } } } -body { list [namespace inscope test_ns_1 cmd x y z] \ [namespace eval test_ns_1 [concat cmd [list x y z]]] } -result {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}} test namespace-29.6 {NamespaceInscopeCmd, 1400572} -setup { namespace eval test_ns_1 {} } -body { namespace inscope test_ns_1 {info level 0} } -result {namespace inscope test_ns_1 {info level 0}} test namespace-30.1 {NamespaceOriginCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace origin} msg] $msg } {1 {wrong # args: should be "namespace origin name"}} test namespace-30.2 {NamespaceOriginCmd, bad args} { list [catch {namespace origin x y} msg] $msg } {1 {wrong # args: should be "namespace origin name"}} test namespace-30.3 {NamespaceOriginCmd, command not found} { list [catch {namespace origin fred} msg] $msg } {1 {invalid command name "fred"}} test namespace-30.4 {NamespaceOriginCmd, command isn't imported} { namespace origin set } {::set} test namespace-30.5 {NamespaceOriginCmd, imported command} { namespace eval test_ns_1 { namespace export cmd* proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_2 { namespace export * namespace import ::test_ns_1::* proc p {} {} } namespace eval test_ns_3 { namespace import ::test_ns_2::* list [namespace origin foreach] \ [namespace origin p] \ [namespace origin cmd1] \ [namespace origin ::test_ns_2::cmd2] } } {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2} test namespace-31.1 {NamespaceParentCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace parent a b} msg] $msg } {1 {wrong # args: should be "namespace parent ?name?"}} test namespace-31.2 {NamespaceParentCmd, no args} { namespace parent } {} test namespace-31.3 {NamespaceParentCmd, namespace specified} { namespace eval test_ns_1 { namespace eval test_ns_2 { namespace eval test_ns_3 {} } } list [namespace parent ::] \ [namespace parent test_ns_1::test_ns_2] \ [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}] } {{} ::test_ns_1 ::test_ns_1} test namespace-31.4 {NamespaceParentCmd, bad namespace specified} -body { namespace parent test_ns_1::test_ns_foo } -returnCodes error -result {namespace "test_ns_1::test_ns_foo" not found in "::"} test namespace-32.1 {NamespaceQualifiersCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace qualifiers} msg] $msg } {1 {wrong # args: should be "namespace qualifiers string"}} test namespace-32.2 {NamespaceQualifiersCmd, bad args} { list [catch {namespace qualifiers x y} msg] $msg } {1 {wrong # args: should be "namespace qualifiers string"}} test namespace-32.3 {NamespaceQualifiersCmd, simple name} { namespace qualifiers foo } {} test namespace-32.4 {NamespaceQualifiersCmd, leading ::} { namespace qualifiers ::x::y::z } {::x::y} test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} { namespace qualifiers a::b } {a} test namespace-32.6 {NamespaceQualifiersCmd, :: argument} { namespace qualifiers :: } {} test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} { namespace qualifiers ::::: } {} test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} { namespace qualifiers foo::: } {foo} test namespace-33.1 {NamespaceTailCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace tail} msg] $msg } {1 {wrong # args: should be "namespace tail string"}} test namespace-33.2 {NamespaceTailCmd, bad args} { list [catch {namespace tail x y} msg] $msg } {1 {wrong # args: should be "namespace tail string"}} test namespace-33.3 {NamespaceTailCmd, simple name} { namespace tail foo } {foo} test namespace-33.4 {NamespaceTailCmd, leading ::} { namespace tail ::x::y::z } {z} test namespace-33.5 {NamespaceTailCmd, no leading ::} { namespace tail a::b } {b} test namespace-33.6 {NamespaceTailCmd, :: argument} { namespace tail :: } {} test namespace-33.7 {NamespaceTailCmd, odd number of :s} { namespace tail ::::: } {} test namespace-33.8 {NamespaceTailCmd, odd number of :s} { namespace tail foo::: } {} test namespace-34.1 {NamespaceWhichCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace which} msg] $msg } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} test namespace-34.2 {NamespaceWhichCmd, bad args} { list [catch {namespace which -fred x} msg] $msg } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} { namespace which -command } {} test namespace-34.4 {NamespaceWhichCmd, bad args} { list [catch {namespace which a b} msg] $msg } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} test namespace-34.5 {NamespaceWhichCmd, command lookup} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { namespace export cmd* variable v1 111 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_2 { namespace export * namespace import ::test_ns_1::* variable v2 222 proc p {} {} } } -body { namespace eval test_ns_3 { namespace import ::test_ns_2::* variable v3 333 list [namespace which -command foreach] \ [namespace which -command p] \ [namespace which -command cmd1] \ [namespace which -command ::test_ns_2::cmd2] \ [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg } } -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}} test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { namespace export cmd* proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_2 { namespace export * namespace import ::test_ns_1::* proc p {} {} } namespace eval test_ns_3 { namespace import ::test_ns_2::* } } -body { namespace eval test_ns_3 { list [namespace which foreach] \ [namespace which p] \ [namespace which cmd1] \ [namespace which ::test_ns_2::cmd2] } } -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2} test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { namespace export cmd* proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} } namespace eval test_ns_2 { namespace export * namespace import ::test_ns_1::* variable v2 222 proc p {} {} } namespace eval test_ns_3 { variable v3 333 namespace import ::test_ns_2::* } } -body { namespace eval test_ns_3 { list [namespace which -variable env] \ [namespace which -variable v3] \ [namespace which -variable ::test_ns_2::v2] \ [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg } } -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { proc p {} { namespace delete [namespace current] return [namespace current] } } test_ns_1::p } -result {::test_ns_1} test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} { namespace eval test_ns_1 { proc q {} { return [namespace current] } } list [test_ns_1::q] \ [namespace delete test_ns_1] \ [catch {test_ns_1::q} msg] $msg } {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}} catch {unset x} catch {unset y} test namespace-36.1 {DupNsNameInternalRep} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 {} set x "::test_ns_1" list [namespace parent $x] [set y $x] [namespace parent $y] } {:: ::test_ns_1 ::} catch {unset x} catch {unset y} test namespace-37.1 {SetNsNameFromAny, ns name found} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} namespace eval test_ns_1 { namespace children ::test_ns_1 } } {::test_ns_1::test_ns_2} test namespace-37.2 {SetNsNameFromAny, ns name not found} -body { namespace eval test_ns_1 { namespace children ::test_ns_1::test_ns_foo } } -returnCodes error -result {namespace "::test_ns_1::test_ns_foo" not found} test namespace-38.1 {UpdateStringOfNsName} { catch {namespace delete {*}[namespace children :: test_ns_*]} ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name list [namespace eval {} {namespace current}] \ [namespace eval {} {namespace current}] } {:: ::} test namespace-39.1 {NamespaceExistsCmd} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval ::test_ns_z::test_me { variable foo } list [namespace exists ::] \ [namespace exists ::bogus_namespace] \ [namespace exists ::test_ns_z] \ [namespace exists test_ns_z] \ [namespace exists ::test_ns_z::foo] \ [namespace exists ::test_ns_z::test_me] \ [namespace eval ::test_ns_z { namespace exists ::test_me }] \ [namespace eval ::test_ns_z { namespace exists test_me }] \ [namespace exists :::::test_ns_z] } {1 0 1 1 0 1 0 1 1} test namespace-39.2 {NamespaceExistsCmd error} { list [catch {namespace exists} msg] $msg } {1 {wrong # args: should be "namespace exists name"}} test namespace-39.3 {NamespaceExistsCmd error} { list [catch {namespace exists a b} msg] $msg } {1 {wrong # args: should be "namespace exists name"}} test namespace-40.1 {Ignoring namespace proc "unknown"} -setup { rename unknown _unknown } -body { proc unknown args {return global} namespace eval ns {proc unknown args {return local}} list [namespace eval ns aaa bbb] [namespace eval ns aaa] } -cleanup { rename unknown {} rename _unknown unknown namespace delete ns } -result {global global} test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} { set res {} namespace eval ns { set res {} proc test {} { set ::g 0 } lappend ::res [test] proc set {a b} { ::set a [incr b] } lappend ::res [test] } namespace delete ns set res } {0 1} test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} { set res {} namespace eval ns {} proc ns::a {i} { variable b proc set args {return "New proc is called"} return [set b $i] } ns::a 1 set res [ns::a 2] namespace delete ns set res } {New proc is called} test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} { set res {} namespace eval ns { variable b 0 } proc ns::a {i} { variable b proc set args {return "New proc is called"} return [set b $i] } set res [list [ns::a 1] $ns::b] namespace delete ns set res } {{New proc is called} 0} # Ensembles (TIP#112) test namespace-42.1 {ensembles: basic} { namespace eval ns { namespace export x proc x {} {format 1} namespace ensemble create } list [info command ns] [ns x] [namespace delete ns] [info command ns] } {ns 1 {} {}} test namespace-42.2 {ensembles: basic} { namespace eval ns { namespace export x proc x {} {format 1} namespace ensemble create } rename ns foo list [info command foo] [foo x] [namespace delete ns] [info command foo] } {foo 1 {} {}} test namespace-42.3 {ensembles: basic} { namespace eval ns { namespace export x* proc x1 {} {format 1} proc x2 {} {format 2} namespace ensemble create } set result [list [ns x1] [ns x2]] lappend result [catch {ns x} msg] $msg rename ns {} lappend result [info command ns::x1] namespace delete ns lappend result [info command ns::x1] } {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}} test namespace-42.4 {ensembles: basic} -body { namespace eval ns { namespace export y* proc x1 {} {format 1} proc x2 {} {format 2} namespace ensemble create } list [catch {ns x} msg] $msg } -cleanup { namespace delete ns } -result {1 {unknown subcommand "x": namespace ::ns does not export any commands}} test namespace-42.5 {ensembles: basic} -body { namespace eval ns { namespace export x* proc x1 {} {format 1} proc x2 {} {format 2} proc x3 {} {format 3} namespace ensemble create } list [catch {ns x} msg] $msg } -cleanup { namespace delete ns } -result {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}} test namespace-42.6 {ensembles: nested} -body { namespace eval ns { namespace export x* namespace eval x0 { proc z {} {format 0} namespace export z namespace ensemble create } proc x1 {} {format 1} proc x2 {} {format 2} proc x3 {} {format 3} namespace ensemble create } list [ns x0 z] [ns x1] [ns x2] [ns x3] } -cleanup { namespace delete ns } -result {0 1 2 3} test namespace-42.7 {ensembles: nested} -body { namespace eval ns { namespace export x* namespace eval x0 { proc z {} {list [info level] [info level 1]} namespace export z namespace ensemble create } proc x1 {} {format 1} proc x2 {} {format 2} proc x3 {} {format 3} namespace ensemble create } list [ns x0 z] [ns x1] [ns x2] [ns x3] } -cleanup { namespace delete ns } -result {{1 ::ns::x0::z} 1 2 3} test namespace-42.8 { ensembles: [Bug 1670091], panic due to pointer to a deallocated List struct. } -setup { proc demo args {} variable target [list [namespace which demo] x] proc trial args {variable target; string length $target} trace add execution demo enter [namespace code trial] namespace ensemble create -command foo -map [list bar $target] } -body { foo bar } -cleanup { unset target rename demo {} rename trial {} rename foo {} } -result {} test namespace-42.9 { ensembles: [Bug 4f6a1ebd64], segmentation fault due to pointer to a deallocated List struct. } -setup { namespace eval n {namespace ensemble create} set lst [dict create one ::two] namespace ensemble configure n -subcommands $lst -map $lst } -body { n one } -cleanup { namespace delete n unset -nocomplain lst } -returnCodes error -match glob -result {invalid command name*} test namespace-42.10 { ensembles: [Bug 4f6a1ebd64] segmentation fault due to pointer to a deallocated List struct (this time with duplicate of one in "dict"). } -setup { namespace eval n {namespace ensemble create} set lst [list one ::two one ::three] namespace ensemble configure n -subcommands $lst -map $lst } -body { n one } -cleanup { namespace delete n unset -nocomplain lst } -returnCodes error -match glob -result {invalid command name *three*} test namespace-42.11 { ensembles: prefix matching segmentation fault issue ccc448a6bfd59cbd } -body { namespace eval n1 { namespace ensemble create namespace export * proc p1 args {error success} } # segmentation fault only occurs in the non-byte-compiled path, so avoid # byte compilation set cmd {namespace eva n1 {[namespace parent]::n1 p1}} {*}$cmd } -returnCodes error -result success test namespace-43.1 {ensembles: dict-driven} { namespace eval ns { namespace export x* proc x1 {} {format 1} proc x2 {} {format 2} namespace ensemble create -map {a x1 b x2} } set result [list [catch {ns c} msg] $msg [namespace ensemble exists ns]] rename ns {} lappend result [namespace ensemble exists ns] } {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0} test namespace-43.2 {ensembles: dict-driven} -body { namespace eval ns { namespace export x* proc x1 {args} {list 1 $args} proc x2 {args} {list 2 [llength $args]} namespace ensemble create -map { a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .} } } list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo] } -cleanup { namespace delete ns } -result {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}} set SETUP { namespace eval ns { namespace export a b proc a args {format 1,[llength $args]} proc b args {format 2,[llength $args]} proc c args {format 3,[llength $args]} proc d args {format 4,[llength $args]} namespace ensemble create -subcommands {b c} } } test namespace-43.3 {ensembles: list-driven} -setup $SETUP -body { namespace delete ns } -result {} test namespace-43.4 {ensembles: list-driven} -setup $SETUP -body { ns a foo bar boo spong wibble } -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c} test namespace-43.5 {ensembles: list-driven} -setup $SETUP -body { ns b foo bar boo spong wibble } -cleanup {namespace delete ns} -result 2,5 test namespace-43.6 {ensembles: list-driven} -setup $SETUP -body { ns c foo bar boo spong wibble } -cleanup {namespace delete ns} -result 3,5 test namespace-43.7 {ensembles: list-driven} -setup $SETUP -body { ns d foo bar boo spong wibble } -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c} set SETUP { namespace eval ns { namespace export a b proc a args {format 1,[llength $args]} proc b args {format 2,[llength $args]} proc c args {format 3,[llength $args]} proc d args {format 4,[llength $args]} namespace ensemble create -subcommands {b c} -map {c ::ns::d} } } test namespace-43.8 {ensembles: list-and-map-driven} -setup $SETUP -body { namespace delete ns } -result {} test namespace-43.9 {ensembles: list-and-map-driven} -setup $SETUP -body { ns a foo bar boo spong wibble } -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c} test namespace-43.10 {ensembles: list-and-map-driven} -setup $SETUP -body { ns b foo bar boo spong wibble } -cleanup {namespace delete ns} -result 2,5 test namespace-43.11 {ensembles: list-and-map-driven} -setup $SETUP -body { ns c foo bar boo spong wibble } -cleanup {namespace delete ns} -result 4,5 test namespace-43.12 {ensembles: list-and-map-driven} -setup $SETUP -body { ns d foo bar boo spong wibble } -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c} set SETUP { namespace eval ns { namespace export * proc foo args {format bar} proc spong args {format wibble} namespace ensemble create -prefixes off } } test namespace-43.13 {ensembles: turn off prefixes} -setup $SETUP -body { namespace delete ns } -result {} test namespace-43.14 {ensembles: turn off prefixes} -setup $SETUP -body { ns fo } -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "fo": must be foo, or spong} test namespace-43.15 {ensembles: turn off prefixes} -setup $SETUP -body { ns foo } -cleanup {namespace delete ns} -result bar test namespace-43.16 {ensembles: turn off prefixes} -setup $SETUP -body { ns s } -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "s": must be foo, or spong} test namespace-43.17 {ensembles: turn off prefixes} -setup $SETUP -body { ns spong } -cleanup {namespace delete ns} -result wibble test namespace-44.1 {ensemble: errors} { list [catch {namespace ensemble} msg] $msg } {1 {wrong # args: should be "namespace ensemble subcommand ?arg ...?"}} test namespace-44.2 {ensemble: errors} { list [catch {namespace ensemble ?} msg] $msg } {1 {bad subcommand "?": must be configure, create, or exists}} test namespace-44.3 {ensemble: errors} { namespace eval ns { list [catch {namespace ensemble create -map x} msg] $msg } } {1 {missing value to go with key}} test namespace-44.4 {ensemble: errors} { namespace eval ns { list [catch {namespace ensemble create -map {x {}}} msg] $msg } } {1 {ensemble subcommand implementations must be non-empty lists}} test namespace-44.5 {ensemble: errors} -setup { namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure} } -body { foobar foobarcon } -cleanup { rename foobar {} } -returnCodes error -result {invalid command name "foobarconfigure"} test namespace-44.6 {ensemble: errors} -returnCodes error -body { namespace ensemble create gorp } -result {wrong # args: should be "namespace ensemble create ?option value ...?"} test namespace-45.1 {ensemble: introspection} { namespace eval ns { namespace export x proc x {} {} namespace ensemble create set ::result [namespace ensemble configure ::ns] } namespace delete ns set result } {-map {} -namespace ::ns -parameters {} -prefixes 1 -subcommands {} -unknown {}} test namespace-45.2 {ensemble: introspection} { namespace eval ns { namespace export x proc x {} {} namespace ensemble create -map {A x} set ::result [namespace ensemble configure ::ns -map] } namespace delete ns set result } {A ::ns::x} test namespace-46.1 {ensemble: modification} { namespace eval ns { namespace export x proc x {} {format 123} # Ensemble maps A->x namespace ensemble create -command ns -map {A ::ns::x} set ::result [list [namespace ensemble configure ns -map] [ns A]] # Ensemble maps B->x namespace ensemble configure ns -map {B ::ns::x} lappend ::result [namespace ensemble configure ns -map] [ns B] # Ensemble maps x->x namespace ensemble configure ns -map {} lappend ::result [namespace ensemble configure ns -map] [ns x] } namespace delete ns set result } {{A ::ns::x} 123 {B ::ns::x} 123 {} 123} test namespace-46.2 {ensemble: ensembles really use current export list} { namespace eval ns { namespace export x1 proc x1 {} {format 1} proc x2 {} {format 1} namespace ensemble create } catch {ns ?} msg; set result [list $msg] namespace eval ns {namespace export x*} catch {ns ?} msg; lappend result $msg rename ns::x1 {} catch {ns ?} msg; lappend result $msg namespace delete ns set result } {{unknown or ambiguous subcommand "?": must be x1} {unknown or ambiguous subcommand "?": must be x1, or x2} {unknown or ambiguous subcommand "?": must be x2}} test namespace-46.3 {ensemble: implementation errors} { namespace eval ns { variable count 0 namespace ensemble create -map { a {::lappend ::result} b {::incr ::ns::count} } } set result {} lappend result [catch { ns } msg] $msg ns a [ns b 10] catch {rename p {}} rename ns p p a [p b 3000] lappend result $ns::count namespace delete ns lappend result [info command p] } {1 {wrong # args: should be "ns subcommand ?arg ...?"} 10 3010 3010 {}} test namespace-46.4 {ensemble: implementation errors} { namespace eval ns { namespace ensemble create } set result [info command ns] lappend result [catch {ns ?} msg] $msg namespace delete ns set result } {ns 1 {unknown subcommand "?": namespace ::ns does not export any commands}} test namespace-46.5 {ensemble: implementation errors} { namespace eval ns { namespace ensemble create -map {makeError ::error} } list [catch {ns makeError "an error happened"} msg] $msg $::errorInfo [namespace delete ns] } {1 {an error happened} {an error happened while executing "ns makeError "an error happened""} {}} test namespace-46.6 {ensemble: implementation renames/deletes itself} { namespace eval ns { namespace ensemble create -map {to ::rename} } ns to ns foo foo to foo bar bar to bar spong spong to spong {} namespace delete ns } {} test namespace-46.7 {ensemble: implementation deletes its namespace} { namespace eval ns { namespace ensemble create -map {kill {::namespace delete}} } ns kill ns } {} test namespace-46.8 {ensemble: implementation deletes its namespace} { namespace eval ns { namespace export * proc foo {} { variable x 1 bar # Tricky; what is the correct return value anyway? info exist x } proc bar {} { namespace delete [namespace current] } namespace ensemble create } list [ns foo] [info exist ns::x] } {1 0} test namespace-46.9 {ensemble: configuring really configures things} { namespace eval ns { namespace ensemble create -map {a a} -prefixes 0 } set result [list [catch {ns x} msg] $msg] namespace ensemble configure ns -map {b b} lappend result [catch {ns x} msg] $msg namespace delete ns set result } {1 {unknown subcommand "x": must be a} 1 {unknown subcommand "x": must be b}} test namespace-47.1 {ensemble: unknown handler} { set log {} namespace eval ns { namespace export {[a-z]*} proc Magic {ensemble subcmd args} { global log if {[string match {[a-z]*} $subcmd]} { lappend log "making $subcmd" proc $subcmd args { global log lappend log "running [info level 0]" llength $args } } else { lappend log "unknown $subcmd - args = $args" return -code error \ "unknown or protected subcommand \"$subcmd\"" } } namespace ensemble create -unknown ::ns::Magic } set result {} lappend result [catch {ns a b c} msg] $msg lappend result [catch {ns a b c} msg] $msg lappend result [catch {ns b c d} msg] $msg lappend result [catch {ns c d e} msg] $msg lappend result [catch {ns Magic foo bar spong wibble} msg] $msg list $result [lsort [info commands ::ns::*]] $log [namespace delete ns] } {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}} test namespace-47.2 {ensemble: unknown handler} { namespace eval ns { namespace export {[a-z]*} proc Magic {ensemble subcmd args} { error foobar } namespace ensemble create -unknown ::ns::Magic } list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns] } {1 foobar {foobar while executing "error foobar" (procedure "::ns::Magic" line 2) invoked from within "::ns::Magic ::ns spong" (ensemble unknown subcommand handler) invoked from within "ns spong"} {}} test namespace-47.3 {ensemble: unknown handler} { namespace eval ns { variable count 0 namespace export {[a-z]*} proc a {} {} proc c {} {} proc Magic {ensemble subcmd args} { variable count incr count proc b {} {} } namespace ensemble create -unknown ::ns::Magic } list [catch {ns spong} msg] $msg $ns::count [namespace delete ns] } {1 {unknown or ambiguous subcommand "spong": must be a, b, or c} 1 {}} test namespace-47.4 {ensemble: unknown handler} { namespace eval ns { namespace export {[a-z]*} proc Magic {ensemble subcmd args} { return -code break } namespace ensemble create -unknown ::ns::Magic } list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns] } {1 {unknown subcommand handler returned bad code: break} {unknown subcommand handler returned bad code: break result of ensemble unknown subcommand handler: ::ns::Magic ::ns spong invoked from within "ns spong"} {}} test namespace-47.5 {ensemble: unknown handler} { namespace ensemble create -command foo -unknown bar proc bar {args} { global result target lappend result "LOG $args" return $target } set result {} set target {} lappend result [catch {foo bar} msg] $msg set target {lappend result boo hoo} lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo] rename foo {} set result } {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -parameters {} -prefixes 1 -subcommands {} -unknown bar}} test namespace-47.6 {ensemble: unknown handler} { namespace ensemble create -command foo -unknown bar proc bar {args} { return "\{" } set result [list [catch {foo bar} msg] $msg $::errorInfo] rename foo {} set result } {1 {unmatched open brace in list} {unmatched open brace in list while parsing result of ensemble unknown subcommand handler invoked from within "foo bar"}} test namespace-47.7 {ensemble: unknown handler, commands with spaces} { namespace ensemble create -command foo -unknown bar proc bar {args} { list ::set ::x [join $args |] } set result [foo {one two three}] rename foo {} set result } {::foo|one two three} test namespace-47.8 {ensemble: unknown handler, commands with spaces} { namespace ensemble create -command foo -unknown {bar boo} proc bar {args} { list ::set ::x [join $args |] } set result [foo {one two three}] rename foo {} set result } {boo|::foo|one two three} test namespace-48.1 {ensembles and namespace import: unknown handler} { namespace eval foo { namespace export bar namespace ensemble create -command bar -unknown ::foo::u -subcomm x proc u {ens args} { global result lappend result $ens $args namespace ensemble config $ens -subcommand {x y} } proc u2 {ens args} { global result lappend result $ens $args namespace ensemble config ::bar -subcommand {x y z} } proc x args { global result lappend result XXX $args } proc y args { global result lappend result YYY $args } proc z args { global result lappend result ZZZ $args } } namespace import -force foo::bar set result [list [namespace ensemble config bar]] bar x 123 bar y 456 namespace ensemble config bar -unknown ::foo::u2 bar z 789 namespace delete foo set result } {{-map {} -namespace ::foo -parameters {} -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789} test namespace-48.2 {ensembles and namespace import: exists} { namespace eval foo { namespace ensemble create -command ::foo::bar namespace export bar } set result [namespace ensemble exist foo::bar] lappend result [namespace ensemble exist bar] namespace import foo::bar lappend result [namespace ensemble exist bar] rename foo::bar foo::bar2 lappend result [namespace ensemble exist bar] \ [namespace ensemble exist spong] rename bar spong lappend result [namespace ensemble exist bar] \ [namespace ensemble exist spong] rename foo::bar2 {} lappend result [namespace ensemble exist spong] namespace delete foo set result } {1 0 1 1 0 0 1 0} test namespace-48.3 {ensembles and namespace import: config} { catch {rename spong {}} namespace eval foo { namespace ensemble create -command ::foo::bar namespace export bar boo proc boo {} {} } namespace import foo::bar foo::boo set result [namespace ensemble config bar -namespace] lappend result [catch {namespace ensemble config boo} msg] $msg lappend result [catch {namespace ensemble config spong} msg] $msg namespace delete foo set result } {::foo 1 {"boo" is not an ensemble command} 1 {unknown command "spong"}} test namespace-49.1 {ensemble subcommand caching} -body { namespace ens cre -command a -map {b {lappend result 1}} namespace ens cre -command c -map {b {lappend result 2}} proc x {} {a b; c b; a b; c b} x } -result {1 2 1 2} -cleanup { rename a {} rename c {} rename x {} } test namespace-49.2 {strange delete crash} -body { namespace eval foo {namespace ensemble create -command ::bar} trace add command ::bar delete DeleteTrace proc DeleteTrace {old new op} { trace remove command ::bar delete DeleteTrace rename $old "" # This next line caused a bus error in [Bug 1220058] namespace delete foo } rename ::bar "" } -result "" -cleanup { rename DeleteTrace "" } test namespace-50.1 {ensembles affect proc arguments error messages} -body { namespace ens cre -command a -map {b {bb foo}} proc bb {c d {e f} args} {list $c $args} a b } -returnCodes error -result "wrong # args: should be \"a b d ?e? ?arg ...?\"" -cleanup { rename a {} rename bb {} } test namespace-50.2 {ensembles affect WrongNumArgs error messages} -body { namespace ens cre -command a -map {b {string is}} a b boolean } -returnCodes error -result "wrong # args: should be \"a b class ?-strict? ?-failindex var? str\"" -cleanup { rename a {} } test namespace-50.3 {chained ensembles affect error messages} -body { namespace ens cre -command a -map {b c} namespace ens cre -command c -map {d e} proc e f {} a b d } -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup { rename a {} rename c {} } test namespace-50.4 {chained ensembles affect error messages} -body { namespace ens cre -command a -map {b {c d}} namespace ens cre -command c -map {d {e f}} proc e f {} a b d } -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup { rename a {} rename c {} } test namespace-50.5 {[4402cfa58c]} -setup { proc bar {ev} {} proc bingo {xx} {} namespace ensemble create -command launch -map {foo bar event bingo} set result {} } -body { catch {launch foo} m; lappend result $m catch {launch ev} m; lappend result $m catch {launch foo} m; lappend result $m } -cleanup { rename launch {} rename bingo {} rename bar {} } -result {{wrong # args: should be "launch foo ev"} {wrong # args: should be "launch event xx"} {wrong # args: should be "launch foo ev"}} test namespace-50.6 {[4402cfa58c]} -setup { proc target {x y} {} namespace ensemble create -command e2 -map {s2 target} namespace ensemble create -command e1 -map {s1 e2} set result {} } -body { set s s catch {e1 s1 s2 a} m; lappend result $m catch {e1 $s s2 a} m; lappend result $m catch {e1 s1 $s a} m; lappend result $m catch {e1 $s $s a} m; lappend result $m } -cleanup { rename e1 {} rename e2 {} rename target {} } -result {{wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"}} test namespace-50.7 {[4402cfa58c]} -setup { proc target {x y} {} namespace ensemble create -command e2 -map {s2 target} namespace ensemble create -command e1 -map {s1 e2} -parameters foo set result {} } -body { set s s catch {e1 s2 s1 a} m; lappend result $m catch {e1 $s s1 a} m; lappend result $m catch {e1 s2 $s a} m; lappend result $m catch {e1 $s $s a} m; lappend result $m } -cleanup { rename e1 {} rename e2 {} rename target {} } -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}} test namespace-50.8 {[f961d7d1dd]} -setup { proc target {} {} namespace ensemble create -command e -map {s target} -parameters {{a b}} } -body { e } -returnCodes error -result {wrong # args: should be "e {a b} subcommand ?arg ...?"} -cleanup { rename e {} rename target {} } test namespace-50.9 {[cea0344a51]} -body { namespace eval foo { namespace eval bar { namespace delete foo } } } -returnCodes error -result {unknown namespace "foo" in namespace delete command} test namespace-51.1 {name resolution path control} -body { namespace eval ::test_ns_1 { namespace eval test_ns_2 { proc pathtestA {} { ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] } proc pathtestC {} { ::return 2 } } proc pathtestB {} { return 1 } proc pathtestC {} { return 1 } namespace path ::test_ns_1 } proc ::pathtestB {} { return global } proc ::pathtestD {} { return global } test_ns_1::test_ns_2::pathtestA } -result "global,2,global," -cleanup { namespace delete ::test_ns_1 catch {rename ::pathtestB {}} catch {rename ::pathtestD {}} } test namespace-51.2 {name resolution path control} -body { namespace eval ::test_ns_1 { namespace eval test_ns_2 { namespace path ::test_ns_1 proc pathtestA {} { ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] } proc pathtestC {} { ::return 2 } } proc pathtestB {} { return 1 } proc pathtestC {} { return 1 } } proc ::pathtestB {} { return global } proc ::pathtestD {} { return global } ::test_ns_1::test_ns_2::pathtestA } -result "1,2,global,::test_ns_1" -cleanup { namespace delete ::test_ns_1 catch {rename ::pathtestB {}} catch {rename ::pathtestD {}} } test namespace-51.3 {name resolution path control} -body { namespace eval ::test_ns_1 { namespace eval test_ns_2 { proc pathtestA {} { ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] } proc pathtestC {} { ::return 2 } } proc pathtestB {} { return 1 } proc pathtestC {} { return 1 } } proc ::pathtestB {} { return global } proc ::pathtestD {} { return global } set result [::test_ns_1::test_ns_2::pathtestA] namespace eval ::test_ns_1::test_ns_2 { namespace path ::test_ns_1 } lappend result [::test_ns_1::test_ns_2::pathtestA] rename ::test_ns_1::pathtestB {} lappend result [::test_ns_1::test_ns_2::pathtestA] } -result "global,2,global, 1,2,global,::test_ns_1 global,2,global,::test_ns_1" -cleanup { namespace delete ::test_ns_1 catch {rename ::pathtestB {}} catch {rename ::pathtestD {}} } test namespace-51.4 {name resolution path control} -body { namespace eval ::test_ns_1 { namespace eval test_ns_2 { proc pathtestA {} { ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] } proc pathtestC {} { ::return 2 } } proc pathtestB {} { return 1 } proc pathtestC {} { return 1 } } proc ::pathtestB {} { return global } proc ::pathtestD {} { return global } set result [::test_ns_1::test_ns_2::pathtestA] namespace eval ::test_ns_1::test_ns_2 { namespace path ::test_ns_1 } lappend result [::test_ns_1::test_ns_2::pathtestA] namespace eval ::test_ns_1::test_ns_2 { namespace path {} } lappend result [::test_ns_1::test_ns_2::pathtestA] } -result "global,2,global, 1,2,global,::test_ns_1 global,2,global," -cleanup { namespace delete ::test_ns_1 catch {rename ::pathtestB {}} catch {rename ::pathtestD {}} } test namespace-51.5 {name resolution path control} -body { namespace eval ::test_ns_1 { namespace eval test_ns_2 { proc pathtestA {} { ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] } proc pathtestC {} { ::return 2 } namespace path ::test_ns_1 } proc pathtestB {} { return 1 } proc pathtestC {} { return 1 } proc pathtestD {} { return 1 } } proc ::pathtestB {} { return global } proc ::pathtestD {} { return global } set result [::test_ns_1::test_ns_2::pathtestA] namespace eval ::test_ns_1::test_ns_2 { namespace path {:: ::test_ns_1} } lappend result [::test_ns_1::test_ns_2::pathtestA] rename ::test_ns_1::test_ns_2::pathtestC {} lappend result [::test_ns_1::test_ns_2::pathtestA] } -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1}" -cleanup { namespace delete ::test_ns_1 catch {rename ::pathtestB {}} catch {rename ::pathtestD {}} } test namespace-51.6 {name resolution path control} -body { namespace eval ::test_ns_1 { namespace eval test_ns_2 { proc pathtestA {} { ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] } proc pathtestC {} { ::return 2 } namespace path ::test_ns_1 } proc pathtestB {} { return 1 } proc pathtestC {} { return 1 } proc pathtestD {} { return 1 } } proc ::pathtestB {} { return global } proc ::pathtestD {} { return global } set result [::test_ns_1::test_ns_2::pathtestA] namespace eval ::test_ns_1::test_ns_2 { namespace path {:: ::test_ns_1} } lappend result [::test_ns_1::test_ns_2::pathtestA] rename ::test_ns_1::test_ns_2::pathtestC {} lappend result [::test_ns_1::test_ns_2::pathtestA] proc ::pathtestC {} { return global } lappend result [::test_ns_1::test_ns_2::pathtestA] } -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1} {global,global,global,:: ::test_ns_1}" -cleanup { namespace delete ::test_ns_1 catch {rename ::pathtestB {}} catch {rename ::pathtestD {}} catch {rename ::pathtestC {}} } test namespace-51.7 {name resolution path control} -body { namespace eval ::test_ns_1 { } namespace eval ::test_ns_2 { namespace path ::test_ns_1 proc getpath {} {namespace path} } list [::test_ns_2::getpath] [namespace delete ::test_ns_1] [::test_ns_2::getpath] } -result {::test_ns_1 {} {}} -cleanup { catch {namespace delete ::test_ns_1} namespace delete ::test_ns_2 } test namespace-51.8 {name resolution path control} -body { namespace eval ::test_ns_1 { } namespace eval ::test_ns_2 { } namespace eval ::test_ns_3 { } namespace eval ::test_ns_4 { namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3} proc getpath {} {namespace path} } list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [::test_ns_4::getpath] } -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {::test_ns_1 ::test_ns_3}} -cleanup { catch {namespace delete ::test_ns_1} catch {namespace delete ::test_ns_2} catch {namespace delete ::test_ns_3} catch {namespace delete ::test_ns_4} } test namespace-51.9 {name resolution path control} -body { namespace eval ::test_ns_1 { } namespace eval ::test_ns_2 { } namespace eval ::test_ns_3 { } namespace eval ::test_ns_4 { namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3} proc getpath {} {namespace path} } list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [namespace eval ::test_ns_2 {}] [::test_ns_4::getpath] } -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {} {::test_ns_1 ::test_ns_3}} -cleanup { catch {namespace delete ::test_ns_1} catch {namespace delete ::test_ns_2} catch {namespace delete ::test_ns_3} catch {namespace delete ::test_ns_4} } test namespace-51.10 {name resolution path control} -body { namespace eval ::test_ns_1 { namespace path does::not::exist } } -returnCodes error -result {namespace "does::not::exist" not found in "::test_ns_1"} -cleanup { catch {namespace delete ::test_ns_1} } test namespace-51.11 {name resolution path control} -body { namespace eval ::test_ns_1 { proc foo {} {return 1} } namespace eval ::test_ns_2 { proc foo {} {return 2} } namespace eval ::test_ns_3 { namespace path ::test_ns_1 } namespace eval ::test_ns_4 { namespace path {::test_ns_3 ::test_ns_2} foo } } -result 2 -cleanup { catch {namespace delete ::test_ns_1} catch {namespace delete ::test_ns_2} catch {namespace delete ::test_ns_3} catch {namespace delete ::test_ns_4} } test namespace-51.12 {name resolution path control} -body { namespace eval ::test_ns_1 { proc foo {} {return 1} } namespace eval ::test_ns_2 { proc foo {} {return 2} } namespace eval ::test_ns_3 { namespace path ::test_ns_1 } namespace eval ::test_ns_4 { namespace path {::test_ns_3 ::test_ns_2} list [foo] [namespace delete ::test_ns_3] [foo] } } -result {2 {} 2} -cleanup { catch {namespace delete ::test_ns_1} catch {namespace delete ::test_ns_2} catch {namespace delete ::test_ns_3} catch {namespace delete ::test_ns_4} } test namespace-51.13 {name resolution path control} -body { set ::result {} namespace eval ::test_ns_1 { proc foo {} {lappend ::result 1} } namespace eval ::test_ns_2 { proc foo {} {lappend ::result 2} trace add command foo delete "namespace eval ::test_ns_3 foo;#" } namespace eval ::test_ns_3 { proc foo {} { lappend ::result 3 namespace delete [namespace current] ::test_ns_4::bar } } namespace eval ::test_ns_4 { namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1} proc bar {} { list [foo] [namespace delete ::test_ns_2] [foo] } bar } # Should the result be "2 {} {2 3 2 1}" instead? } -result {2 {} {2 3 1 1}} -cleanup { catch {namespace delete ::test_ns_1} catch {namespace delete ::test_ns_2} catch {namespace delete ::test_ns_3} catch {namespace delete ::test_ns_4} } test namespace-51.14 {name resolution path control} -setup { foreach cmd [info commands foo*] { rename $cmd {} } namespace eval ::test_ns_1 {} namespace eval ::test_ns_2 {} namespace eval ::test_ns_3 {} } -body { proc foo0 {} {} proc ::test_ns_1::foo1 {} {} proc ::test_ns_2::foo2 {} {} namespace eval ::test_ns_3 { variable result {} lappend result [info commands foo*] namespace path {::test_ns_1 ::test_ns_2} lappend result [info commands foo*] proc foo2 {} {} lappend result [info commands foo*] rename foo2 {} lappend result [info commands foo*] namespace delete ::test_ns_1 lappend result [info commands foo*] } } -cleanup { catch {namespace delete ::test_ns_1} catch {namespace delete ::test_ns_2} catch {namespace delete ::test_ns_3} } -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} test namespace-51.15 {namespace resolution path control} -body { namespace eval ::test_ns_2 { proc foo {} {return 2} } namespace eval ::test_ns_1 { namespace eval test_ns_2 { proc foo {} {return 1_2} } namespace eval test_ns_3 { namespace path ::test_ns_1 test_ns_2::foo } } } -result 1_2 -cleanup { namespace delete ::test_ns_1 namespace delete ::test_ns_2 } test namespace-51.16 {Bug 1566526} { interp create child child eval namespace eval demo namespace path :: interp delete child } {} test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup { set result {} catch {namespace delete ::a} } -body { namespace eval ::a { proc c {} {lappend ::result A} c namespace eval b { variable d c lappend ::result [catch { $d }] } lappend ::result . namespace eval b { namespace path [namespace parent] $d;[format %c 99] } lappend ::result . namespace eval b { proc c {} {lappend ::result B} $d;[format %c 99] } lappend ::result . } namespace eval ::a::b { $d;[format %c 99] lappend ::result . proc ::c {} {lappend ::result G} $d;[format %c 99] lappend ::result . rename ::a::c {} $d;[format %c 99] lappend ::result . rename ::a::b::c {} $d;[format %c 99] } } -cleanup { namespace delete ::a catch {rename ::c {}} unset result } -result {A 1 . A A . B B . B B . B B . B B . G G} test namespace-51.18 {Bug 3185407} -setup { namespace eval ::test_ns_1 {} } -body { namespace eval ::test_ns_1 { variable result {} namespace eval ns {proc foo {} {}} namespace eval ns2 {proc foo {} {}} namespace path {ns ns2} variable x foo lappend result [namespace which $x] proc foo {} {} lappend result [namespace which $x] } } -cleanup { namespace delete ::test_ns_1 } -result {::test_ns_1::ns::foo ::test_ns_1::foo} # TIP 181 - namespace unknown tests test namespace-52.1 {unknown: default handler ::unknown} { set result [list [namespace eval foobar { namespace unknown }]] lappend result [namespace eval :: { namespace unknown }] namespace delete foobar set result } {{} ::unknown} test namespace-52.2 {unknown: default resolution global} { proc ::foo {} { return "GLOBAL" } namespace eval ::bar { proc foo {} { return "NAMESPACE" } } namespace eval ::bar::jim { proc test {} { foo } } set result [::bar::jim::test] namespace delete ::bar rename ::foo {} set result } {GLOBAL} test namespace-52.3 {unknown: default resolution local} { proc ::foo {} { return "GLOBAL" } namespace eval ::bar { proc foo {} { return "NAMESPACE" } proc test {} { foo } } set result [::bar::test] namespace delete ::bar rename ::foo {} set result } {NAMESPACE} test namespace-52.4 {unknown: set handler} { namespace eval foo { namespace unknown [list dispatch] proc dispatch {args} { return $args } proc test {} { UnknownCmd a b c } } set result [foo::test] namespace delete foo set result } {UnknownCmd a b c} test namespace-52.5 {unknown: search path before unknown is unaltered} { proc ::test2 {args} { return "TEST2: $args" } namespace eval foo { namespace unknown [list dispatch] proc dispatch {args} { return "UNKNOWN: $args" } proc test1 {args} { return "TEST1: $args" } proc test {} { set result [list [test1 a b c]] lappend result [test2 a b c] lappend result [test3 a b c] return $result } } set result [foo::test] namespace delete foo rename ::test2 {} set result } {{TEST1: a b c} {TEST2: a b c} {UNKNOWN: test3 a b c}} test namespace-52.6 {unknown: deleting handler restores default} { rename ::unknown ::_unknown_orig proc ::unknown {args} { return "DEFAULT: $args" } namespace eval foo { namespace unknown dummy namespace unknown {} } set result [namespace eval foo { dummy a b c }] rename ::unknown {} rename ::_unknown_orig ::unknown namespace delete foo set result } {DEFAULT: dummy a b c} test namespace-52.7 {unknown: setting global unknown handler} { proc ::myunknown {args} { return "MYUNKNOWN: $args" } namespace eval :: { namespace unknown ::myunknown } set result [namespace eval foo { dummy a b c }] namespace eval :: { namespace unknown {} } rename ::myunknown {} namespace delete foo set result } {MYUNKNOWN: dummy a b c} test namespace-52.8 {unknown: destroying and redefining global namespace} { set i [interp create] $i hide proc $i hide namespace $i hide return $i invokehidden namespace delete :: $i expose return $i invokehidden proc unknown args { return "FINE" } $i eval { foo bar bob } } {FINE} test namespace-52.9 {unknown: refcounting} -setup { proc this args { unset args ;# stop sharing set copy [namespace unknown] string length $copy ;# shimmer away list rep info level 0 } set handler [namespace unknown] namespace unknown {this is a test} catch {rename noSuchCommand {}} } -body { noSuchCommand } -cleanup { namespace unknown $handler rename this {} } -result {this is a test noSuchCommand} testConstraint testevalobjv [llength [info commands testevalobjv]] test namespace-52.10 {unknown: with TCL_EVAL_GLOBAL} -constraints { testevalobjv } -setup { rename ::unknown unknown.save proc ::unknown args { set caller [uplevel 1 {namespace current}] namespace eval $caller { variable foo return $foo } } catch {rename ::noSuchCommand {}} } -body { namespace eval :: { variable foo SUCCESS } namespace eval test_ns_1 { variable foo FAIL testevalobjv 1 noSuchCommand } } -cleanup { unset -nocomplain ::foo namespace delete test_ns_1 rename ::unknown {} rename unknown.save ::unknown } -result SUCCESS test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup { set handler [namespace eval :: {namespace unknown}] namespace eval :: {namespace unknown unknown} rename ::unknown unknown.save namespace eval :: { proc unknown args { return SUCCESS } } catch {rename ::noSuchCommand {}} set ::child [interp create] } -body { $::child alias bar noSuchCommand namespace eval test_ns_1 { namespace unknown unknown proc unknown args { return FAIL } $::child eval bar } } -cleanup { interp delete $::child unset ::child namespace delete test_ns_1 rename ::unknown {} rename unknown.save ::unknown namespace eval :: [list namespace unknown $handler] } -result SUCCESS test namespace-52.12 {unknown: error case must not reset handler} -body { namespace eval foo { namespace unknown ok catch {namespace unknown {{}{}{}}} namespace unknown } } -cleanup { namespace delete foo } -result ok # TIP 314 - ensembles with parameters test namespace-53.1 {ensembles: parameters} { namespace eval ns { namespace export x proc x {para} {list 1 $para} namespace ensemble create -parameters {para1} } list [info command ns] [ns bar x] [namespace delete ns] [info command ns] } {ns {1 bar} {} {}} test namespace-53.2 {ensembles: parameters} -setup { namespace eval ns { namespace export x proc x {para} {list 1 $para} namespace ensemble create } } -body { namespace ensemble configure ns -parameters {para1} rename ns foo list [info command foo] [foo bar x] [namespace delete ns] [info command foo] } -result {foo {1 bar} {} {}} test namespace-53.3 {ensembles: parameters} -setup { namespace eval ns { namespace export x* proc x1 {para} {list 1 $para} proc x2 {para} {list 2 $para} namespace ensemble create -parameters param1 } } -body { set result [list [ns x2 x1] [ns x1 x2]] lappend result [catch {ns x} msg] $msg lappend result [catch {ns x x} msg] $msg rename ns {} lappend result [info command ns::x1] namespace delete ns lappend result [info command ns::x1] } -result\ {{1 x2} {2 x1}\ 1 {wrong # args: should be "ns param1 subcommand ?arg ...?"}\ 1 {unknown or ambiguous subcommand "x": must be x1, or x2}\ ::ns::x1 {}} test namespace-53.4 {ensembles: parameters} -setup { namespace eval ns { namespace export x* proc x1 {a1 a2} {list 1 $a1 $a2} proc x2 {a1 a2} {list 2 $a1 $a2} proc x3 {a1 a2} {list 3 $a1 $a2} namespace ensemble create } } -body { set result {} lappend result [ns x1 x2 x3] namespace ensemble configure ns -parameters p1 lappend result [ns x1 x2 x3] namespace ensemble configure ns -parameters {p1 p2} lappend result [ns x1 x2 x3] } -cleanup { namespace delete ns } -result {{1 x2 x3} {2 x1 x3} {3 x1 x2}} test namespace-53.5 {ensembles: parameters} -setup { namespace eval ns { namespace export x* proc x1 {para} {list 1 $para} proc x2 {para} {list 2 $para} proc x3 {para} {list 3 $para} namespace ensemble create } } -body { set result [list [catch {ns x x1} msg] $msg] lappend result [catch {ns x1 x} msg] $msg namespace ensemble configure ns -parameters p1 lappend result [catch {ns x1 x} msg] $msg lappend result [catch {ns x x1} msg] $msg } -cleanup { namespace delete ns } -result\ {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\ 0 {1 x}\ 1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\ 0 {1 x}} test namespace-53.6 {ensembles: nested} -setup { namespace eval ns { namespace export x* namespace eval x0 { proc z {args} {list 0 $args} namespace export z namespace ensemble create } proc x1 {args} {list 1 $args} proc x2 {args} {list 2 $args} proc x3 {args} {list 3 $args} namespace ensemble create -parameters p } } -body { list [ns z x0] [ns z x1] [ns z x2] [ns z x3] } -cleanup { namespace delete ns } -result {{0 {}} {1 z} {2 z} {3 z}} test namespace-53.7 {ensembles: parameters & wrong # args} -setup { namespace eval ns { namespace export x* proc x1 {a1 a2 a3 a4} {list x1 $a1 $a2 $a3 $a4} namespace ensemble create -parameters p1 } } -body { set result {} lappend result [catch {ns} msg] $msg lappend result [catch {ns x1} msg] $msg lappend result [catch {ns x1 x1} msg] $msg lappend result [catch {ns x1 x1 x1} msg] $msg lappend result [catch {ns x1 x1 x1 x1} msg] $msg lappend result [catch {ns x1 x1 x1 x1 x1} msg] $msg } -cleanup { namespace delete ns } -result\ {1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\ 1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\ 0 {x1 x1 x1 x1 x1}} test namespace-53.8 {ensemble: unknown handler changing -parameters} -setup { namespace eval ns { namespace export x* proc x1 {a1} {list 1 $a1} proc Magic {ensemble subcmd args} { namespace ensemble configure $ensemble\ -parameters [lrange p1 [llength [ namespace ensemble configure $ensemble -parameters ]] 0] list } namespace ensemble create -unknown ::ns::Magic } } -body { set result {} lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters] lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters] lappend result [catch {ns x2 x3} msg] $msg [namespace ensemble configure ns -parameters] } -cleanup { namespace delete ns } -result\ {0 {1 x2} {}\ 0 {1 x2} p1\ 1 {unknown or ambiguous subcommand "x2": must be x1} {}} test namespace-53.9 {ensemble: unknown handler changing -parameters,\ thereby eating all args} -setup { namespace eval ns { namespace export x* proc x1 {args} {list 1 $args} proc Magic {ensemble subcmd args} { namespace ensemble configure $ensemble\ -parameters {p1 p2 p3 p4 p5} list } namespace ensemble create -unknown ::ns::Magic } } -body { set result {} lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters] lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters] lappend result [catch {ns a1 a2 a3 a4 a5 x1} msg] $msg [namespace ensemble configure ns -parameters] } -cleanup { namespace delete ns } -result\ {0 {1 x2} {}\ 1 {wrong # args: should be "ns p1 p2 p3 p4 p5 subcommand ?arg ...?"} {p1 p2 p3 p4 p5}\ 0 {1 {a1 a2 a3 a4 a5}} {p1 p2 p3 p4 p5}} test namespace-53.10 {ensembles: nested rewrite} -setup { namespace eval ns { namespace export x namespace eval x { proc z0 {} {list 0} proc z1 {a1} {list 1 $a1} proc z2 {a1 a2} {list 2 $a1 $a2} proc z3 {a1 a2 a3} {list 3 $a1 $a2 $a3} namespace export z* namespace ensemble create } namespace ensemble create -parameters p } } -body { set result {} # In these cases, parsing the subensemble does not grab a new word. lappend result [catch {ns z0 x} msg] $msg lappend result [catch {ns z1 x} msg] $msg lappend result [catch {ns z2 x} msg] $msg lappend result [catch {ns z2 x v} msg] $msg namespace ensemble configure ns::x -parameters q1 # In these cases, parsing the subensemble grabs a new word. lappend result [catch {ns v x z0} msg] $msg lappend result [catch {ns v x z1} msg] $msg lappend result [catch {ns v x z2} msg] $msg lappend result [catch {ns v x z2 v2} msg] $msg } -cleanup { namespace delete ns } -result\ {0 0\ 1 {wrong # args: should be "ns z1 x a1"}\ 1 {wrong # args: should be "ns z2 x a1 a2"}\ 1 {wrong # args: should be "ns z2 x a1 a2"}\ 1 {wrong # args: should be "::ns::x::z0"}\ 0 {1 v}\ 1 {wrong # args: should be "ns v x z2 a2"}\ 0 {2 v v2}} test namespace-53.11 {ensembles: nested rewrite} -setup { namespace eval ns { namespace export x namespace eval x { proc z2 {a1 a2} {list 2 $a1 $a2} namespace export z* namespace ensemble create -parameter p } namespace ensemble create } } -body { list [catch {ns x 1 z2} msg] $msg } -cleanup { namespace delete ns unset -nocomplain msg } -result {1 {wrong # args: should be "ns x 1 z2 a2"}} test namespace-54.1 {leak on namespace deletion} -constraints {memory} \ -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex $lines 3 3 } } -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { set ns ::y$i namespace eval $ns {} namespace delete $ns set start $end set end [getbytes] } set leakedBytes [expr {$end - $start}] } -cleanup { rename getbytes {} unset i ns start end } -result 0 test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} { info class [format %s constructor] oo::object } "" test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} { namespace eval ::testing { proc abc {} {} proc def {} {} trace add command abc delete "rename ::testing::def {}; #" trace add command def delete "rename ::testing::abc {}; #" } namespace delete ::testing } {} test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} { namespace eval ::testing { namespace eval abc {proc xyz {} {}} namespace eval def {proc xyz {} {}} trace add command abc::xyz delete "namespace delete ::testing::def {}; #" trace add command def::xyz delete "namespace delete ::testing::abc {}; #" } namespace delete ::testing } {} test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} { namespace eval ::testing { variable gone {} oo::class create CB { variable cmd constructor other {set cmd $other} destructor {rename $cmd {}; lappend ::testing::gone $cmd} } namespace eval abc { ::testing::CB create def ::testing::abc::ghi ::testing::CB create ghi ::testing::abc::def } namespace delete abc try { return [lsort $gone] } finally { namespace delete ::testing } } } {::testing::abc::def ::testing::abc::ghi} test namespace-56.4 {bug 16fe1b5807: names starting with ":"} knownBug { namespace eval : { namespace ensemble create namespace export * proc p1 {} { return 16fe1b5807 } } : p1 } 16fe1b5807 test namespace-56.5 {Bug 8b9854c3d8} -setup { namespace eval namespace-56.5 { proc cmd {} {string match ::* [lindex [[string cat info] level 0] 0]} namespace export * namespace ensemble create } } -body { namespace-56.5 cmd } -cleanup { namespace delete namespace-56.5 } -result 1 test namespace-56.6 { Namespace deletion traces on both the original routine and the imported routine should run without any memory error under a debug build. } -body { variable res 0 proc ondelete {old new op} { $old } namespace eval ns1 {} { namespace export * proc p1 {} { namespace upvar [namespace parent] res res incr res } trace add command p1 delete ondelete } namespace eval ns2 {} { namespace import ::ns1::p1 trace add command p1 delete ondelete } namespace delete ns1 namespace delete ns2 return $res } -cleanup { unset res rename ondelete {} } -result 2 test namespace-57.0 { an imported alias should be usable in the deletion trace for the alias see 29e8848eb976 } -body { variable res {} namespace eval ns2 { namespace export * proc p1 {oldname newname op} { return success } interp alias {} [namespace current]::p2 {} [namespace which p1] } namespace eval ns3 { namespace import ::ns2::p2 } set ondelete [list apply [list {oldname newname op} { variable res catch { ns3::p2 $oldname $newname $op } cres lappend res $cres } [namespace current]]] trace add command ::ns2::p2 delete $ondelete rename ns2::p2 {} return $res } -cleanup { unset res namespace delete ns2 namespace delete ns3 } -result success # cleanup catch {rename cmd1 {}} catch {unset l} catch {unset msg} catch {unset trigger} namespace delete {*}[namespace children :: test_ns_*] ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/notify.test0000644000175000017500000002117414554262142015222 0ustar sergeisergei# -*- tcl -*- # # notify.test -- # # This file tests several functions in the file, 'generic/tclNotify.c'. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testevent [llength [info commands testevent]] test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} vwait done set delivered } \ -result {one} test notify-1.2 {Tcl_QueueEvent and delivery of events in order} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent queue two tail {lappend delivered two; expr 1} testevent queue three tail {lappend delivered three; expr 1} vwait done set delivered } \ -result {one two three} test notify-1.3 {Tcl_QueueEvent at head} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one head {lappend delivered one; expr 1} vwait done set delivered } \ -result one test notify-1.4 {Tcl_QueueEvent multiple events at head} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one head {lappend delivered one; expr 1} testevent queue two head {lappend delivered two; expr 1} testevent queue three head {lappend delivered three; expr 1} vwait done set delivered } \ -result {three two one} test notify-1.5 {Tcl_QueueEvent marker event into an empty queue} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} vwait done set delivered } \ -result one test notify-1.6 {Tcl_QueueEvent first marker event in a nonempty queue} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent queue two mark {lappend delivered two; expr 1} testevent queue three head {lappend delivered three; expr 1} vwait done set delivered } \ -result {three two one} test notify-1.7 {Tcl_QueueEvent second marker event} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent queue two mark {lappend delivered two; expr 1} vwait done set delivered } \ -result {one two} test notify-1.8 {Tcl_QueueEvent preexisting event following second marker} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent queue two tail {lappend delivered two; expr 1} testevent queue three mark {lappend delivered three; expr 1} vwait done set delivered } \ -result {one three two} test notify-2.1 {remove sole element, don't replace } \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent delete one vwait done set delivered } \ -result {} test notify-2.2 {remove and replace sole element} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent delete one testevent queue two tail {lappend delivered two; expr 1} vwait done set delivered } \ -result two test notify-2.3 {remove first element} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent queue two tail {lappend delivered two; expr 1} testevent delete one vwait done set delivered } \ -result {two} test notify-2.4 {remove and replace first element} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent queue two tail {lappend delivered two; expr 1} testevent delete one testevent queue three head {lappend delivered three; expr 1}; vwait done set delivered } \ -result {three two} test notify-2.5 {remove last element} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent queue two tail {lappend delivered two; expr 1} testevent delete two vwait done set delivered } \ -result {one} test notify-2.6 {remove and replace last element} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent queue two tail {lappend delivered two; expr 1} testevent delete two testevent queue three tail {lappend delivered three; expr 1}; vwait done set delivered } \ -result {one three} test notify-2.7 {remove a middle element} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one tail {lappend delivered one; expr 1} testevent queue two tail {lappend delivered two; expr 1} testevent queue three tail {lappend delivered three; expr 1} testevent delete two vwait done set delivered } \ -result {one three} test notify-2.8 {remove a marker event that's the sole event in the queue} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent delete one vwait done set delivered } \ -result {} test notify-2.9 {remove and replace a marker event that's the sole event} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent delete one testevent queue two mark {lappend delivered two; expr 1} vwait done set delivered } \ -result two test notify-2.10 {remove marker event from head} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent queue two mark {lappend delivered two; expr 1} testevent delete one vwait done set delivered } \ -result two test notify-2.11 {remove and replace marker event at head} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent queue two tail {lappend delivered two; expr 1} testevent delete one testevent queue three mark {lappend delivered three; expr 1} vwait done set delivered } \ -result {three two} test notify-2.12 {remove marker event at tail} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent queue two mark {lappend delivered two; expr 1} testevent delete two vwait done set delivered } \ -result {one} test notify-2.13 {remove and replace marker event at tail} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent queue two mark {lappend delivered two; expr 1} testevent delete two testevent queue three mark {lappend delivered three; expr 1} vwait done set delivered } \ -result {one three} test notify-2.14 {remove marker event from middle} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent queue two mark {lappend delivered two; expr 1} testevent queue three mark {lappend delivered three; expr 1} testevent delete two vwait done set delivered } \ -result {one three} test notify-2.15 {remove and replace marker event at middle} \ -constraints {testevent} \ -body { set delivered {} after 10 set done 1 testevent queue one mark {lappend delivered one; expr 1} testevent queue two mark {lappend delivered two; expr 1} testevent queue three tail {lappend delivered three; expr 1} testevent delete two testevent queue four mark {lappend delivered four; expr 1}; vwait done set delivered } \ -result {one four three} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/nre.test0000644000175000017500000002371414565156356014513 0ustar sergeisergei# Commands covered: proc, apply, [interp alias], [namespace import] # # This file contains a collection of tests for the non-recursive executor that # avoids recursive calls to TEBC. Only the NRE behaviour is tested here, the # actual command functionality is tested in the specific test file. # # Copyright (c) 2008 by Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testnrelevels [llength [info commands testnrelevels]] # # The tests that risked blowing the C stack on failure have been removed: we # can now actually measure using testnrelevels. # if {[testConstraint testnrelevels]} { namespace eval testnre { namespace path ::tcl::mathop # # [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels, # cmdFrame level, callFrame level, tosPtr and callback depth # variable last [testnrelevels] proc depthDiff {} { variable last set depth [testnrelevels] set res {} foreach t $depth l $last { lappend res [expr {$t-$l}] } set last $depth return $res } proc setabs {} { variable abs [- [lindex [testnrelevels] 0]] } variable body0 { set x [depthDiff] if {[incr i] > 10} { namespace upvar [namespace qualifiers \ [namespace origin depthDiff]] abs abs incr abs [lindex [testnrelevels] 0] return [list [lrange $x 0 3] $abs] } } proc makebody txt { variable body0 return "$body0; $txt" } namespace export * } namespace import testnre::* } test nre-0.1 {levels while unwinding} -body { testnreunwind } -constraints { testnrelevels } -result {0 0 0} test nre-1.1 {self-recursive procs} -setup { proc a i [makebody {a $i}] } -body { setabs a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 1 1 1} 0} test nre-1.2 {self-recursive lambdas} -setup { set a [list i [makebody {apply $::a $i}]] } -body { setabs apply $a 0 } -cleanup { unset a } -constraints { testnrelevels } -result {{0 1 1 1} 0} test nre-1.3 {mutually recursive procs and lambdas} -setup { proc a i { apply $::b [incr i] } set b [list i [makebody {a $i}]] } -body { setabs a 0 } -cleanup { rename a {} unset b } -constraints { testnrelevels } -result {{0 2 2 2} 0} # # Test that aliases are non-recursive # test nre-2.1 {alias is not recursive} -setup { proc a i [makebody {b $i}] interp alias {} b {} a } -body { setabs a 0 } -cleanup { rename a {} rename b {} } -constraints { testnrelevels } -result {{0 2 1 1} 0} # # Test that imports are non-recursive # test nre-3.1 {imports are not recursive} -setup { namespace eval foo { setabs namespace export a } proc foo::a i [makebody {::a $i}] namespace import foo::a } -body { a 0 } -cleanup { rename a {} namespace delete ::foo } -constraints { testnrelevels } -result {{0 2 1 1} 0} test nre-4.1 {ensembles are not recursive} -setup { proc a i [makebody {b foo $i}] namespace ensemble create \ -command b \ -map [list foo a] } -body { setabs a 0 } -cleanup { rename a {} rename b {} } -constraints { testnrelevels } -result {{0 2 1 1} 0} test nre-4.2 {(compiled) ensembles do not break tailcall} -setup { # Fix Bug d87cb18205 proc b {} { tailcall append result first } set map [namespace ensemble configure ::dict -map] dict set map a b namespace ensemble configure ::dict -map $map proc demo {} { dict a append result second } } -body { demo } -cleanup { rename demo {} namespace ensemble configure ::dict -map [dict remove $map a] unset map rename b {} } -result firstsecond test nre-5.1 {[namespace eval] is not recursive} -setup { namespace eval ::foo { setabs } proc foo::a i [makebody {namespace eval ::foo [list a $i]}] } -body { ::foo::a 0 } -cleanup { namespace delete ::foo } -constraints { testnrelevels } -result {{0 2 2 2} 0} test nre-5.2 {[namespace eval] is not recursive} -setup { namespace eval ::foo { setabs } proc foo::a i [makebody {namespace eval ::foo "set x $i; a $i"}] } -body { foo::a 0 } -cleanup { namespace delete ::foo } -constraints { testnrelevels } -result {{0 2 2 2} 0} test nre-6.1 {[uplevel] is not recursive} -setup { proc a i [makebody {uplevel 1 [list a $i]}] } -body { setabs a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 2 2 0} 0} test nre-6.2 {[uplevel] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "set x $i; a $i"}] } -body { a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 2 2 0} 0} test nre-7.1 {[catch] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "catch {a $i} msg; set msg"}] } -body { a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 3 3 0} 0} test nre-7.2 {[if] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "if 1 {a $i}"}] } -body { a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 2 2 0} 0} test nre-7.3 {[while] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}] } -body { a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 2 2 0} 0} test nre-7.4 {[for] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}] } -body { a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 2 2 0} 0} test nre-7.5 {[foreach] is not recursive} -setup { # # Enable once [foreach] is NR-enabled # setabs proc a i [makebody {uplevel 1 "foreach j {1 2 3 4 5 6} {set res \[a $i\]; break}; set res"}] } -body { a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 3 3 0} 0} test nre-7.6 {[eval] is not recursive} -setup { proc a i [makebody {eval [list a $i]}] } -body { setabs a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 2 2 1} 0} test nre-7.7 {[eval] is not recursive} -setup { proc a i [makebody {eval "a $i"}] } -body { setabs a 0 } -cleanup { rename a {} } -constraints { testnrelevels } -result {{0 2 2 1} 0} test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup { proc foo args {} foo coroutine bar apply {{} { yield proc foo args {return ok} while 1 { yield [incr i] foo } }} } -body { # if switching to plain eval is not nre aware, this will cause a "cannot # yield" error list [bar] [bar] [bar] } -cleanup { rename bar {} rename foo {} } -result {1 2 3} test nre-8.1 {nre and {*}} -body { # force an expansion that grows the evaluation stack, check that nre # adapts the TEBCdataPtr. This crashes on failure. proc inner {} { set long [lrepeat 1000000 1] list {*}$long } proc outer {} inner lrange [outer] 0 2 } -cleanup { rename inner {} rename outer {} } -result {1 1 1} test nre-8.2 {nre and {*}, [Bug 2415422]} -body { # force an expansion that grows the evaluation stack, check that nre # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not # done properly. proc nop {} {} proc crash {} { foreach val [list {*}[lrepeat 100000 x]] { nop } } crash } -cleanup { rename nop {} rename crash {} } # # Basic TclOO tests # test nre-oo.1 {really deep calls in oo - direct} -setup { oo::object create foo oo::objdefine foo method bar i [makebody {foo bar $i}] } -body { setabs foo bar 0 } -cleanup { foo destroy } -constraints { testnrelevels } -result {{0 1 1 1} 0} test nre-oo.2 {really deep calls in oo - call via [self]} -setup { oo::object create foo oo::objdefine foo method bar i [makebody {[self] bar $i}] } -body { setabs foo bar 0 } -cleanup { foo destroy } -constraints { testnrelevels } -result {{0 1 1 1} 0} test nre-oo.3 {really deep calls in oo - private calls} -setup { oo::object create foo oo::objdefine foo method bar i [makebody {my bar $i}] } -body { setabs foo bar 0 } -cleanup { foo destroy } -constraints { testnrelevels } -result {{0 1 1 1} 0} test nre-oo.4 {really deep calls in oo - overriding} -setup { oo::class create foo { method bar i [makebody {my bar $i}] } oo::class create boo { superclass foo method bar i [makebody {next $i}] } } -body { setabs [boo new] bar 0 } -cleanup { foo destroy } -constraints { testnrelevels } -result {{0 1 1 1} 0} test nre-oo.5 {really deep calls in oo - forwards} -setup { oo::object create foo set body [makebody {my boo $i}] oo::objdefine foo " method bar i {$body} forward boo ::foo bar " } -body { setabs foo bar 0 } -cleanup { foo destroy } -constraints { testnrelevels } -result {{0 2 1 1} 0} # # NASTY BUG found by tcllib's interp package # test nre-X.1 {eval in wrong interp} -setup { set i [interp create] $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}} } -body { $i eval { set x {namespace children ::} set y [list namespace children ::] namespace delete {*}[filter [{*}$y]] set j [interp create] $j alias filter filter $j eval {namespace delete {*}[filter [namespace children ::]]} namespace eval foo {} list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]] } } -cleanup { interp delete $i } -result {::foo ::foo {} {}} # cleanup ::tcltest::cleanupTests if {[testConstraint testnrelevels]} { namespace forget testnre::* namespace delete testnre } return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/obj.test0000644000175000017500000005761414554262142014474 0ustar sergeisergei# Functionality covered: this file contains a collection of tests for the # procedures in tclObj.c that implement Tcl's basic type support and the # type managers for the types boolean, double, and integer. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 foreach {t} { {array search} bytearray bytecode cmdName dict end-offset regexp string } { set first [string first $t [testobj types]] set r [expr {$r && ($first >= 0)}] } set result $r } {1} test obj-2.1 {Tcl_GetObjType error} testobj { list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg } {0 1 {no type foo found}} test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 12] lappend result [testobj convert 1 bytearray] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 12 12 bytearray 3} test obj-3.1 {Tcl_ConvertToType error} testobj { list [testdoubleobj set 1 12.34] \ [catch {testobj convert 1 end-offset} msg] \ $msg } {12.34 1 {bad index "12.34": must be end?[+-]integer?}} test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj { list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg } {{} 1 {bad index "": must be end?[+-]integer?}} test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} string 2} test obj-5.1 {Tcl_FreeObj} testobj { set result "" lappend result [testintobj set 1 12345] lappend result [testobj freeallvars] lappend result [catch {testintobj get 1} msg] lappend result $msg } {12345 {} 1 {variable 1 is unset (NULL)}} test obj-6.1 {Tcl_DuplicateObj, object has internal rep} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 47] lappend result [testobj duplicate 1 2] lappend result [testintobj get 2] lappend result [testobj refcount 1] lappend result [testobj refcount 2] } {{} 47 47 47 2 3} test obj-6.2 {Tcl_DuplicateObj, "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] lappend result [testobj duplicate 1 2] lappend result [testintobj get 2] lappend result [testobj refcount 1] lappend result [testobj refcount 2] } {{} {} {} {} 2 3} # We assume that testobj is an indicator for test*obj as well test obj-7.1 {Tcl_GetString, return existing string rep} testobj { set result "" lappend result [testintobj set 1 47] lappend result [testintobj get2 1] } {47 47} test obj-7.2 {Tcl_GetString, "empty string" object} testobj { set result "" lappend result [testobj newobj 1] lappend result [teststringobj append 1 abc -1] lappend result [teststringobj get2 1] } {{} abc abc} test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} testobj { set result "" lappend result [teststringobj set 1 xyz] lappend result [teststringobj append 1 abc -1] lappend result [teststringobj get2 1] } {xyz xyzabc xyzabc} test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} testobj { set result "" lappend result [testintobj set 1 77] lappend result [testintobj mult10 1] lappend result [teststringobj get2 1] } {77 770 770} test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} testobj { set result "" lappend result [testintobj set 1 47] lappend result [testintobj get 1] } {47 47} test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} testobj { set result "" lappend result [testobj newobj 1] lappend result [teststringobj append 1 abc -1] lappend result [teststringobj get 1] } {{} abc abc} test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} testobj { set result "" lappend result [teststringobj set 1 xyz] lappend result [teststringobj append 1 abc -1] lappend result [teststringobj get 1] } {xyz xyzabc xyzabc} test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} testobj { set result "" lappend result [testintobj set 1 77] lappend result [testintobj mult10 1] lappend result [teststringobj get 1] } {77 770 770} test obj-9.1 {Tcl_NewBooleanObj} testobj { set result "" lappend result [testobj freeallvars] lappend result [testbooleanobj set 1 0] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 0 int 2} test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] lappend result [testbooleanobj set 1 0] ;# makes existing obj boolean lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 0 int 2} test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 98765] lappend result [testbooleanobj set 1 1] ;# makes existing obj boolean lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 98765 1 int 2} test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} testobj { set result "" lappend result [testbooleanobj set 1 1] lappend result [testbooleanobj not 1] ;# gets existing boolean rep } {1 0} test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} testobj { set result "" lappend result [testintobj set 1 47] lappend result [testbooleanobj not 1] ;# must convert to bool lappend result [testobj type 1] } {47 0 int} test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} testobj { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {abc 1 {expected boolean value but got "abc"}} test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {{} 1 {expected boolean value but got ""}} test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} testobj { set result "" lappend result [teststringobj set 1 0xac] lappend result [testbooleanobj not 1] lappend result [testobj type 1] } {0xac 0 int} test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} testobj { set result "" lappend result [teststringobj set 1 5.42] lappend result [testbooleanobj not 1] lappend result [testobj type 1] } {5.42 0 int} test obj-12.1 {DupBooleanInternalRep} testobj { set result "" lappend result [testbooleanobj set 1 1] lappend result [testobj duplicate 1 2] ;# uses DupBooleanInternalRep lappend result [testbooleanobj get 2] } {1 1 1} test obj-13.1 {SetBooleanFromAny, int to boolean special case} testobj { set result "" lappend result [testintobj set 1 1234] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] } {1234 0 int} test obj-13.2 {SetBooleanFromAny, double to boolean special case} testobj { set result "" lappend result [testdoubleobj set 1 3.14159] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] } {3.14159 0 int} test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} testobj { set result "" foreach s {yes no true false on off} { teststringobj set 1 $s lappend result [testbooleanobj not 1] } lappend result [testobj type 1] } {0 1 0 1 0 1 int} test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} testobj { set result "" lappend result [testintobj set 1 456] lappend result [testintobj div10 1] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] } {456 45 0 int} test obj-13.5 {SetBooleanFromAny, error parsing string} testobj { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {abc 1 {expected boolean value but got "abc"}} test obj-13.6 {SetBooleanFromAny, error parsing string} testobj { set result "" lappend result [teststringobj set 1 x1.0] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {x1.0 1 {expected boolean value but got "x1.0"}} test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {{} 1 {expected boolean value but got ""}} test obj-13.8 {SetBooleanFromAny, unicode strings} testobj { set result "" lappend result [teststringobj set 1 1\u7777] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } "1\u7777 1 {expected boolean value but got \"1\u7777\"}" test obj-14.1 {UpdateStringOfBoolean} testobj { set result "" lappend result [testbooleanobj set 1 0] lappend result [testbooleanobj not 1] lappend result [testbooleanobj get 1] ;# must update string rep } {0 1 1} test obj-15.1 {Tcl_NewDoubleObj} testobj { set result "" lappend result [testobj freeallvars] lappend result [testdoubleobj set 1 3.1459] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 3.1459 double 2} test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] lappend result [testdoubleobj set 1 0.123] ;# makes existing obj boolean lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 0.123 double 2} test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 98765] lappend result [testdoubleobj set 1 27.56] ;# makes existing obj double lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 98765 27.56 double 2} test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} testobj { set result "" lappend result [testdoubleobj set 1 16.1] lappend result [testdoubleobj mult10 1] ;# gets existing double rep } {16.1 161.0} test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} testobj { set result "" lappend result [testintobj set 1 477] lappend result [testdoubleobj div10 1] ;# must convert to bool lappend result [testobj type 1] } {477 47.7 double} test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} testobj { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testdoubleobj mult10 1} msg] lappend result $msg } {abc 1 {expected floating-point number but got "abc"}} test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] lappend result [catch {testdoubleobj div10 1} msg] lappend result $msg } {{} 1 {expected floating-point number but got ""}} test obj-18.1 {DupDoubleInternalRep} testobj { set result "" lappend result [testdoubleobj set 1 17.1] lappend result [testobj duplicate 1 2] ;# uses DupDoubleInternalRep lappend result [testdoubleobj get 2] } {17.1 17.1 17.1} test obj-19.1 {SetDoubleFromAny, int to double special case} testobj { set result "" lappend result [testintobj set 1 1234] lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny lappend result [testobj type 1] } {1234 12340.0 double} test obj-19.2 {SetDoubleFromAny, boolean to double special case} testobj { set result "" lappend result [testbooleanobj set 1 1] lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny lappend result [testobj type 1] } {1 10.0 double} test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} testobj { set result "" lappend result [testintobj set 1 456] lappend result [testintobj div10 1] lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny lappend result [testobj type 1] } {456 45 450.0 double} test obj-19.4 {SetDoubleFromAny, error parsing string} testobj { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testdoubleobj mult10 1} msg] lappend result $msg } {abc 1 {expected floating-point number but got "abc"}} test obj-19.5 {SetDoubleFromAny, error parsing string} testobj { set result "" lappend result [teststringobj set 1 x1.0] lappend result [catch {testdoubleobj mult10 1} msg] lappend result $msg } {x1.0 1 {expected floating-point number but got "x1.0"}} test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] lappend result [catch {testdoubleobj div10 1} msg] lappend result $msg } {{} 1 {expected floating-point number but got ""}} test obj-20.1 {UpdateStringOfDouble} testobj { set result "" lappend result [testdoubleobj set 1 3.14159] lappend result [testdoubleobj mult10 1] lappend result [testdoubleobj get 1] ;# must update string rep } {3.14159 31.4159 31.4159} test obj-21.1 {Tcl_NewIntObj} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 55] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 55 int 2} test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] lappend result [testintobj set 1 77] ;# makes existing obj int lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 77 int 2} test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testdoubleobj set 1 12.34] lappend result [testintobj set 1 77] ;# makes existing obj int lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 12.34 77 int 2} test obj-23.1 {Tcl_GetIntFromObj, existing int object} testobj { set result "" lappend result [testintobj set 1 22] lappend result [testintobj mult10 1] ;# gets existing int rep } {22 220} test obj-23.2 {Tcl_GetIntFromObj, convert to int} testobj { set result "" lappend result [testintobj set 1 477] lappend result [testintobj div10 1] ;# must convert to bool lappend result [testobj type 1] } {477 47 int} test obj-23.3 {Tcl_GetIntFromObj, error converting to int} testobj { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {abc 1 {expected integer but got "abc"}} test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] lappend result [catch {testintobj div10 1} msg] lappend result $msg } {{} 1 {expected integer but got ""}} test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {testobj} { set result "" lappend result [testobj newobj 1] lappend result [testintobj inttoobigtest 1] } {{} 1} test obj-24.1 {DupIntInternalRep} testobj { set result "" lappend result [testintobj set 1 23] lappend result [testobj duplicate 1 2] ;# uses DupIntInternalRep lappend result [testintobj get 2] } {23 23 23} test obj-25.1 {SetIntFromAny, int to int special case} testobj { set result "" lappend result [testintobj set 1 1234] lappend result [testintobj mult10 1] ;# converts with SetIntFromAny lappend result [testobj type 1] } {1234 12340 int} test obj-25.2 {SetIntFromAny, boolean to int special case} testobj { set result "" lappend result [testbooleanobj set 1 1] lappend result [testintobj mult10 1] ;# converts with SetIntFromAny lappend result [testobj type 1] } {1 10 int} test obj-25.3 {SetIntFromAny, recompute string rep then parse it} testobj { set result "" lappend result [testintobj set 1 456] lappend result [testintobj div10 1] lappend result [testintobj mult10 1] ;# converts with SetIntFromAny lappend result [testobj type 1] } {456 45 450 int} test obj-25.4 {SetIntFromAny, error parsing string} testobj { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {abc 1 {expected integer but got "abc"}} test obj-25.5 {SetIntFromAny, error parsing string} testobj { set result "" lappend result [teststringobj set 1 x17] lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {x17 1 {expected integer but got "x17"}} test obj-25.6 {SetIntFromAny, integer too large} {testobj} { set result "" lappend result [teststringobj set 1 123456789012345678901] lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {123456789012345678901 1 {integer value too large to represent}} test obj-25.7 {SetIntFromAny, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] lappend result [catch {testintobj div10 1} msg] lappend result $msg } {{} 1 {expected integer but got ""}} test obj-26.1 {UpdateStringOfInt} testobj { set result "" lappend result [testintobj set 1 512] lappend result [testintobj mult10 1] lappend result [testintobj get 1] ;# must update string rep } {512 5120 5120} test obj-27.1 {Tcl_NewLongObj} testobj { set result "" lappend result [testobj freeallvars] testintobj setmaxlong 1 lappend result [testintobj ismaxlong 1] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 1 int 1} test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] lappend result [testintobj setlong 1 77] ;# makes existing obj long int lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 77 int 2} test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testdoubleobj set 1 12.34] lappend result [testintobj setlong 1 77] ;# makes existing obj long int lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 12.34 77 int 2} test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} testobj { set result "" lappend result [testintobj setlong 1 22] lappend result [testintobj mult10 1] ;# gets existing long int rep } {22 220} test obj-29.2 {Tcl_GetLongFromObj, convert to long} testobj { set result "" lappend result [testintobj setlong 1 477] lappend result [testintobj div10 1] ;# must convert to bool lappend result [testobj type 1] } {477 47 int} test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} testobj { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int lappend result $msg } {abc 1 {expected integer but got "abc"}} test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int lappend result $msg } {{} 1 {expected integer but got ""}} test obj-30.1 {Ref counting and object deletion, simple types} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 1024] lappend result [testobj assign 1 2] ;# vars 1 and 2 share the int obj lappend result [testobj type 2] lappend result [testobj refcount 1] lappend result [testobj refcount 2] lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs lappend result [testobj type 2] lappend result [testobj refcount 1] lappend result [testobj refcount 2] } {{} 1024 1024 int 4 4 0 int 3 2} test obj-31.1 {regenerate string rep of "end"} testobj { testobj freeallvars teststringobj set 1 end testobj convert 1 end-offset testobj invalidateStringRep 1 } end test obj-31.2 {regenerate string rep of "end-1"} testobj { testobj freeallvars teststringobj set 1 end-0x1 testobj convert 1 end-offset testobj invalidateStringRep 1 } end-1 test obj-31.3 {regenerate string rep of "end--1"} testobj { testobj freeallvars teststringobj set 1 end--0x1 testobj convert 1 end-offset testobj invalidateStringRep 1 } end--1 test obj-31.4 {regenerate string rep of "end-bigInteger"} testobj { testobj freeallvars teststringobj set 1 end-0x7fffffff testobj convert 1 end-offset testobj invalidateStringRep 1 } end-2147483647 test obj-31.5 {regenerate string rep of "end--bigInteger"} testobj { testobj freeallvars teststringobj set 1 end--0x7fffffff testobj convert 1 end-offset testobj invalidateStringRep 1 } end--2147483647 test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj longIs32bit} { testobj freeallvars teststringobj set 1 end--0x80000000 testobj convert 1 end-offset testobj invalidateStringRep 1 } end--2147483648 test obj-32.1 {freeing very large object trees} { set x {} for {set i 0} {$i<100000} {incr i} { set x [list $x {}] } unset x } {} test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x 0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 2147483648} test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} test obj-33.3 {integer overflow on input} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {0 4294967296} test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -2147483648} test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x -0x8000; append x 0001 list [string is integer $x] [expr { wide($x) }] } {1 -2147483649} test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x -0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 -4294967295} test obj-33.7 {integer overflow on input} { set x -0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {0 -4294967296} test obj-34.1 {mp_iseven} testobj { set result "" lappend result [testbignumobj set 1 0] lappend result [testbignumobj iseven 1] ; lappend result [testobj type 1] } {0 1 int} test obj-34.2 {mp_radix_size} testobj { set result "" lappend result [testbignumobj set 1 9] lappend result [testbignumobj radixsize 1] ; lappend result [testobj type 1] } {9 2 int} if {[testConstraint testobj]} { testobj freeallvars } # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/ooNext2.test0000644000175000017500000006200014554262142015241 0ustar sergeisergei# This file contains a collection of tests for Tcl's built-in object system. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 2006-2011 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require TclOO 1.1.0 if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { set lines [split [memory info] \n] return [lindex $lines 3 3] } proc leaktest {script {iterations 3}} { set end [getbytes] for {set i 0} {$i < $iterations} {incr i} { uplevel 1 $script set tmp $end set end [getbytes] } return [expr {$end - $tmp}] } } test oo-nextto-1.1 {basic nextto functionality} -setup { oo::class create root } -body { oo::class create A { superclass root method x args { lappend ::result ==A== $args } } oo::class create B { superclass A method x args { lappend ::result ==B== $args nextto A B -> A {*}$args } } oo::class create C { superclass A method x args { lappend ::result ==C== $args nextto A C -> A {*}$args } } oo::class create D { superclass B C method x args { lappend ::result ==D== $args next foo nextto C bar } } set ::result {} [D new] x return $::result } -cleanup { root destroy } -result {==D== {} ==B== foo ==A== {B -> A foo} ==C== bar ==A== {C -> A bar}} test oo-nextto-1.2 {basic nextto functionality} -setup { oo::class create root } -body { oo::class create A { superclass root method x args { lappend ::result ==A== $args } } oo::class create B { superclass A method x args { lappend ::result ==B== $args nextto A B -> A {*}$args } } oo::class create C { superclass A method x args { lappend ::result ==C== $args nextto A C -> A {*}$args } } oo::class create D { superclass B C method x args { lappend ::result ==D== $args nextto B foo {*}$args nextto C bar {*}$args } } set ::result {} [D new] x 123 return $::result } -cleanup { root destroy } -result {==D== 123 ==B== {foo 123} ==A== {B -> A foo 123} ==C== {bar 123} ==A== {C -> A bar 123}} test oo-nextto-1.3 {basic nextto functionality: constructors} -setup { oo::class create root } -body { oo::class create A { superclass root variable result constructor {a c} { lappend result ==A== a=$a,c=$c } } oo::class create B { superclass root variable result constructor {b} { lappend result ==B== b=$b } } oo::class create C { superclass A B variable result constructor {p q r} { lappend result ==C== p=$p,q=$q,r=$r # Route arguments to superclasses, in non-trivial pattern nextto B $q nextto A $p $r } method result {} {return $result} } [C new x y z] result } -cleanup { root destroy } -result {==C== p=x,q=y,r=z ==B== b=y ==A== a=x,c=z} test oo-nextto-1.4 {basic nextto functionality: destructors} -setup { oo::class create root {destructor return} } -body { oo::class create A { superclass root destructor { lappend ::result ==A== next } } oo::class create B { superclass root destructor { lappend ::result ==B== next } } oo::class create C { superclass A B destructor { lappend ::result ==C== lappend ::result | nextto B lappend ::result | nextto A lappend ::result | next } } set ::result "" [C new] destroy return $::result } -cleanup { root destroy } -result {==C== | ==B== | ==A== ==B== | ==A== ==B==} test oo-nextto-2.1 {errors in nextto} -setup { oo::class create root } -body { oo::class create A { superclass root method x y {error $y} } oo::class create B { superclass A method x y {nextto A $y} } [B new] x boom } -cleanup { root destroy } -result boom -returnCodes error test oo-nextto-2.2 {errors in nextto} -setup { oo::class create root } -body { oo::class create A { superclass root method x y {error $y} } oo::class create B { superclass root method x y {nextto A $y} } [B new] x boom } -returnCodes error -cleanup { root destroy } -result {method has no non-filter implementation by "A"} test oo-nextto-2.3 {errors in nextto} -setup { oo::class create root } -body { oo::class create A { superclass root method x y {nextto $y} } oo::class create B { superclass A method x y {nextto A $y} } [B new] x B } -returnCodes error -cleanup { root destroy } -result {method implementation by "B" not reachable from here} test oo-nextto-2.4 {errors in nextto} -setup { oo::class create root } -body { oo::class create A { superclass root method x y {nextto $y} } oo::class create B { superclass A method x y {nextto} } [B new] x B } -returnCodes error -cleanup { root destroy } -result {wrong # args: should be "nextto class ?arg...?"} test oo-nextto-2.5 {errors in nextto} -setup { oo::class create root } -body { oo::class create A { superclass root method x y {nextto $y} } oo::class create B { superclass A method x y {nextto $y $y $y} } [B new] x A } -cleanup { root destroy } -result {wrong # args: should be "nextto A y"} -returnCodes error test oo-nextto-2.6 {errors in nextto} -setup { oo::class create root } -body { oo::class create A { superclass root method x y {nextto $y} } oo::class create B { superclass A method x y {nextto $y $y $y} } [B new] x [root create notAClass] } -cleanup { root destroy } -result {"::notAClass" is not a class} -returnCodes error test oo-nextto-2.7 {errors in nextto} -setup { oo::class create root } -body { oo::class create A { superclass root method x y {nextto $y} } oo::class create B { superclass A filter Y method Y args {next {*}$args} } oo::class create C { superclass B method x y {nextto $y $y $y} } [C new] x B } -returnCodes error -cleanup { root destroy } -result {method has no non-filter implementation by "B"} test oo-call-1.1 {object call introspection} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } A create y info object call y x } -cleanup { root destroy } -result {{method x ::A method}} test oo-call-1.2 {object call introspection} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } oo::class create ::B { superclass A method x {} {} } B create y info object call y x } -cleanup { root destroy } -result {{method x ::B method} {method x ::A method}} test oo-call-1.3 {object call introspection} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } A create y oo::objdefine y method x {} {} info object call y x } -cleanup { root destroy } -result {{method x object method} {method x ::A method}} test oo-call-1.4 {object object call introspection - unknown} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } A create y info object call y z } -cleanup { root destroy } -result {{unknown unknown ::oo::object {core method: "unknown"}}} test oo-call-1.5 {object call introspection - filters} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} method y {} {} filter y } A create y info object call y x } -cleanup { root destroy } -result {{filter y ::A method} {method x ::A method}} test oo-call-1.6 {object call introspection - filters} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} method y {} {} filter y } oo::class create ::B { superclass A method x {} {} } B create y info object call y x } -cleanup { root destroy } -result {{filter y ::A method} {method x ::B method} {method x ::A method}} test oo-call-1.7 {object call introspection - filters} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} method y {} {} filter y } oo::class create ::B { superclass A method x {} {} method y {} {} } B create y info object call y x } -cleanup { root destroy } -result {{filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}} test oo-call-1.8 {object call introspection - filters} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} method y {} {} filter y } oo::class create ::B { superclass A method x {} {} method y {} {} method z {} {} filter z } B create y info object call y x } -cleanup { root destroy } -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}} test oo-call-1.9 {object call introspection - filters} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} method y {} {} filter y } oo::class create ::B { superclass A method x {} {} method y {} {} method z {} {} filter z } B create y info object call y y } -cleanup { root destroy } -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method y ::B method} {method y ::A method}} test oo-call-1.10 {object call introspection - filters + unknown} -setup { oo::class create root } -body { oo::class create ::A { superclass root method y {} {} filter y } oo::class create ::B { superclass A method y {} {} method unknown {} {} } B create y info object call y x } -cleanup { root destroy } -result {{filter y ::B method} {filter y ::A method} {unknown unknown ::B method} {unknown unknown ::oo::object {core method: "unknown"}}} test oo-call-1.11 {object call introspection - filters + unknown} -setup { oo::class create root } -body { oo::class create ::A { superclass root method y {} {} filter y } A create y oo::objdefine y method unknown {} {} info object call y x } -cleanup { root destroy } -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}} test oo-call-1.12 {object call introspection - filters + unknown} -setup { oo::class create root } -body { oo::class create ::A { superclass root method y {} {} } A create y oo::objdefine y { method unknown {} {} filter y } info object call y x } -cleanup { root destroy } -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}} test oo-call-1.13 {object call introspection - filters + unknown} -setup { oo::class create root } -body { oo::class create ::A { superclass root method y {} {} } A create y oo::objdefine y { method unknown {} {} method x {} {} filter y } info object call y x } -cleanup { root destroy } -result {{filter y ::A method} {method x object method}} test oo-call-1.14 {object call introspection - errors} -body { info object call } -returnCodes error -result {wrong # args: should be "info object call objName methodName"} test oo-call-1.15 {object call introspection - errors} -body { info object call a } -returnCodes error -result {wrong # args: should be "info object call objName methodName"} test oo-call-1.16 {object call introspection - errors} -body { info object call a b c } -returnCodes error -result {wrong # args: should be "info object call objName methodName"} test oo-call-1.17 {object call introspection - errors} -body { info object call notanobject x } -returnCodes error -result {notanobject does not refer to an object} test oo-call-1.18 {object call introspection - memory leaks} -body { leaktest { info object call oo::object destroy } } -constraints memory -result 0 test oo-call-1.19 {object call introspection - memory leaks} -setup { oo::class create leaktester { method foo {} {dummy} } } -body { leaktest { set lt [leaktester new] oo::objdefine $lt method foobar {} {dummy} list [info object call $lt destroy] \ [info object call $lt foo] \ [info object call $lt bar] \ [info object call $lt foobar] \ [$lt destroy] } } -cleanup { leaktester destroy } -constraints memory -result 0 test oo-call-1.20 {object call introspection - complex case} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } oo::class create ::B { superclass A method x {} {} } oo::class create ::C { superclass root method x {} {} mixin B } oo::class create ::D { superclass C method x {} {} } oo::class create ::E { superclass root method x {} {} } oo::class create ::F { superclass E method x {} {} } oo::class create ::G { superclass root method x {} {} } oo::class create ::H { superclass G method x {} {} } oo::define F mixin H F create y oo::objdefine y { method x {} {} mixin D } info object call y x } -cleanup { root destroy } -result {{method x ::D method} {method x ::B method} {method x ::A method} {method x ::C method} {method x ::H method} {method x ::G method} {method x object method} {method x ::F method} {method x ::E method}} test oo-call-1.21 {object call introspection - complex case} -setup { oo::class create root } -body { oo::class create ::A { superclass root method y {} {} filter y } oo::class create ::B { superclass A method y {} {} } oo::class create ::C { superclass root method x {} {} mixin B } oo::class create ::D { superclass C filter x } oo::class create ::E { superclass root method y {} {} method x {} {} } oo::class create ::F { superclass E method z {} {} method q {} {} } F create y oo::objdefine y { method unknown {} {} mixin D filter q } info object call y z } -cleanup { root destroy } -result {{filter x ::C method} {filter x ::E method} {filter y ::B method} {filter y ::A method} {filter y ::E method} {filter q ::F method} {method z ::F method}} test oo-call-2.1 {class call introspection} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } info class call A x } -cleanup { root destroy } -result {{method x ::A method}} test oo-call-2.2 {class call introspection} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } oo::class create ::B { superclass A method x {} {} } list [info class call A x] [info class call B x] } -cleanup { root destroy } -result {{{method x ::A method}} {{method x ::B method} {method x ::A method}}} test oo-call-2.3 {class call introspection} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } oo::class create ::B { superclass A method x {} {} } oo::class create ::C { superclass A method x {} {} } oo::class create ::D { superclass C B method x {} {} } info class call D x } -cleanup { root destroy } -result {{method x ::D method} {method x ::C method} {method x ::B method} {method x ::A method}} test oo-call-2.4 {class call introspection - mixin} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } oo::class create ::B { superclass A method x {} {} } oo::class create ::C { superclass A method x {} {} } oo::class create ::D { superclass C mixin B method x {} {} } info class call D x } -cleanup { root destroy } -result {{method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}} test oo-call-2.5 {class call introspection - mixin + filter} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } oo::class create ::B { superclass A method x {} {} method y {} {} filter y } oo::class create ::C { superclass A method x {} {} method y {} {} } oo::class create ::D { superclass C mixin B method x {} {} } info class call D x } -cleanup { root destroy } -result {{filter y ::B method} {filter y ::C method} {method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}} test oo-call-2.6 {class call introspection - mixin + filter + unknown} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} method unknown {} {} } oo::class create ::B { superclass A method x {} {} method y {} {} filter y } oo::class create ::C { superclass A method x {} {} method y {} {} } oo::class create ::D { superclass C mixin B method x {} {} method unknown {} {} } info class call D z } -cleanup { root destroy } -result {{filter y ::B method} {filter y ::C method} {unknown unknown ::D method} {unknown unknown ::A method} {unknown unknown ::oo::object {core method: "unknown"}}} test oo-call-2.7 {class call introspection - mixin + filter + unknown} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} } oo::class create ::B { superclass A method x {} {} filter x } info class call B x } -cleanup { root destroy } -result {{filter x ::B method} {filter x ::A method} {method x ::B method} {method x ::A method}} test oo-call-2.8 {class call introspection - errors} -body { info class call } -returnCodes error -result {wrong # args: should be "info class call className methodName"} test oo-call-2.9 {class call introspection - errors} -body { info class call a } -returnCodes error -result {wrong # args: should be "info class call className methodName"} test oo-call-2.10 {class call introspection - errors} -body { info class call a b c } -returnCodes error -result {wrong # args: should be "info class call className methodName"} test oo-call-2.11 {class call introspection - errors} -body { info class call notaclass x } -returnCodes error -result {notaclass does not refer to an object} test oo-call-2.12 {class call introspection - errors} -setup { oo::class create root } -body { root create notaclass info class call notaclass x } -returnCodes error -cleanup { root destroy } -result {"notaclass" is not a class} test oo-call-2.13 {class call introspection - memory leaks} -body { leaktest { info class call oo::class destroy } } -constraints memory -result 0 test oo-call-2.14 {class call introspection - memory leaks} -body { leaktest { oo::class create leaktester { method foo {} {dummy} } [leaktester new] destroy list [info class call leaktester destroy] \ [info class call leaktester foo] \ [info class call leaktester bar] \ [leaktester destroy] } } -constraints memory -result 0 test oo-call-3.1 {current call introspection} -setup { oo::class create root } -body { oo::class create A { superclass root method x {} {lappend ::result [self call]} } oo::class create B { superclass A method x {} {lappend ::result [self call];next} } B create y oo::objdefine y method x {} {lappend ::result [self call];next} set ::result {} y x } -cleanup { root destroy } -result {{{{method x object method} {method x ::B method} {method x ::A method}} 0} {{{method x object method} {method x ::B method} {method x ::A method}} 1} {{{method x object method} {method x ::B method} {method x ::A method}} 2}} test oo-call-3.2 {current call introspection} -setup { oo::class create root } -constraints memory -body { oo::class create A { superclass root method x {} {self call} } oo::class create B { superclass A method x {} {self call;next} } B create y oo::objdefine y method x {} {self call;next} leaktest { y x } } -cleanup { root destroy } -result 0 test oo-call-3.3 {current call introspection: in constructors} -setup { oo::class create root } -body { oo::class create A { superclass root constructor {} {lappend ::result [self call]} } oo::class create B { superclass A constructor {} {lappend ::result [self call]; next} } set ::result {} [B new] destroy return $::result } -cleanup { root destroy } -result {{{{method ::B method} {method ::A method}} 0} {{{method ::B method} {method ::A method}} 1}} test oo-call-3.4 {current call introspection: in destructors} -setup { oo::class create root } -body { oo::class create A { superclass root destructor {lappend ::result [self call]} } oo::class create B { superclass A destructor {lappend ::result [self call]; next} } set ::result {} [B new] destroy return $::result } -cleanup { root destroy } -result {{{{method ::B method} {method ::A method}} 0} {{{method ::B method} {method ::A method}} 1}} # Contributed tests from aspect, related to [0f42ff7871] # # dkf's "Principles Leading to a Fix" # # A method ought to work "the same" whether or not it has been overridden by # a subclass. A tailcalled command ought to have as parent stack the same # thing you'd get with uplevel 1. A subclass will often expect the # superclass's result to be the result that would be returned if the # subclass was not there. # Common setup: # any invocation of bar should emit "abc\nhi\n" then return to its # caller set testopts { -setup { oo::class create Parent oo::class create Foo { superclass Parent method bar {} { puts abc tailcall puts hi puts xyz } } oo::class create Foo2 { superclass Parent } } -cleanup { Parent destroy } } # these succeed, showing that without [next] the bug doesn't fire test next-tailcall-simple-1 "trivial case with one method" {*}$testopts -body { [Foo create foo] bar } -output [join {abc hi} \n]\n test next-tailcall-simple-2 "my bar" {*}$testopts -body { oo::define Foo method baz {} { puts a my bar puts b } [Foo create foo] baz } -output [join {a abc hi b} \n]\n test next-tailcall-simple-3 "\[self\] bar" {*}$testopts -body { oo::define Foo method baz {} { puts a [self] bar puts b } [Foo create foo] baz } -output [join {a abc hi b} \n]\n test next-tailcall-simple-4 "foo bar" {*}$testopts -body { oo::define Foo method baz {} { puts a foo bar puts b } [Foo create foo] baz } -output [join {a abc hi b} \n]\n # everything from here on uses [next], and fails on 8.6.4 with compilation test next-tailcall-superclass-1 "next superclass" {*}$testopts -body { oo::define Foo2 { superclass Foo method bar {} { puts a next puts b } } [Foo2 create foo] bar } -output [join {a abc hi b} \n]\n test next-tailcall-superclass-2 "nextto superclass" {*}$testopts -body { oo::define Foo2 { superclass Foo method bar {} { puts a nextto Foo puts b } } [Foo2 create foo] bar } -output [join {a abc hi b} \n]\n test next-tailcall-mixin-1 "class mixin" {*}$testopts -body { oo::define Foo2 { method Bar {} { puts a next puts b } filter Bar } oo::define Foo mixin Foo2 Foo create foo foo bar } -output [join {a abc hi b} \n]\n test next-tailcall-objmixin-1 "object mixin" {*}$testopts -body { oo::define Foo2 { method Bar {} { puts a next puts b } filter Bar } Foo create foo oo::objdefine foo mixin Foo2 foo bar } -output [join {a abc hi b} \n]\n test next-tailcall-filter-1 "filter method" {*}$testopts -body { oo::define Foo method Filter {} { puts a next puts b } oo::define Foo filter Filter [Foo new] bar } -output [join {a abc hi b} \n]\n test next-tailcall-forward-1 "forward method" {*}$testopts -body { proc foobar {} { puts "abc" tailcall puts "hi" puts "xyz" } oo::define Foo forward foobar foobar oo::define Foo2 { superclass Foo method foobar {} { puts a next puts b } } [Foo2 new] foobar } -output [join {a abc hi b} \n]\n test next-tailcall-constructor-1 "next in constructor" -body { oo::class create Foo { constructor {} { puts abc tailcall puts hi puts xyz } } oo::class create Foo2 { superclass Foo constructor {} { puts a next puts b } } list [Foo new] [Foo2 new] return "" } -cleanup { Foo destroy } -output [join {abc hi a abc hi b} \n]\n test next-tailcall-destructor-1 "next in destructor" -body { oo::class create Foo { destructor { puts abc tailcall puts hi puts xyz } } oo::class create Foo2 { superclass Foo destructor { puts a next puts b } } Foo create foo Foo2 create foo2 foo destroy foo2 destroy } -output [join {abc hi a abc hi b} \n]\n -cleanup { Foo destroy } unset testopts cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/oo.test0000644000175000017500000034005514554262142014331 0ustar sergeisergei# This file contains a collection of tests for Tcl's built-in object system. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 2006-2013 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require TclOO 1.1.0 if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # The foundational objects oo::object and oo::class are sensitive to reference # counting errors and are deallocated only when an interp is deleted, so in # this test suite, interp creation and interp deletion are often used in # leaktests in order to leverage this sensitivity. testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { set lines [split [memory info] \n] return [lindex $lines 3 3] } proc leaktest {script {iterations 3}} { set end [getbytes] for {set i 0} {$i < $iterations} {incr i} { uplevel 1 $script set tmp $end set end [getbytes] } return [expr {$end - $tmp}] } } test oo-0.1 {basic test of OO's ability to clean up its initial state} { interp create t t eval { package require TclOO } interp delete t } {} test oo-0.2 {basic test of OO's ability to clean up its initial state} { set i [interp create] interp eval $i { package require TclOO namespace delete :: } interp delete $i } {} test oo-0.3 {basic test of OO's ability to clean up its initial state} -body { leaktest { [oo::object new] destroy } } -constraints memory -result 0 test oo-0.4 {basic test of OO's ability to clean up its initial state} -body { leaktest { oo::class create foo foo new foo destroy } } -constraints memory -result 0 test oo-0.5.1 {testing object foundation cleanup} memory { leaktest { interp create foo interp delete foo } } 0 test oo-0.5.2 {testing literal leak on interp delete} memory { leaktest { interp create foo foo eval {oo::object new} interp delete foo } } 0 test oo-0.6 {cleaning the core class pair; way #1} -setup { interp create t } -body { t eval { package require TclOO namespace path oo list [catch {class destroy} m] $m [catch {object destroy} m] $m } } -cleanup { interp delete t } -result {0 {} 1 {invalid command name "object"}} test oo-0.7 {cleaning the core class pair; way #2} -setup { interp create t } -body { t eval { package require TclOO namespace path oo list [catch {object destroy} m] $m [catch {class destroy} m] $m } } -cleanup { interp delete t } -result {0 {} 1 {invalid command name "class"}} test oo-0.8 {leak in variable management} -setup { oo::class create foo } -constraints memory -body { oo::define foo { constructor {} { variable v 0 } } leaktest {[foo new] destroy} } -cleanup { foo destroy } -result 0 test oo-0.9 {various types of presence of the TclOO package} { list [lsearch -nocase -all -inline [package names] tcloo] \ [package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}] } [list TclOO $::oo::patchlevel 1] test oo-1.1 {basic test of OO functionality: no classes} { set result {} lappend result [oo::object create foo] lappend result [oo::objdefine foo { method bar args { global result lappend result {*}$args return [llength $args] } }] lappend result [foo bar a b c] lappend result [foo destroy] [info commands foo] } {::foo {} a b c 3 {} {}} test oo-1.2 {basic test of OO functionality: no classes} -body { oo::define oo::object method missingArgs } -returnCodes 1 -result "wrong # args: should be \"oo::define oo::object method name args body\"" test oo-1.3 {basic test of OO functionality: no classes} { catch {oo::define oo::object method missingArgs} set errorInfo } "wrong # args: should be \"oo::define oo::object method name args body\" while executing \"oo::define oo::object method missingArgs\"" test oo-1.4 {basic test of OO functionality} -body { oo::object create {} } -returnCodes 1 -result {object name must not be empty} test oo-1.4.1 {fully-qualified nested name} -body { oo::object create ::one::two::three } -result {::one::two::three} test oo-1.4.2 {automatic command name has same name as namespace} -body { set obj [oo::object new] expr {[info object namespace $obj] == $obj} } -result 1 test oo-1.5 {basic test of OO functionality} -body { oo::object doesnotexist } -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new} test oo-1.5.1 {basic test of OO functionality} -setup { oo::object create aninstance } -returnCodes error -body { aninstance } -cleanup { rename aninstance {} } -result {wrong # args: should be "aninstance method ?arg ...?"} test oo-1.6 {basic test of OO functionality} -setup { oo::object create aninstance } -body { oo::objdefine aninstance unexport destroy aninstance doesnotexist } -cleanup { rename aninstance {} } -returnCodes 1 -result {object "::aninstance" has no visible methods} test oo-1.7 {basic test of OO functionality} -setup { oo::object create aninstance } -body { oo::objdefine aninstance { # Do not do this in real code! Ever! This is *not* supported! ::oo::define::method ha ha ha } } -returnCodes error -cleanup { aninstance destroy } -result {attempt to misuse API} test oo-1.8 {basic test of OO functionality} -setup { oo::object create obj set result {} } -cleanup { obj destroy } -body { oo::objdefine obj method foo {} {return bar} lappend result [obj foo] oo::objdefine obj method foo {} {} lappend result [obj foo] } -result {bar {}} test oo-1.9 {basic test of OO functionality} -setup { oo::object create a oo::object create b } -cleanup { catch {a destroy} b destroy } -body { oo::objdefine a method foo {} { return A } oo::objdefine b method foo {} { return B } apply {{} { set m foo return [a $m],[a destroy],[b $m] }} } -result A,,B test oo-1.10 {basic test of OO functionality} -body { namespace eval foo { namespace eval bar { oo::object create o namespace export o } namespace import bar::o } list [info object isa object foo::bar::o] [info object isa object foo::o] } -cleanup { namespace delete foo } -result {1 1} test oo-1.11 {basic test of OO functionality: abbreviating} -setup { oo::class create c } -cleanup { c destroy } -body { oo::define c super oo::class info class super c } -result ::oo::class test oo-1.12 {basic test of OO functionality: abbreviating} -setup { oo::class create c } -cleanup { c destroy } -body { oo::define c {super oo::class} info class super c } -result ::oo::class test oo-1.13 {basic test of OO functionality: abbreviating} -setup { oo::class create c } -cleanup { c destroy } -body { oo::define c self {forw a b} info object forw c a } -result b test oo-1.14 {basic test of OO functionality: abbreviating} -setup { oo::class create c } -cleanup { c destroy } -body { oo::define c self forw a b info object forw c a } -result b test oo-1.15 {basic test of OO functionality: abbreviating} -setup { oo::object create o } -cleanup { o destroy } -body { oo::objdefine o {forw a b} info object forw o a } -result b test oo-1.16 {basic test of OO functionality: abbreviating} -setup { oo::object create o } -cleanup { o destroy } -body { oo::objdefine o forw a b info object forw o a } -result b test oo-1.17 {basic test of OO functionality: Bug 2481109} -body { namespace eval ::foo {oo::object create lreplace} } -cleanup { namespace delete ::foo } -result ::foo::lreplace # Check for Bug 2519474; problem in tclNamesp.c, but tested here... test oo-1.18 {OO: create object in NS with same name as global cmd} -setup { proc test-oo-1.18 {} return oo::class create A oo::class create B {superclass A} } -body { oo::define B constructor {} {A create test-oo-1.18} B create C } -cleanup { rename test-oo-1.18 {} A destroy } -result ::C test oo-1.18.1 {no memory leak: superclass} -setup { } -constraints memory -body { leaktest { interp create t t eval { oo::class create A { superclass oo::class } } interp delete t } } -cleanup { } -result 0 test oo-1.18.2 {Bug 75b8433707: memory leak in oo-1.18} -setup { proc test-oo-1.18 {} return } -constraints memory -body { leaktest { oo::class create A oo::class create B {superclass A} oo::define B constructor {} {A create test-oo-1.18} B create C A destroy } } -cleanup { rename test-oo-1.18 {} } -result 0 test oo-1.18.3 {Bug 21c144f0f5} -setup { interp create child } -body { child eval { oo::define [oo::class create foo] superclass oo::class oo::class destroy } } -cleanup { interp delete child } test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup { interp create child } -body { child eval { oo::class create A oo::class create B { superclass oo::class constructor {} { next {superclass A} next {superclass -append A} } } [B create C] create d } } -returnCodes error -cleanup { interp delete child } -result {class should only be a direct superclass once} test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup { interp create child } -body { child eval { oo::class create A oo::class create B { superclass oo::class constructor {c} { next {superclass A} next [list superclass -append {*}$c] } } [B create C {B C}] create d } } -returnCodes error -cleanup { interp delete child } -result {attempt to form circular dependency graph} test oo-1.19 {basic test of OO functionality: teardown order} -body { oo::object create o namespace delete [info object namespace o] o destroy # Crashes on error } -returnCodes error -result {invalid command name "o"} test oo-1.20 {basic test of OO functionality: my teardown post rename} -body { oo::object create obj rename [info object namespace obj]::my ::AGlobalName obj destroy info commands ::AGlobalName } -result {} test oo-1.21 {basic test of OO functionality: default relations} -setup { set fresh [interp create] } -body { lmap x [$fresh eval { foreach cmd {instances subclasses mixins superclass} { foreach initial {object class Slot} { lappend x [info class $cmd ::oo::$initial] } } foreach initial {object class Slot} { lappend x [info object class ::oo::$initial] } return $x }] {lsort $x} } -cleanup { interp delete $fresh } -result {{} {::oo::Slot ::oo::class ::oo::object} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class} test oo-2.1 {basic test of OO functionality: constructor} -setup { # This is a bit complex because it needs to run in a sub-interp as # we're modifying the root object class's constructor interp create subinterp subinterp eval { package require TclOO } } -body { subinterp eval { oo::define oo::object constructor {} { lappend ::result [info level 0] } lappend result 1 lappend result 2 [oo::object create foo] } } -cleanup { interp delete subinterp } -result {1 {oo::object create foo} 2 ::foo} test oo-2.2 {basic test of OO functionality: constructor} { oo::class create testClass { constructor {} { global result lappend result "[self]->construct" } method bar {} { global result lappend result "[self]->bar" } } set result {} [testClass create foo] bar testClass destroy return $result } {::foo->construct ::foo->bar} test oo-2.4 {OO constructor - Bug 2531577} -setup { oo::class create foo } -body { oo::define foo constructor {} return [foo new] destroy oo::define foo constructor {} {} llength [info command [foo new]] } -cleanup { foo destroy } -result 1 test oo-2.5 {OO constructor - Bug 2531577} -setup { oo::class create foo set result {} } -body { oo::define foo constructor {} {error x} lappend result [catch {foo new}] oo::define foo constructor {} {} lappend result [llength [info command [foo new]]] } -cleanup { foo destroy } -result {1 1} test oo-2.6 {OO constructor and tailcall - Bug 2414858} -setup { oo::class create foo } -body { oo::define foo { constructor {} { tailcall my bar } method bar {} { return bad } } namespace tail [foo create good] } -cleanup { foo destroy } -result good test oo-2.7 {construction, method calls and ensembles - Bug 3514761} -setup { namespace eval k {} } -body { namespace eval k { oo::class create s { constructor {j} { # nothing } } namespace export s namespace ensemble create } k s create X } -returnCodes error -cleanup { namespace delete k } -result {wrong # args: should be "k s create X j"} test oo-2.8 {construction, method calls and ensembles - Bug 3514761} -setup { namespace eval k {} } -body { namespace eval k { oo::class create s { constructor {j} { # nothing } } oo::class create t { superclass s constructor args { k next {*}$args } } interp alias {} ::k::next {} ::oo::Helpers::next namespace export t next namespace ensemble create } k t create X } -returnCodes error -cleanup { namespace delete k } -result {wrong # args: should be "k next j"} test oo-2.9 {construction failures and self creation} -setup { set ::result {} oo::class create Root } -body { oo::class create A { superclass Root constructor {} { lappend ::result "in A" error "failure in A" } destructor {lappend ::result [self]} } oo::class create B { superclass Root constructor {} { lappend ::result "in B [self]" error "failure in B" } destructor {lappend ::result [self]} } lappend ::result [catch {A create a} msg] $msg lappend ::result [catch {B create b} msg] $msg } -cleanup { Root destroy } -result {{in A} ::a 1 {failure in A} {in B ::b} ::b 1 {failure in B}} test oo-3.1 {basic test of OO functionality: destructor} -setup { # This is a bit complex because it needs to run in a sub-interp as we're # modifying the root object class's constructor interp create subinterp subinterp eval { package require TclOO } } -body { subinterp eval { oo::define oo::object destructor { lappend ::result died } lappend result 1 [oo::object create foo] lappend result 2 [rename foo {}] oo::define oo::object destructor {} return $result } } -cleanup { interp delete subinterp } -result {1 ::foo died 2 {}} test oo-3.2 {basic test of OO functionality: destructor} -setup { # This is a bit complex because it needs to run in a sub-interp as # we're modifying the root object class's constructor interp create subinterp subinterp eval { package require TclOO } } -body { subinterp eval { oo::define oo::object destructor { lappend ::result died } lappend result 1 [oo::object create foo] lappend result 2 [rename foo {}] } } -cleanup { interp delete subinterp } -result {1 ::foo died 2 {}} test oo-3.3 {basic test of OO functionality: destructor} -setup { oo::class create foo set result {} } -cleanup { foo destroy } -body { oo::define foo { constructor {} {lappend ::result made} destructor {lappend ::result died} } namespace delete [info object namespace [foo new]] return $result } -result {made died} test oo-3.4 {basic test of OO functionality: my exists in destructor} -setup { oo::class create cls set result {} } -cleanup { cls destroy } -body { oo::define cls { variable state constructor {} { proc localcmdexists {} {} set state ok } forward Report lappend ::result destructor { objmy Report [catch {set state} msg] $msg objmy Report [namespace which -var state] objmy Report [info commands localcmdexists] } } cls create obj rename [info object namespace obj]::my ::objmy obj destroy lappend result [info commands ::objmy] } -match glob -result {0 ok *::state localcmdexists {}} test oo-3.4a {basic test of OO functionality: my exists in destructor} -setup { oo::class create cls set result {} } -cleanup { cls destroy } -body { oo::define cls { variable state constructor {} { proc localcmdexists {} {} set state ok } forward Report lappend ::result destructor { objmy Report [catch {set state} msg] $msg objmy Report [namespace which -var state] objmy Report [info commands localcmdexists] } } cls create obj rename [info object namespace obj]::my ::objmy rename obj {} lappend result [info commands ::objmy] } -match glob -result {0 ok *::state localcmdexists {}} test oo-3.5 {basic test of OO functionality: destructor: evil case for Itcl} -setup { oo::class create cls set result {} } -cleanup { cls destroy } -body { oo::define cls { variable state constructor {} { proc localcmdexists {} {} set state ok } forward Report lappend ::result destructor { objmy Report [catch {set state} msg] $msg objmy Report [namespace which -var state] objmy Report [info commands localcmdexists] } } cls create obj rename [info object namespace obj]::my ::objmy namespace delete [info object namespace obj] lappend result [info commands ::objmy] } -match glob -result {0 ok *::state localcmdexists {}} test oo-3.5a {basic test of OO functionality: destructor: evil case for Itcl} -setup { oo::class create cls set result {} } -cleanup { cls destroy } -body { oo::define cls { variable state result constructor {} { proc localcmdexists {} {} set state ok my eval {upvar 0 ::result result} } method nuke {} { namespace delete [namespace current] return $result } destructor { lappend result [self] $state [info commands localcmdexists] } } cls create obj namespace delete [info object namespace obj] [cls create obj2] nuke } -match glob -result {::obj ok localcmdexists ::obj2 ok localcmdexists} test oo-3.6 {basic test of OO functionality: errors in destructor} -setup { oo::class create cls } -cleanup { cls destroy } -body { oo::define cls destructor {error foo} list [catch {[cls create obj] destroy} msg] $msg [info commands obj] } -result {1 foo {}} test oo-3.7 {basic test of OO functionality: errors in destructor} -setup { oo::class create cls set result {} proc bgerror msg {lappend ::result $msg} } -cleanup { cls destroy rename bgerror {} } -body { oo::define cls destructor {error foo} list [rename [cls create obj] {}] \ [update idletasks] $result [info commands obj] } -result {{} {} foo {}} test oo-3.8 {basic test of OO functionality: errors in destructor} -setup { oo::class create cls set result {} proc bgerror msg {lappend ::result $msg} } -cleanup { cls destroy rename bgerror {} } -body { oo::define cls destructor {error foo} list [namespace delete [info object namespace [cls create obj]]] \ [update idletasks] $result [info commands obj] } -result {{} {} foo {}} test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup { oo::class create cls set result {} } -body { oo::define cls { destructor { lappend ::result in destructor [self] destroy } } # This used to crash [cls new] destroy return $result } -cleanup { cls destroy } -result {in destructor} test oo-3.10 {Bug 3d96b7076e: killing the object's class in a method call} -setup { oo::class create Super } -body { # Only reliably failed in a memdebug build oo::class create Cls { superclass Super method mthd {} { [self class] destroy return ok } } [Cls new] mthd } -cleanup { Super destroy } -result ok test oo-3.11 {Bug 3d96b7076e: killing the object's class in a method call} -setup { oo::class create Super oo::class create Sub { superclass Super } } -body { # Only reliably failed in a memdebug build oo::class create Cls { superclass Super method mthd {} { oo::objdefine [self] class Sub Cls destroy return ok } } [Cls new] mthd } -cleanup { Super destroy } -result ok test oo-3.12 {Bug 3d96b7076e: killing the object's class in a method call} -setup { oo::class create Super } -body { # Only reliably failed in a memdebug build oo::class create Cls { superclass Super method mthd {} { [self class] destroy return ok } } set o [Super new] oo::objdefine $o mixin Cls $o mthd } -cleanup { Super destroy } -result ok test oo-4.1 {basic test of OO functionality: export} { set o [oo::object new] set result {} oo::objdefine $o method Foo {} {lappend ::result Foo; return} lappend result [catch {$o Foo} msg] $msg oo::objdefine $o export Foo lappend result [$o Foo] [$o destroy] } {1 {unknown method "Foo": must be destroy} Foo {} {}} test oo-4.2 {basic test of OO functionality: unexport} { set o [oo::object new] set result {} oo::objdefine $o method foo {} {lappend ::result foo; return} lappend result [$o foo] oo::objdefine $o unexport foo lappend result [catch {$o foo} msg] $msg [$o destroy] } {foo {} 1 {unknown method "foo": must be destroy} {}} test oo-4.3 {exporting and error messages, Bug 1824958} -setup { oo::class create testClass } -cleanup { testClass destroy } -body { oo::define testClass self export Bad testClass Bad } -returnCodes 1 -result {unknown method "Bad": must be create, destroy or new} test oo-4.4 {exporting a class method from an object} -setup { oo::class create testClass testClass create testObject } -cleanup { testClass destroy } -body { oo::define testClass method Good {} { return ok } oo::objdefine testObject export Good testObject Good } -result ok test oo-4.5 {export creates proper method entries} -setup { oo::class create testClass } -body { oo::define testClass { export foo method foo {} {return ok} } [testClass new] foo } -cleanup { testClass destroy } -result ok test oo-4.6 {export creates proper method entries} -setup { oo::class create testClass } -body { oo::define testClass { unexport foo method foo {} {return ok} } [testClass new] foo } -cleanup { testClass destroy } -result ok test oo-5.1 {OO: manipulation of classes as objects} -setup { set obj [oo::object new] } -body { oo::objdefine oo::object method foo {} { return "in object" } catch {$obj foo} result list [catch {$obj foo} result] $result [oo::object foo] } -cleanup { oo::objdefine oo::object deletemethod foo $obj destroy } -result {1 {unknown method "foo": must be destroy} {in object}} test oo-5.2 {OO: manipulation of classes as objects} -setup { set obj [oo::object new] } -body { oo::define oo::object self method foo {} { return "in object" } catch {$obj foo} result list [catch {$obj foo} result] $result [oo::object foo] } -cleanup { oo::objdefine oo::object deletemethod foo $obj destroy } -result {1 {unknown method "foo": must be destroy} {in object}} test oo-5.3 {OO: manipulation of classes as objects} -setup { set obj [oo::object new] } -body { oo::objdefine oo::object { method foo {} { return "in object" } } catch {$obj foo} result list [catch {$obj foo} result] $result [oo::object foo] } -cleanup { oo::objdefine oo::object deletemethod foo $obj destroy } -result {1 {unknown method "foo": must be destroy} {in object}} test oo-5.4 {OO: manipulation of classes as objects} -setup { set obj [oo::object new] } -body { oo::define oo::object { self method foo {} { return "in object" } } catch {$obj foo} result list [catch {$obj foo} result] $result [oo::object foo] } -cleanup { oo::objdefine oo::object deletemethod foo $obj destroy } -result {1 {unknown method "foo": must be destroy} {in object}} test oo-5.5 {OO: manipulation of classes as objects} -setup { set obj [oo::object new] } -body { oo::define oo::object { self { method foo {} { return "in object" } } } catch {$obj foo} result list [catch {$obj foo} result] $result [oo::object foo] } -cleanup { oo::objdefine oo::object deletemethod foo $obj destroy } -result {1 {unknown method "foo": must be destroy} {in object}} test oo-6.1 {OO: forward} { oo::object create foo oo::objdefine foo { forward a lappend forward b lappend result } set result {} foo a result 1 foo b 2 foo destroy return $result } {1 2} test oo-6.2 {OO: forward resolution scope} -setup { oo::class create fooClass } -body { proc foo {} {return bad} oo::define fooClass { constructor {} { proc foo {} {return good} } forward bar foo } [fooClass new] bar } -cleanup { fooClass destroy rename foo {} } -result good test oo-6.3 {OO: forward resolution scope} -setup { oo::class create fooClass } -body { proc foo {} {return bad} oo::define fooClass { constructor {} { proc foo {} {return good} } } oo::define fooClass forward bar foo [fooClass new] bar } -cleanup { fooClass destroy rename foo {} } -result good test oo-6.4 {OO: forward resolution scope} -setup { oo::class create fooClass } -body { proc foo {} {return good} oo::define fooClass { constructor {} { proc foo {} {return bad} } forward bar ::foo } [fooClass new] bar } -cleanup { fooClass destroy rename foo {} } -result good test oo-6.5 {OO: forward resolution scope} -setup { oo::class create fooClass namespace eval foo {} } -body { proc foo::foo {} {return good} oo::define fooClass { constructor {} { proc foo {} {return bad} } forward bar foo::foo } [fooClass new] bar } -cleanup { fooClass destroy namespace delete foo } -result good test oo-6.6 {OO: forward resolution scope} -setup { oo::class create fooClass namespace eval foo {} } -body { proc foo::foo {} {return bad} oo::define fooClass { constructor {} { namespace eval foo { proc foo {} {return good} } } forward bar foo::foo } [fooClass new] bar } -cleanup { fooClass destroy namespace delete foo } -result good test oo-6.7 {OO: forward resolution scope is per-object} -setup { oo::class create fooClass } -body { oo::define fooClass { constructor {} { proc curns {} {namespace current} } forward ns curns } expr {[[fooClass new] ns] ne [[fooClass new] ns]} } -cleanup { fooClass destroy } -result 1 test oo-6.8 {Bug 3400658: forwarding and wrongargs rewriting} -setup { oo::class create fooClass } -body { oo::define fooClass { forward test my handler method handler {a b c} {} } fooClass create ::foo foo test } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "foo test a b c"} test oo-6.9 {Bug 3400658: forwarding and wrongargs rewriting} -setup { oo::class create fooClass } -body { oo::define fooClass { forward test my handler method handler {a b c} {list $a,$b,$c} } fooClass create ::foo foo test 1 2 3 } -cleanup { fooClass destroy } -result 1,2,3 test oo-6.10 {Bug 3400658: forwarding and wrongargs rewriting} -setup { oo::class create fooClass } -body { oo::define fooClass { forward test my handler method handler {a b c} {list $a,$b,$c} } fooClass create ::foo foo test 1 2 } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "foo test a b c"} test oo-6.11 {Bug 3400658: forwarding and wrongargs rewriting} -setup { oo::object create foo } -body { oo::objdefine foo { forward test my handler method handler {a b c} {} } foo test } -returnCodes error -cleanup { foo destroy } -result {wrong # args: should be "foo test a b c"} test oo-6.12 {Bug 3400658: forwarding and wrongargs rewriting} -setup { oo::object create foo } -body { oo::objdefine foo { forward test my handler method handler {a b c} {list $a,$b,$c} } foo test 1 2 3 } -cleanup { foo destroy } -result 1,2,3 test oo-6.13 {Bug 3400658: forwarding and wrongargs rewriting} -setup { oo::object create foo } -body { oo::objdefine foo { forward test my handler method handler {a b c} {list $a,$b,$c} } foo test 1 2 } -returnCodes error -cleanup { foo destroy } -result {wrong # args: should be "foo test a b c"} test oo-6.14 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup { oo::class create fooClass } -body { oo::define fooClass { forward test my handler1 p forward handler1 my handler q method handler {a b c} {} } fooClass create ::foo foo test } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "foo test c"} test oo-6.15 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup { oo::class create fooClass } -body { oo::define fooClass { forward test my handler1 p forward handler1 my handler q method handler {a b c} {list $a,$b,$c} } fooClass create ::foo foo test 1 } -cleanup { fooClass destroy } -result q,p,1 test oo-6.16 {Bug 3400658: forwarding and wrongargs rewriting - via alias} -setup { oo::class create fooClass } -body { oo::define fooClass { forward test handler1 foo bar forward handler2 my handler x method handler {a b c d} {list $a,$b,$c,$d} export eval } fooClass create ::foo foo eval { interp alias {} [namespace current]::handler1 \ {} [namespace current]::my handler2 } foo test 1 2 3 } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "foo test d"} test oo-6.17 {Bug 3400658: forwarding and wrongargs rewriting - via ensemble} -setup { oo::class create fooClass } -body { oo::define fooClass { forward test handler1 foo bar boo forward handler2 my handler method handler {a b c d} {list $a,$b,$c,$d} export eval } fooClass create ::foo foo eval { namespace ensemble create \ -command [namespace current]::handler1 -parameters {p q} \ -map [list boo [list [namespace current]::my handler2]] } foo test 1 2 3 } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "foo test c d"} test oo-6.18 {Bug 3408830: more forwarding cases} -setup { oo::class create fooClass } -body { oo::define fooClass { forward len string length } [fooClass create foo] len a b } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "::foo len string"} test oo-6.19 {Bug 3610404: forwarding resolution + traces} -setup { oo::object create foo unset -nocomplain ::result set ::result {} } -body { proc ::my {method} {lappend ::result global} oo::objdefine foo { method target {} {lappend ::result instance} forward bar my target method bump {} { set ns [info object namespace ::foo] rename ${ns}::my ${ns}:: rename ${ns}:: ${ns}::my } } proc harness {} { foo target foo bar foo target } trace add execution harness enterstep {apply {{cmd args} {foo bump}}} foo target foo bar foo bump foo bar harness } -cleanup { catch {rename harness {}} catch {rename ::my {}} foo destroy } -result {instance instance instance instance instance instance} test oo-6.20 {Bug 3610404: forwarding resolution + traces} -setup { oo::class create fooClass fooClass create foo unset -nocomplain ::result set ::result {} } -body { proc ::my {method} {lappend ::result global} oo::define fooClass { method target {} {lappend ::result class} forward bar my target method bump {} { set ns [info object namespace [self]] rename ${ns}::my ${ns}:: rename ${ns}:: ${ns}::my } } proc harness {} { foo target foo bar foo target } trace add execution harness enterstep {apply {{cmd args} {foo bump}}} foo target foo bar foo bump foo bar harness } -cleanup { catch {rename harness {}} catch {rename ::my {}} fooClass destroy } -result {class class class class class class} test oo-7.1 {OO: inheritance 101} -setup { oo::class create superClass oo::class create subClass subClass create instance } -body { oo::define superClass method doit x {lappend ::result $x} oo::define subClass superclass superClass set result [list [catch {subClass doit bad} msg] $msg] instance doit ok return $result } -cleanup { subClass destroy superClass destroy } -result {1 {unknown method "doit": must be create, destroy or new} ok} test oo-7.2 {OO: inheritance 101} -setup { oo::class create superClass oo::class create subClass subClass create instance } -body { oo::define superClass method doit x { lappend ::result |$x| } oo::define subClass superclass superClass oo::objdefine instance method doit x { lappend ::result =$x= next [incr x] } set result {} instance doit 1 return $result } -cleanup { subClass destroy superClass destroy } -result {=1= |2|} test oo-7.3 {OO: inheritance 101} -setup { oo::class create superClass oo::class create subClass subClass create instance } -body { oo::define superClass method doit x { lappend ::result |$x| } oo::define subClass { superclass superClass method doit x {lappend ::result -$x-; next [incr x]} } oo::objdefine instance method doit x { lappend ::result =$x=; next [incr x] } set result {} instance doit 1 return $result } -cleanup { subClass destroy superClass destroy } -result {=1= -2- |3|} test oo-7.4 {OO: inheritance from oo::class} -body { oo::class create meta { superclass oo::class self { unexport create new method make {x {definitions {}}} { if {![string match ::* $x]} { set ns [uplevel 1 {::namespace current}] set x ${ns}::$x } set o [my create $x] lappend ::result "made $o" oo::define $o $definitions return $o } } } set result [list [catch {meta create foo} msg] $msg] lappend result [meta make classinstance { lappend ::result "in definition script in [namespace current]" }] lappend result [classinstance create instance] } -cleanup { catch {classinstance destroy} catch {meta destroy} } -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance} test oo-7.5 {OO: inheritance from oo::class in the secondary chain} -body { oo::class create other oo::class create meta { superclass other oo::class self { unexport create new method make {x {definitions {}}} { if {![string match ::* $x]} { set ns [uplevel 1 {::namespace current}] set x ${ns}::$x } set o [my create $x] lappend ::result "made $o" oo::define $o $definitions return $o } } } set result [list [catch {meta create foo} msg] $msg] lappend result [meta make classinstance { lappend ::result "in definition script in [namespace current]" }] lappend result [classinstance create instance] } -cleanup { catch {classinstance destroy} catch {meta destroy} catch {other destroy} } -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance} test oo-7.6 {OO: inheritance 101 - overridden methods should be oblivious} -setup { oo::class create Aclass oo::class create Bclass Bclass create Binstance } -body { oo::define Aclass { method incr {var step} { upvar 1 $var v ::incr v $step } } oo::define Bclass { superclass Aclass method incr {var {step 1}} { global result lappend result $var $step set r [next $var $step] lappend result returning:$r return $r } } set result {} set x 10 lappend result x=$x lappend result [Binstance incr x] lappend result x=$x } -result {x=10 x 1 returning:11 11 x=11} -cleanup { unset -nocomplain x Aclass destroy } test oo-7.7 {OO: inheritance and errorInfo} -setup { oo::class create A oo::class create B B create c } -body { oo::define A method foo {} {error foo!} oo::define B { superclass A method foo {} { next } } oo::objdefine c method foo {} { next } catch {c ?} msg set result [list $msg] catch {c foo} msg lappend result $msg $errorInfo } -cleanup { A destroy } -result {{unknown method "?": must be destroy or foo} foo! {foo! while executing "error foo!" (class "::A" method "foo" line 1) invoked from within "next " (class "::B" method "foo" line 1) invoked from within "next " (object "::c" method "foo" line 1) invoked from within "c foo"}} test oo-7.8 {OO: next at the end of the method chain} -setup { set ::result "" } -cleanup { foo destroy } -body { oo::class create foo { method bar {} {lappend ::result foo; lappend ::result [next] foo} } oo::class create foo2 { superclass foo method bar {} {lappend ::result foo2; lappend ::result [next] foo2} } lappend result [catch {[foo2 new] bar} msg] $msg } -result {foo2 foo 1 {no next method implementation}} test oo-7.9 {OO: defining inheritance in namespaces} -setup { set ::result {} oo::class create ::parent namespace eval ::foo { oo::class create mixin {superclass ::parent} } } -cleanup { ::parent destroy namespace delete ::foo } -body { namespace eval ::foo { oo::class create bar {superclass parent} oo::class create boo oo::define boo {superclass bar} oo::define boo {mixin mixin} oo::class create spong {superclass boo} return } } -result {} test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup { set ::result "" oo::class create c1 { method m1 {} { lappend ::result c1::m1 } } oo::class create c2 { superclass c1 destructor { lappend ::result c2::destructor my m1 lappend ::result /c2::destructor } method m1 {} { lappend ::result c2::m1 rename [self] {} lappend ::result no-self next lappend ::result /c2::m1 } } } -body { c2 create o lappend ::result [catch {o m1} msg] $msg } -cleanup { c1 destroy unset ::result } -result {c2::m1 c2::destructor c2::m1 no-self c1::m1 /c2::m1 /c2::destructor no-self 1 {no next method implementation}} test oo-8.1 {OO: global must work in methods} { oo::object create foo oo::objdefine foo method bar x {global result; lappend result $x} set result {} foo bar this foo bar is lappend result a foo bar test foo destroy return $result } {this is a test} test oo-9.1 {OO: multiple inheritance} -setup { oo::class create A oo::class create B oo::class create C oo::class create D D create foo } -body { oo::define A method test {} {lappend ::result A; return ok} oo::define B { superclass A method test {} {lappend ::result B; next} } oo::define C { superclass A method test {} {lappend ::result C; next} } oo::define D { superclass B C method test {} {lappend ::result D; next} } set result {} lappend result [foo test] } -cleanup { D destroy C destroy B destroy A destroy } -result {D B C A ok} test oo-9.2 {OO: multiple inheritance} -setup { oo::class create A oo::class create B oo::class create C oo::class create D D create foo } -body { oo::define A method test {} {lappend ::result A; return ok} oo::define B { superclass A method test {} {lappend ::result B; next} } oo::define C { superclass A method test {} {lappend ::result C; next} } oo::define D { superclass B C method test {} {lappend ::result D; next} } set result {} lappend result [foo test] } -cleanup { A destroy } -result {D B C A ok} test oo-10.1 {OO: recursive invoke and modify} -setup { [oo::class create C] create O } -cleanup { C destroy } -body { oo::define C method foo x { lappend ::result $x if {$x} { [self object] foo [incr x -1] } } oo::objdefine O method foo x { lappend ::result -$x- if {$x == 1} { oo::objdefine O deletemethod foo } next $x } set result {} O foo 2 return $result } -result {-2- 2 -1- 1 0} test oo-10.2 {OO: recursive invoke and modify} -setup { oo::object create O } -cleanup { O destroy } -body { oo::objdefine O method foo {} { oo::objdefine [self] method foo {} { error "not called" } return [format %s%s call ed] } O foo } -result called test oo-10.3 {OO: invoke and modify} -setup { oo::class create A { method a {} {return A.a} method b {} {return A.b} method c {} {return A.c} } oo::class create B { superclass A method a {} {return [next],B.a} method b {} {return [next],B.b} method c {} {return [next],B.c} } B create C set result {} } -cleanup { A destroy } -body { lappend result [C a] [C b] [C c] - oo::define B deletemethod b lappend result [C a] [C b] [C c] - oo::define B renamemethod a b lappend result [C a] [C b] [C c] - oo::define B deletemethod b c lappend result [C a] [C b] [C c] } -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c} test oo-10.4 {OO: invoke and modify} -setup { oo::class create A { method a {} {return A.a} method b {} {return A.b} method c {} {return A.c} } A create B oo::objdefine B { method a {} {return [next],B.a} method b {} {return [next],B.b} method c {} {return [next],B.c} } set result {} } -cleanup { A destroy } -body { lappend result [B a] [B b] [B c] - oo::objdefine B deletemethod b lappend result [B a] [B b] [B c] - oo::objdefine B renamemethod a b lappend result [B a] [B b] [B c] - oo::objdefine B deletemethod b c lappend result [B a] [B b] [B c] } -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c} test oo-11.1 {OO: cleanup} { oo::object create foo set result [list [catch {oo::object create foo} msg] $msg] lappend result [foo destroy] [oo::object create foo] [foo destroy] } {1 {can't create object "foo": command already exists with that name} {} ::foo {}} test oo-11.2 {OO: cleanup} { oo::class create bar bar create foo set result [list [catch {bar create foo} msg] $msg] lappend result [bar destroy] [oo::object create foo] [foo destroy] } {1 {can't create object "foo": command already exists with that name} {} ::foo {}} test oo-11.3 {OO: cleanup} { oo::class create bar0 oo::class create bar oo::define bar superclass bar0 bar create foo set result [list [catch {bar create foo} msg] $msg] lappend result [bar0 destroy] [oo::object create foo] [foo destroy] } {1 {can't create object "foo": command already exists with that name} {} ::foo {}} test oo-11.4 {OO: cleanup} { oo::class create bar0 oo::class create bar1 oo::define bar1 superclass bar0 oo::class create bar2 oo::define bar2 { superclass bar0 destructor {lappend ::result destroyed} } oo::class create bar oo::define bar superclass bar1 bar2 bar create foo set result [list [catch {bar create foo} msg] $msg] lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \ [oo::object create bar2] [bar2 destroy] } {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}} test oo-11.5 {OO: cleanup} { oo::class create obj1 trace add command obj1 delete {apply {{name1 name2 action} { set namespace [info object namespace $name1] namespace delete $namespace }}} rename obj1 {} # No segmentation fault return done } done test oo-11.6.1 { OO: cleanup of when an class is mixed into itself } -constraints memory -body { leaktest { interp create interp1 oo::class create obj1 ::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]} rename obj1 {} interp delete interp1 } } -result 0 -cleanup { } test oo-11.6.2 { OO: cleanup ReleaseClassContents() where class is mixed into one of its instances } -constraints memory -body { leaktest { interp create interp1 interp1 eval { oo::class create obj1 ::oo::copy obj1 obj2 rename obj2 {} rename obj1 {} } interp delete interp1 } } -result 0 -cleanup { } test oo-11.6.3 { OO: cleanup ReleaseClassContents() where class is mixed into one of its instances } -constraints memory -body { leaktest { interp create interp1 interp1 eval { oo::class create obj1 ::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]} ::oo::copy obj1 obj2 rename obj2 {} rename obj1 {} } interp delete interp1 } } -result 0 -cleanup { } test oo-11.6.4 { OO: cleanup ReleaseClassContents() where class is mixed into one of its instances } -body { oo::class create obj1 ::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]} ::oo::copy obj1 obj2 ::oo::objdefine obj2 {mixin [uplevel 1 {namespace which obj2}]} ::oo::copy obj2 obj3 rename obj3 {} rename obj2 {} # No segmentation fault return done } -result done -cleanup { rename obj1 {} } test oo-12.1 {OO: filters} { oo::class create Aclass Aclass create Aobject oo::define Aclass { method concatenate args { global result lappend result {*}$args join $args {} } method logFilter args { global result lappend result "calling [self object]->[self method] $args" set r [next {*}$args] lappend result "result=$r" return $r } } oo::objdefine Aobject filter logFilter set result {} lappend result [Aobject concatenate 1 2 3 4 5] Aclass destroy return $result } {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345} test oo-12.2 {OO: filters} -setup { oo::class create Aclass Aclass create Aobject } -body { oo::define Aclass { method concatenate args { global result lappend result {*}$args join $args {} } method logFilter args { global result lappend result "calling [self object]->[self method] $args" set r [next {*}$args] lappend result "result=$r" return $r } } oo::objdefine Aobject filter logFilter set result {} lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy] } -cleanup { Aclass destroy } -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}} test oo-12.3 {OO: filters} -setup { oo::class create Aclass Aclass create Aobject } -body { oo::define Aclass { method concatenate args { global result lappend result {*}$args join $args {} } method logFilter args { global result lappend result "calling [self object]->[self method] $args" set r [next {*}$args] lappend result "result=$r" return $r } filter logFilter } set result {} lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy] } -cleanup { Aclass destroy } -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}} test oo-12.4 {OO: filters} -setup { oo::class create Aclass Aclass create Aobject } -body { oo::define Aclass { method foo {} { return foo } method Bar {} { return 1 } method boo {} { if {[my Bar]} { next } { error forbidden } } filter boo } Aobject foo } -cleanup { Aclass destroy } -result foo test oo-12.5 {OO: filters} -setup { oo::class create Aclass Aclass create Aobject } -body { oo::define Aclass { method foo {} { return foo } method Bar {} { return [my Bar2] } method Bar2 {} { return 1 } method boo {} { if {[my Bar]} { next } { error forbidden } } filter boo } Aobject foo } -cleanup { Aclass destroy } -result foo test oo-12.6 {OO: filters} -setup { oo::class create Aclass Aclass create Aobject } -body { oo::define Aclass { method foo {} { return foo } method Bar {} { return [my Bar2] } method Bar2 {} { return [my Bar3] } method Bar3 {} { return 1 } method boo {} { if {[my Bar]} { next } { error forbidden } } filter boo } Aobject foo } -cleanup { Aclass destroy } -result foo test oo-12.7 {OO: filters} -setup { oo::class create Aclass Aclass create Aobject } -body { oo::define Aclass { method outerfoo {} { return [my InnerFoo] } method InnerFoo {} { return foo } method Bar {} { return [my Bar2] } method Bar2 {} { return [my Bar3] } method Bar3 {} { return 1 } method boo {} { lappend ::log [self target] if {[my Bar]} { next } else { error forbidden } } filter boo } set log {} list [Aobject outerfoo] $log } -cleanup { Aclass destroy } -result {foo {{::Aclass outerfoo} {::Aclass InnerFoo}}} test oo-12.8 {OO: filters and destructors} -setup { oo::class create Aclass Aclass create Aobject set ::log {} } -body { oo::define Aclass { constructor {} { lappend ::log "in constructor" } destructor { lappend ::log "in destructor" } method bar {} { lappend ::log "in method" } method Boo args { lappend ::log [self target] next {*}$args } filter Boo } set obj [Aclass new] $obj bar $obj destroy return $::log } -cleanup { Aclass destroy } -result {{in constructor} {::Aclass bar} {in method} {::oo::object destroy} {in destructor}} test oo-13.1 {OO: changing an object's class} { oo::class create Aclass oo::define Aclass {method bar {} {lappend ::result "in A [self object]"}} oo::class create Bclass oo::define Bclass {method bar {} {lappend ::result "in B [self object]"}} set result [Aclass create foo] foo bar oo::objdefine foo class Bclass foo bar Aclass destroy lappend result [info command foo] Bclass destroy return $result } {::foo {in A ::foo} {in B ::foo} foo} test oo-13.2 {OO: changing an object's class} -body { oo::object create foo oo::objdefine foo class oo::class } -cleanup { foo destroy } -result {} test oo-13.3 {OO: changing an object's class} -body { oo::class create foo oo::objdefine foo class oo::object } -cleanup { foo destroy } -result {} test oo-13.4 {OO: changing an object's class} -body { oo::class create foo { method m {} { set result [list [self class] [info object class [self]]] oo::objdefine [self] class ::bar lappend result [self class] [info object class [self]] } } oo::class create bar [foo new] m } -cleanup { foo destroy bar destroy } -result {::foo ::foo ::foo ::bar} test oo-13.5 {OO: changing an object's class: non-class to class} -setup { oo::object create fooObj } -body { oo::objdefine fooObj { class oo::class } oo::define fooObj { method x {} {expr {1+2+3}} } [fooObj new] x } -cleanup { fooObj destroy } -result 6 test oo-13.6 {OO: changing an object's class: class to non-class} -setup { oo::class create foo unset -nocomplain ::result } -body { set result dangling oo::define foo { method x {} {expr {1+2+3}} } oo::class create boo { superclass foo destructor {set ::result "ok"} } boo new foo create bar oo::objdefine foo { class oo::object } list $result [catch {bar x} msg] $msg } -cleanup { catch {bar destroy} foo destroy } -result {ok 1 {invalid command name "bar"}} test oo-13.7 {OO: changing an object's class} -setup { oo::class create foo oo::class create bar unset -nocomplain result } -body { oo::define bar method x {} {return ok} oo::define foo { method x {} {expr {1+2+3}} self mixin foo } lappend result [foo x] oo::objdefine foo class bar lappend result [foo x] } -cleanup { foo destroy bar destroy } -result {6 ok} test oo-13.8 {OO: changing an object's class to itself} -setup { oo::class create foo } -body { oo::define foo { method x {} {expr {1+2+3}} } oo::objdefine foo class foo } -cleanup { foo destroy } -returnCodes error -result {may not change classes into an instance of themselves} test oo-13.9 {OO: changing an object's class: roots are special} -setup { set i [interp create] } -body { $i eval { oo::objdefine oo::object { class oo::class } } } -cleanup { interp delete $i } -returnCodes error -result {may not modify the class of the root object class} test oo-13.10 {OO: changing an object's class: roots are special} -setup { set i [interp create] } -body { $i eval { oo::objdefine oo::class { class oo::object } } } -cleanup { interp delete $i } -returnCodes error -result {may not modify the class of the class of classes} test oo-13.11 {OO: changing an object's class in a tricky place} -setup { oo::class create cls unset -nocomplain result } -body { set result gorp list [catch { oo::define cls { method x {} {return} self class oo::object ::set ::result ok method y {} {return}; # I'm sorry, Dave. I'm afraid I can't do that. } } msg] $msg $result } -cleanup { cls destroy } -result {1 {attempt to misuse API} ok} # todo: changing a class subtype (metaclass) to another class subtype test oo-14.1 {OO: mixins} { oo::class create Aclass oo::define Aclass method bar {} {lappend ::result "[self object] in bar"} oo::class create Bclass oo::define Bclass method boo {} {lappend ::result "[self object] in boo"} oo::objdefine [Aclass create fooTest] mixin Bclass oo::objdefine [Aclass create fooTest2] mixin Bclass set result [list [catch {fooTest ?} msg] $msg] fooTest bar fooTest boo fooTest2 bar fooTest2 boo oo::objdefine fooTest2 mixin lappend result [Bclass destroy] [info command fooTest*] [Aclass destroy] } {1 {unknown method "?": must be bar, boo or destroy} {::fooTest in bar} {::fooTest in boo} {::fooTest2 in bar} {::fooTest2 in boo} {} fooTest2 {}} test oo-14.2 {OO: mixins} { oo::class create Aclass { method bar {} {return "[self object] in bar"} } oo::class create Bclass { method boo {} {return "[self object] in boo"} } oo::define Aclass mixin Bclass Aclass create fooTest set result [list [catch {fooTest ?} msg] $msg] lappend result [catch {fooTest bar} msg] $msg lappend result [catch {fooTest boo} msg] $msg lappend result [Bclass destroy] [info commands Aclass] } {1 {unknown method "?": must be bar, boo or destroy} 0 {::fooTest in bar} 0 {::fooTest in boo} {} {}} test oo-14.3 {OO and mixins and filters - advanced case} -setup { oo::class create mix oo::class create c { mixin mix } c create i } -body { oo::define mix { method foo {} {return >>[next]<<} filter foo } oo::objdefine i method bar {} {return foobar} i bar } -cleanup { mix destroy if {[info object isa object i]} { error "mixin deletion failed to destroy dependent instance" } } -result >>foobar<< test oo-14.4 {OO: mixin error case} -setup { oo::class create c } -body { oo::define c mixin c } -returnCodes error -cleanup { c destroy } -result {may not mix a class into itself} test oo-14.5 {OO and mixins and filters - advanced case} -setup { oo::class create mix oo::class create c { mixin mix } c create i } -body { oo::define mix { method foo {} {return >>[next]<<} filter foo } oo::objdefine i method bar {} {return foobar} i bar } -cleanup { c destroy mix destroy } -result >>foobar<< test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create A { superclass parent method egg {} { return chicken } } oo::class create B { superclass parent mixin A method bar {} { # mixin from A my egg } } oo::class create C { superclass parent mixin B method foo {} { # mixin from B my bar } } [C new] foo } -result chicken test oo-14.7 {OO and filters from mixins of mixins} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create A { superclass parent method egg {} { return chicken } filter f method f args { set m [lindex [self target] 1] return "($m) [next {*}$args] ($m)" } } oo::class create B { superclass parent mixin A filter f method bar {} { # mixin from A my egg } } oo::class create C { superclass parent mixin B filter f method foo {} { # mixin from B my bar } } [C new] foo } -result {(foo) (bar) (egg) chicken (egg) (bar) (foo)} test oo-14.8 {OO: class mixin order - Bug 1998221} -setup { set ::result {} oo::class create parent { method test {} {} } } -cleanup { parent destroy } -body { oo::class create mix { superclass parent method test {} {lappend ::result mix; next; return $::result} } oo::class create cls { superclass parent mixin mix method test {} {lappend ::result cls; next; return $::result} } [cls new] test } -result {mix cls} test oo-15.1 {OO: object cloning} { oo::class create Aclass oo::define Aclass method test {} {lappend ::result [self object]->test} Aclass create Ainstance set result {} Ainstance test oo::copy Ainstance Binstance Binstance test Ainstance test Ainstance destroy namespace eval foo { oo::copy Binstance Cinstance Cinstance test } Aclass destroy namespace delete foo lappend result [info commands Binstance] } {::Ainstance->test ::Binstance->test ::Ainstance->test ::foo::Cinstance->test {}} test oo-15.2 {OO: object cloning} { oo::object create foo oo::objdefine foo { method m x {lappend ::result [self object] >$x<} forward f ::lappend ::result fwd } set result {} foo m 1 foo f 2 lappend result [oo::copy foo bar] foo m 3 foo f 4 bar m 5 bar f 6 lappend result [foo destroy] bar m 7 bar f 8 lappend result [bar destroy] } {::foo >1< fwd 2 ::bar ::foo >3< fwd 4 ::bar >5< fwd 6 {} ::bar >7< fwd 8 {}} catch {foo destroy} catch {bar destroy} test oo-15.3 {OO: class cloning} { oo::class create foo { method testme {} {lappend ::result [self class]->[self object]} } set result {} foo create baseline baseline testme oo::copy foo bar baseline testme bar create tester tester testme foo destroy tester testme bar destroy return $result } {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester} test oo-15.4 {OO: object cloning - Bug 3474460} -setup { oo::class create ArbitraryClass } -body { ArbitraryClass create foo oo::objdefine foo variable a b c oo::copy foo bar info object variable bar } -cleanup { ArbitraryClass destroy } -result {a b c} test oo-15.5 {OO: class cloning - Bug 3474460} -setup { oo::class create ArbitraryClass } -body { oo::class create Foo { superclass ArbitraryClass variable a b c } oo::copy Foo Bar info class variable Bar } -cleanup { ArbitraryClass destroy } -result {a b c} test oo-15.6 {OO: object cloning copies namespace contents} -setup { oo::class create ArbitraryClass {export eval} } -body { ArbitraryClass create a a eval {proc foo x { variable y return [string repeat $x [incr y]] }} set result [list [a eval {foo 2}] [a eval {foo 3}]] oo::copy a b a eval {rename foo bar} lappend result [b eval {foo 2}] [b eval {foo 3}] [a eval {bar 4}] } -cleanup { ArbitraryClass destroy } -result {2 33 222 3333 444} test oo-15.7 {OO: classes can be cloned anonymously} -setup { oo::class create ArbitraryClassA oo::class create ArbitraryClassB {superclass ArbitraryClassA} } -body { info object isa class [oo::copy ArbitraryClassB] } -cleanup { ArbitraryClassA destroy } -result 1 test oo-15.8 {OO: intercept object cloning} -setup { oo::class create Foo set result {} } -body { oo::define Foo { constructor {msg} { variable v $msg } method {from} { next $from lappend ::result cloned $from [self] } method check {} { variable v lappend ::result check [self] $v } } Foo create foo ok oo::copy foo bar foo check bar check } -cleanup { Foo destroy } -result {cloned ::foo ::bar check ::foo ok check ::bar ok} test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup { oo::class create Foo } -body { oo::define Foo { method {a b} {} } interp alias {} Bar {} oo::copy [Foo create foo] Bar bar } -returnCodes error -cleanup { Foo destroy } -result {wrong # args: should be "::bar a b"} test oo-15.10 {variable binding must not bleed through oo::copy} -setup { oo::class create FooClass set result {} } -body { set obj1 [FooClass new] oo::objdefine $obj1 { variable var method m {} { set var foo } method get {} { return $var } export eval } $obj1 m lappend result [$obj1 get] set obj2 [oo::copy $obj1] $obj2 eval { set var bar } lappend result [$obj2 get] $obj1 eval { set var grill } lappend result [$obj1 get] [$obj2 get] } -cleanup { FooClass destroy } -result {foo bar grill bar} test oo-15.11 {OO: object cloning} -returnCodes error -body { oo::copy } -result {wrong # args: should be "oo::copy sourceName ?targetName? ?targetNamespace?"} test oo-15.12 {OO: object cloning with target NS} -setup { oo::class create Super oo::class create Cls {superclass Super} } -body { namespace eval ::existing {} oo::copy Cls {} ::existing } -returnCodes error -cleanup { Super destroy catch {namespace delete ::existing} } -result {::existing refers to an existing namespace} test oo-15.13.1 { OO: object cloning with target NS Valgrind will report a leak if the reference count of the namespace isn't properly incremented. } -setup { oo::class create Cls {} } -body { oo::copy Cls Cls2 ::dupens return done } -cleanup { Cls destroy Cls2 destroy } -result done test oo-15.13.2 {OO: object cloning with target NS} -setup { oo::class create Super oo::class create Cls {superclass Super} } -body { list [namespace exist ::dupens] [oo::copy Cls Cls2 ::dupens] [namespace exist ::dupens] } -cleanup { Super destroy } -result {0 ::Cls2 1} test oo-15.14 {OO: object cloning with target NS} -setup { oo::class create Cls {export eval} set result {} } -body { Cls create obj obj eval { proc test-15.14 {} {} } lappend result [info commands ::dupens::t*] oo::copy obj obj2 ::dupens lappend result [info commands ::dupens::t*] } -cleanup { Cls destroy } -result {{} ::dupens::test-15.14} test oo-15.15 {method cloning must ensure that there is a string representation of bodies} -setup { oo::class create cls } -body { cls create foo oo::objdefine foo { method m1 {} [string map {a b} {return hello}] } [oo::copy foo] m1 } -cleanup { cls destroy } -result hello test oo-16.1 {OO: object introspection} -body { info object } -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\"" test oo-16.1.1 {OO: object introspection} -body { catch {info object} m o dict get $o -errorinfo } -result "wrong \# args: should be \"info object subcommand ?arg ...?\" while executing \"info object\"" test oo-16.2 {OO: object introspection} -body { info object class NOTANOBJECT } -returnCodes 1 -result {NOTANOBJECT does not refer to an object} test oo-16.3 {OO: object introspection} -body { info object gorp oo::object } -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars} test oo-16.4 {OO: object introspection} -setup { oo::class create meta { superclass oo::class } [meta create instance1] create instance2 } -body { list [list [info object class oo::object] \ [info object class oo::class] \ [info object class meta] \ [info object class instance1] \ [info object class instance2]] \ [list [info object isa class oo::object] \ [info object isa class meta] \ [info object isa class instance1] \ [info object isa class instance2]] \ [list [info object isa metaclass oo::object] \ [info object isa metaclass oo::class] \ [info object isa metaclass meta] \ [info object isa metaclass instance1] \ [info object isa metaclass instance2]] \ [list [info object isa object oo::object] \ [info object isa object oo::class] \ [info object isa object meta] \ [info object isa object instance1] \ [info object isa object instance2] \ [info object isa object oo::define] \ [info object isa object NOTANOBJECT]] } -cleanup { meta destroy } -result {{::oo::class ::oo::class ::oo::class ::meta ::instance1} {1 1 1 0} {0 1 1 0 0} {1 1 1 1 1 0 0}} test oo-16.5 {OO: object introspection} {info object methods oo::object} {} test oo-16.6 {OO: object introspection} { oo::object create foo set result [list [info object methods foo]] oo::objdefine foo method bar {} {...} lappend result [info object methods foo] [foo destroy] } {{} bar {}} test oo-16.7 {OO: object introspection} -setup { oo::object create foo } -body { oo::objdefine foo method bar {a {b c} args} {the body} set result [info object methods foo] lappend result [info object methodtype foo bar] \ [info object definition foo bar] } -cleanup { foo destroy } -result {bar method {{a {b c} args} {the body}}} test oo-16.8 {OO: object introspection} { oo::object create foo oo::class create bar oo::objdefine foo mixin bar set result [list [info object mixins foo] \ [info object isa mixin foo bar] \ [info object isa mixin foo oo::class]] foo destroy bar destroy return $result } {::bar 1 0} test oo-16.9 {OO: object introspection} -body { oo::class create Ac oo::class create Bc; oo::define Bc superclass Ac oo::class create Cc; oo::define Cc superclass Bc oo::class create Dc; oo::define Dc mixin Cc Cc create E Dc create F list [info object isa typeof E oo::class] \ [info object isa typeof E Ac] \ [info object isa typeof F Bc] \ [info object isa typeof F Cc] } -cleanup { catch {Ac destroy} } -result {0 1 1 1} test oo-16.10 {OO: object introspection} -setup { oo::object create foo } -body { oo::objdefine foo export eval foo eval {variable c 3 a 1 b 2 ddd 4 e} lsort [info object vars foo ?] } -cleanup { foo destroy } -result {a b c} test oo-16.11 {OO: object introspection} -setup { oo::class create foo foo create bar } -body { oo::define foo method spong {} {...} oo::objdefine bar method boo {a {b c} args} {the body} list [lsort [info object methods bar -all]] [lsort [info object methods bar -all -private]] } -cleanup { foo destroy } -result {{boo destroy spong} { boo destroy eval spong unknown variable varname}} test oo-16.12 {OO: object introspection} -setup { oo::object create foo } -cleanup { rename foo {} } -body { oo::objdefine foo unexport {*}[info object methods foo -all] info object methods foo -all } -result {} test oo-16.13 {OO: object introspection} -setup { oo::object create foo } -cleanup { rename foo {} } -body { oo::objdefine foo method Bar {} {return "ok in foo"} [info object namespace foo]::my Bar } -result "ok in foo" test oo-16.14 {OO: object introspection: TIP #436} -setup { oo::class create meta { superclass oo::class } [meta create instance1] create instance2 } -body { list class [list [info object isa class NOTANOBJECT] \ [info object isa class list]] \ meta [list [info object isa metaclass NOTANOBJECT] \ [info object isa metaclass list] \ [info object isa metaclass oo::object]] \ type [list [info object isa typeof oo::object NOTANOBJECT] \ [info object isa typeof NOTANOBJECT oo::object] \ [info object isa typeof list NOTANOBJECT] \ [info object isa typeof NOTANOBJECT list] \ [info object isa typeof oo::object list] \ [info object isa typeof list oo::object]] \ mix [list [info object isa mixin oo::object NOTANOBJECT] \ [info object isa mixin NOTANOBJECT oo::object] \ [info object isa mixin list NOTANOBJECT] \ [info object isa mixin NOTANOBJECT list] \ [info object isa mixin oo::object list] \ [info object isa mixin list oo::object]] } -cleanup { meta destroy } -result {class {0 0} meta {0 0 0} type {0 0 0 0 0 0} mix {0 0 0 0 0 0}} test oo-17.1 {OO: class introspection} -body { info class } -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\"" test oo-17.1.1 {OO: class introspection} -body { catch {info class} m o dict get $o -errorinfo } -result "wrong \# args: should be \"info class subcommand ?arg ...?\" while executing \"info class\"" test oo-17.2 {OO: class introspection} -body { info class superclass NOTANOBJECT } -returnCodes 1 -result {NOTANOBJECT does not refer to an object} test oo-17.3 {OO: class introspection} -setup { oo::object create foo } -body { info class superclass foo } -returnCodes 1 -cleanup { foo destroy } -result {"foo" is not a class} test oo-17.4 {OO: class introspection} -body { info class gorp oo::object } -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables} test oo-17.5 {OO: class introspection} -setup { oo::class create testClass } -body { testClass create foo testClass create bar testClass create spong lsort [info class instances testClass] } -cleanup { testClass destroy } -result {::bar ::foo ::spong} test oo-17.6 {OO: class introspection} -setup { oo::class create foo } -body { oo::define foo method bar {a {b c} args} {the body} set result [info class methods foo] lappend result [info class methodtype foo bar] \ [info class definition foo bar] } -cleanup { foo destroy } -result {bar method {{a {b c} args} {the body}}} test oo-17.7 {OO: class introspection} { info class superclasses oo::class } ::oo::object test oo-17.8 {OO: class introspection} -setup { oo::class create testClass oo::class create superClass1 oo::class create superClass2 } -body { oo::define testClass superclass superClass1 superClass2 list [info class superclasses testClass] \ [lsort [info class subclass oo::object ::superClass?]] } -cleanup { testClass destroy superClass1 destroy superClass2 destroy } -result {{::superClass1 ::superClass2} {::superClass1 ::superClass2}} test oo-17.9 {OO: class introspection} -setup { oo::class create foo oo::class create subfoo {superclass foo} } -body { oo::define foo { method bar {a {b c} args} {the body} self { method bad {} {...} } } oo::define subfoo method boo {a {b c} args} {the body} list [lsort [info class methods subfoo -all]] \ [lsort [info class methods subfoo -all -private]] } -cleanup { foo destroy } -result {{bar boo destroy} { bar boo destroy eval unknown variable varname}} test oo-17.10 {OO: class introspection} -setup { oo::class create foo } -cleanup { rename foo {} } -body { oo::define foo unexport {*}[info class methods foo -all] info class methods foo -all } -result {} set stdmethods { destroy eval unknown variable varname} test oo-17.11 {OO: object method unexport (bug 900cb0284bc)} -setup { oo::object create o oo::objdefine o unexport m } -body { lsort [info object methods o -all -private] } -cleanup { o destroy } -result $stdmethods test oo-17.12 {OO: instance method unexport (bug 900cb0284bc)} -setup { oo::class create c c create o oo::objdefine o unexport m } -body { lsort [info object methods o -all -private] } -cleanup { o destroy c destroy } -result $stdmethods test oo-17.13 {OO: class method unexport (bug 900cb0284bc)} -setup { oo::class create c oo::define c unexport m } -body { lsort [info class methods c -all -private] } -cleanup { c destroy } -result $stdmethods test oo-17.14 {OO: instance method unexport (bug 900cb0284bc)} -setup { oo::class create c oo::define c unexport m c create o } -body { lsort [info object methods o -all -private] } -cleanup { o destroy c destroy } -result $stdmethods test oo-18.1 {OO: define command support} { list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo } {1 foo {foo while executing "error foo" (in definition script for class "::oo::object" line 1) invoked from within "oo::define oo::object {error foo}"}} test oo-18.2 {OO: define command support} { list [catch {oo::define oo::object error foo} msg] $msg $errorInfo } {1 foo {foo while executing "oo::define oo::object error foo"}} test oo-18.3 {OO: define command support} { list [catch {oo::class create foo {error bar}} msg] $msg $errorInfo } {1 bar {bar while executing "error bar" (in definition script for class "::foo" line 1) invoked from within "oo::class create foo {error bar}"}} test oo-18.3a {OO: define command support} { list [catch {oo::class create foo { error bar }} msg] $msg $errorInfo } {1 bar {bar while executing "error bar" (in definition script for class "::foo" line 2) invoked from within "oo::class create foo { error bar }"}} test oo-18.3b {OO: define command support} { list [catch {oo::class create foo { eval eval error bar }} msg] $msg $errorInfo } {1 bar {bar while executing "error bar" ("eval" body line 1) invoked from within "eval error bar" ("eval" body line 1) invoked from within "eval eval error bar" (in definition script for class "::foo" line 2) invoked from within "oo::class create foo { eval eval error bar }"}} test oo-18.4 {OO: more error traces from the guts} -setup { oo::object create obj } -body { oo::objdefine obj method bar {} {my eval {error foo}} list [catch {obj bar} msg] $msg $errorInfo } -cleanup { obj destroy } -result {1 foo {foo while executing "error foo" (in "my eval" script line 1) invoked from within "my eval {error foo}" (object "::obj" method "bar" line 1) invoked from within "obj bar"}} test oo-18.5 {OO: more error traces from the guts} -setup { [oo::class create cls] create obj set errorInfo {} } -body { oo::define cls { method eval script {next $script} export eval } oo::objdefine obj method bar {} {my eval {error foo}} set result {} lappend result [catch {obj bar} msg] $msg $errorInfo lappend result [catch {obj eval {error bar}} msg] $msg $errorInfo } -cleanup { cls destroy } -result {1 foo {foo while executing "error foo" (in "my eval" script line 1) invoked from within "next $script" (class "::cls" method "eval" line 1) invoked from within "my eval {error foo}" (object "::obj" method "bar" line 1) invoked from within "obj bar"} 1 bar {bar while executing "error bar" (in "::obj eval" script line 1) invoked from within "next $script" (class "::cls" method "eval" line 1) invoked from within "obj eval {error bar}"}} test oo-18.6 {class construction reference management and errors} -setup { oo::class create super_abc } -body { catch { oo::class create abc { superclass super_abc ::rename abc ::def ::error foo } } msg opt dict get $opt -errorinfo } -cleanup { super_abc destroy } -result {foo while executing "::error foo" (in definition script for class "::def" line 4) invoked from within "oo::class create abc { superclass super_abc ::rename abc ::def ::error foo }"} test oo-18.7 {OO: objdefine command support} -setup { oo::object create ::inst } -body { list [catch {oo::objdefine inst {rename ::inst ::INST;error foo}} msg] $msg $errorInfo } -cleanup { catch {::inst destroy} catch {::INST destroy} } -result {1 foo {foo while executing "error foo" (in definition script for object "::INST" line 1) invoked from within "oo::objdefine inst {rename ::inst ::INST;error foo}"}} test oo-18.8 {OO: define/self command support} -setup { oo::class create parent oo::class create ::foo {superclass parent} } -body { catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt dict get $opt -errorinfo } -cleanup { parent destroy } -result {foobar while executing "error foobar" (in definition script for class object "::bar" line 1) invoked from within "self {error foobar}" (in definition script for class "::bar" line 1) invoked from within "oo::define foo {rename ::foo ::bar; self {error foobar}}"} test oo-18.9 {OO: define/self command support} -setup { oo::class create parent set c [oo::class create now_this_is_a_very_very_long_class_name_indeed { superclass parent }] } -body { catch {oo::define $c {error err}} msg opt dict get $opt -errorinfo } -cleanup { parent destroy } -result {err while executing "error err" (in definition script for class "::now_this_is_a_very_very_long..." line 1) invoked from within "oo::define $c {error err}"} test oo-18.10 {OO: define/self command support} -setup { oo::class create parent oo::class create ::foo {superclass parent} } -body { catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt dict get $opt -errorinfo } -cleanup { parent destroy } -result {foobar while executing "error foobar" (in definition script for class object "::foo" line 1) invoked from within "self {rename ::foo {}; error foobar}" (in definition script for class "::foo" line 1) invoked from within "oo::define foo {self {rename ::foo {}; error foobar}}"} test oo-18.11 {OO: define/self command support} -setup { oo::class create parent oo::class create ::foo {superclass parent} } -body { catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt dict get $opt -errorinfo } -cleanup { parent destroy } -result {this command cannot be called when the object has been deleted while executing "self {error foobar}" (in definition script for class "::foo" line 1) invoked from within "oo::define foo {rename ::foo {}; self {error foobar}}"} test oo-19.1 {OO: varname method} -setup { oo::object create inst oo::objdefine inst export eval set result {} inst eval { variable x } } -body { inst eval {trace add variable x write foo} set ns [inst eval namespace current] proc foo args { global ns result set context [uplevel 1 namespace current] lappend result $args [expr { $ns eq $context ? "ok" : [list $ns ne $context] }] [expr { "${ns}::x" eq [uplevel 1 my varname x] ? "ok" : [list ${ns}::x ne [uplevel 1 my varname x]] }] } lappend result [inst eval set x 0] } -cleanup { inst destroy rename foo {} } -result {{x {} write} ok ok 0} test oo-19.2 {OO: varname method: Bug 2883857} -setup { oo::class create SpecialClass oo::objdefine SpecialClass export createWithNamespace SpecialClass createWithNamespace inst ::oo_test oo::objdefine inst export varname eval } -body { inst eval { variable x; array set x {y z} } inst varname x(y) } -cleanup { SpecialClass destroy } -result ::oo_test::x(y) test oo-19.3 {OO: varname method and variable decl: Bug 3603695} -setup { oo::class create testClass { variable foo export varname constructor {} { variable foo x } method bar {obj} { my varname foo $obj varname foo } } } -body { testClass create A testClass create B lsearch [list [A varname foo] [B varname foo]] [B bar A] } -cleanup { testClass destroy } -result 0 test oo-20.1 {OO: variable method} -body { oo::class create testClass { constructor {} { my variable ok set ok {} } } lsort [info object vars [testClass new]] } -cleanup { catch {testClass destroy} } -result ok test oo-20.2 {OO: variable method} -body { oo::class create testClass { constructor {} { my variable a b c set a [set b [set c {}]] } } lsort [info object vars [testClass new]] } -cleanup { catch {testClass destroy} } -result {a b c} test oo-20.3 {OO: variable method} -body { oo::class create testClass { export varname method bar {} { my variable a(b) } } testClass create foo array set [foo varname a] {b c} foo bar } -returnCodes 1 -cleanup { catch {testClass destroy} } -result {can't define "a(b)": name refers to an element in an array} test oo-20.4 {OO: variable method} -body { oo::class create testClass { export varname method bar {} { my variable a(b) } } testClass create foo set [foo varname a] b foo bar } -returnCodes 1 -cleanup { catch {testClass destroy} } -result {can't define "a(b)": name refers to an element in an array} test oo-20.5 {OO: variable method} -body { oo::class create testClass { method bar {} { my variable a::b } } testClass create foo foo bar } -returnCodes 1 -cleanup { catch {testClass destroy} } -result {variable name "a::b" illegal: must not contain namespace separator} test oo-20.6 {OO: variable method} -setup { oo::class create testClass { export varname self export eval } } -body { testClass eval variable a 0 oo::objdefine [testClass create foo] method bar {other} { $other variable a set a 3 } oo::objdefine [testClass create boo] export variable set [foo varname a] 1 set [boo varname a] 2 foo bar boo list [testClass eval set a] [set [foo varname a]] [set [boo varname a]] } -cleanup { testClass destroy } -result {0 1 3} test oo-20.7 {OO: variable method} -setup { oo::class create cls } -body { oo::define cls { method a {} { my variable d b lappend b $d } method e {} { my variable b d return [list $b $d] } method f {x y} { my variable b d set b $x set d $y } } cls create obj obj f p q obj a obj a obj e } -cleanup { cls destroy } -result {{p q q} q} # oo-20.8 tested explicitly for functionality removed due to [Bug 1959457] test oo-20.9 {OO: variable method} -setup { oo::object create obj } -body { oo::objdefine obj { method a {} { my variable ::b } } obj a } -returnCodes 1 -cleanup { obj destroy } -result {variable name "::b" illegal: must not contain namespace separator} test oo-20.10 {OO: variable and varname methods refer to same things} -setup { oo::object create obj } -body { oo::objdefine obj { method a {} { my variable b set b [self] return [my varname b] } } list [set [obj a]] [namespace tail [obj a]] } -cleanup { obj destroy } -result {::obj b} test oo-20.11 {OO: variable mustn't crash when recursing} -body { oo::class create A { constructor {name} { my variable np_name set np_name $name } method copy {nm} { set cpy [[info object class [self]] new $nm] foreach var [info object vars [self]] { my variable $var set val [set $var] if {[string match o_* $var]} { set objs {} foreach ref $val { # call to "copy" crashes lappend objs [$ref copy {}] } $cpy prop $var $objs } else { $cpy prop $var $val } } return $cpy } method prop {name val} { my variable $name set $name $val } } set o1 [A new {}] set o2 [A new {}] $o1 prop o_object $o2 $o1 copy aa } -cleanup { catch {A destroy} } -match glob -result * test oo-20.12 {OO: variable method accept zero args (TIP 323)} -setup { oo::object create foo } -cleanup { foo destroy } -body { oo::objdefine foo method demo {} { my variable } foo demo } -result {} test oo-20.13 {OO: variable method use in non-methods [Bug 2903811]} -setup { oo::object create fooObj oo::objdefine fooObj export variable } -cleanup { fooObj destroy } -body { apply {{} {fooObj variable x; set x ok; return}} apply {{} {fooObj variable x; return $x}} } -result ok test oo-20.14 {OO: variable method use in non-methods [Bug 2903811]} -setup { oo::object create fooObj oo::objdefine fooObj export variable namespace eval ns1 {} namespace eval ns2 {} set x bad } -cleanup { fooObj destroy namespace delete ns1 ns2 unset x } -body { namespace eval ns1 {fooObj variable x; set x ok; subst ""} set x bad namespace eval ns2 {fooObj variable x; return $x} } -result ok test oo-20.15 {OO: variable method use in non-methods [Bug 2903811]} -setup { oo::object create fooObj oo::objdefine fooObj export variable varname } -cleanup { fooObj destroy } -body { apply {{} {fooObj variable x; set x ok; return}} return [set [fooObj varname x]] } -result ok test oo-20.16 {variable method: leak per instance} -setup { oo::class create foo } -constraints memory -body { oo::define foo { constructor {} { set [my variable v] 0 } } leaktest {[foo new] destroy} } -cleanup { foo destroy } -result 0 test oo-21.1 {OO: inheritance ordering} -setup { oo::class create A } -body { oo::define A method m {} {lappend ::result A} oo::class create B { superclass A method m {} {lappend ::result B;next} } oo::class create C { superclass A method m {} {lappend ::result C;next} } oo::class create D { superclass B C method m {} {lappend ::result D;next} } D create o oo::objdefine o method m {} {lappend ::result o;next} set result {} o m return $result } -cleanup { A destroy } -result {o D B C A} test oo-21.2 {OO: inheritance ordering} -setup { oo::class create A } -body { oo::define A method m {} {lappend ::result A} oo::class create B { superclass A method m {} {lappend ::result B;next} } oo::class create C { superclass A method m {} {lappend ::result C;next} } oo::class create D { superclass B C method m {} {lappend ::result D;next} } oo::class create Emix { superclass C method m {} {lappend ::result Emix;next} } oo::class create Fmix { superclass Emix method m {} {lappend ::result Fmix;next} } D create o oo::objdefine o { method m {} {lappend ::result o;next} mixin Fmix } set result {} o m return $result } -cleanup { A destroy } -result {Fmix Emix o D B C A} test oo-21.3 {OO: inheritance ordering} -setup { oo::class create A } -body { oo::define A method m {} {lappend ::result A} oo::class create B { superclass A method m {} {lappend ::result B;next} method f {} {lappend ::result B-filt;next} } oo::class create C { superclass A method m {} {lappend ::result C;next} } oo::class create D { superclass B C method m {} {lappend ::result D;next} } oo::class create Emix { superclass C method m {} {lappend ::result Emix;next} method f {} {lappend ::result Emix-filt;next} } oo::class create Fmix { superclass Emix method m {} {lappend ::result Fmix;next} } D create o oo::objdefine o { method m {} {lappend ::result o;next} mixin Fmix filter f } set result {} o m return $result } -cleanup { A destroy } -result {Emix-filt B-filt Fmix Emix o D B C A} test oo-21.4 {OO: inheritance ordering} -setup { oo::class create A } -body { oo::define A method m {} {lappend ::result A} oo::class create B { superclass A method m {} {lappend ::result B;next} method f {} {lappend ::result B-filt;next} method g {} {lappend ::result B-cfilt;next} } oo::class create C { superclass A method m {} {lappend ::result C;next} } oo::class create D { superclass B C method m {} {lappend ::result D;next} method g {} {lappend ::result D-cfilt;next} filter g } oo::class create Emix { superclass C method m {} {lappend ::result Emix;next} method f {} {lappend ::result Emix-filt;next} } oo::class create Fmix { superclass Emix method m {} {lappend ::result Fmix;next} } D create o oo::objdefine o { method m {} {lappend ::result o;next} mixin Fmix filter f } set result {} o m return $result } -cleanup { A destroy } -result {Emix-filt B-filt D-cfilt B-cfilt Fmix Emix o D B C A} test oo-22.1 {OO and info frame} -setup { oo::class create c c create i } -match glob -body { oo::define c self method frame {} { info frame 0 } oo::define c { method frames {} { info frame 0 } method level {} { info frame } } oo::objdefine i { method frames {} { list [next] [info frame 0] } method level {} { expr {[next] - [info frame]} } } list [i level] [i frames] [dict get [c frame] object] } -cleanup { c destroy } -result {1 {{* cmd {info frame 0} method frames class ::c level 0} {* cmd {info frame 0} method frames object ::i level 0}} ::c} test oo-22.2 {OO and info frame: Bug 3001438} -setup { oo::class create c } -body { oo::define c method test {{x 1}} { if {$x} {my test 0} lsort {q w e r t y u i o p}; # Overwrite the Tcl stack info frame 0 } [c new] test } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { oo::class create SELF { superclass oo::class unexport create new # Next is just a convenience method method args {oo::define [self] method {*}$args} method derive {name} { set o [my new [list superclass [self]]] oo::objdefine $o mixin $o uplevel 1 [list rename $o $name]\;[list namespace which $name] } self mixin SELF } set result {} } -body { [SELF derive foo1] method bar1 {} {return 1} lappend result [foo1 bar1] [foo1 derive foo2] method bar2 {} {return [my bar1],2} lappend result [foo2 bar2] [foo2 derive foo3] method bar3 {} {return [my bar2],3} lappend result [foo3 bar3] [foo3 derive foo4] method bar4 {} {return [my bar3],4} lappend result [foo4 bar4] foo2 method bar2 {} {return [my bar1],x} lappend result [foo4 bar4] } -cleanup { SELF destroy } -result {1 1,2 1,2,3 1,2,3,4 1,x,3,4} test oo-24.1 {unknown method method - Bug 1965063} -setup { oo::class create cls } -cleanup { cls destroy } -returnCodes error -body { oo::define cls { method dummy {} {} method unknown args {next {*}$args} } [cls new] foo bar } -result {unknown method "foo": must be destroy, dummy or unknown} test oo-24.2 {unknown method method - Bug 1965063} -setup { oo::class create cls } -cleanup { cls destroy } -returnCodes error -body { oo::define cls { method dummy {} {} method unknown args {next {*}$args} } cls create obj oo::objdefine obj { method dummy2 {} {} method unknown args {next {*}$args} } obj foo bar } -result {unknown method "foo": must be destroy, dummy, dummy2 or unknown} test oo-24.3 {unknown method method - absent method name} -setup { set o [oo::object new] } -cleanup { $o destroy } -body { oo::objdefine $o method unknown args { return "unknown: >>$args<<" } list [$o] [$o foobar] [$o foo bar] } -result {{unknown: >><<} {unknown: >>foobar<<} {unknown: >>foo bar<<}} # Probably need a better set of tests, but this is quite difficult to devise test oo-25.1 {call chain caching} -setup { oo::class create cls { method ab {} {return ok} } set result {} } -cleanup { cls destroy } -body { cls create foo cls create bar set m1 ab set m2 a; append m2 b ;# different object! lappend result [foo $m1] [foo $m1] [bar $m1] [foo $m1] lappend result [foo $m2] [bar $m2] oo::objdefine foo method ab {} {return good} lappend result [foo $m1] [bar $m2] } -result {ok ok ok ok ok ok good ok} test oo-25.2 {call chain caching - Bug #2120903} -setup { set c [oo::class create MyClass] set o [$c new] } -body { oo::define MyClass { method name {} {return ok} method isa o {MyClass name $o} self method name o {$o name} } list [$o name] [$c name $o] [$o isa $o] } -cleanup { $c destroy } -result {ok ok ok} test oo-26.1 {Bug 2037727} -setup { proc succeed args {} oo::object create example } -body { oo::objdefine example method foo {} {succeed} example foo proc succeed {} {return succeed} example foo } -cleanup { example destroy rename succeed {} } -result succeed test oo-26.2 {Bug 2037727} -setup { oo::class create example { method localProc {args body} {proc called $args $body} method run {} { called } } example create i1 example create i2 } -body { i1 localProc args {} i2 localProc args {return nonempty} list [i1 run] [i2 run] } -cleanup { example destroy } -result {{} nonempty} test oo-26.3 {Bug 2037727} -setup { oo::class create example { method subProc {args body} { namespace eval subns [list proc called $args $body] } method run {} { subns::called } } example create i1 example create i2 } -body { i1 subProc args {} i2 subProc args {return nonempty} list [i1 run] [i2 run] } -cleanup { example destroy } -result {{} nonempty} test oo-27.1 {variables declaration - class introspection} -setup { oo::class create foo } -cleanup { foo destroy } -body { oo::define foo variable a b c info class variables foo } -result {a b c} test oo-27.2 {variables declaration - object introspection} -setup { oo::object create foo } -cleanup { foo destroy } -body { oo::objdefine foo variable a b c info object variables foo } -result {a b c} test oo-27.3 {variables declaration - basic behaviour} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable x! constructor {} {set x! 1} method y {} {incr x!} } foo create bar bar y bar y } -result 3 test oo-27.4 {variables declaration - destructors too} -setup { oo::class create parent set result bad! } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable x! constructor {} {set x! 1} method y {} {incr x!} destructor {set ::result ${x!}} } foo create bar bar y bar y bar destroy return $result } -result 3 test oo-27.5 {variables declaration - object-bound variables} -setup { oo::object create foo } -cleanup { foo destroy } -body { oo::objdefine foo { variable x! method y {} {incr x!} } foo y foo y } -result 2 test oo-27.6 {variables declaration - non-interference of levels} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable x! constructor {} {set x! 1} method y {} {incr x!} } foo create bar oo::objdefine bar { variable y! method y {} {list [next] [incr y!] [info var] [info local]} export eval } bar y list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}] } -result {{3 2 y! {}} {x! y!} {x! y!}} test oo-27.7 {variables declaration - one underlying variable space} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable x! constructor {} {set x! 1} method y {} {incr x!} } oo::class create foo2 { superclass foo variable y! constructor {} {set y! 42; next} method x {} {incr y! -1} } foo2 create bar oo::objdefine bar { variable x! y! method z {} {list ${x!} ${y!}} } bar y bar x list [bar y] [bar x] [bar z] } -result {3 40 {3 40}} test oo-27.8 {variables declaration - error cases - ns separators} -body { oo::define oo::object variable bad::var } -returnCodes error -result {invalid declared variable name "bad::var": must not contain namespace separators} test oo-27.9 {variables declaration - error cases - arrays} -body { oo::define oo::object variable bad(var) } -returnCodes error -result {invalid declared variable name "bad(var)": must not refer to an array element} test oo-27.10 {variables declaration - no instance var leaks with class resolvers} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable clsvar constructor {} { set clsvar 0 } method step {} { incr clsvar return } method value {} { return $clsvar } } foo create inst1 inst1 step foo create inst2 inst2 step inst1 step inst2 step inst1 step list [inst1 value] [inst2 value] } -result {3 2} test oo-27.11 {variables declaration - no instance var leaks with class resolvers} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable clsvar constructor {} { set clsvar 0 } method step {} { incr clsvar return } method value {} { return $clsvar } } foo create inst1 oo::objdefine inst1 { variable clsvar method reinit {} { set clsvar 0 } } foo create inst2 oo::objdefine inst2 { variable clsvar method reinit {} { set clsvar 0 } } inst1 step inst2 step inst1 reinit inst2 reinit inst1 step inst2 step inst1 step inst2 step inst1 step list [inst1 value] [inst2 value] } -result {3 2} test oo-27.12 {variables declaration: leak per instance} -setup { oo::class create foo } -constraints memory -body { oo::define foo { variable v constructor {} { set v 0 } } leaktest {[foo new] destroy} } -cleanup { foo destroy } -result 0 # This test will actually (normally) crash if it fails! test oo-27.13 {variables declaration: Bug 3185009: require refcount management} -setup { oo::object create foo } -body { oo::objdefine foo { variable x method set v {set x $v} method unset {} {unset x} method exists {} {info exists x} method get {} {return $x} } list [foo exists] [foo set 7] [foo exists] [foo get] [foo unset] \ [foo exists] [catch {foo get} msg] $msg } -cleanup { foo destroy } -result {0 7 1 7 {} 0 1 {can't read "x": no such variable}} test oo-27.14 {variables declaration - multiple use} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable x variable y method boo {} { return [incr x],[incr y] } } foo create bar list [bar boo] [bar boo] } -result {1,1 2,2} test oo-27.15 {variables declaration - multiple use} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable variable x y method boo {} { return [incr x],[incr y] } } foo create bar list [bar boo] [bar boo] } -result {1,1 2,2} test oo-27.16 {variables declaration - multiple use} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable x variable -clear variable y method boo {} { return [incr x],[incr y] } } foo create bar list [bar boo] [bar boo] } -result {1,1 1,2} test oo-27.17 {variables declaration - multiple use} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable x variable -set y method boo {} { return [incr x],[incr y] } } foo create bar list [bar boo] [bar boo] } -result {1,1 1,2} test oo-27.18 {variables declaration - multiple use} -setup { oo::class create parent } -cleanup { parent destroy } -body { oo::class create foo { superclass parent variable x variable -? y method boo {} { return [incr x],[incr y] } } 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} 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} test oo-27.23 {variable resolver leakage: Bug 1493a43044} -setup { oo::class create Super oo::class create parent { superclass Super variable member1 member2 constructor {} { set member1 parent1 set member2 parent2 } method getChild {} { Child new [self] } } oo::class create Child { superclass Super variable member1 result constructor {m} { set [namespace current]::member1 child1 set ns [info object namespace $m] namespace upvar $ns member1 l1 member2 l2 upvar 1 member1 l3 member2 l4 [format namespace] upvar $ns member1 l5 member2 l6 [format upvar] 1 member1 l7 member2 l8 set result [list $l1 $l2 $l3 $l4 $l5 $l6 $l7 $l8] } method result {} {return $result} } } -body { [[parent new] getChild] result } -cleanup { Super destroy } -result {parent1 parent2 parent1 parent2 parent1 parent2 parent1 parent2} # A feature that's not supported because the mechanism may change without # warning, but is supposed to work... test oo-28.1 {scripted extensions to oo::define} -setup { interp create foo foo eval {oo::class create cls {export eval}} } -cleanup { interp delete foo } -body { foo eval { proc oo::define::privateMethod {name arguments body} { uplevel 1 [list method $name $arguments $body] uplevel 1 [list unexport $name] } oo::define cls privateMethod m {x y} {return $x,$y} cls create obj list [catch {obj m 1 2}] [obj eval my m 3 4] } } -result {1 3,4} test oo-29.1 {self class with object-defined methods} -setup { oo::object create obj } -body { oo::objdefine obj method demo {} { self class } obj demo } -returnCodes error -cleanup { obj destroy } -result {method not defined by a class} test oo-30.1 {Bug 2903011: deleting an object in a constructor} -setup { oo::class create cls } -body { oo::define cls {constructor {} {[self] destroy}} cls new } -returnCodes error -cleanup { cls destroy } -result {object deleted in constructor} test oo-30.2 {Bug 2903011: deleting an object in a constructor} -setup { oo::class create cls } -body { oo::define cls {constructor {} {my destroy}} cls new } -returnCodes error -cleanup { cls destroy } -result {object deleted in constructor} test oo-31.1 {Bug 3111059: when objects and coroutines entangle} -setup { oo::class create cls } -constraints memory -body { oo::define cls { method justyield {} { yield } constructor {} { coroutine coro my justyield } } list [leaktest {[cls new] destroy}] [info class instances cls] } -cleanup { cls destroy } -result {0 {}} test oo-31.2 {Bug 3111059: when objects and coroutines entangle} -setup { oo::class create cls } -constraints memory -body { oo::define cls { method justyield {} { yield } constructor {} { coroutine coro my justyield } destructor { rename coro {} } } list [leaktest {[cls new] destroy}] [info class instances cls] } -cleanup { cls destroy } -result {0 {}} proc SampleSlotSetup script { set script0 { oo::class create SampleSlot { superclass oo::Slot constructor {} { variable contents {a b c} ops {} } method contents {} {variable contents; return $contents} method ops {} {variable ops; return $ops} method Get {} { variable contents variable ops lappend ops [info level] Get return $contents } method Set {lst} { variable contents $lst variable ops lappend ops [info level] Set $lst return } } } append script0 \n$script } proc SampleSlotCleanup script { set script0 { SampleSlot destroy } append script \n$script0 } test oo-32.1 {TIP 380: slots - class test} -setup [SampleSlotSetup { SampleSlot create sampleSlot }] -body { list [info level] [sampleSlot contents] [sampleSlot ops] } -cleanup [SampleSlotCleanup { rename sampleSlot {} }] -result {0 {a b c} {}} test oo-32.2 {TIP 380: slots - class test} -setup [SampleSlotSetup { SampleSlot create sampleSlot }] -body { list [info level] [sampleSlot -clear] \ [sampleSlot contents] [sampleSlot ops] } -cleanup [SampleSlotCleanup { rename sampleSlot {} }] -result {0 {} {} {1 Set {}}} test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup { SampleSlot create sampleSlot }] -body { list [info level] [sampleSlot -append g h i] \ [sampleSlot contents] [sampleSlot ops] } -cleanup [SampleSlotCleanup { rename sampleSlot {} }] -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}} test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup { SampleSlot create sampleSlot }] -body { list [info level] [sampleSlot -set d e f] \ [sampleSlot contents] [sampleSlot ops] } -cleanup [SampleSlotCleanup { rename sampleSlot {} }] -result {0 {} {d e f} {1 Set {d e f}}} test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup { SampleSlot create sampleSlot }] -body { list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \ [sampleSlot contents] [sampleSlot ops] } -cleanup [SampleSlotCleanup { rename sampleSlot {} }] -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}} test oo-33.1 {TIP 380: slots - defaulting} -setup [SampleSlotSetup { set s [SampleSlot new] }] -body { list [$s x y] [$s contents] } -cleanup [SampleSlotCleanup { rename $s {} }] -result {{} {a b c x y}} test oo-33.2 {TIP 380: slots - defaulting} -setup [SampleSlotSetup { set s [SampleSlot new] }] -body { list [$s destroy; $s unknown] [$s contents] } -cleanup [SampleSlotCleanup { rename $s {} }] -result {{} {a b c destroy unknown}} test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup { set s [SampleSlot new] }] -body { oo::objdefine $s forward --default-operation my -set list [$s destroy; $s unknown] [$s contents] [$s ops] } -cleanup [SampleSlotCleanup { rename $s {} }] -result {{} unknown {1 Set destroy 1 Set unknown}} test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup { set s [SampleSlot new] }] -body { # Method names beginning with "-" are special to slots $s -grill q } -returnCodes error -cleanup [SampleSlotCleanup { rename $s {} }] -result \ {unknown method "-grill": must be -append, -clear, -set, contents or ops} test oo-34.1 {TIP 380: slots - presence} -setup { set obj [oo::object new] set result {} } -body { oo::define oo::object { ::lappend ::result [::info object class filter] ::lappend ::result [::info object class mixin] ::lappend ::result [::info object class superclass] ::lappend ::result [::info object class variable] } oo::objdefine $obj { ::lappend ::result [::info object class filter] ::lappend ::result [::info object class mixin] ::lappend ::result [::info object class variable] } return $result } -cleanup { $obj destroy } -result {::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot} test oo-34.2 {TIP 380: slots - presence} { lsort [info class instances oo::Slot] } {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} proc getMethods obj { list [lsort [info object methods $obj -all]] \ [lsort [info object methods $obj -private]] } test oo-34.3 {TIP 380: slots - presence} { getMethods oo::define::filter } {{-append -clear -set} {Get Set}} test oo-34.4 {TIP 380: slots - presence} { getMethods oo::define::mixin } {{-append -clear -set} {--default-operation Get Set}} test oo-34.5 {TIP 380: slots - presence} { getMethods oo::define::superclass } {{-append -clear -set} {--default-operation Get Set}} test oo-34.6 {TIP 380: slots - presence} { getMethods oo::define::variable } {{-append -clear -set} {Get Set}} test oo-34.7 {TIP 380: slots - presence} { getMethods oo::objdefine::filter } {{-append -clear -set} {Get Set}} test oo-34.8 {TIP 380: slots - presence} { getMethods oo::objdefine::mixin } {{-append -clear -set} {--default-operation Get Set}} test oo-34.9 {TIP 380: slots - presence} { getMethods oo::objdefine::variable } {{-append -clear -set} {Get Set}} test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup { oo::class create fruit { method eat {} {} } set result {} } -body { lappend result [fruit create ::apple] [info class superclasses fruit] oo::define fruit superclass lappend result [info class superclasses fruit] \ [info object class apple oo::object] \ [info class call fruit destroy] \ [catch { apple }] } -cleanup { unset -nocomplain result fruit destroy } -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1} test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup { oo::class create fruitMetaclass { superclass oo::class method eat {} {} } set result {} } -body { lappend result [fruitMetaclass create ::appleClass] \ [appleClass create orange] \ [info class superclasses fruitMetaclass] oo::define fruitMetaclass superclass lappend result [info class superclasses fruitMetaclass] \ [info object class appleClass oo::class] \ [catch { orange }] [info object class orange] \ [appleClass create pear] } -cleanup { unset -nocomplain result fruitMetaclass destroy } -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear} test oo-35.3 {Bug 593baa032c: superclass list teardown} { # Bug makes this crash, especially with mem-debugging on oo::class create B {} oo::class create D {superclass B} namespace eval [info object namespace D] [list [namespace which B] destroy] } {} test oo-35.4 {Bug 593baa032c: mixins list teardown} { # Bug makes this crash, especially with mem-debugging on oo::class create B {} oo::class create D {mixin B} namespace eval [info object namespace D] [list [namespace which B] destroy] } {} test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly} -setup { oo::class create base { unexport destroy } } -body { oo::class create C { superclass base method c {} {} } oo::class create D { superclass base mixin C method d {} {} } oo::class create E { superclass D method e {} {} } E create e1 list [lsort [info class methods E -all]] [lsort [info object methods e1 -all]] } -cleanup { base destroy } -result {{c d e} {c d e}} test oo-35.6 { Bug : teardown of an object that is a class that is an instance of itself } -setup { oo::class create obj oo::copy obj obj1 obj1 oo::objdefine obj1 { mixin obj1 obj } oo::copy obj1 obj2 oo::objdefine obj2 { mixin obj2 obj1 } } -body { rename obj2 {} rename obj1 {} # doesn't crash return done } -cleanup { rename obj {} } -result done cleanupTests return # Local Variables: # MODE: Tcl # End: tcl8.6.14/tests/opt.test0000644000175000017500000001636414554262142014521 0ustar sergeisergei# Package covered: opt1.0/optparse.tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # the package we are going to test package require opt 0.4.8 # we are using implementation specifics to test the package #### functions tests ##### set n $::tcl::OptDescN test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} { list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr {$n+1}]] [::tcl::OptKeyRegister {}] } "$n [expr {$n+1}] [expr {$n+2}]" test opt-2.1 {OptKeyDelete} { list [::tcl::OptKeyRegister {} testkey] \ [info exists ::tcl::OptDesc(testkey)] \ [::tcl::OptKeyDelete testkey] \ [info exists ::tcl::OptDesc(testkey)] } {testkey 1 {} 0} test opt-3.1 {OptParse / temp key is removed} { set n $::tcl::OptDescN set prev [array names ::tcl::OptDesc] ::tcl::OptKeyRegister {} $n list [info exists ::tcl::OptDesc($n)]\ [::tcl::OptKeyDelete $n]\ [::tcl::OptParse {{-foo}} {}]\ [info exists ::tcl::OptDesc($n)]\ [expr {"[lsort $prev]"=="[lsort [array names ::tcl::OptDesc]]"}] } {1 {} {} 0 1} test opt-3.2 {OptParse / temp key is removed even on errors} { set n $::tcl::OptDescN catch {::tcl::OptKeyDelete $n} list [catch {::tcl::OptParse {{-foo}} {-blah}}] \ [info exists ::tcl::OptDesc($n)] } {1 0} test opt-4.1 {OptProc} { ::tcl::OptProc optTest {} {} optTest ::tcl::OptKeyDelete optTest } {} test opt-5.1 {OptProcArgGiven} { ::tcl::OptProc optTest {{-foo}} { if {[::tcl::OptProcArgGiven "-foo"]} { return 1 } else { return 0 } } list [optTest] [optTest -f] [optTest -F] [optTest -fOO] } {0 1 1 1} test opt-6.1 {OptKeyParse} { ::tcl::OptKeyRegister {} test list [catch {::tcl::OptKeyParse test {-help}} msg] $msg } {1 {Usage information: Var/FlagName Type Value Help ------------ ---- ----- ---- (-help gives this help)}} test opt-7.1 {OptCheckType} { list \ [::tcl::OptCheckType 23 int] \ [::tcl::OptCheckType 23 float] \ [::tcl::OptCheckType true boolean] \ [::tcl::OptCheckType "-blah" any] \ [::tcl::OptCheckType {a b c} list] \ [::tcl::OptCheckType maYbe choice {yes maYbe no}] \ [catch {::tcl::OptCheckType "-blah" string}] \ [catch {::tcl::OptCheckType 6 boolean}] \ [catch {::tcl::OptCheckType x float}] \ [catch {::tcl::OptCheckType "a \{ c" list}] \ [catch {::tcl::OptCheckType 2.3 int}] \ [catch {::tcl::OptCheckType foo choice {x y Foo z}}] } {23 23.0 1 -blah {a b c} maYbe 1 1 1 1 1 1} test opt-8.1 {List utilities} { ::tcl::Lempty {} } 1 test opt-8.2 {List utilities} { ::tcl::Lempty {a b c} } 0 test opt-8.3 {List utilities} { ::tcl::Lget {a {b c d} e} {1 2} } d test opt-8.4 {List utilities} { set l {a {b c d e} f} ::tcl::Lvarset l {1 2} D set l } {a {b c D e} f} test opt-8.5 {List utilities} { set l {a b c} ::tcl::Lvarset1 l 6 X set l } {a b c {} {} {} X} test opt-8.6 {List utilities} { set l {a {b c 7 e} f} ::tcl::Lvarincr l {1 2} set l } {a {b c 8 e} f} test opt-8.7 {List utilities} { set l {a {b c 7 e} f} ::tcl::Lvarincr l {1 2} -9 set l } {a {b c -2 e} f} # 8.8 and 8.9 missing? test opt-8.10 {List utilities} { set l {a {b c 7 e} f} ::tcl::Lvarpop l set l } {{b c 7 e} f} test opt-8.11 {List utilities} { catch {unset x} set l {a {b c 7 e} f} list [::tcl::Lassign $l u v w x] \ $u $v $w [info exists x] } {3 a {b c 7 e} f 0} test opt-9.1 {Misc utilities} { catch {unset v} ::tcl::SetMax v 3 ::tcl::SetMax v 7 ::tcl::SetMax v 6 set v } 7 test opt-9.2 {Misc utilities} { catch {unset v} ::tcl::SetMin v 3 ::tcl::SetMin v -7 ::tcl::SetMin v 1 set v } -7 #### behaviour tests ##### test opt-10.1 {ambigous flags} { ::tcl::OptProc optTest {{-fla} {-other} {-flag2xyz} {-flag3xyz}} {} catch {optTest -fL} msg set msg } {ambigous option "-fL", choose from: -fla boolflag (false) -flag2xyz boolflag (false) -flag3xyz boolflag (false)} test opt-10.2 {non ambigous flags} { ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} { return $flag2xyz } optTest -fLaG2 } 1 test opt-10.3 {non ambigous flags because of exact match} { ::tcl::OptProc optTest {{-flag1x} {-other} {-flag1} {-flag1xy}} { return $flag1 } optTest -flAg1 } 1 test opt-10.4 {ambigous flags, not exact match} { ::tcl::OptProc optTest {{-flag1xy} {-other} {-flag1} {-flag1xyz}} { return $flag1 } catch {optTest -fLag1X} msg set msg } {ambigous option "-fLag1X", choose from: -flag1xy boolflag (false) -flag1xyz boolflag (false)} # medium size overall test example: (defined once) ::tcl::OptProc optTest { {cmd -choice {print save delete} "sub command to choose"} {-allowBoing -boolean true} {arg2 -string "this is help"} {?arg3? 7 "optional number"} {-moreflags} } { list $cmd $allowBoing $arg2 $arg3 $moreflags } test opt-10.5 {medium size overall test} { list [catch {optTest} msg] $msg } {1 {no value given for parameter "cmd" (use -help for full usage) : cmd choice (print save delete) sub command to choose}} test opt-10.6 {medium size overall test} { list [catch {optTest -help} msg] $msg } {1 {Usage information: Var/FlagName Type Value Help ------------ ---- ----- ---- (-help gives this help) cmd choice (print save delete) sub command to choose -allowBoing boolean (true) arg2 string () this is help ?arg3? int (7) optional number -moreflags boolflag (false)}} test opt-10.7 {medium size overall test} { optTest save tst } {save 1 tst 7 0} test opt-10.8 {medium size overall test} { optTest save -allowBoing false -- 8 } {save 0 8 7 0} test opt-10.9 {medium size overall test} { optTest save tst -m -- } {save 1 tst 7 1} test opt-10.10 {medium size overall test} { list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0] } {1 {too many arguments (unexpected argument(s): foo), usage:}} test opt-11.1 {too many args test 2} { set key [::tcl::OptKeyRegister {-foo}] list [catch {::tcl::OptKeyParse $key {-foo blah}} msg] $msg\ [::tcl::OptKeyDelete $key] } {1 {too many arguments (unexpected argument(s): blah), usage: Var/FlagName Type Value Help ------------ ---- ----- ---- (-help gives this help) -foo boolflag (false)} {}} test opt-11.2 {default value for args} { set args {} set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}] ::tcl::OptKeyParse $key {} ::tcl::OptKeyDelete $key set args } {a b c} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/package.test0000644000175000017500000013204214554262142015302 0ustar sergeisergei# This file contains tests for the package and ::pkg::* commands. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2011 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.3.3 namespace import -force ::tcltest::* } # Do all this in a child interp to avoid garbaging the package list set i [interp create] tcltest::loadIntoChildInterpreter $i {*}$argv interp eval $i { namespace import -force ::tcltest::* package forget {*}[package names] set oldPkgUnknown [package unknown] package unknown {} set oldPath $auto_path set auto_path "" test package-1.1 {pkg::create gives error on insufficient args} -body { ::pkg::create } -returnCodes error -match glob -result {wrong # args: should be "*"} test package-1.2 {pkg::create gives error on bad args} -body { ::pkg::create -foo bar -bar baz -baz boo } -returnCodes error -match glob -result {unknown option "bar": *} test package-1.3 {pkg::create gives error on no value given} -body { ::pkg::create -name foo -version 1.0 -source test.tcl -load } -returnCodes error -match glob -result {value for "-load" missing: *} test package-1.4 {pkg::create gives error on no name given} -body { ::pkg::create -version 1.0 -source test.tcl -load foo.so } -returnCodes error -match glob -result {value for "-name" missing: *} test package-1.5 {pkg::create gives error on no version given} -body { ::pkg::create -name foo -source test.tcl -load foo.so } -returnCodes error -match glob -result {value for "-version" missing: *} test package-1.6 {pkg::create gives error on no source or load options} -body { ::pkg::create -name foo -version 1.0 -version 2.0 } -returnCodes error -result {at least one of -load and -source must be given} test package-1.7 {pkg::create gives correct output for 1 direct source} { ::pkg::create -name foo -version 1.0 -source test.tcl } {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]} test package-1.8 {pkg::create gives correct output for 2 direct sources} { ::pkg::create -name foo -version 1.0 -source test.tcl -source test2.tcl } {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list source [file join $dir test2.tcl]]} test package-1.9 {pkg::create gives correct output for 1 direct load} { ::pkg::create -name foo -version 1.0 -load test.so } {package ifneeded foo 1.0 [list load [file join $dir test.so]]} test package-1.10 {pkg::create gives correct output for 2 direct loads} { ::pkg::create -name foo -version 1.0 -load test.so -load test2.so } {package ifneeded foo 1.0 [list load [file join $dir test.so]]\n[list load [file join $dir test2.so]]} test package-1.11 {pkg::create gives correct output for 1 lazy source} { ::pkg::create -name foo -version 1.0 -source {test.tcl {foo bar}} } {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.tcl source {foo bar}}}]} test package-1.12 {pkg::create gives correct output for 2 lazy sources} { ::pkg::create -name foo -version 1.0 -source {test.tcl {foo bar}} \ -source {test2.tcl {baz boo}} } {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.tcl source {foo bar}} {test2.tcl source {baz boo}}}]} test package-1.13 {pkg::create gives correct output for 1 lazy load} { ::pkg::create -name foo -version 1.0 -load {test.so {foo bar}} } {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.so load {foo bar}}}]} test package-1.14 {pkg::create gives correct output for 2 lazy loads} { ::pkg::create -name foo -version 1.0 -load {test.so {foo bar}} \ -load {test2.so {baz boo}} } {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.so load {foo bar}} {test2.so load {baz boo}}}]} test package-1.15 {pkg::create gives correct output for 1 each, direct} { ::pkg::create -name foo -version 1.0 -source test.tcl -load test2.so } {package ifneeded foo 1.0 [list load [file join $dir test2.so]]\n[list source [file join $dir test.tcl]]} test package-1.16 {pkg::create gives correct output for 1 direct, 1 lazy} { ::pkg::create -name foo -version 1.0 -source test.tcl \ -source {test2.tcl {foo bar}} } {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list tclPkgSetup $dir foo 1.0 {{test2.tcl source {foo bar}}}]} test package-2.1 {Tcl_PkgProvide procedure} { package forget t package provide t 2.3 } {} test package-2.2 {Tcl_PkgProvide procedure} -returnCodes error -setup { package forget t } -body { package provide t 2.3 package provide t 2.2 } -result {conflicting versions provided for package "t": 2.3, then 2.2} test package-2.3 {Tcl_PkgProvide procedure} -returnCodes error -setup { package forget t } -body { package provide t 2.3 package provide t 2.4 } -result {conflicting versions provided for package "t": 2.3, then 2.4} test package-2.4 {Tcl_PkgProvide procedure} -returnCodes error -setup { package forget t } -body { package provide t 2.3 package provide t 3.3 } -result {conflicting versions provided for package "t": 2.3, then 3.3} test package-2.5 {Tcl_PkgProvide procedure} -setup { package forget t } -body { package provide t 2.3 package provide t 2.3 } -result {} test package-2.6 {Tcl_PkgProvide procedure} { package forget t package provide t 2.3a1 } {} set n 0 foreach v { 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1 2b4a1 2b3b2 } { test package-2.7.$n {Tcl_PkgProvide procedure} -setup { package forget t } -returnCodes error -body " package provide t $v " -result "expected version number but got \"$v\"" incr n } test package-3.1 {Tcl_PkgRequire procedure, picking best version} -setup { package forget t set x xxx } -body { foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i; package provide t $i" } package require t return $x } -result {3.4} test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup { package forget t set x xxx } -body { foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} { package ifneeded t $i "set x $i; package provide t $i" } package require t return $x } -result {3.5} test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup { package forget t set x xxx } -body { foreach i {3.5 2.1 2.3} { package ifneeded t $i "set x $i; package provide t $i" } package require t 2.2 return $x } -result {2.3} test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup { package forget t set x xxx } -body { foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i; package provide t $i" } package require -exact t 2.3 return $x } -result {2.3} test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup { package forget t set x xxx } -body { foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i; package provide t $i" } package require t 2.1 return $x } -result {2.4} test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup { package forget t } -returnCodes error -body { package unknown {} foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package require t 2.5 } -result {can't find package t 2.5} test package-3.7 {Tcl_PkgRequire procedure, can't find suitable version} -setup { package forget t } -returnCodes error -body { package unknown {} foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package require t 4.1 } -result {can't find package t 4.1} test package-3.8 {Tcl_PkgRequire procedure, can't find suitable version} -setup { package forget t } -returnCodes error -body { package unknown {} foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package require -exact t 1.3 } -result {can't find package t exactly 1.3} test package-3.9 {Tcl_PkgRequire procedure, can't find suitable version} -setup { package forget t } -returnCodes error -body { package unknown {} package require t } -result {can't find package t} test package-3.10 {Tcl_PkgRequire procedure, error in ifneeded script} -setup { package forget t } -body { package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"} list [catch {package require t 2.1} msg] $msg $::errorInfo } -match glob -result {1 {ifneeded test} {ifneeded test while executing "error "ifneeded test"" ("package ifneeded*" script) invoked from within "package require t 2.1"}} test package-3.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -setup { package forget t set x xxx } -body { package ifneeded t 2.1 "set x invoked" list [catch {package require t 2.1} msg] $msg $x } -match glob -result {1 * invoked} test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup { package forget t set x xxx } -body { package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2" package require t 1.2 return $x } -result {1.2} test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup { package forget t set x xxx } -body { proc pkgUnknown args { # args = name requirement # requirement = v-v (for exact version) global x set x $args package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0] } foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package unknown pkgUnknown package require -exact t 1.5 return $x } -cleanup { package unknown {} } -result {t 1.5-1.5} test package-3.14 {Tcl_PkgRequire procedure, "package unknown" support} -setup { package forget t set x xxx } -body { proc pkgUnknown args { package ifneeded t 1.2 "set x loaded; package provide t 1.2" } package unknown pkgUnknown list [package require t] $x } -cleanup { package unknown {} } -result {1.2 loaded} test package-3.15 {Tcl_PkgRequire procedure, "package unknown" support} -setup { package forget {a b} package unknown pkgUnknown set x xxx } -body { proc pkgUnknown args { global x set x $args package provide [lindex $args 0] 2.0 } package require {a b} return $x } -cleanup { package unknown {} } -result {{a b} 0-} test package-3.16 {Tcl_PkgRequire procedure, "package unknown" error} -setup { package forget t } -body { proc pkgUnknown args { error "testing package unknown" } package unknown pkgUnknown list [catch {package require t} msg] $msg $::errorInfo } -cleanup { package unknown {} } -result {1 {testing package unknown} {testing package unknown while executing "error "testing package unknown"" (procedure "pkgUnknown" line 2) invoked from within "pkgUnknown t 0-" ("package unknown" script) invoked from within "package require t"}} test package-3.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} -setup { package forget t set x xxx } -body { proc pkgUnknown args { global x set x $args } foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package unknown pkgUnknown list [catch {package require -exact t 1.5} msg] $msg $x } -cleanup { package unknown {} } -result {1 {can't find package t exactly 1.5} {t 1.5-1.5}} test package-3.18 {Tcl_PkgRequire procedure, version checks} -setup { package forget t } -body { package provide t 2.3 package require t } -result {2.3} test package-3.19 {Tcl_PkgRequire procedure, version checks} -setup { package forget t } -body { package provide t 2.3 package require t 2.1 } -result {2.3} test package-3.20 {Tcl_PkgRequire procedure, version checks} -setup { package forget t } -body { package provide t 2.3 package require t 2.3 } -result {2.3} test package-3.21 {Tcl_PkgRequire procedure, version checks} -setup { package forget t } -returnCodes error -body { package provide t 2.3 package require t 2.4 } -result {version conflict for package "t": have 2.3, need 2.4} test package-3.22 {Tcl_PkgRequire procedure, version checks} -setup { package forget t } -returnCodes error -body { package provide t 2.3 package require t 1.2 } -result {version conflict for package "t": have 2.3, need 1.2} test package-3.23 {Tcl_PkgRequire procedure, version checks} -setup { package forget t } -body { package provide t 2.3 package require -exact t 2.3 } -result {2.3} test package-3.24 {Tcl_PkgRequire procedure, version checks} -setup { package forget t } -returnCodes error -body { package provide t 2.3 package require -exact t 2.2 } -result {version conflict for package "t": have 2.3, need exactly 2.2} test package-3.25 {Tcl_PkgRequire procedure, error in ifneeded script} -setup { package forget t } -body { package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI} list [catch {package require t 2.1} msg] $msg $::errorInfo } -match glob -result {1 {ifneeded test} {EI ("package ifneeded*" script) invoked from within "package require t 2.1"}} test package-3.26 {Tcl_PkgRequire procedure, error in ifneeded script} -setup { package forget t } -body { package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}} list [catch {package require t 2.1} msg] $msg $::errorInfo } -match glob -result {1 {ifneeded test} {EI ("foreach" body line 1) invoked from within "foreach x 1 {error "ifneeded test" EI}" ("package ifneeded*" script) invoked from within "package require t 2.1"}} test package-3.27 {Tcl_PkgRequire: circular dependency} -setup { package forget foo } -body { package ifneeded foo 1 {package require foo 1} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {circular package dependency:*} test package-3.28 {Tcl_PkgRequire: circular dependency} -setup { package forget foo } -body { package ifneeded foo 1 {package require foo 2} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {circular package dependency:*} test package-3.29 {Tcl_PkgRequire: circular dependency} -setup { package forget foo package forget bar } -body { package ifneeded foo 1 {package require bar 1; package provide foo 1} package ifneeded bar 1 {package require foo 1; package provide bar 1} package require foo 1 } -cleanup { package forget foo package forget bar } -returnCodes error -match glob -result {circular package dependency:*} test package-3.30 {Tcl_PkgRequire: circular dependency} -setup { package forget foo package forget bar } -body { package ifneeded foo 1 {package require bar 1; package provide foo 1} package ifneeded foo 2 {package provide foo 2} package ifneeded bar 1 {package require foo 2; package provide bar 1} package require foo 1 } -cleanup { package forget foo package forget bar } -returnCodes error -match glob -result {circular package dependency:*} test package-3.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {package provide foo 1; error foo} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result foo test package-3.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {package provide foo 1; error foo} catch {package require foo 1} package provide foo } -cleanup { package forget foo } -result {} test package-3.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {package provide foo 2} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test package-3.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {package provide foo 1.1} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test package-3.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1.1 {package provide foo 1} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test package-3.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1.1 {package provide foo 1} package require foo 1.1 } -cleanup { package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test package-3.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test package-3.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {break} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob \ -result {attempt to provide package * failed: bad return code:*} test package-3.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {continue} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob \ -result {attempt to provide package * failed: bad return code:*} test package-3.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {return} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob \ -result {attempt to provide package * failed: bad return code:*} test package-3.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {return -level 0 -code 10} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob \ -result {attempt to provide package * failed: bad return code:*} test package-3.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {package provide foo 2 ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result * test package-3.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {break ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} test package-3.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {continue ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} test package-3.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {return ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} test package-3.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {return -level 0 -code 10 ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup { package provide demo 1.2.3 } -body { package require -exact demo 1.2 } -returnCodes error -cleanup { package forget demo } -result {version conflict for package "demo": have 1.2.3, need exactly 1.2} test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -setup { package forget t set x xxx } -body { foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} { package ifneeded t $i "set x $i; package provide t $i" } package require t return $x } -result {3.4} test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup { package forget t set x xxx } -body { foreach i {1.2b1 1.2 1.3a2 1.3} { package ifneeded t $i "set x $i; package provide t $i" } package require t return $x } -result {1.3} test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup { package forget t set x xxx } -body { foreach i {1.2b1 1.2 1.3 1.3a2} { package ifneeded t $i "set x $i; package provide t $i" } package require t return $x } -result {1.3} test pkg-3.53 {Tcl_PkgRequire procedure, picking best stable version} { package forget t foreach i {1.2b1 1.1} { package ifneeded t $i "set x $i; package provide t $i" } set x xxx package require t set x } {1.1} test package-3.54 {Tcl_PkgRequire procedure, coroutine support} -setup { package forget t } -body { coroutine coro1 apply {{} { package ifneeded t 2.1 { yield package provide t 2.1 } package require t 2.1 }} list [catch {coro1} msg] $msg } -match glob -result {0 2.1} test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body { package } -result {wrong # args: should be "package option ?arg ...?"} test package-4.2 {Tcl_PackageCmd procedure, "forget" option} { package forget {*}[package names] package names } {} test package-4.3 {Tcl_PackageCmd procedure, "forget" option} { package forget {*}[package names] package forget foo } {} test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup { package forget {*}[package names] set result {} } -body { package ifneeded t 1.1 {first script} package ifneeded t 2.3 {second script} package ifneeded x 1.4 {x's script} lappend result [lsort [package names]] [package versions t] package forget t lappend result [lsort [package names]] [package versions t] } -result {{t x} {1.1 2.3} x {}} test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup { package forget {*}[package names] } -body { package ifneeded a 1.1 {first script} package ifneeded b 2.3 {second script} package ifneeded c 1.4 {third script} package forget set result [list [lsort [package names]]] package forget a c lappend result [lsort [package names]] } -result {{a b c} b} test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body { # Test for Bug 415273 package ifneeded a 1 "I should have been forgotten" package forget no-such-package a package ifneeded a 1 } -cleanup { package forget a } -result {} test package-4.6 {Tcl_PackageCmd procedure, "ifneeded" option} -body { package ifneeded a } -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"} test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body { package ifneeded a b c d } -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"} test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body { package ifneeded t xyz } -returnCodes error -result {expected version number but got "xyz"} test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} { package forget {*}[package names] list [package ifneeded foo 1.1] [package names] } {{} {}} test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup { package forget t } -body { package ifneeded t 1.4 "script for t 1.4" list [package names] [package ifneeded t 1.4] [package versions t] } -result {t {script for t 1.4} 1.4} test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup { package forget t } -body { package ifneeded t 1.4 "script for t 1.4" list [package ifneeded t 1.5] [package names] [package versions t] } -result {{} t 1.4} test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup { package forget t } -body { package ifneeded t 1.4 "script for t 1.4" package ifneeded t 1.4 "second script for t 1.4" list [package ifneeded t 1.4] [package names] [package versions t] } -result {{second script for t 1.4} t 1.4} test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup { package forget t } -body { package ifneeded t 1.4 "script for t 1.4" package ifneeded t 1.2 "second script" package ifneeded t 3.1 "last script" list [package ifneeded t 1.2] [package versions t] } -result {{second script} {1.4 1.2 3.1}} test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body { package names a } -returnCodes error -result {wrong # args: should be "package names"} test package-4.15 {Tcl_PackageCmd procedure, "names" option} { package forget {*}[package names] package names } {} test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup { package forget {*}[package names] } -body { package ifneeded x 1.2 {dummy} package provide x 1.3 package provide y 2.4 catch {package require z 47.16} lsort [package names] } -result {x y} test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body { package provide } -returnCodes error -result {wrong # args: should be "package provide package ?version?"} test package-4.18 {Tcl_PackageCmd procedure, "provide" option} -body { package provide a b c } -returnCodes error -result {wrong # args: should be "package provide package ?version?"} test package-4.19 {Tcl_PackageCmd procedure, "provide" option} -setup { package forget t } -body { package provide t } -result {} test package-4.20 {Tcl_PackageCmd procedure, "provide" option} -setup { package forget t } -body { package provide t 2.3 package provide t } -result {2.3} test package-4.21 {Tcl_PackageCmd procedure, "provide" option} -setup { package forget t } -returnCodes error -body { package provide t a.b } -result {expected version number but got "a.b"} test package-4.22 {Tcl_PackageCmd procedure, "require" option} -returnCodes error -body { package require } -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"} test package-4.24 {Tcl_PackageCmd procedure, "require" option} -body { package require -exact a b c # Exact syntax: -exact name version # name ?requirement ...? } -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"} test package-4.26 {Tcl_PackageCmd procedure, "require" option} -body { package require x a.b } -returnCodes error -result {expected version number but got "a.b"} test package-4.27 {Tcl_PackageCmd procedure, "require" option} -body { package require -exact x a.b } -returnCodes error -result {expected version number but got "a.b"} test package-4.28 {Tcl_PackageCmd procedure, "require" option} -body { package require -exact x } -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"} test package-4.29 {Tcl_PackageCmd procedure, "require" option} -body { package require -exact } -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"} test package-4.30 {Tcl_PackageCmd procedure, "require" option} -setup { package forget t } -body { package provide t 2.3 package require t 2.1 } -result {2.3} test package-4.31 {Tcl_PackageCmd procedure, "require" option} -setup { package forget t } -body { package require t } -returnCodes error -result {can't find package t} test package-4.32 {Tcl_PackageCmd procedure, "require" option} -setup { package forget t } -body { package ifneeded t 2.3 "error {synthetic error}" package require t 2.3 } -returnCodes error -result {synthetic error} test package-4.33 {Tcl_PackageCmd procedure, "unknown" option} -body { package unknown a b } -returnCodes error -result {wrong # args: should be "package unknown ?command?"} test package-4.34 {Tcl_PackageCmd procedure, "unknown" option} { package unknown "test script" package unknown } {test script} test package-4.35 {Tcl_PackageCmd procedure, "unknown" option} { package unknown "test script" package unknown {} package unknown } {} test package-4.36 {Tcl_PackageCmd procedure, "vcompare" option} -body { package vcompare a } -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"} test package-4.37 {Tcl_PackageCmd procedure, "vcompare" option} -body { package vcompare a b c } -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"} test package-4.38 {Tcl_PackageCmd procedure, "vcompare" option} -body { package vcompare x.y 3.4 } -returnCodes error -result {expected version number but got "x.y"} test package-4.39 {Tcl_PackageCmd procedure, "vcompare" option} -body { package vcompare 2.1 a.b } -returnCodes error -result {expected version number but got "a.b"} test package-4.40 {Tcl_PackageCmd procedure, "vcompare" option} { package vc 2.1 2.3 } {-1} test package-4.41 {Tcl_PackageCmd procedure, "vcompare" option} { package vc 2.2.4 2.2.4 } {0} test package-4.42 {Tcl_PackageCmd procedure, "versions" option} -body { package versions } -returnCodes error -result {wrong # args: should be "package versions package"} test package-4.43 {Tcl_PackageCmd procedure, "versions" option} -body { package versions a b } -returnCodes error -result {wrong # args: should be "package versions package"} test package-4.44 {Tcl_PackageCmd procedure, "versions" option} -body { package forget t package versions t } -result {} test package-4.45 {Tcl_PackageCmd procedure, "versions" option} -setup { package forget t } -body { package provide t 2.3 package versions t } -result {} test package-4.46 {Tcl_PackageCmd procedure, "versions" option} -setup { package forget t } -body { package ifneeded t 2.3 x package ifneeded t 2.4 y package versions t } -result {2.3 2.4} test package-4.47 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { package vsatisfies a } -returnCodes error -result {wrong # args: should be "package vsatisfies version ?requirement ...?"} test package-4.49 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { package vsatisfies x.y 3.4 } -returnCodes error -result {expected version number but got "x.y"} test package-4.50 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { package vcompare 2.1 a.b } -returnCodes error -result {expected version number but got "a.b"} test package-4.51 {Tcl_PackageCmd procedure, "vsatisfies" option} { package vs 2.3 2.1 } {1} test package-4.52 {Tcl_PackageCmd procedure, "vsatisfies" option} { package vs 2.3 1.2 } {0} test package-4.53 {Tcl_PackageCmd procedure, "versions" option} -body { package foo } -returnCodes error -result {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies} test package-4.54 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { package vsatisfies 2.1 2.1-3.2-4.5 } -returnCodes error -result {expected versionMin-versionMax but got "2.1-3.2-4.5"} test package-4.55 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { package vsatisfies 2.1 3.2-x.y } -returnCodes error -result {expected version number but got "x.y"} test package-4.56 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { package vsatisfies 2.1 x.y-3.2 } -returnCodes error -result {expected version number but got "x.y"} # No tests for FindPackage; can't think up anything detectable errors. test package-5.1 {TclFreePackageInfo procedure} { interp create child child eval { package ifneeded t 2.3 x package ifneeded t 2.4 y package ifneeded x 3.1 z package provide q 4.3 package unknown "will this get freed?" } interp delete child } {} test package-5.2 {TclFreePackageInfo procedure} -body { interp create foo foo eval { package ifneeded t 2.3 x package ifneeded t 2.4 y package ifneeded x 3.1 z package provide q 4.3 } foo alias z kill proc kill {} { interp delete foo } foo eval package require x 3.1 } -returnCodes error -match glob -result * test package-6.1 {CheckVersion procedure} { package vcompare 1 2.1 } -1 test package-6.2 {CheckVersion procedure} -body { package vcompare .1 2.1 } -returnCodes error -result {expected version number but got ".1"} test package-6.3 {CheckVersion procedure} -body { package vcompare 111.2a.3 2.1 } -returnCodes error -result {expected version number but got "111.2a.3"} test package-6.4 {CheckVersion procedure} -body { package vcompare 1.2.3. 2.1 } -returnCodes error -result {expected version number but got "1.2.3."} test package-6.5 {CheckVersion procedure} -body { package vcompare 1.2..3 2.1 } -returnCodes error -result {expected version number but got "1.2..3"} test package-7.1 {ComparePkgVersions procedure} { package vcompare 1.23 1.22 } {1} test package-7.2 {ComparePkgVersions procedure} { package vcompare 1.22.1.2.3 1.22.1.2.3 } {0} test package-7.3 {ComparePkgVersions procedure} { package vcompare 1.21 1.22 } {-1} test package-7.4 {ComparePkgVersions procedure} { package vcompare 1.21 1.21.2 } {-1} test package-7.5 {ComparePkgVersions procedure} { package vcompare 1.21.1 1.21 } {1} test package-7.6 {ComparePkgVersions procedure} { package vsatisfies 1.21.1 1.21 } {1} test package-7.7 {ComparePkgVersions procedure} { package vsatisfies 2.22.3 1.21 } {0} test package-7.8 {ComparePkgVersions procedure} { package vsatisfies 1 1 } {1} test package-7.9 {ComparePkgVersions procedure} { package vsatisfies 2 1 } {0} test package-8.1 {Tcl_PkgPresent procedure, any version} -setup { package forget t } -body { package provide t 2.4 package present t } -result {2.4} test package-8.2 {Tcl_PkgPresent procedure, correct version} -setup { package forget t } -body { package provide t 2.4 package present t 2.4 } -result {2.4} test package-8.3 {Tcl_PkgPresent procedure, satisfying version} -setup { package forget t } -body { package provide t 2.4 package present t 2.0 } -result {2.4} test package-8.4 {Tcl_PkgPresent procedure, not satisfying version} -setup { package forget t } -returnCodes error -body { package provide t 2.4 package present t 2.6 } -result {version conflict for package "t": have 2.4, need 2.6} test package-8.5 {Tcl_PkgPresent procedure, not satisfying version} -setup { package forget t } -returnCodes error -body { package provide t 2.4 package present t 1.0 } -result {version conflict for package "t": have 2.4, need 1.0} test package-8.6 {Tcl_PkgPresent procedure, exact version} -setup { package forget t } -body { package provide t 2.4 package present -exact t 2.4 } -result {2.4} test package-8.7 {Tcl_PkgPresent procedure, not exact version} -setup { package forget t } -returnCodes error -body { package provide t 2.4 package present -exact t 2.3 } -result {version conflict for package "t": have 2.4, need exactly 2.3} test package-8.8 {Tcl_PkgPresent procedure, unknown package} -body { package forget t package present t } -returnCodes error -result {package t is not present} test package-8.9 {Tcl_PkgPresent procedure, unknown package} -body { package forget t package present t 2.4 } -returnCodes error -result {package t 2.4 is not present} test package-8.10 {Tcl_PkgPresent procedure, unknown package} -body { package forget t package present -exact t 2.4 } -returnCodes error -result {package t 2.4 is not present} test package-8.11 {Tcl_PackageCmd procedure, "present" option} -body { package present } -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"} test package-8.12 {Tcl_PackageCmd procedure, "present" option} -body { package present a b c } -returnCodes error -result {expected version number but got "b"} test package-8.13 {Tcl_PackageCmd procedure, "present" option} -body { package present -exact a b c } -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"} test package-8.14 {Tcl_PackageCmd procedure, "present" option} -body { package present -bs a b } -returnCodes error -result {expected version number but got "a"} test package-8.15 {Tcl_PackageCmd procedure, "present" option} -body { package present x a.b } -returnCodes error -result {expected version number but got "a.b"} test package-8.16 {Tcl_PackageCmd procedure, "present" option} -body { package present -exact x a.b } -returnCodes error -result {expected version number but got "a.b"} test package-8.17 {Tcl_PackageCmd procedure, "present" option} -body { package present -exact x } -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"} test package-8.18 {Tcl_PackageCmd procedure, "present" option} -body { package present -exact } -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"} set n 0 foreach {r p vs vc} { 8.5a0 8.5a5 1 -1 8.5a0 8.5b1 1 -1 8.5a0 8.5.1 1 -1 8.5a0 8.6a0 1 -1 8.5a0 8.6b0 1 -1 8.5a0 8.6.0 1 -1 8.5a6 8.5a5 0 1 8.5a6 8.5b1 1 -1 8.5a6 8.5.1 1 -1 8.5a6 8.6a0 1 -1 8.5a6 8.6b0 1 -1 8.5a6 8.6.0 1 -1 8.5b0 8.5a5 0 1 8.5b0 8.5b1 1 -1 8.5b0 8.5.1 1 -1 8.5b0 8.6a0 1 -1 8.5b0 8.6b0 1 -1 8.5b0 8.6.0 1 -1 8.5b2 8.5a5 0 1 8.5b2 8.5b1 0 1 8.5b2 8.5.1 1 -1 8.5b2 8.6a0 1 -1 8.5b2 8.6b0 1 -1 8.5b2 8.6.0 1 -1 8.5 8.5a5 1 1 8.5 8.5b1 1 1 8.5 8.5.1 1 -1 8.5 8.6a0 1 -1 8.5 8.6b0 1 -1 8.5 8.6.0 1 -1 8.5.0 8.5a5 0 1 8.5.0 8.5b1 0 1 8.5.0 8.5.1 1 -1 8.5.0 8.6a0 1 -1 8.5.0 8.6b0 1 -1 8.5.0 8.6.0 1 -1 10 8 0 1 8 10 0 -1 0.0.1.2 0.1.2 1 -1 } { test package-9.$n {package vsatisfies} { package vsatisfies $p $r } $vs test package-10.$n {package vcompare} { package vcompare $r $p } $vc incr n } test package-11.0.0 {package vcompare at 32bit boundary} { package vcompare [expr {1<<31}] [expr {(1<<31)-1}] } 1 # Note: It is correct that the result of the very first test, i.e. "5.0 5.0a0" # is 1, i.e. that version 5.0a0 satisfies a 5.0 requirement. # The requirement "5.0" internally translates first to "5.0-6", and then to # its final form of "5.0a0-6a0". These translations are explicitly specified # by the TIP (Search for "padded/extended internally with 'a0'"). This was # done intentionally for exactly the tested case, that an alpha package can # satisfy a requirement for the regular package. An example would be a package # FOO requiring Tcl 8.X for its operation. It can be used with Tcl 8.Xa0. # Without our translation that would not be possible. set n 0 foreach {required provided satisfied} { 5.0 5.0a0 1 5.0a0 5.0 1 8.5a0- 8.5a5 1 8.5a0- 8.5b1 1 8.5a0- 8.5.1 1 8.5a0- 8.6a0 1 8.5a0- 8.6b0 1 8.5a0- 8.6.0 1 8.5a6- 8.5a5 0 8.5a6- 8.5b1 1 8.5a6- 8.5.1 1 8.5a6- 8.6a0 1 8.5a6- 8.6b0 1 8.5a6- 8.6.0 1 8.5b0- 8.5a5 0 8.5b0- 8.5b1 1 8.5b0- 8.5.1 1 8.5b0- 8.6a0 1 8.5b0- 8.6b0 1 8.5b0- 8.6.0 1 8.5b2- 8.5a5 0 8.5b2- 8.5b1 0 8.5b2- 8.5.1 1 8.5b2- 8.6a0 1 8.5b2- 8.6b0 1 8.5b2- 8.6.0 1 8.5- 8.5a5 1 8.5- 8.5b1 1 8.5- 8.5.1 1 8.5- 8.6a0 1 8.5- 8.6b0 1 8.5- 8.6.0 1 8.5.0- 8.5a5 0 8.5.0- 8.5b1 0 8.5.0- 8.5.1 1 8.5.0- 8.6a0 1 8.5.0- 8.6b0 1 8.5.0- 8.6.0 1 8.5a0-7 8.5a5 0 8.5a0-7 8.5b1 0 8.5a0-7 8.5.1 0 8.5a0-7 8.6a0 0 8.5a0-7 8.6b0 0 8.5a0-7 8.6.0 0 8.5a6-7 8.5a5 0 8.5a6-7 8.5b1 0 8.5a6-7 8.5.1 0 8.5a6-7 8.6a0 0 8.5a6-7 8.6b0 0 8.5a6-7 8.6.0 0 8.5b0-7 8.5a5 0 8.5b0-7 8.5b1 0 8.5b0-7 8.5.1 0 8.5b0-7 8.6a0 0 8.5b0-7 8.6b0 0 8.5b0-7 8.6.0 0 8.5b2-7 8.5a5 0 8.5b2-7 8.5b1 0 8.5b2-7 8.5.1 0 8.5b2-7 8.6a0 0 8.5b2-7 8.6b0 0 8.5b2-7 8.6.0 0 8.5-7 8.5a5 0 8.5-7 8.5b1 0 8.5-7 8.5.1 0 8.5-7 8.6a0 0 8.5-7 8.6b0 0 8.5-7 8.6.0 0 8.5.0-7 8.5a5 0 8.5.0-7 8.5b1 0 8.5.0-7 8.5.1 0 8.5.0-7 8.6a0 0 8.5.0-7 8.6b0 0 8.5.0-7 8.6.0 0 8.5a0-8.6.1 8.5a5 1 8.5a0-8.6.1 8.5b1 1 8.5a0-8.6.1 8.5.1 1 8.5a0-8.6.1 8.6a0 1 8.5a0-8.6.1 8.6b0 1 8.5a0-8.6.1 8.6.0 1 8.5a6-8.6.1 8.5a5 0 8.5a6-8.6.1 8.5b1 1 8.5a6-8.6.1 8.5.1 1 8.5a6-8.6.1 8.6a0 1 8.5a6-8.6.1 8.6b0 1 8.5a6-8.6.1 8.6.0 1 8.5b0-8.6.1 8.5a5 0 8.5b0-8.6.1 8.5b1 1 8.5b0-8.6.1 8.5.1 1 8.5b0-8.6.1 8.6a0 1 8.5b0-8.6.1 8.6b0 1 8.5b0-8.6.1 8.6.0 1 8.5b2-8.6.1 8.5a5 0 8.5b2-8.6.1 8.5b1 0 8.5b2-8.6.1 8.5.1 1 8.5b2-8.6.1 8.6a0 1 8.5b2-8.6.1 8.6b0 1 8.5b2-8.6.1 8.6.0 1 8.5-8.6.1 8.5a5 1 8.5-8.6.1 8.5b1 1 8.5-8.6.1 8.5.1 1 8.5-8.6.1 8.6a0 1 8.5-8.6.1 8.6b0 1 8.5-8.6.1 8.6.0 1 8.5.0-8.6.1 8.5a5 0 8.5.0-8.6.1 8.5b1 0 8.5.0-8.6.1 8.5.1 1 8.5.0-8.6.1 8.6a0 1 8.5.0-8.6.1 8.6b0 1 8.5.0-8.6.1 8.6.0 1 8.5a0-8.5a0 8.5a0 1 8.5a0-8.5a0 8.5b1 0 8.5a0-8.5a0 8.4 0 8.5b0-8.5b0 8.5a5 0 8.5b0-8.5b0 8.5b0 1 8.5b0-8.5b0 8.5.1 0 8.5-8.5 8.5a5 0 8.5-8.5 8.5b1 0 8.5-8.5 8.5 1 8.5-8.5 8.5.1 0 8.5.0-8.5.0 8.5a5 0 8.5.0-8.5.0 8.5b1 0 8.5.0-8.5.0 8.5.0 1 8.5.0-8.5.0 8.5.1 0 8.5.0-8.5.0 8.6a0 0 8.5.0-8.5.0 8.6b0 0 8.5.0-8.5.0 8.6.0 0 8.2 9 0 8.2- 9 1 8.2-8.5 9 0 8.2-9.1 9 1 8.5-8.5 8.5b1 0 8.5a0-8.5 8.5b1 0 8.5a0-8.5.1 8.5b1 1 8.5-8.5 8.5 1 8.5.0-8.5.0 8.5 1 8.5a0-8.5.0 8.5 0 } { test package-11.$n "package vsatisfies $provided $required" { package vsatisfies $provided $required } $satisfied incr n } test package-12.0 "package vsatisfies multiple" { # yes no package vsatisfies 8.4 8.4 7.3 } 1 test package-12.1 "package vsatisfies multiple" { # no yes package vsatisfies 8.4 7.3 8.4 } 1 test package-12.2 "package vsatisfies multiple" { # yes yes package vsatisfies 8.4.2 8.4 8.4.1 } 1 test package-12.3 "package vsatisfies multiple" { # no no package vsatisfies 8.4 7.3 6.1 } 0 proc prefer {args} { set ip [interp create] try { lappend res [$ip eval {package prefer}] foreach mode $args { lappend res [$ip eval [list package prefer $mode]] } return $res } finally { interp delete $ip } } test package-13.0 {package prefer defaults} { prefer } stable test package-13.1 {package prefer defaults} -body { set ::env(TCL_PKG_PREFER_LATEST) stable ;# value not relevant! prefer } -cleanup { unset -nocomplain ::env(TCL_PKG_PREFER_LATEST) } -result latest test package-14.0 {wrong\#args} -returnCodes error -body { package prefer foo bar } -result {wrong # args: should be "package prefer ?latest|stable?"} test package-14.1 {bogus argument} -returnCodes error -body { package prefer foo } -result {bad preference "foo": must be latest or stable} test package-15.0 {set, keep} {package prefer stable} stable test package-15.1 {set stable, keep} {prefer stable} {stable stable} test package-15.2 {set latest, change} {prefer latest} {stable latest} test package-15.3 {set latest, keep} { prefer latest latest } {stable latest latest} test package-15.4 {set stable, rejected} { prefer latest stable } {stable latest latest} rename prefer {} set auto_path $oldPath package unknown $oldPkgUnknown cleanupTests } # cleanup interp delete $i ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/parseExpr.test0000644000175000017500000020152614554262142015664 0ustar sergeisergei# This file contains a collection of tests for the procedures in the # file tclCompExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Note that the Tcl expression parser (tclCompExpr.c) does not check # the semantic validity of the expressions it parses. It does not check, # for example, that a math function actually exists, or that the operands # of "<<" are integers. testConstraint testexprparser [llength [info commands testexprparser]] testConstraint testbytestring [llength [info commands testbytestring]] # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues binary scan [binary format dd -1.0 1.0] c* c switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ ieeeValues(-Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ ieeeValues(+Normal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ ieeeValues(+Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 } default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] ###################################################################### test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {testexprparser testbytestring} { testexprparser [testbytestring "1+2\0 +3"] -1 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} testexprparser { testexprparser "1 + 2" -1 } {- {} 0 subexpr {1 + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} testexprparser { testexprparser 12345678901234567890 -1 } {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-1.4 {Tcl_ParseExpr procedure, error in conditional expression} \ -constraints testexprparser -body { testexprparser {foo+} -1 } -match glob -returnCodes error -result * test parseExpr-1.5 {Tcl_ParseExpr procedure, lexemes after the expression} -constraints testexprparser -body { testexprparser {1+2 345} -1 } -returnCodes error -match glob -result * test parseExpr-2.1 {ParseCondExpr procedure, valid test subexpr} testexprparser { testexprparser {2>3? 1 : 0} -1 } {- {} 0 subexpr {2>3? 1 : 0} 11 operator ? 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-2.2 {ParseCondExpr procedure, error in test subexpr} \ -constraints testexprparser -body { testexprparser {0 || foo} -1 } -match glob -returnCodes error -result * test parseExpr-2.3 {ParseCondExpr procedure, next lexeme isn't "?"} testexprparser { testexprparser {1+2} -1 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-2.4 {ParseCondExpr procedure, next lexeme is "?"} testexprparser { testexprparser {1+2 ? 3 : 4} -1 } {- {} 0 subexpr {1+2 ? 3 : 4} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-2.5 {ParseCondExpr procedure, bad lexeme after "?"} testexprparser { testexprparser {1+2 ? 12345678901234567890 : 0} -1 } {- {} 0 subexpr {1+2 ? 12345678901234567890 : 0} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 subexpr 0 1 text 0 0 {}} test parseExpr-2.6 {ParseCondExpr procedure, valid "then" subexpression} testexprparser { testexprparser {1? 3 : 4} -1 } {- {} 0 subexpr {1? 3 : 4} 7 operator ? 0 subexpr 1 1 text 1 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-2.7 {ParseCondExpr procedure, error in "then" subexpression} \ -constraints testexprparser -body { testexprparser {1? fred : martha} -1 } -match glob -returnCodes error -result * test parseExpr-2.8 {ParseCondExpr procedure, lexeme after "then" subexpr isn't ":"} -constraints testexprparser -body { testexprparser {1? 2 martha 3} -1 } -returnCodes error -match glob -result * test parseExpr-2.9 {ParseCondExpr procedure, valid "else" subexpression} testexprparser { testexprparser {27||3? 3 : 4&&9} -1 } {- {} 0 subexpr {27||3? 3 : 4&&9} 15 operator ? 0 subexpr 27||3 5 operator || 0 subexpr 27 1 text 27 0 subexpr 3 1 text 3 0 subexpr 3 1 text 3 0 subexpr 4&&9 5 operator && 0 subexpr 4 1 text 4 0 subexpr 9 1 text 9 0 {}} test parseExpr-2.10 {ParseCondExpr procedure, error in "else" subexpression} \ -constraints testexprparser -body { testexprparser {1? 2 : martha} -1 } -match glob -returnCodes error -result * test parseExpr-3.1 {ParseLorExpr procedure, valid logical and subexpr} testexprparser { testexprparser {1&&2 || 3} -1 } {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-3.2 {ParseLorExpr procedure, error in logical and subexpr} \ -constraints testexprparser -body { testexprparser {1&&foo || 3} -1 } -match glob -returnCodes error -result * test parseExpr-3.3 {ParseLorExpr procedure, next lexeme isn't "||"} testexprparser { testexprparser {1&&2? 1 : 0} -1 } {- {} 0 subexpr {1&&2? 1 : 0} 11 operator ? 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-3.4 {ParseLorExpr procedure, next lexeme is "||"} testexprparser { testexprparser {1&&2 || 3} -1 } {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-3.5 {ParseLorExpr procedure, bad lexeme after "||"} testexprparser { testexprparser {1&&2 || 12345678901234567890} -1 } {- {} 0 subexpr {1&&2 || 12345678901234567890} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-3.6 {ParseLorExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1&&2 || 3 || 4} -1 } {- {} 0 subexpr {1&&2 || 3 || 4} 13 operator || 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-3.7 {ParseLorExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1&&2 || 3 || martha} -1 } -match glob -returnCodes error -result * test parseExpr-4.1 {ParseLandExpr procedure, valid LHS "|" subexpr} testexprparser { testexprparser {1|2 && 3} -1 } {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-4.2 {ParseLandExpr procedure, error in LHS "|" subexpr} \ -constraints testexprparser -body { testexprparser {1&&foo && 3} -1 } -match glob -returnCodes error -result * test parseExpr-4.3 {ParseLandExpr procedure, next lexeme isn't "&&"} testexprparser { testexprparser {1|2? 1 : 0} -1 } {- {} 0 subexpr {1|2? 1 : 0} 11 operator ? 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-4.4 {ParseLandExpr procedure, next lexeme is "&&"} testexprparser { testexprparser {1|2 && 3} -1 } {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-4.5 {ParseLandExpr procedure, bad lexeme after "&&"} testexprparser { testexprparser {1|2 && 12345678901234567890} -1 } {- {} 0 subexpr {1|2 && 12345678901234567890} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-4.6 {ParseLandExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1|2 && 3 && 4} -1 } {- {} 0 subexpr {1|2 && 3 && 4} 13 operator && 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-4.7 {ParseLandExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1|2 && 3 && martha} -1 } -match glob -returnCodes error -result * test parseExpr-5.1 {ParseBitOrExpr procedure, valid LHS "^" subexpr} testexprparser { testexprparser {1^2 | 3} -1 } {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-5.2 {ParseBitOrExpr procedure, error in LHS "^" subexpr} \ -constraints testexprparser -body { testexprparser {1|foo | 3} -1 } -match glob -returnCodes error -result * test parseExpr-5.3 {ParseBitOrExpr procedure, next lexeme isn't "|"} testexprparser { testexprparser {1^2? 1 : 0} -1 } {- {} 0 subexpr {1^2? 1 : 0} 11 operator ? 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-5.4 {ParseBitOrExpr procedure, next lexeme is "|"} testexprparser { testexprparser {1^2 | 3} -1 } {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-5.5 {ParseBitOrExpr procedure, bad lexeme after "|"} testexprparser { testexprparser {1^2 | 12345678901234567890} -1 } {- {} 0 subexpr {1^2 | 12345678901234567890} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-5.6 {ParseBitOrExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1^2 | 3 | 4} -1 } {- {} 0 subexpr {1^2 | 3 | 4} 13 operator | 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-5.7 {ParseBitOrExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1^2 | 3 | martha} -1 } -match glob -returnCodes error -result * test parseExpr-6.1 {ParseBitXorExpr procedure, valid LHS "&" subexpr} testexprparser { testexprparser {1&2 ^ 3} -1 } {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-6.2 {ParseBitXorExpr procedure, error in LHS "&" subexpr} \ -constraints testexprparser -body { testexprparser {1^foo ^ 3} -1 } -match glob -returnCodes error -result * test parseExpr-6.3 {ParseBitXorExpr procedure, next lexeme isn't "^"} testexprparser { testexprparser {1&2? 1 : 0} -1 } {- {} 0 subexpr {1&2? 1 : 0} 11 operator ? 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-6.4 {ParseBitXorExpr procedure, next lexeme is "^"} testexprparser { testexprparser {1&2 ^ 3} -1 } {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-6.5 {ParseBitXorExpr procedure, bad lexeme after "^"} testexprparser { testexprparser {1&2 ^ 12345678901234567890} -1 } {- {} 0 subexpr {1&2 ^ 12345678901234567890} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-6.6 {ParseBitXorExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1&2 ^ 3 ^ 4} -1 } {- {} 0 subexpr {1&2 ^ 3 ^ 4} 13 operator ^ 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-6.7 {ParseBitXorExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1&2 ^ 3 ^ martha} -1 } -match glob -returnCodes error -result * test parseExpr-7.1 {ParseBitAndExpr procedure, valid LHS equality subexpr} testexprparser { testexprparser {1==2 & 3} -1 } {- {} 0 subexpr {1==2 & 3} 9 operator & 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-7.2 {ParseBitAndExpr procedure, error in LHS equality subexpr} \ -constraints testexprparser -body { testexprparser {1!=foo & 3} -1 } -match glob -returnCodes error -result * test parseExpr-7.3 {ParseBitAndExpr procedure, next lexeme isn't "&"} testexprparser { testexprparser {1==2? 1 : 0} -1 } {- {} 0 subexpr {1==2? 1 : 0} 11 operator ? 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-7.4 {ParseBitAndExpr procedure, next lexeme is "&"} testexprparser { testexprparser {1>2 & 3} -1 } {- {} 0 subexpr {1>2 & 3} 9 operator & 0 subexpr 1>2 5 operator > 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-7.5 {ParseBitAndExpr procedure, bad lexeme after "&"} {testexprparser} { testexprparser {1==2 & 12345678901234567890} -1 } {- {} 0 subexpr {1==2 & 12345678901234567890} 9 operator & 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-7.6 {ParseBitAndExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1<2 & 3 & 4} -1 } {- {} 0 subexpr {1<2 & 3 & 4} 13 operator & 0 subexpr {1<2 & 3} 9 operator & 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-7.7 {ParseBitAndExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1==2 & 3>2 & martha} -1 } -match glob -returnCodes error -result * test parseExpr-8.1 {ParseEqualityExpr procedure, valid LHS relational subexpr} testexprparser { testexprparser {1<2 == 3} -1 } {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-8.2 {ParseEqualityExpr procedure, error in LHS relational subexpr} \ -constraints testexprparser -body { testexprparser {1>=foo == 3} -1 } -match glob -returnCodes error -result * test parseExpr-8.3 {ParseEqualityExpr procedure, next lexeme isn't "==" or "!="} testexprparser { testexprparser {1<2? 1 : 0} -1 } {- {} 0 subexpr {1<2? 1 : 0} 11 operator ? 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-8.4 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} testexprparser { testexprparser {1<2 == 3} -1 } {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-8.5 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} testexprparser { testexprparser {1<2 != 3} -1 } {- {} 0 subexpr {1<2 != 3} 9 operator != 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-8.6 {ParseEqualityExpr procedure, bad lexeme after "==" or "!="} testexprparser { testexprparser {1<2 == 12345678901234567890} -1 } {- {} 0 subexpr {1<2 == 12345678901234567890} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-8.7 {ParseEqualityExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1<2 == 3 == 4} -1 } {- {} 0 subexpr {1<2 == 3 == 4} 13 operator == 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-8.8 {ParseEqualityExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1<2 == 3 != martha} -1 } -match glob -returnCodes error -result * test parseExpr-9.1 {ParseRelationalExpr procedure, valid LHS shift subexpr} testexprparser { testexprparser {1<<2 < 3} -1 } {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-9.2 {ParseRelationalExpr procedure, error in LHS shift subexpr} \ -constraints testexprparser -body { testexprparser {1>=foo < 3} -1 } -match glob -returnCodes error -result * test parseExpr-9.3 {ParseRelationalExpr procedure, next lexeme isn't relational op} testexprparser { testexprparser {1<<2? 1 : 0} -1 } {- {} 0 subexpr {1<<2? 1 : 0} 11 operator ? 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-9.4 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser { testexprparser {1<<2 < 3} -1 } {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-9.5 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser { testexprparser {1>>2 > 3} -1 } {- {} 0 subexpr {1>>2 > 3} 9 operator > 0 subexpr 1>>2 5 operator >> 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-9.6 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser { testexprparser {1<<2 <= 3} -1 } {- {} 0 subexpr {1<<2 <= 3} 9 operator <= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-9.7 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser { testexprparser {1<<2 >= 3} -1 } {- {} 0 subexpr {1<<2 >= 3} 9 operator >= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-9.8 {ParseRelationalExpr procedure, bad lexeme after relational op} testexprparser { testexprparser {1<<2 < 12345678901234567890} -1 } {- {} 0 subexpr {1<<2 < 12345678901234567890} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-9.9 {ParseRelationalExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1<<2 < 3 < 4} -1 } {- {} 0 subexpr {1<<2 < 3 < 4} 13 operator < 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-9.10 {ParseRelationalExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1<<2 < 3 > martha} -1 } -match glob -returnCodes error -result * test parseExpr-10.1 {ParseShiftExpr procedure, valid LHS add subexpr} testexprparser { testexprparser {1+2 << 3} -1 } {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-10.2 {ParseShiftExpr procedure, error in LHS add subexpr} \ -constraints testexprparser -body { testexprparser {1-foo << 3} -1 } -match glob -returnCodes error -result * test parseExpr-10.3 {ParseShiftExpr procedure, next lexeme isn't "<<" or ">>"} testexprparser { testexprparser {1+2? 1 : 0} -1 } {- {} 0 subexpr {1+2? 1 : 0} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-10.4 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} testexprparser { testexprparser {1+2 << 3} -1 } {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-10.5 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} testexprparser { testexprparser {1+2 >> 3} -1 } {- {} 0 subexpr {1+2 >> 3} 9 operator >> 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-10.6 {ParseShiftExpr procedure, bad lexeme after "<<" or ">>"} testexprparser { testexprparser {1+2 << 12345678901234567890} -1 } {- {} 0 subexpr {1+2 << 12345678901234567890} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-10.7 {ParseShiftExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1+2 << 3 << 4} -1 } {- {} 0 subexpr {1+2 << 3 << 4} 13 operator << 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-10.8 {ParseShiftExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1+2 << 3 >> martha} -1 } -match glob -returnCodes error -result * test parseExpr-11.1 {ParseAddExpr procedure, valid LHS multiply subexpr} testexprparser { testexprparser {1*2 + 3} -1 } {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-11.2 {ParseAddExpr procedure, error in LHS multiply subexpr} \ -constraints testexprparser -body { testexprparser {1/foo + 3} -1 } -match glob -returnCodes error -result * test parseExpr-11.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} testexprparser { testexprparser {1*2? 1 : 0} -1 } {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-11.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser { testexprparser {1*2 + 3} -1 } {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-11.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser { testexprparser {1*2 - 3} -1 } {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-11.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} testexprparser { testexprparser {1*2 + 12345678901234567890} -1 } {- {} 0 subexpr {1*2 + 12345678901234567890} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-11.7 {ParseAddExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1*2 + 3 + 4} -1 } {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-11.8 {ParseAddExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1*2 + 3 - martha} -1 } -match glob -returnCodes error -result * test parseExpr-12.1 {ParseAddExpr procedure, valid LHS multiply subexpr} testexprparser { testexprparser {1*2 + 3} -1 } {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-12.2 {ParseAddExpr procedure, error in LHS multiply subexpr} \ -constraints testexprparser -body { testexprparser {1/foo + 3} -1 } -match glob -returnCodes error -result * test parseExpr-12.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} testexprparser { testexprparser {1*2? 1 : 0} -1 } {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-12.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser { testexprparser {1*2 + 3} -1 } {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-12.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser { testexprparser {1*2 - 3} -1 } {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-12.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} testexprparser { testexprparser {1*2 + 12345678901234567890} -1 } {- {} 0 subexpr {1*2 + 12345678901234567890} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-12.7 {ParseAddExpr procedure, valid RHS subexpression} testexprparser { testexprparser {1*2 + 3 + 4} -1 } {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-12.8 {ParseAddExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {1*2 + 3 - martha} -1 } -match glob -returnCodes error -result * test parseExpr-13.1 {ParseMultiplyExpr procedure, valid LHS unary subexpr} testexprparser { testexprparser {+2 * 3} -1 } {- {} 0 subexpr {+2 * 3} 7 operator * 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-13.2 {ParseMultiplyExpr procedure, error in LHS unary subexpr} testexprparser { testexprparser {-12345678901234567890 * 3} -1 } {- {} 0 subexpr {-12345678901234567890 * 3} 7 operator * 0 subexpr -12345678901234567890 3 operator - 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 subexpr 3 1 text 3 0 {}} test parseExpr-13.3 {ParseMultiplyExpr procedure, next lexeme isn't "*", "/", or "%"} testexprparser { testexprparser {+2? 1 : 0} -1 } {- {} 0 subexpr {+2? 1 : 0} 9 operator ? 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-13.4 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} testexprparser { testexprparser {-123 * 3} -1 } {- {} 0 subexpr {-123 * 3} 7 operator * 0 subexpr -123 3 operator - 0 subexpr 123 1 text 123 0 subexpr 3 1 text 3 0 {}} test parseExpr-13.5 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} testexprparser { testexprparser {+-456 / 3} -1 } {- {} 0 subexpr {+-456 / 3} 9 operator / 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}} test parseExpr-13.6 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} testexprparser { testexprparser {+-456 % 3} -1 } {- {} 0 subexpr {+-456 % 3} 9 operator % 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}} test parseExpr-13.7 {ParseMultiplyExpr procedure, bad lexeme after "*", "/", or "%"} testexprparser { testexprparser {--++5 / 12345678901234567890} -1 } {- {} 0 subexpr {--++5 / 12345678901234567890} 13 operator / 0 subexpr --++5 9 operator - 0 subexpr -++5 7 operator - 0 subexpr ++5 5 operator + 0 subexpr +5 3 operator + 0 subexpr 5 1 text 5 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-13.8 {ParseMultiplyExpr procedure, valid RHS subexpression} testexprparser { testexprparser {-2 / 3 % 4} -1 } {- {} 0 subexpr {-2 / 3 % 4} 11 operator % 0 subexpr {-2 / 3} 7 operator / 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}} test parseExpr-13.9 {ParseMultiplyExpr procedure, error in RHS subexpression} \ -constraints testexprparser -body { testexprparser {++2 / 3 * martha} -1 } -match glob -returnCodes error -result * test parseExpr-14.1 {ParseUnaryExpr procedure, first token is unary operator} testexprparser { testexprparser {+2} -1 } {- {} 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 {}} test parseExpr-14.2 {ParseUnaryExpr procedure, first token is unary operator} testexprparser { testexprparser {-2} -1 } {- {} 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 {}} test parseExpr-14.3 {ParseUnaryExpr procedure, first token is unary operator} testexprparser { testexprparser {~2} -1 } {- {} 0 subexpr ~2 3 operator ~ 0 subexpr 2 1 text 2 0 {}} test parseExpr-14.4 {ParseUnaryExpr procedure, first token is unary operator} testexprparser { testexprparser {!2} -1 } {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}} test parseExpr-14.5 {ParseUnaryExpr procedure, error in lexeme after unary op} testexprparser { testexprparser {-12345678901234567890} -1 } {- {} 0 subexpr -12345678901234567890 3 operator - 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-14.6 {ParseUnaryExpr procedure, simple unary expr after unary op} testexprparser { testexprparser {+"1234"} -1 } {- {} 0 subexpr +\"1234\" 3 operator + 0 subexpr {"1234"} 1 text 1234 0 {}} test parseExpr-14.7 {ParseUnaryExpr procedure, another unary expr after unary op} testexprparser { testexprparser {~!{fred}} -1 } {- {} 0 subexpr ~!{fred} 5 operator ~ 0 subexpr !{fred} 3 operator ! 0 subexpr {{fred}} 1 text fred 0 {}} test parseExpr-14.8 {ParseUnaryExpr procedure, error in unary expr after unary op} -constraints testexprparser -body { testexprparser {+-||27} -1 } -returnCodes error -match glob -result * test parseExpr-14.9 {ParseUnaryExpr procedure, error in unary expr after unary op} -constraints testexprparser -body { testexprparser {+-||27} -1 } -returnCodes error -match glob -result * test parseExpr-14.10 {ParseUnaryExpr procedure, first token is not unary op} testexprparser { testexprparser {123} -1 } {- {} 0 subexpr 123 1 text 123 0 {}} test parseExpr-14.11 {ParseUnaryExpr procedure, not unary expr, complex primary expr} testexprparser { testexprparser {(1+2)} -1 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-14.12 {ParseUnaryExpr procedure, not unary expr, error in primary expr} testexprparser { testexprparser {(12345678901234567890)} -1 } {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-15.1 {ParsePrimaryExpr procedure, just parenthesized subexpr} testexprparser { testexprparser {({abc}/{def})} -1 } {- {} 0 subexpr {{abc}/{def}} 5 operator / 0 subexpr {{abc}} 1 text abc 0 subexpr {{def}} 1 text def 0 {}} test parseExpr-15.2 {ParsePrimaryExpr procedure, bad lexeme after "("} {testexprparser} { testexprparser {(12345678901234567890)} -1 } {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-15.3 {ParsePrimaryExpr procedure, valid parenthesized subexpr} testexprparser { testexprparser {({abc}? 2*4 : -6)} -1 } {- {} 0 subexpr {{abc}? 2*4 : -6} 13 operator ? 0 subexpr {{abc}} 1 text abc 0 subexpr 2*4 5 operator * 0 subexpr 2 1 text 2 0 subexpr 4 1 text 4 0 subexpr -6 3 operator - 0 subexpr 6 1 text 6 0 {}} test parseExpr-15.4 {ParsePrimaryExpr procedure, error in parenthesized subexpr} -constraints testexprparser -body { testexprparser {(? 123 : 456)} -1 } -returnCodes error -match glob -result * test parseExpr-15.5 {ParsePrimaryExpr procedure, missing ")" after in parenthesized subexpr} -constraints testexprparser -body { testexprparser {({abc}/{def}} -1 } -returnCodes error -match glob -result * test parseExpr-15.6 {ParsePrimaryExpr procedure, primary is literal} testexprparser { testexprparser {12345} -1 } {- {} 0 subexpr 12345 1 text 12345 0 {}} test parseExpr-15.7 {ParsePrimaryExpr procedure, primary is literal} testexprparser { testexprparser {12345.6789} -1 } {- {} 0 subexpr 12345.6789 1 text 12345.6789 0 {}} test parseExpr-15.8 {ParsePrimaryExpr procedure, primary is var reference} testexprparser { testexprparser {$a} -1 } {- {} 0 subexpr {$a} 2 variable {$a} 1 text a 0 {}} test parseExpr-15.9 {ParsePrimaryExpr procedure, primary is var reference} testexprparser { testexprparser {$a(hello$there)} -1 } {- {} 0 subexpr {$a(hello$there)} 5 variable {$a(hello$there)} 4 text a 0 text hello 0 variable {$there} 1 text there 0 {}} test parseExpr-15.10 {ParsePrimaryExpr procedure, primary is var reference} testexprparser { testexprparser {$a()} -1 } {- {} 0 subexpr {$a()} 3 variable {$a()} 2 text a 0 text {} 0 {}} test parseExpr-15.11 {ParsePrimaryExpr procedure, error in var reference} -constraints testexprparser -body { testexprparser {$a(} -1 } -returnCodes error -match glob -result * test parseExpr-15.12 {ParsePrimaryExpr procedure, primary is quoted string} testexprparser { testexprparser {"abc $xyz def"} -1 } {- {} 0 subexpr {"abc $xyz def"} 5 word {"abc $xyz def"} 4 text {abc } 0 variable {$xyz} 1 text xyz 0 text { def} 0 {}} test parseExpr-15.13 {ParsePrimaryExpr procedure, error in quoted string} -constraints testexprparser -body { testexprparser {"$a(12"} -1 } -returnCodes error -match glob -result * test parseExpr-15.14 {ParsePrimaryExpr procedure, quoted string has multiple tokens} testexprparser { testexprparser {"abc [xyz] $def"} -1 } {- {} 0 subexpr {"abc [xyz] $def"} 6 word {"abc [xyz] $def"} 5 text {abc } 0 command {[xyz]} 0 text { } 0 variable {$def} 1 text def 0 {}} test parseExpr-15.15 {ParsePrimaryExpr procedure, primary is command} testexprparser { testexprparser {[def]} -1 } {- {} 0 subexpr {[def]} 1 command {[def]} 0 {}} test parseExpr-15.16 {ParsePrimaryExpr procedure, primary is multiple commands} testexprparser { testexprparser {[one; two; three; four;]} -1 } {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}} test parseExpr-15.17 {ParsePrimaryExpr procedure, primary is multiple commands} testexprparser { testexprparser {[one; two; three; four;]} -1 } {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}} test parseExpr-15.18 {ParsePrimaryExpr procedure, missing close bracket} -constraints testexprparser -body { testexprparser {[one} -1 } -returnCodes error -match glob -result * test parseExpr-15.19 {ParsePrimaryExpr procedure, primary is braced string} testexprparser { testexprparser {{hello world}} -1 } {- {} 0 subexpr {{hello world}} 1 text {hello world} 0 {}} test parseExpr-15.20 {ParsePrimaryExpr procedure, error in primary, which is braced string} -constraints testexprparser -body { testexprparser "\{abc\\\n" -1 } -returnCodes error -match glob -result * test parseExpr-15.21 {ParsePrimaryExpr procedure, primary is braced string with multiple tokens} testexprparser { testexprparser "\{ \\ +123 \}" -1 } {- {} 0 subexpr \{\ \ \\\n\ +123\ \} 4 word \{\ \ \\\n\ +123\ \} 3 text { } 0 backslash \\\n\ 0 text {+123 } 0 {}} test parseExpr-15.22 {ParsePrimaryExpr procedure, primary is function call} testexprparser { testexprparser {foo(123)} -1 } {- {} 0 subexpr foo(123) 3 operator foo 0 subexpr 123 1 text 123 0 {}} test parseExpr-15.23 {ParsePrimaryExpr procedure, bad lexeme after function name} -constraints testexprparser -body { testexprparser {foo 12345678901234567890 123)} -1 } -returnCodes error -match glob -result * test parseExpr-15.24 {ParsePrimaryExpr procedure, lexeme after function name isn't "("} \ -constraints testexprparser -body { testexprparser {foo 27.4 123)} -1 } -match glob -returnCodes error -result * test parseExpr-15.25 {ParsePrimaryExpr procedure, bad lexeme after "("} testexprparser { testexprparser {foo(12345678901234567890)} -1 } {- {} 0 subexpr foo(12345678901234567890) 3 operator foo 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-15.26 {ParsePrimaryExpr procedure, function call, one arg} testexprparser { testexprparser {foo(27*4)} -1 } {- {} 0 subexpr foo(27*4) 7 operator foo 0 subexpr 27*4 5 operator * 0 subexpr 27 1 text 27 0 subexpr 4 1 text 4 0 {}} test parseExpr-15.27 {ParsePrimaryExpr procedure, error in function arg} -constraints testexprparser -body { testexprparser {foo(*1-2)} -1 } -returnCodes error -match glob -result * test parseExpr-15.28 {ParsePrimaryExpr procedure, error in function arg} -constraints testexprparser -body { testexprparser {foo(*1-2)} -1 } -returnCodes error -match glob -result * test parseExpr-15.29 {ParsePrimaryExpr procedure, function call, comma after arg} testexprparser { testexprparser {foo(27-2, (-2*[foo]))} -1 } {- {} 0 subexpr {foo(27-2, (-2*[foo]))} 15 operator foo 0 subexpr 27-2 5 operator - 0 subexpr 27 1 text 27 0 subexpr 2 1 text 2 0 subexpr {-2*[foo]} 7 operator * 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr {[foo]} 1 command {[foo]} 0 {}} test parseExpr-15.30 {ParsePrimaryExpr procedure, bad lexeme after comma} testexprparser { testexprparser {foo(123, 12345678901234567890)} -1 } {- {} 0 subexpr {foo(123, 12345678901234567890)} 5 operator foo 0 subexpr 123 1 text 123 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-15.31 {ParsePrimaryExpr procedure, lexeme not "," or ")" after arg} -constraints testexprparser -body { testexprparser {foo(123 [foo])} -1 } -returnCodes error -match glob -result * test parseExpr-15.32 {ParsePrimaryExpr procedure, bad lexeme after primary} -constraints testexprparser -body { testexprparser {123 12345678901234567890} -1 } -returnCodes error -match glob -result * test parseExpr-15.33 {ParsePrimaryExpr procedure, comma-specific message} -constraints testexprparser -body { testexprparser {123+,456} -1 } -returnCodes error -match glob -result * test parseExpr-15.34 {ParsePrimaryExpr procedure, single equal-specific message} -constraints testexprparser -body { testexprparser {123+=456} -1 } -returnCodes error -match glob -result * test parseExpr-15.35 {ParsePrimaryExpr procedure, error in parenthesized subexpr} -constraints testexprparser -body { testexprparser {(: 123 : 456)} -1 } -returnCodes error -match glob -result * test parseExpr-15.36 {ParsePrimaryExpr procedure, missing close-bracket} -constraints testexprparser -body { # Test for Bug 681841 testexprparser {[set a [format bc]} -1 } -returnCodes error -match glob -result * test parseExpr-16.1 {GetLexeme procedure, whitespace before lexeme} testexprparser { testexprparser { 123} -1 } {- {} 0 subexpr 123 1 text 123 0 {}} test parseExpr-16.2 {GetLexeme procedure, whitespace before lexeme} testexprparser { testexprparser { \ 456} -1 } {- {} 0 subexpr 456 1 text 456 0 {}} test parseExpr-16.3 {GetLexeme procedure, no lexeme after whitespace} testexprparser { testexprparser { 123 \ } -1 } {- {} 0 subexpr 123 1 text 123 0 {}} test parseExpr-16.4 {GetLexeme procedure, integer lexeme} testexprparser { testexprparser {000} -1 } {- {} 0 subexpr 000 1 text 000 0 {}} test parseExpr-16.5 {GetLexeme procedure, integer lexeme too big} testexprparser { testexprparser {12345678901234567890} -1 } {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}} test parseExpr-16.6 {GetLexeme procedure, bad integer lexeme} -constraints testexprparser -body { testexprparser {0o999} -1 } -returnCodes error -match glob -result {*invalid octal number*} test parseExpr-16.7 {GetLexeme procedure, double lexeme} testexprparser { testexprparser {0.999} -1 } {- {} 0 subexpr 0.999 1 text 0.999 0 {}} test parseExpr-16.8 {GetLexeme procedure, double lexeme} testexprparser { testexprparser {.123} -1 } {- {} 0 subexpr .123 1 text .123 0 {}} test parseExpr-16.9 {GetLexeme procedure, double lexeme} {testexprparser unix} { testexprparser {nan} -1 } {- {} 0 subexpr nan 1 text nan 0 {}} test parseExpr-16.10 {GetLexeme procedure, double lexeme} {testexprparser unix} { testexprparser {NaN} -1 } {- {} 0 subexpr NaN 1 text NaN 0 {}} test parseExpr-16.11a {GetLexeme procedure, bad double lexeme too big} {testexprparser && !ieeeFloatingPoint} { list [catch {testexprparser {123.e+99999999999999} -1} msg] $msg } {1 {floating-point value too large to represent}} test parseExpr-16.11b {GetLexeme procedure, bad double lexeme too big} {testexprparser && ieeeFloatingPoint} { list [catch {testexprparser {123.e+99999999999999} -1} msg] $msg } {0 {- {} 0 subexpr 123.e+99999999999999 1 text 123.e+99999999999999 0 {}}} test parseExpr-16.12 {GetLexeme procedure, bad double lexeme} -constraints testexprparser -body { testexprparser {123.4x56} -1 } -returnCodes error -match glob -result * test parseExpr-16.13 {GetLexeme procedure, lexeme is "["} testexprparser { testexprparser {[foo]} -1 } {- {} 0 subexpr {[foo]} 1 command {[foo]} 0 {}} test parseExpr-16.14 {GetLexeme procedure, lexeme is open brace} testexprparser { testexprparser {{bar}} -1 } {- {} 0 subexpr {{bar}} 1 text bar 0 {}} test parseExpr-16.15 {GetLexeme procedure, lexeme is "("} testexprparser { testexprparser {(123)} -1 } {- {} 0 subexpr 123 1 text 123 0 {}} test parseExpr-16.16 {GetLexeme procedure, lexeme is ")"} testexprparser { testexprparser {(2*3)} -1 } {- {} 0 subexpr 2*3 5 operator * 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.17 {GetLexeme procedure, lexeme is "$"} testexprparser { testexprparser {$wombat} -1 } {- {} 0 subexpr {$wombat} 2 variable {$wombat} 1 text wombat 0 {}} test parseExpr-16.18 "GetLexeme procedure, lexeme is '\"'" testexprparser { testexprparser {"fred"} -1 } {- {} 0 subexpr {"fred"} 1 text fred 0 {}} test parseExpr-16.19 {GetLexeme procedure, lexeme is ","} testexprparser { testexprparser {foo(1,2)} -1 } {- {} 0 subexpr foo(1,2) 5 operator foo 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-16.20 {GetLexeme procedure, lexeme is "*"} testexprparser { testexprparser {$a*$b} -1 } {- {} 0 subexpr {$a*$b} 7 operator * 0 subexpr {$a} 2 variable {$a} 1 text a 0 subexpr {$b} 2 variable {$b} 1 text b 0 {}} test parseExpr-16.21 {GetLexeme procedure, lexeme is "/"} testexprparser { testexprparser {5/6} -1 } {- {} 0 subexpr 5/6 5 operator / 0 subexpr 5 1 text 5 0 subexpr 6 1 text 6 0 {}} test parseExpr-16.22 {GetLexeme procedure, lexeme is "%"} testexprparser { testexprparser {5%[xxx]} -1 } {- {} 0 subexpr {5%[xxx]} 5 operator % 0 subexpr 5 1 text 5 0 subexpr {[xxx]} 1 command {[xxx]} 0 {}} test parseExpr-16.23 {GetLexeme procedure, lexeme is "+"} testexprparser { testexprparser {1+2} -1 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-16.24 {GetLexeme procedure, lexeme is "-"} testexprparser { testexprparser {.12-0e27} -1 } {- {} 0 subexpr .12-0e27 5 operator - 0 subexpr .12 1 text .12 0 subexpr 0e27 1 text 0e27 0 {}} test parseExpr-16.25 {GetLexeme procedure, lexeme is "?" or ":"} testexprparser { testexprparser {$b? 1 : 0} -1 } {- {} 0 subexpr {$b? 1 : 0} 8 operator ? 0 subexpr {$b} 2 variable {$b} 1 text b 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}} test parseExpr-16.26 {GetLexeme procedure, lexeme is "<"} testexprparser { testexprparser {2<3} -1 } {- {} 0 subexpr 2<3 5 operator < 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.27 {GetLexeme procedure, lexeme is "<<"} testexprparser { testexprparser {2<<3} -1 } {- {} 0 subexpr 2<<3 5 operator << 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.28 {GetLexeme procedure, lexeme is "<="} testexprparser { testexprparser {2<=3} -1 } {- {} 0 subexpr 2<=3 5 operator <= 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.29 {GetLexeme procedure, lexeme is ">"} testexprparser { testexprparser {2>3} -1 } {- {} 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.30 {GetLexeme procedure, lexeme is ">>"} testexprparser { testexprparser {2>>3} -1 } {- {} 0 subexpr 2>>3 5 operator >> 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.31 {GetLexeme procedure, lexeme is ">="} testexprparser { testexprparser {2>=3} -1 } {- {} 0 subexpr 2>=3 5 operator >= 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.32 {GetLexeme procedure, lexeme is "=="} testexprparser { testexprparser {2==3} -1 } {- {} 0 subexpr 2==3 5 operator == 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.33 {GetLexeme procedure, bad lexeme starting with "="} -constraints testexprparser -body { testexprparser {2=+3} -1 } -returnCodes error -match glob -result * test parseExpr-16.34 {GetLexeme procedure, lexeme is "!="} testexprparser { testexprparser {2!=3} -1 } {- {} 0 subexpr 2!=3 5 operator != 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.35 {GetLexeme procedure, lexeme is "!"} testexprparser { testexprparser {!2} -1 } {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}} test parseExpr-16.36 {GetLexeme procedure, lexeme is "&&"} testexprparser { testexprparser {2&&3} -1 } {- {} 0 subexpr 2&&3 5 operator && 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.37 {GetLexeme procedure, lexeme is "&"} testexprparser { testexprparser {1&2} -1 } {- {} 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-16.38 {GetLexeme procedure, lexeme is "^"} testexprparser { testexprparser {1^2} -1 } {- {} 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-16.39 {GetLexeme procedure, lexeme is "||"} testexprparser { testexprparser {2||3} -1 } {- {} 0 subexpr 2||3 5 operator || 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.40 {GetLexeme procedure, lexeme is "|"} testexprparser { testexprparser {1|2} -1 } {- {} 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-16.41 {GetLexeme procedure, lexeme is "~"} testexprparser { testexprparser {~2} -1 } {- {} 0 subexpr ~2 3 operator ~ 0 subexpr 2 1 text 2 0 {}} test parseExpr-16.42 {GetLexeme procedure, lexeme is func name} testexprparser { testexprparser {george()} -1 } {- {} 0 subexpr george() 1 operator george 0 {}} test parseExpr-16.43 {GetLexeme procedure, lexeme is func name} testexprparser { testexprparser {harmonic_ratio(2,3)} -1 } {- {} 0 subexpr harmonic_ratio(2,3) 5 operator harmonic_ratio 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}} test parseExpr-16.44 {GetLexeme procedure, unknown lexeme} -constraints testexprparser -body { testexprparser {@27} -1 } -returnCodes error -match glob -result * test parseExpr-17.1 {PrependSubExprTokens procedure, expand token array} testexprparser { testexprparser {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} -1 } {- {} 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 13 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 9 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 5 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 {}} test parseExpr-18.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -constraints testexprparser -body { testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 } -returnCodes error -match glob -result * test parseExpr-19.1 {TclParseInteger: [Bug 648441]} -body { # Should see this as integer "0" followed by incomplete function "x" # Thus, syntax error. # If Bug 648441 is not fixed, "0x" will be seen as floating point 0.0 expr 0x } -returnCodes error -match glob -result * test parseExpr-20.1 {Bug 1451233} { expr 1000000000000000000042 } 1000000000000000000042 test parseExpr-20.2 {Bug 1451233} { expr 10000000000000000000420000000042 } 10000000000000000000420000000042 test parseExpr-20.3 {Bug 1451233} { expr 10000000000000000000020000000002 } 10000000000000000000020000000002 test parseExpr-21.1 {error messages} -body { expr @ } -returnCodes error -result {invalid character "@" in expression "@"} test parseExpr-21.2 {error messages} -body { expr = } -returnCodes error -result {incomplete operator "=" in expression "="} test parseExpr-21.3 {error messages} -body { expr x } -returnCodes error -result {invalid bareword "x" in expression "x"; should be "$x" or "{x}" or "x(...)" or ...} test parseExpr-21.4 {error messages} -body { expr abcdefghijklmnopqrstuvwxyz } -returnCodes error -result {invalid bareword "abcdefghijklmnopqrstuv..." in expression "abcdefghijklmnopqrstuv..."; should be "$abcdefghijklmnopqrstuv..." or "{abcdefghijklmnopqrstuv...}" or "abcdefghijklmnopqrstuv...(...)" or ...} test parseExpr-21.5 {error messages} -body { expr {[][]} } -returnCodes error -result {missing operator at _@_ in expression "[]_@_[]"} test parseExpr-21.6 {error messages} -body { expr {0 0} } -returnCodes error -result {missing operator at _@_ in expression "0 _@_0"} test parseExpr-21.7 {error messages} -body { expr {0o8} } -returnCodes error -match glob -result {*invalid octal number*} test parseExpr-21.8 {error messages} -body { expr {0o8x} } -returnCodes error -match glob -result {*invalid octal number*} test parseExpr-21.9 {error messages} -body { expr {"} } -returnCodes error -result {missing " in expression """} test parseExpr-21.10 {error messages} -body { expr \{ } -returnCodes error -result "missing close-brace in expression \"\{\"" test parseExpr-21.11 {error messages} -body { expr $ } -returnCodes error -result {invalid character "$" in expression "$"} test parseExpr-21.12 {error messages} -body { expr {$(} } -returnCodes error -result {missing ) in expression "$("} test parseExpr-21.13 {error messages} -body { expr {[""x]} } -returnCodes error -result {extra characters after close-quote in expression "[""x]"} test parseExpr-21.14 {error messages} -body { expr {[} } -returnCodes error -result {missing close-bracket in expression "["} test parseExpr-21.15 {error messages} -body { expr 0~0 } -returnCodes error -result {missing operator at _@_ in expression "0_@_~0"} test parseExpr-21.16 {error messages} -body { expr () } -returnCodes error -result {empty subexpression at _@_ in expression "(_@_)"} test parseExpr-21.17 {error messages} -body { expr ( } -returnCodes error -result {unbalanced open paren in expression "("} test parseExpr-21.18 {error messages} -body { expr a(0,) } -returnCodes error -result {missing function argument at _@_ in expression "a(0,_@_)"} test parseExpr-21.19 {error messages} -body { expr {} } -returnCodes error -result {empty expression in expression ""} test parseExpr-21.20 {error messages} -body { expr ) } -returnCodes error -result {unbalanced close paren in expression ")"} test parseExpr-21.21 {error messages} -body { expr a(,0) } -returnCodes error -result {missing function argument at _@_ in expression "a(_@_,0)"} test parseExpr-21.22 {error messages} -body { expr 0&|0 } -returnCodes error -result {missing operand at _@_ in expression "0&_@_|0"} test parseExpr-21.23 {error messages} -body { expr 0^^0 } -returnCodes error -result {missing operand at _@_ in expression "0^_@_^0"} test parseExpr-21.24 {error messages} -body { expr 0|&0 } -returnCodes error -result {missing operand at _@_ in expression "0|_@_&0"} test parseExpr-21.25 {error messages} -body { expr a(1+,0) } -returnCodes error -result {missing operand at _@_ in expression "a(1+_@_,0)"} test parseExpr-21.26 {error messages} -body { expr (0 } -returnCodes error -result {unbalanced open paren in expression "(0"} test parseExpr-21.27 {error messages} -body { expr 0?0 } -returnCodes error -result {missing operator ":" at _@_ in expression "0?0_@_"} test parseExpr-21.28 {error messages} -body { expr 0:0 } -returnCodes error -result {unexpected operator ":" without preceding "?" in expression "0:0"} test parseExpr-21.29 {error messages} -body { expr 0) } -returnCodes error -result {unbalanced close paren in expression "0)"} test parseExpr-21.30 {error messages} -body { expr 0, } -returnCodes error -result {unexpected "," outside function argument list in expression "0,"} test parseExpr-21.31 {error messages} -body { expr 0,0 } -returnCodes error -result {unexpected "," outside function argument list in expression "0,0"} test parseExpr-21.32 {error messages} -body { expr (0,0) } -returnCodes error -result {unexpected "," outside function argument list in expression "(0,0)"} test parseExpr-21.33 {error messages} -body { expr a(0:0,0) } -returnCodes error -result {unexpected operator ":" without preceding "?" in expression "a(0:0,0)"} test parseExpr-21.34 {error messages} -body { expr {"abcdefghijklmnopqrstuvwxyz"@0} } -returnCodes error -result {invalid character "@" in expression "...fghijklmnopqrstuvwxyz"@0"} test parseExpr-21.35 {error messages} -body { expr {0@"abcdefghijklmnopqrstuvwxyz"} } -returnCodes error -result {invalid character "@" in expression "0@"abcdefghijklmnopqrstu..."} test parseExpr-21.36 {error messages} -body { expr {"abcdefghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstuvwxyz"} } -returnCodes error -result {invalid character "@" in expression "...fghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstu..."} test parseExpr-21.37 {error messages} -body { expr [format {"%s" @ 0} [string repeat \u00a7 25]] } -returnCodes error -result [format {invalid character "@" in expression "...%s" @ 0"} [string repeat \u00a7 10]] test parseExpr-21.38 {error messages} -body { expr [format {0 @ "%s"} [string repeat \u00a7 25]] } -returnCodes error -result [format {invalid character "@" in expression "0 @ "%s..."} [string repeat \u00a7 10]] test parseExpr-21.39 {error messages} -body { expr [format {"%s" @ "%s"} [string repeat \u00a7 25] [string repeat \u00a7 25]] } -returnCodes error -result [format {invalid character "@" in expression "...%s" @ "%s..."} [string repeat \u00a7 10] [string repeat \u00a7 10]] test parseExpr-21.40 {error messages} -body { catch {expr {"abcdefghijklmnopqrstuvwxyz"@0}} m o dict get $o -errorinfo } -result {invalid character "@" in expression "...fghijklmnopqrstuvwxyz"@0" (parsing expression ""abcdefghijklmnopqrstu...") invoked from within "expr {"abcdefghijklmnopqrstuvwxyz"@0}"} test parseExpr-21.41 {error messages} -body { catch {expr [format {"%s" @ 0} [string repeat \u00a7 25]]} m o dict get $o -errorinfo } -result [format {invalid character "@" in expression "...%s" @ 0" (parsing expression ""%s...") invoked from within "expr [format {"%%s" @ 0} [string repeat \u00a7 25]]"} [string repeat \u00a7 10] [string repeat \u00a7 10]] test parseExpr-21.42 {error message} -body { expr {123456789012345678901234567890*"abcdefghijklmnopqrstuvwxyz} } -returnCodes error -result {missing " in expression "...012345678901234567890*"abcdefghijklmnopqrstuv..."} test parseExpr-21.43 {error message} -body { expr "123456789012345678901234567890*\"foobar\$\{abcdefghijklmnopqrstuvwxyz\"" } -returnCodes error -result "missing close-brace for variable name in expression \"...8901234567890*\"foobar\$\{abcdefghijklmnopqrstuv...\"" test parseExpr-21.44 {error message} -body { expr {123456789012345678901234567890*"foo$bar(abcdefghijklmnopqrstuvwxyz"} } -returnCodes error -result {missing ) in expression "...8901234567890*"foo$bar(abcdefghijklmnopqrstuv..."} test parseExpr-21.45 {error message} -body { expr {123456789012345678901234567890*"foo$bar([{}abcdefghijklmnopqrstuvwxyz])"} } -returnCodes error -result {extra characters after close-brace in expression "...234567890*"foo$bar([{}abcdefghijklmnopqrstuv..."} test parseExpr-21.46 {error message} -body { expr {123456789012345678901234567890*"foo$bar([""abcdefghijklmnopqrstuvwxyz])"} } -returnCodes error -result {extra characters after close-quote in expression "...234567890*"foo$bar([""abcdefghijklmnopqrstuv..."} test parseExpr-21.47 {error message} -body { expr {123456789012345678901234567890*"foo$bar([abcdefghijklmnopqrstuvwxyz)"} } -returnCodes error -result {missing close-bracket in expression "...901234567890*"foo$bar([abcdefghijklmnopqrstuv..."} test parseExpr-21.48 {error message} -body { expr "123456789012345678901234567890*\"foo\$bar(\[\{abcdefghijklmnopqrstuvwxyz])\"" } -returnCodes error -result "missing close-brace in expression \"...01234567890*\"foo\$bar(\[\{abcdefghijklmnopqrstuv...\"" test parseExpr-21.49 {error message} -body { expr "123456789012345678901234567890*\{abcdefghijklmnopqrstuvwxyz" } -returnCodes error -result "missing close-brace in expression \"...012345678901234567890*\{abcdefghijklmnopqrstuv...\"" test parseExpr-21.50 {error message} -body { expr {123456789012345678901234567890*$foo(["abcdefghijklmnopqrstuvwxyz])} } -returnCodes error -result {missing " in expression "...678901234567890*$foo(["abcdefghijklmnopqrstuv..."} test parseExpr-21.51 {error message} -body { expr "123456789012345678901234567890*\$\{abcdefghijklmnopqrstuvwxyz" } -returnCodes error -result "missing close-brace for variable name in expression \"...12345678901234567890*\$\{abcdefghijklmnopqrstuv...\"" test parseExpr-21.52 {error message} -body { expr {123456789012345678901234567890*$bar(abcdefghijklmnopqrstuvwxyz} } -returnCodes error -result {missing ) in expression "...45678901234567890*$bar(abcdefghijklmnopqrstuv..."} test parseExpr-21.53 {error message} -body { expr {123456789012345678901234567890*$bar([{}abcdefghijklmnopqrstuvwxyz])"} } -returnCodes error -result {extra characters after close-brace in expression "...8901234567890*$bar([{}abcdefghijklmnopqrstuv..."} test parseExpr-21.54 {error message} -body { expr {123456789012345678901234567890*$bar([""abcdefghijklmnopqrstuvwxyz])"} } -returnCodes error -result {extra characters after close-quote in expression "...8901234567890*$bar([""abcdefghijklmnopqrstuv..."} test parseExpr-21.55 {error message} -body { expr {123456789012345678901234567890*$bar([abcdefghijklmnopqrstuvwxyz)"} } -returnCodes error -result {missing close-bracket in expression "...5678901234567890*$bar([abcdefghijklmnopqrstuv..."} test parseExpr-21.56 {error message} -body { expr "123456789012345678901234567890*\$bar(\[\{abcdefghijklmnopqrstuvwxyz])" } -returnCodes error -result "missing close-brace in expression \"...678901234567890*\$bar(\[\{abcdefghijklmnopqrstuv...\"" test parseExpr-21.57 {error message} -body { expr {123456789012345678901234567890*["abcdefghijklmnopqrstuvwxyz]} } -returnCodes error -result {missing " in expression "...12345678901234567890*["abcdefghijklmnopqrstuv..."} test parseExpr-21.58 {error message} -body { expr "123456789012345678901234567890*\[\$\{abcdefghijklmnopqrstuvwxyz]" } -returnCodes error -result "missing close-brace for variable name in expression \"...2345678901234567890*\[\$\{abcdefghijklmnopqrstuv...\"" test parseExpr-21.59 {error message} -body { expr {123456789012345678901234567890*[$bar(abcdefghijklmnopqrstuvwxyz]} } -returnCodes error -result {missing ) in expression "...5678901234567890*[$bar(abcdefghijklmnopqrstuv..."} test parseExpr-21.60 {error message} -body { expr {123456789012345678901234567890*[{}abcdefghijklmnopqrstuvwxyz]"} } -returnCodes error -result {extra characters after close-brace in expression "...345678901234567890*[{}abcdefghijklmnopqrstuv..."} test parseExpr-21.61 {error message} -body { expr {123456789012345678901234567890*[""abcdefghijklmnopqrstuvwxyz]"} } -returnCodes error -result {extra characters after close-quote in expression "...345678901234567890*[""abcdefghijklmnopqrstuv..."} test parseExpr-21.62 {error message} -body { expr {123456789012345678901234567890*[abcdefghijklmnopqrstuvwxyz"} } -returnCodes error -result {missing close-bracket in expression "...012345678901234567890*[abcdefghijklmnopqrstuv..."} test parseExpr-21.63 {error message} -body { expr "123456789012345678901234567890*\[\{abcdefghijklmnopqrstuvwxyz]" } -returnCodes error -result "missing close-brace in expression \"...12345678901234567890*\[\{abcdefghijklmnopqrstuv...\"" test parseExpr-22.1 {Bug 3401704} -constraints testexprparser -body { testexprparser 2a() 1 } -result {- {} 0 subexpr 2 1 text 2 0 {}} test parseExpr-22.2 {Bug 3401704} -constraints testexprparser -body { testexprparser nana() 3 } -result {- {} 0 subexpr nan 1 text nan 0 {}} test parseExpr-22.3 {Bug 3401704} -constraints testexprparser -body { testexprparser 2a() -1 } -result {- {} 0 subexpr 2a() 1 operator 2a 0 {}} test parseExpr-22.4 {Bug 3401704} -constraints testexprparser -body { testexprparser nana() -1 } -result {- {} 0 subexpr nana() 1 operator nana 0 {}} test parseExpr-22.5 {Bug 3401704} -constraints testexprparser -body { testexprparser nan9() -1 } -result {- {} 0 subexpr nan9() 1 operator nan9 0 {}} test parseExpr-22.6 {Bug 3401704} -constraints testexprparser -body { testexprparser 2_() -1 } -result {- {} 0 subexpr 2_() 1 operator 2_ 0 {}} test parseExpr-22.7 {Bug 3401704} -constraints testexprparser -body { testexprparser nan_() -1 } -result {- {} 0 subexpr nan_() 1 operator nan_ 0 {}} test parseExpr-22.8 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser nan!() -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR MISSING} test parseExpr-22.9 {Bug 3401704} -constraints testexprparser -body { testexprparser 1e3_() -1 } -result {- {} 0 subexpr 1e3_() 1 operator 1e3_ 0 {}} test parseExpr-22.10 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 1.3_() -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR BADCHAR} test parseExpr-22.11 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 1e-3_() -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR BADCHAR} test parseExpr-22.12 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser naneq() -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR EMPTY} test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body { testexprparser naner() -1 } -result {- {} 0 subexpr naner() 1 operator naner 0 {}} test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 08 -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR BADNUMBER OCTAL} test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 0o8 -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR BADNUMBER OCTAL} test parseExpr-22.16 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 0o08 -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR BADNUMBER OCTAL} test parseExpr-22.17 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 0b2 -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR BADNUMBER BINARY} test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 0b02 -1} m o dict get $o -errorcode } -result {TCL PARSE EXPR BADNUMBER BINARY} test parseExpr-22.19 {Bug d2ffcca163} -constraints testexprparser -body { testexprparser \u0433 -1 } -returnCodes error -match glob -result {*invalid character*} test parseExpr-22.20 {Bug d2ffcca163} -constraints testexprparser -body { testexprparser \u043f -1 } -returnCodes error -match glob -result {*invalid character*} test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body { testexprparser in\u0433(0) -1 } -returnCodes error -match glob -result {missing operand*} # cleanup cleanupTests return tcl8.6.14/tests/parseOld.test0000644000175000017500000003445014554262142015464 0ustar sergeisergei# Commands covered: set (plus basic command syntax). Also tests the # procedures in the file tclOldParse.c. This set of tests is an old # one that predates the new parser in Tcl 8.1. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testwordend [llength [info commands testwordend]] testConstraint testbytestring [llength [info commands testbytestring]] # Save the argv value for restoration later set savedArgv $argv proc fourArgs {a b c d} { global arg1 arg2 arg3 arg4 set arg1 $a set arg2 $b set arg3 $c set arg4 $d } proc getArgs args { global argv set argv $args } # Basic argument parsing. test parseOld-1.1 {basic argument parsing} { set arg1 {} fourArgs a b c d list $arg1 $arg2 $arg3 $arg4 } {a b c d} test parseOld-1.2 {basic argument parsing} { set arg1 {} eval "fourArgs 123\v4\f56\r7890" list $arg1 $arg2 $arg3 $arg4 } {123 4 56 7890} # Quotes. test parseOld-2.1 {quotes and variable-substitution} { getArgs "a b c" d set argv } {{a b c} d} test parseOld-2.2 {quotes and variable-substitution} { set a 101 getArgs "a$a b c" set argv } {{a101 b c}} test parseOld-2.3 {quotes and variable-substitution} { set argv "xy[format xabc]" set argv } {xyxabc} test parseOld-2.4 {quotes and variable-substitution} { set argv "xy\t" set argv } xy\t test parseOld-2.5 {quotes and variable-substitution} { set argv "a b c d e f" set argv } a\ b\tc\nd\ e\ f test parseOld-2.6 {quotes and variable-substitution} { set argv a"bcd"e set argv } {a"bcd"e} # Braces. test parseOld-3.1 {braces} { getArgs {a b c} d set argv } "{a b c} d" test parseOld-3.2 {braces} { set a 101 set argv {a$a b c} set b [string index $argv 1] set b } {$} test parseOld-3.3 {braces} { set argv {a[format xyz] b} string length $argv } 15 test parseOld-3.4 {braces} { set argv {a\nb\}} string length $argv } 6 test parseOld-3.5 {braces} { set argv {{{{}}}} set argv } "{{{}}}" test parseOld-3.6 {braces} { set argv a{{}}b set argv } "a{{}}b" test parseOld-3.7 {braces} { set a [format "last]"] set a } {last]} # Command substitution. test parseOld-4.1 {command substitution} { set a [format xyz] set a } xyz test parseOld-4.2 {command substitution} { set a a[format xyz]b[format q] set a } axyzbq test parseOld-4.3 {command substitution} { set a a[ set b 22; format %s $b ]b set a } a22b test parseOld-4.4 {command substitution} { set a 7.7 if {[catch {expr {int($a)}}]} {set a foo} set a } 7.7 # Variable substitution. test parseOld-5.1 {variable substitution} { set a 123 set b $a set b } 123 test parseOld-5.2 {variable substitution} { set a 345 set b x$a.b set b } x345.b test parseOld-5.3 {variable substitution} { set _123z xx set b $_123z^ set b } xx^ test parseOld-5.4 {variable substitution} { set a 78 set b a${a}b set b } a78b test parseOld-5.5 {variable substitution} {catch {$_non_existent_} msg} 1 test parseOld-5.6 {variable substitution} { catch {$_non_existent_} msg set msg } {can't read "_non_existent_": no such variable} test parseOld-5.7 {array variable substitution} { unset -nocomplain a set a(xyz) 123 set b $a(xyz)foo set b } 123foo test parseOld-5.8 {array variable substitution} { unset -nocomplain a set "a(x y z)" 123 set b $a(x y z)foo set b } 123foo test parseOld-5.9 {array variable substitution} { unset -nocomplain a qqq set "a(x y z)" qqq set $a([format x]\ y [format z]) foo set qqq } foo test parseOld-5.10 {array variable substitution} { unset -nocomplain a list [catch {set b $a(22)} msg] $msg } {1 {can't read "a(22)": no such variable}} test parseOld-5.11 {array variable substitution} { set b a$! set b } {a$!} test parseOld-5.12 {empty array name support} { list [catch {set b a$()} msg] $msg } {1 {can't read "()": no such variable}} unset -nocomplain a test parseOld-5.13 {array variable substitution} { unset -nocomplain a set long {This is a very long variable, long enough to cause storage \ allocation to occur in Tcl_ParseVar. If that storage isn't getting \ freed up correctly, then a core leak will occur when this test is \ run. This text is probably beginning to sound like drivel, but I've \ run out of things to say and I need more characters still.} set a($long) 777 set b $a($long) list $b [array names a] } {777 {{This is a very long variable, long enough to cause storage \ allocation to occur in Tcl_ParseVar. If that storage isn't getting \ freed up correctly, then a core leak will occur when this test is \ run. This text is probably beginning to sound like drivel, but I've \ run out of things to say and I need more characters still.}}} test parseOld-5.14 {array variable substitution} { unset -nocomplain a b a1 set a1(22) foo set a(foo) bar set b $a($a1(22)) set b } bar unset -nocomplain a a1 test parseOld-7.1 {backslash substitution} { set a "\a\c\n\]\}" string length $a } 5 test parseOld-7.2 {backslash substitution} { set a {\a\c\n\]\}} string length $a } 10 test parseOld-7.3 {backslash substitution} { set a "abc\ def" set a } {abc def} test parseOld-7.4 {backslash substitution} { set a {abc\ def} set a } {abc def} test parseOld-7.5 {backslash substitution} { set msg {} set a xxx set error [catch {if {24 < \ 35} {set a 22} {set \ a 33}} msg] list $error $msg $a } {0 22 22} test parseOld-7.6 {backslash substitution} { eval "concat abc\\" } "abc\\" test parseOld-7.7 {backslash substitution} { eval "concat \\\na" } "a" test parseOld-7.8 {backslash substitution} { eval "concat x\\\n a" } "x a" test parseOld-7.9 {backslash substitution} { eval "concat \\x" } "x" test parseOld-7.10 {backslash substitution} { eval "list a b\\\nc d" } {a b c d} test parseOld-7.11 {backslash substitution} { eval "list a \"b c\"\\\nd e" } {a {b c} d e} test parseOld-7.12 {backslash substitution} testbytestring { expr {[list \ua2] eq [testbytestring "\xc2\xa2"]} } 1 test parseOld-7.13 {backslash substitution} testbytestring { expr {[list \u4e21] eq [testbytestring "\xe4\xb8\xa1"]} } 1 test parseOld-7.14 {backslash substitution} testbytestring { expr {[list \u4e2k] eq [testbytestring "\xd3\xa2k"]} } 1 # Semi-colon. test parseOld-8.1 {semi-colons} { set b 0 getArgs a;set b 2 set argv } a test parseOld-8.2 {semi-colons} { set b 0 getArgs a;set b 2 set b } 2 test parseOld-8.3 {semi-colons} { getArgs a b ; set b 1 set argv } {a b} test parseOld-8.4 {semi-colons} { getArgs a b ; set b 1 set b } 1 # The following checks are to ensure that the interpreter's result # gets re-initialized by Tcl_Eval in all the right places. set a 22 test parseOld-9.1 {result initialization} {concat abc} abc test parseOld-9.2 {result initialization} {concat abc; proc foo {} {}} {} test parseOld-9.3 {result initialization} {concat abc; proc foo {} $a} {} test parseOld-9.4 {result initialization} {proc foo {} [concat abc]} {} test parseOld-9.5 {result initialization} {concat abc; } abc test parseOld-9.6 {result initialization} { eval { concat abc }} abc test parseOld-9.7 {result initialization} {} {} test parseOld-9.8 {result initialization} {concat abc; ; ;} abc # Syntax errors. test parseOld-10.1 {syntax errors} {catch "set a \{bcd" msg} 1 test parseOld-10.2 {syntax errors} { catch "set a \{bcd" msg set msg } {missing close-brace} test parseOld-10.3 {syntax errors} {catch {set a "bcd} msg} 1 test parseOld-10.4 {syntax errors} { catch {set a "bcd} msg set msg } {missing "} #" Emacs formatting >:^( test parseOld-10.5 {syntax errors} {catch {set a "bcd"xy} msg} 1 test parseOld-10.6 {syntax errors} { catch {set a "bcd"xy} msg set msg } {extra characters after close-quote} test parseOld-10.7 {syntax errors} {catch "set a {bcd}xy" msg} 1 test parseOld-10.8 {syntax errors} { catch "set a {bcd}xy" msg set msg } {extra characters after close-brace} test parseOld-10.9 {syntax errors} {catch {set a [format abc} msg} 1 test parseOld-10.10 {syntax errors} { catch {set a [format abc} msg set msg } {missing close-bracket} test parseOld-10.11 {syntax errors} {catch gorp-a-lot msg} 1 test parseOld-10.12 {syntax errors} { catch gorp-a-lot msg set msg } {invalid command name "gorp-a-lot"} test parseOld-10.13 {syntax errors} { set a [concat {a}\ {b}] set a } {a b} # The next test will fail on the Mac, 'cause the MSL uses a fixed sized # buffer for %d conversions (LAME!). I won't leave the test out, however, # since MetroWerks may some day fix this. test parseOld-10.14 {syntax errors} { list [catch {eval \$x[format "%01000d" 0](} msg] $msg $::errorInfo } {1 {missing )} {missing ) while executing "$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000..." ("eval" body line 1) invoked from within "eval \$x[format "%01000d" 0]("}} test parseOld-10.15 {syntax errors, missplaced braces} { catch { proc misplaced_end_brace {} { set what foo set when [expr ${what}size - [set off$what]}] } msg set msg } {extra characters after close-brace} test parseOld-10.16 {syntax errors, missplaced braces} { catch { set a { set what foo set when [expr ${what}size - [set off$what]}] } msg set msg } {extra characters after close-brace} test parseOld-10.17 {syntax errors, unusual spacing} { list [catch {return [ [1]]} msg] $msg } {1 {invalid command name "1"}} # Long values (stressing storage management) set a {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH} test parseOld-11.1 {long values} { string length $a } 214 test parseOld-11.2 {long values} { llength $a } 43 test parseOld-11.3 {long values} { set b "1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH" set b } $a test parseOld-11.4 {long values} { set b "$a" set b } $a test parseOld-11.5 {long values} { set b [set a] set b } $a test parseOld-11.6 {long values} { set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH] string length $b } 214 test parseOld-11.7 {long values} { set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH] llength $b } 43 # Duplicate action of previous test llength [set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]] test parseOld-11.8 {long values} { set b } $a test parseOld-11.9 {long values} { set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] llength $a } 62 set i 0 foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] { set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i] set test $test$test$test$test test parseOld-11.10-[incr i] {long values} { set j } $test } test parseOld-11.11 {test buffer overflow in backslashes in braces} { expr {"a" == {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101}} } 0 test parseOld-12.1 {comments} { set a old eval { # set a new} set a } {old} test parseOld-12.2 {comments} { set a old eval " # set a new\nset a new" set a } {new} test parseOld-12.3 {comments} { set a old eval " # set a new\\\nset a new" set a } {old} test parseOld-12.4 {comments} { set a old eval " # set a new\\\\\nset a new" set a } {new} test parseOld-13.1 {comments at the end of a bracketed script} { set x "[ expr {1+1} # skip this! ]" } {2} test parseOld-15.1 {TclScriptEnd procedure} { info complete {puts [ expr {1+1} #this is a comment ]} } {0} test parseOld-15.2 {TclScriptEnd procedure} { info complete "abc\\\n" } {0} test parseOld-15.3 {TclScriptEnd procedure} { info complete "abc\\\\\n" } {1} test parseOld-15.4 {TclScriptEnd procedure} { info complete "xyz \[abc \{abc\]" } {0} test parseOld-15.5 {TclScriptEnd procedure} { info complete "xyz \[abc" } {0} # cleanup set argv $savedArgv ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/parse.test0000644000175000017500000013746314554262142015035 0ustar sergeisergei# This file contains a collection of tests for the procedures in the # file tclParse.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." return } namespace eval ::tcl::test::parse { namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testparser [llength [info commands testparser]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testevalobjv [llength [info commands testevalobjv]] testConstraint testevalex [llength [info commands testevalex]] testConstraint testparsevarname [llength [info commands testparsevarname]] testConstraint testparsevar [llength [info commands testparsevar]] testConstraint testasync [llength [info commands testasync]] testConstraint testcmdtrace [llength [info commands testcmdtrace]] testConstraint testevent [llength [info commands testevent]] testConstraint memory [llength [info commands memory]] test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {testparser testbytestring} { testparser [testbytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} test parse-1.3 {Tcl_ParseCommand procedure, leading space} testparser { testparser " \n\t foo" 0 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.4 {Tcl_ParseCommand procedure, leading space} testparser { testparser "\f\r\vfoo" 0 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.5 {Tcl_ParseCommand procedure, backslash-newline in leading space} testparser { testparser " \\\n foo" 0 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.6 {Tcl_ParseCommand procedure, backslash-newline in leading space} testparser { testparser { \a foo} 0 } {- {\a foo} 2 word {\a} 1 backslash {\a} 0 simple foo 1 text foo 0 {}} test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading space} testparser { testparser " \\\n" 0 } {- {} 0 {}} test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} testparser { testparser " foo" 3 } {- {} 0 { foo}} test parse-1.9 {Tcl_ParseCommand procedure, backslash newline + newline} testparser { testparser "cmd1\\\n\ncmd2" 0 } {- cmd1\\\n\n 1 simple cmd1 1 text cmd1 0 cmd2} test parse-1.10 {Tcl_ParseCommand procedure, backslash newline + newline} testparser { testparser "list \\\nA B\\\n\nlist C D" 0 } {- list\ \\\nA\ B\\\n\n 3 simple list 1 text list 0 simple A 1 text A 0 simple B 1 text B 0 {list C D}} test parse-2.1 {Tcl_ParseCommand procedure, comments} testparser { testparser "# foo bar\n foo" 0 } {{# foo bar } foo 1 simple foo 1 text foo 0 {}} test parse-2.2 {Tcl_ParseCommand procedure, several comments} testparser { testparser " # foo bar\n # another comment\n\n foo" 0 } {{# foo bar # another comment } foo 1 simple foo 1 text foo 0 {}} test parse-2.3 {Tcl_ParseCommand procedure, backslash-newline in comments} testparser { testparser " # foo bar\\\ncomment on continuation line\nfoo" 0 } {\#\ foo\ bar\\\ncomment\ on\ continuation\ line\n foo 1 simple foo 1 text foo 0 {}} test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} testparser { testparser "# \\\n" 0 } {\#\ \ \ \\\n {} 0 {}} test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} testparser { testparser " # foo bar\nfoo" 8 } {{# foo b} {} 0 {ar foo}} test parse-3.1 {Tcl_ParseCommand procedure, parsing words, skipping space} testparser { testparser "foo bar\t\tx" 0 } {- {foo bar x} 3 simple foo 1 text foo 0 simple bar 1 text bar 0 simple x 1 text x 0 {}} test parse-3.2 {Tcl_ParseCommand procedure, missing continuation line in leading space} testparser { testparser "abc \\\n" 0 } {- abc\ \ \\\n 1 simple abc 1 text abc 0 {}} test parse-3.3 {Tcl_ParseCommand procedure, parsing words, command ends in space} testparser { testparser "foo ; bar x" 0 } {- {foo ;} 1 simple foo 1 text foo 0 { bar x}} test parse-3.4 {Tcl_ParseCommand procedure, parsing words, command ends in space} testparser { testparser "foo " 5 } {- {foo } 1 simple foo 1 text foo 0 { }} test parse-3.5 {Tcl_ParseCommand procedure, quoted words} testparser { testparser {foo "a b c" d "efg";} 0 } {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}} test parse-3.6 {Tcl_ParseCommand procedure, words in braces} testparser { testparser {foo {a $b [concat foo]} {c d}} 0 } {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}} test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} testparser { list [catch {testparser "foo \$\{abc" 0} msg] $msg $::errorInfo } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\$\\\{abc\"\ 0\"} test parse-4.1 {Tcl_ParseCommand procedure, simple words} testparser { testparser {foo} 0 } {- foo 1 simple foo 1 text foo 0 {}} test parse-4.2 {Tcl_ParseCommand procedure, simple words} testparser { testparser {{abc}} 0 } {- {{abc}} 1 simple {{abc}} 1 text abc 0 {}} test parse-4.3 {Tcl_ParseCommand procedure, simple words} testparser { testparser {"c d"} 0 } {- {"c d"} 1 simple {"c d"} 1 text {c d} 0 {}} test parse-4.4 {Tcl_ParseCommand procedure, simple words} testparser { testparser {x$d} 0 } {- {x$d} 1 word {x$d} 3 text x 0 variable {$d} 1 text d 0 {}} test parse-4.5 {Tcl_ParseCommand procedure, simple words} testparser { testparser {"a [foo] b"} 0 } {- {"a [foo] b"} 1 word {"a [foo] b"} 3 text {a } 0 command {[foo]} 0 text { b} 0 {}} test parse-4.6 {Tcl_ParseCommand procedure, simple words} testparser { testparser {$x} 0 } {- {$x} 1 word {$x} 2 variable {$x} 1 text x 0 {}} test parse-5.1 {Tcl_ParseCommand procedure, backslash-newline terminates word} testparser { testparser "{abc}\\\n" 0 } {- \{abc\}\\\n 1 simple {{abc}} 1 text abc 0 {}} test parse-5.2 {Tcl_ParseCommand procedure, backslash-newline terminates word} testparser { testparser "foo\\\nbar" 0 } {- foo\\\nbar 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} test parse-5.3 {Tcl_ParseCommand procedure, word terminator is command terminator} testparser { testparser "foo\n bar" 0 } {- {foo } 1 simple foo 1 text foo 0 { bar}} test parse-5.4 {Tcl_ParseCommand procedure, word terminator is command terminator} testparser { testparser "foo; bar" 0 } {- {foo;} 1 simple foo 1 text foo 0 { bar}} test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} testparser { testparser "\"foo\" bar" 5 } {- {"foo"} 1 simple {"foo"} 1 text foo 0 { bar}} test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} testparser { list [catch {testparser {foo "bar"x} 0} msg] $msg $::errorInfo } {1 {extra characters after close-quote} {extra characters after close-quote (remainder of script: "x") invoked from within "testparser {foo "bar"x} 0"}} test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote} testparser { testparser "foo \"bar\"\\\nx" 0 } {- foo\ \"bar\"\\\nx 3 simple foo 1 text foo 0 simple {"bar"} 1 text bar 0 simple x 1 text x 0 {}} test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} testparser { list [catch {testparser {foo {bar}x} 0} msg] $msg $::errorInfo } {1 {extra characters after close-brace} {extra characters after close-brace (remainder of script: "x") invoked from within "testparser {foo {bar}x} 0"}} test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} testparser { testparser "foo {bar}\\\nx" 0 } {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}} test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} testparser { # This test is designed to catch bug 1681. list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $::errorInfo } "1 {missing \"} {missing \" (remainder of script: \"\"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8\") invoked from within \"testparser \"a \\\"\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\\\\9\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\" 0\"}" test parse-5.11 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{expan}} 0 } {- {{expan}} 1 simple {{expan}} 1 text expan 0 {}} test parse-5.12 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{expan}x} 0 } -returnCodes error -result {extra characters after close-brace} test parse-5.13 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{**}} 0 } {- {{**}} 1 simple {{**}} 1 text ** 0 {}} test parse-5.14 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{**}x} 0 } -returnCodes error -result {extra characters after close-brace} test parse-5.15 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{*}{123456}x} 0 } -returnCodes error -result {extra characters after close-brace} test parse-5.16 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{123456\ }} 0 } {- {{123456 }} 1 simple {{123456 }} 1 text {123456 } 0 {}} test parse-5.17 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{123456\ }x} 0 } -returnCodes error -result {extra characters after close-brace} test parse-5.18 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{*\ }} 0 } {- {{* }} 1 simple {{* }} 1 text {* } 0 {}} test parse-5.19 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{*\ }x} 0 } -returnCodes error -result {extra characters after close-brace} test parse-5.20 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{123456}} 0 } {- {{123456}} 1 simple {{123456}} 1 text 123456 0 {}} test parse-5.21 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{123456}x} 0 } -returnCodes error -result {extra characters after close-brace} test parse-5.22 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{*}} 0 } {- {{*}} 1 simple {{*}} 1 text * 0 {}} test parse-5.23 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{*} } 0 } {- {{*} } 1 simple {{*}} 1 text * 0 {}} test parse-5.24 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{*}x} 0 } {- {{*}x} 1 simple x 1 text x 0 {}} test parse-5.25 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{*} } 0 } {- {{*} } 1 simple {{*}} 1 text * 0 {}} test parse-5.26 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{*};} 0 } {- {{*};} 1 simple {{*}} 1 text * 0 {}} test parse-5.27 {Tcl_ParseCommand: {*} parsing} testparser { testparser "{*}\\\n foo bar" 0 } {- \{*\}\\\n\ foo\ bar 3 simple {{*}} 1 text * 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} test parse-5.28 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser { testparser {{*}{a b}} 0 } {- {{*}{a b}} 2 simple a 1 text a 0 simple b 1 text b 0 {}} test parse-5.29 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser { testparser {{*}{a \n b}} 0 } {- {{*}{a \n b}} 1 expand {{*}{a \n b}} 1 text {a \n b} 0 {}} test parse-5.30 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser { testparser {{*}"a b"} 0 } {- {{*}"a b"} 2 simple a 1 text a 0 simple b 1 text b 0 {}} test parse-5.31 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser { testparser {{*}"a \n b"} 0 } {- {{*}"a \n b"} 1 expand {{*}"a \n b"} 3 text {a } 0 backslash {\n} 0 text { b} 0 {}} test parse-6.1 {ParseTokens procedure, empty word} testparser { testparser {""} 0 } {- {""} 1 simple {""} 1 text {} 0 {}} test parse-6.2 {ParseTokens procedure, simple range} testparser { testparser {"abc$x.e"} 0 } {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}} test parse-6.3 {ParseTokens procedure, variable reference} testparser { testparser {abc$x.e $y(z)} 0 } {- {abc$x.e $y(z)} 2 word {abc$x.e} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 word {$y(z)} 3 variable {$y(z)} 2 text y 0 text z 0 {}} test parse-6.4 {ParseTokens procedure, variable reference} testparser { list [catch {testparser {$x([a )} 0} msg] $msg } {1 {missing close-bracket}} test parse-6.5 {ParseTokens procedure, command substitution} testparser { testparser {[foo $x bar]z} 0 } {- {[foo $x bar]z} 1 word {[foo $x bar]z} 2 command {[foo $x bar]} 0 text z 0 {}} test parse-6.6 {ParseTokens procedure, command substitution} testparser { testparser {[foo \] [a b]]} 0 } {- {[foo \] [a b]]} 1 word {[foo \] [a b]]} 1 command {[foo \] [a b]]} 0 {}} test parse-6.7 {ParseTokens procedure, error in command substitution} testparser { list [catch {testparser {a [b {}c d] e} 0} msg] $msg $::errorInfo } {1 {extra characters after close-brace} {extra characters after close-brace (remainder of script: "c d] e") invoked from within "testparser {a [b {}c d] e} 0"}} test parse-6.8 {ParseTokens procedure, error in command substitution} { info complete {a [b {}c d]} } {1} test parse-6.9 {ParseTokens procedure, error in command substitution} { info complete {a [b "c d} } {0} test parse-6.10 {ParseTokens procedure, incomplete sub-command} { info complete {puts [ expr {1+1} #this is a comment ]} } {0} test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} testparser { testparser {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 } {- {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 word {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 command {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 {}} test parse-6.12 {ParseTokens procedure, missing close bracket} testparser { list [catch {testparser {[foo $x bar} 0} msg] $msg $::errorInfo } {1 {missing close-bracket} {missing close-bracket (remainder of script: "[foo $x bar") invoked from within "testparser {[foo $x bar} 0"}} test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} testparser { list [catch {testparser "\"a b\\\n" 0} msg] $msg $::errorInfo } {1 {missing "} missing\ \"\n\ \ \ \ (remainder\ of\ script:\ \"\"a\ b\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\"a\ b\\\\\\n\"\ 0\"} test parse-6.14 {ParseTokens procedure, backslash-newline} testparser { testparser "b\\\nc" 0 } {- b\\\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}} test parse-6.15 {ParseTokens procedure, backslash-newline} testparser { testparser "\"b\\\nc\"" 0 } {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}} test parse-6.16 {ParseTokens procedure, backslash substitution} testparser { testparser {\n\a\x7f} 0 } {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}} test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} { expr {[testparser [testbytestring "foo\0zz"] 0] eq "- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}" } } 1 test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser { # Test for Bug 681841 list [catch {testparser {[a]} 2} msg] $msg } {1 {missing close-bracket}} test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} testparser { testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0 } {- {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 16 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 {}} test parse-8.1 {Tcl_EvalObjv procedure} testevalobjv { testevalobjv 0 concat this is a test } {this is a test} test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { rename ::unknown unknown.old set x [catch {testevalobjv 10 asdf poiu} msg] rename unknown.old ::unknown list $x $msg } {1 {invalid command name "asdf"}} test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { rename ::unknown unknown.old proc ::unknown args { return "unknown $args" } set x [catch {testevalobjv 0 asdf poiu} msg] rename ::unknown {} rename unknown.old ::unknown list $x $msg } {0 {unknown asdf poiu}} test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { rename ::unknown unknown.old proc ::unknown args { error "I don't like that command" } set x [catch {testevalobjv 0 asdf poiu} msg] rename ::unknown {} rename unknown.old ::unknown list $x $msg } {1 {I don't like that command}} test parse-8.5 {Tcl_EvalObjv procedure, command traces} {testevalobjv testcmdtrace} { testevalobjv 0 set x 123 testcmdtrace tracetest {testevalobjv 0 set x $x} } {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}} test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} -constraints { testevalobjv } -setup { proc x {} { set y 23 set z [testevalobjv 1 set y] return [list $z $y] } set ::y 16 } -cleanup { unset ::y } -body { x } -result {16 23} test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints { testevalobjv testasync } -setup { variable ::aresult variable ::acode proc async1 {result code} { variable ::aresult variable ::acode set aresult $result set acode $code return "new result" } set handler1 [testasync create async1] set aresult xxx set acode yyy } -cleanup { testasync delete } -body { list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult } -result {{new result} 0 original} test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv { list [catch {testevalobjv 0 error message} msg] $msg } {1 message} test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv { rename ::unknown unknown.save proc ::unknown args {lappend ::info [info level]} catch {rename ::noSuchCommand {}} set ::info {} namespace eval test_ns_1 { testevalobjv 1 noSuchCommand uplevel #0 noSuchCommand } namespace delete test_ns_1 rename ::unknown {} rename unknown.save ::unknown set ::info } {1 1} test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv { rename ::unknown unknown.save proc ::unknown args {lappend ::info [info level]; uplevel 1 foo} proc ::foo args {lappend ::info global} catch {rename ::noSuchCommand {}} set ::child [interp create] $::child alias bar noSuchCommand set ::info {} namespace eval test_ns_1 { proc foo args {lappend ::info namespace} $::child eval bar testevalobjv 1 [list $::child eval bar] uplevel #0 [list $::child eval bar] } namespace delete test_ns_1 rename ::foo {} rename ::unknown {} rename unknown.save ::unknown set ::info } [subst {[set level 2; incr level [info level]] global 1 global 1 global}] test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} { set ::auto_index(noSuchCommand) { proc noSuchCommand {} {lappend ::info global} } set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list \ proc [namespace current]::test_ns_1::noSuchCommand {} { lappend ::info ns }] catch {rename ::noSuchCommand {}} set ::child [interp create] $::child alias bar noSuchCommand set ::info {} namespace eval test_ns_1 { $::child eval bar } namespace delete test_ns_1 interp delete $::child catch {rename ::noSuchCommand {}} set ::info } global test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { unset -nocomplain x list [catch {testevalex {for {} 1 {} { # asdf set x }}}] $::errorInfo } {1 {can't read "x": no such variable while executing "set x" ("for" body line 5) invoked from within "for {} 1 {} { # asdf set x }" invoked from within "testevalex {for {} 1 {} { # asdf set x }}"}} test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} { list [catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}] $::errorInfo } {1 {wrong # args: should be "set varName ?newValue?" while executing "set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}} test parse-10.1 {Tcl_EvalTokens, simple text} testevalex { testevalex {concat test} } {test} test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex { testevalex {concat test\063\062test} } {test32test} test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { testevalex {concat [expr {2 + 6}]} } {8} test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { unset -nocomplain a list [catch {testevalex {concat xxx[expr {$a}]}} msg] $msg } {1 {can't read "a": no such variable}} test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex { set a hello testevalex {concat $a} } {hello} test parse-10.6 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a set a(12) 46 testevalex {concat $a(12)} } {46} test parse-10.7 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a set a(12) 46 testevalex {concat $a(1[expr {3 - 1}])} } {46} test parse-10.8 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a list [catch {testevalex {concat $x($a)}} msg] $msg } {1 {can't read "a": no such variable}} test parse-10.9 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a list [catch {testevalex {concat xyz$a(1)}} msg] $msg } {1 {can't read "a(1)": no such variable}} test parse-10.10 {Tcl_EvalTokens, object values} testevalex { set a 123 testevalex {concat $a} } {123} test parse-10.11 {Tcl_EvalTokens, object values} testevalex { set a 123 testevalex {concat $a$a$a} } {123123123} test parse-10.12 {Tcl_EvalTokens, object values} testevalex { testevalex {concat [expr {2}][expr {4}][expr {6}]} } {246} test parse-10.13 {Tcl_EvalTokens, string values} testevalex { testevalex {concat {a" b"}} } {a" b"} test parse-10.14 {Tcl_EvalTokens, string values} testevalex { set a 111 testevalex {concat x$a.$a.$a} } {x111.111.111} test parse-11.1 {Tcl_EvalEx, TCL_EVAL_GLOBAL flag} -constraints { testevalex } -setup { proc x {} { set y 777 set z [testevalex "set y" global] return [list $z $y] } set ::y 321 } -cleanup { unset ::y } -body { x } -result {321 777} test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex { list [catch {testevalex {concat "abc}} msg] $msg } {1 {missing "}} test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex { unset -nocomplain a list [catch {testevalex {concat xyz $a}} msg] $msg } {1 {can't read "a": no such variable}} test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} testevalex { unset -nocomplain a list [catch {testevalex {_bogus_ a b c d}} msg] $msg } {1 {invalid command name "_bogus_"}} test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex { list [catch {testevalex {break}} msg] $msg } {3 {}} test parse-11.6 {Tcl_EvalEx, freeing memory} testevalex { testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z} } {a b c d e f g h i j k l m n o p q r s t u v w x y z} test parse-11.7 {Tcl_EvalEx, multiple commands in script} testevalex { list [testevalex {set a b; set c d}] $a $c } {d b d} test parse-11.8 {Tcl_EvalEx, multiple commands in script} testevalex { list [testevalex { set a b set c d }] $a $c } {d b d} test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex { unset -nocomplain a list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg } {1 {can't read "a": no such variable}} test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex { testevalex {concat xyz; } } {xyz} test parse-11.11 {Tcl_EvalTokens, empty commands} testevalex { testevalex "concat abc; ; # this is a comment\n" } {abc} test parse-11.12 {Tcl_EvalTokens, empty commands} testevalex { testevalex {} } {} test parse-12.1 {Tcl_ParseVarName procedure, initialization} testparsevarname { list [catch {testparsevarname {$a([first second])} 8 0} msg] $msg } {1 {missing close-bracket}} test parse-12.2 {Tcl_ParseVarName procedure, initialization} testparsevarname { testparsevarname {$a([first second])} 0 0 } {- {} 0 variable {$a([first second])} 2 text a 0 command {[first second]} 0 {}} test parse-12.3 {Tcl_ParseVarName procedure, initialization} testparsevarname { list [catch {testparsevarname {$abcd} 3 0} msg] $msg } {0 {- {} 0 variable {$ab} 1 text ab 0 cd}} test parse-12.4 {Tcl_ParseVarName procedure, initialization} testparsevarname { testparsevarname {$abcd} 0 0 } {- {} 0 variable {$abcd} 1 text abcd 0 {}} test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} testparsevarname { testparsevarname {$abcd} 1 0 } {- {} 0 text {$} 0 abcd} test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} testparser { testparser {${..[]b}cd} 0 } {- {${..[]b}cd} 1 word {${..[]b}cd} 3 variable {${..[]b}} 1 text {..[]b} 0 text cd 0 {}} test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} testparser { testparser "\$\{\{\} " 0 } {- \$\{\{\}\ 1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}} test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} testparser { list [catch {testparser "$\{abc" 0} msg] $msg $::errorInfo } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\$\\\{abc\"\ 0\"} test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} testparsevarname { list [catch {testparsevarname {${bcd}} 4 0} msg] $msg } {1 {missing close-brace for variable name}} test parse-12.10 {Tcl_ParseVarName procedure, missing close brace} testparsevarname { list [catch {testparsevarname {${bc}} 4 0} msg] $msg } {1 {missing close-brace for variable name}} test parse-12.11 {Tcl_ParseVarName procedure, simple variable name} testparser { testparser {$az_AZ.} 0 } {- {$az_AZ.} 1 word {$az_AZ.} 3 variable {$az_AZ} 1 text az_AZ 0 text . 0 {}} test parse-12.12 {Tcl_ParseVarName procedure, simple variable name} testparser { testparser {$abcdefg} 4 } {- {$abc} 1 word {$abc} 2 variable {$abc} 1 text abc 0 defg} test parse-12.13 {Tcl_ParseVarName procedure, simple variable name with ::} testparser { testparser {$xyz::ab:c} 0 } {- {$xyz::ab:c} 1 word {$xyz::ab:c} 3 variable {$xyz::ab} 1 text xyz::ab 0 text :c 0 {}} test parse-12.14 {Tcl_ParseVarName procedure, variable names with many colons} testparser { testparser {$xyz:::::c} 0 } {- {$xyz:::::c} 1 word {$xyz:::::c} 2 variable {$xyz:::::c} 1 text xyz:::::c 0 {}} test parse-12.15 {Tcl_ParseVarName procedure, : vs. ::} testparsevarname { testparsevarname {$ab:cd} 0 0 } {- {} 0 variable {$ab} 1 text ab 0 :cd} test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} testparsevarname { testparsevarname {$ab::cd} 4 0 } {- {} 0 variable {$ab} 1 text ab 0 ::cd} test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} testparsevarname { testparsevarname {$ab:::cd} 5 0 } {- {} 0 variable {$ab::} 1 text ab:: 0 :cd} test parse-12.18 {Tcl_ParseVarName procedure, no variable name} testparser { testparser {$$ $.} 0 } {- {$$ $.} 2 word {$$} 2 text {$} 0 text {$} 0 word {$.} 2 text {$} 0 text . 0 {}} test parse-12.19 {Tcl_ParseVarName procedure, EOF before (} testparsevarname { testparsevarname {$ab(cd)} 3 0 } {- {} 0 variable {$ab} 1 text ab 0 (cd)} test parse-12.20 {Tcl_ParseVarName procedure, array reference} testparser { testparser {$x(abc)} 0 } {- {$x(abc)} 1 word {$x(abc)} 3 variable {$x(abc)} 2 text x 0 text abc 0 {}} test parse-12.21 {Tcl_ParseVarName procedure, array reference} testparser { testparser {$x(ab$cde[foo bar])} 0 } {- {$x(ab$cde[foo bar])} 1 word {$x(ab$cde[foo bar])} 6 variable {$x(ab$cde[foo bar])} 5 text x 0 text ab 0 variable {$cde} 1 text cde 0 command {[foo bar]} 0 {}} test parse-12.22 {Tcl_ParseVarName procedure, array reference} testparser { testparser {$x([cmd arg]zz)} 0 } {- {$x([cmd arg]zz)} 1 word {$x([cmd arg]zz)} 4 variable {$x([cmd arg]zz)} 3 text x 0 command {[cmd arg]} 0 text zz 0 {}} test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} testparser { list [catch {testparser {$x(poiu} 0} msg] $msg $::errorInfo } {1 {missing )} {missing ) (remainder of script: "(poiu") invoked from within "testparser {$x(poiu} 0"}} test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} testparsevarname { list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $::errorInfo } {1 {missing )} {missing ) (remainder of script: "(cd)") invoked from within "testparsevarname {$ab(cd)} 6 0"}} test parse-12.25 {Tcl_ParseVarName procedure, nested array reference} testparser { testparser {$x(a$y(b$z))} 0 } {- {$x(a$y(b$z))} 1 word {$x(a$y(b$z))} 8 variable {$x(a$y(b$z))} 7 text x 0 text a 0 variable {$y(b$z)} 4 text y 0 text b 0 variable {$z} 1 text z 0 {}} test parse-12.26 {Tcl_ParseVarName [d2ffcca163] non-ascii} testparser { testparser "$\u0433" -1 } "- {$\u0433} 1 word {$\u0433} 2 text {$} 0 text \u0433 0 {}" test parse-13.1 {Tcl_ParseVar procedure} testparsevar { set abc 24 testparsevar {$abc.fg} } {24 .fg} test parse-13.2 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$} } {{$} {}} test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$.123} } {{$} .123} test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar { unset -nocomplain abc list [catch {testparsevar {$abc}} msg] $msg } {1 {can't read "abc": no such variable}} test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar { unset -nocomplain abc list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg } {1 {invalid command name "bogus"}} test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup { proc getbytes {} { return [lindex [split [memory info] \n] 3 3] } } -body { set a() foo set end [getbytes] for {set i 0} {$i < 5} {incr i} { set vn {} set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]] if {$res ne {foo bar}} {error "Unexpected result: $res"} set tmp $end set end [getbytes] } expr {$end - $tmp} } -cleanup { unset -nocomplain a end i vn res tmp rename getbytes {} } -result 0 test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {testparser testbytestring} { testparser [testbytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} test parse-14.3 {Tcl_ParseBraces procedure, words in braces} testparser { testparser {foo {a $b [concat foo]} {c d}} 0 } {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}} test parse-14.4 {Tcl_ParseBraces procedure, empty nested braces} testparser { testparser {foo {{}}} 0 } {- {foo {{}}} 2 simple foo 1 text foo 0 simple {{{}}} 1 text {{}} 0 {}} test parse-14.5 {Tcl_ParseBraces procedure, nested braces} testparser { testparser {foo {{a {b} c} {} {d e}}} 0 } {- {foo {{a {b} c} {} {d e}}} 2 simple foo 1 text foo 0 simple {{{a {b} c} {} {d e}}} 1 text {{a {b} c} {} {d e}} 0 {}} test parse-14.6 {Tcl_ParseBraces procedure, backslashes in words in braces} testparser { testparser "foo {a \\n\\\{}" 0 } {- {foo {a \n\{}} 2 simple foo 1 text foo 0 simple {{a \n\{}} 1 text {a \n\{} 0 {}} test parse-14.7 {Tcl_ParseBraces procedure, missing continuation line in braces} testparser { list [catch {testparser "\{abc\\\n" 0} msg] $msg $::errorInfo } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\{abc\\\\\\n\"\ 0\"} test parse-14.8 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { testparser "foo {\\\nx}" 0 } {- foo\ \{\\\nx\} 2 simple foo 1 text foo 0 word \{\\\nx\} 2 backslash \\\n 0 text x 0 {}} test parse-14.9 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { testparser "foo {a \\\n b}" 0 } {- foo\ \{a\ \\\n\ \ \ b\} 2 simple foo 1 text foo 0 word \{a\ \\\n\ \ \ b\} 3 text {a } 0 backslash \\\n\ \ \ 0 text b 0 {}} test parse-14.10 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { testparser "foo {xyz\\\n }" 0 } {- foo\ \{xyz\\\n\ \} 2 simple foo 1 text foo 0 word \{xyz\\\n\ \} 2 text xyz 0 backslash \\\n\ 0 {}} test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} testparser { testparser {foo {}} 0 } {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}} test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser { list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"} test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} {testparser testbytestring} { testparser [testbytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} testparser { testparser {foo "a b c" d "efg";} 0 } {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}} test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} testparser { list [catch {testparser {foo "a b c"d} 0} msg] $msg $::errorInfo } {1 {extra characters after close-quote} {extra characters after close-quote (remainder of script: "d") invoked from within "testparser {foo "a b c"d} 0"}} test parse-15.5 {CommandComplete procedure} { info complete "" } 1 test parse-15.6 {CommandComplete procedure} { info complete " \n" } 1 test parse-15.7 {CommandComplete procedure} { info complete "abc def" } 1 test parse-15.8 {CommandComplete procedure} { info complete "a b c d e f \t\n" } 1 test parse-15.9 {CommandComplete procedure} { info complete {a b c"d} } 1 test parse-15.10 {CommandComplete procedure} { info complete {a b "c d" e} } 1 test parse-15.11 {CommandComplete procedure} { info complete {a b "c d"} } 1 test parse-15.12 {CommandComplete procedure} { info complete {a b "c d"} } 1 test parse-15.13 {CommandComplete procedure} { info complete {a b "c d} } 0 test parse-15.14 {CommandComplete procedure} { info complete {a b "} } 0 test parse-15.15 {CommandComplete procedure} { info complete {a b "cd"xyz} } 1 test parse-15.16 {CommandComplete procedure} { info complete {a b "c $d() d"} } 1 test parse-15.17 {CommandComplete procedure} { info complete {a b "c $dd("} } 0 test parse-15.18 {CommandComplete procedure} { info complete {a b "c \"} } 0 test parse-15.19 {CommandComplete procedure} { info complete {a b "c [d e f]"} } 1 test parse-15.20 {CommandComplete procedure} { info complete {a b "c [d e f] g"} } 1 test parse-15.21 {CommandComplete procedure} { info complete {a b "c [d e f"} } 0 test parse-15.22 {CommandComplete procedure} { info complete {a {b c d} e} } 1 test parse-15.23 {CommandComplete procedure} { info complete {a {b c d}} } 1 test parse-15.24 {CommandComplete procedure} { info complete "a b\{c d" } 1 test parse-15.25 {CommandComplete procedure} { info complete "a b \{c" } 0 test parse-15.26 {CommandComplete procedure} { info complete "a b \{c{ }" } 0 test parse-15.27 {CommandComplete procedure} { info complete "a b {c d e}xxx" } 1 test parse-15.28 {CommandComplete procedure} { info complete "a b {c \\\{d e}xxx" } 1 test parse-15.29 {CommandComplete procedure} { info complete {a b [ab cd ef]} } 1 test parse-15.30 {CommandComplete procedure} { info complete {a b x[ab][cd][ef] gh} } 1 test parse-15.31 {CommandComplete procedure} { info complete {a b x[ab][cd[ef] gh} } 0 test parse-15.32 {CommandComplete procedure} { info complete {a b x[ gh} } 0 test parse-15.33 {CommandComplete procedure} { info complete {[]]]} } 1 test parse-15.34 {CommandComplete procedure} { info complete {abc x$yyy} } 1 test parse-15.35 {CommandComplete procedure} { info complete "abc x\${abc\[\\d} xyz" } 1 test parse-15.36 {CommandComplete procedure} { info complete "abc x\$\{ xyz" } 0 test parse-15.37 {CommandComplete procedure} { info complete {word $a(xyz)} } 1 test parse-15.38 {CommandComplete procedure} { info complete {word $a(} } 0 test parse-15.39 {CommandComplete procedure} { info complete "set a \\\n" } 0 test parse-15.40 {CommandComplete procedure} { info complete "set a \\\\\n" } 1 test parse-15.41 {CommandComplete procedure} { info complete "set a \\n " } 1 test parse-15.42 {CommandComplete procedure} { info complete "set a \\" } 1 test parse-15.43 {CommandComplete procedure} { info complete "foo \\\n\{" } 0 test parse-15.44 {CommandComplete procedure} { info complete "a\nb\n# \{\n# \{\nc\n" } 1 test parse-15.45 {CommandComplete procedure} { info complete "#Incomplete comment\\\n" } 0 test parse-15.46 {CommandComplete procedure} { info complete "#Incomplete comment\\\nBut now it's complete.\n" } 1 test parse-15.47 {CommandComplete procedure} { info complete "# Complete comment\\\\\n" } 1 test parse-15.48 {CommandComplete procedure} { info complete "abc\\\n def" } 1 test parse-15.49 {CommandComplete procedure} { info complete "abc\\\n " } 1 test parse-15.50 {CommandComplete procedure} { info complete "abc\\\n" } 0 test parse-15.51 {CommandComplete procedure} " info complete \"\\\{abc\\\}\\\{\" " 1 test parse-15.52 {CommandComplete procedure} { info complete "\"abc\"(" } 1 test parse-15.53 {CommandComplete procedure} " info complete \" # \{\" " 1 test parse-15.54 {CommandComplete procedure} " info complete \"foo bar;# \{\" " 1 test parse-15.55 {CommandComplete procedure} testbytestring { info complete "set x [testbytestring \0]; puts hi" } 1 test parse-15.56 {CommandComplete procedure} testbytestring { info complete "set x [testbytestring \0]; \{" } 0 test parse-15.57 {CommandComplete procedure} { info complete "# Comment should be complete command" } 1 test parse-15.58 {CommandComplete procedure, memory leaks} { info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22" } 1 test parse-15.59 {CommandComplete procedure} testbytestring { # Test for Tcl Bug 684744 info complete [testbytestring "\x00;if 1 \{"] } 0 test parse-15.60 {CommandComplete procedure} { # Test for Tcl Bug 1968882 info complete \\\n } 0 test parse-16.1 {Bug 218885 (Scriptics bug 2535)} { subst {[eval {return foo}]bar} } foobar test parse-17.1 {Correct return codes from errors during substitution} { catch {eval {w[continue]}} } 4 test parse-18.1 {Tcl_SubstObj, ParseTokens flags} { subst {foo\t$::tcl_library\t[set ::tcl_library]} } "foo $::tcl_library $::tcl_library" test parse-18.2 {Tcl_SubstObj, ParseTokens flags} { subst -nocommands {foo\t$::tcl_library\t[set ::tcl_library]} } "foo $::tcl_library \[set ::tcl_library]" test parse-18.3 {Tcl_SubstObj, ParseTokens flags} { subst -novariables {foo\t$::tcl_library\t[set ::tcl_library]} } "foo \$::tcl_library $::tcl_library" test parse-18.4 {Tcl_SubstObj, ParseTokens flags} { subst -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} } "foo\\t$::tcl_library\\t$::tcl_library" test parse-18.5 {Tcl_SubstObj, ParseTokens flags} { subst -novariables -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} } "foo\\t\$::tcl_library\\t$::tcl_library" test parse-18.6 {Tcl_SubstObj, ParseTokens flags} { subst -nocommands -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} } "foo\\t$::tcl_library\\t\[set ::tcl_library]" test parse-18.7 {Tcl_SubstObj, ParseTokens flags} { subst -nocommands -novariables {foo\t$::tcl_library\t[set ::tcl_library]} } "foo \$::tcl_library \[set ::tcl_library]" test parse-18.8 {Tcl_SubstObj, ParseTokens flags} { subst -nocommands -novariables -nobackslashes \ {foo\t$::tcl_library\t[set ::tcl_library]} } "foo\\t\$::tcl_library\\t\[set ::tcl_library]" test parse-18.9 {Tcl_SubstObj, parse errors} { list [catch "subst foo\$\{foo" msg] $msg } [list 1 "missing close-brace for variable name"] test parse-18.10 {Tcl_SubstObj, parse errors} { list [catch "subst foo\[set \$\{foo]" msg] $msg } [list 1 "missing close-brace for variable name"] test parse-18.11 {Tcl_SubstObj, parse errors} { list [catch "subst foo\$array(\$\{foo)" msg] $msg } [list 1 "missing close-brace for variable name"] test parse-18.12 {Tcl_SubstObj, parse errors} { list [catch "subst foo\$(\$\{foo)" msg] $msg } [list 1 "missing close-brace for variable name"] test parse-18.13 {Tcl_SubstObj, parse errors} { list [catch "subst \[" msg] $msg } [list 1 "missing close-bracket"] test parse-18.14 {Tcl_SubstObj, exception handling} { subst {abc,[break],def} } {abc,} test parse-18.15 {Tcl_SubstObj, exception handling} { subst {abc,[continue; expr {1+2}],def} } {abc,,def} test parse-18.16 {Tcl_SubstObj, exception handling} { subst {abc,[return foo; expr {1+2}],def} } {abc,foo,def} test parse-18.17 {Tcl_SubstObj, exception handling} { subst {abc,[return -code 10 foo; expr {1+2}],def} } {abc,foo,def} test parse-18.18 {Tcl_SubstObj, exception handling} { subst {abc,[break; set {} {}{}],def} } {abc,} test parse-18.19 {Tcl_SubstObj, exception handling} { list [catch {subst {abc,[continue; expr {1+2}; set {} {}{}],def}} msg] $msg } [list 1 "extra characters after close-brace"] test parse-18.20 {Tcl_SubstObj, exception handling} { list [catch {subst {abc,[return foo; expr {1+2}; set {} {}{}],def}} msg] $msg } [list 1 "extra characters after close-brace"] test parse-18.21 {Tcl_SubstObj, exception handling} { list [catch { subst {abc,[return -code 10 foo; expr {1+2}; set {} {}{}],def} } msg] $msg } [list 1 "extra characters after close-brace"] test parse-18.22 {Tcl_SubstObj, side effects} { set a 0 list [subst {foo[incr a]bar}] $a } [list foo1bar 1] test parse-18.23 {Tcl_SubstObj, side effects} { set a 0 list [subst {foo[incr a; incr a]bar}] $a } [list foo2bar 2] test parse-18.24 {Tcl_SubstObj, side effects} { set a 0 list [subst {foo[incr a; break; incr a]bar}] $a } [list foo 1] test parse-18.25 {Tcl_SubstObj, side effects} { set a 0 list [subst {foo[incr a; continue; incr a]bar}] $a } [list foobar 1] test parse-18.26 {Tcl_SubstObj, side effects} { set a 0 list [subst {foo[incr a; return; incr a]bar}] $a } [list foobar 1] test parse-18.27 {Tcl_SubstObj, side effects} { set a 0 list [subst {foo[incr a; return -code 10; incr a]bar}] $a } [list foobar 1] test parse-18.28 {Tcl_SubstObj, side effects} { set a 0 catch {subst {foo[incr a; parse error {}{}; incr a]bar}} set a } 1 test parse-18.29 {Tcl_SubstObj, side effects} { set a 0 catch {subst {foo[incr a; incr a; parse error {}{}]bar}} set a } 2 test parse-18.30 {Tcl_SubstObj, side effects} { set a 0 catch {subst {foo[incr a; incr a parse error {}{}]bar}} set a } 1 test parse-19.1 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { testevalex } -setup { interp create i load {} Tcltest i i eval {proc {} args {}} interp recursionlimit i 3 } -body { i eval {testevalex {[]}} } -cleanup { interp delete i } test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { testevalex } -setup { interp create i load {} Tcltest i i eval {proc {} args {}} interp recursionlimit i 2 } -body { i eval {testevalex {[[]]}} } -cleanup { interp delete i } -returnCodes error -match glob -result {too many nested*} test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest { # Test no longer valid in Tcl 8.6 } {} test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest { # Test no longer valid in Tcl 8.6 } {} test parse-20.1 {TclParseBackslash: truncated escape} testparser { testparser {\u12345} 1 } {- \\ 1 simple \\ 1 text \\ 0 u12345} test parse-20.2 {TclParseBackslash: truncated escape} testparser { testparser {\u12345} 2 } {- {\u} 1 word {\u} 1 backslash {\u} 0 12345} test parse-20.3 {TclParseBackslash: truncated escape} testparser { testparser {\u12345} 3 } {- {\u1} 1 word {\u1} 1 backslash {\u1} 0 2345} test parse-20.4 {TclParseBackslash: truncated escape} testparser { testparser {\u12345} 4 } {- {\u12} 1 word {\u12} 1 backslash {\u12} 0 345} test parse-20.5 {TclParseBackslash: truncated escape} testparser { testparser {\u12345} 5 } {- {\u123} 1 word {\u123} 1 backslash {\u123} 0 45} test parse-20.6 {TclParseBackslash: truncated escape} testparser { testparser {\u12345} 6 } {- {\u1234} 1 word {\u1234} 1 backslash {\u1234} 0 5} test parse-20.7 {TclParseBackslash: truncated escape} testparser { testparser {\u12345} 7 } {- {\u12345} 1 word {\u12345} 2 backslash {\u1234} 0 text 5 0 {}} test parse-20.8 {TclParseBackslash: truncated escape} testparser { testparser {\x12X} 1 } {- \\ 1 simple \\ 1 text \\ 0 x12X} test parse-20.9 {TclParseBackslash: truncated escape} testparser { testparser {\x12X} 2 } {- {\x} 1 word {\x} 1 backslash {\x} 0 12X} test parse-20.10 {TclParseBackslash: truncated escape} testparser { testparser {\x12X} 3 } {- {\x1} 1 word {\x1} 1 backslash {\x1} 0 2X} test parse-20.11 {TclParseBackslash: truncated escape} testparser { testparser {\x12X} 4 } {- {\x12} 1 word {\x12} 1 backslash {\x12} 0 X} test parse-20.12 {TclParseBackslash: truncated escape} testparser { testparser {\x12X} 5 } {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}} test parse-21.0 {Bug 1884496} testevent { set ::script {testevent delete a; set a [p]; set ::done $a} proc ::p {} {string first s $::script} testevent queue a head $::script vwait done } {} test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent { testevent queue a head {testevent delete a; \ set ::done [dict get [info frame 0] line]} vwait done set ::done } 2 cleanupTests } namespace delete ::tcl::test::parse return tcl8.6.14/tests/pid.test0000644000175000017500000000345314554262142014466 0ustar sergeisergei# Commands covered: pid # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint pidDefined [llength [info commands pid]] test pid-1.1 {pid command} pidDefined { regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid] } 1 test pid-1.2 {pid command} -constraints {unixOrWin unixExecs pidDefined} -setup { set path(test1) [makeFile {} test1] file delete $path(test1) } -body { set f [open |[list echo foo | cat >$path(test1)] w] set pids [pid $f] close $f list [llength $pids] [regexp {^[0-9]+$} [lindex $pids 0]] \ [regexp {^[0-9]+$} [lindex $pids 1]] \ [expr {[lindex $pids 0] == [lindex $pids 1]}] } -cleanup { removeFile test1 } -result {2 1 1 0} test pid-1.3 {pid command} -constraints pidDefined -setup { set path(test1) [makeFile {} test1] file delete $path(test1) } -body { set f [open $path(test1) w] set pids [pid $f] close $f set pids } -cleanup { removeFile test1 } -result {} test pid-1.4 {pid command} pidDefined { list [catch {pid a b} msg] $msg } {1 {wrong # args: should be "pid ?channelId?"}} test pid-1.5 {pid command} pidDefined { list [catch {pid gorp} msg] $msg } {1 {can not find channel named "gorp"}} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/pkgMkIndex.test0000644000175000017500000004664014554262142015760 0ustar sergeisergei# This file contains tests for the pkg_mkIndex command. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1998-1999 Scriptics Corporation. # All rights reserved. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } set fullPkgPath [makeDirectory pkg] namespace eval pkgtest { # Namespace for procs we can discard } # pkgtest::parseArgs -- # # Parse an argument list. # # Arguments: # (optional) arguments starting with a dash are collected as # options to pkg_mkIndex and passed to pkg_mkIndex. # dirPath the directory to index # pattern0 pattern to index # ... pattern to index # patternN pattern to index # # Results: # Returns a three element list: # 0: the options # 1: the directory to index # 2: the patterns list proc pkgtest::parseArgs { args } { set options "" set argc [llength $args] for {set iarg 0} {$iarg < $argc} {incr iarg} { set a [lindex $args $iarg] if {[regexp {^-} $a]} { lappend options $a if {$a eq "-load"} { incr iarg lappend options [lindex $args $iarg] } } else { break } } set dirPath [lindex $args $iarg] incr iarg set patternList [lrange $args $iarg end] return [list $options $dirPath $patternList] } # pkgtest::parseIndex -- # # Loads a pkgIndex.tcl file, records all the calls to "package ifneeded". # # Arguments: # filePath path to the pkgIndex.tcl file. # # Results: # Returns a list, in "array set/get" format, where the keys are the package # name and version (in the form "$name:$version"), and the values the rest # of the command line. proc pkgtest::parseIndex { filePath } { # create a child interpreter, where we override "package ifneeded" set child [interp create] if {[catch { $child eval { rename package package_original proc package { args } { if {[lindex $args 0] eq "ifneeded"} { set pkg [lindex $args 1] set ver [lindex $args 2] set ::PKGS($pkg:$ver) [lindex $args 3] } else { return [package_original {*}$args] } } array set ::PKGS {} } set dir [file dirname $filePath] $child eval {set curdir [pwd]} $child eval [list cd $dir] $child eval [list set dir $dir] $child eval [list source [file tail $filePath]] $child eval {cd $curdir} # Create the list in sorted order, so that we don't get spurious # errors because the order has changed. array set P {} foreach {k v} [$child eval {array get ::PKGS}] { set P($k) $v } set PKGS "" foreach k [lsort [array names P]] { lappend PKGS $k $P($k) } } err opts]} { set ei [dict get $opts -errorinfo] set ec [dict get $opts -errorcode] catch {interp delete $child} error $ei $ec } interp delete $child return $PKGS } # pkgtest::createIndex -- # # Runs pkg_mkIndex for the given directory and set of patterns. This # procedure deletes any pkgIndex.tcl file in the target directory, then runs # pkg_mkIndex. # # Arguments: # (optional) arguments starting with a dash are collected as # options to pkg_mkIndex and passed to pkg_mkIndex. # dirPath the directory to index # pattern0 pattern to index # ... pattern to index # patternN pattern to index # # Results: # Returns a two element list: # 0: 1 if the procedure encountered an error, 0 otherwise. # 1: the error result if element 0 was 1 proc pkgtest::createIndex { args } { set parsed [parseArgs {*}$args] set options [lindex $parsed 0] set dirPath [lindex $parsed 1] set patternList [lindex $parsed 2] file mkdir $dirPath if {[catch { file delete [file join $dirPath pkgIndex.tcl] pkg_mkIndex {*}$options $dirPath {*}$patternList } err]} { return [list 1 $err] } return [list 0 {}] } # makePkgList -- # # Takes the output of a pkgtest::parseIndex call, filters it and returns a # cleaned up list of packages and their actions. # # Arguments: # inList output from a pkgtest::parseIndex. # # Results: # Returns a list of two element lists: # 0: the name:version # 1: a list describing the package. # For tclPkgSetup packages it consists of: # 0: the keyword tclPkgSetup # 1: the first file to source, with its exported procedures # 2: the second file ... # N: the N-1st file ... proc makePkgList { inList } { set pkgList "" foreach {k v} $inList { switch [lindex $v 0] { tclPkgSetup { set l tclPkgSetup foreach s [lindex $v 4] { lappend l $s } } source { set l $v } default { error "can't handle $k $v" } } lappend pkgList [list $k $l] } return $pkgList } # pkgtest::runIndex -- # # Runs pkg_mkIndex, parses the generated index file. # # Arguments: # (optional) arguments starting with a dash are collected as # options to pkg_mkIndex and passed to pkg_mkIndex. # dirPath the directory to index # pattern0 pattern to index # ... pattern to index # patternN pattern to index # # Results: # Returns a two element list: # 0: 1 if the procedure encountered an error, 0 otherwise. # 1: if no error, this is the parsed generated index file, in the format # returned by pkgtest::parseIndex. If error, this is the error result. proc pkgtest::runCreatedIndex {rv args} { if {[lindex $rv 0] == 0} { set parsed [parseArgs {*}$args] set dirPath [lindex $parsed 1] set idxFile [file join $dirPath pkgIndex.tcl] if {[catch { set result [list 0 [makePkgList [parseIndex $idxFile]]] } err]} { set result [list 1 $err] } file delete $idxFile } else { set result $rv } return $result } proc pkgtest::runIndex { args } { set rv [createIndex {*}$args] return [runCreatedIndex $rv {*}$args] } # If there is no match to the patterns, make sure the directory hasn't changed # on us test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} { list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd] } [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]] makeFile { # This is a simple package, just to check basic functionality. package provide simple 1.0 namespace eval simple { namespace export lower upper } proc simple::lower { stg } { return [string tolower $stg] } proc simple::upper { stg } { return [string toupper $stg] } } [file join pkg simple.tcl] test pkgMkIndex-2.1 {simple package} { pkgtest::runIndex -lazy $fullPkgPath simple.tcl } {0 {{simple:1.0 {tclPkgSetup {simple.tcl source {::simple::lower ::simple::upper}}}}}} test pkgMkIndex-2.2 {simple package - use -direct} { pkgtest::runIndex -direct $fullPkgPath simple.tcl } "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" test pkgMkIndex-2.3 {simple package - direct loading is default} { pkgtest::runIndex $fullPkgPath simple.tcl } "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" test pkgMkIndex-2.4 {simple package - use -verbose} -body { pkgtest::runIndex -verbose $fullPkgPath simple.tcl } -result "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" \ -errorOutput {successful sourcing of simple.tcl packages provided were {simple 1.0} processed simple.tcl } removeFile [file join pkg simple.tcl] makeFile { # Contains global symbols, used to check that they don't have a leading :: package provide global 1.0 proc global_lower { stg } { return [string tolower $stg] } proc global_upper { stg } { return [string toupper $stg] } } [file join pkg global.tcl] test pkgMkIndex-3.1 {simple package with global symbols} { pkgtest::runIndex -lazy $fullPkgPath global.tcl } {0 {{global:1.0 {tclPkgSetup {global.tcl source {global_lower global_upper}}}}}} removeFile [file join pkg global.tcl] makeFile { # This package is required by pkg1. # This package is split into two files, to test packages that are split over # multiple files. package provide pkg2 1.0 namespace eval pkg2 { namespace export p2-1 } proc pkg2::p2-1 { num } { return [expr {$num * 2}] } } [file join pkg pkg2_a.tcl] makeFile { # This package is required by pkg1. # This package is split into two files, to test packages that are split over # multiple files. package provide pkg2 1.0 namespace eval pkg2 { namespace export p2-2 } proc pkg2::p2-2 { num } { return [expr {$num * 3}] } } [file join pkg pkg2_b.tcl] test pkgMkIndex-4.1 {split package} { pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl } {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}} test pkgMkIndex-4.2 {split package - direct loading} { pkgtest::runIndex -direct $fullPkgPath pkg2_a.tcl pkg2_b.tcl } "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]] [list source [file join $fullPkgPath pkg2_b.tcl]]}}}" # Add the direct1 directory to auto_path, so that the direct1 package can be # found. set direct1 [makeDirectory direct1] lappend auto_path $direct1 makeFile { # This is referenced by pkgIndex.tcl as a -direct script. package provide direct1 1.0 namespace eval direct1 { namespace export pd1 pd2 } proc direct1::pd1 { stg } { return [string tolower $stg] } proc direct1::pd2 { stg } { return [string toupper $stg] } } [file join direct1 direct1.tcl] pkg_mkIndex -direct $direct1 direct1.tcl makeFile { # Does a package require of direct1, whose pkgIndex.tcl entry is created # above with option -direct. This tests that pkg_mkIndex can handle code # that is sourced in pkgIndex.tcl files. package require direct1 package provide std 1.0 namespace eval std { namespace export p1 p2 } proc std::p1 { stg } { return [string tolower $stg] } proc std::p2 { stg } { return [string toupper $stg] } } [file join pkg std.tcl] test pkgMkIndex-5.1 {requires -direct package} { pkgtest::runIndex -lazy $fullPkgPath std.tcl } {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}} removeFile [file join direct1 direct1.tcl] file delete [file join $direct1 pkgIndex.tcl] removeDirectory direct1 removeFile [file join pkg std.tcl] makeFile { # This package requires pkg3, but it does not use any of pkg3's procs in the # code that is executed by the file (i.e. references to pkg3's procs are in # the proc bodies only). package require pkg3 1.0 package provide pkg1 1.0 namespace eval pkg1 { namespace export p1-1 p1-2 } proc pkg1::p1-1 { num } { return [pkg3::p3-1 $num] } proc pkg1::p1-2 { num } { return [pkg3::p3-2 $num] } } [file join pkg pkg1.tcl] makeFile { package provide pkg3 1.0 namespace eval pkg3 { namespace export p3-1 p3-2 } proc pkg3::p3-1 { num } { return {[expr {$num * 2}]} } proc pkg3::p3-2 { num } { return {[expr {$num * 3}]} } } [file join pkg pkg3.tcl] test pkgMkIndex-6.1 {pkg1 requires pkg3} { pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl } {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}} test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} { pkgtest::runIndex -direct $fullPkgPath pkg1.tcl pkg3.tcl } "0 {{pkg1:1.0 {[list source [file join $fullPkgPath pkg1.tcl]]}} {pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}}}" removeFile [file join pkg pkg1.tcl] makeFile { # This package requires pkg3, and it calls a pkg3 proc in the code that is # executed by the file package require pkg3 1.0 package provide pkg4 1.0 namespace eval pkg4 { namespace export p4-1 p4-2 variable m2 [pkg3::p3-1 10] } proc pkg4::p4-1 { num } { variable m2 return [expr {$m2 * $num}] } proc pkg4::p4-2 { num } { return [pkg3::p3-2 $num] } } [file join pkg pkg4.tcl] test pkgMkIndex-7.1 {pkg4 uses pkg3} { pkgtest::runIndex -lazy $fullPkgPath pkg4.tcl pkg3.tcl } {0 {{pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}} {pkg4:1.0 {tclPkgSetup {pkg4.tcl source {::pkg4::p4-1 ::pkg4::p4-2}}}}}} test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} { pkgtest::runIndex -direct $fullPkgPath pkg4.tcl pkg3.tcl } "0 {{pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}} {pkg4:1.0 {[list source [file join $fullPkgPath pkg4.tcl]]}}}" removeFile [file join pkg pkg4.tcl] removeFile [file join pkg pkg3.tcl] makeFile { # This package requires pkg2, and it calls a pkg2 proc in the code that is # executed by the file. Pkg2 is a split package. package require pkg2 1.0 package provide pkg5 1.0 namespace eval pkg5 { namespace export p5-1 p5-2 variable m2 [pkg2::p2-1 10] variable m3 [pkg2::p2-2 10] } proc pkg5::p5-1 { num } { variable m2 return [expr {$m2 * $num}] } proc pkg5::p5-2 { num } { variable m2 return [expr {$m2 * $num}] } } [file join pkg pkg5.tcl] test pkgMkIndex-8.1 {pkg5 uses pkg2} { pkgtest::runIndex -lazy $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl } {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}} {pkg5:1.0 {tclPkgSetup {pkg5.tcl source {::pkg5::p5-1 ::pkg5::p5-2}}}}}} test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} { pkgtest::runIndex -direct $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl } "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]] [list source [file join $fullPkgPath pkg2_b.tcl]]}} {pkg5:1.0 {[list source [file join $fullPkgPath pkg5.tcl]]}}}" removeFile [file join pkg pkg5.tcl] removeFile [file join pkg pkg2_a.tcl] removeFile [file join pkg pkg2_b.tcl] makeFile { # This package requires circ2, and circ2 requires circ3, which in turn # requires circ1. In case of circularities, pkg_mkIndex should give up when # it gets stuck. package require circ2 1.0 package provide circ1 1.0 namespace eval circ1 { namespace export c1-1 c1-2 c1-3 c1-4 } proc circ1::c1-1 { num } { return [circ2::c2-1 $num] } proc circ1::c1-2 { num } { return [circ2::c2-2 $num] } proc circ1::c1-3 {} { return 10 } proc circ1::c1-4 {} { return 20 } } [file join pkg circ1.tcl] makeFile { # This package is required by circ1, and requires circ3. Circ3, in turn, # requires circ1 to give us a circularity. package require circ3 1.0 package provide circ2 1.0 namespace eval circ2 { namespace export c2-1 c2-2 } proc circ2::c2-1 { num } { return [expr {$num * [circ3::c3-1]}] } proc circ2::c2-2 { num } { return [expr {$num * [circ3::c3-2]}] } } [file join pkg circ2.tcl] makeFile { # This package is required by circ2, and in turn requires circ1. This closes # the circularity. package require circ1 1.0 package provide circ3 1.0 namespace eval circ3 { namespace export c3-1 c3-4 } proc circ3::c3-1 {} { return [circ1::c1-3] } proc circ3::c3-2 {} { return [circ1::c1-4] } } [file join pkg circ3.tcl] test pkgMkIndex-9.1 {circular packages} { pkgtest::runIndex -lazy $fullPkgPath circ1.tcl circ2.tcl circ3.tcl } {0 {{circ1:1.0 {tclPkgSetup {circ1.tcl source {::circ1::c1-1 ::circ1::c1-2 ::circ1::c1-3 ::circ1::c1-4}}}} {circ2:1.0 {tclPkgSetup {circ2.tcl source {::circ2::c2-1 ::circ2::c2-2}}}} {circ3:1.0 {tclPkgSetup {circ3.tcl source ::circ3::c3-1}}}}} removeFile [file join pkg circ1.tcl] removeFile [file join pkg circ2.tcl] removeFile [file join pkg circ3.tcl] # Some tests require the existence of one of the DLLs in the dltest directory set x [file join [file dirname [info nameofexecutable]] dltest \ pkga[info sharedlibextension]] set dll "[file tail $x]Required" testConstraint $dll [file exists $x] if {[testConstraint $dll]} { makeFile { # This package provides pkga, which is also provided by a DLL. package provide pkga 1.0 proc pkga_neq { x } { return [expr {! [pkgq_eq $x]}] } } [file join pkg pkga.tcl] file copy -force $x $fullPkgPath } testConstraint exec [llength [info commands ::exec]] test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] { # Do all [load]ing of shared libraries in another process, so we can # delete the file and not get stuck because we're holding a reference to # it. set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl] exec [interpreter] << $cmd pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl } "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}" test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] { # Do all [load]ing of shared libraries in another process, so we can # delete the file and not get stuck because we're holding a reference to # it. # # This test depends on context from prior test, so repeat it. set script \ "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]" append script \n \ "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]" exec [interpreter] << $script pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension] } {0 {}} if {[testConstraint $dll]} { file delete -force [file join $fullPkgPath [file tail $x]] removeFile [file join pkg pkga.tcl] } # Tolerate "namespace import" at the global scope makeFile { package provide fubar 1.0 namespace eval ::fubar:: { # # export only public functions. # namespace export {[a-z]*} } proc ::fubar::foo {bar} { puts "$bar" return true } namespace import ::fubar::foo } [file join pkg import.tcl] test pkgMkIndex-11.1 {conflicting namespace imports} { pkgtest::runIndex -lazy $fullPkgPath import.tcl } {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}} removeFile [file join pkg import.tcl] # Verify that the auto load list generated is correct even when there is a # proc name conflict between two namespaces (ie, ::foo::baz and ::bar::baz) makeFile { package provide football 1.0 namespace eval ::pro:: { # # export only public functions. # namespace export {[a-z]*} } namespace eval ::college:: { # # export only public functions. # namespace export {[a-z]*} } proc ::pro::team {} { puts "go packers!" return true } proc ::college::team {} { puts "go badgers!" return true } } [file join pkg samename.tcl] test pkgMkIndex-12.1 {same name procs in different namespace} { pkgtest::runIndex -lazy $fullPkgPath samename.tcl } {0 {{football:1.0 {tclPkgSetup {samename.tcl source {::college::team ::pro::team}}}}}} removeFile [file join pkg samename.tcl] # Proc names with embedded spaces are properly listed (i.e. correct number of # braces) in result makeFile { package provide spacename 1.0 proc {a b} {} {} proc {c d} {} {} } [file join pkg spacename.tcl] test pkgMkIndex-13.1 {proc names with embedded spaces} { pkgtest::runIndex -lazy $fullPkgPath spacename.tcl } {0 {{spacename:1.0 {tclPkgSetup {spacename.tcl source {{a b} {c d}}}}}}} removeFile [file join pkg spacename.tcl] # Test the tcl::Pkg::CompareExtension helper function test pkgMkIndex-14.1 {tcl::Pkg::CompareExtension} {unix} { tcl::Pkg::CompareExtension foo.so .so } 1 test pkgMkIndex-14.2 {tcl::Pkg::CompareExtension} {unix} { tcl::Pkg::CompareExtension foo.so.bar .so } 0 test pkgMkIndex-14.3 {tcl::Pkg::CompareExtension} {unix} { tcl::Pkg::CompareExtension foo.so.1 .so } 1 test pkgMkIndex-14.4 {tcl::Pkg::CompareExtension} {unix} { tcl::Pkg::CompareExtension foo.so.1.2 .so } 1 test pkgMkIndex-14.5 {tcl::Pkg::CompareExtension} {unix} { tcl::Pkg::CompareExtension foo .so } 0 test pkgMkIndex-14.6 {tcl::Pkg::CompareExtension} {unix} { tcl::Pkg::CompareExtension foo.so.1.2.bar .so } 0 # cleanup removeDirectory pkg namespace delete pkgtest ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/platform.test0000644000175000017500000000613714554262142015540 0ustar sergeisergei# The file tests the tcl_platform variable and platform package. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1999 by Scriptics Corporation # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 source [file join [file dirname [info script]] tcltests.tcl] namespace eval ::tcl::test::platform { namespace import ::tcltest::testConstraint namespace import ::tcltest::test namespace import ::tcltest::cleanupTests # This is not how [variable] works. See TIP 276. #variable ::tcl_platform namespace upvar :: tcl_platform tcl_platform ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testCPUID [llength [info commands testcpuid]] test platform-1.0 {tcl_platform(engine)} { set tcl_platform(engine) } {Tcl} test platform-1.1 {TclpSetVariables: tcl_platform} { interp create i i eval {catch {unset tcl_platform(debug)}} i eval {catch {unset tcl_platform(threaded)}} set result [i eval {lsort [array names tcl_platform]}] interp delete i set result } {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize} # Test assumes twos-complement arithmetic, which is true of virtually # everything these days. Note that this does *not* use wide(), and # this is intentional since that could make Tcl's numbers wider than # the machine-integer on some platforms... test platform-2.1 {tcl_platform(wordSize) indicates size of native word} { set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}] # Result must be the largest bit in a machine word, which this checks # without assuming how wide the word really is list [expr {$result < 0}] [expr {$result ^ int($result - 1)}] } {1 -1} # On Windows/UNIX, test that the CPU ID works test platform-3.1 {CPU ID on Windows/UNIX} \ -constraints testCPUID \ -body { set cpudata [testcpuid 0] binary format iii \ [lindex $cpudata 1] \ [lindex $cpudata 3] \ [lindex $cpudata 2] } \ -match regexp \ -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$} # The platform package makes very few promises, but does promise that the # format of string it produces consists of two non-empty words separated by a # hyphen. package require platform test platform-4.1 {format of platform::identify result} -constraints notValgrind -match regexp -body { # [identify] may attempt to [exec] dpkg-architecture, which may not exist, # in which case fork will not be followed by exec, and valgrind will issue # "still reachable" reports. platform::identify } -result {^([^-]+-)+[^-]+$} test platform-4.2 {format of platform::generic result} -match regexp -body { platform::generic } -result {^([^-]+-)+[^-]+$} # cleanup cleanupTests } namespace delete ::tcl::test::platform return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/proc-old.test0000644000175000017500000003525614554262142015437 0ustar sergeisergei# Commands covered: proc, return, global # # This file, proc-old.test, includes the original set of tests for Tcl's # proc, return, and global commands. There is now a new file proc.test # that contains tests for the tclProc.c source file. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } catch {rename t1 ""} catch {rename foo ""} proc tproc {} {return a; return b} test proc-old-1.1 {simple procedure call and return} {tproc} a proc tproc x { set x [expr {$x + 1}] return $x } test proc-old-1.2 {simple procedure call and return} {tproc 2} 3 test proc-old-1.3 {simple procedure call and return} { proc tproc {} {return foo} } {} test proc-old-1.4 {simple procedure call and return} { proc tproc {} {return} tproc } {} proc tproc1 {a} {incr a; return $a} proc tproc2 {a b} {incr a; return $a} test proc-old-1.5 {simple procedure call and return (2 procs with same body but different parameters)} { list [tproc1 123] [tproc2 456 789] } {124 457} test proc-old-1.6 {simple procedure call and return (shared proc body string)} { set x {} proc tproc {} {} ;# body is shared with x list [tproc] [append x foo] } {{} foo} test proc-old-2.1 {local and global variables} { proc tproc x { set x [expr {$x + 1}] return $x } set x 42 list [tproc 6] $x } {7 42} test proc-old-2.2 {local and global variables} { proc tproc x { set y [expr {$x + 1}] return $y } set y 18 list [tproc 6] $y } {7 18} test proc-old-2.3 {local and global variables} { proc tproc x { global y set y [expr {$x + 1}] return $y } set y 189 list [tproc 6] $y } {7 7} test proc-old-2.4 {local and global variables} { proc tproc x { global y return [expr {$x + $y}] } set y 189 list [tproc 6] $y } {195 189} catch {unset _undefined_} test proc-old-2.5 {local and global variables} { proc tproc x { global _undefined_ return $_undefined_ } list [catch {tproc xxx} msg] $msg } {1 {can't read "_undefined_": no such variable}} test proc-old-2.6 {local and global variables} { set a 114 set b 115 global a b list $a $b } {114 115} proc do {cmd} {eval $cmd} test proc-old-3.1 {local and global arrays} { catch {unset a} set a(0) 22 list [catch {do {global a; set a(0)}} msg] $msg } {0 22} test proc-old-3.2 {local and global arrays} { catch {unset a} set a(x) 22 list [catch {do {global a; set a(x) newValue}} msg] $msg $a(x) } {0 newValue newValue} test proc-old-3.3 {local and global arrays} { catch {unset a} set a(x) 22 set a(y) 33 list [catch {do {global a; unset a(y)}; array names a} msg] $msg } {0 x} test proc-old-3.4 {local and global arrays} { catch {unset a} set a(x) 22 set a(y) 33 list [catch {do {global a; unset a; info exists a}} msg] $msg \ [info exists a] } {0 0 0} test proc-old-3.5 {local and global arrays} { catch {unset a} set a(x) 22 set a(y) 33 list [catch {do {global a; unset a(y); array names a}} msg] $msg } {0 x} catch {unset a} test proc-old-3.6 {local and global arrays} { catch {unset a} set a(x) 22 set a(y) 33 do {global a; do {global a; unset a}; set a(z) 22} list [catch {array names a} msg] $msg } {0 z} test proc-old-3.7 {local and global arrays} { proc t1 {args} {global info; set info 1} catch {unset a} set info {} do {global a; trace add var a(1) write t1} set a(1) 44 set info } 1 test proc-old-3.8 {local and global arrays} { proc t1 {args} {global info; set info 1} catch {unset a} trace add var a(1) write t1 set info {} do {global a; trace remove variable a(1) write t1} set a(1) 44 set info } {} test proc-old-3.9 {local and global arrays} { proc t1 {args} {global info; set info 1} catch {unset a} trace add var a(1) write t1 do {global a; trace info var a(1)} } {{write t1}} catch {unset a} test proc-old-30.1 {arguments and defaults} { proc tproc {x y z} { return [list $x $y $z] } tproc 11 12 13 } {11 12 13} test proc-old-30.2 {arguments and defaults} { proc tproc {x y z} { return [list $x $y $z] } list [catch {tproc 11 12} msg] $msg } {1 {wrong # args: should be "tproc x y z"}} test proc-old-30.3 {arguments and defaults} { proc tproc {x y z} { return [list $x $y $z] } list [catch {tproc 11 12 13 14} msg] $msg } {1 {wrong # args: should be "tproc x y z"}} test proc-old-30.4 {arguments and defaults} { proc tproc {x {y y-default} {z z-default}} { return [list $x $y $z] } tproc 11 12 13 } {11 12 13} test proc-old-30.5 {arguments and defaults} { proc tproc {x {y y-default} {z z-default}} { return [list $x $y $z] } tproc 11 12 } {11 12 z-default} test proc-old-30.6 {arguments and defaults} { proc tproc {x {y y-default} {z z-default}} { return [list $x $y $z] } tproc 11 } {11 y-default z-default} test proc-old-30.7 {arguments and defaults} { proc tproc {x {y y-default} {z z-default}} { return [list $x $y $z] } list [catch {tproc} msg] $msg } {1 {wrong # args: should be "tproc x ?y? ?z?"}} test proc-old-30.8 {arguments and defaults} { list [catch { proc tproc {x {y y-default} z} { return [list $x $y $z] } tproc 2 3 } msg] $msg } {1 {wrong # args: should be "tproc x ?y? z"}} test proc-old-30.9 {arguments and defaults} { proc tproc {x {y y-default} args} { return [list $x $y $args] } tproc 2 3 4 5 } {2 3 {4 5}} test proc-old-30.10 {arguments and defaults} { proc tproc {x {y y-default} args} { return [list $x $y $args] } tproc 2 3 } {2 3 {}} test proc-old-30.11 {arguments and defaults} { proc tproc {x {y y-default} args} { return [list $x $y $args] } tproc 2 } {2 y-default {}} test proc-old-30.12 {arguments and defaults} { proc tproc {x {y y-default} args} { return [list $x $y $args] } list [catch {tproc} msg] $msg } {1 {wrong # args: should be "tproc x ?y? ?arg ...?"}} test proc-old-4.1 {variable numbers of arguments} { proc tproc args {return $args} tproc } {} test proc-old-4.2 {variable numbers of arguments} { proc tproc args {return $args} tproc 1 2 3 4 5 6 7 8 } {1 2 3 4 5 6 7 8} test proc-old-4.3 {variable numbers of arguments} { proc tproc args {return $args} tproc 1 {2 3} {4 {5 6} {{{7}}}} 8 } {1 {2 3} {4 {5 6} {{{7}}}} 8} test proc-old-4.4 {variable numbers of arguments} { proc tproc {x y args} {return $args} tproc 1 2 3 4 5 6 7 } {3 4 5 6 7} test proc-old-4.5 {variable numbers of arguments} { proc tproc {x y args} {return $args} tproc 1 2 } {} test proc-old-4.6 {variable numbers of arguments} { proc tproc {x missing args} {return $args} list [catch {tproc 1} msg] $msg } {1 {wrong # args: should be "tproc x missing ?arg ...?"}} test proc-old-5.1 {error conditions} { list [catch {proc} msg] $msg } {1 {wrong # args: should be "proc name args body"}} test proc-old-5.2 {error conditions} { list [catch {proc tproc b} msg] $msg } {1 {wrong # args: should be "proc name args body"}} test proc-old-5.3 {error conditions} { list [catch {proc tproc b c d e} msg] $msg } {1 {wrong # args: should be "proc name args body"}} test proc-old-5.4 {error conditions} { list [catch {proc tproc \{xyz {return foo}} msg] $msg } {1 {unmatched open brace in list}} test proc-old-5.5 {error conditions} { list [catch {proc tproc {{} y} {return foo}} msg] $msg } {1 {argument with no name}} test proc-old-5.6 {error conditions} { list [catch {proc tproc {{} y} {return foo}} msg] $msg } {1 {argument with no name}} test proc-old-5.7 {error conditions} { list [catch {proc tproc {{x 1 2} y} {return foo}} msg] $msg } {1 {too many fields in argument specifier "x 1 2"}} test proc-old-5.8 {error conditions} { catch {return} } 2 proc tproc {} { set a 22 global a } test proc-old-5.10 {error conditions} { list [catch {tproc} msg] $msg } {1 {variable "a" already exists}} test proc-old-5.11 {error conditions} { catch {rename tproc {}} catch { proc tproc {x {} z} {return foo} } list [catch {tproc 1} msg] $msg } {1 {invalid command name "tproc"}} test proc-old-5.12 {error conditions} { proc tproc {} { set a 22 error "error in procedure" return } list [catch tproc msg] $msg } {1 {error in procedure}} test proc-old-5.13 {error conditions} { proc tproc {} { set a 22 error "error in procedure" return } catch tproc msg set ::errorInfo } {error in procedure while executing "error "error in procedure"" (procedure "tproc" line 3) invoked from within "tproc"} test proc-old-5.14 {error conditions} { proc tproc {} { set a 22 break return } catch tproc msg set ::errorInfo } {invoked "break" outside of a loop (procedure "tproc" line 1) invoked from within "tproc"} test proc-old-5.15 {error conditions} { proc tproc {} { set a 22 continue return } catch tproc msg set ::errorInfo } {invoked "continue" outside of a loop (procedure "tproc" line 1) invoked from within "tproc"} test proc-old-5.16 {error conditions} { proc foo args { global fooMsg set fooMsg "foo was called: $args" } proc tproc {} { set x 44 trace add var x unset foo while {$x < 100} { error "Nested error" } } set fooMsg "foo not called" list [catch tproc msg] $msg $::errorInfo $fooMsg } {1 {Nested error} {Nested error while executing "error "Nested error"" (procedure "tproc" line 5) invoked from within "tproc"} {foo was called: x {} unset}} # The tests below will really only be useful when run under Purify or # some other system that can detect accesses to freed memory... test proc-old-6.1 {procedure that redefines itself} { proc tproc {} { proc tproc {} { return 44 } return 45 } tproc } 45 test proc-old-6.2 {procedure that deletes itself} { proc tproc {} { rename tproc {} return 45 } tproc } 45 proc tproc code { return -code $code abc } test proc-old-7.1 {return with special completion code} { list [catch {tproc ok} msg] $msg } {0 abc} test proc-old-7.2 {return with special completion code} { list [catch {tproc error} msg] $msg $::errorInfo $::errorCode } {1 abc {abc while executing "tproc error"} NONE} test proc-old-7.3 {return with special completion code} { list [catch {tproc return} msg] $msg } {2 abc} test proc-old-7.4 {return with special completion code} { list [catch {tproc break} msg] $msg } {3 abc} test proc-old-7.5 {return with special completion code} { list [catch {tproc continue} msg] $msg } {4 abc} test proc-old-7.6 {return with special completion code} { list [catch {tproc -14} msg] $msg } {-14 abc} test proc-old-7.7 {return with special completion code} -body { tproc err } -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} test proc-old-7.8 {return with special completion code} -body { tproc 10b } -returnCodes error -match glob -result {bad completion code "10b": must be ok, error, return, break, continue*, or an integer} test proc-old-7.9 {return with special completion code} { proc tproc2 {} { tproc return } list [catch tproc2 msg] $msg } {0 abc} test proc-old-7.10 {return with special completion code} { proc tproc2 {} { return -code error } list [catch tproc2 msg] $msg } {1 {}} test proc-old-7.11 {return with special completion code} { proc tproc2 {} { global errorCode errorInfo catch {open _bad_file_name r} msg return -code error -errorinfo $errorInfo -errorcode $errorCode $msg } set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode] regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "open _bad_file_name r" invoked from within "tproc2"} {posix enoent {no such file or directory}}} test proc-old-7.12 {return with special completion code} { proc tproc2 {} { global errorCode errorInfo catch {open _bad_file_name r} msg return -code error -errorcode $errorCode $msg } set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode] regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "tproc2"} {posix enoent {no such file or directory}}} test proc-old-7.13 {return with special completion code} { proc tproc2 {} { global errorCode errorInfo catch {open _bad_file_name r} msg return -code error -errorinfo $errorInfo $msg } set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode] regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "open _bad_file_name r" invoked from within "tproc2"} none} test proc-old-7.14 {return with special completion code} { proc tproc2 {} { global errorCode errorInfo catch {open _bad_file_name r} msg return -code error $msg } set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode] regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "tproc2"} none} test proc-old-7.15 {return with special completion code} { list [catch {return -badOption foo message} msg] $msg } {2 message} test proc-old-8.1 {unset and undefined local arrays} { proc t1 {} { foreach v {xxx, yyy} { catch {unset $v} } set yyy(foo) bar } t1 } bar test proc-old-9.1 {empty command name} { catch {rename {} ""} proc t1 {args} { return } set v [t1] catch {$v} } 1 test proc-old-10.1 {ByteCode epoch change during recursive proc execution} { proc t1 x { set y 20 rename expr expr.old rename expr.old expr if {$x} then {t1 0} ;# recursive call after foo's code is invalidated return 20 } t1 1 } 20 # cleanup catch {rename t1 ""} catch {rename foo ""} ::tcltest::cleanupTests return tcl8.6.14/tests/proc.test0000644000175000017500000003344014554262142014654 0ustar sergeisergei# This file contains tests for the tclProc.c source file. Tests appear in the # same order as the C code that they test. The set of tests is currently # incomplete since it includes only new tests, in particular tests for code # changed for the addition of Tcl namespaces. Other procedure-related tests # appear in other test files such as proc-old.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint procbodytest [expr {![catch {package require procbodytest}]}] testConstraint memory [llength [info commands memory]] catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename {} ""} catch {unset msg} test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { namespace eval baz {} } proc test_ns_1::baz::p {} { return "p in [namespace current]" } list [test_ns_1::baz::p] \ [namespace eval test_ns_1 {baz::p}] \ [info commands test_ns_1::baz::*] } -result {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p} test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -returnCodes error -body { proc test_ns_1::baz::p {} {} } -result {can't create procedure "test_ns_1::baz::p": unknown namespace} test proc-1.3 {Tcl_ProcObjCmd, empty proc name} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { proc :: {} { return "empty called" } list [::] \ [info body {}] } -result {{empty called} { return "empty called" }} test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { namespace eval baz { proc p {} { return "p in [namespace current]" } } } list [test_ns_1::baz::p] \ [info commands test_ns_1::baz::*] } -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p} test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1::baz {} namespace eval test_ns_1 { proc baz::p {} { return "p in [namespace current]" } } list [test_ns_1::baz::p] \ [info commands test_ns_1::baz::*] \ [namespace eval test_ns_1::baz {namespace which p}] } -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p} test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { proc q: {} {return "q:"} proc value:at: {} {return "value:at:"} } list [namespace eval test_ns_1 {q:}] \ [namespace eval test_ns_1 {value:at:}] \ [test_ns_1::q:] \ [test_ns_1::value:at:] \ [lsort [info commands test_ns_1::*]] \ [namespace eval test_ns_1 {namespace which q:}] \ [namespace eval test_ns_1 {namespace which value:at:}] } -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:} test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup { catch {rename p ""} } -returnCodes error -body { proc p {a(1) a(2)} { set z [expr {$a(1)+$a(2)}] puts "$z=z, $a(1)=$a(1)" } } -result {formal parameter "a(1)" is an array element} test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup { catch {rename p ""} } -body { proc p {b:a b::a} { } } -returnCodes error -result {formal parameter "b::a" is not a simple name} test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body { set v 2 binary scan AB cc a b proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}} p } -result [expr {65+66+4}] -cleanup { rename p {} } test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} } -body { proc p {} {return "p in [namespace current]"} info body p } -result {return "p in [namespace current]"} test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { namespace eval baz { proc p {} {return "p in [namespace current]"} } } namespace eval test_ns_1::baz {info body p} } -result {return "p in [namespace current]"} test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1::baz {} namespace eval test_ns_1 { proc baz::p {} {return "p in [namespace current]"} } namespace eval test_ns_1 {info body baz::p} } -result {return "p in [namespace current]"} test proc-2.4 {TclFindProc, global proc and executing in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} } -body { proc p {} {return "global p"} namespace eval test_ns_1::baz {info body p} } -result {return "global p"} test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { proc p {} {return "p in [namespace current]"} p } -result {p in ::} test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1::baz { proc p {} {return "p in [namespace current]"} p } } -result {p in ::test_ns_1::baz} test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} } -body { proc p {} {return "p in [namespace current]"} namespace eval test_ns_1::baz { p } } -result {p in ::} test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} } -body { namespace eval test_ns_1::baz { proc p {} {return "p in [namespace current]"} rename ::test_ns_1::baz::p ::p list [p] [namespace which p] } } -result {{p in ::} ::p} test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} -body { proc p {x} {info commands 3m} p } -returnCodes error -result {wrong # args: should be "p x"} test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} -body { proc {a b c} {x} {info commands 3m} {a b c} } -returnCodes error -result {wrong # args: should be "{a b c} x"} test proc-3.7 {TclObjInterpProc, wrong num args, Bug 3366265} { proc {} {x} {} list [catch {{}} msg] $msg } {1 {wrong # args: should be "{} x"}} catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename {} ""} catch {rename {a b c} {}} catch {unset msg} catch {rename p ""} catch {rename t ""} # Note that the test require that procedures whose body is used to create # procbody objects must be executed before the procbodytest::proc command is # executed, so that the Proc struct is populated correctly (CompiledLocals are # added at compile time). test proc-4.1 {TclCreateProc, procbody obj} -constraints procbodytest -body { proc p x {return "$x:$x"} set rv [p P] procbodytest::proc t x p lappend rv [t T] } -cleanup { catch {rename p ""} catch {rename t ""} } -result {P:P T:T} test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} -body { proc p x { set y [string tolower $x] return "$x:$y" } set rv [p P] procbodytest::proc t x p lappend rv [t T] } -constraints procbodytest -cleanup { catch {rename p ""} catch {rename t ""} } -result {P:p T:t} test proc-4.3 {TclCreateProc, procbody obj, too many args} -body { proc p x { set y [string tolower $x] return "$x:$y" } set rv [p P] procbodytest::proc t {x x1 x2} p lappend rv [t T] } -constraints procbodytest -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": arg list contains 3 entries, precompiled header expects 1} test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} -body { proc p {x y z} { set v [join [list $x $y $z]] set w [string tolower $v] return "$v:$w" } set rv [p P Q R] procbodytest::proc t {x x1 z} p lappend rv [t S T U] } -constraints procbodytest -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": formal parameter 1 is inconsistent with precompiled body} test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} -body { proc p {x y {z Z}} { set v [join [list $x $y $z]] set w [string tolower $v] return "$v:$w" } set rv [p P Q R] procbodytest::proc t {x y z} p lappend rv [t S T U] } -constraints procbodytest -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": formal parameter 2 is inconsistent with precompiled body} test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} -body { proc p {x y z} { set v [join [list $x $y $z]] set w [string tolower $v] return "$v:$w" } set rv [p P Q R] procbodytest::proc t {x y {z Z}} p lappend rv [t S T U] } -returnCodes error -constraints procbodytest -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": formal parameter 2 is inconsistent with precompiled body} test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} -body { proc p {x y {z Z}} { set v [join [list $x $y $z]] set w [string tolower $v] return "$v:$w" } set rv [p P Q R] procbodytest::proc t {x y {z ZZ}} p lappend rv [t S T U] } -constraints procbodytest -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": formal parameter "z" has default value inconsistent with precompiled body} test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex $lines 3 3 } proc px x { set y [string tolower $x] return "$x:$y" } px x } -constraints {procbodytest memory} -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { procbodytest::proc tx x px set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { rename getbytes {} unset -nocomplain end i tmp leakedBytes } -result 0 test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} procbodytest { procbodytest::check } 1 test proc-4.10 { TclCreateProc, issue a8579d906a28, argument with no name } -body { catch { proc p1 [list [list [expr {1 + 2}] default]] {} } } -cleanup { catch {rename p1 {}} } -result 0 test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body { proc p args {} ; # this will be bytecompiled into t proc t {} { set res {} set a 0 set b 0 trace add variable a read {append res a ;#} trace add variable b write {append res b ;#} p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello set res } t } -cleanup { catch {rename p ""} catch {rename t ""} } -result {aba} test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} -body { proc a {} {return -code -5} proc b {} a catch b } -cleanup { rename a {} rename b {} } -result -5 test proc-7.1 {Redefining a compiled cmd: Bug 729692} { proc bar args {} proc foo {} { proc bar args {return bar} bar } foo } bar test proc-7.2 {Shadowing a compiled cmd: Bug 729692} -body { namespace eval ugly {} proc ugly::foo {} { proc set args {return bar} set x 1 } ugly::foo } -cleanup { namespace delete ugly } -result bar test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body { namespace eval ugly {} proc ugly::foo {} { set i 0 while { 1 } { if { [incr i] > 3 } { proc continue {} {return -code break} } continue } return $i } ugly::foo } -cleanup { namespace delete ugly } -result 4 test proc-7.4 {Proc struct outlives its interp: Bug 3532959} { set lambda x lappend lambda {set a 1} interp create child child eval [list apply $lambda foo] interp delete child unset lambda } {} test proc-7.5 {[631b4c45df] Crash in argument processing} { binary scan A c val proc foo [list [list from $val]] {} rename foo {} unset -nocomplain val } {} test proc-7.6 {[51d5f22997] Crash in argument processing} -cleanup { rename foo {} } -body { proc foo {{x {}} {y {}} args} {} foo } -result {} # cleanup catch {rename p ""} catch {rename t ""} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/pwd.test0000644000175000017500000000165314554262142014504 0ustar sergeisergei# Commands covered: pwd # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test pwd-1.1 {simple pwd} { catch pwd } 0 test pwd-1.2 {simple pwd} { expr {[string length [pwd]]>0} } 1 test pwd-2.1 {pwd takes no args} -body { pwd foobar } -returnCodes error -result "wrong \# args: should be \"pwd\"" # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/regexpComp.test0000644000175000017500000006502014554262142016021 0ustar sergeisergei# Commands covered: regexp, regsub # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Procedure to evaluate a script within a proc, to test compilation # functionality proc evalInProc { script } { proc testProc {} $script set status [catch { testProc } result] rename testProc {} return $result #return [list $status $result] } unset -nocomplain foo test regexpComp-1.1 {basic regexp operation} { evalInProc { regexp ab*c abbbc } } 1 test regexpComp-1.2 {basic regexp operation} { evalInProc { regexp ab*c ac } } 1 test regexpComp-1.3 {basic regexp operation} { evalInProc { regexp ab*c ab } } 0 test regexpComp-1.4 {basic regexp operation} { evalInProc { regexp -- -gorp abc-gorpxxx } } 1 test regexpComp-1.5 {basic regexp operation} { evalInProc { regexp {^([^ ]*)[ ]*([^ ]*)} "" a } } 1 test regexpComp-1.6 {basic regexp operation} { list [catch {regexp {} abc} msg] $msg } {0 1} test regexpComp-1.7 {regexp utf compliance} { # if not UTF-8 aware, result is "0 1" evalInProc { set foo "\u4e4eb q" regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar list [string compare $foo $bar] [regexp 4 $bar] } } {0 0} test regexpComp-1.8 {regexp ***= metasyntax} { evalInProc { regexp -- "***=o" "aeiou" } } 1 test regexpComp-1.9 {regexp ***= metasyntax} { evalInProc { set string "aeiou" regexp -- "***=o" $string } } 1 test regexpComp-1.10 {regexp ***= metasyntax} { evalInProc { set string "aeiou" set re "***=o" regexp -- $re $string } } 1 test regexpComp-1.11 {regexp ***= metasyntax} { evalInProc { regexp -- "***=y" "aeiou" } } 0 test regexpComp-1.12 {regexp ***= metasyntax} { evalInProc { set string "aeiou" regexp -- "***=y" $string } } 0 test regexpComp-1.13 {regexp ***= metasyntax} { evalInProc { set string "aeiou" set re "***=y" regexp -- $re $string } } 0 test regexpComp-1.14 {regexp ***= metasyntax} { evalInProc { set string "aeiou" set re "***=e*o" regexp -- $re $string } } 0 test regexpComp-1.15 {regexp ***= metasyntax} { evalInProc { set string "ae*ou" set re "***=e*o" regexp -- $re $string } } 1 test regexpComp-1.16 {regexp ***= metasyntax} { evalInProc { set string {ae*[o]?ua} set re {***=e*[o]?u} regexp -- $re $string } } 1 test regexpComp-2.1 {getting substrings back from regexp} { evalInProc { set foo {} list [regexp ab*c abbbbc foo] $foo } } {1 abbbbc} test regexpComp-2.2 {getting substrings back from regexp} { evalInProc { set foo {} set f2 {} list [regexp a(b*)c abbbbc foo f2] $foo $f2 } } {1 abbbbc bbbb} test regexpComp-2.3 {getting substrings back from regexp} { evalInProc { set foo {} set f2 {} list [regexp a(b*)(c) abbbbc foo f2] $foo $f2 } } {1 abbbbc bbbb} test regexpComp-2.4 {getting substrings back from regexp} { evalInProc { set foo {} set f2 {} set f3 {} list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3 } } {1 abbbbc bbbb c} test regexpComp-2.5 {getting substrings back from regexp} { evalInProc { set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {}; set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {}; list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \ 12223345556789999aabbb \ foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \ $f6 $f7 $f8 $f9 $fa $fb } } {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb} test regexpComp-2.6 {getting substrings back from regexp} { evalInProc { set foo 2; set f2 2; set f3 2; set f4 2 list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4 } } {1 a a {} {}} test regexpComp-2.7 {getting substrings back from regexp} { evalInProc { set foo 1; set f2 1; set f3 1; set f4 1 list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 } } {1 ac a {} c} test regexpComp-2.8 {getting substrings back from regexp} { evalInProc { set match {} list [regexp {^a*b} aaaab match] $match } } {1 aaaab} test regexpComp-3.1 {-indices option to regexp} { evalInProc { set foo {} list [regexp -indices ab*c abbbbc foo] $foo } } {1 {0 5}} test regexpComp-3.2 {-indices option to regexp} { evalInProc { set foo {} set f2 {} list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2 } } {1 {0 5} {1 4}} test regexpComp-3.3 {-indices option to regexp} { evalInProc { set foo {} set f2 {} list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2 } } {1 {0 5} {1 4}} test regexpComp-3.4 {-indices option to regexp} { evalInProc { set foo {} set f2 {} set f3 {} list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3 } } {1 {0 5} {1 4} {5 5}} test regexpComp-3.5 {-indices option to regexp} { evalInProc { set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {}; set f6 {}; set f7 {}; set f8 {}; set f9 {} list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \ 12223345556789999 \ foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \ $f6 $f7 $f8 $f9 } } {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}} test regexpComp-3.6 {getting substrings back from regexp} { evalInProc { set foo 2; set f2 2; set f3 2; set f4 2 list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4 } } {1 {1 1} {1 1} {-1 -1} {-1 -1}} test regexpComp-3.7 {getting substrings back from regexp} { evalInProc { set foo 1; set f2 1; set f3 1; set f4 1 list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 } } {1 {1 2} {1 1} {-1 -1} {2 2}} test regexpComp-4.1 {-nocase option to regexp} { evalInProc { regexp -nocase foo abcFOo } } 1 test regexpComp-4.2 {-nocase option to regexp} { evalInProc { set f1 22 set f2 33 set f3 44 list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3 } } {1 aBbbxYXxxZ Bbb xYXxx} test regexpComp-4.3 {-nocase option to regexp} { evalInProc { regexp -nocase FOo abcFOo } } 1 set ::x abcdefghijklmnopqrstuvwxyz1234567890 set ::x $x$x$x$x$x$x$x$x$x$x$x$x test regexpComp-4.4 {case conversion in regexp} { evalInProc { list [regexp -nocase $::x $::x foo] $foo } } "1 $x" unset -nocomplain ::x test regexpComp-5.1 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*a bbba } } 1 test regexpComp-5.2 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*b xxxb } } 1 test regexpComp-5.3 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*c yyyc } } 1 test regexpComp-5.4 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*d 1d } } 1 test regexpComp-5.5 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*e xe } } 1 test regexpComp-6.1 {regexp errors} { evalInProc { list [catch {regexp a} msg] $msg } } {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} test regexpComp-6.2 {regexp errors} { evalInProc { list [catch {regexp -nocase a} msg] $msg } } {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} test regexpComp-6.3 {regexp errors} { evalInProc { list [catch {regexp -gorp a} msg] $msg } } {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}} test regexpComp-6.4 {regexp errors} { evalInProc { list [catch {regexp a( b} msg] $msg } } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexpComp-6.5 {regexp errors} { evalInProc { list [catch {regexp a( b} msg] $msg } } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexpComp-6.6 {regexp errors} { evalInProc { list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg } } {0 1} test regexpComp-6.7 {regexp errors} { evalInProc { list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg } } {0 0} test regexpComp-6.8 {regexp errors} { evalInProc { unset -nocomplain f1 set f1 44 list [catch {regexp abc abc f1(f2)} msg] $msg } } {1 {can't set "f1(f2)": variable isn't array}} test regexpComp-6.9 {regexp errors, -start bad int check} { evalInProc { list [catch {regexp -start bogus {^$} {}} msg] $msg } } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexpComp-7.1 {basic regsub operation} { evalInProc { list [regsub aa+ xaxaaaxaa 111&222 foo] $foo } } {1 xax111aaa222xaa} test regexpComp-7.2 {basic regsub operation} { evalInProc { list [regsub aa+ aaaxaa &111 foo] $foo } } {1 aaa111xaa} test regexpComp-7.3 {basic regsub operation} { evalInProc { list [regsub aa+ xaxaaa 111& foo] $foo } } {1 xax111aaa} test regexpComp-7.4 {basic regsub operation} { evalInProc { list [regsub aa+ aaa 11&2&333 foo] $foo } } {1 11aaa2aaa333} test regexpComp-7.5 {basic regsub operation} { evalInProc { list [regsub aa+ xaxaaaxaa &2&333 foo] $foo } } {1 xaxaaa2aaa333xaa} test regexpComp-7.6 {basic regsub operation} { evalInProc { list [regsub aa+ xaxaaaxaa 1&22& foo] $foo } } {1 xax1aaa22aaaxaa} test regexpComp-7.7 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo } } {1 xax1aa22aaxaa} test regexpComp-7.8 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo } } "1 {xax1\\aa22aaxaa}" test regexpComp-7.9 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo } } "1 {xax1\\122aaxaa}" test regexpComp-7.10 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo } } "1 {xax1\\aaaaaxaa}" test regexpComp-7.11 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo } } {1 xax1&aaxaa} test regexpComp-7.12 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo } } {1 xaxaaaaaaaaaaaaaaxaa} test regexpComp-7.13 {basic regsub operation} { evalInProc { set foo xxx list [regsub abc xyz 111 foo] $foo } } {0 xyz} test regexpComp-7.14 {basic regsub operation} { evalInProc { set foo xxx list [regsub ^ xyz "111 " foo] $foo } } {1 {111 xyz}} test regexpComp-7.15 {basic regsub operation} { evalInProc { set foo xxx list [regsub -- -foo abc-foodef "111 " foo] $foo } } {1 {abc111 def}} test regexpComp-7.16 {basic regsub operation} { evalInProc { set foo xxx list [regsub x "" y foo] $foo } } {0 {}} test regexpComp-7.17 {regsub utf compliance} { evalInProc { # if not UTF-8 aware, result is "0 1" set foo "xyz555ijka\u4e4ebpqr" regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar list [string compare $foo $bar] [regexp 4 $bar] } } {0 0} test regexpComp-8.1 {case conversion in regsub} { evalInProc { list [regsub -nocase a(a+) xaAAaAAay & foo] $foo } } {1 xaAAaAAay} test regexpComp-8.2 {case conversion in regsub} { evalInProc { list [regsub -nocase a(a+) xaAAaAAay & foo] $foo } } {1 xaAAaAAay} test regexpComp-8.3 {case conversion in regsub} { evalInProc { set foo 123 list [regsub a(a+) xaAAaAAay & foo] $foo } } {0 xaAAaAAay} test regexpComp-8.4 {case conversion in regsub} { evalInProc { set foo 123 list [regsub -nocase a CaDE b foo] $foo } } {1 CbDE} test regexpComp-8.5 {case conversion in regsub} { evalInProc { set foo 123 list [regsub -nocase XYZ CxYzD b foo] $foo } } {1 CbD} test regexpComp-8.6 {case conversion in regsub} { evalInProc { set x abcdefghijklmnopqrstuvwxyz1234567890 set x $x$x$x$x$x$x$x$x$x$x$x$x set foo 123 list [regsub -nocase $x $x b foo] $foo } } {1 b} test regexpComp-9.1 {-all option to regsub} { evalInProc { set foo 86 list [regsub -all x+ axxxbxxcxdx |&| foo] $foo } } {4 a|xxx|b|xx|c|x|d|x|} test regexpComp-9.2 {-all option to regsub} { evalInProc { set foo 86 list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo } } {4 a|XxX|b|xx|c|X|d|x|} test regexpComp-9.3 {-all option to regsub} { evalInProc { set foo 86 list [regsub x+ axxxbxxcxdx |&| foo] $foo } } {1 a|xxx|bxxcxdx} test regexpComp-9.4 {-all option to regsub} { evalInProc { set foo 86 list [regsub -all bc axxxbxxcxdx |&| foo] $foo } } {0 axxxbxxcxdx} test regexpComp-9.5 {-all option to regsub} { evalInProc { set foo xxx list [regsub -all node "node node more" yy foo] $foo } } {2 {yy yy more}} test regexpComp-9.6 {-all option to regsub} { evalInProc { set foo xxx list [regsub -all ^ xxx 123 foo] $foo } } {1 123xxx} test regexpComp-9.7 {Bug 84af1192f5: -all option to regsub} { evalInProc { regsub -all {\(.*} 123(qwe) "" } } 123 test regexpComp-10.1 {expanded syntax in regsub} { evalInProc { set foo xxx list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo } } {1 defc} test regexpComp-10.2 {newline sensitivity in regsub} { evalInProc { set foo xxx list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo } } "1 {dabc\n123\n}" test regexpComp-10.3 {newline sensitivity in regsub} { evalInProc { set foo xxx list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo } } "1 {dabc\n123\nxb}" test regexpComp-10.4 {partial newline sensitivity in regsub} { evalInProc { set foo xxx list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo } } "1 {da\n123}" test regexpComp-10.5 {inverse partial newline sensitivity in regsub} { evalInProc { set foo xxx list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo } } "1 {da\nb123\nxb}" test regexpComp-11.1 {regsub errors} { evalInProc { list [catch {regsub a b} msg] $msg } } {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexpComp-11.2 {regsub errors} { evalInProc { list [catch {regsub -nocase a b} msg] $msg } } {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexpComp-11.3 {regsub errors} { evalInProc { list [catch {regsub -nocase -all a b} msg] $msg } } {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexpComp-11.4 {regsub errors} { evalInProc { list [catch {regsub a b c d e f} msg] $msg } } {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexpComp-11.5 {regsub errors} { evalInProc { list [catch {regsub -gorp a b c} msg] $msg } } {1 {bad option "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}} test regexpComp-11.6 {regsub errors} { evalInProc { list [catch {regsub -nocase a( b c d} msg] $msg } } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexpComp-11.7 {regsub errors} { evalInProc { unset -nocomplain f1 set f1 44 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg } } {1 {can't set "f1(f2)": variable isn't array}} test regexpComp-11.8 {regsub errors, -start bad int check} { evalInProc { list [catch {regsub -start bogus pattern string rep var} msg] $msg } } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} # This test crashes on the Mac unless you increase the Stack Space to about 1 # Meg. This is probably bigger than most users want... # 8.2.3 regexp reduced stack space requirements, but this should be # tested again test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} { evalInProc { list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z } } {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z} test regexpComp-13.1 {regsub of a very large string} { # This test is designed to stress the memory subsystem in order # to catch Bug #933. It only fails if the Tcl memory allocator # is in use. set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE} set filedata [string repeat $line 200] for {set i 1} {$i<10} {incr i} { regsub -all "BEGIN_TABLE " $filedata "" newfiledata } set x done } {done} test regexpComp-14.1 {CompileRegexp: regexp cache} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f set x . append x *a regexp $x bbba } } 1 test regexpComp-14.2 {CompileRegexp: regexp cache, different flags} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f set x . append x *a regexp -nocase $x bbba } } 1 testConstraint exec [llength [info commands exec]] test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -constraints { exec } -setup { set junk [makeFile {puts [regexp {} foo]} junk.tcl] } -body { exec [interpreter] $junk } -cleanup { removeFile junk.tcl } -result 1 test regexpComp-15.1 {regexp -start} { unset -nocomplain x list [regexp -start -10 {\d} 1abc2de3 x] $x } {1 1} test regexpComp-15.2 {regexp -start} { unset -nocomplain x list [regexp -start 2 {\d} 1abc2de3 x] $x } {1 2} test regexpComp-15.3 {regexp -start} { unset -nocomplain x list [regexp -start 4 {\d} 1abc2de3 x] $x } {1 2} test regexpComp-15.4 {regexp -start} { unset -nocomplain x list [regexp -start 5 {\d} 1abc2de3 x] $x } {1 3} test regexpComp-15.5 {regexp -start, over end of string} { unset -nocomplain x list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] } {0 0} test regexpComp-15.6 {regexp -start, loss of ^$ behavior} { list [regexp -start 2 {^$} {}] } {0} test regexpComp-16.1 {regsub -start} { unset -nocomplain x list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x } {4 a1b/2c/3d/4e/5} test regexpComp-16.2 {regsub -start} { unset -nocomplain x list [regsub -all -start -25 {z} hello {/&} x] $x } {0 hello} test regexpComp-16.3 {regsub -start} { unset -nocomplain x list [regsub -all -start 3 {z} hello {/&} x] $x } {0 hello} test regexpComp-16.4 {regsub -start, \A behavior} { set out {} lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x } {5 /a/b/c/d/e 3 ab/c/d/e} test regexpComp-17.1 {regexp -inline} { regexp -inline b ababa } {b} test regexpComp-17.2 {regexp -inline} { regexp -inline (b) ababa } {b b} test regexpComp-17.3 {regexp -inline -indices} { regexp -inline -indices (b) ababa } {{1 1} {1 1}} test regexpComp-17.4 {regexp -inline} { regexp -inline {\w(\d+)\w} " hello 23 there456def " } {e456d 456} test regexpComp-17.5 {regexp -inline no matches} { regexp -inline {\w(\d+)\w} "" } {} test regexpComp-17.6 {regexp -inline no matches} { regexp -inline hello goodbye } {} test regexpComp-17.7 {regexp -inline, no matchvars allowed} { list [catch {regexp -inline b abc match} msg] $msg } {1 {regexp match variables not allowed when using -inline}} test regexpComp-18.1 {regexp -all} { regexp -all b bbbbb } {5} test regexpComp-18.2 {regexp -all} { regexp -all b abababbabaaaaaaaaaab } {6} test regexpComp-18.3 {regexp -all -inline} { regexp -all -inline b abababbabaaaaaaaaaab } {b b b b b b} test regexpComp-18.4 {regexp -all -inline} { regexp -all -inline {\w(\w)} abcdefg } {ab b cd d ef f} test regexpComp-18.5 {regexp -all -inline} { regexp -all -inline {\w(\w)$} abcdefg } {fg g} test regexpComp-18.6 {regexp -all -inline} { regexp -all -inline {\d+} 10:20:30:40 } {10 20 30 40} test regexpComp-18.7 {regexp -all -inline} { list [catch {regexp -all -inline b abc match} msg] $msg } {1 {regexp match variables not allowed when using -inline}} test regexpComp-18.8 {regexp -all} { # This should not cause an infinite loop regexp -all -inline {a*} a } {a} test regexpComp-18.9 {regexp -all} { # Yes, the expected result is {a {}}. Here's why: # Start at index 0; a* matches the "a" there then stops. # Go to index 1; a* matches the lambda (or {}) there then stops. Recall # that a* matches zero or more "a"'s; thus it matches the string "b", as # there are zero or more "a"'s there. # Go to index 2; this is past the end of the string, so stop. regexp -all -inline {a*} ab } {a {}} test regexpComp-18.10 {regexp -all} { # Yes, the expected result is {a {} a}. Here's why: # Start at index 0; a* matches the "a" there then stops. # Go to index 1; a* matches the lambda (or {}) there then stops. Recall # that a* matches zero or more "a"'s; thus it matches the string "b", as # there are zero or more "a"'s there. # Go to index 2; a* matches the "a" there then stops. # Go to index 3; this is past the end of the string, so stop. regexp -all -inline {a*} aba } {a {} a} test regexpComp-18.11 {regexp -all} { evalInProc { regexp -all -inline {^a} aaaa } } {a} test regexpComp-18.12 {regexp -all -inline -indices} { evalInProc { regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh } } {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}} test regexpComp-19.1 {regsub null replacement} { evalInProc { regsub -all {@} {@hel@lo@} "\0a\0" result list $result [string length $result] } } "\0a\0hel\0a\0lo\0a\0 14" test regexpComp-20.1 {regsub shared object shimmering} { evalInProc { # Bug #461322 set a abcdefghijklmnopqurstuvwxyz set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d list $d [string length $d] [string bytelength $d] } } [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] test regexpComp-20.2 {regsub shared object shimmering with -about} { evalInProc { eval regexp -about abc } } {0 {}} test regexpComp-21.1 {regexp command compiling tests} { evalInProc { regexp foo bar } } 0 test regexpComp-21.2 {regexp command compiling tests} { evalInProc { regexp {^foo$} dogfood } } 0 test regexpComp-21.3 {regexp command compiling tests} { evalInProc { set a foo regexp {^foo$} $a } } 1 test regexpComp-21.4 {regexp command compiling tests} { evalInProc { regexp foo dogfood } } 1 test regexpComp-21.5 {regexp command compiling tests} { evalInProc { regexp -nocase FOO dogfod } } 0 test regexpComp-21.6 {regexp command compiling tests} { evalInProc { regexp -n foo dogfoOd } } 1 test regexpComp-21.7 {regexp command compiling tests} { evalInProc { regexp -no -- FoO dogfood } } 1 test regexpComp-21.8 {regexp command compiling tests} { evalInProc { regexp -- foo dogfod } } 0 test regexpComp-21.9 {regexp command compiling tests} { evalInProc { list [catch {regexp -- -nocase foo dogfod} msg] $msg } } {0 0} test regexpComp-21.10 {regexp command compiling tests} { evalInProc { list [regsub -all "" foo bar str] $str } } {3 barfbarobaro} test regexpComp-21.11 {regexp command compiling tests} { evalInProc { list [regsub -all "" "" bar str] $str } } {0 {}} test regexpComp-22.0.1 {Bug 1810038} { evalInProc { regexp ($|^X)* {} } } 1 test regexpComp-22.0.2 {regexp compile and backrefs, Bug 1857126} { evalInProc { regexp -- {([bc])\1} bb } } 1 set i 0 foreach {str exp result} { foo ^foo 1 foobar ^foobar$ 1 foobar bar$ 1 foobar ^$ 0 "" ^$ 1 anything $ 1 anything ^.*$ 1 anything ^.*a$ 0 anything ^.*a.*$ 1 anything ^.*.*$ 1 anything ^.*..*$ 1 anything ^.*b$ 0 anything ^a.*$ 1 } { test regexpComp-22.[incr i] {regexp command compiling tests} \ [subst {evalInProc {set a "$str"; regexp {$exp} \$a}}] $result } set i 0 foreach {str exp result} { foo ^foo 1 foobar ^foobar$ 1 foobar bar$ 1 foobar ^$ 0 "" ^$ 1 anything $ 1 anything ^.*$ 1 anything ^.*a$ 0 anything ^.*a.*$ 1 anything ^.*.*$ 1 anything ^.*..*$ 1 anything ^.*b$ 0 anything ^a.*$ 1 } { test regexpComp-23.[incr i] {regexp command compiling tests INST_REGEXP} \ [subst {evalInProc {set a "$str"; set re "$exp"; regexp \$re \$a}}] $result } test regexpComp-24.1 {regexp command compiling tests} { evalInProc { set re foo regexp -nocase $re bar } } 0 test regexpComp-24.2 {regexp command compiling tests} { evalInProc { set re {^foo$} regexp $re dogfood } } 0 test regexpComp-24.3 {regexp command compiling tests} { evalInProc { set a foo set re {^foo$} regexp $re $a } } 1 test regexpComp-24.4 {regexp command compiling tests} { evalInProc { set re foo regexp $re dogfood } } 1 test regexpComp-24.5 {regexp command compiling tests} { evalInProc { set re FOO regexp -nocase $re dogfod } } 0 test regexpComp-24.6 {regexp command compiling tests} { evalInProc { set re foo regexp -n $re dogfoOd } } 1 test regexpComp-24.7 {regexp command compiling tests} { evalInProc { set re FoO regexp -no -- $re dogfood } } 1 test regexpComp-24.8 {regexp command compiling tests} { evalInProc { set re foo regexp -- $re dogfod } } 0 test regexpComp-24.9 {regexp command compiling tests} { evalInProc { set re "(" list [catch {regexp -- $re dogfod} msg] $msg } } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexpComp-24.10 {regexp command compiling tests} { # Bug 1902436 - last * escaped evalInProc { set text {this is *bold* !} set re {\*bold\*} regexp -- $re $text } } 1 test regexpComp-24.11 {regexp command compiling tests} { # Bug 1902436 - last * escaped evalInProc { set text {this is *bold* !} set re {\*bold\*.*!} regexp -- $re $text } } 1 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/regexp.test0000644000175000017500000012021614554262142015201 0ustar sergeisergei# Commands covered: regexp, regsub # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } unset -nocomplain foo testConstraint exec [llength [info commands exec]] test regexp-1.1 {basic regexp operation} { regexp ab*c abbbc } 1 test regexp-1.2 {basic regexp operation} { regexp ab*c ac } 1 test regexp-1.3 {basic regexp operation} { regexp ab*c ab } 0 test regexp-1.4 {basic regexp operation} { regexp -- -gorp abc-gorpxxx } 1 test regexp-1.5 {basic regexp operation} { regexp {^([^ ]*)[ ]*([^ ]*)} "" a } 1 test regexp-1.6 {basic regexp operation} { list [catch {regexp {} abc} msg] $msg } {0 1} test regexp-1.7 {regexp utf compliance} { # if not UTF-8 aware, result is "0 1" set foo "\u4e4eb q" regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar list [string compare $foo $bar] [regexp 4 $bar] } {0 0} test regexp-1.8 {regexp ***= metasyntax} { regexp -- "***=o" "aeiou" } 1 test regexp-1.9 {regexp ***= metasyntax} { set string "aeiou" regexp -- "***=o" $string } 1 test regexp-1.10 {regexp ***= metasyntax} { set string "aeiou" set re "***=o" regexp -- $re $string } 1 test regexp-1.11 {regexp ***= metasyntax} { regexp -- "***=y" "aeiou" } 0 test regexp-1.12 {regexp ***= metasyntax} { set string "aeiou" regexp -- "***=y" $string } 0 test regexp-1.13 {regexp ***= metasyntax} { set string "aeiou" set re "***=y" regexp -- $re $string } 0 test regexp-2.1 {getting substrings back from regexp} { set foo {} list [regexp ab*c abbbbc foo] $foo } {1 abbbbc} test regexp-2.2 {getting substrings back from regexp} { set foo {} set f2 {} list [regexp a(b*)c abbbbc foo f2] $foo $f2 } {1 abbbbc bbbb} test regexp-2.3 {getting substrings back from regexp} { set foo {} set f2 {} list [regexp a(b*)(c) abbbbc foo f2] $foo $f2 } {1 abbbbc bbbb} test regexp-2.4 {getting substrings back from regexp} { set foo {} set f2 {} set f3 {} list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3 } {1 abbbbc bbbb c} test regexp-2.5 {getting substrings back from regexp} { set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {}; set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {}; list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \ 12223345556789999aabbb \ foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \ $f6 $f7 $f8 $f9 $fa $fb } {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb} test regexp-2.6 {getting substrings back from regexp} { set foo 2; set f2 2; set f3 2; set f4 2 list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4 } {1 a a {} {}} test regexp-2.7 {getting substrings back from regexp} { set foo 1; set f2 1; set f3 1; set f4 1 list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 } {1 ac a {} c} test regexp-2.8 {getting substrings back from regexp} { set match {} list [regexp {^a*b} aaaab match] $match } {1 aaaab} test regexp-2.9 {getting substrings back from regexp} { set foo {} set f2 {} list [regexp f\352te(b*)c f\352tebbbbc foo f2] $foo $f2 } [list 1 f\352tebbbbc bbbb] test regexp-2.10 {getting substrings back from regexp} { set foo {} set f2 {} list [regexp f\352te(b*)c eff\352tebbbbc foo f2] $foo $f2 } [list 1 f\352tebbbbc bbbb] test regexp-2.11 {non-capturing subgroup} { set foo {} set f2 {} list [regexp {str(?:a+)} straa foo f2] $foo $f2 } [list 1 straa {}] test regexp-2.12 {non-capturing subgroup with -inline} { regexp -inline {str(?:a+)} straa } {straa} test regexp-2.13 {non-capturing and capturing subgroups} { set foo {} set f2 {} set f3 {} list [regexp {str(?:a+)(c+)} straacc foo f2 f3] $foo $f2 $f3 } [list 1 straacc cc {}] test regexp-2.14 {non-capturing and capturing subgroups} { regexp -inline {str(?:a+)(c+)} straacc } {straacc cc} test regexp-2.15 {getting substrings back from regexp} { set foo NA set f2 NA list [regexp {str(?:a+)} straa foo f2] $foo $f2 } [list 1 straa {}] test regexp-3.1 {-indices option to regexp} { set foo {} list [regexp -indices ab*c abbbbc foo] $foo } {1 {0 5}} test regexp-3.2 {-indices option to regexp} { set foo {} set f2 {} list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2 } {1 {0 5} {1 4}} test regexp-3.3 {-indices option to regexp} { set foo {} set f2 {} list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2 } {1 {0 5} {1 4}} test regexp-3.4 {-indices option to regexp} { set foo {} set f2 {} set f3 {} list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3 } {1 {0 5} {1 4} {5 5}} test regexp-3.5 {-indices option to regexp} { set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {}; set f6 {}; set f7 {}; set f8 {}; set f9 {} list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \ 12223345556789999 \ foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \ $f6 $f7 $f8 $f9 } {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}} test regexp-3.6 {getting substrings back from regexp} { set foo 2; set f2 2; set f3 2; set f4 2 list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4 } {1 {1 1} {1 1} {-1 -1} {-1 -1}} test regexp-3.7 {getting substrings back from regexp} { set foo 1; set f2 1; set f3 1; set f4 1 list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 } {1 {1 2} {1 1} {-1 -1} {2 2}} test regexp-3.8a {-indices by multi-byte utf-8} { regexp -inline -indices {(\w+)-(\w+)} \ "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442" } {{0 10} {0 3} {5 10}} test regexp-3.8b {-indices by multi-byte utf-8, from -start position} { list\ [regexp -inline -indices -start 3 {(\w+)-(\w+)} \ "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] \ [regexp -inline -indices -start 4 {(\w+)-(\w+)} \ "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] } {{{3 10} {3 3} {5 10}} {}} test regexp-4.1 {-nocase option to regexp} { regexp -nocase foo abcFOo } 1 test regexp-4.2 {-nocase option to regexp} { set f1 22 set f2 33 set f3 44 list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3 } {1 aBbbxYXxxZ Bbb xYXxx} test regexp-4.3 {-nocase option to regexp} { regexp -nocase FOo abcFOo } 1 set x abcdefghijklmnopqrstuvwxyz1234567890 set x $x$x$x$x$x$x$x$x$x$x$x$x test regexp-4.4 {case conversion in regexp} { list [regexp -nocase $x $x foo] $foo } "1 $x" unset -nocomplain x test regexp-5.1 {exercise cache of compiled expressions} { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*a bbba } 1 test regexp-5.2 {exercise cache of compiled expressions} { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*b xxxb } 1 test regexp-5.3 {exercise cache of compiled expressions} { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*c yyyc } 1 test regexp-5.4 {exercise cache of compiled expressions} { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*d 1d } 1 test regexp-5.5 {exercise cache of compiled expressions} { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*e xe } 1 test regexp-6.1 {regexp errors} { list [catch {regexp a} msg] $msg } {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} test regexp-6.2 {regexp errors} { list [catch {regexp -nocase a} msg] $msg } {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} test regexp-6.3 {regexp errors} { list [catch {regexp -gorp a} msg] $msg } {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}} test regexp-6.4 {regexp errors} { list [catch {regexp a( b} msg] $msg } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexp-6.5 {regexp errors} { list [catch {regexp a( b} msg] $msg } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexp-6.6 {regexp errors} { list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg } {0 1} test regexp-6.7 {regexp errors} { list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg } {0 0} test regexp-6.8 {regexp errors} -setup { unset -nocomplain f1 } -body { set f1 44 regexp abc abc f1(f2) } -returnCodes error -result {can't set "f1(f2)": variable isn't array} test regexp-6.9 {regexp errors, -start bad int check} { list [catch {regexp -start bogus {^$} {}} msg] $msg } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexp-6.10 {regexp errors} { list [catch {regexp {a[} b} msg] $msg } {1 {couldn't compile regular expression pattern: brackets [] not balanced}} test regexp-7.1 {basic regsub operation} { list [regsub aa+ xaxaaaxaa 111&222 foo] $foo } {1 xax111aaa222xaa} test regexp-7.2 {basic regsub operation} { list [regsub aa+ aaaxaa &111 foo] $foo } {1 aaa111xaa} test regexp-7.3 {basic regsub operation} { list [regsub aa+ xaxaaa 111& foo] $foo } {1 xax111aaa} test regexp-7.4 {basic regsub operation} { list [regsub aa+ aaa 11&2&333 foo] $foo } {1 11aaa2aaa333} test regexp-7.5 {basic regsub operation} { list [regsub aa+ xaxaaaxaa &2&333 foo] $foo } {1 xaxaaa2aaa333xaa} test regexp-7.6 {basic regsub operation} { list [regsub aa+ xaxaaaxaa 1&22& foo] $foo } {1 xax1aaa22aaaxaa} test regexp-7.7 {basic regsub operation} { list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo } {1 xax1aa22aaxaa} test regexp-7.8 {basic regsub operation} { list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo } "1 {xax1\\aa22aaxaa}" test regexp-7.9 {basic regsub operation} { list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo } "1 {xax1\\122aaxaa}" test regexp-7.10 {basic regsub operation} { list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo } "1 {xax1\\aaaaaxaa}" test regexp-7.11 {basic regsub operation} { list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo } {1 xax1&aaxaa} test regexp-7.12 {basic regsub operation} { list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo } {1 xaxaaaaaaaaaaaaaaxaa} test regexp-7.13 {basic regsub operation} { set foo xxx list [regsub abc xyz 111 foo] $foo } {0 xyz} test regexp-7.14 {basic regsub operation} { set foo xxx list [regsub ^ xyz "111 " foo] $foo } {1 {111 xyz}} test regexp-7.15 {basic regsub operation} { set foo xxx list [regsub -- -foo abc-foodef "111 " foo] $foo } {1 {abc111 def}} test regexp-7.16 {basic regsub operation} { set foo xxx list [regsub x "" y foo] $foo } {0 {}} test regexp-7.17 {regsub utf compliance} { # if not UTF-8 aware, result is "0 1" set foo "xyz555ijka\u4e4ebpqr" regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar list [string compare $foo $bar] [regexp 4 $bar] } {0 0} test regexp-7.18 {basic regsub replacement} { list [regsub a+ aaa {&} foo] $foo } {1 aaa} test regexp-7.19 {basic regsub replacement} { list [regsub a+ aaa {\&} foo] $foo } {1 &} test regexp-7.20 {basic regsub replacement} { list [regsub a+ aaa {\\&} foo] $foo } {1 {\aaa}} test regexp-7.21 {basic regsub replacement} { list [regsub a+ aaa {\\\&} foo] $foo } {1 {\&}} test regexp-7.22 {basic regsub replacement} { list [regsub a+ aaa {\0} foo] $foo } {1 aaa} test regexp-7.23 {basic regsub replacement} { list [regsub a+ aaa {\\0} foo] $foo } {1 {\0}} test regexp-7.24 {basic regsub replacement} { list [regsub a+ aaa {\\\0} foo] $foo } {1 {\aaa}} test regexp-7.25 {basic regsub replacement} { list [regsub a+ aaa {\\\\0} foo] $foo } {1 {\\0}} test regexp-7.26 {dollar zero is not a backslash replacement} { list [regsub a+ aaa {$0} foo] $foo } {1 {$0}} test regexp-7.27 {dollar zero is not a backslash replacement} { list [regsub a+ aaa {\0$0} foo] $foo } {1 {aaa$0}} test regexp-7.28 {dollar zero is not a backslash replacement} { list [regsub a+ aaa {\$0} foo] $foo } {1 {\$0}} test regexp-7.29 {dollar zero is not a backslash replacement} { list [regsub a+ aaa {\\} foo] $foo } {1 \\} test regexp-8.1 {case conversion in regsub} { list [regsub -nocase a(a+) xaAAaAAay & foo] $foo } {1 xaAAaAAay} test regexp-8.2 {case conversion in regsub} { list [regsub -nocase a(a+) xaAAaAAay & foo] $foo } {1 xaAAaAAay} test regexp-8.3 {case conversion in regsub} { set foo 123 list [regsub a(a+) xaAAaAAay & foo] $foo } {0 xaAAaAAay} test regexp-8.4 {case conversion in regsub} { set foo 123 list [regsub -nocase a CaDE b foo] $foo } {1 CbDE} test regexp-8.5 {case conversion in regsub} { set foo 123 list [regsub -nocase XYZ CxYzD b foo] $foo } {1 CbD} test regexp-8.6 {case conversion in regsub} { set x abcdefghijklmnopqrstuvwxyz1234567890 set x $x$x$x$x$x$x$x$x$x$x$x$x set foo 123 list [regsub -nocase $x $x b foo] $foo } {1 b} test regexp-9.1 {-all option to regsub} { set foo 86 list [regsub -all x+ axxxbxxcxdx |&| foo] $foo } {4 a|xxx|b|xx|c|x|d|x|} test regexp-9.2 {-all option to regsub} { set foo 86 list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo } {4 a|XxX|b|xx|c|X|d|x|} test regexp-9.3 {-all option to regsub} { set foo 86 list [regsub x+ axxxbxxcxdx |&| foo] $foo } {1 a|xxx|bxxcxdx} test regexp-9.4 {-all option to regsub} { set foo 86 list [regsub -all bc axxxbxxcxdx |&| foo] $foo } {0 axxxbxxcxdx} test regexp-9.5 {-all option to regsub} { set foo xxx list [regsub -all node "node node more" yy foo] $foo } {2 {yy yy more}} test regexp-9.6 {-all option to regsub} { set foo xxx list [regsub -all ^ xxx 123 foo] $foo } {1 123xxx} test regexp-10.1 {expanded syntax in regsub} { set foo xxx list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo } {1 defc} test regexp-10.2 {newline sensitivity in regsub} { set foo xxx list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo } "1 {dabc\n123\n}" test regexp-10.3 {newline sensitivity in regsub} { set foo xxx list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo } "1 {dabc\n123\nxb}" test regexp-10.4 {partial newline sensitivity in regsub} { set foo xxx list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo } "1 {da\n123}" test regexp-10.5 {inverse partial newline sensitivity in regsub} { set foo xxx list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo } "1 {da\nb123\nxb}" test regexp-11.1 {regsub errors} { list [catch {regsub a b} msg] $msg } {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexp-11.2 {regsub errors} { list [catch {regsub -nocase a b} msg] $msg } {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexp-11.3 {regsub errors} { list [catch {regsub -nocase -all a b} msg] $msg } {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexp-11.4 {regsub errors} { list [catch {regsub a b c d e f} msg] $msg } {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexp-11.5 {regsub errors} { list [catch {regsub -gorp a b c} msg] $msg } {1 {bad option "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}} test regexp-11.6 {regsub errors} { list [catch {regsub -nocase a( b c d} msg] $msg } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexp-11.7 {regsub errors} -setup { unset -nocomplain f1 } -body { set f1 44 regsub -nocase aaa aaa xxx f1(f2) } -returnCodes error -result {can't set "f1(f2)": variable isn't array} test regexp-11.8 {regsub errors, -start bad int check} { list [catch {regsub -start bogus pattern string rep var} msg] $msg } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexp-11.9 {regsub without final variable name returns value} { regsub b abaca X } {aXaca} test regexp-11.10 {regsub without final variable name returns value} { regsub -all a abaca X } {XbXcX} test regexp-11.11 {regsub without final variable name returns value} { regsub b(.*?)d abcdeabcfde {,&,\1,} } {a,bcd,c,eabcfde} test regexp-11.12 {regsub without final variable name returns value} { regsub -all b(.*?)d abcdeabcfde {,&,\1,} } {a,bcd,c,ea,bcfd,cf,e} # This test crashes on the Mac unless you increase the Stack Space to about 1 # Meg. This is probably bigger than most users want... # 8.2.3 regexp reduced stack space requirements, but this should be # tested again test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} { list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z } {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z} test regexp-13.1 {regsub of a very large string} { # This test is designed to stress the memory subsystem in order to catch # Bug #933. It only fails if the Tcl memory allocator is in use. set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE} set filedata [string repeat $line 200] for {set i 1} {$i<10} {incr i} { regsub -all "BEGIN_TABLE " $filedata "" newfiledata } set x done } {done} test regexp-14.1 {CompileRegexp: regexp cache} { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f set x . append x *a regexp $x bbba } 1 test regexp-14.2 {CompileRegexp: regexp cache, different flags} { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f set x . append x *a regexp -nocase $x bbba } 1 test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -constraints { exec } -setup { set junk [makeFile {puts [regexp {} foo]} junk.tcl] } -body { exec [interpreter] $junk } -cleanup { removeFile junk.tcl } -result 1 test regexp-15.1 {regexp -start} { unset -nocomplain x list [regexp -start -10 {\d} 1abc2de3 x] $x } {1 1} test regexp-15.2 {regexp -start} { unset -nocomplain x list [regexp -start 2 {\d} 1abc2de3 x] $x } {1 2} test regexp-15.3 {regexp -start} { unset -nocomplain x list [regexp -start 4 {\d} 1abc2de3 x] $x } {1 2} test regexp-15.4 {regexp -start} { unset -nocomplain x list [regexp -start 5 {\d} 1abc2de3 x] $x } {1 3} test regexp-15.5 {regexp -start, over end of string} { unset -nocomplain x list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] } {0 0} test regexp-15.6 {regexp -start, loss of ^$ behavior} { list [regexp -start 2 {^$} {}] } {0} test regexp-15.7 {regexp -start, double option} { regexp -start 2 -start 0 a abc } 1 test regexp-15.8 {regexp -start, double option} { regexp -start 0 -start 2 a abc } 0 test regexp-15.9 {regexp -start, end relative index} { unset -nocomplain x list [regexp -start end {\d} 1abc2de3 x] [info exists x] } {0 0} test regexp-15.10 {regexp -start, end relative index} { unset -nocomplain x list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x } {1 1 3} test regexp-15.11 {regexp -start, over end of string} { set x NA list [regexp -start 2 {.*} ab x] $x } {1 {}} test regexp-16.1 {regsub -start} { unset -nocomplain x list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x } {4 a1b/2c/3d/4e/5} test regexp-16.2 {regsub -start} { unset -nocomplain x list [regsub -all -start -25 {z} hello {/&} x] $x } {0 hello} test regexp-16.3 {regsub -start} { unset -nocomplain x list [regsub -all -start 3 {z} hello {/&} x] $x } {0 hello} test regexp-16.4 {regsub -start, \A behavior} { set out {} lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x } {5 /a/b/c/d/e 3 ab/c/d/e} test regexp-16.5 {regsub -start, double option} { list [regsub -start 2 -start 0 a abc c x] $x } {1 cbc} test regexp-16.6 {regsub -start, double option} { list [regsub -start 0 -start 2 a abc c x] $x } {0 abc} test regexp-16.7 {regexp -start, end relative index} { list [regsub -start end a aaa b x] $x } {0 aaa} test regexp-16.8 {regexp -start, end relative index} { list [regsub -start end-1 a aaa b x] $x } {1 aab} test regexp-16.9 {regsub -start and -all} { set foo {} list [regsub -start 0 -all x+ axxxbxx |&| foo] $foo } {2 a|xxx|b|xx|} test regexp-16.10 {regsub -start and -all} { set foo {} list [regsub -start 1 -all x+ axxxbxx |&| foo] $foo } {2 a|xxx|b|xx|} test regexp-16.11 {regsub -start and -all} { set foo {} list [regsub -start 4 -all x+ axxxbxx |&| foo] $foo } {1 axxxb|xx|} test regexp-16.12 {regsub -start} { set foo {} list [regsub -start 4 x+ axxxbxx |&| foo] $foo } {1 axxxb|xx|} test regexp-16.13 {regsub -start and -all} { set foo {} list [regsub -start 1 -all a+ "" & foo] $foo } {0 {}} test regexp-16.14 {regsub -start} { set foo {} list [regsub -start 1 a+ "" & foo] $foo } {0 {}} test regexp-16.15 {regsub -start and -all} { set foo {} list [regsub -start 2 -all a+ "xy" & foo] $foo } {0 xy} test regexp-16.16 {regsub -start} { set foo {} list [regsub -start 2 a+ "xy" & foo] $foo } {0 xy} test regexp-16.17 {regsub -start and -all} { set foo {} list [regsub -start 1 -all y+ "xy" & foo] $foo } {1 xy} test regexp-16.18 {regsub -start} { set foo {} list [regsub -start 1 y+ "xy" & foo] $foo } {1 xy} test regexp-16.19 {regsub -start} { set foo {} list [regsub -start -1 a+ "" & foo] $foo } {0 {}} test regexp-16.20 {regsub -start, loss of ^$ behavior} { set foo NA list [regsub -start 1 {^$} {} & foo] $foo } {0 {}} test regexp-16.21 {regsub -start, loss of ^$ behavior} { set foo NA list [regsub -start 1 {^.*$} abc & foo] $foo } {0 abc} test regexp-16.22 {regsub -start, loss of ^$ behavior} { set foo NA list [regsub -all -start 1 {^.*$} abc & foo] $foo } {0 abc} test regexp-17.1 {regexp -inline} { regexp -inline b ababa } {b} test regexp-17.2 {regexp -inline} { regexp -inline (b) ababa } {b b} test regexp-17.3 {regexp -inline -indices} { regexp -inline -indices (b) ababa } {{1 1} {1 1}} test regexp-17.4 {regexp -inline} { regexp -inline {\w(\d+)\w} " hello 23 there456def " } {e456d 456} test regexp-17.5 {regexp -inline no matches} { regexp -inline {\w(\d+)\w} "" } {} test regexp-17.6 {regexp -inline no matches} { regexp -inline hello goodbye } {} test regexp-17.7 {regexp -inline, no matchvars allowed} { list [catch {regexp -inline b abc match} msg] $msg } {1 {regexp match variables not allowed when using -inline}} test regexp-18.1 {regexp -all} { regexp -all b bbbbb } {5} test regexp-18.2 {regexp -all} { regexp -all b abababbabaaaaaaaaaab } {6} test regexp-18.3 {regexp -all -inline} { regexp -all -inline b abababbabaaaaaaaaaab } {b b b b b b} test regexp-18.4 {regexp -all -inline} { regexp -all -inline {\w(\w)} abcdefg } {ab b cd d ef f} test regexp-18.5 {regexp -all -inline} { regexp -all -inline {\w(\w)$} abcdefg } {fg g} test regexp-18.6 {regexp -all -inline} { regexp -all -inline {\d+} 10:20:30:40 } {10 20 30 40} test regexp-18.7 {regexp -all -inline} { list [catch {regexp -all -inline b abc match} msg] $msg } {1 {regexp match variables not allowed when using -inline}} test regexp-18.8 {regexp -all} { # This should not cause an infinite loop regexp -all -inline {a*} a } {a} test regexp-18.9 {regexp -all} { # Yes, the expected result is {a {}}. Here's why: # Start at index 0; a* matches the "a" there then stops. # Go to index 1; a* matches the lambda (or {}) there then stops. Recall # that a* matches zero or more "a"'s; thus it matches the string "b", as # there are zero or more "a"'s there. # Go to index 2; this is past the end of the string, so stop. regexp -all -inline {a*} ab } {a {}} test regexp-18.10 {regexp -all} { # Yes, the expected result is {a {} a}. Here's why: # Start at index 0; a* matches the "a" there then stops. # Go to index 1; a* matches the lambda (or {}) there then stops. Recall # that a* matches zero or more "a"'s; thus it matches the string "b", as # there are zero or more "a"'s there. # Go to index 2; a* matches the "a" there then stops. # Go to index 3; this is past the end of the string, so stop. regexp -all -inline {a*} aba } {a {} a} test regexp-18.11 {regexp -all} { regexp -all -inline {^a} aaaa } {a} test regexp-18.12 {regexp -all -inline -indices} { regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh } {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}} test regexp-19.1 {regsub null replacement} { regsub -all {@} {@hel@lo@} "\0a\0" result list $result [string length $result] } "\0a\0hel\0a\0lo\0a\0 14" test regexp-19.2 {regsub null replacement} { regsub -all {@} {@hel@lo@} "\0a\0" result set expected "\0a\0hel\0a\0lo\0a\0" string equal $result $expected } 1 test regexp-20.1 {regsub shared object shimmering} { # Bug #461322 set a abcdefghijklmnopqurstuvwxyz set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d list $d [string length $d] [string bytelength $d] } [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] test regexp-20.2 {regsub shared object shimmering with -about} { eval regexp -about abc } {0 {}} test regexp-21.1 {regsub works with empty string} { regsub -- ^ {} foo } {foo} test regexp-21.2 {regsub works with empty string} { regsub -- \$ {} foo } {foo} test regexp-21.3 {regsub works with empty string offset} { regsub -start 0 -- ^ {} foo } {foo} test regexp-21.4 {regsub works with empty string offset} { regsub -start 0 -- \$ {} foo } {foo} test regexp-21.5 {regsub works with empty string offset} { regsub -start 3 -- \$ {123} foo } {123foo} test regexp-21.6 {regexp works with empty string} { regexp -- ^ {} } {1} test regexp-21.7 {regexp works with empty string} { regexp -start 0 -- ^ {} } {1} test regexp-21.8 {regexp works with empty string offset} { regexp -start 3 -- ^ {123} } {0} test regexp-21.9 {regexp works with empty string offset} { regexp -start 3 -- \$ {123} } {1} test regexp-21.10 {multiple matches handle newlines} { regsub -all -lineanchor -- {^#[^\n]*\n} "#one\n#two\n#three\n" foo\n } "foo\nfoo\nfoo\n" test regexp-21.11 {multiple matches handle newlines} { regsub -all -line -- ^ "a\nb\nc" \# } "\#a\n\#b\n\#c" test regexp-21.12 {multiple matches handle newlines} { regsub -all -line -- ^ "\n\n" \# } "\#\n\#\n\#" test regexp-21.13 {multiple matches handle newlines} { regexp -all -inline -indices -line -- ^ "a\nb\nc" } {{0 -1} {2 1} {4 3}} test regexp-21.14 {regsub works with empty string} { regsub -- ^ {} & } {} test regexp-21.15 {regsub works with empty string} { regsub -- ^ {} foo& } {foo} test regexp-21.16 {regsub works with empty string} { regsub -all -- ^ {} foo& } {foo} test regexp-21.17 {regsub works with empty string} { regsub -- ^ {} {foo\0} } {foo} test regexp-21.18 {regsub works with empty string} { regsub -- ^.* {} {foo$0} } {foo$0} test regexp-21.19 {regsub works with empty string} { regsub -- ^ {input} {} } {input} test regexp-21.20 {regsub works with empty string} { regsub -- x {} {foo} } {} test regexp-22.1 {Bug 1810038} { regexp ($|^X)* {} } 1 test regexp-22.2 {regexp compile and backrefs, Bug 1857126} { regexp -- {([bc])\1} bb } 1 test regexp-22.3 {Bug 3604074} { # This will hang in interps where the bug is not fixed regexp ((((((((a)*)*)*)*)*)*)*)* a } 1 test regexp-22.4 {Bug 3606139} -setup { interp alias {} a {} string repeat a } -body { # This crashes in interps where the bug is not fixed regexp [join [list [a 160]([a 55])[a 668]([a 55])[a 669]([a 55]) \ [a 668]([a 55])[a 649]([a 55])[a 668]([a 55])[a 668]([a 55]) \ [a 672]([a 55])[a 669]([a 55])[a 671]([a 55])[a 671]([a 55]) \ [a 672]([a 55])[a 652]([a 55])[a 672]([a 55])[a 671]([a 55]) \ [a 671]([a 55])[a 671]([a 55])[a 653]([a 55])[a 672]([a 55]) \ [a 653]([a 55])[a 672]([a 55])[a 672]([a 55])[a 652]([a 55]) \ [a 671]([a 55])[a 652]([a 55])[a 652]([a 55])[a 672]([a 55]) \ [a 672]([a 55])[a 672]([a 55])[a 653]([a 55])[a 671]([a 55]) \ [a 669]([a 55])[a 649]([a 55])[a 668]([a 55])[a 668]([a 55]) \ [a 668]([a 55])[a 650]([a 55])[a 650]([a 55])[a 672]([a 55]) \ [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ [a 668]([a 55])[a 669]([a 55])[a 672]([a 55])[a 669]([a 55]) \ [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 672]([a 55]) \ [a 670]([a 55])[a 671]([a 55])[a 672]([a 55])[a 672]([a 55]) \ [a 671]([a 55])[a 671]([a 55])[a 672]([a 55])[a 669]([a 55]) \ [a 668]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ [a 669]([a 55])[a 668]([a 55])[a 669]([a 55])[a 669]([a 55]) \ [a 668]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 669]([a 55]) \ [a 668]([a 55])[a 669]([a 55])[a 672]([a 55])[a 669]([a 55]) \ [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 668]([a 55]) \ [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ [a 672]([a 55])[a 669]([a 55])[a 669]([a 55])[a 710]([a 55]) \ [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 669]([a 55]) \ [a 672]([a 55])[a 669]([a 55])[a 669]([a 55])[a 668]([a 55]) \ [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 668]([a 55]) \ [a 667]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ [a 671]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ [a 668]([a 55])[a 710]([a 55])[a 668]([a 55])[a 668]([a 55]) \ [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 511]] {}] a } -cleanup { rename a {} } -returnCodes 1 -match glob -result {couldn't compile regular expression pattern: *} test regexp-22.5 {Bug 3610026} -setup { set e {} set cp 99 while {$cp < 32864} { append e [format %c [incr cp]] } } -body { regexp -about $e } -cleanup { unset -nocomplain e cp } -returnCodes error -match glob -result {*too many colors*} test regexp-22.6 {Bug 6585b21ca8} { expr {[regexp {(\w).*?\1} Programmer m] ? $m : ""} } rogr test regexp-23.1 {regexp -all and -line} { set string "" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1}} {{0 -1}} {{0 -1}}} test regexp-23.2 {regexp -all and -line} { set string "\n" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1}} {{0 -1}} {{0 -1}}} test regexp-23.3 {regexp -all and -line} { set string "\n\n" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1} {1 0}} {{0 -1} {1 0}} {{0 -1} {1 0}}} test regexp-23.4 {regexp -all and -line} { set string "a" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^.*$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1}} {{0 0}} {{1 0}}} test regexp-23.5 {regexp -all and -line} {knownBug} { set string "a\n" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^.*$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1} {2 1}} {{0 0} {2 1}} {{1 0} {2 1}}} test regexp-23.6 {regexp -all and -line} { set string "\na" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^.*$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1} {1 0}} {{0 -1} {1 1}} {{0 -1} {2 1}}} test regexp-23.7 {regexp -all and -line} {knownBug} { set string "ab\n" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^.*$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1} {3 2}} {{0 1} {3 2}} {{2 1} {3 2}}} test regexp-23.8 {regexp -all and -line} { set string "a\nb" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^.*$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1} {2 1}} {{0 0} {2 2}} {{1 0} {3 2}}} test regexp-23.9 {regexp -all and -line} {knownBug} { set string "a\nb\n" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^.*$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1} {2 1} {4 3}} {{0 0} {2 2} {4 3}} {{1 0} {3 2} {4 3}}} test regexp-23.10 {regexp -all and -line} { set string "a\nb\nc" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^.*$} $string] \ [regexp -all -inline -indices -line -- {$} $string] } {{{0 -1} {2 1} {4 3}} {{0 0} {2 2} {4 4}} {{1 0} {3 2} {5 4}}} test regexp-23.11 {regexp -all and -line} { regexp -all -inline -indices -line -- {b} "abb\nb" } {{1 1} {2 2} {4 4}} test regexp-24.1 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } {1 <> 1 <> 1 <>} test regexp-24.2 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "\n" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 2 "<>\n<>" 2 "<>\n<>" 2 "<>\n<>"] test regexp-24.3 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "\n\n" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 3 "<>\n<>\n<>" 3 "<>\n<>\n<>" 3 "<>\n<>\n<>"] test regexp-24.4 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "a" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^.*$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 1 "<>a" 1 "" 1 "a<>"] test regexp-24.5 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "a\n" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^.*$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 2 "<>a\n<>" 2 "\n<>" 2 "a<>\n<>"] test regexp-24.6 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "\na" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^.*$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 2 "<>\n<>a" 2 "<>\n" 2 "<>\na<>"] test regexp-24.7 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "ab\n" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^.*$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 2 "<>ab\n<>" 2 "\n<>" 2 "ab<>\n<>"] test regexp-24.8 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "a\nb" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^.*$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 2 "<>a\n<>b" 2 "\n" 2 "a<>\nb<>"] test regexp-24.9 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "a\nb\n" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^.*$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 3 "<>a\n<>b\n<>" 3 "\n\n<>" 3 "a<>\nb<>\n<>"] test regexp-24.10 {regsub -all and -line} { foreach {v1 v2 v3} {{} {} {}} {} set string "a\nb\nc" list \ [regsub -line -all {^} $string {<&>} v1] $v1 \ [regsub -line -all {^.*$} $string {<&>} v2] $v2 \ [regsub -line -all {$} $string {<&>} v3] $v3 } [list 3 "<>a\n<>b\n<>c" 3 "\n\n" 3 "a<>\nb<>\nc<>"] test regexp-24.11 {regsub -all and -line} { regsub -line -all {b} "abb\nb" {<&>} } "a\n" test regexp-25.1 {regexp without -line option} { set foo "" list [regexp {a.*b} "dabc\naxyb\n" foo] $foo } [list 1 abc\naxyb] test regexp-25.2 {regexp without -line option} { set foo "" list [regexp {^a.*b$} "dabc\naxyb\n" foo] $foo } {0 {}} test regexp-25.3 {regexp with -line option} { set foo "" list [regexp -line {^a.*b$} "dabc\naxyb\n" foo] $foo } {1 axyb} test regexp-25.4 {regexp with -line option} { set foo "" list [regexp -line {^a.*b$} "dabc\naxyb\nxb" foo] $foo } {1 axyb} test regexp-25.5 {regexp without -line option} { set foo "" list [regexp {^a.*b$} "dabc\naxyb\nxb" foo] $foo } {0 {}} test regexp-25.6 {regexp without -line option} { set foo "" list [regexp {a.*b$} "dabc\naxyb\nxb" foo] $foo } "1 {abc\naxyb\nxb}" test regexp-25.7 {regexp with -lineanchor option} { set foo "" list [regexp -lineanchor {^a.*b$} "dabc\naxyb\nxb" foo] $foo } "1 {axyb\nxb}" test regexp-25.8 {regexp with -lineanchor and -linestop option} { set foo "" list [regexp -lineanchor -linestop {^a.*b$} "dabc\naxyb\nxb" foo] $foo } {1 axyb} test regexp-25.9 {regexp with -linestop option} { set foo "" list [regexp -linestop {a.*b} "ab\naxyb\nxb" foo] $foo } {1 ab} test regexp-26.1 {matches start of line 1 time} { regexp -all -inline -- {^a+} "aab\naaa" } {aa} test regexp-26.2 {matches start of line(s) 2 times} { regexp -all -inline -line -- {^a+} "aab\naaa" } {aa aaa} test regexp-26.3 {effect of -line -all and -start} { list \ [regexp -all -inline -line -start 0 -- {^a+} "aab\naaa"] \ [regexp -all -inline -line -start 1 -- {^a+} "aab\naaa"] \ [regexp -all -inline -line -start 3 -- {^a+} "aab\naaa"] \ [regexp -all -inline -line -start 4 -- {^a+} "aab\naaa"] \ } {{aa aaa} aaa aaa aaa} # No regexp-26.4 test regexp-26.5 {match length 0, match length 1} { regexp -all -inline -line -- {^b*} "a\nb" } {{} b} test regexp-26.6 {non reporting capture group} { regexp -all -inline -line -- {^(?:a+|b)} "aab\naaa" } {aa aaa} test regexp-26.7 {Tcl bug 2826551: -line sensitive regexp and -start} { set match1 {} set match2 {} list \ [regexp -start 0 -indices -line {^a} "\nab" match1] $match1 \ [regexp -start 1 -indices -line {^a} "\nab" match2] $match2 } {1 {1 1} 1 {1 1}} test regexp-26.8 {Tcl bug 2826551: diff regexp with -line option} { set data "@1\n2\n+3\n@4\n-5\n+6\n7\n@8\n9\n" regexp -all -inline -line {^@.*\n(?:[^@].*\n?)*} $data } [list "@1\n2\n+3\n" "@4\n-5\n+6\n7\n" "@8\n9\n"] test regexp-26.9 {Tcl bug 2826551: diff regexp with embedded -line option} { set data "@1\n2\n+3\n@4\n-5\n+6\n7\n@8\n9\n" regexp -all -inline {(?n)^@.*\n(?:[^@].*\n?)*} $data } [list "@1\n2\n+3\n" "@4\n-5\n+6\n7\n" "@8\n9\n"] test regexp-26.10 {regexp with -line option} { regexp -all -inline -line -- {a*} "a\n" } {a {}} test regexp-26.11 {regexp without -line option} { regexp -all -inline -- {a*} "a\n" } {a {}} test regexp-26.12 {regexp with -line option} { regexp -all -inline -line -- {a*} "b\n" } {{} {}} test regexp-26.13 {regexp without -line option} { regexp -all -inline -- {a*} "b\n" } {{} {}} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/registry.test0000644000175000017500000010003414554262142015553 0ustar sergeisergei# registry.test -- # # This file contains a collection of tests for the registry command. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # In order for these tests to run, the registry package must be on the # auto_path or the registry package must have been loaded already. # # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands set ::regver [package require registry 1.3.5] }]} { testConstraint reg 1 } } # determine the current locale testConstraint english [expr { [llength [info commands testlocale]] && [string match "English*" [testlocale all ""]] }] test registry-1.0 {check if we are testing the right dll} {win reg} { set ::regver } {1.3.5} test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.1a {argument parsing for registry command} {win reg} { list [catch {registry -32bit} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.1b {argument parsing for registry command} {win reg} { list [catch {registry -64bit} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.2 {argument parsing for registry command} {win reg} { list [catch {registry foo} msg] $msg } {1 {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}} test registry-1.2a {argument parsing for registry command} {win reg} { list [catch {registry -33bit foo} msg] $msg } {1 {bad mode "-33bit": must be -32bit or -64bit}} test registry-1.3 {argument parsing for registry command} {win reg} { list [catch {registry d} msg] $msg } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} test registry-1.3a {argument parsing for registry command} {win reg} { list [catch {registry -32bit d} msg] $msg } {1 {wrong # args: should be "registry -32bit delete keyName ?valueName?"}} test registry-1.3b {argument parsing for registry command} {win reg} { list [catch {registry -64bit d} msg] $msg } {1 {wrong # args: should be "registry -64bit delete keyName ?valueName?"}} test registry-1.4 {argument parsing for registry command} {win reg} { list [catch {registry delete} msg] $msg } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} test registry-1.5 {argument parsing for registry command} {win reg} { list [catch {registry delete foo bar baz} msg] $msg } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} test registry-1.6 {argument parsing for registry command} {win reg} { list [catch {registry g} msg] $msg } {1 {wrong # args: should be "registry get keyName valueName"}} test registry-1.6a {argument parsing for registry command} {win reg} { list [catch {registry -32bit g} msg] $msg } {1 {wrong # args: should be "registry -32bit get keyName valueName"}} test registry-1.6b {argument parsing for registry command} {win reg} { list [catch {registry -64bit g} msg] $msg } {1 {wrong # args: should be "registry -64bit get keyName valueName"}} test registry-1.7 {argument parsing for registry command} {win reg} { list [catch {registry get} msg] $msg } {1 {wrong # args: should be "registry get keyName valueName"}} test registry-1.8 {argument parsing for registry command} {win reg} { list [catch {registry get foo} msg] $msg } {1 {wrong # args: should be "registry get keyName valueName"}} test registry-1.9 {argument parsing for registry command} {win reg} { list [catch {registry get foo bar baz} msg] $msg } {1 {wrong # args: should be "registry get keyName valueName"}} test registry-1.10 {argument parsing for registry command} {win reg} { list [catch {registry k} msg] $msg } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} test registry-1.10a {argument parsing for registry command} {win reg} { list [catch {registry -32bit k} msg] $msg } {1 {wrong # args: should be "registry -32bit keys keyName ?pattern?"}} test registry-1.10b {argument parsing for registry command} {win reg} { list [catch {registry -64bit k} msg] $msg } {1 {wrong # args: should be "registry -64bit keys keyName ?pattern?"}} test registry-1.11 {argument parsing for registry command} {win reg} { list [catch {registry keys} msg] $msg } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} test registry-1.12 {argument parsing for registry command} {win reg} { list [catch {registry keys foo bar baz} msg] $msg } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} test registry-1.13 {argument parsing for registry command} {win reg} { list [catch {registry s} msg] $msg } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} test registry-1.13a {argument parsing for registry command} {win reg} { list [catch {registry -32bit s} msg] $msg } {1 {wrong # args: should be "registry -32bit set keyName ?valueName data ?type??"}} test registry-1.13b {argument parsing for registry command} {win reg} { list [catch {registry -64bit s} msg] $msg } {1 {wrong # args: should be "registry -64bit set keyName ?valueName data ?type??"}} test registry-1.14 {argument parsing for registry command} {win reg} { list [catch {registry set} msg] $msg } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} test registry-1.15 {argument parsing for registry command} {win reg} { list [catch {registry set foo bar} msg] $msg } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} test registry-1.16 {argument parsing for registry command} {win reg} { list [catch {registry set foo bar baz blat gorp} msg] $msg } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} test registry-1.17 {argument parsing for registry command} {win reg} { list [catch {registry t} msg] $msg } {1 {wrong # args: should be "registry type keyName valueName"}} test registry-1.17a {argument parsing for registry command} {win reg} { list [catch {registry -32bit t} msg] $msg } {1 {wrong # args: should be "registry -32bit type keyName valueName"}} test registry-1.17b {argument parsing for registry command} {win reg} { list [catch {registry -64bit t} msg] $msg } {1 {wrong # args: should be "registry -64bit type keyName valueName"}} test registry-1.18 {argument parsing for registry command} {win reg} { list [catch {registry type} msg] $msg } {1 {wrong # args: should be "registry type keyName valueName"}} test registry-1.19 {argument parsing for registry command} {win reg} { list [catch {registry type foo} msg] $msg } {1 {wrong # args: should be "registry type keyName valueName"}} test registry-1.20 {argument parsing for registry command} {win reg} { list [catch {registry type foo bar baz} msg] $msg } {1 {wrong # args: should be "registry type keyName valueName"}} test registry-1.21 {argument parsing for registry command} {win reg} { list [catch {registry v} msg] $msg } {1 {wrong # args: should be "registry values keyName ?pattern?"}} test registry-1.21a {argument parsing for registry command} {win reg} { list [catch {registry -32bit v} msg] $msg } {1 {wrong # args: should be "registry -32bit values keyName ?pattern?"}} test registry-1.21b {argument parsing for registry command} {win reg} { list [catch {registry -64bit v} msg] $msg } {1 {wrong # args: should be "registry -64bit values keyName ?pattern?"}} test registry-1.22 {argument parsing for registry command} {win reg} { list [catch {registry values} msg] $msg } {1 {wrong # args: should be "registry values keyName ?pattern?"}} test registry-1.23 {argument parsing for registry command} {win reg} { list [catch {registry values foo bar baz} msg] $msg } {1 {wrong # args: should be "registry values keyName ?pattern?"}} test registry-2.1 {DeleteKey: bad key} {win reg} { list [catch {registry delete foo} msg] $msg } {1 {bad root name "foo": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} test registry-2.2 {DeleteKey: bad key} {win reg} { list [catch {registry delete HKEY_CLASSES_ROOT} msg] $msg } {1 {bad key: cannot delete root keys}} test registry-2.3 {DeleteKey: bad key} {win reg} { list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg } {1 {bad key: cannot delete root keys}} test registry-2.4 {DeleteKey: subkey at root level} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar registry delete HKEY_CURRENT_USER\\TclFoobar registry keys HKEY_CURRENT_USER TclFoobar } {} test registry-2.5 {DeleteKey: subkey below root level} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar\\test registry delete HKEY_CURRENT_USER\\TclFoobar\\test set result [registry keys HKEY_CURRENT_USER TclFoobar\\test] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {} test registry-2.6 {DeleteKey: recursive delete} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar\\test1 registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3 registry delete HKEY_CURRENT_USER\\TclFoobar set result [registry keys HKEY_CURRENT_USER TclFoobar] set result } {} test registry-2.7 {DeleteKey: trailing backslashes} {win reg english} { registry set HKEY_CURRENT_USER\\TclFoobar\\baz list [catch {registry delete HKEY_CURRENT_USER\\TclFoobar\\} msg] $msg } {1 {unable to delete key: The configuration registry key is invalid.}} test registry-2.8 {DeleteKey: failure} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry delete HKEY_CURRENT_USER\\TclFoobar } {} test registry-2.9 {DeleteKey: unicode} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar\\a registry set HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar\\b registry delete HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar set result [registry keys HKEY_CURRENT_USER\\TclFoobar] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {} test registry-3.1 {DeleteValue} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz test1 blort registry set HKEY_CURRENT_USER\\TclFoobar\\baz test2 blat registry delete HKEY_CURRENT_USER\\TclFoobar\\baz test1 set result [registry values HKEY_CURRENT_USER\\TclFoobar\\baz] registry delete HKEY_CURRENT_USER\\TclFoobar set result } test2 test registry-3.2 {DeleteValue: bad key} {win reg english} { registry delete HKEY_CURRENT_USER\\TclFoobar list [catch {registry delete HKEY_CURRENT_USER\\TclFoobar test} msg] $msg } {1 {unable to open key: The system cannot find the file specified.}} test registry-3.3 {DeleteValue: bad value} {win reg english} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz test2 blort set result [list [catch {registry delete HKEY_CURRENT_USER\\TclFoobar test1} msg] $msg] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {1 {unable to delete value "test1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}} test registry-3.4 {DeleteValue: Unicode} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz \u00c7test1 blort registry set HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz test2 blat registry delete HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz \u00c7test1 set result [registry values HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz] registry delete HKEY_CURRENT_USER\\TclFoobar set result } test2 test registry-4.1 {GetKeyNames: bad key} {win reg english} { registry delete HKEY_CURRENT_USER\\TclFoobar list [catch {registry keys HKEY_CURRENT_USER\\TclFoobar} msg] $msg } {1 {unable to open key: The system cannot find the file specified.}} test registry-4.2 {GetKeyNames} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz set result [registry keys HKEY_CURRENT_USER\\TclFoobar] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {baz} test registry-4.3 {GetKeyNames: remote key} {win reg nonPortable english} { set hostname [info hostname] registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar\\baz set result [registry keys \\\\gaspode\\HKEY_CURRENT_USER\\TclFoobar] registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar set result } {baz} test registry-4.4 {GetKeyNames: empty key} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar set result [registry keys HKEY_CURRENT_USER\\TclFoobar] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {} test registry-4.5 {GetKeyNames: patterns} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz registry set HKEY_CURRENT_USER\\TclFoobar\\blat registry set HKEY_CURRENT_USER\\TclFoobar\\foo set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {baz blat} test registry-4.6 {GetKeyNames: names with spaces} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz\ bar registry set HKEY_CURRENT_USER\\TclFoobar\\blat registry set HKEY_CURRENT_USER\\TclFoobar\\foo set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {{baz bar} blat} test registry-4.7 {GetKeyNames: Unicode} {win reg english} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar registry set HKEY_CURRENT_USER\\TclFoobar\\blat registry set HKEY_CURRENT_USER\\TclFoobar\\foo set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] registry delete HKEY_CURRENT_USER\\TclFoobar set result } "baz\u00c7bar blat" test registry-4.8 {GetKeyNames: Unicode} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar registry set HKEY_CURRENT_USER\\TclFoobar\\blat registry set HKEY_CURRENT_USER\\TclFoobar\\foo set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] registry delete HKEY_CURRENT_USER\\TclFoobar set result } "baz\u30b7bar blat" test registry-4.9 {GetKeyNames: very long key [Bug 1682211]} {*}{ -constraints {win reg} -setup { registry set HKEY_CURRENT_USER\\TclFoobar\\a registry set HKEY_CURRENT_USER\\TclFoobar\\b[string repeat x 254] registry set HKEY_CURRENT_USER\\TclFoobar\\c } -body { lsort [registry keys HKEY_CURRENT_USER\\TclFoobar] } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar }} \ -result [list a b[string repeat x 254] c] test registry-5.1 {GetType} {win reg english} { registry delete HKEY_CURRENT_USER\\TclFoobar list [catch {registry type HKEY_CURRENT_USER\\TclFoobar val1} msg] $msg } {1 {unable to open key: The system cannot find the file specified.}} test registry-5.2 {GetType} {win reg english} { registry set HKEY_CURRENT_USER\\TclFoobar list [catch {registry type HKEY_CURRENT_USER\\TclFoobar val1} msg] $msg } {1 {unable to get type of value "val1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}} test registry-5.3 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar none set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } none test registry-5.4 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } sz test registry-5.5 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar sz set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } sz test registry-5.6 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar expand_sz set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } expand_sz test registry-5.7 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 binary set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } binary test registry-5.8 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 dword set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } dword test registry-5.9 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 dword_big_endian set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } dword_big_endian test registry-5.10 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 link set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } link test registry-5.11 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar multi_sz set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } multi_sz test registry-5.12 {GetType} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 resource_list set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } resource_list test registry-5.13 {GetType: unknown types} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 24 set result [registry type HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } 24 test registry-5.14 {GetType: Unicode} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar va\u00c7l1 1 24 set result [registry type HKEY_CURRENT_USER\\TclFoobar va\u00c7l1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } 24 test registry-6.1 {GetValue} {win reg english} { registry delete HKEY_CURRENT_USER\\TclFoobar list [catch {registry get HKEY_CURRENT_USER\\TclFoobar val1} msg] $msg } {1 {unable to open key: The system cannot find the file specified.}} test registry-6.2 {GetValue} {win reg english} { registry set HKEY_CURRENT_USER\\TclFoobar list [catch {registry get HKEY_CURRENT_USER\\TclFoobar val1} msg] $msg } {1 {unable to get value "val1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}} test registry-6.3 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar none set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar test registry-6.4 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar test registry-6.5 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar test registry-6.6 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar expand_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar test registry-6.7 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 binary set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } 1 test registry-6.8 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 0x20 dword set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } 32 test registry-6.9 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 0x20 dword_big_endian set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } 32 test registry-6.10 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 link set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } 1 test registry-6.11 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar test registry-6.12 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo\ bar baz} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {{foo bar} baz} test registry-6.13 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } {} test registry-6.14 {GetValue: truncation of multivalues with null elements} \ {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {a {} b} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } a test registry-6.15 {GetValue} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 resource_list set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } 1 test registry-6.16 {GetValue: unknown types} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 1 24 set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } 1 test registry-6.17 {GetValue: Unicode value names} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71] registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar test registry-6.18 {GetValue: values with Unicode strings} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } "foo ba\u30b7r baz" test registry-6.19 {GetValue: values with Unicode strings} {win reg english} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } "foo ba\u00c7r baz" test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } "foo ba r baz" test registry-6.21 {GetValue: very long value names and values} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]] registry delete HKEY_CURRENT_USER\\TclFoobar set result } [string repeat x 16383] test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar } -body { registry values HKEY_CURRENT_USER\\TclFoobar } -returnCodes error -result {unable to open key: The system cannot find the file specified.} test registry-7.2 {GetValueNames} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar baz foobar } -body { registry values HKEY_CURRENT_USER\\TclFoobar } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result baz test registry-7.3 {GetValueNames} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 registry set HKEY_CURRENT_USER\\TclFoobar {} foobar3 } -body { lsort [registry values HKEY_CURRENT_USER\\TclFoobar] } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result {{} baz blat} test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -body { set hostname [info hostname] registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat set result [registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar] registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar set result } -result baz test registry-7.5 {GetValueNames: empty key} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar } -body { registry values HKEY_CURRENT_USER\\TclFoobar } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result {} test registry-7.6 {GetValueNames: patterns} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3 } -body { lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*] } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result {baz blat} test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar baz\ bar foobar1 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3 } -body { lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*] } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result {{baz bar} blat} test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \ -body { # This test will only succeed if the current user does not have # registry access on the specified machine. registry keys {\\mom\HKEY_LOCAL_MACHINE} } -returnCodes error -result "unable to open key: Access is denied." test registry-8.2 {OpenSubKey} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar } -body { registry keys HKEY_CURRENT_USER TclFoobar } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result {TclFoobar} test registry-8.3 {OpenSubKey} -constraints {win reg english} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar } -body { registry keys HKEY_CURRENT_USER\\TclFoobar } -returnCodes error \ -result "unable to open key: The system cannot find the file specified." test registry-9.1 {ParseKeyName: bad keys} -constraints {win reg} -body { registry values \\ } -returnCodes error -result "bad key \"\\\": must start with a valid root" test registry-9.2 {ParseKeyName: bad keys} -constraints {win reg} -body { registry values \\foobar } -returnCodes error -result {bad key "\foobar": must start with a valid root} test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body { registry values \\\\ } -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body { registry values \\\\\\ } -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english} -body { registry values \\\\\\HKEY_CLASSES_ROOT } -returnCodes error -result {unable to open key: The network address is invalid.} test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body { registry values \\\\gaspode } -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} test registry-9.7 {ParseKeyName: bad keys} -constraints {win reg} -body { registry values foobar } -returnCodes error -result {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} test registry-9.8 {ParseKeyName: null keys} -constraints {win reg} -body { registry delete HKEY_CLASSES_ROOT\\ } -returnCodes error -result {bad key: cannot delete root keys} test registry-9.9 {ParseKeyName: null keys} \ -constraints {win reg english} \ -body {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} \ -returnCodes error \ -result {unable to open key: The system cannot find the file specified.} test registry-10.1 {RecursiveDeleteKey} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar } -body { registry set HKEY_CURRENT_USER\\TclFoobar\\test1 registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3 registry delete HKEY_CURRENT_USER\\TclFoobar set result [registry keys HKEY_CURRENT_USER TclFoobar] set result } -result {} test registry-10.2 {RecursiveDeleteKey} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\test1 registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3 } -body { registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4 } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result {} test registry-11.1 {SetValue: recursive creation} \ -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar } -body { registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] } -result {foobar} test registry-11.2 {SetValue: modification} -constraints {win reg} \ -setup { registry delete HKEY_CURRENT_USER\\TclFoobar } -body { registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] } -result {frob} test registry-11.3 {SetValue: failure} \ -constraints {win reg nonPortable english} \ -body { # This test will only succeed if the current user does not have # registry access on the specified machine. registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar } -returnCodes error -result {unable to open key: Access is denied.} test registry-12.1 {BroadcastValue} -constraints {win reg} -body { registry broadcast } -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" test registry-12.2 {BroadcastValue} -constraints {win reg} -body { registry broadcast "" -time } -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" test registry-12.3 {BroadcastValue} -constraints {win reg} -body { registry broadcast "" - 500 } -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" test registry-12.4 {BroadcastValue} -constraints {win reg} -body { registry broadcast {Environment} } -result {1 0} test registry-12.5 {BroadcastValue} -constraints {win reg} -body { registry b {} } -result {1 0} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # tcl-indent-level: 4 # fill-column: 78 # End: tcl8.6.14/tests/reg.test0000644000175000017500000012357214554262142014474 0ustar sergeisergei# reg.test -- # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # (Don't panic if you are seeing this as part of the reg distribution # and aren't using Tcl -- reg's own regression tester also knows how # to read this file, ignoring the Tcl-isms.) # # Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # All tests require the testregexp command, return if this # command doesn't exist ::tcltest::testConstraint testregexp [llength [info commands testregexp]] ::tcltest::testConstraint localeRegexp 0 # This file uses some custom procedures, defined below, for regexp regression # testing. The name of the procedure indicates the general nature of the # test: # expectError compile error expected # expectNomatch match failure expected # expectMatch successful match # expectIndices successful match with -indices (used in checking things # like nonparticipating subexpressions) # expectPartial unsuccessful match with -indices (!!) (used in checking # partial-match reporting) # There is also "doing" which sets up title and major test number for each # block of tests. # The first 3 arguments are constant: a minor number (which often gets # a letter or two suffixed to it internally), some flags, and the RE # itself. For expectError, the remaining argument is the name of the # compile error expected, less the leading "REG_". For the rest, the # next argument is the string to try the match against. Remaining # arguments are the substring expected to be matched, and any # substrings expected to be matched by subexpressions. (For # expectNomatch, these arguments are optional, and if present are # ignored except that they indicate how many subexpressions should be # present in the RE.) It is an error for the number of subexpression # arguments to be wrong. Cases involving nonparticipating # subexpressions, checking where empty substrings are located, # etc. should be done using expectIndices and expectPartial. # The flag characters are complex and a bit eclectic. Generally speaking, # lowercase letters are compile options, uppercase are expected re_info # bits, and nonalphabetics are match options, controls for how the test is # run, or testing options. The one small surprise is that AREs are the # default, and you must explicitly request lesser flavors of RE. The flags # are as follows. It is admitted that some are not very mnemonic. # There are some others which are purely debugging tools and are not # useful in this file. # # - no-op (placeholder) # + provide fake xy equivalence class and ch collating element # % force small state-set cache in matcher (to test cache replace) # ^ beginning of string is not beginning of line # $ end of string is not end of line # * test is Unicode-specific, needs big character set # # & test as both ARE and BRE # b BRE # e ERE # a turn advanced-features bit on (error unless ERE already) # q literal string, no metacharacters at all # # i case-independent matching # o ("opaque") no subexpression capture # p newlines are half-magic, excluded from . and [^ only # w newlines are half-magic, significant to ^ and $ only # n newlines are fully magic, both effects # x expanded RE syntax # t incomplete-match reporting # # A backslash-_a_lphanumeric seen # B ERE/ARE literal-_b_race heuristic used # E backslash (_e_scape) seen within [] # H looka_h_ead constraint seen # I _i_mpossible to match # L _l_ocale-specific construct seen # M unportable (_m_achine-specific) construct seen # N RE can match empty (_n_ull) string # P non-_P_OSIX construct seen # Q {} _q_uantifier seen # R back _r_eference seen # S POSIX-un_s_pecified syntax seen # T prefers shortest (_t_iny) # U saw original-POSIX botch: unmatched right paren in ERE (_u_gh) # The one area we can't easily test is memory-allocation failures (which # are hard to provoke on command). Embedded NULs also are not tested at # the moment, but this is a historical accident which should be fixed. # test procedures and related namespace eval RETest { namespace export doing expect* knownBug variable regBug 0 # re_info abbreviation mapping table variable infonames array set infonames { A REG_UBSALNUM B REG_UBRACES E REG_UBBS H REG_ULOOKAHEAD I REG_UIMPOSSIBLE L REG_ULOCALE M REG_UUNPORT N REG_UEMPTYMATCH P REG_UNONPOSIX Q REG_UBOUNDS R REG_UBACKREF S REG_UUNSPEC T REG_USHORTEST U REG_UPBOTCH } variable infonameorder "RHQBAUEPSMLNIT" ;# must match bit order, lsb first # build test number (internal) proc TestNum {args} { return reg-[join [concat $args] .] } # build description, with possible modifiers (internal) proc TestDesc {args} { variable description set testid [concat $args] set d $description if {[llength $testid] > 1} { set d "$d ([lrange $testid 1 end])" } return $d } # build trailing options and flags argument from a flags string (internal) proc TestFlags {fl} { set args [list] set flags "" foreach f [split $fl ""] { switch -exact -- $f { "i" { lappend args "-nocase" } "x" { lappend args "-expanded" } "n" { lappend args "-line" } "p" { lappend args "-linestop" } "w" { lappend args "-lineanchor" } "-" { } default { append flags $f } } } if {$flags ne ""} { lappend args -xflags $flags } return $args } # build info-flags list from a flags string (internal) proc TestInfoFlags {fl} { variable infonames variable infonameorder set ret [list] foreach f [split $infonameorder ""] { if {[string match *$f* $fl]} { lappend ret $infonames($f) } } return $ret } # Share the generation of the list of test constraints so it is # done the same on all routes. proc TestConstraints {flags} { set constraints [list testregexp] variable regBug if {$regBug} { # This will trigger registration as a skipped test lappend constraints knownBug } # Tcl locale stuff doesn't do the ch/xy test fakery yet if {[string match *+* $flags]} { # This will trigger registration as a skipped test lappend constraints localeRegexp } return $constraints } # match expected, internal routine that does the work # parameters like the "real" routines except they don't have "opts", # which is a possibly-empty list of switches for the regexp match attempt # The ! flag is used to indicate expected match failure (for REG_EXPECT, # which wants argument testing even in the event of failure). proc MatchExpected {opts testid flags re target args} { # if &, test as both BRE and ARE if {[string match *&* $flags]} { set f [string map {& {}} $flags] MatchExpected $opts "$testid ARE" ${f} $re $target {*}$args MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args return } set constraints [TestConstraints $flags] set f [TestFlags $flags] set infoflags [TestInfoFlags $flags] set ccmd [list testregexp -about {*}$f $re] set ecmd [list testregexp {*}$opts {*}$f $re $target] set nsub [expr {[llength $args] - 1}] set names [list] set refs "" for {set i 0} {$i < [llength $args]} {incr i} { if {$i == 0} { set name match } else { set name sub$i } lappend names $name append refs " \$$name" set $name "" } if {[string match *o* $flags]} { ;# REG_NOSUB kludge set nsub 0 ;# unsigned value cannot be -1 } if {[string match *t* $flags]} { ;# REG_EXPECT incr nsub -1 ;# the extra does not count } set erun "list \[[concat $ecmd $names]\] $refs" set result [list [expr {![string match *!* $flags]}] {*}$args] set info [list $nsub $infoflags] ::tcltest::test [TestNum $testid compile] [TestDesc $testid compile] \ -constraints $constraints -body $ccmd -result $info ::tcltest::test [TestNum $testid execute] [TestDesc $testid execute] \ -constraints $constraints -body $erun -result $result } # set major test number and description proc doing {major desc} { variable description "RE engine $desc" } # compilation error expected proc expectError {testid flags re err} { # if &, test as both ARE and BRE if {[string match *&* $flags]} { set f [string map {& {}} $flags] expectError "$testid ARE" ${f} $re $err expectError "$testid BRE" ${f}b $re $err return } set constraints [TestConstraints $flags] set cmd [list testregexp -about {*}[TestFlags $flags] $re] ::tcltest::test [TestNum $testid error] [TestDesc $testid error] \ -constraints $constraints -result [list 1 REG_$err] -body \ "list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]" } # match failure expected proc expectNomatch {testid flags re target args} { variable regBug # if &, test as both ARE and BRE if {[string match *&* $flags]} { set f [string map {& {}} $flags] expectNomatch "$testid ARE" ${f} $re $target {*}$args expectNomatch "$testid BRE" ${f}b $re $target {*}$args return } set constraints [TestConstraints $flags] set f [TestFlags $flags] set infoflags [TestInfoFlags $flags] set ccmd [list testregexp -about {*}$f $re] set nsub [expr {[llength $args] - 1}] if {$nsub < 0} { # didn't tell us number of subexps set ccmd "lreplace \[$ccmd\] 0 0" set info [list $infoflags] } else { set info [list $nsub $infoflags] } set ecmd [list testregexp {*}$f $re $target] ::tcltest::test [TestNum $testid compile] [TestDesc $testid compile] \ -constraints $constraints -body $ccmd -result $info ::tcltest::test [TestNum $testid execute] [TestDesc $testid execute] \ -constraints $constraints -body $ecmd -result 0 } # match expected (no missing, empty, or ambiguous submatches) # expectMatch testno flags re target mat submat ... proc expectMatch {args} { MatchExpected {} {*}$args } # match expected (full fanciness) # expectIndices testno flags re target mat submat ... proc expectIndices {args} { MatchExpected -indices {*}$args } # partial match expected # expectPartial testno flags re target mat "" ... # Quirk: number of ""s must be one more than number of subREs. proc expectPartial {args} { lset args 1 ![lindex $args 1] ;# add ! flag MatchExpected -indices {*}$args } # test is a knownBug proc knownBug {args} { variable regBug 1 uplevel \#0 $args set regBug 0 } } namespace import RETest::* ######## the tests themselves ######## # support functions and preliminary misc. # This is sensitive to changes in message wording, but we really have to # test the code->message expansion at least once. ::tcltest::test reg-0.1 "regexp error reporting" { list [catch {regexp (*) ign} msg] $msg } {1 {couldn't compile regular expression pattern: quantifier operand invalid}} doing 1 "basic sanity checks" expectMatch 1.1 & abc abc abc expectNomatch 1.2 & abc def expectMatch 1.3 & abc xyabxabce abc doing 2 "invalid option combinations" expectError 2.1 qe a INVARG expectError 2.2 qa a INVARG expectError 2.3 qx a INVARG expectError 2.4 qn a INVARG expectError 2.5 ba a INVARG doing 3 "basic syntax" expectIndices 3.1 &NS "" a {0 -1} expectMatch 3.2 NS a| a a expectMatch 3.3 - a|b a a expectMatch 3.4 - a|b b b expectMatch 3.5 NS a||b b b expectMatch 3.6 & ab ab ab doing 4 "parentheses" expectMatch 4.1 - (a)e ae ae a expectMatch 4.2 o (a)e ae expectMatch 4.3 b {\(a\)b} ab ab a expectMatch 4.4 - a((b)c) abc abc bc b expectMatch 4.5 - a(b)(c) abc abc b c expectError 4.6 - a(b EPAREN expectError 4.7 b {a\(b} EPAREN # sigh, we blew it on the specs here... someday this will be fixed in POSIX, # but meanwhile, it's fixed in AREs expectMatch 4.8 eU a)b a)b a)b expectError 4.9 - a)b EPAREN expectError 4.10 b {a\)b} EPAREN expectMatch 4.11 P a(?:b)c abc abc expectError 4.12 e a(?:b)c BADRPT expectIndices 4.13 S a()b ab {0 1} {1 0} expectMatch 4.14 SP a(?:)b ab ab expectIndices 4.15 S a(|b)c ac {0 1} {1 0} expectMatch 4.16 S a(b|)c abc abc b doing 5 "simple one-char matching" # general case of brackets done later expectMatch 5.1 & a.b axb axb expectNomatch 5.2 &n "a.b" "a\nb" expectMatch 5.3 & {a[bc]d} abd abd expectMatch 5.4 & {a[bc]d} acd acd expectNomatch 5.5 & {a[bc]d} aed expectNomatch 5.6 & {a[^bc]d} abd expectMatch 5.7 & {a[^bc]d} aed aed expectNomatch 5.8 &p "a\[^bc]d" "a\nd" doing 6 "context-dependent syntax" # plus odds and ends expectError 6.1 - * BADRPT expectMatch 6.2 b * * * expectMatch 6.3 b {\(*\)} * * * expectError 6.4 - (*) BADRPT expectMatch 6.5 b ^* * * expectError 6.6 - ^* BADRPT expectNomatch 6.7 & ^b ^b expectMatch 6.8 b x^ x^ x^ expectNomatch 6.9 I x^ x expectMatch 6.10 n "\n^" "x\nb" "\n" expectNomatch 6.11 bS {\(^b\)} ^b expectMatch 6.12 - (^b) b b b expectMatch 6.13 & {x$} x x expectMatch 6.14 bS {\(x$\)} x x x expectMatch 6.15 - {(x$)} x x x expectMatch 6.16 b {x$y} "x\$y" "x\$y" expectNomatch 6.17 I {x$y} xy expectMatch 6.18 n "x\$\n" "x\n" "x\n" expectError 6.19 - + BADRPT expectError 6.20 - ? BADRPT doing 7 "simple quantifiers" expectMatch 7.1 &N a* aa aa expectIndices 7.2 &N a* b {0 -1} expectMatch 7.3 - a+ aa aa expectMatch 7.4 - a?b ab ab expectMatch 7.5 - a?b b b expectError 7.6 - ** BADRPT expectMatch 7.7 bN ** *** *** expectError 7.8 & a** BADRPT expectError 7.9 & a**b BADRPT expectError 7.10 & *** BADRPT expectError 7.11 - a++ BADRPT expectError 7.12 - a?+ BADRPT expectError 7.13 - a?* BADRPT expectError 7.14 - a+* BADRPT expectError 7.15 - a*+ BADRPT doing 8 "braces" expectMatch 8.1 NQ "a{0,1}" "" "" expectMatch 8.2 NQ "a{0,1}" ac a expectError 8.3 - "a{1,0}" BADBR expectError 8.4 - "a{1,2,3}" BADBR expectError 8.5 - "a{257}" BADBR expectError 8.6 - "a{1000}" BADBR expectError 8.7 - "a{1" EBRACE expectError 8.8 - "a{1n}" BADBR expectMatch 8.9 BS "a{b" "a\{b" "a\{b" expectMatch 8.10 BS "a{" "a\{" "a\{" expectMatch 8.11 bQ "a\\{0,1\\}b" cb b expectError 8.12 b "a\\{0,1" EBRACE expectError 8.13 - "a{0,1\\" BADBR expectMatch 8.14 Q "a{0}b" ab b expectMatch 8.15 Q "a{0,0}b" ab b expectMatch 8.16 Q "a{0,1}b" ab ab expectMatch 8.17 Q "a{0,2}b" b b expectMatch 8.18 Q "a{0,2}b" aab aab expectMatch 8.19 Q "a{0,}b" aab aab expectMatch 8.20 Q "a{1,1}b" aab ab expectMatch 8.21 Q "a{1,3}b" aaaab aaab expectNomatch 8.22 Q "a{1,3}b" b expectMatch 8.23 Q "a{1,}b" aab aab expectNomatch 8.24 Q "a{2,3}b" ab expectMatch 8.25 Q "a{2,3}b" aaaab aaab expectNomatch 8.26 Q "a{2,}b" ab expectMatch 8.27 Q "a{2,}b" aaaab aaaab doing 9 "brackets" expectMatch 9.1 & {a[bc]} ac ac expectMatch 9.2 & {a[-]} a- a- expectMatch 9.3 & {a[[.-.]]} a- a- expectMatch 9.4 &L {a[[.zero.]]} a0 a0 expectMatch 9.5 &LM {a[[.zero.]-9]} a2 a2 expectMatch 9.6 &M {a[0-[.9.]]} a2 a2 expectMatch 9.7 &+L {a[[=x=]]} ax ax expectMatch 9.8 &+L {a[[=x=]]} ay ay expectNomatch 9.9 &+L {a[[=x=]]} az expectError 9.10 & {a[0-[=x=]]} ERANGE expectMatch 9.11 &L {a[[:digit:]]} a0 a0 expectError 9.12 & {a[[:woopsie:]]} ECTYPE expectNomatch 9.13 &L {a[[:digit:]]} ab expectError 9.14 & {a[0-[:digit:]]} ERANGE expectMatch 9.15 &LP {[[:<:]]a} a a expectMatch 9.16 &LP {a[[:>:]]} a a expectError 9.17 & {a[[..]]b} ECOLLATE expectError 9.18 & {a[[==]]b} ECOLLATE expectError 9.19 & {a[[::]]b} ECTYPE expectError 9.20 & {a[[.a} EBRACK expectError 9.21 & {a[[=a} EBRACK expectError 9.22 & {a[[:a} EBRACK expectError 9.23 & {a[} EBRACK expectError 9.24 & {a[b} EBRACK expectError 9.25 & {a[b-} EBRACK expectError 9.26 & {a[b-c} EBRACK expectMatch 9.27 &M {a[b-c]} ab ab expectMatch 9.28 & {a[b-b]} ab ab expectMatch 9.29 &M {a[1-2]} a2 a2 expectError 9.30 & {a[c-b]} ERANGE expectError 9.31 & {a[a-b-c]} ERANGE expectMatch 9.32 &M {a[--?]b} a?b a?b expectMatch 9.33 & {a[---]b} a-b a-b expectMatch 9.34 & {a[]b]c} a]c a]c expectMatch 9.35 EP {a[\]]b} a]b a]b expectNomatch 9.36 bE {a[\]]b} a]b expectMatch 9.37 bE {a[\]]b} "a\\]b" "a\\]b" expectMatch 9.38 eE {a[\]]b} "a\\]b" "a\\]b" expectMatch 9.39 EP {a[\\]b} "a\\b" "a\\b" expectMatch 9.40 eE {a[\\]b} "a\\b" "a\\b" expectMatch 9.41 bE {a[\\]b} "a\\b" "a\\b" expectError 9.42 - {a[\Z]b} EESCAPE expectMatch 9.43 & {a[[b]c} "a\[c" "a\[c" expectMatch 9.44 EMP* {a[\u00fe-\u0507][\u00ff-\u0300]b} \ "a\u0102\u02ffb" "a\u0102\u02ffb" doing 10 "anchors and newlines" expectMatch 10.1 & ^a a a expectNomatch 10.2 &^ ^a a expectIndices 10.3 &N ^ a {0 -1} expectIndices 10.4 & {a$} aba {2 2} expectNomatch 10.5 {&$} {a$} a expectIndices 10.6 &N {$} ab {2 1} expectMatch 10.7 &n ^a a a expectMatch 10.8 &n "^a" "b\na" "a" expectIndices 10.9 &w "^a" "a\na" {0 0} expectIndices 10.10 &n^ "^a" "a\na" {2 2} expectMatch 10.11 &n {a$} a a expectMatch 10.12 &n "a\$" "a\nb" "a" expectIndices 10.13 &n "a\$" "a\na" {0 0} expectIndices 10.14 N ^^ a {0 -1} expectMatch 10.15 b ^^ ^ ^ expectIndices 10.16 N {$$} a {1 0} expectMatch 10.17 b {$$} "\$" "\$" expectMatch 10.18 &N {^$} "" "" expectNomatch 10.19 &N {^$} a expectIndices 10.20 &nN "^\$" a\n\nb {2 1} expectMatch 10.21 N {$^} "" "" expectMatch 10.22 b {$^} "\$^" "\$^" expectMatch 10.23 P {\Aa} a a expectMatch 10.24 ^P {\Aa} a a expectNomatch 10.25 ^nP {\Aa} "b\na" expectMatch 10.26 P {a\Z} a a expectMatch 10.27 \$P {a\Z} a a expectNomatch 10.28 \$nP {a\Z} "a\nb" expectError 10.29 - ^* BADRPT expectError 10.30 - {$*} BADRPT expectError 10.31 - {\A*} BADRPT expectError 10.32 - {\Z*} BADRPT doing 11 "boundary constraints" expectMatch 11.1 &LP {[[:<:]]a} a a expectMatch 11.2 &LP {[[:<:]]a} -a a expectNomatch 11.3 &LP {[[:<:]]a} ba expectMatch 11.4 &LP {a[[:>:]]} a a expectMatch 11.5 &LP {a[[:>:]]} a- a expectNomatch 11.6 &LP {a[[:>:]]} ab expectMatch 11.7 bLP {\} a a expectNomatch 11.10 bLP {a\>} ab expectMatch 11.11 LP {\ya} a a expectNomatch 11.12 LP {\ya} ba expectMatch 11.13 LP {a\y} a a expectNomatch 11.14 LP {a\y} ab expectMatch 11.15 LP {a\Y} ab a expectNomatch 11.16 LP {a\Y} a- expectNomatch 11.17 LP {a\Y} a expectNomatch 11.18 LP {-\Y} -a expectMatch 11.19 LP {-\Y} -% - expectNomatch 11.20 LP {\Y-} a- expectError 11.21 - {[[:<:]]*} BADRPT expectError 11.22 - {[[:>:]]*} BADRPT expectError 11.23 b {\<*} BADRPT expectError 11.24 b {\>*} BADRPT expectError 11.25 - {\y*} BADRPT expectError 11.26 - {\Y*} BADRPT expectMatch 11.27 LP {\ma} a a expectNomatch 11.28 LP {\ma} ba expectMatch 11.29 LP {a\M} a a expectNomatch 11.30 LP {a\M} ab expectNomatch 11.31 ILP {\Ma} a expectNomatch 11.32 ILP {a\m} a doing 12 "character classes" expectMatch 12.1 LP {a\db} a0b a0b expectNomatch 12.2 LP {a\db} axb expectNomatch 12.3 LP {a\Db} a0b expectMatch 12.4 LP {a\Db} axb axb expectMatch 12.5 LP "a\\sb" "a b" "a b" expectMatch 12.6 LP "a\\sb" "a\tb" "a\tb" expectMatch 12.7 LP "a\\sb" "a\nb" "a\nb" expectNomatch 12.8 LP {a\sb} axb expectMatch 12.9 LP {a\Sb} axb axb expectNomatch 12.10 LP "a\\Sb" "a b" expectMatch 12.11 LP {a\wb} axb axb expectNomatch 12.12 LP {a\wb} a-b expectNomatch 12.13 LP {a\Wb} axb expectMatch 12.14 LP {a\Wb} a-b a-b expectMatch 12.15 LP {\y\w+z\y} adze-guz guz expectMatch 12.16 LPE {a[\d]b} a1b a1b expectMatch 12.17 LPE "a\[\\s]b" "a b" "a b" expectMatch 12.18 LPE {a[\w]b} axb axb doing 13 "escapes" expectError 13.1 & "a\\" EESCAPE expectMatch 13.2 - {a\]+)>} a } 1 test reg-33.4 {Bug 505048} { regexp {\A\s*([^b]*)b} ab } 1 test reg-33.5 {Bug 505048} { regexp {\A\s*[^b]*(b)} ab } 1 test reg-33.6 {Bug 505048} { regexp {\A(\s*)[^b]*(b)} ab } 1 test reg-33.7 {Bug 505048} { regexp {\A\s*[^b]*b} ab } 1 test reg-33.8 {Bug 505048} { regexp -inline {\A\s*[^b]*b} ab } ab test reg-33.9 {Bug 505048} { regexp -indices -inline {\A\s*[^b]*b} ab } {{0 1}} test reg-33.10 {Bug 840258} -body { regsub {(^|\n)+\.*b} \n.b {} tmp } -cleanup { unset tmp } -result 1 test reg-33.11 {Bug 840258} -body { regsub {(^|[\n\r]+)\.*\?<.*?(\n|\r)+} \ "TQ\r\n.?<5000267>Test already stopped\r\n" {} tmp } -cleanup { unset tmp } -result 1 test reg-33.12 {Bug 1810264 - bad read} { regexp {\3161573148} {\3161573148} } 0 test reg-33.13 {Bug 1810264 - infinite loop} { regexp {($|^)*} {x} } 1 # Some environments have small default stack sizes. [Bug 1905562] test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable { regexp {(x{200}){200}$y} {x} } 0 test reg-33.15.1 {Bug 3603557 - an "in the wild" RE} { lindex [regexp -expanded -about { ^TETRA_MODE_CMD # Message Type ([[:blank:]]+) # Pad (ETS_1_1|ETS_1_2|ETS_2_2) # SystemCode ([[:blank:]]+) # Pad (CONTINUOUS|CARRIER|MCCH|TRAFFIC) # SharingMode ([[:blank:]]+) # Pad ([[:digit:]]{1,2}) # ColourCode ([[:blank:]]+) # Pad (1|2|3|4|6|9|12|18) # TSReservedFrames ([[:blank:]]+) # Pad (PASS|TRUE|FAIL|FALSE) # UPlaneDTX ([[:blank:]]+) # Pad (PASS|TRUE|FAIL|FALSE) # Frame18Extension ([[:blank:]]+) # Pad ([[:digit:]]{1,4}) # MCC ([[:blank:]]+) # Pad ([[:digit:]]{1,5}) # MNC ([[:blank:]]+) # Pad (BOTH|BCAST|ENQRY|NONE) # NbrCellBcast ([[:blank:]]+) # Pad (UNKNOWN|LOW|MEDIUM|HIGH) # CellServiceLevel ([[:blank:]]+) # Pad (PASS|TRUE|FAIL|FALSE) # LateEntryInfo ([[:blank:]]+) # Pad (300|400) # FrequencyBand ([[:blank:]]+) # Pad (NORMAL|REVERSE) # ReverseOperation ([[:blank:]]+) # Pad (NONE|\+6\.25|\-6\.25|\+12\.5) # Offset ([[:blank:]]+) # Pad (10) # DuplexSpacing ([[:blank:]]+) # Pad ([[:digit:]]{1,4}) # MainCarrierNr ([[:blank:]]+) # Pad (0|1|2|3) # NrCSCCH ([[:blank:]]+) # Pad (15|20|25|30|35|40|45) # MSTxPwrMax ([[:blank:]]+) # Pad (\-125|\-120|\-115|\-110|\-105|\-100|\-95|\-90|\-85|\-80|\-75|\-70|\-65|\-60|\-55|\-50) # RxLevAccessMin ([[:blank:]]+) # Pad (\-53|\-51|\-49|\-47|\-45|\-43|\-41|\-39|\-37|\-35|\-33|\-31|\-29|\-27|\-25|\-23) # AccessParameter ([[:blank:]]+) # Pad (DISABLE|[[:digit:]]{3,4}) # RadioDLTimeout ([[:blank:]]+) # Pad (\-[[:digit:]]{2,3}) # RSSIThreshold ([[:blank:]]+) # Pad ([[:digit:]]{1,5}) # CCKIdSCKVerNr ([[:blank:]]+) # Pad ([[:digit:]]{1,5}) # LocationArea ([[:blank:]]+) # Pad ([(1|0)]{16}) # SubscriberClass ([[:blank:]]+) # Pad ([(1|0)]{12}) # BSServiceDetails ([[:blank:]]+) # Pad (RANDOMIZE|IMMEDIATE|[[:digit:]]{1,2}) # IMM ([[:blank:]]+) # Pad ([[:digit:]]{1,2}) # WT ([[:blank:]]+) # Pad ([[:digit:]]{1,2}) # Nu ([[:blank:]]+) # Pad ([0-1]) # FrameLngFctr ([[:blank:]]+) # Pad ([[:digit:]]{1,2}) # TSPtr ([[:blank:]]+) # Pad ([0-7]) # MinPriority ([[:blank:]]+) # Pad (PASS|TRUE|FAIL|FALSE) # ExtdSrvcsEnabled ([[:blank:]]+) # Pad (.*) # ConditionalFields }] 0 } 68 test reg-33.16.1 {Bug [8d2c0da36d]- another "in the wild" RE} { lindex [regexp -about "^MRK:client1: =1339 14HKelly Talisman 10011000 (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*) \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 8 0 8 0 0 0 77 77 1 1 2 0 11 { 1 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 13HC6 My Creator 2 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 31HC7 Slightly offensive name, huh 3 8 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 23HE-mail:kelly@hotbox.com 4 9 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 17Hcompface must die 5 10 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 3HAir 6 12 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 14HPGP public key 7 13 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 16Hkelly@hotbox.com 8 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 12H2 text/plain 9 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 13H2 x-kom/basic 10 33 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H0 11 14 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H3 }\r?"] 0 } 1 test reg-33.15 {constraint fixes} { regexp {(^)+^} x } 1 test reg-33.16 {constraint fixes} { regexp {($^)+} x } 0 test reg-33.17 {constraint fixes} { regexp {(^$)*} x } 1 test reg-33.18 {constraint fixes} { regexp {(^(?!aa))+} {aa bb cc} } 0 test reg-33.19 {constraint fixes} { regexp {(^(?!aa)(?!bb)(?!cc))+} {aa x} } 0 test reg-33.20 {constraint fixes} { regexp {(^(?!aa)(?!bb)(?!cc))+} {bb x} } 0 test reg-33.21 {constraint fixes} { regexp {(^(?!aa)(?!bb)(?!cc))+} {cc x} } 0 test reg-33.22 {constraint fixes} { regexp {(^(?!aa)(?!bb)(?!cc))+} {dd x} } 1 test reg-33.23 {} { regexp {abcd(\m)+xyz} x } 0 test reg-33.24 {} { regexp {abcd(\m)+xyz} a } 0 test reg-33.25 {} { regexp {^abcd*(((((^(a c(e?d)a+|)+|)+|)+|)+|a)+|)} x } 0 test reg-33.26 {} { regexp {a^(^)bcd*xy(((((($a+|)+|)+|)+$|)+|)+|)^$} x } 0 test reg-33.27 {} { regexp {xyz(\Y\Y)+} x } 0 test reg-33.28 {} { regexp {x|(?:\M)+} x } 1 test reg-33.29 {} { # This is near the limits of the RE engine regexp [string repeat x*y*z* 480] x } 1 test reg-33.30 {Bug 1080042} { regexp {(\Y)+} foo } 1 test reg-33.31 {Bug 7c64aa5e1a} { regexp -inline {(?b).\{1,10\}} {abcdef} } abcdef # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/rename.test0000644000175000017500000001346214554262142015162 0ustar sergeisergei# Commands covered: rename # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testdel [llength [info commands testdel]] # Must eliminate the "unknown" command while the test is running, especially # if the test is being run in a program with its own special-purpose unknown # command. catch {rename unknown unknown.old} catch {rename r2 {}} proc r1 {} {return "procedure r1"} rename r1 r2 test rename-1.1 {simple renaming} { r2 } {procedure r1} test rename-1.2 {simple renaming} { list [catch r1 msg] $msg } {1 {invalid command name "r1"}} rename r2 {} test rename-1.3 {simple renaming} { list [catch r2 msg] $msg } {1 {invalid command name "r2"}} # The test below is tricky because it renames a built-in command. It's # possible that the test procedure uses this command, so must restore the # command before calling test again. rename list l.new set a [catch list msg1] set b [l.new a b c] rename l.new list set c [catch l.new msg2] set d [list 111 222] test rename-2.1 {renaming built-in command} { list $a $msg1 $b $c $msg2 $d } {1 {invalid command name "list"} {a b c} 1 {invalid command name "l.new"} {111 222}} test rename-3.1 {error conditions} { list [catch {rename r1} msg] $msg $errorCode } {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}} test rename-3.2 {error conditions} { list [catch {rename r1 r2 r3} msg] $msg $errorCode } {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}} test rename-3.3 {error conditions} -setup { proc r1 {} {} proc r2 {} {} } -returnCodes error -body { rename r1 r2 } -result {can't rename to "r2": command already exists} test rename-3.4 {error conditions} -setup { catch {rename r1 {}} catch {rename r2 {}} } -returnCodes error -body { rename r1 r2 } -result {can't rename "r1": command doesn't exist} test rename-3.5 {error conditions} -setup { catch {rename _non_existent_command {}} } -returnCodes error -body { rename _non_existent_command {} } -result {can't delete "_non_existent_command": command doesn't exist} catch {rename unknown {}} catch {rename unknown.old unknown} catch {rename bar {}} test rename-4.1 {reentrancy issues with command deletion and renaming} testdel { set x {} testdel {} foo {lappend x deleted; rename bar {}; lappend x [info command bar]} rename foo bar lappend x | rename bar {} set x } {| deleted {}} test rename-4.2 {reentrancy issues with command deletion and renaming} testdel { set x {} testdel {} foo {lappend x deleted; rename foo bar} rename foo {} set x } {deleted} test rename-4.3 {reentrancy issues with command deletion and renaming} testdel { set x {} testdel {} foo {lappend x deleted; testdel {} foo {lappend x deleted2}} rename foo {} lappend x | rename foo {} set x } {deleted | deleted2} test rename-4.4 {reentrancy issues with command deletion and renaming} testdel { set x {} testdel {} foo {lappend x deleted; rename foo bar} rename foo {} lappend x | [info command bar] } {deleted | {}} test rename-4.5 {reentrancy issues with command deletion and renaming} testdel { set env(value) before interp create foo testdel foo cmd {set env(value) deleted} interp delete foo set env(value) } {deleted} test rename-4.6 {reentrancy issues with command deletion and renaming} testdel { proc kill args { interp delete foo } set env(value) before interp create foo foo alias kill kill testdel foo cmd {set env(value) deleted; kill} list [catch {foo eval {rename cmd {}}} msg] $msg $env(value) } {0 {} deleted} test rename-4.7 {reentrancy issues with command deletion and renaming} testdel { proc kill args { interp delete foo } set env(value) before interp create foo foo alias kill kill testdel foo cmd {set env(value) deleted; kill} list [catch {interp delete foo} msg] $msg $env(value) } {0 {} deleted} if {[info exists env(value)]} { unset env(value) } test rename-4.8 {Bug a16752c252} testdel { set x broken testdel {} foo {set x ok} proc foo args {} rename foo {} return -level 0 $x[unset x] } ok # Save the unknown procedure which is modified by the following test. catch {rename unknown unknown.old} set SAVED_UNKNOWN "proc unknown " append SAVED_UNKNOWN [list [info args unknown.old] [info body unknown.old]] test rename-5.1 {repeated rename deletion and redefinition of same command} { for {set i 0} {$i < 10} {incr i} { eval $SAVED_UNKNOWN tcl_wordBreakBefore "" 0 rename tcl_wordBreakBefore {} rename unknown {} } } {} catch {rename unknown {}} catch {rename unknown.old unknown} test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed} -body { proc x {} { set a 123 set b [incr a] } x rename incr incr.old proc incr {} {puts "new incr called!"} x } -cleanup { rename incr {} rename incr.old incr } -returnCodes error -result {wrong # args: should be "incr"} if {[info commands incr.old] != {}} { catch {rename incr {}} catch {rename incr.old incr} } ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/resolver.test0000644000175000017500000002040014554262142015542 0ustar sergeisergei# This test collection covers some unwanted interactions between command # literal sharing and the use of command resolvers (per-interp) which cause # command literals to be re-used with their command references being invalid # in the reusing context. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2011 Gustaf Neumann # Copyright (c) 2011 Stefan Sobernig # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testinterpresolver [llength [info commands testinterpresolver]] test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup { testinterpresolver up namespace eval ::ns1 { proc z {} { return Z } namespace export z } proc ::y {} { return Y } proc ::x {} { z } } -constraints testinterpresolver -body { # 1) Have the proc body compiled: During compilation or, alternatively, # the first evaluation of the compiled body, the InterpCmdResolver (see # tclTest.c) maps the cmd token "z" to "::y"; this mapping is saved in the # resulting CmdName Tcl_Obj with the print string "z". The CmdName Tcl_Obj # is turned into a command literal shared for a given (here: the global) # namespace. set r0 [x]; # --> The result of [x] is "Y" # 2) After having requested cmd resolution above, we can now use the # globally shared CmdName Tcl_Obj "z", now bound to cmd ::y. This is # certainly questionable, but defensible set r1 [z]; # --> The result of [z] is "Y" # 3) We import from the namespace ns1 another z. [namespace import] takes # care "shadowed" cmd references, however, till now cmd literals have not # been touched. This is, however, necessary since the BC compiler (used in # the [namespace eval]) seems to be eager to reuse CmdName Tcl_Objs as cmd # literals for a given NS scope. We expect, that r2 is "Z", the result of # the namespace imported cmd. namespace eval :: { namespace import ::ns1::z set r2 [z] } list $r0 $r1 $::r2 } -cleanup { testinterpresolver down rename ::x "" rename ::y "" namespace delete ::ns1 } -result {Y Y Z} test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup { testinterpresolver up proc ::y {} { return Y } proc ::x {} { z } } -constraints testinterpresolver -body { set r0 [x] set r1 [z] proc ::foo {} { proc ::z {} { return Z } return [z] } list $r0 $r1 [::foo] } -cleanup { testinterpresolver down rename ::x "" rename ::y "" rename ::foo "" rename ::z "" } -result {Y Y Z} test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup { testinterpresolver up proc ::Z {} { return Z } proc ::y {} { return Y } proc ::x {} { z } } -constraints testinterpresolver -body { set r0 [x] set r1 [z] namespace eval :: { rename ::Z ::z set r2 [z] } list $r0 $r1 $r2 } -cleanup { testinterpresolver down rename ::x "" rename ::y "" rename ::z "" } -result {Y Y Z} test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup { testinterpresolver up proc ::Z {} { return Z } interp hide {} Z proc ::y {} { return Y } proc ::x {} { z } } -constraints testinterpresolver -body { set r0 [x] set r1 [z] interp expose {} Z z namespace eval :: { set r2 [z] } list $r0 $r1 $r2 } -cleanup { testinterpresolver down rename ::x "" rename ::y "" rename ::z "" } -result {Y Y Z} test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup { testinterpresolver up namespace eval ::ns1 { proc z {} { return Z } namespace export z } proc ::y {} { return Y } namespace eval ::ns2 { proc x {} { z } } namespace eval :: { variable r2 "" } } -constraints testinterpresolver -body { list [namespace eval ::ns2 {x}] [namespace eval ::ns2 {z}] [namespace eval ::ns2 { namespace import ::ns1::z z }] } -cleanup { testinterpresolver down namespace delete ::ns2 namespace delete ::ns1 } -result {Y Y Z} test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup { testinterpresolver up proc ::Z {} { return Z } proc ::y {} { return Y } proc ::x {} { z } } -constraints testinterpresolver -body { set r0 [x] set r1 [z] namespace eval :: { interp alias {} ::z {} ::Z set r2 [z] } list $r0 $r1 $r2 } -cleanup { testinterpresolver down rename ::x "" rename ::y "" rename ::Z "" } -result {Y Y Z} test resolver-2.1 {compiled var resolver: Bug #3383616} -setup { testinterpresolver up # The compiled var resolver fetches just variables starting with a capital # "T" and stores some test information in the resolver-specific resolver # var info. proc ::x {} { set T1 100 return $T1 } } -constraints testinterpresolver -body { # Call "x" the first time, causing a byte code compilation of the body. # During the compilation the compiled var resolver, the resolve-specific # var info is allocated, during the execution of the body, the variable is # fetched and cached. x # During later calls, the cached variable is reused. x # When the proc is freed, the resolver-specific resolver var info is # freed. This did not happen before fix #3383616. rename ::x "" } -cleanup { testinterpresolver down } -result {} # # The test resolver-3.1* test bad interactions of resolvers on the "global" # (per interp) literal pools. A resolver might resolve a cmd literal depending # on a context differently, whereas the cmd literal sharing assumed that the # namespace containing the literal solely determines the resolved cmd (and is # resolver-agnostic). # # In order to make the test cases for the per-interpreter cmd literal pool # reproducible and to minimize interactions between test cases, we use a child # interpreter per test-case. # # # Testing resolver in namespace-based context "ctx1" # test resolver-3.1a { interp command resolver, resolve literal "z" in proc "x1" in context "ctx1" } -setup { interp create i0 testinterpresolver up i0 i0 eval { proc y {} { return yy } namespace eval ::ns { proc x1 {} { z } } } } -constraints testinterpresolver -body { set r [i0 eval {namespace eval ::ctx1 { ::ns::x1 }}] return $r } -cleanup { testinterpresolver down i0 interp delete i0 } -result {yy} # # Testing resolver in namespace-based context "ctx2" # test resolver-3.1b { interp command resolver, resolve literal "z" in proc "x2" in context "ctx2" } -setup { interp create i0 testinterpresolver up i0 i0 eval { proc Y {} { return YY } namespace eval ::ns { proc x2 {} { z } } } } -constraints testinterpresolver -body { set r [i0 eval {namespace eval ::ctx2 { ::ns::x2 }}] return $r } -cleanup { testinterpresolver down i0 interp delete i0 } -result {YY} # # Testing resolver in namespace-based context "ctx1" and "ctx2" in the same # interpreter. # test resolver-3.1c { interp command resolver, resolve literal "z" in proc "x1" in context "ctx1", resolve literal "z" in proc "x2" in context "ctx2" Test, whether the shared cmd literal created by the first byte-code compilation interacts with the second one. } -setup { interp create i0 testinterpresolver up i0 i0 eval { proc y {} { return yy } proc Y {} { return YY } namespace eval ::ns { proc x1 {} { z } proc x2 {} { z } } } } -constraints testinterpresolver -body { set r1 [i0 eval {namespace eval ::ctx1 { ::ns::x1 }}] set r2 [i0 eval {namespace eval ::ctx2 { ::ns::x2 }}] set r3 [i0 eval {namespace eval ::ctx1 { ::ns::x1 }}] return [list $r1 $r2 $r3] } -cleanup { testinterpresolver down i0 interp delete i0 } -result {yy YY yy} cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/result.test0000644000175000017500000001250114554262142015222 0ustar sergeisergei# This file tests the routines in tclResult.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Some tests require the testsaveresult command testConstraint testsaveresult [llength [info commands testsaveresult]] testConstraint testsetobjerrorcode [llength [info commands testsetobjerrorcode]] testConstraint testseterrorcode [llength [info commands testseterrorcode]] testConstraint testreturn [llength [info commands testreturn]] test result-1.1 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult small {set x 42} 0 } {small result} test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult append {set x 42} 0 } {append result} test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 0 } {dynamic result notCalled present} test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 0 } {object result same} test result-1.5 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult small {set x 42} 1 } {42} test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult append {set x 42} 1 } {42} test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 1 } {42 called missing} test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 1 } {42 different} # Tcl_RestoreInterpResult is mostly tested by the previous tests except # for the following case test result-2.1 {Tcl_RestoreInterpResult} {testsaveresult} { testsaveresult append {cd _foobar} 0 } {append result} # Tcl_DiscardInterpResult is mostly tested by the previous tests except # for the following cases test result-3.1 {Tcl_DiscardInterpResult} -constraints testsaveresult -body { testsaveresult append {cd _foobar} 1 } -returnCodes error -result {couldn't change working directory to "_foobar": no such file or directory} test result-3.2 {Tcl_DiscardInterpResult} {testsaveresult} { testsaveresult free {set x 42} 1 } {42} test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsetobjerrorcode} { catch {testsetobjerrorcode 1} list [set errorCode] } {1} test result-4.2 {Tcl_SetObjErrorCode - two args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2} list [set errorCode] } {{1 2}} test result-4.3 {Tcl_SetObjErrorCode - three args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3} list [set errorCode] } {{1 2 3}} test result-4.4 {Tcl_SetObjErrorCode - four args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3 4} list [set errorCode] } {{1 2 3 4}} test result-4.5 {Tcl_SetObjErrorCode - five args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3 4 5} list [set errorCode] } {{1 2 3 4 5}} test result-5.1 {Tcl_SetErrorCode - one arg} testseterrorcode { catch {testseterrorcode 1} set errorCode } 1 test result-5.2 {Tcl_SetErrorCode - one arg, list quoting} testseterrorcode { catch {testseterrorcode {a b}} set errorCode } {{a b}} test result-5.3 {Tcl_SetErrorCode - one arg, list quoting} testseterrorcode { catch {testseterrorcode \{} llength $errorCode } 1 test result-5.4 {Tcl_SetErrorCode - two args, list quoting} testseterrorcode { catch {testseterrorcode {a b} c} set errorCode } {{a b} c} test result-6.0 {Bug 1209759} -constraints testreturn -body { # Might panic if bug is not fixed. proc foo {} {testreturn} foo } -returnCodes ok -result {} test result-6.1 {Bug 1209759} -constraints testreturn -body { # Might panic if bug is not fixed. proc foo {} {catch {return -level 2}; testreturn} foo } -cleanup { rename foo {} } -returnCodes ok -result {} test result-6.2 {Bug 1649062} -setup { proc foo {} { if {[catch { return -code error -errorinfo custom -errorcode CUSTOM foo } err]} { return [list $err $::errorCode $::errorInfo] } } set ::errorInfo {} set ::errorCode {} } -body { foo } -cleanup { rename foo {} } -result {foo {} {}} test result-6.3 {Bug 2383005} { catch {return -code error -errorcode {{}a} eek} m set m } {bad -errorcode value: expected a list but got "{}a"} test result-6.4 {non-list -errorstack} -body { catch {return -code error -errorstack {{}a} eek} m o list $m [dict get $o -errorcode] [dict get $o -errorstack] } -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}} test result-6.5 {odd-sized-list -errorstack} -body { catch {return -code error -errorstack a eek} m o list $m [dict get $o -errorcode] [dict get $o -errorstack] } -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}} # cleanup cleanupTests return tcl8.6.14/tests/safe-stock.test0000644000175000017500000001006614554262142015747 0ustar sergeisergei# safe-stock.test -- # # This file contains tests for safe Tcl that were previously in the file # safe.test, and use files and packages of stock Tcl 8.6 to perform the tests. # These files may be changed or disappear in future revisions of Tcl, # for example package http 1.0 will be removed from Tcl 8.7. # # The tests are replaced in safe.tcl with tests that use files provided in the # tests directory. Test numbering is for comparison with similar tests in # safe.test. # # Sourcing this file into tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } foreach i [interp children] { interp delete $i } set SaveAutoPath $::auto_path set ::auto_path [info library] set TestsDir [file normalize [file dirname [info script]]] set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR] proc mapList {map listIn} { set listOut {} foreach element $listIn { lappend listOut [string map $map $element] } return $listOut } # Force actual loading of the safe package because we use unexported (and # thus unautoindexed) APIs in this test result arguments: catch {safe::interpConfigure} # high level general test test safe-stock-7.1 {tests that everything works at high level, uses http 2} -body { set i [safe::interpCreate] # no error shall occur: # (because the default access_path shall include 1st level sub dirs so # package require in a child works like in the parent) set v [interp eval $i {package require http 2}] # no error shall occur: interp eval $i {http::config} safe::interpDelete $i set v } -match glob -result 2.* test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath, uses http1.0} -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] # should add as p1 set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] # an error shall occur (http is not anymore in the secure 0-level # provided deep path) list $token1 $token2 -- \ [catch {interp eval $i {package require http 1}} msg] $msg -- \ $mappA -- [safe::interpDelete $i] } -match glob -result {{$p(:0:)} {$p(:*:)} -- 1 {can't find package http 1} --\ {TCLLIB */dummy/unixlike/test/path} -- {}} test safe-stock-7.4 {tests specific path and positive search, uses http1.0} -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] # should add as p1 set token2 [safe::interpAddToAccessPath $i [file join [info library] http1.0]] set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] # this time, unlike test safe-stock-7.2, http should be found list $token1 $token2 -- \ [catch {interp eval $i {package require http 1}} msg] $msg -- \ $mappA -- [safe::interpDelete $i] } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.0 -- {TCLLIB *TCLLIB/http1.0} -- {}} # The following test checks whether the definition of tcl_endOfWord can be # obtained from auto_loading. It was previously test "safe-5.1". test safe-stock-9.8 {test auto-loading in safe interpreters, was test 5.1} -setup { catch {safe::interpDelete a} safe::interpCreate a } -body { interp eval a {tcl_endOfWord "" 0} } -cleanup { safe::interpDelete a } -result -1 set ::auto_path $SaveAutoPath unset SaveAutoPath TestsDir PathMapp rename mapList {} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/safe.test0000644000175000017500000020733414554262142014634 0ustar sergeisergei# safe.test -- # # This file contains a collection of tests for safe Tcl, packages loading, and # using safe interpreters. Sourcing this file into tcl runs the tests and # generates output for errors. No output means no errors were found. # # The package http 1.0 is convenient for testing package loading, but will soon # be removed. # - Tests that use http are replaced here with tests that use example packages # provided in subdirectory auto0 of the tests directory, which are independent # of any changes made to the packages provided with Tcl itself. # - These are tests 7.1 7.2 7.4 9.11 9.13 # - Tests 5.* test the example packages themselves before they # are used to test Safe Base interpreters. # - Alternative tests using stock packages of Tcl 8.6 are in file # safe-stock.test. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } foreach i [interp children] { interp delete $i } set SaveAutoPath $::auto_path set ::auto_path [info library] set TestsDir [file normalize [file dirname [info script]]] set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR] proc mapList {map listIn} { set listOut {} foreach element $listIn { lappend listOut [string map $map $element] } return $listOut } proc mapAndSortList {map listIn} { set listOut {} foreach element $listIn { lappend listOut [string map $map $element] } lsort $listOut } # Force actual loading of the safe package because we use unexported (and # thus unautoindexed) APIs in this test result arguments: catch {safe::interpConfigure} # testing that nested and statics do what is advertised (we use a static # package - Tcltest - but it might be absent if we're in standard tclsh) testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}] test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body { safe::interpConfigure } -result {no value given for parameter "slave" (use -help for full usage) : slave name () name of the slave} test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body { safe::interpCreate -help } -result {Usage information: Var/FlagName Type Value Help ------------ ---- ----- ---- (-help gives this help) ?slave? name () name of the slave (optional) -accessPath list () access path for the slave -noStatics boolflag (false) prevent loading of statically linked pkgs -statics boolean (true) loading of statically linked pkgs -nestedLoadOk boolflag (false) allow nested loading -nested boolean (false) nested loading -deleteHook script () delete hook} test safe-1.3 {safe::interpInit syntax} -returnCodes error -body { safe::interpInit -noStatics } -result {bad value "-noStatics" for parameter slave name () name of the slave} test safe-2.1 {creating interpreters, should have no aliases} emptyTest { # Disabled this test. It tests nothing sensible. [Bug 999612] # interp aliases } "" test safe-2.2 {creating interpreters, should have no aliases} -setup { catch {safe::interpDelete a} } -body { interp create a a aliases } -cleanup { safe::interpDelete a # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters # is regrettable and should be removed at the next major revision. } -result "" test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup { catch {safe::interpDelete a} } -body { interp create a -safe lsort [a aliases] } -cleanup { interp delete a } -result {::tcl::mathfunc::max ::tcl::mathfunc::min clock} test safe-3.1 {calling safe::interpInit is safe} -setup { catch {safe::interpDelete a} interp create a -safe } -body { safe::interpInit a interp eval a exec ls } -returnCodes error -cleanup { safe::interpDelete a } -result {invalid command name "exec"} test safe-3.2 {calling safe::interpCreate on trusted interp} -setup { catch {safe::interpDelete a} } -body { safe::interpCreate a lsort [a aliases] } -cleanup { safe::interpDelete a } -result {::tcl::file::atime ::tcl::file::attributes ::tcl::file::copy ::tcl::file::delete ::tcl::file::dirname ::tcl::file::executable ::tcl::file::exists ::tcl::file::extension ::tcl::file::isdirectory ::tcl::file::isfile ::tcl::file::link ::tcl::file::lstat ::tcl::file::mkdir ::tcl::file::mtime ::tcl::file::nativename ::tcl::file::normalize ::tcl::file::owned ::tcl::file::readable ::tcl::file::readlink ::tcl::file::rename ::tcl::file::rootname ::tcl::file::size ::tcl::file::stat ::tcl::file::tail ::tcl::file::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source} test safe-3.3 {calling safe::interpCreate on trusted interp} -setup { catch {safe::interpDelete a} } -body { safe::interpCreate a interp eval a {source [file join $tcl_library init.tcl]} } -cleanup { safe::interpDelete a } -result "" test safe-3.4 {calling safe::interpCreate on trusted interp} -setup { catch {safe::interpDelete a} } -body { safe::interpCreate a interp eval a {source [file join $tcl_library init.tcl]} } -cleanup { safe::interpDelete a } -result {} test safe-4.1 {safe::interpDelete} -setup { catch {safe::interpDelete a} } -body { interp create a safe::interpDelete a # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters # is regrettable and should be removed at the next major revision. } -result "" test safe-4.2 {safe::interpDelete, indirectly} -setup { catch {safe::interpDelete a} } -body { interp create a a alias exit safe::interpDelete a a eval exit # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters # is regrettable and should be removed at the next major revision. } -result "" test safe-4.5 {safe::interpDelete} -setup { catch {safe::interpDelete a} } -body { safe::interpCreate a safe::interpCreate a } -returnCodes error -cleanup { safe::interpDelete a } -result {interpreter named "a" already exists, cannot create} test safe-4.6 {safe::interpDelete, indirectly} -setup { catch {safe::interpDelete a} } -body { safe::interpCreate a a eval exit } -result "" # The old test "safe-5.1" has been moved to "safe-stock-9.8". # A replacement test using example files is "safe-9.8". # Tests 5.* test the example files before using them to test safe interpreters. unset -nocomplain path test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2] } -body { # Try to load the commands. set code3 [catch report1 msg3] set code4 [catch report2 msg4] list $code3 $msg3 $code4 $msg4 } -cleanup { catch {rename report1 {}} catch {rename report2 {}} set ::auto_path $tmpAutoPath auto_reset } -match glob -result {0 ok1 0 ok2} test safe-5.2 {example tclIndex commands, negative test in parent interpreter} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0] } -body { # Try to load the commands. set code3 [catch report1 msg3] set code4 [catch report2 msg4] list $code3 $msg3 $code4 $msg4 } -cleanup { catch {rename report1 {}} catch {rename report2 {}} set ::auto_path $tmpAutoPath auto_reset } -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}} test safe-5.3 {example pkgIndex.tcl packages, test in parent interpreter, child directories} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0] } -body { # Try to load the packages and run a command from each one. set code3 [catch {package require SafeTestPackage1} msg3] set code4 [catch {package require SafeTestPackage2} msg4] set code5 [catch HeresPackage1 msg5] set code6 [catch HeresPackage2 msg6] list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6 } -cleanup { set ::auto_path $tmpAutoPath catch {package forget SafeTestPackage1} catch {package forget SafeTestPackage2} catch {rename HeresPackage1 {}} catch {rename HeresPackage2 {}} } -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2} test safe-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2] } -body { # Try to load the packages and run a command from each one. set code3 [catch {package require SafeTestPackage1} msg3] set code4 [catch {package require SafeTestPackage2} msg4] set code5 [catch HeresPackage1 msg5] set code6 [catch HeresPackage2 msg6] list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6 } -cleanup { set ::auto_path $tmpAutoPath catch {package forget SafeTestPackage1} catch {package forget SafeTestPackage2} catch {rename HeresPackage1 {}} catch {rename HeresPackage2 {}} } -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2} test safe-5.5 {example modules packages, test in parent interpreter, replace path} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { # Try to load the modules and run a command from each one. set code0 [catch {package require test0} msg0] set code1 [catch {package require mod1::test1} msg1] set code2 [catch {package require mod2::test2} msg2] set out0 [test0::try0] set out1 [mod1::test1::try1] set out2 [mod2::test2::try2] list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } catch {package forget test0} catch {package forget mod1::test1} catch {package forget mod2::test2} catch {namespace delete ::test0} catch {namespace delete ::mod1} } -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} test safe-5.6 {example modules packages, test in parent interpreter, append to path} -setup { tcl::tm::path add [file join $TestsDir auto0 modules] } -body { # Try to load the modules and run a command from each one. set code0 [catch {package require test0} msg0] set code1 [catch {package require mod1::test1} msg1] set code2 [catch {package require mod2::test2} msg2] set out0 [test0::try0] set out1 [mod1::test1::try1] set out2 [mod2::test2::try2] list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] catch {package forget test0} catch {package forget mod1::test1} catch {package forget mod2::test2} catch {namespace delete ::test0} catch {namespace delete ::mod1} } -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} # test safe interps 'information leak' proc SafeEval {script} { # Helper procedure that ensures the safe interp is cleaned up even if # there is a failure in the script. set SafeInterp [interp create -safe] catch {$SafeInterp eval $script} msg opts interp delete $SafeInterp return -options $opts $msg } test safe-6.1 {test safe interpreters knowledge of the world} { lsort [SafeEval {info globals}] } {tcl_interactive tcl_patchLevel tcl_platform tcl_version} test safe-6.2 {test safe interpreters knowledge of the world} { SafeEval {info script} } {} test safe-6.3 {test safe interpreters knowledge of the world} { set r [SafeEval {array names tcl_platform}] # If running a windows-debug shell, remove the "debug" element from r. if {[testConstraint win]} { set r [lsearch -all -inline -not -exact $r "debug"] } set r [lsearch -all -inline -not -exact $r "threaded"] lsort $r } {byteOrder engine pathSeparator platform pointerSize wordSize} rename SafeEval {} # More test should be added to check that hostname, nameofexecutable, aren't # leaking infos, but they still do... # high level general test # Use example packages not http1.0 etc test safe-7.1 {tests that everything works at high level} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0] set i [safe::interpCreate] set ::auto_path $tmpAutoPath } -body { # no error shall occur: # (because the default access_path shall include 1st level sub dirs so # package require in a child works like in the parent) set v [interp eval $i {package require SafeTestPackage1}] # no error shall occur: interp eval $i {HeresPackage1} set v } -cleanup { safe::interpDelete $i } -match glob -result 1.2.3 test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup { } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] # should add as p* (not p1 if parent has a module path) set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] # should add as p* (not p2 if parent has a module path) set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level # provided deep path) list $token1 $token2 $token3 -- \ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ $mappA -- [safe::interpDelete $i] } -cleanup { } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\ 1 {can't find package SafeTestPackage1} --\ {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}} test safe-7.3 {check that safe subinterpreters work} { set g [interp children] if {$g ne {}} { append g { -- residue of an earlier test} } set h [info vars ::safe::S*] if {$h ne {}} { append h { -- residue of an earlier test} } set i [safe::interpCreate] set j [safe::interpCreate [list $i x]] list $g $h [interp eval $j {join {o k} ""}] [safe::interpDelete $i] \ [interp exists $j] [info vars ::safe::S*] } {{} {} ok {} 0 {}} test safe-7.3.1 {check that safe subinterpreters work with namespace names} -setup { } -body { set g [interp children] if {$g ne {}} { append g { -- residue of an earlier test} } set h [info vars ::safe::S*] if {$h ne {}} { append h { -- residue of an earlier test} } set i [safe::interpCreate foo::bar] set j [safe::interpCreate [list $i hello::world]] list $g $h [interp eval $j {join {o k} ""}] \ [foo::bar eval {hello::world eval {join {o k} ""}}] \ [safe::interpDelete $i] \ [interp exists $j] [info vars ::safe::S*] } -match glob -result {{} {} ok ok {} 0 {}} test safe-7.4 {tests specific path and positive search} -setup { } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] # should add as p* (not p1 if parent has a module path) set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]] set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] # this time, unlike test safe-7.2, SafeTestPackage1 should be found list $token1 $token2 -- \ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ $mappA -- [safe::interpDelete $i] # Note that the glob match elides directories (those from the module path) # other than the first and last in the access path. } -cleanup { } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\ {TCLLIB * TESTSDIR/auto0/auto1} -- {}} # test source control on file name test safe-8.1 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} } -body { safe::interpCreate $i $i eval {source} } -returnCodes error -cleanup { safe::interpDelete $i unset i } -result {wrong # args: should be "source ?-encoding E? fileName"} test safe-8.2 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} } -body { safe::interpCreate $i $i eval {source a b c d e} } -returnCodes error -cleanup { safe::interpDelete $i unset i } -result {wrong # args: should be "source ?-encoding E? fileName"} test safe-8.3 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {lappend ::log $str} set prevlog [safe::setLogCmd] } -body { safe::interpCreate $i safe::setLogCmd safe-test-log list [catch {$i eval {source .}} msg] $msg $log } -cleanup { safe::setLogCmd $prevlog safe::interpDelete $i rename safe-test-log {} unset i log } -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}} test safe-8.4 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} set prevlog [safe::setLogCmd] } -body { safe::interpCreate $i safe::setLogCmd safe-test-log list [catch {$i eval {source /abc/def}} msg] $msg $log } -cleanup { safe::setLogCmd $prevlog safe::interpDelete $i rename safe-test-log {} unset i log } -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}} test safe-8.5 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} set prevlog [safe::setLogCmd] } -body { # This tested filename == *.tcl or tclIndex, but that restriction was # removed in 8.4a4 - hobbs safe::interpCreate $i safe::setLogCmd safe-test-log list [catch { $i eval {source [file join [info lib] blah]} } msg] $msg $log } -cleanup { safe::setLogCmd $prevlog safe::interpDelete $i rename safe-test-log {} unset i log } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]] test safe-8.6 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} set prevlog [safe::setLogCmd] } -body { safe::interpCreate $i safe::setLogCmd safe-test-log list [catch { $i eval {source [file join [info lib] blah.tcl]} } msg] $msg $log } -cleanup { safe::setLogCmd $prevlog safe::interpDelete $i rename safe-test-log {} unset i log } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]] test safe-8.7 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} set prevlog [safe::setLogCmd] } -body { safe::interpCreate $i # This tested length of filename, but that restriction was removed in # 8.4a4 - hobbs safe::setLogCmd safe-test-log list [catch { $i eval {source [file join [info lib] xxxxxxxxxxx.tcl]} } msg] $msg $log } -cleanup { safe::setLogCmd $prevlog safe::interpDelete $i rename safe-test-log {} unset i log } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]] test safe-8.8 {safe source forbids -rsrc} emptyTest { # Disabled this test. It was only useful for long unsupported # Mac OS 9 systems. [Bug 860a9f1945] } {} test safe-8.9 {safe source and return} -setup { set i "a" set returnScript [makeFile {return "ok"} return.tcl] catch {safe::interpDelete $i} } -body { safe::interpCreate $i set token [safe::interpAddToAccessPath $i [file dirname $returnScript]] $i eval [list source $token/[file tail $returnScript]] } -cleanup { catch {safe::interpDelete $i} removeFile $returnScript unset i } -result ok test safe-8.10 {safe source and return} -setup { set i "a" set returnScript [makeFile {return -level 2 "ok"} return.tcl] catch {safe::interpDelete $i} } -body { safe::interpCreate $i set token [safe::interpAddToAccessPath $i [file dirname $returnScript]] $i eval [list apply {filename { source $filename error boom }} $token/[file tail $returnScript]] } -cleanup { catch {safe::interpDelete $i} removeFile $returnScript unset i } -result ok test safe-9.1 {safe interps' deleteHook} -setup { set i "a" catch {safe::interpDelete $i} set res {} } -body { proc testDelHook {args} { global res # the interp still exists at that point interp eval a {set delete 1} # mark that we've been here (successfully) set res $args } safe::interpCreate $i -deleteHook "testDelHook arg1 arg2" list [interp eval $i exit] $res } -cleanup { catch {rename testDelHook {}} unset i res } -result {{} {arg1 arg2 a}} test safe-9.2 {safe interps' error in deleteHook} -setup { set i "a" catch {safe::interpDelete $i} set res {} set log {} proc safe-test-log {str} {lappend ::log $str} set prevlog [safe::setLogCmd] } -body { proc testDelHook {args} { global res # the interp still exists at that point interp eval a {set delete 1} # mark that we've been here (successfully) set res $args # create an exception error "being catched" } safe::interpCreate $i -deleteHook "testDelHook arg1 arg2" safe::setLogCmd safe-test-log list [safe::interpDelete $i] $res $log } -cleanup { safe::setLogCmd $prevlog catch {rename testDelHook {}} rename safe-test-log {} unset i log res } -result {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}}} test safe-9.3 {dual specification of statics} -returnCodes error -body { safe::interpCreate -stat true -nostat } -result {conflicting values given for -statics and -noStatics} test safe-9.4 {dual specification of statics} { # no error shall occur safe::interpDelete [safe::interpCreate -stat false -nostat] } {} test safe-9.5 {dual specification of nested} -returnCodes error -body { safe::interpCreate -nested 0 -nestedload } -result {conflicting values given for -nested and -nestedLoadOk} test safe-9.6 {interpConfigure widget like behaviour} -body { # this test shall work, don't try to "fix it" unless you *really* know what # you are doing (ie you are me :p) -- dl list [set i [safe::interpCreate \ -noStatics \ -nestedLoadOk \ -deleteHook {foo bar}] safe::interpConfigure $i -accessPath /foo/bar safe::interpConfigure $i]\ [safe::interpConfigure $i -aCCess]\ [safe::interpConfigure $i -nested]\ [safe::interpConfigure $i -statics]\ [safe::interpConfigure $i -DEL]\ [safe::interpConfigure $i -accessPath /blah -statics 1 safe::interpConfigure $i]\ [safe::interpConfigure $i -deleteHook toto -nosta -nested 0 safe::interpConfigure $i] } -cleanup { safe::interpDelete $i } -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\ {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\ {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\ {-accessPath * -statics 0 -nested 0 -deleteHook toto}} test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body { # this test shall work, believed equivalent to 9.6 set i [safe::interpCreate \ -noStatics \ -nestedLoadOk \ -deleteHook {foo bar}] safe::interpConfigure $i -accessPath /foo/bar set a [safe::interpConfigure $i] set b [safe::interpConfigure $i -aCCess] set c [safe::interpConfigure $i -nested] set d [safe::interpConfigure $i -statics] set e [safe::interpConfigure $i -DEL] safe::interpConfigure $i -accessPath /blah -statics 1 set f [safe::interpConfigure $i] safe::interpConfigure $i -deleteHook toto -nosta -nested 0 set g [safe::interpConfigure $i] list $a $b $c $d $e $f $g } -cleanup { safe::interpDelete $i unset -nocomplain a b c d e f g i } -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\ {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\ {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\ {-accessPath * -statics 0 -nested 0 -deleteHook toto}} test safe-9.8 {test autoloading commands indexed in tclIndex files} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load and run the commands. set code1 [catch {interp eval $i {report1}} msg1] set code2 [catch {interp eval $i {report2}} msg2] list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}} test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load auto_load data. interp eval $i {catch nonExistentCommand} # Load and run the commands. # This guarantees the test will pass even if the tokens are swapped. set code1 [catch {interp eval $i {report1}} msg1] set code2 [catch {interp eval $i {report2}} msg2] # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Run the commands. set code3 [catch {interp eval $i {report1}} msg3] set code4 [catch {interp eval $i {report2}} msg4] list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}} test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load auto_load data. interp eval $i {catch nonExistentCommand} # Do not load the commands. With the tokens swapped, the test # will pass only if the Safe Base has called auto_reset. # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load and run the commands. set code3 [catch {interp eval $i {report1}} msg3] set code4 [catch {interp eval $i {report2}} msg4] list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}} test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup { } -body { # For complete correspondence to safe-9.10opt, include auto0 in access path. set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0] \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load pkgIndex.tcl data. catch {interp eval $i {package require NOEXIST}} # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}. # This would have no effect because the records in Pkg of these directories # were from access as children of {$p(:1:)}. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0] \ [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Try to load the packages and run a command from each one. set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ 0 OK1 0 OK2} test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load pkgIndex.tcl data. catch {interp eval $i {package require NOEXIST}} # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Try to load the packages and run a command from each one. set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ $mappA -- $mappB -- \ $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ 0 1.2.3 0 2.3.4 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ 0 OK1 0 OK2} test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load pkgIndex.tcl data. catch {interp eval $i {package require NOEXIST}} # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}. safe::interpConfigure $i -accessPath [list $tcl_library] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4] set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5] # Try to load the packages. set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3] set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6] list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \ $mappA -- $mappB } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ 1 {* not found in access path} -- 1 1 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}} test safe-9.20 {check module loading} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} -- res0 res1 res2} # - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in # tokenized form to the child's access path, and then adds all the # descendants, discovered recursively by using glob. # - The order of the directories in the list returned by glob is system-dependent, # and therefore this is true also for (a) the order of token assignment to # descendants of the [tcl::tm::list] roots; and (b) the order of those same # directories in the access path. Both those things must be sorted before # comparing with expected results. The test is therefore not totally strict, # but will notice missing or surplus directories. test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Add to access path. # This injects more tokens, pushing modules to higher token numbers. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Load pkg data. catch {interp eval $i {package require NOEXIST}} catch {interp eval $i {package require mod1::NOEXIST}} catch {interp eval $i {package require mod2::NOEXIST}} # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Add to access path. # This injects more tokens, pushing modules to higher token numbers. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Force the interpreter to acquire pkg data which will soon become stale. catch {interp eval $i {package require NOEXIST}} catch {interp eval $i {package require mod1::NOEXIST}} catch {interp eval $i {package require mod2::NOEXIST}} # Add to access path. # This injects more tokens, pushing modules to higher token numbers. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Refresh stale pkg data. catch {interp eval $i {package require NOEXIST}} catch {interp eval $i {package require mod1::NOEXIST}} catch {interp eval $i {package require mod2::NOEXIST}} # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Force the interpreter to acquire pkg data which will soon become stale. catch {interp eval $i {package require NOEXIST}} catch {interp eval $i {package require mod1::NOEXIST}} catch {interp eval $i {package require mod2::NOEXIST}} # Add to access path. # This injects more tokens, pushing modules to higher token numbers. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. catch {teststaticpkg Safepkg1 0 0} test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] } -body { interp eval $i {load {} Safepkg1} } -returnCodes error -cleanup { safe::interpDelete $i } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] } -body { catch {interp eval $i {load {} Safepkg1}} m o dict get $o -errorinfo } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure invoked from within "load {} Safepkg1" invoked from within "interp eval $i {load {} Safepkg1}"} test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body { set i [safe::interpCreate -nostatics] interp eval $i {load {} Safepkg1} } -returnCodes error -cleanup { safe::interpDelete $i } -result {permission denied (static package)} test safe-10.3 {testing nested statics loading / no nested by default} -setup { set i [safe::interpCreate] } -constraints TcltestPackage -body { interp eval $i {interp create x; load {} Safepkg1 x} } -returnCodes error -cleanup { safe::interpDelete $i } -result {permission denied (nested load)} test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body { set i [safe::interpCreate -nestedloadok] interp eval $i {interp create x; load {} Safepkg1 x} } -returnCodes error -cleanup { safe::interpDelete $i } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body { set i [safe::interpCreate -nestedloadok] catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o dict get $o -errorinfo } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure invoked from within "load {} Safepkg1 x" invoked from within "interp eval $i {interp create x; load {} Safepkg1 x}"} test safe-11.1 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding } -returnCodes error -cleanup { safe::interpDelete $i } -result {wrong # args: should be "encoding option ?arg ...?"} test safe-11.1a {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding foobar } -returnCodes error -cleanup { safe::interpDelete $i } -match glob -result {bad option "foobar": must be *} test safe-11.2 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding system cp775 } -returnCodes error -cleanup { safe::interpDelete $i } -result {wrong # args: should be "encoding system"} test safe-11.3 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding system } -cleanup { safe::interpDelete $i } -result [encoding system] test safe-11.4 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding names } -cleanup { safe::interpDelete $i } -result [encoding names] test safe-11.5 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding convertfrom cp1258 foobar } -cleanup { safe::interpDelete $i } -result foobar test safe-11.6 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding convertto cp1258 foobar } -cleanup { safe::interpDelete $i } -result foobar test safe-11.7 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding convertfrom } -returnCodes error -cleanup { safe::interpDelete $i } -result {wrong # args: should be "encoding convertfrom ?encoding? data"} test safe-11.7.1 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { catch {interp eval $i encoding convertfrom} m o dict get $o -errorinfo } -returnCodes ok -match glob -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {wrong # args: should be "encoding convertfrom ?encoding? data" while executing "encoding convertfrom" invoked from within "::interp invokehidden interp* encoding convertfrom" invoked from within "encoding convertfrom" invoked from within "interp eval $i encoding convertfrom"} test safe-11.8 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding convertto } -returnCodes error -cleanup { safe::interpDelete $i } -result {wrong # args: should be "encoding convertto ?encoding? data"} test safe-11.8.1 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { catch {interp eval $i encoding convertto} m o dict get $o -errorinfo } -returnCodes ok -match glob -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {wrong # args: should be "encoding convertto ?encoding? data" while executing "encoding convertto" invoked from within "::interp invokehidden interp* encoding convertto" invoked from within "encoding convertto" invoked from within "interp eval $i encoding convertto"} test safe-12.1 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob ../* } -returnCodes error -cleanup { safe::interpDelete $i } -result "permission denied" test safe-12.2 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -directory .. * } -returnCodes error -cleanup { safe::interpDelete $i } -result "permission denied" test safe-12.3 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -join .. * } -returnCodes error -cleanup { safe::interpDelete $i } -result "permission denied" test safe-12.4 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -nocomplain ../* } -cleanup { safe::interpDelete $i } -result {} test safe-12.5 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -directory .. -nocomplain * } -cleanup { safe::interpDelete $i } -result {} test safe-12.6 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -nocomplain -join .. * } -cleanup { safe::interpDelete $i } -result {} test safe-12.7 {glob is restricted} -setup { set i [safe::interpCreate] } -body { $i eval glob * } -returnCodes error -cleanup { safe::interpDelete $i } -result {permission denied} proc buildEnvironment {filename} { upvar 1 testdir testdir testdir2 testdir2 testfile testfile set testdir [makeDirectory deletethisdir] set testdir2 [makeDirectory deletemetoo $testdir] set testfile [makeFile {} $filename $testdir2] } proc buildEnvironment2 {filename} { upvar 1 testdir testdir testdir2 testdir2 testfile testfile upvar 1 testdir3 testdir3 testfile2 testfile2 set testdir [makeDirectory deletethisdir] set testdir2 [makeDirectory deletemetoo $testdir] set testfile [makeFile {} $filename $testdir2] set testdir3 [makeDirectory deleteme $testdir] set testfile2 [makeFile {} $filename $testdir3] } #### New tests for Safe base glob, with patches @ Bug 2964715 test safe-13.1 {glob is restricted [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { $i eval glob * } -returnCodes error -cleanup { safe::interpDelete $i } -result {permission denied} test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment deleteme.tm } -body { ::safe::interpAddToAccessPath $i $testdir2 set result [$i eval glob -nocomplain -directory $testdir2 *.tm] if {$result eq [list $testfile]} { return "glob match" } else { return "no match: $result" } } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {glob match} test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment deleteme.tm } -body { $i eval glob -directory $testdir2 *.tm } -returnCodes error -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {permission denied} test safe-13.4 {another valid glob call [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment deleteme.tm } -body { ::safe::interpAddToAccessPath $i $testdir ::safe::interpAddToAccessPath $i $testdir2 set result [$i eval \ glob -nocomplain -directory $testdir [file join deletemetoo *.tm]] if {$result eq [list $testfile]} { return "glob match" } else { return "no match: $result" } } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {glob match} test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment deleteme.tm } -body { ::safe::interpAddToAccessPath $i $testdir2 $i eval \ glob -directory $testdir [file join deletemetoo *.tm] } -returnCodes error -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {permission denied} test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment deleteme.tm } -body { ::safe::interpAddToAccessPath $i $testdir $i eval \ glob -nocomplain -directory $testdir [file join deletemetoo *.tm] } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {} test safe-13.7 {mimic the glob call by tclPkgUnknown in a safe interpreter [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment pkgIndex.tcl } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 mapList [list $safeTD EXPECTED] [$i eval [list \ glob -directory $safeTD -join * pkgIndex.tcl]] } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {EXPECTED/deletemetoo/pkgIndex.tcl} test safe-13.7.1 {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup { set i [safe::interpCreate] buildEnvironment2 pkgIndex.tcl } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 ::safe::interpAddToAccessPath $i $testdir3 mapAndSortList [list $safeTD EXPECTED] [$i eval [list \ glob -directory $safeTD -join * pkgIndex.tcl]] } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl} # See comments on lsort after test safe-9.20. test safe-13.8 {mimic the glob call by tclPkgUnknown without the special treatment that is specific to pkgIndex.tcl [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment notIndex.tcl } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl] } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {} test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment notIndex.tcl } -body { ::safe::interpAddToAccessPath $i $testdir2 set result [$i eval \ glob -directory $testdir -join -nocomplain * notIndex.tcl] if {$result eq [list $testfile]} { return {glob match} } else { return "no match: $result" } } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {no match: } test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment notIndex.tcl } -body { ::safe::interpAddToAccessPath $i $testdir $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {} rename buildEnvironment {} rename buildEnvironment2 {} #### Test for the module path test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { set tm {} foreach token [$i eval ::tcl::tm::path list] { lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token] } return $tm } -cleanup { safe::interpDelete $i } -result [::tcl::tm::path list] test safe-15.1 {safe file ensemble does not surprise code} -setup { set i [interp create -safe] } -body { set result [expr {"file" in [interp hidden $i]}] lappend result [interp eval $i {tcl::file::split a/b/c}] lappend result [catch {interp eval $i {tcl::file::isdirectory .}}] lappend result [interp invokehidden $i file split a/b/c] lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg lappend result [catch {interp invokehidden $i file isdirectory .}] interp expose $i file lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg } -cleanup { unset -nocomplain msg interp delete $i } -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}} test safe-15.2 {safe file ensemble does not surprise code} -setup { set i [interp create -safe] } -body { set result [expr {"file" in [interp hidden $i]}] lappend result [interp eval $i {tcl::file::split a/b/c}] lappend result [catch {interp eval $i {tcl::file::isdirectory .}}] lappend result [interp invokehidden $i file split a/b/c] lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg lappend result [catch {interp invokehidden $i file isdirectory .}] interp expose $i file lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo] } -cleanup { unset -nocomplain msg o interp delete $i } -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file while executing "file isdirectory ." invoked from within "interp eval $i {file isdirectory .}"}} ### ~ should have no special meaning in paths in safe interpreters test safe-16.1 {Bug 3529949: defang ~ in paths} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar set i [safe::interpCreate] } -body { $i eval { set d [format %c 126] list [file join [file dirname $d] [file tail $d]] } } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME unset savedHOME } -result {./~} test safe-16.2 {Bug 3529949: defang ~user in paths} -setup { set i [safe::interpCreate] set user $tcl_platform(user) } -body { string map [list $user USER] [$i eval \ "file join \[file dirname ~$user\] \[file tail ~$user\]"] } -cleanup { safe::interpDelete $i unset user } -result {./~USER} test safe-16.3 {Bug 3529949: defang ~ in globs} -setup { set syntheticHOME [makeDirectory foo] makeFile {} bar $syntheticHOME set savedHOME $env(HOME) set env(HOME) $syntheticHOME set i [safe::interpCreate] } -body { ::safe::interpAddToAccessPath $i $syntheticHOME $i eval {glob -nocomplain ~/*} } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME removeDirectory $syntheticHOME unset savedHOME syntheticHOME } -result {} test safe-16.4 {Bug 3529949: defang ~user in globs} -setup { set i [safe::interpCreate] } -body { ::safe::interpAddToAccessPath $i $~$tcl_platform(user) $i eval [list glob -nocomplain ~$tcl_platform(user)/*] } -cleanup { safe::interpDelete $i } -result {} test safe-16.5 {Bug 3529949: defang ~ in paths used by AliasGlob (1)} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar set i [safe::interpCreate] } -body { $i eval { set d [format %c 126] file join {$p(:0:)} $d } } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME unset savedHOME } -result {~} test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar set i [safe::interpCreate] } -body { $i eval { set d [format %c 126] file join {$p(:0:)/foo/bar} $d } } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME unset savedHOME } -result {~} test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup { set i [safe::interpCreate] set user $tcl_platform(user) } -body { string map [list $user USER] [$i eval [list file join {$p(:0:)} ~$user]] } -cleanup { safe::interpDelete $i unset user } -result {~USER} test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup { set i [safe::interpCreate] set user $tcl_platform(user) } -body { string map [list $user USER] [$i eval [list file join {$p(:0:)/foo/bar} ~$user]] } -cleanup { safe::interpDelete $i unset user } -result {~USER} # cleanup set ::auto_path $SaveAutoPath unset SaveAutoPath TestsDir PathMapp unset -nocomplain path rename mapList {} rename mapAndSortList {} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/scan.test0000644000175000017500000007327414554262142014646 0ustar sergeisergei# Commands covered: scan # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # procedure that returns the range of integers proc int_range {} { for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} { set MIN_INT [expr { $MIN_INT << 1 }] } set MIN_INT [expr {int($MIN_INT)}] set MAX_INT [expr { ~ $MIN_INT }] return [list $MIN_INT $MAX_INT] } # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues binary scan [binary format dd -1.0 1.0] c* c switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ ieeeValues(-Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ ieeeValues(+Normal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ ieeeValues(+Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 } default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] testConstraint wideIs64bit \ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x } {1 f} test scan-1.2 {BuildCharSet, CharInSet} { list [scan \]foo {%[]f]} x] $x } {1 \]f} test scan-1.3 {BuildCharSet, CharInSet} { list [scan abc-def {%[a-c]} x] $x } {1 abc} test scan-1.4 {BuildCharSet, CharInSet} { list [scan abc-def {%[a-c]} x] $x } {1 abc} test scan-1.5 {BuildCharSet, CharInSet} { list [scan -abc-def {%[-ac]} x] $x } {1 -a} test scan-1.6 {BuildCharSet, CharInSet} { list [scan -abc-def {%[ac-]} x] $x } {1 -a} test scan-1.7 {BuildCharSet, CharInSet} { list [scan abc-def {%[c-a]} x] $x } {1 abc} test scan-1.8 {BuildCharSet, CharInSet} { list [scan def-abc {%[^c-a]} x] $x } {1 def-} test scan-1.9 {BuildCharSet, CharInSet no match} -setup { unset -nocomplain x } -body { list [scan {= f} {= %[TF]} x] [info exists x] } -result {0 0} test scan-2.1 {ReleaseCharSet} { list [scan abcde {%[abc]} x] $x } {1 abc} test scan-2.2 {ReleaseCharSet} { list [scan abcde {%[a-c]} x] $x } {1 abc} test scan-3.1 {ValidateFormat} -returnCodes error -body { scan {} {%d%1$d} x } -result {cannot mix "%" and "%n$" conversion specifiers} test scan-3.2 {ValidateFormat} -returnCodes error -body { scan {} {%d%1$d} x } -result {cannot mix "%" and "%n$" conversion specifiers} test scan-3.3 {ValidateFormat} -returnCodes error -body { scan {} {%2$d%d} x } -result {"%n$" argument index out of range} test scan-3.4 {ValidateFormat} { # degenerate case, before changed from 8.2 to 8.3 list [catch {scan {} %d} msg] $msg } {0 {}} test scan-3.5 {ValidateFormat} -returnCodes error -body { scan {} {%10c} a } -result {field width may not be specified in %c conversion} test scan-3.6 {ValidateFormat} -returnCodes error -body { scan {} {%*1$d} a } -result {bad scan conversion character "$"} test scan-3.7 {ValidateFormat} -returnCodes error -body { scan {} {%1$d%1$d} a } -result {variable is assigned by multiple "%n$" conversion specifiers} test scan-3.8 {ValidateFormat} -returnCodes error -body { scan {} a x } -result {variable is not assigned by any conversion specifiers} test scan-3.9 {ValidateFormat} -returnCodes error -body { scan {} {%2$s} x y } -result {variable is not assigned by any conversion specifiers} test scan-3.10 {ValidateFormat} -returnCodes error -body { scan {} {%[a} x } -result {unmatched [ in format string} test scan-3.11 {ValidateFormat} -returnCodes error -body { scan {} {%[^a} x } -result {unmatched [ in format string} test scan-3.12 {ValidateFormat} -returnCodes error -body { scan {} {%[]a} x } -result {unmatched [ in format string} test scan-3.13 {ValidateFormat} -returnCodes error -body { scan {} {%[^]a} x } -result {unmatched [ in format string} test scan-4.1 {Tcl_ScanObjCmd, argument checks} -returnCodes error -body { scan } -result {wrong # args: should be "scan string format ?varName ...?"} test scan-4.2 {Tcl_ScanObjCmd, argument checks} -returnCodes error -body { scan string } -result {wrong # args: should be "scan string format ?varName ...?"} test scan-4.3 {Tcl_ScanObjCmd, argument checks} { # degenerate case, before changed from 8.2 to 8.3 list [catch {scan string format} msg] $msg } {0 {}} test scan-4.4 {Tcl_ScanObjCmd, whitespace} { list [scan { abc def } {%s%s} x y] $x $y } {2 abc def} test scan-4.5 {Tcl_ScanObjCmd, whitespace} { list [scan { abc def } { %s %s } x y] $x $y } {2 abc def} test scan-4.6 {Tcl_ScanObjCmd, whitespace} { list [scan { abc def } { %s %s } x y] $x $y } {2 abc def} test scan-4.7 {Tcl_ScanObjCmd, literals} { # degenerate case, before changed from 8.2 to 8.3 scan { abc def } { abc def } } {} test scan-4.8 {Tcl_ScanObjCmd, literals} { set x {} list [scan { abcg} { abc def %1s} x] $x } {0 {}} test scan-4.9 {Tcl_ScanObjCmd, literals} { list [scan { abc%defghi} { abc %% def%n } x] $x } {1 10} test scan-4.10 {Tcl_ScanObjCmd, assignment suppression} { list [scan { abc def } { %*c%s def } x] $x } {1 bc} test scan-4.11 {Tcl_ScanObjCmd, XPG3-style} { list [scan { abc def } {%2$s %1$s} x y] $x $y } {2 def abc} test scan-4.12 {Tcl_ScanObjCmd, width specifiers} { list [scan {abc123456789012} {%3s%3d%3f%3[0-9]%s} a b c d e] $a $b $c $d $e } {5 abc 123 456.0 789 012} test scan-4.13 {Tcl_ScanObjCmd, width specifiers} { list [scan {abc123456789012} {%3s%3d%3f%3[0-9]%s} a b c d e] $a $b $c $d $e } {5 abc 123 456.0 789 012} test scan-4.14 {Tcl_ScanObjCmd, underflow} { set x {} list [scan {a} {a%d} x] $x } {-1 {}} test scan-4.15 {Tcl_ScanObjCmd, underflow} { set x {} list [scan {} {a%d} x] $x } {-1 {}} test scan-4.16 {Tcl_ScanObjCmd, underflow} { set x {} list [scan {ab} {a%d} x] $x } {0 {}} test scan-4.17 {Tcl_ScanObjCmd, underflow} { set x {} list [scan {a } {a%d} x] $x } {-1 {}} test scan-4.18 {Tcl_ScanObjCmd, skipping whitespace} { list [scan { b} {%c%s} x y] $x $y } {2 32 b} test scan-4.19 {Tcl_ScanObjCmd, skipping whitespace} { list [scan { b} {%[^b]%s} x y] $x $y } {2 { } b} test scan-4.20 {Tcl_ScanObjCmd, string scanning} { list [scan {abc def} {%s} x] $x } {1 abc} test scan-4.21 {Tcl_ScanObjCmd, string scanning} { list [scan {abc def} {%0s} x] $x } {1 abc} test scan-4.22 {Tcl_ScanObjCmd, string scanning} { list [scan {abc def} {%2s} x] $x } {1 ab} test scan-4.23 {Tcl_ScanObjCmd, string scanning} { list [scan {abc def} {%*s%n} x] $x } {1 3} test scan-4.24 {Tcl_ScanObjCmd, charset scanning} { list [scan {abcdef} {%[a-c]} x] $x } {1 abc} test scan-4.25 {Tcl_ScanObjCmd, charset scanning} { list [scan {abcdef} {%0[a-c]} x] $x } {1 abc} test scan-4.26 {Tcl_ScanObjCmd, charset scanning} { list [scan {abcdef} {%2[a-c]} x] $x } {1 ab} test scan-4.27 {Tcl_ScanObjCmd, charset scanning} { list [scan {abcdef} {%*[a-c]%n} x] $x } {1 3} test scan-4.28 {Tcl_ScanObjCmd, character scanning} { list [scan {abcdef} {%c} x] $x } {1 97} test scan-4.29 {Tcl_ScanObjCmd, character scanning} { list [scan {abcdef} {%*c%n} x] $x } {1 1} test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} } -body { list [scan {1234567890a} {%3d} x] $x } -result {1 123} test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} } -body { list [scan {1234567890a} {%d} x] $x } -result {1 1234567890} test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} } -body { list [scan {01234567890a} {%d} x] $x } -result {1 1234567890} test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} } -body { list [scan {+01234} {%d} x] $x } -result {1 1234} test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} } -body { list [scan {-01234} {%d} x] $x } -result {1 -1234} test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} } -body { list [scan {a01234} {%d} x] $x } -result {0 {}} test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} } -body { list [scan {0x10} {%d} x] $x } -result {1 0} test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} -setup { set x {} } -body { list [scan {012345678} {%o} x] $x } -result {1 342391} test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} -setup { set x {} } -body { list [scan {+1238 -1239 123a} {%o%*s%o%*s%o} x y z] $x $y $z } -result {3 83 -83 83} test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} -setup { set x {} } -body { list [scan {+1238 -123a 0123} {%x%x%x} x y z] $x $y $z } -result {3 4664 -4666 291} test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} -setup { set x {} } -body { # The behavior changed in 8.4a4/8.3.4cvs (6 Feb) to correctly # return '1' for 0x1 scanned via %x, to comply with 8.0 and C scanf. # Bug #495213 list [scan {aBcDeF AbCdEf 0x1} {%x%x%x} x y z] $x $y $z } -result {3 11259375 11259375 1} test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} -setup { set x {} } -body { list [scan {0xF 0x00A0B 0X0XF} {%x %x %x} x y z] $x $y $z } -result {3 15 2571 0} test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} -setup { unset -nocomplain x } -body { list [scan {xF} {%x} x] [info exists x] } -result {0 0} test scan-4.40.3 {Tcl_ScanObjCmd, base-2 integer scanning} -setup { set x {} } -body { list [scan {1001 0b101 100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} {%b %b %llb} x y z] $x $y $z } -result {3 9 5 340282366920938463463374607431768211456} test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} -setup { set x {} } -body { list [scan {10 010 0x10 0b10} {%i%i%i%i} x y z t] $x $y $z $t } -result {4 10 8 16 0} test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} -setup { set x {} } -body { list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z } -result {3 10 8 16} test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup { set x {} } -body { list [scan {+ } {%i} x] $x } -result {0 {}} test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup { set x {} } -body { list [scan {+} {%i} x] $x } -result {-1 {}} test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup { set x {} } -body { list [scan {0x} {%i%s} x y] $x $y } -result {2 0 x} test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup { set x {} } -body { list [scan {0X} {%i%s} x y] $x $y } -result {2 0 X} test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} -setup { set x {} } -body { list [scan {123def} {%*i%s} x] $x } -result {1 def} test scan-4.48 {Tcl_ScanObjCmd, float scanning} { list [scan {1 2 3} {%e %f %g} x y z] $x $y $z } {3 1.0 2.0 3.0} test scan-4.49 {Tcl_ScanObjCmd, float scanning} { list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z } {3 0.1 0.2 3.0} test scan-4.49-uc-1 {Tcl_ScanObjCmd, float scanning} { list [scan {0.5*0.75} {%E%c%G} x y z] $x $y $z } {3 0.5 42 0.75} test scan-4.49-uc-2 {Tcl_ScanObjCmd, float scanning} { list [scan {5e-1*75E-2} {%E%c%G} x y z] $x $y $z } {3 0.5 42 0.75} test scan-4.50 {Tcl_ScanObjCmd, float scanning} { list [scan {1234567890a} %f x] $x } {1 1234567890.0} test scan-4.51 {Tcl_ScanObjCmd, float scanning} { list [scan {+123+45} %f x] $x } {1 123.0} test scan-4.52 {Tcl_ScanObjCmd, float scanning} { list [scan {-123+45} %f x] $x } {1 -123.0} test scan-4.53 {Tcl_ScanObjCmd, float scanning} { list [scan {1.0e1} %f x] $x } {1 10.0} test scan-4.54 {Tcl_ScanObjCmd, float scanning} { list [scan {1.0e-1} %f x] $x } {1 0.1} test scan-4.55 {Tcl_ScanObjCmd, odd cases} -setup { set x {} } -body { list [scan {+} %f x] $x } -result {-1 {}} test scan-4.56 {Tcl_ScanObjCmd, odd cases} -setup { set x {} } -body { list [scan {1.0e} %f%s x y] $x $y } -result {2 1.0 e} test scan-4.57 {Tcl_ScanObjCmd, odd cases} -setup { set x {} } -body { list [scan {1.0e+} %f%s x y] $x $y } -result {2 1.0 e+} test scan-4.58 {Tcl_ScanObjCmd, odd cases} -setup { set x {} set y {} } -body { list [scan {e1} %f%s x y] $x $y } -result {0 {} {}} test scan-4.59 {Tcl_ScanObjCmd, float scanning} { list [scan {1.0e-1x} %*f%n x] $x } {1 6} test scan-4.60 {Tcl_ScanObjCmd, set errors} -setup { set x {} set y {} unset -nocomplain z } -body { array set z {} list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x $y } -cleanup { unset -nocomplain z } -result {1 {can't set "z": variable is array} abc ghi} test scan-4.61 {Tcl_ScanObjCmd, set errors} -setup { set x {} unset -nocomplain y unset -nocomplain z } -body { array set y {} array set z {} list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x } -cleanup { unset -nocomplain y unset -nocomplain z } -result {1 {can't set "z": variable is array} abc} test scan-4.62 {scanning of large and negative octal integers} { lassign [int_range] MIN_INT MAX_INT set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT] list [scan $scanstring {%o %o %o} a b c] \ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }] } {3 1 1 1} test scan-4.63 {scanning of large and negative hex integers} { lassign [int_range] MIN_INT MAX_INT set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT] list [scan $scanstring {%x %x %x} a b c] \ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }] } {3 1 1 1} test scan-4.64 {scanning of hex with %X} { scan "123 abc f78" %X%X%X } {291 2748 3960} test scan-5.1 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d } -result {4 -20 1476 33 0} test scan-5.2 {integer scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c] $a $b $c } -result {3 -4 16 7890} test scan-5.3 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "-45 16 +10 987" "%ld %d %ld %d" a b c d] $a $b $c $d } -result {4 -45 16 10 987} test scan-5.4 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "14 1ab 62 10" "%d %x %lo %x" a b c d] $a $b $c $d } -result {4 14 427 50 16} test scan-5.5 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "12345670 1234567890ab cdefg" "%o %o %x %lx" a b c d] \ $a $b $c $d } -result {4 2739128 342391 561323 52719} test scan-5.6 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "ab123-24642" "%2x %3x %3o %2o" a b c d] $a $b $c $d } -result {4 171 291 -20 52} test scan-5.7 {integer scanning} -setup { set a {}; set b {} } -body { list [scan "1234567 234 567 " "%*3x %x %*o %4o" a b] $a $b } -result {2 17767 375} test scan-5.8 {integer scanning} -setup { set a {}; set b {} } -body { list [scan "a 1234" "%d %d" a b] $a $b } -result {0 {} {}} test scan-5.9 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "12345678" "%2d %2d %2ld %2d" a b c d] $a $b $c $d } -result {4 12 34 56 78} test scan-5.10 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d } -result {2 1 2 {} {}} # # The behavior for scanning integers larger than MAX_INT is not defined by the # ANSI spec. Some implementations wrap the input (-16) some return MAX_INT. # test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { set a {}; set b {} } -body { list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] } -result {2 4294967280 1} test scan-5.12 {integer scanning} -constraints {wideIs64bit} -setup { set a {}; set b {}; set c {} } -body { list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ %ld,%lx,%lo a b c] $a $b $c } -result {3 7810179016327718216 7810179016327718216 7810179016327718216} test scan-5.13 {integer scanning and overflow} { # This test used to fail on some 64-bit systems. [Bug 1011860] scan {300000000 3000000000 30000000000} {%ld %ld %ld} } {300000000 3000000000 30000000000} test scan-5.14 {integer scanning} { scan 0xff %u } 0 test scan-5.15 {Bug be003d570f} { scan 0x40 %o } 0 test scan-5.16 {Bug be003d570f} { scan 0x40 %b } 0 test scan-5.17 {bigint scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "207698809136909011942886895,abcdef0123456789abcdef,125715736004432126361152746757" \ %lld,%llx,%llo a b c] $a $b $c } -result {3 207698809136909011942886895 207698809136909011942886895 207698809136909011942886895} test scan-5.18 {bigint scanning underflow} -setup { set a {}; } -body { list [scan "-207698809136909011942886895" \ %llu a] $a } -returnCodes 1 -result {unsigned bignum scans are invalid} test scan-5.19 {bigint scanning invalid} -setup { set a {}; } -body { list [scan "207698809136909011942886895" \ %llu a] $a } -returnCodes 1 -result {unsigned bignum scans are invalid} test scan-6.1 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d } -result {3 2.1 -300000000.0 0.99962 {}} test scan-6.2 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d } -result {4 -1.0 234.0 5.0 8.2} test scan-6.3 {floating-point scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "1e00004 332E-4 3e+4" "%Lf %*2e %f %f" a b c] $a $c } -result {3 10000.0 30000.0} # # Some libc implementations consider 3.e- bad input. The ANSI spec states # that digits must follow the - sign. # test scan-6.4 {floating-point scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c } -result {3 1.0 200.0 3.0} test scan-6.5 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d } -result {4 4.6 99999.7 87.643 118.0} test scan-6.6 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d } -result {4 1.2345 0.697 124.0 5e-5} test scan-6.7 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d } -result {1 4.6 {} {} {}} test scan-6.8 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d } -result {2 4.6 5.2 {} {}} test scan-7.1 {string and character scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d } -result {4 abc def ghijk dum} test scan-7.2 {string and character scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "a bcdef" "%c%c%1s %s" a b c d] $a $b $c $d } -result {4 97 32 b cdef} test scan-7.3 {string and character scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "123456 test " "%*c%*s %s %s %s" a b c] $a $b $c } -result {1 test {} {}} test scan-7.4 {string and character scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d] $a $b $c $d } -result {4 abab cd {01234 } {f 12345}} test scan-7.5 {string and character scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c } -result {3 aabc bcdefg 43} test scan-7.6 {string and character scanning, unicode} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d } -result "4 abc d\u00c7f ghijk dum" test scan-7.7 {string and character scanning, unicode} -setup { set a {}; set b {} } -body { list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b } -result "2 199 99" test scan-7.8 {string and character scanning, unicode} -setup { set a {}; set b {} } -body { list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a } -result "1 ab\ufeff" test scan-8.1 {error conditions} -body { scan a } -returnCodes error -match glob -result * test scan-8.2 {error conditions} -returnCodes error -body { scan a } -result {wrong # args: should be "scan string format ?varName ...?"} test scan-8.3 {error conditions} -returnCodes error -body { scan a %D x } -result {bad scan conversion character "D"} test scan-8.4 {error conditions} -returnCodes error -body { scan a %O x } -result {bad scan conversion character "O"} test scan-8.5 {error conditions} -returnCodes error -body { scan a %B x } -result {bad scan conversion character "B"} test scan-8.6 {error conditions} -returnCodes error -body { scan a %F x } -result {bad scan conversion character "F"} test scan-8.7 {error conditions} -returnCodes error -body { scan a %p x } -result {bad scan conversion character "p"} test scan-8.8 {error conditions} -returnCodes error -body { scan a "%d %d" a } -result {different numbers of variable names and field specifiers} test scan-8.9 {error conditions} -returnCodes error -body { scan a "%d %d" a b c } -result {variable is not assigned by any conversion specifiers} test scan-8.10 {error conditions} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [expr {[scan " a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d } -result {1 {} {} {} {}} test scan-8.11 {error conditions} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d } -result {2 1 2 {} {}} test scan-8.12 {error conditions} -setup { unset -nocomplain a } -body { set a(0) 44 scan 44 %d a } -returnCodes error -cleanup { unset -nocomplain a } -result {can't set "a": variable is array} test scan-8.13 {error conditions} -setup { unset -nocomplain a } -body { set a(0) 44 scan 44 %c a } -returnCodes error -cleanup { unset -nocomplain a } -result {can't set "a": variable is array} test scan-8.14 {error conditions} -setup { unset -nocomplain a } -body { set a(0) 44 scan 44 %s a } -returnCodes error -cleanup { unset -nocomplain a } -result {can't set "a": variable is array} test scan-8.15 {error conditions} -setup { unset -nocomplain a } -body { set a(0) 44 scan 44 %f a } -returnCodes error -cleanup { unset -nocomplain a } -result {can't set "a": variable is array} test scan-8.16 {error conditions} -setup { unset -nocomplain a } -body { set a(0) 44 scan 44 %f a } -returnCodes error -cleanup { unset -nocomplain a } -result {can't set "a": variable is array} test scan-8.17 {error conditions} -returnCodes error -body { scan 44 %2c a } -result {field width may not be specified in %c conversion} test scan-8.18 {error conditions} -returnCodes error -body { scan abc {%[} x } -result {unmatched [ in format string} test scan-8.19 {error conditions} -returnCodes error -body { scan abc {%[^a} x } -result {unmatched [ in format string} test scan-8.20 {error conditions} -returnCodes error -body { scan abc {%[^]a} x } -result {unmatched [ in format string} test scan-8.21 {error conditions} -returnCodes error -body { scan abc {%[]a} x } -result {unmatched [ in format string} test scan-9.1 {lots of arguments} { scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 } 20 test scan-9.2 {lots of arguments} { scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 set a20 } 200 test scan-10.1 {miscellaneous tests} -setup { set a {} } -body { list [scan ab16c ab%dc a] $a } -result {1 16} test scan-10.2 {miscellaneous tests} -setup { set a {} } -body { list [scan ax16c ab%dc a] $a } -result {0 {}} test scan-10.3 {miscellaneous tests} -setup { set a {} } -body { list [catch {scan ab%c114 ab%%c%d a} msg] $msg $a } -result {0 1 114} test scan-10.4 {miscellaneous tests} -setup { set a {} } -body { list [catch {scan ab%c14 ab%%c%d a} msg] $msg $a } -result {0 1 14} test scan-10.5 {miscellaneous tests} -setup { unset -nocomplain arr } -body { set arr(2) {} list [catch {scan ab%c14 ab%%c%d arr(2)} msg] $msg $arr(2) } -result {0 1 14} test scan-10.6 {miscellaneous tests} { scan 5a {%i%[a]} } {5 a} test scan-10.7 {miscellaneous tests} { scan {5 a} {%i%[a]} } {5 {}} test scan-11.1 {alignment in results array (TCL_ALIGN)} { scan "123 13.6" "%s %f" a b set b } 13.6 test scan-11.2 {alignment in results array (TCL_ALIGN)} { scan "1234567 13.6" "%s %f" a b set b } 13.6 test scan-11.3 {alignment in results array (TCL_ALIGN)} { scan "12345678901 13.6" "%s %f" a b set b } 13.6 test scan-11.4 {alignment in results array (TCL_ALIGN)} { scan "123456789012345 13.6" "%s %f" a b set b } 13.6 test scan-11.5 {alignment in results array (TCL_ALIGN)} { scan "1234567890123456789 13.6" "%s %f" a b set b } 13.6 test scan-12.1 {Tcl_ScanObjCmd, inline case} { scan a %c } 97 test scan-12.2 {Tcl_ScanObjCmd, inline case} { scan abc %c%c%c%c } {97 98 99 {}} test scan-12.3 {Tcl_ScanObjCmd, inline case} { scan abc %s%c } {abc {}} test scan-12.4 {Tcl_ScanObjCmd, inline case, underflow} { scan abc abc%c } {} test scan-12.5 {Tcl_ScanObjCmd, inline case} { scan abc bogus%c%c%c } {{} {} {}} test scan-12.6 {Tcl_ScanObjCmd, inline case} { # degenerate case, behavior changed from 8.2 to 8.3 list [catch {scan foo foobar} msg] $msg } {0 {}} test scan-12.7 {Tcl_ScanObjCmd, inline case lots of arguments} { scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140\ 150 160 170 180 190 200" \ "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" } {10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200 {}} test scan-13.1 {Tcl_ScanObjCmd, inline XPG case} { scan a {%1$c} } 97 test scan-13.2 {Tcl_ScanObjCmd, inline XPG case} { scan abc {%1$c%2$c%3$c%4$c} } {97 98 99 {}} test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} -returnCodes error -body { scan abc {%1$c%1$c} } -result {variable is assigned by multiple "%n$" conversion specifiers} test scan-13.4 {Tcl_ScanObjCmd, inline XPG case} { scan abc {%2$s%1$c} } {{} abc} test scan-13.5 {Tcl_ScanObjCmd, inline XPG case, underflow} { scan abc {abc%5$c} } {} test scan-13.6 {Tcl_ScanObjCmd, inline XPG case} { catch {scan abc {bogus%1$c%5$c%10$c}} msg list [llength $msg] $msg } {10 {{} {} {} {} {} {} {} {} {} {}}} test scan-13.7 {Tcl_ScanObjCmd, inline XPG case lots of arguments} { scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" {%20$d %18$d %17$d %16$d %15$d %14$d %13$d %12$d %11$d %10$d %9$d %8$d %7$d %6$d %5$d %4$d %3$d %2$d %1$d} } {190 180 170 160 150 140 130 120 110 100 90 80 70 60 50 40 30 20 {} 10} test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} { set msg [scan "10 20 30" {%100$d %5$d %200$d}] list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199] } {200 10 20 30} test scan-13.9 {Tcl_ScanObjCmd, inline XPG case limit error} -body { # Note this applies to 64-bit builds as well so long as max number of # command line arguments allowed for scan command is INT_MAX scan abc {%2147483648$s} } -result {"%n$" argument index out of range} -returnCodes error # scan infinities - not working test scan-14.1 {positive infinity} { scan Inf %g d return $d } Inf test scan-14.2 {negative infinity} { scan -Inf %g d return $d } -Inf # TODO - also need to scan NaN's catch {rename int_range {}} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/security.test0000644000175000017500000000160014554262142015551 0ustar sergeisergei# security.test -- # # Functionality covered: this file contains a collection of tests for the auto # loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # If this proc becomes invoked, then there is a bug proc BUG {args} { set ::BUG 1 } # Check and Clear the bug flag (to do before each test) set ::BUG 0 proc CB {} { set ret $::BUG set ::BUG 0 return $ret } test security-1.1 {tcl_endOfPreviousWord} { catch {tcl_startOfPreviousWord x {[BUG]}} CB } 0 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/set-old.test0000644000175000017500000007510714554262142015266 0ustar sergeisergei# Commands covered: set, unset, array # # This file includes the original set of tests for Tcl's set command. # Since the set command is now compiled, a new set of tests covering # the new implementation is in the file "set.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } proc ignore args {} # Simple variable operations. catch {unset a} test set-old-1.1 {basic variable setting and unsetting} { set a 22 } 22 test set-old-1.2 {basic variable setting and unsetting} { set a 123 set a } 123 test set-old-1.3 {basic variable setting and unsetting} { set a xxx format %s $a } xxx test set-old-1.4 {basic variable setting and unsetting} { set a 44 unset a list [catch {set a} msg] $msg } {1 {can't read "a": no such variable}} # Basic array operations. catch {unset a} set a(xyz) 2 set a(44) 3 set {a(a long name)} test test set-old-2.1 {basic array operations} { lsort [array names a] } {44 {a long name} xyz} test set-old-2.2 {basic array operations} { set a(44) } 3 test set-old-2.3 {basic array operations} { set a(xyz) } 2 test set-old-2.4 {basic array operations} { set "a(a long name)" } test test set-old-2.5 {basic array operations} { list [catch {set a(other)} msg] $msg } {1 {can't read "a(other)": no such element in array}} test set-old-2.6 {basic array operations} { list [catch {set a} msg] $msg } {1 {can't read "a": variable is array}} test set-old-2.7 {basic array operations} { format %s $a(44) } 3 test set-old-2.8 {basic array operations} { format %s $a(a long name) } test unset a(44) test set-old-2.9 {basic array operations} { lsort [array names a] } {{a long name} xyz} test set-old-2.10 {basic array operations} { catch {unset b} list [catch {set b(123)} msg] $msg } {1 {can't read "b(123)": no such variable}} test set-old-2.11 {basic array operations} { catch {unset b} set b 44 list [catch {set b(123)} msg] $msg } {1 {can't read "b(123)": variable isn't array}} test set-old-2.12 {basic array operations} { list [catch {set a 14} msg] $msg } {1 {can't set "a": variable is array}} unset a test set-old-2.13 {basic array operations} { list [catch {set a(xyz)} msg] $msg } {1 {can't read "a(xyz)": no such variable}} # Test the set commands, and exercise the corner cases of the code # that parses array references into two parts. test set-old-3.1 {set command} { list [catch {set} msg] $msg } {1 {wrong # args: should be "set varName ?newValue?"}} test set-old-3.2 {set command} { list [catch {set x y z} msg] $msg } {1 {wrong # args: should be "set varName ?newValue?"}} test set-old-3.3 {set command} { catch {unset a} list [catch {set a} msg] $msg } {1 {can't read "a": no such variable}} test set-old-3.4 {set command} { catch {unset a} set a(14) 83 list [catch {set a 22} msg] $msg } {1 {can't set "a": variable is array}} # Test the corner-cases of parsing array names, using set and unset. test set-old-4.1 {parsing array names} { catch {unset a} set a(()) 44 list [catch {array names a} msg] $msg } {0 ()} test set-old-4.2 {parsing array names} { catch {unset a a(abcd} set a(abcd 33 info exists a(abcd } 1 test set-old-4.3 {parsing array names} { catch {unset a a(abcd} set a(abcd 33 list [catch {array names a} msg] $msg } {0 {}} test set-old-4.4 {parsing array names} { catch {unset a abcd)} set abcd) 33 info exists abcd) } 1 test set-old-4.5 {parsing array names} { set a(bcd yyy catch {unset a} list [catch {set a(bcd} msg] $msg } {0 yyy} test set-old-4.6 {parsing array names} { catch {unset a} set a 44 list [catch {set a(bcd test} msg] $msg } {0 test} # Errors in reading variables test set-old-5.1 {errors in reading variables} { catch {unset a} list [catch {set a} msg] $msg } {1 {can't read "a": no such variable}} test set-old-5.2 {errors in reading variables} { catch {unset a} set a 44 list [catch {set a(18)} msg] $msg } {1 {can't read "a(18)": variable isn't array}} test set-old-5.3 {errors in reading variables} { catch {unset a} set a(6) 44 list [catch {set a(18)} msg] $msg } {1 {can't read "a(18)": no such element in array}} test set-old-5.4 {errors in reading variables} { catch {unset a} set a(6) 44 list [catch {set a} msg] $msg } {1 {can't read "a": variable is array}} # Errors and other special cases in writing variables test set-old-6.1 {creating array during write} { catch {unset a} trace var a rwu ignore list [catch {set a(14) 186} msg] $msg [array names a] } {0 186 14} test set-old-6.2 {errors in writing variables} { catch {unset a} set a xxx list [catch {set a(14) 186} msg] $msg } {1 {can't set "a(14)": variable isn't array}} test set-old-6.3 {errors in writing variables} { catch {unset a} set a(100) yyy list [catch {set a 2} msg] $msg } {1 {can't set "a": variable is array}} test set-old-6.4 {expanding variable size} { catch {unset a} list [set a short] [set a "longer name"] [set a "even longer name"] \ [set a "a much much truly longer name"] } {short {longer name} {even longer name} {a much much truly longer name}} # Unset command, Tcl_UnsetVar procedures test set-old-7.1 {unset command} { catch {unset a}; catch {unset b}; catch {unset c}; catch {unset d} set a 44 set b 55 set c 66 set d 77 unset a b c list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \ [catch {set d(0) 0}] } {0 0 0 1} test set-old-7.2 {unset command} { list [catch {unset} msg] $msg } {0 {}} # Used to return: #{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName ...?"}} test set-old-7.3 {unset command} { catch {unset a} list [catch {unset a} msg] $msg } {1 {can't unset "a": no such variable}} test set-old-7.4 {unset command} { catch {unset a} set a 44 list [catch {unset a(14)} msg] $msg } {1 {can't unset "a(14)": variable isn't array}} test set-old-7.5 {unset command} { catch {unset a} set a(0) xx list [catch {unset a(14)} msg] $msg } {1 {can't unset "a(14)": no such element in array}} test set-old-7.6 {unset command} { catch {unset a}; catch {unset b}; catch {unset c} set a foo set c gorp list [catch {unset a a a(14)} msg] $msg [info exists c] } {1 {can't unset "a": no such variable} 1} test set-old-7.7 {unsetting globals from within procedures} { set y 0 proc p1 {} { global y set z [p2] return [list $z [catch {set y} msg] $msg] } proc p2 {} {global y; unset y; list [catch {set y} msg] $msg} p1 } {{1 {can't read "y": no such variable}} 1 {can't read "y": no such variable}} test set-old-7.8 {unsetting globals from within procedures} { set y 0 proc p1 {} { global y p2 return [list [catch {set y 44} msg] $msg] } proc p2 {} {global y; unset y} concat [p1] [list [catch {set y} msg] $msg] } {0 44 0 44} test set-old-7.9 {unsetting globals from within procedures} { set y 0 proc p1 {} { global y unset y return [list [catch {set y 55} msg] $msg] } concat [p1] [list [catch {set y} msg] $msg] } {0 55 0 55} test set-old-7.10 {unset command} { catch {unset a} set a(14) 22 unset a(14) list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2 } {1 {can't read "a(14)": no such element in array} 0 {}} test set-old-7.11 {unset command} { catch {unset a} set a(14) 22 unset a list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2 } {1 {can't read "a(14)": no such variable} 0 {}} test set-old-7.12 {unset command, -nocomplain} { catch {unset a} list [info exists a] [catch {unset -nocomplain a}] [info exists a] } {0 0 0} test set-old-7.13 {unset command, -nocomplain} { set -nocomplain abc list [info exists -nocomplain] [catch {unset -nocomplain}] \ [info exists -nocomplain] [catch {unset -- -nocomplain}] \ [info exists -nocomplain] } {1 0 1 0 0} test set-old-7.14 {unset command, --} { set -- abc list [info exists --] [catch {unset --}] \ [info exists --] [catch {unset -- --}] \ [info exists --] } {1 0 1 0 0} test set-old-7.15 {unset command, -nocomplain} { set -nocomplain abc set -- abc list [info exists -nocomplain] [catch {unset -- -nocomplain}] \ [info exists -nocomplain] [info exists --] \ [catch {unset -- -nocomplain}] [info exists --] \ [catch {unset -- --}] [info exists --] } {1 0 0 1 1 1 0 0} test set-old-7.16 {unset command, -nocomplain} { set -nocomplain abc set var abc list [info exists bogus] [catch {unset -nocomplain bogus var bogus}] \ [info exists -nocomplain] [info exists var] \ [catch {unset -nocomplain -nocomplain}] [info exists -nocomplain] } {0 0 1 0 0 0} test set-old-7.17 {unset command, -nocomplain (no abbreviation)} { set -nocomp abc list [info exists -nocomp] [catch {unset -nocomp}] [info exists -nocomp] } {1 0 0} test set-old-7.18 {unset command, -nocomplain (no abbreviation)} { catch {unset -nocomp} list [info exists -nocomp] [catch {unset -nocomp}] } {0 1} test set-old-7.19 {unset command, both switches} { set -- val list [info exists --] [catch {unset -nocomplain --}] [info exists --]\ [catch {unset -nocomplain -- --}] [info exists --] } {1 0 1 0 0} # Array command. test set-old-8.1 {array command} { list [catch {array} msg] $msg } {1 {wrong # args: should be "array subcommand ?arg ...?"}} test set-old-8.2 {array command} { list [catch {array a} msg] $msg } {1 {wrong # args: should be "array anymore arrayName searchId"}} test set-old-8.3 {array command} { catch {unset a} list [catch {array anymore a b} msg] $msg } {1 {"a" isn't an array}} test set-old-8.4 {array command} { catch {unset a} set a 44 list [catch {array anymore a b} msg] $msg } {1 {"a" isn't an array}} test set-old-8.5 {array command} { proc foo {} { set a 44 upvar 0 a x list [catch {array anymore x b} msg] $msg } foo } {1 {"x" isn't an array}} test set-old-8.6 {array command} { catch {unset a} set a(22) 3 list [catch {array gorp a} msg] $msg } {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}} test set-old-8.7 {array command, anymore option} { catch {unset a} list [catch {array anymore a x} msg] $msg } {1 {"a" isn't an array}} test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array anymore a x] } set a(x) 123 } list [catch {foo 1} msg] $msg } {1 {"a" isn't an array}} test set-old-8.9 {array command, donesearch option} { catch {unset a} list [catch {array donesearch a x} msg] $msg } {1 {"a" isn't an array}} test set-old-8.10 {array command, donesearch option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array donesearch a x] } set a(x) 123 } list [catch {foo 1} msg] $msg } {1 {"a" isn't an array}} test set-old-8.11 {array command, exists option} { list [catch {array exists a b} msg] $msg } {1 {wrong # args: should be "array exists arrayName"}} test set-old-8.12 {array command, exists option} { catch {unset a} array exists a } {0} test set-old-8.13 {array command, exists option} { catch {unset a} set a(0) 1 array exists a } {1} test set-old-8.14 {array command, exists option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array exists a] } set a(x) 123 } list [catch {foo 1} msg] $msg } {0 0} test set-old-8.15 {array command, get option} { list [catch {array get} msg] $msg } {1 {wrong # args: should be "array get arrayName ?pattern?"}} test set-old-8.16 {array command, get option} { list [catch {array get a b c} msg] $msg } {1 {wrong # args: should be "array get arrayName ?pattern?"}} test set-old-8.17 {array command, get option} { catch {unset a} array get a } {} test set-old-8.18 {array command, get option} { catch {unset a} set a(22) 3 set {a(long name)} {} lsort [array get a] } {{} 22 3 {long name}} test set-old-8.19 {array command, get option (unset variable)} { catch {unset a} set a(x) 3 trace var a(y) w ignore array get a } {x 3} test set-old-8.20 {array command, get option, with pattern} { catch {unset a} set a(x1) 3 set a(x2) 4 set a(x3) 5 set a(b1) 24 set a(b2) 25 lsort [array get a x*] } {3 4 5 x1 x2 x3} test set-old-8.21 {array command, get option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array get a] } set a(x) 123 } list [catch {foo 1} msg] $msg } {0 {}} test set-old-8.22 {array command, names option} { catch {unset a} set a(22) 3 list [catch {array names a 4 5} msg] $msg } {1 {bad option "4": must be -exact, -glob, or -regexp}} test set-old-8.23 {array command, names option} { catch {unset a} array names a } {} test set-old-8.24 {array command, names option} { catch {unset a} set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx list [catch {lsort [array names a]} msg] $msg } {0 {22 Textual_name {name with spaces}}} test set-old-8.25 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; trace var a(xxx) w ignore list [catch {lsort [array names a]} msg] $msg } {0 {22 33}} test set-old-8.26 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; trace var a(xxx) w ignore set a(xxx) value list [catch {lsort [array names a]} msg] $msg } {0 {22 33 xxx}} test set-old-8.27 {array command, names option} { catch {unset a} set a(axy) 3 set a(bxy) 44 set a(no) yes set a(xxx) value list [lsort [array names a *xy]] [lsort [array names a]] } {{axy bxy} {axy bxy no xxx}} test set-old-8.28 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array names a] } set a(x) 123 } list [catch {foo 1} msg] $msg } {0 {}} test set-old-8.29 {array command, nextelement option} { list [catch {array nextelement a} msg] $msg } {1 {wrong # args: should be "array nextelement arrayName searchId"}} test set-old-8.30 {array command, nextelement option} { catch {unset a} list [catch {array nextelement a b} msg] $msg } {1 {"a" isn't an array}} test set-old-8.31 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array nextelement a b] } set a(x) 123 } list [catch {foo 1} msg] $msg } {1 {"a" isn't an array}} test set-old-8.32 {array command, set option} { list [catch {array set a} msg] $msg } {1 {wrong # args: should be "array set arrayName list"}} test set-old-8.33 {array command, set option} { list [catch {array set a 1 2} msg] $msg } {1 {wrong # args: should be "array set arrayName list"}} test set-old-8.34 {array command, set option} { list [catch {array set a "a \{ c"} msg] $msg } {1 {unmatched open brace in list}} test set-old-8.35 {array command, set option} { catch {unset a} set a 44 list [catch {array set a {a b c d}} msg] $msg } {1 {can't set "a(a)": variable isn't array}} test set-old-8.36 {array command, set option} { catch {unset a} set a(xx) yy array set a {b c d e} lsort [array get a] } {b c d e xx yy} test set-old-8.37 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array set a {x 0}] } set a(x) } list [catch {foo 1} msg] $msg } {0 {}} test set-old-8.38 {array command, set option} { catch {unset aVaRnAmE} array set aVaRnAmE {} list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg } {1 1 {can't read "aVaRnAmE": variable is array}} test set-old-8.38.1 {array command, set scalar} { catch {unset aVaRnAmE} set aVaRnAmE 1 list [catch {array set aVaRnAmE {}} msg] $msg } {1 {can't array set "aVaRnAmE": variable isn't array}} test set-old-8.38.2 {array command, set alias} { catch {unset aVaRnAmE} upvar 0 aVaRnAmE anAliAs array set anAliAs {} list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg } {1 1 {can't read "anAliAs": variable is array}} test set-old-8.38.3 {array command, set element alias} { catch {unset aVaRnAmE} list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \ [catch {array set elemAliAs {}} msg] $msg } {0 1 {can't array set "elemAliAs": variable isn't array}} test set-old-8.38.4 {array command, empty set with populated array} { catch {unset aVaRnAmE} array set aVaRnAmE [list e1 v1 e2 v2] array set aVaRnAmE {} array set aVaRnAmE [list e3 v3] list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg } {{e1 e2 e3} 0 v2} test set-old-8.38.5 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var {}} msg] $msg } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}} test set-old-8.38.6 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var {a b}} msg] $msg } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}} test set-old-8.38.7 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg } {1 {can't set "bogusnamespace::var(0)": parent namespace doesn't exist}} test set-old-8.39 {array command, size option} { catch {unset a} array size a } {0} test set-old-8.40 {array command, size option} { list [catch {array size a 4} msg] $msg } {1 {wrong # args: should be "array size arrayName"}} test set-old-8.41 {array command, size option} { catch {unset a} array size a } {0} test set-old-8.42 {array command, size option} { catch {unset a} set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx list [catch {array size a} msg] $msg } {0 3} test set-old-8.43 {array command, size option} { catch {unset a} set a(22) 3; set a(xx) 44; set a(y) xxx unset a(22) a(y) a(xx) list [catch {array size a} msg] $msg } {0 0} test set-old-8.44 {array command, size option} { catch {unset a} set a(22) 3; trace var a(33) rwu ignore list [catch {array size a} msg] $msg } {0 1} test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array size a] } set a(x) 123 } list [catch {foo 1} msg] $msg } {0 0} test set-old-8.46 {array command, startsearch option} { list [catch {array startsearch a b} msg] $msg } {1 {wrong # args: should be "array startsearch arrayName"}} test set-old-8.47 {array command, startsearch option} { catch {unset a} list [catch {array startsearch a} msg] $msg } {1 {"a" isn't an array}} test set-old-8.48 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} { catch {rename p ""} proc p {x} { if {$x==1} { return [array startsearch a] } set a(x) 123 } list [catch {p 1} msg] $msg } {1 {"a" isn't an array}} test set-old-8.49 {array command, statistics option} { catch {unset a} set a(abc) 1 set a(def) 2 set a(ghi) 3 set a(jkl) 4 set a(mno) 5 set a(pqr) 6 set a(stu) 7 set a(vwx) 8 set a(yz) 9 array statistics a } "9 entries in table, 4 buckets number of buckets with 0 entries: 0 number of buckets with 1 entries: 0 number of buckets with 2 entries: 3 number of buckets with 3 entries: 1 number of buckets with 4 entries: 0 number of buckets with 5 entries: 0 number of buckets with 6 entries: 0 number of buckets with 7 entries: 0 number of buckets with 8 entries: 0 number of buckets with 9 entries: 0 number of buckets with 10 or more entries: 0 average search distance for entry: 1.7" test set-old-8.50 {array command, array names -exact on glob pattern} { catch {unset a} set a(1*2) 1 list [catch {array names a -exact 1*2} msg] $msg } {0 1*2} test set-old-8.51 {array command, array names -glob on glob pattern} { catch {unset a} set a(1*2) 1 set a(12) 1 set a(11) 1 list [catch {lsort [array names a -glob 1*2]} msg] $msg } {0 {1*2 12}} test set-old-8.52 {array command, array names -regexp on regexp pattern} { catch {unset a} set a(1*2) 1 set a(12) 1 set a(11) 1 list [catch {lsort [array names a -regexp ^1]} msg] $msg } {0 {1*2 11 12}} test set-old-8.52.1 {array command, array names -regexp, backrefs} { catch {unset a} set a(1*2) 1 set a(12) 1 set a(11) 1 list [catch {lsort [array names a -regexp {^(.)\1}]} msg] $msg } {0 11} test set-old-8.53 {array command, array names -regexp} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -regexp} msg] $msg } {0 -regexp} test set-old-8.54 {array command, array names -exact} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -exact} msg] $msg } {0 -exact} test set-old-8.55 {array command, array names -glob} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -glob} msg] $msg } {0 -glob} test set-old-8.56 {array command, array statistics on a non-array} { catch {unset a} list [catch {array statistics a} msg] $msg } [list 1 "\"a\" isn't an array"] test set-old-8.57 {array command, array get with trivial pattern} { catch {unset a} set a(x) 1 set a(y) 2 array get a x } {x 1} test set-old-8.58 {array command, array set with LVT and odd length literal} { list [catch {apply {{} { array set a {b c d} }}} msg] $msg } {1 {list must have an even number of elements}} test set-old-9.1 {ids for array enumeration} { catch {unset a} set a(a) 1 list [array star a] [array star a] [array done a s-1-a; array star a] \ [array done a s-2-a; array d a s-3-a; array start a] } {s-1-a s-2-a s-3-a s-1-a} test set-old-9.2 {array enumeration} { catch {unset a} set a(a) 1 set a(b) 1 set a(c) 1 set x [array startsearch a] lsort [list [array nextelement a $x] [array ne a $x] [array next a $x] \ [array next a $x] [array next a $x]] } {{} {} a b c} test set-old-9.3 {array enumeration} { catch {unset a} set a(a) 1 set a(b) 1 set a(c) 1 set x [array startsearch a] set y [array startsearch a] set z [array startsearch a] lsort [list [array nextelement a $x] [array ne a $x] \ [array next a $y] [array next a $z] [array next a $y] \ [array next a $z] [array next a $y] [array next a $z] \ [array next a $y] [array next a $z] [array next a $x] \ [array next a $x]] } {{} {} {} a a a b b b c c c} test set-old-9.4 {array enumeration: stopping searches} { catch {unset a} set a(a) 1 set a(b) 1 set a(c) 1 set x [array startsearch a] set y [array startsearch a] set z [array startsearch a] lsort [list [array next a $x] [array next a $x] [array next a $y] \ [array done a $z; array next a $x] \ [array done a $x; array next a $y] [array next a $y]] } {a a b b c c} test set-old-9.5 {array enumeration: stopping searches} { catch {unset a} set a(a) 1 set x [array startsearch a] array done a $x list [catch {array next a $x} msg] $msg } {1 {couldn't find search "s-1-a"}} test set-old-9.6 {array enumeration: searches automatically stopped} { catch {unset a} set a(a) 1 set x [array startsearch a] set y [array startsearch a] set a(b) 1 list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}} test set-old-9.7 {array enumeration: searches automatically stopped} { catch {unset a} set a(a) 1 set x [array startsearch a] set y [array startsearch a] set a(a) 2 list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {0 a 0 a} test set-old-9.8 {array enumeration: searches automatically stopped} { catch {unset a} set a(a) 1 set a(c) 2 set x [array startsearch a] set y [array startsearch a] catch {unset a(c)} list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}} test set-old-9.9 {array enumeration: searches automatically stopped} { catch {unset a} set a(a) 1 set x [array startsearch a] set y [array startsearch a] catch {unset a(c)} list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {0 a 0 a} test set-old-9.10 {array enumeration: searches automatically stopped} { catch {unset a} set a(a) 1 set x [array startsearch a] set y [array startsearch a] trace var a(b) r {} list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}} test set-old-9.11 {array enumeration: searches automatically stopped} { catch {unset a} set a(a) 1 set x [array startsearch a] set y [array startsearch a] trace var a(a) r {} list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {0 a 0 a} test set-old-9.12 {array enumeration with traced undefined elements} { catch {unset a} set a(a) 1 trace var a(b) r {} set x [array startsearch a] lsort [list [array next a $x] [array next a $x]] } {{} a} test set-old-10.1 {array enumeration errors} { list [catch {array start} msg] $msg } {1 {wrong # args: should be "array startsearch arrayName"}} test set-old-10.2 {array enumeration errors} { list [catch {array start a b} msg] $msg } {1 {wrong # args: should be "array startsearch arrayName"}} test set-old-10.3 {array enumeration errors} { catch {unset a} list [catch {array start a} msg] $msg } {1 {"a" isn't an array}} test set-old-10.4 {array enumeration errors} { catch {unset a} set a(a) 1 set x [array startsearch a] list [catch {array next a} msg] $msg } {1 {wrong # args: should be "array nextelement arrayName searchId"}} test set-old-10.5 {array enumeration errors} { catch {unset a} set a(a) 1 set x [array startsearch a] list [catch {array next a b c} msg] $msg } {1 {wrong # args: should be "array nextelement arrayName searchId"}} test set-old-10.6 {array enumeration errors} { catch {unset a} set a(a) 1 set x [array startsearch a] list [catch {array next a a-1-a} msg] $msg } {1 {illegal search identifier "a-1-a"}} test set-old-10.7 {array enumeration errors} { catch {unset a} set a(a) 1 set x [array startsearch a] list [catch {array next a sx1-a} msg] $msg } {1 {illegal search identifier "sx1-a"}} test set-old-10.8 {array enumeration errors} { catch {unset a} set a(a) 1 set x [array startsearch a] list [catch {array next a s--a} msg] $msg } {1 {illegal search identifier "s--a"}} test set-old-10.9 {array enumeration errors} { catch {unset a} set a(a) 1 set x [array startsearch a] list [catch {array next a s-1-b} msg] $msg } {1 {search identifier "s-1-b" isn't for variable "a"}} test set-old-10.10 {array enumeration errors} { catch {unset a} set a(a) 1 set x [array startsearch a] list [catch {array next a s-1ba} msg] $msg } {1 {illegal search identifier "s-1ba"}} test set-old-10.11 {array enumeration errors} { catch {unset a} set a(a) 1 set x [array startsearch a] list [catch {array next a s-2-a} msg] $msg } {1 {couldn't find search "s-2-a"}} test set-old-10.12 {array enumeration errors} { list [catch {array done a} msg] $msg } {1 {wrong # args: should be "array donesearch arrayName searchId"}} test set-old-10.13 {array enumeration errors} { list [catch {array done a b c} msg] $msg } {1 {wrong # args: should be "array donesearch arrayName searchId"}} test set-old-10.14 {array enumeration errors} { catch {unset a} set a(a) a list [catch {array done a b} msg] $msg } {1 {illegal search identifier "b"}} test set-old-10.15 {array enumeration errors} { list [catch {array anymore a} msg] $msg } {1 {wrong # args: should be "array anymore arrayName searchId"}} test set-old-10.16 {array enumeration errors} { list [catch {array any a b c} msg] $msg } {1 {wrong # args: should be "array anymore arrayName searchId"}} test set-old-10.17 {array enumeration errors} { catch {unset a} set a(0) 44 list [catch {array any a bogus} msg] $msg } {1 {illegal search identifier "bogus"}} # Array enumeration with "anymore" option test set-old-11.1 {array anymore option} { catch {unset a} set a(a) 1 set a(b) 2 set a(c) 3 array startsearch a lsort [list [array anymore a s-1-a] [array next a s-1-a] \ [array anymore a s-1-a] [array next a s-1-a] \ [array anymore a s-1-a] [array next a s-1-a] \ [array anymore a s-1-a] [array next a s-1-a]] } {{} 0 1 1 1 a b c} test set-old-11.2 {array anymore option} { catch {unset a} set a(a) 1 set a(b) 2 set a(c) 3 array startsearch a lsort [list [array next a s-1-a] [array next a s-1-a] \ [array anymore a s-1-a] [array next a s-1-a] \ [array next a s-1-a] [array anymore a s-1-a]] } {{} 0 1 a b c} # Special check to see that the value of a variable is handled correctly # if it is returned as the result of a procedure (must not free the variable # string while deleting the call frame). Errors will only be detected if # a memory consistency checker such as Purify is being used. test set-old-12.1 {cleanup on procedure return} { proc foo {} { set x 12345 } foo } 12345 test set-old-12.2 {cleanup on procedure return} { proc foo {} { set x(1) 23456 } foo } 23456 # Must delete variables when done, since these arrays get used as # scalars by other tests. catch {unset a} catch {unset b} catch {unset c} catch {unset aVaRnAmE} catch {rename foo {}} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/set.test0000644000175000017500000004436714554262142014516 0ustar sergeisergei# Commands covered: set # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testset2 [llength [info commands testset2]] catch {unset x} catch {unset i} test set-1.1 {TclCompileSetCmd: missing variable name} { list [catch {set} msg] $msg } {1 {wrong # args: should be "set varName ?newValue?"}} test set-1.2 {TclCompileSetCmd: simple variable name} { set i 10 list [set i] $i } {10 10} test set-1.3 {TclCompileSetCmd: error compiling variable name} { set i 10 catch {set "i"xxx} msg set msg } {extra characters after close-quote} test set-1.4 {TclCompileSetCmd: simple variable name in quotes} { set i 17 list [set "i"] $i } {17 17} test set-1.5 {TclCompileSetCmd: simple variable name in braces} -setup { catch {unset {a simple var}} } -body { set {a simple var} 27 list [set {a simple var}] ${a simple var} } -result {27 27} test set-1.6 {TclCompileSetCmd: simple array variable name} -setup { catch {unset a} } -body { set a(foo) 37 list [set a(foo)] $a(foo) } -result {37 37} test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} { set x "i" set i 77 list [set $x] $i } {77 77} test set-1.8 {TclCompileSetCmd: non-simple (computed) variable name} { set x "i" set i 77 list [set [set x] 2] $i } {2 2} test set-1.9 {TclCompileSetCmd: 3rd arg => assignment} { set i "abcdef" list [set i] $i } {abcdef abcdef} test set-1.10 {TclCompileSetCmd: only two args => just getting value} { set i {one two} set i } {one two} test set-1.11 {TclCompileSetCmd: simple global name} { proc p {} { global i set i 54 set i } p } {54} test set-1.12 {TclCompileSetCmd: simple local name} { proc p {bar} { set foo $bar set foo } p 999 } {999} test set-1.13 {TclCompileSetCmd: simple but new (unknown) local name} { proc p {} { set bar } catch {p} msg set msg } {can't read "bar": no such variable} test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} { proc 260locals {} { # create 260 locals (the last ones with index > 255) set a0 0; set a1 0; set a2 0; set a3 0; set a4 0 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0 set z5 0; set z6 0; set z7 0; set z8 0; set z9 1234 } 260locals } {1234} test set-1.15 {TclCompileSetCmd: variable is array} -setup { catch {unset a} } -body { set x 27 set x [set a(foo) 11] catch {unset a} set x } -result 11 test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} -setup { catch {unset a} } -body { set i 5 set x 789 set a(foo5) 27 set x [set a(foo$i)] catch {unset a} set x } -result 27 test set-1.17 {TclCompileSetCmd: doing assignment, simple int} { set i 5 set i 123 } 123 test set-1.18 {TclCompileSetCmd: doing assignment, simple int} { set i 5 set i -100 } -100 test set-1.19 {TclCompileSetCmd: doing assignment, simple but not int} { set i 5 set i 0x12MNOP set i } {0x12MNOP} test set-1.20 {TclCompileSetCmd: doing assignment, in quotes} { set i 25 set i "-100" } -100 test set-1.21 {TclCompileSetCmd: doing assignment, in braces} { set i 24 set i {126} } 126 test set-1.22 {TclCompileSetCmd: doing assignment, large int} { set i 5 set i 200000 } 200000 test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} { set i 25 set i 0o00012345 ;# an octal literal == 5349 decimal list $i [incr i] } {0o00012345 5350} test set-1.24 {TclCompileSetCmd: too many arguments} { set i 10 catch {set i 20 30} msg set msg } {wrong # args: should be "set varName ?newValue?"} test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} { # This was a known error in 8.1a* - 8.2.1 catch {unset array} set {array($foo)} 5 } 5 test set-1.26 {TclCompileSetCmd: various array constructs} { # Test all kinds of array constructs that TclCompileSetCmd # may feel inclined to tamper with. apply {{} { set a x set be(hej) 1 ; # hej set be($a) 1 ; # x set {be($a)} 1 ; # $a set be($a,hej) 1 ; # x,hej set be($a,$a) 5 ; # x,x set be(c($a) 1 ; # c(x set be(\w\w) 1 ; # ww set be(a:$a) [set be(x,$a)] ; # a:x set be(hej,$be($a,hej),hej) 1 ; # hej,1,hej set be([string range hugge 0 2]) 1 ; # hug set be(a\ a) 1 ; # a a set be($a\ ,[string range hugge 1 3],hej) 1 ; # x ,ugg,hej set be($a,h"ej) 1 ; # x,h"ej set be([string range "a b c" 2 end]) 1 ; # b c set [string range bet 0 1](foo) 1 ; # foo set be([set be(a:$a)][set b\e($a)]) 1 ; # 51 return [lsort [array names be]] }} } [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej {b c} foo 51}]; # " just a matching end quote test set-2.1 {set command: runtime error, bad variable name} -setup { unset -nocomplain {"foo} } -body { list [catch {set {"foo}} msg] $msg $::errorInfo } -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable while executing "set {"foo}"}} # Stop my editor highlighter " from being confused test set-2.2 {set command: runtime error, not array variable} -setup { unset -nocomplain b } -body { set b 44 list [catch {set b(123)} msg] $msg } -result {1 {can't read "b(123)": variable isn't array}} test set-2.3 {set command: runtime error, errors in reading variables} -setup { unset -nocomplain a } -body { set a(6) 44 list [catch {set a(18)} msg] $msg } -result {1 {can't read "a(18)": no such element in array}} test set-2.4 {set command: runtime error, readonly variable} -setup { unset -nocomplain x } -body { proc readonly args {error "variable is read-only"} set x 123 trace var x w readonly list [catch {set x 1} msg] $msg $::errorInfo } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing * "set x 1"}} test set-2.5 {set command: runtime error, basic array operations} -setup { unset -nocomplain a } -body { array set a {} list [catch {set a(other)} msg] $msg } -result {1 {can't read "a(other)": no such element in array}} test set-2.6 {set command: runtime error, basic array operations} -setup { unset -nocomplain a } -body { array set a {} list [catch {set a} msg] $msg } -result {1 {can't read "a": variable is array}} # Test the uncompiled version of set catch {unset a} catch {unset b} catch {unset i} catch {unset x} test set-3.1 {uncompiled set command: missing variable name} { set z set list [catch {$z} msg] $msg } {1 {wrong # args: should be "set varName ?newValue?"}} test set-3.2 {uncompiled set command: simple variable name} { set z set $z i 10 list [$z i] $i } {10 10} test set-3.3 {uncompiled set command: error compiling variable name} { set z set $z i 10 catch {$z "i"xxx} msg $z msg } {extra characters after close-quote} test set-3.4 {uncompiled set command: simple variable name in quotes} { set z set $z i 17 list [$z "i"] $i } {17 17} test set-3.5 {uncompiled set command: simple variable name in braces} { set z set catch {unset {a simple var}} $z {a simple var} 27 list [$z {a simple var}] ${a simple var} } {27 27} test set-3.6 {uncompiled set command: simple array variable name} { set z set catch {unset a} $z a(foo) 37 list [$z a(foo)] $a(foo) } {37 37} test set-3.7 {uncompiled set command: non-simple (computed) variable name} { set z set $z x "i" $z i 77 list [$z $x] $i } {77 77} test set-3.8 {uncompiled set command: non-simple (computed) variable name} { set z set $z x "i" $z i 77 list [$z [$z x] 2] $i } {2 2} test set-3.9 {uncompiled set command: 3rd arg => assignment} { set z set $z i "abcdef" list [$z i] $i } {abcdef abcdef} test set-3.10 {uncompiled set command: only two args => just getting value} { set z set $z i {one two} $z i } {one two} test set-3.11 {uncompiled set command: simple global name} { proc p {} { set z set global i $z i 54 $z i } p } {54} test set-3.12 {uncompiled set command: simple local name} { proc p {bar} { set z set $z foo $bar $z foo } p 999 } {999} test set-3.13 {uncompiled set command: simple but new (unknown) local name} { set z set proc p {} { set z set $z bar } catch {p} msg $z msg } {can't read "bar": no such variable} test set-3.14 {uncompiled set command: simple local name, >255 locals} { proc 260locals {} { set z set # create 260 locals (the last ones with index > 255) $z a0 0; $z a1 0; $z a2 0; $z a3 0; $z a4 0 $z a5 0; $z a6 0; $z a7 0; $z a8 0; $z a9 0 $z b0 0; $z b1 0; $z b2 0; $z b3 0; $z b4 0 $z b5 0; $z b6 0; $z b7 0; $z b8 0; $z b9 0 $z c0 0; $z c1 0; $z c2 0; $z c3 0; $z c4 0 $z c5 0; $z c6 0; $z c7 0; $z c8 0; $z c9 0 $z d0 0; $z d1 0; $z d2 0; $z d3 0; $z d4 0 $z d5 0; $z d6 0; $z d7 0; $z d8 0; $z d9 0 $z e0 0; $z e1 0; $z e2 0; $z e3 0; $z e4 0 $z e5 0; $z e6 0; $z e7 0; $z e8 0; $z e9 0 $z f0 0; $z f1 0; $z f2 0; $z f3 0; $z f4 0 $z f5 0; $z f6 0; $z f7 0; $z f8 0; $z f9 0 $z g0 0; $z g1 0; $z g2 0; $z g3 0; $z g4 0 $z g5 0; $z g6 0; $z g7 0; $z g8 0; $z g9 0 $z h0 0; $z h1 0; $z h2 0; $z h3 0; $z h4 0 $z h5 0; $z h6 0; $z h7 0; $z h8 0; $z h9 0 $z i0 0; $z i1 0; $z i2 0; $z i3 0; $z i4 0 $z i5 0; $z i6 0; $z i7 0; $z i8 0; $z i9 0 $z j0 0; $z j1 0; $z j2 0; $z j3 0; $z j4 0 $z j5 0; $z j6 0; $z j7 0; $z j8 0; $z j9 0 $z k0 0; $z k1 0; $z k2 0; $z k3 0; $z k4 0 $z k5 0; $z k6 0; $z k7 0; $z k8 0; $z k9 0 $z l0 0; $z l1 0; $z l2 0; $z l3 0; $z l4 0 $z l5 0; $z l6 0; $z l7 0; $z l8 0; $z l9 0 $z m0 0; $z m1 0; $z m2 0; $z m3 0; $z m4 0 $z m5 0; $z m6 0; $z m7 0; $z m8 0; $z m9 0 $z n0 0; $z n1 0; $z n2 0; $z n3 0; $z n4 0 $z n5 0; $z n6 0; $z n7 0; $z n8 0; $z n9 0 $z o0 0; $z o1 0; $z o2 0; $z o3 0; $z o4 0 $z o5 0; $z o6 0; $z o7 0; $z o8 0; $z o9 0 $z p0 0; $z p1 0; $z p2 0; $z p3 0; $z p4 0 $z p5 0; $z p6 0; $z p7 0; $z p8 0; $z p9 0 $z q0 0; $z q1 0; $z q2 0; $z q3 0; $z q4 0 $z q5 0; $z q6 0; $z q7 0; $z q8 0; $z q9 0 $z r0 0; $z r1 0; $z r2 0; $z r3 0; $z r4 0 $z r5 0; $z r6 0; $z r7 0; $z r8 0; $z r9 0 $z s0 0; $z s1 0; $z s2 0; $z s3 0; $z s4 0 $z s5 0; $z s6 0; $z s7 0; $z s8 0; $z s9 0 $z t0 0; $z t1 0; $z t2 0; $z t3 0; $z t4 0 $z t5 0; $z t6 0; $z t7 0; $z t8 0; $z t9 0 $z u0 0; $z u1 0; $z u2 0; $z u3 0; $z u4 0 $z u5 0; $z u6 0; $z u7 0; $z u8 0; $z u9 0 $z v0 0; $z v1 0; $z v2 0; $z v3 0; $z v4 0 $z v5 0; $z v6 0; $z v7 0; $z v8 0; $z v9 0 $z w0 0; $z w1 0; $z w2 0; $z w3 0; $z w4 0 $z w5 0; $z w6 0; $z w7 0; $z w8 0; $z w9 0 $z x0 0; $z x1 0; $z x2 0; $z x3 0; $z x4 0 $z x5 0; $z x6 0; $z x7 0; $z x8 0; $z x9 0 $z y0 0; $z y1 0; $z y2 0; $z y3 0; $z y4 0 $z y5 0; $z y6 0; $z y7 0; $z y8 0; $z y9 0 $z z0 0; $z z1 0; $z z2 0; $z z3 0; $z z4 0 $z z5 0; $z z6 0; $z z7 0; $z z8 0; $z z9 1234 } 260locals } {1234} test set-3.15 {uncompiled set command: variable is array} { set z set catch {unset a} $z x 27 $z x [$z a(foo) 11] catch {unset a} $z x } 11 test set-3.16 {uncompiled set command: variable is array, elem substitutions} { set z set catch {unset a} $z i 5 $z x 789 $z a(foo5) 27 $z x [$z a(foo$i)] catch {unset a} $z x } 27 test set-3.17 {uncompiled set command: doing assignment, simple int} { set z set $z i 5 $z i 123 } 123 test set-3.18 {uncompiled set command: doing assignment, simple int} { set z set $z i 5 $z i -100 } -100 test set-3.19 {uncompiled set command: doing assignment, simple but not int} { set z set $z i 5 $z i 0x12MNOP $z i } {0x12MNOP} test set-3.20 {uncompiled set command: doing assignment, in quotes} { set z set $z i 25 $z i "-100" } -100 test set-3.21 {uncompiled set command: doing assignment, in braces} { set z set $z i 24 $z i {126} } 126 test set-3.22 {uncompiled set command: doing assignment, large int} { set z set $z i 5 $z i 200000 } 200000 test set-3.23 {uncompiled set command: doing assignment, formatted int != int} { set z set $z i 25 $z i 0o00012345 ;# an octal literal == 5349 decimal list $i [incr i] } {0o00012345 5350} test set-3.24 {uncompiled set command: too many arguments} { set z set $z i 10 catch {$z i 20 30} msg $z msg } {wrong # args: should be "set varName ?newValue?"} test set-4.1 {uncompiled set command: runtime error, bad variable name} -setup { unset -nocomplain {"foo} } -body { set z set list [catch {$z {"foo}} msg] $msg $::errorInfo } -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable while executing "$z {"foo}"}} # Stop my editor highlighter " from being confused test set-4.2 {uncompiled set command: runtime error, not array variable} -setup { catch {unset b} } -body { set z set $z b 44 list [catch {$z b(123)} msg] $msg } -result {1 {can't read "b(123)": variable isn't array}} test set-4.3 {uncompiled set command: runtime error, errors in reading variables} -setup { catch {unset a} } -body { set z set $z a(6) 44 list [catch {$z a(18)} msg] $msg } -result {1 {can't read "a(18)": no such element in array}} test set-4.4 {uncompiled set command: runtime error, readonly variable} -body { set z set proc readonly args {error "variable is read-only"} $z x 123 trace var x w readonly list [catch {$z x 1} msg] $msg $::errorInfo } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing * "$z x 1"}} test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup { unset -nocomplain a array set a {} } -body { set z set list [catch {$z a(other)} msg] $msg } -result {1 {can't read "a(other)": no such element in array}} test set-4.6 {set command: runtime error, basic array operations} -setup { unset -nocomplain a array set a {} } -body { set z set list [catch {$z a} msg] $msg } -result {1 {can't read "a": variable is array}} test set-5.1 {error on malformed array name} -constraints testset2 -setup { unset -nocomplain z } -body { catch {testset2 z(a) b} msg catch {testset2 z(b) a} msg1 list $msg $msg1 } -result {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}} # In a mem-debug build, this test will crash unless Bug 3602706 is fixed. test set-5.2 {Bug 3602706} -body { testset2 ::tcl_platform not-in-there } -returnCodes error -result * -match glob # cleanup catch {unset a} catch {unset b} catch {unset i} catch {unset x} catch {unset z} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/socket.test0000644000175000017500000022767614554262142015221 0ustar sergeisergei# Commands tested in this file: socket. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Running socket tests with a remote server: # ------------------------------------------ # # Some tests in socket.test depend on the existence of a remote server to # which they connect. The remote server must be an instance of tcltest and it # must run the script found in the file "remote.tcl" in this directory. You # can start the remote server on any machine reachable from the machine on # which you want to run the socket tests, by issuing: # # tcltest remote.tcl -port 2048 # Or choose another port number. # # If the machine you are running the remote server on has several IP # interfaces, you can choose which interface the server listens on for # connections by specifying the -address command line flag, so: # # tcltest remote.tcl -address your.machine.com # # These options can also be set by environment variables. On Unix, you can # type these commands to the shell from which the remote server is started: # # shell% setenv serverPort 2048 # shell% setenv serverAddress your.machine.com # # and subsequently you can start the remote server with: # # tcltest remote.tcl # # to have it listen on port 2048 on the interface your.machine.com. # # When the server starts, it prints out a detailed message containing its # configuration information, and it will block until killed with a Ctrl-C. # Once the remote server exists, you can run the tests in socket.test with the # server by setting two Tcl variables: # # % set remoteServerIP # % set remoteServerPort 2048 # # These variables are also settable from the environment. On Unix, you can: # # shell% setenv remoteServerIP machine.where.server.runs # shell% senetv remoteServerPort 2048 # # The preamble of the socket.test file checks to see if the variables are set # either in Tcl or in the environment; if they are, it attempts to connect to # the server. If the connection is successful, the tests using the remote # server will be performed; otherwise, it will attempt to start the remote # server (via exec) on platforms that support this, on the local host, # listening at port 2048. If all fails, a message is printed and the tests # using the remote server are not performed. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands # A bad interaction between socket creation, macOS, and unattended CI # environments make this whole file impractical to run; too many weird hangs. if {[info exists ::env(MAC_CI)]} { return } # Some tests require the Thread package or exec command testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] testConstraint exec [llength [info commands exec]] # Produce a random port number in the Dynamic/Private range # from 49152 through 65535. proc randport {} { # firstly try dynamic port via server-socket(0): set port 0x7fffffff catch { set port [lindex [fconfigure [set s [socket -server {} 0]] -sockname] 2] close $s } while {[catch { close [socket -server {} $port] } msg]} { if {[incr i] > 1000} {return -code error "too many iterations to get free random port: $msg"} # try random port: set port [expr {int(rand()*16383+49152)}] } return $port } # Test the latency of tcp connections over the loopback interface. Some OSes # (e.g. NetBSD) seem to use the Nagle algorithm and delayed ACKs, so it takes # up to 200ms for a packet sent to localhost to arrive. We're measuring this # here, so that OSes that don't have this problem can run the tests at full # speed. set server [socket -server {apply {{s a p} {set ::s1 $s}}} 0] set s2 [socket localhost [lindex [fconfigure $server -sockname] 2]] vwait s1; close $server fconfigure $s1 -buffering line fconfigure $s2 -buffering line set t1 [clock milliseconds] puts $s2 test1; gets $s1 puts $s2 test2; gets $s1 close $s1; close $s2 set t2 [clock milliseconds] set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin # Test the latency of failed connection attempts over the loopback # interface. They can take more than a second under Windows and requires # additional [after]s in some tests that are not needed on systems that fail # immediately. set t1 [clock milliseconds] catch {socket 127.0.0.1 [randport]} set t2 [clock milliseconds] set lat2 [expr {($t2-$t1)*3}] # Use the maximum of the two latency calculations, but at least 200ms set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}] set latency [expr {$latency > 200 ? $latency : 200}] unset t1 t2 s1 s2 lat1 lat2 server # If remoteServerIP or remoteServerPort are not set, check in the environment # variables for externally set values. # if {![info exists remoteServerIP]} { if {[info exists env(remoteServerIP)]} { set remoteServerIP $env(remoteServerIP) } } if {![info exists remoteServerPort]} { if {[info exists env(remoteServerPort)]} { set remoteServerPort $env(remoteServerPort) } else { if {[info exists remoteServerIP]} { set remoteServerPort 2048 } } } if 0 { # activate this to time the tests proc test {args} { set name [lindex $args 0] puts "[lindex [time {uplevel [linsert $args 0 tcltest::test]}] 0] @@@ $name" } } foreach {af localhost} { inet 127.0.0.1 inet6 ::1 } { # Check if the family is supported and set the constraint accordingly testConstraint supported_$af [expr {![catch {socket -server foo -myaddr $localhost 0} sock]}] catch {close $sock} } set sock [socket -server foo -myaddr localhost 0] set sockname [fconfigure $sock -sockname] close $sock testConstraint localhost_v4 [expr {"127.0.0.1" in $sockname}] testConstraint localhost_v6 [expr {"::1" in $sockname}] foreach {af localhost} { any 127.0.0.1 inet 127.0.0.1 inet6 ::1 } { if {![testConstraint supported_$af]} { continue } set ::tcl::unsupported::socketAF $af # # Check if we're supposed to do tests against the remote server # set doTestsWithRemoteServer 1 if {![info exists remoteServerIP]} { set remoteServerIP $localhost } if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} { set remoteServerPort [randport] } # Attempt to connect to a remote server if one is already running. If it is # not running or for some other reason the connect fails, attempt to start the # remote server on the local host listening on port 2048. This is only done on # platforms that support exec (i.e. not on the Mac). On platforms that do not # support exec, the remote server must be started by the user before running # the tests. set remoteProcChan "" set commandSocket "" if {$doTestsWithRemoteServer} { catch {close $commandSocket} if {![catch { set commandSocket [socket $remoteServerIP $remoteServerPort] }]} then { fconfigure $commandSocket -translation crlf -buffering line } elseif {![testConstraint exec]} { set noRemoteTestReason "can't exec" set doTestsWithRemoteServer 0 } else { set remoteServerIP $localhost # Be *extra* careful in case this file is sourced from # a directory other than the current one... set remoteFile [file join [pwd] [file dirname [info script]] \ remote.tcl] if {![catch { set remoteProcChan [open "|[list \ [interpreter] $remoteFile -serverIsSilent \ -port $remoteServerPort -address $remoteServerIP]" w+] } msg]} then { gets $remoteProcChan if {[catch { set commandSocket [socket $remoteServerIP $remoteServerPort] } msg] == 0} then { fconfigure $commandSocket -translation crlf -buffering line } else { set noRemoteTestReason $msg set doTestsWithRemoteServer 0 } } else { set noRemoteTestReason "$msg [interpreter]" set doTestsWithRemoteServer 0 } } } # Some tests are run only if we are doing testing against a remote server. testConstraint doTestsWithRemoteServer $doTestsWithRemoteServer if {!$doTestsWithRemoteServer} { if {[string first s $::tcltest::verbose] >= 0} { puts "Skipping tests with remote server. See tests/socket.test for" puts "information on how to run remote server." puts "Reason for not doing remote tests: $noRemoteTestReason" } } # # If we do the tests, define a command to send a command to the remote server. # if {[testConstraint doTestsWithRemoteServer]} { proc sendCommand {c} { global commandSocket if {[eof $commandSocket]} { error "remote server disappeared" } if {[catch {puts $commandSocket $c} msg]} { error "remote server disappaered: $msg" } if {[catch {puts $commandSocket "--Marker--Marker--Marker--"} msg]} { error "remote server disappeared: $msg" } while {1} { set line [gets $commandSocket] if {[eof $commandSocket]} { error "remote server disappaered" } if {$line eq "--Marker--Marker--Marker--"} { lassign $result code info value return -code $code -errorinfo $info $value } append result $line "\n" } } } proc getPort sock { lindex [fconfigure $sock -sockname] 2 } # Some tests in this file are known to hang *occasionally* on OSX; stop the # worst offenders. testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] # Here "Windows" means derived platforms as Cygwin or Msys2 too. testConstraint notWindows [expr {![regexp {^(Windows|MSYS|CYGWIN)} $::tcl_platform(os)]}] # ---------------------------------------------------------------------- test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server } -returnCodes error -result {no argument given for -server option} test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server foo } -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"} test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myaddr } -returnCodes error -result {no argument given for -myaddr option} test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myaddr $localhost } -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"} test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myport } -returnCodes error -result {no argument given for -myport option} test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myport xxxx } -returnCodes error -result {expected integer but got "xxxx"} test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myport 2522 } -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"} test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -froboz } -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, or -server} test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server foo -myport 2521 3333 } -returnCodes error -result {option -myport is not valid for servers} test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket host 2528 -junk } -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"} test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server callback 2520 -- } -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"} test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket foo badport } -returnCodes error -result {expected integer but got "badport"} test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -async -server } -returnCodes error -result {cannot set -async option for server sockets} test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server foo -async } -returnCodes error -result {cannot set -async option for server sockets} set path(script) [makeFile {} script] test socket_$af-2.1 {tcp connection} -constraints [list socket supported_$af stdio] -setup { file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 10000 "set x timed_out"] set f [socket -server accept 0] proc accept {file addr port} { global x set x done close $file } puts ready puts [lindex [fconfigure $f -sockname] 2] vwait x after cancel $timer close $f puts $x } close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f x gets $f listen } -body { # $x == "ready" at this point set sock [socket $localhost $listen] lappend x [gets $f] close $sock lappend x [gets $f] } -cleanup { close $f } -result {ready done {}} test socket_$af-2.2 {tcp connection with client port specified} -setup { set port [randport] file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 10000 "set x timeout"] set f [socket -server accept 0] proc accept {file addr port} { global x puts "[gets $file] $port" close $file set x done } puts ready puts [lindex [fconfigure $f -sockname] 2] vwait x after cancel $timer close $f } close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f x gets $f listen } -constraints [list socket supported_$af stdio] -body { # $x == "ready" at this point set sock [socket -myport $port $localhost $listen] puts $sock hello flush $sock lappend x [expr {[gets $f] eq "hello $port"}] close $sock return $x } -cleanup { catch {close [socket $localhost $listen]} close $f } -result {ready 1} test socket_$af-2.3 {tcp connection with client interface specified} -setup { file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 2000 "set x done"] set f [socket -server accept 0] proc accept {file addr port} { global x puts "[gets $file] $addr" close $file set x done } puts [lindex [fconfigure $f -sockname] 2] puts ready vwait x after cancel $timer close $f } close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f listen gets $f x } -constraints [list socket supported_$af stdio] -body { # $x == "ready" at this point set sock [socket -myaddr $localhost $localhost $listen] puts $sock hello flush $sock lappend x [gets $f] close $sock return $x } -cleanup { close $f } -result [list ready [list hello $localhost]] test socket_$af-2.4 {tcp connection with server interface specified} -setup { file delete $path(script) set f [open $path(script) w] puts $f [list set localhost $localhost] puts $f { set timer [after 2000 "set x done"] set f [socket -server accept -myaddr $localhost 0] proc accept {file addr port} { global x puts "[gets $file]" close $file set x done } puts ready puts [lindex [fconfigure $f -sockname] 2] vwait x after cancel $timer close $f } close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f x gets $f listen } -constraints [list socket supported_$af stdio] -body { # $x == "ready" at this point set sock [socket $localhost $listen] puts $sock hello flush $sock lappend x [gets $f] close $sock return $x } -cleanup { close $f } -result {ready hello} test socket_$af-2.5 {tcp connection with redundant server port} -setup { file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 10000 "set x timeout"] set f [socket -server accept 0] proc accept {file addr port} { global x puts "[gets $file]" close $file set x done } puts ready puts [lindex [fconfigure $f -sockname] 2] vwait x after cancel $timer close $f } close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f x gets $f listen } -constraints [list socket supported_$af stdio] -body { # $x == "ready" at this point set sock [socket $localhost $listen] puts $sock hello flush $sock lappend x [gets $f] close $sock return $x } -cleanup { close $f } -result {ready hello} test socket_$af-2.6 {tcp connection} -constraints [list socket supported_$af] -body { set status ok if {![catch {set sock [socket $localhost [randport]]}]} { if {![catch {gets $sock}]} { set status broken } close $sock } set status } -result ok test socket_$af-2.7 {echo server, one line} -constraints [list socket supported_$af stdio] -setup { file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 10000 "set x timeout"] set f [socket -server accept 0] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -translation lf -buffering line } proc echo {s} { set l [gets $s] if {[eof $s]} { global x close $s set x done } else { puts $s $l } } puts ready puts [lindex [fconfigure $f -sockname] 2] vwait x after cancel $timer close $f puts $x } close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f gets $f listen } -body { set s [socket $localhost $listen] fconfigure $s -buffering line -translation lf puts $s "hello abcdefghijklmnop" set x [gets $s] close $s list $x [gets $f] } -cleanup { close $f } -result {{hello abcdefghijklmnop} done} removeFile script test socket_$af-2.8 {echo server, loop 50 times, single connection} -setup { set path(script) [makeFile { set f [socket -server accept 0] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line } proc echo {s} { global i set l [gets $s] if {[eof $s]} { global x close $s set x done } else { incr i puts $s $l } } set i 0 puts ready puts [lindex [fconfigure $f -sockname] 2] set timer [after 20000 "set x done"] vwait x after cancel $timer close $f puts "done $i" } script] set f [open "|[list [interpreter] $path(script)]" r] gets $f gets $f listen } -constraints [list socket supported_$af stdio] -body { set s [socket $localhost $listen] fconfigure $s -buffering line catch { for {set x 0} {$x < 50} {incr x} { puts $s "hello abcdefghijklmnop" gets $s } } close $s catch {set x [gets $f]} return $x } -cleanup { close $f removeFile script } -result {done 50} set path(script) [makeFile {} script] test socket_$af-2.9 {socket conflict} -constraints [list socket supported_$af stdio] -body { set s [socket -server accept 0] file delete $path(script) set f [open $path(script) w] puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF] puts $f "socket -server accept [lindex [fconfigure $s -sockname] 2]" close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f after 100 close $f } -returnCodes error -cleanup { close $s } -match glob -result {couldn't open socket: address already in use*} test socket_$af-2.10 {close on accept, accepted socket lives} -setup { set done 0 set timer [after 20000 "set done timed_out"] } -constraints [list socket supported_$af] -body { set ss [socket -server accept 0] proc accept {s a p} { global ss close $ss fileevent $s readable "readit $s" fconfigure $s -trans lf } proc readit {s} { global done gets $s close $s set done 1 } set cs [socket $localhost [lindex [fconfigure $ss -sockname] 2]] puts $cs hello close $cs vwait done return $done } -cleanup { after cancel $timer } -result 1 test socket_$af-2.11 {detecting new data} -constraints [list socket supported_$af] -setup { proc accept {s a p} { global sock set sock $s } set s [socket -server accept 0] set sock "" } -body { set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]] vwait sock puts $s2 one flush $s2 after $latency {set x 1}; # Spurious failures in Travis CI, if we do [after idle] vwait x fconfigure $sock -blocking 0 set result a:[gets $sock] lappend result b:[gets $sock] fconfigure $sock -blocking 1 puts $s2 two flush $s2 after $latency {set x 1}; # NetBSD fails here if we do [after idle] vwait x fconfigure $sock -blocking 0 lappend result c:[gets $sock] } -cleanup { fconfigure $sock -blocking 1 close $s2 close $s close $sock } -result {a:one b: c:two} test socket_$af-2.12 {} [list socket stdio supported_$af] { file delete $path(script) set f [open $path(script) w] puts $f { set server [socket -server accept_client 0] puts [lindex [chan configure $server -sockname] 2] proc accept_client { client host port } { chan configure $client -blocking 0 -buffering line write_line $client } proc write_line client { if { [catch { chan puts $client [string repeat . 720000]}] } { puts [catch {chan close $client}] } else { puts signal1 after 0 write_line $client } } chan event stdin readable {set forever now} vwait forever exit } close $f set f [open "|[list [interpreter] $path(script)]" r+] gets $f port set sock [socket $localhost $port] chan event $sock readable [list read_lines $sock $f] proc read_lines { sock pipe } { gets $pipe chan close $sock chan event $pipe readable [list readpipe $pipe] } proc readpipe {pipe} { while {![string is integer [set ::done [gets $pipe]]]} {} } vwait ::done close $f set ::done } 0 test socket_$af-2.13 {Bug 1758a0b603} {socket stdio} { file delete $path(script) set f [open $path(script) w] puts $f { set server [socket -server accept 0] puts [lindex [chan configure $server -sockname] 2] proc accept { client host port } { chan configure $client -blocking 0 -buffering line -buffersize 1 puts $client [string repeat . 720000] puts ready chan event $client writable [list setup $client] } proc setup client { chan event $client writable {set forever write} after 5 {set forever timeout} } vwait forever puts $forever } close $f set pipe [open |[list [interpreter] $path(script)] r] gets $pipe port set sock [socket $localhost $port] chan configure $sock -blocking 0 -buffering line chan event $sock readable [list read_lines $sock $pipe ] proc read_lines { sock pipe } { gets $pipe gets $sock line after idle [list stop $sock $pipe] chan event $sock readable {} } proc stop {sock pipe} { variable done close $sock set done [gets $pipe] } variable done vwait [namespace which -variable done] close $pipe set done } write test socket_$af-3.1 {socket conflict} -constraints [list socket supported_$af stdio] -setup { file delete $path(script) set f [open $path(script) w] puts $f [list set localhost $localhost] puts $f { set f [socket -server accept -myaddr $localhost 0] puts ready puts [lindex [fconfigure $f -sockname] 2] gets stdin close $f } close $f set f [open "|[list [interpreter] $path(script)]" r+] gets $f gets $f listen } -body { socket -server accept -myaddr $localhost $listen } -cleanup { puts $f bye close $f } -returnCodes error -result {couldn't open socket: address already in use} test socket_$af-3.2 {server with several clients} -setup { file delete $path(script) set f [open $path(script) w] puts $f [list set localhost $localhost] puts $f { set t1 [after 30000 "set x timed_out"] set t2 [after 31000 "set x timed_out"] set t3 [after 32000 "set x timed_out"] set counter 0 set s [socket -server accept -myaddr $localhost 0] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line } proc echo {s} { global x set l [gets $s] if {[eof $s]} { close $s set x done } else { puts $s $l } } puts ready puts [lindex [fconfigure $s -sockname] 2] vwait x after cancel $t1 vwait x after cancel $t2 vwait x after cancel $t3 close $s puts $x } close $f set f [open "|[list [interpreter] $path(script)]" r+] set x [gets $f] gets $f listen } -constraints [list socket supported_$af stdio] -body { # $x == "ready" here set s1 [socket $localhost $listen] fconfigure $s1 -buffering line set s2 [socket $localhost $listen] fconfigure $s2 -buffering line set s3 [socket $localhost $listen] fconfigure $s3 -buffering line for {set i 0} {$i < 100} {incr i} { puts $s1 hello,s1 gets $s1 puts $s2 hello,s2 gets $s2 puts $s3 hello,s3 gets $s3 } close $s1 close $s2 close $s3 lappend x [gets $f] } -cleanup { close $f } -result {ready done} test socket_$af-4.1 {server with several clients} -setup { file delete $path(script) set f [open $path(script) w] puts $f [list set localhost $localhost] puts $f { set port [gets stdin] set s [socket $localhost $port] fconfigure $s -buffering line for {set i 0} {$i < 100} {incr i} { puts $s hello gets $s } close $s puts bye gets stdin } close $f set p1 [open "|[list [interpreter] $path(script)]" r+] fconfigure $p1 -buffering line set p2 [open "|[list [interpreter] $path(script)]" r+] fconfigure $p2 -buffering line set p3 [open "|[list [interpreter] $path(script)]" r+] fconfigure $p3 -buffering line } -constraints [list socket supported_$af stdio] -body { proc accept {s a p} { fconfigure $s -buffering line fileevent $s readable [list echo $s] } proc echo {s} { global x set l [gets $s] if {[eof $s]} { close $s set x done } else { puts $s $l } } set t1 [after 30000 "set x timed_out"] set t2 [after 31000 "set x timed_out"] set t3 [after 32000 "set x timed_out"] set s [socket -server accept -myaddr $localhost 0] set listen [lindex [fconfigure $s -sockname] 2] puts $p1 $listen puts $p2 $listen puts $p3 $listen vwait x vwait x vwait x after cancel $t1 after cancel $t2 after cancel $t3 close $s set l "" lappend l [list p1 [gets $p1] $x] lappend l [list p2 [gets $p2] $x] lappend l [list p3 [gets $p3] $x] } -cleanup { puts $p1 bye puts $p2 bye puts $p3 bye close $p1 close $p2 close $p3 } -result {{p1 bye done} {p2 bye done} {p3 bye done}} test socket_$af-4.2 {byte order problems, socket numbers, htons} -body { close [socket -server dodo -myaddr $localhost 0x3000] return ok } -constraints [list socket supported_$af] -result ok test socket_$af-5.1 {byte order problems, socket numbers, htons} -body { if {![catch {socket -server dodo 0x1} msg]} { close $msg return {htons problem, should be disallowed, are you running as SU?} } return {couldn't open socket: not owner} } -constraints [list socket supported_$af unix notRoot notOSX notWindows] -result {couldn't open socket: not owner} test socket_$af-5.2 {byte order problems, socket numbers, htons} -body { if {![catch {socket -server dodo 0x10000} msg]} { close $msg return {port resolution problem, should be disallowed} } return {couldn't open socket: port number too high} } -constraints [list socket supported_$af] -result {couldn't open socket: port number too high} test socket_$af-5.3 {byte order problems, socket numbers, htons} -body { if {![catch {socket -server dodo 21} msg]} { close $msg return {htons problem, should be disallowed, are you running as SU?} } return {couldn't open socket: not owner} } -constraints [list socket supported_$af unix notRoot notOSX notWindows] -result {couldn't open socket: not owner} test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup { proc myHandler {msg options} { variable x $msg } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] file delete $path(script) } -body { set f [open $path(script) w] puts $f [list set localhost $localhost] puts $f { gets stdin port socket $localhost $port } close $f set f [open "|[list [interpreter] $path(script)]" r+] proc accept {s a p} {expr {10 / 0}} set s [socket -server accept -myaddr $localhost 0] puts $f [lindex [fconfigure $s -sockname] 2] close $f set timer [after 10000 "set x timed_out"] vwait x after cancel $timer close $s return $x } -cleanup { interp bgerror {} $handler } -result {divide by zero} test socket_$af-6.2 { readable fileevent on server socket } -setup { set sock [socket -server dummy 0] } -constraints [list socket supported_$af] -body { fileevent $sock readable dummy } -cleanup { close $sock } -returnCodes 1 -result "channel is not readable" test socket_$af-6.3 {writable fileevent on server socket} -setup { set sock [socket -server dummy 0] } -constraints [list socket supported_$af] -body { fileevent $sock writable dummy } -cleanup { close $sock } -returnCodes 1 -result "channel is not writable" test socket_$af-7.1 {testing socket specific options} -setup { file delete $path(script) set f [open $path(script) w] puts $f { set ss [socket -server accept 0] proc accept args { global x set x done } puts ready puts [lindex [fconfigure $ss -sockname] 2] set timer [after 10000 "set x timed_out"] vwait x after cancel $timer } close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f gets $f listen set l "" } -constraints [list socket supported_$af stdio] -body { set s [socket $localhost $listen] set p [fconfigure $s -peername] close $s lappend l [string compare [lindex $p 0] $localhost] lappend l [string compare [lindex $p 2] $listen] lappend l [llength $p] } -cleanup { close $f } -result {0 0 3} test socket_$af-7.2 {testing socket specific options} -setup { file delete $path(script) set f [open $path(script) w] puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF] puts $f { set ss [socket -server accept 0] proc accept args { global x set x done } puts ready puts [lindex [fconfigure $ss -sockname] 2] set timer [after 10000 "set x timed_out"] vwait x after cancel $timer } close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f gets $f listen } -constraints [list socket supported_$af stdio] -body { set s [socket $localhost $listen] set p [fconfigure $s -sockname] close $s list [llength $p] \ [regexp {^(127\.0\.0\.1|0\.0\.0\.0|::1)$} [lindex $p 0]] \ [expr {[lindex $p 2] == $listen}] } -cleanup { close $f } -result {3 1 0} test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body { set s [socket -server accept -myaddr $localhost 0] set l [fconfigure $s] close $s update llength $l } -result 14 test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup { set timer [after 10000 "set x timed_out"] set l "" } -body { set s [socket -server accept -myaddr $localhost 0] proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s } set listen [lindex [fconfigure $s -sockname] 2] set s1 [socket $localhost $listen] vwait x lappend l [expr {[lindex $x 2] == $listen}] [llength $x] } -cleanup { after cancel $timer close $s close $s1 } -result {1 3} test socket_$af-7.5 {testing socket specific options} -setup { set timer [after 10000 "set x timed_out"] set l "" } -constraints [list socket supported_$af unixOrWin] -body { set s [socket -server accept 0] proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s } set listen [lindex [fconfigure $s -sockname] 2] set s1 [socket $localhost $listen] vwait x lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x] } -cleanup { after cancel $timer close $s close $s1 } -result [list $localhost 1 3] test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body { # NOTE: This test may fail on some Solaris 2.4 systems. If it does, check # that you have these patches installed (using showrev -p): # # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03, # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01, # 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03, # 102066-04, 102070-01, 102105-01, 102153-03, 102216-01, 102232-01, # 101878-03, 101879-01, 101880-03, 101933-01, 101950-01, 102030-01, # 102057-08, 102140-01, 101920-02, 101921-09, 101922-07, 101923-03 # # If after installing these patches you are still experiencing a problem, # please email jyl@eng.sun.com. We have not observed this failure on # Solaris 2.5, so another option (instead of installing these patches) is # to upgrade to Solaris 2.5. set s [socket -server accept -myaddr $localhost 0] proc accept {s a p} { global x puts $s bye close $s set x done } set s1 [socket -async $localhost [lindex [fconfigure $s -sockname] 2]] vwait x gets $s1 } -cleanup { close $s close $s1 } -result bye test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup { set len 0 set spurious 0 set done 0 set timer [after 10000 "set done timed_out"] } -body { proc readlittle {s} { global spurious done len set l [read $s 1] if {[string length $l] == 0} { if {![eof $s]} { incr spurious } else { close $s set done 1 } } else { incr len [string length $l] } } proc accept {s a p} { fconfigure $s -buffering none -blocking off fileevent $s readable [list readlittle $s] } set s [socket -server accept -myaddr $localhost 0] set c [socket $localhost [lindex [fconfigure $s -sockname] 2]] puts -nonewline $c 01234567890123456789012345678901234567890123456789 close $c vwait done close $s list $spurious $len } -cleanup { after cancel $timer } -result {0 50} test socket_$af-9.2 {testing async write, fileevents, flush on close} -constraints [list socket supported_$af] -setup { set firstblock "" for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"} set secondblock "" for {set i 0} {$i < 16} {incr i} { set secondblock "b$secondblock$secondblock" } set timer [after 10000 "set done timed_out"] set l [socket -server accept -myaddr $localhost 0] proc accept {s a p} { fconfigure $s -blocking 0 -translation lf -buffersize 16384 \ -buffering line fileevent $s readable "readable $s" } proc readable {s} { set l [gets $s] fileevent $s readable {} after idle respond $s } proc respond {s} { global firstblock puts -nonewline $s $firstblock after idle writedata $s } proc writedata {s} { global secondblock puts -nonewline $s $secondblock close $s } } -body { set s [socket $localhost [lindex [fconfigure $l -sockname] 2]] fconfigure $s -blocking 0 -trans lf -buffering line set count 0 puts $s hello proc readit {s} { global count done set l [read $s] incr count [string length $l] if {[eof $s]} { close $s set done 1 } } fileevent $s readable "readit $s" vwait done return $count } -cleanup { close $l after cancel $timer } -result 65566 test socket_$af-9.3 {testing EOF stickyness} -constraints [list socket supported_$af] -setup { set count 0 set done false proc write_then_close {s} { puts $s bye close $s } proc accept {s a p} { fconfigure $s -buffering line -translation lf fileevent $s writable "write_then_close $s" } set s [socket -server accept -myaddr $localhost 0] } -body { proc count_to_eof {s} { global count done set l [gets $s] if {[eof $s]} { incr count if {$count > 9} { close $s set done true set count {eof is sticky} } } } proc timerproc {s} { global done count set done true set count {timer went off, eof is not sticky} close $s } set c [socket $localhost [lindex [fconfigure $s -sockname] 2]] fconfigure $c -blocking off -buffering line -translation lf fileevent $c readable "count_to_eof $c" set timer [after 1000 timerproc $c] vwait done return $count } -cleanup { close $s after cancel $timer } -result {eof is sticky} removeFile script test socket_$af-10.1 {testing socket accept callback error handling} \ -constraints [list socket supported_$af] -setup { variable goterror 0 proc myHandler {msg options} { variable goterror 1 } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { set s [socket -server accept -myaddr $localhost 0] proc accept {s a p} {close $s; error} set c [socket $localhost [lindex [fconfigure $s -sockname] 2]] vwait goterror close $s close $c return $goterror } -cleanup { interp bgerror {} $handler } -result 1 test socket_$af-11.1 {tcp connection} -setup { set port [sendCommand { set server [socket -server accept 0] proc accept {s a p} { puts $s done close $s } getPort $server }] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { set s [socket $remoteServerIP $port] gets $s } -cleanup { close $s sendCommand {close $server} } -result done test socket_$af-11.2 {client specifies its port} -setup { set lport [randport] set rport [sendCommand { set server [socket -server accept 0] proc accept {s a p} { puts $s $p close $s } getPort $server }] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { set s [socket -myport $lport $remoteServerIP $rport] set r [gets $s] expr {$r==$lport ? "ok" : "broken: $r != $port"} } -cleanup { close $s sendCommand {close $server} } -result ok test socket_$af-11.3 {trying to connect, no server} -body { set status ok if {![catch {set s [socket $remoteServerIp [randport]]}]} { if {![catch {gets $s}]} { set status broken } close $s } return $status } -constraints [list socket supported_$af doTestsWithRemoteServer] -result ok test socket_$af-11.4 {remote echo, one line} -setup { set port [sendCommand { set server [socket -server accept 0] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line -translation crlf } proc echo {s} { set l [gets $s] if {[eof $s]} { close $s } else { puts $s $l } } getPort $server }] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { set f [socket $remoteServerIP $port] fconfigure $f -translation crlf -buffering line puts $f hello gets $f } -cleanup { catch {close $f} sendCommand {close $server} } -result hello test socket_$af-11.5 {remote echo, 50 lines} -setup { set port [sendCommand { set server [socket -server accept 0] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line -translation crlf } proc echo {s} { set l [gets $s] if {[eof $s]} { close $s } else { puts $s $l } } getPort $server }] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { set f [socket $remoteServerIP $port] fconfigure $f -translation crlf -buffering line for {set cnt 0} {$cnt < 50} {incr cnt} { puts $f "hello, $cnt" if {[gets $f] != "hello, $cnt"} { break } } return $cnt } -cleanup { close $f sendCommand {close $server} } -result 50 test socket_$af-11.6 {socket conflict} -setup { set s1 [socket -server accept -myaddr $localhost 0] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { set s2 [socket -server accept -myaddr $localhost [getPort $s1]] list [getPort $s2] [close $s2] } -cleanup { close $s1 } -returnCodes error -result {couldn't open socket: address already in use} test socket_$af-11.7 {server with several clients} -setup { set port [sendCommand { set server [socket -server accept 0] proc accept {s a p} { fconfigure $s -buffering line fileevent $s readable [list echo $s] } proc echo {s} { set l [gets $s] if {[eof $s]} { close $s } else { puts $s $l } } getPort $server }] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { set s1 [socket $remoteServerIP $port] fconfigure $s1 -buffering line set s2 [socket $remoteServerIP $port] fconfigure $s2 -buffering line set s3 [socket $remoteServerIP $port] fconfigure $s3 -buffering line for {set i 0} {$i < 100} {incr i} { puts $s1 hello,s1 gets $s1 puts $s2 hello,s2 gets $s2 puts $s3 hello,s3 gets $s3 } return $i } -cleanup { close $s1 close $s2 close $s3 sendCommand {close $server} } -result 100 test socket_$af-11.8 {client with several servers} -setup { lassign [sendCommand { set s1 [socket -server "accept server1" 0] set s2 [socket -server "accept server2" 0] set s3 [socket -server "accept server3" 0] proc accept {mp s a p} { puts $s $mp close $s } list [getPort $s1] [getPort $s2] [getPort $s3] }] p1 p2 p3 } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { set s1 [socket $remoteServerIP $p1] set s2 [socket $remoteServerIP $p2] set s3 [socket $remoteServerIP $p3] list [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \ [gets $s3] [gets $s3] [eof $s3] } -cleanup { close $s1 close $s2 close $s3 sendCommand { close $s1 close $s2 close $s3 } } -result {server1 {} 1 server2 {} 1 server3 {} 1} test socket_$af-11.9 {accept callback error} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup { proc myHandler {msg options} { variable x $msg } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] set timer [after 10000 "set x timed_out"] } -body { set s [socket -server accept 0] proc accept {s a p} {expr {10 / 0}} sendCommand "set port [getPort $s]" if {[catch { sendCommand { set peername [fconfigure $callerSocket -peername] set s [socket [lindex $peername 0] $port] close $s } } msg]} then { close $s error $msg } vwait x return $x } -cleanup { close $s after cancel $timer interp bgerror {} $handler } -result {divide by zero} test socket_$af-11.10 {testing socket specific options} -setup { set port [sendCommand { set server [socket -server accept 0] proc accept {s a p} {close $s} getPort $server }] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { set s [socket $remoteServerIP $port] set p [fconfigure $s -peername] set n [fconfigure $s -sockname] list [expr {[lindex $p 2] == $port}] [llength $p] [llength $n] } -cleanup { close $s sendCommand {close $server} } -result {1 3 3} test socket_$af-11.11 {testing spurious events} -setup { set port [sendCommand { set server [socket -server accept 0] proc accept {s a p} { fconfigure $s -translation "auto lf" after idle writesome $s } proc writesome {s} { for {set i 0} {$i < 100} {incr i} { puts $s "line $i from remote server" } close $s } getPort $server }] set len 0 set spurious 0 set done 0 set timer [after 40000 "set done timed_out"] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { proc readlittle {s} { global spurious done len set l [read $s 1] if {[string length $l] == 0} { if {![eof $s]} { incr spurious } else { close $s set done 1 } } else { incr len [string length $l] } } set c [socket $remoteServerIP $port] fileevent $c readable "readlittle $c" vwait done list $spurious $len $done } -cleanup { after cancel $timer sendCommand {close $server} } -result {0 2690 1} test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup { set counter 0 set done 0 set port [sendCommand { set server [socket -server accept 0] proc accept {s a p} { after idle close $s } getPort $server }] proc timed_out {} { global c done set done {timed_out, EOF is not sticky} close $c } set after_id [after 1000 timed_out] } -body { proc count_up {s} { global counter done set l [gets $s] if {[eof $s]} { incr counter if {$counter > 9} { set done {EOF is sticky} close $s } } } set c [socket $remoteServerIP $port] fileevent $c readable [list count_up $c] vwait done return $done } -cleanup { after cancel $after_id sendCommand {close $server} } -result {EOF is sticky} test socket_$af-11.13 {testing async write, async flush, async close} -setup { set port [sendCommand { set firstblock "" for {set i 0} {$i < 5} {incr i} { set firstblock "a$firstblock$firstblock" } set secondblock "" for {set i 0} {$i < 16} {incr i} { set secondblock "b$secondblock$secondblock" } set l [socket -server accept 0] proc accept {s a p} { fconfigure $s -blocking 0 -translation lf -buffersize 16384 \ -buffering line fileevent $s readable "readable $s" } proc readable {s} { set l [gets $s] fileevent $s readable {} after idle respond $s } proc respond {s} { global firstblock puts -nonewline $s $firstblock after idle writedata $s } proc writedata {s} { global secondblock puts -nonewline $s $secondblock close $s } getPort $l }] set timer [after 10000 "set done timed_out"] } -constraints [list socket supported_$af doTestsWithRemoteServer] -body { proc readit {s} { global count done set l [read $s] incr count [string length $l] if {[eof $s]} { close $s set done 1 } } set s [socket $remoteServerIP $port] fconfigure $s -blocking 0 -trans lf -buffering line set count 0 puts $s hello fileevent $s readable "readit $s" vwait done return $count } -cleanup { after cancel $timer sendCommand {close $l} } -result 65566 set path(script1) [makeFile {} script1] set path(script2) [makeFile {} script2] test socket_$af-12.1 {testing inheritance of server sockets} -setup { file delete $path(script1) file delete $path(script2) # Script1 is just a 10 second delay. If the server socket is inherited, it # will be held open for 10 seconds set f [open $path(script1) w] puts $f { fileevent stdin readable exit after 10000 exit vwait forever } close $f # Script2 creates the server socket, launches script1, and exits. # The server socket will now be closed unless script1 inherited it. set f [open $path(script2) w] puts $f [list set tcltest [interpreter]] puts $f [list set delay $path(script1)] puts $f [list set localhost $localhost] puts $f { set f [socket -server accept -myaddr $localhost 0] proc accept { file addr port } { close $file } exec $tcltest $delay & puts [lindex [fconfigure $f -sockname] 2] close $f exit } close $f } -constraints [list socket supported_$af stdio exec] -body { # Launch script2 and wait 5 seconds ### exec [interpreter] script2 & set p [open "|[list [interpreter] $path(script2)]" r] # If we can still connect to the server, the socket got inherited. if {[catch {close [socket $localhost $listen]}]} { return {server socket was not inherited} } else { return {server socket was inherited} } } -cleanup { catch {close $p} } -result {server socket was not inherited} test socket_$af-12.2 {testing inheritance of client sockets} -setup { file delete $path(script1) file delete $path(script2) # Script1 is just a 20 second delay. If the server socket is inherited, it # will be held open for 20 seconds set f [open $path(script1) w] puts $f { fileevent stdin readable exit after 20000 exit vwait forever } close $f # Script2 opens the client socket and writes to it. It then launches # script1 and exits. If the child process inherited the client socket, the # socket will still be open. set f [open $path(script2) w] puts $f [list set tcltest [interpreter]] puts $f [list set delay $path(script1)] puts $f [list set localhost $localhost] puts $f { gets stdin port set f [socket $localhost $port] exec $tcltest $delay & puts $f testing flush $f exit } close $f # If the socket doesn't hit end-of-file in 10 seconds, the script1 process # must have inherited the client. set timeout 0 set after [after 10000 {set x "client socket was inherited"}] } -constraints [list socket supported_$af stdio exec] -body { # Create the server socket set server [socket -server accept -myaddr $localhost 0] proc accept { file host port } { # When the client connects, establish the read handler global server close $server fileevent $file readable [list getdata $file] fconfigure $file -buffering line -blocking 0 set ::f $file } proc getdata { file } { # Read handler on the accepted socket. global x set status [catch {read $file} data] if {$status != 0} { set x "read failed, error was $data" } elseif {$data ne ""} { } elseif {[fblocked $file]} { } elseif {[eof $file]} { set x "client socket was not inherited" } else { set x "impossible case" } } # Launch the script2 process ### exec [interpreter] script2 & set p [open "|[list [interpreter] $path(script2)]" w] puts $p [lindex [fconfigure $server -sockname] 2] ; flush $p vwait x return $x } -cleanup { fconfigure $f -blocking 1 close $f after cancel $after close $p } -result {client socket was not inherited} test socket_$af-12.3 {testing inheritance of accepted sockets} -setup { file delete $path(script1) file delete $path(script2) set f [open $path(script1) w] puts $f { fileevent stdin readable exit after 10000 exit vwait forever } close $f set f [open $path(script2) w] puts $f [list set tcltest [interpreter]] puts $f [list set delay $path(script1)] puts $f [list set localhost $localhost] puts $f { set server [socket -server accept -myaddr $localhost 0] proc accept { file host port } { global tcltest delay puts $file {test data on socket} exec $tcltest $delay & after idle exit } puts stdout [lindex [fconfigure $server -sockname] 2] vwait forever } close $f } -constraints [list socket supported_$af stdio exec] -body { # Launch the script2 process and connect to it. See how long the socket # stays open ## exec [interpreter] script2 & set p [open "|[list [interpreter] $path(script2)]" r] gets $p listen set f [socket $localhost $listen] fconfigure $f -buffering full -blocking 0 fileevent $f readable [list getdata $f] # If the socket is still open after 5 seconds, the script1 process must # have inherited the accepted socket. set failed 0 set after [after 5000 [list set x "accepted socket was inherited"]] proc getdata { file } { # Read handler on the client socket. global x global failed set status [catch {read $file} data] if {$status != 0} { set x "read failed, error was $data" } elseif {[string compare {} $data]} { } elseif {[fblocked $file]} { } elseif {[eof $file]} { set x "accepted socket was not inherited" } else { set x "impossible case" } return } vwait x set x } -cleanup { fconfigure $f -blocking 1 close $f after cancel $after close $p } -result {accepted socket was not inherited} test socket_$af-13.1 {Testing use of shared socket between two threads} -body { # create a thread set serverthread [thread::create -preserved [string map [list @localhost@ $localhost] { set f [socket -server accept -myaddr @localhost@ 0] set listen [lindex [fconfigure $f -sockname] 2] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line } proc echo {s} { global i set l [gets $s] if {[eof $s]} { global x close $s set x done } else { incr i puts $s $l } } set i 0 vwait x close $f }]] set port [thread::send $serverthread {set listen}] set s [socket $localhost $port] fconfigure $s -buffering line catch { puts $s "hello" gets $s result } close $s thread::release $serverthread append result " " [llength [thread::names]] } -result {hello 1} -constraints [list socket supported_$af thread] proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} { try { set ::count 0 set ::testmode $testmode set port 0 set srvsock {} # if binding on port 0 is not possible (system related, blocked on ISPs etc): if {[catch {close [socket -async $::localhost $port]}]} { # simplest server on random port (immediately closing a connect): set port [randport] set srvsock [socket -server {apply {{ch args} {close $ch}}} -myaddr $::localhost $port] # socket on windows has some issues yet (e. g. bug [b6d0d8cc2c]), so we simply decrease iteration count (to 1/4): if {$::tcl_platform(platform) eq "windows" && $maxIter > 50} { set ::count [expr {$maxIter / 4 * 3 - 1}]; # bypass 3/4 iterations } } tcltest::DebugPuts 2 "== test \[$::localhost\]:$port $testmode ==" set ::parent [thread::id] # helper thread creating async connection and initiating transfer (detach) to parent: set ::helper [thread::create] thread::send -async $::helper [list \ lassign [list $::parent $::localhost $port $testmode] \ ::parent ::localhost ::port ::testmode ] thread::send -async $::helper { set ::helper [thread::id] proc iteration {args} { set fd [socket -async $::localhost $::port] if {"helper-writable" in $::testmode} {;# to test both sides during connect fileevent $fd writable [list apply {{fd} { if {[thread::id] ne $::helper} { thread::send -async $::parent {set ::count "ERROR: invalid thread, $::helper is expecting"} close $fd return } }} $fd] };# thread::detach $fd thread::send -async $::parent [list transf_parent $fd {*}$args] } iteration first } # parent proc committing transfer attempt (attach) and checking acquire was successful: proc transf_parent {fd args} { tcltest::DebugPuts 2 "** trma / $::count ** $args **" thread::attach $fd if {"parent-close" in $::testmode} {;# to test close during connect set ::count $::count close $fd return };# fileevent $fd writable [list apply {{fd} { if {[thread::id] ne $::parent} { thread::send -async $::parent {set ::count "ERROR: invalid thread, $::parent is expecting"} close $fd return } set ::count $::count close $fd }} $fd] } # repeat maxIter times (up to maxTime ms as timeout): set tout [after $maxTime {set ::count "TIMEOUT"}] while 1 { vwait ::count if {![string is integer $::count]} { # if timeout just skip (test was successful until now): if {$::count eq "TIMEOUT"} {::tcltest::Skip "timing issue"} break } if {[incr ::count] >= $maxIter} break tcltest::DebugPuts 2 "** iter / $::count **" thread::send -async $::helper [list iteration nr $::count] } update set ::count } finally { catch {after cancel $tout} if {$srvsock ne {}} {close $srvsock} if {[info exists ::helper]} {thread::release -wait $::helper} tcltest::DebugPuts 2 "== stop / $::count ==" unset -nocomplain ::count ::testmode ::parent ::helper } } test socket_$af-13.2.tr1 {Testing socket transfer between threads during async connect} -body { transf_test {transfer} 1000 } -result 1000 -constraints [list socket supported_$af thread] test socket_$af-13.2.tr2 {Testing socket transfer between threads during async connect} -body { transf_test {transfer helper-writable} 100 } -result 100 -constraints [list socket supported_$af thread] test socket_$af-13.2.cl1 {Testing socket transfer between threads during async connect} -body { transf_test {parent-close} 100 } -result 100 -constraints [list socket supported_$af thread] test socket_$af-13.2.cl2 {Testing socket transfer between threads during async connect} -body { transf_test {parent-close helper-writable} 100 } -result 100 -constraints [list socket supported_$af thread] catch {rename transf_parent {}} rename transf_test {} # ---------------------------------------------------------------------- removeFile script1 removeFile script2 # cleanup if {$remoteProcChan ne ""} { catch {sendCommand exit} } catch {close $commandSocket} catch {close $remoteProcChan} } unset ::tcl::unsupported::socketAF test socket-14.0.0 {[socket -async] when server only listens on IPv4} -setup { proc accept {s a p} { global x puts $s bye close $s set x ok } set server [socket -server accept -myaddr 127.0.0.1 0] set port [lindex [fconfigure $server -sockname] 2] } -constraints {socket supported_inet localhost_v4} -body { set client [socket -async localhost $port] set after [after $latency {set x [fconfigure $client -error]}] vwait x set x } -cleanup { catch {after cancel $after} catch {close $server} catch {close $client} unset -nocomplain x } -result ok test socket-14.0.1 {[socket -async] when server only listens on IPv6} -setup { proc accept {s a p} { global x puts $s bye close $s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure $server -sockname] 2] } -constraints {socket supported_inet6 localhost_v6} -body { set client [socket -async localhost $port] set after [after $latency {set x [fconfigure $client -error]}] vwait x set x } -cleanup { catch {after cancel $after} catch {close $server} catch {close $client} unset -nocomplain x } -result ok test socket-14.1 {[socket -async] fileevent while still connecting} -setup { proc accept {s a p} { global x puts $s bye close $s lappend x ok } set server [socket -server accept -myaddr localhost 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } -constraints socket -body { set client [socket -async localhost $port] fileevent $client writable { lappend x [fconfigure $client -error] fileevent $client writable {} } set after [after $latency {lappend x timeout}] while {[llength $x] < 2 && "timeout" ni $x} { vwait x } lsort $x; # we only want to see both events, the order doesn't matter } -cleanup { catch {after cancel $after} catch {close $server} catch {close $client} unset -nocomplain x } -result {{} ok} test socket-14.2 {[socket -async] fileevent connection refused} -setup { set after [after $latency set x timeout] } -body { set client [socket -async localhost [randport]] fileevent $client writable {set x ok} vwait x lappend x [fconfigure $client -error] } -constraints socket -cleanup { catch {after cancel $after} catch {close $client} unset -nocomplain x after client } -result {ok {connection refused}} test socket-14.3 {[socket -async] when server only listens on IPv6} -setup { proc accept {s a p} { global x puts $s bye close $s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure $server -sockname] 2] } -constraints {socket supported_inet6 localhost_v6} -body { set client [socket -async localhost $port] set after [after $latency {set x [fconfigure $client -error]}] vwait x set x } -cleanup { catch {after cancel $after} catch {close $server} catch {close $client} unset -nocomplain x } -result ok test socket-14.4 {[socket -async] and both, readdable and writable fileevents} -setup { proc accept {s a p} { puts $s bye close $s } set server [socket -server accept -myaddr localhost 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } -constraints socket -body { set client [socket -async localhost $port] fileevent $client writable { lappend x [fconfigure $client -error] fileevent $client writable {} } fileevent $client readable {lappend x [gets $client]} set after [after $latency {lappend x timeout}] while {[llength $x] < 2 && "timeout" ni $x} { vwait x } lsort $x } -cleanup { catch {after cancel $after} catch {close $client} catch {close $server} unset -nocomplain x } -result {{} bye} # FIXME: we should also have an IPv6 counterpart of this test socket-14.5 {[socket -async] which fails before any connect() can be made} -body { # address from rfc5737 socket -async -myaddr 192.0.2.42 127.0.0.1 [randport] } -constraints {socket supported_inet notOSX} -returnCodes 1 \ -result {couldn't open socket: cannot assign requested address} test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} -setup { proc accept {s a p} { global x puts $s bye close $s set x ok } set server [socket -server accept -myaddr 127.0.0.1 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } -constraints {socket supported_inet localhost_v4} -body { set client [socket -async localhost $port] for {set i 0} {$i < 50} {incr i } { update if {$x ne ""} { lappend x [gets $client] break } after 100 } set x } -cleanup { catch {close $server} catch {close $client} unset -nocomplain x } -result {ok bye} test socket-14.6.1 {[socket -async] with no event loop and server listening on IPv6} -setup { proc accept {s a p} { global x puts $s bye close $s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } -constraints {socket supported_inet6 localhost_v6} -body { set client [socket -async localhost $port] for {set i 0} {$i < 50} {incr i } { update if {$x ne ""} { lappend x [gets $client] break } after 100 } set x } -cleanup { catch {close $server} catch {close $client} unset -nocomplain x } -result {ok bye} test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {puts $s ok; close $s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -constraints {socket supported_inet localhost_v4 notOSX} -body { set sock [socket -async localhost $port] list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error] } -cleanup { catch {close $fd} catch {close $sock} removeFile script } -result {{} ok {}} test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {puts $s ok; close $s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -constraints {socket supported_inet6 localhost_v6 notOSX} -body { set sock [socket -async localhost $port] list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error] } -cleanup { catch {close $fd} catch {close $sock} removeFile script } -result {{} ok {}} test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} -setup { set sock [socket -server error 0] set unusedPort [lindex [fconfigure $sock -sockname] 2] close $sock } -body { set sock [socket -async localhost $unusedPort] catch {gets $sock} x list $x [fconfigure $sock -error] [fconfigure $sock -error] } -constraints {socket notOSX} -cleanup { catch {close $sock} } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {puts $s ok; close $s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -constraints {socket supported_inet localhost_v4} -body { set sock [socket -async localhost $port] fconfigure $sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break after 200 } set x } -cleanup { catch {close $fd} catch {close $sock} removeFile script } -result {ok} test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {puts $s ok; close $s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -constraints {socket supported_inet6 localhost_v6} -body { set sock [socket -async localhost $port] fconfigure $sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break after 200 } set x } -cleanup { catch {close $fd} catch {close $sock} removeFile script } -result {ok} test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break after 200 } list $x [fconfigure $sock -error] [fconfigure $sock -error] } -constraints socket -cleanup { catch {close $sock} } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} -setup { makeFile { fileevent stdin readable exit after 10000 exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x puts [gets $x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -constraints {socket supported_inet localhost_v4 notOSX} -body { set sock [socket -async localhost $port] puts $sock ok flush $sock list [fconfigure $sock -error] [gets $fd] } -cleanup { catch {close $fd} catch {close $sock} removeFile script } -result {{} ok} test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} -setup { makeFile { fileevent stdin readable exit after 10000 exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x puts [gets $x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -constraints {socket supported_inet6 localhost_v6 notOSX} -body { set sock [socket -async localhost $port] puts $sock ok flush $sock list [fconfigure $sock -error] [gets $fd] } -cleanup { catch {close $fd} catch {close $sock} removeFile script } -result {{} ok} test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is IPv4} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x puts [gets $x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] set after [after $latency set x timeout] } -constraints {socket supported_inet localhost_v4} -body { set sock [socket -async localhost $port] fconfigure $sock -blocking 0 puts $sock ok flush $sock fileevent $fd readable {set x 1} vwait x list [fconfigure $sock -error] [gets $fd] } -cleanup { after cancel $after catch {close $fd} catch {close $sock} removeFile script } -result {{} ok} test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is IPv6} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x puts [gets $x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] set after [after $latency set x timeout] } -constraints {socket supported_inet6 localhost_v6} -body { set sock [socket -async localhost $port] fconfigure $sock -blocking 0 puts $sock ok flush $sock fileevent $fd readable {set x 1} vwait x list [fconfigure $sock -error] [gets $fd] } -cleanup { after cancel $after catch {close $fd} catch {close $sock} removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} -setup { set after [after $latency set x timeout] } -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 puts $sock ok fileevent $sock writable {set x 1} vwait x close $sock } -constraints socket -cleanup { after cancel $after catch {close $sock} unset -nocomplain x } -result {socket is not connected} -returnCodes 1 test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} -setup { set after [after $latency set x timeout] } -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 puts $sock ok flush $sock fileevent $sock writable {set x 1} vwait x close $sock } -constraints {socket nonPortable} -cleanup { after cancel $timeout catch {close $sock} unset -nocomplain x } -result {socket is not connected} -returnCodes 1 test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} -body { set s [socket -async localhost [randport]] for {set i 0} {$i < 50} {incr i} { set x [fconfigure $s -error] if {$x != ""} break after 200 } set x } -constraints socket -cleanup { catch {close $s} unset -nocomplain x s } -result {connection refused} test socket-14.13 {testing writable event when quick failure} -body { # Test for bug 336441ed59 where a quick background fail was ignored # # Test only for windows as socket -async 255.255.255.255 fails # directly on Unix # # The following connect should fail very quickly set a1 [after $latency {set x timeout}] set s [socket -async 255.255.255.255 43434] fileevent $s writable {set x writable} vwait x set x } -constraints {socket win supported_inet} -cleanup { catch {close $s} after cancel $a1 } -result writable test socket-14.14 {testing fileevent readable on failed async socket connect} -body { # Test for bug 581937ab1e set a1 [after $latency {set x timeout}] # This connect should fail set s [socket -async localhost [randport]] fileevent $s readable {set x readable} vwait x set x } -constraints socket -cleanup { catch {close $s} after cancel $a1 } -result readable test socket-14.15 {blocking read on async socket should not trigger event handlers} -setup { set subprocess [open "|[list [interpreter]]" r+] fconfigure $subprocess -blocking 0 -buffering none } -constraints socket -body { puts $subprocess { set s [socket -async localhost [randport]] set x ok fileevent $s writable {set x fail} catch {read $s} close $s puts $x exit } set after [after $latency set x timeout] fileevent $subprocess readable [list gets $subprocess x] vwait x return $x } -cleanup { catch {after cancel $after} if {![testConstraint win]} { catch {exec kill [pid $subprocess]} } catch {close $subprocess} unset -nocomplain x } -result ok # v4 and v6 is required to prevent that the async connect does not terminate # before the fconfigure command. There is always an additional ip to try. test socket-14.16 {empty -peername while [socket -async] connecting} -body { set client [socket -async localhost [randport]] fconfigure $client -peername } -constraints {socket localhost_v4 localhost_v6 notOSX} -cleanup { catch {close $client} } -result {} # v4 and v6 is required to prevent that the async connect does not terminate # before the fconfigure command. There is always an additional ip to try. test socket-14.17 {empty -sockname while [socket -async] connecting} -body { set client [socket -async localhost [randport]] fconfigure $client -sockname } -constraints {socket localhost_v4 localhost_v6 notOSX} -cleanup { catch {close $client} } -result {} # test for bug c6ed4acfd8: running async socket connect with other connect # established will block tcl as it goes in an infinite loop in vwait test socket-14.18 {bug c6ed4acfd8: running async socket connect made other connect block} -body { proc accept {channel address port} {} set port [randport] set ssock [socket -server accept $port] set csock1 [socket -async localhost [randport]] set csock2 [socket localhost $port] after 1000 {set done ok} vwait done } -constraints {socket notOSX} -cleanup { catch {close $ssock} catch {close $csock1} catch {close $csock2} } -result {} set num 0 set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}} set resultok {-result "sock*" -match glob} set resulterr { -result {couldn't open socket: connection refused} -returnCodes 1 } foreach {servip sc} $x { foreach {cliip cc} $x { set constraints [list socket $sc $cc] set result $resulterr switch -- [lsort -unique [list $servip $cliip]] { localhost - 127.0.0.1 - ::1 { set result $resultok } {127.0.0.1 localhost} { if {[testConstraint localhost_v4]} { set result $resultok } } {::1 localhost} { if {[testConstraint localhost_v6]} { set result $resultok } } } test socket-15.1.$num "Connect to $servip from $cliip" -setup { set server [socket -server accept -myaddr $servip 0] proc accept {s h p} { close $s } set port [lindex [fconfigure $server -sockname] 2] } -constraints $constraints -body { set s [socket $cliip $port] } -cleanup { close $server catch {close $s} } {*}$result incr num } } ::tcltest::cleanupTests flush stdout return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/source.test0000644000175000017500000002165414554262142015215 0ustar sergeisergei# Commands covered: source # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # Contributions from Don Porter, NIST, 2003. (not subject to US copyright) # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." return } namespace eval ::tcl::test::source { namespace import ::tcltest::* test source-1.1 {source command} -setup { set x "old x value" set y "old y value" set z "old z value" set sourcefile [makeFile { set x 22 set y 33 set z 44 } source.file] } -body { source $sourcefile list $x $y $z } -cleanup { removeFile source.file } -result {22 33 44} test source-1.2 {source command} -setup { set sourcefile [makeFile {list result} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -result result test source-1.3 {source command} -setup { set sourcefile [makeFile {} source.file] set fd [open $sourcefile w] fconfigure $fd -translation lf puts $fd "list a b c \\" puts $fd "d e f" close $fd } -body { source $sourcefile } -cleanup { removeFile source.file } -result {a b c d e f} proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 } foreach e $expected a $actual { if {![string match $e $a]} { return 0 } } return 1 } customMatch listGlob [namespace which ListGlobMatch] test source-2.3 {source error conditions} -setup { set sourcefile [makeFile { set x 146 error "error in sourced file" set y $x } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo } -cleanup { removeFile source.file } -match listGlob -result [list 1 {error in sourced file} \ {error in sourced file while executing "error "error in sourced file"" (file "*source.file" line 3) invoked from within "source $sourcefile"}] test source-2.4 {source error conditions} -setup { set sourcefile [makeFile {break} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes break test source-2.5 {source error conditions} -setup { set sourcefile [makeFile {continue} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes continue test source-2.6 {source error conditions} -setup { set sourcefile [makeFile {} _non_existent_] removeFile _non_existent_ } -body { list [catch {source $sourcefile} msg] $msg $::errorCode } -match listGlob -result [list 1 \ {couldn't read file "*_non_existent_": no such file or directory} \ {POSIX ENOENT {no such file or directory}}] test source-2.7 {utf-8 with BOM} -setup { set sourcefile [makeFile {} source.file] } -body { set out [open $sourcefile w] fconfigure $out -encoding utf-8 puts $out "\ufeffset y new-y" close $out set y old-y source -encoding utf-8 $sourcefile return $y } -cleanup { removeFile $sourcefile } -result {new-y} test source-3.1 {return in middle of source file} -setup { set sourcefile [makeFile { set x new-x return allDone set y new-y } source.file] } -body { set x old-x set y old-y set z [source $sourcefile] list $x $y $z } -cleanup { removeFile source.file } -result {new-x old-y allDone} test source-3.2 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code break "Silly result" set y new-y } source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes break -result {Silly result} test source-3.3 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error "Simulated error" set y new-y } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {Simulated error} {Simulated error while executing "source $sourcefile"} NONE} test source-3.4 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error -errorinfo "Simulated errorInfo stuff" set y new-y } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {} {Simulated errorInfo stuff invoked from within "source $sourcefile"} NONE} test source-3.5 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error -errorinfo "Simulated errorInfo stuff" \ -errorcode {a b c} set y new-y } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {} {Simulated errorInfo stuff invoked from within "source $sourcefile"} {a b c}} test source-4.1 {continuation line parsing} -setup { set sourcefile [makeFile [string map {CL \\\n} { format %s "[dict get [info frame 0] type]:CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]" }] source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -result {source: 3 4 5} test source-6.1 {source is binary ok} -setup { # Note [makeFile] writes in the system encoding. # [source] defaults to reading in the system encoding. set sourcefile [makeFile [list set x "a b\0c"] source.file] } -body { set x {} source $sourcefile string length $x } -cleanup { removeFile source.file } -result 5 test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup { set sourcefile [makeFile "set x ab\32c" source.file] } -body { set x {} source $sourcefile string length $x } -cleanup { removeFile source.file } -result 2 test source-7.1 {source -encoding test} -setup { set sourcefile [makeFile {} source.file] file delete $sourcefile set f [open $sourcefile w] fconfigure $f -encoding utf-8 puts $f "set symbol(square-root) \u221A; set x correct" close $f } -body { set x unset source -encoding utf-8 $sourcefile set x } -cleanup { removeFile source.file } -result correct test source-7.2 {source -encoding test} -setup { # This tests for bad interactions between [source -encoding] # and use of the Control-Z character (\u001A) as a cross-platform # EOF character by [source]. Here we write out and the [source] a # file that contains the byte \x1A, although not the character \u001A in # the indicated encoding. set sourcefile [makeFile {} source.file] file delete $sourcefile set f [open $sourcefile w] fconfigure $f -encoding unicode puts $f "set symbol(square-root) \u221A; set x correct" close $f } -body { set x unset source -encoding unicode $sourcefile set x } -cleanup { removeFile source.file } -result correct test source-7.3 {source -encoding: syntax} -body { # Have to spell out the -encoding option source -e utf-8 no_file } -returnCodes 1 -match glob -result {bad option*} test source-7.4 {source -encoding: syntax} -setup { set sourcefile [makeFile {} source.file] } -body { source -encoding no-such-encoding $sourcefile } -cleanup { removeFile source.file } -returnCodes 1 -match glob -result {unknown encoding*} test source-7.5 {source -encoding: correct operation} -setup { set sourcefile [makeFile {} source.file] file delete $sourcefile set f [open $sourcefile w] fconfigure $f -encoding utf-8 puts $f "proc \u20ac {} {return foo}" close $f } -body { source -encoding utf-8 $sourcefile \u20ac } -cleanup { removeFile source.file rename \u20ac {} } -result foo test source-7.6 {source -encoding: mismatch encoding error} -setup { set sourcefile [makeFile {} source.file] file delete $sourcefile set f [open $sourcefile w] fconfigure $f -encoding utf-8 puts $f "proc \u20ac {} {return foo}" close $f } -body { source -encoding iso8859-1 $sourcefile \u20ac } -cleanup { removeFile source.file } -returnCodes error -result "invalid command name \"\u20ac\"" test source-8.1 {source and coroutine/yield} -setup { set sourcefile [makeFile {} source.file] file delete $sourcefile } -body { makeFile {yield 1; yield 2; return 3;} $sourcefile coroutine coro apply {f {yield;source $f}} $sourcefile list [coro] [coro] [coro] [info exist coro] } -cleanup { catch {rename coro {}} removeFile source.file } -result {1 2 3 0} cleanupTests } namespace delete ::tcl::test::source return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/split.test0000644000175000017500000000500214554262142015035 0ustar sergeisergei# Commands covered: split # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test split-1.1 {basic split commands} { split "a\n b\t\r c\n " } {a {} b {} {} c {} {}} test split-1.2 {basic split commands} { split "word 1xyzword 2zword 3" xyz } {{word 1} {} {} {word 2} {word 3}} test split-1.3 {basic split commands} { split "12345" {} } {1 2 3 4 5} test split-1.4 {basic split commands} { split "a\}b\[c\{\]\$" } "a\\}b\\\[c\\{\\\]\\\$" test split-1.5 {basic split commands} { split {} {} } {} test split-1.6 {basic split commands} { split {} } {} test split-1.7 {basic split commands} { split { } } {{} {} {} {}} test split-1.8 {basic split commands} { proc foo {} { set x {} foreach f [split {]\n} {}] { append x $f } return $x } foo } {]\n} test split-1.9 {basic split commands} { proc foo {} { set x ab\000c set y [split $x {}] return $y } foo } "a b \000 c" test split-1.10 {basic split commands} { split "a0ab1b2bbb3\000c4" ab\000c } {{} 0 {} 1 2 {} {} 3 {} 4} test split-1.11 {basic split commands} { split "12,3,45" {,} } {12 3 45} test split-1.12 {basic split commands} { split "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1 } {{} ab cd {} ef {}} test split-1.13 {basic split commands} { split "12,34,56," {,} } {12 34 56 {}} test split-1.14 {basic split commands} { split ",12,,,34,56," {,} } {{} 12 {} {} 34 56 {}} test split-1.15 {basic split commands} -body { split "a\U01f4a9b" {} } -result "a \U01f4a9 b" test split-2.1 {split errors} { list [catch split msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}} test split-2.2 {split errors} { list [catch {split a b c} msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}} # cleanup catch {rename foo {}} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/stack.test0000644000175000017500000000350314554262142015013 0ustar sergeisergei# Tests that the stack size is big enough for the application. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Note that a failure in this test may result in a crash of the executable. test stack-1.1 {maxNestingDepth reached on infinite recursion} -body { # do this in a sub process in case it segfaults exec [interpreter] << { proc recurse {} { recurse } catch { recurse } rv puts $rv } } -result {too many nested evaluations (infinite loop?)} test stack-2.1 {maxNestingDepth reached on infinite recursion} -body { # do this in a sub process in case it segfaults exec [interpreter] << { interp alias {} unknown {} notaknownproc catch { unknown } msg puts $msg } } -result {too many nested evaluations (infinite loop?)} # Make sure that there is enough stack to run regexp even if we're # close to the recursion limit. [Bug 947070] [Patch 746378] test stack-3.1 {enough room for regexp near recursion limit} -body { # do this in a sub process in case it segfaults exec [interpreter] << { interp recursionlimit {} 10000 set depth 0 proc a { max } { if { [info level] < $max } { set ::depth [info level] a $max } else { regexp {^ ?} x } } catch { a 10001 } set depth2 $depth puts [list [a $depth] [expr { $depth2 - $depth }]] } } -result {1 1} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/stringComp.test0000644000175000017500000005525714554262142016050 0ustar sergeisergei# Commands covered: string # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # This differs from the original string tests in that the tests call # things in procs, which uses the compiled string code instead of # the runtime parse string code. The tests of import should match # their equivalent number in string.test. # # Copyright (c) 2001 by ActiveState Corporation. # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { set lines [split [memory info] \n] return [lindex $lines 3 3] } proc leaktest {script {iterations 3}} { set end [getbytes] for {set i 0} {$i < $iterations} {incr i} { uplevel 1 $script set tmp $end set end [getbytes] } return [expr {$end - $tmp}] } } test stringComp-1.1 {error conditions} { proc foo {} {string gorp a b} list [catch {foo} msg] $msg } {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test stringComp-1.2 {error conditions} { proc foo {} {string} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string subcommand ?arg ...?"}} test stringComp-1.3 {error condition - undefined method during compile} { # We don't want this to complain about 'never' because it may never # be called, or string may get redefined. This must compile OK. proc foo {str i} { if {"yes" == "no"} { string never called but complains here } string index $str $i } foo abc 0 } a ## Test string compare|equal over equal constraints ## Use result for string compare, and negate it for string equal ## The body will be tested both in and outside a proc set i 0 foreach {tname tbody tresult tcode} { {too few args} { string compare a } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error} {bad args} { string compare a b c } {bad option "a": must be -nocase or -length} {error} {bad args} { string compare -length -nocase str1 str2 } {expected integer but got "-nocase"} {error} {too many args} { string compare -length 10 -nocase str1 str2 str3 } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error} {compare with length unspecified} { string compare -length 10 10 } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error} {basic operation fail} { string compare abcde abdef } {-1} {} {basic operation success} { string compare abcde abcde } {0} {} {with length} { string compare -length 2 abcde abxyz } {0} {} {with special index} { string compare -length end-3 abcde abxyz } {expected integer but got "end-3"} {error} {unicode} { string compare ab\u7266 ab\u7267 } {-1} {} {unicode} {string compare \334 \u00dc} 0 {} {unicode} {string compare \334 \u00fc} -1 {} {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {} {high bit} { # This test fails if the underlying comparison # is using signed chars instead of unsigned chars. # (like SunOS's default memcmp thus the compat/memcmp.c) string compare "\x80" "@" # Nb this tests works also in utf-8 space because \x80 is # translated into a 2 or more bytelength but whose first byte has # the high bit set. } {1} {} {-nocase 1} {string compare -nocase abcde abdef} {-1} {} {-nocase 2} {string compare -nocase abcde Abdef} {-1} {} {-nocase 3} {string compare -nocase abcde ABCDE} {0} {} {-nocase 4} {string compare -nocase abcde abcde} {0} {} {-nocase unicode} { string compare -nocase \334 \u00dc } 0 {} {-nocase unicode} { string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334 } 0 {} {-nocase with length} { string compare -length 2 -nocase abcde Abxyz } {0} {} {-nocase with length} { string compare -nocase -length 3 abcde Abxyz } {-1} {} {-nocase with length <= 0} { string compare -nocase -length -1 abcde AbCdEf } {-1} {} {-nocase with excessive length} { string compare -nocase -length 50 AbCdEf abcde } {1} {} {-len unicode} { # These are strings that are 6 BYTELENGTH long, but the length # shouldn't make a different because there are actually 3 CHARS long string compare -len 5 \334\334\334 \334\334\374 } -1 {} {-nocase with special index} { string compare -nocase -length end-3 Abcde abxyz } {expected integer but got "end-3"} error {null strings} { string compare "" "" } 0 {} {null strings} { string compare "" foo } -1 {} {null strings} { string compare foo "" } 1 {} {-nocase null strings} { string compare -nocase "" "" } 0 {} {-nocase null strings} { string compare -nocase "" foo } -1 {} {-nocase null strings} { string compare -nocase foo "" } 1 {} {with length, unequal strings, partial first string} { string compare -length 2 abc abde } 0 {} {with length, unequal strings 2, full first string} { string compare -length 2 ab abde } 0 {} {with NUL character vs. other ASCII} { # Be careful here, since UTF-8 rep comparison with memcmp() of # these puts chars in the wrong order string compare \x00 \x01 } -1 {} {high bit} { string compare "a\x80" "a@" } 1 {} {high bit} { string compare "a\x00" "a\x01" } -1 {} {high bit} { string compare "\x00\x00" "\x00\x01" } -1 {} {binary equal} { string compare [binary format a100 0] [binary format a100 0] } 0 {} {binary neq} { string compare [binary format a100a 0 1] [binary format a100a 0 0] } 1 {} {binary neq inequal length} { string compare [binary format a20a 0 1] [binary format a100a 0 0] } 1 {} } { if {$tname eq ""} { continue } if {$tcode eq ""} { set tcode ok } test stringComp-2.[incr i] "string compare, $tname" \ -body [list eval $tbody] \ -returnCodes $tcode -result $tresult test stringComp-2.[incr i] "string compare bc, $tname" \ -body "[list proc foo {} $tbody];foo" \ -returnCodes $tcode -result $tresult if {"error" ni $tcode} { set tresult [expr {!$tresult}] } else { set tresult [string map {compare equal} $tresult] } set tbody [string map {compare equal} $tbody] test stringComp-2.[incr i] "string equal, $tname" \ -body [list eval $tbody] \ -returnCodes $tcode -result $tresult test stringComp-2.[incr i] "string equal bc, $tname" \ -body "[list proc foo {} $tbody];foo" \ -returnCodes $tcode -result $tresult } # need a few extra tests short abbr cmd test stringComp-3.1 {string compare, shortest method name} { proc foo {} {string co abcde ABCDE} foo } 1 test stringComp-3.2 {string equal, shortest method name} { proc foo {} {string e abcde ABCDE} foo } 0 test stringComp-3.3 {string equal -nocase} { proc foo {} {string eq -nocase abcde ABCDE} foo } 1 test stringComp-4.1 {string first, too few args} { proc foo {} {string first a} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}} test stringComp-4.2 {string first, bad args} { proc foo {} {string first a b c} list [catch {foo} msg] $msg } {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test stringComp-4.3 {string first, too many args} { proc foo {} {string first a b 5 d} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}} test stringComp-4.4 {string first} { proc foo {} {string first bq abcdefgbcefgbqrs} foo } 12 test stringComp-4.5 {string first} { proc foo {} {string fir bcd abcdefgbcefgbqrs} foo } 1 test stringComp-4.6 {string first} { proc foo {} {string f b abcdefgbcefgbqrs} foo } 1 test stringComp-4.7 {string first} { proc foo {} {string first xxx x123xx345xxx789xxx012} foo } 9 test stringComp-4.8 {string first} { proc foo {} {string first "" x123xx345xxx789xxx012} foo } -1 test stringComp-4.9 {string first, unicode} { proc foo {} {string first x abc\u7266x} foo } 4 test stringComp-4.10 {string first, unicode} { proc foo {} {string first \u7266 abc\u7266x} foo } 3 test stringComp-4.11 {string first, start index} { proc foo {} {string first \u7266 abc\u7266x 3} foo } 3 test stringComp-4.12 {string first, start index} { proc foo {} {string first \u7266 abc\u7266x 4} foo } -1 test stringComp-4.13 {string first, start index} { proc foo {} {string first \u7266 abc\u7266x end-2} foo } 3 test stringComp-4.14 {string first, negative start index} { proc foo {} {string first b abc -1} foo } 1 test stringComp-5.1 {string index} { proc foo {} {string index} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test stringComp-5.2 {string index} { proc foo {} {string index a b c} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test stringComp-5.3 {string index} { proc foo {} {string index abcde 0} foo } a test stringComp-5.4 {string index} { proc foo {} {string in abcde 4} foo } e test stringComp-5.5 {string index} { proc foo {} {string index abcde 5} foo } {} test stringComp-5.6 {string index} { proc foo {} {string index abcde -10} list [catch {foo} msg] $msg } {0 {}} test stringComp-5.7 {string index} { proc foo {} {string index a xyz} list [catch {foo} msg] $msg } {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} test stringComp-5.8 {string index} { proc foo {} {string index abc end} foo } c test stringComp-5.9 {string index} { proc foo {} {string index abc end-1} foo } b test stringComp-5.10 {string index, unicode} { proc foo {} {string index abc\u7266d 4} foo } d test stringComp-5.11 {string index, unicode} { proc foo {} {string index abc\u7266d 3} foo } \u7266 test stringComp-5.12 {string index, unicode over char length, under byte length} { proc foo {} {string index \334\374\334\374 6} foo } {} test stringComp-5.13 {string index, bytearray object} { proc foo {} {string index [binary format a5 fuz] 0} foo } f test stringComp-5.14 {string index, bytearray object} { proc foo {} {string index [binary format I* {0x50515253 0x52}] 3} foo } S test stringComp-5.15 {string index, bytearray object} { proc foo {} { set b [binary format I* {0x50515253 0x52}] set i1 [string index $b end-6] set i2 [string index $b 1] string compare $i1 $i2 } foo } 0 test stringComp-5.16 {string index, bytearray object with string obj shimmering} { proc foo {} { set str "0123456789\x00 abcdedfghi" binary scan $str H* dump string compare [string index $str 10] \x00 } foo } 0 test stringComp-5.17 {string index, bad integer} -body { proc foo {} {string index "abc" 0o8} list [catch {foo} msg] $msg } -match glob -result {1 {*invalid octal number*}} test stringComp-5.18 {string index, bad integer} -body { proc foo {} {string index "abc" end-0o0289} list [catch {foo} msg] $msg } -match glob -result {1 {*invalid octal number*}} test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo } {} test stringComp-5.20 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] 20} foo } {} proc largest_int {} { # This will give us what the largest valid int on this machine is, # so we can test for overflow properly below on >32 bit systems set int 1 set exp 7; # assume we get at least 8 bits while {$int > 0} { set int [expr {1 << [incr exp]}] } return [expr {$int-1}] } ## string is ## not yet bc catch {rename largest_int {}} ## string last ## not yet bc ## string length ## not yet bc test stringComp-8.1 {string bytelength} { proc foo {} {string bytelength} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test stringComp-8.2 {string bytelength} { proc foo {} {string bytelength a b} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test stringComp-8.3 {string bytelength} { proc foo {} {string bytelength "\u00c7"} foo } 2 test stringComp-8.4 {string bytelength} { proc foo {} {string b ""} foo } 0 ## string length ## test stringComp-9.1 {string length} { proc foo {} {string length} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string length string"}} test stringComp-9.2 {string length} { proc foo {} {string length a b} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string length string"}} test stringComp-9.3 {string length} { proc foo {} {string length "a little string"} foo } 15 test stringComp-9.4 {string length} { proc foo {} {string le ""} foo } 0 test stringComp-9.5 {string length, unicode} { proc foo {} {string le "abcd\u7266"} foo } 5 test stringComp-9.6 {string length, bytearray object} { proc foo {} {string length [binary format a5 foo]} foo } 5 test stringComp-9.7 {string length, bytearray object} { proc foo {} {string length [binary format I* {0x50515253 0x52}]} foo } 8 ## string map ## not yet bc ## string match ## test stringComp-11.1 {string match, too few args} { proc foo {} {string match a} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string match ?-nocase? pattern string"}} test stringComp-11.2 {string match, too many args} { proc foo {} {string match a b c d} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string match ?-nocase? pattern string"}} test stringComp-11.3 {string match} { proc foo {} {string match abc abc} foo } 1 test stringComp-11.4 {string match} { proc foo {} {string mat abc abd} foo } 0 test stringComp-11.5 {string match} { proc foo {} {string match ab*c abc} foo } 1 test stringComp-11.6 {string match} { proc foo {} {string match ab**c abc} foo } 1 test stringComp-11.7 {string match} { proc foo {} {string match ab* abcdef} foo } 1 test stringComp-11.8 {string match} { proc foo {} {string match *c abc} foo } 1 test stringComp-11.9 {string match} { proc foo {} {string match *3*6*9 0123456789} foo } 1 test stringComp-11.10 {string match} { proc foo {} {string match *3*6*9 01234567890} foo } 0 test stringComp-11.11 {string match} { proc foo {} {string match a?c abc} foo } 1 test stringComp-11.12 {string match} { proc foo {} {string match a??c abc} foo } 0 test stringComp-11.13 {string match} { proc foo {} {string match ?1??4???8? 0123456789} foo } 1 test stringComp-11.14 {string match} { proc foo {} {string match {[abc]bc} abc} foo } 1 test stringComp-11.15 {string match} { proc foo {} {string match {a[abc]c} abc} foo } 1 test stringComp-11.16 {string match} { proc foo {} {string match {a[xyz]c} abc} foo } 0 test stringComp-11.17 {string match} { proc foo {} {string match {12[2-7]45} 12345} foo } 1 test stringComp-11.18 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12345} foo } 1 test stringComp-11.19 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12b45} foo } 1 test stringComp-11.20 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12d45} foo } 1 test stringComp-11.21 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12145} foo } 0 test stringComp-11.22 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12545} foo } 0 test stringComp-11.23 {string match} { proc foo {} {string match {a\*b} a*b} foo } 1 test stringComp-11.24 {string match} { proc foo {} {string match {a\*b} ab} foo } 0 test stringComp-11.25 {string match} { proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"} foo } 1 test stringComp-11.26 {string match} { proc foo {} {string match ** ""} foo } 1 test stringComp-11.27 {string match} { proc foo {} {string match *. ""} foo } 0 test stringComp-11.28 {string match} { proc foo {} {string match "" ""} foo } 1 test stringComp-11.29 {string match} { proc foo {} {string match \[a a} foo } 1 test stringComp-11.30 {string match, bad args} { proc foo {} {string match - b c} list [catch {foo} msg] $msg } {1 {bad option "-": must be -nocase}} test stringComp-11.31 {string match case} { proc foo {} {string match a A} foo } 0 test stringComp-11.32 {string match nocase} { proc foo {} {string match -n a A} foo } 1 test stringComp-11.33 {string match nocase} { proc foo {} {string match -nocase a\334 A\374} foo } 1 test stringComp-11.34 {string match nocase} { proc foo {} {string match -nocase a*f ABCDEf} foo } 1 test stringComp-11.35 {string match case, false hope} { # This is true because '_' lies between the A-Z and a-z ranges proc foo {} {string match {[A-z]} _} foo } 1 test stringComp-11.36 {string match nocase range} { # This is false because although '_' lies between the A-Z and a-z ranges, # we lower case the end points before checking the ranges. proc foo {} {string match -nocase {[A-z]} _} foo } 0 test stringComp-11.37 {string match nocase} { proc foo {} {string match -nocase {[A-fh-Z]} g} foo } 0 test stringComp-11.38 {string match case, reverse range} { proc foo {} {string match {[A-fh-Z]} g} foo } 1 test stringComp-11.39 {string match, *\ case} { proc foo {} {string match {*\abc} abc} foo } 1 test stringComp-11.40 {string match, *special case} { proc foo {} {string match {*[ab]} abc} foo } 0 test stringComp-11.41 {string match, *special case} { proc foo {} {string match {*[ab]*} abc} foo } 1 test stringComp-11.42 {string match, *special case} { proc foo {} {string match "*\\" "\\"} foo } 0 test stringComp-11.43 {string match, *special case} { proc foo {} {string match "*\\\\" "\\"} foo } 1 test stringComp-11.44 {string match, *special case} { proc foo {} {string match "*???" "12345"} foo } 1 test stringComp-11.45 {string match, *special case} { proc foo {} {string match "*???" "12"} foo } 0 test stringComp-11.46 {string match, *special case} { proc foo {} {string match "*\\*" "abc*"} foo } 1 test stringComp-11.47 {string match, *special case} { proc foo {} {string match "*\\*" "*"} foo } 1 test stringComp-11.48 {string match, *special case} { proc foo {} {string match "*\\*" "*abc"} foo } 0 test stringComp-11.49 {string match, *special case} { proc foo {} {string match "?\\*" "a*"} foo } 1 test stringComp-11.50 {string match, *special case} { proc foo {} {string match "\\" "\\"} foo } 0 test stringComp-11.51 {string match; *, -nocase and UTF-8} { proc foo {} {string match -nocase [binary format I 717316707] \ [binary format I 2028036707]} foo } 1 test stringComp-11.52 {string match, null char in string} { proc foo {} { set ptn "*abc*" foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] { lappend out [string match $ptn $elem] } set out } foo } {1 1 1 1} test stringComp-11.53 {string match, null char in pattern} { proc foo {} { set out "" foreach {ptn elem} [list \ "*\u0000abc\u0000" "\u0000abc\u0000" \ "*\u0000abc\u0000" "\u0000abc\u0000ef" \ "*\u0000abc\u0000*" "\u0000abc\u0000ef" \ "*\u0000abc\u0000" "@\u0000abc\u0000ef" \ "*\u0000abc\u0000*" "@\u0000abc\u0000ef" \ ] { lappend out [string match $ptn $elem] } set out } foo } {1 0 1 0 1} test stringComp-11.54 {string match, failure} { proc foo {} { set longString "" for {set i 0} {$i < 10} {incr i} { append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123" } list [string match *cba* $longString] \ [string match *a*l*\u0000* $longString] \ [string match *a*l*\u0000*123 $longString] \ [string match *a*l*\u0000*123* $longString] \ [string match *a*l*\u0000*cba* $longString] \ [string match *===* $longString] } foo } {0 1 1 1 0 0} ## string range test stringComp-12.1 {Bug 3588366: end-offsets before start} { apply {s { string range $s 0 end-5 }} 12345 } {} ## string repeat ## not yet bc ## string replace test stringComp-14.1 {Bug 82e7f67325} { apply {x { set a [join $x {}] lappend b [string length [string replace ___! 0 2 $a]] lappend b [string length [string replace ___! 0 2 $a[unset a]]] }} {a b} } {3 3} test stringComp-14.2 {Bug 82e7f67325} memory { # As in stringComp-14.1, but make sure we don't retain too many refs leaktest { apply {x { set a [join $x {}] lappend b [string length [string replace ___! 0 2 $a]] lappend b [string length [string replace ___! 0 2 $a[unset a]]] }} {a b} } } {0} test stringComp-14.3 {Bug 0dca3bfa8f} { apply {arg { set argCopy $arg set arg [string replace $arg 1 2 aa] # Crashes in comparison before fix expr {$arg ne $argCopy} }} abcde } 1 test stringComp-14.4 {Bug 1af8de570511} { apply {{x y} { # Generate an unshared string value set val "" for { set i 0 } { $i < $x } { incr i } { set val [format "0%s" $val] } string replace $val[unset val] 1 1 $y }} 4 x } 0x00 test stringComp-14.5 {} { string length [string replace [string repeat a\u00fe 2] 3 end {}] } 3 ## string tolower ## not yet bc ## string toupper ## not yet bc ## string totitle ## not yet bc ## string trim* ## not yet bc ## string word* ## not yet bc ## string cat test stringComp-29.1 {string cat, no arg} { proc foo {} {string cat} foo } "" test stringComp-29.2 {string cat, single arg} { proc foo {} { set x FOO string compare $x [string cat $x] } foo } 0 test stringComp-29.3 {string cat, two args} { proc foo {} { set x FOO string compare $x$x [string cat $x $x] } foo } 0 test stringComp-29.4 {string cat, many args} { proc foo {} { set x FOO set n 260 set xx [string repeat $x $n] set vv [string repeat {$x} $n] set vvs [string repeat {$x } $n] set r1 [string compare $xx [subst $vv]] set r2 [string compare $xx [eval "string cat $vvs"]] list $r1 $r2 } foo } {0 0} # cleanup catch {rename foo {}} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/stringObj.test0000644000175000017500000004722414554262142015657 0ustar sergeisergei# Commands covered: none # # This file contains tests for the procedures in tclStringObj.c that implement # the Tcl type manager for the string type. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] set result [expr {$first >= 0}] } 1 test stringObj-2.1 {Tcl_NewStringObj} testobj { set result "" lappend result [testobj freeallvars] lappend result [teststringobj set 1 abcd] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} abcd string 2} test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] lappend result [teststringobj set 1 xyz] ;# makes existing obj a string lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} xyz string 2} test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 512] lappend result [teststringobj set 1 foo] ;# makes existing obj a string lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 512 foo string 2} test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} testobj { testobj freeallvars teststringobj set 1 test teststringobj setlength 1 3 list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {3 4 tes} test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj { testobj freeallvars teststringobj set 1 abcdef teststringobj setlength 1 10 teststringobj length 1 } 10 test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj { testobj freeallvars teststringobj set 1 abcdef teststringobj append 1 xyzq -1 list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {10 20 abcdefxyzq} test stringObj-4.4 {Tcl_SetObjLength procedure, "empty string", length 0} testobj { testobj freeallvars testobj newobj 1 teststringobj setlength 1 0 list [teststringobj length2 1] [teststringobj get 1] } {0 {}} test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} testobj { testobj freeallvars testintobj set2 1 43 teststringobj append 1 xyz -1 teststringobj get 1 } {43xyz} test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} testobj { testobj freeallvars teststringobj set 1 {x y } teststringobj append 1 bbCCddEE 4 teststringobj append 1 123 -1 teststringobj get 1 } {x y bbCC123} test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} testobj { testobj freeallvars teststringobj set 1 xyz teststringobj setlength 1 15 teststringobj setlength 1 2 set result {} teststringobj append 1 1234567890123 -1 lappend result [teststringobj length 1] [teststringobj length2 1] teststringobj setlength 1 10 teststringobj append 1 abcdef -1 lappend result [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {15 15 16 32 xy12345678abcdef} test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj { testobj freeallvars teststringobj set2 1 [list a b] teststringobj appendstrings 1 xyz { 1234 } foo teststringobj get 1 } {a bxyz 1234 foo} test stringObj-6.2 {Tcl_AppendStringsToObj procedure, counting space} testobj { testobj freeallvars teststringobj set 1 abc teststringobj appendstrings 1 list [teststringobj length 1] [teststringobj get 1] } {3 abc} test stringObj-6.3 {Tcl_AppendStringsToObj procedure, counting space} testobj { testobj freeallvars teststringobj set 1 abc teststringobj appendstrings 1 {} {} {} {} list [teststringobj length 1] [teststringobj get 1] } {3 abc} test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} testobj { testobj freeallvars teststringobj set 1 abc teststringobj appendstrings 1 { 123 } abcdefg list [teststringobj length 1] [teststringobj get 1] } {15 {abc 123 abcdefg}} test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj { testobj freeallvars testobj newobj 1 teststringobj appendstrings 1 123 abcdefg list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1] } {10 20 123abcdefg} test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj { testobj freeallvars teststringobj set 1 abc teststringobj setlength 1 10 teststringobj setlength 1 2 teststringobj appendstrings 1 34567890 list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {10 10 ab34567890} test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testobj { testobj freeallvars teststringobj set 1 abc teststringobj setlength 1 10 teststringobj setlength 1 2 teststringobj appendstrings 1 34567890x list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {11 22 ab34567890x} test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj { testobj freeallvars testobj newobj 1 teststringobj appendstrings 1 {} list [teststringobj length2 1] [teststringobj get 1] } {0 {}} test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj { testobj freeallvars teststringobj set2 1 [string replace abc 1 1 d] teststringobj appendstrings 1 foo bar soom teststringobj get 1 } adcfoobarsoom test stringObj-7.1 {SetStringFromAny procedure} testobj { testobj freeallvars teststringobj set2 1 [list a b] teststringobj append 1 x -1 list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {4 8 {a bx}} test stringObj-7.2 {SetStringFromAny procedure, null object} testobj { testobj freeallvars testobj newobj 1 teststringobj appendstrings 1 {} list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {0 0 {}} test stringObj-7.3 {SetStringFromAny called with non-string obj} testobj { set x 2345 list [incr x] [testobj objtype $x] [string index $x end] \ [testobj objtype $x] } {2346 int 6 string} test stringObj-7.4 {SetStringFromAny called with string obj} testobj { set x "abcdef" list [string length $x] [testobj objtype $x] \ [string length $x] [testobj objtype $x] } {6 string 6 string} test stringObj-8.1 {DupStringInternalRep procedure} testobj { testobj freeallvars teststringobj set 1 {} teststringobj append 1 abcde -1 testobj duplicate 1 2 list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj maxchars 1] [teststringobj get 1] \ [teststringobj length 2] [teststringobj length2 2] \ [teststringobj maxchars 2] [teststringobj get 2] } {5 10 0 abcde 5 5 0 abcde} test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj { set x abc\u00ef\u00bf\u00aeghi string length $x set y $x list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \ [set y] [testobj objtype $x] [testobj objtype $y] } "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string" test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} testobj { set x abc\u00ef\u00bf\u00aeghi set y $x string length $x list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \ [set y] [testobj objtype $x] [testobj objtype $y] } "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string" test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} testobj { set x abcdefghi string length $x set y $x list [testobj objtype $x] [testobj objtype $y] [append x jkl] \ [set y] [testobj objtype $x] [testobj objtype $y] } {string string abcdefghijkl abcdefghi string string} test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} testobj { set x abcdefghi set y $x string length $x list [testobj objtype $x] [testobj objtype $y] [append x jkl] \ [set y] [testobj objtype $x] [testobj objtype $y] } {string string abcdefghijkl abcdefghi string string} test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {testobj testdstring} { set x abc\u00ef\u00bf\u00aeghi testdstring free testdstring append \u00ae\u00bf\u00ef -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] } "string none abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none" test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj { set x abc\u00ef\u00bf\u00aeghi string length $x list [testobj objtype $x] [append x $x] [testobj objtype $x] \ [append x $x] [testobj objtype $x] } "string abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi string\ abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi\ string" test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj testdstring} { set x abcdefghi testdstring free testdstring append \u00ae\u00bf\u00ef -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] } "string none abcdefghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none" test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {testobj testdstring} { set x abcdefghi testdstring free testdstring append jkl -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] } {string none abcdefghijkl jkl string none} test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj { set x abcdefghi string length $x list [testobj objtype $x] [append x $x] [testobj objtype $x] \ [append x $x] [testobj objtype $x] } {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\ string} test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {testobj testdstring} { set x abc\u00ef\u00bf\u00aeghi testdstring free testdstring append jkl -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] } "string none abc\u00ef\u00bf\u00aeghijkl jkl string none" test stringObj-9.7 {TclAppendObjToObj, integer src & dest} testobj { set x [expr {4 * 5}] set y [expr {4 + 5}] list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [testobj objtype $x] [append x $y] [testobj objtype $x] \ [testobj objtype $y] } {int int 209 string 2099 string int} test stringObj-9.8 {TclAppendObjToObj, integer src & dest} testobj { set x [expr {4 * 5}] list [testobj objtype $x] [append x $x] [testobj objtype $x] \ [append x $x] [testobj objtype $x] } {int 2020 string 20202020 string} test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} testobj { set x abcdefghi set y [expr {4 + 5}] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] } {string int abcdefghi9 9 string int} test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} testobj { set x abc\u00ef\u00bf\u00aeghi set y [expr {4 + 5}] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] } "string int abc\u00ef\u00bf\u00aeghi9 9 string int" test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj { # bug 2678, in <=8.2.0, the second obj (the one to append) in # Tcl_AppendObjToObj was not correctly checked to see if it was all one # byte chars, so a Unicode string would be added as one byte chars. set x abcdef set len [string length $x] set y a\u00fcb\u00e5c\u00ef set len [string length $y] append x $y string length $x set q {} for {set i 0} {$i < 12} {incr i} { lappend q [string index $x $i] } set q } "a b c d e f a \u00fc b \u00e5 c \u00ef" test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring} { testdstring free testdstring append abcdef -1 set x [testdstring get] list [testobj objtype $x] [set y [string range $x 1 end-1]] \ [testobj objtype $x] [testobj objtype $y] } [list none bcde string string] test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstring} { # Because this test does not use \uXXXX notation below instead of # hard-coding the values, it may fail in multibyte locales. However, we # need to test that the parser produces untyped objects even when there # are high-ASCII characters in the input (like "УЏ"). I don't know what # else to do but inline those characters here. testdstring free testdstring append "abc\u00ef\u00efdef" -1 set x [testdstring get] list [testobj objtype $x] [set y [string range $x 1 end-1]] \ [testobj objtype $x] [testobj objtype $y] } [list none "bc\u00EF\u00EFde" string string] test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj { # set x "abcУЏУЏdef" # Use \uXXXX notation below instead of hard-coding the values, otherwise # the test will fail in multibyte locales. set x "abc\u00EF\u00EFdef" string length $x list [testobj objtype $x] [set y [string range $x 1 end-1]] \ [testobj objtype $x] [testobj objtype $y] } [list string "bc\u00EF\u00EFde" string string] test stringObj-10.4 {Tcl_GetRange with some mixed width chars} testobj { # set a "УЏaТПbТЎcУЏТПdТЎ" # Use \uXXXX notation below instead of hard-coding the values, otherwise # the test will fail in multibyte locales. set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE" set result [list] while {[string length $a] > 0} { set a [string range $a 1 end-1] lappend result $a } set result } [list a\u00BFb\u00AEc\u00EF\u00BFd \ \u00BFb\u00AEc\u00EF\u00BF \ b\u00AEc\u00EF \ \u00AEc \ {}] test stringObj-11.1 {UpdateStringOfString} testobj { set x 2345 list [string index $x end] [testobj objtype $x] [incr x] \ [testobj objtype $x] } {5 string 2346 int} test stringObj-12.1 {Tcl_GetUniChar with byte-size chars} testobj { set x "abcdefghi" list [string index $x 0] [string index $x 1] } {a b} test stringObj-12.2 {Tcl_GetUniChar with byte-size chars} testobj { set x "abcdefghi" list [string index $x 3] [string index $x end] } {d i} test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} testobj { set x "abcdefghi" list [string index $x end] [string index $x end-1] } {i h} test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} testobj { string index "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" 0 } "\u00ef" test stringObj-12.5 {Tcl_GetUniChar} testobj { set x "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" list [string index $x 4] [string index $x 0] } "\u00ae \u00ef" test stringObj-12.6 {Tcl_GetUniChar} testobj { string index "\u00efa\u00bfb\u00aec\u00ef\u00bfd\u00ae" end } "\u00ae" test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} testobj { set a "" list [string length $a] [string length $a] } {0 0} test stringObj-13.2 {Tcl_GetCharLength with byte-size chars} testobj { string length "a" } 1 test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj { set a "abcdef" list [string length $a] [string length $a] } {6 6} test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj { string length "\u00ae" } 1 test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj { # string length "УЏТПТЎУЏТПТЎ" # Use \uXXXX notation below instead of hard-coding the values, otherwise # the test will fail in multibyte locales. string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE" } 6 test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj { # set a "УЏaТПbТЎcУЏТПdТЎ" # Use \uXXXX notation below instead of hard-coding the values, otherwise # the test will fail in multibyte locales. set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE" list [string length $a] [string length $a] } {10 10} test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { # SF bug #684699 string length [testbytestring \x00] } 1 test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo teststringobj getunicode 1 teststringobj append 1 bar -1 teststringobj getunicode 1 teststringobj append 1 bar -1 teststringobj setlength 1 0 teststringobj append 1 bar -1 teststringobj get 1 } {bar} test stringObj-15.1 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 0 } foofoo test stringObj-15.2 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 1 } foooo test stringObj-15.3 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 2 } fooo test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 3 } foo test stringObj-15.5 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself2 1 0 } foofoo test stringObj-15.6 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself2 1 1 } foooo test stringObj-15.7 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself2 1 2 } fooo test stringObj-15.8 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself2 1 3 } foo test stringObj-16.0 {Tcl_GetRange: normal case} testobj { teststringobj set 1 abcde teststringobj range 1 1 3 } bcd test stringObj-16.1 {Tcl_GetRange: first > end} testobj { teststringobj set 1 abcde teststringobj range 1 10 5 } {} test stringObj-16.2 {Tcl_GetRange: last > end} testobj { teststringobj set 1 abcde teststringobj range 1 3 13 } de test stringObj-16.3 {Tcl_GetRange: first = -1} testobj { teststringobj set 1 abcde teststringobj range 1 -1 3 } abcd test stringObj-16.4 {Tcl_GetRange: last = -1} testobj { teststringobj set 1 abcde teststringobj range 1 1 -1 } bcde test stringObj-16.5 {Tcl_GetRange: fist = last = -1} testobj { teststringobj set 1 abcde teststringobj range 1 -1 -1 } abcde test stringObj-16.6 {Tcl_GetRange: old anomaly} testobj { # Older implementations could return "cde" teststringobj set 1 abcde teststringobj range 1 2 0 } {} if {[testConstraint testobj]} { testobj freeallvars } # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/string.test0000644000175000017500000024265214554262142015226 0ustar sergeisergei# Commands covered: string # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # Copyright (c) 2001 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] testConstraint testindexobj [expr {[info commands testindexobj] != {}}] testConstraint testevalex [expr {[info commands testevalex] != {}}] testConstraint utf16 [expr {[string length \U010000] == 2}] testConstraint testbytestring [llength [info commands testbytestring]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] foreach noComp {0 1} { if {$noComp} { if {[info commands testevalex] eq {}} { test string-0.1.$noComp "show testevalex availability" {testevalex} {list} {} continue } interp alias {} run {} testevalex set constraints testevalex } else { interp alias {} run {} try set constraints {} } test string-1.1.$noComp {error conditions} -body { list [catch {run {string gorp a b}} msg] $msg } -result {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-1.2.$noComp {error conditions} { list [catch {run {string}} msg] $msg } {1 {wrong # args: should be "string subcommand ?arg ...?"}} test string-2.1.$noComp {string compare, not enough args} { list [catch {run {string compare a}} msg] $msg } {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} test string-2.2.$noComp {string compare, bad args} { list [catch {run {string compare a b c}} msg] $msg } {1 {bad option "a": must be -nocase or -length}} test string-2.3.$noComp {string compare, bad args} { list [catch {run {string compare -length -nocase str1 str2}} msg] $msg } {1 {expected integer but got "-nocase"}} test string-2.4.$noComp {string compare, too many args} { list [catch {run {string compare -length 10 -nocase str1 str2 str3}} msg] $msg } {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} test string-2.5.$noComp {string compare with length unspecified} { list [catch {run {string compare -length 10 10}} msg] $msg } {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} test string-2.6.$noComp {string compare} { run {string compare abcde abdef} } -1 test string-2.7.$noComp {string compare, shortest method name} { run {string co abcde ABCDE} } 1 test string-2.8.$noComp {string compare} { run {string compare abcde abcde} } 0 test string-2.9.$noComp {string compare with length} { run {string compare -length 2 abcde abxyz} } 0 test string-2.10.$noComp {string compare with special index} { list [catch {run {string compare -length end-3 abcde abxyz}} msg] $msg } {1 {expected integer but got "end-3"}} test string-2.11.$noComp {string compare, unicode} { run {string compare ab\u7266 ab\u7267} } -1 test string-2.12.$noComp {string compare, high bit} { # This test will fail if the underlying comparison # is using signed chars instead of unsigned chars. # (like SunOS's default memcmp thus the compat/memcmp.c) run {string compare "\x80" "@"} # Nb this tests works also in utf-8 space because \x80 is # translated into a 2 or more bytelength but whose first byte has # the high bit set. } 1 test string-2.13.$noComp {string compare -nocase} { run {string compare -nocase abcde abdef} } -1 test string-2.14.$noComp {string compare -nocase} { run {string compare -nocase abcde ABCDE} } 0 test string-2.15.$noComp {string compare -nocase} { run {string compare -nocase abcde abcde} } 0 test string-2.16.$noComp {string compare -nocase with length} { run {string compare -length 2 -nocase abcde Abxyz} } 0 test string-2.17.$noComp {string compare -nocase with length} { run {string compare -nocase -length 3 abcde Abxyz} } -1 test string-2.18.$noComp {string compare -nocase with length <= 0} { run {string compare -nocase -length -1 abcde AbCdEf} } -1 test string-2.19.$noComp {string compare -nocase with excessive length} { run {string compare -nocase -length 50 AbCdEf abcde} } 1 test string-2.20.$noComp {string compare -len unicode} { # These are strings that are 6 BYTELENGTH long, but the length # shouldn't make a different because there are actually 3 CHARS long run {string compare -len 5 \334\334\334 \334\334\374} } -1 test string-2.21.$noComp {string compare -nocase with special index} { list [catch {run {string compare -nocase -length end-3 Abcde abxyz}} msg] $msg } {1 {expected integer but got "end-3"}} test string-2.22.$noComp {string compare, null strings} { run {string compare "" ""} } 0 test string-2.23.$noComp {string compare, null strings} { run {string compare "" foo} } -1 test string-2.24.$noComp {string compare, null strings} { run {string compare foo ""} } 1 test string-2.25.$noComp {string compare -nocase, null strings} { run {string compare -nocase "" ""} } 0 test string-2.26.$noComp {string compare -nocase, null strings} { run {string compare -nocase "" foo} } -1 test string-2.27.$noComp {string compare -nocase, null strings} { run {string compare -nocase foo ""} } 1 test string-2.28.$noComp {string compare with length, unequal strings} { run {string compare -length 2 abc abde} } 0 test string-2.29.$noComp {string compare with length, unequal strings} { run {string compare -length 2 ab abde} } 0 test string-2.30.$noComp {string compare with NUL character vs. other ASCII} { # Be careful here, since UTF-8 rep comparison with memcmp() of # these puts chars in the wrong order run {string compare \x00 \x01} } -1 test string-2.31.$noComp {string compare, high bit} { run {string compare "a\x80" "a@"} } 1 test string-2.32.$noComp {string compare, high bit} { run {string compare "a\x00" "a\x01"} } -1 test string-2.33.$noComp {string compare, high bit} { run {string compare "\x00\x00" "\x00\x01"} } -1 test string-2.34.$noComp {string compare, binary equal} { run {string compare [binary format a100 0] [binary format a100 0]} } 0 test string-2.35.$noComp {string compare, binary neq} { run {string compare [binary format a100a 0 1] [binary format a100a 0 0]} } 1 test string-2.36.$noComp {string compare, binary neq unequal length} { run {string compare [binary format a20a 0 1] [binary format a100a 0 0]} } 1 # only need a few tests on equal, since it uses the same code as # string compare, but just modifies the return output test string-3.1.$noComp {string equal} { run {string equal abcde abdef} } 0 test string-3.2.$noComp {string equal} { run {string eq abcde ABCDE} } 0 test string-3.3.$noComp {string equal} { run {string equal abcde abcde} } 1 test string-3.4.$noComp {string equal -nocase} { run {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334} } 1 test string-3.5.$noComp {string equal -nocase} { run {string equal -nocase abcde abdef} } 0 test string-3.6.$noComp {string equal -nocase} { run {string eq -nocase abcde ABCDE} } 1 test string-3.7.$noComp {string equal -nocase} { run {string equal -nocase abcde abcde} } 1 test string-3.8.$noComp {string equal with length, unequal strings} { run {string equal -length 2 abc abde} } 1 test string-4.1.$noComp {string first, not enough args} { list [catch {run {string first a}} msg] $msg } {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}} test string-4.2.$noComp {string first, bad args} { list [catch {run {string first a b c}} msg] $msg } {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test string-4.3.$noComp {string first, too many args} { list [catch {run {string first a b 5 d}} msg] $msg } {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}} test string-4.4.$noComp {string first} { run {string first bq abcdefgbcefgbqrs} } 12 test string-4.5.$noComp {string first} { run {string fir bcd abcdefgbcefgbqrs} } 1 test string-4.6.$noComp {string first} { run {string f b abcdefgbcefgbqrs} } 1 test string-4.7.$noComp {string first} { run {string first xxx x123xx345xxx789xxx012} } 9 test string-4.8.$noComp {string first} { run {string first "" x123xx345xxx789xxx012} } -1 test string-4.9.$noComp {string first, unicode} { run {string first x abc\u7266x} } 4 test string-4.10.$noComp {string first, unicode} { run {string first \u7266 abc\u7266x} } 3 test string-4.11.$noComp {string first, start index} { run {string first \u7266 abc\u7266x 3} } 3 test string-4.12.$noComp {string first, start index} -body { run {string first \u7266 abc\u7266x 4} } -result -1 test string-4.13.$noComp {string first, start index} -body { run {string first \u7266 abc\u7266x end-2} } -result 3 test string-4.14.$noComp {string first, negative start index} -body { run {string first b abc -1} } -result 1 test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} -body { # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded # strings was incorrect, leading to an index returned by [string first] # which pointed past the end of the string. set uchar \u057E ;# character with two-byte encoding in utf-8 run {string first % %#$uchar$uchar#$uchar$uchar#% 3} } -result 8 test string-4.17.$noComp {string first, corner case} -body { run {string first a aaa 4294967295} } -result 0 test string-4.18.$noComp {string first, corner case} -body { run {string first a aaa -1} } -result 0 test string-4.19.$noComp {string first, corner case} -body { run {string first a aaa end-5} } -result 0 test string-4.20.$noComp {string last, corner case} -body { run {string last a aaa 4294967295} } -result -1 test string-4.21.$noComp {string last, corner case} -body { run {string last a aaa -1} } -result -1 test string-4.22.$noComp {string last, corner case} { run {string last a aaa end-5} } -1 test string-5.1.$noComp {string index} { list [catch {run {string index}} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test string-5.2.$noComp {string index} { list [catch {run {string index a b c}} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test string-5.3.$noComp {string index} { run {string index abcde 0} } a test string-5.4.$noComp {string index} { run {string in abcde 4} } e test string-5.5.$noComp {string index} { run {string index abcde 5} } {} test string-5.6.$noComp {string index} { list [catch {run {string index abcde -10}} msg] $msg } {0 {}} test string-5.7.$noComp {string index} { list [catch {run {string index a xyz}} msg] $msg } {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} test string-5.8.$noComp {string index} { run {string index abc end} } c test string-5.9.$noComp {string index} { run {string index abc end-1} } b test string-5.10.$noComp {string index, unicode} { run {string index abc\u7266d 4} } d test string-5.11.$noComp {string index, unicode} { run {string index abc\u7266d 3} } \u7266 test string-5.12.$noComp {string index, unicode over char length, under byte length} -body { run {string index \334\374\334\374 6} } -result {} test string-5.13.$noComp {string index, bytearray object} { run {string index [binary format a5 fuz] 0} } f test string-5.14.$noComp {string index, bytearray object} { run {string index [binary format I* {0x50515253 0x52}] 3} } S test string-5.15.$noComp {string index, bytearray object} { set b [binary format I* {0x50515253 0x52}] set i1 [run {string index $b end-6}] set i2 [run {string index $b 1}] run {string compare $i1 $i2} } 0 test string-5.16.$noComp {string index, bytearray object with string obj shimmering} { set str "0123456789\x00 abcdedfghi" binary scan $str H* dump run {string compare [run {string index $str 10}] \x00} } 0 test string-5.17.$noComp {string index, bad integer} -body { list [catch {run {string index "abc" 0o8}} msg] $msg } -match glob -result {1 {*invalid octal number*}} test string-5.18.$noComp {string index, bad integer} -body { list [catch {run {string index "abc" end-0o0289}} msg] $msg } -match glob -result {1 {*invalid octal number*}} test string-5.19.$noComp {string index, bytearray object out of bounds} { run {string index [binary format I* {0x50515253 0x52}] -1} } {} test string-5.20.$noComp {string index, bytearray object out of bounds} -body { run {string index [binary format I* {0x50515253 0x52}] 20} } -result {} test string-5.22.$noComp {string index} -constraints testbytestring -body { run {list [scan [string index [testbytestring \xFF] 0] %c var] $var} } -result {1 255} proc largest_int {} { # This will give us what the largest valid int on this machine is, # so we can test for overflow properly below on >32 bit systems set int 1 set exp 7; # assume we get at least 8 bits while {wide($int) > 0} { set int [expr {wide(1) << [incr exp]}] } return [expr {$int-1}] } test string-6.1.$noComp {string is, not enough args} { list [catch {run {string is}} msg] $msg } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} test string-6.2.$noComp {string is, not enough args} { list [catch {run {string is alpha}} msg] $msg } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} test string-6.3.$noComp {string is, bad args} { list [catch {run {string is alpha -failin str}} msg] $msg } {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}} test string-6.4.$noComp {string is, too many args} { list [catch {run {string is alpha -failin var -strict str more}} msg] $msg } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} test string-6.5.$noComp {string is, class check} { list [catch {run {string is bogus str}} msg] $msg } {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} test string-6.6.$noComp {string is, ambiguous class} { list [catch {run {string is al str}} msg] $msg } {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} test string-6.7.$noComp {string is alpha, all ok} { run {string is alpha -strict -failindex var abc} } 1 test string-6.8.$noComp {string is, error in var} { list [run {string is alpha -failindex var abc5def}] $var } {0 3} test string-6.9.$noComp {string is, var shouldn't get set} { catch {unset var} list [catch {run {string is alpha -failindex var abc; set var}} msg] $msg } {1 {can't read "var": no such variable}} test string-6.10.$noComp {string is, ok on empty} { run {string is alpha {}} } 1 test string-6.11.$noComp {string is, -strict check against empty} { run {string is alpha -strict {}} } 0 test string-6.12.$noComp {string is alnum, true} { run {string is alnum abc123} } 1 test string-6.13.$noComp {string is alnum, false} { list [run {string is alnum -failindex var abc1.23}] $var } {0 4} test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xfc}" 1 test string-6.15.$noComp {string is alpha, true} { run {string is alpha abc} } 1 test string-6.16.$noComp {string is alpha, false} { list [run {string is alpha -fail var a1bcde}] $var } {0 1} test string-6.17.$noComp {string is alpha, unicode} { run {string is alpha abc\374} } 1 test string-6.18.$noComp {string is ascii, true} { run {string is ascii abc\x7Fend\x00} } 1 test string-6.19.$noComp {string is ascii, false} { list [run {string is ascii -fail var abc\x00def\x80more}] $var } {0 7} test string-6.20.$noComp {string is boolean, true} { run {string is boolean true} } 1 test string-6.21.$noComp {string is boolean, true} { run {string is boolean f} } 1 test string-6.22.$noComp {string is boolean, true based on type} { run {string is bool [run {string compare a a}]} } 1 test string-6.23.$noComp {string is boolean, false} { list [run {string is bool -fail var yada}] $var } {0 0} test string-6.24.$noComp {string is digit, true} { run {string is digit 0123456789} } 1 test string-6.25.$noComp {string is digit, false} { list [run {string is digit -fail var 0123\xDC567}] $var } {0 4} test string-6.26.$noComp {string is digit, false} { list [run {string is digit -fail var +123567}] $var } {0 0} test string-6.27.$noComp {string is double, true} { run {string is double 1} } 1 test string-6.28.$noComp {string is double, true} { run {string is double [expr {double(1)}]} } 1 test string-6.29.$noComp {string is double, true} { run {string is double 1.0} } 1 test string-6.30.$noComp {string is double, true} { run {string is double [run {string compare a a}]} } 1 test string-6.31.$noComp {string is double, true} { run {string is double " +1.0e-1 "} } 1 test string-6.32.$noComp {string is double, true} { run {string is double "\n1.0\v"} } 1 test string-6.33.$noComp {string is double, false} { list [run {string is double -fail var 1abc}] $var } {0 1} test string-6.34.$noComp {string is double, false} { list [run {string is double -fail var abc}] $var } {0 0} test string-6.35.$noComp {string is double, false} { list [run {string is double -fail var " 1.0e4e4 "}] $var } {0 8} test string-6.36.$noComp {string is double, false} { list [run {string is double -fail var "\n"}] $var } {0 0} test string-6.37.$noComp {string is double, false on int overflow} -setup { set var priorValue } -body { # Make it the largest int recognizable, with one more digit for overflow # Since bignums arrived in Tcl 8.5, the sense of this test changed. # Now integer values that exceed native limits become bignums, and # bignums can convert to doubles without error. list [run {string is double -fail var [largest_int]0}] $var } -result {1 priorValue} # string-6.38 removed, underflow on input is no longer an error. test string-6.39.$noComp {string is double, false} { # This test is non-portable because IRIX thinks # that .e1 is a valid double - this is really a bug # on IRIX as .e1 should NOT be a valid double # # Portable now. Tcl 8.5 does its own double parsing. list [run {string is double -fail var .e1}] $var } {0 0} test string-6.40.$noComp {string is false, true} { run {string is false false} } 1 test string-6.41.$noComp {string is false, true} { run {string is false FaLsE} } 1 test string-6.42.$noComp {string is false, true} { run {string is false N} } 1 test string-6.43.$noComp {string is false, true} { run {string is false 0} } 1 test string-6.44.$noComp {string is false, true} { run {string is false off} } 1 test string-6.45.$noComp {string is false, false} { list [run {string is false -fail var abc}] $var } {0 0} test string-6.46.$noComp {string is false, false} { catch {unset var} list [run {string is false -fail var Y}] $var } {0 0} test string-6.47.$noComp {string is false, false} { catch {unset var} list [run {string is false -fail var offensive}] $var } {0 0} test string-6.48.$noComp {string is integer, true} { run {string is integer +1234567890} } 1 test string-6.49.$noComp {string is integer, true on type} { run {string is integer [expr {int(50.0)}]} } 1 test string-6.50.$noComp {string is integer, true} { run {string is integer [list -10]} } 1 test string-6.51.$noComp {string is integer, true as hex} { run {string is integer 0xabcdef} } 1 test string-6.52.$noComp {string is integer, true as octal} { run {string is integer 012345} } 1 test string-6.53.$noComp {string is integer, true with whitespace} { run {string is integer " \n1234\v"} } 1 test string-6.54.$noComp {string is integer, false} { list [run {string is integer -fail var 123abc}] $var } {0 3} test string-6.55.$noComp {string is integer, false on overflow} { list [run {string is integer -fail var +[largest_int]0}] $var } {0 -1} test string-6.56.$noComp {string is integer, false} { list [run {string is integer -fail var [expr {double(1)}]}] $var } {0 1} test string-6.57.$noComp {string is integer, false} { list [run {string is integer -fail var " "}] $var } {0 0} test string-6.58.$noComp {string is integer, false on bad octal} { list [run {string is integer -fail var 0o36963}] $var } {0 4} test string-6.58.1.$noComp {string is integer, false on bad octal} { list [run {string is integer -fail var 0o36963}] $var } {0 4} test string-6.59.$noComp {string is integer, false on bad hex} { list [run {string is integer -fail var 0X345XYZ}] $var } {0 5} test string-6.60.$noComp {string is lower, true} { run {string is lower abc} } 1 test string-6.61.$noComp {string is lower, unicode true} { run {string is lower abc\xFCue} } 1 test string-6.62.$noComp {string is lower, false} { list [run {string is lower -fail var aBc}] $var } {0 1} test string-6.63.$noComp {string is lower, false} { list [run {string is lower -fail var abc1}] $var } {0 3} test string-6.64.$noComp {string is lower, unicode false} { list [run {string is lower -fail var ab\xDCUE}] $var } {0 2} test string-6.65.$noComp {string is space, true} { run {string is space " \t\n\v\f"} } 1 test string-6.66.$noComp {string is space, false} { list [run {string is space -fail var " \t\n\v1\f"}] $var } {0 4} test string-6.67.$noComp {string is true, true} { run {string is true true} } 1 test string-6.68.$noComp {string is true, true} { run {string is true TrU} } 1 test string-6.69.$noComp {string is true, true} { run {string is true ye} } 1 test string-6.70.$noComp {string is true, true} { run {string is true 1} } 1 test string-6.71.$noComp {string is true, true} { run {string is true on} } 1 test string-6.72.$noComp {string is true, false} { list [run {string is true -fail var onto}] $var } {0 0} test string-6.73.$noComp {string is true, false} { catch {unset var} list [run {string is true -fail var 25}] $var } {0 0} test string-6.74.$noComp {string is true, false} { catch {unset var} list [run {string is true -fail var no}] $var } {0 0} test string-6.75.$noComp {string is upper, true} { run {string is upper ABC} } 1 test string-6.76.$noComp {string is upper, unicode true} { run {string is upper ABC\xDCUE} } 1 test string-6.77.$noComp {string is upper, false} { list [run {string is upper -fail var AbC}] $var } {0 1} test string-6.78.$noComp {string is upper, false} { list [run {string is upper -fail var AB2C}] $var } {0 2} test string-6.79.$noComp {string is upper, unicode false} { list [run {string is upper -fail var ABC\xFCue}] $var } {0 3} test string-6.80.$noComp {string is wordchar, true} { run {string is wordchar abc_123} } 1 test string-6.81.$noComp {string is wordchar, unicode true} { run {string is wordchar abc\xFCab\xDCAB\u5001} } 1 test string-6.82.$noComp {string is wordchar, false} { list [run {string is wordchar -fail var abcd.ef}] $var } {0 4} test string-6.83.$noComp {string is wordchar, unicode false} { list [run {string is wordchar -fail var abc\x80def}] $var } {0 3} test string-6.84.$noComp {string is control} { ## Control chars are in the ranges ## 00..1F && 7F..9F list [run {string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60}] $var } {0 7} test string-6.85.$noComp {string is control} { run {string is control \u0100} } 0 test string-6.86.$noComp {string is graph} { ## graph is any print char, except space list [run {string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "}] $var } {0 14} test string-6.87.$noComp {string is print} { ## basically any printable char list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\x10"}] $var } {0 15} test string-6.88.$noComp {string is punct} { ## any graph char that isn't alnum list [run {string is punct -fail var "_!@#\xBEq0"}] $var } {0 4} test string-6.89.$noComp {string is xdigit} { list [run {string is xdigit -fail var 0123456789\x61bcdefABCDEFg}] $var } {0 22} test string-6.90.$noComp {string is integer, bad integers} { # SF bug #634856 set result "" set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"] foreach num $numbers { lappend result [run {string is int -strict $num}] } return $result } {1 1 0 0 0 1 0 0} test string-6.91.$noComp {string is double, bad doubles} { set result "" set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"] foreach num $numbers { lappend result [run {string is double -strict $num}] } return $result } {1 1 0 0 0 1 0 0} test string-6.92.$noComp {string is integer, 32-bit overflow} { # Bug 718878 set x 0x100000000 list [run {string is integer -failindex var $x}] $var } {0 -1} test string-6.93.$noComp {string is integer, 32-bit overflow} { # Bug 718878 set x 0x100000000 append x "" list [run {string is integer -failindex var $x}] $var } {0 -1} test string-6.94.$noComp {string is integer, 32-bit overflow} { # Bug 718878 set x 0x100000000 list [run {string is integer -failindex var [expr {$x}]}] $var } {0 -1} test string-6.95.$noComp {string is wideinteger, true} { run {string is wideinteger +1234567890} } 1 test string-6.96.$noComp {string is wideinteger, true on type} { run {string is wideinteger [expr {wide(50.0)}]} } 1 test string-6.97.$noComp {string is wideinteger, true} { run {string is wideinteger [list -10]} } 1 test string-6.98.$noComp {string is wideinteger, true as hex} { run {string is wideinteger 0xabcdef} } 1 test string-6.99.$noComp {string is wideinteger, true as octal} { run {string is wideinteger 0123456} } 1 test string-6.100.$noComp {string is wideinteger, true with whitespace} { run {string is wideinteger " \n1234\v"} } 1 test string-6.101.$noComp {string is wideinteger, false} { list [run {string is wideinteger -fail var 123abc}] $var } {0 3} test string-6.102.$noComp {string is wideinteger, false on overflow} { list [run {string is wideinteger -fail var +[largest_int]0}] $var } {0 -1} test string-6.103.$noComp {string is wideinteger, false} { list [run {string is wideinteger -fail var [expr {double(1)}]}] $var } {0 1} test string-6.104.$noComp {string is wideinteger, false} { list [run {string is wideinteger -fail var " "}] $var } {0 0} test string-6.105.$noComp {string is wideinteger, false on bad octal} { list [run {string is wideinteger -fail var 0o36963}] $var } {0 4} test string-6.105.1.$noComp {string is wideinteger, false on bad octal} { list [run {string is wideinteger -fail var 0o36963}] $var } {0 4} test string-6.106.$noComp {string is wideinteger, false on bad hex} { list [run {string is wideinteger -fail var 0X345XYZ}] $var } {0 5} test string-6.107.$noComp {string is integer, bad integers} { # SF bug #634856 set result "" set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"] foreach num $numbers { lappend result [run {string is wideinteger -strict $num}] } return $result } {1 1 0 0 0 1 0 0} test string-6.108.$noComp {string is double, Bug 1382287} { set x 2turtledoves run {string is double $x} run {string is double $x} } 0 test string-6.109.$noComp {string is double, Bug 1360532} { run {string is double 1\xA0} } 0 test string-6.110.$noComp {string is entier, true} { run {string is entier +1234567890} } 1 test string-6.111.$noComp {string is entier, true on type} { run {string is entier [expr {wide(50.0)}]} } 1 test string-6.112.$noComp {string is entier, true} { run {string is entier [list -10]} } 1 test string-6.113.$noComp {string is entier, true as hex} { run {string is entier 0xabcdef} } 1 test string-6.114.$noComp {string is entier, true as octal} { run {string is entier 0123456} } 1 test string-6.115.$noComp {string is entier, true with whitespace} { run {string is entier " \n1234\v"} } 1 test string-6.116.$noComp {string is entier, false} { list [run {string is entier -fail var 123abc}] $var } {0 3} test string-6.117.$noComp {string is entier, false} { list [run {string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc}] $var } {0 84} test string-6.118.$noComp {string is entier, false} { list [run {string is entier -fail var [expr {double(1)}]}] $var } {0 1} test string-6.119.$noComp {string is entier, false} { list [run {string is entier -fail var " "}] $var } {0 0} test string-6.120.$noComp {string is entier, false on bad octal} { list [run {string is entier -fail var 0o36963}] $var } {0 4} test string-6.121.1.$noComp {string is entier, false on bad octal} { list [run {string is entier -fail var 0o36963}] $var } {0 4} test string-6.122.$noComp {string is entier, false on bad hex} { list [run {string is entier -fail var 0X345XYZ}] $var } {0 5} test string-6.123.$noComp {string is entier, bad integers} { # SF bug #634856 set result "" set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"] foreach num $numbers { lappend result [run {string is entier -strict $num}] } return $result } {1 1 0 0 0 1 0 0} test string-6.124.$noComp {string is entier, true} { run {string is entier +1234567890123456789012345678901234567890} } 1 test string-6.125.$noComp {string is entier, true} { run {string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]} } 1 test string-6.126.$noComp {string is entier, true as hex} { run {string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef} } 1 test string-6.127.$noComp {string is entier, true as octal} { run {string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456} } 1 test string-6.128.$noComp {string is entier, true with whitespace} { run {string is entier " \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"} } 1 test string-6.129.$noComp {string is entier, false on bad octal} { list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var } {0 87} test string-6.130.1.$noComp {string is entier, false on bad octal} { list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var } {0 87} test string-6.131.$noComp {string is entier, false on bad hex} { list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var } {0 88} test string-6.139.$noComp {string is integer, bug [76ad7aeba3]} { run {string is integer 18446744073709551615} } 0 test string-6.140.$noComp {string is integer, bug [76ad7aeba3]} { run {string is integer -18446744073709551615} } 0 catch {rename largest_int {}} test string-7.1.$noComp {string last, not enough args} { list [catch {run {string last a}} msg] $msg } {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}} test string-7.2.$noComp {string last, bad args} { list [catch {run {string last a b c}} msg] $msg } {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test string-7.3.$noComp {string last, too many args} { list [catch {run {string last a b c d}} msg] $msg } {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}} test string-7.4.$noComp {string last} { run {string la xxx xxxx123xx345x678} } 1 test string-7.5.$noComp {string last} { run {string last xx xxxx123xx345x678} } 7 test string-7.6.$noComp {string last} { run {string las x xxxx123xx345x678} } 12 test string-7.7.$noComp {string last, unicode} { run {string las x xxxx12\u7266xx345x678} } 12 test string-7.8.$noComp {string last, unicode} { run {string las \u7266 xxxx12\u7266xx345x678} } 6 test string-7.9.$noComp {string last, stop index} { run {string las \u7266 xxxx12\u7266xx345x678} } 6 test string-7.10.$noComp {string last, unicode} { run {string las \u7266 xxxx12\u7266xx345x678} } 6 test string-7.11.$noComp {string last, start index} { run {string last \u7266 abc\u7266x 3} } 3 test string-7.12.$noComp {string last, start index} { run {string last \u7266 abc\u7266x 2} } -1 test string-7.13.$noComp {string last, start index} { ## Constrain to last 'a' should work run {string last ba badbad end-1} } 3 test string-7.14.$noComp {string last, start index} { ## Constrain to last 'b' should skip last 'ba' run {string last ba badbad end-2} } 0 test string-7.15.$noComp {string last, start index} { run {string last \334a \334ad\334ad 0} } -1 test string-7.16.$noComp {string last, start index} { run {string last \334a \334ad\334ad end-1} } 3 test string-8.1.$noComp {string bytelength} { list [catch {run {string bytelength}} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test string-8.2.$noComp {string bytelength} { list [catch {run {string bytelength a b}} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test string-8.3.$noComp {string bytelength} { run {string bytelength "\xC7"} } 2 test string-8.4.$noComp {string bytelength} { run {string b ""} } 0 test string-9.1.$noComp {string length} { list [catch {run {string length}} msg] $msg } {1 {wrong # args: should be "string length string"}} test string-9.2.$noComp {string length} { list [catch {run {string length a b}} msg] $msg } {1 {wrong # args: should be "string length string"}} test string-9.3.$noComp {string length} { run {string length "a little string"} } 15 test string-9.4.$noComp {string length} { run {string le ""} } 0 test string-9.5.$noComp {string length, unicode} { run {string le "abcd\u7266"} } 5 test string-9.6.$noComp {string length, bytearray object} { run {string length [binary format a5 foo]} } 5 test string-9.7.$noComp {string length, bytearray object} { run {string length [binary format I* {0x50515253 0x52}]} } 8 test string-10.1.$noComp {string map, not enough args} { list [catch {run {string map}} msg] $msg } {1 {wrong # args: should be "string map ?-nocase? charMap string"}} test string-10.2.$noComp {string map, bad args} { list [catch {run {string map {a b} abba oops}} msg] $msg } {1 {bad option "a b": must be -nocase}} test string-10.3.$noComp {string map, too many args} { list [catch {run {string map -nocase {a b} str1 str2}} msg] $msg } {1 {wrong # args: should be "string map ?-nocase? charMap string"}} test string-10.4.$noComp {string map} { run {string map {a b} abba} } {bbbb} test string-10.5.$noComp {string map} { run {string map {a b} a} } {b} test string-10.6.$noComp {string map -nocase} { run {string map -nocase {a b} Abba} } {bbbb} test string-10.7.$noComp {string map} { run {string map {abc 321 ab * a A} aabcabaababcab} } {A321*A*321*} test string-10.8.$noComp {string map -nocase} { run {string map -nocase {aBc 321 Ab * a A} aabcabaababcab} } {A321*A*321*} test string-10.9.$noComp {string map -nocase} { run {string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb} } {A321*A*321*} test string-10.10.$noComp {string map} { list [catch {run {string map {a b c} abba}} msg] $msg } {1 {char map list unbalanced}} test string-10.11.$noComp {string map, nulls} { run {string map {\x00 NULL blah \x00nix} {qwerty}} } {qwerty} test string-10.12.$noComp {string map, unicode} { run {string map [list \374 ue UE \334] "a\374ueUE\x00EU"} } aueue\334\x00EU test string-10.13.$noComp {string map, -nocase unicode} { run {string map -nocase [list \374 ue UE \334] "a\374ueUE\x00EU"} } aue\334\334\x00EU test string-10.14.$noComp {string map, -nocase null arguments} { run {string map -nocase {{} abc} foo} } foo test string-10.15.$noComp {string map, one pair case} { run {string map -nocase {abc 32} aAbCaBaAbAbcAb} } {a32aBaAb32Ab} test string-10.16.$noComp {string map, one pair case} { run {string map -nocase {ab 4321} aAbCaBaAbAbcAb} } {a4321C4321a43214321c4321} test string-10.17.$noComp {string map, one pair case} { run {string map {Ab 4321} aAbCaBaAbAbcAb} } {a4321CaBa43214321c4321} test string-10.18.$noComp {string map, empty argument} { run {string map -nocase {{} abc} foo} } foo test string-10.19.$noComp {string map, empty arguments} { run {string map -nocase {{} abc f bar {} def} foo} } baroo test string-10.20.$noComp {string map, dictionaries don't alter map ordering} { set map {aa X a Y} list [run {string map [dict create aa X a Y] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}] } {XY XY 2 XY} test string-10.20.1.$noComp {string map, dictionaries don't alter map ordering} { set map {a X b Y a Z} list [run {string map [dict create a X b Y a Z] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}] } {ZZZ XXX 2 XXX} test string-10.21.$noComp {string map, ABR checks} { run {string map {longstring foob} long} } long test string-10.22.$noComp {string map, ABR checks} { run {string map {long foob} long} } foob test string-10.23.$noComp {string map, ABR checks} { run {string map {lon foob} long} } foobg test string-10.24.$noComp {string map, ABR checks} { run {string map {lon foob} longlo} } foobglo test string-10.25.$noComp {string map, ABR checks} { run {string map {lon foob} longlon} } foobgfoob test string-10.26.$noComp {string map, ABR checks} { run {string map {longstring foob longstring bar} long} } long test string-10.27.$noComp {string map, ABR checks} { run {string map {long foob longstring bar} long} } foob test string-10.28.$noComp {string map, ABR checks} { run {string map {lon foob longstring bar} long} } foobg test string-10.29.$noComp {string map, ABR checks} { run {string map {lon foob longstring bar} longlo} } foobglo test string-10.30.$noComp {string map, ABR checks} { run {string map {lon foob longstring bar} longlon} } foobgfoob test string-10.31.$noComp {string map, nasty sharing crash from [Bug 1018562]} { set a {a b} run {string map $a $a} } {b b} test string-11.1.$noComp {string match, not enough args} { list [catch {run {string match a}} msg] $msg } {1 {wrong # args: should be "string match ?-nocase? pattern string"}} test string-11.2.$noComp {string match, too many args} { list [catch {run {string match a b c d}} msg] $msg } {1 {wrong # args: should be "string match ?-nocase? pattern string"}} test string-11.3.$noComp {string match} { run {string match abc abc} } 1 test string-11.4.$noComp {string match} { run {string mat abc abd} } 0 test string-11.5.$noComp {string match} { run {string match ab*c abc} } 1 test string-11.6.$noComp {string match} { run {string match ab**c abc} } 1 test string-11.7.$noComp {string match} { run {string match ab* abcdef} } 1 test string-11.8.$noComp {string match} { run {string match *c abc} } 1 test string-11.9.$noComp {string match} { run {string match *3*6*9 0123456789} } 1 test string-11.9.1.$noComp {string match} { run {string match *3*6*89 0123456789} } 1 test string-11.9.2.$noComp {string match} { run {string match *3*456*89 0123456789} } 1 test string-11.9.3.$noComp {string match} { run {string match *3*6* 0123456789} } 1 test string-11.9.4.$noComp {string match} { run {string match *3*56* 0123456789} } 1 test string-11.9.5.$noComp {string match} { run {string match *3*456*** 0123456789} } 1 test string-11.9.6.$noComp {string match} { run {string match **3*456** 0123456789} } 1 test string-11.9.7.$noComp {string match} { run {string match *3***456* 0123456789} } 1 test string-11.9.8.$noComp {string match} { run {string match *3***\[456]* 0123456789} } 1 test string-11.9.9.$noComp {string match} { run {string match *3***\[4-6]* 0123456789} } 1 test string-11.9.10.$noComp {string match} { run {string match *3***\[4-6] 0123456789} } 0 test string-11.9.11.$noComp {string match} { run {string match *3***\[4-6] 0123456} } 1 test string-11.10.$noComp {string match} { run {string match *3*6*9 01234567890} } 0 test string-11.10.1.$noComp {string match} { run {string match *3*6*89 01234567890} } 0 test string-11.10.2.$noComp {string match} { run {string match *3*456*89 01234567890} } 0 test string-11.10.3.$noComp {string match} { run {string match **3*456*89 01234567890} } 0 test string-11.10.4.$noComp {string match} { run {string match *3*456***89 01234567890} } 0 test string-11.11.$noComp {string match} { run {string match a?c abc} } 1 test string-11.12.$noComp {string match} { run {string match a??c abc} } 0 test string-11.13.$noComp {string match} { run {string match ?1??4???8? 0123456789} } 1 test string-11.14.$noComp {string match} { run {string match {[abc]bc} abc} } 1 test string-11.15.$noComp {string match} { run {string match {a[abc]c} abc} } 1 test string-11.16.$noComp {string match} { run {string match {a[xyz]c} abc} } 0 test string-11.17.$noComp {string match} { run {string match {12[2-7]45} 12345} } 1 test string-11.18.$noComp {string match} { run {string match {12[ab2-4cd]45} 12345} } 1 test string-11.19.$noComp {string match} { run {string match {12[ab2-4cd]45} 12b45} } 1 test string-11.20.$noComp {string match} { run {string match {12[ab2-4cd]45} 12d45} } 1 test string-11.21.$noComp {string match} { run {string match {12[ab2-4cd]45} 12145} } 0 test string-11.22.$noComp {string match} { run {string match {12[ab2-4cd]45} 12545} } 0 test string-11.23.$noComp {string match} { run {string match {a\*b} a*b} } 1 test string-11.24.$noComp {string match} { run {string match {a\*b} ab} } 0 test string-11.25.$noComp {string match} { run {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"} } 1 test string-11.26.$noComp {string match} { run {string match ** ""} } 1 test string-11.27.$noComp {string match} { run {string match *. ""} } 0 test string-11.28.$noComp {string match} { run {string match "" ""} } 1 test string-11.29.$noComp {string match} { run {string match \[a a} } 1 test string-11.30.$noComp {string match, bad args} { list [catch {run {string match - b c}} msg] $msg } {1 {bad option "-": must be -nocase}} test string-11.31.$noComp {string match case} { run {string match a A} } 0 test string-11.32.$noComp {string match nocase} { run {string match -n a A} } 1 test string-11.33.$noComp {string match nocase} { run {string match -nocase a\334 A\374} } 1 test string-11.34.$noComp {string match nocase} { run {string match -nocase a*f ABCDEf} } 1 test string-11.35.$noComp {string match case, false hope} { # This is true because '_' lies between the A-Z and a-z ranges run {string match {[A-z]} _} } 1 test string-11.36.$noComp {string match nocase range} { # This is false because although '_' lies between the A-Z and a-z ranges, # we lower case the end points before checking the ranges. run {string match -nocase {[A-z]} _} } 0 test string-11.37.$noComp {string match nocase} { run {string match -nocase {[A-fh-Z]} g} } 0 test string-11.38.$noComp {string match case, reverse range} { run {string match {[A-fh-Z]} g} } 1 test string-11.39.$noComp {string match, *\ case} { run {string match {*\abc} abc} } 1 test string-11.39.1.$noComp {string match, *\ case} { run {string match {*ab\c} abc} } 1 test string-11.39.2.$noComp {string match, *\ case} { run {string match {*ab\*} ab*} } 1 test string-11.39.3.$noComp {string match, *\ case} { run {string match {*ab\*} abc} } 0 test string-11.39.4.$noComp {string match, *\ case} { run {string match {*ab\\*} {ab\c}} } 1 test string-11.39.5.$noComp {string match, *\ case} { run {string match {*ab\\*} {ab\*}} } 1 test string-11.40.$noComp {string match, *special case} { run {string match {*[ab]} abc} } 0 test string-11.41.$noComp {string match, *special case} { run {string match {*[ab]*} abc} } 1 test string-11.42.$noComp {string match, *special case} { run {string match "*\\" "\\"} } 0 test string-11.43.$noComp {string match, *special case} { run {string match "*\\\\" "\\"} } 1 test string-11.44.$noComp {string match, *special case} { run {string match "*???" "12345"} } 1 test string-11.45.$noComp {string match, *special case} { run {string match "*???" "12"} } 0 test string-11.46.$noComp {string match, *special case} { run {string match "*\\*" "abc*"} } 1 test string-11.47.$noComp {string match, *special case} { run {string match "*\\*" "*"} } 1 test string-11.48.$noComp {string match, *special case} { run {string match "*\\*" "*abc"} } 0 test string-11.49.$noComp {string match, *special case} { run {string match "?\\*" "a*"} } 1 test string-11.50.$noComp {string match, *special case} { run {string match "\\" "\\"} } 0 test string-11.51.$noComp {string match; *, -nocase and UTF-8} { run {string match -nocase [binary format I 717316707] \ [binary format I 2028036707]} } 1 test string-11.52.$noComp {string match, null char in string} { set out "" set ptn "*abc*" foreach elem [list "\x00@abc" "@abc" "\x00@abc\x00" "blahabcblah"] { lappend out [run {string match $ptn $elem}] } set out } {1 1 1 1} test string-11.53.$noComp {string match, null char in pattern} { set out "" foreach {ptn elem} [list \ "*\x00abc\x00" "\x00abc\x00" \ "*\x00abc\x00" "\x00abc\x00ef" \ "*\x00abc\x00*" "\x00abc\x00ef" \ "*\x00abc\x00" "@\x00abc\x00ef" \ "*\x00abc\x00*" "@\x00abc\x00ef" \ ] { lappend out [run {string match $ptn $elem}] } set out } {1 0 1 0 1} test string-11.54.$noComp {string match, failure} { set longString "" for {set i 0} {$i < 10} {incr i} { append longString "abcdefghijklmnopqrstuvwxy\x00z01234567890123" } run {string first $longString 123} list [run {string match *cba* $longString}] \ [run {string match *a*l*\x00* $longString}] \ [run {string match *a*l*\x00*123 $longString}] \ [run {string match *a*l*\x00*123* $longString}] \ [run {string match *a*l*\x00*cba* $longString}] \ [run {string match *===* $longString}] } {0 1 1 1 0 0} test string-11.55.$noComp {string match, invalid binary optimization} { [format string] match \u0141 [binary format c 65] } 0 test string-12.1.$noComp {string range} { list [catch {run {string range}} msg] $msg } {1 {wrong # args: should be "string range string first last"}} test string-12.2.$noComp {string range} { list [catch {run {string range a 1}} msg] $msg } {1 {wrong # args: should be "string range string first last"}} test string-12.3.$noComp {string range} { list [catch {run {string range a 1 2 3}} msg] $msg } {1 {wrong # args: should be "string range string first last"}} test string-12.4.$noComp {string range} { run {string range abcdefghijklmnop 2 14} } {cdefghijklmno} test string-12.5.$noComp {string range, last > length} { run {string range abcdefghijklmnop 7 1000} } {hijklmnop} test string-12.6.$noComp {string range} { run {string range abcdefghijklmnop 10 end} } {klmnop} test string-12.7.$noComp {string range, last < first} { run {string range abcdefghijklmnop 10 9} } {} test string-12.8.$noComp {string range, first < 0} { run {string range abcdefghijklmnop -3 2} } {abc} test string-12.9.$noComp {string range} { run {string range abcdefghijklmnop -3 -2} } {} test string-12.10.$noComp {string range} { run {string range abcdefghijklmnop 1000 1010} } {} test string-12.11.$noComp {string range} { run {string range abcdefghijklmnop -100 end} } {abcdefghijklmnop} test string-12.12.$noComp {string range} { list [catch {run {string range abc abc 1}} msg] $msg } {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} test string-12.13.$noComp {string range} { list [catch {run {string range abc 1 eof}} msg] $msg } {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} test string-12.14.$noComp {string range} { run {string range abcdefghijklmnop end-1 end} } {op} test string-12.15.$noComp {string range} { run {string range abcdefghijklmnop end 1000} } {p} test string-12.16.$noComp {string range} { run {string range abcdefghijklmnop end end-1} } {} test string-12.17.$noComp {string range, unicode} { run {string range ab\u7266cdefghijklmnop 5 5} } e test string-12.18.$noComp {string range, unicode} { run {string range ab\u7266cdefghijklmnop 2 3} } \u7266c test string-12.19.$noComp {string range, bytearray object} { set b [binary format I* {0x50515253 0x52}] set r1 [run {string range $b 1 end-1}] set r2 [run {string range $b 1 6}] run {string equal $r1 $r2} } 1 test string-12.20.$noComp {string range, out of bounds indices} { run {string range \xFF 0 1} } \xFF # Bug 1410553 test string-12.21.$noComp {string range, regenerates correct reps, bug 1410553} { set bytes "\x00 \x03 \x41" set rxBuffer {} foreach ch $bytes { append rxBuffer $ch if {$ch eq "\x03"} { run {string length $rxBuffer} } } set rxCRC [run {string range $rxBuffer end-1 end}] binary scan [join $bytes {}] "H*" input_hex binary scan $rxBuffer "H*" rxBuffer_hex binary scan $rxCRC "H*" rxCRC_hex list $input_hex $rxBuffer_hex $rxCRC_hex } {000341 000341 0341} test string-12.22.$noComp {string range, shimmering binary/index} { set s 0000000001 binary scan $s a* x run {string range $s $s end} } 000000001 test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} utf16 { run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]} } [list \U100000 {} b] test string-13.1.$noComp {string repeat} { list [catch {run {string repeat}} msg] $msg } {1 {wrong # args: should be "string repeat string count"}} test string-13.2.$noComp {string repeat} { list [catch {run {string repeat abc 10 oops}} msg] $msg } {1 {wrong # args: should be "string repeat string count"}} test string-13.3.$noComp {string repeat} { run {string repeat {} 100} } {} test string-13.4.$noComp {string repeat} { run {string repeat { } 5} } { } test string-13.5.$noComp {string repeat} { run {string repeat abc 3} } {abcabcabc} test string-13.6.$noComp {string repeat} { run {string repeat abc -1} } {} test string-13.7.$noComp {string repeat} { list [catch {run {string repeat abc end}} msg] $msg } {1 {expected integer but got "end"}} test string-13.8.$noComp {string repeat} { run {string repeat {} -1000} } {} test string-13.9.$noComp {string repeat} { run {string repeat {} 0} } {} test string-13.10.$noComp {string repeat} { run {string repeat def 0} } {} test string-13.11.$noComp {string repeat} { run {string repeat def 1} } def test string-13.12.$noComp {string repeat} { run {string repeat ab\u7266cd 3} } ab\u7266cdab\u7266cdab\u7266cd test string-13.13.$noComp {string repeat} { run {string repeat \x00 3} } \x00\x00\x00 test string-13.14.$noComp {string repeat} { # The string range will ensure us that string repeat gets a unicode string run {string repeat [run {string range ab\u7266cd 2 3}] 3} } \u7266c\u7266c\u7266c test string-14.1.$noComp {string replace} { list [catch {run {string replace}} msg] $msg } {1 {wrong # args: should be "string replace string first last ?string?"}} test string-14.2.$noComp {string replace} { list [catch {run {string replace a 1}} msg] $msg } {1 {wrong # args: should be "string replace string first last ?string?"}} test string-14.3.$noComp {string replace} { list [catch {run {string replace a 1 2 3 4}} msg] $msg } {1 {wrong # args: should be "string replace string first last ?string?"}} test string-14.4.$noComp {string replace} { } {} test string-14.5.$noComp {string replace} { run {string replace abcdefghijklmnop 2 14} } {abp} test string-14.6.$noComp {string replace} -body { run {string replace abcdefghijklmnop 7 1000} } -result abcdefg test string-14.7.$noComp {string replace} { run {string replace abcdefghijklmnop 10 end} } abcdefghij test string-14.8.$noComp {string replace} { run {string replace abcdefghijklmnop 10 9} } abcdefghijklmnop test string-14.9.$noComp {string replace} { run {string replace abcdefghijklmnop -3 2} } defghijklmnop test string-14.10.$noComp {string replace} { run {string replace abcdefghijklmnop -3 -2} } abcdefghijklmnop test string-14.11.$noComp {string replace} -body { run {string replace abcdefghijklmnop 1000 1010} } -result abcdefghijklmnop test string-14.12.$noComp {string replace} { run {string replace abcdefghijklmnop -100 end} } {} test string-14.13.$noComp {string replace} { list [catch {run {string replace abc abc 1}} msg] $msg } {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} test string-14.14.$noComp {string replace} { list [catch {run {string replace abc 1 eof}} msg] $msg } {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} test string-14.15.$noComp {string replace} { run {string replace abcdefghijklmnop end-10 end-2 NEW} } {abcdeNEWop} test string-14.16.$noComp {string replace} { run {string replace abcdefghijklmnop 0 end foo} } {foo} test string-14.17.$noComp {string replace} { run {string replace abcdefghijklmnop end end-1} } {abcdefghijklmnop} test string-14.18.$noComp {string replace} { run {string replace abcdefghijklmnop 10 9 XXX} } {abcdefghijklmnop} test string-14.19.$noComp {string replace} { run {string replace {} -1 0 A} } A test string-15.1.$noComp {string tolower not enough args} { list [catch {run {string tolower}} msg] $msg } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} test string-15.2.$noComp {string tolower bad args} { list [catch {run {string tolower a b}} msg] $msg } {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-15.3.$noComp {string tolower too many args} { list [catch {run {string tolower ABC 1 end oops}} msg] $msg } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} test string-15.4.$noComp {string tolower} { run {string tolower ABCDeF} } {abcdef} test string-15.5.$noComp {string tolower} { run {string tolower "ABC XyZ"} } {abc xyz} test string-15.6.$noComp {string tolower} { run {string tolower {123#$&*()}} } {123#$&*()} test string-15.7.$noComp {string tolower} { run {string tolower ABC 1} } AbC test string-15.8.$noComp {string tolower} { run {string tolower ABC 1 end} } Abc test string-15.9.$noComp {string tolower} { run {string tolower ABC 0 end-1} } abC test string-15.10.$noComp {string tolower, unicode} { run {string tolower ABCabc\xC7\xE7} } "abcabc\xE7\xE7" test string-15.11.$noComp {string tolower, compiled} { lindex [run {string tolower [list A B [list C]]}] 1 } b test string-16.1.$noComp {string toupper} { list [catch {run {string toupper}} msg] $msg } {1 {wrong # args: should be "string toupper string ?first? ?last?"}} test string-16.2.$noComp {string toupper} { list [catch {run {string toupper a b}} msg] $msg } {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-16.3.$noComp {string toupper} { list [catch {run {string toupper a 1 end oops}} msg] $msg } {1 {wrong # args: should be "string toupper string ?first? ?last?"}} test string-16.4.$noComp {string toupper} { run {string toupper abCDEf} } {ABCDEF} test string-16.5.$noComp {string toupper} { run {string toupper "abc xYz"} } {ABC XYZ} test string-16.6.$noComp {string toupper} { run {string toupper {123#$&*()}} } {123#$&*()} test string-16.7.$noComp {string toupper} { run {string toupper abc 1} } aBc test string-16.8.$noComp {string toupper} { run {string toupper abc 1 end} } aBC test string-16.9.$noComp {string toupper} { run {string toupper abc 0 end-1} } ABc test string-16.10.$noComp {string toupper, unicode} { run {string toupper ABCabc\xC7\xE7} } "ABCABC\xC7\xC7" test string-16.11.$noComp {string toupper, compiled} { lindex [run {string toupper [list a b [list c]]}] 1 } B test string-17.1.$noComp {string totitle} { list [catch {run {string totitle}} msg] $msg } {1 {wrong # args: should be "string totitle string ?first? ?last?"}} test string-17.2.$noComp {string totitle} { list [catch {run {string totitle a b}} msg] $msg } {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-17.3.$noComp {string totitle} { run {string totitle abCDEf} } {Abcdef} test string-17.4.$noComp {string totitle} { run {string totitle "abc xYz"} } {Abc xyz} test string-17.5.$noComp {string totitle} { run {string totitle {123#$&*()}} } {123#$&*()} test string-17.6.$noComp {string totitle, unicode} { run {string totitle ABCabc\xC7\xE7} } "Abcabc\xE7\xE7" test string-17.7.$noComp {string totitle, unicode} { run {string totitle \u01F3BCabc\xC7\xE7} } "\u01F2bcabc\xE7\xE7" test string-17.8.$noComp {string totitle, compiled} { lindex [run {string totitle [list aa bb [list cc]]}] 0 } Aa test string-18.1.$noComp {string trim} { list [catch {run {string trim}} msg] $msg } {1 {wrong # args: should be "string trim string ?chars?"}} test string-18.2.$noComp {string trim} { list [catch {run {string trim a b c}} msg] $msg } {1 {wrong # args: should be "string trim string ?chars?"}} test string-18.3.$noComp {string trim} { run {string trim " XYZ "} } {XYZ} test string-18.4.$noComp {string trim} { run {string trim "\t\nXYZ\t\n\r\n"} } {XYZ} test string-18.5.$noComp {string trim} { run {string trim " A XYZ A "} } {A XYZ A} test string-18.6.$noComp {string trim} { run {string trim "XXYYZZABC XXYYZZ" ZYX} } {ABC } test string-18.7.$noComp {string trim} { run {string trim " \t\r "} } {} test string-18.8.$noComp {string trim} { run {string trim {abcdefg} {}} } {abcdefg} test string-18.9.$noComp {string trim} { run {string trim {}} } {} test string-18.10.$noComp {string trim} { run {string trim ABC DEF} } {ABC} test string-18.11.$noComp {string trim, unicode} { run {string trim "\xE7\xE8 AB\xE7C \xE8\xE7" \xE7\xE8} } " AB\xE7C " test string-18.12.$noComp {string trim, unicode default} { run {string trim \uFEFF\x00\x85\xA0\u1680\u180EABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} } ABC\u1361 test string-19.1.$noComp {string trimleft} { list [catch {run {string trimleft}} msg] $msg } {1 {wrong # args: should be "string trimleft string ?chars?"}} test string-19.2.$noComp {string trimleft} { run {string trimleft " XYZ "} } {XYZ } test string-19.3.$noComp {string trimleft, unicode default} { run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC} } \u1361ABC test string-20.1.$noComp {string trimright errors} { list [catch {run {string trimright}} msg] $msg } {1 {wrong # args: should be "string trimright string ?chars?"}} test string-20.2.$noComp {string trimright errors} -body { list [catch {run {string trimg a}} msg] $msg } -result {1 {unknown or ambiguous subcommand "trimg": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-20.3.$noComp {string trimright} { run {string trimright " XYZ "} } { XYZ} test string-20.4.$noComp {string trimright} { run {string trimright " "} } {} test string-20.5.$noComp {string trimright} { run {string trimright ""} } {} test string-20.6.$noComp {string trimright, unicode default} { run {string trimright ABC\u1361\x85\x00\xA0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} } ABC\u1361 test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} testbytestring { set result {} set a [testbytestring \xC0\x80\xA0] set b foo$a set m [list \x00 U \xA0 V [testbytestring \xA0] W] lappend result [string map $m $b] lappend result [string map $m [run {string trimright $b x}]] lappend result [string map $m [run {string trimright $b \x00}]] lappend result [string map $m [run {string trimleft $b fox}]] lappend result [string map $m [run {string trimleft $b fo\x00}]] lappend result [string map $m [run {string trim $b fox}]] lappend result [string map $m [run {string trim $b fo\x00}]] } [list {*}[lrepeat 3 fooUV] {*}[lrepeat 2 UV V]] test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is ok} testbytestring { set result {} set a [testbytestring \xE8\xA0] set b foo$a set m [list \xE8 U \xA0 V [testbytestring \xE8] W [testbytestring \xA0] X]] lappend result [string map $m $b] lappend result [string map $m [run {string trimright $b x}]] lappend result [string map $m [run {string trimright $b \xE8}]] lappend result [string map $m [run {string trimright $b [bytestring \xE8]}]] lappend result [string map $m [run {string trimright $b \xA0}]] lappend result [string map $m [run {string trimright $b [bytestring \xA0]}]] lappend result [string map $m [run {string trimright $b \xE8\xA0}]] lappend result [string map $m [run {string trimright $b [bytestring \xE8\xA0]}]] lappend result [string map $m [run {string trimright $b \x00}]] } [list {*}[lrepeat 4 fooUV] {*}[lrepeat 2 fooU] {*}[lrepeat 2 foo] fooUV] test string-21.1.$noComp {string wordend} -body { list [catch {run {string wordend a}} msg] $msg } -result {1 {wrong # args: should be "string wordend string index"}} test string-21.2.$noComp {string wordend} -body { list [catch {run {string wordend a b c}} msg] $msg } -result {1 {wrong # args: should be "string wordend string index"}} test string-21.3.$noComp {string wordend} -body { list [catch {run {string wordend a gorp}} msg] $msg } -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} test string-21.4.$noComp {string wordend} -body { run {string wordend abc. -1} } -result 3 test string-21.5.$noComp {string wordend} -body { run {string wordend abc. 100} } -result 4 test string-21.6.$noComp {string wordend} -body { run {string wordend "word_one two three" 2} } -result 8 test string-21.7.$noComp {string wordend} -body { run {string wordend "one .&# three" 5} } -result 6 test string-21.8.$noComp {string wordend} -body { run {string worde "x.y" 0} } -result 1 test string-21.9.$noComp {string wordend} -body { run {string worde "x.y" end-1} } -result 2 test string-21.10.$noComp {string wordend, unicode} -body { run {string wordend "xyz\xC7de fg" 0} } -result 6 test string-21.11.$noComp {string wordend, unicode} -body { run {string wordend "xyz\uC700de fg" 0} } -result 6 test string-21.12.$noComp {string wordend, unicode} -body { run {string wordend "xyz\u203Fde fg" 0} } -result 6 test string-21.13.$noComp {string wordend, unicode} -body { run {string wordend "xyz\u2045de fg" 0} } -result 3 test string-21.14.$noComp {string wordend, unicode} -body { run {string wordend "\uC700\uC700 abc" 8} } -result 6 test string-21.17.$noComp {string trim, unicode} { run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} } "Hello world!" test string-21.18.$noComp {string trimleft, unicode} { run {string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} } "Hello world!\uD83D\uDE02" test string-21.19.$noComp {string trimright, unicode} { run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} } "\uD83D\uDE02Hello world!" test string-21.20.$noComp {string trim, unicode} { run {string trim "\uF602Hello world!\uF602" \uD83D\uDE02} } "\uF602Hello world!\uF602" test string-21.21.$noComp {string trimleft, unicode} { run {string trimleft "\uF602Hello world!\uF602" \uD83D\uDE02} } "\uF602Hello world!\uF602" test string-21.22.$noComp {string trimright, unicode} { run {string trimright "\uF602Hello world!\uF602" \uD83D\uDE02} } "\uF602Hello world!\uF602" test string-21.23.$noComp {string trim, unicode} { run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} } "\uD83D\uDE02Hello world!\uD83D\uDE02" test string-21.24.$noComp {string trimleft, unicode} { run {string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} } "\uD83D\uDE02Hello world!\uD83D\uDE02" test string-21.25.$noComp {string trimright, unicode} { run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} } "\uD83D\uDE02Hello world!\uD83D\uDE02" test string-22.1.$noComp {string wordstart} -body { list [catch {run {string word a}} msg] $msg } -result {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-22.2.$noComp {string wordstart} -body { list [catch {run {string wordstart a}} msg] $msg } -result {1 {wrong # args: should be "string wordstart string index"}} test string-22.3.$noComp {string wordstart} -body { list [catch {run {string wordstart a b c}} msg] $msg } -result {1 {wrong # args: should be "string wordstart string index"}} test string-22.4.$noComp {string wordstart} -body { list [catch {run {string wordstart a gorp}} msg] $msg } -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} test string-22.5.$noComp {string wordstart} -body { run {string wordstart "one two three_words" 400} } -result 8 test string-22.6.$noComp {string wordstart} -body { run {string wordstart "one two three_words" 2} } -result 0 test string-22.7.$noComp {string wordstart} -body { run {string wordstart "one two three_words" -2} } -result 0 test string-22.8.$noComp {string wordstart} -body { run {string wordstart "one .*&^ three" 6} } -result 6 test string-22.9.$noComp {string wordstart} -body { run {string wordstart "one two three" 4} } -result 4 test string-22.10.$noComp {string wordstart} -body { run {string wordstart "one two three" end-5} } -result 7 test string-22.11.$noComp {string wordstart, unicode} -body { run {string wordstart "one tw\xC7o three" 7} } -result 4 test string-22.12.$noComp {string wordstart, unicode} -body { run {string wordstart "ab\uC700\uC700 cdef ghi" 12} } -result 10 test string-22.13.$noComp {string wordstart, unicode} -body { run {string wordstart "\uC700\uC700 abc" 8} } -result 3 test string-22.14.$noComp {string wordstart, invalid UTF-8} -constraints testbytestring -body { # See Bug c61818e4c9 set demo [testbytestring "abc def\xE0\xA9ghi"] run {string index $demo [string wordstart $demo 10]} } -result g test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj { set x 5 catch {testindexobj $x foo bar soom} run {string is boolean $x} } 0 test string-23.1.$noComp {string is command with empty string} { set s "" list \ [run {string is alnum $s}] \ [run {string is alpha $s}] \ [run {string is ascii $s}] \ [run {string is control $s}] \ [run {string is boolean $s}] \ [run {string is digit $s}] \ [run {string is double $s}] \ [run {string is false $s}] \ [run {string is graph $s}] \ [run {string is integer $s}] \ [run {string is lower $s}] \ [run {string is print $s}] \ [run {string is punct $s}] \ [run {string is space $s}] \ [run {string is true $s}] \ [run {string is upper $s}] \ [run {string is wordchar $s}] \ [run {string is xdigit $s}] \ } {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1} test string-23.2.$noComp {string is command with empty string} { set s "" list \ [run {string is alnum -strict $s}] \ [run {string is alpha -strict $s}] \ [run {string is ascii -strict $s}] \ [run {string is control -strict $s}] \ [run {string is boolean -strict $s}] \ [run {string is digit -strict $s}] \ [run {string is double -strict $s}] \ [run {string is false -strict $s}] \ [run {string is graph -strict $s}] \ [run {string is integer -strict $s}] \ [run {string is lower -strict $s}] \ [run {string is print -strict $s}] \ [run {string is punct -strict $s}] \ [run {string is space -strict $s}] \ [run {string is true -strict $s}] \ [run {string is upper -strict $s}] \ [run {string is wordchar -strict $s}] \ [run {string is xdigit -strict $s}] \ } {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} test string-24.1.$noComp {string reverse command} -body { run {string reverse} } -returnCodes error -result "wrong # args: should be \"string reverse string\"" test string-24.2.$noComp {string reverse command} -body { run {string reverse a b} } -returnCodes error -result "wrong # args: should be \"string reverse string\"" test string-24.3.$noComp {string reverse command - shared string} { set x abcde run {string reverse $x} } edcba test string-24.4.$noComp {string reverse command - unshared string} { set x abc set y de run {string reverse $x$y} } edcba test string-24.5.$noComp {string reverse command - shared unicode string} { set x abcde\uD0AD run {string reverse $x} } \uD0ADedcba test string-24.6.$noComp {string reverse command - unshared string} { set x abc set y de\uD0AD run {string reverse $x$y} } \uD0ADedcba test string-24.7.$noComp {string reverse command - simple case} { run {string reverse a} } a test string-24.8.$noComp {string reverse command - simple case} { run {string reverse \uD0AD} } \uD0AD test string-24.9.$noComp {string reverse command - simple case} { run {string reverse {}} } {} test string-24.10.$noComp {string reverse command - corner case} { set x \uBEEF\uD0AD run {string reverse $x} } \uD0AD\uBEEF test string-24.11.$noComp {string reverse command - corner case} { set x \uBEEF set y \uD0AD run {string reverse $x$y} } \uD0AD\uBEEF test string-24.12.$noComp {string reverse command - corner case} { set x \uBEEF set y \uD0AD run {string is ascii [run {string reverse $x$y}]} } 0 test string-24.13.$noComp {string reverse command - pure Unicode string} { run {string reverse [run {string range \uBEEF\uD0AD\uBEEF\uD0AD\uBEEF\uD0AD 1 5}]} } \uD0AD\uBEEF\uD0AD\uBEEF\uD0AD test string-24.14.$noComp {string reverse command - pure bytearray} { binary scan [run {string reverse [binary format H* 010203]}] H* x set x } 030201 test string-24.15.$noComp {string reverse command - pure bytearray} { binary scan [run {tcl::string::reverse [binary format H* 010203]}] H* x set x } 030201 test string-24.16.$noComp {string reverse command - surrogates} { run {string reverse \u0444bulb\uD83D\uDE02} } \uD83D\uDE02blub\u0444 test string-24.17.$noComp {string reverse command - surrogates} { run {string reverse \uD83D\uDE02hello\uD83D\uDE02} } \uD83D\uDE02olleh\uD83D\uDE02 test string-24.18.$noComp {string reverse command - surrogates} { set s \u0444bulb\uD83D\uDE02 # shim shimmery ... string index $s 0 run {string reverse $s} } \uD83D\uDE02blub\u0444 test string-24.19.$noComp {string reverse command - surrogates} { set s \uD83D\uDE02hello\uD83D\uDE02 # shim shimmery ... string index $s 0 run {string reverse $s} } \uD83D\uDE02olleh\uD83D\uDE02 test string-25.1.$noComp {string is list} { run {string is list {a b c}} } 1 test string-25.2.$noComp {string is list} { run {string is list "a \{b c"} } 0 test string-25.3.$noComp {string is list} { run {string is list {a {b c}d e}} } 0 test string-25.4.$noComp {string is list} { run {string is list {}} } 1 test string-25.5.$noComp {string is list} { run {string is list -strict {a b c}} } 1 test string-25.6.$noComp {string is list} { run {string is list -strict "a \{b c"} } 0 test string-25.7.$noComp {string is list} { run {string is list -strict {a {b c}d e}} } 0 test string-25.8.$noComp {string is list} { run {string is list -strict {}} } 1 test string-25.9.$noComp {string is list} { set x {} list [run {string is list -failindex x {a b c}}] $x } {1 {}} test string-25.10.$noComp {string is list} { set x {} list [run {string is list -failindex x "a \{b c"}] $x } {0 2} test string-25.11.$noComp {string is list} { set x {} list [run {string is list -failindex x {a b {b c}d e}}] $x } {0 4} test string-25.12.$noComp {string is list} { set x {} list [run {string is list -failindex x {}}] $x } {1 {}} test string-25.13.$noComp {string is list} { set x {} list [run {string is list -failindex x { {b c}d e}}] $x } {0 2} test string-25.14.$noComp {string is list} { set x {} list [run {string is list -failindex x "\uABCD {b c}d e"}] $x } {0 2} test string-26.1.$noComp {tcl::prefix, not enough args} -body { tcl::prefix match a } -returnCodes 1 -result {wrong # args: should be "tcl::prefix match ?options? table string"} test string-26.2.$noComp {tcl::prefix, bad args} -body { tcl::prefix match a b c } -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message} test string-26.2.1.$noComp {tcl::prefix, empty table} -body { tcl::prefix match {} foo } -returnCodes 1 -result {bad option "foo": no valid options} test string-26.3.$noComp {tcl::prefix, bad args} -body { tcl::prefix match -error "{}x" -exact str1 str2 } -returnCodes 1 -result {list element in braces followed by "x" instead of space} test string-26.3.1.$noComp {tcl::prefix, bad args} -body { tcl::prefix match -error "x" -exact str1 str2 } -returnCodes 1 -result {error options must have an even number of elements} test string-26.3.2.$noComp {tcl::prefix, bad args} -body { tcl::prefix match -error str1 str2 } -returnCodes 1 -result {missing value for -error} test string-26.4.$noComp {tcl::prefix, bad args} -body { tcl::prefix match -message str1 str2 } -returnCodes 1 -result {missing value for -message} test string-26.5.$noComp {tcl::prefix} { tcl::prefix match {apa bepa cepa depa} cepa } cepa test string-26.6.$noComp {tcl::prefix} { tcl::prefix match {apa bepa cepa depa} be } bepa test string-26.7.$noComp {tcl::prefix} -body { tcl::prefix match -exact {apa bepa cepa depa} be } -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa} test string-26.8.$noComp {tcl::prefix} -body { tcl::prefix match -message wombat {apa bepa bear depa} be } -returnCodes 1 -result {ambiguous wombat "be": must be apa, bepa, bear, or depa} test string-26.9.$noComp {tcl::prefix} -body { tcl::prefix match -error {} {apa bepa bear depa} be } -returnCodes 0 -result {} test string-26.10.$noComp {tcl::prefix} -body { tcl::prefix match -error {-level 1} {apa bepa bear depa} be } -returnCodes 2 -result {ambiguous option "be": must be apa, bepa, bear, or depa} test string-26.10.1.$noComp {tcl::prefix} -setup { proc _testprefix {args} { array set opts {-a x -b y -c y} foreach {opt val} $args { set opt [tcl::prefix match -error {-level 1} {-a -b -c} $opt] set opts($opt) $val } array get opts } } -body { set a [catch {_testprefix -x u} result options] dict get $options -errorinfo } -cleanup { rename _testprefix {} } -result {bad option "-x": must be -a, -b, or -c while executing "_testprefix -x u"} # Helper for memory stress tests # Repeat each body in a local space checking that memory does not increase proc MemStress {args} { set res {} foreach body $args { set end 0 for {set i 0} {$i < 5} {incr i} { proc MemStress_Body {} $body uplevel 1 MemStress_Body rename MemStress_Body {} set tmp $end set end [lindex [lindex [split [memory info] "\n"] 3] 3] } lappend res [expr {$end - $tmp}] } return $res } test string-26.11.$noComp {tcl::prefix: testing for leaks} -body { # This test is made to stress object reference management MemStress { set table {hejj miff gurk} set item [lindex $table 1] # If not careful, this can cause a circular reference # that will cause a leak. tcl::prefix match $table $item } { # A similar case with nested lists set table2 {hejj {miff maff} gurk} set item [lindex [lindex $table2 1] 0] tcl::prefix match $table2 $item } { # A similar case with dict set table3 {hejj {miff maff} gurk2} set item [lindex [dict keys [lindex $table3 1]] 0] tcl::prefix match $table3 $item } } -constraints memory -result {0 0 0} test string-26.12.$noComp {tcl::prefix: testing for leaks} -body { # This is a memory leak test in a form that might actually happen # in real code. The shared literal "miff" causes a connection # between the item and the table. MemStress { proc stress1 {item} { set table [list hejj miff gurk] tcl::prefix match $table $item } proc stress2 {} { stress1 miff } stress2 rename stress1 {} rename stress2 {} } } -constraints memory -result 0 test string-26.13.$noComp {tcl::prefix: testing for leaks} -body { # This test is made to stress object reference management MemStress { set table [list hejj miff] set item $table set error $table # Use the same objects in all places catch { tcl::prefix match -error $error $table $item } } } -constraints memory -result {0} test string-27.1.$noComp {tcl::prefix all, not enough args} -body { tcl::prefix all a } -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"} test string-27.2.$noComp {tcl::prefix all, bad args} -body { tcl::prefix all a b c } -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"} test string-27.3.$noComp {tcl::prefix all, bad args} -body { tcl::prefix all "{}x" str2 } -returnCodes 1 -result {list element in braces followed by "x" instead of space} test string-27.4.$noComp {tcl::prefix all} { tcl::prefix all {apa bepa cepa depa} c } cepa test string-27.5.$noComp {tcl::prefix all} { tcl::prefix all {apa bepa cepa depa} cepa } cepa test string-27.6.$noComp {tcl::prefix all} { tcl::prefix all {apa bepa cepa depa} cepax } {} test string-27.7.$noComp {tcl::prefix all} { tcl::prefix all {apa aska appa} a } {apa aska appa} test string-27.8.$noComp {tcl::prefix all} { tcl::prefix all {apa aska appa} ap } {apa appa} test string-27.9.$noComp {tcl::prefix all} { tcl::prefix all {apa aska appa} p } {} test string-27.10.$noComp {tcl::prefix all} { tcl::prefix all {apa aska appa} {} } {apa aska appa} test string-28.1.$noComp {tcl::prefix longest, not enough args} -body { tcl::prefix longest a } -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"} test string-28.2.$noComp {tcl::prefix longest, bad args} -body { tcl::prefix longest a b c } -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"} test string-28.3.$noComp {tcl::prefix longest, bad args} -body { tcl::prefix longest "{}x" str2 } -returnCodes 1 -result {list element in braces followed by "x" instead of space} test string-28.4.$noComp {tcl::prefix longest} { tcl::prefix longest {apa bepa cepa depa} c } cepa test string-28.5.$noComp {tcl::prefix longest} { tcl::prefix longest {apa bepa cepa depa} cepa } cepa test string-28.6.$noComp {tcl::prefix longest} { tcl::prefix longest {apa bepa cepa depa} cepax } {} test string-28.7.$noComp {tcl::prefix longest} { tcl::prefix longest {apa aska appa} a } a test string-28.8.$noComp {tcl::prefix longest} { tcl::prefix longest {apa aska appa} ap } ap test string-28.9.$noComp {tcl::prefix longest} { tcl::prefix longest {apa bska appa} a } ap test string-28.10.$noComp {tcl::prefix longest} { tcl::prefix longest {apa bska appa} {} } {} test string-28.11.$noComp {tcl::prefix longest} { tcl::prefix longest {{} bska appa} {} } {} test string-28.12.$noComp {tcl::prefix longest} { tcl::prefix longest {apa {} appa} {} } {} test string-28.13.$noComp {tcl::prefix longest} { # Test utf-8 handling tcl::prefix longest {ax\x90 bep ax\x91} a } ax test string-29.1.$noComp {string cat, no arg} { run {string cat} } "" test string-29.2.$noComp {string cat, single arg} { set x FOO run {string compare $x [run {string cat $x}]} } 0 test string-29.3.$noComp {string cat, two args} { set x FOO run {string compare $x$x [run {string cat $x $x}]} } 0 test string-29.4.$noComp {string cat, many args} { set x FOO set n 260 set xx [run {string repeat $x $n}] set vv [run {string repeat {$x} $n}] set vvs [run {string repeat {$x } $n}] set r1 [run {string compare $xx [subst $vv]}] set r2 [run {string compare $xx [eval "run {string cat $vvs}"]}] list $r1 $r2 } {0 0} test string-30.1.1.$noComp {[Bug ba921a8d98]: string cat} { run {string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]} } hellohello test string-30.1.2.$noComp {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} { run {set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"} } hellohello }; # foreach noComp {0 1} # cleanup rename MemStress {} catch {rename foo {}} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/subst.test0000644000175000017500000002407314554262142015053 0ustar sergeisergei# Commands covered: subst # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.1 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testbytestring [llength [info commands testbytestring]] test subst-1.1 {basics} -returnCodes error -body { subst } -result {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"} test subst-1.2 {basics} -returnCodes error -body { subst a b c } -result {bad option "a": must be -nobackslashes, -nocommands, or -novariables} test subst-2.1 {simple strings} { subst {} } {} test subst-2.2 {simple strings} { subst a } a test subst-2.3 {simple strings} { subst abcdefg } abcdefg test subst-2.4 {simple strings} testbytestring { # Tcl Bug 685106 expr {[subst [testbytestring bar\x00soom]] eq [testbytestring bar\x00soom]} } 1 test subst-3.1 {backslash substitutions} { subst {\x\$x\[foo bar]\\} } "x\$x\[foo bar]\\" test subst-3.2 {backslash substitutions with utf chars} { # 'j' is just a char that doesn't mean anything, and \344 is 'УЄ' # that also doesn't mean anything, but is multi-byte in UTF-8. list [subst \j] [subst \\j] [subst \\344] [subst \\\344] } "j j \344 \344" test subst-4.1 {variable substitutions} { set a 44 subst {$a} } {44} test subst-4.2 {variable substitutions} { set a 44 subst {x$a.y{$a}.z} } {x44.y{44}.z} test subst-4.3 {variable substitutions} -setup { catch {unset a} } -body { set a(13) 82 set i 13 subst {x.$a($i)} } -result {x.82} catch {unset a} set long {This is a very long string, intentionally made so long that it will overflow the static character size for dstrings, so that additional memory will have to be allocated by subst. That way, if the subst procedure forgets to free up memory while returning an error, there will be memory that isn't freed (this will be detected when the tests are run under a checking memory allocator such as Purify).} test subst-4.4 {variable substitutions} -returnCodes error -body { subst {$long $a} } -result {can't read "a": no such variable} test subst-5.1 {command substitutions} { subst {[concat {}]} } {} test subst-5.2 {command substitutions} { subst {[concat A test string]} } {A test string} test subst-5.3 {command substitutions} { subst {x.[concat foo].y.[concat bar].z} } {x.foo.y.bar.z} test subst-5.4 {command substitutions} { list [catch {subst {$long [set long] [bogus_command]}} msg] $msg } {1 {invalid command name "bogus_command"}} test subst-5.5 {command substitutions} { set a 0 list [catch {subst {[set a 1}} msg] $a $msg } {1 0 {missing close-bracket}} test subst-5.6 {command substitutions} { set a 0 list [catch {subst {0[set a 1}} msg] $a $msg } {1 0 {missing close-bracket}} test subst-5.7 {command substitutions} { set a 0 list [catch {subst {0[set a 1; set a 2}} msg] $a $msg } {1 1 {missing close-bracket}} # repeat the tests above simulating cmd line input test subst-5.8 {command substitutions} { set script {[subst {[set a 1}]} list [catch {exec [info nameofexecutable] << $script} msg] $msg } {1 {missing close-bracket}} test subst-5.9 {command substitutions} { set script {[subst {0[set a 1}]} list [catch {exec [info nameofexecutable] << $script} msg] $msg } {1 {missing close-bracket}} test subst-5.10 {command substitutions} { set script {[subst {0[set a 1; set a 2}]} list [catch {exec [info nameofexecutable] << $script} msg] $msg } {1 {missing close-bracket}} test subst-6.1 {clear the result after command substitution} -body { catch {unset a} subst {[concat foo] $a} } -returnCodes error -result {can't read "a": no such variable} test subst-7.1 {switches} -returnCodes error -body { subst foo bar } -result {bad option "foo": must be -nobackslashes, -nocommands, or -novariables} test subst-7.2 {switches} -returnCodes error -body { subst -no bar } -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables} test subst-7.3 {switches} -returnCodes error -body { subst -bogus bar } -result {bad option "-bogus": must be -nobackslashes, -nocommands, or -novariables} test subst-7.4 {switches} { set x 123 subst -nobackslashes {abc $x [expr {1 + 2}] \\\x41} } {abc 123 3 \\\x41} test subst-7.5 {switches} { set x 123 subst -nocommands {abc $x [expr {1 + 2}] \\\x41} } {abc 123 [expr {1 + 2}] \A} test subst-7.6 {switches} { set x 123 subst -novariables {abc $x [expr {1 + 2}] \\\x41} } {abc $x 3 \A} test subst-7.7 {switches} { set x 123 subst -nov -nob -noc {abc $x [expr {1 + 2}] \\\x41} } {abc $x [expr {1 + 2}] \\\x41} test subst-8.1 {return in a subst} { subst {foo [return {x}; bogus code] bar} } {foo x bar} test subst-8.2 {return in a subst} { subst {foo [return x ; bogus code] bar} } {foo x bar} test subst-8.3 {return in a subst} { subst {foo [if 1 { return {x}; bogus code }] bar} } {foo x bar} test subst-8.4 {return in a subst} { subst {[eval {return hi}] there} } {hi there} test subst-8.5 {return in a subst} { subst {foo [return {]}; bogus code] bar} } {foo ] bar} test subst-8.6 {return in a subst} -returnCodes error -body { subst "foo \[return {x}; bogus code bar" } -result {missing close-bracket} test subst-8.7 {return in a subst, parse error} -body { subst {foo [return {x} ; set a {}"" ; stuff] bar} } -returnCodes error -result {extra characters after close-brace} test subst-8.8 {return in a subst, parse error} -body { subst {foo [return {x} ; set bar baz ; set a {}"" ; stuff] bar} } -returnCodes error -result {extra characters after close-brace} test subst-8.9 {return in a variable subst} { subst {foo $var([return {x}]) bar} } {foo x bar} test subst-9.1 {error in a subst} -body { subst {[error foo; bogus code]bar} } -returnCodes error -result foo test subst-9.2 {error in a subst} -body { subst {[if 1 { error foo; bogus code}]bar} } -returnCodes error -result foo test subst-9.3 {error in a variable subst} -setup { catch {unset var} } -body { subst {foo $var([error foo]) bar} } -returnCodes error -result foo test subst-10.1 {break in a subst} { subst {foo [break; bogus code] bar} } {foo } test subst-10.2 {break in a subst} { subst {foo [break; return x; bogus code] bar} } {foo } test subst-10.3 {break in a subst} { subst {foo [if 1 { break; bogus code}] bar} } {foo } test subst-10.4 {break in a subst, parse error} { subst {foo [break ; set a {}{} ; stuff] bar} } {foo } test subst-10.5 {break in a subst, parse error} { subst {foo [break ;set bar baz ;set a {}{} ; stuff] bar} } {foo } test subst-10.6 {break in a variable subst} { subst {foo $var([break]) bar} } {foo } test subst-11.1 {continue in a subst} { subst {foo [continue; bogus code] bar} } {foo bar} test subst-11.2 {continue in a subst} { subst {foo [continue; return x; bogus code] bar} } {foo bar} test subst-11.3 {continue in a subst} { subst {foo [if 1 { continue; bogus code}] bar} } {foo bar} test subst-11.4 {continue in a subst, parse error} -body { subst {foo [continue ; set a {}{} ; stuff] bar} } -returnCodes error -result {extra characters after close-brace} test subst-11.5 {continue in a subst, parse error} -body { subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar} } -returnCodes error -result {extra characters after close-brace} test subst-11.6 {continue in a variable subst} { subst {foo $var([continue]) bar} } {foo bar} test subst-12.1 {nasty case, Bug 1036649} { for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[subst {};"} msg] $msg] if {$msg ne "missing close-bracket"} break } return $res } {1 {missing close-bracket}} test subst-12.2 {nasty case, Bug 1036649} { for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[subst {}; "} msg] $msg] if {$msg ne "missing close-bracket"} break } return $res } {1 {missing close-bracket}} test subst-12.3 {nasty case, Bug 1036649} { set x 0 for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[incr x;"} msg] $msg] if {$msg ne "missing close-bracket"} break } lappend res $x } {1 {missing close-bracket} 10} test subst-12.4 {nasty case, Bug 1036649} { set x 0 for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[incr x; "} msg] $msg] if {$msg ne "missing close-bracket"} break } lappend res $x } {1 {missing close-bracket} 10} test subst-12.5 {nasty case, Bug 1036649} { set x 0 for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[incr x"} msg] $msg] if {$msg ne "missing close-bracket"} break } lappend res $x } {1 {missing close-bracket} 0} test subst-12.6 {nasty case with compilation} { set x unset set y unset list [eval [list subst {[set x 1;break;incr x][set y $x]}]] $x $y } {{} 1 unset} test subst-12.7 {nasty case with compilation} { set x unset set y unset list [eval [list subst {[set x 1;continue;incr x][set y $x]}]] $x $y } {1 1 1} test subst-13.1 {Bug 3081065} -setup { set script [makeFile { proc demo {string} { subst $string } demo name2 } subst13.tcl] } -body { interp create child child eval [list source $script] interp delete child interp create child child eval { set count 400 while {[incr count -1]} { lappend bloat [expr {rand()}] } } child eval [list source $script] interp delete child } -cleanup { removeFile subst13.tcl } test subst-13.2 {Test for segfault} -body { subst {[} } -returnCodes error -result * -match glob # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/switch.test0000644000175000017500000005321514554262142015214 0ustar sergeisergei# Commands covered: switch # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test switch-1.1 {simple patterns} { switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4} } 1 test switch-1.2 {simple patterns} { switch b a {subst 1} b {subst 2} c {subst 3} default {subst 4} } 2 test switch-1.3 {simple patterns} { switch x a {subst 1} b {subst 2} c {subst 3} default {subst 4} } 4 test switch-1.4 {simple patterns} { switch x a {subst 1} b {subst 2} c {subst 3} } {} test switch-1.5 {simple pattern matches many times} { switch b a {subst 1} b {subst 2} b {subst 3} b {subst 4} } 2 test switch-1.6 {simple patterns} { switch default a {subst 1} default {subst 2} c {subst 3} default {subst 4} } 2 test switch-1.7 {simple patterns} { switch x a {subst 1} default {subst 2} c {subst 3} default {subst 4} } 4 test switch-1.8 {simple patterns with -nocase} { switch -nocase b a {subst 1} b {subst 2} c {subst 3} default {subst 4} } 2 test switch-1.9 {simple patterns with -nocase} { switch -nocase B a {subst 1} b {subst 2} c {subst 3} default {subst 4} } 2 test switch-1.10 {simple patterns with -nocase} { switch -nocase b a {subst 1} B {subst 2} c {subst 3} default {subst 4} } 2 test switch-1.11 {simple patterns with -nocase} { switch -nocase x a {subst 1} default {subst 2} c {subst 3} default {subst 4} } 4 test switch-2.1 {single-argument form for pattern/command pairs} { switch b { a {subst 1} b {subst 2} default {subst 6} } } {2} test switch-2.2 {single-argument form for pattern/command pairs} -body { switch z {a 2 b} } -returnCodes error -result {extra switch pattern with no body} test switch-3.1 {-exact vs. -glob vs. -regexp} { switch -exact aaaab { ^a*b$ {subst regexp} *b {subst glob} aaaab {subst exact} default {subst none} } } exact test switch-3.2 {-exact vs. -glob vs. -regexp} { switch -regexp aaaab { ^a*b$ {subst regexp} *b {subst glob} aaaab {subst exact} default {subst none} } } regexp test switch-3.3 {-exact vs. -glob vs. -regexp} { switch -glob aaaab { ^a*b$ {subst regexp} *b {subst glob} aaaab {subst exact} default {subst none} } } glob test switch-3.4 {-exact vs. -glob vs. -regexp} { switch aaaab {^a*b$} {subst regexp} *b {subst glob} \ aaaab {subst exact} default {subst none} } exact test switch-3.5 {-exact vs. -glob vs. -regexp} { switch -- -glob { ^g.*b$ {subst regexp} -* {subst glob} -glob {subst exact} default {subst none} } } exact test switch-3.6 {-exact vs. -glob vs. -regexp} -body { switch -foo a b c } -returnCodes error -result {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --} test switch-3.7 {-exact vs. -glob vs. -regexp with -nocase} { switch -exact -nocase aaaab { ^a*b$ {subst regexp} *b {subst glob} aaaab {subst exact} default {subst none} } } exact test switch-3.8 {-exact vs. -glob vs. -regexp with -nocase} { switch -regexp -nocase aaaab { ^a*b$ {subst regexp} *b {subst glob} aaaab {subst exact} default {subst none} } } regexp test switch-3.9 {-exact vs. -glob vs. -regexp with -nocase} { switch -glob -nocase aaaab { ^a*b$ {subst regexp} *b {subst glob} aaaab {subst exact} default {subst none} } } glob test switch-3.10 {-exact vs. -glob vs. -regexp with -nocase} { switch -nocase aaaab {^a*b$} {subst regexp} *b {subst glob} \ aaaab {subst exact} default {subst none} } exact test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} { switch -nocase -- -glob { ^g.*b$ {subst regexp} -* {subst glob} -glob {subst exact} default {subst none} } } exact test switch-3.12 {-exact vs. -glob vs. -regexp} { switch -exa Foo Foo {set result OK} } OK test switch-3.13 {-exact vs. -glob vs. -regexp} { switch -gl Foo Fo? {set result OK} } OK test switch-3.14 {-exact vs. -glob vs. -regexp} { switch -re Foo Fo. {set result OK} } OK test switch-3.15 {-exact vs. -glob vs. -regexp} -body { switch -exact -exact Foo Foo {set result OK} } -returnCodes error -result {bad option "-exact": -exact option already found} test switch-3.16 {-exact vs. -glob vs. -regexp} -body { switch -exact -glob Foo Foo {set result OK} } -returnCodes error -result {bad option "-glob": -exact option already found} test switch-3.17 {-exact vs. -glob vs. -regexp} -body { switch -glob -regexp Foo Foo {set result OK} } -returnCodes error -result {bad option "-regexp": -glob option already found} test switch-3.18 {-exact vs. -glob vs. -regexp} -body { switch -regexp -glob Foo Foo {set result OK} } -returnCodes error -result {bad option "-glob": -regexp option already found} test switch-4.1 {error in executed command} { list [catch {switch a a {error "Just a test"} default {subst 1}} msg] \ $msg $::errorInfo } {1 {Just a test} {Just a test while executing "error "Just a test"" ("a" arm line 1) invoked from within "switch a a {error "Just a test"} default {subst 1}"}} test switch-4.2 {error: not enough args} -returnCodes error -body { switch } -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"} test switch-4.3 {error: pattern with no body} -body { switch a b } -returnCodes error -result {extra switch pattern with no body} test switch-4.4 {error: pattern with no body} -body { switch a b {subst 1} c } -returnCodes error -result {extra switch pattern with no body} test switch-4.5 {error in default command} { list [catch {switch foo a {error switch1} b {error switch 3} \ default {error switch2}} msg] $msg $::errorInfo } {1 switch2 {switch2 while executing "error switch2" ("default" arm line 1) invoked from within "switch foo a {error switch1} b {error switch 3} default {error switch2}"}} test switch-5.1 {errors in -regexp matching} -returnCodes error -body { switch -regexp aaaab { *b {subst glob} aaaab {subst exact} default {subst none} } } -result {couldn't compile regular expression pattern: quantifier operand invalid} test switch-6.1 {backslashes in patterns} { switch -exact {\a\$\.\[} { \a\$\.\[ {subst first} \a\\$\.\\[ {subst second} \\a\\$\\.\\[ {subst third} {\a\\$\.\\[} {subst fourth} {\\a\\$\\.\\[} {subst fifth} default {subst none} } } third test switch-6.2 {backslashes in patterns} { switch -exact {\a\$\.\[} { \a\$\.\[ {subst first} {\a\$\.\[} {subst second} {{\a\$\.\[}} {subst third} default {subst none} } } second test switch-7.1 {"-" bodies} { switch a { a - b - c {subst 1} default {subst 2} } } 1 test switch-7.2 {"-" bodies} -body { switch a { a - b - c - } } -returnCodes error -result {no body specified for pattern "c"} test switch-7.3 {"-" bodies} -body { switch a { a - b -foo c - } } -returnCodes error -result {no body specified for pattern "c"} test switch-7.4 {"-" bodies} -body { switch a { a - b -foo c {} } } -returnCodes error -result {invalid command name "-foo"} test switch-8.1 {empty body} { set msg {} switch {2} { 1 {set msg 1} 2 {} default {set msg 2} } } {} proc test_switch_body {} { return "INVOKED" } test switch-8.2 {weird body text, variable} { set cmd {test_switch_body} switch Foo { Foo $cmd } } {INVOKED} test switch-8.3 {weird body text, variable} { set cmd {test_switch_body} switch Foo { Foo {$cmd} } } {INVOKED} test switch-9.1 {empty pattern/body list} -returnCodes error -body { switch x } -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"} test switch-9.2 {unpaired pattern} -returnCodes error -body { switch -- x } -result {extra switch pattern with no body} test switch-9.3 {empty pattern/body list} -body { switch x {} } -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"} test switch-9.4 {empty pattern/body list} -body { switch -- x {} } -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"} test switch-9.5 {unpaired pattern} -body { switch x a {} b } -returnCodes error -result {extra switch pattern with no body} test switch-9.6 {unpaired pattern} -body { switch x {a {} b} } -returnCodes error -result {extra switch pattern with no body} test switch-9.7 {unpaired pattern} -body { switch x a {} # comment b } -returnCodes error -result {extra switch pattern with no body} test switch-9.8 {unpaired pattern} -returnCodes error -body { switch x {a {} # comment b} } -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation} test switch-9.9 {unpaired pattern} -body { switch x a {} x {} # comment b } -returnCodes error -result {extra switch pattern with no body} test switch-9.10 {unpaired pattern} -returnCodes error -body { switch x {a {} x {} # comment b} } -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation} test switch-10.1 {compiled -exact switch} { if 1 {switch -exact -- a {a {subst 1} b {subst 2}}} } 1 test switch-10.1a {compiled -exact switch} { if 1 {switch -exact a {a {subst 1} b {subst 2}}} } 1 test switch-10.2 {compiled -exact switch} { if 1 {switch -exact -- b {a {subst 1} b {subst 2}}} } 2 test switch-10.2a {compiled -exact switch} { if 1 {switch -exact b {a {subst 1} b {subst 2}}} } 2 test switch-10.3 {compiled -exact switch} { if 1 {switch -exact -- c {a {subst 1} b {subst 2}}} } {} test switch-10.3a {compiled -exact switch} { if 1 {switch -exact c {a {subst 1} b {subst 2}}} } {} test switch-10.4 {compiled -exact switch} { if 1 { set x 0 switch -exact -- c {a {subst 1} b {subst 2}} } } {} test switch-10.5 {compiled -exact switch} { if 1 {switch -exact -- a {a - aa {subst 1} b {subst 2}}} } 1 test switch-10.6 {compiled -exact switch} { if 1 {switch -exact -- b {a { set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 } b {subst 2}}} } 2 # Command variants are: # c* are compiled switches, i* are interpreted # *-glob use glob matching, *-exact use exact matching # *2* include a default clause (different results too.) proc cswtest-glob s { set x 0; set y 0 foreach c [split $s {}] { switch -glob $c { a {incr x} b {incr y} } } set x [expr {$x*100}]; set y [expr {$y*100}] foreach c [split $s {}] { switch -glob -- $c a {incr x} b {incr y} } return $x,$y } proc iswtest-glob s { set x 0; set y 0; set switch switch foreach c [split $s {}] { $switch -glob $c { a {incr x} b {incr y} } } set x [expr {$x*100}]; set y [expr {$y*100}] foreach c [split $s {}] { $switch -glob -- $c a {incr x} b {incr y} } return $x,$y } proc cswtest-exact s { set x 0; set y 0 foreach c [split $s {}] { switch -exact $c { a {incr x} b {incr y} } } set x [expr {$x*100}]; set y [expr {$y*100}] foreach c [split $s {}] { switch -exact -- $c a {incr x} b {incr y} } return $x,$y } proc iswtest-exact s { set x 0; set y 0; set switch switch foreach c [split $s {}] { $switch -exact $c { a {incr x} b {incr y} } } set x [expr {$x*100}]; set y [expr {$y*100}] foreach c [split $s {}] { $switch -exact -- $c a {incr x} b {incr y} } return $x,$y } proc cswtest2-glob s { set x 0; set y 0; set z 0 foreach c [split $s {}] { switch -glob $c { a {incr x} b {incr y} default {incr z} } } set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] foreach c [split $s {}] { switch -glob -- $c a {incr x} b {incr y} default {incr z} } return $x,$y,$z } proc iswtest2-glob s { set x 0; set y 0; set z 0; set switch switch foreach c [split $s {}] { $switch -glob $c { a {incr x} b {incr y} default {incr z} } } set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] foreach c [split $s {}] { $switch -glob -- $c a {incr x} b {incr y} default {incr z} } return $x,$y,$z } proc cswtest2-exact s { set x 0; set y 0; set z 0 foreach c [split $s {}] { switch -exact $c { a {incr x} b {incr y} default {incr z} } } set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] foreach c [split $s {}] { switch -exact -- $c a {incr x} b {incr y} default {incr z} } return $x,$y,$z } proc iswtest2-exact s { set x 0; set y 0; set z 0; set switch switch foreach c [split $s {}] { $switch -exact $c { a {incr x} b {incr y} default {incr z} } } set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] foreach c [split $s {}] { $switch -exact -- $c a {incr x} b {incr y} default {incr z} } return $x,$y,$z } test switch-10.7 {comparison of compiled and interpreted behaviour of switch, exact matching} { cswtest-exact abcb } [iswtest-exact abcb] test switch-10.8 {comparison of compiled and interpreted behaviour of switch, glob matching} { cswtest-glob abcb } [iswtest-glob abcb] test switch-10.9 {comparison of compiled and interpreted behaviour of switch, exact matching with default} { cswtest2-exact abcb } [iswtest2-exact abcb] test switch-10.10 {comparison of compiled and interpreted behaviour of switch, glob matching with default} { cswtest2-glob abcb } [iswtest2-glob abcb] proc cswtest-default-exact {x} { switch -- $x { a* {return b} aa {return c} default {return d} } } test switch-10.11 {default to exact matching when compiled} { cswtest-default-exact a } d test switch-10.12 {default to exact matching when compiled} { cswtest-default-exact aa } c test switch-10.13 {default to exact matching when compiled} { cswtest-default-exact a* } b test switch-10.14 {default to exact matching when compiled} { cswtest-default-exact a** } d rename cswtest-default-exact {} rename cswtest-glob {} rename iswtest-glob {} rename cswtest2-glob {} rename iswtest2-glob {} rename cswtest-exact {} rename iswtest-exact {} rename cswtest2-exact {} rename iswtest2-exact {} # Bug 1891827 test switch-10.15 {(not) compiled exact nocase regression} { apply {{} { switch -nocase -- A { a {return yes} default {return no} } }} } yes # Added due to TIP#75 test switch-11.1 {regexp matching with -matchvar} { switch -regexp -matchvar x -- abc {.(.). {set x}} } {abc b} test switch-11.2 {regexp matching with -matchvar} { set x GOOD switch -regexp -matchvar x -- abc {.(.).. {list $x z}} set x } GOOD test switch-11.3 {regexp matching with -matchvar} { switch -regexp -matchvar x -- "a b c" {.(.). {set x}} } {{a b} { }} test switch-11.4 {regexp matching with -matchvar} { set x BAD switch -regexp -matchvar x -- "a b c" { bc {list $x YES} default {list $x NO} } } {{} NO} test switch-11.5 {-matchvar without -regexp} { set x {} list [catch {switch -glob -matchvar x -- abc . {set x}} msg] $x $msg } {1 {} {-matchvar option requires -regexp option}} test switch-11.6 {-matchvar unwritable} { set x {} list [catch {switch -regexp -matchvar x(x) -- abc . {set x}} msg] $x $msg } {1 {} {can't set "x(x)": variable isn't array}} test switch-12.1 {regexp matching with -indexvar} { switch -regexp -indexvar x -- abc {.(.). {set x}} } {{0 2} {1 1}} test switch-12.2 {regexp matching with -indexvar} { set x GOOD switch -regexp -indexvar x -- abc {.(.).. {list $x z}} set x } GOOD test switch-12.3 {regexp matching with -indexvar} { switch -regexp -indexvar x -- "a b c" {.(.). {set x}} } {{0 2} {1 1}} test switch-12.4 {regexp matching with -indexvar} { set x BAD switch -regexp -indexvar x -- "a b c" { bc {list $x YES} default {list $x NO} } } {{} NO} test switch-12.5 {-indexvar without -regexp} { set x {} list [catch {switch -glob -indexvar x -- abc . {set x}} msg] $x $msg } {1 {} {-indexvar option requires -regexp option}} test switch-12.6 {-indexvar unwritable} { set x {} list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg } {1 {} {can't set "x(x)": variable isn't array}} test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} { set str abcdef switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]} } abc test switch-12.8 {-indexvar and matched empty strings} { switch -regexp -indexvar x -- abcdef ^...(x?) {return $x} } {{0 2} {3 2}} test switch-12.9 {-indexvar and unmatched strings} { switch -regexp -indexvar x -- abcdef ^...(x)? {return $x} } {{0 2} {-1 -1}} test switch-13.1 {-indexvar -matchvar combinations} { switch -regexp -indexvar x -matchvar y abc { . {list $x $y} } } {{{0 0}} a} test switch-13.2 {-indexvar -matchvar combinations} { switch -regexp -indexvar x -matchvar y abc { .$ {list $x $y} } } {{{2 2}} c} test switch-13.3 {-indexvar -matchvar combinations} { switch -regexp -indexvar x -matchvar y abc { (.)(.)(.) {list $x $y} } } {{{0 2} {0 0} {1 1} {2 2}} {abc a b c}} test switch-13.4 {-indexvar -matchvar combinations} { set x - set y - switch -regexp -indexvar x -matchvar y abc { (.)(.)(.). - default {list $x $y} } } {{} {}} test switch-13.5 {-indexvar -matchvar combinations} { set x - set y - list [catch { switch -regexp -indexvar x(x) -matchvar y abc {. {list $x $y}} } msg] $x $y $msg } {1 - - {can't set "x(x)": variable isn't array}} test switch-13.6 {-indexvar -matchvar combinations} { set x - set y - list [catch { switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}} } msg] $x $y $msg } {1 {{0 0}} - {can't set "y(y)": variable isn't array}} test switch-14.1 {-regexp -- compilation [Bug 1854399]} { switch -regexp -- 0 { {[0-9]+} {return yes} default {return no} } foo } yes test switch-14.2 {-regexp -- compilation [Bug 1854399]} { proc foo {} { switch -regexp -- 0 { {[0-9]+} {return yes} default {return no} } } foo } yes test switch-14.3 {-regexp -- compilation [Bug 1854399]} { proc foo {} { switch -regexp -- 0 { {\d+} {return yes} default {return no} } } foo } yes test switch-14.4 {-regexp -- compilation [Bug 1854399]} { proc foo {} { switch -regexp -- 0 { {0} {return yes} default {return no} } } foo } yes test switch-14.5 {switch -regexp compilation} { apply {{} { switch -regexp -- 0 { {0|1|2} {return yes} default {return no} } }} } yes test switch-14.6 {switch -regexp compilation} { apply {{} { switch -regexp -- 0 { {0|11|222} {return yes} default {return no} } }} } yes test switch-14.7 {switch -regexp compilation} { apply {{} { switch -regexp -- 0 { {[012]} {return yes} default {return no} } }} } yes test switch-14.8 {switch -regexp compilation} { apply {{} { switch -regexp -- x { {0|1|2} {return yes} default {return no} } }} } no test switch-14.9 {switch -regexp compilation} { apply {{} { switch -regexp -- x { {0|11|222} {return yes} default {return no} } }} } no test switch-14.10 {switch -regexp compilation} { apply {{} { switch -regexp -- x { {[012]} {return yes} default {return no} } }} } no test switch-14.11 {switch -regexp compilation} { apply {{} { switch -regexp -- x { {0|1|2} {return yes} .+ {return yes2} default {return no} } }} } yes2 test switch-14.12 {switch -regexp compilation} { apply {{} { switch -regexp -- x { {0|11|222} {return yes} .+ {return yes2} default {return no} } }} } yes2 test switch-14.13 {switch -regexp compilation} { apply {{} { switch -regexp -- x { {[012]} {return yes} .+ {return yes2} default {return no} } }} } yes2 test switch-14.14 {switch -regexp compilation} { apply {{} { switch -regexp -- {} { {0|1|2} {return yes} .+ {return yes2} default {return no} } }} } no test switch-14.15 {switch -regexp compilation} { apply {{} { switch -regexp -- {} { {0|11|222} {return yes} .+ {return yes2} default {return no} } }} } no test switch-14.16 {switch -regexp compilation} { apply {{} { switch -regexp -- {} { {[012]} {return yes} .+ {return yes2} default {return no} } }} } no test switch-14.17 {switch -regexp bug [c0bc269178]} { set result {} switch -regexp -matchvar m -indexvar i ac { {(a)(b)?(c)} {set result $m} } set result } {ac a {} c} test switch-15.1 {coroutine safety of non-bytecoded switch} {*}{ -body { proc coro {} { switch -glob a { a {yield ok1} } return ok2 } list [coroutine c coro] [c] } -result {ok1 ok2} -cleanup { rename coro {} } } # cleanup catch {rename foo {}} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/tailcall.test0000644000175000017500000004035114554262142015475 0ustar sergeisergei# Commands covered: tailcall # # This file contains a collection of tests for experimental commands that are # found in ::tcl::unsupported. The tests will migrate to normal test files # if/when the commands find their way into the core. # # Copyright (c) 2008 by Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testnrelevels [llength [info commands testnrelevels]] # # The tests that risked blowing the C stack on failure have been removed: we # can now actually measure using testnrelevels. # if {[testConstraint testnrelevels]} { namespace eval testnre { # # [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels, # cmdFrame level, callFrame level, tosPtr and callback depth # variable last [testnrelevels] proc depthDiff {} { variable last set depth [testnrelevels] set res {} foreach t $depth l $last { lappend res [expr {$t-$l}] } set last $depth return $res } namespace export * } namespace import testnre::* } proc errorcode options { dict get [dict merge {-errorcode NONE} $options] -errorcode } test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup { proc a i { # # NOTE: there may be a diff in callback depth with the first call # ($i==0) due to the fact that the first is from an eval. Successive # calls should add nothing to any stack depths. # if {$i == 1} { depthDiff } if {[incr i] > 10} { return [depthDiff] } tailcall a $i } } -body { a 0 } -cleanup { rename a {} } -result {0 0 0 0 0 0} test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup { set a { i { if {$i == 1} { depthDiff } if {[incr i] > 10} { return [depthDiff] } upvar 1 a a tailcall apply $a $i }} } -body { apply $a 0 } -cleanup { unset a } -result {0 0 0 0 0 0} test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup { proc a i { if {$i == 1} { depthDiff } if {[incr i] > 10} { return [depthDiff] } tailcall b $i } interp alias {} b {} a } -body { b 0 } -cleanup { rename a {} rename b {} } -result {0 0 0 0 0 0} test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup { namespace eval ::ns { namespace export * } proc ::ns::a i { if {$i == 1} { depthDiff } if {[incr i] > 10} { return [depthDiff] } set b [uplevel 1 [list namespace which b]] tailcall $b $i } namespace import ::ns::a rename a b } -body { b 0 } -cleanup { rename b {} namespace delete ::ns } -result {0 0 0 0 0 0} test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup { proc b i { if {$i == 1} { depthDiff } if {[incr i] > 10} { return [depthDiff] } tailcall a b $i } namespace ensemble create -command a -map {b b} } -body { a b 0 } -cleanup { rename a {} rename b {} } -result {0 0 0 0 0 0} test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -setup { # # This test is related to [bug d87cb182053fd79b3]: the fix to that bug was # to remove a call to TclSkipTailcall, which caused a violation of the # constant-space property of tailcall in that particular # configuration. This test was added to detect that, and insure that the # problem is fixed. # proc b i { if {$i == 1} { depthDiff } if {[incr i] > 10} { return [depthDiff] } tailcall dict b $i } set map0 [namespace ensemble configure dict -map] set map $map0 dict set map b b namespace ensemble configure dict -map $map } -body { dict b 0 } -cleanup { rename b {} namespace ensemble configure dict -map $map0 unset map map0 } -result {0 0 0 0 0 0} test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup { # # This test fails because ns-unknown is not NR-enabled # proc c i { if {$i == 1} { depthDiff } if {[incr i] > 10} { return [depthDiff] } tailcall a b $i } proc d {ens sub args} { return [list $ens c] } namespace ensemble create -command a -unknown d } -body { a b 0 } -cleanup { rename a {} rename c {} rename d {} } -result {0 0 0 0 0 0} test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup { catch {rename foo {}} oo::class create foo { method b i { if {$i == 1} { depthDiff } if {[incr i] > 10} { return [depthDiff] } tailcall [self] b $i } } } -body { foo create a a b 0 } -cleanup { rename a {} rename foo {} } -result {0 0 0 0 0 0} test tailcall-1 {tailcall} -body { namespace eval a { variable x *::a proc xset {} { set tmp {} set ns {[namespace current]} set level [info level] for {set i 0} {$i <= [info level]} {incr i} { uplevel #$i "set x $i$ns" lappend tmp "$i [info level $i]" } lrange $tmp 1 end } proc foo {} {tailcall xset; set x noreach} } namespace eval b { variable x *::b proc xset args {error b::xset} proc moo {} {set x 0; variable y [::a::foo]; set x} } variable x *:: proc xset args {error ::xset} list [::b::moo] | $x $a::x $b::x | $::b::y } -cleanup { unset x rename xset {} namespace delete a b } -result {1::b | 0:: *::a *::b | {{1 ::b::moo} {2 xset}}} test tailcall-2 {tailcall in non-proc} -body { namespace eval a [list tailcall set x 1] } -match glob -result *tailcall* -returnCodes error test tailcall-3 {tailcall falls off tebc} -body { unset -nocomplain x proc foo {} {tailcall set x 1} list [catch foo msg] $msg [set x] } -cleanup { rename foo {} unset x } -result {0 1 1} test tailcall-4 {tailcall falls off tebc} -body { set x 2 proc foo {} {tailcall set x 1} foo set x } -cleanup { rename foo {} unset x } -result 1 test tailcall-5 {tailcall falls off tebc} -body { set x 2 namespace eval bar { variable x 3 proc foo {} {tailcall set x 1} } bar::foo list $x $bar::x } -cleanup { unset x namespace delete bar } -result {1 3} test tailcall-6 {tailcall does remove callframes} -body { proc foo {} {info level} proc moo {} {tailcall foo} proc boo {} {expr {[moo] - [info level]}} boo } -cleanup { rename foo {} rename moo {} rename boo {} } -result 1 test tailcall-7 {tailcall does return} -setup { namespace eval ::foo { variable res {} proc a {} { variable res append res a tailcall set x 1 append res a } proc b {} { variable res append res b a append res b } proc c {} { variable res append res c b append res c } } } -body { namespace eval ::foo c } -cleanup { namespace delete ::foo } -result cbabc test tailcall-8 {tailcall tailcall} -setup { namespace eval ::foo { variable res {} proc a {} { variable res append res a tailcall tailcall set x 1 append res a } proc b {} { variable res append res b a append res b } proc c {} { variable res append res c b append res c } } } -body { namespace eval ::foo c } -cleanup { namespace delete ::foo } -result cbac test tailcall-9 {tailcall factorial} -setup { proc fact {n {b 1}} { if {$n == 1} { return $b } tailcall fact [expr {$n-1}] [expr {$n*$b}] } } -body { list [fact 1] [fact 5] [fact 10] [fact 15] } -cleanup { rename fact {} } -result {1 120 3628800 1307674368000} test tailcall-10a {tailcall and eval} -setup { set ::x 0 proc a {} { eval [list tailcall lappend ::x 2] set ::x 1 } } -body { list [a] $::x } -cleanup { unset -nocomplain ::x } -result {{0 2} {0 2}} test tailcall-10b {tailcall and eval} -setup { set ::x 0 proc a {} { eval {tailcall lappend ::x 2} set ::x 1 } } -body { list [a] $::x } -cleanup { unset -nocomplain ::x } -result {{0 2} {0 2}} test tailcall-11a {tailcall and uplevel} -setup { proc a {} { uplevel 1 [list tailcall set ::x 2] set ::x 1 } } -body { list [a] $::x } -cleanup { unset -nocomplain ::x } -match glob -result *tailcall* -returnCodes error test tailcall-11b {tailcall and uplevel} -setup { proc a {} { uplevel 1 {tailcall set ::x 2} set ::x 1 } } -body { list [a] $::x } -cleanup { unset -nocomplain ::x } -match glob -result *tailcall* -returnCodes error test tailcall-11c {tailcall and uplevel} -setup { proc a {} { uplevel 1 {tailcall lappend ::x 2} set ::x 1 } proc b {} {set ::x 0; a; lappend ::x 3} } -body { list [b] $::x } -cleanup { rename a {} rename b {} unset -nocomplain ::x } -result {{0 3 2} {0 3 2}} test tailcall-12.1 {[Bug 2649975]} -setup { proc dump {{text {}}} { set text [uplevel 1 [list subst $text]] set l [expr {[info level] -1}] if {$text eq {}} { set text [info level $l] } puts "$l: $text" } # proc dump args {} proc bravo {} { upvar 1 v w dump {inside bravo, v -> $w} set v "procedure bravo" #uplevel 1 [list delta ::betty] uplevel 1 {delta ::betty} return $::resolution } proc delta name { upvar 1 v w dump {inside delta, v -> $w} set v "procedure delta" tailcall foxtrot } proc foxtrot {} { upvar 1 v w dump {inside foxtrot, v -> $w} global resolution set ::resolution $w } set v "global level" } -body { set result [bravo] if {$result ne $v} { puts "v should have been found at $v but was found in $result" } } -cleanup { unset v rename dump {} rename bravo {} rename delta {} rename foxtrot {} } -output {1: inside bravo, v -> global level 1: inside delta, v -> global level 1: inside foxtrot, v -> global level } test tailcall-12.2 {[Bug 2649975]} -setup { proc dump {{text {}}} { set text [uplevel 1 [list subst $text]] set l [expr {[info level] -1}] if {$text eq {}} { set text [info level $l] } puts "$l: $text" } # proc dump args {} set v "global level" oo::class create foo { # like connection method alpha {} { # like connections 'tables' method dump upvar 1 v w dump {inside foo's alpha, v resolves to $w} set v "foo's method alpha" dump {foo's alpha is calling [self] bravo - v should resolve at global level} set result [uplevel 1 [list [self] bravo]] dump {exiting from foo's alpha} return $result } method bravo {} { # like connections 'foreach' method dump upvar 1 v w dump {inside foo's bravo, v resolves to $w} set v "foo's method bravo" dump {foo's bravo is calling charlie to create barney} set barney [my charlie ::barney] dump {foo's bravo is calling bravo on $barney} dump {v should resolve at global scope there} set result [uplevel 1 [list $barney bravo]] dump {exiting from foo's bravo} return $result } method charlie {name} { # like tdbc prepare dump set v "foo's method charlie" dump {tailcalling bar's constructor} tailcall ::bar create $name } } oo::class create bar { # like statement method bravo {} { # like statement foreach method dump upvar 1 v w dump {inside bar's bravo, v is resolving to $w} set v "bar's method bravo" dump {calling delta to construct betty - v should resolve global there} uplevel 1 [list [self] delta ::betty] dump {exiting from bar's bravo} return [::betty whathappened] } method delta {name} { # like statement execute method dump upvar 1 v w dump {inside bar's delta, v is resolving to $w} set v "bar's method delta" dump {tailcalling to construct $name as instance of grill} dump {v should resolve at global level in grill's constructor} dump {grill's constructor should run at level [info level]} tailcall grill create $name } } oo::class create grill { variable resolution constructor {} { dump upvar 1 v w dump "in grill's constructor, v resolves to $w" set resolution $w } method whathappened {} { return $resolution } } foo create fred } -body { set result [fred alpha] if {$result ne "global level"} { puts "v should have been found at global level but was found in $result" } } -cleanup { unset result rename fred {} rename dump {} rename foo {} rename bar {} rename grill {} } -output {1: fred alpha 1: inside foo's alpha, v resolves to global level 1: foo's alpha is calling ::fred bravo - v should resolve at global level 1: ::fred bravo 1: inside foo's bravo, v resolves to global level 1: foo's bravo is calling charlie to create barney 2: my charlie ::barney 2: tailcalling bar's constructor 1: foo's bravo is calling bravo on ::barney 1: v should resolve at global scope there 1: ::barney bravo 1: inside bar's bravo, v is resolving to global level 1: calling delta to construct betty - v should resolve global there 1: ::barney delta ::betty 1: inside bar's delta, v is resolving to global level 1: tailcalling to construct ::betty as instance of grill 1: v should resolve at global level in grill's constructor 1: grill's constructor should run at level 1 1: grill create ::betty 1: in grill's constructor, v resolves to global level 1: exiting from bar's bravo 1: exiting from foo's bravo 1: exiting from foo's alpha } test tailcall-12.3a0 {[Bug 2695587]} -body { apply {{} { catch [list tailcall foo] }} } -returnCodes 1 -result {invalid command name "foo"} test tailcall-12.3a1 {[Bug 2695587]} -body { apply {{} { catch [list tailcall foo] tailcall }} } -result {} test tailcall-12.3a2 {[Bug 2695587]} -body { apply {{} { catch [list tailcall foo] tailcall moo }} } -returnCodes 1 -result {invalid command name "moo"} test tailcall-12.3a3 {[Bug 2695587]} -body { set x 0 apply {{} { catch [list tailcall foo] tailcall lappend x 1 }} set x } -cleanup { unset x } -result {0 1} test tailcall-12.3b0 {[Bug 2695587]} -body { apply {{} { set catch catch $catch [list tailcall foo] }} } -returnCodes 1 -result {invalid command name "foo"} test tailcall-12.3b1 {[Bug 2695587]} -body { apply {{} { set catch catch $catch [list tailcall foo] tailcall }} } -result {} test tailcall-12.3b2 {[Bug 2695587]} -body { apply {{} { set catch catch $catch [list tailcall foo] tailcall moo }} } -returnCodes 1 -result {invalid command name "moo"} test tailcall-12.3b3 {[Bug 2695587]} -body { set x 0 apply {{} { set catch catch $catch [list tailcall foo] tailcall lappend x 1 }} set x } -cleanup { unset x } -result {0 1} # MORE VARIANTS MISSING: bc'ed caught script vs (bc'ed, not-bc'ed) # catch. Actually superfluous now, as tailcall just returns TCL_RETURN so that # standard catch behaviour is required. test tailcall-13.1 {directly tailcalling the tailcall command is ok} { list [catch { apply {{} { apply {{} { tailcall tailcall subst ok subst b }} subst c }} } msg opt] $msg [errorcode $opt] } {0 ok NONE} test tailcall-13.2 {indirectly tailcalling the tailcall command is ok} { list [catch { apply {{} { apply {{} { tailcall eval tailcall subst ok subst b }} subst c }} } msg opt] $msg [errorcode $opt] } {0 ok NONE} if {[testConstraint testnrelevels]} { namespace forget testnre::* namespace delete testnre } test tailcall-14.1 {in a deleted namespace} -body { namespace eval ns { proc p args { tailcall [namespace current] $args } namespace delete [namespace current] p } } -returnCodes 1 -result {namespace "::ns" not found} test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body { namespace eval ns { proc p args { tailcall [namespace current] {*}$args } namespace delete [namespace current] p } } -returnCodes 1 -result {namespace "::ns" not found} test tailcall-bug-784befb0ba {tailcall crash with 254 args} -body { proc tccrash args {llength $args} # Must be EXACTLY 254 for crash proc p {} [list tailcall tccrash {*}[lrepeat 254 x]] p } -result 254 # cleanup ::tcltest::cleanupTests # Local Variables: # mode: tcl # End: tcl8.6.14/tests/tcltest.test0000644000175000017500000014470114554262142015376 0ustar sergeisergei# This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-1999 Scriptics Corporation. # Copyright (c) 2000 Ajuba Solutions # All rights reserved. # Note that there are several places where the value of # tcltest::currentFailure is stored/reset in the -setup/-cleanup # of a test that has a body that runs [test] that will fail. # This is a workaround of using the same tcltest code that we are # testing to run the test itself. Ditto on things like [verbose]. # # It would be better to have the -body of the tests run the tcltest # commands in a child interp so the [test] being tested would not # interfere with the [test] doing the testing. # if {"::tcltest" ni [namespace children]} { package require tcltest 2.1 namespace import -force ::tcltest::* } # File permissions broken on wsl without some "exotic" wsl configuration testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] namespace eval ::tcltest::test { namespace import ::tcltest::* makeFile { package require tcltest 2.5 namespace import ::tcltest::test test a-1.0 {test a} { list 0 } {0} test b-1.0 {test b} { list 1 } {0} test c-1.0 {test c} {knownBug} { } {} test d-1.0 {test d} { error "foo" foo 9 } {} tcltest::cleanupTests exit } test.tcl cd [temporaryDirectory] testConstraint exec [llength [info commands exec]] # test -help # Child processes because -help [exit]s. test tcltest-1.1 {tcltest -help} {exec} { set result [catch {exec [interpreter] test.tcl -help} msg] list $result [regexp Usage $msg] } {1 1} test tcltest-1.2 {tcltest -help -something} {exec} { set result [catch {exec [interpreter] test.tcl -help -something} msg] list $result [regexp Usage $msg] } {1 1} test tcltest-1.3 {tcltest -h} {exec} { set result [catch {exec [interpreter] test.tcl -h} msg] list $result [regexp Usage $msg] } {1 0} # -verbose, implicit & explicit testing of [verbose] proc child {msgVar args} { upvar 1 $msgVar msg interp create [namespace current]::i # Fake the child interp into dumping output to a file i eval {namespace eval ::tcltest {}} i eval "set tcltest::outputChannel\ \[[list open [set of [makeFile {} output]] w]]" i eval "set tcltest::errorChannel\ \[[list open [set ef [makeFile {} error]] w]]" i eval [list set argv0 [lindex $args 0]] i eval [list set argv [lrange $args 1 end]] i eval [list package ifneeded tcltest [package provide tcltest] \ [package ifneeded tcltest [package provide tcltest]]] i eval {proc exit args {}} # Need to capture output in msg set code [catch {i eval {source $argv0}}] i eval {close $tcltest::outputChannel} interp delete [namespace current]::i set f [open $of] set msg [read -nonewline $f] close $f set f [open $ef] set err [read -nonewline $f] close $f removeFile output removeFile error if {[string length $err]} { set code 1 append msg \n$err } return $code } test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} { set result [child msg test.tcl] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} test tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} { set result [child msg test.tcl -verbose 'b'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} test tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} { set result [child msg test.tcl -verbose 'p'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 1 0 1} test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} { set result [child msg test.tcl -verbose 's'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 0 1 1} test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} { set result [child msg test.tcl -verbose 'ps'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 1 1 1} test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} { set result [child msg test.tcl -verbose 'psb'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 1 1} test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} { set result [child msg test.tcl -verbose "pass skip body"] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 1 1} test tcltest-2.6 {tcltest -verbose 't'} { -constraints {unixOrWin} -body { set result [child msg test.tcl -verbose 't'] list $result $msg } -result {^0 .*a-1.0 start.*b-1.0 start} -match regexp } test tcltest-2.6a {tcltest -verbose 'start'} { -constraints {unixOrWin} -body { set result [child msg test.tcl -verbose start] list $result $msg } -result {^0 .*a-1.0 start.*b-1.0 start} -match regexp } test tcltest-2.7 {tcltest::verbose} { -body { set oldVerbosity [verbose] verbose bar set currentVerbosity [verbose] verbose foo set newVerbosity [verbose] verbose $oldVerbosity list $currentVerbosity $newVerbosity } -result {body {}} } test tcltest-2.8 {tcltest -verbose 'error'} { -constraints {unixOrWin} -body { set result [child msg test.tcl -verbose error] list $result $msg } -result {errorInfo: foo.*errorCode: 9} -match regexp } # -match, [match] test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} { set result [child msg test.tcl -match a* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 1 0 0 1} test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} { set result [child msg test.tcl -match b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg] } {0 0 1 0 1} test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} { set result [child msg test.tcl -match c* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg] } {0 0 0 1 1} test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} { set result [child msg test.tcl -match {a* b*} -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg] } {0 1 1 0 1} test tcltest-3.5 {tcltest::match} { -body { set oldMatch [match] match foo set currentMatch [match] match bar set newMatch [match] match $oldMatch list $currentMatch $newMatch } -result {foo bar} } # -skip, [skip] test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} { set result [child msg test.tcl -skip a* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg] } {0 0 1 1 1} test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} { set result [child msg test.tcl -skip b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg] } {0 1 0 1 1} test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} { set result [child msg test.tcl -skip c* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 0 1} test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} { set result [child msg test.tcl -skip {a* b*} -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg] } {0 0 0 1 1} test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} { set result [child msg test.tcl -match {a* b*} -skip b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 1 0 0 1} test tcltest-4.6 {tcltest::skip} { -body { set oldSkip [skip] skip foo set currentSkip [skip] skip bar set newSkip [skip] skip $oldSkip list $currentSkip $newSkip } -result {foo bar} } # -constraints, -limitconstraints, [testConstraint], # $constraintsSpecified, [limitConstraints] test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} { set result [child msg test.tcl -constraints knownBug -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg] } {0 1 1 1 1} test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} { set result [child msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 0 0 1 1} test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)} { -body { set r1 [testConstraint tcltestFakeConstraint] set r2 [testConstraint tcltestFakeConstraint 4] set r3 [testConstraint tcltestFakeConstraint] list $r1 $r2 $r3 } -result {0 4 4} -cleanup {unset ::tcltest::testConstraints(tcltestFakeConstraint)} } # Removed this test of internals of tcltest. Those internals have changed. #test tcltest-5.4 {tcltest::constraintsSpecified} { # -setup { # set constraintlist $::tcltest::constraintsSpecified # set ::tcltest::constraintsSpecified {} # } # -body { # set r1 $::tcltest::constraintsSpecified # testConstraint tcltestFakeConstraint1 1 # set r2 $::tcltest::constraintsSpecified # testConstraint tcltestFakeConstraint2 1 # set r3 $::tcltest::constraintsSpecified # list $r1 $r2 $r3 # } # -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}} # -cleanup { # set ::tcltest::constraintsSpecified $constraintlist # unset ::tcltest::testConstraints(tcltestFakeConstraint1) # unset ::tcltest::testConstraints(tcltestFakeConstraint2) # } #} test tcltest-5.5 {InitConstraints: list of built-in constraints} \ -constraints {!singleTestInterp notWsl} \ -setup {tcltest::InitConstraints} \ -body { lsort [array names ::tcltest::testConstraints] } \ -result [lsort { 95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly }] # Removed this broken test. Its usage of [limitConstraints] was not # in agreement with the documentation. [limitConstraints] is supposed # to take an optional boolean argument, and "knownBug" ain't no boolean! #test tcltest-5.6 {tcltest::limitConstraints} { # -setup { # set keeplc $::tcltest::limitConstraints # set keepkb [testConstraint knownBug] # } # -body { # set r1 [limitConstraints] # set r2 [limitConstraints knownBug] # set r3 [limitConstraints] # list $r1 $r2 $r3 # } # -cleanup { # limitConstraints $keeplc # testConstraint knownBug $keepkb # } # -result {false knownBug knownBug} #} # -outfile, -errfile, [outputChannel], [outputFile], [errorChannel], [errorFile] set printerror [makeFile { package require tcltest 2.5 namespace import ::tcltest::* puts [outputChannel] "a test" ::tcltest::PrintError "a really short string" ::tcltest::PrintError "a really really really really really really long \ string containing \"quotes\" and other bad bad stuff" ::tcltest::PrintError "a really really long string containing a \ \"Path/that/is/really/long/and/contains/no/spaces\"" ::tcltest::PrintError "a really really long string containing a \ \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\"" exit } printerror.tcl] test tcltest-6.1 {tcltest -outfile, -errfile defaults} { -constraints unixOrWin -body { child msg $printerror return $msg } -result {a test.*a really} -match regexp } test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} { child msg $printerror -outfile a.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {0 1 0 1 1 {}} test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} { child msg $printerror -errfile a.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {1 0 1 0 1 {}} test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} { child msg $printerror -outfile a.tmp -errfile b.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" b.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 \ [file exists a.tmp] [file delete a.tmp] \ [file exists b.tmp] [file delete b.tmp] } {0 0 0 0 1 {} 1 {}} test tcltest-6.5 {tcltest::errorChannel - retrieval} { -setup { set of [errorChannel] set ::tcltest::errorChannel stderr } -body { errorChannel } -result {stderr} -cleanup { set ::tcltest::errorChannel $of } } test tcltest-6.6 {tcltest::errorFile (implicit errorChannel)} { -setup { set ef [makeFile {} efile] set of [errorFile] set ::tcltest::errorChannel stderr set ::tcltest::errorFile stderr } -body { set f0 [errorChannel] set f1 [errorFile] set f2 [errorFile $ef] set f3 [errorChannel] set f4 [errorFile] subst {$f0;$f1;$f2;$f3;$f4} } -result {stderr;stderr;.*efile;file[0-9a-f]+;.*efile} -match regexp -cleanup { errorFile $of removeFile efile } } test tcltest-6.7 {tcltest::outputChannel - retrieval} { -setup { set of [outputChannel] set ::tcltest::outputChannel stdout } -body { outputChannel } -result {stdout} -cleanup { set ::tcltest::outputChannel $of } } test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} { -setup { set ef [makeFile {} efile] set of [outputFile] set ::tcltest::outputChannel stdout set ::tcltest::outputFile stdout } -body { set f0 [outputChannel] set f1 [outputFile] set f2 [outputFile $ef] set f3 [outputChannel] set f4 [outputFile] subst {$f0;$f1;$f2;$f3;$f4} } -result {stdout;stdout;.*efile;file[0-9a-f]+;.*efile} -match regexp -cleanup { outputFile $of removeFile efile } } # -debug, [debug] # Must use child processes to test -debug because it always writes # messages to stdout, and we have no way to capture stdout of a # child interp test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 0} msg regexp "Flags passed into tcltest" $msg } {0} test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg list [regexp userSpecifiedSkip $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 1 -match b*} msg list [regexp userSpecifiedNonMatch $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 2} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 0} test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 3} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 1} test tcltest-7.6 {tcltest::debug} { -setup { set old $::tcltest::debug set ::tcltest::debug 0 } -body { set f1 [debug] set f2 [debug 1] set f3 [debug] set f4 [debug 2] set f5 [debug] list $f1 $f2 $f3 $f4 $f5 } -result {0 1 1 2 2} -cleanup { set ::tcltest::debug $old } } removeFile test.tcl # directory tests set a [makeFile { package require tcltest 2.5 tcltest::makeFile {} a.tmp puts [tcltest::outputChannel] "testdir: [tcltest::testsDirectory]" exit } a.tcl] set tdiaf [makeFile {} thisdirectoryisafile] set normaldirectory [makeDirectory normaldirectory] normalizePath normaldirectory # -tmpdir, [temporaryDirectory] test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup { file delete -force thisdirectorydoesnotexist } -body { child msg $a -tmpdir thisdirectorydoesnotexist file exists [file join thisdirectorydoesnotexist a.tmp] } -cleanup { file delete -force thisdirectorydoesnotexist } -result 1 test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} { -constraints unixOrWin -body { child msg $a -tmpdir $tdiaf return $msg } -result {*not a directory*} -match glob } # Test non-writable directories, non-readable directories with directory flags set notReadableDir [file join [temporaryDirectory] notreadable] set notWritableDir [file join [temporaryDirectory] notwritable] makeDirectory notreadable makeDirectory notwritable switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 0o333 file attributes $notWritableDir -permissions 0o555 } default { # note in FAT/NTFS we won't be able to protect directory with read-only attribute... catch {file attributes $notWritableDir -readonly 1} catch {testchmod 0o444 $notWritableDir} } } test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} { -constraints {unix notRoot notWsl} -body { child msg $a -tmpdir $notReadableDir return $msg } -result {*not readable*} -match glob } # This constraint doesn't go at the top of the file so that it doesn't # interfere with tcltest-5.5 testConstraint notFAT [expr { ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWritableDir] 1]] || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]] }] # FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used test tcltest-8.4 {tcltest a.tcl -tmpdir notWritableDir} { -constraints {unixOrWin notRoot notFAT notWsl} -body { child msg $a -tmpdir $notWritableDir return $msg } -result {*not writable*} -match glob } test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} { -constraints unixOrWin -body { child msg $a -tmpdir $normaldirectory # The join is necessary because the message can be split on multiple # lines file exists [file join $normaldirectory a.tmp] } -cleanup { catch {file delete [file join $normaldirectory a.tmp]} } -result 1 } cd [workingDirectory] test tcltest-8.6 {temporaryDirectory} { -setup { set old $::tcltest::temporaryDirectory set ::tcltest::temporaryDirectory $normaldirectory } -body { set f1 [temporaryDirectory] set f2 [temporaryDirectory [workingDirectory]] set f3 [temporaryDirectory] list $f1 $f2 $f3 } -result "[list $normaldirectory [workingDirectory] [workingDirectory]]" -cleanup { set ::tcltest::temporaryDirectory $old } } test tcltest-8.6a {temporaryDirectory - test format 2} -setup { set old $::tcltest::temporaryDirectory set ::tcltest::temporaryDirectory $normaldirectory } -body { set f1 [temporaryDirectory] set f2 [temporaryDirectory [workingDirectory]] set f3 [temporaryDirectory] list $f1 $f2 $f3 } -cleanup { set ::tcltest::temporaryDirectory $old } -result [list $normaldirectory [workingDirectory] [workingDirectory]] cd [temporaryDirectory] # -testdir, [testsDirectory] test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} { -constraints unixOrWin -setup { file delete -force thisdirectorydoesnotexist } -body { child msg $a -testdir thisdirectorydoesnotexist return $msg } -match glob -result {*does not exist*} } test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} { -constraints unixOrWin -body { child msg $a -testdir $tdiaf return $msg } -match glob -result {*not a directory*} } test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} { -constraints {unix notRoot notWsl} -body { child msg $a -testdir $notReadableDir return $msg } -match glob -result {*not readable*} } test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} { -constraints unixOrWin -body { child msg $a -testdir $normaldirectory # The join is necessary because the message can be split on multiple # lines list [string first "testdir: $normaldirectory" [join $msg]] \ [file exists [file join [temporaryDirectory] a.tmp]] } -cleanup { file delete [file join [temporaryDirectory] a.tmp] } -result {0 1} } cd [workingDirectory] set current [pwd] test tcltest-8.14 {testsDirectory} { -setup { set old $::tcltest::testsDirectory set ::tcltest::testsDirectory $normaldirectory } -body { set f1 [testsDirectory] set f2 [testsDirectory $current] set f3 [testsDirectory] list $f1 $f2 $f3 } -result "[list $normaldirectory $current $current]" -cleanup { set ::tcltest::testsDirectory $old } } # [workingDirectory] test tcltest-8.60 {::workingDirectory} { -setup { set old $::tcltest::workingDirectory set current [pwd] set ::tcltest::workingDirectory $normaldirectory cd $normaldirectory } -body { set f1 [workingDirectory] set f2 [pwd] set f3 [workingDirectory $current] set f4 [pwd] set f5 [workingDirectory] list $f1 $f2 $f3 $f4 $f5 } -result "[list $normaldirectory \ $normaldirectory \ $current \ $current \ $current]" -cleanup { set ::tcltest::workingDirectory $old cd $current } } # clean up from directory testing switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 0o777 file attributes $notWritableDir -permissions 0o777 } default { catch {testchmod 0o777 $notWritableDir} catch {file attributes $notWritableDir -readonly 0} } } file delete -force -- $notReadableDir $notWritableDir removeFile a.tcl removeFile thisdirectoryisafile removeDirectory normaldirectory # -file, -notfile, [matchFiles], [skipFiles] test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { child msg [file join [testsDirectory] all.tcl] -file d*.test return $msg } -cleanup { testsDirectory $old } -match regexp -result {dstring\.test} test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { child msg [file join [testsDirectory] all.tcl] \ -file d*.test -notfile dstring* regexp {dstring\.test} $msg } -cleanup { testsDirectory $old } -result 0 test tcltest-9.3 {matchFiles} { -body { set old [matchFiles] matchFiles foo set current [matchFiles] matchFiles bar set new [matchFiles] matchFiles $old list $current $new } -result {foo bar} } test tcltest-9.4 {skipFiles} { -body { set old [skipFiles] skipFiles foo set current [skipFiles] skipFiles bar set new [skipFiles] skipFiles $old list $current $new } -result {foo bar} } test tcltest-9.5 {GetMatchingFiles: Bug 1119798} -setup { set d [makeDirectory tmp] makeDirectory foo $d makeFile {} fee $d file copy [file join [file dirname [info script]] all.tcl] $d } -body { child msg [file join [temporaryDirectory] all.tcl] -file f* regexp {exiting with errors:} $msg } -cleanup { file delete [file join $d all.tcl] removeFile fee $d removeDirectory foo $d removeDirectory tmp } -result 0 # -preservecore, [preserveCore] set mc [makeFile { package require tcltest 2.5 namespace import ::tcltest::test test makecore {make a core file} { set f [open core w] close $f } {} ::tcltest::cleanupTests return } makecore.tcl] cd [temporaryDirectory] test tcltest-10.1 {-preservecore 0} {unixOrWin} { child msg $mc -preservecore 0 file delete core regexp "Core file produced" $msg } {0} test tcltest-10.2 {-preservecore 1} {unixOrWin} { child msg $mc -preservecore 1 file delete core regexp "Core file produced" $msg } {1} test tcltest-10.3 {-preservecore 2} {unixOrWin} { child msg $mc -preservecore 2 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} test tcltest-10.4 {-preservecore 3} {unixOrWin} { child msg $mc -preservecore 3 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} # Removing this test. It makes no sense to test the ability of # [preserveCore] to accept an invalid value that will cause errors # in other parts of tcltest's operation. #test tcltest-10.5 {preserveCore} { # -body { # set old [preserveCore] # set result [preserveCore foo] # set result2 [preserveCore] # preserveCore $old # list $result $result2 # } # -result {foo foo} #} removeFile makecore.tcl # -load, -loadfile, [loadScript], [loadFile] set contents { package require tcltest 2.5 namespace import tcltest::* puts [outputChannel] $::tcltest::loadScript exit } set loadfile [makeFile $contents load.tcl] test tcltest-12.1 {-load xxx} {unixOrWin} { child msg $loadfile -load xxx return $msg } {xxx} # Using child process because of -debug usage. test tcltest-12.2 {-loadfile load.tcl} {unixOrWin} { catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg list \ [regexp {tcltest} [join [list $msg] [split $msg \n]]] \ [regexp {loadScript} [join [list $msg] [split $msg \n]]] } {1 1} test tcltest-12.3 {loadScript} { -setup { set old $::tcltest::loadScript set ::tcltest::loadScript {} } -body { set f1 [loadScript] set f2 [loadScript xxx] set f3 [loadScript] list $f1 $f2 $f3 } -result {{} xxx xxx} -cleanup { set ::tcltest::loadScript $old } } test tcltest-12.4 {loadFile} { -setup { set olds $::tcltest::loadScript set ::tcltest::loadScript {} set oldf $::tcltest::loadFile set ::tcltest::loadFile {} } -body { set f1 [loadScript] set f2 [loadFile] set f3 [loadFile $loadfile] set f4 [loadScript] set f5 [loadFile] list $f1 $f2 $f3 $f4 $f5 } -result "[list {} {} $loadfile $contents $loadfile]\n" -cleanup { set ::tcltest::loadScript $olds set ::tcltest::loadFile $oldf } } removeFile load.tcl # [interpreter] test tcltest-13.1 {interpreter} { -constraints notValgrind -setup { #to do: Why is $::tcltest::tcltest being saved and restored here? set old $::tcltest::tcltest set ::tcltest::tcltest tcltest } -body { set f1 [interpreter] set f2 [interpreter tclsh] set f3 [interpreter] list $f1 $f2 $f3 } -result {tcltest tclsh tclsh} -cleanup { # writing ::tcltest::tcltest triggers a trace that sets up the stdio # constraint, which involves a call to [exec] that might fail after # "fork" and before "exec", in which case the forked process will not # have a chance to clean itself up before exiting, which causes # valgrind to issue numerous "still reachable" reports. set ::tcltest::tcltest $old } } # -singleproc, [singleProcess] set spd [makeDirectory singleprocdir] makeFile { set foo 1 } single1.test $spd makeFile { unset foo } single2.test $spd set allfile [makeFile { package require tcltest 2.5 namespace import tcltest::* testsDirectory [file join [temporaryDirectory] singleprocdir] runAllTests } all-single.tcl $spd] cd [workingDirectory] test tcltest-14.1 {-singleproc - single process} { -constraints {unixOrWin} -body { child msg $allfile -singleproc 0 -tmpdir [temporaryDirectory] return $msg } -result {Test file error: can't unset .foo.: no such variable} -match regexp } test tcltest-14.2 {-singleproc - multiple process} { -constraints {unixOrWin} -body { child msg $allfile -singleproc 1 -tmpdir [temporaryDirectory] return $msg } -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0} -match regexp } test tcltest-14.3 {singleProcess} { -setup { set old $::tcltest::singleProcess set ::tcltest::singleProcess 0 } -body { set f1 [singleProcess] set f2 [singleProcess 1] set f3 [singleProcess] list $f1 $f2 $f3 } -result {0 1 1} -cleanup { set ::tcltest::singleProcess $old } } removeFile single1.test $spd removeFile single2.test $spd removeDirectory singleprocdir # -asidefromdir, -relateddir, [matchDirectories], [skipDirectories] # Before running these tests, need to set up test subdirectories with their own # all.tcl files. set dtd [makeDirectory dirtestdir] set dtd1 [makeDirectory dirtestdir2.1 $dtd] set dtd2 [makeDirectory dirtestdir2.2 $dtd] set dtd3 [makeDirectory dirtestdir2.3 $dtd] makeFile { package require tcltest 2.5 namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir] runAllTests } all.tcl $dtd makeFile { package require tcltest 2.5 namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.1] runAllTests } all.tcl $dtd1 makeFile { package require tcltest 2.5 namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.2] runAllTests } all.tcl $dtd2 makeFile { package require tcltest 2.5 namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3] runAllTests } all.tcl $dtd3 test tcltest-15.1 {basic directory walking} { -constraints {unixOrWin} -body { if {[child msg \ [file join $dtd all.tcl] \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -match regexp -returnCodes 1 -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123]} } test tcltest-15.2 {-asidefromdir} { -constraints {unixOrWin} -body { if {[child msg \ [file join $dtd all.tcl] \ -asidefromdir dirtestdir2.3 \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -match regexp -returnCodes 1 -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[12].*Tests located in:.*dirtestdir2.[12].*dirtestdir2.[12] test ended at .*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Error: No test files remain after applying your match and skip patterns! Error: No test files remain after applying your match and skip patterns! Error: No test files remain after applying your match and skip patterns!$} } test tcltest-15.3 {-relateddir, non-existent dir} { -constraints {unixOrWin} -body { if {[child msg \ [file join $dtd all.tcl] \ -relateddir [file join [temporaryDirectory] dirtestdir0] \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -returnCodes 1 -match regexp -result {[^~]|dirtestdir[^2]} } test tcltest-15.4 {-relateddir, subdir} { -constraints {unixOrWin} -body { if {[child msg \ [file join $dtd all.tcl] \ -relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} { error $msg } } -returnCodes 1 -match regexp -result {Tests located in:.*dirtestdir2.[^23]} } test tcltest-15.5 {-relateddir, -asidefromdir} { -constraints {unixOrWin} -body { if {[child msg \ [file join $dtd all.tcl] \ -relateddir "dirtestdir2.1 dirtestdir2.2" \ -asidefromdir dirtestdir2.2 \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -match regexp -returnCodes 1 -result {Tests located in:.*dirtestdir2.[^23]} } test tcltest-15.6 {matchDirectories} { -setup { set old [matchDirectories] set ::tcltest::matchDirectories {} } -body { set r1 [matchDirectories] set r2 [matchDirectories foo] set r3 [matchDirectories] list $r1 $r2 $r3 } -cleanup { set ::tcltest::matchDirectories $old } -result {{} foo foo} } test tcltest-15.7 {skipDirectories} { -setup { set old [skipDirectories] set ::tcltest::skipDirectories {} } -body { set r1 [skipDirectories] set r2 [skipDirectories foo] set r3 [skipDirectories] list $r1 $r2 $r3 } -cleanup { set ::tcltest::skipDirectories $old } -result {{} foo foo} } removeDirectory dirtestdir2.3 $dtd removeDirectory dirtestdir2.2 $dtd removeDirectory dirtestdir2.1 $dtd removeDirectory dirtestdir # TCLTEST_OPTIONS test tcltest-19.1 {TCLTEST_OPTIONS default} -setup { if {[info exists ::env(TCLTEST_OPTIONS)]} { set oldoptions $::env(TCLTEST_OPTIONS) } else { set oldoptions none } # set this to { } instead of just {} to get around quirk in # Windows env handling that removes empty elements from env array. set ::env(TCLTEST_OPTIONS) { } interp create child1 child1 eval [list set argv {-debug 2}] child1 alias puts puts interp create child2 child2 alias puts puts } -cleanup { interp delete child2 interp delete child1 if {$oldoptions eq "none"} { unset ::env(TCLTEST_OPTIONS) } else { set ::env(TCLTEST_OPTIONS) $oldoptions } } -body { child1 eval [package ifneeded tcltest [package provide tcltest]] child1 eval tcltest::debug set ::env(TCLTEST_OPTIONS) "-debug 3" child2 eval [package ifneeded tcltest [package provide tcltest]] child2 eval tcltest::debug } -result {^3$} -match regexp -output\ {tcltest::debug\s+= 2.*tcltest::debug\s+= 3} # Begin testing of tcltest procs ... cd [temporaryDirectory] # PrintError test tcltest-20.1 {PrintError} {unixOrWin} { set result [child msg $printerror] list $result [regexp "Error: a really short string" $msg] \ [regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \ [regexp " \"Really" $msg] [regexp Problem $msg] } {1 1 1 1 1 1} cd [workingDirectory] removeFile printerror.tcl # test::test test tcltest-21.0 {name and desc but no args specified} -setup { set v [verbose] } -cleanup { verbose $v } -body { verbose {} test tcltest-21.0.0 bar } -result {} test tcltest-21.1 {expect with glob} { -body { list a b c d e } -match glob -result {[ab] b c d e} } test tcltest-21.2 {force a test command failure} { -body { test tcltest-21.2.0 { return 2 } {1} } -returnCodes 1 -result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} } test tcltest-21.3 {test command with setup} { -setup { set foo 1 } -body { set foo } -cleanup {unset foo} -result {1} } test tcltest-21.4 {test command with cleanup failure} { -setup { if {[info exists foo]} { unset foo } set fail $::tcltest::currentFailure set v [verbose] } -body { verbose {} test tcltest-21.4.0 {foo-1} { -cleanup {unset foo} } } -result {^$} -match regexp -cleanup {verbose $v; set ::tcltest::currentFailure $fail} -output "Test cleanup failed:.*can't unset \"foo\": no such variable" } test tcltest-21.5 {test command with setup failure} { -setup { if {[info exists foo]} { unset foo } set fail $::tcltest::currentFailure } -body { test tcltest-21.5.0 {foo-2} { -setup {unset foo} } } -result {^$} -match regexp -cleanup {set ::tcltest::currentFailure $fail} -output "Test setup failed:.*can't unset \"foo\": no such variable" } test tcltest-21.6 {test command - setup occurs before cleanup & before script} { -setup {set v [verbose]; set fail $::tcltest::currentFailure} -body { verbose {} test tcltest-21.6.0 {foo-3} { -setup { if {[info exists foo]} { unset foo } set foo 1 set expected 2 } -body { incr foo set foo } -cleanup { if {$foo != 2} { puts [outputChannel] "foo is wrong" } else { puts [outputChannel] "foo is 2" } } -result {$expected} } } -cleanup {verbose $v; set ::tcltest::currentFailure $fail} -result {^$} -match regexp -output "foo is 2" } test tcltest-21.7 {test command - bad flag} { -setup {set fail $::tcltest::currentFailure} -cleanup {set ::tcltest::currentFailure $fail} -body { test tcltest-21.7.0 {foo-4} { -foobar {} } } -returnCodes 1 -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} } # alternate test command format (these are the same as 21.1-21.6, with the # exception of being in the all-inline format) test tcltest-21.7a {expect with glob} \ -body {list a b c d e} \ -result {[ab] b c d e} \ -match glob test tcltest-21.8 {force a test command failure} \ -setup {set fail $::tcltest::currentFailure} \ -body { test tcltest-21.8.0 { return 2 } {1} } \ -returnCodes 1 \ -cleanup {set ::tcltest::currentFailure $fail} \ -result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} test tcltest-21.9 {test command with setup} \ -setup {set foo 1} \ -body {set foo} \ -cleanup {unset foo} \ -result {1} test tcltest-21.10 {test command with cleanup failure} -setup { if {[info exists foo]} { unset foo } set fail $::tcltest::currentFailure set v [verbose] } -cleanup { verbose $v set ::tcltest::currentFailure $fail } -body { verbose {} test tcltest-21.10.0 {foo-1} -cleanup {unset foo} } -result {^$} -match regexp \ -output {Test cleanup failed:.*can't unset \"foo\": no such variable} test tcltest-21.11 {test command with setup failure} -setup { if {[info exists foo]} { unset foo } set fail $::tcltest::currentFailure } -cleanup {set ::tcltest::currentFailure $fail} -body { test tcltest-21.11.0 {foo-2} -setup {unset foo} } -result {^$} -output {Test setup failed:.*can't unset \"foo\": no such variable} -match regexp test tcltest-21.12 { test command - setup occurs before cleanup & before script } -setup { set fail $::tcltest::currentFailure set v [verbose] } -cleanup { verbose $v set ::tcltest::currentFailure $fail } -body { verbose {} test tcltest-21.12.0 {foo-3} -setup { if {[info exists foo]} { unset foo } set foo 1 set expected 2 } -body { incr foo set foo } -cleanup { if {$foo != 2} { puts [outputChannel] "foo is wrong" } else { puts [outputChannel] "foo is 2" } } -result {$expected} } -result {^$} -output {foo is 2} -match regexp # test all.tcl usage (runAllTests); simulate .test file failure, as well as # crashes to determine whether or not these errors are logged. set atd [makeDirectory alltestdir] makeFile { package require tcltest 2.5 namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] alltestdir] runAllTests } all.tcl $atd makeFile { exit 1 } exit.test $atd makeFile { error "throw an error" } error.test $atd makeFile { package require tcltest 2.5 namespace import -force tcltest::* test foo-1.1 {foo} { -body { return 1 } -result {1} } cleanupTests } test.test $atd # Must use a child process because stdout/stderr parsing can't be # duplicated in child interp. test tcltest-22.1 {runAllTests} { -constraints {unixOrWin} -body { exec [interpreter] \ [file join $atd all.tcl] \ -verbose t -tmpdir [temporaryDirectory] } -match regexp -result "Test files exiting with errors:.*error.test.*exit.test" } removeDirectory alltestdir # makeFile, removeFile, makeDirectory, removeDirectory, viewFile test tcltest-23.1 {makeFile} { -setup { set mfdir [file join [temporaryDirectory] mfdir] file mkdir $mfdir } -body { makeFile {} t1.tmp makeFile {} et1.tmp $mfdir list [file exists [file join [temporaryDirectory] t1.tmp]] \ [file exists [file join $mfdir et1.tmp]] } -cleanup { file delete -force $mfdir \ [file join [temporaryDirectory] t1.tmp] } -result {1 1} } test tcltest-23.2 {removeFile} { -setup { set mfdir [file join [temporaryDirectory] mfdir] file mkdir $mfdir makeFile {} t1.tmp makeFile {} et1.tmp $mfdir if {![file exists [file join [temporaryDirectory] t1.tmp]] || \ ![file exists [file join $mfdir et1.tmp]]} { error "file creation didn't work" } } -body { removeFile t1.tmp removeFile et1.tmp $mfdir list [file exists [file join [temporaryDirectory] t1.tmp]] \ [file exists [file join $mfdir et1.tmp]] } -cleanup { file delete -force $mfdir \ [file join [temporaryDirectory] t1.tmp] } -result {0 0} } test tcltest-23.3 {makeDirectory} { -body { set mfdir [file join [temporaryDirectory] mfdir] file mkdir $mfdir makeDirectory d1 makeDirectory d2 $mfdir list [file exists [file join [temporaryDirectory] d1]] \ [file exists [file join $mfdir d2]] } -cleanup { file delete -force [file join [temporaryDirectory] d1] $mfdir } -result {1 1} } test tcltest-23.4 {removeDirectory} { -setup { set mfdir [makeDirectory mfdir] makeDirectory t1 makeDirectory t2 $mfdir if {![file exists $mfdir] || \ ![file exists [file join [temporaryDirectory] $mfdir t2]]} { error "setup failed - directory not created" } } -body { removeDirectory t1 removeDirectory t2 $mfdir list [file exists [file join [temporaryDirectory] t1]] \ [file exists [file join $mfdir t2]] } -result {0 0} } test tcltest-23.5 {viewFile} { -body { set mfdir [file join [temporaryDirectory] mfdir] file mkdir $mfdir makeFile {foobar} t1.tmp makeFile {foobarbaz} t2.tmp $mfdir list [viewFile t1.tmp] [viewFile t2.tmp $mfdir] } -result {foobar foobarbaz} -cleanup { file delete -force $mfdir removeFile t1.tmp } } # customMatch proc matchNegative { expected actual } { set match 0 foreach a $actual e $expected { if { $a != $e } { set match 1 break } } return $match } test tcltest-24.0 { customMatch: syntax } -body { list [catch {customMatch} result] $result } -result [list 1 "wrong # args: should be \"customMatch mode script\""] test tcltest-24.1 { customMatch: syntax } -body { list [catch {customMatch foo} result] $result } -result [list 1 "wrong # args: should be \"customMatch mode script\""] test tcltest-24.2 { customMatch: syntax } -body { list [catch {customMatch foo bar baz} result] $result } -result [list 1 "wrong # args: should be \"customMatch mode script\""] test tcltest-24.3 { customMatch: argument checking } -body { list [catch {customMatch bad "a \{ b"} result] $result } -result [list 1 "invalid customMatch script; can't evaluate after completion"] test tcltest-24.4 { test: valid -match values } -body { list [catch { test tcltest-24.4.0 {} \ -match [namespace current]::noSuchMode } result] $result } -match glob -result {1 *bad -match value*} test tcltest-24.5 { test: valid -match values } -setup { customMatch [namespace current]::alwaysMatch "format 1 ;#" } -body { list [catch { test tcltest-24.5.0 {} \ -match [namespace current]::noSuchMode } result] $result } -match glob -result {1 *bad -match value*: must be *alwaysMatch,*} test tcltest-24.6 { customMatch: -match script that always matches } -setup { customMatch [namespace current]::alwaysMatch "format 1 ;#" set v [verbose] } -body { verbose {} test tcltest-24.6.0 {} -match [namespace current]::alwaysMatch \ -body {format 1} -result 0 } -cleanup { verbose $v } -result {} -output {} -errorOutput {} test tcltest-24.7 { customMatch: replace default -exact matching } -setup { set saveExactMatchScript $::tcltest::CustomMatch(exact) customMatch exact "format 1 ;#" set v [verbose] } -body { verbose {} test tcltest-24.7.0 {} -body {format 1} -result 0 } -cleanup { verbose $v customMatch exact $saveExactMatchScript unset saveExactMatchScript } -result {} -output {} test tcltest-24.9 { customMatch: error during match } -setup { proc errorDuringMatch args {return -code error "match returned error"} customMatch [namespace current]::errorDuringMatch \ [namespace code errorDuringMatch] set v [verbose] set fail $::tcltest::currentFailure } -body { verbose {} test tcltest-24.9.0 {} -match [namespace current]::errorDuringMatch } -cleanup { verbose $v set ::tcltest::currentFailure $fail } -match glob -result {} -output {*FAILED*match returned error*} test tcltest-24.10 { customMatch: bad return from match command } -setup { proc nonBooleanReturn args {return foo} customMatch nonBooleanReturn [namespace code nonBooleanReturn] set v [verbose] set fail $::tcltest::currentFailure } -body { verbose {} test tcltest-24.10.0 {} -match nonBooleanReturn } -cleanup { verbose $v set ::tcltest::currentFailure $fail } -match glob -result {} -output {*FAILED*expected boolean value*} test tcltest-24.11 { test: -match exact } -body { set result {A B C} } -match exact -result {A B C} test tcltest-24.12 { test: -match exact match command eval in ::, not caller namespace } -setup { set saveExactMatchScript $::tcltest::CustomMatch(exact) customMatch exact [list string equal] set v [verbose] proc string args {error {called [string] in caller namespace}} } -body { verbose {} test tcltest-24.12.0 {} -body {format 1} -result 1 } -cleanup { rename string {} verbose $v customMatch exact $saveExactMatchScript unset saveExactMatchScript } -match exact -result {} -output {} test tcltest-24.13 { test: -match exact failure } -setup { set saveExactMatchScript $::tcltest::CustomMatch(exact) customMatch exact [list string equal] set v [verbose] set fail $::tcltest::currentFailure } -body { verbose {} test tcltest-24.13.0 {} -body {format 1} -result 0 } -cleanup { set ::tcltest::currentFailure $fail verbose $v customMatch exact $saveExactMatchScript unset saveExactMatchScript } -match glob -result {} -output {*FAILED*Result was: 1*(exact matching): 0*} test tcltest-24.14 { test: -match glob } -body { set result {A B C} } -match glob -result {A B*} test tcltest-24.15 { test: -match glob failure } -setup { set v [verbose] set fail $::tcltest::currentFailure } -body { verbose {} test tcltest-24.15.0 {} -match glob -body {format {A B C}} \ -result {A B* } } -cleanup { set ::tcltest::currentFailure $fail verbose $v } -match glob -result {} -output {*FAILED*Result was: *(glob matching): *} test tcltest-24.16 { test: -match regexp } -body { set result {A B C} } -match regexp -result {A B.*} test tcltest-24.17 { test: -match regexp failure } -setup { set fail $::tcltest::currentFailure set v [verbose] } -body { verbose {} test tcltest-24.17.0 {} -match regexp -body {format {A B C}} \ -result {A B.* X} } -cleanup { set ::tcltest::currentFailure $fail verbose $v } -match glob -result {} -output {*FAILED*Result was: *(regexp matching): *} test tcltest-24.18 { test: -match custom forget namespace qualification } -setup { set fail $::tcltest::currentFailure set v [verbose] customMatch negative matchNegative } -body { verbose {} test tcltest-24.18.0 {} -match negative -body {format {A B C}} \ -result {A B X} } -cleanup { set ::tcltest::currentFailure $fail verbose $v } -match glob -result {} -output {*FAILED*Error testing result:*} test tcltest-24.19 { test: -match custom } -setup { set v [verbose] customMatch negative [namespace code matchNegative] } -body { verbose {} test tcltest-24.19.0 {} -match negative -body {format {A B C}} \ -result {A B X} } -cleanup { verbose $v } -match exact -result {} -output {} test tcltest-24.20 { test: -match custom failure } -setup { set fail $::tcltest::currentFailure set v [verbose] customMatch negative [namespace code matchNegative] } -body { verbose {} test tcltest-24.20.0 {} -match negative -body {format {A B C}} \ -result {A B C} } -cleanup { set ::tcltest::currentFailure $fail verbose $v } -match glob -result {} -output {*FAILED*Result was: *(negative matching): *} test tcltest-25.1 { constraint of setup/cleanup (Bug 589859) } -setup { set foo 0 } -body { # Buggy tcltest will generate result of 2 test tcltest-25.1.0 {} -constraints knownBug -setup { incr foo } -body { incr foo } -cleanup { incr foo } -match glob -result * set foo } -cleanup { unset foo } -result 0 test tcltest-25.2 { puts -nonewline (Bug 612786) } -body { puts -nonewline stdout bla puts -nonewline stdout bla } -output {blabla} test tcltest-25.3 { reported return code (Bug 611922) } -setup { set fail $::tcltest::currentFailure set v [verbose] } -body { verbose {} test tcltest-25.3.0 {} -body { error foo } } -cleanup { set ::tcltest::currentFailure $fail verbose $v } -match glob -output {*generated error; Return code was: 1*} test tcltest-26.1 {Bug/RFE 1017151} -setup { makeFile { package require tcltest 2.5 set ::errorInfo "Should never see this" tcltest::test tcltest-26.1.0 { no errorInfo when only return code mismatch } -body { set x 1 } -returnCodes error -result 1 tcltest::cleanupTests } test.tcl } -body { child msg [file join [temporaryDirectory] test.tcl] return $msg } -cleanup { removeFile test.tcl } -match glob -result {* ---- Return code should have been one of: 1 ==== tcltest-26.1.0 FAILED*} test tcltest-26.2 {Bug/RFE 1017151} -setup { makeFile { package require tcltest 2.5 set ::errorInfo "Should never see this" tcltest::test tcltest-26.2.0 {do not mask body errorInfo} -body { error "body error" } -cleanup { error "cleanup error" } -result 1 tcltest::cleanupTests } test.tcl } -body { child msg [file join [temporaryDirectory] test.tcl] return $msg } -cleanup { removeFile test.tcl } -match glob -result {* ---- errorInfo: body error * ---- errorInfo(cleanup): cleanup error*} cleanupTests } namespace delete ::tcltest::test return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/thread.test0000644000175000017500000015016014554262142015157 0ustar sergeisergei# Commands covered: (test)thread # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # when thread::release is used, -wait is passed in order allow the thread to # be fully finalized, which avoids valgrind "still reachable" reports. package require tcltest 2.5 source [file join [file dirname [info script]] tcltests.tcl] ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Some tests require the testthread command testConstraint testthread [expr {[info commands testthread] ne {}}] set threadSuperKillScript { rename catch "" rename while "" rename unknown "" rename update "" thread::release } proc getThreadErrorFromInfo { info } { set list [split $info \n] set idx [lsearch -glob $list "*eval*unwound*"] if {$idx >= 0} then { return [lindex $list $idx] } set idx [lsearch -glob $list "*eval*canceled*"] if {$idx >= 0} then { return [lindex $list $idx] } return ""; # some other error we do not care about. } proc findThreadError { info } { foreach error [lreverse $info] { set error [getThreadErrorFromInfo $error] if {[string length $error] > 0} then { return $error } } return ""; # some other error we do not care about. } proc ThreadError {id info} { global threadSawError if {[string length [getThreadErrorFromInfo $info]] > 0} then { global threadId threadError set threadId $id lappend threadError($id) $info } set threadSawError($id) true; # signal main thread to exit [vwait]. } proc threadSuperKill id { variable threadSuperKillScript try { thread::send $id $::threadSuperKillScript } on error {tres topts} { if {$tres ne {target thread died}} { return -options $topts $tres } } } if {[testConstraint thread]} { thread::errorproc ThreadError } if {[testConstraint testthread]} { proc drainEventQueue {} { while {[set x [testthread event]]} { #puts "WARNING: drained $x event(s) on main thread" } } testthread errorproc ThreadError } # Some tests require manual draining of the event queue testConstraint drainEventQueue [expr {[info commands drainEventQueue] != {}}] test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} { llength [thread::names] } 1 test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} { set serverthread [thread::create -preserved] set numthreads [llength [thread::names]] thread::release -wait $serverthread set numthreads } 2 test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} { thread::create {set x 5} foreach try {0 1 2 4 5 6} { # Try various ways to yield update after 10 set l [llength [thread::names]] if {$l == 1} { break } } set l } 1 test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} { thread::create {{*}{}} update after 10 llength [thread::names] } {1} test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} { set serverthread [thread::create -preserved] set five [thread::send $serverthread {set x 5}] thread::release -wait $serverthread set five } 5 test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} { set serverthread [thread::create -preserved {set z 5 ; thread::wait}] set five [thread::send $serverthread {set z}] thread::release -wait $serverthread set five } 5 # The tests above also cover: # TclCreateThread, except when pthread_create fails # NewThread, safe and regular # ThreadErrorProc, except for printing to standard error test thread-2.1 {ListUpdateInner and ListRemove} {thread} { catch {unset tid} foreach t {0 1 2} { upvar #0 t$t tid set tid [thread::create -preserved] } foreach t {0 1 2} { upvar #0 t$t tid thread::release $tid } llength [thread::names] } 1 test thread-3.1 {TclThreadList} {thread} { catch {unset tid} set len [llength [thread::names]] set l1 {} foreach t {0 1 2} { lappend l1 [thread::create -preserved] } set l2 [thread::names] set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]] foreach t $l1 { thread::release -wait $t } list $len $c } {1 0} test thread-4.1 {TclThreadSend to self} {thread} { catch {unset x} thread::send [thread::id] { set x 4 } set x } {4} test thread-4.2 {TclThreadSend -async} {thread} { set len [llength [thread::names]] set serverthread [thread::create -preserved] thread::send -async $serverthread { after 1 {thread::release} } set two [llength [thread::names]] after 100 {set done 1} vwait done list $len [llength [thread::names]] $two } {1 1 2} test thread-4.3 {TclThreadSend preserve errorInfo} {thread} { set len [llength [thread::names]] set serverthread [thread::create -preserved] set x [catch {thread::send $serverthread {set undef}} msg] set savedErrorInfo $::errorInfo thread::release $serverthread list $len $x $msg $savedErrorInfo } {1 1 {can't read "undef": no such variable} {can't read "undef": no such variable while executing "set undef" invoked from within "thread::send $serverthread {set undef}"}} test thread-4.4 {TclThreadSend preserve code} {thread} { set len [llength [thread::names]] set serverthread [thread::create -preserved] set ::errorInfo {} set x [catch {thread::send $serverthread {set ::errorInfo {}; break}} msg] set savedErrorInfo $::errorInfo thread::release $serverthread list $len $x $msg $savedErrorInfo } {1 3 {} {}} test thread-4.5 {TclThreadSend preserve errorCode} {thread} { set serverthread [thread::create] set x [catch {thread::send $serverthread {error ERR INFO CODE}} msg] set savedErrorCode $::errorCode thread::release $serverthread list $x $msg $savedErrorCode } {1 ERR CODE} test thread-5.0 {Joining threads} {thread} { set serverthread [thread::create -joinable -preserved] thread::send -async $serverthread {after 1000 ; thread::release} thread::join $serverthread } {0} test thread-5.1 {Joining threads after the fact} {thread} { set serverthread [thread::create -joinable -preserved] thread::send -async $serverthread {thread::release} after 2000 thread::join $serverthread } {0} test thread-5.2 {Try to join a detached thread} {thread} { set serverthread [thread::create -preserved] thread::send -async $serverthread {after 1000 ; thread::release} catch {set res [thread::join $serverthread]} msg while {[llength [thread::names]] > 1} { after 20 } lrange $msg 0 2 } {cannot join thread} test thread-6.1 {freeing very large object trees in a thread} thread { # conceptual duplicate of obj-32.1 set serverthread [thread::create -preserved] thread::send -async $serverthread { set x {} for {set i 0} {$i<100000} {incr i} { set x [list $x {}] } unset x } thread::release -wait $serverthread } 0 # TIP #285: Script cancellation support test thread-7.4 {cancel: pure bytecode loop} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} { # No bytecode at all here... } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} test thread-7.5 {cancel: pure inside-command loop} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while $while {1} { # No bytecode at all here... } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} test thread-7.6 {cancel: pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} { # No bytecode at all here... } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.7 {cancel: pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while $while {1} { # No bytecode at all here... } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.8 {cancel: pure bytecode loop custom result} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} { # No bytecode at all here... } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread "the eval was canceled"] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {the eval was canceled}} test thread-7.9 {cancel: pure inside-command loop custom result} -constraints { thread drainEventQueue } -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while $while {1} { # No bytecode at all here... } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread "the eval was canceled"] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {the eval was canceled}} test thread-7.10 {cancel: pure bytecode loop custom result -unwind} -constraints { thread drainEventQueue } -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} { # No bytecode at all here... } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread "the eval was unwound"] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {the eval was unwound}} test thread-7.11 {cancel: pure inside-command loop custom result -unwind} -constraints { thread drainEventQueue } -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while $while {1} { # No bytecode at all here... } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread "the eval was unwound"] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {the eval was unwound}} test thread-7.12 {cancel: after} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } after 30000 }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} test thread-7.13 {cancel: after -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } after 30000 }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.14 {cancel: vwait} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } vwait forever }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} test thread-7.15 {cancel: vwait -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } vwait forever }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.16 {cancel: expr} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create] $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } expr {[while {1} {incr x}]} } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} test thread-7.17 {cancel: expr -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create] $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } expr {[while {1} {incr x}]} } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.18 {cancel: expr bignum} {thread drainEventQueue knownBug} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create] $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } # # BUGBUG: This will not cancel because libtommath # does not check Tcl_Canceled. # expr {2**99999} } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::cancel $serverthread] vwait ::threadSawError($serverthread); # WARNING: Never returns (see above). thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above). list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } {{} 1 0 {}} test thread-7.19 {cancel: expr bignum -unwind} {thread drainEventQueue knownBug} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create] $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } # # BUGBUG: This will not cancel because libtommath # does not check Tcl_Canceled. # expr {2**99999} } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread); # WARNING: Never returns (see above). thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above). list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } {{} 1 0 {}} test thread-7.20 {cancel: subst} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create] $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } subst {[while {1} {incr x}]} } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} test thread-7.21 {cancel: subst -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create] $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } subst {[while {1} {incr x}]} } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.22 {cancel: child interp} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create] $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} {} } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} test thread-7.23 {cancel: child interp -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create] $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while; $while {1} {} } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainEventQueue} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { while {1} { catch { while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::cancel $serverthread] threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } {{} 1 0 {}} test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread drainEventQueue} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while $while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { $while {1} { $catch { $while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::cancel $serverthread] threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } {{} 1 0 {}} test thread-7.26 {cancel: send async cancel bad interp path} {thread drainEventQueue} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } update } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted catch {thread::send $serverthread {interp cancel -- bad}} msg thread::send -async $serverthread {interp cancel -unwind} vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list [expr {$::threadIdStarted == $serverthread}] $msg } {1 {could not find interpreter "bad"}} test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { set i [interp create -- -unwind] $i eval "package require -exact Thread [package present Thread]" $i eval { proc foobar {} { while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } update } } foobar } }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::send -async $serverthread {interp cancel -- -unwind}] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {thread drainEventQueue} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { while {1} { catch { while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {interp cancel}] threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } {{} 1 1 {eval canceled}} test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {thread drainEventQueue} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while $while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { $while {1} { $catch { $while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {interp cancel}] threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } {{} 1 1 {eval canceled}} test thread-7.30 {cancel: send async thread cancel nested catch inside pure bytecode loop} {thread drainEventQueue} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { while {1} { catch { while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {thread::cancel [thread::id]}] threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } {{} 1 1 {eval canceled}} test thread-7.31 {cancel: send async thread cancel nested catch pure inside-command loop} {thread drainEventQueue} { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while $while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { $while {1} { $catch { $while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {thread::cancel [thread::id]}] threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } {{} 1 1 {eval canceled}} test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { while {1} { catch { while {1} { # No bytecode at all here... } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while $while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { $while {1} { $catch { $while {1} { # No bytecode at all here... } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { while {1} { catch { while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::send -async $serverthread {interp cancel -unwind}] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while $while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { $while {1} { $catch { $while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::send -async $serverthread {interp cancel -unwind}] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.36 {cancel: send async thread cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { while {1} { catch { while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-7.37 {cancel: send async thread cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while $while {1} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { $while {1} { $catch { $while {1} { # we must call update here because otherwise # the thread cannot even be forced to exit. update } } } } } } foobar }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}] vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError($serverthread)] ? \ [findThreadError $::threadError($serverthread)] : ""}] } -cleanup { unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} test thread-8.1 {threaded fork stress} -constraints {thread} -setup { unset -nocomplain ::threadCount ::execCount ::threads ::thread set ::threadCount 10 set ::execCount 10 } -body { set ::threads [list] for {set i 0} {$i < $::threadCount} {incr i} { lappend ::threads [thread::create -joinable [string map \ [list %execCount% $::execCount] { proc execLs {} { if {$::tcl_platform(platform) eq "windows"} then { return [exec $::env(COMSPEC) /c DIR] } else { return [exec /bin/ls] } } set j {%execCount%}; while {[incr j -1]} {execLs} }]] } foreach ::thread $::threads { thread::join $::thread } } -cleanup { unset -nocomplain ::threadCount ::execCount ::threads ::thread } -result {} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/timer.test0000644000175000017500000003626614554262142015042 0ustar sergeisergei# This file contains a collection of tests for the procedures in the # file tclTimer.c, which includes the "after" Tcl command. Sourcing # this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup { foreach i [after info] { after cancel $i } } -body { set x "" foreach i {100 200 1000 50 150} { after $i lappend x $i } after 200 set done 1 vwait done return $x } -cleanup { foreach i [after info] { after cancel $i } } -result {50 100 150 200} test timer-2.1 {Tcl_DeleteTimerHandler procedure} -setup { foreach i [after info] { after cancel $i } } -body { set x "" foreach i {100 200 1000 50 150} { after $i lappend x $i } after cancel lappend x 150 after cancel lappend x 50 after 200 set done 1 vwait done return $x } -result {100 200} # No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested # above. test timer-3.1 {TimerHandlerEventProc procedure: event masks} { set x start after 100 { set x fired } update idletasks set result $x after 200 update lappend result $x } {start fired} test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} -setup { foreach i [after info] { after cancel $i } } -body { foreach i {200 600 1000} { after $i lappend x $i } after 200 set result "" set x "" update lappend result $x after 400 update lappend result $x after 400 update lappend result $x } -result {200 {200 600} {200 600 1000}} test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} -setup { foreach i [after info] { after cancel $i } } -body { set x {} after 100 lappend x 100 set i [after 300 lappend x 300] after 200 after cancel $i after 400 update return $x } -result 100 test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} -setup { foreach i [after info] { after cancel $i } } -body { set x {} after 100 lappend x a after 200 lappend x b after 300 lappend x c after 300 vwait x return $x } -result {a b c} test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup { foreach i [after info] { after cancel $i } } -body { set x {} after 100 {lappend x a; after 0 lappend x b} after 100 vwait x return $x } -result a test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup { foreach i [after info] { after cancel $i } } -body { set x {} after 100 {lappend x a; after 100 lappend x b; after 100} after 100 vwait x set result $x vwait x lappend result $x } -result {a {a b}} # No tests for Tcl_DoWhenIdle: it's already tested by other tests # below. test timer-4.1 {Tcl_CancelIdleCall procedure} -setup { foreach i [after info] { after cancel $i } } -body { set x before set y before set z before after idle set x after1 after idle set y after2 after idle set z after3 after cancel set y after2 update idletasks list $x $y $z } -result {after1 before after3} test timer-4.2 {Tcl_CancelIdleCall procedure} -setup { foreach i [after info] { after cancel $i } } -body { set x before set y before set z before after idle set x after1 after idle set y after2 after idle set z after3 after cancel set x after1 update idletasks list $x $y $z } -result {before after2 after3} test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} -setup { foreach i [after info] { after cancel $i } } -body { set x 1 set y 23 after idle {incr x; after idle {incr x; after idle {incr x}}} after idle {incr y} vwait x set result "$x $y" update idletasks lappend result $x } -result {2 24 4} test timer-6.1 {Tcl_AfterCmd procedure, basics} -returnCodes error -body { after } -result {wrong # args: should be "after option ?arg ...?"} test timer-6.2 {Tcl_AfterCmd procedure, basics} -returnCodes error -body { after 2x } -result {bad argument "2x": must be cancel, idle, info, or an integer} test timer-6.3 {Tcl_AfterCmd procedure, basics} -returnCodes error -body { after gorp } -result {bad argument "gorp": must be cancel, idle, info, or an integer} test timer-6.4 {Tcl_AfterCmd procedure, ms argument} { set x before after 400 {set x after} after 200 update set y $x after 400 update list $y $x } {before after} test timer-6.5 {Tcl_AfterCmd procedure, ms argument} { set x before after 400 set x after after 200 update set y $x after 400 update list $y $x } {before after} test timer-6.6 {Tcl_AfterCmd procedure, cancel option} -body { after cancel } -returnCodes error -result {wrong # args: should be "after cancel id|command"} test timer-6.7 {Tcl_AfterCmd procedure, cancel option} { after cancel after#1 } {} test timer-6.8 {Tcl_AfterCmd procedure, cancel option} { after cancel {foo bar} } {} test timer-6.9 {Tcl_AfterCmd procedure, cancel option} -setup { foreach i [after info] { after cancel $i } } -body { set x before set y [after 100 set x after] after cancel $y after 200 update return $x } -result {before} test timer-6.10 {Tcl_AfterCmd procedure, cancel option} -setup { foreach i [after info] { after cancel $i } } -body { set x before after 100 set x after after cancel {set x after} after 200 update return $x } -result {before} test timer-6.11 {Tcl_AfterCmd procedure, cancel option} -setup { foreach i [after info] { after cancel $i } } -body { set x before after 100 set x after set id [after 300 set x after] after cancel $id after 200 update set y $x set x cleared after 200 update list $y $x } -result {after cleared} test timer-6.12 {Tcl_AfterCmd procedure, cancel option} -setup { foreach i [after info] { after cancel $i } } -body { set x first after idle lappend x second after idle lappend x third set i [after idle lappend x fourth] after cancel {lappend x second} after cancel $i update idletasks return $x } -result {first third} test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} -setup { foreach i [after info] { after cancel $i } } -body { set x first after idle lappend x second after idle lappend x third set i [after idle lappend x fourth] after cancel lappend x second after cancel $i update idletasks return $x } -result {first third} test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} -setup { foreach i [after info] { after cancel $i } } -body { set id [ after 100 { set x done after cancel $id } ] vwait x } -result {} test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} -setup { foreach i [after info] { after cancel $i } } -body { interp create x x eval {set a before; set b before; after idle {set a a-after}; after idle {set b b-after}} set result [llength [x eval after info]] lappend result [llength [after info]] after cancel {set b b-after} set a aaa set b bbb x eval {after cancel set a a-after} update idletasks lappend result $a $b [x eval {list $a $b}] } -cleanup { interp delete x } -result {2 0 aaa bbb {before b-after}} test timer-6.16 {Tcl_AfterCmd procedure, idle option} -body { after idle } -returnCodes error -result {wrong # args: should be "after idle script ?script ...?"} test timer-6.17 {Tcl_AfterCmd procedure, idle option} { set x before after idle {set x after} set y $x update idletasks list $y $x } {before after} test timer-6.18 {Tcl_AfterCmd procedure, idle option} { set x before after idle set x after set y $x update idletasks list $y $x } {before after} set event1 [after idle event 1] set event2 [after 1000 event 2] interp create x set childEvent [x eval {after idle event in child}] test timer-6.19 {Tcl_AfterCmd, info option} { lsort [after info] } [lsort "$event1 $event2"] test timer-6.20 {Tcl_AfterCmd, info option} -returnCodes error -body { after info a b } -result {wrong # args: should be "after info ?id?"} test timer-6.21 {Tcl_AfterCmd, info option} -returnCodes error -body { after info $childEvent } -result "event \"$childEvent\" doesn't exist" test timer-6.22 {Tcl_AfterCmd, info option} { list [after info $event1] [after info $event2] } {{{event 1} idle} {{event 2} timer}} after cancel $event1 after cancel $event2 interp delete x test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup { foreach i [after info] { after cancel $i } } -body { set x "hello world" after 1 "set x ab\0cd" after 10 update string length $x } -result {5} test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NUL} -setup { foreach i [after info] { after cancel $i } } -body { set x "hello world" after 1 set x ab\0cd after 10 update string length $x } -result {5} test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup { foreach i [after info] { after cancel $i } } -body { set x "hello world" after 1 set x ab\0cd after cancel "set x ab\0ef" llength [after info] } -cleanup { foreach i [after info] { after cancel $i } } -result {1} test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup { foreach i [after info] { after cancel $i } } -body { set x "hello world" after 1 set x ab\0cd after cancel set x ab\0ef llength [after info] } -cleanup { foreach i [after info] { after cancel $i } } -result {1} test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup { foreach i [after info] { after cancel $i } } -body { set x "hello world" after idle "set x ab\0cd" update string length $x } -result {5} test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup { foreach i [after info] { after cancel $i } } -body { set x "hello world" after idle set x ab\0cd update string length $x } -result {5} test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NUL} -setup { foreach i [after info] { after cancel $i } } -body { set x "hello world" set id junk set id [after 10 set x ab\0cd] update string length [lindex [lindex [after info $id] 0] 2] } -cleanup { foreach i [after info] { after cancel $i } } -result 5 set event [after idle foo bar] scan $event after#%d lastId test timer-7.1 {GetAfterEvent procedure} -returnCodes error -body { after info xfter#$lastId } -result "event \"xfter#$lastId\" doesn't exist" test timer-7.2 {GetAfterEvent procedure} -returnCodes error -body { after info afterx$lastId } -result "event \"afterx$lastId\" doesn't exist" test timer-7.3 {GetAfterEvent procedure} -returnCodes error -body { after info after#ab } -result {event "after#ab" doesn't exist} test timer-7.4 {GetAfterEvent procedure} -returnCodes error -body { after info after# } -result {event "after#" doesn't exist} test timer-7.5 {GetAfterEvent procedure} -returnCodes error -body { after info after#${lastId}x } -result "event \"after#${lastId}x\" doesn't exist" test timer-7.6 {GetAfterEvent procedure} -returnCodes error -body { after info afterx[expr {$lastId+1}] } -result "event \"afterx[expr {$lastId+1}]\" doesn't exist" after cancel $event test timer-8.1 {AfterProc procedure} { set x before proc foo {} { set x untouched after 100 {set x after} after 200 update return $x } list [foo] $x } {untouched after} test timer-8.2 {AfterProc procedure} -setup { variable x empty proc myHandler {msg options} { variable x [list $msg [dict get $options -errorinfo]] } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { after 100 {error "After error"} after 200 set y $x update list $y $x } -cleanup { interp bgerror {} $handler } -result {empty {{After error} {After error while executing "error "After error"" ("after" script)}}} test timer-8.3 {AfterProc procedure, deleting handler from itself} -setup { foreach i [after info] { after cancel $i } } -body { proc foo {} { global x set x {} foreach i [after info] { lappend x [after info $i] } after cancel foo } after idle foo after 1000 {error "I shouldn't ever have executed"} update idletasks return $x } -result {{{error "I shouldn't ever have executed"} timer}} test timer-8.4 {AfterProc procedure, deleting handler from itself} -setup { foreach i [after info] { after cancel $i } } -body { proc foo {} { global x set x {} foreach i [after info] { lappend x [after info $i] } after cancel foo } after 1000 {error "I shouldn't ever have executed"} after idle foo update idletasks return $x } -result {{{error "I shouldn't ever have executed"} timer}} foreach i [after info] { after cancel $i } # No test for FreeAfterPtr, since it is already tested above. test timer-9.1 {AfterCleanupProc procedure} -setup { catch {interp delete x} } -body { interp create x x eval {after 200 { lappend x after puts "part 1: this message should not appear" }} after 200 {lappend x after2} x eval {after 200 { lappend x after3 puts "part 2: this message should not appear" }} after 200 {lappend x after4} x eval {after 200 { lappend x after5 puts "part 3: this message should not appear" }} interp delete x set x before after 300 update return $x } -result {before after2 after4} test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup { interp create child child eval namespace export after child eval namespace eval foo namespace import ::after } -body { child eval foo::after 1 child eval namespace origin foo::after } -cleanup { # Bug will cause crash here; would cause failure otherwise interp delete child } -result ::after test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} -body { set b ok set a [after 0x100000001 {set b "after fired early"}] after 100 set done 1 vwait done return $b } -cleanup { catch {after cancel $a} } -result ok test timer-11.2 {Bug 1350293: [after] negative argument} -body { set l {} after 100 {lappend l 100; set done 1} after -1 {lappend l -1} vwait done return $l } -result {-1 100} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/tm.test0000644000175000017500000002036714554262142014335 0ustar sergeisergei# This file contains tests for the ::tcl::tm::* commands. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 2004 by Donal K. Fellows. # All rights reserved. package require Tcl 8.5- if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test tm-1.1 {tm: path command exists} { catch { ::tcl::tm::path } info commands ::tcl::tm::path } ::tcl::tm::path test tm-1.2 {tm: path command syntax} -returnCodes error -body { ::tcl::tm::path foo } -result {unknown or ambiguous subcommand "foo": must be add, list, or remove} test tm-1.3 {tm: path command syntax} { ::tcl::tm::path add } {} test tm-1.4 {tm: path command syntax} { ::tcl::tm::path remove } {} test tm-1.5 {tm: path command syntax} -returnCodes error -body { ::tcl::tm::path list foobar } -result "wrong # args: should be \"::tcl::tm::path list\"" test tm-2.1 {tm: roots command exists} { catch { ::tcl::tm::roots } info commands ::tcl::tm::roots } ::tcl::tm::roots test tm-2.2 {tm: roots command syntax} -returnCodes error -body { ::tcl::tm::roots } -result "wrong # args: should be \"::tcl::tm::roots paths\"" test tm-2.3 {tm: roots command syntax} -returnCodes error -body { ::tcl::tm::roots foo bar } -result "wrong # args: should be \"::tcl::tm::roots paths\"" test tm-3.1 {tm: module path management, input validation} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -returnCodes error -body { ::tcl::tm::path add foo/bar ::tcl::tm::path add foo } -result {foo is ancestor of existing module path foo/bar.} test tm-3.2 {tm: module path management, input validation} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -returnCodes error -body { ::tcl::tm::path add foo ::tcl::tm::path add foo/bar } -result {foo/bar is subdirectory of existing module path foo.} test tm-3.3 {tm: module path management, add/list interaction} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { ::tcl::tm::path add foo ::tcl::tm::path add bar ::tcl::tm::path list } -result {bar foo} test tm-3.4 {tm: module path management, add/list interaction} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { ::tcl::tm::path add foo bar baz ::tcl::tm::path list } -result {baz bar foo} test tm-3.5 {tm: module path management, input validation/list interaction} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { catch {::tcl::tm::path add snarf foo geode foo/bar} # Nothing is added if a problem was found. ::tcl::tm::path list } -result {} test tm-3.6 {tm: module path management, input validation/list interaction} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { catch {::tcl::tm::path add snarf foo/bar geode foo} # Nothing is added if a problem was found. ::tcl::tm::path list } -result {} test tm-3.7 {tm: module path management, input validation/list interaction} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { catch { ::tcl::tm::path add foo/bar ::tcl::tm::path add snarf geode foo } # Nothing is added if a problem was found. ::tcl::tm::path list } -result {foo/bar} test tm-3.8 {tm: module path management, input validation, ignore duplicates} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { # Ignore path if present ::tcl::tm::path add foo ::tcl::tm::path add snarf geode foo ::tcl::tm::path list } -result {geode snarf foo} test tm-3.9 {tm: module path management, input validation, ignore duplicates} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { # Ignore path if present ::tcl::tm::path add foo snarf geode foo ::tcl::tm::path list } -result {geode snarf foo} test tm-3.10 {tm: module path management, remove} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { ::tcl::tm::path add snarf geode foo ::tcl::tm::path remove foo ::tcl::tm::path list } -result {geode snarf} test tm-3.11 {tm: module path management, remove ignores unknown path} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { ::tcl::tm::path add foo snarf geode ::tcl::tm::path remove fox ::tcl::tm::path list } -result {geode snarf foo} proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor set results {} set base [file join $base tcl$major] lappend results [file join $base site-tcl] for {set i 0} {$i <= $minor} {incr i} { lappend results [file join $base ${major}.$i] } return $results } test tm-3.12 {tm: module path management, roots} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { ::tcl::tm::roots /FOO ::tcl::tm::path list } -result [genpaths /FOO] test tm-3.13 {tm: module path management, roots} -setup { # Save and clear the list set defaults [::tcl::tm::path list] foreach p $defaults {::tcl::tm::path remove $p} } -cleanup { # Restore old contents of path list. foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} foreach p $defaults {::tcl::tm::path add $p} } -body { ::tcl::tm::roots [list /FOO /BAR] ::tcl::tm::path list } -result [concat [genpaths /BAR] [genpaths /FOO]] rename genpaths {} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/trace.test0000644000175000017500000024564514554262142015023 0ustar sergeisergei# Commands covered: trace # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testcmdtrace [llength [info commands testcmdtrace]] testConstraint testevalobjv [llength [info commands testevalobjv]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] proc getbytes {} { set lines [split [memory info] "\n"] lindex [lindex $lines 3] 3 } proc traceScalar {name1 name2 op} { global info set info [list $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg] } proc traceScalarAppend {name1 name2 op} { global info lappend info $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg } proc traceArray {name1 name2 op} { global info set info [list $name1 $name2 $op [catch {uplevel 1 set [set name1]($name2)} msg] $msg] } proc traceArray2 {name1 name2 op} { global info set info [list $name1 $name2 $op] } proc traceProc {name1 name2 op} { global info set info [concat $info [list $name1 $name2 $op]] } proc traceTag {tag args} { global info set info [concat $info $tag] } proc traceError {args} { error "trace returned error" } proc traceCheck {cmd args} { global info set info [list [catch $cmd msg] $msg] } proc traceCrtElement {value name1 name2 op} { uplevel 1 set ${name1}($name2) $value } proc traceCommand {oldName newName op} { global info set info [list $oldName $newName $op] } test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} { # You may need Purify or Electric Fence to reliably # see this one fail. unset -nocomplain z trace add variable z array {set z(foo) 1 ;#} set res "names: [array names z]" unset -nocomplain ::z trace add variable ::z write {unset ::z; error "memory corruption";#} list [catch {set ::z 1} msg] $msg } {1 {can't set "::z": memory corruption}} # Read-tracing on variables test trace-1.1 {trace add variable reads} { unset -nocomplain x set info {} trace add variable x read traceScalar list [catch {set x} msg] $msg $info } {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}} test trace-1.2 {trace add variable reads} { unset -nocomplain x set x 123 set info {} trace add variable x read traceScalar list [catch {set x} msg] $msg $info } {0 123 {x {} read 0 123}} test trace-1.3 {trace add variable reads} { unset -nocomplain x set info {} trace add variable x read traceScalar set x 123 set info } {} test trace-1.4 {trace array element reads} { unset -nocomplain x set info {} trace add variable x(2) read traceArray list [catch {set x(2)} msg] $msg $info } {1 {can't read "x(2)": no such element in array} {x 2 read 1 {can't read "x(2)": no such element in array}}} test trace-1.5 {trace array element reads} { unset -nocomplain x set x(2) zzz set info {} trace add variable x(2) read traceArray list [catch {set x(2)} msg] $msg $info } {0 zzz {x 2 read 0 zzz}} test trace-1.6 {trace array element reads} { unset -nocomplain x set info {} trace add variable x read traceArray2 proc p {} { global x set x(2) willi return $x(2) } list [catch {p} msg] $msg $info } {0 willi {x 2 read}} test trace-1.7 {trace array element reads, create element undefined if nonexistant} { unset -nocomplain x set info {} trace add variable x read q proc q {name1 name2 op} { global info set info [list $name1 $name2 $op] global $name1 set ${name1}($name2) wolf } proc p {} { global x set x(X) willi return $x(Y) } list [catch {p} msg] $msg $info } {0 wolf {x Y read}} test trace-1.8 {trace reads on whole arrays} { unset -nocomplain x set info {} trace add variable x read traceArray list [catch {set x(2)} msg] $msg $info } {1 {can't read "x(2)": no such variable} {}} test trace-1.9 {trace reads on whole arrays} { unset -nocomplain x set x(2) zzz set info {} trace add variable x read traceArray list [catch {set x(2)} msg] $msg $info } {0 zzz {x 2 read 0 zzz}} test trace-1.10 {trace add variable reads} { unset -nocomplain x set x 444 set info {} trace add variable x read traceScalar unset x set info } {} test trace-1.11 {read traces that modify the array structure} { unset -nocomplain x set x(bar) 0 trace add variable x read {set x(foo) 1 ;#} trace add variable x read {unset -nocomplain x(bar) ;#} array get x } {} test trace-1.12 {read traces that modify the array structure} { unset -nocomplain x set x(bar) 0 trace add variable x read {unset -nocomplain x(bar) ;#} trace add variable x read {set x(foo) 1 ;#} array get x } {} test trace-1.13 {read traces that modify the array structure} { unset -nocomplain x set x(bar) 0 trace add variable x read {set x(foo) 1 ;#} trace add variable x read {unset -nocomplain x;#} list [catch {array get x} res] $res } {1 {can't read "x(bar)": no such variable}} test trace-1.14 {read traces that modify the array structure} { unset -nocomplain x set x(bar) 0 trace add variable x read {unset -nocomplain x;#} trace add variable x read {set x(foo) 1 ;#} list [catch {array get x} res] $res } {1 {can't read "x(bar)": no such variable}} # Basic write-tracing on variables test trace-2.1 {trace add variable writes} { unset -nocomplain x set info {} trace add variable x write traceScalar set x 123 set info } {x {} write 0 123} test trace-2.2 {trace writes to array elements} { unset -nocomplain x set info {} trace add variable x(33) write traceArray set x(33) 444 set info } {x 33 write 0 444} test trace-2.3 {trace writes on whole arrays} { unset -nocomplain x set info {} trace add variable x write traceArray set x(abc) qq set info } {x abc write 0 qq} test trace-2.4 {trace add variable writes} { unset -nocomplain x set x 1234 set info {} trace add variable x write traceScalar set x set info } {} test trace-2.5 {trace add variable writes} { unset -nocomplain x set x 1234 set info {} trace add variable x write traceScalar unset x set info } {} test trace-2.6 {trace add variable writes on compiled local} { # # Check correct function of whole array traces on compiled local # arrays [Bug 1770591]. The corresponding function for read traces is # already indirectly tested in trace-1.7 # unset -nocomplain x set info {} proc p {} { trace add variable x write traceArray set x(X) willy } p set info } {x X write 0 willy} test trace-2.7 {trace add variable writes on errorInfo} -body { # # Check correct behaviour of write traces on errorInfo. # [Bug 1773040] trace add variable ::errorInfo write traceScalar catch {set dne} lrange [set info] 0 2 } -cleanup { # always remove trace on errorInfo otherwise further tests will fail unset ::errorInfo } -result {::errorInfo {} write} # append no longer triggers read traces when fetching the old values of # variables before doing the append operation. However, lappend _does_ # still trigger these read traces. Also lappend triggers only one write # trace: after appending all arguments to the list. test trace-3.1 {trace add variable read-modify-writes} { unset -nocomplain x set info {} trace add variable x read traceScalarAppend append x 123 append x 456 lappend x 789 set info } {x {} read 0 123456} test trace-3.2 {trace add variable read-modify-writes} { unset -nocomplain x set info {} trace add variable x {read write} traceScalarAppend append x 123 lappend x 456 set info } {x {} write 0 123 x {} read 0 123 x {} write 0 {123 456}} # Basic unset-tracing on variables test trace-4.1 {trace add variable unsets} { unset -nocomplain x set info {} trace add variable x unset traceScalar unset -nocomplain x set info } {x {} unset 1 {can't read "x": no such variable}} test trace-4.2 {variable mustn't exist during unset trace} { unset -nocomplain x set x 1234 set info {} trace add variable x unset traceScalar unset x set info } {x {} unset 1 {can't read "x": no such variable}} test trace-4.3 {unset traces mustn't be called during reads and writes} { unset -nocomplain x set info {} trace add variable x unset traceScalar set x 44 set x set info } {} test trace-4.4 {trace unsets on array elements} { unset -nocomplain x set x(0) 18 set info {} trace add variable x(1) unset traceArray unset -nocomplain x(1) set info } {x 1 unset 1 {can't read "x(1)": no such element in array}} test trace-4.5 {trace unsets on array elements} { unset -nocomplain x set x(1) 18 set info {} trace add variable x(1) unset traceArray unset x(1) set info } {x 1 unset 1 {can't read "x(1)": no such element in array}} test trace-4.6 {trace unsets on array elements} { unset -nocomplain x set x(1) 18 set info {} trace add variable x(1) unset traceArray unset x set info } {x 1 unset 1 {can't read "x(1)": no such variable}} test trace-4.7 {trace unsets on whole arrays} { unset -nocomplain x set x(1) 18 set info {} trace add variable x unset traceProc unset -nocomplain x(0) set info } {} test trace-4.8 {trace unsets on whole arrays} { unset -nocomplain x set x(1) 18 set x(2) 144 set x(3) 14 set info {} trace add variable x unset traceProc unset x(1) set info } {x 1 unset} test trace-4.9 {trace unsets on whole arrays} { unset -nocomplain x set x(1) 18 set x(2) 144 set x(3) 14 set info {} trace add variable x unset traceProc unset x set info } {x {} unset} # Array tracing on variables test trace-5.1 {array traces fire on accesses via [array]} { unset -nocomplain x set x(b) 2 trace add variable x array traceArray2 set ::info {} array set x {a 1} set ::info } {x {} array} test trace-5.2 {array traces do not fire on normal accesses} { unset -nocomplain x set x(b) 2 trace add variable x array traceArray2 set ::info {} set x(a) 1 set x(b) $x(a) set ::info } {} test trace-5.3 {array traces do not outlive variable} { unset -nocomplain x trace add variable x array traceArray2 set ::info {} set x(a) 1 unset x array set x {a 1} set ::info } {} test trace-5.4 {array traces properly listed in trace information} { unset -nocomplain x trace add variable x array traceArray2 set result [trace info variable x] set result } [list [list array traceArray2]] test trace-5.5 {array traces properly listed in trace information} { unset -nocomplain x trace add variable x array traceArray2 set result [trace info variable x] set result } [list [list array traceArray2]] test trace-5.6 {array traces don't fire on scalar variables} { unset -nocomplain x set x foo trace add variable x array traceArray2 set ::info {} catch {array set x {a 1}} set ::info } {} test trace-5.7 {array traces fire for undefined variables} { unset -nocomplain x trace add variable x array traceArray2 set ::info {} array set x {a 1} set ::info } {x {} array} test trace-5.8 {array traces fire for undefined variables} { unset -nocomplain x trace add variable x array {set x(foo) 1 ;#} set res "names: [array names x]" } {names: foo} # Trace multiple trace types at once. test trace-6.1 {multiple ops traced at once} { unset -nocomplain x set info {} trace add variable x {read write unset} traceProc catch {set x} set x 22 set x set x 33 unset x set info } {x {} read x {} write x {} read x {} write x {} unset} test trace-6.2 {multiple ops traced on array element} { unset -nocomplain x set info {} trace add variable x(0) {read write unset} traceProc catch {set x(0)} set x(0) 22 set x(0) set x(0) 33 unset x(0) unset x set info } {x 0 read x 0 write x 0 read x 0 write x 0 unset} test trace-6.3 {multiple ops traced on whole array} { unset -nocomplain x set info {} trace add variable x {read write unset} traceProc catch {set x(0)} set x(0) 22 set x(0) set x(0) 33 unset x(0) unset x set info } {x 0 write x 0 read x 0 write x 0 unset x {} unset} # Check order of invocation of traces test trace-7.1 {order of invocation of traces} { unset -nocomplain x set info {} trace add variable x read "traceTag 1" trace add variable x read "traceTag 2" trace add variable x read "traceTag 3" catch {set x} set x 22 set x set info } {3 2 1 3 2 1} test trace-7.2 {order of invocation of traces} { unset -nocomplain x set x(0) 44 set info {} trace add variable x(0) read "traceTag 1" trace add variable x(0) read "traceTag 2" trace add variable x(0) read "traceTag 3" set x(0) set info } {3 2 1} test trace-7.3 {order of invocation of traces} { unset -nocomplain x set x(0) 44 set info {} trace add variable x(0) read "traceTag 1" trace add variable x read "traceTag A1" trace add variable x(0) read "traceTag 2" trace add variable x read "traceTag A2" trace add variable x(0) read "traceTag 3" trace add variable x read "traceTag A3" set x(0) set info } {A3 A2 A1 3 2 1} # Check effects of errors in trace procedures test trace-8.1 {error returns from traces} { unset -nocomplain x set x 123 set info {} trace add variable x read "traceTag 1" trace add variable x read traceError list [catch {set x} msg] $msg $info } {1 {can't read "x": trace returned error} {}} test trace-8.2 {error returns from traces} { unset -nocomplain x set x 123 set info {} trace add variable x write "traceTag 1" trace add variable x write traceError list [catch {set x 44} msg] $msg $info } {1 {can't set "x": trace returned error} {}} test trace-8.3 {error returns from traces} { unset -nocomplain x set x 123 set info {} trace add variable x write traceError list [catch {append x 44} msg] $msg $info } {1 {can't set "x": trace returned error} {}} test trace-8.4 {error returns from traces} { unset -nocomplain x set x 123 set info {} trace add variable x unset "traceTag 1" trace add variable x unset traceError list [catch {unset x} msg] $msg $info } {0 {} 1} test trace-8.5 {error returns from traces} { unset -nocomplain x set x(0) 123 set info {} trace add variable x(0) read "traceTag 1" trace add variable x read "traceTag 2" trace add variable x read traceError trace add variable x read "traceTag 3" list [catch {set x(0)} msg] $msg $info } {1 {can't read "x(0)": trace returned error} 3} test trace-8.6 {error returns from traces} { unset -nocomplain x set x 123 trace add variable x unset traceError list [catch {unset x} msg] $msg } {0 {}} test trace-8.7 {error returns from traces} { # This test just makes sure that the memory for the error message # gets deallocated correctly when the trace is invoked again or # when the trace is deleted. unset -nocomplain x set x 123 trace add variable x read traceError catch {set x} catch {set x} trace remove variable x read traceError } {} test trace-8.8 {error returns from traces} { # Yet more elaborate memory corruption testing that checks nothing # bad happens when the trace deletes itself and installs something # new. Alas, there is no neat way to guarantee that this test will # fail if there is a problem, but that's life and with the new code # it should *never* fail. # # Adapted from Bug #219393 reported by Don Porter. catch {rename ::foo {}} proc foo {old args} { trace remove variable ::x write [list foo $old] trace add variable ::x write [list foo $::x] error "foo" } unset -nocomplain ::x ::y set x junk trace add variable ::x write [list foo $x] for {set y 0} {$y<100} {incr y} { catch {set x junk} } unset x } {} # Check to see that variables are expunged before trace # procedures are invoked, so trace procedure can even manipulate # a new copy of the variables. test trace-9.1 {be sure variable is unset before trace is called} { unset -nocomplain x set x 33 set info {} trace add variable x unset {traceCheck {uplevel 1 set x}} unset x set info } {1 {can't read "x": no such variable}} test trace-9.2 {be sure variable is unset before trace is called} { unset -nocomplain x set x 33 set info {} trace add variable x unset {traceCheck {uplevel 1 set x 22}} unset x concat $info [list [catch {set x} msg] $msg] } {0 22 0 22} test trace-9.3 {be sure traces are cleared before unset trace called} { unset -nocomplain x set x 33 set info {} trace add variable x unset {traceCheck {uplevel 1 trace info variable x}} unset x set info } {0 {}} test trace-9.4 {set new trace during unset trace} { unset -nocomplain x set x 33 set info {} trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}} unset x concat $info [trace info variable x] } {0 {} {unset traceProc}} test trace-10.1 {make sure array elements are unset before traces are called} { unset -nocomplain x set x(0) 33 set info {} trace add variable x(0) unset {traceCheck {uplevel 1 set x(0)}} unset x(0) set info } {1 {can't read "x(0)": no such element in array}} test trace-10.2 {make sure array elements are unset before traces are called} { unset -nocomplain x set x(0) 33 set info {} trace add variable x(0) unset {traceCheck {uplevel 1 set x(0) zzz}} unset x(0) concat $info [list [catch {set x(0)} msg] $msg] } {0 zzz 0 zzz} test trace-10.3 {array elements are unset before traces are called} { unset -nocomplain x set x(0) 33 set info {} trace add variable x(0) unset {traceCheck {global x; trace info variable x(0)}} unset x(0) set info } {0 {}} test trace-10.4 {set new array element trace during unset trace} { unset -nocomplain x set x(0) 33 set info {} trace add variable x(0) unset {traceCheck {uplevel 1 {trace add variable x(0) read {}}}} unset -nocomplain x(0) concat $info [trace info variable x(0)] } {0 {} {read {}}} test trace-11.1 {make sure arrays are unset before traces are called} { unset -nocomplain x set x(0) 33 set info {} trace add variable x unset {traceCheck {uplevel 1 set x(0)}} unset x set info } {1 {can't read "x(0)": no such variable}} test trace-11.2 {make sure arrays are unset before traces are called} { unset -nocomplain x set x(y) 33 set info {} trace add variable x unset {traceCheck {uplevel 1 set x(y) 22}} unset x concat $info [list [catch {set x(y)} msg] $msg] } {0 22 0 22} test trace-11.3 {make sure arrays are unset before traces are called} { unset -nocomplain x set x(y) 33 set info {} trace add variable x unset {traceCheck {uplevel 1 array exists x}} unset x set info } {0 0} test trace-11.4 {make sure arrays are unset before traces are called} { unset -nocomplain x set x(y) 33 set info {} set cmd {traceCheck {uplevel 1 {trace info variable x}}} trace add variable x unset $cmd unset x set info } {0 {}} test trace-11.5 {set new array trace during unset trace} { unset -nocomplain x set x(y) 33 set info {} trace add variable x unset {traceCheck {global x; trace add variable x read {}}} unset x concat $info [trace info variable x] } {0 {} {read {}}} test trace-11.6 {create scalar during array unset trace} { unset -nocomplain x set x(y) 33 set info {} trace add variable x unset {traceCheck {global x; set x 44}} unset x concat $info [list [catch {set x} msg] $msg] } {0 44 0 44} # Check special conditions (e.g. errors) in Tcl_TraceVar2. test trace-12.1 {creating array when setting variable traces} { unset -nocomplain x set info {} trace add variable x(0) write traceProc list [catch {set x 22} msg] $msg } {1 {can't set "x": variable is array}} test trace-12.2 {creating array when setting variable traces} { unset -nocomplain x set info {} trace add variable x(0) write traceProc list [catch {set x(0)} msg] $msg } {1 {can't read "x(0)": no such element in array}} test trace-12.3 {creating array when setting variable traces} { unset -nocomplain x set info {} trace add variable x(0) write traceProc set x(0) 22 set info } {x 0 write} test trace-12.4 {creating variable when setting variable traces} { unset -nocomplain x set info {} trace add variable x write traceProc list [catch {set x} msg] $msg } {1 {can't read "x": no such variable}} test trace-12.5 {creating variable when setting variable traces} { unset -nocomplain x set info {} trace add variable x write traceProc set x 22 set info } {x {} write} test trace-12.6 {creating variable when setting variable traces} { unset -nocomplain x set info {} trace add variable x write traceProc set x(0) 22 set info } {x 0 write} test trace-12.7 {create array element during read trace} { unset -nocomplain x set x(2) zzz trace add variable x read {traceCrtElement xyzzy} list [catch {set x(3)} msg] $msg } {0 xyzzy} test trace-12.8 {errors when setting variable traces} { unset -nocomplain x set x 44 list [catch {trace add variable x(0) write traceProc} msg] $msg } {1 {can't trace "x(0)": variable isn't array}} # Check trace deletion test trace-13.1 {delete one trace from another} { proc delTraces {args} { global x trace remove variable x read {traceTag 2} trace remove variable x read {traceTag 3} trace remove variable x read {traceTag 4} } unset -nocomplain x set x 44 set info {} trace add variable x read {traceTag 1} trace add variable x read {traceTag 2} trace add variable x read {traceTag 3} trace add variable x read {traceTag 4} trace add variable x read delTraces trace add variable x read {traceTag 5} set x set info } {5 1} test trace-13.2 {leak when unsetting traced variable} \ -constraints memory -body { set end [getbytes] proc f args {} for {set i 0} {$i < 5} {incr i} { trace add variable bepa write f set bepa a unset bepa set tmp $end set end [getbytes] } expr {$end - $tmp} } -cleanup { unset -nocomplain end i tmp } -result 0 test trace-13.3 {leak when removing traces} \ -constraints memory -body { set end [getbytes] proc f args {} for {set i 0} {$i < 5} {incr i} { trace add variable bepa write f set bepa a trace remove variable bepa write f set tmp $end set end [getbytes] } expr {$end - $tmp} } -cleanup { unset -nocomplain end i tmp } -result 0 test trace-13.4 {leaks in error returns from traces} \ -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { set apa {a 1 b 2} set bepa [lrange $apa 0 end] trace add variable bepa write {error hej} catch {set bepa a} unset bepa set tmp $end set end [getbytes] } expr {$end - $tmp} } -cleanup { unset -nocomplain end i tmp } -result 0 # Check operation and syntax of "trace" command. # Syntax for adding/removing variable and command traces is basically the # same: # trace add variable name opList command # trace remove variable name opList command # # The following loops just get all the common "wrong # args" tests done. set i 0 set start "wrong # args:" foreach type {variable command} { foreach op {add remove} { test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace $op $type} msg] $msg } [list 1 "$start should be \"trace $op $type name opList command\""] test trace-14.0.[incr i] "trace command wrong # args errors" { list [catch {trace $op $type foo} msg] $msg } [list 1 "$start should be \"trace $op $type name opList command\""] test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace $op $type foo bar} msg] $msg } [list 1 "$start should be \"trace $op $type name opList command\""] test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace $op $type foo bar baz boo} msg] $msg } [list 1 "$start should be \"trace $op $type name opList command\""] } test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace info $type foo bar} msg] $msg } [list 1 "$start should be \"trace info $type name\""] test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace info $type} msg] $msg } [list 1 "$start should be \"trace info $type name\""] } test trace-14.1 "trace command, wrong # args errors" { list [catch {trace} msg] $msg } [list 1 "wrong # args: should be \"trace option ?arg ...?\""] test trace-14.2 "trace command, wrong # args errors" { list [catch {trace add} msg] $msg } [list 1 "wrong # args: should be \"trace add type ?arg ...?\""] test trace-14.3 "trace command, wrong # args errors" { list [catch {trace remove} msg] $msg } [list 1 "wrong # args: should be \"trace remove type ?arg ...?\""] test trace-14.4 "trace command, wrong # args errors" { list [catch {trace info} msg] $msg } [list 1 "wrong # args: should be \"trace info type name\""] test trace-14.5 {trace command, invalid option} { list [catch {trace gorp} msg] $msg } [list 1 "bad option \"gorp\": must be add, info, remove, variable, vdelete, or vinfo"] # Again, [trace ... command] and [trace ... variable] share syntax and # error message styles for their opList options; these loops test those # error messages. set i 0 set errs [list "array, read, unset, or write" "delete or rename" "enter, leave, enterstep, or leavestep"] set abbvs [list {a r u w} {d r} {}] proc x {} {} foreach type {variable command execution} err $errs abbvlist $abbvs { foreach op {add remove} { test trace-14.6.[incr i] "trace $op $type errors" { list [catch {trace $op $type x {y z w} a} msg] $msg } [list 1 "bad operation \"y\": must be $err"] foreach abbv $abbvlist { test trace-14.6.[incr i] "trace $op $type rejects abbreviations" { list [catch {trace $op $type x $abbv a} msg] $msg } [list 1 "bad operation \"$abbv\": must be $err"] } test trace-14.6.[incr i] "trace $op $type rejects null opList" { list [catch {trace $op $type x {} a} msg] $msg } [list 1 "bad operation list \"\": must be one or more of $err"] } } rename x {} test trace-14.7 {trace command, "trace variable" errors} { list [catch {trace variable} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] test trace-14.8 {trace command, "trace variable" errors} { list [catch {trace variable x} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] test trace-14.9 {trace command, "trace variable" errors} { list [catch {trace variable x y} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] test trace-14.10 {trace command, "trace variable" errors} { list [catch {trace variable x y z w} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] test trace-14.11 {trace command, "trace variable" errors} { list [catch {trace variable x y z} msg] $msg } [list 1 "bad operations \"y\": should be one or more of rwua"] test trace-14.12 {trace command ("remove variable" option)} { unset -nocomplain x set info {} trace add variable x write traceProc trace remove variable x write traceProc } {} test trace-14.13 {trace command ("remove variable" option)} { unset -nocomplain x set info {} trace add variable x write traceProc trace remove variable x write traceProc set x 12345 set info } {} test trace-14.14 {trace command ("remove variable" option)} { unset -nocomplain x set info {} trace add variable x write {traceTag 1} trace add variable x write traceProc trace add variable x write {traceTag 2} set x yy trace remove variable x write traceProc set x 12345 trace remove variable x write {traceTag 1} set x foo trace remove variable x write {traceTag 2} set x gorp set info } {2 x {} write 1 2 1 2} test trace-14.15 {trace command ("remove variable" option)} { unset -nocomplain x set info {} trace add variable x write {traceTag 1} trace remove variable x write non_existent set x 12345 set info } {1} test trace-14.16 {trace command ("info variable" option)} { unset -nocomplain x trace add variable x write {traceTag 1} trace add variable x write traceProc trace add variable x write {traceTag 2} trace info variable x } {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}} test trace-14.17 {trace command ("info variable" option)} { unset -nocomplain x trace info variable x } {} test trace-14.18 {trace command ("info variable" option)} { unset -nocomplain x trace info variable x(0) } {} test trace-14.19 {trace command ("info variable" option)} { unset -nocomplain x set x 44 trace info variable x(0) } {} test trace-14.20 {trace command ("info variable" option)} { unset -nocomplain x set x 44 trace add variable x write {traceTag 1} proc check {} {global x; trace info variable x} check } {{write {traceTag 1}}} # Check fancy trace commands (long ones, weird arguments, etc.) test trace-15.1 {long trace command} { unset -nocomplain x set info {} trace add variable x write {traceTag {This is a very very long argument. It's \ designed to test out the facilities of TraceVarProc for dealing \ with such long arguments by malloc-ing space. One possibility \ is that space doesn't get freed properly. If this happens, then \ invoking this test over and over again will eventually leak memory.}} set x 44 set info } {This is a very very long argument. It's \ designed to test out the facilities of TraceVarProc for dealing \ with such long arguments by malloc-ing space. One possibility \ is that space doesn't get freed properly. If this happens, then \ invoking this test over and over again will eventually leak memory.} test trace-15.2 {long trace command result to ignore} { proc longResult {args} {return "quite a bit of text, designed to generate a core leak if this command file is invoked over and over again and memory isn't being recycled correctly"} unset -nocomplain x trace add variable x write longResult set x 44 set x 5 set x abcde } abcde test trace-15.3 {special list-handling in trace commands} { unset -nocomplain "x y z" set "x y z(a\n\{)" 44 set info {} trace add variable "x y z(a\n\{)" write traceProc set "x y z(a\n\{)" 33 set info } "{x y z} a\\n\\\{ write" # Check for proper handling of unsets during traces. proc traceUnset {unsetName args} { global info upvar 1 $unsetName x lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg } proc traceReset {unsetName resetName args} { global info upvar 1 $unsetName x $resetName y lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg } proc traceReset2 {unsetName resetName args} { global info lappend info [catch {uplevel 1 unset $unsetName} msg] $msg \ [catch {uplevel 1 set $resetName xyzzy} msg] $msg } proc traceAppend {string name1 name2 op} { global info lappend info $string } test trace-16.1 {unsets during read traces} { unset -nocomplain y set y 1234 set info {} trace add variable y read {traceUnset y} trace add variable y unset {traceAppend unset} lappend info [catch {set y} msg] $msg } {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}} test trace-16.2 {unsets during read traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceUnset y(0)} lappend info [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}} test trace-16.3 {unsets during read traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceUnset y} lappend info [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}} test trace-16.4 {unsets during read traces} { unset -nocomplain y set y 1234 set info {} trace add variable y read {traceReset y y} lappend info [catch {set y} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} test trace-16.5 {unsets during read traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceReset y(0) y(0)} lappend info [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} test trace-16.6 {unsets during read traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceReset y y(0)} lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}} test trace-16.7 {unsets during read traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceReset2 y y(0)} lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy} test trace-16.8 {unsets during write traces} { unset -nocomplain y set y 1234 set info {} trace add variable y write {traceUnset y} trace add variable y unset {traceAppend unset} lappend info [catch {set y xxx} msg] $msg } {unset 0 {} 1 {can't read "x": no such variable} 0 {}} test trace-16.9 {unsets during write traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceUnset y(0)} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {}} test trace-16.10 {unsets during write traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceUnset y} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {}} test trace-16.11 {unsets during write traces} { unset -nocomplain y set y 1234 set info {} trace add variable y write {traceReset y y} lappend info [catch {set y xxx} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} test trace-16.12 {unsets during write traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceReset y(0) y(0)} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} test trace-16.13 {unsets during write traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceReset y y(0)} lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}} test trace-16.14 {unsets during write traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceReset2 y y(0)} lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 {} 0 xyzzy} test trace-16.15 {unsets during unset traces} { unset -nocomplain y set y 1234 set info {} trace add variable y unset {traceUnset y} lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}} test trace-16.16 {unsets during unset traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) unset {traceUnset y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}} test trace-16.17 {unsets during unset traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) unset {traceUnset y} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}} test trace-16.18 {unsets during unset traces} { unset -nocomplain y set y 1234 set info {} trace add variable y unset {traceReset2 y y} lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg } {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy} test trace-16.19 {unsets during unset traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) unset {traceReset2 y(0) y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy} test trace-16.20 {unsets during unset traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) unset {traceReset2 y y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 {} 0 xyzzy} test trace-16.21 {unsets cancelling traces} { unset -nocomplain y set y 1234 set info {} trace add variable y read {traceAppend first} trace add variable y read {traceUnset y} trace add variable y read {traceAppend third} trace add variable y unset {traceAppend unset} lappend info [catch {set y} msg] $msg } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}} test trace-16.22 {unsets cancelling traces} { unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceAppend first} trace add variable y(0) read {traceUnset y} trace add variable y(0) read {traceAppend third} trace add variable y(0) unset {traceAppend unset} lappend info [catch {set y(0)} msg] $msg } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}} # Check various non-interference between traces and other things. test trace-17.1 {trace doesn't prevent unset errors} { unset -nocomplain x set info {} trace add variable x unset {traceProc} list [catch {unset x} msg] $msg $info } {1 {can't unset "x": no such variable} {x {} unset}} test trace-17.2 {traced variables must survive procedure exits} { unset -nocomplain x proc p1 {} {global x; trace add variable x write traceProc} p1 trace info variable x } {{write traceProc}} test trace-17.3 {traced variables must survive procedure exits} { unset -nocomplain x set info {} proc p1 {} {global x; trace add variable x write traceProc} p1 set x 44 set info } {x {} write} # Be sure that procedure frames are released before unset traces # are invoked. test trace-18.1 {unset traces on procedure returns} { proc p1 {x y} {set a 44; p2 14} proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}} set info {} p1 foo bar set info } {0 {a x y}} test trace-18.2 {namespace delete / trace remove variable combo} { namespace eval ::foo { variable x 123 } proc p1 args { trace remove variable ::foo::x unset p1 } trace add variable ::foo::x unset p1 namespace delete ::foo info exists ::foo::x } 0 test trace-18.3 {namespace delete / trace remove variable combo, Bug \#1337229} { namespace eval ::ns {} trace add variable ::ns::var unset {unset ::ns::var ;#} namespace delete ::ns } {} test trace-18.4 {namespace delete / trace remove variable combo, Bug \#1338280} { namespace eval ::ref {} set ::ref::var1 AAA trace add variable ::ref::var1 unset doTrace set ::ref::var2 BBB trace add variable ::ref::var2 {unset} doTrace proc doTrace {vtraced vidx op} { global info append info [catch {set ::$vtraced}][llength [info vars ::ref::*]] } set info {} namespace delete ::ref rename doTrace {} set info } 1110 # Delete arrays when done, so they can be re-used as scalars # elsewhere. unset -nocomplain x y test trace-19.0.1 {trace add command (command existence)} { # Just in case! catch {rename nosuchname ""} list [catch {trace add command nosuchname rename traceCommand} msg] $msg } {1 {unknown command "nosuchname"}} test trace-19.0.2 {trace add command (command existence in ns)} { list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg } {1 {unknown command "nosuchns::nosuchname"}} test trace-19.1 {trace add command (rename option)} { proc foo {} {} catch {rename bar {}} trace add command foo rename traceCommand rename foo bar set info } {::foo ::bar rename} test trace-19.2 {traces stick with renamed commands} { proc foo {} {} catch {rename bar {}} trace add command foo rename traceCommand rename foo bar rename bar foo set info } {::bar ::foo rename} test trace-19.2.1 {trace add command rename trace exists} { proc foo {} {} trace add command foo rename traceCommand trace info command foo } {{rename traceCommand}} test trace-19.3 {command rename traces don't fire on command deletion} { proc foo {} {} set info {} trace add command foo rename traceCommand rename foo {} set info } {} test trace-19.4 {trace add command rename doesn't trace recreated commands} { proc foo {} {} catch {rename bar {}} set info {} trace add command foo rename traceCommand proc foo {} {} rename foo bar set info } {} test trace-19.5 {trace add command deleted removes traces} { proc foo {} {} trace add command foo rename traceCommand proc foo {} {} trace info command foo } {} test trace-19.6 {trace add command rename in namespace} -setup { namespace eval tc {} proc tc::tcfoo {} {} } -body { trace add command tc::tcfoo rename traceCommand rename tc::tcfoo tc::tcbar set info } -cleanup { namespace delete tc } -result {::tc::tcfoo ::tc::tcbar rename} test trace-19.7 {trace add command rename in namespace back again} -setup { namespace eval tc {} proc tc::tcfoo {} {} } -body { trace add command tc::tcfoo rename traceCommand rename tc::tcfoo tc::tcbar rename tc::tcbar tc::tcfoo set info } -cleanup { namespace delete tc } -result {::tc::tcbar ::tc::tcfoo rename} test trace-19.8 {trace add command rename in namespace to out of namespace} -setup { namespace eval tc {} proc tc::tcfoo {} {} } -body { trace add command tc::tcfoo rename traceCommand rename tc::tcfoo tcbar set info } -cleanup { catch {rename tcbar {}} namespace delete tc } -result {::tc::tcfoo ::tcbar rename} test trace-19.9 {trace add command rename back into namespace} -setup { namespace eval tc {} proc tc::tcfoo {} {} } -body { trace add command tc::tcfoo rename traceCommand rename tc::tcfoo tcbar rename tcbar tc::tcfoo set info } -cleanup { namespace delete tc } -result {::tcbar ::tc::tcfoo rename} test trace-19.10 {trace add command failed rename doesn't trigger trace} { set info {} proc foo {} {} proc bar {} {} trace add command foo {rename delete} traceCommand catch {rename foo bar} set info } {} catch {rename foo {}} catch {rename bar {}} test trace-19.11 {trace add command qualifies when renamed in namespace} -setup { namespace eval tc {} proc tc::tcfoo {} {} } -body { set info {} trace add command tc::tcfoo {rename delete} traceCommand namespace eval tc {rename tcfoo tcbar} set info } -cleanup { namespace delete tc } -result {::tc::tcfoo ::tc::tcbar rename} # Make sure it exists again proc foo {} {} test trace-20.1 {trace add command (delete option)} { trace add command foo delete traceCommand rename foo "" set info } {::foo {} delete} test trace-20.2 {trace add command delete doesn't trace recreated commands} { set info {} proc foo {} {} rename foo "" set info } {} test trace-20.2.1 {trace add command delete trace info} { proc foo {} {} trace add command foo delete traceCommand trace info command foo } {{delete traceCommand}} test trace-20.3 {trace add command implicit delete} { proc foo {} {} trace add command foo delete traceCommand proc foo {} {} set info } {::foo {} delete} test trace-20.3.1 {trace add command delete trace info} { proc foo {} {} trace info command foo } {} test trace-20.4 {trace add command rename followed by delete} { set infotemp {} proc foo {} {} trace add command foo {rename delete} traceCommand rename foo bar lappend infotemp $info rename bar {} lappend infotemp $info set info $infotemp unset infotemp set info } {{::foo ::bar rename} {::bar {} delete}} catch {rename foo {}} catch {rename bar {}} test trace-20.5 {trace add command rename and delete} { set infotemp {} set info {} proc foo {} {} trace add command foo {rename delete} traceCommand rename foo bar lappend infotemp $info rename bar {} lappend infotemp $info set info $infotemp unset infotemp set info } {{::foo ::bar rename} {::bar {} delete}} test trace-20.6 {trace add command rename and delete in subinterp} { set tc [interp create] foreach p {traceCommand} { $tc eval [list proc $p [info args $p] [info body $p]] } $tc eval [list set infotemp {}] $tc eval [list set info {}] $tc eval [list proc foo {} {}] $tc eval [list trace add command foo {rename delete} traceCommand] $tc eval [list rename foo bar] $tc eval {lappend infotemp $info} $tc eval [list rename bar {}] $tc eval {lappend infotemp $info} $tc eval {set info $infotemp} $tc eval [list unset infotemp] set info [$tc eval [list set info]] interp delete $tc set info } {{::foo ::bar rename} {::bar {} delete}} # I'd like it if this test could give 'foo {} d' as a result, # but interp deletion means there is no interp to evaluate # the trace in. test trace-20.7 {trace add command delete in subinterp while being deleted} { set info {} set tc [interp create] interp alias $tc traceCommand {} traceCommand $tc eval [list proc foo {} {}] $tc eval [list trace add command foo {rename delete} traceCommand] interp delete $tc set info } {} proc traceDelete {cmd old new op} { trace remove command $cmd {*}[lindex [trace info command $cmd] 0] global info set info [list $old $new $op] } proc traceCmdrename {cmd old new op} { rename $old someothername } proc traceCmddelete {cmd old new op} { rename $old "" } test trace-20.8 {trace delete while trace is active} { set info {} proc foo {} {} catch {rename bar {}} trace add command foo {rename delete} [list traceDelete foo] rename foo bar list [set info] [trace info command bar] } {{::foo ::bar rename} {}} test trace-20.9 {rename trace deletes command} { set info {} proc foo {} {} catch {rename bar {}} catch {rename someothername {}} trace add command foo rename [list traceCmddelete foo] rename foo bar list [info commands foo] [info commands bar] [info commands someothername] } {{} {} {}} test trace-20.10 {rename trace renames command} { set info {} proc foo {} {} catch {rename bar {}} catch {rename someothername {}} trace add command foo rename [list traceCmdrename foo] rename foo bar set info [list [info commands foo] [info commands bar] [info commands someothername]] rename someothername {} set info } {{} {} someothername} test trace-20.11 {delete trace deletes command} { set info {} proc foo {} {} catch {rename bar {}} catch {rename someothername {}} trace add command foo delete [list traceCmddelete foo] rename foo {} list [info commands foo] [info commands bar] [info commands someothername] } {{} {} {}} test trace-20.12 {delete trace renames command} { set info {} proc foo {} {} catch {rename bar {}} catch {rename someothername {}} trace add command foo delete [list traceCmdrename foo] rename foo bar rename bar {} # None of these should exist. list [info commands foo] [info commands bar] [info commands someothername] } {{} {} {}} test trace-20.13 {rename trace discards result [Bug 1355342]} { proc foo {} {} trace add command foo rename {set w Aha!;#} list [rename foo bar] [rename bar {}] } {{} {}} test trace-20.14 {rename trace discards error result [Bug 1355342]} { proc foo {} {} trace add command foo rename {error} list [rename foo bar] [rename bar {}] } {{} {}} test trace-20.15 {delete trace discards result [Bug 1355342]} { proc foo {} {} trace add command foo delete {set w Aha!;#} rename foo {} } {} test trace-20.16 {delete trace discards error result [Bug 1355342]} { proc foo {} {} trace add command foo delete {error} rename foo {} } {} proc foo {b} { set a $b } # Delete arrays when done, so they can be re-used as scalars # elsewhere. unset -nocomplain x y # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). catch {rename foobar {}} catch {rename foo {}} catch {rename bar {}} proc foo {a} { set b $a } proc traceExecute {args} { global info lappend info $args } test trace-21.1 {trace execution: enter} { set info {} trace add execution foo enter [list traceExecute foo] foo 1 trace remove execution foo enter [list traceExecute foo] set info } {{foo {foo 1} enter}} test trace-21.2 {trace exeuction: leave} { set info {} trace add execution foo leave [list traceExecute foo] foo 2 trace remove execution foo leave [list traceExecute foo] set info } {{foo {foo 2} 0 2 leave}} test trace-21.3 {trace exeuction: enter, leave} { set info {} trace add execution foo {enter leave} [list traceExecute foo] foo 3 trace remove execution foo {enter leave} [list traceExecute foo] set info } {{foo {foo 3} enter} {foo {foo 3} 0 3 leave}} test trace-21.4 {trace execution: enter, leave, enterstep} { set info {} trace add execution foo {enter leave enterstep} [list traceExecute foo] foo 3 trace remove execution foo {enter leave enterstep} [list traceExecute foo] set info } {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {foo 3} 0 3 leave}} test trace-21.5 {trace execution: enter, leave, enterstep, leavestep} { set info {} trace add execution foo {enter leave enterstep leavestep} [list traceExecute foo] foo 3 trace remove execution foo {enter leave enterstep leavestep} [list traceExecute foo] set info } {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep} {foo {foo 3} 0 3 leave}} test trace-21.6 {trace execution: enterstep, leavestep} { set info {} trace add execution foo {enterstep leavestep} [list traceExecute foo] foo 3 trace remove execution foo {enterstep leavestep} [list traceExecute foo] set info } {{foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep}} test trace-21.7 {trace execution: enterstep} { set info {} trace add execution foo {enterstep} [list traceExecute foo] foo 3 trace remove execution foo {enterstep} [list traceExecute foo] set info } {{foo {set b 3} enterstep}} test trace-21.8 {trace execution: leavestep} { set info {} trace add execution foo {leavestep} [list traceExecute foo] foo 3 trace remove execution foo {leavestep} [list traceExecute foo] set info } {{foo {set b 3} 0 3 leavestep}} test trace-21.9 {trace execution: TCL_EVAL_GLOBAL} testevalobjv { trace add execution foo enter soom proc ::soom args {lappend ::info SUCCESS [info level]} set ::info {} namespace eval test_ns_1 { proc soom args {lappend ::info FAIL [info level]} # [testevalobjv 1 ...] ought to produce the same # results as [uplevel #0 ...]. testevalobjv 1 foo x uplevel #0 foo x } namespace delete test_ns_1 trace remove execution foo enter soom set ::info } {SUCCESS 1 SUCCESS 1} test trace-21.10 {trace execution: TCL_EVAL_GLOBAL} testevalobjv { trace add execution foo leave soom proc ::soom args {lappend ::info SUCCESS [info level]} set ::info {} namespace eval test_ns_1 { proc soom args {lappend ::info FAIL [info level]} # [testevalobjv 1 ...] ought to produce the same # results as [uplevel #0 ...]. testevalobjv 1 foo x uplevel #0 foo x } namespace delete test_ns_1 trace remove execution foo leave soom set ::info } {SUCCESS 1 SUCCESS 1} test trace-21.11 {trace execution and alias} -setup { set res {} proc ::x {} {return ::} namespace eval a {} proc ::a::x {} {return ::a} interp alias {} y {} x } -body { lappend res [namespace eval ::a y] trace add execution ::x enter { rename ::x {} proc ::x {} {return ::} #} lappend res [namespace eval ::a y] } -cleanup { namespace delete a rename ::x {} } -result {:: ::} proc set2 args { set {*}$args } test trace-21.12 {bug 2438181} -setup { trace add execution set2 leave {puts one two three #;} } -body { set2 a hello } -returnCodes 1 -result {wrong # args: should be "puts ?-nonewline? ?channelId? string"} proc factorial {n} { if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] } return 1 } test trace-22.1 {recursive(1) trace execution: enter} { set info {} trace add execution factorial {enter} [list traceExecute factorial] factorial 1 trace remove execution factorial {enter} [list traceExecute factorial] set info } {{factorial {factorial 1} enter}} test trace-22.2 {recursive(2) trace execution: enter} { set info {} trace add execution factorial {enter} [list traceExecute factorial] factorial 2 trace remove execution factorial {enter} [list traceExecute factorial] set info } {{factorial {factorial 2} enter} {factorial {factorial 1} enter}} test trace-22.3 {recursive(3) trace execution: enter} { set info {} trace add execution factorial {enter} [list traceExecute factorial] factorial 3 trace remove execution factorial {enter} [list traceExecute factorial] set info } {{factorial {factorial 3} enter} {factorial {factorial 2} enter} {factorial {factorial 1} enter}} test trace-23.1 {recursive(1) trace execution: enter, leave, enterstep, leavestep} { set info {} trace add execution factorial {enter leave enterstep leavestep} [list traceExecute] factorial 1 trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute] join $info "\n" } {{factorial 1} enter {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep {return 1} enterstep {return 1} 2 1 leavestep {factorial 1} 0 1 leave} test trace-23.2 {recursive(2) trace execution: enter, leave, enterstep, leavestep} { set info {} trace add execution factorial {enter leave enterstep leavestep} [list traceExecute] factorial 2 trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute] join $info "\n" } {{factorial 2} enter {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep {expr {$n * [factorial [expr {$n -1 }]]}} enterstep {expr {$n -1 }} enterstep {expr {$n -1 }} 0 1 leavestep {factorial 1} enterstep {factorial 1} enter {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep {return 1} enterstep {return 1} 2 1 leavestep {factorial 1} 0 1 leave {factorial 1} 0 1 leavestep {expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep {return 2} enterstep {return 2} 2 2 leavestep {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep {factorial 2} 0 2 leave} test trace-23.3 {recursive(3) trace execution: enter, leave, enterstep, leavestep} { set info {} trace add execution factorial {enter leave enterstep leavestep} [list traceExecute] factorial 3 trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute] join $info "\n" } {{factorial 3} enter {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep {expr {$n * [factorial [expr {$n -1 }]]}} enterstep {expr {$n -1 }} enterstep {expr {$n -1 }} 0 2 leavestep {factorial 2} enterstep {factorial 2} enter {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep {expr {$n * [factorial [expr {$n -1 }]]}} enterstep {expr {$n -1 }} enterstep {expr {$n -1 }} 0 1 leavestep {factorial 1} enterstep {factorial 1} enter {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep {return 1} enterstep {return 1} 2 1 leavestep {factorial 1} 0 1 leave {factorial 1} 0 1 leavestep {expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep {return 2} enterstep {return 2} 2 2 leavestep {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep {factorial 2} 0 2 leave {factorial 2} 0 2 leavestep {expr {$n * [factorial [expr {$n -1 }]]}} 0 6 leavestep {return 6} enterstep {return 6} 2 6 leavestep {if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 6 leavestep {factorial 3} 0 6 leave} proc traceDelete {cmd args} { trace remove execution $cmd {*}[lindex [trace info execution $cmd] 0] global info set info $args } test trace-24.1 {delete trace during enter trace} { set info {} trace add execution foo enter [list traceDelete foo] foo 1 list $info [catch {trace info execution foo} res] $res } {{{foo 1} enter} 0 {}} test trace-24.2 {delete trace during leave trace} { set info {} trace add execution foo leave [list traceDelete foo] foo 1 list $info [catch {trace info execution foo} res] $res } {{{foo 1} 0 1 leave} 0 {}} test trace-24.3 {delete trace during enter-leave trace} { set info {} trace add execution foo {enter leave} [list traceDelete foo] foo 1 list $info [catch {trace info execution foo} res] $res } {{{foo 1} enter} 0 {}} test trace-24.4 {delete trace during all exec traces} { set info {} trace add execution foo {enter leave enterstep leavestep} [list traceDelete foo] foo 1 list $info [catch {trace info execution foo} res] $res } {{{foo 1} enter} 0 {}} test trace-24.5 {delete trace during all exec traces except enter} { set info {} trace add execution foo {leave enterstep leavestep} [list traceDelete foo] foo 1 list $info [catch {trace info execution foo} res] $res } {{{set b 1} enterstep} 0 {}} proc traceDelete {cmd args} { rename $cmd {} global info set info $args } proc foo {a} { set b $a } test trace-25.1 {delete command during enter trace} { set info {} trace add execution foo enter [list traceDelete foo] catch {foo 1} err list $err $info [catch {trace info execution foo} res] $res } {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} proc foo {a} { set b $a } test trace-25.2 {delete command during leave trace} { set info {} trace add execution foo leave [list traceDelete foo] foo 1 list $info [catch {trace info execution foo} res] $res } {{{foo 1} 0 1 leave} 1 {unknown command "foo"}} proc foo {a} { set b $a } test trace-25.3 {delete command during enter then leave trace} { set info {} trace add execution foo enter [list traceDelete foo] trace add execution foo leave [list traceDelete foo] catch {foo 1} err list $err $info [catch {trace info execution foo} res] $res } {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} proc foo {a} { set b $a } proc traceExecute2 {args} { global info lappend info $args } # This shows the peculiar consequences of having two traces # at the same time: as well as tracing the procedure you want test trace-25.4 {order dependencies of two enter traces} { set info {} trace add execution foo enter [list traceExecute traceExecute] trace add execution foo enter [list traceExecute2 traceExecute2] catch {foo 1} err trace remove execution foo enter [list traceExecute traceExecute] trace remove execution foo enter [list traceExecute2 traceExecute2] join [list $err [join $info \n] [trace info execution foo]] "\n" } {1 traceExecute2 {foo 1} enter traceExecute {foo 1} enter } test trace-25.5 {order dependencies of two step traces} { set info {} trace add execution foo enterstep [list traceExecute traceExecute] trace add execution foo enterstep [list traceExecute2 traceExecute2] catch {foo 1} err trace remove execution foo enterstep [list traceExecute traceExecute] trace remove execution foo enterstep [list traceExecute2 traceExecute2] join [list $err [join $info \n] [trace info execution foo]] "\n" } {1 traceExecute2 {set b 1} enterstep traceExecute {set b 1} enterstep } # We don't want the result string (5th argument), or the results # will get unmanageable. proc tracePostExecute {args} { global info lappend info [concat [lrange $args 0 2] [lindex $args 4]] } proc tracePostExecute2 {args} { global info lappend info [concat [lrange $args 0 2] [lindex $args 4]] } test trace-25.6 {order dependencies of two leave traces} { set info {} trace add execution foo leave [list tracePostExecute tracePostExecute] trace add execution foo leave [list tracePostExecute2 tracePostExecute2] catch {foo 1} err trace remove execution foo leave [list tracePostExecute tracePostExecute] trace remove execution foo leave [list tracePostExecute2 tracePostExecute2] join [list $err [join $info \n] [trace info execution foo]] "\n" } {1 tracePostExecute {foo 1} 0 leave tracePostExecute2 {foo 1} 0 leave } test trace-25.7 {order dependencies of two leavestep traces} { set info {} trace add execution foo leavestep [list tracePostExecute tracePostExecute] trace add execution foo leavestep [list tracePostExecute2 tracePostExecute2] catch {foo 1} err trace remove execution foo leavestep [list tracePostExecute tracePostExecute] trace remove execution foo leavestep [list tracePostExecute2 tracePostExecute2] join [list $err [join $info \n] [trace info execution foo]] "\n" } {1 tracePostExecute {set b 1} 0 leavestep tracePostExecute2 {set b 1} 0 leavestep } proc foo {a} { set b $a } proc traceDelete {cmd args} { rename $cmd {} global info set info $args } test trace-25.8 {delete command during enter leave and enter/leave-step traces} { set info {} trace add execution foo enter [list traceDelete foo] trace add execution foo leave [list traceDelete foo] trace add execution foo enterstep [list traceDelete foo] trace add execution foo leavestep [list traceDelete foo] catch {foo 1} err list $err $info [catch {trace info execution foo} res] $res } {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} proc foo {a} { set b $a } test trace-25.9 {delete command during enter leave and leavestep traces} { set info {} trace add execution foo enter [list traceDelete foo] trace add execution foo leave [list traceDelete foo] trace add execution foo leavestep [list traceDelete foo] catch {foo 1} err list $err $info [catch {trace info execution foo} res] $res } {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} proc foo {a} { set b $a } test trace-25.10 {delete command during leave and leavestep traces} { set info {} trace add execution foo leave [list traceDelete foo] trace add execution foo leavestep [list traceDelete foo] catch {foo 1} err list $err $info [catch {trace info execution foo} res] $res } {1 {{set b 1} 0 1 leavestep} 1 {unknown command "foo"}} proc foo {a} { set b $a } test trace-25.11 {delete command during enter and enterstep traces} { set info {} trace add execution foo enter [list traceDelete foo] trace add execution foo enterstep [list traceDelete foo] catch {foo 1} err list $err $info [catch {trace info execution foo} res] $res } {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} test trace-26.1 {trace targetCmd when invoked through an alias} { proc foo {args} { set b $args } set info {} trace add execution foo enter [list traceExecute foo] interp alias {} bar {} foo 1 bar 2 trace remove execution foo enter [list traceExecute foo] set info } {{foo {foo 1 2} enter}} test trace-26.2 {trace targetCmd when invoked through an alias} { proc foo {args} { set b $args } set info {} trace add execution foo enter [list traceExecute foo] interp create child interp alias child bar {} foo 1 child eval bar 2 interp delete child trace remove execution foo enter [list traceExecute foo] set info } {{foo {foo 1 2} enter}} test trace-27.1 {memory leak in rename trace (604609)} { catch {rename bar {}} proc foo {} {error foo} trace add command foo rename {rename foo "" ;#} rename foo bar info commands foo } {} test trace-27.2 {command trace remove nonsense} { list [catch {trace remove command thisdoesntexist \ {delete rename} bar} res] $res } {1 {unknown command "thisdoesntexist"}} test trace-27.3 {command trace info nonsense} { list [catch {trace info command thisdoesntexist} res] $res } {1 {unknown command "thisdoesntexist"}} test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} { catch {rename foo {}} proc foo {} { set a 1 update idletasks set b 1 } set info {} trace add execution foo {enter enterstep leavestep leave} \ [list traceExecute foo] update after idle {set a "idle"} foo trace remove execution foo {enter enterstep leavestep leave} \ [list traceExecute foo] rename foo {} unset -nocomplain a join $info "\n" } {foo foo enter foo {set a 1} enterstep foo {set a 1} 0 1 leavestep foo {update idletasks} enterstep foo {set a idle} enterstep foo {set a idle} 0 idle leavestep foo {update idletasks} 0 {} leavestep foo {set b 1} enterstep foo {set b 1} 0 1 leavestep foo foo 0 1 leave} test trace-28.2 {exec traces with 'error'} { set info {} set res {} proc foo {} { if {[catch {bar}]} { return "error" } else { return "ok" } } proc bar {} { error "msg" } lappend res [foo] trace add execution foo {enter enterstep leave leavestep} \ [list traceExecute foo] # With the trace active lappend res [foo] trace remove execution foo {enter enterstep leave leavestep} \ [list traceExecute foo] list $res [join $info \n] } {{error error} {foo foo enter foo {if {[catch {bar}]} { return "error" } else { return "ok" }} enterstep foo {catch bar} enterstep foo bar enterstep foo {error msg} enterstep foo {error msg} 1 msg leavestep foo bar 1 msg leavestep foo {catch bar} 0 1 leavestep foo {return error} enterstep foo {return error} 2 error leavestep foo {if {[catch {bar}]} { return "error" } else { return "ok" }} 2 error leavestep foo foo 0 error leave}} test trace-28.3 {exec traces with 'return -code error'} { set info {} set res {} proc foo {} { if {[catch {bar}]} { return "error" } else { return "ok" } } proc bar {} { return -code error "msg" } lappend res [foo] trace add execution foo {enter enterstep leave leavestep} \ [list traceExecute foo] # With the trace active lappend res [foo] trace remove execution foo {enter enterstep leave leavestep} \ [list traceExecute foo] list $res [join $info \n] } {{error error} {foo foo enter foo {if {[catch {bar}]} { return "error" } else { return "ok" }} enterstep foo {catch bar} enterstep foo bar enterstep foo {return -code error msg} enterstep foo {return -code error msg} 2 msg leavestep foo bar 1 msg leavestep foo {catch bar} 0 1 leavestep foo {return error} enterstep foo {return error} 2 error leavestep foo {if {[catch {bar}]} { return "error" } else { return "ok" }} 2 error leavestep foo foo 0 error leave}} test trace-28.4 {exec traces in child with 'return -code error'} { interp create child interp alias child traceExecute {} traceExecute set info {} set res [interp eval child { set info {} set res {} proc foo {} { if {[catch {bar}]} { return "error" } else { return "ok" } } proc bar {} { return -code error "msg" } lappend res [foo] trace add execution foo {enter enterstep leave leavestep} \ [list traceExecute foo] # With the trace active lappend res [foo] trace remove execution foo {enter enterstep leave leavestep} \ [list traceExecute foo] list $res }] interp delete child lappend res [join $info \n] } {{error error} {foo foo enter foo {if {[catch {bar}]} { return "error" } else { return "ok" }} enterstep foo {catch bar} enterstep foo bar enterstep foo {return -code error msg} enterstep foo {return -code error msg} 2 msg leavestep foo bar 1 msg leavestep foo {catch bar} 0 1 leavestep foo {return error} enterstep foo {return error} 2 error leavestep foo {if {[catch {bar}]} { return "error" } else { return "ok" }} 2 error leavestep foo foo 0 error leave}} test trace-28.5 {exec traces} { set info {} proc foo {args} { set a 1 } trace add execution foo {enter enterstep leave leavestep} \ [list traceExecute foo] after idle [list foo test-28.4] update # Complicated way of removing traces set ti [lindex [eval [list trace info execution ::foo]] 0] if {[llength $ti]} { eval [concat [list trace remove execution foo] $ti] } join $info \n } {foo {foo test-28.4} enter foo {set a 1} enterstep foo {set a 1} 0 1 leavestep foo {foo test-28.4} 0 1 leave} test trace-28.6 {exec traces firing order} { set info {} proc enterStep {cmd op} {lappend ::info "enter $cmd/$op"} proc leaveStep {cmd code result op} {lappend ::info "leave $cmd/$code/$result/$op"} proc foo x { set b x=$x incr x } trace add execution foo enterstep enterStep trace add execution foo leavestep leaveStep foo 42 rename foo {} join $info \n } {enter set b x=42/enterstep leave set b x=42/0/x=42/leavestep enter incr x/enterstep leave incr x/0/43/leavestep} test trace-28.7 {exec trace information} { set info {} proc foo x { incr x } proc bar {args} {} trace add execution foo {enter leave enterstep leavestep} bar set info [trace info execution foo] trace remove execution foo {enter leave enterstep leavestep} bar } {} test trace-28.8 {exec trace remove nonsense} { list [catch {trace remove execution thisdoesntexist \ {enter leave enterstep leavestep} bar} res] $res } {1 {unknown command "thisdoesntexist"}} test trace-28.9 {exec trace info nonsense} { list [catch {trace info execution thisdoesntexist} res] $res } {1 {unknown command "thisdoesntexist"}} test trace-28.10 {exec trace info nonsense} { list [catch {trace remove execution} res] $res } {1 {wrong # args: should be "trace remove execution name opList command"}} test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace tracetest {set stuff [expr {14 + 16}]} } {{expr {14 + 16}} {expr {14 + 16}} {set stuff [expr {14 + 16}]} {set stuff 30}} test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace tracetest {set stuff [info tclversion]} } [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]] test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace deletetest {set stuff [info tclversion]} } [info tclversion] test trace-29.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace} { # Note that the proc call is the same as the variable name, and that # the call can be direct or indirect by way of another procedure proc tracer {args} {} proc tracedLoop {level} { incr level tracer foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level} } testcmdtrace tracetest {tracedLoop 0} } {{tracedLoop 0} {tracedLoop 0} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {1 2} {tracedLoop $level}} {tracedLoop $level} {tracedLoop 1} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {} {tracedLoop $level}} {tracedLoop $level} {tracedLoop 1} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {} {tracedLoop $level}}} catch {rename tracer {}} catch {rename tracedLoop {}} test trace-29.5 {Tcl_CreateObjTrace, status return TCL_ERROR} {testcmdtrace} { proc Error { args } { error "Shouldn't get here" } set x 1; list [catch {testcmdtrace resulttest {Error $x}} result] [set result] } {1 {Error $x}} test trace-29.6 {Tcl_CreateObjTrace, status return TCL_RETURN} {testcmdtrace} { proc Return { args } { error "Shouldn't get here" } set x 1; list [catch {testcmdtrace resulttest {Return $x}} result] [set result] } {2 {}} test trace-29.7 {Tcl_CreateObjTrace, status return TCL_BREAK} {testcmdtrace} { proc Break { args } { error "Shouldn't get here" } set x 1; list [catch {testcmdtrace resulttest {Break $x}} result] [set result] } {3 {}} test trace-29.8 {Tcl_CreateObjTrace, status return TCL_CONTINUE} {testcmdtrace} { proc Continue { args } { error "Shouldn't get here" } set x 1; list [catch {testcmdtrace resulttest {Continue $x}} result] [set result] } {4 {}} test trace-29.9 {Tcl_CreateObjTrace, status return unknown} {testcmdtrace} { proc OtherStatus { args } { error "Shouldn't get here" } set x 1; list [catch {testcmdtrace resulttest {OtherStatus $x}} result] [set result] } {6 {}} test trace-29.10 {Tcl_CreateTrace, correct level interpretation} {testcmdtrace} { proc foo {} {uplevel 1 bar} proc bar {} {uplevel 1 grok} proc grok {} {uplevel 1 spock} proc spock {} {uplevel 1 fascinating} proc fascinating {} {} testcmdtrace leveltest {foo} } {foo {foo} {uplevel 1 bar} {uplevel 1 bar} bar {bar} {uplevel 1 grok} {uplevel 1 grok}} test trace-29.11 {Tcl_CreateTrace, multiple traces} {testcmdtrace} { testcmdtrace doubletest {format xx} } {{format xx} {format xx}} test trace-30.1 {Tcl_DeleteTrace} {emptyTest} { # the above tests have tested Tcl_DeleteTrace } {} test trace-31.1 {command and execution traces shared struct} { # Tcl Bug 807243 proc foo {} {} trace add command foo delete foo trace add execution foo enter foo set result [trace info command foo] trace remove command foo delete foo trace remove execution foo enter foo rename foo {} set result } [list [list delete foo]] test trace-31.2 {command and execution traces shared struct} { # Tcl Bug 807243 proc foo {} {} trace add command foo delete foo trace add execution foo enter foo set result [trace info execution foo] trace remove command foo delete foo trace remove execution foo enter foo rename foo {} set result } [list [list enter foo]] test trace-32.1 { TraceCommandInfo refcount decr in TraceCommandProc w/o loss of reference } { # Tcl Bug 811483 proc foo {} {} trace add command foo delete foo trace add execution foo enter foo set result [trace info command foo] rename foo {} set result } [list [list delete foo]] test trace-33.1 {variable match with remove variable} { unset -nocomplain x trace add variable x write foo trace remove variable x write foo llength [trace info variable x] } 0 test trace-34.1 {Bug 1201035} { set ::x [list] proc foo {} {lappend ::x foo} proc bar args { lappend ::x $args trace remove execution foo leavestep bar trace remove execution foo enterstep bar trace add execution foo leavestep bar trace add execution foo enterstep bar lappend ::x done } trace add execution foo leavestep bar trace add execution foo enterstep bar foo set ::x } {{{lappend ::x foo} enterstep} done foo} test trace-34.2 {Bug 1224585} { proc foo {} {} proc bar args {trace remove execution foo leave soom} trace add execution foo leave bar trace add execution foo leave soom foo } {} test trace-34.3 {Bug 1224585} { proc foo {} {set x {}} proc bar args {trace remove execution foo enterstep soom} trace add execution foo enterstep soom trace add execution foo enterstep bar foo } {} # We test here for the half-documented and currently valid interplay between # delete traces and namespace deletion. test trace-34.4 {Bug 1047286} { variable x notrace proc callback {old - -} { variable x "$old exists: [namespace which -command $old]" } namespace eval ::foo {proc bar {} {}} trace add command ::foo::bar delete [namespace code callback] namespace delete ::foo set x } {::foo::bar exists: ::foo::bar} test trace-34.5 {Bug 1047286} { variable x notrace proc callback {old - -} { variable x "$old exists: [namespace which -command $old]" } namespace eval ::foo {proc bar {} {}} trace add command ::foo::bar delete [namespace code callback] namespace eval ::foo namespace delete ::foo set x } {::foo::bar exists: } test trace-34.6 {Bug 1458266} -setup { proc dummy {} {} proc stepTraceHandler {cmdString args} { variable log append log "[expr {[info level] - 1}]: [lindex [split $cmdString] 0]\n" dummy isTracedInside_2 } proc cmdTraceHandler {cmdString args} { # silent } proc isTracedInside_1 {} { isTracedInside_2 } proc isTracedInside_2 {} { set x 2 } } -body { variable log {} trace add execution isTracedInside_1 enterstep stepTraceHandler trace add execution isTracedInside_2 enterstep stepTraceHandler isTracedInside_1 variable first $log set log {} trace add execution dummy enter cmdTraceHandler isTracedInside_1 variable second $log expr {($first eq $second) ? "ok" : "\n$first\nand\n\n$second\ndiffer"} } -cleanup { unset -nocomplain log first second rename dummy {} rename stepTraceHandler {} rename cmdTraceHandler {} rename isTracedInside_1 {} rename isTracedInside_2 {} } -result ok test trace-35.1 {527164: Keep -errorinfo of traces} -setup { unset -nocomplain x y } -body { trace add variable x write {error foo;#} trace add variable y write {set x 2;#} list [catch {set y 1} msg opts] $msg [dict get $opts -errorinfo] } -cleanup { unset -nocomplain x y } -result {1 {can't set "y": can't set "x": foo} {foo while executing "error foo" (write trace on "x") invoked from within "set x 2" (write trace on "y") invoked from within "set y 1"}} # # Test for the correct(?) dynamics of execution traces. This test insures that # the dynamics of the original implementation remain valid; note that # these aspects are neither documented nor do they appear in TIP 62 proc traceproc {tracevar args} { append ::$tracevar * } proc untraced {type} { trace add execution untraced $type {traceproc tracevar} append ::tracevar - } proc runbase {results base} { set tt {enter leave enterstep leavestep} foreach n {1 2 3 4} t $tt r $results { eval [subst $base] } } set base { test trace-36.$n {dynamic trace creation: $t} -setup { set ::tracevar {} } -cleanup { unset ::tracevar trace remove execution untraced $t {traceproc tracevar} } -body { untraced $t set ::tracevar } -result {$r} } runbase {- - - -} $base set base { test trace-37.$n {dynamic trace addition: $t} -setup { set ::tracevar {} set ::tracevar2 {} trace add execution untraced enter {traceproc tracevar2} } -cleanup { trace remove execution untraced $t {traceproc tracevar} trace remove execution untraced enter {traceproc tracevar2} unset ::tracevar ::tracevar2 } -body { untraced $t list \$::tracevar \$::tracevar2 } -result {$r} } runbase {{- *} {-* *} {- *} {- *}} $base set base { test trace-38.$n {dynamic trace addition: $t} -setup { set ::tracevar {} set ::tracevar2 {} trace add execution untraced leave {traceproc tracevar2} } -cleanup { trace remove execution untraced $t {traceproc tracevar} trace remove execution untraced leave {traceproc tracevar2} unset ::tracevar ::tracevar2 } -body { untraced $t list \$::tracevar \$::tracevar2 } -result {$r} } runbase {{- *} {-* *} {- *} {- *}} $base test trace-39 {bug #3484621: tracing Bc'ed commands} -setup { set ::traceLog 0 set ::traceCalls 0 set ::bar [list 0 1 2 3] set res {} proc dotrace args { incr ::traceLog } proc foo {} { incr ::traceCalls # choose a BC'ed command that is 'unlikely' to interfere with tcltest's # internals lset ::bar 1 2 } } -body { foo lappend res $::traceLog trace add execution lset enter dotrace foo lappend res $::traceLog trace remove execution lset enter dotrace foo lappend res $::traceLog list $::traceCalls | {*}$res } -cleanup { unset ::traceLog ::traceCalls ::bar res rename dotrace {} rename foo {} } -result {3 | 0 1 1} test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup { set ::traceLog 0 set ::traceCalls 0 set res {} proc dotrace args { incr ::traceLog } proc foo {} { incr ::traceCalls string equal zip zap } } -body { foo lappend res $::traceLog trace add execution ::tcl::string::equal enter dotrace foo lappend res $::traceLog trace remove execution tcl::string::equal enter dotrace foo lappend res $::traceLog list $::traceCalls | {*}$res } -cleanup { unset ::traceLog ::traceCalls res rename dotrace {} rename foo {} } -result {3 | 0 1 1} test trace-40.1 {execution trace errors become command errors} { proc foo args {} trace add execution foo enter {rename foo {}; error bar;#} catch foo m return -level 0 $m[unset m] } bar # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). catch {rename foobar {}} catch {rename foo {}} catch {rename bar {}} catch {rename untraced {}} catch {rename traceproc {}} catch {rename runbase {}} # Unset the variable when done unset -nocomplain info base # cleanup cleanupTests return tcl8.6.14/tests/unixFCmd.test0000644000175000017500000003371614554262142015434 0ustar sergeisergei# This file tests the tclUnixFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] # File permissions broken on wsl without some "exotic" wsl configuration testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] # These tests really need to be run from a writable directory, which # it is assumed [temporaryDirectory] is. set oldcwd [pwd] cd [temporaryDirectory] # Several tests require need to match results against the Unix username set user {} if {[testConstraint unix]} { catch {set user [exec whoami]} if {$user == ""} { catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} } if {$user == ""} { set user "root" } } # Find a group that exists on this system, or else skip tests that require # groups testConstraint foundGroup 0 if {[testConstraint unix]} { catch { set groupList [exec groups] set group [lindex $groupList 0] testConstraint foundGroup 1 } } # check whether -readonly attribute is supported testConstraint readonlyAttr 0 if {[testConstraint unix]} { set f [makeFile "whatever" probe] catch { file attributes $f -readonly testConstraint readonlyAttr 1 } removeFile probe } proc openup {path} { testchmod 0o777 $path if {[file isdirectory $path]} { catch { foreach p [glob -directory $path *] { openup $p } } } } proc cleanup {args} { foreach p ". $args" { set x "" catch { set x [glob -directory $p tf* td*] } foreach file $x { if { [catch {file delete -force -- $file}] && [testConstraint testchmod] } then { openup $file file delete -force -- $file } } } } if {[testConstraint unix] && [testConstraint notRoot]} { testConstraint execMknod [expr {![catch {exec mknod tf1 p}]}] cleanup } test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup { cleanup } -constraints {unix notRoot notWsl} -body { file mkdir td1/td2/td3 file attributes td1/td2 -permissions 0o000 file rename td1/td2/td3 td2 } -returnCodes error -cleanup { file attributes td1/td2 -permissions 0o755 cleanup } -result {error renaming "td1/td2/td3": permission denied} test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td1/td2 file mkdir td2 file rename td2 td1 } -returnCodes error -cleanup { cleanup } -result {error renaming "td2" to "td1/td2": file already exists} test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td1 file rename td1 td1 } -returnCodes error -cleanup { cleanup } -result {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself} test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unix notRoot} { # can't make it happen } {} test unixFCmd-1.5 {TclpRenameFile: ENOENT} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td1 file rename td2 td1 } -returnCodes error -cleanup { cleanup } -result {error renaming "td2": no such file or directory} test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} { # can't make it happen } {} test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup { cleanup } -constraints {unix notRoot notWsl} -body { file mkdir foo/bar file attr foo -perm 0o40555 file rename foo/bar /tmp } -returnCodes error -cleanup { catch {file delete /tmp/bar} catch {file attr foo -perm 0o40777} catch {file delete -force foo} } -match glob -result {*: permission denied} test unixFCmd-1.8 {Checking EINTR Bug} {unix notRoot nonPortable} { testalarm after 2000 list [testgotsig] [testgotsig] } {1 0} test unixFCmd-1.9 {Checking EINTR Bug} -constraints {unix notRoot nonPortable} -setup { cleanup set f [open tfalarm w] puts $f { after 2000 puts "hello world" exit 0 } close $f } -body { testalarm set pipe [open "|[info nameofexecutable] tfalarm" r+] set line [read $pipe 1] catch {close $pipe} list $line [testgotsig] } -cleanup { cleanup } -result {h 1} test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} -setup { cleanup } -constraints {unix notRoot} -body { close [open tf1 a] close [open tf2 a] file copy -force tf1 tf2 } -cleanup { cleanup } -result {} test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} -setup { cleanup } -constraints {unix notRoot dontCopyLinks} -body { # copying links should end up with real files close [open tf1 a] file link -symbolic tf2 tf1 file copy tf2 tf3 file type tf3 } -cleanup { cleanup } -result file test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} -setup { cleanup } -constraints {unix notRoot} -body { # copying links should end up with the links copied close [open tf1 a] file link -symbolic tf2 tf1 file copy tf2 tf3 file type tf3 } -cleanup { cleanup } -result link test unixFCmd-2.3 {TclpCopyFile: src is block} -setup { cleanup } -constraints {unix notRoot} -body { set null "/dev/null" while {[file type $null] != "characterSpecial"} { set null [file join [file dirname $null] [file readlink $null]] } # file copy $null tf1 } -result {} test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup { cleanup } -constraints {unix notRoot execMknod} -body { exec mknod tf1 p file copy tf1 tf2 list [file type tf1] [file type tf2] } -cleanup { cleanup } -result {fifo fifo} test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup { cleanup } -constraints {unix notRoot notWsl} -body { close [open tf1 a] file attributes tf1 -permissions 0o472 file copy tf1 tf2 format 0o%03o [file attributes tf2 -permissions] } -cleanup { cleanup } -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w- test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} { } {} test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unix notRoot} { } {} test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unix notRoot} { } {} test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unix notRoot} { } {} test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unix notRoot} { } {} test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unix notRoot} { } {} test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unix notRoot} { } {} test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unix notRoot} { } {} test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unix notRoot} { } {} test unixFCmd-12.1 {GetGroupAttribute - file not found} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -returnCodes error -body { file attributes foo.test -group } -result {could not read "foo.test": no such file or directory} test unixFCmd-12.2 {GetGroupAttribute - file found} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] file attributes foo.test -group } -cleanup { file delete -force -- foo.test } -match glob -result * test unixFCmd-13.1 {GetOwnerAttribute - file not found} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -returnCodes error -body { file attributes foo.test -group } -result {could not read "foo.test": no such file or directory} test unixFCmd-13.2 {GetOwnerAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] file attributes foo.test -owner } -cleanup { file delete -force -- foo.test } -result $user test unixFCmd-14.1 {GetPermissionsAttribute - file not found} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -returnCodes error -body { file attributes foo.test -permissions } -result {could not read "foo.test": no such file or directory} test unixFCmd-14.2 {GetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] file attribute foo.test -permissions } -cleanup { file delete -force -- foo.test } -match glob -result * #groups hard to test test unixFCmd-15.1 {SetGroupAttribute - invalid group} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { file attributes foo.test -group foozzz } -returnCodes error -cleanup { file delete -force -- foo.test } -result {could not set group for file "foo.test": group "foozzz" does not exist} test unixFCmd-15.2 {SetGroupAttribute - invalid file} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot foundGroup} -returnCodes error -body { file attributes foo.test -group $group } -result {could not set group for file "foo.test": no such file or directory} #changing owners hard to do test unixFCmd-16.1 {SetOwnerAttribute - current owner} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] list [file attributes foo.test -owner $user] \ [file attributes foo.test -owner] } -cleanup { file delete -force -- foo.test } -result [list {} $user] test unixFCmd-16.2 {SetOwnerAttribute - invalid file} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -returnCodes error -body { file attributes foo.test -owner $user } -result {could not set owner for file "foo.test": no such file or directory} test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -returnCodes error -body { file attributes foo.test -owner foozzz } -result {could not set owner for file "foo.test": user "foozzz" does not exist} test unixFCmd-17.1 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot notWsl} -body { close [open foo.test w] list [file attributes foo.test -permissions 0o000] \ [format 0o%03o [file attributes foo.test -permissions]] } -cleanup { file delete -force -- foo.test } -result {{} 0o000} test unixFCmd-17.2 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -returnCodes error -body { file attributes foo.test -permissions 0o000 } -result {could not set permissions for file "foo.test": no such file or directory} test unixFCmd-17.3 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] file attributes foo.test -permissions foo } -cleanup { file delete -force -- foo.test } -returnCodes error -result {unknown permission string format "foo"} test unixFCmd-17.4 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] file attributes foo.test -permissions ---rwx } -cleanup { file delete -force -- foo.test } -returnCodes error -result {unknown permission string format "---rwx"} close [open foo.test w] set ::i 4 proc permcheck {testnum permList expected} { test $testnum {SetPermissionsAttribute} {unix notRoot notWsl} { set result {} foreach permstr $permList { file attributes foo.test -permissions $permstr lappend result [format 0o%03o [file attributes foo.test -permissions]] } set result } $expected } permcheck unixFCmd-17.5 rwxrwxrwx 0o777 permcheck unixFCmd-17.6 r--r---w- 0o442 permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {0o000 0o740 0o540 0o547} permcheck unixFCmd-17.11 --x--x--x 0o111 permcheck unixFCmd-17.12 {0 a+rwx} {0o000 0o777} file delete -force -- foo.test test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup { set cd [pwd] } -body { # This test is non-portable because SunOS generates a weird error # message when the current directory isn't readable. set nd $cd/tstdir file mkdir $nd cd $nd file attributes $nd -permissions 0o000 pwd } -returnCodes error -cleanup { cd $cd file attributes $nd -permissions 0o755 file delete $nd } -match glob -result {error getting working directory name:*} test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot readonlyAttr} -returnCodes error -body { file attributes foo.test -readonly } -result {could not read "foo.test": no such file or directory} test unixFCmd-19.2 {GetReadOnlyAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot readonlyAttr} -body { close [open foo.test w] file attribute foo.test -readonly } -cleanup { file delete -force -- foo.test } -result 0 test unixFCmd-20.1 {SetReadOnlyAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot readonlyAttr} -body { close [open foo.test w] list [catch {file attributes foo.test -readonly 1} msg] $msg \ [catch {file attribute foo.test -readonly} msg] $msg \ [catch {file delete -force -- foo.test}] \ [catch {file attributes foo.test -readonly 0} msg] $msg \ [catch {file attribute foo.test -readonly} msg] $msg } -cleanup { file delete -force -- foo.test } -result {0 {} 0 1 1 0 {} 0 0} test unixFCmd-20.2 {SetReadOnlyAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot readonlyAttr} -returnCodes error -body { file attributes foo.test -readonly 1 } -result {could not read "foo.test": no such file or directory} # cleanup cleanup cd $oldcwd ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/unixFile.test0000644000175000017500000000367214554262142015500 0ustar sergeisergei# This file contains tests for the routines in the file tclUnixFile.c # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testfindexecutable [llength [info commands testfindexecutable]] set oldpwd [pwd] cd [temporaryDirectory] catch { set oldPath $env(PATH) file attributes [makeFile "" junk] -perm 0o777 } set absPath [file join [temporaryDirectory] junk] test unixFile-1.1 {Tcl_FindExecutable} {testfindexecutable unix} { set env(PATH) "" testfindexecutable junk } $absPath test unixFile-1.2 {Tcl_FindExecutable} {testfindexecutable unix} { set env(PATH) "/dummy" testfindexecutable junk } {} test unixFile-1.3 {Tcl_FindExecutable} {testfindexecutable unix} { set env(PATH) "/dummy:[pwd]" testfindexecutable junk } $absPath test unixFile-1.4 {Tcl_FindExecutable} {testfindexecutable unix} { set env(PATH) "/dummy:" testfindexecutable junk } $absPath test unixFile-1.5 {Tcl_FindExecutable} {testfindexecutable unix} { set env(PATH) "/dummy:/dummy" testfindexecutable junk } {} test unixFile-1.6 {Tcl_FindExecutable} {testfindexecutable unix} { set env(PATH) "/dummy::/dummy" testfindexecutable junk } $absPath test unixFile-1.7 {Tcl_FindExecutable} {testfindexecutable unix} { set env(PATH) ":/dummy" testfindexecutable junk } $absPath # cleanup catch {set env(PATH) $oldPath} removeFile junk cd $oldpwd ::tcltest::cleanupTests return tcl8.6.14/tests/unixForkEvent.test0000644000175000017500000000261014554262142016513 0ustar sergeisergei# This file contains a collection of tests for the procedures in the file # tclUnixNotify.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 namespace import -force ::tcltest::* testConstraint testfork [llength [info commands testfork]] # Test if the notifier thread is well initialized in a forked interpreter # by Tcl_InitNotifier test unixforkevent-1.1 {fork and test writable event} \ -constraints {testfork nonPortable} \ -body { set myFolder [makeDirectory unixtestfork] set pid [testfork] if {$pid == 0} { # we are the forked process set result initialized set h [open [file join $myFolder test.txt] w] fileevent $h writable\ "set result writable;\ after cancel [after 1000 {set result timeout}]" vwait result close $h makeFile $result result.txt $myFolder exit } # we are the original process while {![file readable [file join $myFolder result.txt]]} {} viewFile result.txt $myFolder } \ -result {writable} \ -cleanup { catch { removeFolder $myFolder } } ::tcltest::cleanupTests return tcl8.6.14/tests/unixInit.test0000644000175000017500000001220214554262142015511 0ustar sergeisergei# The file tests the functions in the tclUnixInit.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 namespace import ::tcltest::* unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { set x {} # Watch out for a race condition here. If tcltest is too slow to start # then we'll kill it before it has a chance to set up its signal handler. set f [open "|[list [interpreter]]" w+] puts $f "puts hi" flush $f gets $f exec kill -PIPE [pid $f] lappend x [catch {close $f}] set f [open "|[list [interpreter]]" w+] puts $f "puts hi" flush $f gets $f exec kill [pid $f] lappend x [catch {close $f}] set x } {0 1} # This test is really a test of code in tclUnixChan.c, but the channels are # set up as part of initialisation of the interpreter so the test seems to me # to fit here as well as anywhere else. test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} { # pipe1 is a connection to a server that reports what port it starts on, # and delivers a constant string to the first client to connect to that # port before exiting. set pipe1 [open "|[list [interpreter]]" r+] puts $pipe1 { proc accept {channel host port} { puts $channel {puts [chan configure stdin -peername]; exit} close $channel exit } puts [chan configure [socket -server accept -myaddr 127.0.0.1 0] -sockname] vwait forever \ } # Note the backslash above; this is important to make sure that the whole # string is read before an [exit] can happen... flush $pipe1 set port [lindex [gets $pipe1] 2] set sock [socket localhost $port] # pipe2 is a connection to a Tcl interpreter that takes its orders from # the socket we hand it (i.e. the server we create above.) These orders # will tell it to print out the details about the socket it is taking # instructions from, hopefully identifying it as a socket. Which is what # this test is all about. set pipe2 [open "|[list [interpreter] <@$sock]" r] set result [gets $pipe2] # Clear any pending data; stops certain kinds of (non-important) errors chan configure $pipe1 -blocking 0; gets $pipe1 chan configure $pipe2 -blocking 0; gets $pipe2 # Close the pipes and the socket. close $pipe2 close $pipe1 catch {close $sock} # Can't use normal comparison, as hostname varies due to some # installations having a messed up /etc/hosts file. if { "127.0.0.1" eq [lindex $result 0] && $port == [lindex $result 2] } then { subst "OK" } else { subst "Expected: `[list 127.0.0.1 localhost $port]', Got `$result'" } } {OK} test unixInit-3.1 {TclpSetInitialEncodings} -constraints { unix stdio } -body { set env(LANG) C set f [open "|[list [interpreter]]" w+] chan configure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] close $f set enc } -cleanup { unset -nocomplain env(LANG) } -match regexp -result {^(iso8859-15?|utf-8)$} test unixInit-3.2 {TclpSetInitialEncodings} -setup { catch {set oldlc_all $env(LC_ALL)} } -constraints {unix stdio} -body { set env(LANG) japanese set env(LC_ALL) japanese set f [open "|[list [interpreter]]" w+] chan configure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] close $f set validEncodings [list euc-jp] if {[string match HP-UX $tcl_platform(os)]} { # Some older HP-UX systems need us to accept this as valid Bug 453883 # reports that newer HP-UX systems report euc-jp like everybody else. lappend validEncodings shiftjis } expr {$enc ni $validEncodings} } -cleanup { unset -nocomplain env(LANG) env(LC_ALL) catch {set env(LC_ALL) $oldlc_all} } -result 0 test unixInit-4.1 {TclpSetVariables} {unix} { # just make sure they exist set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)] set a [list $tcl_platform(osVersion) $tcl_platform(machine)] set tcl_platform(platform) } "unix" test unixInit-5.1 {Tcl_Init} {emptyTest unix} { # test initScript } {} test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unix} { } {} test unixInit-7.1 {closed standard channel: Bug 772288} -constraints { unix stdio } -body { set tclsh [interpreter] set crash [makeFile {puts [open /dev/null]} crash.tcl] set crashtest [makeFile " close stdin [list exec $tclsh $crash] " crashtest.tcl] exec $tclsh $crashtest } -cleanup { removeFile crash.tcl removeFile crashtest.tcl } -returnCodes 0 # cleanup unset -nocomplain env(LANG) catch {set env(LANG) $oldlang} unset -nocomplain path ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/unixNotfy.test0000644000175000017500000000553314554262142015716 0ustar sergeisergei# This file contains tests for tclUnixNotfy.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # When run in a Tk shell, these tests hang. testConstraint noTk [expr {0 != [catch {package present Tk}]}] testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] # Darwin always uses a threaded notifier testConstraint unthreaded [expr { ![::tcl::pkgconfig get threaded] && $tcl_platform(os) ne "Darwin" }] # The next two tests will hang if threads are enabled because the notifier # will not necessarily wait for ever in this case, so it does not generate # an error. test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body { catch {vwait x} set f [open [makeFile "" foo] w] fileevent $f writable {set x 1} vwait x close $f list [catch {vwait x} msg] $msg } -result {1 {can't wait for variable "x": would wait forever}} -cleanup { catch { close $f } catch { removeFile foo } } test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body { catch {vwait x} set f1 [open [makeFile "" foo] w] set f2 [open [makeFile "" foo2] w] fileevent $f1 writable {set x 1} fileevent $f2 writable {set y 1} vwait x close $f1 vwait y close $f2 list [catch {vwait x} msg] $msg } -result {1 {can't wait for variable "x": would wait forever}} -cleanup { catch { close $f1 } catch { close $f2 } catch { removeFile foo } catch { removeFile foo2 } } test unixNotfy-2.1 {Tcl_DeleteFileHandler} \ -constraints {noTk unix thread} \ -body { update set f [open [makeFile "" foo] w] fileevent $f writable {set x 1} vwait x close $f thread::create "thread::send [thread::id] {set x ok}" vwait x set x } \ -result {ok} \ -cleanup { catch { close $f } catch { removeFile foo } } test unixNotfy-2.2 {Tcl_DeleteFileHandler} \ -constraints {noTk unix thread} \ -body { update set f1 [open [makeFile "" foo] w] set f2 [open [makeFile "" foo2] w] fileevent $f1 writable {set x 1} fileevent $f2 writable {set y 1} vwait x close $f1 vwait y close $f2 thread::create "thread::send [thread::id] {set x ok}" vwait x set x } \ -result {ok} \ -cleanup { catch { close $f1 } catch { close $f2 } catch { removeFile foo } catch { removeFile foo2 } } # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/unknown.test0000644000175000017500000000343514554262142015411 0ustar sergeisergei# Commands covered: unknown # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 namespace import ::tcltest::* unset -nocomplain x catch {rename unknown unknown.old} test unknown-1.1 {non-existent "unknown" command} { list [catch {_non-existent_ foo bar} msg] $msg } {1 {invalid command name "_non-existent_"}} proc unknown {args} { global x set x $args } test unknown-2.1 {calling "unknown" command} { foobar x y z set x } {foobar x y z} test unknown-2.2 {calling "unknown" command with lots of args} { foobar 1 2 3 4 5 6 7 set x } {foobar 1 2 3 4 5 6 7} test unknown-2.3 {calling "unknown" command with lots of args} { foobar 1 2 3 4 5 6 7 8 set x } {foobar 1 2 3 4 5 6 7 8} test unknown-2.4 {calling "unknown" command with lots of args} { foobar 1 2 3 4 5 6 7 8 9 set x } {foobar 1 2 3 4 5 6 7 8 9} test unknown-3.1 {argument quoting in calls to "unknown"} { foobar \{ \} a\{b \; "\\" \$a a\[b \] set x } "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]" proc unknown args { error "unknown failed" } test unknown-4.1 {errors in "unknown" procedure} { list [catch {non-existent a b} msg] $msg $errorCode } {1 {unknown failed} NONE} # cleanup catch {rename unknown {}} catch {rename unknown.old unknown} cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/unload.test0000644000175000017500000003201614554262142015171 0ustar sergeisergei# Commands covered: unload # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # Copyright (c) 2003-2004 Georgios Petasis # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Figure out what extension is used for shared libraries on this # platform. if {![info exists ext]} { set ext [info sharedlibextension] } # Tests require the existence of one of the DLLs in the dltest directory. set testDir [file join [file dirname [info nameofexecutable]] dltest] set x [file join $testDir pkgua$ext] set dll "[file tail $x]Required" testConstraint $dll [file readable $x] # Tests also require that this DLL has not already been loaded. set loaded "[file tail $x]Loaded" set alreadyLoaded [info loaded] testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] # Certain tests need the 'testsimplefilsystem' in tcltest testConstraint testsimplefilesystem \ [llength [info commands testsimplefilesystem]] proc loadIfNotPresent {pkg args} { global testDir ext set loaded [lmap x [info loaded {*}$args] {lindex $x 1}] if {[string totitle $pkg] ni $loaded} { load [file join $testDir $pkg$ext] } } # Basic tests: parameter testing... test unload-1.1 {basic errors} -returnCodes error -body { unload } -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?interp?"} test unload-1.2 {basic errors} -returnCodes error -body { unload a b c d } -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?interp?"} test unload-1.3 {basic errors} -returnCodes error -body { unload a b foobar } -result {could not find interpreter "foobar"} test unload-1.4 {basic errors} -returnCodes error -body { unload {} } -result {must specify either file name or package name} test unload-1.5 {basic errors} -returnCodes error -body { unload {} {} } -result {must specify either file name or package name} test unload-1.6 {basic errors} -returnCodes error -body { unload {} Unknown } -result {package "Unknown" is loaded statically and cannot be unloaded} test unload-1.7 {-nocomplain switch} { unload -nocomplain {} Unknown } {} set pkgua_loaded {} set pkgua_detached {} set pkgua_unloaded {} # Tests for loading/unloading in trusted (non-safe) interpreters... test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] { loadIfNotPresent pkga list [pkga_eq abc def] [lsort [info commands pkga_*]] } {0 {pkga_eq pkga_quote}} test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [load [file join $testDir pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}} test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} -setup { loadIfNotPresent pkga } -constraints [list $dll $loaded] -returnCodes error -match glob -body { unload [file join $testDir pkga$ext] } -result {file "*" cannot be unloaded under a trusted interpreter} test unload-2.4 {basic unloading of unloadable package, with guess for package name} -setup { loadIfNotPresent pkgua } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {. {} {} {} {} . . .} test unload-2.5 {reloading of unloaded package, with guess for package name} -setup { if {$pkgua_loaded eq ""} { loadIfNotPresent pkgua unload [file join $testDir pkgua$ext] } } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [load [file join $testDir pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .} test unload-2.6 {basic unloading of re-loaded package, with guess for package name} -setup { # Establish expected state if {$pkgua_loaded eq ""} { loadIfNotPresent pkgua unload [file join $testDir pkgua$ext] load [file join $testDir pkgua$ext] } } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {.. . . {} {} .. .. ..} # Tests for loading/unloading in safe interpreters... interp create -safe child child eval { set pkgua_loaded {} set pkgua_detached {} set pkgua_unloaded {} } test unload-3.1 {basic loading of non-unloadable package in a safe interpreter, with package name conversion} \ [list $dll $loaded] { catch {rename pkgb_sub {}} load [file join $testDir pkgb$ext] Pkgb child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test unload-3.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \ [list $dll $loaded] { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [load [file join $testDir pkgua$ext] Pkgua child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup { loadIfNotPresent pkga } -constraints [list $dll $loaded] -returnCodes error -match glob -body { unload [file join $testDir pkga$ext] {} child } -result {file "*" has never been loaded in this interpreter} test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup { if {[lsearch -index 1 [info loaded child] Pkgb] < 0} { load [file join $testDir pkgb$ext] Pkgb child } } -constraints [list $dll $loaded] -returnCodes error -match glob -body { unload [file join $testDir pkgb$ext] {} child } -result {file "*" cannot be unloaded under a safe interpreter} test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup { if {[lsearch -index 1 [info loaded child] Pkgua] < 0} { load [file join $testDir pkgua$ext] Pkgua child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [unload [file join $testDir pkgua$ext] {} child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . .}} test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} -setup { if {[child eval set pkgua_loaded] eq ""} { load [file join $testDir pkgua$ext] {} child unload [file join $testDir pkgua$ext] {} child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [load [file join $testDir pkgua$ext] {} child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}} test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} -setup { if {[child eval set pkgua_loaded] eq ""} { load [file join $testDir pkgua$ext] {} child unload [file join $testDir pkgua$ext] {} child load [file join $testDir pkgua$ext] {} child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [unload [file join $testDir pkgua$ext] Pkgua child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{.. . .} {} {} {.. .. ..}} # Tests for loading/unloading of a package among multiple interpreters... interp create child-trusted child-trusted eval { set pkgua_loaded {} set pkgua_detached {} set pkgua_unloaded {} } array set load {M 0 C 0 T 0} ## Load package in main trusted interpreter... test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} -setup { set pkgua_loaded "" set pkgua_detached "" set pkgua_unloaded "" incr load(M) } -constraints [list $dll $loaded] -body { list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ [load [file join $testDir pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] } -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} ## Load package in child-safe interpreter... test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} -setup { child eval { set pkgua_loaded "" set pkgua_detached "" set pkgua_unloaded "" } incr load(C) } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [load [file join $testDir pkgua$ext] Pkgua child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} ## Load package in child-trusted interpreter... test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} -setup { incr load(T) } -constraints [list $dll $loaded] -body { list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [load [file join $testDir pkgua$ext] Pkgua child-trusted] \ [child-trusted eval pkgua_eq abc def] \ [lsort [child-trusted eval info commands pkgua_*]] \ [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} ## Unload the package from the main trusted interpreter... test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} -setup { if {!$load(M)} { load [file join $testDir pkgua$ext] } if {!$load(C)} { load [file join $testDir pkgua$ext] {} child incr load(C) } if {!$load(T)} { load [file join $testDir pkgua$ext] {} child-trusted incr load(T) } } -constraints [list $dll $loaded] -body { list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] } -result {{. {} {}} {} {} {. . {}}} ## Unload the package from the child safe interpreter... test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup { if {!$load(C)} { load [file join $testDir pkgua$ext] {} child } if {!$load(T)} { load [file join $testDir pkgua$ext] {} child-trusted incr load(T) } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [unload [file join $testDir pkgua$ext] {} child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . {}}} ## Unload the package from the child trusted interpreter... test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup { if {!$load(T)} { load [file join $testDir pkgua$ext] {} child-trusted } } -constraints [list $dll $loaded] -body { list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [unload [file join $testDir pkgua$ext] {} child-trusted] \ [child-trusted eval info commands pkgua_*] \ [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . .}} test unload-5.1 {unload a module loaded from vfs} \ -constraints [list $dll $loaded testsimplefilesystem] \ -setup { set dir [pwd] cd $testDir testsimplefilesystem 1 load simplefs:/pkgua$ext Pkgua } \ -body { list [catch {unload simplefs:/pkgua$ext} msg] $msg } \ -result {0 {}} # cleanup interp delete child interp delete child-trusted unset ext ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/uplevel.test0000644000175000017500000002044414554262142015365 0ustar sergeisergei# Commands covered: uplevel # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } proc a {x y} { newset z [expr {$x + $y}] return $z } proc newset {name value} { uplevel set $name $value uplevel 1 {uplevel 1 {set xyz 22}} } test uplevel-1.1 {simple operation} { set xyz 0 a 22 33 } 55 test uplevel-1.2 {command is another uplevel command} { set xyz 0 a 22 33 set xyz } 22 proc a1 {} { b1 global a a1 set a $x set a1 $y } proc b1 {} { c1 global b b1 set b $x set b1 $y } proc c1 {} { uplevel 1 set x 111 uplevel #2 set y 222 uplevel 2 set x 333 uplevel #1 set y 444 uplevel 3 set x 555 uplevel #0 set y 666 } a1 test uplevel-2.1 {relative and absolute uplevel} {set a} 333 test uplevel-2.2 {relative and absolute uplevel} {set a1} 444 test uplevel-2.3 {relative and absolute uplevel} {set b} 111 test uplevel-2.4 {relative and absolute uplevel} {set b1} 222 test uplevel-2.5 {relative and absolute uplevel} {set x} 555 test uplevel-2.6 {relative and absolute uplevel} {set y} 666 test uplevel-3.1 {uplevel to same level} { set x 33 uplevel #0 set x 44 set x } 44 test uplevel-3.2 {uplevel to same level} { set x 33 uplevel 0 set x } 33 test uplevel-3.3 {uplevel to same level} { set y xxx proc a1 {} {set y 55; uplevel 0 set y 66; return $y} a1 } 66 test uplevel-3.4 {uplevel to same level} { set y zzz proc a1 {} {set y 55; uplevel #1 set y} a1 } 55 test uplevel-4.0.1 {error: non-existent level} -body { uplevel #0 { uplevel { set y 222 } } } -returnCodes error -result {bad level "1"} test uplevel-4.0.2 {error: non-existent level} -setup { interp create i } -body { i eval { uplevel { set y 222 } } } -returnCodes error -result {bad level "1"} -cleanup { interp delete i } test uplevel-4.1 {error: non-existent level} -returnCodes error -body { apply {{} { uplevel #2 {set y 222} }} } -result {bad level "#2"} test uplevel-4.2 {error: non-existent level} -returnCodes error -body { apply {{} { uplevel 3 {set a b} }} } -result {bad level "3"} test uplevel-4.3 {error: not enough args} -returnCodes error -body { uplevel } -result {wrong # args: should be "uplevel ?level? command ?arg ...?"} test uplevel-4.4 {error: not enough args} -returnCodes error -body { apply {{} { uplevel 1 }} } -result {wrong # args: should be "uplevel ?level? command ?arg ...?"} test uplevel-4.5 {level parsing} { apply {{} {uplevel 0 {}}} } {} test uplevel-4.6 {level parsing} { apply {{} {uplevel #0 {}}} } {} test uplevel-4.7 {level parsing} { apply {{} {uplevel [expr 0] {}}} } {} test uplevel-4.8 {level parsing} { apply {{} {uplevel #[expr 0] {}}} } {} test uplevel-4.9 {level parsing} { apply {{} {uplevel -0 {}}} } {} test uplevel-4.10 {level parsing} { apply {{} {uplevel #-0 {}}} } {} test uplevel-4.11 {level parsing} { apply {{} {uplevel [expr -0] {}}} } {} test uplevel-4.12 {level parsing} { apply {{} {uplevel #[expr -0] {}}} } {} test uplevel-4.13 {level parsing} { apply {{} {uplevel 1 {}}} } {} test uplevel-4.14 {level parsing} { apply {{} {uplevel #1 {}}} } {} test uplevel-4.15 {level parsing} { apply {{} {uplevel [expr 1] {}}} } {} test uplevel-4.16 {level parsing} { apply {{} {uplevel #[expr 1] {}}} } {} test uplevel-4.17 {level parsing} { apply {{} {uplevel -0xffffffff {}}} } {} test uplevel-4.18 {level parsing} { apply {{} {uplevel #-0xffffffff {}}} } {} test uplevel-4.19 {level parsing} { apply {{} {uplevel [expr -0xffffffff] {}}} } {} test uplevel-4.20 {level parsing} { apply {{} {uplevel #[expr -0xffffffff] {}}} } {} test uplevel-4.21 {level parsing} -body { apply {{} {uplevel -1 {}}} } -returnCodes error -result {invalid command name "-1"} test uplevel-4.22 {level parsing} -body { apply {{} {uplevel #-1 {}}} } -returnCodes error -result {bad level "#-1"} test uplevel-4.23 {level parsing} -body { apply {{} {uplevel [expr -1] {}}} } -returnCodes error -result {invalid command name "-1"} test uplevel-4.24 {level parsing} -body { apply {{} {uplevel #[expr -1] {}}} } -returnCodes error -result {bad level "#-1"} test uplevel-4.25 {level parsing} -body { apply {{} {uplevel 0xffffffff {}}} } -returnCodes error -result {bad level "0xffffffff"} test uplevel-4.26 {level parsing} -body { apply {{} {uplevel #0xffffffff {}}} } -returnCodes error -result {bad level "#0xffffffff"} test uplevel-4.27 {level parsing} -body { apply {{} {uplevel [expr 0xffffffff] {}}} } -returnCodes error -result {bad level "4294967295"} test uplevel-4.28 {level parsing} -body { apply {{} {uplevel #[expr 0xffffffff] {}}} } -returnCodes error -result {bad level "#4294967295"} test uplevel-4.29 {level parsing} -body { apply {{} {uplevel 0.2 {}}} } -returnCodes error -result {bad level "0.2"} test uplevel-4.30 {level parsing} -body { apply {{} {uplevel #0.2 {}}} } -returnCodes error -result {bad level "#0.2"} test uplevel-4.31 {level parsing} -body { apply {{} {uplevel [expr 0.2] {}}} } -returnCodes error -result {bad level "0.2"} test uplevel-4.32 {level parsing} -body { apply {{} {uplevel #[expr 0.2] {}}} } -returnCodes error -result {bad level "#0.2"} test uplevel-4.33 {level parsing} -body { apply {{} {uplevel .2 {}}} } -returnCodes error -result {invalid command name ".2"} test uplevel-4.34 {level parsing} -body { apply {{} {uplevel #.2 {}}} } -returnCodes error -result {bad level "#.2"} test uplevel-4.35 {level parsing} -body { apply {{} {uplevel [expr .2] {}}} } -returnCodes error -result {bad level "0.2"} test uplevel-4.36 {level parsing} -body { apply {{} {uplevel #[expr .2] {}}} } -returnCodes error -result {bad level "#0.2"} proc a2 {} { uplevel a3 } proc a3 {} { global x y set x [info level] set y [info level 1] } a2 test uplevel-5.1 {info level} {set x} 1 test uplevel-5.2 {info level} {set y} a3 namespace eval ns1 { proc set args {return ::ns1} } proc a2 {} { uplevel {set x ::} } test uplevel-6.1 {uplevel and shadowed cmds} { set res [namespace eval ns1 a2] lappend res [namespace eval ns2 a2] lappend res [namespace eval ns1 a2] namespace eval ns1 {rename set {}} lappend res [namespace eval ns1 a2] } {::ns1 :: ::ns1 ::} # # These tests verify that upleveled scripts run in the correct level and access # the proper variables. # test uplevel-7.1 {var access, no LVT in either level} -setup { set x 1 unset -nocomplain y z } -body { namespace eval foo { set x 2 set y 2 uplevel 1 { set x 3 set y 3 set z 3 } } list $x $y $z } -cleanup { namespace delete foo unset -nocomplain x y z } -result {3 3 3} test uplevel-7.2 {var access, no LVT in upper level} -setup { set x 1 unset -nocomplain y z } -body { proc foo {} { set x 2 set y 2 uplevel 1 { set x 3 set y 3 set z 3 } } foo list $x $y $z } -cleanup { rename foo {} unset -nocomplain x y z } -result {3 3 3} test uplevel-7.3 {var access, LVT in upper level} -setup { proc moo {} { set x 1; #var in LVT unset -nocomplain y z foo list $x $y $z } } -body { proc foo {} { set x 2 set y 2 uplevel 1 { set x 3 set y 3 set z 3 } } foo moo } -cleanup { rename foo {} rename moo {} } -result {3 3 3} test uplevel-8.0 { string representation isn't generated when there is only one argument } -body { set res {} set script [list lindex 5] lappend res [apply {script { uplevel $script }} $script] lappend res [string match {value is a list *no string representation*} [ ::tcl::unsupported::representation $script]] } -cleanup { unset script unset res } -result {5 1} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/upvar.test0000644000175000017500000003625514554262142015055 0ustar sergeisergei# Commands covered: 'upvar', 'namespace upvar' # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testupvar [llength [info commands testupvar]] test upvar-1.1 {reading variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a} p1 foo bar } {foo bar 22 33 abc} test upvar-1.2 {reading variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {p3} proc p3 {} {upvar 2 a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a} p1 foo bar } {foo bar 22 33 abc} test upvar-1.3 {reading variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {p3} proc p3 {} { upvar #1 a x1 b x2 c x3 d x4 set a abc list $x1 $x2 $x3 $x4 $a } p1 foo bar } {foo bar 22 33 abc} test upvar-1.4 {reading variables with upvar} { set x1 44 set x2 55 proc p1 {} {p2} proc p2 {} { upvar 2 x1 x1 x2 a upvar #0 x1 b set c $b incr b 3 list $x1 $a $b } p1 } {47 55 47} test upvar-1.5 {reading array elements with upvar} { proc p1 {} {set a(0) zeroth; set a(1) first; p2} proc p2 {} {upvar a(0) x; set x} p1 } {zeroth} test upvar-2.1 {writing variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d} proc p2 {} { upvar a x1 b x2 c x3 d x4 set x1 14 set x4 88 } p1 foo bar } {14 bar 22 88} test upvar-2.2 {writing variables with upvar} { set x1 44 set x2 55 proc p1 {x1 x2} { upvar #0 x1 a upvar x2 b set a $x1 set b $x2 } p1 newbits morebits list $x1 $x2 } {newbits morebits} test upvar-2.3 {writing variables with upvar} { catch {unset x1} catch {unset x2} proc p1 {x1 x2} { upvar #0 x1 a upvar x2 b set a $x1 set b $x2 } p1 newbits morebits list [catch {set x1} msg] $msg [catch {set x2} msg] $msg } {0 newbits 0 morebits} test upvar-2.4 {writing array elements with upvar} { proc p1 {} {set a(0) zeroth; set a(1) first; list [p2] $a(0)} proc p2 {} {upvar a(0) x; set x xyzzy} p1 } {xyzzy xyzzy} test upvar-3.1 {unsetting variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]} proc p2 {} { upvar 1 a x1 d x2 unset x1 x2 } p1 foo bar } {b c} test upvar-3.2 {unsetting variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]} proc p2 {} { upvar 1 a x1 d x2 unset x1 x2 set x2 28 } p1 foo bar } {b c d} test upvar-3.3 {unsetting variables with upvar} { set x1 44 set x2 55 proc p1 {} {p2} proc p2 {} { upvar 2 x1 a upvar #0 x2 b unset a b } p1 list [info exists x1] [info exists x2] } {0 0} test upvar-3.4 {unsetting variables with upvar} { set x1 44 set x2 55 proc p1 {} { upvar x1 a x2 b unset a b set b 118 } p1 list [info exists x1] [catch {set x2} msg] $msg } {0 0 118} test upvar-3.5 {unsetting array elements with upvar} { proc p1 {} { set a(0) zeroth set a(1) first set a(2) second p2 array names a } proc p2 {} {upvar a(0) x; unset x} lsort [p1] } {1 2} test upvar-3.6 {unsetting then resetting array elements with upvar} { proc p1 {} { set a(0) zeroth set a(1) first set a(2) second p2 list [lsort [array names a]] [catch {set a(0)} msg] $msg } proc p2 {} {upvar a(0) x; unset x; set x 12345} p1 } {{0 1 2} 0 12345} test upvar-4.1 {nested upvars} { set x1 88 proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {global x1; upvar c x2; p3} proc p3 {} { upvar x1 a x2 b list $a $b } p1 14 15 } {88 22} test upvar-4.2 {nested upvars} { set x1 88 proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d} proc p2 {} {global x1; upvar c x2; p3} proc p3 {} { upvar x1 a x2 b set a foo set b bar } list [p1 14 15] $x1 } {{14 15 bar 33} foo} proc tproc {args} {global x; set x [list $args [uplevel info vars]]} test upvar-5.1 {traces involving upvars} { proc p1 {a b} {set c 22; set d 33; trace add var c {read write} tproc; p2} proc p2 {} {upvar c x1; set x1 22} set x --- p1 foo bar set x } {{x1 {} write} x1} test upvar-5.2 {traces involving upvars} { proc p1 {a b} {set c 22; set d 33; trace add var c {read write} tproc; p2} proc p2 {} {upvar c x1; set x1} set x --- p1 foo bar set x } {{x1 {} read} x1} test upvar-5.3 {traces involving upvars} { proc p1 {a b} {set c 22; set d 33; trace add var c {read write unset} tproc; p2} proc p2 {} {upvar c x1; unset x1} set x --- p1 foo bar set x } {{x1 {} unset} x1} test upvar-6.1 {retargeting an upvar} { proc p1 {} { set a(0) zeroth set a(1) first set a(2) second p2 } proc p2 {} { upvar a x set result {} foreach i [array names x] { upvar a($i) x lappend result $x } lsort $result } p1 } {first second zeroth} test upvar-6.2 {retargeting an upvar} { set x 44 set y abcde proc p1 {} { global x set result $x upvar y x lappend result $x } p1 } {44 abcde} test upvar-6.3 {retargeting an upvar} { set x 44 set y abcde proc p1 {} { upvar y x lappend result $x global x lappend result $x } p1 } {abcde 44} test upvar-7.1 {upvar to same level} { set x 44 set y 55 catch {unset uv} upvar #0 x uv set uv abc upvar 0 y uv set uv xyzzy list $x $y } {abc xyzzy} test upvar-7.2 {upvar to same level} { set x 1234 set y 4567 proc p1 {x y} { upvar 0 x uv set uv $y return "$x $y" } p1 44 89 } {89 89} test upvar-7.3 {upvar to same level} { set x 1234 set y 4567 proc p1 {x y} { upvar #1 x uv set uv $y return "$x $y" } p1 xyz abc } {abc abc} test upvar-7.4 {upvar to same level: tricky problems when deleting variable table} { proc tt {} {upvar #1 toto loc; return $loc} list [catch tt msg] $msg } {1 {can't read "loc": no such variable}} test upvar-7.5 {potential memory leak when deleting variable table} { proc leak {} { array set foo {1 2 3 4} upvar 0 foo(1) bar } leak } {} test upvar-8.1 {errors in upvar command} -returnCodes error -body { upvar } -result {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"} test upvar-8.2 {errors in upvar command} -returnCodes error -body { upvar 1 } -result {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"} test upvar-8.2.1 {upvar with numeric first argument} { apply {{} {set 0 ok; apply {{} {upvar 0 x; return $x}}}} } ok test upvar-8.3 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar a b c} p1 } -result {bad level "a"} test upvar-8.3.1 {bad level for upvar (upvar at top-level, bug [775ee88560])} -body { proc p1 {} { uplevel { upvar b b; lappend b UNEXPECTED } } uplevel #0 { p1 } } -returnCodes error -result {bad level "1"} test upvar-8.3.2 {bad level for upvar (upvar at top-level, bug [775ee88560])} -setup { interp create i } -body { i eval { upvar b b; lappend b UNEXPECTED } } -returnCodes error -result {bad level "1"} -cleanup { interp delete i } test upvar-8.4 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar 0 b b} p1 } -result {can't upvar from variable to itself} test upvar-8.5 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar 0 a b; upvar 0 b a} p1 } -result {can't upvar from variable to itself} test upvar-8.6 {errors in upvar command} -returnCodes error -body { proc p1 {} {set a 33; upvar b a} p1 } -result {variable "a" already exists} test upvar-8.7 {errors in upvar command} -returnCodes error -body { proc p1 {} {trace add variable a write foo; upvar b a} p1 } -result {variable "a" has traces: can't use for upvar} test upvar-8.8 {create nested array with upvar} -body { proc p1 {} {upvar x(a) b; set b(2) 44} catch {unset x} p1 } -returnCodes error -cleanup { unset x } -result {can't set "b(2)": variable isn't array} test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename MakeLink ""} namespace eval ::test_ns_1 {} } -returnCodes error -body { proc MakeLink {a} { namespace eval ::test_ns_1 { upvar a a } unset ::test_ns_1::a } MakeLink 1 } -result {bad variable name "a": can't create namespace variable that refers to procedure variable} test upvar-8.10 {upvar will create element alias for new array element} -setup { catch {unset upvarArray} } -body { array set upvarArray {} catch {upvar 0 upvarArray(elem) upvarArrayElemAlias} } -result {0} test upvar-8.11 {upvar will not create a variable that looks like an array} -setup { catch {unset upvarArray} } -body { array set upvarArray {} upvar 0 upvarArray(elem) upvarArrayElemAlias(elem) } -returnCodes 1 -match glob -result * test upvar-9.1 {Tcl_UpVar2 procedure} testupvar { list [catch {testupvar xyz a {} x global} msg] $msg } {1 {bad level "1"}} test upvar-9.1.1 {TclGetFrame, via Tcl_UpVar2} testupvar { apply {{} {testupvar xyz a {} x local; set x foo}} set a } foo test upvar-9.2 {Tcl_UpVar2 procedure} testupvar { catch {unset a} catch {unset x} set a 44 list [catch "testupvar #0 a 1 x global" msg] $msg } {1 {can't access "a(1)": variable isn't array}} test upvar-9.3 {Tcl_UpVar2 procedure} testupvar { proc foo {} { testupvar 1 a {} x local set x } catch {unset a} catch {unset x} set a 44 foo } {44} test upvar-9.4 {Tcl_UpVar2 procedure} testupvar { proc foo {} { testupvar 1 a {} _up_ global list [catch {set x} msg] $msg } catch {unset a} catch {unset _up_} set a 44 concat [foo] $_up_ } {1 {can't read "x": no such variable} 44} test upvar-9.5 {Tcl_UpVar2 procedure} testupvar { proc foo {} { testupvar 1 a b x local set x } catch {unset a} catch {unset x} set a(b) 1234 foo } {1234} test upvar-9.6 {Tcl_UpVar procedure} testupvar { proc foo {} { testupvar 1 a x local set x } catch {unset a} catch {unset x} set a xyzzy foo } {xyzzy} test upvar-9.7 {Tcl_UpVar procedure} testupvar { proc foo {} { testupvar #0 a(b) x local set x } catch {unset a} catch {unset x} set a(b) 1234 foo } {1234} catch {unset a} test upvar-10.1 {CompileWord OBOE} -setup { proc linenumber {} {dict get [info frame -1] line} } -body { apply {n { upvar 1 {*}{ } [return [incr n -[linenumber]]] x }} [linenumber] } -cleanup { rename linenumber {} } -result 1 # # Tests for 'namespace upvar'. As the implementation is essentially the same as # for 'upvar', we only test that the variables are linked correctly, i.e., we # assume that the behaviour of variables once the link is established has # already been tested above. # # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_0 { variable x test_ns_0 } set ::x test_global test upvar-NS-1.1 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { namespace upvar ::test_ns_0 x w set w } } -result {test_ns_0} -cleanup { namespace delete test_ns_1 } test upvar-NS-1.2 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { proc a {} { namespace upvar ::test_ns_0 x w set w } return [a] } } -result {test_ns_0} -cleanup { namespace delete test_ns_1 } test upvar-NS-1.3 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { namespace upvar test_ns_0 x w set w } } -returnCodes error -cleanup { namespace delete test_ns_1 } -result {namespace "test_ns_0" not found in "::test_ns_1"} test upvar-NS-1.4 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { proc a {} { namespace upvar test_ns_0 x w set w } return [a] } } -returnCodes error -cleanup { namespace delete test_ns_1 } -result {namespace "test_ns_0" not found in "::test_ns_1"} test upvar-NS-1.5 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { namespace eval test_ns_0 {} namespace upvar test_ns_0 x w set w } } -cleanup { namespace delete test_ns_1 } -result {can't read "w": no such variable} -returnCodes error test upvar-NS-1.6 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { namespace eval test_ns_0 {} proc a {} { namespace upvar test_ns_0 x w set w } return [a] } } -cleanup { namespace delete test_ns_1 } -result {can't read "w": no such variable} -returnCodes error test upvar-NS-1.7 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { namespace eval test_ns_0 { variable x test_ns_1::test_ns_0 } namespace upvar test_ns_0 x w set w } } -cleanup { namespace delete test_ns_1 } -result {test_ns_1::test_ns_0} test upvar-NS-1.8 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { namespace eval test_ns_0 { variable x test_ns_1::test_ns_0 } proc a {} { namespace upvar test_ns_0 x w set w } return [a] } } -cleanup { namespace delete test_ns_1 } -result {test_ns_1::test_ns_0} test upvar-NS-1.9 {nsupvar links to correct variable} -body { namespace eval test_ns_1 { variable x test_ns_1 proc a {} { namespace upvar test_ns_0 x w set w } return [a] } } -returnCodes error -cleanup { namespace delete test_ns_1 } -result {namespace "test_ns_0" not found in "::test_ns_1"} test upvar-NS-2.1 {TIP 323} -returnCodes error -body { namespace upvar } -result {wrong # args: should be "namespace upvar ns ?otherVar myVar ...?"} test upvar-NS-2.2 {TIP 323} -setup { namespace eval test_ns_1 {} } -body { namespace upvar test_ns_1 } -cleanup { namespace delete test_ns_1 } -result {} test upvar-NS-3.1 {CompileWord OBOE} -setup { proc linenumber {} {dict get [info frame -1] line} } -body { apply {n { namespace upvar {*}{ } [return [incr n -[linenumber]]] x y }} [linenumber] } -cleanup { rename linenumber {} } -result 1 test upvar-NS-3.2 {CompileWord OBOE} -setup { proc linenumber {} {dict get [info frame -1] line} } -body { apply {n { namespace upvar :: {*}{ } [return [incr n -[linenumber]]] x }} [linenumber] } -cleanup { rename linenumber {} } -result 1 test upvar-NS-3.3 {CompileWord OBOE} -setup { proc linenumber {} {dict get [info frame -1] line} } -body { apply {n { variable x {*}{ } [return [incr n -[linenumber]]] }} [linenumber] } -cleanup { rename linenumber {} } -result 1 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/utf.test0000644000175000017500000015402114554262142014506 0ustar sergeisergei# This file contains a collection of tests for tclUtf.c # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}] testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] testConstraint utf16 [expr {[string length [format %c 0x10000]] == 2}] testConstraint utf32 [expr {[testConstraint fullutf] && [string length [format %c 0x10000]] == 1}] testConstraint Uesc [expr {"\U0041" eq "A"}] testConstraint pre388 [expr {"\x741" eq "A"}] testConstraint pairsTo4bytes [expr {[llength [info commands teststringbytes]] && [string length [teststringbytes \uD83D\uDCA9]] == 4}] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testfindfirst [llength [info commands testfindfirst]] testConstraint testfindlast [llength [info commands testfindlast]] testConstraint testnumutfchars [llength [info commands testnumutfchars]] testConstraint teststringobj [llength [info commands teststringobj]] testConstraint testutfnext [llength [info commands testutfnext]] testConstraint testutfprev [llength [info commands testutfprev]] testConstraint testgetunichar [llength [info commands testgetunichar]] testConstraint tip413 [expr {[string trim \x00] eq {}}] catch {unset x} test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring { expr {"\x01" eq [testbytestring \x01]} } 1 test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { expr {"\x00" eq [testbytestring \xC0\x80]} } 1 test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { expr {"\xE0" eq [testbytestring \xC3\xA0]} } 1 test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring { expr {"\u4E4E" eq [testbytestring \xE4\xB9\x8E]} } 1 test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring { expr {[format %c 0x110000] eq [testbytestring \xEF\xBF\xBD]} } 1 test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring { expr {[format %c -1] eq [testbytestring \xEF\xBF\xBD]} } 1 test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf testbytestring} { expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]} } 1 test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {Uesc ucs2 testbytestring} { expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]} } 0 test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { expr {"\uD842" eq [testbytestring \xED\xA1\x82]} } 1 test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { expr {"\uDC42" eq [testbytestring \xED\xB1\x82]} } 1 test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { expr {[format %c 0xD842] eq [testbytestring \xED\xA1\x82]} } 1 test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { expr {[format %c 0xDC42] eq [testbytestring \xED\xB1\x82]} } 1 test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4bytes testbytestring} { expr {"\uD842\uDC42" eq [testbytestring \xF0\xA0\xA1\x82]} } 1 test utf-1.13.0 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc ucs2} { expr {"\UD842" eq "\uD842"} } 1 test utf-1.13.1 {Tcl_UniCharToUtf: Invalid surrogate} {fullutf testbytestring} { expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]} } 1 test utf-2.1 {Tcl_UtfToUniChar: low ascii} { string length "abc" } 3 test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring { string length [testbytestring \x82\x83\x84] } 3 test utf-2.3 {Tcl_UtfToUniChar: lead (2-byte) followed by non-trail} testbytestring { string length [testbytestring \xC2] } 1 test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} { string length \xA2 } 1 test utf-2.5 {Tcl_UtfToUniChar: lead (3-byte) followed by non-trail} testbytestring { string length [testbytestring \xE2] } 1 test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestring { string length [testbytestring \xE2\xA2] } 2 test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring { string length [testbytestring \xE4\xB9\x8E] } 1 test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} { string length [testbytestring \xF0\x90\x80\x80] } 2 test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 { string length \U010000 } 2 test utf-2.8.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf32 { string length \U010000 } 1 test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} { string length [testbytestring \xF4\x8F\xBF\xBF] } 2 test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 { string length \U10FFFF } 2 test utf-2.9.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf32 { string length \U10FFFF } 1 test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring { string length [testbytestring \xF0\x8F\xBF\xBF] } 4 test utf-2.11 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, overflow} testbytestring { # Would decode to U+110000 but that is outside the Unicode range. string length [testbytestring \xF4\x90\x80\x80] } 4 test utf-2.12 {Tcl_UtfToUniChar: longer UTF sequences not supported} testbytestring { string length [testbytestring \xF8\xA2\xA2\xA2\xA2] } 5 test utf-3.1 {Tcl_UtfCharComplete} { } {} test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars { testnumutfchars "" } 0 test utf-4.2 {Tcl_NumUtfChars: length 1} testnumutfchars { testnumutfchars \xA2 } 1 test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} { testnumutfchars abc\xA2[testbytestring \xE4\xB9\x8E\xA2\x4E] } 7 test utf-4.4 {Tcl_NumUtfChars: #x00} testnumutfchars { testnumutfchars \x00 } 1 test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars { testnumutfchars "" 0 } 0 test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} { testnumutfchars \xA2 end } 1 test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} { testnumutfchars abc\xA2[testbytestring \xE4\xB9\x8E\xA2\x4E] end } 7 test utf-4.8 {Tcl_NumUtfChars: #x00, calc len} testnumutfchars { testnumutfchars \x00 end } 1 # Bug [2738427]: Tcl_NumUtfChars(...) no overflow check test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} { testnumutfchars [testbytestring \xE2\x82\xAC] end-1 } 2 test utf-4.10 {Tcl_NumUtfChars: #x00, calc len, overcomplete} {testnumutfchars testbytestring} { testnumutfchars [testbytestring \x00] end+1 } 2 test utf-4.11 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end-1 } 3 test utf-4.12.0 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs2} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end } 2 test utf-4.12.1 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring utf32} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end } 1 test utf-4.13 {Tcl_NumUtfChars: end of string} {testnumutfchars testbytestring} { testnumutfchars foobar[testbytestring \xF2\xC2\xA0] end } 8 test utf-4.14 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} { testnumutfchars [testbytestring \xF4\x90\x80\x80] end-1 } 3 test utf-5.1 {Tcl_UtfFindFirst} {testfindfirst testbytestring} { testfindfirst [testbytestring abcbc] 98 } bcbc test utf-5.2 {Tcl_UtfFindLast} {testfindlast testbytestring} { testfindlast [testbytestring abcbc] 98 } bc test utf-6.1 {Tcl_UtfNext} {testutfnext testbytestring} { # This takes the pointer one past the terminating NUL. # This is really an invalid call. testutfnext [testbytestring \x00] } 1 test utf-6.2 {Tcl_UtfNext} testutfnext { testutfnext A } 1 test utf-6.3 {Tcl_UtfNext} testutfnext { testutfnext AA } 1 test utf-6.4 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring A\xA0] } 1 test utf-6.5 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext A[testbytestring \xD0] } 1 test utf-6.6 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext A[testbytestring \xE8] } 1 test utf-6.7 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext A[testbytestring \xF2] } 1 test utf-6.8 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext A[testbytestring \xF8] } 1 test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\x00] } 1 test utf-6.10 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0]G } 1 test utf-6.11.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\x00] } 1 test utf-6.11.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\x00] } 2 test utf-6.12 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xD0] } 1 test utf-6.13 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xE8] } 1 test utf-6.14 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xF2] } 1 test utf-6.15 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xF8] } 1 test utf-6.16 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\x00] } 1 test utf-6.17 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0]G } 1 test utf-6.18 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0] } 2 test utf-6.19 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xD0] } 1 test utf-6.20 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xE8] } 1 test utf-6.21 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xF2] } 1 test utf-6.22 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xF8] } 1 test utf-6.23 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\x00] } 1 test utf-6.24 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8]G } 1 test utf-6.25 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0\x00] } 1 test utf-6.26 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xD0] } 1 test utf-6.27 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xE8] } 1 test utf-6.28 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xF2] } 1 test utf-6.29 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xF8] } 1 test utf-6.30.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2] } 1 test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\x00] } 1 test utf-6.31 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2]G } 1 test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0] } 1 test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\x00] } 1 test utf-6.33 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xD0] } 1 test utf-6.34 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xE8] } 1 test utf-6.35 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xF2] } 1 test utf-6.36 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xF8] } 1 test utf-6.37 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF8] } 1 test utf-6.38 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF8]G } 1 test utf-6.39 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF8\xA0] } 1 test utf-6.40 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF8\xD0] } 1 test utf-6.41 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF8\xE8] } 1 test utf-6.42 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF8\xF2] } 1 test utf-6.43 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF8\xF8] } 1 test utf-6.44 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0]G } 2 test utf-6.45 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0\xA0] } 2 test utf-6.46 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0\xD0] } 2 test utf-6.47 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0\xE8] } 2 test utf-6.48 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0\xF2] } 2 test utf-6.49 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0\xF8] } 2 test utf-6.50 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0]G } 1 test utf-6.51 {Tcl_UtfNext} testutfnext { testutfnext \u8820 } 3 test utf-6.52 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0\xD0] } 1 test utf-6.53 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0\xE8] } 1 test utf-6.54 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0\xF2] } 1 test utf-6.55 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0\xF8] } 1 test utf-6.56 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0]G } 1 test utf-6.57 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\x00] } 1 test utf-6.58 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xD0] } 1 test utf-6.59 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xE8] } 1 test utf-6.60 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xF2] } 1 test utf-6.61 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xF8] } 1 test utf-6.62 {Tcl_UtfNext} testutfnext { testutfnext \u8820G } 3 test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0\xA0\xA0] } 3 test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext \u8820[testbytestring \xD0] } 3 test utf-6.65 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext \u8820[testbytestring \xE8] } 3 test utf-6.66 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext \u8820[testbytestring \xF2] } 3 test utf-6.67 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext \u8820[testbytestring \xF8] } 3 test utf-6.68 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0]G } 1 test utf-6.69.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0] } 1 test utf-6.69.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0] } 4 test utf-6.70 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xD0] } 1 test utf-6.71 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xE8] } 1 test utf-6.72 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xF2] } 1 test utf-6.73 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xF8] } 1 test utf-6.74.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G } 1 test utf-6.74.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G } 4 test utf-6.75.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] } 1 test utf-6.75.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] } 4 test utf-6.76.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0] } 1 test utf-6.76.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0] } 4 test utf-6.77.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8] } 1 test utf-6.77.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8] } 4 test utf-6.78.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2] } 1 test utf-6.78.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2] } 4 test utf-6.79.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8] } 1 test utf-6.79.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8] } 4 test utf-6.80 {Tcl_UtfNext - overlong sequences} testutfnext { testutfnext \x00 } 2 test utf-6.81 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xC0\x81] } 1 test utf-6.82 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xC1\x80] } 1 test utf-6.83 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xC2\x80] } 2 test utf-6.84 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xE0\x80\x80] } 1 test utf-6.85 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xE0\xA0\x80] } 3 test utf-6.86 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xF0\x80\x80\x80] } 1 test utf-6.87.0 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF0\x90\x80\x80] } 1 test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF0\x90\x80\x80] } 4 test utf-6.88.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\x00] } 1 test utf-6.88.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\x00] } 2 test utf-6.89.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \x80\x80\x00] } 1 test utf-6.89.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \x80\x80\x00] } 2 test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF4\x8F\xBF\xBF] } 1 test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF4\x8F\xBF\xBF] } 4 test utf-6.91 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring} { testutfnext [testbytestring \xF4\x90\x80\x80] } 1 test utf-6.92.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\xA0] } 1 test utf-6.92.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\xA0] } 3 test utf-6.93.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \x80\x80\x80] } 1 test utf-6.93.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \x80\x80\x80] } 3 test utf-6.94.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\xA0\xA0] } 1 test utf-6.94.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\xA0\xA0] } 3 test utf-6.95.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \x80\x80\x80\x80] } 1 test utf-6.95.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \x80\x80\x80\x80] } 3 test utf-6.96 {Tcl_UtfNext, read limits} testutfnext { testutfnext G 0 } 0 test utf-6.97 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xA0] 0 } 0 test utf-6.98 {Tcl_UtfNext, read limits} testutfnext { testutfnext AG 1 } 1 test utf-6.99 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext A[testbytestring \xA0] 1 } 1 test utf-6.100 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0]G 1 } 0 test utf-6.101 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0]G 2 } 2 test utf-6.102 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0\xA0] 1 } 0 test utf-6.103 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xA0\xA0] 2 } 2 test utf-6.104 {Tcl_UtfNext, read limits} testutfnext { testutfnext \u8820G 1 } 0 test utf-6.105 {Tcl_UtfNext, read limits} testutfnext { testutfnext \u8820G 2 } 0 test utf-6.106 {Tcl_UtfNext, read limits} testutfnext { testutfnext \u8820G 3 } 3 test utf-6.107 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext \u8820[testbytestring \xA0] 1 } 0 test utf-6.108 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext \u8820[testbytestring \xA0] 2 } 0 test utf-6.109 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext \u8820[testbytestring \xA0] 3 } 3 # This testcase actually tests Tcl_UtfCharComplete, not Tcl_UtfNext test utf-6.110 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 1 } 0 # This testcase actually tests Tcl_UtfCharComplete, not Tcl_UtfNext test utf-6.111 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 2 } 0 test utf-6.112.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 3 } 1 test utf-6.112.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 3 } 0 test utf-6.113.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 4 } 1 test utf-6.113.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 4 } 4 # This testcase actually tests Tcl_UtfCharComplete, not Tcl_UtfNext test utf-6.114 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 1 } 0 # This testcase actually tests Tcl_UtfCharComplete, not Tcl_UtfNext test utf-6.115 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 2 } 0 test utf-6.116.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 3 } 1 test utf-6.116.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 3 } 0 test utf-6.117.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 4 } 1 test utf-6.117.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 4 } 4 test utf-6.118 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xA0]G 0 } 0 test utf-6.119 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xA0]G 1 } 0 test utf-6.120 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xA0] 1 } 0 test utf-6.121 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xA0]G 2 } 0 test utf-6.122 {Tcl_UtfNext, read limits} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xA0\xA0] 2 } 0 test utf-6.123.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\xA0]G 3 } 1 test utf-6.123.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\xA0]G 3 } 3 test utf-6.124.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\xA0\xA0] 3 } 1 test utf-6.124.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\xA0\xA0] 3 } 3 test utf-6.125.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\xA0\xA0]G 4 } 1 test utf-6.125.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\xA0\xA0]G 4 } 3 test utf-6.126.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\xA0\xA0\xA0] 4 } 1 test utf-6.126.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\xA0\xA0\xA0] 4 } 3 test utf-7.1 {Tcl_UtfPrev} testutfprev { testutfprev {} } 0 test utf-7.2 {Tcl_UtfPrev} testutfprev { testutfprev A } 0 test utf-7.3 {Tcl_UtfPrev} testutfprev { testutfprev AA } 1 test utf-7.4 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8] } 1 test utf-7.4.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 2 } 1 test utf-7.4.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xF8\xA0\xA0] 2 } 1 test utf-7.5 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF2] } 1 test utf-7.5.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 2 } 1 test utf-7.5.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF2\xF8\xA0\xA0] 2 } 1 test utf-7.6 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8] } 1 test utf-7.6.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 2 } 1 test utf-7.6.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xF8\xA0\xA0] 2 } 1 test utf-7.7 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0] } 1 test utf-7.7.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 2 } 1 test utf-7.7.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xF8\xA0\xA0] 2 } 1 test utf-7.8 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0] } 1 test utf-7.8.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 2 } 1 test utf-7.8.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xF8\xA0\xA0] 2 } 1 test utf-7.9 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0] } 2 test utf-7.9.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 3 } 2 test utf-7.9.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xF8\xA0] 3 } 2 test utf-7.10.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF2\xA0] } 2 test utf-7.10.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF2\xA0] } 1 test utf-7.10.2 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 3 } 2 test utf-7.10.3 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 3 } 1 test utf-7.10.4 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3 } 2 test utf-7.10.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3 } 1 test utf-7.11 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0] } 1 test utf-7.11.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 3 } 1 test utf-7.11.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0\xF8\xA0] 3 } 1 test utf-7.11.3 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0\xF8] 3 } 1 test utf-7.12 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0] } 1 test utf-7.12.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 3 } 1 test utf-7.12.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xF8\xA0] 3 } 1 test utf-7.13 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xA0] } 2 test utf-7.13.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 3 } 2 test utf-7.13.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xA0\xF8\xA0] 3 } 2 test utf-7.14 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xA0] } 3 test utf-7.14.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 4 } 3 test utf-7.14.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xA0\xF8] 4 } 3 test utf-7.15.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF2\xA0\xA0] } 3 test utf-7.15.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF2\xA0\xA0] } 1 test utf-7.15.2 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 4 } 3 test utf-7.15.3 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 4 } 1 test utf-7.15.4 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4 } 3 test utf-7.15.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4 } 1 test utf-7.16 {Tcl_UtfPrev} testutfprev { testutfprev A\u8820 } 1 test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 4 } 1 test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A\u8820[testbytestring \xF8] 4 } 1 test utf-7.17 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xA0] } 3 test utf-7.17.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 4 } 3 test utf-7.17.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xA0\xF8] 4 } 3 test utf-7.18.0 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xA0\xA0] } 3 test utf-7.18.1 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 4 } 3 test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xA0\xA0\xF8] 4 } 3 test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xF8\xA0\xA0\xA0] } 4 test utf-7.20.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { testutfprev [testbytestring A\xF2\xA0\xA0\xA0] } 4 test utf-7.20.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev [testbytestring A\xF2\xA0\xA0\xA0] } 1 test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0\xA0\xA0] } 4 test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xA0\xA0] } 4 test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev [testbytestring A\xA0\xA0\xA0\xA0] } 4 test utf-7.24 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xC0\x81] } 2 test utf-7.25 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xC0\x81] 2 } 1 test utf-7.26 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\x80\x80] } 3 test utf-7.27 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\x80] } 2 test utf-7.27.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\x80\x80] 3 } 2 test utf-7.28 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0] } 1 test utf-7.28.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\x80\x80] 2 } 1 test utf-7.29 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xF0\x80\x80\x80] } 4 test utf-7.30 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xF0\x80\x80\x80] 4 } 3 test utf-7.31 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xF0\x80\x80\x80] 3 } 2 test utf-7.32 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xF0\x80\x80\x80] 2 } 1 test utf-7.33 {Tcl_UtfPrev -- overlong sequence} testutfprev { testutfprev A\x00 } 1 test utf-7.34 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xC1\x80] } 2 test utf-7.35 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xC2\x80] } 1 test utf-7.36 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] } 1 test utf-7.37 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] 3 } 1 test utf-7.38 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] 2 } 1 test utf-7.39.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF0\x90\x80\x80] } 4 test utf-7.39.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF0\x90\x80\x80] } 1 test utf-7.40.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF0\x90\x80\x80] 4 } 3 test utf-7.40.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF0\x90\x80\x80] 4 } 1 test utf-7.41.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF0\x90\x80\x80] 3 } 2 test utf-7.41.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF0\x90\x80\x80] 3 } 1 test utf-7.42 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xF0\x90\x80\x80] 2 } 1 test utf-7.43 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { testutfprev [testbytestring \xA0] } 0 test utf-7.44 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { testutfprev [testbytestring \xA0\xA0] } 1 test utf-7.45 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { testutfprev [testbytestring \xA0\xA0\xA0] } 2 test utf-7.46 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { testutfprev [testbytestring \xA0\xA0\xA0\xA0] } 3 test utf-7.47 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} {testutfprev testbytestring} { testutfprev [testbytestring \xE8\xA0] } 0 test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} testutfprev { testutfprev \u8820 2 } 0 test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} { testutfprev [testbytestring \xE8\xA0\x00] 2 } 0 test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] } 4 test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] } 1 test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 } 3 test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 } 1 test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 } 2 test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 } 1 test utf-7.48.6 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 2 } 1 test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x90\x80\x80] } 4 test utf-7.49.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x90\x80\x80] 4 } 3 test utf-7.49.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x90\x80\x80] 3 } 2 test utf-7.49.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x90\x80\x80] 2 } 1 test utf-8.1 {Tcl_UniCharAtIndex: index = 0} { string index abcd 0 } a test utf-8.2 {Tcl_UniCharAtIndex: index = 0} { string index \u4E4E\u25A 0 } \u4E4E test utf-8.3 {Tcl_UniCharAtIndex: index > 0} { string index abcd 2 } c test utf-8.4 {Tcl_UniCharAtIndex: index > 0} { string index \u4E4E\u25A\xFF\u543 2 } \xFF test utf-8.5.0 {Tcl_UniCharAtIndex: high surrogate} ucs2 { string index \uD842 0 } \uD842 test utf-8.5.1 {Tcl_UniCharAtIndex: high surrogate} utf32 { string index \uD842 0 } \uD842 test utf-8.5.2 {Tcl_UniCharAtIndex: high surrogate} utf16 { string index \uD842 0 } \uD842 test utf-8.6 {Tcl_UniCharAtIndex: low surrogate} { string index \uDC42 0 } \uDC42 test utf-8.7.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { string index \uD83D\uDE00G 0 } \uD83D test utf-8.7.1 {Tcl_UniCharAtIndex: Emoji} utf32 { string index \U1F600G 0 } \U1F600 test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 { string index \U1F600G 0 } \U1F600 test utf-8.8.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { string index \uD83D\uDE00G 1 } \uDE00 test utf-8.8.1 {Tcl_UniCharAtIndex: Emoji} utf32 { string index \U1F600G 1 } G test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 { string index \U1F600G 1 } {} test utf-8.9.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { string index \uD83D\uDE00G 2 } G test utf-8.9.1 {Tcl_UniCharAtIndex: Emoji} utf32 { string index \U1F600G 2 } {} test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 { string index \U1F600G 2 } G test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { string index \U1F600G 0 } \uFFFD test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} utf32 { string index \U1F600G 0 } \U1F600 test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} utf16 { string index \U1F600G 0 } \U1F600 test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { string index \U1F600G 1 } G test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} utf32 { string index \U1F600G 1 } G test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} utf16 { string index \U1F600G 1 } {} test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { string index \U1F600G 2 } {} test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} utf32 { string index \U1F600G 2 } {} test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} utf16 { string index \U1F600G 2 } G test utf-9.1 {Tcl_UtfAtIndex: index = 0} { string range abcd 0 2 } abc test utf-9.2 {Tcl_UtfAtIndex: index > 0} { string range \u4E4E\u25A\xFF\u543klmnop 1 5 } \u25A\xFF\u543kl test utf-9.3.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 { string range \uD83D\uDE00G 0 0 } \uD83D test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} utf32 { string range \U1F600G 0 0 } \U1F600 test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 { string range \U1F600G 0 0 } \U1F600 test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { string range \uD83D\uDE00G 1 1 } \uDE00 test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} utf32 { string range \U1F600G 1 1 } G test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { string range \U1F600G 1 1 } {} test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { string range \uD83D\uDE00G 2 2 } G test utf-9.5.1 {Tcl_UtfAtIndex: index > 0, Emoji} utf32 { string range \U1F600G 2 2 } {} test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { string range \U1F600G 2 2 } G test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs2} { string range \U1F600G 0 0 } \uFFFD test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} utf32 { string range \U1F600G 0 0 } \U1F600 test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 { string range \U1F600G 0 0 } \U1F600 test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} { string range \U1F600G 1 1 } G test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} utf32 { string range \U1F600G 1 1 } G test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { string range \U1F600G 1 1 } {} test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} { string range \U1F600G 2 2 } {} test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} utf32 { string range \U1F600G 2 2 } {} test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { string range \U1F600G 2 2 } G test utf-10.1 {Tcl_UtfBackslash: dst == NULL} { set x \n } { } test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring { expr {"\uA2" eq [testbytestring \xC2\xA2]} } 1 test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring { expr {"\u4E21" eq [testbytestring \xE4\xB8\xA1]} } 1 test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring { expr {"\u4E2k" eq "[testbytestring \xD3\xA2]k"} } 1 test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring { expr {"\u4E216" eq "[testbytestring \xE4\xB8\xA1]6"} } 1 test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {fullutf testbytestring} { expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"} } 1 test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {fullutf testbytestring} { expr {"\U10E2165" eq "[testbytestring \xF4\x8E\x88\x96]5"} } 1 proc bsCheck {char num {constraints {}}} { global errNum test utf-10.$errNum {backslash substitution} $constraints { scan $char %c value set value } $num incr errNum } set errNum 8 bsCheck \b 8 bsCheck \e 101 bsCheck \f 12 bsCheck \n 10 bsCheck \r 13 bsCheck \t 9 bsCheck \v 11 bsCheck \{ 123 bsCheck \} 125 bsCheck \[ 91 bsCheck \] 93 bsCheck \$ 36 bsCheck \ 32 bsCheck \; 59 bsCheck \\ 92 bsCheck \Ca 67 bsCheck \Ma 77 bsCheck \CMa 67 # prior to 8.3, this returned 8, as \8 as accepted as an # octal value - but it isn't! [Bug: 3975] bsCheck \8a 56 bsCheck \14 12 bsCheck \141 97 bsCheck b\0 98 bsCheck \x 120 bsCheck \xa 10 bsCheck \xA 10 bsCheck \x41 65 bsCheck \x541 65 pre388 ;# == \x41 bsCheck \x541 84 !pre388 ;# == \x54 1 bsCheck \u 117 bsCheck \uk 117 bsCheck \u41 65 bsCheck \ua 10 bsCheck \uA 10 bsCheck \340 224 bsCheck \uA1 161 bsCheck \u4E21 20001 bsCheck \741 225 pre388 ;# == \341 bsCheck \741 60 !pre388 ;# == \74 1 bsCheck \U 85 bsCheck \Uk 85 bsCheck \U41 65 Uesc bsCheck \Ua 10 Uesc bsCheck \UA 10 Uesc bsCheck \UA1 161 Uesc bsCheck \U4E21 20001 Uesc bsCheck \U004E21 20001 Uesc bsCheck \U00004E21 20001 Uesc bsCheck \U0000004E21 78 Uesc bsCheck \U00110000 69632 fullutf bsCheck \U01100000 69632 fullutf bsCheck \U11000000 69632 fullutf bsCheck \U0010FFFF 1114111 fullutf bsCheck \U010FFFF0 1114111 fullutf bsCheck \U10FFFF00 1114111 fullutf bsCheck \UFFFFFFFF 1048575 fullutf test utf-11.1 {Tcl_UtfToUpper} { string toupper {} } {} test utf-11.2 {Tcl_UtfToUpper} { string toupper abc } ABC test utf-11.3 {Tcl_UtfToUpper} { string toupper \xE3gh } \xC3GH test utf-11.4 {Tcl_UtfToUpper} { string toupper \u01E3gh } \u01E2GH test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} { string toupper \u10D0\u1C90 } \u1C90\u1C90 test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} fullutf { string toupper \U10428 } \U10400 test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf { string toupper \uD801\uDC28 } \uD801\uDC00 test utf-11.8 {Tcl_UtfToUpper low/high surrogate)} { string toupper \uDC24\uD824 } \uDC24\uD824 test utf-12.1 {Tcl_UtfToLower} { string tolower {} } {} test utf-12.2 {Tcl_UtfToLower} { string tolower ABC } abc test utf-12.3 {Tcl_UtfToLower} { string tolower \xC3GH } \xE3gh test utf-12.4 {Tcl_UtfToLower} { string tolower \u01E2GH } \u01E3gh test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} { string tolower \u10D0\u1C90 } \u10D0\u10D0 test utf-12.6 {Tcl_UtfToLower low/high surrogate)} { string tolower \uDC24\uD824 } \uDC24\uD824 test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} fullutf { string tolower \U10400 } \U10428 test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf { string tolower \uD801\uDC00 } \uD801\uDC28 test utf-13.1 {Tcl_UtfToTitle} { string totitle {} } {} test utf-13.2 {Tcl_UtfToTitle} { string totitle abc } Abc test utf-13.3 {Tcl_UtfToTitle} { string totitle \xE3GH } \xC3gh test utf-13.4 {Tcl_UtfToTitle} { string totitle \u01F3AB } \u01F2ab test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { string totitle \u10D0\u1C90 } \u10D0\u1C90 test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { string totitle \u1C90\u10D0 } \u1C90\u10D0 test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} { string totitle \uDC24\uD824 } \uDC24\uD824 test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} fullutf { string totitle \U10428\U10400 } \U10400\U10428 test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf { string totitle \uD801\uDC28\uD801\uDC00 } \uD801\uDC00\uD801\uDC28 test utf-14.1 {Tcl_UtfNcasecmp} { string compare -nocase a b } -1 test utf-14.2 {Tcl_UtfNcasecmp} { string compare -nocase b a } 1 test utf-14.3 {Tcl_UtfNcasecmp} { string compare -nocase B a } 1 test utf-14.4 {Tcl_UtfNcasecmp} { string compare -nocase aBcB abca } 1 test utf-15.1 {Tcl_UniCharToUpper, negative delta} { string toupper aA } AA test utf-15.2 {Tcl_UniCharToUpper, positive delta} { string toupper \u0178\xFF } \u0178\u0178 test utf-15.3 {Tcl_UniCharToUpper, no delta} { string toupper ! } ! test utf-16.1 {Tcl_UniCharToLower, negative delta} { string tolower aA } aa test utf-16.2 {Tcl_UniCharToLower, positive delta} { string tolower \u0178\xFF\uA78D\u01C5 } \xFF\xFF\u0265\u01C6 test utf-17.1 {Tcl_UniCharToLower, no delta} { string tolower ! } ! test utf-18.1 {Tcl_UniCharToTitle, add one for title} { string totitle \u01C4 } \u01C5 test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} { string totitle \u01C6 } \u01C5 test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} { string totitle \u017F } \x53 test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} { string totitle \xFF } \u0178 test utf-18.5 {Tcl_UniCharToTitle, no delta} { string totitle ! } ! test utf-19.1 {TclUniCharLen} -body { list [regexp \\d abc456def foo] $foo } -cleanup { unset -nocomplain foo } -result {1 4} test utf-20.1 {TclUniCharNcmp} utf32 { string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0] } -1 test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} { set one [format %c 0xFFFF] set two [format %c 0x10000] set first [string compare $one $two] string range $one 0 0 string range $two 0 0 set second [string compare $one $two] expr {($first == $second) ? "agree" : "disagree"} } agree test utf-21.1 {Tcl_UniCharIsAlnum} { # this returns 1 with Unicode 7 compliance string is alnum \u1040\u021F\u0220 } 1 test utf-21.2 {unicode alnum char in regc_locale.c} { # this returns 1 with Unicode 7 compliance list [regexp {^[[:alnum:]]+$} \u1040\u021F\u0220] [regexp {^\w+$} \u1040\u021F\u0220_\u203F\u2040\u2054\uFE33\uFE34\uFE4D\uFE4E\uFE4F\uFF3F] } {1 1} test utf-21.3 {unicode print char in regc_locale.c} { # this returns 1 with Unicode 7 compliance regexp {^[[:print:]]+$} \uFBC1 } 1 test utf-21.4 {Tcl_UniCharIsGraph} { # [Bug 3464428] string is graph \u0120 } 1 test utf-21.5 {unicode graph char in regc_locale.c} { # [Bug 3464428] regexp {^[[:graph:]]+$} \u0120 } 1 test utf-21.6 {Tcl_UniCharIsGraph} { # [Bug 3464428] string is graph \xA0 } 0 test utf-21.7 {unicode graph char in regc_locale.c} { # [Bug 3464428] regexp {[[:graph:]]} \x20\xA0\u2028\u2029 } 0 test utf-21.8 {Tcl_UniCharIsPrint} { # [Bug 3464428] string is print \x09 } 0 test utf-21.9 {unicode print char in regc_locale.c} { # [Bug 3464428] regexp {[[:print:]]} \x09 } 0 test utf-21.10 {unicode print char in regc_locale.c} { # [Bug 3464428] regexp {[[:print:]]} \x09 } 0 test utf-21.11 {Tcl_UniCharIsControl} { # [Bug 3464428] string is control \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF } 1 test utf-21.12 {unicode control char in regc_locale.c} { # [Bug 3464428], [Bug a876646efe] regexp {^[[:cntrl:]]*$} \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF } 1 test utf-22.1 {Tcl_UniCharIsWordChar} { string wordend "xyz123_bar fg" 0 } 10 test utf-22.2 {Tcl_UniCharIsWordChar} { string wordend "x\u5080z123_bar\u203C fg" 0 } 10 test utf-23.1 {Tcl_UniCharIsAlpha} { # this returns 1 with Unicode 7 compliance string is alpha \u021F\u0220\u037F\u052F } 1 test utf-23.2 {unicode alpha char in regc_locale.c} { # this returns 1 with Unicode 7 compliance regexp {^[[:alpha:]]+$} \u021F\u0220\u037F\u052F } 1 test utf-24.1 {Tcl_UniCharIsDigit} { # this returns 1 with Unicode 7 compliance string is digit \u1040\uABF0 } 1 test utf-24.2 {unicode digit char in regc_locale.c} { # this returns 1 with Unicode 7 compliance list [regexp {^[[:digit:]]+$} \u1040\uABF0] [regexp {^\d+$} \u1040\uABF0] } {1 1} test utf-24.3 {Tcl_UniCharIsSpace} { # this returns 1 with Unicode 7 compliance string is space \u1680\u180E\u202F } 1 test utf-24.4 {unicode space char in regc_locale.c} { # this returns 1 with Unicode 7 compliance list [regexp {^[[:space:]]+$} \u1680\u180E\u202F] [regexp {^\s+$} \u1680\u180E\u202F] } {1 1} test utf-24.5 {Tcl_UniCharIsSpace} tip413 { # this returns 1 with Unicode 7/TIP 413 compliance string is space \x85\u1680\u180E\u200B\u202F\u2060 } 1 test utf-24.6 {unicode space char in regc_locale.c} tip413 { # this returns 1 with Unicode 7/TIP 413 compliance list [regexp {^[[:space:]]+$} \x85\u1680\u180E\u200B\u202F\u2060] [regexp {^\s+$} \x85\u1680\u180E\u200B\u202F\u2060] } {1 1} proc UniCharCaseCmpTest {order one two {constraints {}}} { variable count test utf-25.$count {Tcl_UniCharNcasecmp} -setup { testobj freeallvars } -constraints [linsert $constraints 0 teststringobj] -cleanup { testobj freeallvars } -body { teststringobj set 1 $one teststringobj set 2 $two teststringobj getunicode 1 teststringobj getunicode 2 set result [string compare -nocase [teststringobj get 1] [teststringobj get 2]] if {$result eq [string map {< -1 = 0 > 1} $order]} { set result ok } else { set result "'$one' should be $order '$two' (no case)" } set result } -result ok incr count } variable count 1 UniCharCaseCmpTest < a b UniCharCaseCmpTest > b a UniCharCaseCmpTest > B a UniCharCaseCmpTest > aBcB abca UniCharCaseCmpTest < \uFFFF [format %c 0x10000] utf32 UniCharCaseCmpTest < \uFFFF \U10000 utf32 UniCharCaseCmpTest > [format %c 0x10000] \uFFFF utf32 UniCharCaseCmpTest > \U10000 \uFFFF utf32 test utf-26.1 {Tcl_UniCharDString} -setup { testobj freeallvars } -constraints {teststringobj testbytestring} -cleanup { testobj freeallvars } -body { teststringobj set 1 foo teststringobj getunicode 1 teststringobj append 1 [testbytestring barsoom\xF2\xC2\x80] 10 scan [string index [teststringobj get 1] 11] %c } -result 128 unset count rename UniCharCaseCmpTest {} proc GetUniCharTest {s index result} { variable count # Use quotes, not {} so test output shows exact string on error test getunichar-1.$count "Tcl_GetUniChar $s $index" \ -constraints testgetunichar \ -body "testgetunichar $s $index" \ -result $result incr count } variable count 1 set errorIndicator [expr 0xFFFD]; # Decimalize U+FFFD GetUniCharTest abcd -2 $errorIndicator GetUniCharTest abcd -1 $errorIndicator GetUniCharTest abcd 0 97 ;# a -> ASCII 97 GetUniCharTest abcd 3 100 GetUniCharTest abcd 4 $errorIndicator GetUniCharTest abcd 1000 $errorIndicator GetUniCharTest \xe0bc\xe1 -2 $errorIndicator GetUniCharTest \xe0bc\xe1 -1 $errorIndicator GetUniCharTest \xe0bc\xe1 0 224 ;# \xe0 == 224 GetUniCharTest \xe0bc\xe1 3 225 GetUniCharTest \xe0bc\xe1 4 $errorIndicator GetUniCharTest \xe0bc\xe1 1000 $errorIndicator unset count rename GetUniCharTest "" # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/util.test0000644000175000017500000040501314560736524014674 0ustar sergeisergei# This file is a Tcl script to test the code in the file tclUtil.c. # This file is organized in the standard fashion for Tcl tests. # # Copyright (c) 1995-1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint controversialNaN 1 testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] testConstraint testconcatobj [llength [info commands testconcatobj]] testConstraint testdoubledigits [llength [info commands testdoubledigits]] testConstraint testprint [llength [info commands testprint]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues binary scan [binary format dd -1.0 1.0] c* c switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ ieeeValues(-Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ ieeeValues(+Normal) binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ ieeeValues(+Infinity) binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ ieeeValues(NaN) binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \ ieeeValues(-NaN) binary scan \xef\xcd\xab\x89\x67\x45\xfb\xff d \ ieeeValues(-NaN(3456789abcdef)) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-0) binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-NaN) binary scan \xff\xfb\x45\x67\x89\xab\xcd\xef d \ ieeeValues(-NaN(3456789abcdef)) set ieeeValues(littleEndian) 0 return 1 } default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] proc convertDouble { x } { variable ieeeValues if { $ieeeValues(littleEndian) } { binary scan [binary format w $x] d result } else { binary scan [binary format W $x] d result } return $result } proc verdonk_test {sig binexp shouldbe exp} { regexp {([-+]?)([0-9a-f]+)} $sig -> signum sig scan $sig %llx sig if {$signum eq {-}} { set signum [expr {1<<63}] } else { set signum 0 } regexp {E([-+]?[0-9]+)} $binexp -> binexp set word [expr {$signum | (($binexp + 0x3ff)<<52)|($sig & ~(1<<52))}] binary scan [binary format w $word] q double regexp {([-+])(\d+)_(\d+)\&} $shouldbe -> signum digits1 digits2 regexp {E([-+]\d+)} $exp -> decexp incr decexp [expr {[string length $digits1] - 1}] lassign [testdoubledigits $double [string length $digits1] e] \ outdigits decpt outsign if {[string index $digits2 0] >= 5} { incr digits1 } if {$outsign != $signum || $outdigits != $digits1 || $decpt != $decexp} { return -code error "result is ${outsign}0.${outdigits}E$decpt\ should be ${signum}0.${digits1}E$decexp" } } test util-1.1 {TclFindElement procedure - binary element in middle of list} { lindex {0 foo\x00help 1} 1 } "foo\x00help" test util-1.2 {TclFindElement procedure - binary element at end of list} { lindex {0 foo\x00help} 1 } "foo\x00help" test util-2.1 {TclCopyAndCollapse procedure - normal string} { lindex {0 foo} 1 } {foo} test util-2.2 {TclCopyAndCollapse procedure - string with backslashes} { lindex {0 foo\n\x00help 1} 1 } "foo\n\x00help" test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} { # This test checks for a very tricky feature. Any list element # generated with Tcl_ScanCountedElement and Tcl_ConvertElement must # have the property that it can be enclosing in curly braces to make # an embedded sub-list. If this property doesn't hold, then # Tcl_DStringStartSublist doesn't work. set x {} lappend x "# \\\{ \\" concat $x [llength "{$x}"] } {\#\ \\\{\ \\ 1} test util-3.2 {Tcl_ConverCountedElement procedure - quote leading '#'} { list # # a } {{#} # a} test util-3.3 {Tcl_ConverCountedElement procedure - quote leading '#'} { list #\{ # a } {\#\{ # a} test util-3.4 {Tcl_ConverCountedElement procedure - quote leading '#'} { proc # {} {return #} set result [eval [list #]] rename # {} set result } {#} test util-3.4.1 {Tcl_ConverCountedElement procedure - quote leading '#'} { proc # {} {return #} set cmd [list #] append cmd "" ;# force string rep generation set result [eval $cmd] rename # {} set result } {#} test util-3.5 {Tcl_ConverCountedElement procedure - quote leading '#'} { proc #\{ {} {return #} set result [eval [list #\{]] rename #\{ {} set result } {#} test util-3.5.1 {Tcl_ConverCountedElement procedure - quote leading '#'} { proc #\{ {} {return #} set cmd [list #\{] append cmd "" ;# force string rep generation set result [eval $cmd] rename #\{ {} set result } {#} test util-3.6 {Tcl_ConvertElement, Bug 3371644} { interp create #\\ interp alias {} x #\\ concat interp target {} x ;# Crash if bug not fixed interp delete #\\ } {} test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} { concat a {b\ } c } {a b\ c} test util-4.2 {Tcl_ConcatObj - backslash-space at end of argument} { concat a {b\ } c } {a b\ c} test util-4.3 {Tcl_ConcatObj - backslash-space at end of argument} { concat a {b\\ } c } {a b\\ c} test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} { concat a {b } c } {a b c} test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} { concat a { } c } {a c} test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} { # Check for Bug #227512. If this violates C isspace, then it returns \xc3. concat \xe0 } \xe0 test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj { # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the # symptoms was Bug #2055782. testconcatobj } {} test util-4.8 {Tcl_ConcatObj - [Bug 26649439c7]} { concat [list foo] [list #] } {foo {#}} proc Wrapper_Tcl_StringMatch {pattern string} { # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch switch -glob -- $string $pattern {return 1} default {return 0} } test util-5.1 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch ab*c abc } 1 test util-5.2 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch ab**c abc } 1 test util-5.3 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch ab* abcdef } 1 test util-5.4 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch *c abc } 1 test util-5.5 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch *3*6*9 0123456789 } 1 test util-5.6 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch *3*6*9 01234567890 } 0 test util-5.7 {Tcl_StringMatch: UTF-8} { Wrapper_Tcl_StringMatch *u \u4e4fu } 1 test util-5.8 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch a?c abc } 1 test util-5.9 {Tcl_StringMatch: UTF-8} { # skip one character in string Wrapper_Tcl_StringMatch a?c a\u4e4fc } 1 test util-5.10 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch a??c abc } 0 test util-5.11 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch ?1??4???8? 0123456789 } 1 test util-5.12 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {[abc]bc} abc } 1 test util-5.13 {Tcl_StringMatch: UTF-8} { # string += Tcl_UtfToUniChar(string, &ch); Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc" } 1 test util-5.14 {Tcl_StringMatch} { # if ((*pattern == ']') || (*pattern == '\0')) # badly formed pattern Wrapper_Tcl_StringMatch {[]} {[]} } 0 test util-5.15 {Tcl_StringMatch} { # if ((*pattern == ']') || (*pattern == '\0')) # badly formed pattern Wrapper_Tcl_StringMatch {[} {[} } 0 test util-5.16 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {a[abc]c} abc } 1 test util-5.17 {Tcl_StringMatch: UTF-8} { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # get 1 UTF-8 character Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc" } 1 test util-5.18 {Tcl_StringMatch: UTF-8} testbytestring { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # proper advance: wrong answer would match on UTF trail byte of \u4e4f Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\u008fc] } 0 test util-5.19 {Tcl_StringMatch: UTF-8} { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # proper advance. Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc" } 1 test util-5.20 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {a[xyz]c} abc } 0 test util-5.21 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {12[2-7]45} 12345 } 1 test util-5.22 {Tcl_StringMatch: UTF-8 range} { Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "0" } 0 test util-5.23 {Tcl_StringMatch: UTF-8 range} { Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33" } 1 test util-5.24 {Tcl_StringMatch: UTF-8 range} { Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08" } 0 test util-5.25 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12345 } 1 test util-5.26 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12b45 } 1 test util-5.27 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12d45 } 1 test util-5.28 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12145 } 0 test util-5.29 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12545 } 0 test util-5.30 {Tcl_StringMatch: forwards range} { Wrapper_Tcl_StringMatch {[k-w]} "z" } 0 test util-5.31 {Tcl_StringMatch: forwards range} { Wrapper_Tcl_StringMatch {[k-w]} "w" } 1 test util-5.32 {Tcl_StringMatch: forwards range} { Wrapper_Tcl_StringMatch {[k-w]} "r" } 1 test util-5.33 {Tcl_StringMatch: forwards range} { Wrapper_Tcl_StringMatch {[k-w]} "k" } 1 test util-5.34 {Tcl_StringMatch: forwards range} { Wrapper_Tcl_StringMatch {[k-w]} "a" } 0 test util-5.35 {Tcl_StringMatch: reverse range} { Wrapper_Tcl_StringMatch {[w-k]} "z" } 0 test util-5.36 {Tcl_StringMatch: reverse range} { Wrapper_Tcl_StringMatch {[w-k]} "w" } 1 test util-5.37 {Tcl_StringMatch: reverse range} { Wrapper_Tcl_StringMatch {[w-k]} "r" } 1 test util-5.38 {Tcl_StringMatch: reverse range} { Wrapper_Tcl_StringMatch {[w-k]} "k" } 1 test util-5.39 {Tcl_StringMatch: reverse range} { Wrapper_Tcl_StringMatch {[w-k]} "a" } 0 test util-5.40 {Tcl_StringMatch: skip correct number of ']'} { Wrapper_Tcl_StringMatch {[A-]x} Ax } 0 test util-5.41 {Tcl_StringMatch: skip correct number of ']'} { Wrapper_Tcl_StringMatch {[A-]]x} Ax } 1 test util-5.42 {Tcl_StringMatch: skip correct number of ']'} { Wrapper_Tcl_StringMatch {[A-]]x} \ue1x } 0 test util-5.43 {Tcl_StringMatch: skip correct number of ']'} { Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x } 1 test util-5.44 {Tcl_StringMatch: skip correct number of ']'} { Wrapper_Tcl_StringMatch {[A-]h]x} hx } 1 test util-5.45 {Tcl_StringMatch} { # if (*pattern == '\0') # badly formed pattern, still treats as a set Wrapper_Tcl_StringMatch {[a} a } 1 test util-5.46 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {a\*b} a*b } 1 test util-5.47 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {a\*b} ab } 0 test util-5.48 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {a\*\?\[\]\\\x} "a*?\[\]\\x" } 1 test util-5.49 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch ** "" } 1 test util-5.50 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch *. "" } 0 test util-5.51 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch "" "" } 1 test util-5.52 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch \[a\u0000 a\x80 } 0 test util-6.1 {Tcl_PrintDouble - using tcl_precision} -setup { set old_precision $::tcl_precision set ::tcl_precision 12 } -body { concat x[expr {1.4}] } -cleanup { set ::tcl_precision $old_precision } -result {x1.4} test util-6.2 {Tcl_PrintDouble - using tcl_precision} -setup { set old_precision $::tcl_precision set ::tcl_precision 12 } -body { concat x[expr {1.39999999999}] } -cleanup { set ::tcl_precision $old_precision } -result {x1.39999999999} test util-6.3 {Tcl_PrintDouble - using tcl_precision} -setup { set old_precision $::tcl_precision set ::tcl_precision 12 } -body { concat x[expr {1.399999999999}] } -cleanup { set ::tcl_precision $old_precision } -result {x1.4} test util-6.4 {Tcl_PrintDouble - using tcl_precision} -setup { set old_precision $::tcl_precision set ::tcl_precision 5 } -body { concat x[expr {1.123412341234}] } -cleanup { set tcl_precision $old_precision } -result {x1.1234} test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr {2.0}] } {x2.0} test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr {3.0e98}] } {x3e+98} test util-7.1 {TclPrecTraceProc - unset callbacks} -setup { set old_precision $::tcl_precision } -body { set tcl_precision 7 set x $tcl_precision unset tcl_precision list $x $tcl_precision } -cleanup { set ::tcl_precision $old_precision } -result {7 7} test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} -setup { set old_precision $::tcl_precision } -body { set tcl_precision 12 interp create child set x [child eval set tcl_precision] child eval {set tcl_precision 6} interp delete child list $x $tcl_precision } -cleanup { set ::tcl_precision $old_precision } -result {12 6} test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} -setup { set old_precision $::tcl_precision } -body { set tcl_precision 12 interp create -safe child set x [child eval { list [catch {set tcl_precision 8} msg] $msg }] interp delete child list $x $tcl_precision } -cleanup { set ::tcl_precision $old_precision } -result {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12} test util-7.4 {TclPrecTraceProc - write traces, bogus values} -setup { set old_precision $::tcl_precision } -body { set tcl_precision 12 list [catch {set tcl_precision abc} msg] $msg $tcl_precision } -cleanup { set ::tcl_precision $old_precision } -result {1 {can't set "tcl_precision": improper value for precision} 12} # This test always succeeded in the C locale anyway... test util-8.1 {TclNeedSpace - correct utf-8 handling} { # Bug 411825 # Note that this test relies on the fact that # [interp target] calls on Tcl_AppendElement() # which calls on TclNeedSpace(). If [interp target] # is ever updated, this test will no longer test # TclNeedSpace. interp create \u5420 interp create [list \u5420 foo] interp alias {} fooset [list \u5420 foo] set set result [interp target {} fooset] interp delete \u5420 set result } "\u5420 foo" test util-8.2 {TclNeedSpace - correct utf-8 handling} testdstring { # Bug 411825 # This tests the same bug as the previous test, but # should be more future-proof, as the DString # operations will likely continue to call TclNeedSpace testdstring free testdstring append \u5420 -1 testdstring element foo llength [testdstring get] } 2 test util-8.3 {TclNeedSpace - correct utf-8 handling} testdstring { # Bug 411825 - new variant reported by Dossy Shiobara testdstring free testdstring append \u00A0 -1 testdstring element foo llength [testdstring get] } 2 test util-8.4 {TclNeedSpace - correct utf-8 handling} testdstring { # Another bug uncovered while fixing 411825 testdstring free testdstring append {\ } -1 testdstring append \{ -1 testdstring element foo llength [testdstring get] } 2 test util-8.5 {TclNeedSpace - correct utf-8 handling} testdstring { testdstring free testdstring append {\\ } -1 testdstring element foo list [llength [testdstring get]] [string length [testdstring get]] } {2 6} test util-8.6 {TclNeedSpace - correct utf-8 handling} testdstring { testdstring free testdstring append {\\ } -1 testdstring append \{ -1 testdstring element foo testdstring append \} -1 list [llength [testdstring get]] [string length [testdstring get]] } {2 8} test util-8.7 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\ } -1 testdstring start testdstring end # Should make {\ {}} list [llength [testdstring get]] [string index [testdstring get] 3] } {2 \{} test util-8.8 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\\ } -1 testdstring start testdstring end # Should make {\\ {}} list [llength [testdstring get]] [string index [testdstring get] 3] } {2 \{} test util-8.9 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\\\ } -1 testdstring start testdstring end # Should make {\\\ {}} list [llength [testdstring get]] [string index [testdstring get] 5] } {2 \{} test util-8.10 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\\\\\\\ } -1 testdstring start testdstring end # Should make {\\\\\\\ {}} list [llength [testdstring get]] [string index [testdstring get] 9] } {2 \{} test util-8.11 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\\\\\\\\ } -1 testdstring start testdstring end # Should make {\\\\\\\\ {}} list [llength [testdstring get]] [string index [testdstring get] 9] } {2 \{} test util-9.0.0 {TclGetIntForIndex} { string index abcd 0 } a test util-9.0.1 {TclGetIntForIndex} { string index abcd 0x0 } a test util-9.0.2 {TclGetIntForIndex} { string index abcd -0x0 } a test util-9.0.3 {TclGetIntForIndex} { string index abcd { 0 } } a test util-9.0.4 {TclGetIntForIndex} { string index abcd { 0x0 } } a test util-9.0.5 {TclGetIntForIndex} { string index abcd { -0x0 } } a test util-9.0.6 {TclGetIntForIndex} { string index abcd 01 } b test util-9.0.7 {TclGetIntForIndex} { string index abcd { 01 } } b test util-9.1.0 {TclGetIntForIndex} { string index abcd 3 } d test util-9.1.1 {TclGetIntForIndex} { string index abcd { 3 } } d test util-9.1.2 {TclGetIntForIndex} { string index abcdefghijk 0xa } k test util-9.1.3 {TclGetIntForIndex} { string index abcdefghijk { 0xa } } k test util-9.2.0 {TclGetIntForIndex} { string index abcd end } d test util-9.2.1 {TclGetIntForIndex} -body { string index abcd { end} } -returnCodes error -match glob -result * test util-9.2.2 {TclGetIntForIndex} -body { string index abcd {end } } -returnCodes error -match glob -result * test util-9.3 {TclGetIntForIndex} { # Deprecated string index abcd en } d test util-9.4 {TclGetIntForIndex} { # Deprecated string index abcd e } d test util-9.5.0 {TclGetIntForIndex} { string index abcd end-1 } c test util-9.5.1 {TclGetIntForIndex} { string index abcd {end-1 } } c test util-9.5.2 {TclGetIntForIndex} -body { string index abcd { end-1} } -returnCodes error -match glob -result * test util-9.6 {TclGetIntForIndex} { string index abcd end+-1 } c test util-9.7 {TclGetIntForIndex} { string index abcd end+1 } {} test util-9.8 {TclGetIntForIndex} { string index abcd end--1 } {} test util-9.9.0 {TclGetIntForIndex} { string index abcd 0+0 } a test util-9.9.1 {TclGetIntForIndex} { string index abcd { 0+0 } } a test util-9.10 {TclGetIntForIndex} { string index abcd 0-0 } a test util-9.11 {TclGetIntForIndex} { string index abcd 1+0 } b test util-9.12 {TclGetIntForIndex} { string index abcd 1-0 } b test util-9.13 {TclGetIntForIndex} { string index abcd 1+1 } c test util-9.14 {TclGetIntForIndex} { string index abcd 1-1 } a test util-9.15 {TclGetIntForIndex} { string index abcd -1+2 } b test util-9.16 {TclGetIntForIndex} { string index abcd -1--2 } b test util-9.17 {TclGetIntForIndex} { string index abcd { -1+2 } } b test util-9.18 {TclGetIntForIndex} { string index abcd { -1--2 } } b test util-9.19 {TclGetIntForIndex} -body { string index a {} } -returnCodes error -match glob -result * test util-9.20 {TclGetIntForIndex} -body { string index a { } } -returnCodes error -match glob -result * test util-9.21 {TclGetIntForIndex} -body { string index a " \r\t\n" } -returnCodes error -match glob -result * test util-9.22 {TclGetIntForIndex} -body { string index a + } -returnCodes error -match glob -result * test util-9.23 {TclGetIntForIndex} -body { string index a - } -returnCodes error -match glob -result * test util-9.24 {TclGetIntForIndex} -body { string index a x } -returnCodes error -match glob -result * test util-9.25 {TclGetIntForIndex} -body { string index a +x } -returnCodes error -match glob -result * test util-9.26 {TclGetIntForIndex} -body { string index a -x } -returnCodes error -match glob -result * test util-9.27 {TclGetIntForIndex} -body { string index a 0y } -returnCodes error -match glob -result * test util-9.28 {TclGetIntForIndex} -body { string index a 1* } -returnCodes error -match glob -result * test util-9.29 {TclGetIntForIndex} -body { string index a 0+ } -returnCodes error -match glob -result * test util-9.30 {TclGetIntForIndex} -body { string index a {0+ } } -returnCodes error -match glob -result * test util-9.31 {TclGetIntForIndex} -body { string index a 0x } -returnCodes error -match glob -result * test util-9.32 {TclGetIntForIndex} -body { string index a 0x1FFFFFFFF+0 } -returnCodes error -match glob -result * test util-9.33 {TclGetIntForIndex} -body { string index a 100000000000+0 } -returnCodes error -match glob -result * test util-9.34 {TclGetIntForIndex} -body { string index a 1.0 } -returnCodes error -match glob -result * test util-9.35 {TclGetIntForIndex} -body { string index a 1e23 } -returnCodes error -match glob -result * test util-9.36 {TclGetIntForIndex} -body { string index a 1.5e2 } -returnCodes error -match glob -result * test util-9.37 {TclGetIntForIndex} -body { string index a 0+x } -returnCodes error -match glob -result * test util-9.38 {TclGetIntForIndex} -body { string index a 0+0x } -returnCodes error -match glob -result * test util-9.39 {TclGetIntForIndex} -body { string index a 0+0xg } -returnCodes error -match glob -result * test util-9.40 {TclGetIntForIndex} -body { string index a 0+0xg } -returnCodes error -match glob -result * test util-9.41 {TclGetIntForIndex} -body { string index a 0+1.0 } -returnCodes error -match glob -result * test util-9.42 {TclGetIntForIndex} -body { string index a 0+1e2 } -returnCodes error -match glob -result * test util-9.43 {TclGetIntForIndex} -body { string index a 0+1.5e1 } -returnCodes error -match glob -result * test util-9.44 {TclGetIntForIndex} -body { string index a 0+1000000000000 } -returnCodes error -match glob -result * test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x0000000000000000 } {0.0} test util-10.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x8000000000000000 } {-0.0} test util-10.3 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x7ef754e31cd072da } {4e+303} test util-10.4 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xd08afcef51f0fb5f } {-1e+80} test util-10.5 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x7ed754e31cd072da } {1e+303} test util-10.6 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xfee754e31cd072da } {-2e+303} test util-10.7 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x0afe07b27dd78b14 } {1e-255} test util-10.8 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x93ae29e9c56687fe } {-7e-214} test util-10.9 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x376be03d0bf225c7 } {1e-41} test util-10.10 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xa0ca2fe76a3f9475 } {-1e-150} test util-10.11 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x7fa9a2028368022e } {9e+306} test util-10.12 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdfc317e5ef3ab327 } {-2e+153} test util-10.13 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x5fd317e5ef3ab327 } {4e+153} test util-10.14 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdfe317e5ef3ab327 } {-8e+153} test util-10.15 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x00feb8e84fa0b278 } {7e-304} test util-10.16 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x8133339131c46f8b } {-7e-303} test util-10.17 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x35dc0f92a6276c9d } {3e-49} test util-10.18 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xa445ce1f143d7ad2 } {-6e-134} test util-10.19 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x2d2c0794d9d40e96 } {4.3e-91} test util-10.20 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xad3c0794d9d40e96 } {-8.6e-91} test util-10.21 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x30ecd5bee57763e6 } {5.1e-73} test util-10.22 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x68ad1c26db7d0dae } {1.7e+196} test util-10.23 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbfa3f7ced916872b } {-0.039} test util-10.24 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x64b7d93193f78fc6 } {1.51e+177} test util-10.25 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x98ea82a1631eeb30 } {-1.19e-188} test util-10.26 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xd216c309024bab4b } {-2.83e+87} test util-10.27 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x0dfdbbac6f83a821 } {2.7869147e-241} test util-10.28 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdadc569e968e0944 } {-4.91080654e+129} test util-10.29 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x5acc569e968e0944 } {2.45540327e+129} test util-10.30 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xab5fc575867314ee } {-9.078555839e-100} test util-10.31 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdabc569e968e0944 } {-1.227701635e+129} test util-10.32 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x2b6fc575867314ee } {1.8157111678e-99} test util-10.33 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xb3b8bf7e7fa6f02a } {-1.5400733123779e-59} test util-10.34 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xcd83de005bd620df } {-2.6153245263757307e+65} test util-10.35 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x6cdf92bacb3cb40c } {2.7210404151224248e+216} test util-10.36 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xecef92bacb3cb40c } {-5.4420808302448496e+216} test util-10.37 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x49342dbf25096cf5 } {4.5e+44} test util-10.38 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xd06afcef51f0fb5f } {-2.5e+79} test util-10.39 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x49002498ea6df0c4 } {4.5e+43} test util-10.40 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xfeb754e31cd072da } {-2.5e+302} test util-10.41 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x1d22deac01e2b4f7 } {2.5e-168} test util-10.42 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xaccb1df536c13eee } {-6.5e-93} test util-10.43 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3650711fed5b19a4 } {4.5e-47} test util-10.44 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xb6848d67e8b1e00d } {-4.5e-46} test util-10.45 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4bac8c574c0c6be7 } {3.5e+56} test util-10.46 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xccd756183c147514 } {-1.5e+62} test util-10.47 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4ca2ab469676c410 } {1.5e+61} test util-10.48 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xcf5539684e774b48 } {-1.5e+74} test util-10.49 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x2e12e5f5dfa4fe9d } {9.5e-87} test util-10.50 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x8b9bdc2417bf7787 } {-9.5e-253} test util-10.51 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x00eeb8e84fa0b278 } {3.5e-304} test util-10.52 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xadde3cbc9907fdc8 } {-9.5e-88} test util-10.53 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x2bb0ad836f269a17 } {3.05e-98} test util-10.54 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x950b39ae1909c31b } {-2.65e-207} test util-10.55 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x1bfb2ab18615fcc6 } {6.865e-174} test util-10.56 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x98f3e1f90a573064 } {-1.785e-188} test util-10.57 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x5206c309024bab4b } {1.415e+87} test util-10.58 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xcc059bd3ad46e346 } {-1.6955e+58} test util-10.59 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x47bdf4170f0fdecc } {3.9815e+37} test util-10.60 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x59e7e1e0f1c7a4ac } {1.263005e+125} test util-10.61 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xda1dda592e398dd7 } {-1.263005e+126} test util-10.62 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdc4e597c0b94b7ae } {-4.4118455e+136} test util-10.63 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x5aac569e968e0944 } {6.138508175e+128} test util-10.64 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdabc569e968e0944 } {-1.227701635e+129} test util-10.65 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x6ce7ae0c186d8709 } {4.081560622683637e+216} test util-10.66 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x44b52d02c7e14af7 } {1.0000000000000001e+23} test util-10.67 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc589d971e4fe8402 } {-1e+27} test util-10.68 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4599d971e4fe8402 } {2e+27} test util-10.69 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc5a9d971e4fe8402 } {-4e+27} test util-10.70 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3e45798ee2308c3a } {1e-8} test util-10.71 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbe55798ee2308c3a } {-2e-8} test util-10.72 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3e65798ee2308c3a } {4e-8} test util-10.73 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbabef2d0f5da7dd9 } {-1e-25} test util-10.74 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x44da784379d99db4 } {5e+23} test util-10.75 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc4fa784379d99db4 } {-2e+24} test util-10.76 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4503da329b633647 } {3e+24} test util-10.77 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc54cf389cd46047d } {-7e+25} test util-10.78 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3fc999999999999a } {0.2} test util-10.79 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbfd3333333333333 } {-0.3} test util-10.80 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3cf6849b86a12b9b } {5e-15} test util-10.81 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbd16849b86a12b9b } {-2e-14} test util-10.82 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3b87ccfc73126788 } {6.3e-22} test util-10.83 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbbbdc03b8fd7016a } {-6.3e-21} test util-10.84 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3fa3f7ced916872b } {0.039} test util-10.85 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x460b297cad9f70b6 } {2.69e+29} test util-10.86 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc61b297cad9f70b6 } {-5.38e+29} test util-10.87 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3adcdc06b20ef183 } {3.73e-25} test util-10.88 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x45fb297cad9f70b6 } {1.345e+29} test util-10.89 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc60b297cad9f70b6 } {-2.69e+29} test util-10.90 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbc050a246ecd44f3 } {-1.4257e-19} test util-10.91 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbec19b96f36ec68b } {-2.09901e-6} test util-10.92 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3dcc06d366394441 } {5.0980203373e-11} test util-10.93 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc79f58ac4db68c90 } {-1.04166211811e+37} test util-10.94 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4569d971e4fe8402 } {2.5e+26} test util-10.95 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc50dc74be914d16b } {-4.5e+24} test util-10.96 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4534adf4b7320335 } {2.5e+25} test util-10.97 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc54ae22487c1042b } {-6.5e+25} test util-10.98 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3c987fe49aab41e0 } {8.5e-17} test util-10.99 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbc2f5c05e4b23fd7 } {-8.5e-19} test util-10.100 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3d5faa7ab552a552 } {4.5e-13} test util-10.101 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbdbb7cdfd9d7bdbb } {-2.5e-11} test util-10.102 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x44f3da329b633647 } {1.5e+24} test util-10.103 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc53cf389cd46047d } {-3.5e+25} test util-10.104 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x454f04ef12cb04cf } {7.5e+25} test util-10.105 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc55f04ef12cb04cf } {-1.5e+26} test util-10.106 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3fc3333333333333 } {0.15} test util-10.107 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbdb07e1fe91b0b70 } {-1.5e-11} test util-10.108 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3de49da7e361ce4c } {1.5e-10} test util-10.109 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbe19c511dc3a41df } {-1.5e-9} test util-10.110 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc5caa83d74267822 } {-1.65e+28} test util-10.111 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4588f1d5969453de } {9.65e+26} test util-10.112 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3b91d9bd564dcda6 } {9.45e-22} test util-10.113 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbcfa58973ecbede6 } {-5.85e-15} test util-10.114 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x45eb297cad9f70b6 } {6.725e+28} test util-10.115 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc5fb297cad9f70b6 } {-1.345e+29} test util-10.116 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3accdc06b20ef183 } {1.865e-25} test util-10.117 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbd036071dcae4565 } {-8.605e-15} test util-10.118 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x462cb968d297dde8 } {1.137885e+30} test util-10.119 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc661f3e1839eeab1 } {-1.137885e+31} test util-10.120 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x474e9cec176c96f8 } {3.179033335e+35} test util-10.121 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3dbc06d366394441 } {2.54901016865e-11} test util-10.122 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x478f58ac4db68c90 } {5.20831059055e+36} test util-11.1 {Tcl_PrintDouble - scaling} { expr {1.1e-5} } {1.1e-5} test util-11.2 {Tcl_PrintDouble - scaling} { expr {1.1e-4} } {0.00011} test util-11.3 {Tcl_PrintDouble - scaling} { expr {1.1e-3} } {0.0011} test util-11.4 {Tcl_PrintDouble - scaling} { expr {1.1e-2} } {0.011} test util-11.5 {Tcl_PrintDouble - scaling} { expr {1.1e-1} } {0.11} test util-11.6 {Tcl_PrintDouble - scaling} { expr {1.1e0} } {1.1} test util-11.7 {Tcl_PrintDouble - scaling} { expr {1.1e1} } {11.0} test util-11.8 {Tcl_PrintDouble - scaling} { expr {1.1e2} } {110.0} test util-11.9 {Tcl_PrintDouble - scaling} { expr {1.1e3} } {1100.0} test util-11.10 {Tcl_PrintDouble - scaling} { expr {1.1e4} } {11000.0} test util-11.11 {Tcl_PrintDouble - scaling} { expr {1.1e5} } {110000.0} test util-11.12 {Tcl_PrintDouble - scaling} { expr {1.1e6} } {1100000.0} test util-11.13 {Tcl_PrintDouble - scaling} { expr {1.1e7} } {11000000.0} test util-11.14 {Tcl_PrintDouble - scaling} { expr {1.1e8} } {110000000.0} test util-11.15 {Tcl_PrintDouble - scaling} { expr {1.1e9} } {1100000000.0} test util-11.16 {Tcl_PrintDouble - scaling} { expr {1.1e10} } {11000000000.0} test util-11.17 {Tcl_PrintDouble - scaling} { expr {1.1e11} } {110000000000.0} test util-11.18 {Tcl_PrintDouble - scaling} { expr {1.1e12} } {1100000000000.0} test util-11.19 {Tcl_PrintDouble - scaling} { expr {1.1e13} } {11000000000000.0} test util-11.20 {Tcl_PrintDouble - scaling} { expr {1.1e14} } {110000000000000.0} test util-11.21 {Tcl_PrintDouble - scaling} { expr {1.1e15} } {1100000000000000.0} test util-11.22 {Tcl_PrintDouble - scaling} { expr {1.1e16} } {11000000000000000.0} test util-11.23 {Tcl_PrintDouble - scaling} { expr {1.1e17} } {1.1e+17} test util-12.1 {TclDoubleDigits - Inf} {testdoubledigits ieeeFloatingPoint} { testdoubledigits Inf -1 shortest } {Infinity 9999 +} test util-12.2 {TclDoubleDigits - -Inf} {testdoubledigits ieeeFloatingPoint} { testdoubledigits -Inf -1 shortest } {Infinity 9999 -} test util-12.3 {TclDoubleDigits - NaN} {testdoubledigits ieeeFloatingPoint} { testdoubledigits $ieeeValues(NaN) -1 shortest } {NaN 9999 +} test util-12.4 {TclDoubleDigits - NaN} {*}{ -constraints {testdoubledigits ieeeFloatingPoint controversialNaN} -body { testdoubledigits -NaN -1 shortest } -result {NaN 9999 -} } test util-12.5 {TclDoubleDigits - 0} testdoubledigits { testdoubledigits 0.0 -1 shortest } {0 0 +} test util-12.6 {TclDoubleDigits - -0} testdoubledigits { testdoubledigits -0.0 -1 shortest } {0 0 -} # Verdonk test vectors test util-13.1 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1754e31cd072da E+1008 +4_000000000000000000& E+303 } -result {} } test util-13.2 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1afcef51f0fb5f E+265 -1_000000000000000000& E+80 } -result {} } test util-13.3 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1754e31cd072da E+1006 +1_000000000000000000& E+303 } -result {} } test util-13.4 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1754e31cd072da E+1007 -2_000000000000000000& E+303 } -result {} } test util-13.5 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1e07b27dd78b14 E-848 +1_00000000000000000& E-255 } -result {} } test util-13.6 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1e29e9c56687fe E-709 -7_00000000000000000& E-214 } -result {} } test util-13.7 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1be03d0bf225c7 E-137 +1_00000000000000000& E-41 } -result {} } test util-13.8 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1a2fe76a3f9475 E-499 -1_00000000000000000& E-150 } -result {} } test util-13.9 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 19a2028368022e E+1019 +8_999999999999999999& E+306 } -result {} } test util-13.10 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1317e5ef3ab327 E+509 -1_999999999999999999& E+153 } -result {} } test util-13.11 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1317e5ef3ab327 E+510 +3_99999999999999999& E+153 } -result {} } test util-13.12 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1317e5ef3ab327 E+511 -7_99999999999999999& E+153 } -result {} } test util-13.13 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1eb8e84fa0b278 E-1008 +6_999999999999999999& E-304 } -result {} } test util-13.14 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -13339131c46f8b E-1004 -6_999999999999999999& E-303 } -result {} } test util-13.15 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1c0f92a6276c9d E-162 +2_999999999999999999& E-49 } -result {} } test util-13.16 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -15ce1f143d7ad2 E-443 -5_99999999999999999& E-134 } -result {} } test util-13.17 {just over exact - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1c0794d9d40e96 E-301 +43_000000000000000000& E-92 } -result {} } test util-13.18 {just over exact - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1c0794d9d40e96 E-300 -86_000000000000000000& E-92 } -result {} } test util-13.19 {just over exact - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1cd5bee57763e6 E-241 +51_000000000000000000& E-74 } -result {} } test util-13.20 {just under exact - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1d1c26db7d0dae E+651 +16_999999999999999999& E+195 } -result {} } test util-13.21 {just under exact - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -13f7ced916872b E-5 -38_999999999999999999& E-3 } -result {} } test util-13.22 {just over exact - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 17d93193f78fc6 E+588 +151_0000000000000000000& E+175 } -result {} } test util-13.23 {just over exact - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1a82a1631eeb30 E-625 -119_000000000000000000& E-190 } -result {} } test util-13.24 {just under exact - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -16c309024bab4b E+290 -282_999999999999999999& E+85 } -result {} } test util-13.25 {just over exact - 8 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1dbbac6f83a821 E-800 +27869147_0000000000000000000& E-248 } -result {} } test util-13.26 {just under exact - 9 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1c569e968e0944 E+430 -491080653_9999999999999999999& E+121 } -result {} } test util-13.27 {just under exact - 9 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1c569e968e0944 E+429 +245540326_9999999999999999999& E+121 } -result {} } test util-13.28 {just over exact - 10 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1fc575867314ee E-330 -9078555839_0000000000000000000& E-109 } -result {} } test util-13.29 {just under exact - 10 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1c569e968e0944 E+428 -1227701634_9999999999999999999& E+120 } -result {} } test util-13.30 {just over exact - 11 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1fc575867314ee E-329 +18157111678_0000000000000000000& E-109 } -result {} } test util-13.31 {just over exact - 14 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -18bf7e7fa6f02a E-196 -15400733123779_0000000000000000000& E-72 } -result {} } test util-13.32 {just over exact - 17 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -13de005bd620df E+217 -26153245263757307_0000000000000000000& E+49 } -result {} } test util-13.33 {just over exact - 18 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1f92bacb3cb40c E+718 +272104041512242479_0000000000000000000& E+199 } -result {} } test util-13.34 {just over exact - 18 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1f92bacb3cb40c E+719 -544208083024484958_0000000000000000000& E+199 } -result {} } test util-13.35 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 142dbf25096cf5 E+148 +4_500000000000000000& E+44 } -result {} } test util-13.36 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1afcef51f0fb5f E+263 -2_500000000000000000& E+79 } -result {} } test util-13.37 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 102498ea6df0c4 E+145 +4_500000000000000000& E+43 } -result {} } test util-13.38 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1754e31cd072da E+1004 -2_500000000000000000& E+302 } -result {} } test util-13.39 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 12deac01e2b4f7 E-557 +2_50000000000000000& E-168 } -result {} } test util-13.40 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1b1df536c13eee E-307 -6_50000000000000000& E-93 } -result {} } test util-13.41 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 10711fed5b19a4 E-154 +4_50000000000000000& E-47 } -result {} } test util-13.42 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -148d67e8b1e00d E-151 -4_50000000000000000& E-46 } -result {} } test util-13.43 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1c8c574c0c6be7 E+187 +3_49999999999999999& E+56 } -result {} } test util-13.44 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1756183c147514 E+206 -1_49999999999999999& E+62 } -result {} } test util-13.45 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 12ab469676c410 E+203 +1_49999999999999999& E+61 } -result {} } test util-13.46 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1539684e774b48 E+246 -1_49999999999999999& E+74 } -result {} } test util-13.47 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 12e5f5dfa4fe9d E-286 +9_499999999999999999& E-87 } -result {} } test util-13.48 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1bdc2417bf7787 E-838 -9_499999999999999999& E-253 } -result {} } test util-13.49 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1eb8e84fa0b278 E-1009 +3_499999999999999999& E-304 } -result {} } test util-13.50 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1e3cbc9907fdc8 E-290 -9_499999999999999999& E-88 } -result {} } test util-13.51 {just over half ulp - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 10ad836f269a17 E-324 +30_500000000000000000& E-99 } -result {} } test util-13.52 {just over half ulp - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1b39ae1909c31b E-687 -26_500000000000000000& E-208 } -result {} } test util-13.53 {just over half ulp - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1b2ab18615fcc6 E-576 +686_500000000000000000& E-176 } -result {} } test util-13.54 {just over half ulp - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -13e1f90a573064 E-624 -178_500000000000000000& E-190 } -result {} } test util-13.55 {just under half ulp - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 16c309024bab4b E+289 +141_499999999999999999& E+85 } -result {} } test util-13.56 {just under half ulp - 4 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -159bd3ad46e346 E+193 -1695_499999999999999999& E+55 } -result {} } test util-13.57 {just under half ulp - 4 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1df4170f0fdecc E+124 +3981_499999999999999999& E+34 } -result {} } test util-13.58 {just over half ulp - 6 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 17e1e0f1c7a4ac E+415 +126300_5000000000000000000& E+120 } -result {} } test util-13.59 {just over half ulp - 6 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1dda592e398dd7 E+418 -126300_5000000000000000000& E+121 } -result {} } test util-13.60 {just under half ulp - 7 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1e597c0b94b7ae E+453 -4411845_499999999999999999& E+130 } -result {} } test util-13.61 {just under half ulp - 9 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1c569e968e0944 E+427 +613850817_4999999999999999999& E+120 } -result {} } test util-13.62 {just under half ulp - 9 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1c569e968e0944 E+428 -122770163_49999999999999999999& E+121 } -result {} } test util-13.63 {just over half ulp - 18 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 17ae0c186d8709 E+719 +408156062268363718_5000000000000000000& E+199 } -result {} } test util-13.64 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 152d02c7e14af7 E+76 +1_0000000000000000& E+23 } -result {} } test util-13.65 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -19d971e4fe8402 E+89 -1_0000000000000000& E+27 } -result {} } test util-13.66 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 19d971e4fe8402 E+90 +2_0000000000000000& E+27 } -result {} } test util-13.67 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -19d971e4fe8402 E+91 -4_0000000000000000& E+27 } -result {} } test util-13.68 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 15798ee2308c3a E-27 +1_0000000000000000& E-8 } -result {} } test util-13.69 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -15798ee2308c3a E-26 -2_0000000000000000& E-8 } -result {} } test util-13.70 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 15798ee2308c3a E-25 +4_0000000000000000& E-8 } -result {} } test util-13.71 {just over exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1ef2d0f5da7dd9 E-84 -1_0000000000000000& E-25 } -result {} } test util-13.72 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1a784379d99db4 E+78 +4_9999999999999999& E+23 } -result {} } test util-13.73 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1a784379d99db4 E+80 -1_9999999999999999& E+24 } -result {} } test util-13.74 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 13da329b633647 E+81 +2_9999999999999999& E+24 } -result {} } test util-13.75 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1cf389cd46047d E+85 -6_9999999999999999& E+25 } -result {} } test util-13.76 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 19999999999999 E-3 +1_99999999999999999& E-1 } -result {} } test util-13.77 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -13333333333333 E-2 -2_99999999999999999& E-1 } -result {} } test util-13.78 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 16849b86a12b9b E-48 +4_99999999999999999& E-15 } -result {} } test util-13.79 {just under exact - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -16849b86a12b9b E-46 -1_99999999999999999& E-14 } -result {} } test util-13.80 {just over exact - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 17ccfc73126788 E-71 +63_00000000000000000& E-23 } -result {} } test util-13.81 {just over exact - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1dc03b8fd7016a E-68 -63_00000000000000000& E-22 } -result {} } test util-13.82 {just under exact - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 13f7ced916872b E-5 +38_999999999999999999& E-3 } -result {} } test util-13.83 {just over exact - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1b297cad9f70b6 E+97 +269_000000000000000000& E+27 } -result {} } test util-13.84 {just over exact - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1b297cad9f70b6 E+98 -538_00000000000000000& E+27 } -result {} } test util-13.85 {just over exact - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1cdc06b20ef183 E-82 +373_00000000000000000& E-27 } -result {} } test util-13.86 {just over exact - 4 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1b297cad9f70b6 E+96 +1345_00000000000000000& E+26 } -result {} } # this one is not 4 digits, it is 3, and it is covered above. test util-13.87 {just over exact - 4 digits} {*}{ -constraints {testdoubledigits knownBadTest} -body { verdonk_test -1b297cad9f70b6 E+97 -2690_00000000000000000& E+26 } -result {} } test util-13.88 {just over exact - 5 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -150a246ecd44f3 E-63 -14257_00000000000000000& E-23 } -result {} } test util-13.89 {just under exact - 6 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -119b96f36ec68b E-19 -209900_999999999999999999& E-11 } -result {} } test util-13.90 {just over exact - 11 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1c06d366394441 E-35 +50980203373_000000000000000000& E-21 } -result {} } test util-13.91 {just under exact - 12 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1f58ac4db68c90 E+122 -104166211810_99999999999999999& E+26 } -result {} } test util-13.92 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 19d971e4fe8402 E+87 +2_5000000000000000& E+26 } -result {} } test util-13.93 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1dc74be914d16b E+81 -4_500000000000000& E+24 } -result {} } test util-13.94 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 14adf4b7320335 E+84 +2_500000000000000& E+25 } -result {} } test util-13.95 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1ae22487c1042b E+85 -6_5000000000000000& E+25 } -result {} } test util-13.96 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 187fe49aab41e0 E-54 +8_5000000000000000& E-17 } -result {} } test util-13.97 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1f5c05e4b23fd7 E-61 -8_5000000000000000& E-19 } -result {} } test util-13.98 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1faa7ab552a552 E-42 +4_5000000000000000& E-13 } -result {} } test util-13.99 {just over half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1b7cdfd9d7bdbb E-36 -2_5000000000000000& E-11 } -result {} } test util-13.100 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 13da329b633647 E+80 +1_4999999999999999& E+24 } -result {} } test util-13.101 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1cf389cd46047d E+84 -3_49999999999999999& E+25 } -result {} } test util-13.102 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1f04ef12cb04cf E+85 +7_4999999999999999& E+25 } -result {} } test util-13.103 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1f04ef12cb04cf E+86 -1_4999999999999999& E+26 } -result {} } test util-13.104 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 13333333333333 E-3 +1_49999999999999999& E-1 } -result {} } test util-13.105 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -107e1fe91b0b70 E-36 -1_49999999999999999& E-11 } -result {} } test util-13.106 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 149da7e361ce4c E-33 +1_49999999999999999& E-10 } -result {} } test util-13.107 {just under half ulp - 1 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -19c511dc3a41df E-30 -1_49999999999999999& E-9 } -result {} } test util-13.108 {just over half ulp - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1aa83d74267822 E+93 -16_5000000000000000& E+27 } -result {} } test util-13.109 {just over half ulp - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 18f1d5969453de E+89 +96_5000000000000000& E+25 } -result {} } test util-13.110 {just over half ulp - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 11d9bd564dcda6 E-70 +94_50000000000000000& E-23 } -result {} } test util-13.111 {just over half ulp - 2 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1a58973ecbede6 E-48 -58_50000000000000000& E-16 } -result {} } test util-13.112 {just over half ulp - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1b297cad9f70b6 E+95 +672_50000000000000000& E+26 } -result {} } test util-13.113 {just over half ulp - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -1b297cad9f70b6 E+96 -134_500000000000000000& E+27 } -result {} } test util-13.114 {just over half ulp - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1cdc06b20ef183 E-83 +186_50000000000000000& E-27 } -result {} } test util-13.115 {just over half ulp - 3 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -136071dcae4565 E-47 -860_50000000000000000& E-17 } -result {} } test util-13.116 {just over half ulp - 6 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1cb968d297dde8 E+99 +113788_50000000000000000& E+25 } -result {} } test util-13.117 {just over half ulp - 6 digits} {*}{ -constraints testdoubledigits -body { verdonk_test -11f3e1839eeab1 E+103 -113788_50000000000000000& E+26 } -result {} } test util-13.118 {just under half ulp - 9 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1e9cec176c96f8 E+117 +317903333_49999999999999999& E+27 } -result {} } test util-13.119 {just over half ulp - 11 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1c06d366394441 E-36 +25490101686_500000000000000000& E-21 } -result {} } test util-13.120 {just under half ulp - 11 digits} {*}{ -constraints testdoubledigits -body { verdonk_test 1f58ac4db68c90 E+121 +52083105905_49999999999999999& E+26 } -result {} } test util-14.1 {funky NaN} {*}{ -constraints {ieeeFloatingPoint controversialNaN} -body { set ieeeValues(-NaN) } -result -NaN } test util-14.2 {funky NaN} {*}{ -constraints {ieeeFloatingPoint controversialNaN} -body { set ieeeValues(-NaN(3456789abcdef)) } -result -NaN(3456789abcdef) } test util-15.1 {largest subnormal} {*}{ -body { binary scan [binary format w 0x000fffffffffffff] q x set x } -result 2.225073858507201e-308 -cleanup { unset x } } test util-15.2 {largest subnormal} {*}{ -body { binary scan [binary format w 0x800fffffffffffff] q x set x } -result -2.225073858507201e-308 -cleanup { unset x } } test util-15.3 {largest subnormal} {*}{ -body { binary scan [binary format q 2.225073858507201e-308] w x format %#lx $x } -result 0xfffffffffffff -cleanup { unset x } } test util-15.4 {largest subnormal} {*}{ -body { binary scan [binary format q -2.225073858507201e-308] w x format %#lx $x } -result 0x800fffffffffffff -cleanup { unset x } } test util-15.5 {smallest normal} {*}{ -body { binary scan [binary format w 0x0010000000000000] q x set x } -result 2.2250738585072014e-308 -cleanup { unset x } } test util-15.6 {smallest normal} {*}{ -body { binary scan [binary format w 0x8010000000000000] q x set x } -result -2.2250738585072014e-308 -cleanup { unset x } } test util-15.7 {smallest normal} {*}{ -body { binary scan [binary format q 2.2250738585072014e-308] w x format %#lx $x } -result 0x10000000000000 -cleanup { unset x } } test util-15.8 {smallest normal} {*}{ -body { binary scan [binary format q -2.2250738585072014e-308] w x format %#lx $x } -result 0x8010000000000000 -cleanup { unset x } } set saved_precision $::tcl_precision foreach ::tcl_precision {0 12} { for {set e -312} {$e < -9} {incr e} { test util-16.1.$::tcl_precision.$e {shortening of numbers} \ "expr {1.1e$e}" 1.1e$e } } set tcl_precision 0 for {set e -9} {$e < -4} {incr e} { test util-16.1.$::tcl_precision.$e {shortening of numbers} \ "expr {1.1e$e}" 1.1e$e } set tcl_precision 12 for {set e -9} {$e < -4} {incr e} { test util-16.1.$::tcl_precision.$e {8.4 compatible formatting of doubles} \ "expr {1.1e$e}" 1.1e[format %+03d $e] } foreach ::tcl_precision {0 12} { test util-16.1.$::tcl_precision.-4 {shortening of numbers} \ {expr {1.1e-4}} \ 0.00011 test util-16.1.$::tcl_precision.-3 {shortening of numbers} \ {expr {1.1e-3}} \ 0.0011 test util-16.1.$::tcl_precision.-2 {shortening of numbers} \ {expr {1.1e-2}} \ 0.011 test util-16.1.$::tcl_precision.-1 {shortening of numbers} \ {expr {1.1e-1}} \ 0.11 test util-16.1.$::tcl_precision.0 {shortening of numbers} \ {expr {1.1}} \ 1.1 for {set e 1} {$e < 17} {incr e} { test util-16.1.$::tcl_precision.$e {shortening of numbers} \ "expr {11[string repeat 0 [expr {$e-1}]].0}" \ 11[string repeat 0 [expr {$e-1}]].0 } for {set e 17} {$e < 309} {incr e} { test util-16.1.$::tcl_precision.$e {shortening of numbers} \ "expr {1.1e$e}" 1.1e+$e } } set tcl_precision 17 test util-16.1.17.-300 {8.4 compatible formatting of doubles} \ {expr {1e-300}} \ 1e-300 test util-16.1.17.-299 {8.4 compatible formatting of doubles} \ {expr {1e-299}} \ 9.9999999999999999e-300 test util-16.1.17.-298 {8.4 compatible formatting of doubles} \ {expr {1e-298}} \ 9.9999999999999991e-299 test util-16.1.17.-297 {8.4 compatible formatting of doubles} \ {expr {1e-297}} \ 1e-297 test util-16.1.17.-296 {8.4 compatible formatting of doubles} \ {expr {1e-296}} \ 1e-296 test util-16.1.17.-295 {8.4 compatible formatting of doubles} \ {expr {1e-295}} \ 1.0000000000000001e-295 test util-16.1.17.-294 {8.4 compatible formatting of doubles} \ {expr {1e-294}} \ 1e-294 test util-16.1.17.-293 {8.4 compatible formatting of doubles} \ {expr {1e-293}} \ 1.0000000000000001e-293 test util-16.1.17.-292 {8.4 compatible formatting of doubles} \ {expr {1e-292}} \ 1.0000000000000001e-292 test util-16.1.17.-291 {8.4 compatible formatting of doubles} \ {expr {1e-291}} \ 9.9999999999999996e-292 test util-16.1.17.-290 {8.4 compatible formatting of doubles} \ {expr {1e-290}} \ 1.0000000000000001e-290 test util-16.1.17.-289 {8.4 compatible formatting of doubles} \ {expr {1e-289}} \ 1e-289 test util-16.1.17.-288 {8.4 compatible formatting of doubles} \ {expr {1e-288}} \ 1.0000000000000001e-288 test util-16.1.17.-287 {8.4 compatible formatting of doubles} \ {expr {1e-287}} \ 1e-287 test util-16.1.17.-286 {8.4 compatible formatting of doubles} \ {expr {1e-286}} \ 1.0000000000000001e-286 test util-16.1.17.-285 {8.4 compatible formatting of doubles} \ {expr {1e-285}} \ 1.0000000000000001e-285 test util-16.1.17.-284 {8.4 compatible formatting of doubles} \ {expr {1e-284}} \ 1e-284 test util-16.1.17.-283 {8.4 compatible formatting of doubles} \ {expr {1e-283}} \ 9.9999999999999995e-284 test util-16.1.17.-282 {8.4 compatible formatting of doubles} \ {expr {1e-282}} \ 1e-282 test util-16.1.17.-281 {8.4 compatible formatting of doubles} \ {expr {1e-281}} \ 1e-281 test util-16.1.17.-280 {8.4 compatible formatting of doubles} \ {expr {1e-280}} \ 9.9999999999999996e-281 test util-16.1.17.-279 {8.4 compatible formatting of doubles} \ {expr {1e-279}} \ 1.0000000000000001e-279 test util-16.1.17.-278 {8.4 compatible formatting of doubles} \ {expr {1e-278}} \ 9.9999999999999994e-279 test util-16.1.17.-277 {8.4 compatible formatting of doubles} \ {expr {1e-277}} \ 9.9999999999999997e-278 test util-16.1.17.-276 {8.4 compatible formatting of doubles} \ {expr {1e-276}} \ 1.0000000000000001e-276 test util-16.1.17.-275 {8.4 compatible formatting of doubles} \ {expr {1e-275}} \ 9.9999999999999993e-276 test util-16.1.17.-274 {8.4 compatible formatting of doubles} \ {expr {1e-274}} \ 9.9999999999999997e-275 test util-16.1.17.-273 {8.4 compatible formatting of doubles} \ {expr {1e-273}} \ 1.0000000000000001e-273 test util-16.1.17.-272 {8.4 compatible formatting of doubles} \ {expr {1e-272}} \ 9.9999999999999993e-273 test util-16.1.17.-271 {8.4 compatible formatting of doubles} \ {expr {1e-271}} \ 9.9999999999999996e-272 test util-16.1.17.-270 {8.4 compatible formatting of doubles} \ {expr {1e-270}} \ 1e-270 test util-16.1.17.-269 {8.4 compatible formatting of doubles} \ {expr {1e-269}} \ 9.9999999999999996e-270 test util-16.1.17.-268 {8.4 compatible formatting of doubles} \ {expr {1e-268}} \ 9.9999999999999996e-269 test util-16.1.17.-267 {8.4 compatible formatting of doubles} \ {expr {1e-267}} \ 9.9999999999999998e-268 test util-16.1.17.-266 {8.4 compatible formatting of doubles} \ {expr {1e-266}} \ 9.9999999999999998e-267 test util-16.1.17.-265 {8.4 compatible formatting of doubles} \ {expr {1e-265}} \ 9.9999999999999998e-266 test util-16.1.17.-264 {8.4 compatible formatting of doubles} \ {expr {1e-264}} \ 1e-264 test util-16.1.17.-263 {8.4 compatible formatting of doubles} \ {expr {1e-263}} \ 1e-263 test util-16.1.17.-262 {8.4 compatible formatting of doubles} \ {expr {1e-262}} \ 1e-262 test util-16.1.17.-261 {8.4 compatible formatting of doubles} \ {expr {1e-261}} \ 9.9999999999999998e-262 test util-16.1.17.-260 {8.4 compatible formatting of doubles} \ {expr {1e-260}} \ 9.9999999999999996e-261 test util-16.1.17.-259 {8.4 compatible formatting of doubles} \ {expr {1e-259}} \ 1.0000000000000001e-259 test util-16.1.17.-258 {8.4 compatible formatting of doubles} \ {expr {1e-258}} \ 9.9999999999999995e-259 test util-16.1.17.-257 {8.4 compatible formatting of doubles} \ {expr {1e-257}} \ 9.9999999999999998e-258 test util-16.1.17.-256 {8.4 compatible formatting of doubles} \ {expr {1e-256}} \ 9.9999999999999998e-257 test util-16.1.17.-255 {8.4 compatible formatting of doubles} \ {expr {1e-255}} \ 1e-255 test util-16.1.17.-254 {8.4 compatible formatting of doubles} \ {expr {1e-254}} \ 9.9999999999999991e-255 test util-16.1.17.-253 {8.4 compatible formatting of doubles} \ {expr {1e-253}} \ 1.0000000000000001e-253 test util-16.1.17.-252 {8.4 compatible formatting of doubles} \ {expr {1e-252}} \ 9.9999999999999994e-253 test util-16.1.17.-251 {8.4 compatible formatting of doubles} \ {expr {1e-251}} \ 1e-251 test util-16.1.17.-250 {8.4 compatible formatting of doubles} \ {expr {1e-250}} \ 1.0000000000000001e-250 test util-16.1.17.-249 {8.4 compatible formatting of doubles} \ {expr {1e-249}} \ 1.0000000000000001e-249 test util-16.1.17.-248 {8.4 compatible formatting of doubles} \ {expr {1e-248}} \ 9.9999999999999998e-249 test util-16.1.17.-247 {8.4 compatible formatting of doubles} \ {expr {1e-247}} \ 1e-247 test util-16.1.17.-246 {8.4 compatible formatting of doubles} \ {expr {1e-246}} \ 9.9999999999999996e-247 test util-16.1.17.-245 {8.4 compatible formatting of doubles} \ {expr {1e-245}} \ 9.9999999999999993e-246 test util-16.1.17.-244 {8.4 compatible formatting of doubles} \ {expr {1e-244}} \ 9.9999999999999993e-245 test util-16.1.17.-243 {8.4 compatible formatting of doubles} \ {expr {1e-243}} \ 1e-243 test util-16.1.17.-242 {8.4 compatible formatting of doubles} \ {expr {1e-242}} \ 9.9999999999999997e-243 test util-16.1.17.-241 {8.4 compatible formatting of doubles} \ {expr {1e-241}} \ 9.9999999999999997e-242 test util-16.1.17.-240 {8.4 compatible formatting of doubles} \ {expr {1e-240}} \ 9.9999999999999997e-241 test util-16.1.17.-239 {8.4 compatible formatting of doubles} \ {expr {1e-239}} \ 1.0000000000000001e-239 test util-16.1.17.-238 {8.4 compatible formatting of doubles} \ {expr {1e-238}} \ 9.9999999999999999e-239 test util-16.1.17.-237 {8.4 compatible formatting of doubles} \ {expr {1e-237}} \ 9.9999999999999999e-238 test util-16.1.17.-236 {8.4 compatible formatting of doubles} \ {expr {1e-236}} \ 1e-236 test util-16.1.17.-235 {8.4 compatible formatting of doubles} \ {expr {1e-235}} \ 9.9999999999999996e-236 test util-16.1.17.-234 {8.4 compatible formatting of doubles} \ {expr {1e-234}} \ 9.9999999999999996e-235 test util-16.1.17.-233 {8.4 compatible formatting of doubles} \ {expr {1e-233}} \ 9.9999999999999996e-234 test util-16.1.17.-232 {8.4 compatible formatting of doubles} \ {expr {1e-232}} \ 1e-232 test util-16.1.17.-231 {8.4 compatible formatting of doubles} \ {expr {1e-231}} \ 9.9999999999999999e-232 test util-16.1.17.-230 {8.4 compatible formatting of doubles} \ {expr {1e-230}} \ 1e-230 test util-16.1.17.-229 {8.4 compatible formatting of doubles} \ {expr {1e-229}} \ 1.0000000000000001e-229 test util-16.1.17.-228 {8.4 compatible formatting of doubles} \ {expr {1e-228}} \ 1e-228 test util-16.1.17.-227 {8.4 compatible formatting of doubles} \ {expr {1e-227}} \ 9.9999999999999994e-228 test util-16.1.17.-226 {8.4 compatible formatting of doubles} \ {expr {1e-226}} \ 9.9999999999999992e-227 test util-16.1.17.-225 {8.4 compatible formatting of doubles} \ {expr {1e-225}} \ 9.9999999999999996e-226 test util-16.1.17.-224 {8.4 compatible formatting of doubles} \ {expr {1e-224}} \ 1e-224 test util-16.1.17.-223 {8.4 compatible formatting of doubles} \ {expr {1e-223}} \ 9.9999999999999997e-224 test util-16.1.17.-222 {8.4 compatible formatting of doubles} \ {expr {1e-222}} \ 1e-222 test util-16.1.17.-221 {8.4 compatible formatting of doubles} \ {expr {1e-221}} \ 1e-221 test util-16.1.17.-220 {8.4 compatible formatting of doubles} \ {expr {1e-220}} \ 9.9999999999999999e-221 test util-16.1.17.-219 {8.4 compatible formatting of doubles} \ {expr {1e-219}} \ 1e-219 test util-16.1.17.-218 {8.4 compatible formatting of doubles} \ {expr {1e-218}} \ 1e-218 test util-16.1.17.-217 {8.4 compatible formatting of doubles} \ {expr {1e-217}} \ 1.0000000000000001e-217 test util-16.1.17.-216 {8.4 compatible formatting of doubles} \ {expr {1e-216}} \ 1e-216 test util-16.1.17.-215 {8.4 compatible formatting of doubles} \ {expr {1e-215}} \ 1e-215 test util-16.1.17.-214 {8.4 compatible formatting of doubles} \ {expr {1e-214}} \ 9.9999999999999991e-215 test util-16.1.17.-213 {8.4 compatible formatting of doubles} \ {expr {1e-213}} \ 9.9999999999999995e-214 test util-16.1.17.-212 {8.4 compatible formatting of doubles} \ {expr {1e-212}} \ 9.9999999999999995e-213 test util-16.1.17.-211 {8.4 compatible formatting of doubles} \ {expr {1e-211}} \ 1.0000000000000001e-211 test util-16.1.17.-210 {8.4 compatible formatting of doubles} \ {expr {1e-210}} \ 1e-210 test util-16.1.17.-209 {8.4 compatible formatting of doubles} \ {expr {1e-209}} \ 1e-209 test util-16.1.17.-208 {8.4 compatible formatting of doubles} \ {expr {1e-208}} \ 1.0000000000000001e-208 test util-16.1.17.-207 {8.4 compatible formatting of doubles} \ {expr {1e-207}} \ 9.9999999999999993e-208 test util-16.1.17.-206 {8.4 compatible formatting of doubles} \ {expr {1e-206}} \ 1e-206 test util-16.1.17.-205 {8.4 compatible formatting of doubles} \ {expr {1e-205}} \ 1e-205 test util-16.1.17.-204 {8.4 compatible formatting of doubles} \ {expr {1e-204}} \ 1e-204 test util-16.1.17.-203 {8.4 compatible formatting of doubles} \ {expr {1e-203}} \ 1e-203 test util-16.1.17.-202 {8.4 compatible formatting of doubles} \ {expr {1e-202}} \ 1e-202 test util-16.1.17.-201 {8.4 compatible formatting of doubles} \ {expr {1e-201}} \ 9.9999999999999995e-202 test util-16.1.17.-200 {8.4 compatible formatting of doubles} \ {expr {1e-200}} \ 9.9999999999999998e-201 test util-16.1.17.-199 {8.4 compatible formatting of doubles} \ {expr {1e-199}} \ 9.9999999999999998e-200 test util-16.1.17.-198 {8.4 compatible formatting of doubles} \ {expr {1e-198}} \ 9.9999999999999991e-199 test util-16.1.17.-197 {8.4 compatible formatting of doubles} \ {expr {1e-197}} \ 9.9999999999999999e-198 test util-16.1.17.-196 {8.4 compatible formatting of doubles} \ {expr {1e-196}} \ 1e-196 test util-16.1.17.-195 {8.4 compatible formatting of doubles} \ {expr {1e-195}} \ 1.0000000000000001e-195 test util-16.1.17.-194 {8.4 compatible formatting of doubles} \ {expr {1e-194}} \ 1e-194 test util-16.1.17.-193 {8.4 compatible formatting of doubles} \ {expr {1e-193}} \ 1e-193 test util-16.1.17.-192 {8.4 compatible formatting of doubles} \ {expr {1e-192}} \ 1.0000000000000001e-192 test util-16.1.17.-191 {8.4 compatible formatting of doubles} \ {expr {1e-191}} \ 1e-191 test util-16.1.17.-190 {8.4 compatible formatting of doubles} \ {expr {1e-190}} \ 1e-190 test util-16.1.17.-189 {8.4 compatible formatting of doubles} \ {expr {1e-189}} \ 1.0000000000000001e-189 test util-16.1.17.-188 {8.4 compatible formatting of doubles} \ {expr {1e-188}} \ 9.9999999999999995e-189 test util-16.1.17.-187 {8.4 compatible formatting of doubles} \ {expr {1e-187}} \ 1e-187 test util-16.1.17.-186 {8.4 compatible formatting of doubles} \ {expr {1e-186}} \ 9.9999999999999991e-187 test util-16.1.17.-185 {8.4 compatible formatting of doubles} \ {expr {1e-185}} \ 9.9999999999999999e-186 test util-16.1.17.-184 {8.4 compatible formatting of doubles} \ {expr {1e-184}} \ 1.0000000000000001e-184 test util-16.1.17.-183 {8.4 compatible formatting of doubles} \ {expr {1e-183}} \ 1e-183 test util-16.1.17.-182 {8.4 compatible formatting of doubles} \ {expr {1e-182}} \ 1e-182 test util-16.1.17.-181 {8.4 compatible formatting of doubles} \ {expr {1e-181}} \ 1e-181 test util-16.1.17.-180 {8.4 compatible formatting of doubles} \ {expr {1e-180}} \ 1e-180 test util-16.1.17.-179 {8.4 compatible formatting of doubles} \ {expr {1e-179}} \ 1e-179 test util-16.1.17.-178 {8.4 compatible formatting of doubles} \ {expr {1e-178}} \ 9.9999999999999995e-179 test util-16.1.17.-177 {8.4 compatible formatting of doubles} \ {expr {1e-177}} \ 9.9999999999999995e-178 test util-16.1.17.-176 {8.4 compatible formatting of doubles} \ {expr {1e-176}} \ 1e-176 test util-16.1.17.-175 {8.4 compatible formatting of doubles} \ {expr {1e-175}} \ 1e-175 test util-16.1.17.-174 {8.4 compatible formatting of doubles} \ {expr {1e-174}} \ 1e-174 test util-16.1.17.-173 {8.4 compatible formatting of doubles} \ {expr {1e-173}} \ 1e-173 test util-16.1.17.-172 {8.4 compatible formatting of doubles} \ {expr {1e-172}} \ 1e-172 test util-16.1.17.-171 {8.4 compatible formatting of doubles} \ {expr {1e-171}} \ 9.9999999999999998e-172 test util-16.1.17.-170 {8.4 compatible formatting of doubles} \ {expr {1e-170}} \ 9.9999999999999998e-171 test util-16.1.17.-169 {8.4 compatible formatting of doubles} \ {expr {1e-169}} \ 1e-169 test util-16.1.17.-168 {8.4 compatible formatting of doubles} \ {expr {1e-168}} \ 1e-168 test util-16.1.17.-167 {8.4 compatible formatting of doubles} \ {expr {1e-167}} \ 1e-167 test util-16.1.17.-166 {8.4 compatible formatting of doubles} \ {expr {1e-166}} \ 1e-166 test util-16.1.17.-165 {8.4 compatible formatting of doubles} \ {expr {1e-165}} \ 1e-165 test util-16.1.17.-164 {8.4 compatible formatting of doubles} \ {expr {1e-164}} \ 9.9999999999999996e-165 test util-16.1.17.-163 {8.4 compatible formatting of doubles} \ {expr {1e-163}} \ 9.9999999999999992e-164 test util-16.1.17.-162 {8.4 compatible formatting of doubles} \ {expr {1e-162}} \ 9.9999999999999995e-163 test util-16.1.17.-161 {8.4 compatible formatting of doubles} \ {expr {1e-161}} \ 1e-161 test util-16.1.17.-160 {8.4 compatible formatting of doubles} \ {expr {1e-160}} \ 9.9999999999999999e-161 test util-16.1.17.-159 {8.4 compatible formatting of doubles} \ {expr {1e-159}} \ 9.9999999999999999e-160 test util-16.1.17.-158 {8.4 compatible formatting of doubles} \ {expr {1e-158}} \ 1.0000000000000001e-158 test util-16.1.17.-157 {8.4 compatible formatting of doubles} \ {expr {1e-157}} \ 9.9999999999999994e-158 test util-16.1.17.-156 {8.4 compatible formatting of doubles} \ {expr {1e-156}} \ 1e-156 test util-16.1.17.-155 {8.4 compatible formatting of doubles} \ {expr {1e-155}} \ 1e-155 test util-16.1.17.-154 {8.4 compatible formatting of doubles} \ {expr {1e-154}} \ 9.9999999999999997e-155 test util-16.1.17.-153 {8.4 compatible formatting of doubles} \ {expr {1e-153}} \ 1e-153 test util-16.1.17.-152 {8.4 compatible formatting of doubles} \ {expr {1e-152}} \ 1.0000000000000001e-152 test util-16.1.17.-151 {8.4 compatible formatting of doubles} \ {expr {1e-151}} \ 9.9999999999999994e-152 test util-16.1.17.-150 {8.4 compatible formatting of doubles} \ {expr {1e-150}} \ 1e-150 test util-16.1.17.-149 {8.4 compatible formatting of doubles} \ {expr {1e-149}} \ 9.9999999999999998e-150 test util-16.1.17.-148 {8.4 compatible formatting of doubles} \ {expr {1e-148}} \ 9.9999999999999994e-149 test util-16.1.17.-147 {8.4 compatible formatting of doubles} \ {expr {1e-147}} \ 9.9999999999999997e-148 test util-16.1.17.-146 {8.4 compatible formatting of doubles} \ {expr {1e-146}} \ 1e-146 test util-16.1.17.-145 {8.4 compatible formatting of doubles} \ {expr {1e-145}} \ 9.9999999999999991e-146 test util-16.1.17.-144 {8.4 compatible formatting of doubles} \ {expr {1e-144}} \ 9.9999999999999995e-145 test util-16.1.17.-143 {8.4 compatible formatting of doubles} \ {expr {1e-143}} \ 9.9999999999999995e-144 test util-16.1.17.-142 {8.4 compatible formatting of doubles} \ {expr {1e-142}} \ 1e-142 test util-16.1.17.-141 {8.4 compatible formatting of doubles} \ {expr {1e-141}} \ 1e-141 test util-16.1.17.-140 {8.4 compatible formatting of doubles} \ {expr {1e-140}} \ 9.9999999999999998e-141 test util-16.1.17.-139 {8.4 compatible formatting of doubles} \ {expr {1e-139}} \ 1e-139 test util-16.1.17.-138 {8.4 compatible formatting of doubles} \ {expr {1e-138}} \ 1.0000000000000001e-138 test util-16.1.17.-137 {8.4 compatible formatting of doubles} \ {expr {1e-137}} \ 9.9999999999999998e-138 test util-16.1.17.-136 {8.4 compatible formatting of doubles} \ {expr {1e-136}} \ 1e-136 test util-16.1.17.-135 {8.4 compatible formatting of doubles} \ {expr {1e-135}} \ 1e-135 test util-16.1.17.-134 {8.4 compatible formatting of doubles} \ {expr {1e-134}} \ 1e-134 test util-16.1.17.-133 {8.4 compatible formatting of doubles} \ {expr {1e-133}} \ 1.0000000000000001e-133 test util-16.1.17.-132 {8.4 compatible formatting of doubles} \ {expr {1e-132}} \ 9.9999999999999999e-133 test util-16.1.17.-131 {8.4 compatible formatting of doubles} \ {expr {1e-131}} \ 9.9999999999999999e-132 test util-16.1.17.-130 {8.4 compatible formatting of doubles} \ {expr {1e-130}} \ 1.0000000000000001e-130 test util-16.1.17.-129 {8.4 compatible formatting of doubles} \ {expr {1e-129}} \ 9.9999999999999993e-130 test util-16.1.17.-128 {8.4 compatible formatting of doubles} \ {expr {1e-128}} \ 1.0000000000000001e-128 test util-16.1.17.-127 {8.4 compatible formatting of doubles} \ {expr {1e-127}} \ 1e-127 test util-16.1.17.-126 {8.4 compatible formatting of doubles} \ {expr {1e-126}} \ 9.9999999999999995e-127 test util-16.1.17.-125 {8.4 compatible formatting of doubles} \ {expr {1e-125}} \ 1e-125 test util-16.1.17.-124 {8.4 compatible formatting of doubles} \ {expr {1e-124}} \ 9.9999999999999993e-125 test util-16.1.17.-123 {8.4 compatible formatting of doubles} \ {expr {1e-123}} \ 1.0000000000000001e-123 test util-16.1.17.-122 {8.4 compatible formatting of doubles} \ {expr {1e-122}} \ 1.0000000000000001e-122 test util-16.1.17.-121 {8.4 compatible formatting of doubles} \ {expr {1e-121}} \ 9.9999999999999998e-122 test util-16.1.17.-120 {8.4 compatible formatting of doubles} \ {expr {1e-120}} \ 9.9999999999999998e-121 test util-16.1.17.-119 {8.4 compatible formatting of doubles} \ {expr {1e-119}} \ 1e-119 test util-16.1.17.-118 {8.4 compatible formatting of doubles} \ {expr {1e-118}} \ 9.9999999999999999e-119 test util-16.1.17.-117 {8.4 compatible formatting of doubles} \ {expr {1e-117}} \ 1e-117 test util-16.1.17.-116 {8.4 compatible formatting of doubles} \ {expr {1e-116}} \ 9.9999999999999999e-117 test util-16.1.17.-115 {8.4 compatible formatting of doubles} \ {expr {1e-115}} \ 1.0000000000000001e-115 test util-16.1.17.-114 {8.4 compatible formatting of doubles} \ {expr {1e-114}} \ 1.0000000000000001e-114 test util-16.1.17.-113 {8.4 compatible formatting of doubles} \ {expr {1e-113}} \ 9.9999999999999998e-114 test util-16.1.17.-112 {8.4 compatible formatting of doubles} \ {expr {1e-112}} \ 9.9999999999999995e-113 test util-16.1.17.-111 {8.4 compatible formatting of doubles} \ {expr {1e-111}} \ 1.0000000000000001e-111 test util-16.1.17.-110 {8.4 compatible formatting of doubles} \ {expr {1e-110}} \ 1.0000000000000001e-110 test util-16.1.17.-109 {8.4 compatible formatting of doubles} \ {expr {1e-109}} \ 9.9999999999999999e-110 test util-16.1.17.-108 {8.4 compatible formatting of doubles} \ {expr {1e-108}} \ 1e-108 test util-16.1.17.-107 {8.4 compatible formatting of doubles} \ {expr {1e-107}} \ 1e-107 test util-16.1.17.-106 {8.4 compatible formatting of doubles} \ {expr {1e-106}} \ 9.9999999999999994e-107 test util-16.1.17.-105 {8.4 compatible formatting of doubles} \ {expr {1e-105}} \ 9.9999999999999997e-106 test util-16.1.17.-104 {8.4 compatible formatting of doubles} \ {expr {1e-104}} \ 9.9999999999999993e-105 test util-16.1.17.-103 {8.4 compatible formatting of doubles} \ {expr {1e-103}} \ 9.9999999999999996e-104 test util-16.1.17.-102 {8.4 compatible formatting of doubles} \ {expr {1e-102}} \ 9.9999999999999993e-103 test util-16.1.17.-101 {8.4 compatible formatting of doubles} \ {expr {1e-101}} \ 1.0000000000000001e-101 test util-16.1.17.-100 {8.4 compatible formatting of doubles} \ {expr {1e-100}} \ 1e-100 test util-16.1.17.-99 {8.4 compatible formatting of doubles} \ {expr {1e-99}} \ 1e-99 test util-16.1.17.-98 {8.4 compatible formatting of doubles} \ {expr {1e-98}} \ 9.9999999999999994e-99 test util-16.1.17.-97 {8.4 compatible formatting of doubles} \ {expr {1e-97}} \ 1e-97 test util-16.1.17.-96 {8.4 compatible formatting of doubles} \ {expr {1e-96}} \ 9.9999999999999991e-97 test util-16.1.17.-95 {8.4 compatible formatting of doubles} \ {expr {1e-95}} \ 9.9999999999999999e-96 test util-16.1.17.-94 {8.4 compatible formatting of doubles} \ {expr {1e-94}} \ 9.9999999999999996e-95 test util-16.1.17.-93 {8.4 compatible formatting of doubles} \ {expr {1e-93}} \ 9.999999999999999e-94 test util-16.1.17.-92 {8.4 compatible formatting of doubles} \ {expr {1e-92}} \ 9.9999999999999999e-93 test util-16.1.17.-91 {8.4 compatible formatting of doubles} \ {expr {1e-91}} \ 1e-91 test util-16.1.17.-90 {8.4 compatible formatting of doubles} \ {expr {1e-90}} \ 9.9999999999999999e-91 test util-16.1.17.-89 {8.4 compatible formatting of doubles} \ {expr {1e-89}} \ 1e-89 test util-16.1.17.-88 {8.4 compatible formatting of doubles} \ {expr {1e-88}} \ 9.9999999999999993e-89 test util-16.1.17.-87 {8.4 compatible formatting of doubles} \ {expr {1e-87}} \ 1e-87 test util-16.1.17.-86 {8.4 compatible formatting of doubles} \ {expr {1e-86}} \ 1.0000000000000001e-86 test util-16.1.17.-85 {8.4 compatible formatting of doubles} \ {expr {1e-85}} \ 9.9999999999999998e-86 test util-16.1.17.-84 {8.4 compatible formatting of doubles} \ {expr {1e-84}} \ 1e-84 test util-16.1.17.-83 {8.4 compatible formatting of doubles} \ {expr {1e-83}} \ 1e-83 test util-16.1.17.-82 {8.4 compatible formatting of doubles} \ {expr {1e-82}} \ 9.9999999999999996e-83 test util-16.1.17.-81 {8.4 compatible formatting of doubles} \ {expr {1e-81}} \ 9.9999999999999996e-82 test util-16.1.17.-80 {8.4 compatible formatting of doubles} \ {expr {1e-80}} \ 9.9999999999999996e-81 test util-16.1.17.-79 {8.4 compatible formatting of doubles} \ {expr {1e-79}} \ 1e-79 test util-16.1.17.-78 {8.4 compatible formatting of doubles} \ {expr {1e-78}} \ 1e-78 test util-16.1.17.-77 {8.4 compatible formatting of doubles} \ {expr {1e-77}} \ 9.9999999999999993e-78 test util-16.1.17.-76 {8.4 compatible formatting of doubles} \ {expr {1e-76}} \ 9.9999999999999993e-77 test util-16.1.17.-75 {8.4 compatible formatting of doubles} \ {expr {1e-75}} \ 9.9999999999999996e-76 test util-16.1.17.-74 {8.4 compatible formatting of doubles} \ {expr {1e-74}} \ 9.9999999999999996e-75 test util-16.1.17.-73 {8.4 compatible formatting of doubles} \ {expr {1e-73}} \ 1e-73 test util-16.1.17.-72 {8.4 compatible formatting of doubles} \ {expr {1e-72}} \ 9.9999999999999997e-73 test util-16.1.17.-71 {8.4 compatible formatting of doubles} \ {expr {1e-71}} \ 9.9999999999999992e-72 test util-16.1.17.-70 {8.4 compatible formatting of doubles} \ {expr {1e-70}} \ 1e-70 test util-16.1.17.-69 {8.4 compatible formatting of doubles} \ {expr {1e-69}} \ 9.9999999999999996e-70 test util-16.1.17.-68 {8.4 compatible formatting of doubles} \ {expr {1e-68}} \ 1.0000000000000001e-68 test util-16.1.17.-67 {8.4 compatible formatting of doubles} \ {expr {1e-67}} \ 9.9999999999999994e-68 test util-16.1.17.-66 {8.4 compatible formatting of doubles} \ {expr {1e-66}} \ 9.9999999999999998e-67 test util-16.1.17.-65 {8.4 compatible formatting of doubles} \ {expr {1e-65}} \ 9.9999999999999992e-66 test util-16.1.17.-64 {8.4 compatible formatting of doubles} \ {expr {1e-64}} \ 9.9999999999999997e-65 test util-16.1.17.-63 {8.4 compatible formatting of doubles} \ {expr {1e-63}} \ 1.0000000000000001e-63 test util-16.1.17.-62 {8.4 compatible formatting of doubles} \ {expr {1e-62}} \ 1e-62 test util-16.1.17.-61 {8.4 compatible formatting of doubles} \ {expr {1e-61}} \ 1e-61 test util-16.1.17.-60 {8.4 compatible formatting of doubles} \ {expr {1e-60}} \ 9.9999999999999997e-61 test util-16.1.17.-59 {8.4 compatible formatting of doubles} \ {expr {1e-59}} \ 1e-59 test util-16.1.17.-58 {8.4 compatible formatting of doubles} \ {expr {1e-58}} \ 1e-58 test util-16.1.17.-57 {8.4 compatible formatting of doubles} \ {expr {1e-57}} \ 9.9999999999999995e-58 test util-16.1.17.-56 {8.4 compatible formatting of doubles} \ {expr {1e-56}} \ 1e-56 test util-16.1.17.-55 {8.4 compatible formatting of doubles} \ {expr {1e-55}} \ 9.9999999999999999e-56 test util-16.1.17.-54 {8.4 compatible formatting of doubles} \ {expr {1e-54}} \ 1e-54 test util-16.1.17.-53 {8.4 compatible formatting of doubles} \ {expr {1e-53}} \ 1e-53 test util-16.1.17.-52 {8.4 compatible formatting of doubles} \ {expr {1e-52}} \ 1e-52 test util-16.1.17.-51 {8.4 compatible formatting of doubles} \ {expr {1e-51}} \ 1e-51 test util-16.1.17.-50 {8.4 compatible formatting of doubles} \ {expr {1e-50}} \ 1e-50 test util-16.1.17.-49 {8.4 compatible formatting of doubles} \ {expr {1e-49}} \ 9.9999999999999994e-50 test util-16.1.17.-48 {8.4 compatible formatting of doubles} \ {expr {1e-48}} \ 9.9999999999999997e-49 test util-16.1.17.-47 {8.4 compatible formatting of doubles} \ {expr {1e-47}} \ 9.9999999999999997e-48 test util-16.1.17.-46 {8.4 compatible formatting of doubles} \ {expr {1e-46}} \ 1e-46 test util-16.1.17.-45 {8.4 compatible formatting of doubles} \ {expr {1e-45}} \ 9.9999999999999998e-46 test util-16.1.17.-44 {8.4 compatible formatting of doubles} \ {expr {1e-44}} \ 9.9999999999999995e-45 test util-16.1.17.-43 {8.4 compatible formatting of doubles} \ {expr {1e-43}} \ 1.0000000000000001e-43 test util-16.1.17.-42 {8.4 compatible formatting of doubles} \ {expr {1e-42}} \ 1e-42 test util-16.1.17.-41 {8.4 compatible formatting of doubles} \ {expr {1e-41}} \ 1e-41 test util-16.1.17.-40 {8.4 compatible formatting of doubles} \ {expr {1e-40}} \ 9.9999999999999993e-41 test util-16.1.17.-39 {8.4 compatible formatting of doubles} \ {expr {1e-39}} \ 9.9999999999999993e-40 test util-16.1.17.-38 {8.4 compatible formatting of doubles} \ {expr {1e-38}} \ 9.9999999999999996e-39 test util-16.1.17.-37 {8.4 compatible formatting of doubles} \ {expr {1e-37}} \ 1.0000000000000001e-37 test util-16.1.17.-36 {8.4 compatible formatting of doubles} \ {expr {1e-36}} \ 9.9999999999999994e-37 test util-16.1.17.-35 {8.4 compatible formatting of doubles} \ {expr {1e-35}} \ 1e-35 test util-16.1.17.-34 {8.4 compatible formatting of doubles} \ {expr {1e-34}} \ 9.9999999999999993e-35 test util-16.1.17.-33 {8.4 compatible formatting of doubles} \ {expr {1e-33}} \ 1.0000000000000001e-33 test util-16.1.17.-32 {8.4 compatible formatting of doubles} \ {expr {1e-32}} \ 1.0000000000000001e-32 test util-16.1.17.-31 {8.4 compatible formatting of doubles} \ {expr {1e-31}} \ 1.0000000000000001e-31 test util-16.1.17.-30 {8.4 compatible formatting of doubles} \ {expr {1e-30}} \ 1.0000000000000001e-30 test util-16.1.17.-29 {8.4 compatible formatting of doubles} \ {expr {1e-29}} \ 9.9999999999999994e-30 test util-16.1.17.-28 {8.4 compatible formatting of doubles} \ {expr {1e-28}} \ 9.9999999999999997e-29 test util-16.1.17.-27 {8.4 compatible formatting of doubles} \ {expr {1e-27}} \ 1e-27 test util-16.1.17.-26 {8.4 compatible formatting of doubles} \ {expr {1e-26}} \ 1e-26 test util-16.1.17.-25 {8.4 compatible formatting of doubles} \ {expr {1e-25}} \ 1e-25 test util-16.1.17.-24 {8.4 compatible formatting of doubles} \ {expr {1e-24}} \ 9.9999999999999992e-25 test util-16.1.17.-23 {8.4 compatible formatting of doubles} \ {expr {1e-23}} \ 9.9999999999999996e-24 test util-16.1.17.-22 {8.4 compatible formatting of doubles} \ {expr {1e-22}} \ 1e-22 test util-16.1.17.-21 {8.4 compatible formatting of doubles} \ {expr {1e-21}} \ 9.9999999999999991e-22 test util-16.1.17.-20 {8.4 compatible formatting of doubles} \ {expr {1e-20}} \ 9.9999999999999995e-21 test util-16.1.17.-19 {8.4 compatible formatting of doubles} \ {expr {1e-19}} \ 9.9999999999999998e-20 test util-16.1.17.-18 {8.4 compatible formatting of doubles} \ {expr {1e-18}} \ 1.0000000000000001e-18 test util-16.1.17.-17 {8.4 compatible formatting of doubles} \ {expr {1e-17}} \ 1.0000000000000001e-17 test util-16.1.17.-16 {8.4 compatible formatting of doubles} \ {expr {1e-16}} \ 9.9999999999999998e-17 test util-16.1.17.-15 {8.4 compatible formatting of doubles} \ {expr {1e-15}} \ 1.0000000000000001e-15 test util-16.1.17.-14 {8.4 compatible formatting of doubles} \ {expr {1e-14}} \ 1e-14 test util-16.1.17.-13 {8.4 compatible formatting of doubles} \ {expr {1e-13}} \ 1e-13 test util-16.1.17.-12 {8.4 compatible formatting of doubles} \ {expr {1e-12}} \ 9.9999999999999998e-13 test util-16.1.17.-11 {8.4 compatible formatting of doubles} \ {expr {1e-11}} \ 9.9999999999999994e-12 test util-16.1.17.-10 {8.4 compatible formatting of doubles} \ {expr {1e-10}} \ 1e-10 test util-16.1.17.-9 {8.4 compatible formatting of doubles} \ {expr {1e-9}} \ 1.0000000000000001e-09 test util-16.1.17.-8 {8.4 compatible formatting of doubles} \ {expr {1e-8}} \ 1e-08 test util-16.1.17.-7 {8.4 compatible formatting of doubles} \ {expr {1e-7}} \ 9.9999999999999995e-08 test util-16.1.17.-6 {8.4 compatible formatting of doubles} \ {expr {1e-6}} \ 9.9999999999999995e-07 test util-16.1.17.-5 {8.4 compatible formatting of doubles} \ {expr {1e-5}} \ 1.0000000000000001e-05 test util-16.1.17.-4 {8.4 compatible formatting of doubles} \ {expr {1e-4}} \ 0.0001 test util-16.1.17.-3 {8.4 compatible formatting of doubles} \ {expr {1e-3}} \ 0.001 test util-16.1.17.-2 {8.4 compatible formatting of doubles} \ {expr {1e-2}} \ 0.01 test util-16.1.17.-1 {8.4 compatible formatting of doubles} \ {expr {1e-1}} \ 0.10000000000000001 test util-16.1.17.0 {8.4 compatible formatting of doubles} \ {expr {1e0}} \ 1.0 test util-16.1.17.1 {8.4 compatible formatting of doubles} \ {expr {1e1}} \ 10.0 test util-16.1.17.2 {8.4 compatible formatting of doubles} \ {expr {1e2}} \ 100.0 test util-16.1.17.3 {8.4 compatible formatting of doubles} \ {expr {1e3}} \ 1000.0 test util-16.1.17.4 {8.4 compatible formatting of doubles} \ {expr {1e4}} \ 10000.0 test util-16.1.17.5 {8.4 compatible formatting of doubles} \ {expr {1e5}} \ 100000.0 test util-16.1.17.6 {8.4 compatible formatting of doubles} \ {expr {1e6}} \ 1000000.0 test util-16.1.17.7 {8.4 compatible formatting of doubles} \ {expr {1e7}} \ 10000000.0 test util-16.1.17.8 {8.4 compatible formatting of doubles} \ {expr {1e8}} \ 100000000.0 test util-16.1.17.9 {8.4 compatible formatting of doubles} \ {expr {1e9}} \ 1000000000.0 test util-16.1.17.10 {8.4 compatible formatting of doubles} \ {expr {1e10}} \ 10000000000.0 test util-16.1.17.11 {8.4 compatible formatting of doubles} \ {expr {1e11}} \ 100000000000.0 test util-16.1.17.12 {8.4 compatible formatting of doubles} \ {expr {1e12}} \ 1000000000000.0 test util-16.1.17.13 {8.4 compatible formatting of doubles} \ {expr {1e13}} \ 10000000000000.0 test util-16.1.17.14 {8.4 compatible formatting of doubles} \ {expr {1e14}} \ 100000000000000.0 test util-16.1.17.15 {8.4 compatible formatting of doubles} \ {expr {1e15}} \ 1000000000000000.0 test util-16.1.17.16 {8.4 compatible formatting of doubles} \ {expr {1e16}} \ 10000000000000000.0 test util-16.1.17.17 {8.4 compatible formatting of doubles} \ {expr {1e17}} \ 1e+17 test util-16.1.17.18 {8.4 compatible formatting of doubles} \ {expr {1e18}} \ 1e+18 test util-16.1.17.19 {8.4 compatible formatting of doubles} \ {expr {1e19}} \ 1e+19 test util-16.1.17.20 {8.4 compatible formatting of doubles} \ {expr {1e20}} \ 1e+20 test util-16.1.17.21 {8.4 compatible formatting of doubles} \ {expr {1e21}} \ 1e+21 test util-16.1.17.22 {8.4 compatible formatting of doubles} \ {expr {1e22}} \ 1e+22 test util-16.1.17.23 {8.4 compatible formatting of doubles} \ {expr {1e23}} \ 9.9999999999999992e+22 test util-16.1.17.24 {8.4 compatible formatting of doubles} \ {expr {1e24}} \ 9.9999999999999998e+23 test util-16.1.17.25 {8.4 compatible formatting of doubles} \ {expr {1e25}} \ 1.0000000000000001e+25 test util-16.1.17.26 {8.4 compatible formatting of doubles} \ {expr {1e26}} \ 1e+26 test util-16.1.17.27 {8.4 compatible formatting of doubles} \ {expr {1e27}} \ 1e+27 test util-16.1.17.28 {8.4 compatible formatting of doubles} \ {expr {1e28}} \ 9.9999999999999996e+27 test util-16.1.17.29 {8.4 compatible formatting of doubles} \ {expr {1e29}} \ 9.9999999999999991e+28 test util-16.1.17.30 {8.4 compatible formatting of doubles} \ {expr {1e30}} \ 1e+30 test util-16.1.17.31 {8.4 compatible formatting of doubles} \ {expr {1e31}} \ 9.9999999999999996e+30 test util-16.1.17.32 {8.4 compatible formatting of doubles} \ {expr {1e32}} \ 1.0000000000000001e+32 test util-16.1.17.33 {8.4 compatible formatting of doubles} \ {expr {1e33}} \ 9.9999999999999995e+32 test util-16.1.17.34 {8.4 compatible formatting of doubles} \ {expr {1e34}} \ 9.9999999999999995e+33 test util-16.1.17.35 {8.4 compatible formatting of doubles} \ {expr {1e35}} \ 9.9999999999999997e+34 test util-16.1.17.36 {8.4 compatible formatting of doubles} \ {expr {1e36}} \ 1e+36 test util-16.1.17.37 {8.4 compatible formatting of doubles} \ {expr {1e37}} \ 9.9999999999999995e+36 test util-16.1.17.38 {8.4 compatible formatting of doubles} \ {expr {1e38}} \ 9.9999999999999998e+37 test util-16.1.17.39 {8.4 compatible formatting of doubles} \ {expr {1e39}} \ 9.9999999999999994e+38 test util-16.1.17.40 {8.4 compatible formatting of doubles} \ {expr {1e40}} \ 1e+40 test util-16.1.17.41 {8.4 compatible formatting of doubles} \ {expr {1e41}} \ 1e+41 test util-16.1.17.42 {8.4 compatible formatting of doubles} \ {expr {1e42}} \ 1e+42 test util-16.1.17.43 {8.4 compatible formatting of doubles} \ {expr {1e43}} \ 1e+43 test util-16.1.17.44 {8.4 compatible formatting of doubles} \ {expr {1e44}} \ 1.0000000000000001e+44 test util-16.1.17.45 {8.4 compatible formatting of doubles} \ {expr {1e45}} \ 9.9999999999999993e+44 test util-16.1.17.46 {8.4 compatible formatting of doubles} \ {expr {1e46}} \ 9.9999999999999999e+45 test util-16.1.17.47 {8.4 compatible formatting of doubles} \ {expr {1e47}} \ 1e+47 test util-16.1.17.48 {8.4 compatible formatting of doubles} \ {expr {1e48}} \ 1e+48 test util-16.1.17.49 {8.4 compatible formatting of doubles} \ {expr {1e49}} \ 9.9999999999999995e+48 test util-16.1.17.50 {8.4 compatible formatting of doubles} \ {expr {1e50}} \ 1.0000000000000001e+50 test util-16.1.17.51 {8.4 compatible formatting of doubles} \ {expr {1e51}} \ 9.9999999999999999e+50 test util-16.1.17.52 {8.4 compatible formatting of doubles} \ {expr {1e52}} \ 9.9999999999999999e+51 test util-16.1.17.53 {8.4 compatible formatting of doubles} \ {expr {1e53}} \ 9.9999999999999999e+52 test util-16.1.17.54 {8.4 compatible formatting of doubles} \ {expr {1e54}} \ 1.0000000000000001e+54 test util-16.1.17.55 {8.4 compatible formatting of doubles} \ {expr {1e55}} \ 1e+55 test util-16.1.17.56 {8.4 compatible formatting of doubles} \ {expr {1e56}} \ 1.0000000000000001e+56 test util-16.1.17.57 {8.4 compatible formatting of doubles} \ {expr {1e57}} \ 1e+57 test util-16.1.17.58 {8.4 compatible formatting of doubles} \ {expr {1e58}} \ 9.9999999999999994e+57 test util-16.1.17.59 {8.4 compatible formatting of doubles} \ {expr {1e59}} \ 9.9999999999999997e+58 test util-16.1.17.60 {8.4 compatible formatting of doubles} \ {expr {1e60}} \ 9.9999999999999995e+59 test util-16.1.17.61 {8.4 compatible formatting of doubles} \ {expr {1e61}} \ 9.9999999999999995e+60 test util-16.1.17.62 {8.4 compatible formatting of doubles} \ {expr {1e62}} \ 1e+62 test util-16.1.17.63 {8.4 compatible formatting of doubles} \ {expr {1e63}} \ 1.0000000000000001e+63 test util-16.1.17.64 {8.4 compatible formatting of doubles} \ {expr {1e64}} \ 1e+64 test util-16.1.17.65 {8.4 compatible formatting of doubles} \ {expr {1e65}} \ 9.9999999999999999e+64 test util-16.1.17.66 {8.4 compatible formatting of doubles} \ {expr {1e66}} \ 9.9999999999999995e+65 test util-16.1.17.67 {8.4 compatible formatting of doubles} \ {expr {1e67}} \ 9.9999999999999998e+66 test util-16.1.17.68 {8.4 compatible formatting of doubles} \ {expr {1e68}} \ 9.9999999999999995e+67 test util-16.1.17.69 {8.4 compatible formatting of doubles} \ {expr {1e69}} \ 1.0000000000000001e+69 test util-16.1.17.70 {8.4 compatible formatting of doubles} \ {expr {1e70}} \ 1.0000000000000001e+70 test util-16.1.17.71 {8.4 compatible formatting of doubles} \ {expr {1e71}} \ 1e+71 test util-16.1.17.72 {8.4 compatible formatting of doubles} \ {expr {1e72}} \ 9.9999999999999994e+71 test util-16.1.17.73 {8.4 compatible formatting of doubles} \ {expr {1e73}} \ 9.9999999999999998e+72 test util-16.1.17.74 {8.4 compatible formatting of doubles} \ {expr {1e74}} \ 9.9999999999999995e+73 test util-16.1.17.75 {8.4 compatible formatting of doubles} \ {expr {1e75}} \ 9.9999999999999993e+74 test util-16.1.17.76 {8.4 compatible formatting of doubles} \ {expr {1e76}} \ 1e+76 test util-16.1.17.77 {8.4 compatible formatting of doubles} \ {expr {1e77}} \ 9.9999999999999998e+76 test util-16.1.17.78 {8.4 compatible formatting of doubles} \ {expr {1e78}} \ 1e+78 test util-16.1.17.79 {8.4 compatible formatting of doubles} \ {expr {1e79}} \ 9.9999999999999997e+78 test util-16.1.17.80 {8.4 compatible formatting of doubles} \ {expr {1e80}} \ 1e+80 test util-16.1.17.81 {8.4 compatible formatting of doubles} \ {expr {1e81}} \ 9.9999999999999992e+80 test util-16.1.17.82 {8.4 compatible formatting of doubles} \ {expr {1e82}} \ 9.9999999999999996e+81 test util-16.1.17.83 {8.4 compatible formatting of doubles} \ {expr {1e83}} \ 1e+83 test util-16.1.17.84 {8.4 compatible formatting of doubles} \ {expr {1e84}} \ 1.0000000000000001e+84 test util-16.1.17.85 {8.4 compatible formatting of doubles} \ {expr {1e85}} \ 1e+85 test util-16.1.17.86 {8.4 compatible formatting of doubles} \ {expr {1e86}} \ 1e+86 test util-16.1.17.87 {8.4 compatible formatting of doubles} \ {expr {1e87}} \ 9.9999999999999996e+86 test util-16.1.17.88 {8.4 compatible formatting of doubles} \ {expr {1e88}} \ 9.9999999999999996e+87 test util-16.1.17.89 {8.4 compatible formatting of doubles} \ {expr {1e89}} \ 9.9999999999999999e+88 test util-16.1.17.90 {8.4 compatible formatting of doubles} \ {expr {1e90}} \ 9.9999999999999997e+89 test util-16.1.17.91 {8.4 compatible formatting of doubles} \ {expr {1e91}} \ 1.0000000000000001e+91 test util-16.1.17.92 {8.4 compatible formatting of doubles} \ {expr {1e92}} \ 1e+92 test util-16.1.17.93 {8.4 compatible formatting of doubles} \ {expr {1e93}} \ 1e+93 test util-16.1.17.94 {8.4 compatible formatting of doubles} \ {expr {1e94}} \ 1e+94 test util-16.1.17.95 {8.4 compatible formatting of doubles} \ {expr {1e95}} \ 1e+95 test util-16.1.17.96 {8.4 compatible formatting of doubles} \ {expr {1e96}} \ 1e+96 test util-16.1.17.97 {8.4 compatible formatting of doubles} \ {expr {1e97}} \ 1.0000000000000001e+97 test util-16.1.17.98 {8.4 compatible formatting of doubles} \ {expr {1e98}} \ 1e+98 test util-16.1.17.99 {8.4 compatible formatting of doubles} \ {expr {1e99}} \ 9.9999999999999997e+98 test util-16.1.17.100 {8.4 compatible formatting of doubles} \ {expr {1e100}} \ 1e+100 test util-16.1.17.101 {8.4 compatible formatting of doubles} \ {expr {1e101}} \ 9.9999999999999998e+100 test util-16.1.17.102 {8.4 compatible formatting of doubles} \ {expr {1e102}} \ 9.9999999999999998e+101 test util-16.1.17.103 {8.4 compatible formatting of doubles} \ {expr {1e103}} \ 1e+103 test util-16.1.17.104 {8.4 compatible formatting of doubles} \ {expr {1e104}} \ 1e+104 test util-16.1.17.105 {8.4 compatible formatting of doubles} \ {expr {1e105}} \ 9.9999999999999994e+104 test util-16.1.17.106 {8.4 compatible formatting of doubles} \ {expr {1e106}} \ 1.0000000000000001e+106 test util-16.1.17.107 {8.4 compatible formatting of doubles} \ {expr {1e107}} \ 9.9999999999999997e+106 test util-16.1.17.108 {8.4 compatible formatting of doubles} \ {expr {1e108}} \ 1e+108 test util-16.1.17.109 {8.4 compatible formatting of doubles} \ {expr {1e109}} \ 9.9999999999999998e+108 test util-16.1.17.110 {8.4 compatible formatting of doubles} \ {expr {1e110}} \ 1e+110 test util-16.1.17.111 {8.4 compatible formatting of doubles} \ {expr {1e111}} \ 9.9999999999999996e+110 test util-16.1.17.112 {8.4 compatible formatting of doubles} \ {expr {1e112}} \ 9.9999999999999993e+111 test util-16.1.17.113 {8.4 compatible formatting of doubles} \ {expr {1e113}} \ 1e+113 test util-16.1.17.114 {8.4 compatible formatting of doubles} \ {expr {1e114}} \ 1e+114 test util-16.1.17.115 {8.4 compatible formatting of doubles} \ {expr {1e115}} \ 1e+115 test util-16.1.17.116 {8.4 compatible formatting of doubles} \ {expr {1e116}} \ 1e+116 test util-16.1.17.117 {8.4 compatible formatting of doubles} \ {expr {1e117}} \ 1.0000000000000001e+117 test util-16.1.17.118 {8.4 compatible formatting of doubles} \ {expr {1e118}} \ 9.9999999999999997e+117 test util-16.1.17.119 {8.4 compatible formatting of doubles} \ {expr {1e119}} \ 9.9999999999999994e+118 test util-16.1.17.120 {8.4 compatible formatting of doubles} \ {expr {1e120}} \ 9.9999999999999998e+119 test util-16.1.17.121 {8.4 compatible formatting of doubles} \ {expr {1e121}} \ 1e+121 test util-16.1.17.122 {8.4 compatible formatting of doubles} \ {expr {1e122}} \ 1e+122 test util-16.1.17.123 {8.4 compatible formatting of doubles} \ {expr {1e123}} \ 9.9999999999999998e+122 test util-16.1.17.124 {8.4 compatible formatting of doubles} \ {expr {1e124}} \ 9.9999999999999995e+123 test util-16.1.17.125 {8.4 compatible formatting of doubles} \ {expr {1e125}} \ 9.9999999999999992e+124 test util-16.1.17.126 {8.4 compatible formatting of doubles} \ {expr {1e126}} \ 9.9999999999999992e+125 test util-16.1.17.127 {8.4 compatible formatting of doubles} \ {expr {1e127}} \ 9.9999999999999995e+126 test util-16.1.17.128 {8.4 compatible formatting of doubles} \ {expr {1e128}} \ 1.0000000000000001e+128 test util-16.1.17.129 {8.4 compatible formatting of doubles} \ {expr {1e129}} \ 1e+129 test util-16.1.17.130 {8.4 compatible formatting of doubles} \ {expr {1e130}} \ 1.0000000000000001e+130 test util-16.1.17.131 {8.4 compatible formatting of doubles} \ {expr {1e131}} \ 9.9999999999999991e+130 test util-16.1.17.132 {8.4 compatible formatting of doubles} \ {expr {1e132}} \ 9.9999999999999999e+131 test util-16.1.17.133 {8.4 compatible formatting of doubles} \ {expr {1e133}} \ 1e+133 test util-16.1.17.134 {8.4 compatible formatting of doubles} \ {expr {1e134}} \ 9.9999999999999992e+133 test util-16.1.17.135 {8.4 compatible formatting of doubles} \ {expr {1e135}} \ 9.9999999999999996e+134 test util-16.1.17.136 {8.4 compatible formatting of doubles} \ {expr {1e136}} \ 1.0000000000000001e+136 test util-16.1.17.137 {8.4 compatible formatting of doubles} \ {expr {1e137}} \ 1e+137 test util-16.1.17.138 {8.4 compatible formatting of doubles} \ {expr {1e138}} \ 1e+138 test util-16.1.17.139 {8.4 compatible formatting of doubles} \ {expr {1e139}} \ 1e+139 test util-16.1.17.140 {8.4 compatible formatting of doubles} \ {expr {1e140}} \ 1.0000000000000001e+140 test util-16.1.17.141 {8.4 compatible formatting of doubles} \ {expr {1e141}} \ 1e+141 test util-16.1.17.142 {8.4 compatible formatting of doubles} \ {expr {1e142}} \ 1.0000000000000001e+142 test util-16.1.17.143 {8.4 compatible formatting of doubles} \ {expr {1e143}} \ 1e+143 test util-16.1.17.144 {8.4 compatible formatting of doubles} \ {expr {1e144}} \ 1e+144 test util-16.1.17.145 {8.4 compatible formatting of doubles} \ {expr {1e145}} \ 9.9999999999999999e+144 test util-16.1.17.146 {8.4 compatible formatting of doubles} \ {expr {1e146}} \ 9.9999999999999993e+145 test util-16.1.17.147 {8.4 compatible formatting of doubles} \ {expr {1e147}} \ 9.9999999999999998e+146 test util-16.1.17.148 {8.4 compatible formatting of doubles} \ {expr {1e148}} \ 1e+148 test util-16.1.17.149 {8.4 compatible formatting of doubles} \ {expr {1e149}} \ 1e+149 test util-16.1.17.150 {8.4 compatible formatting of doubles} \ {expr {1e150}} \ 9.9999999999999998e+149 test util-16.1.17.151 {8.4 compatible formatting of doubles} \ {expr {1e151}} \ 1e+151 test util-16.1.17.152 {8.4 compatible formatting of doubles} \ {expr {1e152}} \ 1e+152 test util-16.1.17.153 {8.4 compatible formatting of doubles} \ {expr {1e153}} \ 1e+153 test util-16.1.17.154 {8.4 compatible formatting of doubles} \ {expr {1e154}} \ 1e+154 test util-16.1.17.155 {8.4 compatible formatting of doubles} \ {expr {1e155}} \ 1e+155 test util-16.1.17.156 {8.4 compatible formatting of doubles} \ {expr {1e156}} \ 9.9999999999999998e+155 test util-16.1.17.157 {8.4 compatible formatting of doubles} \ {expr {1e157}} \ 9.9999999999999998e+156 test util-16.1.17.158 {8.4 compatible formatting of doubles} \ {expr {1e158}} \ 9.9999999999999995e+157 test util-16.1.17.159 {8.4 compatible formatting of doubles} \ {expr {1e159}} \ 9.9999999999999993e+158 test util-16.1.17.160 {8.4 compatible formatting of doubles} \ {expr {1e160}} \ 1e+160 test util-16.1.17.161 {8.4 compatible formatting of doubles} \ {expr {1e161}} \ 1e+161 test util-16.1.17.162 {8.4 compatible formatting of doubles} \ {expr {1e162}} \ 9.9999999999999994e+161 test util-16.1.17.163 {8.4 compatible formatting of doubles} \ {expr {1e163}} \ 9.9999999999999994e+162 test util-16.1.17.164 {8.4 compatible formatting of doubles} \ {expr {1e164}} \ 1e+164 test util-16.1.17.165 {8.4 compatible formatting of doubles} \ {expr {1e165}} \ 9.999999999999999e+164 test util-16.1.17.166 {8.4 compatible formatting of doubles} \ {expr {1e166}} \ 9.9999999999999994e+165 test util-16.1.17.167 {8.4 compatible formatting of doubles} \ {expr {1e167}} \ 1e+167 test util-16.1.17.168 {8.4 compatible formatting of doubles} \ {expr {1e168}} \ 9.9999999999999993e+167 test util-16.1.17.169 {8.4 compatible formatting of doubles} \ {expr {1e169}} \ 9.9999999999999993e+168 test util-16.1.17.170 {8.4 compatible formatting of doubles} \ {expr {1e170}} \ 1e+170 test util-16.1.17.171 {8.4 compatible formatting of doubles} \ {expr {1e171}} \ 9.9999999999999995e+170 test util-16.1.17.172 {8.4 compatible formatting of doubles} \ {expr {1e172}} \ 1.0000000000000001e+172 test util-16.1.17.173 {8.4 compatible formatting of doubles} \ {expr {1e173}} \ 1e+173 test util-16.1.17.174 {8.4 compatible formatting of doubles} \ {expr {1e174}} \ 1.0000000000000001e+174 test util-16.1.17.175 {8.4 compatible formatting of doubles} \ {expr {1e175}} \ 9.9999999999999994e+174 test util-16.1.17.176 {8.4 compatible formatting of doubles} \ {expr {1e176}} \ 1e+176 test util-16.1.17.177 {8.4 compatible formatting of doubles} \ {expr {1e177}} \ 1e+177 test util-16.1.17.178 {8.4 compatible formatting of doubles} \ {expr {1e178}} \ 1.0000000000000001e+178 test util-16.1.17.179 {8.4 compatible formatting of doubles} \ {expr {1e179}} \ 9.9999999999999998e+178 test util-16.1.17.180 {8.4 compatible formatting of doubles} \ {expr {1e180}} \ 1e+180 test util-16.1.17.181 {8.4 compatible formatting of doubles} \ {expr {1e181}} \ 9.9999999999999992e+180 test util-16.1.17.182 {8.4 compatible formatting of doubles} \ {expr {1e182}} \ 1.0000000000000001e+182 test util-16.1.17.183 {8.4 compatible formatting of doubles} \ {expr {1e183}} \ 9.9999999999999995e+182 test util-16.1.17.184 {8.4 compatible formatting of doubles} \ {expr {1e184}} \ 1e+184 test util-16.1.17.185 {8.4 compatible formatting of doubles} \ {expr {1e185}} \ 9.9999999999999998e+184 test util-16.1.17.186 {8.4 compatible formatting of doubles} \ {expr {1e186}} \ 9.9999999999999998e+185 test util-16.1.17.187 {8.4 compatible formatting of doubles} \ {expr {1e187}} \ 9.9999999999999991e+186 test util-16.1.17.188 {8.4 compatible formatting of doubles} \ {expr {1e188}} \ 1e+188 test util-16.1.17.189 {8.4 compatible formatting of doubles} \ {expr {1e189}} \ 1e+189 test util-16.1.17.190 {8.4 compatible formatting of doubles} \ {expr {1e190}} \ 1.0000000000000001e+190 test util-16.1.17.191 {8.4 compatible formatting of doubles} \ {expr {1e191}} \ 1.0000000000000001e+191 test util-16.1.17.192 {8.4 compatible formatting of doubles} \ {expr {1e192}} \ 1e+192 test util-16.1.17.193 {8.4 compatible formatting of doubles} \ {expr {1e193}} \ 1.0000000000000001e+193 test util-16.1.17.194 {8.4 compatible formatting of doubles} \ {expr {1e194}} \ 9.9999999999999994e+193 test util-16.1.17.195 {8.4 compatible formatting of doubles} \ {expr {1e195}} \ 9.9999999999999998e+194 test util-16.1.17.196 {8.4 compatible formatting of doubles} \ {expr {1e196}} \ 9.9999999999999995e+195 test util-16.1.17.197 {8.4 compatible formatting of doubles} \ {expr {1e197}} \ 9.9999999999999995e+196 test util-16.1.17.198 {8.4 compatible formatting of doubles} \ {expr {1e198}} \ 1e+198 test util-16.1.17.199 {8.4 compatible formatting of doubles} \ {expr {1e199}} \ 1.0000000000000001e+199 test util-16.1.17.200 {8.4 compatible formatting of doubles} \ {expr {1e200}} \ 9.9999999999999997e+199 test util-16.1.17.201 {8.4 compatible formatting of doubles} \ {expr {1e201}} \ 1e+201 test util-16.1.17.202 {8.4 compatible formatting of doubles} \ {expr {1e202}} \ 9.999999999999999e+201 test util-16.1.17.203 {8.4 compatible formatting of doubles} \ {expr {1e203}} \ 9.9999999999999999e+202 test util-16.1.17.204 {8.4 compatible formatting of doubles} \ {expr {1e204}} \ 9.9999999999999999e+203 test util-16.1.17.205 {8.4 compatible formatting of doubles} \ {expr {1e205}} \ 1e+205 test util-16.1.17.206 {8.4 compatible formatting of doubles} \ {expr {1e206}} \ 1e+206 test util-16.1.17.207 {8.4 compatible formatting of doubles} \ {expr {1e207}} \ 1e+207 test util-16.1.17.208 {8.4 compatible formatting of doubles} \ {expr {1e208}} \ 9.9999999999999998e+207 test util-16.1.17.209 {8.4 compatible formatting of doubles} \ {expr {1e209}} \ 1.0000000000000001e+209 test util-16.1.17.210 {8.4 compatible formatting of doubles} \ {expr {1e210}} \ 9.9999999999999993e+209 test util-16.1.17.211 {8.4 compatible formatting of doubles} \ {expr {1e211}} \ 9.9999999999999996e+210 test util-16.1.17.212 {8.4 compatible formatting of doubles} \ {expr {1e212}} \ 9.9999999999999991e+211 test util-16.1.17.213 {8.4 compatible formatting of doubles} \ {expr {1e213}} \ 9.9999999999999998e+212 test util-16.1.17.214 {8.4 compatible formatting of doubles} \ {expr {1e214}} \ 9.9999999999999995e+213 test util-16.1.17.215 {8.4 compatible formatting of doubles} \ {expr {1e215}} \ 9.9999999999999991e+214 test util-16.1.17.216 {8.4 compatible formatting of doubles} \ {expr {1e216}} \ 1e+216 test util-16.1.17.217 {8.4 compatible formatting of doubles} \ {expr {1e217}} \ 9.9999999999999996e+216 test util-16.1.17.218 {8.4 compatible formatting of doubles} \ {expr {1e218}} \ 1.0000000000000001e+218 test util-16.1.17.219 {8.4 compatible formatting of doubles} \ {expr {1e219}} \ 9.9999999999999997e+218 test util-16.1.17.220 {8.4 compatible formatting of doubles} \ {expr {1e220}} \ 1e+220 test util-16.1.17.221 {8.4 compatible formatting of doubles} \ {expr {1e221}} \ 1e+221 test util-16.1.17.222 {8.4 compatible formatting of doubles} \ {expr {1e222}} \ 1e+222 test util-16.1.17.223 {8.4 compatible formatting of doubles} \ {expr {1e223}} \ 1e+223 test util-16.1.17.224 {8.4 compatible formatting of doubles} \ {expr {1e224}} \ 9.9999999999999997e+223 test util-16.1.17.225 {8.4 compatible formatting of doubles} \ {expr {1e225}} \ 9.9999999999999993e+224 test util-16.1.17.226 {8.4 compatible formatting of doubles} \ {expr {1e226}} \ 9.9999999999999996e+225 test util-16.1.17.227 {8.4 compatible formatting of doubles} \ {expr {1e227}} \ 1.0000000000000001e+227 test util-16.1.17.228 {8.4 compatible formatting of doubles} \ {expr {1e228}} \ 9.9999999999999992e+227 test util-16.1.17.229 {8.4 compatible formatting of doubles} \ {expr {1e229}} \ 9.9999999999999999e+228 test util-16.1.17.230 {8.4 compatible formatting of doubles} \ {expr {1e230}} \ 1.0000000000000001e+230 test util-16.1.17.231 {8.4 compatible formatting of doubles} \ {expr {1e231}} \ 1.0000000000000001e+231 test util-16.1.17.232 {8.4 compatible formatting of doubles} \ {expr {1e232}} \ 1.0000000000000001e+232 test util-16.1.17.233 {8.4 compatible formatting of doubles} \ {expr {1e233}} \ 9.9999999999999997e+232 test util-16.1.17.234 {8.4 compatible formatting of doubles} \ {expr {1e234}} \ 1e+234 test util-16.1.17.235 {8.4 compatible formatting of doubles} \ {expr {1e235}} \ 1.0000000000000001e+235 test util-16.1.17.236 {8.4 compatible formatting of doubles} \ {expr {1e236}} \ 1.0000000000000001e+236 test util-16.1.17.237 {8.4 compatible formatting of doubles} \ {expr {1e237}} \ 9.9999999999999994e+236 test util-16.1.17.238 {8.4 compatible formatting of doubles} \ {expr {1e238}} \ 1e+238 test util-16.1.17.239 {8.4 compatible formatting of doubles} \ {expr {1e239}} \ 9.9999999999999999e+238 test util-16.1.17.240 {8.4 compatible formatting of doubles} \ {expr {1e240}} \ 1e+240 test util-16.1.17.241 {8.4 compatible formatting of doubles} \ {expr {1e241}} \ 1.0000000000000001e+241 test util-16.1.17.242 {8.4 compatible formatting of doubles} \ {expr {1e242}} \ 1.0000000000000001e+242 test util-16.1.17.243 {8.4 compatible formatting of doubles} \ {expr {1e243}} \ 1.0000000000000001e+243 test util-16.1.17.244 {8.4 compatible formatting of doubles} \ {expr {1e244}} \ 1.0000000000000001e+244 test util-16.1.17.245 {8.4 compatible formatting of doubles} \ {expr {1e245}} \ 1e+245 test util-16.1.17.246 {8.4 compatible formatting of doubles} \ {expr {1e246}} \ 1.0000000000000001e+246 test util-16.1.17.247 {8.4 compatible formatting of doubles} \ {expr {1e247}} \ 9.9999999999999995e+246 test util-16.1.17.248 {8.4 compatible formatting of doubles} \ {expr {1e248}} \ 1e+248 test util-16.1.17.249 {8.4 compatible formatting of doubles} \ {expr {1e249}} \ 9.9999999999999992e+248 test util-16.1.17.250 {8.4 compatible formatting of doubles} \ {expr {1e250}} \ 9.9999999999999992e+249 test util-16.1.17.251 {8.4 compatible formatting of doubles} \ {expr {1e251}} \ 1e+251 test util-16.1.17.252 {8.4 compatible formatting of doubles} \ {expr {1e252}} \ 1.0000000000000001e+252 test util-16.1.17.253 {8.4 compatible formatting of doubles} \ {expr {1e253}} \ 9.9999999999999994e+252 test util-16.1.17.254 {8.4 compatible formatting of doubles} \ {expr {1e254}} \ 9.9999999999999994e+253 test util-16.1.17.255 {8.4 compatible formatting of doubles} \ {expr {1e255}} \ 9.9999999999999999e+254 test util-16.1.17.256 {8.4 compatible formatting of doubles} \ {expr {1e256}} \ 1e+256 test util-16.1.17.257 {8.4 compatible formatting of doubles} \ {expr {1e257}} \ 1e+257 test util-16.1.17.258 {8.4 compatible formatting of doubles} \ {expr {1e258}} \ 1.0000000000000001e+258 test util-16.1.17.259 {8.4 compatible formatting of doubles} \ {expr {1e259}} \ 9.9999999999999993e+258 test util-16.1.17.260 {8.4 compatible formatting of doubles} \ {expr {1e260}} \ 1.0000000000000001e+260 test util-16.1.17.261 {8.4 compatible formatting of doubles} \ {expr {1e261}} \ 9.9999999999999993e+260 test util-16.1.17.262 {8.4 compatible formatting of doubles} \ {expr {1e262}} \ 1e+262 test util-16.1.17.263 {8.4 compatible formatting of doubles} \ {expr {1e263}} \ 1e+263 test util-16.1.17.264 {8.4 compatible formatting of doubles} \ {expr {1e264}} \ 1e+264 test util-16.1.17.265 {8.4 compatible formatting of doubles} \ {expr {1e265}} \ 1.0000000000000001e+265 test util-16.1.17.266 {8.4 compatible formatting of doubles} \ {expr {1e266}} \ 1e+266 test util-16.1.17.267 {8.4 compatible formatting of doubles} \ {expr {1e267}} \ 9.9999999999999997e+266 test util-16.1.17.268 {8.4 compatible formatting of doubles} \ {expr {1e268}} \ 9.9999999999999997e+267 test util-16.1.17.269 {8.4 compatible formatting of doubles} \ {expr {1e269}} \ 1e+269 test util-16.1.17.270 {8.4 compatible formatting of doubles} \ {expr {1e270}} \ 1e+270 test util-16.1.17.271 {8.4 compatible formatting of doubles} \ {expr {1e271}} \ 9.9999999999999995e+270 test util-16.1.17.272 {8.4 compatible formatting of doubles} \ {expr {1e272}} \ 1.0000000000000001e+272 test util-16.1.17.273 {8.4 compatible formatting of doubles} \ {expr {1e273}} \ 9.9999999999999995e+272 test util-16.1.17.274 {8.4 compatible formatting of doubles} \ {expr {1e274}} \ 9.9999999999999992e+273 test util-16.1.17.275 {8.4 compatible formatting of doubles} \ {expr {1e275}} \ 9.9999999999999996e+274 test util-16.1.17.276 {8.4 compatible formatting of doubles} \ {expr {1e276}} \ 1.0000000000000001e+276 test util-16.1.17.277 {8.4 compatible formatting of doubles} \ {expr {1e277}} \ 1e+277 test util-16.1.17.278 {8.4 compatible formatting of doubles} \ {expr {1e278}} \ 9.9999999999999996e+277 test util-16.1.17.279 {8.4 compatible formatting of doubles} \ {expr {1e279}} \ 1.0000000000000001e+279 test util-16.1.17.280 {8.4 compatible formatting of doubles} \ {expr {1e280}} \ 1e+280 test util-16.1.17.281 {8.4 compatible formatting of doubles} \ {expr {1e281}} \ 1e+281 test util-16.1.17.282 {8.4 compatible formatting of doubles} \ {expr {1e282}} \ 1e+282 test util-16.1.17.283 {8.4 compatible formatting of doubles} \ {expr {1e283}} \ 9.9999999999999996e+282 test util-16.1.17.284 {8.4 compatible formatting of doubles} \ {expr {1e284}} \ 1.0000000000000001e+284 test util-16.1.17.285 {8.4 compatible formatting of doubles} \ {expr {1e285}} \ 9.9999999999999998e+284 test util-16.1.17.286 {8.4 compatible formatting of doubles} \ {expr {1e286}} \ 1e+286 test util-16.1.17.287 {8.4 compatible formatting of doubles} \ {expr {1e287}} \ 1.0000000000000001e+287 test util-16.1.17.288 {8.4 compatible formatting of doubles} \ {expr {1e288}} \ 1e+288 test util-16.1.17.289 {8.4 compatible formatting of doubles} \ {expr {1e289}} \ 1.0000000000000001e+289 test util-16.1.17.290 {8.4 compatible formatting of doubles} \ {expr {1e290}} \ 1.0000000000000001e+290 test util-16.1.17.291 {8.4 compatible formatting of doubles} \ {expr {1e291}} \ 9.9999999999999996e+290 test util-16.1.17.292 {8.4 compatible formatting of doubles} \ {expr {1e292}} \ 1e+292 test util-16.1.17.293 {8.4 compatible formatting of doubles} \ {expr {1e293}} \ 9.9999999999999992e+292 test util-16.1.17.294 {8.4 compatible formatting of doubles} \ {expr {1e294}} \ 1.0000000000000001e+294 test util-16.1.17.295 {8.4 compatible formatting of doubles} \ {expr {1e295}} \ 9.9999999999999998e+294 test util-16.1.17.296 {8.4 compatible formatting of doubles} \ {expr {1e296}} \ 9.9999999999999998e+295 test util-16.1.17.297 {8.4 compatible formatting of doubles} \ {expr {1e297}} \ 1e+297 test util-16.1.17.298 {8.4 compatible formatting of doubles} \ {expr {1e298}} \ 9.9999999999999996e+297 test util-16.1.17.299 {8.4 compatible formatting of doubles} \ {expr {1e299}} \ 1.0000000000000001e+299 test util-16.1.17.300 {8.4 compatible formatting of doubles} \ {expr {1e300}} \ 1.0000000000000001e+300 test util-16.1.17.301 {8.4 compatible formatting of doubles} \ {expr {1e301}} \ 1.0000000000000001e+301 test util-16.1.17.302 {8.4 compatible formatting of doubles} \ {expr {1e302}} \ 1.0000000000000001e+302 test util-16.1.17.303 {8.4 compatible formatting of doubles} \ {expr {1e303}} \ 1e+303 test util-16.1.17.304 {8.4 compatible formatting of doubles} \ {expr {1e304}} \ 9.9999999999999994e+303 test util-16.1.17.305 {8.4 compatible formatting of doubles} \ {expr {1e305}} \ 9.9999999999999994e+304 test util-16.1.17.306 {8.4 compatible formatting of doubles} \ {expr {1e306}} \ 1e+306 test util-16.1.17.307 {8.4 compatible formatting of doubles} \ {expr {1e307}} \ 9.9999999999999999e+306 test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} { set r {} foreach {input} { 0x1ffffffffffffc000 0x1ffffffffffffc800 0x1ffffffffffffd000 0x1ffffffffffffd800 0x1ffffffffffffe000 0x1ffffffffffffe800 0x1fffffffffffff000 0x1fffffffffffff800 } { binary scan [binary format q [expr {double($input)}]] wu x lappend r [format %#llx $x] binary scan [binary format q [expr {double(-$input)}]] wu x lappend r [format %#llx $x] } set r } [list {*}{ 0x43fffffffffffffc 0xc3fffffffffffffc 0x43fffffffffffffc 0xc3fffffffffffffc 0x43fffffffffffffd 0xc3fffffffffffffd 0x43fffffffffffffe 0xc3fffffffffffffe 0x43fffffffffffffe 0xc3fffffffffffffe 0x43fffffffffffffe 0xc3fffffffffffffe 0x43ffffffffffffff 0xc3ffffffffffffff 0x4400000000000000 0xc400000000000000 }] test util-18.1 {Tcl_ObjPrintf} {testprint longIs32bit} { testprint %ld [expr {2**32-1}] } {-1} test util-18.2 {Tcl_ObjPrintf} {testprint longIs64bit} { testprint %ld [expr {2**32-1}] } {4294967295} test util-18.3 {Tcl_ObjPrintf} {testprint} { testprint %lu [expr {2**32-1}] } {4294967295} test util-18.4 {Tcl_ObjPrintf} {testprint} { testprint %ld [expr {2**64-1}] } {-1} test util-18.5 {Tcl_ObjPrintf} {testprint longIs32bit} { testprint %lu [expr {2**64-1}] } {4294967295} test util-18.6 {Tcl_ObjPrintf} {testprint longIs64bit} { testprint %lu [expr {2**64-1}] } {18446744073709551615} set ::tcl_precision $saved_precision # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/var.test0000644000175000017500000010117414554262142014501 0ustar sergeisergei# This file contains tests for the tclVar.c source file. Tests appear in the # same order as the C code that they test. The set of tests is currently # incomplete since it currently includes only new tests for code changed for # the addition of Tcl namespaces. Other variable-related tests appear in # several other test files including namespace.test, set.test, trace.test, and # upvar.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testupvar [llength [info commands testupvar]] testConstraint testgetvarfullname [llength [info commands testgetvarfullname]] testConstraint testsetnoerr [llength [info commands testsetnoerr]] testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { return [lindex [split [memory info] \n] 3 3] } proc leaktest {script {iterations 3}} { set end [getbytes] for {set i 0} {$i < $iterations} {incr i} { uplevel 1 $script set tmp $end set end [getbytes] } return [expr {$end - $tmp}] } } catch {rename p ""} catch {namespace delete test_ns_var} catch {unset xx} catch {unset x} catch {unset y} catch {unset i} catch {unset a} catch {unset arr} test var-1.1 {TclLookupVar, Array handling} -setup { catch {unset a} } -body { set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd set i 10 set arr(foo) 37 list [$x i] $i [$x arr(foo)] $arr(foo) } -result {11 11 38 38} set ::x "global value" namespace eval test_ns_var { variable x "namespace value" } test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} { namespace eval test_ns_var { proc p {} { global x ;# specifies TCL_GLOBAL_ONLY to get global x return $x } } test_ns_var::p } {global value} test var-1.3 {TclLookupVar, TCL_NAMESPACE_ONLY implies namespace var} { namespace eval test_ns_var { proc q {} { variable x ;# specifies TCL_NAMESPACE_ONLY to get namespace x return $x } } test_ns_var::q } {namespace value} test var-1.4 {TclLookupVar, no active call frame implies global namespace var} { set x } {global value} test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies namespace var} { namespace eval test_ns_var {set x} } {namespace value} test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} { namespace eval test_ns_var {set ::x} } {global value} test var-1.7 {TclLookupVar, error finding namespace var} -body { set a:::b } -returnCodes error -result {can't read "a:::b": no such variable} test var-1.8 {TclLookupVar, error finding namespace var} -body { set ::foobarfoo } -returnCodes error -result {can't read "::foobarfoo": no such variable} test var-1.9 {TclLookupVar, create new namespace var} { namespace eval test_ns_var { set v hello } } {hello} test var-1.10 {TclLookupVar, create new namespace var} -setup { catch {unset y} } -body { namespace eval test_ns_var { set ::y 789 } set y } -result {789} test var-1.11 {TclLookupVar, error creating new namespace var} -body { namespace eval test_ns_var { set ::test_ns_var::foo::bar 314159 } } -returnCodes error -result {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist} test var-1.12 {TclLookupVar, error creating new namespace var} -body { namespace eval test_ns_var { set ::test_ns_var::foo:: 1997 } } -returnCodes error -result {can't set "::test_ns_var::foo::": parent namespace doesn't exist} test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} { catch {unset aNeWnAmEiNnS} namespace eval test_ns_var { namespace eval test_ns_var2::test_ns_var3 { set aNeWnAmEiNnS 77777 } # namespace which builds a name by traversing nsPtr chain to :: namespace which -variable test_ns_var2::test_ns_var3::aNeWnAmEiNnS } } {::test_ns_var::test_ns_var2::test_ns_var3::aNeWnAmEiNnS} test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of var names} { namespace eval test_ns_var { set : 123 set v: 456 set x:y: 789 list [set :] [set v:] [set x:y:] \ ${:} ${v:} ${x:y:} \ [expr {":" in [info vars]}] \ [expr {"v:" in [info vars]}] \ [expr {"x:y:" in [info vars]}] } } {123 456 789 123 456 789 1 1 1} test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} { namespace eval test_ns_var { variable foo 2 } proc p {} { variable ::test_ns_var::foo lappend result [catch {set foo} msg] $msg namespace delete ::test_ns_var lappend result [catch {set foo 3} msg] $msg lappend result [catch {set foo(3) 3} msg] $msg } p } {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}} test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} { namespace eval test_ns_var { variable result namespace eval subns { variable foo 2 } upvar 0 subns::foo foo lappend result [catch {set foo} msg] $msg namespace delete subns lappend result [catch {set foo 3} msg] $msg lappend result [catch {set foo(3) 3} msg] $msg namespace delete [namespace current] set result } } {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}} test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} { namespace eval test_ns_var { variable result proc p {} { array set x {1 2 3 4} upvar 0 x(1) foo lappend result [catch {set foo} msg] $msg unset x lappend result [catch {set foo 3} msg] $msg } set result [p] namespace delete [namespace current] set result } } {0 2 1 {can't set "foo": upvar refers to element in deleted array}} test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup { unset -nocomplain test_ns_var::x } -body { namespace eval test_ns_var { variable result {} variable x array set x {1 2 3 4} upvar 0 x(1) foo lappend result [catch {set foo} msg] $msg unset x lappend result [catch {set foo 3} msg] $msg namespace delete [namespace current] set result } } -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}} test var-1.19 {TclLookupVar, right error message when parsing variable name} -body { [format set] thisvar(doesntexist) } -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable} test var-1.20 {TclLookupVar, regression on utf-8 variable names} -setup { proc p [list \u20ac \xe4] {info vars} } -body { # test variable with non-ascii name is available (euro and a-uml chars here): list \ [p 1 2] \ [apply [list [list \u20ac \xe4] {info vars}] 1 2] \ [apply [list [list [list \u20ac \u20ac] [list \xe4 \xe4]] {info vars}]] \ } -cleanup { rename p {} } -result [lrepeat 3 [list \u20ac \xe4]] test var-1.21 {TclLookupVar, regression on utf-8 variable names} -setup { proc p [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]} } -body { # test variable with non-ascii name (and default) is resolvable (euro and a-uml chars here): list \ [p] \ [apply [list [list \u20ac \xe4] {list [set \u20ac] [set \xe4]}] v\u20ac v\xe4] \ [apply [list [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]}]] \ } -cleanup { rename p {} } -result [lrepeat 3 [list v\u20ac v\xe4]] test var-2.1 {Tcl_LappendObjCmd, create var if new} { catch {unset x} lappend x 1 2 } {1 2} test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} -setup { catch {unset x} } -body { set x 1997 proc p {} { global x ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x return $x } p } -result {1997} test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} { namespace eval test_ns_var { catch {unset v} variable v 1998 proc p {} { variable v ;# TCL_NAMESPACE_ONLY specified for other var x return $v } p } } {1998} test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup { catch {unset a} } -constraints testupvar -body { set a 123321 proc p {} { # create global xx linked to global a testupvar 1 a {} xx global } list [p] $xx [set xx 789] $a } -result {{} 123321 789 789} test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup { catch {unset a} } -constraints testupvar -body { set a 456 namespace eval test_ns_var { catch {unset ::test_ns_var::vv} proc p {} { # create namespace var vv linked to global a testupvar 1 a {} vv namespace } p } list $test_ns_var::vv [set test_ns_var::vv 123] $a } -result {456 123 123} test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup { catch {unset aaaaa} catch {unset xxxxx} } -body { set aaaaa 77777 upvar #0 aaaaa xxxxx list [set xxxxx] [set aaaaa] } -result {77777 77777} test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} -setup { catch {unset a} } -body { set a 121212 namespace eval test_ns_var { upvar ::a vvv set vvv } } -result {121212} test var-3.7 {MakeUpvar, my var has ::s} -setup { catch {unset a} } -body { set a 789789 upvar #0 a test_ns_var::lnk namespace eval test_ns_var { set lnk } } -result {789789} test var-3.8 {MakeUpvar, my var already exists in global ns} -setup { upvar #0 aaaaa xxxxx catch {unset aaaaa} catch {unset xxxxx} } -body { set aaaaa 456654 set xxxxx hello upvar #0 aaaaa xxxxx set xxxxx } -result {hello} test var-3.9 {MakeUpvar, my var has invalid ns name} -setup { catch {unset aaaaa} } -returnCodes error -body { set aaaaa 789789 upvar #0 aaaaa test_ns_fred::lnk } -cleanup { unset ::aaaaa } -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist} test var-3.10 {MakeUpvar, between namespaces} -body { namespace eval {} { variable bar 0 namespace eval foo upvar bar bar set foo::bar 1 list $bar $foo::bar } } -result {1 1} test var-3.11 {MakeUpvar, my var looks like array elem} -setup { catch {unset aaaaa} } -returnCodes error -body { set aaaaa 789789 upvar #0 aaaaa foo(bar) } -result {bad variable name "foo(bar)": can't create a scalar variable that looks like an array element} test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname { catch {unset a} set a 123 testgetvarfullname a global } ::a test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname { namespace eval test_ns_var { variable george testgetvarfullname george namespace } } ::test_ns_var::george test var-4.3 {Tcl_GetVariableName, variable can't be array element} -setup { catch {unset a} } -constraints testgetvarfullname -body { set a(1) foo testgetvarfullname a(1) global } -returnCodes error -result {unknown variable "a(1)"} test var-5.1 {Tcl_GetVariableFullName, global variable} -setup { catch {unset a} } -body { set a bar namespace which -variable a } -result {::a} test var-5.2 {Tcl_GetVariableFullName, namespace variable} { namespace eval test_ns_var { variable martha namespace which -variable martha } } {::test_ns_var::martha} test var-5.3 {Tcl_GetVariableFullName, namespace variable} -setup { namespace eval test_ns_var {variable martha} } -body { namespace which -variable test_ns_var::martha } -result {::test_ns_var::martha} test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} { namespace eval test_ns_var { variable boeing 777 } apply {{} { global ::test_ns_var::boeing set boeing }} } {777} test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} { namespace eval test_ns_var { namespace eval test_ns_nested { variable java java } proc p {} { global ::test_ns_var::test_ns_nested::java set java } } test_ns_var::p } {java} test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} { namespace eval ::test_ns_var::test_ns_nested {} set ::test_ns_var::test_ns_nested:: 24 apply {{} { global ::test_ns_var::test_ns_nested:: set {} }} } {24} test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} { # Test for Tcl Bug 480176 set :v broken proc p {} { global :v set :v fixed } p set :v } {fixed} test var-6.5 {Tcl_GlobalObjCmd, no-op case (TIP 323)} { global } {} test var-6.6 {Tcl_GlobalObjCmd, no-op case (TIP 323)} { proc p {} { global } p } {} test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} -setup { catch {namespace delete test_ns_var} } -body { namespace eval test_ns_var { variable one 1 } list [info vars test_ns_var::*] [set test_ns_var::one] } -result {::test_ns_var::one 1} test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} { set two 2222222 namespace eval test_ns_var { variable two } list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg } {0 1 {can't read "test_ns_var::two": no such variable}} test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup { catch {namespace delete test_ns_var} namespace eval test_ns_var {variable one 1} } -body { namespace eval test_ns_var { variable two 2 } list [lsort [info vars test_ns_var::*]] \ [namespace eval test_ns_var {set two}] } -result [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2] test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup { catch {namespace delete test_ns_var} namespace eval test_ns_var {variable one 1; variable two 2} } -body { namespace eval test_ns_var { variable three 3 four 4 } list [lsort [info vars test_ns_var::*]] \ [namespace eval test_ns_var {expr {$three+$four}}] } -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7] test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup { catch {unset a} catch {unset five} catch {unset six} } -body { set a "" set five 555 set six 666 namespace eval test_ns_var { variable five 5 six lappend a $five } lappend a $test_ns_var::five \ [set test_ns_var::six 6] [set test_ns_var::six] $six } -cleanup { catch {unset five} catch {unset six} } -result {5 5 6 6 666} test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} -setup { catch {unset newvar} } -body { namespace eval test_ns_var { variable ::newvar cheers! } return $newvar } -cleanup { catch {unset newvar} } -result {cheers!} test var-7.7 {Tcl_VariableObjCmd, bad var name} -returnCodes error -body { namespace eval test_ns_var { variable sev:::en 7 } } -result {can't define "sev:::en": parent namespace doesn't exist} test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} { set a "" namespace eval test_ns_var { variable eight 8 lappend a $eight variable eight lappend a $eight } set a } {8 8} test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} -setup { catch {namespace delete test_ns_var2} } -body { set a "" namespace eval test_ns_var2 { variable x 123 variable y variable z } lappend a [lsort [info vars test_ns_var2::*]] lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \ [info exists test_ns_var2::z] lappend a [list [catch {set test_ns_var2::y} msg] $msg] lappend a [lsort [info vars test_ns_var2::*]] lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z] lappend a [set test_ns_var2::y hello] lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z] lappend a [list [catch {unset test_ns_var2::y} msg] $msg] lappend a [lsort [info vars test_ns_var2::*]] lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z] lappend a [list [catch {unset test_ns_var2::z} msg] $msg] lappend a [namespace delete test_ns_var2] } -result [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\ {1 {can't read "test_ns_var2::y": no such variable}}\ [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\ hello 1 0\ {0 {}}\ [lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\ {1 {can't unset "test_ns_var2::z": no such variable}}\ {}] test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup { namespace eval test_ns_var { variable eight 8 } } -body { namespace eval test_ns_var { proc p {} { variable eight list [set eight] [info vars] } p } } -result {8 eight} test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup { namespace eval test_ns_var { variable eight 8 } } -body { proc p {} { ;# note this proc is at global :: scope variable test_ns_var::eight list [set eight] [info vars] } p } -result {8 eight} test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} { namespace eval test_ns_var { variable {} {My name is empty} } proc p {} { ;# note this proc is at global :: scope variable test_ns_var:: list [set {}] [info vars] } p } {{My name is empty} {{}}} test var-7.13 {Tcl_VariableObjCmd, variable named ":"} { namespace eval test_ns_var { variable : {My name is ":"} proc p {} { variable : list [set :] [info vars] } p } } {{My name is ":"} :} test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body { namespace eval test_ns_var { variable arrayvar(1) } } -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array" test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body { namespace eval test_ns_var { variable arrayvar set arrayvar(1) x variable arrayvar(1) y } } -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array" test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} { variable } {} test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} { namespace eval test_ns_var { variable } } {} test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} -setup { catch {namespace delete test_ns_var} catch {unset a} } -body { namespace eval test_ns_var { variable v 123 variable info "" proc traceUnset {name1 name2 op} { variable info set info [concat $info [list $name1 $name2 $op]] } trace add var v unset [namespace code traceUnset] } list [unset test_ns_var::v] $test_ns_var::info } -result {{} {test_ns_var::v {} unset}} test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup { catch {namespace delete test_ns_var} catch {unset a} } -body { set info "" namespace eval test_ns_var { variable v 123 1 trace add var v unset ::traceUnset } proc traceUnset {name1 name2 op} { set ::info [concat $::info [list $name1 $name2 $op]] } list [namespace delete test_ns_var] $::info } -result {{} {::test_ns_var::v {} unset}} test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup { proc ::t {a i o} { set $a 321 } } -body { leaktest { namespace eval n { variable v 123 trace add variable v unset ::t } namespace delete n } } -cleanup { rename ::t {} } -result 0 test var-9.1 {behaviour of TclGet/SetVar simple get/set} -setup { catch {unset u} catch {unset v} } -constraints testsetnoerr -body { list \ [set u a; testsetnoerr u] \ [testsetnoerr v b] \ [testseterr u] \ [unset v; testseterr v b] } -result [list {before get a} {before set b} {before get a} {before set b}] test var-9.2 {behaviour of TclGet/SetVar namespace get/set} -setup { catch {namespace delete ns} } -constraints testsetnoerr -body { namespace eval ns {variable u a; variable v} list \ [testsetnoerr ns::u] \ [testsetnoerr ns::v b] \ [testseterr ns::u] \ [unset ns::v; testseterr ns::v b] } -result [list {before get a} {before set b} {before get a} {before set b}] test var-9.3 {behaviour of TclGetVar no variable} -setup { catch {unset u} } -constraints testsetnoerr -body { list \ [catch {testsetnoerr u} res] $res \ [catch {testseterr u} res] $res } -result {1 {before get} 1 {can't read "u": no such variable}} test var-9.4 {behaviour of TclGetVar no namespace variable} -setup { catch {namespace delete ns} } -constraints testsetnoerr -body { namespace eval ns {} list \ [catch {testsetnoerr ns::w} res] $res \ [catch {testseterr ns::w} res] $res } -result {1 {before get} 1 {can't read "ns::w": no such variable}} test var-9.5 {behaviour of TclGetVar no namespace} -setup { catch {namespace delete ns} } -constraints testsetnoerr -body { list \ [catch {testsetnoerr ns::u} res] $res \ [catch {testseterr ns::v} res] $res } -result {1 {before get} 1 {can't read "ns::v": no such variable}} test var-9.6 {behaviour of TclSetVar no namespace} -setup { catch {namespace delete ns} } -constraints testsetnoerr -body { list \ [catch {testsetnoerr ns::v 1} res] $res \ [catch {testseterr ns::v 1} res] $res } -result {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}} test var-9.7 {behaviour of TclGetVar array variable} -setup { catch {unset arr} } -constraints testsetnoerr -body { set arr(1) 1 list \ [catch {testsetnoerr arr} res] $res \ [catch {testseterr arr} res] $res } -result {1 {before get} 1 {can't read "arr": variable is array}} test var-9.8 {behaviour of TclSetVar array variable} -setup { catch {unset arr} } -constraints testsetnoerr -body { set arr(1) 1 list \ [catch {testsetnoerr arr 2} res] $res \ [catch {testseterr arr 2} res] $res } -result {1 {before set} 1 {can't set "arr": variable is array}} test var-9.9 {behaviour of TclGetVar read trace success} -setup { catch {unset u} catch {unset v} } -constraints testsetnoerr -body { proc resetvar {val name elem op} {upvar 1 $name v; set v $val} set u 10 trace add var u read [list resetvar 1] trace add var v read [list resetvar 2] list \ [testsetnoerr u] \ [testseterr v] } -result {{before get 1} {before get 2}} test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr { proc writeonly args {error "write-only"} set v 456 trace add var v read writeonly list \ [catch {testsetnoerr v} msg] $msg \ [catch {testseterr v} msg] $msg } {1 {before get} 1 {can't read "v": write-only}} test var-9.11 {behaviour of TclSetVar write trace success} -setup { catch {unset u} catch {unset v} } -constraints testsetnoerr -body { proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]} set v 1 trace add var v write doubleval trace add var u write doubleval list \ [testsetnoerr u 2] \ [testseterr v 3] } -result {{before set 4} {before set 6}} test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr { proc readonly args {error "read-only"} set v 456 trace add var v write readonly list \ [catch {testsetnoerr v 2} msg] $msg $v \ [catch {testseterr v 3} msg] $msg $v } {1 {before set} 2 1 {can't set "v": read-only} 3} test var-10.1 {can't nest arrays with array set} -setup { catch {unset arr} } -returnCodes error -body { array set arr(x) {a 1 b 2} } -result {can't set "arr(x)": variable isn't array} test var-10.2 {can't nest arrays with array set} -setup { catch {unset arr} } -returnCodes error -body { array set arr(x) {} } -result {can't set "arr(x)": variable isn't array} test var-11.1 {array unset} -setup { catch {unset a} } -body { array set a { 1,1 a 1,2 b 2,1 c 2,3 d } array unset a 1,* lsort -dict [array names a] } -result {2,1 2,3} test var-11.2 {array unset} -setup { catch {unset a} } -body { array set a { 1,1 a 1,2 b } array unset a array exists a } -result 0 test var-11.3 {array unset errors} -setup { catch {unset a} } -returnCodes error -body { array set a { 1,1 a 1,2 b } array unset a pattern too } -result {wrong # args: should be "array unset arrayName ?pattern?"} test var-12.1 {TclFindCompiledLocals, {} array name} { namespace eval n { proc p {} { variable {} set (0) 0 set (1) 1 set n 2 set ($n) 2 set ($n,foo) 2 } p lsort -dictionary [array names {}] } } {0 1 2 2,foo} test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup { catch {unset t} } -body { proc foo {var ind op} { global t set foo bar } namespace eval :: { set t(1) 1 trace add variable t(1) unset foo unset t } set x "If you see this, it worked" } -result "If you see this, it worked" test var-13.2 {unset array with search, bug 46a2410650} -body { apply {{} { array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66} set s [array startsearch a] unset a([array nextelement a $s]) array nextelement a $s }} } -returnCodes error -result {couldn't find search "s-1-a"} test var-13.3 {unset array with search, SIGSEGV, bug 46a2410650} -body { apply {{} { array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66} set s [array startsearch a] unset a(ff) array nextelement a $s }} } -returnCodes error -result {couldn't find search "s-1-a"} test var-14.1 {array names syntax} -body { array names foo bar baz snafu } -returnCodes 1 -match glob -result * test var-14.2 {array names -glob} -body { array names tcl_platform -glob os } -result os test var-15.1 {segfault in [unset], [Bug 735335]} { proc A { name } { upvar $name var set var $name } # # Note that the variable name has to be # unused previously for the segfault to # be triggered. # namespace eval test A useSomeUnlikelyNameHere namespace eval test unset useSomeUnlikelyNameHere } {} test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} { apply {{} {unset foo [return ok]}} } ok test var-16.1 {CallVarTraces: save/restore interp error state} { trace add variable ::errorCode write " ;#" catch {error foo bar baz} trace remove variable ::errorCode write " ;#" set ::errorInfo } bar test var-17.1 {TclArraySet [Bug 1669489]} -setup { unset -nocomplain ::a } -body { namespace eval :: { set elements {1 2 3 4} trace add variable a write "string length \$elements ;#" array set a $elements } } -cleanup { unset -nocomplain ::a ::elements } -result {} test var-17.2 {TclArraySet Dict shortcut only on pure value} -setup { unset -nocomplain a d set d {p 1 p 2} dict get $d p set foo 0 } -body { trace add variable a write "[list incr [namespace which -variable foo]];#" array set a $d set foo } -cleanup { unset -nocomplain a d foo } -result 2 test var-18.1 {array unset and unset traces: Bug 2939073} -setup { set already 0 unset -nocomplain x } -body { array set x {e 1 i 1} trace add variable x unset {apply {args { global already x if {!$already} { set already 1 unset x(i) } }}} # The next command would crash reliably with memory debugging prior to the # bug fix. array unset x * array size x } -cleanup { unset x already } -result 0 test var-19.1 {crash when freeing locals hashtable: Bug 3037525} { proc foo {} { catch {upvar 0 dummy \$index} } foo ; # This crashes without the fix for the bug rename foo {} } {} test var-20.1 {array set compilation correctness: Bug 3603163} -setup { unset -nocomplain x } -body { apply {{} { global x array set x {a 1} }} array size x } -result 1 test var-20.2 {array set compilation correctness: Bug 3603163} -setup { unset -nocomplain x } -body { apply {{} { global x array set x {} }} array size x } -result 0 test var-20.3 {array set compilation correctness: Bug 3603163} -setup { unset -nocomplain x } -body { apply {{} { array set ::x {a 1} }} array size x } -result 1 test var-20.4 {array set compilation correctness: Bug 3603163} -setup { unset -nocomplain x } -body { apply {{} { array set ::x {} }} array size x } -result 0 test var-20.5 {array set compilation correctness: Bug 3603163} -setup { unset -nocomplain x } -body { apply {{} { global x eval {array set x {a 1}} }} array size x } -result 1 test var-20.6 {array set compilation correctness: Bug 3603163} -setup { unset -nocomplain x } -body { apply {{} { global x eval {array set x {}} }} array size x } -result 0 test var-20.7 {array set compilation correctness: Bug 3603163} -setup { unset -nocomplain x } -body { apply {{} { eval {array set ::x {a 1}} }} array size x } -result 1 test var-20.8 {array set compilation correctness: Bug 3603163} -setup { unset -nocomplain x } -body { apply {{} { eval {array set ::x {}} }} array size x } -result 0 test var-20.9 {[bc1a96407a] array set compiled w/ trace} -setup { variable foo variable lambda unset -nocomplain lambda foo array set foo {} lappend lambda {} lappend lambda [list array set [namespace which -variable foo] {a 1}] } -body { after 0 [list apply $lambda] vwait [namespace which -variable foo] } -cleanup { unset -nocomplain lambda foo } -result {} test var-20.10 {[bc1a96407a] array set don't compile bad varname} -body { apply {{} {set name foo(bar); array set $name {a 1}}} } -returnCodes error -match glob -result * test var-20.11 {array set don't compile bad initializer} -setup { unset -nocomplain foo trace add variable foo array {set foo(bar) baz;#} } -body { catch {array set foo bad} set foo(bar) } -cleanup { unset -nocomplain foo } -result baz test var-20.12 {array set don't compile bad initializer} -setup { unset -nocomplain ::foo trace add variable ::foo array {set ::foo(bar) baz;#} } -body { catch {apply {{} { set value bad array set ::foo $value }}} set ::foo(bar) } -cleanup { unset -nocomplain ::foo } -result baz test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup { proc linenumber {} {dict get [info frame -1] line} } -body { apply {n { set foo bar unset foo {*}{ } [return [incr n -[linenumber]]] }} [linenumber] } -cleanup { rename linenumber {} } -result 1 test var-22.0 {leak in array element unset: Bug a3309d01db} -setup { proc getbytes {} { lindex [split [memory info] \n] 3 3 } proc doit k { variable A set A($k) {} foreach n [array names A] { if {$n <= $k-1} { unset A($n) } } } } -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { doit $i set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { array unset A rename getbytes {} rename doit {} } -result 0 test var-22.1 {leak in localVarName internalrep: Bug 80304238ac} -setup { proc getbytes {} { lindex [split [memory info] \n] 3 3 } proc doit {} { interp create child child eval { proc doit script { eval $script set foo bar } doit {foreach foo baz {}} } interp delete child } } -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { doit set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { array unset A rename getbytes {} rename doit {} } -result 0 catch {namespace delete ns} catch {unset arr} catch {unset v} catch {rename p ""} catch {namespace delete test_ns_var} catch {namespace delete test_ns_var2} catch {unset xx} catch {unset x} catch {unset y} catch {unset i} catch {unset a} catch {unset xxxxx} catch {unset aaaaa} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/while-old.test0000644000175000017500000000643714554262142015603 0ustar sergeisergei# Commands covered: while # # This file contains the original set of tests for Tcl's while command. # Since the while command is now compiled, a new set of tests covering # the new implementation is in the file "while.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test while-old-1.1 {basic while loops} { set count 0 while {$count < 10} {set count [expr {$count + 1}]} set count } 10 test while-old-1.2 {basic while loops} { set value xxx while {2 > 3} {set value yyy} set value } xxx test while-old-1.3 {basic while loops} { set value 1 while {"true"} { incr value; if {$value > 5} { break; } } set value } 6 test while-old-1.4 {basic while loops, multiline test expr} { set value 1 while {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} { incr value break } set value } {2} test while-old-1.5 {basic while loops, test expr in quotes} { set value 1 while "0 < 3" {set value 2; break} set value } {2} test while-old-2.1 {continue in while loop} { set list {1 2 3 4 5} set index 0 set result {} while {$index < 5} { if {$index == 2} {set index [expr {$index + 1}]; continue} set result [concat $result [lindex $list $index]] set index [expr {$index + 1}] } set result } {1 2 4 5} test while-old-3.1 {break in while loop} { set list {1 2 3 4 5} set index 0 set result {} while {$index < 5} { if {$index == 3} break set result [concat $result [lindex $list $index]] set index [expr {$index + 1}] } set result } {1 2 3} test while-old-4.1 {errors in while loops} { set err [catch {while} msg] list $err $msg } {1 {wrong # args: should be "while test command"}} test while-old-4.2 {errors in while loops} { set err [catch {while 1} msg] list $err $msg } {1 {wrong # args: should be "while test command"}} test while-old-4.3 {errors in while loops} { set err [catch {while 1 2 3} msg] list $err $msg } {1 {wrong # args: should be "while test command"}} test while-old-4.4 {errors in while loops} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg } {1 {can't use non-numeric string as operand of "+"}} test while-old-4.5 {errors in while loops} { catch {unset x} set x 1 set err [catch {while {$x} {set x foo}} msg] list $err $msg } {1 {expected boolean value but got "foo"}} test while-old-4.6 {errors in while loops} { set err [catch {while {1} {error "loop aborted"}} msg] list $err $msg $::errorInfo } {1 {loop aborted} {loop aborted while executing "error "loop aborted""}} test while-old-5.1 {while return result} { while {0} {set a 400} } {} test while-old-5.2 {while return result} { set x 1 while {$x} {set x 0} } {} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/while.test0000644000175000017500000003733114554262142015024 0ustar sergeisergei# Commands covered: while # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Basic "while" operation. catch {unset i} catch {unset a} test while-1.1 {TclCompileWhileCmd: missing test expression} -body { while } -returnCodes error -result {wrong # args: should be "while test command"} test while-1.2 {TclCompileWhileCmd: error in test expression} -body { set i 0 catch {while {$i<} break} return $::errorInfo } -cleanup { unset i } -match glob -result {*"while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} -body { while {"a"+"b"} {error "loop aborted"} } -returnCodes error -result {can't use non-numeric string as operand of "+"} test while-1.4 {TclCompileWhileCmd: multiline test expr} -body { set value 1 while {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} { incr value break } return $value } -cleanup { unset value } -result {2} test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} -body { set value 1 while {"true"} { incr value; if {$value > 5} { break; } } return $value } -cleanup { unset value } -result 6 test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} { set i 0 while "$i > 5" {} } {} test while-1.7 {TclCompileWhileCmd: missing command body} -body { set i 0 while {$i < 5} } -returnCodes error -result {wrong # args: should be "while test command"} test while-1.8 {TclCompileWhileCmd: error compiling command body} -body { set i 0 catch {while {$i < 5} {set}} return $::errorInfo } -match glob -cleanup { unset i } -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test while-1.9 {TclCompileWhileCmd: simple command body} -body { set a {} set i 1 while {$i<6} { if {$i==4} break set a [concat $a $i] incr i } return $a } -cleanup { unset a i } -result {1 2 3} test while-1.10 {TclCompileWhileCmd: command body in quotes} -body { set a {} set i 1 while {$i<6} "append a x; incr i" return $a } -cleanup { unset a i } -result {xxxxx} test while-1.11 {TclCompileWhileCmd: computed command body} -setup { catch {unset x1} catch {unset bb} catch {unset x2} } -body { set x1 {append a x1; } set bb {break} set x2 {; append a x2; incr i} set a {} set i 1 while {$i<6} $x1$bb$x2 return $a } -cleanup { unset x1 bb x2 a i } -result {x1} test while-1.12 {TclCompileWhileCmd: long command body} -body { set a {} set i 1 while {$i<6} { if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } return $a } -cleanup { unset a i } -result {1 2 3} test while-1.13 {TclCompileWhileCmd: while command result} -body { set i 0 set a [while {$i < 5} {incr i}] return $a } -cleanup { unset a i } -result {} test while-1.14 {TclCompileWhileCmd: while command result} -body { set i 0 set a [while {$i < 5} {if {$i==3} break; incr i}] return $a } -cleanup { unset a i } -result {} # Check "while" and "continue". test while-2.1 {continue tests} -body { set a {} set i 1 while {$i <= 4} { incr i if {$i == 3} continue set a [concat $a $i] } return $a } -cleanup { unset a i } -result {2 4 5} test while-2.2 {continue tests} -body { set a {} set i 1 while {$i <= 4} { incr i if {$i != 2} continue set a [concat $a $i] } return $a } -cleanup { unset a i } -result {2} test while-2.3 {continue tests, nested loops} -body { set msg {} set i 1 while {$i <= 4} { incr i set a 1 while {$a <= 2} { incr a if {$i>=3 && $a>=3} continue set msg [concat $msg "$i.$a"] } } return $msg } -cleanup { unset a i msg } -result {2.2 2.3 3.2 4.2 5.2} test while-2.4 {continue tests, long command body} -body { set a {} set i 1 while {$i<6} { if {$i==2} {incr i; continue} if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } return $a } -cleanup { unset a i } -result {1 3} # Check "while" and "break". test while-3.1 {break tests} -body { set a {} set i 1 while {$i <= 4} { if {$i == 3} break set a [concat $a $i] incr i } return $a } -cleanup { unset a i } -result {1 2} test while-3.2 {break tests, nested loops} -body { set msg {} set i 1 while {$i <= 4} { set a 1 while {$a <= 2} { if {$i>=2 && $a>=2} break set msg [concat $msg "$i.$a"] incr a } incr i } return $msg } -cleanup { unset a i msg } -result {1.1 1.2 2.1 3.1 4.1} test while-3.3 {break tests, long command body} -body { set a {} set i 1 while {$i<6} { if {$i==2} {incr i; continue} if {$i==5} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i==4} break if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } return $a } -cleanup { unset a i } -result {1 3} # Check "while" with computed command names. test while-4.1 {while and computed command names} -body { set i 0 set z while $z {$i < 10} { incr i } return $i } -cleanup { unset i z } -result 10 test while-4.2 {while (not compiled): missing test expression} -body { set z while $z } -returnCodes error -cleanup { unset z } -result {wrong # args: should be "while test command"} test while-4.3 {while (not compiled): error in test expression} -body { set i 0 set z while catch {$z {$i<} {set x 1}} return $::errorInfo } -match glob -cleanup { unset i z } -result {*"$z {$i<} {set x 1}"} test while-4.4 {while (not compiled): error in test expression} -body { set z while $z {"a"+"b"} {error "loop aborted"} } -returnCodes error -result {can't use non-numeric string as operand of "+"} test while-4.5 {while (not compiled): multiline test expr} -body { set value 1 set z while $z {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} { incr value break } return $value } -cleanup { unset value z } -result {2} test while-4.6 {while (not compiled): non-numeric boolean test expr} -body { set value 1 set z while $z {"true"} { incr value; if {$value > 5} { break; } } return $value } -cleanup { unset value z } -result 6 test while-4.7 {while (not compiled): test expr is enclosed in quotes} -body { set i 0 set z while $z "$i > 5" {} } -cleanup { unset i z } -result {} test while-4.8 {while (not compiled): missing command body} -body { set i 0 set z while $z {$i < 5} } -returnCodes error -cleanup { unset i z } -result {wrong # args: should be "while test command"} test while-4.9 {while (not compiled): error compiling command body} -body { set i 0 set z while catch {$z {$i < 5} {set}} set ::errorInfo } -match glob -cleanup { unset i z } -result {wrong # args: should be "set varName ?newValue?" while *ing "set" ("while" body line 1) invoked from within "$z {$i < 5} {set}"} test while-4.10 {while (not compiled): simple command body} -body { set a {} set i 1 set z while $z {$i<6} { if {$i==4} break set a [concat $a $i] incr i } return $a } -cleanup { unset a i z } -result {1 2 3} test while-4.11 {while (not compiled): command body in quotes} -body { set a {} set i 1 set z while $z {$i<6} "append a x; incr i" return $a } -cleanup { unset a i z } -result {xxxxx} test while-4.12 {while (not compiled): computed command body} -setup { catch {unset x1} catch {unset bb} catch {unset x2} } -body { set z while set x1 {append a x1; } set bb {break} set x2 {; append a x2; incr i} set a {} set i 1 $z {$i<6} $x1$bb$x2 return $a } -cleanup { unset z x1 bb x2 a i } -result {x1} test while-4.13 {while (not compiled): long command body} -body { set a {} set z while set i 1 $z {$i<6} { if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } return $a } -cleanup { unset a i z } -result {1 2 3} test while-4.14 {while (not compiled): while command result} -body { set i 0 set z while set a [$z {$i < 5} {incr i}] return $a } -cleanup { unset a i z } -result {} test while-4.15 {while (not compiled): while command result} -body { set i 0 set z while set a [$z {$i < 5} {if {$i==3} break; incr i}] return $a } -cleanup { unset a i z } -result {} # Check "break" with computed command names. test while-5.1 {break and computed command names} -body { set i 0 set z break while 1 { if {$i > 10} $z incr i } return $i } -cleanup { unset i z } -result 11 test while-5.2 {break tests with computed command names} -body { set a {} set i 1 set z break while {$i <= 4} { if {$i == 3} $z set a [concat $a $i] incr i } return $a } -cleanup { unset a i z } -result {1 2} test while-5.3 {break tests, nested loops with computed command names} -body { set msg {} set i 1 set z break while {$i <= 4} { set a 1 while {$a <= 2} { if {$i>=2 && $a>=2} $z set msg [concat $msg "$i.$a"] incr a } incr i } return $msg } -cleanup { unset a i z msg } -result {1.1 1.2 2.1 3.1 4.1} test while-5.4 {break tests, long command body with computed command names} -body { set a {} set i 1 set z break while {$i<6} { if {$i==2} {incr i; continue} if {$i==5} $z if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i==4} $z if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } return $a } -cleanup { unset a i z } -result {1 3} # Check "continue" with computed command names. test while-6.1 {continue and computed command names} -body { set i 0 set z continue while 1 { incr i if {$i < 10} $z break } return $i } -cleanup { unset i z } -result 10 test while-6.2 {continue tests} -body { set a {} set i 1 set z continue while {$i <= 4} { incr i if {$i == 3} $z set a [concat $a $i] } return $a } -cleanup { unset a i z } -result {2 4 5} test while-6.3 {continue tests with computed command names} -body { set a {} set i 1 set z continue while {$i <= 4} { incr i if {$i != 2} $z set a [concat $a $i] } return $a } -cleanup { unset a i z } -result {2} test while-6.4 {continue tests, nested loops with computed command names} -body { set msg {} set i 1 set z continue while {$i <= 4} { incr i set a 1 while {$a <= 2} { incr a if {$i>=3 && $a>=3} $z set msg [concat $msg "$i.$a"] } } return $msg } -cleanup { unset a i z msg } -result {2.2 2.3 3.2 4.2 5.2} test while-6.5 {continue tests, long command body with computed command names} -body { set a {} set i 1 set z continue while {$i<6} { if {$i==2} {incr i; continue} if {$i==4} break if {$i>5} $z if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } return $a } -cleanup { unset a i z } -result {1 3} # Test for incorrect "double evaluation" semantics test while-7.1 {delayed substitution of body} -body { set i 0 while {[incr i] < 10} " set result $i " proc p {} { set i 0 while {[incr i] < 10} " set result $i " return $result } append result [p] } -cleanup { unset result i } -result {00} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: tcl8.6.14/tests/winConsole.test0000644000175000017500000000215414554262142016027 0ustar sergeisergei# This file tests the tclWinConsole.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test winConsole-1.1 {Console file channel: non-blocking gets} {win interactive} { set oldmode [fconfigure stdin] puts stdout "Enter abcdef now: " nonewline flush stdout fileevent stdin readable { if {[gets stdin line] >= 0} { set result $line } else { set result "gets failed" } } fconfigure stdin -blocking 0 -buffering line set result {} vwait result #cleanup the fileevent fileevent stdin readable {} fconfigure stdin {*}$oldmode set result } "abcdef" #cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/winDde.test0000644000175000017500000004135714554262142015131 0ustar sergeisergei# This file tests the tclWinDde.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 #tcltest::configure -verbose {pass start} namespace import -force ::tcltest::* } testConstraint debug [::tcl::pkgconfig get debug] testConstraint dde 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands set ::ddever [package require dde 1.4.4] set ::ddelib [info loaded "" Dde]}]} { testConstraint dde 1 } } # ------------------------------------------------------------------------- # Setup a script for a test server # set scriptName [makeFile {} script1.tcl] proc createChildProcess {ddeServerName args} { file delete -force $::scriptName set f [open $::scriptName w+] puts $f [list set ddeServerName $ddeServerName] puts $f [list load $::ddelib Dde] puts $f { # DDE child server - # if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # If an error occurs during the tests, this process may end up not # being closed down. To deal with this we create a 30s timeout. proc ::DoTimeout {} { global done ddeServerName set done 1 puts "winDde.test child process $ddeServerName timed out." flush stdout } set timeout [after 30000 ::DoTimeout] # Define a restricted handler. proc Handler1 {cmd} { if {$cmd eq "stop"} {set ::done 1} if {$cmd == ""} { set cmd "null data" } puts $cmd ; flush stdout return } proc Handler2 {cmd} { if {$cmd eq "stop"} {set ::done 1} puts [uplevel \#0 $cmd] ; flush stdout return } proc Handler3 {prefix cmd} { if {$cmd eq "stop"} {set ::done 1} puts [list $prefix $cmd] ; flush stdout return } } # set the dde server name to the supplied argument. puts $f [list dde servername {*}$args -- $ddeServerName] puts $f { # run the server and handle final cleanup. after 200;# give dde a chance to get going. puts ready flush stdout vwait done # allow enough time for the calling process to # claim all results, to avoid spurious "server did # not respond" after 200 {set reallyDone 1} vwait reallyDone exit } close $f # run the child server script. set f [open |[list [interpreter] $::scriptName] r] fconfigure $f -buffering line gets $f line return $f } # ------------------------------------------------------------------------- test winDde-1.0 {check if we are testing the right dll} {win dde} { set ::ddever } {1.4.4} test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] } -result {foobar foobar self} test winDde-2.1 {Checking for other services} -constraints dde -body { expr {[llength [dde services {} {}]] >= 0} } -result 1 test winDde-2.2 {Checking for existence, with service and topic specified} \ -constraints dde -body { llength [dde services TclEval self] } -result 1 test winDde-2.3 {Checking for existence, with only the service specified} \ -constraints dde -body { expr {[llength [dde services TclEval {}]] >= 1} } -result 1 test winDde-2.4 {Checking for existence, with only the topic specified} \ -constraints dde -body { expr {[llength [dde services {} self]] >= 1} } -result 1 # ------------------------------------------------------------------------- test winDde-3.1 {DDE execute locally} -constraints dde -body { set \xe1 "" dde execute TclEval self [list set \xe1 foo] set \xe1 } -result foo test winDde-3.2 {DDE execute -async locally} -constraints dde -body { set \xe1 "" dde execute -async TclEval self [list set \xe1 foo] update set \xe1 } -result foo test winDde-3.3 {DDE request locally} -constraints dde -body { set \xe1 "" dde execute TclEval self [list set \xe1 foo] dde request TclEval self \xe1 } -result foo test winDde-3.4 {DDE eval locally} -constraints dde -body { set \xe1 "" dde eval self set \xe1 foo } -result foo test winDde-3.5 {DDE request locally} -constraints dde -body { set \xe1 "" dde execute TclEval self [list set \xe1 foo] dde request -binary TclEval self \xe1 } -result "foo\x00" # Set variable a to A with diaeresis (Unicode C4) by relying on the fact # that utf-8 is sent (e.g. "c3 84" on the wire) test winDde-3.6 {DDE request utf-8} -constraints dde -body { set \xe1 "not set" dde execute TclEval self "set \xe1 \xc4" scan [set \xe1] %c } -result 196 # Set variable a to A with diaeresis (Unicode C4) using binary execute # and compose utf-8 (e.g. "c3 84" ) manually test winDde-3.7 {DDE request binary} -constraints dde -body { set \xe1 "not set" dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00] scan [set \xe1] %c } -result 196 test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body { set \xe1 "" dde poke TclEval self \xe1 \xc4 dde request TclEval self \xe1 } -result \xc4 test winDde-3.9 {DDE poke -binary locally} -constraints {dde debug} -body { set \xe1 "" dde poke -binary TclEval self \xe1 \xc3\x84\x00 dde request TclEval self \xe1 } -result \xc4 # ------------------------------------------------------------------------- test winDde-4.1 {DDE execute remotely} -constraints {dde stdio} -body { set \xe1 "" set name ch\xEDld-4.1 set child [createChildProcess $name] dde execute TclEval $name [list set \xe1 foo] dde execute TclEval $name {set done 1} update set \xe1 } -result "" test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body { set \xe1 "" set name ch\xEDld-4.2 set child [createChildProcess $name] dde execute -async TclEval $name [list set \xe1 foo] update dde execute TclEval $name {set done 1} update set \xe1 } -result "" test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body { set \xe1 "" set name ch\xEDld-4.3 set child [createChildProcess $name] dde execute TclEval $name [list set \xe1 foo] set \xe1 [dde request TclEval $name \xe1] dde execute TclEval $name {set done 1} update set \xe1 } -result foo test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body { set \xe1 "" set name ch\xEDld-4.4 set child [createChildProcess $name] set \xe1 [dde eval $name set \xe1 foo] dde execute TclEval $name {set done 1} update set \xe1 } -result foo test winDde-4.5 {DDE poke remotely} -constraints {dde debug stdio} -body { set \xe1 "" set name ch\xEDld-4.5 set child [createChildProcess $name] dde poke TclEval $name \xe1 foo set \xe1 [dde request TclEval $name \xe1] dde execute TclEval $name {set done 1} update set \xe1 } -result foo # ------------------------------------------------------------------------- test winDde-5.1 {check for bad arguments} -constraints dde -body { dde execute "" "" "" "" } -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"} test winDde-5.2 {check for bad arguments} -constraints dde -body { dde execute -binary "" "" "" } -returnCodes error -result {cannot execute null data} test winDde-5.3 {check for bad arguments} -constraints dde -body { dde execute -foo "" "" "" } -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"} test winDde-5.4 {DDE eval bad arguments} -constraints dde -body { dde eval "" "foo" } -returnCodes error -result {invalid service name ""} # ------------------------------------------------------------------------- test winDde-6.1 {DDE servername bad arguments} -constraints dde -body { dde servername -z -z -z } -returnCodes error -result {bad option "-z": must be -force, -handler, or --} test winDde-6.2 {DDE servername set name} -constraints dde -body { dde servername -- winDde-6.2 } -result {winDde-6.2} test winDde-6.3 {DDE servername set exact name} -constraints dde -body { dde servername -force winDde-6.3 } -result {winDde-6.3} test winDde-6.4 {DDE servername set exact name} -constraints dde -body { dde servername -force -- winDde-6.4 } -result {winDde-6.4} test winDde-6.5 {DDE remote servername collision} -constraints {dde stdio} -setup { set name ch\xEDld-6.5 set child [createChildProcess $name] } -body { dde servername -- $name } -cleanup { dde execute TclEval $name {set done 1} update } -result "ch\xEDld-6.5 #2" test winDde-6.6 {DDE remote servername collision force} -constraints {dde stdio} -setup { set name ch\xEDld-6.6 set child [createChildProcess $name] } -body { dde servername -force -- $name } -cleanup { dde execute TclEval $name {set done 1} update } -result "ch\xEDld-6.6" # ------------------------------------------------------------------------- test winDde-7.1 {Load DDE in child interpreter} -constraints dde -setup { interp create child } -body { child eval [list load $::ddelib Dde] child eval [list dde servername -- dde-interp-7.1] } -cleanup { interp delete child } -result {dde-interp-7.1} test winDde-7.2 {DDE child cleanup} -constraints dde -setup { interp create child child eval [list load $::ddelib Dde] child eval [list dde servername -- dde-interp-7.5] interp delete child } -body { dde services TclEval {} set s [dde services TclEval {}] set m [list [list TclEval dde-interp-7.5]] if {$m in $s} { set s } } -result {} test winDde-7.3 {DDE present in child interp} -constraints dde -setup { interp create child child eval [list load $::ddelib Dde] child eval [list dde servername -- dde-interp-7.3] } -body { dde services TclEval dde-interp-7.3 } -cleanup { interp delete child } -result {{TclEval dde-interp-7.3}} test winDde-7.4 {interp name collision with -force} -constraints dde -setup { interp create child child eval [list load $::ddelib Dde] child eval [list dde servername -- dde-interp-7.4] } -body { dde servername -force -- dde-interp-7.4 } -cleanup { interp delete child } -result {dde-interp-7.4} test winDde-7.5 {interp name collision without -force} -constraints dde -setup { interp create child child eval [list load $::ddelib Dde] child eval [list dde servername -- dde-interp-7.5] } -body { dde servername -- dde-interp-7.5 } -cleanup { interp delete child } -result "dde-interp-7.5 #2" # ------------------------------------------------------------------------- test winDde-8.1 {Safe DDE load} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde } -body { child eval dde servername child } -cleanup { interp delete child } -returnCodes error -result {invalid command name "dde"} test winDde-8.2 {Safe DDE set servername} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde } -body { child invokehidden dde servername child } -cleanup {interp delete child} -result {child} test winDde-8.3 {Safe DDE check handler required for eval} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child invokehidden dde servername child } -body { catch {dde eval child set a 1} msg } -cleanup {interp delete child} -result {1} test winDde-8.4 {Safe DDE check that execute is denied} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child invokehidden dde servername child } -body { child eval set a 1 dde execute TclEval child {set a 2} child eval set a } -cleanup {interp delete child} -result 1 test winDde-8.5 {Safe DDE check that request is denied} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child invokehidden dde servername child } -body { child eval set a 1 dde request TclEval child a } -cleanup { interp delete child } -returnCodes error -result {remote server cannot handle this command} test winDde-8.6 {Safe DDE assign handler procedure} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} } -body { child invokehidden dde servername -handler DDEACCEPT child } -cleanup {interp delete child} -result child test winDde-8.7 {Safe DDE check simple command} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} child invokehidden dde servername -handler DDEACCEPT child } -body { dde eval child set x 1 } -cleanup {interp delete child} -result {set x 1} test winDde-8.8 {Safe DDE check non-list command} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} child invokehidden dde servername -handler DDEACCEPT child } -body { set s "c:\\Program Files\\Microsoft Visual Studio\\" dde eval child $s string equal [child eval set DDECMD] $s } -cleanup {interp delete child} -result 1 test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} child invokehidden dde servername -handler DDEACCEPT child } -body { dde eval child set \xe1 1 child eval set \xe1 } -cleanup {interp delete child} -result 1 test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} child invokehidden dde servername -handler DDEACCEPT child } -body { dde eval child [list set x 1] child eval set x } -cleanup {interp delete child} -result 1 test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints dde -setup { interp create -safe child child invokehidden load $::ddelib Dde child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} child invokehidden dde servername -handler DDEACCEPT child } -body { dde eval child [list [list set x 1]] child eval set x } -cleanup {interp delete child} -returnCodes error -result {invalid command name "set x 1"} # ------------------------------------------------------------------------- test winDde-9.1 {External safe DDE check string passing} -constraints {dde stdio} -setup { set name ch\xEDld-9.1 set child [createChildProcess $name -handler Handler1] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 gets $child line set line } -cleanup { dde execute TclEval $name stop update file delete -force -- dde-script.tcl } -result {set x 1} test winDde-9.2 {External safe DDE check command evaluation} -constraints {dde stdio} -setup { set name ch\xEDld-9.2 set child [createChildProcess $name -handler Handler2] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 gets $child line set line } -cleanup { dde execute TclEval $name stop update file delete -force -- dde-script.tcl } -result 1 test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {dde stdio} -setup { set name ch\xEDld-9.3 set child [createChildProcess $name -handler [list Handler3 ARG]] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 gets $child line set line } -cleanup { dde execute TclEval $name stop update file delete -force -- dde-script.tcl } -result {ARG {set x 1}} test winDde-9.4 {External safe DDE check null data passing} -constraints {dde stdio} -setup { set name ch\xEDld-9.4 set child [createChildProcess $name -handler Handler1] file copy -force script1.tcl dde-script.tcl } -body { dde execute TclEval $name "" gets $child line set line } -cleanup { dde execute TclEval $name stop update file delete -force -- dde-script.tcl } -result {null data} # ------------------------------------------------------------------------- #cleanup #catch {interp delete $child}; # ensure we clean up the child. file delete -force $::scriptName ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/winFCmd.test0000644000175000017500000013231114554262142015235 0ustar sergeisergei# This file tests the tclWinFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Initialise the test constraints testConstraint winVista 0 testConstraint win2000orXP 0 testConstraint winOlderThan2000 0 testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint testfile [llength [info commands testfile]] testConstraint testchmod [llength [info commands testchmod]] testConstraint cdrom 0 testConstraint exdev 0 testConstraint longFileNames 0 # Some things fail under all Continuous Integration systems for subtle reasons # such as CI often running with elevated privileges in a container. testConstraint notInCIenv [expr {![info exists ::env(CI)]}] proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string close $f return $string } proc contents {file} { set f [open $file r] set r [read $f] close $f set r } proc cleanupRecurse {args} { # Assumes no loops via links! # Need to change permissions BEFORE deletion catch {testchmod 0o777 {*}$args} foreach victim $args { if {[file isdirectory $victim]} { cleanupRecurse {*}[glob -nocomplain -directory $victim td* tf* Test*] } file delete -force $victim } } proc cleanup {args} { foreach p [list [pwd] {*}$args] { cleanupRecurse {*}[glob -nocomplain -directory $p tf* td*] } } if {[testConstraint winOnly]} { if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} { if {$::tcl_platform(osVersion) >= 6.0} { testConstraint winVista 1 } else { testConstraint win2000orXP 1 } } else { testConstraint winOlderThan2000 1 } } # find a CD-ROM so we can test read-only filesystems. proc findfile {dir} { foreach p [glob -nocomplain -type f -directory $dir *] { return $p } foreach p [glob -nocomplain -type d -directory $dir *] { set f [findfile $p] if {$f ne ""} { return $f } } return "" } if {[testConstraint testvolumetype]} { foreach p {d e f g h i j k l m n o p q r s t u v w x y z} { if {![catch {testvolumetype ${p}:} result] && $result in {CDFS UDF}} { set cdrom ${p}: set cdfile [findfile $cdrom] testConstraint cdrom 1 break } } } # NB: filename is chosen to be short but unlikely to clash with other apps if {[file exists c:/] && [file exists d:/]} { catch {file delete d:/TclTmpF.1} catch {file delete d:/TclTmpD.1} catch {file delete c:/TclTmpC.1} if {![catch {createfile d:/TclTmpF.1 {}}] && [file isfile d:/TclTmpF.1] && ![catch {file mkdir d:/TclTmpD.1}] && [file isdirectory d:/TclTmpD.1] && ![catch {file mkdir c:/TclTmpC.1}] && [file isdirectory c:/TclTmpC.1] } { file delete d:/TclTmpF.1 d:/TclTmpD.1 c:/TclTmpC.1 testConstraint exdev 1 } } file delete -force -- td1 if {![catch {open td1 w} testfile]} { close $testfile testConstraint longFileNames 1 file delete -force -- td1 } # A really long file name # length of longname is 1216 chars, which should be greater than any static # buffer or allowable filename. set longname "abcdefghihjllmnopqrstuvwxyz01234567890" append longname $longname append longname $longname append longname $longname append longname $longname append longname $longname # Uses the "testfile" command instead of the "file" command. The "file" # command provides several layers of sanity checks on the arguments and # it can be difficult to actually forward "insane" arguments to the # low-level Posix emulation layer. test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body { testfile mv $cdfile $cdrom/dummy~~.fil } -constraints {win cdrom testfile} -returnCodes error -result EACCES test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td2/td3 file mkdir td2 testfile mv td2 td1/td2 } -returnCodes error -result EEXIST test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} -setup { cleanup } -constraints {win testfile} -body { testfile mv / td1 } -returnCodes error -result EINVAL test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile mv td1 td1/td2 } -returnCodes error -result EINVAL test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv tf1 td1 } -returnCodes error -result EISDIR test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { testfile mv tf1 tf2 } -returnCodes error -result ENOENT test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { testfile mv "" tf2 } -returnCodes error -result ENOENT test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 testfile mv tf1 "" } -returnCodes error -result ENOENT test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv td1 tf1 } -returnCodes error -result ENOTDIR test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} -setup { file delete -force d:/TclTmpD.1 } -constraints {win exdev testfile} -body { file mkdir c:/TclTmpC.1 testfile mv c:/TclTmpC.1 d:/TclTmpD.1 } -cleanup { file delete -force c:/TclTmpC.1 } -returnCodes error -result EXDEV test winFCmd-1.11 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win testfile} -body { set fd [open tf1 w] testfile mv tf1 tf2 } -cleanup { catch {close $fd} } -returnCodes error -result EACCES test winFCmd-1.12 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 set fd [open tf2 w] testfile mv tf1 tf2 } -cleanup { catch {close $fd} } -returnCodes error -result EACCES test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win win2000orXP testfile} -body { testfile mv nul tf1 } -returnCodes error -result EINVAL test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win nt winOlderThan2000 testfile} -body { testfile mv nul tf1 } -returnCodes error -result EACCES test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup { cleanup } -constraints {win nt testfile} -body { createfile tf1 testfile mv tf1 nul } -returnCodes error -result EEXIST test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 tf1 testfile mv tf1 tf2 list [file exists tf1] [contents tf2] } -result {0 tf1} test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} -setup { cleanup } -constraints {win testfile} -body { testfile mv tf1 tf2 } -returnCodes error -result ENOENT test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup { cleanup } -constraints {win testfile} -body { testfile mv tf1 tf2 } -returnCodes error -result ENOENT test winFCmd-1.19 {TclpRenameFile: errno == EACCES} -setup { cleanup } -constraints {win win2000orXP testfile} -body { testfile mv nul tf1 } -returnCodes error -result EINVAL test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup { cleanup } -constraints {win nt winOlderThan2000 testfile} -body { testfile mv nul tf1 } -returnCodes error -result EACCES test winFCmd-1.20 {TclpRenameFile: src is dir} -setup { cleanup } -constraints {win nt testfile} -body { # under 95, this would actually succeed and move the current dir out from # under the current process! file delete /tf1 testfile mv [pwd] /tf1 } -returnCodes error -result EACCES test winFCmd-1.21 {TclpRenameFile: long src} -setup { cleanup } -constraints {win testfile} -body { testfile mv $longname tf1 } -returnCodes error -result ENAMETOOLONG test winFCmd-1.22 {TclpRenameFile: long dst} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 testfile mv tf1 $longname } -returnCodes error -result ENAMETOOLONG test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile mv [pwd]/td1 td1/td2 } -returnCodes error -result EINVAL test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup { cleanup } -constraints {win testfile} -body { # Error code depends on Windows version testfile mv / c:/ } -returnCodes error -result {^(EINVAL|ENOENT)$} -match regexp test winFCmd-1.25 {TclpRenameFile: cross file systems} -setup { cleanup } -constraints {win cdrom testfile} -body { file mkdir td1 testfile mv td1 $cdrom/td1 } -returnCodes error -result EXDEV test winFCmd-1.26 {TclpRenameFile: readonly fs} -setup { cleanup } -constraints {win cdrom testfile} -body { testfile mv $cdfile $cdrom/dummy~~.fil } -returnCodes error -result EACCES test winFCmd-1.27 {TclpRenameFile: open file} -setup { cleanup } -constraints {win testfile} -body { set fd [open tf1 w] testfile mv tf1 tf2 } -cleanup { catch {close $fd} } -returnCodes error -result EACCES test winFCmd-1.28 {TclpRenameFile: errno == EEXIST} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 createfile tf2 testfile mv tf1 tf2 list [file exists tf1] [file exists tf2] } -result {0 1} test winFCmd-1.29 {TclpRenameFile: src is dir} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv td1 tf1 } -returnCodes error -result ENOTDIR test winFCmd-1.30 {TclpRenameFile: dst is dir} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 file mkdir td2/td2 testfile mv td1 td2 } -returnCodes error -result EEXIST test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 file mkdir td2/td2 testfile mv td1 td2 } -returnCodes error -result EEXIST test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td2 file mkdir td2 testfile mv td1 td2 list [file exists td1] [file exists td2] [file exists td2/td2] } -result {0 1 1} test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \ -constraints {win exdev testfile testchmod} -body { file mkdir d:/TclTmpD.1 testchmod 0 d:/TclTmpD.1 file mkdir c:/TclTmpC.1 catch {testfile mv c:/TclTmpC.1 d:/TclTmpD.1} msg list $msg [file writable d:/TclTmpD.1] } -cleanup { catch {testchmod 0o666 d:/TclTmpD.1} file delete d:/TclTmpD.1 file delete -force c:/TclTmpC.1 } -result {EXDEV 0} test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv td1 tf1 } -cleanup { cleanup } -returnCodes error -result ENOTDIR test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv tf1 td1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-1.36 {TclpRenameFile: src and dst not dir} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 tf1 createfile tf2 tf2 testfile mv tf1 tf2 contents tf2 } -cleanup { cleanup } -result {tf1} test winFCmd-1.37 {TclpRenameFile: need to restore temp file} {win emptyTest} { # Can't figure out how to cause this. # Need a file that can't be copied. } {} # If the native filesystem produces 0 for inodes numbers there is no point # doing the following test. testConstraint winNonZeroInodes [eval { file stat [info nameofexecutable] statExe expr {$statExe(ino) != 0} }] proc MakeFiles {dirname} { set inodes {} set ndx -1 while {1} { # upped to 50K for 64bit Server 2008 if {$ndx > 50000} { return -code error "limit reached without finding a collistion." } set filename [file join $dirname Test[incr ndx]] set f [open $filename w] close $f file stat $filename stat if {[set n [lsearch -exact -integer $inodes $stat(ino)]] >= 0} { return [list [file join $dirname Test$n] $filename] } lappend inodes $stat(ino) unset stat } } test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup { cleanup } -constraints {win winNonZeroInodes notInCIenv} -body { file mkdir td1 lassign [MakeFiles td1] a b file rename -force $a $b file exists $a } -cleanup { cleanup } -result 0 test winFCmd-2.1 {TclpCopyFile: errno: EACCES} -setup { cleanup } -constraints {win cdrom testfile} -body { testfile cp $cdfile $cdrom/dummy~~.fil } -returnCodes error -result EACCES test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile cp td1 tf1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 file mkdir td1 testfile cp tf1 td1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { testfile cp tf1 tf2 } -returnCodes error -result ENOENT test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { testfile cp "" tf2 } -returnCodes error -result ENOENT test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 testfile cp tf1 "" } -cleanup { cleanup } -returnCodes error -result ENOENT test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup { cleanup } -constraints {win win2000orXP testfile} -body { testfile cp nul tf1 } -returnCodes error -result EINVAL test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup { cleanup } -constraints {win nt winOlderThan2000 testfile} -body { testfile cp nul tf1 } -returnCodes error -result EACCES test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 tf1 testfile cp tf1 tf2 list [contents tf1] [contents tf2] } -cleanup { cleanup } -result {tf1 tf1} test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 tf1 createfile tf2 tf2 testfile cp tf1 tf2 list [contents tf1] [contents tf2] } -cleanup { cleanup } -result {tf1 tf1} test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} -setup { cleanup } -constraints {win testfile testchmod} -body { createfile tf1 tf1 file attribute tf1 -readonly 1 testfile cp tf1 tf2 list [contents tf2] [file writable tf2] } -cleanup { testchmod 0o660 tf1 cleanup } -result {tf1 0} test winFCmd-2.13 {TclpCopyFile: CopyFile fails} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 file mkdir td1 testfile cp tf1 td1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-2.14 {TclpCopyFile: errno == EACCES} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile cp td1 tf1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-2.15 {TclpCopyFile: src is directory} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile cp td1 tf1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-2.16 {TclpCopyFile: dst is directory} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 file mkdir td1 testfile cp tf1 td1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup { cleanup } -constraints {win testfile testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 file attribute tf2 -readonly 1 testfile cp tf1 tf2 list [file writable tf2] [contents tf2] } -cleanup { cleanup } -result {1 tf1} test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body { testfile rm $cdfile $cdrom/dummy~~.fil } -constraints {win cdrom testfile} -returnCodes error -result EACCES test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile rm td1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { testfile rm tf1 } -returnCodes error -result ENOENT test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { testfile rm "" } -returnCodes error -result ENOENT test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} -setup { cleanup } -constraints {win testfile} -body { set fd [open tf1 w] testfile rm tf1 } -cleanup { close $fd cleanup } -returnCodes error -result EACCES test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} -setup { cleanup } -constraints {win testfile} -body { testfile rm nul } -returnCodes error -result EACCES test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 testfile rm tf1 file exists tf1 } -result {0} test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile rm td1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} -setup { cleanup } -constraints {win testfile} -body { set fd [open tf1 w] testfile rm tf1 } -cleanup { close $fd } -returnCodes error -result EACCES test winFCmd-3.10 {TclpDeleteFile: path is readonly} -setup { cleanup } -constraints {win testfile testchmod} -body { createfile tf1 testchmod 0 tf1 testfile rm tf1 file exists tf1 } -result {0} test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup { cleanup } -constraints {win testfile testchmod} -body { set fd [open tf1 w] testchmod 0 tf1 testfile rm tf1 } -cleanup { close $fd cleanup } -returnCodes error -result EACCES test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body { testfile mkdir $cdrom/dummy~~.dir } -constraints {win nt cdrom testfile} -returnCodes error -result EACCES test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile mkdir td1 } -cleanup { cleanup } -returnCodes error -result EEXIST test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { testfile mkdir td1/td2 } -returnCodes error -result ENOENT test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} -setup { cleanup } -constraints {win testfile} -body { testfile mkdir td1 file type td1 } -cleanup cleanup -result directory test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile cpdir td1 td2 list [file type td1] [file type td2] } -cleanup { cleanup } -result {directory directory} test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup } -constraints {winVista testfile testchmod notInCIenv} -body { # Parent's FILE_DELETE_CHILD setting permits deletion of subdir # even when subdir DELETE mask is clear. So we need an intermediate # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W. file mkdir td0/td1 testchmod 0o777 td0 testchmod 0 td0/td1 testfile rmdir td0/td1 file exists td0/td1 } -returnCodes error -cleanup { cleanup } -result {td0/td1 EACCES} # This next test has a very hokey way of matching... test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td2 list [catch {testfile rmdir td1} msg] [file tail $msg] } -result {1 {td1 EEXIST}} test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest trashSystem} { # can't test this w/o removing everything on your hard disk first! # testfile rmdir / } {} # This next test has a very hokey way of matching... test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { list [catch {testfile rmdir td1} msg] [file tail $msg] } -result {1 {td1 ENOENT}} test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { testfile rmdir "" } -returnCodes error -result ENOENT # This next test has a very hokey way of matching... test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 list [catch {testfile rmdir tf1} msg] [file tail $msg] } -result {1 {tf1 ENOTDIR}} test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile rmdir td1 file exists td1 } -result {0} # This next test has a very hokey way of matching... test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 list [catch {testfile rmdir tf1} msg] [file tail $msg] } -result {1 {tf1 ENOTDIR}} # winFCmd-6.9 removed - was exact dup of winFCmd-6.1 test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup { cleanup } -constraints {win nt testfile} -body { testfile rmdir / # WinXP returns EEXIST, WinNT seems to return EACCES. No policy # decision has been made as to which is correct. } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup { cleanup } -constraints {winVista testfile testchmod notInCIenv} -body { # Parent's FILE_DELETE_CHILD setting permits deletion of subdir # even when subdir DELETE mask is clear. So we need an intermediate # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W. file mkdir td0/td1 testchmod 0o770 td0 testchmod 0o444 td0/td1 testfile rmdir td0/td1 file exists td0/td1 } -cleanup { testchmod 0o770 td0/td1 cleanup } -returnCodes error -result {td0/td1 EACCES} # This next test has a very hokey way of matching... test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td2 list [catch {testfile rmdir td1} msg] [file tail $msg] } -result {1 {td1 EEXIST}} test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 testfile rmdir -force tf1 } -returnCodes error -result {tf1 ENOTDIR} test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td2 testfile rmdir -force td1 file exists td1 } -result {0} test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td2/td3 testfile rmdir -force td1 file exists td1 } -result {0} test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td2/td3 testfile cpdir td1 td2 list [file exists td1] [file exists td2] } -cleanup { cleanup } -result {1 1} test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} -setup { cleanup } -constraints {win testfile} -body { testfile cpdir td1 td2 } -returnCodes error -result {td1 ENOENT} test winFCmd-7.4 {TraverseWinTree: source isn't directory} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } -cleanup { cleanup } -result {tf1} test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } -cleanup { cleanup } -result {tf1} test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 tf1 testfile rmdir -force td1 file exists td1 } -result {0} test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } -cleanup { cleanup } -result {tf1} test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body { testfile rmdir $cdrom/ } -constraints {win nt cdrom testfile} -returnCodes error -match glob \ -result {* EACCES} test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \ {win emptyTest} { # can't make it happen } {} test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup { cleanup } -constraints {win testfile testchmod} -body { file mkdir td1 createfile td1/tf1 tf1 testchmod 0o770 td1/tf1; # Else tf2 will have no ACL after td1 testchmod testchmod 0o400 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } -cleanup { testchmod 0o660 td1 cleanup } -result {1 1} test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 tf1 testfile rmdir -force td1 file exists td1 } -result {0} test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } -cleanup { cleanup } -result {tf1} test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup { cleanup } -constraints {win nt testfile} -body { file mkdir td1 testfile cpdir td1 / } -cleanup { cleanup # Windows7 returns EEXIST, XP returns EACCES } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$} test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile cpdir td1 td2 } -cleanup { cleanup } -result {} test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/td2 testfile cpdir td1 td2 glob td2/* } -cleanup { cleanup } -result {td2/td2} test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 createfile td1/tf2 file mkdir td1/td2/td3 createfile td1/tf3 createfile td1/tf4 testfile cpdir td1 td2 lsort [glob td2/*] } -cleanup { cleanup } -result {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4} test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} -setup { cleanup } -constraints {win testfile testchmod} -body { file mkdir td1 createfile td1/tf1 tf1 testchmod 0o770 td1/tf1; # Else tf2 will have no ACL after td1 testchmod testchmod 0o400 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } -cleanup { testchmod 0o660 td1 cleanup } -result {1 1} test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 tf1 testfile rmdir -force td1 file exists td1 } -result {0} test winFCmd-7.21 {TraverseWinTree: fill errorPtr} -setup { cleanup } -constraints {win testfile} -body { testfile cpdir td1 td2 } -returnCodes error -result {td1 ENOENT} test winFCmd-8.1 {TraversalCopy: DOTREE_F} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile cpdir td1 td1 } -returnCodes error -result {td1 EEXIST} test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} -setup { cleanup } -constraints {win testfile testchmod} -body { file mkdir td1/td2 testchmod 0o770 td1/td2; # Else td2 will have no ACL after td1 testchmod testchmod 0o400 td1 testfile cpdir td1 td2 list [file writable td1] [file writable td1/td2] } -cleanup { testchmod 0o660 td1 cleanup } -result {0 1} test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile cpdir td1 td2 } -cleanup { cleanup } -result {} test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 testfile rmdir -force td1 } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup } -constraints {winVista testfile testchmod notInCIenv} -body { # Parent's FILE_DELETE_CHILD setting permits deletion of subdir # even when subdir DELETE mask is clear. So we need an intermediate # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W. file mkdir td0/td1/td2 testchmod 0o770 td0 testchmod 0o400 td0/td1 testfile rmdir -force td0/td1 file exists td1 } -cleanup { testchmod 0o770 td0/td1 cleanup } -returnCodes error -result {td0/td1 EACCES} test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td1/td3/td4/td5 testfile rmdir -force td1 } -result {} test winFCmd-10.1 {AttributesPosixError - get} -constraints {win} -setup { cleanup } -body { file attributes td1 -archive } -returnCodes error -result {could not read "td1": no such file or directory} test winFCmd-10.2 {AttributesPosixError - set} -constraints {win} -setup { cleanup } -body { file attributes td1 -archive 0 } -returnCodes error -result {could not read "td1": no such file or directory} test winFCmd-11.1 {GetWinFileAttributes} -constraints {win} -setup { cleanup } -body { createfile td1 {} file attributes td1 -archive } -cleanup { cleanup } -result 1 test winFCmd-11.2 {GetWinFileAttributes} -constraints {win} -setup { cleanup } -body { createfile td1 {} file attributes td1 -readonly } -cleanup { cleanup } -result 0 test winFCmd-11.3 {GetWinFileAttributes} -constraints {win} -setup { cleanup } -body { createfile td1 {} file attributes td1 -hidden } -cleanup { cleanup } -result 0 test winFCmd-11.4 {GetWinFileAttributes} -constraints {win} -setup { cleanup } -body { createfile td1 {} file attributes td1 -system } -cleanup { cleanup } -result 0 test winFCmd-11.5 {GetWinFileAttributes} -constraints {win} -setup { set old [pwd] } -body { # Attr of relative paths that resolve to root was failing don't care about # answer, just that test runs. cd c:/ file attr c: file attr c:. file attr . } -cleanup { cd $old } -match glob -result * test winFCmd-11.6 {GetWinFileAttributes} -constraints {win} -body { file attr c:/ -hidden } -result {0} test winFCmd-12.1 {ConvertFileNameFormat} -constraints {win} -setup { cleanup } -body { createfile td1 {} string tolower [file attributes td1 -longname] } -cleanup { cleanup } -result {td1} test winFCmd-12.2 {ConvertFileNameFormat} -constraints {win} -setup { cleanup } -body { file mkdir td1 createfile td1/td1 {} string tolower [file attributes td1/td1 -longname] } -cleanup { cleanup } -result {td1/td1} test winFCmd-12.3 {ConvertFileNameFormat} -constraints {win} -setup { cleanup } -body { file mkdir td1 file mkdir td1/td2 createfile td1/td3 {} string tolower [file attributes td1/td2/../td3 -longname] } -cleanup { cleanup } -result {td1/td2/../td3} test winFCmd-12.4 {ConvertFileNameFormat} -constraints {win} -setup { cleanup } -body { createfile td1 {} string tolower [file attributes ./td1 -longname] } -cleanup { cleanup } -result {./td1} test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body { list [file attributes / -longname] [file attributes \\ -longname] } -constraints {win} -result {/ /} test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup { catch {file delete -force -- c:/TclTmpC.1} } -constraints {win win2000orXP} -body { createfile c:/TclTmpC.1 {} string tolower [file attributes c:/TclTmpC.1 -longname] } -cleanup { file delete -force -- c:/TclTmpC.1 } -result [string tolower {c:/TclTmpC.1}] test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup { catch {file delete -force -- $::env(TEMP)/td1} } -constraints {win} -body { createfile $::env(TEMP)/td1 {} string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \ [string tolower [file normalize $::env(TEMP)]/td1] } -cleanup { file delete -force -- $::env(TEMP)/td1 } -result 1 test winFCmd-12.7 {ConvertFileNameFormat} -body { string tolower [file attributes //bisque/tcl/ws -longname] } -constraints {nonPortable win} -result {//bisque/tcl/ws} test winFCmd-12.8 {ConvertFileNameFormat} -setup { cleanup } -constraints {win longFileNames} -body { createfile td1 {} string tolower [file attributes td1 -longname] } -cleanup { cleanup } -result {td1} test winFCmd-12.10 {ConvertFileNameFormat} -setup { cleanup } -constraints {longFileNames win} -body { createfile td1td1td1 {} file attributes td1td1td1 -shortname } -cleanup { cleanup } -match glob -result * test winFCmd-12.11 {ConvertFileNameFormat} -setup { cleanup } -constraints {longFileNames win} -body { createfile td1 {} string tolower [file attributes td1 -shortname] } -cleanup { cleanup } -result {td1} test winFCmd-13.1 {GetWinFileLongName} -constraints {win} -setup { cleanup } -body { createfile td1 {} string tolower [file attributes td1 -longname] } -cleanup { cleanup } -result td1 test winFCmd-14.1 {GetWinFileShortName} -constraints {win} -setup { cleanup } -body { createfile td1 {} string tolower [file attributes td1 -shortname] } -cleanup { cleanup } -result td1 test winFCmd-15.1 {SetWinFileAttributes} -constraints {win} -setup { cleanup } -body { file attributes td1 -archive 0 } -returnCodes error -result {could not read "td1": no such file or directory} test winFCmd-15.2 {SetWinFileAttributes - archive} -constraints {win} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -archive 1] [file attributes td1 -archive] } -cleanup { cleanup } -result {{} 1} test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -archive 0] [file attributes td1 -archive] } -cleanup { cleanup } -result {{} 0} test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \ [file attributes td1 -hidden 0] } -cleanup { cleanup } -result {{} 1 {}} test winFCmd-15.5 {SetWinFileAttributes - hidden} -constraints {win} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -hidden 0] [file attributes td1 -hidden] } -cleanup { cleanup } -result {{} 0} test winFCmd-15.6 {SetWinFileAttributes - readonly} -setup { cleanup } -constraints {win} -body { createfile td1 {} list [file attributes td1 -readonly 1] [file attributes td1 -readonly] } -cleanup { cleanup } -result {{} 1} test winFCmd-15.7 {SetWinFileAttributes - readonly} -setup { cleanup } -constraints {win} -body { createfile td1 {} list [file attributes td1 -readonly 0] [file attributes td1 -readonly] } -cleanup { cleanup } -result {{} 0} test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -system 1] [file attributes td1 -system] } -cleanup { cleanup } -result {{} 1} test winFCmd-15.9 {SetWinFileAttributes - system} -constraints {win} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -system 0] [file attributes td1 -system] } -cleanup { cleanup } -result {{} 0} test winFCmd-15.10 {SetWinFileAttributes - failing} -setup { cleanup } -constraints {win cdrom} -body { file attributes $cdfile -archive 1 } -returnCodes error -match glob -result * test winFCmd-16.1 {Windows file normalization} -constraints {win} -body { list [file normalize c:/] [file normalize C:/] } -result {C:/ C:/} test winFCmd-16.2 {Windows file normalization} -constraints {win} -body { createfile td1... {} file tail [file normalize td1] } -cleanup { file delete td1... } -result {td1} set pwd [pwd] set d [string index $pwd 0] test winFCmd-16.3 {Windows file normalization} -constraints {win} -body { file norm ${d}:foo } -result [file join $pwd foo] test winFCmd-16.4 {Windows file normalization} -constraints {win} -body { file norm [string tolower ${d}]:foo } -result [file join $pwd foo] test winFCmd-16.5 {Windows file normalization} -constraints {win} -body { file norm ${d}:foo/bar } -result [file join $pwd foo/bar] test winFCmd-16.6 {Windows file normalization} -constraints {win} -body { file norm ${d}:foo\\bar } -result [file join $pwd foo/bar] test winFCmd-16.7 {Windows file normalization} -constraints {win} -body { file norm /bar } -result "${d}:/bar" test winFCmd-16.8 {Windows file normalization} -constraints {win} -body { file norm ///bar } -result "${d}:/bar" test winFCmd-16.9 {Windows file normalization} -constraints {win} -body { file norm /bar/foo } -result "${d}:/bar/foo" if {$d eq "C"} { set dd "D" } else { set dd "C" } test winFCmd-16.10 {Windows file normalization} -constraints {win} -body { file norm ${dd}:foo } -result "${dd}:/foo" test winFCmd-16.11 {Windows file normalization} -body { cd ${d}: cd $cdrom cd ${d}: cd $cdrom # Must not crash set result "no crash" } -constraints {win cdrom} -cleanup { cd $pwd } -result {no crash} test winFCmd-16.12 {Windows file normalization - no crash} \ -constraints win -setup { set oldhome "" catch {set oldhome $::env(HOME)} } -body { set expectedResult [file normalize ${d}:] set ::env(HOME) ${d}: cd # At one point this led to an infinite recursion in Tcl set result [pwd]; # <- Must not crash set result "no crash" } -cleanup { set ::env(HOME) $oldhome cd $pwd } -result {no crash} test winFCmd-16.13 {Windows file normalization - absolute HOME} -setup { set oldhome "" catch {set oldhome $::env(HOME)} } -constraints win -body { # Test 'cd' normalization when HOME is absolute set ::env(HOME) ${d}:/ cd pwd } -cleanup { set ::env(HOME) $oldhome cd $pwd } -result [file normalize ${d}:/] test winFCmd-16.14 {Windows file normalization - relative HOME} -setup { set oldhome "" catch {set oldhome $::env(HOME)} } -constraints win -body { # Test 'cd' normalization when HOME is relative set ::env(HOME) ${d}: cd pwd } -cleanup { set ::env(HOME) $oldhome cd $pwd } -result $pwd test winFCmd-17.1 {Windows bad permissions cd} -constraints win -body { set d {} foreach dd {c:/ d:/ e:/} { eval lappend d [glob -nocomplain \ -types hidden -dir $dd "System Volume Information"] } # Old versions of Tcl gave a misleading error that the # directory in question didn't exist. if {[llength $d] && [catch {cd [lindex $d 0]} err]} { regsub ".*: " $err "" err set err } else { set err "permission denied" } } -cleanup { cd $pwd } -result "permission denied" cd $pwd unset d dd pwd test winFCmd-18.1 {Windows reserved path names} -constraints win -body { file pathtype com1 } -result "absolute" test winFCmd-18.1.2 {Windows reserved path names} -constraints win -body { file pathtype com4 } -result "absolute" test winFCmd-18.1.3 {Windows reserved path names} -constraints win -body { file pathtype com9 } -result "absolute" test winFCmd-18.1.4 {Windows reserved path names} -constraints win -body { file pathtype lpt3 } -result "absolute" test winFCmd-18.1.5 {Windows reserved path names} -constraints win -body { file pathtype lpt9 } -result "absolute" test winFCmd-18.1.6 {Windows reserved path names} -constraints win -body { file pathtype nul } -result "absolute" test winFCmd-18.1.7 {Windows reserved path names} -constraints win -body { file pathtype null } -result "relative" test winFCmd-18.2 {Windows reserved path names} -constraints win -body { file pathtype com1: } -result "absolute" test winFCmd-18.3 {Windows reserved path names} -constraints win -body { file pathtype COM1 } -result "absolute" test winFCmd-18.4 {Windows reserved path names} -constraints win -body { file pathtype CoM1: } -result "absolute" test winFCmd-18.5 {Windows reserved path names} -constraints win -body { file normalize com1: } -result COM1 test winFCmd-18.6 {Windows reserved path names} -constraints win -body { file normalize COM1: } -result COM1 test winFCmd-18.7 {Windows reserved path names} -constraints win -body { file normalize cOm1 } -result COM1 test winFCmd-18.8 {Windows reserved path names} -constraints win -body { file normalize cOm1: } -result COM1 test winFCmd-19.1 {Windows extended path names} -constraints nt -body { file normalize //?/c:/windows/win.ini } -result //?/c:/windows/win.ini test winFCmd-19.2 {Windows extended path names} -constraints nt -body { file normalize //?/c:/windows/../windows/win.ini } -result //?/c:/windows/win.ini test winFCmd-19.3 {Windows extended path names} -constraints nt -setup { set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp] set tmpfile [file normalize $tmpfile] } -body { list [catch { set f [open $tmpfile [list WRONLY CREAT]] close $f } res] $res } -cleanup { catch {file delete $tmpfile} } -result [list 0 {}] test winFCmd-19.4 {Windows extended path names} -constraints {win nt} -setup { set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp] set tmpfile //?/[file normalize $tmpfile] } -body { list [catch { set f [open $tmpfile [list WRONLY CREAT]] close $f } res] $res } -cleanup { catch {file delete $tmpfile} } -result [list 0 {}] test winFCmd-19.5 {Windows extended path names} -constraints nt -setup { set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp] set tmpfile [file normalize $tmpfile] } -body { list [catch { set f [open $tmpfile [list WRONLY CREAT]] close $f } res] $res } -cleanup { catch {file delete $tmpfile} } -result [list 0 {}] test winFCmd-19.6 {Windows extended path names} -constraints {win nt} -setup { set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp] set tmpfile //?/[file normalize $tmpfile] } -body { list [catch { set f [open $tmpfile [list WRONLY CREAT]] close $f } res] $res } -cleanup { catch {file delete $tmpfile} } -result [list 0 {}] test winFCmd-19.7 {Windows extended path names} -constraints {win nt} -setup { set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "] set tmpfile [file normalize $tmpfile] } -body { list [catch { set f [open $tmpfile [list WRONLY CREAT]] close $f } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*] } -cleanup { catch {file delete $tmpfile} } -result [list 0 {} [list tcl[pid].tmp]] test winFCmd-19.8 {Windows extended path names} -constraints {win nt} -setup { set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "] set tmpfile //?/[file normalize $tmpfile] } -body { list [catch { set f [open $tmpfile [list WRONLY CREAT]] close $f } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*] } -cleanup { catch {file delete $tmpfile} } -result [list 0 {} [list "tcl[pid].tmp "]] test winFCmd-19.9 {Windows devices path names} -constraints {win nt} -body { file normalize //./com1 } -result //./com1 # This block of code used to occur after the "return" call, so I'm # commenting it out and assuming that this code is still under construction. #foreach source {tef ted tnf tnd "" nul com1} { # foreach chmodsrc {000 755} { # foreach dest "tfn tfe tdn tdempty tdfull td1/td2 $p $p/td1 {} nul" { # foreach chmoddst {000 755} { # puts hi # cleanup # file delete -force ted tef # file mkdir ted # createfile tef # createfile tfe # file mkdir tdempty # file mkdir tdfull/td1/td2 # # catch {testchmod $chmodsrc $source} # catch {testchmod $chmoddst $dest} # # if [catch {file rename $source $dest} msg] { # puts "file rename $source ($chmodsrc) $dest ($chmoddst)" # puts $msg # } # } # } # } #} cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/winFile.test0000644000175000017500000001514214554262142015305 0ustar sergeisergei# This file tests the tclWinFile.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[catch {package require tcltest 2.5}]} { puts stderr "Skipping tests in [info script]. tcltest 2.5 required." return } namespace import -force ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint notNTFS 0 testConstraint win2000 0 if {[testConstraint testvolumetype]} { testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}] } if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} { testConstraint win2000 1 } test winFile-1.1 {TclpGetUserHome} -constraints {win} -body { glob ~nosuchuser } -returnCodes error -result {user "nosuchuser" doesn't exist} test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body { # The administrator account should always exist. glob ~administrator } -match glob -result * test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} { catch {glob ~stanton@workgroup} } {0} test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body { makeFile {} GlobCapS set args [list -nocomplain -tails -directory [temporaryDirectory]] list [glob {*}$args GlobC*] [glob {*}$args globc*]} -cleanup { removeFile GlobCapS } -result {GlobCapS GlobCapS} test winFile-2.2 {TclpMatchFiles: case sensitivity} -constraints {win} -body { makeFile {} globlower set args [list -nocomplain -tails -directory [temporaryDirectory]] list [glob {*}$args globl*] [glob {*}$args gLOBl*] } -cleanup { removeFile globlower } -result {globlower globlower} test winFile-3.1 {file system} -constraints {win testvolumetype} -setup { set res "" } -body { foreach vol [file volumes] { # Have to catch in case there is a removable drive (CDROM, floppy) # with nothing in it. catch { if {[lindex [file system $vol] 1] ne [testvolumetype $vol]} { append res "For $vol, we found [file system $vol]\ and [testvolumetype $vol] are different\n" } } } set res } -result {} proc cacls {fname args} { string trim [eval [list exec cacls [file nativename $fname]] $args < $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} { exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win nt exec cat32} { exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} { exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" test winpipe-1.6 {32 bit comprehensive tests: from console} \ {win cat32 AllocConsole} { # would block waiting for human input } {} test winpipe-1.7 {32 bit comprehensive tests: from NUL} {win exec cat32} { exec $cat32 < nul > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {{} stderr32} test winpipe-1.8 {32 bit comprehensive tests: from socket} {win cat32} { # doesn't work } {} test winpipe-1.9 {32 bit comprehensive tests: from nowhere} \ {win exec cat32 RealConsole} { exec $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {{} stderr32} test winpipe-1.10 {32 bit comprehensive tests: from file handle} \ {win exec cat32} { set f [open $path(little) r] exec $cat32 <@$f > $path(stdout) 2> $path(stderr) close $f list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.11 {32 bit comprehensive tests: read from application} \ {win exec cat32} { set f [open "|[list $cat32] < [list $path(little)]" r] gets $f line catch {close $f} msg list $line $msg } {little stderr32} test winpipe-1.12 {32 bit comprehensive tests: a little to file} \ {win exec cat32} { exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.13 {32 bit comprehensive tests: a lot to file} \ {win exec cat32} { exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" test winpipe-1.14 {32 bit comprehensive tests: a little to pipe} \ {win exec stdio cat32} { exec $cat32 < $path(little) | [interpreter] $path(more) > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.15 {32 bit comprehensive tests: a lot to pipe} \ {win exec stdio cat32} { exec $cat32 < $path(big) | [interpreter] $path(more) > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" test winpipe-1.16 {32 bit comprehensive tests: to console} {win exec cat32} { catch {exec $cat32 << "You should see this\n" >@stdout} msg set msg } stderr32 test winpipe-1.17 {32 bit comprehensive tests: to NUL} {win exec cat32} { # some apps hang when sending a large amount to NUL. $cat32 isn't one. catch {exec $cat32 < $path(big) > nul} msg set msg } stderr32 test winpipe-1.18 {32 bit comprehensive tests: to nowhere} \ {win exec cat32 RealConsole} { exec $cat32 < $path(big) >&@stdout } {} test winpipe-1.19 {32 bit comprehensive tests: to file handle} {win exec cat32} { set f1 [open $path(stdout) w] set f2 [open $path(stderr) w] exec $cat32 < $path(little) >@$f1 2>@$f2 close $f1 close $f2 list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.20 {32 bit comprehensive tests: write to application} \ {win exec cat32} { set f [open |[list $cat32 >$path(stdout)] w] puts -nonewline $f "foo" catch {close $f} msg list [contents $path(stdout)] $msg } {foo stderr32} test winpipe-1.21 {32 bit comprehensive tests: read/write application} \ {win exec cat32} { set f [open "|[list $cat32]" r+] puts $f $big puts $f \032 flush $f set r [read $f 64] catch {close $f} set r } "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} { proc readResults {f} { global x result if { [eof $f] } { close $f set x 1 } else { set line [read $f ] set result "$result$line" } } set f [open "|[list $cat32] < $path(big) 2> $path(stderr)" r] fconfigure $f -buffering none -blocking 0 fileevent $f readable "readResults $f" set x 0 set result "" vwait x list $result $x [contents $path(stderr)] } "{$big} 1 stderr32" test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "load $::tcltestlib Tcltest" puts $f "testexcept float_underflow" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGFPE} test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "load $::tcltestlib Tcltest" puts $f "testexcept access_violation" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGSEGV} test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "load $::tcltestlib Tcltest" puts $f "testexcept illegal_instruction" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGILL} test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "load $::tcltestlib Tcltest" puts $f "testexcept ctrl+c" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGINT} set path(nothing) [makeFile {} nothing] close [open $path(nothing) w] catch {set env_tmp $env(TMP)} catch {set env_temp $env(TEMP)} set env(TMP) c:/ set env(TEMP) c:/ test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {win exec} { set x {} set existing [glob -nocomplain c:/tcl*.tmp] exec [interpreter] < $path(nothing) foreach p [glob -nocomplain c:/tcl*.tmp] { if {$p ni $existing} { lappend x $p } } set x } {} test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {win exec} { set tmp $env(TMP) set temp $env(TEMP) unset env(TMP) unset env(TEMP) exec [interpreter] < $path(nothing) set env(TMP) $tmp set env(TEMP) $temp set x {} } {} test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \ {win exec } { set tmp $env(TMP) set env(TMP) snarky exec [interpreter] < $path(nothing) set env(TMP) $tmp set x {} } {} test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \ {win exec} { set tmp $env(TMP) set temp $env(TEMP) unset env(TMP) set env(TEMP) snarky exec [interpreter] < $path(nothing) set env(TMP) $tmp set env(TEMP) $temp set x {} } {} test winpipe-6.1 {PipeSetupProc & PipeCheckProc: read threads} \ {win exec cat32} { set f [open "|[list $cat32]" r+] fconfigure $f -blocking 0 fileevent $f writable { set x writable } set x {} vwait x fileevent $f writable {} fileevent $f readable { lappend x readable } after 100 { lappend x timeout } vwait x puts $f foobar flush $f vwait x lappend x [read $f] after 100 { lappend x timeout } vwait x fconfigure $f -blocking 1 lappend x [catch {close $f} msg] $msg } {writable timeout readable {foobar } timeout 1 stderr32} test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \ {win exec cat32} { set f [open "|[list $cat32]" r+] fconfigure $f -blocking 0 fileevent $f writable { set x writable } set x {} vwait x puts -nonewline $f $big$big$big$big flush $f after 100 { lappend x timeout } vwait x lappend x [catch {close $f} msg] $msg } {writable timeout 0 {}} proc _testExecArgs {flags args} { variable path if {![info exists path(echoArgs.tcl)] || ![file exists $path(echoArgs.tcl)]} { set path(echoArgs.tcl) [makeFile { puts "[list [file tail $argv0] {*}$argv]" } echoArgs.tcl] } if {![info exists path(echoArgs.bat)] || ![file exists $path(echoArgs.bat)]} { set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" "echoArgs.bat"] } set cmds [list [list [interpreter] $path(echoArgs.tcl)]] if {"exe-only" ni $flags} { if {"batch2" ni $flags} { lappend cmds [list $path(echoArgs.bat)] } else { if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} { set path(echoArgs2.bat) [makeFile \ "@[file native [interpreter]] $path(echoArgs.tcl) %*" \ "echo(Cmd)Test Args & Batch.bat" [makeDirectory test(Dir)Check]] } lappend cmds [list $path(echoArgs2.bat)] } } set broken {} foreach args $args { if {"enclose" in $flags} { # enclose single test-arg between 1st/3rd to be sure nothing is truncated # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined): set args [list "1st" $args "3rd"] } set args [list {*}$args]; # normalized canonical list foreach cmd $cmds { set e [linsert $args 0 [file tail $path(echoArgs.tcl)]] tcltest::DebugPuts 4 " ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n ## $args" if {[catch { exec {*}$cmd {*}$args } r]} { set r "ERROR: $r" } if {[file extension [lindex $cmd 0]] eq ".bat"} { set evm {}; foreach ev [lsort -unique [regexp -inline -all {%[A-Z]+%} $e]] { set ev [string range $ev 1 end-1] if {[info exists ::env($ev)]} { lappend evm %$ev% $::env($ev) } } set e [string map $evm $e] } if {$r ne $e} { append broken "\[ERROR\]: exec [file extension [lindex $cmd 0]] on $args\n -- result:\n$r\n -- expected:\n$e\n" } } } return $broken } ### validate the raw output of BuildCommandLine(). ### test winpipe-7.1 {BuildCommandLine: null arguments} {win exec} { exec $env(COMSPEC) /c echo foo "" bar } {foo "" bar} test winpipe-7.2 {BuildCommandLine: null arguments} {win exec} { exec $env(COMSPEC) /c echo foo {} bar } {foo "" bar} test winpipe-7.3 {BuildCommandLine: dbl quote quoting #1} {win exec} { exec $env(COMSPEC) /c echo foo "\"" bar } {foo \" bar} test winpipe-7.4 {BuildCommandLine: dbl quote quoting #2} {win exec} { exec $env(COMSPEC) /c echo foo {""} bar } {foo \"\" bar} test winpipe-7.5 {BuildCommandLine: dbl quote quoting #3} {win exec} { exec $env(COMSPEC) /c echo foo "\" " bar } {foo "\" " bar} test winpipe-7.6 {BuildCommandLine: dbl quote quoting #4} {win exec} { exec $env(COMSPEC) /c echo foo {a="b"} bar } {foo a=\"b\" bar} test winpipe-7.7 {BuildCommandLine: dbl quote quoting #5} {win exec} { exec $env(COMSPEC) /c echo foo {a = "b"} bar } {foo "a = \"b\"" bar} test winpipe-7.8 {BuildCommandLine: dbl quote quoting #6} {win exec} { exec $env(COMSPEC) /c echo {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} "he \" llo" } {\"hello\" \"\"hello\"\" \"\"\"hello\"\"\" \"\\\"hello\\\"\" "he llo" "he \" llo"} test winpipe-7.9 {BuildCommandLine: N backslashes followed a quote rule #1} {win exec} { exec $env(COMSPEC) /c echo foo \\ bar } {foo \ bar} test winpipe-7.10 {BuildCommandLine: N backslashes followed a quote rule #2} {win exec} { exec $env(COMSPEC) /c echo foo \\\\ bar } {foo \\ bar} test winpipe-7.11 {BuildCommandLine: N backslashes followed a quote rule #3} {win exec} { exec $env(COMSPEC) /c echo foo \\\ \\ bar } {foo "\ \\" bar} test winpipe-7.12 {BuildCommandLine: N backslashes followed a quote rule #4} {win exec} { exec $env(COMSPEC) /c echo foo \\\ \\\\ bar } {foo "\ \\\\" bar} test winpipe-7.13 {BuildCommandLine: N backslashes followed a quote rule #5} {win exec} { exec $env(COMSPEC) /c echo foo \\\ \\\\\\ bar } {foo "\ \\\\\\" bar} test winpipe-7.14 {BuildCommandLine: N backslashes followed a quote rule #6} {win exec} { exec $env(COMSPEC) /c echo foo \\\ \\\" bar } {foo "\ \\\"" bar} test winpipe-7.15 {BuildCommandLine: N backslashes followed a quote rule #7} {win exec} { exec $env(COMSPEC) /c echo foo \\\ \\\\\" bar } {foo "\ \\\\\"" bar} test winpipe-7.16 {BuildCommandLine: N backslashes followed a quote rule #8} {win exec} { exec $env(COMSPEC) /c echo foo \\\ \\\\\\\" bar } {foo "\ \\\\\\\"" bar} test winpipe-7.17 {BuildCommandLine: special chars #4} {win exec} { exec $env(COMSPEC) /c echo foo \{ bar } "foo \{ bar" test winpipe-7.18 {BuildCommandLine: special chars #5} {win exec} { exec $env(COMSPEC) /c echo foo \} bar } "foo \} bar" set injectList { {test"whoami} {test""whoami} {test"""whoami} {test""""whoami} "test\"whoami\\" "test\"\"whoami\\" "test\"\"\"whoami\\" "test\"\"\"\"whoami\\" {test\\&\\test} {test"\\&\\test} {"test\\&\\test} {"test"\\&\\"test"} {test\\"&"\\test} {test"\\"&"\\test} {"test\\"&"\\test} {"test"\\"&"\\"test"} {test\"&whoami} {test"\"&whoami} {test""\"&whoami} {test"""\"&whoami} {test\"\&whoami} {test"\"\&whoami} {test""\"\&whoami} {test"""\"\&whoami} {test&whoami} {test|whoami} {"test&whoami} {"test|whoami} {test"&whoami} {test"|whoami} {"test"&whoami} {"test"|whoami} {""test"&whoami} {""test"|whoami} {test&echo "} {test|echo "} {"test&echo "} {"test|echo "} {test"&echo "} {test"|echo "} {"test"&echo "} {"test"|echo "} {""test"&echo "} {""test"|echo "} {test&echo ""} {test|echo ""} {"test&echo ""} {"test|echo ""} {test"&echo ""} {test"|echo ""} {"test"&echo ""} {"test"|echo ""} {""test"&echo ""} {""test"|echo ""} {test>whoami} {testwhoami} {"testwhoami} {test"whoami} {"test"whoami} {""test"!()%} {\&|^<>!()% } {"\&|^<>!()%} {"\&|^<>!()% } {"""""\\\\\&|^<>!()%} {"""""\\\\\&|^<>!()% } } set i 0 time { set args {[incr i].} time { set map [lindex $maps [expr {int(rand()*[llength $maps])}]] # be sure arg has some prefix (avoid special handling, like |& etc) set a {x} while {[string length $a] < 50} { append a [string index $map [expr {int(rand()*[string length $map])}]] } lappend args $a } 20 lappend lst $args } 10 _testExecArgs {} {*}$lst } -result {} -cleanup { unset -nocomplain lst args a map maps } set injectList { "test\"\nwhoami" "test\"\"\nwhoami" "test\"\"\"\nwhoami" "test\"\"\"\"\nwhoami" "test;\n&echo \"" "\"test;\n&echo \"" "test\";\n&echo \"" "\"test\";\n&echo \"" "\"\"test\";\n&echo \"" } test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args} \ -constraints {win exec} -body { # test exe only, because currently there is no proper way to escape a new-line char resp. # to supply a new-line to the batch-files within arguments (command line is truncated). _testExecArgs exe-only \ [list START {*}$injectList END] \ [list "START\"" {*}$injectList END] \ [list START {*}$injectList "\"END"] \ [list "START\"" {*}$injectList "\"END"] } -result {} test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args (batch)} \ -constraints {win exec knownBug} -body { # this will fail if executed batch-file, because currently there is no proper way to escape a new-line char. _testExecArgs {} $injectList } -result {} rename _testExecArgs {} # restore old values for env(TMP) and env(TEMP) if {[catch {set env(TMP) $env_tmp}]} { unset env(TMP) } if {[catch {set env(TEMP) $env_temp}]} { unset env(TEMP) } # cleanup removeFile little removeFile big removeFile more removeFile stdout removeFile stderr removeFile nothing if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl } if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat } if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check } ::tcltest::cleanupTests # back to original directory: cd $org_pwd; unset org_pwd return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/winTime.test0000644000175000017500000000377214554262142015332 0ustar sergeisergei# This file tests the tclWinTime.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testwinclock [llength [info commands testwinclock]] # The next two tests will crash on Windows if the check for negative # clock values is not done properly. test winTime-1.1 {TclpGetDate} {win} { set ::env(TZ) JST-9 set result [clock format -1 -format %Y] unset ::env(TZ) set result } {1970} test winTime-1.2 {TclpGetDate} {win} { set ::env(TZ) PST8 set result [clock format 1 -format %Y] unset ::env(TZ) set result } {1969} # Next test tries to make sure that the Tcl clock stays in step # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? test winTime-2.1 {Synchronization of Tcl and Windows clocks} testwinclock { # May fail due to OS/hardware discrepancies. See: # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 set failed {} set ok 1 foreach start_sec [testwinclock] break while { 1 } { foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break set diff [expr { $tcl_sec - $sys_sec + 1.0e-6 * ( $tcl_usec - $sys_usec ) }] if { abs($diff) > 0.1 } { set failed "Tcl clock differs from system clock by $diff sec" break } else { testwinsleep 1 } if { $sys_sec - $start_sec >= 30 } break } set failed } {} # cleanup ::tcltest::cleanupTests return tcl8.6.14/tests/word.test0000644000175000017500000001235714560736524014677 0ustar sergeisergei# This file is a Tcl script to test the [tcl_startOf|endOf]* functions in # word.tcl. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 2024 Jan Nijtmans # All rights reserved. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] test word-1.0 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" -1 } -result 2 test word-1.1 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" 0 } -result 2 test word-1.2 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" 1 } -result 2 test word-1.3 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" 2 } -result -1 test word-1.4 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" 3 } -result -1 test word-1.5 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" 4 } -result -1 test word-1.6 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" 5 } -result -1 test word-1.7 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" end } -result -1 test word-1.8 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" end-1 } -result -1 test word-2.0 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" -1 } -result -1 test word-2.1 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" 0 } -result -1 test word-2.2 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" 1 } -result 0 test word-2.3 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" 2 } -result 0 test word-2.4 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" 3 } -result 0 test word-2.5 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" 4 } -result 3 test word-2.6 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" 5 } -result 3 test word-2.7 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" end } -result 3 test word-2.8 {tcl_startOfPreviousWord, bug [16e25e1402]} -body { tcl_startOfPreviousWord "ab cd" end-1 } -result 0 test word-3.0 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" -1 } -result 3 test word-3.1 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" 0 } -result 3 test word-3.2 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" 1 } -result 3 test word-3.3 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" 2 } -result 3 test word-3.4 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" 3 } -result -1 test word-3.5 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" 4 } -result -1 test word-3.6 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" 5 } -result -1 test word-3.7 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" end } -result -1 test word-3.8 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" end-1 } -result -1 test word-4.0 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" -1 } -result -1 test word-4.1 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" 0 } -result -1 test word-4.2 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" 1 } -result -1 test word-4.3 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" 2 } -result 2 test word-4.4 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" 3 } -result 3 test word-4.5 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" 4 } -result 3 test word-4.6 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" 5 } -result 3 test word-4.7 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" end } -result 3 test word-4.8 {tcl_wordBreakBefore} -body { tcl_startOfNextWord "ab cd" end-1 } -result -1 test word-5.0 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" -1 } -result 2 test word-5.1 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" 0 } -result 2 test word-5.2 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" 1 } -result 2 test word-5.3 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" 2 } -result 3 test word-5.4 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" 3 } -result -1 test word-5.5 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" 4 } -result -1 test word-5.6 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" 5 } -result -1 test word-5.7 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" end } -result -1 test word-5.8 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" end-1 } -result -1 test word-6.0 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord a b c d } -returnCodes 1 -result {wrong # args: should be "tcl_startOfPreviousWord str start"} test word-6.1 {tcl_startOfNextWord} -body { tcl_startOfNextWord a b c d } -returnCodes 1 -result {wrong # args: should be "tcl_startOfNextWord str start"} test word-6.2 {tcl_endOfWord} -body { tcl_endOfWord a b c d } -returnCodes 1 -result {wrong # args: should be "tcl_endOfWord str start"} test word-6.3 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore a b c d } -returnCodes 1 -result {wrong # args: should be "tcl_wordBreakBefore str start"} test word-6.4 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter a b c d } -returnCodes 1 -result {wrong # args: should be "tcl_wordBreakAfter str start"} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/zlib.test0000644000175000017500000011424514554262142014654 0ustar sergeisergei# The file tests the tclZlib.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1996-1998 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint zlib [llength [info commands zlib]] testConstraint recentZlib 0 catch { # Work around a bug in some versions of zlib; known to manifest on at # least Mac OS X Mountain Lion... testConstraint recentZlib \ [package vsatisfies [zlib::pkgconfig get zlibVersion] 1.2.6] } test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body { zlib } -result {wrong # args: should be "zlib command arg ?...?"} test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body { zlib ? {} } -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream} test zlib-1.3 {zlib basics} -constraints zlib -body { zlib::pkgconfig list } -result zlibVersion test zlib-1.4 {zlib basics} -constraints zlib -body { package present zlib } -result 2.0.1 test zlib-2.1 {zlib compress/decompress} zlib { zlib decompress [zlib compress abcdefghijklm] } abcdefghijklm test zlib-3.1 {zlib deflate/inflate} zlib { zlib inflate [zlib deflate abcdefghijklm] } abcdefghijklm test zlib-4.1 {zlib gzip/gunzip} zlib { zlib gunzip [zlib gzip abcdefghijklm] } abcdefghijklm test zlib-4.2 {zlib gzip/gunzip} zlib { set s [string repeat abcdef 5] list [zlib gunzip [zlib gzip $s -header {comment gorp}] -header head] \ [dict get $head comment] [dict get $head size] } {abcdefabcdefabcdefabcdefabcdef gorp 30} test zlib-5.1 {zlib adler32} zlib { format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}] } b3b50b9b test zlib-5.2 {zlib adler32} zlib { format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}] } b8830bc4 test zlib-5.3 {zlib adler32} -constraints zlib -returnCodes error -body { zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42 x } -result {wrong # args: should be "zlib adler32 data ?startValue?"} test zlib-6.1 {zlib crc32} zlib { format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}] } 6f73e901 test zlib-6.2 {zlib crc32} zlib { format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}] } ce1c4914 test zlib-6.3 {zlib crc32} -constraints zlib -returnCodes error -body { zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42 x } -result {wrong # args: should be "zlib crc32 data ?startValue?"} test zlib-6.4 {zlib crc32: bug 2662434} -constraints zlib -body { zlib crc32 "dabale arroz a la zorra el abad" } -result 3842832571 test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup { set s [zlib stream compress] } -body { $s ? } -cleanup { $s close } -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset} test zlib-7.1 {zlib stream} zlib { set s [zlib stream compress] $s put -finalize abcdeEDCBA set data [$s get] set result [list [$s get] [format %x [$s checksum]]] $s close lappend result [zlib decompress $data] } {{} 136f033f abcdeEDCBA} test zlib-7.2 {zlib stream} zlib { set s [zlib stream decompress] $s put -finalize [zlib compress abcdeEDCBA] set data [$s get] set result [list [$s get] [format %x [$s checksum]]] $s close lappend result $data } {{} 136f033f abcdeEDCBA} test zlib-7.3 {zlib stream} zlib { set s [zlib stream deflate] $s put -finalize abcdeEDCBA set data [$s get] set result [list [$s get] [format %x [$s checksum]]] $s close lappend result [zlib inflate $data] } {{} 1 abcdeEDCBA} test zlib-7.4 {zlib stream} zlib { set s [zlib stream inflate] $s put -finalize [zlib deflate abcdeEDCBA] set data [$s get] set result [list [$s get] [format %x [$s checksum]]] $s close lappend result $data } {{} 1 abcdeEDCBA} test zlib-7.5 {zlib stream} zlib { set s [zlib stream gzip] $s put -finalize abcdeEDCBA.. set data [$s get] set result [list [$s get] [format %x [$s checksum]]] $s close lappend result [zlib gunzip $data] } {{} 69f34b6a abcdeEDCBA..} test zlib-7.6 {zlib stream} zlib { set s [zlib stream gunzip] $s put -finalize [zlib gzip abcdeEDCBA..] set data [$s get] set result [list [$s get] [format %x [$s checksum]]] $s close lappend result $data } {{} 69f34b6a abcdeEDCBA..} test zlib-7.7 {zlib stream: Bug 25842c161} -constraints zlib -body { set s [zlib stream deflate] $s put {} } -cleanup { catch {$s close} } -result "" # Also causes Tk Bug 10f2e7872b test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup { expr {srand(12345)} set randdata {} for {set i 0} {$i<6001} {incr i} { append randdata [binary format c [expr {int(256*rand())}]] } } -body { set strm [zlib stream compress] for {set i 1} {$i<3000} {incr i} { $strm put $randdata } $strm put -finalize $randdata set data [$strm get] list [string length $data] [string length [zlib decompress $data]] } -cleanup { catch {$strm close} unset -nocomplain randdata data } -result {120185 18003000} test zlib-7.9 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { set z1 [zlib stream gzip] set z2 [zlib stream gzip] } -body { $z1 put ABCDEedbca.. $z1 finalize zlib gunzip [$z1 get] } -cleanup { $z1 close } -result ABCDEedbca.. test zlib-7.10 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { set z2 [zlib stream gzip] } -body { $z2 put -finalize ABCDEedbca.. zlib gunzip [$z2 get] } -cleanup { $z2 close } -result ABCDEedbca.. test zlib-7.11 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -setup { set c [zlib stream gzip] set d [zlib stream gunzip] } -body { $c put abcdeEDCBA.. $c finalize $d put [$c get] $d finalize $d get } -cleanup { $c close $d close } -result abcdeEDCBA.. test zlib-7.12 {zlib stream put; zlib stream finalize (bug 25842c161)} -constraints zlib -setup { set c [zlib stream gzip] set d [zlib stream gunzip] } -body { $c put -finalize abcdeEDCBA.. $d put -finalize [$c get] $d get } -cleanup { $c close $d close } -result abcdeEDCBA.. test zlib-8.1 {zlib transformation} -constraints zlib -setup { set file [makeFile {} test.gz] } -body { set f [zlib push gzip [open $file w] -header {comment gorp}] puts $f "ok" close $f set f [zlib push gunzip [open $file]] list [gets $f] [dict get [chan configure $f -header] comment] } -cleanup { close $f removeFile $file } -result {ok gorp} test zlib-8.2 {zlib transformation} -constraints zlib -setup { set file [makeFile {} test.z] } -body { set f [zlib push compress [open $file w]] puts $f "ok" close $f set f [zlib push decompress [open $file]] gets $f } -cleanup { close $f removeFile $file } -result ok test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup { set srv [socket -myaddr localhost -server {apply {{c a p} { fconfigure $c -translation binary -buffering none -blocking 0 puts -nonewline $c [zlib gzip [string repeat a 81920]] close $c }}} 0] set port [lindex [fconfigure $srv -sockname] 2] set file [makeFile {} test.gz] set fout [open $file wb] } -body { set sin [socket localhost $port] try { fconfigure $sin -translation binary zlib push gunzip $sin after 1000 {set total timeout} fcopy $sin $fout -command {apply {{c {e {}}} { set ::total [expr {$e eq {} ? $c : $e}] }}} vwait total after cancel {set total timeout} } finally { close $sin } append total --> [file size $file] } -cleanup { close $fout close $srv removeFile $file } -result 81920-->81920 test zlib-8.4 {transformation and flushing: Bug 3517696} -setup { set file [makeFile {} test.z] set fd [open $file w] } -constraints zlib -body { zlib push compress $fd puts $fd "qwertyuiop" fconfigure $fd -flush sync puts $fd "qwertyuiop" } -cleanup { catch {close $fd} removeFile $file } -result {} test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup { foreach {r w} [chan pipe] break } -constraints zlib -body { set ::res {} fconfigure $w -buffering none zlib push compress $w puts -nonewline $w qwertyuiop chan configure $w -flush sync after 500 {puts -nonewline $w asdfghjkl;close $w} fconfigure $r -blocking 0 -buffering none zlib push decompress $r fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}} after 250 {lappend ::res MIDDLE} vwait ::done set ::res } -cleanup { catch {close $r} } -result {qwertyuiop MIDDLE asdfghjkl {}} test zlib-8.6 {transformation and fconfigure} -setup { set file [makeFile {} test.z] set fd [open $file wb] } -constraints zlib -body { list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \ [chan pop $fd; fconfigure $fd] } -cleanup { catch {close $fd} removeFile $file } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}} test zlib-8.7 {transformation and fconfigure} -setup { set file [makeFile {} test.gz] set fd [open $file wb] } -constraints zlib -body { list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \ [chan pop $fd; fconfigure $fd] } -cleanup { catch {close $fd} removeFile $file } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}} # Input is headers from fetching SPDY draft # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl" test zlib-8.8 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide } -constraints zlib -body { zlib push compress $outSide -dictionary $spdyDict fconfigure $outSide -blocking 1 -translation binary -buffering none fconfigure $inSide -blocking 1 -translation binary puts -nonewline $outSide $spdyHeaders chan pop $outSide chan close $outSide set compressed [read $inSide] catch {zlib decompress $compressed} err opt list [string length [zlib compress $spdyHeaders]] \ [string length $compressed] \ $err [dict get $opt -errorcode] [zlib adler32 $spdyDict] } -cleanup { catch {close $outSide} catch {close $inSide} } -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010} test zlib-8.9 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream decompress] } -constraints zlib -body { zlib push compress $outSide -dictionary $spdyDict fconfigure $outSide -blocking 1 -translation binary -buffering none fconfigure $inSide -blocking 1 -translation binary puts -nonewline $outSide $spdyHeaders set result [fconfigure $outSide -checksum] chan pop $outSide chan close $outSide $strm put -dictionary $spdyDict [read $inSide] lappend result [string length $spdyHeaders] [string length [$strm get]] } -cleanup { catch {close $outSide} catch {close $inSide} catch {$strm close} } -result {3064818174 358 358} test zlib-8.10 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide } -constraints {zlib recentZlib} -body { zlib push deflate $outSide -dictionary $spdyDict fconfigure $outSide -blocking 1 -translation binary -buffering none fconfigure $inSide -blocking 1 -translation binary puts -nonewline $outSide $spdyHeaders chan pop $outSide chan close $outSide set compressed [read $inSide] catch { zlib inflate $compressed throw UNREACHABLE "should be unreachable" } err opt list [string length [zlib deflate $spdyHeaders]] \ [string length $compressed] \ $err [dict get $opt -errorcode] } -cleanup { catch {close $outSide} catch {close $inSide} } -result {254 212 {data error} {TCL ZLIB DATA}} test zlib-8.11 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream inflate] } -constraints zlib -body { zlib push deflate $outSide -dictionary $spdyDict fconfigure $outSide -blocking 1 -translation binary -buffering none fconfigure $inSide -blocking 1 -translation binary puts -nonewline $outSide $spdyHeaders chan pop $outSide chan close $outSide $strm put -dictionary $spdyDict [read $inSide] list [string length $spdyHeaders] [string length [$strm get]] } -cleanup { catch {close $outSide} catch {close $inSide} catch {$strm close} } -result {358 358} test zlib-8.12 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream compress] } -constraints zlib -body { $strm put -dictionary $spdyDict -finalize $spdyHeaders zlib push decompress $inSide fconfigure $outSide -blocking 1 -translation binary fconfigure $inSide -translation binary -dictionary $spdyDict puts -nonewline $outSide [$strm get] close $outSide list [string length $spdyHeaders] [string length [read $inSide]] \ [fconfigure $inSide -checksum] } -cleanup { catch {close $outSide} catch {close $inSide} catch {$strm close} } -result {358 358 3064818174} test zlib-8.13 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream compress] } -constraints zlib -body { $strm put -dictionary $spdyDict -finalize $spdyHeaders zlib push decompress $inSide -dictionary $spdyDict fconfigure $outSide -blocking 1 -translation binary fconfigure $inSide -translation binary puts -nonewline $outSide [$strm get] close $outSide list [string length $spdyHeaders] [string length [read $inSide]] \ [fconfigure $inSide -checksum] } -cleanup { catch {close $outSide} catch {close $inSide} catch {$strm close} } -result {358 358 3064818174} test zlib-8.14 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream deflate] } -constraints zlib -body { $strm put -finalize -dictionary $spdyDict $spdyHeaders zlib push inflate $inSide fconfigure $outSide -blocking 1 -buffering none -translation binary fconfigure $inSide -translation binary -dictionary $spdyDict puts -nonewline $outSide [$strm get] close $outSide list [string length $spdyHeaders] [string length [read $inSide]] } -cleanup { catch {close $outSide} catch {close $inSide} catch {$strm close} } -result {358 358} test zlib-8.15 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream deflate] } -constraints zlib -body { $strm put -finalize -dictionary $spdyDict $spdyHeaders zlib push inflate $inSide -dictionary $spdyDict fconfigure $outSide -blocking 1 -buffering none -translation binary fconfigure $inSide -translation binary puts -nonewline $outSide [$strm get] close $outSide list [string length $spdyHeaders] [string length [read $inSide]] } -cleanup { catch {close $outSide} catch {close $inSide} catch {$strm close} } -result {358 358} test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup { # Actual data isn't very important; needs to be substantially larger than # the internal buffer (32kB) and incompressible. set largeData {} for {set i 0;expr {srand(1)}} {$i < 100000} {incr i} { append largeData [lindex "a b c d e f g h i j k l m n o p" \ [expr {int(16*rand())}]] } set file [makeFile {} test.gz] } -constraints zlib -body { set f [open $file wb] fconfigure $f -buffering none zlib push gzip $f puts -nonewline $f $largeData close $f file size $file } -cleanup { removeFile $file } -result 57647 test zlib-8.17 {Bug dd260aaf: fconfigure} -setup { lassign [chan pipe] inSide outSide } -constraints zlib -body { zlib push inflate $inSide zlib push deflate $outSide list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary] } -cleanup { catch {close $inSide} catch {close $outSide} } -result {{} {}} test zlib-8.18 {Bug dd260aaf: fconfigure} -setup { lassign [chan pipe] inSide outSide } -constraints zlib -body { zlib push inflate $inSide -dictionary "one two" zlib push deflate $outSide -dictionary "one two" list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary] } -cleanup { catch {close $inSide} catch {close $outSide} } -result {{one two} {one two}} test zlib-8.19 {zlib transformation, bug f9eafc3886} -constraints zlib -setup { set file [makeFile {} test.gz] } -body { set f [zlib push gzip [open $file w] -header [list comment [string repeat A 500]]] } -cleanup { catch {close $f} removeFile $file } -returnCodes 1 -result {Comment too large for zip} test zlib-8.20 {zlib transformation, bug f9eafc3886} -constraints zlib -setup { set file [makeFile {} test.gz] } -body { set f [zlib push gzip [open $file w] -header [list filename [string repeat A 5000]]] } -cleanup { catch {close $f} removeFile $file } -returnCodes 1 -result {Filename too large for zip} test zlib-8.21 {zlib transformation, bug f9eafc3886} -constraints zlib -setup { set file [makeFile {} test.gz] } -body { set f [zlib push gzip [open $file w] -header [list comment \u100]] } -cleanup { catch {close $f} removeFile $file } -returnCodes 1 -result {Comment contains characters > 0xFF} test zlib-8.22 {zlib transformation, bug f9eafc3886} -constraints zlib -setup { set file [makeFile {} test.gz] } -body { set f [zlib push gzip [open $file w] -header [list filename \u100]] } -cleanup { catch {close $f} removeFile $file } -returnCodes 1 -result {Filename contains characters > 0xFF} test zlib-9.1 "check fcopy with push" -constraints zlib -setup { set sfile [makeFile {} testsrc.gz] set file [makeFile {} test.gz] set f [open $sfile wb] puts -nonewline $f [zlib gzip [string repeat a 81920]] close $f } -body { set fin [zlib push gunzip [open $sfile rb]] set fout [open $file wb] set total [fcopy $fin $fout] close $fin ; close $fout list copied $total size [file size $file] } -cleanup { removeFile $file removeFile $sfile } -result {copied 81920 size 81920} test zlib-9.2 "socket fcopy with push" -constraints zlib -setup { set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 puts -nonewline $c [zlib gzip [string repeat a 81920]] close $c set ::total -1 }}} 0] set file [makeFile {} test.gz] } -body { lassign [chan configure $srv -sockname] addr name port set sin [socket $addr $port] chan configure $sin -translation binary zlib push gunzip $sin after 1000 {set ::total timeout} vwait ::total after cancel {set ::total timeout} if {$::total != -1} {error "unexpected value $::total of ::total"} set total [fcopy $sin [set fout [open $file wb]]] close $sin close $fout list read $total size [file size $file] } -cleanup { close $srv removeFile $file } -result {read 81920 size 81920} test zlib-9.3 "socket fcopy bg (identity)" -constraints {tempNotWin zlib} -setup { set srv [socket -myaddr localhost -server {apply {{c a p} { #puts "connection from $a:$p on $c" chan configure $c -translation binary -buffering none -blocking 0 puts -nonewline $c [string repeat a 81920] close $c }}} 0] set file [makeFile {} test.gz] } -body { lassign [chan configure $srv -sockname] addr name port #puts "listening for connections on $addr $port" set sin [socket localhost $port] chan configure $sin -translation binary update set fout [open $file wb] after 1000 {set ::total timeout} fcopy $sin $fout -command {apply {{c {e {}}} { set ::total [expr {$e eq {} ? $c : $e}] }}} vwait ::total after cancel {set ::total timeout} close $sin; close $fout list read $::total size [file size $file] } -cleanup { close $srv removeFile $file } -returnCodes {ok error} -result {read 81920 size 81920} test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup { set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 puts -nonewline $c [zlib gzip [string repeat a 81920]] close $c }}} 0] set file [makeFile {} test.gz] } -body { lassign [chan configure $srv -sockname] addr name port set sin [socket $addr $port] chan configure $sin -translation binary zlib push gunzip $sin update set fout [open $file wb] after 1000 {set ::total timeout} fcopy $sin $fout -command {apply {{c {e {}}} { set ::total [expr {$e eq {} ? $c : $e}] }}} vwait ::total after cancel {set ::total timeout} close $sin; close $fout list read $::total size [file size $file] } -cleanup { close $srv removeFile $file } -result {read 81920 size 81920} test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup { set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 puts -nonewline $c [zlib gzip [string repeat a 81920]] close $c }}} 0] proc zlib95copy {i o t c {e {}}} { incr t $c if {$e ne {}} { set ::total [list error $e] } elseif {[eof $i]} { set ::total [list eof $t] } else { fcopy $i $o -size 8192 -command [list zlib95copy $i $o $t] } } set file [makeFile {} test.gz] } -body { lassign [chan configure $srv -sockname] addr name port set sin [socket $addr $port] chan configure $sin -translation binary zlib push gunzip $sin update set fout [open $file wb] after 1000 {set ::total timeout} fcopy $sin $fout -size 8192 -command [list zlib95copy $sin $fout 0] vwait ::total after cancel {set ::total timeout} close $sin; close $fout list $::total size [file size $file] } -cleanup { close $srv rename zlib95copy {} removeFile $file } -result {{eof 81920} size 81920} test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup { set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 zlib push gzip $c puts -nonewline $c [string repeat hello 100] close $c }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] chan configure $s -translation binary zlib push gunzip $s chan event $s readable [list apply {{s} { set d [read $s] if {[eof $s]} { chan event $s readable {} set ::total [list eof [string length $d]] } }} $s] vwait ::total after cancel {set ::total timeout} close $s set ::total } -cleanup { close $srv unset -nocomplain total } -result {eof 500} test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup { set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 zlib push compress $c puts -nonewline $c [string repeat hello 100] close $c }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] chan configure $s -translation binary zlib push decompress $s chan event $s readable [list apply {{s} { set d [read $s] if {[eof $s]} { chan event $s readable {} set ::total [list eof [string length $d]] } }} $s] vwait ::total after cancel {set ::total timeout} close $s set ::total } -cleanup { close $srv unset -nocomplain total } -result {eof 500} test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup { set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 zlib push deflate $c puts -nonewline $c [string repeat hello 100] close $c }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] chan configure $s -translation binary zlib push inflate $s chan event $s readable [list apply {{s} { set d [read $s] if {[eof $s]} { chan event $s readable {} set ::total [list eof [string length $d]] } }} $s] vwait ::total after cancel {set ::total timeout} close $s set ::total } -cleanup { unset -nocomplain total close $srv } -result {eof 500} test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup { proc bgerror {s} {set ::total [list error $s]} set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 zlib push gzip $c puts -nonewline $c [string repeat hello 100] close $c }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] try { chan configure $s -translation binary zlib push inflate $s chan event $s readable [list apply {{s} { set d [read $s] if {[eof $s]} { chan event $s readable {} set ::total [list eof [string length $d]] } }} $s] vwait ::total } finally { after cancel {set ::total timeout} close $s } set ::total } -cleanup { unset -nocomplain total close $srv rename bgerror {} } -result {error {invalid block type}} test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup { proc bgerror {s} {set ::total [list error $s]} set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 zlib push compress $c puts -nonewline $c [string repeat hello 100] close $c }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] try { chan configure $s -translation binary zlib push inflate $s chan event $s readable [list apply {{s} { set d [read $s] if {[eof $s]} { chan event $s readable {} set ::total [list eof [string length $d]] } }} $s] vwait ::total } finally { after cancel {set ::total timeout} close $s } set ::total } -cleanup { unset -nocomplain total close $srv rename bgerror {} } -result {error {invalid stored block lengths}} test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup { proc bgerror {s} {set ::total [list error $s]} set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none -blocking 0 zlib push deflate $c puts -nonewline $c [string repeat hello 100] close $c }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] try { chan configure $s -translation binary zlib push gunzip $s chan event $s readable [list apply {{s} { set d [read $s] if {[eof $s]} { chan event $s readable {} set ::total [list eof [string length $d]] } }} $s] vwait ::total } finally { after cancel {set ::total timeout} close $s } set ::total } -cleanup { unset -nocomplain total close $srv rename bgerror {} } -result {error {incorrect header check}} test zlib-10.0 "bug #2818131 (close with null interp)" -constraints { zlib } -setup { proc bgerror {s} {set ::total [list error $s]} set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary zlib push inflate $c chan event $c readable [list apply {{c} { set d [read $c] if {[eof $c]} { chan event $c readable {} close $c set ::total [list eof [string length $d]] } }} $c] }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] chan configure $s -translation binary -buffering none -blocking 0 zlib push gzip $s chan event $s xyzzy [list apply {{s} { if {[gets $s line] < 0} { chan close $s } }} $s] after idle [list apply {{s} { puts $s test chan close $s after 100 {set ::total done} }} $s] vwait ::total after cancel {set ::total timeout} after cancel {set ::total done} set ::total } -cleanup { close $srv rename bgerror {} } -returnCodes error \ -result {bad event name "xyzzy": must be readable or writable} test zlib-10.1 "bug #2818131 (mismatch read)" -constraints { zlib } -setup { proc bgerror {s} {set ::total [list error $s]} proc zlibRead {c} { set d [read $c] if {[eof $c]} { chan event $c readable {} close $c set ::total [list eof [string length $d]] } } set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary zlib push inflate $c chan event $c readable [list zlibRead $c] }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] chan configure $s -translation binary -buffering none -blocking 0 zlib push gzip $s chan event $s readable [list zlibRead $s] after idle [list apply {{s} { puts $s test chan close $s after 100 {set ::total done} }} $s] vwait ::total after cancel {set ::total timeout} after cancel {set ::total done} set ::total } -cleanup { close $srv rename bgerror {} rename zlibRead {} } -result {error {invalid block type}} test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints { zlib } -setup { proc bgerror {s} {set ::total [list error $s]} proc zlibRead {c} { if {[gets $c line] < 0} { close $c set ::total [list error -1] } elseif {[eof $c]} { chan event $c readable {} close $c set ::total [list eof 0] } } set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary zlib push inflate $c chan event $c readable [list zlibRead $c] }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] chan configure $s -translation binary -buffering none -blocking 0 zlib push gzip $s chan event $s readable [list zlibRead $s] after idle [list apply {{s} { puts $s test chan close $s after 100 {set ::total done} }} $s] vwait ::total after cancel {set ::total timeout} after cancel {set ::total done} set ::total } -cleanup { close $srv rename bgerror {} rename zlibRead {} } -result {error {invalid block type}} test zlib-11.1 "Bug #3390073: mis-applied gzip filtering" -setup { set file [makeFile {} test.input] } -constraints zlib -body { set f [open $file wb] puts -nonewline [zlib push gzip $f] [string repeat "hello" 1000] close $f set f [open $file rb] set d [read $f] close $f set d [zlib gunzip $d] list [regexp -all "hello" $d] [string length [regsub -all "hello" $d {}]] } -cleanup { removeFile $file } -result {1000 0} test zlib-11.2 "Bug #3390073: mis-applied gzip filtering" -setup { set file [makeFile {} test.input] } -constraints zlib -body { set f [open $file wb] puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \ [string repeat "hello" 1000] close $f set f [open $file rb] set d [read $f] close $f set d [zlib gunzip $d -header h] list [regexp -all "hello" $d] [dict get $h filename] \ [string length [regsub -all "hello" $d {}]] } -cleanup { removeFile $file } -result {1000 /foo/bar 0} test zlib-11.3 {Bug 3595576 variant} -setup { set file [makeFile {} test.input] } -constraints zlib -body { set f [open $file wb] puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \ [string repeat "hello" 1000] close $f set f [open $file rb] set d [read $f] close $f zlib gunzip $d -header noSuchNs::foo } -cleanup { removeFile $file } -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist} test zlib-12.1 {Tk Bug 9eb55debc5} -constraints zlib -setup { set stream [zlib stream compress] } -body { for {set opts {};set y 0} {$y < 60} {incr y} { for {set line {};set x 0} {$x < 100} {incr x} { append line [binary format ccc $x $y 128] } if {$y == 59} { set opts -finalize } $stream put {*}$opts $line } set data [$stream get] list [string length $data] [string length [zlib decompress $data]] } -cleanup { $stream close } -result {12026 18000} test zlib-12.2 {Patrick Dunnigan's issue} -constraints zlib -setup { set filesrc [makeFile {} test.input] set filedst [makeFile {} test.output] set f [open $filesrc "wb"] for {set i 0} {$i < 10000} {incr i} { puts -nonewline $f "x" } close $f } -body { set fin [open $filesrc "rb"] set fout [open $filedst "wb"] set header [dict create filename "test.input" time 0] try { fcopy $fin [zlib push gzip $fout -header $header] } finally { close $fin close $fout } file size $filedst } -cleanup { removeFile $filesrc removeFile $filedst } -result 56 set zlibbinf "" proc _zlibbinf {} { # inlined zlib.bin file creator: variable zlibbinf if {$zlibbinf eq ""} { set zlibbinf [makeFile {} test-zlib-13.bin] set f [open $zlibbinf wb] puts -nonewline $f [zlib decompress [binary decode base64 { eJx7e+6s1+EAgYaLjK3ratptGmOck0vT/y/ZujHAd0qJelDBXfUPJ3tfrtLbpX+wOOFHmtn03/tizm /+tXROXU3d203b79p5X6/0cvUyFzTsqOj4sa9r8SrZI5zT7265e2Xzq595Fb9LbpgffVy7cZaJ/d15 4U9L7LLM2vdqut8+aSU/r6q9Ltv6+T9mBhTgIK97bH33m/O1C1eBwf9FDKNgaIDaj9wA+5hToA== }]] close $f } return $zlibbinf } test zlib-13.1 {Ticket [8af92dfb66] - zlib stream mis-expansion} -constraints zlib -setup { set pathin [_zlibbinf] set chanin [open $pathin rb] set pathout [makeFile {} test-zlib-13.deflated] set chanout [open $pathout wb] zlib push inflate $chanin fcopy $chanin $chanout close $chanin close $chanout } -body { file size $pathout } -cleanup { removeFile $pathout unset chanin pathin chanout pathout } -result 458752 test zlib-13.2 {Ticket [f70ce1fead] - zlib multi-stream expansion} -constraints zlib -setup { # Start from the basic asset set pathin [_zlibbinf] set chanin [open $pathin rb] # Create a multi-stream by copying the asset twice into it. set pathout [makeFile {} test-zlib-13.multi] set chanout [open $pathout wb] fcopy $chanin $chanout seek $chanin 0 start fcopy $chanin $chanout close $chanin close $chanout # The multi-stream file shall be our input set pathin $pathout set chanin [open $pathin rb] # And our destinations set pathout1 [makeFile {} test-zlib-13.multi-1] set pathout2 [makeFile {} test-zlib-13.multi-2] } -body { # Decode first stream set chanout [open $pathout1 wb] zlib push inflate $chanin fcopy $chanin $chanout chan pop $chanin close $chanout # Decode second stream set chanout [open $pathout2 wb] zlib push inflate $chanin fcopy $chanin $chanout chan pop $chanin close $chanout # list [file size $pathout1] [file size $pathout2] } -cleanup { close $chanin removeFile $pathout removeFile $pathout1 removeFile $pathout2 unset chanin pathin chanout pathout pathout1 pathout2 } -result {458752 458752} if {$zlibbinf ne ""} { removeFile $zlibbinf } unset zlibbinf rename _zlibbinf {} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: tcl8.6.14/tests/README0000644000175000017500000001047014554262142013666 0ustar sergeisergeiREADME -- Tcl test suite design document. Contents: --------- 1. Introduction 2. Running tests 3. Adding tests 4. Incompatibilities with prior Tcl versions 1. Introduction: ---------------- This directory contains a set of validation tests for the Tcl commands and C Library procedures for Tcl. Each of the files whose name ends in ".test" is intended to fully exercise the functions in the C source file that corresponds to the file prefix. The C functions and/or Tcl commands tested by a given file are listed in the first line of the file. 2. Running tests: ----------------- We recommend that you use the "test" target of Tcl's Makefile to run the test suite. From the directory in which you build Tcl, simply type "make test". This will create a special executable named tcltest in which the testing scripts will be evaluated. To create the tcltest executable without running the test suite, simple type "make tcltest". All the configuration options of the tcltest package are available during a "make test" by defining the TESTFLAGS environment variable. For example,if you wish to run only those tests in the file append.test, you can type: make test TESTFLAGS="-file append.test" For interactive testing, the Tcl Makefile provides the "runtest" target. Type "make runtest" in your build directory, and the tcltest executable will be created, if necessary, then it will run interactively. At the command prompt, you may type any Tcl commands. If you type "source ../tests/all.tcl", the test suite will run. You may use the tcltest::configure command to configure the test suite run as an alternative to command line options via TESTFLAGS. You might also wish to use the tcltest::testConstraint command to select the constraints that govern which tests are run. See the documentation for the tcltest package for details. 3. Adding tests: ---------------- Please see the tcltest man page for more information regarding how to write and run tests. Please note that the all.tcl file will source your new test file if the filename matches the tests/*.test pattern (as it should). The names of test files that contain regression (or glass-box) tests should correspond to the Tcl or C code file that they are testing. For example, the test file for the C file "tclCmdAH.c" is "cmdAH.test". Test files that contain black-box tests may not correspond to any Tcl or C code file so they should match the pattern "*_bb.test". Be sure your new test file can be run from any working directory. Be sure no temporary files are left behind by your test file. Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests] properly to be sure of this. Be sure your tests can run cross-platform in both a build environment as well as an installation environment. If your test file contains tests that should not be run in one or more of those cases, please use the constraints mechanism to skip those tests. 4. Incompatibilities of package tcltest 2.1 with testing machinery of very old versions of Tcl: ------------------------------------------------ 1) Global variables such as VERBOSE, TESTS, and testConfig of the old machinery correspond to the [configure -verbose], [configure -match], and [testConstraint] commands of tcltest 2.1, respectively. 2) VERBOSE values were longer numeric. [configure -verbose] values are lists of keywords. 3) When you run "make test", the working dir for the test suite is now the one from which you called "make test", rather than the "tests" directory. This change allows for both unix and windows test suites to be run simultaneously without interference with each other or with existing files. All tests must now run independently of their working directory. 4) The "all" file is now called "all.tcl" 5) The "defs" and "defs.tcl" files no longer exist. 6) Instead of creating a doAllTests file in the tests directory, to run all nonPortable tests, just use the "-constraints nonPortable" command line flag. If you are running interactively, you can run [tcltest::testConstraint nonPortable 1] (after loading the tcltest package). 7) Direct evaluation of the *.test files by the "source" command is no longer recommended. Instead, "source all.tcl" and use the "-file" and "-notfile" options of tcltest::configure to control which *.test files are evaluated. tcl8.6.14/tests/httpd0000644000175000017500000001432114554262142014053 0ustar sergeisergei# -*- tcl -*- # # The httpd_ procedures implement a stub http server. # # Copyright (c) 1997-1998 Sun Microsystems, Inc. # Copyright (c) 1999-2000 Scriptics Corporation # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #set httpLog 1 # Do not use [info hostname]. # Name resolution is often a problem on OSX; not focus of HTTP package anyway. # Also a problem on other platforms for http-4.14 (test with bad port number). set HOST localhost proc httpd_init {{port 8015}} { socket -server httpdAccept $port } proc httpd_log {args} { global httpLog if {[info exists httpLog] && $httpLog} { puts stderr "httpd: [join $args { }]" } } array set httpdErrors { 204 {No Content} 400 {Bad Request} 401 {Authorization Required} 404 {Not Found} 503 {Service Unavailable} 504 {Service Temporarily Unavailable} } proc httpdError {sock code args} { global httpdErrors puts $sock "$code $httpdErrors($code)" httpd_log "error: [join $args { }]" } proc httpdAccept {newsock ipaddr port} { global httpd upvar #0 httpd$newsock data fconfigure $newsock -blocking 0 -translation {auto crlf} httpd_log $newsock Connect $ipaddr $port set data(ipaddr) $ipaddr fileevent $newsock readable [list httpdRead $newsock] } # read data from a client request proc httpdRead { sock } { upvar #0 httpd$sock data if {[eof $sock]} { set readCount -1 } elseif {![info exists data(state)]} { # Read the protocol line and parse out the URL and query set readCount [gets $sock line] if {[regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} $line \ -> data(proto) data(url) data(query) data(httpversion)]} { set data(state) mime httpd_log $sock Query $line if {[regexp {(?:^|[\?&])delay=([^&]+)} $data(query) {} val]} { fileevent $sock readable {} after $val [list fileevent $sock readable [list httpdRead $sock]] } } else { httpdError $sock 400 httpd_log $sock Error "bad first line:$line" httpdSockDone $sock } return } elseif {$data(state) == "mime"} { # Read the HTTP headers set readCount [gets $sock line] if {[regexp {^([^:]+):(.*)$} $line -> key val]} { lappend data(meta) $key [string trim $val] } } elseif {$data(state) == "query"} { # Read the query data if {![info exists data(length_orig)]} { set data(length_orig) $data(length) } set line [read $sock $data(length)] set readCount [string length $line] incr data(length) -$readCount } # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1 set state [string compare $readCount 0],$data(state),$data(proto) httpd_log $sock $state switch -- $state { -1,mime,HEAD - -1,mime,GET - -1,mime,POST { # gets would block return } 0,mime,HEAD - 0,mime,GET - 0,query,POST { # Empty line at end of headers, # or eof after query data httpdRespond $sock } 0,mime,POST { # Empty line between headers and query data if {![info exists data(mime,content-length)]} { httpd_log $sock Error "No Content-Length for POST" httpdError $sock 400 httpdSockDone $sock } else { set data(state) query set data(length) $data(mime,content-length) # Special case to simulate servers that respond # without reading the post data. if {[string match *droppost* $data(url)]} { fileevent $sock readable {} httpdRespond $sock } } } 1,mime,HEAD - 1,mime,POST - 1,mime,GET { # A line of HTTP headers if {[regexp {([^:]+):[ ]*(.*)} $line dummy key value]} { set data(mime,[string tolower $key]) $value } } -1,query,POST { httpd_log $sock Error "unexpected eof on <$data(url)> request" httpdError $sock 400 httpdSockDone $sock } 1,query,POST { append data(query) $line if {$data(length) <= 0} { set data(length) $data(length_orig) httpdRespond $sock } } default { if {[eof $sock]} { httpd_log $sock Error "unexpected eof on <$data(url)> request" } else { httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>" } httpdError $sock 404 httpdSockDone $sock } } } proc httpdSockDone { sock } { upvar #0 httpd$sock data unset data catch {close $sock} } # Respond to the query. proc httpdRespond { sock } { global httpd bindata port upvar #0 httpd$sock data switch -glob -- $data(url) { *binary* { set html "$bindata${::HOST}:$port$data(url)" set type application/octet-stream } *xml* { set html [encoding convertto utf-8 "\u1234"] set type "application/xml;charset=UTF-8" } *post* { set html "Got [string length $data(query)] bytes" set type text/plain } *headers* { set html "" set type text/plain foreach {key value} $data(meta) { append html [list $key $value] "\n" } set html [string trim $html] } default { set type text/html set html "HTTP/1.0 TEST

Hello, World!

$data(proto) $data(url)

" if {[info exists data(query)] && [string length $data(query)]} { append html "

Query

\n
\n" foreach {key value} [split $data(query) &=] { append html "
$key
$value\n" if {$key == "timeout"} { after $value ;# pause } } append html
\n } append html } } # Catch errors from premature client closes catch { if {$data(proto) == "HEAD"} { puts $sock "HTTP/1.0 200 OK" } else { # Split the response to test for [Bug 26245326] puts -nonewline $sock "HT" flush $sock puts $sock "TP/1.0 200 Data follows" } puts $sock "Date: [clock format [clock seconds] \ -format {%a, %d %b %Y %H:%M:%S %Z}]" puts $sock "Content-Type: $type" puts $sock "Content-Length: [string length $html]" foreach {key val} $data(meta) { if {[string match "X-*" $key]} { puts $sock "$key: $val" } } puts $sock "" flush $sock if {$data(proto) != "HEAD"} { fconfigure $sock -translation binary puts -nonewline $sock $html } } httpd_log $sock Done "" httpdSockDone $sock } tcl8.6.14/tests/all.tcl0000644000175000017500000000200014554262142014250 0ustar sergeisergei# all.tcl -- # # This file contains a top-level script to run all of the Tcl # tests. Execute it by invoking "source all.test" when running tcltest # in this directory. # # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2000 by Ajuba Solutions # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.5- package require tcltest 2.5 namespace import ::tcltest::* configure {*}$argv -testdir [file dirname [file dirname [file normalize [ info script]/...]]] if {[singleProcess]} { interp debug {} -frame 1 } set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)] unset -nocomplain env(ERROR_ON_FAILURES) if {[runAllTests] && $ErrorOnFailures} {exit 1} # if calling direct only (avoid rewrite exit if inlined or interactive): if { [info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]] && !([info exists ::tcl_interactive] && $::tcl_interactive) } { proc exit args {} }tcl8.6.14/tests/httpd11.tcl0000644000175000017500000002045614554262142015004 0ustar sergeisergei# httpd11.tcl -- -*- tcl -*- # # A simple httpd for testing HTTP/1.1 client features. # Not suitable for use on a internet connected port. # # Copyright (C) 2009 Pat Thoyts # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.6- proc ::tcl::dict::get? {dict key} { if {[dict exists $dict $key]} { return [dict get $dict $key] } return } namespace ensemble configure dict \ -map [linsert [namespace ensemble configure dict -map] end get? ::tcl::dict::get?] proc make-chunk-generator {data {size 4096}} { variable _chunk_gen_uid if {![info exists _chunk_gen_uid]} {set _chunk_gen_uid 0} set lambda {{data size} { set pos 0 yield while {1} { set payload [string range $data $pos [expr {$pos + $size - 1}]] incr pos $size set chunk [format %x [string length $payload]]\r\n$payload\r\n yield $chunk if {![string length $payload]} {return} } }} set name chunker[incr _chunk_gen_uid] coroutine $name ::apply $lambda $data $size return $name } proc get-chunks {data {compression gzip}} { switch -exact -- $compression { gzip { set data [zlib gzip $data] } deflate { set data [zlib deflate $data] } compress { set data [zlib compress $data] } } set data "" set chunker [make-chunk-generator $data 512] while {[string length [set chunk [$chunker]]]} { append data $chunk } return $data } proc blow-chunks {data {ochan stdout} {compression gzip}} { switch -exact -- $compression { gzip { set data [zlib gzip $data] } deflate { set data [zlib deflate $data] } compress { set data [zlib compress $data] } } set chunker [make-chunk-generator $data 512] while {[string length [set chunk [$chunker]]]} { puts -nonewline $ochan $chunk } return } proc mime-type {filename} { switch -exact -- [file extension $filename] { .htm - .html { return {text text/html}} .png { return {binary image/png} } .jpg { return {binary image/jpeg} } .gif { return {binary image/gif} } .css { return {text text/css} } .xml { return {text text/xml} } .xhtml {return {text application/xml+html} } .svg { return {text image/svg+xml} } .txt - .tcl - .c - .h { return {text text/plain}} } return {binary text/plain} } proc Puts {chan s} {puts $chan $s; puts $s} proc Service {chan addr port} { chan event $chan readable [info coroutine] while {1} { set meta {} chan configure $chan -buffering line -encoding iso8859-1 -translation crlf chan configure $chan -blocking 0 yield while {[gets $chan line] < 0} { if {[eof $chan]} {chan event $chan readable {}; close $chan; return} yield } if {[eof $chan]} {chan event $chan readable {}; close $chan; return} foreach {req url protocol} {GET {} HTTP/1.1} break regexp {^(\S+)\s+(.*)\s(\S+)?$} $line -> req url protocol puts $line while {[gets $chan line] > 0} { if {[regexp {^([^:]+):(.*)$} $line -> key val]} { puts [list $key [string trim $val]] lappend meta [string tolower $key] [string trim $val] } yield } set encoding identity set transfer "" set close 1 set type text/html set code "404 Not Found" set data "Error 404" append data "

Not Found

Try again.

" if {[scan $url {%[^?]?%s} path query] < 2} { set query "" } switch -exact -- $req { GET - HEAD { } POST { # Read the query. set qlen [dict get? $meta content-length] if {[string is integer -strict $qlen]} { chan configure $chan -buffering none -translation binary while {[string length $query] < $qlen} { append query [read $chan $qlen] if {[string length $query] < $qlen} {yield} } # Check for excess query bytes [Bug 2715421] if {[dict get? $meta x-check-query] eq "yes"} { chan configure $chan -blocking 0 append query [read $chan] } } } default { # invalid request error 5?? } } if {$query ne ""} {puts $query} set path [string trimleft $path /] set path [file join [pwd] $path] if {[file exists $path] && [file isfile $path]} { foreach {what type} [mime-type $path] break set f [open $path r] if {$what eq "binary"} {chan configure $f -translation binary} set data [read $f] close $f set code "200 OK" set close [expr {[dict get? $meta connection] eq "close"}] } if {$protocol eq "HTTP/1.1"} { foreach enc [split [dict get? $meta accept-encoding] ,] { set enc [string trim $enc] if {$enc in {deflate gzip compress}} { set encoding $enc break } } set transfer chunked } else { set close 1 } set nosendclose 0 foreach pair [split $query &] { if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""} switch -exact -- $key { nosendclose {set nosendclose 1} close {set close 1 ; set transfer 0} transfer {set transfer $val} content-type {set type $val} } } if {$protocol eq "HTTP/1.1"} { set nosendclose 0 } chan configure $chan -buffering line -encoding iso8859-1 -translation crlf Puts $chan "$protocol $code" Puts $chan "content-type: $type" Puts $chan [format "x-crc32: %08x" [zlib crc32 $data]] if {$req eq "POST"} { Puts $chan [format "x-query-length: %d" [string length $query]] } if {$close && (!$nosendclose)} { Puts $chan "connection: close" } Puts $chan "x-requested-encodings: [dict get? $meta accept-encoding]" if {$encoding eq "identity" && (!$nosendclose)} { Puts $chan "content-length: [string length $data]" } elseif {$encoding eq "identity"} { # This is a blatant attempt to confuse the client by sending neither # "Connection: close" nor "Content-Length" when in non-chunked mode. # See test http11-3.4. } else { Puts $chan "content-encoding: $encoding" } if {$transfer eq "chunked"} { Puts $chan "transfer-encoding: chunked" } puts $chan "" flush $chan chan configure $chan -buffering full -translation binary if {$transfer eq "chunked"} { blow-chunks $data $chan $encoding } elseif {$encoding ne "identity"} { puts -nonewline $chan [zlib $encoding $data] } else { puts -nonewline $chan $data } if {$close} { chan event $chan readable {} close $chan puts "close $chan" return } else { flush $chan } puts "pipeline $chan" } } proc Accept {chan addr port} { coroutine client$chan Service $chan $addr $port return } proc Control {chan} { if {[gets $chan line] >= 0} { if {[string trim $line] eq "quit"} { set ::forever 1 } } if {[eof $chan]} { chan event $chan readable {} } } proc Main {{port 0}} { set server [socket -server Accept -myaddr localhost $port] puts [chan configure $server -sockname] flush stdout chan event stdin readable [list Control stdin] vwait ::forever close $server return "done" } if {!$tcl_interactive} { set r [catch [linsert $argv 0 Main] err] if {$r} {puts stderr $errorInfo} elseif {[string length $err]} {puts $err} exit $r } tcl8.6.14/tests/httpTestScript.tcl0000644000175000017500000003240314554262142016516 0ustar sergeisergei# httpTestScript.tcl # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # # Copyright (C) 2018 Keith Nash # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------------ # "Package" httpTestScript for executing test scripts written in a convenient # shorthand. # ------------------------------------------------------------------------------ # ------------------------------------------------------------------------------ # Documentation for "package" httpTestScript. # ------------------------------------------------------------------------------ # To use the package: # (a) define URLs as the values of elements in the array ::httpTestScript # (b) define a script in terms of the commands # START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST # referring to URLs by the name of the corresponding array element. The # script can include any other Tcl commands, and evaluates in the # httpTestScript namespace. # (c) Use the command httpTestScript::runHttpTestScript to evaluate the script. # (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test" # command. # ------------------------------------------------------------------------------ # START # Must be the first command of the script. # # STOP # Must be present in the script to avoid waiting for client timeout. # Usually the last command, but can be elsewhere to end a script prematurely. # Subsequent httpTestScript commands will have no effect. # # DELAY ms # If there are no WAIT commands, this sets the delay in ms between subsequent # calls to http::geturl. Default 500ms. # # KEEPALIVE # Set the value passed to http::geturl for the -keepalive option. The command # applies to subsequent requests in the script. Default 1. # # WAIT ms # Pause for a time in ms before sending subsequent requests. # # PIPELINE boolean # Set the value of -pipeline using http::config. The last PIPELINE command # in the script applies to every request. Default 1. # # POSTFRESH boolean # Set the value of -postfresh using http::config. The last POSTFRESH command # in the script applies to every request. Default 0. # # REPOST boolean # Set the value of -repost using http::config. The last REPOST command # in the script applies to every request. Default 1 for httpTestScript. # (Default value in http is 0). # # GET uriCode ?arg ...? # Send a HTTP request using the GET method. # Arguments: # uriCode - the code for the base URI - the value must be stored in # ::httpTestScript::URL($uriCode). # args - strings that will be joined by "&" and appended to the query # string with a preceding "&". # # HEAD uriCode ?arg ...? # Send a HTTP request using the HEAD method. # Arguments: as for GET # # POST uriCode ?arg ...? # Send a HTTP request using the POST method. # Arguments: # uriCode - the code for the base URI - the value must be stored in # ::httpTestScript::URL($uriCode). # args - strings that will be joined by "&" and used as the request body. # ------------------------------------------------------------------------------ namespace eval ::httpTestScript { namespace export runHttpTestScript cleanupHttpTestScript } # httpTestScript::START -- # Initialise, and create a long-stop timeout. proc httpTestScript::START {} { variable CountRequestedSoFar variable RequestsWhenStopped variable KeepAlive variable Delay variable TimeOutCode variable TimeOutDone variable StartDone variable StopDone variable CountFinishedSoFar variable RequestList variable RequestsMade variable ExtraTime variable ActualKeepAlive if {[info exists StartDone] && ($StartDone == 1)} { set msg {START has been called twice without an intervening STOP} return -code error $msg } set StartDone 1 set StopDone 0 set TimeOutDone 0 set CountFinishedSoFar 0 set CountRequestedSoFar 0 set RequestList {} set RequestsMade {} set ExtraTime 0 set ActualKeepAlive 1 # Undefined until a STOP command: unset -nocomplain RequestsWhenStopped # Default values: set KeepAlive 1 set Delay 500 # Default values for tests: KEEPALIVE 1 PIPELINE 1 POSTFRESH 0 REPOST 1 set TimeOutCode [after 30000 httpTestScript::TimeOutNow] # set TimeOutCode [after 4000 httpTestScript::TimeOutNow] return } # httpTestScript::STOP -- # Do not process any more commands. The commands will be executed but will # silently do nothing. proc httpTestScript::STOP {} { variable CountRequestedSoFar variable CountFinishedSoFar variable RequestsWhenStopped variable TimeOutCode variable StartDone variable StopDone variable RequestsMade if {$StopDone} { # Don't do anything on a second call. return } if {![info exists StartDone]} { return -code error {initialise the script by calling command START} } set StopDone 1 set StartDone 0 set RequestsWhenStopped $CountRequestedSoFar unset -nocomplain StartDone if {$CountFinishedSoFar == $RequestsWhenStopped} { if {[info exists TimeOutCode]} { after cancel $TimeOutCode } set ::httpTestScript::FOREVER 0 } return } # httpTestScript::DELAY -- # If there are no WAIT commands, this sets the delay in ms between subsequent # calls to http::geturl. Default 500ms. proc httpTestScript::DELAY {t} { variable StartDone variable StopDone if {$StopDone} { return } if {![info exists StartDone]} { return -code error {initialise the script by calling command START} } variable Delay set Delay $t return } # httpTestScript::KEEPALIVE -- # Set the value passed to http::geturl for the -keepalive option. Default 1. proc httpTestScript::KEEPALIVE {b} { variable StartDone variable StopDone if {$StopDone} { return } if {![info exists StartDone]} { return -code error {initialise the script by calling command START} } variable KeepAlive set KeepAlive $b return } # httpTestScript::WAIT -- # Pause for a time in ms before processing any more commands. proc httpTestScript::WAIT {t} { variable StartDone variable StopDone variable ExtraTime if {$StopDone} { return } if {![info exists StartDone]} { return -code error {initialise the script by calling command START} } if {(![string is integer -strict $t]) || $t < 0} { return -code error {argument to WAIT must be a non-negative integer} } incr ExtraTime $t return } # httpTestScript::PIPELINE -- # Pass a value to http::config -pipeline. proc httpTestScript::PIPELINE {b} { variable StartDone variable StopDone if {$StopDone} { return } if {![info exists StartDone]} { return -code error {initialise the script by calling command START} } ::http::config -pipeline $b ##::http::Log http(-pipeline) is now [::http::config -pipeline] return } # httpTestScript::POSTFRESH -- # Pass a value to http::config -postfresh. proc httpTestScript::POSTFRESH {b} { variable StartDone variable StopDone if {$StopDone} { return } if {![info exists StartDone]} { return -code error {initialise the script by calling command START} } ::http::config -postfresh $b ##::http::Log http(-postfresh) is now [::http::config -postfresh] return } # httpTestScript::REPOST -- # Pass a value to http::config -repost. proc httpTestScript::REPOST {b} { variable StartDone variable StopDone if {$StopDone} { return } if {![info exists StartDone]} { return -code error {initialise the script by calling command START} } ::http::config -repost $b ##::http::Log http(-repost) is now [::http::config -repost] return } # httpTestScript::GET -- # Send a HTTP request using the GET method. # Arguments: # uriCode - the code for the base URI - the value must be stored in # ::httpTestScript::URL($uriCode). # args - strings that will each be preceded by "&" and appended to the query # string. proc httpTestScript::GET {uriCode args} { variable RequestList lappend RequestList GET RequestAfter $uriCode 0 {} {*}$args return } # httpTestScript::HEAD -- # Send a HTTP request using the HEAD method. # Arguments: as for GET proc httpTestScript::HEAD {uriCode args} { variable RequestList lappend RequestList HEAD RequestAfter $uriCode 1 {} {*}$args return } # httpTestScript::POST -- # Send a HTTP request using the POST method. # Arguments: # uriCode - the code for the base URI - the value must be stored in # ::httpTestScript::URL($uriCode). # args - strings that will be joined by "&" and used as the request body. proc httpTestScript::POST {uriCode args} { variable RequestList lappend RequestList POST RequestAfter $uriCode 0 {use} {*}$args return } proc httpTestScript::RequestAfter {uriCode validate query args} { variable CountRequestedSoFar variable Delay variable ExtraTime variable StartDone variable StopDone variable KeepAlive if {$StopDone} { return } if {![info exists StartDone]} { return -code error {initialise the script by calling command START} } incr CountRequestedSoFar set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}] # Could pass values of -pipeline, -postfresh, -repost if it were # useful to change these mid-script. after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args] return } proc httpTestScript::Requester {uriCode keepAlive validate query args} { variable URL ::http::config -accept {*/*} set absUrl $URL($uriCode) if {$query eq {}} { if {$args ne {}} { append absUrl & [join $args &] } set queryArgs {} } elseif {$validate} { return -code error {cannot have both -validate (HEAD) and -query (POST)} } else { set queryArgs [list -query [join $args &]] } if {[catch { ::http::geturl $absUrl \ -validate $validate \ -timeout 10000 \ {*}$queryArgs \ -keepalive $keepAlive \ -command ::httpTestScript::WhenFinished } token]} { set msg $token catch {puts stdout "Error: $msg"} return } else { # Request will begin. } return } proc httpTestScript::TimeOutNow {} { variable TimeOutDone set TimeOutDone 1 set ::httpTestScript::FOREVER 0 return } proc httpTestScript::WhenFinished {hToken} { variable CountFinishedSoFar variable RequestsWhenStopped variable TimeOutCode variable StopDone variable RequestList variable RequestsMade variable ActualKeepAlive upvar #0 $hToken state if {[catch { if { [info exists state(transfer)] && ($state(transfer) eq "chunked") } { set Trans chunked } else { set Trans unchunked } if { [info exists ::httpTest::testOptions(-verbose)] && ($::httpTest::testOptions(-verbose) > 0) } { puts "Token $hToken Response $state(http) Status $state(status) Method $state(method) Transfer $Trans Size $state(currentsize) URL $state(url) " } if {!$state(-keepalive)} { set ActualKeepAlive 0 } if {[info exists state(method)]} { lappend RequestsMade $state(method) } else { lappend RequestsMade UNKNOWN } set tk [namespace tail $hToken] if { ($state(http) != {HTTP/1.1 200 OK}) || ($state(status) != {ok}) || (($state(currentsize) == 0) && ($state(method) ne "HEAD")) } { ::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken } } err]} { ::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken } incr CountFinishedSoFar if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} { if {[info exists TimeOutCode]} { after cancel $TimeOutCode } if {$RequestsMade ne $RequestList && $ActualKeepAlive} { ::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken } set ::httpTestScript::FOREVER 0 } return } proc httpTestScript::runHttpTestScript {scr} { variable TimeOutDone variable RequestsWhenStopped after idle [list namespace eval ::httpTestScript $scr] vwait ::httpTestScript::FOREVER # N.B. does not automatically execute in this namespace, unlike some other events. # Release when all requests have been served or have timed out. if {$TimeOutDone} { return -code error {test script timed out} } return $RequestsWhenStopped } proc httpTestScript::cleanupHttpTestScript {} { variable TimeOutDone variable RequestsWhenStopped if {![info exists RequestsWhenStopped]} { return -code error {Cleanup Failed: RequestsWhenStopped is undefined} } for {set i 1} {$i <= $RequestsWhenStopped} {incr i} { http::cleanup ::http::$i } return } tcl8.6.14/tests/httpTest.tcl0000644000175000017500000004235314554262142015336 0ustar sergeisergei# httpTest.tcl # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # # Copyright (C) 2018 Keith Nash # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------------ # "Package" httpTest for analysis of Log output of http requests. # ------------------------------------------------------------------------------ # This is a specialised test kit for examining the presence, ordering, and # overlap of multiple HTTP transactions over a persistent ("Keep-Alive") # connection; and also for testing reconnection in accordance with RFC 7230 when # the connection is lost. # # This kit is probably not useful for other purposes. It depends on the # presence of specific Log commands in the http library, and it interprets the # logs that these commands create. # ------------------------------------------------------------------------------ package require http namespace eval ::http { variable TestStartTimeInMs [clock milliseconds] # catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"} } namespace eval ::httpTest { variable testResults {} variable testOptions array set testOptions { -verbose 0 -dotted 1 } # -verbose - 0 quiet 1 write to stdout 2 write more # -dotted - (boolean) use dots for absences in lists of transactions } proc httpTest::Puts {txt} { variable testOptions if {$testOptions(-verbose) > 0} { puts stdout $txt flush stdout } return } # http::Log # # A special-purpose logger used for running tests. # - Processes Log calls that have "^" in their arguments, and records them in # variable ::httpTest::testResults. # - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0). # - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1). proc http::Log {args} { variable TestStartTimeInMs set time [expr {[clock milliseconds] - $TestStartTimeInMs}] set txt [list $time {*}$args] if {[string first ^ $txt] >= 0} { ::httpTest::LogRecord $txt ::httpTest::Puts $txt } elseif {$::httpTest::testOptions(-verbose) > 1} { ::httpTest::Puts $txt } return } # Called by http::Log (the "testing" version) to record logs for later analysis. proc httpTest::LogRecord {txt} { variable testResults set pos [string first ^ $txt] set len [string length $txt] if {$pos > $len - 3} { puts stdout "Logging Error: $txt" puts stdout "Fix this call to Log in http-*.tm so it has ^ then\ a letter then a numeral." flush stdout } elseif {$pos < 0} { # Called by mistake. } else { set letter [string index $txt [incr pos]] set number [string index $txt [incr pos]] # Max 9 requests! lappend testResults [list $letter $number] } return } # ------------------------------------------------------------------------------ # Commands for analysing the logs recorded when calling http::geturl. # ------------------------------------------------------------------------------ # httpTest::TestOverlaps -- # # The main test for correct behaviour of pipelined and sequential # (non-pipelined) transactions. Other tests should be run first to detect # any inconsistencies in the data (e.g. absence of the elements that are # examined here). # # Examine the sequence $someResults for each transaction from 1 to $n, # ignoring any that are listed in $badTrans. # Determine whether the elements "B" to $term for one transaction overlap # elements "B" to $term for the previous and following transactions. # # Transactions in the list $badTrans are not included in "clean" or # "dirty", but their possible overlap with other transactions is noted. # Transactions in the list $notPiped are a subset of $badTrans, and # their possible overlap with other transactions is NOT noted. # # Arguments: # someResults - list of results, each of the form {letter numeral} # n - number of HTTP transactions # term - letter that indicated end of search range. "E" for testing # overlaps from start of request to end of response headers. # "F" to extend to the end of the response body. # msg - the cumulative message from sanity checks. Append to it only # to report a test failure. # badTrans - list of transaction numbers not to be assessed as "clean" or # "dirty" # notPiped - subset of badTrans. List of transaction numbers that cannot # taint another transaction by overlapping with it, because it # used a different socket. # # Return value: [list $msg $clean $dirty] # msg - warning messages: nothing will be appended to argument $msg if there # is an error with the test. # clean - list of transactions that have no overlap with other transactions # dirty - list of transactions that have YES overlap with other transactions proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} { variable testOptions # Check whether transactions overlap: set clean {} set dirty {} for {set i 1} {$i <= $n} {incr i} { if {$i in $badTrans} { continue } set myStart [lsearch -exact $someResults [list B $i]] set myEnd [lsearch -exact $someResults [list $term $i]] if {($myStart < 0 || $myEnd < 0)} { set res "Cannot find positions of transaction $i" append msg $res \n Puts $res } set overlaps {} for {set j $myStart} {$j <= $myEnd} {incr j} { lassign [lindex $someResults $j] letter number if {$number != $i && $letter ne "A" && $number ni $notPiped} { lappend overlaps $number } } if {[llength $overlaps] == 0} { set res "Transaction $i has no overlaps" Puts $res lappend clean $i if {$testOptions(-dotted)} { # N.B. results from different segments are concatenated. lappend dirty . } else { } } else { set res "Transaction $i overlaps with [join $overlaps { }]" Puts $res lappend dirty $i if {$testOptions(-dotted)} { # N.B. results from different segments are concatenated. lappend clean . } else { } } } return [list $msg $clean $dirty] } # httpTest::PipelineNext -- # # Test whether prevPair, pair are valid as consecutive elements of a pipelined # sequence (Start 1), (End 1), (Start 2), (End 2) ... # Numbers are integers increasing (by 1 if argument "any" is false), and need # not begin with 1. # The first element of the sequence has prevPair {} and is always passed as # valid. # # Arguments; # Start - string that labels the start of a segment # End - string that labels the end of a segment # prevPair - previous "pair" (list of string and number) element of a # sequence, or {} if argument "pair" is the first in the # sequence. # pair - current "pair" (list of string and number) element of a # sequence # any - (boolean) iff true, accept any increasing sequence of integers. # If false, integers must increase by 1. # # Return value - boolean, true iff the two pairs are valid consecutive elements. proc httpTest::PipelineNext {Start End prevPair pair any} { if {$prevPair eq {}} { return 1 } lassign $prevPair letter number lassign $pair newLetter newNumber if {$letter eq $Start} { return [expr {($newLetter eq $End) && ($newNumber == $number)}] } elseif {$any} { set nxt [list $Start [expr {$number + 1}]] return [expr {($newLetter eq $Start) && ($newNumber > $number)}] } else { set nxt [list $Start [expr {$number + 1}]] return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}] } } # httpTest::TestPipeline -- # # Given a sequence of "pair" elements, check that the elements whose string is # $Start or $End form a valid pipeline. Ignore other elements. # # Return value: {} if valid pipeline, otherwise a non-empty error message. proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} { set sequence {} set prevPair {} set ok 1 set any [llength $badTrans] foreach pair $someResults { lassign $pair letter number if {($letter in [list $Start $End]) && ($number ni $badTrans)} { lappend sequence $pair if {![PipelineNext $Start $End $prevPair $pair $any]} { set ok 0 break } set prevPair $pair } } if {!$ok} { set res "$desc are not pipelined: {$sequence}" append msg $res \n Puts $res } return $msg } # httpTest::TestSequence -- # # Examine each transaction from 1 to $n, ignoring any that are listed # in $badTrans. # Check that each transaction has elements A to F, in alphabetical order. proc httpTest::TestSequence {someResults n msg badTrans} { variable testOptions for {set i 1} {$i <= $n} {incr i} { if {$i in $badTrans} { continue } set sequence {} foreach pair $someResults { lassign $pair letter number if {$number == $i} { lappend sequence $letter } } if {$sequence eq {A B C D E F}} { } else { set res "Wrong sequence for token ::http::$i - {$sequence}" append msg $res \n Puts $res if {"X" in $sequence} { set res "- and error(s) X" append msg $res \n Puts $res } if {"Y" in $sequence} { set res "- and warnings(s) Y" append msg $res \n Puts $res } } } return $msg } # # Arguments: # someResults - list of elements, each a list of a letter and a number # n - (positive integer) the number of HTTP requests # msg - accumulated warning messages # skipOverlaps - (boolean) whether to skip testing of transaction overlaps # badTrans - list of transaction numbers not to be assessed as "clean" or # "dirty" by their overlaps # for 1/2 includes all transactions # for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled. # notPiped - subset of badTrans. List of transaction numbers that cannot # taint another transaction by overlapping with it, because it # used a different socket. # # Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF] # msg - warning messages: nothing will be appended to argument $msg if there # is no error with the test. # cleanE - list of transactions that have no overlap with other transactions # (not considering response body) # dirtyE - list of transactions that have YES overlap with other transactions # (not considering response body) # cleanF - list of transactions that have no overlap with other transactions # (including response body) # dirtyF - list of transactions that have YES overlap with other transactions # (including response body) proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} { variable testOptions # Check that stages for "good" transactions are all present and correct: set msg [TestSequence $someResults $n $msg $badTrans] # Check that requests are pipelined: set msg [TestPipeline $someResults $n B C $msg Requests $notPiped] # Check that responses are pipelined: set msg [TestPipeline $someResults $n D F $msg Responses $notPiped] if {$skipOverlaps} { set cleanE {} set dirtyE {} set cleanF {} set dirtyF {} } else { Puts "Overlaps including response body (test for non-pipelined case)" lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF Puts "Overlaps without response body (test for pipelined case)" lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE } return [list $msg $cleanE $cleanF $dirtyE $dirtyF] } # httpTest::ProcessRetries -- # # Command to examine results for socket-changing records [PQR], # divide the results into segments for each connection, and analyse each segment # individually. # (Could add $sock to the logging to simplify this, but never mind.) # # In each segment, identify any transactions that are not included, and # any that are aborted, to assist subsequent testing. # # Prepend A records (socket-independent) to each segment for transactions that # were scheduled (by A) but not completed (by F). Pass each segment to # MostAnalysis for processing. proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} { variable testOptions set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}] if {$nextRetry < 0} { return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped] } set badTrans $notIncluded set tryCount 0 set try $nextRetry incr tryCount lassign [lindex $someResults $try] letter number Puts "Processing retry [lindex $someResults $try]" set beforeTry [lrange $someResults 0 $try-1] Puts [join $beforeTry \n] set afterTry [lrange $someResults $try+1 end] set dummyTry {} for {set i 1} {$i <= $n} {incr i} { set first [lsearch -exact $beforeTry [list A $i]] set last [lsearch -exact $beforeTry [list F $i]] if {$first < 0} { set res "Transaction $i was not started in connection number $tryCount" # So lappend it to badTrans and don't include it in the call below of MostAnalysis. # append msg $res \n Puts $res if {$i ni $badTrans} { lappend badTrans $i } else { } } elseif {$last < 0} { set res "Transaction $i was started but unfinished in connection number $tryCount" # So lappend it to badTrans and don't include it in the call below of MostAnalysis. # append msg $res \n Puts $res lappend badTrans $i lappend dummyTry [list A $i] } else { set res "Transaction $i was started and finished in connection number $tryCount" # So include it in the call below of MostAnalysis. # So lappend it to notIncluded and don't include it in the recursive call of # ProcessRetries which handles the later connections. # append msg $res \n Puts $res lappend notIncluded $i } } # Analyse the part of the results before the first replay: set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped] lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1 # Pass the rest of the results to be processed recursively. set afterTry [concat $dummyTry $afterTry] set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped] lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2 set cleanE [concat $cleanE1 $cleanE2] set cleanF [concat $cleanF1 $cleanF2] set dirtyE [concat $dirtyE1 $dirtyE2] set dirtyF [concat $dirtyF1 $dirtyF2] return [list $msg $cleanE $cleanF $dirtyE $dirtyF] } # httpTest::logAnalyse -- # # The main command called to analyse logs for a single test. # # Arguments: # n - (positive integer) the number of HTTP requests # skipOverlaps - (boolean) whether to skip testing of transaction overlaps # notIncluded - list of transaction numbers not to be assessed as "clean" or # "dirty" by their overlaps # notPiped - subset of notIncluded. List of transaction numbers that cannot # taint another transaction by overlapping with it, because it # used a different socket. # # Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF] # msg - warning messages: {} if there is no error with the test. # cleanE - list of transactions that have no overlap with other transactions # (not considering response body) # dirtyE - list of transactions that have YES overlap with other transactions # (not considering response body) # cleanF - list of transactions that have no overlap with other transactions # (including response body) # dirtyF - list of transactions that have YES overlap with other transactions # (including response body) proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} { variable testResults variable testOptions # Check that each data item has the correct form {letter numeral}. set ii 0 set ok 1 foreach pair $testResults { lassign $pair letter number if { [string match {[A-Z]} $letter] && [string match {[0-9]} $number] } { # OK } else { set ok 0 set res "Error: testResults has bad element {$pair} at position $ii" append msg $res \n Puts $res } incr ii } if {!$ok} { return $msg } set msg {} Puts [join $testResults \n] ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped # N.B. Implicit Return. } proc httpTest::cleanupHttpTest {} { variable testResults set testResults {} return } proc httpTest::setHttpTestOptions {key args} { variable testOptions if {$key ni {-dotted -verbose}} { return -code error {valid options are -dotted, -verbose} } set testOptions($key) {*}$args } namespace eval httpTest { namespace export cleanupHttpTest logAnalyse setHttpTestOptions } tcl8.6.14/tests/internals.tcl0000644000175000017500000000605214554262142015512 0ustar sergeisergei# This file contains internal facilities for Tcl tests. # # Source this file in the related tests to include from tcl-tests: # # source [file join [file dirname [info script]] internals.tcl] # # Copyright (c) 2020 Sergey G. Brester (sebres). # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[namespace which -command ::tcltest::internals::scriptpath] eq ""} {namespace eval ::tcltest::internals { namespace path ::tcltest ::tcltest::ConstraintInitializer testWithLimit { expr {[testConstraint macOrUnix] && ![catch { exec prlimit --version }]} } # test-with-limit -- # # Usage: test-with-limit ?-addmem bytes? ?-maxmem bytes? command # Options: # -addmem - set additional memory limit (in bytes) as difference (extra memory needed to run a test) # -maxmem - set absolute maximum address space limit (in bytes) # proc testWithLimit args { set body [lindex $args end] array set in [lrange $args 0 end-1] # test in child process (with limits): set pipe {} if {[catch { # start new process: set pipe [open |[list [interpreter]] r+] set ppid [pid $pipe] # create prlimit args: set args {} # with limited address space: if {[info exists in(-addmem)] || [info exists in(-maxmem)]} { if {[info exists in(-addmem)]} { # as difference to normal usage, so try to retrieve current memory usage: if {[catch { # using ps (vsz is in KB): incr in(-addmem) [expr {[lindex [exec ps -hq $ppid -o vsz] end] * 1024}] }]} { # ps failed, use default size 20MB: incr in(-addmem) 20000000 # + size of locale-archive (may be up to 100MB): incr in(-addmem) [expr { [file exists /usr/lib/locale/locale-archive] ? [file size /usr/lib/locale/locale-archive] : 0 }] } if {![info exists in(-maxmem)]} { set in(-maxmem) $in(-addmem) } set in(-maxmem) [expr { max($in(-addmem), $in(-maxmem)) }] } append args --as=$in(-maxmem) } # apply limits: exec prlimit -p $ppid {*}$args } msg opt]} { catch {close $pipe} tcltest::Warn "testWithLimit: error - [regsub {^\s*([^\n]*).*$} $msg {\1}]" tcltest::Skip testWithLimit } # execute body, close process and return: set ret [catch { chan configure $pipe -buffering line puts $pipe "puts \[$body\]" puts $pipe exit set result [read $pipe] close $pipe set pipe {} set result } result opt] if {$pipe ne ""} { catch { close $pipe } } if {$ret && [dict get $opt -errorcode] eq "BYPASS-SKIPPED-TEST"} { return {*}$opt $result } if { ( [info exists in(-warn-on-code)] && $ret in $in(-warn-on-code) ) || ( $ret && [info exists in(-warn-on-alloc-error)] && $in(-warn-on-alloc-error) && [regexp {\munable to (?:re)?alloc\M} $result] ) } { tcltest::Warn "testWithLimit: wrong limit, result: $result" tcltest::Skip testWithLimit } return {*}$opt $result } # export all routines starting with test namespace export test* # for script path & as mark for loaded proc scriptpath {} [list return [info script]] }}; # end of internals. tcl8.6.14/tests/pkgIndex.tcl0000644000175000017500000000012514554262142015257 0ustar sergeisergei#! /usr/bin/env tclsh package ifneeded tcltests 0.1 [list source $dir/tcltests.tcl] tcl8.6.14/tests/remote.tcl0000644000175000017500000001013314554262142015001 0ustar sergeisergei# This file contains Tcl code to implement a remote server that can be # used during testing of Tcl socket code. This server is used by some # of the tests in socket.test. # # Source this file in the remote server you are using to test Tcl against. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # Initialize message delimiter # Initialize command array catch {unset command} set command(0) "" set callerSocket "" # Detect whether we should print out connection messages etc. if {![info exists VERBOSE]} { set VERBOSE 0 } proc __doCommands__ {l s} { global callerSocket VERBOSE if {$VERBOSE} { puts "--- Server executing the following for socket $s:" puts $l puts "---" } set callerSocket $s set ::errorInfo "" set code [catch {uplevel "#0" $l} msg] return [list $code $::errorInfo $msg] } proc __readAndExecute__ {s} { global command VERBOSE set l [gets $s] if {[string compare $l "--Marker--Marker--Marker--"] == 0} { puts $s [__doCommands__ $command($s) $s] puts $s "--Marker--Marker--Marker--" set command($s) "" return } if {[string compare $l ""] == 0} { if {[eof $s]} { if {$VERBOSE} { puts "Server closing $s, eof from client" } close $s } return } if {[eof $s]} { if {$VERBOSE} { puts "Server closing $s, eof from client" } close $s unset command($s) return } append command($s) $l "\n" } proc __accept__ {s a p} { global command VERBOSE if {$VERBOSE} { puts "Server accepts new connection from $a:$p on $s" } set command($s) "" fconfigure $s -buffering line -translation crlf fileevent $s readable [list __readAndExecute__ $s] } set serverIsSilent 0 for {set i 0} {$i < $argc} {incr i} { if {[string compare -serverIsSilent [lindex $argv $i]] == 0} { set serverIsSilent 1 break } } if {![info exists serverPort]} { if {[info exists env(serverPort)]} { set serverPort $env(serverPort) } } if {![info exists serverPort]} { for {set i 0} {$i < $argc} {incr i} { if {[string compare -port [lindex $argv $i]] == 0} { if {$i < $argc - 1} { set serverPort [lindex $argv [expr {$i + 1}]] } break } } } if {![info exists serverPort]} { set serverPort 2048 } if {![info exists serverAddress]} { if {[info exists env(serverAddress)]} { set serverAddress $env(serverAddress) } } if {![info exists serverAddress]} { for {set i 0} {$i < $argc} {incr i} { if {[string compare -address [lindex $argv $i]] == 0} { if {$i < $argc - 1} { set serverAddress [lindex $argv [expr {$i + 1}]] } break } } } if {![info exists serverAddress]} { set serverAddress 0.0.0.0 } if {$serverIsSilent == 0} { set l "Remote server listening on port $serverPort, IP $serverAddress." puts "" puts $l for {set c [string length $l]} {$c > 0} {incr c -1} {puts -nonewline "-"} puts "" puts "" puts "You have set the Tcl variables serverAddress to $serverAddress and" puts "serverPort to $serverPort. You can set these with the -address and" puts "-port command line options, or as environment variables in your" puts "shell." puts "" puts "NOTE: The tests will not work properly if serverAddress is set to" puts "\"localhost\" or 127.0.0.1." puts "" puts "When you invoke tcltest to run the tests, set the variables" puts "remoteServerPort to $serverPort and remoteServerIP to" puts "[info hostname]. You can set these as environment variables" puts "from the shell. The tests will not work properly if you set" puts "remoteServerIP to \"localhost\" or 127.0.0.1." puts "" puts -nonewline "Type Ctrl-C to terminate--> " flush stdout } proc getPort sock { lindex [fconfigure $sock -sockname] 2 } if {[catch {set serverSocket \ [socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} { puts "Server on $serverAddress:$serverPort cannot start: $msg" } else { puts ready vwait __server_wait_variable__ } tcl8.6.14/tests/tcltests.tcl0000644000175000017500000000243714554262142015363 0ustar sergeisergei#! /usr/bin/env tclsh # Don't overwrite tcltests facilities already present if {[package provide tcltests] ne {}} return package require tcltest 2.5 namespace import ::tcltest::* testConstraint exec [llength [info commands exec]] testConstraint fcopy [llength [info commands fcopy]] testConstraint fileevent [llength [info commands fileevent]] testConstraint thread [ expr {0 == [catch {package require Thread 2.7-}]}] testConstraint notValgrind [expr {![testConstraint valgrind]}] namespace eval ::tcltests { proc init {} { if {[namespace which ::tcl::file::tempdir] eq {}} { interp alias {} [namespace current]::tempdir {} [ namespace current]::tempdir_alternate } else { interp alias {} [namespace current]::tempdir {} ::tcl::file::tempdir } } proc tempdir_alternate {} { close [file tempfile tempfile] set tmpdir [file dirname $tempfile] set execname [info nameofexecutable] regsub -all {[^[:alpha:][:digit:]]} $execname _ execname for {set i 0} {$i < 10000} {incr i} { set time [clock milliseconds] set name $tmpdir/${execname}_${time}_$i if {![file exists $name]} { file mkdir $name return $name } } error [list {could not create temporary directory}] } init package provide tcltests 0.1 } tcl8.6.14/tests/auto0/0000755000175000017500000000000014566153412014036 5ustar sergeisergeitcl8.6.14/tests/auto0/auto1/0000755000175000017500000000000014566153412015067 5ustar sergeisergeitcl8.6.14/tests/auto0/auto1/tclIndex0000644000175000017500000000064114554262142016563 0ustar sergeisergei# Tcl autoload index file, version 2.0 # This file is generated by the "auto_mkindex" command # and sourced to set up indexing information for one or # more commands. Typically each line is a command that # sets an element in the auto_index array, where the # element name is the name of a command and the value is # a script that loads the command. set auto_index(report1) [list source [file join $dir file1.tcl]] tcl8.6.14/tests/auto0/auto1/file1.tcl0000644000175000017500000000004714554262142016572 0ustar sergeisergeiproc report1 {args} { return ok1 } tcl8.6.14/tests/auto0/auto1/package1.tcl0000644000175000017500000000012514554262142017243 0ustar sergeisergeiproc HeresPackage1 {args} { return OK1 } package provide SafeTestPackage1 1.2.3 tcl8.6.14/tests/auto0/auto1/pkgIndex.tcl0000644000175000017500000000104614554262142017343 0ustar sergeisergei# Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. package ifneeded SafeTestPackage1 1.2.3 [list source [file join $dir package1.tcl]] tcl8.6.14/tests/auto0/auto2/0000755000175000017500000000000014566153412015070 5ustar sergeisergeitcl8.6.14/tests/auto0/auto2/tclIndex0000644000175000017500000000064114554262142016564 0ustar sergeisergei# Tcl autoload index file, version 2.0 # This file is generated by the "auto_mkindex" command # and sourced to set up indexing information for one or # more commands. Typically each line is a command that # sets an element in the auto_index array, where the # element name is the name of a command and the value is # a script that loads the command. set auto_index(report2) [list source [file join $dir file2.tcl]] tcl8.6.14/tests/auto0/auto2/file2.tcl0000644000175000017500000000004714554262142016574 0ustar sergeisergeiproc report2 {args} { return ok2 } tcl8.6.14/tests/auto0/auto2/package2.tcl0000644000175000017500000000012514554262142017245 0ustar sergeisergeiproc HeresPackage2 {args} { return OK2 } package provide SafeTestPackage2 2.3.4 tcl8.6.14/tests/auto0/auto2/pkgIndex.tcl0000644000175000017500000000104614554262142017344 0ustar sergeisergei# Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. package ifneeded SafeTestPackage2 2.3.4 [list source [file join $dir package2.tcl]] tcl8.6.14/tests/auto0/modules/0000755000175000017500000000000014566153412015506 5ustar sergeisergeitcl8.6.14/tests/auto0/modules/test0-0.5.tm0000644000175000017500000000010314554262142017377 0ustar sergeisergeinamespace eval test0 {} proc test0::try0 args { return res0 } tcl8.6.14/tests/auto0/modules/mod1/0000755000175000017500000000000014566153412016346 5ustar sergeisergeitcl8.6.14/tests/auto0/modules/mod1/test1-1.0.tm0000644000175000017500000000011714554262142020241 0ustar sergeisergeinamespace eval mod1::test1 {} proc mod1::test1::try1 args { return res1 } tcl8.6.14/tests/auto0/modules/mod2/0000755000175000017500000000000014566153412016347 5ustar sergeisergeitcl8.6.14/tests/auto0/modules/mod2/test2-2.0.tm0000644000175000017500000000011714554262142020244 0ustar sergeisergeinamespace eval mod2::test2 {} proc mod2::test2::try2 args { return res2 } tcl8.6.14/win/0000755000175000017500000000000014566153412012441 5ustar sergeisergeitcl8.6.14/win/Makefile.in0000644000175000017500000007671614563210117014520 0ustar sergeisergei# # This file is a Makefile for Tcl. If it has the name "Makefile.in" then it # is a template for a Makefile; to generate the actual Makefile, run # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. VERSION = @TCL_VERSION@ #-------------------------------------------------------------------------- # Things you can change to personalize the Makefile for your own site (you can # make these changes in either Makefile.in or Makefile, but changes to # Makefile will get lost if you re-run the configuration script). #-------------------------------------------------------------------------- # Default top-level directories in which to install architecture-specific # files (exec_prefix) and machine-independent files such as scripts (prefix). # The values specified here may be overridden at configure-time with the # --exec-prefix and --prefix options to the "configure" script. prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS # with replication. It allows the pathnames used for installation to be # different than those used for actually reference files at run-time. # INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. INSTALL_ROOT = # Directory from which applications will reference the library of Tcl scripts # (note: you can set the TCL_LIBRARY environment variable at run-time to # override this value): TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION) # Path to use at runtime to refer to LIB_INSTALL_DIR: LIB_RUNTIME_DIR = $(libdir) # Directory in which to install the program tclsh: BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir) # Directory in which to install the .a or .so binary for the Tcl library: LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) # Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) # Path name to use when installing Tcl modules. MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Directory in which to (optionally) install the private tcl headers: PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Top-level directory in which to install manual entries: MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir) # Directory in which to install manual entry for tclsh: MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 # Directory in which to install manual entries for Tcl's C library procedures: MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 # Directory in which to install manual entries for the built-in Tcl commands: MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann # Libraries built with optimization switches have this additional extension TCL_DBGX = @TCL_DBGX@ # warning flags CFLAGS_WARNING = @CFLAGS_WARNING@ # The default switches for optimization or debugging CFLAGS_DEBUG = @CFLAGS_DEBUG@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -D_ATL_XP_TARGETING=1 -D__USE_MINGW_ANSI_STDIO=0 -DMP_FIXED_CUTOFFS -DMP_NO_STDINT # To compile without backward compatibility and deprecated code uncomment the # following NO_DEPRECATED_FLAGS = #NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED # To enable compilation debugging reverse the comment characters on one of the # following lines. COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. TOP_DIR = $(shell cd @srcdir@/..; pwd -W 2>/dev/null || pwd -P) GENERIC_DIR = $(TOP_DIR)/generic WIN_DIR = $(TOP_DIR)/win COMPAT_DIR = $(TOP_DIR)/compat PKGS_DIR = $(TOP_DIR)/pkgs ZLIB_DIR = $(COMPAT_DIR)/zlib TOMMATH_DIR = $(TOP_DIR)/libtommath # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ libdir_native = $(shell $(CYGPATH) '$(libdir)') bindir_native = $(shell $(CYGPATH) '$(bindir)') includedir_native = $(shell $(CYGPATH) '$(includedir)') mandir_native = $(shell $(CYGPATH) '$(mandir)') TCL_LIBRARY_NATIVE = $(shell $(CYGPATH) '$(TCL_LIBRARY)') GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') SCRIPT_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(SCRIPT_INSTALL_DIR)') INCLUDE_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(INCLUDE_INSTALL_DIR)') MAN_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(MAN_INSTALL_DIR)') ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W 2>/dev/null || pwd -P) ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)') TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') # Fully qualify library path so that `make test` # does not depend on the current directory. LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@ DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@ DDEVER = @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@ DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@ REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@ REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@ TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX} REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${DLLSUFFIX}${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ package ifneeded dde 1.4.4 [list load [file normalize ${DDE_DLL_FILE}] Dde];\ package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] Registry] TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}]];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} WINE = @WINE@ CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) # For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is # available *BEFORE* running make for the first time. Certain build targets # (make genstubs, make install) need it to be available on the PATH. This # executable should *NOT* be required just to do a normal build although # it can be required to run make dist. TCL_EXE = @TCL_EXE@ @SET_MAKE@ # Setting the VPATH variable to a list of paths will cause the Makefile to # look into these paths when resolving .c to .obj dependencies. VPATH = $(GENERIC_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR):$(TOMMATH_DIR) AR = @AR@ RANLIB = @RANLIB@ CC = @CC@ RC = @RC@ RES = @RES@ AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@ CPPFLAGS = @CPPFLAGS@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@ LDFLAGS_CONSOLE = @LDFLAGS_CONSOLE@ LDFLAGS_WINDOW = @LDFLAGS_WINDOW@ EXEEXT = @EXEEXT@ OBJEXT = @OBJEXT@ STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ LIBS = @LIBS@ $(shell $(CYGPATH) '@ZLIB_LIBS@') RMDIR = rm -rf MKDIR = mkdir -p SHELL = @SHELL@ RM = rm -f COPY = cp CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ -I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" -DTCL_TOMMATH \ ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ STUB_CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ -I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" -DTCL_TOMMATH \ ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} TCLTEST_OBJS = \ tclTest.$(OBJEXT) \ tclTestObj.$(OBJEXT) \ tclTestProcBodyObj.$(OBJEXT) \ tclThreadTest.$(OBJEXT) \ tclWinTest.$(OBJEXT) GENERIC_OBJS = \ regcomp.$(OBJEXT) \ regexec.$(OBJEXT) \ regfree.$(OBJEXT) \ regerror.$(OBJEXT) \ tclAlloc.$(OBJEXT) \ tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ tclBinary.$(OBJEXT) \ tclCkalloc.$(OBJEXT) \ tclClock.$(OBJEXT) \ tclCmdAH.$(OBJEXT) \ tclCmdIL.$(OBJEXT) \ tclCmdMZ.$(OBJEXT) \ tclCompCmds.$(OBJEXT) \ tclCompCmdsGR.$(OBJEXT) \ tclCompCmdsSZ.$(OBJEXT) \ tclCompExpr.$(OBJEXT) \ tclCompile.$(OBJEXT) \ tclConfig.$(OBJEXT) \ tclDate.$(OBJEXT) \ tclDictObj.$(OBJEXT) \ tclDisassemble.$(OBJEXT) \ tclEncoding.$(OBJEXT) \ tclEnsemble.$(OBJEXT) \ tclEnv.$(OBJEXT) \ tclEvent.$(OBJEXT) \ tclExecute.$(OBJEXT) \ tclFCmd.$(OBJEXT) \ tclFileName.$(OBJEXT) \ tclGet.$(OBJEXT) \ tclHash.$(OBJEXT) \ tclHistory.$(OBJEXT) \ tclIndexObj.$(OBJEXT) \ tclInterp.$(OBJEXT) \ tclIO.$(OBJEXT) \ tclIOCmd.$(OBJEXT) \ tclIOGT.$(OBJEXT) \ tclIORChan.$(OBJEXT) \ tclIORTrans.$(OBJEXT) \ tclIOSock.$(OBJEXT) \ tclIOUtil.$(OBJEXT) \ tclLink.$(OBJEXT) \ tclLiteral.$(OBJEXT) \ tclListObj.$(OBJEXT) \ tclLoad.$(OBJEXT) \ tclMainW.$(OBJEXT) \ tclMain.$(OBJEXT) \ tclNamesp.$(OBJEXT) \ tclNotify.$(OBJEXT) \ tclOO.$(OBJEXT) \ tclOOBasic.$(OBJEXT) \ tclOOCall.$(OBJEXT) \ tclOODefineCmds.$(OBJEXT) \ tclOOInfo.$(OBJEXT) \ tclOOMethod.$(OBJEXT) \ tclOOStubInit.$(OBJEXT) \ tclObj.$(OBJEXT) \ tclOptimize.$(OBJEXT) \ tclPanic.$(OBJEXT) \ tclParse.$(OBJEXT) \ tclPathObj.$(OBJEXT) \ tclPipe.$(OBJEXT) \ tclPkg.$(OBJEXT) \ tclPkgConfig.$(OBJEXT) \ tclPosixStr.$(OBJEXT) \ tclPreserve.$(OBJEXT) \ tclProc.$(OBJEXT) \ tclRegexp.$(OBJEXT) \ tclResolve.$(OBJEXT) \ tclResult.$(OBJEXT) \ tclScan.$(OBJEXT) \ tclStringObj.$(OBJEXT) \ tclStrToD.$(OBJEXT) \ tclStubInit.$(OBJEXT) \ tclThread.$(OBJEXT) \ tclThreadAlloc.$(OBJEXT) \ tclThreadJoin.$(OBJEXT) \ tclThreadStorage.$(OBJEXT) \ tclTimer.$(OBJEXT) \ tclTomMathInterface.$(OBJEXT) \ tclTrace.$(OBJEXT) \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) \ tclZlib.$(OBJEXT) TOMMATH_OBJS = \ bn_mp_add.${OBJEXT} \ bn_mp_add_d.${OBJEXT} \ bn_mp_and.${OBJEXT} \ bn_mp_clamp.${OBJEXT} \ bn_mp_clear.${OBJEXT} \ bn_mp_clear_multi.${OBJEXT} \ bn_mp_cmp.${OBJEXT} \ bn_mp_cmp_d.${OBJEXT} \ bn_mp_cmp_mag.${OBJEXT} \ bn_mp_cnt_lsb.${OBJEXT} \ bn_mp_copy.${OBJEXT} \ bn_mp_count_bits.${OBJEXT} \ bn_mp_div.${OBJEXT} \ bn_mp_div_d.${OBJEXT} \ bn_mp_div_2.${OBJEXT} \ bn_mp_div_2d.${OBJEXT} \ bn_mp_div_3.${OBJEXT} \ bn_mp_exch.${OBJEXT} \ bn_mp_expt_u32.${OBJEXT} \ bn_mp_grow.${OBJEXT} \ bn_mp_init.${OBJEXT} \ bn_mp_init_copy.${OBJEXT} \ bn_mp_init_multi.${OBJEXT} \ bn_mp_init_set.${OBJEXT} \ bn_mp_init_size.${OBJEXT} \ bn_mp_lshd.${OBJEXT} \ bn_mp_mod.${OBJEXT} \ bn_mp_mod_2d.${OBJEXT} \ bn_mp_mul.${OBJEXT} \ bn_mp_mul_2.${OBJEXT} \ bn_mp_mul_2d.${OBJEXT} \ bn_mp_mul_d.${OBJEXT} \ bn_mp_neg.${OBJEXT} \ bn_mp_or.${OBJEXT} \ bn_mp_pack.${OBJEXT} \ bn_mp_pack_count.${OBJEXT} \ bn_mp_radix_size.${OBJEXT} \ bn_mp_radix_smap.${OBJEXT} \ bn_mp_read_radix.${OBJEXT} \ bn_mp_rshd.${OBJEXT} \ bn_mp_set.${OBJEXT} \ bn_mp_shrink.${OBJEXT} \ bn_mp_sqr.${OBJEXT} \ bn_mp_sqrt.${OBJEXT} \ bn_mp_sub.${OBJEXT} \ bn_mp_sub_d.${OBJEXT} \ bn_mp_signed_rsh.${OBJEXT} \ bn_mp_to_ubin.${OBJEXT} \ bn_mp_to_radix.${OBJEXT} \ bn_mp_ubin_size.${OBJEXT} \ bn_mp_unpack.${OBJEXT} \ bn_mp_xor.${OBJEXT} \ bn_mp_zero.${OBJEXT} \ bn_s_mp_add.${OBJEXT} \ bn_s_mp_balance_mul.$(OBJEXT) \ bn_s_mp_karatsuba_mul.${OBJEXT} \ bn_s_mp_karatsuba_sqr.$(OBJEXT) \ bn_s_mp_mul_digs.${OBJEXT} \ bn_s_mp_mul_digs_fast.${OBJEXT} \ bn_s_mp_reverse.${OBJEXT} \ bn_s_mp_sqr_fast.${OBJEXT} \ bn_s_mp_sqr.${OBJEXT} \ bn_s_mp_sub.${OBJEXT} \ bn_s_mp_toom_mul.${OBJEXT} \ bn_s_mp_toom_sqr.${OBJEXT} WIN_OBJS = \ tclWin32Dll.$(OBJEXT) \ tclWinChan.$(OBJEXT) \ tclWinConsole.$(OBJEXT) \ tclWinSerial.$(OBJEXT) \ tclWinError.$(OBJEXT) \ tclWinFCmd.$(OBJEXT) \ tclWinFile.$(OBJEXT) \ tclWinInit.$(OBJEXT) \ tclWinLoad.$(OBJEXT) \ tclWinNotify.$(OBJEXT) \ tclWinPipe.$(OBJEXT) \ tclWinSock.$(OBJEXT) \ tclWinThrd.$(OBJEXT) \ tclWinTime.$(OBJEXT) DDE_OBJS = tclWinDde.$(OBJEXT) REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) ZLIB_OBJS = \ adler32.$(OBJEXT) \ compress.$(OBJEXT) \ crc32.$(OBJEXT) \ deflate.$(OBJEXT) \ infback.$(OBJEXT) \ inffast.$(OBJEXT) \ inflate.$(OBJEXT) \ inftrees.$(OBJEXT) \ trees.$(OBJEXT) \ uncompr.$(OBJEXT) \ zutil.$(OBJEXT) TCL_OBJS = ${GENERIC_OBJS} ${WIN_OBJS} @ZLIB_OBJS@ $(TOMMATH_OBJS) TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] all: binaries libraries doc packages # Test-suite helper (can be used to test Tcl from build directory with all expected modules). # To start from windows shell use: # > tcltest.cmd -verbose bps -file fileName.test # or from mingw/msys shell: # $ ./tcltest -verbose bps -file fileName.test tcltest.cmd: Makefile @echo 'Create tcltest.cmd helpers'; @(\ echo '@echo off'; \ echo 'rem set LANG=en_US'; \ echo 'set BDP=%~dp0'; \ echo 'set OWD=%CD%'; \ echo 'cd /d %TEMP%'; \ echo 'rem "%BDP%\$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_FACILITIES)" %*'; \ echo '"%BDP%\$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_PRMS)" %*'; \ echo 'cd /d %OWD%'; \ ) > tcltest.cmd; @(\ echo '#!/bin/sh'; \ echo '#LANG=en_US'; \ echo 'BDP=$$(dirname $$(readlink -f %0))'; \ echo 'cd /tmp'; \ echo '#"$$BDP/$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_FACILITIES)" "$$@"'; \ echo '"$$BDP/$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_PRMS)" "$$@"'; \ ) > tcltest.sh; tcltest.sh: tcltest.cmd tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH) winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} libraries: doc: $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) $(COPY) tclsh.exe.manifest $(TCLSH).manifest @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) # The following targets are configured by autoconf to generate either a shared # library or static library ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${TCL_DLL_FILE}.manifest @VC_MANIFEST_EMBED_DLL@ ${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ ${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest ${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT} @$(RM) ${TEST_EXE_FILE} $(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) $(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest # use prebuilt zlib1.dll ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} @if test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/zdll.libset" ; then \ $(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.aset" ; then \ $(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \ $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ else \ $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ fi; # Add the object extension to the implicit rules. By default .obj is not # automatically added. .SUFFIXES: .${OBJEXT} .SUFFIXES: .$(RES) .SUFFIXES: .rc # Special case object targets tclTestMain.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DUNICODE -D_UNICODE $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinReg.${OBJEXT}: tclWinReg.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinDde.${OBJEXT}: tclWinDde.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclAppInit.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) tclMainW.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed # and where it will look for its libraries (which can be different). We derive # this information from the variables which can be overridden by the user. As # every path can be configured separately we do not remember one general # prefix/exec_prefix but all the different paths individually. tclPkgConfig.${OBJEXT}: tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR_NATIVE)\"" \ -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR_NATIVE)\"" \ -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR_NATIVE)\"" \ -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR_NATIVE)\"" \ -DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR_NATIVE)\"" \ \ -DCFG_RUNTIME_LIBDIR="\"$(libdir_native)\"" \ -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \ -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \ -DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \ -DBUILD_tcl \ @DEPARG@ $(CC_OBJNAME) tclEvent.${OBJEXT}: tclEvent.c tclUuid.h $(TOP_DIR)/manifest.uuid: printf "git-" >$(TOP_DIR)/manifest.uuid (cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \ (printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \ svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \ printf "unknown" >$(TOP_DIR)/manifest.uuid) tclUuid.h: $(TOP_DIR)/manifest.uuid echo "#define TCL_VERSION_UUID \\" >$@ cat $(TOP_DIR)/manifest.uuid >>$@ echo "" >>$@ # The following objects are part of the stub library and should not be built # as DLL objects but none of the symbols should be exported tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c $(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) tclOOStubLib.${OBJEXT}: tclOOStubLib.c $(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) # Implicit rule for all object files that will end up in the Tcl library %.${OBJEXT}: %.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME) .rc.$(RES): $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@ # The following target generates the file generic/tclDate.c from the yacc # grammar found in generic/tclGetDate.y. This is only run by hand as yacc is # not available in all environments. The name of the .c file is different than # the name of the .y file so that make doesn't try to automatically regenerate # the .c file. gendate: bison --output-file=$(GENERIC_DIR)/tclDate.c \ --name-prefix=TclDate \ --no-lines \ $(GENERIC_DIR)/tclGetDate.y # The following target generates the file generic/tclTomMath.h. It needs to be # run (and the results checked) after updating to a new release of libtommath. gentommath_h: $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \ "$(TOMMATH_DIR_NATIVE)/tommath.h" \ > "$(GENERIC_DIR_NATIVE)/tclTomMath.h" install: all install-binaries install-libraries install-doc install-packages install-binaries: binaries @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)"; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(MKDIR) "$$i"; \ chmod 755 "$$i"; \ else true; \ fi; \ done; @for i in dde${DDEDOTVER} reg${REGDOTVER}; \ do \ if [ ! -d "$(LIB_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ $(MKDIR) "$(LIB_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \ $(COPY) $$i "$(BIN_INSTALL_DIR)"; \ fi; \ done @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \ $(COPY) $$i "$(LIB_INSTALL_DIR)"; \ fi; \ done @if [ -f $(DDE_DLL_FILE) ]; then \ echo Installing $(DDE_DLL_FILE); \ $(COPY) $(DDE_DLL_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo Installing $(DDE_LIB_FILE); \ $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo Installing $(REG_DLL_FILE); \ $(COPY) $(REG_DLL_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ fi install-libraries: libraries install-tzdata install-msgs @for i in "$(prefix)/lib" "$(INCLUDE_INSTALL_DIR)" \ "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(MKDIR) "$$i"; \ else true; \ fi; \ done; @for i in http1.0 opt0.4 encoding; \ do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; @for i in 8.4 8.4/platform 8.5 8.6; \ do \ if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ $(MKDIR) "$(MODULE_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; @echo "Installing header files"; @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \ "$(GENERIC_DIR)/tclPlatDecls.h" \ "$(GENERIC_DIR)/tclTomMath.h" \ "$(GENERIC_DIR)/tclTomMathDecls.h"; \ do \ $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \ do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; @echo "Installing library http1.0 directory"; @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; @echo "Installing package http 2.9.8 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.8.tm"; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.5/msgcat-1.6.1.tm"; @echo "Installing package tcltest 2.5.7 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.7.tm"; @echo "Installing package platform 1.0.19 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm"; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; install-tzdata: @echo "Installing time zone data" @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR_NATIVE)/tzdata" install-msgs: @echo "Installing message catalogs" $(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR_NATIVE)/msgs" install-doc: doc # Optional target to install private headers install-private-headers: libraries @for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ else true; \ fi; \ done; @echo "Installing private header files"; @for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \ "$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \ "$(GENERIC_DIR)/tclOOInt.h" "$(GENERIC_DIR)/tclOOIntDecls.h" \ "$(WIN_DIR)/tclWinPort.h" ; \ do \ $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ done; # Specifying TESTFLAGS on the command line is the standard way to pass args to # tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: test-tcl test-packages test-tcl: tcltest TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ -load "$(TEST_LOAD_FACILITIES)" # Useful target to launch a built tclsh with the proper path,... runtest: tcltest @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` shell: binaries @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: binaries @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run gdb ./$(TCLSH) --command=gdb.run rm gdb.run depend: Makefile: $(SRC_DIR)/Makefile.in ./config.status cleanhelp: $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest.sh $(RM) *.pch *.ilk *.pdb *.zip $(RMDIR) *.vfs distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ tcl.hpj config.status.lineno tclsh.exe.manifest tclUuid.h # # Bundled package targets # PKG_CFG_ARGS = @PKG_CFG_ARGS@ PKG_DIR = ./pkgs packages: @builddir=`$(CYGPATH) $$(pwd -P)`; \ for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ if [ -x $$i/configure ] ; then \ pkg=`basename $$i`; \ mkdir -p $(PKG_DIR)/$$pkg; \ if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \ ( cd $(PKG_DIR)/$$pkg; \ echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \ $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \ fi ; \ echo "Building package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \ fi; \ fi; \ done; \ cd $$builddir install-packages: packages @builddir=`pwd -P`; \ for i in $(PKGS_DIR)/*; do \ if [ -d $$i ]; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ echo "Installing package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) install "DESTDIR=$(INSTALL_ROOT)"; ) \ fi; \ fi; \ done; \ cd $$builddir test-packages: tcltest packages @builddir=`pwd -P`; \ for i in $(PKGS_DIR)/*; do \ if [ -d $$i ]; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ echo "Testing package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) "LD_LIBRARY_PATH=$$builddir:${LD_LIBRARY_PATH}" "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" "TCLLIBPATH=$$builddir/pkgs" test "TCLSH_PROG=$$builddir/${TCLSH}"; ) \ fi; \ fi; \ done; \ cd $$builddir clean-packages: @builddir=`pwd -P`; \ for i in $(PKGS_DIR)/*; do \ if [ -d $$i ]; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \ fi; \ fi; \ done; \ cd $$builddir distclean-packages: @builddir=`pwd -P`; \ for i in $(PKGS_DIR)/*; do \ if [ -d $$i ]; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \ fi; \ cd $$builddir; \ rm -rf $(PKG_DIR)/$$pkg; \ fi; \ done; \ rm -rf $(PKG_DIR) # # Regenerate the stubs files. # $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \ $(GENERIC_DIR)/tclInt.decls @echo "Warning: tclStubInit.c may be out of date." @echo "Developers may want to run \"make genstubs\" to regenerate." @echo "This warning can be safely ignored, do not report as a bug!" genstubs: $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tcl.decls" \ "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ "$(GENERIC_DIR_NATIVE)/tclTomMath.decls" $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tclOO.decls" # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool # workspace. It depends on the Tcl & Tk being in directories called tcl8.* & # tk8.* up two directories from the TOOL_DIR. # TOOL_DIR=$(ROOT_DIR)/tools HTML_INSTALL_DIR=$(ROOT_DIR)/html html: $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)" html-tcl: $(TCLSH) $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl" html-tk: $(TCLSH) $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk" # # The list of all the targets that do not correspond to real files. This stops # 'make' from getting confused when someone makes an error in a rule. # .PHONY: all tcltest binaries libraries doc gendate gentommath_h install .PHONY: install-binaries install-libraries install-tzdata install-msgs .PHONY: install-doc install-private-headers test test-tcl runtest shell .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html .PHONY: html-tcl html-tk # DO NOT DELETE THIS LINE -- make depend depends on it. tcl8.6.14/win/configure.in0000644000175000017500000003526514554262142014763 0ustar sergeisergei#! /bin/bash -norc # This file is an input file used by the GNU "autoconf" program to # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. AC_INIT([tcl],[8.6]) AC_CONFIG_SRCDIR([../generic/tcl.h]) AC_PREREQ([2.59]) # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL=".14" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.3 TCL_REG_MAJOR_VERSION=1 TCL_REG_MINOR_VERSION=3 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ rm -Rf pkgs #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then prefix=/usr/local fi if test "${exec_prefix}" = "NONE"; then exec_prefix=$prefix fi # libdir must be a fully qualified path (not ${exec_prefix}/lib) eval libdir="$libdir" #------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi AC_PROG_CC AC_C_INLINE AC_HEADER_STDC AC_CHECK_TOOL(AR, ar) AC_CHECK_TOOL(RANLIB, ranlib) AC_CHECK_TOOL(RC, windres) #-------------------------------------------------------------------- # Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- AC_PROG_MAKE_SET #-------------------------------------------------------------------- # Determines the correct binary file extension (.o, .obj, .exe etc.) #-------------------------------------------------------------------- AC_OBJEXT AC_EXEEXT #-------------------------------------------------------------------- # Check whether --enable-threads or --disable-threads was given. #-------------------------------------------------------------------- SC_ENABLE_THREADS #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ SC_TCL_CFG_ENCODING #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- SC_ENABLE_SHARED #-------------------------------------------------------------------- # Check whether --enable-time64bit was given. #-------------------------------------------------------------------- AC_MSG_CHECKING([force of 64-bit time_t]) AC_ARG_ENABLE(time64bit, AS_HELP_STRING([--enable-time64bit], [force 64-bit time_t for 32-bit build (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) AC_MSG_RESULT("$tcl_ok") if test "$tcl_ok" = "yes"; then CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- SC_CONFIG_CFLAGS # Cross-compiling case ${host_alias} in *mingw32*) TCL_EXE="tclsh" ;; *) TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}" ;; esac #------------------------------------------------------------------------ # Add stuff for zlib; note that this is mostly done in the makefile now # as we just assume that the platform hasn't got a usable z.lib #------------------------------------------------------------------------ AS_IF([test "${enable_shared+set}" = "set"], [ enableval="$enable_shared" tcl_ok=$enableval ], [ tcl_ok=yes ]) zlib_lib_name=zdll.lib AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) AS_IF([test "$do64bit" != "no"], [ AS_IF([test "$do64bit" = "arm64"], [ AS_IF([test "$GCC" == "yes"],[ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a]) zlib_lib_name=libz.dll.a ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib]) ]) ], [ AS_IF([test "$GCC" == "yes"],[ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a]) zlib_lib_name=libz.dll.a ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib]) ]) ]) ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win32/zdll.lib]) ]) ], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) AC_SUBST(TCL_ZLIB_LIB_NAME, $zlib_lib_name) AC_CHECK_TYPE([intptr_t], [ AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [ AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [ for tcl_cv_intptr_t in "int" "long" "long long" none; do if test "$tcl_cv_intptr_t" != none; then AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], [tcl_ok=yes], [tcl_ok=no]) test "$tcl_ok" = yes && break; fi done]) if test "$tcl_cv_intptr_t" != none; then AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer type wide enough to hold a pointer.]) fi ]) AC_CHECK_TYPE([uintptr_t], [ AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [ AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [ for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ none; do if test "$tcl_cv_uintptr_t" != none; then AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])], [tcl_ok=yes], [tcl_ok=no]) test "$tcl_ok" = yes && break; fi done]) if test "$tcl_cv_uintptr_t" != none; then AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer type wide enough to hold a pointer.]) fi ]) #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, tcl_cv_findex_enums, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN ]], [[ FINDEX_INFO_LEVELS i; FINDEX_SEARCH_OPS j; ]])], [tcl_cv_findex_enums=yes], [tcl_cv_findex_enums=no]) ) if test "$tcl_cv_findex_enums" = "no"; then AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1, [Defined when enums are missing from winbase.h]) fi # See if the compiler supports intrinsics. AC_CACHE_CHECK(for intrinsics support in compiler, tcl_cv_intrinsics, AC_LINK_IFELSE([AC_LANG_PROGRAM([[ #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN #include ]], [[ __cpuidex(0,0,0); ]])], [tcl_cv_intrinsics=yes], [tcl_cv_intrinsics=no]) ) if test "$tcl_cv_intrinsics" = "yes"; then AC_DEFINE(HAVE_INTRIN_H, 1, [Defined when the compilers supports intrinsics]) fi # See if the header file is present AC_CACHE_CHECK(for wspiapi.h, tcl_cv_wspiapi_h, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include ]], [[]])], [tcl_cv_wspiapi_h=yes], [tcl_cv_wspiapi_h=no]) ) if test "$tcl_cv_wspiapi_h" = "yes"; then AC_DEFINE(HAVE_WSPIAPI_H, 1, [Defined when wspiapi.h exists]) fi # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, tcl_cv_findex_enums, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN ]], [[ FINDEX_INFO_LEVELS i; FINDEX_SEARCH_OPS j; ]])], [tcl_cv_findex_enums=yes], [tcl_cv_findex_enums=no]) ) if test "$tcl_cv_findex_enums" = "no"; then AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1, [Defined when enums are missing from winbase.h]) fi #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called # after SC_CONFIG_CFLAGS macro is called. #-------------------------------------------------------------------- SC_ENABLE_SYMBOLS TCL_DBGX=${DBGX} #-------------------------------------------------------------------- # Embed the manifest if we can determine how #-------------------------------------------------------------------- SC_EMBED_MANIFEST #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ TCL_SHARED_BUILD=${SHARED_BUILD} #-------------------------------------------------------------------- # Perform final evaluations of variables with possible substitutions. #-------------------------------------------------------------------- eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then eval "TCL_LIB_FLAG=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" else eval "TCL_LIB_FLAG=\"-ltcl${VER}${FLAGSUFFIX}\"" eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\"" fi eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" eval "DLLSUFFIX=${DLLSUFFIX}" eval "LIBPREFIX=${LIBPREFIX}" eval "LIBSUFFIX=${LIBSUFFIX}" eval "EXESUFFIX=${EXESUFFIX}" TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}" TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX} CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX} #-------------------------------------------------------------------- # Adjust the defines for how the resources are built depending # on symbols and static vs. shared. #-------------------------------------------------------------------- if test ${SHARED_BUILD} = 0 ; then if test "${DBGX}" = "g"; then RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG" else RC_DEFINES="${RC_DEFINE} STATIC_BUILD" fi else if test "${DBGX}" = "g"; then RC_DEFINES="${RC_DEFINE} DEBUG" else RC_DEFINES="" fi fi #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$prefix/lib" != "$libdir"; then TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib}" else TCL_PACKAGE_PATH="{${prefix}/lib}" fi # The tclsh.exe.manifest requires these # TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs # the release level, and must account for interim release versioning case "$TCL_PATCH_LEVEL" in *a*) TCL_RELEASE_LEVEL=0 ;; *b*) TCL_RELEASE_LEVEL=1 ;; *) TCL_RELEASE_LEVEL=2 ;; esac TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" AC_SUBST(TCL_WIN_VERSION) # X86|AMD64|ARM64|IA64 for manifest AC_SUBST(MACHINE) AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(PKG_CFG_ARGS) AC_SUBST(TCL_EXE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_STATIC_LIB_FILE) AC_SUBST(TCL_STATIC_LIB_FLAG) AC_SUBST(TCL_IMPORT_LIB_FILE) AC_SUBST(TCL_IMPORT_LIB_FLAG) # empty on win AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_PATH) AC_SUBST(TCL_INCLUDE_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_PATH) AC_SUBST(TCL_DLL_FILE) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_DBGX) AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX) AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX) # win/tcl.m4 doesn't set (CFLAGS) AC_SUBST(CFLAGS_DEFAULT) AC_SUBST(EXTRA_CFLAGS) AC_SUBST(CYGPATH) AC_SUBST(DEPARG) AC_SUBST(CC_OBJNAME) AC_SUBST(CC_EXENAME) # win/tcl.m4 doesn't set (LDFLAGS) AC_SUBST(LDFLAGS_DEFAULT) AC_SUBST(LDFLAGS_DEBUG) AC_SUBST(LDFLAGS_OPTIMIZE) AC_SUBST(LDFLAGS_CONSOLE) AC_SUBST(LDFLAGS_WINDOW) AC_SUBST(AR) AC_SUBST(RANLIB) AC_SUBST(STLIB_LD) AC_SUBST(SHLIB_LD) AC_SUBST(SHLIB_LD_LIBS) AC_SUBST(SHLIB_CFLAGS) AC_SUBST(SHLIB_SUFFIX) AC_SUBST(TCL_SHARED_BUILD) AC_SUBST(LIBS) AC_SUBST(LIBS_GUI) AC_SUBST(DLLSUFFIX) AC_SUBST(LIBPREFIX) AC_SUBST(LIBSUFFIX) AC_SUBST(EXESUFFIX) AC_SUBST(LIBRARIES) AC_SUBST(MAKE_LIB) AC_SUBST(MAKE_STUB_LIB) AC_SUBST(POST_MAKE_LIB) AC_SUBST(MAKE_DLL) AC_SUBST(MAKE_EXE) # empty on win, but needs sub'ing AC_SUBST(TCL_BUILD_LIB_SPEC) AC_SUBST(TCL_CC_SEARCH_FLAGS) AC_SUBST(TCL_LD_SEARCH_FLAGS) AC_SUBST(TCL_BUILD_EXP_FILE) AC_SUBST(TCL_EXP_FILE) AC_SUBST(DL_LIBS) AC_SUBST(TCL_PACKAGE_PATH) # win only AC_SUBST(TCL_DDE_VERSION) AC_SUBST(TCL_DDE_MAJOR_VERSION) AC_SUBST(TCL_DDE_MINOR_VERSION) AC_SUBST(TCL_REG_VERSION) AC_SUBST(TCL_REG_MAJOR_VERSION) AC_SUBST(TCL_REG_MINOR_VERSION) AC_SUBST(RC) AC_SUBST(RC_OUT) AC_SUBST(RC_TYPE) AC_SUBST(RC_INCLUDE) AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(RES) AC_CONFIG_FILES([Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest]) AC_OUTPUT dnl Local Variables: dnl mode: autoconf dnl End: tcl8.6.14/win/configure0000755000175000017500000054334714554262142014366 0ustar sergeisergei#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.59 for tcl 8.6. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' PACKAGE_VERSION='8.6' PACKAGE_STRING='tcl 8.6' PACKAGE_BUGREPORT='' ac_unique_file="../generic/tcl.h" # Factoring default headers for most tests. ac_includes_default="\ #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if STDC_HEADERS # include # include #else # if HAVE_STDLIB_H # include # endif #endif #if HAVE_STRING_H # if !STDC_HEADERS && HAVE_MEMORY_H # include # endif # include #endif #if HAVE_STRINGS_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_NOLTO ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS TCL_ZLIB_LIB_NAME CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_CC_SEARCH_FLAGS TCL_LD_SEARCH_FLAGS TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias ac_env_CC_set=${CC+set} ac_env_CC_value=$CC ac_cv_env_CC_set=${CC+set} ac_cv_env_CC_value=$CC ac_env_CFLAGS_set=${CFLAGS+set} ac_env_CFLAGS_value=$CFLAGS ac_cv_env_CFLAGS_set=${CFLAGS+set} ac_cv_env_CFLAGS_value=$CFLAGS ac_env_LDFLAGS_set=${LDFLAGS+set} ac_env_LDFLAGS_value=$LDFLAGS ac_cv_env_LDFLAGS_set=${LDFLAGS+set} ac_cv_env_LDFLAGS_value=$LDFLAGS ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS ac_env_CPP_set=${CPP+set} ac_env_CPP_value=$CPP ac_cv_env_CPP_set=${CPP+set} ac_cv_env_CPP_value=$CPP # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures tcl 8.6 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of tcl 8.6:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-threads build with threads (default: on) --enable-shared build and link with shared libraries (default: on) --enable-time64bit force 64-bit time_t for 32-bit build (default: off) --enable-64bit enable 64bit support (where applicable) --enable-wince enable Win/CE support (where applicable) --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values --with-celib=DIR use Windows/CE support library from DIR Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF tcl configure 8.6 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit 0 fi exec 5>config.log cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 8.6, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL=".14" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.3 TCL_REG_MAJOR_VERSION=1 TCL_REG_MINOR_VERSION=3 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ rm -Rf pkgs #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then prefix=/usr/local fi if test "${exec_prefix}" = "NONE"; then exec_prefix=$prefix fi # libdir must be a fully qualified path (not ${exec_prefix}/lib) eval libdir="$libdir" #------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CC" && break done CC=$ac_ct_CC fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 (eval $ac_link_default) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Find the output, starting from the most likely. This scheme is # not robust to junk in `.', hence go to wildcards (a.*) only as a last # resort. # Be careful to initialize this variable, since it used to be cached. # Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. ac_cv_exeext= # b.out is created by i960 compilers. for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; conftest.$ac_ext ) # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` # FIXME: I believe we export ac_cv_exeext for Libtool, # but it would be cool to find out if it's true. Does anybody # maintain Libtool? --akim. export ac_cv_exeext break;; * ) break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6 # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6 echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` export ac_cv_exeext break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS CFLAGS="-g" echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cc_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 if test "${ac_cv_prog_cc_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_stdc=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std1 is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std1. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF # Don't try gcc -ansi; that turns off useful extensions and # breaks some systems' header files. # AIX -qlanglvl=ansi # Ultrix and OSF/1 -std1 # HP-UX 10.20 and later -Ae # HP-UX older versions -Aa -D_HPUX_SOURCE # SVR4 -Xc -D__EXTENSIONS__ for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_stdc=$ac_arg break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext done rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi case "x$ac_cv_prog_cc_stdc" in x|xno) echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6 ;; *) echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 CC="$CC $ac_cv_prog_cc_stdc" ;; esac # Some people use a C++ compiler to compile C. Since we use `exit', # in C++ we need to declare it. In case someone uses the same compiler # for both compiling C and C++ we need to have the C++ compiler decide # the declaration of exit, since it's the most demanding environment. cat >conftest.$ac_ext <<_ACEOF #ifndef __cplusplus choke me #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then for ac_declaration in \ '' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration #include int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking for inline" >&5 echo $ECHO_N "checking for inline... $ECHO_C" >&6 if test "${ac_cv_c_inline+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifndef __cplusplus typedef int foo_t; static $ac_kw foo_t static_foo () {return 0; } $ac_kw foo_t foo () {return 0; } #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_inline=$ac_kw; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done fi echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 echo "${ECHO_T}$ac_cv_c_inline" >&6 case $ac_cv_c_inline in inline | yes) ;; *) case $ac_cv_c_inline in no) ac_val=;; *) ac_val=$ac_cv_c_inline;; esac cat >>confdefs.h <<_ACEOF #ifndef __cplusplus #define inline $ac_val #endif _ACEOF ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6 ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6 if test "${ac_cv_prog_egrep+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | (grep -E '(a|b)') >/dev/null 2>&1 then ac_cv_prog_egrep='grep -E' else ac_cv_prog_egrep='egrep' fi fi echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 echo "${ECHO_T}$ac_cv_prog_egrep" >&6 EGREP=$ac_cv_prog_egrep echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6 if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 echo "${ECHO_T}$ac_ct_AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi AR=$ac_ct_AR else AR="$ac_cv_prog_AR" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then echo "$as_me:$LINENO: result: $RANLIB" >&5 echo "${ECHO_T}$RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 echo "${ECHO_T}$ac_ct_RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args. set dummy ${ac_tool_prefix}windres; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_RC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RC"; then ac_cv_prog_RC="$RC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RC="${ac_tool_prefix}windres" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi RC=$ac_cv_prog_RC if test -n "$RC"; then echo "$as_me:$LINENO: result: $RC" >&5 echo "${ECHO_T}$RC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_RC"; then ac_ct_RC=$RC # Extract the first word of "windres", so it can be a program name with args. set dummy windres; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_RC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RC"; then ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RC="windres" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_RC=$ac_cv_prog_ac_ct_RC if test -n "$ac_ct_RC"; then echo "$as_me:$LINENO: result: $ac_ct_RC" >&5 echo "${ECHO_T}$ac_ct_RC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi RC=$ac_ct_RC else RC="$ac_cv_prog_RC" fi #-------------------------------------------------------------------- # Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 set x ${MAKE-make} ac_make=`echo "" | sed 'y,:./+-,___p_,'` if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\_ACEOF SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. case `${MAKE-make} -f conftest.make 2>/dev/null` in *@@@%%%=?*=@@@%%%*) eval ac_cv_prog_make_${ac_make}_set=yes;; *) eval ac_cv_prog_make_${ac_make}_set=no;; esac rm -f conftest.make fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 SET_MAKE= else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 SET_MAKE="MAKE=${MAKE-make}" fi #-------------------------------------------------------------------- # Determines the correct binary file extension (.o, .obj, .exe etc.) #-------------------------------------------------------------------- #-------------------------------------------------------------------- # Check whether --enable-threads or --disable-threads was given. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for building with threads" >&5 echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 # Check whether --enable-threads or --disable-threads was given. if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else tcl_ok=yes fi; if test "$tcl_ok" = "yes"; then echo "$as_me:$LINENO: result: yes (default)" >&5 echo "${ECHO_T}yes (default)" >&6 TCL_THREADS=1 cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 _ACEOF # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention cat >>confdefs.h <<\_ACEOF #define USE_THREAD_ALLOC 1 _ACEOF else TCL_THREADS=0 echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ # Check whether --with-encoding or --without-encoding was given. if test "${with_encoding+set}" = set; then withval="$with_encoding" with_tcencoding=${withval} fi; if test x"${with_tcencoding}" != x ; then cat >>confdefs.h <<_ACEOF #define TCL_CFGVAL_ENCODING "${with_tcencoding}" _ACEOF else # Default encoding on windows is not "iso8859-1" cat >>confdefs.h <<\_ACEOF #define TCL_CFGVAL_ENCODING "cp1252" _ACEOF fi #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking how to build libraries" >&5 echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes fi; if test "$tcl_ok" = "yes" ; then echo "$as_me:$LINENO: result: shared" >&5 echo "${ECHO_T}shared" >&6 SHARED_BUILD=1 else echo "$as_me:$LINENO: result: static" >&5 echo "${ECHO_T}static" >&6 SHARED_BUILD=0 cat >>confdefs.h <<\_ACEOF #define STATIC_BUILD 1 _ACEOF fi #-------------------------------------------------------------------- # Check whether --enable-time64bit was given. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking force of 64-bit time_t" >&5 echo $ECHO_N "checking force of 64-bit time_t... $ECHO_C" >&6 # Check whether --enable-time64bit or --disable-time64bit was given. if test "${enable_time64bit+set}" = set; then enableval="$enable_time64bit" tcl_ok=$enableval else tcl_ok=no fi; echo "$as_me:$LINENO: result: \"$tcl_ok\"" >&5 echo "${ECHO_T}\"$tcl_ok\"" >&6 if test "$tcl_ok" = "yes"; then CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- # Step 0: Enable 64 bit support? echo "$as_me:$LINENO: checking if 64bit support is requested" >&5 echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" do64bit=$enableval else do64bit=no fi; echo "$as_me:$LINENO: result: $do64bit" >&5 echo "${ECHO_T}$do64bit" >&6 # Cross-compiling options for Windows/CE builds echo "$as_me:$LINENO: checking if Windows/CE build is requested" >&5 echo $ECHO_N "checking if Windows/CE build is requested... $ECHO_C" >&6 # Check whether --enable-wince or --disable-wince was given. if test "${enable_wince+set}" = set; then enableval="$enable_wince" doWince=$enableval else doWince=no fi; echo "$as_me:$LINENO: result: $doWince" >&5 echo "${ECHO_T}$doWince" >&6 echo "$as_me:$LINENO: checking for Windows/CE celib directory" >&5 echo $ECHO_N "checking for Windows/CE celib directory... $ECHO_C" >&6 # Check whether --with-celib or --without-celib was given. if test "${with_celib+set}" = set; then withval="$with_celib" CELIB_DIR=$withval else CELIB_DIR=NO_CELIB fi; echo "$as_me:$LINENO: result: $CELIB_DIR" >&5 echo "${ECHO_T}$CELIB_DIR" >&6 # Set some defaults (may get changed below) EXTRA_CFLAGS="" cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE extern _ACEOF # Extract the first word of "cygpath", so it can be a program name with args. set dummy cygpath; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CYGPATH+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CYGPATH"; then ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CYGPATH="cygpath -m" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" fi fi CYGPATH=$ac_cv_prog_CYGPATH if test -n "$CYGPATH"; then echo "$as_me:$LINENO: result: $CYGPATH" >&5 echo "${ECHO_T}$CYGPATH" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, # which requires x86|amd64|arm64|ia64. MACHINE="X86" if test "$GCC" = "yes"; then echo "$as_me:$LINENO: checking for cross-compile version of gcc" >&5 echo $ECHO_N "checking for cross-compile version of gcc... $ECHO_C" >&6 if test "${ac_cv_cross+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifndef _WIN32 #error cross-compiler #endif int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_cross=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_cross=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_cross" >&5 echo "${ECHO_T}$ac_cv_cross" >&6 if test "$ac_cv_cross" = "yes"; then case "$do64bit" in amd64|x64|yes) CC="x86_64-w64-mingw32-${CC}" LD="x86_64-w64-mingw32-ld" AR="x86_64-w64-mingw32-ar" RANLIB="x86_64-w64-mingw32-ranlib" RC="x86_64-w64-mingw32-windres" ;; arm64|aarch64) CC="aarch64-w64-mingw32-${CC}" LD="aarch64-w64-mingw32-ld" AR="aarch64-w64-mingw32-ar" RANLIB="aarch64-w64-mingw32-ranlib" RC="aarch64-w64-mingw32-windres" ;; *) CC="i686-w64-mingw32-${CC}" LD="i686-w64-mingw32-ld" AR="i686-w64-mingw32-ar" RANLIB="i686-w64-mingw32-ranlib" RC="i686-w64-mingw32-windres" ;; esac fi fi # Check for a bug in gcc's windres that causes the # compile to fail when a Windows native path is # passed into windres. The mingw toolchain requires # Windows native paths while Cygwin should work # with both. Avoid the bug by passing a POSIX # path when using the Cygwin toolchain. if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then conftest=/tmp/conftest.rc echo "STRINGTABLE BEGIN" > $conftest echo "101 \"name\"" >> $conftest echo "END" >> $conftest echo "$as_me:$LINENO: checking for Windows native path bug in windres" >&5 echo $ECHO_N "checking for Windows native path bug in windres... $ECHO_C" >&6 cyg_conftest=`$CYGPATH $conftest` if { ac_try='$RC -o conftest.res.o $cyg_conftest' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } ; then echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 else echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 CYGPATH=echo fi conftest= cyg_conftest= fi if test "$CYGPATH" = "echo"; then DEPARG='"$<"' else DEPARG='"$(shell $(CYGPATH) $<)"' fi # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then extra_cflags="-pipe" extra_ldflags="-pipe -static-libgcc" echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5 echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6 if test "${ac_cv_win32+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef _WIN32 #error win32 #endif int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_win32=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_win32=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_win32" >&5 echo "${ECHO_T}$ac_cv_win32" >&6 if test "$ac_cv_win32" != "yes"; then { { echo "$as_me:$LINENO: error: ${CC} cannot produce win32 executables." >&5 echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;} { (exit 1); exit 1; }; } fi if test "$do64bit" != "arm64"; then extra_cflags="$extra_cflags -DHAVE_CPUID=1" fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" echo "$as_me:$LINENO: checking for working -municode linker flag" >&5 echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6 if test "${ac_cv_municode+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_municode=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_municode=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_municode" >&5 echo "${ECHO_T}$ac_cv_municode" >&6 CFLAGS=$hold_cflags if test "$ac_cv_municode" = "yes" ; then extra_ldflags="$extra_ldflags -municode" else extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" echo "$as_me:$LINENO: checking for working -fno-lto" >&5 echo $ECHO_N "checking for working -fno-lto... $ECHO_C" >&6 if test "${ac_cv_nolto+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_nolto=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_nolto=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_nolto" >&5 echo "${ECHO_T}$ac_cv_nolto" >&6 CFLAGS=$hold_cflags if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base" echo "$as_me:$LINENO: checking for working --enable-auto-image-base" >&5 echo $ECHO_N "checking for working --enable-auto-image-base... $ECHO_C" >&6 if test "${ac_cv_enable_auto_image_base+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_enable_auto_image_base=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_enable_auto_image_base=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_enable_auto_image_base" >&5 echo "${ECHO_T}$ac_cv_enable_auto_image_base" >&6 CFLAGS=$hold_cflags if test "$ac_cv_enable_auto_image_base" == "yes" ; then extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base" fi echo "$as_me:$LINENO: checking compiler flags" >&5 echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${GCC}" = "yes" ; then SHLIB_LD="" SHLIB_LD_LIBS='${LIBS}' LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= RC_INCLUDE=--include RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \$@" MAKE_STUB_LIB="\${STLIB_LD} \$@" POST_MAKE_LIB="\${RANLIB} \$@" MAKE_EXE="\${CC} -o \$@" LIBPREFIX="lib" if test "${SHARED_BUILD}" = "0" ; then # static echo "$as_me:$LINENO: result: using static flags" >&5 echo "${ECHO_T}using static flags" >&6 runtime= LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else # dynamic echo "$as_me:$LINENO: result: using shared flags" >&5 echo "${ECHO_T}using shared flags" >&6 # ad-hoc check to see if CC supports -shared. if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then { { echo "$as_me:$LINENO: error: ${CC} does not support the -shared option. You will need to upgrade to a newer version of the toolchain." >&5 echo "$as_me: error: ${CC} does not support the -shared option. You will need to upgrade to a newer version of the toolchain." >&2;} { (exit 1); exit 1; }; } fi runtime= # Add SHLIB_LD_LIBS to the Make rule, not here. EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi # Link with gcc since ld does not link to default libs like # -luser32 and -lmsvcrt by default. SHLIB_LD='${CC} -shared' SHLIB_LD_LIBS='${LIBS}' MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ -Wl,--out-implib,\$(patsubst %.dll,lib%.dll.a,\$@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" LIBSUFFIX="\${DBGX}.a" LIBFLAGSUFFIX="\${DBGX}" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" CFLAGS_WARNING="-Wall -Wpointer-arith" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= case "${CC}" in *++) CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" ;; *) CFLAGS_WARNING="${CFLAGS_WARNING} -Wdeclaration-after-statement" ;; esac # Specify the CC output file names based on the target name CC_OBJNAME="-o \$@" CC_EXENAME="-o \$@" # Specify linker flags depending on the type of app being # built -- Console vs. Window. # # ORIGINAL COMMENT: # We need to pass -e _WinMain@16 so that ld will use # WinMain() instead of main() as the entry point. We can't # use autoconf to check for this case since it would need # to run an executable and that does not work when # cross compiling. Remove this -e workaround once we # require a gcc that does not have this bug. # # MK NOTE: Tk should use a different mechanism. This causes # interesting problems, such as wish dying at startup. #LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}" LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}" LDFLAGS_WINDOW="-mwindows ${extra_ldflags}" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 ;; arm64|aarch64) MACHINE="ARM64" echo "$as_me:$LINENO: result: Using ARM64 $MACHINE mode" >&5 echo "${ECHO_T} Using ARM64 $MACHINE mode" >&6 ;; ia64) MACHINE="IA64" echo "$as_me:$LINENO: result: Using IA64 $MACHINE mode" >&5 echo "${ECHO_T} Using IA64 $MACHINE mode" >&6 ;; *) cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifndef _WIN64 #error 32-bit #endif int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_win_64bit=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_win_64bit=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test "$tcl_win_64bit" = "yes" ; then do64bit=amd64 MACHINE="AMD64" echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 fi ;; esac else if test "${SHARED_BUILD}" = "0" ; then # static echo "$as_me:$LINENO: result: using static flags" >&5 echo "${ECHO_T}using static flags" >&6 runtime=-MT LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else # dynamic echo "$as_me:$LINENO: result: using shared flags" >&5 echo "${ECHO_T}using shared flags" >&6 runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. LIBRARIES="\${SHARED_LIBRARIES}" EXESUFFIX="\${DBGX}.exe" case "x`echo \${VisualStudioVersion}`" in x1[4-9]*) lflags="${lflags} -nodefaultlib:libucrt.lib" ;; *) ;; esac fi MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" LIBSUFFIX="\${DBGX}.lib" LIBFLAGSUFFIX="\${DBGX}" if test "$do64bit" != "no" ; then case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build ;; arm64|aarch64) MACHINE="ARM64" ;; ia64) MACHINE="IA64" ;; esac echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 fi LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib" case "x`echo \${VisualStudioVersion}`" in x1[4-9]*) LIBS="$LIBS ucrt.lib" ;; *) ;; esac if test "$do64bit" != "no" ; then RC="rc" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="${lflags} -nologo -MACHINE:${MACHINE}" LINKBIN="link" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 LIBS="$LIBS bufferoverflowU.lib" else RC="rc" # -Od - no optimization # -WX - warnings as errors CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="${lflags} -nologo" LINKBIN="link" fi if test "$doWince" != "no" ; then # Set defaults for common evc4/PPC2003 setup # Currently Tcl requires 300+, possibly 420+ for sockets CEVERSION=420; # could be 211 300 301 400 420 ... TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... ARCH=ARM; # could be ARM MIPS X86EM ... PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" if test "$doWince" != "yes"; then # If !yes then the user specified something # Reset ARCH to allow user to skip specifying it ARCH= eval `echo $doWince | awk -F "," '{ \ if (length($1)) { printf "CEVERSION=\"%s\"\n", $1; \ if ($1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ if (length($2)) { printf "TARGETCPU=\"%s\"\n", toupper($2) }; \ if (length($3)) { printf "ARCH=\"%s\"\n", toupper($3) }; \ if (length($4)) { printf "PLATFORM=\"%s\"\n", $4 }; \ }'` if test "x${ARCH}" = "x" ; then ARCH=$TARGETCPU; fi fi OSVERSION=WCE$CEVERSION; if test "x${WCEROOT}" = "x" ; then WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" if test ! -d "${WCEROOT}" ; then WCEROOT="C:/Program Files/Microsoft eMbedded Tools" fi fi if test "x${SDKROOT}" = "x" ; then SDKROOT="C:/Program Files/Windows CE Tools" if test ! -d "${SDKROOT}" ; then SDKROOT="C:/Windows CE Tools" fi fi # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` if test ! -d "${CELIB_DIR}/inc"; then { { echo "$as_me:$LINENO: error: Invalid celib directory \"${CELIB_DIR}\"" >&5 echo "$as_me: error: Invalid celib directory \"${CELIB_DIR}\"" >&2;} { (exit 1); exit 1; }; } fi if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\ -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then { { echo "$as_me:$LINENO: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&5 echo "$as_me: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&2;} { (exit 1); exit 1; }; } else CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" if test -d "${CEINCLUDE}/${TARGETCPU}" ; then CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" fi CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" fi fi if test "$doWince" != "no" ; then CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" if test "${TARGETCPU}" = "X86"; then CC="${CEBINROOT}/cl.exe" else CC="${CEBINROOT}/cl${ARCH}.exe" fi CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" arch=`echo ${ARCH} | awk '{print tolower($0)}'` defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS" for i in $defs ; do cat >>confdefs.h <<_ACEOF #define $i 1 _ACEOF done # if test "${ARCH}" = "X86EM"; then # AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION) # fi cat >>confdefs.h <<_ACEOF #define _WIN32_WCE $CEVERSION _ACEOF cat >>confdefs.h <<_ACEOF #define UNDER_CE $CEVERSION _ACEOF CFLAGS_DEBUG="-nologo -Zi -Od" CFLAGS_OPTIMIZE="-nologo -O2" lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" LINKBIN="\"${CEBINROOT}/link.exe\"" if test "${CEVERSION}" -lt 400 ; then LIBS="coredll.lib corelibc.lib winsock.lib" else LIBS="coredll.lib corelibc.lib ws2.lib" fi # celib currently stuck at wce300 status #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib" LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\"" LIBS_GUI="commctrl.lib commdlg.lib" else LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" fi SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" SHLIB_LD_LIBS='${LIBS}' # link -lib only works when -lib is the first arg STLIB_LD="${LINKBIN} -lib ${lflags}" RC_OUT=-fo RC_TYPE=-r RC_INCLUDE=-i RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\$@" MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\$@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\$@" LIBPREFIX="" CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" EXTRA_CFLAGS="" CFLAGS_WARNING="-W3" LDFLAGS_DEBUG="-debug" LDFLAGS_OPTIMIZE="-release" # Specify the CC output file names based on the target name CC_OBJNAME="-Fo\$@" CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\"" # Specify linker flags depending on the type of app being # built -- Console vs. Window. if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then LDFLAGS_CONSOLE="-link ${lflags}" LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} else LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}" LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}" fi fi if test "$do64bit" != "no" ; then cat >>confdefs.h <<\_ACEOF #define TCL_CFG_DO64BIT 1 _ACEOF fi if test "${GCC}" = "yes" ; then echo "$as_me:$LINENO: checking for SEH support in compiler" >&5 echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6 if test "${tcl_cv_seh+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_seh=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN int main(int argc, char** argv) { int a, b = 0; __try { a = 666 / b; } __except (EXCEPTION_EXECUTE_HANDLER) { return 0; } return 1; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_seh=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) tcl_cv_seh=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5 echo "${ECHO_T}$tcl_cv_seh" >&6 if test "$tcl_cv_seh" = "no" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_NO_SEH 1 _ACEOF fi # # Check to see if the excpt.h include file provided contains the # definition for EXCEPTION_DISPOSITION; if not, which is the case # with Cygwin's version as of 2002-04-10, define it to be int, # sufficient for getting the current code to work. # echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5 echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6 if test "${tcl_cv_eh_disposition+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ # define WIN32_LEAN_AND_MEAN # include # undef WIN32_LEAN_AND_MEAN int main () { EXCEPTION_DISPOSITION x; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_eh_disposition=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_eh_disposition=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5 echo "${ECHO_T}$tcl_cv_eh_disposition" >&6 if test "$tcl_cv_eh_disposition" = "no" ; then cat >>confdefs.h <<\_ACEOF #define EXCEPTION_DISPOSITION int _ACEOF fi # Check to see if winnt.h defines CHAR, SHORT, and LONG # even if VOID has already been #defined. The win32api # used by mingw and cygwin is known to do this. echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5 echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6 if test "${tcl_cv_winnt_ignore_void+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define VOID void #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN int main () { CHAR c; SHORT s; LONG l; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_winnt_ignore_void=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_winnt_ignore_void=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5 echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6 if test "$tcl_cv_winnt_ignore_void" = "yes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_WINNT_IGNORE_VOID 1 _ACEOF fi # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. echo "$as_me:$LINENO: checking for cast to union support" >&5 echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 if test "${tcl_cv_cast_to_union+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { union foo { int i; double d; }; union foo f = (union foo) (int) 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cast_to_union=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cast_to_union=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 if test "$tcl_cv_cast_to_union" = "yes"; then cat >>confdefs.h <<\_ACEOF #define HAVE_CAST_TO_UNION 1 _ACEOF fi fi # DL_LIBS is empty, but then we match the Unix version # Cross-compiling case ${host_alias} in *mingw32*) TCL_EXE="tclsh" ;; *) TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}" ;; esac #------------------------------------------------------------------------ # Add stuff for zlib; note that this is mostly done in the makefile now # as we just assume that the platform hasn't got a usable z.lib #------------------------------------------------------------------------ if test "${enable_shared+set}" = "set"; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes fi zlib_lib_name=zdll.lib if test "$tcl_ok" = "yes"; then ZLIB_DLL_FILE=\${ZLIB_DLL_FILE} if test "$do64bit" != "no"; then if test "$do64bit" = "arm64"; then if test "$GCC" == "yes"; then ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a zlib_lib_name=libz.dll.a else ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib fi else if test "$GCC" == "yes"; then ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a zlib_lib_name=libz.dll.a else ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib fi fi else ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib fi else ZLIB_OBJS=\${ZLIB_OBJS} fi cat >>confdefs.h <<\_ACEOF #define HAVE_ZLIB 1 _ACEOF TCL_ZLIB_LIB_NAME=$zlib_lib_name # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking for intptr_t" >&5 echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 if test "${ac_cv_type_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((intptr_t *) 0) return 0; if (sizeof (intptr_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_intptr_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_intptr_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 if test $ac_cv_type_intptr_t = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_INTPTR_T 1 _ACEOF else echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 if test "${tcl_cv_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for tcl_cv_intptr_t in "int" "long" "long long" none; do if test "$tcl_cv_intptr_t" != none; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_ok=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 echo "${ECHO_T}$tcl_cv_intptr_t" >&6 if test "$tcl_cv_intptr_t" != none; then cat >>confdefs.h <<_ACEOF #define intptr_t $tcl_cv_intptr_t _ACEOF fi fi echo "$as_me:$LINENO: checking for uintptr_t" >&5 echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 if test "${ac_cv_type_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((uintptr_t *) 0) return 0; if (sizeof (uintptr_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_uintptr_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_uintptr_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 if test $ac_cv_type_uintptr_t = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_UINTPTR_T 1 _ACEOF else echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 if test "${tcl_cv_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ none; do if test "$tcl_cv_uintptr_t" != none; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_ok=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 if test "$tcl_cv_uintptr_t" != none; then cat >>confdefs.h <<_ACEOF #define uintptr_t $tcl_cv_uintptr_t _ACEOF fi fi #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6 if test "${tcl_cv_findex_enums+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN int main () { FINDEX_INFO_LEVELS i; FINDEX_SEARCH_OPS j; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_findex_enums=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_findex_enums=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5 echo "${ECHO_T}$tcl_cv_findex_enums" >&6 if test "$tcl_cv_findex_enums" = "no"; then cat >>confdefs.h <<\_ACEOF #define HAVE_NO_FINDEX_ENUMS 1 _ACEOF fi # See if the compiler supports intrinsics. echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5 echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6 if test "${tcl_cv_intrinsics+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN #include int main () { __cpuidex(0,0,0); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_intrinsics=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_intrinsics=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5 echo "${ECHO_T}$tcl_cv_intrinsics" >&6 if test "$tcl_cv_intrinsics" = "yes"; then cat >>confdefs.h <<\_ACEOF #define HAVE_INTRIN_H 1 _ACEOF fi # See if the header file is present echo "$as_me:$LINENO: checking for wspiapi.h" >&5 echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6 if test "${tcl_cv_wspiapi_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_wspiapi_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_wspiapi_h=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_wspiapi_h" >&5 echo "${ECHO_T}$tcl_cv_wspiapi_h" >&6 if test "$tcl_cv_wspiapi_h" = "yes"; then cat >>confdefs.h <<\_ACEOF #define HAVE_WSPIAPI_H 1 _ACEOF fi # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6 if test "${tcl_cv_findex_enums+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN int main () { FINDEX_INFO_LEVELS i; FINDEX_SEARCH_OPS j; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_findex_enums=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_findex_enums=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5 echo "${ECHO_T}$tcl_cv_findex_enums" >&6 if test "$tcl_cv_findex_enums" = "no"; then cat >>confdefs.h <<\_ACEOF #define HAVE_NO_FINDEX_ENUMS 1 _ACEOF fi #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called # after SC_CONFIG_CFLAGS macro is called. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for build with symbols" >&5 echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" tcl_ok=$enableval else tcl_ok=no fi; # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" cat >>confdefs.h <<\_ACEOF #define NDEBUG 1 _ACEOF echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 cat >>confdefs.h <<\_ACEOF #define TCL_CFG_OPTIMIZED 1 _ACEOF else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' DBGX=g if test "$tcl_ok" = "yes"; then echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 echo "${ECHO_T}yes (standard debugging)" >&6 fi fi if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then cat >>confdefs.h <<\_ACEOF #define TCL_MEM_DEBUG 1 _ACEOF fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_DEBUG 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_STATS 1 _ACEOF fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5 echo "${ECHO_T}enabled symbols mem compile debugging" >&6 else echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5 echo "${ECHO_T}enabled $tcl_ok debugging" >&6 fi fi TCL_DBGX=${DBGX} #-------------------------------------------------------------------- # Embed the manifest if we can determine how #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether to embed manifest" >&5 echo $ECHO_N "checking whether to embed manifest... $ECHO_C" >&6 # Check whether --enable-embedded-manifest or --disable-embedded-manifest was given. if test "${enable_embedded_manifest+set}" = set; then enableval="$enable_embedded_manifest" embed_ok=$enableval else embed_ok=yes fi; VC_MANIFEST_EMBED_DLL= VC_MANIFEST_EMBED_EXE= result=no if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \ -a "$GCC" != "yes" ; then # Add the magic to embed the manifest into the dll/exe cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if defined(_MSC_VER) && _MSC_VER >= 1400 print("manifest needed") #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "manifest needed" >/dev/null 2>&1; then # Could do a CHECK_PROG for mt, but should always be with MSVC8+ # Could add 'if test -f' check, but manifest should be created # in this compiler case # Add in a manifest argument that may be specified # XXX Needs improvement so that the test for existence accounts # XXX for a provided (known) manifest VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;2 ; fi" VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;1 ; fi" result=yes if test "x" != x ; then result="yes ()" fi fi rm -f conftest* fi echo "$as_me:$LINENO: result: $result" >&5 echo "${ECHO_T}$result" >&6 #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ TCL_SHARED_BUILD=${SHARED_BUILD} #-------------------------------------------------------------------- # Perform final evaluations of variables with possible substitutions. #-------------------------------------------------------------------- eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then eval "TCL_LIB_FLAG=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" else eval "TCL_LIB_FLAG=\"-ltcl${VER}${FLAGSUFFIX}\"" eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\"" fi eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" eval "DLLSUFFIX=${DLLSUFFIX}" eval "LIBPREFIX=${LIBPREFIX}" eval "LIBSUFFIX=${LIBSUFFIX}" eval "EXESUFFIX=${EXESUFFIX}" TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}" TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX} CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX} #-------------------------------------------------------------------- # Adjust the defines for how the resources are built depending # on symbols and static vs. shared. #-------------------------------------------------------------------- if test ${SHARED_BUILD} = 0 ; then if test "${DBGX}" = "g"; then RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG" else RC_DEFINES="${RC_DEFINE} STATIC_BUILD" fi else if test "${DBGX}" = "g"; then RC_DEFINES="${RC_DEFINE} DEBUG" else RC_DEFINES="" fi fi #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$prefix/lib" != "$libdir"; then TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib}" else TCL_PACKAGE_PATH="{${prefix}/lib}" fi # The tclsh.exe.manifest requires these # TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs # the release level, and must account for interim release versioning case "$TCL_PATCH_LEVEL" in *a*) TCL_RELEASE_LEVEL=0 ;; *b*) TCL_RELEASE_LEVEL=1 ;; *) TCL_RELEASE_LEVEL=2 ;; esac TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" # X86|AMD64|ARM64|IA64 for manifest # empty on win # win/tcl.m4 doesn't set (CFLAGS) # win/tcl.m4 doesn't set (LDFLAGS) # empty on win, but needs sub'ing # win only ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. cat >confdef2opt.sed <<\_ACEOF t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g p _ACEOF # We use echo to avoid assuming a particular line-breaking character. # The extra dot is to prevent the shell from consuming trailing # line-breaks from the sub-command output. A line-break within # single-quotes doesn't work because, if this script is created in a # platform that uses two characters for line-breaks (e.g., DOS), tr # would break. ac_LF_and_DOT=`echo; echo .` DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` rm -f confdef2opt.sed ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_i=`echo "$ac_i" | sed 's/\$U\././;s/\.o$//;s/\.obj$//'` # 2. Add them. ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by tcl $as_me 8.6, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ tcl config.status 8.6 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; "tclsh.exe.manifest" ) CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@CC@,$CC,;t t s,@CFLAGS@,$CFLAGS,;t t s,@LDFLAGS@,$LDFLAGS,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t s,@CPP@,$CPP,;t t s,@EGREP@,$EGREP,;t t s,@AR@,$AR,;t t s,@ac_ct_AR@,$ac_ct_AR,;t t s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@RC@,$RC,;t t s,@ac_ct_RC@,$ac_ct_RC,;t t s,@SET_MAKE@,$SET_MAKE,;t t s,@TCL_THREADS@,$TCL_THREADS,;t t s,@CYGPATH@,$CYGPATH,;t t s,@CELIB_DIR@,$CELIB_DIR,;t t s,@DL_LIBS@,$DL_LIBS,;t t s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t s,@CFLAGS_NOLTO@,$CFLAGS_NOLTO,;t t s,@ZLIB_DLL_FILE@,$ZLIB_DLL_FILE,;t t s,@ZLIB_LIBS@,$ZLIB_LIBS,;t t s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t s,@TCL_ZLIB_LIB_NAME@,$TCL_ZLIB_LIB_NAME,;t t s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t s,@MACHINE@,$MACHINE,;t t s,@TCL_VERSION@,$TCL_VERSION,;t t s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t s,@TCL_EXE@,$TCL_EXE,;t t s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t s,@TCL_STATIC_LIB_FILE@,$TCL_STATIC_LIB_FILE,;t t s,@TCL_STATIC_LIB_FLAG@,$TCL_STATIC_LIB_FLAG,;t t s,@TCL_IMPORT_LIB_FILE@,$TCL_IMPORT_LIB_FILE,;t t s,@TCL_IMPORT_LIB_FLAG@,$TCL_IMPORT_LIB_FLAG,;t t s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t s,@TCL_DLL_FILE@,$TCL_DLL_FILE,;t t s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t s,@TCL_DBGX@,$TCL_DBGX,;t t s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t s,@DEPARG@,$DEPARG,;t t s,@CC_OBJNAME@,$CC_OBJNAME,;t t s,@CC_EXENAME@,$CC_EXENAME,;t t s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t s,@STLIB_LD@,$STLIB_LD,;t t s,@SHLIB_LD@,$SHLIB_LD,;t t s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t s,@LIBS_GUI@,$LIBS_GUI,;t t s,@DLLSUFFIX@,$DLLSUFFIX,;t t s,@LIBPREFIX@,$LIBPREFIX,;t t s,@LIBSUFFIX@,$LIBSUFFIX,;t t s,@EXESUFFIX@,$EXESUFFIX,;t t s,@LIBRARIES@,$LIBRARIES,;t t s,@MAKE_LIB@,$MAKE_LIB,;t t s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t s,@MAKE_DLL@,$MAKE_DLL,;t t s,@MAKE_EXE@,$MAKE_EXE,;t t s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t s,@TCL_CC_SEARCH_FLAGS@,$TCL_CC_SEARCH_FLAGS,;t t s,@TCL_LD_SEARCH_FLAGS@,$TCL_LD_SEARCH_FLAGS,;t t s,@TCL_BUILD_EXP_FILE@,$TCL_BUILD_EXP_FILE,;t t s,@TCL_EXP_FILE@,$TCL_EXP_FILE,;t t s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t s,@RC_OUT@,$RC_OUT,;t t s,@RC_TYPE@,$RC_TYPE,;t t s,@RC_INCLUDE@,$RC_INCLUDE,;t t s,@RC_DEFINE@,$RC_DEFINE,;t t s,@RC_DEFINES@,$RC_DEFINES,;t t s,@RES@,$RES,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi tcl8.6.14/win/tclConfig.sh.in0000644000175000017500000001433414554262142015315 0ustar sergeisergei# tclConfig.sh -- # # This shell script (for sh) is generated automatically by Tcl's # configure script. It will create shell variables for most of # the configuration options discovered by the configure script. # This script is intended to be included by the configure scripts # for Tcl extensions so that they don't have to figure this all # out for themselves. # # The information in this file is specific to a single platform. TCL_DLL_FILE="@TCL_DLL_FILE@" # Tcl's version number. TCL_VERSION='@TCL_VERSION@' TCL_MAJOR_VERSION='@TCL_MAJOR_VERSION@' TCL_MINOR_VERSION='@TCL_MINOR_VERSION@' TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@' # C compiler to use for compilation. TCL_CC='@CC@' # -D flags for use with the C compiler. TCL_DEFS='@DEFS@' # If TCL was built with debugging symbols, generated libraries contain # this string at the end of the library name (before the extension). TCL_DBGX=@TCL_DBGX@ # Default flags used in an optimized and debuggable build, respectively. TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@' TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@' # Default linker flags used in an optimized and debuggable build, respectively. TCL_LDFLAGS_DEBUG='@LDFLAGS_DEBUG@' TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@' # Flag, 1: we built a shared lib, 0 we didn't TCL_SHARED_BUILD=@TCL_SHARED_BUILD@ # The name of the Tcl library (may be either a .a file or a shared library): TCL_LIB_FILE='@TCL_LIB_FILE@' # Flag to indicate whether shared libraries need export files. TCL_NEEDS_EXP_FILE='' # Deprecated. Same as TCL_UNSHARED_LIB_SUFFIX TCL_EXPORT_FILE_SUFFIX='@CFG_TCL_UNSHARED_LIB_SUFFIX@' # Additional libraries to use when linking Tcl. TCL_LIBS='@LIBS@' # Top-level directory in which Tcl's platform-independent files are # installed. TCL_PREFIX='@prefix@' # Top-level directory in which Tcl's platform-specific files (e.g. # executables) are installed. TCL_EXEC_PREFIX='@exec_prefix@' # Flags to pass to cc when compiling the components of a shared library: TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@' # Flags to pass to cc to get warning messages TCL_CFLAGS_WARNING='@CFLAGS_WARNING@' # Extra flags to pass to cc: TCL_EXTRA_CFLAGS='@EXTRA_CFLAGS@' # Base command to use for combining object files into a shared library: TCL_SHLIB_LD='@SHLIB_LD@' # Base command to use for combining object files into a static library: TCL_STLIB_LD='@STLIB_LD@' # Either '$LIBS' (if dependent libraries should be included when linking # shared libraries) or an empty string. See Tcl's configure.in for more # explanation. TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@' # Suffix to use for the name of a shared library. TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@' # Library file(s) to include in tclsh and other base applications # in order to provide facilities needed by DLOBJ above. TCL_DL_LIBS='@DL_LIBS@' # Flags to pass to the compiler when linking object files into # an executable tclsh or tcltest binary. TCL_LD_FLAGS='@LDFLAGS@' # Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the # run-time dynamic linker where to look for shared libraries such as # libtcl.so. Used when linking applications. Only works if there # is a variable "LIB_RUNTIME_DIR" defined in the Makefile. TCL_CC_SEARCH_FLAGS='@TCL_CC_SEARCH_FLAGS@' TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@' # Additional object files linked with Tcl to provide compatibility # with standard facilities from ANSI C or POSIX. TCL_COMPAT_OBJS='@LIBOBJS@' # Name of the ranlib program to use. TCL_RANLIB='@RANLIB@' # -l flag to pass to the linker to pick up the Tcl library TCL_LIB_FLAG='@TCL_LIB_FLAG@' # String to pass to linker to pick up the Tcl library from its # build directory. TCL_BUILD_LIB_SPEC='@TCL_BUILD_LIB_SPEC@' # String to pass to linker to pick up the Tcl library from its # installed directory. TCL_LIB_SPEC='@TCL_LIB_SPEC@' # String to pass to the compiler so that an extension can # find installed Tcl headers. TCL_INCLUDE_SPEC='@TCL_INCLUDE_SPEC@' # Indicates whether a version numbers should be used in -l switches # ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means # use switches like -ltcl75). SunOS and FreeBSD require "nodots", for # example. TCL_LIB_VERSIONS_OK='nodots' # String that can be evaluated to generate the part of a shared library # name that comes after the "libxxx" (includes version number, if any, # extension, and anything else needed). May depend on the variables # VERSION and SHLIB_SUFFIX. On most UNIX systems this is # ${VERSION}${SHLIB_SUFFIX}. TCL_SHARED_LIB_SUFFIX='@CFG_TCL_SHARED_LIB_SUFFIX@' # String that can be evaluated to generate the part of an unshared library # name that comes after the "libxxx" (includes version number, if any, # extension, and anything else needed). May depend on the variable # VERSION. On most UNIX systems this is ${VERSION}.a. TCL_UNSHARED_LIB_SUFFIX='@CFG_TCL_UNSHARED_LIB_SUFFIX@' # Location of the top-level source directory from which Tcl was built. # This is the directory that contains a README file as well as # subdirectories such as generic, unix, etc. If Tcl was compiled in a # different place than the directory containing the source files, this # points to the location of the sources, not the location where Tcl was # compiled. TCL_SRC_DIR='@TCL_SRC_DIR@' # List of standard directories in which to look for packages during # "package require" commands. Contains the "prefix" directory plus also # the "exec_prefix" directory, if it is different. TCL_PACKAGE_PATH='@TCL_PACKAGE_PATH@' # Tcl supports stub. TCL_SUPPORTS_STUBS=1 # The name of the Tcl stub library (.a): TCL_STUB_LIB_FILE='@TCL_STUB_LIB_FILE@' # -l flag to pass to the linker to pick up the Tcl stub library TCL_STUB_LIB_FLAG='@TCL_STUB_LIB_FLAG@' # String to pass to linker to pick up the Tcl stub library from its # build directory. TCL_BUILD_STUB_LIB_SPEC='@TCL_BUILD_STUB_LIB_SPEC@' # String to pass to linker to pick up the Tcl stub library from its # installed directory. TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@' # Path to the Tcl stub library in the build directory. TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@' # Path to the Tcl stub library in the install directory. TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@' # Flag, 1: we built Tcl with threads enabled, 0 we didn't TCL_THREADS=@TCL_THREADS@ # Name of the zlib library that extensions should use TCL_ZLIB_LIB_NAME='@TCL_ZLIB_LIB_NAME@' tcl8.6.14/win/tclooConfig.sh0000644000175000017500000000140514554262142015241 0ustar sergeisergei# tclooConfig.sh -- # # This shell script (for sh) is generated automatically by TclOO's configure # script, or would be except it has no values that we substitute. It will # create shell variables for most of the configuration options discovered by # the configure script. This script is intended to be included by TEA-based # configure scripts for TclOO extensions so that they don't have to figure # this all out for themselves. # # The information in this file is specific to a single platform. # These are mostly empty because no special steps are ever needed from Tcl 8.6 # onwards; all libraries and include files are just part of Tcl. TCLOO_LIB_SPEC="" TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" TCLOO_VERSION=1.1.0 tcl8.6.14/win/tcl.m40000644000175000017500000011373014554262142013470 0ustar sergeisergei#------------------------------------------------------------------------ # SC_PATH_TCLCONFIG -- # # Locate the tclConfig.sh file and perform a sanity check on # the Tcl compile flags # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --with-tcl=... # # Defines the following vars: # TCL_BIN_DIR Full path to the directory containing # the tclConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TCLCONFIG], [ # # Ok, lets find the tcl configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true AC_ARG_WITH(tcl, AS_HELP_STRING([--with-tcl], [directory containing tcl configuration (tclConfig.sh)]), [with_tclconfig="${withval}"]) AC_MSG_CHECKING([for Tcl configuration]) AC_CACHE_VAL(ac_cv_c_tclconfig,[ # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then case "${with_tclconfig}" in */tclConfig.sh ) if test -f "${with_tclconfig}"; then AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself]) with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" fi ;; esac if test -f "${with_tclconfig}/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" else AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) fi fi # then check for a private Tcl installation if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ../tcl \ `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ ../../tcl \ `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ ../../../tcl \ `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/win/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/win; pwd)`" break fi done fi # check in a few common install locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ `ls -d /c/Tcl/lib 2>/dev/null` \ `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ `ls -d C:/Tcl/lib 2>/dev/null` \ `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" break fi done fi # check in a few other private locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ${srcdir}/../tcl \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/win/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/win; pwd)`" break fi done fi ]) if test x"${ac_cv_c_tclconfig}" = x ; then TCL_BIN_DIR="# no Tcl configs found" AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) else no_tcl= TCL_BIN_DIR="${ac_cv_c_tclconfig}" AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) fi fi ]) #------------------------------------------------------------------------ # SC_PATH_TKCONFIG -- # # Locate the tkConfig.sh file # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --with-tk=... # # Defines the following vars: # TK_BIN_DIR Full path to the directory containing # the tkConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Ok, lets find the tk configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then # we reset no_tk in case something fails here no_tk=true AC_ARG_WITH(tk, AS_HELP_STRING([--with-tk], [directory containing tk configuration (tkConfig.sh)]), [with_tkconfig="${withval}"]) AC_MSG_CHECKING([for Tk configuration]) AC_CACHE_VAL(ac_cv_c_tkconfig,[ # First check to see if --with-tkconfig was specified. if test x"${with_tkconfig}" != x ; then case "${with_tkconfig}" in */tkConfig.sh ) if test -f "${with_tkconfig}"; then AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself]) with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`" fi ;; esac if test -f "${with_tkconfig}/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`" else AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) fi fi # then check for a private Tk library if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ../tk \ `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ ../../tk \ `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ ../../../tk \ `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/win/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/win; pwd)`" break fi done fi # check in a few common install locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ `ls -d /c/Tcl/lib 2>/dev/null` \ `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ `ls -d C:/Tcl/lib 2>/dev/null` \ `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ ; do if test -f "$i/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i; pwd)`" break fi done fi # check in a few other private locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ${srcdir}/../tk \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/win/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/win; pwd)`" break fi done fi ]) if test x"${ac_cv_c_tkconfig}" = x ; then TK_BIN_DIR="# no Tk configs found" AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) else no_tk= TK_BIN_DIR="${ac_cv_c_tkconfig}" AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) fi fi ]) #------------------------------------------------------------------------ # SC_LOAD_TCLCONFIG -- # # Load the tclConfig.sh file. # # Arguments: # # Requires the following vars to be set: # TCL_BIN_DIR # # Results: # # Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE # #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # # If the TCL_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TCL_LIB_SPEC will be set to the value # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. # if test -f $TCL_BIN_DIR/Makefile ; then TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC} TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC} TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH} fi # # eval is required to do the TCL_DBGX substitution # eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" AC_SUBST(TCL_VERSION) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) AC_SUBST(TCL_DEFS) ]) #------------------------------------------------------------------------ # SC_LOAD_TKCONFIG -- # # Load the tkConfig.sh file # # Arguments: # # Requires the following vars to be set: # TK_BIN_DIR # # Results: # # Sets the following vars that should be in tkConfig.sh: # TK_BIN_DIR #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TKCONFIG], [ AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TK_BIN_DIR}/tkConfig.sh" else AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi AC_SUBST(TK_BIN_DIR) AC_SUBST(TK_SRC_DIR) AC_SUBST(TK_LIB_FILE) ]) #------------------------------------------------------------------------ # SC_ENABLE_SHARED -- # # Allows the building of shared libraries # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-shared=yes|no # # Defines the following vars: # STATIC_BUILD Used for building import/export libraries # on Windows. # # Sets the following vars: # SHARED_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, [ --enable-shared build and link with shared libraries (default: on)], [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes" ; then AC_MSG_RESULT([shared]) SHARED_BUILD=1 else AC_MSG_RESULT([static]) SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi ]) #------------------------------------------------------------------------ # SC_ENABLE_THREADS -- # # Specify if thread support should be enabled # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-threads=yes|no # # Defines the following vars: # TCL_THREADS #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_THREADS], [ AC_MSG_CHECKING(for building with threads) AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)], [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes"; then AC_MSG_RESULT([yes (default)]) TCL_THREADS=1 AC_DEFINE(TCL_THREADS) # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention AC_DEFINE(USE_THREAD_ALLOC) else TCL_THREADS=0 AC_MSG_RESULT(no) fi AC_SUBST(TCL_THREADS) ]) #------------------------------------------------------------------------ # SC_ENABLE_SYMBOLS -- # # Specify if debugging symbols should be used. # Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging # can also be enabled. # # Arguments: # none # # Requires the following vars to be set in the Makefile: # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # # Results: # # Adds the following arguments to configure: # --enable-symbols # # Defines the following vars: # CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true # Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false # DBGX Debug library extension # #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols (default: off)], [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?]) AC_MSG_RESULT([no]) AC_DEFINE(TCL_CFG_OPTIMIZED) else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' DBGX=g if test "$tcl_ok" = "yes"; then AC_MSG_RESULT([yes (standard debugging)]) fi fi AC_SUBST(CFLAGS_DEFAULT) AC_SUBST(LDFLAGS_DEFAULT) if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?]) fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then AC_DEFINE(TCL_COMPILE_DEBUG, 1, [Is bytecode debugging enabled?]) AC_DEFINE(TCL_COMPILE_STATS, 1, [Are bytecode statistics enabled?]) fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then AC_MSG_RESULT([enabled symbols mem compile debugging]) else AC_MSG_RESULT([enabled $tcl_ok debugging]) fi fi ]) #-------------------------------------------------------------------- # SC_CONFIG_CFLAGS # # Try to determine the proper flags to pass to the compiler # for building shared libraries and other such nonsense. # # NOTE: The backslashes in quotes below are substituted twice # due to the fact that they are in a macro and then inlined # in the final configure script. # # Arguments: # none # # Results: # # Can the following vars: # EXTRA_CFLAGS # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # CFLAGS_WARNING # CFLAGS_NOLTO # LDFLAGS_DEBUG # LDFLAGS_OPTIMIZE # LDFLAGS_CONSOLE # LDFLAGS_WINDOW # CC_OBJNAME # CC_EXENAME # CYGPATH # STLIB_LD # SHLIB_LD # SHLIB_LD_LIBS # LIBS # AR # RC # RES # # MAKE_LIB # MAKE_STUB_LIB # MAKE_EXE # MAKE_DLL # # LIBSUFFIX # LIBFLAGSUFFIX # LIBPREFIX # LIBRARIES # EXESUFFIX # DLLSUFFIX # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_CFLAGS], [ # Step 0: Enable 64 bit support? AC_MSG_CHECKING([if 64bit support is requested]) AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no]) AC_MSG_RESULT($do64bit) # Cross-compiling options for Windows/CE builds AC_MSG_CHECKING([if Windows/CE build is requested]) AC_ARG_ENABLE(wince,[ --enable-wince enable Win/CE support (where applicable)], [doWince=$enableval], [doWince=no]) AC_MSG_RESULT($doWince) AC_MSG_CHECKING([for Windows/CE celib directory]) AC_ARG_WITH(celib,[ --with-celib=DIR use Windows/CE support library from DIR], CELIB_DIR=$withval, CELIB_DIR=NO_CELIB) AC_MSG_RESULT([$CELIB_DIR]) # Set some defaults (may get changed below) EXTRA_CFLAGS="" AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden]) AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo) SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, # which requires x86|amd64|arm64|ia64. MACHINE="X86" if test "$GCC" = "yes"; then AC_CACHE_CHECK(for cross-compile version of gcc, ac_cv_cross, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifndef _WIN32 #error cross-compiler #endif ]], [[]])], [ac_cv_cross=no], [ac_cv_cross=yes]) ) if test "$ac_cv_cross" = "yes"; then case "$do64bit" in amd64|x64|yes) CC="x86_64-w64-mingw32-${CC}" LD="x86_64-w64-mingw32-ld" AR="x86_64-w64-mingw32-ar" RANLIB="x86_64-w64-mingw32-ranlib" RC="x86_64-w64-mingw32-windres" ;; arm64|aarch64) CC="aarch64-w64-mingw32-${CC}" LD="aarch64-w64-mingw32-ld" AR="aarch64-w64-mingw32-ar" RANLIB="aarch64-w64-mingw32-ranlib" RC="aarch64-w64-mingw32-windres" ;; *) CC="i686-w64-mingw32-${CC}" LD="i686-w64-mingw32-ld" AR="i686-w64-mingw32-ar" RANLIB="i686-w64-mingw32-ranlib" RC="i686-w64-mingw32-windres" ;; esac fi fi # Check for a bug in gcc's windres that causes the # compile to fail when a Windows native path is # passed into windres. The mingw toolchain requires # Windows native paths while Cygwin should work # with both. Avoid the bug by passing a POSIX # path when using the Cygwin toolchain. if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then conftest=/tmp/conftest.rc echo "STRINGTABLE BEGIN" > $conftest echo "101 \"name\"" >> $conftest echo "END" >> $conftest AC_MSG_CHECKING([for Windows native path bug in windres]) cyg_conftest=`$CYGPATH $conftest` if AC_TRY_COMMAND($RC -o conftest.res.o $cyg_conftest) ; then AC_MSG_RESULT([no]) else AC_MSG_RESULT([yes]) CYGPATH=echo fi conftest= cyg_conftest= fi if test "$CYGPATH" = "echo"; then DEPARG='"$<"' else DEPARG='"$(shell $(CYGPATH) $<)"' fi # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then extra_cflags="-pipe" extra_ldflags="-pipe -static-libgcc" AC_CACHE_CHECK(for mingw32 version of gcc, ac_cv_win32, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef _WIN32 #error win32 #endif ]], [[]])], [ac_cv_win32=no], [ac_cv_win32=yes]) ) if test "$ac_cv_win32" != "yes"; then AC_MSG_ERROR([${CC} cannot produce win32 executables.]) fi if test "$do64bit" != "arm64"; then extra_cflags="$extra_cflags -DHAVE_CPUID=1" fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" AC_CACHE_CHECK(for working -municode linker flag, ac_cv_municode, AC_LINK_IFELSE([AC_LANG_PROGRAM([[ #include int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} ]], [[]])], [ac_cv_municode=yes], [ac_cv_municode=no]) ) CFLAGS=$hold_cflags if test "$ac_cv_municode" = "yes" ; then extra_ldflags="$extra_ldflags -municode" else extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" AC_CACHE_CHECK(for working -fno-lto, ac_cv_nolto, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])], [ac_cv_nolto=yes], [ac_cv_nolto=no]) ) CFLAGS=$hold_cflags if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base" AC_CACHE_CHECK(for working --enable-auto-image-base, ac_cv_enable_auto_image_base, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])], [ac_cv_enable_auto_image_base=yes], [ac_cv_enable_auto_image_base=no]) ) CFLAGS=$hold_cflags if test "$ac_cv_enable_auto_image_base" == "yes" ; then extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base" fi AC_MSG_CHECKING([compiler flags]) if test "${GCC}" = "yes" ; then SHLIB_LD="" SHLIB_LD_LIBS='${LIBS}' LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= RC_INCLUDE=--include RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \[$]@" MAKE_STUB_LIB="\${STLIB_LD} \[$]@" POST_MAKE_LIB="\${RANLIB} \[$]@" MAKE_EXE="\${CC} -o \[$]@" LIBPREFIX="lib" if test "${SHARED_BUILD}" = "0" ; then # static AC_MSG_RESULT([using static flags]) runtime= LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else # dynamic AC_MSG_RESULT([using shared flags]) # ad-hoc check to see if CC supports -shared. if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then AC_MSG_ERROR([${CC} does not support the -shared option. You will need to upgrade to a newer version of the toolchain.]) fi runtime= # Add SHLIB_LD_LIBS to the Make rule, not here. EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi # Link with gcc since ld does not link to default libs like # -luser32 and -lmsvcrt by default. SHLIB_LD='${CC} -shared' SHLIB_LD_LIBS='${LIBS}' MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ -Wl,--out-implib,\$(patsubst %.dll,lib%.dll.a,\[$]@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" LIBSUFFIX="\${DBGX}.a" LIBFLAGSUFFIX="\${DBGX}" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" CFLAGS_WARNING="-Wall -Wpointer-arith" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= case "${CC}" in *++) CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" ;; *) CFLAGS_WARNING="${CFLAGS_WARNING} -Wdeclaration-after-statement" ;; esac # Specify the CC output file names based on the target name CC_OBJNAME="-o \[$]@" CC_EXENAME="-o \[$]@" # Specify linker flags depending on the type of app being # built -- Console vs. Window. # # ORIGINAL COMMENT: # We need to pass -e _WinMain@16 so that ld will use # WinMain() instead of main() as the entry point. We can't # use autoconf to check for this case since it would need # to run an executable and that does not work when # cross compiling. Remove this -e workaround once we # require a gcc that does not have this bug. # # MK NOTE: Tk should use a different mechanism. This causes # interesting problems, such as wish dying at startup. #LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}" LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}" LDFLAGS_WINDOW="-mwindows ${extra_ldflags}" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) ;; arm64|aarch64) MACHINE="ARM64" AC_MSG_RESULT([ Using ARM64 $MACHINE mode]) ;; ia64) MACHINE="IA64" AC_MSG_RESULT([ Using IA64 $MACHINE mode]) ;; *) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifndef _WIN64 #error 32-bit #endif ]], [[]])], [tcl_win_64bit=yes], [tcl_win_64bit=no] ) if test "$tcl_win_64bit" = "yes" ; then do64bit=amd64 MACHINE="AMD64" AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi ;; esac else if test "${SHARED_BUILD}" = "0" ; then # static AC_MSG_RESULT([using static flags]) runtime=-MT LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else # dynamic AC_MSG_RESULT([using shared flags]) runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. LIBRARIES="\${SHARED_LIBRARIES}" EXESUFFIX="\${DBGX}.exe" case "x`echo \${VisualStudioVersion}`" in x1[[4-9]]*) lflags="${lflags} -nodefaultlib:libucrt.lib" ;; *) ;; esac fi MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" LIBSUFFIX="\${DBGX}.lib" LIBFLAGSUFFIX="\${DBGX}" if test "$do64bit" != "no" ; then case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build ;; arm64|aarch64) MACHINE="ARM64" ;; ia64) MACHINE="IA64" ;; esac AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib" case "x`echo \${VisualStudioVersion}`" in x1[[4-9]]*) LIBS="$LIBS ucrt.lib" ;; *) ;; esac if test "$do64bit" != "no" ; then RC="rc" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="${lflags} -nologo -MACHINE:${MACHINE}" LINKBIN="link" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 LIBS="$LIBS bufferoverflowU.lib" else RC="rc" # -Od - no optimization # -WX - warnings as errors CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="${lflags} -nologo" LINKBIN="link" fi if test "$doWince" != "no" ; then # Set defaults for common evc4/PPC2003 setup # Currently Tcl requires 300+, possibly 420+ for sockets CEVERSION=420; # could be 211 300 301 400 420 ... TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... ARCH=ARM; # could be ARM MIPS X86EM ... PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" if test "$doWince" != "yes"; then # If !yes then the user specified something # Reset ARCH to allow user to skip specifying it ARCH= eval `echo $doWince | awk -F "," '{ \ if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \ if ([$]1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \ if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \ if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \ }'` if test "x${ARCH}" = "x" ; then ARCH=$TARGETCPU; fi fi OSVERSION=WCE$CEVERSION; if test "x${WCEROOT}" = "x" ; then WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" if test ! -d "${WCEROOT}" ; then WCEROOT="C:/Program Files/Microsoft eMbedded Tools" fi fi if test "x${SDKROOT}" = "x" ; then SDKROOT="C:/Program Files/Windows CE Tools" if test ! -d "${SDKROOT}" ; then SDKROOT="C:/Windows CE Tools" fi fi # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` if test ! -d "${CELIB_DIR}/inc"; then AC_MSG_ERROR([Invalid celib directory "${CELIB_DIR}"]) fi if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\ -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]]) else CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" if test -d "${CEINCLUDE}/${TARGETCPU}" ; then CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" fi CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" fi fi if test "$doWince" != "no" ; then CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" if test "${TARGETCPU}" = "X86"; then CC="${CEBINROOT}/cl.exe" else CC="${CEBINROOT}/cl${ARCH}.exe" fi CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" arch=`echo ${ARCH} | awk '{print tolower([$]0)}'` defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS" for i in $defs ; do AC_DEFINE_UNQUOTED($i) done # if test "${ARCH}" = "X86EM"; then # AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION) # fi AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION) AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION) CFLAGS_DEBUG="-nologo -Zi -Od" CFLAGS_OPTIMIZE="-nologo -O2" lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" LINKBIN="\"${CEBINROOT}/link.exe\"" AC_SUBST(CELIB_DIR) if test "${CEVERSION}" -lt 400 ; then LIBS="coredll.lib corelibc.lib winsock.lib" else LIBS="coredll.lib corelibc.lib ws2.lib" fi # celib currently stuck at wce300 status #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib" LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\"" LIBS_GUI="commctrl.lib commdlg.lib" else LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" fi SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" SHLIB_LD_LIBS='${LIBS}' # link -lib only works when -lib is the first arg STLIB_LD="${LINKBIN} -lib ${lflags}" RC_OUT=-fo RC_TYPE=-r RC_INCLUDE=-i RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\[$]@" MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\[$]@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\[$]@" LIBPREFIX="" CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" EXTRA_CFLAGS="" CFLAGS_WARNING="-W3" LDFLAGS_DEBUG="-debug" LDFLAGS_OPTIMIZE="-release" # Specify the CC output file names based on the target name CC_OBJNAME="-Fo\[$]@" CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\"" # Specify linker flags depending on the type of app being # built -- Console vs. Window. if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then LDFLAGS_CONSOLE="-link ${lflags}" LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} else LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}" LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}" fi fi if test "$do64bit" != "no" ; then AC_DEFINE(TCL_CFG_DO64BIT) fi if test "${GCC}" = "yes" ; then AC_CACHE_CHECK(for SEH support in compiler, tcl_cv_seh, AC_RUN_IFELSE([AC_LANG_SOURCE([[ #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN int main(int argc, char** argv) { int a, b = 0; __try { a = 666 / b; } __except (EXCEPTION_EXECUTE_HANDLER) { return 0; } return 1; } ]])], [tcl_cv_seh=yes], [tcl_cv_seh=no], [tcl_cv_seh=no]) ) if test "$tcl_cv_seh" = "no" ; then AC_DEFINE(HAVE_NO_SEH, 1, [Defined when mingw does not support SEH]) fi # # Check to see if the excpt.h include file provided contains the # definition for EXCEPTION_DISPOSITION; if not, which is the case # with Cygwin's version as of 2002-04-10, define it to be int, # sufficient for getting the current code to work. # AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files, tcl_cv_eh_disposition, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ # define WIN32_LEAN_AND_MEAN # include # undef WIN32_LEAN_AND_MEAN ]], [[ EXCEPTION_DISPOSITION x; ]])], [tcl_cv_eh_disposition=yes], [tcl_cv_eh_disposition=no]) ) if test "$tcl_cv_eh_disposition" = "no" ; then AC_DEFINE(EXCEPTION_DISPOSITION, int, [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION]) fi # Check to see if winnt.h defines CHAR, SHORT, and LONG # even if VOID has already been #defined. The win32api # used by mingw and cygwin is known to do this. AC_CACHE_CHECK(for winnt.h that ignores VOID define, tcl_cv_winnt_ignore_void, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #define VOID void #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN ]], [[ CHAR c; SHORT s; LONG l; ]])], [tcl_cv_winnt_ignore_void=yes], [tcl_cv_winnt_ignore_void=no]) ) if test "$tcl_cv_winnt_ignore_void" = "yes" ; then AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, [Defined when cygwin/mingw ignores VOID define in winnt.h]) fi # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. AC_CACHE_CHECK(for cast to union support, tcl_cv_cast_to_union, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[ union foo { int i; double d; }; union foo f = (union foo) (int) 0; ]])], [tcl_cv_cast_to_union=yes], [tcl_cv_cast_to_union=no]) ) if test "$tcl_cv_cast_to_union" = "yes"; then AC_DEFINE(HAVE_CAST_TO_UNION, 1, [Defined when compiler supports casting to union type.]) fi fi # DL_LIBS is empty, but then we match the Unix version AC_SUBST(DL_LIBS) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) AC_SUBST(CFLAGS_NOLTO) ]) #------------------------------------------------------------------------ # SC_WITH_TCL -- # # Location of the Tcl build directory. # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --with-tcl=... # # Defines the following vars: # TCL_BIN_DIR Full path to the tcl build dir. #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ if test -d ../../tcl8.6$1/win; then TCL_BIN_DEFAULT=../../tcl8.6$1/win else TCL_BIN_DEFAULT=../../tcl8.6/win fi AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) fi if test ! -f $TCL_BIN_DIR/Makefile; then AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?) else echo "building against Tcl binaries in: $TCL_BIN_DIR" fi AC_SUBST(TCL_BIN_DIR) ]) #------------------------------------------------------------------------ # SC_PROG_TCLSH # Locate a tclsh shell installed on the system path. This macro # will only find a Tcl shell that already exists on the system. # It will not find a Tcl shell in the Tcl build directory or # a Tcl shell that has been installed from the Tcl build directory. # If a Tcl shell can't be located on the PATH, then TCLSH_PROG will # be set to "". Extensions should take care not to create Makefile # rules that are run by default and depend on TCLSH_PROG. An # extension can't assume that an executable Tcl shell exists at # build time. # # Arguments # none # # Results # Substitutes the following values: # TCLSH_PROG #------------------------------------------------------------------------ AC_DEFUN([SC_PROG_TCLSH], [ AC_MSG_CHECKING([for tclsh]) AC_CACHE_VAL(ac_cv_path_tclsh, [ search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[[8-9]]*.exe 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done ]) if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" AC_MSG_RESULT($TCLSH_PROG) else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" AC_MSG_RESULT([No tclsh found on PATH]) fi AC_SUBST(TCLSH_PROG) ]) #------------------------------------------------------------------------ # SC_BUILD_TCLSH # Determine the fully qualified path name of the tclsh executable # in the Tcl build directory. This macro will correctly determine # the name of the tclsh executable even if tclsh has not yet # been built in the build directory. The build tclsh must be used # when running tests from an extension build directory. It is not # correct to use the TCLSH_PROG in cases like this. # # Arguments # none # # Results # Substitutes the following values: # BUILD_TCLSH #------------------------------------------------------------------------ AC_DEFUN([SC_BUILD_TCLSH], [ AC_MSG_CHECKING([for tclsh in Tcl build directory]) BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}\${EXESUFFIX} AC_MSG_RESULT($BUILD_TCLSH) AC_SUBST(BUILD_TCLSH) ]) #-------------------------------------------------------------------- # SC_TCL_CFG_ENCODING TIP #59 # # Declare the encoding to use for embedded configuration information. # # Arguments: # None. # # Results: # Might append to the following vars: # DEFS (implicit) # # Will define the following vars: # TCL_CFGVAL_ENCODING # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CFG_ENCODING], [ AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval}) if test x"${with_tcencoding}" != x ; then AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}") else # Default encoding on windows is not "iso8859-1" AC_DEFINE(TCL_CFGVAL_ENCODING,"cp1252") fi ]) #-------------------------------------------------------------------- # SC_EMBED_MANIFEST # # Figure out if we can embed the manifest where necessary # # Arguments: # An optional manifest to merge into DLL/EXE. # # Results: # Will define the following vars: # VC_MANIFEST_EMBED_DLL # VC_MANIFEST_EMBED_EXE # #-------------------------------------------------------------------- AC_DEFUN([SC_EMBED_MANIFEST], [ AC_MSG_CHECKING(whether to embed manifest) AC_ARG_ENABLE(embedded-manifest, AS_HELP_STRING([--enable-embedded-manifest], [embed manifest if possible (default: yes)]), [embed_ok=$enableval], [embed_ok=yes]) VC_MANIFEST_EMBED_DLL= VC_MANIFEST_EMBED_EXE= result=no if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \ -a "$GCC" != "yes" ; then # Add the magic to embed the manifest into the dll/exe AC_EGREP_CPP([manifest needed], [ #if defined(_MSC_VER) && _MSC_VER >= 1400 print("manifest needed") #endif ], [ # Could do a CHECK_PROG for mt, but should always be with MSVC8+ # Could add 'if test -f' check, but manifest should be created # in this compiler case # Add in a manifest argument that may be specified # XXX Needs improvement so that the test for existence accounts # XXX for a provided (known) manifest VC_MANIFEST_EMBED_DLL="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;2 ; fi" VC_MANIFEST_EMBED_EXE="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;1 ; fi" result=yes if test "x$1" != x ; then result="yes ($1)" fi ]) fi AC_MSG_RESULT([$result]) AC_SUBST(VC_MANIFEST_EMBED_DLL) AC_SUBST(VC_MANIFEST_EMBED_EXE) ]) tcl8.6.14/win/aclocal.m40000644000175000017500000000003014554262142014270 0ustar sergeisergeibuiltin(include,tcl.m4) tcl8.6.14/win/tclsh.exe.manifest.in0000644000175000017500000000322114554262142016467 0ustar sergeisergei Tcl command line shell (tclsh) true tcl8.6.14/win/tclUuid.h.in0000644000175000017500000000003314554262142014622 0ustar sergeisergei#define TCL_VERSION_UUID \ tcl8.6.14/win/gitmanifest.in0000644000175000017500000000000414554262142015273 0ustar sergeisergeigit-tcl8.6.14/win/svnmanifest.in0000644000175000017500000000000514554262142015317 0ustar sergeisergeisvn-rtcl8.6.14/win/x86_64-w64-mingw32-nmakehlp.exe0000755000175000017500000006200014554262142017600 0ustar sergeisergeiMZџџИ@€КД Э!ИLЭ!This program cannot be run in DOS mode. $PEd† №/  .` @акЈ  є ` рU(№Ђ .textX,.`P`.dataа@ 2@`Р.rdata@P<@`@.pdata `L@0@.xdata pP@0@.bss €€`Р.idataє   T@0Р.CRThА`@@Р.tlsРb@@РУff.„@Hƒь(H‹5J1ЩЧH‹6JЧH‹9JЧH‹ќIЧH‹пHf8MZuHcPHpH‰ёшbI‰№H‰пI‹TнH‰СшFH‰иHƒУH9ХuЪJD'јHЧH‰=Пlш:H‹гEL‹Єl‹ ЎlH‹L‰H‹™lш”‹ zl‰xl…Щ„Т‹bl…вtHФ˜[^_]A\A]УЗD$`щ"џџџH‹5ХEН‹ƒј…ўџџЙш+‹ƒј…$ўџџH‹ЙEH‹ ЂEш§Ч…э… ўџџ1РH‡щўџџL‰СџTщ{§џџшк‹мkHФ˜[^_]A\A]УH‹…EH‹ nEЧшЃщЇ§џџ‰СшgfDHƒь(H‹ЕEЧшZшхќџџHƒФ(Уff.„Hƒь(H‹…EЧш*шЕќџџHƒФ(Уff.„Hƒь(шH…Р”РЖРїиHƒФ(УH щдџџџ@УATUWVSHƒь@H‹-ŽHyH‰ЮLd$ИHƒФ([^УHK—H5D—H9оtсH‹H…РtџаHƒУH9оuэИHƒФ([^Уш; ИHƒФ([^Уff.„@1РУHƒьXH‹%uH…Рt,ђ„$€‰L$ HL$ H‰T$(ђT$0ђ\$8ђD$@џаHƒФXУff.„@H‰ йtщL@VSHƒьx)t$@)|$PD)D$`ƒ9‡Ќ‹HL=Hc‚HаџрHю<ђDA ђyђqH‹qЙшђDD$0I‰иHс<ђ|$(H‰СI‰ёђt$ шb(t$@(|$P1РD(D$`HƒФx[^УHС;ы—Hј;ыŽHЯ;ы…H6<щyџџџH<щmџџџH~;щaџџџлуУH‰ШУff.„H‰ШУATSHƒь8I‰ЬHD$XЙH‰T$XL‰D$`L‰L$hH‰D$(ш3AИКH A<I‰СшyH‹\$(Йш L‰тH‰СI‰ишќш—fDATUWVSHƒьPHc=csI‰ЬH‰жL‰У…џŽsH‹Os1ЩHƒРH‹I9дrL‹@E‹@LТI9д‚‹ƒСHƒР(9љuйL‰сшВ H‰ХH…Р„ZH‹sH<ПHСчHјH‰h ЧшЅ ‹M HT$ AИ0HСH‹еrH‰L8џˆH…Р„‹D$DPРƒтПt ƒшƒрћ…‚ƒžrƒћs(іУ…И…лtЖAˆ$іУ…КHƒФP[^_]A\УH‹IL$HƒсјI‰$‰иH‹TјI‰TјI)ЬDуL)цƒујƒћrШƒуј1Р‰ТƒРL‹L‰9иrяHƒФP[^_]A\УH‹L$ H‹T$8AИ@H=rH‰OI‰љH‰WџG‡…Р…Nџџџџ™†H њ:‰Тшћ§џџ1џщКўџџ‹‰лA‰$‹DќA‰DќщFџџџ‰лЗDўfA‰Dўщ4џџџL‰тH b:шН§џџH‹žq‹UH l:L‹D8шЂ§џџUAWAVAUATWVSHƒь8HЌ$€‹5bq…іtHeИ[^_A\A]A^A_]УЧCqш^ H˜H€HХHƒр№шW L‹%`;H‹i;ЧqH)ФHD$ H‰qL‰рH)иHƒј~–‹Hƒј 3…в…Ѕ‹C…Р…š‹Sƒњ…ђHƒУ L}ЈL‹-*;IОџџџџL9уr>щHџџџDЖL‰џM‰ТIЪџџџE„РMHТI)аL‰њMШL‰EЈAИш§џџHƒУ L9уsm‹‹KDЖCLъLщL‹ Aƒј „ц‡ГAƒјtžAƒј…LDЗL‰џM‰ТIЪџџfE…РMHТHƒУ I)аL‰њMШL‰EЈAИш•ќџџL9уr“‹ўo…РŽ”ўџџL‹%;…1лH‹ъoHиD‹E…РtH‹PH‹HI‰љAџдƒЦHƒУ(;5Рo|бщWўџџ…вuv‹C‰Ч {…Цўџџ‹S HƒУ щЏўџџAƒј@…ŸH‹AИL‰џH)аL‰њLШH‰EЈшџћџџщєўџџ‹L‰џI‰РL №E…РIIРAИH)аL‰њLШH‰EЈшаћџџщХўџџL9уƒд§џџIƒьL‹-—9H}ЈI)мIСьNdу‹K‹AИH‰њHƒУLщ‰EЈшˆћџџL9уuмщюўџџD‰ТH \8HЧEЈшїњџџH 8шыњџџHƒь(‹=–Р‡=‹РvOsџџ?ƒј w:HG8Hc‚Hаџр1вЙш2 Hƒј…˜КЙш шTњџџE1РD‰РHƒФ(У=Р„ŒvFE1Р=Рtс=Р…›1вЙшл Hƒј„›H…Р„‡ЙџаE1РD‰РHƒФ(УE1Р=€A•РD‰РHƒФ(У1вЙш– HƒјtqAИH…Р„pџџџЙџаE1Рщaџџџ1вЙ шf HƒјtXH…РtЙ џаE1Рщ;џџџAИщ0џџџAИщ%џџџКЙш' E1РщџџџКЙш E1РщїўџџКЙ шљE1РщрўџџATUWVSHƒь шёH‰Ц‹Pm…Рu%H…іt H №6Ч6mшH…РtИHƒФ [^_]A\УH-nЙ0E1фHmH‰пH-ўџџѓHЋЙ H‰зH)ѕѓHЋH‰зы-Ц IƒФHƒУ ‰o‹P ‰SєPH‰јHƒЧH)№‰Sј‰CќIƒќ tL‰сшйH…РuЦM…ф„wџџџD‰тыК I‰№H ЇmџYщXџџџff.„ATHƒь H‹‹I‰Ь‰Ссџџџ љCCG „Х=–Р‡Ђ=‹РvPsџџ?ƒј w:Hы5Hc‚Hаџр1вЙшІHƒј…ЊКЙшшШїџџИџџџџHƒФ A\У=Р„•v7=Рtр=Рu01вЙшUHƒј„—H…РtЙџаИџџџџыЕ=€tЉH‹škH…РtL‰сHƒФ A\HџріB…1џџџы…1РHƒФ A\У1вЙшјHƒјtUH…РtМЙџаИџџџџщYџџџ1вЙ шаHƒјtFH…Рt”Й џаИџџџџщ1џџџКЙшЅƒШџщџџџКЙшŽИџџџџщџџџКЙ шuƒШџщъўџџATWVSHƒь(H €mџњ~H‹SmH…лt2H‹=ЧH‹50‹ џзI‰Фџж…РuM…фt H‹CL‰сџаH‹[H…лuмH 5mHƒФ([^_A\Hџ%%DWVSHƒь ‹ћl‰ЯH‰ж…РuHƒФ [^_УКЙш+H‰УH…Рt<‰8H тlH‰pџX~H‹БlH ЪlH‰ЃlH‰CџЙ~1РHƒФ [^_УƒШџы f.„SHƒь ‹}l‰Ы…Рu1РHƒФ [УH €lџњ}H‹ SlH…Щt'1вы H‰ЪH…РtH‰С‹9иH‹AuыH…вtH‰BшOH @lџ:~1РHƒФ [УH‰ lынf„SHƒь ƒњ„Јw#…вtD‹юk…Рt+ЧрkИHƒФ [Уƒњu№‹Ъk…РtцшIўџџыпH аkџТ}ыЦ‹Њk…Рtш)ўџџ‹›kƒјuЖH‹‡kH…лtH‰йH‹[шžH…лuяH ŠkHЧ_kЧ]kџп|щrџџџшuєџџИHƒФ [УHcAVL%7V„Щuщf AЖL$IƒФ„Щ„T џг…РuшL‰хыHƒХЖM„Щ„P џг…РtъI‰яы џж…РtIƒЧAЖ„ЩuюH‰шL‰§I‰яH‰ХL‰јЙ$ыHƒРЖ€њ wєHЃбsюЦEЙЦш{ћџџH‰ЧH…Р„=џџџL‰сшЧћџџL‰љH‰GшЛћџџHЧH‰GH‹„$аH…Р„A H‰ТH‹H…РuѕH‰:щњўџџƒў„ џеsH|$pЙHЌ$АI‰Ф1РLЌ$E1ЩH‰|$PLt$hM‰шƒюѓЋЙH‰яL‰ђѓЋL‰яЙL‹=5sѓЋЧ„$АhH IЧ„$ьHЧ„$џџџџЧ„$Ч„$ AџзH‹= sM‰рL‰сH‹T$hLŒ$ЧD$0ЧD$(ЧD$ џзL‰ђLД$РM‰шE1ЩH ЭL-I!AџзM‰рL‰сH‹T$hLŒ$ЧD$0L=!!ЧD$(ЧD$ џзHі L‰ё1џџsL‹%ŽsL‰њL‰ёAџдH‹TћHƒЧL‰ёAџдL‰ъL‰ёAџд9ўлH‹D$PE1ЩE1Р1ЩH‰l$@L‰ђH‰D$HHЧD$8HЧD$0ЧD$(ЧD$ џяq…Р„: H|$dH‹ЫqH‹Œ$E1фџгH‹Œ$џгКˆH‹L$pџ4tH‹L$xџгH‹5Ўq1в1ЩL ЛLЄуџџH‰|$(ЧD$ џжL ž1в1ЩLƒуџџH‰„$аH‰|$(ЧD$ џжƒЪџH‹L$pH‰„$иџnrH‹L$pџгH”$аAЙєAИЙџ@rH‹Œ$аџгH‹Œ$иџгHЊH &шAјџџH…Р…ПћџџHŽH ш%јџџH…Р…ЃћџџHzH юш јџџH…Р…‡ћџџH^H в шэїџџH…Р…kћџџHJH ЖшбїџџH…Р…OћџџH.H š E1фшВїџџH…РA”Фщ-ћџџƒў„ƒў„жH‹SH‹KE1фш„їџџH…РA•Фщџњџџƒў„}L‹ LЄ$аL%щŸњџџƒў… H‹KОrH˜H‹{H-Mш їџџI‰ФH…Рuы4H‰њH‰йшїџџH‰ТH…Р…fM‰рКdH‰йшwїџџH…РuдL‰сшrїџџAМщnњџџLЄ$аƒў„ЯL‹ LФщњџџƒў…мL‹{1іHщ!H‹№H…в„\M…џA”Ф„OIƒЭџH‰зD‰рL‰щђЎHїбHYџHƒСHљ‡(HЌ$АI‰иL‰џH‰щшbіџџHDL‰щLЌ$аfЧ\*L‰ъЦ@D‰рђЎHїбyџH‰щ‰|$PџoI‰ФHƒјџ„АLcїIƒЦі„$а„~H”$ќ1РHƒЩџH‰зђЎHїбLAџJ<I>H=‡PHLшдѕџџ‹D$PLOL‰њHL=Ц„<Б\D@L‰L$XMcРшЋѕџџH‰щџВnƒјџ„ Ј…L‹L$XLЌ$РКH‰щM‰шBЦ„ АE1ЩџnL‰щш‡ѕџџL‰сE1фџ+nщЭјџџL‹ LЄ$аК+LЇL‰сшрџџЙєџџџ‰УџRnL‰тA‰иE1фHЧD$ H‰СLŒ$РџпnщyјџџL‹sLl$pHД$РџлmL‰яЙE1ЩI‰Ф1РHЌ$ѓЋЙH‰їL|$hѓЋЙH‰яI‰шѓЋL‰њH‹=KmH lЧ„$РhЧ„$ќHЧ„$џџџџЧ„$џзH‹.mM‰рL‰сH‹T$hLŒ$ЧD$0ЧD$(ЧD$ џгE1ЩI‰шL‰њH љ џзLŒ$ M‰рL‰сH‹T$hЧD$0ЧD$(ЧD$ џгHœ$АH#H‰йџвmH‹=УmL‰ђH‰йџзH1H‰йџзE1ЩE1Р1ЩL‰l$HH‰кH‰t$@HЧD$8HЧD$0ЧD$(ЧD$ џ:l…Р„#H|$dH‹lH‹Œ$E1фџгH‹Œ$ џгКˆH‹L$pџnH‹L$xџгH‹5љk1в1ЩL  LянџџH‰|$(ЧD$ џжL щ1в1ЩLЮнџџH‰„$аH‰|$(ЧD$ џжƒЪџH‹L$pH‰„$иџЙlH‹L$pџгH”$аAЙєAИЙџ‹lH‹Œ$аџгH‹Œ$иџгH<H q шŒђџџH…Р… іџџH H UшpђџџH…Р…юѕџџH H 9 шTђџџH…Р…вѕџџHюH ш8ђџџH…Р…ЖѕџџHиH  шђџџHХH…Р…“ѕџџщFњџџM‰рH‹KE1ЩКџkL‰сE1фшђџџщiѕџџL‹ LЄ$аL(щѕџџL‹ LЄ$аLqщћєџџL‹ LЄ$аLŠщфєџџL‹ LЄ$аLщЭєџџL‰ъL‰сџjj…Р…`ћџџL‰сџIjAМHƒЦHƒў…њџџщзєџџL‰хщХѕџџAМынI‹L$I‹$ш’ёџџI‹L$шˆёџџL‰сI‰мш}ёџџM…фuиL‰ёE1фшёџџщєџџL‰щш€ёџџH‹-!1іL‹Є$аH=CL‰уы+L‹{L‹kЙџеA‰№H‰њƒЦL‰|$ H‰СM‰щш#ёџџH‹H…лuаH$GM‰№КH KшёџџH…Р„rџџџM‰чL-§J1эM…фuщЃM‹?M…џ„—I‹WL‰щшa№џџI‰РH…РtрHЪFL9шtH‰зH5ЛJЄI9№uњL‰ТL)ъHкI‹GH…Рu ыˆ HƒТHƒРЖ„ЩuяI‹‰шHƒЩџђЎHїбILџЖ„РtHƒСˆHƒТЖ„РuяЦЙ€L‰яH‰оѓHЅщ]џџџHGJH 6шћяџџщџџџE1фщ=ѓџџH”$ащНєџџ1РHƒЩџђЎH‰ШHїаLlџы„РtIƒХAЖEPа€њ wыƒю0L‰ыH=TH-[L5Xы ƒюtBHƒУЖ„вt7DОњH‰љD‰њшcяџџH…Рt#D‰њH‰щшSяџџH…РuЬОSџL‰ёшBяџџH…РuЛыОЦL‰сшяџџA€}„јџџL‰щE1фш*яџџщ|ђџџџhLЄ$аM‰ё‰D$d‰D$ L‰сLJК+ш кџџК,D‹D$dE1ЩHЧD$0)ТH˜ЙџLр‰T$(1вH‰D$ џgL‰сџŒhЙєџџџ‰УџЗgL‰тLL$dA‰иHЧD$ H‰СAМџDhщоёџџџygLЄ$аI‰й‰D$d‰D$ щ]џџџH‰шщЫђџџщЫиџџџџџџџџџџ <@џџџџџџџџ џџџџџџџџџџџџџџџџP<@џџџџџџџџџџџџџ@+@`+@p+@€+@+@2Ђп-™+Э] вfдџџCLLINKusage: %s -c Tests for whether cl.exe supports an option exitcodes: 0 == no, 1 == yes, 2 == error cl.exe -nologo -c -TC -Zs -X -Fp.\_junk.pch .\nulTried to launch: "%s", but got error [%u]: D4002D9002D2021usage: %s -l ? ...? Tests for whether link.exe supports an option exitcodes: 0 == no, 1 == yes, 2 == error link.exe -nologo ""LNK1117LNK4044LNK4224usage: %s -f Find a substring within another exitcodes: 0 == no, 1 == yes, 2 == error usage: %s -s Perform a set of string map type substutitions on a file exitcodes: 0 rt% 3d '%s' => '%s' %susage: %s -V filename matchstring Extract a version from a file: eg: pkgIndex.tcl "package ifneeded http"0123456789.ab.ababusage: %s -Q path Emit the fully qualified path exitcodes: 0 == no, 1 == yes, 2 == error usage: %s -L keypath Emit the fully qualified path of directory containing keypath exitcodes: 0 == success, 1 == not found, 2 == error usage: %s -c|-f|-l|-Q|-s|-V ... This is a little helper app to equalize shell differences between WinNT and Win9x and get nmake.exe to accomplish its job. НоџџЙиџџЙиџџЙиџџЙиџџоџџЙиџџЙиџџЙиџџЙиџџ,оџџЙиџџЙиџџЙиџџЙиџџЙиџџЙиџџЙиџџЙиџџЙиџџЙиџџЙиџџЙиџџ оџџЙиџџЙиџџонџџЙиџџЙиџџЙиџџЙиџџЙиџџ кџџЙиџџЙиџџЙиџџЙиџџЙиџџЙиџџ@йџџ....\....\..\..dU@gU@mU@р@‰@р@Р@Р@œŽ@@А@Unknown errorArgument domain error (DOMAIN)Overflow range error (OVERFLOW)Partial loss of significance (PLOSS)Total loss of significance (TLOSS)The result is too small to be represented (UNDERFLOW)Argument singularity (SIGN)_matherr(): %s in %s(%g, %g) (retval=%g) WУџџ$УџџНТџџ6Уџџ?УџџKУџџ-УџџMingw-w64 runtime failure: Address %p has no image-section VirtualQuery failed for %d bytes at address %p VirtualProtect failed with code 0x%x Unknown pseudo relocation protocol version %d. Unknown pseudo relocation bit size %d. ТЧџџТЧџџТЧџџТЧџџТЧџџьЧџџТЧџџ^ШџџьЧџџШџџ.pdataЪџџЪџџЪџџЪџџЪџџHЪџџЪџџЬЪџџHЪџџoЪџџPH@`H@0<@@^@@^@РU@@hЄ@Є@ЈЄ@рŽ@’@’@А@А@А@0А@аˆ@аŽ@p"@а@€Ž@АŽ@рˆ@˜Ž@”Ž@Ž@GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0GCC: (GNU) 9.1.0pp i ppjpp’(p ТHpащhp№ќpptp˜xp Тˆpаіp5Аp@Иp ЗФpРЧШpагЬpрЎаpАЈрpАж№pрQјp`cqpБqРЬqаЇqАГ,qРФ0qад4qрJ8qP?Dq@іTq !lq€!d"tqp"$„q${$Œq€$і$œq%w%Јq€%F&АqP&n&Иqp&|&Мq€&Ф&Рqа&_'Фq`'к'аqр' (иq(y(рq€(Ј(шqА(1)№q@)ъ)јq0*5*r@+_+r`+h+ rp+{+r€+‹+r+›+r -<˜p <%<rBb0`pPРа B8+tŒp"Œ B8+ЄМp"МB  r0`pPРbB ƒ 0 ` p PРар№BB0`  R0`pPР  в0`PBB0`Ђ ˆx hт0`b0Р  ’0`pPР …b 0 ` p Рар№PB  20`pPР2Р  B0`pР20`p202020`РBBBBBB20P 8Ћ№ЂИЁиЋXЄрЂшЋ€ЅЅžЅЌЅОЅЮЅцЅјЅІІ.І>ІPІdІzІІІІКІЪІмІьІЇЇ2ЇJЇdЇpЇ†ЇšЇДЇШЇтЇђЇЈЈ,Ј:ЈVЈhЈxЈ’ЈЈЈДЈРЈЬЈиЈ№ЈЉ ЉЉ*Љ<ЉPЉZЉhЉrЉ|ЉˆЉ’ЉœЉЊЉВЉМЉФЉЮЉжЉоЉшЉ№ЉњЉЊЊЊ"Њ*Њ4Њ>ЊHЊRЊ\ЊfЊrЊЅžЅЌЅОЅЮЅцЅјЅІІ.І>ІPІdІzІІІІКІЪІмІьІЇЇ2ЇJЇdЇpЇ†ЇšЇДЇШЇтЇђЇЈЈ,Ј:ЈVЈhЈxЈ’ЈЈЈДЈРЈЬЈиЈ№ЈЉ ЉЉ*Љ<ЉPЉZЉhЉrЉ|ЉˆЉ’ЉœЉЊЉВЉМЉФЉЮЉжЉоЉшЉ№ЉњЉЊЊЊ"Њ*Њ4Њ>ЊHЊRЊ\ЊfЊrЊƒCloseHandleлCreatePipeоCreateProcessAюCreateThread DeleteCriticalSection+DuplicateHandle1EnterCriticalSectionvFindClosezFindFirstFileA‹FindNextFileAЇFormatMessageAGetCurrentProcessGetCurrentProcessIdGetCurrentThreadIdCGetFileAttributesAYGetFullPathNameAbGetLastErrorвGetStartupInfoAеGetStdHandleыGetSystemTimeAsFileTimeGetTickCount`InitializeCriticalSectionИLeaveCriticalSectionFQueryPerformanceCounteriReadFileœRtlAddFunctionTableRtlCaptureContextЄRtlLookupFunctionEntryЋRtlVirtualUnwindэSetEnvironmentVariableAяSetErrorModeCSetUnhandledExceptionFilterQSleep`TerminateProcesstTlsGetValue‚UnhandledExceptionFilterЃVirtualProtectЅVirtualQueryЋWaitForMultipleObjects­WaitForSingleObjectцWriteFilelstrcatA lstrcpyAlstrlenA8__C_specific_handlerR__getmainargsS__initenvT__iob_func[__lconv_initb__set_app_typef__setusermatherrv_acmdln~_amsg_exit_cexit§_fmodeN_inittermi_onexitп_strdupV_vsnprintf abortcalloc*exit.fclose4fgets;fopen=fprintfDfreePfwriteeisspacemalloc‡memcpyprintf”putsЅsignalВstrchrКstrlenНstrncmpОstrncpyУstrstrнvfprintfАWaitForInputIdle                                            KERNEL32.dll                                    msvcrt.dll( USER32.dll @@Р@р@А@tcl8.6.14/win/cat.c0000644000175000017500000000134614554262142013356 0ustar sergeisergei/* * cat.c -- * * Program used when testing tclWinPipe.c * * Copyright (c) 1996 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef TCL_BROKEN_MAINARGS /* On mingw32 and cygwin this doesn't work */ # undef UNICODE # undef _UNICODE #endif #include #include #include #include int _tmain(void) { char buf[1024]; int n; const char *err; while (1) { n = _read(0, buf, sizeof(buf)); if (n <= 0) { break; } _write(1, buf, n); } err = (sizeof(int) == 2) ? "stderr16" : "stderr32"; _write(2, err, (unsigned int)strlen(err)); return 0; } tcl8.6.14/win/nmakehlp.c0000644000175000017500000005125214554262142014407 0ustar sergeisergei/* * ---------------------------------------------------------------------------- * nmakehlp.c -- * * This is used to fix limitations within nmake and the environment. * * Copyright (c) 2002 David Gravereaux. * Copyright (c) 2006 Pat Thoyts * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * ---------------------------------------------------------------------------- */ #define _CRT_SECURE_NO_DEPRECATE #include #ifdef _MSC_VER #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") #endif #include /* * This library is required for x64 builds with _some_ versions of MSVC */ #if defined(_M_IA64) || defined(_M_AMD64) #if _MSC_VER >= 1400 && _MSC_VER < 1500 #pragma comment(lib, "bufferoverflowU") #endif #endif /* ISO hack for dumb VC++ */ #if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900 #define snprintf _snprintf #endif /* protos */ static int CheckForCompilerFeature(const char *option); static int CheckForLinkerFeature(char **options, int count); static int IsIn(const char *string, const char *substring); static int SubstituteFile(const char *substs, const char *filename); static int QualifyPath(const char *path); static int LocateDependency(const char *keyfile); static const char *GetVersionFromFile(const char *filename, const char *match, int numdots); static DWORD WINAPI ReadFromPipe(LPVOID args); /* globals */ #define CHUNK 25 #define STATICBUFFERSIZE 1000 typedef struct { HANDLE pipe; char buffer[STATICBUFFERSIZE]; } pipeinfo; pipeinfo Out = {INVALID_HANDLE_VALUE, ""}; pipeinfo Err = {INVALID_HANDLE_VALUE, ""}; /* * exitcodes: 0 == no, 1 == yes, 2 == error */ int main( int argc, char *argv[]) { char msg[300]; DWORD dwWritten; int chars; const char *s; /* * Make sure children (cl.exe and link.exe) are kept quiet. */ SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX); /* * Make sure the compiler and linker aren't effected by the outside world. */ SetEnvironmentVariable("CL", ""); SetEnvironmentVariable("LINK", ""); if (argc > 1 && *argv[1] == '-') { switch (*(argv[1]+1)) { case 'c': if (argc != 3) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -c \n" "Tests for whether cl.exe supports an option\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return CheckForCompilerFeature(argv[2]); case 'l': if (argc < 3) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -l ? ...?\n" "Tests for whether link.exe supports an option\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return CheckForLinkerFeature(&argv[2], argc-2); case 'f': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -f \n" "Find a substring within another\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } else if (argc == 3) { /* * If the string is blank, there is no match. */ return 0; } else { return IsIn(argv[2], argv[3]); } case 's': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -s \n" "Perform a set of string map type substutitions on a file\n" "exitcodes: 0\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return SubstituteFile(argv[2], argv[3]); case 'V': if (argc != 4) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -V filename matchstring\n" "Extract a version from a file:\n" "eg: pkgIndex.tcl \"package ifneeded http\"", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 0; } s = GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0'); if (s && *s) { printf("%s\n", s); return 0; } else return 1; /* Version not found. Return non-0 exit code */ case 'Q': if (argc != 3) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -Q path\n" "Emit the fully qualified path\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return QualifyPath(argv[2]); case 'L': if (argc != 3) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -L keypath\n" "Emit the fully qualified path of directory containing keypath\n" "exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return LocateDependency(argv[2]); } } chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -c|-f|-l|-Q|-s|-V ...\n" "This is a little helper app to equalize shell differences between WinNT and\n" "Win9x and get nmake.exe to accomplish its job.\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } static int CheckForCompilerFeature( const char *option) { STARTUPINFO si; PROCESS_INFORMATION pi; SECURITY_ATTRIBUTES sa; DWORD threadID; char msg[300]; BOOL ok; HANDLE hProcess, h, pipeThreads[2]; char cmdline[100]; hProcess = GetCurrentProcess(); memset(&pi, 0, sizeof(PROCESS_INFORMATION)); memset(&si, 0, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = INVALID_HANDLE_VALUE; memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = FALSE; /* * Create a non-inheritable pipe. */ CreatePipe(&Out.pipe, &h, &sa, 0); /* * Dupe the write side, make it inheritable, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); /* * Same as above, but for the error side. */ CreatePipe(&Err.pipe, &h, &sa, 0); DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); /* * Base command line. */ lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch "); /* * Append our option for testing */ lstrcat(cmdline, option); /* * Filename to compile, which exists, but is nothing and empty. */ lstrcat(cmdline, " .\\nul"); ok = CreateProcess( NULL, /* Module name. */ cmdline, /* Command line. */ NULL, /* Process handle not inheritable. */ NULL, /* Thread handle not inheritable. */ TRUE, /* yes, inherit handles. */ DETACHED_PROCESS, /* No console for you. */ NULL, /* Use parent's environment block. */ NULL, /* Use parent's starting directory. */ &si, /* Pointer to STARTUPINFO structure. */ &pi); /* Pointer to PROCESS_INFORMATION structure. */ if (!ok) { DWORD err = GetLastError(); int chars = snprintf(msg, sizeof(msg) - 1, "Tried to launch: \"%s\", but got error [%lu]: ", cmdline, err); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars], (300-chars), 0); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; } /* * Close our references to the write handles that have now been inherited. */ CloseHandle(si.hStdOutput); CloseHandle(si.hStdError); WaitForInputIdle(pi.hProcess, 5000); CloseHandle(pi.hThread); /* * Start the pipe reader threads. */ pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); /* * Block waiting for the process to end. */ WaitForSingleObject(pi.hProcess, INFINITE); CloseHandle(pi.hProcess); /* * Wait for our pipe to get done reading, should it be a little slow. */ WaitForMultipleObjects(2, pipeThreads, TRUE, 500); CloseHandle(pipeThreads[0]); CloseHandle(pipeThreads[1]); /* * Look for the commandline warning code in both streams. * - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002. */ return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL || strstr(Out.buffer, "D9002") != NULL || strstr(Err.buffer, "D9002") != NULL || strstr(Out.buffer, "D2021") != NULL || strstr(Err.buffer, "D2021") != NULL); } static int CheckForLinkerFeature( char **options, int count) { STARTUPINFO si; PROCESS_INFORMATION pi; SECURITY_ATTRIBUTES sa; DWORD threadID; char msg[300]; BOOL ok; HANDLE hProcess, h, pipeThreads[2]; int i; char cmdline[255]; hProcess = GetCurrentProcess(); memset(&pi, 0, sizeof(PROCESS_INFORMATION)); memset(&si, 0, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = INVALID_HANDLE_VALUE; memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; /* * Create a non-inheritible pipe. */ CreatePipe(&Out.pipe, &h, &sa, 0); /* * Dupe the write side, make it inheritable, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); /* * Same as above, but for the error side. */ CreatePipe(&Err.pipe, &h, &sa, 0); DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); /* * Base command line. */ lstrcpy(cmdline, "link.exe -nologo "); /* * Append our option for testing. */ for (i = 0; i < count; i++) { lstrcat(cmdline, " \""); lstrcat(cmdline, options[i]); lstrcat(cmdline, "\""); } ok = CreateProcess( NULL, /* Module name. */ cmdline, /* Command line. */ NULL, /* Process handle not inheritable. */ NULL, /* Thread handle not inheritable. */ TRUE, /* yes, inherit handles. */ DETACHED_PROCESS, /* No console for you. */ NULL, /* Use parent's environment block. */ NULL, /* Use parent's starting directory. */ &si, /* Pointer to STARTUPINFO structure. */ &pi); /* Pointer to PROCESS_INFORMATION structure. */ if (!ok) { DWORD err = GetLastError(); int chars = snprintf(msg, sizeof(msg) - 1, "Tried to launch: \"%s\", but got error [%lu]: ", cmdline, err); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars], (300-chars), 0); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; } /* * Close our references to the write handles that have now been inherited. */ CloseHandle(si.hStdOutput); CloseHandle(si.hStdError); WaitForInputIdle(pi.hProcess, 5000); CloseHandle(pi.hThread); /* * Start the pipe reader threads. */ pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); /* * Block waiting for the process to end. */ WaitForSingleObject(pi.hProcess, INFINITE); CloseHandle(pi.hProcess); /* * Wait for our pipe to get done reading, should it be a little slow. */ WaitForMultipleObjects(2, pipeThreads, TRUE, 500); CloseHandle(pipeThreads[0]); CloseHandle(pipeThreads[1]); /* * Look for the commandline warning code in the stderr stream. */ return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL || strstr(Out.buffer, "LNK4044") != NULL || strstr(Err.buffer, "LNK4044") != NULL || strstr(Out.buffer, "LNK4224") != NULL || strstr(Err.buffer, "LNK4224") != NULL); } static DWORD WINAPI ReadFromPipe( LPVOID args) { pipeinfo *pi = (pipeinfo *) args; char *lastBuf = pi->buffer; DWORD dwRead; BOOL ok; again: if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) { CloseHandle(pi->pipe); return (DWORD)-1; } ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L); if (!ok || dwRead == 0) { CloseHandle(pi->pipe); return 0; } lastBuf += dwRead; goto again; return 0; /* makes the compiler happy */ } static int IsIn( const char *string, const char *substring) { return (strstr(string, substring) != NULL); } /* * GetVersionFromFile -- * Looks for a match string in a file and then returns the version * following the match where a version is anything acceptable to * package provide or package ifneeded. */ static const char * GetVersionFromFile( const char *filename, const char *match, int numdots) { static char szBuffer[100]; char *szResult = NULL; FILE *fp = fopen(filename, "rt"); if (fp != NULL) { /* * Read data until we see our match string. */ while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) { LPSTR p, q; p = strstr(szBuffer, match); if (p != NULL) { /* * Skip to first digit after the match. */ p += strlen(match); while (*p && !isdigit((unsigned char)*p)) { ++p; } /* * Find ending whitespace. */ q = p; while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q) && !strchr("ab", q[-1])) || --numdots))) { ++q; } *q = 0; szResult = p; break; } } fclose(fp); } return szResult; } /* * List helpers for the SubstituteFile function */ typedef struct list_item_t { struct list_item_t *nextPtr; char * key; char * value; } list_item_t; /* insert a list item into the list (list may be null) */ static list_item_t * list_insert(list_item_t **listPtrPtr, const char *key, const char *value) { list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t)); if (itemPtr) { itemPtr->key = strdup(key); itemPtr->value = strdup(value); itemPtr->nextPtr = NULL; while(*listPtrPtr) { listPtrPtr = &(*listPtrPtr)->nextPtr; } *listPtrPtr = itemPtr; } return itemPtr; } static void list_free(list_item_t **listPtrPtr) { list_item_t *tmpPtr, *listPtr = *listPtrPtr; while (listPtr) { tmpPtr = listPtr; listPtr = listPtr->nextPtr; free(tmpPtr->key); free(tmpPtr->value); free(tmpPtr); } } /* * SubstituteFile -- * As windows doesn't provide anything useful like sed and it's unreliable * to use the tclsh you are building against (consider x-platform builds - * e.g. compiling AMD64 target from IX86) we provide a simple substitution * option here to handle autoconf style substitutions. * The substitution file is whitespace and line delimited. The file should * consist of lines matching the regular expression: * \s*\S+\s+\S*$ * * Usage is something like: * nmakehlp -S << $** > $@ * @PACKAGE_NAME@ $(PACKAGE_NAME) * @PACKAGE_VERSION@ $(PACKAGE_VERSION) * << */ static int SubstituteFile( const char *substitutions, const char *filename) { static char szBuffer[1024], szCopy[1024]; list_item_t *substPtr = NULL; FILE *fp, *sp; fp = fopen(filename, "rt"); if (fp != NULL) { /* * Build a list of substitutions from the first filename */ sp = fopen(substitutions, "rt"); if (sp != NULL) { while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) { unsigned char *ks, *ke, *vs, *ve; ks = (unsigned char*)szBuffer; while (ks && *ks && isspace(*ks)) ++ks; ke = ks; while (ke && *ke && !isspace(*ke)) ++ke; vs = ke; while (vs && *vs && isspace(*vs)) ++vs; ve = vs; while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; *ke = 0, *ve = 0; list_insert(&substPtr, (char*)ks, (char*)vs); } fclose(sp); } /* debug: dump the list */ #ifndef NDEBUG { int n = 0; list_item_t *p = NULL; for (p = substPtr; p != NULL; p = p->nextPtr, ++n) { fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value); } } #endif /* * Run the substitutions over each line of the input */ while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) { list_item_t *p = NULL; for (p = substPtr; p != NULL; p = p->nextPtr) { char *m = strstr(szBuffer, p->key); if (m) { char *cp, *op, *sp; cp = szCopy; op = szBuffer; while (op != m) *cp++ = *op++; sp = p->value; while (sp && *sp) *cp++ = *sp++; op += strlen(p->key); while (*op) *cp++ = *op++; *cp = 0; memcpy(szBuffer, szCopy, sizeof(szCopy)); } } printf("%s", szBuffer); } list_free(&substPtr); } fclose(fp); return 0; } BOOL FileExists(LPCTSTR szPath) { #ifndef INVALID_FILE_ATTRIBUTES #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) #endif DWORD pathAttr = GetFileAttributes(szPath); return (pathAttr != INVALID_FILE_ATTRIBUTES && !(pathAttr & FILE_ATTRIBUTE_DIRECTORY)); } /* * QualifyPath -- * * This composes the current working directory with a provided path * and returns the fully qualified and normalized path. * Mostly needed to setup paths for testing. */ static int QualifyPath( const char *szPath) { char szCwd[MAX_PATH + 1]; GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL); printf("%s\n", szCwd); return 0; } /* * Implements LocateDependency for a single directory. See that command * for an explanation. * Returns 0 if found after printing the directory. * Returns 1 if not found but no errors. * Returns 2 on any kind of error * Basically, these are used as exit codes for the process. */ static int LocateDependencyHelper(const char *dir, const char *keypath) { HANDLE hSearch; char path[MAX_PATH+1]; size_t dirlen; int keylen, ret; WIN32_FIND_DATA finfo; if (dir == NULL || keypath == NULL) { return 2; /* Have no real error reporting mechanism into nmake */ } dirlen = strlen(dir); if (dirlen > sizeof(path) - 3) { return 2; } strncpy(path, dir, dirlen); strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */ keylen = strlen(keypath); #if 0 /* This function is not available in Visual C++ 6 */ /* * Use numerics 0 -> FindExInfoStandard, * 1 -> FindExSearchLimitToDirectories, * as these are not defined in Visual C++ 6 */ hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0); #else hSearch = FindFirstFile(path, &finfo); #endif if (hSearch == INVALID_HANDLE_VALUE) return 1; /* Not found */ /* Loop through all subdirs checking if the keypath is under there */ ret = 1; /* Assume not found */ do { int sublen; /* * We need to check it is a directory despite the * FindExSearchLimitToDirectories in the above call. See SDK docs */ if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) continue; sublen = strlen(finfo.cFileName); if ((dirlen+1+sublen+1+keylen+1) > sizeof(path)) continue; /* Path does not fit, assume not matched */ strncpy(path+dirlen+1, finfo.cFileName, sublen); path[dirlen+1+sublen] = '\\'; strncpy(path+dirlen+1+sublen+1, keypath, keylen+1); if (FileExists(path)) { /* Found a match, print to stdout */ path[dirlen+1+sublen] = '\0'; QualifyPath(path); ret = 0; break; } } while (FindNextFile(hSearch, &finfo)); FindClose(hSearch); return ret; } /* * LocateDependency -- * * Locates a dependency for a package. * keypath - a relative path within the package directory * that is used to confirm it is the correct directory. * The search path for the package directory is currently only * the parent and grandparent of the current working directory. * If found, the command prints * name_DIRPATH= * and returns 0. If not found, does not print anything and returns 1. */ static int LocateDependency(const char *keypath) { size_t i; int ret; static const char *paths[] = {"..", "..\\..", "..\\..\\.."}; for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) { ret = LocateDependencyHelper(paths[i], keypath); if (ret == 0) { return ret; } } return ret; } /* * Local variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * indent-tabs-mode: t * tab-width: 8 * End: */ tcl8.6.14/win/tclAppInit.c0000644000175000017500000002126014554262142014653 0ustar sergeisergei/* * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit * procedure for tclsh and other Tcl-based applications (without Tk). * Note that this program must be built in Win32 console mode to work * properly. * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" #define WIN32_LEAN_AND_MEAN #define STRICT /* See MSDN Article Q83456 */ #include #undef STRICT #undef WIN32_LEAN_AND_MEAN #include #include #include #if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 # define Tcl_LibraryInitProc Tcl_PackageInitProc # define Tcl_StaticLibrary Tcl_StaticPackage #endif #ifdef TCL_TEST extern Tcl_LibraryInitProc Tcltest_Init; extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES extern Tcl_LibraryInitProc Registry_Init; extern Tcl_LibraryInitProc Dde_Init; extern Tcl_LibraryInitProc Dde_SafeInit; #endif #if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS) int _CRT_glob = 0; #endif /* __GNUC__ || TCL_BROKEN_MAINARGS */ #ifdef TCL_BROKEN_MAINARGS static void setargv(int *argcPtr, TCHAR ***argvPtr); #endif /* TCL_BROKEN_MAINARGS */ /* * The following #if block allows you to change the AppInit function by using * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The * #if checks for that #define and uses Tcl_AppInit if it does not exist. */ #ifndef TCL_LOCAL_APPINIT #define TCL_LOCAL_APPINIT Tcl_AppInit #endif #ifndef MODULE_SCOPE # define MODULE_SCOPE extern #endif MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); /* * The following #if block allows you to change how Tcl finds the startup * script, prime the library or encoding paths, fiddle with the argv, etc., * without needing to rewrite Tcl_Main() */ #ifdef TCL_LOCAL_MAIN_HOOK MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); #endif /* *---------------------------------------------------------------------- * * main -- * * This is the main program for the application. * * Results: * None: Tcl_Main never returns here, so this procedure never returns * either. * * Side effects: * Just about anything, since from here we call arbitrary Tcl code. * *---------------------------------------------------------------------- */ #ifdef TCL_BROKEN_MAINARGS int main( int argc, /* Number of command-line arguments. */ char **argv1) /* Not used. */ { TCHAR **argv; #else int _tmain( int argc, /* Number of command-line arguments. */ TCHAR *argv[]) /* Values of command-line arguments. */ { #endif TCHAR *p; /* * Set up the default locale to be standard "C" locale so parsing is * performed correctly. */ setlocale(LC_ALL, "C"); #ifdef TCL_BROKEN_MAINARGS /* * Get our args from the c-runtime. Ignore command line. */ (void)argv1; setargv(&argc, &argv); #endif /* * Forward slashes substituted for backslashes. */ for (p = argv[0]; *p != '\0'; p++) { if (*p == '\\') { *p = '/'; } } #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE)) /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */ TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * * This procedure performs application-specific initialization. Most * applications, especially those that incorporate additional packages, * will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error message in * the interp's result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } #if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES if (Registry_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticLibrary(interp, "Registry", Registry_Init, NULL); if (Dde_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticLibrary(interp, "Dde", Dde_Init, Dde_SafeInit); #endif #ifdef TCL_TEST if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ /* * Call the init procedures for included packages. Each call should look * like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * * where "Mod" is the name of the module. (Dynamically-loadable packages * should have the same entry-point name.) */ /* * Call Tcl_CreateCommand for application-specific commands, if they * weren't already created by the init procedures called above. */ /* * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. */ (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); return TCL_OK; } /* *------------------------------------------------------------------------- * * setargv -- * * Parse the Windows command line string into argc/argv. Done here * because we don't trust the builtin argument parser in crt0. Windows * applications are responsible for breaking their command line into * arguments. * * 2N backslashes + quote -> N backslashes + begin quoted string * 2N + 1 backslashes + quote -> literal * N backslashes + non-quote -> literal * quote + quote in a quoted string -> single quote * quote + quote not in quoted string -> empty string * quote -> begin quoted string * * Results: * Fills argcPtr with the number of arguments and argvPtr with the array * of arguments. * * Side effects: * Memory allocated. * *-------------------------------------------------------------------------- */ #ifdef TCL_BROKEN_MAINARGS static void setargv( int *argcPtr, /* Filled with number of argument strings. */ TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ { TCHAR *cmdLine, *p, *arg, *argSpace; TCHAR **argv; int argc, size, inquote, copy, slashes; cmdLine = GetCommandLine(); /* * Precompute an overly pessimistic guess at the number of arguments in * the command line by counting non-space spans. */ size = 2; for (p = cmdLine; *p != '\0'; p++) { if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ size++; while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ p++; } if (*p == '\0') { break; } } } /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ #undef Tcl_Alloc #undef Tcl_DbCkalloc argSpace = (TCHAR *)ckalloc(size * sizeof(char *) + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); argv = (TCHAR **) argSpace; argSpace += size * (sizeof(char *)/sizeof(TCHAR)); size--; p = cmdLine; for (argc = 0; argc < size; argc++) { argv[argc] = arg = argSpace; while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ p++; } if (*p == '\0') { break; } inquote = 0; slashes = 0; while (1) { copy = 1; while (*p == '\\') { slashes++; p++; } if (*p == '"') { if ((slashes & 1) == 0) { copy = 0; if ((inquote) && (p[1] == '"')) { p++; copy = 1; } else { inquote = !inquote; } } slashes >>= 1; } while (slashes) { *arg = '\\'; arg++; slashes--; } if ((*p == '\0') || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ break; } if (copy != 0) { *arg = *p; arg++; } p++; } *arg = '\0'; argSpace = arg + 1; } argv[argc] = NULL; *argcPtr = argc; *argvPtr = argv; } #endif /* TCL_BROKEN_MAINARGS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWin32Dll.c0000644000175000017500000005013614554262142014651 0ustar sergeisergei/* * tclWin32Dll.c -- * * This file contains the DLL entry point and other low-level bit bashing * code that needs inline assembly. * * Copyright (c) 1995-1996 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" #if defined(HAVE_INTRIN_H) # include #endif /* * The following variables keep track of information about this DLL on a * per-instance basis. Each time this DLL is loaded, it gets its own new data * segment with its own copy of all static and global information. */ static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ /* * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it */ #if defined(_MSC_VER) && (_MSC_VER <= 1100) && defined (_M_IX86) #define cpuid __asm __emit 0fh __asm __emit 0a2h #endif /* * The following declaration is for the VC++ DLL entry point. */ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved); /* * The following structure and linked list is to allow us to map between * volume mount points and drive letters on the fly (no Win API exists for * this). */ typedef struct MountPointMap { WCHAR *volumeName; /* Native wide string volume name. */ WCHAR driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; /* Pointer to next structure in list, or * NULL. */ } MountPointMap; /* * This is the head of the linked list, which is protected by the mutex which * follows, for thread-enabled builds. */ MountPointMap *driveLetterLookup = NULL; TCL_DECLARE_MUTEX(mountPointMap) /* * We will need this below. */ #ifdef _WIN32 #ifndef STATIC_BUILD /* *---------------------------------------------------------------------- * * DllEntryPoint -- * * This wrapper function is used by Borland to invoke the initialization * code for Tcl. It simply calls the DllMain routine. * * Results: * See DllMain. * * Side effects: * See DllMain. * *---------------------------------------------------------------------- */ BOOL APIENTRY DllEntryPoint( HINSTANCE hInst, /* Library instance handle. */ DWORD reason, /* Reason this function is being called. */ LPVOID reserved) { return DllMain(hInst, reason, reserved); } /* *---------------------------------------------------------------------- * * DllMain -- * * This routine is called by the VC++ C run time library init code, or * the DllEntryPoint routine. It is responsible for initializing various * dynamically loaded libraries. * * Results: * TRUE on sucess, FALSE on failure. * * Side effects: * Initializes most rudimentary Windows bits. * *---------------------------------------------------------------------- */ BOOL APIENTRY DllMain( HINSTANCE hInst, /* Library instance handle. */ DWORD reason, /* Reason this function is being called. */ LPVOID reserved) /* Not used. */ { (void)reserved; switch (reason) { case DLL_PROCESS_ATTACH: DisableThreadLibraryCalls(hInst); TclWinInit(hInst); return TRUE; /* * DLL_PROCESS_DETACH is unnecessary as the user should call * Tcl_Finalize explicitly before unloading Tcl. */ } return TRUE; } #endif /* !STATIC_BUILD */ #endif /* _WIN32 */ /* *---------------------------------------------------------------------- * * TclWinGetTclInstance -- * * Retrieves the global library instance handle. * * Results: * Returns the global library instance handle. * * Side effects: * None. * *---------------------------------------------------------------------- */ HINSTANCE TclWinGetTclInstance(void) { return hInstance; } /* *---------------------------------------------------------------------- * * TclWinInit -- * * This function initializes the internal state of the tcl library. * * Results: * None. * * Side effects: * Initializes the tclPlatformId variable. * *---------------------------------------------------------------------- */ void TclWinInit( HINSTANCE hInst) /* Library instance handle. */ { OSVERSIONINFOW os; hInstance = hInst; os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); GetVersionExW(&os); /* * We no longer support Win32s or Win9x or Windows CE, so just in case * someone manages to get a runtime there, make sure they know that. */ if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) { Tcl_Panic("Windows NT is the only supported platform"); } } /* *---------------------------------------------------------------------- * * TclWinGetPlatformId -- * * Determines whether running under NT, 95, or Win32s, to allow runtime * conditional code. * * Results: * The return value is always: * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclWinGetPlatformId(void) { return VER_PLATFORM_WIN32_NT; } /* *------------------------------------------------------------------------- * * TclWinNoBackslash -- * * We're always iterating through a string in Windows, changing the * backslashes to slashes for use in Tcl. * * Results: * All backslashes in given string are changed to slashes. * * Side effects: * None. * *------------------------------------------------------------------------- */ char * TclWinNoBackslash( char *path) /* String to change. */ { char *p; for (p = path; *p != '\0'; p++) { if (*p == '\\') { *p = '/'; } } return path; } /* *--------------------------------------------------------------------------- * * TclWinEncodingsCleanup -- * * Called during finalization to clean up any memory allocated in our * mount point map which is used to follow certain kinds of symlinks. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclWinEncodingsCleanup(void) { MountPointMap *dlIter, *dlIter2; /* * Clean up the mount point map. */ Tcl_MutexLock(&mountPointMap); dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; ckfree(dlIter->volumeName); ckfree(dlIter); dlIter = dlIter2; } Tcl_MutexUnlock(&mountPointMap); } /* *--------------------------------------------------------------------------- * * TclWinResetInterfaces -- * * Called during finalization to reset us to a safe state for reuse. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclWinResetInterfaces(void) { } /* *-------------------------------------------------------------------- * * TclWinDriveLetterForVolMountPoint * * Unfortunately, Windows provides no easy way at all to get hold of the * drive letter for a volume mount point, but we need that information to * understand paths correctly. So, we have to build an associated array * to find these correctly, and allow quick and easy lookup from volume * mount points to drive letters. * * We assume here that we are running on a system for which the wide * character interfaces are used, which is valid for Win 2000 and WinXP * which are the only systems on which this function will ever be called. * * Result: * The drive letter, or -1 if no drive letter corresponds to the given * mount point. * *-------------------------------------------------------------------- */ char TclWinDriveLetterForVolMountPoint( const WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; WCHAR Target[55]; /* Target of mount at mount point */ WCHAR drive[4] = L"A:\\"; /* * Detect the volume mounted there. Unfortunately, there is no simple way * to map a unique volume name to a DOS drive letter. So, we have to build * an associative array. */ Tcl_MutexLock(&mountPointMap); dlIter = driveLetterLookup; while (dlIter != NULL) { if (wcscmp(dlIter->volumeName, mountPoint) == 0) { /* * We need to check whether this information is still valid, since * either the user or various programs could have adjusted the * mount points on the fly. */ drive[0] = (WCHAR) dlIter->driveLetter; /* * Try to read the volume mount point and see where it points. */ if (GetVolumeNameForVolumeMountPointW(drive, Target, 55) != 0) { if (wcscmp(dlIter->volumeName, Target) == 0) { /* * Nothing has changed. */ Tcl_MutexUnlock(&mountPointMap); return (char) dlIter->driveLetter; } } /* * If we reach here, unfortunately, this mount point is no longer * valid at all. */ if (driveLetterLookup == dlIter) { dlPtr2 = dlIter; driveLetterLookup = dlIter->nextPtr; } else { for (dlPtr2 = driveLetterLookup; dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) { if (dlPtr2->nextPtr == dlIter) { dlPtr2->nextPtr = dlIter->nextPtr; dlPtr2 = dlIter; break; } } } /* * Now dlPtr2 points to the structure to free. */ ckfree(dlPtr2->volumeName); ckfree(dlPtr2); /* * Restart the loop - we could try to be clever and continue half * way through, but the logic is a bit messy, so it's cleanest * just to restart. */ dlIter = driveLetterLookup; continue; } dlIter = dlIter->nextPtr; } /* * We couldn't find it, so we must iterate over the letters. */ for (drive[0] = 'A'; drive[0] <= 'Z'; drive[0]++) { /* * Try to read the volume mount point and see where it points. */ if (GetVolumeNameForVolumeMountPointW(drive, Target, 55) != 0) { int alreadyStored = 0; for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { if (wcscmp(dlIter->volumeName, Target) == 0) { alreadyStored = 1; break; } } if (!alreadyStored) { dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target); dlPtr2->driveLetter = (WCHAR) drive[0]; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; } } } /* * Try again. */ for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { if (wcscmp(dlIter->volumeName, mountPoint) == 0) { Tcl_MutexUnlock(&mountPointMap); return (char) dlIter->driveLetter; } } /* * The volume doesn't appear to correspond to a drive letter - we remember * that fact and store '-1' so we don't have to look it up each time. */ dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint); dlPtr2->driveLetter = (WCHAR)-1; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; Tcl_MutexUnlock(&mountPointMap); return -1; } /* *--------------------------------------------------------------------------- * * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf -- * * Convert between UTF-8 and Unicode when running Windows. * * On Mac and Unix, all strings exchanged between Tcl and the OS are * "char" oriented. We need only one Tcl_Encoding to convert between * UTF-8 and the system's native encoding. We use NULL to represent * that encoding. * * On Windows, some strings exchanged between Tcl and the OS are "char" * oriented, while others are in Unicode. We need two Tcl_Encoding APIs * depending on whether we are targeting a "char" or Unicode interface. * * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding * of NULL should always used to convert between UTF-8 and the system's * "char" oriented encoding. The following two functions are used in * Windows-specific code to convert between UTF-8 and Unicode strings. * This saves you the trouble of writing the * following type of fragment over and over: * * encoding <- Tcl_GetEncoding("unicode"); * nativeBuffer <- UtfToExternal(encoding, utfBuffer); * Tcl_FreeEncoding(encoding); * * By convention, in Windows a WCHAR is a Unicode character. If you plan * on targeting a Unicode interface when running on Windows, these * functions should be used. If you plan on targetting a "char" oriented * function on Windows, use Tcl_UtfToExternal() with an encoding of NULL. * * Results: * The result is a pointer to the string in the desired target encoding. * Storage for the result string is allocated in dsPtr; the caller must * call Tcl_DStringFree() when the result is no longer needed. * * Side effects: * None. * *--------------------------------------------------------------------------- */ TCHAR * Tcl_WinUtfToTChar( const char *string, /* Source string in UTF-8. */ int len, /* Source string length in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { #if TCL_UTF_MAX > 4 Tcl_UniChar ch = 0; TCHAR *w, *wString; const char *p, *end; int oldLength; #endif Tcl_DStringInit(dsPtr); if (!string) { return NULL; } #if TCL_UTF_MAX > 4 if (len < 0) { len = strlen(string); } /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in * bytes. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (int) ((len + 1) * sizeof(TCHAR))); wString = (TCHAR *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; p = string; end = string + len - 4; while (p < end) { p += TclUtfToUniChar(p, &ch); if (ch > 0xFFFF) { *w++ = (WCHAR) (0xD800 + ((ch -= 0x10000) >> 10)); *w++ = (WCHAR) (0xDC00 | (ch & 0x3FF)); } else { *w++ = ch; } } end += 4; while (p < end) { if (Tcl_UtfCharComplete(p, end-p)) { p += TclUtfToUniChar(p, &ch); } else { ch = UCHAR(*p++); } if (ch > 0xFFFF) { *w++ = (WCHAR) (0xD800 + ((ch -= 0x10000) >> 10)); *w++ = (WCHAR) (0xDC00 | (ch & 0x3FF)); } else { *w++ = ch; } } *w = '\0'; Tcl_DStringSetLength(dsPtr, oldLength + ((char *) w - (char *) wString)); return wString; #else return (TCHAR *)Tcl_UtfToUniCharDString(string, len, dsPtr); #endif } char * Tcl_WinTCharToUtf( const TCHAR *string, /* Source string in Unicode. */ int len, /* Source string length in bytes, or -1 for * platform-specific string length. */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { #if TCL_UTF_MAX > 4 const WCHAR *w, *wEnd; char *p, *result; int oldLength, blen = 1; #endif Tcl_DStringInit(dsPtr); if (!string) { return NULL; } if (len < 0) { len = (int)wcslen((WCHAR *)string); } else { len /= 2; } #if TCL_UTF_MAX > 4 oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (len + 1) * 4); result = Tcl_DStringValue(dsPtr) + oldLength; p = result; wEnd = (WCHAR *)string + len; for (w = (WCHAR *)string; w < wEnd; ) { if (!blen && ((*w & 0xFC00) != 0xDC00)) { /* Special case for handling high surrogates. */ p += Tcl_UniCharToUtf(-1, p); } blen = Tcl_UniCharToUtf(*w, p); p += blen; if ((*w >= 0xD800) && (blen < 3)) { /* Indication that high surrogate is handled */ blen = 0; } w++; } if (!blen) { /* Special case for handling high surrogates. */ p += Tcl_UniCharToUtf(-1, p); } Tcl_DStringSetLength(dsPtr, oldLength + (p - result)); return result; #else return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr); #endif } /* *------------------------------------------------------------------------ * * TclWinCPUID -- * * Get CPU ID information on an Intel box under Windows * * Results: * Returns TCL_OK if successful, TCL_ERROR if CPUID is not supported or * fails. * * Side effects: * If successful, stores EAX, EBX, ECX and EDX registers after the CPUID * instruction in the four integers designated by 'regsPtr' * *---------------------------------------------------------------------- */ int TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve. */ unsigned int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; #if defined(HAVE_INTRIN_H) && defined(_WIN64) && defined(HAVE_CPUID) __cpuid((int *)regsPtr, (int)index); status = TCL_OK; #elif defined(__GNUC__) && defined(HAVE_CPUID) # if defined(_WIN64) /* * Execute the CPUID instruction with the given index, and store results * off 'regPtr'. */ __asm__ __volatile__( /* * Do the CPUID instruction, and save the results in the 'regsPtr' * area. */ "movl %[rptr], %%edi" "\n\t" "movl %[index], %%eax" "\n\t" "cpuid" "\n\t" "movl %%eax, 0x0(%%edi)" "\n\t" "movl %%ebx, 0x4(%%edi)" "\n\t" "movl %%ecx, 0x8(%%edi)" "\n\t" "movl %%edx, 0xC(%%edi)" "\n\t" : /* No outputs */ : [index] "m" (index), [rptr] "m" (regsPtr) : "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"); status = TCL_OK; # else TCLEXCEPTION_REGISTRATION registration; /* * Execute the CPUID instruction with the given index, and store results * off 'regPtr'. */ __asm__ __volatile__( /* * Construct an TCLEXCEPTION_REGISTRATION to protect the CPUID * instruction (early 486's don't have CPUID) */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */ "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* * Link the TCLEXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" /* * Do the CPUID instruction, and save the results in the 'regsPtr' * area. */ "movl %[rptr], %%edi" "\n\t" "movl %[index], %%eax" "\n\t" "cpuid" "\n\t" "movl %%eax, 0x0(%%edi)" "\n\t" "movl %%ebx, 0x4(%%edi)" "\n\t" "movl %%ecx, 0x8(%%edi)" "\n\t" "movl %%edx, 0xC(%%edi)" "\n\t" /* * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION and * store a TCL_OK status. */ "movl %%fs:0, %%edx" "\n\t" "movl %[ok], %%eax" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that we * previously put on the chain. */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" /* * Come here however we exited. Restore context from the * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xC(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [index] "m" (index), [rptr] "m" (regsPtr), [registration] "m" (registration), [ok] "i" (TCL_OK), [error] "i" (TCL_ERROR) : "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"); status = registration.status; # endif /* !_WIN64 */ #elif defined(_MSC_VER) && defined(HAVE_CPUID) # if defined(_WIN64) __cpuid(regsPtr, index); status = TCL_OK; # elif defined (_M_IX86) /* * Define a structure in the stack frame to hold the registers. */ struct { DWORD dw0; DWORD dw1; DWORD dw2; DWORD dw3; } regs; regs.dw0 = index; /* * Execute the CPUID instruction and save regs in the stack frame. */ _try { _asm { push ebx push ecx push edx mov eax, regs.dw0 cpuid mov regs.dw0, eax mov regs.dw1, ebx mov regs.dw2, ecx mov regs.dw3, edx pop edx pop ecx pop ebx } /* * Copy regs back out to the caller. */ regsPtr[0] = regs.dw0; regsPtr[1] = regs.dw1; regsPtr[2] = regs.dw2; regsPtr[3] = regs.dw3; status = TCL_OK; } __except(EXCEPTION_EXECUTE_HANDLER) { /* do nothing */ } # endif #else (void)index; (void)regsPtr; /* * Don't know how to do assembly code for this compiler and/or * architecture. */ #endif return status; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinChan.c0000644000175000017500000012262014554262142014640 0ustar sergeisergei/* * tclWinChan.c * * Channel drivers for Windows channels based on files, command pipes and * TCP sockets. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" #include "tclIO.h" /* * State flags used in the info structures below. */ #define FILE_PENDING (1<<0) /* Message is pending in the queue. */ #define FILE_ASYNC (1<<1) /* Channel is non-blocking. */ #define FILE_APPEND (1<<2) /* File is in append mode. */ #define FILE_TYPE_SERIAL (FILE_TYPE_PIPE+1) #define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2) /* * The following structure contains per-instance data for a file based channel. */ typedef struct FileInfo { Tcl_Channel channel; /* Pointer to channel structure. */ int validMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ int watchMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which events should be reported. */ int flags; /* State flags, see above for a list. */ HANDLE handle; /* Input/output file. */ struct FileInfo *nextPtr; /* Pointer to next registered file. */ int dirty; /* Boolean flag. Set if the OS may have data * pending on the channel. */ } FileInfo; typedef struct ThreadSpecificData { /* * List of all file channels currently open. */ FileInfo *firstFilePtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following structure is what is added to the Tcl event queue when file * events are generated. */ typedef struct FileEvent { Tcl_Event header; /* Information that is standard for all * events. */ FileInfo *infoPtr; /* Pointer to file info structure. Note that * we still have to verify that the file * exists before dereferencing this * pointer. */ } FileEvent; /* * Static routines for this file: */ static int FileBlockProc(ClientData instanceData, int mode); static void FileChannelExitHandler(ClientData clientData); static void FileCheckProc(ClientData clientData, int flags); static int FileCloseProc(ClientData instanceData, Tcl_Interp *interp); static int FileClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags); static int FileEventProc(Tcl_Event *evPtr, int flags); static int FileGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static ThreadSpecificData *FileInit(void); static int FileInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static int FileSeekProc(ClientData instanceData, long offset, int mode, int *errorCode); static Tcl_WideInt FileWideSeekProc(ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode); static void FileSetupProc(ClientData clientData, int flags); static void FileWatchProc(ClientData instanceData, int mask); static void FileThreadActionProc(ClientData instanceData, int action); static int FileTruncateProc(ClientData instanceData, Tcl_WideInt length); static DWORD FileGetType(HANDLE handle); static int NativeIsComPort(const WCHAR *nativeName); static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, int permissions, int appendMode); /* * This structure describes the channel type structure for file based IO. */ static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ FileCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ FileSeekProc, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ FileGetHandleProc, /* Get an OS handle from channel. */ FileClose2Proc, /* close2proc. */ FileBlockProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ FileWideSeekProc, /* Wide seek proc. */ FileThreadActionProc, /* Thread action proc. */ FileTruncateProc /* Truncate proc. */ }; /* *---------------------------------------------------------------------- * * FileInit -- * * This function creates the window used to simulate file events. * * Results: * None. * * Side effects: * Creates a new window and creates an exit handler. * *---------------------------------------------------------------------- */ static ThreadSpecificData * FileInit(void) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->firstFilePtr = NULL; Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL); Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL); } return tsdPtr; } /* *---------------------------------------------------------------------- * * FileChannelExitHandler -- * * This function is called to cleanup the channel driver before Tcl is * unloaded. * * Results: * None. * * Side effects: * Destroys the communication window. * *---------------------------------------------------------------------- */ static void FileChannelExitHandler( ClientData clientData) /* Old window proc */ { (void)clientData; Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL); } /* *---------------------------------------------------------------------- * * FileSetupProc -- * * This function is invoked before Tcl_DoOneEvent blocks waiting for an * event. * * Results: * None. * * Side effects: * Adjusts the block time if needed. * *---------------------------------------------------------------------- */ void FileSetupProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)data; if (!(flags & TCL_FILE_EVENTS)) { return; } /* * Check to see if there is a ready file. If so, poll. */ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask) { Tcl_SetMaxBlockTime(&blockTime); break; } } } /* *---------------------------------------------------------------------- * * FileCheckProc -- * * This function is called by Tcl_DoOneEvent to check the file event * source for events. * * Results: * None. * * Side effects: * May queue an event. * *---------------------------------------------------------------------- */ static void FileCheckProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileEvent *evPtr; FileInfo *infoPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)data; if (!(flags & TCL_FILE_EVENTS)) { return; } /* * Queue events for any ready files that don't already have events queued * (caused by persistent states that won't generate WinSock events). */ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) { infoPtr->flags |= FILE_PENDING; evPtr = (FileEvent *)ckalloc(sizeof(FileEvent)); evPtr->header.proc = FileEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } } /* *---------------------------------------------------------------------- * * FileEventProc -- * * This function is invoked by Tcl_ServiceEvent when a file event reaches * the front of the event queue. This function invokes Tcl_NotifyChannel * on the file. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the notifier callback does. * *---------------------------------------------------------------------- */ static int FileEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { FileEvent *fileEvPtr = (FileEvent *)evPtr; FileInfo *infoPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return 0; } /* * Search through the list of watched files for the one whose handle * matches the event. We do this rather than simply dereferencing the * handle in the event so that files can be deleted while the event is in * the queue. */ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (fileEvPtr->infoPtr == infoPtr) { infoPtr->flags &= ~(FILE_PENDING); Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask); break; } } return 1; } /* *---------------------------------------------------------------------- * * FileBlockProc -- * * Set blocking or non-blocking mode on channel. * * Results: * 0 if successful, errno when failed. * * Side effects: * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ static int FileBlockProc( ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { FileInfo *infoPtr = (FileInfo *)instanceData; /* * Files on Windows can not be switched between blocking and nonblocking, * hence we have to emulate the behavior. This is done in the input * function by checking against a bit in the state. We set or unset the * bit here to cause the input function to emulate the correct behavior. */ if (mode == TCL_MODE_NONBLOCKING) { infoPtr->flags |= FILE_ASYNC; } else { infoPtr->flags &= ~(FILE_ASYNC); } return 0; } /* *---------------------------------------------------------------------- * * FileCloseProc/FileClose2Proc -- * * Closes the IO channel. * * Results: * 0 if successful, the value of errno if failed. * * Side effects: * Closes the physical channel * *---------------------------------------------------------------------- */ static int FileCloseProc( ClientData instanceData, /* Pointer to FileInfo structure. */ Tcl_Interp *interp) /* Not used. */ { FileInfo *fileInfoPtr = (FileInfo *)instanceData; FileInfo *infoPtr; ThreadSpecificData *tsdPtr; int errorCode = 0; (void)interp; /* * Remove the file from the watch list. */ FileWatchProc(instanceData, 0); /* * Don't close the Win32 handle if the handle is a standard channel during * the thread exit process. Otherwise, one thread may kill the stdio of * another. */ if (!TclInThreadExit() || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle) && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) { if (CloseHandle(fileInfoPtr->handle) == FALSE) { TclWinConvertError(GetLastError()); errorCode = errno; } } /* * See if this FileInfo* is still on the thread local list. */ tsdPtr = TCL_TSD_INIT(&dataKey); for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr == fileInfoPtr) { /* * This channel exists on the thread local list. It should have * been removed by an earlier Threadaction call, but do that now * since just deallocating fileInfoPtr would leave an deallocated * pointer on the thread local list. */ FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE); break; } } ckfree(fileInfoPtr); return errorCode; } static int FileClose2Proc( ClientData instanceData, /* Pointer to FileInfo structure. */ Tcl_Interp *interp, /* Not used. */ int flags) { if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return FileCloseProc(instanceData, interp); } return EINVAL; } /* *---------------------------------------------------------------------- * * FileSeekProc -- * * Seeks on a file-based channel. Returns the new position. * * Results: * -1 if failed, the new position if successful. If failed, it also sets * *errorCodePtr to the error code. * * Side effects: * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ static int FileSeekProc( ClientData instanceData, /* File state. */ long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { FileInfo *infoPtr = (FileInfo *)instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; DWORD moveMethod; *errorCodePtr = 0; if (mode == SEEK_SET) { moveMethod = FILE_BEGIN; } else if (mode == SEEK_CUR) { moveMethod = FILE_CURRENT; } else { moveMethod = FILE_END; } /* * Save our current place in case we need to roll-back the seek. */ oldPosHigh = 0; oldPos = (int)SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); if (oldPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { TclWinConvertError(winError); *errorCodePtr = errno; return -1; } } newPosHigh = (offset < 0 ? -1 : 0); newPos = (int)SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod); if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { TclWinConvertError(winError); *errorCodePtr = errno; return -1; } } /* * Check for expressability in our return type, and roll-back otherwise. */ if (newPosHigh != 0) { *errorCodePtr = EOVERFLOW; SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN); return -1; } return (int) newPos; } /* *---------------------------------------------------------------------- * * FileWideSeekProc -- * * Seeks on a file-based channel. Returns the new position. * * Results: * -1 if failed, the new position if successful. If failed, it also sets * *errorCodePtr to the error code. * * Side effects: * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ static Tcl_WideInt FileWideSeekProc( ClientData instanceData, /* File state. */ Tcl_WideInt offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { FileInfo *infoPtr = (FileInfo *)instanceData; DWORD moveMethod; LONG newPos, newPosHigh; *errorCodePtr = 0; if (mode == SEEK_SET) { moveMethod = FILE_BEGIN; } else if (mode == SEEK_CUR) { moveMethod = FILE_CURRENT; } else { moveMethod = FILE_END; } newPosHigh = Tcl_WideAsLong(offset >> 32); newPos = (int)SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset), &newPosHigh, moveMethod); if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { TclWinConvertError(winError); *errorCodePtr = errno; return -1; } } return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32)); } /* *---------------------------------------------------------------------- * * FileTruncateProc -- * * Truncates a file-based channel. Returns the error code. * * Results: * 0 if successful, POSIX-y error code if it failed. * * Side effects: * Truncates the file, may move file pointers too. * *---------------------------------------------------------------------- */ static int FileTruncateProc( ClientData instanceData, /* File state. */ Tcl_WideInt length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; /* * Save where we were... */ oldPosHigh = 0; oldPos = (int)SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); if (oldPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { TclWinConvertError(winError); return errno; } } /* * Move to where we want to truncate */ newPosHigh = Tcl_WideAsLong(length >> 32); newPos = (int)SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length), &newPosHigh, FILE_BEGIN); if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { TclWinConvertError(winError); return errno; } } /* * Perform the truncation (unlike POSIX ftruncate(), we needed to move to * the location to truncate at first). */ if (!SetEndOfFile(infoPtr->handle)) { TclWinConvertError(GetLastError()); return errno; } /* * Move back. If this last step fails, we don't care; it's just a "best * effort" attempt to restore our file pointer to where it was. */ SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN); return 0; } /* *---------------------------------------------------------------------- * * FileInputProc -- * * Reads input from the IO channel into the buffer given. Returns count * of how many bytes were actually read, and an error indication. * * Results: * A count of how many bytes were read is returned and an error * indication is returned in an output argument. * * Side effects: * Reads input from the actual channel. * *---------------------------------------------------------------------- */ static int FileInputProc( ClientData instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ { FileInfo *infoPtr = (FileInfo *)instanceData; DWORD bytesRead; *errorCode = 0; /* * TODO: This comment appears to be out of date. We *do* have a * console driver, over in tclWinConsole.c. After some Windows * developer confirms, this comment should be revised. * * Note that we will block on reads from a console buffer until a full * line has been entered. The only way I know of to get around this is to * write a console driver. We should probably do this at some point, but * for now, we just block. The same problem exists for files being read * over the network. */ if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead, (LPOVERLAPPED) NULL) != FALSE) { return (int)bytesRead; } TclWinConvertError(GetLastError()); *errorCode = errno; if (errno == EPIPE) { return 0; } return -1; } /* *---------------------------------------------------------------------- * * FileOutputProc -- * * Writes the given output on the IO channel. Returns count of how many * characters were actually written, and an error indication. * * Results: * A count of how many characters were written is returned and an error * indication is returned in an output argument. * * Side effects: * Writes output on the actual channel. * *---------------------------------------------------------------------- */ static int FileOutputProc( ClientData instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { FileInfo *infoPtr = (FileInfo *)instanceData; DWORD bytesWritten; *errorCode = 0; /* * If we are writing to a file that was opened with O_APPEND, we need to * seek to the end of the file before writing the current buffer. */ if (infoPtr->flags & FILE_APPEND) { SetFilePointer(infoPtr->handle, 0, NULL, FILE_END); } if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) { TclWinConvertError(GetLastError()); *errorCode = errno; return -1; } infoPtr->dirty = 1; return (int)bytesWritten; } /* *---------------------------------------------------------------------- * * FileWatchProc -- * * Called by the notifier to set up to watch for events on this channel. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void FileWatchProc( ClientData instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { FileInfo *infoPtr = (FileInfo *)instanceData; Tcl_Time blockTime = { 0, 0 }; /* * Since the file is always ready for events, we set the block time to * zero so we will poll. */ infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { Tcl_SetMaxBlockTime(&blockTime); } } /* *---------------------------------------------------------------------- * * FileGetHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS handles from a file * based channel. * * Results: * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no * handle for the specified direction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int FileGetHandleProc( ClientData instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *)instanceData; if (direction & infoPtr->validMask) { *handlePtr = (ClientData) infoPtr->handle; return TCL_OK; } else { return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * TclpOpenFileChannel -- * * Open an File based channel on Unix systems. * * Results: * The new channel or NULL. If NULL, the output argument errorCodePtr is * set to a POSIX error. * * Side effects: * May open the channel and may cause creation of a file on the file * system. * *---------------------------------------------------------------------- */ Tcl_Channel TclpOpenFileChannel( Tcl_Interp *interp, /* Interpreter for error reporting; can be * NULL. */ Tcl_Obj *pathPtr, /* Name of file to open. */ int mode, /* POSIX mode. */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { Tcl_Channel channel = 0; int channelPermissions = 0; DWORD accessMode = 0, createMode, shareMode, flags; const WCHAR *nativeName; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; TclFile readFile = NULL, writeFile = NULL; nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), "\": filename is invalid on this platform", NULL); } return NULL; } switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { case O_RDONLY: accessMode = GENERIC_READ; channelPermissions = TCL_READABLE; break; case O_WRONLY: accessMode = GENERIC_WRITE; channelPermissions = TCL_WRITABLE; break; case O_RDWR: accessMode = (GENERIC_READ | GENERIC_WRITE); channelPermissions = (TCL_READABLE | TCL_WRITABLE); break; default: Tcl_Panic("TclpOpenFileChannel: invalid mode value"); break; } /* * Map the creation flags to the NT create mode. */ switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) { case (O_CREAT | O_EXCL): case (O_CREAT | O_EXCL | O_TRUNC): createMode = CREATE_NEW; break; case (O_CREAT | O_TRUNC): createMode = CREATE_ALWAYS; break; case O_CREAT: createMode = OPEN_ALWAYS; break; case O_TRUNC: case (O_TRUNC | O_EXCL): createMode = TRUNCATE_EXISTING; break; default: createMode = OPEN_EXISTING; break; } /* * [2413550] Avoid double-open of serial ports on Windows * Special handling for Windows serial ports by a "name-hint" * to directly open it with the OVERLAPPED flag set. */ if( NativeIsComPort(nativeName) ) { handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "couldn't open serial \"", TclGetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL); } return NULL; } /* * For natively-named Windows serial ports we are done. */ channel = TclWinOpenSerialChannel(handle, channelName, channelPermissions); return channel; } /* * If the file is being created, get the file attributes from the * permissions argument, else use the existing file attributes. */ if (mode & O_CREAT) { if (permissions & S_IWRITE) { flags = FILE_ATTRIBUTE_NORMAL; } else { flags = FILE_ATTRIBUTE_READONLY; } } else { flags = GetFileAttributesW(nativeName); if (flags == 0xFFFFFFFF) { flags = 0; } } /* * Set up the file sharing mode. We want to allow simultaneous access. */ shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE; /* * Now we get to create the file. */ handle = CreateFileW(nativeName, accessMode, shareMode, NULL, createMode, flags, (HANDLE) NULL); if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) { err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } TclWinConvertError(err); if (interp != (Tcl_Interp *) NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": %s", TclGetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } channel = NULL; switch (FileGetType(handle)) { case FILE_TYPE_SERIAL: /* * Natively named serial ports "com1-9", "\\\\.\\comXX" are * already done with the code above. * Here we handle all other serial port names. * * Reopen channel for OVERLAPPED operation. Normally this shouldn't * fail, because the channel exists. */ handle = TclWinSerialOpen(handle, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); if (interp != (Tcl_Interp *) NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't reopen serial \"%s\": %s", TclGetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } channel = TclWinOpenSerialChannel(handle, channelName, channelPermissions); break; case FILE_TYPE_CONSOLE: channel = TclWinOpenConsoleChannel(handle, channelName, channelPermissions); break; case FILE_TYPE_PIPE: if (channelPermissions & TCL_READABLE) { readFile = TclWinMakeFile(handle); } if (channelPermissions & TCL_WRITABLE) { writeFile = TclWinMakeFile(handle); } channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL); break; case FILE_TYPE_CHAR: case FILE_TYPE_DISK: case FILE_TYPE_UNKNOWN: channel = OpenFileChannel(handle, channelName, channelPermissions, (mode & O_APPEND) ? FILE_APPEND : 0); break; default: /* * The handle is of an unknown type, probably /dev/nul equivalent or * possibly a closed handle. */ channel = NULL; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": bad file type", TclGetString(pathPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE", NULL); break; } return channel; } /* *---------------------------------------------------------------------- * * Tcl_MakeFileChannel -- * * Creates a Tcl_Channel from an existing platform specific file handle. * * Results: * The Tcl_Channel created around the preexisting file. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeFileChannel( ClientData rawHandle, /* OS level handle */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__) TCLEXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; Tcl_Channel channel = NULL; HANDLE handle = (HANDLE) rawHandle; HANDLE dupedHandle; TclFile readFile = NULL, writeFile = NULL; BOOL result; if (mode == 0) { return NULL; } switch (FileGetType(handle)) { case FILE_TYPE_SERIAL: channel = TclWinOpenSerialChannel(handle, channelName, mode); break; case FILE_TYPE_CONSOLE: channel = TclWinOpenConsoleChannel(handle, channelName, mode); break; case FILE_TYPE_PIPE: if (mode & TCL_READABLE) { readFile = TclWinMakeFile(handle); } if (mode & TCL_WRITABLE) { writeFile = TclWinMakeFile(handle); } channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL); break; case FILE_TYPE_DISK: case FILE_TYPE_CHAR: channel = OpenFileChannel(handle, channelName, mode, 0); break; case FILE_TYPE_UNKNOWN: default: /* * The handle is of an unknown type. Test the validity of this OS * handle by duplicating it, then closing the dupe. The Win32 API * doesn't provide an IsValidHandle() function, so we have to emulate * it here. This test will not work on a console handle reliably, * which is why we can't test every handle that comes into this * function in this way. */ result = DuplicateHandle(GetCurrentProcess(), handle, GetCurrentProcess(), &dupedHandle, 0, FALSE, DUPLICATE_SAME_ACCESS); if (result == 0) { /* * Unable to make a duplicate. It's definitely invalid at this * point. */ return NULL; } /* * Use structured exception handling (Win32 SEH) to protect the close * of this duped handle which might throw EXCEPTION_INVALID_HANDLE. */ result = 0; #if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__) /* * Don't have SEH available, do things the hard way. Note that this * needs to be one block of asm, to avoid stack imbalance; also, it is * illegal for one asm block to contain a jump to another. */ __asm__ __volatile__ ( /* * Pick up parameters before messing with the stack */ "movl %[dupedHandle], %%ebx" "\n\t" /* * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * CloseHandle. */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" /* * Call CloseHandle(dupedHandle). */ "pushl %%ebx" "\n\t" "call _CloseHandle@4" "\n\t" /* * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION * and put a TRUE status return into it. */ "movl %%fs:0, %%edx" "\n\t" "movl $1, %%eax" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" /* * Come here however we exited. Restore context from the * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xC(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [registration] "m" (registration), [dupedHandle] "m" (dupedHandle) : "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" ); result = registration.status; #else #ifndef HAVE_NO_SEH __try { #endif CloseHandle(dupedHandle); result = 1; #ifndef HAVE_NO_SEH } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif #endif if (result == FALSE) { return NULL; } /* * Fall through, the handle is valid. * * Create the undefined channel, anyways, because we know the handle * is valid to something. */ channel = OpenFileChannel(handle, channelName, mode, 0); } return channel; } /* *---------------------------------------------------------------------- * * TclpGetDefaultStdChannel -- * * Constructs a channel for the specified standard OS handle. * * Results: * Returns the specified default standard channel, or NULL. * * Side effects: * May cause the creation of a standard channel and the underlying file. * *---------------------------------------------------------------------- */ Tcl_Channel TclpGetDefaultStdChannel( int type) /* One of TCL_STDIN, TCL_STDOUT, or * TCL_STDERR. */ { Tcl_Channel channel; HANDLE handle; int mode = -1; const char *bufMode = NULL; DWORD handleId = (DWORD) -1; /* Standard handle to retrieve. */ switch (type) { case TCL_STDIN: handleId = STD_INPUT_HANDLE; mode = TCL_READABLE; bufMode = "line"; break; case TCL_STDOUT: handleId = STD_OUTPUT_HANDLE; mode = TCL_WRITABLE; bufMode = "line"; break; case TCL_STDERR: handleId = STD_ERROR_HANDLE; mode = TCL_WRITABLE; bufMode = "none"; break; default: Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type"); break; } handle = GetStdHandle(handleId); /* * Note that we need to check for 0 because Windows may return 0 if this * is not a console mode application, even though this is not a valid * handle. */ if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) { return (Tcl_Channel) NULL; } channel = Tcl_MakeFileChannel(handle, mode); if (channel == NULL) { return (Tcl_Channel) NULL; } /* * Set up the normal channel options for stdio handles. */ if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK || Tcl_SetChannelOption(NULL,channel,"-eofchar","\032 {}")!=TCL_OK || Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) { Tcl_Close(NULL, channel); return (Tcl_Channel) NULL; } return channel; } /* *---------------------------------------------------------------------- * * OpenFileChannel -- * * Constructs a File channel for the specified standard OS handle. This * is a helper function to break up the construction of channels into * File, Console, or Serial. * * Results: * Returns the new channel, or NULL. * * Side effects: * May open the channel and may cause creation of a file on the file * system. * *---------------------------------------------------------------------- */ Tcl_Channel OpenFileChannel( HANDLE handle, /* Win32 HANDLE to swallow */ char *channelName, /* Buffer to receive channel name */ int permissions, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION, indicating * which operations are valid on the file. */ int appendMode) /* OR'ed combination of bits indicating what * additional configuration of the channel is * present. */ { FileInfo *infoPtr; ThreadSpecificData *tsdPtr = FileInit(); /* * See if a channel with this handle already exists. */ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL; } } infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo)); /* * TIP #218. Removed the code inserting the new structure into the global * list. This is now handled in the thread action callbacks, and only * there. */ infoPtr->nextPtr = NULL; infoPtr->validMask = permissions; infoPtr->watchMask = 0; infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, infoPtr, permissions); /* * Files have default translation of AUTO and ^Z eof char, which means * that a ^Z will be accepted as EOF when reading. */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } /* *---------------------------------------------------------------------- * * TclWinFlushDirtyChannels -- * * Flush all dirty channels to disk, so that requesting the size of any * file returns the correct value. * * Results: * None. * * Side effects: * Information is actually written to disk now, rather than later. Don't * call this too often, or there will be a performance hit (i.e. only * call when we need to ask for the size of a file). * *---------------------------------------------------------------------- */ void TclWinFlushDirtyChannels(void) { FileInfo *infoPtr; ThreadSpecificData *tsdPtr = FileInit(); /* * Flush all channels which are dirty, i.e. may have data pending in the * OS. */ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->dirty) { FlushFileBuffers(infoPtr->handle); infoPtr->dirty = 0; } } } /* *---------------------------------------------------------------------- * * FileThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void FileThreadActionProc( ClientData instanceData, int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileInfo *infoPtr = ( FileInfo *)instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { infoPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = infoPtr; } else { FileInfo **nextPtrPtr; int removed = 0; for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } } /* * This could happen if the channel was created in one thread and then * moved to another without updating the thread local data in each * thread. */ if (!removed) { Tcl_Panic("file info ptr not on thread channel list"); } } } /* *---------------------------------------------------------------------- * * FileGetType -- * * Given a file handle, return its type * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DWORD FileGetType( HANDLE handle) /* Opened file handle */ { DWORD type; type = GetFileType(handle); /* * If the file is a character device, we need to try to figure out whether * it is a serial port, a console, or something else. We test for the * console case first because this is more common. */ if ((type == FILE_TYPE_CHAR) || ((type == FILE_TYPE_UNKNOWN) && !GetLastError())) { DWORD consoleParams; if (GetConsoleMode(handle, &consoleParams)) { type = FILE_TYPE_CONSOLE; } else { DCB dcb; dcb.DCBlength = sizeof(DCB); if (GetCommState(handle, &dcb)) { type = FILE_TYPE_SERIAL; } } } return type; } /* *---------------------------------------------------------------------- * * NativeIsComPort -- * * Determines if a path refers to a Windows serial port. * A simple and efficient solution is to use a "name hint" to detect * COM ports by their filename instead of resorting to a syscall * to detect serialness after the fact. * The following patterns cover common serial port names: * COM[1-9] * \\.\COM[0-9]+ * * Results: * 1 = serial port, 0 = not. * *---------------------------------------------------------------------- */ static int NativeIsComPort( const WCHAR *nativePath) /* Path of file to access, native encoding. */ { const WCHAR *p = (const WCHAR *) nativePath; int i, len = (int)wcslen(p); /* * 1. Look for com[1-9]:? */ if ( (len == 4) && (_wcsnicmp(p, L"com", 3) == 0) ) { /* * The 4th character must be a digit 1..9 */ if ( (p[3] < L'1') || (p[3] > L'9') ) { return 0; } return 1; } /* * 2. Look for \\.\com[0-9]+ */ if ((len >= 8) && (_wcsnicmp(p, L"\\\\.\\com", 7) == 0)) { /* * Charaters 8..end must be a digits 0..9 */ for ( i=7; i '9') ) { return 0; } } return 1; } return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinConsole.c0000644000175000017500000011303214565156356015401 0ustar sergeisergei/* * tclWinConsole.c -- * * This file implements the Windows-specific console functions, and the * "console" channel driver. * * Copyright (c) 1999 by Scriptics Corp. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" /* * The following variable is used to tell whether this module has been * initialized. */ static int initialized = 0; /* * The consoleMutex locks around access to the initialized variable, and it is * used to protect background threads from being terminated while they are * using APIs that hold locks. */ TCL_DECLARE_MUTEX(consoleMutex) /* * Bit masks used in the flags field of the ConsoleInfo structure below. */ #define CONSOLE_PENDING (1<<0) /* Message is pending in the queue. */ #define CONSOLE_ASYNC (1<<1) /* Channel is non-blocking. */ /* * Bit masks used in the sharedFlags field of the ConsoleInfo structure below. */ #define CONSOLE_EOF (1<<2) /* Console has reached EOF. */ #define CONSOLE_BUFFERED (1<<3) /* Data was read into a buffer by the reader * thread. */ #define CONSOLE_BUFFER_SIZE (8*1024) /* * Structure containing handles associated with one of the special console * threads. */ typedef struct ConsoleThreadInfo { HANDLE thread; /* Handle to reader or writer thread. */ HANDLE readyEvent; /* Manual-reset event to signal _to_ the main * thread when the worker thread has finished * waiting for its normal work to happen. */ TclPipeThreadInfo *TI; /* Thread info structure of writer and reader. */ } ConsoleThreadInfo; /* * This structure describes per-instance data for a console based channel. */ typedef struct ConsoleInfo { HANDLE handle; int type; struct ConsoleInfo *nextPtr;/* Pointer to next registered console. */ Tcl_Channel channel; /* Pointer to channel structure. */ int validMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ int watchMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which events should be reported. */ int flags; /* State flags, see above for a list. */ Tcl_ThreadId threadId; /* Thread to which events should be reported. * This value is used by the reader/writer * threads. */ ConsoleThreadInfo writer; /* A specialized thread for handling * asynchronous writes to the console; the * waiting starts when a control event is sent, * and a reset event is sent back to the main * thread when the write is done. */ ConsoleThreadInfo reader; /* A specialized thread for handling * asynchronous reads from the console; the * waiting starts when a control event is sent, * and a reset event is sent back to the main * thread when input is available. */ DWORD writeError; /* An error caused by the last background * write. Set to 0 if no error has been * detected. This word is shared with the * writer thread so access must be * synchronized with the writable object. */ char *writeBuf; /* Current background output buffer. Access is * synchronized with the writable object. */ int writeBufLen; /* Size of write buffer. Access is * synchronized with the writable object. */ int toWrite; /* Current amount to be written. Access is * synchronized with the writable object. */ int readFlags; /* Flags that are shared with the reader * thread. Access is synchronized with the * readable object. */ int bytesRead; /* Number of bytes in the buffer. */ int offset; /* Number of bytes read out of the buffer. */ char buffer[CONSOLE_BUFFER_SIZE]; /* Data consumed by reader thread. */ } ConsoleInfo; typedef struct ThreadSpecificData { /* * The following pointer refers to the head of the list of consoles that * are being watched for file events. */ ConsoleInfo *firstConsolePtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following structure is what is added to the Tcl event queue when * console events are generated. */ typedef struct ConsoleEvent { Tcl_Event header; /* Information that is standard for all * events. */ ConsoleInfo *infoPtr; /* Pointer to console info structure. Note * that we still have to verify that the * console exists before dereferencing this * pointer. */ } ConsoleEvent; /* * Declarations for functions used only in this file. */ static int ConsoleBlockModeProc(ClientData instanceData, int mode); static void ConsoleCheckProc(ClientData clientData, int flags); static int ConsoleCloseProc(ClientData instanceData, Tcl_Interp *interp); static int ConsoleClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags); static int ConsoleEventProc(Tcl_Event *evPtr, int flags); static void ConsoleExitHandler(ClientData clientData); static int ConsoleGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static void ConsoleInit(void); static int ConsoleInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int ConsoleOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static DWORD WINAPI ConsoleReaderThread(LPVOID arg); static void ConsoleSetupProc(ClientData clientData, int flags); static void ConsoleWatchProc(ClientData instanceData, int mask); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); static void ProcExitHandler(ClientData clientData); static int WaitForRead(ConsoleInfo *infoPtr, int blocking); static void ConsoleThreadActionProc(ClientData instanceData, int action); static BOOL ReadConsoleBytes(HANDLE hConsole, LPVOID lpBuffer, DWORD nbytes, LPDWORD nbytesread); static BOOL WriteConsoleBytes(HANDLE hConsole, const void *lpBuffer, DWORD nbytes, LPDWORD nbyteswritten); /* * This structure describes the channel type structure for command console * based IO. */ static const Tcl_ChannelType consoleChannelType = { "console", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ ConsoleCloseProc, /* Close proc. */ ConsoleInputProc, /* Input proc. */ ConsoleOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ ConsoleWatchProc, /* Set up notifier to watch the channel. */ ConsoleGetHandleProc, /* Get an OS handle from channel. */ ConsoleClose2Proc, /* close2proc. */ ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ NULL, /* Flush proc. */ NULL, /* Handler proc. */ NULL, /* Wide seek proc. */ ConsoleThreadActionProc, /* Thread action proc. */ NULL /* Truncation proc. */ }; /* *---------------------------------------------------------------------- * * ReadConsoleBytes, WriteConsoleBytes -- * * Wrapper for ReadConsoleW, that takes and returns number of bytes * instead of number of WCHARS. * *---------------------------------------------------------------------- */ static BOOL ReadConsoleBytes( HANDLE hConsole, LPVOID lpBuffer, DWORD nbytes, LPDWORD nbytesread) { DWORD ntchars; BOOL result; /* * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return * success with ntchars == 0 and GetLastError() will be * ERROR_OPERATION_ABORTED. We do not want to treat this case * as EOF so we will loop around again. If no Ctrl signal handlers * have been established, the default signal OS handler in a separate * thread will terminate the program. If a Ctrl signal handler * has been established (through an extension for example), it * will run and take whatever action it deems appropriate. */ do { result = ReadConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, NULL); } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED); if (nbytesread != NULL) { *nbytesread = ntchars * sizeof(WCHAR); } return result; } static BOOL WriteConsoleBytes( HANDLE hConsole, const void *lpBuffer, DWORD nbytes, LPDWORD nbyteswritten) { DWORD ntchars; BOOL result; result = WriteConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, NULL); if (nbyteswritten != NULL) { *nbyteswritten = ntchars * sizeof(WCHAR); } return result; } /* *---------------------------------------------------------------------- * * ConsoleInit -- * * This function initializes the static variables for this file. * * Results: * None. * * Side effects: * Creates a new event source. * *---------------------------------------------------------------------- */ static void ConsoleInit(void) { /* * Check the initialized flag first, then check again in the mutex. This * is a speed enhancement. */ if (!initialized) { Tcl_MutexLock(&consoleMutex); if (!initialized) { initialized = 1; Tcl_CreateExitHandler(ProcExitHandler, NULL); } Tcl_MutexUnlock(&consoleMutex); } if (TclThreadDataKeyGet(&dataKey) == NULL) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->firstConsolePtr = NULL; Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL); } } /* *---------------------------------------------------------------------- * * ConsoleExitHandler -- * * This function is called to cleanup the console module before Tcl is * unloaded. * * Results: * None. * * Side effects: * Removes the console event source. * *---------------------------------------------------------------------- */ static void ConsoleExitHandler( ClientData clientData) /* Old window proc. */ { (void)clientData; Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); } /* *---------------------------------------------------------------------- * * ProcExitHandler -- * * This function is called to cleanup the process list before Tcl is * unloaded. * * Results: * None. * * Side effects: * Resets the process list. * *---------------------------------------------------------------------- */ static void ProcExitHandler( ClientData clientData) /* Old window proc. */ { (void)clientData; Tcl_MutexLock(&consoleMutex); initialized = 0; Tcl_MutexUnlock(&consoleMutex); } /* *---------------------------------------------------------------------- * * ConsoleSetupProc -- * * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an * event. * * Results: * None. * * Side effects: * Adjusts the block time if needed. * *---------------------------------------------------------------------- */ void ConsoleSetupProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; int block = 1; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)data; if (!(flags & TCL_FILE_EVENTS)) { return; } /* * Look to see if any events are already pending. If they are, poll. */ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask & TCL_WRITABLE) { if (WaitForSingleObject(infoPtr->writer.readyEvent, 0) != WAIT_TIMEOUT) { block = 0; } } if (infoPtr->watchMask & TCL_READABLE) { if (WaitForRead(infoPtr, 0) >= 0) { block = 0; } } } if (!block) { Tcl_SetMaxBlockTime(&blockTime); } } /* *---------------------------------------------------------------------- * * ConsoleCheckProc -- * * This procedure is called by Tcl_DoOneEvent to check the console event * source for events. * * Results: * None. * * Side effects: * May queue an event. * *---------------------------------------------------------------------- */ static void ConsoleCheckProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleInfo *infoPtr; int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return; } /* * Queue events for any ready consoles that don't already have events * queued. */ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->flags & CONSOLE_PENDING) { continue; } /* * Queue an event if the console is signaled for reading or writing. */ needEvent = 0; if (infoPtr->watchMask & TCL_WRITABLE) { if (WaitForSingleObject(infoPtr->writer.readyEvent, 0) != WAIT_TIMEOUT) { needEvent = 1; } } if (infoPtr->watchMask & TCL_READABLE) { if (WaitForRead(infoPtr, 0) >= 0) { needEvent = 1; } } if (needEvent) { ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent)); infoPtr->flags |= CONSOLE_PENDING; evPtr->header.proc = ConsoleEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } } /* *---------------------------------------------------------------------- * * ConsoleBlockModeProc -- * * Set blocking or non-blocking mode on channel. * * Results: * 0 if successful, errno when failed. * * Side effects: * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ static int ConsoleBlockModeProc( ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; /* * Consoles on Windows can not be switched between blocking and * nonblocking, hence we have to emulate the behavior. This is done in the * input function by checking against a bit in the state. We set or unset * the bit here to cause the input function to emulate the correct * behavior. */ if (mode == TCL_MODE_NONBLOCKING) { infoPtr->flags |= CONSOLE_ASYNC; } else { infoPtr->flags &= ~CONSOLE_ASYNC; } return 0; } /* *---------------------------------------------------------------------- * * ConsoleCloseProc/ConsoleClose2Proc -- * * Closes a console based IO channel. * * Results: * 0 on success, errno otherwise. * * Side effects: * Closes the physical channel. * *---------------------------------------------------------------------- */ static int ConsoleCloseProc( ClientData instanceData, /* Pointer to ConsoleInfo structure. */ Tcl_Interp *interp) /* For error reporting. */ { ConsoleInfo *consolePtr = (ConsoleInfo *)instanceData; int errorCode = 0; ConsoleInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Clean up the background thread if necessary. Note that this must be * done before we can close the file, since the thread may be blocking * trying to read from the console. */ if (consolePtr->reader.thread) { TclPipeThreadStop(&consolePtr->reader.TI, consolePtr->reader.thread); CloseHandle(consolePtr->reader.thread); CloseHandle(consolePtr->reader.readyEvent); consolePtr->reader.thread = NULL; } consolePtr->validMask &= ~TCL_READABLE; /* * Wait for the writer thread to finish the current buffer, then terminate * the thread and close the handles. If the channel is nonblocking, there * should be no pending write operations. */ if (consolePtr->writer.thread) { if (consolePtr->toWrite) { /* * We only need to wait if there is something to write. This may * prevent infinite wait on exit. [Python Bug 216289] */ WaitForSingleObject(consolePtr->writer.readyEvent, 5000); } TclPipeThreadStop(&consolePtr->writer.TI, consolePtr->writer.thread); CloseHandle(consolePtr->writer.thread); CloseHandle(consolePtr->writer.readyEvent); consolePtr->writer.thread = NULL; } consolePtr->validMask &= ~TCL_WRITABLE; /* * Don't close the Win32 handle if the handle is a standard channel during * the thread exit process. Otherwise, one thread may kill the stdio of * another. */ if (!TclInThreadExit() || ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle) && (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) { if (CloseHandle(consolePtr->handle) == FALSE) { TclWinConvertError(GetLastError()); errorCode = errno; } } consolePtr->watchMask &= consolePtr->validMask; /* * Remove the file from the list of watched files. */ for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr; infoPtr != NULL; nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { if (infoPtr == (ConsoleInfo *) consolePtr) { *nextPtrPtr = infoPtr->nextPtr; break; } } if (consolePtr->writeBuf != NULL) { ckfree(consolePtr->writeBuf); consolePtr->writeBuf = 0; } ckfree(consolePtr); return errorCode; } static int ConsoleClose2Proc( ClientData instanceData, /* Pointer to ConsoleInfo structure. */ Tcl_Interp *interp, /* For error reporting. */ int flags) { if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return ConsoleCloseProc(instanceData, interp); } return EINVAL; } /* *---------------------------------------------------------------------- * * ConsoleInputProc -- * * Reads input from the IO channel into the buffer given. Returns count * of how many bytes were actually read, and an error indication. * * Results: * A count of how many bytes were read is returned and an error * indication is returned in an output argument. * * Side effects: * Reads input from the actual channel. * *---------------------------------------------------------------------- */ static int ConsoleInputProc( ClientData instanceData, /* Console state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; DWORD count, bytesRead = 0; int result; *errorCode = 0; /* * Synchronize with the reader thread. */ result = WaitForRead(infoPtr, (infoPtr->flags & CONSOLE_ASYNC) ? 0 : 1); /* * If an error occurred, return immediately. */ if (result == -1) { *errorCode = errno; return -1; } if (infoPtr->readFlags & CONSOLE_BUFFERED) { /* * Data is stored in the buffer. */ if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) { memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize); bytesRead = bufSize; infoPtr->offset += bufSize; } else { memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize); bytesRead = infoPtr->bytesRead - infoPtr->offset; /* * Reset the buffer. */ infoPtr->readFlags &= ~CONSOLE_BUFFERED; infoPtr->offset = 0; } return bytesRead; } /* * Attempt to read bufSize bytes. The read will return immediately if * there is any data available. Otherwise it will block until at least one * byte is available or an EOF occurs. */ if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count) == TRUE) { /* * TODO: This potentially writes beyond the limits specified * by the caller. In practice this is harmless, since all writes * are into ChannelBuffers, and those have padding, but still * ought to remove this, unless some Windows wizard can give * a reason not to. */ buf[count] = '\0'; return count; } return -1; } /* *---------------------------------------------------------------------- * * ConsoleOutputProc -- * * Writes the given output on the IO channel. Returns count of how many * characters were actually written, and an error indication. * * Results: * A count of how many characters were written is returned and an error * indication is returned in an output argument. * * Side effects: * Writes output on the actual channel. * *---------------------------------------------------------------------- */ static int ConsoleOutputProc( ClientData instanceData, /* Console state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; ConsoleThreadInfo *threadInfo = &infoPtr->writer; DWORD bytesWritten, timeout; *errorCode = 0; /* avoid blocking if pipe-thread exited */ timeout = (infoPtr->flags & CONSOLE_ASYNC) || !TclPipeThreadIsAlive(&threadInfo->TI) || TclInExit() || TclInThreadExit() ? 0 : INFINITE; if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) { /* * The writer thread is blocked waiting for a write to complete and * the channel is in non-blocking mode. */ errno = EWOULDBLOCK; goto error; } /* * Check for a background error on the last write. */ if (infoPtr->writeError) { TclWinConvertError(infoPtr->writeError); infoPtr->writeError = 0; goto error; } if (infoPtr->flags & CONSOLE_ASYNC) { /* * The console is non-blocking, so copy the data into the output * buffer and restart the writer thread. */ if (toWrite > infoPtr->writeBufLen) { /* * Reallocate the buffer to be large enough to hold the data. */ if (infoPtr->writeBuf) { ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; ResetEvent(threadInfo->readyEvent); TclPipeThreadSignal(&threadInfo->TI); bytesWritten = toWrite; } else { /* * In the blocking case, just try to write the buffer directly. This * avoids an unnecessary copy. */ if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite, &bytesWritten) == FALSE) { TclWinConvertError(GetLastError()); goto error; } } return bytesWritten; error: *errorCode = errno; return -1; } /* *---------------------------------------------------------------------- * * ConsoleEventProc -- * * This function is invoked by Tcl_ServiceEvent when a file event reaches * the front of the event queue. This procedure invokes Tcl_NotifyChannel * on the console. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the notifier callback does. * *---------------------------------------------------------------------- */ static int ConsoleEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { ConsoleEvent *consoleEvPtr = (ConsoleEvent *) evPtr; ConsoleInfo *infoPtr; int mask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return 0; } /* * Search through the list of watched consoles for the one whose handle * matches the event. We do this rather than simply dereferencing the * handle in the event so that consoles can be deleted while the event is * in the queue. */ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (consoleEvPtr->infoPtr == infoPtr) { infoPtr->flags &= ~CONSOLE_PENDING; break; } } /* * Remove stale events. */ if (!infoPtr) { return 1; } /* * Check to see if the console is readable. Note that we can't tell if a * console is writable, so we always report it as being writable unless we * have detected EOF. */ mask = 0; if (infoPtr->watchMask & TCL_WRITABLE) { if (WaitForSingleObject(infoPtr->writer.readyEvent, 0) != WAIT_TIMEOUT) { mask = TCL_WRITABLE; } } if (infoPtr->watchMask & TCL_READABLE) { if (WaitForRead(infoPtr, 0) >= 0) { if (infoPtr->readFlags & CONSOLE_EOF) { mask = TCL_READABLE; } else { mask |= TCL_READABLE; } } } /* * Inform the channel of the events. */ Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask); return 1; } /* *---------------------------------------------------------------------- * * ConsoleWatchProc -- * * Called by the notifier to set up to watch for events on this channel. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void ConsoleWatchProc( ClientData instanceData, /* Console state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { ConsoleInfo **nextPtrPtr, *ptr; ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; int oldMask = infoPtr->watchMask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Since most of the work is handled by the background threads, we just * need to update the watchMask and then force the notifier to poll once. */ infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; if (!oldMask) { infoPtr->nextPtr = tsdPtr->firstConsolePtr; tsdPtr->firstConsolePtr = infoPtr; } Tcl_SetMaxBlockTime(&blockTime); } else if (oldMask) { /* * Remove the console from the list of watched consoles. */ for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr; ptr != NULL; nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { if (infoPtr == ptr) { *nextPtrPtr = ptr->nextPtr; break; } } } } /* *---------------------------------------------------------------------- * * ConsoleGetHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a * command consoleline based channel. * * Results: * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no * handle for the specified direction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ConsoleGetHandleProc( ClientData instanceData, /* The console state. */ int direction, /* TCL_READABLE or TCL_WRITABLE. */ ClientData *handlePtr) /* Where to store the handle. */ { ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; (void)direction; *handlePtr = infoPtr->handle; return TCL_OK; } /* *---------------------------------------------------------------------- * * WaitForRead -- * * Wait until some data is available, the console is at EOF or the reader * thread is blocked waiting for data (if the channel is in non-blocking * mode). * * Results: * Returns 1 if console is readable. Returns 0 if there is no data on the * console, but there is buffered data. Returns -1 if an error occurred. * If an error occurred, the threads may not be synchronized. * * Side effects: * Updates the shared state flags. If no error occurred, the reader * thread is blocked waiting for a signal from the main thread. * *---------------------------------------------------------------------- */ static int WaitForRead( ConsoleInfo *infoPtr, /* Console state. */ int blocking) /* Indicates whether call should be blocking * or not. */ { DWORD timeout, count; HANDLE *handle = (HANDLE *)infoPtr->handle; ConsoleThreadInfo *threadInfo = &infoPtr->reader; INPUT_RECORD input; while (1) { /* * Synchronize with the reader thread. */ /* avoid blocking if pipe-thread exited */ timeout = (!blocking || !TclPipeThreadIsAlive(&threadInfo->TI) || TclInExit() || TclInThreadExit()) ? 0 : INFINITE; if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) { /* * The reader thread is blocked waiting for data and the channel * is in non-blocking mode. */ errno = EWOULDBLOCK; return -1; } /* * At this point, the two threads are synchronized, so it is safe to * access shared state. */ /* * If the console has hit EOF, it is always readable. */ if (infoPtr->readFlags & CONSOLE_EOF) { return 1; } if (PeekConsoleInputW(handle, &input, 1, &count) == FALSE) { /* * Check to see if the peek failed because of EOF. */ TclWinConvertError(GetLastError()); if (errno == EOF) { infoPtr->readFlags |= CONSOLE_EOF; return 1; } /* * Ignore errors if there is data in the buffer. */ if (infoPtr->readFlags & CONSOLE_BUFFERED) { return 0; } else { return -1; } } /* * If there is data in the buffer, the console must be readable (since * it is a line-oriented device). */ if (infoPtr->readFlags & CONSOLE_BUFFERED) { return 1; } /* * There wasn't any data available, so reset the thread and try again. */ ResetEvent(threadInfo->readyEvent); TclPipeThreadSignal(&threadInfo->TI); } } /* *---------------------------------------------------------------------- * * ConsoleReaderThread -- * * This function runs in a separate thread and waits for input to become * available on a console. * * Results: * None. * * Side effects: * Signals the main thread when input become available. May cause the * main thread to wake up by posting a message. May one line from the * console for each wait operation. * *---------------------------------------------------------------------- */ static DWORD WINAPI ConsoleReaderThread( LPVOID arg) { TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg; ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */ HANDLE handle = NULL; ConsoleThreadInfo *threadInfo = NULL; int done = 0; while (!done) { /* * Wait for the main thread to signal before attempting to read. */ if (!TclPipeThreadWaitForSignal(&pipeTI)) { /* exit */ break; } if (!infoPtr) { infoPtr = (ConsoleInfo *)pipeTI->clientData; handle = infoPtr->handle; threadInfo = &infoPtr->reader; } /* * Look for data on the console, but first ignore any events that are * not KEY_EVENTs. */ if (ReadConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE, (LPDWORD) &infoPtr->bytesRead) != FALSE) { /* * Data was stored in the buffer. */ infoPtr->readFlags |= CONSOLE_BUFFERED; } else { DWORD err = GetLastError(); if (err == (DWORD) EOF) { infoPtr->readFlags = CONSOLE_EOF; } done = 1; } /* * Signal the main thread by signalling the readable event and then * waking up the notifier thread. */ SetEvent(threadInfo->readyEvent); /* * Alert the foreground thread. Note that we need to treat this like a * critical section so the foreground thread does not terminate this * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&consoleMutex); if (infoPtr->threadId != NULL) { /* * TIP #218. When in flight ignore the event, no one will receive * it anyway. */ Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&consoleMutex); } /* Worker exit, so inform the main thread or free TI-structure (if owned) */ TclPipeThreadExit(&pipeTI); return 0; } /* *---------------------------------------------------------------------- * * ConsoleWriterThread -- * * This function runs in a separate thread and writes data onto a * console. * * Results: * Always returns 0. * * Side effects: * Signals the main thread when an output operation is completed. May * cause the main thread to wake up by posting a message. * *---------------------------------------------------------------------- */ static DWORD WINAPI ConsoleWriterThread( LPVOID arg) { TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg; ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */ HANDLE handle = NULL; ConsoleThreadInfo *threadInfo = NULL; DWORD count, toWrite; char *buf; int done = 0; while (!done) { /* * Wait for the main thread to signal before attempting to write. */ if (!TclPipeThreadWaitForSignal(&pipeTI)) { /* exit */ break; } if (!infoPtr) { infoPtr = (ConsoleInfo *)pipeTI->clientData; handle = infoPtr->handle; threadInfo = &infoPtr->writer; } buf = infoPtr->writeBuf; toWrite = infoPtr->toWrite; /* * Loop until all of the bytes are written or an error occurs. */ while (toWrite > 0) { if (WriteConsoleBytes(handle, buf, (DWORD) toWrite, &count) == FALSE) { infoPtr->writeError = GetLastError(); done = 1; break; } toWrite -= count; buf += count; } /* * Signal the main thread by signalling the writable event and then * waking up the notifier thread. */ SetEvent(threadInfo->readyEvent); /* * Alert the foreground thread. Note that we need to treat this like a * critical section so the foreground thread does not terminate this * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&consoleMutex); if (infoPtr->threadId != NULL) { /* * TIP #218. When in flight ignore the event, no one will receive * it anyway. */ Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&consoleMutex); } /* Worker exit, so inform the main thread or free TI-structure (if owned) */ TclPipeThreadExit(&pipeTI); return 0; } /* *---------------------------------------------------------------------- * * TclWinOpenConsoleChannel -- * * Constructs a Console channel for the specified standard OS handle. * This is a helper function to break up the construction of channels * into File, Console, or Serial. * * Results: * Returns the new channel, or NULL. * * Side effects: * May open the channel. * *---------------------------------------------------------------------- */ Tcl_Channel TclWinOpenConsoleChannel( HANDLE handle, char *channelName, int permissions) { ConsoleInfo *infoPtr; DWORD modes; ConsoleInit(); /* * See if a channel with this handle already exists. */ infoPtr = (ConsoleInfo *)ckalloc(sizeof(ConsoleInfo)); memset(infoPtr, 0, sizeof(ConsoleInfo)); infoPtr->validMask = permissions; infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; infoPtr->threadId = Tcl_GetCurrentThread(); /* * Use the pointer for the name of the result channel. This keeps the * channel names unique, since some may share handles (stdin/stdout/stderr * for instance). */ snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, infoPtr, permissions); if (permissions & TCL_READABLE) { /* * Make sure the console input buffer is ready for only character * input notifications and the buffer is set for line buffering. IOW, * we only want to catch when complete lines are ready for reading. */ GetConsoleMode(infoPtr->handle, &modes); modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); modes |= ENABLE_LINE_INPUT; SetConsoleMode(infoPtr->handle, modes); infoPtr->reader.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->reader.thread = CreateThread(NULL, 256, ConsoleReaderThread, TclPipeThreadCreateTI(&infoPtr->reader.TI, infoPtr, infoPtr->reader.readyEvent), 0, NULL); SetThreadPriority(infoPtr->reader.thread, THREAD_PRIORITY_HIGHEST); } if (permissions & TCL_WRITABLE) { infoPtr->writer.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writer.thread = CreateThread(NULL, 256, ConsoleWriterThread, TclPipeThreadCreateTI(&infoPtr->writer.TI, infoPtr, infoPtr->writer.readyEvent), 0, NULL); SetThreadPriority(infoPtr->writer.thread, THREAD_PRIORITY_HIGHEST); } /* * Files have default translation of AUTO and ^Z eof char, which means * that a ^Z will be accepted as EOF when reading. */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); return infoPtr->channel; } /* *---------------------------------------------------------------------- * * ConsoleThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void ConsoleThreadActionProc( ClientData instanceData, int action) { ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; /* * We do not access firstConsolePtr in the thread structures. This is not * for all serials managed by the thread, but only those we are watching. * Removal of the fileevent handlers before transfer thus takes care of * this structure. */ Tcl_MutexLock(&consoleMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { /* * We can't copy the thread information from the channel when the * channel is created. At this time the channel back pointer has not * been set yet. However in that case the threadId has already been * set by TclpCreateCommandChannel itself, so the structure is still * good. */ ConsoleInit(); if (infoPtr->channel != NULL) { infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&consoleMutex); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinDde.c0000644000175000017500000015202514554262142014465 0ustar sergeisergei/* * tclWinDde.c -- * * This file provides functions that implement the "send" command, * allowing commands to be passed from interpreter to interpreter. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #include #include #include #if !defined(NDEBUG) /* test POKE server Implemented for debug mode only */ # undef CBF_FAIL_POKES # define CBF_FAIL_POKES 0 #endif /* * The following structure is used to keep track of the interpreters * registered by this process. */ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ WCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; /* * Used to keep track of conversations. */ typedef struct Conversation { struct Conversation *nextPtr; /* The next conversation in the list. */ RegisteredInterp *riPtr; /* The info we know about the conversation. */ HCONV hConv; /* The DDE handle for this conversation. */ Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; typedef struct { Tcl_Interp *interp; int result; ATOM service; ATOM topic; HWND hwnd; } DdeEnumServices; typedef struct { Conversation *currentConversations; /* A list of conversations currently being * processed. */ RegisteredInterp *interpListPtr; /* List of all interpreters registered in the * current process. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following variables cannot be placed in thread-local storage. The Mutex * ddeMutex guards access to the ddeInstance. */ static HSZ ddeServiceGlobal = 0; static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; #define TCL_DDE_VERSION "1.4.4" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME L"TclEval" #define TCL_DDE_EXECUTE_RESULT L"$TCLEVAL$EXECUTE$RESULT" #define DDE_FLAG_ASYNC 1 #define DDE_FLAG_BINARY 2 #define DDE_FLAG_FORCE 4 TCL_DECLARE_MUTEX(ddeMutex) /* * Forward declarations for functions defined later in this file. */ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(void *clientData); static int DdeGetServicesList(Tcl_Interp *interp, const WCHAR *serviceName, const WCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); static void DeleteProc(void *clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 # define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) # define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString # endif #endif static unsigned char * getByteArrayFromObj( Tcl_Obj *objPtr, size_t *lengthPtr ) { int length; unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); #if TCL_MAJOR_VERSION > 8 if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { /* 64-bit and TIP #494 situation: */ *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; } else #endif /* 32-bit or without TIP #494 */ *lengthPtr = (size_t) (unsigned) length; return result; } #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); #ifdef __cplusplus } #endif /* *---------------------------------------------------------------------- * * Dde_Init -- * * This function initializes the dde command. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Dde_Init( Tcl_Interp *interp) { if (!Tcl_InitStubs(interp, "8.5-", 0)) { return TCL_ERROR; } Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } /* *---------------------------------------------------------------------- * * Dde_SafeInit -- * * This function initializes the dde command within a safe interp * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Dde_SafeInit( Tcl_Interp *interp) { int result = Dde_Init(interp); if (result == TCL_OK) { Tcl_HideCommand(interp, "dde", "dde"); } return result; } /* *---------------------------------------------------------------------- * * Initialize -- * * Initialize the global DDE instance. * * Results: * None. * * Side effects: * Registers the DDE server proc. * *---------------------------------------------------------------------- */ static void Initialize(void) { int nameFound = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * See if the application is already registered; if so, remove its current * name from the registry. The deletion of the command will take care of * disposing of this entry. */ if (tsdPtr->interpListPtr != NULL) { nameFound = 1; } /* * Make sure that the DDE server is there. This is done only once, add an * exit handler tear it down. */ if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { if (DdeInitializeW(&ddeInstance, (PFNCALLBACK)(void *)DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; } } Tcl_MutexUnlock(&ddeMutex); } if ((ddeServiceGlobal == 0) && (nameFound != 0)) { Tcl_MutexLock(&ddeMutex); if ((ddeServiceGlobal == 0) && (nameFound != 0)) { ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); ddeServiceGlobal = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; } Tcl_MutexUnlock(&ddeMutex); } } /* *---------------------------------------------------------------------- * * DdeSetServerName -- * * This function is called to associate an ASCII name with a Dde server. * If the interpreter has already been named, the name replaces the old * one. * * Results: * The return value is the name actually given to the interp. This will * normally be the same as name, but if name was already in use for a Dde * Server then a name of the form "name #2" will be chosen, with a high * enough number to make the name unique. * * Side effects: * Registration info is saved, thereby allowing the "send" command to be * used later to invoke commands in the application. In addition, the * "send" command is created in the application's interpreter. The * registration will be removed automatically if the interpreter is * deleted or the "send" command is removed. * *---------------------------------------------------------------------- */ static const WCHAR * DdeSetServerName( Tcl_Interp *interp, const WCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; const WCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * See if the application is already registered; if so, remove its current * name from the registry. The deletion of the command will take care of * disposing of this entry. */ for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; prevPtr = riPtr, riPtr = riPtr->nextPtr) { if (riPtr->interp == interp) { if (name != NULL) { if (prevPtr == NULL) { tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr; } else { prevPtr->nextPtr = riPtr->nextPtr; } break; } else { /* * The name was NULL, so the caller is asking for the name of * the current interp. */ return riPtr->name; } } } if (name == NULL) { /* * The name was NULL, so the caller is asking for the name of the * current interp, but it doesn't have a name. */ return L""; } /* * Get the list of currently registered Tcl interpreters by calling the * internal implementation of the 'dde services' command. */ Tcl_DStringInit(&dString); actualName = name; if (!(flags & DDE_FLAG_FORCE)) { r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL); if (r == TCL_OK) { srvListPtr = Tcl_GetObjResult(interp); } if (r == TCL_OK) { r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount, &srvPtrPtr); } if (r != TCL_OK) { Tcl_DStringInit(&dString); OutputDebugStringW(Tcl_UtfToWCharDString(Tcl_GetString(Tcl_GetObjResult(interp)), -1, &dString)); Tcl_DStringFree(&dString); return NULL; } /* * Pick a name to use for the application. Use "name" if it's not * already in use. Otherwise add a suffix such as " #2", trying larger * and larger numbers until we eventually find one that is unique. */ offset = lastSuffix = 0; suffix = 1; while (suffix != lastSuffix) { lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { Tcl_DStringAppend(&dString, (char *)name, wcslen(name) * sizeof(WCHAR)); Tcl_DStringAppend(&dString, (char *)L" #", 2 * sizeof(WCHAR)); offset = Tcl_DStringLength(&dString); Tcl_DStringSetLength(&dString, offset + sizeof(WCHAR) * TCL_INTEGER_SPACE); actualName = (WCHAR *) Tcl_DStringValue(&dString); } _snwprintf((WCHAR *) (Tcl_DStringValue(&dString) + offset), TCL_INTEGER_SPACE, L"%d", suffix); } /* * See if the name is already in use, if so increment suffix. */ for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); Tcl_DStringInit(&ds); Tcl_UtfToWCharDString(Tcl_GetString(namePtr), -1, &ds); if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); break; } Tcl_DStringFree(&ds); } } } /* * We have found a unique name. Now add it to the registry. */ riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp)); riPtr->interp = interp; riPtr->name = (WCHAR *) Tcl_Alloc((wcslen(actualName) + 1) * sizeof(WCHAR)); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; wcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); } Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); } Tcl_DStringFree(&dString); /* * Re-initialize with the new name. */ Initialize(); return riPtr->name; } /* *---------------------------------------------------------------------- * * DdeGetRegistrationPtr * * Retrieve the registration info for an interpreter. * * Results: * Returns a pointer to the registration structure or NULL * * Side effects: * None * *---------------------------------------------------------------------- */ static RegisteredInterp * DdeGetRegistrationPtr( Tcl_Interp *interp) { RegisteredInterp *riPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (riPtr->interp == interp) { break; } } return riPtr; } /* *---------------------------------------------------------------------- * * DeleteProc * * This function is called when the command "dde" is destroyed. * * Results: * none * * Side effects: * The interpreter given by riPtr is unregistered. * *---------------------------------------------------------------------- */ static void DeleteProc( void *clientData) /* The interp we are deleting. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL; (searchPtr != NULL) && (searchPtr != riPtr); prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) { /* * Empty loop body. */ } if (searchPtr != NULL) { if (prevPtr == NULL) { tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr; } else { prevPtr->nextPtr = searchPtr->nextPtr; } } Tcl_Free((char *) riPtr->name); if (riPtr->handlerPtr) { Tcl_DecrRefCount(riPtr->handlerPtr); } Tcl_EventuallyFree(clientData, TCL_DYNAMIC); } /* *---------------------------------------------------------------------- * * ExecuteRemoteObject -- * * Takes the package delivered by DDE and executes it in the server's * interpreter. * * Results: * A list Tcl_Obj * that describes what happened. The first element is * the numerical return code (TCL_ERROR, etc.). The second element is the * result of the script. If the return result was TCL_ERROR, then the * third element will be the value of the global "errorCode", and the * fourth will be the value of the global "errorInfo". The return result * will have a refCount of 0. * * Side effects: * A Tcl script is run, which can cause all kinds of other things to * happen. * *---------------------------------------------------------------------- */ static Tcl_Obj * ExecuteRemoteObject( RegisteredInterp *riPtr, /* Info about this server. */ Tcl_Obj *ddeObjectPtr) /* The object to execute. */ { Tcl_Obj *returnPackagePtr; int result = TCL_OK; if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) { Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " "a handler procedure must be defined for use in a safe " "interp", -1)); Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL); result = TCL_ERROR; } if (riPtr->handlerPtr != NULL) { /* * Add the dde request data to the handler proc list. */ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr); if (result == TCL_OK) { ddeObjectPtr = cmdPtr; } } if (result == TCL_OK) { result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL); } returnPackagePtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); if (result == TCL_ERROR) { Tcl_Obj *errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL, TCL_GLOBAL_ONLY); if (errorObjPtr) { Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); } errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (errorObjPtr) { Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); } } return returnPackagePtr; } /* *---------------------------------------------------------------------- * * DdeServerProc -- * * Handles all transactions for this server. Can handle execute, request, * and connect protocols. Dde will call this routine when a client * attempts to run a dde command using this server. * * Results: * A DDE Handle with the result of the dde command. * * Side effects: * Depending on which command is executed, arbitrary Tcl scripts can be * run. * *---------------------------------------------------------------------- */ static HDDEDATA CALLBACK DdeServerProc( UINT uType, /* The type of DDE transaction we are * performing. */ UINT uFmt, /* The format that data is sent or received */ HCONV hConv, /* The conversation associated with the * current transaction. */ HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type * dependent. */ HDDEDATA hData, /* DDE data. Transaction-type dependent. */ DWORD unused1, DWORD unused2) /* Transaction-dependent data. */ { Tcl_DString dString; size_t len; DWORD dlen; WCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; Conversation *convPtr, *prevConvPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)unused1; (void)unused2; switch(uType) { case XTYP_CONNECT: /* * Dde is trying to initialize a conversation with us. Check and make * sure we have a valid topic. */ len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryStringW(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (_wcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } } Tcl_DStringFree(&dString); return (HDDEDATA) FALSE; case XTYP_CONNECT_CONFIRM: /* * Dde has decided that we can connect, so it gives us a conversation * handle. We need to keep track of it so we know which execution * result to return in an XTYP_REQUEST. */ len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryStringW(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (_wcsicmp(riPtr->name, utilString) == 0) { convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; convPtr->hConv = hConv; convPtr->riPtr = riPtr; tsdPtr->currentConversations = convPtr; break; } } Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; case XTYP_DISCONNECT: /* * The client has disconnected from our server. Forget this * conversation. */ for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL; convPtr != NULL; prevConvPtr = convPtr, convPtr = convPtr->nextPtr) { if (hConv == convPtr->hConv) { if (prevConvPtr == NULL) { tsdPtr->currentConversations = convPtr->nextPtr; } else { prevConvPtr->nextPtr = convPtr->nextPtr; } if (convPtr->returnPackagePtr != NULL) { Tcl_DecrRefCount(convPtr->returnPackagePtr); } Tcl_Free((char *) convPtr); break; } } return (HDDEDATA) TRUE; case XTYP_REQUEST: /* * This could be either a request for a value of a Tcl variable, or it * could be the send command requesting the results of the last * execute. */ if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { return (HDDEDATA) FALSE; } ddeReturn = (HDDEDATA) FALSE; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* * Empty loop body. */ } if (convPtr != NULL) { Tcl_DString dsBuf; char *returnString; len = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringInit(&dsBuf); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { returnString = Tcl_GetString(convPtr->returnPackagePtr); len = convPtr->returnPackagePtr->length; if (uFmt != CF_TEXT) { Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; } else { Tcl_DString ds; Tcl_Obj *variableObjPtr; Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); variableObjPtr = Tcl_GetVar2Ex( convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { returnString = Tcl_GetString(variableObjPtr); len = variableObjPtr->length; if (uFmt != CF_TEXT) { Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { ddeReturn = NULL; } Tcl_DStringFree(&ds); } } Tcl_DStringFree(&dsBuf); Tcl_DStringFree(&dString); } return ddeReturn; #if !CBF_FAIL_POKES case XTYP_POKE: /* * This is a poke for a Tcl variable, only implemented in * debug/UNICODE mode. */ ddeReturn = DDE_FNOTPROCESSED; if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { return ddeReturn; } for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* * Empty loop body. */ } if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) { Tcl_DString ds, ds2; Tcl_Obj *variableObjPtr; DWORD len2; Tcl_DStringInit(&dString); Tcl_DStringInit(&ds2); len = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); utilString = (WCHAR *) DdeAccessData(hData, &len2); len = len2; if (uFmt != CF_TEXT) { Tcl_DStringInit(&ds2); Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2); utilString = (WCHAR *) Tcl_DStringValue(&ds2); } variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, variableObjPtr, TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds2); Tcl_DStringFree(&ds); Tcl_DStringFree(&dString); ddeReturn = (HDDEDATA) DDE_FACK; } return ddeReturn; #endif case XTYP_EXECUTE: { /* * Execute this script. The results will be saved into a list object * which will be retrieved later. See ExecuteRemoteObject. */ Tcl_Obj *returnPackagePtr; char *string; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* * Empty loop body. */ } if (convPtr == NULL) { return (HDDEDATA) DDE_FNOTPROCESSED; } utilString = (WCHAR *) DdeAccessData(hData, &dlen); string = (char *) utilString; if (!dlen) { /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { /* Cannot be Unicode, so assume utf-8 */ if (!string[dlen-1]) { dlen--; } ddeObjectPtr = Tcl_NewStringObj(string, dlen); } else { /* Unicode */ Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(utilString, (dlen>>1) - 1, &dsBuf); ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); if (convPtr->returnPackagePtr != NULL) { Tcl_DecrRefCount(convPtr->returnPackagePtr); } convPtr->returnPackagePtr = NULL; returnPackagePtr = ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr); Tcl_IncrRefCount(returnPackagePtr); for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* * Empty loop body. */ } if (convPtr != NULL) { convPtr->returnPackagePtr = returnPackagePtr; } else { Tcl_DecrRefCount(returnPackagePtr); } Tcl_DecrRefCount(ddeObjectPtr); if (returnPackagePtr == NULL) { return (HDDEDATA) DDE_FNOTPROCESSED; } else { return (HDDEDATA) DDE_FACK; } } case XTYP_WILDCONNECT: { /* * Dde wants a list of services and topics that we support. */ HSZPAIR *returnPtr; int i; int numItems; for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL; i++, riPtr = riPtr->nextPtr) { /* * Empty loop body. */ } numItems = i; ddeReturn = DdeCreateDataHandle(ddeInstance, NULL, (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); len = dlen; for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { returnPtr[i].hszSvc = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); returnPtr[i].hszTopic = DdeCreateStringHandleW(ddeInstance, riPtr->name, CP_WINUNICODE); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; DdeUnaccessData(ddeReturn); return ddeReturn; } default: return NULL; } } /* *---------------------------------------------------------------------- * * DdeExitProc -- * * Gets rid of our DDE server when we go away. * * Results: * None. * * Side effects: * The DDE server is deleted. * *---------------------------------------------------------------------- */ static void DdeExitProc( void *dummy) /* Not used. */ { (void)dummy; DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER); DdeUninitialize(ddeInstance); ddeInstance = 0; } /* *---------------------------------------------------------------------- * * MakeDdeConnection -- * * This function is a utility used to connect to a DDE server when given * a server name and a topic name. * * Results: * A standard Tcl result. * * Side effects: * Passes back a conversation through ddeConvPtr * *---------------------------------------------------------------------- */ static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ const WCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; ddeService = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); ddeTopic = DdeCreateStringHandleW(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); if (ddeConv == (HCONV) NULL) { if (interp != NULL) { Tcl_DString dString; Tcl_DStringInit(&dString); Tcl_WCharToUtfDString(name, wcslen(name), &dString); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no registered server named \"%s\"", Tcl_DStringValue(&dString))); Tcl_DStringFree(&dString); Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); } return TCL_ERROR; } *ddeConvPtr = ddeConv; return TCL_OK; } /* *---------------------------------------------------------------------- * * DdeGetServicesList -- * * This function obtains the list of DDE services. * * The functions between here and this function are all involved with * handling the DDE callbacks for this. They are: DdeCreateClient, * DdeClientWindowProc, DdeServicesOnAck, and DdeEnumWindowsCallback * * Results: * A standard Tcl result. * * Side effects: * Sets the services list into the interp result. * *---------------------------------------------------------------------- */ static int DdeCreateClient( DdeEnumServices *es) { WNDCLASSEXW wc; static const WCHAR *szDdeClientClassName = L"TclEval client class"; static const WCHAR *szDdeClientWindowName = L"TclEval client window"; memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; wc.cbWndExtra = sizeof(DdeEnumServices *); /* * Register and create the callback window. */ RegisterClassExW(&wc); es->hwnd = CreateWindowExW(0, szDdeClientClassName, szDdeClientWindowName, WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } static LRESULT CALLBACK DdeClientWindowProc( HWND hwnd, /* What window is the message for */ UINT uMsg, /* The type of message received */ WPARAM wParam, LPARAM lParam) /* (Potentially) our local handle */ { switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; DdeEnumServices *es = (DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else SetWindowLongW(hwnd, GWL_USERDATA, (LONG) es); #endif return (LRESULT) 0L; } case WM_DDE_ACK: return DdeServicesOnAck(hwnd, wParam, lParam); default: return DefWindowProcW(hwnd, uMsg, wParam, lParam); } } static LRESULT DdeServicesOnAck( HWND hwnd, WPARAM wParam, LPARAM lParam) { HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); DdeEnumServices *es; WCHAR sz[255]; Tcl_DString dString; #ifdef _WIN64 es = (DdeEnumServices *) GetWindowLongPtrW(hwnd, GWLP_USERDATA); #else es = (DdeEnumServices *) GetWindowLongW(hwnd, GWL_USERDATA); #endif if (((es->service == (ATOM)0) || (es->service == service)) && ((es->topic == (ATOM)0) || (es->topic == topic))) { Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomNameW(service, sz, 255); Tcl_DStringInit(&dString); Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); GlobalGetAtomNameW(topic, sz, 255); Tcl_DStringInit(&dString); Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); /* * Adding the hwnd as a third list element provides a unique * identifier in the case of multiple servers with the name * application and topic names. */ /* * Needs a TIP though: * Tcl_ListObjAppendElement(NULL, matchPtr, * Tcl_NewLongObj((long)hwndRemote)); */ if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } if (Tcl_ListObjAppendElement(es->interp, resultPtr, matchPtr) == TCL_OK) { Tcl_SetObjResult(es->interp, resultPtr); } } /* * Tell the server we are no longer interested. */ PostMessageW(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); return 0L; } static BOOL CALLBACK DdeEnumWindowsCallback( HWND hwndTarget, LPARAM lParam) { DWORD_PTR dwResult = 0; DdeEnumServices *es = (DdeEnumServices *) lParam; SendMessageTimeoutW(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, &dwResult); return TRUE; } static int DdeGetServicesList( Tcl_Interp *interp, const WCHAR *serviceName, const WCHAR *topicName) { DdeEnumServices es; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) ? (ATOM)0 : GlobalAddAtomW(serviceName); es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomW(topicName); Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es); if (IsWindow(es.hwnd)) { DestroyWindow(es.hwnd); } if (es.service != (ATOM)0) { GlobalDeleteAtom(es.service); } if (es.topic != (ATOM)0) { GlobalDeleteAtom(es.topic); } return es.result; } /* *---------------------------------------------------------------------- * * SetDdeError -- * * Sets the interp result to a cogent error message describing the last * DDE error. * * Results: * None. * * Side effects: * The interp's result object is changed. * *---------------------------------------------------------------------- */ static void SetDdeError( Tcl_Interp *interp) /* The interp to put the message in. */ { const char *errorMessage, *errorCode; switch (DdeGetLastError(ddeInstance)) { case DMLERR_DATAACKTIMEOUT: case DMLERR_EXECACKTIMEOUT: case DMLERR_POKEACKTIMEOUT: errorMessage = "remote interpreter did not respond"; errorCode = "TIMEOUT"; break; case DMLERR_BUSY: errorMessage = "remote server is busy"; errorCode = "BUSY"; break; case DMLERR_NOTPROCESSED: errorMessage = "remote server cannot handle this command"; errorCode = "NOCANDO"; break; default: errorMessage = "dde command failed"; errorCode = "FAILED"; } Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL); } /* *---------------------------------------------------------------------- * * DdeObjCmd -- * * This function is invoked to process the "dde" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DdeObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; static const char *const ddeSrvOptions[] = { "-force", "-handler", "--", NULL }; enum DdeSrvOptions { DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, }; static const char *const ddeExecOptions[] = { "-async", "-binary", NULL }; enum DdeExecOptions { DDE_EXEC_ASYNC, DDE_EXEC_BINARY }; static const char *const ddeEvalOptions[] = { "-async", NULL }; static const char *const ddeReqOptions[] = { "-binary", NULL }; int index, i, argIndex; size_t length; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; const WCHAR *serviceName = NULL, *topicName = NULL; const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; Tcl_DString serviceBuf, topicBuf, itemBuf; (void)dummy; /* * Initialize DDE server/client */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0, &index) != TCL_OK) { return TCL_ERROR; } Tcl_DStringInit(&serviceBuf); Tcl_DStringInit(&topicBuf); Tcl_DStringInit(&itemBuf); switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: for (i = 2; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, "option", 0, &argIndex) != TCL_OK) { /* * If it is the last argument, it might be a server name * instead of a bad argument. */ if (i != objc-1) { return TCL_ERROR; } Tcl_ResetResult(interp); break; } if (argIndex == DDE_SERVERNAME_EXACT) { flags |= DDE_FLAG_FORCE; } else if (argIndex == DDE_SERVERNAME_HANDLER) { if ((objc - i) == 1) { /* return current handler */ RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp); if (riPtr && riPtr->handlerPtr) { Tcl_SetObjResult(interp, riPtr->handlerPtr); } else { Tcl_ResetResult(interp); } return TCL_OK; } handlerPtr = objv[++i]; } else if (argIndex == DDE_SERVERNAME_LAST) { i++; break; } } if ((objc - i) > 1) { Tcl_ResetResult(interp); Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?-handler proc? ?--? ?serverName?"); return TCL_ERROR; } firstArg = (objc == i) ? 1 : i; break; case DDE_EXECUTE: if (objc == 5) { firstArg = 2; break; } else if ((objc >= 6) && (objc <= 7)) { firstArg = objc - 3; for (i = 2; i < firstArg; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions, "option", 0, &argIndex) != TCL_OK) { goto wrongDdeExecuteArgs; } if (argIndex == DDE_EXEC_ASYNC) { flags |= DDE_FLAG_ASYNC; } else { flags |= DDE_FLAG_BINARY; } } break; } /* otherwise... */ wrongDdeExecuteArgs: Tcl_WrongNumArgs(interp, 2, objv, "?-async? ?-binary? serviceName topicName value"); return TCL_ERROR; case DDE_POKE: if (objc == 6) { firstArg = 2; break; } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { flags |= DDE_FLAG_BINARY; firstArg = 3; break; } /* * Otherwise... */ Tcl_WrongNumArgs(interp, 2, objv, "?-binary? serviceName topicName item value"); return TCL_ERROR; case DDE_REQUEST: if (objc == 5) { firstArg = 2; break; } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { flags |= DDE_FLAG_BINARY; firstArg = 3; break; } /* * Otherwise ... */ Tcl_WrongNumArgs(interp, 2, objv, "?-binary? serviceName topicName value"); return TCL_ERROR; case DDE_SERVICES: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "serviceName topicName"); return TCL_ERROR; } firstArg = 2; break; case DDE_EVAL: if (objc < 4) { wrongDdeEvalArgs: Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args"); return TCL_ERROR; } else { firstArg = 2; if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } flags |= DDE_FLAG_ASYNC; firstArg++; } break; } } Initialize(); if (firstArg != 1) { const char *src = Tcl_GetString(objv[firstArg]); length = objv[firstArg]->length; Tcl_DStringInit(&serviceBuf); Tcl_UtfToWCharDString(src, length, &serviceBuf); serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR); } else { length = 0; } if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { ddeService = DdeCreateStringHandleW(ddeInstance, serviceName, CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { const char *src = Tcl_GetString(objv[firstArg + 1]); length = objv[firstArg + 1]->length; Tcl_DStringInit(&topicBuf); topicName = Tcl_UtfToWCharDString(src, length, &topicBuf); length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); if (length == 0) { topicName = NULL; } else { ddeTopic = DdeCreateStringHandleW(ddeInstance, topicName, CP_WINUNICODE); } } switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: serviceName = DdeSetServerName(interp, serviceName, flags, handlerPtr); if (serviceName != NULL) { Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(serviceName, wcslen(serviceName), &dsBuf); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf))); Tcl_DStringFree(&dsBuf); } else { Tcl_ResetResult(interp); } break; case DDE_EXECUTE: { size_t dataLength; const void *dataString; Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = getByteArrayFromObj(objv[firstArg + 2], &dataLength); } else { const char *src; src = Tcl_GetString(objv[firstArg + 2]); dataLength = objv[firstArg + 2]->length; Tcl_DStringInit(&dsBuf); dataString = Tcl_UtfToWCharDString(src, dataLength, &dsBuf); dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } if (dataLength + 1 < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); Tcl_DStringFree(&dsBuf); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; break; } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { Tcl_DStringFree(&dsBuf); SetDdeError(interp); result = TCL_ERROR; break; } ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString, (DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0); if (ddeData != NULL) { if (flags & DDE_FLAG_ASYNC) { DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeReturn == 0) { SetDdeError(interp); result = TCL_ERROR; } } DdeFreeDataHandle(ddeData); } else { SetDdeError(interp); result = TCL_ERROR; } Tcl_DStringFree(&dsBuf); break; } case DDE_REQUEST: { const WCHAR *itemString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; Tcl_DStringInit(&itemBuf); itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; goto cleanup; } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; ddeItem = DdeCreateStringHandleW(ddeInstance, itemString, CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; WCHAR *dataString = (WCHAR *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { returnObjPtr = Tcl_NewByteArrayObj((BYTE *) dataString, tmp); } else { Tcl_DString dsBuf; if ((tmp >= sizeof(WCHAR)) && !dataString[tmp / sizeof(WCHAR) - 1]) { tmp -= sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf); returnObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); Tcl_SetObjResult(interp, returnObjPtr); } } else { SetDdeError(interp); result = TCL_ERROR; } } break; } case DDE_POKE: { Tcl_DString dsBuf; const WCHAR *itemString; BYTE *dataString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; Tcl_DStringInit(&itemBuf); itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; goto cleanup; } Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = (BYTE *) getByteArrayFromObj(objv[firstArg + 3], &length); } else { const char *data = Tcl_GetString(objv[firstArg + 3]); length = objv[firstArg + 3]->length; Tcl_DStringInit(&dsBuf); dataString = (BYTE *) Tcl_UtfToWCharDString(data, length, &dsBuf); length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { ddeItem = DdeCreateStringHandleW(ddeInstance, itemString, CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(dataString, (DWORD) length, hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } } else { SetDdeError(interp); result = TCL_ERROR; } } Tcl_DStringFree(&dsBuf); break; } case DDE_SERVICES: result = DdeGetServicesList(interp, serviceName, topicName); break; case DDE_EVAL: { RegisteredInterp *riPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (serviceName == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid service name \"\"", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); result = TCL_ERROR; goto cleanup; } objc -= firstArg + 1; objv += firstArg + 1; /* * See if the target interpreter is local. If so, execute the command * directly without going through the DDE server. Don't exchange * objects between interps. The target interp could compile an object, * producing a bytecode structure that refers to other objects owned * by the target interp. If the target interp is then deleted, the * bytecode structure would be referring to deallocated objects. */ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (_wcsicmp(serviceName, riPtr->name) == 0) { break; } } if (riPtr != NULL) { Tcl_Interp *sendInterp; /* * This command is to a local interp. No need to go through the * server. */ Tcl_Preserve(riPtr); sendInterp = riPtr->interp; Tcl_Preserve(sendInterp); /* * Don't exchange objects between interps. The target interp would * compile an object, producing a bytecode structure that refers * to other objects owned by the target interp. If the target * interp is then deleted, the bytecode structure would be * referring to deallocated objects. */ if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) { Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( "permission denied: a handler procedure must be" " defined for use in a safe interp", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", NULL); result = TCL_ERROR; } if (result == TCL_OK) { if (objc == 1) { objPtr = objv[0]; } else { objPtr = Tcl_ConcatObj(objc, objv); } if (riPtr->handlerPtr != NULL) { /* add the dde request data to the handler proc list */ /* *result = Tcl_ListObjReplace(sendInterp, objPtr, 0, 0, 1, * &(riPtr->handlerPtr)); */ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); result = Tcl_ListObjAppendElement(sendInterp, cmdPtr, objPtr); if (result == TCL_OK) { objPtr = cmdPtr; } } } if (result == TCL_OK) { Tcl_IncrRefCount(objPtr); result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(objPtr); } if (interp != sendInterp) { if (result == TCL_ERROR) { /* * An error occurred, so transfer error information from * the destination interpreter back to our interpreter. */ Tcl_ResetResult(interp); objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (objPtr) { Tcl_AppendObjToErrorInfo(interp, objPtr); } objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, TCL_GLOBAL_ONLY); if (objPtr) { Tcl_SetObjErrorCode(interp, objPtr); } } Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp)); } Tcl_Release(riPtr); Tcl_Release(sendInterp); } else { Tcl_DString dsBuf; /* * This is a non-local request. Send the script to the server and * poll it for a result. */ if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { invalidServerResponse: Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid data returned from server", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL); result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetString(objPtr); length = objPtr->length; Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(string, length, &dsBuf); string = Tcl_DStringValue(&dsBuf); length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, (DWORD) length, 0, 0, CF_UNICODETEXT, 0); Tcl_DStringFree(&dsBuf); if (flags & DDE_FLAG_ASYNC) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { ddeCookie = DdeCreateStringHandleW(ddeInstance, TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL); } } Tcl_DecrRefCount(objPtr); if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; goto cleanup; } if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; WCHAR *ddeDataString; /* * The return handle has a two or four element list in it. The * first element is the return code (TCL_OK, TCL_ERROR, etc.). * The second is the result of the script. If the return code * is TCL_ERROR, then the third element is the value of the * variable "errorCode", and the fourth is the value of the * variable "errorInfo". */ length = DdeGetData(ddeData, NULL, 0, 0); ddeDataString = (WCHAR *) Tcl_Alloc(length); DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); if (length > sizeof(WCHAR)) { length -= sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(ddeDataString, length>>1, &dsBuf); resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); Tcl_Free((char *) ddeDataString); if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) { Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } if (result == TCL_ERROR) { Tcl_ResetResult(interp); if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } Tcl_AppendObjToErrorInfo(interp, objPtr); Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); Tcl_SetObjErrorCode(interp, objPtr); } if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } Tcl_SetObjResult(interp, objPtr); Tcl_DecrRefCount(resultPtr); } } } } cleanup: if (ddeCookie != NULL) { DdeFreeStringHandle(ddeInstance, ddeCookie); } if (ddeItem != NULL) { DdeFreeStringHandle(ddeInstance, ddeItem); } if (ddeItemData != NULL) { DdeFreeDataHandle(ddeItemData); } if (ddeData != NULL) { DdeFreeDataHandle(ddeData); } if (hConv != NULL) { DdeDisconnect(hConv); } Tcl_DStringFree(&itemBuf); Tcl_DStringFree(&topicBuf); Tcl_DStringFree(&serviceBuf); return result; } /* * Local variables: * mode: c * indent-tabs-mode: t * tab-width: 8 * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinError.c0000644000175000017500000002675714554262142015076 0ustar sergeisergei/* * tclWinError.c -- * * This file contains code for converting from Win32 errors to errno * errors. * * Copyright (c) 1995-1996 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * The following table contains the mapping from Win32 errors to errno errors. */ static const unsigned char errorTable[] = { 0, EINVAL, /* ERROR_INVALID_FUNCTION 1 */ ENOENT, /* ERROR_FILE_NOT_FOUND 2 */ ENOENT, /* ERROR_PATH_NOT_FOUND 3 */ EMFILE, /* ERROR_TOO_MANY_OPEN_FILES 4 */ EACCES, /* ERROR_ACCESS_DENIED 5 */ EBADF, /* ERROR_INVALID_HANDLE 6 */ ENOMEM, /* ERROR_ARENA_TRASHED 7 */ ENOMEM, /* ERROR_NOT_ENOUGH_MEMORY 8 */ ENOMEM, /* ERROR_INVALID_BLOCK 9 */ E2BIG, /* ERROR_BAD_ENVIRONMENT 10 */ ENOEXEC, /* ERROR_BAD_FORMAT 11 */ EACCES, /* ERROR_INVALID_ACCESS 12 */ EINVAL, /* ERROR_INVALID_DATA 13 */ ENOMEM, /* ERROR_OUT_OF_MEMORY 14 */ ENOENT, /* ERROR_INVALID_DRIVE 15 */ EACCES, /* ERROR_CURRENT_DIRECTORY 16 */ EXDEV, /* ERROR_NOT_SAME_DEVICE 17 */ ENOENT, /* ERROR_NO_MORE_FILES 18 */ EROFS, /* ERROR_WRITE_PROTECT 19 */ ENXIO, /* ERROR_BAD_UNIT 20 */ EBUSY, /* ERROR_NOT_READY 21 */ EIO, /* ERROR_BAD_COMMAND 22 */ EIO, /* ERROR_CRC 23 */ EIO, /* ERROR_BAD_LENGTH 24 */ EIO, /* ERROR_SEEK 25 */ EIO, /* ERROR_NOT_DOS_DISK 26 */ ENXIO, /* ERROR_SECTOR_NOT_FOUND 27 */ EBUSY, /* ERROR_OUT_OF_PAPER 28 */ EIO, /* ERROR_WRITE_FAULT 29 */ EIO, /* ERROR_READ_FAULT 30 */ EIO, /* ERROR_GEN_FAILURE 31 */ EACCES, /* ERROR_SHARING_VIOLATION 32 */ EACCES, /* ERROR_LOCK_VIOLATION 33 */ ENXIO, /* ERROR_WRONG_DISK 34 */ ENFILE, /* ERROR_FCB_UNAVAILABLE 35 */ ENFILE, /* ERROR_SHARING_BUFFER_EXCEEDED 36 */ EINVAL, /* 37 */ EINVAL, /* 38 */ ENOSPC, /* ERROR_HANDLE_DISK_FULL 39 */ EINVAL, /* 40 */ EINVAL, /* 41 */ EINVAL, /* 42 */ EINVAL, /* 43 */ EINVAL, /* 44 */ EINVAL, /* 45 */ EINVAL, /* 46 */ EINVAL, /* 47 */ EINVAL, /* 48 */ EINVAL, /* 49 */ ENODEV, /* ERROR_NOT_SUPPORTED 50 */ EBUSY, /* ERROR_REM_NOT_LIST 51 */ EEXIST, /* ERROR_DUP_NAME 52 */ ENOENT, /* ERROR_BAD_NETPATH 53 */ EBUSY, /* ERROR_NETWORK_BUSY 54 */ ENODEV, /* ERROR_DEV_NOT_EXIST 55 */ EAGAIN, /* ERROR_TOO_MANY_CMDS 56 */ EIO, /* ERROR_ADAP_HDW_ERR 57 */ EIO, /* ERROR_BAD_NET_RESP 58 */ EIO, /* ERROR_UNEXP_NET_ERR 59 */ EINVAL, /* ERROR_BAD_REM_ADAP 60 */ EFBIG, /* ERROR_PRINTQ_FULL 61 */ ENOSPC, /* ERROR_NO_SPOOL_SPACE 62 */ ENOENT, /* ERROR_PRINT_CANCELLED 63 */ ENOENT, /* ERROR_NETNAME_DELETED 64 */ EACCES, /* ERROR_NETWORK_ACCESS_DENIED 65 */ ENODEV, /* ERROR_BAD_DEV_TYPE 66 */ ENOENT, /* ERROR_BAD_NET_NAME 67 */ ENFILE, /* ERROR_TOO_MANY_NAMES 68 */ EIO, /* ERROR_TOO_MANY_SESS 69 */ EAGAIN, /* ERROR_SHARING_PAUSED 70 */ EINVAL, /* ERROR_REQ_NOT_ACCEP 71 */ EAGAIN, /* ERROR_REDIR_PAUSED 72 */ EINVAL, /* 73 */ EINVAL, /* 74 */ EINVAL, /* 75 */ EINVAL, /* 76 */ EINVAL, /* 77 */ EINVAL, /* 78 */ EINVAL, /* 79 */ EEXIST, /* ERROR_FILE_EXISTS 80 */ EINVAL, /* 81 */ ENOSPC, /* ERROR_CANNOT_MAKE 82 */ EIO, /* ERROR_FAIL_I24 83 */ ENFILE, /* ERROR_OUT_OF_STRUCTURES 84 */ EEXIST, /* ERROR_ALREADY_ASSIGNED 85 */ EPERM, /* ERROR_INVALID_PASSWORD 86 */ EINVAL, /* ERROR_INVALID_PARAMETER 87 */ EIO, /* ERROR_NET_WRITE_FAULT 88 */ EAGAIN, /* ERROR_NO_PROC_SLOTS 89 */ EINVAL, /* 90 */ EINVAL, /* 91 */ EINVAL, /* 92 */ EINVAL, /* 93 */ EINVAL, /* 94 */ EINVAL, /* 95 */ EINVAL, /* 96 */ EINVAL, /* 97 */ EINVAL, /* 98 */ EINVAL, /* 99 */ EINVAL, /* 100 */ EINVAL, /* 101 */ EINVAL, /* 102 */ EINVAL, /* 103 */ EINVAL, /* 104 */ EINVAL, /* 105 */ EINVAL, /* 106 */ EXDEV, /* ERROR_DISK_CHANGE 107 */ EAGAIN, /* ERROR_DRIVE_LOCKED 108 */ EPIPE, /* ERROR_BROKEN_PIPE 109 */ ENOENT, /* ERROR_OPEN_FAILED 110 */ EINVAL, /* ERROR_BUFFER_OVERFLOW 111 */ ENOSPC, /* ERROR_DISK_FULL 112 */ EMFILE, /* ERROR_NO_MORE_SEARCH_HANDLES 113 */ EBADF, /* ERROR_INVALID_TARGET_HANDLE 114 */ EFAULT, /* ERROR_PROTECTION_VIOLATION 115 */ EINVAL, /* 116 */ EINVAL, /* 117 */ EINVAL, /* 118 */ EINVAL, /* 119 */ EINVAL, /* 120 */ EINVAL, /* 121 */ EINVAL, /* 122 */ ENOENT, /* ERROR_INVALID_NAME 123 */ EINVAL, /* 124 */ EINVAL, /* 125 */ EINVAL, /* 126 */ EINVAL, /* ERROR_PROC_NOT_FOUND 127 */ ECHILD, /* ERROR_WAIT_NO_CHILDREN 128 */ ECHILD, /* ERROR_CHILD_NOT_COMPLETE 129 */ EBADF, /* ERROR_DIRECT_ACCESS_HANDLE 130 */ EINVAL, /* ERROR_NEGATIVE_SEEK 131 */ ESPIPE, /* ERROR_SEEK_ON_DEVICE 132 */ EINVAL, /* 133 */ EINVAL, /* 134 */ EINVAL, /* 135 */ EINVAL, /* 136 */ EINVAL, /* 137 */ EINVAL, /* 138 */ EINVAL, /* 139 */ EINVAL, /* 140 */ EINVAL, /* 141 */ EAGAIN, /* ERROR_BUSY_DRIVE 142 */ EINVAL, /* 143 */ EINVAL, /* 144 */ EEXIST, /* ERROR_DIR_NOT_EMPTY 145 */ EINVAL, /* 146 */ EINVAL, /* 147 */ EINVAL, /* 148 */ EINVAL, /* 149 */ EINVAL, /* 150 */ EINVAL, /* 151 */ EINVAL, /* 152 */ EINVAL, /* 153 */ EINVAL, /* 154 */ EINVAL, /* 155 */ EINVAL, /* 156 */ EINVAL, /* 157 */ EACCES, /* ERROR_NOT_LOCKED 158 */ EINVAL, /* 159 */ EINVAL, /* 160 */ ENOENT, /* ERROR_BAD_PATHNAME 161 */ EINVAL, /* 162 */ EINVAL, /* 163 */ EINVAL, /* 164 */ EINVAL, /* 165 */ EINVAL, /* 166 */ EACCES, /* ERROR_LOCK_FAILED 167 */ EINVAL, /* 168 */ EINVAL, /* 169 */ EINVAL, /* 170 */ EINVAL, /* 171 */ EINVAL, /* 172 */ EINVAL, /* 173 */ EINVAL, /* 174 */ EINVAL, /* 175 */ EINVAL, /* 176 */ EINVAL, /* 177 */ EINVAL, /* 178 */ EINVAL, /* 179 */ EINVAL, /* 180 */ EINVAL, /* 181 */ EINVAL, /* 182 */ EEXIST, /* ERROR_ALREADY_EXISTS 183 */ ECHILD, /* ERROR_NO_CHILD_PROCESS 184 */ EINVAL, /* 185 */ EINVAL, /* 186 */ EINVAL, /* 187 */ EINVAL, /* 188 */ EINVAL, /* 189 */ EINVAL, /* 190 */ EINVAL, /* 191 */ EINVAL, /* 192 */ EINVAL, /* 193 */ EINVAL, /* 194 */ EINVAL, /* 195 */ EINVAL, /* 196 */ EINVAL, /* 197 */ EINVAL, /* 198 */ EINVAL, /* 199 */ EINVAL, /* 200 */ EINVAL, /* 201 */ EINVAL, /* 202 */ EINVAL, /* 203 */ EINVAL, /* 204 */ EINVAL, /* 205 */ ENAMETOOLONG,/* ERROR_FILENAME_EXCED_RANGE 206 */ EINVAL, /* 207 */ EINVAL, /* 208 */ EINVAL, /* 209 */ EINVAL, /* 210 */ EINVAL, /* 211 */ EINVAL, /* 212 */ EINVAL, /* 213 */ EINVAL, /* 214 */ EINVAL, /* 215 */ EINVAL, /* 216 */ EINVAL, /* 217 */ EINVAL, /* 218 */ EINVAL, /* 219 */ EINVAL, /* 220 */ EINVAL, /* 221 */ EINVAL, /* 222 */ EINVAL, /* 223 */ EINVAL, /* 224 */ EINVAL, /* 225 */ EINVAL, /* 226 */ EINVAL, /* 227 */ EINVAL, /* 228 */ EINVAL, /* 229 */ EPIPE, /* ERROR_BAD_PIPE 230 */ EAGAIN, /* ERROR_PIPE_BUSY 231 */ EPIPE, /* ERROR_NO_DATA 232 */ EPIPE, /* ERROR_PIPE_NOT_CONNECTED 233 */ EINVAL, /* 234 */ EINVAL, /* 235 */ EINVAL, /* 236 */ EINVAL, /* 237 */ EINVAL, /* 238 */ EINVAL, /* 239 */ EINVAL, /* 240 */ EINVAL, /* 241 */ EINVAL, /* 242 */ EINVAL, /* 243 */ EINVAL, /* 244 */ EINVAL, /* 245 */ EINVAL, /* 246 */ EINVAL, /* 247 */ EINVAL, /* 248 */ EINVAL, /* 249 */ EINVAL, /* 250 */ EINVAL, /* 251 */ EINVAL, /* 252 */ EINVAL, /* 253 */ EINVAL, /* 254 */ EINVAL, /* 255 */ EINVAL, /* 256 */ EINVAL, /* 257 */ EINVAL, /* 258 */ EINVAL, /* 259 */ EINVAL, /* 260 */ EINVAL, /* 261 */ EINVAL, /* 262 */ EINVAL, /* 263 */ EINVAL, /* 264 */ EINVAL, /* 265 */ EINVAL, /* 266 */ ENOTDIR /* ERROR_DIRECTORY 267 */ }; /* * The following table contains the mapping from WinSock errors to * errno errors. */ static const unsigned char wsaErrorTable[] = { EWOULDBLOCK, /* WSAEWOULDBLOCK */ EINPROGRESS, /* WSAEINPROGRESS */ EALREADY, /* WSAEALREADY */ ENOTSOCK, /* WSAENOTSOCK */ EDESTADDRREQ, /* WSAEDESTADDRREQ */ EMSGSIZE, /* WSAEMSGSIZE */ EPROTOTYPE, /* WSAEPROTOTYPE */ ENOPROTOOPT, /* WSAENOPROTOOPT */ EPROTONOSUPPORT, /* WSAEPROTONOSUPPORT */ ESOCKTNOSUPPORT, /* WSAESOCKTNOSUPPORT */ EOPNOTSUPP, /* WSAEOPNOTSUPP */ EPFNOSUPPORT, /* WSAEPFNOSUPPORT */ EAFNOSUPPORT, /* WSAEAFNOSUPPORT */ EADDRINUSE, /* WSAEADDRINUSE */ EADDRNOTAVAIL, /* WSAEADDRNOTAVAIL */ ENETDOWN, /* WSAENETDOWN */ ENETUNREACH, /* WSAENETUNREACH */ ENETRESET, /* WSAENETRESET */ ECONNABORTED, /* WSAECONNABORTED */ ECONNRESET, /* WSAECONNRESET */ ENOBUFS, /* WSAENOBUFS */ EISCONN, /* WSAEISCONN */ ENOTCONN, /* WSAENOTCONN */ ESHUTDOWN, /* WSAESHUTDOWN */ ETOOMANYREFS, /* WSAETOOMANYREFS */ ETIMEDOUT, /* WSAETIMEDOUT */ ECONNREFUSED, /* WSAECONNREFUSED */ ELOOP, /* WSAELOOP */ ENAMETOOLONG, /* WSAENAMETOOLONG */ EHOSTDOWN, /* WSAEHOSTDOWN */ EHOSTUNREACH, /* WSAEHOSTUNREACH */ ENOTEMPTY, /* WSAENOTEMPTY */ EAGAIN, /* WSAEPROCLIM */ EUSERS, /* WSAEUSERS */ EDQUOT, /* WSAEDQUOT */ ESTALE, /* WSAESTALE */ EREMOTE /* WSAEREMOTE */ }; /* *---------------------------------------------------------------------- * * TclWinConvertError -- * * This routine converts a Win32 error into an errno value. * * Results: * None. * * Side effects: * Sets the errno global variable. * *---------------------------------------------------------------------- */ void TclWinConvertError( DWORD errCode) /* Win32 error code. */ { if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { errCode -= WSAEWOULDBLOCK; if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { Tcl_SetErrno(errorTable[1]); } else { Tcl_SetErrno(wsaErrorTable[errCode]); } } else { Tcl_SetErrno(errorTable[errCode]); } } #ifdef __CYGWIN__ /* *---------------------------------------------------------------------- * * tclWinDebugPanic -- * * Display a message. If a debugger is present, present it directly to * the debugger, otherwise send it to stderr. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ TCL_NORETURN void tclWinDebugPanic( const char *format, ...) { #define TCL_MAX_WARN_LEN 1024 va_list argList; va_start(argList, format); if (IsDebuggerPresent()) { WCHAR msgString[TCL_MAX_WARN_LEN]; char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX]; vsnprintf(buf, sizeof(buf), format, argList); msgString[TCL_MAX_WARN_LEN-1] = L'\0'; MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); /* * Truncate MessageBox string if it is too long to not overflow the buffer. */ if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } OutputDebugStringW(msgString); } else { vfprintf(stderr, format, argList); fprintf(stderr, "\n"); fflush(stderr); } # if defined(__GNUC__) __builtin_trap(); # else DebugBreak(); # endif abort(); } #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ tcl8.6.14/win/tclWinFCmd.c0000644000175000017500000015112414554262142014601 0ustar sergeisergei/* * tclWinFCmd.c * * This file implements the Windows specific portion of file manipulation * subcommands of the "file" command. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" /* * The following constants specify the type of callback when * TraverseWinTree() calls the traverseProc() */ #define DOTREE_PRED 1 /* pre-order directory */ #define DOTREE_POSTD 2 /* post-order directory */ #define DOTREE_F 3 /* regular file */ #define DOTREE_LINK 4 /* symbolic link */ /* * Callbacks for file attributes code. */ static int GetWinFileAttributes(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); static int GetWinFileLongName(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); static int GetWinFileShortName(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); static int SetWinFileAttributes(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); static int CannotSetAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* * Constants and variables necessary for file attributes subcommand. */ enum { WIN_ARCHIVE_ATTRIBUTE, WIN_HIDDEN_ATTRIBUTE, WIN_LONGNAME_ATTRIBUTE, WIN_READONLY_ATTRIBUTE, WIN_SHORTNAME_ATTRIBUTE, WIN_SYSTEM_ATTRIBUTE }; static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", NULL }; const TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileLongName, CannotSetAttribute}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileShortName, CannotSetAttribute}, {GetWinFileAttributes, SetWinFileAttributes}}; /* * Prototype for the TraverseWinTree callback function. */ typedef int (TraversalProc)(const WCHAR *srcPtr, const WCHAR *dstPtr, int type, Tcl_DString *errorPtr); /* * Declarations for local functions defined in this file: */ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName); static int ConvertFileNameFormat(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, int longShort, Tcl_Obj **attributePtrPtr); static int DoCopyFile(const WCHAR *srcPtr, const WCHAR *dstPtr); static int DoCreateDirectory(const WCHAR *pathPtr); static int DoRemoveJustDirectory(const WCHAR *nativeSrc, int ignoreError, Tcl_DString *errorPtr); static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); static int DoRenameFile(const WCHAR *nativeSrc, const WCHAR *dstPtr); static int TraversalCopy(const WCHAR *srcPtr, const WCHAR *dstPtr, int type, Tcl_DString *errorPtr); static int TraversalDelete(const WCHAR *srcPtr, const WCHAR *dstPtr, int type, Tcl_DString *errorPtr); static int TraverseWinTree(TraversalProc *traverseProc, Tcl_DString *sourcePtr, Tcl_DString *dstPtr, Tcl_DString *errorPtr); /* *--------------------------------------------------------------------------- * * TclpObjRenameFile, DoRenameFile -- * * Changes the name of an existing file or directory, from src to dst. * If src and dst refer to the same file or directory, does nothing and * returns success. Otherwise if dst already exists, it will be deleted * and replaced by src subject to the following conditions: * If src is a directory, dst may be an empty directory. * If src is a file, dst may be a file. * In any other situation where dst already exists, the rename will fail. * * Results: * If the file or directory was successfully renamed, returns TCL_OK. * Otherwise the return value is TCL_ERROR and errno is set to indicate * the error. Some possible values for errno are: * * ENAMETOOLONG: src or dst names are too long. * EACCES: src or dst parent directory can't be read and/or written. * EEXIST: dst is a non-empty directory. * EINVAL: src is a root directory or dst is a subdirectory of src. * EISDIR: dst is a directory, but src is not. * ENOENT: src doesn't exist. src or dst is "". * ENOTDIR: src is a directory, but dst is not. * EXDEV: src and dst are on different filesystems. * * EACCES: exists an open file already referring to src or dst. * EACCES: src or dst specify the current working directory (NT). * EACCES: src specifies a char device (nul:, com1:, etc.) * EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT) * EACCES: dst specifies a char device (nul:, com1:, etc.) (95) * * Side effects: * The implementation supports cross-filesystem renames of files, but the * caller should be prepared to emulate cross-filesystem renames of * directories if errno is EXDEV. * *--------------------------------------------------------------------------- */ int TclpObjRenameFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { return DoRenameFile((WCHAR *)Tcl_FSGetNativePath(srcPathPtr), (WCHAR *)Tcl_FSGetNativePath(destPathPtr)); } static int DoRenameFile( const WCHAR *nativeSrc, /* Pathname of file or dir to be renamed * (native). */ const WCHAR *nativeDst) /* New pathname for file or directory * (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) TCLEXCEPTION_REGISTRATION registration; #endif DWORD srcAttr, dstAttr; int retval = -1; /* * The MoveFileW API acts differently under Win95/98 and NT WRT NULL and * "". Avoid passing these values. */ if (nativeSrc == NULL || nativeSrc[0] == '\0' || nativeDst == NULL || nativeDst[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } /* * The MoveFileW API would throw an exception under NT if one of the * arguments is a char block device. */ #if defined(HAVE_NO_SEH) && !defined(_WIN64) /* * Don't have SEH available, do things the hard way. Note that this needs * to be one block of asm, to avoid stack imbalance; also, it is illegal * for one asm block to contain a jump to another. */ __asm__ __volatile__ ( /* * Pick up params before messing with the stack. */ "movl %[nativeDst], %%ebx" "\n\t" "movl %[nativeSrc], %%ecx" "\n\t" /* * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * MoveFileW. */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" /* * Call MoveFileW(nativeSrc, nativeDst) */ "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" "movl %[moveFileW], %%eax" "\n\t" "call *%%eax" "\n\t" /* * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from MoveFileW into it. */ "movl %%fs:0, %%edx" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" /* * Come here however we exited. Restore context from the * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xC(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), [moveFileW] "r" (MoveFileW) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); if (registration.status != FALSE) { retval = TCL_OK; } #else #ifndef HAVE_NO_SEH __try { #endif if ((*MoveFileW)(nativeSrc, nativeDst) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif #endif if (retval != -1) { return retval; } TclWinConvertError(GetLastError()); srcAttr = GetFileAttributesW(nativeSrc); dstAttr = GetFileAttributesW(nativeDst); if (srcAttr == 0xFFFFFFFF) { if (GetFullPathNameW(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } srcAttr = 0; } if (dstAttr == 0xFFFFFFFF) { if (GetFullPathNameW(nativeDst, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } dstAttr = 0; } if (errno == EBADF) { errno = EACCES; return TCL_ERROR; } if (errno == EACCES) { decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { WCHAR *nativeSrcRest, *nativeDstRest; const char **srcArgv, **dstArgv; int size, srcArgc, dstArgc; WCHAR nativeSrcPath[MAX_PATH]; WCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; const char *src, *dst; size = GetFullPathNameW(nativeSrc, MAX_PATH, nativeSrcPath, &nativeSrcRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } size = GetFullPathNameW(nativeDst, MAX_PATH, nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } CharLowerW(nativeSrcPath); CharLowerW(nativeDstPath); src = Tcl_WinTCharToUtf((TCHAR *)nativeSrcPath, -1, &srcString); dst = Tcl_WinTCharToUtf((TCHAR *)nativeDstPath, -1, &dstString); /* * Check whether the destination path is actually inside the * source path. This is true if the prefix matches, and the next * character is either end-of-string or a directory separator */ if ((strncmp(src, dst, Tcl_DStringLength(&srcString))==0) && (dst[Tcl_DStringLength(&srcString)] == '\\' || dst[Tcl_DStringLength(&srcString)] == '/' || dst[Tcl_DStringLength(&srcString)] == '\0')) { /* * Trying to move a directory into itself. */ errno = EINVAL; Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); return TCL_ERROR; } Tcl_SplitPath(src, &srcArgc, &srcArgv); Tcl_SplitPath(dst, &dstArgc, &dstArgv); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); if (srcArgc == 1) { /* * They are trying to move a root directory. Whether or not it * is across filesystems, this cannot be done. */ Tcl_SetErrno(EINVAL); } else if ((srcArgc > 0) && (dstArgc > 0) && (strcmp(srcArgv[0], dstArgv[0]) != 0)) { /* * If src is a directory and dst filesystem != src filesystem, * errno should be EXDEV. It is very important to get this * behavior, so that the caller can respond to a cross * filesystem rename by simulating it with copy and delete. * The MoveFileW system call already handles the case of moving * a file between filesystems. */ Tcl_SetErrno(EXDEV); } ckfree(srcArgv); ckfree(dstArgv); } /* * Other types of access failure is that dst is a read-only * filesystem, that an open file referred to src or dest, or that src * or dest specified the current working directory on the current * filesystem. EACCES is returned for those cases. */ } else if (Tcl_GetErrno() == EEXIST) { /* * Reports EEXIST any time the target already exists. If it makes * sense, remove the old file and try renaming again. */ if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { /* * Overwrite empty dst directory with src directory. The * following call will remove an empty directory. If it fails, * it's because it wasn't empty. */ if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) { /* * Now that that empty directory is gone, we can try * renaming again. If that fails, we'll put this empty * directory back, for completeness. */ if (MoveFileW(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } /* * Some new error has occurred. Don't know what it could * be, but report this one. */ TclWinConvertError(GetLastError()); CreateDirectoryW(nativeDst, NULL); SetFileAttributesW(nativeDst, dstAttr); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. */ goto decode; } } } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ Tcl_SetErrno(ENOTDIR); } } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { Tcl_SetErrno(EISDIR); } else { /* * Overwrite existing file by: * * 1. Rename existing file to temp name. * 2. Rename old file to new name. * 3. If success, delete temp file. If failure, put temp file * back to old name. */ WCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; WCHAR tempBuf[MAX_PATH]; size = GetFullPathNameW(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } nativeTmp = (WCHAR *) tempBuf; nativeRest[0] = L'\0'; result = TCL_ERROR; nativePrefix = (WCHAR *) L"tclr"; if (GetTempFileNameW(nativeTmp, nativePrefix, 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and * MoveFileW to be joined as an atomic operation so no * other app comes along in the meantime and creates the * same temp file. */ nativeTmp = tempBuf; DeleteFileW(nativeTmp); if (MoveFileW(nativeDst, nativeTmp) != FALSE) { if (MoveFileW(nativeSrc, nativeDst) != FALSE) { SetFileAttributesW(nativeTmp, FILE_ATTRIBUTE_NORMAL); DeleteFileW(nativeTmp); return TCL_OK; } else { DeleteFileW(nativeDst); MoveFileW(nativeTmp, nativeDst); } } /* * Can't backup dst file or move src file. Return that * error. Could happen if an open file refers to dst. */ TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. */ goto decode; } } return result; } } } return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * TclpObjCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and is not * a directory, it is removed. * * Results: * If the file was successfully copied, returns TCL_OK. Otherwise the * return value is TCL_ERROR and errno is set to indicate the error. * Some possible values for errno are: * * EACCES: src or dst parent directory can't be read and/or written. * EISDIR: src or dst is a directory. * ENOENT: src doesn't exist. src or dst is "". * * EACCES: exists an open file already referring to dst (95). * EACCES: src specifies a char device (nul:, com1:, etc.) (NT) * ENOENT: src specifies a char device (nul:, com1:, etc.) (95) * * Side effects: * It is not an error to copy to a char device. * *--------------------------------------------------------------------------- */ int TclpObjCopyFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { return DoCopyFile((WCHAR *)Tcl_FSGetNativePath(srcPathPtr), (WCHAR *)Tcl_FSGetNativePath(destPathPtr)); } static int DoCopyFile( const WCHAR *nativeSrc, /* Pathname of file to be copied (native). */ const WCHAR *nativeDst) /* Pathname of file to copy to (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) TCLEXCEPTION_REGISTRATION registration; #endif int retval = -1; /* * The CopyFile API acts differently under Win95/98 and NT WRT NULL and * "". Avoid passing these values. */ if (nativeSrc == NULL || nativeSrc[0] == '\0' || nativeDst == NULL || nativeDst[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } /* * The CopyFile API would throw an exception under NT if one of the * arguments is a char block device. */ #if defined(HAVE_NO_SEH) && !defined(_WIN64) /* * Don't have SEH available, do things the hard way. Note that this needs * to be one block of asm, to avoid stack imbalance; also, it is illegal * for one asm block to contain a jump to another. */ __asm__ __volatile__ ( /* * Pick up parameters before messing with the stack */ "movl %[nativeDst], %%ebx" "\n\t" "movl %[nativeSrc], %%ecx" "\n\t" /* * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * CopyFile. */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" /* * Call CopyFileW(nativeSrc, nativeDst, 0) */ "movl %[copyFileW], %%eax" "\n\t" "pushl $0" "\n\t" "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" "call *%%eax" "\n\t" /* * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from CopyFile into it. */ "movl %%fs:0, %%edx" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" /* * Come here however we exited. Restore context from the * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xC(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), [copyFileW] "r" (CopyFileW) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); if (registration.status != FALSE) { retval = TCL_OK; } #else #ifndef HAVE_NO_SEH __try { #endif if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif #endif if (retval != -1) { return retval; } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EBADF) { Tcl_SetErrno(EACCES); return TCL_ERROR; } if (Tcl_GetErrno() == EACCES) { DWORD srcAttr, dstAttr; srcAttr = GetFileAttributesW(nativeSrc); dstAttr = GetFileAttributesW(nativeDst); if (srcAttr != 0xFFFFFFFF) { if (dstAttr == 0xFFFFFFFF) { dstAttr = 0; } if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) || (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) { if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) { /* Source is a symbolic link -- copy it */ if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst)==0) { return TCL_OK; } } Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { SetFileAttributesW(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } /* * Still can't copy onto dst. Return that error, and restore * attributes of dst. */ TclWinConvertError(GetLastError()); SetFileAttributesW(nativeDst, dstAttr); } } } return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * TclpObjDeleteFile, TclpDeleteFile -- * * Removes a single file (not a directory). * * Results: * If the file was successfully deleted, returns TCL_OK. Otherwise the * return value is TCL_ERROR and errno is set to indicate the error. * Some possible values for errno are: * * EACCES: a parent directory can't be read and/or written. * EISDIR: path is a directory. * ENOENT: path doesn't exist or is "". * * EACCES: exists an open file already referring to path. * EACCES: path is a char device (nul:, com1:, etc.) * * Side effects: * The file is deleted, even if it is read-only. * *--------------------------------------------------------------------------- */ int TclpObjDeleteFile( Tcl_Obj *pathPtr) { return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr)); } int TclpDeleteFile( const void *nativePath) /* Pathname of file to be removed (native). */ { DWORD attr; const WCHAR *path = (const WCHAR *)nativePath; /* * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and * "". Avoid passing these values. */ if (path == NULL || path[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } if (DeleteFileW(path) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { attr = GetFileAttributesW(path); if (attr != 0xFFFFFFFF) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * It is a symbolic link - remove it. */ if (TclWinSymLinkDelete(path, 0) == 0) { return TCL_OK; } } /* * If we fall through here, it is a directory. * * Windows NT reports removing a directory as EACCES instead * of EISDIR. */ Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { int res = SetFileAttributesW(path, attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); if ((res != 0) && (DeleteFileW(path) != FALSE)) { return TCL_OK; } TclWinConvertError(GetLastError()); if (res != 0) { SetFileAttributesW(path, attr); } } } } else if (Tcl_GetErrno() == ENOENT) { attr = GetFileAttributesW(path); if (attr != 0xFFFFFFFF) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* * Windows 95 reports removing a directory as ENOENT instead * of EISDIR. */ Tcl_SetErrno(EISDIR); } } } else if (Tcl_GetErrno() == EINVAL) { /* * Windows NT reports removing a char device as EINVAL instead of * EACCES. */ Tcl_SetErrno(EACCES); } return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * TclpObjCreateDirectory -- * * Creates the specified directory. All parent directories of the * specified directory must already exist. The directory is automatically * created with permissions so that user can access the new directory and * create new files or subdirectories in it. * * Results: * If the directory was successfully created, returns TCL_OK. Otherwise * the return value is TCL_ERROR and errno is set to indicate the error. * Some possible values for errno are: * * EACCES: a parent directory can't be read and/or written. * EEXIST: path already exists. * ENOENT: a parent directory doesn't exist. * * Side effects: * A directory is created. * *--------------------------------------------------------------------------- */ int TclpObjCreateDirectory( Tcl_Obj *pathPtr) { return DoCreateDirectory((WCHAR *)Tcl_FSGetNativePath(pathPtr)); } static int DoCreateDirectory( const WCHAR *nativePath) /* Pathname of directory to create (native). */ { if (CreateDirectoryW(nativePath, NULL) == 0) { DWORD error = GetLastError(); TclWinConvertError(error); return TCL_ERROR; } return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclpObjCopyDirectory -- * * Recursively copies a directory. The target directory dst must not * already exist. Note that this function does not merge two directory * hierarchies, even if the target directory is an empty directory. * * Results: * If the directory was successfully copied, returns TCL_OK. Otherwise * the return value is TCL_ERROR, errno is set to indicate the error, and * the pathname of the file that caused the error is stored in errorPtr. * See TclpCreateDirectory and TclpCopyFile for a description of possible * values for errno. * * Side effects: * An exact copy of the directory hierarchy src will be created with the * name dst. If an error occurs, the error will be returned immediately, * and remaining files will not be processed. * *--------------------------------------------------------------------------- */ int TclpObjCopyDirectory( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_DString srcString, dstString; Tcl_Obj *normSrcPtr, *normDestPtr; int ret; normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); if ((normSrcPtr == NULL) || (normDestPtr == NULL)) { return TCL_ERROR; } Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); if (ret != TCL_OK) { if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normSrcPtr))) { *errorPtr = srcPathPtr; } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) { *errorPtr = destPathPtr; } else { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); } Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } return ret; } /* *---------------------------------------------------------------------- * * TclpObjRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * * Results: * If the directory was successfully removed, returns TCL_OK. Otherwise * the return value is TCL_ERROR, errno is set to indicate the error, and * the pathname of the file that caused the error is stored in errorPtr. * Some possible values for errno are: * * EACCES: path directory can't be read and/or written. * EEXIST: path is a non-empty directory. * EINVAL: path is root directory or current directory. * ENOENT: path doesn't exist or is "". * ENOTDIR: path is not a directory. * * EACCES: path is a char device (nul:, com1:, etc.) (95) * EINVAL: path is a char device (nul:, com1:, etc.) (NT) * * Side effects: * Directory removed. If an error occurs, the error will be returned * immediately, and remaining files will not be deleted. * *---------------------------------------------------------------------- */ int TclpObjRemoveDirectory( Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_Obj *normPtr = NULL; int ret; if (recursive) { /* * In the recursive case, the string rep is used to construct a * Tcl_DString which may be used extensively, so we can't optimize * this case easily. */ Tcl_DString native; normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPtr == NULL) { return TCL_ERROR; } Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { ret = DoRemoveJustDirectory((WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds); } if (ret != TCL_OK) { if (Tcl_DStringLength(&ds) > 0) { if (normPtr != NULL && !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { *errorPtr = TclDStringToObj(&ds); } Tcl_IncrRefCount(*errorPtr); } Tcl_DStringFree(&ds); } return ret; } static int DoRemoveJustDirectory( const WCHAR *nativePath, /* Pathname of directory to be removed * (native). */ int ignoreError, /* If non-zero, don't initialize the errorPtr * under some circumstances on return. */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { DWORD attr; /* * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL * and "". Avoid passing these values. */ if (nativePath == NULL || nativePath[0] == '\0') { Tcl_SetErrno(ENOENT); Tcl_DStringInit(errorPtr); return TCL_ERROR; } attr = GetFileAttributesW(nativePath); if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * It is a symbolic link - remove it. */ if (TclWinSymLinkDelete(nativePath, 0) == 0) { return TCL_OK; } } else { /* * Ordinary directory. */ if (RemoveDirectoryW(nativePath) != FALSE) { return TCL_OK; } } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { attr = GetFileAttributesW(nativePath); if (attr != 0xFFFFFFFF) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * Windows 95 reports calling RemoveDirectory on a file as an * EACCES, not an ENOTDIR. */ Tcl_SetErrno(ENOTDIR); goto end; } if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * It is a symbolic link - remove it. */ if (TclWinSymLinkDelete(nativePath, 1) != 0) { goto end; } } if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; if (SetFileAttributesW(nativePath, attr) == FALSE) { goto end; } if (RemoveDirectoryW(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); SetFileAttributesW(nativePath, attr | FILE_ATTRIBUTE_READONLY); } } } if (Tcl_GetErrno() == ENOTEMPTY) { /* * The caller depends on EEXIST to signify that the directory is not * empty, not ENOTEMPTY. */ Tcl_SetErrno(EEXIST); } if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) { /* * If we're being recursive, this error may actually be ok, so we * don't want to initialise the errorPtr yet. */ return TCL_ERROR; } end: if (errorPtr != NULL) { char *p = Tcl_WinTCharToUtf((TCHAR *)nativePath, -1, errorPtr); for (; *p; ++p) { if (*p == '\\') *p = '/'; } } return TCL_ERROR; } static int DoRemoveDirectory( Tcl_DString *pathPtr, /* Pathname of directory to be removed * (native). */ int recursive, /* If non-zero, removes directories that are * nonempty. Otherwise, will only remove empty * directories. */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { int res = DoRemoveJustDirectory((const WCHAR *)Tcl_DStringValue(pathPtr), recursive, errorPtr); if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { /* * The directory is nonempty, but the recursive flag has been * specified, so we recursively remove all the files in the directory. */ return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr); } else { return res; } } /* *--------------------------------------------------------------------------- * * TraverseWinTree -- * * Traverse directory tree specified by sourcePtr, calling the function * traverseProc for each file and directory encountered. If destPtr is * non-null, each of name in the sourcePtr directory is appended to the * directory specified by destPtr and passed as the second argument to * traverseProc(). * * Results: * Standard Tcl result. * * Side effects: * None caused by TraverseWinTree, however the user specified * traverseProc() may change state. If an error occurs, the error will be * returned immediately, and remaining files will not be processed. * *--------------------------------------------------------------------------- */ static int TraverseWinTree( TraversalProc *traverseProc,/* Function to call for every file and * directory in source hierarchy. */ Tcl_DString *sourcePtr, /* Pathname of source directory to be * traversed (native). */ Tcl_DString *targetPtr, /* Pathname of directory to traverse in * parallel with source directory (native), * may be NULL. */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { DWORD sourceAttr; WCHAR *nativeSource, *nativeTarget, *nativeErrfile; int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen; HANDLE handle; WIN32_FIND_DATAW data; nativeErrfile = NULL; result = TCL_OK; oldTargetLen = 0; /* lint. */ nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); nativeTarget = (WCHAR *) (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); oldSourceLen = Tcl_DStringLength(sourcePtr); sourceAttr = GetFileAttributesW(nativeSource); if (sourceAttr == 0xFFFFFFFF) { nativeErrfile = nativeSource; goto end; } if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * Process the symbolic link */ return traverseProc(nativeSource, nativeTarget, DOTREE_LINK, errorPtr); } if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * Process the regular file */ return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr); } Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); handle = FindFirstFileW(nativeSource, &data); if (handle == INVALID_HANDLE_VALUE) { /* * Can't read directory. */ TclWinConvertError(GetLastError()); nativeErrfile = nativeSource; goto end; } Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); Tcl_DStringSetLength(sourcePtr, oldSourceLen); result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED, errorPtr); if (result != TCL_OK) { FindClose(handle); return result; } sourceLen = oldSourceLen + sizeof(WCHAR); Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { oldTargetLen = Tcl_DStringLength(targetPtr); targetLen = oldTargetLen; targetLen += sizeof(WCHAR); Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); Tcl_DStringSetLength(targetPtr, targetLen); } found = 1; for (; found; found = FindNextFileW(handle, &data)) { WCHAR *nativeName; size_t len; WCHAR *wp = data.cFileName; if (*wp == '.') { wp++; if (*wp == '.') { wp++; } if (*wp == '\0') { continue; } } nativeName = (WCHAR *) data.cFileName; len = wcslen(data.cFileName) * sizeof(WCHAR); /* * Append name after slash, and recurse on the file. */ Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1); Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); if (targetPtr != NULL) { Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1); Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1); } result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, errorPtr); if (result != TCL_OK) { break; } /* * Remove name after slash. */ Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, targetLen); } } FindClose(handle); /* * Strip off the trailing slash we added. */ Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); Tcl_DStringSetLength(sourcePtr, oldSourceLen); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, oldTargetLen + 1); Tcl_DStringSetLength(targetPtr, oldTargetLen); } if (result == TCL_OK) { /* * Call traverseProc() on a directory after visiting all the * files in that directory. */ result = traverseProc((const WCHAR *)Tcl_DStringValue(sourcePtr), (const WCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), DOTREE_POSTD, errorPtr); } end: if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { Tcl_WinTCharToUtf((TCHAR *)nativeErrfile, -1, errorPtr); } result = TCL_ERROR; } return result; } /* *---------------------------------------------------------------------- * * TraversalCopy * * Called from TraverseUnixTree in order to execute a recursive copy of a * directory. * * Results: * Standard Tcl result. * * Side effects: * Depending on the value of type, src may be copied to dst. * *---------------------------------------------------------------------- */ static int TraversalCopy( const WCHAR *nativeSrc, /* Source pathname to copy. */ const WCHAR *nativeDst, /* Destination pathname of copy. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ { switch (type) { case DOTREE_F: if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) { return TCL_OK; } break; case DOTREE_LINK: if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) { return TCL_OK; } break; case DOTREE_PRED: if (DoCreateDirectory(nativeDst) == TCL_OK) { DWORD attr = GetFileAttributesW(nativeSrc); if (SetFileAttributesW(nativeDst, attr) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); } break; case DOTREE_POSTD: return TCL_OK; } /* * There shouldn't be a problem with src, because we already checked it to * get here. */ if (errorPtr != NULL) { Tcl_WinTCharToUtf((TCHAR *)nativeDst, -1, errorPtr); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TraversalDelete -- * * Called by function TraverseWinTree for every file and directory that * it encounters in a directory hierarchy. This function unlinks files, * and removes directories after all the containing files have been * processed. * * Results: * Standard Tcl result. * * Side effects: * Files or directory specified by src will be deleted. If an error * occurs, the windows error is converted to a Posix error and errno is * set accordingly. * *---------------------------------------------------------------------- */ static int TraversalDelete( const WCHAR *nativeSrc, /* Source pathname to delete. */ const WCHAR *dstPtr, /* Not used. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ { switch (type) { case DOTREE_F: if (TclpDeleteFile(nativeSrc) == TCL_OK) { return TCL_OK; } break; case DOTREE_LINK: if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { return TCL_OK; } break; case DOTREE_PRED: return TCL_OK; case DOTREE_POSTD: if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { return TCL_OK; } break; } if (errorPtr != NULL) { Tcl_WinTCharToUtf((TCHAR *)nativeSrc, -1, errorPtr); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * StatError -- * * Sets the object result with the appropriate error. * * Results: * None. * * Side effects: * The interp's object result is set with an error message based on the * objIndex, fileName and errno. * *---------------------------------------------------------------------- */ static void StatError( Tcl_Interp *interp, /* The interp that has the error */ Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } /* *---------------------------------------------------------------------- * * GetWinFileAttributes -- * * Returns a Tcl_Obj containing the value of a file attribute. This * routine gets the -hidden, -readonly or -system attribute. * * Results: * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will * have ref count 0. If the return value is not TCL_OK, attributePtrPtr * is not touched. * * Side effects: * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ static int GetWinFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result; const WCHAR *nativeName; int attr; nativeName = (WCHAR *)Tcl_FSGetNativePath(fileName); result = GetFileAttributesW(nativeName); if (result == 0xFFFFFFFF) { StatError(interp, fileName); return TCL_ERROR; } attr = (int)(result & attributeArray[objIndex]); if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) { /* * It is hidden. However there is a bug on some Windows OSes in which * root volumes (drives) formatted as NTFS are declared hidden when * they are not (and cannot be). * * We test for, and fix that case, here. */ int len; const char *str = Tcl_GetStringFromObj(fileName,&len); if (len < 4) { if (len == 0) { /* * Not sure if this is possible, but we pass it on anyway. */ } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) { /* * Path is pointing to the root volume. */ attr = 0; } else if ((str[1] == ':') && (len == 2 || (str[2] == '/' || str[2] == '\\'))) { /* * Path is of the form 'x:' or 'x:/' or 'x:\' */ attr = 0; } } } *attributePtrPtr = Tcl_NewBooleanObj(attr); return TCL_OK; } /* *---------------------------------------------------------------------- * * ConvertFileNameFormat -- * * Returns a Tcl_Obj containing either the long or short version of the * file name. * * Results: * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will * have ref count 0. If the return value is not TCL_OK, attributePtrPtr * is not touched. * * Warning: if you pass this function a drive name like 'c:' it will * actually return the current working directory on that drive. To avoid * this, make sure the drive name ends in a slash, like this 'c:/'. * * Side effects: * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ static int ConvertFileNameFormat( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file. */ int longShort, /* 0 to short name, 1 to long name. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { int pathc, i; Tcl_Obj *splitPath; splitPath = Tcl_FSSplitPath(fileName, &pathc); if (splitPath == NULL || pathc == 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", Tcl_GetString(fileName))); errno = ENOENT; Tcl_PosixError(interp); } goto cleanup; } /* * We will decrement this again at the end. It is safer to do this in * case any of the calls below retain a reference to splitPath. */ Tcl_IncrRefCount(splitPath); for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; int pathLen; Tcl_ListObjIndex(NULL, splitPath, i, &elt); pathv = Tcl_GetStringFromObj(elt, &pathLen); if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':')) || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) { /* * Handle "/", "//machine/export", "c:/", "." or ".." by just * copying the string literally. Uppercase the drive letter, just * because it looks better under Windows to do so. */ simple: /* * Here we are modifying the string representation in place. * * I believe this is legal, since this won't affect any file * representation this thing may have. */ pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0])); } else { Tcl_Obj *tempPath; Tcl_DString ds; Tcl_DString dsTemp; const WCHAR *nativeName; const char *tempString; int tempLen; WIN32_FIND_DATAW data; HANDLE handle; DWORD attr; tempPath = Tcl_FSJoinPath(splitPath, i+1); Tcl_IncrRefCount(tempPath); /* * We'd like to call Tcl_FSGetNativePath(tempPath) but that is * likely to lead to infinite loops. */ Tcl_DStringInit(&ds); tempString = Tcl_GetStringFromObj(tempPath,&tempLen); nativeName = (WCHAR *)Tcl_WinUtfToTChar(tempString, tempLen, &ds); Tcl_DecrRefCount(tempPath); handle = FindFirstFileW(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* * FindFirstFileW() doesn't like root directories. We would * only get a root directory here if the caller specified "c:" * or "c:." and the current directory on the drive was the * root directory */ attr = GetFileAttributesW(nativeName); if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); goto simple; } } if (handle == INVALID_HANDLE_VALUE) { Tcl_DStringFree(&ds); if (interp != NULL) { StatError(interp, fileName); } goto cleanup; } nativeName = data.cAlternateFileName; if (longShort) { if (data.cFileName[0] != '\0') { nativeName = data.cFileName; } } else { if (data.cAlternateFileName[0] == '\0') { nativeName = (WCHAR *) data.cFileName; } } /* * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying * to dereference nativeName as a Unicode string. I have proven to * myself that purify is wrong by running the following example * when nativeName == data.w.cAlternateFileName and noting that * purify doesn't complain about the first line, but does complain * about the second. * * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]); * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); */ Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf((TCHAR *)nativeName, -1, &dsTemp); Tcl_DStringFree(&ds); /* * Deal with issues of tildes being absolute. */ if (Tcl_DStringValue(&dsTemp)[0] == '~') { TclNewLiteralStringObj(tempPath, "./"); Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), Tcl_DStringLength(&dsTemp)); Tcl_DStringFree(&dsTemp); } else { tempPath = TclDStringToObj(&dsTemp); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); } } *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1); if (splitPath != NULL) { /* * Unfortunately, the object we will return may have its only refCount * as part of the list splitPath. This means if we free splitPath, the * object will disappear. So, we have to be very careful here. * Unfortunately this means we must manipulate the object's refCount * directly. */ Tcl_IncrRefCount(*attributePtrPtr); Tcl_DecrRefCount(splitPath); --(*attributePtrPtr)->refCount; } return TCL_OK; cleanup: if (splitPath != NULL) { Tcl_DecrRefCount(splitPath); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * GetWinFileLongName -- * * Returns a Tcl_Obj containing the long version of the file name. * * Results: * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will * have ref count 0. If the return value is not TCL_OK, attributePtrPtr * is not touched. * * Side effects: * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ static int GetWinFileLongName( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr); } /* *---------------------------------------------------------------------- * * GetWinFileShortName -- * * Returns a Tcl_Obj containing the short version of the file name. * * Results: * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will * have ref count 0. If the return value is not TCL_OK, attributePtrPtr * is not touched. * * Side effects: * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ static int GetWinFileShortName( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr); } /* *---------------------------------------------------------------------- * * SetWinFileAttributes -- * * Set the file attributes to the value given by attributePtr. This * routine sets the -hidden, -readonly, or -system attributes. * * Results: * Standard TCL error. * * Side effects: * The file's attribute is set. * *---------------------------------------------------------------------- */ static int SetWinFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { DWORD fileAttributes, old; int yesNo, result; const WCHAR *nativeName; nativeName = (WCHAR *)Tcl_FSGetNativePath(fileName); fileAttributes = old = GetFileAttributesW(nativeName); if (fileAttributes == 0xFFFFFFFF) { StatError(interp, fileName); return TCL_ERROR; } result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo); if (result != TCL_OK) { return result; } if (yesNo) { fileAttributes |= (attributeArray[objIndex]); } else { fileAttributes &= ~(attributeArray[objIndex]); } if ((fileAttributes != old) && !SetFileAttributesW(nativeName, fileAttributes)) { StatError(interp, fileName); return TCL_ERROR; } return result; } /* *---------------------------------------------------------------------- * * SetWinFileLongName -- * * The attribute in question is a readonly attribute and cannot be set. * * Results: * TCL_ERROR * * Side effects: * The object result is set to a pertinent error message. * *---------------------------------------------------------------------- */ static int CannotSetAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); errno = EINVAL; Tcl_PosixError(interp); return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * TclpObjListVolumes -- * * Lists the currently mounted volumes * * Results: * The list of volumes. * * Side effects: * None * *--------------------------------------------------------------------------- */ Tcl_Obj * TclpObjListVolumes(void) { Tcl_Obj *resultPtr, *elemPtr; char buf[40 * 4]; /* There couldn't be more than 30 drives??? */ int i; char *p; TclNewObj(resultPtr); /* * On Win32s: * GetLogicalDriveStrings() isn't implemented. * GetLogicalDrives() returns incorrect information. */ if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) { /* * GetVolumeInformationW() will detect all drives, but causes * chattering on empty floppy drives. We only do this if * GetLogicalDriveStrings() didn't work. It has also been reported * that on some laptops it takes a while for GetVolumeInformationW() to * return when pinging an empty floppy drive, another reason to try to * avoid calling it. */ buf[1] = ':'; buf[2] = '/'; buf[3] = '\0'; for (i = 0; i < 26; i++) { buf[0] = (char) ('a' + i); if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) || (GetLastError() == ERROR_NOT_READY)) { elemPtr = Tcl_NewStringObj(buf, -1); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } } else { for (p = buf; *p != '\0'; p += 4) { p[2] = '/'; elemPtr = Tcl_NewStringObj(p, -1); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } Tcl_IncrRefCount(resultPtr); return resultPtr; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinFile.c0000644000175000017500000024677314554262142014666 0ustar sergeisergei/* * tclWinFile.c -- * * This file contains temporary wrappers around UNIX file handling * functions. These wrappers map the UNIX functions to Win32 HANDLE-style * files, which can be manipulated through the Win32 console redirection * interfaces. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" #include "tclFileSystem.h" #include #include #include /* For TclpGetUserHome(). */ #include /* For TclpGetUserHome(). */ #include /* For GetNamedSecurityInfo */ #ifdef _MSC_VER # pragma comment(lib, "userenv.lib") #endif /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). */ #define POSIX_EPOCH_AS_FILETIME \ ((Tcl_WideInt) 116444736 * (Tcl_WideInt) 1000000000) /* * Declarations for 'link' related information. This information should come * with VC++ 6.0, but is not in some older SDKs. In any case it is not well * documented. */ #ifndef IO_REPARSE_TAG_RESERVED_ONE # define IO_REPARSE_TAG_RESERVED_ONE 0x000000001 #endif #ifndef IO_REPARSE_TAG_RESERVED_RANGE # define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001 #endif #ifndef IO_REPARSE_TAG_VALID_VALUES # define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF #endif #ifndef IO_REPARSE_TAG_HSM # define IO_REPARSE_TAG_HSM 0x0C0000004 #endif #ifndef IO_REPARSE_TAG_NSS # define IO_REPARSE_TAG_NSS 0x080000005 #endif #ifndef IO_REPARSE_TAG_NSSRECOVER # define IO_REPARSE_TAG_NSSRECOVER 0x080000006 #endif #ifndef IO_REPARSE_TAG_SIS # define IO_REPARSE_TAG_SIS 0x080000007 #endif #ifndef IO_REPARSE_TAG_DFS # define IO_REPARSE_TAG_DFS 0x080000008 #endif #ifndef IO_REPARSE_TAG_RESERVED_ZERO # define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000 #endif #ifndef FILE_FLAG_OPEN_REPARSE_POINT # define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 #endif #ifndef IO_REPARSE_TAG_MOUNT_POINT # define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003 #endif #ifndef IsReparseTagValid # define IsReparseTagValid(x) \ (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE)) #endif #ifndef IO_REPARSE_TAG_SYMBOLIC_LINK # define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO #endif #ifndef FILE_SPECIAL_ACCESS # define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS) #endif #ifndef FSCTL_SET_REPARSE_POINT # define FSCTL_SET_REPARSE_POINT \ CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) # define FSCTL_GET_REPARSE_POINT \ CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) # define FSCTL_DELETE_REPARSE_POINT \ CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) #endif #ifndef INVALID_FILE_ATTRIBUTES #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) #endif /* * Maximum reparse buffer info size. The max user defined reparse data is * 16KB, plus there's a header. */ #define MAX_REPARSE_SIZE 17000 /* * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition. This is * found in winnt.h. * * IMPORTANT: caution when using this structure, since the actual structures * used will want to store a full path in the 'PathBuffer' field, but there * isn't room (there's only a single WCHAR!). Therefore one must artificially * create a larger space of memory and then cast it to this type. We use the * 'DUMMY_REPARSE_BUFFER' struct just below to deal with this problem. */ #define REPARSE_MOUNTPOINT_HEADER_SIZE 8 #ifndef REPARSE_DATA_BUFFER_HEADER_SIZE typedef struct _REPARSE_DATA_BUFFER { DWORD ReparseTag; WORD ReparseDataLength; WORD Reserved; union { struct { WORD SubstituteNameOffset; WORD SubstituteNameLength; WORD PrintNameOffset; WORD PrintNameLength; ULONG Flags; WCHAR PathBuffer[1]; } SymbolicLinkReparseBuffer; struct { WORD SubstituteNameOffset; WORD SubstituteNameLength; WORD PrintNameOffset; WORD PrintNameLength; WCHAR PathBuffer[1]; } MountPointReparseBuffer; struct { BYTE DataBuffer[1]; } GenericReparseBuffer; }; } REPARSE_DATA_BUFFER; #endif typedef struct { REPARSE_DATA_BUFFER dummy; WCHAR dummyBuf[MAX_PATH * 3]; } DUMMY_REPARSE_BUFFER; /* * Other typedefs required by this code. */ static time_t ToCTime(FILETIME fileTime); static void FromCTime(time_t posixTime, FILETIME *fileTime); /* * Declarations for local functions defined in this file: */ static int NativeAccess(const WCHAR *path, int mode); static int NativeDev(const WCHAR *path); static int NativeStat(const WCHAR *path, Tcl_StatBuf *statPtr, int checkLinks); static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec); static int NativeIsExec(const WCHAR *path); static int NativeReadReparse(const WCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess); static int NativeWriteReparse(const WCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer); static int NativeMatchType(int isDrive, DWORD attr, const WCHAR *nativeName, Tcl_GlobTypeData *types); static int WinIsDrive(const char *name, size_t nameLen); static int WinIsReserved(const char *path); static Tcl_Obj * WinReadLink(const WCHAR *LinkSource); static Tcl_Obj * WinReadLinkDirectory(const WCHAR *LinkDirectory); static int WinLink(const WCHAR *LinkSource, const WCHAR *LinkTarget, int linkAction); static int WinSymLinkDirectory(const WCHAR *LinkDirectory, const WCHAR *LinkTarget); MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); /* *-------------------------------------------------------------------- * * WinLink -- * * Make a link from source to target. * *-------------------------------------------------------------------- */ static int WinLink( const WCHAR *linkSourcePath, const WCHAR *linkTargetPath, int linkAction) { WCHAR tempFileName[MAX_PATH]; WCHAR *tempFilePart; DWORD attr; /* * Get the full path referenced by the target. */ if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. */ TclWinConvertError(GetLastError()); return -1; } /* * Make sure source file doesn't exist. */ attr = GetFileAttributesW(linkSourcePath); if (attr != INVALID_FILE_ATTRIBUTES) { Tcl_SetErrno(EEXIST); return -1; } /* * Get the full path referenced by the source file/directory. */ if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. */ TclWinConvertError(GetLastError()); return -1; } /* * Check the target. */ attr = GetFileAttributesW(linkTargetPath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The target doesn't exist. */ TclWinConvertError(GetLastError()); } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * It is a file. */ if (linkAction & TCL_CREATE_HARD_LINK) { if (CreateHardLinkW(linkSourcePath, linkTargetPath, NULL)) { /* * Success! */ return 0; } TclWinConvertError(GetLastError()); } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { if (!tclWinProcs.createSymbolicLink) { /* * Can't symlink files. */ Tcl_SetErrno(EINVAL); } else if (tclWinProcs.createSymbolicLink(linkSourcePath, linkTargetPath, 0x2 /* SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE */)) { /* * Success! */ return 0; } else { TclWinConvertError(GetLastError()); } } else { Tcl_SetErrno(ENODEV); } } else { /* * We've got a directory. Now check whether what we're trying to do is * reasonable. */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { return WinSymLinkDirectory(linkSourcePath, linkTargetPath); } else if (linkAction & TCL_CREATE_HARD_LINK) { /* * Can't hard link directories. */ Tcl_SetErrno(EISDIR); } else { Tcl_SetErrno(ENODEV); } } return -1; } /* *-------------------------------------------------------------------- * * WinReadLink -- * * What does 'LinkSource' point to? * *-------------------------------------------------------------------- */ static Tcl_Obj * WinReadLink( const WCHAR *linkSourcePath) { WCHAR tempFileName[MAX_PATH]; WCHAR *tempFilePart; DWORD attr; /* * Get the full path referenced by the target. */ if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. */ TclWinConvertError(GetLastError()); return NULL; } /* * Make sure source file does exist. */ attr = GetFileAttributesW(linkSourcePath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The source doesn't exist. */ TclWinConvertError(GetLastError()); return NULL; } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * It is a file - this is not yet supported. */ Tcl_SetErrno(ENOTDIR); return NULL; } return WinReadLinkDirectory(linkSourcePath); } /* *-------------------------------------------------------------------- * * WinSymLinkDirectory -- * * This routine creates a NTFS junction, using the undocumented * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points and * junctions. * * Assumption that linkTargetPath is a valid, existing directory. * * Returns: * Zero on success. * *-------------------------------------------------------------------- */ static int WinSymLinkDirectory( const WCHAR *linkDirPath, const WCHAR *linkTargetPath) { DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; int len; WCHAR nativeTarget[MAX_PATH]; WCHAR *loop; /* * Make the native target name. */ memcpy(nativeTarget, L"\\??\\", 4 * sizeof(WCHAR)); memcpy(nativeTarget + 4, linkTargetPath, sizeof(WCHAR) * (1+wcslen((WCHAR *) linkTargetPath))); len = wcslen(nativeTarget); /* * We must have backslashes only. This is VERY IMPORTANT. If we have any * forward slashes everything appears to work, but the resulting symlink * is useless! */ for (loop = nativeTarget; *loop != 0; loop++) { if (*loop == '/') { *loop = '\\'; } } if ((nativeTarget[len-1] == '\\') && (nativeTarget[len-2] != ':')) { nativeTarget[len-1] = 0; } /* * Build the reparse info. */ memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; reparseBuffer->MountPointReparseBuffer.SubstituteNameLength = wcslen(nativeTarget) * sizeof(WCHAR); reparseBuffer->Reserved = 0; reparseBuffer->MountPointReparseBuffer.PrintNameLength = 0; reparseBuffer->MountPointReparseBuffer.PrintNameOffset = reparseBuffer->MountPointReparseBuffer.SubstituteNameLength + sizeof(WCHAR); memcpy(reparseBuffer->MountPointReparseBuffer.PathBuffer, nativeTarget, sizeof(WCHAR) + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength); reparseBuffer->ReparseDataLength = reparseBuffer->MountPointReparseBuffer.SubstituteNameLength+12; return NativeWriteReparse(linkDirPath, reparseBuffer); } /* *-------------------------------------------------------------------- * * TclWinSymLinkCopyDirectory -- * * Copy a Windows NTFS junction. This function assumes that LinkOriginal * exists and is a valid junction point, and that LinkCopy does not * exist. * * Returns: * Zero on success. * *-------------------------------------------------------------------- */ int TclWinSymLinkCopyDirectory( const WCHAR *linkOrigPath, /* Existing junction - reparse point */ const WCHAR *linkCopyPath) /* Will become a duplicate junction */ { DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; if (NativeReadReparse(linkOrigPath, reparseBuffer, GENERIC_READ)) { return -1; } return NativeWriteReparse(linkCopyPath, reparseBuffer); } /* *-------------------------------------------------------------------- * * TclWinSymLinkDelete -- * * Delete a Windows NTFS junction. Once the junction information is * deleted, the filesystem object becomes an ordinary directory. Unless * 'linkOnly' is given, that directory is also removed. * * Assumption that LinkOriginal is a valid, existing junction. * * Returns: * Zero on success. * *-------------------------------------------------------------------- */ int TclWinSymLinkDelete( const WCHAR *linkOrigPath, int linkOnly) { /* * It is a symbolic link - remove it. */ DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; HANDLE hFile; DWORD returnedLength; memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; hFile = CreateFileW(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile != INVALID_HANDLE_VALUE) { if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) { /* * Error setting junction. */ TclWinConvertError(GetLastError()); CloseHandle(hFile); } else { CloseHandle(hFile); if (!linkOnly) { RemoveDirectoryW(linkOrigPath); } return 0; } } return -1; } /* *-------------------------------------------------------------------- * * WinReadLinkDirectory -- * * This routine reads a NTFS junction, using the undocumented * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points and * junctions. * * Assumption that LinkDirectory is a valid, existing directory. * * Returns: * A Tcl_Obj with refCount of 1 (i.e. owned by the caller), or NULL if * anything went wrong. * * In the future we should enhance this to return a path object rather * than a string. * *-------------------------------------------------------------------- */ #if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Warray-bounds" #endif static Tcl_Obj * WinReadLinkDirectory( const WCHAR *linkDirPath) { int attr, len, offset; DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; Tcl_Obj *retVal; Tcl_DString ds; const char *copy; attr = GetFileAttributesW(linkDirPath); if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { goto invalidError; } if (NativeReadReparse(linkDirPath, reparseBuffer, 0)) { return NULL; } switch (reparseBuffer->ReparseTag) { case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: case IO_REPARSE_TAG_SYMBOLIC_LINK: case IO_REPARSE_TAG_MOUNT_POINT: /* * Certain native path representations on Windows have a special * prefix to indicate that they are to be treated specially. For * example extremely long paths, or symlinks, or volumes mounted * inside directories. * * There is an assumption in this code that 'wide' interfaces are * being used (see tclWin32Dll.c), which is true for the only systems * which support reparse tags at present. If that changes in the * future, this code will have to be generalised. */ offset = 0; if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == '\\') { /* * Check whether this is a mounted volume. */ if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer, L"\\??\\Volume{",11) == 0) { char drive; /* * There is some confusion between \??\ and \\?\ which we have * to fix here. It doesn't seem very well documented. */ reparseBuffer->MountPointReparseBuffer.PathBuffer[1] = '\\'; /* * Check if a corresponding drive letter exists, and use that * if it is found */ drive = TclWinDriveLetterForVolMountPoint( reparseBuffer->MountPointReparseBuffer.PathBuffer); if (drive != -1) { char driveSpec[3] = { '\0', ':', '\0' }; driveSpec[0] = drive; retVal = Tcl_NewStringObj(driveSpec,2); Tcl_IncrRefCount(retVal); return retVal; } /* * This is actually a mounted drive, which doesn't exists as a * DOS drive letter. This means the path isn't actually a * link, although we partially treat it like one ('file type' * will return 'link'), but then the link will actually just * be treated like an ordinary directory. I don't believe any * serious inconsistency will arise from this, but it is * something to be aware of. */ goto invalidError; } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer .PathBuffer, L"\\\\?\\",4) == 0) { /* * Strip off the prefix. */ offset = 4; } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer .PathBuffer, L"\\??\\",4) == 0) { /* * Strip off the prefix. */ offset = 4; } } Tcl_WinTCharToUtf((TCHAR *) reparseBuffer->MountPointReparseBuffer.PathBuffer, reparseBuffer->MountPointReparseBuffer .SubstituteNameLength, &ds); copy = Tcl_DStringValue(&ds)+offset; len = Tcl_DStringLength(&ds)-offset; retVal = Tcl_NewStringObj(copy,len); Tcl_IncrRefCount(retVal); Tcl_DStringFree(&ds); return retVal; } invalidError: Tcl_SetErrno(EINVAL); return NULL; } #if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) #pragma GCC diagnostic pop #endif /* *-------------------------------------------------------------------- * * NativeReadReparse -- * * Read the junction/reparse information from a given NTFS directory. * * Assumption that linkDirPath is a valid, existing directory. * * Returns: * Zero on success. * *-------------------------------------------------------------------- */ static int NativeReadReparse( const WCHAR *linkDirPath, /* The junction to read */ REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */ DWORD desiredAccess) { HANDLE hFile; DWORD returnedLength; hFile = CreateFileW(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* * Error creating directory. */ TclWinConvertError(GetLastError()); return -1; } /* * Get the link. */ if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, 0, buffer, sizeof(DUMMY_REPARSE_BUFFER), &returnedLength, NULL)) { /* * Error setting junction. */ TclWinConvertError(GetLastError()); CloseHandle(hFile); return -1; } CloseHandle(hFile); if (!IsReparseTagValid(buffer->ReparseTag)) { Tcl_SetErrno(EINVAL); return -1; } return 0; } /* *-------------------------------------------------------------------- * * NativeWriteReparse -- * * Write the reparse information for a given directory. * * Assumption that LinkDirectory does not exist. * *-------------------------------------------------------------------- */ static int NativeWriteReparse( const WCHAR *linkDirPath, REPARSE_DATA_BUFFER *buffer) { HANDLE hFile; DWORD returnedLength; /* * Create the directory - it must not already exist. */ if (CreateDirectoryW(linkDirPath, NULL) == 0) { /* * Error creating directory. */ TclWinConvertError(GetLastError()); return -1; } hFile = CreateFileW(linkDirPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* * Error creating directory. */ TclWinConvertError(GetLastError()); return -1; } /* * Set the link. */ if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer, (DWORD) buffer->ReparseDataLength + REPARSE_MOUNTPOINT_HEADER_SIZE, NULL, 0, &returnedLength, NULL)) { /* * Error setting junction. */ TclWinConvertError(GetLastError()); CloseHandle(hFile); RemoveDirectoryW(linkDirPath); return -1; } CloseHandle(hFile); /* * We succeeded. */ return 0; } /* *---------------------------------------------------------------------- * * tclWinDebugPanic -- * * Display a message. If a debugger is present, present it directly to * the debugger, otherwise use a MessageBox. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ TCL_NORETURN void tclWinDebugPanic( const char *format, ...) { #define TCL_MAX_WARN_LEN 1024 va_list argList; char buf[TCL_MAX_WARN_LEN * 3]; WCHAR msgString[TCL_MAX_WARN_LEN]; va_start(argList, format); vsnprintf(buf, sizeof(buf), format, argList); msgString[TCL_MAX_WARN_LEN-1] = '\0'; MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); /* * Truncate MessageBox string if it is too long to not overflow the screen * and cause possible oversized window error. */ if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } if (IsDebuggerPresent()) { OutputDebugStringW(msgString); } else { MessageBeep(MB_ICONEXCLAMATION); MessageBoxW(NULL, msgString, L"Fatal Error", MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); } #if defined(__GNUC__) __builtin_trap(); #elif defined(_WIN64) __debugbreak(); #elif defined(_MSC_VER) && defined (_M_IX86) _asm {int 3} #else DebugBreak(); #endif abort(); } /* *--------------------------------------------------------------------------- * * TclpFindExecutable -- * * This function computes the absolute path name of the current * application. * * Results: * None. * * Side effects: * The computed path is stored. * *--------------------------------------------------------------------------- */ void TclpFindExecutable( const char *argv0) /* If NULL, install PanicMessageBox, otherwise * ignore. */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * 3]; /* * Under Windows we ignore argv0, and return the path for the file used to * create this process. Only if it is NULL, install a new panic handler. */ if (argv0 == NULL) { Tcl_SetPanicProc(tclWinDebugPanic); } GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR)); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); TclWinNoBackslash(name); TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); } /* *---------------------------------------------------------------------- * * TclpMatchInDirectory -- * * This routine is used by the globbing code to search a directory for * all files which match a given pattern. * * Results: * The return value is a standard Tcl result indicating whether an error * occurred in globbing. Errors are left in interp, good results are * lappended to resultPtr (which must be a valid object). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpMatchInDirectory( Tcl_Interp *interp, /* Interpreter to receive errors. */ Tcl_Obj *resultPtr, /* List object to lappend results. */ Tcl_Obj *pathPtr, /* Contains path to directory to search. */ const char *pattern, /* Pattern to match against. */ Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. In particular the directory * flag is very important. */ { const WCHAR *native; if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) { /* * The native filesystem never adds mounts. */ return TCL_OK; } if (pattern == NULL || (*pattern == '\0')) { Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (norm != NULL) { /* * Match a single file directly. */ int len; DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; const char *str = Tcl_GetStringFromObj(norm,&len); native = (WCHAR *)Tcl_FSGetNativePath(pathPtr); if (GetFileAttributesExW(native, GetFileExInfoStandard, &data) != TRUE) { return TCL_OK; } attr = data.dwFileAttributes; if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } return TCL_OK; } else { DWORD attr; HANDLE handle; WIN32_FIND_DATAW data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ int dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ Tcl_DString dsOrig; /* UTF-8 encoding of dir. */ Tcl_Obj *fileNamePtr; char lastChar; /* * Get the normalized path representation (the main thing is we dont * want any '~' sequences). */ fileNamePtr = Tcl_FSGetNormalizedPath(interp, pathPtr); if (fileNamePtr == NULL) { return TCL_ERROR; } /* * Verify that the specified path exists and is actually a directory. */ native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (native == NULL) { return TCL_OK; } attr = GetFileAttributesW(native); if ((attr == INVALID_FILE_ATTRIBUTES) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { return TCL_OK; } /* * Build up the directory name for searching, including a trailing * directory separator. */ Tcl_DStringInit(&dsOrig); dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } dirName = Tcl_DStringValue(&dsOrig); /* * We need to check all files in the directory, so we append '*.*' to * the path, unless the pattern we've been given is rather simple, * when we can use that instead. */ if (strpbrk(pattern, "[]\\") == NULL) { /* * The pattern is a simple one containing just '*' and/or '?'. * This means we can get the OS to help us, by passing it the * pattern. */ dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } native = (WCHAR *)Tcl_WinUtfToTChar(dirName, -1, &ds); if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { handle = FindFirstFileW(native, &data); } else { /* * We can be more efficient, for pure directory requests. */ handle = FindFirstFileExW(native, FindExInfoStandard, &data, FindExSearchLimitToDirectories, NULL, 0); } if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); Tcl_DStringFree(&ds); if (err == ERROR_FILE_NOT_FOUND) { /* * We used our 'pattern' above, and matched nothing. This * means we just return TCL_OK, indicating no results found. */ Tcl_DStringFree(&dsOrig); return TCL_OK; } TclWinConvertError(err); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read directory \"%s\": %s", Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); } Tcl_DStringFree(&dsOrig); return TCL_ERROR; } Tcl_DStringFree(&ds); /* * We may use this later, so we must restore it to its length * including the directory delimiter. */ Tcl_DStringSetLength(&dsOrig, dirLength); /* * Check to see if the pattern should match the special . and * .. names, referring to the current directory, or the directory * above. We need a special check for this because paths beginning * with a dot are not considered hidden on Windows, and so otherwise a * relative glob like 'glob -join * *' will actually return * './. ../..' etc. */ if ((pattern[0] == '.') || ((pattern[0] == '\\') && (pattern[1] == '.'))) { matchSpecialDots = 1; } else { matchSpecialDots = 0; } /* * Now iterate over all of the files in the directory, starting with * the first one we found. */ do { const char *utfname; int checkDrive = 0, isDrive; native = data.cFileName; attr = data.dwFileAttributes; utfname = Tcl_WinTCharToUtf((TCHAR *)native, -1, &ds); if (!matchSpecialDots) { /* * If it is exactly '.' or '..' then we ignore it. */ if ((utfname[0] == '.') && (utfname[1] == '\0' || (utfname[1] == '.' && utfname[2] == '\0'))) { Tcl_DStringFree(&ds); continue; } } else if (utfname[0] == '.' && utfname[1] == '.' && utfname[2] == '\0') { /* * Have to check if this is a drive below, so we can correctly * match 'hidden' and not hidden files. */ checkDrive = 1; } /* * Check to see if the file matches the pattern. Note that we are * ignoring the case sensitivity flag because Windows doesn't * honor case even if the volume is case sensitive. If the volume * also doesn't preserve case, then we previously returned the * lower case form of the name. This didn't seem quite right since * there are non-case-preserving volumes that actually return * mixed case. So now we are returning exactly what we get from * the system. */ if (Tcl_StringCaseMatch(utfname, pattern, 1)) { /* * If the file matches, then we need to process the remainder * of the path. */ if (checkDrive) { const char *fullname = Tcl_DStringAppend(&dsOrig, utfname, Tcl_DStringLength(&ds)); isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig)); Tcl_DStringSetLength(&dsOrig, dirLength); } else { isDrive = 0; } if (NativeMatchType(isDrive, attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, TclNewFSPathObj(pathPtr, utfname, Tcl_DStringLength(&ds))); } } /* * Free ds here to ensure that native is valid above. */ Tcl_DStringFree(&ds); } while (FindNextFileW(handle, &data) == TRUE); FindClose(handle); Tcl_DStringFree(&dsOrig); return TCL_OK; } } /* * Does the given path represent a root volume? We need this special case * because for NTFS root volumes, the getFileAttributesProc returns a 'hidden' * attribute when it should not. */ static int WinIsDrive( const char *name, /* Name (UTF-8) */ size_t len) /* Length of name */ { int remove = 0; while (len > 4) { if ((name[len-1] != '.' || name[len-2] != '.') || (name[len-3] != '/' && name[len-3] != '\\')) { /* * We don't have '/..' at the end. */ if (remove == 0) { break; } remove--; while (len > 0) { len--; if (name[len] == '/' || name[len] == '\\') { break; } } if (len < 4) { len++; break; } } else { /* * We do have '/..' */ len -= 3; remove++; } } if (len < 4) { if (len == 0) { /* * Not sure if this is possible, but we pass it on anyway. */ } else if (len == 1 && (name[0] == '/' || name[0] == '\\')) { /* * Path is pointing to the root volume. */ return 1; } else if ((name[1] == ':') && (len == 2 || (name[2] == '/' || name[2] == '\\'))) { /* * Path is of the form 'x:' or 'x:/' or 'x:\' */ return 1; } } return 0; } /* * Does the given path represent a reserved window path name? If not return 0, * if true, return the number of characters of the path that we actually want * (not any trailing :). */ static int WinIsReserved( const char *path) /* Path in UTF-8 */ { if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') && path[3] >= '1' && path[3] <= '9') { /* * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { return 4; } else if (path[4] == ':' && path[5] == '\0') { return 4; } } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* * Have match for 'con' */ return 3; } } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { if (path[3] >= '1' && path[3] <= '9') { /* * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { return 4; } else if (path[4] == ':' && path[5] == '\0') { return 4; } } } else if (!strcasecmp(path, "prn") || !strcasecmp(path, "nul") || !strcasecmp(path, "aux")) { /* * Have match for 'prn', 'nul' or 'aux'. */ return 3; } return 0; } /* *---------------------------------------------------------------------- * * NativeMatchType -- * * This function needs a special case for a path which is a root volume, * because for NTFS root volumes, the getFileAttributesProc returns a * 'hidden' attribute when it should not. * * We never make any calls to a 'get attributes' routine here, since we * have arranged things so that our caller already knows such * information. * * Results: * 0 = file doesn't match * 1 = file matches * *---------------------------------------------------------------------- */ static int NativeMatchType( int isDrive, /* Is this a drive. */ DWORD attr, /* We already know the attributes for the * file. */ const WCHAR *nativeName, /* Native path to check. */ Tcl_GlobTypeData *types) /* Type description to match against. */ { /* * 'attr' represents the attributes of the file, but we only want to * retrieve this info if it is absolutely necessary because it is an * expensive call. Unfortunately, to deal with hidden files properly, we * must always retrieve it. */ if (types == NULL) { /* * If invisible, don't return the file. */ return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive); } if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { /* * If invisible. */ if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) { return 0; } } else { /* * Visible. */ if (types->perm & TCL_GLOB_PERM_HIDDEN) { return 0; } } if (types->perm != 0) { if (((types->perm & TCL_GLOB_PERM_RONLY) && !(attr & FILE_ATTRIBUTE_READONLY)) || ((types->perm & TCL_GLOB_PERM_R) && (0 /* File exists => R_OK on Windows */)) || ((types->perm & TCL_GLOB_PERM_W) && (attr & FILE_ATTRIBUTE_READONLY)) || ((types->perm & TCL_GLOB_PERM_X) && (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativeName)))) { return 0; } } if ((types->type & TCL_GLOB_TYPE_DIR) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { /* * Quicker test for directory, which is a common case. */ return 1; } else if (types->type != 0) { unsigned short st_mode; int isExec = NativeIsExec(nativeName); st_mode = NativeStatMode(attr, 0, isExec); /* * In order bcdpfls as in 'find -t' */ if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) || ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) || ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) || ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) || #ifdef S_ISSOCK ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) || #endif ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) { /* * Do nothing - this file is ok. */ } else { #ifdef S_ISLNK if (types->type & TCL_GLOB_TYPE_LINK) { st_mode = NativeStatMode(attr, 1, isExec); if (S_ISLNK(st_mode)) { return 1; } } #endif /* S_ISLNK */ return 0; } } return 1; } /* *---------------------------------------------------------------------- * * TclpGetUserHome -- * * This function takes the passed in user name and finds the * corresponding home directory specified in the password file. * * Results: * The result is a pointer to a string specifying the user's home * directory, or NULL if the user's home directory could not be * determined. Storage for the result string is allocated in bufferPtr; * the caller must call Tcl_DStringFree() when the result is no longer * needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * TclpGetUserHome( const char *name, /* User name for desired home directory. */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of user's home directory. */ { char *result = NULL; USER_INFO_1 *uiPtr; Tcl_DString ds; int nameLen = -1; int rc = 0; const char *domain; WCHAR *wName, *wHomeDir, *wDomain; Tcl_DStringInit(bufferPtr); wDomain = NULL; domain = Tcl_UtfFindFirst(name, '@'); if (domain == NULL) { const char *ptr; /* * Treat the current user as a special case because the general case * below does not properly retrieve the path. The NetUserGetInfo * call returns an empty path and the code defaults to the user's * name in the profiles directory. On modern Windows systems, this * is generally wrong as when the account is a Microsoft account, * for example abcdefghi@outlook.com, the directory name is * abcde and not abcdefghi. * * Note we could have just used env(USERPROFILE) here but * the intent is to retrieve (as on Unix) the system's view * of the home irrespective of environment settings of HOME * and USERPROFILE. * * Fixing this for the general user needs more investigating but * at least for the current user we can use a direct call. */ ptr = TclpGetUserName(&ds); if (ptr != NULL && strcasecmp(name, ptr) == 0) { HANDLE hProcess; WCHAR buf[MAX_PATH]; DWORD nChars = sizeof(buf) / sizeof(buf[0]); /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */ hProcess = GetCurrentProcess(); /* Need not be closed */ if (hProcess) { HANDLE hToken; if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) { if (GetUserProfileDirectoryW(hToken, buf, &nChars)) { Tcl_WinTCharToUtf((TCHAR *)buf, (nChars-1)*sizeof(WCHAR), bufferPtr); result = Tcl_DStringValue(bufferPtr); rc = 1; } CloseHandle(hToken); } } } Tcl_DStringFree(&ds); } else { wName = (WCHAR *)Tcl_WinUtfToTChar(domain + 1, -1, &ds); rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain); Tcl_DStringFree(&ds); nameLen = domain - name; } if (rc == 0) { wName = (WCHAR *)Tcl_WinUtfToTChar(name, nameLen, &ds); while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) { /* * User does not exist; if domain was not specified, try again * using current domain. */ rc = 1; if (domain != NULL) { break; } /* * Get current domain */ rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain); if (rc != 0) { break; } domain = (const char *)INT2PTR(-1); /* repeat once */ } if (rc == 0) { DWORD i, size = MAX_PATH; wHomeDir = uiPtr->usri1_home_dir; if ((wHomeDir != NULL) && (wHomeDir[0] != '\0')) { size = lstrlenW(wHomeDir); Tcl_WinTCharToUtf((TCHAR *)wHomeDir, size*sizeof(WCHAR), bufferPtr); } else { WCHAR buf[MAX_PATH]; /* * User exists but has no home dir. Return * "{GetProfilesDirectory}/". */ GetProfilesDirectoryW(buf, &size); Tcl_WinTCharToUtf((TCHAR *)buf, (size-1)*sizeof(WCHAR), bufferPtr); Tcl_DStringAppend(bufferPtr, "/", 1); Tcl_DStringAppend(bufferPtr, name, nameLen); } result = Tcl_DStringValue(bufferPtr); /* * Be sure we return normalized path */ for (i = 0; i < size; ++i) { if (result[i] == '\\') { result[i] = '/'; } } NetApiBufferFree((void *) uiPtr); } Tcl_DStringFree(&ds); } if (wDomain != NULL) { NetApiBufferFree((void *) wDomain); } return result; } /* *--------------------------------------------------------------------------- * * NativeAccess -- * * This function replaces the library version of access(), fixing the * following bugs: * * 1. access() returns that all files have execute permission. * * Results: * See access documentation. * * Side effects: * See access documentation. * *--------------------------------------------------------------------------- */ static int NativeAccess( const WCHAR *nativePath, /* Path of file to access, native encoding. */ int mode) /* Permission setting. */ { DWORD attr; attr = GetFileAttributesW(nativePath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * File might not exist. */ DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { TclWinConvertError(lasterror); return -1; } } if (mode == F_OK) { /* * File exists, nothing else to check. */ return 0; } /* * If it's not a directory (assume file), do several fast checks: */ if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) { /* * If the attributes say this is not writable at all. The file is a * regular file (i.e., not a directory), then the file is not * writable, full stop. For directories, the read-only bit is * (mostly) ignored by Windows, so we can't ascertain anything about * directory access from the attrib data. However, if we have the * advanced 'getFileSecurityProc', then more robust ACL checks will be * done below. */ if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { Tcl_SetErrno(EACCES); return -1; } /* * If doesn't have the correct extension, it can't be executable */ if ((mode & X_OK) && !NativeIsExec(nativePath)) { Tcl_SetErrno(EACCES); return -1; } /* * Special case for read/write/executable check on file */ if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) { DWORD mask = 0; HANDLE hFile; if (mode & R_OK) { mask |= GENERIC_READ; } if (mode & W_OK) { mask |= GENERIC_WRITE; } if (mode & X_OK) { mask |= GENERIC_EXECUTE; } hFile = CreateFileW(nativePath, mask, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL); if (hFile != INVALID_HANDLE_VALUE) { CloseHandle(hFile); return 0; } /* * Fast exit if access was denied */ if (GetLastError() == ERROR_ACCESS_DENIED) { Tcl_SetErrno(EACCES); return -1; } } /* * We cannot verify the access fast, check it below using security * info. */ } /* * It looks as if the permissions are ok, but if we are on NT, 2000 or XP, * we have a more complex permissions structure so we try to check that. * The code below is remarkably complex for such a simple thing as finding * what permissions the OS has set for a file. */ { SECURITY_DESCRIPTOR *sdPtr = NULL; unsigned long size; PSID pSid = 0; BOOL SidDefaulted; SID_IDENTIFIER_AUTHORITY samba_unmapped = {{0, 0, 0, 0, 0, 22}}; GENERIC_MAPPING genMap; HANDLE hToken = NULL; DWORD desiredAccess = 0, grantedAccess = 0; BOOL accessYesNo = FALSE; PRIVILEGE_SET privSet; DWORD privSetSize = sizeof(PRIVILEGE_SET); int error; /* * First find out how big the buffer needs to be. */ size = 0; GetFileSecurityW(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, 0, 0, &size); /* * Should have failed with ERROR_INSUFFICIENT_BUFFER */ error = GetLastError(); if (error != ERROR_INSUFFICIENT_BUFFER) { /* * Most likely case is ERROR_ACCESS_DENIED, which we will convert * to EACCES - just what we want! */ TclWinConvertError((DWORD) error); return -1; } /* * Now size contains the size of buffer needed. */ sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size); if (sdPtr == NULL) { goto accessError; } /* * Call GetFileSecurityW() for real. */ if (!GetFileSecurityW(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, sdPtr, size, &size)) { /* * Error getting owner SD */ goto accessError; } /* * As of Samba 3.0.23 (10-Jul-2006), unmapped users and groups are * assigned to SID domains S-1-22-1 and S-1-22-2, where "22" is the * top-level authority. If the file owner and group is unmapped then * the ACL access check below will only test against world access, * which is likely to be more restrictive than the actual access * restrictions. Since the ACL tests are more likely wrong than * right, skip them. Moreover, the unix owner access permissions are * usually mapped to the Windows attributes, so if the user is the * file owner then the attrib checks above are correct (as far as they * go). */ if(!GetSecurityDescriptorOwner(sdPtr,&pSid,&SidDefaulted) || memcmp(GetSidIdentifierAuthority(pSid),&samba_unmapped, sizeof(SID_IDENTIFIER_AUTHORITY))==0) { HeapFree(GetProcessHeap(), 0, sdPtr); return 0; /* Attrib tests say access allowed. */ } /* * Perform security impersonation of the user and open the resulting * thread token. */ if (!ImpersonateSelf(SecurityImpersonation)) { /* * Unable to perform security impersonation. */ goto accessError; } if (!OpenThreadToken(GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) { /* * Unable to get current thread's token. */ goto accessError; } RevertToSelf(); /* * Setup desiredAccess according to the access privileges we are * checking. */ if (mode & R_OK) { desiredAccess |= FILE_GENERIC_READ; } if (mode & W_OK) { desiredAccess |= FILE_GENERIC_WRITE; } if (mode & X_OK) { desiredAccess |= FILE_GENERIC_EXECUTE; } memset(&genMap, 0x0, sizeof(GENERIC_MAPPING)); genMap.GenericRead = FILE_GENERIC_READ; genMap.GenericWrite = FILE_GENERIC_WRITE; genMap.GenericExecute = FILE_GENERIC_EXECUTE; genMap.GenericAll = FILE_ALL_ACCESS; /* * Perform access check using the token. */ if (!AccessCheck(sdPtr, hToken, desiredAccess, &genMap, &privSet, &privSetSize, &grantedAccess, &accessYesNo)) { /* * Unable to perform access check. */ accessError: TclWinConvertError(GetLastError()); if (sdPtr != NULL) { HeapFree(GetProcessHeap(), 0, sdPtr); } if (hToken != NULL) { CloseHandle(hToken); } return -1; } /* * Clean up. */ HeapFree(GetProcessHeap(), 0, sdPtr); CloseHandle(hToken); if (!accessYesNo) { Tcl_SetErrno(EACCES); return -1; } } return 0; } /* *---------------------------------------------------------------------- * * NativeIsExec -- * * Determines if a path is executable. On windows this is simply defined * by whether the path ends in a standard executable extension. * * Results: * 1 = executable, 0 = not. * *---------------------------------------------------------------------- */ static int NativeIsExec( const WCHAR *path) { size_t len = wcslen(path); if (len < 5) { return 0; } if (path[len-4] != '.') { return 0; } path += len-3; if ((_wcsicmp(path, L"exe") == 0) || (_wcsicmp(path, L"com") == 0) || (_wcsicmp(path, L"cmd") == 0) || (_wcsicmp(path, L"bat") == 0)) { return 1; } return 0; } /* *---------------------------------------------------------------------- * * TclpObjChdir -- * * This function replaces the library version of chdir(). * * Results: * See chdir() documentation. * * Side effects: * See chdir() documentation. * *---------------------------------------------------------------------- */ int TclpObjChdir( Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; const WCHAR *nativePath; nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (!nativePath) { return -1; } result = SetCurrentDirectoryW(nativePath); if (result == 0) { TclWinConvertError(GetLastError()); return -1; } return 0; } /* *---------------------------------------------------------------------- * * TclpGetCwd -- * * This function replaces the library version of getcwd(). (Obsolete * function, only retained for old extensions which may call it * directly). * * Results: * The result is a pointer to a string specifying the current directory, * or NULL if the current directory could not be determined. If NULL is * returned, an error message is left in the interp's result. Storage for * the result string is allocated in bufferPtr; the caller must call * Tcl_DStringFree() when the result is no longer needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * TclpGetCwd( Tcl_Interp *interp, /* If non-NULL, used for error reporting. */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of current directory. */ { WCHAR buffer[MAX_PATH]; char *p; WCHAR *native; if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error getting working directory name: %s", Tcl_PosixError(interp))); } return NULL; } /* * Watch for the weird Windows c:\\UNC syntax. */ native = (WCHAR *) buffer; if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; } Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); /* * Convert to forward slashes for easier use in scripts. */ for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '\\') { *p = '/'; } } return Tcl_DStringValue(bufferPtr); } int TclpObjStat( Tcl_Obj *pathPtr, /* Path of file to stat. */ Tcl_StatBuf *statPtr) /* Filled with results of stat call. */ { /* * Ensure correct file sizes by forcing the OS to write any pending data * to disk. This is done only for channels which are dirty, i.e. have been * written to since the last flush here. */ TclWinFlushDirtyChannels(); return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 0); } /* *---------------------------------------------------------------------- * * NativeStat -- * * This function replaces the library version of stat(), fixing the * following bugs: * * 1. stat("c:") returns an error. * 2. Borland stat() return time in GMT instead of localtime. * 3. stat("\\server\mount") would return error. * 4. Accepts slashes or backslashes. * 5. st_dev and st_rdev were wrong for UNC paths. * * Results: * See stat documentation. * * Side effects: * See stat documentation. * *---------------------------------------------------------------------- */ static int NativeStat( const WCHAR *nativePath, /* Path of file to stat */ Tcl_StatBuf *statPtr, /* Filled with results of stat call. */ int checkLinks) /* If non-zero, behave like 'lstat' */ { DWORD attr; int dev, nlink = 1; unsigned short mode; unsigned int inode = 0; HANDLE fileHandle; DWORD fileType = FILE_TYPE_UNKNOWN; /* * If we can use 'createFile' on this, then we can use the resulting * fileHandle to read more information (nlink, ino) than we can get from * other attributes reading APIs. If not, then we try to fall back on the * 'getFileAttributesExProc', and if that isn't available, then on even * simpler routines. * * Special consideration must be given to Windows hard-coded names like * CON, NULL, COM1, LPT1 etc. For these, we still need to do the * CreateFile as some may not exist (e.g. there is no CON in wish by * default). However the subsequent GetFileInformationByHandle will * fail. We do a WinIsReserved to see if it is one of the special names, * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure. */ fileHandle = CreateFileW(nativePath, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL); if (fileHandle != INVALID_HANDLE_VALUE) { BY_HANDLE_FILE_INFORMATION data; if (GetFileInformationByHandle(fileHandle,&data) != TRUE) { fileType = GetFileType(fileHandle); CloseHandle(fileHandle); if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { Tcl_SetErrno(ENOENT); return -1; } /* * Mock up the expected structure */ memset(&data, 0, sizeof(data)); statPtr->st_atime = 0; statPtr->st_mtime = 0; statPtr->st_ctime = 0; } else { CloseHandle(fileHandle); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); } attr = data.dwFileAttributes; statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) | (((Tcl_WideInt) data.nFileSizeHigh) << 32); /* * On Unix, for directories, nlink apparently depends on the number of * files in the directory. We could calculate that, but it would be a * bit of a performance penalty, I think. Hence we just use what * Windows gives us, which is the same as Unix for files, at least. */ nlink = data.nNumberOfLinks; /* * Unfortunately our stat definition's inode field (unsigned short) * will throw away most of the precision we have here, which means we * can't rely on inode as a unique identifier of a file. We'd really * like to do something like how we handle 'st_size'. */ inode = data.nFileIndexHigh | data.nFileIndexLow; } else { /* * Fall back on the less capable routines. This means no nlink or ino. */ WIN32_FILE_ATTRIBUTE_DATA data; if (GetFileAttributesExW(nativePath, GetFileExInfoStandard, &data) != TRUE) { HANDLE hFind; WIN32_FIND_DATAW ffd; DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { TclWinConvertError(lasterror); return -1; } hFind = FindFirstFileW(nativePath, &ffd); if (hFind == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); return -1; } memcpy(&data, &ffd, sizeof(data)); FindClose(hFind); } attr = data.dwFileAttributes; statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) | (((Tcl_WideInt) data.nFileSizeHigh) << 32); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); } dev = NativeDev(nativePath); mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath)); if (fileType == FILE_TYPE_CHAR) { mode &= ~S_IFMT; mode |= S_IFCHR; } else if (fileType == FILE_TYPE_DISK) { mode &= ~S_IFMT; mode |= S_IFBLK; } statPtr->st_dev = (dev_t) dev; statPtr->st_ino = inode; statPtr->st_mode = mode; statPtr->st_nlink = nlink; statPtr->st_uid = 0; statPtr->st_gid = 0; statPtr->st_rdev = (dev_t) dev; return 0; } /* *---------------------------------------------------------------------- * * NativeDev -- * * Calculate just the 'st_dev' field of a 'stat' structure. * *---------------------------------------------------------------------- */ static int NativeDev( const WCHAR *nativePath) /* Full path of file to stat */ { int dev; Tcl_DString ds; WCHAR nativeFullPath[MAX_PATH]; WCHAR *nativePart; const char *fullPath; GetFullPathNameW(nativePath, MAX_PATH, nativeFullPath, &nativePart); fullPath = Tcl_WinTCharToUtf((TCHAR *)nativeFullPath, -1, &ds); if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { const char *p; DWORD dw; const WCHAR *nativeVol; Tcl_DString volString; p = strchr(fullPath + 2, '\\'); p = strchr(p + 1, '\\'); if (p == NULL) { /* * Add terminating backslash to fullpath or GetVolumeInformationW() * won't work. */ fullPath = TclDStringAppendLiteral(&ds, "\\"); p = fullPath + Tcl_DStringLength(&ds); } else { p++; } nativeVol = (WCHAR *)Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); dw = (DWORD) -1; GetVolumeInformationW(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); /* * GetFullPathNameW() turns special devices like "NUL" into "\\.\NUL", * but GetVolumeInformationW() returns failure for "\\.\NUL". This will * cause "NUL" to get a drive number of -1, which makes about as much * sense as anything since the special devices don't live on any * drive. */ dev = dw; Tcl_DStringFree(&volString); } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; } else { dev = -1; } Tcl_DStringFree(&ds); return dev; } /* *---------------------------------------------------------------------- * * NativeStatMode -- * * Calculate just the 'st_mode' field of a 'stat' structure. * * In many places we don't need the full stat structure, and it's much * faster just to calculate these pieces, if that's all we need. * *---------------------------------------------------------------------- */ static unsigned short NativeStatMode( DWORD attr, int checkLinks, int isExec) { int mode; if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) { /* * It is a link. */ mode = S_IFLNK; } else { mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG; } mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD|S_IWRITE; if (isExec) { mode |= S_IEXEC; } /* * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and other * positions. */ mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3; mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6; return (unsigned short) mode; } /* *------------------------------------------------------------------------ * * ToCTime -- * * Converts a Windows FILETIME to a time_t in UTC. * * Results: * Returns the count of seconds from the Posix epoch. * *------------------------------------------------------------------------ */ static time_t ToCTime( FILETIME fileTime) /* UTC time */ { LARGE_INTEGER convertedTime; convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; return (time_t) ((convertedTime.QuadPart - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000); } /* *------------------------------------------------------------------------ * * FromCTime -- * * Converts a time_t to a Windows FILETIME * * Results: * Returns the count of 100-ns ticks seconds from the Windows epoch. * *------------------------------------------------------------------------ */ static void FromCTime( time_t posixTime, FILETIME *fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000 + POSIX_EPOCH_AS_FILETIME; fileTime->dwLowDateTime = convertedTime.LowPart; fileTime->dwHighDateTime = convertedTime.HighPart; } /* *--------------------------------------------------------------------------- * * TclpGetNativeCwd -- * * This function replaces the library version of getcwd(). * * Results: * The input and output are filesystem paths in native form. The result * is either the given clientData, if the working directory hasn't * changed, or a new clientData (owned by our caller), giving the new * native path, or NULL if the current directory could not be determined. * If NULL is returned, the caller can examine the standard Posix error * codes to determine the cause of the problem. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData TclpGetNativeCwd( ClientData clientData) { WCHAR buffer[MAX_PATH]; if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); return NULL; } if (clientData != NULL) { if (wcscmp((const WCHAR *) clientData, buffer) == 0) { return clientData; } } return TclNativeDupInternalRep(buffer); } int TclpObjAccess( Tcl_Obj *pathPtr, int mode) { return NativeAccess((const WCHAR *)Tcl_FSGetNativePath(pathPtr), mode); } int TclpObjLstat( Tcl_Obj *pathPtr, Tcl_StatBuf *statPtr) { /* * Ensure correct file sizes by forcing the OS to write any pending data * to disk. This is done only for channels which are dirty, i.e. have been * written to since the last flush here. */ TclWinFlushDirtyChannels(); return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 1); } #ifdef S_IFLNK Tcl_Obj * TclpObjLink( Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction) { if (toPtr != NULL) { int res; const WCHAR *LinkTarget; const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr); if (normalizedToPtr == NULL) { return NULL; } LinkTarget = (const WCHAR *)Tcl_FSGetNativePath(normalizedToPtr); if (LinkSource == NULL || LinkTarget == NULL) { return NULL; } res = WinLink(LinkSource, LinkTarget, linkAction); if (res == 0) { return toPtr; } else { return NULL; } } else { const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (LinkSource == NULL) { return NULL; } return WinReadLink(LinkSource); } } #endif /* S_IFLNK */ /* *--------------------------------------------------------------------------- * * TclpFilesystemPathType -- * * This function is part of the native filesystem support, and returns * the path type of the given path. Returns NTFS or FAT or whatever is * returned by the 'volume information' proc. * * Results: * NULL at present. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclpFilesystemPathType( Tcl_Obj *pathPtr) { #define VOL_BUF_SIZE 32 int found; WCHAR volType[VOL_BUF_SIZE]; char *firstSeparator; const char *path; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath == NULL) { return NULL; } path = Tcl_GetString(normPath); if (path == NULL) { return NULL; } firstSeparator = strchr(path, '/'); if (firstSeparator == NULL) { found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); } else { Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); Tcl_IncrRefCount(driveName); found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); Tcl_DecrRefCount(driveName); } if (found == 0) { return NULL; } else { Tcl_DString ds; Tcl_WinTCharToUtf((TCHAR *)volType, -1, &ds); return TclDStringToObj(&ds); } #undef VOL_BUF_SIZE } /* * This define can be turned on to experiment with a different way of * normalizing paths (using a different Windows API). Unfortunately the new * path seems to take almost exactly the same amount of time as the old path! * The primary time taken by normalization is in * GetFileAttributesEx/FindFirstFile or GetFileAttributesEx/GetLongPathName. * Conversion to/from native is not a significant factor at all. * * Also, since we have to check for symbolic links (reparse points) then we * have to call GetFileAttributes on each path segment anyway, so there's no * benefit to doing anything clever there. */ /* #define TclNORM_LONG_PATH */ /* *--------------------------------------------------------------------------- * * TclpObjNormalizePath -- * * This function scans through a path specification and replaces it, in * place, with a normalized version. This means using the 'longname', and * expanding any symbolic links contained within the path. * * Results: * The new 'nextCheckpoint' value, giving as far as we could understand * in the path. * * Side effects: * The pathPtr string, which must contain a valid path, is possibly * modified in place. * *--------------------------------------------------------------------------- */ int TclpObjNormalizePath( Tcl_Interp *interp, /* not used */ Tcl_Obj *pathPtr, /* An unshared object containing the path to * normalize */ int nextCheckpoint) /* offset to start at in pathPtr */ { char *lastValidPathEnd = NULL; Tcl_DString dsNorm; /* This will hold the normalized string. */ char *path, *currentPathEndPosition; Tcl_Obj *temp = NULL; int isDrive = 1; Tcl_DString ds; /* Some workspace. */ (void)interp; Tcl_DStringInit(&dsNorm); path = Tcl_GetString(pathPtr); currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; } while (1) { char cur = *currentPathEndPosition; if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { /* * Reached directory separator, or end of string. */ WIN32_FILE_ATTRIBUTE_DATA data; const WCHAR *nativePath = (WCHAR *)Tcl_WinUtfToTChar(path, currentPathEndPosition - path, &ds); if (GetFileAttributesExW(nativePath, GetFileExInfoStandard, &data) != TRUE) { /* * File doesn't exist. */ if (isDrive) { int len = WinIsReserved(path); if (len > 0) { /* * Actually it does exist - COM1, etc. */ int i; for (i=0 ; i= 'a') { wc -= ('a' - 'A'); ((WCHAR *) nativePath)[i] = wc; } } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, (int)(sizeof(WCHAR) * len)); lastValidPathEnd = currentPathEndPosition; } else if (nextCheckpoint == 0) { /* * Path starts with a drive designation that's not * actually on the system. We still must normalize up * past the first separator. [Bug 3603434] */ currentPathEndPosition++; } } Tcl_DStringFree(&ds); break; } /* * File 'nativePath' does exist if we get here. We now want to * check if it is a symlink and otherwise continue with the * rest of the path. */ /* * Check for symlinks, except at last component of path (we don't * follow final symlinks). Also a drive (C:/) for example, may * sometimes have the reparse flag set for some reason I don't * understand. We therefore don't perform this check for drives. */ if (cur != 0 && !isDrive && data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){ Tcl_Obj *to = WinReadLinkDirectory(nativePath); if (to != NULL) { /* * Read the reparse point ok. Now, reparse points need not * be normalized, otherwise we could use: * * Tcl_GetStringFromObj(to, &pathLen); * nextCheckpoint = pathLen; * * So, instead we have to start from the beginning. */ nextCheckpoint = 0; Tcl_AppendToObj(to, currentPathEndPosition, -1); /* * Convert link to forward slashes. */ for (path = Tcl_GetString(to); *path != 0; path++) { if (*path == '\\') { *path = '/'; } } path = Tcl_GetString(to); currentPathEndPosition = path + nextCheckpoint; if (temp != NULL) { Tcl_DecrRefCount(temp); } temp = to; /* * Reset variables so we can restart normalization. */ isDrive = 1; Tcl_DStringFree(&dsNorm); Tcl_DStringFree(&ds); continue; } } #ifndef TclNORM_LONG_PATH /* * Now we convert the tail of the current path to its 'long form', * and append it to 'dsNorm' which holds the current normalized * path */ if (isDrive) { WCHAR drive = ((WCHAR *) nativePath)[0]; if (drive >= 'a') { drive -= ('a' - 'A'); ((WCHAR *) nativePath)[0] = drive; } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, Tcl_DStringLength(&ds)); } else { char *checkDots = NULL; if (lastValidPathEnd[1] == '.') { checkDots = lastValidPathEnd + 1; while (checkDots < currentPathEndPosition) { if (*checkDots != '.') { checkDots = NULL; break; } checkDots++; } } if (checkDots != NULL) { int dotLen = currentPathEndPosition-lastValidPathEnd; /* * Path is just dots. We shouldn't really ever see a path * like that. However, to be nice we at least don't mangle * the path - we just add the dots as a path segment and * continue. */ Tcl_DStringAppend(&dsNorm, ((const char *)nativePath) + Tcl_DStringLength(&ds) - (dotLen * sizeof(WCHAR)), dotLen * sizeof(WCHAR)); } else { /* * Normal path. */ WIN32_FIND_DATAW fData; HANDLE handle; handle = FindFirstFileW((WCHAR *) nativePath, &fData); if (handle == INVALID_HANDLE_VALUE) { /* * This is usually the '/' in 'c:/' at end of string. */ Tcl_DStringAppend(&dsNorm, (const char *) L"/", sizeof(WCHAR)); } else { WCHAR *nativeName; if (fData.cFileName[0] != '\0') { nativeName = fData.cFileName; } else { nativeName = fData.cAlternateFileName; } FindClose(handle); Tcl_DStringAppend(&dsNorm, (const char *) L"/", sizeof(WCHAR)); Tcl_DStringAppend(&dsNorm, (const char *) nativeName, (int) (wcslen(nativeName)*sizeof(WCHAR))); } } } #endif /* !TclNORM_LONG_PATH */ Tcl_DStringFree(&ds); lastValidPathEnd = currentPathEndPosition; if (cur == 0) { break; } /* * If we get here, we've got past one directory delimiter, so we * know it is no longer a drive. */ isDrive = 0; } currentPathEndPosition++; #ifdef TclNORM_LONG_PATH /* * Convert the entire known path to long form. */ if (1) { WCHAR wpath[MAX_PATH]; const WCHAR *nativePath = Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds); DWORD wpathlen = GetLongPathNameProc(nativePath, (WCHAR *) wpath, MAX_PATH); /* * We have to make the drive letter uppercase. */ if (wpath[0] >= 'a') { wpath[0] -= ('a' - 'A'); } Tcl_DStringAppend(&dsNorm, (const char *) wpath, wpathlen * sizeof(WCHAR)); Tcl_DStringFree(&ds); } #endif /* TclNORM_LONG_PATH */ } /* * Common code path for all Windows platforms. */ nextCheckpoint = currentPathEndPosition - path; if (lastValidPathEnd != NULL) { /* * Concatenate the normalized string in dsNorm with the tail of the * path which we didn't recognise. The string in dsNorm is in the * native encoding, so we have to convert it to Utf. */ Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&dsNorm), Tcl_DStringLength(&dsNorm), &ds); nextCheckpoint = Tcl_DStringLength(&ds); if (*lastValidPathEnd != 0) { /* * Not the end of the string. */ int len; Tcl_Obj *tmpPathPtr; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); path = Tcl_GetStringFromObj(tmpPathPtr, &len); Tcl_SetStringObj(pathPtr, path, len); Tcl_DecrRefCount(tmpPathPtr); } else { /* * End of string was reached above. */ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint); } Tcl_DStringFree(&ds); } Tcl_DStringFree(&dsNorm); /* * This must be done after we are totally finished with 'path' as we are * sharing the same underlying string. */ if (temp != NULL) { Tcl_DecrRefCount(temp); } return nextCheckpoint; } /* *--------------------------------------------------------------------------- * * TclWinVolumeRelativeNormalize -- * * Only Windows has volume-relative paths. These paths are rather rare, * but it is nice if Tcl can handle them. It is much better if we can * handle them here, rather than in the native fs code, because we really * need to have a real absolute path just below. * * We do not let this block compile on non-Windows platforms because the * test suite's manual forcing of tclPlatform can otherwise cause this * code path to be executed, causing various errors because * volume-relative paths really do not exist. * * Results: * A valid normalized path. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclWinVolumeRelativeNormalize( Tcl_Interp *interp, const char *path, Tcl_Obj **useThisCwdPtr) { Tcl_Obj *absolutePath, *useThisCwd; useThisCwd = Tcl_FSGetCwd(interp); if (useThisCwd == NULL) { return NULL; } if (path[0] == '/') { /* * Path of form /foo/bar which is a path in the root directory of the * current volume. */ const char *drive = Tcl_GetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); Tcl_AppendToObj(absolutePath, path, -1); Tcl_IncrRefCount(absolutePath); /* * We have a refCount on the cwd. */ } else { /* * Path of form C:foo/bar, but this only makes sense if the cwd is * also on drive C. */ int cwdLen; const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; if (drive_cur >= 'a') { drive_cur -= ('a' - 'A'); } if (drive[0] == drive_cur) { absolutePath = Tcl_DuplicateObj(useThisCwd); /* * We have a refCount on the cwd, which we will release later. */ if (drive[cwdLen-1] != '/' && (path[2] != '\0')) { /* * Only add a trailing '/' if needed, which is if there isn't * one already, and if we are going to be adding some more * characters. */ Tcl_AppendToObj(absolutePath, "/", 1); } } else { Tcl_DecrRefCount(useThisCwd); useThisCwd = NULL; /* * The path is not in the current drive, but is volume-relative. * The way Tcl 8.3 handles this is that it treats such a path as * relative to the root of the drive. We therefore behave the same * here. This behaviour is, however, different to that of the * windows command-line. If we want to fix this at some point in * the future (at the expense of a behaviour change to Tcl), we * could use the '_dgetdcwd' Win32 API to get the drive's cwd. */ absolutePath = Tcl_NewStringObj(path, 2); Tcl_AppendToObj(absolutePath, "/", 1); } Tcl_IncrRefCount(absolutePath); Tcl_AppendToObj(absolutePath, path+2, -1); } *useThisCwdPtr = useThisCwd; return absolutePath; } /* *--------------------------------------------------------------------------- * * TclpNativeToNormalized -- * * Convert native format to a normalized path object, with refCount of * zero. * * Currently assumes all native paths are actually normalized already, so * if the path given is not normalized this will actually just convert to * a valid string path, but not necessarily a normalized one. * * Results: * A valid normalized path. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj * TclpNativeToNormalized( ClientData clientData) { Tcl_DString ds; Tcl_Obj *objPtr; int len; char *copy, *p; Tcl_WinTCharToUtf((TCHAR *) clientData, -1, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); /* * Certain native path representations on Windows have this special prefix * to indicate that they are to be treated specially. For example * extremely long paths, or symlinks. */ if (*copy == '\\') { if (0 == strncmp(copy,"\\??\\",4)) { copy += 4; len -= 4; } else if (0 == strncmp(copy,"\\\\?\\",4)) { copy += 4; len -= 4; } } /* * Ensure we are using forward slashes only. */ for (p = copy; *p != '\0'; p++) { if (*p == '\\') { *p = '/'; } } objPtr = Tcl_NewStringObj(copy,len); Tcl_DStringFree(&ds); return objPtr; } /* *--------------------------------------------------------------------------- * * TclNativeCreateNativeRep -- * * Create a native representation for the given path. * * Results: * The nativePath representation. * * Side effects: * Memory will be allocated. The path might be normalized. * *--------------------------------------------------------------------------- */ ClientData TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { WCHAR *nativePathPtr = NULL; const char *str; Tcl_Obj *validPathPtr; int len; WCHAR *wp; Tcl_DString ds; Tcl_Encoding utf8; if (TclFSCwdIsNative()) { /* * The cwd is native, which means we can use the translated path * without worrying about normalization (this will also usually be * shorter so the utf-to-external conversion will be somewhat faster). */ validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } /* * refCount of validPathPtr was already incremented in * Tcl_FSGetTranslatedPath */ } else { /* * Make sure the normalized path is set. */ validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } /* * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, * so incr refCount here */ Tcl_IncrRefCount(validPathPtr); } utf8 = Tcl_GetEncoding(NULL, "utf-8"); str = Tcl_GetStringFromObj(validPathPtr, &len); str = Tcl_UtfToExternalDString(utf8, str, len, &ds); len = Tcl_DStringLength(&ds); Tcl_FreeEncoding(utf8); if (strlen(str) != (size_t)len) { /* * String contains NUL-bytes. This is invalid. */ goto done; } /* * For a reserved device, strip a possible postfix ':' */ len = WinIsReserved(str); if (len == 0) { /* * Let MultiByteToWideChar check for other invalid sequences, like * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */ len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0); if (len==0) { goto done; } } /* * Overallocate 6 chars, making some room for extended paths */ wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { goto done; } MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len + 2); nativePathPtr[len] = 0; /* * If path starts with "//?/" or "\\?\" (extended path), translate any * slashes to backslashes but leave the '?' intact */ if ((str[0] == '\\' || str[0] == '/') && (str[1] == '\\' || str[1] == '/') && str[2] == '?' && (str[3] == '\\' || str[3] == '/')) { wp[0] = wp[1] = wp[3] = '\\'; str += 4; wp += 4; } /* * If there is no "\\?\" prefix but there is a drive or UNC path prefix * and the path is larger than MAX_PATH chars, no Win32 API function can * handle that unless it is prefixed with the extended path prefix. See: * */ if (((str[0] >= 'A' && str[0] <= 'Z') || (str[0] >= 'a' && str[0] <= 'z')) && str[1] == ':') { if (wp == nativePathPtr && len > MAX_PATH && (str[2] == '\\' || str[2] == '/')) { memmove(wp + 4, wp, len * sizeof(WCHAR)); memcpy(wp, L"\\\\?\\", 4 * sizeof(WCHAR)); wp += 4; } /* * If (remainder of) path starts with ":", leave the ':' * intact. */ wp += 2; } else if (wp == nativePathPtr && len > MAX_PATH && (str[0] == '\\' || str[0] == '/') && (str[1] == '\\' || str[1] == '/') && str[2] != '?') { memmove(wp + 6, wp, len * sizeof(WCHAR)); memcpy(wp, L"\\\\?\\UNC", 7 * sizeof(WCHAR)); wp += 7; } /* * In the remainder of the path, translate invalid characters to * characters in the Unicode private use area. */ while (*wp != '\0') { if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) { *wp |= 0xF000; } else if (*wp == '/') { *wp = '\\'; } ++wp; } done: Tcl_DStringFree(&ds); TclDecrRefCount(validPathPtr); return nativePathPtr; } /* *--------------------------------------------------------------------------- * * TclNativeDupInternalRep -- * * Duplicate the native representation. * * Results: * The copied native representation, or NULL if it is not possible to * copy the representation. * * Side effects: * Memory allocation for the copy. * *--------------------------------------------------------------------------- */ ClientData TclNativeDupInternalRep( ClientData clientData) { char *copy; size_t len; if (clientData == NULL) { return NULL; } len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); copy = (char *)ckalloc(len); memcpy(copy, clientData, len); return copy; } /* *--------------------------------------------------------------------------- * * TclpUtime -- * * Set the modification date for a file. * * Results: * 0 on success, -1 on error. * * Side effects: * Sets errno to a representation of any Windows problem that's observed * in the process. * *--------------------------------------------------------------------------- */ int TclpUtime( Tcl_Obj *pathPtr, /* File to modify */ struct utimbuf *tval) /* New modification date structure */ { int res = 0; HANDLE fileHandle; const WCHAR *native; DWORD attr = 0; DWORD flags = FILE_ATTRIBUTE_NORMAL; FILETIME lastAccessTime, lastModTime; FromCTime(tval->actime, &lastAccessTime); FromCTime(tval->modtime, &lastModTime); native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); attr = GetFileAttributesW(native); if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) { flags = FILE_FLAG_BACKUP_SEMANTICS; } /* * We use the native APIs (not 'utime') because there are some daylight * savings complications that utime gets wrong. */ fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { TclWinConvertError(GetLastError()); res = -1; } if (fileHandle != INVALID_HANDLE_VALUE) { CloseHandle(fileHandle); } return res; } /* *--------------------------------------------------------------------------- * * TclWinFileOwned -- * * Returns 1 if the specified file exists and is owned by the current * user and 0 otherwise. Like the Unix case, the check is made using * the real process SID, not the effective (impersonation) one. * *--------------------------------------------------------------------------- */ int TclWinFileOwned( Tcl_Obj *pathPtr) /* File whose ownership is to be checked */ { const WCHAR *native; PSID ownerSid = NULL; PSECURITY_DESCRIPTOR secd = NULL; HANDLE token; LPBYTE buf = NULL; DWORD bufsz; int owned = 0; native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, &secd) != ERROR_SUCCESS) { /* * Either not a file, or we do not have access to it in which case we * are in all likelihood not the owner. */ return 0; } /* * Getting the current process SID is a multi-step process. We make the * assumption that if a call fails, this process is so underprivileged it * could not possibly own anything. Normally a process can *always* look * up its own token. */ if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) { /* * Find out how big the buffer needs to be. */ bufsz = 0; GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); if (bufsz) { buf = (LPBYTE)ckalloc(bufsz); if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); } } CloseHandle(token); } /* * Free allocations and be done. */ if (secd) { LocalFree(secd); /* Also frees ownerSid */ } if (buf) { ckfree(buf); } return (owned != 0); /* Convert non-0 to 1 */ } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinInit.c0000644000175000017500000004306714554262142014701 0ustar sergeisergei/* * tclWinInit.c -- * * Contains the Windows-specific interpreter initialization functions. * * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" #include #include #include /* * GetUserNameW() is found in advapi32.dll */ #ifdef _MSC_VER # pragma comment(lib, "advapi32.lib") #endif /* * The following declaration is a workaround for some Microsoft brain damage. * The SYSTEM_INFO structure is different in various releases, even though the * layout is the same. So we overlay our own structure on top of it so we can * access the interesting slots in a uniform way. */ typedef struct { WORD wProcessorArchitecture; WORD wReserved; } OemId; /* * Windows version dependend functions */ TclWinProcs tclWinProcs; /* * The following arrays contain the human readable strings for the * processor values. */ #define NUMPROCESSORS 15 static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64" }; /* * The default directory in which the init.tcl file is expected to be found. */ static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir; static ProcessGlobalValue defaultLibraryDir = {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL}; static TclInitProcessGlobalValueProc InitializeSourceLibraryDir; static ProcessGlobalValue sourceLibraryDir = {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL}; static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib); /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * * Initialize all the platform-dependent things like signals, * floating-point error handling and sockets. * * Called at process initialization time. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclpInitPlatform(void) { WSADATA wsaData; WORD wVersionRequested = MAKEWORD(2, 2); HMODULE handle; tclPlatform = TCL_PLATFORM_WINDOWS; /* * Initialize the winsock library. On Windows XP and higher this * can never fail. */ WSAStartup(wVersionRequested, &wsaData); #ifdef STATIC_BUILD /* * If we are in a statically linked executable, then we need to explicitly * initialize the Windows function tables here since DllMain() will not be * invoked. */ TclWinInit(GetModuleHandleW(NULL)); #endif /* * Fill available functions depending on windows version */ handle = GetModuleHandleW(L"KERNEL32"); tclWinProcs.cancelSynchronousIo = (BOOL (WINAPI *)(HANDLE))(void *)GetProcAddress(handle, "CancelSynchronousIo"); tclWinProcs.createSymbolicLink = (BOOLEAN (WINAPI *)(LPCWSTR, LPCWSTR, DWORD))(void *)GetProcAddress(handle, "CreateSymbolicLinkW"); } /* *------------------------------------------------------------------------- * * TclpInitLibraryPath -- * * This is the fallback routine that sets the library path if the * application has not set one by the first time it is needed. * * Results: * None. * * Side effects: * Sets the library path to an initial value. * *------------------------------------------------------------------------- */ void TclpInitLibraryPath( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; const char *bytes; TclNewObj(pathPtr); /* * Initialize the substring used when locating the script library. The * installLib variable computes the script library path relative to the * installed DLL. */ snprintf(installLib, sizeof(installLib), "lib/tcl%s", TCL_VERSION); /* * Look for the library relative to the TCL_LIBRARY env variable. If the * last dirname in the TCL_LIBRARY path does not match the last dirname in * the installLib variable, use the last dir name of installLib in * addition to the original TCL_LIBRARY path. */ AppendEnvironment(pathPtr, installLib); /* * Look for the library in its default location. */ Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&defaultLibraryDir)); /* * Look for the library in its source checkout location. */ Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, bytes, *lengthPtr + 1); Tcl_DecrRefCount(pathPtr); } /* *--------------------------------------------------------------------------- * * AppendEnvironment -- * * Append the value of the TCL_LIBRARY environment variable onto the path * pointer. If the env variable points to another version of tcl (e.g. * "tcl7.6") also append the path to this version (e.g., * "tcl7.6/../tcl8.2") * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static void AppendEnvironment( Tcl_Obj *pathPtr, const char *lib) { int pathc; WCHAR wBuf[MAX_PATH]; char buf[MAX_PATH * 3]; Tcl_Obj *objPtr; Tcl_DString ds; const char **pathv; char *shortlib; /* * The shortlib value needs to be the tail component of the lib path. For * example, "lib/tcl8.4" -> "tcl8.4" while "usr/share/tcl8.5" -> "tcl8.5". */ for (shortlib = (char *) &lib[strlen(lib)-1]; shortlib>lib ; shortlib--) { if (*shortlib == '/') { if ((size_t)(shortlib - lib) == strlen(lib) - 1) { Tcl_Panic("last character in lib cannot be '/'"); } shortlib++; break; } } if (shortlib == lib) { Tcl_Panic("no '/' character found in lib"); } /* * The "L" preceding the TCL_LIBRARY string is used to tell VC++ that * this is a Unicode string. */ GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH); WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL); if (buf[0] != '\0') { objPtr = Tcl_NewStringObj(buf, -1); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); TclWinNoBackslash(buf); Tcl_SplitPath(buf, &pathc, &pathv); /* * The lstrcmpiA() will work even if pathv[pathc-1] is random UTF-8 * chars because I know shortlib is ascii. */ if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) { /* * TCL_LIBRARY is set but refers to a different tcl installation * than the current version. Try fiddling with the specified * directory to make it refer to this installation by removing the * old "tclX.Y" and substituting the current version string. */ pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); (void) Tcl_JoinPath(pathc, pathv, &ds); objPtr = TclDStringToObj(&ds); } else { objPtr = Tcl_NewStringObj(buf, -1); } Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); ckfree(pathv); } } /* *--------------------------------------------------------------------------- * * InitializeDefaultLibraryDir -- * * Locate the Tcl script library default location relative to the * location of the Tcl DLL. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static void InitializeDefaultLibraryDir( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; GetModuleFileNameW(hModule, wName, sizeof(wName)/sizeof(WCHAR)); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); end = strrchr(name, '\\'); *end = '\0'; p = strrchr(name, '\\'); if (p != NULL) { end = p; } *end = '\\'; TclWinNoBackslash(name); snprintf(end + 1, LIBRARY_SIZE, "lib/tcl%s", TCL_VERSION); *lengthPtr = strlen(name); *valuePtr = (char *)ckalloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } /* *--------------------------------------------------------------------------- * * InitializeSourceLibraryDir -- * * Locate the Tcl script library default location relative to the * location of the Tcl DLL as it exists in the build output directory * associated with the source checkout. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static void InitializeSourceLibraryDir( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; GetModuleFileNameW(hModule, wName, sizeof(wName)/sizeof(WCHAR)); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); end = strrchr(name, '\\'); *end = '\0'; p = strrchr(name, '\\'); if (p != NULL) { end = p; } *end = '\\'; TclWinNoBackslash(name); snprintf(end + 1, LIBRARY_SIZE, "../library"); *lengthPtr = strlen(name); *valuePtr = (char *)ckalloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } /* *--------------------------------------------------------------------------- * * TclpSetInitialEncodings -- * * Based on the locale, determine the encoding of the operating system * and the default encoding for newly opened files. * * Called at process initialization time, and part way through startup, * we verify that the initial encodings were correctly setup. Depending * on Tcl's environment, there may not have been enough information first * time through (above). * * Results: * None. * * Side effects: * The Tcl library path is converted from native encoding to UTF-8, on * the first call, and the encodings may be changed on first or second * call. * *--------------------------------------------------------------------------- */ void TclpSetInitialEncodings(void) { Tcl_DString encodingName; Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); } void TclWinSetInterfaces( int dummy) /* Not used. */ { (void)dummy; } const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { UINT acp = GetACP(); Tcl_DStringInit(bufPtr); if (acp == CP_UTF8) { Tcl_DStringAppend(bufPtr, "utf-8", 5); } else { Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); snprintf(Tcl_DStringValue(bufPtr), 2+TCL_INTEGER_SPACE, "cp%d", GetACP()); Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); } return Tcl_DStringValue(bufPtr); } const char * TclpGetUserName( Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * the name of user. */ { Tcl_DStringInit(bufferPtr); if (TclGetEnv("USERNAME", bufferPtr) == NULL) { WCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; if (!GetUserNameW(szUserName, &cchUserNameLen)) { return NULL; } cchUserNameLen--; cchUserNameLen *= sizeof(WCHAR); Tcl_WinTCharToUtf((TCHAR *)szUserName, cchUserNameLen, bufferPtr); } return Tcl_DStringValue(bufferPtr); } /* *--------------------------------------------------------------------------- * * TclpSetVariables -- * * Performs platform-specific interpreter initialization related to the * tcl_platform and env variables, and other platform-specific things. * * Results: * None. * * Side effects: * Sets "tcl_platform", and "env(HOME)" Tcl variables. * *---------------------------------------------------------------------- */ void TclpSetVariables( Tcl_Interp *interp) /* Interp to initialize. */ { const char *ptr; char buffer[TCL_INTEGER_SPACE * 2]; union { SYSTEM_INFO info; OemId oemId; } sys; static OSVERSIONINFOW osInfo; static int osInfoInitialized = 0; Tcl_DString ds; Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); if (!osInfoInitialized) { HMODULE handle = GetModuleHandleW(L"NTDLL"); int(__stdcall *getversion)(void *) = (int(__stdcall *)(void *))(void *)GetProcAddress(handle, "RtlGetVersion"); osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); if (!getversion || getversion(&osInfo)) { GetVersionExW(&osInfo); } osInfoInitialized = 1; } GetSystemInfo(&sys.info); /* * Define the tcl_platform array. */ Tcl_SetVar2(interp, "tcl_platform", "platform", "windows", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); if (osInfo.dwMajorVersion == 10 && osInfo.dwBuildNumber >= 22000) { osInfo.dwMajorVersion = 11; } snprintf(buffer, sizeof(buffer), "%ld.%ld", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", processors[sys.oemId.wProcessorArchitecture], TCL_GLOBAL_ONLY); } #ifndef NDEBUG /* * The existence of the "debug" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with debug * information. Using "info exists tcl_platform(debug)" a Tcl script can * direct the interpreter to load debug versions of DLLs with the load * command. */ Tcl_SetVar2(interp, "tcl_platform", "debug", "1", TCL_GLOBAL_ONLY); #endif /* * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH * environment variables, if necessary. */ Tcl_DStringInit(&ds); ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY); if (ptr == NULL) { ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); if (ptr != NULL) { Tcl_DStringAppend(&ds, ptr, -1); } ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY); if (ptr != NULL) { Tcl_DStringAppend(&ds, ptr, -1); } if (Tcl_DStringLength(&ds) > 0) { Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); } else { /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); if (ptr != NULL && ptr[0]) { Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); } else { /* Last resort */ Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); } } } /* * Initialize the user name from the environment first, since this is much * faster than asking the system. * Note: cchUserNameLen is number of characters including nul terminator. */ ptr = TclpGetUserName(&ds); Tcl_SetVar2(interp, "tcl_platform", "user", ptr ? ptr : "", TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds); /* * Define what the platform PATH separator is. [TIP #315] */ Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY); } /* *---------------------------------------------------------------------- * * TclpFindVariable -- * * Locate the entry in environ for a given name. On Unix this routine is * case sensitive, on Windows this matches mixed case. * * Results: * The return value is the index in environ of an entry with the name * "name", or -1 if there is no such entry. The integer at *lengthPtr is * filled in with the length of name (if a matching entry is found) or * the length of the environ array (if no matching entry is found). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpFindVariable( const char *name, /* Name of desired environment variable * (UTF-8). */ int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { int i, length, result = -1; const WCHAR *env; const char *p1, *p2; char *envUpper, *nameUpper; Tcl_DString envString; /* * Convert the name to all upper case for the case insensitive comparison. */ length = strlen(name); nameUpper = (char *)ckalloc(length + 1); memcpy(nameUpper, name, length+1); Tcl_UtfToUpper(nameUpper); Tcl_DStringInit(&envString); for (i = 0, env = _wenviron[i]; env != NULL; i++, env = _wenviron[i]) { /* * Chop the env string off after the equal sign, then Convert the name * to all upper case, so we do not have to convert all the characters * after the equal sign. */ envUpper = Tcl_WinTCharToUtf((TCHAR *)env, -1, &envString); p1 = strchr(envUpper, '='); if (p1 == NULL) { continue; } length = (int) (p1 - envUpper); Tcl_DStringSetLength(&envString, length+1); Tcl_UtfToUpper(envUpper); p1 = envUpper; p2 = nameUpper; for (; *p2 == *p1; p1++, p2++) { /* NULL loop body. */ } if ((*p1 == '=') && (*p2 == '\0')) { *lengthPtr = length; result = i; goto done; } Tcl_DStringFree(&envString); } *lengthPtr = i; done: Tcl_DStringFree(&envString); ckfree(nameUpper); return result; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinInt.h0000644000175000017500000001250714554262142014530 0ustar sergeisergei/* * tclWinInt.h -- * * Declarations of Windows-specific shared variables and procedures. * * Copyright (c) 1994-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLWININT #define _TCLWININT #include "tclInt.h" #ifdef HAVE_NO_SEH /* * Unlike Borland and Microsoft, we don't register exception handlers by * pushing registration records onto the runtime stack. Instead, we register * them by creating an TCLEXCEPTION_REGISTRATION within the activation record. */ typedef struct TCLEXCEPTION_REGISTRATION { struct TCLEXCEPTION_REGISTRATION *link; EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); void *ebp; void *esp; int status; } TCLEXCEPTION_REGISTRATION; #endif /* * Windows version dependend functions */ typedef struct TclWinProcs { BOOL (WINAPI *cancelSynchronousIo)(HANDLE); BOOLEAN (WINAPI *createSymbolicLink)(LPCWSTR, LPCWSTR, DWORD); } TclWinProcs; MODULE_SCOPE TclWinProcs tclWinProcs; /* * Some versions of Borland C have a define for the OSVERSIONINFO for * Win32s and for NT, but not for Windows 95. * Define VER_PLATFORM_WIN32_CE for those without newer headers. */ #ifndef VER_PLATFORM_WIN32_WINDOWS #define VER_PLATFORM_WIN32_WINDOWS 1 #endif #ifndef VER_PLATFORM_WIN32_CE #define VER_PLATFORM_WIN32_CE 3 #endif #ifndef TCL_Z_MODIFIER # ifdef _WIN64 # if defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO # define TCL_Z_MODIFIER "ll" # else # define TCL_Z_MODIFIER "I" # endif # else # define TCL_Z_MODIFIER "" # endif #endif #define TCL_I_MODIFIER TCL_Z_MODIFIER /* * Declarations of functions that are not accessible by way of the * stubs table. */ MODULE_SCOPE char TclWinDriveLetterForVolMountPoint( const WCHAR *mountPoint); MODULE_SCOPE void TclWinEncodingsCleanup(void); MODULE_SCOPE void TclWinInit(HINSTANCE hInst); MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle); MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle, char *channelName, int permissions); MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, char *channelName, int permissions); MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const WCHAR *name, DWORD access); MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, const WCHAR *LinkCopy); MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) MODULE_SCOPE void TclWinFreeAllocCache(void); MODULE_SCOPE void TclFreeAllocCache(void *); MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void); MODULE_SCOPE void * TclpGetAllocCache(void); MODULE_SCOPE void TclpSetAllocCache(void *); #endif /* TCL_THREADS */ MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); /* Needed by tclWinFile.c and tclWinFCmd.c */ #ifndef FILE_ATTRIBUTE_REPARSE_POINT #define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400 #endif /* *---------------------------------------------------------------------- * Declarations of helper-workers threaded facilities for a pipe based channel. * * Corresponding functionality provided in "tclWinPipe.c". *---------------------------------------------------------------------- */ typedef struct TclPipeThreadInfo { HANDLE evControl; /* Auto-reset event used by the main thread to * signal when the pipe thread should attempt * to do read/write operation. Additionally * used as signal to stop (state set to -1) */ volatile LONG state; /* Indicates current state of the thread */ ClientData clientData; /* Referenced data of the main thread */ HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */ } TclPipeThreadInfo; /* If pipe-workers will use some tcl subsystem, we can use ckalloc without * more overhead for finalize thread (should be executed anyway) * * #define _PTI_USE_CKALLOC 1 */ /* * State of the pipe-worker. * * State PTI_STATE_STOP possible from idle state only, worker owns TI structure. * Otherwise PTI_STATE_END used (main thread hold ownership of the TI). */ #define PTI_STATE_IDLE 0 /* idle or not yet initialzed */ #define PTI_STATE_WORK 1 /* in work */ #define PTI_STATE_STOP 2 /* thread should stop work (owns TI structure) */ #define PTI_STATE_END 4 /* thread should stop work (worker is busy) */ #define PTI_STATE_DOWN 8 /* worker is down */ MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, ClientData clientData, HANDLE wakeEvent); MODULE_SCOPE int TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr); static inline void TclPipeThreadSignal( TclPipeThreadInfo **pipeTIPtr) { TclPipeThreadInfo *pipeTI = *pipeTIPtr; if (pipeTI) { SetEvent(pipeTI->evControl); } }; static inline int TclPipeThreadIsAlive( TclPipeThreadInfo **pipeTIPtr) { TclPipeThreadInfo *pipeTI = *pipeTIPtr; return (pipeTI && pipeTI->state != PTI_STATE_DOWN); }; MODULE_SCOPE int TclPipeThreadStopSignal(TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent); MODULE_SCOPE void TclPipeThreadStop(TclPipeThreadInfo **pipeTIPtr, HANDLE hThread); MODULE_SCOPE void TclPipeThreadExit(TclPipeThreadInfo **pipeTIPtr); #endif /* _TCLWININT */ tcl8.6.14/win/tclWinLoad.c0000644000175000017500000003016714554262142014652 0ustar sergeisergei/* * tclWinLoad.c -- * * This function provides a version of the TclLoadFile that works with * the Windows "LoadLibrary" and "GetProcAddress" API for dynamic * loading. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" /* * Native name of the directory in the native filesystem where DLLs used in * this process are copied prior to loading, and mutex used to protect its * allocation. */ static WCHAR *dllDirectoryName = NULL; static Tcl_Mutex dllDirectoryNameMutex; /* * Static functions defined within this file. */ static void * FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); static int InitDLLDirectoryName(void); static void UnloadFile(Tcl_LoadHandle loadHandle); /* *---------------------------------------------------------------------- * * TclpDlopen -- * * Dynamically loads a binary code file into memory and returns a handle * to the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. * *---------------------------------------------------------------------- */ int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { HINSTANCE hInstance = NULL; const WCHAR *nativeName; Tcl_LoadHandle handlePtr; DWORD firstError; (void)flags; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (nativeName != NULL) { hInstance = LoadLibraryExW(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); } if (hInstance == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the * binary path. */ Tcl_DString ds; /* * Remember the first error on load attempt to be used if the * second load attempt below also fails. */ firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); nativeName = (WCHAR *)Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds); hInstance = LoadLibraryExW(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } if (hInstance == NULL) { DWORD lastError; Tcl_Obj *errMsg; /* * We choose to only use the error from the second call if the first * call failed due to the file not being found. Else stick to the * first error for reporting purposes. */ if (firstError == ERROR_MOD_NOT_FOUND || firstError == ERROR_DLL_NOT_FOUND) { lastError = GetLastError(); } else { lastError = firstError; } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", Tcl_GetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, * because Windows seems to only return ERROR_MOD_NOT_FOUND for just * about any problem, but it's better than nothing. It'd be even * better if there was a way to get what DLLs */ if (interp) { switch (lastError) { case ERROR_MOD_NOT_FOUND: Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL); goto notFoundMsg; case ERROR_DLL_NOT_FOUND: Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL); notFoundMsg: Tcl_AppendToObj(errMsg, "this library or a dependent library" " could not be found in library path", -1); break; case ERROR_PROC_NOT_FOUND: Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL); Tcl_AppendToObj(errMsg, "A function specified in the import" " table could not be resolved by the system. Windows" " is not telling which one, I'm sorry.", -1); break; case ERROR_INVALID_DLL: Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL); Tcl_AppendToObj(errMsg, "this library or a dependent library" " is damaged", -1); break; case ERROR_DLL_INIT_FAILED: Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL); Tcl_AppendToObj(errMsg, "the library initialization" " routine failed", -1); break; case ERROR_BAD_EXE_FORMAT: Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", NULL); Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1); break; default: TclWinConvertError(lastError); Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1); } Tcl_SetObjResult(interp, errMsg); } return TCL_ERROR; } /* * Succeded; package everything up for Tcl. */ handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); handlePtr->clientData = (ClientData) hInstance; handlePtr->findSymbolProcPtr = &FindSymbol; handlePtr->unloadFileProcPtr = &UnloadFile; *loadHandle = handlePtr; *unloadProcPtr = &UnloadFile; return TCL_OK; } /* *---------------------------------------------------------------------- * * FindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). * * Results: * Returns a pointer to the function associated with 'symbol' if it is * found. Otherwise returns NULL and may leave an error message in the * interp's result. * *---------------------------------------------------------------------- */ static void * FindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol) { HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; void *proc = NULL; /* * For each symbol, check for both Symbol and _Symbol, since Borland * generates C symbols with a leading '_' by default. */ proc = (void *)GetProcAddress(hInstance, symbol); if (proc == NULL) { Tcl_DString ds; const char *sym2; Tcl_DStringInit(&ds); TclDStringAppendLiteral(&ds, "_"); sym2 = Tcl_DStringAppend(&ds, symbol, -1); proc = (void *)GetProcAddress(hInstance, sym2); Tcl_DStringFree(&ds); } if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); } return proc; } /* *---------------------------------------------------------------------- * * UnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling * this function. * * Results: * None. * * Side effects: * Code removed from memory. * *---------------------------------------------------------------------- */ static void UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; FreeLibrary(hInstance); ckfree(loadHandle); } /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package name, * this function is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a package * name; generic code will then try to guess the package from the file * name. A return value of 1 would have meant that we figured out the * package name and put it in bufPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName( const char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ { (void)fileName; (void)bufPtr; return 0; } /* *---------------------------------------------------------------------- * * TclpTempFileNameForLibrary -- * * Constructs a temporary file name for loading a shared object (DLL). * * Results: * Returns the constructed file name. * * On Windows, a DLL is identified by the final component of its path name. * Cross linking among DLL's (and hence, preloading) will not work unless this * name is preserved when copying a DLL from a VFS to a temp file for * preloading. For this reason, all DLLs in a given process are copied to a * temp directory, and their names are preserved. * *---------------------------------------------------------------------- */ Tcl_Obj * TclpTempFileNameForLibrary( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *path) /* Path name of the DLL in the VFS. */ { Tcl_Obj *fileName; /* Name of the temp file. */ Tcl_Obj *tail; /* Tail of the source path. */ Tcl_MutexLock(&dllDirectoryNameMutex); if (dllDirectoryName == NULL) { if (InitDLLDirectoryName() == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create temporary directory: %s", Tcl_PosixError(interp))); Tcl_MutexUnlock(&dllDirectoryNameMutex); return NULL; } } Tcl_MutexUnlock(&dllDirectoryNameMutex); /* * Now we know where to put temporary DLLs, construct the name. */ fileName = TclpNativeToNormalized(dllDirectoryName); tail = TclPathPart(interp, path, TCL_PATH_TAIL); if (tail == NULL) { Tcl_DecrRefCount(fileName); return NULL; } Tcl_AppendToObj(fileName, "/", 1); Tcl_AppendObjToObj(fileName, tail); return fileName; } /* *---------------------------------------------------------------------- * * InitDLLDirectoryName -- * * Helper for TclpTempFileNameForLibrary; builds a temporary directory * that is specific to the current process. Should only be called once * per process start. Caller must hold dllDirectoryNameMutex. * * Results: * Tcl result code. * * Side-effects: * Creates temp directory. * Allocates memory pointed to by dllDirectoryName. * *---------------------------------------------------------------------- * [Candidate for process global?] */ static int InitDLLDirectoryName(void) { size_t nameLen; /* Length of the temp folder name. */ WCHAR name[MAX_PATH]; /* Path name of the temp folder. */ DWORD id; /* The process id. */ DWORD lastError; /* Last error to happen in Win API. */ int i; /* * Determine the name of the directory to use, and create it. (Keep * trying with new names until an attempt to create the directory * succeeds) */ nameLen = GetTempPathW(MAX_PATH, name); if (nameLen >= MAX_PATH-12) { Tcl_SetErrno(ENAMETOOLONG); return TCL_ERROR; } wcscpy(name+nameLen, L"TCLXXXXXXXX"); nameLen += 11; id = GetCurrentProcessId(); lastError = ERROR_ALREADY_EXISTS; for (i=0 ; i<256 ; i++) { wsprintfW(name+nameLen-8, L"%08x", id); if (CreateDirectoryW(name, NULL)) { /* * Issue: we don't schedule this directory for deletion by anyone. * Can we ask the OS to do this for us? There appears to be * potential for using CreateFile (with the flag * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this... */ goto copyToGlobalBuffer; } lastError = GetLastError(); if (lastError != ERROR_ALREADY_EXISTS) { break; } id *= 16777619; } TclWinConvertError(lastError); return TCL_ERROR; /* * Store our computed value in the global. */ copyToGlobalBuffer: dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR)); wcscpy(dllDirectoryName, name); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinNotify.c0000644000175000017500000003652414554262142015246 0ustar sergeisergei/* * tclWinNotify.c -- * * This file contains Windows-specific procedures for the notifier, which * is the lowest-level part of the Tcl event loop. This file works * together with ../generic/tclNotify.c. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * The following static indicates whether this module has been initialized. */ #define INTERVAL_TIMER 1 /* Handle of interval timer. */ #define WM_WAKEUP WM_USER /* Message that is send by * Tcl_AlertNotifier. */ /* * The following static structure contains the state information for the * Windows implementation of the Tcl notifier. One of these structures is * created for each thread that is using the notifier. */ typedef struct ThreadSpecificData { CRITICAL_SECTION crit; /* Monitor for this notifier. */ DWORD thread; /* Identifier for thread associated with this * notifier. */ HANDLE event; /* Event object used to wake up the notifier * thread. */ int pending; /* Alert message pending, this field is locked * by the notifierMutex. */ HWND hwnd; /* Messaging window. */ int timeout; /* Current timeout value. */ int timerActive; /* 1 if interval timer is running. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following static indicates the number of threads that have initialized * notifiers. It controls the lifetime of the TclNotifier window class. * * You must hold the notifierMutex lock before accessing this variable. */ static int notifierCount = 0; static const WCHAR classname[] = L"TclNotifier"; TCL_DECLARE_MUTEX(notifierMutex) /* * Static routines defined in this file. */ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); /* *---------------------------------------------------------------------- * * Tcl_InitNotifier -- * * Initializes the platform specific notifier state. * * Results: * Returns a handle to the notifier state for this thread.. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_InitNotifier(void) { if (tclNotifierHooks.initNotifierProc) { return tclNotifierHooks.initNotifierProc(); } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); WNDCLASSW windowClass; /* * Register Notifier window class if this is the first thread to use * this module. */ Tcl_MutexLock(¬ifierMutex); if (notifierCount == 0) { windowClass.style = 0; windowClass.cbClsExtra = 0; windowClass.cbWndExtra = 0; windowClass.hInstance = TclWinGetTclInstance(); windowClass.hbrBackground = NULL; windowClass.lpszMenuName = NULL; windowClass.lpszClassName = classname; windowClass.lpfnWndProc = NotifierProc; windowClass.hIcon = NULL; windowClass.hCursor = NULL; if (!RegisterClassW(&windowClass)) { Tcl_Panic("Unable to register TclNotifier window class"); } } notifierCount++; Tcl_MutexUnlock(¬ifierMutex); tsdPtr->pending = 0; tsdPtr->timerActive = 0; InitializeCriticalSection(&tsdPtr->crit); tsdPtr->hwnd = NULL; tsdPtr->thread = GetCurrentThreadId(); tsdPtr->event = CreateEventW(NULL, TRUE /* manual */, FALSE /* !signaled */, NULL); return tsdPtr; } } /* *---------------------------------------------------------------------- * * Tcl_FinalizeNotifier -- * * This function is called to cleanup the notifier state before a thread * is terminated. * * Results: * None. * * Side effects: * May dispose of the notifier window and class. * *---------------------------------------------------------------------- */ void Tcl_FinalizeNotifier( ClientData clientData) /* Pointer to notifier data. */ { if (tclNotifierHooks.finalizeNotifierProc) { tclNotifierHooks.finalizeNotifierProc(clientData); return; } else { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; /* * Only finalize the notifier if a notifier was installed in the * current thread; there is a route in which this is not guaranteed to * be true (when tclWin32Dll.c:DllMain() is called with the flag * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread * that's never previously been involved with Tcl, e.g. the task * manager) so this check is important. * * Fixes Bug #217982 reported by Hugh Vu and Gene Leache. */ if (tsdPtr == NULL) { return; } DeleteCriticalSection(&tsdPtr->crit); CloseHandle(tsdPtr->event); /* * Clean up the timer and messaging window for this thread. */ if (tsdPtr->hwnd) { KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); DestroyWindow(tsdPtr->hwnd); } /* * If this is the last thread to use the notifier, unregister the * notifier window class. */ Tcl_MutexLock(¬ifierMutex); notifierCount--; if (notifierCount == 0) { UnregisterClassW(classname, TclWinGetTclInstance()); } Tcl_MutexUnlock(¬ifierMutex); } } /* *---------------------------------------------------------------------- * * Tcl_AlertNotifier -- * * Wake up the specified notifier from any thread. This routine is called * by the platform independent notifier code whenever the Tcl_ThreadAlert * routine is called. This routine is guaranteed not to be called on a * given notifier after Tcl_FinalizeNotifier is called for that notifier. * This routine is typically called from a thread other than the * notifier's thread. * * Results: * None. * * Side effects: * Sends a message to the messaging window for the notifier if there * isn't already one pending. * *---------------------------------------------------------------------- */ void Tcl_AlertNotifier( ClientData clientData) /* Pointer to thread data. */ { if (tclNotifierHooks.alertNotifierProc) { tclNotifierHooks.alertNotifierProc(clientData); return; } else { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; /* * Note that we do not need to lock around access to the hwnd because * the race condition has no effect since any race condition implies * that the notifier thread is already awake. */ if (tsdPtr->hwnd) { /* * We do need to lock around access to the pending flag. */ EnterCriticalSection(&tsdPtr->crit); if (!tsdPtr->pending) { PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0); } tsdPtr->pending = 1; LeaveCriticalSection(&tsdPtr->crit); } else { SetEvent(tsdPtr->event); } } } /* *---------------------------------------------------------------------- * * Tcl_SetTimer -- * * This procedure sets the current notifier timer value. The notifier * will ensure that Tcl_ServiceAll() is called after the specified * interval, even if no events have occurred. * * Results: * None. * * Side effects: * Replaces any previous timer. * *---------------------------------------------------------------------- */ void Tcl_SetTimer( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { if (tclNotifierHooks.setTimerProc) { tclNotifierHooks.setTimerProc(timePtr); return; } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); UINT timeout; /* * We only need to set up an interval timer if we're being called from * an external event loop. If we don't have a window handle then we * just return immediately and let Tcl_WaitForEvent handle timeouts. */ if (!tsdPtr->hwnd) { return; } if (!timePtr) { timeout = 0; } else { /* * Make sure we pass a non-zero value into the timeout argument. * Windows seems to get confused by zero length timers. */ timeout = timePtr->sec * 1000 + timePtr->usec / 1000; if (timeout == 0) { timeout = 1; } } tsdPtr->timeout = timeout; if (timeout != 0) { tsdPtr->timerActive = 1; SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout, NULL); } else { tsdPtr->timerActive = 0; KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); } } } /* *---------------------------------------------------------------------- * * Tcl_ServiceModeHook -- * * This function is invoked whenever the service mode changes. * * Results: * None. * * Side effects: * If this is the first time the notifier is set into TCL_SERVICE_ALL, * then the communication window is created. * *---------------------------------------------------------------------- */ void Tcl_ServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { if (tclNotifierHooks.serviceModeHookProc) { tclNotifierHooks.serviceModeHookProc(mode); return; } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * If this is the first time that the notifier has been used from a * modal loop, then create a communication window. Note that after this * point, the application needs to service events in a timely fashion * or Windows will hang waiting for the window to respond to * synchronous system messages. At some point, we may want to consider * destroying the window if we leave the modal loop, but for now we'll * leave it around. */ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { tsdPtr->hwnd = CreateWindowW(classname, classname, WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); /* * Send an initial message to the window to ensure that we wake up * the notifier once we get into the modal loop. This will force * the notifier to recompute the timeout value and schedule a timer * if one is needed. */ Tcl_AlertNotifier(tsdPtr); } } } /* *---------------------------------------------------------------------- * * NotifierProc -- * * This procedure is invoked by Windows to process events on the notifier * window. Messages will be sent to this window in response to external * timer events or calls to TclpAlertTsdPtr-> * * Results: * A standard windows result. * * Side effects: * Services any pending events. * *---------------------------------------------------------------------- */ static LRESULT CALLBACK NotifierProc( HWND hwnd, /* Passed on... */ UINT message, /* What messsage is this? */ WPARAM wParam, /* Passed on... */ LPARAM lParam) /* Passed on... */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (message == WM_WAKEUP) { EnterCriticalSection(&tsdPtr->crit); tsdPtr->pending = 0; LeaveCriticalSection(&tsdPtr->crit); } else if (message != WM_TIMER) { return DefWindowProcW(hwnd, message, wParam, lParam); } /* * Process all of the runnable events. */ Tcl_ServiceAll(); return 0; } /* *---------------------------------------------------------------------- * * Tcl_WaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on * the message queue. If the block time is 0, then Tcl_WaitForEvent just * polls the event queue without blocking. * * Results: * Returns -1 if a WM_QUIT message is detected, returns 1 if a message * was dispatched, otherwise returns 0. * * Side effects: * Dispatches a message to a window procedure, which could do anything. * *---------------------------------------------------------------------- */ int Tcl_WaitForEvent( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { if (tclNotifierHooks.waitForEventProc) { return tclNotifierHooks.waitForEventProc(timePtr); } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); MSG msg; DWORD timeout, result; int status; /* * Compute the timeout in milliseconds. */ if (timePtr) { /* * TIP #233 (Virtualized Time). Convert virtual domain delay to * real-time. */ Tcl_Time myTime; myTime.sec = timePtr->sec; myTime.usec = timePtr->usec; if (myTime.sec != 0 || myTime.usec != 0) { tclScaleTimeProcPtr(&myTime, tclTimeClientData); } timeout = myTime.sec * 1000 + myTime.usec / 1000; } else { timeout = INFINITE; } /* * Check to see if there are any messages in the queue before waiting * because MsgWaitForMultipleObjects will not wake up if there are * events currently sitting in the queue. */ if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Wait for something to happen (a signal from another thread, a * message, or timeout) or loop servicing asynchronous procedure * calls queued to this thread. */ again: result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout, QS_ALLINPUT, MWMO_ALERTABLE); if (result == WAIT_IO_COMPLETION) { goto again; } else if (result == WAIT_FAILED) { status = -1; goto end; } } /* * Check to see if there are any messages to process. */ if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Retrieve and dispatch the first message. */ result = GetMessageW(&msg, NULL, 0, 0); if (result == 0) { /* * We received a request to exit this thread (WM_QUIT), so * propagate the quit message and start unwinding. */ PostQuitMessage((int) msg.wParam); status = -1; } else if (result == (DWORD)-1) { /* * We got an error from the system. I have no idea why this * would happen, so we'll just unwind. */ status = -1; } else { TranslateMessage(&msg); DispatchMessageW(&msg); status = 1; } } else { status = 0; } end: ResetEvent(tsdPtr->event); return status; } } /* *---------------------------------------------------------------------- * * Tcl_Sleep -- * * Delay execution for the specified number of milliseconds. * * Results: * None. * * Side effects: * Time passes. * *---------------------------------------------------------------------- */ void Tcl_Sleep( int ms) /* Number of milliseconds to sleep. */ { /* * Simply calling 'Sleep' for the requisite number of milliseconds can * make the process appear to wake up early because it isn't synchronized * with the CPU performance counter that is used in tclWinTime.c. This * behavior is probably benign, but messes up some of the corner cases in * the test suite. We get around this problem by repeating the 'Sleep' * call as many times as necessary to make the clock advance by the * requisite amount. */ Tcl_Time now; /* Current wall clock time. */ Tcl_Time desired; /* Desired wakeup time. */ Tcl_Time vdelay; /* Time to sleep, for scaling virtual -> * real. */ DWORD sleepTime; /* Time to sleep, real-time */ vdelay.sec = ms / 1000; vdelay.usec = (ms % 1000) * 1000; Tcl_GetTime(&now); desired.sec = now.sec + vdelay.sec; desired.usec = now.usec + vdelay.usec; if (desired.usec > 1000000) { ++desired.sec; desired.usec -= 1000000; } /* * TIP #233: Scale delay from virtual to real-time. */ tclScaleTimeProcPtr(&vdelay, tclTimeClientData); sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; for (;;) { SleepEx(sleepTime, TRUE); Tcl_GetTime(&now); if (now.sec > desired.sec) { break; } else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) { break; } vdelay.sec = desired.sec - now.sec; vdelay.usec = desired.usec - now.usec; tclScaleTimeProcPtr(&vdelay, tclTimeClientData); sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinPipe.c0000644000175000017500000027554114554262142014677 0ustar sergeisergei/* * tclWinPipe.c -- * * This file implements the Windows-specific exec pipeline functions, the * "pipe" channel driver, and the "pid" Tcl command. * * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" /* * The following variable is used to tell whether this module has been * initialized. */ static int initialized = 0; /* * The pipeMutex locks around access to the initialized and procList * variables, and it is used to protect background threads from being * terminated while they are using APIs that hold locks. */ TCL_DECLARE_MUTEX(pipeMutex) /* * The following defines identify the various types of applications that run * under windows. There is special case code for the various types. */ #define APPL_NONE 0 #define APPL_DOS 1 #define APPL_WIN3X 2 #define APPL_WIN32 3 /* * The following constants and structures are used to encapsulate the state of * various types of files used in a pipeline. This used to have a 1 && 2 that * supported Win32s. */ #define WIN_FILE 3 /* Basic Win32 file. */ /* * This structure encapsulates the common state associated with all file types * used in a pipeline. */ typedef struct { int type; /* One of the file types defined above. */ HANDLE handle; /* Open file handle. */ } WinFile; /* * This list is used to map from pids to process handles. */ typedef struct ProcInfo { HANDLE hProcess; DWORD dwProcessId; struct ProcInfo *nextPtr; } ProcInfo; static ProcInfo *procList; /* * Bit masks used in the flags field of the PipeInfo structure below. */ #define PIPE_PENDING (1<<0) /* Message is pending in the queue. */ #define PIPE_ASYNC (1<<1) /* Channel is non-blocking. */ /* * Bit masks used in the sharedFlags field of the PipeInfo structure below. */ #define PIPE_EOF (1<<2) /* Pipe has reached EOF. */ #define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */ /* * TODO: It appears the whole EXTRABYTE machinery is in place to support * outdated Win 95 systems. If this can be confirmed, much code can be * deleted. */ /* * This structure describes per-instance data for a pipe based channel. */ typedef struct PipeInfo { struct PipeInfo *nextPtr; /* Pointer to next registered pipe. */ Tcl_Channel channel; /* Pointer to channel structure. */ int validMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ int watchMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which events should be reported. */ int flags; /* State flags, see above for a list. */ TclFile readFile; /* Output from pipe. */ TclFile writeFile; /* Input from pipe. */ TclFile errorFile; /* Error output from pipe. */ int numPids; /* Number of processes attached to pipe. */ Tcl_Pid *pidPtr; /* Pids of attached processes. */ Tcl_ThreadId threadId; /* Thread to which events should be reported. * This value is used by the reader/writer * threads. */ TclPipeThreadInfo *writeTI; /* Thread info of writer and reader, this */ TclPipeThreadInfo *readTI; /* structure owned by corresponding thread. */ HANDLE writeThread; /* Handle to writer thread. */ HANDLE readThread; /* Handle to reader thread. */ HANDLE writable; /* Manual-reset event to signal when the * writer thread has finished waiting for the * current buffer to be written. */ HANDLE readable; /* Manual-reset event to signal when the * reader thread has finished waiting for * input. */ DWORD writeError; /* An error caused by the last background * write. Set to 0 if no error has been * detected. This word is shared with the * writer thread so access must be * synchronized with the writable object. */ char *writeBuf; /* Current background output buffer. Access is * synchronized with the writable object. */ int writeBufLen; /* Size of write buffer. Access is * synchronized with the writable object. */ int toWrite; /* Current amount to be written. Access is * synchronized with the writable object. */ int readFlags; /* Flags that are shared with the reader * thread. Access is synchronized with the * readable object. */ char extraByte; /* Buffer for extra character consumed by * reader thread. This byte is shared with the * reader thread so access must be * synchronized with the readable object. */ } PipeInfo; typedef struct { /* * The following pointer refers to the head of the list of pipes that are * being watched for file events. */ PipeInfo *firstPipePtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following structure is what is added to the Tcl event queue when pipe * events are generated. */ typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ PipeInfo *infoPtr; /* Pointer to pipe info structure. Note that * we still have to verify that the pipe * exists before dereferencing this * pointer. */ } PipeEvent; /* * Declarations for functions used only in this file. */ static int ApplicationType(Tcl_Interp *interp, const char *fileName, char *fullName); static void BuildCommandLine(const char *executable, int argc, const char **argv, Tcl_DString *linePtr); static BOOL HasConsole(void); static int PipeBlockModeProc(ClientData instanceData, int mode); static void PipeCheckProc(ClientData clientData, int flags); static int PipeClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags); static int PipeEventProc(Tcl_Event *evPtr, int flags); static int PipeGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static void PipeInit(void); static int PipeInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int PipeOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static DWORD WINAPI PipeReaderThread(LPVOID arg); static void PipeSetupProc(ClientData clientData, int flags); static void PipeWatchProc(ClientData instanceData, int mask); static DWORD WINAPI PipeWriterThread(LPVOID arg); static int TempFileName(WCHAR name[MAX_PATH]); static int WaitForRead(PipeInfo *infoPtr, int blocking); static void PipeThreadActionProc(ClientData instanceData, int action); /* * This structure describes the channel type structure for command pipe based * I/O. */ static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TCL_CLOSE2PROC, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ PipeWatchProc, /* Set up notifier to watch the channel. */ PipeGetHandleProc, /* Get an OS handle from channel. */ PipeClose2Proc, /* close2proc */ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ PipeThreadActionProc, /* thread action proc */ NULL /* truncate */ }; /* *---------------------------------------------------------------------- * * PipeInit -- * * This function initializes the static variables for this file. * * Results: * None. * * Side effects: * Creates a new event source. * *---------------------------------------------------------------------- */ static void PipeInit(void) { ThreadSpecificData *tsdPtr; /* * Check the initialized flag first, then check again in the mutex. This * is a speed enhancement. */ if (!initialized) { Tcl_MutexLock(&pipeMutex); if (!initialized) { initialized = 1; procList = NULL; } Tcl_MutexUnlock(&pipeMutex); } tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->firstPipePtr = NULL; Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL); } } /* *---------------------------------------------------------------------- * * TclpFinalizePipes -- * * This function is called from Tcl_FinalizeThread to finalize the * platform specific pipe subsystem. * * Results: * None. * * Side effects: * Removes the pipe event source. * *---------------------------------------------------------------------- */ void TclpFinalizePipes(void) { ThreadSpecificData *tsdPtr; tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL); } } /* *---------------------------------------------------------------------- * * PipeSetupProc -- * * This function is invoked before Tcl_DoOneEvent blocks waiting for an * event. * * Results: * None. * * Side effects: * Adjusts the block time if needed. * *---------------------------------------------------------------------- */ void PipeSetupProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { PipeInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; int block = 1; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return; } /* * Look to see if any events are already pending. If they are, poll. */ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask & TCL_WRITABLE) { if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { block = 0; } } if (infoPtr->watchMask & TCL_READABLE) { if (WaitForRead(infoPtr, 0) >= 0) { block = 0; } } } if (!block) { Tcl_SetMaxBlockTime(&blockTime); } } /* *---------------------------------------------------------------------- * * PipeCheckProc -- * * This function is called by Tcl_DoOneEvent to check the pipe event * source for events. * * Results: * None. * * Side effects: * May queue an event. * *---------------------------------------------------------------------- */ static void PipeCheckProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { PipeInfo *infoPtr; PipeEvent *evPtr; int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return; } /* * Queue events for any ready pipes that don't already have events queued. */ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->flags & PIPE_PENDING) { continue; } /* * Queue an event if the pipe is signaled for reading or writing. */ needEvent = 0; if ((infoPtr->watchMask & TCL_WRITABLE) && (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) { needEvent = 1; } if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr, 0) >= 0)) { needEvent = 1; } if (needEvent) { infoPtr->flags |= PIPE_PENDING; evPtr = (PipeEvent *)ckalloc(sizeof(PipeEvent)); evPtr->header.proc = PipeEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } } /* *---------------------------------------------------------------------- * * TclWinMakeFile -- * * This function constructs a new TclFile from a given data and type * value. * * Results: * Returns a newly allocated WinFile as a TclFile. * * Side effects: * None. * *---------------------------------------------------------------------- */ TclFile TclWinMakeFile( HANDLE handle) /* Type-specific data. */ { WinFile *filePtr; filePtr = (WinFile *)ckalloc(sizeof(WinFile)); filePtr->type = WIN_FILE; filePtr->handle = handle; return (TclFile)filePtr; } /* *---------------------------------------------------------------------- * * TempFileName -- * * Gets a temporary file name and deals with the fact that the temporary * file path provided by Windows may not actually exist if the TMP or * TEMP environment variables refer to a non-existent directory. * * Results: * 0 if error, non-zero otherwise. If non-zero is returned, the name * buffer will be filled with a name that can be used to construct a * temporary file. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TempFileName( WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file * gets stored. */ { const WCHAR *prefix = L"TCL"; if (GetTempPathW(MAX_PATH, name) != 0) { if (GetTempFileNameW(name, prefix, 0, name) != 0) { return 1; } } name[0] = '.'; name[1] = '\0'; return GetTempFileNameW(name, prefix, 0, name); } /* *---------------------------------------------------------------------- * * TclpMakeFile -- * * Make a TclFile from a channel. * * Results: * Returns a new TclFile or NULL on failure. * * Side effects: * None. * *---------------------------------------------------------------------- */ TclFile TclpMakeFile( Tcl_Channel channel, /* Channel to get file from. */ int direction) /* Either TCL_READABLE or TCL_WRITABLE. */ { HANDLE handle; if (Tcl_GetChannelHandle(channel, direction, (ClientData *) &handle) == TCL_OK) { return TclWinMakeFile(handle); } else { return (TclFile) NULL; } } /* *---------------------------------------------------------------------- * * TclpOpenFile -- * * This function opens files for use in a pipeline. * * Results: * Returns a newly allocated TclFile structure containing the file * handle. * * Side effects: * None. * *---------------------------------------------------------------------- */ TclFile TclpOpenFile( const char *path, /* The name of the file to open. */ int mode) /* In what mode to open the file? */ { HANDLE handle; DWORD accessMode, createMode, shareMode, flags; Tcl_DString ds; const WCHAR *nativePath; /* * Map the access bits to the NT access mode. */ switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { case O_RDONLY: accessMode = GENERIC_READ; break; case O_WRONLY: accessMode = GENERIC_WRITE; break; case O_RDWR: accessMode = (GENERIC_READ | GENERIC_WRITE); break; default: TclWinConvertError(ERROR_INVALID_FUNCTION); return NULL; } /* * Map the creation flags to the NT create mode. */ switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) { case (O_CREAT | O_EXCL): case (O_CREAT | O_EXCL | O_TRUNC): createMode = CREATE_NEW; break; case (O_CREAT | O_TRUNC): createMode = CREATE_ALWAYS; break; case O_CREAT: createMode = OPEN_ALWAYS; break; case O_TRUNC: case (O_TRUNC | O_EXCL): createMode = TRUNCATE_EXISTING; break; default: createMode = OPEN_EXISTING; break; } nativePath = (WCHAR *)Tcl_WinUtfToTChar(path, -1, &ds); /* * If the file is not being created, use the existing file attributes. */ flags = 0; if (!(mode & O_CREAT)) { flags = GetFileAttributesW(nativePath); if (flags == 0xFFFFFFFF) { flags = 0; } } /* * Set up the file sharing mode. We want to allow simultaneous access. */ shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE; /* * Now we get to create the file. */ handle = CreateFileW(nativePath, accessMode, shareMode, NULL, createMode, flags, NULL); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { DWORD err; err = GetLastError(); if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) { err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } TclWinConvertError(err); return NULL; } /* * Seek to the end of file if we are writing. */ if (mode & (O_WRONLY|O_APPEND)) { SetFilePointer(handle, 0, NULL, FILE_END); } return TclWinMakeFile(handle); } /* *---------------------------------------------------------------------- * * TclpCreateTempFile -- * * This function opens a unique file with the property that it will be * deleted when its file handle is closed. The temporary file is created * in the system temporary directory. * * Results: * Returns a valid TclFile, or NULL on failure. * * Side effects: * Creates a new temporary file. * *---------------------------------------------------------------------- */ TclFile TclpCreateTempFile( const char *contents) /* String to write into temp file, or NULL. */ { WCHAR name[MAX_PATH]; const char *native; Tcl_DString dstring; HANDLE handle; if (TempFileName(name) == 0) { return NULL; } handle = CreateFileW(name, GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL); if (handle == INVALID_HANDLE_VALUE) { goto error; } /* * Write the file out, doing line translations on the way. */ if (contents != NULL) { DWORD result, length; const char *p; int toCopy; /* * Convert the contents from UTF to native encoding */ native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); toCopy = Tcl_DStringLength(&dstring); for (p = native; toCopy > 0; p++, toCopy--) { if (*p == '\n') { length = p - native; if (length > 0) { if (!WriteFile(handle, native, length, &result, NULL)) { goto error; } } if (!WriteFile(handle, "\r\n", 2, &result, NULL)) { goto error; } native = p+1; } } length = p - native; if (length > 0) { if (!WriteFile(handle, native, length, &result, NULL)) { goto error; } } Tcl_DStringFree(&dstring); if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) { goto error; } } return TclWinMakeFile(handle); error: /* * Free the native representation of the contents if necessary. */ if (contents != NULL) { Tcl_DStringFree(&dstring); } TclWinConvertError(GetLastError()); CloseHandle(handle); DeleteFileW(name); return NULL; } /* *---------------------------------------------------------------------- * * TclpTempFileName -- * * This function returns a unique filename. * * Results: * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * TclpTempFileName(void) { WCHAR fileName[MAX_PATH]; if (TempFileName(fileName) == 0) { return NULL; } return TclpNativeToNormalized(fileName); } /* *---------------------------------------------------------------------- * * TclpCreatePipe -- * * Creates an anonymous pipe. * * Results: * Returns 1 on success, 0 on failure. * * Side effects: * Creates a pipe. * *---------------------------------------------------------------------- */ int TclpCreatePipe( TclFile *readPipe, /* Location to store file handle for read side * of pipe. */ TclFile *writePipe) /* Location to store file handle for write * side of pipe. */ { HANDLE readHandle, writeHandle; if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) { *readPipe = TclWinMakeFile(readHandle); *writePipe = TclWinMakeFile(writeHandle); return 1; } TclWinConvertError(GetLastError()); return 0; } /* *---------------------------------------------------------------------- * * TclpCloseFile -- * * Closes a pipeline file handle. These handles are created by * TclpOpenFile, TclpCreatePipe, or TclpMakeFile. * * Results: * 0 on success, -1 on failure. * * Side effects: * The file is closed and deallocated. * *---------------------------------------------------------------------- */ int TclpCloseFile( TclFile file) /* The file to close. */ { WinFile *filePtr = (WinFile *) file; switch (filePtr->type) { case WIN_FILE: /* * Don't close the Win32 handle if the handle is a standard channel * during the thread exit process. Otherwise, one thread may kill the * stdio of another. */ if (!TclInThreadExit() || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle) && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) { if (filePtr->handle != NULL && CloseHandle(filePtr->handle) == FALSE) { TclWinConvertError(GetLastError()); ckfree(filePtr); return -1; } } break; default: Tcl_Panic("TclpCloseFile: unexpected file type"); } ckfree(filePtr); return 0; } /* *-------------------------------------------------------------------------- * * TclpGetPid -- * * Given a HANDLE to a child process, return the process id for that * child process. * * Results: * Returns the process id for the child process. If the pid was not known * by Tcl, either because the pid was not created by Tcl or the child * process has already been reaped, -1 is returned. * * Side effects: * None. * *-------------------------------------------------------------------------- */ int TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { ProcInfo *infoPtr; PipeInit(); Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->hProcess == (HANDLE) pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } } Tcl_MutexUnlock(&pipeMutex); return (unsigned long) -1; } /* *---------------------------------------------------------------------- * * TclpCreateProcess -- * * Create a child process that has the specified files as its standard * input, output, and error. The child process runs asynchronously under * Windows NT and Windows 9x, and runs with the same environment * variables as the creating process. * * The complete Windows search path is searched to find the specified * executable. If an executable by the given name is not found, * automatically tries appending standard extensions to the * executable name. * * Results: * The return value is TCL_ERROR and an error message is left in the * interp's result if there was a problem creating the child process. * Otherwise, the return value is TCL_OK and *pidPtr is filled with the * process id of the child process. * * Side effects: * A process is created. * *---------------------------------------------------------------------- */ int TclpCreateProcess( Tcl_Interp *interp, /* Interpreter in which to leave errors that * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ int argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings. argv[0] contains * the name of the executable converted to * native format (using the * Tcl_TranslateFileName call). Additional * arguments have not been converted. */ TclFile inputFile, /* If non-NULL, gives the file to use as input * for the child process. If inputFile file is * not readable or is NULL, the child will * receive no standard input. */ TclFile outputFile, /* If non-NULL, gives the file that receives * output from the child process. If * outputFile file is not writable or is * NULL, output from the child will be * discarded. */ TclFile errorFile, /* If non-NULL, gives the file that receives * errors from the child process. If errorFile * file is not writable or is NULL, errors * from the child will be discarded. errorFile * may be the same as outputFile. */ Tcl_Pid *pidPtr) /* If this function is successful, pidPtr is * filled with the process id of the child * process. */ { int result, applType, createFlags; Tcl_DString cmdLine; /* Complete command line (WCHAR). */ STARTUPINFOW startInfo; PROCESS_INFORMATION procInfo; SECURITY_ATTRIBUTES secAtts; HANDLE hProcess, h, inputHandle, outputHandle, errorHandle; char execPath[MAX_PATH * TCL_UTF_MAX]; WinFile *filePtr; PipeInit(); applType = ApplicationType(interp, argv[0], execPath); if (applType == APPL_NONE) { return TCL_ERROR; } result = TCL_ERROR; Tcl_DStringInit(&cmdLine); hProcess = GetCurrentProcess(); /* * STARTF_USESTDHANDLES must be used to pass handles to child process. * Using SetStdHandle() and/or dup2() only works when a console mode * parent process is spawning an attached console mode child process. */ ZeroMemory(&startInfo, sizeof(startInfo)); startInfo.cb = sizeof(startInfo); startInfo.dwFlags = STARTF_USESTDHANDLES; startInfo.hStdInput = INVALID_HANDLE_VALUE; startInfo.hStdOutput= INVALID_HANDLE_VALUE; startInfo.hStdError = INVALID_HANDLE_VALUE; secAtts.nLength = sizeof(SECURITY_ATTRIBUTES); secAtts.lpSecurityDescriptor = NULL; secAtts.bInheritHandle = TRUE; /* * We have to check the type of each file, since we cannot duplicate some * file types. */ inputHandle = INVALID_HANDLE_VALUE; if (inputFile != NULL) { filePtr = (WinFile *)inputFile; if (filePtr->type == WIN_FILE) { inputHandle = filePtr->handle; } } outputHandle = INVALID_HANDLE_VALUE; if (outputFile != NULL) { filePtr = (WinFile *)outputFile; if (filePtr->type == WIN_FILE) { outputHandle = filePtr->handle; } } errorHandle = INVALID_HANDLE_VALUE; if (errorFile != NULL) { filePtr = (WinFile *)errorFile; if (filePtr->type == WIN_FILE) { errorHandle = filePtr->handle; } } /* * Duplicate all the handles which will be passed off as stdin, stdout and * stderr of the child process. The duplicate handles are set to be * inheritable, so the child process can use them. */ if (inputHandle == INVALID_HANDLE_VALUE) { /* * If handle was not set, stdin should return immediate EOF. Under * Windows95, some applications (both 16 and 32 bit!) cannot read from * the NUL device; they read from console instead. When running tk, * this is fatal because the child process would hang forever waiting * for EOF from the unmapped console window used by the helper * application. * * Fortunately, the helper application detects a closed pipe as an * immediate EOF and can pass that information to the child process. */ if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) { CloseHandle(h); } } else { DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdInput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't duplicate input handle: %s", Tcl_PosixError(interp))); goto end; } if (outputHandle == INVALID_HANDLE_VALUE) { /* * If handle was not set, output should be sent to an infinitely deep * sink. Under Windows 95, some 16 bit applications cannot have stdout * redirected to NUL; they send their output to the console instead. * Some applications, like "more" or "dir /p", when outputting * multiple pages to the console, also then try and read from the * console to go the next page. When running tk, this is fatal because * the child process would hang forever waiting for input from the * unmapped console window used by the helper application. * * Fortunately, the helper application will detect a closed pipe as a * sink. */ startInfo.hStdOutput = CreateFileW(L"NUL:", GENERIC_WRITE, 0, &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't duplicate output handle: %s", Tcl_PosixError(interp))); goto end; } if (errorHandle == INVALID_HANDLE_VALUE) { /* * If handle was not set, errors should be sent to an infinitely deep * sink. */ startInfo.hStdError = CreateFileW(L"NUL:", GENERIC_WRITE, 0, &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdError == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't duplicate error handle: %s", Tcl_PosixError(interp))); goto end; } /* * If we do not have a console window, then we must run DOS and WIN32 * console mode applications as detached processes. This tells the loader * that the child application should not inherit the console, and that it * should not create a new console window for the child application. The * child application should get its stdio from the redirection handles * provided by this application, and run in the background. * * If we are starting a GUI process, they don't automatically get a * console, so it doesn't matter if they are started as foreground or * detached processes. The GUI window will still pop up to the foreground. */ if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { if (HasConsole()) { createFlags = 0; } else if (applType == APPL_DOS) { /* * Under NT, 16-bit DOS applications will not run unless they can * be attached to a console. If we are running without a console, * run the 16-bit program as an normal process inside of a hidden * console application, and then run that hidden console as a * detached process. */ startInfo.wShowWindow = SW_HIDE; startInfo.dwFlags |= STARTF_USESHOWWINDOW; createFlags = CREATE_NEW_CONSOLE; TclDStringAppendLiteral(&cmdLine, "cmd.exe /c"); } else { createFlags = DETACHED_PROCESS; } } else { if (HasConsole()) { createFlags = 0; } else { createFlags = DETACHED_PROCESS; } if (applType == APPL_DOS) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "DOS application process not supported on this platform", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP", NULL); goto end; } } /* * cmdLine gets the full command line used to invoke the executable, * including the name of the executable itself. The command line arguments * in argv[] are stored in cmdLine separated by spaces. Special characters * in individual arguments from argv[] must be quoted when being stored in * cmdLine. * * When calling any application, bear in mind that arguments that specify * a path name are not converted. If an argument contains forward slashes * as path separators, it may or may not be recognized as a path name, * depending on the program. In general, most applications accept forward * slashes only as option delimiters and backslashes only as paths. * * Additionally, when calling a 16-bit dos or windows application, all * path names must use the short, cryptic, path format (e.g., using * ab~1.def instead of "a b.default"). */ BuildCommandLine(execPath, argc, argv, &cmdLine); if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", argv[0], Tcl_PosixError(interp))); goto end; } /* * This wait is used to force the OS to give some time to the DOS process. */ if (applType == APPL_DOS) { WaitForSingleObject(procInfo.hProcess, 50); } /* * "When an application spawns a process repeatedly, a new thread instance * will be created for each process but the previous instances may not be * cleaned up. This results in a significant virtual memory loss each time * the process is spawned. If there is a WaitForInputIdle() call between * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID * Number: Q124121 */ WaitForInputIdle(procInfo.hProcess, 5000); CloseHandle(procInfo.hThread); *pidPtr = (Tcl_Pid) procInfo.hProcess; if (*pidPtr != 0) { TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } result = TCL_OK; end: Tcl_DStringFree(&cmdLine); if (startInfo.hStdInput != INVALID_HANDLE_VALUE) { CloseHandle(startInfo.hStdInput); } if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) { CloseHandle(startInfo.hStdOutput); } if (startInfo.hStdError != INVALID_HANDLE_VALUE) { CloseHandle(startInfo.hStdError); } return result; } /* *---------------------------------------------------------------------- * * HasConsole -- * * Determines whether the current application is attached to a console. * * Results: * Returns TRUE if this application has a console, else FALSE. * * Side effects: * None. * *---------------------------------------------------------------------- */ static BOOL HasConsole(void) { HANDLE handle; handle = CreateFileW(L"CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (handle != INVALID_HANDLE_VALUE) { CloseHandle(handle); return TRUE; } else { return FALSE; } } /* *-------------------------------------------------------------------- * * ApplicationType -- * * Search for the specified program and identify if it refers to a DOS, * Windows 3.X, or Win32 program. Used to determine how to invoke a * program, or if it can even be invoked. * * It is possible to almost positively identify DOS and Windows * applications that contain the appropriate magic numbers. However, DOS * .com files do not seem to contain a magic number; if the program name * ends with .com and could not be identified as a Windows .com file, it * will be assumed to be a DOS application, even if it was just random * data. If the program name does not end with .com, no such assumption * is made. * * The Win32 function GetBinaryType incorrectly identifies any junk file * that ends with .exe as a dos executable and some executables that * don't end with .exe as not executable. Plus it doesn't exist under * win95, so I won't feel bad about reimplementing functionality. * * Results: * The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32 if the * filename referred to the corresponding application type. If the file * name could not be found or did not refer to any known application * type, APPL_NONE is returned and an error message is left in interp. * .bat files are identified as APPL_DOS. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ApplicationType( Tcl_Interp *interp, /* Interp, for error message. */ const char *originalName, /* Name of the application to find. */ char fullName[]) /* Filled with complete path to * application. */ { int applType, i, nameLen, found; HANDLE hFile; WCHAR *rest; char *ext; char buf[2]; DWORD attr, read; IMAGE_DOS_HEADER header; Tcl_DString nameBuf, ds; const WCHAR *nativeName; WCHAR nativeFullPath[MAX_PATH]; static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"}; /* * Look for the program as an external program. First try the name as it * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name, * looking for an executable. * * Using the raw SearchPathW() function doesn't do quite what is necessary. * If the name of the executable already contains a '.' character, it will * not try appending the specified extension when searching (in other * words, SearchPathW will not find the program "a.b.exe" if the arguments * specified "a.b" and ".exe"). So, first look for the file as it is * named. Then manually append the extensions, looking for a match. */ applType = APPL_NONE; Tcl_DStringInit(&nameBuf); Tcl_DStringAppend(&nameBuf, originalName, -1); nameLen = Tcl_DStringLength(&nameBuf); for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { Tcl_DStringSetLength(&nameBuf, nameLen); Tcl_DStringAppend(&nameBuf, extensions[i], -1); nativeName = (WCHAR *)Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); found = SearchPathW(NULL, nativeName, NULL, MAX_PATH, nativeFullPath, &rest); Tcl_DStringFree(&ds); if (found == 0) { continue; } /* * Ignore matches on directories or data files, return if identified a * known type. */ attr = GetFileAttributesW(nativeFullPath); if ((attr == 0xFFFFFFFF) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { continue; } strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *)nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); if ((ext != NULL) && (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) { applType = APPL_DOS; break; } hFile = CreateFileW(nativeFullPath, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) { continue; } header.e_magic = 0; ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL); if (header.e_magic != IMAGE_DOS_SIGNATURE) { /* * Doesn't have the magic number for relocatable executables. If * filename ends with .com, assume it's a DOS application anyhow. * Note that we didn't make this assumption at first, because some * supposed .com files are really 32-bit executables with all the * magic numbers and everything. */ CloseHandle(hFile); if ((ext != NULL) && (strcasecmp(ext, ".com") == 0)) { applType = APPL_DOS; break; } continue; } if (header.e_lfarlc != sizeof(header)) { /* * All Windows 3.X and Win32 and some DOS programs have this value * set here. If it doesn't, assume that since it already had the * other magic number it was a DOS application. */ CloseHandle(hFile); applType = APPL_DOS; break; } /* * The DWORD at header.e_lfanew points to yet another magic number. */ buf[0] = '\0'; SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN); ReadFile(hFile, (void *) buf, 2, &read, NULL); CloseHandle(hFile); if ((buf[0] == 'N') && (buf[1] == 'E')) { applType = APPL_WIN3X; } else if ((buf[0] == 'P') && (buf[1] == 'E')) { applType = APPL_WIN32; } else { /* * Strictly speaking, there should be a test that there is an 'L' * and 'E' at buf[0..1], to identify the type as DOS, but of * course we ran into a DOS executable that _doesn't_ have the * magic number - specifically, one compiled using the Lahey * Fortran90 compiler. */ applType = APPL_DOS; } break; } Tcl_DStringFree(&nameBuf); if (applType == APPL_NONE) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", originalName, Tcl_PosixError(interp))); return APPL_NONE; } if (applType == APPL_WIN3X) { /* * Replace long path name of executable with short path name for * 16-bit applications. Otherwise the application may not be able to * correctly parse its own command line to separate off the * application name from the arguments. */ GetShortPathNameW(nativeFullPath, nativeFullPath, MAX_PATH); strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *)nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); } return applType; } /* *---------------------------------------------------------------------- * * BuildCommandLine -- * * The command line arguments are stored in linePtr separated by spaces, * in a form that CreateProcess() understands. Special characters in * individual arguments from argv[] must be quoted when being stored in * cmdLine. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static const char * BuildCmdLineBypassBS( const char *current, const char **bspos) { /* * Mark first backslash position. */ if (!*bspos) { *bspos = current; } do { current++; } while (*current == '\\'); return current; } static void QuoteCmdLineBackslash( Tcl_DString *dsPtr, const char *start, const char *current, const char *bspos) { if (!bspos) { if (current > start) { /* part before current (special) */ Tcl_DStringAppend(dsPtr, start, (int) (current - start)); } } else { if (bspos > start) { /* part before first backslash */ Tcl_DStringAppend(dsPtr, start, (int) (bspos - start)); } while (bspos++ < current) { /* each backslash twice */ TclDStringAppendLiteral(dsPtr, "\\\\"); } } } static const char * QuoteCmdLinePart( Tcl_DString *dsPtr, const char *start, const char *special, const char *specMetaChars, const char **bspos) { if (!*bspos) { /* * Rest before special (before quote). */ QuoteCmdLineBackslash(dsPtr, start, special, NULL); start = special; } else { /* * Rest before first backslash and backslashes into new quoted block. */ QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); start = *bspos; } /* * escape all special chars enclosed in quotes like `"..."`, note that * here we don't must escape `\` (with `\`), because it's outside of the * main quotes, so `\` remains `\`, but important - not at end of part, * because results as before the quote, so `%\%\` should be escaped as * `"%\%"\\`). */ TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */ do { *bspos = NULL; special++; if (*special == '\\') { /* * Bypass backslashes (and mark first backslash position). */ special = BuildCmdLineBypassBS(special, bspos); if (*special == '\0') { break; } } } while (*special && strchr(specMetaChars, *special)); if (!*bspos) { /* * Unescaped rest before quote. */ QuoteCmdLineBackslash(dsPtr, start, special, NULL); } else { /* * Unescaped rest before first backslash (rather belongs to the main * block). */ QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); } TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */ return special; } static void BuildCommandLine( const char *executable, /* Full path of executable (including * extension). Replacement for argv[0]. */ int argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (WCHAR). */ { const char *arg, *start, *special, *bspos; int quote = 0, i; Tcl_DString ds; #ifdef TCL_WIN_PIPE_FULLESC /* full escape inclusive %-subst avoidance */ static const char specMetaChars[] = "&|^<>!()%"; /* Characters to enclose in quotes if unpaired * quote flag set. */ static const char specMetaChars2[] = "%"; /* Character to enclose in quotes in any case * (regardless of unpaired-flag). */ #else /* escape considering quotation only (no %-subst avoidance) */ static const char specMetaChars[] = "&|^<>!()"; /* Characters to enclose in quotes if unpaired * quote flag set. */ #endif /* * Quote flags: * CL_ESCAPE - escape argument; * CL_QUOTE - enclose in quotes; * CL_UNPAIRED - previous arguments chain contains unpaired quote-char; */ enum {CL_ESCAPE = 1, CL_QUOTE = 2, CL_UNPAIRED = 4}; Tcl_DStringInit(&ds); /* * Prime the path. Add a space separator if we were primed with something. */ TclDStringAppendDString(&ds, linePtr); if (Tcl_DStringLength(linePtr) > 0) { TclDStringAppendLiteral(&ds, " "); } for (i = 0; i < argc; i++) { if (i == 0) { arg = executable; } else { arg = argv[i]; TclDStringAppendLiteral(&ds, " "); } quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */ bspos = NULL; if (arg[0] == '\0') { quote = CL_QUOTE; } else { for (start = arg; *start != '\0' && (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE); start++) { if (*start & 0x80) { continue; } if (TclIsSpaceProc(*start)) { quote |= CL_QUOTE; /* quote only */ if (bspos) { /* if backslash found, escape & quote */ quote |= CL_ESCAPE; break; } continue; } if (strchr(specMetaChars, *start)) { quote |= (CL_ESCAPE|CL_QUOTE); /* escape & quote */ break; } if (*start == '"') { quote |= CL_ESCAPE; /* escape only */ continue; } if (*start == '\\') { bspos = start; if (quote & CL_QUOTE) { /* if quote, escape & quote */ quote |= CL_ESCAPE; break; } continue; } } bspos = NULL; } if (quote & CL_QUOTE) { /* * Start of argument (main opening quote-char). */ TclDStringAppendLiteral(&ds, "\""); } if (!(quote & CL_ESCAPE)) { /* * Nothing to escape. */ Tcl_DStringAppend(&ds, arg, -1); } else { start = arg; for (special = arg; *special != '\0'; ) { /* * Position of `\` is important before quote or at end (equal * `\"` because quoted). */ if (*special == '\\') { /* * Bypass backslashes (and mark first backslash position) */ special = BuildCmdLineBypassBS(special, &bspos); if (*special == '\0') { break; } } /* ["] */ if (*special == '"') { /* * Invert the unpaired flag - observe unpaired quotes */ quote ^= CL_UNPAIRED; /* * Add part before (and escape backslashes before quote). */ QuoteCmdLineBackslash(&ds, start, special, bspos); bspos = NULL; /* * Escape using backslash */ TclDStringAppendLiteral(&ds, "\\\""); start = ++special; continue; } /* * Unpaired (escaped) quote causes special handling on * meta-chars */ if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) { special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos); /* * Start to current or first backslash */ start = !bspos ? special : bspos; continue; } #ifdef TCL_WIN_PIPE_FULLESC /* * Special case for % - should be enclosed always (paired * also) */ if (strchr(specMetaChars2, *special)) { special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos); /* * Start to current or first backslash. */ start = !bspos ? special : bspos; continue; } #endif /* * Other not special (and not meta) character */ bspos = NULL; /* reset last backslash position (not * interesting) */ special++; } /* * Rest of argument (and escape backslashes before closing main * quote) */ QuoteCmdLineBackslash(&ds, start, special, (quote & CL_QUOTE) ? bspos : NULL); } if (quote & CL_QUOTE) { /* * End of argument (main closing quote-char) */ TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); Tcl_DStringFree(&ds); } /* *---------------------------------------------------------------------- * * TclpCreateCommandChannel -- * * This function is called by Tcl_OpenCommandChannel to perform the * platform specific channel initialization for a command channel. * * Results: * Returns a new channel or NULL on failure. * * Side effects: * Allocates a new channel. * *---------------------------------------------------------------------- */ Tcl_Channel TclpCreateCommandChannel( TclFile readFile, /* If non-null, gives the file for reading. */ TclFile writeFile, /* If non-null, gives the file for writing. */ TclFile errorFile, /* If non-null, gives the file where errors * can be read. */ int numPids, /* The number of pids in the pid array. */ Tcl_Pid *pidPtr) /* An array of process identifiers. */ { char channelName[16 + TCL_INTEGER_SPACE]; PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo)); PipeInit(); infoPtr->watchMask = 0; infoPtr->flags = 0; infoPtr->readFlags = 0; infoPtr->readFile = readFile; infoPtr->writeFile = writeFile; infoPtr->errorFile = errorFile; infoPtr->numPids = numPids; infoPtr->pidPtr = pidPtr; infoPtr->writeBuf = 0; infoPtr->writeBufLen = 0; infoPtr->writeError = 0; infoPtr->channel = NULL; infoPtr->validMask = 0; infoPtr->threadId = Tcl_GetCurrentThread(); if (readFile != NULL) { /* * Start the background reader thread. */ infoPtr->readable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread, TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable), 0, NULL); SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_READABLE; } else { infoPtr->readTI = NULL; infoPtr->readThread = 0; } if (writeFile != NULL) { /* * Start the background writer thread. */ infoPtr->writable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread, TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable), 0, NULL); SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_WRITABLE; } else { infoPtr->writeTI = NULL; infoPtr->writeThread = 0; } /* * For backward compatibility with previous versions of Tcl, we use * "file%d" as the base name for pipes even though it would be more * natural to use "pipe%d". Use the pointer to keep the channel names * unique, in case channels share handles (stdin/stdout). */ snprintf(channelName, sizeof(channelName), "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, infoPtr, infoPtr->validMask); /* * Pipes have AUTO translation mode on Windows and ^Z eof char, which * means that a ^Z will be appended to them at close. This is needed for * Windows programs that expect a ^Z at EOF. */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } /* *---------------------------------------------------------------------- * * Tcl_CreatePipe -- * * System dependent interface to create a pipe for the [chan pipe] * command. Stolen from TclX. * * Results: * TCL_OK or TCL_ERROR. * *---------------------------------------------------------------------- */ int Tcl_CreatePipe( Tcl_Interp *interp, /* Errors returned in result.*/ Tcl_Channel *rchan, /* Where to return the read side. */ Tcl_Channel *wchan, /* Where to return the write side. */ int flags) /* Reserved for future use. */ { HANDLE readHandle, writeHandle; SECURITY_ATTRIBUTES sec; sec.nLength = sizeof(SECURITY_ATTRIBUTES); sec.lpSecurityDescriptor = NULL; sec.bInheritHandle = FALSE; if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "pipe creation failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } *rchan = Tcl_MakeFileChannel((ClientData) readHandle, TCL_READABLE); Tcl_RegisterChannel(interp, *rchan); *wchan = Tcl_MakeFileChannel((ClientData) writeHandle, TCL_WRITABLE); Tcl_RegisterChannel(interp, *wchan); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclGetAndDetachPids -- * * Stores a list of the command PIDs for a command channel in the * interp's result. * * Results: * None. * * Side effects: * Modifies the interp's result. * *---------------------------------------------------------------------- */ void TclGetAndDetachPids( Tcl_Interp *interp, Tcl_Channel chan) { PipeInfo *pipePtr; const Tcl_ChannelType *chanTypePtr; Tcl_Obj *pidsObj; int i; /* * Punt if the channel is not a command channel. */ chanTypePtr = Tcl_GetChannelType(chan); if (chanTypePtr != &pipeChannelType) { return; } pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan); TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewWideIntObj((unsigned) TclpGetPid(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; } } /* *---------------------------------------------------------------------- * * PipeBlockModeProc -- * * Set blocking or non-blocking mode on channel. * * Results: * 0 if successful, errno when failed. * * Side effects: * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ static int PipeBlockModeProc( ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; /* * Pipes on Windows can not be switched between blocking and nonblocking, * hence we have to emulate the behavior. This is done in the input * function by checking against a bit in the state. We set or unset the * bit here to cause the input function to emulate the correct behavior. */ if (mode == TCL_MODE_NONBLOCKING) { infoPtr->flags |= PIPE_ASYNC; } else { infoPtr->flags &= ~(PIPE_ASYNC); } return 0; } /* *---------------------------------------------------------------------- * * PipeClose2Proc -- * * Closes a pipe based IO channel. * * Results: * 0 on success, errno otherwise. * * Side effects: * Closes the physical channel. * *---------------------------------------------------------------------- */ static int PipeClose2Proc( ClientData instanceData, /* Pointer to PipeInfo structure. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { PipeInfo *pipePtr = (PipeInfo *) instanceData; Tcl_Channel errChan; int errorCode, result; PipeInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int inExit = (TclInExit() || TclInThreadExit()); errorCode = 0; result = 0; if ((!flags || flags & TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) { /* * Clean up the background thread if necessary. Note that this must be * done before we can close the file, since the thread may be blocking * trying to read from the pipe. */ if (pipePtr->readThread) { TclPipeThreadStop(&pipePtr->readTI, pipePtr->readThread); CloseHandle(pipePtr->readThread); CloseHandle(pipePtr->readable); pipePtr->readThread = NULL; } if (TclpCloseFile(pipePtr->readFile) != 0) { errorCode = errno; } pipePtr->validMask &= ~TCL_READABLE; pipePtr->readFile = NULL; } if ((!flags || flags & TCL_CLOSE_WRITE) && (pipePtr->writeFile != NULL)) { if (pipePtr->writeThread) { /* * Wait for the writer thread to finish the current buffer, then * terminate the thread and close the handles. If the channel is * nonblocking or may block during exit, bail out since the worker * thread is not interruptible and we want TIP#398-fast-exit. */ if ((pipePtr->flags & PIPE_ASYNC) && inExit) { /* give it a chance to leave honorably */ TclPipeThreadStopSignal(&pipePtr->writeTI, pipePtr->writable); if (WaitForSingleObject(pipePtr->writable, 20) == WAIT_TIMEOUT) { return EWOULDBLOCK; } } else { WaitForSingleObject(pipePtr->writable, inExit ? 5000 : INFINITE); } TclPipeThreadStop(&pipePtr->writeTI, pipePtr->writeThread); CloseHandle(pipePtr->writable); CloseHandle(pipePtr->writeThread); pipePtr->writeThread = NULL; } if (TclpCloseFile(pipePtr->writeFile) != 0) { if (errorCode == 0) { errorCode = errno; } } pipePtr->validMask &= ~TCL_WRITABLE; pipePtr->writeFile = NULL; } pipePtr->watchMask &= pipePtr->validMask; /* * Don't free the channel if any of the flags were set. */ if (flags) { return errorCode; } /* * Remove the file from the list of watched files. */ for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr; infoPtr != NULL; nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { if (infoPtr == (PipeInfo *)pipePtr) { *nextPtrPtr = infoPtr->nextPtr; break; } } if ((pipePtr->flags & PIPE_ASYNC) || inExit) { /* * If the channel is non-blocking or Tcl is being cleaned up, just * detach the children PIDs, reap them (important if we are in a * dynamic load module), and discard the errorFile. */ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr); Tcl_ReapDetachedProcs(); if (pipePtr->errorFile) { if (TclpCloseFile(pipePtr->errorFile) != 0) { if (errorCode == 0) { errorCode = errno; } } } result = 0; } else { /* * Wrap the error file into a channel and give it to the cleanup * routine. */ if (pipePtr->errorFile) { WinFile *filePtr = (WinFile *) pipePtr->errorFile; errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, TCL_READABLE); ckfree(filePtr); } else { errChan = NULL; } result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr, errChan); } if (pipePtr->numPids > 0) { ckfree(pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { ckfree(pipePtr->writeBuf); } ckfree(pipePtr); if (errorCode == 0) { return result; } return errorCode; } /* *---------------------------------------------------------------------- * * PipeInputProc -- * * Reads input from the IO channel into the buffer given. Returns count * of how many bytes were actually read, and an error indication. * * Results: * A count of how many bytes were read is returned and an error * indication is returned in an output argument. * * Side effects: * Reads input from the actual channel. * *---------------------------------------------------------------------- */ static int PipeInputProc( ClientData instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr = (WinFile*) infoPtr->readFile; DWORD count, bytesRead = 0; int result; *errorCode = 0; /* * Synchronize with the reader thread. */ result = WaitForRead(infoPtr, (infoPtr->flags & PIPE_ASYNC) ? 0 : 1); /* * If an error occurred, return immediately. */ if (result == -1) { *errorCode = errno; return -1; } if (infoPtr->readFlags & PIPE_EXTRABYTE) { /* * The reader thread consumed 1 byte as a side effect of waiting so we * need to move it into the buffer. */ *buf = infoPtr->extraByte; infoPtr->readFlags &= ~PIPE_EXTRABYTE; buf++; bufSize--; bytesRead = 1; /* * If further read attempts would block, return what we have. */ if (result == 0) { return bytesRead; } } /* * Attempt to read bufSize bytes. The read will return immediately if * there is any data available. Otherwise it will block until at least one * byte is available or an EOF occurs. */ if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &count, (LPOVERLAPPED) NULL) == TRUE) { return bytesRead + count; } else if (bytesRead) { /* * Ignore errors if we have data to return. */ return bytesRead; } TclWinConvertError(GetLastError()); if (errno == EPIPE) { infoPtr->readFlags |= PIPE_EOF; return 0; } *errorCode = errno; return -1; } /* *---------------------------------------------------------------------- * * PipeOutputProc -- * * Writes the given output on the IO channel. Returns count of how many * characters were actually written, and an error indication. * * Results: * A count of how many characters were written is returned and an error * indication is returned in an output argument. * * Side effects: * Writes output on the actual channel. * *---------------------------------------------------------------------- */ static int PipeOutputProc( ClientData instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr = (WinFile*) infoPtr->writeFile; DWORD bytesWritten, timeout; *errorCode = 0; /* avoid blocking if pipe-thread exited */ timeout = ((infoPtr->flags & PIPE_ASYNC) || !TclPipeThreadIsAlive(&infoPtr->writeTI) || TclInExit() || TclInThreadExit()) ? 0 : INFINITE; if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) { /* * The writer thread is blocked waiting for a write to complete and * the channel is in non-blocking mode. */ errno = EWOULDBLOCK; goto error; } /* * Check for a background error on the last write. */ if (infoPtr->writeError) { TclWinConvertError(infoPtr->writeError); infoPtr->writeError = 0; goto error; } if (infoPtr->flags & PIPE_ASYNC) { /* * The pipe is non-blocking, so copy the data into the output buffer * and restart the writer thread. */ if (toWrite > infoPtr->writeBufLen) { /* * Reallocate the buffer to be large enough to hold the data. */ if (infoPtr->writeBuf) { ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->writable); TclPipeThreadSignal(&infoPtr->writeTI); bytesWritten = toWrite; } else { /* * In the blocking case, just try to write the buffer directly. This * avoids an unnecessary copy. */ if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) { TclWinConvertError(GetLastError()); goto error; } } return bytesWritten; error: *errorCode = errno; return -1; } /* *---------------------------------------------------------------------- * * PipeEventProc -- * * This function is invoked by Tcl_ServiceEvent when a file event reaches * the front of the event queue. This function invokes Tcl_NotifyChannel * on the pipe. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the notifier callback does. * *---------------------------------------------------------------------- */ static int PipeEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to * handle, such as TCL_FILE_EVENTS. */ { PipeEvent *pipeEvPtr = (PipeEvent *)evPtr; PipeInfo *infoPtr; int mask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return 0; } /* * Search through the list of watched pipes for the one whose handle * matches the event. We do this rather than simply dereferencing the * handle in the event so that pipes can be deleted while the event is in * the queue. */ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (pipeEvPtr->infoPtr == infoPtr) { infoPtr->flags &= ~(PIPE_PENDING); break; } } /* * Remove stale events. */ if (!infoPtr) { return 1; } /* * Check to see if the pipe is readable. Note that we can't tell if a pipe * is writable, so we always report it as being writable unless we have * detected EOF. */ mask = 0; if ((infoPtr->watchMask & TCL_WRITABLE) && (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) { mask = TCL_WRITABLE; } if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) { if (infoPtr->readFlags & PIPE_EOF) { mask = TCL_READABLE; } else { mask |= TCL_READABLE; } } /* * Inform the channel of the events. */ Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask); return 1; } /* *---------------------------------------------------------------------- * * PipeWatchProc -- * * Called by the notifier to set up to watch for events on this channel. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PipeWatchProc( ClientData instanceData, /* Pipe state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { PipeInfo **nextPtrPtr, *ptr; PipeInfo *infoPtr = (PipeInfo *) instanceData; int oldMask = infoPtr->watchMask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Since most of the work is handled by the background threads, we just * need to update the watchMask and then force the notifier to poll once. */ infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; if (!oldMask) { infoPtr->nextPtr = tsdPtr->firstPipePtr; tsdPtr->firstPipePtr = infoPtr; } Tcl_SetMaxBlockTime(&blockTime); } else { if (oldMask) { /* * Remove the pipe from the list of watched pipes. */ for (nextPtrPtr = &(tsdPtr->firstPipePtr), ptr = *nextPtrPtr; ptr != NULL; nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { if (infoPtr == ptr) { *nextPtrPtr = ptr->nextPtr; break; } } } } } /* *---------------------------------------------------------------------- * * PipeGetHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a * command pipeline based channel. * * Results: * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no * handle for the specified direction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int PipeGetHandleProc( ClientData instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr; if (direction == TCL_READABLE && infoPtr->readFile) { filePtr = (WinFile*) infoPtr->readFile; *handlePtr = (ClientData) filePtr->handle; return TCL_OK; } if (direction == TCL_WRITABLE && infoPtr->writeFile) { filePtr = (WinFile*) infoPtr->writeFile; *handlePtr = (ClientData) filePtr->handle; return TCL_OK; } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_WaitPid -- * * Emulates the waitpid system call. * * Results: * Returns 0 if the process is still alive, -1 on an error, or the pid on * a clean close. * * Side effects: * Unless WNOHANG is set and the wait times out, the process information * record will be deleted and the process handle will be closed. * *---------------------------------------------------------------------- */ Tcl_Pid Tcl_WaitPid( Tcl_Pid pid, int *statPtr, int options) { ProcInfo *infoPtr = NULL, **prevPtrPtr; DWORD flags; Tcl_Pid result; DWORD ret, exitCode; PipeInit(); /* * If no pid is specified, do nothing. */ if (pid == 0) { *statPtr = 0; return 0; } /* * Find the process and cut it from the process list. */ Tcl_MutexLock(&pipeMutex); prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { if (infoPtr->hProcess == (HANDLE) pid) { *prevPtrPtr = infoPtr->nextPtr; break; } } Tcl_MutexUnlock(&pipeMutex); /* * If the pid is not one of the processes we know about (we started it) * then do nothing. */ if (infoPtr == NULL) { *statPtr = 0; return 0; } /* * Officially "wait" for it to finish. We either poll (WNOHANG) or wait * for an infinite amount of time. */ if (options & WNOHANG) { flags = 0; } else { flags = INFINITE; } ret = WaitForSingleObject(infoPtr->hProcess, flags); if (ret == WAIT_TIMEOUT) { *statPtr = 0; if (options & WNOHANG) { /* * Re-insert this infoPtr back on the list. */ Tcl_MutexLock(&pipeMutex); infoPtr->nextPtr = procList; procList = infoPtr; Tcl_MutexUnlock(&pipeMutex); return 0; } else { result = 0; } } else if (ret == WAIT_OBJECT_0) { GetExitCodeProcess(infoPtr->hProcess, &exitCode); /* * Does the exit code look like one of the exception codes? */ switch (exitCode) { case EXCEPTION_FLT_DENORMAL_OPERAND: case EXCEPTION_FLT_DIVIDE_BY_ZERO: case EXCEPTION_FLT_INEXACT_RESULT: case EXCEPTION_FLT_INVALID_OPERATION: case EXCEPTION_FLT_OVERFLOW: case EXCEPTION_FLT_STACK_CHECK: case EXCEPTION_FLT_UNDERFLOW: case EXCEPTION_INT_DIVIDE_BY_ZERO: case EXCEPTION_INT_OVERFLOW: *statPtr = 0xC0000000 | SIGFPE; break; case EXCEPTION_PRIV_INSTRUCTION: case EXCEPTION_ILLEGAL_INSTRUCTION: *statPtr = 0xC0000000 | SIGILL; break; case EXCEPTION_ACCESS_VIOLATION: case EXCEPTION_ARRAY_BOUNDS_EXCEEDED: case EXCEPTION_STACK_OVERFLOW: case EXCEPTION_NONCONTINUABLE_EXCEPTION: case EXCEPTION_INVALID_DISPOSITION: case EXCEPTION_GUARD_PAGE: case EXCEPTION_INVALID_HANDLE: *statPtr = 0xC0000000 | SIGSEGV; break; case EXCEPTION_DATATYPE_MISALIGNMENT: *statPtr = 0xC0000000 | SIGBUS; break; case EXCEPTION_BREAKPOINT: case EXCEPTION_SINGLE_STEP: *statPtr = 0xC0000000 | SIGTRAP; break; case CONTROL_C_EXIT: *statPtr = 0xC0000000 | SIGINT; break; default: /* * Non-exceptional, normal, exit code. Note that the exit code is * truncated to a signed short range [-32768,32768) whether it * fits into this range or not. * * BUG: Even though the exit code is a DWORD, it is understood by * convention to be a signed integer, yet there isn't enough room * to fit this into the POSIX style waitstatus mask without * truncating it. */ *statPtr = exitCode; break; } result = pid; } else { errno = ECHILD; *statPtr = 0xC0000000 | ECHILD; result = (Tcl_Pid) -1; } /* * Officially close the process handle. */ CloseHandle(infoPtr->hProcess); ckfree(infoPtr); return result; } /* *---------------------------------------------------------------------- * * TclWinAddProcess -- * * Add a process to the process list so that we can use Tcl_WaitPid on * the process. * * Results: * None * * Side effects: * Adds the specified process handle to the process list so Tcl_WaitPid * knows about it. * *---------------------------------------------------------------------- */ void TclWinAddProcess( void *hProcess, /* Handle to process */ unsigned long id) /* Global process identifier */ { ProcInfo *procPtr = (ProcInfo *)ckalloc(sizeof(ProcInfo)); PipeInit(); procPtr->hProcess = hProcess; procPtr->dwProcessId = id; Tcl_MutexLock(&pipeMutex); procPtr->nextPtr = procList; procList = procPtr; Tcl_MutexUnlock(&pipeMutex); } /* *---------------------------------------------------------------------- * * Tcl_PidObjCmd -- * * This function is invoked to process the "pid" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_PidObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Channel chan; const Tcl_ChannelType *chanTypePtr; PipeInfo *pipePtr; int i; Tcl_Obj *resultPtr; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); return TCL_ERROR; } if (objc == 1) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); } else { chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } chanTypePtr = Tcl_GetChannelType(chan); if (chanTypePtr != &pipeChannelType) { return TCL_OK; } pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); TclNewObj(resultPtr); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, Tcl_NewWideIntObj((unsigned) TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * WaitForRead -- * * Wait until some data is available, the pipe is at EOF or the reader * thread is blocked waiting for data (if the channel is in non-blocking * mode). * * Results: * Returns 1 if pipe is readable. Returns 0 if there is no data on the * pipe, but there is buffered data. Returns -1 if an error occurred. If * an error occurred, the threads may not be synchronized. * * Side effects: * Updates the shared state flags and may consume 1 byte of data from the * pipe. If no error occurred, the reader thread is blocked waiting for a * signal from the main thread. * *---------------------------------------------------------------------- */ static int WaitForRead( PipeInfo *infoPtr, /* Pipe state. */ int blocking) /* Indicates whether call should be blocking * or not. */ { DWORD timeout, count; HANDLE handle = ((WinFile *) infoPtr->readFile)->handle; while (1) { /* * Synchronize with the reader thread. */ /* avoid blocking if pipe-thread exited */ timeout = (!blocking || !TclPipeThreadIsAlive(&infoPtr->readTI) || TclInExit() || TclInThreadExit()) ? 0 : INFINITE; if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) { /* * The reader thread is blocked waiting for data and the channel * is in non-blocking mode. */ errno = EWOULDBLOCK; return -1; } /* * At this point, the two threads are synchronized, so it is safe to * access shared state. */ /* * If the pipe has hit EOF, it is always readable. */ if (infoPtr->readFlags & PIPE_EOF) { return 1; } /* * Check to see if there is any data sitting in the pipe. */ if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0, (LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) { TclWinConvertError(GetLastError()); /* * Check to see if the peek failed because of EOF. */ if (errno == EPIPE) { infoPtr->readFlags |= PIPE_EOF; return 1; } /* * Ignore errors if there is data in the buffer. */ if (infoPtr->readFlags & PIPE_EXTRABYTE) { return 0; } else { return -1; } } /* * We found some data in the pipe, so it must be readable. */ if (count > 0) { return 1; } /* * The pipe isn't readable, but there is some data sitting in the * buffer, so return immediately. */ if (infoPtr->readFlags & PIPE_EXTRABYTE) { return 0; } /* * There wasn't any data available, so reset the thread and try again. */ ResetEvent(infoPtr->readable); TclPipeThreadSignal(&infoPtr->readTI); } } /* *---------------------------------------------------------------------- * * PipeReaderThread -- * * This function runs in a separate thread and waits for input to become * available on a pipe. * * Results: * None. * * Side effects: * Signals the main thread when input become available. May cause the * main thread to wake up by posting a message. May consume one byte from * the pipe for each wait operation. Will cause a memory leak of ~4k, if * forcefully terminated with TerminateThread(). * *---------------------------------------------------------------------- */ static DWORD WINAPI PipeReaderThread( LPVOID arg) { TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *) arg; PipeInfo *infoPtr = NULL; /* access info only after success init/wait */ HANDLE handle = NULL; DWORD count, err; int done = 0; while (!done) { /* * Wait for the main thread to signal before attempting to wait on the * pipe becoming readable. */ if (!TclPipeThreadWaitForSignal(&pipeTI)) { /* exit */ break; } if (!infoPtr) { infoPtr = (PipeInfo *) pipeTI->clientData; handle = ((WinFile *) infoPtr->readFile)->handle; } /* * Try waiting for 0 bytes. This will block until some data is * available on NT, but will return immediately on Win 95. So, if no * data is available after the first read, we block until we can read * a single byte off of the pipe. */ if (ReadFile(handle, NULL, 0, &count, NULL) == FALSE || PeekNamedPipe(handle, NULL, 0, NULL, &count, NULL) == FALSE) { /* * The error is a result of an EOF condition, so set the EOF bit * before signalling the main thread. */ err = GetLastError(); if (err == ERROR_BROKEN_PIPE) { infoPtr->readFlags |= PIPE_EOF; done = 1; } else if (err == ERROR_INVALID_HANDLE) { done = 1; } } else if (count == 0) { if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL) != FALSE) { /* * One byte was consumed as a side effect of waiting for the * pipe to become readable. */ infoPtr->readFlags |= PIPE_EXTRABYTE; } else { err = GetLastError(); if (err == ERROR_BROKEN_PIPE) { /* * The error is a result of an EOF condition, so set the * EOF bit before signalling the main thread. */ infoPtr->readFlags |= PIPE_EOF; done = 1; } else if (err == ERROR_INVALID_HANDLE) { done = 1; } } } /* * Signal the main thread by signalling the readable event and then * waking up the notifier thread. */ SetEvent(infoPtr->readable); /* * Alert the foreground thread. Note that we need to treat this like a * critical section so the foreground thread does not terminate this * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&pipeMutex); if (infoPtr->threadId != NULL) { /* * TIP #218. When in flight ignore the event, no one will receive * it anyway. */ Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&pipeMutex); } /* * If state of thread was set to stop, we can sane free info structure, * otherwise it is shared with main thread, so main thread will own it */ TclPipeThreadExit(&pipeTI); return 0; } /* *---------------------------------------------------------------------- * * PipeWriterThread -- * * This function runs in a separate thread and writes data onto a pipe. * * Results: * Always returns 0. * * Side effects: * Signals the main thread when an output operation is completed. May * cause the main thread to wake up by posting a message. * *---------------------------------------------------------------------- */ static DWORD WINAPI PipeWriterThread( LPVOID arg) { TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg; PipeInfo *infoPtr = NULL; /* access info only after success init/wait */ HANDLE handle = NULL; DWORD count, toWrite; char *buf; int done = 0; while (!done) { /* * Wait for the main thread to signal before attempting to write. */ if (!TclPipeThreadWaitForSignal(&pipeTI)) { /* exit */ break; } if (!infoPtr) { infoPtr = (PipeInfo *)pipeTI->clientData; handle = ((WinFile *) infoPtr->writeFile)->handle; } buf = infoPtr->writeBuf; toWrite = infoPtr->toWrite; /* * Loop until all of the bytes are written or an error occurs. */ while (toWrite > 0) { if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) { infoPtr->writeError = GetLastError(); done = 1; break; } else { toWrite -= count; buf += count; } } /* * Signal the main thread by signalling the writable event and then * waking up the notifier thread. */ SetEvent(infoPtr->writable); /* * Alert the foreground thread. Note that we need to treat this like a * critical section so the foreground thread does not terminate this * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&pipeMutex); if (infoPtr->threadId != NULL) { /* * TIP #218. When in flight ignore the event, no one will receive * it anyway. */ Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&pipeMutex); } /* * If state of thread was set to stop, we can sane free info structure, * otherwise it is shared with main thread, so main thread will own it. */ TclPipeThreadExit(&pipeTI); return 0; } /* *---------------------------------------------------------------------- * * PipeThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void PipeThreadActionProc( ClientData instanceData, int action) { PipeInfo *infoPtr = (PipeInfo *) instanceData; /* * We do not access firstPipePtr in the thread structures. This is not for * all pipes managed by the thread, but only those we are watching. * Removal of the fileevent handlers before transfer thus takes care of * this structure. */ Tcl_MutexLock(&pipeMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { /* * We can't copy the thread information from the channel when the * channel is created. At this time the channel back pointer has not * been set yet. However in that case the threadId has already been * set by TclpCreateCommandChannel itself, so the structure is still * good. */ PipeInit(); if (infoPtr->channel != NULL) { infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&pipeMutex); } /* *---------------------------------------------------------------------- * * TclpOpenTemporaryFile -- * * Creates a temporary file, possibly based on the supplied bits and * pieces of template supplied in the first three arguments. If the * fourth argument is non-NULL, it contains a Tcl_Obj to store the name * of the temporary file in (and it is caller's responsibility to clean * up). If the fourth argument is NULL, try to arrange for the temporary * file to go away once it is no longer needed. * * Results: * A read-write Tcl Channel open on the file. * *---------------------------------------------------------------------- */ Tcl_Channel TclpOpenTemporaryFile( Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) { WCHAR name[MAX_PATH]; char *namePtr; HANDLE handle; DWORD flags = FILE_ATTRIBUTE_TEMPORARY; int length, counter, counter2; Tcl_DString buf; if (!resultingNameObj) { flags |= FILE_FLAG_DELETE_ON_CLOSE; } namePtr = (char *) name; length = GetTempPathW(MAX_PATH, name); if (length == 0) { goto gotError; } namePtr += length * sizeof(WCHAR); if (basenameObj) { const char *string = Tcl_GetString(basenameObj); Tcl_WinUtfToTChar(string, basenameObj->length, &buf); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); namePtr += Tcl_DStringLength(&buf); Tcl_DStringFree(&buf); } else { const WCHAR *baseStr = L"TCL"; length = 3 * sizeof(WCHAR); memcpy(namePtr, baseStr, length); namePtr += length; } counter = TclpGetClicks() % 65533; counter2 = 1024; /* Only try this many times! Prevents * an infinite loop. */ do { char number[TCL_INTEGER_SPACE + 4]; snprintf(number, sizeof(number), "%d.TMP", counter); counter = (unsigned short) (counter + 1); Tcl_WinUtfToTChar(number, strlen(number), &buf); Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); handle = CreateFileW(name, GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL); } while (handle == INVALID_HANDLE_VALUE && --counter2 > 0 && GetLastError() == ERROR_FILE_EXISTS); if (handle == INVALID_HANDLE_VALUE) { goto gotError; } if (resultingNameObj) { Tcl_Obj *tmpObj = TclpNativeToNormalized(name); Tcl_AppendObjToObj(resultingNameObj, tmpObj); TclDecrRefCount(tmpObj); } return Tcl_MakeFileChannel((ClientData) handle, TCL_READABLE|TCL_WRITABLE); gotError: TclWinConvertError(GetLastError()); return NULL; } /* *---------------------------------------------------------------------- * * TclPipeThreadCreateTI -- * * Creates a thread info structure, can be owned by worker. * * Results: * Pointer to created TI structure. * *---------------------------------------------------------------------- */ TclPipeThreadInfo * TclPipeThreadCreateTI( TclPipeThreadInfo **pipeTIPtr, ClientData clientData, HANDLE wakeEvent) { TclPipeThreadInfo *pipeTI; #ifndef _PTI_USE_CKALLOC pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo)); #else pipeTI = (TclPipeThreadInfo *)ckalloc(sizeof(TclPipeThreadInfo)); #endif /* !_PTI_USE_CKALLOC */ pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL); pipeTI->state = PTI_STATE_IDLE; pipeTI->clientData = clientData; pipeTI->evWakeUp = wakeEvent; return (*pipeTIPtr = pipeTI); } /* *---------------------------------------------------------------------- * * TclPipeThreadWaitForSignal -- * * Wait for work/stop signals inside pipe worker. * * Results: * 1 if signaled to work, 0 if signaled to stop. * * Side effects: * If this function returns 0, TI-structure pointer given via pipeTIPtr * may be NULL, so not accessible (can be owned by main thread). * *---------------------------------------------------------------------- */ int TclPipeThreadWaitForSignal( TclPipeThreadInfo **pipeTIPtr) { TclPipeThreadInfo *pipeTI = *pipeTIPtr; LONG state; DWORD waitResult; HANDLE wakeEvent; if (!pipeTI) { return 0; } wakeEvent = pipeTI->evWakeUp; /* * Wait for the main thread to signal before attempting to do the work. */ /* * Reset work state of thread (idle/waiting) */ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_IDLE, PTI_STATE_WORK); if (state & (PTI_STATE_STOP|PTI_STATE_END)) { /* * End of work, check the owner of structure. */ goto end; } /* * Entering wait */ waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE); if (waitResult != WAIT_OBJECT_0) { /* * The control event was not signaled, so end of work (unexpected * behaviour, main thread can be dead?). */ goto end; } /* * Try to set work state of thread */ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_WORK, PTI_STATE_IDLE); if (state & (PTI_STATE_STOP|PTI_STATE_END)) { /* * End of work */ goto end; } /* * Signaled to work. */ return 1; end: /* * End of work, check the owner of the TI structure. */ if (state != PTI_STATE_STOP) { *pipeTIPtr = NULL; } else { pipeTI->evWakeUp = NULL; } if (wakeEvent) { SetEvent(wakeEvent); } return 0; } /* *---------------------------------------------------------------------- * * TclPipeThreadStopSignal -- * * Send stop signal to the pipe worker (without waiting). * * After calling of this function, TI-structure pointer given via pipeTIPtr * may be NULL. * * Results: * 1 if signaled (or pipe-thread is down), 0 if pipe thread still working. * *---------------------------------------------------------------------- */ int TclPipeThreadStopSignal( TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent) { TclPipeThreadInfo *pipeTI = *pipeTIPtr; HANDLE evControl; int state; if (!pipeTI) { return 1; } evControl = pipeTI->evControl; pipeTI->evWakeUp = wakeEvent; state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP, PTI_STATE_IDLE); switch (state) { case PTI_STATE_IDLE: /* * Thread was idle/waiting, notify it goes teardown */ SetEvent(evControl); *pipeTIPtr = NULL; /* FALLTHRU */ case PTI_STATE_DOWN: return 1; default: /* * Thread works currently, we should try to end it, own the TI * structure (because of possible sharing the joint structures with * thread) */ InterlockedExchange(&pipeTI->state, PTI_STATE_END); break; } return 0; } /* *---------------------------------------------------------------------- * * TclPipeThreadStop -- * * Send stop signal to the pipe worker and wait for thread completion. * * May be combined with TclPipeThreadStopSignal. * * After calling of this function, TI-structure pointer given via pipeTIPtr * is not accessible (owned by pipe worker or released here). * * Results: * None. * * Side effects: * Can terminate pipe worker (and / or stop its synchronous operations). * *---------------------------------------------------------------------- */ void TclPipeThreadStop( TclPipeThreadInfo **pipeTIPtr, HANDLE hThread) { TclPipeThreadInfo *pipeTI = *pipeTIPtr; HANDLE evControl; int state; if (!pipeTI) { return; } pipeTI = *pipeTIPtr; evControl = pipeTI->evControl; pipeTI->evWakeUp = NULL; /* * Try to sane stop the pipe worker, corresponding its current state */ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP, PTI_STATE_IDLE); switch (state) { case PTI_STATE_IDLE: /* * Thread was idle/waiting, notify it goes teardown */ SetEvent(evControl); /* * We don't need to wait for it at all, thread frees himself (owns the * TI structure) */ pipeTI = NULL; break; case PTI_STATE_STOP: /* * Already stopped, thread frees himself (owns the TI structure) */ pipeTI = NULL; break; case PTI_STATE_DOWN: /* * Thread already down (?), do nothing */ /* * We don't need to wait for it, but we should free pipeTI */ hThread = NULL; break; /* case PTI_STATE_WORK: */ default: /* * Thread works currently, we should try to end it, own the TI * structure (because of possible sharing the joint structures with * thread) */ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_END, PTI_STATE_WORK); if (state == PTI_STATE_DOWN) { /* * We don't need to wait for it, but we should free pipeTI */ hThread = NULL; } break; } if (pipeTI && hThread) { DWORD exitCode; /* * The thread may already have closed on its own. Check its exit * code. */ GetExitCodeThread(hThread, &exitCode); if (exitCode == STILL_ACTIVE) { int inExit = (TclInExit() || TclInThreadExit()); /* * Set the stop event so that if the pipe thread is blocked * somewhere, it may hereafter sane exit cleanly. */ SetEvent(evControl); /* * Cancel all sync-IO of this thread (may be blocked there). */ if (tclWinProcs.cancelSynchronousIo) { tclWinProcs.cancelSynchronousIo(hThread); } /* * Wait at most 20 milliseconds for the reader thread to close * (regarding TIP#398-fast-exit). */ /* * If we want TIP#398-fast-exit. */ if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) { /* * The thread must be blocked waiting for the pipe to become * readable in ReadFile(). There isn't a clean way to exit the * thread from this condition. We should terminate the child * process instead to get the reader thread to fall out of * ReadFile with a FALSE. (below) is not the correct way to do * this, but will stay here until a better solution is found. * * Note that we need to guard against terminating the thread * while it is in the middle of Tcl_ThreadAlert because it * won't be able to release the notifier lock. * * Also note that terminating threads during their * initialization or teardown phase may result in ntdll.dll's * LoaderLock to remain locked indefinitely. This causes * ntdll.dll's LdrpInitializeThread() to deadlock trying to * acquire LoaderLock. LdrpInitializeThread() is executed * within new threads to perform initialization and to execute * DllMain() of all loaded dlls. As a result, all new threads * are deadlocked in their initialization phase and never * execute, even though CreateThread() reports successful * thread creation. This results in a very weird process-wide * behavior, which is extremely hard to debug. * * THREADS SHOULD NEVER BE TERMINATED. Period. * * But for now, check if thread is exiting, and if so, let it * die peacefully. * * Also don't terminate if in exit (otherwise deadlocked in * ntdll.dll's). */ if (pipeTI->state != PTI_STATE_DOWN && WaitForSingleObject(hThread, inExit ? 50 : 5000) != WAIT_OBJECT_0) { /* BUG: this leaks memory */ if (inExit || !TerminateThread(hThread, 0)) { /* * in exit or terminate fails, just give thread a * chance to exit */ if (InterlockedExchange(&pipeTI->state, PTI_STATE_STOP) != PTI_STATE_DOWN) { pipeTI = NULL; } } } } } } *pipeTIPtr = NULL; if (pipeTI) { if (pipeTI->evWakeUp) { SetEvent(pipeTI->evWakeUp); } CloseHandle(pipeTI->evControl); #ifndef _PTI_USE_CKALLOC free(pipeTI); #else ckfree(pipeTI); #endif /* !_PTI_USE_CKALLOC */ } } /* *---------------------------------------------------------------------- * * TclPipeThreadExit -- * * Clean-up for the pipe thread (removes owned TI-structure in worker). * * Should be executed on worker exit, to inform the main thread or * free TI-structure (if owned). * * After calling of this function, TI-structure pointer given via pipeTIPtr * is not accessible (owned by main thread or released here). * * Results: * None. * *---------------------------------------------------------------------- */ void TclPipeThreadExit( TclPipeThreadInfo **pipeTIPtr) { LONG state; TclPipeThreadInfo *pipeTI = *pipeTIPtr; /* * If state of thread was set to stop (exactly), we can sane free its info * structure, otherwise it is shared with main thread, so main thread will * own it. */ if (!pipeTI) { return; } *pipeTIPtr = NULL; state = InterlockedExchange(&pipeTI->state, PTI_STATE_DOWN); if (state == PTI_STATE_STOP) { CloseHandle(pipeTI->evControl); if (pipeTI->evWakeUp) { SetEvent(pipeTI->evWakeUp); } #ifndef _PTI_USE_CKALLOC free(pipeTI); #else ckfree(pipeTI); /* be sure all subsystems used are finalized */ Tcl_FinalizeThread(); #endif /* !_PTI_USE_CKALLOC */ } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinPort.h0000644000175000017500000003333314554262142014722 0ustar sergeisergei/* * tclWinPort.h -- * * This header file handles porting issues that occur because of * differences between Windows and Unix. It should be the only * file that contains #ifdefs to handle different flavors of OS. * * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLWINPORT #define _TCLWINPORT #if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) /* See [Bug 3354324]: file mtime sets wrong time */ # define __MINGW_USE_VC2005_COMPAT #endif /* * We must specify the lower version we intend to support. * * WINVER = 0x0501 means Windows XP and above */ #ifndef WINVER # define WINVER 0x0501 #endif #ifndef _WIN32_WINNT # define _WIN32_WINNT 0x0501 #endif #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN /* Compatibility to older visual studio / windows platform SDK */ #if !defined(MAXULONG_PTR) typedef DWORD DWORD_PTR; typedef DWORD_PTR * PDWORD_PTR; #endif /* * Ask for the winsock function typedefs, also. */ #ifndef INCL_WINSOCK_API_TYPEDEFS # define INCL_WINSOCK_API_TYPEDEFS 1 #endif #include #include #ifdef HAVE_WSPIAPI_H # include #endif #ifdef CHECK_UNICODE_CALLS # define _UNICODE # define UNICODE # define __TCHAR_DEFINED typedef float *_TCHAR; # define _TCHAR_DEFINED typedef float *TCHAR; #endif /* CHECK_UNICODE_CALLS */ /* * Pull in the typedef of TCHAR for windows. */ #include #ifndef _TCHAR_DEFINED /* Borland seems to forget to set this. */ typedef _TCHAR TCHAR; # define _TCHAR_DEFINED #endif #if defined(_MSC_VER) && defined(__STDC__) /* VS2005 SP1 misses this. See [Bug #3110161] */ typedef _TCHAR TCHAR; #endif /* *--------------------------------------------------------------------------- * The following sets of #includes and #ifdefs are required to get Tcl to * compile under the windows compilers. *--------------------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #ifdef HAVE_INTTYPES_H # include #endif #include #ifndef __GNUC__ # define strncasecmp _strnicmp # define strcasecmp _stricmp #endif /* * Need to block out these includes for building extensions with MetroWerks * compiler for Win32. */ #ifndef __MWERKS__ #include #include # ifdef __BORLANDC__ # include # else # include # endif /* __BORLANDC__ */ #endif /* __MWERKS__ */ /* * The following defines redefine the Windows Socket errors as * BSD errors so Tcl_PosixError can do the right thing. */ #ifndef ENOTEMPTY # define ENOTEMPTY 41 /* Directory not empty */ #endif #ifndef EREMOTE # define EREMOTE 66 /* The object is remote */ #endif #ifndef EPFNOSUPPORT # define EPFNOSUPPORT 96 /* Protocol family not supported */ #endif #ifndef EADDRINUSE # define EADDRINUSE 100 /* Address already in use */ #endif #ifndef EADDRNOTAVAIL # define EADDRNOTAVAIL 101 /* Can't assign requested address */ #endif #ifndef EAFNOSUPPORT # define EAFNOSUPPORT 102 /* Address family not supported */ #endif #ifndef EALREADY # define EALREADY 103 /* Operation already in progress */ #endif #ifndef EBADMSG # define EBADMSG 104 /* Not a data message */ #endif #ifndef ECANCELED # define ECANCELED 105 /* Canceled */ #endif #ifndef ECONNABORTED # define ECONNABORTED 106 /* Software caused connection abort */ #endif #ifndef ECONNREFUSED # define ECONNREFUSED 107 /* Connection refused */ #endif #ifndef ECONNRESET # define ECONNRESET 108 /* Connection reset by peer */ #endif #ifndef EDESTADDRREQ # define EDESTADDRREQ 109 /* Destination address required */ #endif #ifndef EHOSTUNREACH # define EHOSTUNREACH 110 /* No route to host */ #endif #ifndef EIDRM # define EIDRM 111 /* Identifier removed */ #endif #ifndef EINPROGRESS # define EINPROGRESS 112 /* Operation now in progress */ #endif #ifndef EISCONN # define EISCONN 113 /* Socket is already connected */ #endif #ifndef ELOOP # define ELOOP 114 /* Symbolic link loop */ #endif #ifndef EMSGSIZE # define EMSGSIZE 115 /* Message too long */ #endif #ifndef ENETDOWN # define ENETDOWN 116 /* Network is down */ #endif #ifndef ENETRESET # define ENETRESET 117 /* Network dropped connection on reset */ #endif #ifndef ENETUNREACH # define ENETUNREACH 118 /* Network is unreachable */ #endif #ifndef ENOBUFS # define ENOBUFS 119 /* No buffer space available */ #endif #ifndef ENODATA # define ENODATA 120 /* No data available */ #endif #ifndef ENOLINK # define ENOLINK 121 /* Link has be severed */ #endif #ifndef ENOMSG # define ENOMSG 122 /* No message of desired type */ #endif #ifndef ENOPROTOOPT # define ENOPROTOOPT 123 /* Protocol not available */ #endif #ifndef ENOSR # define ENOSR 124 /* Out of stream resources */ #endif #ifndef ENOSTR # define ENOSTR 125 /* Not a stream device */ #endif #ifndef ENOTCONN # define ENOTCONN 126 /* Socket is not connected */ #endif #ifndef ENOTRECOVERABLE # define ENOTRECOVERABLE 127 /* Not recoverable */ #endif #ifndef ENOTSOCK # define ENOTSOCK 128 /* Socket operation on non-socket */ #endif #ifndef ENOTSUP # define ENOTSUP 129 /* Operation not supported */ #endif #ifndef EOPNOTSUPP # define EOPNOTSUPP 130 /* Operation not supported on socket */ #endif #ifndef EOTHER # define EOTHER 131 /* Other error */ #endif #ifndef EOVERFLOW # define EOVERFLOW 132 /* File too big */ #endif #ifndef EOWNERDEAD # define EOWNERDEAD 133 /* Owner dead */ #endif #ifndef EPROTO # define EPROTO 134 /* Protocol error */ #endif #ifndef EPROTONOSUPPORT # define EPROTONOSUPPORT 135 /* Protocol not supported */ #endif #ifndef EPROTOTYPE # define EPROTOTYPE 136 /* Protocol wrong type for socket */ #endif #ifndef ETIME # define ETIME 137 /* Timer expired */ #endif #ifndef ETIMEDOUT # define ETIMEDOUT 138 /* Connection timed out */ #endif #ifndef ETXTBSY # define ETXTBSY 139 /* Text file or pseudo-device busy */ #endif #ifndef EWOULDBLOCK # define EWOULDBLOCK 140 /* Operation would block */ #endif /* Visual Studio doesn't have these, so just choose some high numbers */ #ifndef ESOCKTNOSUPPORT # define ESOCKTNOSUPPORT 240 /* Socket type not supported */ #endif #ifndef ESHUTDOWN # define ESHUTDOWN 241 /* Can't send after socket shutdown */ #endif #ifndef ETOOMANYREFS # define ETOOMANYREFS 242 /* Too many references: can't splice */ #endif #ifndef EHOSTDOWN # define EHOSTDOWN 243 /* Host is down */ #endif #ifndef EUSERS # define EUSERS 244 /* Too many users (for UFS) */ #endif #ifndef EDQUOT # define EDQUOT 245 /* Disc quota exceeded */ #endif #ifndef ESTALE # define ESTALE 246 /* Stale NFS file handle */ #endif /* * Signals not known to the standard ANSI signal.h. These are used * by Tcl_WaitPid() and generic/tclPosixStr.c */ #ifndef SIGTRAP # define SIGTRAP 5 #endif #ifndef SIGBUS # define SIGBUS 10 #endif /* * Supply definitions for macros to query wait status, if not already * defined in header files above. */ #ifdef TCL_UNION_WAIT # define WAIT_STATUS_TYPE union wait #else # define WAIT_STATUS_TYPE int #endif /* TCL_UNION_WAIT */ #ifndef WIFEXITED # define WIFEXITED(stat) (((*((int *) &(stat))) & 0xC0000000) == 0) #endif #ifndef WEXITSTATUS # define WEXITSTATUS(stat) (*((int *) &(stat))) #endif #ifndef WIFSIGNALED # define WIFSIGNALED(stat) ((*((int *) &(stat))) & 0xC0000000) #endif #ifndef WTERMSIG # define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7F) #endif #ifndef WIFSTOPPED # define WIFSTOPPED(stat) 0 #endif #ifndef WSTOPSIG # define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xFF) #endif /* * Define constants for waitpid() system call if they aren't defined * by a system header file. */ #ifndef WNOHANG # define WNOHANG 1 #endif #ifndef WUNTRACED # define WUNTRACED 2 #endif /* * Define access mode constants if they aren't already defined. */ #ifndef F_OK # define F_OK 00 #endif #ifndef X_OK # define X_OK 01 #endif #ifndef W_OK # define W_OK 02 #endif #ifndef R_OK # define R_OK 04 #endif /* * Define macros to query file type bits, if they're not already * defined. */ #ifndef S_IFLNK # define S_IFLNK 0120000 /* Symbolic Link */ #endif /* * Windows compilers do not define S_IFBLK. However, Tcl uses it in * GetTypeFromMode to identify blockSpecial devices based on the * value in the statsbuf st_mode field. We have no other way to pass this * from NativeStat on Windows so are forced to define it here. * The definition here is essentially what is seen on Linux and MingW. * XXX - the root problem is Tcl using Unix definitions instead of * abstracting the structure into a platform independent one. Sigh - perhaps * Tcl 9 */ #ifndef S_IFBLK # define S_IFBLK (S_IFDIR | S_IFCHR) #endif #ifndef S_ISREG # ifdef S_IFREG # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) # else # define S_ISREG(m) 0 # endif #endif /* !S_ISREG */ #ifndef S_ISDIR # ifdef S_IFDIR # define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) # else # define S_ISDIR(m) 0 # endif #endif /* !S_ISDIR */ #ifndef S_ISCHR # ifdef S_IFCHR # define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR) # else # define S_ISCHR(m) 0 # endif #endif /* !S_ISCHR */ #ifndef S_ISBLK # ifdef S_IFBLK # define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK) # else # define S_ISBLK(m) 0 # endif #endif /* !S_ISBLK */ #ifndef S_ISFIFO # ifdef S_IFIFO # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) # else # define S_ISFIFO(m) 0 # endif #endif /* !S_ISFIFO */ #ifndef S_ISLNK # ifdef S_IFLNK # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) # else # define S_ISLNK(m) 0 # endif #endif /* !S_ISLNK */ /* * Define MAXPATHLEN in terms of MAXPATH if available */ #ifndef MAXPATH # define MAXPATH MAX_PATH #endif /* MAXPATH */ #ifndef MAXPATHLEN # define MAXPATHLEN MAXPATH #endif /* MAXPATHLEN */ /* * Define pid_t and uid_t if they're not already defined. */ #if !defined(TCL_PID_T) # define pid_t int #endif /* !TCL_PID_T */ #if !defined(TCL_UID_T) # define uid_t int #endif /* !TCL_UID_T */ /* * Visual C++ has some odd names for common functions, so we need to * define a few macros to handle them. Also, it defines EDEADLOCK and * EDEADLK as the same value, which confuses Tcl_ErrnoId(). */ #if defined(_MSC_VER) || defined(__MSVCRT__) # define environ _environ # if defined(_MSC_VER) && (_MSC_VER < 1600) # define hypot _hypot # endif # define exception _exception # undef EDEADLOCK # if defined(_MSC_VER) && (_MSC_VER >= 1700) # define timezone _timezone # endif #endif /* _MSC_VER || __MSVCRT__ */ /* * Borland's timezone and environ functions. */ #ifdef __BORLANDC__ # define timezone _timezone # define environ _environ #endif /* __BORLANDC__ */ #ifdef __WATCOMC__ # if !defined(__CHAR_SIGNED__) # error "You must use the -j switch to ensure char is signed." # endif #endif /* * MSVC 8.0 started to mark many standard C library functions depreciated * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ #if defined(_MSC_VER) # pragma warning(disable:4090) /* see: https://developercommunity.visualstudio.com/t/c-compiler-incorrect-propagation-of-const-qualifie/390711 */ # pragma warning(disable:4146) # pragma warning(disable:4244) # if _MSC_VER >= 1400 # pragma warning(disable:4267) # pragma warning(disable:4996) # endif #endif /* *--------------------------------------------------------------------------- * The following macros and declarations represent the interface between * generic and windows-specific parts of Tcl. Some of the macros may * override functions declared in tclInt.h. *--------------------------------------------------------------------------- */ /* * The default platform eol translation on Windows is TCL_TRANSLATE_CRLF: */ #define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CRLF /* * Declare dynamic loading extension macro. */ #define TCL_SHLIB_EXT ".dll" /* * The following define ensures that we use the native putenv * implementation to modify the environment array. This keeps * the C level environment in synch with the system level environment. */ #define USE_PUTENV 1 #define USE_PUTENV_FOR_UNSET 1 /* * Msvcrt's putenv() copies the string rather than takes ownership of it. */ #if defined(_MSC_VER) || defined(__MSVCRT__) # define HAVE_PUTENV_THAT_COPIES 1 #endif /* * Older version of Mingw are known to lack a MWMO_ALERTABLE define. */ #if !defined(MWMO_ALERTABLE) # define MWMO_ALERTABLE 2 #endif /* * The following defines wrap the system memory allocation routines for * use by tclAlloc.c. */ #define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \ (DWORD)0, (DWORD)size)) #define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ (DWORD)0, (HGLOBAL)ptr)) #define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ (DWORD)0, (LPVOID)ptr, (DWORD)size)) /* This type is not defined in the Windows headers */ #define socklen_t int /* * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. */ #define TclpReleaseFile(file) ckfree((char *) file) /* * The following macros and declarations wrap the C runtime library * functions. */ #define TclpExit exit #ifndef INVALID_SET_FILE_POINTER #define INVALID_SET_FILE_POINTER 0xFFFFFFFF #endif /* INVALID_SET_FILE_POINTER */ #ifndef LABEL_SECURITY_INFORMATION # define LABEL_SECURITY_INFORMATION (0x00000010L) #endif #define Tcl_DirEntry void #define TclDIR void #endif /* _TCLWINPORT */ tcl8.6.14/win/tclWinReg.c0000644000175000017500000012011214554262142014476 0ustar sergeisergei/* * tclWinReg.c -- * * This file contains the implementation of the "registry" Tcl built-in * command. This command is built as a dynamically loadable extension in * a separate DLL. * * Copyright (c) 1997 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") #endif #include /* * Ensure that we can say which registry is being accessed. */ #ifndef KEY_WOW64_64KEY # define KEY_WOW64_64KEY (0x0100) #endif #ifndef KEY_WOW64_32KEY # define KEY_WOW64_32KEY (0x0200) #endif /* * The maximum length of a sub-key name. */ #ifndef MAX_KEY_LENGTH # define MAX_KEY_LENGTH 256 #endif /* * The following macros convert between different endian ints. */ #define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) #define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) /* * The following flag is used in OpenKeys to indicate that the specified key * should be created if it doesn't currently exist. */ #define REG_CREATE 1 /* * The following tables contain the mapping from registry root names to the * system predefined keys. */ static const char *const rootKeyNames[] = { "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT", "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL }; static const HKEY rootKeys[] = { HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA }; static const char REGISTRY_ASSOC_KEY[] = "registry::command"; /* * The following table maps from registry types to strings. Note that the * indices for this array are the same as the constants for the known registry * types so we don't need a separate table to hold the mapping. */ static const char *const typeNames[] = { "none", "sz", "expand_sz", "binary", "dword", "dword_big_endian", "link", "multi_sz", "resource_list", NULL }; static DWORD lastType = REG_RESOURCE_LIST; /* * Declarations for functions defined in this file. */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); static int BroadcastValue(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); static void DeleteCmd(void *clientData); static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, REGSAM mode); static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *patternObj, REGSAM mode); static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, REGSAM mode); static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, REGSAM mode); static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *patternObj, REGSAM mode); static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode, int flags, HKEY *keyPtr); static DWORD OpenSubKey(char *hostName, HKEY rootKey, char *keyName, REGSAM mode, int flags, HKEY *keyPtr); static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, const WCHAR * pKeyName, REGSAM mode); static int RegistryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); #if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 # define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) # define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString # endif #endif static unsigned char * getByteArrayFromObj( Tcl_Obj *objPtr, size_t *lengthPtr ) { int length; unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); #if TCL_MAJOR_VERSION > 8 if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { /* 64-bit and TIP #494 situation: */ *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; } else #endif /* 32-bit or without TIP #494 */ *lengthPtr = (size_t) (unsigned) length; return result; } #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Registry_Init(Tcl_Interp *interp); DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); #ifdef __cplusplus } #endif /* *---------------------------------------------------------------------- * * Registry_Init -- * * This function initializes the registry command. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Registry_Init( Tcl_Interp *interp) { Tcl_Command cmd; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); return Tcl_PkgProvideEx(interp, "registry", "1.3.5", NULL); } /* *---------------------------------------------------------------------- * * Registry_Unload -- * * This function removes the registry command. * * Results: * A standard Tcl result. * * Side effects: * The registry command is deleted and the dll may be unloaded. * *---------------------------------------------------------------------- */ int Registry_Unload( Tcl_Interp *interp, /* Interpreter for unloading */ int flags) /* Flags passed by the unload system */ { Tcl_Command cmd; Tcl_Obj *objv[3]; (void)flags; /* * Unregister the registry package. There is no Tcl_PkgForget() */ objv[0] = Tcl_NewStringObj("package", -1); objv[1] = Tcl_NewStringObj("forget", -1); objv[2] = Tcl_NewStringObj("registry", -1); Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL); /* * Delete the originally registered command. */ cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); if (cmd != NULL) { Tcl_DeleteCommandFromToken(interp, cmd); } return TCL_OK; } /* *---------------------------------------------------------------------- * * DeleteCmd -- * * Cleanup the interp command token so that unloading doesn't try to * re-delete the command (which will crash). * * Results: * None. * * Side effects: * The unload command will not attempt to delete this command. * *---------------------------------------------------------------------- */ static void DeleteCmd( void *clientData) { Tcl_Interp *interp = (Tcl_Interp *)clientData; Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); } /* *---------------------------------------------------------------------- * * RegistryObjCmd -- * * This function implements the Tcl "registry" command. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int RegistryObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { int n = 1; int index, argc; REGSAM mode = 0; const char *errString = NULL; static const char *const subcommands[] = { "broadcast", "delete", "get", "keys", "set", "type", "values", NULL }; enum SubCmdIdx { BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx }; static const char *const modes[] = { "-32bit", "-64bit", NULL }; (void)dummy; if (objc < 2) { wrongArgs: Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetString(objv[n])[0] == '-') { if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case 0: /* -32bit */ mode |= KEY_WOW64_32KEY; break; case 1: /* -64bit */ mode |= KEY_WOW64_64KEY; break; } if (objc < 3) { goto wrongArgs; } } if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } argc = (objc - n); switch (index) { case BroadcastIdx: /* broadcast */ if (argc == 1 || argc == 3) { int res = BroadcastValue(interp, argc, objv + n); if (res != TCL_BREAK) { return res; } } errString = "keyName ?-timeout milliseconds?"; break; case DeleteIdx: /* delete */ if (argc == 1) { return DeleteKey(interp, objv[n], mode); } else if (argc == 2) { return DeleteValue(interp, objv[n], objv[n+1], mode); } errString = "keyName ?valueName?"; break; case GetIdx: /* get */ if (argc == 2) { return GetValue(interp, objv[n], objv[n+1], mode); } errString = "keyName valueName"; break; case KeysIdx: /* keys */ if (argc == 1) { return GetKeyNames(interp, objv[n], NULL, mode); } else if (argc == 2) { return GetKeyNames(interp, objv[n], objv[n+1], mode); } errString = "keyName ?pattern?"; break; case SetIdx: /* set */ if (argc == 1) { HKEY key; /* * Create the key and then close it immediately. */ mode |= KEY_ALL_ACCESS; if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) { return TCL_ERROR; } RegCloseKey(key); return TCL_OK; } else if (argc == 3) { return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL, mode); } else if (argc == 4) { return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3], mode); } errString = "keyName ?valueName data ?type??"; break; case TypeIdx: /* type */ if (argc == 2) { return GetType(interp, objv[n], objv[n+1], mode); } errString = "keyName valueName"; break; case ValuesIdx: /* values */ if (argc == 1) { return GetValueNames(interp, objv[n], NULL, mode); } else if (argc == 2) { return GetValueNames(interp, objv[n], objv[n+1], mode); } errString = "keyName ?pattern?"; break; } Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * DeleteKey -- * * This function deletes a registry key. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int DeleteKey( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key to delete. */ REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; const WCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; Tcl_DString buf; REGSAM saveMode = mode; /* * Find the parent of the key being deleted and open it. */ keyName = Tcl_GetString(keyNameObj); buffer = (char *)Tcl_Alloc(keyNameObj->length + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName) != TCL_OK) { Tcl_Free(buffer); return TCL_ERROR; } if (*keyName == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("bad key: cannot delete root keys", -1)); Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL); Tcl_Free(buffer); return TCL_ERROR; } tail = strrchr(keyName, '\\'); if (tail) { *tail++ = '\0'; } else { tail = keyName; keyName = NULL; } mode |= KEY_ENUMERATE_SUB_KEYS | DELETE; result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey); if (result != ERROR_SUCCESS) { Tcl_Free(buffer); if (result == ERROR_FILE_NOT_FOUND) { return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } /* * Now we recursively delete the key and everything below it. */ Tcl_DStringInit(&buf); nativeTail = Tcl_UtfToWCharDString(tail, -1, &buf); result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); result = TCL_ERROR; } else { result = TCL_OK; } RegCloseKey(subkey); Tcl_Free(buffer); return result; } /* *---------------------------------------------------------------------- * * DeleteValue -- * * This function deletes a value from a registry key. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int DeleteValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to delete. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; char *valueName; DWORD result; Tcl_DString ds; /* * Attempt to open the key for deletion. */ mode |= KEY_SET_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetString(valueNameObj); Tcl_DStringInit(&ds); Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); result = RegDeleteValueW(key, (const WCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to delete value \"%s\" from key \"%s\": ", Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } else { result = TCL_OK; } RegCloseKey(key); return result; } /* *---------------------------------------------------------------------- * * GetKeyNames -- * * This function enumerates the subkeys of a given key. If the optional * pattern is supplied, then only keys that match the pattern will be * returned. * * Results: * Returns the list of subkeys in the result object of the interpreter, * or an error message on failure. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetKeyNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ Tcl_Obj *patternObj, /* Optional match pattern. */ REGSAM mode) /* Mode flags to pass. */ { const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ WCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ Tcl_Obj *resultPtr; /* List of subkeys being accumulated */ int result = TCL_OK; /* Return value from this command */ Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */ if (patternObj) { pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } /* * Attempt to open the key for enumeration. */ mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } /* * Enumerate the subkeys. */ resultPtr = Tcl_NewObj(); for (index = 0;; ++index) { bufSize = MAX_KEY_LENGTH; result = RegEnumKeyExW(key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { if (result == ERROR_NO_MORE_ITEMS) { result = TCL_OK; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to enumerate subkeys of \"%s\": ", Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } break; } Tcl_DStringInit(&ds); name = Tcl_WCharToUtfDString(buffer, bufSize, &ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); continue; } result = Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); if (result != TCL_OK) { break; } } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); } else { Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */ } RegCloseKey(key); return result; } /* *---------------------------------------------------------------------- * * GetType -- * * This function gets the type of a given registry value and places it in * the interpreter result. * * Results: * Returns a normal Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetType( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to get. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; DWORD result, type; Tcl_DString ds; const char *valueName; const WCHAR *nativeValue; /* * Attempt to open the key for reading. */ mode |= KEY_QUERY_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } /* * Get the type of the value. */ valueName = Tcl_GetString(valueNameObj); Tcl_DStringInit(&ds); nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); result = RegQueryValueExW(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); RegCloseKey(key); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get type of value \"%s\" from key \"%s\": ", Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); return TCL_ERROR; } /* * Set the type into the result. Watch out for unknown types. If we don't * know about the type, just use the numeric value. */ if (type > lastType) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type)); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * GetValue -- * * This function gets the contents of a registry value and places a list * containing the data and the type in the interpreter result. * * Results: * Returns a normal Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to get. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; const char *valueName; const WCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; /* * Attempt to open the key for reading. */ mode |= KEY_QUERY_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } /* * Initialize a Dstring to maximum statically allocated size we could get * one more byte by avoiding Tcl_DStringSetLength() and just setting * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the * implementation of Dstrings changes. * * This allows short values to be read from the registry in one call. * Longer values need a second call with an expanded DString. */ Tcl_DStringInit(&data); Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1; valueName = Tcl_GetString(valueNameObj); Tcl_DStringInit(&buf); nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &buf); result = RegQueryValueExW(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* * The Windows docs say that in this error case, we just need to * expand our buffer and request more data. Required for * HKEY_PERFORMANCE_DATA */ length = Tcl_DStringLength(&data) * (2 / sizeof(WCHAR)); Tcl_DStringSetLength(&data, (int) length * sizeof(WCHAR)); result = RegQueryValueExW(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get value \"%s\" from key \"%s\": ", Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; } /* * If the data is a 32-bit quantity, store it as an integer object. If it * is a multi-string, store it as a list of strings. For null-terminated * strings, append up the to first null. Otherwise, store it as a binary * string. */ if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, *((DWORD *) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); char *end = Tcl_DStringValue(&data) + length; Tcl_Obj *resultPtr = Tcl_NewObj(); /* * Multistrings are stored as an array of null-terminated strings, * terminated by two null characters. Also do a bounds check in case * we get bogus data. */ while ((p < end) && *((WCHAR *) p) != 0) { WCHAR *wp = (WCHAR *) p; Tcl_DStringInit(&buf); Tcl_WCharToUtfDString(wp, wcslen(wp), &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); while (*wp++ != 0) {/* empty body */} p = (char *) wp; Tcl_DStringFree(&buf); } Tcl_SetObjResult(interp, resultPtr); } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { WCHAR *wp = (WCHAR *) Tcl_DStringValue(&data); Tcl_DStringInit(&buf); Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&data), wcslen(wp), &buf); Tcl_DStringResult(interp, &buf); } else { /* * Save binary data as a byte array. */ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj( (BYTE *) Tcl_DStringValue(&data), (int) length)); } Tcl_DStringFree(&data); return result; } /* *---------------------------------------------------------------------- * * GetValueNames -- * * This function enumerates the values of the given key. If the * optional pattern is supplied, then only value names that match the * pattern will be returned. * * Results: * Returns the list of value names in the result object of the * interpreter, or an error message on failure. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetValueNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ Tcl_Obj *patternObj, /* Optional match pattern. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; Tcl_Obj *resultPtr; DWORD index, size, result; Tcl_DString buffer, ds; const char *pattern, *name; /* * Attempt to open the key for enumeration. */ mode |= KEY_QUERY_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); index = 0; result = TCL_OK; if (patternObj) { pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } /* * Enumerate the values under the given subkey until we get an error, * indicating the end of the list. Note that we need to reset size after * each iteration because RegEnumValue smashes the old value. */ size = MAX_KEY_LENGTH; while (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { Tcl_DStringInit(&ds); Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds); name = Tcl_DStringValue(&ds); if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); if (result != TCL_OK) { Tcl_DStringFree(&ds); break; } } Tcl_DStringFree(&ds); index++; size = MAX_KEY_LENGTH; } Tcl_SetObjResult(interp, resultPtr); Tcl_DStringFree(&buffer); RegCloseKey(key); return result; } /* *---------------------------------------------------------------------- * * OpenKey -- * * This function opens the specified key. This function is a simple * wrapper around ParseKeyName and OpenSubKey. * * Results: * Returns the opened key in the keyPtr argument and a Tcl result code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int OpenKey( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to open. */ REGSAM mode, /* Access mode. */ int flags, /* 0 or REG_CREATE. */ HKEY *keyPtr) /* Returned HKEY. */ { char *keyName, *buffer, *hostName; HKEY rootKey; DWORD result; keyName = Tcl_GetString(keyNameObj); buffer = (char *)Tcl_Alloc(keyNameObj->length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); if (result == TCL_OK) { result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to open key: ", -1)); AppendSystemError(interp, result); result = TCL_ERROR; } else { result = TCL_OK; } } Tcl_Free(buffer); return result; } /* *---------------------------------------------------------------------- * * OpenSubKey -- * * Opens a given subkey of the given root key on the specified * host. * * Results: * Returns the opened key in the keyPtr and a Windows error code as the * return value. * * Side effects: * None. * *---------------------------------------------------------------------- */ static DWORD OpenSubKey( char *hostName, /* Host to access, or NULL for local. */ HKEY rootKey, /* Root registry key. */ char *keyName, /* Subkey name. */ REGSAM mode, /* Access mode. */ int flags, /* 0 or REG_CREATE. */ HKEY *keyPtr) /* Returned HKEY. */ { DWORD result; Tcl_DString buf; /* * Attempt to open the root key on a remote host if necessary. */ if (hostName) { Tcl_DStringInit(&buf); hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf); result = RegConnectRegistryW((WCHAR *)hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { return result; } } /* * Now open the specified key with the requested permissions. Note that * this key must be closed by the caller. */ if (keyName) { Tcl_DStringInit(&buf); keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf); } if (flags & REG_CREATE) { DWORD create; result = RegCreateKeyExW(rootKey, (WCHAR *)keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* * Here we fudge it for this special root key. See MSDN for more info * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. */ *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { result = RegOpenKeyExW(rootKey, (WCHAR *)keyName, 0, mode, keyPtr); } if (keyName) { Tcl_DStringFree(&buf); } /* * Be sure to close the root key since we are done with it now. */ if (hostName) { RegCloseKey(rootKey); } return result; } /* *---------------------------------------------------------------------- * * ParseKeyName -- * * Parses a key name into the host, root, and subkey parts. * * Results: * The pointers to the start of the host and subkey names are returned in * the hostNamePtr and keyNamePtr variables. The specified root HKEY is * returned in rootKeyPtr. Returns a standard Tcl result. * * Side effects: * Modifies the name string by inserting nulls. * *---------------------------------------------------------------------- */ static int ParseKeyName( Tcl_Interp *interp, /* Current interpreter. */ char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr) { char *rootName; int result, index; Tcl_Obj *rootObj; /* * Split the key into host and root portions. */ *hostNamePtr = *keyNamePtr = rootName = NULL; if (name[0] == '\\') { if (name[1] == '\\') { *hostNamePtr = name; for (rootName = name+2; *rootName != '\0'; rootName++) { if (*rootName == '\\') { *rootName++ = '\0'; break; } } } } else { rootName = name; } if (!rootName) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad key \"%s\": must start with a valid root", name)); Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL); return TCL_ERROR; } /* * Split the root into root and subkey portions. */ for (*keyNamePtr = rootName; **keyNamePtr != '\0'; (*keyNamePtr)++) { if (**keyNamePtr == '\\') { **keyNamePtr = '\0'; (*keyNamePtr)++; break; } } /* * Look for a matching root name. */ rootObj = Tcl_NewStringObj(rootName, -1); result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name", TCL_EXACT, &index); Tcl_DecrRefCount(rootObj); if (result != TCL_OK) { return TCL_ERROR; } *rootKeyPtr = rootKeys[index]; return TCL_OK; } /* *---------------------------------------------------------------------- * * RecursiveDeleteKey -- * * This function recursively deletes all the keys below a starting key. * Although Windows 95 does this automatically, we still need to do this * for Windows NT. * * Results: * Returns a Windows error code. * * Side effects: * Deletes all of the keys and values below the given key. * *---------------------------------------------------------------------- */ static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ const WCHAR *keyName, /* Name of key to be deleted in external * encoding, not UTF. */ REGSAM mode) /* Mode flags to pass. */ { DWORD result, size; Tcl_DString subkey; HKEY hKey; REGSAM saveMode = mode; static int checkExProc = 0; static LONG (* regDeleteKeyExProc) (HKEY, LPCWSTR, REGSAM, DWORD) = (LONG (*) (HKEY, LPCWSTR, REGSAM, DWORD)) NULL; /* * Do not allow NULL or empty key name. */ if (!keyName || *keyName == '\0') { return ERROR_BADKEY; } mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; result = RegOpenKeyExW(startKey, keyName, 0, mode, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ size = MAX_KEY_LENGTH; result = RegEnumKeyExW(hKey, 0, (WCHAR *)Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { /* * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we * can't compile with it in. We need to check for it at runtime * and use it if we find it. */ if (mode && !checkExProc) { HMODULE handle; checkExProc = 1; handle = GetModuleHandleW(L"ADVAPI32"); regDeleteKeyExProc = (LONG (*) (HKEY, LPCWSTR, REGSAM, DWORD)) (void *)GetProcAddress(handle, "RegDeleteKeyExW"); } if (mode && regDeleteKeyExProc) { result = regDeleteKeyExProc(startKey, keyName, mode, 0); } else { result = RegDeleteKeyW(startKey, keyName); } break; } else if (result == ERROR_SUCCESS) { result = RecursiveDeleteKey(hKey, (const WCHAR *) Tcl_DStringValue(&subkey), mode); } } Tcl_DStringFree(&subkey); RegCloseKey(hKey); return result; } /* *---------------------------------------------------------------------- * * SetValue -- * * This function sets the contents of a registry value. If the key or * value does not exist, it will be created. If it does exist, then the * data and type will be replaced. * * Results: * Returns a normal Tcl result. * * Side effects: * May create new keys or values. * *---------------------------------------------------------------------- */ static int SetValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to set. */ Tcl_Obj *dataObj, /* Data to be written. */ Tcl_Obj *typeObj, /* Type of data to be written. */ REGSAM mode) /* Mode flags to pass. */ { int type; DWORD result; HKEY key; const char *valueName; Tcl_DString nameBuf; if (typeObj == NULL) { type = REG_SZ; } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", 0, (int *) &type) != TCL_OK) { if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) { return TCL_ERROR; } Tcl_ResetResult(interp); } mode |= KEY_ALL_ACCESS; if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetString(valueNameObj); Tcl_DStringInit(&nameBuf); valueName = (char *) Tcl_UtfToWCharDString(valueName, valueNameObj->length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) { RegCloseKey(key); Tcl_DStringFree(&nameBuf); return TCL_ERROR; } value = ConvertDWORD((DWORD) type, (DWORD) value); result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; int objc, i; Tcl_Obj **objv; if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) { RegCloseKey(key); Tcl_DStringFree(&nameBuf); return TCL_ERROR; } /* * Append the elements as null terminated strings. Note that we must * not assume the length of the string in case there are embedded * nulls, which aren't allowed in REG_MULTI_SZ values. */ Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { const char *bytes = Tcl_GetString(objv[i]); Tcl_DStringAppend(&data, bytes, objv[i]->length); /* * Add a null character to separate this value from the next. */ Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } Tcl_DStringInit(&buf); Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; const char *data = Tcl_GetString(dataObj); Tcl_DStringInit(&buf); data = (char *) Tcl_UtfToWCharDString(data, dataObj->length, &buf); /* * Include the null in the length, padding if needed for WCHAR. */ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); } else { BYTE *data; size_t bytelength; /* * Store binary data in the registry. */ data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength); result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, data, (DWORD) bytelength); } Tcl_DStringFree(&nameBuf); RegCloseKey(key); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to set value: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * BroadcastValue -- * * This function broadcasts a WM_SETTINGCHANGE message to indicate to * other programs that we have changed the contents of a registry value. * * Results: * Returns a normal Tcl result. * * Side effects: * Will cause other programs to reload their system settings. * *---------------------------------------------------------------------- */ static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { LRESULT result; DWORD_PTR sendResult; int timeout = 3000; size_t len; const char *str; Tcl_Obj *objPtr; WCHAR *wstr; Tcl_DString ds; if (objc == 3) { str = Tcl_GetString(objv[1]); len = objv[1]->length; if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) { return TCL_BREAK; } if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) { return TCL_ERROR; } } str = Tcl_GetString(objv[0]); Tcl_DStringInit(&ds); wstr = Tcl_UtfToWCharDString(str, objv[0]->length, &ds); if (Tcl_DStringLength(&ds) == 0) { wstr = NULL; } /* * Use the ignore the result. */ result = SendMessageTimeoutW(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult); Tcl_DStringFree(&ds); objPtr = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult)); Tcl_SetObjResult(interp, objPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * AppendSystemError -- * * Formats a Windows system error message and places it into * the interpreter result. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AppendSystemError( Tcl_Interp *interp, /* Current interpreter. */ DWORD error) /* Result code from error. */ { int length; WCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr, 0, NULL); if (length == 0) { snprintf(msgBuf, sizeof(msgBuf), "unknown error: %ld", error); msg = msgBuf; } else { char *msgPtr; Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &ds); LocalFree(tMsgPtr); msgPtr = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. */ if (msgPtr[length-1] == '\n') { --length; } if (msgPtr[length-1] == '\r') { --length; } msgPtr[length] = 0; msg = msgPtr; } snprintf(id, sizeof(id), "%ld", error); Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL); Tcl_AppendToObj(resultPtr, msg, length); Tcl_SetObjResult(interp, resultPtr); if (length != 0) { Tcl_DStringFree(&ds); } } /* *---------------------------------------------------------------------- * * ConvertDWORD -- * * Determines whether a DWORD needs to be byte swapped, and * returns the appropriately swapped value. * * Results: * Returns a converted DWORD. * * Side effects: * None. * *---------------------------------------------------------------------- */ static DWORD ConvertDWORD( DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */ DWORD value) /* The value to be converted. */ { const DWORD order = 1; DWORD localType; /* * Check to see if the low bit is in the first byte. */ localType = (*((const char *) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; return (type != localType) ? (DWORD) SWAPLONG(value) : value; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinSerial.c0000644000175000017500000016226214554262142015214 0ustar sergeisergei/* * tclWinSerial.c -- * * This file implements the Windows-specific serial port functions, and * the "serial" channel driver. * * Copyright (c) 1999 by Scriptics Corp. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * Serial functionality implemented by Rolf.Schroedter@dlr.de */ #include "tclWinInt.h" /* * The following variable is used to tell whether this module has been * initialized. */ static int initialized = 0; /* * The serialMutex locks around access to the initialized variable, and it is * used to protect background threads from being terminated while they are * using APIs that hold locks. */ TCL_DECLARE_MUTEX(serialMutex) /* * Bit masks used in the flags field of the SerialInfo structure below. */ #define SERIAL_PENDING (1<<0) /* Message is pending in the queue. */ #define SERIAL_ASYNC (1<<1) /* Channel is non-blocking. */ /* * Bit masks used in the sharedFlags field of the SerialInfo structure below. */ #define SERIAL_EOF (1<<2) /* Serial has reached EOF. */ #define SERIAL_ERROR (1<<4) /* * Default time to block between checking status on the serial port. */ #define SERIAL_DEFAULT_BLOCKTIME 10 /* 10 msec */ /* * Define Win32 read/write error masks returned by ClearCommError() */ #define SERIAL_READ_ERRORS \ (CE_RXOVER | CE_OVERRUN | CE_RXPARITY | CE_FRAME | CE_BREAK) #define SERIAL_WRITE_ERRORS \ (CE_TXFULL | CE_PTO) /* * This structure describes per-instance data for a serial based channel. */ typedef struct SerialInfo { HANDLE handle; struct SerialInfo *nextPtr; /* Pointer to next registered serial. */ Tcl_Channel channel; /* Pointer to channel structure. */ int validMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ int watchMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which events should be reported. */ int flags; /* State flags, see above for a list. */ int readable; /* Flag that the channel is readable. */ int writable; /* Flag that the channel is writable. */ int blockTime; /* Maximum blocktime in msec. */ unsigned int lastEventTime; /* Time in milliseconds since last readable * event. */ /* Next readable event only after blockTime */ DWORD error; /* pending error code returned by * ClearCommError() */ DWORD lastError; /* last error code, can be fetched with * fconfigure chan -lasterror */ DWORD sysBufRead; /* Win32 system buffer size for read ops, * default=4096 */ DWORD sysBufWrite; /* Win32 system buffer size for write ops, * default=4096 */ Tcl_ThreadId threadId; /* Thread to which events should be reported. * This value is used by the reader/writer * threads. */ OVERLAPPED osRead; /* OVERLAPPED structure for read operations. */ OVERLAPPED osWrite; /* OVERLAPPED structure for write operations */ TclPipeThreadInfo *writeTI; /* Thread info structure of writer worker. */ HANDLE writeThread; /* Handle to writer thread. */ CRITICAL_SECTION csWrite; /* Writer thread synchronisation. */ HANDLE evWritable; /* Manual-reset event to signal when the * writer thread has finished waiting for the * current buffer to be written. */ DWORD writeError; /* An error caused by the last background * write. Set to 0 if no error has been * detected. This word is shared with the * writer thread so access must be * synchronized with the evWritable object. */ char *writeBuf; /* Current background output buffer. Access is * synchronized with the evWritable object. */ int writeBufLen; /* Size of write buffer. Access is * synchronized with the evWritable object. */ int toWrite; /* Current amount to be written. Access is * synchronized with the evWritable object. */ int writeQueue; /* Number of bytes pending in output queue. * Offset to DCB.cbInQue. Used to query * [fconfigure -queue] */ } SerialInfo; typedef struct ThreadSpecificData { /* * The following pointer refers to the head of the list of serials that * are being watched for file events. */ SerialInfo *firstSerialPtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following structure is what is added to the Tcl event queue when serial * events are generated. */ typedef struct SerialEvent { Tcl_Event header; /* Information that is standard for all * events. */ SerialInfo *infoPtr; /* Pointer to serial info structure. Note that * we still have to verify that the serial * exists before dereferencing this * pointer. */ } SerialEvent; /* * We don't use timeouts. */ static COMMTIMEOUTS no_timeout = { 0, /* ReadIntervalTimeout */ 0, /* ReadTotalTimeoutMultiplier */ 0, /* ReadTotalTimeoutConstant */ 0, /* WriteTotalTimeoutMultiplier */ 0, /* WriteTotalTimeoutConstant */ }; /* * Declarations for functions used only in this file. */ static int SerialBlockProc(ClientData instanceData, int mode); static void SerialCheckProc(ClientData clientData, int flags); static int SerialCloseProc(ClientData instanceData, Tcl_Interp *interp); static int SerialClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags); static int SerialEventProc(Tcl_Event *evPtr, int flags); static void SerialExitHandler(ClientData clientData); static int SerialGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static ThreadSpecificData *SerialInit(void); static int SerialInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int SerialOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static void SerialSetupProc(ClientData clientData, int flags); static void SerialWatchProc(ClientData instanceData, int mask); static void ProcExitHandler(ClientData clientData); static int SerialGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int SerialSetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); static DWORD WINAPI SerialWriterThread(LPVOID arg); static void SerialThreadActionProc(ClientData instanceData, int action); static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr); static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpWritten, LPOVERLAPPED osPtr); /* * This structure describes the channel type structure for command serial * based IO. */ static const Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ SerialCloseProc, /* Close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ SerialSetOptionProc, /* Set option proc. */ SerialGetOptionProc, /* Get option proc. */ SerialWatchProc, /* Set up notifier to watch the channel. */ SerialGetHandleProc, /* Get an OS handle from channel. */ SerialClose2Proc, /* close2proc. */ SerialBlockProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ SerialThreadActionProc, /* thread action proc */ NULL /* truncate */ }; /* *---------------------------------------------------------------------- * * SerialInit -- * * This function initializes the static variables for this file. * * Results: * None. * * Side effects: * Creates a new event source. * *---------------------------------------------------------------------- */ static ThreadSpecificData * SerialInit(void) { ThreadSpecificData *tsdPtr; /* * Check the initialized flag first, then check it again in the mutex. * This is a speed enhancement. */ if (!initialized) { Tcl_MutexLock(&serialMutex); if (!initialized) { initialized = 1; Tcl_CreateExitHandler(ProcExitHandler, NULL); } Tcl_MutexUnlock(&serialMutex); } tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->firstSerialPtr = NULL; Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL); Tcl_CreateThreadExitHandler(SerialExitHandler, NULL); } return tsdPtr; } /* *---------------------------------------------------------------------- * * SerialExitHandler -- * * This function is called to cleanup the serial module before Tcl is * unloaded. * * Results: * None. * * Side effects: * Removes the serial event source. * *---------------------------------------------------------------------- */ static void SerialExitHandler( ClientData clientData) /* Old window proc */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SerialInfo *infoPtr; /* * Clear all eventually pending output. Otherwise Tcl's exit could totally * block, because it performs a blocking flush on all open channels. Note * that serial write operations may be blocked due to handshake. */ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); } Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL); } /* *---------------------------------------------------------------------- * * ProcExitHandler -- * * This function is called to cleanup the process list before Tcl is * unloaded. * * Results: * None. * * Side effects: * Resets the process list. * *---------------------------------------------------------------------- */ static void ProcExitHandler( ClientData clientData) /* Old window proc */ { Tcl_MutexLock(&serialMutex); initialized = 0; Tcl_MutexUnlock(&serialMutex); } /* *---------------------------------------------------------------------- * * SerialBlockTime -- * * Wrapper to set Tcl's block time in msec. * * Results: * None. * * Side effects: * Updates the maximum blocking time. * *---------------------------------------------------------------------- */ static void SerialBlockTime( int msec) /* milli-seconds */ { Tcl_Time blockTime; blockTime.sec = msec / 1000; blockTime.usec = (msec % 1000) * 1000; Tcl_SetMaxBlockTime(&blockTime); } /* *---------------------------------------------------------------------- * * SerialGetMilliseconds -- * * Get current time in milliseconds,ignoring integer overruns. * * Results: * The current time. * * Side effects: * None. * *---------------------------------------------------------------------- */ static unsigned int SerialGetMilliseconds(void) { Tcl_Time time; Tcl_GetTime(&time); return (time.sec * 1000 + time.usec / 1000); } /* *---------------------------------------------------------------------- * * SerialSetupProc -- * * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an * event. * * Results: * None. * * Side effects: * Adjusts the block time if needed. * *---------------------------------------------------------------------- */ void SerialSetupProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; int block = 1; int msec = INT_MAX; /* min. found block time */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return; } /* * Look to see if any events handlers installed. If they are, do not * block. */ for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ; infoPtr=infoPtr->nextPtr) { if (infoPtr->watchMask & TCL_WRITABLE) { if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) { block = 0; msec = min(msec, infoPtr->blockTime); } } if (infoPtr->watchMask & TCL_READABLE) { block = 0; msec = min(msec, infoPtr->blockTime); } } if (!block) { SerialBlockTime(msec); } } /* *---------------------------------------------------------------------- * * SerialCheckProc -- * * This procedure is called by Tcl_DoOneEvent to check the serial event * source for events. * * Results: * None. * * Side effects: * May queue an event. * *---------------------------------------------------------------------- */ static void SerialCheckProc( ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; SerialEvent *evPtr; int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); COMSTAT cStat; unsigned int time; if (!(flags & TCL_FILE_EVENTS)) { return; } /* * Queue events for any ready serials that don't already have events * queued. */ for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ; infoPtr=infoPtr->nextPtr) { if (infoPtr->flags & SERIAL_PENDING) { continue; } needEvent = 0; /* * If WRITABLE watch mask is set look for infoPtr->evWritable object. */ if (infoPtr->watchMask & TCL_WRITABLE && WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) { infoPtr->writable = 1; needEvent = 1; } /* * If READABLE watch mask is set call ClearCommError to poll cbInQue. * Window errors are ignored here. */ if (infoPtr->watchMask & TCL_READABLE) { if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) { /* * Look for characters already pending in windows queue. If * they are, poll. */ if (infoPtr->watchMask & TCL_READABLE) { /* * Force fileevent after serial read error. */ if ((cStat.cbInQue > 0) || (infoPtr->error & SERIAL_READ_ERRORS)) { infoPtr->readable = 1; time = SerialGetMilliseconds(); if ((unsigned int) (time - infoPtr->lastEventTime) >= (unsigned int) infoPtr->blockTime) { needEvent = 1; infoPtr->lastEventTime = time; } } } } } /* * Queue an event if the serial is signaled for reading or writing. */ if (needEvent) { infoPtr->flags |= SERIAL_PENDING; evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent)); evPtr->header.proc = SerialEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } } /* *---------------------------------------------------------------------- * * SerialBlockProc -- * * Set blocking or non-blocking mode on channel. * * Results: * 0 if successful, errno when failed. * * Side effects: * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ static int SerialBlockProc( ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { int errorCode = 0; SerialInfo *infoPtr = (SerialInfo *) instanceData; /* * Only serial READ can be switched between blocking & nonblocking using * COMMTIMEOUTS. Serial write emulates blocking & nonblocking by the * SerialWriterThread. */ if (mode == TCL_MODE_NONBLOCKING) { infoPtr->flags |= SERIAL_ASYNC; } else { infoPtr->flags &= ~(SERIAL_ASYNC); } return errorCode; } /* *---------------------------------------------------------------------- * * SerialCloseProc/SerialClose2Proc -- * * Closes a serial based IO channel. * * Results: * 0 on success, errno otherwise. * * Side effects: * Closes the physical channel. * *---------------------------------------------------------------------- */ static int SerialCloseProc( ClientData instanceData, /* Pointer to SerialInfo structure. */ Tcl_Interp *interp) /* For error reporting. */ { SerialInfo *serialPtr = (SerialInfo *) instanceData; int errorCode, result = 0; SerialInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); errorCode = 0; if (serialPtr->validMask & TCL_READABLE) { PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); CloseHandle(serialPtr->osRead.hEvent); } serialPtr->validMask &= ~TCL_READABLE; if (serialPtr->writeThread) { TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread); CloseHandle(serialPtr->osWrite.hEvent); CloseHandle(serialPtr->evWritable); CloseHandle(serialPtr->writeThread); serialPtr->writeThread = NULL; PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR); } serialPtr->validMask &= ~TCL_WRITABLE; DeleteCriticalSection(&serialPtr->csWrite); /* * Don't close the Win32 handle if the handle is a standard channel during * the thread exit process. Otherwise, one thread may kill the stdio of * another. */ if (!TclInThreadExit() || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle) && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) { if (CloseHandle(serialPtr->handle) == FALSE) { TclWinConvertError(GetLastError()); errorCode = errno; } } serialPtr->watchMask &= serialPtr->validMask; /* * Remove the file from the list of watched files. */ for (nextPtrPtr=&(tsdPtr->firstSerialPtr), infoPtr=*nextPtrPtr; infoPtr!=NULL; nextPtrPtr=&infoPtr->nextPtr, infoPtr=*nextPtrPtr) { if (infoPtr == (SerialInfo *)serialPtr) { *nextPtrPtr = infoPtr->nextPtr; break; } } /* * Wrap the error file into a channel and give it to the cleanup routine. */ if (serialPtr->writeBuf != NULL) { ckfree(serialPtr->writeBuf); serialPtr->writeBuf = NULL; } ckfree(serialPtr); if (errorCode == 0) { return result; } return errorCode; } static int SerialClose2Proc( ClientData instanceData, /* Pointer to SerialInfo structure. */ Tcl_Interp *interp, /* For error reporting. */ int flags) { if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return SerialCloseProc(instanceData, interp); } return EINVAL; } /* *---------------------------------------------------------------------- * * SerialBlockingRead -- * * Perform a blocking read into the buffer given. Returns count of how * many bytes were actually read, and an error indication. * * Results: * A count of how many bytes were read is returned and an error * indication is returned. * * Side effects: * Reads input from the actual channel. * *---------------------------------------------------------------------- */ static int SerialBlockingRead( SerialInfo *infoPtr, /* Serial info structure */ LPVOID buf, /* The input buffer pointer */ DWORD bufSize, /* The number of bytes to read */ LPDWORD lpRead, /* Returns number of bytes read */ LPOVERLAPPED osPtr) /* OVERLAPPED structure */ { /* * Perform overlapped blocking read. * 1. Reset the overlapped event * 2. Start overlapped read operation * 3. Wait for completion */ /* * Set Offset to ZERO, otherwise NT4.0 may report an error. */ osPtr->Offset = osPtr->OffsetHigh = 0; ResetEvent(osPtr->hEvent); if (!ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr)) { if (GetLastError() != ERROR_IO_PENDING) { /* * ReadFile failed, but it isn't delayed. Report error. */ return FALSE; } else { /* * Read is pending, wait for completion, timeout? */ if (!GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE)) { return FALSE; } } } else { /* * ReadFile completed immediately. */ } return TRUE; } /* *---------------------------------------------------------------------- * * SerialBlockingWrite -- * * Perform a blocking write from the buffer given. Returns count of how * many bytes were actually written, and an error indication. * * Results: * A count of how many bytes were written is returned and an error * indication is returned. * * Side effects: * Writes output to the actual channel. * *---------------------------------------------------------------------- */ static int SerialBlockingWrite( SerialInfo *infoPtr, /* Serial info structure */ LPVOID buf, /* The output buffer pointer */ DWORD bufSize, /* The number of bytes to write */ LPDWORD lpWritten, /* Returns number of bytes written */ LPOVERLAPPED osPtr) /* OVERLAPPED structure */ { int result; /* * Perform overlapped blocking write. * 1. Reset the overlapped event * 2. Remove these bytes from the output queue counter * 3. Start overlapped write operation * 3. Remove these bytes from the output queue counter * 4. Wait for completion * 5. Adjust the output queue counter */ ResetEvent(osPtr->hEvent); EnterCriticalSection(&infoPtr->csWrite); infoPtr->writeQueue -= bufSize; /* * Set Offset to ZERO, otherwise NT4.0 may report an error */ osPtr->Offset = osPtr->OffsetHigh = 0; result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr); LeaveCriticalSection(&infoPtr->csWrite); if (result == FALSE) { int err = GetLastError(); switch (err) { case ERROR_IO_PENDING: /* * Write is pending, wait for completion. */ if (!GetOverlappedResult(infoPtr->handle, osPtr, lpWritten, TRUE)) { return FALSE; } break; case ERROR_COUNTER_TIMEOUT: /* * Write timeout handled in SerialOutputProc. */ break; default: /* * WriteFile failed, but it isn't delayed. Report error. */ return FALSE; } } else { /* * WriteFile completed immediately. */ } EnterCriticalSection(&infoPtr->csWrite); infoPtr->writeQueue += (*lpWritten - bufSize); LeaveCriticalSection(&infoPtr->csWrite); return TRUE; } /* *---------------------------------------------------------------------- * * SerialInputProc -- * * Reads input from the IO channel into the buffer given. Returns count * of how many bytes were actually read, and an error indication. * * Results: * A count of how many bytes were read is returned and an error * indication is returned in an output argument. * * Side effects: * Reads input from the actual channel. * *---------------------------------------------------------------------- */ static int SerialInputProc( ClientData instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; DWORD bytesRead = 0; COMSTAT cStat; *errorCode = 0; /* * Check if there is a CommError pending from SerialCheckProc */ if (infoPtr->error & SERIAL_READ_ERRORS) { goto commError; } /* * Look for characters already pending in windows queue. This is the * mainly restored good old code from Tcl8.0 */ if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) { /* * Check for errors here, but not in the evSetup/Check procedures. */ if (infoPtr->error & SERIAL_READ_ERRORS) { goto commError; } if (infoPtr->flags & SERIAL_ASYNC) { /* * NON_BLOCKING mode: Avoid blocking by reading more bytes than * available in input buffer. */ if (cStat.cbInQue > 0) { if ((DWORD) bufSize > cStat.cbInQue) { bufSize = cStat.cbInQue; } } else { errno = *errorCode = EWOULDBLOCK; return -1; } } else { /* * BLOCKING mode: Tcl tries to read a full buffer of 4 kBytes here. */ if (cStat.cbInQue > 0) { if ((DWORD) bufSize > cStat.cbInQue) { bufSize = cStat.cbInQue; } } else { bufSize = 1; } } } if (bufSize == 0) { return bytesRead = 0; } /* * Perform blocking read. Doesn't block in non-blocking mode, because we * checked the number of available bytes. */ if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead, &infoPtr->osRead) == FALSE) { TclWinConvertError(GetLastError()); *errorCode = errno; return -1; } return bytesRead; commError: infoPtr->lastError = infoPtr->error; /* save last error code */ infoPtr->error = 0; /* reset error code */ *errorCode = EIO; /* to return read-error only once */ return -1; } /* *---------------------------------------------------------------------- * * SerialOutputProc -- * * Writes the given output on the IO channel. Returns count of how many * characters were actually written, and an error indication. * * Results: * A count of how many characters were written is returned and an error * indication is returned in an output argument. * * Side effects: * Writes output on the actual channel. * *---------------------------------------------------------------------- */ static int SerialOutputProc( ClientData instanceData, /* Serial state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; DWORD bytesWritten, timeout; *errorCode = 0; /* * At EXIT Tcl tries to flush all open channels in blocking mode. We avoid * blocking output after ExitProc or CloseHandler(chan) has been called by * checking the corresponding variables. */ if (!initialized || TclInExit()) { return toWrite; } /* * Check if there is a CommError pending from SerialCheckProc */ if (infoPtr->error & SERIAL_WRITE_ERRORS) { infoPtr->lastError = infoPtr->error; /* save last error code */ infoPtr->error = 0; /* reset error code */ errno = EIO; goto error; } timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE; if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) { /* * The writer thread is blocked waiting for a write to complete and * the channel is in non-blocking mode. */ errno = EWOULDBLOCK; goto error1; } /* * Check for a background error on the last write. */ if (infoPtr->writeError) { TclWinConvertError(infoPtr->writeError); infoPtr->writeError = 0; goto error1; } /* * Remember the number of bytes in output queue */ EnterCriticalSection(&infoPtr->csWrite); infoPtr->writeQueue += toWrite; LeaveCriticalSection(&infoPtr->csWrite); if (infoPtr->flags & SERIAL_ASYNC) { /* * The serial is non-blocking, so copy the data into the output buffer * and restart the writer thread. */ if (toWrite > infoPtr->writeBufLen) { /* * Reallocate the buffer to be large enough to hold the data. */ if (infoPtr->writeBuf) { ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->evWritable); TclPipeThreadSignal(&infoPtr->writeTI); bytesWritten = (DWORD) toWrite; } else { /* * In the blocking case, just try to write the buffer directly. This * avoids an unnecessary copy. */ if (!SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, &infoPtr->osWrite)) { goto writeError; } if (bytesWritten != (DWORD) toWrite) { /* * Write timeout. */ infoPtr->lastError |= CE_PTO; errno = EIO; goto error; } } return (int) bytesWritten; writeError: TclWinConvertError(GetLastError()); error: /* * Reset the output queue counter on error during blocking output */ /* * EnterCriticalSection(&infoPtr->csWrite); * infoPtr->writeQueue = 0; * LeaveCriticalSection(&infoPtr->csWrite); */ error1: *errorCode = errno; return -1; } /* *---------------------------------------------------------------------- * * SerialEventProc -- * * This function is invoked by Tcl_ServiceEvent when a file event reaches * the front of the event queue. This procedure invokes Tcl_NotifyChannel * on the serial. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the notifier callback does. * *---------------------------------------------------------------------- */ static int SerialEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { SerialEvent *serialEvPtr = (SerialEvent *)evPtr; SerialInfo *infoPtr; int mask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return 0; } /* * Search through the list of watched serials for the one whose handle * matches the event. We do this rather than simply dereferencing the * handle in the event so that serials can be deleted while the event is * in the queue. */ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (serialEvPtr->infoPtr == infoPtr) { infoPtr->flags &= ~(SERIAL_PENDING); break; } } /* * Remove stale events. */ if (!infoPtr) { return 1; } /* * Check to see if the serial is readable. Note that we can't tell if a * serial is writable, so we always report it as being writable unless we * have detected EOF. */ mask = 0; if (infoPtr->watchMask & TCL_WRITABLE) { if (infoPtr->writable) { mask |= TCL_WRITABLE; infoPtr->writable = 0; } } if (infoPtr->watchMask & TCL_READABLE) { if (infoPtr->readable) { mask |= TCL_READABLE; infoPtr->readable = 0; } } /* * Inform the channel of the events. */ Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask); return 1; } /* *---------------------------------------------------------------------- * * SerialWatchProc -- * * Called by the notifier to set up to watch for events on this channel. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void SerialWatchProc( ClientData instanceData, /* Serial state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { SerialInfo **nextPtrPtr, *ptr; SerialInfo *infoPtr = (SerialInfo *) instanceData; int oldMask = infoPtr->watchMask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Since the file is always ready for events, we set the block time so we * will poll. */ infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { if (!oldMask) { infoPtr->nextPtr = tsdPtr->firstSerialPtr; tsdPtr->firstSerialPtr = infoPtr; } SerialBlockTime(infoPtr->blockTime); } else if (oldMask) { /* * Remove the serial port from the list of watched serial ports. */ for (nextPtrPtr=&(tsdPtr->firstSerialPtr), ptr=*nextPtrPtr; ptr!=NULL; nextPtrPtr=&ptr->nextPtr, ptr=*nextPtrPtr) { if (infoPtr == ptr) { *nextPtrPtr = ptr->nextPtr; break; } } } } /* *---------------------------------------------------------------------- * * SerialGetHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a * command serial port based channel. * * Results: * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no * handle for the specified direction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int SerialGetHandleProc( ClientData instanceData, /* The serial state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; *handlePtr = (ClientData) infoPtr->handle; return TCL_OK; } /* *---------------------------------------------------------------------- * * SerialWriterThread -- * * This function runs in a separate thread and writes data onto a serial. * * Results: * Always returns 0. * * Side effects: * Signals the main thread when an output operation is completed. May * cause the main thread to wake up by posting a message. * *---------------------------------------------------------------------- */ static DWORD WINAPI SerialWriterThread( LPVOID arg) { TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg; SerialInfo *infoPtr = NULL; /* access info only after success init/wait */ DWORD bytesWritten, toWrite; char *buf; OVERLAPPED myWrite; /* Have an own OVERLAPPED in this thread. */ for (;;) { /* * Wait for the main thread to signal before attempting to write. */ if (!TclPipeThreadWaitForSignal(&pipeTI)) { /* exit */ break; } infoPtr = (SerialInfo *)pipeTI->clientData; buf = infoPtr->writeBuf; toWrite = infoPtr->toWrite; myWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); /* * Loop until all of the bytes are written or an error occurs. */ while (toWrite > 0) { /* * Check for pending writeError. Ignore all write operations until * the user has been notified. */ if (infoPtr->writeError) { break; } if (SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, &myWrite) == FALSE) { infoPtr->writeError = GetLastError(); break; } if (bytesWritten != toWrite) { /* * Write timeout. */ infoPtr->writeError = ERROR_WRITE_FAULT; break; } toWrite -= bytesWritten; buf += bytesWritten; } CloseHandle(myWrite.hEvent); /* * Signal the main thread by signalling the evWritable event and then * waking up the notifier thread. */ SetEvent(infoPtr->evWritable); /* * Alert the foreground thread. Note that we need to treat this like a * critical section so the foreground thread does not terminate this * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&serialMutex); if (infoPtr->threadId != NULL) { /* * TIP #218: When in flight ignore the event, no one will receive * it anyway. */ Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&serialMutex); } /* Worker exit, so inform the main thread or free TI-structure (if owned) */ TclPipeThreadExit(&pipeTI); return 0; } /* *---------------------------------------------------------------------- * * TclWinSerialOpen -- * * Opens or Reopens the serial port with the OVERLAPPED FLAG set * * Results: * Returns the new handle, or INVALID_HANDLE_VALUE. * If an existing channel is specified it is closed and reopened. * * Side effects: * May close/reopen the original handle * *---------------------------------------------------------------------- */ HANDLE TclWinSerialOpen( HANDLE handle, const WCHAR *name, DWORD access) { SerialInit(); /* * If an open channel is specified, close it */ if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) { return INVALID_HANDLE_VALUE; } /* * Multithreaded I/O needs the overlapped flag set otherwise * ClearCommError blocks under Windows NT/2000 until serial output is * finished */ handle = CreateFileW(name, access, 0, 0, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); return handle; } /* *---------------------------------------------------------------------- * * TclWinOpenSerialChannel -- * * Constructs a Serial port channel for the specified standard OS handle. * This is a helper function to break up the construction of channels * into File, Console, or Serial. * * Results: * Returns the new channel, or NULL. * * Side effects: * May open the channel * *---------------------------------------------------------------------- */ Tcl_Channel TclWinOpenSerialChannel( HANDLE handle, char *channelName, int permissions) { SerialInfo *infoPtr; SerialInit(); infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); infoPtr->validMask = permissions; infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; infoPtr->readable = 0; infoPtr->writable = 1; infoPtr->toWrite = infoPtr->writeQueue = 0; infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME; infoPtr->lastEventTime = 0; infoPtr->lastError = infoPtr->error = 0; infoPtr->threadId = Tcl_GetCurrentThread(); infoPtr->sysBufRead = 4096; infoPtr->sysBufWrite = 4096; /* * Use the pointer to keep the channel names unique, in case the handles * are shared between multiple channels (stdin/stdout). */ snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); /* * Default is blocking. */ SetCommTimeouts(handle, &no_timeout); InitializeCriticalSection(&infoPtr->csWrite); if (permissions & TCL_READABLE) { infoPtr->osRead.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); } if (permissions & TCL_WRITABLE) { /* * Initially the channel is writable and the writeThread is idle. */ infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread, TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->evWritable), 0, NULL); } /* * Files have default translation of AUTO and ^Z eof char, which means * that a ^Z will be accepted as EOF when reading. */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } /* *---------------------------------------------------------------------- * * SerialErrorStr -- * * Converts a Win32 serial error code to a list of readable errors. * * Results: * None. * * Side effects: * Generates readable errors in the supplied DString. * *---------------------------------------------------------------------- */ static void SerialErrorStr( DWORD error, /* Win32 serial error code. */ Tcl_DString *dsPtr) /* Where to store string. */ { if (error & CE_RXOVER) { Tcl_DStringAppendElement(dsPtr, "RXOVER"); } if (error & CE_OVERRUN) { Tcl_DStringAppendElement(dsPtr, "OVERRUN"); } if (error & CE_RXPARITY) { Tcl_DStringAppendElement(dsPtr, "RXPARITY"); } if (error & CE_FRAME) { Tcl_DStringAppendElement(dsPtr, "FRAME"); } if (error & CE_BREAK) { Tcl_DStringAppendElement(dsPtr, "BREAK"); } if (error & CE_TXFULL) { Tcl_DStringAppendElement(dsPtr, "TXFULL"); } if (error & CE_PTO) { /* PTO used to signal WRITE-TIMEOUT */ Tcl_DStringAppendElement(dsPtr, "TIMEOUT"); } if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) { char buf[TCL_INTEGER_SPACE + 1]; snprintf(buf, sizeof(buf), "%ld", error); Tcl_DStringAppendElement(dsPtr, buf); } } /* *---------------------------------------------------------------------- * * SerialModemStatusStr -- * * Converts a Win32 modem status list of readable flags * * Result: * None. * * Side effects: * Appends modem status flag strings to the given DString. * *---------------------------------------------------------------------- */ static void SerialModemStatusStr( DWORD status, /* Win32 modem status. */ Tcl_DString *dsPtr) /* Where to store string. */ { Tcl_DStringAppendElement(dsPtr, "CTS"); Tcl_DStringAppendElement(dsPtr, (status & MS_CTS_ON) ? "1" : "0"); Tcl_DStringAppendElement(dsPtr, "DSR"); Tcl_DStringAppendElement(dsPtr, (status & MS_DSR_ON) ? "1" : "0"); Tcl_DStringAppendElement(dsPtr, "RING"); Tcl_DStringAppendElement(dsPtr, (status & MS_RING_ON) ? "1" : "0"); Tcl_DStringAppendElement(dsPtr, "DCD"); Tcl_DStringAppendElement(dsPtr, (status & MS_RLSD_ON) ? "1" : "0"); } /* *---------------------------------------------------------------------- * * SerialSetOptionProc -- * * Sets an option on a channel. * * Results: * A standard Tcl result. Also sets the interp's result on error if * interp is not NULL. * * Side effects: * May modify an option on a device. * *---------------------------------------------------------------------- */ static int SerialSetOptionProc( ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { SerialInfo *infoPtr; DCB dcb; BOOL result, flag; size_t len, vlen; Tcl_DString ds; const WCHAR *native; int argc; const char **argv; infoPtr = (SerialInfo *) instanceData; /* * Parse options. This would be far easier if we had Tcl_Objs to work with * as that would let us use Tcl_GetIndexFromObj()... */ len = strlen(optionName); vlen = strlen(value); /* * Option -mode baud,parity,databits,stopbits */ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { goto getStateFailed; } native = (const WCHAR *)Tcl_WinUtfToTChar(value, -1, &ds); result = BuildCommDCBW(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -mode: should be baud,parity,data,stop", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); } return TCL_ERROR; } /* * Default settings for serial communications. */ dcb.fBinary = TRUE; dcb.fErrorChar = FALSE; dcb.fNull = FALSE; dcb.fAbortOnError = FALSE; if (!SetCommState(infoPtr->handle, &dcb)) { goto setStateFailed; } return TCL_OK; } /* * Option -handshake none|xonxoff|rtscts|dtrdsr */ if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { goto getStateFailed; } /* * Reset all handshake options. DTR and RTS are ON by default. */ dcb.fOutX = dcb.fInX = FALSE; dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE; dcb.fDtrControl = DTR_CONTROL_ENABLE; dcb.fRtsControl = RTS_CONTROL_ENABLE; dcb.fTXContinueOnXoff = FALSE; /* * Adjust the handshake limits. Yes, the XonXoff limits seem to * influence even hardware handshake. */ dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (strncasecmp(value, "NONE", vlen) == 0) { /* * Leave all handshake options disabled. */ } else if (strncasecmp(value, "XONXOFF", vlen) == 0) { dcb.fOutX = dcb.fInX = TRUE; } else if (strncasecmp(value, "RTSCTS", vlen) == 0) { dcb.fOutxCtsFlow = TRUE; dcb.fRtsControl = RTS_CONTROL_HANDSHAKE; } else if (strncasecmp(value, "DTRDSR", vlen) == 0) { dcb.fOutxDsrFlow = TRUE; dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -handshake: must be one of" " xonxoff, rtscts, dtrdsr or none", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL); } return TCL_ERROR; } if (!SetCommState(infoPtr->handle, &dcb)) { goto setStateFailed; } return TCL_OK; } /* * Option -xchar {\x11 \x13} */ if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { goto getStateFailed; } if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if (argc != 2) { badXchar: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -xchar: should be a list of" " two elements with each a single character", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } ckfree(argv); return TCL_ERROR; } /* * These dereferences are safe, even in the zero-length string cases, * because that just makes the xon/xoff character into NUL. When the * character looks like it is UTF-8 encoded, decode it before casting * into the format required for the Win guts. Note that this does not * convert character sets; it is expected that when people set the * control characters to something large and custom, they'll know the * hex/octal value rather than the printable form. */ dcb.XonChar = argv[0][0]; dcb.XoffChar = argv[1][0]; if (argv[0][0] & 0x80 || argv[1][0] & 0x80) { int character; int charLen; charLen = TclUtfToUCS4(argv[0], &character); if ((character & ~0xFF) || argv[0][charLen]) { goto badXchar; } dcb.XonChar = (char) character; charLen = TclUtfToUCS4(argv[1], &character); if ((character & ~0xFF) || argv[1][charLen]) { goto badXchar; } dcb.XoffChar = (char) character; } ckfree(argv); if (!SetCommState(infoPtr->handle, &dcb)) { goto setStateFailed; } return TCL_OK; } /* * Option -ttycontrol {DTR 1 RTS 0 BREAK 0} */ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { int i, res = TCL_OK; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if ((argc % 2) == 1) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -ttycontrol: should be " "a list of signal,value pairs", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL); } ckfree(argv); return TCL_ERROR; } for (i = 0; i < argc - 1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { res = TCL_ERROR; break; } if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETDTR : CLRDTR))) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't set DTR signal", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", NULL); } res = TCL_ERROR; break; } } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETRTS : CLRRTS))) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't set RTS signal", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", NULL); } res = TCL_ERROR; break; } } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETBREAK : CLRBREAK))) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't set BREAK signal", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", NULL); } res = TCL_ERROR; break; } } else { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad signal name \"%s\" for -ttycontrol: must be" " DTR, RTS or BREAK", argv[i])); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL", NULL); } res = TCL_ERROR; break; } } ckfree(argv); return res; } /* * Option -sysbuffer {read_size write_size} * Option -sysbuffer read_size */ if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) { /* * -sysbuffer 4096 or -sysbuffer {64536 4096} */ size_t inSize = (size_t) -1, outSize = (size_t) -1; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if (argc == 1) { inSize = atoi(argv[0]); outSize = infoPtr->sysBufWrite; } else if (argc == 2) { inSize = atoi(argv[0]); outSize = atoi(argv[1]); } ckfree(argv); if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -sysbuffer: should be " "a list of one or two integers > 0", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL); } return TCL_ERROR; } if (!SetupComm(infoPtr->handle, inSize, outSize)) { if (interp != NULL) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't setup comm buffers: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } infoPtr->sysBufRead = inSize; infoPtr->sysBufWrite = outSize; /* * Adjust the handshake limits. Yes, the XonXoff limits seem to * influence even hardware handshake. */ if (!GetCommState(infoPtr->handle, &dcb)) { goto getStateFailed; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (!SetCommState(infoPtr->handle, &dcb)) { goto setStateFailed; } return TCL_OK; } /* * Option -pollinterval msec */ if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) { if (Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } /* * Option -timeout msec */ if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) { int msec; COMMTIMEOUTS tout = {0,0,0,0,0}; if (Tcl_GetInt(interp, value, &msec) != TCL_OK) { return TCL_ERROR; } tout.ReadTotalTimeoutConstant = msec; if (!SetCommTimeouts(infoPtr->handle, &tout)) { if (interp != NULL) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't set comm timeouts: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, "mode handshake pollinterval sysbuffer timeout ttycontrol xchar"); getStateFailed: if (interp != NULL) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get comm state: %s", Tcl_PosixError(interp))); } return TCL_ERROR; setStateFailed: if (interp != NULL) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't set comm state: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * SerialGetOptionProc -- * * Gets a mode associated with an IO channel. If the optionName arg is * non NULL, retrieves the value of that option. If the optionName arg is * NULL, retrieves a list of alternating option names and values for the * given channel. * * Results: * A standard Tcl result. Also sets the supplied DString to the string * value of the option(s) returned. * * Side effects: * The string returned by this function is in static storage and may be * reused at any time subsequent to the call. * *---------------------------------------------------------------------- */ static int SerialGetOptionProc( ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { SerialInfo *infoPtr; DCB dcb; size_t len; int valid = 0; /* Flag if valid option parsed. */ infoPtr = (SerialInfo *) instanceData; if (optionName == NULL) { len = 0; } else { len = strlen(optionName); } /* * Get option -mode */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-mode"); } if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) { char parity; const char *stop; char buf[2 * TCL_INTEGER_SPACE + 16]; if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get comm state: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } valid = 1; parity = 'n'; if (dcb.Parity <= 4) { parity = "noems"[dcb.Parity]; } stop = (dcb.StopBits == ONESTOPBIT) ? "1" : (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2"; snprintf(buf, sizeof(buf), "%ld,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize, stop); Tcl_DStringAppendElement(dsPtr, buf); } /* * Get option -pollinterval */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-pollinterval"); } if (len==0 || (len>1 && strncmp(optionName, "-pollinterval", len)==0)) { char buf[TCL_INTEGER_SPACE + 1]; valid = 1; snprintf(buf, sizeof(buf), "%d", infoPtr->blockTime); Tcl_DStringAppendElement(dsPtr, buf); } /* * Get option -sysbuffer */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-sysbuffer"); Tcl_DStringStartSublist(dsPtr); } if (len==0 || (len>1 && strncmp(optionName, "-sysbuffer", len) == 0)) { char buf[TCL_INTEGER_SPACE + 1]; valid = 1; snprintf(buf, sizeof(buf), "%ld", infoPtr->sysBufRead); Tcl_DStringAppendElement(dsPtr, buf); snprintf(buf, sizeof(buf), "%ld", infoPtr->sysBufWrite); Tcl_DStringAppendElement(dsPtr, buf); } if (len == 0) { Tcl_DStringEndSublist(dsPtr); } /* * Get option -xchar */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-xchar"); Tcl_DStringStartSublist(dsPtr); } if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) { char buf[4]; valid = 1; if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get comm state: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } buf[1] = '\0'; buf[0] = dcb.XonChar; Tcl_DStringAppendElement(dsPtr, buf); buf[0] = dcb.XoffChar; Tcl_DStringAppendElement(dsPtr, buf); } if (len == 0) { Tcl_DStringEndSublist(dsPtr); } /* * Get option -lasterror * * Option is readonly and returned by [fconfigure chan -lasterror] but not * returned by unnamed [fconfigure chan]. */ if (len>1 && strncmp(optionName, "-lasterror", len)==0) { valid = 1; SerialErrorStr(infoPtr->lastError, dsPtr); } /* * get option -queue * * Option is readonly and returned by [fconfigure chan -queue]. */ if (len>1 && strncmp(optionName, "-queue", len)==0) { char buf[TCL_INTEGER_SPACE + 1]; COMSTAT cStat; DWORD error; int inBuffered, outBuffered, count; valid = 1; /* * Query the pending data in Tcl's internal queues. */ inBuffered = Tcl_InputBuffered(infoPtr->channel); outBuffered = Tcl_OutputBuffered(infoPtr->channel); /* * Query the number of bytes in our output queue: * 1. The bytes pending in the output thread * 2. The bytes in the system drivers buffer * The writer thread should not interfere this action. */ EnterCriticalSection(&infoPtr->csWrite); ClearCommError(infoPtr->handle, &error, &cStat); count = (int) cStat.cbOutQue + infoPtr->writeQueue; LeaveCriticalSection(&infoPtr->csWrite); snprintf(buf, sizeof(buf), "%ld", inBuffered + cStat.cbInQue); Tcl_DStringAppendElement(dsPtr, buf); snprintf(buf, sizeof(buf), "%d", outBuffered + count); Tcl_DStringAppendElement(dsPtr, buf); } /* * get option -ttystatus * * Option is readonly and returned by [fconfigure chan -ttystatus] but not * returned by unnamed [fconfigure chan]. */ if (len>4 && strncmp(optionName, "-ttystatus", len)==0) { DWORD status; if (!GetCommModemStatus(infoPtr->handle, &status)) { if (interp != NULL) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get tty status: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } valid = 1; SerialModemStatusStr(status, dsPtr); } if (valid) { return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } /* *---------------------------------------------------------------------- * * SerialThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void SerialThreadActionProc( ClientData instanceData, int action) { SerialInfo *infoPtr = (SerialInfo *) instanceData; /* * We do not access firstSerialPtr in the thread structures. This is not * for all serials managed by the thread, but only those we are watching. * Removal of the fileevent handlers before transfer thus takes care of * this structure. */ Tcl_MutexLock(&serialMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { /* * We can't copy the thread information from the channel when the * channel is created. At this time the channel back pointer has not * been set yet. However in that case the threadId has already been * set by TclpCreateCommandChannel itself, so the structure is still * good. */ SerialInit(); if (infoPtr->channel != NULL) { infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&serialMutex); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinSock.c0000644000175000017500000025615314565156356014712 0ustar sergeisergei/* * tclWinSock.c -- * * This file contains Windows-specific socket related code. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * ----------------------------------------------------------------------- * The order and naming of functions in this file should minimize * the file diff to tclUnixSock.c. * ----------------------------------------------------------------------- * * General information on how this module works. * * - Each Tcl-thread with its sockets maintains an internal window to receive * socket messages from the OS. * * - To ensure that message reception is always running this window is * actually owned and handled by an internal thread. This we call the * co-thread of Tcl's thread. * * - The whole structure is set up by InitSockets() which is called for each * Tcl thread. The implementation of the co-thread is in SocketThread(), * and the messages are handled by SocketProc(). The connection between * both is not directly visible, it is done through a Win32 window class. * This class is initialized by InitSockets() as well, and used in the * creation of the message receiver windows. * * - An important thing to note is that *both* thread and co-thread have * access to the list of sockets maintained in the private TSD data of the * thread. The co-thread was given access to it upon creation through the * new thread's client-data. * * Because of this dual access the TSD data contains an OS mutex, the * "socketListLock", to mediate exclusion between thread and co-thread. * * The co-thread's access is all in SocketProc(). The thread's access is * through SocketEventProc() (1) and the functions called by it. * * (Ad 1) This is the handler function for all queued socket events, which * all the OS messages are translated to through the EventSource (2) * driven by the OS messages. * * (Ad 2) The main functions for this are SocketSetupProc() and * SocketCheckProc(). */ #include "tclWinInt.h" #ifdef _MSC_VER # pragma comment (lib, "ws2_32") #endif /* * Support for control over sockets' KEEPALIVE and NODELAY behavior is * currently disabled. */ #undef TCL_FEATURE_KEEPALIVE_NAGLE /* * Make sure to remove the redirection defines set in tclWinPort.h that is in * use in other sections of the core, except for us. */ #undef getservbyname #undef getsockopt #undef setsockopt /* * Helper macros to make parts of this file clearer. The macros do exactly * what they say on the tin. :-) They also only ever refer to their arguments * once, and so can be used without regard to side effects. */ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) #define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ #define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) #define SOCK_TEMPLATE "sock%p" /* * The following variable is used to tell whether this module has been * initialized. If 1, initialization of sockets was successful, if -1 then * socket initialization failed (WSAStartup failed). */ static int initialized = 0; static const WCHAR className[] = L"TclSocket"; TCL_DECLARE_MUTEX(socketMutex) /* * The following defines declare the messages used on socket windows. */ #define SOCKET_MESSAGE WM_USER+1 #define SOCKET_SELECT WM_USER+2 #define SOCKET_TERMINATE WM_USER+3 #define SELECT TRUE #define UNSELECT FALSE /* * This is needed to comply with the strict aliasing rules of GCC, but it also * simplifies casting between the different sockaddr types. */ typedef union { struct sockaddr sa; struct sockaddr_in sa4; struct sockaddr_in6 sa6; struct sockaddr_storage sas; } address; #ifndef IN6_ARE_ADDR_EQUAL #define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL #endif /* * This structure describes per-instance state of a tcp-based channel. */ typedef struct TcpState TcpState; typedef struct TcpFdList { TcpState *statePtr; SOCKET fd; struct TcpFdList *next; } TcpFdList; struct TcpState { Tcl_Channel channel; /* Channel associated with this socket. */ struct TcpFdList *sockets; /* Windows SOCKET handle. */ int flags; /* Bit field comprised of the flags described * below. */ int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events are interesting. */ volatile int readyEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events have occurred. * Set by notifier thread, access must be * protected by semaphore */ int selectEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events are currently being * selected. */ volatile int acceptEventCount; /* Count of the current number of FD_ACCEPTs * that have arrived and not yet processed. * Set by notifier thread, access must be * protected by semaphore */ Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */ void *acceptProcData; /* The data for the accept proc. */ /* * Only needed for client sockets */ struct addrinfo *addrlist; /* Addresses to connect to. */ struct addrinfo *addr; /* Iterator over addrlist. */ struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ int connectError; /* Cache status of async socket. */ int cachedBlocking; /* Cache blocking mode of async socket. */ volatile int notifierConnectError; /* Async connect error set by notifier thread. * This error is still a windows error code. * Access must be protected by semaphore */ struct TcpState *nextPtr; /* The next socket on the per-thread socket * list. */ }; /* * These bits may be OR'ed together into the "flags" field of a TcpState * structure. */ #define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */ #define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ #define SOCKET_EOF (1<<2) /* A zero read happened on the * socket. */ #define SOCKET_PENDING (1<<3) /* A message has been sent for this * socket */ #define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to * process an async connect. This * flag indicates that reentry is * still pending */ #define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ /* * The following structure is what is added to the Tcl event queue when a * socket event occurs. */ typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ SOCKET socket; /* Socket descriptor that is ready. Used to * find the TcpState structure for the file * (can't point directly to the TcpState * structure because it could go away while * the event is queued). */ } SocketEvent; /* * This defines the minimum buffersize maintained by the kernel. */ #define TCP_BUFFER_SIZE 4096 typedef struct { HWND hwnd; /* Handle to window for socket messages. */ HANDLE socketThread; /* Thread handling the window */ Tcl_ThreadId threadId; /* Parent thread. */ HANDLE readyEvent; /* Event indicating that a socket event is * ready. Also used to indicate that the * socketThread has been initialized and has * started. */ HANDLE socketListLock; /* Win32 Event to lock the socketList */ TcpState *pendingTcpState; /* This socket is opened but not jet in the * list. This value is also checked by * the event structure. */ TcpState *socketList; /* Every open socket in this thread has an * entry on this list. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; static WNDCLASSW windowClass; /* * Static routines for this file: */ static int TcpConnect(Tcl_Interp *interp, TcpState *state); static void InitSockets(void); static TcpState * NewSocketInfo(SOCKET socket); static void SocketExitHandler(void *clientData); static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); static int SocketsEnabled(void); static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr); static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); static int WaitForSocketEvent(TcpState *statePtr, int events, int *errorCodePtr); static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket); static int FindFDInList(TcpState *statePtr, SOCKET socket); static DWORD WINAPI SocketThread(LPVOID arg); static void TcpThreadActionProc(void *instanceData, int action); static Tcl_EventCheckProc SocketCheckProc; static Tcl_EventProc SocketEventProc; static Tcl_EventSetupProc SocketSetupProc; static Tcl_DriverBlockModeProc TcpBlockModeProc; static Tcl_DriverCloseProc TcpCloseProc; static Tcl_DriverClose2Proc TcpClose2Proc; static Tcl_DriverSetOptionProc TcpSetOptionProc; static Tcl_DriverGetOptionProc TcpGetOptionProc; static Tcl_DriverInputProc TcpInputProc; static Tcl_DriverOutputProc TcpOutputProc; static Tcl_DriverWatchProc TcpWatchProc; static Tcl_DriverGetHandleProc TcpGetHandleProc; /* * This structure describes the channel type structure for TCP socket * based IO: */ static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TcpCloseProc, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TcpSetOptionProc, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Initialize notifier. */ TcpGetHandleProc, /* Get OS handles out of channel. */ TcpClose2Proc, /* Close2 proc. */ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ TcpThreadActionProc, /* thread action proc. */ NULL /* truncate proc. */ }; /* * The following variable holds the network name of this host. */ static TclInitProcessGlobalValueProc InitializeHostName; static ProcessGlobalValue hostName = {0, 0, NULL, NULL, InitializeHostName, NULL, NULL}; /* * Simple wrapper round the SendMessage syscall. */ #define SendSelectMessage(tsdPtr, message, payload) \ SendMessageW((tsdPtr)->hwnd, SOCKET_SELECT, \ (WPARAM) (message), (LPARAM) (payload)) /* * Address print debug functions */ #if 0 void printaddrinfo( struct addrinfo *ai, char *prefix) { char host[NI_MAXHOST], port[NI_MAXSERV]; getnameinfo(ai->ai_addr, ai->ai_addrlen, host, sizeof(host), port, sizeof(port), NI_NUMERICHOST|NI_NUMERICSERV); } void printaddrinfolist( struct addrinfo *addrlist, char *prefix) { struct addrinfo *ai; for (ai = addrlist; ai != NULL; ai = ai->ai_next) { printaddrinfo(ai, prefix); } } #endif /* *---------------------------------------------------------------------- * * InitializeHostName -- * * This routine sets the process global value of the name of the local * host on which the process is running. * * Results: * None. * *---------------------------------------------------------------------- */ void InitializeHostName( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { WCHAR wbuf[256]; DWORD length = sizeof(wbuf)/sizeof(WCHAR); Tcl_DString ds; if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) { /* * Convert string from native to UTF then change to lowercase. */ Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &ds)); } else { Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { /* * The buffer size of 256 is recommended by the MSDN page that * documents gethostname() as being always adequate. */ Tcl_DString inDs; Tcl_DStringInit(&inDs); Tcl_DStringSetLength(&inDs, 256); if (gethostname(Tcl_DStringValue(&inDs), Tcl_DStringLength(&inDs)) == 0) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, &ds); } Tcl_DStringFree(&inDs); } } *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); Tcl_DStringFree(&ds); } /* *---------------------------------------------------------------------- * * Tcl_GetHostName -- * * Returns the name of the local host. * * Results: * A string containing the network name for this machine, or an empty * string if we can't figure out the name. The caller must not modify or * free this string. * * Side effects: * Caches the name to return for future calls. * *---------------------------------------------------------------------- */ const char * Tcl_GetHostName(void) { return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); } /* *---------------------------------------------------------------------- * * TclpHasSockets -- * * This function determines whether sockets are available on the current * system and returns an error in interp if they are not. Note that * interp may be NULL. * * Results: * Returns TCL_OK if the system supports sockets, or TCL_ERROR with an * error in interp (if non-NULL). * * Side effects: * If not already prepared, initializes the TSD structure and socket * message handling thread associated to the calling thread for the * subsystem of the driver. * *---------------------------------------------------------------------- */ int TclpHasSockets( Tcl_Interp *interp) /* Where to write an error message if sockets * are not present, or NULL if no such message * is to be written. */ { Tcl_MutexLock(&socketMutex); InitSockets(); Tcl_MutexUnlock(&socketMutex); if (SocketsEnabled()) { return TCL_OK; } if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "sockets are not available on this system", -1)); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclpFinalizeSockets -- * * This function is called from Tcl_FinalizeThread to finalize the * platform specific socket subsystem. Also, it may be called from within * this module to cleanup the state if unable to initialize the sockets * subsystem. * * Results: * None. * * Side effects: * Deletes the event source and destroys the socket thread. * *---------------------------------------------------------------------- */ void TclpFinalizeSockets(void) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Careful! This is a finalizer! */ if (tsdPtr == NULL) { return; } if (tsdPtr->socketThread != NULL) { if (tsdPtr->hwnd != NULL) { PostMessageW(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); /* * Wait for the thread to exit. This ensures that we are * completely cleaned up before we leave this function. */ WaitForSingleObject(tsdPtr->readyEvent, INFINITE); tsdPtr->hwnd = NULL; } CloseHandle(tsdPtr->socketThread); tsdPtr->socketThread = NULL; } if (tsdPtr->readyEvent != NULL) { CloseHandle(tsdPtr->readyEvent); tsdPtr->readyEvent = NULL; } if (tsdPtr->socketListLock != NULL) { CloseHandle(tsdPtr->socketListLock); tsdPtr->socketListLock = NULL; } Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); } /* *---------------------------------------------------------------------- * * TcpBlockModeProc -- * * This function is invoked by the generic IO level to set blocking and * nonblocking mode on a TCP socket based channel. * * Results: * 0 if successful, errno when failed. * * Side effects: * Sets the device into blocking or nonblocking mode. * *---------------------------------------------------------------------- */ static int TcpBlockModeProc( void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { TcpState *statePtr = (TcpState *)instanceData; if (mode == TCL_MODE_NONBLOCKING) { SET_BITS(statePtr->flags, TCP_NONBLOCKING); } else { CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); } return 0; } /* *---------------------------------------------------------------------- * * WaitForConnect -- * * Check the state of an async connect process. If a connection attempt * terminated, process it, which may finalize it or may start the next * attempt. If a connect error occures, it is saved in * statePtr->connectError to be reported by 'fconfigure -error'. * * There are two modes of operation, defined by errorCodePtr: * * non-NULL: Called by explicite read/write command. Block if socket * is blocking. * May return two error codes: * * EWOULDBLOCK: if connect is still in progress * * ENOTCONN: if connect failed. This would be the error message * of a recv or sendto syscall so this is emulated here. * * Null: Called by a background operation. Do not block and don't * return any error code. * * Results: * 0 if the connection has completed, -1 if still in progress or there is * an error. * * Side effects: * Processes socket events off the system queue. May process * asynchronous connect. * *---------------------------------------------------------------------- */ static int WaitForConnect( TcpState *statePtr, /* State of the socket. */ int *errorCodePtr) /* Where to store errors? A passed * null-pointer activates background mode. */ { int result; int oldMode; ThreadSpecificData *tsdPtr; /* * Check if an async connect failed already and error reporting is * demanded, return the error ENOTCONN. */ if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { *errorCodePtr = ENOTCONN; return -1; } /* * Check if an async connect is running. If not return ok */ if (!GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { return 0; } /* * Be sure to disable event servicing so we are truly modal. */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); /* * Loop in the blocking case until the connect signal is present */ while (1) { /* * Get the statePtr lock. */ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Check for connect event. */ if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) { /* * Consume the connect event. */ CLEAR_BITS(statePtr->readyEvents, FD_CONNECT); /* * For blocking sockets and foreground processing, disable async * connect as we continue now synchronously. */ if (errorCodePtr != NULL && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); } /* * Free list lock. */ SetEvent(tsdPtr->socketListLock); /* * Continue connect. If switched to synchronous connect, the * connect is terminated. */ result = TcpConnect(NULL, statePtr); /* * Restore event service mode. */ (void) Tcl_SetServiceMode(oldMode); /* * Check for Successful connect or async connect restart */ if (result == TCL_OK) { /* * Check for async connect restart (not possible for * foreground blocking operation) */ if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { if (errorCodePtr != NULL) { *errorCodePtr = EWOULDBLOCK; } return -1; } return 0; } /* * Connect finally failed. For foreground operation return * ENOTCONN. */ if (errorCodePtr != NULL) { *errorCodePtr = ENOTCONN; } return -1; } /* * Free list lock. */ SetEvent(tsdPtr->socketListLock); /* * Background operation returns with no action as there was no connect * event */ if (errorCodePtr == NULL) { return -1; } /* * A non blocking socket waiting for an asynchronous connect * returns directly the error EWOULDBLOCK */ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; return -1; } /* * Wait until something happens. */ WaitForSingleObject(tsdPtr->readyEvent, INFINITE); } } /* *---------------------------------------------------------------------- * * TcpInputProc -- * * This function is invoked by the generic IO level to read input from a * TCP socket based channel. * * Results: * The number of bytes read is returned or -1 on error. An output * argument contains the POSIX error code on error, or zero if no error * occurred. * * Side effects: * Reads input from the input device of the channel. * *---------------------------------------------------------------------- */ static int TcpInputProc( void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { TcpState *statePtr = (TcpState *)instanceData; int bytesRead; DWORD error; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; /* * Check that WinSock is initialized; do not call it if not, to prevent * system crashes. This can happen at exit time if the exit handler for * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { *errorCodePtr = EFAULT; return -1; } /* * First check to see if EOF was already detected, to prevent calling the * socket stack after the first time EOF is detected. */ if (GOT_BITS(statePtr->flags, SOCKET_EOF)) { return 0; } /* * Check if there is an async connect running. * For blocking sockets terminate connect, otherwise do one step. * For a non blocking socket return EWOULDBLOCK if connect not terminated */ if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } /* * No EOF, and it is connected, so try to read more from the socket. Note * that we clear the FD_READ bit because read events are level triggered * so a new event will be generated if there is still data available to be * read. We have to simulate blocking behavior here since we are always * using non-blocking sockets. */ while (1) { SendSelectMessage(tsdPtr, UNSELECT, statePtr); /* * Single fd operation: this proc is only called for a connected * socket. */ bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0); CLEAR_BITS(statePtr->readyEvents, FD_READ); /* * Check for end-of-file condition or successful read. */ if (bytesRead == 0) { SET_BITS(statePtr->flags, SOCKET_EOF); } if (bytesRead != SOCKET_ERROR) { break; } /* * If an error occurs after the FD_CLOSE has arrived, then ignore the * error and report an EOF. */ if (GOT_BITS(statePtr->readyEvents, FD_CLOSE)) { SET_BITS(statePtr->flags, SOCKET_EOF); bytesRead = 0; break; } error = WSAGetLastError(); /* * If an RST comes, then ignore the error and report an EOF just like * on Unix. */ if (error == WSAECONNRESET) { SET_BITS(statePtr->flags, SOCKET_EOF); bytesRead = 0; break; } /* * Check for error condition or underflow in non-blocking case. */ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) || (error != WSAEWOULDBLOCK)) { TclWinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; break; } /* * In the blocking case, wait until the file becomes readable or * closed and try again. */ if (!WaitForSocketEvent(statePtr, FD_READ|FD_CLOSE, errorCodePtr)) { bytesRead = -1; break; } } SendSelectMessage(tsdPtr, SELECT, statePtr); return bytesRead; } /* *---------------------------------------------------------------------- * * TcpOutputProc -- * * This function is called by the generic IO level to write data to a * socket based channel. * * Results: * The number of bytes written or -1 on failure. * * Side effects: * Produces output on the socket. * *---------------------------------------------------------------------- */ static int TcpOutputProc( void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { TcpState *statePtr = (TcpState *)instanceData; int written; DWORD error; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; /* * Check that WinSock is initialized; do not call it if not, to prevent * system crashes. This can happen at exit time if the exit handler for * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { *errorCodePtr = EFAULT; return -1; } /* * Check if there is an async connect running. * For blocking sockets terminate connect, otherwise do one step. * For a non blocking socket return EWOULDBLOCK if connect not terminated */ if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } while (1) { SendSelectMessage(tsdPtr, UNSELECT, statePtr); /* * Single fd operation: this proc is only called for a connected * socket. */ written = send(statePtr->sockets->fd, buf, toWrite, 0); if (written != SOCKET_ERROR) { /* * Since Windows won't generate a new write event until we hit an * overflow condition, we need to force the event loop to poll * until the condition changes. */ if (GOT_BITS(statePtr->watchEvents, FD_WRITE)) { Tcl_Time blockTime = { 0, 0 }; Tcl_SetMaxBlockTime(&blockTime); } break; } /* * Check for error condition or overflow. In the event of overflow, we * need to clear the FD_WRITE flag so we can detect the next writable * event. Note that Windows only sends a new writable event after a * send fails with WSAEWOULDBLOCK. */ error = WSAGetLastError(); if (error == WSAEWOULDBLOCK) { CLEAR_BITS(statePtr->readyEvents, FD_WRITE); if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; written = -1; break; } } else { TclWinConvertError(error); *errorCodePtr = Tcl_GetErrno(); written = -1; break; } /* * In the blocking case, wait until the file becomes writable or * closed and try again. */ if (!WaitForSocketEvent(statePtr, FD_WRITE|FD_CLOSE, errorCodePtr)) { written = -1; break; } } SendSelectMessage(tsdPtr, SELECT, statePtr); return written; } /* *---------------------------------------------------------------------- * * TcpCloseProc -- * * This function is called by the generic IO level to perform channel * type specific cleanup on a socket based channel when the channel is * closed. * * Results: * 0 if successful, the value of errno if failed. * * Side effects: * Closes the socket. * *---------------------------------------------------------------------- */ static int TcpCloseProc( void *instanceData, /* The socket to close. */ Tcl_Interp *interp) /* Unused. */ { TcpState *statePtr = (TcpState *)instanceData; /* TIP #218 */ int errorCode = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Check that WinSock is initialized; do not call it if not, to prevent * system crashes. This can happen at exit time if the exit handler for * WinSock ran before other exit handlers that want to use sockets. */ if (SocketsEnabled()) { /* * Clean up the OS socket handle. The default Windows setting for a * socket is SO_DONTLINGER, which does a graceful shutdown in the * background. */ while (statePtr->sockets != NULL) { TcpFdList *thisfd = statePtr->sockets; statePtr->sockets = thisfd->next; if (closesocket(thisfd->fd) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); errorCode = Tcl_GetErrno(); } ckfree(thisfd); } } if (statePtr->addrlist != NULL) { freeaddrinfo(statePtr->addrlist); } if (statePtr->myaddrlist != NULL) { freeaddrinfo(statePtr->myaddrlist); } /* * Clear an eventual tsd info list pointer. * * This may be called, if an async socket connect fails or is closed * between connect and thread action callback. */ if (tsdPtr->pendingTcpState != NULL && tsdPtr->pendingTcpState == statePtr) { /* * Get infoPtr lock, because this concerns the notifier thread. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); tsdPtr->pendingTcpState = NULL; /* * Free list lock. */ SetEvent(tsdPtr->socketListLock); } /* * TIP #218. Removed the code removing the structure from the global * socket list. This is now done by the thread action callbacks, and only * there. This happens before this code is called. We can free without * fear of damaging the list. */ ckfree(statePtr); return errorCode; } /* *---------------------------------------------------------------------- * * TcpClose2Proc -- * * This function is called by the generic IO level to perform the channel * type specific part of a half-close: namely, a shutdown() on a socket. * * Results: * 0 if successful, the value of errno if failed. * * Side effects: * Shuts down one side of the socket. * *---------------------------------------------------------------------- */ static int TcpClose2Proc( void *instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = (TcpState *)instanceData; int readError = 0; int writeError = 0; /* * Shutdown the OS socket handle. */ if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { return TcpCloseProc(instanceData, interp); } /* * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or * TCL_WRITABLE so this should never be called for a server socket. */ if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { TclWinConvertError((DWORD) WSAGetLastError()); readError = Tcl_GetErrno(); } if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { TclWinConvertError((DWORD) WSAGetLastError()); writeError = Tcl_GetErrno(); } return (readError != 0) ? readError : writeError; } /* *---------------------------------------------------------------------- * * TcpSetOptionProc -- * * Sets Tcp channel specific options. * * Results: * None, unless an error happens. * * Side effects: * Changes attributes of the socket at the system level. * *---------------------------------------------------------------------- */ static int TcpSetOptionProc( void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to set. */ const char *value) /* New value for option. */ { #ifdef TCL_FEATURE_KEEPALIVE_NAGLE TcpState *statePtr = instanceData; SOCKET sock; #endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ /* * Check that WinSock is initialized; do not call it if not, to prevent * system crashes. This can happen at exit time if the exit handler for * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "winsock is not initialized", -1)); } return TCL_ERROR; } #ifdef TCL_FEATURE_KEEPALIVE_NAGLE #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list" sock = statePtr->sockets->fd; if (!strcasecmp(optionName, "-keepalive")) { BOOL val = FALSE; int boolVar, rtn; if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { return TCL_ERROR; } if (boolVar) { val = TRUE; } rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { TclWinConvertError(WSAGetLastError()); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't set socket option: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } else if (!strcasecmp(optionName, "-nagle")) { BOOL val = FALSE; int boolVar, rtn; if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { return TCL_ERROR; } if (!boolVar) { val = TRUE; } rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { TclWinConvertError(WSAGetLastError()); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't set socket option: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, "keepalive nagle"); #else return Tcl_BadChannelOption(interp, optionName, ""); #endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ } /* *---------------------------------------------------------------------- * * TcpGetOptionProc -- * * Computes an option value for a TCP socket based channel, or a list of * all options and their values. * * Note: This code is based on code contributed by John Haxby. * * Results: * A standard Tcl result. The value of the specified option or a list of * all options and their values is returned in the supplied DString. Sets * Error message if needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TcpGetOptionProc( void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to retrieve the value * for, or NULL to get all options and their * values. */ Tcl_DString *dsPtr) /* Where to store the computed value; * initialized by caller. */ { TcpState *statePtr = (TcpState *)instanceData; char host[NI_MAXHOST], port[NI_MAXSERV]; SOCKET sock; size_t len = 0; int reverseDNS = 0; #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" /* * Check that WinSock is initialized; do not call it if not, to prevent * system crashes. This can happen at exit time if the exit handler for * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "winsock is not initialized", -1)); } return TCL_ERROR; } /* * Go one step in async connect * * If any error is thrown save it as background error to report eventually * below. */ WaitForConnect(statePtr, NULL); sock = statePtr->sockets->fd; if (optionName != NULL) { len = strlen(optionName); } if ((len > 1) && (optionName[1] == 'e') && (strncmp(optionName, "-error", len) == 0)) { /* * Do not return any errors if async connect is running. */ if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { /* * In case of a failed async connect, eventually report the * connect error only once. Do not report the system error, * as this comes again and again. */ if (statePtr->connectError != 0) { Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(statePtr->connectError), -1); statePtr->connectError = 0; } } else { /* * Report an eventual last error of the socket system. */ int optlen; int ret; DWORD err; /* * Populate the err variable with a POSIX error */ optlen = sizeof(int); ret = getsockopt(sock, SOL_SOCKET, SO_ERROR, (char *)&err, &optlen); /* * The error was not returned directly but should be taken * from WSA. */ if (ret == SOCKET_ERROR) { err = WSAGetLastError(); } /* * Return error message. */ if (err) { TclWinConvertError(err); Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1); } } } return TCL_OK; } if ((len > 1) && (optionName[1] == 'c') && (strncmp(optionName, "-connecting", len) == 0)) { Tcl_DStringAppend(dsPtr, GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING) ? "1" : "0", -1); return TCL_OK; } if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { reverseDNS = NI_NUMERICHOST; } if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && (strncmp(optionName, "-peername", len) == 0))) { address peername; socklen_t size = sizeof(peername); if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* * In async connect output an empty string */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringAppendElement(dsPtr, ""); } else { return TCL_OK; } } else if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) { /* * Peername fetch succeeded - output list */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } getnameinfo(&(peername.sa), size, host, sizeof(host), NULL, 0, NI_NUMERICHOST); Tcl_DStringAppendElement(dsPtr, host); getnameinfo(&(peername.sa), size, host, sizeof(host), port, sizeof(port), reverseDNS | NI_NUMERICSERV); Tcl_DStringAppendElement(dsPtr, host); Tcl_DStringAppendElement(dsPtr, port); if (len == 0) { Tcl_DStringEndSublist(dsPtr); } else { return TCL_OK; } } else { /* * getpeername failed - but if we were asked for all the options * (len==0), don't flag an error at that point because it could be * an fconfigure request on a server socket (such sockets have no * peer). {Copied from unix/tclUnixChan.c} */ if (len) { TclWinConvertError((DWORD) WSAGetLastError()); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get peername: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } } } if ((len == 0) || ((len > 1) && (optionName[1] == 's') && (strncmp(optionName, "-sockname", len) == 0))) { TcpFdList *fds; address sockname; socklen_t size; int found = 0; if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-sockname"); Tcl_DStringStartSublist(dsPtr); } if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* * In async connect output an empty string */ found = 1; } else { for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { sock = fds->fd; size = sizeof(sockname); if (getsockname(sock, &(sockname.sa), &size) >= 0) { int flags = reverseDNS; found = 1; getnameinfo(&sockname.sa, size, host, sizeof(host), NULL, 0, NI_NUMERICHOST); Tcl_DStringAppendElement(dsPtr, host); /* * We don't want to resolve INADDR_ANY and sin6addr_any; * they can sometimes cause problems (and never have a * name). */ flags |= NI_NUMERICSERV; if (sockname.sa.sa_family == AF_INET) { if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) { flags |= NI_NUMERICHOST; } } else if (sockname.sa.sa_family == AF_INET6) { if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr, &in6addr_any)) || (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr) && sockname.sa6.sin6_addr.s6_addr[12] == 0 && sockname.sa6.sin6_addr.s6_addr[13] == 0 && sockname.sa6.sin6_addr.s6_addr[14] == 0 && sockname.sa6.sin6_addr.s6_addr[15] == 0)) { flags |= NI_NUMERICHOST; } } getnameinfo(&sockname.sa, size, host, sizeof(host), port, sizeof(port), flags); Tcl_DStringAppendElement(dsPtr, host); Tcl_DStringAppendElement(dsPtr, port); } } } if (found) { if (len) { return TCL_OK; } Tcl_DStringEndSublist(dsPtr); } else { if (interp) { TclWinConvertError((DWORD) WSAGetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get sockname: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } } #ifdef TCL_FEATURE_KEEPALIVE_NAGLE if (len == 0 || !strncmp(optionName, "-keepalive", len)) { int optlen; BOOL opt = FALSE; if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-keepalive"); } optlen = sizeof(BOOL); getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen); if (opt) { Tcl_DStringAppendElement(dsPtr, "1"); } else { Tcl_DStringAppendElement(dsPtr, "0"); } if (len > 0) { return TCL_OK; } } if (len == 0 || !strncmp(optionName, "-nagle", len)) { int optlen; BOOL opt = FALSE; if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-nagle"); } optlen = sizeof(BOOL); getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen); if (opt) { Tcl_DStringAppendElement(dsPtr, "0"); } else { Tcl_DStringAppendElement(dsPtr, "1"); } if (len > 0) { return TCL_OK; } } #endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ if (len > 0) { #ifdef TCL_FEATURE_KEEPALIVE_NAGLE return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname keepalive nagle"); #else return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname"); #endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ } return TCL_OK; } /* *---------------------------------------------------------------------- * * TcpWatchProc -- * * Informs the channel driver of the events that the generic channel code * wishes to receive on this socket. * * Results: * None. * * Side effects: * May cause the notifier to poll if any of the specified conditions are * already true. * *---------------------------------------------------------------------- */ static void TcpWatchProc( void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { TcpState *statePtr = (TcpState *)instanceData; /* * Update the watch events mask. Only if the socket is not a server * socket. [Bug 557878] */ if (!statePtr->acceptProc) { statePtr->watchEvents = 0; if (GOT_BITS(mask, TCL_READABLE)) { SET_BITS(statePtr->watchEvents, FD_READ | FD_CLOSE); } if (GOT_BITS(mask, TCL_WRITABLE)) { SET_BITS(statePtr->watchEvents, FD_WRITE | FD_CLOSE); } /* * If there are any conditions already set, then tell the notifier to * poll rather than block. */ if (statePtr->readyEvents & statePtr->watchEvents) { Tcl_Time blockTime = { 0, 0 }; Tcl_SetMaxBlockTime(&blockTime); } } } /* *---------------------------------------------------------------------- * * TcpGetHandleProc -- * * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a * TCP socket based channel. * * Results: * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no * handle for the specified direction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TcpGetHandleProc( void *instanceData, /* The socket state. */ int direction, /* Not used. */ void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; *handlePtr = INT2PTR(statePtr->sockets->fd); return TCL_OK; } /* *---------------------------------------------------------------------- * * TcpConnect -- * * This function opens a new socket in client mode. * * This might be called in 3 circumstances: * - By a regular socket command * - By the event handler to continue an asynchronously connect * - By a blocking socket function (gets/puts) to terminate the * connect synchronously * * Results: * TCL_OK, if the socket was successfully connected or an asynchronous * connection is in progress. If an error occurs, TCL_ERROR is returned * and an error message is left in interp. * * Side effects: * Opens a socket. * * Remarks: * A single host name may resolve to more than one IP address, e.g. for * an IPv4/IPv6 dual stack host. For handling asynchronously connecting * sockets in the background for such hosts, this function can act as a * coroutine. On the first call, it sets up the control variables for the * two nested loops over the local and remote addresses. Once the first * connection attempt is in progress, it sets up itself as a writable * event handler for that socket, and returns. When the callback occurs, * control is transferred to the "reenter" label, right after the initial * return and the loops resume as if they had never been interrupted. * For synchronously connecting sockets, the loops work the usual way. * *---------------------------------------------------------------------- */ static int TcpConnect( Tcl_Interp *interp, /* For error reporting; can be NULL. */ TcpState *statePtr) { DWORD error; int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); /* We are started with async connect and the * connect notification was not yet * received. */ int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); /* We were called by the event procedure and * continue our loop. */ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (async_callback) { goto reenter; } for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; statePtr->addr = statePtr->addr->ai_next) { for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL; statePtr->myaddr = statePtr->myaddr->ai_next) { /* * No need to try combinations of local and remote addresses * of different families. */ if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) { continue; } /* * Close the socket if it is still open from the last unsuccessful * iteration. */ if (statePtr->sockets->fd != INVALID_SOCKET) { closesocket(statePtr->sockets->fd); } /* * Get statePtr lock. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Reset last error from last try */ statePtr->notifierConnectError = 0; Tcl_SetErrno(0); statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0); /* * Free list lock. */ SetEvent(tsdPtr->socketListLock); /* * Continue on socket creation error. */ if (statePtr->sockets->fd == INVALID_SOCKET) { TclWinConvertError((DWORD) WSAGetLastError()); continue; } /* * Win-NT has a misfeature that sockets are inherited in child * processes by default. Turn off the inherit bit. */ SetHandleInformation((HANDLE) statePtr->sockets->fd, HANDLE_FLAG_INHERIT, 0); /* * Set kernel space buffering */ TclSockMinimumBuffers((void *) statePtr->sockets->fd, TCP_BUFFER_SIZE); /* * Try to bind to a local port. */ if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr, statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); continue; } /* * For asynchronous connect set the socket in nonblocking mode * and activate connect notification */ if (async_connect) { TcpState *statePtr2; int in_socket_list = 0; /* * Get statePtr lock. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Bugfig for 336441ed59 to not ignore notifications until the * infoPtr is in the list. * Check if my statePtr is already in the tsdPtr->socketList * It is set after this call by TcpThreadActionProc and is set * on a second round. * * If not, we buffer my statePtr in the tsd memory so it is * not lost by the event procedure */ for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL; statePtr2 = statePtr2->nextPtr) { if (statePtr2 == statePtr) { in_socket_list = 1; break; } } if (!in_socket_list) { tsdPtr->pendingTcpState = statePtr; } /* * Set connect mask to connect events * * This is activated by a SOCKET_SELECT message to the * notifier thread. */ SET_BITS(statePtr->selectEvents, FD_CONNECT); /* * Free list lock. */ SetEvent(tsdPtr->socketListLock); /* * Activate accept notification. */ SendSelectMessage(tsdPtr, SELECT, statePtr); } /* * Attempt to connect to the remote socket. */ connect(statePtr->sockets->fd, statePtr->addr->ai_addr, statePtr->addr->ai_addrlen); error = WSAGetLastError(); TclWinConvertError(error); if (async_connect && error == WSAEWOULDBLOCK) { /* * Asynchronous connect * * Remember that we jump back behind this next round */ SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); return TCL_OK; reenter: /* * Re-entry point for async connect after connect event or * blocking operation * * Clear the reenter flag */ CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); /* * Get statePtr lock. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Get signaled connect error. */ TclWinConvertError((DWORD) statePtr->notifierConnectError); /* * Clear eventual connect flag. */ CLEAR_BITS(statePtr->selectEvents, FD_CONNECT); /* * Free list lock. */ SetEvent(tsdPtr->socketListLock); } /* * Clear the tsd socket list pointer if we did not wait for * the FD_CONNECT asynchronously */ tsdPtr->pendingTcpState = NULL; if (Tcl_GetErrno() == 0) { goto out; } } } out: /* * Socket connected or connection failed */ /* * Async connect terminated */ CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); if (Tcl_GetErrno() == 0) { /* * Successfully connected * * Set up the select mask for read/write events. */ statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE; /* * Register for interest in events in the select mask. Note that this * automatically places the socket into non-blocking mode. */ SendSelectMessage(tsdPtr, SELECT, statePtr); } else { /* * Connect failed * * For async connect schedule a writable event to report the fail. */ if (async_callback) { /* * Set up the select mask for read/write events. */ statePtr->selectEvents = FD_WRITE|FD_READ; /* * Get statePtr lock. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Signal ready readable and writable events. */ SET_BITS(statePtr->readyEvents, FD_WRITE | FD_READ); /* * Flag error to event routine. */ SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); /* * Save connect error to be reported by 'fconfigure -error'. */ statePtr->connectError = Tcl_GetErrno(); /* * Free list lock. */ SetEvent(tsdPtr->socketListLock); } /* * Error message on synchronous connect */ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open socket: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_OpenTcpClient -- * * Opens a TCP client socket and creates a channel around it. * * Results: * The channel or NULL if failed. An error message is returned in the * interpreter on failure. * * Side effects: * Opens a client socket and creates a new channel. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_OpenTcpClient( Tcl_Interp *interp, /* For error reporting; can be NULL. */ int port, /* Port number to open. */ const char *host, /* Host on which to open port. */ const char *myaddr, /* Client-side address */ int myport, /* Client-side port */ int async) /* If nonzero, attempt to do an asynchronous * connect. Otherwise we do a blocking * connect. */ { TcpState *statePtr; const char *errorMsg = NULL; struct addrinfo *addrlist = NULL, *myaddrlist = NULL; char channelName[SOCK_CHAN_LENGTH]; if (TclpHasSockets(interp) != TCL_OK) { return NULL; } /* * Check that WinSock is initialized; do not call it if not, to prevent * system crashes. This can happen at exit time if the exit handler for * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { return NULL; } /* * Do the name lookups for the local and remote addresses. */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, &errorMsg)) { if (addrlist != NULL) { freeaddrinfo(addrlist); } if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open socket: %s", errorMsg)); } return NULL; } statePtr = NewSocketInfo(INVALID_SOCKET); statePtr->addrlist = addrlist; statePtr->myaddrlist = myaddrlist; if (async) { SET_BITS(statePtr->flags, TCP_ASYNC_CONNECT); } /* * Create a new client socket and wrap it in a channel. */ if (TcpConnect(interp, statePtr) != TCL_OK) { TcpCloseProc(statePtr, NULL); return NULL; } snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf")) { Tcl_Close(NULL, statePtr->channel); return NULL; } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel, "-eofchar", "")) { Tcl_Close(NULL, statePtr->channel); return NULL; } return statePtr->channel; } /* *---------------------------------------------------------------------- * * Tcl_MakeTcpClientChannel -- * * Creates a Tcl_Channel from an existing client TCP socket. * * Results: * The Tcl_Channel wrapped around the preexisting TCP socket. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeTcpClientChannel( void *sock) /* The socket to wrap up into a channel. */ { TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; ThreadSpecificData *tsdPtr; if (TclpHasSockets(NULL) != TCL_OK) { return NULL; } tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Set kernel space buffering and non-blocking. */ TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE); statePtr = NewSocketInfo((SOCKET) sock); /* * Start watching for read/write events on the socket. */ statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; SendSelectMessage(tsdPtr, SELECT, statePtr); snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf"); return statePtr->channel; } /* *---------------------------------------------------------------------- * * Tcl_OpenTcpServer -- * * Opens a TCP server socket and creates a channel around it. * * Results: * The channel or NULL if failed. If an error occurred, an error message * is left in the interp's result if interp is not NULL. * * Side effects: * Opens a server socket and creates a new channel. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_OpenTcpServer( Tcl_Interp *interp, /* For error reporting - may be NULL. */ int port, /* Port number to open. */ const char *myHost, /* Name of local host. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ void *acceptProcData) /* Data for the callback. */ { SOCKET sock = INVALID_SOCKET; unsigned short chosenport = 0; struct addrinfo *addrlist = NULL; struct addrinfo *addrPtr; /* Socket address to listen on. */ TcpState *statePtr = NULL; /* The returned value. */ char channelName[SOCK_CHAN_LENGTH]; u_long flag = 1; /* Indicates nonblocking mode. */ const char *errorMsg = NULL; if (TclpHasSockets(interp) != TCL_OK) { return NULL; } /* * Check that WinSock is initialized; do not call it if not, to prevent * system crashes. This can happen at exit time if the exit handler for * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { return NULL; } /* * Construct the addresses for each end of the socket. */ if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) { goto error; } for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { sock = socket(addrPtr->ai_family, addrPtr->ai_socktype, addrPtr->ai_protocol); if (sock == INVALID_SOCKET) { TclWinConvertError((DWORD) WSAGetLastError()); continue; } /* * Win-NT has a misfeature that sockets are inherited in child * processes by default. Turn off the inherit bit. */ SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); /* * Set kernel space buffering */ TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE); /* * Make sure we use the same port when opening two server sockets * for IPv4 and IPv6. * * As sockaddr_in6 uses the same offset and size for the port * member as sockaddr_in, we can handle both through the IPv4 API. */ if (port == 0 && chosenport != 0) { ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port = htons(chosenport); } /* * Bind to the specified port. Note that we must not call * setsockopt with SO_REUSEADDR because Microsoft allows addresses * to be reused even if they are still in use. * * Bind should not be affected by the socket having already been * set into nonblocking mode. If there is trouble, this is one * place to look for bugs. */ if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; } if (port == 0 && chosenport == 0) { address sockname; socklen_t namelen = sizeof(sockname); /* * Synchronize port numbers when binding to port 0 of multiple * addresses. */ if (getsockname(sock, &sockname.sa, &namelen) >= 0) { chosenport = ntohs(sockname.sa4.sin_port); } } /* * Set the maximum number of pending connect requests to the max * value allowed on each platform (Win32 and Win32s may be * different, and there may be differences between TCP/IP stacks). */ if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; } if (statePtr == NULL) { /* * Add this socket to the global list of sockets. */ statePtr = NewSocketInfo(sock); } else { AddSocketInfoFd(statePtr, sock); } } error: if (addrlist != NULL) { freeaddrinfo(addrlist); } if (statePtr != NULL) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, 0); /* * Set up the select mask for connection request events. */ statePtr->selectEvents = FD_ACCEPT; /* * Register for interest in events in the select mask. Note that this * automatically places the socket into non-blocking mode. */ ioctlsocket(sock, (long) FIONBIO, &flag); SendSelectMessage(tsdPtr, SELECT, statePtr); if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "") == TCL_ERROR) { Tcl_Close(NULL, statePtr->channel); return NULL; } return statePtr->channel; } if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open socket: %s", (errorMsg ? errorMsg : Tcl_PosixError(interp)))); } if (sock != INVALID_SOCKET) { closesocket(sock); } return NULL; } /* *---------------------------------------------------------------------- * * TcpAccept -- * Accept a TCP socket connection. This is called by the event loop. * * Results: * None. * * Side effects: * Creates a new connection socket. Calls the registered callback for the * connection acceptance mechanism. * *---------------------------------------------------------------------- */ static void TcpAccept( TcpFdList *fds, /* Server socket that accepted newSocket. */ SOCKET newSocket, /* Newly accepted socket. */ address addr) /* Address of new socket. */ { TcpState *newInfoPtr; TcpState *statePtr = fds->statePtr; int len = sizeof(addr); char channelName[SOCK_CHAN_LENGTH]; char host[NI_MAXHOST], port[NI_MAXSERV]; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Win-NT has a misfeature that sockets are inherited in child processes * by default. Turn off the inherit bit. */ SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0); /* * Add this socket to the global list of sockets. */ newInfoPtr = NewSocketInfo(newSocket); /* * Select on read/write events and create the channel. */ newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); SendSelectMessage(tsdPtr, SELECT, newInfoPtr); snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, newInfoPtr); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { Tcl_Close(NULL, newInfoPtr->channel); return; } if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "") == TCL_ERROR) { Tcl_Close(NULL, newInfoPtr->channel); return; } /* * Invoke the accept callback function. */ if (statePtr->acceptProc != NULL) { getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port), NI_NUMERICHOST|NI_NUMERICSERV); statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel, host, atoi(port)); } } /* *---------------------------------------------------------------------- * * InitSockets -- * * Registers the event window for the socket notifier code. * * Assumes socketMutex is held. * * Results: * None. * * Side effects: * Register a new window class and creates a * window for use in asynchronous socket notification. * *---------------------------------------------------------------------- */ static void InitSockets(void) { DWORD id; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (!initialized) { initialized = 1; TclCreateLateExitHandler(SocketExitHandler, NULL); /* * Create the async notification window with a new class. We must * create a new class to avoid a Windows 95 bug that causes us to get * the wrong message number for socket events if the message window is * a subclass of a static control. */ windowClass.style = 0; windowClass.cbClsExtra = 0; windowClass.cbWndExtra = 0; windowClass.hInstance = (HINSTANCE)TclWinGetTclInstance(); windowClass.hbrBackground = NULL; windowClass.lpszMenuName = NULL; windowClass.lpszClassName = className; windowClass.lpfnWndProc = SocketProc; windowClass.hIcon = NULL; windowClass.hCursor = NULL; if (!RegisterClassW(&windowClass)) { TclWinConvertError(GetLastError()); goto initFailure; } } /* * Check for per-thread initialization. */ if (tsdPtr != NULL) { return; } /* * OK, this thread has never done anything with sockets before. Construct * a worker thread to handle asynchronous events related to sockets * assigned to _this_ thread. */ tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->pendingTcpState = NULL; tsdPtr->socketList = NULL; tsdPtr->hwnd = NULL; tsdPtr->threadId = Tcl_GetCurrentThread(); tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); if (tsdPtr->readyEvent == NULL) { goto initFailure; } tsdPtr->socketListLock = CreateEventW(NULL, FALSE, TRUE, NULL); if (tsdPtr->socketListLock == NULL) { goto initFailure; } tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0, &id); if (tsdPtr->socketThread == NULL) { goto initFailure; } SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); /* * Wait for the thread to signal when the window has been created and if * it is ready to go. */ WaitForSingleObject(tsdPtr->readyEvent, INFINITE); if (tsdPtr->hwnd == NULL) { goto initFailure; /* Trouble creating the window. */ } Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); return; initFailure: TclpFinalizeSockets(); initialized = -1; return; } /* *---------------------------------------------------------------------- * * SocketsEnabled -- * * Check that the WinSock was successfully initialized. * * Warning: * This check was useful in times of Windows98 where WinSock may * not be available. This is not the case any more. * This function may be removed with TCL 9.0 * * Results: * 1 if it is. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int SocketsEnabled(void) { int enabled; Tcl_MutexLock(&socketMutex); enabled = (initialized == 1); Tcl_MutexUnlock(&socketMutex); return enabled; } /* *---------------------------------------------------------------------- * * SocketExitHandler -- * * Callback invoked during exit clean up to delete the socket * communication window. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void SocketExitHandler( void *clientData) /* Not used. */ { Tcl_MutexLock(&socketMutex); /* * Make sure the socket event handling window is cleaned-up for, at * most, this thread. */ TclpFinalizeSockets(); UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance()); initialized = 0; Tcl_MutexUnlock(&socketMutex); } /* *---------------------------------------------------------------------- * * SocketSetupProc -- * * This function is invoked before Tcl_DoOneEvent blocks waiting for an * event. * * Results: * None. * * Side effects: * Adjusts the block time if needed. * *---------------------------------------------------------------------- */ void SocketSetupProc( void *data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { TcpState *statePtr; Tcl_Time blockTime = { 0, 0 }; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { return; } /* * Check to see if there is a ready socket. If so, poll. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { if (GOT_BITS(statePtr->readyEvents, statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) { Tcl_SetMaxBlockTime(&blockTime); break; } } SetEvent(tsdPtr->socketListLock); } /* *---------------------------------------------------------------------- * * SocketCheckProc -- * * This function is called by Tcl_DoOneEvent to check the socket event * source for events. * * Results: * None. * * Side effects: * May queue an event. * *---------------------------------------------------------------------- */ static void SocketCheckProc( void *data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { TcpState *statePtr; SocketEvent *evPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { return; } /* * Queue events for any ready sockets that don't already have events * queued (caused by persistent states that won't generate WinSock * events). */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { if (GOT_BITS(statePtr->readyEvents, statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } SetEvent(tsdPtr->socketListLock); } /* *---------------------------------------------------------------------- * * SocketEventProc -- * * This function is called by Tcl_ServiceEvent when a socket event * reaches the front of the event queue. This function is responsible for * notifying the generic channel code. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the channel callback functions do. * *---------------------------------------------------------------------- */ static int SocketEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { TcpState *statePtr; SocketEvent *eventPtr = (SocketEvent *) evPtr; int mask = 0, events; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); TcpFdList *fds; SOCKET newSocket; address addr; int len; if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { return 0; } /* * Find the specified socket on the socket list. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { if (statePtr->sockets->fd == eventPtr->socket) { break; } } /* * Discard events that have gone stale. */ if (!statePtr) { SetEvent(tsdPtr->socketListLock); return 1; } /* * Clear flag that (this) event is pending */ CLEAR_BITS(statePtr->flags, SOCKET_PENDING); /* * Continue async connect if pending and ready */ if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) { if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* * Do one step and save eventual connect error */ SetEvent(tsdPtr->socketListLock); WaitForConnect(statePtr,NULL); } else { /* * No async connect reenter pending. Just clear event. */ CLEAR_BITS(statePtr->readyEvents, FD_CONNECT); SetEvent(tsdPtr->socketListLock); } return 1; } /* * Handle connection requests directly. */ if (GOT_BITS(statePtr->readyEvents, FD_ACCEPT)) { for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { /* * Accept the incoming connection request. */ len = sizeof(address); newSocket = accept(fds->fd, &(addr.sa), &len); /* * On Tcl server sockets with multiple OS fds we loop over the fds * trying an accept() on each, so we expect INVALID_SOCKET. There * are also other network stack conditions that can result in * FD_ACCEPT but a subsequent failure on accept() by the time we * get around to it. * * Access to sockets (acceptEventCount, readyEvents) in socketList * is still protected by the lock (prevents reintroduction of * SF Tcl Bug 3056775. */ if (newSocket == INVALID_SOCKET) { /* int err = WSAGetLastError(); */ continue; } /* * It is possible that more than one FD_ACCEPT has been sent, so * an extra count must be kept. Decrement the count, and reset the * readyEvent bit if the count is no longer > 0. */ statePtr->acceptEventCount--; if (statePtr->acceptEventCount <= 0) { CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT); } SetEvent(tsdPtr->socketListLock); /* * Caution: TcpAccept() has the side-effect of evaluating the * server accept script (via AcceptCallbackProc() in tclIOCmd.c), * which can close the server socket and invalidate statePtr and * fds. If TcpAccept() accepts a socket we must return immediately * and let SocketCheckProc queue additional FD_ACCEPT events. */ TcpAccept(fds, newSocket, addr); return 1; } /* * Loop terminated with no sockets accepted; clear the ready mask so * we can detect the next connection request. Note that connection * requests are level triggered, so if there is a request already * pending, a new event will be generated. */ statePtr->acceptEventCount = 0; CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT); SetEvent(tsdPtr->socketListLock); return 1; } SetEvent(tsdPtr->socketListLock); /* * Mask off unwanted events and compute the read/write mask so we can * notify the channel. */ events = statePtr->readyEvents & statePtr->watchEvents; if (GOT_BITS(events, FD_CLOSE)) { /* * If the socket was closed and the channel is still interested in * read events, then we need to ensure that we keep polling for this * event until someone does something with the channel. Note that we * do this before calling Tcl_NotifyChannel so we don't have to watch * out for the channel being deleted out from under us. This may cause * a redundant trip through the event loop, but it's simpler than * trying to do unwind protection. */ Tcl_Time blockTime = { 0, 0 }; Tcl_SetMaxBlockTime(&blockTime); SET_BITS(mask, TCL_READABLE | TCL_WRITABLE); } else if (GOT_BITS(events, FD_READ)) { /* * Throw the readable event if an async connect failed. */ if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { SET_BITS(mask, TCL_READABLE); } else { fd_set readFds; struct timeval timeout; /* * We must check to see if data is really available, since someone * could have consumed the data in the meantime. Turn off async * notification so select will work correctly. If the socket is * still readable, notify the channel driver, otherwise reset the * async select handler and keep waiting. */ SendSelectMessage(tsdPtr, UNSELECT, statePtr); FD_ZERO(&readFds); FD_SET(statePtr->sockets->fd, &readFds); timeout.tv_usec = 0; timeout.tv_sec = 0; if (select(0, &readFds, NULL, NULL, &timeout) != 0) { SET_BITS(mask, TCL_READABLE); } else { CLEAR_BITS(statePtr->readyEvents, FD_READ); SendSelectMessage(tsdPtr, SELECT, statePtr); } } } /* * writable event */ if (GOT_BITS(events, FD_WRITE)) { SET_BITS(mask, TCL_WRITABLE); } /* * Call registered event procedures */ if (mask) { Tcl_NotifyChannel(statePtr->channel, mask); } return 1; } /* *---------------------------------------------------------------------- * * AddSocketInfoFd -- * * This function adds a SOCKET file descriptor to the 'sockets' linked * list of a TcpState structure. * * Results: * None. * * Side effects: * None, except for allocation of memory. * *---------------------------------------------------------------------- */ static void AddSocketInfoFd( TcpState *statePtr, SOCKET socket) { TcpFdList *fds = statePtr->sockets; if (fds == NULL) { /* * Add the first FD. */ statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { /* * Find end of list and append FD. */ while (fds->next != NULL) { fds = fds->next; } fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList)); fds = fds->next; } /* * Populate new FD. */ fds->fd = socket; fds->statePtr = statePtr; fds->next = NULL; } /* *---------------------------------------------------------------------- * * NewSocketInfo -- * * This function allocates and initializes a new TcpState structure. * * Results: * Returns a newly allocated TcpState. * * Side effects: * None, except for allocation of memory. * *---------------------------------------------------------------------- */ static TcpState * NewSocketInfo(SOCKET socket) { TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); /* * TIP #218. Removed the code inserting the new structure into the global * list. This is now handled in the thread action callbacks, and only * there. */ AddSocketInfoFd(statePtr, socket); return statePtr; } /* *---------------------------------------------------------------------- * * WaitForSocketEvent -- * * Waits until one of the specified events occurs on a socket. * For event FD_CONNECT use WaitForConnect. * * Results: * Returns 1 on success or 0 on failure, with an error code in * errorCodePtr. * * Side effects: * Processes socket events off the system queue. * *---------------------------------------------------------------------- */ static int WaitForSocketEvent( TcpState *statePtr, /* Information about this socket. */ int events, /* Events to look for. May be one of * FD_READ or FD_WRITE. */ int *errorCodePtr) /* Where to store errors? */ { int result = 1; int oldMode; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Be sure to disable event servicing so we are truly modal. */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); /* * Reset WSAAsyncSelect so we have a fresh set of events pending. */ SendSelectMessage(tsdPtr, UNSELECT, statePtr); SendSelectMessage(tsdPtr, SELECT, statePtr); while (1) { int event_found; /* * Get statePtr lock. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Check if event occurred. */ event_found = GOT_BITS(statePtr->readyEvents, events); /* * Free list lock. */ SetEvent(tsdPtr->socketListLock); /* * Exit loop if event occurred. */ if (event_found) { break; } /* * Exit loop if event did not occur but this is a non-blocking channel */ if (statePtr->flags & TCP_NONBLOCKING) { *errorCodePtr = EWOULDBLOCK; result = 0; break; } /* * Wait until something happens. */ WaitForSingleObject(tsdPtr->readyEvent, INFINITE); } (void) Tcl_SetServiceMode(oldMode); return result; } /* *---------------------------------------------------------------------- * * SocketThread -- * * Helper thread used to manage the socket event handling window. * * Results: * 1 if unable to create socket event window, 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ static DWORD WINAPI SocketThread( LPVOID arg) { MSG msg; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)arg; /* * Create a dummy window receiving socket events. */ tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); /* * Signalize thread creator that we are done creating the window. */ SetEvent(tsdPtr->readyEvent); /* * If unable to create the window, exit this thread immediately. */ if (tsdPtr->hwnd == NULL) { return 1; } /* * Process all messages on the socket window until WM_QUIT. This threads * exits only when instructed to do so by the call to * PostMessageW(SOCKET_TERMINATE) in TclpFinalizeSockets(). */ while (GetMessageW(&msg, NULL, 0, 0) > 0) { DispatchMessageW(&msg); } /* * This releases waiters on thread exit in TclpFinalizeSockets() */ SetEvent(tsdPtr->readyEvent); return msg.wParam; } /* *---------------------------------------------------------------------- * * SocketProc -- * * This function is called when WSAAsyncSelect has been used to register * interest in a socket event, and the event has occurred. * * Results: * 0 on success. * * Side effects: * The flags for the given socket are updated to reflect the event that * occurred. * *---------------------------------------------------------------------- */ static LRESULT CALLBACK SocketProc( HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) { int event, error; SOCKET socket; TcpState *statePtr; int info_found = 0; TcpFdList *fds = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) #ifdef _WIN64 GetWindowLongPtrW(hwnd, GWLP_USERDATA); #else GetWindowLongW(hwnd, GWL_USERDATA); #endif switch (message) { default: return DefWindowProcW(hwnd, message, wParam, lParam); break; case WM_CREATE: /* * Store the initial tsdPtr, it's from a different thread, so it's not * directly accessible, but needed. */ #ifdef _WIN64 SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams); #else SetWindowLongW(hwnd, GWL_USERDATA, (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams); #endif break; case WM_DESTROY: PostQuitMessage(0); break; case SOCKET_MESSAGE: event = WSAGETSELECTEVENT(lParam); error = WSAGETSELECTERROR(lParam); socket = (SOCKET) wParam; WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Find the specified socket on the socket list and update its * eventState flag. */ for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { if (FindFDInList(statePtr, socket)) { info_found = 1; break; } } /* * Check if there is a pending info structure not jet in the list. */ if (!info_found && tsdPtr->pendingTcpState != NULL && FindFDInList(tsdPtr->pendingTcpState, socket)) { statePtr = tsdPtr->pendingTcpState; info_found = 1; } if (info_found) { /* * Update the socket state. * * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event * happens, then clear the FD_ACCEPT count. Otherwise, increment * the count if the current event is an FD_ACCEPT. */ if (GOT_BITS(event, FD_CLOSE)) { statePtr->acceptEventCount = 0; CLEAR_BITS(statePtr->readyEvents, FD_WRITE | FD_ACCEPT); } else if (GOT_BITS(event, FD_ACCEPT)) { statePtr->acceptEventCount++; } if (GOT_BITS(event, FD_CONNECT)) { /* * Remember any error that occurred so we can report * connection failures. */ if (error != ERROR_SUCCESS) { statePtr->notifierConnectError = error; } } /* * Inform main thread about signaled events */ SET_BITS(statePtr->readyEvents, event); /* * Wake up the Main Thread. */ SetEvent(tsdPtr->readyEvent); Tcl_ThreadAlert(tsdPtr->threadId); } SetEvent(tsdPtr->socketListLock); break; case SOCKET_SELECT: statePtr = (TcpState *) lParam; for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { if (wParam == SELECT) { WSAAsyncSelect(fds->fd, hwnd, SOCKET_MESSAGE, statePtr->selectEvents); } else { /* * Clear the selection mask */ WSAAsyncSelect(fds->fd, hwnd, 0, 0); } } break; case SOCKET_TERMINATE: DestroyWindow(hwnd); break; } return 0; } /* *---------------------------------------------------------------------- * * FindFDInList -- * * Return true, if the given file descriptor is contained in the * file descriptor list. * * Results: * true if found. * * Side effects: * *---------------------------------------------------------------------- */ static int FindFDInList( TcpState *statePtr, SOCKET socket) { TcpFdList *fds; for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { if (fds->fd == socket) { return 1; } } return 0; } /* *---------------------------------------------------------------------- * * TclWinGetSockOpt, et al. -- * * Those functions are historically exported by the stubs table and * just use the original system calls now. * * Warning: * Those functions are depreciated and will be removed with TCL 9.0. * * Results: * As defined for each function. * * Side effects: * As defined for each function. * *---------------------------------------------------------------------- */ #undef TclWinGetSockOpt int TclWinGetSockOpt( SOCKET s, int level, int optname, char *optval, int *optlen) { return getsockopt(s, level, optname, optval, optlen); } #undef TclWinSetSockOpt int TclWinSetSockOpt( SOCKET s, int level, int optname, const char *optval, int optlen) { return setsockopt(s, level, optname, optval, optlen); } #undef TclpInetNtoa char * TclpInetNtoa( struct in_addr addr) { return inet_ntoa(addr); } #undef TclWinGetServByName struct servent * TclWinGetServByName( const char *name, const char *proto) { return getservbyname(name, proto); } /* *---------------------------------------------------------------------- * * TcpThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void TcpThreadActionProc( void *instanceData, int action) { ThreadSpecificData *tsdPtr; TcpState *statePtr = (TcpState *)instanceData; int notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { /* * Ensure that socket subsystem is initialized in this thread, or else * sockets will not work. */ Tcl_MutexLock(&socketMutex); InitSockets(); Tcl_MutexUnlock(&socketMutex); tsdPtr = TCL_TSD_INIT(&dataKey); WaitForSingleObject(tsdPtr->socketListLock, INFINITE); statePtr->nextPtr = tsdPtr->socketList; tsdPtr->socketList = statePtr; if (statePtr == tsdPtr->pendingTcpState) { tsdPtr->pendingTcpState = NULL; } SetEvent(tsdPtr->socketListLock); notifyCmd = SELECT; } else { TcpState **nextPtrPtr; int removed = 0; tsdPtr = TCL_TSD_INIT(&dataKey); /* * TIP #218, Bugfix: All access to socketList has to be protected by * the lock. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == statePtr) { (*nextPtrPtr) = statePtr->nextPtr; removed = 1; break; } } SetEvent(tsdPtr->socketListLock); /* * This could happen if the channel was created in one thread and then * moved to another without updating the thread local data in each * thread. */ if (!removed) { Tcl_Panic("file info ptr not on thread channel list"); } notifyCmd = UNSELECT; } /* * Ensure that, or stop, notifications for the socket occur in this * thread. */ SendSelectMessage(tsdPtr, notifyCmd, statePtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ tcl8.6.14/win/tclWinTest.c0000644000175000017500000004442514554262142014714 0ustar sergeisergei/* * tclWinTest.c -- * * Contains commands for platform specific tests on Windows. * * Copyright (c) 1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" /* * For TestplatformChmod on Windows */ #include #include /* * MinGW 3.4.2 does not define this. */ #ifndef INHERITED_ACE #define INHERITED_ACE (0x10) #endif /* * Forward declarations of functions defined later in this file: */ static Tcl_ObjCmdProc TesteventloopCmd; static Tcl_ObjCmdProc TestvolumetypeCmd; static Tcl_ObjCmdProc TestwinclockCmd; static Tcl_ObjCmdProc TestwinsleepCmd; static Tcl_ObjCmdProc TestSizeCmd; static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); static Tcl_ObjCmdProc TestchmodCmd; /* *---------------------------------------------------------------------- * * TclplatformtestInit -- * * Defines commands that test platform specific functionality for Windows * platforms. * * Results: * A standard Tcl result. * * Side effects: * Defines new commands. * *---------------------------------------------------------------------- */ int TclplatformtestInit( Tcl_Interp *interp) /* Interpreter to add commands to. */ { /* * Add commands for platform specific tests for Windows here. */ Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TesteventloopCmd -- * * This function implements the "testeventloop" command. It is used to * test the Tcl notifier from an "external" event loop (i.e. not * Tcl_DoOneEvent()). * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TesteventloopCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static int *framePtr = NULL;/* Pointer to integer on stack frame of * innermost invocation of the "wait" * subcommand. */ (void)clientData; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ..."); return TCL_ERROR; } if (strcmp(Tcl_GetString(objv[1]), "done") == 0) { *framePtr = 1; } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { int *oldFramePtr, done; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); /* * Save the old stack frame pointer and set up the current frame. */ oldFramePtr = framePtr; framePtr = &done; /* * Enter a standard Windows event loop until the flag changes. Note * that we do not explicitly call Tcl_ServiceEvent(). */ done = 0; while (!done) { MSG msg; if (!GetMessageW(&msg, NULL, 0, 0)) { /* * The application is exiting, so repost the quit message and * start unwinding. */ PostQuitMessage((int) msg.wParam); break; } TranslateMessage(&msg); DispatchMessageW(&msg); } (void) Tcl_SetServiceMode(oldMode); framePtr = oldFramePtr; } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be done or wait", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Testvolumetype -- * * This function implements the "testvolumetype" command. It is used to * check the volume type (FAT, NTFS) of a volume. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestvolumetypeCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { #define VOL_BUF_SIZE 32 int found; char volType[VOL_BUF_SIZE]; const char *path; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } if (objc == 2) { /* * path has to be really a proper volume, but we don't get query APIs * for that until NT5 */ path = Tcl_GetString(objv[1]); } else { path = NULL; } found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); if (found == 0) { Tcl_AppendResult(interp, "could not get volume type for \"", (path?path:""), "\"", NULL); TclWinConvertError(GetLastError()); return TCL_ERROR; } Tcl_AppendResult(interp, volType, NULL); return TCL_OK; #undef VOL_BUF_SIZE } /* *---------------------------------------------------------------------- * * TestwinclockCmd -- * * Command that returns the seconds and microseconds portions of the * system clock and of the Tcl clock so that they can be compared to * validate that the Tcl clock is staying in sync. * * Usage: * testclock * * Parameters: * None. * * Results: * Returns a standard Tcl result comprising a four-element list: the * seconds and microseconds portions of the system clock, and the seconds * and microseconds portions of the Tcl clock. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestwinclockCmd( ClientData dummy, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }; /* The Posix epoch, expressed as a Windows * FILETIME */ Tcl_Time tclTime; /* Tcl clock */ FILETIME sysTime; /* System clock */ Tcl_Obj *result; /* Result of the command */ LARGE_INTEGER t1, t2; LARGE_INTEGER p1, p2; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } QueryPerformanceCounter(&p1); Tcl_GetTime(&tclTime); GetSystemTimeAsFileTime(&sysTime); t1.LowPart = posixEpoch.dwLowDateTime; t1.HighPart = posixEpoch.dwHighDateTime; t2.LowPart = sysTime.dwLowDateTime; t2.HighPart = sysTime.dwHighDateTime; t2.QuadPart -= t1.QuadPart; QueryPerformanceCounter(&p2); result = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) (t2.QuadPart / 10000000))); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000))); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart)); Tcl_SetObjResult(interp, result); return TCL_OK; } static int TestwinsleepCmd( ClientData clientData, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int ms; (void)clientData; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "ms"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { return TCL_ERROR; } Sleep((DWORD) ms); return TCL_OK; } static int TestSizeCmd( ClientData clientData, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { if (objc != 2) { goto syntax; } if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) { Tcl_StatBuf *statPtr; Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); return TCL_OK; } syntax: Tcl_WrongNumArgs(interp, 1, objv, "st_mtime"); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TestExceptionCmd -- * * Causes this process to end with the named exception. Used for testing * Tcl_WaitPid(). * * Usage: * testexcept * * Parameters: * Type of exception. * * Results: * None, this process closes now and doesn't return. * * Side effects: * This Tcl process closes, hard... Bang! * *---------------------------------------------------------------------- */ static int TestExceptionCmd( ClientData dummy, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { static const char *const cmds[] = { "access_violation", "datatype_misalignment", "array_bounds", "float_denormal", "float_divbyzero", "float_inexact", "float_invalidop", "float_overflow", "float_stack", "float_underflow", "int_divbyzero", "int_overflow", "private_instruction", "inpageerror", "illegal_instruction", "noncontinue", "stack_overflow", "invalid_disp", "guard_page", "invalid_handle", "ctrl+c", NULL }; static const DWORD exceptions[] = { EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT, EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND, EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT, EXCEPTION_FLT_INVALID_OPERATION, EXCEPTION_FLT_OVERFLOW, EXCEPTION_FLT_STACK_CHECK, EXCEPTION_FLT_UNDERFLOW, EXCEPTION_INT_DIVIDE_BY_ZERO, EXCEPTION_INT_OVERFLOW, EXCEPTION_PRIV_INSTRUCTION, EXCEPTION_IN_PAGE_ERROR, EXCEPTION_ILLEGAL_INSTRUCTION, EXCEPTION_NONCONTINUABLE_EXCEPTION, EXCEPTION_STACK_OVERFLOW, EXCEPTION_INVALID_DISPOSITION, EXCEPTION_GUARD_PAGE, EXCEPTION_INVALID_HANDLE, CONTROL_C_EXIT }; int cmd; (void)dummy; if (objc != 2) { Tcl_WrongNumArgs(interp, 0, objv, ""); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0, &cmd) != TCL_OK) { return TCL_ERROR; } /* * Make sure the GPF dialog doesn't popup. */ SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX); /* * As Tcl does not handle structured exceptions, this falls all the way * back up the instruction stack to the C run-time portion that called * main() where the process will now be terminated with this exception * code by the default handler the C run-time provides. */ /* SMASH! */ RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL); return TCL_OK; } /* * This "chmod" works sufficiently for test script purposes. Do not expect * it to be exact emulation of Unix chmod (not sure if that's even possible) */ static int TestplatformChmod( const char *nativePath, int pmode) { /* * Note FILE_DELETE_CHILD missing from dirWriteMask because we do * not want overriding of child's delete setting when testing */ static const DWORD dirWriteMask = FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | FILE_ADD_FILE | FILE_ADD_SUBDIRECTORY | STANDARD_RIGHTS_WRITE | DELETE | SYNCHRONIZE; static const DWORD dirReadMask = FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_LIST_DIRECTORY | STANDARD_RIGHTS_READ | SYNCHRONIZE; /* Note - default user privileges allow ignoring TRAVERSE setting */ static const DWORD dirExecuteMask = FILE_TRAVERSE | STANDARD_RIGHTS_READ | SYNCHRONIZE; static const DWORD fileWriteMask = FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | FILE_WRITE_DATA | FILE_APPEND_DATA | STANDARD_RIGHTS_WRITE | DELETE | SYNCHRONIZE; static const DWORD fileReadMask = FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_READ_DATA | STANDARD_RIGHTS_READ | SYNCHRONIZE; static const DWORD fileExecuteMask = FILE_EXECUTE | STANDARD_RIGHTS_READ | SYNCHRONIZE; DWORD attr, newAclSize; PACL newAcl = NULL; int res = 0; HANDLE hToken = NULL; int i; int nSids = 0; struct { PSID pSid; DWORD mask; DWORD sidLen; } aceEntry[3]; DWORD dw; int isDir; TOKEN_USER *pTokenUser = NULL; res = -1; /* Assume failure */ attr = GetFileAttributesA(nativePath); if (attr == 0xFFFFFFFF) { goto done; /* Not found */ } isDir = (attr & FILE_ATTRIBUTE_DIRECTORY) != 0; if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hToken)) { goto done; } /* Get process SID */ if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) && GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } pTokenUser = (TOKEN_USER *)ckalloc(dw); if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) { goto done; } aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid); aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenUser->User.Sid)) { ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ goto done; } /* * Always include DACL modify rights so we don't get locked out */ aceEntry[nSids].mask = READ_CONTROL | WRITE_DAC | WRITE_OWNER | SYNCHRONIZE | FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES; if (pmode & 0700) { /* Owner permissions. Assumes current process is owner */ if (pmode & 0400) { aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; } if (pmode & 0200) { aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; } if (pmode & 0100) { aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; } } ++nSids; if (pmode & 0070) { /* Group permissions. */ TOKEN_PRIMARY_GROUP *pTokenGroup; /* Get primary group SID */ if (!GetTokenInformation( hToken, TokenPrimaryGroup, NULL, 0, &dw) && GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } pTokenGroup = (TOKEN_PRIMARY_GROUP *)ckalloc(dw); if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) { ckfree(pTokenGroup); goto done; } aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup); aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) { ckfree(pTokenGroup); ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ goto done; } ckfree(pTokenGroup); /* Generate mask for group ACL */ aceEntry[nSids].mask = 0; if (pmode & 0040) { aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; } if (pmode & 0020) { aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; } if (pmode & 0010) { aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; } ++nSids; } if (pmode & 0007) { /* World permissions */ PSID pWorldSid; if (!ConvertStringSidToSidA("S-1-1-0", &pWorldSid)) { goto done; } aceEntry[nSids].sidLen = GetLengthSid(pWorldSid); aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) { LocalFree(pWorldSid); ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ goto done; } LocalFree(pWorldSid); /* Generate mask for world ACL */ aceEntry[nSids].mask = 0; if (pmode & 0004) { aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; } if (pmode & 0002) { aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; } if (pmode & 0001) { aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; } ++nSids; } /* Allocate memory and initialize the new ACL. */ newAclSize = sizeof(ACL); /* Add in size required for each ACE entry in the ACL */ for (i = 0; i < nSids; ++i) { newAclSize += TclOffset(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen; } newAcl = (PACL)ckalloc(newAclSize); if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) { goto done; } for (i = 0; i < nSids; ++i) { if (!AddAccessAllowedAce(newAcl, ACL_REVISION, aceEntry[i].mask, aceEntry[i].pSid)) { goto done; } } /* * Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used * to remove inherited ACL (we need to overwrite the default ACL's in this case) */ if (SetNamedSecurityInfoA((LPSTR)nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION | PROTECTED_DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; } done: if (pTokenUser) { ckfree(pTokenUser); } if (hToken) { CloseHandle(hToken); } if (newAcl) { ckfree(newAcl); } for (i = 0; i < nSids; ++i) { ckfree(aceEntry[i].pSid); } if (res != 0) { return res; } /* Run normal chmod command */ return chmod(nativePath, pmode); } /* *--------------------------------------------------------------------------- * * TestchmodCmd -- * * Implements the "testchmod" cmd. Used when testing "file" command. The * only attribute used by the Windows platform is the user write flag; if * this is not set, the file is made read-only. Otherwise, the file is * made read-write. * * Results: * A standard Tcl result. * * Side effects: * Changes permissions of specified files. * *--------------------------------------------------------------------------- */ static int TestchmodCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int i, mode; (void)dummy; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) { return TCL_ERROR; } for (i = 2; i < objc; i++) { Tcl_DString buffer; const char *translated; translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer); if (translated == NULL) { return TCL_ERROR; } if (TestplatformChmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); } return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinThrd.c0000644000175000017500000006334414554262142014677 0ustar sergeisergei/* * tclWinThread.c -- * * This file implements the Windows-specific thread operations. * * Copyright (c) 1998 by Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation * Copyright (c) 2008 by George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" #include /* Workaround for mingw versions which don't provide this in float.h */ #ifndef _MCW_EM # define _MCW_EM 0x0008001F /* Error masks */ # define _MCW_RC 0x00000300 /* Rounding */ # define _MCW_PC 0x00030000 /* Precision */ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask); #endif /* * This is the global lock used to serialize access to other serialization * data structures. */ static CRITICAL_SECTION globalLock; static int init = 0; #define GLOBAL_LOCK TclpGlobalLock() #define GLOBAL_UNLOCK TclpGlobalUnlock() /* * This is the global lock used to serialize initialization and finalization * of Tcl as a whole. */ static CRITICAL_SECTION initLock; /* * allocLock is used by Tcl's version of malloc for synchronization. For * obvious reasons, cannot use any dynamically allocated storage. */ #ifdef TCL_THREADS static struct Tcl_Mutex_ { CRITICAL_SECTION crit; } allocLock; static Tcl_Mutex allocLockPtr = &allocLock; static int allocOnce = 0; #endif /* TCL_THREADS */ /* * The joinLock serializes Create- and ExitThread. This is necessary to * prevent a race where a new joinable thread exits before the creating thread * had the time to create the necessary data structures in the emulation * layer. */ static CRITICAL_SECTION joinLock; /* * Condition variables are implemented with a combination of a per-thread * Windows Event and a per-condition waiting queue. The idea is that each * thread has its own Event that it waits on when it is doing a ConditionWait; * it uses the same event for all condition variables because it only waits on * one at a time. Each condition variable has a queue of waiting threads, and * a mutex used to serialize access to this queue. * * Special thanks to David Nichols and Jim Davidson for advice on the * Condition Variable implementation. */ /* * The per-thread event and queue pointers. */ #ifdef TCL_THREADS typedef struct ThreadSpecificData { HANDLE condEvent; /* Per-thread condition event */ struct ThreadSpecificData *nextPtr; /* Queue pointers */ struct ThreadSpecificData *prevPtr; int flags; /* See flags below */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #endif /* TCL_THREADS */ /* * State bits for the thread. * WIN_THREAD_UNINIT Uninitialized. Must be zero because of the way * ThreadSpecificData is created. * WIN_THREAD_RUNNING Running, not waiting. * WIN_THREAD_BLOCKED Waiting, or trying to wait. */ #define WIN_THREAD_UNINIT 0x0 #define WIN_THREAD_RUNNING 0x1 #define WIN_THREAD_BLOCKED 0x2 /* * The per condition queue pointers and the Mutex used to serialize access to * the queue. */ typedef struct WinCondition { CRITICAL_SECTION condLock; /* Lock to serialize queuing on the * condition. */ struct ThreadSpecificData *firstPtr; /* Queue pointers */ struct ThreadSpecificData *lastPtr; } WinCondition; /* * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC static int once; static DWORD tlsKey; typedef struct allocMutex { Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; #endif /* USE_THREAD_ALLOC */ /* * The per thread data passed from TclpThreadCreate * to TclWinThreadStart. */ typedef struct WinThread { LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ LPVOID lpParameter; /* Original startup data */ unsigned int fpControl; /* Floating point control word from the * main thread */ } WinThread; /* *---------------------------------------------------------------------- * * TclWinThreadStart -- * * This procedure is the entry point for all new threads created * by Tcl on Windows. * * Results: * Various, depending on the result of the wrapped thread start * routine. * * Side effects: * Arbitrary, since user code is executed. * *---------------------------------------------------------------------- */ static DWORD WINAPI TclWinThreadStart( LPVOID lpParameter) /* The WinThread structure pointer passed * from TclpThreadCreate */ { WinThread *winThreadPtr = (WinThread *) lpParameter; LPTHREAD_START_ROUTINE lpOrigStartAddress; LPVOID lpOrigParameter; if (!winThreadPtr) { return TCL_ERROR; } _controlfp(winThreadPtr->fpControl, _MCW_EM | _MCW_RC | 0x03000000 /* _MCW_DN */ #if !defined(_WIN64) | _MCW_PC #endif ); lpOrigStartAddress = winThreadPtr->lpStartAddress; lpOrigParameter = winThreadPtr->lpParameter; ckfree((char *)winThreadPtr); return lpOrigStartAddress(lpOrigParameter); } /* *---------------------------------------------------------------------- * * TclpThreadCreate -- * * This procedure creates a new thread. * * Results: * TCL_OK if the thread could be created. The thread ID is returned in a * parameter. * * Side effects: * A new thread is created. * *---------------------------------------------------------------------- */ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ ClientData clientData, /* The one argument to Main(). */ int stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread)); winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc; winThreadPtr->lpParameter = clientData; winThreadPtr->fpControl = _controlfp(0, 0); EnterCriticalSection(&joinLock); *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and * on WIN64 sizeof void* != sizeof unsigned */ #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr, 0, (unsigned *)idPtr); #else tHandle = CreateThread(NULL, (DWORD) stackSize, TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr); #endif if (tHandle == NULL) { LeaveCriticalSection(&joinLock); return TCL_ERROR; } else { if (flags & TCL_THREAD_JOINABLE) { TclRememberJoinableThread(*idPtr); } /* * The only purpose of this is to decrement the reference count so the * OS resources will be reacquired when the thread closes. */ CloseHandle(tHandle); LeaveCriticalSection(&joinLock); return TCL_OK; } } /* *---------------------------------------------------------------------- * * Tcl_JoinThread -- * * This procedure waits upon the exit of the specified thread. * * Results: * TCL_OK if the wait was successful, TCL_ERROR else. * * Side effects: * The result area is set to the exit code of the thread we * waited upon. * *---------------------------------------------------------------------- */ int Tcl_JoinThread( Tcl_ThreadId threadId, /* Id of the thread to wait upon */ int *result) /* Reference to the storage the result of the * thread we wait upon will be written into. */ { return TclJoinThread(threadId, result); } /* *---------------------------------------------------------------------- * * TclpThreadExit -- * * This procedure terminates the current thread. * * Results: * None. * * Side effects: * This procedure terminates the current thread. * *---------------------------------------------------------------------- */ void TclpThreadExit( int status) { EnterCriticalSection(&joinLock); TclSignalExitThread(Tcl_GetCurrentThread(), status); LeaveCriticalSection(&joinLock); #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) _endthreadex((unsigned) status); #else ExitThread((DWORD) status); #endif } /* *---------------------------------------------------------------------- * * Tcl_GetCurrentThread -- * * This procedure returns the ID of the currently running thread. * * Results: * A thread ID. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_ThreadId Tcl_GetCurrentThread(void) { return (Tcl_ThreadId)(size_t)GetCurrentThreadId(); } /* *---------------------------------------------------------------------- * * TclpInitLock * * This procedure is used to grab a lock that serializes initialization * and finalization of Tcl. On some platforms this may also initialize * the mutex used to serialize creation of more mutexes and thread local * storage keys. * * Results: * None. * * Side effects: * Acquire the initialization mutex. * *---------------------------------------------------------------------- */ void TclpInitLock(void) { if (!init) { /* * There is a fundamental race here that is solved by creating the * first Tcl interpreter in a single threaded environment. Once the * interpreter has been created, it is safe to create more threads * that create interpreters in parallel. */ init = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); InitializeCriticalSection(&globalLock); } EnterCriticalSection(&initLock); } /* *---------------------------------------------------------------------- * * TclpInitUnlock * * This procedure is used to release a lock that serializes * initialization and finalization of Tcl. * * Results: * None. * * Side effects: * Release the initialization mutex. * *---------------------------------------------------------------------- */ void TclpInitUnlock(void) { LeaveCriticalSection(&initLock); } /* *---------------------------------------------------------------------- * * TclpGlobalLock * * This procedure is used to grab a lock that serializes creation of * mutexes, condition variables, and thread local storage keys. * * This lock must be different than the initLock because the initLock is * held during creation of synchronization objects. * * Results: * None. * * Side effects: * Acquire the global mutex. * *---------------------------------------------------------------------- */ void TclpGlobalLock(void) { if (!init) { /* * There is a fundamental race here that is solved by creating the * first Tcl interpreter in a single threaded environment. Once the * interpreter has been created, it is safe to create more threads * that create interpreters in parallel. */ init = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); InitializeCriticalSection(&globalLock); } EnterCriticalSection(&globalLock); } /* *---------------------------------------------------------------------- * * TclpGlobalUnlock * * This procedure is used to release a lock that serializes creation and * deletion of synchronization objects. * * Results: * None. * * Side effects: * Release the global mutex. * *---------------------------------------------------------------------- */ void TclpGlobalUnlock(void) { LeaveCriticalSection(&globalLock); } /* *---------------------------------------------------------------------- * * Tcl_GetAllocMutex * * This procedure returns a pointer to a statically initialized mutex for * use by the memory allocator. The allocator must use this lock, because * all other locks are allocated... * * Results: * A pointer to a mutex that is suitable for passing to Tcl_MutexLock and * Tcl_MutexUnlock. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Mutex * Tcl_GetAllocMutex(void) { #ifdef TCL_THREADS if (!allocOnce) { InitializeCriticalSection(&allocLock.crit); allocOnce = 1; } return &allocLockPtr; #else return NULL; #endif } /* *---------------------------------------------------------------------- * * TclpFinalizeLock * * This procedure is used to destroy all private resources used in this * file. * * Results: * None. * * Side effects: * Destroys everything private. TclpInitLock must be held entering this * function. * *---------------------------------------------------------------------- */ void TclFinalizeLock(void) { GLOBAL_LOCK; DeleteCriticalSection(&joinLock); /* * Destroy the critical section that we are holding! */ DeleteCriticalSection(&globalLock); init = 0; #ifdef TCL_THREADS if (allocOnce) { DeleteCriticalSection(&allocLock.crit); allocOnce = 0; } #endif LeaveCriticalSection(&initLock); /* * Destroy the critical section that we were holding. */ DeleteCriticalSection(&initLock); } #ifdef TCL_THREADS /* locally used prototype */ static void FinalizeConditionEvent(ClientData data); /* *---------------------------------------------------------------------- * * Tcl_MutexLock -- * * This procedure is invoked to lock a mutex. This is a self initializing * mutex that is automatically finalized during Tcl_Finalize. * * Results: * None. * * Side effects: * May block the current thread. The mutex is acquired when this returns. * *---------------------------------------------------------------------- */ void Tcl_MutexLock( Tcl_Mutex *mutexPtr) /* The lock */ { CRITICAL_SECTION *csPtr; if (*mutexPtr == NULL) { GLOBAL_LOCK; /* * Double inside global lock check to avoid a race. */ if (*mutexPtr == NULL) { csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); } GLOBAL_UNLOCK; } csPtr = *((CRITICAL_SECTION **)mutexPtr); EnterCriticalSection(csPtr); } /* *---------------------------------------------------------------------- * * Tcl_MutexUnlock -- * * This procedure is invoked to unlock a mutex. * * Results: * None. * * Side effects: * The mutex is released when this returns. * *---------------------------------------------------------------------- */ void Tcl_MutexUnlock( Tcl_Mutex *mutexPtr) /* The lock */ { CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr); LeaveCriticalSection(csPtr); } /* *---------------------------------------------------------------------- * * TclpFinalizeMutex -- * * This procedure is invoked to clean up one mutex. This is only safe to * call at the end of time. * * Results: * None. * * Side effects: * The mutex list is deallocated. * *---------------------------------------------------------------------- */ void TclpFinalizeMutex( Tcl_Mutex *mutexPtr) { CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr; if (csPtr != NULL) { DeleteCriticalSection(csPtr); ckfree(csPtr); *mutexPtr = NULL; } } /* *---------------------------------------------------------------------- * * Tcl_ConditionWait -- * * This procedure is invoked to wait on a condition variable. The mutex * is atomically released as part of the wait, and automatically grabbed * when the condition is signaled. * * The mutex must be held when this procedure is called. * * Results: * None. * * Side effects: * May block the current thread. The mutex is acquired when this returns. * Will allocate memory for a HANDLE and initialize this the first time * this Tcl_Condition is used. * *---------------------------------------------------------------------- */ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ const Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ DWORD wtime; /* Windows time value */ int timeout; /* True if we got a timeout */ int doExit = 0; /* True if we need to do exit setup */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Self initialize the two parts of the condition. The per-condition and * per-thread parts need to be handled independently. */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { GLOBAL_LOCK; /* * Create the per-thread event and queue pointers. */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { tsdPtr->condEvent = CreateEventW(NULL, TRUE /* manual reset */, FALSE /* non signaled */, NULL); tsdPtr->nextPtr = NULL; tsdPtr->prevPtr = NULL; tsdPtr->flags = WIN_THREAD_RUNNING; doExit = 1; } GLOBAL_UNLOCK; if (doExit) { /* * Create a per-thread exit handler to clean up the condEvent. We * must be careful to do this outside the Global Lock because * Tcl_CreateThreadExitHandler uses its own ThreadSpecificData, * and initializing that may drop back into the Global Lock. */ Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr); } } if (*condPtr == NULL) { GLOBAL_LOCK; /* * Initialize the per-condition queue pointers and Mutex. */ if (*condPtr == NULL) { winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; *condPtr = (Tcl_Condition) winCondPtr; TclRememberCondition(condPtr); } GLOBAL_UNLOCK; } csPtr = *((CRITICAL_SECTION **)mutexPtr); winCondPtr = *((WinCondition **)condPtr); if (timePtr == NULL) { wtime = INFINITE; } else { wtime = timePtr->sec * 1000 + timePtr->usec / 1000; } /* * Queue the thread on the condition, using the per-condition lock for * serialization. */ tsdPtr->flags = WIN_THREAD_BLOCKED; tsdPtr->nextPtr = NULL; EnterCriticalSection(&winCondPtr->condLock); tsdPtr->prevPtr = winCondPtr->lastPtr; /* A: */ winCondPtr->lastPtr = tsdPtr; if (tsdPtr->prevPtr != NULL) { tsdPtr->prevPtr->nextPtr = tsdPtr; } if (winCondPtr->firstPtr == NULL) { winCondPtr->firstPtr = tsdPtr; } /* * Unlock the caller's mutex and wait for the condition, or a timeout. * There is a minor issue here in that we don't count down the timeout if * we get notified, but another thread grabs the condition before we do. * In that race condition we'll wait again for the full timeout. Timed * waits are dubious anyway. Either you have the locking protocol wrong * and are masking a deadlock, or you are using conditions to pause your * thread. */ LeaveCriticalSection(csPtr); timeout = 0; while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) { ResetEvent(tsdPtr->condEvent); LeaveCriticalSection(&winCondPtr->condLock); if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime, TRUE) == WAIT_TIMEOUT) { timeout = 1; } EnterCriticalSection(&winCondPtr->condLock); } /* * Be careful on timeouts because the signal might arrive right around the * time limit and someone else could have taken us off the queue. */ if (timeout) { if (tsdPtr->flags & WIN_THREAD_RUNNING) { timeout = 0; } else { /* * When dequeueing, we can leave the tsdPtr->nextPtr and * tsdPtr->prevPtr with dangling pointers because they are * reinitialized w/out reading them when the thread is enqueued * later. */ if (winCondPtr->firstPtr == tsdPtr) { winCondPtr->firstPtr = tsdPtr->nextPtr; } else { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } if (winCondPtr->lastPtr == tsdPtr) { winCondPtr->lastPtr = tsdPtr->prevPtr; } else { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->flags = WIN_THREAD_RUNNING; } } LeaveCriticalSection(&winCondPtr->condLock); EnterCriticalSection(csPtr); } /* *---------------------------------------------------------------------- * * Tcl_ConditionNotify -- * * This procedure is invoked to signal a condition variable. * * The mutex must be held during this call to avoid races, but this * interface does not enforce that. * * Results: * None. * * Side effects: * May unblock another thread. * *---------------------------------------------------------------------- */ void Tcl_ConditionNotify( Tcl_Condition *condPtr) { WinCondition *winCondPtr; ThreadSpecificData *tsdPtr; if (*condPtr != NULL) { winCondPtr = *((WinCondition **)condPtr); if (winCondPtr == NULL) { return; } /* * Loop through all the threads waiting on the condition and notify * them (i.e., broadcast semantics). The queue manipulation is guarded * by the per-condition coordinating mutex. */ EnterCriticalSection(&winCondPtr->condLock); while (winCondPtr->firstPtr != NULL) { tsdPtr = winCondPtr->firstPtr; winCondPtr->firstPtr = tsdPtr->nextPtr; if (winCondPtr->lastPtr == tsdPtr) { winCondPtr->lastPtr = NULL; } tsdPtr->flags = WIN_THREAD_RUNNING; tsdPtr->nextPtr = NULL; tsdPtr->prevPtr = NULL; /* Not strictly necessary, see A: */ SetEvent(tsdPtr->condEvent); } LeaveCriticalSection(&winCondPtr->condLock); } else { /* * No-one has used the condition variable, so there are no waiters. */ } } /* *---------------------------------------------------------------------- * * FinalizeConditionEvent -- * * This procedure is invoked to clean up the per-thread event used to * implement condition waiting. This is only safe to call at the end of * time. * * Results: * None. * * Side effects: * The per-thread event is closed. * *---------------------------------------------------------------------- */ static void FinalizeConditionEvent( ClientData data) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data; tsdPtr->flags = WIN_THREAD_UNINIT; CloseHandle(tsdPtr->condEvent); } /* *---------------------------------------------------------------------- * * TclpFinalizeCondition -- * * This procedure is invoked to clean up a condition variable. This is * only safe to call at the end of time. * * This assumes the Global Lock is held. * * Results: * None. * * Side effects: * The condition variable is deallocated. * *---------------------------------------------------------------------- */ void TclpFinalizeCondition( Tcl_Condition *condPtr) { WinCondition *winCondPtr = *(WinCondition **)condPtr; /* * Note - this is called long after the thread-local storage is reclaimed. * The per-thread condition waiting event is reclaimed earlier in a * per-thread exit handler, which is called before thread local storage is * reclaimed. */ if (winCondPtr != NULL) { DeleteCriticalSection(&winCondPtr->condLock); ckfree(winCondPtr); *condPtr = NULL; } } /* * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC Tcl_Mutex * TclpNewAllocMutex(void) { struct allocMutex *lockPtr; lockPtr = (struct allocMutex *)malloc(sizeof(struct allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock; InitializeCriticalSection(&lockPtr->wlock); return &lockPtr->tlock; } void TclpFreeAllocMutex( Tcl_Mutex *mutex) /* The alloc mutex to free. */ { allocMutex *lockPtr = (allocMutex *) mutex; if (!lockPtr) { return; } DeleteCriticalSection(&lockPtr->wlock); free(lockPtr); } void * TclpGetAllocCache(void) { void *result; if (!once) { /* * We need to make sure that TclpFreeAllocCache is called on each * thread that calls this, but only on threads that call this. */ tlsKey = TlsAlloc(); once = 1; if (tlsKey == TLS_OUT_OF_INDEXES) { Tcl_Panic("could not allocate thread local storage"); } } result = TlsGetValue(tlsKey); if ((result == NULL) && (GetLastError() != NO_ERROR)) { Tcl_Panic("TlsGetValue failed from TclpGetAllocCache"); } return result; } void TclpSetAllocCache( void *ptr) { BOOL success; success = TlsSetValue(tlsKey, ptr); if (!success) { Tcl_Panic("TlsSetValue failed from TclpSetAllocCache"); } } void TclpFreeAllocCache( void *ptr) { BOOL success; if (ptr != NULL) { /* * Called by TclFinalizeThreadAlloc() and * TclFinalizeThreadAllocThread() during Tcl_Finalize() or * Tcl_FinalizeThread(). This function destroys the tsd key which * stores allocator caches in thread local storage. */ TclFreeAllocCache(ptr); success = TlsSetValue(tlsKey, NULL); if (!success) { Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache"); } } else if (once) { /* * Called by us in TclFinalizeThreadAlloc() during the library * finalization initiated from Tcl_Finalize() */ success = TlsFree(tlsKey); if (!success) { Tcl_Panic("TlsFree failed from TclpFreeAllocCache"); } once = 0; /* reset for next time. */ } } #endif /* USE_THREAD_ALLOC */ void * TclpThreadCreateKey(void) { DWORD *key; key = (DWORD *)TclpSysAlloc(sizeof *key, 0); if (key == NULL) { Tcl_Panic("unable to allocate thread key!"); } *key = TlsAlloc(); if (*key == TLS_OUT_OF_INDEXES) { Tcl_Panic("unable to allocate thread-local storage"); } return key; } void TclpThreadDeleteKey( void *keyPtr) { DWORD *key = (DWORD *)keyPtr; if (!TlsFree(*key)) { Tcl_Panic("unable to delete key"); } TclpSysFree(keyPtr); } void TclpThreadSetGlobalTSD( void *tsdKeyPtr, void *ptr) { DWORD *key = (DWORD *)tsdKeyPtr; if (!TlsSetValue(*key, ptr)) { Tcl_Panic("unable to set global TSD value"); } } void * TclpThreadGetGlobalTSD( void *tsdKeyPtr) { DWORD *key = (DWORD *)tsdKeyPtr; return TlsGetValue(*key); } #endif /* TCL_THREADS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclWinTime.c0000644000175000017500000012131014554262142014660 0ustar sergeisergei/* * tclWinTime.c -- * * Contains Windows specific versions of Tcl functions that obtain time * values from the operating system. * * Copyright 1995-1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #define SECSPERDAY (60L * 60L * 24L) #define SECSPERYEAR (SECSPERDAY * 365L) #define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) /* * Number of samples over which to estimate the performance counter. */ #define SAMPLES 64 /* * The following arrays contain the day of year for the last day of each * month, where index 1 is January. */ static const int normalDays[] = { -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 }; static const int leapDays[] = { -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 }; typedef struct ThreadSpecificData { char tzName[64]; /* Time zone name */ struct tm tm; /* time information */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Data for managing high-resolution timers. */ typedef struct TimeInfo { CRITICAL_SECTION cs; /* Mutex guarding this structure. */ int initialized; /* Flag == 1 if this structure is * initialized. */ int perfCounterAvailable; /* Flag == 1 if the hardware has a performance * counter. */ DWORD calibrationInterv; /* Calibration interval in seconds (start 1 sec) */ HANDLE calibrationThread; /* Handle to the thread that keeps the virtual * clock calibrated. */ HANDLE readyEvent; /* System event used to trigger the requesting * thread when the clock calibration procedure * is initialized for the first time. */ HANDLE exitEvent; /* Event to signal out of an exit handler to * tell the calibration loop to terminate. */ LARGE_INTEGER nominalFreq; /* Nominal frequency of the system performance * counter, that is, the value returned from * QueryPerformanceFrequency. */ /* * The following values are used for calculating virtual time. Virtual * time is always equal to: * lastFileTime + (current perf counter - lastCounter) * * 10000000 / curCounterFreq * and lastFileTime and lastCounter are updated any time that virtual time * is returned to a caller. */ ULARGE_INTEGER fileTimeLastCall; LARGE_INTEGER perfCounterLastCall; LARGE_INTEGER curCounterFreq; LARGE_INTEGER posixEpoch; /* Posix epoch expressed as 100-ns ticks since * the windows epoch. */ /* * Data used in developing the estimate of performance counter frequency */ Tcl_WideUInt fileTimeSample[SAMPLES]; /* Last 64 samples of system time. */ Tcl_WideInt perfCounterSample[SAMPLES]; /* Last 64 samples of performance counter. */ int sampleNo; /* Current sample number. */ } TimeInfo; static TimeInfo timeInfo = { { NULL, 0, 0, NULL, NULL, 0 }, 0, 0, 1, (HANDLE) NULL, (HANDLE) NULL, (HANDLE) NULL, #ifdef HAVE_CAST_TO_UNION (LARGE_INTEGER) (Tcl_WideInt) 0, (ULARGE_INTEGER) (DWORDLONG) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, #else {0, 0}, {0, 0}, {0, 0}, {0, 0}, {0, 0}, #endif { 0 }, { 0 }, 0 }; /* * Scale to convert wide click values from the TclpGetWideClicks native * resolution to microsecond resolution and back. */ static struct { int initialized; /* 1 if initialized, 0 otherwise */ int perfCounter; /* 1 if performance counter usable for wide * clicks */ double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; /* * Declarations for functions defined later in this file. */ static struct tm * ComputeGMT(const time_t *tp); static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); static void ResetCounterSamples(Tcl_WideUInt fileTime, Tcl_WideInt perfCounter, Tcl_WideInt perfFreq); static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter, Tcl_WideUInt fileTime); static void NativeScaleTime(Tcl_Time* timebuf, ClientData clientData); static Tcl_WideInt NativeGetMicroseconds(void); static void NativeGetTime(Tcl_Time* timebuf, ClientData clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. */ Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; ClientData tclTimeClientData = NULL; /* *---------------------------------------------------------------------- * * TclpGetSeconds -- * * This procedure returns the number of seconds from the epoch. On most * Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of seconds from the epoch. * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned long TclpGetSeconds(void) { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { return usecSincePosixEpoch / 1000000; } else { Tcl_Time t; tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */ return t.sec; } } /* *---------------------------------------------------------------------- * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no guarantees on what the * resolution will be. In Tcl we will call this value a "click". The * start time is also system dependent. * * Results: * Number of clicks from some start time. * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned long TclpGetClicks(void) { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { return (unsigned long)usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as * nearly as we can, and return it. */ Tcl_Time now; /* Current Tcl time */ tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ return ((unsigned long)(now.sec)*1000000UL) + (unsigned long)(now.usec); } } /* *---------------------------------------------------------------------- * * TclpGetWideClicks -- * * This procedure returns a WideInt value that represents the highest * resolution clock in microseconds available on the system. * * Results: * Number of microseconds (from some start time). * * Side effects: * This should be used for time-delta resp. for measurement purposes * only, because on some platforms can return microseconds from some * start time (not from the epoch). * *---------------------------------------------------------------------- */ Tcl_WideInt TclpGetWideClicks(void) { LARGE_INTEGER curCounter; if (!wideClick.initialized) { LARGE_INTEGER perfCounterFreq; /* * The frequency of the performance counter is fixed at system boot and * is consistent across all processors. Therefore, the frequency need * only be queried upon application initialization. */ if (QueryPerformanceFrequency(&perfCounterFreq)) { wideClick.perfCounter = 1; wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart; } else { /* fallback using microseconds */ wideClick.perfCounter = 0; wideClick.microsecsScale = 1; } wideClick.initialized = 1; } if (wideClick.perfCounter) { if (QueryPerformanceCounter(&curCounter)) { return (Tcl_WideInt)curCounter.QuadPart; } /* fallback using microseconds */ wideClick.perfCounter = 0; wideClick.microsecsScale = 1; return TclpGetMicroseconds(); } else { return TclpGetMicroseconds(); } } /* *---------------------------------------------------------------------- * * TclpWideClickInMicrosec -- * * This procedure return scale to convert wide click values from the * TclpGetWideClicks native resolution to microsecond resolution * and back. * * Results: * 1 click in microseconds as double. * * Side effects: * None. * *---------------------------------------------------------------------- */ double TclpWideClickInMicrosec(void) { if (!wideClick.initialized) { (void)TclpGetWideClicks(); /* initialize */ } return wideClick.microsecsScale; } /* *---------------------------------------------------------------------- * * TclpGetMicroseconds -- * * This procedure returns a WideInt value that represents the highest * resolution clock in microseconds available on the system. * * Results: * Number of microseconds (from the epoch). * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_WideInt TclpGetMicroseconds(void) { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { return usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as * nearly as we can, and return it. */ Tcl_Time now; tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ return (((Tcl_WideInt)now.sec) * 1000000) + now.usec; } } /* *---------------------------------------------------------------------- * * Tcl_GetTime -- * * Gets the current system time in seconds and microseconds since the * beginning of the epoch: 00:00 UCT, January 1, 1970. * * Results: * Returns the current time in timePtr. * * Side effects: * On the first call, initializes a set of static variables to keep track * of the base value of the performance counter, the corresponding wall * clock (obtained through ftime) and the frequency of the performance * counter. Also spins a thread whose function is to wake up periodically * and monitor these values, adjusting them as necessary to correct for * drift in the performance counter's oscillator. * *---------------------------------------------------------------------- */ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { timePtr->sec = (long) (usecSincePosixEpoch / 1000000); timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); } else { tclGetTimeProcPtr(timePtr, tclTimeClientData); } } /* *---------------------------------------------------------------------- * * NativeScaleTime -- * * TIP #233: Scale from virtual time to the real-time. For native scaling * the relationship is 1:1 and nothing has to be done. * * Results: * Scales the time in timePtr. * * Side effects: * See above. * *---------------------------------------------------------------------- */ static void NativeScaleTime( Tcl_Time *timePtr, ClientData clientData) { /* * Native scale is 1:1. Nothing is done. */ } /* *---------------------------------------------------------------------- * * NativeGetMicroseconds -- * * Gets the current system time in microseconds since the beginning * of the epoch: 00:00 UCT, January 1, 1970. * * Results: * Returns the wide integer with number of microseconds from the epoch, or * 0 if high resolution timer is not available. * * Side effects: * On the first call, initializes a set of static variables to keep track * of the base value of the performance counter, the corresponding wall * clock (obtained through ftime) and the frequency of the performance * counter. Also spins a thread whose function is to wake up periodically * and monitor these values, adjusting them as necessary to correct for * drift in the performance counter's oscillator. * *---------------------------------------------------------------------- */ static inline Tcl_WideInt NativeCalc100NsTicks( ULONGLONG fileTimeLastCall, LONGLONG perfCounterLastCall, LONGLONG curCounterFreq, LONGLONG curCounter ) { return fileTimeLastCall + ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq); } static Tcl_WideInt NativeGetMicroseconds(void) { /* * Initialize static storage on the first trip through. * * Note: Outer check for 'initialized' is a performance win since it * avoids an extra mutex lock in the common case. */ if (!timeInfo.initialized) { TclpInitLock(); if (!timeInfo.initialized) { timeInfo.posixEpoch.LowPart = 0xD53E8000; timeInfo.posixEpoch.HighPart = 0x019DB1DE; timeInfo.perfCounterAvailable = QueryPerformanceFrequency(&timeInfo.nominalFreq); /* * Some hardware abstraction layers use the CPU clock in place of * the real-time clock as a performance counter reference. This * results in: * - inconsistent results among the processors on * multi-processor systems. * - unpredictable changes in performance counter frequency on * "gearshift" processors such as Transmeta and SpeedStep. * * There seems to be no way to test whether the performance * counter is reliable, but a useful heuristic is that if its * frequency is 1.193182 MHz or 3.579545 MHz, it's derived from a * colorburst crystal and is therefore the RTC rather than the * TSC. * * A sloppier but serviceable heuristic is that the RTC crystal is * normally less than 15 MHz while the TSC crystal is virtually * assured to be greater than 100 MHz. Since Win98SE appears to * fiddle with the definition of the perf counter frequency * (perhaps in an attempt to calibrate the clock?), we use the * latter rule rather than an exact match. * * We also assume (perhaps questionably) that the vendors have * gotten their act together on Win64, so bypass all this rubbish * on that platform. */ #if !defined(_WIN64) if (timeInfo.perfCounterAvailable /* * The following lines would do an exact match on crystal * frequency: * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)1193182 * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)3579545 */ && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000){ /* * As an exception, if every logical processor on the system * is on the same chip, we use the performance counter anyway, * presuming that everyone's TSC is locked to the same * oscillator. */ SYSTEM_INFO systemInfo; unsigned int regs[4]; GetSystemInfo(&systemInfo); if (TclWinCPUID(0, regs) == TCL_OK && regs[1] == 0x756E6547 /* "Genu" */ && regs[3] == 0x49656E69 /* "ineI" */ && regs[2] == 0x6C65746E /* "ntel" */ && TclWinCPUID(1, regs) == TCL_OK && ((regs[0]&0x00000F00) == 0x00000F00 /* Pentium 4 */ || ((regs[0] & 0x00F00000) /* Extended family */ && (regs[3] & 0x10000000))) /* Hyperthread */ && (((regs[1]&0x00FF0000) >> 16)/* CPU count */ == systemInfo.dwNumberOfProcessors)) { timeInfo.perfCounterAvailable = TRUE; } else { timeInfo.perfCounterAvailable = FALSE; } } #endif /* above code is Win32 only */ /* * If the performance counter is available, start a thread to * calibrate it. */ if (timeInfo.perfCounterAvailable) { DWORD id; InitializeCriticalSection(&timeInfo.cs); timeInfo.readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); timeInfo.exitEvent = CreateEventW(NULL, FALSE, FALSE, NULL); timeInfo.calibrationThread = CreateThread(NULL, 256, CalibrationThread, (LPVOID) NULL, 0, &id); SetThreadPriority(timeInfo.calibrationThread, THREAD_PRIORITY_HIGHEST); /* * Wait for the thread just launched to start running, and * create an exit handler that kills it so that it doesn't * outlive unloading tclXX.dll */ WaitForSingleObject(timeInfo.readyEvent, INFINITE); CloseHandle(timeInfo.readyEvent); Tcl_CreateExitHandler(StopCalibration, NULL); } timeInfo.initialized = TRUE; } TclpInitUnlock(); } if (timeInfo.perfCounterAvailable && timeInfo.curCounterFreq.QuadPart!=0) { /* * Query the performance counter and use it to calculate the current * time. */ ULONGLONG fileTimeLastCall; LONGLONG perfCounterLastCall, curCounterFreq; /* Copy with current data of calibration cycle */ LARGE_INTEGER curCounter; /* Current performance counter. */ QueryPerformanceCounter(&curCounter); /* * Hold time section locked as short as possible */ EnterCriticalSection(&timeInfo.cs); fileTimeLastCall = timeInfo.fileTimeLastCall.QuadPart; perfCounterLastCall = timeInfo.perfCounterLastCall.QuadPart; curCounterFreq = timeInfo.curCounterFreq.QuadPart; LeaveCriticalSection(&timeInfo.cs); /* * If calibration cycle occurred after we get curCounter */ if (curCounter.QuadPart <= perfCounterLastCall) { /* * Calibrated file-time is saved from Posix in 100-ns ticks */ return fileTimeLastCall / 10; } /* * If it appears to be more than 1.1 seconds since the last trip * through the calibration loop, the performance counter may have * jumped forward. (See MSDN Knowledge Base article Q274323 for a * description of the hardware problem that makes this test * necessary.) If the counter jumps, we don't want to use it directly. * Instead, we must return system time. Eventually, the calibration * loop should recover. */ if (curCounter.QuadPart - perfCounterLastCall < 11 * curCounterFreq * timeInfo.calibrationInterv / 10 ) { /* Calibrated file-time is saved from Posix in 100-ns ticks */ return NativeCalc100NsTicks(fileTimeLastCall, perfCounterLastCall, curCounterFreq, curCounter.QuadPart) / 10; } } /* * High resolution timer is not available. */ return 0; } /* *---------------------------------------------------------------------- * * NativeGetTime -- * * TIP #233: Gets the current system time in seconds and microseconds * since the beginning of the epoch: 00:00 UCT, January 1, 1970. * * Results: * Returns the current time in timePtr. * * Side effects: * See NativeGetMicroseconds for more information. * *---------------------------------------------------------------------- */ static void NativeGetTime( Tcl_Time *timePtr, ClientData clientData) { Tcl_WideInt usecSincePosixEpoch; /* * Try to use high resolution timer. */ if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) { timePtr->sec = (long) (usecSincePosixEpoch / 1000000); timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); } else { /* * High resolution timer is not available. Just use ftime. */ struct _timeb t; _ftime(&t); timePtr->sec = (long)t.time; timePtr->usec = t.millitm * 1000; } } /* *---------------------------------------------------------------------- * * StopCalibration -- * * Turns off the calibration thread in preparation for exiting the * process. * * Results: * None. * * Side effects: * Sets the 'exitEvent' event in the 'timeInfo' structure to ask the * thread in question to exit, and waits for it to do so. * *---------------------------------------------------------------------- */ void TclWinResetTimerResolution(void); static void StopCalibration( ClientData unused) /* Client data is unused */ { SetEvent(timeInfo.exitEvent); /* * If Tcl_Finalize was called from DllMain, the calibration thread is in a * paused state so we need to timeout and continue. */ WaitForSingleObject(timeInfo.calibrationThread, 100); CloseHandle(timeInfo.exitEvent); CloseHandle(timeInfo.calibrationThread); } /* *---------------------------------------------------------------------- * * TclpGetDate -- * * This function converts between seconds and struct tm. If useGMT is * true, then the returned date will be in Greenwich Mean Time (GMT). * Otherwise, it will be in the local time zone. * * Results: * Returns a static tm structure. * * Side effects: * None. * *---------------------------------------------------------------------- */ struct tm * TclpGetDate( const time_t *t, int useGMT) { struct tm *tmPtr; time_t time; #if defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)) # define t2 *t /* no need to cripple time to 32-bit */ #else time_t t2 = *(__time32_t *)t; #endif if (!useGMT) { #if defined(_MSC_VER) && (_MSC_VER >= 1900) # undef timezone /* prevent conflict with timezone() function */ long timezone = 0; #endif tzset(); /* * If we are in the valid range, let the C run-time library handle it. * Otherwise we need to fake it. Note that this algorithm ignores * daylight savings time before the epoch. */ /* * Hmm, Borland's localtime manages to return NULL under certain * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, * since 'localtime' isn't supposed to do this, possibly leading to * crashes. * * Patch: We only call this function if we are at least one day into * the epoch, else we handle it ourselves (like we do for times < 0). * H. Giese, June 2003 */ #ifdef __BORLANDC__ #define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY #else #define LOCALTIME_VALIDITY_BOUNDARY 0 #endif if (t2 >= LOCALTIME_VALIDITY_BOUNDARY) { return TclpLocaltime(&t2); } #if defined(_MSC_VER) && (_MSC_VER >= 1900) _get_timezone(&timezone); #endif time = t2 - timezone; /* * If we aren't near to overflowing the long, just add the bias and * use the normal calculation. Otherwise we will need to adjust the * result at the end. */ if (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) { tmPtr = ComputeGMT(&time); } else { tmPtr = ComputeGMT(&t2); tzset(); /* * Add the bias directly to the tm structure to avoid overflow. * Propagate seconds overflow into minutes, hours and days. */ time = tmPtr->tm_sec - timezone; tmPtr->tm_sec = (int)(time % 60); if (tmPtr->tm_sec < 0) { tmPtr->tm_sec += 60; time -= 60; } time = tmPtr->tm_min + time/60; tmPtr->tm_min = (int)(time % 60); if (tmPtr->tm_min < 0) { tmPtr->tm_min += 60; time -= 60; } time = tmPtr->tm_hour + time/60; tmPtr->tm_hour = (int)(time % 24); if (tmPtr->tm_hour < 0) { tmPtr->tm_hour += 24; time -= 24; } time /= 24; tmPtr->tm_mday += (int)time; tmPtr->tm_yday += (int)time; tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; } } else { tmPtr = ComputeGMT(&t2); } return tmPtr; } /* *---------------------------------------------------------------------- * * ComputeGMT -- * * This function computes GMT given the number of seconds since the epoch * (midnight Jan 1 1970). * * Results: * Returns a (per thread) statically allocated struct tm. * * Side effects: * Updates the values of the static struct tm. * *---------------------------------------------------------------------- */ static struct tm * ComputeGMT( const time_t *tp) { struct tm *tmPtr; long tmp, rem; int isLeap; const int *days; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tmPtr = &tsdPtr->tm; /* * Compute the 4 year span containing the specified time. */ tmp = (long)(*tp / SECSPER4YEAR); rem = (long)(*tp % SECSPER4YEAR); /* * Correct for weird mod semantics so the remainder is always positive. */ if (rem < 0) { tmp--; rem += SECSPER4YEAR; } /* * Compute the year after 1900 by taking the 4 year span and adjusting for * the remainder. This works because 2000 is a leap year, and 1900/2100 * are out of the range. */ tmp = (tmp * 4) + 70; isLeap = 0; if (rem >= SECSPERYEAR) { /* 1971, etc. */ tmp++; rem -= SECSPERYEAR; if (rem >= SECSPERYEAR) { /* 1972, etc. */ tmp++; rem -= SECSPERYEAR; if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ tmp++; rem -= SECSPERYEAR + SECSPERDAY; } else { isLeap = 1; } } } tmPtr->tm_year = tmp; /* * Compute the day of year and leave the seconds in the current day in the * remainder. */ tmPtr->tm_yday = rem / SECSPERDAY; rem %= SECSPERDAY; /* * Compute the time of day. */ tmPtr->tm_hour = rem / 3600; rem %= 3600; tmPtr->tm_min = rem / 60; tmPtr->tm_sec = rem % 60; /* * Compute the month and day of month. */ days = (isLeap) ? leapDays : normalDays; for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { /* empty body */ } tmPtr->tm_mon = --tmp; tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; /* * Compute day of week. Epoch started on a Thursday. */ tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; if ((*tp % SECSPERDAY) < 0) { tmPtr->tm_wday--; } tmPtr->tm_wday %= 7; if (tmPtr->tm_wday < 0) { tmPtr->tm_wday += 7; } return tmPtr; } /* *---------------------------------------------------------------------- * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from * the performance counter, to keep it synchronized with the system * clock. * * Parameters: * arg - Client data from the CreateThread call. This parameter points to * the static TimeInfo structure. * * Return value: * None. This thread embeds an infinite loop. * * Side effects: * At an interval of 1s, this thread performs virtual time discipline. * * Note: When this thread is entered, TclpInitLock has been called to * safeguard the static storage. There is therefore no synchronization in the * body of this procedure. * *---------------------------------------------------------------------- */ static DWORD WINAPI CalibrationThread( LPVOID arg) { FILETIME curFileTime; DWORD waitResult; /* * Get initial system time and performance counter. */ GetSystemTimeAsFileTime(&curFileTime); QueryPerformanceCounter(&timeInfo.perfCounterLastCall); QueryPerformanceFrequency(&timeInfo.curCounterFreq); timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime; timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; /* Calibrated file-time will be saved from Posix in 100-ns ticks */ timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart; ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart); /* * Wake up the calling thread. When it wakes up, it will release the * initialization lock. */ SetEvent(timeInfo.readyEvent); /* * Run the calibration once a second. */ while (timeInfo.perfCounterAvailable) { /* * If the exitEvent is set, break out of the loop. */ waitResult = WaitForSingleObjectEx(timeInfo.exitEvent, 1000, FALSE); if (waitResult == WAIT_OBJECT_0) { break; } UpdateTimeEachSecond(); } return (DWORD) 0; } /* *---------------------------------------------------------------------- * * UpdateTimeEachSecond -- * * Callback from the waitable timer in the clock calibration thread that * updates system time. * * Parameters: * info - Pointer to the static TimeInfo structure * * Results: * None. * * Side effects: * Performs virtual time calibration discipline. * *---------------------------------------------------------------------- */ static void UpdateTimeEachSecond(void) { LARGE_INTEGER curPerfCounter; /* Current value returned from * QueryPerformanceCounter. */ FILETIME curSysTime; /* Current system time. */ static LARGE_INTEGER lastFileTime; /* File time of the previous calibration */ LARGE_INTEGER curFileTime; /* File time at the time this callback was * scheduled. */ Tcl_WideInt estFreq; /* Estimated perf counter frequency. */ Tcl_WideInt vt0; /* Tcl time right now. */ Tcl_WideInt vt1; /* Tcl time one second from now. */ Tcl_WideInt tdiff; /* Difference between system clock and Tcl * time. */ Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time into * step over 1 second. */ /* * Sample performance counter and system time (from Posix epoch). */ GetSystemTimeAsFileTime(&curSysTime); curFileTime.LowPart = curSysTime.dwLowDateTime; curFileTime.HighPart = curSysTime.dwHighDateTime; curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart; /* If calibration still not needed (check for possible time switch) */ if ( curFileTime.QuadPart > lastFileTime.QuadPart && curFileTime.QuadPart < lastFileTime.QuadPart + (timeInfo.calibrationInterv * 10000000) ) { /* again in next one second */ return; } QueryPerformanceCounter(&curPerfCounter); lastFileTime.QuadPart = curFileTime.QuadPart; /* * We divide by timeInfo.curCounterFreq.QuadPart in several places. That * value should always be positive on a correctly functioning system. But * it is good to be defensive about such matters. So if something goes * wrong and the value does goes to zero, we clear the * timeInfo.perfCounterAvailable in order to cause the calibration thread * to shut itself down, then return without additional processing. */ if (timeInfo.curCounterFreq.QuadPart == 0){ timeInfo.perfCounterAvailable = 0; return; } /* * Several things may have gone wrong here that have to be checked for. * (1) The performance counter may have jumped. * (2) The system clock may have been reset. * * In either case, we'll need to reinitialize the circular buffer with * samples relative to the current system time and the NOMINAL performance * frequency (not the actual, because the actual has probably run slow in * the first case). Our estimated frequency will be the nominal frequency. * * Store the current sample into the circular buffer of samples, and * estimate the performance counter frequency. */ estFreq = AccumulateSample(curPerfCounter.QuadPart, (Tcl_WideUInt) curFileTime.QuadPart); /* * We want to adjust things so that time appears to be continuous. * Virtual file time, right now, is * * vt0 = 10000000 * (curPerfCounter - perfCounterLastCall) * / curCounterFreq * + fileTimeLastCall * * Ideally, we would like to drift the clock into place over a period of 2 * sec, so that virtual time 2 sec from now will be * * vt1 = 20000000 + curFileTime * * The frequency that we need to use to drift the counter back into place * is estFreq * 20000000 / (vt1 - vt0) */ vt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, curPerfCounter.QuadPart); /* * If we've gotten more than a second away from system time, then drifting * the clock is going to be pretty hopeless. Just let it jump. Otherwise, * compute the drift frequency and fill in everything. */ tdiff = vt0 - curFileTime.QuadPart; if (tdiff > 10000000 || tdiff < -10000000) { /* jump to current system time, use curent estimated frequency */ vt0 = curFileTime.QuadPart; } else { /* calculate new frequency and estimate drift to the next second */ vt1 = 20000000 + curFileTime.QuadPart; driftFreq = (estFreq * 20000000 / (vt1 - vt0)); /* * Avoid too large drifts (only half of the current difference), * that allows also be more accurate (aspire to the smallest tdiff), * so then we can prolong calibration interval by tdiff < 100000 */ driftFreq = timeInfo.curCounterFreq.QuadPart + (driftFreq - timeInfo.curCounterFreq.QuadPart) / 2; /* * Average between estimated, 2 current and 5 drifted frequencies, * (do the soft drifting as possible) */ estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + 5 * driftFreq) / 8; } /* Avoid too large discrepancy from nominal frequency */ if (estFreq > 1003*timeInfo.nominalFreq.QuadPart/1000) { estFreq = 1003*timeInfo.nominalFreq.QuadPart/1000; vt0 = curFileTime.QuadPart; } else if (estFreq < 997*timeInfo.nominalFreq.QuadPart/1000) { estFreq = 997*timeInfo.nominalFreq.QuadPart/1000; vt0 = curFileTime.QuadPart; } else if (vt0 != curFileTime.QuadPart) { /* * Be sure the clock ticks never backwards (avoid it by negative drifting) * just compare native time (in 100-ns) before and hereafter using * new calibrated values) and do a small adjustment (short time freeze) */ LARGE_INTEGER newPerfCounter; Tcl_WideInt nt0, nt1; QueryPerformanceCounter(&newPerfCounter); nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, newPerfCounter.QuadPart); nt1 = NativeCalc100NsTicks(vt0, curPerfCounter.QuadPart, estFreq, newPerfCounter.QuadPart); if (nt0 > nt1) { /* drifted backwards, try to compensate with new base */ /* first adjust with a micro jump (short frozen time is acceptable) */ vt0 += nt0 - nt1; /* if drift unavoidable (e. g. we had a time switch), then reset it */ vt1 = vt0 - curFileTime.QuadPart; if (vt1 > 10000000 || vt1 < -10000000) { /* larger jump resp. shift relative new file-time */ vt0 = curFileTime.QuadPart; } } } /* In lock commit new values to timeInfo (hold lock as short as possible) */ EnterCriticalSection(&timeInfo.cs); /* grow calibration interval up to 10 seconds (if still precise enough) */ if (tdiff < -100000 || tdiff > 100000) { /* too long drift - reset calibration interval to 1000 second */ timeInfo.calibrationInterv = 1; } else if (timeInfo.calibrationInterv < 10) { timeInfo.calibrationInterv++; } timeInfo.fileTimeLastCall.QuadPart = vt0; timeInfo.curCounterFreq.QuadPart = estFreq; timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart; LeaveCriticalSection(&timeInfo.cs); } /* *---------------------------------------------------------------------- * * ResetCounterSamples -- * * Fills the sample arrays in 'timeInfo' with dummy values that will * yield the current performance counter and frequency. * * Results: * None. * * Side effects: * The array of samples is filled in so that it appears that there are * SAMPLES samples at one-second intervals, separated by precisely the * given frequency. * *---------------------------------------------------------------------- */ static void ResetCounterSamples( Tcl_WideUInt fileTime, /* Current file time */ Tcl_WideInt perfCounter, /* Current performance counter */ Tcl_WideInt perfFreq) /* Target performance frequency */ { int i; for (i=SAMPLES-1 ; i>=0 ; --i) { timeInfo.perfCounterSample[i] = perfCounter; timeInfo.fileTimeSample[i] = fileTime; perfCounter -= perfFreq; fileTime -= 10000000; } timeInfo.sampleNo = 0; } /* *---------------------------------------------------------------------- * * AccumulateSample -- * * Updates the circular buffer of performance counter and system time * samples with a new data point. * * Results: * None. * * Side effects: * The new data point replaces the oldest point in the circular buffer, * and the descriptive statistics are updated to accumulate the new * point. * * Several things may have gone wrong here that have to be checked for. * (1) The performance counter may have jumped. * (2) The system clock may have been reset. * * In either case, we'll need to reinitialize the circular buffer with samples * relative to the current system time and the NOMINAL performance frequency * (not the actual, because the actual has probably run slow in the first * case). */ static Tcl_WideInt AccumulateSample( Tcl_WideInt perfCounter, Tcl_WideUInt fileTime) { Tcl_WideUInt workFTSample; /* File time sample being removed from or * added to the circular buffer. */ Tcl_WideInt workPCSample; /* Performance counter sample being removed * from or added to the circular buffer. */ Tcl_WideUInt lastFTSample; /* Last file time sample recorded */ Tcl_WideInt lastPCSample; /* Last performance counter sample recorded */ Tcl_WideInt FTdiff; /* Difference between last FT and current */ Tcl_WideInt PCdiff; /* Difference between last PC and current */ Tcl_WideInt estFreq; /* Estimated performance counter frequency */ /* * Test for jumps and reset the samples if we have one. */ if (timeInfo.sampleNo == 0) { lastPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo + SAMPLES - 1]; lastFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo + SAMPLES - 1]; } else { lastPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo - 1]; lastFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo - 1]; } PCdiff = perfCounter - lastPCSample; FTdiff = fileTime - lastFTSample; if (PCdiff < timeInfo.nominalFreq.QuadPart * 9 / 10 || PCdiff > timeInfo.nominalFreq.QuadPart * 11 / 10 || FTdiff < 9000000 || FTdiff > 11000000) { ResetCounterSamples(fileTime, perfCounter, timeInfo.nominalFreq.QuadPart); return timeInfo.nominalFreq.QuadPart; } else { /* * Estimate the frequency. */ workPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo]; workFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo]; estFreq = 10000000 * (perfCounter - workPCSample) / (fileTime - workFTSample); timeInfo.perfCounterSample[timeInfo.sampleNo] = perfCounter; timeInfo.fileTimeSample[timeInfo.sampleNo] = (Tcl_WideInt) fileTime; /* * Advance the sample number. */ if (++timeInfo.sampleNo >= SAMPLES) { timeInfo.sampleNo = 0; } return estFreq; } } /* *---------------------------------------------------------------------- * * TclpGmtime -- * * Wrapper around the 'gmtime' library function to make it thread safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes gmtime or gmtime_r as appropriate. * *---------------------------------------------------------------------- */ struct tm * TclpGmtime( const time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ { /* * The MS implementation of gmtime is thread safe because it returns the * time in a block of thread-local storage, and Windows does not provide a * Posix gmtime_r function. */ #if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) return gmtime(timePtr); #else return _gmtime32((const __time32_t *)timePtr); #endif } /* *---------------------------------------------------------------------- * * TclpLocaltime -- * * Wrapper around the 'localtime' library function to make it thread * safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes localtime or localtime_r as appropriate. * *---------------------------------------------------------------------- */ struct tm * TclpLocaltime( const time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ { /* * The MS implementation of localtime is thread safe because it returns * the time in a block of thread-local storage, and Windows does not * provide a Posix localtime_r function. */ #if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) return localtime(timePtr); #else return _localtime32((const __time32_t *)timePtr); #endif } /* *---------------------------------------------------------------------- * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the * virtualization of Tcl's access to time information. * * Results: * None. * * Side effects: * Remembers the handlers, alters core behaviour. * *---------------------------------------------------------------------- */ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; tclTimeClientData = clientData; } /* *---------------------------------------------------------------------- * * Tcl_QueryTimeProc -- * * TIP #233 (Virtualized Time): Query which time handlers are registered. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; } if (scaleProc) { *scaleProc = tclScaleTimeProcPtr; } if (clientData) { *clientData = tclTimeClientData; } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/win/tclsh.ico0000644000175000017500000015727614554262142014272 0ustar sergeisergei @@ (Bж00 Ј%ўB  ЈІh ˆ Ny hж‚00Ј>‡ Ј цЃHŽАhжЗ00Ј>Л ЈцЩШŽвhVй(@€ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџYџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ7дџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ киџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ—џиџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ%џџиџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ0џџиџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ0џџиџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ0џџиџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ0џџиџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ0џџкџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ3џџў%џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџNџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ–џџџю џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ{џџџџџЄ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ.—єџџџџџџџё~џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ+mзџџџџџџџЦџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ@їџџџџџџџџХџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ/ёџёqsnцџџџR2е% Еђџч+џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџеџ*+)ёнррџббШєћџџmC#яЄe4џ•\/жЦџрџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџˆџђймлџьююџнркўеџџmC#яЄe4џЄe4џЁc3э ЏџШџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџњџ˜›˜§ьююџьююџдЮСџ ДџџmC#яЄe4џЄe4џЄe4џЄe4ѕ ДџžџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџbџѓъььџьююџьююџФБšџ-ІџџkB"эЄe4џЄe4џЄe4џЄe4џ`1лжў;џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЗџ}}zњшэьџыээџыююџД’pџ]9ЉџџU4сЄe4џЄe4џЄe4џЄe4џЄe4џyK'­§Юџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџцћdd_хђъььџотнџЅj9џŒV-Мџџ:$йЄe4џЄe4џЄe4џЄe4џЄe4џЄe4ќ Гџgџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџѓџџ іьююџЯХЗџЄe4џЄe4уьџ! кЄe4џЄe4џЄe4џЄe4џ›`1№Ёc3ўN(Б§еџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџўѓј ђьююџУЎ—џЄe4џЄe4џТџ тЄe4џЄe4џЄe4џЄe4џX.Щы и№џ.џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ  ї552ёьююџТЎ–џЄe4џЄe4џ+ІџїŸb3џЄe4џЄe4џЄe4џЄe4џ7"Ѓџџџ‡џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџLLIѓьююџУАšџЄe4џЄe4џ{K'ВџџuH%ѓЄe4џЄe4џЄe4џЄe4џЁd3ъаў€qџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ5џGFCђьююџХДžџЄe4џЄe4џЄe4ыпџ:$йЄe4џЄe4џЄe4џЄe4џЄe4џrF$­§й џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџEџ&%#ёьююџЧЖЂџЄe4џЄe4џЄe4џЋџ хЄe4џЄe4џЄe4џЄe4џЄe4џЄe4§ ЋџЄџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ!џ іьююџЩКЇџЄe4џЄe4џЄe4џ`;Їџџ’Z.џЄe4џЄe4џЄe4џЄe4џЄe4џ•\0ЦђџVџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџѕџсууџдаФџЄe4џЄe4џЄe4џ d3дёџ\9фЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ ЅџиџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЮџЖИИџтчхџЇqDџЄe4џЄe4џЄe4џ Еџ" йЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ“[/Уєџ\џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЄџbb^іьююџИš{џЄe4џЄe4џЄe4џF,ЁџєЂd3џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЇџиџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџnџєьююџФДџЄe4џЄe4џЄe4џ”[/Оќџ|L'їЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џY.Піџ\џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџЙМЛџвЮСџЄe4џЄe4џЄe4џЄe4ќ Дџ+иЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ Њџвџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџаџ^^ZітчхџЈsGџЄe4џЄe4џЄe4џrG$Њџљ–]0џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џP)Бўџ6џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ€џѕьююџК ƒџЄe4џЄe4џЄe4џЄe4ѕТџH,мЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4њЛџšџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ0џџДИЖџЪМЊџЉvJџШОЌџЈtHџЄe4џ\:ЃџэЁc3џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џc=Ѕџѓ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџпџ[[WіпсмџорлџыююџБŠfџЄe4џЄe4ыгџe? шЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄd4ьгџcџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ}џѕъььџ–›–№дззџЖ–vџЄe4џЄe4џG, џ рЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џA) џЧџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџњџ''%сџЈ­ЌџЛ ƒџЄe4џЄe4џЁc3псџO)ѕЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џŸb2ишџ,џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЉџџџ‚„ћЦЕžџЄe4џЄe4џЄe4џ3Ёџ( иЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ% Ѓџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ@џзџ^^ZіииаџЄg6џЄe4џЄe4џša1аьћ‘Y.ќЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ“Z.РїэџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџАћ21/ђыююџГ’pџЄe4џЄe4џЄe4џA(Ёџ5!йЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ ­џXџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџвўЫЮЭџШКЅџЄe4џЄe4џЄe4џЄe4ёХј•\/ўЄe4џЄe4џЄe4џЄe4џxK&И ЭйџНџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџŸџ[[XіпсмџЊxMџЄe4џЄe4џЄe4џ„Q*Лї;$йЄe4џЄe4џЄe4џЄe4џЄe4їДџл†џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ6џјтффџЧЛЈџЄe4џЄe4џЄe4џЄe4џ,Іѕ˜]0џЄe4џЄe4џЄe4џЄe4џ˜^/гтќ-џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЌџstpљхшхџЎ…`џЄe4џЄe4џЄe4џЃd4яТB(лЄe4џЄe4џЄe4џЄe4џЄe4џf? Ј§Пџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ'ќњУФУџЮЦЗџЄe4џЄe4џЄe4џЄe4џ—^0ж кš_1џЄe4џЄe4џЄe4џЄe4џЄe4ўЊџUџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ˜џ"" ђхшшџЛЂ†џЄe4џЄe4џЄe4џЄe4џ}M'ИP1йЄe4џЄe4џЄe4џЄe4џЄe4џ|L'­џОџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ йџlmiјсуоџЏ‚[џЄe4џЎƒ]џЄe4џЄe4џN(зЄe4џЄe4џЄe4џЄe4џЄe4џЄe4ёЮіџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ.іќЇЊЇ§дбЧџЇn@џджЬџЗ—wџЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ3 Ёџ:џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџdџїЛНЛўвжЬџъээџввШџЄg6џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џZ.ЙџxџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЂџ ѓЬЮЮџЅІžщ…ˆ„ћМЅ‹џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe3пшБџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџРџё/0,д іЪЬХџЉrEџЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4ќЧЪџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ ЬџџџGGDєЮЧИџЄg6џЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ АоџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџжћџmnjїФДџЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ" ЄёџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџtНџ€ƒ~љСЎ–џЄf5џЄe4џЄe4џЄe4џЄe4џ-ЁџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџщџHJFёФРВџЈsGџЄe4џЄe4џЄe4џ1ЁџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџСџ ёY\Vэž“іІk<џЄe4џ5!Ёџ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџxіџџщcZLс4(Џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџqиџџџїџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ5qЌгџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџпџџџџџџџŸџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџўџџџџџџўџџџџџџ№џџџџџџјџџџџџџјџџџџџџ№џџџџџџрџџџџџР?џџџџџРџџџџџРџџџџџ€џџџџџ€џџџџџ€џџџџџ€џџџџџ џџџџџрџџџџџрџџџџџрџџџџџрџџџџџрџџџџџрџџџџџрџџџџџ№џџџџџ№џџџџ№џџџџ№?џџџџј?џџџџј?џџџџќџџџџќџџџџќџџџџўџџџџў€џџџџџ€џџџџџ€џџџџџРџџџџџРџџџџџрџџџџџрџџџџџ№џџџџџјџџџџџќџџџџџќџџџџџўџџџџџџџџџџџџ€џџџџџџ№џџџџџџјџџџџџџќџџџџџџџџџџџџџџСџџџџџџџљџџ(0` џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ8џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ м џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџžџ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџ7џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ5џџœџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџŠџџіџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџB­џџџџь} џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ4—ћџџџџџzџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџoџљџџ№џї`џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ>ћ яЅЇ яџџ8"вwI&ХЬџnџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџшэагбџппй§рџ,вЄe4џЁc3ђ ДќJџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ–џМНЛўьююџжЯУџ Мџ! гЄe4џЄe4џЃe4ј Уђџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџч*)&эьююџьююџЧБšџ% ЊџзЄe4џЄe4џЄe4џˆT+ЧіЄџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ)џVWSюhic№ьююџЖ“rџR1Њџ мЄe4џЄe4џЄe4џЄe4џ0Њў9џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ9џџ<;7эфцуџІk<џO(Лџ фЄe4џЄe4џЄe4џˆT*з|L'блЈџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџGНЯWUO№лзЮџЄe4џЂd3уё№Єe4џЄe4џЄe4џW-Ъіџѕ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџџЯqpjѕмйбџЄe4џЄe4џ ЙџˆT+їЄe4џЄe4џЄe4џ% Ќџ 7џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџяmkfєнмжџЄe4џЄe4џJ-ЋџN0жЄe4џЄe4џЄe4џš_1лыТџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџьHFBюппкџЄe4џЄe4џ”Z/Ъ§зЄe4џЄe4џЄe4џЄe4џ<$ЊџƒџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџС'&#эчыъџЋyNџЄe4џЄe4§ЪїŸb2џЄe4џЄe4џЄe4џ c3ъмљџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ— ѕъььџМŸ‚џЄe4џЄe4џ0ЊџsG$щЄe4џЄe4џЄe4џЄe4џU4Ќџ”џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџiџІЈЅўЫМЊџЄe4џЄe4џ}M(Йџ6!вЄe4џЄe4џЄe4џЄe4џЄe4ѕЬїџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ§LJFякйаџЄe4џЄe4џЄe4єдщЂd3џЄe4џЄe4џЄe4џЄe4џiA!БџŠџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџКіхщшџЏ‚[џЄe4џЄe4џM/Ћџh@!сЄe4џЄe4џЄe4џЄe4џЄe4ібъџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ^џ Ёž§ПЄŠџЈrEџЌ{RџЁc4щс кЄe4џЄe4џЄe4џЄe4џЄe4џL/ЋџUџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ ѕFD@юидЪџпоиџНЂ†џЄe4џ:$ЊџƒP)№Єe4џЄe4џЄe4џЄe4џ c3ццКџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџІіООИљ‚‚|єУЌ“џЄe4џa2оь' вЄe4џЄe4џЄe4џЄe4џЄe4џ.Ћў џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџIџћ)'$ьШЙЄџЄe4џЄe4џ) Ћљ–\/ћЄe4џЄe4џЄe4џЄe4џ•\/біƒџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџщч ђлквџЅf6џЄe4џ”]/вѓ@(гЄe4џЄe4џЄe4џЄe4џЄe4џВфџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ`FўжйиџДmџЄe4џЄe4џB)Њ№œ`1ўЄe4џЄe4џЄe4џa2ѓpD$ЖџLџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ §igcєЫНЋџЄe4џЄe4џЄe4љ ОI-еЄe4џЄe4џЄe4џh@!ВўіœџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџД ѓуффџДŽkџЄe4џЄe4џ–\/и кža2џЄe4џЄe4џЄe4џ! Ўѕџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ.ў{zvіиеЫџІj:џЄe4џЄe4џd> БS3зЄe4џЄe4џЄe4џ b4ъеЄџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЄјЦШХўУЏ™џЄe4џЄe4џЄe4џC*Н c3џЄe4џЄe4џЄe4џd= Џў.џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџт$#!эуцуџЏ‚[џЅj:џЇpCџŸb3ъ‰T+ьЄe4џЄe4џЄe4џЂd4ъцwџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ/ѓ]\WёдЬРџСЋ“џХБšџЄe4џЄe4џЄe4џЄe4џЄe4џЄe4џ" ­ЖџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџN§xwrѕфшцџЗКДњЌ{QџЄe4џЄe4џЄe4џЄe4џЄe4џe> Ађџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџv§iieщ №ФИЇџЄe4џЄe4џЄe4џЄe4џЄe4џzL'ИџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџŸџўKKH№М „џЄe4џЄe4џЄe4џЄe4џŒV-ТџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџНLђBB>эВŽmџЄe4џЄe4џЄe4џœb2аџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџZџ22/ьИЂŠўЄe4џЄe4џЄe4сі џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџPы юUTLф›eђЄf5єу$џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџˆиўрь)џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ)zЪ,џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџяџџџџџЯџџџџџЯџџџџџЯџџџџџЯџџџџџЯџџџџџЯџџџџџЧџџџџџ‡џџџџџџџџџўџџџџџџџџџўџџџџќџџџј?џџџјџџџјџџџјџџџјџџџќџџџќџџџќџџџќџџџќџџџўџџџўџџџўџџџџџџџџџџџџџџџџ€џџџ€џџџрџџџр?џџџрџџџ№?џџџ№?џџџј?џџџќџџџўџџџџџџџџџџџџ џџџџ№џџџџјџџџџќџџџџџпџ( @ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ Gџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџœhџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџhџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџhџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџhџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ2џЈџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЁџћ>џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџДџџџё$џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЛ шџф№‘џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ‹%# чвгЮќђ в‘Z.п Р”џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјзизџйгЩџЬйЄe4џЄe4ћ Тjџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџg,+)ш­ЌЈњЩДŸџ ЗтЄe4џЄe4џŒV-адџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ|ћvsmѓК•uџC)ВьЄe4џЄe4џh@!У Ъ[џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ,Š‘ŠјЖlџO)Ч§˜]0ќЄe4џ‡S+Юљ‘џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџž‹†јЗ‘pџЄe4њо`;иЄe4џЄe4џ  Е€џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ„gc]№МœџЄe4џ! Г$ ЮЄe4џЄe4џ–\/нч"џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџY42.щЬКЇџЄe4џjA!ЗьЃe4џЄe4џЄe4џ6!ЏДџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјвЯЧџЄe4џ c3ъы{M'хЄe4џЄe4џžb3ъфIџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџОŒŠ…ї­|SџЄe4џ/А ЯЄe4џЄe4џЄe4џ5!ЏЕџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџa2/,шЭРЏџУЊ‘џ—]/нђŒU,яЄe4џЄe4џ—]/мёџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџѓ\YSтМАЁџЄe4џ" Д,ЫЄe4џЄe4џЄe4џ Ж|џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЉѕЁ —њЄe4џX-дё—]0јЄe4џЄe4џƒQ*Ъмџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ){olgёГ‰eџЄe4џ6!Г>&ЫЄe4џЄe4џrF%ЩрCџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ4 юЯСГџЄe4џЃd4ї Чža2§Єe4џ€N)Щэ.џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџАxuoђК—wџЄe4џW-з^:ЯЄe4џЄe4џ;$Џ„џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ&яЄ ˜јЉqDџІl=џ€O(иЄe4џЄe4џža2фпџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџJюИЎ ћеЮСџЅi9џЄe4џЄe4џЄe4џЗ.џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџqшRQMчРЇџЄe4џЄe4џЄe4џ8"Џ^џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ›фNMGыЎYџЄe4џЄe4џI-БfџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЎ983цЕ”vџЄe4џ[8Еkџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ“ ъVQIп]J7ЦpџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџhЙoџџџџџџџџџџџџџџџџџџџџџџџџџџџџџїџџџїџџџїџџџїџџџѓџџџуџџџСџџџРџџџ€џџ€џџ€?џџ€?џџ€џџ€џџ€џџРџџРџџРџџрџџрџџрџџјџџјџџјџџќџџўџџџџџџџџџСџџџсџџџ§џ(0 џџџџџџџџџџџџџџџџџџџџџџџџџџџJџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџцџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџFџjџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџCщџћAџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџkтў ЭН џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ'&$!фмнйџжh@!з€O)бЙџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџeppkёгЦЗџ З[8аЄe4џH,И]џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ~цУЈџW5ЖL/ЪЄe4џP1МЩџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџбТІџ‘Z.д ЫЄe4џ„Q*аЩ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЫЧЏ˜џЄe4§ вЃd4џЄe4џ Й@џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЛЦНБ§Єe4џЙ|L'фЄe4џ”[/нЧџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџq}wёЇm?џe> Л+ЫЄe4џЄe4џ,Д^џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ,)&хШЗЃџА‚[ћд—]0їЄe4џ’Z.иНџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ УHFBцРЂ‡џP1И=%ЪЄe4џЄe4џК(џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџSТІ›ŒјЁc3є бža2ќЄe4џxJ&ТŒџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџCgd\ыЈoBџ~M(ЮV5ЬЄe4џ=&ГЈџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџкМЋšќЄe4џe> ЩЃd4џЃe4њ З џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџM.-)цМЂ†џА‚]ќa2јЄe4џV5ЖIџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџrXWRъ“…ёЅh8џЄe4џ‘Y.г‚џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ™Ц {ђЄe4џŸb2сŒџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЕvpdцЉ~X№†џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџYЏ…џџџџџџџџџџџџџџџџџџџџџџПџџПџџПџџПџџџџџўџўџўџўџўџўџџџџџџџџ€џРџРџрџ№?џ№?џќ?џџ?(  џџџџџџџџџџџџџџџџџџYџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ-аџxџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџХMKDпџя7џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЅџџџ§џл‡EџФџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЈѓЧџџл‡EџU3с…џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЋѓЧџџл‡Eџй…DџЪџџџџџџџџџџџџџџџџџџџџџџџџџџџŒѓЧџѓЧџџл‡EџQ2кАџџџџџџџџџџџџџџџџџџџџџџџџџџџ# йѓЧџџл‡Eџл‡EџЈџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЂѓЧџѓЧџџл‡EџЬџџџџџџџџџџџџџџџџџџџџџџџџџџџ ЭѓЧџc=џл‡EџU4аЇџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџŸѓЧџѓЧџ“Z.џл‡EџЊџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџŸѓЧџѓЧџл‡EџЏџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџš&*(ъѓЧџРџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџK&&#Ъžџџџџџџџџџџџџџџ§џ§џљџ№џ№№?№?№јјќќўџџЯ(0`џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ ЅЇ 8"wI&џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџагбппй,Єe4Ёc3 џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџМНЛьююжЯУ ! Єe4Єe4Ѓe4 џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ*)&ьююьююЧБš% Єe4Єe4Єe4ˆT+џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџVWShicьююЖ“rR1 Єe4Єe4Єe4Єe40џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ<;7фцуІk<O( Єe4Єe4Єe4ˆT*|L'џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџWUOлзЮЄe4Ђd3Єe4Єe4Єe4W-џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџqpjмйбЄe4Єe4 ˆT+Єe4Єe4Єe4% џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџmkfнмжЄe4Єe4J-N0Єe4Єe4Єe4š_1џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџHFBппкЄe4Єe4”Z/Єe4Єe4Єe4Єe4<$џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ'&#чыъЋyNЄe4Єe4Ÿb2Єe4Єe4Єe4 c3џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ ъььМŸ‚Єe4Єe40sG$Єe4Єe4Єe4Єe4U4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџІЈЅЫМЊЄe4Єe4}M(6!Єe4Єe4Єe4Єe4Єe4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџLJFкйаЄe4Єe4Єe4Ђd3Єe4Єe4Єe4Єe4iA!џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџхщшЏ‚[Єe4Єe4M/h@!Єe4Єe4Єe4Єe4Єe4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ ЁžПЄŠЈrEЌ{RЁc4 Єe4Єe4Єe4Єe4Єe4L/џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџFD@идЪпоиНЂ†Єe4:$ƒP)Єe4Єe4Єe4Єe4 c3џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџООИ‚‚|УЌ“Єe4a2' Єe4Єe4Єe4Єe4Єe4.џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ)'$ШЙЄЄe4Єe4) –\/Єe4Єe4Єe4Єe4•\/џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ лквЅf6Єe4”]/@(Єe4Єe4Єe4Єe4Єe4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџжйиДmЄe4Єe4B)œ`1Єe4Єe4Єe4a2pD$џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџigcЫНЋЄe4Єe4Єe4 I-Єe4Єe4Єe4h@!џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ уффДŽkЄe4Єe4–\/ ža2Єe4Єe4Єe4! џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ{zvиеЫІj:Єe4Єe4d> S3Єe4Єe4Єe4 b4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЦШХУЏ™Єe4Єe4Єe4C* c3Єe4Єe4Єe4d= џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ$#!уцуЏ‚[Ѕj:ЇpCŸb3‰T+Єe4Єe4Єe4Ђd4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ]\WдЬРСЋ“ХБšЄe4Єe4Єe4Єe4Єe4Єe4" џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџxwrфшцЗКДЌ{QЄe4Єe4Єe4Єe4Єe4e> џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџiie ФИЇЄe4Єe4Єe4Єe4Єe4zL'џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџKKHМ „Єe4Єe4Єe4Єe4ŒV-џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџBB>ВŽmЄe4Єe4Єe4œb2џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ22/ИЂŠЄe4Єe4Єe4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ UTL›eЄf5џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџяџџџџџЯџџџџџЯџџџџџЯџџџџџЯџџџџџЯџџџџџЯџџџџџЧџџџџџ‡џџџџџџџџџўџџџџџџџџџўџџџџќџџџј?џџџјџџџјџџџјџџџјџџџќџџџќџџџќџџџќџџџќџџџўџџџўџџџўџџџџџџџџџџџџџџџџ€џџџ€џџџрџџџр?џџџрџџџ№?џџџ№?џџџј?џџџќџџџўџџџџџџџџџџџџ џџџџ№џџџџјџџџџќџџџџџпџ( @џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ%# вгЮ ‘Z. џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџзизйгЩЄe4Єe4 џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ,+)­ЌЈЩДŸ Єe4Єe4ŒV-џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџvsmК•uC)Єe4Єe4h@! џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ‘ŠЖlO)˜]0Єe4‡S+џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ‹†З‘pЄe4`;Єe4Єe4  џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџgc]МœЄe4! $ Єe4Єe4–\/џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ42.ЬКЇЄe4jA!Ѓe4Єe4Єe46!џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџвЯЧЄe4 c3{M'Єe4Єe4žb3џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџŒŠ…­|SЄe4/ Єe4Єe4Єe45!џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ2/,ЭРЏУЊ‘—]/ŒU,Єe4Єe4—]/џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ\YSМАЁЄe4" ,Єe4Єe4Єe4 џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЁ —Єe4X-—]0Єe4Єe4ƒQ*џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџolgГ‰eЄe46!>&Єe4Єe4rF%џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ ЯСГЄe4Ѓd4 ža2Єe4€N)џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџxuoК—wЄe4W-^:Єe4Єe4;$џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЄ ˜ЉqDІl=€O(Єe4Єe4ža2џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџИЎ еЮСЅi9Єe4Єe4Єe4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџRQMРЇЄe4Єe4Єe48"џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџNMGЎYЄe4Єe4I-џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ983Е”vЄe4[8џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ VQI]J7џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџїџџџїџџџїџџџїџџџѓџџџуџџџСџџџРџџџ€џџ€џџ€?џџ€?џџ€џџ€џџ€џџРџџРџџРџџрџџрџџрџџјџџјџџјџџќџџўџџџџџџџџџСџџџсџџџ§џ(0џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ&$!мнйh@!€O)џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџppkгЦЗ [8Єe4H,џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџУЈW5L/Єe4P1џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџТІ‘Z. Єe4„Q*џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЧЏ˜Єe4 Ѓd4Єe4 џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЦНБЄe4|L'Єe4”[/џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ}wЇm?e> +Єe4Єe4,џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ,)&ШЗЃА‚[—]0Єe4’Z.џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ HFBРЂ‡P1=%Єe4Єe4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџІ›ŒЁc3 ža2Єe4xJ&џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџgd\ЈoB~M(V5Єe4=&џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџМЋšЄe4e> Ѓd4Ѓe4 џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ.-)МЂ†А‚]a2Єe4V5џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџXWR“…Ѕh8Єe4‘Y.џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ {Єe4Ÿb2џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџvpdЉ~XџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџПџџПџџПџџПџџџџџўџўџўџўџўџўџџџџџџџџ€џРџРџрџ№?џ№?џќ?џџ?( џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџMKDџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџл‡EџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџѓЧл‡EU3џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџѓЧл‡Eй…DџџџџџџџџџџџџџџџџџџџџџџџџџџџѓЧѓЧл‡EQ2џџџџџџџџџџџџџџџџџџџџџџџџџџџ ѓЧл‡Eл‡EџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџѓЧѓЧл‡Eџџџџџџџџџџџџџџџџџџџџџџџџџџџ ѓЧc=л‡EU4џџџџџџџџџџџџџџџџџџџџџџџџџџџџџџѓЧѓЧ“Z.л‡EџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџѓЧѓЧл‡Eџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ&*(ѓЧџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ&&#џџџџџџџџџџџџџџ§џ§џљџ№џ№№?№?№јјќќўџџЯ(0`           ! ! " % ' ) ,6!8":$$#!'&#@()'$B)C**)&J-L/M/N0R1S3U422/d= <;7e> h@!pD$BB>sG$FD@wI&HFB|L'}M(LJFKKHƒP)ˆT*ˆT+‰T+ŒV-W-UTLWUO”Z/VWS•\/–\/”]/š_1œ`1]\Wa2ža2œb2Ÿb2Ÿb3 b4 c3Ёc3Ёc4Ђd3Ђd4Ѓe4Єe4Єf5Ѕf6Ѕj:Іj:Іk<igchiciiemkfЇpCЈrEqpjЋyNЌ{QЌ{R{zv›eЏ‚[‚‚|ДŽkВŽmДmЖ“rМŸ‚М „НЂ†ИЂŠ ЁžПЄŠЅЇ ІЈЅСЋ“УЌ“УЏ™ХБšЧБšФИЇШЙЄЗКДЫМЊЫНЋМНЛООИЦШХдЬРжЯУидЪагбиеЫлзЮкйамйблквжйинмжпоиппйппкуффуцуфцуфшцхщшчыъъьььюю}$= ˜"_Z‰Ё __^ ,ЁЁƒ___LfЁv1____6œd ___D?J‘_\___Hk“__E___h–__-0___P>™__K____'Ÿl__V___Y w__;____3~‡__@#_____A’___\____žq__/8_____{|jn[_____.<Ž—y_%C____Y Šr€______)…__!N____M”a_O(_____•u__*Q___S9eˆ______šs__N T___oc__2___X ‹___+Y___5&›qbiWF___]RŒ‚______†m_____7g„_____Bx____G:t___U4z___Ip` џџџџџџџџяџџџџџяџџџџџЧџџџџџЯџџџџџЯџџџџџЯџџџџџЧџџџџџЯџџџџџЧџџџџџƒџџџџ§џџџџўџџџџќџџџў?џџџј?џџџј(Пџџџј_џџџј /џџџ№џџџўџџџќџџџќ/џџџќџџџўџџџќџџџў џџџўџџџўџџџџџџџџ‚џџџџџџџ€€џџџџРџџџр"?џџџрџџџ№ Пџџџ№џџџј?џџџќџџџў€џџџџ_џџџџ€џџџџ€џџџџрџџџџ№џџџџўџџџџџ_џ( @          ! " $ 5!8";$%# >&,+)2/,42.[8983jA!{M'€N)€O(O)NMGƒQ*‡S+VQIRQMŒU,ŒV-W-X-‘Z.–\/—]/—]0˜]0ža2žb3 c3Ѓd4Ѓe4Єe4gc]Ѕi9Іl=olgЉqDvsmxuo­|SЎYГ‰eŒŠ…‹†ЖlЗ‘p‘ŠЕ”vК•uК—wМœЁ —Є ˜РЇУЊ‘­ЌЈИЎ МАЁЩДŸЬКЇЭРЏЯСГеЮСвЯЧйгЩвгЮзиз ^2_] <<TW <<<<-R<<<)E<<#L<",џџџџџїџџџѓџџџїџџџїџџџїџџџуџџџСџџџрџџџРџџ€Пџџ?џџˆПџџРџџ‚?џџ€џџР/џџРџџтџџРџџш‹џџрџџј‹џџ№џџј#џџќџџўџџџџџџ‚џџџСџџџтџџџѕџ(0   +,=%&$!=&,)&L/.-)P1V5e> h@!HFBxJ&|L'~M(€O)„Q*‘Z.”[/—]0a2ža2Ÿb2Ёc3Ѓd4Ѓe4Єe4Ѕh8gd\Їm?ЈoBvpdppkЉ~X}wА‚[А‚] {“…І›ŒМЂ†РЂ‡ТІУЈМЋšЧЏ˜ШЗЃЦНБгЦЗмнйB 1A + <+;"+!>+)+ @++#3. ++ ?4$+:++8(&+-/+=+)*95%+7,+6+'02 џџџџПџџПџџ?џџПџџџў/џўџў/џќCџў#џўџў#џџџџџџџˆџџРџрџџРџшПџ№џў?џџ?(  &&#&*(Q2U3U4c=MKD“Z.й…Dл‡EѓЧџџџ          џџ§џ§џёџјџ№ј?№?ј?јј?ќўўџџпtcl8.6.14/win/tcl.rc0000644000175000017500000000272014554262142013550 0ustar sergeisergei// Version Resource Script // #include #include // // build-up the name suffix that defines the type of build this is. // #if TCL_THREADS #define SUFFIX_THREADS "t" #else #define SUFFIX_THREADS "" #endif #if DEBUG && !UNCHECKED #define SUFFIX_DEBUG "g" #else #define SUFFIX_DEBUG "" #endif #define SUFFIX SUFFIX_THREADS SUFFIX_DEBUG LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ VS_VERSION_INFO VERSIONINFO FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL FILEFLAGSMASK 0x3fL #ifdef DEBUG FILEFLAGS VS_FF_DEBUG #else FILEFLAGS 0x0L #endif FILEOS VOS__WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0x0L BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */ BEGIN VALUE "FileDescription", "Tcl DLL\0" VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".dll\0" VALUE "FileVersion", TCL_PATCH_LEVEL VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0" VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" VALUE "ProductVersion", TCL_PATCH_LEVEL END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x409, 1200 END END tcl8.6.14/win/tclsh.rc0000644000175000017500000000356014554262142014106 0ustar sergeisergei// // Version Resource Script // #include #include // // build-up the name suffix that defines the type of build this is. // #if TCL_THREADS #define SUFFIX_THREADS "t" #else #define SUFFIX_THREADS "" #endif #if STATIC_BUILD #define SUFFIX_STATIC "s" #else #define SUFFIX_STATIC "" #endif #if DEBUG && !UNCHECKED #define SUFFIX_DEBUG "g" #else #define SUFFIX_DEBUG "" #endif #define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ VS_VERSION_INFO VERSIONINFO FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL FILEFLAGSMASK 0x3fL #ifdef DEBUG FILEFLAGS VS_FF_DEBUG #else FILEFLAGS 0x0L #endif FILEOS VOS__WINDOWS32 FILETYPE VFT_APP FILESUBTYPE 0x0L BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904b0" BEGIN VALUE "FileDescription", "Tclsh Application\0" VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0" VALUE "FileVersion", TCL_PATCH_LEVEL VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0" VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" VALUE "ProductVersion", TCL_PATCH_LEVEL END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x409, 1200 END END // // Icon // tclsh ICON DISCARDABLE "tclsh.ico" // // This is needed for Windows 8.1 onwards. // #ifndef RT_MANIFEST #define RT_MANIFEST 24 #endif #ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID #define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 #endif CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclsh.exe.manifest" tcl8.6.14/win/tcltest.rc0000644000175000017500000000332014554262142014445 0ustar sergeisergei// // Version Resource Script // #include #include // // build-up the name suffix that defines the type of build this is. // #if STATIC_BUILD #define SUFFIX_STATIC "s" #else #define SUFFIX_STATIC "" #endif #if DEBUG && !UNCHECKED #define SUFFIX_DEBUG "g" #else #define SUFFIX_DEBUG "" #endif #define SUFFIX SUFFIX_STATIC SUFFIX_DEBUG LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ VS_VERSION_INFO VERSIONINFO FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL FILEFLAGSMASK 0x3fL #ifdef DEBUG FILEFLAGS VS_FF_DEBUG #else FILEFLAGS 0x0L #endif FILEOS VOS__WINDOWS32 FILETYPE VFT_APP FILESUBTYPE 0x0L BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904b0" BEGIN VALUE "FileDescription", "Tcltest Application\0" VALUE "OriginalFilename", "tcltest" SUFFIX ".exe\0" VALUE "FileVersion", TCL_PATCH_LEVEL VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0" VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" VALUE "ProductVersion", TCL_PATCH_LEVEL END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x409, 1200 END END // // Icon // tclsh ICON DISCARDABLE "tclsh.ico" // // This is needed for Windows 8.1 onwards. // #ifndef RT_MANIFEST #define RT_MANIFEST 24 #endif #ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID #define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 #endif CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclsh.exe.manifest" tcl8.6.14/win/buildall.vc.bat0000644000175000017500000000536414554262142015336 0ustar sergeisergei@echo off :: This is an example batchfile for building everything. Please :: edit this (or make your own) for your needs and wants using :: the instructions for calling makefile.vc found in makefile.vc set SYMBOLS= :OPTIONS if "%1" == "/?" goto help if /i "%1" == "/help" goto help if %1.==symbols. goto SYMBOLS if %1.==debug. goto SYMBOLS goto OPTIONS_DONE :SYMBOLS set SYMBOLS=symbols shift goto OPTIONS :OPTIONS_DONE :: reset errorlevel cd > nul :: You might have installed your developer studio to add itself to the :: path or have already run vcvars32.bat. Testing these envars proves :: cl.exe and friends are in your path. :: if defined VCINSTALLDIR (goto :startBuilding) if defined MSDEVDIR (goto :startBuilding) if defined MSVCDIR (goto :startBuilding) if defined MSSDK (goto :startBuilding) if defined WINDOWSSDKDIR (goto :startBuilding) :: We need to run the development environment batch script that comes :: with developer studio (v4,5,6,7,etc...) All have it. This path :: might not be correct. You should call it yourself prior to running :: this batchfile. :: call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat" if errorlevel 1 (goto no_vcvars) :startBuilding echo. echo Sit back and have a cup of coffee while this grinds through ;) echo You asked for *everything*, remember? echo. title Building Tcl, please wait... :: makefile.vc uses this for its default anyways, but show its use here :: just to be explicit and convey understanding to the user. Setting :: the INSTALLDIR envar prior to running this batchfile affects all builds. :: if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl :: Build the normal stuff along with the help file. :: set OPTS=none if not %SYMBOLS%.==. set OPTS=symbols nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1 if errorlevel 1 goto error :: Build the static core and shell. :: set OPTS=static,msvcrt if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1 if errorlevel 1 goto error set OPTS= set SYMBOLS= goto end :error echo *** BOOM! *** goto end :no_vcvars echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path. goto out :help title buildall.vc.bat help message echo usage: echo %0 : builds Tcl for all build types (do this first) echo %0 install : installs all the release builds (do this second) echo %0 symbols : builds Tcl for all debugging build types echo %0 symbols install : install all the debug builds. echo. goto out :end title Building Tcl, please wait... DONE! echo DONE! goto out :out pause title Command Prompt tcl8.6.14/win/makefile.vc0000644000175000017500000010750514554262142014556 0ustar sergeisergei#------------------------------------------------------------- -*- makefile -*- # # Microsoft Visual C++ makefile for building Tcl with nmake # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # Copyright (c) 2001-2005 ActiveState Corporation. # Copyright (c) 2001-2004 David Gravereaux. # Copyright (c) 2003-2008 Pat Thoyts. # Copyright (c) 2017 Ashok P. Nadkarni #------------------------------------------------------------------------------ # General usage: # nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]] # # For MACRODEF, see TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) # or examine Sections 7-9 in rules.vc. # # Possible values for TARGET are: # release -- Builds the core, the shell and the dlls. (default) # dlls -- Just builds the windows extensions. # shell -- Just builds the shell and the core. # core -- Only builds the core [tclXX.(dll|lib)]. # all -- Builds everything. # test -- Builds and runs the test suite. # tcltest -- Just builds the test shell. # install -- Installs the built binaries and libraries to $(INSTALLDIR) # as the root of the install tree. # tidy/clean/hose -- varying levels of cleaning. # genstubs -- Rebuilds the Stubs table and support files (dev only). # depend -- Generates an accurate set of source dependancies for this # makefile. Helpful to avoid problems when the sources are # refreshed and you rebuild, but can "overbuild" when common # headers like tclInt.h just get small changes. # htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the # troff manual pages found in $(ROOT)\doc. You need to # have installed the HTML Help Compiler package from Microsoft # to produce the .chm file. # # The steps to setup a Visual C++ environment depend on which # version of Visual Studio and/or the Windows SDK you are building # against and are not described here. The simplest method is generally # to start a command shell using one of the short cuts installed by # Visual Studio/Windows SDK for the appropriate target architecture. # # NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform # SDK (not expressly needed), run setenv.bat after vcvars32.bat # according to the instructions for it. This can also turn on the # 64-bit compiler, if your SDK has it. # # Basic macros and options usable on the commandline (see rules.vc for more info): # OPTS=msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,time64bit,unchecked,none # Sets special options for the core. The default is for none. # Any combination of the above may be used (comma separated). # 'none' will over-ride everything to nothing. # # msvcrt = Affects the static option only to switch it from # using libcmt(d) as the C runtime [by default] to # msvcrt(d). This is useful for static embedding # support. # none = Overrides all other options to nothing. # nothreads = Turns off full multithreading support (default on). # pdbs = Produce separate debug symbol files. # profile = Adds profiling hooks. Map file is assumed. # static = Builds a static library of the core instead of a # dll. The shell will be static (and large), as well. # staticpkg = Affects the static option only to switch # tclshXX.exe to have the dde and reg extension linked # inside it. # symbols = Adds symbols for step debugging. # thrdalloc = Use the thread allocator (shared global free pool). # time64bit = Forces a build using 64-bit time_t for 32-bit build # (CRT library should support this). # unchecked = Allows a symbols build to not use the debug # enabled runtime (msvcrt.dll not msvcrtd.dll # or libcmt.lib not libcmtd.lib). # # STATS=compdbg,memdbg,none # Sets optional memory and bytecode compiler debugging code added # to the core. The default is for none. Any combination of the # above may be used (comma separated). 'none' will over-ride # everything to nothing. # # compdbg = Enables byte compilation logging. # memdbg = Enables the debugging memory allocator. # # CHECKS=64bit,fullwarn,nodep,none # Sets special macros for checking compatibility. # # 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. # nodep = Turns off compatibility macros to ensure the core # isn't being built with deprecated functions. # # MACHINE=(ALPHA|AMD64|ARM64|IA64|IX86) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default # when not specified. If the CPU environment variable has been # set (ie: recent Platform SDK) then MACHINE is set from CPU. # # TMP_DIR= # OUT_DIR= # Hooks to allow the intermediate and output directories to be # changed. $(OUT_DIR) is assumed to be # $(BINROOT)\(Release|Debug) based on if symbols are requested. # $(TMP_DIR) will be $(OUT_DIR)\ by default. # # TESTPAT= # Reads the tests requested to be run from this file. # # Examples: # c:\tcl_src\win\>nmake -f makefile.vc release # c:\tcl_src\win\>nmake -f makefile.vc test # c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl # c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs # c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols # # NOTE: # Before modifying this file, check whether the modification is applicable # to building extensions as well and if so, modify rules.vc instead. # The PROJECT macro is used by rules.vc for generating appropriate # macros and rules. PROJECT = tcl # Default target to build if no target is specified. If unspecified, the # rules.vc file will set up "all" as the target. DEFAULT_BUILD_TARGET = release # We have a custom resource file RCFILE = tcl.rc # The rules.vc file does much of the hard work in terms of defining # the build configuration, macros, output directories etc. !include "rules.vc" # Tcl version info based on macros set up by rules.vc DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) # We need versions of various core packages to generate appropriate # file names during installation. !if [echo REM = This file is generated from makefile.vc > versions.vc] !endif !if [echo PKG_HTTP_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] !endif !if [echo PKG_OPT_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\opt\pkgIndex.tcl opt >> versions.vc] !endif !if [echo PKG_TCLTEST_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc] !endif !if [echo PKG_MSGCAT_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc] !endif !if [echo PKG_PLATFORM_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc] !endif !if [echo PKG_SHELL_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] !endif !if [echo PKG_DDE_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc] !endif !if [echo PKG_REG_VER =\>> versions.vc] \ && [nmakehlp -V ..\library\reg\pkgIndex.tcl "registry " >> versions.vc] !endif !include versions.vc DDEDOTVERSION = 1.4 DDEVERSION = $(DDEDOTVERSION:.=) REGDOTVERSION = 1.3 REGVERSION = $(REGDOTVERSION:.=) TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT) TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME) TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT) TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME) TCLTEST = $(OUT_DIR)\$(PROJECT)test$(VERSION)$(SUFX:t=).exe CAT32 = $(OUT_DIR)\cat32.exe TCLSHOBJS = \ $(TMP_DIR)\tclAppInit.obj \ !if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif !endif $(TMP_DIR)\tclsh.res TCLTESTOBJS = \ $(TMP_DIR)\tclTest.obj \ $(TMP_DIR)\tclTestObj.obj \ $(TMP_DIR)\tclTestProcBodyObj.obj \ $(TMP_DIR)\tclThreadTest.obj \ $(TMP_DIR)\tclWinTest.obj \ !if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif !endif $(TMP_DIR)\testMain.obj \ $(TMP_DIR)\tcltest.res COREOBJS = \ $(TMP_DIR)\regcomp.obj \ $(TMP_DIR)\regerror.obj \ $(TMP_DIR)\regexec.obj \ $(TMP_DIR)\regfree.obj \ $(TMP_DIR)\tclAlloc.obj \ $(TMP_DIR)\tclAssembly.obj \ $(TMP_DIR)\tclAsync.obj \ $(TMP_DIR)\tclBasic.obj \ $(TMP_DIR)\tclBinary.obj \ $(TMP_DIR)\tclCkalloc.obj \ $(TMP_DIR)\tclClock.obj \ $(TMP_DIR)\tclCmdAH.obj \ $(TMP_DIR)\tclCmdIL.obj \ $(TMP_DIR)\tclCmdMZ.obj \ $(TMP_DIR)\tclCompCmds.obj \ $(TMP_DIR)\tclCompCmdsGR.obj \ $(TMP_DIR)\tclCompCmdsSZ.obj \ $(TMP_DIR)\tclCompExpr.obj \ $(TMP_DIR)\tclCompile.obj \ $(TMP_DIR)\tclConfig.obj \ $(TMP_DIR)\tclDate.obj \ $(TMP_DIR)\tclDictObj.obj \ $(TMP_DIR)\tclDisassemble.obj \ $(TMP_DIR)\tclEncoding.obj \ $(TMP_DIR)\tclEnsemble.obj \ $(TMP_DIR)\tclEnv.obj \ $(TMP_DIR)\tclEvent.obj \ $(TMP_DIR)\tclExecute.obj \ $(TMP_DIR)\tclFCmd.obj \ $(TMP_DIR)\tclFileName.obj \ $(TMP_DIR)\tclGet.obj \ $(TMP_DIR)\tclHash.obj \ $(TMP_DIR)\tclHistory.obj \ $(TMP_DIR)\tclIndexObj.obj \ $(TMP_DIR)\tclInterp.obj \ $(TMP_DIR)\tclIO.obj \ $(TMP_DIR)\tclIOCmd.obj \ $(TMP_DIR)\tclIOGT.obj \ $(TMP_DIR)\tclIOSock.obj \ $(TMP_DIR)\tclIOUtil.obj \ $(TMP_DIR)\tclIORChan.obj \ $(TMP_DIR)\tclIORTrans.obj \ $(TMP_DIR)\tclLink.obj \ $(TMP_DIR)\tclListObj.obj \ $(TMP_DIR)\tclLiteral.obj \ $(TMP_DIR)\tclLoad.obj \ $(TMP_DIR)\tclMainW.obj \ $(TMP_DIR)\tclMain.obj \ $(TMP_DIR)\tclNamesp.obj \ $(TMP_DIR)\tclNotify.obj \ $(TMP_DIR)\tclOO.obj \ $(TMP_DIR)\tclOOBasic.obj \ $(TMP_DIR)\tclOOCall.obj \ $(TMP_DIR)\tclOODefineCmds.obj \ $(TMP_DIR)\tclOOInfo.obj \ $(TMP_DIR)\tclOOMethod.obj \ $(TMP_DIR)\tclOOStubInit.obj \ $(TMP_DIR)\tclObj.obj \ $(TMP_DIR)\tclOptimize.obj \ $(TMP_DIR)\tclPanic.obj \ $(TMP_DIR)\tclParse.obj \ $(TMP_DIR)\tclPathObj.obj \ $(TMP_DIR)\tclPipe.obj \ $(TMP_DIR)\tclPkg.obj \ $(TMP_DIR)\tclPkgConfig.obj \ $(TMP_DIR)\tclPosixStr.obj \ $(TMP_DIR)\tclPreserve.obj \ $(TMP_DIR)\tclProc.obj \ $(TMP_DIR)\tclRegexp.obj \ $(TMP_DIR)\tclResolve.obj \ $(TMP_DIR)\tclResult.obj \ $(TMP_DIR)\tclScan.obj \ $(TMP_DIR)\tclStringObj.obj \ $(TMP_DIR)\tclStrToD.obj \ $(TMP_DIR)\tclStubInit.obj \ $(TMP_DIR)\tclThread.obj \ $(TMP_DIR)\tclThreadAlloc.obj \ $(TMP_DIR)\tclThreadJoin.obj \ $(TMP_DIR)\tclThreadStorage.obj \ $(TMP_DIR)\tclTimer.obj \ $(TMP_DIR)\tclTomMathInterface.obj \ $(TMP_DIR)\tclTrace.obj \ $(TMP_DIR)\tclUtf.obj \ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ $(TMP_DIR)\tclZlib.obj !if $(STATIC_BUILD) ZLIBOBJS = \ $(TMP_DIR)\adler32.obj \ $(TMP_DIR)\compress.obj \ $(TMP_DIR)\crc32.obj \ $(TMP_DIR)\deflate.obj \ $(TMP_DIR)\infback.obj \ $(TMP_DIR)\inffast.obj \ $(TMP_DIR)\inflate.obj \ $(TMP_DIR)\inftrees.obj \ $(TMP_DIR)\trees.obj \ $(TMP_DIR)\uncompr.obj \ $(TMP_DIR)\zutil.obj !else ZLIBOBJS = $(OUT_DIR)\zdll.lib !endif TOMMATHOBJS = \ $(TMP_DIR)\bn_mp_add.obj \ $(TMP_DIR)\bn_mp_add_d.obj \ $(TMP_DIR)\bn_mp_and.obj \ $(TMP_DIR)\bn_mp_clamp.obj \ $(TMP_DIR)\bn_mp_clear.obj \ $(TMP_DIR)\bn_mp_clear_multi.obj \ $(TMP_DIR)\bn_mp_cmp.obj \ $(TMP_DIR)\bn_mp_cmp_d.obj \ $(TMP_DIR)\bn_mp_cmp_mag.obj \ $(TMP_DIR)\bn_mp_cnt_lsb.obj \ $(TMP_DIR)\bn_mp_copy.obj \ $(TMP_DIR)\bn_mp_count_bits.obj \ $(TMP_DIR)\bn_mp_div.obj \ $(TMP_DIR)\bn_mp_div_d.obj \ $(TMP_DIR)\bn_mp_div_2.obj \ $(TMP_DIR)\bn_mp_div_2d.obj \ $(TMP_DIR)\bn_mp_div_3.obj \ $(TMP_DIR)\bn_mp_exch.obj \ $(TMP_DIR)\bn_mp_expt_u32.obj \ $(TMP_DIR)\bn_mp_grow.obj \ $(TMP_DIR)\bn_mp_init.obj \ $(TMP_DIR)\bn_mp_init_copy.obj \ $(TMP_DIR)\bn_mp_init_multi.obj \ $(TMP_DIR)\bn_mp_init_set.obj \ $(TMP_DIR)\bn_mp_init_size.obj \ $(TMP_DIR)\bn_mp_lshd.obj \ $(TMP_DIR)\bn_mp_mod.obj \ $(TMP_DIR)\bn_mp_mod_2d.obj \ $(TMP_DIR)\bn_mp_mul.obj \ $(TMP_DIR)\bn_mp_mul_2.obj \ $(TMP_DIR)\bn_mp_mul_2d.obj \ $(TMP_DIR)\bn_mp_mul_d.obj \ $(TMP_DIR)\bn_mp_neg.obj \ $(TMP_DIR)\bn_mp_or.obj \ $(TMP_DIR)\bn_mp_pack.obj \ $(TMP_DIR)\bn_mp_pack_count.obj \ $(TMP_DIR)\bn_mp_radix_size.obj \ $(TMP_DIR)\bn_mp_radix_smap.obj \ $(TMP_DIR)\bn_mp_read_radix.obj \ $(TMP_DIR)\bn_mp_rshd.obj \ $(TMP_DIR)\bn_mp_set.obj \ $(TMP_DIR)\bn_mp_shrink.obj \ $(TMP_DIR)\bn_mp_sqr.obj \ $(TMP_DIR)\bn_mp_sqrt.obj \ $(TMP_DIR)\bn_mp_sub.obj \ $(TMP_DIR)\bn_mp_sub_d.obj \ $(TMP_DIR)\bn_mp_signed_rsh.obj \ $(TMP_DIR)\bn_mp_to_ubin.obj \ $(TMP_DIR)\bn_mp_to_radix.obj \ $(TMP_DIR)\bn_mp_ubin_size.obj \ $(TMP_DIR)\bn_mp_unpack.obj \ $(TMP_DIR)\bn_mp_xor.obj \ $(TMP_DIR)\bn_mp_zero.obj \ $(TMP_DIR)\bn_s_mp_add.obj \ $(TMP_DIR)\bn_s_mp_balance_mul.obj \ $(TMP_DIR)\bn_s_mp_karatsuba_mul.obj \ $(TMP_DIR)\bn_s_mp_karatsuba_sqr.obj \ $(TMP_DIR)\bn_s_mp_mul_digs.obj \ $(TMP_DIR)\bn_s_mp_mul_digs_fast.obj \ $(TMP_DIR)\bn_s_mp_reverse.obj \ $(TMP_DIR)\bn_s_mp_sqr.obj \ $(TMP_DIR)\bn_s_mp_sqr_fast.obj \ $(TMP_DIR)\bn_s_mp_sub.obj \ $(TMP_DIR)\bn_s_mp_toom_sqr.obj \ $(TMP_DIR)\bn_s_mp_toom_mul.obj PLATFORMOBJS = \ $(TMP_DIR)\tclWin32Dll.obj \ $(TMP_DIR)\tclWinChan.obj \ $(TMP_DIR)\tclWinConsole.obj \ $(TMP_DIR)\tclWinError.obj \ $(TMP_DIR)\tclWinFCmd.obj \ $(TMP_DIR)\tclWinFile.obj \ $(TMP_DIR)\tclWinInit.obj \ $(TMP_DIR)\tclWinLoad.obj \ $(TMP_DIR)\tclWinNotify.obj \ $(TMP_DIR)\tclWinPipe.obj \ $(TMP_DIR)\tclWinSerial.obj \ $(TMP_DIR)\tclWinSock.obj \ $(TMP_DIR)\tclWinThrd.obj \ $(TMP_DIR)\tclWinTime.obj \ !if $(STATIC_BUILD) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !else $(TMP_DIR)\tcl.res !endif TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ $(TMP_DIR)\tclOOStubLib.obj ### The following paths CANNOT have spaces in them as they appear on ### the left side of implicit rules. TOMMATHDIR = $(ROOT)\libtommath PKGSDIR = $(ROOT)\pkgs # Additional include and C macro definitions for the implicit rules # defined in rules.vc PRJ_INCLUDES = -I"$(TOMMATHDIR)" PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS # Additional Link libraries needed beyond those in rules.vc PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib #--------------------------------------------------------------------- # TclTest flags #--------------------------------------------------------------------- !if "$(TESTPAT)" != "" TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) !endif #--------------------------------------------------------------------- # Project specific targets #--------------------------------------------------------------------- release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs core: setup $(TCLLIB) $(TCLSTUBLIB) shell: setup $(TCLSH) dlls: setup $(TCLREGLIB) $(TCLDDELIB) $(OUT_DIR)\zlib1.dll all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs tcltest: setup $(TCLTEST) dlls $(CAT32) install: install-binaries install-libraries install-docs install-pkgs !if $(SYMBOLS) install: install-pdbs !endif setup: default-setup test: test-core test-pkgs test-core: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << package ifneeded dde 1.4.4 [list load "$(TCLDDELIB:\=/)" Dde] package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)" Registry] << runtest: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) $(SCRIPT) runshell: setup $(TCLSH) dlls set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLSH) $(SCRIPT) !if $(STATIC_BUILD) $(TCLLIB): $(TCLOBJS) $(LIBCMD) @<< $** << !else $(TCLLIB): $(TCLOBJS) $(DLLCMD) @<< $** << $(_VC_MANIFEST_EMBED_DLL) $(TCLIMPLIB): $(TCLLIB) !endif # $(STATIC_BUILD) $(TCLSTUBLIB): $(TCLSTUBOBJS) $(LIBCMD) -nodefaultlib $(TCLSTUBOBJS) $(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(CONEXECMD) -stack:2300000 $** copy $(TMP_DIR)\tclsh.exe.manifest $(TCLSH).manifest $(_VC_MANIFEST_EMBED_EXE) $(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(CONEXECMD) -stack:2300000 $** copy $(TMP_DIR)\tclsh.exe.manifest $(TCLTEST).manifest $(_VC_MANIFEST_EMBED_EXE) !if $(STATIC_BUILD) $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(LIBCMD) $** !else $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) $(DLLCMD) $** $(_VC_MANIFEST_EMBED_DLL) !endif !if $(STATIC_BUILD) $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(LIBCMD) $** !else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) $(DLLCMD) $** $(_VC_MANIFEST_EMBED_DLL) !endif !if "$(MACHINE)" == "ARM64" $(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win64-arm\zlib1.dll $(COPY) $(COMPATDIR)\zlib\win64-arm\zlib1.dll $(OUT_DIR)\zlib1.dll $(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win64-arm\zdll.lib $(COPY) $(COMPATDIR)\zlib\win64-arm\zdll.lib $(OUT_DIR)\zdll.lib !elseif "$(MACHINE)" == "IX86" $(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win32\zlib1.dll $(COPY) $(COMPATDIR)\zlib\win32\zlib1.dll $(OUT_DIR)\zlib1.dll $(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win32\zdll.lib $(COPY) $(COMPATDIR)\zlib\win32\zdll.lib $(OUT_DIR)\zdll.lib !else $(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win64\zlib1.dll $(COPY) $(COMPATDIR)\zlib\win64\zlib1.dll $(OUT_DIR)\zlib1.dll $(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win64\zdll.lib $(COPY) $(COMPATDIR)\zlib\win64\zdll.lib $(OUT_DIR)\zdll.lib !endif pkgs: @for /d %d in ($(PKGSDIR)\*) do \ @if exist "%~fd\win\makefile.vc" ( \ pushd "%~fd\win" & \ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\ popd \ ) test-pkgs: @for /d %d in ($(PKGSDIR)\*) do \ @if exist "%~fd\win\makefile.vc" ( \ pushd "%~fd\win" & \ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\ popd \ ) install-pkgs: @for /d %d in ($(PKGSDIR)\*) do \ @if exist "%~fd\win\makefile.vc" ( \ pushd "%~fd\win" & \ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\ popd \ ) clean-pkgs: @for /d %d in ($(PKGSDIR)\*) do \ @if exist "%~fd\win\makefile.vc" ( \ pushd "%~fd\win" & \ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\ popd \ ) $(CAT32): $(WIN_DIR)\cat.c $(cc32) $(cflags) $(crt) /D_CRT_NONSTDC_NO_DEPRECATE /DCONSOLE \ /DUNICODE /D_UNICODE -Fo$(TMP_DIR)\ $? $(CONEXECMD) -stack:16384 $(TMP_DIR)\cat.obj $(_VC_MANIFEST_EMBED_EXE) #--------------------------------------------------------------------- # Regenerate the stubs files. [Development use only] #--------------------------------------------------------------------- genstubs: !if !exist($(TCLSH)) @echo Build tclsh first! !else $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \ $(GENERICDIR:\=/)/tclTomMath.decls $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ $(GENERICDIR:\=/)/tclOO.decls !endif #---------------------------------------------------------------------- # The following target generates the file generic/tclTomMath.h. # It needs to be run (and the results checked) after updating # to a new release of libtommath. #---------------------------------------------------------------------- gentommath_h: !if !exist($(TCLSH)) @echo Build tclsh first! !else $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \ "$(TOMMATHDIR:\=/)/tommath.h" \ > "$(GENERICDIR)\tclTomMath.h" !endif #--------------------------------------------------------------------- # Build the Windows HTML help file. #--------------------------------------------------------------------- # NOTE: you can define HHC on the command-line to override this. # nmake does not set macro values if already set on the command line. !if defined(PROCESSOR_ARCHITECTURE) && "$(PROCESSOR_ARCHITECTURE)" == "AMD64" HHC="%ProgramFiles(x86)%\HTML Help Workshop\hhc.exe" !else HHC="%ProgramFiles%\HTML Help Workshop\hhc.exe" !endif HTMLDIR=$(OUT_DIR)\html HTMLBASE=TclTk$(VERSION) HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm htmlhelp: chmsetup $(CHMFILE) $(CHMFILE): $(DOCDIR)\* @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)" @echo Compiling HTML help project -"$(HHC)" <<$(HHPFILE) >NUL [OPTIONS] Compatibility=1.1 or later Compiled file=$(HTMLBASE).chm Default topic=contents.htm Display compile progress=no Error log file=$(HTMLBASE).log Full-text search=Yes Language=0x409 English (United States) Title=Tcl/Tk $(DOTVERSION) Help [FILES] contents.htm docs.css Keywords\*.htm TclCmd\*.htm TclLib\*.htm TkCmd\*.htm TkLib\*.htm UserCmd\*.htm << chmsetup: @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR) install-docs: !if exist("$(CHMFILE)") @echo Installing compiled HTML help @$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\" !endif # "emacs font-lock highlighting fix #--------------------------------------------------------------------- # Generate the tcl.nmake file which contains the options used to build # Tcl itself. This is used when building extensions. #--------------------------------------------------------------------- tcl-nmake: $(OUT_DIR)\tcl.nmake $(OUT_DIR)\tcl.nmake: @type << >$@ CORE_MACHINE = $(MACHINE) CORE_DEBUG = $(DEBUG) CORE_TCL_THREADS = $(TCL_THREADS) CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC) << #--------------------------------------------------------------------- # Build tclConfig.sh for the TEA build system. #--------------------------------------------------------------------- tclConfig: $(OUT_DIR)\tclConfig.sh # TBD - is this tclConfig.sh file ever used? The values are incorrect! $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @echo Creating tclConfig.sh @nmakehlp -s << $** >$@ @TCL_DLL_FILE@ $(TCLLIBNAME) @TCL_VERSION@ $(DOTVERSION) @TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION) @TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION) @TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL) @CC@ $(CC) @DEFS@ $(pkgcflags) @CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd @CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD @LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv @LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3 @TCL_DBGX@ $(SUFX) @TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib @LIBS@ $(baselibs) $(PRJ_LIBS) @prefix@ $(_INSTALLDIR) @exec_prefix@ $(BIN_INSTALL_DIR) @SHLIB_CFLAGS@ @STLIB_CFLAGS@ @CFLAGS_WARNING@ -W3 @EXTRA_CFLAGS@ -YX @SHLIB_LD@ $(link32) $(dlllflags) @STLIB_LD@ $(lib32) -nologo @SHLIB_LD_LIBS@ $(baselibs) $(PRJ_LIBS) @SHLIB_SUFFIX@ .dll @DL_LIBS@ @LDFLAGS@ @TCL_CC_SEARCH_FLAGS@ @TCL_LD_SEARCH_FLAGS@ @LIBOBJS@ @RANLIB@ @TCL_LIB_FLAG@ $(PROJECT)$(VERSION)$(SUFX).lib @TCL_BUILD_LIB_SPEC@ $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib @TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib @TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR) @TCL_SRC_DIR@ $(ROOT) @TCL_PACKAGE_PATH@ @TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME) @TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME) @TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME) @TCL_THREADS@ $(TCL_THREADS) @TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME) @TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB) @TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME) @CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll @CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib !if $(STATIC_BUILD) @TCL_SHARED_BUILD@ 0 !else @TCL_SHARED_BUILD@ 1 !endif @TCL_ZLIB_LIB_NAME@ zdll.lib << #--------------------------------------------------------------------- # The following target generates the file generic/tclDate.c # from the yacc grammar found in generic/tclGetDate.y. This is # only run by hand as yacc is not available in all environments. # The name of the .c file is different than the name of the .y file # so that make doesn't try to automatically regenerate the .c file. #--------------------------------------------------------------------- gendate: bison --output-file=$(GENERICDIR)/tclDate.c \ --name-prefix=TclDate \ $(GENERICDIR)/tclGetDate.y #--------------------------------------------------------------------- # Special case object file targets #--------------------------------------------------------------------- $(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \ /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? $(TMP_DIR)\tclMainW.obj: $(GENERICDIR)\tclMain.c $(cc32) $(pkgcflags) /DUNICODE /D_UNICODE \ -Fo$@ $? $(ROOT)\manifest.uuid: copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid git rev-parse HEAD >>$(ROOT)\manifest.uuid $(TMP_DIR)\tclUuid.h: $(ROOT)\manifest.uuid copy $(WIN_DIR)\tclUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\tclUuid.h $(TMP_DIR)\tclEvent.obj: $(GENERICDIR)\tclEvent.c $(TMP_DIR)\tclUuid.h $(cc32) $(pkgcflags) -I$(TMP_DIR) \ -Fo$@ $(GENERICDIR)\tclEvent.c $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(CCAPPCMD) $? $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $? $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c $(cc32) $(pkgcflags) \ /DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ /DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ /DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ /DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ /DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ -Fo$@ $? $(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(appcflags) /DUNICODE /D_UNICODE \ /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? ### The following objects should be built using the stub interfaces ### *ALL* extensions need to built with /DTCL_THREADS=1 $(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $? $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $? ### The following objects are part of the stub library and should not ### be built as DLL objects. -Zl is used to avoid a dependency on any ### specific C run-time. $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in @nmakehlp -s << $** >$@ @MACHINE@ $(MACHINE:IX86=X86) @TCL_WIN_VERSION@ $(DOTVERSION).0.0 << #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a # full rebuild just because some non-global header file like # tclCompile.h was changed. These rules aren't needed when building # from scratch. #--------------------------------------------------------------------- depend: !if !exist($(TCLSH)) @echo Build tclsh first! !else $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ -passthru:"/DBUILD_tcl $(TCL_INCLUDES) $(PRJ_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WIN_DIR),$$(WIN_DIR) @<< $(TCLOBJS) << !endif #--------------------------------------------------------------------- # Dependency rules #--------------------------------------------------------------------- !if exist("$(OUT_DIR)\depend.mk") !include "$(OUT_DIR)\depend.mk" !message *** Dependency rules in use. !else !message *** Dependency rules are not being used. !endif ### add a spacer in the output !message #--------------------------------------------------------------------- # Implicit rules that are not covered by the common ones defined in # rules.vc. A limitation exists with nmake that requires that # source directory can not contain spaces in the path. This an # absolute. #--------------------------------------------------------------------- {$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj:: $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<< $< << {$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj:: $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<< $< << $(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tclsh.rc $(TMP_DIR)\tcltest.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tcltest.rc #--------------------------------------------------------------------- # Installation. #--------------------------------------------------------------------- install-binaries: @echo Installing to '$(_INSTALLDIR)' @echo Installing $(TCLLIBNAME) !if "$(TCLLIB)" != "$(TCLIMPLIB)" @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\" !endif @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(OUT_DIR)\zlib1.dll" "$(BIN_INSTALL_DIR)\" !if exist($(TCLSH)) @echo Installing $(TCLSHNAME) @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\" !endif @echo Installing $(TCLSTUBLIBNAME) @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @if not exist "$(SCRIPT_INSTALL_DIR)" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)" @if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4" @if not exist "$(MODULE_INSTALL_DIR)" \ $(MKDIR) "$(MODULE_INSTALL_DIR)" @if not exist "$(MODULE_INSTALL_DIR)\8.4" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4" @if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform" @if not exist "$(MODULE_INSTALL_DIR)\8.5" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5" @if not exist "$(MODULE_INSTALL_DIR)\8.6" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6" @if not exist "$(LIB_INSTALL_DIR)\nmake" \ $(MKDIR) "$(LIB_INSTALL_DIR)\nmake" @echo Installing header files @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" @echo Installing library files to $(SCRIPT_INSTALL_DIR) @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(WIN_DIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(WIN_DIR)\rules.vc" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WIN_DIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WIN_DIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WIN_DIR)\x86_64-w64-mingw32-nmakehlp.exe" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\" @echo Installing package http 1.0 (obsolete) @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\http1.0\" @echo Installing package opt $(PKG_OPT_VER) @$(CPY) "$(ROOT)\library\opt\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\opt0.4\" @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\http\http.tcl" \ "$(MODULE_INSTALL_DIR)\8.6\http-$(PKG_HTTP_VER).tm" @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ "$(MODULE_INSTALL_DIR)\8.5\msgcat-$(PKG_MSGCAT_VER).tm" @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \ "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm" @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ "$(MODULE_INSTALL_DIR)\8.4\platform-$(PKG_PLATFORM_VER).tm" @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\shell.tcl" \ "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm" @echo Installing $(TCLDDELIBNAME) !if $(STATIC_BUILD) !if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\" !endif !else @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" @$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \ "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" !endif @echo Installing $(TCLREGLIBNAME) !if $(STATIC_BUILD) !if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\" !endif !else @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \ "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" !endif @echo Installing encodings @$(CPY) "$(ROOT)\library\encoding\*.enc" \ "$(SCRIPT_INSTALL_DIR)\encoding\" # "emacs font-lock highlighting fix install-tzdata: @echo Installing time zone data @set TCL_LIBRARY=$(ROOT:\=/)/library @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" install-msgs: @echo Installing message catalogs @set TCL_LIBRARY=$(ROOT:\=/)/library @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" install-pdbs: @echo Installing debug symbols @$(CPY) "$(OUT_DIR)\*.pdb" "$(BIN_INSTALL_DIR)\" # "emacs font-lock highlighting fix #--------------------------------------------------------------------- # Clean up #--------------------------------------------------------------------- tidy: !if "$(TCLLIB)" != "$(TCLIMPLIB)" @echo Removing $(TCLLIB) ... @if exist $(TCLLIB) del $(TCLLIB) !endif @echo Removing $(TCLIMPLIB) ... @if exist $(TCLIMPLIB) del $(TCLIMPLIB) @echo Removing $(TCLSH) ... @if exist $(TCLSH) del $(TCLSH) @echo Removing $(TCLTEST) ... @if exist $(TCLTEST) del $(TCLTEST) @echo Removing $(TCLDDELIB) ... @if exist $(TCLDDELIB) del $(TCLDDELIB) @echo Removing $(TCLREGLIB) ... @if exist $(TCLREGLIB) del $(TCLREGLIB) clean: default-clean clean-pkgs hose: default-hose realclean: hose .PHONY: # Local Variables: # mode: makefile # End: tcl8.6.14/win/rules-ext.vc0000644000175000017500000000755114554262142014731 0ustar sergeisergei# This file should only be included in makefiles for Tcl extensions, # NOT in the makefile for Tcl itself. !ifndef _RULES_EXT_VC # We need to run from the directory the parent makefile is located in. # nmake does not tell us what makefile was used to invoke it so parent # makefile has to set the MAKEFILEVC macro or we just make a guess and # warn if we think that is not the case. !if "$(MAKEFILEVC)" == "" !if exist("$(PROJECT).vc") MAKEFILEVC = $(PROJECT).vc !elseif exist("makefile.vc") MAKEFILEVC = makefile.vc !endif !endif # "$(MAKEFILEVC)" == "" !if !exist("$(MAKEFILEVC)") MSG = ^ You must run nmake from the directory containing the project makefile.^ If you are doing that and getting this message, set the MAKEFILEVC^ macro to the name of the project makefile. !message WARNING: $(MSG) !endif !if "$(PROJECT)" == "tcl" !error The rules-ext.vc file is not intended for Tcl itself. !endif # We extract version numbers using the nmakehlp program. For now use # the local copy of nmakehlp. Once we locate Tcl, we will use that # one if it is newer. !if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" !if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul] !endif !else !if [copy x86_64-w64-mingw32-nmakehlp.exe nmakehlp.exe >NUL] !endif !endif # First locate the Tcl directory that we are working with. !if "$(TCLDIR)" != "" _RULESDIR = $(TCLDIR:/=\) !else # If an installation path is specified, that is also the Tcl directory. # Also Tk never builds against an installed Tcl, it needs Tcl sources !if defined(INSTALLDIR) && "$(PROJECT)" != "tk" _RULESDIR=$(INSTALLDIR:/=\) !else # Locate Tcl sources !if [echo _RULESDIR = \> nmakehlp.out] \ || [nmakehlp -L generic\tcl.h >> nmakehlp.out] _RULESDIR = ..\..\tcl !else !include nmakehlp.out !endif !endif # defined(INSTALLDIR).... !endif # ifndef TCLDIR # Now look for the targets.vc file under the Tcl root. Note we check this # file and not rules.vc because the latter also exists on older systems. !if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl _RULESDIR = $(_RULESDIR)\lib\nmake !elseif exist("$(_RULESDIR)\win\targets.vc") # Building against Tcl sources _RULESDIR = $(_RULESDIR)\win !else # If we have not located Tcl's targets file, most likely we are compiling # against an older version of Tcl and so must use our own support files. _RULESDIR = . !endif !if "$(_RULESDIR)" != "." # Potentially using Tcl's support files. If this extension has its own # nmake support files, need to compare the versions and pick newer. !if exist("rules.vc") # The extension has its own copy !if [echo TCL_RULES_MAJOR = \> versions.vc] \ && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc] !endif !if [echo TCL_RULES_MINOR = \>> versions.vc] \ && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc] !endif !if [echo OUR_RULES_MAJOR = \>> versions.vc] \ && [nmakehlp -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc] !endif !if [echo OUR_RULES_MINOR = \>> versions.vc] \ && [nmakehlp -V "rules.vc" RULES_VERSION_MINOR >> versions.vc] !endif !include versions.vc # We have a newer version of the support files, use them !if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR)) _RULESDIR = . !endif !endif # if exist("rules.vc") !endif # if $(_RULESDIR) != "." # Let rules.vc know what copy of nmakehlp.c to use. NMAKEHLPC = $(_RULESDIR)\nmakehlp.c # Get rid of our internal defines before calling rules.vc !undef TCL_RULES_MAJOR !undef TCL_RULES_MINOR !undef OUR_RULES_MAJOR !undef OUR_RULES_MINOR !if exist("$(_RULESDIR)\rules.vc") !message *** Using $(_RULESDIR)\rules.vc !include "$(_RULESDIR)\rules.vc" !else !error *** Could not locate rules.vc in $(_RULESDIR) !endif !endif # _RULES_EXT_VCtcl8.6.14/win/rules.vc0000644000175000017500000017225414554262142014136 0ustar sergeisergei#------------------------------------------------------------- -*- makefile -*- # rules.vc -- # # Part of the nmake based build system for Tcl and its extensions. # This file does all the hard work in terms of parsing build options, # compiler switches, defining common targets and macros. The Tcl makefile # directly includes this. Extensions include it via "rules-ext.vc". # # See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for # detailed documentation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 2001-2003 David Gravereaux. # Copyright (c) 2003-2008 Patrick Thoyts # Copyright (c) 2017 Ashok P. Nadkarni #------------------------------------------------------------------------------ !ifndef _RULES_VC _RULES_VC = 1 # The following macros define the version of the rules.vc nmake build system # For modifications that are not backward-compatible, you *must* change # the major version. RULES_VERSION_MAJOR = 1 RULES_VERSION_MINOR = 10 # The PROJECT macro must be defined by parent makefile. !if "$(PROJECT)" == "" !error *** Error: Macro PROJECT not defined! Please define it before including rules.vc !endif !if "$(PRJ_PACKAGE_TCLNAME)" == "" PRJ_PACKAGE_TCLNAME = $(PROJECT) !endif # Also special case Tcl and Tk to save some typing later DOING_TCL = 0 DOING_TK = 0 !if "$(PROJECT)" == "tcl" DOING_TCL = 1 !elseif "$(PROJECT)" == "tk" DOING_TK = 1 !endif !ifndef NEED_TK # Backwards compatibility !ifdef PROJECT_REQUIRES_TK NEED_TK = $(PROJECT_REQUIRES_TK) !else NEED_TK = 0 !endif !endif !ifndef NEED_TCL_SOURCE NEED_TCL_SOURCE = 0 !endif !ifdef NEED_TK_SOURCE !if $(NEED_TK_SOURCE) NEED_TK = 1 !endif !else NEED_TK_SOURCE = 0 !endif ################################################################ # Nmake is a pretty weak environment in syntax and capabilities # so this file is necessarily verbose. It's broken down into # the following parts. # # 0. Sanity check that compiler environment is set up and initialize # any built-in settings from the parent makefile # 1. First define the external tools used for compiling, copying etc. # as this is independent of everything else. # 2. Figure out our build structure in terms of the directory, whether # we are building Tcl or an extension, etc. # 3. Determine the compiler and linker versions # 4. Build the nmakehlp helper application # 5. Determine the supported compiler options and features # 6. Extract Tcl, Tk, and possibly extensions, version numbers from the # headers # 7. Parse the OPTS macro value for user-specified build configuration # 8. Parse the STATS macro value for statistics instrumentation # 9. Parse the CHECKS macro for additional compilation checks # 10. Based on this selected configuration, construct the output # directory and file paths # 11. Construct the paths where the package is to be installed # 12. Set up the actual options passed to compiler and linker based # on the information gathered above. # 13. Define some standard build targets and implicit rules. These may # be optionally disabled by the parent makefile. # 14. (For extensions only.) Compare the configuration of the target # Tcl and the extensions and warn against discrepancies. # # One final note about the macro names used. They are as they are # for historical reasons. We would like legacy extensions to # continue to work with this make include file so be wary of # changing them for consistency or clarity. # 0. Sanity check compiler environment # Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or # VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) !if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR) MSG = ^ Visual C++ compiler environment not initialized. !error $(MSG) !endif # We need to run from the directory the parent makefile is located in. # nmake does not tell us what makefile was used to invoke it so parent # makefile has to set the MAKEFILEVC macro or we just make a guess and # warn if we think that is not the case. !if "$(MAKEFILEVC)" == "" !if exist("$(PROJECT).vc") MAKEFILEVC = $(PROJECT).vc !elseif exist("makefile.vc") MAKEFILEVC = makefile.vc !endif !endif # "$(MAKEFILEVC)" == "" !if !exist("$(MAKEFILEVC)") MSG = ^ You must run nmake from the directory containing the project makefile.^ If you are doing that and getting this message, set the MAKEFILEVC^ macro to the name of the project makefile. !message WARNING: $(MSG) !endif ################################################################ # 1. Define external programs being used #---------------------------------------------------------- # Set the proper copy method to avoid overwrite questions # to the user when copying files and selecting the right # "delete all" method. #---------------------------------------------------------- RMDIR = rmdir /S /Q CPY = xcopy /i /y >NUL CPYDIR = xcopy /e /i /y >NUL COPY = copy /y >NUL MKDIR = mkdir ###################################################################### # 2. Figure out our build environment in terms of what we're building. # # (a) Tcl itself # (b) Tk # (c) a Tcl extension using libraries/includes from an *installed* Tcl # (d) a Tcl extension using libraries/includes from Tcl source directory # # This last is needed because some extensions still need # some Tcl interfaces that are not publicly exposed. # # The fragment will set the following macros: # ROOT - root of this module sources # COMPATDIR - source directory that holds compatibility sources # DOCDIR - source directory containing documentation files # GENERICDIR - platform-independent source directory # WIN_DIR - Windows-specific source directory # TESTDIR - directory containing test files # TOOLSDIR - directory containing build tools # _TCLDIR - root of the Tcl installation OR the Tcl sources. Not set # when building Tcl itself. # _INSTALLDIR - native form of the installation path. For Tcl # this will be the root of the Tcl installation. For extensions # this will be the lib directory under the root. # TCLINSTALL - set to 1 if _TCLDIR refers to # headers and libraries from an installed Tcl, and 0 if built against # Tcl sources. Not set when building Tcl itself. Yes, not very well # named. # _TCL_H - native path to the tcl.h file # # If Tk is involved, also sets the following # _TKDIR - native form Tk installation OR Tk source. Not set if building # Tk itself. # TKINSTALL - set 1 if _TKDIR refers to installed Tk and 0 if Tk sources # _TK_H - native path to the tk.h file # Root directory for sources and assumed subdirectories ROOT = $(MAKEDIR)\.. # The following paths CANNOT have spaces in them as they appear on the # left side of implicit rules. !ifndef COMPATDIR COMPATDIR = $(ROOT)\compat !endif !ifndef DOCDIR DOCDIR = $(ROOT)\doc !endif !ifndef GENERICDIR GENERICDIR = $(ROOT)\generic !endif !ifndef TOOLSDIR TOOLSDIR = $(ROOT)\tools !endif !ifndef TESTDIR TESTDIR = $(ROOT)\tests !endif !ifndef LIBDIR !if exist("$(ROOT)\library") LIBDIR = $(ROOT)\library !else LIBDIR = $(ROOT)\lib !endif !endif !ifndef DEMODIR !if exist("$(LIBDIR)\demos") DEMODIR = $(LIBDIR)\demos !else DEMODIR = $(ROOT)\demos !endif !endif # ifndef DEMODIR # Do NOT use WINDIR because it is Windows internal environment # variable to point to c:\windows! WIN_DIR = $(ROOT)\win !ifndef RCDIR !if exist("$(WIN_DIR)\rc") RCDIR = $(WIN_DIR)\rc !else RCDIR = $(WIN_DIR) !endif !endif RCDIR = $(RCDIR:/=\) # The target directory where the built packages and binaries will be installed. # INSTALLDIR is the (optional) path specified by the user. # _INSTALLDIR is INSTALLDIR using the backslash separator syntax !ifdef INSTALLDIR ### Fix the path separators. _INSTALLDIR = $(INSTALLDIR:/=\) !else ### Assume the normal default. _INSTALLDIR = $(HOMEDRIVE)\Tcl !endif !if $(DOING_TCL) # BEGIN Case 2(a) - Building Tcl itself # Only need to define _TCL_H _TCL_H = ..\generic\tcl.h # END Case 2(a) - Building Tcl itself !elseif $(DOING_TK) # BEGIN Case 2(b) - Building Tk TCLINSTALL = 0 # Tk always builds against Tcl source, not an installed Tcl !if "$(TCLDIR)" == "" !if [echo TCLDIR = \> nmakehlp.out] \ || [nmakehlp -L generic\tcl.h >> nmakehlp.out] !error *** Could not locate Tcl source directory. !endif !include nmakehlp.out !endif # TCLDIR == "" _TCLDIR = $(TCLDIR:/=\) _TCL_H = $(_TCLDIR)\generic\tcl.h !if !exist("$(_TCL_H)") !error Could not locate tcl.h. Please set the TCLDIR macro to point to the Tcl *source* directory. !endif _TK_H = ..\generic\tk.h # END Case 2(b) - Building Tk !else # BEGIN Case 2(c) or (d) - Building an extension other than Tk # If command line has specified Tcl location through TCLDIR, use it # else default to the INSTALLDIR setting !if "$(TCLDIR)" != "" _TCLDIR = $(TCLDIR:/=\) !if exist("$(_TCLDIR)\include\tcl.h") # Case 2(c) with TCLDIR defined TCLINSTALL = 1 _TCL_H = $(_TCLDIR)\include\tcl.h !elseif exist("$(_TCLDIR)\generic\tcl.h") # Case 2(d) with TCLDIR defined TCLINSTALL = 0 _TCL_H = $(_TCLDIR)\generic\tcl.h !endif !else # # Case 2(c) for extensions with TCLDIR undefined # Need to locate Tcl depending on whether it needs Tcl source or not. # If we don't, check the INSTALLDIR for an installed Tcl first !if exist("$(_INSTALLDIR)\include\tcl.h") && !$(NEED_TCL_SOURCE) TCLINSTALL = 1 TCLDIR = $(_INSTALLDIR)\.. # NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions # later so the \.. accounts for the /lib _TCLDIR = $(_INSTALLDIR)\.. _TCL_H = $(_TCLDIR)\include\tcl.h !else # exist(...) && !$(NEED_TCL_SOURCE) !if [echo _TCLDIR = \> nmakehlp.out] \ || [nmakehlp -L generic\tcl.h >> nmakehlp.out] !error *** Could not locate Tcl source directory. !endif !include nmakehlp.out TCLINSTALL = 0 TCLDIR = $(_TCLDIR) _TCL_H = $(_TCLDIR)\generic\tcl.h !endif # exist(...) && !$(NEED_TCL_SOURCE) !endif # TCLDIR !ifndef _TCL_H MSG =^ Failed to find tcl.h. The TCLDIR macro is set incorrectly or is not set and default path does not contain tcl.h. !error $(MSG) !endif # Now do the same to locate Tk headers and libs if project requires Tk !if $(NEED_TK) !if "$(TKDIR)" != "" _TKDIR = $(TKDIR:/=\) !if exist("$(_TKDIR)\include\tk.h") TKINSTALL = 1 _TK_H = $(_TKDIR)\include\tk.h !elseif exist("$(_TKDIR)\generic\tk.h") TKINSTALL = 0 _TK_H = $(_TKDIR)\generic\tk.h !endif !else # TKDIR not defined # Need to locate Tcl depending on whether it needs Tcl source or not. # If we don't, check the INSTALLDIR for an installed Tcl first !if exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE) TKINSTALL = 1 # NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions # later so the \.. accounts for the /lib _TKDIR = $(_INSTALLDIR)\.. _TK_H = $(_TKDIR)\include\tk.h TKDIR = $(_TKDIR) !else # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE) !if [echo _TKDIR = \> nmakehlp.out] \ || [nmakehlp -L generic\tk.h >> nmakehlp.out] !error *** Could not locate Tk source directory. !endif !include nmakehlp.out TKINSTALL = 0 TKDIR = $(_TKDIR) _TK_H = $(_TKDIR)\generic\tk.h !endif # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE) !endif # TKDIR !ifndef _TK_H MSG =^ Failed to find tk.h. The TKDIR macro is set incorrectly or is not set and default path does not contain tk.h. !error $(MSG) !endif !endif # NEED_TK !if $(NEED_TCL_SOURCE) && $(TCLINSTALL) MSG = ^ *** Warning: This extension requires the source distribution of Tcl.^ *** Please set the TCLDIR macro to point to the Tcl sources. !error $(MSG) !endif !if $(NEED_TK_SOURCE) !if $(TKINSTALL) MSG = ^ *** Warning: This extension requires the source distribution of Tk.^ *** Please set the TKDIR macro to point to the Tk sources. !error $(MSG) !endif !endif # If INSTALLDIR set to Tcl installation root dir then reset to the # lib dir for installing extensions !if exist("$(_INSTALLDIR)\include\tcl.h") _INSTALLDIR=$(_INSTALLDIR)\lib !endif # END Case 2(c) or (d) - Building an extension !endif # if $(DOING_TCL) ################################################################ # 3. Determine compiler version and architecture # In this section, we figure out the compiler version and the # architecture for which we are building. This sets the # following macros: # VCVERSION - the internal compiler version as 1200, 1400, 1910 etc. # This is also printed by the compiler in dotted form 19.10 etc. # VCVER - the "marketing version", for example Visual C++ 6 for internal # compiler version 1200. This is kept only for legacy reasons as it # does not make sense for recent Microsoft compilers. Only used for # output directory names. # ARCH - set to IX86, ARM64 or AMD64 depending on 32- or 64-bit target # NATIVE_ARCH - set to IX86, ARM64 or AMD64 for the host machine # MACHINE - same as $(ARCH) - legacy # _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed cc32 = $(CC) # built-in default. link32 = link lib32 = lib rc32 = $(RC) # built-in default. #---------------------------------------------------------------- # Figure out the compiler architecture and version by writing # the C macros to a file, preprocessing them with the C # preprocessor and reading back the created file _HASH=^# _VC_MANIFEST_EMBED_EXE= _VC_MANIFEST_EMBED_DLL= VCVER=0 !if ![echo VCVERSION=_MSC_VER > vercl.x] \ && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \ && ![echo ARCH=IX86 >> vercl.x] \ && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \ && ![echo ARCH=AMD64 >> vercl.x] \ && ![echo $(_HASH)elif defined(_M_ARM64) >> vercl.x] \ && ![echo ARCH=ARM64 >> vercl.x] \ && ![echo $(_HASH)endif >> vercl.x] \ && ![$(cc32) -nologo -TC -P vercl.x 2>NUL] !include vercl.i !if $(VCVERSION) < 1900 !if ![echo VCVER= ^\> vercl.vc] \ && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc] !include vercl.vc !endif !else # The simple calculation above does not apply to new Visual Studio releases # Keep the compiler version in its native form. VCVER = $(VCVERSION) !endif !endif !if ![del 2>NUL /q/f vercl.x vercl.i vercl.vc] !endif #---------------------------------------------------------------- # The MACHINE macro is used by legacy makefiles so set it as well !ifdef MACHINE !if "$(MACHINE)" == "x86" !undef MACHINE MACHINE = IX86 !elseif "$(MACHINE)" == "arm64" !undef MACHINE MACHINE = ARM64 !elseif "$(MACHINE)" == "x64" !undef MACHINE MACHINE = AMD64 !endif !if "$(MACHINE)" != "$(ARCH)" !error Specified MACHINE macro $(MACHINE) does not match detected target architecture $(ARCH). !endif !else MACHINE=$(ARCH) !endif #--------------------------------------------------------------- # The PLATFORM_IDENTIFY macro matches the values returned by # the Tcl platform::identify command !if "$(MACHINE)" == "AMD64" PLATFORM_IDENTIFY = win32-x86_64 !elseif "$(MACHINE)" == "ARM64" PLATFORM_IDENTIFY = win32-arm !else PLATFORM_IDENTIFY = win32-ix86 !endif # The MULTIPLATFORM macro controls whether binary extensions are installed # in platform-specific directories. Intended to be set/used by extensions. !ifndef MULTIPLATFORM_INSTALL MULTIPLATFORM_INSTALL = 0 !endif #------------------------------------------------------------ # Figure out the *host* architecture by reading the registry !if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] NATIVE_ARCH=IX86 !elseif ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i ARM | findstr /i 64-bit] NATIVE_ARCH=ARM64 !else NATIVE_ARCH=AMD64 !endif # Since MSVC8 we must deal with manifest resources. !if $(VCVERSION) >= 1400 _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 !endif ################################################################ # 4. Build the nmakehlp program # This is a helper app we need to overcome nmake's limiting # environment. We will call out to it to get various bits of # information about supported compiler options etc. # # Tcl itself will always use the nmakehlp.c program which is # in its own source. It will be kept updated there. # # Extensions built against an installed Tcl will use the installed # copy of Tcl's nmakehlp.c if there is one and their own version # otherwise. In the latter case, they would also be using their own # rules.vc. Note that older versions of Tcl do not install nmakehlp.c # or rules.vc. # # Extensions built against Tcl sources will use the one from the Tcl source. # # When building an extension using a sufficiently new version of Tcl, # rules-ext.vc will define NMAKEHLPC appropriately to point to the # copy of nmakehlp.c to be used. !ifndef NMAKEHLPC # Default to the one in the current directory (the extension's own nmakehlp.c) NMAKEHLPC = nmakehlp.c !if !$(DOING_TCL) !if $(TCLINSTALL) !if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c") NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c !endif !else # !$(TCLINSTALL) !if exist("$(_TCLDIR)\win\nmakehlp.c") NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c !endif !endif # $(TCLINSTALL) !endif # !$(DOING_TCL) !endif # NMAKEHLPC # We always build nmakehlp even if it exists since we do not know # what source it was built from. !if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" !if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul] !endif !else !if [copy $(NMAKEHLPC:nmakehlp.c=x86_64-w64-mingw32-nmakehlp.exe) nmakehlp.exe >NUL] !endif !endif ################################################################ # 5. Test for compiler features # Visual C++ compiler options have changed over the years. Check # which options are supported by the compiler in use. # # The following macros are set: # OPTIMIZATIONS - the compiler flags to be used for optimized builds # DEBUGFLAGS - the compiler flags to be used for debug builds # LINKERFLAGS - Flags passed to the linker # # Note that these are the compiler settings *available*, not those # that will be *used*. The latter depends on the OPTS macro settings # which we have not yet parsed. # # Also note that some of the flags in OPTIMIZATIONS are not really # related to optimization. They are placed there only for legacy reasons # as some extensions expect them to be included in that macro. # -Op improves float consistency. Note only needed for older compilers # Newer compilers do not need or support this option. !if [nmakehlp -c -Op] FPOPTS = -Op !endif # Strict floating point semantics - present in newer compilers in lieu of -Op !if [nmakehlp -c -fp:strict] FPOPTS = $(FPOPTS) -fp:strict !endif !if "$(MACHINE)" == "IX86" ### test for pentium errata !if [nmakehlp -c -QI0f] !message *** Compiler has 'Pentium 0x0f fix' FPOPTS = $(FPOPTS) -QI0f !else !message *** Compiler does not have 'Pentium 0x0f fix' !endif !endif ### test for optimizations # /O2 optimization includes /Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy as per # documentation. Note we do NOT want /Gs as that inserts a _chkstk # stack probe at *every* function entry, not just those with more than # a page of stack allocation resulting in a performance hit. However, # /O2 documentation is misleading as its stack probes are simply the # default page size locals allocation probes and not what is implied # by an explicit /Gs option. OPTIMIZATIONS = $(FPOPTS) !if [nmakehlp -c -O2] OPTIMIZING = 1 OPTIMIZATIONS = $(OPTIMIZATIONS) -O2 !else # Legacy, really. All modern compilers support this !message *** Compiler does not have 'Optimizations' OPTIMIZING = 0 !endif # Checks for buffer overflows in local arrays !if [nmakehlp -c -GS] OPTIMIZATIONS = $(OPTIMIZATIONS) -GS !endif # Link time optimization. Note that this option (potentially) makes # generated libraries only usable by the specific VC++ version that # created it. Requires /LTCG linker option !if [nmakehlp -c -GL] OPTIMIZATIONS = $(OPTIMIZATIONS) -GL CC_GL_OPT_ENABLED = 1 !else # In newer compilers -GL and -YX are incompatible. !if [nmakehlp -c -YX] OPTIMIZATIONS = $(OPTIMIZATIONS) -YX !endif !endif # [nmakehlp -c -GL] DEBUGFLAGS = $(FPOPTS) # Run time error checks. Not available or valid in a release, non-debug build # RTC is for modern compilers, -GZ is legacy !if [nmakehlp -c -RTC1] DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 !elseif [nmakehlp -c -GZ] DEBUGFLAGS = $(DEBUGFLAGS) -GZ !endif #---------------------------------------------------------------- # Linker flags # LINKER_TESTFLAGS are for internal use when we call nmakehlp to test # if the linker supports a specific option. Without these flags link will # return "LNK1561: entry point must be defined" error compiling from VS-IDE: # They are not passed through to the actual application / extension # link rules. !ifndef LINKER_TESTFLAGS LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmakehlp.out !endif LINKERFLAGS = # If compiler has enabled link time optimization, linker must too with -ltcg !ifdef CC_GL_OPT_ENABLED !if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS) -ltcg !endif !endif ################################################################ # 6. Extract various version numbers from headers # For Tcl and Tk, version numbers are extracted from tcl.h and tk.h # respectively. For extensions, versions are extracted from the # configure.in or configure.ac from the TEA configuration if it # exists, and unset otherwise. # Sets the following macros: # TCL_MAJOR_VERSION # TCL_MINOR_VERSION # TCL_RELEASE_SERIAL # TCL_PATCH_LEVEL # TCL_PATCH_LETTER # TCL_VERSION # TK_MAJOR_VERSION # TK_MINOR_VERSION # TK_RELEASE_SERIAL # TK_PATCH_LEVEL # TK_PATCH_LETTER # TK_VERSION # DOTVERSION - set as (for example) 2.5 # VERSION - set as (for example 25) #-------------------------------------------------------------- !if [echo REM = This file is generated from rules.vc > versions.vc] !endif !if [echo TCL_MAJOR_VERSION = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" "define TCL_MAJOR_VERSION" >> versions.vc] !endif !if [echo TCL_MINOR_VERSION = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc] !endif !if [echo TCL_RELEASE_SERIAL = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_RELEASE_SERIAL >> versions.vc] !endif !if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] !endif !if defined(_TK_H) !if [echo TK_MAJOR_VERSION = \>> versions.vc] \ && [nmakehlp -V $(_TK_H) "define TK_MAJOR_VERSION" >> versions.vc] !endif !if [echo TK_MINOR_VERSION = \>> versions.vc] \ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc] !endif !if [echo TK_RELEASE_SERIAL = \>> versions.vc] \ && [nmakehlp -V "$(_TK_H)" TK_RELEASE_SERIAL >> versions.vc] !endif !if [echo TK_PATCH_LEVEL = \>> versions.vc] \ && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc] !endif !endif # _TK_H !include versions.vc TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) TCL_DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) !if [nmakehlp -f $(TCL_PATCH_LEVEL) "a"] TCL_PATCH_LETTER = a !elseif [nmakehlp -f $(TCL_PATCH_LEVEL) "b"] TCL_PATCH_LETTER = b !else TCL_PATCH_LETTER = . !endif !if defined(_TK_H) TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION) TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) !if [nmakehlp -f $(TK_PATCH_LEVEL) "a"] TK_PATCH_LETTER = a !elseif [nmakehlp -f $(TK_PATCH_LEVEL) "b"] TK_PATCH_LETTER = b !else TK_PATCH_LETTER = . !endif !endif # Set DOTVERSION and VERSION !if $(DOING_TCL) DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) VERSION = $(TCL_VERSION) !elseif $(DOING_TK) DOTVERSION = $(TK_DOTVERSION) VERSION = $(TK_VERSION) !else # Doing a non-Tk extension # If parent makefile has not defined DOTVERSION, try to get it from TEA # first from a configure.in file, and then from configure.ac !ifndef DOTVERSION !if [echo DOTVERSION = \> versions.vc] \ || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc] !if [echo DOTVERSION = \> versions.vc] \ || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc] !error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc. !endif !endif !include versions.vc !endif # DOTVERSION VERSION = $(DOTVERSION:.=) !endif # $(DOING_TCL) ... etc. # Windows RC files have 3 version components. Ensure this irrespective # of how many components the package has specified. Basically, ensure # minimum 4 components by appending 4 0's and then pick out the first 4. # Also take care of the fact that DOTVERSION may have "a" or "b" instead # of "." separating the version components. DOTSEPARATED=$(DOTVERSION:a=.) DOTSEPARATED=$(DOTSEPARATED:b=.) !if [echo RCCOMMAVERSION = \> versions.vc] \ || [for /f "tokens=1,2,3,4,5* delims=." %a in ("$(DOTSEPARATED).0.0.0.0") do echo %a,%b,%c,%d >> versions.vc] !error *** Could not generate RCCOMMAVERSION *** !endif !include versions.vc ######################################################################## # 7. Parse the OPTS macro to work out the requested build configuration. # Based on this, we will construct the actual switches to be passed to the # compiler and linker using the macros defined in the previous section. # The following macros are defined by this section based on OPTS # STATIC_BUILD - 0 -> Tcl is to be built as a shared library # 1 -> build as a static library and shell # TCL_THREADS - legacy but always 1 on Windows since winsock requires it. # DEBUG - 1 -> debug build, 0 -> release builds # SYMBOLS - 1 -> generate PDB's, 0 -> no PDB's # PROFILE - 1 -> generate profiling info, 0 -> no profiling # PGO - 1 -> profile based optimization, 0 -> no # MSVCRT - 1 -> link to dynamic C runtime even when building static Tcl build # 0 -> link to static C runtime for static Tcl build. # Does not impact shared Tcl builds (STATIC_BUILD == 0) # Default: 1 for Tcl 8.7 and up, 0 otherwise. # TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions # in the Tcl and Wish shell. 0 -> keep them as shared libraries. Does # not impact shared Tcl builds. Implied by STATIC_BUILD since Tcl 8.7. # USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation. # 0 -> Use the non-thread allocator. # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking # CONFIG_CHECK - 1 -> check current build configuration against Tcl # configuration (ignored for Tcl itself) # _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build # (CRT library should support this, not needed for Tcl 9.x) # Further, LINKERFLAGS are modified based on above. # Default values for all the above STATIC_BUILD = 0 TCL_THREADS = 1 DEBUG = 0 SYMBOLS = 0 PROFILE = 0 PGO = 0 MSVCRT = 1 TCL_USE_STATIC_PACKAGES = 0 USE_THREAD_ALLOC = 1 UNCHECKED = 0 CONFIG_CHECK = 1 !if $(DOING_TCL) USE_STUBS = 0 !else USE_STUBS = 1 !endif # If OPTS is not empty AND does not contain "none" which turns off all OPTS # set the above macros based on OPTS content !if "$(OPTS)" != "" && ![nmakehlp -f "$(OPTS)" "none"] # OPTS are specified, parse them !if [nmakehlp -f $(OPTS) "static"] !message *** Doing static STATIC_BUILD = 1 !endif !if [nmakehlp -f $(OPTS) "nostubs"] !message *** Not using stubs USE_STUBS = 0 !endif !if [nmakehlp -f $(OPTS) "nomsvcrt"] !message *** Doing nomsvcrt MSVCRT = 0 !else !if [nmakehlp -f $(OPTS) "msvcrt"] !message *** Doing msvcrt !else !if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7 && $(STATIC_BUILD) MSVCRT = 0 !endif !endif !endif # [nmakehlp -f $(OPTS) "nomsvcrt"] !if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) !message *** Doing staticpkg TCL_USE_STATIC_PACKAGES = 1 !endif !if [nmakehlp -f $(OPTS) "nothreads"] !message *** Compile explicitly for non-threaded tcl TCL_THREADS = 0 USE_THREAD_ALLOC= 0 !endif !if $(TCL_MAJOR_VERSION) == 8 !if [nmakehlp -f $(OPTS) "time64bit"] !message *** Force 64-bit time_t _USE_64BIT_TIME_T = 1 !endif !endif # Yes, it's weird that the "symbols" option controls DEBUG and # the "pdbs" option controls SYMBOLS. That's historical. !if [nmakehlp -f $(OPTS) "symbols"] !message *** Doing symbols DEBUG = 1 !else DEBUG = 0 !endif !if [nmakehlp -f $(OPTS) "pdbs"] !message *** Doing pdbs SYMBOLS = 1 !else SYMBOLS = 0 !endif !if [nmakehlp -f $(OPTS) "profile"] !message *** Doing profile PROFILE = 1 !else PROFILE = 0 !endif !if [nmakehlp -f $(OPTS) "pgi"] !message *** Doing profile guided optimization instrumentation PGO = 1 !elseif [nmakehlp -f $(OPTS) "pgo"] !message *** Doing profile guided optimization PGO = 2 !else PGO = 0 !endif !if [nmakehlp -f $(OPTS) "loimpact"] !message *** Warning: ignoring option "loimpact" - deprecated on modern Windows. !endif # TBD - should get rid of this option !if [nmakehlp -f $(OPTS) "thrdalloc"] !message *** Doing thrdalloc USE_THREAD_ALLOC = 1 !endif !if [nmakehlp -f $(OPTS) "tclalloc"] USE_THREAD_ALLOC = 0 !endif !if [nmakehlp -f $(OPTS) "unchecked"] !message *** Doing unchecked UNCHECKED = 1 !else UNCHECKED = 0 !endif !if [nmakehlp -f $(OPTS) "noconfigcheck"] CONFIG_CHECK = 1 !else CONFIG_CHECK = 0 !endif !endif # "$(OPTS)" != "" && ... parsing of OPTS # Set linker flags based on above !if $(PGO) > 1 !if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize !else MSG=^ This compiler does not support profile guided optimization. !error $(MSG) !endif !elseif $(PGO) > 0 !if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument !else MSG=^ This compiler does not support profile guided optimization. !error $(MSG) !endif !endif ################################################################ # 8. Parse the STATS macro to configure code instrumentation # The following macros are set by this section: # TCL_MEM_DEBUG - 1 -> enables memory allocation instrumentation # 0 -> disables # TCL_COMPILE_DEBUG - 1 -> enables byte compiler logging # 0 -> disables # Default both are off TCL_MEM_DEBUG = 0 TCL_COMPILE_DEBUG = 0 !if "$(STATS)" != "" && ![nmakehlp -f "$(STATS)" "none"] !if [nmakehlp -f $(STATS) "memdbg"] !message *** Doing memdbg TCL_MEM_DEBUG = 1 !else TCL_MEM_DEBUG = 0 !endif !if [nmakehlp -f $(STATS) "compdbg"] !message *** Doing compdbg TCL_COMPILE_DEBUG = 1 !else TCL_COMPILE_DEBUG = 0 !endif !endif #################################################################### # 9. Parse the CHECKS macro to configure additional compiler checks # The following macros are set by this section: # WARNINGS - compiler switches that control the warnings level # TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions # 0 -> enable deprecated functions # Defaults - Permit deprecated functions and warning level 3 TCL_NO_DEPRECATED = 0 WARNINGS = -W3 !if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"] !if [nmakehlp -f $(CHECKS) "nodep"] !message *** Doing nodep check TCL_NO_DEPRECATED = 1 !endif !if [nmakehlp -f $(CHECKS) "fullwarn"] !message *** Doing full warnings check WARNINGS = -W4 !if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS) -warn:3 !endif !endif !if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64] !message *** Doing 64bit portability warnings WARNINGS = $(WARNINGS) -Wp64 !endif !endif ################################################################ # 10. Construct output directory and file paths # Figure-out how to name our intermediate and output directories. # In order to avoid inadvertent mixing of object files built using # different compilers, build configurations etc., # # Naming convention (suffixes): # t = full thread support. (Not used for Tcl >= 8.7) # s = static library (as opposed to an import library) # g = linked to the debug enabled C run-time. # x = special static build when it links to the dynamic C run-time. # # The following macros are set in this section: # SUFX - the suffix to use for binaries based on above naming convention # BUILDDIRTOP - the toplevel default output directory # is of the form {Release,Debug}[_AMD64][_COMPILERVERSION] # TMP_DIR - directory where object files are created # OUT_DIR - directory where output executables are created # Both TMP_DIR and OUT_DIR are defaulted only if not defined by the # parent makefile (or command line). The default values are # based on BUILDDIRTOP. # STUBPREFIX - name of the stubs library for this project # PRJIMPLIB - output path of the generated project import library # PRJLIBNAME - name of generated project library # PRJLIB - output path of generated project library # PRJSTUBLIBNAME - name of the generated project stubs library # PRJSTUBLIB - output path of the generated project stubs library # RESFILE - output resource file (only if not static build) SUFX = tsgx !if $(DEBUG) BUILDDIRTOP = Debug !else BUILDDIRTOP = Release !endif !if "$(MACHINE)" != "IX86" BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE) !endif !if $(VCVER) > 6 BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER) !endif !if !$(DEBUG) || $(TCL_VERSION) > 86 || $(DEBUG) && $(UNCHECKED) SUFX = $(SUFX:g=) !endif TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX !if !$(STATIC_BUILD) TMP_DIRFULL = $(TMP_DIRFULL:Static=) SUFX = $(SUFX:s=) EXT = dll TMP_DIRFULL = $(TMP_DIRFULL:X=) SUFX = $(SUFX:x=) !else TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=) EXT = lib !if !$(MSVCRT) TMP_DIRFULL = $(TMP_DIRFULL:X=) SUFX = $(SUFX:x=) !endif !endif !if !$(TCL_THREADS) || $(TCL_VERSION) > 86 TMP_DIRFULL = $(TMP_DIRFULL:Threaded=) SUFX = $(SUFX:t=) !endif !ifndef TMP_DIR TMP_DIR = $(TMP_DIRFULL) !ifndef OUT_DIR OUT_DIR = .\$(BUILDDIRTOP) !endif !else !ifndef OUT_DIR OUT_DIR = $(TMP_DIR) !endif !endif # Relative paths -> absolute !if [echo OUT_DIR = \> nmakehlp.out] \ || [nmakehlp -Q "$(OUT_DIR)" >> nmakehlp.out] !error *** Could not fully qualify path OUT_DIR=$(OUT_DIR) !endif !if [echo TMP_DIR = \>> nmakehlp.out] \ || [nmakehlp -Q "$(TMP_DIR)" >> nmakehlp.out] !error *** Could not fully qualify path TMP_DIR=$(TMP_DIR) !endif !include nmakehlp.out # The name of the stubs library for the project being built STUBPREFIX = $(PROJECT)stub # # Set up paths to various Tcl executables and libraries needed by extensions # # TIP 430. Unused for 8.6 but no harm defining it to allow a common rules.vc TCLSCRIPTZIPNAME = libtcl$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)$(TCL_PATCH_LETTER)$(TCL_RELEASE_SERIAL).zip TKSCRIPTZIPNAME = libtk$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)$(TK_PATCH_LETTER)$(TK_RELEASE_SERIAL).zip !if $(DOING_TCL) TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe TCLSH = $(OUT_DIR)\$(TCLSHNAME) TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) TCLLIB = $(OUT_DIR)\$(TCLLIBNAME) TCLSCRIPTZIP = $(OUT_DIR)\$(TCLSCRIPTZIPNAME) TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" !else # !$(DOING_TCL) !if $(TCLINSTALL) # Building against an installed Tcl # When building extensions, we need to locate tclsh. Depending on version # of Tcl we are building against, this may or may not have a "t" suffix. # Try various possibilities in turn. TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe !if !exist("$(TCLSH)") TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe !endif TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib # When building extensions, may be linking against Tcl that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib TCLSCRIPTZIP = $(_TCLDIR)\lib\$(TCLSCRIPTZIPNAME) TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target TCL_INCLUDES = -I"$(_TCLDIR)\include" !else # Building against Tcl sources TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe !if !exist($(TCLSH)) TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe !endif TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib # When building extensions, may be linking against Tcl that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib TCLSCRIPTZIP = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLSCRIPTZIPNAME) TCLTOOLSDIR = $(_TCLDIR)\tools TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" !endif # TCLINSTALL tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)" !endif # $(DOING_TCL) # We need a tclsh that will run on the host machine as part of the build. # IX86 runs on all architectures. !ifndef TCLSH_NATIVE !if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" TCLSH_NATIVE = $(TCLSH) !else !error You must explicitly set TCLSH_NATIVE for cross-compilation !endif !endif # Do the same for Tk and Tk extensions that require the Tk libraries !if $(DOING_TK) || $(NEED_TK) WISHNAMEPREFIX = wish WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe TKLIBNAME8 = tk$(TK_VERSION)$(SUFX).$(EXT) TKLIBNAME9 = tcl9tk$(TK_VERSION)$(SUFX).$(EXT) !if $(TCL_MAJOR_VERSION) == 8 TKLIBNAME = tk$(TK_VERSION)$(SUFX).$(EXT) TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib !else TKLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).$(EXT) TKIMPLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).lib !endif TKSTUBLIBNAME = tkstub$(TK_VERSION).lib !if $(DOING_TK) WISH = $(OUT_DIR)\$(WISHNAME) TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME) TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME) TKLIB = $(OUT_DIR)\$(TKLIBNAME) TK_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" TKSCRIPTZIP = $(OUT_DIR)\$(TKSCRIPTZIPNAME) !else # effectively NEED_TK !if $(TKINSTALL) # Building against installed Tk WISH = $(_TKDIR)\bin\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) # When building extensions, may be linking against Tk that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TKIMPLIB)") TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) !endif TK_INCLUDES = -I"$(_TKDIR)\include" TKSCRIPTZIP = $(_TKDIR)\lib\$(TKSCRIPTZIPNAME) !else # Building against Tk sources WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) # When building extensions, may be linking against Tk that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TKIMPLIB)") TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) !endif TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib" TKSCRIPTZIP = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSCRIPTZIPNAME) !endif # TKINSTALL tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" !endif # $(DOING_TK) !endif # $(DOING_TK) || $(NEED_TK) # Various output paths PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib PRJLIBNAME8 = $(PROJECT)$(VERSION)$(SUFX).$(EXT) PRJLIBNAME9 = tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT) !if $(TCL_MAJOR_VERSION) == 8 PRJLIBNAME = $(PRJLIBNAME8) !else PRJLIBNAME = $(PRJLIBNAME9) !endif PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME) # If extension parent makefile has not defined a resource definition file, # we will generate one from standard template. !if !$(DOING_TCL) && !$(DOING_TK) && !$(STATIC_BUILD) !ifdef RCFILE RESFILE = $(TMP_DIR)\$(RCFILE:.rc=.res) !else RESFILE = $(TMP_DIR)\$(PROJECT).res !endif !endif ################################################################### # 11. Construct the paths for the installation directories # The following macros get defined in this section: # LIB_INSTALL_DIR - where libraries should be installed # BIN_INSTALL_DIR - where the executables should be installed # DOC_INSTALL_DIR - where documentation should be installed # SCRIPT_INSTALL_DIR - where scripts should be installed # INCLUDE_INSTALL_DIR - where C include files should be installed # DEMO_INSTALL_DIR - where demos should be installed # PRJ_INSTALL_DIR - where package will be installed (not set for Tcl and Tk) !if $(DOING_TCL) || $(DOING_TK) LIB_INSTALL_DIR = $(_INSTALLDIR)\lib BIN_INSTALL_DIR = $(_INSTALLDIR)\bin DOC_INSTALL_DIR = $(_INSTALLDIR)\doc !if $(DOING_TCL) SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) MODULE_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(TCL_MAJOR_VERSION) !else # DOING_TK SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) !endif DEMO_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)\demos INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include !else # extension other than Tk PRJ_INSTALL_DIR = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION) !if $(MULTIPLATFORM_INSTALL) LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR)\$(PLATFORM_IDENTIFY) BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR)\$(PLATFORM_IDENTIFY) !else LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR) BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR) !endif DOC_INSTALL_DIR = $(PRJ_INSTALL_DIR) SCRIPT_INSTALL_DIR = $(PRJ_INSTALL_DIR) DEMO_INSTALL_DIR = $(PRJ_INSTALL_DIR)\demos INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include !endif ################################################################### # 12. Set up actual options to be passed to the compiler and linker # Now we have all the information we need, set up the actual flags and # options that we will pass to the compiler and linker. The main # makefile should use these in combination with whatever other flags # and switches are specific to it. # The following macros are defined, names are for historical compatibility: # OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS # COMPILERFLAGS - /Dxxx C macro flags independent of any configuration options # crt - Compiler switch that selects the appropriate C runtime # cdebug - Compiler switches related to debug AND optimizations # cwarn - Compiler switches that set warning levels # cflags - complete compiler switches (subsumes cdebug and cwarn) # ldebug - Linker switches controlling debug information and optimization # lflags - complete linker switches (subsumes ldebug) except subsystem type # dlllflags - complete linker switches to build DLLs (subsumes lflags) # conlflags - complete linker switches for console program (subsumes lflags) # guilflags - complete linker switches for GUI program (subsumes lflags) # baselibs - minimum Windows libraries required. Parent makefile can # define PRJ_LIBS before including rules.rc if additional libs are needed OPTDEFINES = /DSTDC_HEADERS /DUSE_NMAKE=1 !if $(VCVERSION) > 1600 OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1 !else OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1 !endif !if $(VCVERSION) >= 1800 OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1 !endif !if $(TCL_MEM_DEBUG) OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG !endif !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS !endif !if $(TCL_THREADS) && $(TCL_VERSION) < 87 OPTDEFINES = $(OPTDEFINES) /DTCL_THREADS=1 !if $(USE_THREAD_ALLOC) && $(TCL_VERSION) < 87 OPTDEFINES = $(OPTDEFINES) /DUSE_THREAD_ALLOC=1 !endif !endif !if $(STATIC_BUILD) OPTDEFINES = $(OPTDEFINES) /DSTATIC_BUILD !elseif $(TCL_VERSION) > 86 OPTDEFINES = $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH !if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" OPTDEFINES = $(OPTDEFINES) /DMP_64BIT !endif !endif !if $(TCL_NO_DEPRECATED) OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED !endif !if $(USE_STUBS) # Note we do not define USE_TCL_STUBS even when building tk since some # test targets in tk do not use stubs !if !$(DOING_TCL) USE_STUBS_DEFS = /DUSE_TCL_STUBS /DUSE_TCLOO_STUBS !if $(NEED_TK) USE_STUBS_DEFS = $(USE_STUBS_DEFS) /DUSE_TK_STUBS !endif !endif !endif # USE_STUBS !if !$(DEBUG) OPTDEFINES = $(OPTDEFINES) /DNDEBUG !if $(OPTIMIZING) OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_OPTIMIZED !endif !endif !if $(PROFILE) OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_PROFILED !endif !if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 !endif !if $(TCL_MAJOR_VERSION) == 8 !if "$(_USE_64BIT_TIME_T)" == "1" OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1 !endif # _ATL_XP_TARGETING - Newer SDK's need this to build for XP COMPILERFLAGS = /D_ATL_XP_TARGETING !endif # Like the TEA system only set this non empty for non-Tk extensions # Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME # so we pass both !if !$(DOING_TCL) && !$(DOING_TK) PKGNAMEFLAGS = /DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ /DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ /DPACKAGE_VERSION="\"$(DOTVERSION)\"" \ /DMODULE_SCOPE=extern !endif # crt picks the C run time based on selected OPTS !if $(MSVCRT) !if $(DEBUG) && !$(UNCHECKED) crt = -MDd !else crt = -MD !endif !else !if $(DEBUG) && !$(UNCHECKED) crt = -MTd !else crt = -MT !endif !endif # cdebug includes compiler options for debugging as well as optimization. !if $(DEBUG) # In debugging mode, optimizations need to be disabled cdebug = -Zi -Od $(DEBUGFLAGS) !else cdebug = $(OPTIMIZATIONS) !if $(SYMBOLS) cdebug = $(cdebug) -Zi !endif !endif # $(DEBUG) # cwarn includes default warning levels, also C4090 (buggy) and C4146 is useless. cwarn = $(WARNINGS) -wd4090 -wd4146 !if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" # Disable pointer<->int warnings related to cast between different sizes # There are a gadzillion of these due to use of ClientData and # clutter up compiler # output increasing chance of a real warning getting lost. So disable them. # Eventually some day, Tcl will be 64-bit clean. cwarn = $(cwarn) -wd4311 -wd4312 !endif ### Common compiler options that are architecture specific !if "$(MACHINE)" == "ARM" carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE !else carch = !endif # cpuid is only available on intel machines !if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "AMD64" carch = $(carch) /DHAVE_CPUID=1 !endif !if $(DEBUG) # Turn warnings into errors cwarn = $(cwarn) -WX !endif INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES) !if !$(DOING_TCL) && !$(DOING_TK) INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WIN_DIR)" -I"$(COMPATDIR)" !endif # These flags are defined roughly in the order of the pre-reform # rules.vc/makefile.vc to help visually compare that the pre- and # post-reform build logs # cflags contains generic flags used for building practically all object files cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug) # appcflags contains $(cflags) and flags for building the application # object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus # flags used for building shared object files The two differ in the # BUILD_$(PROJECT) macro which should be defined only for the shared # library *implementation* and not for its caller interface appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS) pkgcflags = $(appcflags) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT) pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT) # stubscflags contains $(cflags) plus flags used for building a stubs # library for the package. Note: /DSTATIC_BUILD is defined in # $(OPTDEFINES) only if the OPTS configuration indicates a static # library. However the stubs library is ALWAYS static hence included # here irrespective of the OPTS setting. # # TBD - tclvfs has a comment that stubs libs should not be compiled with -GL # without stating why. Tcl itself compiled stubs libs with this flag. # so we do not remove it from cflags. -GL may prevent extensions # compiled with one VC version to fail to link against stubs library # compiled with another VC version. Check for this and fix accordingly. stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) /Zl /GL- /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS) # Link flags !if $(DEBUG) ldebug = -debug -debugtype:cv !else ldebug = -release -opt:ref -opt:icf,3 !if $(SYMBOLS) ldebug = $(ldebug) -debug -debugtype:cv !endif !endif # Note: Profiling is currently only possible with the Visual Studio Enterprise !if $(PROFILE) ldebug= $(ldebug) -profile !endif ### Declarations common to all linker versions lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) !if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900 lflags = $(lflags) -nodefaultlib:libucrt.lib !endif dlllflags = $(lflags) -dll conlflags = $(lflags) -subsystem:console guilflags = $(lflags) -subsystem:windows # Libraries that are required for every image. # Extensions should define any additional libraries with $(PRJ_LIBS) winlibs = kernel32.lib advapi32.lib !if $(NEED_TK) winlibs = $(winlibs) gdi32.lib user32.lib uxtheme.lib !endif # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 !if "$(MACHINE)" == "AMD64" !if $(VCVERSION) > 1399 && $(VCVERSION) < 1500 winlibs = $(winlibs) bufferoverflowU.lib !endif !endif baselibs = $(winlibs) $(PRJ_LIBS) !if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900 baselibs = $(baselibs) ucrt.lib !endif ################################################################ # 13. Define standard commands, common make targets and implicit rules CCPKGCMD = $(cc32) $(pkgcflags) -Fo$(TMP_DIR)^\ CCAPPCMD = $(cc32) $(appcflags) -Fo$(TMP_DIR)^\ CCSTUBSCMD = $(cc32) $(stubscflags) -Fo$(TMP_DIR)^\ LIBCMD = $(lib32) -nologo $(LINKERFLAGS) -out:$@ DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ $(TCL_INCLUDES) /DSTATIC_BUILD=$(STATIC_BUILD) \ /DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ /DCOMMAVERSION=$(RCCOMMAVERSION) \ /DDOTVERSION=\"$(DOTVERSION)\" \ /DVERSION=\"$(VERSION)\" \ /DSUFX=\"$(SUFX)\" \ /DPROJECT=\"$(PROJECT)\" \ /DPRJLIBNAME=\"$(PRJLIBNAME)\" !ifndef DEFAULT_BUILD_TARGET DEFAULT_BUILD_TARGET = $(PROJECT) !endif default-target: $(DEFAULT_BUILD_TARGET) !if $(MULTIPLATFORM_INSTALL) default-pkgindex: @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl @echo } else { >> $(OUT_DIR)\pkgIndex.tcl @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl @echo } >> $(OUT_DIR)\pkgIndex.tcl !else default-pkgindex: @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ [list load [file join $$dir $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl @echo } else { >> $(OUT_DIR)\pkgIndex.tcl @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ [list load [file join $$dir $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl @echo } >> $(OUT_DIR)\pkgIndex.tcl !endif default-pkgindex-tea: @if exist $(ROOT)\pkgIndex.tcl.in nmakehlp -s << $(ROOT)\pkgIndex.tcl.in > $(OUT_DIR)\pkgIndex.tcl @PACKAGE_VERSION@ $(DOTVERSION) @PACKAGE_NAME@ $(PRJ_PACKAGE_TCLNAME) @PACKAGE_TCLNAME@ $(PRJ_PACKAGE_TCLNAME) @PKG_LIB_FILE@ $(PRJLIBNAME) @PKG_LIB_FILE8@ $(PRJLIBNAME8) @PKG_LIB_FILE9@ $(PRJLIBNAME9) << default-install: default-install-binaries default-install-libraries !if $(SYMBOLS) default-install: default-install-pdbs !endif # Again to deal with historical brokenness, there is some confusion # in terminlogy. For extensions, the "install-binaries" was used to # locate target directory for *binary shared libraries* and thus # the appropriate macro is LIB_INSTALL_DIR since BIN_INSTALL_DIR is # for executables (exes). On the other hand the "install-libraries" # target is for *scripts* and should have been called "install-scripts". default-install-binaries: $(PRJLIB) @echo Installing binaries to '$(LIB_INSTALL_DIR)' @if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)" @$(CPY) $(PRJLIB) "$(LIB_INSTALL_DIR)" >NUL # Alias for default-install-scripts default-install-libraries: default-install-scripts default-install-scripts: $(OUT_DIR)\pkgIndex.tcl @echo Installing libraries to '$(SCRIPT_INSTALL_DIR)' @if exist $(LIBDIR) $(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)" @echo Installing package index in '$(SCRIPT_INSTALL_DIR)' @$(CPY) $(OUT_DIR)\pkgIndex.tcl $(SCRIPT_INSTALL_DIR) default-install-stubs: @echo Installing stubs library to '$(SCRIPT_INSTALL_DIR)' @if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)" @$(CPY) $(PRJSTUBLIB) "$(SCRIPT_INSTALL_DIR)" >NUL default-install-pdbs: @echo Installing PDBs to '$(LIB_INSTALL_DIR)' @if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)" @$(CPY) "$(OUT_DIR)\*.pdb" "$(LIB_INSTALL_DIR)\" # "emacs font-lock highlighting fix default-install-docs-html: @echo Installing documentation files to '$(DOC_INSTALL_DIR)' @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)" @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)" default-install-docs-n: @echo Installing documentation files to '$(DOC_INSTALL_DIR)' @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)" @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.n") do @$(COPY) %f "$(DOC_INSTALL_DIR)" default-install-demos: @echo Installing demos to '$(DEMO_INSTALL_DIR)' @if not exist "$(DEMO_INSTALL_DIR)" mkdir "$(DEMO_INSTALL_DIR)" @if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)" default-clean: @echo Cleaning $(TMP_DIR)\* ... @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) @echo Cleaning $(WIN_DIR)\nmakehlp.obj, nmakehlp.exe ... @if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj @if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe @if exist $(WIN_DIR)\nmakehlp.out del $(WIN_DIR)\nmakehlp.out @echo Cleaning $(WIN_DIR)\nmhlp-out.txt ... @if exist $(WIN_DIR)\nmhlp-out.txt del $(WIN_DIR)\nmhlp-out.txt @echo Cleaning $(WIN_DIR)\_junk.pch ... @if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch @echo Cleaning $(WIN_DIR)\vercl.x, vercl.i ... @if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x @if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i @echo Cleaning $(WIN_DIR)\versions.vc, version.vc ... @if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc @if exist $(WIN_DIR)\version.vc del $(WIN_DIR)\version.vc default-hose: default-clean @echo Hosing $(OUT_DIR)\* ... @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) # Only for backward compatibility default-distclean: default-hose default-setup: @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) !if "$(TESTPAT)" != "" TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) !endif default-test: default-setup $(PROJECT) @set TCLLIBPATH=$(OUT_DIR:\=/) @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)" cd "$(TESTDIR)" && $(DEBUGGER) $(TCLSH) all.tcl $(TESTFLAGS) default-shell: default-setup $(PROJECT) @set TCLLIBPATH=$(OUT_DIR:\=/) @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)" $(DEBUGGER) $(TCLSH) # Generation of Windows version resource !ifdef RCFILE # Note: don't use $** in below rule because there may be other dependencies # and only the "main" rc must be passed to the resource compiler $(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc $(RESCMD) $(RCDIR)\$(PROJECT).rc !else # If parent makefile has not defined a resource definition file, # we will generate one from standard template. $(TMP_DIR)\$(PROJECT).res: $(TMP_DIR)\$(PROJECT).rc $(TMP_DIR)\$(PROJECT).rc: @$(COPY) << $(TMP_DIR)\$(PROJECT).rc #include VS_VERSION_INFO VERSIONINFO FILEVERSION COMMAVERSION PRODUCTVERSION COMMAVERSION FILEFLAGSMASK 0x3fL #ifdef DEBUG FILEFLAGS VS_FF_DEBUG #else FILEFLAGS 0x0L #endif FILEOS VOS_NT_WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE 0x0L BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "040904b0" BEGIN VALUE "FileDescription", "Tcl extension " PROJECT VALUE "OriginalFilename", PRJLIBNAME VALUE "FileVersion", DOTVERSION VALUE "ProductName", "Package " PROJECT " for Tcl" VALUE "ProductVersion", DOTVERSION END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x409, 1200 END END << !endif # ifdef RCFILE !ifndef DISABLE_IMPLICIT_RULES DISABLE_IMPLICIT_RULES = 0 !endif !if !$(DISABLE_IMPLICIT_RULES) # Implicit rule definitions - only for building library objects. For stubs and # main application, the makefile should define explicit rules. {$(ROOT)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(WIN_DIR)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(RCDIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< {$(WIN_DIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< {$(TMP_DIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< .SUFFIXES: .SUFFIXES:.c .rc !endif ################################################################ # 14. Sanity check selected options against Tcl build options # When building an extension, certain configuration options should # match the ones used when Tcl was built. Here we check and # warn on a mismatch. !if !$(DOING_TCL) !if $(TCLINSTALL) # Building against an installed Tcl !if exist("$(_TCLDIR)\lib\nmake\tcl.nmake") TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake" !endif !else # !$(TCLINSTALL) - building against Tcl source !if exist("$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake") TCLNMAKECONFIG = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake" !endif !endif # TCLINSTALL !if $(CONFIG_CHECK) !ifdef TCLNMAKECONFIG !include $(TCLNMAKECONFIG) !if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)" !error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)). !endif !if $(TCL_VERSION) < 87 && defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC) !message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)). !endif !if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG) !message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)). !endif !endif !endif # TCLNMAKECONFIG !endif # !$(DOING_TCL) #---------------------------------------------------------- # Display stats being used. #---------------------------------------------------------- !if !$(DOING_TCL) !message *** Building against Tcl at '$(_TCLDIR)' !endif !if !$(DOING_TK) && $(NEED_TK) !message *** Building against Tk at '$(_TKDIR)' !endif !message *** Intermediate directory will be '$(TMP_DIR)' !message *** Output directory will be '$(OUT_DIR)' !message *** Installation, if selected, will be in '$(_INSTALLDIR)' !message *** Suffix for binaries will be '$(SUFX)' !message *** Compiler version $(VCVER). Target $(MACHINE), host $(NATIVE_ARCH). !endif # ifdef _RULES_VC tcl8.6.14/win/targets.vc0000644000175000017500000000505614554262142014450 0ustar sergeisergei#------------------------------------------------------------- -*- makefile -*- # targets.vc -- # # Part of the nmake based build system for Tcl and its extensions. # This file defines some standard targets for the convenience of extensions # and can be optionally included by the extension makefile. # See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for docs. $(PROJECT): setup pkgindex $(PRJLIB) !ifdef PRJ_STUBOBJS $(PROJECT): $(PRJSTUBLIB) $(PRJSTUBLIB): $(PRJ_STUBOBJS) $(LIBCMD) $** $(PRJ_STUBOBJS): $(CCSTUBSCMD) %s !endif # PRJ_STUBOBJS !ifdef PRJ_MANIFEST $(PROJECT): $(PRJLIB).manifest $(PRJLIB).manifest: $(PRJ_MANIFEST) @nmakehlp -s << $** >$@ @MACHINE@ $(MACHINE:IX86=X86) << !endif !if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk" $(PRJLIB): $(PRJ_OBJS) $(RESFILE) !if $(STATIC_BUILD) $(LIBCMD) $** !else $(DLLCMD) $** $(_VC_MANIFEST_EMBED_DLL) !endif -@del $*.exp !endif !if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != "" $(PRJ_OBJS): $(PRJ_HEADERS) !endif # If parent makefile has defined stub objects, add their installation # to the default install !if "$(PRJ_STUBOBJS)" != "" default-install: default-install-stubs !endif # Unlike the other default targets, these cannot be in rules.vc because # the executed command depends on existence of macro PRJ_HEADERS_PUBLIC # that the parent makefile will not define until after including rules-ext.vc !if "$(PRJ_HEADERS_PUBLIC)" != "" default-install: default-install-headers default-install-headers: @echo Installing headers to '$(INCLUDE_INSTALL_DIR)' @for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)" !endif !if "$(DISABLE_STANDARD_TARGETS)" == "" DISABLE_STANDARD_TARGETS = 0 !endif !if "$(DISABLE_TARGET_setup)" == "" DISABLE_TARGET_setup = 0 !endif !if "$(DISABLE_TARGET_install)" == "" DISABLE_TARGET_install = 0 !endif !if "$(DISABLE_TARGET_clean)" == "" DISABLE_TARGET_clean = 0 !endif !if "$(DISABLE_TARGET_test)" == "" DISABLE_TARGET_test = 0 !endif !if "$(DISABLE_TARGET_shell)" == "" DISABLE_TARGET_shell = 0 !endif !if !$(DISABLE_STANDARD_TARGETS) !if !$(DISABLE_TARGET_setup) setup: default-setup !endif !if !$(DISABLE_TARGET_install) install: default-install !endif !if !$(DISABLE_TARGET_clean) clean: default-clean realclean: hose hose: default-hose distclean: realclean default-distclean !endif !if !$(DISABLE_TARGET_test) test: default-test !endif !if !$(DISABLE_TARGET_shell) shell: default-shell !endif !endif # DISABLE_STANDARD_TARGETS tcl8.6.14/win/coffbase.txt0000644000175000017500000000326214554262142014753 0ustar sergeisergei; ; This file defines the virtual base addresses for the Dynamic Link Libraries ; that are part of the Tcl system. The first token on a line is the key (or name ; of the DLL) and the second token is the virtual base address, in hexadecimal. ; The third token is the maximum size of the DLL image file, including symbols. ; ; Using a specified "preferred load address" should speed loading time by avoiding ; relocations (NT supported only). It is assumed extension authors will contribute ; their modules to this grand-master list. You can use the dumpbin utility with ; the /headers option to get the "size of image" data (already in hex). If the ; maximum size is too small a linker warning will occur. Modules can overlap when ; they're mutually exclusive. This info is placed in the DLL's PE header by the ; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,` option. tcl 0x10000000 0x00200000 tcldde 0x10200000 0x00010000 tclreg 0x10210000 0x00010000 tk 0x10220000 0x00200000 expect 0x10480000 0x00080000 itcl 0x10500000 0x00080000 itk 0x10580000 0x00080000 bltlite 0x10600000 0x00080000 blt 0x10680000 0x00080000 iocpsock 0x10700000 0x00080000 tls 0x10780000 0x00100000 winico 0x10880000 0x00010000 sample 0x108B0000 0x00010000 tile 0x10900000 0x00080000 memchan 0x109D0000 0x00010000 tdom 0x109E0000 0x00080000 tclvfs 0x10A70000 0x00010000 tkvideo 0x10B00000 0x00010000 tclsdl 0x10B20000 0x00080000 vqtcl 0x10C00000 0x00010000 tdbc 0x10C40000 0x00010000 thread 0x10C80000 0x00020000 nsf 0x10ca0000 0x00080000 ; ; insert new packages here ; snack 0x1E000000 0x00400000 sound 0x1E400000 0x00400000 snackogg 0x1E800000 0x00200000 tcl8.6.14/win/tcl.hpj.in0000644000175000017500000000053414554262142014333 0ustar sergeisergei; This file is maintained by HCW. Do not modify this file directly. [OPTIONS] HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual CNT=tcl86.cnt COPYRIGHT=Copyright Љ 2000 Ajuba Solutions HLP=tcl86.hlp [FILES] tcl.rtf [WINDOWS] main="Tcl/Tk Reference Manual",,0 [CONFIG] BrowseButtons() tcl8.6.14/win/tcl.dsp0000644000175000017500000007010614554262142013735 0ustar sergeisergei# Microsoft Developer Studio Project File - Name="tcl" - Package Owner=<4> # Microsoft Developer Studio Generated Build File, Format Version 6.00 # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) External Target" 0x0106 CFG=tcl - Win32 Debug Static !MESSAGE This is not a valid makefile. To build this project using NMAKE, !MESSAGE use the Export Makefile command and run !MESSAGE !MESSAGE NMAKE /f "tcl.mak". !MESSAGE !MESSAGE You can specify a configuration when running NMAKE !MESSAGE by defining the macro CFG on the command line. For example: !MESSAGE !MESSAGE NMAKE /f "tcl.mak" CFG="tcl - Win32 Debug Static" !MESSAGE !MESSAGE Possible choices for configuration are: !MESSAGE !MESSAGE "tcl - Win32 Release" (based on "Win32 (x86) External Target") !MESSAGE "tcl - Win32 Debug" (based on "Win32 (x86) External Target") !MESSAGE "tcl - Win32 Debug Static" (based on "Win32 (x86) External Target") !MESSAGE "tcl - Win32 Release Static" (based on "Win32 (x86) External Target") !MESSAGE # Begin Project # PROP AllowPerConfigDependencies 0 # PROP Scc_ProjName "" # PROP Scc_LocalPath "" !IF "$(CFG)" == "tcl - Win32 Release" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" # PROP BASE Target_File "Release\tclsh86.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "Release" # PROP Intermediate_Dir "Release\tcl_Dynamic" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE" # PROP Rebuild_Opt "clean release" # PROP Target_File "Release\tclsh86t.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ELSEIF "$(CFG)" == "tcl - Win32 Debug" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 1 # PROP BASE Output_Dir "Debug" # PROP BASE Intermediate_Dir "Debug\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" # PROP BASE Target_File "Debug\tclsh86g.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "Debug" # PROP Intermediate_Dir "Debug\tcl_Dynamic" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE" # PROP Rebuild_Opt "clean release" # PROP Target_File "Debug\tclsh86tg.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ELSEIF "$(CFG)" == "tcl - Win32 Debug Static" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 1 # PROP BASE Output_Dir "Debug" # PROP BASE Intermediate_Dir "Debug\tcl_Static" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" # PROP BASE Target_File "Debug\tclsh86sg.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "Debug" # PROP Intermediate_Dir "Debug\tcl_Static" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" # PROP Rebuild_Opt "-a" # PROP Target_File "Debug\tclsh86sg.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ELSEIF "$(CFG)" == "tcl - Win32 Release Static" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release\tcl_Static" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" # PROP BASE Target_File "Release\tclsh86s.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "Release" # PROP Intermediate_Dir "Release\tcl_Static" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" # PROP Rebuild_Opt "-a" # PROP Target_File "Release\tclsh86s.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ENDIF # Begin Target # Name "tcl - Win32 Release" # Name "tcl - Win32 Debug" # Name "tcl - Win32 Debug Static" # Name "tcl - Win32 Release Static" !IF "$(CFG)" == "tcl - Win32 Release" !ELSEIF "$(CFG)" == "tcl - Win32 Debug" !ELSEIF "$(CFG)" == "tcl - Win32 Debug Static" !ELSEIF "$(CFG)" == "tcl - Win32 Release Static" !ENDIF # Begin Group "compat" # PROP Default_Filter "" # Begin Source File SOURCE=..\compat\dirent.h # End Source File # Begin Source File SOURCE=..\compat\dirent2.h # End Source File # Begin Source File SOURCE=..\compat\dlfcn.h # End Source File # Begin Source File SOURCE=..\compat\fixstrtod.c # End Source File # Begin Source File SOURCE=..\compat\float.h # End Source File # Begin Source File SOURCE=..\compat\gettod.c # End Source File # Begin Source File SOURCE=..\compat\limits.h # End Source File # Begin Source File SOURCE=..\compat\memcmp.c # End Source File # Begin Source File SOURCE=..\compat\opendir.c # End Source File # Begin Source File SOURCE=..\compat\README # End Source File # Begin Source File SOURCE=..\compat\stdlib.h # End Source File # Begin Source File SOURCE=..\compat\string.h # End Source File # Begin Source File SOURCE=..\compat\strncasecmp.c # End Source File # Begin Source File SOURCE=..\compat\strstr.c # End Source File # Begin Source File SOURCE=..\compat\strtod.c # End Source File # Begin Source File SOURCE=..\compat\strtol.c # End Source File # Begin Source File SOURCE=..\compat\strtoul.c # End Source File # Begin Source File SOURCE=..\compat\tclErrno.h # End Source File # Begin Source File SOURCE=..\compat\unistd.h # End Source File # Begin Source File SOURCE=..\compat\waitpid.c # End Source File # End Group # Begin Group "doc" # PROP Default_Filter "" # Begin Source File SOURCE=..\doc\Access.3 # End Source File # Begin Source File SOURCE=..\doc\AddErrInfo.3 # End Source File # Begin Source File SOURCE=..\doc\after.n # End Source File # Begin Source File SOURCE=..\doc\Alloc.3 # End Source File # Begin Source File SOURCE=..\doc\AllowExc.3 # End Source File # Begin Source File SOURCE=..\doc\append.n # End Source File # Begin Source File SOURCE=..\doc\AppInit.3 # End Source File # Begin Source File SOURCE=..\doc\array.n # End Source File # Begin Source File SOURCE=..\doc\AssocData.3 # End Source File # Begin Source File SOURCE=..\doc\Async.3 # End Source File # Begin Source File SOURCE=..\doc\BackgdErr.3 # End Source File # Begin Source File SOURCE=..\doc\Backslash.3 # End Source File # Begin Source File SOURCE=..\doc\bgerror.n # End Source File # Begin Source File SOURCE=..\doc\binary.n # End Source File # Begin Source File SOURCE=..\doc\BoolObj.3 # End Source File # Begin Source File SOURCE=..\doc\break.n # End Source File # Begin Source File SOURCE=..\doc\ByteArrObj.3 # End Source File # Begin Source File SOURCE=..\doc\CallDel.3 # End Source File # Begin Source File SOURCE=..\doc\case.n # End Source File # Begin Source File SOURCE=..\doc\catch.n # End Source File # Begin Source File SOURCE=..\doc\cd.n # End Source File # Begin Source File SOURCE=..\doc\ChnlStack.3 # End Source File # Begin Source File SOURCE=..\doc\clock.n # End Source File # Begin Source File SOURCE=..\doc\close.n # End Source File # Begin Source File SOURCE=..\doc\CmdCmplt.3 # End Source File # Begin Source File SOURCE=..\doc\Concat.3 # End Source File # Begin Source File SOURCE=..\doc\concat.n # End Source File # Begin Source File SOURCE=..\doc\continue.n # End Source File # Begin Source File SOURCE=..\doc\CrtChannel.3 # End Source File # Begin Source File SOURCE=..\doc\CrtChnlHdlr.3 # End Source File # Begin Source File SOURCE=..\doc\CrtCloseHdlr.3 # End Source File # Begin Source File SOURCE=..\doc\CrtCommand.3 # End Source File # Begin Source File SOURCE=..\doc\CrtFileHdlr.3 # End Source File # Begin Source File SOURCE=..\doc\CrtInterp.3 # End Source File # Begin Source File SOURCE=..\doc\CrtMathFnc.3 # End Source File # Begin Source File SOURCE=..\doc\CrtObjCmd.3 # End Source File # Begin Source File SOURCE=..\doc\CrtAlias.3 # End Source File # Begin Source File SOURCE=..\doc\CrtTimerHdlr.3 # End Source File # Begin Source File SOURCE=..\doc\CrtTrace.3 # End Source File # Begin Source File SOURCE=..\doc\dde.n # End Source File # Begin Source File SOURCE=..\doc\DetachPids.3 # End Source File # Begin Source File SOURCE=..\doc\DoOneEvent.3 # End Source File # Begin Source File SOURCE=..\doc\DoubleObj.3 # End Source File # Begin Source File SOURCE=..\doc\DoWhenIdle.3 # End Source File # Begin Source File SOURCE=..\doc\DString.3 # End Source File # Begin Source File SOURCE=..\doc\DumpActiveMemory.3 # End Source File # Begin Source File SOURCE=..\doc\Encoding.3 # End Source File # Begin Source File SOURCE=..\doc\encoding.n # End Source File # Begin Source File SOURCE=..\doc\Environment.3 # End Source File # Begin Source File SOURCE=..\doc\eof.n # End Source File # Begin Source File SOURCE=..\doc\error.n # End Source File # Begin Source File SOURCE=..\doc\Eval.3 # End Source File # Begin Source File SOURCE=..\doc\eval.n # End Source File # Begin Source File SOURCE=..\doc\exec.n # End Source File # Begin Source File SOURCE=..\doc\Exit.3 # End Source File # Begin Source File SOURCE=..\doc\exit.n # End Source File # Begin Source File SOURCE=..\doc\expr.n # End Source File # Begin Source File SOURCE=..\doc\ExprLong.3 # End Source File # Begin Source File SOURCE=..\doc\ExprLongObj.3 # End Source File # Begin Source File SOURCE=..\doc\fblocked.n # End Source File # Begin Source File SOURCE=..\doc\fconfigure.n # End Source File # Begin Source File SOURCE=..\doc\fcopy.n # End Source File # Begin Source File SOURCE=..\doc\file.n # End Source File # Begin Source File SOURCE=..\doc\fileevent.n # End Source File # Begin Source File SOURCE=..\doc\filename.n # End Source File # Begin Source File SOURCE=..\doc\FileSystem.3 # End Source File # Begin Source File SOURCE=..\doc\FindExec.3 # End Source File # Begin Source File SOURCE=..\doc\flush.n # End Source File # Begin Source File SOURCE=..\doc\for.n # End Source File # Begin Source File SOURCE=..\doc\foreach.n # End Source File # Begin Source File SOURCE=..\doc\format.n # End Source File # Begin Source File SOURCE=..\doc\GetCwd.3 # End Source File # Begin Source File SOURCE=..\doc\GetHostName.3 # End Source File # Begin Source File SOURCE=..\doc\GetIndex.3 # End Source File # Begin Source File SOURCE=..\doc\GetInt.3 # End Source File # Begin Source File SOURCE=..\doc\GetOpnFl.3 # End Source File # Begin Source File SOURCE=..\doc\gets.n # End Source File # Begin Source File SOURCE=..\doc\GetStdChan.3 # End Source File # Begin Source File SOURCE=..\doc\GetVersion.3 # End Source File # Begin Source File SOURCE=..\doc\glob.n # End Source File # Begin Source File SOURCE=..\doc\global.n # End Source File # Begin Source File SOURCE=..\doc\Hash.3 # End Source File # Begin Source File SOURCE=..\doc\history.n # End Source File # Begin Source File SOURCE=..\doc\http.n # End Source File # Begin Source File SOURCE=..\doc\if.n # End Source File # Begin Source File SOURCE=..\doc\incr.n # End Source File # Begin Source File SOURCE=..\doc\info.n # End Source File # Begin Source File SOURCE=..\doc\Init.3 # End Source File # Begin Source File SOURCE=..\doc\InitStubs.3 # End Source File # Begin Source File SOURCE=..\doc\Interp.3 # End Source File # Begin Source File SOURCE=..\doc\interp.n # End Source File # Begin Source File SOURCE=..\doc\IntObj.3 # End Source File # Begin Source File SOURCE=..\doc\join.n # End Source File # Begin Source File SOURCE=..\doc\lappend.n # End Source File # Begin Source File SOURCE=..\doc\library.n # End Source File # Begin Source File SOURCE=..\doc\lindex.n # End Source File # Begin Source File SOURCE=..\doc\LinkVar.3 # End Source File # Begin Source File SOURCE=..\doc\linsert.n # End Source File # Begin Source File SOURCE=..\doc\list.n # End Source File # Begin Source File SOURCE=..\doc\ListObj.3 # End Source File # Begin Source File SOURCE=..\doc\llength.n # End Source File # Begin Source File SOURCE=..\doc\load.n # End Source File # Begin Source File SOURCE=..\doc\lrange.n # End Source File # Begin Source File SOURCE=..\doc\lreplace.n # End Source File # Begin Source File SOURCE=..\doc\lsearch.n # End Source File # Begin Source File SOURCE=..\doc\lsort.n # End Source File # Begin Source File SOURCE=..\doc\man.macros # End Source File # Begin Source File SOURCE=..\doc\memory.n # End Source File # Begin Source File SOURCE=..\doc\msgcat.n # End Source File # Begin Source File SOURCE=..\doc\namespace.n # End Source File # Begin Source File SOURCE=..\doc\Notifier.3 # End Source File # Begin Source File SOURCE=..\doc\Object.3 # End Source File # Begin Source File SOURCE=..\doc\ObjectType.3 # End Source File # Begin Source File SOURCE=..\doc\open.n # End Source File # Begin Source File SOURCE=..\doc\OpenFileChnl.3 # End Source File # Begin Source File SOURCE=..\doc\OpenTcp.3 # End Source File # Begin Source File SOURCE=..\doc\package.n # End Source File # Begin Source File SOURCE=..\doc\packagens.n # End Source File # Begin Source File SOURCE=..\doc\Panic.3 # End Source File # Begin Source File SOURCE=..\doc\ParseCmd.3 # End Source File # Begin Source File SOURCE=..\doc\pid.n # End Source File # Begin Source File SOURCE=..\doc\pkgMkIndex.n # End Source File # Begin Source File SOURCE=..\doc\PkgRequire.3 # End Source File # Begin Source File SOURCE=..\doc\Preserve.3 # End Source File # Begin Source File SOURCE=..\doc\PrintDbl.3 # End Source File # Begin Source File SOURCE=..\doc\proc.n # End Source File # Begin Source File SOURCE=..\doc\puts.n # End Source File # Begin Source File SOURCE=..\doc\pwd.n # End Source File # Begin Source File SOURCE=..\doc\re_syntax.n # End Source File # Begin Source File SOURCE=..\doc\read.n # End Source File # Begin Source File SOURCE=..\doc\RecEvalObj.3 # End Source File # Begin Source File SOURCE=..\doc\RecordEval.3 # End Source File # Begin Source File SOURCE=..\doc\RegExp.3 # End Source File # Begin Source File SOURCE=..\doc\regexp.n # End Source File # Begin Source File SOURCE=..\doc\registry.n # End Source File # Begin Source File SOURCE=..\doc\regsub.n # End Source File # Begin Source File SOURCE=..\doc\rename.n # End Source File # Begin Source File SOURCE=..\doc\return.n # End Source File # Begin Source File SOURCE=..\doc\safe.n # End Source File # Begin Source File SOURCE=..\doc\SaveResult.3 # End Source File # Begin Source File SOURCE=..\doc\scan.n # End Source File # Begin Source File SOURCE=..\doc\seek.n # End Source File # Begin Source File SOURCE=..\doc\set.n # End Source File # Begin Source File SOURCE=..\doc\SetErrno.3 # End Source File # Begin Source File SOURCE=..\doc\SetRecLmt.3 # End Source File # Begin Source File SOURCE=..\doc\SetResult.3 # End Source File # Begin Source File SOURCE=..\doc\SetVar.3 # End Source File # Begin Source File SOURCE=..\doc\Signal.3 # End Source File # Begin Source File SOURCE=..\doc\Sleep.3 # End Source File # Begin Source File SOURCE=..\doc\socket.n # End Source File # Begin Source File SOURCE=..\doc\source.n # End Source File # Begin Source File SOURCE=..\doc\SourceRCFile.3 # End Source File # Begin Source File SOURCE=..\doc\split.n # End Source File # Begin Source File SOURCE=..\doc\SplitList.3 # End Source File # Begin Source File SOURCE=..\doc\SplitPath.3 # End Source File # Begin Source File SOURCE=..\doc\StaticPkg.3 # End Source File # Begin Source File SOURCE=..\doc\StdChannels.3 # End Source File # Begin Source File SOURCE=..\doc\string.n # End Source File # Begin Source File SOURCE=..\doc\StringObj.3 # End Source File # Begin Source File SOURCE=..\doc\StrMatch.3 # End Source File # Begin Source File SOURCE=..\doc\subst.n # End Source File # Begin Source File SOURCE=..\doc\SubstObj.3 # End Source File # Begin Source File SOURCE=..\doc\switch.n # End Source File # Begin Source File SOURCE=..\doc\Tcl.n # End Source File # Begin Source File SOURCE=..\doc\Tcl_Main.3 # End Source File # Begin Source File SOURCE=..\doc\TCL_MEM_DEBUG.3 # End Source File # Begin Source File SOURCE=..\doc\tclsh.1 # End Source File # Begin Source File SOURCE=..\doc\tcltest.n # End Source File # Begin Source File SOURCE=..\doc\tclvars.n # End Source File # Begin Source File SOURCE=..\doc\tell.n # End Source File # Begin Source File SOURCE=..\doc\Thread.3 # End Source File # Begin Source File SOURCE=..\doc\time.n # End Source File # Begin Source File SOURCE=..\doc\ToUpper.3 # End Source File # Begin Source File SOURCE=..\doc\trace.n # End Source File # Begin Source File SOURCE=..\doc\TraceVar.3 # End Source File # Begin Source File SOURCE=..\doc\Translate.3 # End Source File # Begin Source File SOURCE=..\doc\UniCharIsAlpha.3 # End Source File # Begin Source File SOURCE=..\doc\unknown.n # End Source File # Begin Source File SOURCE=..\doc\unset.n # End Source File # Begin Source File SOURCE=..\doc\update.n # End Source File # Begin Source File SOURCE=..\doc\uplevel.n # End Source File # Begin Source File SOURCE=..\doc\UpVar.3 # End Source File # Begin Source File SOURCE=..\doc\upvar.n # End Source File # Begin Source File SOURCE=..\doc\Utf.3 # End Source File # Begin Source File SOURCE=..\doc\variable.n # End Source File # Begin Source File SOURCE=..\doc\vwait.n # End Source File # Begin Source File SOURCE=..\doc\while.n # End Source File # Begin Source File SOURCE=..\doc\WrongNumArgs.3 # End Source File # End Group # Begin Group "generic" # PROP Default_Filter "" # Begin Source File SOURCE=..\generic\README # End Source File # Begin Source File SOURCE=..\generic\regc_color.c # End Source File # Begin Source File SOURCE=..\generic\regc_cvec.c # End Source File # Begin Source File SOURCE=..\generic\regc_lex.c # End Source File # Begin Source File SOURCE=..\generic\regc_locale.c # End Source File # Begin Source File SOURCE=..\generic\regc_nfa.c # End Source File # Begin Source File SOURCE=..\generic\regcomp.c # End Source File # Begin Source File SOURCE=..\generic\regcustom.h # End Source File # Begin Source File SOURCE=..\generic\rege_dfa.c # End Source File # Begin Source File SOURCE=..\generic\regerror.c # End Source File # Begin Source File SOURCE=..\generic\regerrs.h # End Source File # Begin Source File SOURCE=..\generic\regex.h # End Source File # Begin Source File SOURCE=..\generic\regexec.c # End Source File # Begin Source File SOURCE=..\generic\regfree.c # End Source File # Begin Source File SOURCE=..\generic\regfronts.c # End Source File # Begin Source File SOURCE=..\generic\regguts.h # End Source File # Begin Source File SOURCE=..\generic\tcl.decls # End Source File # Begin Source File SOURCE=..\generic\tcl.h # End Source File # Begin Source File SOURCE=..\generic\tclAlloc.c # End Source File # Begin Source File SOURCE=..\generic\tclAsync.c # End Source File # Begin Source File SOURCE=..\generic\tclBasic.c # End Source File # Begin Source File SOURCE=..\generic\tclBinary.c # End Source File # Begin Source File SOURCE=..\generic\tclCkalloc.c # End Source File # Begin Source File SOURCE=..\generic\tclClock.c # End Source File # Begin Source File SOURCE=..\generic\tclCmdAH.c # End Source File # Begin Source File SOURCE=..\generic\tclCmdIL.c # End Source File # Begin Source File SOURCE=..\generic\tclCmdMZ.c # End Source File # Begin Source File SOURCE=..\generic\tclCompCmds.c # End Source File # Begin Source File SOURCE=..\generic\tclCompExpr.c # End Source File # Begin Source File SOURCE=..\generic\tclCompile.c # End Source File # Begin Source File SOURCE=..\generic\tclCompile.h # End Source File # Begin Source File SOURCE=..\generic\tclDate.c # End Source File # Begin Source File SOURCE=..\generic\tclDecls.h # End Source File # Begin Source File SOURCE=..\generic\tclEncoding.c # End Source File # Begin Source File SOURCE=..\generic\tclEnv.c # End Source File # Begin Source File SOURCE=..\generic\tclEvent.c # End Source File # Begin Source File SOURCE=..\generic\tclExecute.c # End Source File # Begin Source File SOURCE=..\generic\tclFCmd.c # End Source File # Begin Source File SOURCE=..\generic\tclFileName.c # End Source File # Begin Source File SOURCE=..\generic\tclGet.c # End Source File # Begin Source File SOURCE=..\generic\tclGetDate.y # End Source File # Begin Source File SOURCE=..\generic\tclHash.c # End Source File # Begin Source File SOURCE=..\generic\tclHistory.c # End Source File # Begin Source File SOURCE=..\generic\tclIndexObj.c # End Source File # Begin Source File SOURCE=..\generic\tclInt.decls # End Source File # Begin Source File SOURCE=..\generic\tclInt.h # End Source File # Begin Source File SOURCE=..\generic\tclIntDecls.h # End Source File # Begin Source File SOURCE=..\generic\tclInterp.c # End Source File # Begin Source File SOURCE=..\generic\tclIntPlatDecls.h # End Source File # Begin Source File SOURCE=..\generic\tclIO.c # End Source File # Begin Source File SOURCE=..\generic\tclIO.h # End Source File # Begin Source File SOURCE=..\generic\tclIOCmd.c # End Source File # Begin Source File SOURCE=..\generic\tclIOGT.c # End Source File # Begin Source File SOURCE=..\generic\tclIOSock.c # End Source File # Begin Source File SOURCE=..\generic\tclIOUtil.c # End Source File # Begin Source File SOURCE=..\generic\tclLink.c # End Source File # Begin Source File SOURCE=..\generic\tclListObj.c # End Source File # Begin Source File SOURCE=..\generic\tclLiteral.c # End Source File # Begin Source File SOURCE=..\generic\tclLoad.c # End Source File # Begin Source File SOURCE=..\generic\tclLoadNone.c # End Source File # Begin Source File SOURCE=..\generic\tclMain.c # End Source File # Begin Source File SOURCE=..\generic\tclNamesp.c # End Source File # Begin Source File SOURCE=..\generic\tclNotify.c # End Source File # Begin Source File SOURCE=..\generic\tclObj.c # End Source File # Begin Source File SOURCE=..\generic\tclPanic.c # End Source File # Begin Source File SOURCE=..\generic\tclParse.c # End Source File # Begin Source File SOURCE=..\generic\tclPipe.c # End Source File # Begin Source File SOURCE=..\generic\tclPkg.c # End Source File # Begin Source File SOURCE=..\generic\tclPlatDecls.h # End Source File # Begin Source File SOURCE=..\generic\tclPort.h # End Source File # Begin Source File SOURCE=..\generic\tclPosixStr.c # End Source File # Begin Source File SOURCE=..\generic\tclPreserve.c # End Source File # Begin Source File SOURCE=..\generic\tclProc.c # End Source File # Begin Source File SOURCE=..\generic\tclRegexp.c # End Source File # Begin Source File SOURCE=..\generic\tclRegexp.h # End Source File # Begin Source File SOURCE=..\generic\tclResolve.c # End Source File # Begin Source File SOURCE=..\generic\tclResult.c # End Source File # Begin Source File SOURCE=..\generic\tclScan.c # End Source File # Begin Source File SOURCE=..\generic\tclStringObj.c # End Source File # Begin Source File SOURCE=..\generic\tclStubInit.c # End Source File # Begin Source File SOURCE=..\generic\tclStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclOOStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclTomMathStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclTest.c # End Source File # Begin Source File SOURCE=..\generic\tclTestObj.c # End Source File # Begin Source File SOURCE=..\generic\tclTestProcBodyObj.c # End Source File # Begin Source File SOURCE=..\generic\tclThread.c # End Source File # Begin Source File SOURCE=..\generic\tclThreadJoin.c # End Source File # Begin Source File SOURCE=..\generic\tclThreadTest.c # End Source File # Begin Source File SOURCE=..\generic\tclTimer.c # End Source File # Begin Source File SOURCE=..\generic\tclUniData.c # End Source File # Begin Source File SOURCE=..\generic\tclUtf.c # End Source File # Begin Source File SOURCE=..\generic\tclUtil.c # End Source File # Begin Source File SOURCE=..\generic\tclVar.c # End Source File # End Group # Begin Group "library" # PROP Default_Filter "" # Begin Source File SOURCE=..\library\auto.tcl # End Source File # Begin Source File SOURCE=..\library\history.tcl # End Source File # Begin Source File SOURCE=..\library\init.tcl # End Source File # Begin Source File SOURCE=..\library\ldAout.tcl # End Source File # Begin Source File SOURCE=..\library\package.tcl # End Source File # Begin Source File SOURCE=..\library\parray.tcl # End Source File # Begin Source File SOURCE=..\library\safe.tcl # End Source File # Begin Source File SOURCE=..\library\tclIndex # End Source File # Begin Source File SOURCE=..\library\word.tcl # End Source File # End Group # Begin Group "mac" # PROP Default_Filter "" # End Group # Begin Group "tests" # PROP Default_Filter "" # End Group # Begin Group "tools" # PROP Default_Filter "" # End Group # Begin Group "unix" # PROP Default_Filter "" # End Group # Begin Group "win" # PROP Default_Filter "" # Begin Source File SOURCE=.\aclocal.m4 # End Source File # Begin Source File SOURCE=.\cat.c # End Source File # Begin Source File SOURCE=.\configure # End Source File # Begin Source File SOURCE=.\configure.in # End Source File # Begin Source File SOURCE=.\Makefile.in # End Source File # Begin Source File SOURCE=.\makefile.vc # End Source File # Begin Source File SOURCE=.\mkd.bat # End Source File # Begin Source File SOURCE=.\README # End Source File # Begin Source File SOURCE=.\README.binary # End Source File # Begin Source File SOURCE=.\rmd.bat # End Source File # Begin Source File SOURCE=.\rules.vc # End Source File # Begin Source File SOURCE=.\tcl.hpj.in # End Source File # Begin Source File SOURCE=.\tcl.m4 # End Source File # Begin Source File SOURCE=.\tcl.rc # End Source File # Begin Source File SOURCE=.\tclAppInit.c # End Source File # Begin Source File SOURCE=.\tclConfig.sh.in # End Source File # Begin Source File SOURCE=.\tclsh.ico # End Source File # Begin Source File SOURCE=.\tclsh.rc # End Source File # Begin Source File SOURCE=.\tclWin32Dll.c # End Source File # Begin Source File SOURCE=.\tclWinChan.c # End Source File # Begin Source File SOURCE=.\tclWinConsole.c # End Source File # Begin Source File SOURCE=.\tclWinDde.c # End Source File # Begin Source File SOURCE=.\tclWinError.c # End Source File # Begin Source File SOURCE=.\tclWinFCmd.c # End Source File # Begin Source File SOURCE=.\tclWinFile.c # End Source File # Begin Source File SOURCE=.\tclWinInit.c # End Source File # Begin Source File SOURCE=.\tclWinInt.h # End Source File # Begin Source File SOURCE=.\tclWinLoad.c # End Source File # Begin Source File SOURCE=.\tclWinNotify.c # End Source File # Begin Source File SOURCE=.\tclWinPipe.c # End Source File # Begin Source File SOURCE=.\tclWinPort.h # End Source File # Begin Source File SOURCE=.\tclWinReg.c # End Source File # Begin Source File SOURCE=.\tclWinSerial.c # End Source File # Begin Source File SOURCE=.\tclWinSock.c # End Source File # Begin Source File SOURCE=.\tclWinTest.c # End Source File # Begin Source File SOURCE=.\tclWinThrd.c # End Source File # Begin Source File SOURCE=.\tclWinTime.c # End Source File # End Group # End Target # End Project tcl8.6.14/win/tcl.dsw0000644000175000017500000000102114554262142013732 0ustar sergeisergeiMicrosoft Developer Studio Workspace File, Format Version 6.00 # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE! ############################################################################### Project: "tcl"=.\tcl.dsp - Package Owner=<4> Package=<5> {{{ }}} Package=<4> {{{ }}} ############################################################################### Global: Package=<5> {{{ }}} Package=<3> {{{ }}} ############################################################################### tcl8.6.14/win/README0000644000175000017500000000605714554262142013327 0ustar sergeisergeiTcl 8.6 for Windows 1. Introduction --------------- This is the directory where you configure and compile the Windows version of Tcl. This directory also contains source files for Tcl that are specific to Microsoft Windows. The information in this file is maintained on the web at: https://www.tcl-lang.org/doc/howto/compile.html#win 2. Compiling Tcl ---------------- In order to compile Tcl for Windows, you need the following: Tcl 8.6 Source Distribution (plus any patches) and Visual C++ 6 or newer or Linux + MinGW-w64 [https://www.mingw-w64.org/] (win32 or win64) or Cygwin + MinGW-w64 [https://cygwin.com/install.html] (win32 or win64) or Darwin + MinGW-w64 [https://www.mingw-w64.org/] (win32 or win64) or Msys + MinGW-w64 [https://www.mingw-w64.org/] (win32 or win64) or LLVM MinGW [https://github.com/mstorsjo/llvm-mingw/] (win32 or win64, IX86, AMD64 or ARM64) In practice, this release is built with Visual C++ 6.0 and the TEA Makefile. If you are building with Visual C++, in the "win" subdirectory of the source release, you will find "makefile.vc". This is the makefile for the Visual C++ compiler and uses the stock NMAKE tool. Detailed directions for using it, are in the comments of "makefile.vc". A quick example would be: C:\tcl_source\win\>nmake -f makefile.vc There is also a Developer Studio workspace and project file, too, if you would like to use them. If you are building with Linux, Cygwin or Msys, you can use the configure script that lives in the win subdirectory. The Linux/Cygwin/Msys based configure/build process works just like the UNIX one, so you will want to refer to ../unix/README for available configure options. If you want 64-bit executables (x86_64), you need to configure using the --enable-64bit (or --enable-64bit=arm64) option. Make sure that the x86_64-w64-mingw32 (or aarch64-w64-mingw32) compiler is present. For Cygwin the x86_64 compiler can be found in the "mingw64-x86_64-gcc-core" package, which can be installed through the normal Cygwin install process. If you only want 32-bit executables, the "mingw64-i686-gcc-core" package is what you need. For Linux, Darwin and Msys, you can download a suitable win32 or win64 compiler from [https://sourceforge.net/projects/mingw-w64/files/] Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. Note that in order to run tclsh86.exe, you must ensure that tcl86.dll and zlib1.dll are on your path, in the system directory, or in the directory containing tclsh86.exe. Note: Tcl no longer provides support for Win32s. 3. Test suite ------------- This distribution contains an extensive test suite for Tcl. Some of the tests are timing dependent and will fail from time to time. If a test is failing consistently, please send us a bug report with as much detail as you can manage to our tracker: https://core.tcl-lang.org/tcl/reportlist In order to run the test suite, you build the "test" target using the appropriate makefile for your compiler. tcl8.6.14/win/license.terms0000644000175000017500000000431714554262142015142 0ustar sergeisergeiThis software is copyrighted by the Regents of the University of California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState Corporation and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7014 (b) (3) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license. tcl8.6.14/macosx/0000755000175000017500000000000014566153412013136 5ustar sergeisergeitcl8.6.14/macosx/GNUmakefile0000644000175000017500000001564614554262142015222 0ustar sergeisergei######################################################################################################## # # Makefile wrapper to build tcl on Mac OS X in a way compatible with the tk/macosx Xcode buildsystem # uses the standard Unix build system in tcl/unix (which can be used directly instead of this # if you are not using the tk/macosx projects). # # Copyright (c) 2002-2008 Daniel A. Steffen # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. ######################################################################################################## #------------------------------------------------------------------------------------------------------- # customizable settings DESTDIR ?= INSTALL_ROOT ?= ${DESTDIR} BUILD_DIR ?= ${CURDIR}/../../build SYMROOT ?= ${BUILD_DIR}/${PROJECT} OBJROOT ?= ${SYMROOT} EXTRA_CONFIGURE_ARGS ?= EXTRA_MAKE_ARGS ?= INSTALL_PATH ?= /Library/Frameworks PREFIX ?= /usr/local BINDIR ?= ${PREFIX}/bin LIBDIR ?= ${INSTALL_PATH} MANDIR ?= ${PREFIX}/man # set to non-empty value to install manpages in addition to html help: INSTALL_MANPAGES ?= # Checks and overrides for subframework builds ifeq (${SUBFRAMEWORK},1) ifeq (${DYLIB_INSTALL_DIR},) @echo "Cannot install subframework with empty DYLIB_INSTALL_DIR !" && false endif ifeq (${DESTDIR},) @echo "Cannot install subframework with empty DESTDIR !" && false endif override BUILD_DIR = ${DESTDIR}/build override INSTALL_PATH = /Frameworks endif #------------------------------------------------------------------------------------------------------- # meta targets meta := all install embedded install-embedded clean distclean test styles := develop deploy all := ${styles} all : ${all} install := ${styles:%=install-%} install : ${install} install-%: action := install- embedded := ${styles:%=embedded-%} embedded : embedded-deploy install-embedded := ${embedded:%=install-%} install-embedded : install-embedded-deploy clean := ${styles:%=clean-%} clean : ${clean} clean-%: action := clean- distclean := ${styles:%=distclean-%} distclean : ${distclean} distclean-%: action := distclean- test := ${styles:%=test-%} test : ${test} test-%: action := test- targets := $(foreach v,${meta},${$v}) #------------------------------------------------------------------------------------------------------- # build styles BUILD_STYLE = CONFIGURE_ARGS = OBJ_DIR = ${OBJROOT}/${BUILD_STYLE} empty := space := ${empty} ${empty} objdir = $(subst ${space},\ ,${OBJ_DIR}) develop_make_args := BUILD_STYLE=Development CONFIGURE_ARGS=--enable-symbols deploy_make_args := BUILD_STYLE=Deployment INSTALL_TARGET=install-strip \ EXTRA_CFLAGS=-DNDEBUG embedded_make_args := EMBEDDED_BUILD=1 install_make_args := INSTALL_BUILD=1 ${targets}: ${MAKE} ${action}${PROJECT} \ $(foreach s,${styles} embedded install,$(if $(findstring $s,$@),${${s}_make_args})) #------------------------------------------------------------------------------------------------------- # project specific settings PROJECT := tcl PRODUCT_NAME := Tcl UNIX_DIR := ${CURDIR}/../unix VERSION := $(shell awk -F= '/^TCL_VERSION/ {print $$2; nextfile}' ${UNIX_DIR}/configure.in) TCLSH := tclsh${VERSION} BUILD_TARGET := all tcltest INSTALL_TARGET := install export CPPROG := cp -p INSTALL_TARGETS = install-binaries install-headers install-libraries ifeq (${EMBEDDED_BUILD},) INSTALL_TARGETS += install-private-headers endif ifeq (${INSTALL_BUILD}_${EMBEDDED_BUILD}_${BUILD_STYLE},1__Deployment) INSTALL_TARGETS += install-packages html-tcl ifneq (${INSTALL_MANPAGES},) INSTALL_TARGETS += install-doc endif endif MAKE_VARS := INSTALL_ROOT INSTALL_TARGETS VERSION GENERIC_FLAGS MAKE_ARGS_V = $(foreach v,${MAKE_VARS},$v='${$v}') build-${PROJECT}: target = ${BUILD_TARGET} install-${PROJECT}: target = ${INSTALL_TARGET} clean-${PROJECT} distclean-${PROJECT} test-${PROJECT}: \ target = $* DO_MAKE = +${MAKE} -C "${OBJ_DIR}" ${target} ${MAKE_ARGS_V} ${MAKE_ARGS} ${EXTRA_MAKE_ARGS} #------------------------------------------------------------------------------------------------------- # build rules ${PROJECT}: ${MAKE} install-${PROJECT} INSTALL_ROOT="${OBJ_DIR}/" ${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \ ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \ if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \ --prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \ --mandir="${MANDIR}" --enable-threads --enable-framework --enable-dtrace \ ${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi build-${PROJECT}: ${objdir}/Makefile ${DO_MAKE} ifeq (${INSTALL_BUILD},) # symbolic link hackery to trick # 'make install INSTALL_ROOT=${OBJ_DIR}' # into building Tcl.framework and tclsh in ${SYMROOT} @cd "${OBJ_DIR}" && mkdir -p $(dir $(subst ${space},\ ,.${LIBDIR})) $(dir $(subst ${space},\ ,.${BINDIR})) "${SYMROOT}" && \ rm -f ".${LIBDIR}" ".${BINDIR}" && ln -fs "${SYMROOT}" ".${LIBDIR}" && \ ln -fs "${SYMROOT}" ".${BINDIR}" && ln -fs "${OBJ_DIR}/tcltest" "${SYMROOT}" endif install-${PROJECT}: build-${PROJECT} ifeq (${EMBEDDED_BUILD}_${INSTALL_ROOT},1_) @echo "Cannot install-embedded with empty INSTALL_ROOT !" && false endif ifeq (${EMBEDDED_BUILD},1) @rm -rf "${INSTALL_ROOT}${LIBDIR}/Tcl.framework" endif ${DO_MAKE} ifeq (${INSTALL_BUILD},1) ifeq (${EMBEDDED_BUILD},1) # if we are embedding frameworks, don't install tclsh @rm -f "${INSTALL_ROOT}${BINDIR}/${TCLSH}" && \ rmdir -p "${INSTALL_ROOT}${BINDIR}" 2>&- || true else # install tclsh symbolic link @ln -fs ${TCLSH} "${INSTALL_ROOT}${BINDIR}/tclsh" endif endif ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_) # keep copy of debug library around, so that # Deployment build can be installed on top # of Development build without overwriting # the debug library @if [ -d "${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}" ]; then \ cd "${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}"; \ ln -f "${PRODUCT_NAME}" "${PRODUCT_NAME}_debug"; \ fi endif clean-${PROJECT}: %-${PROJECT}: ${DO_MAKE} rm -rf "${SYMROOT}"/{${PRODUCT_NAME}.framework,${TCLSH},tcltest} rm -f "${OBJ_DIR}"{"${LIBDIR}","${BINDIR}"} && \ rmdir -p "${OBJ_DIR}"$(dir $(subst ${space},\ ,${LIBDIR})) 2>&- || true && \ rmdir -p "${OBJ_DIR}"$(dir $(subst ${space},\ ,${BINDIR})) 2>&- || true distclean-${PROJECT}: %-${PROJECT}: clean-${PROJECT} ${DO_MAKE} rm -rf "${OBJ_DIR}" test-${PROJECT}: %-${PROJECT}: build-${PROJECT} ${DO_MAKE} #------------------------------------------------------------------------------------------------------- .PHONY: ${meta} ${targets} ${PROJECT} build-${PROJECT} install-${PROJECT} \ clean-${PROJECT} distclean-${PROJECT} .NOTPARALLEL: #------------------------------------------------------------------------------------------------------- tcl8.6.14/macosx/README0000644000175000017500000002041614554262142014017 0ustar sergeisergeiTcl Mac OS X README ------------------- This is the README file for the Mac OS X/Darwin version of Tcl. 1. Where to go for support -------------------------- - The tcl-mac mailing list on sourceforge is the best place to ask questions specific to Tcl & Tk on Mac OS X: http://lists.sourceforge.net/lists/listinfo/tcl-mac (this page also has a link to searchable archives of the list, please check them before asking on the list, many questions have already been answered). - For general Tcl/Tk questions, the newsgroup comp.lang.tcl is your best bet: http://groups.google.com/group/comp.lang.tcl/ - The Tcl'ers Wiki also has many pages dealing with Tcl & Tk on Mac OS X, see http://wiki.tcl.tk/_/ref?N=3753 http://wiki.tcl.tk/_/ref?N=8361 - Please report bugs with Tcl on Mac OS X to the tracker: https://core.tcl-lang.org/tcl/reportlist 2. Using Tcl on Mac OS X ------------------------ - At a minimum, Mac OS X 10.3 is required to run Tcl. - Unless weak-linking is used, Tcl built on Mac OS X 10.x will not run on 10.y with y < x; on the other hand Tcl built on 10.y will always run on 10.x with y <= x (but without any of the fixes and optimizations that would be available in a binary built on 10.x). Weak-linking is available on OS X 10.2 or later, it additionally allows Tcl built on 10.x to run on any 10.y with x > y >= z (for a chosen z >= 2). - Tcl extensions can be installed in any of: $HOME/Library/Tcl /Library/Tcl $HOME/Library/Frameworks /Library/Frameworks (searched in that order). Given a potential package directory $pkg, Tcl on OSX checks for the file $pkg/Resources/Scripts/pkgIndex.tcl as well as the usual $pkg/pkgIndex.tcl. This allows building extensions as frameworks with all script files contained in the Resources/Scripts directory of the framework. - [load]able binary extensions can linked as either ordinary shared libraries (.dylib) or as MachO bundles (since 8.4.10/8.5a3); bundles have the advantage that they are [load]ed more efficiently from a tcl VFS (no temporary copy to the native filesystem required), and prior to Mac OS X 10.5, only bundles can be [unload]ed. - The 'deploy' target of macosx/GNUmakefile installs the html manpages into the standard documentation location in the Tcl framework: Tcl.framework/Resources/Documentation/Reference/Tcl No nroff manpages are installed by default by the GNUmakefile. - The Tcl framework can be installed in any of the system's standard framework directories: $HOME/Library/Frameworks /Library/Frameworks 3. Building Tcl on Mac OS X --------------------------- - At least Mac OS X 10.3 is required to build Tcl. Apple's Xcode Developer Tools need to be installed (only the most recent version matching your OS release is supported), the Xcode installer is available on Mac OS X install media or may be present in /Applications/Installers on Macs that came with OS X preinstalled. The most recent version can always be downloaded from the ADC website http://connect.apple.com (free ADC membership required). - Tcl is most easily built as a Mac OS X framework via GNUmakefile in tcl/macosx (see below for details), but can also be built with the standard unix configure and make buildsystem in tcl/unix as on any other unix platform (indeed, the GNUmakefile is just a wrapper around the unix buildsystem). The Mac OS X specific configure flags are --enable-framework and --disable-corefoundation (which disables CF and notably reverts to the standard select based notifier). - It is also possible to build with the Xcode IDE via the projects in tcl/macosx, take care to use the project matching your DevTools and OS version: Tcl.xcode: for Xcode 3.1 on 10.5 Tcl.xcodeproj: for Xcode 3.2 on 10.6 These have the following targets: Tcl: calls through to tcl/macosx/GNUMakefile. tcltest: static build of tcltest for debugging. tests: build tcltest target and run tcl testsuite. The following build configurations are available: Debug: debug build for the active architecture, with Fix & Continue enabled. Debug clang: use clang compiler. Debug llvm-gcc: use llvm-gcc compiler. Debug gcc40: use gcc 4.0 compiler. DebugNoFixAndContinue: disable Fix & Continue. DebugUnthreaded: disable threading. DebugNoCF: disable corefoundation. DebugNoCFUnthreaded: disable corefoundation an threading. DebugMemCompile: enable memory and bytecode debugging. DebugLeaks: define PURIFY. DebugGCov: enable generation of gcov data files. Debug64bit: configure with --enable-64bit (requires building on a 64bit capable processor). Release: release build for the active architecture. ReleaseUniversal: 32/64-bit universal build. ReleaseUniversal clang: use clang compiler. ReleaseUniversal llvm-gcc: use llvm-gcc compiler. ReleaseUniversal gcc40: use gcc 4.0 compiler. ReleaseUniversal10.5SDK: build against the 10.5 SDK (with 10.5 deployment target). Note that the non-SDK configurations have their deployment target set to 10.5 (Tcl.xcode) resp. 10.6 (Tcl.xcodeproj). The Xcode projects refer to the toplevel tcl source directory via the TCL_SRCROOT user build setting, by default this is set to the project-relative path '../../tcl', if your tcl source directory is named differently, e.g. '../../tcl8.6', you need to manually change the TCL_SRCROOT setting by editing your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory) with a text editor. - To build universal binaries outside of the Xcode IDE, set CFLAGS as follows: export CFLAGS="-arch i386 -arch x86_64 -arch ppc" This requires Mac OS X 10.4 and Xcode 2.4 (or Xcode 2.2 if -arch x86_64 is omitted, but _not_ Xcode 2.1) and will work on any architecture (on PowerPC Tiger you need to add "-isysroot /Developer/SDKs/MacOSX10.4u.sdk"). Note that configure requires CFLAGS to contain a least one architecture that can be run on the build machine (i.e. ppc on G3/G4, ppc or ppc64 on G5, ppc or i386 on Core and ppc, i386 or x86_64 on Core2/Xeon). Universal builds of Tcl TEA extensions are also possible with CFLAGS set as above, they will be [load]able by universal as well as thin binaries of Tcl. Detailed Instructions for building with macosx/GNUmakefile ---------------------------------------------------------- - Unpack the Tcl source release archive. - The following instructions assume the Tcl source tree is named "tcl${ver}", (where ${ver} is a shell variable containing the Tcl version number e.g. '8.6'). Setup this shell variable as follows: ver="8.6" - Setup environment variables as desired, e.g. for a universal build on 10.5: CFLAGS="-arch i386 -arch x86_64 -arch ppc -mmacosx-version-min=10.5" export CFLAGS - Change to the directory containing the Tcl source tree and build: make -C tcl${ver}/macosx - Install Tcl onto the root volume (admin password required): sudo make -C tcl${ver}/macosx install if you don't have an admin password, you can install into your home directory instead by passing an INSTALL_ROOT argument to make: make -C tcl${ver}/macosx install INSTALL_ROOT="${HOME}/" - The default GNUmakefile targets will build _both_ debug and optimized versions of the Tcl framework with the standard convention of naming the debug library Tcl.framework/Tcl_debug. This allows switching to the debug libraries at runtime by setting export DYLD_IMAGE_SUFFIX=_debug (c.f. man dyld for more details) If you only want to build and install the debug or optimized build, use the 'develop' or 'deploy' target variants of the GNUmakefile, respectively. For example, to build and install only the optimized versions: make -C tcl${ver}/macosx deploy sudo make -C tcl${ver}/macosx install-deploy - To build a Tcl.framework for use as a subframework in another framework, use the install-embedded target and set SUBFRAMEWORK=1. Set the DYLIB_INSTALL_DIR variable to the path which should be the install_name path of the Tcl library, set the DESTDIR variable to the pathname of a staging directory where the framework will be written . For example, running this command in the Tcl source directory: make -C macosx install-embedded SUBFRAMEWORK=1 DESTDIR=/tmp/tcl \ DYLIB_INSTALL_DIR=/Library/Frameworks/Some.framework/Versions/X.Y/Frameworks/Tcl.framework will produce a Tcl.framework intended for installing as a subframework of Some.framework. The framework will be found in /tmp/tcl/Frameworks/ tcl8.6.14/macosx/tclMacOSXBundle.c0000644000175000017500000001734114554262142016235 0ustar sergeisergei/* * tclMacOSXBundle.c -- * * This file implements functions that inspect CFBundle structures on * MacOS X. * * Copyright 2001-2009, Apple Inc. * Copyright (c) 2003-2009 Daniel A. Steffen * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclPort.h" #ifdef HAVE_COREFOUNDATION #include #ifndef TCL_DYLD_USE_DLFCN /* * Use preferred dlfcn API on 10.4 and later */ # if !defined(NO_DLFCN_H) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1040 # define TCL_DYLD_USE_DLFCN 1 # else # define TCL_DYLD_USE_DLFCN 0 # endif #endif /* TCL_DYLD_USE_DLFCN */ #ifndef TCL_DYLD_USE_NSMODULE /* * Use deprecated NSModule API only to support 10.3 and earlier: */ # if MAC_OS_X_VERSION_MIN_REQUIRED < 1040 # define TCL_DYLD_USE_NSMODULE 1 # else # define TCL_DYLD_USE_NSMODULE 0 # endif #endif /* TCL_DYLD_USE_NSMODULE */ #if TCL_DYLD_USE_DLFCN #include #if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040 /* * Support for weakly importing dlfcn API. */ extern void * dlsym(void *handle, const char *symbol) WEAK_IMPORT_ATTRIBUTE; extern char * dlerror(void) WEAK_IMPORT_ATTRIBUTE; #endif #endif /* TCL_DYLD_USE_DLFCN */ #if TCL_DYLD_USE_NSMODULE #include #endif #if (TCL_DYLD_USE_DLFCN && MAC_OS_X_VERSION_MIN_REQUIRED < 1040) || \ (MAC_OS_X_VERSION_MIN_REQUIRED < 1050) MODULE_SCOPE long tclMacOSXDarwinRelease; #endif #ifdef TCL_DEBUG_LOAD #define TclLoadDbgMsg(m, ...) \ do { \ fprintf(stderr, "%s:%d: %s(): " m ".\n", \ strrchr(__FILE__, '/')+1, __LINE__, __func__, \ ##__VA_ARGS__); \ } while (0) #else #define TclLoadDbgMsg(m, ...) #endif /* TCL_DEBUG_LOAD */ /* * Forward declaration of functions defined in this file: */ static short OpenResourceMap(CFBundleRef bundleRef); #endif /* HAVE_COREFOUNDATION */ /* *---------------------------------------------------------------------- * * OpenResourceMap -- * * Wrapper that dynamically acquires the address for the function * CFBundleOpenBundleResourceMap before calling it, since it is only * present in full CoreFoundation on Mac OS X and not in CFLite on pure * Darwin. Factored out because it is moderately ugly code. * *---------------------------------------------------------------------- */ #ifdef HAVE_COREFOUNDATION static short OpenResourceMap( CFBundleRef bundleRef) { static int initialized = FALSE; static short (*openresourcemap)(CFBundleRef) = NULL; if (!initialized) { #if TCL_DYLD_USE_DLFCN #if MAC_OS_X_VERSION_MIN_REQUIRED < 1040 if (tclMacOSXDarwinRelease >= 8) #endif { openresourcemap = (short (*)(CFBundleRef))dlsym(RTLD_NEXT, "CFBundleOpenBundleResourceMap"); #ifdef TCL_DEBUG_LOAD if (!openresourcemap) { const char *errMsg = dlerror(); TclLoadDbgMsg("dlsym() failed: %s", errMsg); } #endif /* TCL_DEBUG_LOAD */ } if (!openresourcemap) #endif /* TCL_DYLD_USE_DLFCN */ { #if TCL_DYLD_USE_NSMODULE if (NSIsSymbolNameDefinedWithHint( "_CFBundleOpenBundleResourceMap", "CoreFoundation")) { NSSymbol nsSymbol = NSLookupAndBindSymbolWithHint( "_CFBundleOpenBundleResourceMap", "CoreFoundation"); if (nsSymbol) { openresourcemap = NSAddressOfSymbol(nsSymbol); } } #endif /* TCL_DYLD_USE_NSMODULE */ } initialized = TRUE; } if (openresourcemap) { return openresourcemap(bundleRef); } return -1; } #endif /* HAVE_COREFOUNDATION */ /* *---------------------------------------------------------------------- * * Tcl_MacOSXOpenBundleResources -- * * Given the bundle name for a shared library, this routine sets * libraryPath to the Resources/Scripts directory in the framework * package. If hasResourceFile is true, it will also open the main * resource file for the bundle. * * Results: * TCL_OK if the bundle could be opened, and the Scripts folder found. * TCL_ERROR otherwise. * * Side effects: * libraryVariableName may be set, and the resource file opened. * *---------------------------------------------------------------------- */ #undef Tcl_MacOSXOpenBundleResources int Tcl_MacOSXOpenBundleResources( Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath) { return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName, NULL, hasResourceFile, maxPathLen, libraryPath); } /* *---------------------------------------------------------------------- * * Tcl_MacOSXOpenVersionedBundleResources -- * * Given the bundle and version name for a shared library (version name * can be NULL to indicate latest version), this routine sets libraryPath * to the Resources/Scripts directory in the framework package. If * hasResourceFile is true, it will also open the main resource file for * the bundle. * * Results: * TCL_OK if the bundle could be opened, and the Scripts folder found. * TCL_ERROR otherwise. * * Side effects: * libraryVariableName may be set, and the resource file opened. * *---------------------------------------------------------------------- */ int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath) { #ifdef HAVE_COREFOUNDATION CFBundleRef bundleRef, versionedBundleRef = NULL; CFStringRef bundleNameRef; CFURLRef libURL; libraryPath[0] = '\0'; bundleNameRef = CFStringCreateWithCString(NULL, bundleName, kCFStringEncodingUTF8); bundleRef = CFBundleGetBundleWithIdentifier(bundleNameRef); CFRelease(bundleNameRef); if (bundleVersion && bundleRef) { /* * Create bundle from bundleVersion subdirectory of 'Versions'. */ CFURLRef bundleURL = CFBundleCopyBundleURL(bundleRef); if (bundleURL) { CFStringRef bundleVersionRef = CFStringCreateWithCString(NULL, bundleVersion, kCFStringEncodingUTF8); if (bundleVersionRef) { CFComparisonResult versionComparison = kCFCompareLessThan; CFStringRef bundleTailRef = CFURLCopyLastPathComponent( bundleURL); if (bundleTailRef) { versionComparison = CFStringCompare(bundleTailRef, bundleVersionRef, 0); CFRelease(bundleTailRef); } if (versionComparison != kCFCompareEqualTo) { CFURLRef versURL = CFURLCreateCopyAppendingPathComponent( NULL, bundleURL, CFSTR("Versions"), TRUE); if (versURL) { CFURLRef versionedBundleURL = CFURLCreateCopyAppendingPathComponent( NULL, versURL, bundleVersionRef, TRUE); if (versionedBundleURL) { versionedBundleRef = CFBundleCreate(NULL, versionedBundleURL); if (versionedBundleRef) { bundleRef = versionedBundleRef; } CFRelease(versionedBundleURL); } CFRelease(versURL); } } CFRelease(bundleVersionRef); } CFRelease(bundleURL); } } if (bundleRef) { if (hasResourceFile) { (void) OpenResourceMap(bundleRef); } libURL = CFBundleCopyResourceURL(bundleRef, CFSTR("Scripts"), NULL, NULL); if (libURL) { /* * FIXME: This is a quick fix, it is probably not right for * internationalization. */ CFURLGetFileSystemRepresentation(libURL, TRUE, (unsigned char *) libraryPath, maxPathLen); CFRelease(libURL); } if (versionedBundleRef) { #if MAC_OS_X_VERSION_MIN_REQUIRED < 1050 /* * Workaround CFBundle bug in Tiger and earlier. [Bug 2569449] */ if (tclMacOSXDarwinRelease >= 9) #endif { CFRelease(versionedBundleRef); } } } if (libraryPath[0]) { return TCL_OK; } #endif /* HAVE_COREFOUNDATION */ return TCL_ERROR; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/macosx/tclMacOSXFCmd.c0000644000175000017500000004532114554262142015634 0ustar sergeisergei/* * tclMacOSXFCmd.c * * This file implements the MacOSX specific portion of file manipulation * subcommands of the "file" command. * * Copyright (c) 2003-2007 Daniel A. Steffen * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef HAVE_GETATTRLIST #include #include #include #endif /* Darwin 8 copyfile API. */ #ifdef HAVE_COPYFILE #ifdef HAVE_COPYFILE_H #include #if defined(HAVE_WEAK_IMPORT) && (MAC_OS_X_VERSION_MIN_REQUIRED < 1040) /* Support for weakly importing copyfile. */ #define WEAK_IMPORT_COPYFILE extern int copyfile(const char *from, const char *to, copyfile_state_t state, copyfile_flags_t flags) WEAK_IMPORT_ATTRIBUTE; #endif /* HAVE_WEAK_IMPORT */ #else /* HAVE_COPYFILE_H */ int copyfile(const char *from, const char *to, void *state, uint32_t flags); #define COPYFILE_ACL (1<<0) #define COPYFILE_XATTR (1<<2) #define COPYFILE_NOFOLLOW_SRC (1<<18) #if defined(HAVE_WEAK_IMPORT) && (MAC_OS_X_VERSION_MIN_REQUIRED < 1040) /* Support for weakly importing copyfile. */ #define WEAK_IMPORT_COPYFILE extern int copyfile(const char *from, const char *to, void *state, uint32_t flags) WEAK_IMPORT_ATTRIBUTE; #endif /* HAVE_WEAK_IMPORT */ #endif /* HAVE_COPYFILE_H */ #endif /* HAVE_COPYFILE */ #ifdef WEAK_IMPORT_COPYFILE #define MayUseCopyFile() (copyfile != NULL) #elif defined(HAVE_COPYFILE) #define MayUseCopyFile() (1) #else #define MayUseCopyFile() (0) #endif #include /* * Constants for file attributes subcommand. Need to be kept in sync with * tclUnixFCmd.c ! */ enum { UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE, #ifdef HAVE_CHFLAGS UNIX_READONLY_ATTRIBUTE, #endif #ifdef MAC_OSX_TCL MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE, MACOSX_RSRCLENGTH_ATTRIBUTE, #endif }; typedef u_int32_t OSType; static int GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, OSType *osTypePtr); static Tcl_Obj * NewOSTypeObj(const OSType newOSType); static int SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfOSType(Tcl_Obj *objPtr); static const Tcl_ObjType tclOSTypeType = { "osType", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfOSType, /* updateStringProc */ SetOSTypeFromAny /* setFromAnyProc */ }; enum { kIsInvisible = 0x4000, }; #define kFinfoIsInvisible (OSSwapHostToBigConstInt16(kIsInvisible)) typedef struct finderinfo { u_int32_t type; u_int32_t creator; u_int16_t fdFlags; u_int32_t location; u_int16_t reserved; u_int32_t extendedFileInfo[4]; } __attribute__ ((__packed__)) finderinfo; typedef struct { u_int32_t info_length; u_int32_t data[8]; } fileinfobuf; /* *---------------------------------------------------------------------- * * TclMacOSXGetFileAttribute * * Gets a MacOSX attribute of a file. Which attribute is controlled by * objIndex. The object will have ref count 0. * * Results: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there * is no error. * * Side effects: * A new object is allocated. * *---------------------------------------------------------------------- */ int TclMacOSXGetFileAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { #ifdef HAVE_GETATTRLIST int result; Tcl_StatBuf statBuf; struct attrlist alist; fileinfobuf finfo; finderinfo *finder = (finderinfo *) &finfo.data; off_t *rsrcForkSize = (off_t *) &finfo.data; const char *native; result = TclpObjStat(fileName, &statBuf); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); return TCL_ERROR; } if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) { /* * Directories only support attribute "-hidden". */ errno = EISDIR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid attribute: %s", Tcl_PosixError(interp))); return TCL_ERROR; } bzero(&alist, sizeof(struct attrlist)); alist.bitmapcount = ATTR_BIT_MAP_COUNT; if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) { alist.fileattr = ATTR_FILE_RSRCLENGTH; } else { alist.commonattr = ATTR_CMN_FNDRINFO; } native = (const char *)Tcl_FSGetNativePath(fileName); result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read attributes of \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); return TCL_ERROR; } switch (objIndex) { case MACOSX_CREATOR_ATTRIBUTE: *attributePtrPtr = NewOSTypeObj( OSSwapBigToHostInt32(finder->creator)); break; case MACOSX_TYPE_ATTRIBUTE: *attributePtrPtr = NewOSTypeObj( OSSwapBigToHostInt32(finder->type)); break; case MACOSX_HIDDEN_ATTRIBUTE: *attributePtrPtr = Tcl_NewBooleanObj( (finder->fdFlags & kFinfoIsInvisible) != 0); break; case MACOSX_RSRCLENGTH_ATTRIBUTE: *attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize); break; } return TCL_OK; #else Tcl_SetObjResult(interp, Tcl_NewStringObj( "Mac OS X file attributes not supported", -1)); Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); return TCL_ERROR; #endif /* HAVE_GETATTRLIST */ } /* *--------------------------------------------------------------------------- * * TclMacOSXSetFileAttribute -- * * Sets a MacOSX attribute of a file. Which attribute is controlled by * objIndex. * * Results: * Standard TCL result. * * Side effects: * As above. * *--------------------------------------------------------------------------- */ int TclMacOSXSetFileAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New owner for file. */ { #ifdef HAVE_GETATTRLIST int result; Tcl_StatBuf statBuf; struct attrlist alist; fileinfobuf finfo; finderinfo *finder = (finderinfo *) &finfo.data; off_t *rsrcForkSize = (off_t *) &finfo.data; const char *native; result = TclpObjStat(fileName, &statBuf); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); return TCL_ERROR; } if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) { /* * Directories only support attribute "-hidden". */ errno = EISDIR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid attribute: %s", Tcl_PosixError(interp))); return TCL_ERROR; } bzero(&alist, sizeof(struct attrlist)); alist.bitmapcount = ATTR_BIT_MAP_COUNT; if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) { alist.fileattr = ATTR_FILE_RSRCLENGTH; } else { alist.commonattr = ATTR_CMN_FNDRINFO; } native = (const char *)Tcl_FSGetNativePath(fileName); result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read attributes of \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); return TCL_ERROR; } if (objIndex != MACOSX_RSRCLENGTH_ATTRIBUTE) { OSType t; int h; switch (objIndex) { case MACOSX_CREATOR_ATTRIBUTE: if (GetOSTypeFromObj(interp, attributePtr, &t) != TCL_OK) { return TCL_ERROR; } finder->creator = OSSwapHostToBigInt32(t); break; case MACOSX_TYPE_ATTRIBUTE: if (GetOSTypeFromObj(interp, attributePtr, &t) != TCL_OK) { return TCL_ERROR; } finder->type = OSSwapHostToBigInt32(t); break; case MACOSX_HIDDEN_ATTRIBUTE: if (Tcl_GetBooleanFromObj(interp, attributePtr, &h) != TCL_OK) { return TCL_ERROR; } if (h) { finder->fdFlags |= kFinfoIsInvisible; } else { finder->fdFlags &= ~kFinfoIsInvisible; } break; } result = setattrlist(native, &alist, &finfo.data, sizeof(finfo.data), 0); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set attributes of \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); return TCL_ERROR; } } else { Tcl_WideInt newRsrcForkSize; if (TclGetWideIntFromObj(interp, attributePtr, &newRsrcForkSize) != TCL_OK) { return TCL_ERROR; } if (newRsrcForkSize != *rsrcForkSize) { Tcl_DString ds; /* * Only setting rsrclength to 0 to strip a file's resource fork is * supported. */ if (newRsrcForkSize != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "setting nonzero rsrclength not supported", -1)); Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); return TCL_ERROR; } /* * Construct path to resource fork. */ Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, native, -1); Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1); result = truncate(Tcl_DStringValue(&ds), 0); if (result != 0) { /* * truncate() on a valid resource fork path may fail with a * permission error in some OS releases, try truncating with * open() instead: */ int fd = open(Tcl_DStringValue(&ds), O_WRONLY | O_TRUNC); if (fd > 0) { result = close(fd); } } Tcl_DStringFree(&ds); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not truncate resource fork of \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); return TCL_ERROR; } } } return TCL_OK; #else Tcl_SetObjResult(interp, Tcl_NewStringObj( "Mac OS X file attributes not supported", -1)); Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); return TCL_ERROR; #endif } /* *--------------------------------------------------------------------------- * * TclMacOSXCopyFileAttributes -- * * Copy the MacOSX attributes and resource fork (if present) from one * file to another. * * Results: * Standard Tcl result. * * Side effects: * MacOSX attributes and resource fork are updated in the new file to * reflect the old file. * *--------------------------------------------------------------------------- */ int TclMacOSXCopyFileAttributes( const char *src, /* Path name of source file (native). */ const char *dst, /* Path name of target file (native). */ const Tcl_StatBuf *statBufPtr) /* Stat info for source file */ { if (MayUseCopyFile()) { #ifdef HAVE_COPYFILE if (0 == copyfile(src, dst, NULL, (S_ISLNK(statBufPtr->st_mode) ? COPYFILE_XATTR | COPYFILE_NOFOLLOW_SRC : COPYFILE_XATTR | COPYFILE_ACL))) { return TCL_OK; } #endif /* HAVE_COPYFILE */ } else { #if (!defined(HAVE_COPYFILE) || defined(WEAK_IMPORT_COPYFILE)) && defined(HAVE_GETATTRLIST) struct attrlist alist; fileinfobuf finfo; off_t *rsrcForkSize = (off_t *) &finfo.data; Tcl_DString srcBuf, dstBuf; int result; bzero(&alist, sizeof(struct attrlist)); alist.bitmapcount = ATTR_BIT_MAP_COUNT; alist.commonattr = ATTR_CMN_FNDRINFO; if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) { return TCL_ERROR; } if (setattrlist(dst, &alist, &finfo.data, sizeof(finfo.data), 0)) { return TCL_ERROR; } /* * If we're a directory, we're done as they never have resource forks. */ if (S_ISDIR(statBufPtr->st_mode)) { return TCL_OK; } /* * We only copy a non-empty resource fork, so determine if that's the * case first. */ alist.commonattr = 0; alist.fileattr = ATTR_FILE_RSRCLENGTH; if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) { return TCL_ERROR; } else if (*rsrcForkSize == 0) { return TCL_OK; } /* * Construct paths to resource forks. */ Tcl_DStringInit(&srcBuf); Tcl_DStringAppend(&srcBuf, src, -1); Tcl_DStringAppend(&srcBuf, _PATH_RSRCFORKSPEC, -1); Tcl_DStringInit(&dstBuf); Tcl_DStringAppend(&dstBuf, dst, -1); Tcl_DStringAppend(&dstBuf, _PATH_RSRCFORKSPEC, -1); /* * Do the copy. */ result = TclUnixCopyFile(Tcl_DStringValue(&srcBuf), Tcl_DStringValue(&dstBuf), statBufPtr, 1); Tcl_DStringFree(&srcBuf); Tcl_DStringFree(&dstBuf); if (result == 0) { return TCL_OK; } #endif /* (!HAVE_COPYFILE || WEAK_IMPORT_COPYFILE) && HAVE_GETATTRLIST */ } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclMacOSXMatchType -- * * This routine is used by the globbing code to check if a file matches a * given mac type and/or creator code. * * Results: * The return value is 1, 0 or -1 indicating whether the file matches the * given criteria, does not match them, or an error occurred (in which * case an error is left in interp). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclMacOSXMatchType( Tcl_Interp *interp, /* Interpreter to receive errors. */ const char *pathName, /* Native path to check. */ const char *fileName, /* Native filename to check. */ Tcl_StatBuf *statBufPtr, /* Stat info for file to check */ Tcl_GlobTypeData *types) /* Type description to match against. */ { #ifdef HAVE_GETATTRLIST struct attrlist alist; fileinfobuf finfo; finderinfo *finder = (finderinfo *) &finfo.data; OSType osType; bzero(&alist, sizeof(struct attrlist)); alist.bitmapcount = ATTR_BIT_MAP_COUNT; alist.commonattr = ATTR_CMN_FNDRINFO; if (getattrlist(pathName, &alist, &finfo, sizeof(fileinfobuf), 0) != 0) { return 0; } if ((types->perm & TCL_GLOB_PERM_HIDDEN) && !((finder->fdFlags & kFinfoIsInvisible) || (*fileName == '.'))) { return 0; } if (S_ISDIR(statBufPtr->st_mode) && (types->macType || types->macCreator)) { /* * Directories don't support types or creators. */ return 0; } if (types->macType) { if (GetOSTypeFromObj(interp, types->macType, &osType) != TCL_OK) { return -1; } if (osType != OSSwapBigToHostInt32(finder->type)) { return 0; } } if (types->macCreator) { if (GetOSTypeFromObj(interp, types->macCreator, &osType) != TCL_OK) { return -1; } if (osType != OSSwapBigToHostInt32(finder->creator)) { return 0; } } #endif return 1; } /* *---------------------------------------------------------------------- * * GetOSTypeFromObj -- * * Attempt to return an OSType from the Tcl object "objPtr". * * Results: * Standard TCL result. If an error occurs during conversion, an error * message is left in interp->objResult. * * Side effects: * The string representation of objPtr will be updated if necessary. * *---------------------------------------------------------------------- */ static int GetOSTypeFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get an OSType. */ OSType *osTypePtr) /* Place to store resulting OSType. */ { int result = TCL_OK; if (objPtr->typePtr != &tclOSTypeType) { result = SetOSTypeFromAny(interp, objPtr); } *osTypePtr = (OSType) objPtr->internalRep.longValue; return result; } /* *---------------------------------------------------------------------- * * NewOSTypeObj -- * * Create a new OSType object. * * Results: * The newly created OSType object is returned, it has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Obj * NewOSTypeObj( const OSType osType) /* OSType used to initialize the new * object. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); TclInvalidateStringRep(objPtr); objPtr->internalRep.longValue = (long) osType; objPtr->typePtr = &tclOSTypeType; return objPtr; } /* *---------------------------------------------------------------------- * * SetOSTypeFromAny -- * * Attempts to force the internal representation for a Tcl object to * tclOSTypeType, specifically. * * Results: * The return value is a standard object Tcl result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * *---------------------------------------------------------------------- */ static int SetOSTypeFromAny( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Pointer to the object to convert */ { const char *string; int length, result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); string = Tcl_GetStringFromObj(objPtr, &length); Tcl_UtfToExternalDString(encoding, string, length, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected Macintosh OS type but got \"%s\": ", string)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL); } result = TCL_ERROR; } else { OSType osType; char bytes[4] = {'\0','\0','\0','\0'}; memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); osType = (OSType) bytes[0] << 24 | (OSType) bytes[1] << 16 | (OSType) bytes[2] << 8 | (OSType) bytes[3]; TclFreeIntRep(objPtr); objPtr->internalRep.longValue = (long) osType; objPtr->typePtr = &tclOSTypeType; } Tcl_DStringFree(&ds); Tcl_FreeEncoding(encoding); return result; } /* *---------------------------------------------------------------------- * * UpdateStringOfOSType -- * * Update the string representation for an OSType object. Note: This * function does not free an existing old string rep so storage will be * lost if this has not already been done. * * Results: * None. * * Side effects: * The object's string is set to a valid string that results from the * OSType-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfOSType( Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { char string[5]; OSType osType = (OSType) objPtr->internalRep.longValue; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); unsigned len; string[0] = (char) (osType >> 24); string[1] = (char) (osType >> 16); string[2] = (char) (osType >> 8); string[3] = (char) (osType); string[4] = '\0'; Tcl_ExternalToUtfDString(encoding, string, -1, &ds); len = (unsigned) Tcl_DStringLength(&ds) + 1; objPtr->bytes = ckalloc(len); memcpy(objPtr->bytes, Tcl_DStringValue(&ds), len); objPtr->length = Tcl_DStringLength(&ds); Tcl_DStringFree(&ds); Tcl_FreeEncoding(encoding); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/macosx/tclMacOSXNotify.c0000644000175000017500000015573714554262142016310 0ustar sergeisergei/* * tclMacOSXNotify.c -- * * This file contains the implementation of a merged CFRunLoop/select() * based notifier, which is the lowest-level part of the Tcl event loop. * This file works together with generic/tclNotify.c. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright 2001-2009, Apple Inc. * Copyright (c) 2005-2009 Daniel A. Steffen * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * In macOS 10.12 the os_unfair_lock was introduced as a replacement for the * OSSpinLock, and the OSSpinLock was deprecated. */ #if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200 #define USE_OS_UNFAIR_LOCK #include #undef TCL_MAC_DEBUG_NOTIFIER #endif #ifdef HAVE_COREFOUNDATION /* Traditional unix select-based notifier is * in tclUnixNotfy.c */ #include #include /* #define TCL_MAC_DEBUG_NOTIFIER 1 */ #if !defined(USE_OS_UNFAIR_LOCK) /* * We use the Darwin-native spinlock API rather than pthread mutexes for * notifier locking: this radically simplifies the implementation and lowers * overhead. Note that these are not pure spinlocks, they employ various * strategies to back off and relinquish the processor, making them immune to * most priority-inversion livelocks (c.f. 'man 3 OSSpinLockLock' and Darwin * sources: xnu/osfmk/{ppc,i386}/commpage/spinlocks.s). */ #if defined(HAVE_LIBKERN_OSATOMIC_H) && defined(HAVE_OSSPINLOCKLOCK) #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wdeprecated-declarations" #pragma GCC diagnostic ignored "-Wunused-function" /* * Use OSSpinLock API where available (Tiger or later). */ #include #if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040 /* * Support for weakly importing spinlock API. */ #define WEAK_IMPORT_SPINLOCKLOCK #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 #define VOLATILE volatile #else #define VOLATILE #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 */ #ifndef bool #define bool int #endif extern void OSSpinLockLock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern void OSSpinLockUnlock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern bool OSSpinLockTry(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern void _spin_lock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern void _spin_unlock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern bool _spin_lock_try(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; static void (* lockLock)(VOLATILE OSSpinLock *lock) = NULL; static void (* lockUnlock)(VOLATILE OSSpinLock *lock) = NULL; static bool (* lockTry)(VOLATILE OSSpinLock *lock) = NULL; #undef VOLATILE static pthread_once_t spinLockLockInitControl = PTHREAD_ONCE_INIT; static void SpinLockLockInit(void) { lockLock = OSSpinLockLock != NULL ? OSSpinLockLock : _spin_lock; lockUnlock = OSSpinLockUnlock != NULL ? OSSpinLockUnlock : _spin_unlock; lockTry = OSSpinLockTry != NULL ? OSSpinLockTry : _spin_lock_try; if (lockLock == NULL || lockUnlock == NULL) { Tcl_Panic("SpinLockLockInit: no spinlock API available"); } } #define SpinLockLock(p) lockLock(p) #define SpinLockUnlock(p) lockUnlock(p) #define SpinLockTry(p) lockTry(p) #else #define SpinLockLock(p) OSSpinLockLock(p) #define SpinLockUnlock(p) OSSpinLockUnlock(p) #define SpinLockTry(p) OSSpinLockTry(p) #endif /* HAVE_WEAK_IMPORT */ #define SPINLOCK_INIT OS_SPINLOCK_INIT #else /* * Otherwise, use commpage spinlock SPI directly. */ typedef uint32_t OSSpinLock; extern void _spin_lock(OSSpinLock *lock); extern void _spin_unlock(OSSpinLock *lock); extern int _spin_lock_try(OSSpinLock *lock); #define SpinLockLock(p) _spin_lock(p) #define SpinLockUnlock(p) _spin_unlock(p) #define SpinLockTry(p) _spin_lock_try(p) #define SPINLOCK_INIT 0 #pragma GCC diagnostic pop #endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */ #endif /* not using os_unfair_lock */ /* * These locks control access to the global notifier state. */ #if defined(USE_OS_UNFAIR_LOCK) static os_unfair_lock notifierInitLock = OS_UNFAIR_LOCK_INIT; static os_unfair_lock notifierLock = OS_UNFAIR_LOCK_INIT; #else static OSSpinLock notifierInitLock = SPINLOCK_INIT; static OSSpinLock notifierLock = SPINLOCK_INIT; #endif /* * Macros that abstract notifier locking/unlocking */ #if defined(USE_OS_UNFAIR_LOCK) #define LOCK_NOTIFIER_INIT os_unfair_lock_lock(¬ifierInitLock) #define UNLOCK_NOTIFIER_INIT os_unfair_lock_unlock(¬ifierInitLock) #define LOCK_NOTIFIER os_unfair_lock_lock(¬ifierLock) #define UNLOCK_NOTIFIER os_unfair_lock_unlock(¬ifierLock) #define LOCK_NOTIFIER_TSD os_unfair_lock_lock(&tsdPtr->tsdLock) #define UNLOCK_NOTIFIER_TSD os_unfair_lock_unlock(&tsdPtr->tsdLock) #else #define LOCK_NOTIFIER_INIT SpinLockLock(¬ifierInitLock) #define UNLOCK_NOTIFIER_INIT SpinLockUnlock(¬ifierInitLock) #define LOCK_NOTIFIER SpinLockLock(¬ifierLock) #define UNLOCK_NOTIFIER SpinLockUnlock(¬ifierLock) #define LOCK_NOTIFIER_TSD SpinLockLock(&tsdPtr->tsdLock) #define UNLOCK_NOTIFIER_TSD SpinLockUnlock(&tsdPtr->tsdLock) #endif /* * The debug version of the Notifier only works if using OSSpinLock. */ #if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK) #define TclMacOSXNotifierDbgMsg(m, ...) \ do { \ fprintf(notifierLog?notifierLog:stderr, "tclMacOSXNotify.c:%d: " \ "%s() pid %5d thread %10p: " m "\n", __LINE__, __func__, \ getpid(), pthread_self(), ##__VA_ARGS__); \ fflush(notifierLog?notifierLog:stderr); \ } while (0) /* * Debug version of SpinLockLock that logs the time spent waiting for the lock */ #define SpinLockLockDbg(p) \ if (!SpinLockTry(p)) { \ Tcl_WideInt s = TclpGetWideClicks(), e; \ \ SpinLockLock(p); \ e = TclpGetWideClicks(); \ TclMacOSXNotifierDbgMsg("waited on %s for %8.0f ns", \ #p, TclpWideClicksToNanoseconds(e-s)); \ } #undef LOCK_NOTIFIER_INIT #define LOCK_NOTIFIER_INIT SpinLockLockDbg(¬ifierInitLock) #undef LOCK_NOTIFIER #define LOCK_NOTIFIER SpinLockLockDbg(¬ifierLock) #undef LOCK_NOTIFIER_TSD #define LOCK_NOTIFIER_TSD SpinLockLockDbg(tsdPtr->tsdLock) #include static FILE *notifierLog = NULL; #ifndef NOTIFIER_LOG #define NOTIFIER_LOG "/tmp/tclMacOSXNotify.log" #endif #define OPEN_NOTIFIER_LOG \ if (!notifierLog) { \ notifierLog = fopen(NOTIFIER_LOG, "a"); \ /*TclMacOSXNotifierDbgMsg("open log"); \ *asl_set_filter(NULL, \ * ASL_FILTER_MASK_UPTO(ASL_LEVEL_DEBUG)); \ *asl_add_log_file(NULL, fileno(notifierLog));*/ \ } #define CLOSE_NOTIFIER_LOG \ if (notifierLog) { \ /*asl_remove_log_file(NULL, fileno(notifierLog)); \ *TclMacOSXNotifierDbgMsg("close log");*/ \ fclose(notifierLog); \ notifierLog = NULL; \ } #define ENABLE_ASL \ if (notifierLog) { \ /*tsdPtr->asl = asl_open(NULL, "com.apple.console", \ * ASL_OPT_NO_REMOTE); \ *asl_set_filter(tsdPtr->asl, \ * ASL_FILTER_MASK_UPTO(ASL_LEVEL_DEBUG)); \ *asl_add_log_file(tsdPtr->asl, fileno(notifierLog));*/ \ } #define DISABLE_ASL \ /*if (tsdPtr->asl) { \ * if (notifierLog) { \ * asl_remove_log_file(tsdPtr->asl, fileno(notifierLog)); \ * } \ * asl_close(tsdPtr->asl); \ *}*/ #define ASLCLIENT_DECL /*aslclient asl*/ #else #define TclMacOSXNotifierDbgMsg(m, ...) #define OPEN_NOTIFIER_LOG #define CLOSE_NOTIFIER_LOG #define ENABLE_ASL #define DISABLE_ASL #define ASLCLIENT_DECL #endif /* TCL_MAC_DEBUG_NOTIFIER */ /* * This structure is used to keep track of the notifier info for a registered * file. */ typedef struct FileHandler { int fd; int mask; /* Mask of desired events: TCL_READABLE, * etc. */ int readyMask; /* Mask of events that have been seen since * the last time file handlers were invoked * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ ClientData clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; /* * The following structure is what is added to the Tcl event queue when file * handlers are ready to fire. */ typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find * the FileHandler structure for the file * (can't point directly to the FileHandler * structure because it could go away while * the event is queued). */ } FileHandlerEvent; /* * The following structure contains a set of select() masks to track readable, * writable, and exceptional conditions. */ typedef struct { fd_set readable; fd_set writable; fd_set exceptional; } SelectMasks; /* * The following static structure contains the state information for the * select based implementation of the Tcl notifier. One of these structures is * created for each thread that is using the notifier. */ typedef struct ThreadSpecificData { FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler list. */ int polled; /* True if the notifier thread has polled for * this thread. */ int sleeping; /* True if runloop is inside Tcl_Sleep. */ int runLoopSourcePerformed; /* True after the runLoopSource callack was * performed. */ int runLoopRunning; /* True if this thread's Tcl runLoop is * running. */ int runLoopNestingLevel; /* Level of nested runLoop invocations. */ /* Must hold the notifierLock before accessing the following fields: */ /* Start notifierLock section */ int onList; /* True if this thread is on the * waitingList */ struct ThreadSpecificData *nextPtr, *prevPtr; /* All threads that are currently waiting on * an event have their ThreadSpecificData * structure on a doubly-linked listed formed * from these pointers. */ /* End notifierLock section */ #if defined(USE_OS_UNFAIR_LOCK) os_unfair_lock tsdLock; #else OSSpinLock tsdLock; /* Must hold this lock before acessing the * following fields from more than one * thread. */ #endif /* Start tsdLock section */ SelectMasks checkMasks; /* This structure is used to build up the * masks to be used in the next call to * select. Bits are set in response to calls * to Tcl_CreateFileHandler. */ SelectMasks readyMasks; /* This array reflects the readable/writable * conditions that were found to exist by the * last call to select. */ int numFdBits; /* Number of valid bits in checkMasks (one * more than highest fd for which * Tcl_WatchFile has been called). */ int polling; /* True if this thread is polling for * events. */ CFRunLoopRef runLoop; /* This thread's CFRunLoop, needs to be woken * up whenever the runLoopSource is * signaled. */ CFRunLoopSourceRef runLoopSource; /* Any other thread alerts a notifier that an * event is ready to be processed by signaling * this CFRunLoopSource. */ CFRunLoopObserverRef runLoopObserver, runLoopObserverTcl; /* Adds/removes this thread from waitingList * when the CFRunLoop starts/stops. */ CFRunLoopTimerRef runLoopTimer; /* Wakes up CFRunLoop after given timeout when * running embedded. */ /* End tsdLock section */ CFTimeInterval waitTime; /* runLoopTimer wait time when running * embedded. */ ASLCLIENT_DECL; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following static indicates the number of threads that have initialized * notifiers. * * You must hold the notifierInitLock before accessing this variable. */ static int notifierCount = 0; /* * The following variable points to the head of a doubly-linked list of * ThreadSpecificData structures for all threads that are currently waiting on * an event. * * You must hold the notifierLock before accessing this list. */ static ThreadSpecificData *waitingListPtr = NULL; /* * The notifier thread spends all its time in select() waiting for a file * descriptor associated with one of the threads on the waitingListPtr list to * do something interesting. But if the contents of the waitingListPtr list * ever changes, we need to wake up and restart the select() system call. You * can wake up the notifier thread by writing a single byte to the file * descriptor defined below. This file descriptor is the input-end of a pipe * and the notifier thread is listening for data on the output-end of the same * pipe. Hence writing to this file descriptor will cause the select() system * call to return and wake up the notifier thread. * * You must hold the notifierLock lock before writing to the pipe. */ static int triggerPipe = -1; static int receivePipe = -1; /* Output end of triggerPipe */ /* * The following static indicates if the notifier thread is running. * * You must hold the notifierInitLock before accessing this variable. */ static int notifierThreadRunning; /* * This is the thread ID of the notifier thread that does select. Only valid * when notifierThreadRunning is non-zero. * * You must hold the notifierInitLock before accessing this variable. */ static pthread_t notifierThread; /* * Custom runloop mode for running with only the runloop source for the * notifier thread. */ #ifndef TCL_EVENTS_ONLY_RUN_LOOP_MODE #define TCL_EVENTS_ONLY_RUN_LOOP_MODE "com.tcltk.tclEventsOnlyRunLoopMode" #endif #ifdef __CONSTANT_CFSTRINGS__ #define tclEventsOnlyRunLoopMode CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE) #else static CFStringRef tclEventsOnlyRunLoopMode = NULL; #endif /* * CFTimeInterval to wait forever. */ #define CF_TIMEINTERVAL_FOREVER 5.05e8 /* * Static routines defined in this file. */ static void StartNotifierThread(void); static void NotifierThreadProc(ClientData clientData) __attribute__ ((__noreturn__)); static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void TimerWakeUp(CFRunLoopTimerRef timer, void *info); static void QueueFileEvents(void *info); static void UpdateWaitingListAndServiceEvents( CFRunLoopObserverRef observer, CFRunLoopActivity activity, void *info); static int OnOffWaitingList(ThreadSpecificData *tsdPtr, int onList, int signalNotifier); #ifdef HAVE_PTHREAD_ATFORK static int atForkInit = 0; static void AtForkPrepare(void); static void AtForkParent(void); static void AtForkChild(void); #if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040 /* Support for weakly importing pthread_atfork. */ #define WEAK_IMPORT_PTHREAD_ATFORK extern int pthread_atfork(void (*prepare)(void), void (*parent)(void), void (*child)(void)) WEAK_IMPORT_ATTRIBUTE; #define MayUsePthreadAtfork() (pthread_atfork != NULL) #else #define MayUsePthreadAtfork() (1) #endif /* HAVE_WEAK_IMPORT */ /* * On Darwin 9 and later, it is not possible to call CoreFoundation after * a fork. */ #if !defined(MAC_OS_X_VERSION_MIN_REQUIRED) || \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050 MODULE_SCOPE long tclMacOSXDarwinRelease; #define noCFafterFork (tclMacOSXDarwinRelease >= 9) #else /* MAC_OS_X_VERSION_MIN_REQUIRED */ #define noCFafterFork 1 #endif /* MAC_OS_X_VERSION_MIN_REQUIRED */ #endif /* HAVE_PTHREAD_ATFORK */ /* *---------------------------------------------------------------------- * * Tcl_InitNotifier -- * * Initializes the platform specific notifier state. * * Results: * Returns a handle to the notifier state for this thread. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_InitNotifier(void) { ThreadSpecificData *tsdPtr; if (tclNotifierHooks.initNotifierProc) { return tclNotifierHooks.initNotifierProc(); } tsdPtr = TCL_TSD_INIT(&dataKey); #ifdef WEAK_IMPORT_SPINLOCKLOCK /* * Initialize support for weakly imported spinlock API. */ if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) { Tcl_Panic("Tcl_InitNotifier: pthread_once failed"); } #endif #ifndef __CONSTANT_CFSTRINGS__ if (!tclEventsOnlyRunLoopMode) { tclEventsOnlyRunLoopMode = CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE); } #endif /* * Initialize CFRunLoopSource and add it to CFRunLoop of this thread. */ if (!tsdPtr->runLoop) { CFRunLoopRef runLoop = CFRunLoopGetCurrent(); CFRunLoopSourceRef runLoopSource; CFRunLoopSourceContext runLoopSourceContext; CFRunLoopObserverContext runLoopObserverContext; CFRunLoopObserverRef runLoopObserver, runLoopObserverTcl; bzero(&runLoopSourceContext, sizeof(CFRunLoopSourceContext)); runLoopSourceContext.info = tsdPtr; runLoopSourceContext.perform = QueueFileEvents; runLoopSource = CFRunLoopSourceCreate(NULL, LONG_MIN, &runLoopSourceContext); if (!runLoopSource) { Tcl_Panic("Tcl_InitNotifier: could not create CFRunLoopSource"); } CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes); CFRunLoopAddSource(runLoop, runLoopSource, tclEventsOnlyRunLoopMode); bzero(&runLoopObserverContext, sizeof(CFRunLoopObserverContext)); runLoopObserverContext.info = tsdPtr; runLoopObserver = CFRunLoopObserverCreate(NULL, kCFRunLoopEntry|kCFRunLoopExit, TRUE, LONG_MIN, UpdateWaitingListAndServiceEvents, &runLoopObserverContext); if (!runLoopObserver) { Tcl_Panic("Tcl_InitNotifier: could not create " "CFRunLoopObserver"); } CFRunLoopAddObserver(runLoop, runLoopObserver, kCFRunLoopCommonModes); /* * Create a second CFRunLoopObserver with the same callback as above * for the tclEventsOnlyRunLoopMode to ensure that the callback can be * re-entered via Tcl_ServiceAll() in the kCFRunLoopBeforeWaiting case * (CFRunLoop prevents observer callback re-entry of a given observer * instance). */ runLoopObserverTcl = CFRunLoopObserverCreate(NULL, kCFRunLoopEntry|kCFRunLoopExit, TRUE, LONG_MIN, UpdateWaitingListAndServiceEvents, &runLoopObserverContext); if (!runLoopObserverTcl) { Tcl_Panic("Tcl_InitNotifier: could not create " "CFRunLoopObserver"); } CFRunLoopAddObserver(runLoop, runLoopObserverTcl, tclEventsOnlyRunLoopMode); tsdPtr->runLoop = runLoop; tsdPtr->runLoopSource = runLoopSource; tsdPtr->runLoopObserver = runLoopObserver; tsdPtr->runLoopObserverTcl = runLoopObserverTcl; tsdPtr->runLoopTimer = NULL; tsdPtr->waitTime = CF_TIMEINTERVAL_FOREVER; #if defined(USE_OS_UNFAIR_LOCK) tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT; #else tsdPtr->tsdLock = SPINLOCK_INIT; #endif } LOCK_NOTIFIER_INIT; #ifdef HAVE_PTHREAD_ATFORK /* * Install pthread_atfork handlers to reinitialize the notifier in the * child of a fork. */ if (MayUsePthreadAtfork() && !atForkInit) { int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild); if (result) { Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed"); } atForkInit = 1; } #endif /* HAVE_PTHREAD_ATFORK */ if (notifierCount == 0) { int fds[2], status; /* * Initialize trigger pipe. */ if (pipe(fds) != 0) { Tcl_Panic("Tcl_InitNotifier: could not create trigger pipe"); } status = fcntl(fds[0], F_GETFL); status |= O_NONBLOCK; if (fcntl(fds[0], F_SETFL, status) < 0) { Tcl_Panic("Tcl_InitNotifier: could not make receive pipe non " "blocking"); } status = fcntl(fds[1], F_GETFL); status |= O_NONBLOCK; if (fcntl(fds[1], F_SETFL, status) < 0) { Tcl_Panic("Tcl_InitNotifier: could not make trigger pipe non " "blocking"); } receivePipe = fds[0]; triggerPipe = fds[1]; /* * Create notifier thread lazily in Tcl_WaitForEvent() to avoid * interfering with fork() followed immediately by execve() (we cannot * execve() when more than one thread is present). */ notifierThreadRunning = 0; OPEN_NOTIFIER_LOG; } ENABLE_ASL; notifierCount++; UNLOCK_NOTIFIER_INIT; return tsdPtr; } /* *---------------------------------------------------------------------- * * TclMacOSXNotifierAddRunLoopMode -- * * Add the tcl notifier RunLoop source, observer and timer (if any) * to the given RunLoop mode. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); CFStringRef mode = (CFStringRef) runLoopMode; if (tsdPtr->runLoop) { CFRunLoopAddSource(tsdPtr->runLoop, tsdPtr->runLoopSource, mode); CFRunLoopAddObserver(tsdPtr->runLoop, tsdPtr->runLoopObserver, mode); if (tsdPtr->runLoopTimer) { CFRunLoopAddTimer(tsdPtr->runLoop, tsdPtr->runLoopTimer, mode); } } } /* *---------------------------------------------------------------------- * * StartNotifierThread -- * * Start notifier thread if necessary. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void StartNotifierThread(void) { LOCK_NOTIFIER_INIT; if (!notifierCount) { Tcl_Panic("StartNotifierThread: notifier not initialized"); } if (!notifierThreadRunning) { int result; pthread_attr_t attr; pthread_attr_init(&attr); pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); pthread_attr_setstacksize(&attr, 60 * 1024); result = pthread_create(¬ifierThread, &attr, (void * (*)(void *))NotifierThreadProc, NULL); pthread_attr_destroy(&attr); if (result) { Tcl_Panic("StartNotifierThread: unable to start notifier thread"); } notifierThreadRunning = 1; } UNLOCK_NOTIFIER_INIT; } /* *---------------------------------------------------------------------- * * Tcl_FinalizeNotifier -- * * This function is called to cleanup the notifier state before a thread * is terminated. * * Results: * None. * * Side effects: * May terminate the background notifier thread if this is the last * notifier instance. * *---------------------------------------------------------------------- */ void Tcl_FinalizeNotifier( ClientData clientData) { ThreadSpecificData *tsdPtr; if (tclNotifierHooks.finalizeNotifierProc) { tclNotifierHooks.finalizeNotifierProc(clientData); return; } tsdPtr = TCL_TSD_INIT(&dataKey); LOCK_NOTIFIER_INIT; notifierCount--; DISABLE_ASL; /* * If this is the last thread to use the notifier, close the notifier pipe * and wait for the background thread to terminate. */ if (notifierCount == 0) { if (triggerPipe != -1) { /* * Send "q" message to the notifier thread so that it will * terminate. The notifier will return from its call to select() * and notice that a "q" message has arrived, it will then close * its side of the pipe and terminate its thread. Note the we can * not just close the pipe and check for EOF in the notifier * thread because if a background child process was created with * exec, select() would not register the EOF on the pipe until the * child processes had terminated. [Bug: 4139] [Bug 1222872] */ write(triggerPipe, "q", 1); close(triggerPipe); if (notifierThreadRunning) { int result = pthread_join(notifierThread, NULL); if (result) { Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier " "thread"); } notifierThreadRunning = 0; } close(receivePipe); triggerPipe = -1; } CLOSE_NOTIFIER_LOG; } UNLOCK_NOTIFIER_INIT; LOCK_NOTIFIER_TSD; /* For concurrency with Tcl_AlertNotifier */ if (tsdPtr->runLoop) { tsdPtr->runLoop = NULL; /* * Remove runLoopSource, runLoopObserver and runLoopTimer from all * CFRunLoops. */ CFRunLoopSourceInvalidate(tsdPtr->runLoopSource); CFRelease(tsdPtr->runLoopSource); tsdPtr->runLoopSource = NULL; CFRunLoopObserverInvalidate(tsdPtr->runLoopObserver); CFRelease(tsdPtr->runLoopObserver); tsdPtr->runLoopObserver = NULL; CFRunLoopObserverInvalidate(tsdPtr->runLoopObserverTcl); CFRelease(tsdPtr->runLoopObserverTcl); tsdPtr->runLoopObserverTcl = NULL; if (tsdPtr->runLoopTimer) { CFRunLoopTimerInvalidate(tsdPtr->runLoopTimer); CFRelease(tsdPtr->runLoopTimer); tsdPtr->runLoopTimer = NULL; } } UNLOCK_NOTIFIER_TSD; } /* *---------------------------------------------------------------------- * * Tcl_AlertNotifier -- * * Wake up the specified notifier from any thread. This routine is called * by the platform independent notifier code whenever the Tcl_ThreadAlert * routine is called. This routine is guaranteed not to be called on a * given notifier after Tcl_FinalizeNotifier is called for that notifier. * * Results: * None. * * Side effects: * Signals the notifier condition variable for the specified notifier. * *---------------------------------------------------------------------- */ void Tcl_AlertNotifier( ClientData clientData) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; if (tclNotifierHooks.alertNotifierProc) { tclNotifierHooks.alertNotifierProc(clientData); return; } LOCK_NOTIFIER_TSD; if (tsdPtr->runLoop) { CFRunLoopSourceSignal(tsdPtr->runLoopSource); CFRunLoopWakeUp(tsdPtr->runLoop); } UNLOCK_NOTIFIER_TSD; } /* *---------------------------------------------------------------------- * * Tcl_SetTimer -- * * This function sets the current notifier timer value. * * Results: * None. * * Side effects: * Replaces any previous timer. * *---------------------------------------------------------------------- */ void Tcl_SetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { ThreadSpecificData *tsdPtr; CFRunLoopTimerRef runLoopTimer; CFTimeInterval waitTime; if (tclNotifierHooks.setTimerProc) { tclNotifierHooks.setTimerProc(timePtr); return; } tsdPtr = TCL_TSD_INIT(&dataKey); runLoopTimer = tsdPtr->runLoopTimer; if (!runLoopTimer) { return; } if (timePtr) { Tcl_Time vTime = *timePtr; if (vTime.sec != 0 || vTime.usec != 0) { tclScaleTimeProcPtr(&vTime, tclTimeClientData); waitTime = vTime.sec + 1.0e-6 * vTime.usec; } else { waitTime = 0; } } else { waitTime = CF_TIMEINTERVAL_FOREVER; } tsdPtr->waitTime = waitTime; CFRunLoopTimerSetNextFireDate(runLoopTimer, CFAbsoluteTimeGetCurrent() + waitTime); } /* *---------------------------------------------------------------------- * * TimerWakeUp -- * * CFRunLoopTimer callback. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void TimerWakeUp( CFRunLoopTimerRef timer, void *info) { } /* *---------------------------------------------------------------------- * * Tcl_ServiceModeHook -- * * This function is invoked whenever the service mode changes. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_ServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { ThreadSpecificData *tsdPtr; if (tclNotifierHooks.serviceModeHookProc) { tclNotifierHooks.serviceModeHookProc(mode); return; } tsdPtr = TCL_TSD_INIT(&dataKey); if (mode == TCL_SERVICE_ALL && !tsdPtr->runLoopTimer) { if (!tsdPtr->runLoop) { Tcl_Panic("Tcl_ServiceModeHook: Notifier not initialized"); } tsdPtr->runLoopTimer = CFRunLoopTimerCreate(NULL, CFAbsoluteTimeGetCurrent() + CF_TIMEINTERVAL_FOREVER, CF_TIMEINTERVAL_FOREVER, 0, 0, TimerWakeUp, NULL); if (tsdPtr->runLoopTimer) { CFRunLoopAddTimer(tsdPtr->runLoop, tsdPtr->runLoopTimer, kCFRunLoopCommonModes); StartNotifierThread(); } } } /* *---------------------------------------------------------------------- * * Tcl_CreateFileHandler -- * * This function registers a file handler with the select notifier. * * Results: * None. * * Side effects: * Creates a new file handler structure. * *---------------------------------------------------------------------- */ void Tcl_CreateFileHandler( int fd, /* Handle of stream to watch. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr; FileHandler *filePtr; if (tclNotifierHooks.createFileHandlerProc) { tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); return; } tsdPtr = TCL_TSD_INIT(&dataKey); for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; tsdPtr->firstFileHandlerPtr = filePtr; } filePtr->proc = proc; filePtr->clientData = clientData; filePtr->mask = mask; /* * Update the check masks for this file. */ LOCK_NOTIFIER_TSD; if (mask & TCL_READABLE) { FD_SET(fd, &tsdPtr->checkMasks.readable); } else { FD_CLR(fd, &tsdPtr->checkMasks.readable); } if (mask & TCL_WRITABLE) { FD_SET(fd, &tsdPtr->checkMasks.writable); } else { FD_CLR(fd, &tsdPtr->checkMasks.writable); } if (mask & TCL_EXCEPTION) { FD_SET(fd, &tsdPtr->checkMasks.exceptional); } else { FD_CLR(fd, &tsdPtr->checkMasks.exceptional); } if (tsdPtr->numFdBits <= fd) { tsdPtr->numFdBits = fd+1; } UNLOCK_NOTIFIER_TSD; } /* *---------------------------------------------------------------------- * * Tcl_DeleteFileHandler -- * * Cancel a previously-arranged callback arrangement for a file. * * Results: * None. * * Side effects: * If a callback was previously registered on file, remove it. * *---------------------------------------------------------------------- */ void Tcl_DeleteFileHandler( int fd) /* Stream id for which to remove callback * function. */ { FileHandler *filePtr, *prevPtr; int i, numFdBits; ThreadSpecificData *tsdPtr; if (tclNotifierHooks.deleteFileHandlerProc) { tclNotifierHooks.deleteFileHandlerProc(fd); return; } tsdPtr = TCL_TSD_INIT(&dataKey); numFdBits = -1; /* * Find the entry for the given file (and return if there isn't one). */ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; prevPtr = filePtr, filePtr = filePtr->nextPtr) { if (filePtr == NULL) { return; } if (filePtr->fd == fd) { break; } } /* * Find current max fd. */ if (fd+1 == tsdPtr->numFdBits) { numFdBits = 0; for (i = fd-1; i >= 0; i--) { if (FD_ISSET(i, &tsdPtr->checkMasks.readable) || FD_ISSET(i, &tsdPtr->checkMasks.writable) || FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) { numFdBits = i+1; break; } } } LOCK_NOTIFIER_TSD; if (numFdBits != -1) { tsdPtr->numFdBits = numFdBits; } /* * Update the check masks for this file. */ if (filePtr->mask & TCL_READABLE) { FD_CLR(fd, &tsdPtr->checkMasks.readable); } if (filePtr->mask & TCL_WRITABLE) { FD_CLR(fd, &tsdPtr->checkMasks.writable); } if (filePtr->mask & TCL_EXCEPTION) { FD_CLR(fd, &tsdPtr->checkMasks.exceptional); } UNLOCK_NOTIFIER_TSD; /* * Clean up information in the callback record. */ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } ckfree(filePtr); } /* *---------------------------------------------------------------------- * * FileHandlerEventProc -- * * This function is called by Tcl_ServiceEvent when a file event reaches * the front of the event queue. This function is responsible for * actually handling the event by invoking the callback for the file * handler. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the file handler's callback function does. * *---------------------------------------------------------------------- */ static int FileHandlerEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { int mask; FileHandler *filePtr; FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr; ThreadSpecificData *tsdPtr; if (!(flags & TCL_FILE_EVENTS)) { return 0; } /* * Search through the file handlers to find the one whose handle matches * the event. We do this rather than keeping a pointer to the file handler * directly in the event, so that the handler can be deleted while the * event is queued without leaving a dangling pointer. */ tsdPtr = TCL_TSD_INIT(&dataKey); for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd != fileEvPtr->fd) { continue; } /* * The code is tricky for two reasons: * 1. The file handler's desired events could have changed since the * time when the event was queued, so AND the ready mask with the * desired mask. * 2. The file could have been closed and re-opened since the time * when the event was queued. This is why the ready mask is stored * in the file handler rather than the queued event: it will be * zeroed when a new file handler is created for the newly opened * file. */ mask = filePtr->readyMask & filePtr->mask; filePtr->readyMask = 0; if (mask != 0) { LOCK_NOTIFIER_TSD; if (mask & TCL_READABLE) { FD_CLR(filePtr->fd, &tsdPtr->readyMasks.readable); } if (mask & TCL_WRITABLE) { FD_CLR(filePtr->fd, &tsdPtr->readyMasks.writable); } if (mask & TCL_EXCEPTION) { FD_CLR(filePtr->fd, &tsdPtr->readyMasks.exceptional); } UNLOCK_NOTIFIER_TSD; filePtr->proc(filePtr->clientData, mask); } break; } return 1; } /* *---------------------------------------------------------------------- * * Tcl_WaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on * the message queue. If the block time is 0, then Tcl_WaitForEvent just * polls without blocking. * * Results: * Returns 0 if a tcl event or timeout occurred and 1 if a non-tcl * CFRunLoop source was processed. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_WaitForEvent( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { int result, polling, runLoopRunning; CFTimeInterval waitTime; SInt32 runLoopStatus; ThreadSpecificData *tsdPtr; if (tclNotifierHooks.waitForEventProc) { return tclNotifierHooks.waitForEventProc(timePtr); } result = -1; polling = 0; waitTime = CF_TIMEINTERVAL_FOREVER; tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->runLoop) { Tcl_Panic("Tcl_WaitForEvent: Notifier not initialized"); } /* * A NULL timePtr means wait forever. */ if (timePtr) { Tcl_Time vTime = *timePtr; /* * TIP #233 (Virtualized Time). Is virtual time in effect? And do we * actually have something to scale? If yes to both then we call the * handler to do this scaling. */ if (vTime.sec != 0 || vTime.usec != 0) { tclScaleTimeProcPtr(&vTime, tclTimeClientData); waitTime = vTime.sec + 1.0e-6 * vTime.usec; } else { /* * The max block time was set to 0. * * If we set the waitTime to 0, then the call to CFRunLoopInMode * may return without processing all of its sources. The Apple * documentation says that if the waitTime is 0 "only one pass is * made through the run loop before returning; if multiple sources * or timers are ready to fire immediately, only one (possibly two * if one is a version 0 source) will be fired, regardless of the * value of returnAfterSourceHandled." This can cause some chanio * tests to fail. So we use a small positive waitTime unless there * is another RunLoop running. */ polling = 1; waitTime = tsdPtr->runLoopRunning ? 0 : 0.0001; } } StartNotifierThread(); LOCK_NOTIFIER_TSD; tsdPtr->polling = polling; UNLOCK_NOTIFIER_TSD; tsdPtr->runLoopSourcePerformed = 0; /* * If the Tcl runloop is already running (e.g. if Tcl_WaitForEvent was * called recursively) start a new runloop in a custom runloop mode * containing only the source for the notifier thread. Otherwise wakeups * from other sources added to the common runloop mode might get lost or * 3rd party event handlers might get called when they do not expect to * be. */ runLoopRunning = tsdPtr->runLoopRunning; tsdPtr->runLoopRunning = 1; runLoopStatus = CFRunLoopRunInMode( runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode, waitTime, TRUE); tsdPtr->runLoopRunning = runLoopRunning; LOCK_NOTIFIER_TSD; tsdPtr->polling = 0; UNLOCK_NOTIFIER_TSD; switch (runLoopStatus) { case kCFRunLoopRunFinished: Tcl_Panic("Tcl_WaitForEvent: CFRunLoop finished"); break; case kCFRunLoopRunTimedOut: QueueFileEvents(tsdPtr); result = 0; break; case kCFRunLoopRunStopped: case kCFRunLoopRunHandledSource: result = tsdPtr->runLoopSourcePerformed ? 0 : 1; break; } return result; } /* *---------------------------------------------------------------------- * * QueueFileEvents -- * * CFRunLoopSource callback for queueing file events. * * Results: * None. * * Side effects: * Queues file events that are detected by the select. * *---------------------------------------------------------------------- */ static void QueueFileEvents( void *info) { SelectMasks readyMasks; FileHandler *filePtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info; /* * Queue all detected file events. */ LOCK_NOTIFIER_TSD; FD_COPY(&tsdPtr->readyMasks.readable, &readyMasks.readable); FD_COPY(&tsdPtr->readyMasks.writable, &readyMasks.writable); FD_COPY(&tsdPtr->readyMasks.exceptional, &readyMasks.exceptional); FD_ZERO(&tsdPtr->readyMasks.readable); FD_ZERO(&tsdPtr->readyMasks.writable); FD_ZERO(&tsdPtr->readyMasks.exceptional); UNLOCK_NOTIFIER_TSD; tsdPtr->runLoopSourcePerformed = 1; for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL); filePtr = filePtr->nextPtr) { int mask = 0; if (FD_ISSET(filePtr->fd, &readyMasks.readable)) { mask |= TCL_READABLE; } if (FD_ISSET(filePtr->fd, &readyMasks.writable)) { mask |= TCL_WRITABLE; } if (FD_ISSET(filePtr->fd, &readyMasks.exceptional)) { mask |= TCL_EXCEPTION; } if (!mask) { continue; } /* * Don't bother to queue an event if the mask was previously non-zero * since an event must still be on the queue. */ if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } filePtr->readyMask = mask; } } /* *---------------------------------------------------------------------- * * UpdateWaitingListAndServiceEvents -- * * CFRunLoopObserver callback for updating waitingList and * servicing Tcl events. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void UpdateWaitingListAndServiceEvents( CFRunLoopObserverRef observer, CFRunLoopActivity activity, void *info) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info; if (tsdPtr->sleeping) { return; } switch (activity) { case kCFRunLoopEntry: tsdPtr->runLoopNestingLevel++; if (tsdPtr->numFdBits > 0 || tsdPtr->polling) { LOCK_NOTIFIER; if (!OnOffWaitingList(tsdPtr, 1, 1) && tsdPtr->polling) { write(triggerPipe, "", 1); } UNLOCK_NOTIFIER; } break; case kCFRunLoopExit: if (tsdPtr->runLoopNestingLevel == 1) { LOCK_NOTIFIER; OnOffWaitingList(tsdPtr, 0, 1); UNLOCK_NOTIFIER; } tsdPtr->runLoopNestingLevel--; break; default: break; } } /* *---------------------------------------------------------------------- * * OnOffWaitingList -- * * Add/remove the specified thread to/from the global waitingList and * optionally signal the notifier. * * !!! Requires notifierLock to be held !!! * * Results: * Boolean indicating whether the waitingList was changed. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int OnOffWaitingList( ThreadSpecificData *tsdPtr, int onList, int signalNotifier) { int changeWaitingList; #if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK) if (SpinLockTry(¬ifierLock)) { Tcl_Panic("OnOffWaitingList: notifierLock unlocked"); } #endif changeWaitingList = (!onList ^ !tsdPtr->onList); if (changeWaitingList) { if (onList) { tsdPtr->nextPtr = waitingListPtr; if (waitingListPtr) { waitingListPtr->prevPtr = tsdPtr; } tsdPtr->prevPtr = NULL; waitingListPtr = tsdPtr; tsdPtr->onList = 1; } else { if (tsdPtr->prevPtr) { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } else { waitingListPtr = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; } if (signalNotifier) { write(triggerPipe, "", 1); } } return changeWaitingList; } /* *---------------------------------------------------------------------- * * Tcl_Sleep -- * * Delay execution for the specified number of milliseconds. * * Results: * None. * * Side effects: * Time passes. * *---------------------------------------------------------------------- */ void Tcl_Sleep( int ms) /* Number of milliseconds to sleep. */ { Tcl_Time vdelay; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (ms <= 0) { return; } /* * TIP #233: Scale from virtual time to real-time. */ vdelay.sec = ms / 1000; vdelay.usec = (ms % 1000) * 1000; tclScaleTimeProcPtr(&vdelay, tclTimeClientData); if (tsdPtr->runLoop) { CFTimeInterval waitTime; CFRunLoopTimerRef runLoopTimer = tsdPtr->runLoopTimer; CFAbsoluteTime nextTimerFire = 0, waitEnd, now; SInt32 runLoopStatus; waitTime = vdelay.sec + 1.0e-6 * vdelay.usec; now = CFAbsoluteTimeGetCurrent(); waitEnd = now + waitTime; if (runLoopTimer) { nextTimerFire = CFRunLoopTimerGetNextFireDate(runLoopTimer); if (nextTimerFire < waitEnd) { CFRunLoopTimerSetNextFireDate(runLoopTimer, now + CF_TIMEINTERVAL_FOREVER); } else { runLoopTimer = NULL; } } tsdPtr->sleeping = 1; do { runLoopStatus = CFRunLoopRunInMode(kCFRunLoopDefaultMode, waitTime, FALSE); switch (runLoopStatus) { case kCFRunLoopRunFinished: Tcl_Panic("Tcl_Sleep: CFRunLoop finished"); break; case kCFRunLoopRunStopped: TclMacOSXNotifierDbgMsg("CFRunLoop stopped"); waitTime = waitEnd - CFAbsoluteTimeGetCurrent(); break; case kCFRunLoopRunTimedOut: waitTime = 0; break; } } while (waitTime > 0); tsdPtr->sleeping = 0; if (runLoopTimer) { CFRunLoopTimerSetNextFireDate(runLoopTimer, nextTimerFire); } } else { struct timespec waitTime; waitTime.tv_sec = vdelay.sec; waitTime.tv_nsec = vdelay.usec * 1000; while (nanosleep(&waitTime, &waitTime)); } } /* *---------------------------------------------------------------------- * * TclUnixWaitForFile -- * * This function waits synchronously for a file to become readable or * writable, with an optional timeout. * * Results: * The return value is an OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are * present on file at the time of the return. This function will not * return until either "timeout" milliseconds have elapsed or at least * one of the conditions given by mask has occurred for file (a return * value of 0 means that a timeout occurred). No normal events will be * serviced during the execution of this function. * * Side effects: * Time passes. * *---------------------------------------------------------------------- */ int TclUnixWaitForFile( int fd, /* Handle for file on which to wait. */ int mask, /* What to wait for: OR'ed combination of * TCL_READABLE, TCL_WRITABLE, and * TCL_EXCEPTION. */ int timeout) /* Maximum amount of time to wait for one of * the conditions in mask to occur, in * milliseconds. A value of 0 means don't wait * at all, and a value of -1 means wait * forever. */ { Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */ struct timeval blockTime, *timeoutPtr; int numFound, result = 0; fd_set readableMask; fd_set writableMask; fd_set exceptionalMask; #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) #ifndef _DARWIN_C_SOURCE /* * Sanity check fd. */ if (fd >= FD_SETSIZE) { Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd); /* must never get here, or select masks overrun will occur below */ } #endif /* * If there is a non-zero finite timeout, compute the time when we give * up. */ if (timeout > 0) { Tcl_GetTime(&now); abortTime.sec = now.sec + timeout/1000; abortTime.usec = now.usec + (timeout%1000)*1000; if (abortTime.usec >= 1000000) { abortTime.usec -= 1000000; abortTime.sec += 1; } timeoutPtr = &blockTime; } else if (timeout == 0) { timeoutPtr = &blockTime; blockTime.tv_sec = 0; blockTime.tv_usec = 0; } else { timeoutPtr = NULL; } /* * Initialize the select masks. */ FD_ZERO(&readableMask); FD_ZERO(&writableMask); FD_ZERO(&exceptionalMask); /* * Loop in a mini-event loop of our own, waiting for either the file to * become ready or a timeout to occur. */ while (1) { if (timeout > 0) { blockTime.tv_sec = abortTime.sec - now.sec; blockTime.tv_usec = abortTime.usec - now.usec; if (blockTime.tv_usec < 0) { blockTime.tv_sec -= 1; blockTime.tv_usec += 1000000; } if (blockTime.tv_sec < 0) { blockTime.tv_sec = 0; blockTime.tv_usec = 0; } } /* * Setup the select masks for the fd. */ if (mask & TCL_READABLE) { FD_SET(fd, &readableMask); } if (mask & TCL_WRITABLE) { FD_SET(fd, &writableMask); } if (mask & TCL_EXCEPTION) { FD_SET(fd, &exceptionalMask); } /* * Wait for the event or a timeout. */ numFound = select(fd + 1, &readableMask, &writableMask, &exceptionalMask, timeoutPtr); if (numFound == 1) { if (FD_ISSET(fd, &readableMask)) { SET_BITS(result, TCL_READABLE); } if (FD_ISSET(fd, &writableMask)) { SET_BITS(result, TCL_WRITABLE); } if (FD_ISSET(fd, &exceptionalMask)) { SET_BITS(result, TCL_EXCEPTION); } result &= mask; if (result) { break; } } if (timeout == 0) { break; } if (timeout < 0) { continue; } /* * The select returned early, so we need to recompute the timeout. */ Tcl_GetTime(&now); if ((abortTime.sec < now.sec) || (abortTime.sec==now.sec && abortTime.usec<=now.usec)) { break; } } return result; } /* *---------------------------------------------------------------------- * * NotifierThreadProc -- * * This routine is the initial (and only) function executed by the * special notifier thread. Its job is to wait for file descriptors to * become readable or writable or to have an exception condition and then * to notify other threads who are interested in this information by * signalling a condition variable. Other threads can signal this * notifier thread of a change in their interests by writing a single * byte to a special pipe that the notifier thread is monitoring. * * Result: * None. Once started, this routine never exits. It dies with the overall * process. * * Side effects: * The trigger pipe used to signal the notifier thread is created when * the notifier thread first starts. * *---------------------------------------------------------------------- */ static void NotifierThreadProc( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr; fd_set readableMask, writableMask, exceptionalMask; int i, numFdBits = 0, polling; struct timeval poll = {0., 0.}, *timePtr; char buf[2]; /* * Look for file events and report them to interested threads. */ while (1) { FD_ZERO(&readableMask); FD_ZERO(&writableMask); FD_ZERO(&exceptionalMask); /* * Compute the logical OR of the select masks from all the waiting * notifiers. */ timePtr = NULL; LOCK_NOTIFIER; for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { LOCK_NOTIFIER_TSD; for (i = tsdPtr->numFdBits-1; i >= 0; --i) { if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) { FD_SET(i, &readableMask); } if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) { FD_SET(i, &writableMask); } if (FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) { FD_SET(i, &exceptionalMask); } } if (tsdPtr->numFdBits > numFdBits) { numFdBits = tsdPtr->numFdBits; } polling = tsdPtr->polling; UNLOCK_NOTIFIER_TSD; if ((tsdPtr->polled = polling)) { timePtr = &poll; } } UNLOCK_NOTIFIER; /* * Set up the select mask to include the receive pipe. */ if (receivePipe >= numFdBits) { numFdBits = receivePipe + 1; } FD_SET(receivePipe, &readableMask); if (select(numFdBits, &readableMask, &writableMask, &exceptionalMask, timePtr) == -1) { /* * Try again immediately on an error. */ continue; } /* * Alert any threads that are waiting on a ready file descriptor. */ LOCK_NOTIFIER; for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { int found = 0; SelectMasks readyMasks, checkMasks; LOCK_NOTIFIER_TSD; FD_COPY(&tsdPtr->checkMasks.readable, &checkMasks.readable); FD_COPY(&tsdPtr->checkMasks.writable, &checkMasks.writable); FD_COPY(&tsdPtr->checkMasks.exceptional, &checkMasks.exceptional); UNLOCK_NOTIFIER_TSD; found = tsdPtr->polled; FD_ZERO(&readyMasks.readable); FD_ZERO(&readyMasks.writable); FD_ZERO(&readyMasks.exceptional); for (i = tsdPtr->numFdBits-1; i >= 0; --i) { if (FD_ISSET(i, &checkMasks.readable) && FD_ISSET(i, &readableMask)) { FD_SET(i, &readyMasks.readable); found = 1; } if (FD_ISSET(i, &checkMasks.writable) && FD_ISSET(i, &writableMask)) { FD_SET(i, &readyMasks.writable); found = 1; } if (FD_ISSET(i, &checkMasks.exceptional) && FD_ISSET(i, &exceptionalMask)) { FD_SET(i, &readyMasks.exceptional); found = 1; } } if (found) { /* * Remove the ThreadSpecificData structure of this thread from * the waiting list. This prevents us from spinning * continuously on select until the other threads runs and * services the file event. */ OnOffWaitingList(tsdPtr, 0, 0); LOCK_NOTIFIER_TSD; FD_COPY(&readyMasks.readable, &tsdPtr->readyMasks.readable); FD_COPY(&readyMasks.writable, &tsdPtr->readyMasks.writable); FD_COPY(&readyMasks.exceptional, &tsdPtr->readyMasks.exceptional); UNLOCK_NOTIFIER_TSD; tsdPtr->polled = 0; if (tsdPtr->runLoop) { CFRunLoopSourceSignal(tsdPtr->runLoopSource); CFRunLoopWakeUp(tsdPtr->runLoop); } } } UNLOCK_NOTIFIER; /* * Consume the next byte from the notifier pipe if the pipe was * readable. Note that there may be multiple bytes pending, but to * avoid a race condition we only read one at a time. */ if (FD_ISSET(receivePipe, &readableMask)) { i = read(receivePipe, buf, 1); if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) { /* * Someone closed the write end of the pipe or sent us a Quit * message [Bug: 4139] and then closed the write end of the * pipe so we need to shut down the notifier thread. */ break; } } } pthread_exit(0); } #ifdef HAVE_PTHREAD_ATFORK /* *---------------------------------------------------------------------- * * AtForkPrepare -- * * Lock the notifier in preparation for a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkPrepare(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); LOCK_NOTIFIER_INIT; LOCK_NOTIFIER; LOCK_NOTIFIER_TSD; } /* *---------------------------------------------------------------------- * * AtForkParent -- * * Unlock the notifier in the parent after a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkParent(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); UNLOCK_NOTIFIER_TSD; UNLOCK_NOTIFIER; UNLOCK_NOTIFIER_INIT; } /* *---------------------------------------------------------------------- * * AtForkChild -- * * Unlock and reinstall the notifier in the child after a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkChild(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * If a child process unlocks an os_unfair_lock that was created in its parent * the child will exit with an illegal instruction error. So we reinitialize * the lock in the child rather than attempt to unlock it. */ #if defined(USE_OS_UNFAIR_LOCK) tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT; #else UNLOCK_NOTIFIER_TSD; UNLOCK_NOTIFIER; UNLOCK_NOTIFIER_INIT; #endif if (tsdPtr->runLoop) { tsdPtr->runLoop = NULL; if (!noCFafterFork) { CFRunLoopSourceInvalidate(tsdPtr->runLoopSource); CFRelease(tsdPtr->runLoopSource); if (tsdPtr->runLoopTimer) { CFRunLoopTimerInvalidate(tsdPtr->runLoopTimer); CFRelease(tsdPtr->runLoopTimer); } } tsdPtr->runLoopSource = NULL; tsdPtr->runLoopTimer = NULL; } if (notifierCount > 0) { notifierCount = 1; notifierThreadRunning = 0; /* * Assume that the return value of Tcl_InitNotifier in the child will * be identical to the one stored as clientData in tclNotify.c's * ThreadSpecificData by the parent's TclInitNotifier, so discard the * return value here. This assumption may require the fork() to be * executed in the main thread of the parent, otherwise * Tcl_AlertNotifier may break in the child. */ if (!noCFafterFork) { Tcl_InitNotifier(); } } } #endif /* HAVE_PTHREAD_ATFORK */ #else /* HAVE_COREFOUNDATION */ void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode) { Tcl_Panic("TclMacOSXNotifierAddRunLoopMode: " "Tcl not built with CoreFoundation support"); } #endif /* HAVE_COREFOUNDATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/macosx/Tcl-Info.plist.in0000644000175000017500000000236314554262142016235 0ustar sergeisergei CFBundleDevelopmentRegion English CFBundleExecutable @TCL_LIB_FILE@ CFBundleGetInfoString Tcl @TCL_VERSION@@TCL_PATCH_LEVEL@, Copyright ТЉ 1987-@TCL_YEAR@ Tcl Core Team, Copyright ТЉ 2001-@TCL_YEAR@ Daniel A. Steffen, Copyright ТЉ 2001-2009 Apple Inc., Copyright ТЉ 2001-2002 Jim Ingham & Ian Reid CFBundleIdentifier com.tcltk.tcllibrary CFBundleInfoDictionaryVersion 6.0 CFBundleName Tcl @TCL_VERSION@ CFBundlePackageType FMWK CFBundleShortVersionString @TCL_VERSION@@TCL_PATCH_LEVEL@ CFBundleSignature Tcl CFBundleVersion @TCL_VERSION@@TCL_PATCH_LEVEL@ tcl8.6.14/macosx/Tclsh-Info.plist.in0000644000175000017500000000235414554262142016570 0ustar sergeisergei CFBundleDevelopmentRegion English CFBundleExecutable tclsh@TCL_VERSION@ CFBundleGetInfoString Tcl Shell @TCL_VERSION@@TCL_PATCH_LEVEL@, Copyright ТЉ 1987-@TCL_YEAR@ Tcl Core Team, Copyright ТЉ 2001-@TCL_YEAR@ Daniel A. Steffen, Copyright ТЉ 2001-2009 Apple Inc., Copyright ТЉ 2001-2002 Jim Ingham & Ian Reid CFBundleIdentifier com.tcltk.tclsh CFBundleInfoDictionaryVersion 6.0 CFBundleName tclsh CFBundlePackageType APPL CFBundleShortVersionString @TCL_VERSION@@TCL_PATCH_LEVEL@ CFBundleSignature TclS CFBundleVersion @TCL_VERSION@@TCL_PATCH_LEVEL@ tcl8.6.14/macosx/configure.ac0000644000175000017500000000065614554262142015431 0ustar sergeisergei#! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. dnl Ensure that the config (auto)headers support is used, then just dnl include the configure sources from ../unix: m4_include(../unix/aclocal.m4) m4_define(SC_USE_CONFIG_HEADERS) m4_include(../unix/configure.in) tcl8.6.14/macosx/Tcl-Common.xcconfig0000644000175000017500000000301714554262142016627 0ustar sergeisergei// // Tcl-Common.xcconfig -- // // This file contains the Xcode build settings comon to all // project configurations in Tcl.xcodeproj. // // Copyright (c) 2007-2008 Daniel A. Steffen // // See the file "license.terms" for information on usage and redistribution // of this file, and for a DISCLAIMER OF ALL WARRANTIES. HEADER_SEARCH_PATHS = "$(DERIVED_FILE_DIR)/tcl" $(HEADER_SEARCH_PATHS) OTHER_LDFLAGS = -headerpad_max_install_names -sectcreate __TEXT __info_plist "$(DERIVED_FILE_DIR)/tcl/Tclsh-Info.plist" $(OTHER_LDFLAGS) INSTALL_PATH = $(BINDIR) INSTALL_MODE_FLAG = go-w,a+rX GCC_PREFIX_HEADER = $(DERIVED_FILE_DIR)/tcl/tclConfig.h GCC_GENERATE_DEBUGGING_SYMBOLS = YES GCC_NO_COMMON_BLOCKS = YES GCC_DYNAMIC_NO_PIC = YES GCC_VERSION = 4.2 GCC = gcc-$(GCC_VERSION) WARNING_CFLAGS = -Wall -Wextra -Wno-unused-parameter -Wno-missing-field-initializers -Wno-unused-value -Winit-self -Wpointer-arith -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS) BINDIR = $(PREFIX)/bin CFLAGS = $(CFLAGS) CPPFLAGS = -mmacosx-version-min=$(MACOSX_DEPLOYMENT_TARGET) $(CPPFLAGS) FRAMEWORK_INSTALL_PATH = /Library/Frameworks INCLUDEDIR = $(PREFIX)/include LIBDIR = $(PREFIX)/lib MANDIR = $(PREFIX)/man PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc) PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64) PREFIX = /usr/local TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H VERSION = 8.6 tcl8.6.14/macosx/Tcl-Debug.xcconfig0000644000175000017500000000122714554262142016426 0ustar sergeisergei// // Tcl-Debug.xcconfig -- // // This file contains the Xcode build settings for all Debug // project configurations in Tcl.xcodeproj. // // Copyright (c) 2007 Daniel A. Steffen // // See the file "license.terms" for information on usage and redistribution // of this file, and for a DISCLAIMER OF ALL WARRANTIES. #include "Tcl-Common.xcconfig" DEBUG_INFORMATION_FORMAT = dwarf DEAD_CODE_STRIPPING = NO DEPLOYMENT_POSTPROCESSING = NO GCC_OPTIMIZATION_LEVEL = 0 GCC_PREPROCESSOR_DEFINITIONS = $(TCL_DEFS) $(GCC_PREPROCESSOR_DEFINITIONS) CONFIGURE_ARGS = --enable-symbols $(TCL_CONFIGURE_ARGS) $(CONFIGURE_ARGS) MAKE_TARGET = develop tcl8.6.14/macosx/Tcl-Release.xcconfig0000644000175000017500000000125614554262142016762 0ustar sergeisergei// // Tcl-Release.xcconfig -- // // This file contains the Xcode build settings for all Release // project configurations in Tcl.xcodeproj. // // Copyright (c) 2007 Daniel A. Steffen // // See the file "license.terms" for information on usage and redistribution // of this file, and for a DISCLAIMER OF ALL WARRANTIES. #include "Tcl-Common.xcconfig" DEBUG_INFORMATION_FORMAT = dwarf-with-dsym DEAD_CODE_STRIPPING = YES DEPLOYMENT_POSTPROCESSING = YES GCC_OPTIMIZATION_LEVEL = 2 GCC_PREPROCESSOR_DEFINITIONS = NDEBUG $(TCL_DEFS) $(GCC_PREPROCESSOR_DEFINITIONS) CONFIGURE_ARGS = --disable-symbols $(TCL_CONFIGURE_ARGS) $(CONFIGURE_ARGS) MAKE_TARGET = deploy tcl8.6.14/macosx/configure0000755000175000017500000217420214560750373015060 0ustar sergeisergei#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.59 for tcl 8.6. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' PACKAGE_VERSION='8.6' PACKAGE_STRING='tcl 8.6' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. ac_includes_default="\ #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if STDC_HEADERS # include # include #else # if HAVE_STDLIB_H # include # endif #endif #if HAVE_STRING_H # if !STDC_HEADERS && HAVE_MEMORY_H # include # endif # include #endif #if HAVE_STRINGS_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS SHARED_BUILD TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_NOLTO LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias ac_env_CC_set=${CC+set} ac_env_CC_value=$CC ac_cv_env_CC_set=${CC+set} ac_cv_env_CC_value=$CC ac_env_CFLAGS_set=${CFLAGS+set} ac_env_CFLAGS_value=$CFLAGS ac_cv_env_CFLAGS_set=${CFLAGS+set} ac_cv_env_CFLAGS_value=$CFLAGS ac_env_LDFLAGS_set=${LDFLAGS+set} ac_env_LDFLAGS_value=$LDFLAGS ac_cv_env_LDFLAGS_set=${LDFLAGS+set} ac_cv_env_LDFLAGS_value=$LDFLAGS ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS ac_env_CPP_set=${CPP+set} ac_env_CPP_value=$CPP ac_cv_env_CPP_set=${CPP+set} ac_cv_env_CPP_value=$CPP # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures tcl 8.6 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of tcl 8.6:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-man-symlinks use symlinks for the manpages (default: off) --enable-man-compression=PROG compress the manpages with PROG (default: off) --enable-man-suffix=STRING use STRING as a suffix to manpage file names (default: no, tcl if enabled without specifying STRING) --enable-threads build with threads (default: on) --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (default: off) --enable-64bit-vis enable 64bit Sparc VIS support (default: off) --disable-rpath disable rpath support (default: on) --enable-corefoundation use CoreFoundation API on MacOSX (default: on) --enable-load allow dynamic loading and "load" command (default: on) --enable-symbols build with debugging symbols (default: off) --enable-langinfo use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on) --enable-dll-unloading enable the 'unload' command (default: on) --enable-dtrace build with DTrace support (default: off) --enable-framework package shared libraries in MacOSX frameworks (default: off) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values (default: iso8859-1) --with-tzdata install timezone data (default: autodetect) Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF tcl configure 8.6 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit 0 fi exec 5>config.log cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 8.6, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_config_headers="$ac_config_headers tclConfig.h:../unix/tclConfig.h.in" TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL=".14" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} #------------------------------------------------------------------------ # Setup configure arguments for bundled packages #------------------------------------------------------------------------ PKG_CFG_ARGS="$ac_configure_args ${PKG_CFG_ARGS}" if test -r "$cache_file" -a -f "$cache_file"; then case $cache_file in [\\/]* | ?:[\\/]* ) pkg_cache_file=$cache_file ;; *) pkg_cache_file=../../$cache_file ;; esac PKG_CFG_ARGS="${PKG_CFG_ARGS} --cache-file=$pkg_cache_file" fi #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ #rm -Rf pkgs if test -f Makefile; then make distclean-packages fi #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then prefix=/usr/local fi if test "${exec_prefix}" = "NONE"; then exec_prefix=$prefix fi # Make sure srcdir is fully qualified! srcdir="`cd "$srcdir" ; pwd`" TCL_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ # Compress and/or soft link the manpages? #------------------------------------------------------------------------ echo "$as_me:$LINENO: checking whether to use symlinks for manpages" >&5 echo $ECHO_N "checking whether to use symlinks for manpages... $ECHO_C" >&6 # Check whether --enable-man-symlinks or --disable-man-symlinks was given. if test "${enable_man_symlinks+set}" = set; then enableval="$enable_man_symlinks" test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 echo "$as_me:$LINENO: checking whether to compress the manpages" >&5 echo $ECHO_N "checking whether to compress the manpages... $ECHO_C" >&6 # Check whether --enable-man-compression or --disable-man-compression was given. if test "${enable_man_compression+set}" = set; then enableval="$enable_man_compression" case $enableval in yes) { { echo "$as_me:$LINENO: error: missing argument to --enable-man-compression" >&5 echo "$as_me: error: missing argument to --enable-man-compression" >&2;} { (exit 1); exit 1; }; };; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 if test "$enableval" != "no"; then echo "$as_me:$LINENO: checking for compressed file suffix" >&5 echo $ECHO_N "checking for compressed file suffix... $ECHO_C" >&6 touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" echo "$as_me:$LINENO: result: $Z" >&5 echo "${ECHO_T}$Z" >&6 fi echo "$as_me:$LINENO: checking whether to add a package name suffix for the manpages" >&5 echo $ECHO_N "checking whether to add a package name suffix for the manpages... $ECHO_C" >&6 # Check whether --enable-man-suffix or --disable-man-suffix was given. if test "${enable_man_suffix+set}" = set; then enableval="$enable_man_suffix" case $enableval in yes) enableval="tcl" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 #------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CC" && break done CC=$ac_ct_CC fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 (eval $ac_link_default) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Find the output, starting from the most likely. This scheme is # not robust to junk in `.', hence go to wildcards (a.*) only as a last # resort. # Be careful to initialize this variable, since it used to be cached. # Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. ac_cv_exeext= # b.out is created by i960 compilers. for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; conftest.$ac_ext ) # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` # FIXME: I believe we export ac_cv_exeext for Libtool, # but it would be cool to find out if it's true. Does anybody # maintain Libtool? --akim. export ac_cv_exeext break;; * ) break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6 # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6 echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` export ac_cv_exeext break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS CFLAGS="-g" echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cc_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 if test "${ac_cv_prog_cc_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_stdc=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std1 is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std1. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF # Don't try gcc -ansi; that turns off useful extensions and # breaks some systems' header files. # AIX -qlanglvl=ansi # Ultrix and OSF/1 -std1 # HP-UX 10.20 and later -Ae # HP-UX older versions -Aa -D_HPUX_SOURCE # SVR4 -Xc -D__EXTENSIONS__ for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_stdc=$ac_arg break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext done rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi case "x$ac_cv_prog_cc_stdc" in x|xno) echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6 ;; *) echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 CC="$CC $ac_cv_prog_cc_stdc" ;; esac # Some people use a C++ compiler to compile C. Since we use `exit', # in C++ we need to declare it. In case someone uses the same compiler # for both compiling C and C++ we need to have the C++ compiler decide # the declaration of exit, since it's the most demanding environment. cat >conftest.$ac_ext <<_ACEOF #ifndef __cplusplus choke me #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then for ac_declaration in \ '' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration #include int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking for inline" >&5 echo $ECHO_N "checking for inline... $ECHO_C" >&6 if test "${ac_cv_c_inline+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifndef __cplusplus typedef int foo_t; static $ac_kw foo_t static_foo () {return 0; } $ac_kw foo_t foo () {return 0; } #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_inline=$ac_kw; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done fi echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 echo "${ECHO_T}$ac_cv_c_inline" >&6 case $ac_cv_c_inline in inline | yes) ;; *) case $ac_cv_c_inline in no) ac_val=;; *) ac_val=$ac_cv_c_inline;; esac cat >>confdefs.h <<_ACEOF #ifndef __cplusplus #define inline $ac_val #endif _ACEOF ;; esac #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or # strtod in some versions of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6 ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6 if test "${ac_cv_prog_egrep+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | (grep -E '(a|b)') >/dev/null 2>&1 then ac_cv_prog_egrep='grep -E' else ac_cv_prog_egrep='egrep' fi fi echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 echo "${ECHO_T}$ac_cv_prog_egrep" >&6 EGREP=$ac_cv_prog_egrep echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6 if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking dirent.h" >&5 echo $ECHO_N "checking dirent.h... $ECHO_C" >&6 if test "${tcl_cv_dirent_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #ifndef _POSIX_SOURCE # ifdef __Lynx__ /* * Generate compilation error to make the test fail: Lynx headers * are only valid if really in the POSIX environment. */ missing_procedure(); # endif #endif DIR *d; struct dirent *entryPtr; char *p; d = opendir("foobar"); entryPtr = readdir(d); p = entryPtr->d_name; closedir(d); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_dirent_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_dirent_h=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_dirent_h" >&5 echo "${ECHO_T}$tcl_cv_dirent_h" >&6 if test $tcl_cv_dirent_h = no; then cat >>confdefs.h <<\_ACEOF #define NO_DIRENT_H 1 _ACEOF fi if test "${ac_cv_header_float_h+set}" = set; then echo "$as_me:$LINENO: checking for float.h" >&5 echo $ECHO_N "checking for float.h... $ECHO_C" >&6 if test "${ac_cv_header_float_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5 echo "${ECHO_T}$ac_cv_header_float_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking float.h usability" >&5 echo $ECHO_N "checking float.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking float.h presence" >&5 echo $ECHO_N "checking float.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: float.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: float.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: float.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: float.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: float.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: float.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: float.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: float.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for float.h" >&5 echo $ECHO_N "checking for float.h... $ECHO_C" >&6 if test "${ac_cv_header_float_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_float_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5 echo "${ECHO_T}$ac_cv_header_float_h" >&6 fi if test $ac_cv_header_float_h = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_FLOAT_H 1 _ACEOF fi if test "${ac_cv_header_values_h+set}" = set; then echo "$as_me:$LINENO: checking for values.h" >&5 echo $ECHO_N "checking for values.h... $ECHO_C" >&6 if test "${ac_cv_header_values_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5 echo "${ECHO_T}$ac_cv_header_values_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking values.h usability" >&5 echo $ECHO_N "checking values.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking values.h presence" >&5 echo $ECHO_N "checking values.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: values.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: values.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: values.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: values.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: values.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: values.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: values.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: values.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for values.h" >&5 echo $ECHO_N "checking for values.h... $ECHO_C" >&6 if test "${ac_cv_header_values_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_values_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5 echo "${ECHO_T}$ac_cv_header_values_h" >&6 fi if test $ac_cv_header_values_h = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_VALUES_H 1 _ACEOF fi if test "${ac_cv_header_stdlib_h+set}" = set; then echo "$as_me:$LINENO: checking for stdlib.h" >&5 echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 if test "${ac_cv_header_stdlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking stdlib.h usability" >&5 echo $ECHO_N "checking stdlib.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking stdlib.h presence" >&5 echo $ECHO_N "checking stdlib.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: stdlib.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: stdlib.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: stdlib.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: stdlib.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: stdlib.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: stdlib.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: stdlib.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for stdlib.h" >&5 echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 if test "${ac_cv_header_stdlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_stdlib_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 fi if test $ac_cv_header_stdlib_h = yes; then tcl_ok=1 else tcl_ok=0 fi cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtol" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtoul" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtod" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* if test $tcl_ok = 0; then cat >>confdefs.h <<\_ACEOF #define NO_STDLIB_H 1 _ACEOF fi if test "${ac_cv_header_string_h+set}" = set; then echo "$as_me:$LINENO: checking for string.h" >&5 echo $ECHO_N "checking for string.h... $ECHO_C" >&6 if test "${ac_cv_header_string_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5 echo "${ECHO_T}$ac_cv_header_string_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking string.h usability" >&5 echo $ECHO_N "checking string.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking string.h presence" >&5 echo $ECHO_N "checking string.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: string.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: string.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: string.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: string.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: string.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: string.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: string.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: string.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for string.h" >&5 echo $ECHO_N "checking for string.h... $ECHO_C" >&6 if test "${ac_cv_header_string_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_string_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5 echo "${ECHO_T}$ac_cv_header_string_h" >&6 fi if test $ac_cv_header_string_h = yes; then tcl_ok=1 else tcl_ok=0 fi cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strstr" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strerror" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* # See also memmove check below for a place where NO_STRING_H can be # set and why. if test $tcl_ok = 0; then cat >>confdefs.h <<\_ACEOF #define NO_STRING_H 1 _ACEOF fi if test "${ac_cv_header_sys_wait_h+set}" = set; then echo "$as_me:$LINENO: checking for sys/wait.h" >&5 echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6 if test "${ac_cv_header_sys_wait_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sys/wait.h usability" >&5 echo $ECHO_N "checking sys/wait.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sys/wait.h presence" >&5 echo $ECHO_N "checking sys/wait.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: sys/wait.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: sys/wait.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sys/wait.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sys/wait.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: sys/wait.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sys/wait.h" >&5 echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6 if test "${ac_cv_header_sys_wait_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sys_wait_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6 fi if test $ac_cv_header_sys_wait_h = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_SYS_WAIT_H 1 _ACEOF fi if test "${ac_cv_header_dlfcn_h+set}" = set; then echo "$as_me:$LINENO: checking for dlfcn.h" >&5 echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6 if test "${ac_cv_header_dlfcn_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking dlfcn.h usability" >&5 echo $ECHO_N "checking dlfcn.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking dlfcn.h presence" >&5 echo $ECHO_N "checking dlfcn.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: dlfcn.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: dlfcn.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: dlfcn.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: dlfcn.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: dlfcn.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for dlfcn.h" >&5 echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6 if test "${ac_cv_header_dlfcn_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_dlfcn_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6 fi if test $ac_cv_header_dlfcn_h = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_DLFCN_H 1 _ACEOF fi # OS/390 lacks sys/param.h (and doesn't need it, by chance). for ac_header in sys/param.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done #-------------------------------------------------------------------- # Determines the correct executable file extension (.exe) #-------------------------------------------------------------------- #------------------------------------------------------------------------ # If we're using GCC, see if the compiler understands -pipe. If so, use it. # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then echo "$as_me:$LINENO: checking if the compiler understands -pipe" >&5 echo $ECHO_N "checking if the compiler understands -pipe... $ECHO_C" >&6 if test "${tcl_cv_cc_pipe+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_pipe=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_pipe=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_pipe" >&5 echo "${ECHO_T}$tcl_cv_cc_pipe" >&6 if test $tcl_cv_cc_pipe = yes; then CFLAGS="$CFLAGS -pipe" fi fi #------------------------------------------------------------------------ # Threads support #------------------------------------------------------------------------ # Check whether --enable-threads or --disable-threads was given. if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else tcl_ok=yes fi; if test "${TCL_THREADS}" = 1; then tcl_threaded_core=1; fi if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then TCL_THREADS=1 # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention cat >>confdefs.h <<\_ACEOF #define USE_THREAD_ALLOC 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF if test "`uname -s`" = "SunOS" ; then cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF fi cat >>confdefs.h <<\_ACEOF #define _THREAD_SAFE 1 _ACEOF echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthread" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lpthread... $ECHO_C" >&6 if test "${ac_cv_lib_pthread_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthread_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthread_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthread_pthread_mutex_init" >&6 if test $ac_cv_lib_pthread_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "no"; then # Check a little harder for __pthread_mutex_init in the same # library, as some systems hide it there until pthread.h is # defined. We could alternatively do an AC_TRY_COMPILE with # pthread.h, but that will work with libpthread really doesn't # exist, like AIX 4.2. [Bug: 4359] echo "$as_me:$LINENO: checking for __pthread_mutex_init in -lpthread" >&5 echo $ECHO_N "checking for __pthread_mutex_init in -lpthread... $ECHO_C" >&6 if test "${ac_cv_lib_pthread___pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char __pthread_mutex_init (); int main () { __pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthread___pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthread___pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthread___pthread_mutex_init" >&6 if test $ac_cv_lib_pthread___pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthread" else echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthreads" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lpthreads... $ECHO_C" >&6 if test "${ac_cv_lib_pthreads_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthreads $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthreads_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthreads_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthreads_pthread_mutex_init" >&6 if test $ac_cv_lib_pthreads_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthreads" else echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lc... $ECHO_C" >&6 if test "${ac_cv_lib_c_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lc $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_c_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_c_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_c_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_c_pthread_mutex_init" >&6 if test $ac_cv_lib_c_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "no"; then echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc_r" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lc_r... $ECHO_C" >&6 if test "${ac_cv_lib_c_r_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lc_r $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_c_r_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_c_r_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_c_r_pthread_mutex_init" >&6 if test $ac_cv_lib_c_r_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -pthread" else TCL_THREADS=0 { echo "$as_me:$LINENO: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5 echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;} fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" for ac_func in pthread_attr_setstacksize pthread_atfork do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done LIBS=$ac_saved_libs else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output echo "$as_me:$LINENO: checking for building with threads" >&5 echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 if test "${TCL_THREADS}" = 1; then cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 _ACEOF if test "${tcl_threaded_core}" = 1; then echo "$as_me:$LINENO: result: yes (threaded core)" >&5 echo "${ECHO_T}yes (threaded core)" >&6 else echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 fi else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ # Check whether --with-encoding or --without-encoding was given. if test "${with_encoding+set}" = set; then withval="$with_encoding" with_tcencoding=${withval} fi; if test x"${with_tcencoding}" != x ; then cat >>confdefs.h <<_ACEOF #define TCL_CFGVAL_ENCODING "${with_tcencoding}" _ACEOF else cat >>confdefs.h <<\_ACEOF #define TCL_CFGVAL_ENCODING "iso8859-1" _ACEOF fi #-------------------------------------------------------------------- # Look for libraries that we will need when compiling the Tcl shell #-------------------------------------------------------------------- #-------------------------------------------------------------------- # On a few very rare systems, all of the libm.a stuff is # already in libc.a. Set compiler flags accordingly. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for sin" >&5 echo $ECHO_N "checking for sin... $ECHO_C" >&6 if test "${ac_cv_func_sin+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define sin to an innocuous variant, in case declares sin. For example, HP-UX 11i declares gettimeofday. */ #define sin innocuous_sin /* System header to define __stub macros and hopefully few prototypes, which can conflict with char sin (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef sin /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char sin (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_sin) || defined (__stub___sin) choke me #else char (*f) () = sin; #endif #ifdef __cplusplus } #endif int main () { return f != sin; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_sin=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_sin=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_sin" >&5 echo "${ECHO_T}$ac_cv_func_sin" >&6 if test $ac_cv_func_sin = yes; then MATH_LIBS="" else MATH_LIBS="-lm" fi #-------------------------------------------------------------------- # Interactive UNIX requires -linet instead of -lsocket, plus it # needs net/errno.h to define the socket-related error codes. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for main in -linet" >&5 echo $ECHO_N "checking for main in -linet... $ECHO_C" >&6 if test "${ac_cv_lib_inet_main+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { main (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_inet_main=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_inet_main=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_inet_main" >&5 echo "${ECHO_T}$ac_cv_lib_inet_main" >&6 if test $ac_cv_lib_inet_main = yes; then LIBS="$LIBS -linet" fi if test "${ac_cv_header_net_errno_h+set}" = set; then echo "$as_me:$LINENO: checking for net/errno.h" >&5 echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6 if test "${ac_cv_header_net_errno_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5 echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking net/errno.h usability" >&5 echo $ECHO_N "checking net/errno.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking net/errno.h presence" >&5 echo $ECHO_N "checking net/errno.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: net/errno.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: net/errno.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: net/errno.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: net/errno.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: net/errno.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: net/errno.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: net/errno.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: net/errno.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for net/errno.h" >&5 echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6 if test "${ac_cv_header_net_errno_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_net_errno_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5 echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6 fi if test $ac_cv_header_net_errno_h = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_NET_ERRNO_H 1 _ACEOF fi #-------------------------------------------------------------------- # Check for the existence of the -lsocket and -lnsl libraries. # The order here is important, so that they end up in the right # order in the command line generated by make. Here are some # special considerations: # 1. Use "connect" and "accept" to check for -lsocket, and # "gethostbyname" to check for -lnsl. # 2. Use each function name only once: can't redo a check because # autoconf caches the results of the last check and won't redo it. # 3. Use -lnsl and -lsocket only if they supply procedures that # aren't already present in the normal libraries. This is because # IRIX 5.2 has libraries, but they aren't needed and they're # bogus: they goof up name resolution if used. # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. # To get around this problem, check for both libraries together # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- tcl_checkBoth=0 echo "$as_me:$LINENO: checking for connect" >&5 echo $ECHO_N "checking for connect... $ECHO_C" >&6 if test "${ac_cv_func_connect+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define connect to an innocuous variant, in case declares connect. For example, HP-UX 11i declares gettimeofday. */ #define connect innocuous_connect /* System header to define __stub macros and hopefully few prototypes, which can conflict with char connect (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef connect /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char connect (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_connect) || defined (__stub___connect) choke me #else char (*f) () = connect; #endif #ifdef __cplusplus } #endif int main () { return f != connect; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_connect=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_connect=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_connect" >&5 echo "${ECHO_T}$ac_cv_func_connect" >&6 if test $ac_cv_func_connect = yes; then tcl_checkSocket=0 else tcl_checkSocket=1 fi if test "$tcl_checkSocket" = 1; then echo "$as_me:$LINENO: checking for setsockopt" >&5 echo $ECHO_N "checking for setsockopt... $ECHO_C" >&6 if test "${ac_cv_func_setsockopt+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define setsockopt to an innocuous variant, in case declares setsockopt. For example, HP-UX 11i declares gettimeofday. */ #define setsockopt innocuous_setsockopt /* System header to define __stub macros and hopefully few prototypes, which can conflict with char setsockopt (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef setsockopt /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char setsockopt (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_setsockopt) || defined (__stub___setsockopt) choke me #else char (*f) () = setsockopt; #endif #ifdef __cplusplus } #endif int main () { return f != setsockopt; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_setsockopt=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_setsockopt=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_setsockopt" >&5 echo "${ECHO_T}$ac_cv_func_setsockopt" >&6 if test $ac_cv_func_setsockopt = yes; then : else echo "$as_me:$LINENO: checking for setsockopt in -lsocket" >&5 echo $ECHO_N "checking for setsockopt in -lsocket... $ECHO_C" >&6 if test "${ac_cv_lib_socket_setsockopt+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char setsockopt (); int main () { setsockopt (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_socket_setsockopt=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_socket_setsockopt=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_socket_setsockopt" >&5 echo "${ECHO_T}$ac_cv_lib_socket_setsockopt" >&6 if test $ac_cv_lib_socket_setsockopt = yes; then LIBS="$LIBS -lsocket" else tcl_checkBoth=1 fi fi fi if test "$tcl_checkBoth" = 1; then tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" echo "$as_me:$LINENO: checking for accept" >&5 echo $ECHO_N "checking for accept... $ECHO_C" >&6 if test "${ac_cv_func_accept+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define accept to an innocuous variant, in case declares accept. For example, HP-UX 11i declares gettimeofday. */ #define accept innocuous_accept /* System header to define __stub macros and hopefully few prototypes, which can conflict with char accept (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef accept /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char accept (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_accept) || defined (__stub___accept) choke me #else char (*f) () = accept; #endif #ifdef __cplusplus } #endif int main () { return f != accept; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_accept=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_accept=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_accept" >&5 echo "${ECHO_T}$ac_cv_func_accept" >&6 if test $ac_cv_func_accept = yes; then tcl_checkNsl=0 else LIBS=$tk_oldLibs fi fi echo "$as_me:$LINENO: checking for gethostbyname" >&5 echo $ECHO_N "checking for gethostbyname... $ECHO_C" >&6 if test "${ac_cv_func_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gethostbyname to an innocuous variant, in case declares gethostbyname. For example, HP-UX 11i declares gettimeofday. */ #define gethostbyname innocuous_gethostbyname /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gethostbyname /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyname (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) choke me #else char (*f) () = gethostbyname; #endif #ifdef __cplusplus } #endif int main () { return f != gethostbyname; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gethostbyname=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_func_gethostbyname" >&6 if test $ac_cv_func_gethostbyname = yes; then : else echo "$as_me:$LINENO: checking for gethostbyname in -lnsl" >&5 echo $ECHO_N "checking for gethostbyname in -lnsl... $ECHO_C" >&6 if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnsl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyname (); int main () { gethostbyname (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_nsl_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_nsl_gethostbyname=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_nsl_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_lib_nsl_gethostbyname" >&6 if test $ac_cv_lib_nsl_gethostbyname = yes; then LIBS="$LIBS -lnsl" fi fi # Add the threads support libraries LIBS="$LIBS$THREADS_LIBS" echo "$as_me:$LINENO: checking how to build libraries" >&5 echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes fi; if test "$tcl_ok" = "yes" ; then echo "$as_me:$LINENO: result: shared" >&5 echo "${ECHO_T}shared" >&6 SHARED_BUILD=1 else echo "$as_me:$LINENO: result: static" >&5 echo "${ECHO_T}static" >&6 SHARED_BUILD=0 cat >>confdefs.h <<\_ACEOF #define STATIC_BUILD 1 _ACEOF fi #-------------------------------------------------------------------- # Look for a native installed tclsh binary (if available) # If one cannot be found then use the binary we build (fails for # cross compiling). This is used for NATIVE_TCLSH in Makefile. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for tclsh" >&5 echo $ECHO_N "checking for tclsh... $ECHO_C" >&6 if test "${ac_cv_path_tclsh+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[8-9]* 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done fi if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" echo "$as_me:$LINENO: result: $TCLSH_PROG" >&5 echo "${ECHO_T}$TCLSH_PROG" >&6 else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" echo "$as_me:$LINENO: result: No tclsh found on PATH" >&5 echo "${ECHO_T}No tclsh found on PATH" >&6 fi if test "$TCLSH_PROG" = ""; then TCLSH_PROG='./${TCL_EXE}' fi #------------------------------------------------------------------------ # Add stuff for zlib #------------------------------------------------------------------------ zlib_ok=yes if test "${ac_cv_header_zlib_h+set}" = set; then echo "$as_me:$LINENO: checking for zlib.h" >&5 echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6 if test "${ac_cv_header_zlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 echo "${ECHO_T}$ac_cv_header_zlib_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking zlib.h usability" >&5 echo $ECHO_N "checking zlib.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking zlib.h presence" >&5 echo $ECHO_N "checking zlib.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: zlib.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: zlib.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: zlib.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: zlib.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: zlib.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: zlib.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: zlib.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: zlib.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for zlib.h" >&5 echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6 if test "${ac_cv_header_zlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_zlib_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 echo "${ECHO_T}$ac_cv_header_zlib_h" >&6 fi if test $ac_cv_header_zlib_h = yes; then echo "$as_me:$LINENO: checking for gz_header" >&5 echo $ECHO_N "checking for gz_header... $ECHO_C" >&6 if test "${ac_cv_type_gz_header+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { if ((gz_header *) 0) return 0; if (sizeof (gz_header)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_gz_header=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_gz_header=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_gz_header" >&5 echo "${ECHO_T}$ac_cv_type_gz_header" >&6 if test $ac_cv_type_gz_header = yes; then : else zlib_ok=no fi else zlib_ok=no fi if test $zlib_ok = yes; then echo "$as_me:$LINENO: checking for library containing deflateSetHeader" >&5 echo $ECHO_N "checking for library containing deflateSetHeader... $ECHO_C" >&6 if test "${ac_cv_search_deflateSetHeader+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_func_search_save_LIBS=$LIBS ac_cv_search_deflateSetHeader=no cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char deflateSetHeader (); int main () { deflateSetHeader (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_search_deflateSetHeader="none required" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test "$ac_cv_search_deflateSetHeader" = no; then for ac_lib in z; do LIBS="-l$ac_lib $ac_func_search_save_LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char deflateSetHeader (); int main () { deflateSetHeader (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_search_deflateSetHeader="-l$ac_lib" break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext done fi LIBS=$ac_func_search_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_search_deflateSetHeader" >&5 echo "${ECHO_T}$ac_cv_search_deflateSetHeader" >&6 if test "$ac_cv_search_deflateSetHeader" != no; then test "$ac_cv_search_deflateSetHeader" = "none required" || LIBS="$ac_cv_search_deflateSetHeader $LIBS" else zlib_ok=no fi fi if test $zlib_ok = no; then ZLIB_OBJS=\${ZLIB_OBJS} ZLIB_SRCS=\${ZLIB_SRCS} ZLIB_INCLUDE=-I\${ZLIB_DIR} fi cat >>confdefs.h <<\_ACEOF #define HAVE_ZLIB 1 _ACEOF #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then echo "$as_me:$LINENO: result: $RANLIB" >&5 echo "${ECHO_T}$RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":" fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 echo "${ECHO_T}$ac_ct_RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi # Step 0.a: Enable 64 bit support? echo "$as_me:$LINENO: checking if 64bit support is requested" >&5 echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" do64bit=$enableval else do64bit=no fi; echo "$as_me:$LINENO: result: $do64bit" >&5 echo "${ECHO_T}$do64bit" >&6 # Step 0.b: Enable Solaris 64 bit VIS support? echo "$as_me:$LINENO: checking if 64bit Sparc VIS support is requested" >&5 echo $ECHO_N "checking if 64bit Sparc VIS support is requested... $ECHO_C" >&6 # Check whether --enable-64bit-vis or --disable-64bit-vis was given. if test "${enable_64bit_vis+set}" = set; then enableval="$enable_64bit_vis" do64bitVIS=$enableval else do64bitVIS=no fi; echo "$as_me:$LINENO: result: $do64bitVIS" >&5 echo "${ECHO_T}$do64bitVIS" >&6 # Force 64bit on with VIS if test "$do64bitVIS" = "yes"; then do64bit=yes fi # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. echo "$as_me:$LINENO: checking if compiler supports visibility \"hidden\"" >&5 echo $ECHO_N "checking if compiler supports visibility \"hidden\"... $ECHO_C" >&6 if test "${tcl_cv_cc_visibility_hidden+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {} int main () { f(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_visibility_hidden=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_visibility_hidden=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 if test $tcl_cv_cc_visibility_hidden = yes; then cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE extern __attribute__((__visibility__("hidden"))) _ACEOF cat >>confdefs.h <<\_ACEOF #define HAVE_HIDDEN 1 _ACEOF fi # Step 0.d: Disable -rpath support? echo "$as_me:$LINENO: checking if rpath support is requested" >&5 echo $ECHO_N "checking if rpath support is requested... $ECHO_C" >&6 # Check whether --enable-rpath or --disable-rpath was given. if test "${enable_rpath+set}" = set; then enableval="$enable_rpath" doRpath=$enableval else doRpath=yes fi; echo "$as_me:$LINENO: result: $doRpath" >&5 echo "${ECHO_T}$doRpath" >&6 # Step 1: set the variable "system" to hold the name and version number # for the system. echo "$as_me:$LINENO: checking system version" >&5 echo $ECHO_N "checking system version... $ECHO_C" >&6 if test "${tcl_cv_sys_version+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -f /usr/lib/NextStep/software_version; then tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then tcl_cv_sys_version=MP-RAS-`awk '{print $3}' /etc/.relid` fi if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then tcl_cv_sys_version=NetBSD-Debian fi fi fi fi echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 echo "${ECHO_T}$tcl_cv_sys_version" >&6 system=$tcl_cv_sys_version # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6 if test "${ac_cv_lib_dl_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char dlopen (); int main () { dlopen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dl_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dl_dlopen=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6 if test $ac_cv_lib_dl_dlopen = yes; then have_dl=yes else have_dl=no fi # Require ranlib early so we can override it in special cases below. # Step 3: set configuration options based on system name and version. do64bit_ok=no # default to '{$LIBS}' and set to "" on per-platform necessary basis SHLIB_LD_LIBS='${LIBS}' LDFLAGS_ORIG="$LDFLAGS" # When ld needs options to work in 64-bit mode, put them in # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] # is disabled by the user. [Bug 1016796] LDFLAGS_ARCH="" UNSHARED_LIB_SUFFIX="" TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`' ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g if test "$GCC" = yes; then CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall -Wpointer-arith" else CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 echo "${ECHO_T}$ac_ct_AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi AR=$ac_ct_AR else AR="$ac_cv_prog_AR" fi STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" if test "x${SHLIB_VERSION}" = x; then SHLIB_VERSION=".1.0" else SHLIB_VERSION=".${SHLIB_VERSION}" fi case $system in AIX-*) if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then # AIX requires the _r compiler when gcc isn't being used case "${CC}" in *_r|*_r\ *) # ok ... ;; *) # Make sure only first arg gets _r CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'` ;; esac echo "$as_me:$LINENO: result: Using $CC for compiling with threads" >&5 echo "${ECHO_T}Using $CC for compiling with threads" >&6 fi LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" LD_LIBRARY_PATH_VAR="LIBPATH" # ldAix No longer needed with use of -bexpall/-brtl # but some extensions may still reference it LDAIX_SRC='$(UNIX_DIR)/ldAix' # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then if test "$GCC" = yes; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} else do64bit_ok=yes CFLAGS="$CFLAGS -q64" LDFLAGS_ARCH="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" fi fi if test "`uname -m`" = ia64; then # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" if test "$GCC" = yes; then CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' else CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' else if test "$GCC" = yes; then SHLIB_LD='${CC} -shared -Wl,-bexpall' else SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" LDFLAGS="$LDFLAGS -brtl" fi SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi ;; BeOS*) SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -nostart' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" #----------------------------------------------------------- # Check for inet_ntoa in -lbind, for BeOS (which also needs # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- echo "$as_me:$LINENO: checking for inet_ntoa in -lbind" >&5 echo $ECHO_N "checking for inet_ntoa in -lbind... $ECHO_C" >&6 if test "${ac_cv_lib_bind_inet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lbind $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { inet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_bind_inet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_bind_inet_ntoa=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_bind_inet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_bind_inet_ntoa" >&6 if test $ac_cv_lib_bind_inet_ntoa = yes; then LIBS="$LIBS -lbind -lsocket" fi ;; BSD/OS-2.1*|BSD/OS-3*) SHLIB_CFLAGS="" SHLIB_LD="shlicc -r" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; BSD/OS-4.*) SHLIB_CFLAGS="-export-dynamic -fPIC" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32_*|MSYS_*) SHLIB_CFLAGS="-fno-common" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5 echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6 if test "${ac_cv_cygwin+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __CYGWIN__ #error cygwin #endif int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_cygwin=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_cygwin=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5 echo "${ECHO_T}$ac_cv_cygwin" >&6 if test "$ac_cv_cygwin" = "no"; then { { echo "$as_me:$LINENO: error: ${CC} is not a cygwin compiler." >&5 echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;} { (exit 1); exit 1; }; } fi if test "x${TCL_THREADS}" = "x0"; then { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5 echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;} { (exit 1); exit 1; }; } fi do64bit_ok=yes if test "x${SHARED_BUILD}" = "x1"; then echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32" # The eval makes quoting arguments work. if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32; cd ../unix then : else { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } fi fi ;; dgux*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" echo "$as_me:$LINENO: checking for inet_ntoa in -lnetwork" >&5 echo $ECHO_N "checking for inet_ntoa in -lnetwork... $ECHO_C" >&6 if test "${ac_cv_lib_network_inet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnetwork $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { inet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_network_inet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_network_inet_ntoa=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_network_inet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_network_inet_ntoa" >&6 if test $ac_cv_lib_network_inet_ntoa = yes; then LIBS="$LIBS -lnetwork" fi ;; HP-UX-*.11.*) # Use updated header definitions where possible cat >>confdefs.h <<\_ACEOF #define _XOPEN_SOURCE_EXTENDED 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _XOPEN_SOURCE 1 _ACEOF LIBS="$LIBS -lxnet" # Use the XOPEN network library if test "`uname -m`" = ia64; then SHLIB_SUFFIX=".so" else SHLIB_SUFFIX=".sl" fi echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 if test "${ac_cv_lib_dld_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char shl_load (); int main () { shl_load (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_shl_load=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else CFLAGS="$CFLAGS -z" fi # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes"; then if test "$GCC" = yes; then case `${CC} -dumpmachine` in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} ;; esac else do64bit_ok=yes CFLAGS="$CFLAGS +DD64" LDFLAGS_ARCH="+DD64" fi fi ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 if test "${ac_cv_lib_dld_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char shl_load (); int main () { shl_load (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_shl_load=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" SHLIB_LD_LIBS="" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi ;; IRIX-5.*) SHLIB_CFLAGS="" SHLIB_LD="ld -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" case $LIBOBJS in "mkstemp.$ac_objext" | \ *" mkstemp.$ac_objext" | \ "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi ;; IRIX-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" case $LIBOBJS in "mkstemp.$ac_objext" | \ *" mkstemp.$ac_objext" | \ "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes; then CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" else case $system in IRIX-6.3) # Use to build 6.2 compatible binaries on 6.3. CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" ;; *) CFLAGS="$CFLAGS -n32" ;; esac LDFLAGS="$LDFLAGS -n32" fi ;; IRIX64-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" case $LIBOBJS in "mkstemp.$ac_objext" | \ *" mkstemp.$ac_objext" | \ "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then if test "$GCC" = yes; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported by gcc" >&5 echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} else do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" fi fi ;; Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*) SHLIB_CFLAGS="-fPIC -fno-common" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" case $system in DragonFly-*|FreeBSD-*) if test "${TCL_THREADS}" = "1"; then # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS" fi ;; esac if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "`uname -m`" = "alpha"; then CFLAGS="$CFLAGS -mieee" fi if test $do64bit = yes; then echo "$as_me:$LINENO: checking if compiler accepts -m64 flag" >&5 echo $ECHO_N "checking if compiler accepts -m64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_m64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_m64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_m64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_m64" >&5 echo "${ECHO_T}$tcl_cv_cc_m64" >&6 if test $tcl_cv_cc_m64 = yes; then CFLAGS="$CFLAGS -m64" do64bit_ok=yes fi fi # The combo of gcc + glibc has a bug related to inlining of # functions like strtod(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. if test x"${USE_COMPAT}" != x; then CFLAGS="$CFLAGS -fno-inline" fi ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE=-02 SHLIB_LD='${CC} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi ;; MP-RAS-02*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; MP-RAS-*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,-Bexport" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OpenBSD-*) arch=`arch -s` case "$arch" in alpha|sparc64) SHLIB_CFLAGS="-fPIC" ;; *) SHLIB_CFLAGS="-fpic" ;; esac SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" CFLAGS_OPTIMIZE="-O2" if test "${TCL_THREADS}" = "1"; then # On OpenBSD: Compile with -pthread # Don't link with -lpthread LIBS=`echo $LIBS | sed s/-lpthread//` CFLAGS="$CFLAGS -pthread" fi # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "${TCL_THREADS}" = "1"; then # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi ;; Darwin-*) CFLAGS_OPTIMIZE="-O2" SHLIB_CFLAGS="-fno-common" # To avoid discrepancies between what headers configure sees during # preprocessing tests and compiling tests, move any -isysroot and # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if ($i~/^(isysroot|mmacosx-version-min)/) print "-"$i}'`" CFLAGS="`echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if (!($i~/^(isysroot|mmacosx-version-min)/)) print "-"$i}'`" if test $do64bit = yes; then case `arch` in ppc) echo "$as_me:$LINENO: checking if compiler accepts -arch ppc64 flag" >&5 echo $ECHO_N "checking if compiler accepts -arch ppc64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_arch_ppc64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_arch_ppc64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_arch_ppc64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_ppc64" >&5 echo "${ECHO_T}$tcl_cv_cc_arch_ppc64" >&6 if test $tcl_cv_cc_arch_ppc64 = yes; then CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes fi ;; i386|x86_64) echo "$as_me:$LINENO: checking if compiler accepts -arch x86_64 flag" >&5 echo $ECHO_N "checking if compiler accepts -arch x86_64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_arch_x86_64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_arch_x86_64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_arch_x86_64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_x86_64" >&5 echo "${ECHO_T}$tcl_cv_cc_arch_x86_64" >&6 if test $tcl_cv_cc_arch_x86_64 = yes; then CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes fi ;; arm64) echo "$as_me:$LINENO: checking if compiler accepts -arch arm64 flag" >&5 echo $ECHO_N "checking if compiler accepts -arch arm64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_arch_arm64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch arm64" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_arch_arm64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_arch_arm64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_arm64" >&5 echo "${ECHO_T}$tcl_cv_cc_arch_arm64" >&6 if test $tcl_cv_cc_arch_arm64 = yes; then CFLAGS="$CFLAGS -arch arm64" do64bit_ok=yes fi ;; *) { echo "$as_me:$LINENO: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; esac else # Check for combined 32-bit and 64-bit fat build if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64|arm64) ' \ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then fat_32_64=yes fi fi SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' echo "$as_me:$LINENO: checking if ld accepts -single_module flag" >&5 echo $ECHO_N "checking if ld accepts -single_module flag... $ECHO_C" >&6 if test "${tcl_cv_ld_single_module+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_single_module=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_single_module=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_single_module" >&5 echo "${ECHO_T}$tcl_cv_ld_single_module" >&6 if test $tcl_cv_ld_single_module = yes; then SHLIB_LD="${SHLIB_LD} -Wl,-single_module" fi SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" LDFLAGS="$LDFLAGS -headerpad_max_install_names" echo "$as_me:$LINENO: checking if ld accepts -search_paths_first flag" >&5 echo $ECHO_N "checking if ld accepts -search_paths_first flag... $ECHO_C" >&6 if test "${tcl_cv_ld_search_paths_first+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_search_paths_first=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_search_paths_first=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_search_paths_first" >&5 echo "${ECHO_T}$tcl_cv_ld_search_paths_first" >&6 if test $tcl_cv_ld_search_paths_first = yes; then LDFLAGS="$LDFLAGS -Wl,-search_paths_first" fi if test "$tcl_cv_cc_visibility_hidden" != yes; then cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE __private_extern__ _ACEOF tcl_cv_cc_visibility_hidden=yes fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_FALLBACK_LIBRARY_PATH" cat >>confdefs.h <<\_ACEOF #define MAC_OSX_TCL 1 _ACEOF PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' echo "$as_me:$LINENO: checking whether to use CoreFoundation" >&5 echo $ECHO_N "checking whether to use CoreFoundation... $ECHO_C" >&6 # Check whether --enable-corefoundation or --disable-corefoundation was given. if test "${enable_corefoundation+set}" = set; then enableval="$enable_corefoundation" tcl_corefoundation=$enableval else tcl_corefoundation=yes fi; echo "$as_me:$LINENO: result: $tcl_corefoundation" >&5 echo "${ECHO_T}$tcl_corefoundation" >&6 if test $tcl_corefoundation = yes; then echo "$as_me:$LINENO: checking for CoreFoundation.framework" >&5 echo $ECHO_N "checking for CoreFoundation.framework... $ECHO_C" >&6 if test "${tcl_cv_lib_corefoundation+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_libs=$LIBS if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit # archs from CFLAGS et al. while testing for # presence of CF. 64-bit CF is disabled in # tclUnixPort.h if necessary. eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done fi LIBS="$LIBS -framework CoreFoundation" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { CFBundleRef b = CFBundleGetMainBundle(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_lib_corefoundation=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_lib_corefoundation=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi LIBS=$hold_libs fi echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation" >&5 echo "${ECHO_T}$tcl_cv_lib_corefoundation" >&6 if test $tcl_cv_lib_corefoundation = yes; then LIBS="$LIBS -framework CoreFoundation" cat >>confdefs.h <<\_ACEOF #define HAVE_COREFOUNDATION 1 _ACEOF else tcl_corefoundation=no fi if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then echo "$as_me:$LINENO: checking for 64-bit CoreFoundation" >&5 echo $ECHO_N "checking for 64-bit CoreFoundation... $ECHO_C" >&6 if test "${tcl_cv_lib_corefoundation_64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { CFBundleRef b = CFBundleGetMainBundle(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_lib_corefoundation_64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_lib_corefoundation_64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation_64" >&5 echo "${ECHO_T}$tcl_cv_lib_corefoundation_64" >&6 if test $tcl_cv_lib_corefoundation_64 = no; then cat >>confdefs.h <<\_ACEOF #define NO_COREFOUNDATION_64 1 _ACEOF LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" fi fi fi ;; NEXTSTEP-*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -nostdlib -r' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadNext.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OS/390-*) SHLIB_LD_LIBS="" CFLAGS_OPTIMIZE="" # Optimizer is buggy cat >>confdefs.h <<\_ACEOF #define _OE_SOCKETS 1 _ACEOF ;; OSF1-1.0|OSF1-1.1|OSF1-1.2) # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1 SHLIB_CFLAGS="" # Hack: make package name same as library name SHLIB_LD='ld -R -export :' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadOSF.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-1.*) # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2 SHLIB_CFLAGS="-fPIC" if test "$SHARED_BUILD" = 1; then SHLIB_LD="ld -shared" else SHLIB_LD="ld -non_shared" fi SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" if test "$SHARED_BUILD" = 1; then SHLIB_LD='${CC} -shared' else SHLIB_LD='${CC} -non_shared' fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes; then CFLAGS="$CFLAGS -mieee" else CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" fi # see pthread_intro(3) for pthread support on osf1, k.furukawa if test "${TCL_THREADS}" = 1; then CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` if test "$GCC" = yes; then LIBS="$LIBS -lpthread -lmach -lexc" else CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi fi ;; QNX-6*) # QNX RTP # This may work for all QNX, but it was only reported for v6. SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" # dlopen is in -lc on QNX DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. if test "$GCC" = yes; then SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" else SHLIB_CFLAGS="-Kpic -belf" LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" fi SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SINIX*5.4*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SunOS-4*) SHLIB_CFLAGS="-PIC" SHLIB_LD="ld" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} # SunOS can't handle version numbers with dots in them in library # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it # requires an extra version number at the end of .so file names. # So, the library has to have a name like libtcl75.so.1.0 SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; SunOS-5.[0-6]) # Careful to not let 5.10+ fall into this case # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF SHLIB_CFLAGS="-KPIC" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF SHLIB_CFLAGS="-KPIC" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then arch=`isainfo` if test "$arch" = "sparcv9 sparc"; then if test "$GCC" = yes; then if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} else do64bit_ok=yes CFLAGS="$CFLAGS -m64 -mcpu=v9" LDFLAGS="$LDFLAGS -m64 -mcpu=v9" SHLIB_CFLAGS="-fPIC" fi else do64bit_ok=yes if test "$do64bitVIS" = yes; then CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" else CFLAGS="$CFLAGS -xarch=v9" LDFLAGS_ARCH="-xarch=v9" fi # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" fi else if test "$arch" = "amd64 i386"; then if test "$GCC" = yes; then case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) do64bit_ok=yes CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; esac else do64bit_ok=yes case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) CFLAGS="$CFLAGS -xarch=amd64" LDFLAGS="$LDFLAGS -xarch=amd64";; esac fi else { echo "$as_me:$LINENO: WARNING: 64bit mode not supported for $arch" >&5 echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} fi fi fi #-------------------------------------------------------------------- # On Solaris 5.x i386 with the sunpro compiler we need to link # with sunmath to get floating point rounding control #-------------------------------------------------------------------- if test "$GCC" = yes; then use_sunmath=no else arch=`isainfo` echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5 echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6 if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MATH_LIBS="-lsunmath $MATH_LIBS" if test "${ac_cv_header_sunmath_h+set}" = set; then echo "$as_me:$LINENO: checking for sunmath.h" >&5 echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 if test "${ac_cv_header_sunmath_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sunmath.h usability" >&5 echo $ECHO_N "checking sunmath.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sunmath.h presence" >&5 echo $ECHO_N "checking sunmath.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: sunmath.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: sunmath.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sunmath.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sunmath.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: sunmath.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sunmath.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: sunmath.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sunmath.h" >&5 echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 if test "${ac_cv_header_sunmath_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sunmath_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 fi use_sunmath=yes else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 use_sunmath=no fi fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "$do64bit_ok" = yes; then if test "$arch" = "sparcv9 sparc"; then # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" # for finding sparcv9 libgcc, get the regular libgcc # path, remove so name and append 'sparcv9' #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" else if test "$arch" = "amd64 i386"; then SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" fi fi fi else if test "$use_sunmath" = yes; then textmode=textoff else textmode=text fi case $system in SunOS-5.[1-9][0-9]*|SunOS-5.[7-9]) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; esac CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' fi ;; UNIX_SV* | UnixWare-5*) SHLIB_CFLAGS="-KPIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. echo "$as_me:$LINENO: checking for ld accepts -Bexport flag" >&5 echo $ECHO_N "checking for ld accepts -Bexport flag... $ECHO_C" >&6 if test "${tcl_cv_ld_Bexport+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_Bexport=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_Bexport=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_Bexport" >&5 echo "${ECHO_T}$tcl_cv_ld_Bexport" >&6 if test $tcl_cv_ld_Bexport = yes; then LDFLAGS="$LDFLAGS -Wl,-Bexport" fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac if test "$do64bit" = yes -a "$do64bit_ok" = no; then { echo "$as_me:$LINENO: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} fi if test "$do64bit" = yes -a "$do64bit_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define TCL_CFG_DO64BIT 1 _ACEOF fi # Step 4: disable dynamic loading if requested via a command-line switch. # Check whether --enable-load or --disable-load was given. if test "${enable_load+set}" = set; then enableval="$enable_load" tcl_ok=$enableval else tcl_ok=yes fi; if test "$tcl_ok" = no; then DL_OBJS="" fi if test "x$DL_OBJS" != x; then BUILD_DLTEST="\$(DLTEST_TARGETS)" else { echo "$as_me:$LINENO: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" DL_OBJS="tclLoadNone.o" DL_LIBS="" LDFLAGS="$LDFLAGS_ORIG" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" BUILD_DLTEST="" fi LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then case $system in AIX-*) ;; BSD/OS*) ;; CYGWIN_*|MINGW32_*|MSYS_*) ;; HP-UX*) ;; Darwin-*) ;; IRIX*) ;; NetBSD-*|OpenBSD-*) ;; OSF1-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac fi if test "$tcl_cv_cc_visibility_hidden" != yes; then cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE extern _ACEOF fi if test "$SHARED_LIB_SUFFIX" = ""; then SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}' fi if test "$UNSHARED_LIB_SUFFIX" = ""; then UNSHARED_LIB_SUFFIX='${VERSION}.a' fi DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' if test "${SHLIB_SUFFIX}" = ".dll"; then INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" else INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi else LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} if test "$RANLIB" = ""; then MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' else MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@' fi INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi # Stub lib does not depend on shared/static configuration if test "$RANLIB" = ""; then MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' else MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@' fi INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. if test "x${TCL_LIBS}" = x; then TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}" fi # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. echo "$as_me:$LINENO: checking for cast to union support" >&5 echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 if test "${tcl_cv_cast_to_union+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { union foo { int i; double d; }; union foo f = (union foo) (int) 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cast_to_union=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cast_to_union=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 if test "$tcl_cv_cast_to_union" = "yes"; then cat >>confdefs.h <<\_ACEOF #define HAVE_CAST_TO_UNION 1 _ACEOF fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" echo "$as_me:$LINENO: checking for working -fno-lto" >&5 echo $ECHO_N "checking for working -fno-lto... $ECHO_C" >&6 if test "${ac_cv_nolto+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_nolto=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_nolto=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_nolto" >&5 echo "${ECHO_T}$ac_cv_nolto" >&6 CFLAGS=$hold_cflags if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi # Check for vfork, posix_spawnp() and friends unconditionally for ac_func in vfork posix_spawnp posix_spawn_file_actions_adddup2 posix_spawnattr_setflags do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. cat >>confdefs.h <<_ACEOF #define TCL_SHLIB_EXT "${SHLIB_SUFFIX}" _ACEOF echo "$as_me:$LINENO: checking for build with symbols" >&5 echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" tcl_ok=$enableval else tcl_ok=no fi; # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' cat >>confdefs.h <<\_ACEOF #define NDEBUG 1 _ACEOF echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 cat >>confdefs.h <<\_ACEOF #define TCL_CFG_OPTIMIZED 1 _ACEOF else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 echo "${ECHO_T}yes (standard debugging)" >&6 fi fi if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then cat >>confdefs.h <<\_ACEOF #define TCL_MEM_DEBUG 1 _ACEOF fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_DEBUG 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_STATS 1 _ACEOF fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5 echo "${ECHO_T}enabled symbols mem compile debugging" >&6 else echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5 echo "${ECHO_T}enabled $tcl_ok debugging" >&6 fi fi cat >>confdefs.h <<\_ACEOF #define TCL_TOMMATH 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define MP_PREC 4 _ACEOF #-------------------------------------------------------------------- # Detect what compiler flags to set for 64-bit support. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for required early compiler flags" >&5 echo $ECHO_N "checking for required early compiler flags... $ECHO_C" >&6 tcl_flags="" if test "${tcl_cv_flag__isoc99_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *p = (char *)strtoll; char *q = (char *)strtoull; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__isoc99_source=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _ISOC99_SOURCE 1 #include int main () { char *p = (char *)strtoll; char *q = (char *)strtoull; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__isoc99_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_flag__isoc99_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define _ISOC99_SOURCE 1 _ACEOF tcl_flags="$tcl_flags _ISOC99_SOURCE" fi if test "${tcl_cv_flag__largefile64_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__largefile64_source=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _LARGEFILE64_SOURCE 1 #include int main () { struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__largefile64_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_flag__largefile64_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define _LARGEFILE64_SOURCE 1 _ACEOF tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" fi if test "x${tcl_flags}" = "x" ; then echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 else echo "$as_me:$LINENO: result: ${tcl_flags}" >&5 echo "${ECHO_T}${tcl_flags}" >&6 fi echo "$as_me:$LINENO: checking for 64-bit integer type" >&5 echo $ECHO_N "checking for 64-bit integer type... $ECHO_C" >&6 if test "${tcl_cv_type_64bit+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { __int64 value = (__int64) 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_type_64bit=__int64 else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_type_64bit="long long" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # See if we should use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { switch (0) { case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; } ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_64bit=${tcl_type_64bit} else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "${tcl_cv_type_64bit}" = none ; then cat >>confdefs.h <<\_ACEOF #define TCL_WIDE_INT_IS_LONG 1 _ACEOF echo "$as_me:$LINENO: result: using long" >&5 echo "${ECHO_T}using long" >&6 else cat >>confdefs.h <<_ACEOF #define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit} _ACEOF echo "$as_me:$LINENO: result: ${tcl_cv_type_64bit}" >&5 echo "${ECHO_T}${tcl_cv_type_64bit}" >&6 # Now check for auxiliary declarations echo "$as_me:$LINENO: checking for struct dirent64" >&5 echo $ECHO_N "checking for struct dirent64... $ECHO_C" >&6 if test "${tcl_cv_struct_dirent64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct dirent64 p; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_struct_dirent64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_struct_dirent64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_struct_dirent64" >&5 echo "${ECHO_T}$tcl_cv_struct_dirent64" >&6 if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_STRUCT_DIRENT64 1 _ACEOF fi echo "$as_me:$LINENO: checking for DIR64" >&5 echo $ECHO_N "checking for DIR64... $ECHO_C" >&6 if test "${tcl_cv_DIR64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct dirent64 *p; DIR64 d = opendir64("."); p = readdir64(d); rewinddir64(d); closedir64(d); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_DIR64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_DIR64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_DIR64" >&5 echo "${ECHO_T}$tcl_cv_DIR64" >&6 if test "x${tcl_cv_DIR64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_DIR64 1 _ACEOF fi echo "$as_me:$LINENO: checking for struct stat64" >&5 echo $ECHO_N "checking for struct stat64... $ECHO_C" >&6 if test "${tcl_cv_struct_stat64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct stat64 p; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_struct_stat64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_struct_stat64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_struct_stat64" >&5 echo "${ECHO_T}$tcl_cv_struct_stat64" >&6 if test "x${tcl_cv_struct_stat64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_STRUCT_STAT64 1 _ACEOF fi for ac_func in open64 lseek64 do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking for off64_t" >&5 echo $ECHO_N "checking for off64_t... $ECHO_C" >&6 if test "${tcl_cv_type_off64_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { off64_t offset; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_off64_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_type_off64_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TYPE_OFF64_T 1 _ACEOF echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi #-------------------------------------------------------------------- # Check endianness because we can optimize comparisons of # Tcl_UniChar strings to memcmp on big-endian systems. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6 if test "${ac_cv_c_bigendian+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # See if sys/param.h defines the BYTE_ORDER macro. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN bogus endian macros #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then # It does; now see whether it defined to BIG_ENDIAN or not. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if BYTE_ORDER != BIG_ENDIAN not big endian #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_bigendian=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # It does not; compile a test program. if test "$cross_compiling" = yes; then # try to guess the endianness by grepping values into an object file ac_cv_c_bigendian=unknown cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } int main () { _ascii (); _ebcdic (); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then ac_cv_c_bigendian=yes fi if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then if test "$ac_cv_c_bigendian" = unknown; then ac_cv_c_bigendian=no else # finding both strings is unlikely to happen, but who knows? ac_cv_c_bigendian=unknown fi fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* Are we little or big endian? From Harbison&Steele. */ union { long l; char c[sizeof (long)]; } u; u.l = 1; exit (u.c[sizeof (long) - 1] == 1); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_c_bigendian=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 echo "${ECHO_T}$ac_cv_c_bigendian" >&6 case $ac_cv_c_bigendian in yes) cat >>confdefs.h <<\_ACEOF #define WORDS_BIGENDIAN 1 _ACEOF ;; no) ;; *) { { echo "$as_me:$LINENO: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&5 echo "$as_me: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&2;} { (exit 1); exit 1; }; } ;; esac #-------------------------------------------------------------------- # Supply substitutes for missing POSIX library procedures, or # set flags so Tcl uses alternate procedures. #-------------------------------------------------------------------- # Check if Posix compliant getcwd exists, if not we'll use getwd. for ac_func in getcwd do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF else cat >>confdefs.h <<\_ACEOF #define USEGETWD 1 _ACEOF fi done # Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really # define USEGETWD even if the Posix getcwd exists. Add a test ? for ac_func in mkstemp opendir strtol waitpid do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF else case $LIBOBJS in "$ac_func.$ac_objext" | \ *" $ac_func.$ac_objext" | \ "$ac_func.$ac_objext "* | \ *" $ac_func.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS $ac_func.$ac_objext" ;; esac fi done echo "$as_me:$LINENO: checking for strerror" >&5 echo $ECHO_N "checking for strerror... $ECHO_C" >&6 if test "${ac_cv_func_strerror+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strerror to an innocuous variant, in case declares strerror. For example, HP-UX 11i declares gettimeofday. */ #define strerror innocuous_strerror /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strerror (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strerror /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strerror (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strerror) || defined (__stub___strerror) choke me #else char (*f) () = strerror; #endif #ifdef __cplusplus } #endif int main () { return f != strerror; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strerror=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strerror=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strerror" >&5 echo "${ECHO_T}$ac_cv_func_strerror" >&6 if test $ac_cv_func_strerror = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_STRERROR 1 _ACEOF fi echo "$as_me:$LINENO: checking for getwd" >&5 echo $ECHO_N "checking for getwd... $ECHO_C" >&6 if test "${ac_cv_func_getwd+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getwd to an innocuous variant, in case declares getwd. For example, HP-UX 11i declares gettimeofday. */ #define getwd innocuous_getwd /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getwd (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getwd /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getwd (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getwd) || defined (__stub___getwd) choke me #else char (*f) () = getwd; #endif #ifdef __cplusplus } #endif int main () { return f != getwd; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getwd=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getwd=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getwd" >&5 echo "${ECHO_T}$ac_cv_func_getwd" >&6 if test $ac_cv_func_getwd = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_GETWD 1 _ACEOF fi echo "$as_me:$LINENO: checking for wait3" >&5 echo $ECHO_N "checking for wait3... $ECHO_C" >&6 if test "${ac_cv_func_wait3+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define wait3 to an innocuous variant, in case declares wait3. For example, HP-UX 11i declares gettimeofday. */ #define wait3 innocuous_wait3 /* System header to define __stub macros and hopefully few prototypes, which can conflict with char wait3 (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef wait3 /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char wait3 (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_wait3) || defined (__stub___wait3) choke me #else char (*f) () = wait3; #endif #ifdef __cplusplus } #endif int main () { return f != wait3; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_wait3=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_wait3=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_wait3" >&5 echo "${ECHO_T}$ac_cv_func_wait3" >&6 if test $ac_cv_func_wait3 = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_WAIT3 1 _ACEOF fi echo "$as_me:$LINENO: checking for fork" >&5 echo $ECHO_N "checking for fork... $ECHO_C" >&6 if test "${ac_cv_func_fork+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define fork to an innocuous variant, in case declares fork. For example, HP-UX 11i declares gettimeofday. */ #define fork innocuous_fork /* System header to define __stub macros and hopefully few prototypes, which can conflict with char fork (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef fork /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char fork (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_fork) || defined (__stub___fork) choke me #else char (*f) () = fork; #endif #ifdef __cplusplus } #endif int main () { return f != fork; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_fork=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_fork=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_fork" >&5 echo "${ECHO_T}$ac_cv_func_fork" >&6 if test $ac_cv_func_fork = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_FORK 1 _ACEOF fi echo "$as_me:$LINENO: checking for mknod" >&5 echo $ECHO_N "checking for mknod... $ECHO_C" >&6 if test "${ac_cv_func_mknod+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define mknod to an innocuous variant, in case declares mknod. For example, HP-UX 11i declares gettimeofday. */ #define mknod innocuous_mknod /* System header to define __stub macros and hopefully few prototypes, which can conflict with char mknod (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef mknod /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char mknod (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_mknod) || defined (__stub___mknod) choke me #else char (*f) () = mknod; #endif #ifdef __cplusplus } #endif int main () { return f != mknod; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_mknod=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_mknod=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_mknod" >&5 echo "${ECHO_T}$ac_cv_func_mknod" >&6 if test $ac_cv_func_mknod = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_MKNOD 1 _ACEOF fi echo "$as_me:$LINENO: checking for tcdrain" >&5 echo $ECHO_N "checking for tcdrain... $ECHO_C" >&6 if test "${ac_cv_func_tcdrain+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define tcdrain to an innocuous variant, in case declares tcdrain. For example, HP-UX 11i declares gettimeofday. */ #define tcdrain innocuous_tcdrain /* System header to define __stub macros and hopefully few prototypes, which can conflict with char tcdrain (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef tcdrain /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char tcdrain (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_tcdrain) || defined (__stub___tcdrain) choke me #else char (*f) () = tcdrain; #endif #ifdef __cplusplus } #endif int main () { return f != tcdrain; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_tcdrain=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_tcdrain=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_tcdrain" >&5 echo "${ECHO_T}$ac_cv_func_tcdrain" >&6 if test $ac_cv_func_tcdrain = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_TCDRAIN 1 _ACEOF fi echo "$as_me:$LINENO: checking for uname" >&5 echo $ECHO_N "checking for uname... $ECHO_C" >&6 if test "${ac_cv_func_uname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define uname to an innocuous variant, in case declares uname. For example, HP-UX 11i declares gettimeofday. */ #define uname innocuous_uname /* System header to define __stub macros and hopefully few prototypes, which can conflict with char uname (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef uname /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char uname (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_uname) || defined (__stub___uname) choke me #else char (*f) () = uname; #endif #ifdef __cplusplus } #endif int main () { return f != uname; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_uname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_uname=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_uname" >&5 echo "${ECHO_T}$ac_cv_func_uname" >&6 if test $ac_cv_func_uname = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_UNAME 1 _ACEOF fi if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \ test "`uname -r | awk -F. '{print $1}'`" -lt 7; then # prior to Darwin 7, realpath is not threadsafe, so don't # use it when threads are enabled, c.f. bug # 711232 ac_cv_func_realpath=no fi echo "$as_me:$LINENO: checking for realpath" >&5 echo $ECHO_N "checking for realpath... $ECHO_C" >&6 if test "${ac_cv_func_realpath+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define realpath to an innocuous variant, in case declares realpath. For example, HP-UX 11i declares gettimeofday. */ #define realpath innocuous_realpath /* System header to define __stub macros and hopefully few prototypes, which can conflict with char realpath (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef realpath /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char realpath (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_realpath) || defined (__stub___realpath) choke me #else char (*f) () = realpath; #endif #ifdef __cplusplus } #endif int main () { return f != realpath; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_realpath=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_realpath=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_realpath" >&5 echo "${ECHO_T}$ac_cv_func_realpath" >&6 if test $ac_cv_func_realpath = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_REALPATH 1 _ACEOF fi NEED_FAKE_RFC2553=0 for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF else NEED_FAKE_RFC2553=1 fi done echo "$as_me:$LINENO: checking for struct addrinfo" >&5 echo $ECHO_N "checking for struct addrinfo... $ECHO_C" >&6 if test "${ac_cv_type_struct_addrinfo+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { if ((struct addrinfo *) 0) return 0; if (sizeof (struct addrinfo)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_struct_addrinfo=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_struct_addrinfo=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_struct_addrinfo" >&5 echo "${ECHO_T}$ac_cv_type_struct_addrinfo" >&6 if test $ac_cv_type_struct_addrinfo = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_ADDRINFO 1 _ACEOF else NEED_FAKE_RFC2553=1 fi echo "$as_me:$LINENO: checking for struct in6_addr" >&5 echo $ECHO_N "checking for struct in6_addr... $ECHO_C" >&6 if test "${ac_cv_type_struct_in6_addr+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { if ((struct in6_addr *) 0) return 0; if (sizeof (struct in6_addr)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_struct_in6_addr=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_struct_in6_addr=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_struct_in6_addr" >&5 echo "${ECHO_T}$ac_cv_type_struct_in6_addr" >&6 if test $ac_cv_type_struct_in6_addr = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IN6_ADDR 1 _ACEOF else NEED_FAKE_RFC2553=1 fi echo "$as_me:$LINENO: checking for struct sockaddr_in6" >&5 echo $ECHO_N "checking for struct sockaddr_in6... $ECHO_C" >&6 if test "${ac_cv_type_struct_sockaddr_in6+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { if ((struct sockaddr_in6 *) 0) return 0; if (sizeof (struct sockaddr_in6)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_struct_sockaddr_in6=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_struct_sockaddr_in6=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_in6" >&5 echo "${ECHO_T}$ac_cv_type_struct_sockaddr_in6" >&6 if test $ac_cv_type_struct_sockaddr_in6 = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_SOCKADDR_IN6 1 _ACEOF else NEED_FAKE_RFC2553=1 fi echo "$as_me:$LINENO: checking for struct sockaddr_storage" >&5 echo $ECHO_N "checking for struct sockaddr_storage... $ECHO_C" >&6 if test "${ac_cv_type_struct_sockaddr_storage+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { if ((struct sockaddr_storage *) 0) return 0; if (sizeof (struct sockaddr_storage)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_struct_sockaddr_storage=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_struct_sockaddr_storage=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_storage" >&5 echo "${ECHO_T}$ac_cv_type_struct_sockaddr_storage" >&6 if test $ac_cv_type_struct_sockaddr_storage = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_SOCKADDR_STORAGE 1 _ACEOF else NEED_FAKE_RFC2553=1 fi if test "x$NEED_FAKE_RFC2553" = "x1"; then cat >>confdefs.h <<\_ACEOF #define NEED_FAKE_RFC2553 1 _ACEOF case $LIBOBJS in "fake-rfc2553.$ac_objext" | \ *" fake-rfc2553.$ac_objext" | \ "fake-rfc2553.$ac_objext "* | \ *" fake-rfc2553.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" ;; esac echo "$as_me:$LINENO: checking for strlcpy" >&5 echo $ECHO_N "checking for strlcpy... $ECHO_C" >&6 if test "${ac_cv_func_strlcpy+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strlcpy to an innocuous variant, in case declares strlcpy. For example, HP-UX 11i declares gettimeofday. */ #define strlcpy innocuous_strlcpy /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strlcpy (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strlcpy /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strlcpy (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strlcpy) || defined (__stub___strlcpy) choke me #else char (*f) () = strlcpy; #endif #ifdef __cplusplus } #endif int main () { return f != strlcpy; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strlcpy=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strlcpy=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strlcpy" >&5 echo "${ECHO_T}$ac_cv_func_strlcpy" >&6 fi #-------------------------------------------------------------------- # Look for thread-safe variants of some library functions. #-------------------------------------------------------------------- if test "${TCL_THREADS}" = 1; then echo "$as_me:$LINENO: checking for getpwuid_r" >&5 echo $ECHO_N "checking for getpwuid_r... $ECHO_C" >&6 if test "${ac_cv_func_getpwuid_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getpwuid_r to an innocuous variant, in case declares getpwuid_r. For example, HP-UX 11i declares gettimeofday. */ #define getpwuid_r innocuous_getpwuid_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getpwuid_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getpwuid_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getpwuid_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getpwuid_r) || defined (__stub___getpwuid_r) choke me #else char (*f) () = getpwuid_r; #endif #ifdef __cplusplus } #endif int main () { return f != getpwuid_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getpwuid_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getpwuid_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getpwuid_r" >&5 echo "${ECHO_T}$ac_cv_func_getpwuid_r" >&6 if test $ac_cv_func_getpwuid_r = yes; then echo "$as_me:$LINENO: checking for getpwuid_r with 5 args" >&5 echo $ECHO_N "checking for getpwuid_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_getpwuid_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { uid_t uid; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getpwuid_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getpwuid_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_getpwuid_r_5" >&6 tcl_ok=$tcl_cv_api_getpwuid_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWUID_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for getpwuid_r with 4 args" >&5 echo $ECHO_N "checking for getpwuid_r with 4 args... $ECHO_C" >&6 if test "${tcl_cv_api_getpwuid_r_4+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { uid_t uid; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(uid, &pw, buf, buflen); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getpwuid_r_4=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getpwuid_r_4=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_4" >&5 echo "${ECHO_T}$tcl_cv_api_getpwuid_r_4" >&6 tcl_ok=$tcl_cv_api_getpwuid_r_4 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWUID_R_4 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWUID_R 1 _ACEOF fi fi echo "$as_me:$LINENO: checking for getpwnam_r" >&5 echo $ECHO_N "checking for getpwnam_r... $ECHO_C" >&6 if test "${ac_cv_func_getpwnam_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getpwnam_r to an innocuous variant, in case declares getpwnam_r. For example, HP-UX 11i declares gettimeofday. */ #define getpwnam_r innocuous_getpwnam_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getpwnam_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getpwnam_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getpwnam_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getpwnam_r) || defined (__stub___getpwnam_r) choke me #else char (*f) () = getpwnam_r; #endif #ifdef __cplusplus } #endif int main () { return f != getpwnam_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getpwnam_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getpwnam_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getpwnam_r" >&5 echo "${ECHO_T}$ac_cv_func_getpwnam_r" >&6 if test $ac_cv_func_getpwnam_r = yes; then echo "$as_me:$LINENO: checking for getpwnam_r with 5 args" >&5 echo $ECHO_N "checking for getpwnam_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_getpwnam_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { char *name; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwnam_r(name, &pw, buf, buflen, &pwp); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getpwnam_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getpwnam_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_getpwnam_r_5" >&6 tcl_ok=$tcl_cv_api_getpwnam_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWNAM_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for getpwnam_r with 4 args" >&5 echo $ECHO_N "checking for getpwnam_r with 4 args... $ECHO_C" >&6 if test "${tcl_cv_api_getpwnam_r_4+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { char *name; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(name, &pw, buf, buflen); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getpwnam_r_4=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getpwnam_r_4=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_4" >&5 echo "${ECHO_T}$tcl_cv_api_getpwnam_r_4" >&6 tcl_ok=$tcl_cv_api_getpwnam_r_4 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWNAM_R_4 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETPWNAM_R 1 _ACEOF fi fi echo "$as_me:$LINENO: checking for getgrgid_r" >&5 echo $ECHO_N "checking for getgrgid_r... $ECHO_C" >&6 if test "${ac_cv_func_getgrgid_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getgrgid_r to an innocuous variant, in case declares getgrgid_r. For example, HP-UX 11i declares gettimeofday. */ #define getgrgid_r innocuous_getgrgid_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getgrgid_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getgrgid_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getgrgid_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getgrgid_r) || defined (__stub___getgrgid_r) choke me #else char (*f) () = getgrgid_r; #endif #ifdef __cplusplus } #endif int main () { return f != getgrgid_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getgrgid_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getgrgid_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getgrgid_r" >&5 echo "${ECHO_T}$ac_cv_func_getgrgid_r" >&6 if test $ac_cv_func_getgrgid_r = yes; then echo "$as_me:$LINENO: checking for getgrgid_r with 5 args" >&5 echo $ECHO_N "checking for getgrgid_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_getgrgid_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { gid_t gid; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrgid_r(gid, &gr, buf, buflen, &grp); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getgrgid_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getgrgid_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_getgrgid_r_5" >&6 tcl_ok=$tcl_cv_api_getgrgid_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRGID_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for getgrgid_r with 4 args" >&5 echo $ECHO_N "checking for getgrgid_r with 4 args... $ECHO_C" >&6 if test "${tcl_cv_api_getgrgid_r_4+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { gid_t gid; struct group gr; char buf[512]; int buflen = 512; (void)getgrgid_r(gid, &gr, buf, buflen); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getgrgid_r_4=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getgrgid_r_4=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_4" >&5 echo "${ECHO_T}$tcl_cv_api_getgrgid_r_4" >&6 tcl_ok=$tcl_cv_api_getgrgid_r_4 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRGID_R_4 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRGID_R 1 _ACEOF fi fi echo "$as_me:$LINENO: checking for getgrnam_r" >&5 echo $ECHO_N "checking for getgrnam_r... $ECHO_C" >&6 if test "${ac_cv_func_getgrnam_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define getgrnam_r to an innocuous variant, in case declares getgrnam_r. For example, HP-UX 11i declares gettimeofday. */ #define getgrnam_r innocuous_getgrnam_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getgrnam_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef getgrnam_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char getgrnam_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getgrnam_r) || defined (__stub___getgrnam_r) choke me #else char (*f) () = getgrnam_r; #endif #ifdef __cplusplus } #endif int main () { return f != getgrnam_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_getgrnam_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_getgrnam_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_getgrnam_r" >&5 echo "${ECHO_T}$ac_cv_func_getgrnam_r" >&6 if test $ac_cv_func_getgrnam_r = yes; then echo "$as_me:$LINENO: checking for getgrnam_r with 5 args" >&5 echo $ECHO_N "checking for getgrnam_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_getgrnam_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { char *name; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrnam_r(name, &gr, buf, buflen, &grp); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getgrnam_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getgrnam_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_getgrnam_r_5" >&6 tcl_ok=$tcl_cv_api_getgrnam_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRNAM_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for getgrnam_r with 4 args" >&5 echo $ECHO_N "checking for getgrnam_r with 4 args... $ECHO_C" >&6 if test "${tcl_cv_api_getgrnam_r_4+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { char *name; struct group gr; char buf[512]; int buflen = 512; (void)getgrnam_r(name, &gr, buf, buflen); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_getgrnam_r_4=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_getgrnam_r_4=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_4" >&5 echo "${ECHO_T}$tcl_cv_api_getgrnam_r_4" >&6 tcl_ok=$tcl_cv_api_getgrnam_r_4 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRNAM_R_4 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETGRNAM_R 1 _ACEOF fi fi if test "`uname -s`" = "Darwin" && \ test "`uname -r | awk -F. '{print $1}'`" -gt 5; then # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. cat >>confdefs.h <<\_ACEOF #define HAVE_MTSAFE_GETHOSTBYNAME 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define HAVE_MTSAFE_GETHOSTBYADDR 1 _ACEOF elif test "`uname -s`" = "HP-UX" && \ test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then # Starting with HPUX 11.00 (we believe), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. cat >>confdefs.h <<\_ACEOF #define HAVE_MTSAFE_GETHOSTBYNAME 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define HAVE_MTSAFE_GETHOSTBYADDR 1 _ACEOF else # Avoids picking hidden internal symbol from libc echo "$as_me:$LINENO: checking whether gethostbyname_r is declared" >&5 echo $ECHO_N "checking whether gethostbyname_r is declared... $ECHO_C" >&6 if test "${ac_cv_have_decl_gethostbyname_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { #ifndef gethostbyname_r char *p = (char *) gethostbyname_r; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_gethostbyname_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_gethostbyname_r=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_have_decl_gethostbyname_r" >&5 echo "${ECHO_T}$ac_cv_have_decl_gethostbyname_r" >&6 if test $ac_cv_have_decl_gethostbyname_r = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_GETHOSTBYNAME_R 1 _ACEOF tcl_cv_api_gethostbyname_r=yes else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_GETHOSTBYNAME_R 0 _ACEOF tcl_cv_api_gethostbyname_r=no fi if test "$tcl_cv_api_gethostbyname_r" = yes; then echo "$as_me:$LINENO: checking for gethostbyname_r" >&5 echo $ECHO_N "checking for gethostbyname_r... $ECHO_C" >&6 if test "${ac_cv_func_gethostbyname_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gethostbyname_r to an innocuous variant, in case declares gethostbyname_r. For example, HP-UX 11i declares gettimeofday. */ #define gethostbyname_r innocuous_gethostbyname_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gethostbyname_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyname_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gethostbyname_r) || defined (__stub___gethostbyname_r) choke me #else char (*f) () = gethostbyname_r; #endif #ifdef __cplusplus } #endif int main () { return f != gethostbyname_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gethostbyname_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gethostbyname_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname_r" >&5 echo "${ECHO_T}$ac_cv_func_gethostbyname_r" >&6 if test $ac_cv_func_gethostbyname_r = yes; then echo "$as_me:$LINENO: checking for gethostbyname_r with 6 args" >&5 echo $ECHO_N "checking for gethostbyname_r with 6 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyname_r_6+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *name; struct hostent *he, *res; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyname_r_6=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyname_r_6=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_6" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_6" >&6 tcl_ok=$tcl_cv_api_gethostbyname_r_6 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYNAME_R_6 1 _ACEOF else echo "$as_me:$LINENO: checking for gethostbyname_r with 5 args" >&5 echo $ECHO_N "checking for gethostbyname_r with 5 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyname_r_5+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *name; struct hostent *he; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyname_r_5=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyname_r_5=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_5" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_5" >&6 tcl_ok=$tcl_cv_api_gethostbyname_r_5 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYNAME_R_5 1 _ACEOF else echo "$as_me:$LINENO: checking for gethostbyname_r with 3 args" >&5 echo $ECHO_N "checking for gethostbyname_r with 3 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyname_r_3+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *name; struct hostent *he; struct hostent_data data; (void) gethostbyname_r(name, he, &data); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyname_r_3=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyname_r_3=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_3" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_3" >&6 tcl_ok=$tcl_cv_api_gethostbyname_r_3 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYNAME_R_3 1 _ACEOF fi fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYNAME_R 1 _ACEOF fi fi fi # Avoids picking hidden internal symbol from libc echo "$as_me:$LINENO: checking whether gethostbyaddr_r is declared" >&5 echo $ECHO_N "checking whether gethostbyaddr_r is declared... $ECHO_C" >&6 if test "${ac_cv_have_decl_gethostbyaddr_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { #ifndef gethostbyaddr_r char *p = (char *) gethostbyaddr_r; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_gethostbyaddr_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_gethostbyaddr_r=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_have_decl_gethostbyaddr_r" >&5 echo "${ECHO_T}$ac_cv_have_decl_gethostbyaddr_r" >&6 if test $ac_cv_have_decl_gethostbyaddr_r = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_GETHOSTBYADDR_R 1 _ACEOF tcl_cv_api_gethostbyaddr_r=yes else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_GETHOSTBYADDR_R 0 _ACEOF tcl_cv_api_gethostbyaddr_r=no fi if test "$tcl_cv_api_gethostbyaddr_r" = yes; then echo "$as_me:$LINENO: checking for gethostbyaddr_r" >&5 echo $ECHO_N "checking for gethostbyaddr_r... $ECHO_C" >&6 if test "${ac_cv_func_gethostbyaddr_r+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gethostbyaddr_r to an innocuous variant, in case declares gethostbyaddr_r. For example, HP-UX 11i declares gettimeofday. */ #define gethostbyaddr_r innocuous_gethostbyaddr_r /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyaddr_r (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gethostbyaddr_r /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyaddr_r (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gethostbyaddr_r) || defined (__stub___gethostbyaddr_r) choke me #else char (*f) () = gethostbyaddr_r; #endif #ifdef __cplusplus } #endif int main () { return f != gethostbyaddr_r; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gethostbyaddr_r=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gethostbyaddr_r=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyaddr_r" >&5 echo "${ECHO_T}$ac_cv_func_gethostbyaddr_r" >&6 if test $ac_cv_func_gethostbyaddr_r = yes; then echo "$as_me:$LINENO: checking for gethostbyaddr_r with 7 args" >&5 echo $ECHO_N "checking for gethostbyaddr_r with 7 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyaddr_r_7+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *addr; int length; int type; struct hostent *result; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &h_errnop); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyaddr_r_7=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyaddr_r_7=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_7" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_7" >&6 tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYADDR_R_7 1 _ACEOF else echo "$as_me:$LINENO: checking for gethostbyaddr_r with 8 args" >&5 echo $ECHO_N "checking for gethostbyaddr_r with 8 args... $ECHO_C" >&6 if test "${tcl_cv_api_gethostbyaddr_r_8+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *addr; int length; int type; struct hostent *result, *resultp; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &resultp, &h_errnop); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_gethostbyaddr_r_8=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_gethostbyaddr_r_8=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_8" >&5 echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_8" >&6 tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYADDR_R_8 1 _ACEOF fi fi if test "$tcl_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETHOSTBYADDR_R 1 _ACEOF fi fi fi fi fi #--------------------------------------------------------------------------- # Check for serial port interface. # # termios.h is present on all POSIX systems. # sys/ioctl.h is almost always present, though what it contains # is system-specific. # sys/modem.h is needed on HP-UX. #--------------------------------------------------------------------------- for ac_header in termios.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/ioctl.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/modem.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done #-------------------------------------------------------------------- # Include sys/select.h if it exists and if it supplies things # that appear to be useful and aren't already in sys/types.h. # This appears to be true only on the RS/6000 under AIX. Some # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for fd_set in sys/types" >&5 echo $ECHO_N "checking for fd_set in sys/types... $ECHO_C" >&6 if test "${tcl_cv_type_fd_set+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { fd_set readMask, writeMask; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_fd_set=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_type_fd_set=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_type_fd_set" >&5 echo "${ECHO_T}$tcl_cv_type_fd_set" >&6 tcl_ok=$tcl_cv_type_fd_set if test $tcl_ok = no; then echo "$as_me:$LINENO: checking for fd_mask in sys/select" >&5 echo $ECHO_N "checking for fd_mask in sys/select... $ECHO_C" >&6 if test "${tcl_cv_grep_fd_mask+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "fd_mask" >/dev/null 2>&1; then tcl_cv_grep_fd_mask=present else tcl_cv_grep_fd_mask=missing fi rm -f conftest* fi echo "$as_me:$LINENO: result: $tcl_cv_grep_fd_mask" >&5 echo "${ECHO_T}$tcl_cv_grep_fd_mask" >&6 if test $tcl_cv_grep_fd_mask = present; then cat >>confdefs.h <<\_ACEOF #define HAVE_SYS_SELECT_H 1 _ACEOF tcl_ok=yes fi fi if test $tcl_ok = no; then cat >>confdefs.h <<\_ACEOF #define NO_FD_SET 1 _ACEOF fi #------------------------------------------------------------------------------ # Find out all about time handling differences. #------------------------------------------------------------------------------ for ac_header in sys/time.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6 if test "${ac_cv_header_time+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main () { if ((struct tm *) 0) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_time=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_time=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 echo "${ECHO_T}$ac_cv_header_time" >&6 if test $ac_cv_header_time = yes; then cat >>confdefs.h <<\_ACEOF #define TIME_WITH_SYS_TIME 1 _ACEOF fi for ac_func in gmtime_r localtime_r mktime do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking tm_tzadj in struct tm" >&5 echo $ECHO_N "checking tm_tzadj in struct tm... $ECHO_C" >&6 if test "${tcl_cv_member_tm_tzadj+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct tm tm; (void)tm.tm_tzadj; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_member_tm_tzadj=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_member_tm_tzadj=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_member_tm_tzadj" >&5 echo "${ECHO_T}$tcl_cv_member_tm_tzadj" >&6 if test $tcl_cv_member_tm_tzadj = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TM_TZADJ 1 _ACEOF fi echo "$as_me:$LINENO: checking tm_gmtoff in struct tm" >&5 echo $ECHO_N "checking tm_gmtoff in struct tm... $ECHO_C" >&6 if test "${tcl_cv_member_tm_gmtoff+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct tm tm; (void)tm.tm_gmtoff; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_member_tm_gmtoff=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_member_tm_gmtoff=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_member_tm_gmtoff" >&5 echo "${ECHO_T}$tcl_cv_member_tm_gmtoff" >&6 if test $tcl_cv_member_tm_gmtoff = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TM_GMTOFF 1 _ACEOF fi # # Its important to include time.h in this check, as some systems # (like convex) have timezone functions, etc. # echo "$as_me:$LINENO: checking long timezone variable" >&5 echo $ECHO_N "checking long timezone variable... $ECHO_C" >&6 if test "${tcl_cv_timezone_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { extern long timezone; timezone += 1; exit (0); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_timezone_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_timezone_long=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_timezone_long" >&5 echo "${ECHO_T}$tcl_cv_timezone_long" >&6 if test $tcl_cv_timezone_long = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TIMEZONE_VAR 1 _ACEOF else # # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. # echo "$as_me:$LINENO: checking time_t timezone variable" >&5 echo $ECHO_N "checking time_t timezone variable... $ECHO_C" >&6 if test "${tcl_cv_timezone_time+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { extern time_t timezone; timezone += 1; exit (0); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_timezone_time=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_timezone_time=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_timezone_time" >&5 echo "${ECHO_T}$tcl_cv_timezone_time" >&6 if test $tcl_cv_timezone_time = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TIMEZONE_VAR 1 _ACEOF fi fi #-------------------------------------------------------------------- # Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But # we might be able to use fstatfs instead. Some systems (OpenBSD?) also # lack blkcnt_t. #-------------------------------------------------------------------- if test "$ac_cv_cygwin" != "yes"; then echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5 echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6 if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static struct stat ac_aggr; if (ac_aggr.st_blocks) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_stat_st_blocks=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static struct stat ac_aggr; if (sizeof ac_aggr.st_blocks) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_stat_st_blocks=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_stat_st_blocks=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blocks" >&5 echo "${ECHO_T}$ac_cv_member_struct_stat_st_blocks" >&6 if test $ac_cv_member_struct_stat_st_blocks = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_STAT_ST_BLOCKS 1 _ACEOF fi echo "$as_me:$LINENO: checking for struct stat.st_blksize" >&5 echo $ECHO_N "checking for struct stat.st_blksize... $ECHO_C" >&6 if test "${ac_cv_member_struct_stat_st_blksize+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static struct stat ac_aggr; if (ac_aggr.st_blksize) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_stat_st_blksize=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static struct stat ac_aggr; if (sizeof ac_aggr.st_blksize) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_stat_st_blksize=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_stat_st_blksize=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blksize" >&5 echo "${ECHO_T}$ac_cv_member_struct_stat_st_blksize" >&6 if test $ac_cv_member_struct_stat_st_blksize = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_STAT_ST_BLKSIZE 1 _ACEOF fi fi echo "$as_me:$LINENO: checking for blkcnt_t" >&5 echo $ECHO_N "checking for blkcnt_t... $ECHO_C" >&6 if test "${ac_cv_type_blkcnt_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((blkcnt_t *) 0) return 0; if (sizeof (blkcnt_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_blkcnt_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_blkcnt_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_blkcnt_t" >&5 echo "${ECHO_T}$ac_cv_type_blkcnt_t" >&6 if test $ac_cv_type_blkcnt_t = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_BLKCNT_T 1 _ACEOF fi echo "$as_me:$LINENO: checking for fstatfs" >&5 echo $ECHO_N "checking for fstatfs... $ECHO_C" >&6 if test "${ac_cv_func_fstatfs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define fstatfs to an innocuous variant, in case declares fstatfs. For example, HP-UX 11i declares gettimeofday. */ #define fstatfs innocuous_fstatfs /* System header to define __stub macros and hopefully few prototypes, which can conflict with char fstatfs (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef fstatfs /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char fstatfs (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_fstatfs) || defined (__stub___fstatfs) choke me #else char (*f) () = fstatfs; #endif #ifdef __cplusplus } #endif int main () { return f != fstatfs; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_fstatfs=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_fstatfs=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_fstatfs" >&5 echo "${ECHO_T}$ac_cv_func_fstatfs" >&6 if test $ac_cv_func_fstatfs = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_FSTATFS 1 _ACEOF fi #-------------------------------------------------------------------- # Some system have no memcmp or it does not work with 8 bit data, this # checks it and add memcmp.o to LIBOBJS if needed #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for working memcmp" >&5 echo $ECHO_N "checking for working memcmp... $ECHO_C" >&6 if test "${ac_cv_func_memcmp_working+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then ac_cv_func_memcmp_working=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { /* Some versions of memcmp are not 8-bit clean. */ char c0 = 0x40, c1 = 0x80, c2 = 0x81; if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0) exit (1); /* The Next x86 OpenStep bug shows up only when comparing 16 bytes or more and with at least one buffer not starting on a 4-byte boundary. William Lewis provided this test program. */ { char foo[21]; char bar[21]; int i; for (i = 0; i < 4; i++) { char *a = foo + i; char *b = bar + i; strcpy (a, "--------01111111"); strcpy (b, "--------10000000"); if (memcmp (a, b, 16) >= 0) exit (1); } exit (0); } ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_memcmp_working=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_memcmp_working=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5 echo "${ECHO_T}$ac_cv_func_memcmp_working" >&6 test $ac_cv_func_memcmp_working = no && case $LIBOBJS in "memcmp.$ac_objext" | \ *" memcmp.$ac_objext" | \ "memcmp.$ac_objext "* | \ *" memcmp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" ;; esac #-------------------------------------------------------------------- # Some system like SunOS 4 and other BSD like systems have no memmove # (we assume they have bcopy instead). {The replacement define is in # compat/string.h} #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for memmove" >&5 echo $ECHO_N "checking for memmove... $ECHO_C" >&6 if test "${ac_cv_func_memmove+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define memmove to an innocuous variant, in case declares memmove. For example, HP-UX 11i declares gettimeofday. */ #define memmove innocuous_memmove /* System header to define __stub macros and hopefully few prototypes, which can conflict with char memmove (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef memmove /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char memmove (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_memmove) || defined (__stub___memmove) choke me #else char (*f) () = memmove; #endif #ifdef __cplusplus } #endif int main () { return f != memmove; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_memmove=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_memmove=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_memmove" >&5 echo "${ECHO_T}$ac_cv_func_memmove" >&6 if test $ac_cv_func_memmove = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_MEMMOVE 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define NO_STRING_H 1 _ACEOF fi #-------------------------------------------------------------------- # On some systems strstr is broken: it returns a pointer even if # the original string is empty. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for strstr" >&5 echo $ECHO_N "checking for strstr... $ECHO_C" >&6 if test "${ac_cv_func_strstr+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strstr to an innocuous variant, in case declares strstr. For example, HP-UX 11i declares gettimeofday. */ #define strstr innocuous_strstr /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strstr (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strstr /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strstr (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strstr) || defined (__stub___strstr) choke me #else char (*f) () = strstr; #endif #ifdef __cplusplus } #endif int main () { return f != strstr; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strstr=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strstr=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strstr" >&5 echo "${ECHO_T}$ac_cv_func_strstr" >&6 if test $ac_cv_func_strstr = yes; then tcl_ok=1 else tcl_ok=0 fi if test "$tcl_ok" = 1; then echo "$as_me:$LINENO: checking proper strstr implementation" >&5 echo $ECHO_N "checking proper strstr implementation... $ECHO_C" >&6 if test "${tcl_cv_strstr_unbroken+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_strstr_unbroken=unknown else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main() { exit(strstr("\0test", "test") ? 1 : 0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_strstr_unbroken=ok else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) tcl_cv_strstr_unbroken=broken fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $tcl_cv_strstr_unbroken" >&5 echo "${ECHO_T}$tcl_cv_strstr_unbroken" >&6 if test "$tcl_cv_strstr_unbroken" = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then case $LIBOBJS in "strstr.$ac_objext" | \ *" strstr.$ac_objext" | \ "strstr.$ac_objext "* | \ *" strstr.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS strstr.$ac_objext" ;; esac USE_COMPAT=1 fi #-------------------------------------------------------------------- # Check for strtoul function. This is tricky because under some # versions of AIX strtoul returns an incorrect terminator # pointer for the string "0". #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for strtoul" >&5 echo $ECHO_N "checking for strtoul... $ECHO_C" >&6 if test "${ac_cv_func_strtoul+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strtoul to an innocuous variant, in case declares strtoul. For example, HP-UX 11i declares gettimeofday. */ #define strtoul innocuous_strtoul /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strtoul (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strtoul /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strtoul (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strtoul) || defined (__stub___strtoul) choke me #else char (*f) () = strtoul; #endif #ifdef __cplusplus } #endif int main () { return f != strtoul; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strtoul=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strtoul=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strtoul" >&5 echo "${ECHO_T}$ac_cv_func_strtoul" >&6 if test $ac_cv_func_strtoul = yes; then tcl_ok=1 else tcl_ok=0 fi if test "$tcl_ok" = 1; then echo "$as_me:$LINENO: checking proper strtoul implementation" >&5 echo $ECHO_N "checking proper strtoul implementation... $ECHO_C" >&6 if test "${tcl_cv_strtoul_unbroken+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_strtoul_unbroken=unknown else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main() { char *term, *string = "0"; exit(strtoul(string,&term,0) != 0 || term != string+1); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_strtoul_unbroken=ok else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) tcl_cv_strtoul_unbroken=broken fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $tcl_cv_strtoul_unbroken" >&5 echo "${ECHO_T}$tcl_cv_strtoul_unbroken" >&6 if test "$tcl_cv_strtoul_unbroken" = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then case $LIBOBJS in "strtoul.$ac_objext" | \ *" strtoul.$ac_objext" | \ "strtoul.$ac_objext "* | \ *" strtoul.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS strtoul.$ac_objext" ;; esac USE_COMPAT=1 fi #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for mode_t" >&5 echo $ECHO_N "checking for mode_t... $ECHO_C" >&6 if test "${ac_cv_type_mode_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((mode_t *) 0) return 0; if (sizeof (mode_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_mode_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_mode_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_mode_t" >&5 echo "${ECHO_T}$ac_cv_type_mode_t" >&6 if test $ac_cv_type_mode_t = yes; then : else cat >>confdefs.h <<_ACEOF #define mode_t int _ACEOF fi echo "$as_me:$LINENO: checking for pid_t" >&5 echo $ECHO_N "checking for pid_t... $ECHO_C" >&6 if test "${ac_cv_type_pid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((pid_t *) 0) return 0; if (sizeof (pid_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_pid_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_pid_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5 echo "${ECHO_T}$ac_cv_type_pid_t" >&6 if test $ac_cv_type_pid_t = yes; then : else cat >>confdefs.h <<_ACEOF #define pid_t int _ACEOF fi echo "$as_me:$LINENO: checking for size_t" >&5 echo $ECHO_N "checking for size_t... $ECHO_C" >&6 if test "${ac_cv_type_size_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((size_t *) 0) return 0; if (sizeof (size_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_size_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_size_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_size_t" >&5 echo "${ECHO_T}$ac_cv_type_size_t" >&6 if test $ac_cv_type_size_t = yes; then : else cat >>confdefs.h <<_ACEOF #define size_t unsigned _ACEOF fi echo "$as_me:$LINENO: checking for uid_t in sys/types.h" >&5 echo $ECHO_N "checking for uid_t in sys/types.h... $ECHO_C" >&6 if test "${ac_cv_type_uid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "uid_t" >/dev/null 2>&1; then ac_cv_type_uid_t=yes else ac_cv_type_uid_t=no fi rm -f conftest* fi echo "$as_me:$LINENO: result: $ac_cv_type_uid_t" >&5 echo "${ECHO_T}$ac_cv_type_uid_t" >&6 if test $ac_cv_type_uid_t = no; then cat >>confdefs.h <<\_ACEOF #define uid_t int _ACEOF cat >>confdefs.h <<\_ACEOF #define gid_t int _ACEOF fi echo "$as_me:$LINENO: checking for socklen_t" >&5 echo $ECHO_N "checking for socklen_t... $ECHO_C" >&6 if test "${tcl_cv_type_socklen_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { socklen_t foo; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_socklen_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_type_socklen_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_type_socklen_t" >&5 echo "${ECHO_T}$tcl_cv_type_socklen_t" >&6 if test $tcl_cv_type_socklen_t = no; then cat >>confdefs.h <<\_ACEOF #define socklen_t int _ACEOF fi echo "$as_me:$LINENO: checking for intptr_t" >&5 echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 if test "${ac_cv_type_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((intptr_t *) 0) return 0; if (sizeof (intptr_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_intptr_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_intptr_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 if test $ac_cv_type_intptr_t = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_INTPTR_T 1 _ACEOF else echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 if test "${tcl_cv_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for tcl_cv_intptr_t in "int" "long" "long long" none; do if test "$tcl_cv_intptr_t" != none; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_ok=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 echo "${ECHO_T}$tcl_cv_intptr_t" >&6 if test "$tcl_cv_intptr_t" != none; then cat >>confdefs.h <<_ACEOF #define intptr_t $tcl_cv_intptr_t _ACEOF fi fi echo "$as_me:$LINENO: checking for uintptr_t" >&5 echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 if test "${ac_cv_type_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((uintptr_t *) 0) return 0; if (sizeof (uintptr_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_uintptr_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_uintptr_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 if test $ac_cv_type_uintptr_t = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_UINTPTR_T 1 _ACEOF else echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 if test "${tcl_cv_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ none; do if test "$tcl_cv_uintptr_t" != none; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_ok=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 if test "$tcl_cv_uintptr_t" != none; then cat >>confdefs.h <<_ACEOF #define uintptr_t $tcl_cv_uintptr_t _ACEOF fi fi #-------------------------------------------------------------------- # If a system doesn't have an opendir function (man, that's old!) # then we have to supply a different version of dirent.h which # is compatible with the substitute version of opendir that's # provided. This version only works with V7-style directories. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for opendir" >&5 echo $ECHO_N "checking for opendir... $ECHO_C" >&6 if test "${ac_cv_func_opendir+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define opendir to an innocuous variant, in case declares opendir. For example, HP-UX 11i declares gettimeofday. */ #define opendir innocuous_opendir /* System header to define __stub macros and hopefully few prototypes, which can conflict with char opendir (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef opendir /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char opendir (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_opendir) || defined (__stub___opendir) choke me #else char (*f) () = opendir; #endif #ifdef __cplusplus } #endif int main () { return f != opendir; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_opendir=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_opendir=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_opendir" >&5 echo "${ECHO_T}$ac_cv_func_opendir" >&6 if test $ac_cv_func_opendir = yes; then : else cat >>confdefs.h <<\_ACEOF #define USE_DIRENT2_H 1 _ACEOF fi #-------------------------------------------------------------------- # The check below checks whether defines the type # "union wait" correctly. It's needed because of weirdness in # HP-UX where "union wait" is defined in both the BSD and SYS-V # environments. Checking the usability of WIFEXITED seems to do # the trick. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking union wait" >&5 echo $ECHO_N "checking union wait... $ECHO_C" >&6 if test "${tcl_cv_union_wait+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { union wait x; WIFEXITED(x); /* Generates compiler error if WIFEXITED * uses an int. */ ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_union_wait=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_union_wait=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_union_wait" >&5 echo "${ECHO_T}$tcl_cv_union_wait" >&6 if test $tcl_cv_union_wait = no; then cat >>confdefs.h <<\_ACEOF #define NO_UNION_WAIT 1 _ACEOF fi #-------------------------------------------------------------------- # Check whether there is an strncasecmp function on this system. # This is a bit tricky because under SCO it's in -lsocket and # under Sequent Dynix it's in -linet. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for strncasecmp" >&5 echo $ECHO_N "checking for strncasecmp... $ECHO_C" >&6 if test "${ac_cv_func_strncasecmp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strncasecmp to an innocuous variant, in case declares strncasecmp. For example, HP-UX 11i declares gettimeofday. */ #define strncasecmp innocuous_strncasecmp /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strncasecmp (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strncasecmp /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strncasecmp (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strncasecmp) || defined (__stub___strncasecmp) choke me #else char (*f) () = strncasecmp; #endif #ifdef __cplusplus } #endif int main () { return f != strncasecmp; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strncasecmp=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strncasecmp=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strncasecmp" >&5 echo "${ECHO_T}$ac_cv_func_strncasecmp" >&6 if test $ac_cv_func_strncasecmp = yes; then tcl_ok=1 else tcl_ok=0 fi if test "$tcl_ok" = 0; then echo "$as_me:$LINENO: checking for strncasecmp in -lsocket" >&5 echo $ECHO_N "checking for strncasecmp in -lsocket... $ECHO_C" >&6 if test "${ac_cv_lib_socket_strncasecmp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strncasecmp (); int main () { strncasecmp (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_socket_strncasecmp=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_socket_strncasecmp=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_socket_strncasecmp" >&5 echo "${ECHO_T}$ac_cv_lib_socket_strncasecmp" >&6 if test $ac_cv_lib_socket_strncasecmp = yes; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then echo "$as_me:$LINENO: checking for strncasecmp in -linet" >&5 echo $ECHO_N "checking for strncasecmp in -linet... $ECHO_C" >&6 if test "${ac_cv_lib_inet_strncasecmp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strncasecmp (); int main () { strncasecmp (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_inet_strncasecmp=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_inet_strncasecmp=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_inet_strncasecmp" >&5 echo "${ECHO_T}$ac_cv_lib_inet_strncasecmp" >&6 if test $ac_cv_lib_inet_strncasecmp = yes; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then case $LIBOBJS in "strncasecmp.$ac_objext" | \ *" strncasecmp.$ac_objext" | \ "strncasecmp.$ac_objext "* | \ *" strncasecmp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext" ;; esac USE_COMPAT=1 fi #-------------------------------------------------------------------- # The code below deals with several issues related to gettimeofday: # 1. Some systems don't provide a gettimeofday function at all # (set NO_GETTOD if this is the case). # 2. See if gettimeofday is declared in the header file. # if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can # declare it. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for gettimeofday" >&5 echo $ECHO_N "checking for gettimeofday... $ECHO_C" >&6 if test "${ac_cv_func_gettimeofday+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gettimeofday to an innocuous variant, in case declares gettimeofday. For example, HP-UX 11i declares gettimeofday. */ #define gettimeofday innocuous_gettimeofday /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gettimeofday (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gettimeofday /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gettimeofday (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gettimeofday) || defined (__stub___gettimeofday) choke me #else char (*f) () = gettimeofday; #endif #ifdef __cplusplus } #endif int main () { return f != gettimeofday; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gettimeofday=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gettimeofday=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_gettimeofday" >&5 echo "${ECHO_T}$ac_cv_func_gettimeofday" >&6 if test $ac_cv_func_gettimeofday = yes; then : else cat >>confdefs.h <<\_ACEOF #define NO_GETTOD 1 _ACEOF fi echo "$as_me:$LINENO: checking for gettimeofday declaration" >&5 echo $ECHO_N "checking for gettimeofday declaration... $ECHO_C" >&6 if test "${tcl_cv_grep_gettimeofday+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "gettimeofday" >/dev/null 2>&1; then tcl_cv_grep_gettimeofday=present else tcl_cv_grep_gettimeofday=missing fi rm -f conftest* fi echo "$as_me:$LINENO: result: $tcl_cv_grep_gettimeofday" >&5 echo "${ECHO_T}$tcl_cv_grep_gettimeofday" >&6 if test $tcl_cv_grep_gettimeofday = missing ; then cat >>confdefs.h <<\_ACEOF #define GETTOD_NOT_DECLARED 1 _ACEOF fi #-------------------------------------------------------------------- # The following code checks to see whether it is possible to get # signed chars on this platform. This is needed in order to # properly generate sign-extended ints from character values. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether char is unsigned" >&5 echo $ECHO_N "checking whether char is unsigned... $ECHO_C" >&6 if test "${ac_cv_c_char_unsigned+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((char) -1) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_char_unsigned=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_char_unsigned=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_c_char_unsigned" >&5 echo "${ECHO_T}$ac_cv_c_char_unsigned" >&6 if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then cat >>confdefs.h <<\_ACEOF #define __CHAR_UNSIGNED__ 1 _ACEOF fi echo "$as_me:$LINENO: checking signed char declarations" >&5 echo $ECHO_N "checking signed char declarations... $ECHO_C" >&6 if test "${tcl_cv_char_signed+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { signed char *p; p = 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_char_signed=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_char_signed=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_char_signed" >&5 echo "${ECHO_T}$tcl_cv_char_signed" >&6 if test $tcl_cv_char_signed = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_SIGNED_CHAR 1 _ACEOF fi #-------------------------------------------------------------------- # Does putenv() copy or not? We need to know to avoid memory leaks. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for a putenv() that copies the buffer" >&5 echo $ECHO_N "checking for a putenv() that copies the buffer... $ECHO_C" >&6 if test "${tcl_cv_putenv_copy+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_putenv_copy=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #define OURVAR "havecopy=yes" int main (int argc, char *argv[]) { char *foo, *bar; foo = (char *)strdup(OURVAR); putenv(foo); strcpy((char *)(strchr(foo, '=') + 1), "no"); bar = getenv("havecopy"); if (!strcmp(bar, "no")) { /* doesnt copy */ return 0; } else { /* does copy */ return 1; } } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_putenv_copy=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) tcl_cv_putenv_copy=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $tcl_cv_putenv_copy" >&5 echo "${ECHO_T}$tcl_cv_putenv_copy" >&6 if test $tcl_cv_putenv_copy = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_PUTENV_THAT_COPIES 1 _ACEOF fi #-------------------------------------------------------------------- # Check for support of nl_langinfo function #-------------------------------------------------------------------- # Check whether --enable-langinfo or --disable-langinfo was given. if test "${enable_langinfo+set}" = set; then enableval="$enable_langinfo" langinfo_ok=$enableval else langinfo_ok=yes fi; HAVE_LANGINFO=0 if test "$langinfo_ok" = "yes"; then if test "${ac_cv_header_langinfo_h+set}" = set; then echo "$as_me:$LINENO: checking for langinfo.h" >&5 echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6 if test "${ac_cv_header_langinfo_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5 echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking langinfo.h usability" >&5 echo $ECHO_N "checking langinfo.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking langinfo.h presence" >&5 echo $ECHO_N "checking langinfo.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: langinfo.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: langinfo.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: langinfo.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: langinfo.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: langinfo.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: langinfo.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: langinfo.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: langinfo.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for langinfo.h" >&5 echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6 if test "${ac_cv_header_langinfo_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_langinfo_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5 echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6 fi if test $ac_cv_header_langinfo_h = yes; then langinfo_ok=yes else langinfo_ok=no fi fi echo "$as_me:$LINENO: checking whether to use nl_langinfo" >&5 echo $ECHO_N "checking whether to use nl_langinfo... $ECHO_C" >&6 if test "$langinfo_ok" = "yes"; then if test "${tcl_cv_langinfo_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { nl_langinfo(CODESET); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_langinfo_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_langinfo_h=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_langinfo_h" >&5 echo "${ECHO_T}$tcl_cv_langinfo_h" >&6 if test $tcl_cv_langinfo_h = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_LANGINFO 1 _ACEOF fi else echo "$as_me:$LINENO: result: $langinfo_ok" >&5 echo "${ECHO_T}$langinfo_ok" >&6 fi #-------------------------------------------------------------------- # Check for support of chflags and mkstemps functions #-------------------------------------------------------------------- for ac_func in chflags mkstemps do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done #-------------------------------------------------------------------- # Check for support of isnan() function or macro #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking isnan" >&5 echo $ECHO_N "checking isnan... $ECHO_C" >&6 if test "${tcl_cv_isnan+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { isnan(0.0); /* Generates an error if isnan is missing */ ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_isnan=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_isnan=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_isnan" >&5 echo "${ECHO_T}$tcl_cv_isnan" >&6 if test $tcl_cv_isnan = no; then cat >>confdefs.h <<\_ACEOF #define NO_ISNAN 1 _ACEOF fi #-------------------------------------------------------------------- # Darwin specific API checks and defines #-------------------------------------------------------------------- if test "`uname -s`" = "Darwin" ; then for ac_func in getattrlist do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in copyfile.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in copyfile do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done if test $tcl_corefoundation = yes; then for ac_header in libkern/OSAtomic.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in OSSpinLockLock do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done fi cat >>confdefs.h <<\_ACEOF #define TCL_DEFAULT_ENCODING "utf-8" _ACEOF cat >>confdefs.h <<\_ACEOF #define TCL_LOAD_FROM_MEMORY 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define TCL_WIDE_CLICKS 1 _ACEOF for ac_header in AvailabilityMacros.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "$ac_cv_header_AvailabilityMacros_h" = yes; then echo "$as_me:$LINENO: checking if weak import is available" >&5 echo $ECHO_N "checking if weak import is available... $ECHO_C" >&6 if test "${tcl_cv_cc_weak_import+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #endif int rand(void) __attribute__((weak_import)); int main () { rand(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_weak_import=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_weak_import=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_weak_import" >&5 echo "${ECHO_T}$tcl_cv_cc_weak_import" >&6 if test $tcl_cv_cc_weak_import = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_WEAK_IMPORT 1 _ACEOF fi echo "$as_me:$LINENO: checking if Darwin SUSv3 extensions are available" >&5 echo $ECHO_N "checking if Darwin SUSv3 extensions are available... $ECHO_C" >&6 if test "${tcl_cv_cc_darwin_c_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #endif #define _DARWIN_C_SOURCE 1 #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_darwin_c_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_darwin_c_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_darwin_c_source" >&5 echo "${ECHO_T}$tcl_cv_cc_darwin_c_source" >&6 if test $tcl_cv_cc_darwin_c_source = yes; then cat >>confdefs.h <<\_ACEOF #define _DARWIN_C_SOURCE 1 _ACEOF fi fi # Build .bundle dltest binaries in addition to .dylib DLTEST_LD='${CC} -bundle -Wl,-w ${CFLAGS} ${LDFLAGS}' DLTEST_SUFFIX=".bundle" else DLTEST_LD='${SHLIB_LD}' DLTEST_SUFFIX="" fi #-------------------------------------------------------------------- # Check for support of fts functions (readdir replacement) #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for fts" >&5 echo $ECHO_N "checking for fts... $ECHO_C" >&6 if test "${tcl_cv_api_fts+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main () { char*const p[2] = {"/", NULL}; FTS *f = fts_open(p, FTS_PHYSICAL|FTS_NOCHDIR|FTS_NOSTAT, NULL); FTSENT *e = fts_read(f); fts_close(f); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_api_fts=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_api_fts=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_api_fts" >&5 echo "${ECHO_T}$tcl_cv_api_fts" >&6 if test $tcl_cv_api_fts = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_FTS 1 _ACEOF fi #-------------------------------------------------------------------- # The statements below check for systems where POSIX-style non-blocking # I/O (O_NONBLOCK) doesn't work or is unimplemented. On these systems # (mostly older ones), use the old BSD-style FIONBIO approach instead. #-------------------------------------------------------------------- for ac_header in sys/ioctl.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/filio.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking system version" >&5 echo $ECHO_N "checking system version... $ECHO_C" >&6 if test "${tcl_cv_sys_version+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -f /usr/lib/NextStep/software_version; then tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then tcl_cv_sys_version=MP-RAS-`awk '{print $3}' /etc/.relid` fi if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then tcl_cv_sys_version=NetBSD-Debian fi fi fi fi echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 echo "${ECHO_T}$tcl_cv_sys_version" >&6 system=$tcl_cv_sys_version echo "$as_me:$LINENO: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 echo $ECHO_N "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... $ECHO_C" >&6 case $system in OSF*) cat >>confdefs.h <<\_ACEOF #define USE_FIONBIO 1 _ACEOF echo "$as_me:$LINENO: result: FIONBIO" >&5 echo "${ECHO_T}FIONBIO" >&6 ;; SunOS-4*) cat >>confdefs.h <<\_ACEOF #define USE_FIONBIO 1 _ACEOF echo "$as_me:$LINENO: result: FIONBIO" >&5 echo "${ECHO_T}FIONBIO" >&6 ;; *) echo "$as_me:$LINENO: result: O_NONBLOCK" >&5 echo "${ECHO_T}O_NONBLOCK" >&6 ;; esac #------------------------------------------------------------------------ echo "$as_me:$LINENO: checking whether to use dll unloading" >&5 echo $ECHO_N "checking whether to use dll unloading... $ECHO_C" >&6 # Check whether --enable-dll-unloading or --disable-dll-unloading was given. if test "${enable_dll_unloading+set}" = set; then enableval="$enable_dll_unloading" tcl_ok=$enableval else tcl_ok=yes fi; if test $tcl_ok = yes; then cat >>confdefs.h <<\_ACEOF #define TCL_UNLOAD_DLLS 1 _ACEOF fi echo "$as_me:$LINENO: result: $tcl_ok" >&5 echo "${ECHO_T}$tcl_ok" >&6 #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can # be overridden on the configure command line either way. #------------------------------------------------------------------------ echo "$as_me:$LINENO: checking for timezone data" >&5 echo $ECHO_N "checking for timezone data... $ECHO_C" >&6 # Check whether --with-tzdata or --without-tzdata was given. if test "${with_tzdata+set}" = set; then withval="$with_tzdata" tcl_ok=$withval else tcl_ok=auto fi; # # Any directories that get added here must also be added to the # search path in ::tcl::clock::Initialize (library/clock.tcl). # case $tcl_ok in no) echo "$as_me:$LINENO: result: supplied by OS vendor" >&5 echo "${ECHO_T}supplied by OS vendor" >&6 ;; yes) # nothing to do here ;; auto*) if test "${tcl_cv_dir_zoneinfo+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for dir in /usr/share/zoneinfo \ /usr/share/lib/zoneinfo \ /usr/lib/zoneinfo do if test -f $dir/UTC -o -f $dir/GMT then tcl_cv_dir_zoneinfo="$dir" break fi done fi if test -n "$tcl_cv_dir_zoneinfo"; then tcl_ok=no echo "$as_me:$LINENO: result: $dir" >&5 echo "${ECHO_T}$dir" >&6 else tcl_ok=yes fi ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $tcl_ok" >&5 echo "$as_me: error: invalid argument: $tcl_ok" >&2;} { (exit 1); exit 1; }; } ;; esac if test $tcl_ok = yes then echo "$as_me:$LINENO: result: supplied by Tcl" >&5 echo "${ECHO_T}supplied by Tcl" >&6 INSTALL_TZDATA=install-tzdata fi #-------------------------------------------------------------------- # DTrace support #-------------------------------------------------------------------- # Check whether --enable-dtrace or --disable-dtrace was given. if test "${enable_dtrace+set}" = set; then enableval="$enable_dtrace" tcl_ok=$enableval else tcl_ok=no fi; if test $tcl_ok = yes; then if test "${ac_cv_header_sys_sdt_h+set}" = set; then echo "$as_me:$LINENO: checking for sys/sdt.h" >&5 echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6 if test "${ac_cv_header_sys_sdt_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sys/sdt.h usability" >&5 echo $ECHO_N "checking sys/sdt.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sys/sdt.h presence" >&5 echo $ECHO_N "checking sys/sdt.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: sys/sdt.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: sys/sdt.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sys/sdt.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: sys/sdt.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------ ## ## Report this to the tcl lists. ## ## ------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sys/sdt.h" >&5 echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6 if test "${ac_cv_header_sys_sdt_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sys_sdt_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6 fi if test $ac_cv_header_sys_sdt_h = yes; then tcl_ok=yes else tcl_ok=no fi fi if test $tcl_ok = yes; then # Extract the first word of "dtrace", so it can be a program name with args. set dummy dtrace; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_DTRACE+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $DTRACE in [\\/]* | ?:[\\/]*) ac_cv_path_DTRACE="$DTRACE" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_dummy="$PATH:/usr/sbin" for as_dir in $as_dummy do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_DTRACE="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi DTRACE=$ac_cv_path_DTRACE if test -n "$DTRACE"; then echo "$as_me:$LINENO: result: $DTRACE" >&5 echo "${ECHO_T}$DTRACE" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -z "$ac_cv_path_DTRACE" && tcl_ok=no fi echo "$as_me:$LINENO: checking whether to enable DTrace support" >&5 echo $ECHO_N "checking whether to enable DTrace support... $ECHO_C" >&6 MAKEFILE_SHELL='/bin/sh' if test $tcl_ok = yes; then cat >>confdefs.h <<\_ACEOF #define USE_DTRACE 1 _ACEOF DTRACE_SRC="\${DTRACE_SRC}" DTRACE_HDR="\${DTRACE_HDR}" if test "`uname -s`" != "Darwin" ; then DTRACE_OBJ="\${DTRACE_OBJ}" if test "`uname -s`" = "SunOS" -a "$SHARED_BUILD" = "0" ; then # Need to create an intermediate object file to ensure tclDTrace.o # gets included when linking against the static tcl library. STLIB_LD='stlib_ld () { /usr/ccs/bin/ld -r -o $${1%.a}.o "$${@:2}" && '"${STLIB_LD}"' $${1} $${1%.a}.o ; } && stlib_ld' MAKEFILE_SHELL='/bin/bash' # Force use of Sun ar and ranlib, the GNU versions choke on # tclDTrace.o and the combined object file above. AR='/usr/ccs/bin/ar' RANLIB='/usr/ccs/bin/ranlib' fi fi fi echo "$as_me:$LINENO: result: $tcl_ok" >&5 echo "${ECHO_T}$tcl_ok" >&6 #-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether the cpuid instruction is usable" >&5 echo $ECHO_N "checking whether the cpuid instruction is usable... $ECHO_C" >&6 if test "${tcl_cv_cpuid+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int index,regsPtr[4]; __asm__ __volatile__("mov %%ebx, %%edi \n\t" "cpuid \n\t" "mov %%ebx, %%esi \n\t" "mov %%edi, %%ebx \n\t" : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index) : "edi"); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cpuid=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cpuid=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_cpuid" >&5 echo "${ECHO_T}$tcl_cv_cpuid" >&6 if test $tcl_cv_cpuid = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_CPUID 1 _ACEOF fi #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX} eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" # tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed # since on some platforms TCL_LIB_FILE contains shell escapes. # (See also: TCL_TRIM_DOTS). eval "TCL_LIB_FILE=${TCL_LIB_FILE}" test -z "$TCL_LIBRARY" && TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' # Note: in the following variable, it's important to use the absolute # path name of the Tcl directory rather than "..": this is because # AIX remembers this path and will attempt to use it at run-time to look # up the Tcl library. if test "`uname -s`" = "Darwin" ; then if test "`uname -s`" = "Darwin" ; then echo "$as_me:$LINENO: checking how to package libraries" >&5 echo $ECHO_N "checking how to package libraries... $ECHO_C" >&6 # Check whether --enable-framework or --disable-framework was given. if test "${enable_framework+set}" = set; then enableval="$enable_framework" enable_framework=$enableval else enable_framework=no fi; if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then { echo "$as_me:$LINENO: WARNING: Frameworks can only be built if --enable-shared is yes" >&5 echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;} enable_framework=no fi if test $tcl_corefoundation = no; then { echo "$as_me:$LINENO: WARNING: Frameworks can only be used when CoreFoundation is available" >&5 echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;} enable_framework=no fi fi if test $enable_framework = yes; then echo "$as_me:$LINENO: result: framework" >&5 echo "${ECHO_T}framework" >&6 FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then echo "$as_me:$LINENO: result: shared library" >&5 echo "${ECHO_T}shared library" >&6 else echo "$as_me:$LINENO: result: static library" >&5 echo "${ECHO_T}static library" >&6 fi FRAMEWORK_BUILD=0 fi fi TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk '{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}'`" TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}' echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000' TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" TCL_YEAR="`date +%Y`" fi if test "$FRAMEWORK_BUILD" = "1" ; then cat >>confdefs.h <<\_ACEOF #define TCL_FRAMEWORK 1 _ACEOF # Construct a fake local framework structure to make linking with # '-framework Tcl' and running of tcltest work ac_config_commands="$ac_config_commands Tcl.framework" LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" # default install directory for bundled packages if test "${libdir}" = '${exec_prefix}/lib' -o "`basename ${libdir}`" = 'Frameworks'; then PACKAGE_DIR="/Library/Tcl" else PACKAGE_DIR="$libdir" fi if test "${libdir}" = '${exec_prefix}/lib'; then # override libdir default libdir="/Library/Frameworks" fi TCL_LIB_FILE="Tcl" TCL_LIB_FLAG="-framework Tcl" TCL_BUILD_LIB_SPEC="-F`pwd | sed -e 's/ /\\\\ /g'` -framework Tcl" TCL_LIB_SPEC="-F${libdir} -framework Tcl" libdir="${libdir}/Tcl.framework/Versions/\${VERSION}" TCL_LIBRARY="${libdir}/Resources/Scripts" includedir="${libdir}/Headers" PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders" HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl" EXTRA_INSTALL="install-private-headers html-tcl" EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)/TclTOC.html"' EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."' # Don't use AC_DEFINE for the following as the framework version define # needs to go into the Makefile even when using autoheader, so that we # can pick up a potential make override of VERSION. Also, don't put this # into CFLAGS as it should not go into tclConfig.sh EXTRA_CC_SWITCHES='-DTCL_FRAMEWORK_VERSION=\"$(VERSION)\"' else # libdir must be a fully qualified path and not ${exec_prefix}/lib eval libdir="$libdir" # default install directory for bundled packages PACKAGE_DIR="$libdir" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_LIB_FLAG="-ltcl${TCL_VERSION}" else TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`" fi TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" fi VERSION='${VERSION}' eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" VERSION=${TCL_VERSION} #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$FRAMEWORK_BUILD" = "1" ; then test -z "$TCL_PACKAGE_PATH" && \ TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" test -z "$TCL_MODULE_PATH" && \ TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl" elif test "$prefix/lib" != "$libdir"; then test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib} ${TCL_PACKAGE_PATH}" else test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${prefix}/lib} ${TCL_PACKAGE_PATH}" fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl # stub support. #-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_DIR=\"${libdir}\"" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" else TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" fi TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}" TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}" TCL_STUB_LIB_PATH="${TCL_STUB_LIB_DIR}/${TCL_STUB_LIB_FILE}" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ TCL_SHARED_BUILD=${SHARED_BUILD} ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi DEFS=-DHAVE_CONFIG_H DEFS="-DHAVE_TCL_CONFIG_H -imacros tclConfig.h" CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by tcl $as_me 8.6, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Configuration commands: $config_commands Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ tcl config.status 8.6 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # INIT-COMMANDS section. # VERSION=${TCL_VERSION} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "Tcl-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;; "Tclsh-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;; "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;; "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;; "tclConfig.h" ) CONFIG_HEADERS="$CONFIG_HEADERS tclConfig.h:../unix/tclConfig.h.in" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@MAN_FLAGS@,$MAN_FLAGS,;t t s,@CC@,$CC,;t t s,@CFLAGS@,$CFLAGS,;t t s,@LDFLAGS@,$LDFLAGS,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t s,@CPP@,$CPP,;t t s,@EGREP@,$EGREP,;t t s,@TCL_THREADS@,$TCL_THREADS,;t t s,@SHARED_BUILD@,$SHARED_BUILD,;t t s,@TCLSH_PROG@,$TCLSH_PROG,;t t s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t s,@ZLIB_SRCS@,$ZLIB_SRCS,;t t s,@ZLIB_INCLUDE@,$ZLIB_INCLUDE,;t t s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@AR@,$AR,;t t s,@ac_ct_AR@,$ac_ct_AR,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@TCL_LIBS@,$TCL_LIBS,;t t s,@DL_LIBS@,$DL_LIBS,;t t s,@DL_OBJS@,$DL_OBJS,;t t s,@PLAT_OBJS@,$PLAT_OBJS,;t t s,@PLAT_SRCS@,$PLAT_SRCS,;t t s,@LDAIX_SRC@,$LDAIX_SRC,;t t s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t s,@CFLAGS_NOLTO@,$CFLAGS_NOLTO,;t t s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t s,@CC_SEARCH_FLAGS@,$CC_SEARCH_FLAGS,;t t s,@LD_SEARCH_FLAGS@,$LD_SEARCH_FLAGS,;t t s,@STLIB_LD@,$STLIB_LD,;t t s,@SHLIB_LD@,$SHLIB_LD,;t t s,@TCL_SHLIB_LD_EXTRAS@,$TCL_SHLIB_LD_EXTRAS,;t t s,@TK_SHLIB_LD_EXTRAS@,$TK_SHLIB_LD_EXTRAS,;t t s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t s,@MAKE_LIB@,$MAKE_LIB,;t t s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t s,@INSTALL_LIB@,$INSTALL_LIB,;t t s,@DLL_INSTALL_DIR@,$DLL_INSTALL_DIR,;t t s,@INSTALL_STUB_LIB@,$INSTALL_STUB_LIB,;t t s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t s,@DTRACE@,$DTRACE,;t t s,@TCL_VERSION@,$TCL_VERSION,;t t s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t s,@TCL_YEAR@,$TCL_YEAR,;t t s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t s,@LD_LIBRARY_PATH_VAR@,$LD_LIBRARY_PATH_VAR,;t t s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t s,@TCL_SHARED_LIB_SUFFIX@,$TCL_SHARED_LIB_SUFFIX,;t t s,@TCL_UNSHARED_LIB_SUFFIX@,$TCL_UNSHARED_LIB_SUFFIX,;t t s,@TCL_HAS_LONGLONG@,$TCL_HAS_LONGLONG,;t t s,@INSTALL_TZDATA@,$INSTALL_TZDATA,;t t s,@DTRACE_SRC@,$DTRACE_SRC,;t t s,@DTRACE_HDR@,$DTRACE_HDR,;t t s,@DTRACE_OBJ@,$DTRACE_OBJ,;t t s,@MAKEFILE_SHELL@,$MAKEFILE_SHELL,;t t s,@BUILD_DLTEST@,$BUILD_DLTEST,;t t s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t s,@TCL_MODULE_PATH@,$TCL_MODULE_PATH,;t t s,@TCL_LIBRARY@,$TCL_LIBRARY,;t t s,@PRIVATE_INCLUDE_DIR@,$PRIVATE_INCLUDE_DIR,;t t s,@HTML_DIR@,$HTML_DIR,;t t s,@PACKAGE_DIR@,$PACKAGE_DIR,;t t s,@EXTRA_CC_SWITCHES@,$EXTRA_CC_SWITCHES,;t t s,@EXTRA_APP_CC_SWITCHES@,$EXTRA_APP_CC_SWITCHES,;t t s,@EXTRA_INSTALL@,$EXTRA_INSTALL,;t t s,@EXTRA_INSTALL_BINARIES@,$EXTRA_INSTALL_BINARIES,;t t s,@EXTRA_BUILD_HTML@,$EXTRA_BUILD_HTML,;t t s,@EXTRA_TCLSH_LIBS@,$EXTRA_TCLSH_LIBS,;t t s,@DLTEST_LD@,$DLTEST_LD,;t t s,@DLTEST_SUFFIX@,$DLTEST_SUFFIX,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # # CONFIG_HEADER section. # # These sed commands are passed to sed as "A NAME B NAME C VALUE D", where # NAME is the cpp macro being defined and VALUE is the value it is being given. # # ac_d sets the value in "#define NAME VALUE" lines. ac_dA='s,^\([ ]*\)#\([ ]*define[ ][ ]*\)' ac_dB='[ ].*$,\1#\2' ac_dC=' ' ac_dD=',;t' # ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE". ac_uA='s,^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' ac_uB='$,\1#\2define\3' ac_uC=' ' ac_uD=',;t' for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac test x"$ac_file" != x- && { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } # Do quote $f, to prevent DOS paths from being IFS'd. echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } # Remove the trailing spaces. sed 's/[ ]*$//' $ac_file_inputs >$tmp/in _ACEOF # Transform confdefs.h into two sed scripts, `conftest.defines' and # `conftest.undefs', that substitutes the proper values into # config.h.in to produce config.h. The first handles `#define' # templates, and the second `#undef' templates. # And first: Protect against being on the right side of a sed subst in # config.status. Protect against being in an unquoted here document # in config.status. rm -f conftest.defines conftest.undefs # Using a here document instead of a string reduces the quoting nightmare. # Putting comments in sed scripts is not portable. # # `end' is used to avoid that the second main sed command (meant for # 0-ary CPP macros) applies to n-ary macro definitions. # See the Autoconf documentation for `clear'. cat >confdef2sed.sed <<\_ACEOF s/[\\&,]/\\&/g s,[\\$`],\\&,g t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*\)\(([^)]*)\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1\2${ac_dC}\3${ac_dD},gp t end s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD},gp : end _ACEOF # If some macros were called several times there might be several times # the same #defines, which is useless. Nevertheless, we may not want to # sort them, since we want the *last* AC-DEFINE to be honored. uniq confdefs.h | sed -n -f confdef2sed.sed >conftest.defines sed 's/ac_d/ac_u/g' conftest.defines >conftest.undefs rm -f confdef2sed.sed # This sed command replaces #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. cat >>conftest.undefs <<\_ACEOF s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */, _ACEOF # Break up conftest.defines because some shells have a limit on the size # of here documents, and old seds have small limits too (100 cmds). echo ' # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS echo ' if grep "^[ ]*#[ ]*define" $tmp/in >/dev/null; then' >>$CONFIG_STATUS echo ' # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS echo ' :' >>$CONFIG_STATUS rm -f conftest.tail while grep . conftest.defines >/dev/null do # Write a limited-size here document to $tmp/defines.sed. echo ' cat >$tmp/defines.sed <>$CONFIG_STATUS # Speed up: don't consider the non `#define' lines. echo '/^[ ]*#[ ]*define/!b' >>$CONFIG_STATUS # Work around the forget-to-reset-the-flag bug. echo 't clr' >>$CONFIG_STATUS echo ': clr' >>$CONFIG_STATUS sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f $tmp/defines.sed $tmp/in >$tmp/out rm -f $tmp/in mv $tmp/out $tmp/in ' >>$CONFIG_STATUS sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines echo ' fi # grep' >>$CONFIG_STATUS echo >>$CONFIG_STATUS # Break up conftest.undefs because some shells have a limit on the size # of here documents, and old seds have small limits too (100 cmds). echo ' # Handle all the #undef templates' >>$CONFIG_STATUS rm -f conftest.tail while grep . conftest.undefs >/dev/null do # Write a limited-size here document to $tmp/undefs.sed. echo ' cat >$tmp/undefs.sed <>$CONFIG_STATUS # Speed up: don't consider the non `#undef' echo '/^[ ]*#[ ]*undef/!b' >>$CONFIG_STATUS # Work around the forget-to-reset-the-flag bug. echo 't clr' >>$CONFIG_STATUS echo ': clr' >>$CONFIG_STATUS sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS echo 'CEOF sed -f $tmp/undefs.sed $tmp/in >$tmp/out rm -f $tmp/in mv $tmp/out $tmp/in ' >>$CONFIG_STATUS sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail rm -f conftest.undefs mv conftest.tail conftest.undefs done rm -f conftest.undefs cat >>$CONFIG_STATUS <<\_ACEOF # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then echo "/* Generated by configure. */" >$tmp/config.h else echo "/* $ac_file. Generated by configure. */" >$tmp/config.h fi cat $tmp/in >>$tmp/config.h rm -f $tmp/in if test x"$ac_file" != x-; then if diff $ac_file $tmp/config.h >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } rm -f $ac_file mv $tmp/config.h $ac_file fi else cat $tmp/config.h rm -f $tmp/config.h fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # # CONFIG_COMMANDS section. # for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue ac_dest=`echo "$ac_file" | sed 's,:.*,,'` ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_dir=`(dirname "$ac_dest") 2>/dev/null || $as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_dest" : 'X\(//\)[^/]' \| \ X"$ac_dest" : 'X\(//\)$' \| \ X"$ac_dest" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_dest" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac { echo "$as_me:$LINENO: executing $ac_dest commands" >&5 echo "$as_me: executing $ac_dest commands" >&6;} case $ac_dest in Tcl.framework ) n=Tcl && f=$n.framework && v=Versions/$VERSION && rm -rf $f && mkdir -p $f/$v/Resources && ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && unset n f v ;; esac done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi tcl8.6.14/macosx/license.terms0000644000175000017500000000431714554262142015637 0ustar sergeisergeiThis software is copyrighted by the Regents of the University of California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState Corporation and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7014 (b) (3) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license. tcl8.6.14/macosx/Tcl.xcode/0000755000175000017500000000000014566153412014761 5ustar sergeisergeitcl8.6.14/macosx/Tcl.xcode/project.pbxproj0000644000175000017500000066464214554262142020055 0ustar sergeisergei// !$*UTF8*$! { archiveVersion = 1; classes = { }; objectVersion = 45; objects = { /* Begin PBXBuildFile section */ F90509300913A72400327603 /* tclAppInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445508F272B9004A47F5 /* tclAppInit.c */; settings = {COMPILER_FLAGS = "-DTCL_TEST -DTCL_BUILDTIME_LIBRARY=\\\"$(TCL_SRCROOT)/library\\\""; }; }; F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; }; F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; }; F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; }; F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; }; F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F966C07408F2820D005CB29B /* CoreFoundation.framework */; }; F96D456F08F272BB004A47F5 /* regcomp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED008F272A7004A47F5 /* regcomp.c */; }; F96D457208F272BB004A47F5 /* regerror.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED308F272A7004A47F5 /* regerror.c */; }; F96D457508F272BB004A47F5 /* regexec.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED608F272A7004A47F5 /* regexec.c */; }; F96D457608F272BB004A47F5 /* regfree.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED708F272A7004A47F5 /* regfree.c */; }; F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDC08F272A7004A47F5 /* tclAlloc.c */; settings = {COMPILER_FLAGS = "-DUSE_TCLALLOC=0"; }; }; F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDD08F272A7004A47F5 /* tclAsync.c */; }; F96D457D08F272BB004A47F5 /* tclBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDE08F272A7004A47F5 /* tclBasic.c */; }; F96D457E08F272BC004A47F5 /* tclBinary.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDF08F272A7004A47F5 /* tclBinary.c */; }; F96D457F08F272BC004A47F5 /* tclCkalloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE008F272A7004A47F5 /* tclCkalloc.c */; }; F96D458008F272BC004A47F5 /* tclClock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE108F272A7004A47F5 /* tclClock.c */; }; F96D458108F272BC004A47F5 /* tclCmdAH.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE208F272A7004A47F5 /* tclCmdAH.c */; }; F96D458208F272BC004A47F5 /* tclCmdIL.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE308F272A7004A47F5 /* tclCmdIL.c */; }; F96D458308F272BC004A47F5 /* tclCmdMZ.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */; }; F96D458408F272BC004A47F5 /* tclCompCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE508F272A7004A47F5 /* tclCompCmds.c */; }; F96D458508F272BC004A47F5 /* tclCompExpr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE608F272A7004A47F5 /* tclCompExpr.c */; }; F96D458608F272BC004A47F5 /* tclCompile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE708F272A7004A47F5 /* tclCompile.c */; }; F96D458808F272BC004A47F5 /* tclConfig.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE908F272A7004A47F5 /* tclConfig.c */; }; F96D458908F272BC004A47F5 /* tclDate.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEA08F272A7004A47F5 /* tclDate.c */; }; F96D458B08F272BC004A47F5 /* tclDictObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEC08F272A7004A47F5 /* tclDictObj.c */; }; F96D458C08F272BC004A47F5 /* tclEncoding.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EED08F272A7004A47F5 /* tclEncoding.c */; }; F96D458D08F272BC004A47F5 /* tclEnv.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEE08F272A7004A47F5 /* tclEnv.c */; }; F96D458E08F272BC004A47F5 /* tclEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEF08F272A7004A47F5 /* tclEvent.c */; }; F96D458F08F272BC004A47F5 /* tclExecute.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF008F272A7004A47F5 /* tclExecute.c */; }; F96D459008F272BC004A47F5 /* tclFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF108F272A7004A47F5 /* tclFCmd.c */; }; F96D459108F272BC004A47F5 /* tclFileName.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF208F272A7004A47F5 /* tclFileName.c */; }; F96D459308F272BC004A47F5 /* tclGet.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF408F272A7004A47F5 /* tclGet.c */; }; F96D459508F272BC004A47F5 /* tclHash.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF608F272A7004A47F5 /* tclHash.c */; }; F96D459608F272BC004A47F5 /* tclHistory.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF708F272A7004A47F5 /* tclHistory.c */; }; F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF808F272A7004A47F5 /* tclIndexObj.c */; }; F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EFC08F272A7004A47F5 /* tclInterp.c */; }; F96D459D08F272BC004A47F5 /* tclIO.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EFE08F272A7004A47F5 /* tclIO.c */; }; F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0008F272A7004A47F5 /* tclIOCmd.c */; }; F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0108F272A7004A47F5 /* tclIOGT.c */; }; F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0208F272A7004A47F5 /* tclIORChan.c */; }; F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0308F272A7004A47F5 /* tclIOSock.c */; }; F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0408F272A7004A47F5 /* tclIOUtil.c */; }; F96D45A408F272BC004A47F5 /* tclLink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0508F272A7004A47F5 /* tclLink.c */; }; F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0608F272A7004A47F5 /* tclListObj.c */; }; F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0708F272A7004A47F5 /* tclLiteral.c */; }; F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0808F272A7004A47F5 /* tclLoad.c */; }; F96D45A908F272BC004A47F5 /* tclMain.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0A08F272A7004A47F5 /* tclMain.c */; }; F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0B08F272A7004A47F5 /* tclNamesp.c */; }; F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0C08F272A7004A47F5 /* tclNotify.c */; }; F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0D08F272A7004A47F5 /* tclObj.c */; }; F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0E08F272A7004A47F5 /* tclPanic.c */; }; F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0F08F272A7004A47F5 /* tclParse.c */; }; F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1108F272A7004A47F5 /* tclPathObj.c */; }; F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1208F272A7004A47F5 /* tclPipe.c */; }; F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1308F272A7004A47F5 /* tclPkg.c */; }; F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */; settings = {COMPILER_FLAGS = "-DCFG_INSTALL_LIBDIR=\\\"$(LIBDIR)\\\" -DCFG_INSTALL_BINDIR=\\\"$(BINDIR)\\\" -DCFG_INSTALL_SCRDIR=\\\"$(TCL_LIBRARY)\\\" -DCFG_INSTALL_INCDIR=\\\"$(INCLUDEDIR)\\\" -DCFG_INSTALL_DOCDIR=\\\"$(MANDIR)\\\" -DCFG_RUNTIME_LIBDIR=\\\"$(LIBDIR)\\\" -DCFG_RUNTIME_BINDIR=\\\"$(BINDIR)\\\" -DCFG_RUNTIME_SCRDIR=\\\"$(TCL_LIBRARY)\\\" -DCFG_RUNTIME_INCDIR=\\\"$(INCLUDEDIR)\\\" -DCFG_RUNTIME_DOCDIR=\\\"$(MANDIR)\\\""; }; }; F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1708F272A7004A47F5 /* tclPosixStr.c */; }; F96D45B708F272BC004A47F5 /* tclPreserve.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1808F272A7004A47F5 /* tclPreserve.c */; }; F96D45B808F272BC004A47F5 /* tclProc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1908F272A7004A47F5 /* tclProc.c */; }; F96D45B908F272BC004A47F5 /* tclRegexp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1A08F272A7004A47F5 /* tclRegexp.c */; }; F96D45BB08F272BC004A47F5 /* tclResolve.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1C08F272A7004A47F5 /* tclResolve.c */; }; F96D45BC08F272BC004A47F5 /* tclResult.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1D08F272A7004A47F5 /* tclResult.c */; }; F96D45BD08F272BC004A47F5 /* tclScan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1E08F272A7004A47F5 /* tclScan.c */; }; F96D45BE08F272BC004A47F5 /* tclStringObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1F08F272A7004A47F5 /* tclStringObj.c */; }; F96D45C308F272BC004A47F5 /* tclStrToD.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2408F272A7004A47F5 /* tclStrToD.c */; }; F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2508F272A7004A47F5 /* tclStubInit.c */; }; F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2608F272A7004A47F5 /* tclStubLib.c */; }; F96D45C608F272BC004A47F5 /* tclTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2708F272A7004A47F5 /* tclTest.c */; }; F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2808F272A7004A47F5 /* tclTestObj.c */; }; F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */; }; F96D45C908F272BC004A47F5 /* tclThread.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2A08F272A7004A47F5 /* tclThread.c */; }; F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */; }; F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */; }; F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */; }; F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */; }; F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2F08F272A7004A47F5 /* tclTimer.c */; }; F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */; }; F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3208F272A7004A47F5 /* tclTrace.c */; }; F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3408F272A7004A47F5 /* tclUtf.c */; }; F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3508F272A7004A47F5 /* tclUtil.c */; }; F96D45D508F272BC004A47F5 /* tclVar.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3608F272A7004A47F5 /* tclVar.c */; }; F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */; }; F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */; }; F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426908F272B3004A47F5 /* bn_mp_add.c */; }; F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */; }; F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */; }; F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426E08F272B3004A47F5 /* bn_mp_clear.c */; }; F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */; }; F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427008F272B3004A47F5 /* bn_mp_cmp.c */; }; F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */; }; F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_cnt_lsb.c */; }; F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_copy.c */; }; F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */; }; F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427608F272B3004A47F5 /* bn_mp_div.c */; }; F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427708F272B3004A47F5 /* bn_mp_div_2.c */; }; F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */; }; F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427908F272B3004A47F5 /* bn_mp_div_3.c */; }; F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */; }; F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427E08F272B3004A47F5 /* bn_mp_exch.c */; }; F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428708F272B3004A47F5 /* bn_mp_grow.c */; }; F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428808F272B3004A47F5 /* bn_mp_init.c */; }; F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */; }; F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */; }; F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */; }; F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */; }; F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */; }; F96D491108F272C3004A47F5 /* bn_mp_karatsuba_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */; }; F96D491308F272C3004A47F5 /* bn_mp_lshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429508F272B3004A47F5 /* bn_mp_lshd.c */; }; F96D491408F272C3004A47F5 /* bn_mp_mod.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429608F272B3004A47F5 /* bn_mp_mod.c */; }; F96D491508F272C3004A47F5 /* bn_mp_mod_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */; }; F96D491A08F272C3004A47F5 /* bn_mp_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429C08F272B3004A47F5 /* bn_mp_mul.c */; }; F96D491B08F272C3004A47F5 /* bn_mp_mul_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */; }; F96D491C08F272C3004A47F5 /* bn_mp_mul_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */; }; F96D491D08F272C3004A47F5 /* bn_mp_mul_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */; }; F96D492908F272C3004A47F5 /* bn_mp_radix_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */; }; F96D492A08F272C3004A47F5 /* bn_mp_radix_smap.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */; }; F96D492C08F272C3004A47F5 /* bn_mp_read_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */; }; F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */; }; F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BA08F272B3004A47F5 /* bn_mp_set.c */; }; F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */; }; F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C108F272B3004A47F5 /* bn_mp_sub.c */; }; F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */; }; F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */; }; F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */; }; F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */; }; F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */; }; F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D008F272B3004A47F5 /* bn_reverse.c */; }; F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */; }; F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */; }; F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */; }; F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */; }; F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */; }; F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */; }; F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */; }; F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445B08F272B9004A47F5 /* tclLoadDyld.c */; settings = {COMPILER_FLAGS = "-Wno-deprecated-declarations"; }; }; F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445F08F272B9004A47F5 /* tclUnixChan.c */; }; F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446008F272B9004A47F5 /* tclUnixEvent.c */; }; F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446108F272B9004A47F5 /* tclUnixFCmd.c */; }; F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446208F272B9004A47F5 /* tclUnixFile.c */; }; F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446308F272B9004A47F5 /* tclUnixInit.c */; settings = {COMPILER_FLAGS = "-DTCL_LIBRARY=\\\"$(TCL_LIBRARY)\\\" -DTCL_PACKAGE_PATH=\\\"$(TCL_PACKAGE_PATH)\\\""; }; }; F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446408F272B9004A47F5 /* tclUnixNotfy.c */; }; F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446508F272B9004A47F5 /* tclUnixPipe.c */; }; F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446708F272B9004A47F5 /* tclUnixSock.c */; }; F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446808F272B9004A47F5 /* tclUnixTest.c */; }; F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446908F272B9004A47F5 /* tclUnixThrd.c */; }; F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; }; F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; }; F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; }; F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; }; F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; }; F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */; }; F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; }; F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; }; F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; }; F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */; }; F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */; }; F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; }; F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; }; /* End PBXBuildFile section */ /* Begin PBXContainerItemProxy section */ F97258D20A868C6F00096C78 /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = 08FB7793FE84155DC02AAC07 /* Project object */; proxyType = 1; remoteGlobalIDString = 8DD76FA90486AB0100D96B5E; remoteInfo = tcltest; }; /* End PBXContainerItemProxy section */ /* Begin PBXFileReference section */ 8DD76FB20486AB0100D96B5E /* tcltest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tcltest; sourceTree = BUILT_PRODUCTS_DIR; }; F915432A0EF201CF0032D1E8 /* zlib.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = zlib.test; sourceTree = ""; }; F915432D0EF201EE0032D1E8 /* zlib.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = zlib.n; sourceTree = ""; }; F9183E640EFC80CD0030B814 /* throw.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = throw.n; sourceTree = ""; }; F9183E650EFC80D70030B814 /* try.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = try.n; sourceTree = ""; }; F9183E6A0EFC81560030B814 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F9183E8F0EFC817B0030B814 /* tdbc */ = {isa = PBXFileReference; lastKnownFileType = folder; path = tdbc; sourceTree = ""; }; F91DC23C0E44C51B002CB8D1 /* nre.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = nre.test; sourceTree = ""; }; F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xml; path = "Tclsh-Info.plist.in"; sourceTree = ""; }; F92D7F100DE777240033A13A /* tsdPerf.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tsdPerf.tcl; sourceTree = ""; }; F93599B20DF1F75400E04F67 /* tclOO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOO.c; sourceTree = ""; }; F93599B40DF1F75900E04F67 /* tclOO.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclOO.decls; sourceTree = ""; }; F93599B50DF1F75D00E04F67 /* tclOO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOO.h; sourceTree = ""; }; F93599B60DF1F76100E04F67 /* tclOOBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOBasic.c; sourceTree = ""; }; F93599B80DF1F76600E04F67 /* tclOOCall.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOCall.c; sourceTree = ""; }; F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = ""; }; F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = ""; }; F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = ""; }; F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = ""; }; F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = ""; }; F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = ""; }; F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = ""; }; F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = ""; }; F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = ""; }; F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = ""; }; F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = ""; }; F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = ""; }; F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = ""; }; F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = ""; }; F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = ""; }; F93599D60DF1F95000E04F67 /* next.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = next.n; sourceTree = ""; }; F93599D70DF1F96800E04F67 /* object.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = object.n; sourceTree = ""; }; F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = ""; }; F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = ""; }; F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = ""; }; F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = ""; }; F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = ""; }; F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = ""; }; F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = ""; }; F96D3DFA08F272A4004A47F5 /* ChangeLog */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = ChangeLog; sourceTree = ""; }; F96D3DFB08F272A4004A47F5 /* changes */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes; sourceTree = ""; }; F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = ""; }; F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = ""; }; F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = ""; }; F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = ""; }; F96D3E0108F272A4004A47F5 /* AllowExc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AllowExc.3; sourceTree = ""; }; F96D3E0208F272A4004A47F5 /* append.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = append.n; sourceTree = ""; }; F96D3E0308F272A4004A47F5 /* AppInit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AppInit.3; sourceTree = ""; }; F96D3E0408F272A5004A47F5 /* array.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = array.n; sourceTree = ""; }; F96D3E0508F272A5004A47F5 /* AssocData.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AssocData.3; sourceTree = ""; }; F96D3E0608F272A5004A47F5 /* Async.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Async.3; sourceTree = ""; }; F96D3E0708F272A5004A47F5 /* BackgdErr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = BackgdErr.3; sourceTree = ""; }; F96D3E0808F272A5004A47F5 /* Backslash.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Backslash.3; sourceTree = ""; }; F96D3E0908F272A5004A47F5 /* bgerror.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = bgerror.n; sourceTree = ""; }; F96D3E0A08F272A5004A47F5 /* binary.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = binary.n; sourceTree = ""; }; F96D3E0B08F272A5004A47F5 /* BoolObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = BoolObj.3; sourceTree = ""; }; F96D3E0C08F272A5004A47F5 /* break.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = break.n; sourceTree = ""; }; F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ByteArrObj.3; sourceTree = ""; }; F96D3E0E08F272A5004A47F5 /* CallDel.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CallDel.3; sourceTree = ""; }; F96D3E0F08F272A5004A47F5 /* case.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = case.n; sourceTree = ""; }; F96D3E1008F272A5004A47F5 /* catch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = catch.n; sourceTree = ""; }; F96D3E1108F272A5004A47F5 /* cd.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = cd.n; sourceTree = ""; }; F96D3E1208F272A5004A47F5 /* chan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = chan.n; sourceTree = ""; }; F96D3E1308F272A5004A47F5 /* ChnlStack.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ChnlStack.3; sourceTree = ""; }; F96D3E1408F272A5004A47F5 /* clock.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = clock.n; sourceTree = ""; }; F96D3E1508F272A5004A47F5 /* close.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = close.n; sourceTree = ""; }; F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CmdCmplt.3; sourceTree = ""; }; F96D3E1708F272A5004A47F5 /* Concat.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Concat.3; sourceTree = ""; }; F96D3E1808F272A5004A47F5 /* concat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = concat.n; sourceTree = ""; }; F96D3E1908F272A5004A47F5 /* continue.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = continue.n; sourceTree = ""; }; F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChannel.3; sourceTree = ""; }; F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChnlHdlr.3; sourceTree = ""; }; F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCloseHdlr.3; sourceTree = ""; }; F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCommand.3; sourceTree = ""; }; F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtFileHdlr.3; sourceTree = ""; }; F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtInterp.3; sourceTree = ""; }; F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtMathFnc.3; sourceTree = ""; }; F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtObjCmd.3; sourceTree = ""; }; F96D3E2208F272A5004A47F5 /* CrtAlias.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtAlias.3; sourceTree = ""; }; F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTimerHdlr.3; sourceTree = ""; }; F96D3E2408F272A5004A47F5 /* CrtTrace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTrace.3; sourceTree = ""; }; F96D3E2508F272A5004A47F5 /* dde.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dde.n; sourceTree = ""; }; F96D3E2608F272A5004A47F5 /* DetachPids.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DetachPids.3; sourceTree = ""; }; F96D3E2708F272A5004A47F5 /* dict.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dict.n; sourceTree = ""; }; F96D3E2808F272A5004A47F5 /* DictObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DictObj.3; sourceTree = ""; }; F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoOneEvent.3; sourceTree = ""; }; F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoubleObj.3; sourceTree = ""; }; F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoWhenIdle.3; sourceTree = ""; }; F96D3E2C08F272A5004A47F5 /* DString.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DString.3; sourceTree = ""; }; F96D3E2D08F272A5004A47F5 /* DumpActiveMemory.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DumpActiveMemory.3; sourceTree = ""; }; F96D3E2E08F272A5004A47F5 /* Encoding.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Encoding.3; sourceTree = ""; }; F96D3E2F08F272A5004A47F5 /* encoding.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = encoding.n; sourceTree = ""; }; F96D3E3008F272A5004A47F5 /* Ensemble.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Ensemble.3; sourceTree = ""; }; F96D3E3108F272A5004A47F5 /* Environment.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Environment.3; sourceTree = ""; }; F96D3E3208F272A5004A47F5 /* eof.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = eof.n; sourceTree = ""; }; F96D3E3308F272A5004A47F5 /* error.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = error.n; sourceTree = ""; }; F96D3E3408F272A5004A47F5 /* Eval.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Eval.3; sourceTree = ""; }; F96D3E3508F272A5004A47F5 /* eval.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = eval.n; sourceTree = ""; }; F96D3E3608F272A5004A47F5 /* exec.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = exec.n; sourceTree = ""; }; F96D3E3708F272A5004A47F5 /* Exit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Exit.3; sourceTree = ""; }; F96D3E3808F272A5004A47F5 /* exit.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = exit.n; sourceTree = ""; }; F96D3E3908F272A5004A47F5 /* expr.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = expr.n; sourceTree = ""; }; F96D3E3A08F272A5004A47F5 /* ExprLong.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ExprLong.3; sourceTree = ""; }; F96D3E3B08F272A5004A47F5 /* ExprLongObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ExprLongObj.3; sourceTree = ""; }; F96D3E3C08F272A5004A47F5 /* fblocked.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fblocked.n; sourceTree = ""; }; F96D3E3D08F272A5004A47F5 /* fconfigure.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fconfigure.n; sourceTree = ""; }; F96D3E3E08F272A5004A47F5 /* fcopy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fcopy.n; sourceTree = ""; }; F96D3E3F08F272A5004A47F5 /* file.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = file.n; sourceTree = ""; }; F96D3E4008F272A5004A47F5 /* fileevent.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fileevent.n; sourceTree = ""; }; F96D3E4108F272A5004A47F5 /* filename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = filename.n; sourceTree = ""; }; F96D3E4208F272A5004A47F5 /* FileSystem.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = FileSystem.3; sourceTree = ""; }; F96D3E4308F272A5004A47F5 /* FindExec.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = FindExec.3; sourceTree = ""; }; F96D3E4408F272A5004A47F5 /* flush.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = flush.n; sourceTree = ""; }; F96D3E4508F272A5004A47F5 /* for.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = for.n; sourceTree = ""; }; F96D3E4608F272A5004A47F5 /* foreach.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = foreach.n; sourceTree = ""; }; F96D3E4708F272A5004A47F5 /* format.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = format.n; sourceTree = ""; }; F96D3E4808F272A5004A47F5 /* GetCwd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetCwd.3; sourceTree = ""; }; F96D3E4908F272A5004A47F5 /* GetHostName.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetHostName.3; sourceTree = ""; }; F96D3E4A08F272A5004A47F5 /* GetIndex.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetIndex.3; sourceTree = ""; }; F96D3E4B08F272A5004A47F5 /* GetInt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetInt.3; sourceTree = ""; }; F96D3E4C08F272A5004A47F5 /* GetOpnFl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetOpnFl.3; sourceTree = ""; }; F96D3E4D08F272A5004A47F5 /* gets.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = gets.n; sourceTree = ""; }; F96D3E4E08F272A5004A47F5 /* GetStdChan.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetStdChan.3; sourceTree = ""; }; F96D3E4F08F272A5004A47F5 /* GetTime.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetTime.3; sourceTree = ""; }; F96D3E5008F272A5004A47F5 /* GetVersion.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetVersion.3; sourceTree = ""; }; F96D3E5108F272A5004A47F5 /* glob.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = glob.n; sourceTree = ""; }; F96D3E5208F272A6004A47F5 /* global.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = global.n; sourceTree = ""; }; F96D3E5308F272A6004A47F5 /* Hash.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Hash.3; sourceTree = ""; }; F96D3E5408F272A6004A47F5 /* history.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = history.n; sourceTree = ""; }; F96D3E5508F272A6004A47F5 /* http.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = http.n; sourceTree = ""; }; F96D3E5608F272A6004A47F5 /* if.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = if.n; sourceTree = ""; }; F96D3E5708F272A6004A47F5 /* incr.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = incr.n; sourceTree = ""; }; F96D3E5808F272A6004A47F5 /* info.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = info.n; sourceTree = ""; }; F96D3E5908F272A6004A47F5 /* Init.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Init.3; sourceTree = ""; }; F96D3E5A08F272A6004A47F5 /* InitStubs.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = InitStubs.3; sourceTree = ""; }; F96D3E5B08F272A6004A47F5 /* Interp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Interp.3; sourceTree = ""; }; F96D3E5C08F272A6004A47F5 /* interp.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = interp.n; sourceTree = ""; }; F96D3E5D08F272A6004A47F5 /* IntObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = IntObj.3; sourceTree = ""; }; F96D3E5E08F272A6004A47F5 /* join.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = join.n; sourceTree = ""; }; F96D3E5F08F272A6004A47F5 /* lappend.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lappend.n; sourceTree = ""; }; F96D3E6008F272A6004A47F5 /* lassign.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lassign.n; sourceTree = ""; }; F96D3E6108F272A6004A47F5 /* library.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = library.n; sourceTree = ""; }; F96D3E6208F272A6004A47F5 /* Limit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Limit.3; sourceTree = ""; }; F96D3E6308F272A6004A47F5 /* lindex.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lindex.n; sourceTree = ""; }; F96D3E6408F272A6004A47F5 /* LinkVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = LinkVar.3; sourceTree = ""; }; F96D3E6508F272A6004A47F5 /* linsert.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = linsert.n; sourceTree = ""; }; F96D3E6608F272A6004A47F5 /* list.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = list.n; sourceTree = ""; }; F96D3E6708F272A6004A47F5 /* ListObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ListObj.3; sourceTree = ""; }; F96D3E6808F272A6004A47F5 /* llength.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = llength.n; sourceTree = ""; }; F96D3E6908F272A6004A47F5 /* load.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = load.n; sourceTree = ""; }; F96D3E6A08F272A6004A47F5 /* lrange.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lrange.n; sourceTree = ""; }; F96D3E6B08F272A6004A47F5 /* lrepeat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lrepeat.n; sourceTree = ""; }; F96D3E6C08F272A6004A47F5 /* lreplace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lreplace.n; sourceTree = ""; }; F96D3E6D08F272A6004A47F5 /* lsearch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lsearch.n; sourceTree = ""; }; F96D3E6E08F272A6004A47F5 /* lset.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lset.n; sourceTree = ""; }; F96D3E6F08F272A6004A47F5 /* lsort.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lsort.n; sourceTree = ""; }; F96D3E7008F272A6004A47F5 /* man.macros */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = man.macros; sourceTree = ""; }; F96D3E7108F272A6004A47F5 /* mathfunc.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = mathfunc.n; sourceTree = ""; }; F96D3E7208F272A6004A47F5 /* memory.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = memory.n; sourceTree = ""; }; F96D3E7308F272A6004A47F5 /* msgcat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = msgcat.n; sourceTree = ""; }; F96D3E7408F272A6004A47F5 /* Namespace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Namespace.3; sourceTree = ""; }; F96D3E7508F272A6004A47F5 /* namespace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = namespace.n; sourceTree = ""; }; F96D3E7608F272A6004A47F5 /* Notifier.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Notifier.3; sourceTree = ""; }; F96D3E7708F272A6004A47F5 /* Object.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Object.3; sourceTree = ""; }; F96D3E7808F272A6004A47F5 /* ObjectType.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ObjectType.3; sourceTree = ""; }; F96D3E7908F272A6004A47F5 /* open.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = open.n; sourceTree = ""; }; F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = OpenFileChnl.3; sourceTree = ""; }; F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = OpenTcp.3; sourceTree = ""; }; F96D3E7C08F272A6004A47F5 /* package.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = package.n; sourceTree = ""; }; F96D3E7D08F272A6004A47F5 /* packagens.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = packagens.n; sourceTree = ""; }; F96D3E7E08F272A6004A47F5 /* Panic.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Panic.3; sourceTree = ""; }; F96D3E7F08F272A6004A47F5 /* ParseCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ParseCmd.3; sourceTree = ""; }; F96D3E8008F272A6004A47F5 /* pid.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pid.n; sourceTree = ""; }; F96D3E8108F272A6004A47F5 /* pkgMkIndex.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pkgMkIndex.n; sourceTree = ""; }; F96D3E8208F272A6004A47F5 /* PkgRequire.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = PkgRequire.3; sourceTree = ""; }; F96D3E8308F272A6004A47F5 /* Preserve.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Preserve.3; sourceTree = ""; }; F96D3E8408F272A6004A47F5 /* PrintDbl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = PrintDbl.3; sourceTree = ""; }; F96D3E8508F272A6004A47F5 /* proc.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = proc.n; sourceTree = ""; }; F96D3E8608F272A6004A47F5 /* puts.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = puts.n; sourceTree = ""; }; F96D3E8708F272A6004A47F5 /* pwd.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pwd.n; sourceTree = ""; }; F96D3E8808F272A6004A47F5 /* re_syntax.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = re_syntax.n; sourceTree = ""; }; F96D3E8908F272A6004A47F5 /* read.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = read.n; sourceTree = ""; }; F96D3E8A08F272A6004A47F5 /* RecEvalObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RecEvalObj.3; sourceTree = ""; }; F96D3E8B08F272A6004A47F5 /* RecordEval.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RecordEval.3; sourceTree = ""; }; F96D3E8C08F272A6004A47F5 /* RegConfig.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RegConfig.3; sourceTree = ""; }; F96D3E8D08F272A6004A47F5 /* RegExp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RegExp.3; sourceTree = ""; }; F96D3E8E08F272A6004A47F5 /* regexp.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = regexp.n; sourceTree = ""; }; F96D3E8F08F272A6004A47F5 /* registry.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = registry.n; sourceTree = ""; }; F96D3E9008F272A6004A47F5 /* regsub.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = regsub.n; sourceTree = ""; }; F96D3E9108F272A6004A47F5 /* rename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = rename.n; sourceTree = ""; }; F96D3E9208F272A6004A47F5 /* return.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = return.n; sourceTree = ""; }; F96D3E9308F272A6004A47F5 /* safe.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = safe.n; sourceTree = ""; }; F96D3E9408F272A6004A47F5 /* SaveResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SaveResult.3; sourceTree = ""; }; F96D3E9508F272A6004A47F5 /* scan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = scan.n; sourceTree = ""; }; F96D3E9608F272A6004A47F5 /* seek.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = seek.n; sourceTree = ""; }; F96D3E9708F272A6004A47F5 /* set.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = set.n; sourceTree = ""; }; F96D3E9808F272A6004A47F5 /* SetChanErr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetChanErr.3; sourceTree = ""; }; F96D3E9908F272A6004A47F5 /* SetErrno.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetErrno.3; sourceTree = ""; }; F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetRecLmt.3; sourceTree = ""; }; F96D3E9B08F272A7004A47F5 /* SetResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetResult.3; sourceTree = ""; }; F96D3E9C08F272A7004A47F5 /* SetVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetVar.3; sourceTree = ""; }; F96D3E9D08F272A7004A47F5 /* Signal.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Signal.3; sourceTree = ""; }; F96D3E9E08F272A7004A47F5 /* Sleep.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Sleep.3; sourceTree = ""; }; F96D3E9F08F272A7004A47F5 /* socket.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = socket.n; sourceTree = ""; }; F96D3EA008F272A7004A47F5 /* source.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = source.n; sourceTree = ""; }; F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SourceRCFile.3; sourceTree = ""; }; F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = ""; }; F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = ""; }; F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = ""; }; F96D3EA508F272A7004A47F5 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.3; sourceTree = ""; }; F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = ""; }; F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = ""; }; F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = ""; }; F96D3EA908F272A7004A47F5 /* StrMatch.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StrMatch.3; sourceTree = ""; }; F96D3EAA08F272A7004A47F5 /* subst.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = subst.n; sourceTree = ""; }; F96D3EAB08F272A7004A47F5 /* SubstObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SubstObj.3; sourceTree = ""; }; F96D3EAC08F272A7004A47F5 /* switch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = switch.n; sourceTree = ""; }; F96D3EAD08F272A7004A47F5 /* Tcl.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tcl.n; sourceTree = ""; }; F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tcl_Main.3; sourceTree = ""; }; F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TCL_MEM_DEBUG.3; sourceTree = ""; }; F96D3EB008F272A7004A47F5 /* tclsh.1 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tclsh.1; sourceTree = ""; }; F96D3EB108F272A7004A47F5 /* tcltest.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tcltest.n; sourceTree = ""; }; F96D3EB208F272A7004A47F5 /* tclvars.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tclvars.n; sourceTree = ""; }; F96D3EB308F272A7004A47F5 /* tell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tell.n; sourceTree = ""; }; F96D3EB408F272A7004A47F5 /* Thread.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Thread.3; sourceTree = ""; }; F96D3EB508F272A7004A47F5 /* time.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = time.n; sourceTree = ""; }; F96D3EB608F272A7004A47F5 /* tm.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tm.n; sourceTree = ""; }; F96D3EB708F272A7004A47F5 /* ToUpper.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ToUpper.3; sourceTree = ""; }; F96D3EB808F272A7004A47F5 /* trace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = trace.n; sourceTree = ""; }; F96D3EB908F272A7004A47F5 /* TraceCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TraceCmd.3; sourceTree = ""; }; F96D3EBA08F272A7004A47F5 /* TraceVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TraceVar.3; sourceTree = ""; }; F96D3EBB08F272A7004A47F5 /* Translate.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Translate.3; sourceTree = ""; }; F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = UniCharIsAlpha.3; sourceTree = ""; }; F96D3EBD08F272A7004A47F5 /* unknown.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unknown.n; sourceTree = ""; }; F96D3EBE08F272A7004A47F5 /* unload.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unload.n; sourceTree = ""; }; F96D3EBF08F272A7004A47F5 /* unset.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unset.n; sourceTree = ""; }; F96D3EC008F272A7004A47F5 /* update.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = update.n; sourceTree = ""; }; F96D3EC108F272A7004A47F5 /* uplevel.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = uplevel.n; sourceTree = ""; }; F96D3EC208F272A7004A47F5 /* UpVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = UpVar.3; sourceTree = ""; }; F96D3EC308F272A7004A47F5 /* upvar.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = upvar.n; sourceTree = ""; }; F96D3EC408F272A7004A47F5 /* Utf.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Utf.3; sourceTree = ""; }; F96D3EC508F272A7004A47F5 /* variable.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = variable.n; sourceTree = ""; }; F96D3EC608F272A7004A47F5 /* vwait.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = vwait.n; sourceTree = ""; }; F96D3EC708F272A7004A47F5 /* while.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = while.n; sourceTree = ""; }; F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = WrongNumArgs.3; sourceTree = ""; }; F96D3ECA08F272A7004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D3ECB08F272A7004A47F5 /* regc_color.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_color.c; sourceTree = ""; }; F96D3ECC08F272A7004A47F5 /* regc_cvec.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_cvec.c; sourceTree = ""; }; F96D3ECD08F272A7004A47F5 /* regc_lex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_lex.c; sourceTree = ""; }; F96D3ECE08F272A7004A47F5 /* regc_locale.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_locale.c; sourceTree = ""; }; F96D3ECF08F272A7004A47F5 /* regc_nfa.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_nfa.c; sourceTree = ""; }; F96D3ED008F272A7004A47F5 /* regcomp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regcomp.c; sourceTree = ""; }; F96D3ED108F272A7004A47F5 /* regcustom.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regcustom.h; sourceTree = ""; }; F96D3ED208F272A7004A47F5 /* rege_dfa.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = rege_dfa.c; sourceTree = ""; }; F96D3ED308F272A7004A47F5 /* regerror.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regerror.c; sourceTree = ""; }; F96D3ED408F272A7004A47F5 /* regerrs.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regerrs.h; sourceTree = ""; }; F96D3ED508F272A7004A47F5 /* regex.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regex.h; sourceTree = ""; }; F96D3ED608F272A7004A47F5 /* regexec.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regexec.c; sourceTree = ""; }; F96D3ED708F272A7004A47F5 /* regfree.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regfree.c; sourceTree = ""; }; F96D3ED808F272A7004A47F5 /* regfronts.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regfronts.c; sourceTree = ""; }; F96D3ED908F272A7004A47F5 /* regguts.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regguts.h; sourceTree = ""; }; F96D3EDA08F272A7004A47F5 /* tcl.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcl.decls; sourceTree = ""; }; F96D3EDB08F272A7004A47F5 /* tcl.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tcl.h; sourceTree = ""; }; F96D3EDC08F272A7004A47F5 /* tclAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAlloc.c; sourceTree = ""; }; F96D3EDD08F272A7004A47F5 /* tclAsync.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAsync.c; sourceTree = ""; }; F96D3EDE08F272A7004A47F5 /* tclBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclBasic.c; sourceTree = ""; }; F96D3EDF08F272A7004A47F5 /* tclBinary.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclBinary.c; sourceTree = ""; }; F96D3EE008F272A7004A47F5 /* tclCkalloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCkalloc.c; sourceTree = ""; }; F96D3EE108F272A7004A47F5 /* tclClock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclClock.c; sourceTree = ""; }; F96D3EE208F272A7004A47F5 /* tclCmdAH.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdAH.c; sourceTree = ""; }; F96D3EE308F272A7004A47F5 /* tclCmdIL.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdIL.c; sourceTree = ""; }; F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdMZ.c; sourceTree = ""; }; F96D3EE508F272A7004A47F5 /* tclCompCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompCmds.c; sourceTree = ""; }; F96D3EE608F272A7004A47F5 /* tclCompExpr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompExpr.c; sourceTree = ""; }; F96D3EE708F272A7004A47F5 /* tclCompile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompile.c; sourceTree = ""; }; F96D3EE808F272A7004A47F5 /* tclCompile.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclCompile.h; sourceTree = ""; }; F96D3EE908F272A7004A47F5 /* tclConfig.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclConfig.c; sourceTree = ""; }; F96D3EEA08F272A7004A47F5 /* tclDate.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclDate.c; sourceTree = ""; }; F96D3EEB08F272A7004A47F5 /* tclDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclDecls.h; sourceTree = ""; }; F96D3EEC08F272A7004A47F5 /* tclDictObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclDictObj.c; sourceTree = ""; }; F96D3EED08F272A7004A47F5 /* tclEncoding.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEncoding.c; sourceTree = ""; }; F96D3EEE08F272A7004A47F5 /* tclEnv.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEnv.c; sourceTree = ""; }; F96D3EEF08F272A7004A47F5 /* tclEvent.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEvent.c; sourceTree = ""; }; F96D3EF008F272A7004A47F5 /* tclExecute.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclExecute.c; sourceTree = ""; }; F96D3EF108F272A7004A47F5 /* tclFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclFCmd.c; sourceTree = ""; }; F96D3EF208F272A7004A47F5 /* tclFileName.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclFileName.c; sourceTree = ""; }; F96D3EF308F272A7004A47F5 /* tclFileSystem.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclFileSystem.h; sourceTree = ""; }; F96D3EF408F272A7004A47F5 /* tclGet.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclGet.c; sourceTree = ""; }; F96D3EF508F272A7004A47F5 /* tclGetDate.y */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.yacc; path = tclGetDate.y; sourceTree = ""; }; F96D3EF608F272A7004A47F5 /* tclHash.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclHash.c; sourceTree = ""; }; F96D3EF708F272A7004A47F5 /* tclHistory.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclHistory.c; sourceTree = ""; }; F96D3EF808F272A7004A47F5 /* tclIndexObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIndexObj.c; sourceTree = ""; }; F96D3EF908F272A7004A47F5 /* tclInt.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclInt.decls; sourceTree = ""; }; F96D3EFA08F272A7004A47F5 /* tclInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclInt.h; sourceTree = ""; }; F96D3EFB08F272A7004A47F5 /* tclIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIntDecls.h; sourceTree = ""; }; F96D3EFC08F272A7004A47F5 /* tclInterp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclInterp.c; sourceTree = ""; }; F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIntPlatDecls.h; sourceTree = ""; }; F96D3EFE08F272A7004A47F5 /* tclIO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIO.c; sourceTree = ""; }; F96D3EFF08F272A7004A47F5 /* tclIO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIO.h; sourceTree = ""; }; F96D3F0008F272A7004A47F5 /* tclIOCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOCmd.c; sourceTree = ""; }; F96D3F0108F272A7004A47F5 /* tclIOGT.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOGT.c; sourceTree = ""; }; F96D3F0208F272A7004A47F5 /* tclIORChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORChan.c; sourceTree = ""; }; F96D3F0308F272A7004A47F5 /* tclIOSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOSock.c; sourceTree = ""; }; F96D3F0408F272A7004A47F5 /* tclIOUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOUtil.c; sourceTree = ""; }; F96D3F0508F272A7004A47F5 /* tclLink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLink.c; sourceTree = ""; }; F96D3F0608F272A7004A47F5 /* tclListObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclListObj.c; sourceTree = ""; }; F96D3F0708F272A7004A47F5 /* tclLiteral.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLiteral.c; sourceTree = ""; }; F96D3F0808F272A7004A47F5 /* tclLoad.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoad.c; sourceTree = ""; }; F96D3F0908F272A7004A47F5 /* tclLoadNone.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadNone.c; sourceTree = ""; }; F96D3F0A08F272A7004A47F5 /* tclMain.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMain.c; sourceTree = ""; }; F96D3F0B08F272A7004A47F5 /* tclNamesp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclNamesp.c; sourceTree = ""; }; F96D3F0C08F272A7004A47F5 /* tclNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclNotify.c; sourceTree = ""; }; F96D3F0D08F272A7004A47F5 /* tclObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclObj.c; sourceTree = ""; }; F96D3F0E08F272A7004A47F5 /* tclPanic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPanic.c; sourceTree = ""; }; F96D3F0F08F272A7004A47F5 /* tclParse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclParse.c; sourceTree = ""; }; F96D3F1108F272A7004A47F5 /* tclPathObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPathObj.c; sourceTree = ""; }; F96D3F1208F272A7004A47F5 /* tclPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPipe.c; sourceTree = ""; }; F96D3F1308F272A7004A47F5 /* tclPkg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPkg.c; sourceTree = ""; }; F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPkgConfig.c; sourceTree = ""; }; F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclPlatDecls.h; sourceTree = ""; }; F96D3F1608F272A7004A47F5 /* tclPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclPort.h; sourceTree = ""; }; F96D3F1708F272A7004A47F5 /* tclPosixStr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPosixStr.c; sourceTree = ""; }; F96D3F1808F272A7004A47F5 /* tclPreserve.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPreserve.c; sourceTree = ""; }; F96D3F1908F272A7004A47F5 /* tclProc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclProc.c; sourceTree = ""; }; F96D3F1A08F272A7004A47F5 /* tclRegexp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclRegexp.c; sourceTree = ""; }; F96D3F1B08F272A7004A47F5 /* tclRegexp.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclRegexp.h; sourceTree = ""; }; F96D3F1C08F272A7004A47F5 /* tclResolve.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclResolve.c; sourceTree = ""; }; F96D3F1D08F272A7004A47F5 /* tclResult.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclResult.c; sourceTree = ""; }; F96D3F1E08F272A7004A47F5 /* tclScan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclScan.c; sourceTree = ""; }; F96D3F1F08F272A7004A47F5 /* tclStringObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStringObj.c; sourceTree = ""; }; F96D3F2408F272A7004A47F5 /* tclStrToD.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStrToD.c; sourceTree = ""; }; F96D3F2508F272A7004A47F5 /* tclStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubInit.c; sourceTree = ""; }; F96D3F2608F272A7004A47F5 /* tclStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubLib.c; sourceTree = ""; }; F96D3F2708F272A7004A47F5 /* tclTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTest.c; sourceTree = ""; }; F96D3F2808F272A7004A47F5 /* tclTestObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestObj.c; sourceTree = ""; }; F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestProcBodyObj.c; sourceTree = ""; }; F96D3F2A08F272A7004A47F5 /* tclThread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThread.c; sourceTree = ""; }; F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadAlloc.c; sourceTree = ""; }; F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadJoin.c; sourceTree = ""; }; F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadStorage.c; sourceTree = ""; }; F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadTest.c; sourceTree = ""; }; F96D3F2F08F272A7004A47F5 /* tclTimer.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTimer.c; sourceTree = ""; }; F96D3F3008F272A7004A47F5 /* tclTomMath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMath.h; sourceTree = ""; }; F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTomMathInterface.c; sourceTree = ""; }; F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = ""; }; F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = ""; }; F96D3F3408F272A7004A47F5 /* tclUtf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtf.c; sourceTree = ""; }; F96D3F3508F272A7004A47F5 /* tclUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtil.c; sourceTree = ""; }; F96D3F3608F272A7004A47F5 /* tclVar.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclVar.c; sourceTree = ""; }; F96D3F3708F272A7004A47F5 /* tommath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath.h; sourceTree = ""; }; F96D3F3908F272A8004A47F5 /* auto.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = auto.tcl; sourceTree = ""; }; F96D3F3A08F272A8004A47F5 /* clock.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.tcl; sourceTree = ""; }; F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D3F8C08F272A8004A47F5 /* history.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.tcl; sourceTree = ""; }; F96D3F8E08F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = ""; }; F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D3F9108F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = ""; }; F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D3F9308F272A8004A47F5 /* init.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.tcl; sourceTree = ""; }; F96D3F9508F272A8004A47F5 /* msgcat.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = msgcat.tcl; sourceTree = ""; }; F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D401808F272AA004A47F5 /* optparse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = optparse.tcl; sourceTree = ""; }; F96D401908F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D401A08F272AA004A47F5 /* package.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = package.tcl; sourceTree = ""; }; F96D401B08F272AA004A47F5 /* parray.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parray.tcl; sourceTree = ""; }; F96D401D08F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D401E08F272AA004A47F5 /* safe.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.tcl; sourceTree = ""; }; F96D401F08F272AA004A47F5 /* tclIndex */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclIndex; sourceTree = ""; }; F96D402108F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D402208F272AA004A47F5 /* tcltest.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.tcl; sourceTree = ""; }; F96D402308F272AA004A47F5 /* tm.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.tcl; sourceTree = ""; }; F96D425B08F272B2004A47F5 /* word.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = word.tcl; sourceTree = ""; }; F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_digs.c; sourceTree = ""; }; F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_sqr.c; sourceTree = ""; }; F96D426908F272B3004A47F5 /* bn_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add.c; sourceTree = ""; }; F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add_d.c; sourceTree = ""; }; F96D426C08F272B3004A47F5 /* bn_mp_and.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_and.c; sourceTree = ""; }; F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clamp.c; sourceTree = ""; }; F96D426E08F272B3004A47F5 /* bn_mp_clear.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear.c; sourceTree = ""; }; F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear_multi.c; sourceTree = ""; }; F96D427008F272B3004A47F5 /* bn_mp_cmp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp.c; sourceTree = ""; }; F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_d.c; sourceTree = ""; }; F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_mag.c; sourceTree = ""; }; F96D427408F272B3004A47F5 /* bn_mp_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_copy.c; sourceTree = ""; }; F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_count_bits.c; sourceTree = ""; }; F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = ""; }; F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = ""; }; F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = ""; }; F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = ""; }; F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = ""; }; F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = ""; }; F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_u32.c; sourceTree = ""; }; F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = ""; }; F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = ""; }; F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = ""; }; F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = ""; }; F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = ""; }; F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_size.c; sourceTree = ""; }; F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_mul.c; sourceTree = ""; }; F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_sqr.c; sourceTree = ""; }; F96D429508F272B3004A47F5 /* bn_mp_lshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lshd.c; sourceTree = ""; }; F96D429608F272B3004A47F5 /* bn_mp_mod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod.c; sourceTree = ""; }; F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_2d.c; sourceTree = ""; }; F96D429C08F272B3004A47F5 /* bn_mp_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul.c; sourceTree = ""; }; F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2.c; sourceTree = ""; }; F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2d.c; sourceTree = ""; }; F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_d.c; sourceTree = ""; }; F96D42A208F272B3004A47F5 /* bn_mp_neg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_neg.c; sourceTree = ""; }; F96D42A308F272B3004A47F5 /* bn_mp_or.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_or.c; sourceTree = ""; }; F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_size.c; sourceTree = ""; }; F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_smap.c; sourceTree = ""; }; F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_radix.c; sourceTree = ""; }; F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rshd.c; sourceTree = ""; }; F96D42BA08F272B3004A47F5 /* bn_mp_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set.c; sourceTree = ""; }; F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = ""; }; F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = ""; }; F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = ""; }; F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = ""; }; F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = ""; }; F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_ubin.c; sourceTree = ""; }; F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = ""; }; F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = ""; }; F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_radix.c; sourceTree = ""; }; F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_ubin_size.c; sourceTree = ""; }; F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = ""; }; F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = ""; }; F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = ""; }; F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = ""; }; F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = ""; }; F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = ""; }; F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = ""; }; F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = ""; }; F96D432A08F272B4004A47F5 /* tommath_superclass.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_superclass.h; sourceTree = ""; }; F96D432B08F272B4004A47F5 /* license.terms */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = license.terms; sourceTree = ""; }; F96D432E08F272B5004A47F5 /* configure.ac */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure.ac; sourceTree = ""; }; F96D432F08F272B5004A47F5 /* GNUmakefile */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = GNUmakefile; sourceTree = ""; }; F96D433108F272B5004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */ = {isa = PBXFileReference; explicitFileType = text.plist; fileEncoding = 4; path = "Tcl-Info.plist.in"; sourceTree = ""; }; F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXBundle.c; sourceTree = ""; }; F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXFCmd.c; sourceTree = ""; }; F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXNotify.c; sourceTree = ""; }; F96D434308F272B5004A47F5 /* README */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = README; sourceTree = ""; }; F96D434508F272B5004A47F5 /* all.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = all.tcl; sourceTree = ""; }; F96D434608F272B5004A47F5 /* append.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = append.test; sourceTree = ""; }; F96D434708F272B5004A47F5 /* appendComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = appendComp.test; sourceTree = ""; }; F96D434808F272B5004A47F5 /* assocd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = assocd.test; sourceTree = ""; }; F96D434908F272B5004A47F5 /* async.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = async.test; sourceTree = ""; }; F96D434A08F272B5004A47F5 /* autoMkindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = autoMkindex.test; sourceTree = ""; }; F96D434B08F272B5004A47F5 /* basic.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = basic.test; sourceTree = ""; }; F96D434C08F272B5004A47F5 /* binary.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = binary.test; sourceTree = ""; }; F96D434D08F272B5004A47F5 /* case.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = case.test; sourceTree = ""; }; F96D434E08F272B5004A47F5 /* chan.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chan.test; sourceTree = ""; }; F96D434F08F272B5004A47F5 /* clock.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.test; sourceTree = ""; }; F96D435008F272B5004A47F5 /* cmdAH.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdAH.test; sourceTree = ""; }; F96D435108F272B5004A47F5 /* cmdIL.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdIL.test; sourceTree = ""; }; F96D435208F272B5004A47F5 /* cmdInfo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdInfo.test; sourceTree = ""; }; F96D435308F272B5004A47F5 /* cmdMZ.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdMZ.test; sourceTree = ""; }; F96D435408F272B5004A47F5 /* compExpr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "compExpr-old.test"; sourceTree = ""; }; F96D435508F272B5004A47F5 /* compExpr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = compExpr.test; sourceTree = ""; }; F96D435608F272B5004A47F5 /* compile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = compile.test; sourceTree = ""; }; F96D435708F272B5004A47F5 /* concat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = concat.test; sourceTree = ""; }; F96D435808F272B5004A47F5 /* config.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = config.test; sourceTree = ""; }; F96D435908F272B5004A47F5 /* dcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dcall.test; sourceTree = ""; }; F96D435A08F272B5004A47F5 /* dict.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dict.test; sourceTree = ""; }; F96D435C08F272B5004A47F5 /* dstring.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dstring.test; sourceTree = ""; }; F96D435E08F272B5004A47F5 /* encoding.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = encoding.test; sourceTree = ""; }; F96D435F08F272B5004A47F5 /* env.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = env.test; sourceTree = ""; }; F96D436008F272B5004A47F5 /* error.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = error.test; sourceTree = ""; }; F96D436108F272B5004A47F5 /* eval.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = eval.test; sourceTree = ""; }; F96D436208F272B5004A47F5 /* event.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = event.test; sourceTree = ""; }; F96D436308F272B5004A47F5 /* exec.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = exec.test; sourceTree = ""; }; F96D436408F272B5004A47F5 /* execute.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = execute.test; sourceTree = ""; }; F96D436508F272B5004A47F5 /* expr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "expr-old.test"; sourceTree = ""; }; F96D436608F272B5004A47F5 /* expr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = expr.test; sourceTree = ""; }; F96D436708F272B6004A47F5 /* fCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fCmd.test; sourceTree = ""; }; F96D436808F272B6004A47F5 /* fileName.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fileName.test; sourceTree = ""; }; F96D436908F272B6004A47F5 /* fileSystem.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fileSystem.test; sourceTree = ""; }; F96D436A08F272B6004A47F5 /* for-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "for-old.test"; sourceTree = ""; }; F96D436B08F272B6004A47F5 /* for.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = for.test; sourceTree = ""; }; F96D436C08F272B6004A47F5 /* foreach.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = foreach.test; sourceTree = ""; }; F96D436D08F272B6004A47F5 /* format.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = format.test; sourceTree = ""; }; F96D436E08F272B6004A47F5 /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = ""; }; F96D436F08F272B6004A47F5 /* history.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.test; sourceTree = ""; }; F96D437008F272B6004A47F5 /* http.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.test; sourceTree = ""; }; F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd; sourceTree = ""; }; F96D437208F272B6004A47F5 /* httpold.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpold.test; sourceTree = ""; }; F96D437308F272B6004A47F5 /* if-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "if-old.test"; sourceTree = ""; }; F96D437408F272B6004A47F5 /* if.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = if.test; sourceTree = ""; }; F96D437508F272B6004A47F5 /* incr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "incr-old.test"; sourceTree = ""; }; F96D437608F272B6004A47F5 /* incr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = incr.test; sourceTree = ""; }; F96D437708F272B6004A47F5 /* indexObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = indexObj.test; sourceTree = ""; }; F96D437808F272B6004A47F5 /* info.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = info.test; sourceTree = ""; }; F96D437908F272B6004A47F5 /* init.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.test; sourceTree = ""; }; F96D437A08F272B6004A47F5 /* interp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = interp.test; sourceTree = ""; }; F96D437B08F272B6004A47F5 /* io.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = io.test; sourceTree = ""; }; F96D437C08F272B6004A47F5 /* ioCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioCmd.test; sourceTree = ""; }; F96D437D08F272B6004A47F5 /* iogt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iogt.test; sourceTree = ""; }; F96D437F08F272B6004A47F5 /* join.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = join.test; sourceTree = ""; }; F96D438008F272B6004A47F5 /* lindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lindex.test; sourceTree = ""; }; F96D438108F272B6004A47F5 /* link.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = link.test; sourceTree = ""; }; F96D438208F272B6004A47F5 /* linsert.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = linsert.test; sourceTree = ""; }; F96D438308F272B6004A47F5 /* list.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = list.test; sourceTree = ""; }; F96D438408F272B6004A47F5 /* listObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = listObj.test; sourceTree = ""; }; F96D438508F272B6004A47F5 /* llength.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = llength.test; sourceTree = ""; }; F96D438608F272B6004A47F5 /* load.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = load.test; sourceTree = ""; }; F96D438708F272B6004A47F5 /* lrange.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lrange.test; sourceTree = ""; }; F96D438808F272B6004A47F5 /* lrepeat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lrepeat.test; sourceTree = ""; }; F96D438908F272B6004A47F5 /* lreplace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lreplace.test; sourceTree = ""; }; F96D438A08F272B6004A47F5 /* lsearch.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lsearch.test; sourceTree = ""; }; F96D438B08F272B6004A47F5 /* lset.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lset.test; sourceTree = ""; }; F96D438C08F272B6004A47F5 /* lsetComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lsetComp.test; sourceTree = ""; }; F96D438D08F272B6004A47F5 /* macOSXFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXFCmd.test; sourceTree = ""; }; F96D438E08F272B6004A47F5 /* main.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = main.test; sourceTree = ""; }; F96D438F08F272B6004A47F5 /* misc.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = misc.test; sourceTree = ""; }; F96D439008F272B6004A47F5 /* msgcat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = msgcat.test; sourceTree = ""; }; F96D439108F272B6004A47F5 /* namespace-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "namespace-old.test"; sourceTree = ""; }; F96D439208F272B7004A47F5 /* namespace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = namespace.test; sourceTree = ""; }; F96D439308F272B7004A47F5 /* notify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = notify.test; sourceTree = ""; }; F96D439408F272B7004A47F5 /* obj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = obj.test; sourceTree = ""; }; F96D439508F272B7004A47F5 /* opt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = opt.test; sourceTree = ""; }; F96D439608F272B7004A47F5 /* package.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = package.test; sourceTree = ""; }; F96D439708F272B7004A47F5 /* parse.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parse.test; sourceTree = ""; }; F96D439808F272B7004A47F5 /* parseExpr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parseExpr.test; sourceTree = ""; }; F96D439908F272B7004A47F5 /* parseOld.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parseOld.test; sourceTree = ""; }; F96D439A08F272B7004A47F5 /* pid.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pid.test; sourceTree = ""; }; F96D439B08F272B7004A47F5 /* pkg.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkg.test; sourceTree = ""; }; F96D439C08F272B7004A47F5 /* pkgMkIndex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgMkIndex.test; sourceTree = ""; }; F96D439D08F272B7004A47F5 /* platform.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.test; sourceTree = ""; }; F96D439E08F272B7004A47F5 /* proc-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "proc-old.test"; sourceTree = ""; }; F96D439F08F272B7004A47F5 /* proc.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = proc.test; sourceTree = ""; }; F96D43A008F272B7004A47F5 /* pwd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pwd.test; sourceTree = ""; }; F96D43A108F272B7004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D43A208F272B7004A47F5 /* reg.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = reg.test; sourceTree = ""; }; F96D43A308F272B7004A47F5 /* regexp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexp.test; sourceTree = ""; }; F96D43A408F272B7004A47F5 /* regexpComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpComp.test; sourceTree = ""; }; F96D43A508F272B7004A47F5 /* registry.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = registry.test; sourceTree = ""; }; F96D43A608F272B7004A47F5 /* remote.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = remote.tcl; sourceTree = ""; }; F96D43A708F272B7004A47F5 /* rename.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = rename.test; sourceTree = ""; }; F96D43A808F272B7004A47F5 /* result.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = result.test; sourceTree = ""; }; F96D43A908F272B7004A47F5 /* safe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.test; sourceTree = ""; }; F96D43AA08F272B7004A47F5 /* scan.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = scan.test; sourceTree = ""; }; F96D43AB08F272B7004A47F5 /* security.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = security.test; sourceTree = ""; }; F96D43AC08F272B7004A47F5 /* set-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "set-old.test"; sourceTree = ""; }; F96D43AD08F272B7004A47F5 /* set.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = set.test; sourceTree = ""; }; F96D43AE08F272B7004A47F5 /* socket.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = socket.test; sourceTree = ""; }; F96D43AF08F272B7004A47F5 /* source.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = source.test; sourceTree = ""; }; F96D43B008F272B7004A47F5 /* split.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = split.test; sourceTree = ""; }; F96D43B108F272B7004A47F5 /* stack.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stack.test; sourceTree = ""; }; F96D43B208F272B7004A47F5 /* string.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = string.test; sourceTree = ""; }; F96D43B308F272B7004A47F5 /* stringComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stringComp.test; sourceTree = ""; }; F96D43B408F272B7004A47F5 /* stringObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stringObj.test; sourceTree = ""; }; F96D43B508F272B7004A47F5 /* subst.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = subst.test; sourceTree = ""; }; F96D43B608F272B7004A47F5 /* switch.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = switch.test; sourceTree = ""; }; F96D43B708F272B7004A47F5 /* tcltest.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.test; sourceTree = ""; }; F96D43B808F272B7004A47F5 /* thread.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = thread.test; sourceTree = ""; }; F96D43B908F272B7004A47F5 /* timer.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = timer.test; sourceTree = ""; }; F96D43BA08F272B7004A47F5 /* tm.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.test; sourceTree = ""; }; F96D43BB08F272B7004A47F5 /* trace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = trace.test; sourceTree = ""; }; F96D43BC08F272B7004A47F5 /* unixFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixFCmd.test; sourceTree = ""; }; F96D43BD08F272B7004A47F5 /* unixFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixFile.test; sourceTree = ""; }; F96D43BE08F272B7004A47F5 /* unixInit.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixInit.test; sourceTree = ""; }; F96D43BF08F272B7004A47F5 /* unixNotfy.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixNotfy.test; sourceTree = ""; }; F96D43C008F272B7004A47F5 /* unknown.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unknown.test; sourceTree = ""; }; F96D43C108F272B7004A47F5 /* unload.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unload.test; sourceTree = ""; }; F96D43C208F272B7004A47F5 /* uplevel.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uplevel.test; sourceTree = ""; }; F96D43C308F272B7004A47F5 /* upvar.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = upvar.test; sourceTree = ""; }; F96D43C408F272B7004A47F5 /* utf.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = utf.test; sourceTree = ""; }; F96D43C508F272B7004A47F5 /* util.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = util.test; sourceTree = ""; }; F96D43C608F272B7004A47F5 /* var.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = var.test; sourceTree = ""; }; F96D43C708F272B7004A47F5 /* while-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "while-old.test"; sourceTree = ""; }; F96D43C808F272B7004A47F5 /* while.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = while.test; sourceTree = ""; }; F96D43C908F272B7004A47F5 /* winConsole.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winConsole.test; sourceTree = ""; }; F96D43CA08F272B7004A47F5 /* winDde.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winDde.test; sourceTree = ""; }; F96D43CB08F272B7004A47F5 /* winFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFCmd.test; sourceTree = ""; }; F96D43CC08F272B7004A47F5 /* winFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFile.test; sourceTree = ""; }; F96D43CD08F272B7004A47F5 /* winNotify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winNotify.test; sourceTree = ""; }; F96D43CE08F272B7004A47F5 /* winPipe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winPipe.test; sourceTree = ""; }; F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = ""; }; F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = ""; }; F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = ""; }; F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = ""; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = ""; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = ""; }; F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = ""; }; F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = ""; }; F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = ""; }; F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = ""; }; F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = ""; }; F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = ""; }; F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = ""; }; F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = ""; }; F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = ""; }; F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = ""; }; F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = ""; }; F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = ""; }; F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = ""; }; F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = ""; }; F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = ""; }; F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = ""; }; F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = ""; }; F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = ""; }; F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = ""; }; F96D444708F272B9004A47F5 /* pkgc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgc.c; sourceTree = ""; }; F96D444808F272B9004A47F5 /* pkgd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgd.c; sourceTree = ""; }; F96D444908F272B9004A47F5 /* pkge.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkge.c; sourceTree = ""; }; F96D444B08F272B9004A47F5 /* pkgua.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgua.c; sourceTree = ""; }; F96D444C08F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D444D08F272B9004A47F5 /* install-sh */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = "install-sh"; sourceTree = ""; }; F96D444E08F272B9004A47F5 /* installManPage */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = installManPage; sourceTree = ""; }; F96D444F08F272B9004A47F5 /* ldAix */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = ldAix; sourceTree = ""; }; F96D445008F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; F96D445208F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D445308F272B9004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = ""; }; F96D445408F272B9004A47F5 /* tcl.spec */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.spec; sourceTree = ""; }; F96D445508F272B9004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = ""; }; F96D445608F272B9004A47F5 /* tclConfig.h.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = tclConfig.h.in; sourceTree = ""; }; F96D445708F272B9004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = ""; }; F96D445808F272B9004A47F5 /* tclLoadAix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadAix.c; sourceTree = ""; }; F96D445908F272B9004A47F5 /* tclLoadDl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadDl.c; sourceTree = ""; }; F96D445B08F272B9004A47F5 /* tclLoadDyld.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadDyld.c; sourceTree = ""; }; F96D445C08F272B9004A47F5 /* tclLoadNext.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadNext.c; sourceTree = ""; }; F96D445D08F272B9004A47F5 /* tclLoadOSF.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadOSF.c; sourceTree = ""; }; F96D445E08F272B9004A47F5 /* tclLoadShl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadShl.c; sourceTree = ""; }; F96D445F08F272B9004A47F5 /* tclUnixChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixChan.c; sourceTree = ""; }; F96D446008F272B9004A47F5 /* tclUnixEvent.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixEvent.c; sourceTree = ""; }; F96D446108F272B9004A47F5 /* tclUnixFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixFCmd.c; sourceTree = ""; }; F96D446208F272B9004A47F5 /* tclUnixFile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixFile.c; sourceTree = ""; }; F96D446308F272B9004A47F5 /* tclUnixInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixInit.c; sourceTree = ""; }; F96D446408F272B9004A47F5 /* tclUnixNotfy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixNotfy.c; sourceTree = ""; }; F96D446508F272B9004A47F5 /* tclUnixPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixPipe.c; sourceTree = ""; }; F96D446608F272B9004A47F5 /* tclUnixPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixPort.h; sourceTree = ""; }; F96D446708F272B9004A47F5 /* tclUnixSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixSock.c; sourceTree = ""; }; F96D446808F272B9004A47F5 /* tclUnixTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTest.c; sourceTree = ""; }; F96D446908F272B9004A47F5 /* tclUnixThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixThrd.c; sourceTree = ""; }; F96D446B08F272B9004A47F5 /* tclUnixTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTime.c; sourceTree = ""; }; F96D446C08F272B9004A47F5 /* tclXtNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtNotify.c; sourceTree = ""; }; F96D446D08F272B9004A47F5 /* tclXtTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtTest.c; sourceTree = ""; }; F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = ""; }; F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = ""; }; F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = ""; }; F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = ""; }; F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = ""; }; F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = ""; }; F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = ""; }; F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = ""; }; F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = ""; }; F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = ""; }; F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = ""; }; F96D448008F272BA004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = ""; }; F96D448108F272BA004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = ""; }; F96D448208F272BA004A47F5 /* tcl.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.rc; sourceTree = ""; }; F96D448308F272BA004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = ""; }; F96D448408F272BA004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = ""; }; F96D448608F272BA004A47F5 /* tclsh.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclsh.rc; sourceTree = ""; }; F96D448708F272BA004A47F5 /* tclWin32Dll.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWin32Dll.c; sourceTree = ""; }; F96D448808F272BA004A47F5 /* tclWinChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinChan.c; sourceTree = ""; }; F96D448908F272BA004A47F5 /* tclWinConsole.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinConsole.c; sourceTree = ""; }; F96D448A08F272BA004A47F5 /* tclWinDde.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinDde.c; sourceTree = ""; }; F96D448B08F272BA004A47F5 /* tclWinError.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinError.c; sourceTree = ""; }; F96D448C08F272BA004A47F5 /* tclWinFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinFCmd.c; sourceTree = ""; }; F96D448D08F272BA004A47F5 /* tclWinFile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinFile.c; sourceTree = ""; }; F96D448E08F272BA004A47F5 /* tclWinInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinInit.c; sourceTree = ""; }; F96D448F08F272BA004A47F5 /* tclWinInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinInt.h; sourceTree = ""; }; F96D449008F272BA004A47F5 /* tclWinLoad.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinLoad.c; sourceTree = ""; }; F96D449108F272BA004A47F5 /* tclWinNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinNotify.c; sourceTree = ""; }; F96D449208F272BA004A47F5 /* tclWinPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinPipe.c; sourceTree = ""; }; F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = ""; }; F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = ""; }; F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = ""; }; F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = ""; }; F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = ""; }; F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = ""; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = ""; }; F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = ""; }; F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = ""; }; F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = ""; }; F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = ""; }; F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = ""; }; F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = ""; }; F974D5790FBE7E9C00BF728B /* tcl.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.pc.in; sourceTree = ""; }; F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Common.xcconfig"; sourceTree = ""; }; F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Release.xcconfig"; sourceTree = ""; }; F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Debug.xcconfig"; sourceTree = ""; }; F9903CAF094FAADA004613E9 /* tclTomMath.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclTomMath.decls; sourceTree = ""; }; F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMathDecls.h; sourceTree = ""; }; F99D61180EF5573A00BBFE01 /* TclZlib.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TclZlib.3; sourceTree = ""; }; F9A3084B08F2D4CE00BAE1AB /* tclsh */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tclsh; sourceTree = BUILT_PRODUCTS_DIR; }; F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; }; F9A493240CEBF38300B78AE2 /* chanio.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chanio.test; sourceTree = ""; }; F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = ""; }; F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = ""; }; F9ECB1CA0B2652D300A28025 /* apply.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = apply.test; sourceTree = ""; }; F9ECB1CB0B26534C00A28025 /* mathop.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mathop.test; sourceTree = ""; }; F9ECB1E10B26543C00A28025 /* platform_shell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform_shell.n; sourceTree = ""; }; F9ECB1E20B26543C00A28025 /* platform.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform.n; sourceTree = ""; }; F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.dtrace; path = tclDTrace.d; sourceTree = ""; }; F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixCompat.c; sourceTree = ""; }; /* End PBXFileReference section */ /* Begin PBXFrameworksBuildPhase section */ 8DD76FAD0486AB0100D96B5E /* Frameworks */ = { isa = PBXFrameworksBuildPhase; buildActionMask = 2147483647; files = ( F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */, F96437E70EF0D652003F468E /* libz.dylib in Frameworks */, ); runOnlyForDeploymentPostprocessing = 0; }; /* End PBXFrameworksBuildPhase section */ /* Begin PBXGroup section */ 08FB7794FE84155DC02AAC07 /* Tcl */ = { isa = PBXGroup; children = ( F96D3DF608F27169004A47F5 /* Tcl Sources */, F966C06F08F281DC005CB29B /* Frameworks */, 1AB674ADFE9D54B511CA2CBB /* Products */, ); comments = "Copyright (c) 2004-2009 Daniel A. Steffen \nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\n"; name = Tcl; path = .; sourceTree = SOURCE_ROOT; }; 1AB674ADFE9D54B511CA2CBB /* Products */ = { isa = PBXGroup; children = ( F9A3084B08F2D4CE00BAE1AB /* tclsh */, 8DD76FB20486AB0100D96B5E /* tcltest */, F9A3084E08F2D4F400BAE1AB /* Tcl.framework */, ); includeInIndex = 0; name = Products; sourceTree = ""; }; F9183E690EFC81560030B814 /* pkgs */ = { isa = PBXGroup; children = ( F9183E6A0EFC81560030B814 /* README */, F946FB8B0FBE3AED00CD6495 /* itcl */, F9183E8F0EFC817B0030B814 /* tdbc */, ); path = pkgs; sourceTree = ""; }; F966C06F08F281DC005CB29B /* Frameworks */ = { isa = PBXGroup; children = ( F966C07408F2820D005CB29B /* CoreFoundation.framework */, F96437E60EF0D652003F468E /* libz.dylib */, ); name = Frameworks; sourceTree = ""; }; F96D3DF608F27169004A47F5 /* Tcl Sources */ = { isa = PBXGroup; children = ( F96D3EC908F272A7004A47F5 /* generic */, F96D432C08F272B4004A47F5 /* macosx */, F96D443E08F272B9004A47F5 /* unix */, F96D425C08F272B2004A47F5 /* libtommath */, F96D446E08F272B9004A47F5 /* win */, F96D3F3808F272A7004A47F5 /* library */, F96D434408F272B5004A47F5 /* tests */, F96D3DFC08F272A4004A47F5 /* doc */, F96D43D008F272B8004A47F5 /* tools */, F9183E690EFC81560030B814 /* pkgs */, F96D3DFA08F272A4004A47F5 /* ChangeLog */, F96D3DFB08F272A4004A47F5 /* changes */, F96D434308F272B5004A47F5 /* README.md */, F96D432B08F272B4004A47F5 /* license.terms */, ); name = "Tcl Sources"; sourceTree = TCL_SRCROOT; }; F96D3DFC08F272A4004A47F5 /* doc */ = { isa = PBXGroup; children = ( F96D3DFD08F272A4004A47F5 /* Access.3 */, F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */, F96D3DFF08F272A4004A47F5 /* after.n */, F96D3E0008F272A4004A47F5 /* Alloc.3 */, F96D3E0108F272A4004A47F5 /* AllowExc.3 */, F96D3E0208F272A4004A47F5 /* append.n */, F96D3E0308F272A4004A47F5 /* AppInit.3 */, F96D3E0408F272A5004A47F5 /* array.n */, F96D3E0508F272A5004A47F5 /* AssocData.3 */, F96D3E0608F272A5004A47F5 /* Async.3 */, F96D3E0708F272A5004A47F5 /* BackgdErr.3 */, F96D3E0808F272A5004A47F5 /* Backslash.3 */, F96D3E0908F272A5004A47F5 /* bgerror.n */, F96D3E0A08F272A5004A47F5 /* binary.n */, F96D3E0B08F272A5004A47F5 /* BoolObj.3 */, F96D3E0C08F272A5004A47F5 /* break.n */, F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */, F96D3E0E08F272A5004A47F5 /* CallDel.3 */, F96D3E0F08F272A5004A47F5 /* case.n */, F96D3E1008F272A5004A47F5 /* catch.n */, F96D3E1108F272A5004A47F5 /* cd.n */, F96D3E1208F272A5004A47F5 /* chan.n */, F96D3E1308F272A5004A47F5 /* ChnlStack.3 */, F93599CF0DF1F87F00E04F67 /* Class.3 */, F93599D00DF1F89E00E04F67 /* class.n */, F96D3E1408F272A5004A47F5 /* clock.n */, F96D3E1508F272A5004A47F5 /* close.n */, F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */, F96D3E1708F272A5004A47F5 /* Concat.3 */, F96D3E1808F272A5004A47F5 /* concat.n */, F96D3E1908F272A5004A47F5 /* continue.n */, F93599D20DF1F8DF00E04F67 /* copy.n */, F974D5720FBE7DC600BF728B /* coroutine.n */, F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */, F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */, F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */, F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */, F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */, F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */, F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */, F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */, F96D3E2208F272A5004A47F5 /* CrtAlias.3 */, F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */, F96D3E2408F272A5004A47F5 /* CrtTrace.3 */, F96D3E2508F272A5004A47F5 /* dde.n */, F93599D30DF1F8F500E04F67 /* define.n */, F96D3E2608F272A5004A47F5 /* DetachPids.3 */, F96D3E2708F272A5004A47F5 /* dict.n */, F96D3E2808F272A5004A47F5 /* DictObj.3 */, F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */, F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */, F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */, F96D3E2C08F272A5004A47F5 /* DString.3 */, F96D3E2D08F272A5004A47F5 /* DumpActiveMemory.3 */, F96D3E2E08F272A5004A47F5 /* Encoding.3 */, F96D3E2F08F272A5004A47F5 /* encoding.n */, F96D3E3008F272A5004A47F5 /* Ensemble.3 */, F96D3E3108F272A5004A47F5 /* Environment.3 */, F96D3E3208F272A5004A47F5 /* eof.n */, F96D3E3308F272A5004A47F5 /* error.n */, F96D3E3408F272A5004A47F5 /* Eval.3 */, F96D3E3508F272A5004A47F5 /* eval.n */, F96D3E3608F272A5004A47F5 /* exec.n */, F96D3E3708F272A5004A47F5 /* Exit.3 */, F96D3E3808F272A5004A47F5 /* exit.n */, F96D3E3908F272A5004A47F5 /* expr.n */, F96D3E3A08F272A5004A47F5 /* ExprLong.3 */, F96D3E3B08F272A5004A47F5 /* ExprLongObj.3 */, F96D3E3C08F272A5004A47F5 /* fblocked.n */, F96D3E3D08F272A5004A47F5 /* fconfigure.n */, F96D3E3E08F272A5004A47F5 /* fcopy.n */, F96D3E3F08F272A5004A47F5 /* file.n */, F96D3E4008F272A5004A47F5 /* fileevent.n */, F96D3E4108F272A5004A47F5 /* filename.n */, F96D3E4208F272A5004A47F5 /* FileSystem.3 */, F96D3E4308F272A5004A47F5 /* FindExec.3 */, F96D3E4408F272A5004A47F5 /* flush.n */, F96D3E4508F272A5004A47F5 /* for.n */, F96D3E4608F272A5004A47F5 /* foreach.n */, F96D3E4708F272A5004A47F5 /* format.n */, F96D3E4808F272A5004A47F5 /* GetCwd.3 */, F96D3E4908F272A5004A47F5 /* GetHostName.3 */, F96D3E4A08F272A5004A47F5 /* GetIndex.3 */, F96D3E4B08F272A5004A47F5 /* GetInt.3 */, F96D3E4C08F272A5004A47F5 /* GetOpnFl.3 */, F96D3E4D08F272A5004A47F5 /* gets.n */, F96D3E4E08F272A5004A47F5 /* GetStdChan.3 */, F96D3E4F08F272A5004A47F5 /* GetTime.3 */, F96D3E5008F272A5004A47F5 /* GetVersion.3 */, F96D3E5108F272A5004A47F5 /* glob.n */, F96D3E5208F272A6004A47F5 /* global.n */, F96D3E5308F272A6004A47F5 /* Hash.3 */, F96D3E5408F272A6004A47F5 /* history.n */, F96D3E5508F272A6004A47F5 /* http.n */, F96D3E5608F272A6004A47F5 /* if.n */, F96D3E5708F272A6004A47F5 /* incr.n */, F96D3E5808F272A6004A47F5 /* info.n */, F96D3E5908F272A6004A47F5 /* Init.3 */, F96D3E5A08F272A6004A47F5 /* InitStubs.3 */, F96D3E5B08F272A6004A47F5 /* Interp.3 */, F96D3E5C08F272A6004A47F5 /* interp.n */, F96D3E5D08F272A6004A47F5 /* IntObj.3 */, F96D3E5E08F272A6004A47F5 /* join.n */, F96D3E5F08F272A6004A47F5 /* lappend.n */, F96D3E6008F272A6004A47F5 /* lassign.n */, F96D3E6108F272A6004A47F5 /* library.n */, F96D3E6208F272A6004A47F5 /* Limit.3 */, F96D3E6308F272A6004A47F5 /* lindex.n */, F96D3E6408F272A6004A47F5 /* LinkVar.3 */, F96D3E6508F272A6004A47F5 /* linsert.n */, F96D3E6608F272A6004A47F5 /* list.n */, F96D3E6708F272A6004A47F5 /* ListObj.3 */, F96D3E6808F272A6004A47F5 /* llength.n */, F96D3E6908F272A6004A47F5 /* load.n */, F96D3E6A08F272A6004A47F5 /* lrange.n */, F96D3E6B08F272A6004A47F5 /* lrepeat.n */, F96D3E6C08F272A6004A47F5 /* lreplace.n */, F96D3E6D08F272A6004A47F5 /* lsearch.n */, F96D3E6E08F272A6004A47F5 /* lset.n */, F96D3E6F08F272A6004A47F5 /* lsort.n */, F96D3E7008F272A6004A47F5 /* man.macros */, F96D3E7108F272A6004A47F5 /* mathfunc.n */, F96D3E7208F272A6004A47F5 /* memory.n */, F93599D40DF1F91900E04F67 /* Method.3 */, F96D3E7308F272A6004A47F5 /* msgcat.n */, F93599D50DF1F93700E04F67 /* my.n */, F96D3E7408F272A6004A47F5 /* Namespace.3 */, F96D3E7508F272A6004A47F5 /* namespace.n */, F93599D60DF1F95000E04F67 /* next.n */, F96D3E7608F272A6004A47F5 /* Notifier.3 */, F96D3E7708F272A6004A47F5 /* Object.3 */, F93599D70DF1F96800E04F67 /* object.n */, F96D3E7808F272A6004A47F5 /* ObjectType.3 */, F96D3E7908F272A6004A47F5 /* open.n */, F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */, F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */, F96D3E7C08F272A6004A47F5 /* package.n */, F96D3E7D08F272A6004A47F5 /* packagens.n */, F96D3E7E08F272A6004A47F5 /* Panic.3 */, F96D3E7F08F272A6004A47F5 /* ParseCmd.3 */, F96D3E8008F272A6004A47F5 /* pid.n */, F96D3E8108F272A6004A47F5 /* pkgMkIndex.n */, F96D3E8208F272A6004A47F5 /* PkgRequire.3 */, F9ECB1E10B26543C00A28025 /* platform_shell.n */, F9ECB1E20B26543C00A28025 /* platform.n */, F96D3E8308F272A6004A47F5 /* Preserve.3 */, F96D3E8408F272A6004A47F5 /* PrintDbl.3 */, F96D3E8508F272A6004A47F5 /* proc.n */, F96D3E8608F272A6004A47F5 /* puts.n */, F96D3E8708F272A6004A47F5 /* pwd.n */, F96D3E8808F272A6004A47F5 /* re_syntax.n */, F96D3E8908F272A6004A47F5 /* read.n */, F96D3E8A08F272A6004A47F5 /* RecEvalObj.3 */, F96D3E8B08F272A6004A47F5 /* RecordEval.3 */, F96D3E8C08F272A6004A47F5 /* RegConfig.3 */, F96D3E8D08F272A6004A47F5 /* RegExp.3 */, F96D3E8E08F272A6004A47F5 /* regexp.n */, F96D3E8F08F272A6004A47F5 /* registry.n */, F96D3E9008F272A6004A47F5 /* regsub.n */, F96D3E9108F272A6004A47F5 /* rename.n */, F96D3E9208F272A6004A47F5 /* return.n */, F96D3E9308F272A6004A47F5 /* safe.n */, F96D3E9408F272A6004A47F5 /* SaveResult.3 */, F96D3E9508F272A6004A47F5 /* scan.n */, F96D3E9608F272A6004A47F5 /* seek.n */, F93599D80DF1F98300E04F67 /* self.n */, F96D3E9708F272A6004A47F5 /* set.n */, F96D3E9808F272A6004A47F5 /* SetChanErr.3 */, F96D3E9908F272A6004A47F5 /* SetErrno.3 */, F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */, F96D3E9B08F272A7004A47F5 /* SetResult.3 */, F96D3E9C08F272A7004A47F5 /* SetVar.3 */, F96D3E9D08F272A7004A47F5 /* Signal.3 */, F96D3E9E08F272A7004A47F5 /* Sleep.3 */, F96D3E9F08F272A7004A47F5 /* socket.n */, F96D3EA008F272A7004A47F5 /* source.n */, F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */, F96D3EA208F272A7004A47F5 /* split.n */, F96D3EA308F272A7004A47F5 /* SplitList.3 */, F96D3EA408F272A7004A47F5 /* SplitPath.3 */, F96D3EA508F272A7004A47F5 /* StaticPkg.3 */, F96D3EA608F272A7004A47F5 /* StdChannels.3 */, F96D3EA708F272A7004A47F5 /* string.n */, F96D3EA808F272A7004A47F5 /* StringObj.3 */, F96D3EA908F272A7004A47F5 /* StrMatch.3 */, F96D3EAA08F272A7004A47F5 /* subst.n */, F96D3EAB08F272A7004A47F5 /* SubstObj.3 */, F96D3EAC08F272A7004A47F5 /* switch.n */, F974D5760FBE7E1900BF728B /* tailcall.n */, F96D3EAD08F272A7004A47F5 /* Tcl.n */, F99D61180EF5573A00BBFE01 /* TclZlib.3 */, F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */, F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */, F96D3EB008F272A7004A47F5 /* tclsh.1 */, F96D3EB108F272A7004A47F5 /* tcltest.n */, F96D3EB208F272A7004A47F5 /* tclvars.n */, F96D3EB308F272A7004A47F5 /* tell.n */, F96D3EB408F272A7004A47F5 /* Thread.3 */, F9183E640EFC80CD0030B814 /* throw.n */, F96D3EB508F272A7004A47F5 /* time.n */, F96D3EB608F272A7004A47F5 /* tm.n */, F96D3EB708F272A7004A47F5 /* ToUpper.3 */, F96D3EB808F272A7004A47F5 /* trace.n */, F96D3EB908F272A7004A47F5 /* TraceCmd.3 */, F96D3EBA08F272A7004A47F5 /* TraceVar.3 */, F96D3EBB08F272A7004A47F5 /* Translate.3 */, F9183E650EFC80D70030B814 /* try.n */, F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */, F96D3EBD08F272A7004A47F5 /* unknown.n */, F96D3EBE08F272A7004A47F5 /* unload.n */, F96D3EBF08F272A7004A47F5 /* unset.n */, F96D3EC008F272A7004A47F5 /* update.n */, F96D3EC108F272A7004A47F5 /* uplevel.n */, F96D3EC208F272A7004A47F5 /* UpVar.3 */, F96D3EC308F272A7004A47F5 /* upvar.n */, F96D3EC408F272A7004A47F5 /* Utf.3 */, F96D3EC508F272A7004A47F5 /* variable.n */, F96D3EC608F272A7004A47F5 /* vwait.n */, F96D3EC708F272A7004A47F5 /* while.n */, F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */, F915432D0EF201EE0032D1E8 /* zlib.n */, ); path = doc; sourceTree = ""; }; F96D3EC908F272A7004A47F5 /* generic */ = { isa = PBXGroup; children = ( F96D3ECA08F272A7004A47F5 /* README */, F96D3ECB08F272A7004A47F5 /* regc_color.c */, F96D3ECC08F272A7004A47F5 /* regc_cvec.c */, F96D3ECD08F272A7004A47F5 /* regc_lex.c */, F96D3ECE08F272A7004A47F5 /* regc_locale.c */, F96D3ECF08F272A7004A47F5 /* regc_nfa.c */, F96D3ED008F272A7004A47F5 /* regcomp.c */, F96D3ED108F272A7004A47F5 /* regcustom.h */, F96D3ED208F272A7004A47F5 /* rege_dfa.c */, F96D3ED308F272A7004A47F5 /* regerror.c */, F96D3ED408F272A7004A47F5 /* regerrs.h */, F96D3ED508F272A7004A47F5 /* regex.h */, F96D3ED608F272A7004A47F5 /* regexec.c */, F96D3ED708F272A7004A47F5 /* regfree.c */, F96D3ED808F272A7004A47F5 /* regfronts.c */, F96D3ED908F272A7004A47F5 /* regguts.h */, F96D3EDA08F272A7004A47F5 /* tcl.decls */, F96D3EDB08F272A7004A47F5 /* tcl.h */, F96D3EDC08F272A7004A47F5 /* tclAlloc.c */, F96D3EDD08F272A7004A47F5 /* tclAsync.c */, F96D3EDE08F272A7004A47F5 /* tclBasic.c */, F96D3EDF08F272A7004A47F5 /* tclBinary.c */, F96D3EE008F272A7004A47F5 /* tclCkalloc.c */, F96D3EE108F272A7004A47F5 /* tclClock.c */, F96D3EE208F272A7004A47F5 /* tclCmdAH.c */, F96D3EE308F272A7004A47F5 /* tclCmdIL.c */, F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */, F96D3EE508F272A7004A47F5 /* tclCompCmds.c */, F96D3EE608F272A7004A47F5 /* tclCompExpr.c */, F96D3EE708F272A7004A47F5 /* tclCompile.c */, F96D3EE808F272A7004A47F5 /* tclCompile.h */, F96D3EE908F272A7004A47F5 /* tclConfig.c */, F96D3EEA08F272A7004A47F5 /* tclDate.c */, F96D3EEB08F272A7004A47F5 /* tclDecls.h */, F96D3EEC08F272A7004A47F5 /* tclDictObj.c */, F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */, F96D3EED08F272A7004A47F5 /* tclEncoding.c */, F96D3EEE08F272A7004A47F5 /* tclEnv.c */, F96D3EEF08F272A7004A47F5 /* tclEvent.c */, F96D3EF008F272A7004A47F5 /* tclExecute.c */, F96D3EF108F272A7004A47F5 /* tclFCmd.c */, F96D3EF208F272A7004A47F5 /* tclFileName.c */, F96D3EF308F272A7004A47F5 /* tclFileSystem.h */, F96D3EF408F272A7004A47F5 /* tclGet.c */, F96D3EF508F272A7004A47F5 /* tclGetDate.y */, F96D3EF608F272A7004A47F5 /* tclHash.c */, F96D3EF708F272A7004A47F5 /* tclHistory.c */, F96D3EF808F272A7004A47F5 /* tclIndexObj.c */, F96D3EF908F272A7004A47F5 /* tclInt.decls */, F96D3EFA08F272A7004A47F5 /* tclInt.h */, F96D3EFB08F272A7004A47F5 /* tclIntDecls.h */, F96D3EFC08F272A7004A47F5 /* tclInterp.c */, F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */, F96D3EFE08F272A7004A47F5 /* tclIO.c */, F96D3EFF08F272A7004A47F5 /* tclIO.h */, F96D3F0008F272A7004A47F5 /* tclIOCmd.c */, F96D3F0108F272A7004A47F5 /* tclIOGT.c */, F96D3F0208F272A7004A47F5 /* tclIORChan.c */, F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */, F96D3F0308F272A7004A47F5 /* tclIOSock.c */, F96D3F0408F272A7004A47F5 /* tclIOUtil.c */, F96D3F0508F272A7004A47F5 /* tclLink.c */, F96D3F0608F272A7004A47F5 /* tclListObj.c */, F96D3F0708F272A7004A47F5 /* tclLiteral.c */, F96D3F0808F272A7004A47F5 /* tclLoad.c */, F96D3F0908F272A7004A47F5 /* tclLoadNone.c */, F96D3F0A08F272A7004A47F5 /* tclMain.c */, F96D3F0B08F272A7004A47F5 /* tclNamesp.c */, F96D3F0C08F272A7004A47F5 /* tclNotify.c */, F96D3F0D08F272A7004A47F5 /* tclObj.c */, F93599B20DF1F75400E04F67 /* tclOO.c */, F93599B40DF1F75900E04F67 /* tclOO.decls */, F93599B50DF1F75D00E04F67 /* tclOO.h */, F93599B60DF1F76100E04F67 /* tclOOBasic.c */, F93599B80DF1F76600E04F67 /* tclOOCall.c */, F93599BA0DF1F76A00E04F67 /* tclOODecls.h */, F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */, F93599BD0DF1F77400E04F67 /* tclOOInfo.c */, F93599BF0DF1F77900E04F67 /* tclOOInt.h */, F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, F96D3F1208F272A7004A47F5 /* tclPipe.c */, F96D3F1308F272A7004A47F5 /* tclPkg.c */, F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */, F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */, F96D3F1608F272A7004A47F5 /* tclPort.h */, F96D3F1708F272A7004A47F5 /* tclPosixStr.c */, F96D3F1808F272A7004A47F5 /* tclPreserve.c */, F96D3F1908F272A7004A47F5 /* tclProc.c */, F96D3F1A08F272A7004A47F5 /* tclRegexp.c */, F96D3F1B08F272A7004A47F5 /* tclRegexp.h */, F96D3F1C08F272A7004A47F5 /* tclResolve.c */, F96D3F1D08F272A7004A47F5 /* tclResult.c */, F96D3F1E08F272A7004A47F5 /* tclScan.c */, F96D3F1F08F272A7004A47F5 /* tclStringObj.c */, F96D3F2408F272A7004A47F5 /* tclStrToD.c */, F96D3F2508F272A7004A47F5 /* tclStubInit.c */, F96D3F2608F272A7004A47F5 /* tclStubLib.c */, F96D3F2708F272A7004A47F5 /* tclTest.c */, F96D3F2808F272A7004A47F5 /* tclTestObj.c */, F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */, F96D3F2A08F272A7004A47F5 /* tclThread.c */, F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */, F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */, F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */, F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */, F96D3F2F08F272A7004A47F5 /* tclTimer.c */, F9903CAF094FAADA004613E9 /* tclTomMath.decls */, F96D3F3008F272A7004A47F5 /* tclTomMath.h */, F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */, F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */, F96D3F3208F272A7004A47F5 /* tclTrace.c */, F96D3F3308F272A7004A47F5 /* tclUniData.c */, F96D3F3408F272A7004A47F5 /* tclUtf.c */, F96D3F3508F272A7004A47F5 /* tclUtil.c */, F96D3F3608F272A7004A47F5 /* tclVar.c */, F96437C90EF0D4B2003F468E /* tclZlib.c */, F96D3F3708F272A7004A47F5 /* tommath.h */, ); path = generic; sourceTree = ""; }; F96D3F3808F272A7004A47F5 /* library */ = { isa = PBXGroup; children = ( F96D3F3908F272A8004A47F5 /* auto.tcl */, F96D3F3A08F272A8004A47F5 /* clock.tcl */, F96D3F3B08F272A8004A47F5 /* dde */, F96D3F8C08F272A8004A47F5 /* history.tcl */, F96D3F8D08F272A8004A47F5 /* http */, F96D3F9008F272A8004A47F5 /* http1.0 */, F96D3F9308F272A8004A47F5 /* init.tcl */, F96D3F9408F272A8004A47F5 /* msgcat */, F96D401708F272AA004A47F5 /* opt */, F96D401A08F272AA004A47F5 /* package.tcl */, F96D401B08F272AA004A47F5 /* parray.tcl */, F9ECB1110B26521500A28025 /* platform */, F96D401C08F272AA004A47F5 /* reg */, F96D401E08F272AA004A47F5 /* safe.tcl */, F96D401F08F272AA004A47F5 /* tclIndex */, F96D402008F272AA004A47F5 /* tcltest */, F96D402308F272AA004A47F5 /* tm.tcl */, F96D425B08F272B2004A47F5 /* word.tcl */, ); path = library; sourceTree = ""; }; F96D3F3B08F272A8004A47F5 /* dde */ = { isa = PBXGroup; children = ( F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */, ); path = dde; sourceTree = ""; }; F96D3F8D08F272A8004A47F5 /* http */ = { isa = PBXGroup; children = ( F96D3F8E08F272A8004A47F5 /* http.tcl */, F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */, ); path = http; sourceTree = ""; }; F96D3F9008F272A8004A47F5 /* http1.0 */ = { isa = PBXGroup; children = ( F96D3F9108F272A8004A47F5 /* http.tcl */, F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */, ); path = http1.0; sourceTree = ""; }; F96D3F9408F272A8004A47F5 /* msgcat */ = { isa = PBXGroup; children = ( F96D3F9508F272A8004A47F5 /* msgcat.tcl */, F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */, ); path = msgcat; sourceTree = ""; }; F96D401708F272AA004A47F5 /* opt */ = { isa = PBXGroup; children = ( F96D401808F272AA004A47F5 /* optparse.tcl */, F96D401908F272AA004A47F5 /* pkgIndex.tcl */, ); path = opt; sourceTree = ""; }; F96D401C08F272AA004A47F5 /* reg */ = { isa = PBXGroup; children = ( F96D401D08F272AA004A47F5 /* pkgIndex.tcl */, ); path = reg; sourceTree = ""; }; F96D402008F272AA004A47F5 /* tcltest */ = { isa = PBXGroup; children = ( F96D402108F272AA004A47F5 /* pkgIndex.tcl */, F96D402208F272AA004A47F5 /* tcltest.tcl */, ); path = tcltest; sourceTree = ""; }; F96D425C08F272B2004A47F5 /* libtommath */ = { isa = PBXGroup; children = ( F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */, F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */, F96D426908F272B3004A47F5 /* bn_mp_add.c */, F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */, F96D426C08F272B3004A47F5 /* bn_mp_and.c */, F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */, F96D426E08F272B3004A47F5 /* bn_mp_clear.c */, F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */, F96D427008F272B3004A47F5 /* bn_mp_cmp.c */, F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */, F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */, F96D427408F272B3004A47F5 /* bn_mp_copy.c */, F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */, F96D427608F272B3004A47F5 /* bn_mp_div.c */, F96D427708F272B3004A47F5 /* bn_mp_div_2.c */, F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */, F96D427908F272B3004A47F5 /* bn_mp_div_3.c */, F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */, F96D427E08F272B3004A47F5 /* bn_mp_exch.c */, F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */, F96D428708F272B3004A47F5 /* bn_mp_grow.c */, F96D428808F272B3004A47F5 /* bn_mp_init.c */, F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */, F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */, F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */, F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */, F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */, F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */, F96D429508F272B3004A47F5 /* bn_mp_lshd.c */, F96D429608F272B3004A47F5 /* bn_mp_mod.c */, F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */, F96D429C08F272B3004A47F5 /* bn_mp_mul.c */, F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */, F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */, F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */, F96D42A208F272B3004A47F5 /* bn_mp_neg.c */, F96D42A308F272B3004A47F5 /* bn_mp_or.c */, F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */, F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */, F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */, F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */, F96D42BA08F272B3004A47F5 /* bn_mp_set.c */, F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */, F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */, F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */, F96D42C108F272B3004A47F5 /* bn_mp_sub.c */, F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */, F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */, F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */, F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */, F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */, F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */, F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */, F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */, F96D42D008F272B3004A47F5 /* bn_reverse.c */, F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */, F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */, F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */, F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */, F96D432908F272B4004A47F5 /* tommath_class.h */, F96D432A08F272B4004A47F5 /* tommath_superclass.h */, ); path = libtommath; sourceTree = ""; }; F96D432C08F272B4004A47F5 /* macosx */ = { isa = PBXGroup; children = ( F96D432E08F272B5004A47F5 /* configure.ac */, F96D432F08F272B5004A47F5 /* GNUmakefile */, F96D433108F272B5004A47F5 /* README */, F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */, F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */, F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */, F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */, F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */, F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */, F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */, F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */, ); path = macosx; sourceTree = ""; }; F96D434408F272B5004A47F5 /* tests */ = { isa = PBXGroup; children = ( F96D434508F272B5004A47F5 /* all.tcl */, F96D434608F272B5004A47F5 /* append.test */, F96D434708F272B5004A47F5 /* appendComp.test */, F9ECB1CA0B2652D300A28025 /* apply.test */, F96D434808F272B5004A47F5 /* assocd.test */, F96D434908F272B5004A47F5 /* async.test */, F96D434A08F272B5004A47F5 /* autoMkindex.test */, F96D434B08F272B5004A47F5 /* basic.test */, F96D434C08F272B5004A47F5 /* binary.test */, F96D434D08F272B5004A47F5 /* case.test */, F96D434E08F272B5004A47F5 /* chan.test */, F9A493240CEBF38300B78AE2 /* chanio.test */, F96D434F08F272B5004A47F5 /* clock.test */, F96D435008F272B5004A47F5 /* cmdAH.test */, F96D435108F272B5004A47F5 /* cmdIL.test */, F96D435208F272B5004A47F5 /* cmdInfo.test */, F96D435308F272B5004A47F5 /* cmdMZ.test */, F96D435408F272B5004A47F5 /* compExpr-old.test */, F96D435508F272B5004A47F5 /* compExpr.test */, F96D435608F272B5004A47F5 /* compile.test */, F96D435708F272B5004A47F5 /* concat.test */, F96D435808F272B5004A47F5 /* config.test */, F974D5770FBE7E6100BF728B /* coroutine.test */, F96D435908F272B5004A47F5 /* dcall.test */, F96D435A08F272B5004A47F5 /* dict.test */, F96D435C08F272B5004A47F5 /* dstring.test */, F96D435E08F272B5004A47F5 /* encoding.test */, F96D435F08F272B5004A47F5 /* env.test */, F96D436008F272B5004A47F5 /* error.test */, F96D436108F272B5004A47F5 /* eval.test */, F96D436208F272B5004A47F5 /* event.test */, F96D436308F272B5004A47F5 /* exec.test */, F96D436408F272B5004A47F5 /* execute.test */, F96D436508F272B5004A47F5 /* expr-old.test */, F96D436608F272B5004A47F5 /* expr.test */, F96D436708F272B6004A47F5 /* fCmd.test */, F96D436808F272B6004A47F5 /* fileName.test */, F96D436908F272B6004A47F5 /* fileSystem.test */, F96D436A08F272B6004A47F5 /* for-old.test */, F96D436B08F272B6004A47F5 /* for.test */, F96D436C08F272B6004A47F5 /* foreach.test */, F96D436D08F272B6004A47F5 /* format.test */, F96D436E08F272B6004A47F5 /* get.test */, F96D436F08F272B6004A47F5 /* history.test */, F96D437008F272B6004A47F5 /* http.test */, F974D56C0FBE7D6300BF728B /* http11.test */, F96D437108F272B6004A47F5 /* httpd */, F974D56D0FBE7D6300BF728B /* httpd11.tcl */, F96D437208F272B6004A47F5 /* httpold.test */, F96D437308F272B6004A47F5 /* if-old.test */, F96D437408F272B6004A47F5 /* if.test */, F96D437508F272B6004A47F5 /* incr-old.test */, F96D437608F272B6004A47F5 /* incr.test */, F96D437708F272B6004A47F5 /* indexObj.test */, F96D437808F272B6004A47F5 /* info.test */, F96D437908F272B6004A47F5 /* init.test */, F96D437A08F272B6004A47F5 /* interp.test */, F96D437B08F272B6004A47F5 /* io.test */, F96D437C08F272B6004A47F5 /* ioCmd.test */, F96D437D08F272B6004A47F5 /* iogt.test */, F96D437F08F272B6004A47F5 /* join.test */, F96D438008F272B6004A47F5 /* lindex.test */, F96D438108F272B6004A47F5 /* link.test */, F96D438208F272B6004A47F5 /* linsert.test */, F96D438308F272B6004A47F5 /* list.test */, F96D438408F272B6004A47F5 /* listObj.test */, F96D438508F272B6004A47F5 /* llength.test */, F96D438608F272B6004A47F5 /* load.test */, F96D438708F272B6004A47F5 /* lrange.test */, F96D438808F272B6004A47F5 /* lrepeat.test */, F96D438908F272B6004A47F5 /* lreplace.test */, F96D438A08F272B6004A47F5 /* lsearch.test */, F96D438B08F272B6004A47F5 /* lset.test */, F96D438C08F272B6004A47F5 /* lsetComp.test */, F96D438D08F272B6004A47F5 /* macOSXFCmd.test */, F95FAFF90B34F1130072E431 /* macOSXLoad.test */, F96D438E08F272B6004A47F5 /* main.test */, F9ECB1CB0B26534C00A28025 /* mathop.test */, F96D438F08F272B6004A47F5 /* misc.test */, F96D439008F272B6004A47F5 /* msgcat.test */, F96D439108F272B6004A47F5 /* namespace-old.test */, F96D439208F272B7004A47F5 /* namespace.test */, F96D439308F272B7004A47F5 /* notify.test */, F91DC23C0E44C51B002CB8D1 /* nre.test */, F96D439408F272B7004A47F5 /* obj.test */, F93599C80DF1F81900E04F67 /* oo.test */, F96D439508F272B7004A47F5 /* opt.test */, F96D439608F272B7004A47F5 /* package.test */, F96D439708F272B7004A47F5 /* parse.test */, F96D439808F272B7004A47F5 /* parseExpr.test */, F96D439908F272B7004A47F5 /* parseOld.test */, F96D439A08F272B7004A47F5 /* pid.test */, F96D439B08F272B7004A47F5 /* pkg.test */, F96D439C08F272B7004A47F5 /* pkgMkIndex.test */, F96D439D08F272B7004A47F5 /* platform.test */, F96D439E08F272B7004A47F5 /* proc-old.test */, F96D439F08F272B7004A47F5 /* proc.test */, F96D43A008F272B7004A47F5 /* pwd.test */, F96D43A108F272B7004A47F5 /* README */, F96D43A208F272B7004A47F5 /* reg.test */, F96D43A308F272B7004A47F5 /* regexp.test */, F96D43A408F272B7004A47F5 /* regexpComp.test */, F96D43A508F272B7004A47F5 /* registry.test */, F96D43A608F272B7004A47F5 /* remote.tcl */, F96D43A708F272B7004A47F5 /* rename.test */, F96D43A808F272B7004A47F5 /* result.test */, F96D43A908F272B7004A47F5 /* safe.test */, F96D43AA08F272B7004A47F5 /* scan.test */, F96D43AB08F272B7004A47F5 /* security.test */, F96D43AC08F272B7004A47F5 /* set-old.test */, F96D43AD08F272B7004A47F5 /* set.test */, F96D43AE08F272B7004A47F5 /* socket.test */, F96D43AF08F272B7004A47F5 /* source.test */, F96D43B008F272B7004A47F5 /* split.test */, F96D43B108F272B7004A47F5 /* stack.test */, F96D43B208F272B7004A47F5 /* string.test */, F96D43B308F272B7004A47F5 /* stringComp.test */, F96D43B408F272B7004A47F5 /* stringObj.test */, F96D43B508F272B7004A47F5 /* subst.test */, F96D43B608F272B7004A47F5 /* switch.test */, F974D5780FBE7E6100BF728B /* tailcall.test */, F96D43B708F272B7004A47F5 /* tcltest.test */, F96D43B808F272B7004A47F5 /* thread.test */, F96D43B908F272B7004A47F5 /* timer.test */, F96D43BA08F272B7004A47F5 /* tm.test */, F96D43BB08F272B7004A47F5 /* trace.test */, F96D43BC08F272B7004A47F5 /* unixFCmd.test */, F96D43BD08F272B7004A47F5 /* unixFile.test */, F96D43BE08F272B7004A47F5 /* unixInit.test */, F96D43BF08F272B7004A47F5 /* unixNotfy.test */, F96D43C008F272B7004A47F5 /* unknown.test */, F96D43C108F272B7004A47F5 /* unload.test */, F96D43C208F272B7004A47F5 /* uplevel.test */, F96D43C308F272B7004A47F5 /* upvar.test */, F96D43C408F272B7004A47F5 /* utf.test */, F96D43C508F272B7004A47F5 /* util.test */, F96D43C608F272B7004A47F5 /* var.test */, F96D43C708F272B7004A47F5 /* while-old.test */, F96D43C808F272B7004A47F5 /* while.test */, F96D43C908F272B7004A47F5 /* winConsole.test */, F96D43CA08F272B7004A47F5 /* winDde.test */, F96D43CB08F272B7004A47F5 /* winFCmd.test */, F96D43CC08F272B7004A47F5 /* winFile.test */, F96D43CD08F272B7004A47F5 /* winNotify.test */, F96D43CE08F272B7004A47F5 /* winPipe.test */, F96D43CF08F272B7004A47F5 /* winTime.test */, F915432A0EF201CF0032D1E8 /* zlib.test */, ); path = tests; sourceTree = ""; }; F96D43D008F272B8004A47F5 /* tools */ = { isa = PBXGroup; children = ( F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D43D208F272B8004A47F5 /* configure */, F96D43D308F272B8004A47F5 /* configure.in */, F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, F96D442808F272B8004A47F5 /* installData.tcl */, F96D442908F272B8004A47F5 /* loadICU.tcl */, F96D442A08F272B8004A47F5 /* Makefile.in */, F96D442B08F272B8004A47F5 /* makeTestCases.tcl */, F96D442C08F272B8004A47F5 /* man2help.tcl */, F96D442D08F272B8004A47F5 /* man2help2.tcl */, F96D442E08F272B8004A47F5 /* man2html.tcl */, F96D442F08F272B8004A47F5 /* man2html1.tcl */, F96D443008F272B8004A47F5 /* man2html2.tcl */, F96D443108F272B8004A47F5 /* man2tcl.c */, F96D443208F272B8004A47F5 /* README */, F96D443308F272B8004A47F5 /* regexpTestLib.tcl */, F96D443508F272B8004A47F5 /* tcl.hpj.in */, F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */, F96D443A08F272B9004A47F5 /* tclZIC.tcl */, F92D7F100DE777240033A13A /* tsdPerf.tcl */, F96D443B08F272B9004A47F5 /* uniClass.tcl */, F96D443C08F272B9004A47F5 /* uniParse.tcl */, ); path = tools; sourceTree = ""; }; F96D443E08F272B9004A47F5 /* unix */ = { isa = PBXGroup; children = ( F96D444008F272B9004A47F5 /* aclocal.m4 */, F96D444108F272B9004A47F5 /* configure */, F96D444208F272B9004A47F5 /* configure.in */, F96D444308F272B9004A47F5 /* dltest */, F96D444D08F272B9004A47F5 /* install-sh */, F96D444E08F272B9004A47F5 /* installManPage */, F96D444F08F272B9004A47F5 /* ldAix */, F96D445008F272B9004A47F5 /* Makefile.in */, F96D445208F272B9004A47F5 /* README */, F96D445308F272B9004A47F5 /* tcl.m4 */, F974D5790FBE7E9C00BF728B /* tcl.pc.in */, F96D445408F272B9004A47F5 /* tcl.spec */, F96D445508F272B9004A47F5 /* tclAppInit.c */, F96D445608F272B9004A47F5 /* tclConfig.h.in */, F96D445708F272B9004A47F5 /* tclConfig.sh.in */, F96D445808F272B9004A47F5 /* tclLoadAix.c */, F96D445908F272B9004A47F5 /* tclLoadDl.c */, F96D445B08F272B9004A47F5 /* tclLoadDyld.c */, F96D445C08F272B9004A47F5 /* tclLoadNext.c */, F96D445D08F272B9004A47F5 /* tclLoadOSF.c */, F96D445E08F272B9004A47F5 /* tclLoadShl.c */, F96D445F08F272B9004A47F5 /* tclUnixChan.c */, F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */, F96D446008F272B9004A47F5 /* tclUnixEvent.c */, F96D446108F272B9004A47F5 /* tclUnixFCmd.c */, F96D446208F272B9004A47F5 /* tclUnixFile.c */, F96D446308F272B9004A47F5 /* tclUnixInit.c */, F96D446408F272B9004A47F5 /* tclUnixNotfy.c */, F96D446508F272B9004A47F5 /* tclUnixPipe.c */, F96D446608F272B9004A47F5 /* tclUnixPort.h */, F96D446708F272B9004A47F5 /* tclUnixSock.c */, F96D446808F272B9004A47F5 /* tclUnixTest.c */, F96D446908F272B9004A47F5 /* tclUnixThrd.c */, F96D446B08F272B9004A47F5 /* tclUnixTime.c */, F96D446C08F272B9004A47F5 /* tclXtNotify.c */, F96D446D08F272B9004A47F5 /* tclXtTest.c */, ); path = unix; sourceTree = ""; }; F96D444308F272B9004A47F5 /* dltest */ = { isa = PBXGroup; children = ( F96D444408F272B9004A47F5 /* Makefile.in */, F96D444508F272B9004A47F5 /* pkga.c */, F96D444608F272B9004A47F5 /* pkgb.c */, F96D444708F272B9004A47F5 /* pkgc.c */, F96D444808F272B9004A47F5 /* pkgd.c */, F96D444908F272B9004A47F5 /* pkge.c */, F96D444B08F272B9004A47F5 /* pkgua.c */, F96D444C08F272B9004A47F5 /* README */, ); path = dltest; sourceTree = ""; }; F96D446E08F272B9004A47F5 /* win */ = { isa = PBXGroup; children = ( F96D447008F272BA004A47F5 /* aclocal.m4 */, F96D447108F272BA004A47F5 /* buildall.vc.bat */, F96D447208F272BA004A47F5 /* cat.c */, F96D447308F272BA004A47F5 /* coffbase.txt */, F96D447408F272BA004A47F5 /* configure */, F96D447508F272BA004A47F5 /* configure.in */, F96D447708F272BA004A47F5 /* Makefile.in */, F96D447808F272BA004A47F5 /* makefile.vc */, F96D447908F272BA004A47F5 /* nmakehlp.c */, F96D447A08F272BA004A47F5 /* README */, F96D447C08F272BA004A47F5 /* rules.vc */, F96D447D08F272BA004A47F5 /* stub16.c */, F96D447E08F272BA004A47F5 /* tcl.dsp */, F96D447F08F272BA004A47F5 /* tcl.dsw */, F96D448008F272BA004A47F5 /* tcl.hpj.in */, F96D448108F272BA004A47F5 /* tcl.m4 */, F96D448208F272BA004A47F5 /* tcl.rc */, F96D448308F272BA004A47F5 /* tclAppInit.c */, F96D448408F272BA004A47F5 /* tclConfig.sh.in */, F96D448608F272BA004A47F5 /* tclsh.rc */, F96D448708F272BA004A47F5 /* tclWin32Dll.c */, F96D448808F272BA004A47F5 /* tclWinChan.c */, F96D448908F272BA004A47F5 /* tclWinConsole.c */, F96D448A08F272BA004A47F5 /* tclWinDde.c */, F96D448B08F272BA004A47F5 /* tclWinError.c */, F96D448C08F272BA004A47F5 /* tclWinFCmd.c */, F96D448D08F272BA004A47F5 /* tclWinFile.c */, F96D448E08F272BA004A47F5 /* tclWinInit.c */, F96D448F08F272BA004A47F5 /* tclWinInt.h */, F96D449008F272BA004A47F5 /* tclWinLoad.c */, F96D449108F272BA004A47F5 /* tclWinNotify.c */, F96D449208F272BA004A47F5 /* tclWinPipe.c */, F96D449308F272BA004A47F5 /* tclWinPort.h */, F96D449408F272BA004A47F5 /* tclWinReg.c */, F96D449508F272BA004A47F5 /* tclWinSerial.c */, F96D449608F272BA004A47F5 /* tclWinSock.c */, F96D449708F272BA004A47F5 /* tclWinTest.c */, F96D449808F272BA004A47F5 /* tclWinThrd.c */, F96D449A08F272BA004A47F5 /* tclWinTime.c */, ); path = win; sourceTree = ""; }; F9ECB1110B26521500A28025 /* platform */ = { isa = PBXGroup; children = ( F9ECB1120B26521500A28025 /* pkgIndex.tcl */, F9ECB1130B26521500A28025 /* platform.tcl */, F9ECB1140B26521500A28025 /* shell.tcl */, ); path = platform; sourceTree = ""; }; /* End PBXGroup section */ /* Begin PBXNativeTarget section */ 8DD76FA90486AB0100D96B5E /* tcltest */ = { isa = PBXNativeTarget; buildConfigurationList = F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */; buildPhases = ( F9A5C5F508F651A2008AE941 /* Configure Tcl */, 8DD76FAB0486AB0100D96B5E /* Sources */, 8DD76FAD0486AB0100D96B5E /* Frameworks */, F95FA74C0B32CE190072E431 /* Build dltest */, ); buildRules = ( ); dependencies = ( ); name = tcltest; productInstallPath = "$(BINDIR)"; productName = tcltest; productReference = 8DD76FB20486AB0100D96B5E /* tcltest */; productType = "com.apple.product-type.tool"; }; F97258A50A86873C00096C78 /* tests */ = { isa = PBXNativeTarget; buildConfigurationList = F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */; buildPhases = ( F97258A40A86873C00096C78 /* Run Testsuite */, ); buildRules = ( ); dependencies = ( F97258D30A868C6F00096C78 /* PBXTargetDependency */, ); name = tests; productName = tests; productType = "com.apple.product-type.bundle"; }; F9E61D16090A3E94002B3151 /* Tcl */ = { isa = PBXNativeTarget; buildConfigurationList = F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */; buildPhases = ( F97AF02F0B665DA900310EA2 /* Build Tcl */, ); buildRules = ( ); dependencies = ( ); name = Tcl; productName = tclsh; productReference = F9A3084B08F2D4CE00BAE1AB /* tclsh */; productType = "com.apple.product-type.tool"; }; /* End PBXNativeTarget section */ /* Begin PBXProject section */ 08FB7793FE84155DC02AAC07 /* Project object */ = { isa = PBXProject; attributes = { BuildIndependentTargetsInParallel = YES; }; buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */; compatibilityVersion = "Xcode 3.1"; hasScannedForEncodings = 1; mainGroup = 08FB7794FE84155DC02AAC07 /* Tcl */; projectDirPath = ""; projectRoot = ..; targets = ( F9E61D16090A3E94002B3151 /* Tcl */, 8DD76FA90486AB0100D96B5E /* tcltest */, F97258A50A86873C00096C78 /* tests */, ); }; /* End PBXProject section */ /* Begin PBXShellScriptBuildPhase section */ F95FA74C0B32CE190072E431 /* Build dltest */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( ); inputPaths = ( "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh", "$(TCL_SRCROOT)/generic/tclStubLib.c", "$(TCL_SRCROOT)/unix/dltest/pkga.c", "$(TCL_SRCROOT)/unix/dltest/pkgb.c", "$(TCL_SRCROOT)/unix/dltest/pkgc.c", "$(TCL_SRCROOT)/unix/dltest/pkgd.c", "$(TCL_SRCROOT)/unix/dltest/pkge.c", "$(TCL_SRCROOT)/unix/dltest/pkgua.c", ); name = "Build dltest"; outputPaths = ( "$(DERIVED_FILE_DIR)/tcl/dltest.marker", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; shellScript = "## dltest build script phase\n\nrm -f \"${DERIVED_FILE_DIR}/tcl/dltest.marker\"\nmake -C \"${DERIVED_FILE_DIR}/tcl\" dltest.marker\nln -fsh \"${DERIVED_FILE_DIR}/tcl/dltest\" \"${CONFIGURATION_BUILD_DIR}\"\n"; showEnvVarsInLog = 0; }; F97258A40A86873C00096C78 /* Run Testsuite */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( ); inputPaths = ( ); name = "Run Testsuite"; outputPaths = ( ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.5\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi"; showEnvVarsInLog = 0; }; F97AF02F0B665DA900310EA2 /* Build Tcl */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( ); inputPaths = ( "${TARGET_TEMP_DIR}/.none", ); name = "Build Tcl"; outputPaths = ( "${TARGET_BUILD_DIR}/${EXECUTABLE_NAME}", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\nexport CC=$(xcrun -find ${GCC} || echo ${GCC}); export LD=${CC}\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n"; showEnvVarsInLog = 0; }; F9A5C5F508F651A2008AE941 /* Configure Tcl */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( ); inputPaths = ( "$(TCL_SRCROOT)/macosx/configure.ac", "$(TCL_SRCROOT)/unix/configure.in", "$(TCL_SRCROOT)/unix/tcl.m4", "$(TCL_SRCROOT)/unix/aclocal.m4", "$(TCL_SRCROOT)/unix/tclConfig.sh.in", "$(TCL_SRCROOT)/unix/Makefile.in", "$(TCL_SRCROOT)/unix/dltest/Makefile.in", ); name = "Configure Tcl"; outputPaths = ( "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; showEnvVarsInLog = 0; }; /* End PBXShellScriptBuildPhase section */ /* Begin PBXSourcesBuildPhase section */ 8DD76FAB0486AB0100D96B5E /* Sources */ = { isa = PBXSourcesBuildPhase; buildActionMask = 2147483647; files = ( F96D456F08F272BB004A47F5 /* regcomp.c in Sources */, F96D457208F272BB004A47F5 /* regerror.c in Sources */, F96D457508F272BB004A47F5 /* regexec.c in Sources */, F96D457608F272BB004A47F5 /* regfree.c in Sources */, F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */, F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */, F96D457D08F272BB004A47F5 /* tclBasic.c in Sources */, F96D457E08F272BC004A47F5 /* tclBinary.c in Sources */, F96D457F08F272BC004A47F5 /* tclCkalloc.c in Sources */, F96D458008F272BC004A47F5 /* tclClock.c in Sources */, F96D458108F272BC004A47F5 /* tclCmdAH.c in Sources */, F96D458208F272BC004A47F5 /* tclCmdIL.c in Sources */, F96D458308F272BC004A47F5 /* tclCmdMZ.c in Sources */, F96D458408F272BC004A47F5 /* tclCompCmds.c in Sources */, F96D458508F272BC004A47F5 /* tclCompExpr.c in Sources */, F96D458608F272BC004A47F5 /* tclCompile.c in Sources */, F96D458808F272BC004A47F5 /* tclConfig.c in Sources */, F96D458908F272BC004A47F5 /* tclDate.c in Sources */, F96D458B08F272BC004A47F5 /* tclDictObj.c in Sources */, F96D458C08F272BC004A47F5 /* tclEncoding.c in Sources */, F96D458D08F272BC004A47F5 /* tclEnv.c in Sources */, F96D458E08F272BC004A47F5 /* tclEvent.c in Sources */, F96D458F08F272BC004A47F5 /* tclExecute.c in Sources */, F96D459008F272BC004A47F5 /* tclFCmd.c in Sources */, F96D459108F272BC004A47F5 /* tclFileName.c in Sources */, F96D459308F272BC004A47F5 /* tclGet.c in Sources */, F96D459508F272BC004A47F5 /* tclHash.c in Sources */, F96D459608F272BC004A47F5 /* tclHistory.c in Sources */, F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */, F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */, F96D459D08F272BC004A47F5 /* tclIO.c in Sources */, F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */, F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */, F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */, F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */, F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */, F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */, F96D45A408F272BC004A47F5 /* tclLink.c in Sources */, F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */, F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */, F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */, F96D45A908F272BC004A47F5 /* tclMain.c in Sources */, F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */, F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */, F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */, F93599B30DF1F75400E04F67 /* tclOO.c in Sources */, F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */, F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */, F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */, F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */, F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */, F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */, F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */, F96D45B708F272BC004A47F5 /* tclPreserve.c in Sources */, F96D45B808F272BC004A47F5 /* tclProc.c in Sources */, F96D45B908F272BC004A47F5 /* tclRegexp.c in Sources */, F96D45BB08F272BC004A47F5 /* tclResolve.c in Sources */, F96D45BC08F272BC004A47F5 /* tclResult.c in Sources */, F96D45BD08F272BC004A47F5 /* tclScan.c in Sources */, F96D45BE08F272BC004A47F5 /* tclStringObj.c in Sources */, F96D45C308F272BC004A47F5 /* tclStrToD.c in Sources */, F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */, F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */, F96D45C608F272BC004A47F5 /* tclTest.c in Sources */, F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */, F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */, F96D45C908F272BC004A47F5 /* tclThread.c in Sources */, F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */, F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */, F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */, F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */, F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */, F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */, F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */, F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */, F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */, F96D45D508F272BC004A47F5 /* tclVar.c in Sources */, F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */, F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */, F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */, F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */, F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */, F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */, F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */, F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */, F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */, F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */, F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */, F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */, F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */, F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */, F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */, F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */, F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */, F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */, F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */, F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */, F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */, F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */, F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */, F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */, F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */, F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */, F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */, F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */, F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */, F96D491108F272C3004A47F5 /* bn_mp_karatsuba_sqr.c in Sources */, F96D491308F272C3004A47F5 /* bn_mp_lshd.c in Sources */, F96D491408F272C3004A47F5 /* bn_mp_mod.c in Sources */, F96D491508F272C3004A47F5 /* bn_mp_mod_2d.c in Sources */, F96D491A08F272C3004A47F5 /* bn_mp_mul.c in Sources */, F96D491B08F272C3004A47F5 /* bn_mp_mul_2.c in Sources */, F96D491C08F272C3004A47F5 /* bn_mp_mul_2d.c in Sources */, F96D491D08F272C3004A47F5 /* bn_mp_mul_d.c in Sources */, F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */, F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */, F96D492908F272C3004A47F5 /* bn_mp_radix_size.c in Sources */, F96D492A08F272C3004A47F5 /* bn_mp_radix_smap.c in Sources */, F96D492C08F272C3004A47F5 /* bn_mp_read_radix.c in Sources */, F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */, F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */, F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */, F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */, F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */, F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */, F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */, F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */, F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */, F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */, F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */, F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */, F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */, F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */, F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */, F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */, F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */, F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */, F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */, F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */, F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */, F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */, F90509300913A72400327603 /* tclAppInit.c in Sources */, F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */, F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */, F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */, F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */, F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */, F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */, F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */, F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */, F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */, F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */, F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */, F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */, F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */, F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */, ); runOnlyForDeploymentPostprocessing = 0; }; /* End PBXSourcesBuildPhase section */ /* Begin PBXTargetDependency section */ F97258D30A868C6F00096C78 /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = 8DD76FA90486AB0100D96B5E /* tcltest */; targetProxy = F97258D20A868C6F00096C78 /* PBXContainerItemProxy */; }; /* End PBXTargetDependency section */ /* Begin XCBuildConfiguration section */ F91BCC4F093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = ReleaseUniversal; }; F91BCC50093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = ReleaseUniversal; }; F91BCC51093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; }; name = ReleaseUniversal; }; F93084370BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugMemCompile; }; F93084380BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugMemCompile; }; F93084390BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugMemCompile; }; F930843A0BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --enable-symbols=all"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugMemCompile; }; F9359B250DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_GENERATE_TEST_COVERAGE_FILES = YES; GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; OTHER_LDFLAGS = ( "$(OTHER_LDFLAGS)", "-lgcov", ); PREBINDING = NO; }; name = DebugGCov; }; F9359B260DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugGCov; }; F9359B270DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugGCov; }; F9359B280DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugGCov; }; F95CC8AC09158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = Debug; }; F95CC8AD09158F3100EA5ACE /* Release */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = Release; }; F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugNoFixAndContinue; }; F95CC8B109158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; }; name = Debug; }; F95CC8B209158F3100EA5ACE /* Release */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = Release; }; F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugNoFixAndContinue; }; F95CC8B609158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = Debug; }; F95CC8B709158F3100EA5ACE /* Release */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = Release; }; F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugNoFixAndContinue; }; F97258A90A86873D00096C78 /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = Debug; }; F97258AA0A86873D00096C78 /* Release */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = Release; }; F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugNoFixAndContinue; }; F97258AC0A86873D00096C78 /* ReleaseUniversal */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = ReleaseUniversal; }; F97AED1B0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = Debug64bit; }; F97AED1C0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = Debug64bit; }; F97AED1D0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = Debug64bit; }; F97AED1E0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = "$(NATIVE_ARCH_64_BIT)"; CONFIGURE_ARGS = "--enable-64bit $(CONFIGURE_ARGS)"; CPPFLAGS = "-arch $(NATIVE_ARCH_64_BIT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; }; name = Debug64bit; }; F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugNoCF; }; F98751300DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugNoCF; }; F98751310DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugNoCF; }; F98751320DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugNoCF; }; F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugNoCFUnthreaded; }; F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugNoCFUnthreaded; }; F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugNoCFUnthreaded; }; F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugNoCFUnthreaded; }; F9988AB10D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = "Debug gcc40"; }; F9988AB20D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "Debug gcc40"; }; F9988AB30D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; }; name = "Debug gcc40"; }; F9988AB40D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "Debug gcc40"; }; F9988AB50D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC = "llvm-gcc"; GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = "Debug llvm-gcc"; }; F9988AB60D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "Debug llvm-gcc"; }; F9988AB70D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; }; name = "Debug llvm-gcc"; }; F9988AB80D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "Debug llvm-gcc"; }; F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; }; name = "ReleaseUniversal gcc40"; }; F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "ReleaseUniversal gcc40"; }; F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = "ReleaseUniversal gcc40"; }; F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "ReleaseUniversal gcc40"; }; F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; GCC = "llvm-gcc"; GCC_OPTIMIZATION_LEVEL = 4; GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; }; name = "ReleaseUniversal llvm-gcc"; }; F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "ReleaseUniversal llvm-gcc"; }; F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = "ReleaseUniversal llvm-gcc"; }; F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "ReleaseUniversal llvm-gcc"; }; F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugUnthreaded; }; F99EE73C0BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugLeaks; }; F99EE73D0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugUnthreaded; }; F99EE73E0BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugLeaks; }; F99EE73F0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugUnthreaded; }; F99EE7400BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugLeaks; }; F99EE7410BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugUnthreaded; }; F99EE7420BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_PREPROCESSOR_DEFINITIONS = ( PURIFY, "$(GCC_PREPROCESSOR_DEFINITIONS)", ); MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugLeaks; }; F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = ReleaseUniversal10.5SDK; }; F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = ReleaseUniversal10.5SDK; }; F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = ReleaseUniversal10.5SDK; }; F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; SDKROOT = macosx10.5; }; name = ReleaseUniversal10.5SDK; }; /* End XCBuildConfiguration section */ /* Begin XCConfigurationList section */ F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */ = { isa = XCConfigurationList; buildConfigurations = ( F95CC8AC09158F3100EA5ACE /* Debug */, F9988AB60D814C7500B6B03B /* Debug llvm-gcc */, F9988AB20D814C6500B6B03B /* Debug gcc40 */, F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE73B0BE835310060D4AF /* DebugUnthreaded */, F98751300DE7B57E00B1C9EC /* DebugNoCF */, F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084370BB93D2800CD0B9E /* DebugMemCompile */, F99EE73C0BE835310060D4AF /* DebugLeaks */, F9359B260DF212DA00E04F67 /* DebugGCov */, F97AED1B0B660B2100310EA2 /* Debug64bit */, F95CC8AD09158F3100EA5ACE /* Release */, F91BCC4F093152310042A6BF /* ReleaseUniversal */, F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */, F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */ = { isa = XCConfigurationList; buildConfigurations = ( F95CC8B109158F3100EA5ACE /* Debug */, F9988AB70D814C7500B6B03B /* Debug llvm-gcc */, F9988AB30D814C6500B6B03B /* Debug gcc40 */, F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE73D0BE835310060D4AF /* DebugUnthreaded */, F98751310DE7B57E00B1C9EC /* DebugNoCF */, F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084380BB93D2800CD0B9E /* DebugMemCompile */, F99EE73E0BE835310060D4AF /* DebugLeaks */, F9359B270DF212DA00E04F67 /* DebugGCov */, F97AED1C0B660B2100310EA2 /* Debug64bit */, F95CC8B209158F3100EA5ACE /* Release */, F91BCC50093152310042A6BF /* ReleaseUniversal */, F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */, F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */ = { isa = XCConfigurationList; buildConfigurations = ( F95CC8B609158F3100EA5ACE /* Debug */, F9988AB50D814C7500B6B03B /* Debug llvm-gcc */, F9988AB10D814C6500B6B03B /* Debug gcc40 */, F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE7410BE835310060D4AF /* DebugUnthreaded */, F987512F0DE7B57E00B1C9EC /* DebugNoCF */, F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F930843A0BB93D2800CD0B9E /* DebugMemCompile */, F99EE7420BE835310060D4AF /* DebugLeaks */, F9359B250DF212DA00E04F67 /* DebugGCov */, F97AED1E0B660B2100310EA2 /* Debug64bit */, F95CC8B709158F3100EA5ACE /* Release */, F91BCC51093152310042A6BF /* ReleaseUniversal */, F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */, F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */ = { isa = XCConfigurationList; buildConfigurations = ( F97258A90A86873D00096C78 /* Debug */, F9988AB80D814C7500B6B03B /* Debug llvm-gcc */, F9988AB40D814C6500B6B03B /* Debug gcc40 */, F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */, F99EE73F0BE835310060D4AF /* DebugUnthreaded */, F98751320DE7B57E00B1C9EC /* DebugNoCF */, F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084390BB93D2800CD0B9E /* DebugMemCompile */, F99EE7400BE835310060D4AF /* DebugLeaks */, F9359B280DF212DA00E04F67 /* DebugGCov */, F97AED1D0B660B2100310EA2 /* Debug64bit */, F97258AA0A86873D00096C78 /* Release */, F97258AC0A86873D00096C78 /* ReleaseUniversal */, F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */, F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; /* End XCConfigurationList section */ }; rootObject = 08FB7793FE84155DC02AAC07 /* Project object */; } tcl8.6.14/macosx/Tcl.xcode/default.pbxuser0000644000175000017500000001322214554262142020015 0ustar sergeisergei// !$*UTF8*$! { 08FB7793FE84155DC02AAC07 /* Project object */ = { activeBuildConfigurationName = Debug; activeExecutable = F9E61D1C090A4282002B3151 /* tclsh */; activeTarget = F9E61D16090A3E94002B3151 /* Tcl */; codeSenseManager = F944EB9D08F798180049FDD4 /* Code sense */; executables = ( F9E61D1C090A4282002B3151 /* tclsh */, F944EB8F08F798100049FDD4 /* tcltest */, ); perUserDictionary = { com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f75708692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a0b707265666572656e63657386928497960892849a9a07666e6d617463688692849a9a008692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a0572656765788692849a9a065c2e286329248692849a9a097265637572736976658692848484084e534e756d626572008484074e5356616c7565009584012a849696018692849a9a0669734c656166869284b09db296008692849a9a0763616e536176658692af92849a9a1250425850726f6a65637453636f70654b65798692849a9a03594553868692849a9a08676c6f62616c49448692849a9a18314343304541343030343335304546393030343434313042868686>; }; sourceControlManager = F944EB9C08F798180049FDD4 /* Source Control */; userBuildSettings = { SYMROOT = "${SRCROOT}/../../build/tcl"; TCL_SRCROOT = "${SRCROOT}/../../tcl"; }; }; 8DD76FA90486AB0100D96B5E /* tcltest */ = { activeExec = 0; executables = ( F944EB8F08F798100049FDD4 /* tcltest */, ); }; F944EB8F08F798100049FDD4 /* tcltest */ = { isa = PBXExecutable; activeArgIndices = ( NO, NO, NO, ); argumentStrings = ( "${TCL_SRCROOT}/tests/all.tcl", "-singleproc 1", "-verbose \"bet\"", ); autoAttachOnCrash = 1; breakpointsEnabled = 1; configStateDict = { "PBXLSLaunchAction-0" = { PBXLSLaunchAction = 0; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXLSRunLaunchConfig; displayName = "Executable Runner"; identifier = com.apple.Xcode.launch.runConfig; remoteHostInfo = ""; startActionInfo = ""; }; "PBXLSLaunchAction-1" = { PBXLSLaunchAction = 1; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXGDB_LaunchConfig; displayName = GDB; identifier = com.apple.Xcode.launch.GDBMI_Config; remoteHostInfo = ""; startActionInfo = ""; }; }; customDataFormattersEnabled = 1; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = ""; enableDebugStr = 0; environmentEntries = ( { active = YES; name = TCL_LIBRARY; value = "${TCL_SRCROOT}/library"; }, { active = YES; name = TCLLIBPATH; value = /Library/Tcl; }, { active = NO; name = DYLD_PRINT_LIBRARIES; }, { active = NO; name = MallocBadFreeAbort; value = 1; }, { active = NO; name = MallocLogFile; value = /tmp/malloc.log; }, { active = NO; name = MallocStackLogging; value = 1; }, { active = NO; name = MallocStackLoggingNoCompact; value = 1; }, { active = NO; name = MallocPreScribble; value = 1; }, { active = NO; name = MallocScribble; value = 1; }, ); executableSystemSymbolLevel = 0; executableUserSymbolLevel = 0; libgmallocEnabled = 0; name = tcltest; sourceDirectories = ( ); }; F944EB9C08F798180049FDD4 /* Source Control */ = { isa = PBXSourceControlManager; fallbackIsa = XCSourceControlManager; isSCMEnabled = 0; scmConfiguration = { CVSToolPath = /usr/bin/cvs; CVSUseSSH = NO; SubversionToolPath = /usr/bin/svn; repositoryNamesForRoots = { .. = ""; }; }; scmType = scm.cvs; }; F944EB9D08F798180049FDD4 /* Code sense */ = { isa = PBXCodeSenseManager; indexTemplatePath = ""; }; F97258A50A86873C00096C78 /* tests */ = { activeExec = 0; }; F9E61D16090A3E94002B3151 /* Tcl */ = { activeExec = 0; executables = ( F9E61D1C090A4282002B3151 /* tclsh */, ); }; F9E61D1C090A4282002B3151 /* tclsh */ = { isa = PBXExecutable; activeArgIndices = ( ); argumentStrings = ( ); autoAttachOnCrash = 1; breakpointsEnabled = 1; configStateDict = { "PBXLSLaunchAction-0" = { PBXLSLaunchAction = 0; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXLSRunLaunchConfig; displayName = "Executable Runner"; identifier = com.apple.Xcode.launch.runConfig; remoteHostInfo = ""; startActionInfo = ""; }; "PBXLSLaunchAction-1" = { PBXLSLaunchAction = 1; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXGDB_LaunchConfig; displayName = GDB; identifier = com.apple.Xcode.launch.GDBMI_Config; remoteHostInfo = ""; startActionInfo = ""; }; }; customDataFormattersEnabled = 1; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = _debug; enableDebugStr = 0; environmentEntries = ( { active = NO; name = DYLD_PRINT_LIBRARIES; }, ); executableSystemSymbolLevel = 0; executableUserSymbolLevel = 0; libgmallocEnabled = 0; name = tclsh; sourceDirectories = ( ); }; } tcl8.6.14/macosx/Tcl.xcodeproj/0000755000175000017500000000000014566153412015654 5ustar sergeisergeitcl8.6.14/macosx/Tcl.xcodeproj/project.pbxproj0000644000175000017500000067317314554262142020747 0ustar sergeisergei// !$*UTF8*$! { archiveVersion = 1; classes = { }; objectVersion = 46; objects = { /* Begin PBXBuildFile section */ F90509300913A72400327603 /* tclAppInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445508F272B9004A47F5 /* tclAppInit.c */; settings = {COMPILER_FLAGS = "-DTCL_TEST -DTCL_BUILDTIME_LIBRARY=\\\"$(TCL_SRCROOT)/library\\\""; }; }; F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; }; F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; }; F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; }; F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; }; F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F966C07408F2820D005CB29B /* CoreFoundation.framework */; }; F96D456F08F272BB004A47F5 /* regcomp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED008F272A7004A47F5 /* regcomp.c */; }; F96D457208F272BB004A47F5 /* regerror.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED308F272A7004A47F5 /* regerror.c */; }; F96D457508F272BB004A47F5 /* regexec.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED608F272A7004A47F5 /* regexec.c */; }; F96D457608F272BB004A47F5 /* regfree.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED708F272A7004A47F5 /* regfree.c */; }; F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDC08F272A7004A47F5 /* tclAlloc.c */; settings = {COMPILER_FLAGS = "-DUSE_TCLALLOC=0"; }; }; F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDD08F272A7004A47F5 /* tclAsync.c */; }; F96D457D08F272BB004A47F5 /* tclBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDE08F272A7004A47F5 /* tclBasic.c */; }; F96D457E08F272BC004A47F5 /* tclBinary.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDF08F272A7004A47F5 /* tclBinary.c */; }; F96D457F08F272BC004A47F5 /* tclCkalloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE008F272A7004A47F5 /* tclCkalloc.c */; }; F96D458008F272BC004A47F5 /* tclClock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE108F272A7004A47F5 /* tclClock.c */; }; F96D458108F272BC004A47F5 /* tclCmdAH.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE208F272A7004A47F5 /* tclCmdAH.c */; }; F96D458208F272BC004A47F5 /* tclCmdIL.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE308F272A7004A47F5 /* tclCmdIL.c */; }; F96D458308F272BC004A47F5 /* tclCmdMZ.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */; }; F96D458408F272BC004A47F5 /* tclCompCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE508F272A7004A47F5 /* tclCompCmds.c */; }; F96D458508F272BC004A47F5 /* tclCompExpr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE608F272A7004A47F5 /* tclCompExpr.c */; }; F96D458608F272BC004A47F5 /* tclCompile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE708F272A7004A47F5 /* tclCompile.c */; }; F96D458808F272BC004A47F5 /* tclConfig.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE908F272A7004A47F5 /* tclConfig.c */; }; F96D458908F272BC004A47F5 /* tclDate.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEA08F272A7004A47F5 /* tclDate.c */; }; F96D458B08F272BC004A47F5 /* tclDictObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEC08F272A7004A47F5 /* tclDictObj.c */; }; F96D458C08F272BC004A47F5 /* tclEncoding.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EED08F272A7004A47F5 /* tclEncoding.c */; }; F96D458D08F272BC004A47F5 /* tclEnv.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEE08F272A7004A47F5 /* tclEnv.c */; }; F96D458E08F272BC004A47F5 /* tclEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEF08F272A7004A47F5 /* tclEvent.c */; }; F96D458F08F272BC004A47F5 /* tclExecute.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF008F272A7004A47F5 /* tclExecute.c */; }; F96D459008F272BC004A47F5 /* tclFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF108F272A7004A47F5 /* tclFCmd.c */; }; F96D459108F272BC004A47F5 /* tclFileName.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF208F272A7004A47F5 /* tclFileName.c */; }; F96D459308F272BC004A47F5 /* tclGet.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF408F272A7004A47F5 /* tclGet.c */; }; F96D459508F272BC004A47F5 /* tclHash.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF608F272A7004A47F5 /* tclHash.c */; }; F96D459608F272BC004A47F5 /* tclHistory.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF708F272A7004A47F5 /* tclHistory.c */; }; F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF808F272A7004A47F5 /* tclIndexObj.c */; }; F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EFC08F272A7004A47F5 /* tclInterp.c */; }; F96D459D08F272BC004A47F5 /* tclIO.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EFE08F272A7004A47F5 /* tclIO.c */; }; F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0008F272A7004A47F5 /* tclIOCmd.c */; }; F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0108F272A7004A47F5 /* tclIOGT.c */; }; F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0208F272A7004A47F5 /* tclIORChan.c */; }; F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0308F272A7004A47F5 /* tclIOSock.c */; }; F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0408F272A7004A47F5 /* tclIOUtil.c */; }; F96D45A408F272BC004A47F5 /* tclLink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0508F272A7004A47F5 /* tclLink.c */; }; F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0608F272A7004A47F5 /* tclListObj.c */; }; F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0708F272A7004A47F5 /* tclLiteral.c */; }; F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0808F272A7004A47F5 /* tclLoad.c */; }; F96D45A908F272BC004A47F5 /* tclMain.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0A08F272A7004A47F5 /* tclMain.c */; }; F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0B08F272A7004A47F5 /* tclNamesp.c */; }; F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0C08F272A7004A47F5 /* tclNotify.c */; }; F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0D08F272A7004A47F5 /* tclObj.c */; }; F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0E08F272A7004A47F5 /* tclPanic.c */; }; F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0F08F272A7004A47F5 /* tclParse.c */; }; F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1108F272A7004A47F5 /* tclPathObj.c */; }; F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1208F272A7004A47F5 /* tclPipe.c */; }; F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1308F272A7004A47F5 /* tclPkg.c */; }; F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */; settings = {COMPILER_FLAGS = "-DCFG_INSTALL_LIBDIR=\\\"$(LIBDIR)\\\" -DCFG_INSTALL_BINDIR=\\\"$(BINDIR)\\\" -DCFG_INSTALL_SCRDIR=\\\"$(TCL_LIBRARY)\\\" -DCFG_INSTALL_INCDIR=\\\"$(INCLUDEDIR)\\\" -DCFG_INSTALL_DOCDIR=\\\"$(MANDIR)\\\" -DCFG_RUNTIME_LIBDIR=\\\"$(LIBDIR)\\\" -DCFG_RUNTIME_BINDIR=\\\"$(BINDIR)\\\" -DCFG_RUNTIME_SCRDIR=\\\"$(TCL_LIBRARY)\\\" -DCFG_RUNTIME_INCDIR=\\\"$(INCLUDEDIR)\\\" -DCFG_RUNTIME_DOCDIR=\\\"$(MANDIR)\\\""; }; }; F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1708F272A7004A47F5 /* tclPosixStr.c */; }; F96D45B708F272BC004A47F5 /* tclPreserve.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1808F272A7004A47F5 /* tclPreserve.c */; }; F96D45B808F272BC004A47F5 /* tclProc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1908F272A7004A47F5 /* tclProc.c */; }; F96D45B908F272BC004A47F5 /* tclRegexp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1A08F272A7004A47F5 /* tclRegexp.c */; }; F96D45BB08F272BC004A47F5 /* tclResolve.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1C08F272A7004A47F5 /* tclResolve.c */; }; F96D45BC08F272BC004A47F5 /* tclResult.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1D08F272A7004A47F5 /* tclResult.c */; }; F96D45BD08F272BC004A47F5 /* tclScan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1E08F272A7004A47F5 /* tclScan.c */; }; F96D45BE08F272BC004A47F5 /* tclStringObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1F08F272A7004A47F5 /* tclStringObj.c */; }; F96D45C308F272BC004A47F5 /* tclStrToD.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2408F272A7004A47F5 /* tclStrToD.c */; }; F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2508F272A7004A47F5 /* tclStubInit.c */; }; F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2608F272A7004A47F5 /* tclStubLib.c */; }; F96D45C608F272BC004A47F5 /* tclTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2708F272A7004A47F5 /* tclTest.c */; }; F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2808F272A7004A47F5 /* tclTestObj.c */; }; F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */; }; F96D45C908F272BC004A47F5 /* tclThread.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2A08F272A7004A47F5 /* tclThread.c */; }; F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */; }; F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */; }; F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */; }; F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */; }; F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2F08F272A7004A47F5 /* tclTimer.c */; }; F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */; }; F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3208F272A7004A47F5 /* tclTrace.c */; }; F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3408F272A7004A47F5 /* tclUtf.c */; }; F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3508F272A7004A47F5 /* tclUtil.c */; }; F96D45D508F272BC004A47F5 /* tclVar.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3608F272A7004A47F5 /* tclVar.c */; }; F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */; }; F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */; }; F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426908F272B3004A47F5 /* bn_mp_add.c */; }; F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */; }; F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */; }; F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426E08F272B3004A47F5 /* bn_mp_clear.c */; }; F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */; }; F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427008F272B3004A47F5 /* bn_mp_cmp.c */; }; F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */; }; F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_cnt_lsb.c */; }; F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_copy.c */; }; F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */; }; F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427608F272B3004A47F5 /* bn_mp_div.c */; }; F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427708F272B3004A47F5 /* bn_mp_div_2.c */; }; F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */; }; F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427908F272B3004A47F5 /* bn_mp_div_3.c */; }; F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */; }; F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427E08F272B3004A47F5 /* bn_mp_exch.c */; }; F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428708F272B3004A47F5 /* bn_mp_grow.c */; }; F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428808F272B3004A47F5 /* bn_mp_init.c */; }; F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */; }; F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */; }; F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */; }; F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */; }; F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */; }; F96D491108F272C3004A47F5 /* bn_mp_karatsuba_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */; }; F96D491308F272C3004A47F5 /* bn_mp_lshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429508F272B3004A47F5 /* bn_mp_lshd.c */; }; F96D491408F272C3004A47F5 /* bn_mp_mod.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429608F272B3004A47F5 /* bn_mp_mod.c */; }; F96D491508F272C3004A47F5 /* bn_mp_mod_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */; }; F96D491A08F272C3004A47F5 /* bn_mp_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429C08F272B3004A47F5 /* bn_mp_mul.c */; }; F96D491B08F272C3004A47F5 /* bn_mp_mul_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */; }; F96D491C08F272C3004A47F5 /* bn_mp_mul_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */; }; F96D491D08F272C3004A47F5 /* bn_mp_mul_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */; }; F96D492908F272C3004A47F5 /* bn_mp_radix_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */; }; F96D492A08F272C3004A47F5 /* bn_mp_radix_smap.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */; }; F96D492C08F272C3004A47F5 /* bn_mp_read_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */; }; F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */; }; F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BA08F272B3004A47F5 /* bn_mp_set.c */; }; F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */; }; F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C108F272B3004A47F5 /* bn_mp_sub.c */; }; F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */; }; F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */; }; F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */; }; F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */; }; F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */; }; F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D008F272B3004A47F5 /* bn_reverse.c */; }; F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */; }; F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */; }; F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */; }; F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */; }; F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */; }; F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */; }; F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */; }; F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445B08F272B9004A47F5 /* tclLoadDyld.c */; settings = {COMPILER_FLAGS = "-Wno-deprecated-declarations"; }; }; F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445F08F272B9004A47F5 /* tclUnixChan.c */; }; F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446008F272B9004A47F5 /* tclUnixEvent.c */; }; F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446108F272B9004A47F5 /* tclUnixFCmd.c */; }; F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446208F272B9004A47F5 /* tclUnixFile.c */; }; F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446308F272B9004A47F5 /* tclUnixInit.c */; settings = {COMPILER_FLAGS = "-DTCL_LIBRARY=\\\"$(TCL_LIBRARY)\\\" -DTCL_PACKAGE_PATH=\\\"$(TCL_PACKAGE_PATH)\\\""; }; }; F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446408F272B9004A47F5 /* tclUnixNotfy.c */; }; F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446508F272B9004A47F5 /* tclUnixPipe.c */; }; F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446708F272B9004A47F5 /* tclUnixSock.c */; }; F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446808F272B9004A47F5 /* tclUnixTest.c */; }; F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446908F272B9004A47F5 /* tclUnixThrd.c */; }; F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; }; F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; }; F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; }; F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; }; F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; }; F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */; }; F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; }; F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; }; F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; }; F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */; }; F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */; }; F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; }; F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; }; /* End PBXBuildFile section */ /* Begin PBXContainerItemProxy section */ F97258D20A868C6F00096C78 /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = 08FB7793FE84155DC02AAC07 /* Project object */; proxyType = 1; remoteGlobalIDString = 8DD76FA90486AB0100D96B5E; remoteInfo = tcltest; }; /* End PBXContainerItemProxy section */ /* Begin PBXFileReference section */ 8DD76FB20486AB0100D96B5E /* tcltest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tcltest; sourceTree = BUILT_PRODUCTS_DIR; }; F915432A0EF201CF0032D1E8 /* zlib.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = zlib.test; sourceTree = ""; }; F915432D0EF201EE0032D1E8 /* zlib.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = zlib.n; sourceTree = ""; }; F9183E640EFC80CD0030B814 /* throw.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = throw.n; sourceTree = ""; }; F9183E650EFC80D70030B814 /* try.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = try.n; sourceTree = ""; }; F9183E6A0EFC81560030B814 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F9183E8F0EFC817B0030B814 /* tdbc */ = {isa = PBXFileReference; lastKnownFileType = folder; path = tdbc; sourceTree = ""; }; F91DC23C0E44C51B002CB8D1 /* nre.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = nre.test; sourceTree = ""; }; F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xml; path = "Tclsh-Info.plist.in"; sourceTree = ""; }; F92D7F100DE777240033A13A /* tsdPerf.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tsdPerf.tcl; sourceTree = ""; }; F93599B20DF1F75400E04F67 /* tclOO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOO.c; sourceTree = ""; }; F93599B40DF1F75900E04F67 /* tclOO.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclOO.decls; sourceTree = ""; }; F93599B50DF1F75D00E04F67 /* tclOO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOO.h; sourceTree = ""; }; F93599B60DF1F76100E04F67 /* tclOOBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOBasic.c; sourceTree = ""; }; F93599B80DF1F76600E04F67 /* tclOOCall.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOCall.c; sourceTree = ""; }; F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = ""; }; F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = ""; }; F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = ""; }; F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = ""; }; F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = ""; }; F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = ""; }; F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = ""; }; F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = ""; }; F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = ""; }; F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = ""; }; F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = ""; }; F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = ""; }; F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = ""; }; F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = ""; }; F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = ""; }; F93599D60DF1F95000E04F67 /* next.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = next.n; sourceTree = ""; }; F93599D70DF1F96800E04F67 /* object.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = object.n; sourceTree = ""; }; F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = ""; }; F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = ""; }; F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = ""; }; F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = ""; }; F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = ""; }; F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = ""; }; F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = ""; }; F96D3DFA08F272A4004A47F5 /* ChangeLog */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = ChangeLog; sourceTree = ""; }; F96D3DFB08F272A4004A47F5 /* changes */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes; sourceTree = ""; }; F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = ""; }; F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = ""; }; F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = ""; }; F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = ""; }; F96D3E0108F272A4004A47F5 /* AllowExc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AllowExc.3; sourceTree = ""; }; F96D3E0208F272A4004A47F5 /* append.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = append.n; sourceTree = ""; }; F96D3E0308F272A4004A47F5 /* AppInit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AppInit.3; sourceTree = ""; }; F96D3E0408F272A5004A47F5 /* array.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = array.n; sourceTree = ""; }; F96D3E0508F272A5004A47F5 /* AssocData.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AssocData.3; sourceTree = ""; }; F96D3E0608F272A5004A47F5 /* Async.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Async.3; sourceTree = ""; }; F96D3E0708F272A5004A47F5 /* BackgdErr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = BackgdErr.3; sourceTree = ""; }; F96D3E0808F272A5004A47F5 /* Backslash.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Backslash.3; sourceTree = ""; }; F96D3E0908F272A5004A47F5 /* bgerror.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = bgerror.n; sourceTree = ""; }; F96D3E0A08F272A5004A47F5 /* binary.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = binary.n; sourceTree = ""; }; F96D3E0B08F272A5004A47F5 /* BoolObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = BoolObj.3; sourceTree = ""; }; F96D3E0C08F272A5004A47F5 /* break.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = break.n; sourceTree = ""; }; F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ByteArrObj.3; sourceTree = ""; }; F96D3E0E08F272A5004A47F5 /* CallDel.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CallDel.3; sourceTree = ""; }; F96D3E0F08F272A5004A47F5 /* case.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = case.n; sourceTree = ""; }; F96D3E1008F272A5004A47F5 /* catch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = catch.n; sourceTree = ""; }; F96D3E1108F272A5004A47F5 /* cd.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = cd.n; sourceTree = ""; }; F96D3E1208F272A5004A47F5 /* chan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = chan.n; sourceTree = ""; }; F96D3E1308F272A5004A47F5 /* ChnlStack.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ChnlStack.3; sourceTree = ""; }; F96D3E1408F272A5004A47F5 /* clock.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = clock.n; sourceTree = ""; }; F96D3E1508F272A5004A47F5 /* close.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = close.n; sourceTree = ""; }; F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CmdCmplt.3; sourceTree = ""; }; F96D3E1708F272A5004A47F5 /* Concat.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Concat.3; sourceTree = ""; }; F96D3E1808F272A5004A47F5 /* concat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = concat.n; sourceTree = ""; }; F96D3E1908F272A5004A47F5 /* continue.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = continue.n; sourceTree = ""; }; F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChannel.3; sourceTree = ""; }; F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChnlHdlr.3; sourceTree = ""; }; F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCloseHdlr.3; sourceTree = ""; }; F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCommand.3; sourceTree = ""; }; F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtFileHdlr.3; sourceTree = ""; }; F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtInterp.3; sourceTree = ""; }; F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtMathFnc.3; sourceTree = ""; }; F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtObjCmd.3; sourceTree = ""; }; F96D3E2208F272A5004A47F5 /* CrtAlias.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtAlias.3; sourceTree = ""; }; F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTimerHdlr.3; sourceTree = ""; }; F96D3E2408F272A5004A47F5 /* CrtTrace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTrace.3; sourceTree = ""; }; F96D3E2508F272A5004A47F5 /* dde.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dde.n; sourceTree = ""; }; F96D3E2608F272A5004A47F5 /* DetachPids.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DetachPids.3; sourceTree = ""; }; F96D3E2708F272A5004A47F5 /* dict.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dict.n; sourceTree = ""; }; F96D3E2808F272A5004A47F5 /* DictObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DictObj.3; sourceTree = ""; }; F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoOneEvent.3; sourceTree = ""; }; F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoubleObj.3; sourceTree = ""; }; F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoWhenIdle.3; sourceTree = ""; }; F96D3E2C08F272A5004A47F5 /* DString.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DString.3; sourceTree = ""; }; F96D3E2D08F272A5004A47F5 /* DumpActiveMemory.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DumpActiveMemory.3; sourceTree = ""; }; F96D3E2E08F272A5004A47F5 /* Encoding.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Encoding.3; sourceTree = ""; }; F96D3E2F08F272A5004A47F5 /* encoding.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = encoding.n; sourceTree = ""; }; F96D3E3008F272A5004A47F5 /* Ensemble.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Ensemble.3; sourceTree = ""; }; F96D3E3108F272A5004A47F5 /* Environment.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Environment.3; sourceTree = ""; }; F96D3E3208F272A5004A47F5 /* eof.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = eof.n; sourceTree = ""; }; F96D3E3308F272A5004A47F5 /* error.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = error.n; sourceTree = ""; }; F96D3E3408F272A5004A47F5 /* Eval.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Eval.3; sourceTree = ""; }; F96D3E3508F272A5004A47F5 /* eval.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = eval.n; sourceTree = ""; }; F96D3E3608F272A5004A47F5 /* exec.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = exec.n; sourceTree = ""; }; F96D3E3708F272A5004A47F5 /* Exit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Exit.3; sourceTree = ""; }; F96D3E3808F272A5004A47F5 /* exit.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = exit.n; sourceTree = ""; }; F96D3E3908F272A5004A47F5 /* expr.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = expr.n; sourceTree = ""; }; F96D3E3A08F272A5004A47F5 /* ExprLong.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ExprLong.3; sourceTree = ""; }; F96D3E3B08F272A5004A47F5 /* ExprLongObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ExprLongObj.3; sourceTree = ""; }; F96D3E3C08F272A5004A47F5 /* fblocked.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fblocked.n; sourceTree = ""; }; F96D3E3D08F272A5004A47F5 /* fconfigure.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fconfigure.n; sourceTree = ""; }; F96D3E3E08F272A5004A47F5 /* fcopy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fcopy.n; sourceTree = ""; }; F96D3E3F08F272A5004A47F5 /* file.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = file.n; sourceTree = ""; }; F96D3E4008F272A5004A47F5 /* fileevent.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fileevent.n; sourceTree = ""; }; F96D3E4108F272A5004A47F5 /* filename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = filename.n; sourceTree = ""; }; F96D3E4208F272A5004A47F5 /* FileSystem.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = FileSystem.3; sourceTree = ""; }; F96D3E4308F272A5004A47F5 /* FindExec.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = FindExec.3; sourceTree = ""; }; F96D3E4408F272A5004A47F5 /* flush.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = flush.n; sourceTree = ""; }; F96D3E4508F272A5004A47F5 /* for.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = for.n; sourceTree = ""; }; F96D3E4608F272A5004A47F5 /* foreach.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = foreach.n; sourceTree = ""; }; F96D3E4708F272A5004A47F5 /* format.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = format.n; sourceTree = ""; }; F96D3E4808F272A5004A47F5 /* GetCwd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetCwd.3; sourceTree = ""; }; F96D3E4908F272A5004A47F5 /* GetHostName.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetHostName.3; sourceTree = ""; }; F96D3E4A08F272A5004A47F5 /* GetIndex.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetIndex.3; sourceTree = ""; }; F96D3E4B08F272A5004A47F5 /* GetInt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetInt.3; sourceTree = ""; }; F96D3E4C08F272A5004A47F5 /* GetOpnFl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetOpnFl.3; sourceTree = ""; }; F96D3E4D08F272A5004A47F5 /* gets.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = gets.n; sourceTree = ""; }; F96D3E4E08F272A5004A47F5 /* GetStdChan.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetStdChan.3; sourceTree = ""; }; F96D3E4F08F272A5004A47F5 /* GetTime.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetTime.3; sourceTree = ""; }; F96D3E5008F272A5004A47F5 /* GetVersion.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetVersion.3; sourceTree = ""; }; F96D3E5108F272A5004A47F5 /* glob.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = glob.n; sourceTree = ""; }; F96D3E5208F272A6004A47F5 /* global.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = global.n; sourceTree = ""; }; F96D3E5308F272A6004A47F5 /* Hash.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Hash.3; sourceTree = ""; }; F96D3E5408F272A6004A47F5 /* history.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = history.n; sourceTree = ""; }; F96D3E5508F272A6004A47F5 /* http.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = http.n; sourceTree = ""; }; F96D3E5608F272A6004A47F5 /* if.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = if.n; sourceTree = ""; }; F96D3E5708F272A6004A47F5 /* incr.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = incr.n; sourceTree = ""; }; F96D3E5808F272A6004A47F5 /* info.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = info.n; sourceTree = ""; }; F96D3E5908F272A6004A47F5 /* Init.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Init.3; sourceTree = ""; }; F96D3E5A08F272A6004A47F5 /* InitStubs.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = InitStubs.3; sourceTree = ""; }; F96D3E5B08F272A6004A47F5 /* Interp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Interp.3; sourceTree = ""; }; F96D3E5C08F272A6004A47F5 /* interp.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = interp.n; sourceTree = ""; }; F96D3E5D08F272A6004A47F5 /* IntObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = IntObj.3; sourceTree = ""; }; F96D3E5E08F272A6004A47F5 /* join.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = join.n; sourceTree = ""; }; F96D3E5F08F272A6004A47F5 /* lappend.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lappend.n; sourceTree = ""; }; F96D3E6008F272A6004A47F5 /* lassign.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lassign.n; sourceTree = ""; }; F96D3E6108F272A6004A47F5 /* library.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = library.n; sourceTree = ""; }; F96D3E6208F272A6004A47F5 /* Limit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Limit.3; sourceTree = ""; }; F96D3E6308F272A6004A47F5 /* lindex.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lindex.n; sourceTree = ""; }; F96D3E6408F272A6004A47F5 /* LinkVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = LinkVar.3; sourceTree = ""; }; F96D3E6508F272A6004A47F5 /* linsert.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = linsert.n; sourceTree = ""; }; F96D3E6608F272A6004A47F5 /* list.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = list.n; sourceTree = ""; }; F96D3E6708F272A6004A47F5 /* ListObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ListObj.3; sourceTree = ""; }; F96D3E6808F272A6004A47F5 /* llength.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = llength.n; sourceTree = ""; }; F96D3E6908F272A6004A47F5 /* load.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = load.n; sourceTree = ""; }; F96D3E6A08F272A6004A47F5 /* lrange.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lrange.n; sourceTree = ""; }; F96D3E6B08F272A6004A47F5 /* lrepeat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lrepeat.n; sourceTree = ""; }; F96D3E6C08F272A6004A47F5 /* lreplace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lreplace.n; sourceTree = ""; }; F96D3E6D08F272A6004A47F5 /* lsearch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lsearch.n; sourceTree = ""; }; F96D3E6E08F272A6004A47F5 /* lset.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lset.n; sourceTree = ""; }; F96D3E6F08F272A6004A47F5 /* lsort.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lsort.n; sourceTree = ""; }; F96D3E7008F272A6004A47F5 /* man.macros */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = man.macros; sourceTree = ""; }; F96D3E7108F272A6004A47F5 /* mathfunc.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = mathfunc.n; sourceTree = ""; }; F96D3E7208F272A6004A47F5 /* memory.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = memory.n; sourceTree = ""; }; F96D3E7308F272A6004A47F5 /* msgcat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = msgcat.n; sourceTree = ""; }; F96D3E7408F272A6004A47F5 /* Namespace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Namespace.3; sourceTree = ""; }; F96D3E7508F272A6004A47F5 /* namespace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = namespace.n; sourceTree = ""; }; F96D3E7608F272A6004A47F5 /* Notifier.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Notifier.3; sourceTree = ""; }; F96D3E7708F272A6004A47F5 /* Object.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Object.3; sourceTree = ""; }; F96D3E7808F272A6004A47F5 /* ObjectType.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ObjectType.3; sourceTree = ""; }; F96D3E7908F272A6004A47F5 /* open.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = open.n; sourceTree = ""; }; F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = OpenFileChnl.3; sourceTree = ""; }; F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = OpenTcp.3; sourceTree = ""; }; F96D3E7C08F272A6004A47F5 /* package.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = package.n; sourceTree = ""; }; F96D3E7D08F272A6004A47F5 /* packagens.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = packagens.n; sourceTree = ""; }; F96D3E7E08F272A6004A47F5 /* Panic.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Panic.3; sourceTree = ""; }; F96D3E7F08F272A6004A47F5 /* ParseCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ParseCmd.3; sourceTree = ""; }; F96D3E8008F272A6004A47F5 /* pid.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pid.n; sourceTree = ""; }; F96D3E8108F272A6004A47F5 /* pkgMkIndex.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pkgMkIndex.n; sourceTree = ""; }; F96D3E8208F272A6004A47F5 /* PkgRequire.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = PkgRequire.3; sourceTree = ""; }; F96D3E8308F272A6004A47F5 /* Preserve.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Preserve.3; sourceTree = ""; }; F96D3E8408F272A6004A47F5 /* PrintDbl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = PrintDbl.3; sourceTree = ""; }; F96D3E8508F272A6004A47F5 /* proc.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = proc.n; sourceTree = ""; }; F96D3E8608F272A6004A47F5 /* puts.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = puts.n; sourceTree = ""; }; F96D3E8708F272A6004A47F5 /* pwd.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pwd.n; sourceTree = ""; }; F96D3E8808F272A6004A47F5 /* re_syntax.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = re_syntax.n; sourceTree = ""; }; F96D3E8908F272A6004A47F5 /* read.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = read.n; sourceTree = ""; }; F96D3E8A08F272A6004A47F5 /* RecEvalObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RecEvalObj.3; sourceTree = ""; }; F96D3E8B08F272A6004A47F5 /* RecordEval.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RecordEval.3; sourceTree = ""; }; F96D3E8C08F272A6004A47F5 /* RegConfig.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RegConfig.3; sourceTree = ""; }; F96D3E8D08F272A6004A47F5 /* RegExp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RegExp.3; sourceTree = ""; }; F96D3E8E08F272A6004A47F5 /* regexp.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = regexp.n; sourceTree = ""; }; F96D3E8F08F272A6004A47F5 /* registry.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = registry.n; sourceTree = ""; }; F96D3E9008F272A6004A47F5 /* regsub.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = regsub.n; sourceTree = ""; }; F96D3E9108F272A6004A47F5 /* rename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = rename.n; sourceTree = ""; }; F96D3E9208F272A6004A47F5 /* return.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = return.n; sourceTree = ""; }; F96D3E9308F272A6004A47F5 /* safe.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = safe.n; sourceTree = ""; }; F96D3E9408F272A6004A47F5 /* SaveResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SaveResult.3; sourceTree = ""; }; F96D3E9508F272A6004A47F5 /* scan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = scan.n; sourceTree = ""; }; F96D3E9608F272A6004A47F5 /* seek.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = seek.n; sourceTree = ""; }; F96D3E9708F272A6004A47F5 /* set.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = set.n; sourceTree = ""; }; F96D3E9808F272A6004A47F5 /* SetChanErr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetChanErr.3; sourceTree = ""; }; F96D3E9908F272A6004A47F5 /* SetErrno.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetErrno.3; sourceTree = ""; }; F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetRecLmt.3; sourceTree = ""; }; F96D3E9B08F272A7004A47F5 /* SetResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetResult.3; sourceTree = ""; }; F96D3E9C08F272A7004A47F5 /* SetVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetVar.3; sourceTree = ""; }; F96D3E9D08F272A7004A47F5 /* Signal.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Signal.3; sourceTree = ""; }; F96D3E9E08F272A7004A47F5 /* Sleep.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Sleep.3; sourceTree = ""; }; F96D3E9F08F272A7004A47F5 /* socket.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = socket.n; sourceTree = ""; }; F96D3EA008F272A7004A47F5 /* source.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = source.n; sourceTree = ""; }; F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SourceRCFile.3; sourceTree = ""; }; F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = ""; }; F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = ""; }; F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = ""; }; F96D3EA508F272A7004A47F5 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.3; sourceTree = ""; }; F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = ""; }; F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = ""; }; F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = ""; }; F96D3EA908F272A7004A47F5 /* StrMatch.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StrMatch.3; sourceTree = ""; }; F96D3EAA08F272A7004A47F5 /* subst.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = subst.n; sourceTree = ""; }; F96D3EAB08F272A7004A47F5 /* SubstObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SubstObj.3; sourceTree = ""; }; F96D3EAC08F272A7004A47F5 /* switch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = switch.n; sourceTree = ""; }; F96D3EAD08F272A7004A47F5 /* Tcl.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tcl.n; sourceTree = ""; }; F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tcl_Main.3; sourceTree = ""; }; F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TCL_MEM_DEBUG.3; sourceTree = ""; }; F96D3EB008F272A7004A47F5 /* tclsh.1 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tclsh.1; sourceTree = ""; }; F96D3EB108F272A7004A47F5 /* tcltest.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tcltest.n; sourceTree = ""; }; F96D3EB208F272A7004A47F5 /* tclvars.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tclvars.n; sourceTree = ""; }; F96D3EB308F272A7004A47F5 /* tell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tell.n; sourceTree = ""; }; F96D3EB408F272A7004A47F5 /* Thread.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Thread.3; sourceTree = ""; }; F96D3EB508F272A7004A47F5 /* time.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = time.n; sourceTree = ""; }; F96D3EB608F272A7004A47F5 /* tm.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tm.n; sourceTree = ""; }; F96D3EB708F272A7004A47F5 /* ToUpper.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ToUpper.3; sourceTree = ""; }; F96D3EB808F272A7004A47F5 /* trace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = trace.n; sourceTree = ""; }; F96D3EB908F272A7004A47F5 /* TraceCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TraceCmd.3; sourceTree = ""; }; F96D3EBA08F272A7004A47F5 /* TraceVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TraceVar.3; sourceTree = ""; }; F96D3EBB08F272A7004A47F5 /* Translate.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Translate.3; sourceTree = ""; }; F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = UniCharIsAlpha.3; sourceTree = ""; }; F96D3EBD08F272A7004A47F5 /* unknown.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unknown.n; sourceTree = ""; }; F96D3EBE08F272A7004A47F5 /* unload.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unload.n; sourceTree = ""; }; F96D3EBF08F272A7004A47F5 /* unset.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unset.n; sourceTree = ""; }; F96D3EC008F272A7004A47F5 /* update.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = update.n; sourceTree = ""; }; F96D3EC108F272A7004A47F5 /* uplevel.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = uplevel.n; sourceTree = ""; }; F96D3EC208F272A7004A47F5 /* UpVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = UpVar.3; sourceTree = ""; }; F96D3EC308F272A7004A47F5 /* upvar.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = upvar.n; sourceTree = ""; }; F96D3EC408F272A7004A47F5 /* Utf.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Utf.3; sourceTree = ""; }; F96D3EC508F272A7004A47F5 /* variable.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = variable.n; sourceTree = ""; }; F96D3EC608F272A7004A47F5 /* vwait.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = vwait.n; sourceTree = ""; }; F96D3EC708F272A7004A47F5 /* while.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = while.n; sourceTree = ""; }; F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = WrongNumArgs.3; sourceTree = ""; }; F96D3ECA08F272A7004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D3ECB08F272A7004A47F5 /* regc_color.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_color.c; sourceTree = ""; }; F96D3ECC08F272A7004A47F5 /* regc_cvec.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_cvec.c; sourceTree = ""; }; F96D3ECD08F272A7004A47F5 /* regc_lex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_lex.c; sourceTree = ""; }; F96D3ECE08F272A7004A47F5 /* regc_locale.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_locale.c; sourceTree = ""; }; F96D3ECF08F272A7004A47F5 /* regc_nfa.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_nfa.c; sourceTree = ""; }; F96D3ED008F272A7004A47F5 /* regcomp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regcomp.c; sourceTree = ""; }; F96D3ED108F272A7004A47F5 /* regcustom.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regcustom.h; sourceTree = ""; }; F96D3ED208F272A7004A47F5 /* rege_dfa.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = rege_dfa.c; sourceTree = ""; }; F96D3ED308F272A7004A47F5 /* regerror.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regerror.c; sourceTree = ""; }; F96D3ED408F272A7004A47F5 /* regerrs.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regerrs.h; sourceTree = ""; }; F96D3ED508F272A7004A47F5 /* regex.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regex.h; sourceTree = ""; }; F96D3ED608F272A7004A47F5 /* regexec.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regexec.c; sourceTree = ""; }; F96D3ED708F272A7004A47F5 /* regfree.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regfree.c; sourceTree = ""; }; F96D3ED808F272A7004A47F5 /* regfronts.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regfronts.c; sourceTree = ""; }; F96D3ED908F272A7004A47F5 /* regguts.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regguts.h; sourceTree = ""; }; F96D3EDA08F272A7004A47F5 /* tcl.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcl.decls; sourceTree = ""; }; F96D3EDB08F272A7004A47F5 /* tcl.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tcl.h; sourceTree = ""; }; F96D3EDC08F272A7004A47F5 /* tclAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAlloc.c; sourceTree = ""; }; F96D3EDD08F272A7004A47F5 /* tclAsync.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAsync.c; sourceTree = ""; }; F96D3EDE08F272A7004A47F5 /* tclBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclBasic.c; sourceTree = ""; }; F96D3EDF08F272A7004A47F5 /* tclBinary.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclBinary.c; sourceTree = ""; }; F96D3EE008F272A7004A47F5 /* tclCkalloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCkalloc.c; sourceTree = ""; }; F96D3EE108F272A7004A47F5 /* tclClock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclClock.c; sourceTree = ""; }; F96D3EE208F272A7004A47F5 /* tclCmdAH.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdAH.c; sourceTree = ""; }; F96D3EE308F272A7004A47F5 /* tclCmdIL.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdIL.c; sourceTree = ""; }; F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdMZ.c; sourceTree = ""; }; F96D3EE508F272A7004A47F5 /* tclCompCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompCmds.c; sourceTree = ""; }; F96D3EE608F272A7004A47F5 /* tclCompExpr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompExpr.c; sourceTree = ""; }; F96D3EE708F272A7004A47F5 /* tclCompile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompile.c; sourceTree = ""; }; F96D3EE808F272A7004A47F5 /* tclCompile.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclCompile.h; sourceTree = ""; }; F96D3EE908F272A7004A47F5 /* tclConfig.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclConfig.c; sourceTree = ""; }; F96D3EEA08F272A7004A47F5 /* tclDate.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclDate.c; sourceTree = ""; }; F96D3EEB08F272A7004A47F5 /* tclDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclDecls.h; sourceTree = ""; }; F96D3EEC08F272A7004A47F5 /* tclDictObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclDictObj.c; sourceTree = ""; }; F96D3EED08F272A7004A47F5 /* tclEncoding.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEncoding.c; sourceTree = ""; }; F96D3EEE08F272A7004A47F5 /* tclEnv.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEnv.c; sourceTree = ""; }; F96D3EEF08F272A7004A47F5 /* tclEvent.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEvent.c; sourceTree = ""; }; F96D3EF008F272A7004A47F5 /* tclExecute.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclExecute.c; sourceTree = ""; }; F96D3EF108F272A7004A47F5 /* tclFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclFCmd.c; sourceTree = ""; }; F96D3EF208F272A7004A47F5 /* tclFileName.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclFileName.c; sourceTree = ""; }; F96D3EF308F272A7004A47F5 /* tclFileSystem.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclFileSystem.h; sourceTree = ""; }; F96D3EF408F272A7004A47F5 /* tclGet.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclGet.c; sourceTree = ""; }; F96D3EF508F272A7004A47F5 /* tclGetDate.y */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.yacc; path = tclGetDate.y; sourceTree = ""; }; F96D3EF608F272A7004A47F5 /* tclHash.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclHash.c; sourceTree = ""; }; F96D3EF708F272A7004A47F5 /* tclHistory.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclHistory.c; sourceTree = ""; }; F96D3EF808F272A7004A47F5 /* tclIndexObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIndexObj.c; sourceTree = ""; }; F96D3EF908F272A7004A47F5 /* tclInt.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclInt.decls; sourceTree = ""; }; F96D3EFA08F272A7004A47F5 /* tclInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclInt.h; sourceTree = ""; }; F96D3EFB08F272A7004A47F5 /* tclIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIntDecls.h; sourceTree = ""; }; F96D3EFC08F272A7004A47F5 /* tclInterp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclInterp.c; sourceTree = ""; }; F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIntPlatDecls.h; sourceTree = ""; }; F96D3EFE08F272A7004A47F5 /* tclIO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIO.c; sourceTree = ""; }; F96D3EFF08F272A7004A47F5 /* tclIO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIO.h; sourceTree = ""; }; F96D3F0008F272A7004A47F5 /* tclIOCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOCmd.c; sourceTree = ""; }; F96D3F0108F272A7004A47F5 /* tclIOGT.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOGT.c; sourceTree = ""; }; F96D3F0208F272A7004A47F5 /* tclIORChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORChan.c; sourceTree = ""; }; F96D3F0308F272A7004A47F5 /* tclIOSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOSock.c; sourceTree = ""; }; F96D3F0408F272A7004A47F5 /* tclIOUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOUtil.c; sourceTree = ""; }; F96D3F0508F272A7004A47F5 /* tclLink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLink.c; sourceTree = ""; }; F96D3F0608F272A7004A47F5 /* tclListObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclListObj.c; sourceTree = ""; }; F96D3F0708F272A7004A47F5 /* tclLiteral.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLiteral.c; sourceTree = ""; }; F96D3F0808F272A7004A47F5 /* tclLoad.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoad.c; sourceTree = ""; }; F96D3F0908F272A7004A47F5 /* tclLoadNone.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadNone.c; sourceTree = ""; }; F96D3F0A08F272A7004A47F5 /* tclMain.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMain.c; sourceTree = ""; }; F96D3F0B08F272A7004A47F5 /* tclNamesp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclNamesp.c; sourceTree = ""; }; F96D3F0C08F272A7004A47F5 /* tclNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclNotify.c; sourceTree = ""; }; F96D3F0D08F272A7004A47F5 /* tclObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclObj.c; sourceTree = ""; }; F96D3F0E08F272A7004A47F5 /* tclPanic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPanic.c; sourceTree = ""; }; F96D3F0F08F272A7004A47F5 /* tclParse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclParse.c; sourceTree = ""; }; F96D3F1108F272A7004A47F5 /* tclPathObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPathObj.c; sourceTree = ""; }; F96D3F1208F272A7004A47F5 /* tclPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPipe.c; sourceTree = ""; }; F96D3F1308F272A7004A47F5 /* tclPkg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPkg.c; sourceTree = ""; }; F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPkgConfig.c; sourceTree = ""; }; F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclPlatDecls.h; sourceTree = ""; }; F96D3F1608F272A7004A47F5 /* tclPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclPort.h; sourceTree = ""; }; F96D3F1708F272A7004A47F5 /* tclPosixStr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPosixStr.c; sourceTree = ""; }; F96D3F1808F272A7004A47F5 /* tclPreserve.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPreserve.c; sourceTree = ""; }; F96D3F1908F272A7004A47F5 /* tclProc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclProc.c; sourceTree = ""; }; F96D3F1A08F272A7004A47F5 /* tclRegexp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclRegexp.c; sourceTree = ""; }; F96D3F1B08F272A7004A47F5 /* tclRegexp.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclRegexp.h; sourceTree = ""; }; F96D3F1C08F272A7004A47F5 /* tclResolve.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclResolve.c; sourceTree = ""; }; F96D3F1D08F272A7004A47F5 /* tclResult.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclResult.c; sourceTree = ""; }; F96D3F1E08F272A7004A47F5 /* tclScan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclScan.c; sourceTree = ""; }; F96D3F1F08F272A7004A47F5 /* tclStringObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStringObj.c; sourceTree = ""; }; F96D3F2408F272A7004A47F5 /* tclStrToD.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStrToD.c; sourceTree = ""; }; F96D3F2508F272A7004A47F5 /* tclStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubInit.c; sourceTree = ""; }; F96D3F2608F272A7004A47F5 /* tclStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubLib.c; sourceTree = ""; }; F96D3F2708F272A7004A47F5 /* tclTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTest.c; sourceTree = ""; }; F96D3F2808F272A7004A47F5 /* tclTestObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestObj.c; sourceTree = ""; }; F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestProcBodyObj.c; sourceTree = ""; }; F96D3F2A08F272A7004A47F5 /* tclThread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThread.c; sourceTree = ""; }; F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadAlloc.c; sourceTree = ""; }; F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadJoin.c; sourceTree = ""; }; F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadStorage.c; sourceTree = ""; }; F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadTest.c; sourceTree = ""; }; F96D3F2F08F272A7004A47F5 /* tclTimer.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTimer.c; sourceTree = ""; }; F96D3F3008F272A7004A47F5 /* tclTomMath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMath.h; sourceTree = ""; }; F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTomMathInterface.c; sourceTree = ""; }; F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = ""; }; F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = ""; }; F96D3F3408F272A7004A47F5 /* tclUtf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtf.c; sourceTree = ""; }; F96D3F3508F272A7004A47F5 /* tclUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtil.c; sourceTree = ""; }; F96D3F3608F272A7004A47F5 /* tclVar.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclVar.c; sourceTree = ""; }; F96D3F3708F272A7004A47F5 /* tommath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath.h; sourceTree = ""; }; F96D3F3908F272A8004A47F5 /* auto.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = auto.tcl; sourceTree = ""; }; F96D3F3A08F272A8004A47F5 /* clock.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.tcl; sourceTree = ""; }; F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D3F8C08F272A8004A47F5 /* history.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.tcl; sourceTree = ""; }; F96D3F8E08F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = ""; }; F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D3F9108F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = ""; }; F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D3F9308F272A8004A47F5 /* init.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.tcl; sourceTree = ""; }; F96D3F9508F272A8004A47F5 /* msgcat.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = msgcat.tcl; sourceTree = ""; }; F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D401808F272AA004A47F5 /* optparse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = optparse.tcl; sourceTree = ""; }; F96D401908F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D401A08F272AA004A47F5 /* package.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = package.tcl; sourceTree = ""; }; F96D401B08F272AA004A47F5 /* parray.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parray.tcl; sourceTree = ""; }; F96D401D08F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D401E08F272AA004A47F5 /* safe.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.tcl; sourceTree = ""; }; F96D401F08F272AA004A47F5 /* tclIndex */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclIndex; sourceTree = ""; }; F96D402108F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D402208F272AA004A47F5 /* tcltest.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.tcl; sourceTree = ""; }; F96D402308F272AA004A47F5 /* tm.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.tcl; sourceTree = ""; }; F96D425B08F272B2004A47F5 /* word.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = word.tcl; sourceTree = ""; }; F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_digs.c; sourceTree = ""; }; F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_sqr.c; sourceTree = ""; }; F96D426908F272B3004A47F5 /* bn_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add.c; sourceTree = ""; }; F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add_d.c; sourceTree = ""; }; F96D426C08F272B3004A47F5 /* bn_mp_and.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_and.c; sourceTree = ""; }; F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clamp.c; sourceTree = ""; }; F96D426E08F272B3004A47F5 /* bn_mp_clear.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear.c; sourceTree = ""; }; F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear_multi.c; sourceTree = ""; }; F96D427008F272B3004A47F5 /* bn_mp_cmp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp.c; sourceTree = ""; }; F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_d.c; sourceTree = ""; }; F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_mag.c; sourceTree = ""; }; F96D427408F272B3004A47F5 /* bn_mp_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_copy.c; sourceTree = ""; }; F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_count_bits.c; sourceTree = ""; }; F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = ""; }; F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = ""; }; F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = ""; }; F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = ""; }; F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = ""; }; F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = ""; }; F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_u32.c; sourceTree = ""; }; F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = ""; }; F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = ""; }; F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = ""; }; F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = ""; }; F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = ""; }; F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_size.c; sourceTree = ""; }; F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_mul.c; sourceTree = ""; }; F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_sqr.c; sourceTree = ""; }; F96D429508F272B3004A47F5 /* bn_mp_lshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lshd.c; sourceTree = ""; }; F96D429608F272B3004A47F5 /* bn_mp_mod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod.c; sourceTree = ""; }; F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_2d.c; sourceTree = ""; }; F96D429C08F272B3004A47F5 /* bn_mp_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul.c; sourceTree = ""; }; F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2.c; sourceTree = ""; }; F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2d.c; sourceTree = ""; }; F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_d.c; sourceTree = ""; }; F96D42A208F272B3004A47F5 /* bn_mp_neg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_neg.c; sourceTree = ""; }; F96D42A308F272B3004A47F5 /* bn_mp_or.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_or.c; sourceTree = ""; }; F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_size.c; sourceTree = ""; }; F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_smap.c; sourceTree = ""; }; F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_radix.c; sourceTree = ""; }; F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rshd.c; sourceTree = ""; }; F96D42BA08F272B3004A47F5 /* bn_mp_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set.c; sourceTree = ""; }; F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = ""; }; F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = ""; }; F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = ""; }; F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = ""; }; F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = ""; }; F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_ubin.c; sourceTree = ""; }; F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = ""; }; F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = ""; }; F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_radix.c; sourceTree = ""; }; F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_ubin_size.c; sourceTree = ""; }; F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = ""; }; F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = ""; }; F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = ""; }; F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = ""; }; F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = ""; }; F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = ""; }; F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = ""; }; F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = ""; }; F96D432A08F272B4004A47F5 /* tommath_superclass.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_superclass.h; sourceTree = ""; }; F96D432B08F272B4004A47F5 /* license.terms */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = license.terms; sourceTree = ""; }; F96D432E08F272B5004A47F5 /* configure.ac */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure.ac; sourceTree = ""; }; F96D432F08F272B5004A47F5 /* GNUmakefile */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = GNUmakefile; sourceTree = ""; }; F96D433108F272B5004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */ = {isa = PBXFileReference; explicitFileType = text.plist; fileEncoding = 4; path = "Tcl-Info.plist.in"; sourceTree = ""; }; F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXBundle.c; sourceTree = ""; }; F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXFCmd.c; sourceTree = ""; }; F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXNotify.c; sourceTree = ""; }; F96D434308F272B5004A47F5 /* README */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = README; sourceTree = ""; }; F96D434508F272B5004A47F5 /* all.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = all.tcl; sourceTree = ""; }; F96D434608F272B5004A47F5 /* append.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = append.test; sourceTree = ""; }; F96D434708F272B5004A47F5 /* appendComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = appendComp.test; sourceTree = ""; }; F96D434808F272B5004A47F5 /* assocd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = assocd.test; sourceTree = ""; }; F96D434908F272B5004A47F5 /* async.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = async.test; sourceTree = ""; }; F96D434A08F272B5004A47F5 /* autoMkindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = autoMkindex.test; sourceTree = ""; }; F96D434B08F272B5004A47F5 /* basic.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = basic.test; sourceTree = ""; }; F96D434C08F272B5004A47F5 /* binary.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = binary.test; sourceTree = ""; }; F96D434D08F272B5004A47F5 /* case.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = case.test; sourceTree = ""; }; F96D434E08F272B5004A47F5 /* chan.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chan.test; sourceTree = ""; }; F96D434F08F272B5004A47F5 /* clock.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.test; sourceTree = ""; }; F96D435008F272B5004A47F5 /* cmdAH.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdAH.test; sourceTree = ""; }; F96D435108F272B5004A47F5 /* cmdIL.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdIL.test; sourceTree = ""; }; F96D435208F272B5004A47F5 /* cmdInfo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdInfo.test; sourceTree = ""; }; F96D435308F272B5004A47F5 /* cmdMZ.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdMZ.test; sourceTree = ""; }; F96D435408F272B5004A47F5 /* compExpr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "compExpr-old.test"; sourceTree = ""; }; F96D435508F272B5004A47F5 /* compExpr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = compExpr.test; sourceTree = ""; }; F96D435608F272B5004A47F5 /* compile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = compile.test; sourceTree = ""; }; F96D435708F272B5004A47F5 /* concat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = concat.test; sourceTree = ""; }; F96D435808F272B5004A47F5 /* config.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = config.test; sourceTree = ""; }; F96D435908F272B5004A47F5 /* dcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dcall.test; sourceTree = ""; }; F96D435A08F272B5004A47F5 /* dict.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dict.test; sourceTree = ""; }; F96D435C08F272B5004A47F5 /* dstring.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dstring.test; sourceTree = ""; }; F96D435E08F272B5004A47F5 /* encoding.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = encoding.test; sourceTree = ""; }; F96D435F08F272B5004A47F5 /* env.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = env.test; sourceTree = ""; }; F96D436008F272B5004A47F5 /* error.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = error.test; sourceTree = ""; }; F96D436108F272B5004A47F5 /* eval.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = eval.test; sourceTree = ""; }; F96D436208F272B5004A47F5 /* event.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = event.test; sourceTree = ""; }; F96D436308F272B5004A47F5 /* exec.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = exec.test; sourceTree = ""; }; F96D436408F272B5004A47F5 /* execute.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = execute.test; sourceTree = ""; }; F96D436508F272B5004A47F5 /* expr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "expr-old.test"; sourceTree = ""; }; F96D436608F272B5004A47F5 /* expr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = expr.test; sourceTree = ""; }; F96D436708F272B6004A47F5 /* fCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fCmd.test; sourceTree = ""; }; F96D436808F272B6004A47F5 /* fileName.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fileName.test; sourceTree = ""; }; F96D436908F272B6004A47F5 /* fileSystem.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fileSystem.test; sourceTree = ""; }; F96D436A08F272B6004A47F5 /* for-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "for-old.test"; sourceTree = ""; }; F96D436B08F272B6004A47F5 /* for.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = for.test; sourceTree = ""; }; F96D436C08F272B6004A47F5 /* foreach.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = foreach.test; sourceTree = ""; }; F96D436D08F272B6004A47F5 /* format.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = format.test; sourceTree = ""; }; F96D436E08F272B6004A47F5 /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = ""; }; F96D436F08F272B6004A47F5 /* history.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.test; sourceTree = ""; }; F96D437008F272B6004A47F5 /* http.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.test; sourceTree = ""; }; F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd; sourceTree = ""; }; F96D437208F272B6004A47F5 /* httpold.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpold.test; sourceTree = ""; }; F96D437308F272B6004A47F5 /* if-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "if-old.test"; sourceTree = ""; }; F96D437408F272B6004A47F5 /* if.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = if.test; sourceTree = ""; }; F96D437508F272B6004A47F5 /* incr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "incr-old.test"; sourceTree = ""; }; F96D437608F272B6004A47F5 /* incr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = incr.test; sourceTree = ""; }; F96D437708F272B6004A47F5 /* indexObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = indexObj.test; sourceTree = ""; }; F96D437808F272B6004A47F5 /* info.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = info.test; sourceTree = ""; }; F96D437908F272B6004A47F5 /* init.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.test; sourceTree = ""; }; F96D437A08F272B6004A47F5 /* interp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = interp.test; sourceTree = ""; }; F96D437B08F272B6004A47F5 /* io.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = io.test; sourceTree = ""; }; F96D437C08F272B6004A47F5 /* ioCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioCmd.test; sourceTree = ""; }; F96D437D08F272B6004A47F5 /* iogt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iogt.test; sourceTree = ""; }; F96D437F08F272B6004A47F5 /* join.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = join.test; sourceTree = ""; }; F96D438008F272B6004A47F5 /* lindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lindex.test; sourceTree = ""; }; F96D438108F272B6004A47F5 /* link.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = link.test; sourceTree = ""; }; F96D438208F272B6004A47F5 /* linsert.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = linsert.test; sourceTree = ""; }; F96D438308F272B6004A47F5 /* list.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = list.test; sourceTree = ""; }; F96D438408F272B6004A47F5 /* listObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = listObj.test; sourceTree = ""; }; F96D438508F272B6004A47F5 /* llength.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = llength.test; sourceTree = ""; }; F96D438608F272B6004A47F5 /* load.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = load.test; sourceTree = ""; }; F96D438708F272B6004A47F5 /* lrange.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lrange.test; sourceTree = ""; }; F96D438808F272B6004A47F5 /* lrepeat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lrepeat.test; sourceTree = ""; }; F96D438908F272B6004A47F5 /* lreplace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lreplace.test; sourceTree = ""; }; F96D438A08F272B6004A47F5 /* lsearch.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lsearch.test; sourceTree = ""; }; F96D438B08F272B6004A47F5 /* lset.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lset.test; sourceTree = ""; }; F96D438C08F272B6004A47F5 /* lsetComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lsetComp.test; sourceTree = ""; }; F96D438D08F272B6004A47F5 /* macOSXFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXFCmd.test; sourceTree = ""; }; F96D438E08F272B6004A47F5 /* main.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = main.test; sourceTree = ""; }; F96D438F08F272B6004A47F5 /* misc.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = misc.test; sourceTree = ""; }; F96D439008F272B6004A47F5 /* msgcat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = msgcat.test; sourceTree = ""; }; F96D439108F272B6004A47F5 /* namespace-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "namespace-old.test"; sourceTree = ""; }; F96D439208F272B7004A47F5 /* namespace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = namespace.test; sourceTree = ""; }; F96D439308F272B7004A47F5 /* notify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = notify.test; sourceTree = ""; }; F96D439408F272B7004A47F5 /* obj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = obj.test; sourceTree = ""; }; F96D439508F272B7004A47F5 /* opt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = opt.test; sourceTree = ""; }; F96D439608F272B7004A47F5 /* package.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = package.test; sourceTree = ""; }; F96D439708F272B7004A47F5 /* parse.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parse.test; sourceTree = ""; }; F96D439808F272B7004A47F5 /* parseExpr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parseExpr.test; sourceTree = ""; }; F96D439908F272B7004A47F5 /* parseOld.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parseOld.test; sourceTree = ""; }; F96D439A08F272B7004A47F5 /* pid.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pid.test; sourceTree = ""; }; F96D439B08F272B7004A47F5 /* pkg.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkg.test; sourceTree = ""; }; F96D439C08F272B7004A47F5 /* pkgMkIndex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgMkIndex.test; sourceTree = ""; }; F96D439D08F272B7004A47F5 /* platform.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.test; sourceTree = ""; }; F96D439E08F272B7004A47F5 /* proc-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "proc-old.test"; sourceTree = ""; }; F96D439F08F272B7004A47F5 /* proc.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = proc.test; sourceTree = ""; }; F96D43A008F272B7004A47F5 /* pwd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pwd.test; sourceTree = ""; }; F96D43A108F272B7004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D43A208F272B7004A47F5 /* reg.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = reg.test; sourceTree = ""; }; F96D43A308F272B7004A47F5 /* regexp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexp.test; sourceTree = ""; }; F96D43A408F272B7004A47F5 /* regexpComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpComp.test; sourceTree = ""; }; F96D43A508F272B7004A47F5 /* registry.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = registry.test; sourceTree = ""; }; F96D43A608F272B7004A47F5 /* remote.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = remote.tcl; sourceTree = ""; }; F96D43A708F272B7004A47F5 /* rename.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = rename.test; sourceTree = ""; }; F96D43A808F272B7004A47F5 /* result.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = result.test; sourceTree = ""; }; F96D43A908F272B7004A47F5 /* safe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.test; sourceTree = ""; }; F96D43AA08F272B7004A47F5 /* scan.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = scan.test; sourceTree = ""; }; F96D43AB08F272B7004A47F5 /* security.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = security.test; sourceTree = ""; }; F96D43AC08F272B7004A47F5 /* set-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "set-old.test"; sourceTree = ""; }; F96D43AD08F272B7004A47F5 /* set.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = set.test; sourceTree = ""; }; F96D43AE08F272B7004A47F5 /* socket.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = socket.test; sourceTree = ""; }; F96D43AF08F272B7004A47F5 /* source.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = source.test; sourceTree = ""; }; F96D43B008F272B7004A47F5 /* split.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = split.test; sourceTree = ""; }; F96D43B108F272B7004A47F5 /* stack.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stack.test; sourceTree = ""; }; F96D43B208F272B7004A47F5 /* string.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = string.test; sourceTree = ""; }; F96D43B308F272B7004A47F5 /* stringComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stringComp.test; sourceTree = ""; }; F96D43B408F272B7004A47F5 /* stringObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stringObj.test; sourceTree = ""; }; F96D43B508F272B7004A47F5 /* subst.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = subst.test; sourceTree = ""; }; F96D43B608F272B7004A47F5 /* switch.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = switch.test; sourceTree = ""; }; F96D43B708F272B7004A47F5 /* tcltest.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.test; sourceTree = ""; }; F96D43B808F272B7004A47F5 /* thread.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = thread.test; sourceTree = ""; }; F96D43B908F272B7004A47F5 /* timer.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = timer.test; sourceTree = ""; }; F96D43BA08F272B7004A47F5 /* tm.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.test; sourceTree = ""; }; F96D43BB08F272B7004A47F5 /* trace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = trace.test; sourceTree = ""; }; F96D43BC08F272B7004A47F5 /* unixFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixFCmd.test; sourceTree = ""; }; F96D43BD08F272B7004A47F5 /* unixFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixFile.test; sourceTree = ""; }; F96D43BE08F272B7004A47F5 /* unixInit.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixInit.test; sourceTree = ""; }; F96D43BF08F272B7004A47F5 /* unixNotfy.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixNotfy.test; sourceTree = ""; }; F96D43C008F272B7004A47F5 /* unknown.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unknown.test; sourceTree = ""; }; F96D43C108F272B7004A47F5 /* unload.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unload.test; sourceTree = ""; }; F96D43C208F272B7004A47F5 /* uplevel.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uplevel.test; sourceTree = ""; }; F96D43C308F272B7004A47F5 /* upvar.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = upvar.test; sourceTree = ""; }; F96D43C408F272B7004A47F5 /* utf.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = utf.test; sourceTree = ""; }; F96D43C508F272B7004A47F5 /* util.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = util.test; sourceTree = ""; }; F96D43C608F272B7004A47F5 /* var.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = var.test; sourceTree = ""; }; F96D43C708F272B7004A47F5 /* while-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "while-old.test"; sourceTree = ""; }; F96D43C808F272B7004A47F5 /* while.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = while.test; sourceTree = ""; }; F96D43C908F272B7004A47F5 /* winConsole.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winConsole.test; sourceTree = ""; }; F96D43CA08F272B7004A47F5 /* winDde.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winDde.test; sourceTree = ""; }; F96D43CB08F272B7004A47F5 /* winFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFCmd.test; sourceTree = ""; }; F96D43CC08F272B7004A47F5 /* winFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFile.test; sourceTree = ""; }; F96D43CD08F272B7004A47F5 /* winNotify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winNotify.test; sourceTree = ""; }; F96D43CE08F272B7004A47F5 /* winPipe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winPipe.test; sourceTree = ""; }; F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = ""; }; F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = ""; }; F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = ""; }; F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = ""; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = ""; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = ""; }; F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = ""; }; F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = ""; }; F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = ""; }; F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = ""; }; F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = ""; }; F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = ""; }; F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = ""; }; F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = ""; }; F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = ""; }; F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = ""; }; F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = ""; }; F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = ""; }; F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = ""; }; F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = ""; }; F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = ""; }; F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = ""; }; F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = ""; }; F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = ""; }; F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = ""; }; F96D444708F272B9004A47F5 /* pkgc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgc.c; sourceTree = ""; }; F96D444808F272B9004A47F5 /* pkgd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgd.c; sourceTree = ""; }; F96D444908F272B9004A47F5 /* pkge.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkge.c; sourceTree = ""; }; F96D444B08F272B9004A47F5 /* pkgua.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgua.c; sourceTree = ""; }; F96D444C08F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D444D08F272B9004A47F5 /* install-sh */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = "install-sh"; sourceTree = ""; }; F96D444E08F272B9004A47F5 /* installManPage */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = installManPage; sourceTree = ""; }; F96D444F08F272B9004A47F5 /* ldAix */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = ldAix; sourceTree = ""; }; F96D445008F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; F96D445208F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D445308F272B9004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = ""; }; F96D445408F272B9004A47F5 /* tcl.spec */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.spec; sourceTree = ""; }; F96D445508F272B9004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = ""; }; F96D445608F272B9004A47F5 /* tclConfig.h.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = tclConfig.h.in; sourceTree = ""; }; F96D445708F272B9004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = ""; }; F96D445808F272B9004A47F5 /* tclLoadAix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadAix.c; sourceTree = ""; }; F96D445908F272B9004A47F5 /* tclLoadDl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadDl.c; sourceTree = ""; }; F96D445B08F272B9004A47F5 /* tclLoadDyld.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadDyld.c; sourceTree = ""; }; F96D445C08F272B9004A47F5 /* tclLoadNext.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadNext.c; sourceTree = ""; }; F96D445D08F272B9004A47F5 /* tclLoadOSF.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadOSF.c; sourceTree = ""; }; F96D445E08F272B9004A47F5 /* tclLoadShl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadShl.c; sourceTree = ""; }; F96D445F08F272B9004A47F5 /* tclUnixChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixChan.c; sourceTree = ""; }; F96D446008F272B9004A47F5 /* tclUnixEvent.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixEvent.c; sourceTree = ""; }; F96D446108F272B9004A47F5 /* tclUnixFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixFCmd.c; sourceTree = ""; }; F96D446208F272B9004A47F5 /* tclUnixFile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixFile.c; sourceTree = ""; }; F96D446308F272B9004A47F5 /* tclUnixInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixInit.c; sourceTree = ""; }; F96D446408F272B9004A47F5 /* tclUnixNotfy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixNotfy.c; sourceTree = ""; }; F96D446508F272B9004A47F5 /* tclUnixPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixPipe.c; sourceTree = ""; }; F96D446608F272B9004A47F5 /* tclUnixPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixPort.h; sourceTree = ""; }; F96D446708F272B9004A47F5 /* tclUnixSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixSock.c; sourceTree = ""; }; F96D446808F272B9004A47F5 /* tclUnixTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTest.c; sourceTree = ""; }; F96D446908F272B9004A47F5 /* tclUnixThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixThrd.c; sourceTree = ""; }; F96D446B08F272B9004A47F5 /* tclUnixTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTime.c; sourceTree = ""; }; F96D446C08F272B9004A47F5 /* tclXtNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtNotify.c; sourceTree = ""; }; F96D446D08F272B9004A47F5 /* tclXtTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtTest.c; sourceTree = ""; }; F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = ""; }; F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = ""; }; F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = ""; }; F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = ""; }; F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = ""; }; F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = ""; }; F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = ""; }; F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = ""; }; F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = ""; }; F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = ""; }; F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = ""; }; F96D448008F272BA004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = ""; }; F96D448108F272BA004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = ""; }; F96D448208F272BA004A47F5 /* tcl.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.rc; sourceTree = ""; }; F96D448308F272BA004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = ""; }; F96D448408F272BA004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = ""; }; F96D448608F272BA004A47F5 /* tclsh.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclsh.rc; sourceTree = ""; }; F96D448708F272BA004A47F5 /* tclWin32Dll.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWin32Dll.c; sourceTree = ""; }; F96D448808F272BA004A47F5 /* tclWinChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinChan.c; sourceTree = ""; }; F96D448908F272BA004A47F5 /* tclWinConsole.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinConsole.c; sourceTree = ""; }; F96D448A08F272BA004A47F5 /* tclWinDde.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinDde.c; sourceTree = ""; }; F96D448B08F272BA004A47F5 /* tclWinError.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinError.c; sourceTree = ""; }; F96D448C08F272BA004A47F5 /* tclWinFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinFCmd.c; sourceTree = ""; }; F96D448D08F272BA004A47F5 /* tclWinFile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinFile.c; sourceTree = ""; }; F96D448E08F272BA004A47F5 /* tclWinInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinInit.c; sourceTree = ""; }; F96D448F08F272BA004A47F5 /* tclWinInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinInt.h; sourceTree = ""; }; F96D449008F272BA004A47F5 /* tclWinLoad.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinLoad.c; sourceTree = ""; }; F96D449108F272BA004A47F5 /* tclWinNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinNotify.c; sourceTree = ""; }; F96D449208F272BA004A47F5 /* tclWinPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinPipe.c; sourceTree = ""; }; F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = ""; }; F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = ""; }; F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = ""; }; F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = ""; }; F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = ""; }; F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = ""; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = ""; }; F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = ""; }; F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = ""; }; F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = ""; }; F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = ""; }; F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = ""; }; F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = ""; }; F974D5790FBE7E9C00BF728B /* tcl.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.pc.in; sourceTree = ""; }; F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Common.xcconfig"; sourceTree = ""; }; F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Release.xcconfig"; sourceTree = ""; }; F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Debug.xcconfig"; sourceTree = ""; }; F9903CAF094FAADA004613E9 /* tclTomMath.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclTomMath.decls; sourceTree = ""; }; F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMathDecls.h; sourceTree = ""; }; F99D61180EF5573A00BBFE01 /* TclZlib.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TclZlib.3; sourceTree = ""; }; F9A3084B08F2D4CE00BAE1AB /* tclsh */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tclsh; sourceTree = BUILT_PRODUCTS_DIR; }; F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; }; F9A493240CEBF38300B78AE2 /* chanio.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chanio.test; sourceTree = ""; }; F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = ""; }; F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = ""; }; F9ECB1CA0B2652D300A28025 /* apply.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = apply.test; sourceTree = ""; }; F9ECB1CB0B26534C00A28025 /* mathop.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mathop.test; sourceTree = ""; }; F9ECB1E10B26543C00A28025 /* platform_shell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform_shell.n; sourceTree = ""; }; F9ECB1E20B26543C00A28025 /* platform.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform.n; sourceTree = ""; }; F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.dtrace; path = tclDTrace.d; sourceTree = ""; }; F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixCompat.c; sourceTree = ""; }; /* End PBXFileReference section */ /* Begin PBXFrameworksBuildPhase section */ 8DD76FAD0486AB0100D96B5E /* Frameworks */ = { isa = PBXFrameworksBuildPhase; buildActionMask = 2147483647; files = ( F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */, F96437E70EF0D652003F468E /* libz.dylib in Frameworks */, ); runOnlyForDeploymentPostprocessing = 0; }; /* End PBXFrameworksBuildPhase section */ /* Begin PBXGroup section */ 08FB7794FE84155DC02AAC07 /* Tcl */ = { isa = PBXGroup; children = ( F96D3DF608F27169004A47F5 /* Tcl Sources */, F966C06F08F281DC005CB29B /* Frameworks */, 1AB674ADFE9D54B511CA2CBB /* Products */, ); comments = "Copyright (c) 2004-2009 Daniel A. Steffen \nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\n"; name = Tcl; path = .; sourceTree = SOURCE_ROOT; }; 1AB674ADFE9D54B511CA2CBB /* Products */ = { isa = PBXGroup; children = ( F9A3084B08F2D4CE00BAE1AB /* tclsh */, 8DD76FB20486AB0100D96B5E /* tcltest */, F9A3084E08F2D4F400BAE1AB /* Tcl.framework */, ); includeInIndex = 0; name = Products; sourceTree = ""; }; F9183E690EFC81560030B814 /* pkgs */ = { isa = PBXGroup; children = ( F9183E6A0EFC81560030B814 /* README */, F946FB8B0FBE3AED00CD6495 /* itcl */, F9183E8F0EFC817B0030B814 /* tdbc */, ); path = pkgs; sourceTree = ""; }; F966C06F08F281DC005CB29B /* Frameworks */ = { isa = PBXGroup; children = ( F966C07408F2820D005CB29B /* CoreFoundation.framework */, F96437E60EF0D652003F468E /* libz.dylib */, ); name = Frameworks; sourceTree = ""; }; F96D3DF608F27169004A47F5 /* Tcl Sources */ = { isa = PBXGroup; children = ( F96D3EC908F272A7004A47F5 /* generic */, F96D432C08F272B4004A47F5 /* macosx */, F96D443E08F272B9004A47F5 /* unix */, F96D425C08F272B2004A47F5 /* libtommath */, F96D446E08F272B9004A47F5 /* win */, F96D3F3808F272A7004A47F5 /* library */, F96D434408F272B5004A47F5 /* tests */, F96D3DFC08F272A4004A47F5 /* doc */, F96D43D008F272B8004A47F5 /* tools */, F9183E690EFC81560030B814 /* pkgs */, F96D3DFA08F272A4004A47F5 /* ChangeLog */, F96D3DFB08F272A4004A47F5 /* changes */, F96D434308F272B5004A47F5 /* README.md */, F96D432B08F272B4004A47F5 /* license.terms */, ); name = "Tcl Sources"; sourceTree = TCL_SRCROOT; }; F96D3DFC08F272A4004A47F5 /* doc */ = { isa = PBXGroup; children = ( F96D3DFD08F272A4004A47F5 /* Access.3 */, F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */, F96D3DFF08F272A4004A47F5 /* after.n */, F96D3E0008F272A4004A47F5 /* Alloc.3 */, F96D3E0108F272A4004A47F5 /* AllowExc.3 */, F96D3E0208F272A4004A47F5 /* append.n */, F96D3E0308F272A4004A47F5 /* AppInit.3 */, F96D3E0408F272A5004A47F5 /* array.n */, F96D3E0508F272A5004A47F5 /* AssocData.3 */, F96D3E0608F272A5004A47F5 /* Async.3 */, F96D3E0708F272A5004A47F5 /* BackgdErr.3 */, F96D3E0808F272A5004A47F5 /* Backslash.3 */, F96D3E0908F272A5004A47F5 /* bgerror.n */, F96D3E0A08F272A5004A47F5 /* binary.n */, F96D3E0B08F272A5004A47F5 /* BoolObj.3 */, F96D3E0C08F272A5004A47F5 /* break.n */, F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */, F96D3E0E08F272A5004A47F5 /* CallDel.3 */, F96D3E0F08F272A5004A47F5 /* case.n */, F96D3E1008F272A5004A47F5 /* catch.n */, F96D3E1108F272A5004A47F5 /* cd.n */, F96D3E1208F272A5004A47F5 /* chan.n */, F96D3E1308F272A5004A47F5 /* ChnlStack.3 */, F93599CF0DF1F87F00E04F67 /* Class.3 */, F93599D00DF1F89E00E04F67 /* class.n */, F96D3E1408F272A5004A47F5 /* clock.n */, F96D3E1508F272A5004A47F5 /* close.n */, F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */, F96D3E1708F272A5004A47F5 /* Concat.3 */, F96D3E1808F272A5004A47F5 /* concat.n */, F96D3E1908F272A5004A47F5 /* continue.n */, F93599D20DF1F8DF00E04F67 /* copy.n */, F974D5720FBE7DC600BF728B /* coroutine.n */, F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */, F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */, F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */, F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */, F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */, F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */, F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */, F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */, F96D3E2208F272A5004A47F5 /* CrtAlias.3 */, F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */, F96D3E2408F272A5004A47F5 /* CrtTrace.3 */, F96D3E2508F272A5004A47F5 /* dde.n */, F93599D30DF1F8F500E04F67 /* define.n */, F96D3E2608F272A5004A47F5 /* DetachPids.3 */, F96D3E2708F272A5004A47F5 /* dict.n */, F96D3E2808F272A5004A47F5 /* DictObj.3 */, F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */, F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */, F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */, F96D3E2C08F272A5004A47F5 /* DString.3 */, F96D3E2D08F272A5004A47F5 /* DumpActiveMemory.3 */, F96D3E2E08F272A5004A47F5 /* Encoding.3 */, F96D3E2F08F272A5004A47F5 /* encoding.n */, F96D3E3008F272A5004A47F5 /* Ensemble.3 */, F96D3E3108F272A5004A47F5 /* Environment.3 */, F96D3E3208F272A5004A47F5 /* eof.n */, F96D3E3308F272A5004A47F5 /* error.n */, F96D3E3408F272A5004A47F5 /* Eval.3 */, F96D3E3508F272A5004A47F5 /* eval.n */, F96D3E3608F272A5004A47F5 /* exec.n */, F96D3E3708F272A5004A47F5 /* Exit.3 */, F96D3E3808F272A5004A47F5 /* exit.n */, F96D3E3908F272A5004A47F5 /* expr.n */, F96D3E3A08F272A5004A47F5 /* ExprLong.3 */, F96D3E3B08F272A5004A47F5 /* ExprLongObj.3 */, F96D3E3C08F272A5004A47F5 /* fblocked.n */, F96D3E3D08F272A5004A47F5 /* fconfigure.n */, F96D3E3E08F272A5004A47F5 /* fcopy.n */, F96D3E3F08F272A5004A47F5 /* file.n */, F96D3E4008F272A5004A47F5 /* fileevent.n */, F96D3E4108F272A5004A47F5 /* filename.n */, F96D3E4208F272A5004A47F5 /* FileSystem.3 */, F96D3E4308F272A5004A47F5 /* FindExec.3 */, F96D3E4408F272A5004A47F5 /* flush.n */, F96D3E4508F272A5004A47F5 /* for.n */, F96D3E4608F272A5004A47F5 /* foreach.n */, F96D3E4708F272A5004A47F5 /* format.n */, F96D3E4808F272A5004A47F5 /* GetCwd.3 */, F96D3E4908F272A5004A47F5 /* GetHostName.3 */, F96D3E4A08F272A5004A47F5 /* GetIndex.3 */, F96D3E4B08F272A5004A47F5 /* GetInt.3 */, F96D3E4C08F272A5004A47F5 /* GetOpnFl.3 */, F96D3E4D08F272A5004A47F5 /* gets.n */, F96D3E4E08F272A5004A47F5 /* GetStdChan.3 */, F96D3E4F08F272A5004A47F5 /* GetTime.3 */, F96D3E5008F272A5004A47F5 /* GetVersion.3 */, F96D3E5108F272A5004A47F5 /* glob.n */, F96D3E5208F272A6004A47F5 /* global.n */, F96D3E5308F272A6004A47F5 /* Hash.3 */, F96D3E5408F272A6004A47F5 /* history.n */, F96D3E5508F272A6004A47F5 /* http.n */, F96D3E5608F272A6004A47F5 /* if.n */, F96D3E5708F272A6004A47F5 /* incr.n */, F96D3E5808F272A6004A47F5 /* info.n */, F96D3E5908F272A6004A47F5 /* Init.3 */, F96D3E5A08F272A6004A47F5 /* InitStubs.3 */, F96D3E5B08F272A6004A47F5 /* Interp.3 */, F96D3E5C08F272A6004A47F5 /* interp.n */, F96D3E5D08F272A6004A47F5 /* IntObj.3 */, F96D3E5E08F272A6004A47F5 /* join.n */, F96D3E5F08F272A6004A47F5 /* lappend.n */, F96D3E6008F272A6004A47F5 /* lassign.n */, F96D3E6108F272A6004A47F5 /* library.n */, F96D3E6208F272A6004A47F5 /* Limit.3 */, F96D3E6308F272A6004A47F5 /* lindex.n */, F96D3E6408F272A6004A47F5 /* LinkVar.3 */, F96D3E6508F272A6004A47F5 /* linsert.n */, F96D3E6608F272A6004A47F5 /* list.n */, F96D3E6708F272A6004A47F5 /* ListObj.3 */, F96D3E6808F272A6004A47F5 /* llength.n */, F96D3E6908F272A6004A47F5 /* load.n */, F96D3E6A08F272A6004A47F5 /* lrange.n */, F96D3E6B08F272A6004A47F5 /* lrepeat.n */, F96D3E6C08F272A6004A47F5 /* lreplace.n */, F96D3E6D08F272A6004A47F5 /* lsearch.n */, F96D3E6E08F272A6004A47F5 /* lset.n */, F96D3E6F08F272A6004A47F5 /* lsort.n */, F96D3E7008F272A6004A47F5 /* man.macros */, F96D3E7108F272A6004A47F5 /* mathfunc.n */, F96D3E7208F272A6004A47F5 /* memory.n */, F93599D40DF1F91900E04F67 /* Method.3 */, F96D3E7308F272A6004A47F5 /* msgcat.n */, F93599D50DF1F93700E04F67 /* my.n */, F96D3E7408F272A6004A47F5 /* Namespace.3 */, F96D3E7508F272A6004A47F5 /* namespace.n */, F93599D60DF1F95000E04F67 /* next.n */, F96D3E7608F272A6004A47F5 /* Notifier.3 */, F96D3E7708F272A6004A47F5 /* Object.3 */, F93599D70DF1F96800E04F67 /* object.n */, F96D3E7808F272A6004A47F5 /* ObjectType.3 */, F96D3E7908F272A6004A47F5 /* open.n */, F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */, F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */, F96D3E7C08F272A6004A47F5 /* package.n */, F96D3E7D08F272A6004A47F5 /* packagens.n */, F96D3E7E08F272A6004A47F5 /* Panic.3 */, F96D3E7F08F272A6004A47F5 /* ParseCmd.3 */, F96D3E8008F272A6004A47F5 /* pid.n */, F96D3E8108F272A6004A47F5 /* pkgMkIndex.n */, F96D3E8208F272A6004A47F5 /* PkgRequire.3 */, F9ECB1E10B26543C00A28025 /* platform_shell.n */, F9ECB1E20B26543C00A28025 /* platform.n */, F96D3E8308F272A6004A47F5 /* Preserve.3 */, F96D3E8408F272A6004A47F5 /* PrintDbl.3 */, F96D3E8508F272A6004A47F5 /* proc.n */, F96D3E8608F272A6004A47F5 /* puts.n */, F96D3E8708F272A6004A47F5 /* pwd.n */, F96D3E8808F272A6004A47F5 /* re_syntax.n */, F96D3E8908F272A6004A47F5 /* read.n */, F96D3E8A08F272A6004A47F5 /* RecEvalObj.3 */, F96D3E8B08F272A6004A47F5 /* RecordEval.3 */, F96D3E8C08F272A6004A47F5 /* RegConfig.3 */, F96D3E8D08F272A6004A47F5 /* RegExp.3 */, F96D3E8E08F272A6004A47F5 /* regexp.n */, F96D3E8F08F272A6004A47F5 /* registry.n */, F96D3E9008F272A6004A47F5 /* regsub.n */, F96D3E9108F272A6004A47F5 /* rename.n */, F96D3E9208F272A6004A47F5 /* return.n */, F96D3E9308F272A6004A47F5 /* safe.n */, F96D3E9408F272A6004A47F5 /* SaveResult.3 */, F96D3E9508F272A6004A47F5 /* scan.n */, F96D3E9608F272A6004A47F5 /* seek.n */, F93599D80DF1F98300E04F67 /* self.n */, F96D3E9708F272A6004A47F5 /* set.n */, F96D3E9808F272A6004A47F5 /* SetChanErr.3 */, F96D3E9908F272A6004A47F5 /* SetErrno.3 */, F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */, F96D3E9B08F272A7004A47F5 /* SetResult.3 */, F96D3E9C08F272A7004A47F5 /* SetVar.3 */, F96D3E9D08F272A7004A47F5 /* Signal.3 */, F96D3E9E08F272A7004A47F5 /* Sleep.3 */, F96D3E9F08F272A7004A47F5 /* socket.n */, F96D3EA008F272A7004A47F5 /* source.n */, F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */, F96D3EA208F272A7004A47F5 /* split.n */, F96D3EA308F272A7004A47F5 /* SplitList.3 */, F96D3EA408F272A7004A47F5 /* SplitPath.3 */, F96D3EA508F272A7004A47F5 /* StaticPkg.3 */, F96D3EA608F272A7004A47F5 /* StdChannels.3 */, F96D3EA708F272A7004A47F5 /* string.n */, F96D3EA808F272A7004A47F5 /* StringObj.3 */, F96D3EA908F272A7004A47F5 /* StrMatch.3 */, F96D3EAA08F272A7004A47F5 /* subst.n */, F96D3EAB08F272A7004A47F5 /* SubstObj.3 */, F96D3EAC08F272A7004A47F5 /* switch.n */, F974D5760FBE7E1900BF728B /* tailcall.n */, F96D3EAD08F272A7004A47F5 /* Tcl.n */, F99D61180EF5573A00BBFE01 /* TclZlib.3 */, F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */, F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */, F96D3EB008F272A7004A47F5 /* tclsh.1 */, F96D3EB108F272A7004A47F5 /* tcltest.n */, F96D3EB208F272A7004A47F5 /* tclvars.n */, F96D3EB308F272A7004A47F5 /* tell.n */, F96D3EB408F272A7004A47F5 /* Thread.3 */, F9183E640EFC80CD0030B814 /* throw.n */, F96D3EB508F272A7004A47F5 /* time.n */, F96D3EB608F272A7004A47F5 /* tm.n */, F96D3EB708F272A7004A47F5 /* ToUpper.3 */, F96D3EB808F272A7004A47F5 /* trace.n */, F96D3EB908F272A7004A47F5 /* TraceCmd.3 */, F96D3EBA08F272A7004A47F5 /* TraceVar.3 */, F96D3EBB08F272A7004A47F5 /* Translate.3 */, F9183E650EFC80D70030B814 /* try.n */, F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */, F96D3EBD08F272A7004A47F5 /* unknown.n */, F96D3EBE08F272A7004A47F5 /* unload.n */, F96D3EBF08F272A7004A47F5 /* unset.n */, F96D3EC008F272A7004A47F5 /* update.n */, F96D3EC108F272A7004A47F5 /* uplevel.n */, F96D3EC208F272A7004A47F5 /* UpVar.3 */, F96D3EC308F272A7004A47F5 /* upvar.n */, F96D3EC408F272A7004A47F5 /* Utf.3 */, F96D3EC508F272A7004A47F5 /* variable.n */, F96D3EC608F272A7004A47F5 /* vwait.n */, F96D3EC708F272A7004A47F5 /* while.n */, F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */, F915432D0EF201EE0032D1E8 /* zlib.n */, ); path = doc; sourceTree = ""; }; F96D3EC908F272A7004A47F5 /* generic */ = { isa = PBXGroup; children = ( F96D3ECA08F272A7004A47F5 /* README */, F96D3ECB08F272A7004A47F5 /* regc_color.c */, F96D3ECC08F272A7004A47F5 /* regc_cvec.c */, F96D3ECD08F272A7004A47F5 /* regc_lex.c */, F96D3ECE08F272A7004A47F5 /* regc_locale.c */, F96D3ECF08F272A7004A47F5 /* regc_nfa.c */, F96D3ED008F272A7004A47F5 /* regcomp.c */, F96D3ED108F272A7004A47F5 /* regcustom.h */, F96D3ED208F272A7004A47F5 /* rege_dfa.c */, F96D3ED308F272A7004A47F5 /* regerror.c */, F96D3ED408F272A7004A47F5 /* regerrs.h */, F96D3ED508F272A7004A47F5 /* regex.h */, F96D3ED608F272A7004A47F5 /* regexec.c */, F96D3ED708F272A7004A47F5 /* regfree.c */, F96D3ED808F272A7004A47F5 /* regfronts.c */, F96D3ED908F272A7004A47F5 /* regguts.h */, F96D3EDA08F272A7004A47F5 /* tcl.decls */, F96D3EDB08F272A7004A47F5 /* tcl.h */, F96D3EDC08F272A7004A47F5 /* tclAlloc.c */, F96D3EDD08F272A7004A47F5 /* tclAsync.c */, F96D3EDE08F272A7004A47F5 /* tclBasic.c */, F96D3EDF08F272A7004A47F5 /* tclBinary.c */, F96D3EE008F272A7004A47F5 /* tclCkalloc.c */, F96D3EE108F272A7004A47F5 /* tclClock.c */, F96D3EE208F272A7004A47F5 /* tclCmdAH.c */, F96D3EE308F272A7004A47F5 /* tclCmdIL.c */, F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */, F96D3EE508F272A7004A47F5 /* tclCompCmds.c */, F96D3EE608F272A7004A47F5 /* tclCompExpr.c */, F96D3EE708F272A7004A47F5 /* tclCompile.c */, F96D3EE808F272A7004A47F5 /* tclCompile.h */, F96D3EE908F272A7004A47F5 /* tclConfig.c */, F96D3EEA08F272A7004A47F5 /* tclDate.c */, F96D3EEB08F272A7004A47F5 /* tclDecls.h */, F96D3EEC08F272A7004A47F5 /* tclDictObj.c */, F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */, F96D3EED08F272A7004A47F5 /* tclEncoding.c */, F96D3EEE08F272A7004A47F5 /* tclEnv.c */, F96D3EEF08F272A7004A47F5 /* tclEvent.c */, F96D3EF008F272A7004A47F5 /* tclExecute.c */, F96D3EF108F272A7004A47F5 /* tclFCmd.c */, F96D3EF208F272A7004A47F5 /* tclFileName.c */, F96D3EF308F272A7004A47F5 /* tclFileSystem.h */, F96D3EF408F272A7004A47F5 /* tclGet.c */, F96D3EF508F272A7004A47F5 /* tclGetDate.y */, F96D3EF608F272A7004A47F5 /* tclHash.c */, F96D3EF708F272A7004A47F5 /* tclHistory.c */, F96D3EF808F272A7004A47F5 /* tclIndexObj.c */, F96D3EF908F272A7004A47F5 /* tclInt.decls */, F96D3EFA08F272A7004A47F5 /* tclInt.h */, F96D3EFB08F272A7004A47F5 /* tclIntDecls.h */, F96D3EFC08F272A7004A47F5 /* tclInterp.c */, F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */, F96D3EFE08F272A7004A47F5 /* tclIO.c */, F96D3EFF08F272A7004A47F5 /* tclIO.h */, F96D3F0008F272A7004A47F5 /* tclIOCmd.c */, F96D3F0108F272A7004A47F5 /* tclIOGT.c */, F96D3F0208F272A7004A47F5 /* tclIORChan.c */, F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */, F96D3F0308F272A7004A47F5 /* tclIOSock.c */, F96D3F0408F272A7004A47F5 /* tclIOUtil.c */, F96D3F0508F272A7004A47F5 /* tclLink.c */, F96D3F0608F272A7004A47F5 /* tclListObj.c */, F96D3F0708F272A7004A47F5 /* tclLiteral.c */, F96D3F0808F272A7004A47F5 /* tclLoad.c */, F96D3F0908F272A7004A47F5 /* tclLoadNone.c */, F96D3F0A08F272A7004A47F5 /* tclMain.c */, F96D3F0B08F272A7004A47F5 /* tclNamesp.c */, F96D3F0C08F272A7004A47F5 /* tclNotify.c */, F96D3F0D08F272A7004A47F5 /* tclObj.c */, F93599B20DF1F75400E04F67 /* tclOO.c */, F93599B40DF1F75900E04F67 /* tclOO.decls */, F93599B50DF1F75D00E04F67 /* tclOO.h */, F93599B60DF1F76100E04F67 /* tclOOBasic.c */, F93599B80DF1F76600E04F67 /* tclOOCall.c */, F93599BA0DF1F76A00E04F67 /* tclOODecls.h */, F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */, F93599BD0DF1F77400E04F67 /* tclOOInfo.c */, F93599BF0DF1F77900E04F67 /* tclOOInt.h */, F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, F96D3F1208F272A7004A47F5 /* tclPipe.c */, F96D3F1308F272A7004A47F5 /* tclPkg.c */, F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */, F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */, F96D3F1608F272A7004A47F5 /* tclPort.h */, F96D3F1708F272A7004A47F5 /* tclPosixStr.c */, F96D3F1808F272A7004A47F5 /* tclPreserve.c */, F96D3F1908F272A7004A47F5 /* tclProc.c */, F96D3F1A08F272A7004A47F5 /* tclRegexp.c */, F96D3F1B08F272A7004A47F5 /* tclRegexp.h */, F96D3F1C08F272A7004A47F5 /* tclResolve.c */, F96D3F1D08F272A7004A47F5 /* tclResult.c */, F96D3F1E08F272A7004A47F5 /* tclScan.c */, F96D3F1F08F272A7004A47F5 /* tclStringObj.c */, F96D3F2408F272A7004A47F5 /* tclStrToD.c */, F96D3F2508F272A7004A47F5 /* tclStubInit.c */, F96D3F2608F272A7004A47F5 /* tclStubLib.c */, F96D3F2708F272A7004A47F5 /* tclTest.c */, F96D3F2808F272A7004A47F5 /* tclTestObj.c */, F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */, F96D3F2A08F272A7004A47F5 /* tclThread.c */, F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */, F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */, F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */, F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */, F96D3F2F08F272A7004A47F5 /* tclTimer.c */, F9903CAF094FAADA004613E9 /* tclTomMath.decls */, F96D3F3008F272A7004A47F5 /* tclTomMath.h */, F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */, F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */, F96D3F3208F272A7004A47F5 /* tclTrace.c */, F96D3F3308F272A7004A47F5 /* tclUniData.c */, F96D3F3408F272A7004A47F5 /* tclUtf.c */, F96D3F3508F272A7004A47F5 /* tclUtil.c */, F96D3F3608F272A7004A47F5 /* tclVar.c */, F96437C90EF0D4B2003F468E /* tclZlib.c */, F96D3F3708F272A7004A47F5 /* tommath.h */, ); path = generic; sourceTree = ""; }; F96D3F3808F272A7004A47F5 /* library */ = { isa = PBXGroup; children = ( F96D3F3908F272A8004A47F5 /* auto.tcl */, F96D3F3A08F272A8004A47F5 /* clock.tcl */, F96D3F3B08F272A8004A47F5 /* dde */, F96D3F8C08F272A8004A47F5 /* history.tcl */, F96D3F8D08F272A8004A47F5 /* http */, F96D3F9008F272A8004A47F5 /* http1.0 */, F96D3F9308F272A8004A47F5 /* init.tcl */, F96D3F9408F272A8004A47F5 /* msgcat */, F96D401708F272AA004A47F5 /* opt */, F96D401A08F272AA004A47F5 /* package.tcl */, F96D401B08F272AA004A47F5 /* parray.tcl */, F9ECB1110B26521500A28025 /* platform */, F96D401C08F272AA004A47F5 /* reg */, F96D401E08F272AA004A47F5 /* safe.tcl */, F96D401F08F272AA004A47F5 /* tclIndex */, F96D402008F272AA004A47F5 /* tcltest */, F96D402308F272AA004A47F5 /* tm.tcl */, F96D425B08F272B2004A47F5 /* word.tcl */, ); path = library; sourceTree = ""; }; F96D3F3B08F272A8004A47F5 /* dde */ = { isa = PBXGroup; children = ( F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */, ); path = dde; sourceTree = ""; }; F96D3F8D08F272A8004A47F5 /* http */ = { isa = PBXGroup; children = ( F96D3F8E08F272A8004A47F5 /* http.tcl */, F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */, ); path = http; sourceTree = ""; }; F96D3F9008F272A8004A47F5 /* http1.0 */ = { isa = PBXGroup; children = ( F96D3F9108F272A8004A47F5 /* http.tcl */, F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */, ); path = http1.0; sourceTree = ""; }; F96D3F9408F272A8004A47F5 /* msgcat */ = { isa = PBXGroup; children = ( F96D3F9508F272A8004A47F5 /* msgcat.tcl */, F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */, ); path = msgcat; sourceTree = ""; }; F96D401708F272AA004A47F5 /* opt */ = { isa = PBXGroup; children = ( F96D401808F272AA004A47F5 /* optparse.tcl */, F96D401908F272AA004A47F5 /* pkgIndex.tcl */, ); path = opt; sourceTree = ""; }; F96D401C08F272AA004A47F5 /* reg */ = { isa = PBXGroup; children = ( F96D401D08F272AA004A47F5 /* pkgIndex.tcl */, ); path = reg; sourceTree = ""; }; F96D402008F272AA004A47F5 /* tcltest */ = { isa = PBXGroup; children = ( F96D402108F272AA004A47F5 /* pkgIndex.tcl */, F96D402208F272AA004A47F5 /* tcltest.tcl */, ); path = tcltest; sourceTree = ""; }; F96D425C08F272B2004A47F5 /* libtommath */ = { isa = PBXGroup; children = ( F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */, F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */, F96D426908F272B3004A47F5 /* bn_mp_add.c */, F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */, F96D426C08F272B3004A47F5 /* bn_mp_and.c */, F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */, F96D426E08F272B3004A47F5 /* bn_mp_clear.c */, F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */, F96D427008F272B3004A47F5 /* bn_mp_cmp.c */, F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */, F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */, F96D427408F272B3004A47F5 /* bn_mp_copy.c */, F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */, F96D427608F272B3004A47F5 /* bn_mp_div.c */, F96D427708F272B3004A47F5 /* bn_mp_div_2.c */, F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */, F96D427908F272B3004A47F5 /* bn_mp_div_3.c */, F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */, F96D427E08F272B3004A47F5 /* bn_mp_exch.c */, F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */, F96D428708F272B3004A47F5 /* bn_mp_grow.c */, F96D428808F272B3004A47F5 /* bn_mp_init.c */, F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */, F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */, F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */, F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */, F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */, F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */, F96D429508F272B3004A47F5 /* bn_mp_lshd.c */, F96D429608F272B3004A47F5 /* bn_mp_mod.c */, F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */, F96D429C08F272B3004A47F5 /* bn_mp_mul.c */, F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */, F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */, F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */, F96D42A208F272B3004A47F5 /* bn_mp_neg.c */, F96D42A308F272B3004A47F5 /* bn_mp_or.c */, F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */, F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */, F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */, F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */, F96D42BA08F272B3004A47F5 /* bn_mp_set.c */, F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */, F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */, F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */, F96D42C108F272B3004A47F5 /* bn_mp_sub.c */, F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */, F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */, F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */, F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */, F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */, F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */, F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */, F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */, F96D42D008F272B3004A47F5 /* bn_reverse.c */, F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */, F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */, F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */, F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */, F96D432908F272B4004A47F5 /* tommath_class.h */, F96D432A08F272B4004A47F5 /* tommath_superclass.h */, ); path = libtommath; sourceTree = ""; }; F96D432C08F272B4004A47F5 /* macosx */ = { isa = PBXGroup; children = ( F96D432E08F272B5004A47F5 /* configure.ac */, F96D432F08F272B5004A47F5 /* GNUmakefile */, F96D433108F272B5004A47F5 /* README */, F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */, F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */, F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */, F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */, F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */, F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */, F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */, F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */, ); path = macosx; sourceTree = ""; }; F96D434408F272B5004A47F5 /* tests */ = { isa = PBXGroup; children = ( F96D434508F272B5004A47F5 /* all.tcl */, F96D434608F272B5004A47F5 /* append.test */, F96D434708F272B5004A47F5 /* appendComp.test */, F9ECB1CA0B2652D300A28025 /* apply.test */, F96D434808F272B5004A47F5 /* assocd.test */, F96D434908F272B5004A47F5 /* async.test */, F96D434A08F272B5004A47F5 /* autoMkindex.test */, F96D434B08F272B5004A47F5 /* basic.test */, F96D434C08F272B5004A47F5 /* binary.test */, F96D434D08F272B5004A47F5 /* case.test */, F96D434E08F272B5004A47F5 /* chan.test */, F9A493240CEBF38300B78AE2 /* chanio.test */, F96D434F08F272B5004A47F5 /* clock.test */, F96D435008F272B5004A47F5 /* cmdAH.test */, F96D435108F272B5004A47F5 /* cmdIL.test */, F96D435208F272B5004A47F5 /* cmdInfo.test */, F96D435308F272B5004A47F5 /* cmdMZ.test */, F96D435408F272B5004A47F5 /* compExpr-old.test */, F96D435508F272B5004A47F5 /* compExpr.test */, F96D435608F272B5004A47F5 /* compile.test */, F96D435708F272B5004A47F5 /* concat.test */, F96D435808F272B5004A47F5 /* config.test */, F974D5770FBE7E6100BF728B /* coroutine.test */, F96D435908F272B5004A47F5 /* dcall.test */, F96D435A08F272B5004A47F5 /* dict.test */, F96D435C08F272B5004A47F5 /* dstring.test */, F96D435E08F272B5004A47F5 /* encoding.test */, F96D435F08F272B5004A47F5 /* env.test */, F96D436008F272B5004A47F5 /* error.test */, F96D436108F272B5004A47F5 /* eval.test */, F96D436208F272B5004A47F5 /* event.test */, F96D436308F272B5004A47F5 /* exec.test */, F96D436408F272B5004A47F5 /* execute.test */, F96D436508F272B5004A47F5 /* expr-old.test */, F96D436608F272B5004A47F5 /* expr.test */, F96D436708F272B6004A47F5 /* fCmd.test */, F96D436808F272B6004A47F5 /* fileName.test */, F96D436908F272B6004A47F5 /* fileSystem.test */, F96D436A08F272B6004A47F5 /* for-old.test */, F96D436B08F272B6004A47F5 /* for.test */, F96D436C08F272B6004A47F5 /* foreach.test */, F96D436D08F272B6004A47F5 /* format.test */, F96D436E08F272B6004A47F5 /* get.test */, F96D436F08F272B6004A47F5 /* history.test */, F96D437008F272B6004A47F5 /* http.test */, F974D56C0FBE7D6300BF728B /* http11.test */, F96D437108F272B6004A47F5 /* httpd */, F974D56D0FBE7D6300BF728B /* httpd11.tcl */, F96D437208F272B6004A47F5 /* httpold.test */, F96D437308F272B6004A47F5 /* if-old.test */, F96D437408F272B6004A47F5 /* if.test */, F96D437508F272B6004A47F5 /* incr-old.test */, F96D437608F272B6004A47F5 /* incr.test */, F96D437708F272B6004A47F5 /* indexObj.test */, F96D437808F272B6004A47F5 /* info.test */, F96D437908F272B6004A47F5 /* init.test */, F96D437A08F272B6004A47F5 /* interp.test */, F96D437B08F272B6004A47F5 /* io.test */, F96D437C08F272B6004A47F5 /* ioCmd.test */, F96D437D08F272B6004A47F5 /* iogt.test */, F96D437F08F272B6004A47F5 /* join.test */, F96D438008F272B6004A47F5 /* lindex.test */, F96D438108F272B6004A47F5 /* link.test */, F96D438208F272B6004A47F5 /* linsert.test */, F96D438308F272B6004A47F5 /* list.test */, F96D438408F272B6004A47F5 /* listObj.test */, F96D438508F272B6004A47F5 /* llength.test */, F96D438608F272B6004A47F5 /* load.test */, F96D438708F272B6004A47F5 /* lrange.test */, F96D438808F272B6004A47F5 /* lrepeat.test */, F96D438908F272B6004A47F5 /* lreplace.test */, F96D438A08F272B6004A47F5 /* lsearch.test */, F96D438B08F272B6004A47F5 /* lset.test */, F96D438C08F272B6004A47F5 /* lsetComp.test */, F96D438D08F272B6004A47F5 /* macOSXFCmd.test */, F95FAFF90B34F1130072E431 /* macOSXLoad.test */, F96D438E08F272B6004A47F5 /* main.test */, F9ECB1CB0B26534C00A28025 /* mathop.test */, F96D438F08F272B6004A47F5 /* misc.test */, F96D439008F272B6004A47F5 /* msgcat.test */, F96D439108F272B6004A47F5 /* namespace-old.test */, F96D439208F272B7004A47F5 /* namespace.test */, F96D439308F272B7004A47F5 /* notify.test */, F91DC23C0E44C51B002CB8D1 /* nre.test */, F96D439408F272B7004A47F5 /* obj.test */, F93599C80DF1F81900E04F67 /* oo.test */, F96D439508F272B7004A47F5 /* opt.test */, F96D439608F272B7004A47F5 /* package.test */, F96D439708F272B7004A47F5 /* parse.test */, F96D439808F272B7004A47F5 /* parseExpr.test */, F96D439908F272B7004A47F5 /* parseOld.test */, F96D439A08F272B7004A47F5 /* pid.test */, F96D439B08F272B7004A47F5 /* pkg.test */, F96D439C08F272B7004A47F5 /* pkgMkIndex.test */, F96D439D08F272B7004A47F5 /* platform.test */, F96D439E08F272B7004A47F5 /* proc-old.test */, F96D439F08F272B7004A47F5 /* proc.test */, F96D43A008F272B7004A47F5 /* pwd.test */, F96D43A108F272B7004A47F5 /* README */, F96D43A208F272B7004A47F5 /* reg.test */, F96D43A308F272B7004A47F5 /* regexp.test */, F96D43A408F272B7004A47F5 /* regexpComp.test */, F96D43A508F272B7004A47F5 /* registry.test */, F96D43A608F272B7004A47F5 /* remote.tcl */, F96D43A708F272B7004A47F5 /* rename.test */, F96D43A808F272B7004A47F5 /* result.test */, F96D43A908F272B7004A47F5 /* safe.test */, F96D43AA08F272B7004A47F5 /* scan.test */, F96D43AB08F272B7004A47F5 /* security.test */, F96D43AC08F272B7004A47F5 /* set-old.test */, F96D43AD08F272B7004A47F5 /* set.test */, F96D43AE08F272B7004A47F5 /* socket.test */, F96D43AF08F272B7004A47F5 /* source.test */, F96D43B008F272B7004A47F5 /* split.test */, F96D43B108F272B7004A47F5 /* stack.test */, F96D43B208F272B7004A47F5 /* string.test */, F96D43B308F272B7004A47F5 /* stringComp.test */, F96D43B408F272B7004A47F5 /* stringObj.test */, F96D43B508F272B7004A47F5 /* subst.test */, F96D43B608F272B7004A47F5 /* switch.test */, F974D5780FBE7E6100BF728B /* tailcall.test */, F96D43B708F272B7004A47F5 /* tcltest.test */, F96D43B808F272B7004A47F5 /* thread.test */, F96D43B908F272B7004A47F5 /* timer.test */, F96D43BA08F272B7004A47F5 /* tm.test */, F96D43BB08F272B7004A47F5 /* trace.test */, F96D43BC08F272B7004A47F5 /* unixFCmd.test */, F96D43BD08F272B7004A47F5 /* unixFile.test */, F96D43BE08F272B7004A47F5 /* unixInit.test */, F96D43BF08F272B7004A47F5 /* unixNotfy.test */, F96D43C008F272B7004A47F5 /* unknown.test */, F96D43C108F272B7004A47F5 /* unload.test */, F96D43C208F272B7004A47F5 /* uplevel.test */, F96D43C308F272B7004A47F5 /* upvar.test */, F96D43C408F272B7004A47F5 /* utf.test */, F96D43C508F272B7004A47F5 /* util.test */, F96D43C608F272B7004A47F5 /* var.test */, F96D43C708F272B7004A47F5 /* while-old.test */, F96D43C808F272B7004A47F5 /* while.test */, F96D43C908F272B7004A47F5 /* winConsole.test */, F96D43CA08F272B7004A47F5 /* winDde.test */, F96D43CB08F272B7004A47F5 /* winFCmd.test */, F96D43CC08F272B7004A47F5 /* winFile.test */, F96D43CD08F272B7004A47F5 /* winNotify.test */, F96D43CE08F272B7004A47F5 /* winPipe.test */, F96D43CF08F272B7004A47F5 /* winTime.test */, F915432A0EF201CF0032D1E8 /* zlib.test */, ); path = tests; sourceTree = ""; }; F96D43D008F272B8004A47F5 /* tools */ = { isa = PBXGroup; children = ( F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D43D208F272B8004A47F5 /* configure */, F96D43D308F272B8004A47F5 /* configure.in */, F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, F96D442808F272B8004A47F5 /* installData.tcl */, F96D442908F272B8004A47F5 /* loadICU.tcl */, F96D442A08F272B8004A47F5 /* Makefile.in */, F96D442B08F272B8004A47F5 /* makeTestCases.tcl */, F96D442C08F272B8004A47F5 /* man2help.tcl */, F96D442D08F272B8004A47F5 /* man2help2.tcl */, F96D442E08F272B8004A47F5 /* man2html.tcl */, F96D442F08F272B8004A47F5 /* man2html1.tcl */, F96D443008F272B8004A47F5 /* man2html2.tcl */, F96D443108F272B8004A47F5 /* man2tcl.c */, F96D443208F272B8004A47F5 /* README */, F96D443308F272B8004A47F5 /* regexpTestLib.tcl */, F96D443508F272B8004A47F5 /* tcl.hpj.in */, F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */, F96D443A08F272B9004A47F5 /* tclZIC.tcl */, F92D7F100DE777240033A13A /* tsdPerf.tcl */, F96D443B08F272B9004A47F5 /* uniClass.tcl */, F96D443C08F272B9004A47F5 /* uniParse.tcl */, ); path = tools; sourceTree = ""; }; F96D443E08F272B9004A47F5 /* unix */ = { isa = PBXGroup; children = ( F96D444008F272B9004A47F5 /* aclocal.m4 */, F96D444108F272B9004A47F5 /* configure */, F96D444208F272B9004A47F5 /* configure.in */, F96D444308F272B9004A47F5 /* dltest */, F96D444D08F272B9004A47F5 /* install-sh */, F96D444E08F272B9004A47F5 /* installManPage */, F96D444F08F272B9004A47F5 /* ldAix */, F96D445008F272B9004A47F5 /* Makefile.in */, F96D445208F272B9004A47F5 /* README */, F96D445308F272B9004A47F5 /* tcl.m4 */, F974D5790FBE7E9C00BF728B /* tcl.pc.in */, F96D445408F272B9004A47F5 /* tcl.spec */, F96D445508F272B9004A47F5 /* tclAppInit.c */, F96D445608F272B9004A47F5 /* tclConfig.h.in */, F96D445708F272B9004A47F5 /* tclConfig.sh.in */, F96D445808F272B9004A47F5 /* tclLoadAix.c */, F96D445908F272B9004A47F5 /* tclLoadDl.c */, F96D445B08F272B9004A47F5 /* tclLoadDyld.c */, F96D445C08F272B9004A47F5 /* tclLoadNext.c */, F96D445D08F272B9004A47F5 /* tclLoadOSF.c */, F96D445E08F272B9004A47F5 /* tclLoadShl.c */, F96D445F08F272B9004A47F5 /* tclUnixChan.c */, F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */, F96D446008F272B9004A47F5 /* tclUnixEvent.c */, F96D446108F272B9004A47F5 /* tclUnixFCmd.c */, F96D446208F272B9004A47F5 /* tclUnixFile.c */, F96D446308F272B9004A47F5 /* tclUnixInit.c */, F96D446408F272B9004A47F5 /* tclUnixNotfy.c */, F96D446508F272B9004A47F5 /* tclUnixPipe.c */, F96D446608F272B9004A47F5 /* tclUnixPort.h */, F96D446708F272B9004A47F5 /* tclUnixSock.c */, F96D446808F272B9004A47F5 /* tclUnixTest.c */, F96D446908F272B9004A47F5 /* tclUnixThrd.c */, F96D446B08F272B9004A47F5 /* tclUnixTime.c */, F96D446C08F272B9004A47F5 /* tclXtNotify.c */, F96D446D08F272B9004A47F5 /* tclXtTest.c */, ); path = unix; sourceTree = ""; }; F96D444308F272B9004A47F5 /* dltest */ = { isa = PBXGroup; children = ( F96D444408F272B9004A47F5 /* Makefile.in */, F96D444508F272B9004A47F5 /* pkga.c */, F96D444608F272B9004A47F5 /* pkgb.c */, F96D444708F272B9004A47F5 /* pkgc.c */, F96D444808F272B9004A47F5 /* pkgd.c */, F96D444908F272B9004A47F5 /* pkge.c */, F96D444B08F272B9004A47F5 /* pkgua.c */, F96D444C08F272B9004A47F5 /* README */, ); path = dltest; sourceTree = ""; }; F96D446E08F272B9004A47F5 /* win */ = { isa = PBXGroup; children = ( F96D447008F272BA004A47F5 /* aclocal.m4 */, F96D447108F272BA004A47F5 /* buildall.vc.bat */, F96D447208F272BA004A47F5 /* cat.c */, F96D447308F272BA004A47F5 /* coffbase.txt */, F96D447408F272BA004A47F5 /* configure */, F96D447508F272BA004A47F5 /* configure.in */, F96D447708F272BA004A47F5 /* Makefile.in */, F96D447808F272BA004A47F5 /* makefile.vc */, F96D447908F272BA004A47F5 /* nmakehlp.c */, F96D447A08F272BA004A47F5 /* README */, F96D447C08F272BA004A47F5 /* rules.vc */, F96D447D08F272BA004A47F5 /* stub16.c */, F96D447E08F272BA004A47F5 /* tcl.dsp */, F96D447F08F272BA004A47F5 /* tcl.dsw */, F96D448008F272BA004A47F5 /* tcl.hpj.in */, F96D448108F272BA004A47F5 /* tcl.m4 */, F96D448208F272BA004A47F5 /* tcl.rc */, F96D448308F272BA004A47F5 /* tclAppInit.c */, F96D448408F272BA004A47F5 /* tclConfig.sh.in */, F96D448608F272BA004A47F5 /* tclsh.rc */, F96D448708F272BA004A47F5 /* tclWin32Dll.c */, F96D448808F272BA004A47F5 /* tclWinChan.c */, F96D448908F272BA004A47F5 /* tclWinConsole.c */, F96D448A08F272BA004A47F5 /* tclWinDde.c */, F96D448B08F272BA004A47F5 /* tclWinError.c */, F96D448C08F272BA004A47F5 /* tclWinFCmd.c */, F96D448D08F272BA004A47F5 /* tclWinFile.c */, F96D448E08F272BA004A47F5 /* tclWinInit.c */, F96D448F08F272BA004A47F5 /* tclWinInt.h */, F96D449008F272BA004A47F5 /* tclWinLoad.c */, F96D449108F272BA004A47F5 /* tclWinNotify.c */, F96D449208F272BA004A47F5 /* tclWinPipe.c */, F96D449308F272BA004A47F5 /* tclWinPort.h */, F96D449408F272BA004A47F5 /* tclWinReg.c */, F96D449508F272BA004A47F5 /* tclWinSerial.c */, F96D449608F272BA004A47F5 /* tclWinSock.c */, F96D449708F272BA004A47F5 /* tclWinTest.c */, F96D449808F272BA004A47F5 /* tclWinThrd.c */, F96D449A08F272BA004A47F5 /* tclWinTime.c */, ); path = win; sourceTree = ""; }; F9ECB1110B26521500A28025 /* platform */ = { isa = PBXGroup; children = ( F9ECB1120B26521500A28025 /* pkgIndex.tcl */, F9ECB1130B26521500A28025 /* platform.tcl */, F9ECB1140B26521500A28025 /* shell.tcl */, ); path = platform; sourceTree = ""; }; /* End PBXGroup section */ /* Begin PBXNativeTarget section */ 8DD76FA90486AB0100D96B5E /* tcltest */ = { isa = PBXNativeTarget; buildConfigurationList = F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */; buildPhases = ( F9A5C5F508F651A2008AE941 /* Configure Tcl */, 8DD76FAB0486AB0100D96B5E /* Sources */, 8DD76FAD0486AB0100D96B5E /* Frameworks */, F95FA74C0B32CE190072E431 /* Build dltest */, ); buildRules = ( ); dependencies = ( ); name = tcltest; productInstallPath = "$(BINDIR)"; productName = tcltest; productReference = 8DD76FB20486AB0100D96B5E /* tcltest */; productType = "com.apple.product-type.tool"; }; F97258A50A86873C00096C78 /* tests */ = { isa = PBXNativeTarget; buildConfigurationList = F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */; buildPhases = ( F97258A40A86873C00096C78 /* Run Testsuite */, ); buildRules = ( ); dependencies = ( F97258D30A868C6F00096C78 /* PBXTargetDependency */, ); name = tests; productName = tests; productType = "com.apple.product-type.bundle"; }; F9E61D16090A3E94002B3151 /* Tcl */ = { isa = PBXNativeTarget; buildConfigurationList = F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */; buildPhases = ( F97AF02F0B665DA900310EA2 /* Build Tcl */, ); buildRules = ( ); dependencies = ( ); name = Tcl; productName = tclsh; productReference = F9A3084B08F2D4CE00BAE1AB /* tclsh */; productType = "com.apple.product-type.tool"; }; /* End PBXNativeTarget section */ /* Begin PBXProject section */ 08FB7793FE84155DC02AAC07 /* Project object */ = { isa = PBXProject; attributes = { BuildIndependentTargetsInParallel = YES; }; buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */; compatibilityVersion = "Xcode 3.2"; hasScannedForEncodings = 1; mainGroup = 08FB7794FE84155DC02AAC07 /* Tcl */; projectDirPath = ""; projectRoot = ..; targets = ( F9E61D16090A3E94002B3151 /* Tcl */, 8DD76FA90486AB0100D96B5E /* tcltest */, F97258A50A86873C00096C78 /* tests */, ); }; /* End PBXProject section */ /* Begin PBXShellScriptBuildPhase section */ F95FA74C0B32CE190072E431 /* Build dltest */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( ); inputPaths = ( "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh", "$(TCL_SRCROOT)/generic/tclStubLib.c", "$(TCL_SRCROOT)/unix/dltest/pkga.c", "$(TCL_SRCROOT)/unix/dltest/pkgb.c", "$(TCL_SRCROOT)/unix/dltest/pkgc.c", "$(TCL_SRCROOT)/unix/dltest/pkgd.c", "$(TCL_SRCROOT)/unix/dltest/pkge.c", "$(TCL_SRCROOT)/unix/dltest/pkgua.c", ); name = "Build dltest"; outputPaths = ( "$(DERIVED_FILE_DIR)/tcl/dltest.marker", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; shellScript = "## dltest build script phase\n\nrm -f \"${DERIVED_FILE_DIR}/tcl/dltest.marker\"\nmake -C \"${DERIVED_FILE_DIR}/tcl\" dltest.marker\nln -fsh \"${DERIVED_FILE_DIR}/tcl/dltest\" \"${CONFIGURATION_BUILD_DIR}\"\n"; showEnvVarsInLog = 0; }; F97258A40A86873C00096C78 /* Run Testsuite */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( ); inputPaths = ( ); name = "Run Testsuite"; outputPaths = ( ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.5\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi"; showEnvVarsInLog = 0; }; F97AF02F0B665DA900310EA2 /* Build Tcl */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( ); inputPaths = ( "${TARGET_TEMP_DIR}/.none", ); name = "Build Tcl"; outputPaths = ( "${TARGET_BUILD_DIR}/${EXECUTABLE_NAME}", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\nexport CC=$(xcrun -find ${GCC} || echo ${GCC}); export LD=${CC}\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n"; showEnvVarsInLog = 0; }; F9A5C5F508F651A2008AE941 /* Configure Tcl */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( ); inputPaths = ( "$(TCL_SRCROOT)/macosx/configure.ac", "$(TCL_SRCROOT)/unix/configure.in", "$(TCL_SRCROOT)/unix/tcl.m4", "$(TCL_SRCROOT)/unix/aclocal.m4", "$(TCL_SRCROOT)/unix/tclConfig.sh.in", "$(TCL_SRCROOT)/unix/Makefile.in", "$(TCL_SRCROOT)/unix/dltest/Makefile.in", ); name = "Configure Tcl"; outputPaths = ( "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; showEnvVarsInLog = 0; }; /* End PBXShellScriptBuildPhase section */ /* Begin PBXSourcesBuildPhase section */ 8DD76FAB0486AB0100D96B5E /* Sources */ = { isa = PBXSourcesBuildPhase; buildActionMask = 2147483647; files = ( F96D456F08F272BB004A47F5 /* regcomp.c in Sources */, F96D457208F272BB004A47F5 /* regerror.c in Sources */, F96D457508F272BB004A47F5 /* regexec.c in Sources */, F96D457608F272BB004A47F5 /* regfree.c in Sources */, F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */, F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */, F96D457D08F272BB004A47F5 /* tclBasic.c in Sources */, F96D457E08F272BC004A47F5 /* tclBinary.c in Sources */, F96D457F08F272BC004A47F5 /* tclCkalloc.c in Sources */, F96D458008F272BC004A47F5 /* tclClock.c in Sources */, F96D458108F272BC004A47F5 /* tclCmdAH.c in Sources */, F96D458208F272BC004A47F5 /* tclCmdIL.c in Sources */, F96D458308F272BC004A47F5 /* tclCmdMZ.c in Sources */, F96D458408F272BC004A47F5 /* tclCompCmds.c in Sources */, F96D458508F272BC004A47F5 /* tclCompExpr.c in Sources */, F96D458608F272BC004A47F5 /* tclCompile.c in Sources */, F96D458808F272BC004A47F5 /* tclConfig.c in Sources */, F96D458908F272BC004A47F5 /* tclDate.c in Sources */, F96D458B08F272BC004A47F5 /* tclDictObj.c in Sources */, F96D458C08F272BC004A47F5 /* tclEncoding.c in Sources */, F96D458D08F272BC004A47F5 /* tclEnv.c in Sources */, F96D458E08F272BC004A47F5 /* tclEvent.c in Sources */, F96D458F08F272BC004A47F5 /* tclExecute.c in Sources */, F96D459008F272BC004A47F5 /* tclFCmd.c in Sources */, F96D459108F272BC004A47F5 /* tclFileName.c in Sources */, F96D459308F272BC004A47F5 /* tclGet.c in Sources */, F96D459508F272BC004A47F5 /* tclHash.c in Sources */, F96D459608F272BC004A47F5 /* tclHistory.c in Sources */, F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */, F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */, F96D459D08F272BC004A47F5 /* tclIO.c in Sources */, F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */, F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */, F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */, F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */, F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */, F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */, F96D45A408F272BC004A47F5 /* tclLink.c in Sources */, F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */, F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */, F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */, F96D45A908F272BC004A47F5 /* tclMain.c in Sources */, F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */, F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */, F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */, F93599B30DF1F75400E04F67 /* tclOO.c in Sources */, F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */, F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */, F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */, F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */, F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */, F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */, F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */, F96D45B708F272BC004A47F5 /* tclPreserve.c in Sources */, F96D45B808F272BC004A47F5 /* tclProc.c in Sources */, F96D45B908F272BC004A47F5 /* tclRegexp.c in Sources */, F96D45BB08F272BC004A47F5 /* tclResolve.c in Sources */, F96D45BC08F272BC004A47F5 /* tclResult.c in Sources */, F96D45BD08F272BC004A47F5 /* tclScan.c in Sources */, F96D45BE08F272BC004A47F5 /* tclStringObj.c in Sources */, F96D45C308F272BC004A47F5 /* tclStrToD.c in Sources */, F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */, F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */, F96D45C608F272BC004A47F5 /* tclTest.c in Sources */, F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */, F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */, F96D45C908F272BC004A47F5 /* tclThread.c in Sources */, F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */, F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */, F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */, F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */, F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */, F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */, F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */, F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */, F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */, F96D45D508F272BC004A47F5 /* tclVar.c in Sources */, F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */, F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */, F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */, F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */, F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */, F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */, F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */, F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */, F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */, F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */, F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */, F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */, F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */, F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */, F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */, F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */, F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */, F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */, F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */, F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */, F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */, F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */, F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */, F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */, F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */, F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */, F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */, F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */, F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */, F96D491108F272C3004A47F5 /* bn_mp_karatsuba_sqr.c in Sources */, F96D491308F272C3004A47F5 /* bn_mp_lshd.c in Sources */, F96D491408F272C3004A47F5 /* bn_mp_mod.c in Sources */, F96D491508F272C3004A47F5 /* bn_mp_mod_2d.c in Sources */, F96D491A08F272C3004A47F5 /* bn_mp_mul.c in Sources */, F96D491B08F272C3004A47F5 /* bn_mp_mul_2.c in Sources */, F96D491C08F272C3004A47F5 /* bn_mp_mul_2d.c in Sources */, F96D491D08F272C3004A47F5 /* bn_mp_mul_d.c in Sources */, F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */, F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */, F96D492908F272C3004A47F5 /* bn_mp_radix_size.c in Sources */, F96D492A08F272C3004A47F5 /* bn_mp_radix_smap.c in Sources */, F96D492C08F272C3004A47F5 /* bn_mp_read_radix.c in Sources */, F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */, F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */, F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */, F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */, F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */, F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */, F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */, F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */, F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */, F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */, F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */, F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */, F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */, F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */, F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */, F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */, F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */, F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */, F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */, F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */, F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */, F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */, F90509300913A72400327603 /* tclAppInit.c in Sources */, F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */, F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */, F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */, F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */, F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */, F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */, F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */, F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */, F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */, F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */, F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */, F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */, F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */, F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */, ); runOnlyForDeploymentPostprocessing = 0; }; /* End PBXSourcesBuildPhase section */ /* Begin PBXTargetDependency section */ F97258D30A868C6F00096C78 /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = 8DD76FA90486AB0100D96B5E /* tcltest */; targetProxy = F97258D20A868C6F00096C78 /* PBXContainerItemProxy */; }; /* End PBXTargetDependency section */ /* Begin XCBuildConfiguration section */ F91BCC4F093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = ReleaseUniversal; }; F91BCC50093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = ReleaseUniversal; }; F91BCC51093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; }; name = ReleaseUniversal; }; F93084370BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugMemCompile; }; F93084380BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugMemCompile; }; F93084390BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugMemCompile; }; F930843A0BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --enable-symbols=all"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugMemCompile; }; F9359B250DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_GENERATE_TEST_COVERAGE_FILES = YES; GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; OTHER_LDFLAGS = ( "$(OTHER_LDFLAGS)", "-lgcov", ); PREBINDING = NO; }; name = DebugGCov; }; F9359B260DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugGCov; }; F9359B270DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugGCov; }; F9359B280DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugGCov; }; F95CC8AC09158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = Debug; }; F95CC8AD09158F3100EA5ACE /* Release */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = Release; }; F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugNoFixAndContinue; }; F95CC8B109158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; }; name = Debug; }; F95CC8B209158F3100EA5ACE /* Release */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = Release; }; F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugNoFixAndContinue; }; F95CC8B609158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = Debug; }; F95CC8B709158F3100EA5ACE /* Release */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = Release; }; F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugNoFixAndContinue; }; F97258A90A86873D00096C78 /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = Debug; }; F97258AA0A86873D00096C78 /* Release */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = Release; }; F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugNoFixAndContinue; }; F97258AC0A86873D00096C78 /* ReleaseUniversal */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = ReleaseUniversal; }; F97AED1B0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = Debug64bit; }; F97AED1C0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = Debug64bit; }; F97AED1D0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = Debug64bit; }; F97AED1E0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = "$(NATIVE_ARCH_64_BIT)"; CONFIGURE_ARGS = "--enable-64bit $(CONFIGURE_ARGS)"; CPPFLAGS = "-arch $(NATIVE_ARCH_64_BIT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; }; name = Debug64bit; }; F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugNoCF; }; F98751300DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugNoCF; }; F98751310DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugNoCF; }; F98751320DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugNoCF; }; F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugNoCFUnthreaded; }; F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugNoCFUnthreaded; }; F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugNoCFUnthreaded; }; F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugNoCFUnthreaded; }; F9988AB10D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = "Debug gcc40"; }; F9988AB20D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "Debug gcc40"; }; F9988AB30D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; }; name = "Debug gcc40"; }; F9988AB40D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "Debug gcc40"; }; F9988AB50D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC = "llvm-gcc"; GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = "Debug llvm-gcc"; }; F9988AB60D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "Debug llvm-gcc"; }; F9988AB70D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; }; name = "Debug llvm-gcc"; }; F9988AB80D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "Debug llvm-gcc"; }; F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; }; name = "ReleaseUniversal gcc40"; }; F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "ReleaseUniversal gcc40"; }; F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = "ReleaseUniversal gcc40"; }; F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "ReleaseUniversal gcc40"; }; F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; GCC = "llvm-gcc"; GCC_OPTIMIZATION_LEVEL = 4; "GCC_OPTIMIZATION_LEVEL[arch=ppc]" = s; GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; }; name = "ReleaseUniversal llvm-gcc"; }; F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "ReleaseUniversal llvm-gcc"; }; F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = "ReleaseUniversal llvm-gcc"; }; F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "ReleaseUniversal llvm-gcc"; }; F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugUnthreaded; }; F99EE73C0BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = DebugLeaks; }; F99EE73D0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugUnthreaded; }; F99EE73E0BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = DebugLeaks; }; F99EE73F0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugUnthreaded; }; F99EE7400BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = DebugLeaks; }; F99EE7410BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = DebugUnthreaded; }; F99EE7420BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_PREPROCESSOR_DEFINITIONS = ( PURIFY, "$(GCC_PREPROCESSOR_DEFINITIONS)", ); MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; RUN_CLANG_STATIC_ANALYZER = YES; }; name = DebugLeaks; }; F9A9D1EF0FC77787002A2BE3 /* Debug clang */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC = clang; GCC_VERSION = com.apple.compilers.llvm.clang.1_0; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = "Debug clang"; }; F9A9D1F00FC77787002A2BE3 /* Debug clang */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "Debug clang"; }; F9A9D1F10FC77787002A2BE3 /* Debug clang */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; }; name = "Debug clang"; }; F9A9D1F20FC77787002A2BE3 /* Debug clang */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "Debug clang"; }; F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", "$(NATIVE_ARCH_32_BIT)", ); CFLAGS = "-arch i386 -arch x86_64 $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; GCC = clang; GCC_OPTIMIZATION_LEVEL = 4; GCC_VERSION = com.apple.compilers.llvm.clang.1_0; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; }; name = "ReleaseUniversal clang"; }; F9A9D1F40FC77799002A2BE3 /* ReleaseUniversal clang */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = "ReleaseUniversal clang"; }; F9A9D1F50FC77799002A2BE3 /* ReleaseUniversal clang */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = "ReleaseUniversal clang"; }; F9A9D1F60FC77799002A2BE3 /* ReleaseUniversal clang */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = "ReleaseUniversal clang"; }; F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; SKIP_INSTALL = NO; }; name = ReleaseUniversal10.5SDK; }; F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tcltest; }; name = ReleaseUniversal10.5SDK; }; F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; buildSettings = { CODE_SIGN_IDENTITY = ""; PRODUCT_NAME = tests; TCLTEST_OPTIONS = ""; TCL_LIBRARY = "$(TCL_SRCROOT)/library"; TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; }; name = ReleaseUniversal10.5SDK; }; F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; SDKROOT = macosx10.5; }; name = ReleaseUniversal10.5SDK; }; /* End XCBuildConfiguration section */ /* Begin XCConfigurationList section */ F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */ = { isa = XCConfigurationList; buildConfigurations = ( F95CC8AC09158F3100EA5ACE /* Debug */, F9A9D1F00FC77787002A2BE3 /* Debug clang */, F9988AB60D814C7500B6B03B /* Debug llvm-gcc */, F9988AB20D814C6500B6B03B /* Debug gcc40 */, F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE73B0BE835310060D4AF /* DebugUnthreaded */, F98751300DE7B57E00B1C9EC /* DebugNoCF */, F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084370BB93D2800CD0B9E /* DebugMemCompile */, F99EE73C0BE835310060D4AF /* DebugLeaks */, F9359B260DF212DA00E04F67 /* DebugGCov */, F97AED1B0B660B2100310EA2 /* Debug64bit */, F95CC8AD09158F3100EA5ACE /* Release */, F91BCC4F093152310042A6BF /* ReleaseUniversal */, F9A9D1F40FC77799002A2BE3 /* ReleaseUniversal clang */, F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */, F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */ = { isa = XCConfigurationList; buildConfigurations = ( F95CC8B109158F3100EA5ACE /* Debug */, F9A9D1F10FC77787002A2BE3 /* Debug clang */, F9988AB70D814C7500B6B03B /* Debug llvm-gcc */, F9988AB30D814C6500B6B03B /* Debug gcc40 */, F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE73D0BE835310060D4AF /* DebugUnthreaded */, F98751310DE7B57E00B1C9EC /* DebugNoCF */, F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084380BB93D2800CD0B9E /* DebugMemCompile */, F99EE73E0BE835310060D4AF /* DebugLeaks */, F9359B270DF212DA00E04F67 /* DebugGCov */, F97AED1C0B660B2100310EA2 /* Debug64bit */, F95CC8B209158F3100EA5ACE /* Release */, F91BCC50093152310042A6BF /* ReleaseUniversal */, F9A9D1F50FC77799002A2BE3 /* ReleaseUniversal clang */, F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */, F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */ = { isa = XCConfigurationList; buildConfigurations = ( F95CC8B609158F3100EA5ACE /* Debug */, F9A9D1EF0FC77787002A2BE3 /* Debug clang */, F9988AB50D814C7500B6B03B /* Debug llvm-gcc */, F9988AB10D814C6500B6B03B /* Debug gcc40 */, F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE7410BE835310060D4AF /* DebugUnthreaded */, F987512F0DE7B57E00B1C9EC /* DebugNoCF */, F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F930843A0BB93D2800CD0B9E /* DebugMemCompile */, F99EE7420BE835310060D4AF /* DebugLeaks */, F9359B250DF212DA00E04F67 /* DebugGCov */, F97AED1E0B660B2100310EA2 /* Debug64bit */, F95CC8B709158F3100EA5ACE /* Release */, F91BCC51093152310042A6BF /* ReleaseUniversal */, F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */, F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */, F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */ = { isa = XCConfigurationList; buildConfigurations = ( F97258A90A86873D00096C78 /* Debug */, F9A9D1F20FC77787002A2BE3 /* Debug clang */, F9988AB80D814C7500B6B03B /* Debug llvm-gcc */, F9988AB40D814C6500B6B03B /* Debug gcc40 */, F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */, F99EE73F0BE835310060D4AF /* DebugUnthreaded */, F98751320DE7B57E00B1C9EC /* DebugNoCF */, F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084390BB93D2800CD0B9E /* DebugMemCompile */, F99EE7400BE835310060D4AF /* DebugLeaks */, F9359B280DF212DA00E04F67 /* DebugGCov */, F97AED1D0B660B2100310EA2 /* Debug64bit */, F97258AA0A86873D00096C78 /* Release */, F97258AC0A86873D00096C78 /* ReleaseUniversal */, F9A9D1F60FC77799002A2BE3 /* ReleaseUniversal clang */, F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */, F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; /* End XCConfigurationList section */ }; rootObject = 08FB7793FE84155DC02AAC07 /* Project object */; } tcl8.6.14/macosx/Tcl.xcodeproj/default.pbxuser0000644000175000017500000001365114554262142020716 0ustar sergeisergei// !$*UTF8*$! { 08FB7793FE84155DC02AAC07 /* Project object */ = { activeBuildConfigurationName = Debug; activeExecutable = F9E61D1C090A4282002B3151 /* tclsh */; activeTarget = F9E61D16090A3E94002B3151 /* Tcl */; codeSenseManager = F944EB9D08F798180049FDD4 /* Code sense */; executables = ( F9E61D1C090A4282002B3151 /* tclsh */, F944EB8F08F798100049FDD4 /* tcltest */, ); perUserDictionary = { com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a0b707265666572656e63657386928497960892849a9a0669734c6561668692848484084e534e756d626572008484074e5356616c7565009584012a849696008692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a09726563757273697665869284a29da496018692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a0763616e536176658692a892849a9a1250425850726f6a65637453636f70654b65798692849a9a035945538692849a9a0572656765788692849a9a065c2e286329248692849a9a07666e6d617463688692849a9a00868692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a08676c6f62616c49448692849a9a183143433045413430303433353045463930303434343130428692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f7570868686>; }; sourceControlManager = F944EB9C08F798180049FDD4 /* Source Control */; userBuildSettings = { SYMROOT = "${SRCROOT}/../../build/tcl"; TCL_SRCROOT = "${SRCROOT}/../../tcl"; }; }; 8DD76FA90486AB0100D96B5E /* tcltest */ = { activeExec = 0; executables = ( F944EB8F08F798100049FDD4 /* tcltest */, ); }; F944EB8F08F798100049FDD4 /* tcltest */ = { isa = PBXExecutable; activeArgIndices = ( NO, NO, NO, ); argumentStrings = ( "${TCL_SRCROOT}/tests/all.tcl", "-singleproc 1", "-verbose \"bet\"", ); autoAttachOnCrash = 1; breakpointsEnabled = 1; configStateDict = { "PBXLSLaunchAction-0" = { PBXLSLaunchAction = 0; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXLSRunLaunchConfig; displayName = "Executable Runner"; identifier = com.apple.Xcode.launch.runConfig; remoteHostInfo = ""; startActionInfo = ""; }; "PBXLSLaunchAction-1" = { PBXLSLaunchAction = 1; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXGDB_LaunchConfig; displayName = GDB; identifier = com.apple.Xcode.launch.GDBMI_Config; remoteHostInfo = ""; startActionInfo = ""; }; }; customDataFormattersEnabled = 1; dataTipCustomDataFormattersEnabled = 1; dataTipShowTypeColumn = 1; dataTipSortType = 0; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = ""; enableDebugStr = 0; environmentEntries = ( { active = YES; name = TCL_LIBRARY; value = "${TCL_SRCROOT}/library"; }, { active = YES; name = TCLLIBPATH; value = /Library/Tcl; }, { active = NO; name = DYLD_PRINT_LIBRARIES; }, { active = NO; name = MallocBadFreeAbort; value = 1; }, { active = NO; name = MallocLogFile; value = /tmp/malloc.log; }, { active = NO; name = MallocStackLogging; value = 1; }, { active = NO; name = MallocStackLoggingNoCompact; value = 1; }, { active = NO; name = MallocPreScribble; value = 1; }, { active = NO; name = MallocScribble; value = 1; }, ); executableSystemSymbolLevel = 0; executableUserSymbolLevel = 0; libgmallocEnabled = 0; name = tcltest; showTypeColumn = 0; sourceDirectories = ( ); }; F944EB9C08F798180049FDD4 /* Source Control */ = { isa = PBXSourceControlManager; fallbackIsa = XCSourceControlManager; isSCMEnabled = 0; repositoryNamesForRoots = { .. = ""; }; scmConfiguration = { CVSToolPath = /usr/bin/cvs; CVSUseSSH = NO; SubversionToolPath = /usr/bin/svn; repositoryNamesForRoots = { .. = ""; }; }; scmType = scm.cvs; }; F944EB9D08F798180049FDD4 /* Code sense */ = { isa = PBXCodeSenseManager; indexTemplatePath = ""; }; F97258A50A86873C00096C78 /* tests */ = { activeExec = 0; }; F9E61D16090A3E94002B3151 /* Tcl */ = { activeExec = 0; executables = ( F9E61D1C090A4282002B3151 /* tclsh */, ); }; F9E61D1C090A4282002B3151 /* tclsh */ = { isa = PBXExecutable; activeArgIndices = ( ); argumentStrings = ( ); autoAttachOnCrash = 1; breakpointsEnabled = 1; configStateDict = { "PBXLSLaunchAction-0" = { PBXLSLaunchAction = 0; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXLSRunLaunchConfig; displayName = "Executable Runner"; identifier = com.apple.Xcode.launch.runConfig; remoteHostInfo = ""; startActionInfo = ""; }; "PBXLSLaunchAction-1" = { PBXLSLaunchAction = 1; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXGDB_LaunchConfig; displayName = GDB; identifier = com.apple.Xcode.launch.GDBMI_Config; remoteHostInfo = ""; startActionInfo = ""; }; }; customDataFormattersEnabled = 1; dataTipCustomDataFormattersEnabled = 1; dataTipShowTypeColumn = 1; dataTipSortType = 0; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = _debug; enableDebugStr = 0; environmentEntries = ( { active = NO; name = DYLD_PRINT_LIBRARIES; }, ); executableSystemSymbolLevel = 0; executableUserSymbolLevel = 0; libgmallocEnabled = 0; name = tclsh; showTypeColumn = 0; sourceDirectories = ( ); }; } tcl8.6.14/tools/0000755000175000017500000000000014566153413013005 5ustar sergeisergeitcl8.6.14/tools/Makefile.in0000644000175000017500000000271314554262142015052 0ustar sergeisergei# This makefile is used to convert Tcl manual pages into various # alternate formats: # # Windows help file: 1. Build the winhelp target on Unix # 2. Build the helpfile target on Windows # # HTML: 1. Build the html target on Unix TCL = tcl@TCL_VERSION@ TK = tk@TCL_VERSION@ VER = @TCL_WIN_VERSION@ TCL_BIN_DIR = @TCL_BIN_DIR@ TCL_SOURCE = @TCL_SRC_DIR@ TK_SOURCE = $(TCL_SOURCE)/../$(TK) PRO_SOURCE = $(TCL_SOURCE)/../pro ITCL_SOURCE = $(TCL_SOURCE)/../itcl3.1.0 TCL_DOCS = $(TCL_SOURCE)/doc/*.[13n] TK_DOCS = $(TK_SOURCE)/doc/*.[13n] PRO_DOCS = \ $(PRO_SOURCE)/doc/man/procheck.1 \ $(PRO_SOURCE)/doc/man/prodebug.1 \ $(PRO_SOURCE)/doc/man/prodebug.n \ $(PRO_SOURCE)/doc/man/prolicense.1 ITCL_DOCS = \ $(ITCL_SOURCE)/itcl/doc/*.[13n] \ $(ITCL_SOURCE)/itk/doc/*.[13n] # $(ITCL_SOURCE)/iwidgets3.0.0/doc/*.[13n] COREDOCS = $(TCL_DOCS) $(TK_DOCS) #PRODOCS = $(COREDOCS) $(PRO_DOCS) $(ITCL_DOCS) PRODOCS = $(COREDOCS) $(PRO_DOCS) TCLSH = $(TCL_BIN_DIR)/tclsh CC = @CC@ # # Targets # all: core pro: $(MAKE) DOCS="$(PRODOCS)" VER="" rtf core: $(MAKE) DOCS="$(COREDOCS)" rtf rtf: $(TCL_SOURCE)/tools/man2help.tcl man2tcl $(DOCS) LD_LIBRARY_PATH=$(TCL_BIN_DIR) \ TCL_LIBRARY=$(TCL_SOURCE)/library \ $(TCLSH) $(TCL_SOURCE)/tools/man2help.tcl tcl "$(VER)" $(DOCS) winhelp: tcl.rtf man2tcl: $(TCL_SOURCE)/tools/man2tcl.c $(CC) $(CFLAGS) -o man2tcl $(TCL_SOURCE)/tools/man2tcl.c clean: -rm -f man2tcl *.o *.cnt *.rtf helpfile: hcw /c /e tcl.hpj tcl8.6.14/tools/README0000644000175000017500000000121114554262142013655 0ustar sergeisergeiThis directory contains unsupported tools used to build parts of Tcl for distribution. uniParse.tcl -- Script for converting the Unicode character database into a compact table stored in generic/tclUniData.c. uniClass.tcl -- Script for generating regexp class tables from the Tcl "string is" classes Generating HTML files. The tcltk-man2html.tcl script generates a nice set of HTML with good cross references. Use it like cd unix ./configure make html This script is very picky about the organization of man pages, effectively acting as a style enforcer. The resulting documentation can be found at /tmp/dist/tcl/html tcl8.6.14/tools/configure0000755000175000017500000020230114554262142014707 0ustar sergeisergei#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.59. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME= PACKAGE_TARNAME= PACKAGE_VERSION= PACKAGE_STRING= PACKAGE_BUGREPORT= ac_unique_file="man2tcl.c" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_WIN_VERSION CC TCL_VERSION TCL_PATCH_LEVEL TCL_SRC_DIR TCL_BIN_DIR LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures this package to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-tcl=DIR use Tcl $DEF_VER binaries from DIR _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit 0 fi exec 5>config.log cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by $as_me, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Recover information that Tcl computed with its configure script. #-------------------------------------------------------------------- # See if there was a command-line option for where Tcl is; if # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- DEF_VER=8.6 # Check whether --with-tcl or --without-tcl was given. if test "${with_tcl+set}" = set; then withval="$with_tcl" TCL_BIN_DIR=$withval else TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd` fi; if test ! -d $TCL_BIN_DIR; then { { echo "$as_me:$LINENO: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&5 echo "$as_me: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&2;} { (exit 1); exit 1; }; } fi if test ! -f $TCL_BIN_DIR/tclConfig.sh; then { { echo "$as_me:$LINENO: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&5 echo "$as_me: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&2;} { (exit 1); exit 1; }; } fi . $TCL_BIN_DIR/tclConfig.sh TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION CC=$TCL_CC ac_config_files="$ac_config_files Makefile tcl.hpj" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. cat >confdef2opt.sed <<\_ACEOF t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g p _ACEOF # We use echo to avoid assuming a particular line-breaking character. # The extra dot is to prevent the shell from consuming trailing # line-breaks from the sub-command output. A line-break within # single-quotes doesn't work because, if this script is created in a # platform that uses two characters for line-breaks (e.g., DOS), tr # would break. ac_LF_and_DOT=`echo; echo .` DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` rm -f confdef2opt.sed ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_i=`echo "$ac_i" | sed 's/\$U\././;s/\.o$//;s/\.obj$//'` # 2. Add them. ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by $as_me, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ config.status configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t s,@CC@,$CC,;t t s,@TCL_VERSION@,$TCL_VERSION,;t t s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi tcl8.6.14/tools/configure.in0000644000175000017500000000247614554262142015324 0ustar sergeisergeidnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run to configure the dnl Makefile in this directory. AC_INIT AC_CONFIG_SRCDIR([man2tcl.c]) AC_PREREQ([2.59]) # Recover information that Tcl computed with its configure script. #-------------------------------------------------------------------- # See if there was a command-line option for where Tcl is; if # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- DEF_VER=8.6 AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist) fi if test ! -f $TCL_BIN_DIR/tclConfig.sh; then AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?) fi . $TCL_BIN_DIR/tclConfig.sh TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION AC_SUBST(TCL_WIN_VERSION) CC=$TCL_CC AC_SUBST(CC) AC_SUBST(TCL_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_BIN_DIR) AC_CONFIG_FILES([Makefile tcl.hpj]) AC_OUTPUT tcl8.6.14/tools/checkLibraryDoc.tcl0000644000175000017500000001621514554262142016543 0ustar sergeisergei# checkLibraryDoc.tcl -- # # This script attempts to determine what APIs exist in the source base that # have not been documented. By grepping through all of the doc/*.3 man # pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list # against the list of Pkg_ APIs found in the source (e.g., tcl8.6/*/*.[ch]) # we create six lists: # 1) APIs in Source not in Docs. # 2) APIs in Docs not in Source. # 3) Internal APIs and structs. # 4) Misc APIs and structs that we are not documenting. # 5) Command APIs (e.g., Tcl_ArrayObjCmd.) # 6) Proc pointers (e.g., Tcl_CloseProc.) # # Note: Each list is "a best guess" approximation. If developers write # non-standard code, this script will produce erroneous results. Each # list should be carefully checked for accuracy. # # Copyright (c) 1998-1999 Scriptics Corporation. # All rights reserved. lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin" #lappend auto_path "/home/surles/cvs/tclx8.0/tcl/unix" if {[catch {package require Tclx}]} { puts "error: could not load TclX. Please set TCL_LIBRARY." exit 1 } # A list of structs that are known to be undocumented. set StructList { Tcl_AsyncHandler \ Tcl_CallFrame \ Tcl_Condition \ Tcl_Encoding \ Tcl_EncodingState \ Tcl_EncodingType \ Tcl_HashEntry \ Tcl_HashSearch \ Tcl_HashTable \ Tcl_Mutex \ Tcl_Pid \ Tcl_QueuePosition \ Tcl_ResolvedVarInfo \ Tcl_SavedResult \ Tcl_ThreadDataKey \ Tcl_ThreadId \ Tcl_Time \ Tcl_TimerToken \ Tcl_Token \ Tcl_Trace \ Tcl_Value \ Tcl_ValueType \ Tcl_Var \ Tk_3DBorder \ Tk_ArgvInfo \ Tk_BindingTable \ Tk_Canvas \ Tk_CanvasTextInfo \ Tk_ConfigSpec \ Tk_ConfigTypes \ Tk_Cursor \ Tk_CustomOption \ Tk_ErrorHandler \ Tk_FakeWin \ Tk_Font \ Tk_FontMetrics \ Tk_GeomMgr \ Tk_Image \ Tk_ImageMaster \ Tk_ImageModel \ Tk_ImageType \ Tk_Item \ Tk_ItemType \ Tk_OptionSpec\ Tk_OptionTable \ Tk_OptionType \ Tk_PhotoHandle \ Tk_PhotoImageBlock \ Tk_PhotoImageFormat \ Tk_PostscriptInfo \ Tk_SavedOption \ Tk_SavedOptions \ Tk_SegType \ Tk_TextLayout \ Tk_Window \ } # Misc junk that appears in the comments of the source. This just # allows us to filter comments that "fool" the script. set CommentList { Tcl_Create\[Obj\]Command \ Tcl_DecrRefCount\\n \ Tcl_NewObj\\n \ Tk_GetXXX \ } # Main entry point to this script. proc main {} { global argv0 global argv set len [llength $argv] if {($len != 2) && ($len != 3)} { puts "usage: $argv0 pkgName pkgDir \[outFile\]" puts " pkgName == Tcl,Tk" exit 1 } set pkg [lindex $argv 0] set dir [lindex $argv 1] if {[llength $argv] == 3} { set file [open [lindex $argv 2] w] } else { set file stdout } foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {} filter $c $d $dir $pkg $file if {$file ne "stdout"} { close $file } return } # Intersect the two list and write out the sets of APIs in one # list that is not in the other. proc compare {list1 list2} { set inter [intersect3 $list1 $list2] return [list [lindex $inter 0] [lindex $inter 2]] } # Filter the lists into the six lists we report on. Then write # the results to the file. proc filter {code docs dir pkg {outFile stdout}} { set apis {} # A list of Tcl command APIs. These are not documented. # This list should just be verified for accuracy. set cmds {} # A list of proc pointer structs. These are not documented. # This list should just be verified for accuracy. set procs {} # A list of internal declarations. These are not documented. # This list should just be verified for accuracy. set decls [grepDecl $dir $pkg] # A list of misc. procedure declarations that are not documented. # This list should just be verified for accuracy. set misc [grepMisc $dir $pkg] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" # A list of APIs in the source, not in the docs. # This list should just be verified for accuracy. foreach x $code { if {[string match *Cmd $x]} { if {[string match ${pkg}* $x]} { lappend cmds $x } } elseif {[string match *Proc $x]} { if {[string match ${pkg}* $x]} { lappend procs $x } } elseif {[lsearch -exact $decls $x] >= 0} { # No Op. } elseif {[lsearch -exact $misc $x] >= 0} { # No Op. } else { lappend apis $x } } dump $apis "APIs in Source not in Docs." $outFile dump $docs "APIs in Docs not in Source." $outFile dump $decls "Internal APIs and structs." $outFile dump $misc "Misc APIs and structs that we are not documenting." $outFile dump $cmds "Command APIs." $outFile dump $procs "Proc pointers." $outFile return } # Print the list of APIs if the list is not null. proc dump {list title file} { if {$list ne ""} { puts $file "" puts $file $title puts $file "---------------------------------------------------------" foreach x $list { puts $file $x } } } # Grep into "dir/*/*.[ch]" looking for APIs that match $pkg_*. # (e.g., Tcl_Exit). Return a list of APIs. proc grepCode {dir pkg} { set apis [myGrep "${pkg}_\.\*" "${dir}/\*/\*\.\[ch\]"] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" foreach a $apis { if {[regexp -- $pat1 $a main n1]} { set result([string trim $n1]) 1 } } return [lsort [array names result]] } # Grep into "dir/doc/*.3" looking for APIs that match $pkg_*. # (e.g., Tcl_Exit). Return a list of APIs. proc grepDocs {dir pkg} { set apis [myGrep "\\fB${pkg}_\.\*\\fR" "${dir}/doc/\*\.3"] set pat1 ".*(${pkg}_\[A-z0-9]+)\\\\fR.*$" foreach a $apis { if {[regexp -- $pat1 $a main n1]} { set result([string trim $n1]) 1 } } return [lsort [array names result]] } # Grep into "generic/pkgIntDecls.h" looking for APIs that match $pkg_*. # (e.g., Tcl_Export). Return a list of APIs. proc grepDecl {dir pkg} { set file [file join $dir generic "[string tolower $pkg]IntDecls.h"] set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_.*" $file] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" foreach a $apis { if {[regexp -- $pat1 $a main n1]} { set result([string trim $n1]) 1 } } return [lsort [array names result]] } # Grep into "*/*.[ch]" looking for APIs that match $pkg_Db*. # (e.g., Tcl_DbCkalloc). Return a list of APIs. proc grepMisc {dir pkg} { global CommentList global StructList set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_Db.*" "${dir}/\*/\*\.\[ch\]"] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" foreach a $apis { if {[regexp -- $pat1 $a main n1]} { set dbg([string trim $n1]) 1 } } set result {} eval {lappend result} $StructList eval {lappend result} [lsort [array names dbg]] eval {lappend result} $CommentList return $result } proc myGrep {searchPat globPat} { set result {} foreach file [glob -nocomplain $globPat] { set file [open $file r] set data [read $file] close $file foreach line [split $data "\n"] { if {[regexp "^.*${searchPat}.*\$" $line]} { lappend result $line } } } return $result } main tcl8.6.14/tools/eolFix.tcl0000644000175000017500000000315414554262142014737 0ustar sergeisergei## Super aggressive EOL-fixer! ## ## Will even understand screwed up ones like CRCRLF. ## ## davygrvy@pobox.com 3:41 PM 10/12/2001 ## package provide EOL-fix 1.1 namespace eval ::EOL { variable outMode crlf } proc EOL::fix {filename {newfilename {}}} { variable outMode if {![file exists $filename]} { return } puts "EOL Fixing: $filename" file rename ${filename} ${filename}.o set fhnd [open ${filename}.o r] if {$newfilename ne ""} { set newfhnd [open ${newfilename} w] } else { set newfhnd [open ${filename} w] } fconfigure $newfhnd -translation [list auto $outMode] seek $fhnd 0 end set theEnd [tell $fhnd] seek $fhnd 0 start fconfigure $fhnd -translation binary -buffersize $theEnd set rawFile [read $fhnd $theEnd] close $fhnd regsub -all {(\r)|(\r){1,2}(\n)} $rawFile "\n" rawFile set lineList [split $rawFile \n] foreach line $lineList { puts $newfhnd $line } close $newfhnd file delete ${filename}.o } proc EOL::fixall {args} { if {[llength $args] == 0} { puts stderr "no files to fix" exit 1 } else { set cmd [lreplace $args -1 -1 glob -nocomplain] } foreach f [eval $cmd] { if {[file isfile $f]} {fix $f} } } if {$tcl_interactive == 0 && $argc > 0} { if {[string index [lindex $argv 0] 0] eq "-"} { switch -- [lindex $argv 0] { -cr {set ::EOL::outMode cr} -crlf {set ::EOL::outMode crlf} -lf {set ::EOL::outMode lf} default {puts stderr "improper mode switch"; exit 1} } set argv [lrange $argv 1 end] } eval EOL::fixall $argv } else { return } tcl8.6.14/tools/findBadExternals.tcl0000755000175000017500000000233514554262142016731 0ustar sergeisergei# findBadExternals.tcl -- # # This script scans the Tcl load library for exported symbols # that do not begin with 'Tcl' or 'tcl'. It reports them on the # standard output. It is used to make sure that the library does # not inadvertently export externals that may be in conflict with # other code. # # Usage: # # tclsh findBadExternals.tcl /path/to/tclXX.so-or-.dll # # Copyright (c) 2005 George Peter Staplin and Kevin Kenny # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- proc main {argc argv} { if {$argc != 1} { puts stderr "syntax is: [info script] libtcl" return 1 } switch -exact -- $::tcl_platform(platform) { unix - macosx { set status [catch { exec nm --extern-only --defined-only [lindex $argv 0] } result] } windows { set status [catch { exec dumpbin /exports [lindex $argv 0] } result] } } if {$status != 0 && $::errorCode ne "NONE"} { puts $result return 1 } foreach line [split $result \n] { if {! [string match {* [Tt]cl*} $line]} { puts $line } } return 0 } exit [main $::argc $::argv] tcl8.6.14/tools/fix_tommath_h.tcl0000755000175000017500000000441414554262142016342 0ustar sergeisergei# fixtommath.tcl -- # # Changes to 'tommath.h' to make it conform with Tcl's linking # conventions. # # Copyright (c) 2005 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- set f [open [lindex $argv 0] r] set data [read $f] close $f set eat_endif 0 set eat_semi 0 set def_count 0 foreach line [split $data \n] { if {!$eat_semi && !$eat_endif} { switch -regexp -- $line { {#define BN_H_} { puts $line puts {} puts "\#include \"tclInt.h\"" puts "\#include \"tclTomMathDecls.h\"" puts "\#ifndef MODULE_SCOPE" puts "\#define MODULE_SCOPE extern" puts "\#endif" } {typedef\s+unsigned long\s+mp_digit;} { # change the second 'typedef unsigned long mp incr def_count puts "\#ifndef MP_DIGIT_DECLARED" if {$def_count == 2} { puts [string map {long int} $line] } else { puts $line } puts "\#define MP_DIGIT_DECLARED" puts "\#endif" } {typedef.*mp_digit;} { puts "\#ifndef MP_DIGIT_DECLARED" puts $line puts "\#define MP_DIGIT_DECLARED" puts "\#endif" } {typedef struct} { puts "\#ifndef MP_INT_DECLARED" puts "\#define MP_INT_DECLARED" puts "typedef struct mp_int mp_int;" puts "\#endif" puts "struct mp_int \{" } \}\ mp_int\; { puts "\};" } {^(char|int|void)} { puts "/*" puts $line set eat_semi 1 set after_semi "*/" } {^extern (int|const)} { puts "\#if defined(BUILD_tcl) || !defined(_WIN32)" puts [regsub {^extern} $line "MODULE_SCOPE"] set eat_semi 1 set after_semi "\#endif" } {define heap macros} { puts $line puts "\#if 0 /* these are macros in tclTomMathDecls.h */" set eat_endif 1 } {__x86_64__} { puts "[string map {__x86_64__ NEVER} $line]\ /* 128-bit ints fail in too many places */" } {#include} { # remove all includes } default { puts $line } } } else { puts $line } if {$eat_semi} { if {[regexp {; *$} $line]} { puts $after_semi set eat_semi 0 } } if {$eat_endif} { if {[regexp {^\#endif} $line]} { puts "\#endif" set eat_endif 0 } } } tcl8.6.14/tools/genStubs.tcl0000644000175000017500000007444614560736524015326 0ustar sergeisergei# genStubs.tcl -- # # This script generates a set of stub files for a given # interface. # # # Copyright (c) 1998-1999 Scriptics Corporation. # Copyright (c) 2007 Daniel A. Steffen # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. namespace eval genStubs { # libraryName -- # # The name of the entire library. This value is used to compute # the USE_*_STUBS macro and the name of the init file. variable libraryName "UNKNOWN" # interfaces -- # # An array indexed by interface name that is used to maintain # the set of valid interfaces. The value is empty. array set interfaces {} # curName -- # # The name of the interface currently being defined. variable curName "UNKNOWN" # scspec -- # # Storage class specifier for external function declarations. # Normally "EXTERN", may be set to something like XYZAPI # variable scspec "EXTERN" # epoch, revision -- # # The epoch and revision numbers of the interface currently being defined. # (@@@TODO: should be an array mapping interface names -> numbers) # variable epoch {} variable revision 0 # hooks -- # # An array indexed by interface name that contains the set of # subinterfaces that should be defined for a given interface. array set hooks {} # stubs -- # # This three dimensional array is indexed first by interface name, # second by platform name, and third by a numeric offset or the # constant "lastNum". The lastNum entry contains the largest # numeric offset used for a given interface/platform combo. Each # numeric offset contains the C function specification that # should be used for the given entry in the stub table. The spec # consists of a list in the form returned by parseDecl. array set stubs {} # outDir -- # # The directory where the generated files should be placed. variable outDir . } # genStubs::library -- # # This function is used in the declarations file to set the name # of the library that the interfaces are associated with (e.g. "tcl"). # This value will be used to define the inline conditional macro. # # Arguments: # name The library name. # # Results: # None. proc genStubs::library {name} { variable libraryName $name } # genStubs::interface -- # # This function is used in the declarations file to set the name # of the interface currently being defined. # # Arguments: # name The name of the interface. # # Results: # None. proc genStubs::interface {name} { variable curName $name variable interfaces set interfaces($name) {} return } # genStubs::scspec -- # # Define the storage class macro used for external function declarations. # Typically, this will be a macro like XYZAPI or EXTERN that # expands to either DLLIMPORT or DLLEXPORT, depending on whether # -DBUILD_XYZ has been set. # proc genStubs::scspec {value} { variable scspec $value } # genStubs::epoch -- # # Define the epoch number for this library. The epoch # should be incrememented when a release is made that # contains incompatible changes to the public API. # proc genStubs::epoch {value} { variable epoch $value } # genStubs::hooks -- # # This function defines the subinterface hooks for the current # interface. # # Arguments: # names The ordered list of interfaces that are reachable through the # hook vector. # # Results: # None. proc genStubs::hooks {names} { variable curName variable hooks set hooks($curName) $names return } # genStubs::declare -- # # This function is used in the declarations file to declare a new # interface entry. # # Arguments: # index The index number of the interface. # platform The platform the interface belongs to. Should be one # of generic, win, unix, or macosx or aqua or x11. # decl The C function declaration, or {} for an undefined # entry. # # Results: # None. proc genStubs::declare {args} { variable stubs variable curName variable revision incr revision if {[llength $args] == 2} { lassign $args index decl set platformList generic } elseif {[llength $args] == 3} { lassign $args index platformList decl } else { puts stderr "wrong # args: declare $args" return } # Check for duplicate declarations, then add the declaration and # bump the lastNum counter if necessary. foreach platform $platformList { if {[info exists stubs($curName,$platform,$index)]} { puts stderr "Duplicate entry: declare $args" } } regsub -all "\[ \t\n\]+" [string trim $decl] " " decl set decl [parseDecl $decl] if {([lindex $platformList 0] eq "deprecated")} { set stubs($curName,deprecated,$index) [lindex $platformList 1] set stubs($curName,generic,$index) $decl if {![info exists stubs($curName,generic,lastNum)] \ || ($index > $stubs($curName,generic,lastNum))} { set stubs($curName,generic,lastNum) $index } } elseif {([lindex $platformList 0] eq "nostub")} { set stubs($curName,nostub,$index) [lindex $platformList 1] set stubs($curName,generic,$index) $decl if {![info exists stubs($curName,generic,lastNum)] \ || ($index > $stubs($curName,generic,lastNum))} { set stubs($curName,generic,lastNum) $index } } else { foreach platform $platformList { if {$decl ne ""} { set stubs($curName,$platform,$index) $decl if {![info exists stubs($curName,$platform,lastNum)] \ || ($index > $stubs($curName,$platform,lastNum))} { set stubs($curName,$platform,lastNum) $index } } } } return } # genStubs::export -- # # This function is used in the declarations file to declare a symbol # that is exported from the library but is not in the stubs table. # # Arguments: # decl The C function declaration, or {} for an undefined # entry. # # Results: # None. proc genStubs::export {args} { if {[llength $args] != 1} { puts stderr "wrong # args: export $args" } return } # genStubs::rewriteFile -- # # This function replaces the machine generated portion of the # specified file with new contents. It looks for the !BEGIN! and # !END! comments to determine where to place the new text. # # Arguments: # file The name of the file to modify. # text The new text to place in the file. # # Results: # None. proc genStubs::rewriteFile {file text} { if {![file exists $file]} { puts stderr "Cannot find file: $file" return } set in [open ${file} r] fconfigure $in -eofchar "\x1A {}" -encoding utf-8 set out [open ${file}.new w] fconfigure $out -translation lf -encoding utf-8 while {![eof $in]} { set line [gets $in] if {[string match "*!BEGIN!*" $line]} { break } puts $out $line } puts $out "/* !BEGIN!: Do not edit below this line. */" puts $out $text while {![eof $in]} { set line [gets $in] if {[string match "*!END!*" $line]} { break } } puts $out "/* !END!: Do not edit above this line. */" puts -nonewline $out [read $in] close $in close $out file rename -force ${file}.new ${file} return } # genStubs::addPlatformGuard -- # # Wrap a string inside a platform #ifdef. # # Arguments: # plat Platform to test. # # Results: # Returns the original text inside an appropriate #ifdef. proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { set text "" switch $plat { win { append text "#if defined(_WIN32)" if {$withCygwin} { append text " || defined(__CYGWIN__)" } append text " /* WIN */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* WIN */\n${eltxt}" } append text "#endif /* WIN */\n" } unix { append text "#if !defined(_WIN32)" if {$withCygwin} { append text " && !defined(__CYGWIN__)" } append text " && !defined(MAC_OSX_TCL)\ /* UNIX */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* UNIX */\n${eltxt}" } append text "#endif /* UNIX */\n" } macosx { append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* MACOSX */\n${eltxt}" } append text "#endif /* MACOSX */\n" } aqua { append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* AQUA */\n${eltxt}" } append text "#endif /* AQUA */\n" } x11 { append text "#if !(defined(_WIN32)" if {$withCygwin} { append text " || defined(__CYGWIN__)" } append text " || defined(MAC_OSX_TK))\ /* X11 */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* X11 */\n${eltxt}" } append text "#endif /* X11 */\n" } default { append text "${iftxt}${eltxt}" } } return $text } # genStubs::emitSlots -- # # Generate the stub table slots for the given interface. If there # are no generic slots, then one table is generated for each # platform, otherwise one table is generated for all platforms. # # Arguments: # name The name of the interface being emitted. # textVar The variable to use for output. # # Results: # None. proc genStubs::emitSlots {name textVar} { upvar $textVar text forAllStubs $name makeSlot 1 text {" void (*reserved$i)(void);\n"} return } # genStubs::parseDecl -- # # Parse a C function declaration into its component parts. # # Arguments: # decl The function declaration. # # Results: # Returns a list of the form {returnType name args}. The args # element consists of a list of type/name pairs, or a single # element "void". If the function declaration is malformed # then an error is displayed and the return value is {}. proc genStubs::parseDecl {decl} { if {![regexp {^(.*)\((.*)\)$} $decl all prefix args]} { set prefix $decl set args {} } set prefix [string trim $prefix] if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} { puts stderr "Bad return type: $decl" return } set rtype [string trim $rtype] if {$args eq ""} { return [list $rtype $fname {}] } foreach arg [split $args ,] { lappend argList [string trim $arg] } if {![string compare [lindex $argList end] "..."]} { set args TCL_VARARGS foreach arg [lrange $argList 0 end-1] { set argInfo [parseArg $arg] if {[llength $argInfo] == 2 || [llength $argInfo] == 3} { lappend args $argInfo } else { puts stderr "Bad argument: '$arg' in '$decl'" return } } } else { set args {} foreach arg $argList { set argInfo [parseArg $arg] if {![string compare $argInfo "void"]} { lappend args "void" break } elseif {[llength $argInfo] == 2 || [llength $argInfo] == 3} { lappend args $argInfo } else { puts stderr "Bad argument: '$arg' in '$decl'" return } } } return [list $rtype $fname $args] } # genStubs::parseArg -- # # This function parses a function argument into a type and name. # # Arguments: # arg The argument to parse. # # Results: # Returns a list of type and name with an optional third array # indicator. If the argument is malformed, returns "". proc genStubs::parseArg {arg} { if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} { if {$arg eq "void"} { return $arg } else { return } } set result [list [string trim $type] $name] if {$array ne ""} { lappend result $array } return $result } # genStubs::makeDecl -- # # Generate the prototype for a function. # # Arguments: # name The interface name. # decl The function declaration. # index The slot index for this function. # # Results: # Returns the formatted declaration string. proc genStubs::makeDecl {name decl index} { variable scspec variable stubs variable libraryName lassign $decl rtype fname args append text "/* $index */\n" if {[info exists stubs($name,deprecated,$index)]} { append text "[string toupper $libraryName]_DEPRECATED(\"$stubs($name,deprecated,$index)\")\n" set line "$rtype" } elseif {[string range $rtype end-5 end] eq "MP_WUR"} { set line "$scspec [string trim [string range $rtype 0 end-6]]" } else { set line "$scspec $rtype" } set count [expr {2 - ([string length $line] / 8)}] if {$count >= 0} { append line [string range "\t\t\t" 0 $count] } set pad [expr {24 - [string length $line]}] if {$pad <= 0} { append line " " set pad 0 } if {$args eq ""} { append line $fname append text $line append text ";\n" return $text } append line $fname set arg1 [lindex $args 0] switch -exact $arg1 { void { append line "(void)" } TCL_VARARGS { set sep "(" foreach arg [lrange $args 1 end] { append line $sep set next {} append next [lindex $arg 0] if {[string index $next end] ne "*"} { append next " " } append next [lindex $arg 1] [lindex $arg 2] if {[string length $line] + [string length $next] \ + $pad > 76} { append text [string trimright $line] \n set line "\t\t\t\t" set pad 28 } append line $next set sep ", " } append line ", ...)" if {[lindex $args end] eq "{const char *} format"} { append line " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")" } } default { set sep "(" foreach arg $args { append line $sep set next {} append next [lindex $arg 0] if {[string index $next end] ne "*"} { append next " " } append next [lindex $arg 1] [lindex $arg 2] if {[string length $line] + [string length $next] \ + $pad > 76} { append text [string trimright $line] \n set line "\t\t\t\t" set pad 28 } append line $next set sep ", " } append line ")" } } if {[string range $rtype end-5 end] eq "MP_WUR"} { append line " MP_WUR" } return "$text$line;\n" } # genStubs::makeMacro -- # # Generate the inline macro for a function. # # Arguments: # name The interface name. # decl The function declaration. # index The slot index for this function. # # Results: # Returns the formatted macro definition. proc genStubs::makeMacro {name decl index} { lassign $decl rtype fname args set lfname [string tolower [string index $fname 0]] append lfname [string range $fname 1 end] set text "#define $fname \\\n\t(" if {$args eq ""} { append text "*" } append text "${name}StubsPtr->$lfname)" append text " /* $index */\n" return $text } # genStubs::makeSlot -- # # Generate the stub table entry for a function. # # Arguments: # name The interface name. # decl The function declaration. # index The slot index for this function. # # Results: # Returns the formatted table entry. proc genStubs::makeSlot {name decl index} { lassign $decl rtype fname args variable stubs set lfname [string tolower [string index $fname 0]] append lfname [string range $fname 1 end] set text " " if {[info exists stubs($name,deprecated,$index)]} { append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") " } elseif {[info exists stubs($name,nostub,$index)]} { append text "TCL_DEPRECATED_API(\"$stubs($name,nostub,$index)\") " } if {$args eq ""} { append text $rtype " *" $lfname "; /* $index */\n" return $text } if {[string range $rtype end-8 end] eq "__stdcall"} { append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " } elseif {[string range $rtype 0 11] eq "TCL_NORETURN"} { append text "TCL_NORETURN1 " [string trim [string range $rtype 12 end]] " (*" $lfname ") " } elseif {[string range $rtype end-5 end] eq "MP_WUR"} { append text [string trim [string range $rtype 0 end-6]] " (*" $lfname ") " } else { append text $rtype " (*" $lfname ") " } set arg1 [lindex $args 0] switch -exact $arg1 { void { append text "(void)" } TCL_VARARGS { set sep "(" foreach arg [lrange $args 1 end] { append text $sep [lindex $arg 0] if {[string index $text end] ne "*"} { append text " " } append text [lindex $arg 1] [lindex $arg 2] set sep ", " } append text ", ...)" if {[lindex $args end] eq "{const char *} format"} { append text " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")" } } default { set sep "(" foreach arg $args { append text $sep [lindex $arg 0] if {[string index $text end] ne "*"} { append text " " } append text [lindex $arg 1] [lindex $arg 2] set sep ", " } append text ")" } } if {[string range $rtype end-5 end] eq "MP_WUR"} { append text " MP_WUR" } append text "; /* $index */\n" return $text } # genStubs::makeInit -- # # Generate the prototype for a function. # # Arguments: # name The interface name. # decl The function declaration. # index The slot index for this function. # # Results: # Returns the formatted declaration string. proc genStubs::makeInit {name decl index} { if {[lindex $decl 2] eq ""} { append text " &" [lindex $decl 1] ", /* " $index " */\n" } else { append text " " [lindex $decl 1] ", /* " $index " */\n" } return $text } # genStubs::forAllStubs -- # # This function iterates over all of the platforms and invokes # a callback for each slot. The result of the callback is then # placed inside appropriate platform guards. # # Arguments: # name The interface name. # slotProc The proc to invoke to handle the slot. It will # have the interface name, the declaration, and # the index appended. # onAll If 1, emit the skip string even if there are # definitions for one or more platforms. # textVar The variable to use for output. # skipString The string to emit if a slot is skipped. This # string will be subst'ed in the loop so "$i" can # be used to substitute the index value. # # Results: # None. proc genStubs::forAllStubs {name slotProc onAll textVar {skipString {"/* Slot $i is reserved */\n"}}} { variable stubs upvar $textVar text set plats [array names stubs $name,*,lastNum] if {[info exists stubs($name,generic,lastNum)]} { # Emit integrated stubs block set lastNum -1 foreach plat [array names stubs $name,*,lastNum] { if {$stubs($plat) > $lastNum} { set lastNum $stubs($plat) } } for {set i 0} {$i <= $lastNum} {incr i} { set slots [array names stubs $name,*,$i] set emit 0 if {[info exists stubs($name,deprecated,$i)]} { append text [$slotProc $name $stubs($name,generic,$i) $i] set emit 1 } elseif {[info exists stubs($name,nostub,$i)]} { append text [$slotProc $name $stubs($name,generic,$i) $i] set emit 1 } elseif {[info exists stubs($name,generic,$i)]} { if {[llength $slots] > 1} { puts stderr "conflicting generic and platform entries:\ $name $i" } append text [$slotProc $name $stubs($name,generic,$i) $i] set emit 1 } elseif {[llength $slots] > 0} { array set slot {unix 0 x11 0 win 0 macosx 0 aqua 0} foreach s $slots { set slot([lindex [split $s ,] 1]) 1 } # "aqua", "macosx" and "x11" are special cases: # "macosx" implies "unix", "aqua" implies "macosx" and "x11" # implies "unix", so we need to be careful not to emit # duplicate stubs entries: if {($slot(unix) && $slot(macosx)) || ( ($slot(unix) || $slot(macosx)) && ($slot(x11) || $slot(aqua)))} { puts stderr "conflicting platform entries: $name $i" } ## unix ## set temp {} set plat unix if {!$slot(aqua) && !$slot(x11)} { if {$slot($plat)} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] } elseif {$onAll} { eval {append temp} $skipString } } if {$temp ne ""} { append text [addPlatformGuard $plat $temp] set emit 1 } ## x11 ## set temp {} set plat x11 if {!$slot(unix) && !$slot(macosx)} { if {$slot($plat)} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] } elseif {$onAll} { eval {append temp} $skipString } } if {$temp ne ""} { append text [addPlatformGuard $plat $temp] set emit 1 } ## win ## set temp {} set plat win if {$slot($plat)} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] } elseif {$onAll} { eval {append temp} $skipString } if {$temp ne ""} { append text [addPlatformGuard $plat $temp] set emit 1 } ## macosx ## set temp {} set plat macosx if {!$slot(aqua) && !$slot(x11)} { if {$slot($plat)} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] } elseif {$slot(unix)} { append temp [$slotProc $name $stubs($name,unix,$i) $i] } elseif {$onAll} { eval {append temp} $skipString } } if {$temp ne ""} { append text [addPlatformGuard $plat $temp] set emit 1 } ## aqua ## set temp {} set plat aqua if {!$slot(unix) && !$slot(macosx)} { if {[string range $skipString 1 2] ne "/*"} { # genStubs.tcl previously had a bug here causing it to # erroneously generate both a unix entry and an aqua # entry for a given stubs table slot. To preserve # backwards compatibility, generate a dummy stubs entry # before every aqua entry (note that this breaks the # correspondence between emitted entry number and # actual position of the entry in the stubs table, e.g. # TkIntStubs entry 113 for aqua is in fact at position # 114 in the table, entry 114 at position 116 etc). eval {append temp} $skipString set temp "[string range $temp 0 end-1] /*\ Dummy entry for stubs table backwards\ compatibility */\n" } if {$slot($plat)} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] } elseif {$onAll} { eval {append temp} $skipString } } if {$temp ne ""} { append text [addPlatformGuard $plat $temp] set emit 1 } } if {!$emit} { eval {append text} $skipString } } } else { # Emit separate stubs blocks per platform array set block {unix 0 x11 0 win 0 macosx 0 aqua 0} foreach s [array names stubs $name,*,lastNum] { set block([lindex [split $s ,] 1]) 1 } ## unix ## if {$block(unix) && !$block(x11)} { set temp {} set plat unix set lastNum $stubs($name,$plat,lastNum) for {set i 0} {$i <= $lastNum} {incr i} { if {[info exists stubs($name,$plat,$i)]} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] } else { eval {append temp} $skipString } } append text [addPlatformGuard $plat $temp {} true] } ## win ## if {$block(win)} { set temp {} set plat win set lastNum $stubs($name,$plat,lastNum) for {set i 0} {$i <= $lastNum} {incr i} { if {[info exists stubs($name,$plat,$i)]} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] } else { eval {append temp} $skipString } } append text [addPlatformGuard $plat $temp {} true] } ## macosx ## if {($block(unix) || $block(macosx)) && !$block(aqua) && !$block(x11)} { set temp {} set lastNum -1 foreach plat {unix macosx} { if {$block($plat)} { set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum) ? $lastNum : $stubs($name,$plat,lastNum)}] } } for {set i 0} {$i <= $lastNum} {incr i} { set emit 0 foreach plat {unix macosx} { if {[info exists stubs($name,$plat,$i)]} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] set emit 1 break } } if {!$emit} { eval {append temp} $skipString } } append text [addPlatformGuard macosx $temp] } ## aqua ## if {$block(aqua)} { set temp {} set lastNum -1 foreach plat {unix macosx aqua} { if {$block($plat)} { set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum) ? $lastNum : $stubs($name,$plat,lastNum)}] } } for {set i 0} {$i <= $lastNum} {incr i} { set emit 0 foreach plat {unix macosx aqua} { if {[info exists stubs($name,$plat,$i)]} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] set emit 1 break } } if {!$emit} { eval {append temp} $skipString } } append text [addPlatformGuard aqua $temp] } ## x11 ## if {$block(x11)} { set temp {} set lastNum -1 foreach plat {unix macosx x11} { if {$block($plat)} { set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum) ? $lastNum : $stubs($name,$plat,lastNum)}] } } for {set i 0} {$i <= $lastNum} {incr i} { set emit 0 foreach plat {unix macosx x11} { if {[info exists stubs($name,$plat,$i)]} { if {$plat ne "macosx"} { append temp [$slotProc $name \ $stubs($name,$plat,$i) $i] } else { eval {set etxt} $skipString append temp [addPlatformGuard $plat [$slotProc \ $name $stubs($name,$plat,$i) $i] $etxt true] } set emit 1 break } } if {!$emit} { eval {append temp} $skipString } } append text [addPlatformGuard x11 $temp {} true] } } } # genStubs::emitDeclarations -- # # This function emits the function declarations for this interface. # # Arguments: # name The interface name. # textVar The variable to use for output. # # Results: # None. proc genStubs::emitDeclarations {name textVar} { upvar $textVar text append text "\n/*\n * Exported function declarations:\n */\n\n" forAllStubs $name makeDecl 0 text return } # genStubs::emitMacros -- # # This function emits the inline macros for an interface. # # Arguments: # name The name of the interface being emitted. # textVar The variable to use for output. # # Results: # None. proc genStubs::emitMacros {name textVar} { variable libraryName upvar $textVar text set upName [string toupper $libraryName] append text "\n#if defined(USE_${upName}_STUBS)\n" append text "\n/*\n * Inline function declarations:\n */\n\n" forAllStubs $name makeMacro 0 text append text "\n#endif /* defined(USE_${upName}_STUBS) */\n" return } # genStubs::emitHeader -- # # This function emits the body of the Decls.h file for # the specified interface. # # Arguments: # name The name of the interface being emitted. # # Results: # None. proc genStubs::emitHeader {name} { variable outDir variable hooks variable epoch variable revision set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] if {$epoch ne ""} { set CAPName [string toupper $name] append text "\n" append text "#define ${CAPName}_STUBS_EPOCH $epoch\n" append text "#define ${CAPName}_STUBS_REVISION $revision\n" } append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" emitDeclarations $name text if {[info exists hooks($name)]} { append text "\ntypedef struct {\n" foreach hook $hooks($name) { set capHook [string toupper [string index $hook 0]] append capHook [string range $hook 1 end] append text " const struct ${capHook}Stubs *${hook}Stubs;\n" } append text "} ${capName}StubHooks;\n" } append text "\ntypedef struct ${capName}Stubs {\n" append text " int magic;\n" if {$epoch ne ""} { append text " int epoch;\n" append text " int revision;\n" } if {[info exists hooks($name)]} { append text " const ${capName}StubHooks *hooks;\n\n" } else { append text " void *hooks;\n\n" } emitSlots $name text append text "} ${capName}Stubs;\n\n" append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n" append text "#ifdef __cplusplus\n}\n#endif\n" emitMacros $name text rewriteFile [file join $outDir ${name}Decls.h] $text return } # genStubs::emitInit -- # # Generate the table initializers for an interface. # # Arguments: # name The name of the interface to initialize. # textVar The variable to use for output. # # Results: # Returns the formatted output. proc genStubs::emitInit {name textVar} { variable hooks variable interfaces variable epoch upvar $textVar text set root 1 set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] if {[info exists hooks($name)]} { append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n" set sep " " foreach sub $hooks($name) { append text $sep "&${sub}Stubs" set sep ",\n " } append text "\n\};\n" } foreach intf [array names interfaces] { if {[info exists hooks($intf)]} { if {$name in $hooks($intf)} { set root 0 break } } } append text "\n" if {!$root} { append text "static " } append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n" if {$epoch ne ""} { set CAPName [string toupper $name] append text " ${CAPName}_STUBS_EPOCH,\n" append text " ${CAPName}_STUBS_REVISION,\n" } if {[info exists hooks($name)]} { append text " &${name}StubHooks,\n" } else { append text " 0,\n" } forAllStubs $name makeInit 1 text {" 0, /* $i */\n"} append text "\};\n" return } # genStubs::emitInits -- # # This function emits the body of the StubInit.c file for # the specified interface. # # Arguments: # name The name of the interface being emitted. # # Results: # None. proc genStubs::emitInits {} { variable hooks variable outDir variable libraryName variable interfaces # Assuming that dependencies only go one level deep, we need to emit # all of the leaves first to avoid needing forward declarations. set leaves {} set roots {} foreach name [lsort [array names interfaces]] { if {[info exists hooks($name)]} { lappend roots $name } else { lappend leaves $name } } foreach name $leaves { emitInit $name text } foreach name $roots { emitInit $name text } rewriteFile [file join $outDir ${libraryName}StubInit.c] $text } # genStubs::init -- # # This is the main entry point. # # Arguments: # None. # # Results: # None. proc genStubs::init {} { global argv argv0 variable outDir variable interfaces if {[llength $argv] < 2} { puts stderr "usage: $argv0 outDir declFile ?declFile...?" exit 1 } set outDir [lindex $argv 0] foreach file [lrange $argv 1 end] { source -encoding utf-8 $file } foreach name [lsort [array names interfaces]] { puts "Emitting $name" emitHeader $name } emitInits } # lassign -- # # This function emulates the TclX lassign command. # # Arguments: # valueList A list containing the values to be assigned. # args The list of variables to be assigned. # # Results: # Returns any values that were not assigned to variables. if {[namespace which lassign] ne ""} { proc lassign {valueList args} { if {[llength $args] == 0} { error "wrong # args: should be \"lassign list varName ?varName ...?\"" } uplevel [list foreach $args $valueList {break}] return [lrange $valueList [llength $args] end] } } genStubs::init tcl8.6.14/tools/index.tcl0000644000175000017500000001027314554262142014620 0ustar sergeisergei# index.tcl -- # # This file defines procedures that are used during the first pass of # the man page conversion. It is used to extract information used to # generate a table of contents and a keyword list. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # Global variables used by these scripts: # # state - state variable that controls action of text proc. # # topics - array indexed by (package,section,topic) with value # of topic ID. # # keywords - array indexed by keyword string with value of topic ID. # # curID - current topic ID, starts at 0 and is incremented for # each new topic file. # # curPkg - current package name (e.g. Tcl). # # curSect - current section title (e.g. "Tcl Built-In Commands"). # # getPackages -- # # Generate a sorted list of package names from the topics array. # # Arguments: # none. proc getPackages {} { global topics foreach i [array names topics] { regsub {^(.*),.*,.*$} $i {\1} i set temp($i) {} } lsort [array names temp] } # getSections -- # # Generate a sorted list of section titles in the specified package # from the topics array. # # Arguments: # pkg - Name of package to search. proc getSections {pkg} { global topics regsub -all {[][*?\\]} $pkg {\\&} pkg foreach i [array names topics "${pkg},*"] { regsub {^.*,(.*),.*$} $i {\1} i set temp($i) {} } lsort [array names temp] } # getTopics -- # # Generate a sorted list of topics in the specified section of the # specified package from the topics array. # # Arguments: # pkg - Name of package to search. # sect - Name of section to search. proc getTopics {pkg sect} { global topics regsub -all {[][*?\\]} $pkg {\\&} pkg regsub -all {[][*?\\]} $sect {\\&} sect foreach i [array names topics "${pkg},${sect},*"] { regsub {^.*,.*,(.*)$} $i {\1} i set temp($i) {} } lsort [array names temp] } # text -- # # This procedure adds entries to the hypertext arrays topics and keywords. # # Arguments: # string - Text to index. proc text string { global state curID curPkg curSect topics keywords switch $state { NAME { foreach i [split $string ","] { set topic [string trim $i] set index "$curPkg,$curSect,$topic" if {[info exists topics($index)] && [string compare $topics($index) $curID] != 0} { puts stderr "duplicate topic $topic in $curPkg" } set topics($index) $curID lappend keywords($topic) $curID } } KEY { foreach i [split $string ","] { lappend keywords([string trim $i]) $curID } } DT - OFF - DASH {} default { puts stderr "text: unknown state: $state" } } } # macro -- # # This procedure is invoked to process macro invocations that start # with "." (instead of '). # # Arguments: # name - The name of the macro (without the "."). # args - Any additional arguments to the macro. proc macro {name args} { switch $name { SH - SS { global state switch $args { NAME { if {$state eq "INIT" } { set state NAME } } DESCRIPTION {set state DT} INTRODUCTION {set state DT} KEYWORDS {set state KEY} default {set state OFF} } } TH { global state curID curPkg curSect topics keywords set state INIT if {[llength $args] != 5} { set args [join $args " "] puts stderr "Bad .TH macro: .$name $args" } incr curID set topic [lindex $args 0] ;# Tcl_UpVar set curPkg [lindex $args 3] ;# Tcl set curSect [lindex $args 4] ;# {Tcl Library Procedures} regsub -all {\\ } $curSect { } curSect set index "$curPkg,$curSect,$topic" set topics($index) $curID lappend keywords($topic) $curID } } } # dash -- # # This procedure is invoked to handle dash characters ("\-" in # troff). It only function in pass1 is to terminate the NAME state. # # Arguments: # None. proc dash {} { global state if {$state eq "NAME"} { set state DASH } } # initGlobals, tab, font, char, macro2 -- # # These procedures do nothing during the first pass. # # Arguments: # None. proc initGlobals {} {} proc newline {} {} proc tab {} {} proc font type {} proc char name {} proc macro2 {name args} {} tcl8.6.14/tools/installData.tcl0000644000175000017500000000267314554262142015756 0ustar sergeisergei#!/bin/sh #\ exec tclsh "$0" ${1+"$@"} #---------------------------------------------------------------------- # # installData.tcl -- # # This file installs a hierarchy of data found in the directory # specified by its first argument into the directory specified # by its second. # #---------------------------------------------------------------------- # # Copyright (c) 2004 Kevin B. Kenny. All rights reserved. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- proc copyDir {d1 d2} { puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \ [file tail $d2]] file delete -force -- $d2 file mkdir $d2 foreach ftail [glob -directory $d1 -nocomplain -tails *] { set f [file join $d1 $ftail] if {[file isdirectory $f] && [string compare CVS $ftail]} { copyDir $f [file join $d2 $ftail] } elseif {[file isfile $f]} { file copy -force $f [file join $d2 $ftail] if {$::tcl_platform(platform) eq {unix}} { file attributes [file join $d2 $ftail] -permissions 0o644 } else { file attributes [file join $d2 $ftail] -readonly 1 } } } if {$::tcl_platform(platform) eq {unix}} { file attributes $d2 -permissions 0o755 } else { file attributes $d2 -readonly 1 } } copyDir [file normalize [lindex $argv 0]] [file normalize [lindex $argv 1]] tcl8.6.14/tools/loadICU.tcl0000755000175000017500000004530714554262142015002 0ustar sergeisergei#---------------------------------------------------------------------- # # loadICU,tcl -- # # Extracts locale strings from a distribution of ICU # (http://oss.software.ibm.com/developerworks/opensource/icu/project/) # and makes Tcl message catalogs for the 'clock' command. # # Usage: # loadICU.tcl sourceDir destDir # # Parameters: # sourceDir -- Path name of the 'data' directory of your ICU4C # distribution. # destDir -- Directory into which the Tcl message catalogs should go. # # Results: # None. # # Side effects: # Creates the message catalogs. # #---------------------------------------------------------------------- # # Copyright (c) 2004 Kevin B. Kenny. All rights reserved. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- # Calculate the Chinese numerals from zero to ninety-nine. set zhDigits [list {} \u4e00 \u4e8c \u4e09 \u56db \ \u4e94 \u516d \u4e03 \u516b \u4e5d] set t 0 foreach zt $zhDigits { if { $t == 0 } { set zt {} } elseif { $t == 10 } { set zt \u5341 } else { append zt \u5341 } set d 0 foreach zd $zhDigits { if { $t == 0 && $d == 0 } { set zd \u3007 } elseif { $t == 20 && $d != 0 } { set zt \u5eff } elseif { $t == 30 && $d != 0 } { set zt \u5345 } lappend zhNumbers $zt$zd incr d } incr t 10 } # Set format overrides for various locales. set format(zh,LOCALE_NUMERALS) $zhNumbers set format(ja,LOCALE_ERAS) [list \ [list -9223372036854775808 \u897f\u66a6 0 ] \ [list -3061011600 \u660e\u6cbb 1867] \ [list -1812186000 \u5927\u6b63 1911] \ [list -1357635600 \u662d\u548c 1925] \ [list 600220800 \u5e73\u6210 1988]] set format(zh,LOCALE_DATE_FORMAT) "\u516c\u5143%Y\u5e74%B%Od\u65E5" set format(ja,LOCALE_DATE_FORMAT) "%EY\u5e74%m\u6708%d\u65E5" set format(ko,LOCALE_DATE_FORMAT) "%Y\ub144%B%Od\uc77c" set format(zh,LOCALE_TIME_FORMAT) "%OH\u65f6%OM\u5206%OS\u79d2" set format(ja,LOCALE_TIME_FORMAT) "%H\u6642%M\u5206%S\u79d2" set format(ko,LOCALE_TIME_FORMAT) "%H\uc2dc%M\ubd84%S\ucd08" set format(zh,LOCALE_DATE_TIME_FORMAT) "%A %Y\u5e74%B%Od\u65E5%OH\u65f6%OM\u5206%OS\u79d2 %z" set format(ja,LOCALE_DATE_TIME_FORMAT) "%EY\u5e74%m\u6708%d\u65E5 (%a) %H\u6642%M\u5206%S\u79d2 %z" set format(ko,LOCALE_DATE_TIME_FORMAT) "%A %Y\ub144%B%Od\uc77c%H\uc2dc%M\ubd84%S\ucd08 %z" set format(ja,TIME_FORMAT_12) {%P %I:%M:%S} # The next set of format overrides were obtained from the glibc # localization strings. set format(cs_CZ,DATE_FORMAT) %d.%m.%Y set format(cs_CZ,DATE_TIME_FORMAT) {%a %e. %B %Y, %H:%M:%S %z} set format(cs_CZ,TIME_FORMAT) %H:%M:%S set format(cs_CZ,TIME_FORMAT_12) %I:%M:%S set format(da_DK,DATE_FORMAT) %d-%m-%Y set format(da_DK,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(da_DK,TIME_FORMAT) %T set format(da_DK,TIME_FORMAT_12) %T set format(de_AT,DATE_FORMAT) %Y-%m-%d set format(de_AT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(de_AT,TIME_FORMAT) %T set format(de_AT,TIME_FORMAT_12) %T set format(de_BE,DATE_FORMAT) %Y-%m-%d set format(de_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(de_BE,TIME_FORMAT) %T set format(de_BE,TIME_FORMAT_12) %T set format(de_CH,DATE_FORMAT) %Y-%m-%d set format(de_CH,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(de_CH,TIME_FORMAT) %T set format(de_CH,TIME_FORMAT_12) %T set format(de_DE,DATE_FORMAT) %Y-%m-%d set format(de_DE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(de_DE,TIME_FORMAT) %T set format(de_DE,TIME_FORMAT_12) %T set format(de_LU,DATE_FORMAT) %Y-%m-%d set format(de_LU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(de_LU,TIME_FORMAT) %T set format(de_LU,TIME_FORMAT_12) %T set format(en_CA,DATE_FORMAT) %d/%m/%y set format(en_CA,DATE_TIME_FORMAT) {%a %d %b %Y %r %z} set format(en_CA,TIME_FORMAT) %r set format(en_CA,TIME_FORMAT_12) {%I:%M:%S %p} set format(en_DK,DATE_FORMAT) %Y-%m-%d set format(en_DK,DATE_TIME_FORMAT) {%Y-%m-%dT%T %z} set format(en_DK,TIME_FORMAT) %T set format(en_DK,TIME_FORMAT_12) %T set format(en_GB,DATE_FORMAT) %d/%m/%y set format(en_GB,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(en_GB,TIME_FORMAT) %T set format(en_GB,TIME_FORMAT_12) %T set format(en_IE,DATE_FORMAT) %d/%m/%y set format(en_IE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(en_IE,TIME_FORMAT) %T set format(en_IE,TIME_FORMAT_12) %T set format(en_US,DATE_FORMAT) %m/%d/%y set format(en_US,DATE_TIME_FORMAT) {%a %d %b %Y %r %z} set format(en_US,TIME_FORMAT) %r set format(en_US,TIME_FORMAT_12) {%I:%M:%S %p} set format(es_ES,DATE_FORMAT) %d/%m/%y set format(es_ES,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(es_ES,TIME_FORMAT) %T set format(es_ES,TIME_FORMAT_12) %T set format(et_EE,DATE_FORMAT) %d.%m.%Y set format(et_EE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(et_EE,TIME_FORMAT) %T set format(et_EE,TIME_FORMAT_12) %T set format(eu_ES,DATE_FORMAT) {%a, %Yeko %bren %da} set format(eu_ES,DATE_TIME_FORMAT) {%y-%m-%d %T %z} set format(eu_ES,TIME_FORMAT) %T set format(eu_ES,TIME_FORMAT_12) %T set format(fi_FI,DATE_FORMAT) %d.%m.%Y set format(fi_FI,DATE_TIME_FORMAT) {%a %e %B %Y %T} set format(fi_FI,TIME_FORMAT) %T set format(fi_FI,TIME_FORMAT_12) %T set format(fo_FO,DATE_FORMAT) %d/%m-%Y set format(fo_FO,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(fo_FO,TIME_FORMAT) %T set format(fo_FO,TIME_FORMAT_12) %T set format(fr_BE,DATE_FORMAT) %d/%m/%y set format(fr_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(fr_BE,TIME_FORMAT) %T set format(fr_BE,TIME_FORMAT_12) %T set format(fr_CA,DATE_FORMAT) %Y-%m-%d set format(fr_CA,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(fr_CA,TIME_FORMAT) %T set format(fr_CA,TIME_FORMAT_12) %T set format(fr_CH,DATE_FORMAT) {%d. %m. %y} set format(fr_CH,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(fr_CH,TIME_FORMAT) %T set format(fr_CH,TIME_FORMAT_12) %T set format(fr_FR,DATE_FORMAT) %d.%m.%Y set format(fr_FR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(fr_FR,TIME_FORMAT) %T set format(fr_FR,TIME_FORMAT_12) %T set format(fr_LU,DATE_FORMAT) %d.%m.%Y set format(fr_LU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(fr_LU,TIME_FORMAT) %T set format(fr_LU,TIME_FORMAT_12) %T set format(ga_IE,DATE_FORMAT) %d.%m.%y set format(ga_IE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(ga_IE,TIME_FORMAT) %T set format(ga_IE,TIME_FORMAT_12) %T set format(gr_GR,DATE_FORMAT) %d/%m/%Y set format(gr_GR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(gr_GR,TIME_FORMAT) %T set format(gr_GR,TIME_FORMAT_12) %T set format(hr_HR,DATE_FORMAT) %d.%m.%y set format(hr_HR,DATE_TIME_FORMAT) {%a %d %b %Y %T} set format(hr_HR,TIME_FORMAT) %T set format(hr_HR,TIME_FORMAT_12) %T set format(hu_HU,DATE_FORMAT) %Y-%m-%d set format(hu_HU,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(hu_HU,TIME_FORMAT) %T set format(hu_HU,TIME_FORMAT_12) %T set format(is_IS,DATE_FORMAT) {%a %e.%b %Y} set format(is_IS,DATE_TIME_FORMAT) {%a %e.%b %Y, %T %z} set format(is_IS,TIME_FORMAT) %T set format(is_IS,TIME_FORMAT_12) %T set format(it_IT,DATE_FORMAT) %d/%m/%Y set format(it_IT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(it_IT,TIME_FORMAT) %T set format(it_IT,TIME_FORMAT_12) %T set format(iw_IL,DATE_FORMAT) %d/%m/%y set format(iw_IL,DATE_TIME_FORMAT) {%z %H:%M:%S %Y %b %d %a} set format(iw_IL,TIME_FORMAT) %H:%M:%S set format(iw_IL,TIME_FORMAT_12) {%I:%M:%S %P} set format(kl_GL,DATE_FORMAT) {%d %b %Y} set format(kl_GL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(kl_GL,TIME_FORMAT) %T set format(kl_GL,TIME_FORMAT_12) %T set format(lt_LT,DATE_FORMAT) %Y.%m.%d set format(lt_LT,DATE_TIME_FORMAT) {%Y m. %B %d d. %T} set format(lt_LT,TIME_FORMAT) %T set format(lt_LT,TIME_FORMAT_12) %T set format(lv_LV,DATE_FORMAT) %Y.%m.%d. set format(lv_LV,DATE_TIME_FORMAT) {%A, %Y. gada %e. %B, plkst. %H un %M} set format(lv_LV,TIME_FORMAT) %T set format(lv_LV,TIME_FORMAT_12) %T set format(nl_BE,DATE_FORMAT) %d-%m-%y set format(nl_BE,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(nl_BE,TIME_FORMAT) %T set format(nl_BE,TIME_FORMAT_12) %T set format(nl_NL,DATE_FORMAT) %d-%m-%y set format(nl_NL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(nl_NL,TIME_FORMAT) %T set format(nl_NL,TIME_FORMAT_12) %T set format(no_NO,DATE_FORMAT) %d-%m-%Y set format(no_NO,DATE_TIME_FORMAT) {%a %d-%m-%Y %T %z} set format(no_NO,TIME_FORMAT) %T set format(no_NO,TIME_FORMAT_12) %T set format(pl_PL,DATE_FORMAT) %Y-%m-%d set format(pl_PL,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(pl_PL,TIME_FORMAT) %T set format(pl_PL,TIME_FORMAT_12) %T set format(pt_BR,DATE_FORMAT) %d-%m-%Y set format(pt_BR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(pt_BR,TIME_FORMAT) %T set format(pt_BR,TIME_FORMAT_12) %T set format(pt_PT,DATE_FORMAT) %d-%m-%Y set format(pt_PT,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(pt_PT,TIME_FORMAT) %T set format(pt_PT,TIME_FORMAT_12) %T set format(ro_RO,DATE_FORMAT) %Y-%m-%d set format(ro_RO,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(ro_RO,TIME_FORMAT) %T set format(ro_RO,TIME_FORMAT_12) %T set format(ru_RU,DATE_FORMAT) %d.%m.%Y set format(ru_RU,DATE_TIME_FORMAT) {%a %d %b %Y %T} set format(ru_RU,TIME_FORMAT) %T set format(ru_RU,TIME_FORMAT_12) %T set format(sl_SI,DATE_FORMAT) %d.%m.%Y set format(sl_SI,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(sl_SI,TIME_FORMAT) %T set format(sl_SI,TIME_FORMAT_12) %T set format(sv_FI,DATE_FORMAT) %Y-%m-%d set format(sv_FI,DATE_TIME_FORMAT) {%a %e %b %Y %H.%M.%S} set format(sv_FI,TIME_FORMAT) %H.%M.%S set format(sv_FI,TIME_FORMAT_12) %H.%M.%S set format(sv_SE,DATE_FORMAT) %Y-%m-%d set format(sv_SE,DATE_TIME_FORMAT) {%a %e %b %Y %H.%M.%S} set format(sv_SE,TIME_FORMAT) %H.%M.%S set format(sv_SE,TIME_FORMAT_12) %H.%M.%S set format(tr_TR,DATE_FORMAT) %Y-%m-%d set format(tr_TR,DATE_TIME_FORMAT) {%a %d %b %Y %T %z} set format(tr_TR,TIME_FORMAT) %T set format(tr_TR,TIME_FORMAT_12) %T #---------------------------------------------------------------------- # # handleLocaleFile -- # # Extracts strings from an ICU locale definition. # # Parameters: # localeName - Name of the locale (e.g., de_AT_euro) # fileName - Name of the file containing the data # msgFileName - Name of the file containing the Tcl message catalog # # Results: # None. # # Side effects: # Writes the Tcl message catalog. # #---------------------------------------------------------------------- proc handleLocaleFile { localeName fileName msgFileName } { variable format # Get the content of the ICU file set f [open $fileName r] fconfigure $f -encoding utf-8 set data [read $f] close $f # Parse the ICU data set state {} foreach line [split $data \n] { switch -exact -- $state { {} { # Look for the beginnings of data blocks switch -regexp -- $line { {^[[:space:]]*AmPmMarkers[[:space:]]+[\{]} { set state data set key AmPmMarkers } {^[[:space:]]*DateTimePatterns[[:space:]]+[\{]} { set state data set key DateTimePatterns } {^[[:space:]]*DayAbbreviations[[:space:]]+[\{]} { set state data set key DayAbbreviations } {^[[:space:]]*DayNames[[:space:]]+[\{]} { set state data set key DayNames } {^[[:space:]]*Eras[[:space:]]+[\{]} { set state data set key Eras } {^[[:space:]]*MonthAbbreviations[[:space:]]+[\{]} { set state data set key MonthAbbreviations } {^[[:space:]]*MonthNames[[:space:]]+[\{]} { set state data set key MonthNames } } } data { # Inside a data block, collect the strings, doing backslash # expansion to pick up the Unicodes if { [regexp {"(.*)",} $line -> item] } { lappend items($key) [subst -nocommands -novariables $item] } elseif { [regexp {^[[:space:]]*[\}][[:space:]]*$} $line] } { set state {} } } } } # Skip locales that don't change time strings. if {![array exists items]} return # Write the Tcl message catalog set f [open $msgFileName w] # Write a header puts $f "\# created by $::argv0 -- do not edit" puts $f "namespace eval ::tcl::clock \{" # Do ordinary sets of strings (weekday and month names) foreach key { DayAbbreviations DayNames MonthAbbreviations MonthNames } tkey { DAYS_OF_WEEK_ABBREV DAYS_OF_WEEK_FULL MONTHS_ABBREV MONTHS_FULL } { if { [info exists items($key)] } { set itemList $items($key) set cmd1 " ::msgcat::mcset " append cmd1 $localeName " " $tkey " \[list " foreach item $itemList { append cmd1 \\\n { } \" [backslashify $item] \" } append cmd1 \] puts $f $cmd1 } } # Do the eras, B.C.E., and C.E. if { [info exists items(Eras)] } { foreach { bce ce } $items(Eras) break set cmd " ::msgcat::mcset " append cmd $localeName " " BCE " \"" [backslashify $bce] \" puts $f $cmd set cmd " ::msgcat::mcset " append cmd $localeName " " CE " \"" [backslashify $ce] \" puts $f $cmd } # Do the AM and PM markers if { [info exists items(AmPmMarkers)] } { foreach { am pm } $items(AmPmMarkers) break set cmd " ::msgcat::mcset " append cmd $localeName " " AM " \"" [backslashify $am] \" puts $f $cmd set cmd " ::msgcat::mcset " append cmd $localeName " " PM " \"" [backslashify $pm] \" puts $f $cmd } # Do the date/time patterns. First date... if { [info exists format($localeName,DATE_FORMAT)] || [info exists items(DateTimePatterns)] } { # Find the shortest date format that includes a 4-digit year. if { ![info exists format($localeName,DATE_FORMAT)] } { for { set i 7 } { $i >= 4 } { incr i -1 } { if { [regexp yyyy [lindex $items(DateTimePatterns) $i]] } { break } } set fmt \ [backslashify \ [percentify [lindex $items(DateTimePatterns) $i]]] set format($localeName,DATE_FORMAT) $fmt } # Put it to the message catalog set cmd " ::msgcat::mcset " append cmd $localeName " DATE_FORMAT \"" \ $format($localeName,DATE_FORMAT) "\"" puts $f $cmd } # Time if { [info exists format($localeName,TIME_FORMAT)] || [info exists items(DateTimePatterns)] } { # Find the shortest time pattern that includes the seconds if { ![info exists format($localeName,TIME_FORMAT)] } { for { set i 3 } { $i >= 0 } { incr i -1 } { if { [regexp H [lindex $items(DateTimePatterns) $i]] && [regexp s [lindex $items(DateTimePatterns) $i]] } { break } } if { $i >= 0 } { set fmt \ [backslashify \ [percentify [lindex $items(DateTimePatterns) $i]]] regsub { %Z} $fmt {} format($localeName,TIME_FORMAT) } } # Put it to the message catalog if { [info exists format($localeName,TIME_FORMAT)] } { set cmd " ::msgcat::mcset " append cmd $localeName " TIME_FORMAT \"" \ $format($localeName,TIME_FORMAT) "\"" puts $f $cmd } } # 12-hour time... if { [info exists format($localeName,TIME_FORMAT_12)] || [info exists items(DateTimePatterns)] } { # Shortest patterm with 12-hour time that includes seconds if { ![info exists format($localeName,TIME_FORMAT_12)] } { for { set i 3 } { $i >= 0 } { incr i -1 } { if { [regexp h [lindex $items(DateTimePatterns) $i]] && [regexp s [lindex $items(DateTimePatterns) $i]] } { break } } if { $i >= 0 } { set fmt \ [backslashify \ [percentify [lindex $items(DateTimePatterns) $i]]] regsub { %Z} $fmt {} format($localeName,TIME_FORMAT_12) } } # Put it to the catalog if { [info exists format($localeName,TIME_FORMAT_12)] } { set cmd " ::msgcat::mcset " append cmd $localeName " TIME_FORMAT_12 \"" \ $format($localeName,TIME_FORMAT_12) "\"" puts $f $cmd } } # Date and time... Prefer 24-hour format to 12-hour format. if { ![info exists format($localeName,DATE_TIME_FORMAT)] && [info exists format($localeName,DATE_FORMAT)] && [info exists format($localeName,TIME_FORMAT)]} { set format($localeName,DATE_TIME_FORMAT) \ $format($localeName,DATE_FORMAT) append format($localeName,DATE_TIME_FORMAT) \ " " $format($localeName,TIME_FORMAT) " %z" } if { ![info exists format($localeName,DATE_TIME_FORMAT)] && [info exists format($localeName,DATE_FORMAT)] && [info exists format($localeName,TIME_FORMAT_12)]} { set format($localeName,DATE_TIME_FORMAT) \ $format($localeName,DATE_FORMAT) append format($localeName,DATE_TIME_FORMAT) \ " " $format($localeName,TIME_FORMAT_12) " %z" } # Write date/time format to the file if { [info exists format($localeName,DATE_TIME_FORMAT)] } { set cmd " ::msgcat::mcset " append cmd $localeName " DATE_TIME_FORMAT \"" \ $format($localeName,DATE_TIME_FORMAT) "\"" puts $f $cmd } # Write the string sets to the file. foreach key { LOCALE_NUMERALS LOCALE_DATE_FORMAT LOCALE_TIME_FORMAT LOCALE_DATE_TIME_FORMAT LOCALE_ERAS LOCALE_YEAR_FORMAT } { if { [info exists format($localeName,$key)] } { set cmd " ::msgcat::mcset " append cmd $localeName " " $key " \"" \ [backslashify $format($localeName,$key)] "\"" puts $f $cmd } } # Footer puts $f "\}" close $f } #---------------------------------------------------------------------- # # percentify -- # # Converts a Java/ICU-style time format to a C/Tcl style one. # # Parameters: # string -- Format to convert # # Results: # Returns the converted format. # # Side effects: # None. # #---------------------------------------------------------------------- proc percentify { string } { set retval {} foreach { unquoted quoted } [split $string '] { append retval [string map { EEEE %A MMMM %B yyyy %Y MMM %b EEE %a dd %d hh %I HH %H mm %M MM %m ss %S yy %y a %P d %e h %l H %k M %m z %z } $unquoted] append retval $quoted } return $retval } #---------------------------------------------------------------------- # # backslashify -- # # Converts a UTF-8 string to a plain ASCII one with escapes. # # Parameters: # string -- String to convert # # Results: # Returns the converted string # # Side effects: # None. # #---------------------------------------------------------------------- proc backslashify { string } { set retval {} foreach char [split $string {}] { scan $char %c ccode if { $ccode >= 0x20 && $ccode < 0x7F && $char ne "\"" && $char ne "\{" && $char ne "\}" && $char ne "\[" && $char ne "\]" && $char ne "\\" && $char ne "\$" } { append retval $char } else { append retval \\u [format %04x $ccode] } } return $retval } #---------------------------------------------------------------------- # # MAIN PROGRAM # #---------------------------------------------------------------------- # Extract directories from command line foreach { icudir msgdir } $argv break # Walk the ICU files and create corresponding Tcl message catalogs foreach fileName [glob -directory $icudir *.txt] { set n [file rootname [file tail $fileName]] if { [regexp {^[a-z]{2,3}(_[A-Z]{2,3}(_.*)?)?$} $n] } { handleLocaleFile $n $fileName [file join $msgdir [string tolower $n].msg] } } tcl8.6.14/tools/makeTestCases.tcl0000755000175000017500000007765014554262142016264 0ustar sergeisergei# TODO - When integrating this with the Core, path names will need to be # swizzled here. package require msgcat set d [file dirname [file dirname [info script]]] puts "getting transition data from [file join $d library tzdata America Detroit]" source [file join $d library/tzdata/America/Detroit] namespace eval ::tcl::clock { ::msgcat::mcmset en_US_roman { LOCALE_ERAS { {-62164627200 {} 0} {-59008867200 c 100} {-55853107200 cc 200} {-52697347200 ccc 300} {-49541587200 cd 400} {-46385827200 d 500} {-43230067200 dc 600} {-40074307200 dcc 700} {-36918547200 dccc 800} {-33762787200 cm 900} {-30607027200 m 1000} {-27451267200 mc 1100} {-24295507200 mcc 1200} {-21139747200 mccc 1300} {-17983987200 mcd 1400} {-14828227200 md 1500} {-11672467200 mdc 1600} {-8516707200 mdcc 1700} {-5364662400 mdccc 1800} {-2208988800 mcm 1900} {946684800 mm 2000} } LOCALE_NUMERALS { ? i ii iii iv v vi vii viii ix x xi xii xiii xiv xv xvi xvii xviii xix xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix l li lii liii liv lv lvi lvii lviii lix lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii lxxxix xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix c } DATE_FORMAT {%m/%d/%Y} TIME_FORMAT {%H:%M:%S} DATE_TIME_FORMAT {%x %X} LOCALE_DATE_FORMAT {die %Od mensis %Om annoque %EY} LOCALE_TIME_FORMAT {%OH h %OM m %OS s} LOCALE_DATE_TIME_FORMAT {%Ex %EX} } } #---------------------------------------------------------------------- # # listYears -- # # List the years to test in the common clock test cases. # # Parameters: # startOfYearArray - Name of an array in caller's scope that will # be initialized as # Results: # None # # Side effects: # Determines the year numbers of one common year, one leap year, one year # following a common year, and one year following a leap year -- starting # on each day of the week -- in the XIXth, XXth and XXIth centuries. # Initializes the given array to have keys equal to the year numbers and # values equal to [clock seconds] at the start of the corresponding # years. # #---------------------------------------------------------------------- proc listYears { startOfYearArray } { upvar 1 $startOfYearArray startOfYear # List years after 1970 set y 1970 set s 0 set dw 4 ;# Thursday while { $y < 2100 } { if { $y % 4 == 0 && $y % 100 != 0 || $y % 400 == 0 } { set l 1 incr dw 366 set s2 [expr { $s + wide( 366 * 86400 ) }] } else { set l 0 incr dw 365 set s2 [expr { $s + wide( 365 * 86400 ) }] } set x [expr { $y >= 2037 }] set dw [expr {$dw % 7}] set c [expr { $y / 100 }] if { ![info exists do($x$c$dw$l)] } { set do($x$c$dw$l) $y set startOfYear($y) $s set startOfYear([expr {$y + 1}]) $s2 } set s $s2 incr y } # List years before 1970 set y 1970 set s 0 set dw 4; # Thursday while { $y >= 1801 } { set s0 $s incr dw 371 incr y -1 if { $y % 4 == 0 && $y % 100 != 0 || $y % 400 == 0 } { set l 1 incr dw -366 set s [expr { $s - wide(366 * 86400) }] } else { set l 0 incr dw -365 set s [expr { $s - wide(365 * 86400) }] } set dw [expr {$dw % 7}] set c [expr { $y / 100 }] if { ![info exists do($c$dw$l)] } { set do($c$dw$l) $y set startOfYear($y) $s set startOfYear([expr {$y + 1}]) $s0 } } } #---------------------------------------------------------------------- # # processFile - # # Processes the 'clock.test' file, updating the test cases in it. # # Parameters: # None. # # Side effects: # Replaces the file with a new copy, constructing needed test cases. # #---------------------------------------------------------------------- proc processFile {d} { # Open two files set f1 [open [file join $d tests/clock.test] r] set f2 [open [file join $d tests/clock.new] w] # Copy leading portion of the test file set state {} while { [gets $f1 line] >= 0 } { switch -exact -- $state { {} { puts $f2 $line if { [regexp "^\# BEGIN (.*)" $line -> cases] && [string compare {} [info commands $cases]] } { set state inCaseSet $cases $f2 } } inCaseSet { if { [regexp "^\#\ END $cases\$" $line] } { puts $f2 $line set state {} } } } } # Rotate the files close $f1 close $f2 file delete -force [file join $d tests/clock.bak] file rename -force [file join $d tests/clock.test] \ [file join $d tests/clock.bak] file rename [file join $d tests/clock.new] [file join $d tests/clock.test] } #---------------------------------------------------------------------- # # testcases2 -- # # Outputs the 'clock-2.x' test cases. # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for formatting in Gregorian calendar are written to the # output file. # #---------------------------------------------------------------------- proc testcases2 { f2 } { listYears startOfYear # Define the roman numerals set roman { ? i ii iii iv v vi vii viii ix x xi xii xiii xiv xv xvi xvii xviii xix xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix l li lii liii liv lv lvi lvii lviii lix lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii lxxxix xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix c } set romanc { ? c cc ccc cd d dc dcc dccc cm m mc mcc mccc mcd md mdc mdcc mdccc mcm mm mmc mmcc mmccc mmcd mmd mmdc mmdcc mmdccc mmcm mmm mmmc mmmcc mmmccc mmmcd mmmd mmmdc mmmdcc mmmdccc mmmcm } # Names of the months set short {{} Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} set long { {} January February March April May June July August September October November December } # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test formatting of Gregorian year, month, day, all formats" puts $f2 "\# Formats tested: %b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y %EY" puts $f2 "" # Generate the test cases for the first and last day of every month # from 1896 to 2045 set n 0 foreach { y } [lsort -integer [array names startOfYear]] { set s [expr { $startOfYear($y) + wide(12*3600 + 34*60 + 56) }] set m 0 set yd 1 foreach hath { 31 28 31 30 31 30 31 31 30 31 30 31 } { incr m if { $m == 2 && ( $y%4 == 0 && $y%100 != 0 || $y%400 == 0 ) } { incr hath } set b [lindex $short $m] set B [lindex $long $m] set C [format %02d [expr { $y / 100 }]] set h $b set j [format %03d $yd] set mm [format %02d $m] set N [format %2d $m] set yy [format %02d [expr { $y % 100 }]] set J [expr { ( $s / 86400 ) + 2440588 }] set dt $y-$mm-01 set result "" append result $b " " $B " " \ $mm /01/ $y " 12:34:56 " \ "die i mensis " [lindex $roman $m] " annoque " \ [lindex $romanc [expr { $y / 100 }]] \ [lindex $roman [expr { $y % 100 }]] " " \ [lindex $roman 12] " h " [lindex $roman 34] " m " \ [lindex $roman 56] " s " \ $C " " [lindex $romanc [expr { $y / 100 }]] \ " 01 i 1 i " \ $h " " $j " " $J " " $mm " " [lindex $roman $m] " " $N \ " " $mm "/01/" $y \ " die i mensis " [lindex $roman $m] " annoque " \ [lindex $romanc [expr { $y / 100 }]] \ [lindex $roman [expr { $y % 100 }]] \ " " $yy " " [lindex $roman [expr { $y % 100 }]] " " $y puts $f2 "test clock-2.[incr n] {conversion of $dt} {" puts $f2 " clock format $s \\" puts $f2 "\t-format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \\" puts $f2 "\t-gmt true -locale en_US_roman" puts $f2 "} {$result}" set hm1 [expr { $hath - 1 }] incr s [expr { 86400 * ( $hath - 1 ) }] incr yd $hm1 set dd [format %02d $hath] set ee [format %2d $hath] set j [format %03d $yd] set J [expr { ( $s / 86400 ) + 2440588 }] set dt $y-$mm-$dd set result "" append result $b " " $B " " \ $mm / $dd / $y " 12:34:56 " \ "die " [lindex $roman $hath] " mensis " [lindex $roman $m] \ " annoque " \ [lindex $romanc [expr { $y / 100 }]] \ [lindex $roman [expr { $y % 100 }]] " " \ [lindex $roman 12] " h " [lindex $roman 34] " m " \ [lindex $roman 56] " s " \ $C " " [lindex $romanc [expr { $y / 100 }]] \ " " $dd " " [lindex $roman $hath] " " \ $ee " " [lindex $roman $hath] " "\ $h " " $j " " $J " " $mm " " [lindex $roman $m] " " $N \ " " $mm "/" $dd "/" $y \ " die " [lindex $roman $hath] " mensis " [lindex $roman $m] \ " annoque " \ [lindex $romanc [expr { $y / 100 }]] \ [lindex $roman [expr { $y % 100 }]] \ " " $yy " " [lindex $roman [expr { $y % 100 }]] " " $y puts $f2 "test clock-2.[incr n] {conversion of $dt} {" puts $f2 " clock format $s \\" puts $f2 "\t-format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \\" puts $f2 "\t-gmt true -locale en_US_roman" puts $f2 "} {$result}" incr s 86400 incr yd } } puts "testcases2: $n test cases" } #---------------------------------------------------------------------- # # testcases3 -- # # Generate test cases for ISO8601 calendar. # # Parameters: # f2 - Channel handle to the output file # # Results: # None # # Side effects: # Makes a test case for the first and last day of weeks 51, 52, and 1 # plus the first and last day of a year. Does so for each possible # weekday on which a Common Year or Leap Year can begin. # #---------------------------------------------------------------------- proc testcases3 { f2 } { listYears startOfYear set case 0 foreach { y } [lsort -integer [array names startOfYear]] { set secs $startOfYear($y) set ym1 [expr { $y - 1 }] set dow [expr { ( $secs / 86400 + 4 ) % 7}] switch -exact $dow { 0 { # Year starts on a Sunday. # Prior year started on a Friday or Saturday, and was # a 52-week year. # 1 January is ISO week 52 of the prior year. 2 January # begins ISO week 1 of the current year. # 1 January is week 1 according to %U. According to %W, # week 1 begins on 2 January testISO $f2 $ym1 52 1 [expr { $secs - 6*86400 }] testISO $f2 $ym1 52 6 [expr { $secs - 86400 }] testISO $f2 $ym1 52 7 $secs testISO $f2 $y 1 1 [expr { $secs + 86400 }] testISO $f2 $y 1 6 [expr { $secs + 6*86400}] testISO $f2 $y 1 7 [expr { $secs + 7*86400 }] testISO $f2 $y 2 1 [expr { $secs + 8*86400 }] } 1 { # Year starts on a Monday. # Previous year started on a Saturday or Sunday, and was # a 52-week year. # 1 January is ISO week 1 of the current year # According to %U, it's week 0 until 7 January # 1 January is week 1 according to %W testISO $f2 $ym1 52 1 [expr { $secs - 7*86400 }] testISO $f2 $ym1 52 6 [expr {$secs - 2*86400}] testISO $f2 $ym1 52 7 [expr { $secs - 86400 }] testISO $f2 $y 1 1 $secs testISO $f2 $y 1 6 [expr {$secs + 5*86400}] testISO $f2 $y 1 7 [expr { $secs + 6*86400 }] testISO $f2 $y 2 1 [expr { $secs + 7*86400 }] } 2 { # Year starts on a Tuesday. testISO $f2 $ym1 52 1 [expr { $secs - 8*86400 }] testISO $f2 $ym1 52 6 [expr {$secs - 3*86400}] testISO $f2 $ym1 52 7 [expr { $secs - 2*86400 }] testISO $f2 $y 1 1 [expr { $secs - 86400 }] testISO $f2 $y 1 2 $secs testISO $f2 $y 1 6 [expr {$secs + 4*86400}] testISO $f2 $y 1 7 [expr { $secs + 5*86400 }] testISO $f2 $y 2 1 [expr { $secs + 6*86400 }] } 3 { testISO $f2 $ym1 52 1 [expr { $secs - 9*86400 }] testISO $f2 $ym1 52 6 [expr {$secs - 4*86400}] testISO $f2 $ym1 52 7 [expr { $secs - 3*86400 }] testISO $f2 $y 1 1 [expr { $secs - 2*86400 }] testISO $f2 $y 1 3 $secs testISO $f2 $y 1 6 [expr {$secs + 3*86400}] testISO $f2 $y 1 7 [expr { $secs + 4*86400 }] testISO $f2 $y 2 1 [expr { $secs + 5*86400 }] } 4 { testISO $f2 $ym1 52 1 [expr { $secs - 10*86400 }] testISO $f2 $ym1 52 6 [expr {$secs - 5*86400}] testISO $f2 $ym1 52 7 [expr { $secs - 4*86400 }] testISO $f2 $y 1 1 [expr { $secs - 3*86400 }] testISO $f2 $y 1 4 $secs testISO $f2 $y 1 6 [expr {$secs + 2*86400}] testISO $f2 $y 1 7 [expr { $secs + 3*86400 }] testISO $f2 $y 2 1 [expr { $secs + 4*86400 }] } 5 { testISO $f2 $ym1 53 1 [expr { $secs - 4*86400 }] testISO $f2 $ym1 53 5 $secs testISO $f2 $ym1 53 6 [expr {$secs + 86400}] testISO $f2 $ym1 53 7 [expr { $secs + 2*86400 }] testISO $f2 $y 1 1 [expr { $secs + 3*86400 }] testISO $f2 $y 1 6 [expr {$secs + 8*86400}] testISO $f2 $y 1 7 [expr { $secs + 9*86400 }] testISO $f2 $y 2 1 [expr { $secs + 10*86400 }] } 6 { # messy case because previous year may have had 52 or 53 weeks if { $y%4 == 1 } { testISO $f2 $ym1 53 1 [expr { $secs - 5*86400 }] testISO $f2 $ym1 53 6 $secs testISO $f2 $ym1 53 7 [expr { $secs + 86400 }] } else { testISO $f2 $ym1 52 1 [expr { $secs - 5*86400 }] testISO $f2 $ym1 52 6 $secs testISO $f2 $ym1 52 7 [expr { $secs + 86400 }] } testISO $f2 $y 1 1 [expr { $secs + 2*86400 }] testISO $f2 $y 1 6 [expr { $secs + 7*86400 }] testISO $f2 $y 1 7 [expr { $secs + 8*86400 }] testISO $f2 $y 2 1 [expr { $secs + 9*86400 }] } } } puts "testcases3: $case test cases." } proc testISO { f2 G V u secs } { upvar 1 case case set longdays {Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sunday} set shortdays {Sun Mon Tue Wed Thu Fri Sat Sun} puts $f2 "test clock-3.[incr case] {ISO week-based calendar [format %04d-W%02d-%d $G $V $u]} {" puts $f2 " clock format $secs -format {%a %A %g %G %u %U %V %w %W} -gmt true; \# $G-W[format %02d $V]-$u" puts $f2 "} {[lindex $shortdays $u] [lindex $longdays $u]\ [format %02d [expr { $G % 100 }]] $G\ $u\ [clock format $secs -format %U -gmt true]\ [format %02d $V] [expr { $u % 7 }]\ [clock format $secs -format %W -gmt true]}" } #---------------------------------------------------------------------- # # testcases4 -- # # Makes the test cases that test formatting of time of day. # # Parameters: # f2 - Channel handle to the output file # # Results: # None. # # Side effects: # Writes test cases to the output. # #---------------------------------------------------------------------- proc testcases4 { f2 } { puts $f2 {} puts $f2 "\# Test formatting of time of day" puts $f2 "\# Format groups tested: %H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+" puts $f2 {} set i 0 set fmt "%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+" foreach { h romanH I romanI am } { 0 ? 12 xii AM 1 i 1 i AM 11 xi 11 xi AM 12 xii 12 xii PM 13 xiii 1 i PM 23 xxiii 11 xi PM } { set hh [format %02d $h] set II [format %02d $I] set hs [format %2d $h] set Is [format %2d $I] foreach { m romanM } { 0 ? 1 i 58 lviii 59 lix } { set mm [format %02d $m] foreach { s romanS } { 0 ? 1 i 58 lviii 59 lix } { set ss [format %02d $s] set x [expr { ( $h * 60 + $m ) * 60 + $s }] set result "" append result $hh " " $romanH " " $II " " $romanI " " \ $hs " " $romanH " " $Is " " $romanI " " $mm " " $romanM " " \ $am " " [string tolower $am] " " \ $II ":" $mm ":" $ss " " [string tolower $am] " " \ $hh ":" $mm " " \ $ss " " $romanS " " \ $hh ":" $mm ":" $ss " " \ $hh ":" $mm ":" $ss " " \ $romanH " h " $romanM " m " $romanS " s " \ "Thu Jan 1 " $hh : $mm : $ss " GMT 1970" puts $f2 "test clock-4.[incr i] { format time of day $hh:$mm:$ss } {" puts $f2 " clock format $x \\" puts $f2 " -format [list $fmt] \\" puts $f2 " -locale en_US_roman \\" puts $f2 " -gmt true" puts $f2 "} {$result}" } } } puts "testcases4: $i test cases." } #---------------------------------------------------------------------- # # testcases5 -- # # Generates the test cases for Daylight Saving Time # # Parameters: # f2 - Channel handle for the input file # # Results: # None. # # Side effects: # Makes test cases for each known or anticipated time change # in Detroit. # #---------------------------------------------------------------------- proc testcases5 { f2 } { variable TZData puts $f2 {} puts $f2 "\# Test formatting of Daylight Saving Time" puts $f2 {} set fmt {%H:%M:%S %z %Z} set i 0 puts $f2 "test clock-5.[incr i] {does Detroit exist} {" puts $f2 " clock format 0 -format {} -timezone :America/Detroit" puts $f2 " concat" puts $f2 "} {}" puts $f2 "test clock-5.[incr i] {does Detroit have a Y2038 problem} detroit {" puts $f2 " if { \[clock format 2158894800 -format %z -timezone :America/Detroit\] ne {-0400} } {" puts $f2 " concat {y2038 problem}" puts $f2 " } else {" puts $f2 " concat {ok}" puts $f2 " }" puts $f2 "} ok" foreach row $TZData(:America/Detroit) { foreach { t offset isdst tzname } $row break if { $t > -4000000000000 } { set conds [list detroit] if { $t > wide(0x7FFFFFFF) } { set conds [list detroit y2038] } incr t -1 set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ -timezone :America/Detroit] set r [clock format $t -format $fmt \ -timezone :America/Detroit] puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" puts $f2 " clock format $t -format [list $fmt] \\" puts $f2 " -timezone :America/Detroit" puts $f2 "} [list $r]" incr t set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ -timezone :America/Detroit] set r [clock format $t -format $fmt \ -timezone :America/Detroit] puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" puts $f2 " clock format $t -format [list $fmt] \\" puts $f2 " -timezone :America/Detroit" puts $f2 "} [list $r]" incr t set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ -timezone :America/Detroit] set r [clock format $t -format $fmt \ -timezone :America/Detroit] puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" puts $f2 " clock format $t -format [list $fmt] \\" puts $f2 " -timezone :America/Detroit" puts $f2 "} [list $r]" } } puts "testcases5: $i test cases" } #---------------------------------------------------------------------- # # testcases8 -- # # Outputs the 'clock-8.x' test cases. # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for parsing dates in ccyymmdd format are written to the # output file. # #---------------------------------------------------------------------- proc testcases8 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of ccyymmdd" puts $f2 "" set n 0 foreach year {1970 1971 2000 2001} { foreach month {01 12} { foreach day {02 31} { set scanned [clock scan $year$month$day -gmt true] foreach ccyy {%C%y %Y} { foreach mm {%b %B %h %m %Om %N} { foreach dd {%d %Od %e %Oe} { set string [clock format $scanned \ -format "$ccyy $mm $dd" \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-8.[incr n] {parse ccyymmdd} {" puts $f2 " [list clock scan $string -format [list $ccyy $mm $dd] -locale en_US_roman -gmt 1]" puts $f2 "} $scanned" } } } foreach fmt {%x %D} { set string [clock format $scanned \ -format $fmt \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-8.[incr n] {parse ccyymmdd} {" puts $f2 " [list clock scan $string -format $fmt -locale en_US_roman -gmt 1]" puts $f2 "} $scanned" } } } } puts "testcases8: $n test cases" } #---------------------------------------------------------------------- # # testcases11 -- # # Outputs the 'clock-11.x' test cases. # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for precedence among YYYYMMDD and YYYYDDD are written # to f2. # #---------------------------------------------------------------------- proc testcases11 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test precedence among yyyymmdd and yyyyddd" puts $f2 "" array set v { Y 1970 m 01 d 01 j 002 } set n 0 foreach {a b c d} { Y m d j m Y d j d Y m j j Y m d Y m j d m Y j d d Y j m j Y d m Y d m j m d Y j d m Y j j m Y d Y d j m m d j Y d m j Y j m d Y Y j m d m j Y d d j Y m j d Y m Y j d m m j d Y d j m Y j d m Y } { foreach x [list $a $b $c $d] { switch -exact -- $x { m - d { set value 0 } j { set value 86400 } } } set format "%$a%$b%$c%$d" set string "$v($a)$v($b)$v($c)$v($d)" puts $f2 "test clock-11.[incr n] {precedence of ccyyddd and ccyymmdd} {" puts $f2 " [list clock scan $string -format $format -gmt 1]" puts $f2 "} $value" } puts "testcases11: $n test cases" } #---------------------------------------------------------------------- # # testcases12 -- # # Outputs the 'clock-12.x' test cases, parsing CCyyWwwd # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for parsing dates in Gregorian calendar are written to the # output file. # #---------------------------------------------------------------------- proc testcases12 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of ccyyWwwd" puts $f2 "" set n 0 foreach year {1970 1971 2000 2001} { foreach month {01 12} { foreach day {02 31} { set scanned [clock scan $year$month$day -gmt true] foreach d {%a %A %u %w %Ou %Ow} { set string [clock format $scanned \ -format "%G W%V $d" \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-12.[incr n] {parse ccyyWwwd} {" puts $f2 " [list clock scan $string -format [list %G W%V $d] -locale en_US_roman -gmt 1]" puts $f2 "} $scanned" } } } } puts "testcases12: $n test cases" } #---------------------------------------------------------------------- # # testcases14 -- # # Outputs the 'clock-14.x' test cases. # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for parsing yymmdd dates are output. # #---------------------------------------------------------------------- proc testcases14 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of yymmdd" puts $f2 "" set n 0 foreach year {1938 1970 2000 2037} { foreach month {01 12} { foreach day {02 31} { set scanned [clock scan $year$month$day -gmt true] foreach yy {%y %Oy} { foreach mm {%b %B %h %m %Om %N} { foreach dd {%d %Od %e %Oe} { set string [clock format $scanned \ -format "$yy $mm $dd" \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-14.[incr n] {parse yymmdd} {" puts $f2 " [list clock scan $string -format [list $yy $mm $dd] -locale en_US_roman -gmt 1]" puts $f2 "} $scanned" } } } } } } puts "testcases14: $n test cases" } #---------------------------------------------------------------------- # # testcases17 -- # # Outputs the 'clock-17.x' test cases, parsing yyWwwd # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for parsing dates in Gregorian calendar are written to the # output file. # #---------------------------------------------------------------------- proc testcases17 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of yyWwwd" puts $f2 "" set n 0 foreach year {1970 1971 2000 2001} { foreach month {01 12} { foreach day {02 31} { set scanned [clock scan $year$month$day -gmt true] foreach d {%a %A %u %w %Ou %Ow} { set string [clock format $scanned \ -format "%g W%V $d" \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-17.[incr n] {parse yyWwwd} {" puts $f2 " [list clock scan $string -format [list %g W%V $d] -locale en_US_roman -gmt 1]" puts $f2 "} $scanned" } } } } puts "testcases17: $n test cases" } #---------------------------------------------------------------------- # # testcases19 -- # # Outputs the 'clock-19.x' test cases. # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for parsing mmdd dates are output. # #---------------------------------------------------------------------- proc testcases19 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of mmdd" puts $f2 "" set n 0 foreach year {1938 1970 2000 2037} { set base [clock scan ${year}0101 -gmt true] foreach month {01 12} { foreach day {02 31} { set scanned [clock scan $year$month$day -gmt true] foreach mm {%b %B %h %m %Om %N} { foreach dd {%d %Od %e %Oe} { set string [clock format $scanned \ -format "$mm $dd" \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-19.[incr n] {parse mmdd} {" puts $f2 " [list clock scan $string -format [list $mm $dd] -locale en_US_roman -base $base -gmt 1]" puts $f2 "} $scanned" } } } } } puts "testcases19: $n test cases" } #---------------------------------------------------------------------- # # testcases21 -- # # Outputs the 'clock-21.x' test cases, parsing Wwwd # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for parsing dates in Gregorian calendar are written to the # output file. # #---------------------------------------------------------------------- proc testcases22 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of Wwwd" puts $f2 "" set n 0 foreach year {1970 1971 2000 2001} { set base [clock scan ${year}0104 -gmt true] foreach month {03 10} { foreach day {01 31} { set scanned [clock scan $year$month$day -gmt true] foreach d {%a %A %u %w %Ou %Ow} { set string [clock format $scanned \ -format "W%V $d" \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-22.[incr n] {parse Wwwd} {" puts $f2 " [list clock scan $string -format [list W%V $d] -locale en_US_roman -gmt 1] -base $base" puts $f2 "} $scanned" } } } } puts "testcases22: $n test cases" } #---------------------------------------------------------------------- # # testcases24 -- # # Outputs the 'clock-24.x' test cases. # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for parsing naked day of the month are output. # #---------------------------------------------------------------------- proc testcases24 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of naked day-of-month" puts $f2 "" set n 0 foreach year {1970 2000} { foreach month {01 12} { set base [clock scan ${year}${month}01 -gmt true] foreach day {02 28} { set scanned [clock scan $year$month$day -gmt true] foreach dd {%d %Od %e %Oe} { set string [clock format $scanned \ -format "$dd" \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-24.[incr n] {parse naked day of month} {" puts $f2 " [list clock scan $string -format $dd -locale en_US_roman -base $base -gmt 1]" puts $f2 "} $scanned" } } } } puts "testcases24: $n test cases" } #---------------------------------------------------------------------- # # testcases26 -- # # Outputs the 'clock-26.x' test cases, parsing naked day of week # # Parameters: # f2 -- Channel handle to the output file # # Results: # None. # # Side effects: # Test cases for parsing dates in Gregorian calendar are written to the # output file. # #---------------------------------------------------------------------- proc testcases26 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of naked day of week" puts $f2 "" set n 0 foreach year {1970 2001} { foreach week {01 52} { set base [clock scan ${year}W${week}4 \ -format %GW%V%u -gmt true] foreach day {1 7} { set scanned [clock scan ${year}W${week}${day} \ -format %GW%V%u -gmt true] foreach d {%a %A %u %w %Ou %Ow} { set string [clock format $scanned \ -format "$d" \ -locale en_US_roman \ -gmt true] puts $f2 "test clock-26.[incr n] {parse naked day of week} {" puts $f2 " [list clock scan $string -format $d -locale en_US_roman -gmt 1] -base $base" puts $f2 "} $scanned" } } } } puts "testcases26: $n test cases" } #---------------------------------------------------------------------- # # testcases29 -- # # Makes test cases for parsing of time of day. # # Parameters: # f2 -- Channel where tests are to be written # # Results: # None. # # Side effects: # Writes the tests. # #---------------------------------------------------------------------- proc testcases29 { f2 } { # Put out a header describing the tests puts $f2 "" puts $f2 "\# Test parsing of time of day" puts $f2 "" set n 0 foreach hour {0 1 11 12 13 23} \ hampm {12 1 11 12 1 11} \ lhour {? i xi xii xiii xxiii} \ lhampm {xii i xi xii i xi} \ ampmind {am am am pm pm pm} { set sphr [format %2d $hour] set 2dhr [format %02d $hour] set sphampm [format %2d $hampm] set 2dhampm [format %02d $hampm] set AMPMind [string toupper $ampmind] foreach minute {00 01 59} lminute {? i lix} { foreach second {00 01 59} lsecond {? i lix} { set time [expr { ( 60 * $hour + $minute ) * 60 + $second }] foreach {hfmt afmt} [list \ %H {} %k {} %OH {} %Ok {} \ %I %p %l %p \ %OI %p %Ol %p \ %I %P %l %P \ %OI %P %Ol %P] \ {hfld afld} [list \ $2dhr {} $sphr {} $lhour {} $lhour {} \ $2dhampm $AMPMind $sphampm $AMPMind \ $lhampm $AMPMind $lhampm $AMPMind \ $2dhampm $ampmind $sphampm $ampmind \ $lhampm $ampmind $lhampm $ampmind] \ { if { $second eq "00" } { if { $minute eq "00" } { puts $f2 "test clock-29.[incr n] {time parsing} {" puts $f2 " clock scan {2440588 $hfld $afld} \\" puts $f2 " -gmt true -locale en_US_roman \\" puts $f2 " -format {%J $hfmt $afmt}" puts $f2 "} $time" } puts $f2 "test clock-29.[incr n] {time parsing} {" puts $f2 " clock scan {2440588 $hfld:$minute $afld} \\" puts $f2 " -gmt true -locale en_US_roman \\" puts $f2 " -format {%J $hfmt:%M $afmt}" puts $f2 "} $time" puts $f2 "test clock-29.[incr n] {time parsing} {" puts $f2 " clock scan {2440588 $hfld:$lminute $afld} \\" puts $f2 " -gmt true -locale en_US_roman \\" puts $f2 " -format {%J $hfmt:%OM $afmt}" puts $f2 "} $time" } puts $f2 "test clock-29.[incr n] {time parsing} {" puts $f2 " clock scan {2440588 $hfld:$minute:$second $afld} \\" puts $f2 " -gmt true -locale en_US_roman \\" puts $f2 " -format {%J $hfmt:%M:%S $afmt}" puts $f2 "} $time" puts $f2 "test clock-29.[incr n] {time parsing} {" puts $f2 " clock scan {2440588 $hfld:$lminute:$lsecond $afld} \\" puts $f2 " -gmt true -locale en_US_roman \\" puts $f2 " -format {%J $hfmt:%OM:%OS $afmt}" puts $f2 "} $time" } } } } puts "testcases29: $n test cases" } processFile $d tcl8.6.14/tools/man2help2.tcl0000644000175000017500000005134314554262142015304 0ustar sergeisergei# man2help2.tcl -- # # This file defines procedures that are used during the second pass of # the man page conversion. It converts the man format input to rtf # form suitable for use by the Windows help compiler. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # Global variables used by these scripts: # # state - state variable that controls action of text proc. # # topics - array indexed by (package,section,topic) with value # of topic ID. # # keywords - array indexed by keyword string with value of topic ID. # # curID - current topic ID, starts at 0 and is incremented for # each new topic file. # # curPkg - current package name (e.g. Tcl). # # curSect - current section title (e.g. "Tcl Built-In Commands"). # # initGlobals -- # # This procedure is invoked to set the initial values of all of the # global variables, before processing a man page. # # Arguments: # None. proc initGlobals {} { uplevel \#0 unset state global state chars set state(paragraphPending) 0 set state(breakPending) 0 set state(firstIndent) 0 set state(leftIndent) 0 set state(inTP) 0 set state(paragraph) 0 set state(textState) 0 set state(curFont) "" set state(startCode) "{\\b " set state(startEmphasis) "{\\i " set state(endCode) "}" set state(endEmphasis) "}" set state(noFill) 0 set state(charCnt) 0 set state(offset) [getTwips 0.5i] set state(leftMargin) [getTwips 0.5i] set state(nestingLevel) 0 set state(intl) 0 set state(sb) 0 setTabs 0.5i # set up international character table array set chars { o^ F4 } } # beginFont -- # # Arranges for future text to use a special font, rather than # the default paragraph font. # # Arguments: # font - Name of new font to use. proc beginFont {font} { global file state textSetup if {[string equal $state(curFont) $font]} { return } endFont puts -nonewline $file $state(start$font) set state(curFont) $font } # endFont -- # # Reverts to the default font for the paragraph type. # # Arguments: # None. proc endFont {} { global state file if {[string compare $state(curFont) ""]} { puts -nonewline $file $state(end$state(curFont)) set state(curFont) "" } } # textSetup -- # # This procedure is called the first time that text is output for a # paragraph. It outputs the header information for the paragraph. # # Arguments: # None. proc textSetup {} { global file state if $state(breakPending) { puts $file "\\line" } if $state(paragraphPending) { puts $file [format "\\par\n\\pard\\fi%.0f\\li%.0f" \ $state(firstIndent) $state(leftIndent)] foreach tab $state(tabs) { puts $file [format "\\tx%.0f" $tab] } set state(tabs) {} if {$state(sb)} { puts $file "\\sb$state(sb)" set state(sb) 0 } } set state(breakPending) 0 set state(paragraphPending) 0 } # text -- # # This procedure adds text to the current state(paragraph). If this is # the first text in the state(paragraph) then header information for the # state(paragraph) is output before the text. # # Arguments: # string - Text to output in the state(paragraph). proc text {string} { global file state chars textSetup set string [string map [list \ "\\" "\\\\" \ "\{" "\\\{" \ "\}" "\\\}" \ "\t" {\tab } \ '' "\\rdblquote " \ `` "\\ldblquote " \ "\xB7" "\\bullet " \ ] $string] # Check if this is the beginning of an international character string. # If so, look up the sequence in the chars table and substitute the # appropriate hex value. if {$state(intl)} { if {[regexp {^'([^']*)'} $string dummy ch]} { if {[info exists chars($ch)]} { regsub {^'[^']*'} $string "\\\\'$chars($ch)" string } else { puts stderr "Unknown international character '$ch'" } } set state(intl) 0 } switch $state(textState) { REF { if {$state(inTP) == 0} { set string [insertRef $string] } } SEE { global topics curPkg curSect foreach i [split $string] { if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} { continue } if {![catch {set ref $topics($curPkg,$curSect,$i)} ]} { regsub $i $string [link $i $ref] string } } } KEY { return } } puts -nonewline $file "$string" } # insertRef -- # # This procedure looks for a string in the cross reference table and # generates a hot-link to the appropriate topic. Tries to find the # nearest reference in the manual. # # Arguments: # string - Text to output in the state(paragraph). proc insertRef {string} { global NAME_file curPkg curSect topics curID set path {} set string [string trim $string] set ref {} if {[info exists topics($curPkg,$curSect,$string)]} { set ref $topics($curPkg,$curSect,$string) } else { set sites [array names topics "$curPkg,*,$string"] set count [llength $sites] if {$count > 0} { set ref $topics([lindex $sites 0]) } else { set sites [array names topics "*,*,$string"] set count [llength $sites] if {$count > 0} { set ref $topics([lindex $sites 0]) } } } if {($ref != "") && ($ref != $curID)} { set string [link $string $ref] } return $string } # macro -- # # This procedure is invoked to process macro invocations that start # with "." (instead of '). # # Arguments: # name - The name of the macro (without the "."). # args - Any additional arguments to the macro. proc macro {name args} { global state file switch $name { AP { if {[llength $args] != 3 && [llength $args] != 2} { puts stderr "Bad .AP macro: .$name [join $args " "]" } newPara 3.75i -3.75i setTabs {1.25i 2.5i 3.75i} font B text [lindex $args 0] tab font I text [lindex $args 1] tab font R if {[llength $args] == 3} { text "([lindex $args 2])" } tab } AS { # next page and previous page } br { lineBreak } BS {} BE {} CE { puts -nonewline $::file "\\f0\\fs20 " set state(noFill) 0 set state(breakPending) 0 newPara "" set state(leftIndent) [expr {$state(leftIndent) - $state(offset)}] set state(sb) 80 } CS { # code section set state(noFill) 1 newPara "" set state(leftIndent) [expr {$state(leftIndent) + $state(offset)}] set state(sb) 80 puts -nonewline $::file "\\f1\\fs18 " } DE { set state(noFill) 0 decrNestingLevel newPara 0i } DS { set state(noFill) 1 incrNestingLevel newPara 0i } fi { set state(noFill) 0 } IP { IPmacro $args } LP { newPara 0i set state(sb) 80 } ne { } nf { set state(noFill) 1 } OP { if {[llength $args] != 3} { puts stderr "Bad .OP macro: .$name [join $args " "]" } set state(nestingLevel) 0 newPara 0i set state(sb) 120 setTabs 4c text "Command-Line Name:" tab font B set x [lindex $args 0] regsub -all {\\-} $x - x text $x lineBreak font R text "Database Name:" tab font B text [lindex $args 1] lineBreak font R text "Database Class:" tab font B text [lindex $args 2] font R set state(inTP) 0 newPara 0.5i set state(sb) 80 } PP { newPara 0i set state(sb) 120 } RE { decrNestingLevel } RS { incrNestingLevel } SE { font R set state(noFill) 0 set state(nestingLevel) 0 newPara 0i text "See the " font B set temp $state(textState) set state(textState) REF text options set state(textState) $temp font R text " manual entry for detailed descriptions of the above options." } SH { SHmacro $args } SS { SHmacro $args subsection } SO { SHmacro "STANDARD OPTIONS" set state(nestingLevel) 0 newPara 0i setTabs {4c 8c 12c} font B set state(noFill) 1 } so { if {$args ne "man.macros"} { puts stderr "Unknown macro: .$name [join $args " "]" } } sp { ;# needs work if {$args eq ""} { set count 1 } else { set count [lindex $args 0] } while {$count > 0} { lineBreak incr count -1 } } ta { setTabs $args } TH { THmacro $args } TP { TPmacro $args } UL { ;# underline puts -nonewline $file "{\\ul " text [lindex $args 0] puts -nonewline $file "}" if {[llength $args] == 2} { text [lindex $args 1] } } VE {} VS {} QW { formattedText "``[lindex $args 0]''[lindex $args 1] " } MT { text "``'' " } PQ { formattedText \ "(``[lindex $args 0]''[lindex $args 1])[lindex $args 2] " } QR { formattedText "``[lindex $args 0]" dash formattedText "[lindex $args 1]''[lindex $args 2] " } default { puts stderr "Unknown macro: .$name [join $args " "]" } } } # link -- # # This procedure returns the string for a hot link to a different # context location. # # Arguments: # label - String to display in hot-spot. # id - Context string to jump to. proc link {label id} { return "{\\uldb $label}{\\v $id}" } # font -- # # This procedure is invoked to handle font changes in the text # being output. # # Arguments: # type - Type of font: R, I, B, or S. proc font {type} { global state switch $type { P - R { endFont if {$state(textState) eq "REF"} { set state(textState) INSERT } } C - B { beginFont Code if {$state(textState) eq "INSERT"} { set state(textState) REF } } I { beginFont Emphasis } S { } default { puts stderr "Unknown font: $type" } } } # formattedText -- # # Insert a text string that may also have \fB-style font changes # and a few other backslash sequences in it. # # Arguments: # text - Text to insert. proc formattedText {text} { global chars while {$text ne ""} { set index [string first \\ $text] if {$index < 0} { text $text return } text [string range $text 0 [expr {$index-1}]] set c [string index $text [expr {$index+1}]] switch -- $c { f { font [string index $text [expr {$index+2}]] set text [string range $text [expr {$index+3}] end] } e { text "\\" set text [string range $text [expr {$index+2}] end] } - { dash set text [string range $text [expr {$index+2}] end] } & - | { set text [string range $text [expr {$index+2}] end] } ( { char [string range $text $index [expr {$index+3}]] set text [string range $text [expr {$index+4}] end] } default { puts stderr "Unknown sequence: \\$c" set text [string range $text [expr {$index+2}] end] } } } } # dash -- # # This procedure is invoked to handle dash characters ("\-" in # troff). It outputs a special dash character. # # Arguments: # None. proc dash {} { global state if {[string equal $state(textState) "NAME"]} { set state(textState) 0 } text "-" } # tab -- # # This procedure is invoked to handle tabs in the troff input. # Right now it does nothing. # # Arguments: # None. proc tab {} { global file textSetup puts -nonewline $file "\\tab " } # setTabs -- # # This procedure handles the ".ta" macro, which sets tab stops. # # Arguments: # tabList - List of tab stops in *roff format proc setTabs {tabList} { global file state set state(tabs) {} foreach arg $tabList { if {[string match +* $arg]} { set relativeTo [lindex $state(tabs) end] set arg [string range $arg 1 end] } else { # Local left margin set relativeTo [expr {$state(leftMargin) \ + ($state(offset) * $state(nestingLevel))}] } if {[regexp {^\\w'([^']*)'u$} $arg -> submatch]} { # Magic factor! set distance [expr {[string length $submatch] * 86.4}] } else { set distance [getTwips $arg] } lappend state(tabs) [expr {round($distance + $relativeTo)}] } } # lineBreak -- # # Generates a line break in the HTML output. # # Arguments: # None. proc lineBreak {} { global state textSetup set state(breakPending) 1 } # newline -- # # This procedure is invoked to handle newlines in the troff input. # It outputs either a space character or a newline character, depending # on fill mode. # # Arguments: # None. proc newline {} { global state if {$state(inTP)} { set state(inTP) 0 lineBreak } elseif {$state(noFill)} { lineBreak } else { text " " } } # pageBreak -- # # This procedure is invoked to generate a page break. # # Arguments: # None. proc pageBreak {} { global file curVer if {[string equal $curVer ""]} { puts $file {\page} } else { puts $file {\par} puts $file {\pard\sb400\qc} puts $file "Last change: $curVer\\page" } } # char -- # # This procedure is called to handle a special character. # # Arguments: # name - Special character named in troff \x or \(xx construct. proc char {name} { global file state switch -exact $name { {\o} { set state(intl) 1 } {\ } { textSetup puts -nonewline $file " " } {\0} { textSetup puts -nonewline $file " \\emspace " } {\\} - {\e} { textSetup puts -nonewline $file "\\\\" } {\(+-} { textSetup puts -nonewline $file "\\'b1 " } {\%} - {\|} { } {\(->} { textSetup puts -nonewline $file "->" } {\(bu} { textSetup puts -nonewline $file "\\bullet " } {\(co} { textSetup puts -nonewline $file "\\'a9 " } {\(mi} { textSetup puts -nonewline $file "-" } {\(mu} { textSetup puts -nonewline $file "\\'d7 " } {\(em} - {\(en} { textSetup puts -nonewline $file "-" } {\(fm} { textSetup puts -nonewline $file "\\'27 " } default { puts stderr "Unknown character: $name" } } } # macro2 -- # # This procedure handles macros that are invoked with a leading "'" # character instead of space. Right now it just generates an # error diagnostic. # # Arguments: # name - The name of the macro (without the "."). # args - Any additional arguments to the macro. proc macro2 {name args} { puts stderr "Unknown macro: '$name [join $args " "]" } # SHmacro -- # # Subsection head; handles the .SH and .SS macros. # # Arguments: # name - Section name. proc SHmacro {argList {style section}} { global file state set args [join $argList " "] if {[llength $argList] < 1} { puts stderr "Bad .SH macro: .SH $args" } # control what the text proc does with text switch $args { NAME {set state(textState) NAME} DESCRIPTION {set state(textState) INSERT} INTRODUCTION {set state(textState) INSERT} "WIDGET-SPECIFIC OPTIONS" {set state(textState) INSERT} "SEE ALSO" {set state(textState) SEE} KEYWORDS {set state(textState) KEY; return} } if {$state(breakPending) != -1} { set state(breakPending) 1 } else { set state(breakPending) 0 } set state(noFill) 0 if {[string compare "subsection" $style] == 0} { nextPara .25i } else { nextPara 0i } font B text $args font R nextPara .5i } # IPmacro -- # # This procedure is invoked to handle ".IP" macros, which may take any # of the following forms: # # .IP [1] Translate to a "1Step" state(paragraph). # .IP [x] (x > 1) Translate to a "Step" state(paragraph). # .IP Translate to a "Bullet" state(paragraph). # .IP text count Translate to a FirstBody state(paragraph) with special # indent and tab stop based on "count", and tab after # "text". # # Arguments: # argList - List of arguments to the .IP macro. # # HTML limitations: 'count' in '.IP text count' is ignored. proc IPmacro {argList} { global file state set length [llength $argList] foreach {text indent} $argList break if {$length > 2} { puts stderr "Bad .IP macro: .IP [join $argList " "]" } if {$length == 0} { set text {\(bu} set indent 5 } elseif {$length == 1} { set indent 5 } if {$text == {\(bu}} { set text "\xB7" } set tab [expr {$indent * 0.1}]i newPara $tab -$tab set state(sb) 80 setTabs $tab formattedText $text tab } # TPmacro -- # # This procedure is invoked to handle ".TP" macros, which may take any # of the following forms: # # .TP x Translate to an state(indent)ed state(paragraph) with the # specified state(indent) (in 100 twip units). # .TP Translate to an state(indent)ed state(paragraph) with # default state(indent). # # Arguments: # argList - List of arguments to the .IP macro. # # HTML limitations: 'x' in '.TP x' is ignored. proc TPmacro {argList} { global state set length [llength $argList] if {$length == 0} { set val 0.5i } else { set val [expr {([lindex $argList 0] * 100.0)/1440}]i } newPara $val -$val setTabs $val set state(inTP) 1 set state(sb) 120 } # THmacro -- # # This procedure handles the .TH macro. It generates the non-scrolling # header section for a given man page, and enters information into the # table of contents. The .TH macro has the following form: # # .TH name section date footer header # # Arguments: # argList - List of arguments to the .TH macro. proc THmacro {argList} { global file curPkg curSect curID id_keywords state curVer bitmap if {[llength $argList] != 5} { set args [join $argList " "] puts stderr "Bad .TH macro: .TH $args" } incr curID set name [lindex $argList 0] ;# Tcl_UpVar set page [lindex $argList 1] ;# 3 set curVer [lindex $argList 2] ;# 7.4 set curPkg [lindex $argList 3] ;# Tcl set curSect [lindex $argList 4] ;# {Tcl Library Procedures} regsub -all {\\ } $curSect { } curSect ;# Clean up for [incr\ Tcl] puts $file "#{\\footnote $curID}" ;# Context string puts $file "\${\\footnote $name}" ;# Topic title set browse "${curSect}${name}" regsub -all {[ _-]} $browse {} browse puts $file "+{\\footnote $browse}" ;# Browse sequence # Suppress duplicates foreach i $id_keywords($curID) { set keys($i) 1 } foreach i [array names keys] { set i [string trim $i] if {[string length $i] > 0} { puts $file "K{\\footnote $i}" ;# Keyword strings } } unset keys puts $file "\\pard\\tx3000\\sb100\\sa100\\fs24\\keepn" font B text $name tab text $curSect font R if {[info exists bitmap]} { # a right justified bitmap puts $file "\\\{bmrt $bitmap\\\}" } puts $file "\\fs20" set state(breakPending) -1 } # nextPara -- # # Set the indents for a new paragraph, and start a paragraph break # # Arguments: # leftIndent - The new left margin for body lines. # firstIndent - The offset from the left margin for the first line. proc nextPara {leftIndent {firstIndent 0i}} { global state set state(leftIndent) [getTwips $leftIndent] set state(firstIndent) [getTwips $firstIndent] set state(paragraphPending) 1 } # newPara -- # # This procedure sets the left and hanging state(indent)s for a line. # State(Indent)s are specified in units of inches or centimeters, and are # relative to the current nesting level and left margin. # # Arguments: # leftState(Indent) - The new left margin for lines after the first. # firstState(Indent) - The new left margin for the first line of a state(paragraph). proc newPara {leftIndent {firstIndent 0i}} { global state file if $state(paragraph) { puts -nonewline $file "\\line\n" } if {$leftIndent ne ""} { set state(leftIndent) [expr {$state(leftMargin) \ + ($state(offset) * $state(nestingLevel)) \ + [getTwips $leftIndent]}] } set state(firstIndent) [getTwips $firstIndent] set state(paragraphPending) 1 } # getTwips -- # # This procedure converts a distance in inches or centimeters into # twips (1/1440 of an inch). # # Arguments: # arg - A number followed by "i" or "c" proc getTwips {arg} { if {[scan $arg "%f%s" distance units] != 2} { puts stderr "bad distance \"$arg\"" return 0 } if {[string length $units] > 1} { puts stderr "additional characters after unit \"$arg\"" set units [string index $units 0] } switch -- $units { c { set distance [expr {$distance * 567}] } i { set distance [expr {$distance * 1440}] } default { puts stderr "bad units in distance \"$arg\"" return 0 } } return $distance } # incrNestingLevel -- # # This procedure does the work of the .RS macro, which increments # the number of state(indent)ations that affect things like .PP. # # Arguments: # None. proc incrNestingLevel {} { global state incr state(nestingLevel) set oldp $state(paragraph) set state(paragraph) 0 newPara 0i set state(paragraph) $oldp } # decrNestingLevel -- # # This procedure does the work of the .RE macro, which decrements # the number of indentations that affect things like .PP. # # Arguments: # None. proc decrNestingLevel {} { global state if {$state(nestingLevel) == 0} { puts stderr "Nesting level decremented below 0" } else { incr state(nestingLevel) -1 } } tcl8.6.14/tools/man2help.tcl0000644000175000017500000000630514554262142015220 0ustar sergeisergei# man2help.tcl -- # # This file defines procedures that work in conjunction with the # man2tcl program to generate a Windows help file from Tcl manual # entries. # # Copyright (c) 1996 Sun Microsystems, Inc. # # PASS 1 # set man2tclprog [file join [file dirname [info script]] \ man2tcl[file extension [info nameofexecutable]]] proc generateContents {basename version files} { global curID topics set curID 0 foreach f $files { puts "Pass 1 -- $f" flush stdout doFile $f } set fd [open [file join [file dirname [info script]] $basename$version.cnt] w] fconfigure $fd -translation crlf puts $fd ":Base $basename$version.hlp" foreach package [getPackages] { foreach section [getSections $package] { if {![info exists lastSection]} { set lastSection {} } if {[string compare $lastSection $section]} { puts $fd "1 $section" } set lastSection $section set lastTopic {} foreach topic [getTopics $package $section] { if {[string compare $lastTopic $topic]} { set id $topics($package,$section,$topic) puts $fd "2 $topic=$id" set lastTopic $topic } } } } close $fd } # # PASS 2 # proc generateHelp {basename files} { global curID topics keywords file id_keywords set curID 0 foreach key [array names keywords] { foreach id $keywords($key) { lappend id_keywords($id) $key } } set file [open [file join [file dirname [info script]] $basename.rtf] w] fconfigure $file -translation crlf puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\{\\f1\\fmodern\\fcharset0\\fprq1 Courier New\;\}\}" foreach f $files { puts "Pass 2 -- $f" flush stdout initGlobals doFile $f pageBreak } puts $file "\}" close $file } # doFile -- # # Given a file as argument, translate the file to a tcl script and # evaluate it. # # Arguments: # file - Name of file to translate. proc doFile {file} { global man2tclprog if {[catch {eval [exec $man2tclprog [glob $file]]} msg]} { global errorInfo puts stderr $msg puts "in" puts $errorInfo exit 1 } } # doDir -- # # Given a directory as argument, translate all the man pages in # that directory. # # Arguments: # dir - Name of the directory. proc doDir dir { puts "Generating man pages for $dir..." foreach f [lsort [glob -directory $dir "*.\[13n\]"]] { doFile $f } } # process command line arguments if {$argc < 3} { puts stderr "usage: $argv0 \[options\] projectName version manFiles..." exit 1 } set arg 0 if {![string compare [lindex $argv $arg] "-bitmap"]} { set bitmap [lindex $argv [incr arg]] incr arg } set baseName [lindex $argv $arg] set version [lindex $argv [incr arg]] set files {} foreach i [lrange $argv [incr arg] end] { set i [file join $i] if {[file isdir $i]} { foreach f [lsort [glob -directory $i "*.\[13n\]"]] { lappend files $f } } elseif {[file exists $i]} { lappend files $i } } source [file join [file dirname [info script]] index.tcl] generateContents $baseName $version $files source [file join [file dirname [info script]] man2help2.tcl] generateHelp $baseName $files tcl8.6.14/tools/man2html1.tcl0000644000175000017500000001235114554262142015313 0ustar sergeisergei# man2html1.tcl -- # # This file defines procedures that are used during the first pass of the # man page to html conversion process. It is sourced by h.tcl. # # Copyright (c) 1996 Sun Microsystems, Inc. # Global variables used by these scripts: # # state - state variable that controls action of text proc. # # curFile - tail of current man page. # # file - file pointer; for both xref.tcl and contents.html # # NAME_file - array indexed by NAME and containing file names used # for hyperlinks. # # KEY_file - array indexed by KEYWORD and containing file names used # for hyperlinks. # # lib - contains package name. Used to label section in contents.html # # inDT - in dictionary term. # text -- # # This procedure adds entries to the hypertext arrays NAME_file # and KEY_file. # # DT: might do this: if first word of $dt matches $name and [llength $name==1] # and [llength $dt > 1], then add to NAME_file. # # Arguments: # string - Text to index. proc text string { global state curFile NAME_file KEY_file inDT switch $state { NAME { foreach i [split $string ","] { lappend NAME_file([string trim $i]) $curFile } } KEY { foreach i [split $string ","] { lappend KEY_file([string trim $i]) $curFile } } DT - OFF - DASH {} default { puts stderr "text: unknown state: $state" } } } # macro -- # # This procedure is invoked to process macro invocations that start # with "." (instead of '). # # Arguments: # name - The name of the macro (without the "."). # args - Any additional arguments to the macro. proc macro {name args} { switch $name { SH - SS { global state switch $args { NAME { if {$state eq "INIT"} { set state NAME } } DESCRIPTION {set state DT} INTRODUCTION {set state DT} KEYWORDS {set state KEY} default {set state OFF} } } TP { global inDT set inDT 1 } TH { global lib state inDT set inDT 0 set state INIT if {[llength $args] != 5} { set args [join $args " "] puts stderr "Bad .TH macro: .$name $args" } set lib [lindex $args 3] ;# Tcl or Tk } } } # dash -- # # This procedure is invoked to handle dash characters ("\-" in # troff). It only function in pass1 is to terminate the NAME state. # # Arguments: # None. proc dash {} { global state if {$state eq "NAME"} { set state DASH } } # newline -- # # This procedure is invoked to handle newlines in the troff input. # It's only purpose is to terminate a DT (dictionary term). # # Arguments: # None. proc newline {} { global inDT set inDT 0 } # initGlobals, tab, font, char, macro2 -- # # These procedures do nothing during the first pass. # # Arguments: # None. proc initGlobals {} {} proc tab {} {} proc font type {} proc char name {} proc macro2 {name args} {} # doListing -- # # Writes an ls like list to a file. Searches NAME_file for entries # that match the input pattern. # # Arguments: # file - Output file pointer. # pattern - glob style match pattern proc doListing {file pattern} { global NAME_file set max_len 0 foreach name [lsort [array names NAME_file]] { set ref $NAME_file($name) if [string match $pattern $ref] { lappend type $name if {[string length $name] > $max_len} { set max_len [string length $name] } } } if [catch {llength $type} ] { puts stderr " doListing: no names matched pattern ($pattern)" return } incr max_len set ncols [expr {90/$max_len}] set nrows [expr {int(ceil([llength $type] / double($ncols)))} ] # ? max_len ncols nrows set index 0 foreach f $type { lappend row([expr {$index % $nrows}]) $f incr index } puts -nonewline $file "
"
    for {set i 0} {$i<$nrows} {incr i} {
	foreach name $row($i) {
	    set str [format "%-*s" $max_len $name]
	    regsub $name $str "$name" str
	    puts -nonewline $file $str
	}
	puts $file {}
    }
    puts $file "
" } # doContents -- # # Generates a HTML contents file using the NAME_file array # as its input database. # # Arguments: # file - name of the contents file. # packageName - string used in the title and sub-heads of the HTML # page. Normally name of the package without version # numbers. proc doContents {file packageName} { global footer set file [open $file w] puts $file "$packageName Manual" puts $file "

$packageName

" doListing $file "*.1" puts $file "

$packageName Commands

" doListing $file "*.n" puts $file "

$packageName Library

" doListing $file "*.3" puts $file $footer puts $file "" close $file } # do -- # # This is the toplevel procedure that searches a man page # for hypertext links. It builds a data base consisting of # two arrays: NAME_file and KEY file. It runs the man2tcl # program to turn the man page into a script, then it evals # that script. # # Arguments: # fileName - Name of the file to scan. proc do fileName { global curFile set curFile [file tail $fileName] set file stdout puts " Pass 1 -- $fileName" flush stdout if [catch {eval [exec man2tcl [glob $fileName]]} msg] { global errorInfo puts stderr $msg puts "in" puts $errorInfo exit 1 } } tcl8.6.14/tools/man2html2.tcl0000644000175000017500000005131514554262142015317 0ustar sergeisergei############################################################################## # man2html2.tcl -- # # This file defines procedures that are used during the second pass of the man # page to html conversion process. It is sourced by man2html.tcl. # # Copyright (c) 1996 Sun Microsystems, Inc. # Global variables used by these scripts: # # NAME_file - array indexed by NAME and containing file names used for # hyperlinks. # # textState - state variable defining action of 'text' proc. # # nestStk - stack oriented list containing currently active HTML tags (UL, # OL, DL). Local to 'nest' proc. # # inDT - set by 'TPmacro', cleared by 'newline'. Used to insert the # tag while in a dictionary list
. # # curFont - Name of special font that is currently in use. Null means the # default paragraph font is being used. # # file - Where to output the generated HTML. # # fontStart - Array to map font names to starting sequences. # # fontEnd - Array to map font names to ending sequences. # # noFillCount - Non-zero means don't fill the next $noFillCount lines: force a # line break at each newline. Zero means filling is enabled, so # don't output line breaks for each newline. # # footer - info inserted at bottom of each page. Normally read from the # xref.tcl file ############################################################################## # initGlobals -- # # This procedure is invoked to set the initial values of all of the global # variables, before processing a man page. # # Arguments: # None. proc initGlobals {} { global file noFillCount textState global fontStart fontEnd curFont inPRE charCnt inTable nest init set inPRE 0 set inTable 0 set textState 0 set curFont "" set fontStart(Code) "" set fontStart(Emphasis) "" set fontEnd(Code) "" set fontEnd(Emphasis) "" set noFillCount 0 set charCnt 0 setTabs 0.5i } ############################################################################## # beginFont -- # # Arranges for future text to use a special font, rather than the default # paragraph font. # # Arguments: # font - Name of new font to use. proc beginFont font { global curFont file fontStart if {$curFont eq $font} { return } endFont puts -nonewline $file $fontStart($font) set curFont $font } ############################################################################## # endFont -- # # Reverts to the default font for the paragraph type. # # Arguments: # None. proc endFont {} { global curFont file fontEnd if {$curFont ne ""} { puts -nonewline $file $fontEnd($curFont) set curFont "" } } ############################################################################## # text -- # # This procedure adds text to the current paragraph. If this is the first text # in the paragraph then header information for the paragraph is output before # the text. # # Arguments: # string - Text to output in the paragraph. proc text string { global file textState inDT charCnt inTable set pos [string first "\t" $string] if {$pos >= 0} { text [string range $string 0 [expr {$pos-1}]] tab text [string range $string [expr {$pos+1}] end] return } if {$inTable} { if {$inTable == 1} { puts -nonewline $file set inTable 2 } puts -nonewline $file } incr charCnt [string length $string] regsub -all {&} $string {\&} string regsub -all {<} $string {\<} string regsub -all {>} $string {\>} string regsub -all \" $string {\"} string switch -exact -- $textState { REF { if {$inDT eq ""} { set string [insertRef $string] } } SEE { global NAME_file foreach i [split $string] { if {![regexp -nocase {^[a-z_]+} [string trim $i] i]} { # puts "Warning: $i in SEE ALSO not found" continue } if {![catch { set ref $NAME_file($i) }]} { regsub $i $string "$i" string } } } } puts -nonewline $file "$string" if {$inTable} { puts -nonewline $file } } ############################################################################## # insertRef -- # # Arguments: # string - Text to output in the paragraph. proc insertRef string { global NAME_file self set path {} if {![catch { set ref $NAME_file([string trim $string]) }]} { if {"$ref.html" ne $self} { set string "$string" # puts "insertRef: $self $ref.html ---$string--" } } return $string } ############################################################################## # macro -- # # This procedure is invoked to process macro invocations that start with "." # (instead of '). # # Arguments: # name - The name of the macro (without the "."). # args - Any additional arguments to the macro. proc macro {name args} { switch $name { AP { if {[llength $args] != 3} { puts stderr "Bad .AP macro: .$name [join $args " "]" } setTabs {1.25i 2.5i 3.75i} TPmacro {} font B text "[lindex $args 0] " font I text "[lindex $args 1]" font R text " ([lindex $args 2])" newline } AS {} ;# next page and previous page br { lineBreak } BS {} BE {} CE { global file noFillCount inPRE puts $file set inPRE 0 } CS { ;# code section global file noFillCount inPRE puts -nonewline $file 
	    set inPRE 1
	}
	DE {
	    global file noFillCount inTable
	    puts $file
set inTable 0 set noFillCount 0 } DS { global file noFillCount inTable puts -nonewline $file {
} set noFillCount 10000000 set inTable 1 } fi { global noFillCount set noFillCount 0 } IP { IPmacro $args } LP { nest decr nest incr newPara } ne { } nf { global noFillCount set noFillCount 1000000 } OP { global inDT file inPRE if {[llength $args] != 3} { puts stderr "Bad .OP macro: .$name [join $args " "]" } nest para DL DT set inPRE 1 puts -nonewline $file 
	    setTabs 4c
	    text "Command-Line Name:"
	    tab
	    font B
	    set x [lindex $args 0]
	    regsub -all {\\-} $x - x
	    text $x
	    newline
	    font R
	    text "Database Name:"
	    tab
	    font B
	    text [lindex $args 1]
	    newline
	    font R
	    text "Database Class:"
	    tab
	    font B
	    text [lindex $args 2]
	    font R
	    puts -nonewline $file
set inDT "\n
" ;# next newline writes inDT set inPRE 0 newline } PP { nest decr nest incr newPara } RE { nest decr } RS { nest incr } SE { global noFillCount textState inPRE file font R puts -nonewline $file set inPRE 0 set noFillCount 0 nest reset newPara text "See the " font B set temp $textState set textState REF if {[llength $args] > 0} { text [lindex $args 0] } else { text options } set textState $temp font R text " manual entry for detailed descriptions of the above options." } SH { SHmacro $args } SS { SHmacro $args subsection } SO { global noFillCount inPRE file SHmacro "STANDARD OPTIONS" setTabs {4c 8c 12c} set noFillCount 1000000 puts -nonewline $file 
	    set inPRE 1
	    font B
	}
	so {
	    if {$args ne "man.macros"} {
		puts stderr "Unknown macro: .$name [join $args " "]"
	    }
	}
	sp {					;# needs work
	    if {$args eq ""} {
		set count 1
	    } else {
		set count [lindex $args 0]
	    }
	    while {$count > 0} {
		lineBreak
		incr count -1
	    }
	}
	ta {
	    setTabs $args
	}
	TH {
	    THmacro $args
	}
	TP {
	    TPmacro $args
	}
	UL {					;# underline
	    global file
	    puts -nonewline $file ""
	    text [lindex $args 0]
	    puts -nonewline $file ""
	    if {[llength $args] == 2} {
		text [lindex $args 1]
	    }
	}
	VE {
#	    global file
#	    puts -nonewline $file ""
	}
	VS {
#	    global file
#	    if {[llength $args] > 0} {
#		puts -nonewline $file "
"
#	    }
#	    puts -nonewline $file ""
	}
	QW {
	    puts -nonewline $file "&\#147;"
	    text [lindex $args 0]
	    puts -nonewline $file "&\#148;"
	    if {[llength $args] > 1} {
		text [lindex $args 1]
	    }
	}
	PQ {
	    puts -nonewline $file "(&\#147;"
	    if {[lindex $args 0] eq {\N'34'}} {
		puts -nonewline $file \"
	    } else {
		text [lindex $args 0]
	    }
	    puts -nonewline $file "&\#148;"
	    if {[llength $args] > 1} {
		text [lindex $args 1]
	    }
	    puts -nonewline $file ")"
	    if {[llength $args] > 2} {
		text [lindex $args 2]
	    }
	}
	QR {
	    puts -nonewline $file "&\#147;"
	    text [lindex $args 0]
	    puts -nonewline $file "&\#148;&\#150;&\#147;"
	    text [lindex $args 1]
	    puts -nonewline $file "&\#148;"
	    if {[llength $args] > 2} {
		text [lindex $args 2]
	    }
	}
	MT {
	    puts -nonewline $file "&\#147;&\#148;"
	}
	default {
	    puts stderr "Unknown macro: .$name [join $args " "]"
	}
    }

#	global nestStk; puts "$name [format "%-20s" $args] $nestStk"
#	flush stdout; flush stderr
}

##############################################################################
# font --
#
# This procedure is invoked to handle font changes in the text being output.
#
# Arguments:
# type -		Type of font: R, I, B, or S.

proc font type {
    global textState
    switch $type {
	P -
	R {
	    endFont
	    if {$textState eq "REF"} {
		set textState INSERT
	    }
	}
	B {
	    beginFont Code
	    if {$textState eq "INSERT"} {
		set textState REF
	    }
	}
	I {
	    beginFont Emphasis
	}
	S {
	}
	default {
	    puts stderr "Unknown font: $type"
	}
    }
}

##############################################################################
# formattedText --
#
# Insert a text string that may also have \fB-style font changes and a few
# other backslash sequences in it.
#
# Arguments:
# text -		Text to insert.

proc formattedText text {
#	puts "formattedText: $text"
    while {$text ne ""} {
	set index [string first \\ $text]
	if {$index < 0} {
	    text $text
	    return
	}
	text [string range $text 0 [expr {$index-1}]]
	set c [string index $text [expr {$index+1}]]
	switch -- $c {
	    f {
		font [string index $text [expr {$index+2}]]
		set text [string range $text [expr {$index+3}] end]
	    }
	    e {
		text \\
		set text [string range $text [expr {$index+2}] end]
	    }
	    - {
		dash
		set text [string range $text [expr {$index+2}] end]
	    }
	    | {
		set text [string range $text [expr {$index+2}] end]
	    }
	    default {
		puts stderr "Unknown sequence: \\$c"
		set text [string range $text [expr {$index+2}] end]
	    }
	}
    }
}

##############################################################################
# dash --
#
# This procedure is invoked to handle dash characters ("\-" in troff). It
# outputs a special dash character.
#
# Arguments:
# None.

proc dash {} {
    global textState charCnt
    if {$textState eq "NAME"} {
    	set textState 0
    }
    incr charCnt
    text "-"
}

##############################################################################
# tab --
#
# This procedure is invoked to handle tabs in the troff input.
#
# Arguments:
# None.

proc tab {} {
    global inPRE charCnt tabString file
#	? charCnt
    if {$inPRE == 1} {
	set pos [expr {$charCnt % [string length $tabString]}]
	set spaces [string first "1" [string range $tabString $pos end] ]
	text [format "%*s" [incr spaces] " "]
    } else {
#	puts "tab: found tab outside of 
 block"
    }
}

##############################################################################
# setTabs --
#
# This procedure handles the ".ta" macro, which sets tab stops.
#
# Arguments:
# tabList -	List of tab stops, each consisting of a number
#			followed by "i" (inch) or "c" (cm).

proc setTabs {tabList} {
    global file breakPending tabString

    # puts "setTabs: --$tabList--"
    set last 0
    set tabString {}
    set charsPerInch 14.
    set numTabs [llength $tabList]
    foreach arg $tabList {
	if {[string match +* $arg]} {
	    set relative 1
	    set arg [string range $arg 1 end]
	} else {
	    set relative 0
	}
	# Always operate in relative mode for "measurement" mode
	if {[regexp {^\\w'(.*)'u$} $arg content]} {
	    set distance [string length $content]
	} else {
	    if {[scan $arg "%f%s" distance units] != 2} {
		puts stderr "bad distance \"$arg\""
		return 0
	    }
	    switch -- $units {
		c {
		    set distance [expr {$distance * $charsPerInch / 2.54}]
		}
		i {
		    set distance [expr {$distance * $charsPerInch}]
		}
		default {
		    puts stderr "bad units in distance \"$arg\""
		    continue
		}
	    }
	}
	# ? distance
	if {$relative} {
	    append tabString [format "%*s1" [expr {round($distance-1)}] " "]
	    set last [expr {$last + $distance}]
	} else {
	    append tabString [format "%*s1" [expr {round($distance-$last-1)}] " "]
	    set last $distance
	}
    }
    # puts "setTabs: --$tabString--"
}

##############################################################################
# lineBreak --
#
# Generates a line break in the HTML output.
#
# Arguments:
# None.

proc lineBreak {} {
    global file inPRE
    puts $file "
"
}

##############################################################################
# newline --
#
# This procedure is invoked to handle newlines in the troff input. It outputs
# either a space character or a newline character, depending on fill mode.
#
# Arguments:
# None.

proc newline {} {
    global noFillCount file inDT inPRE charCnt inTable

    if {$inDT ne ""} {
    	puts $file "\n$inDT"
    	set inDT {}
    } elseif {$inTable} {
	if {$inTable > 1} {
	    puts $file 
	    set inTable 1
	}
    } elseif {$noFillCount == 0 || $inPRE == 1} {
	puts $file {}
    } else {
	lineBreak
	incr noFillCount -1
    }
    set charCnt 0
}

##############################################################################
# char --
#
# This procedure is called to handle a special character.
#
# Arguments:
# name -		Special character named in troff \x or \(xx construct.

proc char name {
    global file charCnt

    incr charCnt
#	puts "char: $name"
    switch -exact $name {
	\\0 {					;#  \0
	    puts -nonewline $file " "
	}
	\\\\ {					;#  \
	    puts -nonewline $file "\\"
	}
	\\(+- { 				;#  +/-
	    puts -nonewline $file "±"
	}
	\\% {}					;#  \%
	\\| {					;#  \|
	}
	default {
	    puts stderr "Unknown character: $name"
	}
    }
}

##############################################################################
# macro2 --
#
# This procedure handles macros that are invoked with a leading "'" character
# instead of space. Right now it just generates an error diagnostic.
#
# Arguments:
# name -		The name of the macro (without the ".").
# args -		Any additional arguments to the macro.

proc macro2 {name args} {
    puts stderr "Unknown macro: '$name [join $args " "]"
}

##############################################################################
# SHmacro --
#
# Subsection head; handles the .SH and .SS macros.
#
# Arguments:
# name -		Section name.
# style -		Type of section (optional)

proc SHmacro {argList {style section}} {
    global file noFillCount textState charCnt

    set args [join $argList " "]
    if {[llength $argList] < 1} {
	puts stderr "Bad .SH macro: .$name $args"
    }

    set noFillCount 0
    nest reset

    set tag H3
    if {$style eq "subsection"} {
	set tag H4
    }
    puts -nonewline $file "<$tag>"
    text $args
    puts $file ""

#	? args textState

    # control what the text proc does with text

    switch $args {
	NAME {set textState NAME}
	DESCRIPTION {set textState INSERT}
	INTRODUCTION {set textState INSERT}
	"WIDGET-SPECIFIC OPTIONS" {set textState INSERT}
	"SEE ALSO" {set textState SEE}
	KEYWORDS {set textState 0}
    }
    set charCnt 0
}

##############################################################################
# IPmacro --
#
# This procedure is invoked to handle ".IP" macros, which may take any of the
# following forms:
#
# .IP [1]			Translate to a "1Step" paragraph.
# .IP [x] (x > 1)		Translate to a "Step" paragraph.
# .IP				Translate to a "Bullet" paragraph.
# .IP \(bu			Translate to a "Bullet" paragraph.
# .IP text count		Translate to a FirstBody paragraph with
#				special indent and tab stop based on "count",
#				and tab after "text".
#
# Arguments:
# argList -		List of arguments to the .IP macro.
#
# HTML limitations: 'count' in '.IP text count' is ignored.

proc IPmacro argList {
    global file

    setTabs 0.5i
    set length [llength $argList]
    if {$length == 0} {
    	nest para UL LI
	return
    }
    # Special case for alternative mechanism for declaring bullets
    if {[lindex $argList 0] eq "\\(bu"} {
	nest para UL LI
	return
    }
    if {[regexp {^\[\d+\]$} [lindex $argList 0]]} {
    	nest para OL LI
	return
    }
    nest para DL DT
    formattedText [lindex $argList 0]
    puts $file "\n
"
    return
}

##############################################################################
# TPmacro --
#
# This procedure is invoked to handle ".TP" macros, which may take any of the
# following forms:
#
# .TP x		Translate to an indented paragraph with the specified indent
# 			(in 100 twip units).
# .TP		Translate to an indented paragraph with default indent.
#
# Arguments:
# argList -		List of arguments to the .IP macro.
#
# HTML limitations: 'x' in '.TP x' is ignored.

proc TPmacro {argList} {
    global inDT
    nest para DL DT
    set inDT "\n
"			;# next newline writes inDT
    setTabs 0.5i
}

##############################################################################
# THmacro --
#
# This procedure handles the .TH macro. It generates the non-scrolling header
# section for a given man page, and enters information into the table of
# contents. The .TH macro has the following form:
#
# .TH name section date footer header
#
# Arguments:
# argList -		List of arguments to the .TH macro.

proc THmacro {argList} {
    global file

    if {[llength $argList] != 5} {
	set args [join $argList " "]
	puts stderr "Bad .TH macro: .$name $args"
    }
    set name  [lindex $argList 0]		;# Tcl_UpVar
    set page  [lindex $argList 1]		;# 3
    set vers  [lindex $argList 2]		;# 7.4
    set lib   [lindex $argList 3]		;# Tcl
    set pname [lindex $argList 4]		;# {Tcl Library Procedures}

    puts -nonewline $file ""
    text "$lib - $name ($page)"
    puts $file "\n"

    puts -nonewline $file "
"
    text $pname
    puts $file "
\n"
}

##############################################################################
# newPara --
#
# This procedure sets the left and hanging indents for a line. Indents are
# specified in units of inches or centimeters, and are relative to the current
# nesting level and left margin.
#
# Arguments:
# None

proc newPara {} {
    global file nestStk

    if {[lindex $nestStk end] ne "NEW"} {
	nest decr
    }
    puts -nonewline $file "
"
}

##############################################################################
# nest --
#
# This procedure takes care of inserting the tags associated with the IP, TP,
# RS, RE, LP and PP macros. Only 'nest para' takes arguments.
#
# Arguments:
# op -				operation: para, incr, decr, reset, init
# listStart -		begin list tag: OL, UL, DL.
# listItem -		item tag:       LI, LI, DT.

proc nest {op {listStart "NEW"} {listItem ""} } {
    global file nestStk inDT charCnt
#	puts "nest: $op $listStart $listItem"
    switch $op {
	para {
	    set top [lindex $nestStk end]
	    if {$top eq "NEW"} {
		set nestStk [lreplace $nestStk end end $listStart]
		puts $file "<$listStart>"
	    } elseif {$top ne $listStart} {
		puts stderr "nest para: bad stack"
		exit 1
	    }
	    puts $file "\n<$listItem>"
	    set charCnt 0
	}
	incr {
	   lappend nestStk NEW
	}
	decr {
	    if {[llength $nestStk] == 0} {
		puts stderr "nest error: nest length is zero"
		set nestStk NEW
	    }
	    set tag [lindex $nestStk end]
	    if {$tag ne "NEW"} {
		puts $file ""
	    }
	    set nestStk [lreplace $nestStk end end]
	}
	reset {
	    while {[llength $nestStk] > 0} {
		nest decr
	    }
	    set nestStk NEW
	}
	init {
	    set nestStk NEW
	    set inDT {}
	}
    }
    set charCnt 0
}

##############################################################################
# do --
#
# This is the toplevel procedure that translates a man page to HTML. It runs
# the man2tcl program to turn the man page into a script, then it evals that
# script.
#
# Arguments:
# fileName -		Name of the file to translate.

proc do fileName {
    global file self html_dir package footer
    set self "[file tail $fileName].html"
    set file [open "$html_dir/$package/$self" w]
    puts "  Pass 2 -- $fileName"
    flush stdout
    initGlobals
    if {[catch { eval [exec man2tcl [glob $fileName]] } msg]} {
	global errorInfo
	puts stderr $msg
	puts "in"
	puts stderr $errorInfo
	exit 1
    }
    nest reset
    puts $file $footer
    puts $file ""
    close $file
}
tcl8.6.14/tools/man2html.tcl0000644000175000017500000001045514554262142015235 0ustar  sergeisergei#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}

# man2html.tcl --
#
# This file contains procedures that work in conjunction with the
# man2tcl program to generate a HTML files from Tcl manual entries.
#
# Copyright (c) 1996 Sun Microsystems, Inc.


# sarray -
#
# Save an array to a file so that it can be sourced.
#
# Arguments:
# file -		Name of the output file
# args -		Name of the arrays to save
#
proc sarray {file args} {
    set file [open $file w]
    foreach a $args {
	upvar $a array
	if {![array exists array]} {
	    puts "sarray: \"$a\" isn't an array"
	    break
	}

	foreach name [lsort [array names array]] {
	    regsub -all " " $name "\\ " name1
	    puts $file "set ${a}($name1) \{$array($name)\}"
	}
    }
    close $file
}


# footer --
#
# Builds footer info for HTML pages
#
# Arguments:
# packages -		List of packages to link to.

proc footer {packages} {
    lappend f "
"
    set h {[}
    foreach package $packages {
	lappend h "$package"
	lappend h "|"
    }
    lappend f [join [lreplace $h end end {]} ] " "]
    lappend f "
"
    lappend f "
Copyright © 1989-1994 The Regents of the University of California."
    lappend f "Copyright © 1994-1996 Sun Microsystems, Inc."
    lappend f "
"
    return [join $f "\n"]
}


# doDir --
#
# Given a directory as argument, translate all the man pages in
# that directory.
#
# Arguments:
# dir -			Name of the directory.

proc doDir dir {
    foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
	do $f	;# defined in man2html1.tcl & man2html2.tcl
    }
}


# main --
#
# Main code for converting Tcl manual pages to HTML.
#
# Arguments:
# argv -		List of arguments to this script.

proc main {argv} {
    global html_dir
    # Global vars used in man2html1.tcl and man2html2.tcl
    global NAME_file KEY_file lib state curFile file inDT textState nestStk
    global curFont fontStart fontEnd noFillCount footer

    if {[llength $argv] < 2} {
	puts stderr "usage: $::argv0 html_dir tcl_dir packages..."
	puts stderr "usage: $::argv0 -clean html_dir"
	exit 1
    }

    if {[lindex $argv 0] eq "-clean"} {
	set html_dir [lindex $argv 1]
	puts -nonewline "recursively remove: $html_dir? "
	flush stdout
	if {[gets stdin] eq "y"} {
	    puts "removing: $html_dir"
	    file delete -force $html_dir
	}
	exit 0
    }

    set html_dir [lindex $argv 0]
    set tcl_dir  [lindex $argv 1]
    set packages [lrange $argv 2 end]
    set homeDir  [file dirname [info script]]

    #### need to add glob capability to packages ####

    # make sure there are doc directories for each package

    foreach i $packages {
	if {![file exists $tcl_dir/$i/doc]} {
	    puts stderr "Error: doc directory for package $i is missing"
	    exit 1
	}
	if {![file isdirectory $tcl_dir/$i/doc]} {
	    puts stderr "Error: $tcl_dir/$i/doc is not a directory"
	    exit 1
	}
    }

    # we want to start with a clean sheet

    if {[file exists $html_dir]} {
	puts stderr "Error: HTML directory already exists"
	exit 1
    } else {
	file mkdir $html_dir
    }

    set footer [footer $packages]

    # make the hyperlink arrays and contents.html for all packages

    foreach package $packages {
	file mkdir $html_dir/$package

	# build hyperlink database arrays: NAME_file and KEY_file
	#
	puts "\nScanning man pages in $tcl_dir/$package/doc..."
	uplevel \#0 [list source $homeDir/man2html1.tcl]

	doDir $tcl_dir/$package/doc

	# clean up the NAME_file and KEY_file database arrays
	#
	catch {unset KEY_file()}
	foreach name [lsort [array names NAME_file]] {
	    set file_name $NAME_file($name)
	    if {[llength $file_name] > 1} {
		set file_name [lsort $file_name]
		puts "Warning: '$name' multiply defined in: $file_name;\
			using last"
		set NAME_file($name) [lindex $file_name end]
	    }
	}
	# sarray $html_dir/$package/xref.tcl NAME_file KEY_file

	# build the contents file from NAME_file
	#
	puts "\nGenerating contents.html for $package"
	doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl

	# now translate the man pages to HTML pages
	#
	uplevel \#0 [list source $homeDir/man2html2.tcl]
	puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
	doDir $tcl_dir/$package/doc

	unset NAME_file
    }
}


if [catch { main $argv } result] {
    global errorInfo
    puts stderr $result
    puts stderr "in"
    puts stderr $errorInfo
}
tcl8.6.14/tools/mkdepend.tcl0000644000175000017500000002243314554262142015301 0ustar  sergeisergei#==============================================================================
#
# mkdepend : generate dependency information from C/C++ files
#
# Copyright (c) 1998, Nat Pryce
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL THE AUTHOR BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
# SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF
# THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR HAS BEEN ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
# PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
# BASIS, AND THE AUTHOR HAS NO OBLIGATION TO PROVIDE  MAINTENANCE, SUPPORT,
# UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#==============================================================================
#
# Modified heavily by David Gravereaux  about 9/17/2006.
# Original can be found @
#	http://web.archive.org/web/20070616205924/http://www.doc.ic.ac.uk/~np2/software/mkdepend.html
#==============================================================================

array set mode_data {}
set mode_data(vc32) {cl -nologo -E}

set source_extensions [list .c .cpp .cxx .cc]

set excludes [list]
if [info exists env(INCLUDE)] {
    set rawExcludes [split [string trim $env(INCLUDE) ";"] ";"]
    foreach exclude $rawExcludes {
	lappend excludes [file normalize $exclude]
    }
}


# openOutput --
#
#	Opens the output file.
#
# Arguments:
#	file	The file to open
#
# Results:
#	None.

proc openOutput {file} {
    global output
    set output [open $file w]
    puts $output "# Automatically generated at [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] by [info script]\n"
}

# closeOutput --
#
#	Closes output file.
#
# Arguments:
#	none
#
# Results:
#	None.

proc closeOutput {} {
    global output
    if {[string match stdout $output] != 0} {
        close $output
    }
}

# readDepends --
#
#	Read off CCP pipe for #line references.
#
# Arguments:
#	chan	The pipe channel we are reading in.
#
# Results:
#	Raw dependency list pairs.

proc readDepends {chan} {
    set line ""
    array set depends {}

    while {[gets $chan line] >= 0} {
        if {[regexp {^#line [0-9]+ \"(.*)\"$} $line dummy fname] != 0} {
	    set fname [file normalize $fname]
            if {![info exists target]} {
		# this is ourself
		set target $fname
		puts stderr "processing [file tail $fname]"
            } else {
		# don't include ourselves as a dependency of ourself.
		if {![string compare $fname $target]} {continue}
		# store in an array so multiple occurrences are not counted.
                set depends($target|$fname) ""
            }
        }
    }

    set result {}
    foreach n [array names depends] {
        set pair [split $n "|"]
        lappend result [list [lindex $pair 0] [lindex $pair 1]]
    }

    return $result
}

# writeDepends --
#
#	Write the processed list out to the file.
#
# Arguments:
#	out		The channel to write to.
#	depends		The list of dependency pairs
#
# Results:
#	None.

proc writeDepends {out depends} {
    foreach pair $depends {
        puts $out "[lindex $pair 0] : \\\n\t[join [lindex $pair 1] " \\\n\t"]"
    }
}

# stringStartsWith --
#
#	Compares second string to the beginning of the first.
#
# Arguments:
#	str		The string to test the beginning of.
#	prefix		The string to test against
#
# Results:
#	the result of the comparison.

proc stringStartsWith {str prefix} {
    set front [string range $str 0 [expr {[string length $prefix] - 1}]]
    return [expr {[string compare [string tolower $prefix] \
                                  [string tolower $front]] == 0}]
}

# filterExcludes --
#
#	Remove non-project header files.
#
# Arguments:
#	depends		List of dependency pairs.
#	excludes	List of directories that should be removed
#
# Results:
#	the processed dependency list.

proc filterExcludes {depends excludes} {
    set filtered {}

    foreach pair $depends {
        set excluded 0
        set file [lindex $pair 1]

        foreach dir $excludes {
            if [stringStartsWith $file $dir] {
                set excluded 1
                break;
            }
        }

        if {!$excluded} {
            lappend filtered $pair
        }
    }

    return $filtered
}

# replacePrefix --
#
#	Take the normalized search path and put back the
#	macro name for it.
#
# Arguments:
#	file	filename.
#
# Results:
#	filename properly replaced with macro for it.

proc replacePrefix {file} {
    global srcPathList srcPathReplaceList

    foreach was $srcPathList is $srcPathReplaceList {
	regsub $was $file $is file
    }
    return $file
}

# rebaseFiles --
#
#	Replaces normalized paths with original macro names.
#
# Arguments:
#	depends		Dependency pair list.
#
# Results:
#	The processed dependency pair list.

proc rebaseFiles {depends} {
    set rebased {}
    foreach pair $depends {
        lappend rebased [list \
                [replacePrefix [lindex $pair 0]] \
		[replacePrefix [lindex $pair 1]]]

    }
    return $rebased
}

# compressDeps --
#
#	Compresses same named tragets into one pair with
#	multiple deps.
#
# Arguments:
#	depends	Dependency pair list.
#
# Results:
#	The processed list.

proc compressDeps {depends} {
    array set compressed [list]

    foreach pair $depends {
	lappend compressed([lindex $pair 0]) [lindex $pair 1]
    }

    set result [list]
    foreach n [array names compressed] {
        lappend result [list $n [lsort $compressed($n)]]
    }

    return $result
}

# addSearchPath --
#
#	Adds a new set of path and replacement string to the global list.
#
# Arguments:
#	newPathInfo	comma separated path and replacement string
#
# Results:
#	None.

proc addSearchPath {newPathInfo} {
    global srcPathList srcPathReplaceList

    set infoList [split $newPathInfo ,]
    lappend srcPathList [file normalize [lindex $infoList 0]]
    lappend srcPathReplaceList [lindex $infoList 1]
}


# displayUsage --
#
#	Displays usage to stderr
#
# Arguments:
#	none.
#
# Results:
#	None.

proc displayUsage {} {
    puts stderr "mkdepend.tcl \[options\] genericDir,macroName compatDir,macroName platformDir,macroName"
}

# readInputListFile --
#
#	Open and read the object file list.
#
# Arguments:
#	objectListFile - name of the file to open.
#
# Results:
#	None.

proc readInputListFile {objectListFile} {
    global srcFileList srcPathList source_extensions
    set f [open $objectListFile r]
    set fl [read $f]
    close $f

    # fix native path separator so it isn't treated as an escape.
    regsub -all {\\} $fl {/} fl

    # Treat the string as a list so filenames between double quotes are
    # treated as list elements.
    foreach fname $fl {
	# Compiled .res resource files should be ignored.
	if {[file extension $fname] ne ".obj"} {continue}

	# Just filename without path or extension because the path is
	# the build directory, not where the source files are located.
	set baseName [file rootname [file tail $fname]]

	set found 0
	foreach path $srcPathList {
	    foreach ext $source_extensions {
		set test [file join $path ${baseName}${ext}]
		if {[file exist $test]} {
		    lappend srcFileList $test
		    set found 1
		    break
		}
	    }
	    if {$found} break
	}
    }
}

# main --
#
#	The main procedure of this script.
#
# Arguments:
#	none.
#
# Results:
#	None.

proc main {} {
    global argc argv mode mode_data srcFileList srcPathList excludes
    global remove_prefix target_prefix output env

    set srcPathList [list]
    set srcFileList [list]

    if {$argc == 1} {displayUsage}

    # Parse mkdepend input
    for {set i 0} {$i < [llength $argv]} {incr i} {
	switch -glob -- [set arg [lindex $argv $i]] {
	    -vc32 {
		set mode vc32
	    }
	    -bc32 {
		set mode bc32
	    }
	    -wc32 {
		set mode wc32
	    }
	    -lc32 {
		set mode lc32
	    }
	    -mgw32 {
		set mode mgw32
	    }
	    -passthru:* {
		set passthru [string range $arg 10 end]
		regsub -all {"} $passthru {\"} passthru
		regsub -all {\\} $passthru {/} passthru
	    }
	    -out:* {
		openOutput [string range $arg 5 end]
	    }
	    @* {
		set objfile [string range $arg 1 end]
		regsub -all {\\} $objfile {/} objfile
		readInputListFile $objfile
	    }
	    -? - -help - --help {
		displayUsage
		exit 1
	    }
	    default {
		if {![info exist mode]} {
		    puts stderr "mode not set"
		    displayUsage
		}
		addSearchPath $arg
	    }
	}
    }

    # Execute the CPP command and parse output

    foreach srcFile $srcFileList {
	if {[catch {
	    set command "$mode_data($mode) $passthru \"$srcFile\""
	    set input [open |$command r]
	    set depends [readDepends $input]
	    set status [catch {close $input} result]
	    if {$status == 1 && [lindex $::errorCode 0] eq "CHILDSTATUS"} {
		foreach { - pid code } $::errorCode break
		if {$code == 2} {
		    # preprocessor died a cruel death.
		    error $result
		}
	    }
	} err]} {
	    puts stderr "error ocurred: $err\n"
	    continue
	}
	set depends [filterExcludes $depends $excludes]
	set depends [rebaseFiles $depends]
	set depends [compressDeps $depends]
	writeDepends $output $depends
    }

    closeOutput
}

# kick it up.
main
tcl8.6.14/tools/regexpTestLib.tcl0000644000175000017500000001665714554262142016306 0ustar  sergeisergei# regexpTestLib.tcl --
#
# This file contains tcl procedures used by spencer2testregexp.tcl and
# spencer2regexp.tcl, which are programs written to convert Henry
# Spencer's test suite to tcl test files.
#
# Copyright (c) 1996 Sun Microsystems, Inc.

proc readInputFile {} {
    global inFileName
    global lineArray

    set fileId [open $inFileName r]

    set i 0
    while {[gets $fileId line] >= 0} {

	set len [string length $line]

	if {($len > 0) && ([string index $line [expr {$len - 1}]] == "\\")} {
	    if {[info exists lineArray(c$i)] == 0} {
		set lineArray(c$i) 1
	    } else {
		incr lineArray(c$i)
	    }
	    set line [string range $line 0 [expr {$len - 2}]]
	    append lineArray($i) $line
	    continue
	}
	if {[info exists lineArray(c$i)] == 0} {
	    set lineArray(c$i) 1
	} else {
	    incr lineArray(c$i)
	}
	append lineArray($i) $line
	incr i
    }

    close $fileId
    return $i
}

#
# strings with embedded @'s are truncated
# unpreceeded @'s are replaced by {}
#
proc removeAts {ls} {
    set len [llength $ls]
    set newLs {}
    foreach item $ls {
	regsub @.* $item "" newItem
	lappend newLs $newItem
    }
    return $newLs
}

proc convertErrCode {code} {

    set errMsg "couldn't compile regular expression pattern:"

    if {[string compare $code "INVARG"] == 0} {
	return "$errMsg invalid argument to regex routine"
    } elseif {[string compare $code "BADRPT"] == 0} {
	return "$errMsg ?+* follows nothing"
    } elseif {[string compare $code "BADBR"] == 0} {
	return "$errMsg invalid repetition count(s)"
    } elseif {[string compare $code "BADOPT"] == 0} {
	return "$errMsg invalid embedded option"
    } elseif {[string compare $code "EPAREN"] == 0} {
	return "$errMsg unmatched ()"
    } elseif {[string compare $code "EBRACE"] == 0} {
	return "$errMsg unmatched {}"
    } elseif {[string compare $code "EBRACK"] == 0} {
	return "$errMsg unmatched \[\]"
    } elseif {[string compare $code "ERANGE"] == 0} {
	return "$errMsg invalid character range"
    } elseif {[string compare $code "ECTYPE"] == 0} {
	return "$errMsg invalid character class"
    } elseif {[string compare $code "ECOLLATE"] == 0} {
	return "$errMsg invalid collating element"
    } elseif {[string compare $code "EESCAPE"] == 0} {
	return "$errMsg invalid escape sequence"
    } elseif {[string compare $code "BADPAT"] == 0} {
	return "$errMsg invalid regular expression"
    } elseif {[string compare $code "ESUBREG"] == 0} {
	return "$errMsg invalid backreference number"
    } elseif {[string compare $code "IMPOSS"] == 0} {
	return "$errMsg can never match"
    }
    return "$errMsg $code"
}

proc writeOutputFile {numLines fcn} {
    global outFileName
    global lineArray

    # open output file and write file header info to it.

    set fileId [open $outFileName w]

    puts $fileId "# Commands covered:  $fcn"
    puts $fileId "#"
    puts $fileId "# This Tcl-generated file contains tests for the $fcn tcl command."
    puts $fileId "# Sourcing this file into Tcl runs the tests and generates output for"
    puts $fileId "# errors.  No output means no errors were found.  Setting VERBOSE to"
    puts $fileId "# -1 will run tests that are known to fail."
    puts $fileId "#"
    puts $fileId "# Copyright (c) 1998 Sun Microsystems, Inc."
    puts $fileId "#"
    puts $fileId "# See the file \"license.terms\" for information on usage and redistribution"
    puts $fileId "# of this file, and for a DISCLAIMER OF ALL WARRANTIES."
    puts $fileId "#"
    puts $fileId "\# SCCS: \%Z\% \%M\% \%I\% \%E\% \%U\%"
    puts $fileId "\nproc print \{arg\} \{puts \$arg\}\n"
    puts $fileId "if \{\[string compare test \[info procs test\]\] == 1\} \{"
    puts $fileId "    source defs ; set VERBOSE -1\n\}\n"
    puts $fileId "if \{\$VERBOSE != -1\} \{"
    puts $fileId "    proc print \{arg\} \{\}\n\}\n"
    puts $fileId "#"
    puts $fileId "# The remainder of this file is Tcl tests that have been"
    puts $fileId "# converted from Henry Spencer's regexp test suite."
    puts $fileId "#\n"

    set lineNum 0
    set srcLineNum 1
    while {$lineNum < $numLines} {

	set currentLine $lineArray($lineNum)

	# copy comment string to output file and continue

	if {[string index $currentLine 0] == "#"} {
	    puts $fileId $currentLine
	    incr srcLineNum $lineArray(c$lineNum)
	    incr lineNum
	    continue
	}

	set len [llength $currentLine]

	# copy empty string to output file and continue

	if {$len == 0} {
	    puts $fileId "\n"
	    incr srcLineNum $lineArray(c$lineNum)
	    incr lineNum
	    continue
	}
	if {($len < 3)} {
	    puts "warning: test is too short --\n\t$currentLine"
	    incr srcLineNum $lineArray(c$lineNum)
	    incr lineNum
	    continue
	}

	puts $fileId [convertTestLine $currentLine $len $lineNum $srcLineNum]

	incr srcLineNum $lineArray(c$lineNum)
	incr lineNum
    }

    close $fileId
}

proc convertTestLine {currentLine len lineNum srcLineNum} {

    regsub -all {(?b)\\} $currentLine {\\\\} currentLine
    set re [lindex $currentLine 0]
    set flags [lindex $currentLine 1]
    set str [lindex $currentLine 2]

    # based on flags, decide whether to skip the test

    if {[findSkipFlag $flags]} {
	regsub -all {\[|\]|\(|\)|\{|\}|\#} $currentLine {\&} line
	set msg "\# skipping char mapping test from line $srcLineNum\n"
	append msg "print \{... skip test from line $srcLineNum:  $line\}"
	return $msg
    }

    # perform mapping if '=' flag exists

    set noBraces 0
    if {[regexp {=|>} $flags] == 1} {
	regsub -all {_} $currentLine {\\ } currentLine
	regsub -all {A} $currentLine {\\007} currentLine
	regsub -all {B} $currentLine {\\b} currentLine
	regsub -all {E} $currentLine {\\033} currentLine
	regsub -all {F} $currentLine {\\f} currentLine
	regsub -all {N} $currentLine {\\n} currentLine

	# if and \r substitutions are made, do not wrap re, flags,
	# str, and result in braces

	set noBraces [regsub -all {R} $currentLine {\\\u000D} currentLine]
	regsub -all {T} $currentLine {\\t} currentLine
	regsub -all {V} $currentLine {\\v} currentLine
	if {[regexp {=} $flags] == 1} {
	    set re [lindex $currentLine 0]
	}
	set str [lindex $currentLine 2]
    }
    set flags [removeFlags $flags]

    # find the test result

    set numVars [expr {$len - 3}]
    set vars {}
    set vals {}
    set result 0
    set v 0

    if {[regsub {\*} "$flags" "" newFlags] == 1} {
	# an error is expected

	if {[string compare $str "EMPTY"] == 0} {
	    # empty regexp is not an error
	    # skip this test

	    return "\# skipping the empty-re test from line $srcLineNum\n"
	}
	set flags $newFlags
	set result "\{1 \{[convertErrCode $str]\}\}"
    } elseif {$numVars > 0} {
	# at least 1 match is made

	if {[regexp {s} $flags] == 1} {
	    set result "\{0 1\}"
	} else {
	    while {$v < $numVars} {
		append vars " var($v)"
		append vals " \$var($v)"
		incr v
	    }
	    set tmp [removeAts [lrange $currentLine 3 $len]]
	    set result "\{0 \{1 $tmp\}\}"
	    if {$noBraces} {
		set result "\[subst $result\]"
	    }
	}
    } else {
	# no match is made

	set result "\{0 0\}"
    }

    # set up the test and write it to the output file

    set cmd [prepareCmd $flags $re $str $vars $noBraces]
    if {$cmd == -1} {
	return "\# skipping test with metasyntax from line $srcLineNum\n"
    }

    set test "test regexp-1.$srcLineNum \{converted from line $srcLineNum\} \{\n"
    append test "\tcatch {unset var}\n"
    append test "\tlist \[catch \{\n"
    append test "\t\tset match \[$cmd\]\n"
    append test "\t\tlist \$match $vals\n"
    append test "\t\} msg\] \$msg\n"
    append test "\} $result\n"
    return $test
}

tcl8.6.14/tools/tcltk-man2html.tcl0000755000175000017500000005127614554262142016365 0ustar  sergeisergei#!/usr/bin/env tclsh

if {[catch {package require Tcl 8.6-} msg]} {
    puts stderr "ERROR: $msg"
    puts stderr "If running this script from 'make html', set the\
	NATIVE_TCLSH environment\nvariable to point to an installed\
	tclsh8.6 (or the equivalent tclsh86.exe\non Windows)."
    exit 1
}

# Convert Ousterhout format man pages into highly crosslinked hypertext.
#
# Along the way detect many unmatched font changes and other odd things.
#
# Note well, this program is a hack rather than a piece of software
# engineering.  In that sense it's probably a good example of things
# that a scripting language, like Tcl, can do well.  It is offered as
# an example of how someone might convert a specific set of man pages
# into hypertext, not as a general solution to the problem.  If you
# try to use this, you'll be very much on your own.
#
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
# Copyright (c) 2004-2010 Donal K. Fellows

set ::Version "50/8.6"
set ::CSSFILE "docs.css"

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]

proc parse_command_line {} {
    global argv Version

    # These variables determine where the man pages come from and where
    # the converted pages go to.
    global tcltkdir tkdir tcldir webdir build_tcl build_tk verbose

    # Set defaults based on original code.
    set tcltkdir ../..
    set tkdir {}
    set tcldir {}
    set webdir ../html
    set build_tcl 0
    set build_tk 0
    set verbose 0
    # Default search version is a glob pattern
    set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}

    # Handle arguments a la GNU:
    #   --version
    #   --useversion=
    #   --help
    #   --srcdir=/path
    #   --htmldir=/path

    foreach option $argv {
	switch -glob -- $option {
	    --version {
		puts "tcltk-man-html $Version"
		exit 0
	    }

	    --help {
		puts "usage: tcltk-man-html \[OPTION\] ...\n"
		puts "  --help              print this help, then exit"
		puts "  --version           print version number, then exit"
		puts "  --srcdir=DIR        find tcl and tk source below DIR"
		puts "  --htmldir=DIR       put generated HTML in DIR"
		puts "  --tcl               build tcl help"
		puts "  --tk                build tk help"
		puts "  --useversion        version of tcl/tk to search for"
		puts "  --verbose           whether to print longer messages"
		exit 0
	    }

	    --srcdir=* {
		# length of "--srcdir=" is 9.
		set tcltkdir [string range $option 9 end]
	    }

	    --htmldir=* {
		# length of "--htmldir=" is 10
		set webdir [string range $option 10 end]
	    }

	    --useversion=* {
		# length of "--useversion=" is 13
		set useversion [string range $option 13 end]
	    }

	    --tcl {
		set build_tcl 1
	    }

	    --tk {
		set build_tk 1
	    }

	    --verbose=* {
		set verbose [string range $option \
				 [string length --verbose=] end]
	    }
	    default {
		puts stderr "tcltk-man-html: unrecognized option -- `$option'"
		exit 1
	    }
	}
    }

    if {!$build_tcl && !$build_tk} {
	set build_tcl 1;
	set build_tk 1
    }

    if {$build_tcl} {
	# Find Tcl
	set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
		-directory $tcltkdir tcl$useversion]] end]
	if {$tcldir eq ""} {
	    puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
	    exit 1
	}
	puts "using Tcl source directory $tcldir"
    }

    if {$build_tk} {
	# Find Tk
	set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
		-directory $tcltkdir tk$useversion]] end]
	if {$tkdir eq ""} {
	    puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
	    exit 1
	}
	puts "using Tk source directory $tkdir"
    }

    puts "verbose messages are [expr {$verbose ? {on} : {off}}]"

    # the title for the man pages overall
    global overall_title
    set overall_title ""
    if {$build_tcl} {
	append overall_title "[capitalize $tcldir]"
    }
    if {$build_tcl && $build_tk} {
	append overall_title "/"
    }
    if {$build_tk} {
	append overall_title "[capitalize $tkdir]"
    }
    append overall_title " Documentation"
}

proc capitalize {string} {
    return [string toupper $string 0]
}

##
## Returns the style sheet.
##
proc css-style args {
    upvar 1 style style
    set body [uplevel 1 [list subst [lindex $args end]]]
    set tokens [join [lrange $args 0 end-1] ", "]
    append style $tokens " \{" $body "\}\n"
}
proc css-stylesheet {} {
    set hBd "1px dotted #11577B"

    css-style body div p th td li dd ul ol dl dt blockquote {
	font-family: Verdana, sans-serif;
    }
    css-style pre code {
	font-family: 'Courier New', Courier, monospace;
    }
    css-style pre {
	background-color:  #F6FCEC;
	border-top:        1px solid #6A6A6A;
	border-bottom:     1px solid #6A6A6A;
	padding:           1em;
	overflow:          auto;
    }
    css-style body {
	background-color:  #FFFFFF;
	font-size:         12px;
	line-height:       1.25;
	letter-spacing:    .2px;
	padding-left:      .5em;
    }
    css-style h1 h2 h3 h4 {
	font-family:       Georgia, serif;
	padding-left:      1em;
	margin-top:        1em;
    }
    css-style h1 {
	font-size:         18px;
	color:             #11577B;
	border-bottom:     $hBd;
	margin-top:        0px;
    }
    css-style h2 {
	font-size:         14px;
	color:             #11577B;
	background-color:  #C5DCE8;
	padding-left:      1em;
	border:            1px solid #6A6A6A;
    }
    css-style h3 h4 {
	color:             #1674A4;
	background-color:  #E8F2F6;
	border-bottom:     $hBd;
	border-top:        $hBd;
    }
    css-style h3 {
	font-size: 12px;
    }
    css-style h4 {
	font-size: 11px;
    }
    css-style ".keylist dt" ".arguments dt" {
	width: 25em;
	float: left;
	padding: 2px;
	border-top: 1px solid #999999;
    }
    css-style ".keylist dt" { font-weight: bold; }
    css-style ".keylist dd" ".arguments dd" {
	margin-left: 25em;
	padding: 2px;
	border-top: 1px solid #999999;
    }
    css-style .copy {
	background-color:  #F6FCFC;
	white-space:       pre;
	font-size:         80%;
	border-top:        1px solid #6A6A6A;
	margin-top:        2em;
    }
    css-style .tablecell {
	font-size:	   12px;
	padding-left:	   .5em;
	padding-right:	   .5em;
    }
}

##
## foreach of the man directories specified by args
## convert manpages into hypertext in the directory
## specified by html.
##
proc make-man-pages {html args} {
    global manual overall_title tcltkdesc verbose
    global excluded_pages forced_index_pages process_first_patterns

    makedirhier $html
    set cssfd [open $html/$::CSSFILE w]
    fconfigure $cssfd -translation lf -encoding utf-8
    puts $cssfd [css-stylesheet]
    close $cssfd
    set manual(short-toc-n) 1
    set manual(short-toc-fp) [open $html/[indexfile] w]
    fconfigure $manual(short-toc-fp) -translation lf -encoding utf-8
    puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title]
    puts $manual(short-toc-fp) "
"
    set manual(merge-copyrights) {}

    foreach arg $args {
	# preprocess to set up subheader for the rest of the files
	if {![llength $arg]} {
	    continue
	}
	lassign $arg -> name file
	if {[regexp {(.*)(?: Package)? Commands(?:, version .*)?} $name -> pkg]} {
	    set name "$pkg Commands"
	} elseif {[regexp {(.*)(?: Package)? C API(?:, version .*)?} $name -> pkg]} {
	    set name "$pkg C API"
	}
	lappend manual(subheader) $name $file
    }

    ##
    ## parse the manpages in a section of the docs (split by
    ## package) and construct formatted manpages
    ##
    foreach arg $args {
	if {[llength $arg]} {
	    make-manpage-section $html $arg
	}
    }

    ##
    ## build the keyword index.
    ##
    if {!$verbose} {
	puts stderr "Assembling index"
    }
    file delete -force -- $html/Keywords
    makedirhier $html/Keywords
    set keyfp [open $html/Keywords/[indexfile] w]
    fconfigure $keyfp -translation lf -encoding utf-8
    puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \
		     $overall_title "../[indexfile]"]
    set letters {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
    # Create header first
    set keyheader {}
    foreach a $letters {
	set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
	if {[llength $keys]} {
	    lappend keyheader "$a"
	} else {
	    # No keywords for this letter
	    lappend keyheader $a
	}
    }
    set keyheader 
[join $keyheader " |\n"]

    puts $keyfp $keyheader
    foreach a $letters {
	set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
	if {![llength $keys]} {
	    continue
	}
	# Per-keyword page
	set afp [open $html/Keywords/$a.htm w]
	fconfigure $afp -translation lf -encoding utf-8
	puts $afp [htmlhead "$tcltkdesc Keywords - $a" \
		       "$tcltkdesc Keywords - $a" \
		       $overall_title "../[indexfile]"]
	puts $afp $keyheader
	puts $afp "
"
	foreach k [lsort -dictionary $keys] {
	    set k [string range $k 8 end]
	    puts $afp "
$k
"
	    puts $afp "
"
	    set refs {}
	    foreach man $manual(keyword-$k) {
		set name [lindex $man 0]
		set file [lindex $man 1]
		if {[info exists manual(tooltip-$file)]} {
		    set tooltip $manual(tooltip-$file)
		    if {[string match {*[<>""]*} $tooltip]} {
			manerror "bad tooltip for $file: \"$tooltip\""
		    }
		    lappend refs "$name"
		} else {
		    lappend refs "$name"
		}
	    }
	    puts $afp "[join $refs {, }]
"
	}
	puts $afp "
"
	# insert merged copyrights
	puts $afp [copyout $manual(merge-copyrights)]
	puts $afp ""
	close $afp
    }
    # insert merged copyrights
    puts $keyfp [copyout $manual(merge-copyrights)]
    puts $keyfp ""
    close $keyfp

    ##
    ## finish off short table of contents
    ##
    puts $manual(short-toc-fp) "
Keywords
The keywords from the $tcltkdesc man pages."
    puts $manual(short-toc-fp) "
"
    # insert merged copyrights
    puts $manual(short-toc-fp) [copyout $manual(merge-copyrights)]
    puts $manual(short-toc-fp) ""
    close $manual(short-toc-fp)

    ##
    ## output man pages
    ##
    unset manual(section)
    if {!$verbose} {
	puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links and write out"
    }
    foreach path $manual(all-pages) wing_name $manual(all-page-domains) {
	set manual(wing-file) [file dirname $path]
	set manual(tail) [file tail $path]
	set manual(name) [file root $manual(tail)]
	try {
	    set text $manual(output-$manual(wing-file)-$manual(name))
	    set ntext 0
	    foreach item $text {
		incr ntext [llength [split $item \n]]
		incr ntext
	    }
	    set toc $manual(toc-$manual(wing-file)-$manual(name))
	    set ntoc 0
	    foreach item $toc {
		incr ntoc [llength [split $item \n]]
		incr ntoc
	    }
	    if {$verbose} {
		puts stderr "rescanning page $manual(name) $ntoc/$ntext"
	    } else {
		puts -nonewline stderr .
	    }
	    set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
	    fconfigure $outfd -translation lf -encoding utf-8
	    puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \
		    $manual(name) $wing_name "[indexfile]" \
		    $overall_title "../[indexfile]"]
	    if {($ntext > 60) && ($ntoc > 32)} {
		foreach item $toc {
		    puts $outfd $item
		}
	    } elseif {$manual(name) in $forced_index_pages} {
		if {!$verbose} {puts stderr ""}
		manerror "forcing index generation"
		foreach item $toc {
		    puts $outfd $item
		}
	    }
	    foreach item $text {
		puts $outfd [insert-cross-references $item]
	    }
	    puts $outfd ""
	} on error msg {
	    if {$verbose} {
		puts stderr $msg
	    } else {
		puts stderr "\nError when processing $manual(name): $msg"
	    }
	} finally {
	    catch {close $outfd}
	}
    }
    if {!$verbose} {
	puts stderr "\nDone"
    }
    return {}
}

##
## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk).
##
proc plus-base {var root glob name dir desc} {
    global tcltkdir
    if {$var} {
	if {[file exists $tcltkdir/$root/README.md]} {
	    set f [open $tcltkdir/$root/README.md]
	    fconfigure $f -encoding utf-8
	    set d [read $f]
	    close $f
	    if {[regexp {This is the \*\*\w+ (\S+)\*\* source distribution} $d -> version]} {
	       append name ", version $version"
	    }
	}
	set glob $root/$glob
	return [list $tcltkdir/$glob $name $dir $desc]
    }
}

##
## Helper for assembling the descriptions of contributed packages.
##
proc plus-pkgs {type args} {
    global build_tcl tcltkdir tcldir
    if {$type ni {n 3}} {
	error "unknown type \"$type\": must be 3 or n"
    }
    if {!$build_tcl} return
    set result {}
    set pkgsdir $tcltkdir/$tcldir/pkgs
    foreach {dir name version} $args {
	set globpat $pkgsdir/$dir/doc/*.$type
	if {![llength [glob -type f -nocomplain $globpat]]} {
	    # Fallback for manpages generated using doctools
	    set globpat $pkgsdir/$dir/doc/man/*.$type
	    if {![llength [glob -type f -nocomplain $globpat]]} {
		continue
	    }
	}
	set dir [string trimright $dir "0123456789-."]
	switch $type {
	    n {
		set title "$name Package Commands"
		if {$version ne ""} {
		    append title ", version $version"
		}
		set dir [string totitle $dir]Cmd
		set desc \
		    "The additional commands provided by the $name package."
	    }
	    3 {
		set title "$name Package C API"
		if {$version ne ""} {
		    append title ", version $version"
		}
		set dir [string totitle $dir]Lib
		set desc \
		    "The additional C functions provided by the $name package."
	    }
	}
	lappend result [list $globpat $title $dir $desc]
    }
    return $result
}

##
## Set up some special cases. It would be nice if we didn't have them,
## but we do...
##
set excluded_pages {case menubar pack-old}
set forced_index_pages {GetDash}
set process_first_patterns {*/ttk_widget.n */options.n}
set ensemble_commands {
    after array binary chan clock dde dict encoding file history info interp
    memory namespace package registry self string trace update zlib
    clipboard console font grab grid image option pack place selection tk
    tkwait ttk::style winfo wm itcl::delete itcl::find itcl::is
}
array set remap_link_target {
    stdin  Tcl_GetStdChannel
    stdout Tcl_GetStdChannel
    stderr Tcl_GetStdChannel
    style  ttk::style
    {style map} ttk::style
    {tk busy}   busy
    library     auto_execok
    safe-tcl    safe
    tclvars     env
    tcl_break   catch
    tcl_continue catch
    tcl_error   catch
    tcl_ok      catch
    tcl_return  catch
    int()       mathfunc
    wide()      mathfunc
    packagens   pkg::create
    pkgMkIndex  pkg_mkIndex
    pkg_mkIndex pkg_mkIndex
    Tcl_Obj     Tcl_NewObj
    Tcl_ObjType Tcl_RegisterObjType
    Tcl_OpenFileChannelProc Tcl_FSOpenFileChannel
    errorinfo 	env
    errorcode 	env
    tcl_pkgpath env
    Tcl_Command Tcl_CreateObjCommand
    Tcl_CmdProc Tcl_CreateObjCommand
    Tcl_CmdDeleteProc Tcl_CreateObjCommand
    Tcl_ObjCmdProc Tcl_CreateObjCommand
    Tcl_Channel Tcl_OpenFileChannel
    Tcl_WideInt Tcl_NewIntObj
    Tcl_ChannelType Tcl_CreateChannel
    Tcl_DString Tcl_DStringInit
    Tcl_Namespace Tcl_AppendExportList
    Tcl_Object  Tcl_NewObjectInstance
    Tcl_Class   Tcl_GetObjectAsClass
    Tcl_Event   Tcl_QueueEvent
    Tcl_Time	Tcl_GetTime
    Tcl_ThreadId Tcl_CreateThread
    Tk_Window	Tk_WindowId
    Tk_3DBorder Tk_Get3DBorder
    Tk_Anchor	Tk_GetAnchor
    Tk_Cursor	Tk_GetCursor
    Tk_Dash	Tk_GetDash
    Tk_Font	Tk_GetFont
    Tk_Image	Tk_GetImage
    Tk_ImageMaster Tk_GetImage
    Tk_ImageModel Tk_GetImage
    Tk_ItemType Tk_CreateItemType
    Tk_Justify	Tk_GetJustify
    Ttk_Theme	Ttk_GetTheme
}
array set exclude_refs_map {
    bind.n		{button destroy option}
    clock.n		{next}
    history.n		{exec}
    next.n		{unknown}
    zlib.n		{binary close filename text}
    canvas.n		{bitmap text}
    console.n		{eval}
    checkbutton.n	{image}
    clipboard.n		{string}
    entry.n		{string}
    event.n		{return}
    font.n		{menu}
    getOpenFile.n	{file open text}
    grab.n		{global}
    interp.n		{time}
    menu.n		{checkbutton radiobutton}
    messageBox.n	{error info}
    options.n		{bitmap image set}
    radiobutton.n	{image}
    safe.n		{join split}
    scale.n		{label variable}
    scrollbar.n		{set}
    selection.n		{string}
    tcltest.n		{error}
    text.n		{bind image lower raise}
    tkvars.n		{tk}
    tkwait.n		{variable}
    tm.n		{exec}
    ttk_checkbutton.n	{variable}
    ttk_combobox.n	{selection}
    ttk_entry.n		{focus variable}
    ttk_intro.n		{focus text}
    ttk_label.n		{font text}
    ttk_labelframe.n	{text}
    ttk_menubutton.n	{flush}
    ttk_notebook.n	{image text}
    ttk_progressbar.n	{variable}
    ttk_radiobutton.n	{variable}
    ttk_scale.n		{variable}
    ttk_scrollbar.n	{set}
    ttk_spinbox.n	{format}
    ttk_treeview.n	{text open}
    ttk_widget.n	{image text variable}
    TclZlib.3		{binary flush filename text}
}
array set exclude_when_followed_by_map {
    canvas.n {
	bind widget
	focus widget
	image are
	lower widget
	raise widget
    }
    selection.n {
	clipboard selection
	clipboard ;
    }
    ttk_image.n {
	image imageSpec
    }
    fontchooser.n {
	tk fontchooser
    }
}

try {
    # Parse what the user told us to do
    parse_command_line

    # Some strings depend on what options are specified
    set tcltkdesc ""; set cmdesc ""; set appdir ""
    if {$build_tcl} {
	append tcltkdesc "Tcl"
	append cmdesc "Tcl"
	append appdir "$tcldir"
    }
    if {$build_tcl && $build_tk} {
	append tcltkdesc "/"
	append cmdesc " and "
	append appdir ","
    }
    if {$build_tk} {
	append tcltkdesc "Tk"
	append cmdesc "Tk"
	append appdir "$tkdir"
    }

    apply {{} {
    global packageBuildList tcltkdir tcldir build_tcl

    # When building docs for Tcl, try to build docs for bundled packages too
    set packageBuildList {}
    if {$build_tcl} {
	set pkgsDir [file join $tcltkdir $tcldir pkgs]
	set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *]

	foreach dir [lsort $subdirs] {
	    # Parse the subdir name into (name, version) as fallback...
	    set description [split $dir -]
	    if {2 != [llength $description]} {
		regexp {([^0-9]*)(.*)} $dir -> n v
		set description [list $n $v]
	    }

	    # ... but try to extract (name, version) from subdir contents
	    try {
		try {
		    set f [open [file join $pkgsDir $dir configure.in]]
		} trap {POSIX ENOENT} {} {
		    set f [open [file join $pkgsDir $dir configure.ac]]
		}
		fconfigure $f -encoding utf-8
		foreach line [split [read $f] \n] {
		    if {2 == [scan $line \
			    { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} {
			set description [list $n $v]
			break
		    }
		}
	    } finally {
		catch {close $f; unset f}
	    }

	    if {[file exists [file join $pkgsDir $dir configure]]} {
		# Looks like a package, record our best extraction attempt
		lappend packageBuildList $dir {*}$description
	    }
	}
    }

    # Get the list of packages to try, and what their human-readable names
    # are. Note that the package directory list should be version-less.
    try {
	set packageDirNameMap {}
	if {$build_tcl} {
	    set f [open $tcltkdir/$tcldir/pkgs/package.list.txt]
	    fconfigure $f -encoding utf-8
	    try {
		foreach line [split [read $f] \n] {
		    if {[string trim $line] eq ""} continue
		    if {[string match #* $line]} continue
		    lassign $line dir name
		    lappend packageDirNameMap $dir $name
		}
	    } finally {
		close $f
	    }
	}
    } trap {POSIX ENOENT} {} {
	set packageDirNameMap {
	    itcl {[incr Tcl]}
	    tdbc {TDBC}
	    thread Thread
	}
    }

    # Convert to human readable names, if applicable
    for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} {
	lassign [lrange $packageBuildList $idx $idx+2] d n v
	if {[dict exists $packageDirNameMap $n]} {
	    lset packageBuildList $idx+1 [dict get $packageDirNameMap $n]
	}
    }
    }}

    #
    # Invoke the scraper/converter engine.
    #
    make-man-pages $webdir \
	[list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \
	     "The interpreters which implement $cmdesc."] \
	[plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \
	     "The commands which the tclsh interpreter implements."] \
	[plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \
	     "The additional commands which the wish interpreter implements."] \
	{*}[plus-pkgs n {*}$packageBuildList] \
	[plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \
	     "The C functions which a Tcl extended C program may use."] \
	[plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \
	     "The additional C functions which a Tk extended C program may use."] \
	{*}[plus-pkgs 3 {*}$packageBuildList]
} on error {msg opts} {
    # On failure make sure we show what went wrong. We're not supposed
    # to get here though; it represents a bug in the script.
    puts $msg\n[dict get $opts -errorinfo]
    exit 1
}

# Local-Variables:
# mode: tcl
# End:
tcl8.6.14/tools/tcltk-man2html-utils.tcl0000644000175000017500000012622214554262142017512 0ustar  sergeisergei##
## Utility functions for Man->HTML converter. Note that these
## functions are specifically intended to work with the format as used
## by Tcl and Tk; they do not cope with arbitrary nroff markup.
##
## Copyright (c) 1995-1997 Roger E. Critchlow Jr
## Copyright (c) 2004-2011 Donal K. Fellows

set ::manual(report-level) 1

proc manerror {msg} {
    global manual
    set name {}
    set subj {}
    set procname [lindex [info level -1] 0]
    if {[info exists manual(name)]} {
	set name $manual(name)
    }
    if {[info exists manual(section)] && [string length $manual(section)]} {
	puts stderr "$name: $manual(section): $procname: $msg"
    } else {
	puts stderr "$name: $procname: $msg"
    }
}

proc manreport {level msg} {
    global manual
    if {$level < $manual(report-level)} {
	uplevel 1 [list manerror $msg]
    }
}

proc fatal {msg} {
    global manual
    uplevel 1 [list manerror $msg]
    exit 1
}

##
## templating
##
proc indexfile {} {
    if {[info exists ::TARGET] && $::TARGET eq "devsite"} {
	return "index.tml"
    } else {
	return "contents.htm"
    }
}

proc copyright {copyright {level {}}} {
    # We don't actually generate a separate copyright page anymore
    #set page "${level}copyright.htm"
    #return "Copyright © [htmlize-text [lrange $copyright 2 end]]"
    # obfuscate any email addresses that may appear in name
    set who [string map {@ (at)} [lrange $copyright 2 end]]
    return "Copyright © [htmlize-text $who]"
}

proc copyout {copyrights {level {}}} {
    set count 0
    set out "
"
    foreach c $copyrights {
	if {$count > 0} {
	    append out 

	}
	append out "[copyright $c $level]\n"
	incr count
    }
    append out "
"
    return $out
}

proc CSS {{level ""}} {
    return "\n"
}

proc DOCTYPE {} {
    return ""
}

proc htmlhead {title header args} {
    set level ""
    if {[lindex $args end] eq "../[indexfile]"} {
	# XXX hack - assume same level for CSS file
	set level "../"
    }
    set out "[DOCTYPE]\n\n$title\n[CSS $level]\n"
    foreach {uptitle url} $args {
	set header "$uptitle > $header"
    }
    append out "
$header
"
    global manual
    if {[info exists manual(subheader)]} {
	set subs {}
	foreach {name subdir} $manual(subheader) {
	    if {$name eq $title} {
		lappend subs $name
	    } else {
		lappend subs "$name"
	    }
	}
	append out "\n
[join $subs { | }]
"
    }
    return $out
}

##
## parsing
##
proc unquote arg {
    return [string map [list \" {}] $arg]
}

proc parse-directive {line codename restname} {
    upvar 1 $codename code $restname rest
    return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
}

proc htmlize-text {text {charmap {}}} {
    # contains some extras for use in nroff->html processing
    # build on the list passed in, if any
    lappend charmap \
	"–" "–" \
	{&}	{&} \
	{\\}	"\" \
	{\e}	"\" \
	{\ }	{ } \
	{\|}	{ } \
	{\0}	{ } \
	\"	{"} \
	{<}	{<} \
	{>}	{>} \
	\u201C "“" \
	\u201D "”"

    return [string map $charmap $text]
}

proc process-text {text} {
    global manual
    # preprocess text; note that this is an incomplete map, and will probably
    # need to have things added to it as the manuals expand to use them.
    set charmap [list \
	    {\&}	"\t" \
	    {\%}	{} \
	    "\\\n"	"\n" \
	    {\(r!}	"¡" \
	    {\(ct}	"¢" \
	    {\(Po}	"£" \
	    {\(Cs}	"¤" \
	    {\(Ye}	"¥" \
	    {\(bb}	"¦" \
	    {\(sc}	"§" \
	    {\(ad}	"¨" \
	    {\(co}	"©" \
	    {\(Of}	"ª" \
	    {\(Fo}	"«" \
	    {\(no}	"¬" \
	    {\(rg}	"®" \
	    {\(a-}	"¯" \
	    {\(de}	"°" \
	    {\(+-}	"±" \
	    {\(S2}	"²" \
	    {\(S3}	"³" \
	    {\(aa}	"´" \
	    {\(mc}	"µ" \
	    {\(ps}	"¶" \
	    {\(pc}	"·" \
	    {\(ac}	"¸" \
	    {\(S1}	"¹" \
	    {\(Om}	"º" \
	    {\(Fc}	"»" \
	    {\(14}	"¼" \
	    {\(12}	"½" \
	    {\(34}	"¾" \
	    {\(r?}	"¿" \
	    {\(AE}	"Æ" \
	    {\(-D}	"Ð" \
	    {\(mu}	"×" \
	    {\(TP}	"Þ" \
	    {\(ss}	"ß" \
	    {\(ae}	"æ" \
	    {\(Sd}	"ð" \
	    {\(di}	"÷" \
	    {\(Tp}	"þ" \
	    {\(em}	"—" \
	    {\(en}	"–" \
	    {\(fm}	"′" \
	    {\(mi}	"−" \
	    {\(.i}	"ı" \
	    {\(.j}	"ȷ" \
	    {\(Fn}	"ƒ" \
	    {\(OE}	"Œ" \
	    {\(oe}	"œ" \
	    {\(IJ}	"IJ" \
	    {\(ij}	"ij" \
	    {\(<-}	"←" \
	    {\(->}	"→" \
	    {\(eu}	"€" \
	    {\fP}	{\fR} \
	    {\.}	. \
	    {\(bu}	"•" \
	    {\*(qo}	"ô" \
	    ]
    # This might make a few invalid mappings, but we don't use them
    foreach c {a c e g i l n o s t u y z A C E G I L N O S T U Y Z} {
	foreach {prefix suffix} {
	    o ring / slash : uml ' acute ^ circ ` grave ~ tilde , cedil v caron
	} {
	    lappend charmap "\\\[${prefix}${c}\]" "&${c}${suffix};"
	    lappend charmap "\\(${prefix}${c}" "&${c}${suffix};"
	}
    }
    lappend charmap {\-\|\-} --        ; # two hyphens
    lappend charmap {\-} -             ; # a hyphen

    set text [htmlize-text $text $charmap]
    # General quoted entity
    regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text
    while {[string first "\\" $text] >= 0} {
	# C R
	if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
		{\1\2\3} text]} continue
	# B R
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
		{\1\2\3} text]} continue
	# B I
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
		{\1\2\\fI\3} text]} continue
	# I R
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
		{\1\2\3} text]} continue
	# I B
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
		{\1\2\\fB\3} text]} continue
	# B B, I I, R R
	if {
	    [regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
		{\1\\fB\2\3} ntext]
	    || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
		    {\1\\fI\2\3} ntext]
	    || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
		    {\1\\fR\2\3} ntext]
	} {
	    manerror "impotent font change: $text"
	    set text $ntext
	    continue
	}
	# unrecognized
	manerror "uncaught backslash: $text"
	set text [string map [list "\\" "\"] $text]
    }
    return $text
}

##
## pass 2 text input and matching
##
proc open-text {} {
    global manual
    set manual(text-length) [llength $manual(text)]
    set manual(text-pointer) 0
}

proc more-text {} {
    global manual
    return [expr {$manual(text-pointer) < $manual(text-length)}]
}

proc next-text {} {
    global manual
    if {[more-text]} {
	set text [lindex $manual(text) $manual(text-pointer)]
	incr manual(text-pointer)
	return $text
    }
    manerror "read past end of text"
    error "fatal"
}

proc is-a-directive {line} {
    return [string match .* $line]
}

proc split-directive {line opname restname} {
    upvar 1 $opname op $restname rest
    set op [string range $line 0 2]
    set rest [string trim [string range $line 3 end]]
}

proc next-op-is {op restname} {
    global manual
    upvar 1 $restname rest
    if {[more-text]} {
	set text [lindex $manual(text) $manual(text-pointer)]
	if {[string equal -length 3 $text $op]} {
	    set rest [string range $text 4 end]
	    incr manual(text-pointer)
	    return 1
	}
    }
    return 0
}

proc backup-text {n} {
    global manual
    if {$manual(text-pointer)-$n >= 0} {
	incr manual(text-pointer) -$n
    }
}

proc match-text args {
    global manual
    set nargs [llength $args]
    if {$manual(text-pointer) + $nargs > $manual(text-length)} {
	return 0
    }
    set nback 0
    foreach arg $args {
	if {![more-text]} {
	    backup-text $nback
	    return 0
	}
	set arg [string trim $arg]
	set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
	if {$arg eq $targ} {
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp {^@(\w+)$} $arg all name]} {
	    upvar 1 $name var
	    set var $targ
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
		&& [string equal $op [lindex $targ 0]]} {
	    upvar 1 $name var
	    set var [lrange $targ 1 end]
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	backup-text $nback
	return 0
    }
    return 1
}

proc expand-next-text {n} {
    global manual
    return [join [lrange $manual(text) $manual(text-pointer) \
	    [expr {$manual(text-pointer)+$n-1}]] \n\n]
}

##
## pass 2 output
##
proc man-puts {text} {
    global manual
    lappend manual(output-$manual(wing-file)-$manual(name)) $text
}

##
## build hypertext links to tables of contents
##
proc long-toc {text} {
    global manual
    set here M[incr manual(section-toc-n)]
    set manual($manual(name)-id-$text) $here
    set there L[incr manual(long-toc-n)]
    lappend manual(section-toc) \
	    "
$text"
    return "$text"
}

proc option-toc {name class switch} {
    global manual
    # Special case handling, oh we hate it but must do it
    if {[string match "*OPTIONS" $manual(section)]} {
	if {$manual(name) ne "ttk_widget" && ($manual(name) ne "ttk_entry" ||
		![string match validate* $name])} {
	    # link the defined option into the long table of contents
	    set link [long-toc "$switch, $name, $class"]
	    regsub -- "$switch, $name, $class" $link "$switch" link
	    return $link
	}
    } elseif {"$manual(name):$manual(section)" ne "options:DESCRIPTION"} {
	error "option-toc in $manual(name) section $manual(section)"
    }

    # link the defined standard option to the long table of contents and make
    # a target for the standard option references from other man pages.

    set first [lindex $switch 0]
    set here M$first
    set there L[incr manual(long-toc-n)]
    set manual(standard-option-$manual(name)-$first) \
	"$switch, $name, $class"
    lappend manual(section-toc) \
	"
$switch, $name, $class"
    return "$switch"
}

proc std-option-toc {name page} {
    global manual
    if {[info exists manual(standard-option-$page-$name)]} {
	lappend manual(section-toc) 
$manual(standard-option-$page-$name)
	return $manual(standard-option-$page-$name)
    }
    manerror "missing reference to \"$name\" in $page.n"
    set here M[incr manual(section-toc-n)]
    set there L[incr manual(long-toc-n)]
    set other M$name
    lappend manual(section-toc) "
$name"
    return "$name"
}

##
## process the widget option section
## in widget and options man pages
##
proc output-widget-options {rest} {
    global manual
    man-puts 

    lappend manual(section-toc) 

    backup-text 1
    set para {}
    while {[next-op-is .OP rest]} {
	switch -exact -- [llength $rest] {
	    3 {
		lassign $rest switch name class
	    }
	    5 {
		set switch [lrange $rest 0 2]
		set name [lindex $rest 3]
		set class [lindex $rest 4]
	    }
	    default {
		fatal "bad .OP $rest"
	    }
	}
	if {![regexp {^(<.>)([-\w ]+)()$} $switch \
		all oswitch switch cswitch]} {
	    if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)()$} $switch \
		    all oswitch switch1 switch2 cswitch]} {
		error "not Switch: $switch"
	    }
	    set switch "$switch1$cswitch or $oswitch$switch2"
	}
	if {![regexp {^(<.>)([\w]*)()$} $name all oname name cname]} {
	    error "not Name: $name"
	}
	if {![regexp {^(<.>)([\w]*)()$} $class all oclass class cclass]} {
	    error "not Class: $class"
	}
	man-puts "$para
Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
	man-puts "
Database Name: $oname$name$cname"
	man-puts "
Database Class: $oclass$class$cclass"
	man-puts 
[next-text]
	set para 


	if {[next-op-is .RS rest]} {
	    while {[more-text]} {
		set line [next-text]
		if {[is-a-directive $line]} {
		    split-directive $line code rest
		    switch -exact -- $code {
			.RE {
			    break
			}
			.SH - .SS {
			    manerror "unbalanced .RS at section end"
			    backup-text 1
			    break
			}
			default {
			    output-directive $line
			}
		    }
		} else {
		    man-puts $line
		}
	    }
	}
    }
    man-puts 

    lappend manual(section-toc) 

}

##
## process .RS lists
##
proc output-RS-list {} {
    global manual
    if {[next-op-is .IP rest]} {
	output-IP-list .RS .IP $rest
	if {[match-text .RE .sp .RS @rest .IP @rest2]} {
	    man-puts 
$rest
	    output-IP-list .RS .IP $rest2
	}
	if {[match-text .RE .sp .RS @rest .RE]} {
	    man-puts 
$rest
	    return
	}
	if {[next-op-is .RE rest]} {
	    return
	}
    }
    man-puts 

    while {[more-text]} {
	set line [next-text]
	if {[is-a-directive $line]} {
	    split-directive $line code rest
	    switch -exact -- $code {
		.RE {
		    break
		}
		.SH - .SS {
		    manerror "unbalanced .RS at section end"
		    backup-text 1
		    break
		}
		default {
		    output-directive $line
		}
	    }
	} else {
	    man-puts $line
	}
    }
    man-puts 

}

##
## process .IP lists which may be plain indents,
## numeric lists, or definition lists
##
proc output-IP-list {context code rest} {
    global manual
    if {![string length $rest]} {
	# blank label, plain indent, no contents entry
	man-puts 

	while {[more-text]} {
	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		if {$code eq ".IP" && $rest eq {}} {
		    man-puts "
"
		    continue
		}
		if {$code in {.br .DS .RS}} {
		    output-directive $line
		} else {
		    backup-text 1
		    break
		}
	    } else {
		man-puts $line
	    }
	}
	man-puts 

    } else {
	# labelled list, make contents
	if {$context ne ".SH" && $context ne ".SS"} {
	    man-puts 

	}
	set dl "
"
	set enddl "
"
	if {$code eq ".IP"} {
	    if {[regexp {^\[[\da-f]+\]|\(?[\da-f]+\)$} $rest]} {
		set dl "
    "
		set enddl "
"
	    } elseif {"•" eq $rest} {
		set dl "
    "
		set enddl "
"
	    }
	}
	man-puts $dl
	lappend manual(section-toc) $dl
	backup-text 1
	set accept_RE 0
	set para {}
	while {[more-text]} {
	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		switch -exact -- $code {
		    .IP {
			if {$accept_RE} {
			    output-IP-list .IP $code $rest
			    continue
			}
			if {$manual(section) eq "ARGUMENTS"} {
			    man-puts "$para
$rest
"
			} elseif {[regexp {^\[([\da-f]+)\]$} $rest -> value]} {
			    man-puts "$para
  • "
			} elseif {[regexp {^\(?([\da-f]+)\)$} $rest -> value]} {
			    man-puts "$para
  • "
			} elseif {"•" eq $rest} {
			    man-puts "$para
  • "
			} else {
			    man-puts "$para
    [long-toc $rest]
    "
			}
		    }
		    .sp - .br - .DS - .CS {
			output-directive $line
		    }
		    .RS {
			if {[match-text .RS]} {
			    output-directive $line
			    incr accept_RE 1
			} elseif {[match-text .CS]} {
			    output-directive .CS
			    incr accept_RE 1
			} elseif {[match-text .PP]} {
			    output-directive .PP
			    incr accept_RE 1
			} elseif {[match-text .DS]} {
			    output-directive .DS
			    incr accept_RE 1
			} else {
			    output-directive $line
			}
		    }
		    .PP {
			if {[match-text @rest1 .br @rest2 .RS]} {
			    # yet another nroff kludge as above
			    man-puts "$para
    [long-toc $rest1]"
			    man-puts "
    [long-toc $rest2]
    "
			    incr accept_RE 1
			} elseif {[match-text @rest .RE]} {
			    # gad, this is getting ridiculous
			    if {!$accept_RE} {
				man-puts "$enddl
    $rest$dl"
				backup-text 1
				set para {}
				break
			    }
			    man-puts "
    $rest"
			    incr accept_RE -1
			} elseif {$accept_RE} {
			    output-directive $line
			} else {
			    backup-text 1
			    break
			}
		    }
		    .RE {
			if {!$accept_RE} {
			    backup-text 1
			    break
			}
			incr accept_RE -1
		    }
		    default {
			backup-text 1
			break
		    }
		}
	    } else {
		man-puts $line
	    }
	    set para 
    
	}
	man-puts "$para$enddl"
	lappend manual(section-toc) $enddl
	if {$accept_RE} {
	    manerror "missing .RE in output-IP-list"
	}
    }
}

##
## handle the NAME section lines
## there's only one line in the NAME section,
## consisting of a comma separated list of names,
## followed by a hyphen and a short description.
##
proc output-name {line} {
    global manual
    # split name line into pieces
    regexp {^([^-]+) - (.*)$} [regsub -all {[ \n\r\t]+} $line " "] -> head tail
    # output line to manual page untouched
    man-puts "$head — $tail"
    # output line to long table of contents
    lappend manual(section-toc) "
    $head — $tail
    "
    # separate out the names for future reference
    foreach name [split $head ,] {
	set name [string trim $name]
	if {[llength $name] > 1} {
	    manerror "name has a space: {$name}\nfrom: $line"
	}
	lappend manual(wing-toc) $name
	lappend manual(name-$name) $manual(wing-file)/$manual(name)
    }
    set manual(tooltip-$manual(wing-file)/$manual(name).htm) $line
}

##
## build a cross-reference link if appropriate
##
proc cross-reference {ref} {
    global manual remap_link_target
    global ensemble_commands exclude_refs_map exclude_when_followed_by_map
    set manname $manual(name)
    set mantail $manual(tail)
    if {[string match "Tcl_*" $ref] || [string match "Tk_*" $ref] || [string match "Ttk_*" $ref] || [string match "Itcl_*" $ref] || [string match "Tdbc_*" $ref]} {
	regexp {^\w+} $ref lref
	##
	## apply a link remapping if available
	##
	if {[info exists remap_link_target($lref)]} {
	    set lref $remap_link_target($lref)
	}
    } elseif {$ref eq "Tcl"} {
	set lref $ref
    } elseif {
	[regexp {^[A-Z0-9 ?!]+$} $ref]
	&& [info exists manual($manname-id-$ref)]
    } {
	return "$ref"
    } else {
	set lref [string tolower $ref]
	##
	## apply a link remapping if available
	##
	if {[info exists remap_link_target($lref)]} {
	    set lref $remap_link_target($lref)
	}
    }
    ##
    ## nothing to reference
    ##
    if {![info exists manual(name-$lref)]} {
	foreach name $ensemble_commands {
	    if {
		[regexp "^$name \[a-z0-9]*\$" $lref] &&
		[info exists manual(name-$name)] &&
		$mantail ne "$name.n" &&
		(![info exists exclude_refs_map($mantail)] ||
		$manual(name-$name) ni $exclude_refs_map($mantail))
	    } {
		return "$ref"
	    }
	}
	if {$lref in {end}} {
	    # no good place to send this tcl token?
	}
	return $ref
    }
    set manref $manual(name-$lref)
    ##
    ## would be a self reference
    ##
    foreach name $manref {
	if {"$manual(wing-file)/$manname" in $name} {
	    return $ref
	}
    }
    ##
    ## multiple choices for reference
    ##
    if {[llength $manref] > 1} {
	set tcl_i [lsearch -glob $manref *TclCmd*]
	if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd"
		|| $manual(wing-file) eq "TclLib"} {
	    set tcl_ref [lindex $manref $tcl_i]
	    return "$ref"
	}
	set tk_i [lsearch -glob $manref *TkCmd*]
	if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd"
		|| $manual(wing-file) eq "TkLib"} {
	    set tk_ref [lindex $manref $tk_i]
	    return "$ref"
	}
	if {$lref eq "exit" && $mantail eq "tclsh.1" && $tcl_i >= 0} {
	    set tcl_ref [lindex $manref $tcl_i]
	    return "$ref"
	}
	puts stderr "multiple cross reference to $ref in $manref from $manual(wing-file)/$mantail"
	return $ref
    }
    ##
    ## exceptions, sigh, to the rule
    ##
    if {[info exists exclude_when_followed_by_map($mantail)]} {
	upvar 1 text tail
	set following_word [lindex [regexp -inline {\S+} $tail] 0]
	foreach {this that} $exclude_when_followed_by_map($mantail) {
	    # only a ref if $this is not followed by $that
	    if {$lref eq $this && [string match $that* $following_word]} {
		return $ref
	    }
	}
    }
    if {
	[info exists exclude_refs_map($mantail)]
	&& $lref in $exclude_refs_map($mantail)
    } {
	return $ref
    }
    ##
    ## return the cross reference
    ##
    return "$ref"
}

##
## reference generation errors
##
proc reference-error {msg text} {
    global manual
    puts stderr "$manual(tail): $msg: {$text}"
    return $text
}

##
## insert as many cross references into this text string as are appropriate
##
proc insert-cross-references {text} {
    global manual
    set result ""

    while 1 {
	##
	## we identify cross references by:
	##     ``quotation''
	##    emboldening
	##    Tcl_ prefix
	##    Tk_ prefix
	##	  [a-zA-Z0-9]+ manual entry
	## and we avoid messing with already anchored text
	##
	##
	## find where each item lives - EXPENSIVE - and accumulate a list
	##
	unset -nocomplain offsets
	foreach {name pattern} {
	    anchor     {}
	    quote      {``}	end-quote  {''}
	    bold       {}	end-bold   {}
	    c.tcl      {Tcl_}
	    c.tk       {Tk_}
	    c.ttk      {Ttk_}
	    c.tdbc     {Tdbc_}
	    c.itcl     {Itcl_}
	    Tcl1       {Tcl manual entry}
	    Tcl2       {Tcl overview manual entry}
	    url	       {http://}
	} {
	    set o [string first $pattern $text]
	    if {[set offset($name) $o] >= 0} {
		set invert($o) $name
		lappend offsets $o
	    }
	}
	##
	## if nothing, then we're done.
	##
	if {![info exists offsets]} {
	    return [append result $text]
	}
	##
	## sort the offsets
	##
	set offsets [lsort -integer $offsets]
	##
	## see which we want to use
	##
	switch -exact -- $invert([lindex $offsets 0]) {
	    anchor {
		if {$offset(end-anchor) < 0} {
		    return [reference-error {Missing end anchor} $text]
		}
		append result [string range $text 0 $offset(end-anchor)]
		set text [string range $text[set text ""] \
			      [expr {$offset(end-anchor)+1}] end]
		continue
	    }
	    quote {
		if {$offset(end-quote) < 0} {
		    return [reference-error "Missing end quote" $text]
		}
		if {$invert([lindex $offsets 1]) in {tcl tk ttk}} {
		    set offsets [lreplace $offsets 1 1]
		}
		switch -exact -- $invert([lindex $offsets 1]) {
		    end-quote {
			if {$offset(quote) > 0} {
			    append result [string range $text 0 [expr {$offset(quote)-1}]]
			}
			set body [string range $text [expr {$offset(quote)+2}] \
				      [expr {$offset(end-quote)-1}]]
			set text [string range $text[set text ""] \
				      [expr {$offset(end-quote)+2}] end]
			append result `` [cross-reference $body] ''
			continue
		    }
		    bold - anchor {
			append result [string range $text \
				      0 [expr {$offset(end-quote)+1}]]
			set text [string range $text[set text ""] \
				      [expr {$offset(end-quote)+2}] end]
			continue
		    }
		}
		return [reference-error "Uncaught quote case" $text]
	    }
	    bold {
		if {$offset(end-bold) < 0} {
		    return [append result $text]
		}
		if {[string match "c.*" $invert([lindex $offsets 1])]} {
		    set offsets [lreplace $offsets 1 1]
		}
		switch -exact -- $invert([lindex $offsets 1]) {
		    url - end-bold {
			if {$offset(bold) > 0} {
			    append result \
				[string range $text 0 [expr {$offset(bold)-1}]]
			}
			set body [string range $text [expr {$offset(bold)+3}] \
				      [expr {$offset(end-bold)-1}]]
			set text [string range $text[set text ""] \
				      [expr {$offset(end-bold)+4}] end]
			regsub {http://[\w/.-]+} $body {&} body
			append result  [cross-reference $body] 
			continue
		    }
		    anchor {
			append result \
			    [string range $text 0 [expr {$offset(end-bold)+3}]]
			set text [string range $text[set text ""] \
				      [expr {$offset(end-bold)+4}] end]
			continue
		    }
		    default {
			return [reference-error "Uncaught bold case" $text]
		    }
		}
	    }
	    c.tk - c.ttk - c.tcl - c.tdbc - c.itcl {
		if {[lindex $offsets 0] > 0} {
		    append result [string range $text 0 \
			   [expr {[lindex $offsets 0]-1}]]
		}
		regexp -indices -start [lindex $offsets 0] {\w+} $text range
		set body [string range $text {*}$range]
		set text [string range $text[set text ""] \
			      [expr {[lindex $range 1]+1}] end]
		append result [cross-reference $body]
		continue
	    }
	    Tcl1 - Tcl2 {
		set off [lindex $offsets 0]
		if {$off > 0} {
		    append result [string range $text 0 [expr {$off-1}]]
		}
		set text [string range $text[set text ""] [expr {$off+3}] end]
		append result [cross-reference Tcl]
		continue
	    }
	    url {
		set off [lindex $offsets 0]
		if {$off > 0} {
		    append result [string range $text 0 [expr {$off-1}]]
		}
		regexp -indices -start $off {http://[\w/.-]+} $text range
		set url [string range $text {*}$range]
		append result "$url"
		set text [string range $text[set text ""] \
			      [expr {[lindex $range 1]+1}] end]
		continue
	    }
	    end-anchor - end-bold - end-quote {
		return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
	    }
	}
    }
}

##
## process formatting directives
##
proc output-directive {line} {
    global manual
    # process format directive
    split-directive $line code rest
    switch -exact -- $code {
	.BS - .BE {
	    # man-puts 
    
	}
	.SH - .SS {
	    # drain any open lists
	    # announce the subject
	    set manual(section) $rest
	    # start our own stack of stuff
	    set manual($manual(name)-$manual(section)) {}
	    lappend manual(has-$manual(section)) $manual(name)
	    if {$code ne ".SS"} {
		man-puts "
    [long-toc $manual(section)]
    "
	    } else {
		man-puts "
    [long-toc $manual(section)]
    "
	    }
	    # some sections can simply free wheel their way through the text
	    # some sections can be processed in their own loops
	    switch -exact -- [string index $code end]:$manual(section) {
		H:NAME {
		    set names {}
		    while {1} {
			set line [next-text]
			if {[is-a-directive $line]} {
			    backup-text 1
			    if {[llength $names]} {
				output-name [join $names { }]
			    }
			    return
			}
			lappend names [string trim $line]
		    }
		}
		H:SYNOPSIS {
		    lappend manual(section-toc) 
    
		    while {1} {
			if {
			    [next-op-is .nf rest]
			    || [next-op-is .br rest]
			    || [next-op-is .fi rest]
			} {
			    continue
			}
			if {
			    [next-op-is .SH rest]
			    || [next-op-is .SS rest]
			    || [next-op-is .BE rest]
			    || [next-op-is .SO rest]
			} {
			    backup-text 1
			    break
			}
			if {[next-op-is .sp rest]} {
			    #man-puts 
    
			    continue
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "in SYNOPSIS found $more"
			    backup-text 1
			    break
			}
			foreach more [split $more \n] {
			    regexp {^(\s*)(.*)} $more -> spaces more
			    set spaces [string map {" " " "} $spaces]
			    if {[string length $spaces]} {
				set spaces $spaces
			    }
			    man-puts $spaces$more
    
			    if {$manual(wing-file) in {TclLib TkLib}} {
				lappend manual(section-toc) 
    $more
			    }
			}
		    }
		    lappend manual(section-toc) 
    
		    return
		}
		{H:SEE ALSO} {
		    while {[more-text]} {
			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
			    backup-text 1
			    return
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "$more"
			    backup-text 1
			    return
			}
			set nmore {}
			foreach cr [split $more ,] {
			    set cr [string trim $cr]
			    if {![regexp {^.*$} $cr]} {
				set cr $cr
			    }
			    if {[regexp {^(.*)\([13n]\)$} $cr all name]} {
				set cr $name
			    }
			    lappend nmore $cr
			}
			man-puts [join $nmore {, }]
		    }
		    return
		}
		H:KEYWORDS {
		    while {[more-text]} {
			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
			    backup-text 1
			    return
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "$more"
			    backup-text 1
			    return
			}
			set keys {}
			foreach key [split $more ,] {
			    set key [string trim $key]
			    lappend manual(keyword-$key) [list $manual(name) \
				    $manual(wing-file)/$manual(name).htm]
			    set initial [string toupper [string index $key 0]]
			    lappend keys "$key"
			}
			man-puts [join $keys {, }]
		    }
		    return
		}
	    }
	    if {[next-op-is .IP rest]} {
		output-IP-list $code .IP $rest
		return
	    }
	    if {[next-op-is .PP rest]} {
		return
	    }
	    return
	}
	.SO {
	    # When there's a sequence of multiple .SO chunks, process into one
	    set optslist {}
	    while 1 {
		if {[match-text @stuff .SE]} {
		    foreach opt [split $stuff \n\t] {
			lappend optslist [list $opt $rest]
		    }
		} else {
		    manerror "unexpected .SO format:\n[expand-next-text 2]"
		}
		if {![next-op-is .SO rest]} {
		    break
		}
	    }
	    output-directive {.SH STANDARD OPTIONS}
	    man-puts 
    
	    lappend manual(section-toc) 
    
	    foreach optionpair [lsort -dictionary -index 0 $optslist] {
		lassign $optionpair option targetPage
		man-puts "
    [std-option-toc $option $targetPage]"
	    }
	    man-puts 
    
	    lappend manual(section-toc) 
    
	}
	.OP {
	    output-widget-options $rest
	    return
	}
	.IP {
	    output-IP-list .IP .IP $rest
	    return
	}
	.PP - .sp {
	    man-puts 
    
	}
	.RS {
	    output-RS-list
	    return
	}
	.br {
	    man-puts 
    
	    return
	}
	.DS {
	    if {[next-op-is .ta rest]} {
		# skip the leading .ta directive if it is there
	    }
	    if {[match-text @stuff .DE]} {
		set td "
    • $td \t $td] \n$stuff] man-puts "

    " set bodyText [string map [list \n

    $bodyText
    " #man-puts 
    $stuff
    } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} { man-puts "
    [lindex $ul1 1][lindex $ul2 1]\n$stuff
    " } else { manerror "unexpected .DS format:\n[expand-next-text 2]" } return } .CS { if {[next-op-is .ta rest]} { # ??? } if {[match-text @stuff .CE]} { man-puts 
    $stuff
    } else { manerror "unexpected .CS format:\n[expand-next-text 2]" } return } .nf { if {[match-text @more .fi]} { foreach more [split $more \n] { man-puts $more
    } } elseif {[match-text .RS @more .RE .fi]} { man-puts
    foreach more [split $more \n] { man-puts $more
    } man-puts
    } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} { man-puts
    foreach more [split $more \n] { man-puts $more
    } man-puts
    foreach more2 [split $more2 \n] { man-puts $more2
    } man-puts
    } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} { man-puts
    foreach more [split $more \n] { man-puts $more
    } man-puts
    foreach more2 [split $more2 \n] { man-puts $more2
    } man-puts
    foreach more3 [split $more3 \n] { man-puts $more3
    } man-puts
    } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} { man-puts

    foreach more [split $more \n] { man-puts $more
    } man-puts
    foreach more2 [split $more2 \n] { man-puts $more2
    } man-puts

    } elseif {[match-text .RS .sp @more .sp .RE .fi]} { man-puts

    foreach more [split $more \n] { man-puts $more
    } man-puts

    } else { manerror "ignoring $line" } } .RE - .DE - .CE { manerror "unexpected $code" return } .ta - .fi - .na - .ad - .UL - .ie - .el - .ne { manerror "ignoring $line" } default { manerror "unrecognized format directive: $line" } } } ## ## merge copyright listings ## proc merge-copyrights {l1 l2} { set merge {} set re1 {^Copyright +(?:\(c\)|\\\(co|©) +(\w.*?)(?:all rights reserved)?(?:\. )*$} set re2 {^(\d+) +(?:by +)?(\w.*)$} ;# date who set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$} ;# from to who set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who foreach copyright [concat $l1 $l2] { if {[regexp -nocase -- $re1 $copyright -> info]} { set info [string trimright $info ". "] ; # remove extra period if {[regexp -- $re2 $info -> date who]} { lappend dates($who) $date continue } elseif {[regexp -- $re3 $info -> from to who]} { for {set date $from} {$date <= $to} {incr date} { lappend dates($who) $date } continue } elseif {[regexp -- $re3 $info -> date1 date2 who]} { lappend dates($who) $date1 $date2 continue } } puts "oops: $copyright" } foreach who [array names dates] { set list [lsort -dictionary $dates($who)] if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} { lappend merge "Copyright © [lindex $list 0] $who" } else { lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who" } } return [lsort -dictionary $merge] } ## ## foreach of the man pages in the section specified by ## sectionDescriptor, convert manpages into hypertext in ## the directory specified by outputDir. ## proc make-manpage-section {outputDir sectionDescriptor} { global manual overall_title tcltkdesc verbose global excluded_pages forced_index_pages process_first_patterns set LQ \u201C set RQ \u201D lassign $sectionDescriptor \ manual(wing-glob) \ manual(wing-name) \ manual(wing-file) \ manual(wing-description) set manual(wing-copyrights) {} makedirhier $outputDir/$manual(wing-file) set manual(wing-toc-fp) [open $outputDir/$manual(wing-file)/[indexfile] w] fconfigure $manual(wing-toc-fp) -translation lf -encoding utf-8 # whistle puts stderr "scanning section $manual(wing-name)" # put the entry for this section into the short table of contents if {[regexp {^(.+), version (.+)$} $manual(wing-name) -> name version]} { puts $manual(short-toc-fp) "

    $name
    $manual(wing-description)
    " } else { puts $manual(short-toc-fp) "
    $manual(wing-name)
    $manual(wing-description)
    " } # initialize the wing table of contents puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \ $manual(wing-name) $overall_title "../[indexfile]"] # initialize the short table of contents for this section set manual(wing-toc) {} # initialize the man directory for this section makedirhier $outputDir/$manual(wing-file) # initialize the long table of contents for this section set manual(long-toc-n) 1 # get the manual pages for this section set manual(pages) [lsort -dictionary [glob -nocomplain $manual(wing-glob)]] # Some pages have to go first so that their links override others foreach pat $process_first_patterns { set n [lsearch -glob $manual(pages) $pat] if {$n >= 0} { set f [lindex $manual(pages) $n] puts stderr "shuffling [file tail $f] to front of processing queue" set manual(pages) \ [linsert [lreplace $manual(pages) $n $n] 0 $f] } } # set manual(pages) [lrange $manual(pages) 0 5] foreach manual_page $manual(pages) { set manual(page) [file normalize $manual_page] # whistle if {$verbose} { puts stderr "scanning page $manual(page)" } else { puts -nonewline stderr . } set manual(tail) [file tail $manual(page)] set manual(name) [file root $manual(tail)] set manual(section) {} if {$manual(name) in $excluded_pages} { # obsolete if {!$verbose} { puts stderr "" } manerror "discarding $manual(name)" continue } set manual(infp) [open $manual(page)] fconfigure $manual(infp) -encoding utf-8 set manual(text) {} set manual(partial-text) {} foreach p {.RS .DS .CS .SO} { set manual($p) 0 } set manual(stack) {} set manual(section) {} set manual(section-toc) {} set manual(section-toc-n) 1 set manual(copyrights) {} lappend manual(all-pages) $manual(wing-file)/$manual(tail) lappend manual(all-page-domains) $manual(wing-name) manreport 100 $manual(name) while {[gets $manual(infp) line] >= 0} { manreport 100 $line if {[regexp {^[`'][/\\]} $line]} { if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} { lappend manual(copyrights) $copyright } # comment continue } if {"$line" eq {'}} { # comment continue } if {![parse-directive $line code rest]} { addbuffer $line continue } switch -exact -- $code { .if - .nr - .ti - .in - .ie - .el - .ad - .na - .so - .ne - .AS - .HS - .VE - .VS - . { # ignore continue } } switch -exact -- $code { .SH - .SS { flushbuffer if {[llength $rest] == 0} { gets $manual(infp) rest } lappend manual(text) "$code [unquote $rest]" } .TH { flushbuffer lappend manual(text) "$code [unquote $rest]" } .QW { lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ inQuote afterwards addbuffer $LQ [unquote $inQuote] $RQ [unquote $afterwards] } .PQ { lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ inQuote punctuation afterwards addbuffer ( $LQ [unquote $inQuote] $RQ \ [unquote $punctuation] ) [unquote $afterwards] } .QR { lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ rangeFrom rangeTo afterwards addbuffer $LQ [unquote $rangeFrom] "–" \ [unquote $rangeTo] $RQ [unquote $afterwards] } .MT { addbuffer $LQ$RQ } .HS - .UL - .ta { flushbuffer lappend manual(text) "$code [unquote $rest]" } .BS - .BE - .br - .fi - .sp - .nf { flushbuffer if {$rest ne ""} { if {!$verbose} { puts stderr "" } manerror "unexpected argument: $line" } lappend manual(text) $code } .AP { flushbuffer lappend manual(text) [concat .IP [process-text \ "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]] } .IP { flushbuffer regexp {^(.*) +\d+$} $rest all rest lappend manual(text) ".IP [process-text \ [unquote [string trim $rest]]]" } .TP { flushbuffer while {[is-a-directive [set next [gets $manual(infp)]]]} { if {!$verbose} { puts stderr "" } manerror "ignoring $next after .TP" } if {"$next" ne {'}} { lappend manual(text) ".IP [process-text $next]" } } .OP { flushbuffer lassign $rest cmdName dbName dbClass lappend manual(text) [concat .OP [process-text \ "\\fB$cmdName\\fR \\fB$dbName\\fR \\fB$dbClass\\fR"]] } .PP - .LP { flushbuffer lappend manual(text) {.PP} } .RS { flushbuffer incr manual(.RS) lappend manual(text) $code } .RE { flushbuffer incr manual(.RS) -1 lappend manual(text) $code } .SO { flushbuffer incr manual(.SO) if {[llength $rest] == 0} { lappend manual(text) "$code options" } else { lappend manual(text) "$code [unquote $rest]" } } .SE { flushbuffer incr manual(.SO) -1 lappend manual(text) $code } .DS { flushbuffer incr manual(.DS) lappend manual(text) $code } .DE { flushbuffer incr manual(.DS) -1 lappend manual(text) $code } .CS { flushbuffer incr manual(.CS) lappend manual(text) $code } .CE { flushbuffer incr manual(.CS) -1 lappend manual(text) $code } .de { while {[gets $manual(infp) line] >= 0} { if {[string match "..*" $line]} { break } } } .. { if {!$verbose} { puts stderr "" } error "found .. outside of .de" } default { if {!$verbose} { puts stderr "" } flushbuffer manerror "unrecognized format directive: $line" } } } flushbuffer close $manual(infp) # fixups if {$manual(.RS) != 0} { if {!$verbose} { puts stderr "" } puts "unbalanced .RS .RE" } if {$manual(.DS) != 0} { if {!$verbose} { puts stderr "" } puts "unbalanced .DS .DE" } if {$manual(.CS) != 0} { if {!$verbose} { puts stderr "" } puts "unbalanced .CS .CE" } if {$manual(.SO) != 0} { if {!$verbose} { puts stderr "" } puts "unbalanced .SO .SE" } # output conversion open-text set haserror 0 if {[next-op-is .HS rest]} { set manual($manual(wing-file)-$manual(name)-title) \ "[join [lrange $rest 1 end] { }] [lindex $rest 0] manual page" } elseif {[next-op-is .TH rest]} { set manual($manual(wing-file)-$manual(name)-title) \ "[lindex $rest 0] manual page - [join [lrange $rest 4 end] { }]" } else { set haserror 1 if {!$verbose} { puts stderr "" } manerror "no .HS or .TH record found" } if {!$haserror} { while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { output-directive $line } else { man-puts $line } } man-puts [copyout $manual(copyrights) "../"] set manual(wing-copyrights) [merge-copyrights \ $manual(wing-copyrights) $manual(copyrights)] } # # make the long table of contents for this page # set manual(toc-$manual(wing-file)-$manual(name)) \ [concat
    $manual(section-toc)
    ] } if {!$verbose} { puts stderr "" } if {![llength $manual(wing-toc)]} { fatal "not table of contents." } # # make the wing table of contents for the section # set width 0 foreach name $manual(wing-toc) { if {[string length $name] > $width} { set width [string length $name] } } set perline [expr {118 / $width}] set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}] set n 0 catch {unset rows} foreach name [lsort -dictionary $manual(wing-toc)] { set tail $manual(name-$name) if {[llength $tail] > 1} { manerror "$name is defined in more than one file: $tail" set tail [lindex $tail [expr {[llength $tail]-1}]] } set tail [file tail $tail] if {[info exists manual(tooltip-$manual(wing-file)/$tail.htm)]} { set tooltip $manual(tooltip-$manual(wing-file)/$tail.htm) set tooltip [string map {[ {\[} ] {\]} $ {\$} \\ \\\\} $tooltip] regsub {^[^-]+-\s*(.)} $tooltip {[string totitle \1]} tooltip append rows([expr {$n%$nrows}]) \ " $name " } else { append rows([expr {$n%$nrows}]) \ " $name " } incr n } puts $manual(wing-toc-fp) foreach row [lsort -integer [array names rows]] { puts $manual(wing-toc-fp) $rows($row) } puts $manual(wing-toc-fp)
    # # insert wing copyrights # puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"] puts $manual(wing-toc-fp) "" close $manual(wing-toc-fp) set manual(merge-copyrights) \ [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)] } proc makedirhier {dir} { try { if {![file isdirectory $dir]} { file mkdir $dir } } on error msg { return -code error "cannot create directory $dir: $msg" } } proc addbuffer {args} { global manual if {$manual(partial-text) ne ""} { append manual(partial-text) \n } append manual(partial-text) [join $args ""] } proc flushbuffer {} { global manual if {$manual(partial-text) ne ""} { lappend manual(text) [process-text $manual(partial-text)] set manual(partial-text) "" } } return tcl8.6.14/tools/tclZIC.tcl0000755000175000017500000010564614554262142014655 0ustar sergeisergei#---------------------------------------------------------------------- # # tclZIC.tcl -- # # Take the time zone data source files from Arthur Olson's # repository at https://www.iana.org/time-zones, and prepare time zone # information files for Tcl. # # Usage: # tclsh tclZIC.tcl inputDir outputDir # # Parameters: # inputDir - Directory (e.g., tzdata2022a) where Olson's source # files are to be found. # outputDir - Directory (e.g., ../library/tzdata) where # the time zone information files are to be placed. # # Results: # May produce error messages on the standard error. An exit # code of zero denotes success; any other exit code is failure. # # This program parses the timezone data in a means analogous to the # 'zic' command, and produces Tcl time zone information files suitable # for loading into the 'clock' namespace. # #---------------------------------------------------------------------- # # Copyright (c) 2004 Kevin B. Kenny. All rights reserved. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- # Define the names of the Olson files that we need to load. # We avoid the solar time files and the leap seconds. set olsonFiles { africa antarctica asia australasia backward etcetera europe northamerica southamerica } # Define the year at which the DST information will stop. set maxyear 2100 # Determine how big a wide integer is. set MAXWIDE [expr {wide(1)}] while 1 { set next [expr {wide($MAXWIDE + $MAXWIDE + 1)}] if {$next < 0} { break } set MAXWIDE $next } set MINWIDE [expr {-$MAXWIDE-1}] #---------------------------------------------------------------------- # # loadFiles -- # # Loads the time zone files for each continent into memory # # Parameters: # dir - Directory where the time zone source files are found # # Results: # None. # # Side effects: # Calls 'loadZIC' for each continent's data file in turn. # Reports progress on stdout. # #---------------------------------------------------------------------- proc loadFiles {dir} { variable olsonFiles foreach file $olsonFiles { puts "loading: [file join $dir $file]" loadZIC [file join $dir $file] } return } #---------------------------------------------------------------------- # # checkForwardRuleRefs -- # # Checks to make sure that all references to Daylight Saving # Time rules designate defined rules. # # Parameters: # None. # # Results: # None. # # Side effects: # Produces an error message and increases the error count if # any undefined rules are present. # #---------------------------------------------------------------------- proc checkForwardRuleRefs {} { variable forwardRuleRefs variable rules foreach {rule where} [array get forwardRuleRefs] { if {![info exists rules($rule)]} { foreach {fileName lno} $where { puts stderr "$fileName:$lno:can't locate rule \"$rule\"" incr errorCount } } } } #---------------------------------------------------------------------- # # loadZIC -- # # Load one continent's data into memory. # # Parameters: # fileName -- Name of the time zone source file. # # Results: # None. # # Side effects: # The global variable, 'errorCount' counts the number of errors. # The global array, 'links', contains a distillation of the # 'Link' directives in the file. The keys are 'links to' and # the values are 'links from'. The 'parseRule' and 'parseZone' # procedures are called to handle 'Rule' and 'Zone' directives. # #---------------------------------------------------------------------- proc loadZIC {fileName} { variable errorCount variable links # Suck the text into memory. set f [open $fileName r] set data [read $f] close $f # Break the input into lines, and count line numbers. set lno 0 foreach line [split $data \n] { incr lno # Break a line of input into words. regsub {\s*(\#.*)?$} $line {} line if {$line eq ""} { continue } set words {} if {[regexp {^\s} $line]} { # Detect continuations of a zone and flag the list appropriately lappend words "" } lappend words {*}[regexp -all -inline {\S+} $line] # Switch on the directive switch -exact -- [lindex $words 0] { Rule { parseRule $fileName $lno $words } Link { set links([lindex $words 2]) [lindex $words 1] } Zone { set lastZone [lindex $words 1] set until [parseZone $fileName $lno \ $lastZone [lrange $words 2 end] "minimum"] } {} { set i 0 foreach word $words { if {[lindex $words $i] ne ""} { break } incr i } set words [lrange $words $i end] set until [parseZone $fileName $lno $lastZone $words $until] } default { incr errorCount puts stderr "$fileName:$lno:unknown line type \"[lindex $words 0]\"" } } } return } #---------------------------------------------------------------------- # # parseRule -- # # Parses a Rule directive in an Olson file. # # Parameters: # fileName -- Name of the file being parsed. # lno - Line number within the file # words - The line itself, broken into words. # # Results: # None. # # Side effects: # The rule is analyzed and added to the 'rules' array. # Errors are reported and counted. # #---------------------------------------------------------------------- proc parseRule {fileName lno words} { variable rules variable errorCount # Break out the columns lassign $words Rule name from to type in on at save letter # Handle the 'only' keyword if {$to eq "only"} { set to $from } # Process the start year if {![string is integer $from]} { if {![string equal -length [string length $from] $from "minimum"]} { puts stderr "$fileName:$lno:FROM field \"$from\" not an integer." incr errorCount return } else { set from "minimum" } } # Process the end year if {![string is integer $to]} { if {![string equal -length [string length $to] $to "maximum"]} { puts stderr "$fileName:$lno:TO field \"$to\" not an integer." incr errorCount return } else { set to "maximum" } } # Process the type of year in which the rule applies if {$type ne "-"} { puts stderr "$fileName:$lno:year types are not yet supported." incr errorCount return } # Process the month in which the rule starts if {[catch {lookupMonth $in} in]} { puts stderr "$fileName:$lno:$in" incr errorCount return } # Process the day of the month on which the rule starts if {[catch {parseON $on} on]} { puts stderr "$fileName:$lno:$on" incr errorCount return } # Process the time of day on which the rule starts if {[catch {parseTOD $at} at]} { puts stderr "$fileName:$lno:$at" incr errorCount return } # Process the DST adder if {[catch {parseOffsetTime $save} save]} { puts stderr "$fileName:$lno:$save" incr errorCount return } # Process the letter to use for summer time if {$letter eq "-"} { set letter "" } # Accumulate all the data. lappend rules($name) $from $to $type $in $on $at $save $letter return } #---------------------------------------------------------------------- # # parseON -- # # Parse a specification for a day of the month # # Parameters: # on - the ON field from a line in an Olson file. # # Results: # Returns a partial Tcl command. When the year and number of the # month are appended, the command will return the Julian Day Number # of the desired date. # # Side effects: # None. # # The specification can be: # - a simple number, which designates a constant date. # - The name of a weekday, followed by >= or <=, followed by a number. # This designates the nearest occurrence of the given weekday on # or before (on or after) the given day of the month. # - The word 'last' followed by a weekday name with no intervening # space. This designates the last occurrence of the given weekday # in the month. # #---------------------------------------------------------------------- proc parseON {on} { if {![regexp -expanded { ^(?: # first possibility - simple number - field 1 ([[:digit:]]+) | # second possibility - weekday >= (or <=) number # field 2 - weekday ([[:alpha:]]+) # field 3 - direction ([<>]=) # field 4 - number ([[:digit:]]+) | # third possibility - lastWeekday - field 5 last([[:alpha:]]+) )$ } $on -> dom1 wday2 dir2 num2 wday3]} { error "can't parse ON field \"$on\"" } if {$dom1 ne ""} { return [list onDayOfMonth $dom1] } elseif {$wday2 ne ""} { set wday2 [lookupDayOfWeek $wday2] return [list onWeekdayInMonth $wday2 $dir2 $num2] } elseif {$wday3 ne ""} { set wday3 [lookupDayOfWeek $wday3] return [list onLastWeekdayInMonth $wday3] } else { error "in parseOn \"$on\": can't happen" } } #---------------------------------------------------------------------- # # onDayOfMonth -- # # Find a given day of a given month # # Parameters: # day - Day of the month # year - Gregorian year # month - Number of the month (1-12) # # Results: # Returns the Julian Day Number of the desired day. # # Side effects: # None. # #---------------------------------------------------------------------- proc onDayOfMonth {day year month} { scan $day %d day scan $year %d year scan $month %d month set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ [dict create era CE year $year month $month dayOfMonth $day] \ 2361222] return [dict get $date julianDay] } #---------------------------------------------------------------------- # # onWeekdayInMonth -- # # Find the weekday falling on or after (on or before) a # given day of the month # # Parameters: # dayOfWeek - Day of the week (Monday=1, Sunday=7) # relation - <= for the weekday on or before a given date, >= for # the weekday on or after the given date. # dayOfMonth - Day of the month # year - Gregorian year # month - Number of the month (1-12) # # Results: # Returns the Juloan Day Number of the desired day. # # Side effects: # None. # # onWeekdayInMonth is used to compute Daylight Saving Time rules # like 'Sun>=1' (for the nearest Sunday on or after the first of the month) # or "Mon<=4' (for the Monday on or before the fourth of the month). # #---------------------------------------------------------------------- proc onWeekdayInMonth {dayOfWeek relation dayOfMonth year month} { set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ era CE year $year month $month dayOfMonth $dayOfMonth] 2361222] switch -exact -- $relation { <= { return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ [dict get $date julianDay]] } >= { return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ [expr {[dict get $date julianDay] + 6}]] } } } #---------------------------------------------------------------------- # # onLastWeekdayInMonth -- # # Find the last instance of a given weekday in a month. # # Parameters: # dayOfWeek - Weekday to find (Monday=1, Sunday=7) # year - Gregorian year # month - Month (1-12) # # Results: # Returns the Julian Day number of the last instance of # the given weekday in the given month # # Side effects: # None. # #---------------------------------------------------------------------- proc onLastWeekdayInMonth {dayOfWeek year month} { incr month # Find day 0 of the following month, which is the last day of # the current month. Yes, it works to ask for day 0 of month 13! set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ era CE year $year month $month dayOfMonth 0] 2361222] return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ [dict get $date julianDay]] } #---------------------------------------------------------------------- # # parseTOD -- # # Parses the specification of a time of day in an Olson file. # # Parameters: # tod - Time of day, which may be followed by 'w', 's', 'u', 'g' # or 'z'. 'w' (or no letter) designates a wall clock time, # 's' designates Standard Time in the given zone, and # 'u', 'g', and 'z' all designate UTC. # # Results: # Returns a two element list containing a count of seconds from # midnight and the letter that followed the time. # # Side effects: # Reports and counts an error if the time cannot be parsed. # #---------------------------------------------------------------------- proc parseTOD {tod} { if {![regexp -expanded { ^ ([[:digit:]]{1,2}) # field 1 - hour (?: :([[:digit:]]{2}) # field 2 - minute (?: :([[:digit:]]{2}) # field 3 - second )? )? (?: ([wsugz]) # field 4 - type indicator )? } $tod -> hour minute second ind]} { puts stderr "$fileName:$lno:can't parse time field \"$tod\"" incr errorCount } scan $hour %d hour if {$minute ne ""} { scan $minute %d minute } else { set minute 0 } if {$second ne ""} { scan $second %d second } else { set second 0 } if {$ind eq ""} { set ind w } return [list [expr {($hour * 60 + $minute) * 60 + $second}] $ind] } #---------------------------------------------------------------------- # # parseOffsetTime -- # # Parses the specification of an offset time in an Olson file. # # Parameters: # offset - Offset time as [+-]hh:mm:ss # # Results: # Returns the offset time as a count of seconds. # # Side effects: # Reports and counts an error if the time cannot be parsed. # #---------------------------------------------------------------------- proc parseOffsetTime {offset} { if {![regexp -expanded { ^ ([-+])? # field 1 - signum ([[:digit:]]{1,2}) # field 2 - hour (?: :([[:digit:]]{2}) # field 3 - minute (?: :([[:digit:]]{2}) # field 4 - second )? )? } $offset -> signum hour minute second]} { puts stderr "$fileName:$lno:can't parse offset time \"$offset\"" incr errorCount } append signum 1 scan $hour %d hour if {$minute ne ""} { scan $minute %d minute } else { set minute 0 } if {$second ne ""} { scan $second %d second } else { set second 0 } return [expr {(($hour * 60 + $minute) * 60 + $second) * $signum}] } #---------------------------------------------------------------------- # # lookupMonth - # Looks up a month by name # # Parameters: # month - Name of a month. # # Results: # Returns the number of the month. # # Side effects: # None. # #---------------------------------------------------------------------- proc lookupMonth {month} { set indx [lsearch -regexp { {} January February March April May June July August September October November December } ${month}.*] if {$indx < 1} { error "unknown month name \"$month\"" } return $indx } #---------------------------------------------------------------------- # # lookupDayOfWeek -- # # Looks up the name of a weekday. # # Parameters: # wday - Weekday name (or a unique prefix). # # Results: # Returns the weekday number (Monday=1, Sunday=7) # # Side effects: # None. # #---------------------------------------------------------------------- proc lookupDayOfWeek {wday} { set indx [lsearch -regexp { {} Monday Tuesday Wednesday Thursday Friday Saturday Sunday } ${wday}.*] if {$indx < 1} { error "unknown weekday name \"$wday\"" } return $indx } #---------------------------------------------------------------------- # # parseZone -- # # Parses a Zone directive in an Olson file # # Parameters: # fileName -- Name of the file being parsed. # lno -- Line number within the file. # zone -- Name of the time zone # words -- Remaining words on the line. # start -- 'Until' time from the previous line if this is a # continuation line, or 'minimum' if this is the first line. # # Results: # Returns the 'until' field of the current line # # Side effects: # Stores a row in the 'zones' array describing the current zone. # The row consists of a start time (year month day tod), a Standard # Time offset from Greenwich, a Daylight Saving Time offset from # Standard Time, and a format for printing the time zone. # # The start time is the result of an earlier call to 'parseUntil' # or else the keyword 'minimum'. The GMT offset is the # result of a call to 'parseOffsetTime'. The Daylight Saving # Time offset is represented as a partial Tcl command. To the # command will be appended a start time (seconds from epoch) # the current offset of Standard Time from Greenwich, the current # offset of Daylight Saving Time from Greenwich, the default # offset from this line, the name pattern from this line, # the 'until' field from this line, and a variable name where points # are to be stored. This command is implemented by the 'applyNoRule', # 'applyDSTOffset' and 'applyRules' procedures. # #---------------------------------------------------------------------- proc parseZone {fileName lno zone words start} { variable zones variable rules variable errorCount variable forwardRuleRefs lassign $words gmtoff save format if {[catch {parseOffsetTime $gmtoff} gmtoff]} { puts stderr "$fileName:$lno:$gmtoff" incr errorCount return } if {[info exists rules($save)]} { set save [list applyRules $save] } elseif {$save eq "-"} { set save [list applyNoRule] } elseif {[catch {parseOffsetTime $save} save2]} { lappend forwardRuleRefs($save) $fileName $lno set save [list applyRules $save] } else { set save [list applyDSTOffset $save2] } lappend zones($zone) $start $gmtoff $save $format if {[llength $words] >= 4} { return [parseUntil [lrange $words 3 end]] } else { return {} } } #---------------------------------------------------------------------- # # parseUntil -- # # Parses the 'UNTIL' part of a 'Zone' directive. # # Parameters: # words - The 'UNTIL' part of the directie. # # Results: # Returns a list comprising the year, the month, the day, and # the time of day. Time of day is represented as the result of # 'parseTOD'. # #---------------------------------------------------------------------- proc parseUntil {words} { variable firstYear if {[llength $words] >= 1} { set year [lindex $words 0] if {![string is integer $year]} { error "can't parse UNTIL field \"$words\"" } if {![info exists firstYear] || $year < $firstYear} { set firstYear $year } } else { set year "maximum" } if {[llength $words] >= 2} { set month [lookupMonth [lindex $words 1]] } else { set month 1 } if {[llength $words] >= 3} { set day [parseON [lindex $words 2]] } else { set day {onDayOfMonth 1} } if {[llength $words] >= 4} { set tod [parseTOD [lindex $words 3]] } else { set tod {0 w} } return [list $year $month $day $tod] } #---------------------------------------------------------------------- # # applyNoRule -- # # Generates time zone data for a zone without Daylight Saving # Time. # # Parameters: # year - Year in which the rule applies # startSecs - Time at which the rule starts. # stdGMTOffset - Offset from Greenwich prior to the start of the # rule # DSTOffset - Offset of Daylight from Standard prior to the # start of the rule. # nextGMTOffset - Offset from Greenwich when the rule is in effect. # namePattern - Name of the timezone. # until - Time at which the rule expires. # pointsVar - Name of a variable in callers scope that receives # transition times # # Results: # Returns a two element list comprising 'nextGMTOffset' and # 0 - the zero indicates that Daylight Saving Time is not # in effect. # # Side effects: # Appends a row to the 'points' variable comprising the start time, # the offset from GMT, a zero (indicating that DST is not in effect), # and the name of the time zone. # #---------------------------------------------------------------------- proc applyNoRule {year startSecs stdGMTOffset DSTOffset nextGMTOffset namePattern until pointsVar} { upvar 1 $pointsVar points lappend points $startSecs $nextGMTOffset 0 \ [convertNamePattern $namePattern -] return [list $nextGMTOffset 0] } #---------------------------------------------------------------------- # # applyDSTOffset -- # # Generates time zone data for a zone with permanent Daylight # Saving Time. # # Parameters: # nextDSTOffset - Offset of Daylight from Standard while the # rule is in effect. # year - Year in which the rule applies # startSecs - Time at which the rule starts. # stdGMTOffset - Offset from Greenwich prior to the start of the # rule # DSTOffset - Offset of Daylight from Standard prior to the # start of the rule. # nextGMTOffset - Offset from Greenwich when the rule is in effect. # namePattern - Name of the timezone. # until - Time at which the rule expires. # pointsVar - Name of a variable in callers scope that receives # transition times # # Results: # Returns a two element list comprising 'nextGMTOffset' and # 'nextDSTOffset'. # # Side effects: # Appends a row to the 'points' variable comprising the start time, # the offset from GMT, a one (indicating that DST is in effect), # and the name of the time zone. # #---------------------------------------------------------------------- proc applyDSTOffset {nextDSTOffset year startSecs stdGMTOffset DSTOffset nextGMTOffset namePattern until pointsVar} { upvar 1 $pointsVar points lappend points \ $startSecs \ [expr {$nextGMTOffset + $nextDSTOffset}] \ 1 \ [convertNamePattern $namePattern S] return [list $nextGMTOffset $nextDSTOffset] } #---------------------------------------------------------------------- # # applyRules -- # # Applies a rule set to a time zone for a given range of time # # Parameters: # ruleSet - Name of the rule set to apply # year - Starting year for the rules # startSecs - Time at which the rules begin to apply # stdGMTOffset - Offset from Greenwich prior to the start of the # rules. # DSTOffset - Offset of Daylight from Standard prior to the # start of the rules. # nextGMTOffset - Offset from Greenwich when the rules are in effect. # namePattern - Name pattern for the time zone. # until - Time at which the rule set expires. # pointsVar - Name of a variable in callers scope that receives # transition times # # Results: # Returns a two element list comprising the offset from GMT # to Standard and the offset from Standard to Daylight (if DST # is in effect) at the end of the period in which the rules apply # # Side effects: # Appends one or more rows to the 'points' variable, each of which # comprises a transition time, the offset from GMT that is # in effect after the transition, a flag for whether DST is in # effect, and the name of the time zone. # #---------------------------------------------------------------------- proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset namePattern until pointsVar} { variable done variable rules variable maxyear upvar 1 $pointsVar points # Extract the rules that apply to the current year, and the number # of rules (now or in future) that will end at a specific year. # Ignore rules entirely in the past. lassign [divideRules $ruleSet $year] currentRules nSunsetRules # If the first transition is later than $startSecs, and $stdGMTOffset is # different from $nextGMTOffset, we will need an initial record like: # lappend points $startSecs $stdGMTOffset 0 \ # [convertNamePattern $namePattern -] set didTransitionIn false # Determine the letter to use in Standard Time set prevLetter "" foreach { fromYear toYear yearType monthIn daySpecOn timeAt save letter } $rules($ruleSet) { if {$save == 0} { set prevLetter $letter break } } # Walk through each year in turn. This loop will break when # (a) the 'until' time is passed # or (b) the 'until' time is empty and all remaining rules extend to # the end of time set stdGMTOffset $nextGMTOffset # convert "until" to seconds from epoch in current time zone if {$until ne ""} { lassign $until untilYear untilMonth untilDaySpec untilTimeOfDay lappend untilDaySpec $untilYear $untilMonth set untilJCD [eval $untilDaySpec] set untilBaseSecs [expr { wide(86400) * wide($untilJCD) - 210866803200 }] set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \ $DSTOffset {*}$untilTimeOfDay] } set origStartSecs $startSecs while {($until ne "" && $startSecs < $untilSecs) || ($until eq "" && ($nSunsetRules > 0 || $year < $maxyear))} { set remainingRules $currentRules while {[llength $remainingRules] > 0} { # Find the rule with the earliest start time from among the # active rules that haven't yet been processed. lassign [findEarliestRule $remainingRules $year \ $stdGMTOffset $DSTOffset] earliestSecs earliestIndex set endi [expr {$earliestIndex + 7}] set rule [lrange $remainingRules $earliestIndex $endi] lassign $rule fromYear toYear \ yearType monthIn daySpecOn timeAt save letter # Test if the rule is in effect. if { $earliestSecs > $startSecs && ($until eq "" || $earliestSecs < $untilSecs) } { # Test if the initial transition has been done. # If not, do it now. if {!$didTransitionIn && $earliestSecs > $origStartSecs} { set nm [convertNamePattern $namePattern $prevLetter] lappend points \ $origStartSecs \ [expr {$stdGMTOffset + $DSTOffset}] \ 0 \ $nm set didTransitionIn true } # Add a row to 'points' for the rule set nm [convertNamePattern $namePattern $letter] lappend points \ $earliestSecs \ [expr {$stdGMTOffset + $save}] \ [expr {$save != 0}] \ $nm } # Remove the rule just applied from the queue set remainingRules [lreplace \ $remainingRules[set remainingRules {}] \ $earliestIndex $endi] # Update current DST offset and time zone letter set DSTOffset $save set prevLetter $letter # Reconvert the 'until' time in the current zone. if {$until ne ""} { set untilSecs [convertTimeOfDay $untilBaseSecs \ $stdGMTOffset $DSTOffset {*}$untilTimeOfDay] } } # Advance to the next year incr year set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ [dict create era CE year $year month 1 dayOfMonth 1] 2361222] set startSecs [expr { [dict get $date julianDay] * wide(86400) - 210866803200 - $stdGMTOffset - $DSTOffset }] # Get rules in effect in the new year. lassign [divideRules $ruleSet $year] currentRules nSunsetRules } return [list $stdGMTOffset $DSTOffset] } #---------------------------------------------------------------------- # # divideRules -- # Determine what Daylight Saving Time rules may be in effect in # a given year. # # Parameters: # ruleSet - Set of rules from 'parseRule' # year - Year to test # # Results: # Returns a two element list comprising the subset of 'ruleSet' # that is in effect in the given year, and the count of rules # that expire in the future (as opposed to those that expire in # the past or not at all). If this count is zero, the rules do # not change in future years. # # Side effects: # None. # #---------------------------------------------------------------------- proc divideRules {ruleSet year} { variable rules set currentRules {} set nSunsetRules 0 foreach { fromYear toYear yearType monthIn daySpecOn timeAt save letter } $rules($ruleSet) { if {$toYear ne "maximum" && $year > $toYear} { # ignore - rule is in the past } else { if {$fromYear eq "minimum" || $fromYear <= $year} { lappend currentRules $fromYear $toYear $yearType $monthIn \ $daySpecOn $timeAt $save $letter } if {$toYear ne "maximum"} { incr nSunsetRules } } } return [list $currentRules $nSunsetRules] } #---------------------------------------------------------------------- # # findEarliestRule -- # # Find the rule in a rule set that has the earliest start time. # # Parameters: # remainingRules -- Rules to search # year - Year being processed. # stdGMTOffset - Current offset of standard time from GMT # DSTOffset - Current offset of daylight time from standard, # if daylight time is in effect. # # Results: # Returns the index in remainingRules of the next rule to # go into effect. # # Side effects: # None. # #---------------------------------------------------------------------- proc findEarliestRule {remainingRules year stdGMTOffset DSTOffset} { set earliest $::MAXWIDE set i 0 foreach { fromYear toYear yearType monthIn daySpecOn timeAt save letter } $remainingRules { lappend daySpecOn $year $monthIn set dayIn [eval $daySpecOn] set secs [expr {wide(86400) * wide($dayIn) - 210866803200}] set secs [convertTimeOfDay $secs \ $stdGMTOffset $DSTOffset {*}$timeAt] if {$secs < $earliest} { set earliest $secs set earliestIdx $i } incr i 8 } return [list $earliest $earliestIdx] } #---------------------------------------------------------------------- # # convertNamePattern -- # # Converts a name pattern to the name of the time zone. # # Parameters: # pattern - Patthern to convert # flag - Daylight Time flag. An empty string denotes Standard # Time, anything else is Daylight Time. # # Results; # Returns the name of the time zone. # # Side effects: # None. # #---------------------------------------------------------------------- proc convertNamePattern {pattern flag} { if {[regexp {(.*)/(.*)} $pattern -> standard daylight]} { if {$flag ne ""} { set pattern $daylight } else { set pattern $standard } } return [string map [list %s $flag] $pattern] } #---------------------------------------------------------------------- # # convertTimeOfDay -- # # Takes a time of day specifier from 'parseAt' and converts # to seconds from the Epoch, # # Parameters: # seconds -- Time at which the GMT day starts, in seconds # from the Posix epoch # stdGMTOffset - Offset of Standard Time from Greenwich # DSTOffset - Offset of Daylight Time from standard. # timeOfDay - Time of day to convert, in seconds from midnight # flag - Flag indicating whether the time is Greenwich, Standard # or wall-clock. (g, s, or w) # # Results: # Returns the time of day in seconds from the Posix epoch. # # Side effects: # None. # #---------------------------------------------------------------------- proc convertTimeOfDay {seconds stdGMTOffset DSTOffset timeOfDay flag} { incr seconds $timeOfDay switch -exact $flag { g - u - z { } w { incr seconds [expr {-$stdGMTOffset}] incr seconds [expr {-$DSTOffset}] } s { incr seconds [expr {-$stdGMTOffset}] } } return $seconds } #---------------------------------------------------------------------- # # processTimeZone -- # # Generate the information about all time transitions in a # time zone. # # Parameters: # zoneName - Name of the time zone # zoneData - List containing the rows describing the time zone, # obtained from 'parseZone. # # Results: # Returns a list of rows. Each row consists of a time in # seconds from the Posix epoch, an offset from GMT to local # that begins at that time, a flag indicating whether DST # is in effect after that time, and the printable name of the # timezone that goes into effect at that time. # # Side effects: # None. # #---------------------------------------------------------------------- proc processTimeZone {zoneName zoneData} { set points {} set i 0 foreach {startTime nextGMTOffset dstRule namePattern} $zoneData { incr i 4 set until [lindex $zoneData $i] if {![info exists stdGMTOffset]} { set stdGMTOffset $nextGMTOffset } if {![info exists DSTOffset]} { set DSTOffset 0 } if {$startTime eq "minimum"} { set secs $::MINWIDE set year 0 } else { lassign $startTime year month dayRule timeOfDay lappend dayRule $year $month set startDay [eval $dayRule] set secs [expr {wide(86400) * wide($startDay) -210866803200}] set secs [convertTimeOfDay $secs \ $stdGMTOffset $DSTOffset {*}$timeOfDay] } lappend dstRule \ $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \ $namePattern $until points lassign [eval $dstRule] stdGMTOffset DSTOffset } return $points } #---------------------------------------------------------------------- # # writeZones -- # # Writes all the time zone information files. # # Parameters: # outDir - Directory in which to store the files. # # Results: # None. # # Side effects: # Writes the time zone information files; traces what's happening # on the standard output. # #---------------------------------------------------------------------- proc writeZones {outDir} { variable zones # Walk the zones foreach zoneName [lsort -dictionary [array names zones]] { puts "calculating: $zoneName" set fileName [eval [list file join $outDir] [file split $zoneName]] # Create directories as needed set dirName [file dirname $fileName] if {![file exists $dirName]} { puts "creating directory: $dirName" file mkdir $dirName } # Generate data for a zone set data "" foreach { time offset dst name } [processTimeZone $zoneName $zones($zoneName)] { append data "\n " [list [list $time $offset $dst $name]] } append data \n # Write the data to the information file set f [open $fileName w] fconfigure $f -translation lf puts $f "\# created by $::argv0 - do not edit" puts $f "" puts $f [list set TZData(:$zoneName) $data] close $f } return } #---------------------------------------------------------------------- # # writeLinks -- # # Write files describing time zone synonyms (the Link directives # from the Olson files) # # Parameters: # outDir - Name of the directory where the output files go. # # Results: # None. # # Side effects: # Creates a file for each link. proc writeLinks {outDir} { variable links # Walk the links foreach zoneName [lsort -dictionary [array names links]] { puts "creating link: $zoneName" set fileName [eval [list file join $outDir] [file split $zoneName]] # Create directories as needed set dirName [file dirname $fileName] if {![file exists $dirName]} { puts "creating directory: $dirName" file mkdir $dirName } # Create code for the synonym set linkTo $links($zoneName) set sourceCmd "\n [list LoadTimeZoneFile $linkTo]\n" set ifCmd [list if "!\[info exists TZData($linkTo)\]" $sourceCmd] set setCmd "set TZData(:$zoneName) \$TZData(:$linkTo)" # Write the file set f [open $fileName w] fconfigure $f -translation lf puts $f "\# created by $::argv0 - do not edit" puts $f $ifCmd puts $f $setCmd close $f } return } #---------------------------------------------------------------------- # # MAIN PROGRAM # #---------------------------------------------------------------------- puts "Compiling time zones -- [clock format [clock seconds] \ -format {%x %X} -locale system]" # Determine directories lassign $argv inDir outDir puts "Olson files in $inDir" puts "Tcl files to be placed in $outDir" # Initialize count of errors set errorCount 0 # Parse the Olson files loadFiles $inDir if {$errorCount > 0} { exit 1 } # Check that all riles appearing in Zone and Link lines actually exist checkForwardRuleRefs if {$errorCount > 0} { exit 1 } # Write the time zone information files writeZones $outDir writeLinks $outDir if {$errorCount > 0} { exit 1 } # All done! exit tcl8.6.14/tools/tsdPerf.tcl0000644000175000017500000000077014554262142015121 0ustar sergeisergei package require Thread set ::tids [list] for {set i 0} {$i < 4} {incr i} { lappend ::tids [thread::create [string map [list IVALUE $i] { set curdir [file dirname [info script]] load [file join $curdir tsdPerf[info sharedlibextension]] while 1 { tsdPerfSet IVALUE } }]] } puts TIDS:$::tids set curdir [file dirname [info script]] load [file join $curdir tsdPerf[info sharedlibextension]] tsdPerfSet 1234 while 1 { puts "TIME:[time {set value [tsdPerfGet]} 1000] VALUE:$value" } tcl8.6.14/tools/uniClass.tcl0000644000175000017500000000645314554262142015277 0ustar sergeisergei#!/bin/sh # The next line is executed by /bin/sh, but not tcl \ exec tclsh "$0" ${1+"$@"} # # uniClass.tcl -- # # Generates the character ranges and singletons that are used in # generic/regc_locale.c for translation of character classes. # This file must be generated using a tclsh that contains the # correct corresponding tclUniData.c file (generated by uniParse.tcl) # in order for the class ranges to match. # proc emitRange {first last} { global ranges numranges chars numchars extchars extranges if {$first < ($last-1)} { if {!$extranges && ($first) > 0xFFFF} { set extranges 1 set numranges 0 set ranges [string trimright $ranges " \n\r\t,"] append ranges "\n#if CHRBITS > 16\n ," } append ranges [format "{0x%X, 0x%X}, " \ $first $last] if {[incr numranges] % 4 == 0} { set ranges [string trimright $ranges] append ranges "\n " } } else { if {!$extchars && ($first) > 0xFFFF} { set extchars 1 set numchars 0 set chars [string trimright $chars " \n\r\t,"] append chars "\n#if CHRBITS > 16\n ," } append chars [format "0x%X, " $first] incr numchars if {$numchars % 9 == 0} { set chars [string trimright $chars] append chars "\n " } if {$first != $last} { append chars [format "0x%X, " $last] incr numchars if {$numchars % 9 == 0} { append chars "\n " } } } } proc genTable {type} { global first last ranges numranges chars numchars extchars extranges set first -2 set last -2 set ranges " " set numranges 0 set chars " " set numchars 0 set extchars 0 set extranges 0 for {set i 0} {$i <= 0x10FFFF} {incr i} { if {$i == 0xD800} { # Skip surrogates set i 0xE000 } if {[string is $type [format %c $i]]} { if {$i == ($last + 1)} { set last $i } else { if {$first >= 0} { emitRange $first $last } set first $i set last $i } } } emitRange $first $last set ranges [string trimright $ranges "\t\n ,"] if {$extranges} { append ranges "\n#endif" } set chars [string trimright $chars "\t\n ,"] if {$extchars} { append chars "\n#endif" } if {$ranges ne ""} { puts "static const crange ${type}RangeTable\[\] = {\n$ranges\n};\n" puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n" } else { puts "/* no contiguous ranges of $type characters */\n" } if {$chars ne ""} { puts "static const chr ${type}CharTable\[\] = {\n$chars\n};\n" puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n" } else { puts "/*\n * no singletons of $type characters.\n */\n" } } puts "/* * Declarations of Unicode character ranges. This code * is automatically generated by the tools/uniClass.tcl script * and used in generic/regc_locale.c. Do not modify by hand. */ " foreach {type desc} { alpha "alphabetic characters" control "control characters" digit "decimal digit characters" punct "punctuation characters" space "white space characters" lower "lowercase characters" upper "uppercase characters" graph "unicode print characters excluding space" } { puts "/*\n * Unicode: $desc.\n */\n" genTable $type } puts "/* * End of auto-generated Unicode character ranges declarations. */" tcl8.6.14/tools/uniParse.tcl0000644000175000017500000002552514554262142015305 0ustar sergeisergei# uniParse.tcl -- # # This program parses the UnicodeData file and generates the # corresponding tclUniData.c file with compressed character # data tables. The input to this program should be the latest # UnicodeData file from: # ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt # # Copyright (c) 1998-1999 Scriptics Corporation. # All rights reserved. namespace eval uni { set shift 5; # number of bits of data within a page # This value can be adjusted to find the # best split to minimize table size variable pMap; # map from page to page index, each entry is # an index into the pages table, indexed by # page number variable pages; # map from page index to page info, each # entry is a list of indices into the groups # table, the list is indexed by the offset variable groups; # list of character info values, indexed by # group number, initialized with the # unassigned character group variable categories { Cn Lu Ll Lt Lm Lo Mn Me Mc Nd Nl No Zs Zl Zp Cc Cf Co Cs Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So }; # Ordered list of character categories, must # match the enumeration in the header file. } proc uni::getValue {items index} { variable categories # Extract character info set category [lindex $items 2] if {[scan [lindex $items 12] %x toupper] == 1} { set toupper [expr {$index - $toupper}] } else { set toupper 0 } if {[scan [lindex $items 13] %x tolower] == 1} { set tolower [expr {$tolower - $index}] } else { set tolower 0 } if {[scan [lindex $items 14] %x totitle] == 1} { set totitle [expr {$index - $totitle}] } elseif {$tolower} { set totitle 0 } else { set totitle $toupper } set categoryIndex [lsearch -exact $categories $category] if {$categoryIndex < 0} { error "Unexpected character category: $index($category)" } return [list $categoryIndex $toupper $tolower $totitle] } proc uni::getGroup {value} { variable groups set gIndex [lsearch -exact $groups $value] if {$gIndex < 0} { set gIndex [llength $groups] lappend groups $value } return $gIndex } proc uni::addPage {info} { variable pMap variable pages variable shift set pIndex [lsearch -exact $pages $info] if {$pIndex < 0} { set pIndex [llength $pages] lappend pages $info } lappend pMap [expr {$pIndex << $shift}] return } proc uni::buildTables {data} { variable shift variable pMap {} variable pages {} variable groups {{0 0 0 0}} variable next 0 set info {} ;# temporary page info set mask [expr {(1 << $shift) - 1}] foreach line [split $data \n] { if {$line eq ""} { if {!($next & $mask)} { # next character is already on page boundary continue } # fill remaining page set line [format %X [expr {($next-1)|$mask}]] append line ";;Cn;0;ON;;;;;N;;;;;\n" } set items [split $line \;] scan [lindex $items 0] %x index if {$index > 0x3FFFF} then { # Ignore characters > plane 3 continue } set index [format %d $index] set gIndex [getGroup [getValue $items $index]] # Since the input table omits unassigned characters, these will # show up as gaps in the index sequence. There are a few special cases # where the gaps correspond to a uniform block of assigned characters. # These are indicated as such in the character name. # Enter all unassigned characters up to the current character. if {($index > $next) \ && ![regexp "Last>$" [lindex $items 1]]} { for {} {$next < $index} {incr next} { lappend info 0 if {($next & $mask) == $mask} { addPage $info set info {} } } } # Enter all assigned characters up to the current character for {set i $next} {$i <= $index} {incr i} { # Add the group index to the info for the current page lappend info $gIndex # If this is the last entry in the page, add the page if {($i & $mask) == $mask} { addPage $info set info {} } } set next [expr {$index + 1}] } return } proc uni::main {} { global argc argv0 argv variable pMap variable pages variable groups variable shift variable next if {$argc != 2} { puts stderr "\nusage: $argv0 \n" exit 1 } set f [open [lindex $argv 0] r] set data [read $f] close $f buildTables $data puts "X = [llength $pMap] Y= [llength $pages] A= [llength $groups]" set size [expr {[llength $pMap]*2 + ([llength $pages]<<$shift)}] puts "shift = $shift, space = $size" set f [open [file join [lindex $argv 1] tclUniData.c] w] fconfigure $f -translation lf -encoding utf-8 puts $f "/* * tclUniData.c -- * * Declarations of Unicode character information tables. This file is * automatically generated by the tools/uniParse.tcl script. Do not * modify this file by hand. * * Copyright (c) 1998 Scriptics Corporation. * All rights reserved. */ /* * A 16-bit Unicode character is split into two parts in order to index * into the following tables. The lower OFFSET_BITS comprise an offset * into a page of characters. The upper bits comprise the page number. */ #define OFFSET_BITS $shift /* * The pageMap is indexed by page number and returns an alternate page number * that identifies a unique page of characters. Many Unicode characters map * to the same alternate page number. */ static const unsigned short pageMap\[\] = {" set line " " set last [expr {[llength $pMap] - 1}] for {set i 0} {$i <= $last} {incr i} { if {$i == [expr {0x10000 >> $shift}]} { set line [string trimright $line " \t,"] puts $f $line set lastpage [expr {[lindex $line end] >> $shift}] puts stdout "lastpage: $lastpage" puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6" set line " ," } append line [lindex $pMap $i] if {$i != $last} { append line ", " } if {[string length $line] > 70} { puts $f [string trimright $line] set line " " } } puts $f $line puts $f "#endif /* TCL_UTF_MAX > 3 */" puts $f "}; /* * The groupMap is indexed by combining the alternate page number with * the page offset and returns a group number that identifies a unique * set of character attributes. */ static const unsigned char groupMap\[\] = {" set line " " set lasti [expr {[llength $pages] - 1}] for {set i 0} {$i <= $lasti} {incr i} { set page [lindex $pages $i] set lastj [expr {[llength $page] - 1}] if {$i == ($lastpage + 1)} { puts $f [string trimright $line " \t,"] puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6" set line " ," } for {set j 0} {$j <= $lastj} {incr j} { append line [lindex $page $j] if {$j != $lastj || $i != $lasti} { append line ", " } if {[string length $line] > 70} { puts $f [string trimright $line] set line " " } } } puts $f $line puts $f "#endif /* TCL_UTF_MAX > 3 */" puts $f "}; /* * Each group represents a unique set of character attributes. The attributes * are encoded into a 32-bit value as follows: * * Bits 0-4 Character category: see the constants listed below. * * Bits 5-7 Case delta type: 000 = identity * 010 = add delta for lower * 011 = add delta for lower, add 1 for title * 100 = subtract delta for title/upper * 101 = sub delta for upper, sub 1 for title * 110 = sub delta for upper, add delta for lower * 111 = subtract delta for upper * * Bits 8-31 Case delta: delta for case conversions. This should be the * highest field so we can easily sign extend. */ static const int groups\[\] = {" set line " " set last [expr {[llength $groups] - 1}] for {set i 0} {$i <= $last} {incr i} { foreach {type toupper tolower totitle} [lindex $groups $i] {} # Compute the case conversion type and delta if {$totitle} { if {$totitle == $toupper} { # subtract delta for title or upper set case 4 set delta $toupper if {$tolower} { error "New case conversion type needed: $toupper $tolower $totitle" } } elseif {$toupper} { # subtract delta for upper, subtract 1 for title set case 5 set delta $toupper if {($totitle != 1) || $tolower} { error "New case conversion type needed: $toupper $tolower $totitle" } } else { # add delta for lower, add 1 for title set case 3 set delta $tolower if {$totitle != -1} { error "New case conversion type needed: $toupper $tolower $totitle" } } } elseif {$toupper} { set delta $toupper if {$tolower == $toupper} { # subtract delta for upper, add delta for lower set case 6 } elseif {!$tolower} { # subtract delta for upper set case 7 } else { error "New case conversion type needed: $toupper $tolower $totitle" } } elseif {$tolower} { # add delta for lower set case 2 set delta $tolower } else { # noop set case 0 set delta 0 } append line [expr {($delta << 8) | ($case << 5) | $type}] if {$i != $last} { append line ", " } if {[string length $line] > 65} { puts $f [string trimright $line] set line " " } } puts $f $line puts -nonewline $f "}; #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 # define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next]) #else # define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0) #endif /* * The following constants are used to determine the category of a * Unicode character. */ enum { UNASSIGNED, UPPERCASE_LETTER, LOWERCASE_LETTER, TITLECASE_LETTER, MODIFIER_LETTER, OTHER_LETTER, NON_SPACING_MARK, ENCLOSING_MARK, COMBINING_SPACING_MARK, DECIMAL_DIGIT_NUMBER, LETTER_NUMBER, OTHER_NUMBER, SPACE_SEPARATOR, LINE_SEPARATOR, PARAGRAPH_SEPARATOR, CONTROL, FORMAT, PRIVATE_USE, SURROGATE, CONNECTOR_PUNCTUATION, DASH_PUNCTUATION, OPEN_PUNCTUATION, CLOSE_PUNCTUATION, INITIAL_QUOTE_PUNCTUATION, FINAL_QUOTE_PUNCTUATION, OTHER_PUNCTUATION, MATH_SYMBOL, CURRENCY_SYMBOL, MODIFIER_SYMBOL, OTHER_SYMBOL }; /* * The following macros extract the fields of the character info. The * GetDelta() macro is complicated because we can't rely on the C compiler * to do sign extension on right shifts. */ #define GetCaseType(info) (((info) & 0xE0) >> 5) #define GetCategory(ch) (GetUniCharInfo(ch) & 0x1F) #define GetDelta(info) ((info) >> 8) /* * This macro extracts the information about a character from the * Unicode character tables. */ #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 # define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) #else # define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) #endif " close $f } uni::main return tcl8.6.14/tools/man2tcl.c0000644000175000017500000002102214554262142014503 0ustar sergeisergei/* * man2tcl.c -- * * This file contains a program that turns a man page of the form used * for Tcl and Tk into a Tcl script that invokes a Tcl command for each * construct in the man page. The script can then be eval'ed to translate * the manual entry into some other format such as MIF or HTML. * * Usage: * * man2tcl ?fileName? * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ static char sccsid[] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08"; #include #include #include #include #include /* * Imported things that aren't defined in header files: */ /* * Some define errno to be something complex and thread-aware; in * that case we definitely do not want to declare errno ourselves! */ #ifndef errno extern int errno; #endif /* * Current line number, used for error messages. */ static int lineNumber; /* * The variable below is set to 1 if an error occurs anywhere while reading in * the file. */ static int status; /* * The variable below is set to 1 if output should be generated. If it's 0, it * means we're doing a prepass to make sure that the file can be properly * parsed. */ static int writeOutput; #define PRINT(args) if (writeOutput) { printf args; } #define PRINTC(chr) if (writeOutput) { putc((chr), stdout); } /* * Prototypes for functions defined in this file: */ static void DoMacro(char *line); static void DoText(char *line); static void QuoteText(char *string, int count); /* *---------------------------------------------------------------------- * * main -- * * This function is the main program, which does all of the work of the * program. * * Results: * None: exits with a 0 return status to indicate success, or 1 to * indicate that there were problems in the translation. * * Side effects: * A Tcl script is output to standard output. Error messages may be * output on standard error. * *---------------------------------------------------------------------- */ int main( int argc, /* Number of command-line arguments. */ char **argv) /* Values of command-line arguments. */ { FILE *f; #define MAX_LINE_SIZE 4000 char line[MAX_LINE_SIZE]; char *p; /* * Find the file to read, and open it if it isn't stdin. */ if (argc == 1) { f = stdin; } else if (argc == 2) { f = fopen(argv[1], "r"); if (f == NULL) { fprintf(stderr, "Couldn't read \"%s\": %s\n", argv[1], strerror(errno)); exit(1); } } else { fprintf(stderr, "Usage: %s ?fileName?\n", argv[0]); } /* * Make two passes over the file. In the first pass, just check to make * sure we can handle everything. If there are problems, generate output * and stop. If everything is OK, make a second pass to actually generate * output. */ for (writeOutput = 0; writeOutput < 2; writeOutput++) { lineNumber = 0; status = 0; while (fgets(line, MAX_LINE_SIZE, f) != NULL) { for (p = line; *p != 0; p++) { if (*p == '\n') { *p = 0; break; } } lineNumber++; if (((line[0] == '.') || (line[0] == '\'')) && (line[1] == '\\') && (line[2] == '\"')) { /* * This line is a comment. Ignore it. */ continue; } if (strlen(line) >= MAX_LINE_SIZE -1) { fprintf(stderr, "Too long line. Max is %d chars.\n", MAX_LINE_SIZE - 1); exit(1); } if ((line[0] == '.') || (line[0] == '\'')) { /* * This line is a macro invocation. */ DoMacro(line); } else { /* * This line is text, possibly with formatting characters * embedded in it. */ DoText(line); } } if (status != 0) { break; } fseek(f, 0, SEEK_SET); } exit(status); } /* *---------------------------------------------------------------------- * * DoMacro -- * * This function is called to handle a macro invocation. It parses the * arguments to the macro and generates a Tcl command to handle the * invocation. * * Results: * None. * * Side effects: * A Tcl command is written to stdout. * *---------------------------------------------------------------------- */ static void DoMacro( char *line) /* The line of text that contains the macro * invocation. */ { char *p, *end; int quote; /* * If there is no macro name, then just skip the whole line. */ if ((line[1] == 0) || (isspace(line[1]))) { return; } PRINT(("macro")); if (*line != '.') { PRINT(("2")); } /* * Parse the arguments to the macro (including the name), in order. */ p = line+1; while (1) { PRINTC(' '); if (*p == '"') { /* * The argument is delimited by quotes. */ for (end = p+1; *end != '"'; end++) { if (*end == 0) { fprintf(stderr, "Unclosed quote in macro call on line %d.\n", lineNumber); status = 1; break; } } QuoteText(p+1, (end-(p+1))); } else { quote = 0; for (end = p+1; (*end != 0) && (quote || !isspace(*end)); end++) { if (*end == '\'') { quote = !quote; } } QuoteText(p, end-p); } if (*end == 0) { break; } p = end+1; while (isspace(*p)) { /* * Skip empty space before next argument. */ p++; } if (*p == 0) { break; } } PRINTC('\n'); } /* *---------------------------------------------------------------------- * * DoText -- * * This function is called to handle a line of troff text. It parses the * text, generating Tcl commands for text and for formatting stuff such * as font changes. * * Results: * None. * * Side effects: * Tcl commands are written to stdout. * *---------------------------------------------------------------------- */ static void DoText( char *line) /* The line of text. */ { char *p, *end; /* * Divide the line up into pieces consisting of backslash sequences, tabs, * and other text. */ p = line; while (*p != 0) { if (*p == '\t') { PRINT(("tab\n")); p++; } else if (*p != '\\') { /* * Ordinary text. */ for (end = p+1; (*end != '\\') && (*end != 0); end++) { /* Empty loop body. */ } PRINT(("text ")); QuoteText(p, end-p); PRINTC('\n'); p = end; } else { /* * A backslash sequence. There are particular ones that we * understand; output an error message for anything else and just * ignore the backslash. */ p++; if (*p == 'f') { /* * Font change. */ PRINT(("font %c\n", p[1])); p += 2; } else if (*p == '-') { PRINT(("dash\n")); p++; } else if (*p == 'e') { PRINT(("text \\\\\n")); p++; } else if (*p == '.') { PRINT(("text .\n")); p++; } else if (*p == '&') { p++; } else if (*p == '0') { PRINT(("text { }\n")); p++; } else if (*p == '(') { if ((p[1] == 0) || (p[2] == 0)) { fprintf(stderr, "Bad \\( sequence on line %d.\n", lineNumber); status = 1; } else { PRINT(("char {\\(%c%c}\n", p[1], p[2])); p += 3; } } else if (*p == 'N' && *(p+1) == '\'') { int ch; p += 2; sscanf(p,"%d",&ch); PRINT(("text \\u%04x\n", ch)); while(*p&&*p!='\'') p++; p++; } else if (*p != 0) { PRINT(("char {\\%c}\n", *p)); p++; } } } PRINT(("newline\n")); } /* *---------------------------------------------------------------------- * * QuoteText -- * * Copy the "string" argument to stdout, adding quote characters around * any special Tcl characters so that they'll just be treated as ordinary * text. * * Results: * None. * * Side effects: * Text is written to stdout. * *---------------------------------------------------------------------- */ static void QuoteText( char *string, /* The line of text. */ int count) /* Number of characters to write from * string. */ { if (count == 0) { PRINT(("{}")); return; } for ( ; count > 0; string++, count--) { switch (*string) { case '\\': if (*(string+1) == 'N' && *(string+2) == '\'') { int ch; string += 3; count -= 3; sscanf(string,"%d",&ch); PRINT(("\\u%04x", ch)); while(count>0&&*string!='\'') {string++;count--;} continue; } else if (*(string+1) == '0') { PRINT(("\\ ")); string++; count--; continue; } case '$': case '[': case '{': case ' ': case ';': case '"': case '\t': PRINTC('\\'); default: PRINTC(*string); } } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tcl8.6.14/tools/feather.bmp0000644000175000017500000000406614554262142015126 0ustar sergeisergeiBM66( ФФ€€€€€€€€€РРРРмР№ЪІ @ ` €   Р р@@ @@@`@€@ @Р@р`` `@```€` `Р`р€€ €@€`€€€ €Р€р    @ ` €   Р рРР Р@Р`ЈРРРРррр р@р`р€р рРрр@@ @@@`@€@ @Р@р@ @ @ @@ `@ €@  @ Р@ р@@@@ @@@@@`@@€@@ @@Р@@р@`@` @`@@``@`€@` @`Р@`р@€@€ @€@@€`@€€@€ @€Р@€р@ @  @ @@ `@ €@  @ Р@ р@Р@Р @Р@@Р`@Р€@Р @РР@Рр@р@р @р@@р`@р€@р @рР@рр€€ €@€`€€€ €Р€р€ € € @€ `€ €€  € Р€ р€@€@ €@@€@`€@€€@ €@Р€@р€`€` €`@€``€`€€` €`Р€`р€€€€ €€@€€`€€€€€ €€Р€€р€ €  € @€ `€ €€  € Р€ р€Р€Р €Р@€Р`€Р€€Р €РР€Рр€р€р €р@€р`€р€€р €рР€ррРР Р@Р`ЈРРРРрР Р Р @Р `Р €Р  Р РР рР@Р@ Р@@Р@`Р@€Р@ Р@РР@рР`Р` Р`@Р``Р`€Р` Р`РР`рЈЈ Р€@Р€`Р€€Р€ Р€РР€рР Р  Р @Р `Р €Р  Р РР рРРРР РР@РР`РР€РР №ћџЄ  €€€џџџџџџџџџџџџћћЄћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћЄћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћЄћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћЄћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћЄћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћћЄЄћћћћћћћћћћћћћЄћЄаРРРћћћћћћћћћЄЄћћћћћћћћћћћћЄћЄРРРРРРћћћћћћћћћћЄћћћћћћћћћћћќЄћаРРРРРРћћћћћћћћћЄћћћћћћћћћћРќїаРРРРРРРћћћћЄЄћћћћћћћћћћћћћРќќїРРРРРРРРћћћћћЄћћћћћћћћћћћћћРќќЄРРРРРРРРћћћћћЄћћћћћћћћћћћћРќќќаРРРРРРРРћћћћћЄћћћћћћћћћћћРќќќќаРРРРРРРРћћћћћћћћћћћћћћћћћРќќќќаРРРРРРРћћћћћћћћћћћћћћћћћРќќќќќаРРРРРРћћћћћћћћћћћћћћћћћћРќќќќќїРРРРРРћћћћћћћћћћћћћћћћћРќќќќќїРРРРРРРћћћћћћћћћћћћћћћћРќќќќаќїРРРРРРРћћћћћћћћћћћћћћћћРќаќќќќЄРРРРРРРћћћћћћћћћћћћћћћћРќќќќаќаЄРРРРРРћћћћћћћћћћћћћћћћРќќаќаќа›РРРРРРћћћћћћћћћћћћћћћћРќќаќаааќРРРРРРћћћћћћћћЄћћћћћћћћРаќаќаааќРРРРРћћћћћћћЄћћћЄћћћћћРаќаааааќРРРРРћћћћћћћћЄћћћЄћћћћћРќааааааќРРРРћћћћћћћЄћћћћЄћћћћћРРќаааааќРРРРћћћћћћћћЄћћћћЄћћћћћћРќаааааќРРРћћћћћћћћЄћћћћЄЄћћћћћРРќааааќРРРћћћћћћћћћЄћћћћћЄЄћћћћћРРќаааќРРћћћћћћћћћћћћћћћћћћћћћћћћРРРќаќРћћћћћћћћћћћћћћћћћћћћћћћћћћћРРРРћћtcl8.6.14/tools/white.bmp0000644000175000017500000005005214554262142014624 0ustar sergeisergeiBM*P>(еUьOttџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџјtcl8.6.14/tools/tcl.hpj.in0000644000175000017500000000053414554262142014676 0ustar sergeisergei; This file is maintained by HCW. Do not modify this file directly. [OPTIONS] HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual CNT=tcl86.cnt COPYRIGHT=Copyright Љ 2000 Ajuba Solutions HLP=tcl86.hlp [FILES] tcl.rtf [WINDOWS] main="Tcl/Tk Reference Manual",,0 [CONFIG] BrowseButtons() tcl8.6.14/pkgs/0000755000175000017500000000000014566154505012614 5ustar sergeisergeitcl8.6.14/pkgs/README0000644000175000017500000000513114554262142013466 0ustar sergeisergei The 'pkgs' subdirectory of the Tcl source code distribution is meant to be a place where the source code distribution of Tcl packages may be placed so that they are built, installed, and tested along with Tcl. As originally distributed, Tcl re-distributes a number of packages in this location. The build systems for Tcl are written so that additional packages may be added, or the original packages removed in any number and still have all packages present get built, installed, and tested along with Tcl. In order for a package to work properly under the pkgs subdirectory, it needs to conform to the following conventions. All files of the package need to be contained in (subdirs of ...) a single subdirectory of the "pkgs" directrory. In that subdirectory of "pkgs" there must be an executable file named "configure". When the program "configure" is run, it should generate a file "Makefile" in the current working directory. The "configure" program should be able to accept as command line arguments all the arguments that can be passed to the top unix/configure program. It should also accept the --with-tcl= and --with-tclinclude= options in the conventional way. The generated "Makefile" must be one suitable for controlling the operations of a `make` program. The following targets must be defined: : Perform a build of the runtime components of the package from sources. install: Copy the runtime components of the package into their installed location. Must respect the DESTDIR variable for determining the installation location. test: Run the test suite of the package. Must respect the TCLSH_PROG, TESTFLAGS variables. clean: Delete all files generated by the default build target. distclean: Delete all generated files. dist: Produce a copy of the package's source code distribution. Must respect the DIST_ROOT variable determining where to write the generated directory. Packages that are written to make use of the Tcl Extension Architecture (TEA) and that make use of the tclconfig collection of support files, should conform to these conventions without further efforts. These conventions are subject to revision and refinement over time to better support the needs of the build system. Efforts will be made to keep the TEA support scripts consistent with the demands of this system. In addition, it is requested that packages also support building with Microsoft Visual Studio tools. This means the file win/makefile.vc should be included, suitable for use by the nmake program, defining the targets , install, test, and clean. tcl8.6.14/pkgs/package.list.txt0000644000175000017500000000152614554262142015720 0ustar sergeisergei# This file contains the mapping of directory names to package names for # documentation purposes. Each non-blank non-comment line is a two-element # list that says a possible name of directory (multiple lines may be needed # because of capitalization issues) and the documentation name of the package # to match. Pseudo-numeric suffixes are interpreted as version numbers. # [incr Tcl] itcl {[incr Tcl]} Itcl {[incr Tcl]} # SQLite Sqlite SQLite3 sqlite SQLite3 Sqlite3 SQLite3 sqlite3 SQLite3 # Thread Thread Thread thread Thread # Tcl Database Connectivity tdbc TDBC Tdbc TDBC TDBC TDBC # Drivers for TDBC Tdbcmysql tdbc::mysql tdbcmysql tdbc::mysql Tdbcodbc tdbc::odbc tdbcodbc tdbc::odbc Tdbcpostgres tdbc::postgres tdbcpostgres tdbc::postgres Tdbcsqlite3 tdbc::sqlite3 tdbcsqlite3 tdbc::sqlite3 Tdbcsqlite tdbc::sqlite3 tdbcsqlite tdbc::sqlite3 tcl8.6.14/.travis.yml0000644000175000017500000002437114554262142013762 0ustar sergeisergeilanguage: c addons: apt: sources: - ubuntu-toolchain-r-test packages: - binutils-mingw-w64-i686 - binutils-mingw-w64-x86-64 - gcc-mingw-w64 - gcc-mingw-w64-base - gcc-mingw-w64-i686 - gcc-mingw-w64-x86-64 - gcc-multilib jobs: include: # Testing on Linux GCC - name: "Linux/GCC/Shared" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix - name: "Linux/GCC/Shared: UTF_MAX=4" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4 - name: "Linux/GCC/Shared: UTF_MAX=6" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 - name: "Linux/GCC/Static" os: linux dist: focal compiler: gcc env: - CFGOPT="--disable-shared" - BUILD_DIR=unix - name: "Linux/GCC/Debug" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT="--enable-symbols" - name: "Linux/GCC/Mem-Debug" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT="--enable-symbols=mem" # Newer/Older versions of GCC - name: "Linux/GCC 10/Shared" os: linux dist: focal compiler: gcc-10 addons: apt: packages: - g++-10 env: - BUILD_DIR=unix - name: "Linux/GCC 5/Shared" os: linux dist: bionic compiler: gcc-5 addons: apt: packages: - g++-5 env: - BUILD_DIR=unix # Testing on Linux Clang - name: "Linux/Clang/Shared" os: linux dist: focal compiler: clang env: - BUILD_DIR=unix - name: "Linux/Clang/Static" os: linux dist: focal compiler: clang env: - CFGOPT="--disable-shared" - BUILD_DIR=unix - name: "Linux/Clang/Debug" os: linux dist: focal compiler: clang env: - BUILD_DIR=unix - CFGOPT="--enable-symbols" - name: "Linux/Clang/Mem-Debug" os: linux dist: focal compiler: clang env: - BUILD_DIR=unix - CFGOPT="--enable-symbols=mem" # Testing on Mac, various styles - name: "macOS/Xcode 12/Shared" os: osx osx_image: xcode12.2 env: - BUILD_DIR=macosx install: [] script: &mactest - make all # The styles=develop avoids some weird problems on OSX - make test styles=develop - name: "macOS/Xcode 12/Shared/Unix-like" os: osx osx_image: xcode12.2 env: - BUILD_DIR=unix - CFGOPT="--enable-dtrace" # Newer MacOS versions - name: "macOS/Xcode 12/Universal Apps/Shared" os: osx osx_image: xcode12u env: - BUILD_DIR=macosx install: [] script: *mactest # Older MacOS versions - name: "macOS/Xcode 11/Shared" os: osx osx_image: xcode11.7 env: - BUILD_DIR=macosx install: [] script: *mactest - name: "macOS/Xcode 10/Shared" os: osx osx_image: xcode10.3 env: - BUILD_DIR=macosx install: [] script: *mactest - name: "macOS/Xcode 9/Shared" os: osx osx_image: xcode9.4 env: - BUILD_DIR=macosx install: [] script: *mactest - name: "macOS/Xcode 8/Shared" os: osx osx_image: xcode8.3 env: - BUILD_DIR=macosx install: [] script: *mactest # Test with mingw-w64 cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows/GCC/Shared/no test" os: linux dist: focal compiler: x86_64-w64-mingw32-gcc env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" script: &crosstest - make all tcltest # Include a high visibility marker that tests are skipped outright - > echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" # Test with mingw-w64 (32 bit) cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows-32/GCC/Shared/no test" os: linux dist: focal compiler: i686-w64-mingw32-gcc env: - BUILD_DIR=win - CFGOPT=--host=i686-w64-mingw32 script: *crosstest # Test on Windows with MSVC native - name: "Windows/MSVC/Shared" os: windows compiler: cl env: &vcenv - BUILD_DIR=win - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" before_install: &vcpreinst - touch generic/tclStubInit.c generic/tclOOStubInit.c - PATH="$PATH:$VCDIR" - cd ${BUILD_DIR} install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test - name: "Windows/MSVC/Static" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test - name: "Windows/MSVC/StaticPackage" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc test - name: "Windows/MSVC/Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test - name: "Windows/MSVC/Mem-Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg' '-f' makefile.vc test # Test on Windows with MSVC native (32-bit) - name: "Windows/MSVC-x86/Shared" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc test - name: "Windows/MSVC-x86/Static" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test - name: "Windows/MSVC-x86/Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test - name: "Windows/MSVC-x86/Mem-Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg' '-f' makefile.vc test # Test on Windows with GCC native - name: "Windows/GCC/Shared" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit" before_install: &makepreinst - touch generic/tclStubInit.c generic/tclOOStubInit.c - choco install -y make - cd ${BUILD_DIR} - name: "Windows/GCC/Shared: UTF_MAX=4" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=4" before_install: *makepreinst - name: "Windows/GCC/Static" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit --disable-shared" before_install: *makepreinst - name: "Windows/GCC/Debug" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit --enable-symbols" before_install: *makepreinst - name: "Windows/GCC/Mem-Debug" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit --enable-symbols=mem" before_install: *makepreinst # Test on Windows with GCC native (32-bit) - name: "Windows/GCC-x86/Shared" os: windows compiler: gcc env: - BUILD_DIR=win before_install: *makepreinst - name: "Windows/GCC-x86/Shared: UTF_MAX=4" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="CFLAGS=-DTCL_UTF_MAX=4" before_install: *makepreinst - name: "Windows/GCC-x86/Static" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--disable-shared" before_install: *makepreinst - name: "Windows/GCC-x86/Debug" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-symbols" before_install: *makepreinst - name: "Windows/GCC-x86/Mem-Debug" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-symbols=mem" before_install: *makepreinst # "make dist" only - name: "Linux: make dist" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix script: - make dist before_install: - touch generic/tclStubInit.c generic/tclOOStubInit.c - cd ${BUILD_DIR} install: - mkdir "$HOME/install dir" - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) before_script: - export ERROR_ON_FAILURES=1 script: - make all tcltest || echo "Something wrong, maybe a hickup, let's try again" - make test - make install tcl8.6.14/.github/0000755000175000017500000000000014566153413013205 5ustar sergeisergeitcl8.6.14/.github/workflows/0000755000175000017500000000000014566153413015242 5ustar sergeisergeitcl8.6.14/.github/workflows/linux-build.yml0000644000175000017500000000400214554262142020212 0ustar sergeisergeiname: Linux on: push: branches: - "main" - "core-8-branch" - "core-8-6-branch" tags: - "core-**" permissions: contents: read jobs: gcc: runs-on: ubuntu-22.04 strategy: matrix: config: - "" - "--disable-shared" - "--enable-symbols" - "--enable-symbols=mem" - "--enable-symbols=all" - "CFLAGS=-ftrapv" - "CFLAGS=-DTCL_UTF_MAX=4" - "CFLAGS=-DTCL_UTF_MAX=6" # Duplicated below - "CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit" defaults: run: shell: bash working-directory: unix steps: - name: Checkout uses: actions/checkout@v4 timeout-minutes: 5 - name: Install 32-bit dependencies if needed # Duplicated from above if: ${{ matrix.config == 'CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit' }} run: | sudo apt-get update sudo apt-get install gcc-multilib libc6-dev-i386 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c working-directory: generic - name: Configure ${{ matrix.config }} run: | mkdir "${HOME}/install dir" ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: CFGOPT: ${{ matrix.config }} timeout-minutes: 5 - name: Build run: | make all timeout-minutes: 5 - name: Build Test Harness run: | make tcltest timeout-minutes: 5 - name: Run Tests run: | make test env: ERROR_ON_FAILURES: 1 timeout-minutes: 30 - name: Test-Drive Installation run: | make install timeout-minutes: 5 - name: Create Distribution Package run: | make dist timeout-minutes: 5 - name: Convert Documentation to HTML run: | make html-tcl timeout-minutes: 5 tcl8.6.14/.github/workflows/mac-build.yml0000644000175000017500000000342514554262142017623 0ustar sergeisergeiname: macOS on: push: branches: - "main" - "core-8-branch" - "core-8-6-branch" tags: - "core-**" permissions: contents: read jobs: xcode: runs-on: macos-11 defaults: run: shell: bash working-directory: macosx steps: - name: Checkout uses: actions/checkout@v4 timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c working-directory: generic - name: Build run: make all timeout-minutes: 15 - name: Run Tests run: make test styles=develop env: ERROR_ON_FAILURES: 1 MAC_CI: 1 timeout-minutes: 15 clang: runs-on: macos-11 strategy: matrix: config: - "" - "--disable-shared" - "--enable-symbols" - "--enable-symbols=mem" - "--enable-symbols=all" defaults: run: shell: bash working-directory: unix steps: - name: Checkout uses: actions/checkout@v4 timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c mkdir "$HOME/install dir" working-directory: generic - name: Configure ${{ matrix.config }} # Note that macOS is always a 64 bit platform run: ./configure --enable-64bit --enable-dtrace --enable-framework ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1) env: CFGOPT: ${{ matrix.config }} timeout-minutes: 5 - name: Build run: | make all tcltest timeout-minutes: 15 - name: Run Tests run: | make test env: ERROR_ON_FAILURES: 1 MAC_CI: 1 timeout-minutes: 15 tcl8.6.14/.github/workflows/win-build.yml0000644000175000017500000000557714554262142017672 0ustar sergeisergeiname: Windows on: push: branches: - "main" - "core-8-branch" - "core-8-6-branch" tags: - "core-**" permissions: contents: read env: ERROR_ON_FAILURES: 1 jobs: msvc: runs-on: windows-2022 defaults: run: shell: powershell working-directory: win strategy: matrix: config: - "" - "OPTS=static,msvcrt" - "OPTS=static,staticpkg,msvcrt" - "OPTS=symbols" - "OPTS=symbols STATS=compdbg,memdbg" # Using powershell means we need to explicitly stop on failure steps: - name: Checkout uses: actions/checkout@v4 timeout-minutes: 5 - name: Init MSVC uses: ilammy/msvc-dev-cmd@v1 timeout-minutes: 5 - name: Build ${{ matrix.config }} run: | &nmake -f makefile.vc ${{ matrix.config }} all if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } timeout-minutes: 5 - name: Build Test Harness ${{ matrix.config }} run: | &nmake -f makefile.vc ${{ matrix.config }} tcltest if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } timeout-minutes: 5 - name: Run Tests ${{ matrix.config }} run: | &nmake -f makefile.vc ${{ matrix.config }} test if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } timeout-minutes: 30 gcc: runs-on: windows-2022 defaults: run: shell: msys2 {0} working-directory: win strategy: matrix: config: - "" - "--disable-shared" - "--enable-symbols" - "--enable-symbols=mem" - "--enable-symbols=all" # Using powershell means we need to explicitly stop on failure steps: - name: Install MSYS2 uses: msys2/setup-msys2@v2 with: msystem: MINGW64 install: git mingw-w64-x86_64-toolchain make timeout-minutes: 10 - name: Checkout uses: actions/checkout@v4 timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c mkdir "${HOME}/install dir" working-directory: generic - name: Configure ${{ matrix.config }} run: | ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: CFGOPT: --enable-64bit ${{ matrix.config }} timeout-minutes: 5 - name: Build run: make all timeout-minutes: 5 - name: Build Test Harness run: make tcltest timeout-minutes: 5 - name: Run Tests run: make test timeout-minutes: 30 # If you add builds with Wine, be sure to define the environment variable # CI_USING_WINE when running them so that broken tests know not to run.

    Without further ado, here is the program zpipe.c: